pax_global_header00006660000000000000000000000064146656075540014534gustar00rootroot0000000000000052 comment=e802567167ed245d3a6d6f9ab42f15ff3d574f4c coq-8.20.0/000077500000000000000000000000001466560755400124055ustar00rootroot00000000000000coq-8.20.0/.github/000077500000000000000000000000001466560755400137455ustar00rootroot00000000000000coq-8.20.0/.github/CODEOWNERS000066400000000000000000000221031466560755400153360ustar00rootroot00000000000000# This file associates maintainer teams to each component. # See CONTRIBUTING.md ########## Contributing process ########## /.github/ @coq/contributing-process-maintainers /CONTRIBUTING.md @coq/contributing-process-maintainers ########## Build system ########## /Makefile @coq/build-maintainers /dev/tools/make_git_revision.sh @coq/build-maintainers /configure @coq/build-maintainers /tools/configure/* @coq/build-maintainers /tools/coqdep/ @coq/build-maintainers /boot/ @coq/build-maintainers ########## CI infrastructure ########## /dev/ci/ @coq/ci-maintainers /dev/lint-*.sh @coq/ci-maintainers /.travis.yml @coq/ci-maintainers /.gitlab-ci.yml @coq/ci-maintainers /.github/workflows @coq/ci-maintainers /dev/ci/platform/ @coq/windows-build-maintainers /Makefile.ci @coq/ci-maintainers /dev/ci/nix @coq/nix-maintainers *.nix @coq/nix-maintainers /dev/ci/user-overlays/*.sh # Trick to avoid getting review requests # each time someone adds an overlay /dev/bench/ @coq/bench-maintainers ########## Documentation ########## /README.md @coq/doc-maintainers /INSTALL.md @coq/doc-maintainers /CODE_OF_CONDUCT.md @coq/code-of-conduct-team /doc/ @coq/doc-maintainers /dev/doc/ @coq/doc-maintainers /doc/changelog/*/*.rst /dev/doc/changes.md # Trick to avoid getting review requests # each time someone modifies the changelog /dev/doc/build-system.dune.md @coq/build-maintainers /dev/doc/critical-bugs @coq/kernel-maintainers /dev/doc/econstr.md @coq/engine-maintainers /dev/doc/proof-engine.md @coq/engine-maintainers /dev/doc/release-process.md @coq/contributing-process-maintainers /dev/doc/shield-icon.png @coq/contributing-process-maintainers /dev/doc/SProp.md @coq/universes-maintainers /dev/doc/style.md @coq/contributing-process-maintainers /dev/doc/unification.txt @coq/pretyper-maintainers /dev/doc/universes.md @coq/universes-maintainers /dev/doc/xml-protocol.md @coq/stm-maintainers /man/ @coq/doc-maintainers /doc/plugin_tutorial/ @coq/plugin-tutorial-maintainers ########## Coqchk ########## /checker/ @coq/kernel-maintainers /test-suite/coqchk/ @coq/kernel-maintainers ########## Coq lib ########## /clib/ @coq/lib-maintainers /test-suite/unit-tests/clib/ @coq/lib-maintainers /lib/ @coq/lib-maintainers ########## Proof engine ########## /engine/ @coq/engine-maintainers /engine/univ* @coq/universes-maintainers /engine/uState.* @coq/universes-maintainers ########## CoqIDE ########## /ide/ @coq/coqide-maintainers /ide/protocol/ @coq/stm-maintainers /test-suite/ide/ @coq/stm-maintainers ########## Desugaring ########## /interp/ @coq/extensible-syntax-maintainers ########## Kernel ########## /kernel/ @coq/kernel-maintainers /kernel/byterun/ @coq/vm-native-maintainers /kernel/native* @coq/vm-native-maintainers /kernel/vm* @coq/vm-native-maintainers /kernel/vconv.* @coq/vm-native-maintainers /kernel/genOpcodeFiles.* @coq/vm-native-maintainers /kernel/sorts.* @coq/universes-maintainers /kernel/uGraph.* @coq/universes-maintainers /kernel/univ.* @coq/universes-maintainers ########## Library ########## /library/ @coq/library-maintainers ########## Parser ########## /coqpp/ @coq/parsing-maintainers /gramlib/ @coq/parsing-maintainers /parsing/ @coq/parsing-maintainers ########## Standard library and plugins ########## /theories/ @coq/stdlib-maintainers /doc/stdlib/ @coq/stdlib-maintainers /theories/Classes/ @coq/typeclasses-maintainers /theories/Reals/ @coq/reals-library-maintainers /theories/Compat/ @coq/compat-maintainers /plugins/btauto/ @coq/btauto-maintainers /theories/btauto/ @coq/btauto-maintainers /plugins/cc/ @coq/cc-maintainers /theories/cc/ @coq/cc-maintainers /plugins/derive/ @coq/derive-maintainers /theories/derive/ @coq/derive-maintainers /plugins/extraction/ @coq/extraction-maintainers /theories/extraction/ @coq/extraction-maintainers /plugins/firstorder/ @coq/firstorder-maintainers /theories/firstorder/ @coq/firstorder-maintainers /plugins/funind/ @coq/funind-maintainers /theories/funind/ @coq/funind-maintainers /plugins/ltac/ @coq/ltac-maintainers /theories/ltac/ @coq/ltac-maintainers /plugins/micromega/ @coq/micromega-maintainers /theories/micromega/ @coq/micromega-maintainers /test-suite/micromega/ @coq/micromega-maintainers /plugins/nsatz/ @coq/nsatz-maintainers /theories/nsatz/ @coq/nsatz-maintainers /plugins/ring/ @coq/ring-maintainers /theories/setoid_ring/ @coq/ring-maintainers /plugins/ssrmatching/ @coq/ssreflect-maintainers /theories/ssrmatching/ @coq/ssreflect-maintainers /plugins/ssr/ @coq/ssreflect-maintainers /theories/ssr/ @coq/ssreflect-maintainers /test-suite/ssr/ @coq/ssreflect-maintainers /plugins/syntax/ @coq/parsing-maintainers /plugins/rtauto/ @coq/rtauto-maintainers /theories/rtauto/ @coq/rtauto-maintainers /plugins/ltac2/ @coq/ltac2-maintainers /user-contrib/Ltac2 @coq/ltac2-maintainers ########## Pretyper ########## /pretyping/ @coq/pretyper-maintainers /pretyping/vnorm.* @coq/vm-native-maintainers /pretyping/nativenorm.* @coq/vm-native-maintainers ########## Pretty printer ########## /printing/ @coq/extensible-syntax-maintainers ########## Proof infrastructure ########## /proofs/ @coq/engine-maintainers ########## STM ########## /stm/ @coq/stm-maintainers /test-suite/interactive/ @coq/stm-maintainers /test-suite/stm/ @coq/stm-maintainers /test-suite/vio/ @coq/stm-maintainers ########## Tactics ########## /tactics/ @coq/tactics-maintainers /tactics/class_tactics.* @coq/typeclasses-maintainers ########## Number ########## /interp/numTok.* @coq/number-maintainers /kernel/float64* @coq/number-maintainers /kernel/uint63* @coq/number-maintainers /plugins/syntax/g_number_string.mlg @coq/number-maintainers /plugins/syntax/int63_syntax_plugin.mllib @coq/number-maintainers /plugins/syntax/number.ml @coq/number-maintainers /plugins/syntax/number_string_notation_plugin.mllib @coq/number-maintainers /user-contrib/Ltac2/Int.v @coq/number-maintainers /test-suite/output/FloatExtraction* @coq/number-maintainers /test-suite/output/*Number* @coq/number-maintainers /test-suite/primitive/float/ @coq/number-maintainers /test-suite/primitive/sint63/ @coq/number-maintainers /test-suite/primitive/uint63/ @coq/number-maintainers /theories/Init/Decimal.v @coq/number-maintainers /theories/Init/Hexadecimal.v @coq/number-maintainers /theories/Init/Nat.v @coq/number-maintainers /theories/Init/Number.v @coq/number-maintainers /theories/*Arith/ @coq/number-maintainers /theories/Numbers/ @coq/number-maintainers /theories/Floats/ @coq/number-maintainers /theories/extraction/Extr*Nat* @coq/number-maintainers /theories/extraction/Extr*Z* @coq/number-maintainers /theories/extraction/ExtrOCamlFloats.v @coq/number-maintainers /theories/extraction/ExtrOCamlInt* @coq/number-maintainers ########## Tools ########## /tools/coqdoc/ @coq/coqdoc-maintainers /test-suite/coqdoc/ @coq/coqdoc-maintainers /tools/coqwc* @coq/coqdoc-maintainers /test-suite/coqwc/ @coq/coqdoc-maintainers /tools/coq_makefile* @coq/coq-makefile-maintainers /tools/CoqMakefile* @coq/coq-makefile-maintainers /test-suite/coq-makefile/ @coq/coq-makefile-maintainers /tools/TimeFileMaker.py @coq/coq-makefile-maintainers /tools/make-*-tim*.py @coq/coq-makefile-maintainers /tools/coq_tex* @silene # Secondary maintainer @gares ########## Toplevel ########## /toplevel/ @coq/toplevel-maintainers /topbin/ @coq/toplevel-maintainers /sysinit/ @coq/toplevel-maintainers ########## Vernacular ########## /vernac/ @coq/vernac-maintainers /vernac/metasyntax.* @coq/parsing-maintainers /vernac/classes.* @coq/typeclasses-maintainers ########## Test suite ########## /test-suite/Makefile @coq/test-suite-maintainers /test-suite/README.md @coq/test-suite-maintainers /test-suite/report.sh @coq/test-suite-maintainers /test-suite/unit-tests/src/ @coq/test-suite-maintainers /test-suite/success/Compat*.v @coq/compat-maintainers ########## Developer tools ########## /dev/tools/ @coq/dev-tools-maintainers /dev/tools/update-compat.py @coq/compat-maintainers /test-suite/tools/update-compat/ @coq/compat-maintainers ########## Dune ########## /.ocamlinit @coq/build-maintainers *dune* @coq/build-maintainers *.opam @coq/build-maintainers coq-8.20.0/.github/ISSUE_TEMPLATE/000077500000000000000000000000001466560755400161305ustar00rootroot00000000000000coq-8.20.0/.github/ISSUE_TEMPLATE/bug_report.yml000066400000000000000000000025521466560755400210270ustar00rootroot00000000000000name: Bug report description: Report an unexpected behavior. labels: ["kind: bug", "needs: triage"] body: - type: markdown attributes: value: | Thank you for your contribution. It is helpful to explain how to reproduce the bug and what the problem is. If you have a small reproducible example, you can use the second field to provide it. Otherwise, please provide a link to a repository, a gist (https://gist.github.com) or drag-and-drop a `.zip` archive in the first field. - type: textarea attributes: label: Description of the problem placeholder: What happens and what you would have expected instead. - type: textarea attributes: label: Small Coq file to reproduce the bug placeholder: | Goal True. ok tactic. buggy tactic. (* the last line raises an error or an anomaly *) render: coq - type: input attributes: label: Version of Coq where this bug occurs description: | You can get this information by running `coqtop -v`. Feel free to provide a comma-separated list or a range of versions if you can reproduce the bug on several versions of Coq. placeholder: 8.X.Y - type: input attributes: label: Last version of Coq where the bug did not occur description: You can fill this optional field if the bug is a regression compared to a previous version of Coq. coq-8.20.0/.github/ISSUE_TEMPLATE/config.yml000066400000000000000000000015311466560755400201200ustar00rootroot00000000000000blank_issues_enabled: true contact_links: - name: Coq Zulip Chat url: https://coq.zulipchat.com about: For casual and high traffic discussions. You can ask questions about Coq (#Coq users) or questions about Coq internals (#Coq devs & plugin devs). There are also many streams dedicated to external Coq projects. - name: Coq Discourse Forum url: https://coq.discourse.group about: Our official, multilingual forum, for more structured and easy to search discussions. You can also ask about Coq or internals here, and this is the place to send any announcements. - name: Proof Assistants Stack Exchange url: https://proofassistants.stackexchange.com about: For questions about Coq, Lean, Agda, Isabelle, etc. This is a Q&A site, where numerous Coq users are available to answer questions, but this is not an official Coq forum. coq-8.20.0/.github/ISSUE_TEMPLATE/feature_request.yml000066400000000000000000000013021466560755400220520ustar00rootroot00000000000000name: Feature request description: Suggest an idea of improvement. labels: ["kind: wish", "needs: triage"] body: - type: textarea attributes: label: Is your feature request related to a problem? placeholder: A clear and concise description of what the problem is. E.g., I'm frustrated when [...] - type: textarea attributes: label: Proposed solution placeholder: Describe your ideal solution. - type: textarea attributes: label: Alternative solutions placeholder: List any alternative solutions or features you've considered. - type: textarea attributes: label: Additional context placeholder: Add any other context or screenshots about the feature request here. coq-8.20.0/.github/PULL_REQUEST_TEMPLATE.md000066400000000000000000000026171466560755400175540ustar00rootroot00000000000000 Fixes / closes #???? - [ ] Added / updated **test-suite**. - [ ] Added **changelog**. - [ ] Added / updated **documentation**. - [ ] Documented any new / changed **user messages**. - [ ] Updated **documented syntax** by running `make doc_gram_rsts`. - [ ] Opened **overlay** pull requests. We have a number of channels to reach the user community and the development team: - Our [Zulip chat][zulip-link], for casual and high traffic discussions. - Our [Discourse forum][discourse-link], for more structured and easily browsable discussions and Q&A. - Our historical mailing list, the [Coq-Club](https://sympa.inria.fr/sympa/info/coq-club). See also [coq.inria.fr/community](https://coq.inria.fr/community.html), which lists several other active platforms. coq-8.20.0/.github/workflows/000077500000000000000000000000001466560755400160025ustar00rootroot00000000000000coq-8.20.0/.github/workflows/check-conflicts.yml000066400000000000000000000007301466560755400215640ustar00rootroot00000000000000name: "Check conflicts" on: [push] # Only on push because @coqbot already takes care of checking for # conflicts when PRs are opened or synchronized permissions: contents: read jobs: main: permissions: pull-requests: write runs-on: ubuntu-latest steps: - uses: eps1lon/actions-label-merge-conflict@b8bf8341285ec9a4567d4318ba474fee998a6919 with: dirtyLabel: "needs: rebase" repoToken: "${{ secrets.GITHUB_TOKEN }}" coq-8.20.0/.github/workflows/ci-macos.yml000066400000000000000000000034301466560755400202200ustar00rootroot00000000000000name: GitHub macOS CI on: [push, pull_request] permissions: contents: read jobs: macOS: runs-on: macos-12 steps: - uses: actions/checkout@v3 - name: Install system dependencies run: | brew install gnu-time opam gtksourceview3 adwaita-icon-theme expat libxml2 pkg-config pip3 install macpack - name: Install OCaml dependencies run: | export PKG_CONFIG_PATH=/usr/local/opt/libffi/lib/pkgconfig opam init -a -j "$NJOBS" --compiler=ocaml-base-compiler.$COMPILER opam switch set ocaml-base-compiler.$COMPILER eval $(opam env) opam update opam install -j "$NJOBS" ocamlfind${FINDLIB_VER} ounit lablgtk3-sourceview3 zarith.1.11 dune.3.6.1 opam list env: COMPILER: "4.12.0" FINDLIB_VER: ".1.8.1" OPAMYES: "true" MACOSX_DEPLOYMENT_TARGET: "10.11" NJOBS: "2" - name: Build Coq run: | eval $(opam env) ./configure -prefix "$(pwd)/_install_ci" -native-compiler no make dunestrap dune build -p coq-core,coq-stdlib,coqide-server,coqide,coq env: MACOSX_DEPLOYMENT_TARGET: "10.11" NJOBS: "2" - name: Install Coq run: | eval $(opam env) dune install --prefix="$(pwd)/_install_ci" coq-core coq-stdlib coqide-server coqide coq - name: Run Coq Test Suite run: | eval $(opam env) cd test-suite make clean export OCAMLPATH="$(pwd)/../_install_ci/lib":"$OCAMLPATH" BIN="$(pwd)/../_install_ci/bin/" LIB="$(pwd)/../_install_ci/lib/coq/" make -j "$NJOBS" BIN="$BIN" COQLIB="$LIB" PRINT_LOGS=1 TIMED=1 all env: NJOBS: "2" coq-8.20.0/.github/workflows/ci-windows.yml000066400000000000000000000025071466560755400206140ustar00rootroot00000000000000name: Windows CI on: [push, pull_request] permissions: contents: read jobs: Windows: name: Windows runs-on: windows-latest strategy: fail-fast: false matrix: architecture: # - '32' - '64' steps: - name: Set git to use LF run: | git config --global core.autocrlf false git config --global core.eol lf - name: Git checkout uses: actions/checkout@v3 - name: System Information run: | .\dev\ci\platform\coq-pf-01-sysinfo.bat - name: Download Platform env: # Use a dedicated branch that follows master with some lag (manually updated) PLATFORM: "https://github.com/coq/platform/archive/coq-ci.zip" run: | .\dev\ci\platform\coq-pf-02-download.bat - name: Build Platform env: ARCH: ${{matrix.architecture}} shell: cmd run: | .\dev\ci\platform\coq-pf-03-build.bat - name: Build Installer env: ARCH: ${{matrix.architecture}} shell: cmd run: | .\dev\ci\platform\coq-pf-04-installer.bat - name: Upload Installer uses: actions/upload-artifact@v3 with: name: windows-installer path: artifacts if-no-files-found: error coq-8.20.0/.github/workflows/stale.yml000066400000000000000000000006771466560755400176470ustar00rootroot00000000000000name: Stale PRs on: schedule: # Every workday at 2am - cron: '0 2 * * 1-5' permissions: contents: read jobs: stale_prs: # Do not run on forks (we want this request to happen only once every night) permissions: contents: none if: github.repository_owner == 'coq' runs-on: ubuntu-latest steps: - run: curl -d "coq:coq:${{ secrets.DAILY_SCHEDULE_SECRET }}" https://coqbot.herokuapp.com/check-stale-pr coq-8.20.0/.gitlab-ci.yml000066400000000000000000000605071466560755400150510ustar00rootroot00000000000000image: $BASE_IMAGE include: - local: '/dev/ci/gitlab-modes/protected-mode.yml' rules: - if: $CI_COMMIT_BRANCH == "master" - if: $CI_COMMIT_BRANCH =~ /^v.*\..*$/ - local: "/dev/ci/gitlab-modes/normal-mode.yml" rules: - if: $CI_COMMIT_BRANCH != "master" && $CI_COMMIT_BRANCH !~ /^v.*\..*$/ - local: "/dev/ci/gitlab-modes/tagged-runners.yml" rules: - if: $TAGGED_RUNNERS - local: "/dev/ci/gitlab-modes/untagged-runners.yml" rules: - if: $TAGGED_RUNNERS == null - local: '/dev/bench/gitlab-bench.yml' stages: - docker - build-0 - build-1 - build-2 - build-3+ - deploy # We set "needs" to contain all transitive dependencies. We include the # transitive dependencies as otherwise we don't get their artifacts # (eg if color had just needs: bignums it wouldn't get the artifact containing coq) # some default values variables: # Format: image_name-V$DATE-$hash # $DATE is so we can tell what's what in the image list # The $hash is the first 10 characters of the md5 of the Dockerfile. e.g. # echo $(md5sum dev/ci/docker/old_ubuntu_lts/Dockerfile | head -c 10) # echo $(md5sum dev/ci/docker/edge_ubuntu/Dockerfile | head -c 10) BASE_CACHEKEY: "old_ubuntu_lts-v8.20-V2024-01-08-011994e15c" EDGE_CACHEKEY: "edge_ubuntu-v8.20-V2024-02-08-3ed9c93d7c" BASE_IMAGE: "$CI_REGISTRY_IMAGE:$BASE_CACHEKEY" EDGE_IMAGE: "$CI_REGISTRY_IMAGE:$EDGE_CACHEKEY" # Used to select special compiler switches such as flambda, 32bits, etc... OPAM_VARIANT: "" GIT_DEPTH: "10" before_script: - dev/ci/gitlab-section.sh start before_script before_script - cat /proc/{cpu,mem}info || true - ulimit -s - ls -a # figure out if artifacts are around - printenv -0 | sort -z | tr '\0' '\n' - opam switch set -y "${COMPILER}${OPAM_VARIANT}" - eval $(opam env) - opam list - opam config list - dune printenv --root . - dev/tools/check-cachekey.sh - dev/ci/gitlab-section.sh end before_script # Regular "release" build of Coq, with final installed layout .build-template: stage: build-0 interruptible: true extends: .auto-use-tags variables: COQIDE: "opt" artifacts: name: "$CI_JOB_NAME" paths: - _install_ci # All those are for the test-suite jobs, to be discarded soon - config/Makefile - config/coq_config.py - config/coq_config.ml - config/coq_byte_config.ml - config/dune.c_flags expire_in: 1 month script: - PKGS=coq-core,coq-stdlib,coqide-server,coq - if [ "$COQIDE" != "no" ]; then PKGS=${PKGS},coqide; fi - dev/ci/gitlab-section.sh start coq.clean coq.clean - make clean # ensure that `make clean` works on a fresh clone - dev/ci/gitlab-section.sh end coq.clean - dev/ci/gitlab-section.sh start coq.config coq.config - ./configure -prefix "$(pwd)/_install_ci" $COQ_EXTRA_CONF - dev/ci/gitlab-section.sh end coq.config - dev/ci/gitlab-section.sh start coq.build coq.build - make dunestrap - dune build -p $PKGS - dev/ci/gitlab-section.sh end coq.build - dev/ci/gitlab-section.sh start coq.install coq.install - dune install --prefix="$(pwd)/_install_ci" $(sed -e 's/,/ /g' <<< ${PKGS}) - dev/ci/gitlab-section.sh end coq.install # Developer build, with build layout. Faster and useful for those # jobs needing _build .build-template:base:dev: stage: build-0 interruptible: true extends: .auto-use-tags script: - make $DUNE_TARGET - tar cfj _build.tar.bz2 _build variables: DUNE_TARGET: world artifacts: name: "$CI_JOB_NAME" when: always paths: - _build/log - _build.tar.bz2 - theories/dune - user-contrib/Ltac2/dune expire_in: 1 month .doc-template: stage: build-1 interruptible: true extends: .auto-use-tags needs: - build:base:dev script: - ulimit -S -s 16384 - tar xfj _build.tar.bz2 - make "$DUNE_TARGET" artifacts: when: always name: "$CI_JOB_NAME" expire_in: 2 months # The used Coq must be set explicitly for each job with "needs:". # We add a spurious dependency `not-a-real-job` that must be # overridden otherwise the CI will fail (to help debugging missing needs). # set "needs" when using .test-suite-template: stage: build-1 interruptible: true extends: .auto-use-tags needs: - not-a-real-job script: - cd test-suite - make clean - export OCAMLPATH=$(readlink -f ../_install_ci/lib/):"$OCAMLPATH" - COQEXTRAFLAGS="${COQEXTRAFLAGS}" make -j "$NJOBS" TIMED=1 all artifacts: name: "$CI_JOB_NAME.logs" when: on_failure paths: - test-suite/logs # Gitlab doesn't support yet "expire_in: never" so we use the instance default # expire_in: never # set "needs" when using .validate-template: stage: build-1 interruptible: true extends: .auto-use-tags needs: - not-a-real-job script: - cd _install_ci - find lib/coq/ -name '*.vo' -fprint0 vofiles - xargs -0 --arg-file=vofiles bin/coqchk -o -m -coqlib lib/coq/ > ../coqchk.log 2>&1 || touch coqchk.failed - tail -n 1000 ../coqchk.log # the log is too big for gitlab so pipe to a file and display the tail - "[ ! -f coqchk.failed ]" # needs quoting for yml syntax reasons artifacts: name: "$CI_JOB_NAME.logs" when: always paths: - coqchk.log expire_in: 2 months # This template defaults to "needs: build:base" # Remember to include it as a transitive dependency if you want additional "needs:" .ci-template: stage: build-1 interruptible: true extends: .auto-use-tags script: - ulimit -S -s 16384 # For flambda + native - make -f Makefile.ci -j "$NJOBS" "${CI_JOB_NAME#*:}" artifacts: name: "$CI_JOB_NAME" paths: - _build_ci exclude: # reduce artifact size - _build_ci/**/.git # exclude .git directory itself as well - _build_ci/**/.git/**/* when: always needs: - build:base only: &full-ci variables: - $FULL_CI == "true" .ci-template-flambda: extends: .ci-template image: $EDGE_IMAGE needs: - build:edge+flambda variables: OPAM_VARIANT: "+flambda" .deploy-template: stage: deploy extends: .auto-use-tags before_script: - which ssh-agent || ( apt-get update -y && apt-get install openssh-client -y ) - eval $(ssh-agent -s) - mkdir -p ~/.ssh - chmod 700 ~/.ssh - ssh-keyscan -t rsa github.com >> ~/.ssh/known_hosts - git config --global user.name "coqbot" - git config --global user.email "coqbot@users.noreply.github.com" .pkg:opam-template: stage: build-0 image: $EDGE_IMAGE interruptible: true extends: .auto-use-tags # OPAM will build out-of-tree so no point in importing artifacts script: - opam pin add --kind=path coq-core.dev . - opam pin add --kind=path coq-stdlib.dev . - opam pin add --kind=path coqide-server.dev . - opam pin add --kind=path coqide.dev . variables: OPAM_VARIANT: "+flambda" only: *full-ci .nix-template: stage: build-0 needs: [] interruptible: true image: nixos/nix:latest extends: .auto-use-tags variables: GIT_STRATEGY: none # Required because we don't have git USER: root # Variable required by Cachix before_script: - cat /proc/{cpu,mem}info || true # Use current worktree as tmpdir to allow exporting artifacts in case of failure - export TMPDIR=$PWD # Install Cachix - nix-env -iA nixpkgs.cachix - cachix use coq artifacts: name: "$CI_JOB_NAME.logs" when: on_failure paths: - nix-build-coq.drv-0/*/test-suite/logs # Gitlab doesn't support yet "expire_in: never" so we use the instance default # expire_in: never ############################################################################## ########################## End of templates ################################## ############################################################################## docker-boot: stage: docker image: docker:stable services: - docker:dind before_script: [] script: - dev/tools/check-cachekey.sh - docker login -u gitlab-ci-token -p "$CI_JOB_TOKEN" "$CI_REGISTRY" - cd dev/ci/docker/old_ubuntu_lts - if docker pull "$BASE_IMAGE"; then echo "Base image prebuilt!"; else docker build -t "$BASE_IMAGE" .; docker push "$BASE_IMAGE"; fi - cd ../edge_ubuntu - if docker pull "$EDGE_IMAGE"; then echo "Edge image prebuilt!"; else docker build -t "$EDGE_IMAGE" .; docker push "$EDGE_IMAGE"; fi except: variables: - $SKIP_DOCKER == "true" extends: .auto-use-docker-tags timeout: 2h build:base: extends: .build-template variables: COQ_EXTRA_CONF: "-native-compiler yes" only: *full-ci # no coqide for 32bit: libgtk installation problems build:base+32bit: extends: .build-template variables: OPAM_VARIANT: "+32bit" COQ_EXTRA_CONF: "-native-compiler yes" COQIDE: "no" only: *full-ci build:edge+flambda: extends: .build-template image: $EDGE_IMAGE variables: OPAM_VARIANT: "+flambda" COQ_EXTRA_CONF: "-native-compiler yes" only: *full-ci build:base:dev: extends: .build-template:base:dev # Build using native dune rules build:base:dev:dune: stage: build-0 image: $EDGE_IMAGE variables: OPAM_VARIANT: "+flambda" interruptible: true extends: .auto-use-tags script: - cp theories/dune.disabled theories/dune - cp user-contrib/Ltac2/dune.disabled user-contrib/Ltac2/dune - dune build -p coq-core,coq-stdlib,coq,coqide-server - ls _build/install/default/lib/coq/theories/Reals/Reals.vo - ls _build/install/default/lib/coq/user-contrib/Ltac2/Ltac2.vo only: *full-ci build:base+async: extends: .build-template variables: COQ_EXTRA_CONF: "-native-compiler yes" COQ_DUNE_EXTRA_OPT: "-async" after_script: - dmesg > dmesg.txt allow_failure: true # See https://github.com/coq/coq/issues/9658 only: variables: - $UNRELIABLE =~ /enabled/ && $FULL_CI == "true" artifacts: when: always paths: - _install_ci # All those are for the test-suite jobs, to be discarded once we have dune for the test-suite - config/Makefile - config/coq_config.py - config/coq_config.ml - config/coq_byte_config.ml - config/dune.c_flags - dmesg.txt timeout: 1h 30min lint: stage: build-0 image: $EDGE_IMAGE script: dev/lint-repository.sh extends: .auto-use-tags variables: GIT_DEPTH: "" # we need an unknown amount of history for per-commit linting OPAM_VARIANT: "+flambda" # pkg:opam: # extends: .pkg:opam-template pkg:opam:native: extends: .pkg:opam-template before_script: - opam install -y coq-native after_script: - eval $(opam env) - echo "Definition f x := x + x." > test_native.v - coqc -native-compiler yes test_native.v - test -f .coq-native/Ntest_native.cmxs # broken, see eg https://gitlab.com/coq/coq/-/jobs/1754045983 # pkg:nix:deploy: # extends: .nix-template # environment: # name: cachix # url: https://coq.cachix.org # script: # - nix-build https://coq.inria.fr/nix/toolbox --argstr job coq --arg override "{coq = coq:$CI_COMMIT_SHA;}" -K | cachix push coq # only: # refs: # - master # - /^v.*\..*$/ # variables: # - $CACHIX_AUTH_TOKEN # pkg:nix:deploy:channel: # extends: .deploy-template # environment: # name: cachix # url: https://coq.cachix.org # only: # refs: # Repeat conditions from pkg:nix:deploy # - master # - /^v.*\..*$/ # variables: # - $CACHIX_AUTH_TOKEN && $CACHIX_DEPLOYMENT_KEY # # if the $CACHIX_AUTH_TOKEN variable isn't set, the job it depends on doesn't exist # needs: # - pkg:nix:deploy # script: # - echo "$CACHIX_DEPLOYMENT_KEY" | tr -d '\r' | ssh-add - > /dev/null # # Remove all pr branches because they could be missing when we run git fetch --unshallow # - git branch --list 'pr-*' | xargs -r git branch -D # - git fetch --unshallow # - git branch -v # - git push git@github.com:coq/coq-on-cachix "${CI_COMMIT_SHA}":"refs/heads/${CI_COMMIT_REF_NAME}" pkg:nix: extends: .nix-template script: - nix-build "$CI_PROJECT_URL/-/archive/$CI_COMMIT_SHA.tar.gz" -K only: *full-ci doc:refman: extends: .doc-template variables: DUNE_TARGET: refman-html artifacts: paths: - _build/log - _build/default/doc/refman-html doc:refman-pdf: extends: .doc-template variables: DUNE_TARGET: refman-pdf artifacts: paths: - _build/log - _build/default/doc/refman-pdf doc:stdlib: extends: .doc-template variables: DUNE_TARGET: stdlib-html artifacts: paths: - _build/log - _build/default/doc/stdlib/html doc:refman:deploy: extends: .deploy-template environment: name: deployment url: https://coq.github.io/ only: variables: - $DOCUMENTATION_DEPLOY_KEY needs: - doc:ml-api:odoc - doc:refman - doc:stdlib script: - echo "$DOCUMENTATION_DEPLOY_KEY" | tr -d '\r' | ssh-add - > /dev/null - git clone git@github.com:coq/doc.git _deploy - rm -rf _deploy/$CI_COMMIT_REF_NAME/api - rm -rf _deploy/$CI_COMMIT_REF_NAME/refman - rm -rf _deploy/$CI_COMMIT_REF_NAME/stdlib - mkdir -p _deploy/$CI_COMMIT_REF_NAME - cp -rv _build/default/_doc/_html _deploy/$CI_COMMIT_REF_NAME/api - cp -rv _build/default/doc/refman-html _deploy/$CI_COMMIT_REF_NAME/refman - cp -rv _build/default/doc/stdlib/html _deploy/$CI_COMMIT_REF_NAME/stdlib - cd _deploy/$CI_COMMIT_REF_NAME/ - git add api refman stdlib - git commit -m "Documentation of branch “$CI_COMMIT_REF_NAME” at $CI_COMMIT_SHORT_SHA" - git push # TODO: rebase and retry on failure doc:ml-api:odoc: extends: .doc-template variables: DUNE_TARGET: apidoc artifacts: paths: - _build/log - _build/default/_doc/ test-suite:base: extends: .test-suite-template needs: - build:base only: *full-ci test-suite:base+32bit: extends: .test-suite-template needs: - build:base+32bit variables: OPAM_VARIANT: "+32bit" only: *full-ci test-suite:edge+flambda: extends: .test-suite-template image: $EDGE_IMAGE needs: - build:edge+flambda variables: OPAM_VARIANT: "+flambda" only: *full-ci test-suite:base:dev: stage: build-1 interruptible: true extends: .auto-use-tags needs: - build:base:dev script: - tar xfj _build.tar.bz2 - make test-suite artifacts: name: "$CI_JOB_NAME.logs" when: on_failure paths: - _build/default/test-suite/logs # Gitlab doesn't support yet "expire_in: never" so we use the instance default # expire_in: never .test-suite:ocaml+beta+dune-template: stage: build-1 # even though it has no deps we put it with the other test suite jobs needs: - docker-boot interruptible: true script: - opam switch create $OCAMLVER --empty - eval $(opam env) - opam repo add ocaml-beta https://github.com/ocaml/ocaml-beta-repository.git - opam update - opam install ocaml-variants=$OCAMLVER - opam install dune zarith - eval $(opam env) - export COQ_UNIT_TEST=noop - make test-suite artifacts: name: "$CI_JOB_NAME.logs" when: always paths: - _build/log - _build/default/test-suite/logs expire_in: 2 week allow_failure: true test-suite:base+async: extends: .test-suite-template needs: - build:base variables: COQEXTRAFLAGS: "-async-proofs on -async-proofs-cache force" allow_failure: true only: variables: - $UNRELIABLE =~ /enabled/ && $FULL_CI == "true" validate:base: extends: .validate-template needs: - build:base only: *full-ci validate:base+32bit: extends: .validate-template needs: - build:base+32bit variables: OPAM_VARIANT: "+32bit" only: *full-ci validate:edge+flambda: extends: .validate-template image: $EDGE_IMAGE needs: - build:edge+flambda variables: OPAM_VARIANT: "+flambda" only: *full-ci # Libraries are by convention the projects that depend on Coq # but not on its ML API library:ci-argosy: extends: .ci-template library:ci-autosubst: extends: .ci-template-flambda library:ci-bbv: extends: .ci-template library:ci-bedrock2: extends: .ci-template-flambda variables: NJOBS: "1" needs: - build:edge+flambda - library:ci-coqutil - library:ci-kami - library:ci-riscv_coq stage: build-3+ timeout: 2h library:ci-category_theory: extends: .ci-template needs: - build:base - plugin:ci-equations stage: build-2 library:ci-color: extends: .ci-template-flambda needs: - build:edge+flambda - plugin:ci-bignums stage: build-2 library:ci-compcert: extends: .ci-template-flambda needs: - build:edge+flambda - library:ci-flocq - library:ci-menhir stage: build-2 library:ci-coq_performance_tests: extends: .ci-template library:ci-coq_tools: extends: .ci-template library:ci-coqprime: extends: .ci-template-flambda needs: - build:edge+flambda - plugin:ci-bignums stage: build-2 library:ci-coqtail: extends: .ci-template library:ci-coquelicot: extends: .ci-template-flambda needs: - build:edge+flambda - library:ci-mathcomp stage: build-3+ library:ci-coqutil: extends: .ci-template-flambda library:ci-cross_crypto: extends: .ci-template library:ci-engine_bench: extends: .ci-template library:ci-ext_lib: extends: .ci-template-flambda library:ci-fcsl_pcm: extends: .ci-template-flambda needs: - build:edge+flambda - library:ci-mathcomp_1 stage: build-2 library:ci-fiat_crypto: extends: .ci-template-flambda variables: COQEXTRAFLAGS: "-async-proofs-tac-j 0" needs: - build:edge+flambda - library:ci-coqprime - library:ci-rupicola - plugin:ci-rewriter stage: build-3+ timeout: 3h library:ci-fiat_crypto_legacy: extends: .ci-template-flambda timeout: 1h 30min # We cannot use flambda due to # https://github.com/ocaml/ocaml/issues/7842, see # https://github.com/coq/coq/pull/11916#issuecomment-609977375 library:ci-fiat_crypto_ocaml: extends: .ci-template-flambda needs: - build:edge+flambda - library:ci-fiat_crypto stage: build-3+ artifacts: paths: [] # These artifacts would go over the size limit library:ci-flocq: extends: .ci-template-flambda library:ci-kami: extends: .ci-template-flambda library:ci-menhir: extends: .ci-template-flambda library:ci-oddorder: extends: .ci-template-flambda needs: - build:edge+flambda - plugin:ci-elpi_hb - library:ci-mathcomp stage: build-3+ library:ci-fourcolor: extends: .ci-template-flambda needs: - build:edge+flambda - plugin:ci-elpi_hb - library:ci-mathcomp stage: build-3+ library:ci-corn: extends: .ci-template-flambda needs: - build:edge+flambda - plugin:ci-bignums - library:ci-math_classes stage: build-3+ library:ci-hott: extends: .ci-template library:ci-iris: extends: .ci-template-flambda needs: - build:edge+flambda - library:ci-autosubst stage: build-2 library:ci-math_classes: extends: .ci-template-flambda needs: - build:edge+flambda - plugin:ci-bignums stage: build-2 library:ci-mathcomp: extends: .ci-template-flambda needs: - build:edge+flambda - plugin:ci-elpi_hb # for Hierarchy Builder stage: build-2 library:ci-mathcomp_1: extends: .ci-template-flambda library:ci-mathcomp_test: extends: .ci-template-flambda needs: - build:edge+flambda - plugin:ci-elpi_hb - library:ci-mathcomp stage: build-3+ library:ci-mczify: extends: .ci-template-flambda needs: - build:edge+flambda - plugin:ci-elpi_hb - library:ci-mathcomp stage: build-3+ library:ci-finmap: extends: .ci-template-flambda needs: - build:edge+flambda - library:ci-mathcomp stage: build-3+ library:ci-bigenough: extends: .ci-template-flambda needs: - build:edge+flambda - library:ci-mathcomp stage: build-3+ library:ci-analysis: extends: .ci-template-flambda needs: - build:edge+flambda - library:ci-mathcomp - library:ci-finmap - library:ci-bigenough - plugin:ci-elpi_hb # for Hierarchy Builder stage: build-3+ library:ci-neural_net_interp: extends: .ci-template library:ci-paco: extends: .ci-template-flambda library:ci-itree: extends: .ci-template-flambda needs: - build:edge+flambda - library:ci-ext_lib - library:ci-paco stage: build-2 library:ci-itree_io: extends: .ci-template-flambda needs: - build:edge+flambda - library:ci-simple_io - library:ci-itree stage: build-3+ library:ci-simple_io: extends: .ci-template-flambda needs: - build:edge+flambda - library:ci-ext_lib stage: build-2 library:ci-sf: extends: .ci-template library:ci-stdlib2: extends: .ci-template-flambda library:ci-tlc: extends: .ci-template library:ci-unimath: extends: .ci-template-flambda library:ci-verdi_raft: extends: .ci-template-flambda library:ci-vst: extends: .ci-template-flambda variables: NJOBS: "1" needs: - build:edge+flambda - library:ci-flocq - library:ci-menhir - library:ci-compcert stage: build-3+ timeout: 2h library:ci-deriving: extends: .ci-template-flambda needs: - build:edge+flambda - plugin:ci-elpi_hb - library:ci-mathcomp stage: build-3+ library:ci-mathcomp_word: extends: .ci-template-flambda needs: - build:edge+flambda - library:ci-mathcomp_1 stage: build-2 library:ci-jasmin: extends: .ci-template-flambda needs: - build:edge+flambda - library:ci-mathcomp_1 - library:ci-mathcomp_word stage: build-3+ library:ci-coq_library_undecidability: extends: .ci-template needs: - build:base - plugin:ci-equations - plugin:ci-metacoq stage: build-3+ library:ci-http: extends: .ci-template-flambda needs: - build:edge+flambda - library:ci-menhir - library:ci-itree_io - plugin:ci-quickchick stage: build-3+ library:ci-trakt: extends: .ci-template-flambda needs: - build:edge+flambda - plugin:ci-elpi_hb stage: build-2 # Plugins are by definition the projects that depend on Coq's ML API plugin:ci-aac_tactics: extends: .ci-template-flambda plugin:ci-atbr: extends: .ci-template-flambda plugin:ci-autosubst_ocaml: extends: .ci-template-flambda plugin:ci-itauto: extends: .ci-template plugin:ci-bignums: extends: .ci-template-flambda plugin:ci-coinduction: extends: .ci-template-flambda plugin:ci-coq_dpdgraph: extends: .ci-template plugin:ci-coqhammer: extends: .ci-template-flambda plugin:ci-elpi_hb: extends: .ci-template-flambda plugin:ci-elpi_test: extends: .ci-template-flambda needs: - build:edge+flambda - plugin:ci-elpi_hb stage: build-2 plugin:ci-hb_test: extends: .ci-template-flambda needs: - build:edge+flambda - plugin:ci-elpi_hb stage: build-2 plugin:ci-equations: extends: .ci-template plugin:ci-equations_test: extends: .ci-template needs: - build:base - plugin:ci-equations stage: build-2 plugin:ci-fiat_parsers: extends: .ci-template plugin:ci-lean_importer: extends: .ci-template plugin:ci-ltac2_compiler: extends: .ci-template plugin:ci-metacoq: extends: .ci-template needs: - build:base - plugin:ci-equations stage: build-2 timeout: 1h 30min plugin:ci-mtac2: extends: .ci-template plugin:ci-paramcoq: extends: .ci-template plugin:ci-perennial: extends: .ci-template-flambda plugin:plugin-tutorial: stage: build-0 interruptible: true extends: .auto-use-tags script: - ./configure -prefix "$(pwd)/_install_ci" - make -j "$NJOBS" plugin-tutorial plugin:ci-quickchick: extends: .ci-template-flambda needs: - build:edge+flambda - library:ci-ext_lib - library:ci-simple_io - library:ci-mathcomp_1 stage: build-3+ plugin:ci-quickchick_test: extends: .ci-template-flambda needs: - build:edge+flambda - plugin:ci-quickchick stage: build-3+ plugin:ci-reduction_effects: extends: .ci-template plugin:ci-relation_algebra: extends: .ci-template-flambda needs: - build:edge+flambda - plugin:ci-elpi_hb - library:ci-mathcomp - plugin:ci-aac_tactics stage: build-3+ plugin:ci-rewriter: extends: .ci-template-flambda library:ci-riscv_coq: extends: .ci-template-flambda needs: - build:edge+flambda - library:ci-coqutil stage: build-2 library:ci-rupicola: extends: .ci-template-flambda needs: - build:edge+flambda - library:ci-bedrock2 stage: build-3+ plugin:ci-coq_lsp: extends: .ci-template-flambda plugin:ci-serapi: extends: .ci-template-flambda needs: - build:edge+flambda - plugin:ci-coq_lsp stage: build-2 plugin:ci-vscoq: extends: .ci-template-flambda plugin:ci-smtcoq: extends: .ci-template plugin:ci-stalmarck: extends: .ci-template plugin:ci-tactician: extends: .ci-template-flambda plugin:ci-waterproof: extends: .ci-template-flambda coq-8.20.0/.ocp-indent000066400000000000000000000000211466560755400144370ustar00rootroot00000000000000strict_with=auto coq-8.20.0/CODE_OF_CONDUCT.md000066400000000000000000000174161466560755400152150ustar00rootroot00000000000000# Coq Code of Conduct # The Coq development team and the user community are made up of a mixture of professionals and volunteers from all over the world. Diversity brings variety of perspectives that can be very valuable, but it can also lead to communication issues and unhappiness. Therefore, we have a few ground rules that we ask people to adhere to. These rules apply equally to core developers (who should lead by example), occasional contributors and those seeking help and guidance. Their goal is that everyone feels safe and welcome when contributing to Coq or interacting with others in Coq related forums. These rules apply to all spaces managed by the Coq development team. This includes the GitHub repository, the Discourse forum, the Zulip chat, the mailing lists, physical events like Coq working groups and workshops, and any other forums created or managed by the development team which the community uses for communication. In addition, violations of these rules outside these spaces may affect a person's ability to participate within them. - **Be friendly and patient.** - **Be welcoming.** We strive to be a community that welcomes and supports people of all backgrounds and identities. This includes, but is not limited to people of any origin, color, status, educational level, gender identity, sexual orientation, age, culture and beliefs, and mental and physical ability. - **Be considerate.** Your work will be used by other people, and you in turn will depend on the work of others. Any decision you take will affect users and colleagues, and you should take those consequences into account when making decisions. - **Be respectful.** Not all of us will agree all the time, but disagreement is no excuse for poor behavior and poor manners. We might all experience some frustration now and then, but we cannot allow that frustration to turn into a personal attack. It's important to remember that a community where people feel uncomfortable or threatened is not a productive one. Members of the Coq development team and user community should be respectful when dealing with other members as well as with people outside the community. - **Be careful in the words that you choose.** Be kind to others. Do not insult or put down other participants. Harassment and other exclusionary behavior aren't acceptable. * Violent language or threats or personal insults have no chance to resolve a dispute or to let a discussion flourish. Worse, they can hurt durably, or generate durable fears. They are thus unwelcome. * Not everyone is comfortable with sexually explicit or violent material, even as a joke. In an online open multicultural world, you don't know who might be listening. So be cautious and responsible with your words. * Discussions are online and recorded for posterity; we all have our right for privacy and online gossiping as well as posting or threatening to post other people's personally identifying information is prohibited. - **Remember that what you write in a public online forum might be read by many people you don't know.** Consider what image your words will give to outsiders of the development team / the user community as a whole. Try to avoid references to private knowledge to be understandable by anyone. - **Coq online forums are only to discuss Coq-related subjects.** Unrelated political discussions or long digressions are unwelcome, even for illustration or comparison purposes. - **When we disagree, try to understand why.** Disagreements, both social and technical, happen all the time and Coq is no exception. It is important that we resolve disagreements and differing views constructively. Remember that we are different. Different people have different perspectives on issues. Being unable to understand why someone holds a viewpoint doesn't mean that they're wrong. - **It is human to make errors, and please try not to take things personally.** Please do not answer aggressively to problematic behavior and simply signal the issue. If actions have been taken with you (e.g. bans or simple demands of apology, of rephrasing or keeping personal beliefs or troubles private), please understand that they are not intended as aggression or punishment ― even if they feel harsh to you ― but as ways to enforce a calm communication for the other participants and to give you the opportunity to change your behavior. We understand you may feel hurt, or maybe you had a bad day, so please take this opportunity to question yourself, cool down if necessary and do not persist in the exact same behavior you have been reported for. ## Interaction on Coq forums (Zulip, Discourse, etc.) ## Anyone is welcome to ask questions and bring answers, provided they respect the aforementioned rules. In addition we ask that - you do your best to put your questions into their context by providing Coq code or pointers to it, and enough indications to understand where the Coq goals or error message come from. - if you are running through educational material, we kindly ask you to explicitly state it, and that answers do not solve such exercises for you, but only provide hints. Admins and moderators will, at their discretion, review and remove some content, and provide indications or warnings to users. Repeatedly not taking into accounts these warnings may result into a temporary or permanent ban. Based on forum histories, short technical questions with brief code examples in the proper context are the most likely to receive useful answers. In contrast, long and open-ended questions or comments usually see less engagement. This is not to say that long questions or comments that otherwise abide by the rules are discouraged, only that users should carefully set expectations about what answers they are likely to receive. ## Enforcement ## If you believe someone is violating the code of conduct, we ask that you report it by emailing the Coq Code of Conduct enforcement team at or, at your discretion, any member of the team. Confidentiality with regard to the reporter of an incident will be maintained while dealing with it. In particular, you should seek support from the team instead of dealing by yourself with a behavior that you consider hurtful. This applies to members of the enforcement team as well, who shouldn't deal by themselves with violations in discussions in which they are a participant. Depending on the violation, the team can choose to address a private or public warning to the offender, request an apology, or ban them for a short or a long period from interacting on one or all of our forums. Except in case of serious violations, the team will always try a pedagogical approach first (the offender does not necessarily realize immediately why their behavior is wrong). We consider short bans to form part of the pedagogical approach, especially when they come with explanatory comments, as this can give some time to the offender to calm down and think about their actions. The members of the team are currently: - Matthieu Sozeau - Nicolas Tabareau - Théo Zimmermann ## Questions? ## If you have questions, feel free to write to . ## Attribution ## This text is adapted from the [Django Code of Conduct][django-code-of-conduct] which itself was adapted from the Speak Up! Community Code of Conduct. ## License ## Creative Commons License
This work is licensed under a Creative Commons Attribution 4.0 International License . [django-code-of-conduct]: https://web.archive.org/web/20180714161115/https://www.djangoproject.com/conduct/ coq-8.20.0/CONTRIBUTING.md000066400000000000000000002112051466560755400146370ustar00rootroot00000000000000# Guide to contributing to Coq # ## Foreword ## As with any documentation, this guide is most useful if it's promptly updated to reflect changes in processes, development tools, or the Coq ecosystem. If you notice anything inaccurate or outdated, please signal it in a new issue, or fix it in a new pull request. If you find some parts are not sufficiently clear, you may open an issue as well. ## Table of contents ## - [Guide to contributing to Coq](#guide-to-contributing-to-coq) - [Foreword](#foreword) - [Table of contents](#table-of-contents) - [Introduction](#introduction) - [Contributing to the ecosystem](#contributing-to-the-ecosystem) - [Asking and answering questions](#asking-and-answering-questions) - [Writing tutorials and blog posts](#writing-tutorials-and-blog-posts) - [Contributing to the wiki](#contributing-to-the-wiki) - [Creating and maintaining Coq packages](#creating-and-maintaining-coq-packages) - [Distribution of Coq packages](#distribution-of-coq-packages) - [Support for plugin and library authors](#support-for-plugin-and-library-authors) - [Standard libraries](#standard-libraries) - [Maintaining existing packages in coq-community](#maintaining-existing-packages-in-coq-community) - [Contributing to the editor support packages](#contributing-to-the-editor-support-packages) - [Contributing to the website or the package archive](#contributing-to-the-website-or-the-package-archive) - [Other ways of creating content](#other-ways-of-creating-content) - [Issues](#issues) - [Reporting a bug, requesting an enhancement](#reporting-a-bug-requesting-an-enhancement) - [Beta testing](#beta-testing) - [Helping triage existing issues](#helping-triage-existing-issues) - [Code changes](#code-changes) - [Using GitHub pull requests](#using-github-pull-requests) - [Fixing bugs and performing small changes](#fixing-bugs-and-performing-small-changes) - [Proposing large changes: Coq Enhancement Proposals](#proposing-large-changes-coq-enhancement-proposals) - [Seeking early feedback on work-in-progress](#seeking-early-feedback-on-work-in-progress) - [Taking feedback into account](#taking-feedback-into-account) - [Understanding automatic feedback](#understanding-automatic-feedback) - [Test-suite failures](#test-suite-failures) - [Linter failures](#linter-failures) - [Plugin failures](#plugin-failures) - [Library failures](#library-failures) - [Understanding reviewers' feedback](#understanding-reviewers-feedback) - [Fixing your branch](#fixing-your-branch) - [Improving the official documentation](#improving-the-official-documentation) - [Contributing to the standard library](#contributing-to-the-standard-library) - [Becoming a maintainer](#becoming-a-maintainer) - [Reviewing pull requests](#reviewing-pull-requests) - [Collaborating on a pull request](#collaborating-on-a-pull-request) - [Merging pull requests](#merging-pull-requests) - [Additional notes for pull request reviewers and assignees](#additional-notes-for-pull-request-reviewers-and-assignees) - [Joining / leaving maintainer teams](#joining--leaving-maintainer-teams) - [Core development team](#core-development-team) - [Release management](#release-management) - [Packaging Coq](#packaging-coq) - [Additional resources](#additional-resources) - [Developer documentation](#developer-documentation) - [Where to find the resources](#where-to-find-the-resources) - [Building Coq](#building-coq) - [Continuous integration](#continuous-integration) - [Restarting failed jobs](#restarting-failed-jobs) - [Code owners, issue and pull request templates](#code-owners-issue-and-pull-request-templates) - [Style guide](#style-guide) - [OCaml resources](#ocaml-resources) - [Git documentation, tips and tricks](#git-documentation-tips-and-tricks) - [GitHub documentation, tips and tricks](#github-documentation-tips-and-tricks) - [Watching the repository](#watching-the-repository) - [Draft pull requests](#draft-pull-requests) - [Turning a PR into draft mode](#turning-a-pr-into-draft-mode) - [GitLab documentation, tips and tricks](#gitlab-documentation-tips-and-tricks) - [Merge script dependencies](#merge-script-dependencies) - [Coqbot](#coqbot) - [Online forum and chat to talk to developers](#online-forum-and-chat-to-talk-to-developers) - [Coq calls](#coq-calls) - [Coq remote working groups](#coq-remote-working-groups) - [Coq Users and Developers Workshops](#coq-users-and-developers-workshops) ## Introduction ## Thank you for your interest in contributing to Coq! There are many ways to contribute, and we appreciate all of them. People often begin by making small contributions, and contributions to the ecosystem, before working their way up incrementally to the core parts of the system, and start to propose larger changes, or take an active role in maintaining the system. So this is the way this contributing guide is organized. However, it is by no means necessary that you go through these steps in this order. Feel free to use this guide as a reference and quickly jump to the part that is most relevant to you at the current time. We want to make sure that contributing to Coq is a fun and positive experience for everyone, so please make sure you read and abide by our [Code of Conduct][Code-of-conduct]. ## Contributing to the ecosystem ## In this section, we present all the ways to contribute to Coq outside of the Coq repository itself. ### Asking and answering questions ### One very important way of contributing is by asking and answering questions, in order to create a body of easily-browsable, problem-oriented, additional documentation. There are many platforms for this purpose: - Our [Zulip chat][Zulip], which contains a main "#Coq users" stream, but also many other streams dedicated to specific Coq packages, such as Equations, MathComp, etc. - Our [Discourse forum][Discourse], which contains a main "Using Coq" category, but also categories dedicated to asking questions in other languages than English. They have yet to find their public, so do not hesitate to advertise them to people you know who might not be at ease with English. - The [Proof Assistants Stack Exchange][Proof-Assistants-SE], a Q&A site for users of proof assistants, including Coq. - Other [Stack Exchange][Stack-Exchange] sites, and particularly [Stack Overflow][Stack-Overflow], receive questions about Coq. Questions asked anywhere on Stack Exchange with the `coq` tag are automatically relayed to Zulip in a [dedicated topic][Stack-Exchange-to-Zulip]. Other active places to answer questions include the [Coq-Club][] mailing list, the [Coq IRC channel][IRC], the [/r/Coq subreddit][Reddit], etc. ### Writing tutorials and blog posts ### Writing about Coq, in the form of tutorials or blog posts, is also a very important contribution. In particular, it can help new users get interested in Coq, and learn about it, and existing users learn about advance features. Our official resources, such as the [reference manual][refman] are not suited for learning Coq, but serve as reference documentation to which you can link from your tutorials. The Coq website has a page listing known [tutorials][Coq-documentation] and the [wiki][] home page contains a list too. You can expand the former through a pull request on the [Coq website repository][Coq-website-repository], while the latter can be edited directly by anyone with a GitHub account. At the current time, we do not have a way of aggregating blog posts on a single page (like [OCaml planet][OCaml-planet]), but this would probably be something useful to get, so do not hesitate if you want to create it. Some people use [Reddit][] for this purpose. ### Contributing to the wiki ### Coq's [wiki][] is an informal source of additional documentation which anyone with a GitHub account can edit directly. In particular, it contains the Coq [FAQ][] which has not seen so many updates in the recent years. You should feel free to fix it, expand it, and even refactor it (if you are not sure if some changes would be welcome, you can open an issue to discuss them before performing them). People who watch the Coq repository will see recent wiki edits in their GitHub feed. It is recommended to review them *a posteriori* to check no mistake was introduced. The wiki is also a standard git repository, so people can follow the changes using any standard git tool. Coq's wiki is formatted using GitHub's flavored Markdown, with some wiki-specific extensions. See: - [GitHub's Markdown guide][GitHub-markdown] - [GitHub's wiki extensions][GitHub-wiki-extensions] ### Creating and maintaining Coq packages ### *Note: this sub-section is about packages extending Coq, such as plugins or libraries. A different, but also very valuable, contribution is to package Coq for your preferred package manager (see [Packaging Coq](#packaging-coq)).* Sharing reusable assets in the form of new libraries, plugins, and tools is great so that others can start building new things on top. Having an extensive and healthy package ecosystem is key to the success of Coq. #### Distribution of Coq packages #### You can distribute your library or plugin through the [Coq package index][Coq-package-index]. Important packages and tools can be advertised on the [Awesome Coq][Awesome-Coq] list. Some packages are distributed along Coq, within the [Coq Platform][Coq-Platform]. Check the Platform's charter if you consider adding your package to it. #### Support for plugin and library authors #### You can find advice and best practices about maintaining a Coq project on the [coq-community wiki][coq-community-wiki]. Learn how to write a Coq plugin, and about best practices, in the Coq [plugin tutorial][plugin-tutorial]. This tutorial is still a work in progress, so do not hesitate to expand it, or ask questions. If you want quick feedback on best practices, or how to talk to the Coq API, a good place to hang out is the [Coq devs & plugin devs stream][Zulip-dev] of our Zulip chat. Finally, we strongly encourage authors of plugins to submit their plugins to join Coq's continuous integration (CI) early on. Indeed, the Coq API gets continuously reworked, so this is the best way of ensuring your plugin stays compatible with new Coq versions, as this means Coq developers will fix your plugin for you. Learn more about this in the [CI README (user part)][CI-README-users]. Pure Coq libraries are also welcome to join Coq's CI, especially if they test underused / undertested features. #### Standard libraries #### There are many general purpose Coq libraries, so before you publish yours, consider whether you could contribute to an existing one instead (either the official [standard library](#contributing-to-the-standard-library), or one of the many [alternative standard libraries][other-standard-libraries]). #### Maintaining existing packages in coq-community #### Some Coq packages are not maintained by their initial authors anymore (for instance if they've moved on to new jobs or new projects) even if they were useful, or interesting. The coq-community organization is a place for volunteers to take over the maintenance of such packages. If you want to contribute by becoming a maintainer, there is [a list of packages waiting for a maintainer][coq-community-maintainer-wanted]. You can also propose a package that is not listed. Find out more about coq-community in [the manifesto's README][coq-community-manifesto]. ### Contributing to the editor support packages ### Besides CoqIDE, whose sources are available in this repository, and to which you are welcome to contribute, there are a number of alternative user interfaces for Coq, more often as an editor support package. Here are the URLs of the repositories of the various editor support packages: - Proof-General (Emacs major mode) - Company-coq (Emacs minor mode) - Coqtail (Vim) - VsCoq Reloaded (VsCode) And here are alternative user interfaces to be run in the web browser: - JsCoq (Coq executed in your browser) - Jupyter kernel for Coq Each of them has their own contribution process. ### Contributing to the website or the package archive ### The website and the package archive have their own repositories: - - You can contribute to them by using issues and pull requests on these repositories. These repositories should get their own contributing guides, but they don't have any at the time of writing this. ### Other ways of creating content ### There are many other ways of creating content and making the Coq community thrive, including many which we might not have thought about. Feel free to add more references / ideas to this sub-section. You can tweet about Coq, you can give talks about Coq both in academic, and in non-academic venues (such as developer conferences). [Codewars][] is a platform where people can try to solve some programming challenges that were proposed by other community members. Coq is supported and the community is eager to get more challenges. ## Issues ## ### Reporting a bug, requesting an enhancement ### Bug reports are enormously useful to identify issues with Coq; we can't fix what we don't know about. To report a bug, please open an issue in the [Coq issue tracker][Coq-issue-tracker] (you'll need a GitHub account). You can file a bug for any of the following: - An anomaly. These are always considered bugs, so Coq will even ask you to file a bug report! - An error you didn't expect. If you're not sure whether it's a bug or intentional, feel free to file a bug anyway. We may want to improve the documentation or error message. - Missing or incorrect documentation. It's helpful to track where the documentation should be improved, so please file a bug if you can't find or don't understand some bit of documentation. - An error message that wasn't as helpful as you'd like. Bonus points for suggesting what information would have helped you. - Bugs in CoqIDE should also be filed in the [Coq issue tracker][Coq-issue-tracker]. Bugs in the Emacs plugin should be filed against [ProofGeneral][ProofGeneral-issues], or against [company-coq][company-coq-issues] if they are specific to company-coq features. It would help if you search the existing issues before reporting a bug. This can be difficult, so consider it extra credit. We don't mind duplicate bug reports. If unsure, you are always very welcome to ask on our [Discourse forum][Discourse] or [Zulip chat][Zulip] before, after, or while writing a bug report. It is better if you can test that your bug is still present in the current testing or development version of Coq (see the [next sub-section](#beta-testing)) before reporting it, but if you can't, it should not discourage you from reporting it. When it applies, it's extremely helpful for bug reports to include sample code, and much better if the code is self-contained and complete. It's not necessary to minimize your bug or identify precisely where the issue is, since someone else can often do this if you include a complete example. We tend to include the code in the bug description itself, but if you have a very large input file then you can add it as an attachment. If you want to minimize your bug (or help minimize someone else's) for more extra credit, then you can use the [Coq bug minimizer][JasonGross-coq-tools] (specifically, the bug minimizer is the `find-bug.py` script in that repo). Nowadays, the easiest way to use the Coq bug minimizer is to call it through `@coqbot`, as documented [here][coqbot-minimize]. ### Beta testing ### Coq gets a new major release about every six months, which is then distributed through the [Coq Platform][Coq-Platform]. New major versions of Coq are first made available for beta-testing, before being declared stable and the new default version of the Coq Platform. You can help make by testing the beta version, and trying to port your projects to it. You should report any bug you notice, but also any change of behavior that is not documented in the changelog. Then Coq developers will be able to check if what you reported is a regression that needs to be fixed, or an expected change that needs to be mentioned in the changelog. You can go even further by using the development version (`master` branch) of Coq on a day by day basis, and report problems as soon as you notice them. If you wish to do so, the easiest way to install Coq is through opam (using the `dev` version of the Coq package, available in the repository) or through [Nix][]. The documentation of the development version is [available online][master-doc], including the [unreleased changelog][unreleased-changelog]. ### Helping triage existing issues ### Coq has too many bug reports for its core developers alone to manage. You can help a lot by: - confirming that reported bugs are still active with the current version of Coq; - determining if the bug is a regression (new, and unexpected, behavior from a recent Coq version); - more generally, by reproducing a bug, on another system, configuration, another version of Coq, and by documenting what you did; - giving a judgement about whether the reported behavior is really a bug, or is expected but just improperly documented, or expected and already documented; - producing a trace if it is relevant and you know how to do it; - producing another example exhibiting the same bug, or minimizing the initial example using the bug minimizer mentioned above; - using `git bisect` to find the commit that introduced a regression; - fixing the bug if you have an idea of how to do so (see the [following section](#code-changes)). Once you have some experience with the Coq issue tracker, you can request to join the **@coq/contributors** team (any member of the **@coq/core** team can give you access using [this link][add-contributor]). Being in this team will grant you the following access: - **Updating labels:** every open issue and pull request should ideally get one or several `kind:` and `part:` labels. In particular, valid issues should generally get either a `kind: bug` (the reported behavior can indeed be considered a bug, this can be completed with the `kind: anomaly`, and `kind: regression` labels), `kind: documentation` (e.g. if a reported behavior is expected but improperly documented), `kind: enhancement` (a request for enhancement of an existing feature), or `kind: feature` label (an idea for a new feature). - **Creating new labels:** if you feel a `part:` label is missing, do not hesitate to create it. If you are not sure, you may discuss it with other contributors and developers on [Zulip][Zulip-dev] first. - **Closing issues:** if a bug cannot be reproduced anymore, is a duplicate, or should not be considered a bug report in the first place, you should close it. When doing so, try putting an appropriate `resolved:` label to indicate the reason. If the bug has been fixed already, and you know in which version, you can add a milestone to it, even a milestone that's already closed, instead of a `resolved:` label. When closing a duplicate issue, try to add all the additional info that could be gathered to the original issue. - **Editing issue titles:** you may want to do so to better reflect the current understanding of the underlying issue. - **Editing comments:** feel free to do so to fix typos and formatting only (in particular, some old comments from the Bugzilla era or before are not properly formatted). You may also want to edit the OP's initial comment (a.k.a. body of the issue) to better reflect the current understanding of the issue, especially if the discussion is long. If you do so, only add to the original comment, and mark it clearly with an `EDITED by @YourNickname:`. - **Hiding comments:** when the discussion has become too long, this can be done to hide irrelevant comments (off-topic, outdated or resolved sub-issues). - **Deleting things:** please don't delete any comment or issue, our policy doesn't allow for comments to be deleted, unless done by the community moderators. You should hide them instead. An audit log is available to track deleted items if needed (but does not allow recovering them). However, and contrary to most other repositories, it will not give you the ability to push new branches or tags to the repository. This is disabled because we prefer to use forks to work on feature branches. Yet to be fully specified: use of priority, difficulty, `help wanted`, and `good first issue` labels, milestones, assignments, and GitHub projects. ## Code changes ## ### Using GitHub pull requests ### If you want to contribute a documentation update, bug fix or feature yourself, pull requests (PRs) on the [GitHub repository][coq-repository] are the way to contribute directly to the Coq implementation (all changes, even the smallest changes from core developers, go through PRs). You will need to create a fork of the repository on GitHub and push your changes to a new "topic branch" in that fork (instead of using an existing branch name like `master`). PRs should always target the `master` branch. Make sure that your copy of this branch is up-to-date before starting to do your changes, and that there are no conflicts before submitting your PR. If you need to fix conflicts, we generally prefer that you rebase your branch on top of `master`, instead of creating a merge commit. If you are not familiar with `git` or GitHub, Sections [Git documentation, tips and tricks](#git-documentation-tips-and-tricks), and [GitHub documentation, tips and tricks](#github-documentation-tips-and-tricks), should be helpful (and even if you are, you might learn a few tricks). Once you have submitted your PR, it may take some time to get feedback, in the form of reviews from maintainers, and test results from our continuous integration system. Our code owner system will automatically request reviews from relevant maintainers. Then, one maintainer should self-assign the PR (if that does not happen after a few days, feel free to ping the maintainers that were requested a review). The PR assignee will then become your main point of contact for handling the PR: they should ensure that everything is in order and merge when it is the case (you can ping them if the PR is ready from your side but nothing happens for a few days). After your PR is accepted and merged, it may get backported to a release branch if appropriate, and will eventually make it to a release. You do not have to worry about this, it is the role of the assignee and the release manager to do so (see Section [Release management](#release-management)). The milestone should give you an indication of when to expect your change to be released (this could be several months after your PR is merged). That said, you can start using the latest Coq `master` branch to take advantage of all the new features, improvements, and fixes. #### Fixing bugs and performing small changes #### Before fixing a bug, it is best to check that it was reported before: - If it was already reported and you intend to fix it, self-assign the issue (if you have the permission), or leave a comment marking your intention to work on it (and a contributor with write-access may then assign the issue to you). - If the issue already has an assignee, you should check with them if they still intend to work on it. If the assignment is several weeks, months, or even years (!) old, there are good chances that it does not reflect their current priorities. - If the bug has not been reported before, it can be a good idea to open an issue about it, while stating that you are preparing a fix. The issue can be the place to discuss about the bug itself while the PR will be the place to discuss your proposed fix. It is generally a good idea to add a regression test to the test-suite. See the test-suite [README][test-suite-README] for how to do so. Small fixes do not need any documentation, or changelog update. New, or updated, user-facing features, and major bug fixes do. See the [corresponding section](#improving-the-official-documentation) for on how to contribute to the documentation, and the README in [`doc/changelog`][user-changelog] for how to add a changelog entry. #### Proposing large changes: Coq Enhancement Proposals #### Please refrain to open very large PRs without discussing them first. Indeed, you should be aware that the larger the change, the higher the chances it will take very long to review, and possibly never get merged. So it is recommended that before spending a lot of time coding, you seek feedback from maintainers to see if your change would be supported, and if they have recommendations about its implementation. You can do this informally by opening an issue, or more formally by producing a design document as a [Coq Enhancement Proposal][CEP]. Another recommendation is that you do not put several unrelated changes in the same PR (even if you produced them together). In particular, make sure you split bug fixes into separate PRs when this is possible. More generally, smaller-sized PRs, or PRs changing fewer components, are more likely to be reviewed and merged promptly. #### Seeking early feedback on work-in-progress #### You should always feel free to open your PR before the documentation, changelog entry and tests are ready. That's the purpose of the checkboxes in the PR template which you can leave unticked. This can be a way of getting reviewers' approval before spending time on writing the documentation (but you should still do it before your PR can be merged). If even the implementation is not ready but you are still looking for early feedback on your code changes, please use the [draft PR](#draft-pull-requests) mechanism. If you are looking for feedback on the design of your change, rather than on its implementation, then please refrain from opening a PR. You may open an issue to start a discussion, or create a [Coq Enhancement Proposal][CEP] if you have a clear enough view of the design to write a document about it. ### Taking feedback into account ### #### Understanding automatic feedback #### When you open or update a PR, you get automatically some feedback: we have a bot whose job will be to push a branch to our GitLab mirror to run some continuous integration (CI) tests. The tests will run on a commit merging your branch with the base branch, so if there is a conflict and this merge cannot be performed automatically, the bot will put a `needs: rebase` label, and the tests won't run. Otherwise, a suite of tests will be run on GitLab, plus some additional tests on GitHub Actions for Windows and macOS compatibility. The complete suite of tests is no longer run by default to save resources. But it is still required before merging a PR, so this is why the bot will put a `needs: full CI` label if it has only run the lightweight tests. If you are a member of **@coq/contributors**, you can request a full run of the CI by putting the `request: full CI` label before pushing to your PR branch, or by commenting `@coqbot: run full CI` after having pushed. (In case you need to re-run the tests, e.g., because the results are outdated, you can also request the bot to do so by commenting `@coqbot: run full CI` or `@coqbot: run light CI`. If you comment `@coqbot: run CI`, the bot will decide whether to run the full or the lightweight tests based on the presence of the `request: full CI` label.) If a test fails on GitLab, you will see in the GitHub PR interface, both the failure of the whole pipeline, and of the specific failed job. Most of these failures indicate problems that should be addressed, but some can still be due to synchronization issues out of your control. In particular, if you get a failure in one of the tested plugins but you didn't change the Coq API, it is probably a transient issue and you shouldn't have to worry about it. In case of doubt, ask the reviewers. To re-run a specific failed job, you can use the Re-run jobs button in the GitHub interface (if you are a member of **@coq/contributors**). This won't create a new merge commits with the base branch, so if you need this, you can use the `@coqbot: run ... CI` commands instead. ##### Test-suite failures ##### If you broke the test-suite, you should get many failed jobs, because the test-suite is run multiple times in various settings. You should get the same failure locally by running `make test-suite`. It's helpful to run this locally and ensure the test-suite is not broken before submitting a PR as this will spare a lot of runtime on distant machines. To learn more about the test-suite, you should refer to its [README][test-suite-README]. ##### Linter failures ##### We have a linter that checks a few different things: - **Every commit can build.** This is an important requirement to allow the use of `git bisect` in the future. It should be possible to build every commit, and in principle even the test-suite should pass on every commit (but this isn't tested in CI because it would take too long). A good way to test this locally is to use `git rebase master --exec "make check"`. - **No tabs or end-of-line spaces on updated lines**. We are trying to get rid of all tabs and all end-of-line spaces from the code base (except in some very special files that need them). This checks not only that you didn't introduce new ones, but also that updated lines are clean (even if they were there before). You can avoid worrying about tabs and end-of-line spaces by installing our [pre-commit git hook][git-hook], which will fix these issues at commit time. Running `./configure` once will install this hook automatically unless you already have a pre-commit hook installed. If you are encountering these issues nonetheless, you can fix them by rebasing your branch with `git rebase --whitespace=fix`. - **All files should end with a single newline**. See the section [Style guide](#style-guide) for additional style recommendations. - **Documented syntax is up-to-date**. If you update the grammar, you should run `make doc_gram_rsts` to update the documented syntax. You should then update the text describing the syntax in the documentation and commit the changes. In some cases, the documented syntax is edited to make the documentation more readable. In this case, you may have to edit `doc/tools/docgram/common.edit_mlg` to make `doc_gram_rsts` pass. See [doc_grammar's README][doc_gram] for details. Note that in the case where you added new commands or tactics, you will have to manually insert them in the documentation, the tool won't do that for you, although it should detect in most cases if you have forgotten to add documentation for your new command or tactic, or if the documentation is not consistent with the parser. - **.opam files are up to date**. Coq's `*.opam` files are generated automatically from metadata in `dune-project`. If the meta-data becomes out of sync, the linter will complain. This can be fixed doing `dune build *.opam` at the root of Coq's repository. You may run the linter yourself with `dev/lint-repository.sh`. ##### Plugin failures ##### If you did change the Coq API, then you may have broken a plugin. After ensuring that the failure comes from your change, you will have to provide a fix to the plugin, and the PR assignee will have to ensure that this fix is merged in the plugin simultaneously with your PR on the Coq repository. If your changes to the API are not straightforward, you should also document them in `dev/doc/changes.md`. The [CI README (developer part)][CI-README-developers] contains more information on how to fix plugins, test and submit your changes, and how you can anticipate the results of the CI before opening a PR. ##### Library failures ##### Such a failure can indicate either a bug in your branch, or a breaking change that you introduced voluntarily. All such breaking changes should be properly documented in the [user changelog][user-changelog]. Furthermore, a backward-compatible fix should be found, properly documented in the changelog when non-obvious, and this fix should be merged in the broken projects *before* your PR to the Coq repository can be. Note that once the breaking change is well understood, it should not feel like it is your role to fix every project that is affected: as long as reviewers have approved and are ready to integrate your breaking change, you are entitled to (politely) request project authors / maintainers to fix the breakage on their own, or help you fix it. Obviously, you should leave enough time for this to happen (you cannot expect a project maintainer to allocate time for this as soon as you request it) and you should be ready to listen to more feedback and reconsider the impact of your change. If you need help figuring out why your PR is breaking a tested project, you may consider requesting automatic minimization of the failure with the bot. In principle, the bot should automatically propose this option to you if it is available (it needs to detect a failure in a Coq file and it needs to confirm that the failure was not already present in the base branch to propose to run the minimization process). #### Understanding reviewers' feedback #### The reviews you get are highly dependent on the kind of changes you did. In any case, you should always remember that reviewers are friendly volunteers that do their best to help you get your changes in (and should abide by our [Code of Conduct][Code-of-Conduct]). But at the same time, they try to ensure that code that is introduced or updated is of the highest quality and will be easy to maintain in the future, and that's why they may ask you to perform small or even large changes. If you need a clarification, do not hesitate to ask. Here are a few labels that reviewers may add to your PR to track its status. In general, this will come in addition to comments from the reviewers, with specific requests. - [needs: fixing][needs-fixing] indicates the PR needs a fix, as discussed in the comments. - [needs: documentation][needs-documentation] indicates the PR introduces changes that should be documented before it can be merged. This label may be used to reflect that the corresponding checkbox is not yet checked in the PR template (so that we don't forget when we intend to merge the PR). - [needs: changelog entry][needs-changelog] indicates the PR introduces changes that should be documented in the [user changelog][user-changelog]. Similarly to the previous label, this may be used to reflect that the corresponding checkbox is not yet checked in the PR template. - [needs: test-suite update][needs-test-suite] indicates that tests should be added to the test-suite / modified to ensure that the changes are properly tested. Similarly to the previous two labels, this may be used to reflect that the corresponding checkbox is not yet checked in the PR template. - [needs: benchmarking][needs-benchmarking] and [needs: testing][needs-testing] indicate the PR needs testing beyond what the test suite can handle. For example, performance benchmarking is currently performed with a different infrastructure ([documented in the wiki][Benchmarking]). Unless some followup is specifically requested, you aren't expected to do this additional testing. More generally, such labels should come with a description that should allow you to understand what they mean. #### Fixing your branch #### If you have changes to perform before your PR can be merged, you might want to do them in separate commits at first to ease the reviewers' task, but we generally appreciate that they are squashed with the commits that they fix before merging. This is especially true of commits fixing previously introduced bugs or failures. ### Improving the official documentation ### The documentation is usually a good place to start contributing, because you can get used to the pull request submitting and review process, without needing to learn about the code source of Coq at the same time. The official documentation is formed of two components: - the [reference manual][refman], - the [documentation of the standard library][stdlib-doc]. The sources of the reference manual are located in the [`doc/sphinx`][refman-sources] directory. They are written in rst (Sphinx) format with some Coq-specific extensions, which are documented in the [README][refman-README] in the above directory. This README was written to be read from begin to end. As soon as your edits to the documentation are more than changing the textual content, we strongly encourage you to read this document. The documentation of the standard library is generated with [coqdoc][coqdoc-documentation] from the comments in the sources of the standard library. The [README in the `doc` directory][doc-README] contains more information about the documentation's build dependencies, and the `make` targets. You can browse through the list of open documentation issues using the [kind: documentation][kind-documentation] label, or the [user documentation GitHub project][documentation-github-project] (you can look in particular at the "Writing" and "Fixing" columns). ### Contributing to the standard library ### Contributing to the standard library is also made easier by not having to learn about Coq's internals, and its implementation language. Due to the compatibility constraints created by the many projects that depend on it, proposing breaking changes, will usually require to go through a specific process, with a deprecation phase. Additions, such as contributing new lemmas on existing definitions, and clean-ups of existing proofs are easier contributions to start with. In case of doubt, ask in an issue before spending too much time preparing your PR. If you create a new file, it needs to be listed in `doc/stdlib/index-list.html`. Add coqdoc comments to extend the [standard library documentation][stdlib-doc]. See the [coqdoc documentation][coqdoc-documentation] to learn more. ## Becoming a maintainer ## ### Reviewing pull requests ### You can start reviewing PRs as soon as you feel comfortable doing so (anyone can review anything, although some designated reviewers will have to give a final approval before a PR can be merged, as is explained in the next sub-section). Reviewers should ensure that the code that is changed or introduced is in good shape and will not be a burden to maintain, is unlikely to break anything, or the compatibility-breakage has been identified and validated, includes documentation, changelog entries, and test files when necessary. Reviewers can use `needs:` labels, or change requests to further emphasize what remains to be changed before they can approve the PR. Once reviewers are satisfied (regarding the part they reviewed), they should formally approve the PR, possibly stating what they reviewed. That being said, reviewers should also make sure that they do not make the contributing process harder than necessary: they should make it clear which comments are really required to perform before approving, and which are just suggestions. They should strive to reduce the number of rounds of feedback that are needed by posting most of their comments at the same time. If they are opposed to the change, they should clearly say so from the beginning to avoid the contributor spending time in vain. They should avoid making nitpick comments when in fact, they have larger concerns that should be addressed first (these larger concerns should then be made very clear). Furthermore, when reviewing a first contribution (GitHub highlights first-time contributors), be extra careful to be welcoming, whatever the decision on the PR is. When approving a PR, consider thanking the newcomer for their contribution, even if it is a very small one (in cases where, if the PR had come from a regular contributor, it would have felt OK to just merge it without comment). When rejecting a PR, take some extra steps to explain the reasons, so that it doesn't feel hurtful. Don't hesitate to still thank the contributor and possibly redirect them to smaller tasks that might be more appropriate for a newcomer. #### Collaborating on a pull request #### Beyond making suggestions to a PR author during the review process, you may want to collaborate further by checking out the code, making changes, and pushing them. There are two main ways of doing this: - **Pull requests on pull requests:** You can checkout the PR branch (GitHub provides the link to the remote to pull from and the branch name on the top and the bottom of the PR discussion thread), checkout a new personal branch from there, do some changes, commit them, push to your fork, and open a new PR on the PR author's fork. - **Pushing to the PR branch:** If the PR author has not unchecked the "Allow edit from maintainers" checkbox, and you have write-access to the repository (i.e. you are in the **@coq/contributors** team), then you can also push (and even force-push) directly to the PR branch, on the main author's fork. Obviously, don't do it without coordinating with the PR author first (in particular, in case you need to force-push). When several people have co-authored a single commit (e.g. because someone fixed something in a commit initially authored by someone else), this should be reflected by adding ["Co-authored-by:" tags][GitHub-co-authored-by] at the end of the commit message. The line should contain the co-author name and committer e-mail address. ### Merging pull requests ### Our [CODEOWNERS][] file associates a team of maintainers to each component. When a PR is opened (or a [draft PR](#draft-pull-requests) is marked as ready for review), GitHub will automatically request reviews to maintainer teams of affected components. As soon as it is the case, one available member of a team that was requested a review should self-assign the PR, and will act as its shepherd from then on. The PR assignee is responsible for making sure that all the proposed changes have been reviewed by relevant maintainers (at least one reviewer for each component that is significantly affected), that change requests have been implemented, that CI is passing, and eventually will be the one who merges the PR. The PR assignee may use their own judgement to decide to merge a PR that has not received reviews from all maintainers of affected components, depending on how large or controversial the changes to these components are. It is also admissible to have an assignee who is not a maintainer of any of the affected components, in case relevant maintainers are not available, and as long as the assignee is a member of the **@coq/pushers** team and is able to understand the changes in the PR. *If you have already frequently contributed to a component, we would be happy to have you join one of the maintainer teams.* See the [section below](#joining--leaving-maintainer-teams) on joining / leaving maintainer teams. The complete list of maintainer teams is available [here][coq-pushers] (link only accessible to people who are already members of the Coq organization, because of a limitation of GitHub). #### Additional notes for pull request reviewers and assignees #### - NEVER USE GITHUB'S MERGE BUTTON. Instead, you should either: - post a comment containing "@coqbot: merge now"; This is the recommended method and more convenient than the previous script based method (see next bullet) e.g. for developers who do not have a GPG key and for when you do not have access to a console. "coqbot" will **not** check CI status - it is expected that the merger does this manually upfront, but coqbot will deny the merge with an error response in the following cases: - no assignee - no milestone - no `kind` label - left-over `needs` labels - you try to merge a PR which you authored (this is decided by the creator of the PR - reviewers can still do minor changes and merge) - alternatively run the [`dev/tools/merge-pr.sh`][merge-pr] script; Since "coqbot" this method is deprecated with a few exceptions, like merges to release branches - which only release managers do. This requires having configured gpg with git. - PR authors or co-authors cannot review, self-assign, or merge the PR they contributed to. However, reviewers may push small fixes to the PR branch to facilitate the PR integration. - PRs are merged when there is consensus. Consensus is defined by an explicit approval from at least one maintainer for each component that is significantly affected and an absence of dissent. As soon as a developer opposes a PR, it should not be merged without being discussed first (usually in a call or working group). - Sometimes (especially for large or potentially controversial PRs), it is a good practice to announce the intent to merge, one or several days in advance, when unsure that everyone had a chance to voice their opinion, or to finish reviewing the PR. - Only PRs targetting the `master` branch can be merged by a maintainer. For PRs targetting an actively maintained release branch, the assignee should always be the release manager. For older release branches, any **@coq/core** member can merge any PR (but such PRs should be limited to fixing build issues). - Before merging, the assignee must also select a milestone for the PR (see also Section [Release management](#release-management)). - To know which files you are a maintainer of, you can look for black shields icons in the "Files changed" tab. ![shield icon](dev/doc/shield-icon.png) - When a PR has [overlays][user-overlays], then: - the overlays that are backward-compatible (normally the case for overlays fixing Coq code) should have been merged *before* the PR can be merged; it might be a good idea to ask the PR author to remove the overlay information from the PR to get a fresh CI run and ensure that all the overlays have been merged; the PR assignee may also push a commit removing the overlay information (in that case the assignee is not considered a co-author, hence no need to change the assignee) - the overlays that are not backward-compatible (normally only the case for overlays fixing OCaml code) should be merged *just after* the PR has been merged (and thus the assignee should ping the maintainers of the affected projects to ask them to merge the overlays). #### Joining / leaving maintainer teams #### We are always happy to have more people involved in the PR reviewing and merging process, so do not hesitate to propose yourself if you already have experience on a component. Maintainers can leave teams at any time (and core members can also join any team where they feel able to help) but you should always announce it to other maintainers when you do join or leave a team. ### Core development team ### The core developers are the active developers with a lengthy and significant contribution track record. They are the ones with admin powers over the Coq organization, and the ones who take part in [votes][voting-process] in case of conflicts to take a decision (rare). One of them is designated as a development coordinator, and has to approve the changes in the core team membership (until we get a more formal joining and leaving process). The core developers are the members of the **@coq/core** team ([member list][coq-core] only visible to the Coq organization members because of a limitation of GitHub). They are also listed on the [Coq Team page][coq-team]. ## Release management ## Coq's major release cycles generally span about six months, with about 4-5 months of development, and 1-2 months of stabilization / release candidates. The release manager (RM) role is a rolling position among core developers. The [release plan][release-plan] is published on the wiki. Development of new features, refactorings, deprecations and clean-ups always happens on `master`. Stabilization starts by branching (creating a new `v...` release branch from the current `master`), which marks the beginning of a feature freeze (new features will continue to be merged into `master` but won't make it for the upcoming major release, but only for the next one). After branching, most changes are introduced in the release branch by a backporting process. PR authors and assignee can signal a desire to have a PR backported by selecting an appropriate milestone. Most of the time, the choice of milestone is between two options: the next major version that has yet to branch from `master`, or the next version (rc, final, or patch-level release) of the active release branch. In the end, it is the RM who decides whether to follow or not the recommendation of the PR assignee, and who backports PRs to the release branch. Very specific changes that are only relevant for the release branch and not for the `master` branch can result in a PR targetting the release branch instead of `master`. In this case, the RM is the only one who can merge the PR, and they may even do so if they are the author of the PR. Examples of such PRs include bug fixes to a feature that has been removed in `master`, and PRs from the RM changing the version number in preparation for the next release. Some automation is in place to help the RM in their task: a GitHub project is created at branching time to manage PRs to backport; when a PR is merged in a milestone corresponding to the release branch, our bot will add this PR in a "Request inclusion" column in this project; the RM can browse through the list of PRs waiting to be backported in this column, possibly reject some of them by simply removing the PR from the column (in which case, the bot will update the PR milestone), and proceed to backport others; when a backported PR is pushed to the release branch, the bot moves the PR from the "Request inclusion" column to a "Shipped" column. More information about the RM tasks can be found in the [release process checklist][RM-checklist]. ### Packaging Coq ### The RM role does not include the task of making Coq available through the various package managers out there: several contributors (most often external to the development team) take care of this, and we thank them for this. If your preferred package manager does not include Coq, it is a very worthy contribution to make it available there. But be careful not to let a package get outdated, as this could lead some users to install an outdated version of Coq without even being aware of it. Beyond packaging Coq, you might want to consider packaging the rest of Coq packages available to users through the [Coq Platform][Coq-Platform]. In this case, it would be helpful if you try to favor the same versions as in the Coq Platform. This [Repology page][repology-coq] lists the versions of Coq which are packaged in many repositories, although it is missing information on some repositories, like opam. The Windows and macOS installers are created as part of the preparation of the Coq Platform. ## Additional resources ## ### Developer documentation ### #### Where to find the resources #### - You can find developer resources in the `dev` directory, and more specifically developer documentation in `dev/doc`. The [README][dev-README] in the `dev` directory lists what's available. For example, [`dev/doc/README.md`][dev-doc-README] is a beginner's guide to hacking Coq, and documentation on debugging Coq can be found in [`dev/doc/debugging.md`][debugging-doc]. - When it makes sense, the documentation is kept even closer to the sources, in README files in various directories (e.g. the test-suite [README][test-suite-README] or the refman [README][refman-README]). - Documentation of the Coq API is written directly in comments in `.mli` files. You can browse it on [the Coq website][api-doc], or rebuild it locally (`make apidoc`, requires `odoc` and `dune`). - A plugin tutorial is located in [`doc/plugin_tutorial`][plugin-tutorial]. - The Coq [wiki][] contains additional developer resources. #### Building Coq #### The list of dependencies can be found in the first section of the [`INSTALL.md`](INSTALL.md) file. Coq is built using the `dune` build system. Run `make` to get help on the various available targets. Additional documentation can be found in [`dev/doc/build-system.dune.md`][dev-doc-dune], and in [the official Dune documentation][dune-doc]. #### Continuous integration #### Continuous integration (CI) testing is key in ensuring that the `master` branch is kept in a well-functioning state at all times, and that no accidental compatibility breakages are introduced. Our CI is quite extensive since it includes testing many external projects, some of them taking more than an hour to compile. However, you can get partial results much more quickly (when our CI is not overloaded). Nowadays, the full CI is not run by default as already explained in [Understanding automatic feedback](#understanding-automatic-feedback). The main documentation resources on our CI are: - the [README for users, i.e. plugin and library authors][CI-README-users]; - the [README for developers, and contributors][CI-README-developers]; - the README of the [user-overlays][] directory. Preparing an overlay (i.e. a patch to an external project that we test in our CI, to make it compile with the modified version of Coq in your branch) is a step that everyone goes through at some point. All you need to know to prepare an overlay manually is in the README in the [user-overlays][] directory. You might want to use some additional tooling such as the `make ci-*` targets of `Makefile.ci`, the Nix support for getting the dependencies of the external projects (see the README in [`dev/ci/nix`][dev-ci-nix], and the (so far undocumented) [`dev/tools/create_overlays.sh`][dev-tools-create_overlays.sh] script. More work is to be done on understanding how each developer proceeds to prepare overlays, and propose a simplified and documented procedure. We also have a benchmarking infrastructure, which is documented [on the wiki][Benchmarking]. ##### Restarting failed jobs ##### When CI has a few failures which look spurious, restarting the corresponding jobs is a good way to ensure this was indeed the case. Most failed jobs can be restarted directly from the "Checks" tab on GitHub. In case you need to restart a job on GitLab CI using the GitLab interface, then you should sign into GitLab (this can be done using a GitHub account) and join the [Coq GitLab organization][GitLab-organization]. #### Code owners, issue and pull request templates #### These files can be found in the [`.github`](.github) directory. The templates are particularly useful to remind contributors what information we need for them, and, in the case of PRs, to update the documentation, changelog, and test-suite when relevant. GitHub now supports setting up multiple issue templates, and we could use this to define distinct requirements for various kind of bugs, enhancement and feature requests. #### Style guide #### There exists an [old style guide][old-style-guide] whose content is still mostly relevant. Yet to be done: extract the parts that are most relevant, and put them in this section instead. We don't use a code formatter at the current time, and we are reluctant to merge changes to parts of the code that are unchanged aside from formatting. However, it is still a good idea if you don't know how to format a block of code to use the formatting that [ocamlformat][] would give #### OCaml resources #### You can find lots of OCaml resources on , including documentation, a Discourse forum, the package archive, etc. You may also want to refer to the [Dune documentation][dune-doc]. Another ressource is , especially its [community page][ocamlverse-community], which lists the various OCaml discussion platforms. #### Git documentation, tips and tricks #### Lots of resources about git, the version control system, are available on the web, starting with the [official website][git]. We recommend a setup with two configured remotes, one for the official Coq repository, called `upstream`, and one for your fork, called `origin`. Here is a way to do this for a clean clone: ``` shell git clone https://github.com/coq/coq -o upstream cd coq git remote add origin git@github.com:$YOURNAME/coq # Make sure you click the fork button on GitHub so that this repository exists cp dev/tools/pre-commit .git/hooks/ # Setup the pre-commit hook ``` Then, if you want to prepare a fix: ``` shell # Make sure we start from an up-to-date master git checkout master git pull --ff-only # If this fails, then your master branch is messy git checkout -b my-topic-branch # Modify some files git add . # Every untracked or modified file will be included in the next commit # You can also replace the dot with an explicit list of files git commit -m "My commit summary. You can add more information on multiple lines, but you need to skip a line first." git push -u origin my-topic-branch # Next time, you push to this branch, you can just do git push ``` When you push a new branch for the first time, GitHub gives you a link to open a PR. If you need to fix the last commit in your branch (typically, if your branch has a single commit on top of `master`), you can do so with ``` git add . git commit --amend --no-edit ``` If you need to fix another commit in your branch, or if you need to fix a conflict with `master`, you will need to learn about `git rebase`. GitHub provides [a short introduction][GitHub-rebase] to `git rebase`. #### GitHub documentation, tips and tricks #### GitHub has [extensive documentation][GitHub-doc] about everything you can do on the platform, and tips about using `git` as well. See in particular, [how to configure your commit e-mail address][GitHub-commit-email] and [how to open a PR from a fork][GitHub-PR-from-fork]. ##### Watching the repository ##### ["Watching" this repository][GitHub-watching] can result in a very large number of notifications. We recommend you, either, [configure your mailbox][notification-email] to handle incoming notifications efficiently, or you read your notifications within a web browser. You can configure how you receive notifications in [your GitHub settings][GitHub-notification-settings], you can use the GitHub interface to mark as read, save for later or mute threads. Nowadays, you have also the option to watch only part of the activity (only issues, only PRs, only releases, etc.). ##### Draft pull requests ##### [Draft PRs][GitHub-draft-PR] are a mechanism proposed by GitHub to open a pull request before it is ready for review. Opening a draft PR is a way of announcing a change and seeking early feedback without formally requesting maintainers' reviews. Indeed, you should avoid cluttering our maintainers' review request lists before a change is ready on your side. When opening a draft PR, make sure to give it a descriptive enough title so that interested developers still notice it in their notification feed. You may also advertise it by talking about it in our [developer chat][Zulip-dev]. If you know which developer would be able to provide useful feedback to you, you may also ping them. ###### Turning a PR into draft mode ###### If a PR was opened as ready for review, but it turns out that it still needs work, it can be transformed into a draft PR. In this case, previous review requests won't be removed automatically. Someone with write access to the repository should remove them manually. Afterwards, upon marking the PR as ready for review, someone with write access will have to manually add the review requests that were previously removed. #### GitLab documentation, tips and tricks #### We use GitLab mostly for its CI service. The [Coq organization on GitLab][GitLab-coq] hosts a number of CI/CD-only mirrors. If you are a regular contributor, you can request access to it from [the organization page][GitLab-coq], although in most cases, you won't need this. GitLab too has [extensive documentation][GitLab-doc], in particular on configuring CI. #### Merge script dependencies #### Nowadays, most assignees should use the `@coqbot: merge now` command instead of the merge script. However, the merge script is still available, and is still needed to merge PRs into release branches. The merge script passes option `-S` to `git merge` to ensure merge commits are signed. Consequently, it depends on the GnuPG command utility being installed and a GPG key being available. Here is a short documentation on how to use GPG, git & GitHub: https://help.github.com/articles/signing-commits-with-gpg/. The script depends on a few other utilities. If you are a Nix user, the simplest way of getting them is to run `nix-shell` first. **Note for homebrew (MacOS) users:** it has been reported that installing GnuPG is not out of the box. Installing explicitly `pinentry-mac` seems important for typing of passphrase to work correctly (see also this [Stack Overflow Q-and-A][pinentry-mac]). #### Coqbot #### Our bot sources can be found at . Its documentation is still a work-in-progress. ### Online forum and chat to talk to developers ### We have a [Discourse forum][Discourse] (see in particular the [Coq development][Discourse-development-category] category) and a [Zulip chat][Zulip] (see in particular the [Coq devs & plugin devs][Zulip-dev] stream). Feel free to join any of them and ask questions. People are generally happy to help and very reactive. Obviously, the issue tracker is also a good place to ask questions, especially if the development processes are unclear, or the developer documentation should be improved. ### Coq calls ### We try to gather every week for one hour through video-conference to discuss current and urgent matters. When longer discussions are needed, topics are left out for the next working group. See the [wiki][wiki-calls] for more information about Coq calls, as well as notes of past ones. ### Coq remote working groups ### We semi-regularly (up to every month) organize remote working groups, which can be accessed through video-conference, and are most often live streamed on [YouTube][]. Summary notes and announcements of the next working group can be found [on the wiki][wiki-WG] These working groups are where important decisions are taken, most often by consensus, but also, if it is needed, by a vote of core developers. ### Coq Users and Developers Workshops ### We have an annual gathering late Spring in France where most core developers are present, and whose objective is to help new contributors get started with the Coq codebase, provide help to plugin and library authors, and more generally have fun together. The list of past (and upcoming, when it's already planned) workshops can be found [on the wiki][wiki-CUDW]. [add-contributor]: https://github.com/orgs/coq/teams/contributors/members?add=true [api-doc]: https://coq.github.io/doc/master/api/ [Awesome-Coq]: https://github.com/coq-community/awesome-coq [Benchmarking]: https://github.com/coq/coq/wiki/Benchmarking [CEP]: https://github.com/coq/ceps [CI-README-developers]: dev/ci/README-developers.md [CI-README-users]: dev/ci/README-users.md [Code-of-Conduct]: CODE_OF_CONDUCT.md [CODEOWNERS]: .github/CODEOWNERS [Codewars]: https://www.codewars.com/?language=coq [company-coq-issues]: https://github.com/cpitclaudel/company-coq/issues [coqbot-minimize]: https://github.com/coq/coq/wiki/Coqbot-minimize-feature [Coq-Club]: https://sympa.inria.fr/sympa/arc/coq-club [coq-community-maintainer-wanted]: https://github.com/coq-community/manifesto/issues?q=is%3Aissue+is%3Aopen+label%3Amaintainer-wanted [coq-community-manifesto]: https://github.com/coq-community/manifesto [coq-community-wiki]: https://github.com/coq-community/manifesto/wiki [coq-core]: https://github.com/orgs/coq/teams/core/members [coqdoc-documentation]: https://coq.inria.fr/refman/practical-tools/utilities.html#documenting-coq-files-with-coqdoc [Coq-documentation]: https://coq.inria.fr/documentation [Coq-issue-tracker]: https://github.com/coq/coq/issues [Coq-package-index]: https://coq.inria.fr/packages [Coq-Platform]: https://github.com/coq/platform [coq-pushers]: https://github.com/orgs/coq/teams/pushers/teams [coq-repository]: https://github.com/coq/coq [coq-team]: https://coq.inria.fr/coq-team.html [Coq-website-repository]: https://github.com/coq/www [debugging-doc]: dev/doc/debugging.md [dev-ci-nix]: dev/ci/nix/README.md [dev-doc-README]: dev/doc/README.md [dev-doc-dune]: dev/doc/build-system.dune.md [dev-README]: dev/README.md [dev-tools-create_overlays.sh]: dev/tools/create_overlays.sh [Discourse]: https://coq.discourse.group/ [Discourse-development-category]: https://coq.discourse.group/c/coq-development [doc_gram]: doc/tools/docgram/README.md [doc-README]: doc/README.md [documentation-github-project]: https://github.com/orgs/coq/projects/6 [dune-doc]: https://dune.readthedocs.io/en/latest/ [FAQ]: https://github.com/coq/coq/wiki/The-Coq-FAQ [git]: https://git-scm.com/ [git-hook]: dev/tools/pre-commit [GitHub-co-authored-by]: https://github.blog/2018-01-29-commit-together-with-co-authors/ [GitHub-commit-email]: https://help.github.com/en/articles/setting-your-commit-email-address-in-git [GitHub-doc]: https://help.github.com/ [GitHub-draft-PR]: https://github.blog/2019-02-14-introducing-draft-pull-requests/ [GitHub-markdown]: https://guides.github.com/features/mastering-markdown/ [GitHub-notification-settings]: https://github.com/settings/notifications [GitHub-PR-from-fork]: https://help.github.com/en/articles/creating-a-pull-request-from-a-fork [GitHub-rebase]: https://help.github.com/articles/about-git-rebase/ [GitHub-watching]: https://github.com/coq/coq/subscription [GitHub-wiki-extensions]: https://help.github.com/en/articles/editing-wiki-content [GitLab-coq]: https://gitlab.com/coq [GitLab-doc]: https://docs.gitlab.com/ [IRC]: irc://irc.libera.chat:6697/#coq [GitLab-organization]: https://gitlab.com/coq [JasonGross-coq-tools]: https://github.com/JasonGross/coq-tools [kind-documentation]: https://github.com/coq/coq/issues?q=is%3Aopen+is%3Aissue+label%3A%22kind%3A+documentation%22 [master-doc]: https://coq.github.io/doc/master/refman/ [merge-pr]: dev/tools/merge-pr.sh [needs-benchmarking]: https://github.com/coq/coq/labels/needs%3A%20benchmarking [needs-changelog]: https://github.com/coq/coq/labels/needs%3A%20changelog%20entry [needs-documentation]: https://github.com/coq/coq/labels/needs%3A%20documentation [needs-fixing]: https://github.com/coq/coq/labels/needs%3A%20fixing [needs-rebase]: https://github.com/coq/coq/labels/needs%3A%20rebase [needs-testing]: https://github.com/coq/coq/labels/needs%3A%20testing [needs-test-suite]: https://github.com/coq/coq/labels/needs%3A%20test-suite%20update [Nix]: https://github.com/coq/coq/wiki/Nix [notification-email]: https://blog.github.com/2017-07-18-managing-large-numbers-of-github-notifications/#prioritize-the-notifications-you-receive [OCaml-planet]: http://ocaml.org/community/planet/ [ocamlformat]: https://github.com/ocaml-ppx/ocamlformat [ocamlverse-community]: https://ocamlverse.github.io/content/community.html [old-style-guide]: dev/doc/style.txt [other-standard-libraries]: https://github.com/coq/stdlib2/wiki/Other-%22standard%22-libraries [pinentry-mac]: https://stackoverflow.com/questions/39494631/gpg-failed-to-sign-the-data-fatal-failed-to-write-commit-object-git-2-10-0 [plugin-tutorial]: doc/plugin_tutorial [Proof-Assistants-SE]: https://proofassistants.stackexchange.com/ [ProofGeneral-issues]: https://github.com/ProofGeneral/PG/issues [Reddit]: https://www.reddit.com/r/Coq/ [refman]: https://coq.inria.fr/distrib/current/refman/ [refman-sources]: doc/sphinx [refman-README]: doc/sphinx/README.rst [release-plan]: https://github.com/coq/coq/wiki/Release-Plan [repology-coq]: https://repology.org/project/coq/versions [RM-checklist]: dev/doc/release-process.md [Stack-Exchange]: https://stackexchange.com/filters/299857/questions-tagged-coq-on-stackexchange-sites [Stack-Exchange-to-Zulip]: https://coq.zulipchat.com/#narrow/stream/237977-Coq-users/topic/New.20Stack.20Exchange.20question [Stack-Overflow]: https://stackoverflow.com/questions/tagged/coq [stdlib-doc]: https://coq.inria.fr/stdlib/ [test-suite-README]: test-suite/README.md [tools-website]: https://coq.inria.fr/related-tools.html [tools-wiki]: https://github.com/coq/coq/wiki/Tools [unreleased-changelog]: https://coq.github.io/doc/master/refman/changes.html#unreleased-changes [user-changelog]: doc/changelog [user-overlays]: dev/ci/user-overlays [voting-process]: https://github.com/coq/coq/wiki/Core-Team-Voting-Process [wiki]: https://github.com/coq/coq/wiki [wiki-calls]: https://github.com/coq/coq/wiki/Coq-Calls [wiki-CUDW]: https://github.com/coq/coq/wiki/CoqImplementorsWorkshop [wiki-WG]: https://github.com/coq/coq/wiki/Coq-Working-Groups [YouTube]: https://www.youtube.com/channel/UCbJo6gYYr0OF18x01M4THdQ [Zulip]: https://coq.zulipchat.com [Zulip-dev]: https://coq.zulipchat.com/#narrow/stream/237656-Coq-devs.20.26.20plugin.20devs coq-8.20.0/CREDITS000066400000000000000000000175651466560755400134430ustar00rootroot00000000000000The "Coq proof assistant" was jointly developed by - INRIA Formel, Coq, LogiCal, ProVal, TypiCal, Marelle, pi.r2, Ascola, Galinette projects (starting 1985), - Laboratoire de l'Informatique du Parallelisme (LIP) associated to CNRS and ENS Lyon (Sep. 1989 to Aug. 1997), - Laboratoire de Recherche en Informatique (LRI) associated to CNRS and university Paris Sud (since Sep. 1997), - Laboratoire d'Informatique de l'Ecole Polytechnique (LIX) associated to CNRS and Ecole Polytechnique (since Jan. 2003). - Laboratoire PPS associated to CNRS and University Paris Diderot (Jan. 2009 - Dec. 2015 when it was merged into IRIF). - Institut de Recherche en Informatique Fondamentale (IRIF), associated to CNRS and University Paris Diderot (since Jan. 2016). - And many contributors from various institutions. All files but the material of the reference manual are distributed under the term of the GNU Lesser General Public License Version 2.1. The material of the reference manual is distributed under the terms of the Open Publication License v1.0 or above, as indicated in file doc/LICENCE. The following directories contain independent contributions supported by the Coq development team. All of them are released under the terms of the GNU Lesser General Public License Version 2.1. plugins/cc developed by Pierre Corbineau (ENS Cachan, 2001, LRI, 2001-2005, Radboud University at Nijmegen, 2005-2008, Grenoble 1, 2010-2014) plugins/extraction developed by Pierre Letouzey (LRI, 2000-2004, PPS, 2005-now) plugins/firstorder developed by Pierre Corbineau (LRI, 2003-2008) plugins/funind developed by Pierre Courtieu (INRIA-Lemme, 2003-2004, CNAM, 2006-now), Julien Forest (INRIA-Everest, 2006, CNAM, 2007-2008, ENSIIE, 2008-now) and Yves Bertot (INRIA-Marelle, 2005-2006) plugins/micromega developed by Frédéric Besson (IRISA/INRIA, 2006-now), with some extensions by Evgeny Makarov (INRIA, 2007); sum-of-squares solver and interface to the csdp solver uses code from John Harrison (University of Cambridge, 1998) plugins/nsatz developed by Loïc Pottier (INRIA-Marelle, 2009-2011) plugins/omega developed by Pierre Crégut (France Telecom R&D, 1996) plugins/rtauto developed by Pierre Corbineau (LRI, 2005) plugins/ring developed by Benjamin Grégoire (INRIA-Everest, 2005-2006), Assia Mahboubi, Laurent Théry (INRIA-Marelle, 2006) and Bruno Barras (INRIA LogiCal, 2005-2006), plugins/ssr developed by Georges Gonthier (Microsoft Research - Inria Joint Centre, 2007-2013, Inria, 2013-now), Assia Mahboubi and Enrico Tassi (Inria, 2011-now). plugins/ssrmatching developed by Georges Gonthier (Microsoft Research - Inria Joint Centre, 2007-2011, Inria, 2013-now), and Enrico Tassi (Inria-Marelle, 2011-now) theories/ZArith started by Pierre Crégut (France Telecom R&D, 1996) theories/Strings developed by Laurent Théry (INRIA-Lemme, 2003) theories/Numbers/Cyclic developed by Benjamin Grégoire (INRIA-Everest, 2007), Laurent Théry (INRIA-Marelle, 2007-2008), Arnaud Spiwack (INRIA-LogiCal, 2007) and Pierre Letouzey (PPS, 2008) ide/utils some files come from Maxence Guesdon's Cameleon tool The development of Coq significantly benefited from feedback, suggestions or short contributions from the following non exhaustive list of persons and groups: C. Alvarado, C. Auger, F. Blanqui, P. Castéran, C. Cohen, J. Courant, J. Duprat, F. Garillot, G. Gonthier, J. Goubault, J.-P. Jouannaud, S. Lescuyer, A. Miquel, J.-F. Monin, P.-Y. Strub the Foundations Group (Radboud University, Nijmegen, The Netherlands), Laboratoire J.-A. Dieudonné (University of Nice-Sophia Antipolis), L. Lee (https://orcid.org/0000-0002-7128-9257, 2018), INRIA-Gallium project, the CS dept at Yale, the CIS dept at U. Penn, the CSE dept at Harvard, the CS dept at Princeton, the CS dept at MIT as well as a lot of users on coq-club, coqdev, coq-bugs The following people have contributed to the development of different versions of the Coq Proof assistant during the indicated time: Bruno Barras (INRIA, 1995-now) Yves Bertot (INRIA, 2000-now) Pierre Boutillier (INRIA-PPS, 2010-2015) Xavier Clerc (INRIA, 2012-2014) Tej Chajed (MIT, 2016-now) Jacek Chrzaszcz (LRI, 1998-2003) Thierry Coquand (INRIA, 1985-1989) Pierre Corbineau (LRI, 2003-2005, Nijmegen, 2005-2008, Grenoble 1, 2008-2011) Cristina Cornes (INRIA, 1993-1996) Yann Coscoy (INRIA Sophia-Antipolis, 1995-1996) Pierre Courtieu (CNAM, 2006-now) David Delahaye (INRIA, 1997-2002) Maxime Dénès (INRIA, 2013-now) Daniel de Rauglaudre (INRIA, 1996-1998, 2012, 2016) Olivier Desmettre (INRIA, 2001-2003) Gilles Dowek (INRIA, 1991-1994) Jim Fehrle (2018-now) Amy Felty (INRIA, 1993) Jean-Christophe Filliâtre (ENS Lyon, 1994-1997, LRI, 1997-2008) Emilio Jesús Gallego Arias (MINES ParisTech 2015-now) Gaetan Gilbert (INRIA-Galinette, 2016-now) Eduardo Giménez (ENS Lyon, 1993-1996, INRIA, 1997-1998) Stéphane Glondu (INRIA-PPS, 2007-2013) Benjamin Grégoire (INRIA, 2003-2011) Jason Gross (MIT 2013-now) Hugo Herbelin (INRIA, 1996-now) Sébastien Hinderer (INRIA, 2014) Gérard Huet (INRIA, 1985-1997) Konstantinos Kallas (U. Penn, 2019) Matej Košík (INRIA, 2015-2017) Leonidas Lampropoulos (University of Pennsylvania, 2018) Pierre Letouzey (LRI, 2000-2004, PPS, 2005-2008, INRIA-PPS then IRIF, 2009-2018) Yao Li (ORCID: https://orcid.org/0000-0001-8720-883X, University of Pennsylvania, 2018) Yishuai Li (ORCID: https://orcid.org/0000-0002-5728-5903 U. Penn, 2018-2019) Patrick Loiseleur (Paris Sud, 1997-1999) Andreas Lynge (Aarhus University, 2019) Evgeny Makarov (INRIA, 2007) Gregory Malecha (Harvard University 2013-2015, University of California, San Diego 2016) Cyprien Mangin (INRIA-PPS then IRIF, 2015-now) Pascal Manoury (INRIA, 1993) Claude Marché (INRIA, 2003-2004 & LRI, 2004) Micaela Mayero (INRIA, 1997-2002) Guillaume Melquiond (INRIA, 2009-now) Benjamin Monate (LRI, 2003) César Muñoz (INRIA, 1994-1995) Chetan Murthy (INRIA, 1992-1994) Julien Narboux (INRIA, 2005-2006, Strasbourg, 2007-2011) Jean-Marc Notin (CNRS, 2006-now) Catherine Parent-Vigouroux (ENS Lyon, 1992-1995) Christine Paulin-Mohring (INRIA, 1985-1989, ENS Lyon, 1989-1997, LRI, 1997-2006) Pierre-Marie Pédrot (INRIA-PPS, 2011-2015, INRIA-Ascola, 2015-2016, University of Ljubljana, 2016-2017, MPI-SWS, 2017-2018, INRIA 2018-now) Clément Pit-Claudel (MIT, 2015-now) Matthias Puech (INRIA-Bologna, 2008-2011) Yann Régis-Gianas (INRIA-PPS then IRIF, 2009-2016) Clément Renard (INRIA, 2001-2004) Talia Ringer (University of Washington, 2019) Claudio Sacerdoti Coen (INRIA, 2004-2005) Amokrane Saïbi (INRIA, 1993-1998) Vincent Semeria (2018-now) Vincent Siles (INRIA, 2007) Élie Soubiran (INRIA, 2007-2010) Matthieu Sozeau (INRIA, 2005-now) Arnaud Spiwack (INRIA-LIX-Chalmers University, 2006-2010, INRIA, 2011-2014, MINES ParisTech 2014-2015, Tweag/IO 2015-now) Paul Steckler (MIT 2016-2018) Enrico Tassi (INRIA, 2011-now) Amin Timany (Katholieke Universiteit Leuven, 2017) Benjamin Werner (INRIA, 1989-1994) Nickolai Zeldovich (MIT 2014-2016) Théo Zimmermann (ORCID: https://orcid.org/0000-0002-3580-8806, INRIA-PPS then IRIF, 2015-now) *************************************************************************** INRIA refers to: Institut National de la Recherche en Informatique et Automatique CNRS refers to: Centre National de la Recherche Scientifique LRI refers to: Laboratoire de Recherche en Informatique, UMR 8623 CNRS and Université Paris-Sud ENS Lyon refers to: Ecole Normale Supérieure de Lyon PPS refers to: Laboratoire Preuve, Programmation, Système, UMR 7126, CNRS and Université Paris 7 **************************************************************************** coq-8.20.0/INSTALL.md000066400000000000000000000106721466560755400140430ustar00rootroot00000000000000Installing From Sources ======================= To install and use Coq, we recommend relying on [the Coq platform](https://github.com/coq/platform/) or on a package manager (e.g. opam or Nix). See https://coq.inria.fr/download and https://github.com/coq/coq/wiki#coq-installation to learn more. If you need to build Coq from sources manually (e.g. to contribute to Coq or to write a Coq package), the remainder of this file explains how to do so. Build Requirements ------------------ To compile Coq yourself, you need: - [OCaml](https://ocaml.org/) (version >= 4.09.0) (This version of Coq has been tested up to OCaml 4.14.1, for the 4.x series) Support for OCaml 5.x remains experimental. - The [Dune OCaml build system](https://github.com/ocaml/dune/) >= 3.6.1 - The [ZArith library](https://github.com/ocaml/Zarith) >= 1.11 - The [findlib](http://projects.camlcity.org/projects/findlib.html) library (version >= 1.8.1) - a C compiler - an IEEE-754 compliant architecture with rounding to nearest ties to even as default rounding mode (most architectures should work nowadays) - for CoqIDE, the [lablgtk3-sourceview3](https://github.com/garrigue/lablgtk) library (version >= 3.1.2), and the corresponding GTK 3.x libraries, as of today (gtk+3 >= 3.18 and gtksourceview3 >= 3.18) - [optional] GNU Make (version >= 3.81) See [below](#Known-Problems) for a discussion of platform-specific issues with dependencies. Primitive floating-point numbers require IEEE-754 compliance (`Require Import Floats`). Common sources of incompatibility are checked at configure time, preventing compilation. In the unlikely event an incompatibility remains undetected, using `Floats` would enable proving `False` on this architecture. Note that OCaml dependencies (`zarith` and `lablgtk3-sourceview3` at this moment) must be properly registered with `findlib/ocamlfind` since Coq's build system uses `findlib` to locate them. Debian / Ubuntu users can get the necessary system packages for CoqIDE with: $ sudo apt-get install libgtksourceview-3.0-dev Opam (https://opam.ocaml.org/) is recommended to install OCaml and the corresponding packages. $ opam switch create coq --packages="ocaml-variants.4.14.1+options,ocaml-option-flambda" $ eval $(opam env) $ opam install dune ocamlfind zarith lablgtk3-sourceview3 should get you a reasonable OCaml environment to compile Coq. See the OPAM documentation for more help. Nix users can also get all the required dependencies by running: $ nix-shell Run-time dependencies of native compilation ------------------------------------------- The OCaml compiler and findlib are build-time dependencies, but also run-time dependencies if you wish to use the native compiler. Build and install procedure --------------------------- Note that Coq supports a faster, but less optimized developer build, but final users must always use the release build. See [dev/doc/build-system.dune.md](dev/doc/build-system.dune.md) for more details. To build and install Coq (and CoqIDE if desired) do: $ ./configure -prefix $options $ make dunestrap $ dune build -p coq-core,coq-stdlib,coq,coqide-server,coqide $ dune install --prefix= coq-core coq-stdlib coq coqide-server coqide You can drop the `coqide` packages if not needed. Packagers may want to play with `dune install` options as to tweak installation path, the `-prefix` argument in `./configure` tells Coq where to find its standard library, but doesn't control any other installation path these days. OCaml toolchain advisory ------------------------ When loading plugins or `vo` files, you should make sure that these were compiled with the same OCaml setup (version, flags, dependencies...) as Coq. Distribution of pre-compiled plugins and `.vo` files is only possible if users are guaranteed to have the same Coq version compiled with the same OCaml toolchain. An OCaml setup mismatch is the most probable cause for an `Error while loading ...: implementation mismatch on ...`. coq_environment.txt ------------------- Coq binaries which honor environment variables, such as `COQLIB`, can be seeded values for these variables by placing a text file named `coq_environment.txt` next to them. The file can contain assignments like `COQLIB="some path"`, that is a variable name followed by `=` and a string that follows OCaml's escaping conventions. This feature can be used by installers of binary package to make Coq aware of its installation path. coq-8.20.0/LICENSE000066400000000000000000000574751466560755400134340ustar00rootroot00000000000000 GNU LESSER GENERAL PUBLIC LICENSE Version 2.1, February 1999 Copyright (C) 1991, 1999 Free Software Foundation, Inc. 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA Everyone is permitted to copy and distribute verbatim copies of this license document, but changing it is not allowed. [This is the first released version of the Lesser GPL. It also counts as the successor of the GNU Library Public License, version 2, hence the version number 2.1.] Preamble The licenses for most software are designed to take away your freedom to share and change it. By contrast, the GNU General Public Licenses are intended to guarantee your freedom to share and change free software--to make sure the software is free for all its users. This license, the Lesser General Public License, applies to some specially designated software packages--typically libraries--of the Free Software Foundation and other authors who decide to use it. You can use it too, but we suggest you first think carefully about whether this license or the ordinary General Public License is the better strategy to use in any particular case, based on the explanations below. When we speak of free software, we are referring to freedom of use, not price. Our General Public Licenses are designed to make sure that you have the freedom to distribute copies of free software (and charge for this service if you wish); that you receive source code or can get it if you want it; that you can change the software and use pieces of it in new free programs; and that you are informed that you can do these things. To protect your rights, we need to make restrictions that forbid distributors to deny you these rights or to ask you to surrender these rights. These restrictions translate to certain responsibilities for you if you distribute copies of the library or if you modify it. For example, if you distribute copies of the library, whether gratis or for a fee, you must give the recipients all the rights that we gave you. You must make sure that they, too, receive or can get the source code. If you link other code with the library, you must provide complete object files to the recipients, so that they can relink them with the library after making changes to the library and recompiling it. And you must show them these terms so they know their rights. We protect your rights with a two-step method: (1) we copyright the library, and (2) we offer you this license, which gives you legal permission to copy, distribute and/or modify the library. To protect each distributor, we want to make it very clear that there is no warranty for the free library. Also, if the library is modified by someone else and passed on, the recipients should know that what they have is not the original version, so that the original author's reputation will not be affected by problems that might be introduced by others. Finally, software patents pose a constant threat to the existence of any free program. We wish to make sure that a company cannot effectively restrict the users of a free program by obtaining a restrictive license from a patent holder. Therefore, we insist that any patent license obtained for a version of the library must be consistent with the full freedom of use specified in this license. Most GNU software, including some libraries, is covered by the ordinary GNU General Public License. This license, the GNU Lesser General Public License, applies to certain designated libraries, and is quite different from the ordinary General Public License. We use this license for certain libraries in order to permit linking those libraries into non-free programs. When a program is linked with a library, whether statically or using a shared library, the combination of the two is legally speaking a combined work, a derivative of the original library. The ordinary General Public License therefore permits such linking only if the entire combination fits its criteria of freedom. The Lesser General Public License permits more lax criteria for linking other code with the library. We call this license the "Lesser" General Public License because it does Less to protect the user's freedom than the ordinary General Public License. It also provides other free software developers Less of an advantage over competing non-free programs. These disadvantages are the reason we use the ordinary General Public License for many libraries. However, the Lesser license provides advantages in certain special circumstances. For example, on rare occasions, there may be a special need to encourage the widest possible use of a certain library, so that it becomes a de-facto standard. To achieve this, non-free programs must be allowed to use the library. A more frequent case is that a free library does the same job as widely used non-free libraries. In this case, there is little to gain by limiting the free library to free software only, so we use the Lesser General Public License. In other cases, permission to use a particular library in non-free programs enables a greater number of people to use a large body of free software. For example, permission to use the GNU C Library in non-free programs enables many more people to use the whole GNU operating system, as well as its variant, the GNU/Linux operating system. Although the Lesser General Public License is Less protective of the users' freedom, it does ensure that the user of a program that is linked with the Library has the freedom and the wherewithal to run that program using a modified version of the Library. The precise terms and conditions for copying, distribution and modification follow. Pay close attention to the difference between a "work based on the library" and a "work that uses the library". The former contains code derived from the library, whereas the latter must be combined with the library in order to run. GNU LESSER GENERAL PUBLIC LICENSE TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION 0. This License Agreement applies to any software library or other program which contains a notice placed by the copyright holder or other authorized party saying it may be distributed under the terms of this Lesser General Public License (also called "this License"). Each licensee is addressed as "you". A "library" means a collection of software functions and/or data prepared so as to be conveniently linked with application programs (which use some of those functions and data) to form executables. The "Library", below, refers to any such software library or work which has been distributed under these terms. A "work based on the Library" means either the Library or any derivative work under copyright law: that is to say, a work containing the Library or a portion of it, either verbatim or with modifications and/or translated straightforwardly into another language. (Hereinafter, translation is included without limitation in the term "modification".) "Source code" for a work means the preferred form of the work for making modifications to it. For a library, complete source code means all the source code for all modules it contains, plus any associated interface definition files, plus the scripts used to control compilation and installation of the library. Activities other than copying, distribution and modification are not covered by this License; they are outside its scope. The act of running a program using the Library is not restricted, and output from such a program is covered only if its contents constitute a work based on the Library (independent of the use of the Library in a tool for writing it). Whether that is true depends on what the Library does and what the program that uses the Library does. 1. You may copy and distribute verbatim copies of the Library's complete source code as you receive it, in any medium, provided that you conspicuously and appropriately publish on each copy an appropriate copyright notice and disclaimer of warranty; keep intact all the notices that refer to this License and to the absence of any warranty; and distribute a copy of this License along with the Library. You may charge a fee for the physical act of transferring a copy, and you may at your option offer warranty protection in exchange for a fee. 2. You may modify your copy or copies of the Library or any portion of it, thus forming a work based on the Library, and copy and distribute such modifications or work under the terms of Section 1 above, provided that you also meet all of these conditions: a) The modified work must itself be a software library. b) You must cause the files modified to carry prominent notices stating that you changed the files and the date of any change. c) You must cause the whole of the work to be licensed at no charge to all third parties under the terms of this License. d) If a facility in the modified Library refers to a function or a table of data to be supplied by an application program that uses the facility, other than as an argument passed when the facility is invoked, then you must make a good faith effort to ensure that, in the event an application does not supply such function or table, the facility still operates, and performs whatever part of its purpose remains meaningful. (For example, a function in a library to compute square roots has a purpose that is entirely well-defined independent of the application. Therefore, Subsection 2d requires that any application-supplied function or table used by this function must be optional: if the application does not supply it, the square root function must still compute square roots.) These requirements apply to the modified work as a whole. If identifiable sections of that work are not derived from the Library, and can be reasonably considered independent and separate works in themselves, then this License, and its terms, do not apply to those sections when you distribute them as separate works. But when you distribute the same sections as part of a whole which is a work based on the Library, the distribution of the whole must be on the terms of this License, whose permissions for other licensees extend to the entire whole, and thus to each and every part regardless of who wrote it. Thus, it is not the intent of this section to claim rights or contest your rights to work written entirely by you; rather, the intent is to exercise the right to control the distribution of derivative or collective works based on the Library. In addition, mere aggregation of another work not based on the Library with the Library (or with a work based on the Library) on a volume of a storage or distribution medium does not bring the other work under the scope of this License. 3. You may opt to apply the terms of the ordinary GNU General Public License instead of this License to a given copy of the Library. To do this, you must alter all the notices that refer to this License, so that they refer to the ordinary GNU General Public License, version 2, instead of to this License. (If a newer version than version 2 of the ordinary GNU General Public License has appeared, then you can specify that version instead if you wish.) Do not make any other change in these notices. Once this change is made in a given copy, it is irreversible for that copy, so the ordinary GNU General Public License applies to all subsequent copies and derivative works made from that copy. This option is useful when you wish to copy part of the code of the Library into a program that is not a library. 4. You may copy and distribute the Library (or a portion or derivative of it, under Section 2) in object code or executable form under the terms of Sections 1 and 2 above provided that you accompany it with the complete corresponding machine-readable source code, which must be distributed under the terms of Sections 1 and 2 above on a medium customarily used for software interchange. If distribution of object code is made by offering access to copy from a designated place, then offering equivalent access to copy the source code from the same place satisfies the requirement to distribute the source code, even though third parties are not compelled to copy the source along with the object code. 5. A program that contains no derivative of any portion of the Library, but is designed to work with the Library by being compiled or linked with it, is called a "work that uses the Library". Such a work, in isolation, is not a derivative work of the Library, and therefore falls outside the scope of this License. However, linking a "work that uses the Library" with the Library creates an executable that is a derivative of the Library (because it contains portions of the Library), rather than a "work that uses the library". The executable is therefore covered by this License. Section 6 states terms for distribution of such executables. When a "work that uses the Library" uses material from a header file that is part of the Library, the object code for the work may be a derivative work of the Library even though the source code is not. Whether this is true is especially significant if the work can be linked without the Library, or if the work is itself a library. The threshold for this to be true is not precisely defined by law. If such an object file uses only numerical parameters, data structure layouts and accessors, and small macros and small inline functions (ten lines or less in length), then the use of the object file is unrestricted, regardless of whether it is legally a derivative work. (Executables containing this object code plus portions of the Library will still fall under Section 6.) Otherwise, if the work is a derivative of the Library, you may distribute the object code for the work under the terms of Section 6. Any executables containing that work also fall under Section 6, whether or not they are linked directly with the Library itself. 6. As an exception to the Sections above, you may also combine or link a "work that uses the Library" with the Library to produce a work containing portions of the Library, and distribute that work under terms of your choice, provided that the terms permit modification of the work for the customer's own use and reverse engineering for debugging such modifications. You must give prominent notice with each copy of the work that the Library is used in it and that the Library and its use are covered by this License. You must supply a copy of this License. If the work during execution displays copyright notices, you must include the copyright notice for the Library among them, as well as a reference directing the user to the copy of this License. Also, you must do one of these things: a) Accompany the work with the complete corresponding machine-readable source code for the Library including whatever changes were used in the work (which must be distributed under Sections 1 and 2 above); and, if the work is an executable linked with the Library, with the complete machine-readable "work that uses the Library", as object code and/or source code, so that the user can modify the Library and then relink to produce a modified executable containing the modified Library. (It is understood that the user who changes the contents of definitions files in the Library will not necessarily be able to recompile the application to use the modified definitions.) b) Use a suitable shared library mechanism for linking with the Library. A suitable mechanism is one that (1) uses at run time a copy of the library already present on the user's computer system, rather than copying library functions into the executable, and (2) will operate properly with a modified version of the library, if the user installs one, as long as the modified version is interface-compatible with the version that the work was made with. c) Accompany the work with a written offer, valid for at least three years, to give the same user the materials specified in Subsection 6a, above, for a charge no more than the cost of performing this distribution. d) If distribution of the work is made by offering access to copy from a designated place, offer equivalent access to copy the above specified materials from the same place. e) Verify that the user has already received a copy of these materials or that you have already sent this user a copy. For an executable, the required form of the "work that uses the Library" must include any data and utility programs needed for reproducing the executable from it. However, as a special exception, the materials to be distributed need not include anything that is normally distributed (in either source or binary form) with the major components (compiler, kernel, and so on) of the operating system on which the executable runs, unless that component itself accompanies the executable. It may happen that this requirement contradicts the license restrictions of other proprietary libraries that do not normally accompany the operating system. Such a contradiction means you cannot use both them and the Library together in an executable that you distribute. 7. You may place library facilities that are a work based on the Library side-by-side in a single library together with other library facilities not covered by this License, and distribute such a combined library, provided that the separate distribution of the work based on the Library and of the other library facilities is otherwise permitted, and provided that you do these two things: a) Accompany the combined library with a copy of the same work based on the Library, uncombined with any other library facilities. This must be distributed under the terms of the Sections above. b) Give prominent notice with the combined library of the fact that part of it is a work based on the Library, and explaining where to find the accompanying uncombined form of the same work. 8. You may not copy, modify, sublicense, link with, or distribute the Library except as expressly provided under this License. Any attempt otherwise to copy, modify, sublicense, link with, or distribute the Library is void, and will automatically terminate your rights under this License. However, parties who have received copies, or rights, from you under this License will not have their licenses terminated so long as such parties remain in full compliance. 9. You are not required to accept this License, since you have not signed it. However, nothing else grants you permission to modify or distribute the Library or its derivative works. These actions are prohibited by law if you do not accept this License. Therefore, by modifying or distributing the Library (or any work based on the Library), you indicate your acceptance of this License to do so, and all its terms and conditions for copying, distributing or modifying the Library or works based on it. 10. Each time you redistribute the Library (or any work based on the Library), the recipient automatically receives a license from the original licensor to copy, distribute, link with or modify the Library subject to these terms and conditions. You may not impose any further restrictions on the recipients' exercise of the rights granted herein. You are not responsible for enforcing compliance by third parties with this License. 11. If, as a consequence of a court judgment or allegation of patent infringement or for any other reason (not limited to patent issues), conditions are imposed on you (whether by court order, agreement or otherwise) that contradict the conditions of this License, they do not excuse you from the conditions of this License. If you cannot distribute so as to satisfy simultaneously your obligations under this License and any other pertinent obligations, then as a consequence you may not distribute the Library at all. For example, if a patent license would not permit royalty-free redistribution of the Library by all those who receive copies directly or indirectly through you, then the only way you could satisfy both it and this License would be to refrain entirely from distribution of the Library. If any portion of this section is held invalid or unenforceable under any particular circumstance, the balance of the section is intended to apply, and the section as a whole is intended to apply in other circumstances. It is not the purpose of this section to induce you to infringe any patents or other property right claims or to contest validity of any such claims; this section has the sole purpose of protecting the integrity of the free software distribution system which is implemented by public license practices. Many people have made generous contributions to the wide range of software distributed through that system in reliance on consistent application of that system; it is up to the author/donor to decide if he or she is willing to distribute software through any other system and a licensee cannot impose that choice. This section is intended to make thoroughly clear what is believed to be a consequence of the rest of this License. 12. If the distribution and/or use of the Library is restricted in certain countries either by patents or by copyrighted interfaces, the original copyright holder who places the Library under this License may add an explicit geographical distribution limitation excluding those countries, so that distribution is permitted only in or among countries not thus excluded. In such case, this License incorporates the limitation as if written in the body of this License. 13. The Free Software Foundation may publish revised and/or new versions of the Lesser General Public License from time to time. Such new versions will be similar in spirit to the present version, but may differ in detail to address new problems or concerns. Each version is given a distinguishing version number. If the Library specifies a version number of this License which applies to it and "any later version", you have the option of following the terms and conditions either of that version or of any later version published by the Free Software Foundation. If the Library does not specify a license version number, you may choose any version ever published by the Free Software Foundation. 14. If you wish to incorporate parts of the Library into other free programs whose distribution conditions are incompatible with these, write to the author to ask for permission. For software which is copyrighted by the Free Software Foundation, write to the Free Software Foundation; we sometimes make exceptions for this. Our decision will be guided by the two goals of preserving the free status of all derivatives of our free software and of promoting the sharing and reuse of software generally. NO WARRANTY 15. BECAUSE THE LIBRARY IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY FOR THE LIBRARY, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES PROVIDE THE LIBRARY "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE LIBRARY IS WITH YOU. SHOULD THE LIBRARY PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING, REPAIR OR CORRECTION. 16. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR REDISTRIBUTE THE LIBRARY AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE THE LIBRARY (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A FAILURE OF THE LIBRARY TO OPERATE WITH ANY OTHER SOFTWARE), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGES. END OF TERMS AND CONDITIONS coq-8.20.0/Makefile000066400000000000000000000234111466560755400140460ustar00rootroot00000000000000########################################################################## ## # The Coq Proof Assistant / The Coq Development Team ## ## v # Copyright INRIA, CNRS and contributors ## ## " @echo " $$ make dunestrap" @echo " $$ dune build -p coq-core,coq-stdlib" @echo " $$ dune install --prefix= coq-core coq-stdlib" @echo "" @echo " Provided opam/dune packages are:" @echo "" @echo " - coq-core: base Coq package, toplevel compilers, plugins, tools, no stdlib, no GTK" @echo " - coq-stdlib: Coq's standard library" @echo " - coqide-server: XML protocol language server" @echo " - coqide: CoqIDE gtk application" @echo " - coq: meta package depending on coq-core coq-stdlib" @echo "" @echo " To build a package, you can use:" @echo "" @echo " - 'dune build package.install' : build package in developer mode" @echo " - 'dune build -p package' : build package in release mode" @echo "" @echo " Packages _must_ be installed only if built using release mode, to install a package use: " @echo "" @echo " - 'dune install --prefix= package'" @echo "" @echo " Note that '--prefix' must be passed to dune install. The '-prefix' passed to" @echo " configure tells Coq where to look for libraries." @echo "" @echo " Note that building a package in release mode ignores other packages present in" @echo " the worktree. See Dune documentation for more information." # We setup the root even in dev mode, to avoid some problems. We used # this in the past to workaround a bug in opam, but the bug was that # we didn't pass `-p` to the dune build below. # # This would be fixed once dune can directly use `(include # theories_dune)` in our files. DUNESTRAPOPT=--root . # We regenerate always as to correctly track deps, can do better # We do a single call to dune as to avoid races and locking _build/default/theories_dune _build/default/ltac2_dune .dune-stamp: FORCE dune build $(DUNEOPT) $(DUNESTRAPOPT) theories_dune ltac2_dune touch .dune-stamp theories/dune: .dune-stamp cp -a _build/default/theories_dune $@ && chmod +w $@ user-contrib/Ltac2/dune: .dune-stamp cp -a _build/default/ltac2_dune $@ && chmod +w $@ FORCE: ; DUNE_FILES=theories/dune user-contrib/Ltac2/dune dunestrap: $(DUNE_FILES) states: dunestrap dune build $(DUNEOPT) dev/shim/coqtop NONDOC_INSTALL_TARGETS:=coq-core.install coq-stdlib.install coqide-server.install coqide.install coq.install world: dunestrap dune build $(DUNEOPT) $(NONDOC_INSTALL_TARGETS) watch: dune build $(DUNEOPT) $(NONDOC_INSTALL_TARGETS) -w check: dune build $(DUNEOPT) @check test-suite: dunestrap dune runtest --no-buffer $(DUNEOPT) refman-html: dunestrap dune build --no-buffer @refman-html refman-pdf: dunestrap dune build --no-buffer @refman-pdf stdlib-html: dunestrap dune build @stdlib-html apidoc: dune build $(DUNEOPT) @doc release: theories/dune @echo "release target is deprecated, use dune directly" dune build $(DUNEOPT) -p coq # We define this target as to override Make's built-in one install: @echo "To install Coq using dune, use 'dune build -p P && dune install P'" @echo "where P is any of the packages defined by opam files in the root dir" @false fmt: dune build @fmt --auto-promote ocheck: dune build $(DUNEOPT) @check --workspace=dev/dune-workspace.all obuild: dunestrap dune build $(DUNEOPT) @default --workspace=dev/dune-workspace.all ireport: dune clean dune build $(DUNEOPT) @install --profile=ireport clean: rm -f .dune-stamp dune clean # docgram DOC_GRAM:=_build/default/doc/tools/docgram/doc_grammar.exe # not worth figuring out dependencies, just leave it to dune .PHONY: $(DOC_GRAM) $(DOC_GRAM): dune build $(DUNEOPT) $@ include doc/Makefile.docgram # This requires a install layout to be available. CONTEXT=_build/install/default # XXX: Port this to a dune alias so the build is hygienic! .PHONY: plugin-tutorial plugin-tutorial: dunestrap dune build $(CONTEXT)/lib/coq-core/META coq-core.install theories/Init/Prelude.vo +$(MAKE) OCAMLPATH=$(shell pwd)/$(CONTEXT)/lib/ COQBIN=$(shell pwd)/$(CONTEXT)/bin/ COQCORELIB=$(shell pwd)/$(CONTEXT)/lib/coq-core COQLIB=$(shell pwd)/_build/default/ -C doc/plugin_tutorial # This is broken in a very weird way with a permission error... see # the rule in doc/plugin_tutorial/dune: # plugin-tutorial: dunestrap # dune build @plugin-tutorial # ci-* targets CI_PURE_DUNE:=1 export CI_PURE_DUNE include Makefile.ci # Custom targets to create subsets of the world target but with less # compiled files. This is desired when we want to have our Coq Dune # build with Coq developments that are not dunerized and thus still # expect an install layout with a working Coq setup, but smaller than # world. # # Unfortunately, Dune still lacks the capability to refer to install # targets in rules, see https://github.com/ocaml/dune/issues/3192 ; # thus we can't simply yet use `%{pkg:coq:theories/Arith/Arith.vo` to # have the rule install the target, we thus imitate such behavior # using make as a helper. # $(1) is the directory (theories/Foo/) # $(2) is the name (foo) define subtarget = .PHONY: theories-$(2) $(2)_FILES=$$(wildcard $(1)*.v) $(2)_FILES_PATH=$$(addprefix _build/install/default/lib/coq/, $$($(2)_FILES:.v=.vo)) theories-$(2): @echo "DUNE $(1)*.vo" @dune build $$($(2)_FILES_PATH) endef $(foreach subdir,$(wildcard theories/*/),$(eval $(call subtarget,$(subdir),$(shell echo $(subst /,,$(subst theories/,,$(subdir))) | tr A-Z a-z)))) # Other common dev targets: # # dune build coq-core.install # dune build coq.install # dune build coqide.install # # Packaging / OPAM targets: # # dune -p coq @install # dune -p coqide @install coq-8.20.0/Makefile.ci000066400000000000000000000111151466560755400144360ustar00rootroot00000000000000########################################################################## ## # The Coq Proof Assistant / The Coq Development Team ## ## v # Copyright INRIA, CNRS and contributors ## ## Util.check_file_else ~dir:Coq_config.coqlibsuffix ~file:prelude (fun () -> if Sys.file_exists (Filename.concat Coq_config.coqlib prelude) then Coq_config.coqlib else fail ())) (* Build layout uses coqlib = coqcorelib *) let guess_coqcorelib lib = if Sys.file_exists (Path.relative lib plugins_dir) then lib else Path.relative lib "../coq-core" let fail_lib lib = let open Printf in eprintf "File not found: %s\n" lib; eprintf "The path for Coq libraries is wrong.\n"; eprintf "Coq libraries are shipped in the coq-stdlib package.\n"; eprintf "Please check the COQLIB env variable or the -coqlib option.\n"; exit 1 let fail_core plugin = let open Printf in eprintf "File not found: %s\n" plugin; eprintf "The path for Coq plugins is wrong.\n"; eprintf "Coq plugins are shipped in the coq-core package.\n"; eprintf "Please check the COQCORELIB env variable.\n"; exit 1 let validate_env ({ core; lib } as env) = let lib = Filename.concat lib prelude in if not (Sys.file_exists lib) then fail_lib lib; let plugin = Filename.concat core plugins_dir in if not (Sys.file_exists plugin) then fail_core plugin; env (* Should we fail on double initialization? That seems a way to avoid mis-use for example when we pass command line arguments *) let init () = let lib = guess_coqlib () in let core = Util.getenv_else "COQCORELIB" (fun () -> guess_coqcorelib lib) in validate_env { core ; lib } let env_ref = ref None let init () = match !env_ref with | None -> let env = init () in env_ref := Some env; env | Some env -> env let set_coqlib lib = let env = validate_env { lib; core = guess_coqcorelib lib } in env_ref := Some env let coqlib { lib; _ } = lib let corelib { core; _ } = core let plugins { core; _ } = Path.relative core plugins_dir let stdlib { lib; _ } = Path.relative lib theories_dir let user_contrib { lib; _ } = Path.relative lib "user-contrib" let tool { core; _ } tool = Path.(relative (relative core "tools") tool) let revision { core; _ } = Path.relative core "revision" let native_cmi { core; _ } lib = let install_path = Path.relative core lib in if Sys.file_exists install_path then install_path else (* Dune build layout, we need to improve this *) let obj_dir = Format.asprintf ".%s.objs" lib in Filename.(concat (concat (concat core lib) obj_dir) "byte") coq-8.20.0/boot/env.mli000066400000000000000000000076661466560755400146620ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* string -> t (** We should gradually add some more functions to handle common dirs here such the theories directories or share files. Abstracting it hereere does allow to use system-specific functionalities *) (** [exists file] checks if [file] exists *) val exists : t -> bool (** String representation *) val to_string : t -> string end (** Coq runtime enviroment, including location of Coq's stdlib *) type t (** [init ()] will initialize the Coq environment. *) val init : unit -> t (** [stdlib directory] *) val stdlib : t -> Path.t (** [plugins directory] *) val plugins : t -> Path.t (** [user contrib directory] *) val user_contrib : t -> Path.t (** [tool-specific directory] *) val tool : t -> string -> Path.t (** .cmi files needed for native compilation *) val native_cmi : t -> string -> Path.t (** The location of the revision file *) val revision : t -> Path.t (** coq-core/lib directory, not sure if to keep this *) val corelib : t -> Path.t (** coq/lib directory, not sure if to keep this *) val coqlib : t -> Path.t (** Internal, should be set automatically by passing cmdline args to init; note that this will set both [coqlib] and [corelib] for now. *) val set_coqlib : string -> unit coq-8.20.0/boot/path.ml000066400000000000000000000013271466560755400146410ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* set the output directory for native objects\ \n -nI dir OCaml include directories for the native compiler (default if not set) \ \n -h, -help, --help print this list of options\ \n" (* print the usage *) type specific_usage = { executable_name : string; extra_args : string; extra_options : string; } let print_usage co { executable_name; extra_args; extra_options } = print_usage_common co ("Usage: " ^ executable_name ^ " " ^ extra_args ^ "\n\n"); output_string co extra_options coq-8.20.0/boot/usage.mli000066400000000000000000000022121466560755400151540ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* unit val machine_readable_version : unit -> unit (** {6 extra arguments or options to print when asking usage for a given executable. } *) type specific_usage = { executable_name : string; extra_args : string; extra_options : string; } (** {6 Prints the generic part and specific part of usage for a given executable. } *) val print_usage : out_channel -> specific_usage -> unit coq-8.20.0/boot/util.ml000066400000000000000000000051721466560755400146640ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* Some(name,value)) with _ -> None let with_ic file f = let ic = open_in file in try let rc = f ic in close_in ic; rc with e -> close_in ic; raise e let getenv_from_file name = let base = Filename.dirname Sys.executable_name in try with_ic (base ^ "/coq_environment.txt") (fun ic -> let rec find () = let l = input_line ic in match parse_env_line l with | Some(n,v) when n = name -> v | _ -> find () in find ()) with | Sys_error s -> raise Not_found | End_of_file -> raise Not_found let system_getenv name = try Sys.getenv name with Not_found -> getenv_from_file name let getenv_else s dft = try system_getenv s with Not_found -> dft () (** Add a local installation suffix (unless the suffix is itself absolute in which case the prefix does not matter) *) let use_suffix prefix suffix = if String.length suffix > 0 && suffix.[0] = '/' then suffix else Filename.concat prefix suffix let canonical_path_name p = let current = Sys.getcwd () in try Sys.chdir p; let p' = Sys.getcwd () in Sys.chdir current; p' with Sys_error _ -> (* We give up to find a canonical name and just simplify it... *) Filename.concat current p let coqbin = canonical_path_name (Filename.dirname Sys.executable_name) (** The following only makes sense when executables are running from source tree (e.g. during build or in local mode). *) let coqroot = Filename.dirname coqbin (** [check_file_else ~dir ~file oth] checks if [file] exists in the installation directory [dir] given relatively to [coqroot], which maybe has been relocated. If the check fails, then [oth ()] is evaluated. Using file system equality seems well enough for this heuristic *) let check_file_else ~dir ~file oth = let path = use_suffix coqroot dir in if Sys.file_exists (Filename.concat path file) then path else oth () coq-8.20.0/boot/util.mli000066400000000000000000000014541466560755400150340ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* (unit -> string) -> string val check_file_else : dir:string -> file:string -> (unit -> string) -> string coq-8.20.0/checker/000077500000000000000000000000001466560755400140115ustar00rootroot00000000000000coq-8.20.0/checker/analyze.ml000066400000000000000000000316541466560755400160170ustar00rootroot00000000000000(** Headers *) let prefix_small_block = 0x80 let prefix_small_int = 0x40 let prefix_small_string = 0x20 [@@@ocaml.warning "-32"] let code_int8 = 0x00 let code_int16 = 0x01 let code_int32 = 0x02 let code_int64 = 0x03 let code_shared8 = 0x04 let code_shared16 = 0x05 let code_shared32 = 0x06 let code_double_array32_little = 0x07 let code_block32 = 0x08 let code_string8 = 0x09 let code_string32 = 0x0A let code_double_big = 0x0B let code_double_little = 0x0C let code_double_array8_big = 0x0D let code_double_array8_little = 0x0E let code_double_array32_big = 0x0F let code_codepointer = 0x10 let code_infixpointer = 0x11 let code_custom = 0x12 let code_block64 = 0x13 let code_shared64 = 0x14 let code_string64 = 0x15 let code_double_array64_big = 0x16 let code_double_array64_little = 0x17 let code_custom_len = 0x18 let code_custom_fixed = 0x19 [@@@ocaml.warning "-37"] type code_descr = | CODE_INT8 | CODE_INT16 | CODE_INT32 | CODE_INT64 | CODE_SHARED8 | CODE_SHARED16 | CODE_SHARED32 | CODE_DOUBLE_ARRAY32_LITTLE | CODE_BLOCK32 | CODE_STRING8 | CODE_STRING32 | CODE_DOUBLE_BIG | CODE_DOUBLE_LITTLE | CODE_DOUBLE_ARRAY8_BIG | CODE_DOUBLE_ARRAY8_LITTLE | CODE_DOUBLE_ARRAY32_BIG | CODE_CODEPOINTER | CODE_INFIXPOINTER | CODE_CUSTOM | CODE_BLOCK64 | CODE_SHARED64 | CODE_STRING64 | CODE_DOUBLE_ARRAY64_BIG | CODE_DOUBLE_ARRAY64_LITTLE | CODE_CUSTOM_LEN | CODE_CUSTOM_FIXED let code_max = 0x19 let magic_number = "\132\149\166\190" (** Memory reification *) module LargeArray : sig type 'a t val empty : 'a t val length : 'a t -> int val make : int -> 'a -> 'a t val get : 'a t -> int -> 'a val set : 'a t -> int -> 'a -> unit end = struct let max_length = Sys.max_array_length type 'a t = 'a array array * 'a array (** Invariants: - All subarrays of the left array have length [max_length]. - The right array has length < [max_length]. *) let empty = [||], [||] let length (vl, vr) = (max_length * Array.length vl) + Array.length vr let make n x = let k = n / max_length in let r = n mod max_length in let vl = Array.init k (fun _ -> Array.make max_length x) in let vr = Array.make r x in (vl, vr) let get (vl, vr) n = let k = n / max_length in let r = n mod max_length in let len = Array.length vl in if k < len then vl.(k).(r) else if k == len then vr.(r) else invalid_arg "index out of bounds" let set (vl, vr) n x = let k = n / max_length in let r = n mod max_length in let len = Array.length vl in if k < len then vl.(k).(r) <- x else if k == len then vr.(r) <- x else invalid_arg "index out of bounds" end type repr = | RInt of int | Rint64 of Int64.t | RFloat64 of float | RBlock of (int * int) (* tag × len *) | RString of string | RPointer of int | RCode of int type data = | Int of int (* value *) | Ptr of int (* pointer *) | Atm of int (* tag *) | Fun of int (* address *) type obj = | Struct of int * data array (* tag × data *) | Int64 of Int64.t (* Primitive integer *) | Float64 of float (* Primitive float *) | String of string module type Input = sig type t val input_byte : t -> int val input_binary_int : t -> int end module type S = sig type input val parse : input -> (data * obj LargeArray.t) end module Make(M : Input) = struct open M type input = M.t let current_offset = ref 0 let input_byte chan = let () = incr current_offset in input_byte chan let input_binary_int chan = let () = current_offset := !current_offset + 4 in input_binary_int chan let input_char chan = Char.chr (input_byte chan) let input_string len chan = String.init len (fun _ -> input_char chan) let parse_header chan = let () = current_offset := 0 in let magic = input_string 4 chan in let length = input_binary_int chan in let objects = input_binary_int chan in let size32 = input_binary_int chan in let size64 = input_binary_int chan in (magic, length, size32, size64, objects) let input_int8s chan = let i = input_byte chan in if i land 0x80 = 0 then i else i lor ((-1) lsl 8) let input_int8u = input_byte let input_int16s chan = let i = input_byte chan in let j = input_byte chan in let ans = (i lsl 8) lor j in if i land 0x80 = 0 then ans else ans lor ((-1) lsl 16) let input_int16u chan = let i = input_byte chan in let j = input_byte chan in (i lsl 8) lor j let input_int32s chan = let i = input_byte chan in let j = input_byte chan in let k = input_byte chan in let l = input_byte chan in let ans = (i lsl 24) lor (j lsl 16) lor (k lsl 8) lor l in if i land 0x80 = 0 then ans else ans lor ((-1) lsl 31) let input_int32u chan = let i = input_byte chan in let j = input_byte chan in let k = input_byte chan in let l = input_byte chan in (i lsl 24) lor (j lsl 16) lor (k lsl 8) lor l let input_int64s chan = let i = input_byte chan in let j = input_byte chan in let k = input_byte chan in let l = input_byte chan in let m = input_byte chan in let n = input_byte chan in let o = input_byte chan in let p = input_byte chan in let ans = (i lsl 56) lor (j lsl 48) lor (k lsl 40) lor (l lsl 32) lor (m lsl 24) lor (n lsl 16) lor (o lsl 8) lor p in if i land 0x80 = 0 then ans else ans lor ((-1) lsl 63) let input_int64u chan = let i = input_byte chan in let j = input_byte chan in let k = input_byte chan in let l = input_byte chan in let m = input_byte chan in let n = input_byte chan in let o = input_byte chan in let p = input_byte chan in (i lsl 56) lor (j lsl 48) lor (k lsl 40) lor (l lsl 32) lor (m lsl 24) lor (n lsl 16) lor (o lsl 8) lor p let input_header32 chan = let i = input_byte chan in let j = input_byte chan in let k = input_byte chan in let l = input_byte chan in let tag = l in let len = (i lsl 14) lor (j lsl 6) lor (k lsr 2) in (tag, len) let input_header64 chan = let i = input_byte chan in let j = input_byte chan in let k = input_byte chan in let l = input_byte chan in let m = input_byte chan in let n = input_byte chan in let o = input_byte chan in let p = input_byte chan in let tag = p in let len = (i lsl 46) lor (j lsl 38) lor (k lsl 30) lor (l lsl 22) lor (m lsl 14) lor (n lsl 6) lor (o lsr 2) in (tag, len) let input_cstring chan : string = let buff = Buffer.create 17 in let rec loop () = match input_char chan with | '\o000' -> Buffer.contents buff | c -> Buffer.add_char buff c |> loop in loop () let input_intL chan : int64 = let i = input_byte chan in let j = input_byte chan in let k = input_byte chan in let l = input_byte chan in let m = input_byte chan in let n = input_byte chan in let o = input_byte chan in let p = input_byte chan in let ( lsl ) x y = Int64.(shift_left (of_int x) y) in let ( lor ) = Int64.logor in (i lsl 56) lor (j lsl 48) lor (k lsl 40) lor (l lsl 32) lor (m lsl 24) lor (n lsl 16) lor (o lsl 8) lor (Int64.of_int p) let input_double_big chan : float = Int64.float_of_bits (input_intL chan) let input_double_little chan : float = let i = input_byte chan in let j = input_byte chan in let k = input_byte chan in let l = input_byte chan in let m = input_byte chan in let n = input_byte chan in let o = input_byte chan in let p = input_byte chan in let ( lsl ) x y = Int64.(shift_left (of_int x) y) in let ( lor ) = Int64.logor in let bits = (p lsl 56) lor (o lsl 48) lor (n lsl 40) lor (m lsl 32) lor (l lsl 24) lor (k lsl 16) lor (j lsl 8) lor (Int64.of_int i) in Int64.float_of_bits bits let parse_object chan = let data = input_byte chan in if prefix_small_block <= data then let tag = data land 0x0F in let len = (data lsr 4) land 0x07 in RBlock (tag, len) else if prefix_small_int <= data then RInt (data land 0x3F) else if prefix_small_string <= data then let len = data land 0x1F in RString (input_string len chan) else if data > code_max then assert false else match (Obj.magic data) with | CODE_INT8 -> RInt (input_int8s chan) | CODE_INT16 -> RInt (input_int16s chan) | CODE_INT32 -> RInt (input_int32s chan) | CODE_INT64 -> RInt (input_int64s chan) | CODE_SHARED8 -> RPointer (input_int8u chan) | CODE_SHARED16 -> RPointer (input_int16u chan) | CODE_SHARED32 -> RPointer (input_int32u chan) | CODE_BLOCK32 -> RBlock (input_header32 chan) | CODE_BLOCK64 -> RBlock (input_header64 chan) | CODE_STRING8 -> let len = input_int8u chan in RString (input_string len chan) | CODE_STRING32 -> let len = input_int32u chan in RString (input_string len chan) | CODE_CODEPOINTER -> let addr = input_int32u chan in for _i = 0 to 15 do ignore (input_byte chan); done; RCode addr | CODE_CUSTOM | CODE_CUSTOM_FIXED -> begin match input_cstring chan with | "_j" -> Rint64 (input_intL chan) | s -> Printf.eprintf "Unhandled custom code: %s" s; assert false end | CODE_DOUBLE_BIG -> RFloat64 (input_double_big chan) | CODE_DOUBLE_LITTLE -> RFloat64 (input_double_little chan) | CODE_DOUBLE_ARRAY32_LITTLE | CODE_DOUBLE_ARRAY8_BIG | CODE_DOUBLE_ARRAY8_LITTLE | CODE_DOUBLE_ARRAY32_BIG | CODE_INFIXPOINTER | CODE_SHARED64 | CODE_STRING64 | CODE_DOUBLE_ARRAY64_BIG | CODE_DOUBLE_ARRAY64_LITTLE | CODE_CUSTOM_LEN -> Printf.eprintf "Unhandled code %04x\n%!" data; assert false let parse chan = let (magic, len, _, _, size) = parse_header chan in let () = assert (magic = magic_number) in let memory = LargeArray.make size (Struct ((-1), [||])) in let current_object = ref 0 in let fill_obj = function | RPointer n -> let data = Ptr (!current_object - n) in data, None | RInt n -> let data = Int n in data, None | RString s -> let data = Ptr !current_object in let () = LargeArray.set memory !current_object (String s) in let () = incr current_object in data, None | RBlock (tag, 0) -> (* Atoms are never shared *) let data = Atm tag in data, None | RBlock (tag, len) -> let data = Ptr !current_object in let nblock = Array.make len (Atm (-1)) in let () = LargeArray.set memory !current_object (Struct (tag, nblock)) in let () = incr current_object in data, Some nblock | RCode addr -> let data = Fun addr in data, None | Rint64 i -> let data = Ptr !current_object in let () = LargeArray.set memory !current_object (Int64 i) in let () = incr current_object in data, None | RFloat64 f -> let data = Ptr !current_object in let () = LargeArray.set memory !current_object (Float64 f) in let () = incr current_object in data, None in let rec fill block off accu = if Array.length block = off then match accu with | [] -> () | (block, off) :: accu -> fill block off accu else let data, nobj = fill_obj (parse_object chan) in let () = block.(off) <- data in let block, off, accu = match nobj with | None -> block, succ off, accu | Some nblock -> nblock, 0, ((block, succ off) :: accu) in fill block off accu in let ans = [|Atm (-1)|] in let () = fill ans 0 [] in (ans.(0), memory) end module IChannel = struct type t = in_channel let input_byte = input_byte let input_binary_int = input_binary_int end module IString = struct type t = (string * int ref) let input_byte (s, off) = let ans = Char.code (s.[!off]) in let () = incr off in ans let input_binary_int chan = let i = input_byte chan in let j = input_byte chan in let k = input_byte chan in let l = input_byte chan in let ans = (i lsl 24) lor (j lsl 16) lor (k lsl 8) lor l in if i land 0x80 = 0 then ans else ans lor ((-1) lsl 31) end module PChannel = Make(IChannel) module PString = Make(IString) let parse_channel = PChannel.parse let parse_string s = PString.parse (s, ref 0) let instantiate (p, mem) = let len = LargeArray.length mem in let ans = LargeArray.make len (Obj.repr 0) in (* First pass: initialize the subobjects *) for i = 0 to len - 1 do let obj = match LargeArray.get mem i with | Struct (tag, blk) -> Obj.new_block tag (Array.length blk) | Int64 i -> Obj.repr i | Float64 f -> Obj.repr f | String str -> Obj.repr str in LargeArray.set ans i obj done; let get_data = function | Int n -> Obj.repr n | Ptr p -> LargeArray.get ans p | Atm tag -> Obj.new_block tag 0 | Fun _ -> assert false (* We shouldn't serialize closures *) in (* Second pass: set the pointers *) for i = 0 to len - 1 do match LargeArray.get mem i with | Struct (_, blk) -> let obj = LargeArray.get ans i in for k = 0 to Array.length blk - 1 do Obj.set_field obj k (get_data blk.(k)) done | Int64 _ | Float64 _ | String _ -> () done; get_data p coq-8.20.0/checker/analyze.mli000066400000000000000000000025401466560755400161600ustar00rootroot00000000000000(** Representation of data allocated on the OCaml heap. *) type data = | Int of int | Ptr of int | Atm of int (* tag *) | Fun of int (* address *) type obj = | Struct of int * data array (* tag × data *) | Int64 of Int64.t (* Primitive integer *) | Float64 of float (* Primitive float *) | String of string module LargeArray : sig type 'a t val empty : 'a t val length : 'a t -> int val make : int -> 'a -> 'a t val get : 'a t -> int -> 'a val set : 'a t -> int -> 'a -> unit end (** A data structure similar to arrays but allowing to overcome the 2^22 length limitation on 32-bit architecture. *) val parse_channel : in_channel -> (data * obj LargeArray.t) val parse_string : string -> (data * obj LargeArray.t) (** {6 Functorized version} *) module type Input = sig type t val input_byte : t -> int (** Input a single byte *) val input_binary_int : t -> int (** Input a big-endian 31-bits signed integer *) end (** Type of inputs *) module type S = sig type input val parse : input -> (data * obj LargeArray.t) (** Return the entry point and the reification of the memory out of a marshalled structure. *) end module Make (M : Input) : S with type input = M.t (** Functorized version of the previous code. *) val instantiate : data * obj LargeArray.t -> Obj.t (** Create the OCaml object out of the reified representation. *) coq-8.20.0/checker/check.ml000066400000000000000000000373061466560755400154310ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* failwith "path_of_dirpath" | l::dir -> {dirpath=List.map Id.to_string dir;basename=Id.to_string l} let pr_dirlist dp = prlist_with_sep (fun _ -> str".") str (List.rev dp) let pr_path sp = match sp.dirpath with [] -> str sp.basename | sl -> pr_dirlist sl ++ str"." ++ str sp.basename (************************************************************************) (*s Modules loaded in memory contain the following informations. They are kept in the global table [libraries_table]. *) type compilation_unit_name = DirPath.t type seg_proofs = Opaqueproof.opaque_proofterm option array type library_t = { library_name : compilation_unit_name; library_filename : CUnix.physical_path; library_compiled : Safe_typing.compiled_library; library_opaques : seg_proofs; library_deps : (compilation_unit_name * Safe_typing.vodigest) array; library_digest : Safe_typing.vodigest; library_vm : Vmlibrary.on_disk; } module LibraryOrdered = struct type t = DirPath.t let compare d1 d2 = compare (List.rev (DirPath.repr d1)) (List.rev (DirPath.repr d2)) end module LibrarySet = Set.Make(LibraryOrdered) module LibraryMap = Map.Make(LibraryOrdered) (* This is a map from names to loaded libraries *) let libraries_table = ref LibraryMap.empty (* various requests to the tables *) let find_library dir = LibraryMap.find dir !libraries_table let library_full_filename dir = (find_library dir).library_filename (* If a library is loaded several time, then the first occurrence must be performed first, thus the libraries_loaded_list ... *) let register_loaded_library m = libraries_table := LibraryMap.add m.library_name m !libraries_table (* Map from library names to table of opaque terms *) let opaque_tables = ref LibraryMap.empty let access_opaque_table dp i = let t = try LibraryMap.find dp !opaque_tables with Not_found -> assert false in let i = Opaqueproof.repr_handle i in let () = assert (0 <= i && i < Array.length t) in t.(i) let indirect_accessor o = let (sub, ci, dp, i) = Opaqueproof.repr o in let c = access_opaque_table dp i in let c = match c with | None -> CErrors.user_err Pp.(str "Cannot access opaque delayed proof.") | Some c -> c in let (c, prv) = Discharge.cook_opaque_proofterm ci c in let c = Mod_subst.subst_mps_list sub c in (c, prv) let () = Mod_checking.set_indirect_accessor indirect_accessor let check_one_lib admit senv (dir,m) = let md = m.library_compiled in let dig = m.library_digest in (* Look up if the library is to be admitted correct. We could also check if it carries a validation certificate (yet to be implemented). *) let senv = if LibrarySet.mem dir admit then (Flags.if_verbose Feedback.msg_notice (str "Admitting library: " ++ pr_dirpath dir); Safe_checking.unsafe_import (fst senv) md m.library_vm dig), (snd senv) else (Flags.if_verbose Feedback.msg_notice (str "Checking library: " ++ pr_dirpath dir); Safe_checking.import (fst senv) (snd senv) md m.library_vm dig) in register_loaded_library m; senv (*************************************************************************) (*s Load path. Mapping from physical to logical paths etc.*) type logical_path = DirPath.t let load_paths = ref ([],[] : CUnix.physical_path list * logical_path list) let find_logical_path phys_dir = let phys_dir = CUnix.canonical_path_name phys_dir in let physical, logical = !load_paths in match List.filter2 (fun p d -> p = phys_dir) physical logical with | _,[dir] -> dir | _,[] -> default_root_prefix | _,l -> CErrors.anomaly (Pp.str ("Two logical paths are associated to "^phys_dir^".")) let remove_load_path dir = let physical, logical = !load_paths in load_paths := List.filter2 (fun p d -> p <> dir) physical logical let add_load_path (phys_path,coq_path) = if CDebug.(get_flag misc) then Feedback.msg_notice (str "path: " ++ pr_dirpath coq_path ++ str " ->" ++ spc() ++ str phys_path); let phys_path = CUnix.canonical_path_name phys_path in let physical, logical = !load_paths in match List.filter2 (fun p d -> p = phys_path) physical logical with | _,[dir] -> if coq_path <> dir (* If this is not the default -I . to coqtop *) && not (phys_path = CUnix.canonical_path_name Filename.current_dir_name && coq_path = default_root_prefix) then begin (* Assume the user is concerned by library naming *) if dir <> default_root_prefix then Feedback.msg_warning (str phys_path ++ strbrk " was previously bound to " ++ pr_dirpath dir ++ strbrk "; it is remapped to " ++ pr_dirpath coq_path); remove_load_path phys_path; load_paths := (phys_path::fst !load_paths, coq_path::snd !load_paths) end | _,[] -> load_paths := (phys_path :: fst !load_paths, coq_path :: snd !load_paths) | _ -> CErrors.anomaly (Pp.str ("Two logical paths are associated to "^phys_path^".")) let load_paths_of_dir_path dir = let physical, logical = !load_paths in fst (List.filter2 (fun p d -> d = dir) physical logical) (************************************************************************) (*s Locate absolute or partially qualified library names in the path *) exception LibUnmappedDir exception LibNotFound let locate_absolute_library dir = (* Search in loadpath *) let pref, base = split_dirpath dir in let loadpath = load_paths_of_dir_path pref in if loadpath = [] then raise LibUnmappedDir; try let name = Id.to_string base^".vo" in let _, file = System.where_in_path ~warn:false loadpath name in (dir, file) with Not_found -> (* Last chance, removed from the file system but still in memory *) try (dir, library_full_filename dir) with Not_found -> raise LibNotFound let locate_qualified_library qid = try (* we assume qid is an absolute dirpath *) let loadpath = load_paths_of_dir_path (dir_of_path qid) in if loadpath = [] then raise LibUnmappedDir; let name = qid.basename^".vo" in let path, file = System.where_in_path loadpath name in let dir = extend_dirpath (find_logical_path path) (Id.of_string qid.basename) in (* Look if loaded *) try (dir, library_full_filename dir) with Not_found -> (dir, file) with Not_found -> raise LibNotFound let error_unmapped_dir qid = let prefix = qid.dirpath in CErrors.user_err (str "Cannot load " ++ pr_path qid ++ str ":" ++ spc () ++ str "no physical path bound to" ++ spc () ++ pr_dirlist prefix ++ str "." ++ fnl ()) let error_lib_not_found qid = CErrors.user_err (str "Cannot find library " ++ pr_path qid ++ str " in loadpath.") let try_locate_absolute_library dir = try locate_absolute_library dir with | LibUnmappedDir -> error_unmapped_dir (path_of_dirpath dir) | LibNotFound -> error_lib_not_found (path_of_dirpath dir) let try_locate_qualified_library lib = match lib with | PhysicalFile f -> let () = if not (System.file_exists_respecting_case "" f) then error_lib_not_found { dirpath = []; basename = f; } in let dir = Filename.dirname f in let base = Filename.chop_extension (Filename.basename f) in let dir = extend_dirpath (find_logical_path dir) (Id.of_string base) in (dir, f) | LogicalFile qid -> try locate_qualified_library qid with | LibUnmappedDir -> error_unmapped_dir qid | LibNotFound -> error_lib_not_found qid (************************************************************************) (*s Low-level interning of libraries from files *) let raw_intern_library f = ObjFile.open_in ~file:f (************************************************************************) (* Internalise libraries *) type library_info type summary_disk = { md_name : compilation_unit_name; md_deps : (compilation_unit_name * Safe_typing.vodigest) array; md_ocaml : string; md_info : library_info; } type library_objects type library_disk = { md_compiled : Safe_typing.compiled_library; md_syntax_objects : library_objects; md_objects : library_objects; } let mk_library sd md f table digest vm = { library_name = sd.md_name; library_filename = f; library_compiled = md.md_compiled; library_opaques = table; library_deps = sd.md_deps; library_digest = digest; library_vm = vm; } let name_clash_message dir mdir f = str ("The file " ^ f ^ " contains library") ++ spc () ++ pr_dirpath mdir ++ spc () ++ str "and not library" ++ spc() ++ pr_dirpath dir type intern_mode = Rec | Root | Dep (* Rec = standard, Root = -norec, Dep = dependency of norec *) (* Dependency graph *) let depgraph = ref LibraryMap.empty let marshal_in_segment (type a) ~validate ~value ~(segment : a ObjFile.segment) f ch : a = let () = LargeFile.seek_in ch segment.ObjFile.pos in if validate then let v = try let v = Analyze.parse_channel ch in let digest = Digest.input ch in let () = if not (String.equal digest segment.ObjFile.hash) then raise_notrace Exit in v with _ -> CErrors.user_err (str "Corrupted file " ++ quote (str f)) in let () = Validate.validate value v in let v = Analyze.instantiate v in Obj.obj v else System.marshal_in f ch let summary_seg : summary_disk ObjFile.id = ObjFile.make_id "summary" let library_seg : library_disk ObjFile.id = ObjFile.make_id "library" let opaques_seg : seg_proofs ObjFile.id = ObjFile.make_id "opaques" let vm_seg = Vmlibrary.vm_segment let intern_from_file ~intern_mode ~enable_VM (dir, f) = let validate = intern_mode <> Dep in Flags.if_verbose chk_pp (str"[intern "++str f++str" ..."); let (sd,md,table,vmlib,digest) = try (* First pass to read the metadata of the file *) let ch = System.with_magic_number_check raw_intern_library f in let seg_sd = ObjFile.get_segment ch ~segment:summary_seg in let seg_md = ObjFile.get_segment ch ~segment:library_seg in let seg_opaque = ObjFile.get_segment ch ~segment:opaques_seg in let seg_vmlib = ObjFile.get_segment ch ~segment:vm_seg in let () = ObjFile.close_in ch in (* Actually read the data *) let ch = open_in_bin f in let sd = marshal_in_segment ~validate ~value:Values.v_libsum ~segment:seg_sd f ch in let md = marshal_in_segment ~validate ~value:Values.v_lib ~segment:seg_md f ch in let table = marshal_in_segment ~validate ~value:Values.v_opaquetable ~segment:seg_opaque f ch in let vmlib = if enable_VM then marshal_in_segment ~validate ~value:Values.v_vmlib ~segment:seg_vmlib f ch else Vmlibrary.(export (set_path dir empty)) in (* Verification of the final checksum *) let () = close_in ch in let ch = open_in_bin f in let () = close_in ch in let () = System.check_caml_version ~caml:sd.md_ocaml ~file:f in if dir <> sd.md_name then CErrors.user_err (name_clash_message dir sd.md_name f); Flags.if_verbose chk_pp (str" done]" ++ fnl ()); let digest = Safe_typing.Dvo_or_vi seg_md.hash in sd,md,table,vmlib,digest with e -> Flags.if_verbose chk_pp (str" failed!]" ++ fnl ()); raise e in depgraph := LibraryMap.add sd.md_name sd.md_deps !depgraph; opaque_tables := LibraryMap.add sd.md_name table !opaque_tables; mk_library sd md f table digest (Vmlibrary.inject vmlib) (* Read a compiled library and all dependencies, in reverse order. Do not include files that are already in the context. *) let rec intern_library ~intern_mode ~enable_VM seen (dir, f) needed = if LibrarySet.mem dir seen then failwith "Recursive dependencies!"; (* Look if in the current logical environment *) try let _ = find_library dir in needed with Not_found -> (* Look if already listed and consequently its dependencies too *) if List.mem_assoc_f DirPath.equal dir needed then needed else (* [dir] is an absolute name which matches [f] which must be in loadpath *) let m = intern_from_file ~intern_mode ~enable_VM (dir,f) in let seen' = LibrarySet.add dir seen in let deps = Array.map (fun (d,_) -> try_locate_absolute_library d) m.library_deps in let intern_mode = match intern_mode with Rec -> Rec | Root | Dep -> Dep in (dir,m) :: Array.fold_right (intern_library ~intern_mode ~enable_VM seen') deps needed (* Compute the reflexive transitive dependency closure *) let rec fold_deps seen ff (dir,f) (s,acc) = if LibrarySet.mem dir seen then failwith "Recursive dependencies!"; if LibrarySet.mem dir s then (s,acc) else let deps = match LibraryMap.find_opt dir !depgraph with | Some deps -> deps | None -> CErrors.anomaly Pp.(str "missing dep when computing closure (" ++ DirPath.print dir ++ str ")") in let deps = Array.map (fun (d,_) -> try_locate_absolute_library d) deps in let seen' = LibrarySet.add dir seen in let (s',acc') = Array.fold_right (fold_deps seen' ff) deps (s,acc) in (LibrarySet.add dir s', ff dir acc') and fold_deps_list seen ff modl needed = List.fold_right (fold_deps seen ff) modl needed let fold_deps_list ff modl acc = snd (fold_deps_list LibrarySet.empty ff modl (LibrarySet.empty,acc)) let recheck_library senv ~norec ~admit ~check = let enable_VM = (Environ.typing_flags (Safe_typing.env_of_safe_env senv)).enable_VM in let ml = List.map try_locate_qualified_library check in let nrl = List.map try_locate_qualified_library norec in let al = List.map try_locate_qualified_library admit in let needed = List.fold_right (intern_library ~intern_mode:Rec ~enable_VM LibrarySet.empty) ml [] in let needed = List.fold_right (intern_library ~intern_mode:Root ~enable_VM LibrarySet.empty) nrl needed in let needed = List.rev needed in (* first compute the closure of norec, remove closure of check, add closure of admit, and finally remove norec and check *) let nochk = fold_deps_list LibrarySet.add nrl LibrarySet.empty in let nochk = fold_deps_list LibrarySet.remove ml nochk in let nochk = fold_deps_list LibrarySet.add al nochk in (* explicitly required modules cannot be skipped... *) let nochk = List.fold_right LibrarySet.remove (List.map fst (nrl@ml)) nochk in (* *) Flags.if_verbose Feedback.msg_notice (fnl()++hv 2 (str "Ordered list:" ++ fnl() ++ prlist (fun (dir,_) -> pr_dirpath dir ++ fnl()) needed)); let senv = List.fold_left (check_one_lib nochk) (senv, Cmap.empty) needed in Flags.if_verbose Feedback.msg_notice (str"Modules were successfully checked"); senv coq-8.20.0/checker/check.mli000066400000000000000000000022021466560755400155650ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* unit val recheck_library : safe_environment -> norec:object_file list -> admit:object_file list -> check:object_file list -> safe_environment * Cset.t Cmap.t coq-8.20.0/checker/checkFlags.ml000066400000000000000000000026431466560755400164020ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* Environ.env -> Environ.env (** Set flags except for those ignored by the checker (see .ml file for those). *) coq-8.20.0/checker/checkInductive.ml000066400000000000000000000233641466560755400173030ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* None | FakeRecord -> Some None | PrimRecord data -> Some (Some (Array.map (fun (x,_,_,_) -> x) data)) in let check_template ind = match ind.mind_arity with | RegularArity _ -> false | TemplateArity _ -> true in let mind_entry_template = Array.exists check_template mb.mind_packets in let () = if mind_entry_template then assert (Array.for_all check_template mb.mind_packets) in let mind_entry_universes = match mb.mind_universes with | Monomorphic -> (* We only need to rebuild the set of constraints for template polymorphic inductive types. The set of monomorphic constraints is already part of the graph at that point, but we need to emulate a broken bound variable mechanism for template inductive types. *) begin match mb.mind_template with | None -> Monomorphic_ind_entry | Some ctx -> Template_ind_entry ctx.template_context end | Polymorphic auctx -> Polymorphic_ind_entry (AbstractContext.repr auctx) in let ntyps = Array.length mb.mind_packets in let mind_entry_inds = Array.map_to_list (fun ind -> let mind_entry_arity = match ind.mind_arity with | RegularArity ar -> let ctx, arity = Term.decompose_prod_n_decls nparams ar.mind_user_arity in ignore ctx; (* we will check that the produced user_arity is equal to the input *) arity | TemplateArity ar -> let ctx = ind.mind_arity_ctxt in let ctx = List.firstn (List.length ctx - nparams) ctx in Term.mkArity (ctx, ar.template_level) in { mind_entry_typename = ind.mind_typename; mind_entry_arity; mind_entry_consnames = Array.to_list ind.mind_consnames; mind_entry_lc = Array.map_to_list (fun c -> let c = Inductive.abstract_constructor_type_relatively_to_inductive_types_context ntyps mind c in let ctx, c = Term.decompose_prod_n_decls nparams c in ignore ctx; (* we will check that the produced user_lc is equal to the input *) c ) ind.mind_user_lc; }) mb.mind_packets in let mind_entry_variance = Option.map (Array.map (fun v -> Some v)) mb.mind_variance in { mind_entry_record; mind_entry_finite = mb.mind_finite; mind_entry_params = mb.mind_params_ctxt; mind_entry_inds; mind_entry_universes; mind_entry_variance; mind_entry_private = mb.mind_private; } let check_arity env ar1 ar2 = match ar1, ar2 with | RegularArity ar, RegularArity {mind_user_arity;mind_sort} -> Constr.equal ar.mind_user_arity mind_user_arity && Sorts.equal ar.mind_sort mind_sort | TemplateArity ar, TemplateArity {template_level} -> UGraph.check_leq_sort (universes env) template_level ar.template_level (* template_level is inferred by indtypes, so functor application can produce a smaller one *) | (RegularArity _ | TemplateArity _), _ -> assert false let check_template ar1 ar2 = match ar1, ar2 with | None, None -> true | Some ar, Some {template_context; template_param_levels} -> List.equal (Option.equal Univ.Level.equal) ar.template_param_levels template_param_levels && ContextSet.equal template_context ar.template_context | None, Some _ | Some _, None -> false (* if the generated inductive is squashed the original one must be squashed *) let check_squashed orig generated = match orig, generated with | None, None -> true | Some _, None -> (* the inductive is from functor instantiation which removed the need for squash *) true | None, Some _ -> (* missing squash *) false | Some s1, Some s2 -> (* functor instantiation can change sort qualities (from Type -> Prop) Condition: every quality which can make the generated inductive squashed must also make the original inductive squashed *) match s1, s2 with | AlwaysSquashed, AlwaysSquashed -> true | AlwaysSquashed, SometimesSquashed _ -> true | SometimesSquashed _, AlwaysSquashed -> false | SometimesSquashed s1, SometimesSquashed s2 -> Sorts.Quality.Set.subset s2 s1 (* Use [eq_ind_chk] because when we rebuild the recargs we have lost the knowledge of who is the canonical version. Try with to see test-suite/coqchk/include.v *) let eq_recarg_type ty1 ty2 = match ty1, ty2 with | RecArgInd ind1, RecArgInd ind2 -> eq_ind_chk ind1 ind2 | RecArgPrim c1, RecArgPrim c2 -> Names.Constant.CanOrd.equal c1 c2 | (RecArgInd _ | RecArgPrim _), _ -> false let eq_recarg r1 r2 = match r1, r2 with | Norec, Norec -> true | Mrec ty1, Mrec ty2 -> eq_recarg_type ty1 ty2 | (Norec | Mrec _), _ -> false let eq_reloc_tbl = Array.equal (fun x y -> Int.equal (fst x) (fst y) && Int.equal (snd x) (snd y)) let eq_in_context (ctx1, t1) (ctx2, t2) = Context.Rel.equal Sorts.relevance_equal Constr.equal ctx1 ctx2 && Constr.equal t1 t2 let check_packet env mind ind { mind_typename; mind_arity_ctxt; mind_arity; mind_consnames; mind_user_lc; mind_nrealargs; mind_nrealdecls; mind_squashed; mind_nf_lc; mind_consnrealargs; mind_consnrealdecls; mind_recargs; mind_relevance; mind_nb_constant; mind_nb_args; mind_reloc_tbl } = let check = check mind in ignore mind_typename; (* passed through *) check "mind_arity_ctxt" (Context.Rel.equal Sorts.relevance_equal Constr.equal ind.mind_arity_ctxt mind_arity_ctxt); check "mind_arity" (check_arity env ind.mind_arity mind_arity); ignore mind_consnames; (* passed through *) check "mind_user_lc" (Array.equal Constr.equal ind.mind_user_lc mind_user_lc); check "mind_nrealargs" Int.(equal ind.mind_nrealargs mind_nrealargs); check "mind_nrealdecls" Int.(equal ind.mind_nrealdecls mind_nrealdecls); check "mind_squashed" (check_squashed ind.mind_squashed mind_squashed); check "mind_nf_lc" (Array.equal eq_in_context ind.mind_nf_lc mind_nf_lc); (* NB: here syntactic equality is not just an optimisation, we also care about the shape of the terms *) check "mind_consnrealargs" (Array.equal Int.equal ind.mind_consnrealargs mind_consnrealargs); check "mind_consnrealdecls" (Array.equal Int.equal ind.mind_consnrealdecls mind_consnrealdecls); check "mind_recargs" (Rtree.equal eq_recarg ind.mind_recargs mind_recargs); check "mind_relevant" (Sorts.relevance_equal ind.mind_relevance mind_relevance); check "mind_nb_args" Int.(equal ind.mind_nb_args mind_nb_args); check "mind_nb_constant" Int.(equal ind.mind_nb_constant mind_nb_constant); check "mind_reloc_tbl" (eq_reloc_tbl ind.mind_reloc_tbl mind_reloc_tbl); () let check_same_record r1 r2 = match r1, r2 with | NotRecord, NotRecord | FakeRecord, FakeRecord -> true | PrimRecord r1, PrimRecord r2 -> (* The kernel doesn't care about the names, we just need to check that the saved types are correct. *) Array.for_all2 (fun (_,_,r1,tys1) (_,_,r2,tys2) -> Array.equal Sorts.relevance_equal r1 r2 && Array.equal Constr.equal tys1 tys2) r1 r2 | (NotRecord | FakeRecord | PrimRecord _), _ -> false let check_inductive env mind mb = let entry = to_entry mind mb in let { mind_packets; mind_record; mind_finite; mind_ntypes; mind_hyps; mind_univ_hyps; mind_nparams; mind_nparams_rec; mind_params_ctxt; mind_universes; mind_template; mind_variance; mind_sec_variance; mind_private; mind_typing_flags; } = (* Locally set typing flags for further typechecking *) let env = CheckFlags.set_local_flags mb.mind_typing_flags env in Indtypes.check_inductive env ~sec_univs:None mind entry in let check = check mind in Array.iter2 (check_packet env mind) mb.mind_packets mind_packets; check "mind_record" (check_same_record mb.mind_record mind_record); check "mind_finite" (mb.mind_finite == mind_finite); check "mind_ntypes" Int.(equal mb.mind_ntypes mind_ntypes); check "mind_hyps" (List.is_empty mind_hyps); check "mind_univ_hyps" (UVars.Instance.is_empty mind_univ_hyps); check "mind_nparams" Int.(equal mb.mind_nparams mind_nparams); check "mind_nparams_rec" (mb.mind_nparams_rec <= mind_nparams_rec); (* module substitution can increase the real number of recursively uniform parameters, so be tolerant and use [<=]. *) check "mind_params_ctxt" (Context.Rel.equal Sorts.relevance_equal Constr.equal mb.mind_params_ctxt mind_params_ctxt); ignore mind_universes; (* Indtypes did the necessary checking *) check "mind_template" (check_template mb.mind_template mind_template); check "mind_variance" (Option.equal (Array.equal UVars.Variance.equal) mb.mind_variance mind_variance); check "mind_sec_variance" (Option.is_empty mind_sec_variance); ignore mind_private; (* passed through Indtypes *) ignore mind_typing_flags; (* TODO non oracle flags *) add_mind mind mb env coq-8.20.0/checker/checkInductive.mli000066400000000000000000000017251466560755400174510ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* MutInd.t -> Declarations.mutual_inductive_body -> env coq-8.20.0/checker/checkTypes.ml000066400000000000000000000027471466560755400164570ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* () | _ -> failwith "not the correct sort" let check_polymorphic_arity env params par = let pl = par.template_param_levels in let rec check_p env pl params = let open Context.Rel.Declaration in match pl, params with Some u::pl, LocalAssum (na,ty)::params -> check_kind env ty u; check_p (push_rel (LocalAssum (na,ty)) env) pl params | None::pl,d::params -> check_p (push_rel d env) pl params | [], _ -> () | _ -> failwith "check_poly: not the right number of params" in check_p env pl (List.rev params) coq-8.20.0/checker/checkTypes.mli000066400000000000000000000015371466560755400166240ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* rel_context -> template_universes -> unit coq-8.20.0/checker/check_stat.ml000066400000000000000000000067251466560755400164650ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* " else hv 2 (str ass ++ str ":" ++ fnl() ++ prlist_with_sep fnl str axs) let pr_axioms env opac = let add c cb acc = if Declareops.constant_has_body cb then acc else match Cmap.find_opt c opac with | None -> Cset.add c acc | Some s -> Cset.union s acc in let csts = fold_constants add env Cset.empty in let csts = Cset.fold (fun c acc -> Constant.to_string c :: acc) csts [] in pr_assumptions "Axioms" csts let pr_type_in_type env = let csts = fold_constants (fun c cb acc -> if not cb.const_typing_flags.check_universes then Constant.to_string c :: acc else acc) env [] in let csts = fold_inductives (fun c cb acc -> if not cb.mind_typing_flags.check_universes then MutInd.to_string c :: acc else acc) env csts in pr_assumptions "Constants/Inductives relying on type-in-type" csts let pr_unguarded env = let csts = fold_constants (fun c cb acc -> if not cb.const_typing_flags.check_guarded then Constant.to_string c :: acc else acc) env [] in let csts = fold_inductives (fun c cb acc -> if not cb.mind_typing_flags.check_guarded then MutInd.to_string c :: acc else acc) env csts in pr_assumptions "Constants/Inductives relying on unsafe (co)fixpoints" csts let pr_nonpositive env = let inds = fold_inductives (fun c cb acc -> if not cb.mind_typing_flags.check_positive then MutInd.to_string c :: acc else acc) env [] in pr_assumptions "Inductives whose positivity is assumed" inds let print_context env opac = if !output_context then begin Feedback.msg_notice (hov 0 (fnl() ++ str"CONTEXT SUMMARY" ++ fnl() ++ str"===============" ++ fnl() ++ fnl() ++ str "* " ++ hov 0 (pr_impredicative_set env ++ fnl()) ++ fnl() ++ str "* " ++ hov 0 (pr_rewrite_rules env ++ fnl()) ++ fnl() ++ str "* " ++ hov 0 (pr_axioms env opac ++ fnl()) ++ fnl() ++ str "* " ++ hov 0 (pr_type_in_type env ++ fnl()) ++ fnl() ++ str "* " ++ hov 0 (pr_unguarded env ++ fnl()) ++ fnl() ++ str "* " ++ hov 0 (pr_nonpositive env ++ fnl())) ) end let stats env opac = print_context env opac; print_memory_stat () coq-8.20.0/checker/check_stat.mli000066400000000000000000000014321466560755400166240ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* Names.Cset.t Names.Cmap.t -> unit coq-8.20.0/checker/checker.ml000066400000000000000000000357561466560755400157670ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* =len then dirs else let pos = try String.index_from s n '.' with Not_found -> len in let dir = String.sub s n (pos-n) in decoupe_dirs (dir::dirs) (pos+1) in decoupe_dirs [] 0 let dirpath_of_string s = match parse_dir s with [] -> Check.default_root_prefix | dir -> DirPath.make (List.map Id.of_string dir) let path_of_string s = if Filename.check_suffix s ".vo" then PhysicalFile s else match parse_dir s with [] -> invalid_arg "path_of_string" | l::dir -> LogicalFile {dirpath=dir; basename=l} let get_version () = try let env = Boot.Env.init () in let revision = Boot.Env.(Path.to_string (revision env)) in let ch = open_in revision in let ver = input_line ch in let rev = input_line ch in let () = close_in ch in Printf.sprintf "%s (%s)" ver rev with _ -> Coq_config.version let print_header () = Printf.printf "Welcome to Chicken %s\n%!" (get_version ()) (* Adding files to Coq loadpath *) let add_path ~unix_path:dir ~coq_root:coq_dirpath = if exists_dir dir then begin Check.add_load_path (dir,coq_dirpath) end else Feedback.msg_warning (str "Cannot open " ++ str dir) let convert_string d = try Id.of_string d with CErrors.UserError _ -> Flags.if_verbose Feedback.msg_warning (str "Directory " ++ str d ++ str " cannot be used as a Coq identifier (skipped)"); raise_notrace Exit let add_rec_path ~unix_path ~coq_root = if exists_dir unix_path then let dirs = all_subdirs ~unix_path in let prefix = DirPath.repr coq_root in let convert_dirs (lp, cp) = try let path = List.rev_map convert_string cp @ prefix in Some (lp, Names.DirPath.make path) with Exit -> None in let dirs = List.map_filter convert_dirs dirs in List.iter Check.add_load_path dirs; Check.add_load_path (unix_path, coq_root) else Feedback.msg_warning (str "Cannot open " ++ str unix_path) (* By the option -R/-Q of the command line *) let includes = ref [] let push_include (s, alias) = includes := (s,alias) :: !includes let set_include d p = let p = dirpath_of_string p in push_include (d,p) (* Initializes the LoadPath *) let init_load_path () = let coqenv = Boot.Env.init () in (* the to_string casting won't be necessary once Boot handles include paths *) let plugins = Boot.Env.plugins coqenv |> Boot.Path.to_string in let theories = Boot.Env.stdlib coqenv |> Boot.Path.to_string in let user_contrib = Boot.Env.user_contrib coqenv |> Boot.Path.to_string in let xdg_dirs = Envars.xdg_dirs in let coqpath = Envars.coqpath in (* NOTE: These directories are searched from last to first *) (* first standard library *) add_rec_path ~unix_path:theories ~coq_root:(Names.DirPath.make[coq_root]); (* then plugins *) add_rec_path ~unix_path:plugins ~coq_root:(Names.DirPath.make [coq_root]); (* then user-contrib *) if Sys.file_exists user_contrib then add_rec_path ~unix_path:user_contrib ~coq_root:Check.default_root_prefix; (* then directories in XDG_DATA_DIRS and XDG_DATA_HOME *) List.iter (fun s -> add_rec_path ~unix_path:s ~coq_root:Check.default_root_prefix) (xdg_dirs ~warn:(fun x -> Feedback.msg_warning (str x))); (* then directories in COQPATH *) List.iter (fun s -> add_rec_path ~unix_path:s ~coq_root:Check.default_root_prefix) coqpath; (* then current directory *) add_path ~unix_path:"." ~coq_root:Check.default_root_prefix let impredicative_set = ref false let set_impredicative_set () = impredicative_set := true let boot = ref false let set_boot () = boot := true let indices_matter = ref false let enable_vm = ref false let make_senv () = let senv = Safe_typing.empty_environment in let senv = Safe_typing.set_impredicative_set !impredicative_set senv in let senv = Safe_typing.set_indices_matter !indices_matter senv in let senv = Safe_typing.set_VM !enable_vm senv in let senv = Safe_typing.set_allow_sprop true senv in (* be smarter later *) Safe_typing.set_native_compiler false senv let admit_list = ref ([] : object_file list) let add_admit s = admit_list := path_of_string s :: !admit_list let norec_list = ref ([] : object_file list) let add_norec s = norec_list := path_of_string s :: !norec_list let compile_list = ref ([] : object_file list) let add_compile s = compile_list := path_of_string s :: !compile_list (*s Parsing of the command line. We no longer use [Arg.parse], in order to use share [Usage.print_usage] between coqtop and coqc. *) let compile_files senv = Check.recheck_library senv ~norec:(List.rev !norec_list) ~admit:(List.rev !admit_list) ~check:(List.rev !compile_list) let version () = Printf.printf "The Coq Proof Checker, version %s\n" Coq_config.version; exit 0 (* print the usage of coqtop (or coqc) on channel co *) let print_usage_channel co command = output_string co command; output_string co "coqchk options are:\n"; output_string co "\ \n -Q dir coqdir map physical dir to logical coqdir\ \n -R dir coqdir synonymous for -Q\ \n -coqlib dir set coqchk's standard library location\ \n -boot don't initialize the library paths automatically\ \n\ \n -admit module load module and dependencies without checking\ \n -norec module check module but admit dependencies without checking\ \n\ \n -debug enable debugging info\ \n -where print coqchk's standard library location and exit\ \n -v, --version print coqchk version and exit\ \n -o, --output-context print the list of assumptions\ \n -m, --memory print the maximum heap size\ \n -silent disable trace of constants being checked\ \n\ \n -impredicative-set set sort Set impredicative\ \n -indices-matter levels of indices (and nonuniform parameters)\ \n contribute to the level of inductives\ \n -bytecode-compiler (yes|no) enable the vm_compute reduction machine (default is no)\ \n\ \n -h, --help print this list of options\ \n" (* print the usage on standard error *) let print_usage = print_usage_channel stderr let print_usage_coqtop () = print_usage "Usage: coqchk modules\n\n" let usage exitcode = print_usage_coqtop (); flush stderr; exit exitcode open Type_errors let anomaly_string () = str "Anomaly: " let report () = strbrk (". Please report at " ^ Coq_config.wwwbugtracker ^ ".") let guill s = str "\"" ++ str s ++ str "\"" let explain_exn = function | Sys_error msg -> hov 0 (anomaly_string () ++ str "uncaught exception Sys_error " ++ guill msg ++ report() ) | UserError pps -> hov 1 (str "User error: " ++ pps) | Out_of_memory -> hov 0 (str "Out of memory") | Stack_overflow -> hov 0 (str "Stack overflow") | Match_failure(filename,pos1,pos2) -> hov 1 (anomaly_string () ++ str "Match failure in file " ++ guill filename ++ str " at line " ++ int pos1 ++ str " character " ++ int pos2 ++ report ()) | Not_found -> hov 0 (anomaly_string () ++ str "uncaught exception Not_found" ++ report ()) | Failure s -> hov 0 (str "Failure: " ++ str s ++ report ()) | Invalid_argument s -> hov 0 (anomaly_string () ++ str "uncaught exception Invalid_argument " ++ guill s ++ report ()) | Sys.Break -> hov 0 (fnl () ++ str "User interrupt.") | UGraph.UniverseInconsistency i -> let msg = if CDebug.(get_flag misc) then str "." ++ spc() ++ UGraph.explain_universe_inconsistency Sorts.QVar.raw_pr Univ.Level.raw_pr i else mt() in hov 0 (str "Error: Universe inconsistency" ++ msg ++ str ".") | TypeError(ctx,te) -> hov 0 (str "Type error: " ++ (match te with | UnboundRel i -> str"UnboundRel " ++ int i | UnboundVar v -> str"UnboundVar" ++ str(Names.Id.to_string v) | NotAType _ -> str"NotAType" | BadAssumption _ -> str"BadAssumption" | ReferenceVariables _ -> str"ReferenceVariables" | ElimArity _ -> str"ElimArity" | CaseNotInductive _ -> str"CaseNotInductive" | CaseOnPrivateInd _ -> str"CaseOnPrivateInd" | WrongCaseInfo _ -> str"WrongCaseInfo" | NumberBranches _ -> str"NumberBranches" | IllFormedBranch _ -> str"IllFormedBranch" | IllFormedCaseParams -> str "IllFormedCaseParams" | Generalization _ -> str"Generalization" | ActualType _ -> str"ActualType" | IncorrectPrimitive _ -> str"IncorrectPrimitive" | CantApplyBadType ((n,a,b),{uj_val = hd; uj_type = hdty},args) -> let pp_arg i judge = hv 1 (str"arg " ++ int (i+1) ++ str"= " ++ Constr.debug_print judge.uj_val ++ str ",type= " ++ Constr.debug_print judge.uj_type) ++ fnl () in Feedback.msg_notice (str"====== ill-typed term ====" ++ fnl () ++ hov 2 (str"application head= " ++ Constr.debug_print hd) ++ fnl () ++ hov 2 (str"head type= " ++ Constr.debug_print hdty) ++ fnl () ++ str"arguments:" ++ fnl () ++ hv 1 (prvecti pp_arg args)); Feedback.msg_notice (str"====== type error ====@" ++ fnl () ++ Constr.debug_print b ++ fnl () ++ str"is not convertible with" ++ fnl () ++ Constr.debug_print a ++ fnl ()); Feedback.msg_notice (str"====== universes ====" ++ fnl () ++ (UGraph.pr_universes Univ.Level.raw_pr (UGraph.repr (ctx.Environ.env_universes)))); str "CantApplyBadType at argument " ++ int n | CantApplyNonFunctional _ -> str"CantApplyNonFunctional" | IllFormedRecBody _ -> str"IllFormedRecBody" | IllTypedRecBody _ -> str"IllTypedRecBody" | UnsatisfiedQConstraints _ -> str"UnsatisfiedQConstraints" | UnsatisfiedConstraints _ -> str"UnsatisfiedConstraints" | DisallowedSProp -> str"DisallowedSProp" | BadBinderRelevance _ -> str"BadBinderRelevance" | BadCaseRelevance _ -> str"BadCaseRelevance" | BadInvert -> str"BadInvert" | UndeclaredQualities _ -> str"UndeclaredQualities" | UndeclaredUniverse _ -> str"UndeclaredUniverse" | BadVariance _ -> str "BadVariance" | UndeclaredUsedVariables _ -> str "UndeclaredUsedVariables" )) | InductiveError e -> hov 0 (str "Error related to inductive types") (* let ctx = Check.get_env() in hov 0 (str "Error:" ++ spc () ++ Himsg.explain_inductive_error ctx e)*) | CheckInductive.InductiveMismatch (mind,field) -> hov 0 (MutInd.print mind ++ str ": field " ++ str field ++ str " is incorrect.") | Mod_checking.BadConstant (cst, why) -> hov 0 (Constant.print cst ++ spc() ++ why) | Assert_failure (s,b,e) -> hov 0 (anomaly_string () ++ str "assert failure" ++ spc () ++ (if s = "" then mt () else (str "(file \"" ++ str s ++ str "\", line " ++ int b ++ str ", characters " ++ int e ++ str "-" ++ int (e+6) ++ str ")")) ++ report ()) | e -> CErrors.print e (* for anomalies and other uncaught exceptions *) let parse_args argv = let rec parse = function | [] -> () | "-impredicative-set" :: rem -> set_impredicative_set (); parse rem | "-indices-matter" :: rem -> indices_matter:=true; parse rem | "-bytecode-compiler" :: "yes" :: rem -> enable_vm := true; parse rem | "-bytecode-compiler" :: "no" :: rem -> enable_vm := false; parse rem | "-coqlib" :: s :: rem -> if not (exists_dir s) then fatal_error (str "Directory '" ++ str s ++ str "' does not exist") false; Boot.Env.set_coqlib s; parse rem | "-boot" :: rem -> set_boot (); parse rem | ("-Q"|"-R") :: d :: p :: rem -> set_include d p;parse rem | ("-Q"|"-R") :: ([] | [_]) -> usage 1 | "-debug" :: rem -> CDebug.set_debug_all true; parse rem | "-where" :: _ -> let env = Boot.Env.init () in let coqlib = Boot.Env.coqlib env |> Boot.Path.to_string in print_endline coqlib; exit 0 | ("-?"|"-h"|"-H"|"-help"|"--help") :: _ -> usage 0 | ("-v"|"--version") :: _ -> version () | ("-m" | "--memory") :: rem -> Check_stat.memory_stat := true; parse rem | ("-o" | "--output-context") :: rem -> Check_stat.output_context := true; parse rem | "-admit" :: s :: rem -> add_admit s; parse rem | "-admit" :: [] -> usage 1 | "-norec" :: s :: rem -> add_norec s; parse rem | "-norec" :: [] -> usage 1 | "-silent" :: rem -> Flags.quiet := true; parse rem | s :: _ when s<>"" && s.[0]='-' -> fatal_error (str "Unknown option " ++ str s) false | s :: rem -> add_compile s; parse rem in parse (List.tl (Array.to_list argv)) (* XXX: At some point we need to either port the checker to use the feedback system or to remove its use completely. *) let init_with_argv argv = let _fhandle = Feedback.(add_feeder (console_feedback_listener Format.err_formatter)) in try parse_args argv; CWarnings.set_flags ("+"^Typeops.warn_bad_relevance_name); if CDebug.(get_flag misc) then Printexc.record_backtrace true; Flags.if_verbose print_header (); if not !boot then init_load_path (); (* additional loadpath, given with -R/-Q options *) List.iter (fun (unix_path, coq_root) -> add_rec_path ~unix_path ~coq_root) (List.rev !includes); includes := []; make_senv () with e -> fatal_error (str "Error during initialization :" ++ (explain_exn e)) (is_anomaly e) let init() = init_with_argv Sys.argv let run senv = try let senv = compile_files senv in flush_all(); senv with e -> if CDebug.(get_flag misc) then Printexc.print_backtrace stderr; fatal_error (explain_exn e) (is_anomaly e) let start () = let senv = init() in let senv, opac = run senv in Check_stat.stats (Safe_typing.env_of_safe_env senv) opac; exit 0 coq-8.20.0/checker/checker.mli000066400000000000000000000012751466560755400161250ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* unit coq-8.20.0/checker/coqchk.ml000066400000000000000000000000321466560755400156060ustar00rootroot00000000000000 let _ = Checker.start () coq-8.20.0/checker/coqchk.mli000066400000000000000000000014501466560755400157640ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* pr_id id | _ -> str"_";; let prdp dp = pp(str(string_of_dirpath dp));; (* let prc c = pp(Himsg.pr_lconstr_env (Check.get_env()) c);; let prcs cs = prc (Declarations.force cs);; let pru u = pp(str(Univ.string_of_universe u));;*) let pru u = pp(Univ.pr_uni u);; let prlab l = pp(str(string_of_label l));; let prid id = pp(pr_id id);; let prcon c = pp(Indtypes.prcon c);; let prkn kn = pp(Indtypes.prkn kn);; let prus g = pp(Univ.pr_universes g);; let prcstrs c = let g = Univ.merge_constraints c Univ.initial_universes in pp(Univ.pr_universes g);; (*let prcstrs c = pp(Univ.pr_constraints c);; *) (* let prenvu e = let u = universes e in let pu = str "UNIVERSES:"++fnl()++str" "++hov 0 (Univ.pr_universes u) ++fnl() in pp pu;; let prenv e = let ctx1 = named_context e in let ctx2 = rel_context e in let pe = hov 1 (str"[" ++ prlist_with_sep spc (fun (na,_,_) -> pr_id na) (List.rev ctx1)++ str"]") ++ spc() ++ hov 1 (str"[" ++ prlist_with_sep spc (fun (na,_,_) -> pr_na na) (List.rev ctx2)++ str"]") in pp pe;; *) (* let prsub s = let string_of_mp mp = let s = string_of_mp mp in (match mp with MPbound _ -> "#bound."|_->"")^s in pp (hv 0 (fold_subst (fun msid mp strm -> str "S " ++ str (debug_string_of_msid msid) ++ str " |-> " ++ str (string_of_mp mp) ++ fnl() ++ strm) (fun mbid mp strm -> str"B " ++ str (debug_string_of_mbid mbid) ++ str " |-> " ++ str (string_of_mp mp) ++ fnl() ++ strm) (fun mp1 mp strm -> str"P " ++ str (string_of_mp mp1) ++ str " |-> " ++ str (string_of_mp mp) ++ fnl() ++ strm) s (mt()))) ;; *) #install_printer prid;; #install_printer prcon;; #install_printer prlab;; #install_printer prdp;; #install_printer prkn;; #install_printer pru;; (* #install_printer prc;; #install_printer prcs;; *) #install_printer prcstrs;; (*#install_printer prus;;*) (*#install_printer prenv;;*) (*#install_printer prenvu;; #install_printer prsub;;*) Checker.init_with_argv [|"";"-coqlib";"."|];; Flags.quiet := false;; Flags.debug := true;; Sys.catch_break true;; let module_of_file f = let (_,mb,_,_) = Obj.magic ((intern_from_file f).library_compiled) in (mb:Cic.module_body) ;; let deref_mod md s = let l = match md.mod_expr with Struct(NoFunctor l) -> l | FullStruct -> (match md.mod_type with NoFunctor l -> l) in List.assoc (label_of_id(id_of_string s)) l ;; (* let mod_access m fld = match m.mod_expr with Some(SEBstruct l) -> List.assoc fld l | _ -> failwith "bad structure type" ;; *) let parse_dp s = make_dirpath(List.rev_map id_of_string (Str.split(Str.regexp"\\.") s)) ;; let parse_sp s = let l = List.rev (Str.split(Str.regexp"\\.") s) in {dirpath=List.tl l; basename=List.hd l};; let parse_kn s = let l = List.rev (Str.split(Str.regexp"\\.") s) in let dp = make_dirpath(List.map id_of_string(List.tl l)) in make_kn(MPfile dp) empty_dirpath (label_of_id (id_of_string (List.hd l))) ;; let parse_con s = let l = List.rev (Str.split(Str.regexp"\\.") s) in let dp = make_dirpath(List.map id_of_string(List.tl l)) in make_con(MPfile dp) empty_dirpath (label_of_id (id_of_string (List.hd l))) ;; let get_mod dp = lookup_module dp (Safe_typing.get_env()) ;; let get_mod_type dp = lookup_modtype dp (Safe_typing.get_env()) ;; let get_cst kn = lookup_constant kn (Safe_typing.get_env()) ;; let read_mod s f = let lib = intern_from_file (parse_dp s,f) in ((Obj.magic lib.library_compiled): dir_path * module_body * (dir_path * Digest.t) list);; let expln f x = try f x with UserError(_,strm) as e -> msgnl strm; raise e let admit_l l = let l = List.map parse_sp l in Check.recheck_library ~admit:l ~check:l;; let run_l l = Check.recheck_library ~admit:[] ~check:(List.map parse_sp l);; let norec q = Check.recheck_library ~norec:[parse_sp q] ~admit:[] ~check:[];; (* admit_l["Bool";"OrderedType";"DecidableType"];; run_l["FSetInterface"];; *) coq-8.20.0/checker/mod_checking.ml000066400000000000000000000311761466560755400167650ustar00rootroot00000000000000open Pp open Util open Names open Conversion open Typeops open Declarations open Environ (** {6 Checking constants } *) let indirect_accessor : (Opaqueproof.opaque -> Opaqueproof.opaque_proofterm) ref = ref (fun _ -> assert false) let set_indirect_accessor f = indirect_accessor := f let register_opacified_constant env opac kn cb = let rec gather_consts s c = match Constr.kind c with | Constr.Const (c, _) -> Cset.add c s | _ -> Constr.fold gather_consts s c in let wo_body = Cset.fold (fun kn s -> if Declareops.constant_has_body (lookup_constant kn env) then s else match Cmap.find_opt kn opac with | None -> Cset.add kn s | Some s' -> Cset.union s' s) (gather_consts Cset.empty cb) Cset.empty in Cmap.add kn wo_body opac exception BadConstant of Constant.t * Pp.t let check_constant_declaration env opac kn cb opacify = Flags.if_verbose Feedback.msg_notice (str " checking cst:" ++ Constant.print kn); let env = CheckFlags.set_local_flags cb.const_typing_flags env in let poly, env = match cb.const_universes with | Monomorphic -> (* Monomorphic universes are stored at the library level, the ones in const_universes should not be needed *) false, env | Polymorphic auctx -> let ctx = UVars.AbstractContext.repr auctx in (* [env] contains De Bruijn universe variables *) let env = push_context ~strict:false ctx env in true, env in let ty = cb.const_type in let jty = infer_type env ty in if not (Sorts.relevance_equal cb.const_relevance (Sorts.relevance_of_sort jty.utj_type)) then raise Pp.(BadConstant (kn, str "incorrect const_relevance")); let body, env = match cb.const_body with | Undef _ | Primitive _ | Symbol _ -> None, env | Def c -> Some c, env | OpaqueDef o -> let c, u = !indirect_accessor o in let env = match u, cb.const_universes with | Opaqueproof.PrivateMonomorphic (), Monomorphic -> env | Opaqueproof.PrivatePolymorphic local, Polymorphic _ -> push_subgraph local env | _ -> assert false in Some c, env in let () = match body with | Some bd -> let j = infer env bd in begin match conv_leq env j.uj_type ty with | Result.Ok () -> () | Result.Error () -> Type_errors.error_actual_type env j ty end | None -> () in match body with | Some body when opacify -> register_opacified_constant env opac kn body | Some _ | None -> opac let check_constant_declaration env opac kn cb opacify = let opac = check_constant_declaration env opac kn cb opacify in Environ.add_constant kn cb env, opac let check_quality_mask env qmask lincheck = let open Sorts.Quality in match qmask with | PQConstant QSProp -> if Environ.sprop_allowed env then lincheck else Type_errors.error_disallowed_sprop env | PQConstant (QProp | QType) -> lincheck | PQVar qio -> Partial_subst.maybe_add_quality qio () lincheck let check_instance_mask env udecl umask lincheck = match udecl, umask with | Monomorphic, ([||], [||]) -> lincheck | Polymorphic uctx, (qmask, umask) -> let lincheck = Array.fold_left_i (fun i lincheck mask -> check_quality_mask env mask lincheck) lincheck qmask in let lincheck = Array.fold_left_i (fun i lincheck mask -> Partial_subst.maybe_add_univ mask () lincheck) lincheck umask in if (Array.length qmask, Array.length umask) <> UVars.AbstractContext.size uctx then CErrors.anomaly Pp.(str "Bad univ mask length."); lincheck | _ -> CErrors.anomaly Pp.(str "Bad univ mask length.") let rec get_holes_profiles env nargs ndecls lincheck el = List.fold_left (get_holes_profiles_elim env nargs ndecls) lincheck el and get_holes_profiles_elim env nargs ndecls lincheck = function | PEApp args -> Array.fold_left (get_holes_profiles_parg env nargs ndecls) lincheck args | PECase (ind, u, ret, brs) -> let mib, mip = Inductive.lookup_mind_specif env ind in let lincheck = check_instance_mask env mib.mind_universes u lincheck in let lincheck = get_holes_profiles_parg env (nargs + mip.mind_nrealargs + 1) (ndecls + mip.mind_nrealdecls + 1) lincheck ret in Array.fold_left3 (fun lincheck nargs_b ndecls_b -> get_holes_profiles_parg env (nargs + nargs_b) (ndecls + ndecls_b) lincheck) lincheck mip.mind_consnrealargs mip.mind_consnrealdecls brs | PEProj proj -> let () = lookup_projection proj env |> ignore in lincheck and get_holes_profiles_parg env nargs ndecls lincheck = function | EHoleIgnored -> lincheck | EHole i -> Partial_subst.add_term i nargs lincheck | ERigid (h, el) -> let lincheck = get_holes_profiles_head env nargs ndecls lincheck h in get_holes_profiles env nargs ndecls lincheck el and get_holes_profiles_head env nargs ndecls lincheck = function | PHRel n -> if n <= ndecls then lincheck else Type_errors.error_unbound_rel env n | PHSymbol (c, u) -> let cb = lookup_constant c env in check_instance_mask env cb.const_universes u lincheck | PHConstr (c, u) -> let (mib, _) = Inductive.lookup_mind_specif env (inductive_of_constructor c) in check_instance_mask env mib.mind_universes u lincheck | PHInd (ind, u) -> let (mib, _) = Inductive.lookup_mind_specif env ind in check_instance_mask env mib.mind_universes u lincheck | PHInt _ | PHFloat _ | PHString _ -> lincheck | PHSort PSSProp -> if Environ.sprop_allowed env then lincheck else Type_errors.error_disallowed_sprop env | PHSort PSType io -> Partial_subst.maybe_add_univ io () lincheck | PHSort PSQSort (qio, uio) -> lincheck |> Partial_subst.maybe_add_quality qio () |> Partial_subst.maybe_add_univ uio () | PHSort _ -> lincheck | PHLambda (tys, bod) | PHProd (tys, bod) -> let lincheck = Array.fold_left_i (fun i -> get_holes_profiles_parg env (nargs + i) (ndecls + i)) lincheck tys in let lincheck = get_holes_profiles_parg env (nargs + Array.length tys) (ndecls + Array.length tys) lincheck bod in lincheck let check_rhs env holes_profile rhs = let rec check i c = match Constr.kind c with | App (f, args) when Constr.isRel f -> let n = Constr.destRel f in if n <= i then () else if n - i > Array.length holes_profile then CErrors.anomaly Pp.(str "Malformed right-hand-side substitution site"); let d = holes_profile.(n-i-1) in if Array.length args >= d then () else CErrors.anomaly Pp.(str "Malformed right-hand-side substitution site") | Rel n when n > i -> if n - i > Array.length holes_profile then CErrors.anomaly Pp.(str "Malformed right-hand-side substitution site"); let d = holes_profile.(n-i-1) in if d = 0 then () else CErrors.anomaly Pp.(str "Malformed right-hand-side substitution site") | _ -> Constr.iter_with_binders succ check i c in check 0 rhs let check_rewrite_rule env lab i (symb, rule) = Flags.if_verbose Feedback.msg_notice (str " checking rule:" ++ Label.print lab ++ str"#" ++ Pp.int i); let { nvars; lhs_pat; rhs } = rule in let symb_cb = Environ.lookup_constant symb env in let () = match symb_cb.const_body with Symbol _ -> () | _ -> ignore @@ invalid_arg "Rule defined on non-symbol" in let lincheck = Partial_subst.make nvars in let lincheck = check_instance_mask env symb_cb.const_universes (fst lhs_pat) lincheck in let lincheck = get_holes_profiles env 0 0 lincheck (snd lhs_pat) in let holes_profile, _, _ = Partial_subst.to_arrays lincheck in let () = check_rhs env holes_profile rhs in () let check_rewrite_rules_body env lab rrb = List.iteri (check_rewrite_rule env lab) rrb.rewrules_rules (** {6 Checking modules } *) (** We currently ignore the [mod_type_alg] and [typ_expr_alg] fields. The only delicate part is when [mod_expr] is an algebraic expression : we need to expand it before checking it is indeed a subtype of [mod_type]. Fortunately, [mod_expr] cannot contain any [MEwith]. *) let lookup_module mp env = try Environ.lookup_module mp env with Not_found -> failwith ("Unknown module: "^ModPath.to_string mp) let mk_mtb mp sign delta = { mod_mp = mp; mod_expr = (); mod_type = sign; mod_type_alg = None; mod_delta = delta; mod_retroknowledge = ModTypeRK; } let rec collect_constants_without_body sign mp accu = let collect_field s lab = function | SFBconst cb -> let c = Constant.make2 mp lab in if Declareops.constant_has_body cb then s else Cset.add c s | SFBmodule msb -> collect_constants_without_body msb.mod_type (MPdot(mp,lab)) s | SFBmind _ | SFBrules _ | SFBmodtype _ -> s in match sign with | MoreFunctor _ -> Cset.empty (* currently ignored *) | NoFunctor struc -> List.fold_left (fun s (lab,mb) -> collect_field s lab mb) accu struc let rec check_mexpr env opac mse mp_mse res = match mse with | MEident mp -> let mb = lookup_module mp env in let mb = Modops.strengthen_and_subst_module_body mb mp_mse false in mb.mod_type, mb.mod_delta | MEapply (f,mp) -> let sign, delta = check_mexpr env opac f mp_mse res in let farg_id, farg_b, fbody_b = Modops.destr_functor sign in let mtb = Modops.module_type_of_module (lookup_module mp env) in let state = (Environ.universes env, Conversion.checked_universes) in let _ : UGraph.t = Subtyping.check_subtypes state env mtb farg_b in let subst = Mod_subst.map_mbid farg_id mp Mod_subst.empty_delta_resolver in Modops.subst_signature subst fbody_b, Mod_subst.subst_codom_delta_resolver subst delta | MEwith _ -> CErrors.user_err Pp.(str "Unsupported 'with' constraint in module implementation") let rec check_mexpression env opac sign mbtyp mp_mse res = match sign with | MEMoreFunctor body -> let arg_id, mtb, mbtyp = Modops.destr_functor mbtyp in let env' = Modops.add_module_type (MPbound arg_id) mtb env in let body, delta = check_mexpression env' opac body mbtyp mp_mse res in MoreFunctor(arg_id,mtb,body), delta | MENoFunctor me -> check_mexpr env opac me mp_mse res let rec check_module env opac mp mb opacify = Flags.if_verbose Feedback.msg_notice (str " checking module: " ++ str (ModPath.to_string mp)); let env = Modops.add_retroknowledge mb.mod_retroknowledge env in let opac = check_signature env opac mb.mod_type mb.mod_mp mb.mod_delta opacify in let optsign, opac = match mb.mod_expr with | Struct sign_struct -> let opacify = collect_constants_without_body mb.mod_type mb.mod_mp opacify in (* TODO: a bit wasteful, we recheck the types of parameters twice *) let sign_struct = Modops.annotate_struct_body sign_struct mb.mod_type in let opac = check_signature env opac sign_struct mb.mod_mp mb.mod_delta opacify in Some (sign_struct, mb.mod_delta), opac | Algebraic me -> Some (check_mexpression env opac me mb.mod_type mb.mod_mp mb.mod_delta), opac | Abstract|FullStruct -> None, opac in let () = match optsign with | None -> () | Some (sign,delta) -> let mtb1 = mk_mtb mp sign delta and mtb2 = mk_mtb mp mb.mod_type mb.mod_delta in let env = Modops.add_module_type mp mtb1 env in let state = (Environ.universes env, Conversion.checked_universes) in let _ : UGraph.t = Subtyping.check_subtypes state env mtb1 mtb2 in () in opac and check_module_type env mty = Flags.if_verbose Feedback.msg_notice (str " checking module type: " ++ str (ModPath.to_string mty.mod_mp)); let _ : _ Cmap.t = check_signature env Cmap.empty mty.mod_type mty.mod_mp mty.mod_delta Cset.empty in () and check_structure_field env opac mp lab res opacify = function | SFBconst cb -> let c = Constant.make2 mp lab in check_constant_declaration env opac c cb (Cset.mem c opacify) | SFBmind mib -> let kn = KerName.make mp lab in let kn = Mod_subst.mind_of_delta_kn res kn in CheckInductive.check_inductive env kn mib, opac | SFBmodule msb -> let opac = check_module env opac (MPdot(mp,lab)) msb opacify in Modops.add_module msb env, opac | SFBmodtype mty -> check_module_type env mty; add_modtype mty env, opac | SFBrules rrb -> check_rewrite_rules_body env lab rrb; Environ.add_rewrite_rules rrb.rewrules_rules env, opac and check_signature env opac sign mp_mse res opacify = match sign with | MoreFunctor (arg_id, mtb, body) -> check_module_type env mtb; let env' = Modops.add_module_type (MPbound arg_id) mtb env in let opac = check_signature env' opac body mp_mse res Cset.empty in opac | NoFunctor struc -> let (_:env), opac = List.fold_left (fun (env, opac) (lab,mb) -> check_structure_field env opac mp_mse lab res opacify mb) (env, opac) struc in opac let check_module env opac mp mb = check_module env opac mp mb Cset.empty coq-8.20.0/checker/mod_checking.mli000066400000000000000000000016701466560755400171320ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* Opaqueproof.opaque_proofterm) -> unit val check_module : Environ.env -> Names.Cset.t Names.Cmap.t -> Names.ModPath.t -> Declarations.module_body -> Names.Cset.t Names.Cmap.t exception BadConstant of Names.Constant.t * Pp.t coq-8.20.0/checker/safe_checking.ml000066400000000000000000000025151466560755400171170ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* Names.Cset.t Names.Cmap.t -> compiled_library -> Vmlibrary.on_disk -> vodigest -> safe_environment * Names.Cset.t Names.Cmap.t val unsafe_import : safe_environment -> compiled_library -> Vmlibrary.on_disk -> vodigest -> safe_environment coq-8.20.0/checker/validate.ml000066400000000000000000000155431466560755400161440ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* Format.print_int i | Ptr p -> let v = LargeArray.get mem p in begin match v with | Struct (tag, data) -> let n = Array.length data in Format.print_string ("#"^string_of_int tag^"("); Format.open_hvbox 0; for i = 0 to n-1 do pr_obj_rec mem (Array.get data i); if i<>n-1 then (Format.print_string ","; Format.print_cut()) done; Format.close_box(); Format.print_string ")" | String s -> Format.print_string ("\""^String.escaped s^"\"") | Int64 _ | Float64 _ -> Format.print_string "?" end | Atm tag -> Format.print_string ("#"^string_of_int tag^"()"); | Fun addr -> Format.printf "fun@%x" addr let pr_obj mem o = pr_obj_rec mem o; Format.print_newline() (**************************************************************************) (* Obj low-level validators *) type error_frame = | CtxAnnot of string | CtxType of string | CtxField of int | CtxTag of int type error_context = error_frame list let mt_ec : error_context = [] let (/) (ctx:error_context) s : error_context = s::ctx exception ValidObjError of string * error_context * data let fail _mem ctx o s = raise (ValidObjError(s,ctx,o)) let is_block mem o = match o with | Ptr _ | Atm _ -> true | Fun _ | Int _ -> false let is_int _mem o = match o with | Int _ -> true | Fun _ | Ptr _ | Atm _ -> false let is_int64 mem o = match o with | Int _ | Fun _ | Atm _ -> false | Ptr p -> match LargeArray.get mem p with | Int64 _ -> true | Float64 _ | Struct _ | String _ -> false let is_float64 mem o = match o with | Int _ | Fun _ | Atm _ -> false | Ptr p -> match LargeArray.get mem p with | Float64 _ -> true | Int64 _ | Struct _ | String _ -> false let get_int _mem = function | Int i -> i | Fun _ | Ptr _ | Atm _ -> assert false let tag mem o = match o with | Atm tag -> tag | Fun _ -> Obj.out_of_heap_tag | Int _ -> Obj.int_tag | Ptr p -> match LargeArray.get mem p with | Struct (tag, _) -> tag | String _ -> Obj.string_tag | Float64 _ -> Obj.double_tag | Int64 _ -> Obj.custom_tag let size mem o = match o with | Atm _ -> 0 | Fun _ | Int _ -> assert false | Ptr p -> match LargeArray.get mem p with | Struct (tag, blk) -> Array.length blk | String _ | Float64 _ | Int64 _ -> assert false let field mem o i = match o with | Atm _ | Fun _ | Int _ -> assert false | Ptr p -> match LargeArray.get mem p with | Struct (tag, blk) -> Array.get blk i | String _ | Float64 _ | Int64 _ -> assert false (* Check that object o is a block with tag t *) let val_tag t mem ctx o = if is_block mem o && tag mem o = t then () else fail mem ctx o ("expected tag "^string_of_int t) let val_block mem ctx o = if is_block mem o then (if tag mem o > Obj.no_scan_tag then fail mem ctx o "block: found no scan tag") else fail mem ctx o "expected block obj" let val_dyn mem ctx o = let fail () = fail mem ctx o "expected a Dyn.t" in if not (is_block mem o) then fail () else if not (size mem o = 2) then fail () else if not (tag mem (field mem o 0) = Obj.int_tag) then fail () else () open Values let rec val_gen v mem ctx o = match v with | Tuple (name,vs) -> val_tuple ~name vs mem ctx o | Sum (name,cc,vv) -> val_sum name cc vv mem ctx o | Array v -> val_array v mem ctx o | List v0 -> val_sum "list" 1 [|[|Annot ("elem",v0);v|]|] mem ctx o | Opt v -> val_sum "option" 1 [|[|v|]|] mem ctx o | Int -> if not (is_int mem o) then fail mem ctx o "expected an int" | String -> (try val_tag Obj.string_tag mem ctx o with Failure _ -> fail mem ctx o "expected a string") | Any -> () | Fail s -> fail mem ctx o ("unexpected object " ^ s) | Annot (s,v) -> val_gen v mem (ctx/CtxAnnot s) o | Dyn -> val_dyn mem ctx o | Proxy { contents = v } -> val_gen v mem ctx o | Int64 -> val_int64 mem ctx o | Float64 -> val_float64 mem ctx o (* Check that an object is a tuple (or a record). vs is an array of value representation for each field. Its size corresponds to the expected size of the object. *) and val_tuple ?name vs mem ctx o = let ctx = match name with | Some n -> ctx/CtxType n | _ -> ctx in let n = Array.length vs in let val_fld i v = val_gen v mem (ctx/(CtxField i)) (field mem o i) in val_block mem ctx o; if size mem o = n then Array.iteri val_fld vs else fail mem ctx o ("tuple size: found "^string_of_int (size mem o)^ ", expected "^string_of_int n) (* Check that the object is either a constant constructor of tag < cc, or a constructed variant. each element of vv is an array of value representations of the constructor arguments. The size of vv corresponds to the number of non-constant constructors, and the size of vv.(i) is the expected arity of the i-th non-constant constructor. *) and val_sum name cc vv mem ctx o = let ctx = ctx/CtxType name in if is_block mem o then (val_block mem ctx o; let n = Array.length vv in let i = tag mem o in let ctx' = if n=1 then ctx else ctx/CtxTag i in if i < n then val_tuple vv.(i) mem ctx' o else fail mem ctx' o ("sum: unexpected tag")) else if is_int mem o then let (n:int) = get_int mem o in (if n<0 || n>=cc then fail mem ctx o ("bad constant constructor "^string_of_int n)) else fail mem ctx o "not a sum" (* Check the o is an array of values satisfying f. *) and val_array v mem ctx o = val_block mem (ctx/CtxType "array") o; for i = 0 to size mem o - 1 do val_gen v mem ctx (field mem o i) done and val_int64 mem ctx o = if not (is_int64 mem o) then fail mem ctx o "not a 63-bit unsigned integer" and val_float64 mem ctx o = if not (is_float64 mem o) then fail mem ctx o "not a 64-bit float" let print_frame = function | CtxType t -> t | CtxAnnot t -> t | CtxField i -> Printf.sprintf "fld=%i" i | CtxTag i -> Printf.sprintf "tag=%i" i let validate v (o, mem) = try val_gen v mem mt_ec o with ValidObjError(msg,ctx,obj) -> let rctx = List.rev_map print_frame ctx in print_endline ("Context: "^String.concat"/"rctx); pr_obj mem obj; failwith ("Validation failed: "^msg^" (in "^(print_frame (List.hd ctx))^")") coq-8.20.0/checker/validate.mli000066400000000000000000000013611466560755400163060ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* data * obj LargeArray.t -> unit coq-8.20.0/checker/values.ml000066400000000000000000000356621466560755400156560ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* value) : value = let self = ref Any in let ans = f (Proxy self) in let () = self := ans in ans (** Some pseudo-constructors *) let v_tuple name v = Tuple(name,v) let v_sum name cc vv = Sum(name,cc,vv) let v_enum name n = Sum(name,n,[||]) (** Ocaml standard library *) let v_pair v1 v2 = v_tuple "*" [|v1; v2|] let v_bool = v_enum "bool" 2 let v_unit = v_enum "unit" 1 let v_set v = let rec s = Sum ("Set.t",1, [|[|s; Annot("elem",v); s; Annot("bal",Int)|]|]) in s let v_map vk vd = let rec m = Sum ("Map.t",1, [|[|m; Annot("key",vk); Annot("data",vd); m; Annot("bal",Int)|]|]) in m let v_hset v = v_map Int (v_set v) let v_hmap vk vd = v_map Int (v_map vk vd) let v_pred v = v_pair v_bool (v_set v) (** kernel/names *) let v_id = String let v_dp = Annot ("dirpath", List v_id) let v_name = v_sum "name" 1 [|[|v_id|]|] let v_uid = v_tuple "uniq_ident" [|Int;String;v_dp|] let rec v_mp = Sum("module_path",0, [|[|v_dp|]; [|v_uid|]; [|v_mp;v_id|]|]) let v_kn = v_tuple "kernel_name" [|v_mp;v_id;Int|] let v_cst = v_sum "cst|mind" 0 [|[|v_kn|];[|v_kn;v_kn|]|] let v_ind = v_tuple "inductive" [|v_cst;Int|] let v_cons = v_tuple "constructor" [|v_ind;Int|] (** kernel/univ *) let v_level_global = v_tuple "Level.Global.t" [|v_dp;String;Int|] let v_raw_level = v_sum "raw_level" 1 (* Set *) [|(*Level*)[|v_level_global|]; (*Var*)[|Int|]|] let v_level = v_tuple "level" [|Int;v_raw_level|] let v_expr = v_tuple "levelexpr" [|v_level;Int|] let v_univ = List v_expr let v_qvar = v_sum "qvar" 0 [|[|Int|];[|String;Int|]|] let v_constant_quality = v_enum "constant_quality" 3 let v_quality = v_sum "quality" 0 [|[|v_qvar|];[|v_constant_quality|]|] let v_cstrs = Annot ("Univ.constraints", v_set (v_tuple "univ_constraint" [|v_level;v_enum "order_request" 3;v_level|])) let v_variance = v_enum "variance" 3 let v_instance = Annot ("instance", v_pair (Array v_quality) (Array v_level)) let v_abs_context = v_tuple "abstract_universe_context" [|v_pair (Array v_name) (Array v_name); v_cstrs|] let v_context_set = v_tuple "universe_context_set" [|v_hset v_level;v_cstrs|] (** kernel/term *) let v_sort = v_sum "sort" 3 (*SProp, Prop, Set*) [|[|v_univ(*Type*)|];[|v_qvar;v_univ(*QSort*)|]|] let v_relevance = v_sum "relevance" 2 [|[|v_qvar|]|] let v_binder_annot x = v_tuple "binder_annot" [|x;v_relevance|] let v_puniverses v = v_tuple "punivs" [|v;v_instance|] let v_caseinfo = let v_cstyle = v_enum "case_style" 5 in let v_cprint = v_tuple "case_printing" [|v_cstyle|] in v_tuple "case_info" [|v_ind;Int;Array Int;Array Int;v_cprint|] let v_cast = v_enum "cast_kind" 3 let v_proj_repr = v_tuple "projection_repr" [|v_ind;Int;Int;v_cst|] let v_proj = v_tuple "projection" [|v_proj_repr; v_bool|] let v_uint63 = if Sys.word_size == 64 then Int else Int64 let rec v_constr = Sum ("constr",0,[| [|Int|]; (* Rel *) [|v_id|]; (* Var *) [|Fail "Meta"|]; (* Meta *) [|Fail "Evar"|]; (* Evar *) [|v_sort|]; (* Sort *) [|v_constr;v_cast;v_constr|]; (* Cast *) [|v_binder_annot v_name;v_constr;v_constr|]; (* Prod *) [|v_binder_annot v_name;v_constr;v_constr|]; (* Lambda *) [|v_binder_annot v_name;v_constr;v_constr;v_constr|]; (* LetIn *) [|v_constr;Array v_constr|]; (* App *) [|v_puniverses v_cst|]; (* Const *) [|v_puniverses v_ind|]; (* Ind *) [|v_puniverses v_cons|]; (* Construct *) [|v_caseinfo;v_instance; Array v_constr; v_case_return; v_case_invert; v_constr; Array v_case_branch|]; (* Case *) [|v_fix|]; (* Fix *) [|v_cofix|]; (* CoFix *) [|v_proj;v_relevance;v_constr|]; (* Proj *) [|v_uint63|]; (* Int *) [|Float64|]; (* Float *) [|String|]; (* String *) [|v_instance;Array v_constr;v_constr;v_constr|] (* Array *) |]) and v_prec = Tuple ("prec_declaration", [|Array (v_binder_annot v_name); Array v_constr; Array v_constr|]) and v_fix = Tuple ("pfixpoint", [|Tuple ("fix2",[|Array Int;Int|]);v_prec|]) and v_cofix = Tuple ("pcofixpoint",[|Int;v_prec|]) and v_case_invert = Sum ("case_inversion", 1, [|[|Array v_constr|]|]) and v_case_branch = Tuple ("case_branch", [|Array (v_binder_annot v_name); v_constr|]) and v_case_return = Tuple ("case_return", [|Tuple ("case_return'", [|Array (v_binder_annot v_name); v_constr|]); v_relevance|]) let v_rdecl = v_sum "rel_declaration" 0 [| [|v_binder_annot v_name; v_constr|]; (* LocalAssum *) [|v_binder_annot v_name; v_constr; v_constr|] |] (* LocalDef *) let v_rctxt = List v_rdecl let v_ndecl = v_sum "named_declaration" 0 [| [|v_binder_annot v_id; v_constr|]; (* LocalAssum *) [|v_binder_annot v_id; v_constr; v_constr|] |] (* LocalDef *) let v_nctxt = List v_ndecl let v_section_ctxt = v_enum "emptylist" 1 (** kernel/mod_subst *) let v_univ_abstracted v = v_tuple "univ_abstracted" [|v;v_abs_context|] let v_delta_hint = v_sum "delta_hint" 0 [|[|Int; Opt (v_univ_abstracted v_constr)|];[|v_kn|]|] let v_resolver = v_tuple "delta_resolver" [|v_map v_mp v_mp; v_hmap v_kn v_delta_hint|] let v_mp_resolver = v_tuple "" [|v_mp;v_resolver|] let v_subst = Annot ("substitution", v_map v_mp v_mp_resolver) (** kernel/lazyconstr *) let v_abstr_info = Tuple ("abstr_info", [|v_nctxt; v_abs_context; v_instance|]) let v_abstr_inst_info = Tuple ("abstr_inst_info", [|List v_id; v_instance|]) let v_expand_info = Tuple ("expand_info", [|v_hmap v_cst v_abstr_inst_info; v_hmap v_cst v_abstr_inst_info|]) let v_cooking_info = Tuple ("cooking_info", [|v_expand_info; v_abstr_info|]) let v_opaque = v_sum "opaque" 0 [|[|List v_subst; List v_cooking_info; v_dp; Int|]|] (** kernel/declarations *) let v_conv_level = v_sum "conv_level" 2 [|[|Int|]|] let v_oracle = v_tuple "oracle" [| v_map v_id v_conv_level; v_hmap v_cst v_conv_level; v_hmap v_proj_repr v_conv_level; v_pred v_id; v_pred v_cst; v_pred v_proj_repr; |] let v_template_arity = v_tuple "template_arity" [|v_sort|] let v_template_universes = v_tuple "template_universes" [|List(Opt v_level);v_context_set|] let v_primitive = v_enum "primitive" 63 (* Number of constructors of the CPrimitives.t type *) let v_cst_def = v_sum "constant_def" 0 [|[|Opt Int|]; [|v_constr|]; [|v_opaque|]; [|v_primitive|]; [|v_bool|]|] let v_typing_flags = v_tuple "typing_flags" [|v_bool; v_bool; v_bool; v_oracle; v_bool; v_bool; v_bool; v_bool; v_bool; v_bool; v_bool|] let v_univs = v_sum "universes" 1 [|[|v_abs_context|]|] let v_vm_reloc_table = Array (v_pair Int Int) let v_vm_annot_switch = v_tuple "vm_annot_switch" [|v_vm_reloc_table; v_bool; Int|] let v_vm_caml_prim = v_enum "vm_caml_prim" 6 let v_non_subst_reloc = v_sum "vm_non_subst_reloc" 0 [| [|v_sort|]; [|Fail "Evar"|]; [|Int|]; [|v_instance|]; [|Any|]; (* contains a Vmvalues.value *) [|v_uint63|]; [|Float64|]; [|String|]; [|v_vm_annot_switch|]; [|v_vm_caml_prim|]; |] let v_reloc = v_sum "vm_reloc" 0 [| [|v_ind|]; [|v_cst|]; [|Int|]; |] let v_vm_patches = v_tuple "vm_patches" [|Array v_reloc|] let v_vm_pbody_code index = v_sum "pbody_code" 1 [| [|Array v_bool; index; v_vm_patches|]; [|v_cst|]; |] let v_vm_index = v_pair v_dp Int let v_vm_indirect_code = v_vm_pbody_code v_vm_index let v_vm_emitcodes = String let v_vm_fv_elem = v_sum "vm_fv_elem" 0 [| [|v_id|]; [|Int|] |] let v_vm_fv = Array v_vm_fv_elem let v_vm_positions = String let v_vm_to_patch = v_tuple "vm_to_patch" [|v_vm_emitcodes; v_vm_fv; v_vm_positions; Array v_non_subst_reloc|] let v_cb = v_tuple "constant_body" [|v_section_ctxt; v_instance; v_cst_def; v_constr; v_relevance; Opt v_vm_indirect_code; v_univs; v_bool; v_typing_flags|] let v_recarg_type = v_sum "recarg_type" 0 [|[|v_ind|] (* Mrec *);[|v_cst|] (* NestedPrimitive *)|] let v_recarg = v_sum "recarg" 1 (* Norec *) [|[|v_recarg_type|] (* Mrec *)|] let rec v_wfp = Sum ("wf_paths",0, [|[|Int;Int|]; (* Rtree.Param *) [|v_recarg;Array (Array v_wfp)|]; (* Rtree.Node *) [|Int;Array v_wfp|] (* Rtree.Rec *) |]) let v_mono_ind_arity = v_tuple "monomorphic_inductive_arity" [|v_constr;v_sort|] let v_ind_arity = v_sum "inductive_arity" 0 [|[|v_mono_ind_arity|];[|v_template_arity|]|] let v_squash_info = v_sum "squash_info" 1 [|[|v_set v_quality|]|] let v_one_ind = v_tuple "one_inductive_body" [|v_id; v_rctxt; v_ind_arity; Array v_id; Array v_constr; Int; Int; Opt v_squash_info; Array (v_pair v_rctxt v_constr); Array Int; Array Int; v_wfp; v_relevance; Int; Int; v_vm_reloc_table|] let v_finite = v_enum "recursivity_kind" 3 let v_record_info = v_sum "record_info" 2 [| [| Array (v_tuple "record" [| v_id; Array v_id; Array v_relevance; Array v_constr |]) |] |] let v_ind_pack = v_tuple "mutual_inductive_body" [|Array v_one_ind; v_record_info; v_finite; Int; v_section_ctxt; v_instance; Int; Int; v_rctxt; v_univs; (* universes *) Opt v_template_universes; Opt (Array v_variance); Opt (Array v_variance); Opt v_bool; v_typing_flags|] let v_prim_ind = v_enum "prim_ind" 6 (* Number of "Register ... as kernel.ind_..." in PrimInt63.v and PrimFloat.v *) let v_prim_type = v_enum "prim_type" 4 (* Number of constructors of prim_type in "kernel/cPrimitives.ml" *) let v_retro_action = v_sum "retro_action" 0 [| [|v_prim_ind; v_ind|]; [|v_prim_type; v_cst|]; |] let v_retroknowledge = v_sum "module_retroknowledge" 1 [|[|List v_retro_action|]|] let v_puniv = Opt Int let v_pqvar = Opt Int let v_quality_pattern = v_sum "quality_pattern" 0 [|[|v_pqvar|];[|v_constant_quality|]|] let v_instance_mask = v_pair (Array v_quality_pattern) (Array v_puniv) let v_sort_pattern = Sum ("sort_pattern", 3, [|[|v_puniv|]; (* PSType *) [|v_pqvar; v_puniv|] (* PSQSort *) |]) let rec v_hpattern = Sum ("head_pattern", 0, [|[|Int|]; (* PHRel *) [|v_sort_pattern|]; (* PHSort *) [|v_cst; v_instance_mask|]; (* PHSymbol *) [|v_ind; v_instance_mask|]; (* PHInd *) [|v_cons; v_instance_mask|]; (* PHConstr *) [|v_uint63|]; (* PHInt *) [|Float64|]; (* PHFloat *) [|String|]; (* PHString *) [|Array v_patarg; v_patarg|]; (* PHLambda *) [|Array v_patarg; v_patarg|]; (* PHProd *) |]) and v_elimination = Sum ("pattern_elimination", 0, [|[|Array v_patarg|]; (* PEApp *) [|v_ind; v_instance_mask; v_patarg; Array v_patarg|]; (* PECase *) [|v_proj|]; (* PEProj *) |]) and v_head_elim = Tuple ("head*elims", [|v_hpattern; List v_elimination|]) and v_patarg = Sum ("pattern_argument", 1, [|[|Int|]; (* EHole *) [|v_head_elim|]; (* ERigid *) |]) let v_rewrule = v_tuple "rewrite_rule" [| v_tuple "nvars" [| Int; Int; Int |]; v_pair v_instance_mask (List v_elimination); v_constr |] let v_rrb = v_tuple "rewrite_rules_body" [| List (v_pair v_cst v_rewrule) |] let v_module_with_decl = v_sum "with_declaration" 0 [| [|List v_id; v_mp|]; [|List v_id; v_pair v_constr (Opt v_abs_context)|]; |] let rec v_mae = Sum ("module_alg_expr",0, [|[|v_mp|]; (* SEBident *) [|v_mae;v_mp|]; (* SEBapply *) [|v_mae; v_module_with_decl|] (* SEBwith *) |]) let rec v_sfb = Sum ("struct_field_body",0, [|[|v_cb|]; (* SFBconst *) [|v_ind_pack|]; (* SFBmind *) [|v_rrb|]; (* SFBrules *) [|v_module|]; (* SFBmodule *) [|v_modtype|] (* SFBmodtype *) |]) and v_struc = List (Tuple ("label*sfb",[|v_id;v_sfb|])) and v_sign = Sum ("module_sign",0, [|[|v_struc|]; (* NoFunctor *) [|v_uid;v_modtype;v_sign|]|]) (* MoreFunctor *) and v_mexpr = Sum ("module_expr",0, [|[|v_mae|]; (* MENoFunctor *) [|v_mexpr|]|]) (* MEMoreFunctor *) and v_impl = Sum ("module_impl",2, (* Abstract, FullStruct *) [|[|v_mexpr|]; (* Algebraic *) [|v_struc|]|]) (* Struct *) and v_noimpl = v_unit and v_module = Tuple ("module_body", [|v_mp;v_impl;v_sign;Opt v_mexpr;v_resolver;v_retroknowledge|]) and v_modtype = Tuple ("module_type_body", [|v_mp;v_noimpl;v_sign;Opt v_mexpr;v_resolver;v_unit|]) (** kernel/safe_typing *) let v_vodigest = Sum ("module_impl",0, [| [|String|]; [|String;String|] |]) let v_deps = Array (v_tuple "dep" [|v_dp;v_vodigest|]) let v_flags = v_tuple "flags" [|v_bool|] (* Allow Rewrite Rules *) let v_compiled_lib = v_tuple "compiled" [|v_dp;v_module;v_context_set;v_deps; v_flags|] (** STM objects *) let v_frozen = Tuple ("frozen", [|List (v_pair Int Dyn); Opt Dyn|]) let v_states = v_pair Any v_frozen let v_state = Tuple ("state", [|v_states; Any; v_bool|]) let v_vcs = let vcs self = Tuple ("vcs", [|Any; Any; Tuple ("dag", [|Any; Any; v_map Any (Tuple ("state_info", [|Any; Any; Opt v_state; v_pair (Opt self) Any|])) |]) |]) in fix vcs let v_uuid = Any let v_request id doc = Tuple ("request", [|Any; Any; doc; Any; id; String|]) let v_tasks = List (v_pair (v_request v_uuid v_vcs) v_bool) let v_counters = Any let v_stm_seg = v_pair v_tasks v_counters (** Toplevel structures in a vo (see Cic.mli) *) let v_libsum = Tuple ("summary", [|v_dp;v_deps;String;Any|]) let v_lib = Tuple ("library",[|v_compiled_lib;Any;Any|]) let v_delayed_universes = Sum ("delayed_universes", 0, [| [| v_unit |]; [| v_context_set |] |]) let v_opaquetable = Array (Opt (v_pair v_constr v_delayed_universes)) let v_univopaques = Opt (Tuple ("univopaques",[|v_context_set;v_bool|])) let v_vmlib = v_tuple "vmlibrary" [|v_dp; Array v_vm_to_patch|] coq-8.20.0/checker/values.mli000066400000000000000000000031411466560755400160120ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* \tenter the -th child\n\ u\tgo up 1 level\n\ s\tsort\n\ l\ttreat current node as a list\n\ x\texit\n\n%!" let quit () = Printf.printf "\nGoodbye!\n%!"; exit 0 let rec read_num max = Printf.printf "# %!"; let l = try read_line () with End_of_file -> quit () in match l with | "u" -> CmdParent | "s" -> CmdSort | "x" -> CmdExit | "h" -> CmdHelp | "l" -> CmdList | _ -> match int_of_string l with | v -> if v < 0 || v >= max then let () = Printf.printf "Out-of-range input! (only %d children)\n%!" max in read_num max else CmdChild v | exception Failure _ -> Printf.printf "Unrecognized input! Input h for help\n%!"; read_num max type 'a repr = | INT of int | STRING of string | BLOCK of int * 'a array | OTHER module type S = sig type obj val input : in_channel -> obj val repr : obj -> obj repr val size : obj -> int val oid : obj -> int option end module ReprObj : S = struct type obj = Obj.t * int list let input chan = let obj = input_value chan in let () = CObj.register_shared_size obj in (obj, []) let repr (obj, pos) = if Obj.is_block obj then let tag = Obj.tag obj in if tag = Obj.string_tag then STRING (Obj.magic obj) else if tag < Obj.no_scan_tag then let init i = (Obj.field obj i, i :: pos) in let data = Array.init (Obj.size obj) init in BLOCK (tag, Obj.magic data) else OTHER else INT (Obj.magic obj) let size (_, p) = CObj.shared_size_of_pos p let oid _ = None end module ReprMem : S = struct open Analyze type obj = data let memory = ref LargeArray.empty let sizes = ref LargeArray.empty (** size, in words *) let ws = Sys.word_size / 8 let rec init_size seen k = function | Int _ | Atm _ | Fun _ -> k 0 | Ptr p -> if LargeArray.get seen p then k 0 else let () = LargeArray.set seen p true in match LargeArray.get !memory p with | Struct (tag, os) -> let len = Array.length os in let rec fold i accu k = if i == len then k accu else init_size seen (fun n -> fold (succ i) (accu + 1 + n) k) os.(i) in fold 0 1 (fun size -> let () = LargeArray.set !sizes p size in k size) | Int64 _ -> k 0 | Float64 _ -> k 0 | String s -> let size = 2 + (String.length s / ws) in let () = LargeArray.set !sizes p size in k size let size = function | Int _ | Atm _ | Fun _ -> 0 | Ptr p -> LargeArray.get !sizes p let repr = function | Int i -> INT i | Atm t -> BLOCK (t, [||]) | Fun _ -> OTHER | Ptr p -> match LargeArray.get !memory p with | Struct (tag, os) -> BLOCK (tag, os) | Int64 _ -> OTHER (* TODO: pretty-print int63 values *) | Float64 _ -> OTHER (* TODO: pretty-print float64 values *) | String s -> STRING s let input ch = let obj, mem = parse_channel ch in let () = memory := mem in let () = sizes := LargeArray.make (LargeArray.length mem) (-1) in let seen = LargeArray.make (LargeArray.length mem) false in let () = init_size seen ignore obj in obj let oid = function | Int _ | Atm _ | Fun _ -> None | Ptr p -> Some p end module Visit (Repr : S) : sig val init : unit -> unit val visit : Values.value -> Repr.obj -> int list -> unit end = struct (** Name of a value *) let rec get_name ?(extra=false) = function |Any -> "?" |Fail s -> "Invalid node: "^s |Tuple (name,_) -> name |Sum (name,_,_) -> name |Array v -> "array"^(if extra then "/"^get_name ~extra v else "") |List v -> "list"^(if extra then "/"^get_name ~extra v else "") |Opt v -> "option"^(if extra then "/"^get_name ~extra v else "") |Int -> "int" |String -> "string" |Annot (s,v) -> s^"/"^get_name ~extra v |Dyn -> "" | Proxy v -> get_name ~extra !v | Int64 -> "Int64" | Float64 -> "Float64" (** For tuples, its quite handy to display the inner 1st string (if any). Cf. [structure_body] for instance *) exception TupleString of string let get_string_in_tuple o = try for i = 0 to Array.length o - 1 do match Repr.repr o.(i) with | STRING s -> let len = min max_string_length (String.length s) in raise (TupleString (Printf.sprintf " [..%s..]" (String.sub s 0 len))) | _ -> () done; "" with TupleString s -> s (** Some details : tags, integer value for non-block, etc etc *) let rec get_details v o = match v, Repr.repr o with | (String | Any), STRING s -> let len = min max_string_length (String.length s) in Printf.sprintf " [%s]" (String.escaped (String.sub s 0 len)) |Tuple (_,v), BLOCK (_, o) -> get_string_in_tuple o |(Sum _|Any), BLOCK (tag, _) -> Printf.sprintf " [tag=%i]" tag |(Sum _|Any), INT i -> Printf.sprintf " [imm=%i]" i |Int, INT i -> Printf.sprintf " [imm=%i]" i |Annot (s,v), _ -> get_details v o |_ -> "" let get_oid obj = match Repr.oid obj with | None -> "" | Some id -> Printf.sprintf " [0x%08x]" id let node_info (v,o,p) = get_name ~extra:true v ^ get_details v o ^ " (size "^ string_of_int (Repr.size o)^"w)" ^ get_oid o (** Children of a block : type, object, position. For lists, we collect all elements of the list at once *) let access_children vs os pos = if Array.length os = Array.length vs then Array.mapi (fun i v -> v, os.(i), i::pos) vs else raise_notrace Exit let access_list v o pos = let rec loop o pos accu = match Repr.repr o with | INT 0 -> List.rev accu | BLOCK (0, [|hd; tl|]) -> loop tl (1 :: pos) ((v, hd, 0 :: pos) :: accu) | _ -> raise_notrace Exit in Array.of_list (loop o pos []) let access_block o = match Repr.repr o with | BLOCK (tag, os) -> (tag, os) | _ -> raise_notrace Exit (** raises Exit if the object has not the expected structure *) exception Forbidden let rec get_children v o pos = match v with |Tuple (_, v) -> let (_, os) = access_block o in access_children v os pos |Sum (_, _, vv) -> begin match Repr.repr o with | BLOCK (tag, os) -> access_children vv.(tag) os pos | INT _ -> [||] | _ -> raise_notrace Exit end |Array v -> let (_, os) = access_block o in access_children (Array.make (Array.length os) v) os pos |List v -> access_list v o pos |Opt v -> begin match Repr.repr o with | INT 0 -> [||] | BLOCK (0, [|x|]) -> [|(v, x, 0 :: pos)|] | _ -> raise_notrace Exit end | String -> begin match Repr.repr o with | STRING _ -> [||] | _ -> raise_notrace Exit end | Int -> begin match Repr.repr o with | INT _ -> [||] | _ -> raise_notrace Exit end |Annot (s,v) -> get_children v o pos |Any -> raise_notrace Exit |Dyn -> begin match Repr.repr o with | BLOCK (0, [|id; o|]) -> let tpe = Any in [|(Int, id, 0 :: pos); (tpe, o, 1 :: pos)|] | _ -> raise_notrace Exit end |Fail s -> raise Forbidden | Proxy v -> get_children !v o pos | Int64 -> raise_notrace Exit | Float64 -> raise_notrace Exit let get_children v o pos = try get_children v o pos with Exit -> match Repr.repr o with | BLOCK (_, os) -> Array.mapi (fun i o -> Any, o, i :: pos) os | _ -> [||] type info = { nam : string; typ : value; obj : Repr.obj; pos : int list } let stk = ref ([] : info list) let init () = stk := [] let push name v o p = stk := { nam = name; typ = v; obj = o; pos = p } :: !stk exception EmptyStack let pop () = match !stk with | i::s -> stk := s; i | _ -> raise EmptyStack let print_state v o pos children = Printf.printf "\nDepth %d Pos %s Context %s\n" (List.length !stk) (String.concat "." (List.rev_map string_of_int pos)) (String.concat "/" (List.rev_map (fun i -> i.nam) !stk)); Printf.printf "-------------\n"; let nchild = Array.length children in Printf.printf "Here: %s, %d child%s\n" (node_info (v,o,pos)) nchild (if nchild = 0 then "" else "ren:"); Array.iter (fun (i, vop) -> Printf.printf " %d: %s\n" i (node_info vop)) children; Printf.printf "-------------\n" let rec visit v o pos = let children = get_children v o pos in let children = Array.mapi (fun i vop -> (i, vop)) children in let () = print_state v o pos children in read_command v o pos children and read_command v o pos children = try match read_num (Array.length children) with | CmdParent -> let info = pop () in visit info.typ info.obj info.pos | CmdChild child -> let _, (v',o',pos') = children.(child) in push (get_name v) v o pos; visit v' o' pos' | CmdSort -> let children = get_children v o pos in let children = Array.mapi (fun i vop -> (i, vop)) children in let sort (_, (_, o, _)) (_, (_, o', _)) = Int.compare (Repr.size o) (Repr.size o') in let sorted = Array.copy children in let () = Array.sort sort sorted in let () = print_state v o pos sorted in read_command v o pos children | CmdList -> visit (List Any) o pos | CmdHelp -> let () = help () in read_command v o pos children | CmdExit -> quit () with | EmptyStack -> () | Forbidden -> let info = pop () in visit info.typ info.obj info.pos | Failure _ | Invalid_argument _ -> visit v o pos end (** Loading the vo *) type header = { magic : string; (** Magic number of the marshaller *) length : int; (** Size on disk in bytes *) size32 : int; (** Size in words when loaded on 32-bit systems *) size64 : int; (** Size in words when loaded on 64-bit systems *) objects : int; (** Number of blocks defined in the marshalled structure *) } let dummy_header = { magic = "\000\000\000\000"; length = 0; size32 = 0; size64 = 0; objects = 0; } let parse_header chan = let magic = really_input_string chan 4 in let length = input_binary_int chan in let objects = input_binary_int chan in let size32 = input_binary_int chan in let size64 = input_binary_int chan in { magic; length; size32; size64; objects } module ObjFile = struct type segment = { name : string; pos : int64; len : int64; hash : Digest.t; mutable header : header; } let input_int32 ch = let accu = ref 0l in for _i = 0 to 3 do let c = input_byte ch in accu := Int32.add (Int32.shift_left !accu 8) (Int32.of_int c) done; !accu let input_int64 ch = let accu = ref 0L in for _i = 0 to 7 do let c = input_byte ch in accu := Int64.add (Int64.shift_left !accu 8) (Int64.of_int c) done; !accu let input_segment_summary ch = let nlen = input_int32 ch in let name = really_input_string ch (Int32.to_int nlen) in let pos = input_int64 ch in let len = input_int64 ch in let hash = Digest.input ch in { name; pos; len; hash; header = dummy_header } let rec input_segment_summaries ch n accu = if Int32.equal n 0l then Array.of_list (List.rev accu) else let s = input_segment_summary ch in let accu = s :: accu in input_segment_summaries ch (Int32.pred n) accu let parse_segments ch = let magic = input_int32 ch in let version = input_int32 ch in let summary_pos = input_int64 ch in let () = LargeFile.seek_in ch summary_pos in let nsum = input_int32 ch in let seg = input_segment_summaries ch nsum [] in for i = 0 to Array.length seg - 1 do let () = LargeFile.seek_in ch seg.(i).pos in let header = parse_header ch in seg.(i).header <- header done; (magic, version, seg) end let visit_vo f = Printf.printf "\nWelcome to votour !\n"; Printf.printf "Enjoy your guided tour of a Coq .vo or .vi file\n"; Printf.printf "Object sizes are in words (%d bits)\n" Sys.word_size; Printf.printf "Input h for help\n\n%!"; let known_segments = [ "summary", Values.v_libsum; "library", Values.v_lib; "universes", Values.v_univopaques; "tasks", (Opt Values.v_stm_seg); "opaques", Values.v_opaquetable; ] in let repr = if Sys.word_size = 64 then (module ReprMem : S) else (module ReprObj : S) (* On 32-bit machines, representation may exceed the max size of arrays *) in let module Repr = (val repr : S) in let module Visit = Visit(Repr) in while true do let ch = open_in_bin f in let (_magic, version, segments) = ObjFile.parse_segments ch in Printf.printf "File format: %ld\n%!" version; Printf.printf "The file has %d segments, choose the one to visit:\n" (Array.length segments); Array.iteri (fun i ObjFile.{ name; pos; header } -> let size = if Sys.word_size = 64 then header.size64 else header.size32 in Printf.printf " %d: %s, starting at byte %Ld (size %iw)\n" i name pos size) segments; match read_num (Array.length segments) with | CmdChild seg -> let seg = segments.(seg) in let open ObjFile in LargeFile.seek_in ch seg.pos; let o = Repr.input ch in let () = Visit.init () in let typ = try List.assoc seg.name known_segments with Not_found -> Any in Visit.visit typ o [] | CmdParent | CmdSort | CmdList -> () | CmdHelp -> help () | CmdExit -> quit () done let () = if not !Sys.interactive then Arg.parse [] visit_vo ("votour: guided tour of a Coq .vo or .vi file\n"^ "Usage: votour file.v[oi]") coq-8.20.0/checker/votour.mli000066400000000000000000000014501466560755400160520ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* 'a -> int) -> 'a array -> 'a array -> int val equal : ('a -> 'a -> bool) -> 'a array -> 'a array -> bool val equal_norefl : ('a -> 'a -> bool) -> 'a array -> 'a array -> bool val is_empty : 'a array -> bool val exists2 : ('a -> 'b -> bool) -> 'a array -> 'b array -> bool val for_all2 : ('a -> 'b -> bool) -> 'a array -> 'b array -> bool val for_all3 : ('a -> 'b -> 'c -> bool) -> 'a array -> 'b array -> 'c array -> bool val for_all4 : ('a -> 'b -> 'c -> 'd -> bool) -> 'a array -> 'b array -> 'c array -> 'd array -> bool val for_all_i : (int -> 'a -> bool) -> int -> 'a array -> bool val findi : (int -> 'a -> bool) -> 'a array -> int option val find2_map : ('a -> 'b -> 'c option) -> 'a array -> 'b array -> 'c option val hd : 'a array -> 'a val tl : 'a array -> 'a array val last : 'a array -> 'a val cons : 'a -> 'a array -> 'a array val rev : 'a array -> unit val fold_right_i : (int -> 'b -> 'a -> 'a) -> 'b array -> 'a -> 'a val fold_left_i : (int -> 'a -> 'b -> 'a) -> 'a -> 'b array -> 'a val fold_right2 : ('a -> 'b -> 'c -> 'c) -> 'a array -> 'b array -> 'c -> 'c val fold_right3 : ('a -> 'b -> 'c -> 'd -> 'd) -> 'a array -> 'b array -> 'c array -> 'd -> 'd val fold_left2 : ('a -> 'b -> 'c -> 'a) -> 'a -> 'b array -> 'c array -> 'a val fold_left3 : ('a -> 'b -> 'c -> 'd -> 'a) -> 'a -> 'b array -> 'c array -> 'd array -> 'a val fold_left4 : ('a -> 'b -> 'c -> 'd -> 'e -> 'a) -> 'a -> 'b array -> 'c array -> 'd array -> 'e array -> 'a val fold_left2_i : (int -> 'a -> 'b -> 'c -> 'a) -> 'a -> 'b array -> 'c array -> 'a val fold_left3_i : (int -> 'a -> 'b -> 'c -> 'd -> 'a) -> 'a -> 'b array -> 'c array -> 'd array -> 'a val fold_left_from : int -> ('a -> 'b -> 'a) -> 'a -> 'b array -> 'a val map_to_list : ('a -> 'b) -> 'a array -> 'b list val map_of_list : ('a -> 'b) -> 'a list -> 'b array val chop : int -> 'a array -> 'a array * 'a array val split : ('a * 'b) array -> 'a array * 'b array val split3 : ('a * 'b * 'c) array -> 'a array * 'b array * 'c array val split4 : ('a * 'b * 'c * 'd) array -> 'a array * 'b array * 'c array * 'd array val transpose : 'a array array -> 'a array array val map2_i : (int -> 'a -> 'b -> 'c) -> 'a array -> 'b array -> 'c array val map3 : ('a -> 'b -> 'c -> 'd) -> 'a array -> 'b array -> 'c array -> 'd array val map3_i : (int -> 'a -> 'b -> 'c -> 'd) -> 'a array -> 'b array -> 'c array -> 'd array val map_left : ('a -> 'b) -> 'a array -> 'b array val iter2_i : (int -> 'a -> 'b -> unit) -> 'a array -> 'b array -> unit val iter3 : ('a -> 'b -> 'c -> unit) -> 'a array -> 'b array -> 'c array -> unit val fold_left_map : ('a -> 'b -> 'a * 'c) -> 'a -> 'b array -> 'a * 'c array val fold_right_map : ('a -> 'c -> 'b * 'c) -> 'a array -> 'c -> 'b array * 'c val fold_left_map_i : (int -> 'a -> 'b -> 'a * 'c) -> 'a -> 'b array -> 'a * 'c array val fold_left2_map : ('a -> 'b -> 'c -> 'a * 'd) -> 'a -> 'b array -> 'c array -> 'a * 'd array val fold_left2_map_i : (int -> 'a -> 'b -> 'c -> 'a * 'd) -> 'a -> 'b array -> 'c array -> 'a * 'd array val fold_right2_map : ('a -> 'b -> 'c -> 'd * 'c) -> 'a array -> 'b array -> 'c -> 'd array * 'c val distinct : 'a array -> bool val rev_of_list : 'a list -> 'a array val rev_to_list : 'a array -> 'a list val filter_with : bool list -> 'a array -> 'a array module Smart : sig val map : ('a -> 'a) -> 'a array -> 'a array val map_i : (int -> 'a -> 'a) -> 'a array -> 'a array val map2 : ('a -> 'b -> 'b) -> 'a array -> 'b array -> 'b array val fold_left_map : ('a -> 'b -> 'a * 'b) -> 'a -> 'b array -> 'a * 'b array val fold_left2_map : ('a -> 'b -> 'c -> 'a * 'c) -> 'a -> 'b array -> 'c array -> 'a * 'c array end module Fun1 : sig val map : ('r -> 'a -> 'b) -> 'r -> 'a array -> 'b array val iter : ('r -> 'a -> unit) -> 'r -> 'a array -> unit val iter2 : ('r -> 'a -> 'b -> unit) -> 'r -> 'a array -> 'b array -> unit module Smart : sig val map : ('r -> 'a -> 'a) -> 'r -> 'a array -> 'a array end end end include Array let uget = Array.unsafe_get (* Arrays *) let compare cmp v1 v2 = if v1 == v2 then 0 else let len = Array.length v1 in let c = Int.compare len (Array.length v2) in if c <> 0 then c else let rec loop i = if i < 0 then 0 else let x = uget v1 i in let y = uget v2 i in let c = cmp x y in if c <> 0 then c else loop (i - 1) in loop (len - 1) let equal_norefl cmp t1 t2 = let len = Array.length t1 in if not (Int.equal len (Array.length t2)) then false else let rec aux i = if i < 0 then true else let x = uget t1 i in let y = uget t2 i in cmp x y && aux (pred i) in aux (len - 1) let equal cmp t1 t2 = if t1 == t2 then true else equal_norefl cmp t1 t2 let is_empty array = Int.equal (Array.length array) 0 let exists2 f v1 v2 = let rec exrec = function | -1 -> false | n -> f (uget v1 n) (uget v2 n) || (exrec (n-1)) in let lv1 = Array.length v1 in lv1 = Array.length v2 && exrec (lv1-1) let for_all2 f v1 v2 = let rec allrec = function | -1 -> true | n -> let ans = f (uget v1 n) (uget v2 n) in ans && (allrec (n-1)) in let lv1 = Array.length v1 in lv1 = Array.length v2 && allrec (pred lv1) let for_all3 f v1 v2 v3 = let rec allrec = function | -1 -> true | n -> let ans = f (uget v1 n) (uget v2 n) (uget v3 n) in ans && (allrec (n-1)) in let lv1 = Array.length v1 in lv1 = Array.length v2 && lv1 = Array.length v3 && allrec (pred lv1) let for_all4 f v1 v2 v3 v4 = let rec allrec = function | -1 -> true | n -> let ans = f (uget v1 n) (uget v2 n) (uget v3 n) (uget v4 n) in ans && (allrec (n-1)) in let lv1 = Array.length v1 in lv1 = Array.length v2 && lv1 = Array.length v3 && lv1 = Array.length v4 && allrec (pred lv1) let for_all_i f i v = let len = Array.length v in let rec allrec i n = n = len || f i (uget v n) && allrec (i+1) (n+1) in allrec i 0 exception Found of int let findi (pred: int -> 'a -> bool) (arr: 'a array) : int option = try for i=0 to Array.length arr - 1 do if pred i (uget arr i) then raise (Found i) done; None with Found i -> Some i let find2_map (type a) pred arr1 arr2 = let exception Found of a in let n = Array.length arr1 in if not (Array.length arr2 = n) then failwith "Array.find2_map"; try for i=0 to n - 1 do match pred (Array.unsafe_get arr1 i) (Array.unsafe_get arr2 i) with | Some r -> raise (Found r) | None -> () done; None with Found i -> Some i let hd v = match Array.length v with | 0 -> failwith "Array.hd" | _ -> uget v 0 let tl v = match Array.length v with | 0 -> failwith "Array.tl" | n -> Array.sub v 1 (pred n) let last v = match Array.length v with | 0 -> failwith "Array.last" | n -> uget v (pred n) let cons e v = let len = Array.length v in let ans = Array.make (Array.length v + 1) e in let () = Array.blit v 0 ans 1 len in ans let rev t = let n=Array.length t in if n <=0 then () else for i = 0 to pred (n/2) do let tmp = uget t ((pred n)-i) in Array.unsafe_set t ((pred n)-i) (uget t i); Array.unsafe_set t i tmp done let fold_right_i f v a = let rec fold a n = if n=0 then a else let k = n-1 in fold (f k (uget v k) a) k in fold a (Array.length v) let fold_left_i f v a = let n = Array.length a in let rec fold i v = if i = n then v else fold (succ i) (f i v (uget a i)) in fold 0 v let fold_right2 f v1 v2 a = let lv1 = Array.length v1 in let rec fold a n = if n=0 then a else let k = n-1 in fold (f (uget v1 k) (uget v2 k) a) k in if Array.length v2 <> lv1 then invalid_arg "Array.fold_right2"; fold a lv1 let fold_left2 f a v1 v2 = let lv1 = Array.length v1 in let rec fold a n = if n >= lv1 then a else fold (f a (uget v1 n) (uget v2 n)) (succ n) in if Array.length v2 <> lv1 then invalid_arg "Array.fold_left2"; fold a 0 let fold_left2_i f a v1 v2 = let lv1 = Array.length v1 in let rec fold a n = if n >= lv1 then a else fold (f n a (uget v1 n) (uget v2 n)) (succ n) in if Array.length v2 <> lv1 then invalid_arg "Array.fold_left2_i"; fold a 0 let fold_right3 f v1 v2 v3 a = let lv1 = Array.length v1 in let rec fold a n = if n=0 then a else let k = n-1 in fold (f (uget v1 k) (uget v2 k) (uget v3 k) a) k in if Array.length v2 <> lv1 || Array.length v3 <> lv1 then invalid_arg "Array.fold_right3"; fold a lv1 let fold_left3 f a v1 v2 v3 = let lv1 = Array.length v1 in let rec fold a n = if n >= lv1 then a else fold (f a (uget v1 n) (uget v2 n) (uget v3 n)) (succ n) in if Array.length v2 <> lv1 || Array.length v3 <> lv1 then invalid_arg "Array.fold_left3"; fold a 0 let fold_left3_i f a v1 v2 v3 = let lv1 = Array.length v1 in let rec fold a n = if n >= lv1 then a else fold (f n a (uget v1 n) (uget v2 n) (uget v3 n)) (succ n) in if Array.length v2 <> lv1 || Array.length v3 <> lv1 then invalid_arg "Array.fold_left3_i"; fold a 0 let fold_left4 f a v1 v2 v3 v4 = let lv1 = Array.length v1 in let rec fold a n = if n >= lv1 then a else fold (f a (uget v1 n) (uget v2 n) (uget v3 n) (uget v4 n)) (succ n) in if Array.length v2 <> lv1 || Array.length v3 <> lv1 || Array.length v4 <> lv1 then invalid_arg "Array.fold_left4"; fold a 0 let fold_left_from n f a v = let len = Array.length v in let () = if n < 0 then invalid_arg "Array.fold_left_from" in let rec fold a n = if n >= len then a else fold (f a (uget v n)) (succ n) in fold a n let rev_of_list = function | [] -> [| |] | x :: l -> let len = List.length l in let ans = Array.make (succ len) x in let rec set i = function | [] -> () | x :: l -> Array.unsafe_set ans i x; set (pred i) l in let () = set (len - 1) l in ans let map_to_list = CList.map_of_array let map_of_list f l = let len = List.length l in let rec fill i v = function | [] -> () | x :: l -> Array.unsafe_set v i (f x); fill (succ i) v l in match l with | [] -> [||] | x :: l -> let ans = Array.make len (f x) in let () = fill 1 ans l in ans let chop n v = let vlen = Array.length v in if n > vlen then failwith "Array.chop"; (Array.sub v 0 n, Array.sub v n (vlen-n)) let split v = (Array.map fst v, Array.map snd v) let split3 v = (Array.map (fun (a, _, _) -> a) v, Array.map (fun (_, b, _) -> b) v, Array.map (fun (_, _, c) -> c) v) let split4 v = (Array.map (fun (a, _, _, _) -> a) v, Array.map (fun (_, b, _, _) -> b) v, Array.map (fun (_, _, c, _) -> c) v, Array.map (fun (_, _, _, d) -> d) v) let transpose a = let n = Array.length a in if n = 0 then [||] else let n' = Array.length (Array.unsafe_get a 0) in Array.init n' (fun i -> Array.init n (fun j -> a.(j).(i))) let map2_i f v1 v2 = let len1 = Array.length v1 in let len2 = Array.length v2 in let () = if not (Int.equal len1 len2) then invalid_arg "Array.map2" in if Int.equal len1 0 then [| |] else begin let res = Array.make len1 (f 0 (uget v1 0) (uget v2 0)) in for i = 1 to pred len1 do Array.unsafe_set res i (f i (uget v1 i) (uget v2 i)) done; res end let map3 f v1 v2 v3 = let len1 = Array.length v1 in let () = if len1 <> Array.length v2 || len1 <> Array.length v3 then invalid_arg "Array.map3" in if Int.equal len1 0 then [| |] else begin let res = Array.make len1 (f (uget v1 0) (uget v2 0) (uget v3 0)) in for i = 1 to pred len1 do Array.unsafe_set res i (f (uget v1 i) (uget v2 i) (uget v3 i)) done; res end let map3_i f v1 v2 v3 = let len1 = Array.length v1 in let len2 = Array.length v2 in let len3 = Array.length v3 in let () = if not (Int.equal len1 len2 && Int.equal len1 len3) then invalid_arg "Array.map3_i" in if Int.equal len1 0 then [| |] else begin let res = Array.make len1 (f 0 (uget v1 0) (uget v2 0) (uget v3 0)) in for i = 1 to pred len1 do Array.unsafe_set res i (f i (uget v1 i) (uget v2 i) (uget v3 i)) done; res end let map_left f a = (* Ocaml does not guarantee Array.map is LR *) let l = Array.length a in (* (even if so), then we rewrite it *) if Int.equal l 0 then [||] else begin let r = Array.make l (f (uget a 0)) in for i = 1 to l - 1 do Array.unsafe_set r i (f (uget a i)) done; r end let iter2_i f v1 v2 = let len1 = Array.length v1 in let len2 = Array.length v2 in let () = if not (Int.equal len2 len1) then invalid_arg "Array.iter2" in for i = 0 to len1 - 1 do f i (uget v1 i) (uget v2 i) done let iter3 f v1 v2 v3 = let len1 = Array.length v1 in let len2 = Array.length v2 in let len3 = Array.length v3 in let () = if not (Int.equal len2 len1) || not (Int.equal len1 len3) then invalid_arg "Array.iter3" in for i = 0 to len1 - 1 do f (uget v1 i) (uget v2 i) (uget v3 i) done let map_right f a = let l = length a in if l = 0 then [||] else begin let r = Array.make l (f (unsafe_get a (l-1))) in for i = l-2 downto 0 do unsafe_set r i (f (unsafe_get a i)) done; r end let map2_right f a b = let l = length a in if l <> length b then invalid_arg "CArray.map2_right: length mismatch"; if l = 0 then [||] else begin let r = Array.make l (f (unsafe_get a (l-1)) (unsafe_get b (l-1))) in for i = l-2 downto 0 do unsafe_set r i (f (unsafe_get a i) (unsafe_get b i)) done; r end let fold_right_map f v e = let e' = ref e in let v' = map_right (fun x -> let (y,e) = f x !e' in e' := e; y) v in (v',!e') let fold_left_map f e v = let e' = ref e in let v' = Array.map (fun x -> let (e,y) = f !e' x in e' := e; y) v in (!e',v') let fold_right2_map f v1 v2 e = let e' = ref e in let v' = map2_right (fun x1 x2 -> let (y,e) = f x1 x2 !e' in e' := e; y) v1 v2 in (v',!e') let fold_left2_map f e v1 v2 = let e' = ref e in let v' = map2 (fun x1 x2 -> let (e,y) = f !e' x1 x2 in e' := e; y) v1 v2 in (!e',v') let fold_left_map_i f e v = let e' = ref e in let v' = mapi (fun idx x -> let (e,y) = f idx !e' x in e' := e; y) v in (!e',v') let fold_left2_map_i f e v1 v2 = let e' = ref e in let v' = map2_i (fun idx x1 x2 -> let (e,y) = f idx !e' x1 x2 in e' := e; y) v1 v2 in (!e',v') let distinct v = let visited = Hashtbl.create 23 in try Array.iter (fun x -> if Hashtbl.mem visited x then raise_notrace Exit else Hashtbl.add visited x x) v; true with Exit -> false let rev_to_list a = let rec tolist i res = if i >= Array.length a then res else tolist (i+1) (uget a i :: res) in tolist 0 [] let filter_with filter v = Array.of_list (CList.filter_with filter (Array.to_list v)) module Smart = struct (* If none of the elements is changed by f we return ar itself. The while loop looks for the first such an element. If found, we break here and the new array is produced, but f is not re-applied to elements that are already checked *) let map f (ar : 'a array) = let len = Array.length ar in let i = ref 0 in let break = ref true in let temp = ref None in while !break && (!i < len) do let v = Array.unsafe_get ar !i in let v' = f v in if v == v' then incr i else begin break := false; temp := Some v'; end done; if !i < len then begin (* The array is not the same as the original one *) let ans : 'a array = Array.copy ar in let v = match !temp with None -> assert false | Some x -> x in Array.unsafe_set ans !i v; incr i; while !i < len do let v = Array.unsafe_get ans !i in let v' = f v in if v != v' then Array.unsafe_set ans !i v'; incr i done; ans end else ar (* Same as map_i but smart *) let map_i f (ar : 'a array) = let len = Array.length ar in let i = ref 0 in let break = ref true in let temp = ref None in while !break && (!i < len) do let v = Array.unsafe_get ar !i in let v' = f !i v in if v == v' then incr i else begin break := false; temp := Some v'; end done; if !i < len then begin (* The array is not the same as the original one *) let ans : 'a array = Array.copy ar in let v = match !temp with None -> assert false | Some x -> x in Array.unsafe_set ans !i v; incr i; while !i < len do let v = Array.unsafe_get ans !i in let v' = f !i v in if v != v' then Array.unsafe_set ans !i v'; incr i done; ans end else ar let map2 f aux_ar ar = let len = Array.length ar in let aux_len = Array.length aux_ar in let () = if not (Int.equal len aux_len) then invalid_arg "Array.Smart.map2" in let i = ref 0 in let break = ref true in let temp = ref None in while !break && (!i < len) do let v = Array.unsafe_get ar !i in let w = Array.unsafe_get aux_ar !i in let v' = f w v in if v == v' then incr i else begin break := false; temp := Some v'; end done; if !i < len then begin (* The array is not the same as the original one *) let ans : 'a array = Array.copy ar in let v = match !temp with None -> assert false | Some x -> x in Array.unsafe_set ans !i v; incr i; while !i < len do let v = Array.unsafe_get ans !i in let w = Array.unsafe_get aux_ar !i in let v' = f w v in if v != v' then Array.unsafe_set ans !i v'; incr i done; ans end else ar (** Same as [Smart.map] but threads a state meanwhile *) let fold_left_map f accu (ar : 'a array) = let len = Array.length ar in let i = ref 0 in let break = ref true in let r = ref accu in (* This variable is never accessed unset *) let temp = ref None in while !break && (!i < len) do let v = Array.unsafe_get ar !i in let (accu, v') = f !r v in r := accu; if v == v' then incr i else begin break := false; temp := Some v'; end done; if !i < len then begin let ans : 'a array = Array.copy ar in let v = match !temp with None -> assert false | Some x -> x in Array.unsafe_set ans !i v; incr i; while !i < len do let v = Array.unsafe_get ar !i in let (accu, v') = f !r v in r := accu; if v != v' then Array.unsafe_set ans !i v'; incr i done; !r, ans end else !r, ar (** Same as [Smart.map2] but threads a state meanwhile *) let fold_left2_map f accu aux_ar ar = let len = Array.length ar in let aux_len = Array.length aux_ar in let () = if not (Int.equal len aux_len) then invalid_arg "Array.Smart.fold_left2_map" in let i = ref 0 in let break = ref true in let r = ref accu in (* This variable is never accessed unset *) let temp = ref None in while !break && (!i < len) do let v = Array.unsafe_get ar !i in let w = Array.unsafe_get aux_ar !i in let (accu, v') = f !r w v in r := accu; if v == v' then incr i else begin break := false; temp := Some v'; end done; if !i < len then begin let ans : 'a array = Array.copy ar in let v = match !temp with None -> assert false | Some x -> x in Array.unsafe_set ans !i v; incr i; while !i < len do let v = Array.unsafe_get ar !i in let w = Array.unsafe_get aux_ar !i in let (accu, v') = f !r w v in r := accu; if v != v' then Array.unsafe_set ans !i v'; incr i done; !r, ans end else !r, ar end module Fun1 = struct let map f arg v = match v with | [| |] -> [| |] | _ -> let len = Array.length v in let x0 = Array.unsafe_get v 0 in let ans = Array.make len (f arg x0) in for i = 1 to pred len do let x = Array.unsafe_get v i in Array.unsafe_set ans i (f arg x) done; ans let iter f arg v = let len = Array.length v in for i = 0 to pred len do let x = uget v i in f arg x done let iter2 f arg v1 v2 = let len1 = Array.length v1 in let len2 = Array.length v2 in let () = if not (Int.equal len2 len1) then invalid_arg "Array.Fun1.iter2" in for i = 0 to pred len1 do let x1 = uget v1 i in let x2 = uget v2 i in f arg x1 x2 done module Smart = struct let map f arg (ar : 'a array) = let len = Array.length ar in let i = ref 0 in let break = ref true in let temp = ref None in while !break && (!i < len) do let v = Array.unsafe_get ar !i in let v' = f arg v in if v == v' then incr i else begin break := false; temp := Some v'; end done; if !i < len then begin (* The array is not the same as the original one *) let ans : 'a array = Array.copy ar in let v = match !temp with None -> assert false | Some x -> x in Array.unsafe_set ans !i v; incr i; while !i < len do let v = Array.unsafe_get ans !i in let v' = f arg v in if v != v' then Array.unsafe_set ans !i v'; incr i done; ans end else ar end end coq-8.20.0/clib/cArray.mli000066400000000000000000000201251466560755400152420ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* 'a -> int) -> 'a array -> 'a array -> int (** First size comparison, then lexicographic order. *) val equal : ('a -> 'a -> bool) -> 'a array -> 'a array -> bool (** Lift equality to array type. *) val equal_norefl : ('a -> 'a -> bool) -> 'a array -> 'a array -> bool (** Like {!equal} but does not assume that equality is reflexive: no optimisation is performed if both arrays are physically the same. *) val is_empty : 'a array -> bool (** True whenever the array is empty. *) val exists2 : ('a -> 'b -> bool) -> 'a array -> 'b array -> bool val for_all2 : ('a -> 'b -> bool) -> 'a array -> 'b array -> bool val for_all3 : ('a -> 'b -> 'c -> bool) -> 'a array -> 'b array -> 'c array -> bool val for_all4 : ('a -> 'b -> 'c -> 'd -> bool) -> 'a array -> 'b array -> 'c array -> 'd array -> bool val for_all_i : (int -> 'a -> bool) -> int -> 'a array -> bool val findi : (int -> 'a -> bool) -> 'a array -> int option val find2_map : ('a -> 'b -> 'c option) -> 'a array -> 'b array -> 'c option (** First result which is not None, or None; [Failure "Array.find2_map"] if the arrays don't have the same length *) val hd : 'a array -> 'a (** First element of an array, or [Failure "Array.hd"] if empty. *) val tl : 'a array -> 'a array (** Remaining part of [hd], or [Failure "Array.tl"] if empty. *) val last : 'a array -> 'a (** Last element of an array, or [Failure "Array.last"] if empty. *) val cons : 'a -> 'a array -> 'a array (** Append an element on the left. *) val rev : 'a array -> unit (** In place reversal. *) val fold_right_i : (int -> 'b -> 'a -> 'a) -> 'b array -> 'a -> 'a val fold_left_i : (int -> 'a -> 'b -> 'a) -> 'a -> 'b array -> 'a val fold_right2 : ('a -> 'b -> 'c -> 'c) -> 'a array -> 'b array -> 'c -> 'c val fold_right3 : ('a -> 'b -> 'c -> 'd -> 'd) -> 'a array -> 'b array -> 'c array -> 'd -> 'd val fold_left2 : ('a -> 'b -> 'c -> 'a) -> 'a -> 'b array -> 'c array -> 'a val fold_left3 : ('a -> 'b -> 'c -> 'd -> 'a) -> 'a -> 'b array -> 'c array -> 'd array -> 'a val fold_left4 : ('a -> 'b -> 'c -> 'd -> 'e -> 'a) -> 'a -> 'b array -> 'c array -> 'd array -> 'e array -> 'a val fold_left2_i : (int -> 'a -> 'b -> 'c -> 'a) -> 'a -> 'b array -> 'c array -> 'a val fold_left3_i : (int -> 'a -> 'b -> 'c -> 'd -> 'a) -> 'a -> 'b array -> 'c array -> 'd array -> 'a val fold_left_from : int -> ('a -> 'b -> 'a) -> 'a -> 'b array -> 'a val map_to_list : ('a -> 'b) -> 'a array -> 'b list (** Composition of [map] and [to_list]. *) val map_of_list : ('a -> 'b) -> 'a list -> 'b array (** Composition of [map] and [of_list]. *) val chop : int -> 'a array -> 'a array * 'a array (** [chop i a] returns [(a1, a2)] s.t. [a = a1 + a2] and [length a1 = n]. Raise [Failure "Array.chop"] if [i] is not a valid index. *) val split : ('a * 'b) array -> 'a array * 'b array val split3 : ('a * 'b * 'c) array -> 'a array * 'b array * 'c array val split4 : ('a * 'b * 'c * 'd) array -> 'a array * 'b array * 'c array * 'd array val transpose : 'a array array -> 'a array array val map2_i : (int -> 'a -> 'b -> 'c) -> 'a array -> 'b array -> 'c array val map3 : ('a -> 'b -> 'c -> 'd) -> 'a array -> 'b array -> 'c array -> 'd array val map3_i : (int -> 'a -> 'b -> 'c -> 'd) -> 'a array -> 'b array -> 'c array -> 'd array val map_left : ('a -> 'b) -> 'a array -> 'b array (** As [map] but guaranteed to be left-to-right. *) val iter2_i : (int -> 'a -> 'b -> unit) -> 'a array -> 'b array -> unit (** Iter on two arrays. Raise [Invalid_argument "Array.iter2_i"] if sizes differ. *) val iter3 : ('a -> 'b -> 'c -> unit) -> 'a array -> 'b array -> 'c array -> unit (** Iter on three arrays. Raise [Invalid_argument "Array.iter3"] if sizes differ. *) val fold_left_map : ('a -> 'b -> 'a * 'c) -> 'a -> 'b array -> 'a * 'c array (** [fold_left_map f e_0 [|l_1...l_n|] = e_n,[|k_1...k_n|]] where [(e_i,k_i)=f e_{i-1} l_i]; see also [Smart.fold_left_map] *) val fold_right_map : ('a -> 'c -> 'b * 'c) -> 'a array -> 'c -> 'b array * 'c (** Same, folding on the right *) val fold_left_map_i : (int -> 'a -> 'b -> 'a * 'c) -> 'a -> 'b array -> 'a * 'c array (** Same than [fold_left_map] but passing the index of the array *) val fold_left2_map : ('a -> 'b -> 'c -> 'a * 'd) -> 'a -> 'b array -> 'c array -> 'a * 'd array (** Same with two arrays, folding on the left; see also [Smart.fold_left2_map] *) val fold_left2_map_i : (int -> 'a -> 'b -> 'c -> 'a * 'd) -> 'a -> 'b array -> 'c array -> 'a * 'd array (** Same than [fold_left2_map] but passing the index of the array *) val fold_right2_map : ('a -> 'b -> 'c -> 'd * 'c) -> 'a array -> 'b array -> 'c -> 'd array * 'c (** Same with two arrays, folding on the right *) val distinct : 'a array -> bool (** Return [true] if every element of the array is unique (for default equality). *) val rev_of_list : 'a list -> 'a array (** [rev_of_list l] is equivalent to [Array.of_list (List.rev l)]. *) val rev_to_list : 'a array -> 'a list (** [rev_to_list a] is equivalent to [List.rev (List.of_array a)]. *) val filter_with : bool list -> 'a array -> 'a array (** [filter_with b a] selects elements of [a] whose corresponding element in [b] is [true]. Raise [Invalid_argument _] when sizes differ. *) module Smart : sig val map : ('a -> 'a) -> 'a array -> 'a array (** [Smart.map f a] behaves as [map f a] but returns [a] instead of a copy when [f x == x] for all [x] in [a]. *) val map_i : (int -> 'a -> 'a) -> 'a array -> 'a array val map2 : ('a -> 'b -> 'b) -> 'a array -> 'b array -> 'b array (** [Smart.map2 f a b] behaves as [map2 f a b] but returns [a] instead of a copy when [f x y == y] for all [x] in [a] and [y] in [b] pointwise. *) val fold_left_map : ('a -> 'b -> 'a * 'b) -> 'a -> 'b array -> 'a * 'b array (** [Smart.fold_left_mapf a b] behaves as [fold_left_map] but returns [b] as second component instead of a copy of [b] when the output array is pointwise the same as the input array [b] *) val fold_left2_map : ('a -> 'b -> 'c -> 'a * 'c) -> 'a -> 'b array -> 'c array -> 'a * 'c array (** [Smart.fold_left2_map f a b c] behaves as [fold_left2_map] but returns [c] as second component instead of a copy of [c] when the output array is pointwise the same as the input array [c] *) end (** The functions defined in this module are optimized specializations of the main ones, when the returned array is of same type as one of the original array. *) module Fun1 : sig val map : ('r -> 'a -> 'b) -> 'r -> 'a array -> 'b array (** [Fun1.map f x v = map (f x) v] *) val iter : ('r -> 'a -> unit) -> 'r -> 'a array -> unit (** [Fun1.iter f x v = iter (f x) v] *) val iter2 : ('r -> 'a -> 'b -> unit) -> 'r -> 'a array -> 'b array -> unit (** [Fun1.iter2 f x v1 v2 = iter (f x) v1 v2] *) module Smart : sig val map : ('r -> 'a -> 'a) -> 'r -> 'a array -> 'a array (** [Fun1.Smart.map f x v = Smart.map (f x) v] *) end end (** The functions defined in this module are the same as the main ones, except that they are all higher-order, and their function arguments have an additional parameter. This allows us to prevent closure creation in critical cases. *) end include ExtS coq-8.20.0/clib/cEphemeron.ml000066400000000000000000000067171466560755400157500ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* a | _ -> b *) if x.0 == constr_Y then a else b and the polymorphic comparison function works like: let equal = fun (c1, ...) (c2, ...) -> c1.id == c2.id In every new extension constructor, the name field is a constant string and the id field is filled with an unique[1] value returned by %caml_fresh_oo_id. Moreover, every value of an extensible variant type is allocated as a new block. [1]: On 64-bit systems. On 32-bit systems, calling %caml_fresh_oo_id 2**30 times will result in a wraparound. Note that this does not affect soundness because constructors are compared by physical equality during matching. See OCaml PR7809 for code demonstrating this. An extensible variant can be marshalled and unmarshalled, and is guaranteed to not be equal to itself after unmarshalling, since the id field is filled with another unique value. Note that the explanation above is purely informative and we do not depend on the exact representation of extensible variants, only on the fact that no two constructor representations ever alias. In particular, if the definition of constr is replaced with: type constr = int (where the value is truly unique for every created constructor), correctness is preserved. *) type 'a typ = .. (* Erases the contained type so that the key can be put in a hash table. *) type boxkey = Box : 'a typ -> boxkey [@@unboxed] (* Carry the type we just erased with the actual key. *) type 'a key = 'a typ * boxkey module EHashtbl = Ephemeron.K1.Make(struct type t = boxkey let equal = (==) let hash = Hashtbl.hash end) type value = { get : 'k. 'k typ -> 'k } [@@unboxed] let values : value EHashtbl.t = EHashtbl.create 1001 let create : type v. v -> v key = fun value -> let module M = struct type _ typ += Typ : v typ let get : type k. k typ -> k = fun typ -> match typ with | Typ -> value | _ -> assert false let boxkey = Box Typ let key = Typ, boxkey let value = { get } end in EHashtbl.add values M.boxkey M.value; M.key (* Avoid raising Not_found *) exception InvalidKey let get (typ, boxkey) = try (EHashtbl.find values boxkey).get typ with Not_found -> raise InvalidKey let default (typ, boxkey) default = try (EHashtbl.find values boxkey).get typ with Not_found -> default let clean () = EHashtbl.clean values coq-8.20.0/clib/cEphemeron.mli000066400000000000000000000046111466560755400161100ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* 'a key exception InvalidKey val get : 'a key -> 'a (** May raise InvalidKey *) val default : 'a key -> 'a -> 'a (** Never fails. *) val clean : unit -> unit coq-8.20.0/clib/cList.ml000066400000000000000000000624641466560755400147420ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* int type 'a eq = 'a -> 'a -> bool include List (** Tail-rec implementation of usual functions. This is a well-known trick used in, for instance, ExtLib and Batteries. *) type 'a cell = { head : 'a; mutable tail : 'a list; } external cast : 'a cell -> 'a list = "%identity" (** Extensions and redefinitions of OCaml Stdlib *) (** {6 Equality, testing} *) let rec same_length l1 l2 = match l1, l2 with | [], [] -> true | _ :: l1, _ :: l2 -> same_length l1 l2 | ([], _ :: _) | (_ :: _, []) -> false let rec compare cmp l1 l2 = if l1 == l2 then 0 else match l1,l2 with | [], [] -> 0 | _::_, [] -> 1 | [], _::_ -> -1 | x1::l1, x2::l2 -> match cmp x1 x2 with | 0 -> compare cmp l1 l2 | c -> c let rec equal cmp l1 l2 = l1 == l2 || match l1, l2 with | [], [] -> true | x1 :: l1, x2 :: l2 -> cmp x1 x2 && equal cmp l1 l2 | _ -> false let is_empty = function | [] -> true | _ -> false let mem_f cmp x l = List.exists (cmp x) l let for_all_i p = let rec for_all_p i = function | [] -> true | a::l -> p i a && for_all_p (i+1) l in for_all_p let for_all2eq f l1 l2 = try List.for_all2 f l1 l2 with Invalid_argument _ -> false let exists_i p = let rec exists_p i = function | [] -> false | a::l -> p i a || exists_p (i+1) l in exists_p let prefix_of cmp prefl l = let rec prefrec = function | (h1::t1, h2::t2) -> cmp h1 h2 && prefrec (t1,t2) | ([], _) -> true | _ -> false in prefrec (prefl,l) (** {6 Creating lists} *) let interval n m = let rec interval_n (l,m) = if n > m then l else interval_n (m::l, pred m) in interval_n ([], m) let addn n v = let rec aux n l = if Int.equal n 0 then l else aux (pred n) (v :: l) in if n < 0 then invalid_arg "List.addn" else aux n let make n v = addn n v [] let rec init_loop len f p i = if Int.equal i len then () else let c = { head = f i; tail = [] } in p.tail <- cast c; init_loop len f c (succ i) let init len f = if len < 0 then invalid_arg "List.init" else if Int.equal len 0 then [] else let c = { head = f 0; tail = [] } in init_loop len f c 1; cast c let rec append_loop p tl = function | [] -> p.tail <- tl | x :: l -> let c = { head = x; tail = [] } in p.tail <- cast c; append_loop c tl l let append l1 l2 = match l1 with | [] -> l2 | x :: l -> let c = { head = x; tail = [] } in append_loop c l2 l; cast c let rec copy p = function | [] -> p | x :: l -> let c = { head = x; tail = [] } in p.tail <- cast c; copy c l let rec concat_loop p = function | [] -> () | x :: l -> concat_loop (copy p x) l let concat l = let dummy = { head = Obj.magic 0; tail = [] } in concat_loop dummy l; dummy.tail let flatten = concat (** {6 Lists as arrays} *) let assign l n e = let rec assrec stk l i = match l, i with | (h :: t, 0) -> List.rev_append stk (e :: t) | (h :: t, n) -> assrec (h :: stk) t (pred n) | ([], _) -> failwith "List.assign" in assrec [] l n (** {6 Filtering} *) (* [filter_loop f (Some (c0,l0)) c l] will do c0.tail <- l0 if [for_all f l] *) let rec filter_loop f reset p = function | [] -> begin match reset with | None -> () | Some (c,orig) -> c.tail <- orig end | x :: l as orig -> if f x then let c = { head = x; tail = [] } in let () = p.tail <- cast c in let reset = match reset with | Some _ -> reset | None -> Some (p,orig) in filter_loop f reset c l else filter_loop f None p l let rec filter f = function | [] -> [] | x :: l' as orig -> if f x then let c = { head = x; tail = [] } in filter_loop f None c l'; if c.tail == l' then orig else cast c else filter f l' let rec filter2_loop f p q l1 l2 = match l1, l2 with | [], [] -> () | x :: l1', y :: l2' -> let b = f x y in filter2_loop f p q l1' l2'; if b then if p.tail == l1' then begin p.tail <- l1; q.tail <- l2 end else begin p.tail <- x :: p.tail; q.tail <- y :: q.tail end | _ -> invalid_arg "List.filter2" let rec filter2 f l1 l2 = match l1, l2 with | [], [] -> ([],[]) | x1 :: l1', x2 :: l2' -> let b = f x1 x2 in if b then let c1 = { head = x1; tail = [] } in let c2 = { head = x2; tail = [] } in filter2_loop f c1 c2 l1' l2'; if c1.tail == l1' then (l1, l2) else (cast c1, cast c2) else filter2 f l1' l2' | _ -> invalid_arg "List.filter2" let filteri p = let rec filter_i_rec i = function | [] -> [] | x :: l -> let l' = filter_i_rec (succ i) l in if p i x then x :: l' else l' in filter_i_rec 0 let rec filter_with_loop filter p l = match filter, l with | [], [] -> () | b :: filter, x :: l' -> filter_with_loop filter p l'; if b then if p.tail == l' then p.tail <- l else p.tail <- x :: p.tail | _ -> invalid_arg "List.filter_with" let rec filter_with filter l = match filter, l with | [], [] -> [] | b :: filter, x :: l' -> if b then let c = { head = x; tail = [] } in filter_with_loop filter c l'; if c.tail == l' then l else cast c else filter_with filter l' | _ -> invalid_arg "List.filter_with" let rec map_filter_loop f p = function | [] -> () | x :: l -> match f x with | None -> map_filter_loop f p l | Some y -> let c = { head = y; tail = [] } in p.tail <- cast c; map_filter_loop f c l let rec map_filter f = function | [] -> [] | x :: l' -> match f x with | None -> map_filter f l' | Some y -> let c = { head = y; tail = [] } in map_filter_loop f c l'; cast c let rec map_filter_i_loop f i p = function | [] -> () | x :: l -> match f i x with | None -> map_filter_i_loop f (succ i) p l | Some y -> let c = { head = y; tail = [] } in p.tail <- cast c; map_filter_i_loop f (succ i) c l let rec map_filter_i_loop' f i = function | [] -> [] | x :: l' -> match f i x with | None -> map_filter_i_loop' f (succ i) l' | Some y -> let c = { head = y; tail = [] } in map_filter_i_loop f (succ i) c l'; cast c let map_filter_i f l = map_filter_i_loop' f 0 l let partitioni p = let rec aux i = function | [] -> [], [] | x :: l -> let (l1, l2) = aux (succ i) l in if p i x then (x :: l1, l2) else (l1, x :: l2) in aux 0 (** {6 Applying functorially} *) let rec map_loop f p = function | [] -> () | x :: l -> let c = { head = f x; tail = [] } in p.tail <- cast c; map_loop f c l let map f = function | [] -> [] | x :: l -> let c = { head = f x; tail = [] } in map_loop f c l; cast c let rec map2_loop f p l1 l2 = match l1, l2 with | [], [] -> () | x :: l1, y :: l2 -> let c = { head = f x y; tail = [] } in p.tail <- cast c; map2_loop f c l1 l2 | _ -> invalid_arg "List.map2" let map2 f l1 l2 = match l1, l2 with | [], [] -> [] | x :: l1, y :: l2 -> let c = { head = f x y; tail = [] } in map2_loop f c l1 l2; cast c | _ -> invalid_arg "List.map2" (* remove when requiring OCaml >= 5.1.0 *) let rec concat_map_loop f p = function | [] -> () | x :: l -> concat_map_loop f (copy p (f x)) l (* remove when requiring OCaml >= 5.1.0 *) let concat_map f l = let dummy = { head = Obj.magic 0; tail = [] } in concat_map_loop f dummy l; dummy.tail (** Like OCaml [List.mapi] but tail-recursive *) let rec map_i_loop f i p = function | [] -> () | x :: l -> let c = { head = f i x; tail = [] } in p.tail <- cast c; map_i_loop f (succ i) c l let map_i f i = function | [] -> [] | x :: l -> let c = { head = f i x; tail = [] } in map_i_loop f (succ i) c l; cast c let map_left = map let map2_i f i l1 l2 = let rec map_i i = function | ([], []) -> [] | (h1 :: t1, h2 :: t2) -> let v = f i h1 h2 in v :: map_i (succ i) (t1,t2) | (_, _) -> invalid_arg "map2_i" in map_i i (l1,l2) let rec map3_loop f p l1 l2 l3 = match l1, l2, l3 with | [], [], [] -> () | x :: l1, y :: l2, z :: l3 -> let c = { head = f x y z; tail = [] } in p.tail <- cast c; map3_loop f c l1 l2 l3 | _ -> invalid_arg "List.map3" let map3 f l1 l2 l3 = match l1, l2, l3 with | [], [], [] -> [] | x :: l1, y :: l2, z :: l3 -> let c = { head = f x y z; tail = [] } in map3_loop f c l1 l2 l3; cast c | _ -> invalid_arg "List.map3" let rec map4_loop f p l1 l2 l3 l4 = match l1, l2, l3, l4 with | [], [], [], [] -> () | x :: l1, y :: l2, z :: l3, t :: l4 -> let c = { head = f x y z t; tail = [] } in p.tail <- cast c; map4_loop f c l1 l2 l3 l4 | _ -> invalid_arg "List.map4" let map4 f l1 l2 l3 l4 = match l1, l2, l3, l4 with | [], [], [], [] -> [] | x :: l1, y :: l2, z :: l3, t :: l4 -> let c = { head = f x y z t; tail = [] } in map4_loop f c l1 l2 l3 l4; cast c | _ -> invalid_arg "List.map4" let rec map_until_loop f p = function | [] -> [] | x :: l as l' -> match f x with | None -> l' | Some fx -> let c = { head = fx; tail = [] } in p.tail <- cast c; map_until_loop f c l let map_until f = function | [] -> [], [] | x :: l as l' -> match f x with | None -> [], l' | Some fx -> let c = { head = fx; tail = [] } in let l = map_until_loop f c l in cast c, l let rec map_of_array_loop f p a i l = if Int.equal i l then () else let c = { head = f (Array.unsafe_get a i); tail = [] } in p.tail <- cast c; map_of_array_loop f c a (i + 1) l let map_of_array f a = let l = Array.length a in if Int.equal l 0 then [] else let c = { head = f (Array.unsafe_get a 0); tail = [] } in map_of_array_loop f c a 1 l; cast c let map_append f l = flatten (map f l) let map_append2 f l1 l2 = flatten (map2 f l1 l2) let rec extend l a l' = match l,l' with | true :: l, b :: l' -> b :: extend l a l' | false :: l, l' -> a :: extend l a l' | [], [] -> [] | _ -> invalid_arg "extend" let count f l = let rec aux acc = function | [] -> acc | h :: t -> if f h then aux (acc + 1) t else aux acc t in aux 0 l (** {6 Finding position} *) let rec index_f f x l n = match l with | [] -> raise Not_found | y :: l -> if f x y then n else index_f f x l (succ n) let index f x l = index_f f x l 1 let index_opt f x l = try Some (index f x l) with Not_found -> None let index0 f x l = index_f f x l 0 (** {6 Folding} *) let fold_left_until f accu s = let rec aux accu = function | [] -> accu | x :: xs -> match f accu x with CSig.Stop x -> x | CSig.Cont i -> aux i xs in aux accu s let fold_right_i f i l = let rec it_f i l a = match l with | [] -> a | b :: l -> f (i-1) b (it_f (i-1) l a) in it_f (List.length l + i) l let fold_left_i f = let rec it_list_f i a = function | [] -> a | b :: l -> it_list_f (i+1) (f i a b) l in it_list_f let rec fold_left3 f accu l1 l2 l3 = match (l1, l2, l3) with | ([], [], []) -> accu | (a1 :: l1, a2 :: l2, a3 :: l3) -> fold_left3 f (f accu a1 a2 a3) l1 l2 l3 | (_, _, _) -> invalid_arg "List.fold_left3" let rec fold_left4 f accu l1 l2 l3 l4 = match (l1, l2, l3, l4) with | ([], [], [], []) -> accu | (a1 :: l1, a2 :: l2, a3 :: l3, a4 :: l4) -> fold_left4 f (f accu a1 a2 a3 a4) l1 l2 l3 l4 | (_, _, _, _) -> invalid_arg "List.fold_left4" let rec fold_left5 f accu l1 l2 l3 l4 l5 = match (l1, l2, l3, l4, l5) with | ([], [], [], [], []) -> accu | (a1 :: l1, a2 :: l2, a3 :: l3, a4 :: l4, a5 :: l5) -> fold_left5 f (f accu a1 a2 a3 a4 a5) l1 l2 l3 l4 l5 | (_, _, _, _, _) -> invalid_arg "List.fold_left5" (* [fold_right_and_left f [a1;...;an] hd = f (f (... (f (f hd an [an-1;...;a1]) an-1 [an-2;...;a1]) ...) a2 [a1]) a1 []] *) let fold_right_and_left f l hd = let rec aux tl = function | [] -> hd | a :: l -> let hd = aux (a :: tl) l in f hd a tl in aux [] l (* Match sets as lists according to a matching function, also folding a side effect *) let rec fold_left2_set e f x l1 l2 = match l1 with | a1 :: l1 -> let rec find seen = function | [] -> raise e | a2 :: l2 -> try fold_left2_set e f (f x a1 a2 l1 l2) l1 (List.rev_append seen l2) with e' when e' = e -> find (a2 :: seen) l2 in find [] l2 | [] -> if l2 = [] then x else raise e (* Poor man's monadic map *) let rec fold_left_map f e = function | [] -> (e,[]) | h :: t -> let e',h' = f e h in let e'',t' = fold_left_map f e' t in e'',h' :: t' (* (* tail-recursive version of the above function *) let fold_left_map f e l = let g (e,b') h = let (e',h') = f e h in (e',h'::b') in let (e',lrev) = List.fold_left g (e,[]) l in (e',List.rev lrev) *) (* The same, based on fold_right, with the effect accumulated on the right *) let fold_right_map f l e = List.fold_right (fun x (l,e) -> let (y,e) = f x e in (y::l,e)) l ([],e) let on_snd f (x,y) = (x,f y) let fold_left2_map f e l l' = on_snd List.rev @@ List.fold_left2 (fun (e,l) x x' -> let (e,y) = f e x x' in (e, y::l) ) (e, []) l l' let fold_right2_map f l l' e = List.fold_right2 (fun x x' (l,e) -> let (y,e) = f x x' e in (y::l,e)) l l' ([],e) let fold_left3_map f e l l' l'' = on_snd List.rev @@ fold_left3 (fun (e,l) x x' x'' -> let (e,y) = f e x x' x'' in (e,y::l)) (e,[]) l l' l'' let fold_left4_map f e l1 l2 l3 l4 = on_snd List.rev @@ fold_left4 (fun (e,l) x1 x2 x3 x4 -> let (e,y) = f e x1 x2 x3 x4 in (e,y::l)) (e,[]) l1 l2 l3 l4 let fold_left5_map f e l1 l2 l3 l4 l5 = on_snd List.rev @@ fold_left5 (fun (e,l) x1 x2 x3 x4 x5 -> let (e,y) = f e x1 x2 x3 x4 x5 in (e,y::l)) (e,[]) l1 l2 l3 l4 l5 (** {6 Splitting} *) let remove cmp x l = List.filter (fun y -> not (cmp x y)) l let rec remove_first p = function | b :: l when p b -> l | b :: l -> b :: remove_first p l | [] -> raise Not_found let extract_first p li = let rec loop rev_left = function | [] -> raise Not_found | x :: right -> if p x then List.rev_append rev_left right, x else loop (x :: rev_left) right in loop [] li let insert p v l = let rec insrec = function | [] -> [v] | h :: tl -> if p v h then v :: h :: tl else h :: insrec tl in insrec l let rec find_map f = function | [] -> None | x :: l -> match f x with | None -> find_map f l | Some _ as y -> y let find_map_exn f l = match find_map f l with | Some v -> v | None -> raise Not_found (* FIXME: again, generic hash function *) let subset l1 l2 = let t2 = Hashtbl.create 151 in List.iter (fun x -> Hashtbl.add t2 x ()) l2; let rec look = function | [] -> true | x :: ll -> try Hashtbl.find t2 x; look ll with Not_found -> false in look l1 (** [goto i l] splits [l] into two lists [(l1,l2)] such that [(List.rev l1)++l2=l] and [l1] has length [i]. It raises [IndexOutOfRange] when [i] is negative or greater than the length of [l]. *) exception IndexOutOfRange let goto n l = let rec goto i acc = function | tl when Int.equal i 0 -> (acc, tl) | h :: t -> goto (pred i) (h :: acc) t | [] -> raise IndexOutOfRange in goto n [] l (* [chop i l] splits [l] into two lists [(l1,l2)] such that [l1++l2=l] and [l1] has length [i]. It raises [Failure] when [i] is negative or greater than the length of [l] *) let chop n l = try let (h,t) = goto n l in (List.rev h,t) with IndexOutOfRange -> failwith "List.chop" (* spiwack: should raise [IndexOutOfRange] but I'm afraid of missing a try/with when replacing the exception. *) (* [split_when p l] splits [l] into two lists [(l1,a::l2)] such that [l1++(a::l2)=l], [p a=true] and [p b = false] for every element [b] of [l1]. If there is no such [a], then it returns [(l,[])] instead *) let split_when p = let rec split_when_loop x y = match y with | [] -> (List.rev x,[]) | (a :: l) -> if (p a) then (List.rev x,y) else split_when_loop (a :: x) l in split_when_loop [] let firstn n ol = let rec aux acc n l = match n, l with | 0, [] -> ol | 0, _ :: _ -> List.rev acc | n, h :: t -> aux (h :: acc) (pred n) t | _ -> failwith "firstn" in aux [] n ol let sep_first = function | [] -> failwith "sep_first" | hd :: tl -> (hd, tl) let rec sep_last = function | [] -> failwith "sep_last" | hd :: [] -> (hd,[]) | hd :: tl -> let (l,tl) = sep_last tl in (l,hd :: tl) (* Drop the last element of a list *) let rec drop_last = function | [] -> failwith "drop_last" | hd :: [] -> [] | hd :: tl -> hd :: drop_last tl let rec last = function | [] -> failwith "List.last" | hd :: [] -> hd | _ :: tl -> last tl let lastn n l = let len = List.length l in let rec aux m l = if Int.equal m n then l else aux (m - 1) (List.tl l) in if len < n then failwith "lastn" else aux len l let rec skipn n l = match n,l with | 0, _ -> l | _, [] -> failwith "List.skipn" | n, _ :: l -> skipn (pred n) l let skipn_at_best n l = try skipn n l with Failure _ when n >= 0 -> [] (** if [l=p++t] then [drop_prefix p l] is [t] else [l] *) let drop_prefix cmp p l = let rec drop_prefix_rec = function | (h1 :: tp, h2 :: tl) when cmp h1 h2 -> drop_prefix_rec (tp,tl) | ([], tl) -> tl | _ -> l in drop_prefix_rec (p,l) let share_tails eq l1 l2 = let rec shr_rev acc = function | (x1 :: l1, x2 :: l2) when eq x1 x2 -> shr_rev (x1 :: acc) (l1,l2) | (l1, l2) -> (List.rev l1, List.rev l2, acc) in shr_rev [] (List.rev l1, List.rev l2) (** {6 Association lists} *) let map_assoc f = map (fun (x,a) -> (x,f a)) let rec assoc_f f a = function | (x, e) :: xs -> if f a x then e else assoc_f f a xs | [] -> raise Not_found let rec assoc_f_opt f a = function | (x, e) :: xs -> if f a x then Some e else assoc_f_opt f a xs | [] -> None let remove_assoc_f f a l = try remove_first (fun (x,_) -> f a x) l with Not_found -> l let mem_assoc_f f a l = List.exists (fun (x,_) -> f a x) l (** {6 Operations on lists of tuples} *) let rec split_loop p q = function | [] -> () | (x, y) :: l -> let cl = { head = x; tail = [] } in let cr = { head = y; tail = [] } in p.tail <- cast cl; q.tail <- cast cr; split_loop cl cr l let split = function | [] -> [], [] | (x, y) :: l -> let cl = { head = x; tail = [] } in let cr = { head = y; tail = [] } in split_loop cl cr l; (cast cl, cast cr) let rec combine_loop p l1 l2 = match l1, l2 with | [], [] -> () | x :: l1, y :: l2 -> let c = { head = (x, y); tail = [] } in p.tail <- cast c; combine_loop c l1 l2 | _ -> invalid_arg "List.combine" let combine l1 l2 = match l1, l2 with | [], [] -> [] | x :: l1, y :: l2 -> let c = { head = (x, y); tail = [] } in combine_loop c l1 l2; cast c | _ -> invalid_arg "List.combine" let rec split3_loop p q r = function | [] -> () | (x, y, z) :: l -> let cp = { head = x; tail = [] } in let cq = { head = y; tail = [] } in let cr = { head = z; tail = [] } in p.tail <- cast cp; q.tail <- cast cq; r.tail <- cast cr; split3_loop cp cq cr l let split3 = function | [] -> [], [], [] | (x, y, z) :: l -> let cp = { head = x; tail = [] } in let cq = { head = y; tail = [] } in let cr = { head = z; tail = [] } in split3_loop cp cq cr l; (cast cp, cast cq, cast cr) (** XXX TODO tailrec *) let rec split4 = function | [] -> ([], [], [], []) | (a,b,c,d)::l -> let (ra, rb, rc, rd) = split4 l in (a::ra, b::rb, c::rc, d::rd) let rec combine3_loop p l1 l2 l3 = match l1, l2, l3 with | [], [], [] -> () | x :: l1, y :: l2, z :: l3 -> let c = { head = (x, y, z); tail = [] } in p.tail <- cast c; combine3_loop c l1 l2 l3 | _ -> invalid_arg "List.combine3" let combine3 l1 l2 l3 = match l1, l2, l3 with | [], [], [] -> [] | x :: l1, y :: l2, z :: l3 -> let c = { head = (x, y, z); tail = [] } in combine3_loop c l1 l2 l3; cast c | _ -> invalid_arg "List.combine3" (** {6 Operations on lists seen as sets, preserving uniqueness of elements} *) (** Add an element, preserving uniqueness of elements *) let add_set cmp x l = if mem_f cmp x l then l else x :: l (** List equality up to permutation (but considering multiple occurrences) *) let eq_set cmp l1 l2 = let rec aux l1 = function | [] -> is_empty l1 | a :: l2 -> aux (remove_first (cmp a) l1) l2 in try aux l1 l2 with Not_found -> false let rec merge_set cmp l1 l2 = match l1, l2 with | [], l2 -> l2 | l1, [] -> l1 | h1 :: t1, h2 :: t2 -> let c = cmp h1 h2 in if Int.equal c 0 then h1 :: merge_set cmp t1 t2 else if c <= 0 then h1 :: merge_set cmp t1 l2 else h2 :: merge_set cmp l1 t2 let intersect cmp l1 l2 = filter (fun x -> mem_f cmp x l2) l1 let union cmp l1 l2 = let rec urec = function | [] -> l2 | a :: l -> if mem_f cmp a l2 then urec l else a :: urec l in urec l1 let subtract cmp l1 l2 = if is_empty l2 then l1 else List.filter (fun x -> not (mem_f cmp x l2)) l1 let unionq l1 l2 = union (==) l1 l2 let subtractq l1 l2 = subtract (==) l1 l2 (** {6 Uniqueness and duplication} *) (* FIXME: we should avoid relying on the generic hash function, just as we'd better avoid Pervasives.compare *) let distinct l = let visited = Hashtbl.create 23 in let rec loop = function | h :: t -> if Hashtbl.mem visited h then false else begin Hashtbl.add visited h h; loop t end | [] -> true in loop l let distinct_f cmp l = let rec loop = function | a :: b :: _ when Int.equal (cmp a b) 0 -> false | a :: l -> loop l | [] -> true in loop (List.sort cmp l) (* FIXME: again, generic hash function *) let uniquize_key f l = let visited = Hashtbl.create 23 in let rec aux acc changed = function | h :: t -> let x = f h in if Hashtbl.mem visited x then aux acc true t else begin Hashtbl.add visited x x; aux (h :: acc) changed t end | [] -> if changed then List.rev acc else l in aux [] false l let uniquize l = uniquize_key (fun x -> x) l (** [sort_uniquize] might be an alternative to the hashtbl-based [uniquize], when the order of the elements is irrelevant *) let rec uniquize_sorted cmp = function | a :: b :: l when Int.equal (cmp a b) 0 -> uniquize_sorted cmp (a :: l) | a :: l -> a :: uniquize_sorted cmp l | [] -> [] let sort_uniquize cmp l = uniquize_sorted cmp (List.sort cmp l) let min cmp l = let rec aux cur = function | [] -> cur | x :: l -> if cmp x cur < 0 then aux x l else aux cur l in match l with | x :: l -> aux x l | [] -> raise Not_found let rec duplicates cmp = function | [] -> [] | x :: l -> let l' = duplicates cmp l in if mem_f cmp x l then add_set cmp x l' else l' (** {6 Cartesian product} *) (* A generic cartesian product: for any operator (**), [cartesian (**) [x1;x2] [y1;y2] = [x1**y1; x1**y2; x2**y1; x2**y1]], and so on if there are more elements in the lists. *) let cartesian op l1 l2 = map_append (fun x -> map (op x) l2) l1 (* [cartesians] is an n-ary cartesian product: it iterates [cartesian] over a list of lists. *) let cartesians op init ll = List.fold_right (cartesian op) ll [init] (* combinations [[a;b];[c;d]] gives [[a;c];[a;d];[b;c];[b;d]] *) let combinations l = cartesians (fun x l -> x :: l) [] l (* Keep only those products that do not return None *) let cartesian_filter op l1 l2 = map_append (fun x -> map_filter (op x) l2) l1 (* Keep only those products that do not return None *) let cartesians_filter op init ll = List.fold_right (cartesian_filter op) ll [init] (* Factorize lists of pairs according to the left argument *) let rec factorize_left cmp = function | (a,b) :: l -> let al,l' = partition (fun (a',_) -> cmp a a') l in (a,(b :: map snd al)) :: factorize_left cmp l' | [] -> [] module Smart = struct let rec map f l = match l with | [] -> l | h :: tl -> let h' = f h in let tl' = map f tl in if h' == h && tl' == tl then l else h' :: tl' let rec fold_left_map f e l = match l with | [] -> e, [] | h :: tl -> let e', h' = f e h in let e'', tl' = fold_left_map f e' tl in e'', (if h' == h && tl' == tl then l else h' :: tl') let rec fold_right_map f l e = match l with | [] -> [], e | h :: tl -> let tl', e' = fold_right_map f tl e in let h', e'' = f h e' in (if h' == h && tl' == tl then l else h' :: tl'), e'' end module type MonoS = sig type elt val equal : elt list -> elt list -> bool val mem : elt -> elt list -> bool val assoc : elt -> (elt * 'a) list -> 'a val mem_assoc : elt -> (elt * 'a) list -> bool val remove_assoc : elt -> (elt * 'a) list -> (elt * 'a) list val mem_assoc_sym : elt -> ('a * elt) list -> bool end coq-8.20.0/clib/cList.mli000066400000000000000000000436531466560755400151120ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* int type 'a eq = 'a -> 'a -> bool include module type of List (** {6 Equality, testing} *) val compare : 'a cmp -> 'a list cmp (** Lexicographic order on lists. *) val equal : 'a eq -> 'a list eq (** Lift equality to list type. *) val is_empty : 'a list -> bool (** Check whether a list is empty *) val mem_f : 'a eq -> 'a -> 'a list -> bool (** Same as [List.mem], for some specific equality *) val for_all_i : (int -> 'a -> bool) -> int -> 'a list -> bool (** Same as [List.for_all] but with an index *) val for_all2eq : ('a -> 'b -> bool) -> 'a list -> 'b list -> bool (** Same as [List.for_all2] but returning [false] when of different length *) val exists_i : (int -> 'a -> bool) -> int -> 'a list -> bool (** Same as [List.exists] but with an index *) val prefix_of : 'a eq -> 'a list eq (** [prefix_of eq l1 l2] returns [true] if [l1] is a prefix of [l2], [false] otherwise. It uses [eq] to compare elements *) val same_length : 'a list -> 'b list -> bool (** A more efficient variant of [for_all2eq (fun _ _ -> true)] *) (** {6 Creating lists} *) val interval : int -> int -> int list (** [interval i j] creates the list [[i; i + 1; ...; j]], or [[]] when [j < i]. *) val make : int -> 'a -> 'a list (** [make n x] returns a list made of [n] times [x]. Raise [Invalid_argument _] if [n] is negative. *) val addn : int -> 'a -> 'a list -> 'a list (** [addn n x l] adds [n] times [x] on the left of [l]. *) val init : int -> (int -> 'a) -> 'a list (** [init n f] constructs the list [f 0; ... ; f (n - 1)]. Raise [Invalid_argument _] if [n] is negative *) val append : 'a list -> 'a list -> 'a list (** Like OCaml's [List.append] but tail-recursive. *) val concat : 'a list list -> 'a list (** Like OCaml's [List.concat] but tail-recursive. *) val flatten : 'a list list -> 'a list (** Synonymous of [concat] *) (** {6 Lists as arrays} *) val assign : 'a list -> int -> 'a -> 'a list (** [assign l i x] sets the [i]-th element of [l] to [x], starting from [0]. Raise [Failure _] if [i] is out of range. *) (** {6 Filtering} *) val filter : ('a -> bool) -> 'a list -> 'a list (** Like OCaml [List.filter] but tail-recursive and physically returns the original list if the predicate holds for all elements. *) val filter2 : ('a -> 'b -> bool) -> 'a list -> 'b list -> 'a list * 'b list (** Like [List.filter] but with 2 arguments, raise [Invalid_argument _] if the lists are not of same length. *) val filteri : (int -> 'a -> bool) -> 'a list -> 'a list (** Like [List.filter] but with an index starting from [0] *) val filter_with : bool list -> 'a list -> 'a list (** [filter_with bl l] selects elements of [l] whose corresponding element in [bl] is [true]. Raise [Invalid_argument _] if sizes differ. *) val map_filter : ('a -> 'b option) -> 'a list -> 'b list (** Like [map] but keeping only non-[None] elements *) val map_filter_i : (int -> 'a -> 'b option) -> 'a list -> 'b list (** Like [map_filter] but with an index starting from [0] *) val partitioni : (int -> 'a -> bool) -> 'a list -> 'a list * 'a list (** Like [List.partition] but with an index starting from [0] *) (** {6 Applying functorially} *) val map : ('a -> 'b) -> 'a list -> 'b list (** Like OCaml [List.map] but tail-recursive *) val map2 : ('a -> 'b -> 'c) -> 'a list -> 'b list -> 'c list (** Like OCaml [List.map2] but tail-recursive *) val map_left : ('a -> 'b) -> 'a list -> 'b list (** As [map] but ensures the left-to-right order of evaluation. *) val concat_map : ('a -> 'b list) -> 'a list -> 'b list (** Like OCaml [List.concat_map] but tail-recursive. Alternatively, the composition of [concat] and [map] *) val map_i : (int -> 'a -> 'b) -> int -> 'a list -> 'b list (** Like OCaml [List.mapi] but tail-recursive. Alternatively, like [map] but with an index *) val map2_i : (int -> 'a -> 'b -> 'c) -> int -> 'a list -> 'b list -> 'c list (** Like [map2] but with an index *) val map3 : ('a -> 'b -> 'c -> 'd) -> 'a list -> 'b list -> 'c list -> 'd list (** Like [map] but for 3 lists. *) val map4 : ('a -> 'b -> 'c -> 'd -> 'e) -> 'a list -> 'b list -> 'c list -> 'd list -> 'e list (** Like [map] but for 4 lists. *) val map_until : ('a -> 'b option) -> 'a list -> 'b list * 'a list (** [map_until f l] applies f to the elements of l until one returns None, then returns the list of elements where f was applied and the tail where f was not applied *) val map_of_array : ('a -> 'b) -> 'a array -> 'b list (** [map_of_array f a] behaves as [List.map f (Array.to_list a)] *) val map_append : ('a -> 'b list) -> 'a list -> 'b list (** [map_append f [x1; ...; xn]] returns [f x1 @ ... @ f xn]. *) val map_append2 : ('a -> 'b -> 'c list) -> 'a list -> 'b list -> 'c list (** Like [map_append] but for two lists; raises [Invalid_argument _] if the two lists do not have the same length. *) val extend : bool list -> 'a -> 'a list -> 'a list (** [extend l a [a1..an]] assumes that the number of [true] in [l] is [n]; it extends [a1..an] by inserting [a] at the position of [false] in [l] *) val count : ('a -> bool) -> 'a list -> int (** Count the number of elements satisfying a predicate *) (** {6 Finding position} *) val index : 'a eq -> 'a -> 'a list -> int (** [index] returns the 1st index of an element in a list (counting from 1). *) val index_opt : 'a eq -> 'a -> 'a list -> int option (** [index_opt] returns the 1st index of an element in a list (counting from 1) and None otherwise. *) val index0 : 'a eq -> 'a -> 'a list -> int (** [index0] behaves as [index] except that it starts counting at 0. *) (** {6 Folding} *) val fold_left_until : ('c -> 'a -> 'c CSig.until) -> 'c -> 'a list -> 'c (** acts like [fold_left f acc s] while [f] returns [Cont acc']; it stops returning [c] as soon as [f] returns [Stop c]. *) val fold_right_i : (int -> 'a -> 'b -> 'b) -> int -> 'a list -> 'b -> 'b (** Like [List.fold_right] but with an index *) val fold_left_i : (int -> 'a -> 'b -> 'a) -> int -> 'a -> 'b list -> 'a (** Like [List.fold_left] but with an index *) val fold_right_and_left : ('b -> 'a -> 'a list -> 'b) -> 'a list -> 'b -> 'b (** [fold_right_and_left f [a1;...;an] hd] is [f (f (... (f (f hd an [an-1;...;a1]) an-1 [an-2;...;a1]) ...) a2 [a1]) a1 []] *) val fold_left3 : ('a -> 'b -> 'c -> 'd -> 'a) -> 'a -> 'b list -> 'c list -> 'd list -> 'a (** Like [List.fold_left] but for 3 lists; raise [Invalid_argument _] if not all lists of the same size *) val fold_left4 : ('a -> 'b -> 'c -> 'd -> 'e -> 'a) -> 'a -> 'b list -> 'c list -> 'd list -> 'e list -> 'a (** Like [List.fold_left] but for 4 lists; raise [Invalid_argument _] if not all lists of the same size *) val fold_left2_set : exn -> ('a -> 'b -> 'c -> 'b list -> 'c list -> 'a) -> 'a -> 'b list -> 'c list -> 'a (** Fold sets, i.e. lists up to order; the folding function tells when elements match by returning a value and raising the given exception otherwise; sets should have the same size; raise the given exception if no pairing of the two sets is found;; complexity in O(n^2) *) val fold_left_map : ('a -> 'b -> 'a * 'c) -> 'a -> 'b list -> 'a * 'c list (** [fold_left_map f e_0 [a1;...;an]] is [e_n,[k_1...k_n]] where [(e_i,k_i)] is [f e_{i-1} ai] for each i<=n *) val fold_right_map : ('b -> 'a -> 'c * 'a) -> 'b list -> 'a -> 'c list * 'a (** Same, folding on the right *) val fold_left2_map : ('a -> 'b -> 'c -> 'a * 'd) -> 'a -> 'b list -> 'c list -> 'a * 'd list (** Same with two lists, folding on the left *) val fold_right2_map : ('b -> 'c -> 'a -> 'd * 'a) -> 'b list -> 'c list -> 'a -> 'd list * 'a (** Same with two lists, folding on the right *) val fold_left3_map : ('a -> 'b -> 'c -> 'd -> 'a * 'e) -> 'a -> 'b list -> 'c list -> 'd list -> 'a * 'e list (** Same with three lists, folding on the left *) val fold_left4_map : ('a -> 'b -> 'c -> 'd -> 'e -> 'a * 'r) -> 'a -> 'b list -> 'c list -> 'd list -> 'e list -> 'a * 'r list (** Same with four lists, folding on the left *) val fold_left5_map : ('a -> 'b -> 'c -> 'd -> 'e -> 'f -> 'a * 'r) -> 'a -> 'b list -> 'c list -> 'd list -> 'e list -> 'f list -> 'a * 'r list (** Same with five lists, folding on the left *) (** {6 Splitting} *) val remove : 'a eq -> 'a -> 'a list -> 'a list (** [remove eq a l] Remove all occurrences of [a] in [l] *) val remove_first : ('a -> bool) -> 'a list -> 'a list (** Remove the first element satisfying a predicate, or raise [Not_found] *) val extract_first : ('a -> bool) -> 'a list -> 'a list * 'a (** Remove and return the first element satisfying a predicate, or raise [Not_found] *) val find_map : ('a -> 'b option) -> 'a list -> 'b option (** [find_map f l] applies [f] to the elements of [l] in order, and returns the first result of the form [Some v], or [None] if none exist. In stdlib since OCaml 4.10.0 *) val find_map_exn : ('a -> 'b option) -> 'a list -> 'b (** Like [find_map] but raises [Not_found] instead of returning [None]. *) exception IndexOutOfRange val goto: int -> 'a list -> 'a list * 'a list (** [goto i l] splits [l] into two lists [(l1,l2)] such that [(List.rev l1)++l2=l] and [l1] has length [i]. It raises [IndexOutOfRange] when [i] is negative or greater than the length of [l]. *) val split_when : ('a -> bool) -> 'a list -> 'a list * 'a list (** [split_when p l] splits [l] into two lists [(l1,a::l2)] such that [l1++(a::l2)=l], [p a=true] and [p b = false] for every element [b] of [l1]. if there is no such [a], then it returns [(l,[])] instead. *) val sep_first : 'a list -> 'a * 'a list (** [sep_first l] returns [(a,l')] such that [l] is [a::l']. It raises [Failure _] if the list is empty. *) val sep_last : 'a list -> 'a * 'a list (** [sep_last l] returns [(a,l')] such that [l] is [l'@[a]]. It raises [Failure _] if the list is empty. *) val drop_last : 'a list -> 'a list (** Remove the last element of the list. It raises [Failure _] if the list is empty. This is the second part of [sep_last]. *) val last : 'a list -> 'a (** Return the last element of the list. It raises [Failure _] if the list is empty. This is the first part of [sep_last]. *) val lastn : int -> 'a list -> 'a list (** [lastn n l] returns the [n] last elements of [l]. It raises [Failure _] if [n] is less than 0 or larger than the length of [l] *) val chop : int -> 'a list -> 'a list * 'a list (** [chop i l] splits [l] into two lists [(l1,l2)] such that [l1++l2=l] and [l1] has length [i]. It raises [Failure _] when [i] is negative or greater than the length of [l]. *) val firstn : int -> 'a list -> 'a list (** [firstn n l] Returns the [n] first elements of [l]. It raises [Failure _] if [n] negative or too large. This is the first part of [chop]. *) val skipn : int -> 'a list -> 'a list (** [skipn n l] drops the [n] first elements of [l]. It raises [Failure _] if [n] is less than 0 or larger than the length of [l]. This is the second part of [chop]. *) val skipn_at_best : int -> 'a list -> 'a list (** Same as [skipn] but returns [] if [n] is larger than the length of the list. *) val drop_prefix : 'a eq -> 'a list -> 'a list -> 'a list (** [drop_prefix eq l1 l] returns [l2] if [l=l1++l2] else return [l]. *) val insert : 'a eq -> 'a -> 'a list -> 'a list (** Insert at the (first) position so that if the list is ordered wrt to the total order given as argument, the order is preserved *) val share_tails : 'a eq -> 'a list -> 'a list -> 'a list * 'a list * 'a list (** [share_tails l1 l2] returns [(l1',l2',l)] such that [l1] is [l1'\@l] and [l2] is [l2'\@l] and [l] is maximal amongst all such decompositions *) (** {6 Association lists} *) val map_assoc : ('a -> 'b) -> ('c * 'a) list -> ('c * 'b) list (** Applies a function on the codomain of an association list *) val assoc_f : 'a eq -> 'a -> ('a * 'b) list -> 'b (** Like [List.assoc] but using the equality given as argument *) val assoc_f_opt : 'a eq -> 'a -> ('a * 'b) list -> 'b option (** Like [List.assoc_opt] but using the equality given as argument *) val remove_assoc_f : 'a eq -> 'a -> ('a * 'b) list -> ('a * 'b) list (** Remove first matching element; unchanged if no such element *) val mem_assoc_f : 'a eq -> 'a -> ('a * 'b) list -> bool (** Like [List.mem_assoc] but using the equality given as argument *) val factorize_left : 'a eq -> ('a * 'b) list -> ('a * 'b list) list (** Create a list of associations from a list of pairs *) (** {6 Operations on lists of tuples} *) val split : ('a * 'b) list -> 'a list * 'b list (** Like OCaml's [List.split] but tail-recursive. *) val combine : 'a list -> 'b list -> ('a * 'b) list (** Like OCaml's [List.combine] but tail-recursive. *) val split3 : ('a * 'b * 'c) list -> 'a list * 'b list * 'c list (** Like [split] but for triples *) val split4 : ('a * 'b * 'c * 'd) list -> 'a list * 'b list * 'c list * 'd list (** Like [split] but for quads *) val combine3 : 'a list -> 'b list -> 'c list -> ('a * 'b * 'c) list (** Like [combine] but for triples *) (** {6 Operations on lists seen as sets, preserving uniqueness of elements} *) val add_set : 'a eq -> 'a -> 'a list -> 'a list (** [add_set x l] adds [x] in [l] if it is not already there, or returns [l] otherwise. *) val eq_set : 'a eq -> 'a list eq (** Test equality up to permutation. It respects multiple occurrences and thus works also on multisets. *) val subset : 'a list eq (** Tell if a list is a subset of another up to permutation. It expects each element to occur only once. *) val merge_set : 'a cmp -> 'a list -> 'a list -> 'a list (** Merge two sorted lists and preserves the uniqueness property. *) val intersect : 'a eq -> 'a list -> 'a list -> 'a list (** Return the intersection of two lists, assuming and preserving uniqueness of elements *) val union : 'a eq -> 'a list -> 'a list -> 'a list (** Return the union of two lists, assuming and preserving uniqueness of elements *) val unionq : 'a list -> 'a list -> 'a list (** [union] specialized to physical equality *) val subtract : 'a eq -> 'a list -> 'a list -> 'a list (** Remove from the first list all elements from the second list. *) val subtractq : 'a list -> 'a list -> 'a list (** [subtract] specialized to physical equality *) (** {6 Uniqueness and duplication} *) val distinct : 'a list -> bool (** Return [true] if all elements of the list are distinct. *) val distinct_f : 'a cmp -> 'a list -> bool (** Like [distinct] but using the equality given as argument *) val duplicates : 'a eq -> 'a list -> 'a list (** Return the list of unique elements which appear at least twice. Elements are kept in the order of their first appearance. *) val uniquize_key : ('a -> 'b) -> 'a list -> 'a list (** Return the list of elements without duplicates using the function to associate a comparison key to each element. This is the list unchanged if there was none. *) val uniquize : 'a list -> 'a list (** Return the list of elements without duplicates. This is the list unchanged if there was none. *) val sort_uniquize : 'a cmp -> 'a list -> 'a list (** Return a sorted version of a list without duplicates according to some comparison function. *) val min : 'a cmp -> 'a list -> 'a (** Return minimum element according to some comparison function. @raise Not_found on an empty list. *) (** {6 Cartesian product} *) val cartesian : ('a -> 'b -> 'c) -> 'a list -> 'b list -> 'c list (** A generic binary cartesian product: for any operator (**), [cartesian (**) [x1;x2] [y1;y2] = [x1**y1; x1**y2; x2**y1; x2**y1]], and so on if there are more elements in the lists. *) val cartesians : ('a -> 'b -> 'b) -> 'b -> 'a list list -> 'b list (** [cartesians op init l] is an n-ary cartesian product: it builds the list of all [op a1 .. (op an init) ..] for [a1], ..., [an] in the product of the elements of the lists *) val combinations : 'a list list -> 'a list list (** [combinations l] returns the list of [n_1] * ... * [n_p] tuples [[a11;...;ap1];...;[a1n_1;...;apn_pd]] whenever [l] is a list [[a11;..;a1n_1];...;[ap1;apn_p]]; otherwise said, it is [cartesians (::) [] l] *) val cartesians_filter : ('a -> 'b -> 'b option) -> 'b -> 'a list list -> 'b list (** Like [cartesians op init l] but keep only the tuples for which [op] returns [Some _] on all the elements of the tuple. *) (** When returning a list of same type as the input, maximally shares the suffix of the output which is physically equal to the corresponding suffix of the input *) module Smart : sig val map : ('a -> 'a) -> 'a list -> 'a list (** Like [List.map] but sharing with the input the longest suffix of the output which is physically the same as the input; in particular, [Smart.map f l == l] (physically) if [f a == a] (physically) for all members of the list *) val fold_left_map : ('a -> 'b -> 'a * 'b) -> 'a -> 'b list -> 'a * 'b list (** Idem for the second argument of [List.fold_left_map f e l] relatively to the second argument of [f] *) val fold_right_map : ('b -> 'a -> 'b * 'a) -> 'b list -> 'a -> 'b list * 'a (** Idem for the first argument of [List.fold_right_map f l e] relatively to the second argument of [f] *) end module type MonoS = sig type elt val equal : elt list -> elt list -> bool val mem : elt -> elt list -> bool val assoc : elt -> (elt * 'a) list -> 'a val mem_assoc : elt -> (elt * 'a) list -> bool val remove_assoc : elt -> (elt * 'a) list -> (elt * 'a) list val mem_assoc_sym : elt -> ('a * elt) list -> bool end coq-8.20.0/clib/cMap.ml000066400000000000000000000242111466560755400145300ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* t -> int end module type MonadS = sig type +'a t val return : 'a -> 'a t val (>>=) : 'a t -> ('a -> 'b t) -> 'b t end module type S = Map.S module type UExtS = sig include CSig.UMapS module Set : CSig.USetS with type elt = key val get : key -> 'a t -> 'a val set : key -> 'a -> 'a t -> 'a t val modify : key -> (key -> 'a -> 'a) -> 'a t -> 'a t val domain : 'a t -> Set.t val bind : (key -> 'a) -> Set.t -> 'a t val height : 'a t -> int val filter_range : (key -> int) -> 'a t -> 'a t val filter_map: (key -> 'a -> 'b option) -> 'a t -> 'b t (* in OCaml 4.11 *) val of_list : (key * 'a) list -> 'a t val symmetric_diff_fold : (key -> 'a option -> 'a option -> 'b -> 'b) -> 'a t -> 'a t -> 'b -> 'b module Smart : sig val map : ('a -> 'a) -> 'a t -> 'a t val mapi : (key -> 'a -> 'a) -> 'a t -> 'a t end module Monad(M : MonadS) : sig val fold : (key -> 'a -> 'b -> 'b M.t) -> 'a t -> 'b -> 'b M.t val mapi : (key -> 'a -> 'b M.t) -> 'a t -> 'b t M.t end end module type ExtS = sig include CSig.MapS module Set : CSig.SetS with type elt = key include UExtS with type key := key and type 'a t := 'a t and module Set := Set module Monad(M:MonadS) : sig include module type of Monad(M) val fold_left : (key -> 'a -> 'b -> 'b M.t) -> 'a t -> 'b -> 'b M.t val fold_right : (key -> 'a -> 'b -> 'b M.t) -> 'a t -> 'b -> 'b M.t end val fold_left : (key -> 'a -> 'b -> 'b) -> 'a t -> 'b -> 'b val fold_right : (key -> 'a -> 'b -> 'b) -> 'a t -> 'b -> 'b end module MapExt (M : Map.OrderedType) : sig type 'a map = 'a Map.Make(M).t val set : M.t -> 'a -> 'a map -> 'a map val get : M.t -> 'a map -> 'a val modify : M.t -> (M.t -> 'a -> 'a) -> 'a map -> 'a map val domain : 'a map -> Set.Make(M).t val bind : (M.t -> 'a) -> Set.Make(M).t -> 'a map val fold_left : (M.t -> 'a -> 'b -> 'b) -> 'a map -> 'b -> 'b val fold_right : (M.t -> 'a -> 'b -> 'b) -> 'a map -> 'b -> 'b val height : 'a map -> int val filter_range : (M.t -> int) -> 'a map -> 'a map val filter_map: (M.t -> 'a -> 'b option) -> 'a map -> 'b map (* in OCaml 4.11 *) val symmetric_diff_fold : (M.t -> 'a option -> 'a option -> 'b -> 'b) -> 'a map -> 'a map -> 'b -> 'b val of_list : (M.t * 'a) list -> 'a map module Smart : sig val map : ('a -> 'a) -> 'a map -> 'a map val mapi : (M.t -> 'a -> 'a) -> 'a map -> 'a map end module Monad(MS : MonadS) : sig val fold : (M.t -> 'a -> 'b -> 'b MS.t) -> 'a map -> 'b -> 'b MS.t val fold_left : (M.t -> 'a -> 'b -> 'b MS.t) -> 'a map -> 'b -> 'b MS.t val fold_right : (M.t -> 'a -> 'b -> 'b MS.t) -> 'a map -> 'b -> 'b MS.t val mapi : (M.t -> 'a -> 'b MS.t) -> 'a map -> 'b map MS.t end end = struct (** This unsafe module is a way to access to the actual implementations of OCaml sets and maps without reimplementing them ourselves. It is quite dubious that these implementations will ever be changed... Nonetheless, if this happens, we can still implement a less clever version of [domain]. *) module F = Map.Make(M) type 'a map = 'a F.t module S = Set.Make(M) type set = S.t type 'a _map = | MEmpty | MNode of {l:'a map; v:F.key; d:'a; r:'a map; h:int} type _set = | SEmpty | SNode of set * M.t * set * int let map_prj : 'a map -> 'a _map = Obj.magic let map_inj : 'a _map -> 'a map = Obj.magic let set_prj : set -> _set = Obj.magic let set_inj : _set -> set = Obj.magic let rec set k v (s : 'a map) : 'a map = match map_prj s with | MEmpty -> raise Not_found | MNode {l; v=k'; d=v'; r; h} -> let c = M.compare k k' in if c < 0 then let l' = set k v l in if l == l' then s else map_inj (MNode {l=l'; v=k'; d=v'; r; h}) else if c = 0 then if v' == v then s else map_inj (MNode {l; v=k'; d=v; r; h}) else let r' = set k v r in if r == r' then s else map_inj (MNode {l; v=k'; d=v'; r=r'; h}) let rec get k (s:'a map) : 'a = match map_prj s with | MEmpty -> assert false | MNode {l; v=k'; d=v; r; h} -> let c = M.compare k k' in if c < 0 then get k l else if c = 0 then v else get k r let rec modify k f (s : 'a map) : 'a map = match map_prj s with | MEmpty -> raise Not_found | MNode {l; v; d; r; h} -> let c = M.compare k v in if c < 0 then let l' = modify k f l in if l == l' then s else map_inj (MNode {l=l'; v; d; r; h}) else if c = 0 then let d' = f v d in if d' == d then s else map_inj (MNode {l; v; d=d'; r; h}) else let r' = modify k f r in if r == r' then s else map_inj (MNode {l; v; d; r=r'; h}) let rec domain (s : 'a map) : set = match map_prj s with | MEmpty -> set_inj SEmpty | MNode {l; v; r; h; _} -> set_inj (SNode (domain l, v, domain r, h)) (** This function is essentially identity, but OCaml current stdlib does not take advantage of the similarity of the two structures, so we introduce this unsafe loophole. *) let rec bind f (s : set) : 'a map = match set_prj s with | SEmpty -> map_inj MEmpty | SNode (l, k, r, h) -> map_inj (MNode { l=bind f l; v=k; d=f k; r=bind f r; h}) (** Dual operation of [domain]. *) let rec fold_left f (s : 'a map) accu = match map_prj s with | MEmpty -> accu | MNode {l; v=k; d=v; r; h} -> let accu = f k v (fold_left f l accu) in fold_left f r accu let rec fold_right f (s : 'a map) accu = match map_prj s with | MEmpty -> accu | MNode {l; v=k; d=v; r; h} -> let accu = f k v (fold_right f r accu) in fold_right f l accu let height s = match map_prj s with | MEmpty -> 0 | MNode {h;_} -> h (* Filter based on a range *) let filter_range in_range m = let rec aux m = function | MEmpty -> m | MNode {l; v; d; r; _} -> let vr = in_range v in (* the range is below the current value *) if vr < 0 then aux m (map_prj l) (* the range is above the current value *) else if vr > 0 then aux m (map_prj r) (* The current value is in the range *) else let m = aux m (map_prj l) in let m = aux m (map_prj r) in F.add v d m in aux F.empty (map_prj m) let filter_map f m = (* Waiting for the optimized version in OCaml >= 4.11 *) F.fold (fun k v accu -> match f k v with | None -> accu | Some v' -> F.add k v' accu) m F.empty let of_list l = let fold accu (x, v) = F.add x v accu in List.fold_left fold F.empty l type 'a sequenced = | End | More of M.t * 'a * 'a F.t * 'a sequenced let rec seq_cons m rest = match map_prj m with | MEmpty -> rest | MNode {l; v; d; r; _ } -> seq_cons l (More (v, d, r, rest)) let rec fold_seq f acc = function | End -> acc | More (k, v, m, r) -> f k v @@ fold_seq f (F.fold f m acc) r let move_to_acc (m, acc) = match map_prj m with | MEmpty -> assert false | MNode {l; v; d; r; _ } -> l, More (v, d, r, acc) let rec symmetric_cons ((lm, la) as l) ((rm, ra) as r) = if lm == rm then la, ra else let lh = height lm in let rh = height rm in if lh == rh then symmetric_cons (move_to_acc l) (move_to_acc r) else if lh < rh then symmetric_cons l (move_to_acc r) else symmetric_cons (move_to_acc l) r let symmetric_diff_fold f lm rm acc = let rec aux s acc = match s with | End, rs -> fold_seq (fun k v -> f k None (Some v)) acc rs | ls, End -> fold_seq (fun k v -> f k (Some v) None) acc ls | (More (kl, vl, tl, rl) as ls), (More (kr, vr, tr, rr) as rs) -> let cmp = M.compare kl kr in if cmp == 0 then let rem = aux (symmetric_cons (tl, rl) (tr, rr)) acc in if vl == vr then rem else f kl (Some vl) (Some vr) rem else if cmp < 0 then f kl (Some vl) None @@ aux (seq_cons tl rl, rs) acc else f kr None (Some vr) @@ aux (ls, seq_cons tr rr) acc in aux (symmetric_cons (lm, End) (rm, End)) acc module Smart = struct let rec map f (s : 'a map) = match map_prj s with | MEmpty -> map_inj MEmpty | MNode {l; v=k; d=v; r; h} -> let l' = map f l in let r' = map f r in let v' = f v in if l == l' && r == r' && v == v' then s else map_inj (MNode {l=l'; v=k; d=v'; r=r'; h}) let rec mapi f (s : 'a map) = match map_prj s with | MEmpty -> map_inj MEmpty | MNode {l; v=k; d=v; r; h} -> let l' = mapi f l in let r' = mapi f r in let v' = f k v in if l == l' && r == r' && v == v' then s else map_inj (MNode {l=l'; v=k; d=v'; r=r'; h}) end module Monad(M : MonadS) = struct open M let rec fold_left f s accu = match map_prj s with | MEmpty -> return accu | MNode {l; v=k; d=v; r; h} -> fold_left f l accu >>= fun accu -> f k v accu >>= fun accu -> fold_left f r accu let rec fold_right f s accu = match map_prj s with | MEmpty -> return accu | MNode {l; v=k; d=v; r; h} -> fold_right f r accu >>= fun accu -> f k v accu >>= fun accu -> fold_right f l accu let fold = fold_left let rec mapi f s = match map_prj s with | MEmpty -> return (map_inj MEmpty) | MNode {l; v=k; d=v; r; h} -> mapi f l >>= fun l -> mapi f r >>= fun r -> f k v >>= fun v -> return (map_inj (MNode {l; v=k; d=v; r; h})) end end module Make(M : Map.OrderedType) = struct include Map.Make(M) include MapExt(M) end coq-8.20.0/clib/cMap.mli000066400000000000000000000100301466560755400146730ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* t -> int end module type MonadS = sig type +'a t val return : 'a -> 'a t val (>>=) : 'a t -> ('a -> 'b t) -> 'b t end module type S = Map.S module type UExtS = sig include CSig.UMapS (** The underlying Map library *) module Set : CSig.USetS with type elt = key (** Sets used by the domain function *) val get : key -> 'a t -> 'a (** Same as {!find} but fails an assertion instead of raising [Not_found] *) val set : key -> 'a -> 'a t -> 'a t (** Same as [add], but expects the key to be present, and thus faster. @raise Not_found when the key is unbound in the map. *) val modify : key -> (key -> 'a -> 'a) -> 'a t -> 'a t (** Apply the given function to the binding of the given key. @raise Not_found when the key is unbound in the map. *) val domain : 'a t -> Set.t (** Recover the set of keys defined in the map. *) val bind : (key -> 'a) -> Set.t -> 'a t (** [bind f s] transform the set [x1; ...; xn] into [x1 := f x1; ...; xn := f xn]. *) val height : 'a t -> int (** An indication of the logarithmic size of a map *) val filter_range : (key -> int) -> 'a t -> 'a t (** [find_range in_range m] Given a comparison function [in_range x], that tests if [x] is below, above, or inside a given range [filter_range] returns the submap of [m] whose keys are in range. Note that [in_range] has to define a continouous range. *) val filter_map: (key -> 'a -> 'b option) -> 'a t -> 'b t (* in OCaml 4.11 *) (** Like [map] but keeping only bindings mapped to [Some] *) val of_list : (key * 'a) list -> 'a t (** Turns an association list into a map *) val symmetric_diff_fold : (key -> 'a option -> 'a option -> 'b -> 'b) -> 'a t -> 'a t -> 'b -> 'b (** [symmetric_diff f ml mr acc] will efficiently fold over the difference between [ml] and [mr], assumed that they share most of their internal structure. A call to [f k vl vr] means that if [vl] is [Some], then [k] exists in [ml]. Similarly, if [vr] is [Some], then [k] exists in [mr]. If both [vl] and [vr] are [Some], then [vl != vr]. *) module Smart : sig val map : ('a -> 'a) -> 'a t -> 'a t (** As [map] but tries to preserve sharing. *) val mapi : (key -> 'a -> 'a) -> 'a t -> 'a t (** As [mapi] but tries to preserve sharing. *) end module Monad(M : MonadS) : sig val fold : (key -> 'a -> 'b -> 'b M.t) -> 'a t -> 'b -> 'b M.t val mapi : (key -> 'a -> 'b M.t) -> 'a t -> 'b t M.t end (** Fold operators parameterized by any monad. *) end module type ExtS = sig include CSig.MapS module Set : CSig.SetS with type elt = key include UExtS with type key := key and type 'a t := 'a t and module Set := Set module Monad(M:MonadS) : sig include module type of Monad(M) val fold_left : (key -> 'a -> 'b -> 'b M.t) -> 'a t -> 'b -> 'b M.t val fold_right : (key -> 'a -> 'b -> 'b M.t) -> 'a t -> 'b -> 'b M.t end val fold_left : (key -> 'a -> 'b -> 'b) -> 'a t -> 'b -> 'b (** Alias for {!fold}, to easily track where we depend on fold order. *) val fold_right : (key -> 'a -> 'b -> 'b) -> 'a t -> 'b -> 'b (** Folding keys in decreasing order. *) end module Make(M : Map.OrderedType) : ExtS with type key = M.t and type 'a t = 'a Map.Make(M).t and module Set := Set.Make(M) coq-8.20.0/clib/cObj.ml000066400000000000000000000141731466560755400145330ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* = Obj.no_scan_tag then if Obj.tag t = Obj.string_tag then (c := !c + Obj.size t; b := !b + 1; m := max d !m) else if Obj.tag t = Obj.double_tag then (s := !s + 2; b := !b + 1; m := max d !m) else if Obj.tag t = Obj.double_array_tag then (s := !s + 2 * Obj.size t; b := !b + 1; m := max d !m) else (b := !b + 1; m := max d !m) else let n = Obj.size t in s := !s + n; b := !b + 1; block_stats (d + 1) (n - 1) t and block_stats d i t = if i >= 0 then (obj_stats d (Obj.field t i); block_stats d (i-1) t) let obj_stats a = c := 0; s:= 0; b:= 0; m:= 0; obj_stats 0 (Obj.repr a); (!c, !s + !b, !m) (** {6 Physical sizes} *) (*s Pointers already visited are stored in a hash-table, where comparisons are done using physical equality. *) module H = Hashtbl.Make( struct type t = Obj.t let equal = (==) let hash = Hashtbl.hash end) let node_table = (H.create 257 : unit H.t) let in_table o = try H.find node_table o; true with Not_found -> false let add_in_table o = H.add node_table o () let reset_table () = H.clear node_table (*s Objects are traversed recursively, as soon as their tags are less than [no_scan_tag]. [count] records the numbers of words already visited. *) let size_of_double = Obj.size (Obj.repr 1.0) let count = ref 0 let rec traverse t = if not (in_table t) && Obj.is_block t then begin add_in_table t; let n = Obj.size t in let tag = Obj.tag t in if tag < Obj.no_scan_tag then begin count := !count + 1 + n; for i = 0 to n - 1 do traverse (Obj.field t i) done end else if tag = Obj.string_tag then count := !count + 1 + n else if tag = Obj.double_tag then count := !count + size_of_double else if tag = Obj.double_array_tag then count := !count + 1 + size_of_double * n else incr count end (*s Sizes of objects in words and in bytes. The size in bytes is computed system-independently according to [Sys.word_size]. *) let size o = reset_table (); count := 0; traverse (Obj.repr o); !count let size_b o = (size o) * (Sys.word_size / 8) let size_kb o = (size o) / (8192 / Sys.word_size) (** {6 Physical sizes with sharing} *) (** This time, all the size of objects are computed with respect to a larger object containing them all, and we only count the new blocks not already seen earlier in the left-to-right visit of the englobing object. The very same object could have a zero size or not, depending of the occurrence we're considering in the englobing object. For speaking of occurrences, we use an [int list] for a path of field indexes from the outmost block to the one we're looking. In the list, the leftmost integer is the field index in the deepest block. *) (** We now store in the hashtable the size (with sharing), and also the position of the first occurrence of the object *) let node_sizes = (H.create 257 : (int*int list) H.t) let get_size o = H.find node_sizes o let add_size o n pos = H.replace node_sizes o (n,pos) let reset_sizes () = H.clear node_sizes let global_object = ref (Obj.repr 0) (** [sum n f] is [f 0 + f 1 + ... + f (n-1)], evaluated from left to right *) let sum n f = let rec loop k acc = if k >= n then acc else loop (k+1) (acc + f k) in loop 0 0 (** Recursive visit of the main object, filling the hashtable *) let rec compute_size o pos = if not (Obj.is_block o) then 0 else try let _ = get_size o in 0 (* already seen *) with Not_found -> let n = Obj.size o in add_size o (-1) pos (* temp size, for cyclic values *); let tag = Obj.tag o in let size = if tag < Obj.no_scan_tag then 1 + n + sum n (fun i -> compute_size (Obj.field o i) (i::pos)) else if tag = Obj.string_tag then 1 + n else if tag = Obj.double_tag then size_of_double else if tag = Obj.double_array_tag then size_of_double * n else 1 in add_size o size pos; size (** Provides the global object in which we'll search shared sizes *) let register_shared_size t = let o = Obj.repr t in reset_sizes (); global_object := o; ignore (compute_size o []) (** Shared size of an object with respect to the global object given by the last [register_shared_size] *) let shared_size pos o = if not (Obj.is_block o) then 0 else let size,pos' = try get_size o with Not_found -> failwith "shared_size: unregistered structure ?" in match pos with | Some p when p <> pos' -> 0 | _ -> size let shared_size_of_obj t = shared_size None (Obj.repr t) (** Shared size of the object at some positiion in the global object given by the last [register_shared_size] *) let shared_size_of_pos pos = let rec obj_of_pos o = function | [] -> o | n::pos' -> let o' = obj_of_pos o pos' in assert (Obj.is_block o' && n < Obj.size o'); Obj.field o' n in shared_size (Some pos) (obj_of_pos !global_object pos) (*s Total size of the allocated ocaml heap. *) let heap_size () = let stat = Gc.stat () and control = Gc.get () in let max_words_total = stat.Gc.heap_words + control.Gc.minor_heap_size in (max_words_total * (Sys.word_size / 8)) let heap_size_kb () = (heap_size () + 1023) / 1024 coq-8.20.0/clib/cObj.mli000066400000000000000000000044351466560755400147040ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* int (** Physical size of an object in words. *) val size_b : 'a -> int (** Same as [size] in bytes. *) val size_kb : 'a -> int (** Same as [size] in kilobytes. *) (** {6 Physical size of an ocaml value with sharing.} *) (** This time, all the size of objects are computed with respect to a larger object containing them all, and we only count the new blocks not already seen earlier in the left-to-right visit of the englobing object. *) (** Provides the global object in which we'll search shared sizes *) val register_shared_size : 'a -> unit (** Shared size (in word) of an object with respect to the global object given by the last [register_shared_size]. *) val shared_size_of_obj : 'a -> int (** Same, with an object indicated by its occurrence in the global object. The very same object could have a zero size or not, depending of the occurrence we're considering in the englobing object. For speaking of occurrences, we use an [int list] for a path of field indexes (leftmost = deepest block, rightmost = top block of the global object). *) val shared_size_of_pos : int list -> int (** {6 Logical size of an OCaml value.} *) val obj_stats : 'a -> int * int * int (** Return the (logical) value size, the string size, and the maximum depth of the object. This loops on cyclic structures. *) (** {6 Total size of the allocated ocaml heap. } *) val heap_size : unit -> int (** Heap size, in words. *) val heap_size_kb : unit -> int (** Heap size, in kilobytes. *) coq-8.20.0/clib/cSet.ml000066400000000000000000000036041466560755400145510ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* t -> int end module type S = Set.S module Make(M : OrderedType)= Set.Make(M) module type HashedType = sig type t val hash : t -> int end module Hashcons(M : OrderedType)(H : HashedType with type t = M.t) = struct module Set = Make(M) type set = Set.t type _set = | SEmpty | SNode of set * M.t * set * int let set_prj : set -> _set = Obj.magic let set_inj : _set -> set = Obj.magic let rec spine s accu = match set_prj s with | SEmpty -> accu | SNode (l, v, r, _) -> spine l ((v, r) :: accu) let rec umap f s = match set_prj s with | SEmpty -> set_inj SEmpty | SNode (l, v, r, h) -> let l' = umap f l in let r' = umap f r in let v' = f v in set_inj (SNode (l', v', r', h)) let rec eqeq s1 s2 = match s1, s2 with | [], [] -> true | (v1, r1) :: s1, (v2, r2) :: s2 -> v1 == v2 && eqeq (spine r1 s1) (spine r2 s2) | _ -> false module Hashed = struct open Hashset.Combine type t = set type u = M.t -> M.t let eq s1 s2 = s1 == s2 || eqeq (spine s1 []) (spine s2 []) let hash s = Set.fold (fun v accu -> combine (H.hash v) accu) s 0 let hashcons = umap end include Hashcons.Make(Hashed) end coq-8.20.0/clib/cSet.mli000066400000000000000000000022351466560755400147210ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* t -> int end module type S = Set.S module Make(M : OrderedType) : S with type elt = M.t and type t = Set.Make(M).t module type HashedType = sig type t val hash : t -> int end module Hashcons (M : OrderedType) (_ : HashedType with type t = M.t) : Hashcons.S with type t = Set.Make(M).t and type u = M.t -> M.t (** Create hash-consing for sets. The hashing function provided must be compatible with the comparison function. *) coq-8.20.0/clib/cSig.mli000066400000000000000000000066311466560755400147140ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* bool val mem: elt -> t -> bool val add: elt -> t -> t val singleton: elt -> t val remove: elt -> t -> t val union: t -> t -> t val inter: t -> t -> t val diff: t -> t -> t val compare: t -> t -> int val equal: t -> t -> bool val subset: t -> t -> bool val iter: (elt -> unit) -> t -> unit val fold: (elt -> 'a -> 'a) -> t -> 'a -> 'a val for_all: (elt -> bool) -> t -> bool val exists: (elt -> bool) -> t -> bool val filter: (elt -> bool) -> t -> t val partition: (elt -> bool) -> t -> t * t val cardinal: t -> int val elements: t -> elt list val choose: t -> elt end (** Redeclaration of OCaml set signature, to preserve compatibility. See OCaml documentation for more information. Operations which can't be efficiently implemented for HSets are moved to OSetS. *) module type SetS = sig include USetS val min_elt: t -> elt val max_elt: t -> elt val split: elt -> t -> t * bool * t end (** OCaml set operations which require the order structure to be efficient. *) module type UMapS = sig type key type (+'a) t val empty: 'a t val is_empty: 'a t -> bool val mem: key -> 'a t -> bool val add: key -> 'a -> 'a t -> 'a t val update : key -> ('a option -> 'a option) -> 'a t -> 'a t val singleton: key -> 'a -> 'a t val remove: key -> 'a t -> 'a t val merge: (key -> 'a option -> 'b option -> 'c option) -> 'a t -> 'b t -> 'c t val union: (key -> 'a -> 'a -> 'a option) -> 'a t -> 'a t -> 'a t val compare: ('a -> 'a -> int) -> 'a t -> 'a t -> int val equal: ('a -> 'a -> bool) -> 'a t -> 'a t -> bool val iter: (key -> 'a -> unit) -> 'a t -> unit val fold: (key -> 'a -> 'b -> 'b) -> 'a t -> 'b -> 'b val for_all: (key -> 'a -> bool) -> 'a t -> bool val exists: (key -> 'a -> bool) -> 'a t -> bool val filter: (key -> 'a -> bool) -> 'a t -> 'a t val partition: (key -> 'a -> bool) -> 'a t -> 'a t * 'a t val cardinal: 'a t -> int val bindings: 'a t -> (key * 'a) list val choose: 'a t -> (key * 'a) val choose_opt: 'a t -> (key * 'a) option val find: key -> 'a t -> 'a val find_opt : key -> 'a t -> 'a option val map: ('a -> 'b) -> 'a t -> 'b t val mapi: (key -> 'a -> 'b) -> 'a t -> 'b t end module type MapS = sig include UMapS val min_binding: 'a t -> (key * 'a) val max_binding: 'a t -> (key * 'a) val split: key -> 'a t -> 'a t * 'a option * 'a t end coq-8.20.0/clib/cString.ml000066400000000000000000000130021466560755400152550ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* int val is_empty : string -> bool val explode : string -> string list val implode : string list -> string val drop_simple_quotes : string -> string val quote_coq_string : string -> string val unquote_coq_string : string -> string option val html_escape : string -> string val string_index_from : string -> int -> string -> int val string_contains : where:string -> what:string -> bool val plural : int -> string -> string val lplural : _ list -> string -> string val conjugate_verb_to_be : int -> string 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 Pred : Predicate.S with type elt = t module List : CList.MonoS with type elt = t val hcons : string -> string end include String let rec hash len s i accu = if i = len then accu else let c = Char.code (String.unsafe_get s i) in hash len s (succ i) (accu * 19 + c) let hash s = let len = String.length s in hash len s 0 0 let explode s = let rec explode_rec n = if n >= String.length s then [] else String.make 1 (String.get s n) :: explode_rec (succ n) in explode_rec 0 let implode sl = String.concat "" sl let is_empty s = String.length s = 0 let drop_simple_quotes s = let n = String.length s in if n > 2 && s.[0] = '\'' && s.[n-1] = '\'' then String.sub s 1 (n-2) else s let quote_coq_string s = let b = Buffer.create (String.length s + 2) in Buffer.add_char b '"'; for i = 0 to String.length s - 1 do Buffer.add_char b s.[i]; if s.[i] = '"' then Buffer.add_char b s.[i]; done; Buffer.add_char b '"'; Buffer.contents b let unquote_coq_string s = let b = Buffer.create (String.length s) in let n = String.length s in if n < 2 || s.[0] <> '"' || s.[n-1] <> '"' then None else let i = ref 1 in try while !i < n - 1 do Buffer.add_char b s.[!i]; if s.[!i] = '"' then if !i < n - 2 && s.[!i+1] = '"' then incr i else raise Exit; incr i done; Some (Buffer.contents b) with Exit -> None let html_escape msg = let buf = Buffer.create (String.length msg) in String.iter (fun c -> if String.contains "\"&'<>" c then Buffer.add_string buf (Printf.sprintf "&#%d;" (Char.code c)) else Buffer.add_char buf c) msg; Buffer.contents buf (* substring searching... *) (* gdzie = where, co = what *) (* gdzie=gdzie(string) gl=gdzie(length) gi=gdzie(index) *) let rec raw_is_sub gdzie gl gi co cl ci = (ci>=cl) || ((String.unsafe_get gdzie gi = String.unsafe_get co ci) && (raw_is_sub gdzie gl (gi+1) co cl (ci+1))) let rec raw_str_index i gdzie l c co cl = (* First adapt to ocaml 3.11 new semantics of index_from *) if (i+cl > l) then raise Not_found; (* Then proceed as in ocaml < 3.11 *) let i' = String.index_from gdzie i c in if (i'+cl <= l) && (raw_is_sub gdzie l i' co cl 0) then i' else raw_str_index (i'+1) gdzie l c co cl let string_index_from gdzie i co = if co="" then i else raw_str_index i gdzie (String.length gdzie) (String.unsafe_get co 0) co (String.length co) let string_contains ~where ~what = try let _ = string_index_from where 0 what in true with Not_found -> false let is_sub p s off = let lp = String.length p in let ls = String.length s in if ls < off + lp then false else let rec aux i = if lp <= i then true else let cp = String.unsafe_get p i in let cs = String.unsafe_get s (off + i) in if cp = cs then aux (succ i) else false in aux 0 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 lplural l s = match l with | [_] -> s | _ -> s^"s" let conjugate_verb_to_be n = if n<>1 then "are" else "is" let ordinal n = let s = if (n / 10) mod 10 = 1 then "th" else match n mod 10 with | 1 -> "st" | 2 -> "nd" | 3 -> "rd" | _ -> "th" in string_of_int n ^ s (* string parsing *) module Self = struct type t = string let compare = compare end module Set = Set.Make(Self) module Map = CMap.Make(Self) module Pred = Predicate.Make(Self) module List = struct type elt = string let mem id l = List.exists (fun s -> equal id s) l let assoc id l = CList.assoc_f equal id l let remove_assoc id l = CList.remove_assoc_f equal id l let mem_assoc id l = List.exists (fun (a,_) -> equal id a) l let mem_assoc_sym id l = List.exists (fun (_,b) -> equal id b) l let equal l l' = CList.equal equal l l' end let hcons = Hashcons.simple_hcons Hashcons.Hstring.generate Hashcons.Hstring.hcons () coq-8.20.0/clib/cString.mli000066400000000000000000000064231466560755400154370ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* int (** Hashing on strings. Should be compatible with generic one. *) val is_empty : string -> bool (** Test whether a string is empty. *) val explode : string -> string list (** [explode "x1...xn"] returns [["x1"; ...; "xn"]] *) val implode : string list -> string (** [implode [s1; ...; sn]] returns [s1 ^ ... ^ sn] *) val drop_simple_quotes : string -> string (** Remove the eventual first surrounding simple quotes of a string. *) val quote_coq_string : string -> string (** Quote a string according to Coq conventions (i.e. doubling double quotes and surrounding by double quotes) *) val unquote_coq_string : string -> string option (** Unquote a quoted string according to Coq conventions (i.e. removing surrounding double quotes and undoubling double quotes); returns [None] if not a quoted string *) val html_escape : string -> string (** replace HTML reserved characters with escape sequences, e.g. `&` -> "&" *) val string_index_from : string -> int -> string -> int (** As [index_from], but takes a string instead of a char as pattern argument *) val string_contains : where:string -> what:string -> bool (** As [contains], but takes a string instead of a char as pattern argument *) val plural : int -> string -> string (** [plural n s] adds a optional 's' to the [s] when [2 <= n]. *) val lplural : _ list -> string -> string (** [lplural l s] is [plural (List.length l) s]. *) val conjugate_verb_to_be : int -> string (** [conjugate_verb_to_be] returns "is" when [n=1] and "are" otherwise *) val ordinal : int -> string (** Generate the ordinal number in English. *) val is_sub : string -> string -> int -> bool (** [is_sub p s off] tests whether [s] contains [p] at offset [off]. *) 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 (** Finite sets on [string] *) module Map : CMap.ExtS with type key = t and module Set := Set (** Finite maps on [string] *) module Pred : Predicate.S with type elt = t module List : CList.MonoS with type elt = t (** Association lists with [string] as keys *) val hcons : string -> string (** Hashconsing on [string] *) end include ExtS coq-8.20.0/clib/cThread.ml000066400000000000000000000073501466560755400152270ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* loop () in loop () let thread_friendly_read ic s ~off ~len = try let fd = Unix.descr_of_in_channel ic in thread_friendly_read_fd fd s ~off ~len with Unix.Unix_error _ -> 0 let really_read_fd fd s off len = let i = ref 0 in while !i < len do let off = off + !i in let len = len - !i in let r = thread_friendly_read_fd fd s ~off ~len in if r = 0 then raise End_of_file; i := !i + r done let really_read_fd_2_oc fd oc len = let i = ref 0 in let size = 4096 in let s = Bytes.create size in while !i < len do let len = len - !i in let r = thread_friendly_read_fd fd s ~off:0 ~len:(min len size) in if r = 0 then raise End_of_file; i := !i + r; output oc s 0 r; done let thread_friendly_really_read ic s ~off ~len = try let fd = Unix.descr_of_in_channel ic in really_read_fd fd s off len with Unix.Unix_error _ -> raise End_of_file let thread_friendly_really_read_line ic = try let fd = Unix.descr_of_in_channel ic in let b = Buffer.create 1024 in let s = Bytes.make 1 '\000' in let endl = Bytes.of_string "\n" in while not (Bytes.equal s endl) do let n = thread_friendly_read_fd fd s ~off:0 ~len:1 in if n = 0 then raise End_of_file; if not (Bytes.equal s endl) then Buffer.add_bytes b s; done; Buffer.contents b with Unix.Unix_error _ -> raise End_of_file let thread_friendly_input_value ic = try let fd = Unix.descr_of_in_channel ic in let header = Bytes.create Marshal.header_size in really_read_fd fd header 0 Marshal.header_size; let body_size = Marshal.data_size header 0 in let desired_size = body_size + Marshal.header_size in if desired_size <= Sys.max_string_length then begin let msg = Bytes.create desired_size in Bytes.blit header 0 msg 0 Marshal.header_size; really_read_fd fd msg Marshal.header_size body_size; Marshal.from_bytes msg 0 end else begin (* Workaround for 32 bit systems and data > 16M *) let name, oc = Filename.open_temp_file ~mode:[Open_binary] "coq" "marshal" in try output oc header 0 Marshal.header_size; really_read_fd_2_oc fd oc body_size; close_out oc; let ic = open_in_bin name in let data = Marshal.from_channel ic in close_in ic; Sys.remove name; data with e -> Sys.remove name; raise e end with Unix.Unix_error _ | Sys_error _ -> raise End_of_file (* On the ocaml runtime used in some opam-for-windows version the * [Thread.sigmask] API raises Invalid_argument "not implemented", * hence we protect the call and turn the exception into a no-op *) let mask_sigalrm f x = begin try ignore(Thread.sigmask Unix.SIG_BLOCK [Sys.sigalrm]) with Invalid_argument _ -> () end; f x let create f x = Thread.create (mask_sigalrm f) x let with_lock = Memprof_coq.Mutex_aux.with_lock coq-8.20.0/clib/cThread.mli000066400000000000000000000033721466560755400154000ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* thread_ic val thread_friendly_input_value : thread_ic -> 'a val thread_friendly_read : thread_ic -> Bytes.t -> off:int -> len:int -> int val thread_friendly_really_read : thread_ic -> Bytes.t -> off:int -> len:int -> unit val thread_friendly_really_read_line : thread_ic -> string (* Wrapper around Thread.create that blocks signals such as Sys.sigalrm (used * for Timeout *) val create : ('a -> 'b) -> 'a -> Thread.t (* Atomic mutex lock taken from https://gitlab.com/gadmm/memprof-limits/-/blob/master/src/thread_map.ml#L23-34 *) val with_lock : Mutex.t -> scope:(unit -> 'a) -> 'a coq-8.20.0/clib/cUnix.ml000066400000000000000000000132111466560755400147340ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* (* We give up to find a canonical name and just simplify it... *) current ^ dirsep ^ strip_path p let make_suffix name suffix = if Filename.check_suffix name suffix then name else (name ^ suffix) let correct_path f dir = if Filename.is_relative f then Filename.concat dir f else f let file_readable_p name = try Unix.access name [Unix.R_OK];true with Unix.Unix_error (_, _, _) -> false (* As for [Unix.close_process], a [Unix.waipid] that ignores all [EINTR] *) let rec waitpid_non_intr pid = try snd (Unix.waitpid [] pid) with Unix.Unix_error (Unix.EINTR, _, _) -> waitpid_non_intr pid (** [run_command com] launches command [com] (via /bin/sh), and returns the contents of stdout and stderr. If given, [~hook] is called on each elements read on stdout or stderr. *) let run_command ?(hook=(fun _ ->())) c = let result = Buffer.create 127 in let cin,cout,cerr = Unix.open_process_full c (Unix.environment ()) in let buff = Bytes.make 127 ' ' in let buffe = Bytes.make 127 ' ' in let n = ref 0 in let ne = ref 0 in while n:= input cin buff 0 127 ; ne := input cerr buffe 0 127 ; !n+ !ne <> 0 do let r = Bytes.sub buff 0 !n in (hook r; Buffer.add_bytes result r); let r = Bytes.sub buffe 0 !ne in (hook r; Buffer.add_bytes result r); done; (Unix.close_process_full (cin,cout,cerr), Buffer.contents result) (** [sys_command] launches program [prog] with arguments [args]. It behaves like [Sys.command], except that we rely on [Unix.create_process], it's hardly more complex and avoids dealing with shells. In particular, no need to quote arguments (against whitespace or other funny chars in paths), hence no need to care about the different quoting conventions of /bin/sh and cmd.exe. *) let sys_command prog args = let argv = Array.of_list (prog::args) in let pid = Unix.create_process prog argv Unix.stdin Unix.stdout Unix.stderr in waitpid_non_intr pid (* checks if two file names refer to the same (existing) file by comparing their device and inode. It seems that under Windows, inode is always 0, so we cannot accurately check if *) (* Optimised for partial application (in case many candidates must be compared to f1). *) let same_file f1 = try let s1 = Unix.stat f1 in (fun f2 -> try let s2 = Unix.stat f2 in s1.Unix.st_dev = s2.Unix.st_dev && if Sys.os_type = "Win32" then f1 = f2 else s1.Unix.st_ino = s2.Unix.st_ino with Unix.Unix_error _ -> false) with Unix.Unix_error _ -> (fun _ -> false) (* Copied from ocaml filename.ml *) let prng = lazy(Random.State.make_self_init ()) let temp_file_name temp_dir prefix suffix = let rnd = (Random.State.bits (Lazy.force prng)) land 0xFFFFFF in Filename.concat temp_dir (Printf.sprintf "%s%06x%s" prefix rnd suffix) let mktemp_dir ?(temp_dir=Filename.get_temp_dir_name()) prefix suffix = let rec try_name counter = let name = temp_file_name temp_dir prefix suffix in match Unix.mkdir name 0o700 with | () -> name | exception (Sys_error _ as e) -> if counter >= 1000 then raise e else try_name (counter + 1) in try_name 0 coq-8.20.0/clib/cUnix.mli000066400000000000000000000053601466560755400151130ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* physical_path val string_of_physical_path : physical_path -> string (** Escape what has to be escaped (e.g. surround with quotes if with spaces) *) val escaped_string_of_physical_path : physical_path -> string val canonical_path_name : string -> string (** Remove all initial "./" in a path *) val remove_path_dot : string -> string (** If a path [p] starts with the current directory $PWD then [strip_path p] returns the sub-path relative to $PWD. Any leading "./" are also removed from the result. *) val strip_path : string -> string (** correct_path f dir = dir/f if f is relative *) val correct_path : string -> string -> string val path_to_list : string -> string list (** [make_suffix file suf] catenate [file] with [suf] when [file] does not already end with [suf]. *) val make_suffix : string -> string -> string val file_readable_p : string -> bool (** {6 Executing commands } *) (** [run_command com] launches command [com], and returns the contents of stdout and stderr. If given, [~hook] is called on each elements read on stdout or stderr. *) val run_command : ?hook:(bytes->unit) -> string -> Unix.process_status * string (** [sys_command] launches program [prog] with arguments [args]. It behaves like [Sys.command], except that we rely on [Unix.create_process], it's hardly more complex and avoids dealing with shells. In particular, no need to quote arguments (against whitespace or other funny chars in paths), hence no need to care about the different quoting conventions of /bin/sh and cmd.exe. *) val sys_command : string -> string list -> Unix.process_status (** A version of [Unix.waitpid] immune to EINTR exceptions *) val waitpid_non_intr : int -> Unix.process_status (** Check if two file names refer to the same (existing) file *) val same_file : string -> string -> bool (** Like [Stdlib.Filename.temp_file] but producing a directory. *) val mktemp_dir : ?temp_dir:string -> string -> string -> string coq-8.20.0/clib/diff2.ml000066400000000000000000000110731466560755400146440ustar00rootroot00000000000000(* copied from https://github.com/leque/ocaml-diff.git and renamed from "diff.ml" *) (* * Copyright (C) 2016 OOHASHI Daichi * * Permission is hereby granted, free of charge, to any person obtaining a copy * of this software and associated documentation files (the "Software"), to deal * in the Software without restriction, including without limitation the rights * to use, copy, modify, merge, publish, distribute, sublicense, and/or sell * copies of the Software, and to permit persons to whom the Software is * furnished to do so, subject to the following conditions: * The above copyright notice and this permission notice shall be included in * all copies or substantial portions of the Software. * * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR * IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, * FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE * AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER * LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, * OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN * THE SOFTWARE. *) type 'a common = [ `Common of int * int * 'a ] type 'a edit = [ `Added of int * 'a | `Removed of int * 'a | 'a common ] module type SeqType = sig type t type elem val get : t -> int -> elem val length : t -> int end module type S = sig type t type elem val lcs : ?equal:(elem -> elem -> bool) -> t -> t -> elem common list val diff : ?equal:(elem -> elem -> bool) -> t -> t -> elem edit list val fold_left : ?equal:(elem -> elem -> bool) -> f:('a -> elem edit -> 'a) -> init:'a -> t -> t -> 'a val iter : ?equal:(elem -> elem -> bool) -> f:(elem edit -> unit) -> t -> t -> unit end module Make(M : SeqType) : (S with type t = M.t and type elem = M.elem) = struct type t = M.t type elem = M.elem let lcs ?(equal = (=)) a b = let n = M.length a in let m = M.length b in let mn = m + n in let sz = 2 * mn + 1 in let vd = Array.make sz 0 in let vl = Array.make sz 0 in let vr = Array.make sz [] in let get v i = Array.get v (i + mn) in let set v i x = Array.set v (i + mn) x in let finish () = let rec loop i maxl r = if i > mn then List.rev r else if get vl i > maxl then loop (i + 1) (get vl i) (get vr i) else loop (i + 1) maxl r in loop (- mn) 0 [] in if mn = 0 then [] else (* For d <- 0 to mn Do *) let rec dloop d = assert (d <= mn); (* For k <- -d to d in steps of 2 Do *) let rec kloop k = if k > d then dloop @@ d + 1 else let x, l, r = if k = -d || (k <> d && get vd (k - 1) < get vd (k + 1)) then get vd (k + 1), get vl (k + 1), get vr (k + 1) else get vd (k - 1) + 1, get vl (k - 1), get vr (k - 1) in let x, y, l, r = let rec xyloop x y l r = if x < n && y < m && equal (M.get a x) (M.get b y) then xyloop (x + 1) (y + 1) (l + 1) (`Common(x, y, M.get a x) :: r) else x, y, l, r in xyloop x (x - k) l r in set vd k x; set vl k l; set vr k r; if x >= n && y >= m then (* Stop *) finish () else kloop @@ k + 2 in kloop @@ -d in dloop 0 let fold_left ?(equal = (=)) ~f ~init a b = let ff x y = f y x in let fold_map f g x from to_ init = let rec loop i init = if i >= to_ then init else loop (i + 1) (f (g i @@ M.get x i) init) in loop from init in let added i x = `Added (i, x) in let removed i x = `Removed (i, x) in let rec loop cs apos bpos init = match cs with | [] -> init |> fold_map ff removed a apos (M.length a) |> fold_map ff added b bpos (M.length b) | `Common (aoff, boff, _) as e :: rest -> init |> fold_map ff removed a apos aoff |> fold_map ff added b bpos boff |> ff e |> loop rest (aoff + 1) (boff + 1) in loop (lcs ~equal a b) 0 0 init let diff ?(equal = (=)) a b = fold_left ~equal ~f:(fun xs x -> x::xs) ~init:[] a b let iter ?(equal = (=)) ~f a b = fold_left a b ~equal ~f:(fun () x -> f x) ~init:() end coq-8.20.0/clib/diff2.mli000066400000000000000000000057611466560755400150240ustar00rootroot00000000000000(* copied from https://github.com/leque/ocaml-diff.git and renamed from "diff.mli" *) (** An implementation of Eugene Myers' O(ND) Difference Algorithm\[1\]. This implementation is a port of util.lcs module of {{:http://practical-scheme.net/gauche} Gauche Scheme interpreter}. - \[1\] Eugene Myers, An O(ND) Difference Algorithm and Its Variations, Algorithmica Vol. 1 No. 2, pp. 251-266, 1986. *) type 'a common = [ `Common of int * int * 'a ] (** an element of lcs of seq1 and seq2 *) type 'a edit = [ `Removed of int * 'a | `Added of int * 'a | 'a common ] (** an element of diff of seq1 and seq2. *) module type SeqType = sig type t (** The type of the sequence. *) type elem (** The type of the elements of the sequence. *) val get : t -> int -> elem (** [get t n] returns [n]-th element of the sequence [t]. *) val length : t -> int (** [length t] returns the length of the sequence [t]. *) end (** Input signature of {!Diff.Make}. *) module type S = sig type t (** The type of input sequence. *) type elem (** The type of the elements of result / input sequence. *) val lcs : ?equal:(elem -> elem -> bool) -> t -> t -> elem common list (** [lcs ~equal seq1 seq2] computes the LCS (longest common sequence) of [seq1] and [seq2]. Elements of [seq1] and [seq2] are compared with [equal]. [equal] defaults to [Pervasives.(=)]. Elements of lcs are [`Common (pos1, pos2, e)] where [e] is an element, [pos1] is a position in [seq1], and [pos2] is a position in [seq2]. *) val diff : ?equal:(elem -> elem -> bool) -> t -> t -> elem edit list (** [diff ~equal seq1 seq2] computes the diff of [seq1] and [seq2]. Elements of [seq1] and [seq2] are compared with [equal]. Elements only in [seq1] are represented as [`Removed (pos, e)] where [e] is an element, and [pos] is a position in [seq1]; those only in [seq2] are represented as [`Added (pos, e)] where [e] is an element, and [pos] is a position in [seq2]; those common in [seq1] and [seq2] are represented as [`Common (pos1, pos2, e)] where [e] is an element, [pos1] is a position in [seq1], and [pos2] is a position in [seq2]. *) val fold_left : ?equal:(elem -> elem -> bool) -> f:('a -> elem edit -> 'a) -> init:'a -> t -> t -> 'a (** [fold_left ~equal ~f ~init seq1 seq2] is same as [diff ~equal seq1 seq2 |> ListLabels.fold_left ~f ~init], but does not create an intermediate list. *) val iter : ?equal:(elem -> elem -> bool) -> f:(elem edit -> unit) -> t -> t -> unit (** [iter ~equal ~f seq1 seq2] is same as [diff ~equal seq1 seq2 |> ListLabels.iter ~f], but does not create an intermediate list. *) end (** Output signature of {!Diff.Make}. *) module Make : functor (M : SeqType) -> (S with type t = M.t and type elem = M.elem) (** Functor building an implementation of the diff structure given a sequence type. *) coq-8.20.0/clib/dune000066400000000000000000000016101466560755400141720ustar00rootroot00000000000000(library (name clib) (synopsis "Coq's Utility Library [general purpose]") (public_name coq-core.clib) (wrapped false) (modules_without_implementation cSig) (modules :standard \ unicodetable_gen) (libraries (select memprof_coq.ml from (!memprof-limits -> memprof_coq.std.ml) (memprof-limits -> memprof_coq.memprof.ml)) str unix threads)) (executable (name unicodetable_gen) (modules unicodetable_gen)) (rule (targets unicodetable.ml) (deps (:gen ./unicodetable_gen.exe)) (action (run %{gen} %{targets}))) (rule (target mutex_aux.ml) (action (copy mutex_aux_4.x.ml %{target})) (enabled_if (< %{ocaml_version} 5.0))) (rule (target mutex_aux.ml) (action (copy mutex_aux_5.0.ml %{target})) (enabled_if (and (>= %{ocaml_version} 5.0) (< %{ocaml_version} 5.1)))) (rule (target mutex_aux.ml) (action (copy mutex_aux_5.x.ml %{target})) (enabled_if (>= %{ocaml_version} 5.1))) coq-8.20.0/clib/dyn.ml000066400000000000000000000124001466560755400144370ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* 'a value -> t -> t val remove : 'a key -> t -> t val find : 'a key -> t -> 'a value val mem : 'a key -> t -> bool val modify : 'a key -> ('a value -> 'a value) -> t -> t type map = { map : 'a. 'a key -> 'a value -> 'a value } val map : map -> t -> t type any = Any : 'a key * 'a value -> any val iter : (any -> unit) -> t -> unit val fold : (any -> 'r -> 'r) -> t -> 'r -> 'r type filter = { filter : 'a. 'a key -> 'a value -> bool } val filter : filter -> t -> t end module type PreS = sig type 'a tag type t = Dyn : 'a tag * 'a -> t val create : string -> 'a tag val eq : 'a tag -> 'b tag -> ('a, 'b) CSig.eq option val repr : 'a tag -> string val dump : unit -> (int * string) list type any = Any : 'a tag -> any val name : string -> any option module Map(Value : ValueS) : MapS with type 'a key = 'a tag and type 'a value = 'a Value.t module HMap (V1 : ValueS)(V2 : ValueS) : sig type map = { map : 'a. 'a tag -> 'a V1.t -> 'a V2.t } val map : map -> Map(V1).t -> Map(V2).t type filter = { filter : 'a. 'a tag -> 'a V1.t -> bool } val filter : filter -> Map(V1).t -> Map(V1).t end end module type S = sig include PreS module Easy : sig val make_dyn_tag : string -> ('a -> t) * (t -> 'a) * 'a tag val make_dyn : string -> ('a -> t) * (t -> 'a) val inj : 'a -> 'a tag -> t val prj : t -> 'a tag -> 'a option end end module Make () = struct module Self : PreS = struct (* Dynamics, programmed with DANGER !!! *) type 'a tag = int type t = Dyn : 'a tag * 'a -> t type any = Any : 'a tag -> any let dyntab = ref (Int.Map.empty : string Int.Map.t) (** Instead of working with tags as strings, which are costly, we use their hash. We ensure unicity of the hash in the [create] function. If ever a collision occurs, which is unlikely, it is sufficient to tweak the offending dynamic tag. *) let create (s : string) = let hash = Hashtbl.hash s in if Int.Map.mem hash !dyntab then begin let old = Int.Map.find hash !dyntab in Printf.eprintf "Dynamic tag collision: %s vs. %s\n%!" s old; assert false end; dyntab := Int.Map.add hash s !dyntab; hash let eq : 'a 'b. 'a tag -> 'b tag -> ('a, 'b) CSig.eq option = fun h1 h2 -> if Int.equal h1 h2 then Some (Obj.magic CSig.Refl) else None let repr s = try Int.Map.find s !dyntab with Not_found -> let () = Printf.eprintf "Unknown dynamic tag %i\n%!" s in assert false let name s = let hash = Hashtbl.hash s in if Int.Map.mem hash !dyntab then Some (Any hash) else None let dump () = Int.Map.bindings !dyntab module Map(Value: ValueS) = struct type t = Obj.t Value.t Int.Map.t type 'a key = 'a tag type 'a value = 'a Value.t let cast : 'a value -> 'b value = Obj.magic let empty = Int.Map.empty let add tag v m = Int.Map.add tag (cast v) m let remove tag m = Int.Map.remove tag m let find tag m = cast (Int.Map.find tag m) let mem = Int.Map.mem let modify tag f m = Int.Map.modify tag (fun _ v -> cast (f (cast v))) m type map = { map : 'a. 'a tag -> 'a value -> 'a value } let map f m = Int.Map.mapi f.map m type any = Any : 'a tag * 'a value -> any let iter f m = Int.Map.iter (fun k v -> f (Any (k, v))) m let fold f m accu = Int.Map.fold (fun k v accu -> f (Any (k, v)) accu) m accu type filter = { filter : 'a. 'a tag -> 'a value -> bool } let filter f m = Int.Map.filter f.filter m end module HMap (V1 : ValueS) (V2 : ValueS) = struct type map = { map : 'a. 'a tag -> 'a V1.t -> 'a V2.t } let map (f : map) (m : Map(V1).t) : Map(V2).t = Int.Map.mapi f.map m type filter = { filter : 'a. 'a tag -> 'a V1.t -> bool } let filter (f : filter) (m : Map(V1).t) : Map(V1).t = Int.Map.filter f.filter m end end include Self module Easy = struct (* now tags are opaque, we can do the trick *) let make_dyn_tag (s : string) = (fun (type a) (tag : a tag) -> let infun : (a -> t) = fun x -> Dyn (tag, x) in let outfun : (t -> a) = fun (Dyn (t, x)) -> match eq tag t with | None -> assert false | Some CSig.Refl -> x in infun, outfun, tag) (create s) let make_dyn (s : string) = let inf, outf, _ = make_dyn_tag s in inf, outf let inj x tag = Dyn(tag,x) let prj : type a. t -> a tag -> a option = fun (Dyn(tag',x)) tag -> match eq tag tag' with | None -> None | Some CSig.Refl -> Some x end end coq-8.20.0/clib/dyn.mli000066400000000000000000000062221466560755400146150ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* 'a value -> t -> t val remove : 'a key -> t -> t val find : 'a key -> t -> 'a value val mem : 'a key -> t -> bool val modify : 'a key -> ('a value -> 'a value) -> t -> t type map = { map : 'a. 'a key -> 'a value -> 'a value } val map : map -> t -> t type any = Any : 'a key * 'a value -> any val iter : (any -> unit) -> t -> unit val fold : (any -> 'r -> 'r) -> t -> 'r -> 'r type filter = { filter : 'a. 'a key -> 'a value -> bool } val filter : filter -> t -> t end module type S = sig type 'a tag (** Type of dynamic tags *) type t = Dyn : 'a tag * 'a -> t (** Type of dynamic values *) val create : string -> 'a tag (** [create n] returns a tag describing a type called [n]. [create] raises an exception if [n] is already registered. Type names are hashed, so [create] may raise even if no type with the exact same name was registered due to a collision. *) val eq : 'a tag -> 'b tag -> ('a, 'b) CSig.eq option (** [eq t1 t2] returns [Some witness] if [t1] is the same as [t2], [None] otherwise. *) val repr : 'a tag -> string (** [repr tag] returns the name of the type represented by [tag]. *) val dump : unit -> (int * string) list (** [dump ()] returns a list of (tag, name) pairs for every type tag registered in this [Dyn.Make] instance. *) type any = Any : 'a tag -> any (** Type of boxed dynamic tags *) val name : string -> any option (** [name n] returns [Some t] where t is a boxed tag previously registered with [create n], or [None] if there is no such tag. *) module Map(Value : ValueS) : MapS with type 'a key = 'a tag and type 'a value = 'a Value.t (** Map from type tags to values parameterized by the tag type *) module HMap (V1 : ValueS)(V2 : ValueS) : sig type map = { map : 'a. 'a tag -> 'a V1.t -> 'a V2.t } val map : map -> Map(V1).t -> Map(V2).t type filter = { filter : 'a. 'a tag -> 'a V1.t -> bool } val filter : filter -> Map(V1).t -> Map(V1).t end module Easy : sig (* To create a dynamic type on the fly *) val make_dyn_tag : string -> ('a -> t) * (t -> 'a) * 'a tag val make_dyn : string -> ('a -> t) * (t -> 'a) (* For types declared with the [create] function above *) val inj : 'a -> 'a tag -> t val prj : t -> 'a tag -> 'a option end end module Make () : S coq-8.20.0/clib/exninfo.ml000066400000000000000000000074241466560755400153250ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* 'a t (** Create a new piece of information. *) val null : info (** No information *) val add : info -> 'a t -> 'a -> info (** Add information to an exception. *) val get : info -> 'a t -> 'a option (** Get information worn by an exception. Returns [None] if undefined. *) val info : exn -> info (** Retrieve the information of the last exception raised. *) type backtrace val get_backtrace : info -> backtrace option (** [get_backtrace info] does get the backtrace associated to info *) val backtrace_to_string : backtrace -> string (** [backtrace_to_string info] does get the backtrace associated to info *) val record_backtrace : bool -> unit val capture : exn -> iexn (** Add the current backtrace information and other meta-data to the given exception. The intended use case is to re-raise an exception while preserving the meta-data: {[ try foo with | Bar -> bar | My_exn _ as exn -> let (exn, info) = Exninfo.capture err in ... let info = ... in Exninfo.iraise (exn, info) | exn when CErrors.noncritical exn -> let iexn = Exninfo.capture err in ... Exninfo.iraise iexn ]} where [baz] should re-raise using [iraise] below. WARNING: any intermediate code between the [with] and the handler may modify the backtrace. Yes, that includes [when] clauses. Ideally, what you should do is something like: {[ try foo with exn when CErrors.noncritical exn -> let (err, info) = Exninfo.capture exn in match err with | exception Bar -> ... | err -> ... ]} I admit that's a bit heavy, but there is not much to do... *) val iraise : iexn -> 'a (** Raise the given enriched exception. *) val reify : unit -> info coq-8.20.0/clib/hMap.ml000066400000000000000000000263501466560755400145430ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* t -> int val hash : t -> int end module SetMake(M : HashedType) = struct (** Hash Sets use hashes to prevent doing too many comparison tests. They associate to each hash the set of keys having that hash. Invariants: 1. There is no empty set in the intmap. 2. All values in the same set have the same hash, which is the int to which it is associated in the intmap. *) module Set = Set.Make(M) type elt = M.t type t = Set.t Int.Map.t let empty = Int.Map.empty let is_empty = Int.Map.is_empty let mem x s = if Int.Map.is_empty s then false else let h = M.hash x in try let m = Int.Map.find h s in Set.mem x m with Not_found -> false let add x s = let h = M.hash x in Int.Map.update h (function | None -> Some (Set.singleton x) | Some m -> Some (Set.add x m)) s let singleton x = let h = M.hash x in let m = Set.singleton x in Int.Map.singleton h m let remove x s = if Int.Map.is_empty s then s else let h = M.hash x in Int.Map.update h (function | None -> None | Some m -> let m = Set.remove x m in if Set.is_empty m then None else Some m) s let height s = Int.Map.height s let is_smaller s1 s2 = height s1 <= height s2 + 3 (** Assumes s1 << s2 *) let fast_union s1 s2 = let fold h s accu = try Int.Map.modify h (fun _ s' -> Set.fold Set.add s s') accu with Not_found -> Int.Map.add h s accu in Int.Map.fold fold s1 s2 let union s1 s2 = if is_smaller s1 s2 then fast_union s1 s2 else if is_smaller s2 s1 then fast_union s2 s1 else let fu _ m1 m2 = match m1, m2 with | None, None -> None | (Some _ as m), None | None, (Some _ as m) -> m | Some m1, Some m2 -> Some (Set.union m1 m2) in Int.Map.merge fu s1 s2 (** Assumes s1 << s2 *) let fast_inter s1 s2 = let fold h s accu = try let s' = Int.Map.find h s2 in let si = Set.filter (fun e -> Set.mem e s') s in if Set.is_empty si then accu else Int.Map.add h si accu with Not_found -> accu in Int.Map.fold fold s1 Int.Map.empty let inter s1 s2 = if is_smaller s1 s2 then fast_inter s1 s2 else if is_smaller s2 s1 then fast_inter s2 s1 else let fu _ m1 m2 = match m1, m2 with | None, None -> None | Some _, None | None, Some _ -> None | Some m1, Some m2 -> let m = Set.inter m1 m2 in if Set.is_empty m then None else Some m in Int.Map.merge fu s1 s2 (** Assumes s1 << s2 *) let fast_diff_l s1 s2 = let fold h s accu = try let s' = Int.Map.find h s2 in let si = Set.filter (fun e -> not (Set.mem e s')) s in if Set.is_empty si then accu else Int.Map.add h si accu with Not_found -> Int.Map.add h s accu in Int.Map.fold fold s1 Int.Map.empty (** Assumes s2 << s1 *) let fast_diff_r s1 s2 = let fold h s accu = try let s' = Int.Map.find h accu in let si = Set.filter (fun e -> not (Set.mem e s)) s' in if Set.is_empty si then Int.Map.remove h accu else Int.Map.set h si accu with Not_found -> accu in Int.Map.fold fold s2 s1 let diff s1 s2 = if is_smaller s1 s2 then fast_diff_l s1 s2 else if is_smaller s2 s2 then fast_diff_r s1 s2 else let fu _ m1 m2 = match m1, m2 with | None, None -> None | (Some _ as m), None -> m | None, Some _ -> None | Some m1, Some m2 -> let m = Set.diff m1 m2 in if Set.is_empty m then None else Some m in Int.Map.merge fu s1 s2 let compare s1 s2 = Int.Map.compare Set.compare s1 s2 let equal s1 s2 = Int.Map.equal Set.equal s1 s2 let subset s1 s2 = let check h m1 = let m2 = try Int.Map.find h s2 with Not_found -> Set.empty in Set.subset m1 m2 in Int.Map.for_all check s1 let iter f s = let fi _ m = Set.iter f m in Int.Map.iter fi s let fold f s accu = let ff _ m accu = Set.fold f m accu in Int.Map.fold ff s accu let for_all f s = let ff _ m = Set.for_all f m in Int.Map.for_all ff s let exists f s = let fe _ m = Set.exists f m in Int.Map.exists fe s let filter f s = let ff m = Set.filter f m in let s = Int.Map.map ff s in Int.Map.filter (fun _ m -> not (Set.is_empty m)) s let partition f s = let fold h m (sl, sr) = let (ml, mr) = Set.partition f m in let sl = if Set.is_empty ml then sl else Int.Map.add h ml sl in let sr = if Set.is_empty mr then sr else Int.Map.add h mr sr in (sl, sr) in Int.Map.fold fold s (Int.Map.empty, Int.Map.empty) let cardinal s = let fold _ m accu = accu + Set.cardinal m in Int.Map.fold fold s 0 let elements s = let fold _ m accu = Set.fold (fun x accu -> x :: accu) m accu in Int.Map.fold fold s [] let choose s = let (_, m) = Int.Map.choose s in Set.choose m end module Make(M : HashedType) = struct (** This module is essentially the same as SetMake, except that we have maps instead of sets in the intmap. Invariants are the same. *) module Set = SetMake(M) module Map = CMap.Make(M) type key = M.t type 'a t = 'a Map.t Int.Map.t let empty = Int.Map.empty let is_empty = Int.Map.is_empty let mem k s = if Int.Map.is_empty s then false else let h = M.hash k in try let m = Int.Map.find h s in Map.mem k m with Not_found -> false let add k x s = let h = M.hash k in Int.Map.update h (function | None -> Some (Map.singleton k x) | Some m -> Some (Map.add k x m)) s let singleton k x = let h = M.hash k in Int.Map.singleton h (Map.singleton k x) let remove k s = if Int.Map.is_empty s then s else let h = M.hash k in Int.Map.update h (function | None -> None | Some m -> let m = Map.remove k m in if Map.is_empty m then None else Some m) s let merge f s1 s2 = let fm h m1 m2 = match m1, m2 with | None, None -> None | Some m, None -> let m = Map.merge f m Map.empty in if Map.is_empty m then None else Some m | None, Some m -> let m = Map.merge f Map.empty m in if Map.is_empty m then None else Some m | Some m1, Some m2 -> let m = Map.merge f m1 m2 in if Map.is_empty m then None else Some m in Int.Map.merge fm s1 s2 let union f s1 s2 = let fm h m1 m2 = let m = Map.union f m1 m2 in if Map.is_empty m then None else Some m in Int.Map.union fm s1 s2 let compare f s1 s2 = let fc m1 m2 = Map.compare f m1 m2 in Int.Map.compare fc s1 s2 let equal f s1 s2 = let fe m1 m2 = Map.equal f m1 m2 in Int.Map.equal fe s1 s2 let iter f s = let fi _ m = Map.iter f m in Int.Map.iter fi s let fold f s accu = let ff _ m accu = Map.fold f m accu in Int.Map.fold ff s accu let for_all f s = let ff _ m = Map.for_all f m in Int.Map.for_all ff s let exists f s = let fe _ m = Map.exists f m in Int.Map.exists fe s let filter f s = let ff m = Map.filter f m in let s = Int.Map.map ff s in Int.Map.filter (fun _ m -> not (Map.is_empty m)) s let filter_map f s = let ff m = Map.filter_map f m in let s = Int.Map.map ff s in Int.Map.filter (fun _ m -> not (Map.is_empty m)) s let partition f s = let fold h m (sl, sr) = let (ml, mr) = Map.partition f m in let sl = if Map.is_empty ml then sl else Int.Map.add h ml sl in let sr = if Map.is_empty mr then sr else Int.Map.add h mr sr in (sl, sr) in Int.Map.fold fold s (Int.Map.empty, Int.Map.empty) let cardinal s = let fold _ m accu = accu + Map.cardinal m in Int.Map.fold fold s 0 let bindings s = let fold _ m accu = Map.fold (fun k x accu -> (k, x) :: accu) m accu in Int.Map.fold fold s [] let choose s = let (_, m) = Int.Map.choose s in Map.choose m let choose_opt s = try Some (choose s) with Not_found -> None let find k s = if Int.Map.is_empty s then raise Not_found else let h = M.hash k in let m = Int.Map.find h s in Map.find k m let find_opt k s = if Int.Map.is_empty s then None else let h = M.hash k in match Int.Map.find_opt h s with | None -> None | Some m -> Map.find_opt k m let get k s = let h = M.hash k in let m = Int.Map.get h s in Map.get k m let map f s = let fs m = Map.map f m in Int.Map.map fs s let mapi f s = let fs m = Map.mapi f m in Int.Map.map fs s let modify k f s = if Int.Map.is_empty s then raise Not_found else let h = M.hash k in Int.Map.modify h (fun _ m -> Map.modify k f m) s let bind f s = let fb m = Map.bind f m in Int.Map.map fb s let domain s = Int.Map.map Map.domain s let set k x s = if Int.Map.is_empty s then raise Not_found else let h = M.hash k in Int.Map.modify h (fun _ m -> Map.set k x m) s module Smart = struct let map f s = let fs m = Map.Smart.map f m in Int.Map.Smart.map fs s let mapi f s = let fs m = Map.Smart.mapi f m in Int.Map.Smart.map fs s end let height s = Int.Map.height s (* Not as efficient as the original version *) let filter_range f s = filter (fun x _ -> f x = 0) s let of_list l = let fold accu (x, v) = add x v accu in List.fold_left fold empty l let update k f m = if Int.Map.is_empty m then begin match f None with | None -> m | Some v -> singleton k v end else let aux = function | None -> (match f None with | None -> None | Some v -> Some (Map.singleton k v)) | Some m -> let m = Map.update k f m in if Map.is_empty m then None else Some m in Int.Map.update (M.hash k) aux m module Monad(M : CMap.MonadS) = struct module IntM = Int.Map.Monad(M) module ExtM = Map.Monad(M) let fold f s accu = let ff _ m accu = ExtM.fold f m accu in IntM.fold ff s accu let mapi f s = IntM.mapi (fun _ m -> ExtM.mapi f m) s end let symmetric_diff_fold f lm rm acc = Int.Map.symmetric_diff_fold (fun _ l r -> match l, r with | Some m, None -> Map.fold (fun k v acc -> f k (Some v) None acc) m | None, Some m -> Map.fold (fun k v acc -> f k None (Some v) acc) m | Some lm, Some rm -> Map.symmetric_diff_fold f lm rm | None, None -> assert false) lm rm acc end coq-8.20.0/clib/hMap.mli000066400000000000000000000024541466560755400147130ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* t -> int (** Total ordering *) val hash : t -> int (** Hashing function compatible with [compare], i.e. [compare x y = 0] implies [hash x = hash y]. *) end (** Hash maps are maps that take advantage of having a hash on keys. This is essentially a hash table, except that it uses purely functional maps instead of arrays. CAVEAT: order-related functions like [fold] or [iter] do not respect the provided order anymore! It's your duty to do something sensible to prevent this if you need it. *) module Make(M : HashedType) : CMap.UExtS with type key = M.t coq-8.20.0/clib/hashcons.ml000066400000000000000000000103141466560755400154550ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* t1)*(t2->t2)*...). * [hashcons u x] is a function that hash-cons the sub-structures of x using * the hash-consing functions u provides. * [eq] is a comparison function. It is allowed to use physical equality * on the sub-terms hash-consed by the hashcons function. * [hash] is the hash function given to the Hashtbl.Make function * * Note that this module type coerces to the argument of Hashtbl.Make. *) module type HashconsedType = sig type t type u val hashcons : u -> t -> t val eq : t -> t -> bool val hash : t -> int end (** The output is a function [generate] such that [generate args] creates a hash-table of the hash-consed objects, together with [hcons], a function taking a table and an object, and hashcons it. For simplicity of use, we use the wrapper functions defined below. *) module type S = sig type t type u type table val generate : u -> table val hcons : table -> t -> t val stats : table -> Hashset.statistics end module Make (X : HashconsedType) : (S with type t = X.t and type u = X.u) = struct type t = X.t type u = X.u (* We create the type of hashtables for t, with our comparison fun. * An invariant is that the table never contains two entries equals * w.r.t (=), although the equality on keys is X.eq. This is * granted since we hcons the subterms before looking up in the table. *) module Htbl = Hashset.Make(X) type table = (Htbl.t * u) let generate u = let tab = Htbl.create 97 in (tab, u) let hcons (tab, u) x = let y = X.hashcons u x in Htbl.repr (X.hash y) y tab let stats (tab, _) = Htbl.stats tab end (* A few useful wrappers: * takes as argument the function [generate] above and build a function of type * u -> t -> t that creates a fresh table each time it is applied to the * sub-hcons functions. *) (* For non-recursive types it is quite easy. *) let simple_hcons h f u = let table = h u in fun x -> f table x (* Basic hashcons modules for string and obj. Integers do not need be hashconsed. *) module type HashedType = sig type t val hash : t -> int end (* list *) module Hlist (D:HashedType) = struct module X = struct type t = D.t list let eq l1 l2 = l1 == l2 || match l1, l2 with | [], [] -> true | x1::l1, x2::l2 -> x1==x2 && l1==l2 | _ -> false end type t = X.t type u = (D.t -> D.t) module Htbl = Hashset.Make(X) type table = (Htbl.t * u) let generate u = let tab = Htbl.create 97 in (tab, u) let rec hcons (tab, hdata as data) l = let h, l = match l with | [] -> 0, [] | x :: l -> let h, l = hcons data l in let h = Hashset.Combine.combine (D.hash x) h in h, hdata x :: l in h, Htbl.repr h l tab let hcons data l = snd (hcons data l) let stats (tab, _) = Htbl.stats tab end (* string *) module Hstring = Make( struct type t = string type u = unit let hashcons () s =(* incr accesstr;*) s let eq = String.equal (** Copy from CString *) let rec hash len s i accu = if i = len then accu else let c = Char.code (String.unsafe_get s i) in hash len s (succ i) (accu * 19 + c) let hash s = let len = String.length s in hash len s 0 0 end) coq-8.20.0/clib/hashcons.mli000066400000000000000000000066661466560755400156450ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* t -> t (** The actual hashconsing function, using its fist argument to recursively hashcons substructures. It should be compatible with [eq], that is [eq x (hashcons f x) = true]. *) val eq : t -> t -> bool (** A comparison function. It is allowed to use physical equality on the sub-terms hashconsed by the [hashcons] function, but it should be insensible to shallow copy of the compared object. *) val hash : t -> int (** A hash function passed to the underlying hashtable structure. [hash] should be compatible with [eq], i.e. if [eq x y = true] then [hash x = hash y]. *) end module type S = sig type t (** Type of objects to hashcons. *) type u (** Type of hashcons functions for the sub-structures contained in [t]. *) type table (** Type of hashconsing tables *) val generate : u -> table (** This create a hashtable of the hashconsed objects. *) val hcons : table -> t -> t (** Perform the hashconsing of the given object within the table. *) val stats : table -> Hashset.statistics (** Recover statistics of the hashconsing table. *) end module Make (X : HashconsedType) : (S with type t = X.t and type u = X.u) (** Create a new hashconsing, given canonicalization functions. *) (** {6 Wrappers} *) (** These are intended to be used together with instances of the [Make] functor. *) val simple_hcons : ('u -> 'tab) -> ('tab -> 't -> 't) -> 'u -> 't -> 't (** [simple_hcons f sub obj] creates a new table each time it is applied to any sub-hash function [sub]. *) (** {6 Hashconsing of usual structures} *) module type HashedType = sig type t val hash : t -> int end module Hstring : (S with type t = string and type u = unit) (** Hashconsing of strings. *) module Hlist (D:HashedType) : (S with type t = D.t list and type u = (D.t->D.t)) (** Hashconsing of lists. *) coq-8.20.0/clib/hashset.ml000066400000000000000000000172611466560755400153160ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* t -> bool end type statistics = { num_bindings: int; num_buckets: int; max_bucket_length: int; bucket_histogram: int array } module type S = sig type elt type t val create : int -> t val clear : t -> unit val repr : int -> elt -> t -> elt val stats : t -> statistics end module Make (E : EqType) = struct type elt = E.t let emptybucket = Weak.create 0 type t = { mutable table : elt Weak.t array; mutable hashes : int array array; mutable limit : int; (* bucket size limit *) mutable oversize : int; (* number of oversize buckets *) mutable rover : int; (* for internal bookkeeping *) } let get_index t h = (h land max_int) mod (Array.length t) let limit = 7 let over_limit = 2 let create sz = let sz = if sz < 7 then 7 else sz in let sz = if sz > Sys.max_array_length then Sys.max_array_length else sz in { table = Array.make sz emptybucket; hashes = Array.make sz [| |]; limit = limit; oversize = 0; rover = 0; } let clear t = for i = 0 to Array.length t.table - 1 do t.table.(i) <- emptybucket; t.hashes.(i) <- [| |]; done; t.limit <- limit; t.oversize <- 0 let iter_weak f t = let rec iter_bucket i j b = if i >= Weak.length b then () else match Weak.check b i with | true -> f b t.hashes.(j) i; iter_bucket (i+1) j b | false -> iter_bucket (i+1) j b in for i = 0 to pred (Array.length t.table) do iter_bucket 0 i (Array.unsafe_get t.table i) done let rec count_bucket i b accu = if i >= Weak.length b then accu else count_bucket (i+1) b (accu + (if Weak.check b i then 1 else 0)) let min x y = if x - y < 0 then x else y let next_sz n = min (3 * n / 2 + 3) Sys.max_array_length let prev_sz n = ((n - 3) * 2 + 2) / 3 let test_shrink_bucket t = let bucket = t.table.(t.rover) in let hbucket = t.hashes.(t.rover) in let len = Weak.length bucket in let prev_len = prev_sz len in let live = count_bucket 0 bucket 0 in if live <= prev_len then begin let rec loop i j = if j >= prev_len then begin if Weak.check bucket i then loop (i + 1) j else if Weak.check bucket j then begin Weak.blit bucket j bucket i 1; hbucket.(i) <- hbucket.(j); loop (i + 1) (j - 1); end else loop i (j - 1); end; in loop 0 (Weak.length bucket - 1); if prev_len = 0 then begin t.table.(t.rover) <- emptybucket; t.hashes.(t.rover) <- [| |]; end else begin let newbucket = Weak.create prev_len in Weak.blit bucket 0 newbucket 0 prev_len; t.table.(t.rover) <- newbucket; t.hashes.(t.rover) <- Array.sub hbucket 0 prev_len end; if len > t.limit && prev_len <= t.limit then t.oversize <- t.oversize - 1; end; t.rover <- (t.rover + 1) mod (Array.length t.table) let rec resize t = let oldlen = Array.length t.table in let newlen = next_sz oldlen in if newlen > oldlen then begin let newt = create newlen in let add_weak ob oh oi = let setter nb ni _ = Weak.blit ob oi nb ni 1 in let h = oh.(oi) in add_aux newt setter None h (get_index newt.table h); in iter_weak add_weak t; t.table <- newt.table; t.hashes <- newt.hashes; t.limit <- newt.limit; t.oversize <- newt.oversize; t.rover <- t.rover mod Array.length newt.table; end else begin t.limit <- max_int; (* maximum size already reached *) t.oversize <- 0; end and add_aux t setter d h index = let bucket = t.table.(index) in let hashes = t.hashes.(index) in let sz = Weak.length bucket in let rec loop i = if i >= sz then begin let newsz = min (3 * sz / 2 + 3) (Sys.max_array_length - 1) in if newsz <= sz then failwith "Weak.Make: hash bucket cannot grow more"; let newbucket = Weak.create newsz in let newhashes = Array.make newsz 0 in Weak.blit bucket 0 newbucket 0 sz; Array.blit hashes 0 newhashes 0 sz; setter newbucket sz d; newhashes.(sz) <- h; t.table.(index) <- newbucket; t.hashes.(index) <- newhashes; if sz <= t.limit && newsz > t.limit then begin t.oversize <- t.oversize + 1; for _i = 0 to over_limit do test_shrink_bucket t done; end; if t.oversize > Array.length t.table / over_limit then resize t end else if Weak.check bucket i then begin loop (i + 1) end else begin setter bucket i d; hashes.(i) <- h end in loop 0 external unsafe_weak_get : 'a Weak.t -> int -> 'a option = "caml_weak_get" let repr h d t = let table = t.table in let index = get_index table h in let bucket = Array.unsafe_get table index in let hashes = Array.unsafe_get t.hashes index in let sz = Weak.length bucket in let pos = ref 0 in let ans = ref None in while !pos < sz && !ans == None do let i = !pos in if Int.equal h (Array.unsafe_get hashes i) then begin match unsafe_weak_get bucket i with | Some v as res when E.eq v d -> ans := res | _ -> incr pos end else incr pos done; match !ans with | Some v -> v | None -> let () = add_aux t Weak.set (Some d) h index in d let stats t = let fold accu bucket = max (count_bucket 0 bucket 0) accu in let max_length = Array.fold_left fold 0 t.table in let histogram = Array.make (max_length + 1) 0 in let iter bucket = let len = count_bucket 0 bucket 0 in histogram.(len) <- succ histogram.(len) in let () = Array.iter iter t.table in let fold (num, len, i) k = (num + k * i, len + k, succ i) in let (num, len, _) = Array.fold_left fold (0, 0, 0) histogram in { num_bindings = num; num_buckets = len; max_bucket_length = Array.length histogram; bucket_histogram = histogram; } end module Combine = struct (* These are helper functions to combine the hash keys in a similar way as [Hashtbl.hash] does. The constants [alpha] and [beta] must be prime numbers. There were chosen empirically. Notice that the problem of hashing trees is hard and there are plenty of study on this topic. Therefore, there must be room for improvement here. *) let alpha = 65599 let beta = 7 let combine x y = x * alpha + y let combine3 x y z = combine x (combine y z) let combine4 x y z t = combine x (combine3 y z t) let combine5 x y z t u = combine x (combine4 y z t u) let combinesmall x y = beta * x + y end coq-8.20.0/clib/hashset.mli000066400000000000000000000042141466560755400154610ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* t -> bool end type statistics = { num_bindings: int; num_buckets: int; max_bucket_length: int; bucket_histogram: int array } module type S = sig type elt (** Type of hashsets elements. *) type t (** Type of hashsets. *) val create : int -> t (** [create n] creates a fresh hashset with initial size [n]. *) val clear : t -> unit (** Clear the contents of a hashset. *) val repr : int -> elt -> t -> elt (** [repr key constr set] uses [key] to look for [constr] in the hashet [set]. If [constr] is in [set], returns the specific representation that is stored in [set]. Otherwise, [constr] is stored in [set] and will be used as the canonical representation of this value in the future. *) val stats : t -> statistics (** Recover statistics on the table. *) end module Make (E : EqType) : S with type elt = E.t module Combine : sig val combine : int -> int -> int val combinesmall : int -> int -> int val combine3 : int -> int -> int -> int val combine4 : int -> int -> int -> int -> int val combine5 : int -> int -> int -> int -> int -> int end coq-8.20.0/clib/heap.ml000066400000000000000000000071551466560755400145750ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* t -> int end module type S =sig (* Type of functional heaps *) type t (* Type of elements *) type elt (* The empty heap *) val empty : t (* [add x h] returns a new heap containing the elements of [h], plus [x]; complexity $O(log(n))$ *) val add : elt -> t -> t (* [maximum h] returns the maximum element of [h]; raises [EmptyHeap] when [h] is empty; complexity $O(1)$ *) val maximum : t -> elt (* [remove h] returns a new heap containing the elements of [h], except the maximum of [h]; raises [EmptyHeap] when [h] is empty; complexity $O(log(n))$ *) val remove : t -> t (* usual iterators and combinators; elements are presented in arbitrary order *) val iter : (elt -> unit) -> t -> unit val fold : (elt -> 'a -> 'a) -> t -> 'a -> 'a end exception EmptyHeap (*s Functional implementation *) module Functional(X : Ordered) = struct (* Heaps are encoded as Braun trees, that are binary trees where size r <= size l <= size r + 1 for each node Node (l, x, r) *) type t = | Leaf | Node of t * X.t * t type elt = X.t let empty = Leaf let rec add x = function | Leaf -> Node (Leaf, x, Leaf) | Node (l, y, r) -> if X.compare x y >= 0 then Node (add y r, x, l) else Node (add x r, y, l) let rec extract = function | Leaf -> assert false | Node (Leaf, y, r) -> assert (r = Leaf); y, Leaf | Node (l, y, r) -> let x, l = extract l in x, Node (r, y, l) let is_above x = function | Leaf -> true | Node (_, y, _) -> X.compare x y >= 0 let rec replace_min x = function | Node (l, _, r) when is_above x l && is_above x r -> Node (l, x, r) | Node ((Node (_, lx, _) as l), _, r) when is_above lx r -> (* lx <= x, rx necessarily *) Node (replace_min x l, lx, r) | Node (l, _, (Node (_, rx, _) as r)) -> (* rx <= x, lx necessarily *) Node (l, rx, replace_min x r) | Leaf | Node (Leaf, _, _) | Node (_, _, Leaf) -> assert false (* merges two Braun trees [l] and [r], with the assumption that [size r <= size l <= size r + 1] *) let rec merge l r = match l, r with | _, Leaf -> l | Node (ll, lx, lr), Node (_, ly, _) -> if X.compare lx ly >= 0 then Node (r, lx, merge ll lr) else let x, l = extract l in Node (replace_min x r, ly, l) | Leaf, _ -> assert false (* contradicts the assumption *) let maximum = function | Leaf -> raise EmptyHeap | Node (_, x, _) -> x let remove = function | Leaf -> raise EmptyHeap | Node (l, _, r) -> merge l r let rec iter f = function | Leaf -> () | Node (l, x, r) -> iter f l; f x; iter f r let rec fold f h x0 = match h with | Leaf -> x0 | Node (l, x, r) -> fold f l (fold f r (f x x0)) end coq-8.20.0/clib/heap.mli000066400000000000000000000032531466560755400147410ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* t -> int end module type S =sig (** Type of functional heaps *) type t (** Type of elements *) type elt (** The empty heap *) val empty : t (** [add x h] returns a new heap containing the elements of [h], plus [x]; complexity {% $ %}O(log(n)){% $ %} *) val add : elt -> t -> t (** [maximum h] returns the maximum element of [h]; raises [EmptyHeap] when [h] is empty; complexity {% $ %}O(1){% $ %} *) val maximum : t -> elt (** [remove h] returns a new heap containing the elements of [h], except the maximum of [h]; raises [EmptyHeap] when [h] is empty; complexity {% $ %}O(log(n)){% $ %} *) val remove : t -> t (** usual iterators and combinators; elements are presented in arbitrary order *) val iter : (elt -> unit) -> t -> unit val fold : (elt -> 'a -> 'a) -> t -> 'a -> 'a end exception EmptyHeap (** {6 Functional implementation. } *) module Functional(X: Ordered) : S with type elt=X.t coq-8.20.0/clib/iStream.ml000066400000000000000000000042411466560755400152550ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* Nil | Cons (x,s) -> app_node (peek (f x)) (concat_map f s) and concat_map f l = lazy (concat_map_node f (peek l)) coq-8.20.0/clib/iStream.mli000066400000000000000000000044371466560755400154350ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* 'a t -> 'a t (** Append an element in front of a stream. *) val thunk : (unit -> 'a node) -> 'a t (** Internalize the laziness of a stream. *) (** {6 Destructors} *) val is_empty : 'a t -> bool (** Whethere a stream is empty. *) val peek : 'a t -> 'a node (** Return the head and the tail of a stream, if any. *) (** {6 Standard operations} All stream-returning functions are lazy. The other ones are eager. *) val app : 'a t -> 'a t -> 'a t (** Append two streams. Not tail-rec. *) val map : ('a -> 'b) -> 'a t -> 'b t (** Mapping of streams. Not tail-rec. *) val iter : ('a -> unit) -> 'a t -> unit (** Iteration over streams. *) val fold : ('a -> 'b -> 'a) -> 'a -> 'b t -> 'a (** Fold over streams. *) val concat : 'a t t -> 'a t (** Appends recursively a stream of streams. *) val map_filter : ('a -> 'b option) -> 'a t -> 'b t (** Mixing [map] and [filter]. Not tail-rec. *) val concat_map : ('a -> 'b t) -> 'a t -> 'b t (** [concat_map f l] is the same as [concat (map f l)]. *) (** {6 Conversions} *) val of_list : 'a list -> 'a t (** Convert a list into a stream. *) val to_list : 'a t -> 'a list (** Convert a stream into a list. *) (** {6 Other}*) val force : 'a t -> 'a t (** Forces the whole stream. *) coq-8.20.0/clib/int.ml000066400000000000000000000153611466560755400144500ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* int -> bool = "%eq" external compare : int -> int -> int = "caml_int_compare" let hash i = i land 0x3FFFFFFF module Self = struct type t = int let compare = compare end module Set = Set.Make(Self) module Map = struct include CMap.Make(Self) type 'a map = 'a CMap.Make(Self).t type 'a _map = | MEmpty | MNode of {l:'a map; v:int; d:'a; r:'a map; h:int} let map_prj : 'a map -> 'a _map = Obj.magic let map_inj : 'a _map -> 'a map = Obj.magic let rec find i s = match map_prj s with | MEmpty -> raise Not_found | MNode {l; v; d; r; h} -> if i < v then find i l else if i = v then d else find i r let rec get i s = match map_prj s with | MEmpty -> assert false | MNode {l; v; d; r; h} -> if i < v then get i l else if i = v then d else get i r let rec find_opt i s = match map_prj s with | MEmpty -> None | MNode {l; v; d; r; h} -> if i < v then find_opt i l else if i = v then Some d else find_opt i r let rec set k v (s : 'a map) : 'a map = match map_prj s with | MEmpty -> raise Not_found | MNode {l; v=k'; d=v'; r; h} -> if k < k' then let l' = set k v l in if l == l' then s else map_inj (MNode {l=l'; v=k'; d=v'; r; h}) else if k = k' then if v' == v then s else map_inj (MNode {l; v=k'; d=v; r; h}) else let r' = set k v r in if r == r' then s else map_inj (MNode {l; v=k'; d=v'; r=r'; h}) let rec modify k f (s : 'a map) : 'a map = match map_prj s with | MEmpty -> raise Not_found | MNode {l; v; d; r; h} -> if k < v then let l' = modify k f l in if l == l' then s else map_inj (MNode {l=l'; v; d; r; h}) else if k = v then let d' = f v d in if d' == d then s else map_inj (MNode {l; v; d=d'; r; h}) else let r' = modify k f r in if r == r' then s else map_inj (MNode {l; v; d; r=r'; h}) end module List = struct let mem = List.memq let assoc = List.assq let mem_assoc = List.mem_assq let remove_assoc = List.remove_assq end let min (i : int) j = if i < j then i else j (** Utility function *) let rec next from upto = if from < upto then next (2 * from + 1) upto else from module PArray = struct type 'a t = 'a data ref and 'a data = | Root of 'a option array | DSet of int * 'a option * 'a t let empty n = ref (Root (Array.make n None)) let rec rerootk t k = match !t with | Root _ -> k () | DSet (i, v, t') -> let next () = match !t' with | Root a as n -> let v' = Array.unsafe_get a i in let () = Array.unsafe_set a i v in let () = t := n in let () = t' := DSet (i, v', t) in k () | DSet _ -> assert false in rerootk t' next let reroot t = rerootk t (fun () -> ()) let get t i = let () = assert (0 <= i) in match !t with | Root a -> if Array.length a <= i then None else Array.unsafe_get a i | DSet _ -> let () = reroot t in match !t with | Root a -> if Array.length a <= i then None else Array.unsafe_get a i | DSet _ -> assert false let set t i v = let () = assert (0 <= i) in let () = reroot t in match !t with | DSet _ -> assert false | Root a as n -> let len = Array.length a in if i < len then let old = Array.unsafe_get a i in if old == v then t else let () = Array.unsafe_set a i v in let res = ref n in let () = t := DSet (i, old, res) in res else match v with | None -> t (* Nothing to do! *) | Some _ -> (* we must resize *) let nlen = next len (succ i) in let nlen = min nlen Sys.max_array_length in let () = assert (i < nlen) in let a' = Array.make nlen None in let () = Array.blit a 0 a' 0 len in let () = Array.unsafe_set a' i v in let res = ref (Root a') in let () = t := DSet (i, None, res) in res end module PMap = struct type key = int (** Invariants: 1. an empty map is always [Empty]. 2. the set of the [Map] constructor remembers the present keys. *) type 'a t = Empty | Map of Set.t * 'a PArray.t let empty = Empty let is_empty = function | Empty -> true | Map _ -> false let singleton k x = let len = next 19 (k + 1) in let len = min Sys.max_array_length len in let v = PArray.empty len in let v = PArray.set v k (Some x) in let s = Set.singleton k in Map (s, v) let add k x = function | Empty -> singleton k x | Map (s, v) -> let s = match PArray.get v k with | None -> Set.add k s | Some _ -> s in let v = PArray.set v k (Some x) in Map (s, v) let remove k = function | Empty -> Empty | Map (s, v) -> let s = Set.remove k s in if Set.is_empty s then Empty else let v = PArray.set v k None in Map (s, v) let mem k = function | Empty -> false | Map (_, v) -> match PArray.get v k with | None -> false | Some _ -> true let find k = function | Empty -> raise Not_found | Map (_, v) -> match PArray.get v k with | None -> raise Not_found | Some x -> x let iter f = function | Empty -> () | Map (s, v) -> let iter k = match PArray.get v k with | None -> () | Some x -> f k x in Set.iter iter s let fold f m accu = match m with | Empty -> accu | Map (s, v) -> let fold k accu = match PArray.get v k with | None -> accu | Some x -> f k x accu in Set.fold fold s accu let exists f m = match m with | Empty -> false | Map (s, v) -> let exists k = match PArray.get v k with | None -> false | Some x -> f k x in Set.exists exists s let for_all f m = match m with | Empty -> true | Map (s, v) -> let for_all k = match PArray.get v k with | None -> true | Some x -> f k x in Set.for_all for_all s let cast = function | Empty -> Map.empty | Map (s, v) -> let bind k = match PArray.get v k with | None -> assert false | Some x -> x in Map.bind bind s let domain = function | Empty -> Set.empty | Map (s, _) -> s end coq-8.20.0/clib/int.mli000066400000000000000000000065141466560755400146210ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* t -> bool = "%eq" external compare : t -> t -> int = "caml_int_compare" val hash : t -> int module Set : Set.S with type elt = t module Map : CMap.ExtS with type key = t and module Set := Set module List : sig val mem : int -> int list -> bool val assoc : int -> (int * 'a) list -> 'a val mem_assoc : int -> (int * 'a) list -> bool val remove_assoc : int -> (int * 'a) list -> (int * 'a) list end module PArray : sig type 'a t (** Persistent, auto-resizable arrays. The [get] and [set] functions never fail whenever the index is between [0] and [Sys.max_array_length - 1]. *) val empty : int -> 'a t (** The empty array, with a given starting size. *) val get : 'a t -> int -> 'a option (** Get a value at the given index. Returns [None] if undefined. *) val set : 'a t -> int -> 'a option -> 'a t (** Set/unset a value at the given index. *) end module PMap : sig type key = int type 'a t val empty : 'a t val is_empty : 'a t -> bool val mem : key -> 'a t -> bool val add : key -> 'a -> 'a t -> 'a t val singleton : key -> 'a -> 'a t val remove : key -> 'a t -> 'a t (* val merge : (key -> 'a option -> 'b option -> 'c option) -> 'a t -> 'b t -> 'c t *) (* val compare : ('a -> 'a -> int) -> 'a t -> 'a t -> int *) (* val equal : ('a -> 'a -> bool) -> 'a t -> 'a t -> bool *) val iter : (key -> 'a -> unit) -> 'a t -> unit val fold : (key -> 'a -> 'b -> 'b) -> 'a t -> 'b -> 'b val for_all : (key -> 'a -> bool) -> 'a t -> bool val exists : (key -> 'a -> bool) -> 'a t -> bool (* val filter : (key -> 'a -> bool) -> 'a t -> 'a t *) (* val partition : (key -> 'a -> bool) -> 'a t -> 'a t * 'a t *) (* val cardinal : 'a t -> int *) (* val bindings : 'a t -> (key * 'a) list *) (* val min_binding : 'a t -> key * 'a *) (* val max_binding : 'a t -> key * 'a *) (* val choose : 'a t -> key * 'a *) (* val split : key -> 'a t -> 'a t * 'a option * 'a t *) val find : key -> 'a t -> 'a (* val map : ('a -> 'b) -> 'a t -> 'b t *) (* val mapi : (key -> 'a -> 'b) -> 'a t -> 'b t *) val domain : 'a t -> Set.t val cast : 'a t -> 'a Map.t end (** This is a (partial) implementation of a [Map] interface on integers, except that it internally uses persistent arrays. This ensures O(1) accesses in non-backtracking cases. It is thus better suited for zero-starting, contiguous keys, or otherwise a lot of space will be empty. To keep track of the present keys, a binary tree is also used, so that adding a key is still logarithmic. It is therefore essential that most of the operations are accesses and not add/removes. *) coq-8.20.0/clib/memprof_coq.memprof.ml000066400000000000000000000034141466560755400176250ustar00rootroot00000000000000(* From memprof_limits, see also https://gitlab.com/gadmm/memprof-limits/-/issues/7 *) let is_interrupted () = Memprof_limits.is_interrupted () [@@inline] module Resource_bind = Memprof_limits.Resource_bind (* Not exported by memprof limits :( *) (* module Thread_map = Memprof_limits.Thread_map *) (* module Mutex_aux = Memprof_limits.Mutex_aux *) (* We do our own Mutex_aux for OCaml 5.x *) module Mutex_aux = Mutex_aux module Thread_map_core = struct open Resource_bind module IMap = Map.Make ( struct type t = int let compare = Stdlib.compare end) type 'a t = { mutex : Mutex.t ; mutable map : 'a IMap.t } let create () = { mutex = Mutex.create () ; map = IMap.empty } let current_thread () = Thread.id (Thread.self ()) let get s = (* Concurrent threads do not alter the value for the current thread, so we do not need a lock. *) IMap.find_opt (current_thread ()) s.map (* For set and clear we need a lock *) let set s v = let& () = Mutex_aux.with_lock s.mutex in let new_map = match v with | None -> IMap.remove (current_thread ()) s.map | Some v -> IMap.add (current_thread ()) v s.map in s.map <- new_map let _clear s = let& () = Mutex_aux.with_lock s.mutex in s.map <- IMap.empty end module Masking = Memprof_limits.Masking module Thread_map = struct include Thread_map_core let with_value tls ~value ~scope = let old_value = get tls in (* FIXME: needs proper masking here as there is a race between resources and asynchronous exceptions. For now, it is exception-safe only for exceptions arising from Memprof_callbacks. *) Masking.with_resource ~acquire:(fun () -> set tls (Some value)) () ~scope ~release:(fun () -> set tls old_value) end coq-8.20.0/clib/memprof_coq.mli000066400000000000000000000024221466560755400163300ustar00rootroot00000000000000(* From memprof-limits *) val is_interrupted : unit -> bool module Masking : sig val with_resource : acquire:('a -> 'b) -> 'a -> scope:('b -> 'c) -> release:('b -> unit) -> 'c val is_blocked : unit -> bool val assert_blocked : unit -> unit end module Thread_map : sig (** An async-safe, scoped thread-local store *) type 'a t val create : unit -> 'a t (** Create an empty map *) val with_value : 'a t -> value:'a -> scope:(unit -> 'b) -> 'b (** Associate [~value] to the current thread for the duration of a scope. It can be nested: the previous association is restored on exit. *) val get : 'a t -> 'a option (** Get the value currently associated with the current thread. *) end module Resource_bind : sig (** Open {!Memprof_limits.Resource_bind} to enable the [let&] binder for resources. *) val ( let& ) : (scope:('a -> 'b) -> 'b) -> ('a -> 'b) -> 'b (** RAII-style notation for resources cleaned-up at the end of scope. Example: {[open Memprof_limits.Resource_bind let with_my_resource x = Memprof_limits.Masking.with_resource ~acquire x ~release let f x = let& resource = with_my_resource x in …]} *) end module Mutex_aux : sig val with_lock : Mutex.t -> scope:(unit -> 'a) -> 'a end coq-8.20.0/clib/memprof_coq.std.ml000066400000000000000000000070441466560755400167550ustar00rootroot00000000000000let is_interrupted _ = false [@@inline] module Resource_bind = struct let ( let& ) f scope = f ~scope end (* We do our own Mutex_aux for OCaml 5.x *) module Mutex_aux = Mutex_aux module Thread_map_core = struct open Resource_bind module IMap = Map.Make ( struct type t = int let compare = Stdlib.compare end) type 'a t = { mutex : Mutex.t ; mutable map : 'a IMap.t } let create () = { mutex = Mutex.create () ; map = IMap.empty } let current_thread () = Thread.id (Thread.self ()) let get s = (* Concurrent threads do not alter the value for the current thread, so we do not need a lock. *) IMap.find_opt (current_thread ()) s.map (* For set and clear we need a lock *) let set s v = let& () = Mutex_aux.with_lock s.mutex in let new_map = match v with | None -> IMap.remove (current_thread ()) s.map | Some v -> IMap.add (current_thread ()) v s.map in s.map <- new_map let _clear s = let& () = Mutex_aux.with_lock s.mutex in s.map <- IMap.empty end module Masking = struct module T = Thread_map_core type mask = { mutable on : bool } let mask_tls : mask T.t = T.create () (* whether the current thread is masked *) let create_mask () = let r = { on = false } in T.set mask_tls (Some r) ; r let delete_mask () = T.set mask_tls None let is_blocked () = match T.get mask_tls with | None -> false | Some r -> r.on let assert_blocked () = assert (is_blocked ()) (* The current goal is only to protect from those asynchronous exceptions raised after dutifully checking that [is_blocked ()] evaluates to false, and that expect the asynchronous callback to be called again shortly thereafter (e.g. memprof callbacks). There is currently no mechanism to delay asynchronous callbacks, so this strategy cannot work for other kinds of asynchronous callbacks. *) let with_resource ~acquire arg ~scope ~(release : _ -> unit) = let mask, delete_after = match T.get mask_tls with | None -> create_mask (), true | Some r -> r, false in let old_mask = mask.on in let remove_mask () = (* remove the mask flag from the TLS to avoid it growing uncontrollably when there are lots of threads. *) if delete_after then delete_mask () else mask.on <- old_mask in let release_and_unmask r x = match release r with | () -> remove_mask () ; x | exception e -> remove_mask () ; raise e in mask.on <- true ; let r = try acquire arg with | e -> mask.on <- old_mask ; raise e in match mask.on <- old_mask ; scope r with | (* BEGIN ATOMIC *) y -> ( mask.on <- true ; (* END ATOMIC *) release_and_unmask r y ) | (* BEGIN ATOMIC *) exception e -> ( mask.on <- true ; (* END ATOMIC *) match Printexc.get_raw_backtrace () with | bt -> ( let e = release_and_unmask r e in Printexc.raise_with_backtrace e bt ) | exception Out_of_memory -> raise (release_and_unmask r e) ) end module Thread_map = struct include Thread_map_core let with_value tls ~value ~scope = let old_value = get tls in (* FIXME: needs proper masking here as there is a race between resources and asynchronous exceptions. For now, it is exception-safe only for exceptions arising from Memprof_callbacks. *) Masking.with_resource ~acquire:(fun () -> set tls (Some value)) () ~scope ~release:(fun () -> set tls old_value) end coq-8.20.0/clib/monad.ml000066400000000000000000000117221466560755400147510ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* 'a t val (>>=) : 'a t -> ('a -> 'b t) -> 'b t val (>>) : unit t -> 'a t -> 'a t val map : ('a -> 'b) -> 'a t -> 'b t (** The monadic laws must hold: - [(x>>=f)>>=g] = [x>>=fun x' -> (f x'>>=g)] - [return a >>= f] = [f a] - [x>>=return] = [x] As well as the following identities: - [x >> y] = [x >>= fun () -> y] - [map f x] = [x >>= fun x' -> f x'] *) end module type ListS = sig type 'a t (** [List.map f l] maps [f] on the elements of [l] in left to right order. *) val map : ('a -> 'b t) -> 'a list -> 'b list t (** [List.map f l] maps [f] on the elements of [l] in right to left order. *) val map_right : ('a -> 'b t) -> 'a list -> 'b list t (** Like the regular [List.fold_right]. The monadic effects are threaded right to left. Note: many monads behave poorly with right-to-left order. For instance a failure monad would still have to traverse the whole list in order to fail and failure needs to be propagated through the rest of the list in binds which are now spurious. It is also the worst case for substitution monads (aka free monads), exposing the quadratic behaviour.*) val fold_right : ('a -> 'b -> 'b t) -> 'a list -> 'b -> 'b t (** Like the regular [List.fold_left]. The monadic effects are threaded left to right. It is tail-recursive if the [(>>=)] operator calls its second argument in a tail position. *) val fold_left : ('a -> 'b -> 'a t) -> 'a -> 'b list -> 'a t (** Like the regular [List.iter]. The monadic effects are threaded left to right. It is tail-recurisve if the [>>] operator calls its second argument in a tail position. *) val iter : ('a -> unit t) -> 'a list -> unit t (** Like the regular {!CList.map_filter}. The monadic effects are threaded left*) val map_filter : ('a -> 'b option t) -> 'a list -> 'b list t (** {6 Two-list iterators} *) (** [fold_left2 r f s l1 l2] behaves like {!fold_left} but acts simultaneously on two lists. Runs [r] (presumably an exception-raising computation) if both lists do not have the same length. *) val fold_left2 : 'a t -> ('a -> 'b -> 'c -> 'a t) -> 'a -> 'b list -> 'c list -> 'a t end module type S = sig include Def (** List combinators *) module List : ListS with type 'a t := 'a t end module Make (M:Def) : S with type +'a t = 'a M.t = struct include M module List = struct (* The combinators are loop-unrolled to spare a some monadic binds (it is a common optimisation to treat the last of a list of bind specially) and hopefully gain some efficiency using fewer jump. *) let rec map f = function | [] -> return [] | [a] -> M.map (fun a' -> [a']) (f a) | a::b::l -> f a >>= fun a' -> f b >>= fun b' -> M.map (fun l' -> a'::b'::l') (map f l) let rec map_right f = function | [] -> return [] | [a] -> M.map (fun a' -> [a']) (f a) | a::b::l -> map_right f l >>= fun l' -> f b >>= fun b' -> M.map (fun a' -> a'::b'::l') (f a) let rec fold_right f l x = match l with | [] -> return x | [a] -> f a x | a::b::l -> fold_right f l x >>= fun acc -> f b acc >>= fun acc -> f a acc let rec fold_left f x = function | [] -> return x | [a] -> f x a | a::b::l -> f x a >>= fun x' -> f x' b >>= fun x'' -> fold_left f x'' l let rec iter f = function | [] -> return () | [a] -> f a | a::b::l -> f a >> f b >> iter f l let rec map_filter f = function | [] -> return [] | a::l -> f a >>= function | None -> map_filter f l | Some b -> map_filter f l >>= fun filtered -> return (b::filtered) let rec fold_left2 r f x l1 l2 = match l1,l2 with | [] , [] -> return x | [a] , [b] -> f x a b | a1::a2::l1 , b1::b2::l2 -> f x a1 b1 >>= fun x' -> f x' a2 b2 >>= fun x'' -> fold_left2 r f x'' l1 l2 | _ , _ -> r end end coq-8.20.0/clib/monad.mli000066400000000000000000000064261466560755400151270ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* 'a t val (>>=) : 'a t -> ('a -> 'b t) -> 'b t val (>>) : unit t -> 'a t -> 'a t val map : ('a -> 'b) -> 'a t -> 'b t (** The monadic laws must hold: - [(x>>=f)>>=g] = [x>>=fun x' -> (f x'>>=g)] - [return a >>= f] = [f a] - [x>>=return] = [x] As well as the following identities: - [x >> y] = [x >>= fun () -> y] - [map f x] = [x >>= fun x' -> f x'] *) end (** List combinators *) module type ListS = sig type 'a t (** [List.map f l] maps [f] on the elements of [l] in left to right order. *) val map : ('a -> 'b t) -> 'a list -> 'b list t (** [List.map f l] maps [f] on the elements of [l] in right to left order. *) val map_right : ('a -> 'b t) -> 'a list -> 'b list t (** Like the regular [List.fold_right]. The monadic effects are threaded right to left. Note: many monads behave poorly with right-to-left order. For instance a failure monad would still have to traverse the whole list in order to fail and failure needs to be propagated through the rest of the list in binds which are now spurious. It is also the worst case for substitution monads (aka free monads), exposing the quadratic behaviour.*) val fold_right : ('a -> 'b -> 'b t) -> 'a list -> 'b -> 'b t (** Like the regular [List.fold_left]. The monadic effects are threaded left to right. It is tail-recursive if the [(>>=)] operator calls its second argument in a tail position. *) val fold_left : ('a -> 'b -> 'a t) -> 'a -> 'b list -> 'a t (** Like the regular [List.iter]. The monadic effects are threaded left to right. It is tail-recurisve if the [>>] operator calls its second argument in a tail position. *) val iter : ('a -> unit t) -> 'a list -> unit t (** Like the regular {!CList.map_filter}. The monadic effects are threaded left to right. *) val map_filter : ('a -> 'b option t) -> 'a list -> 'b list t (** {6 Two-list iterators} *) (** [fold_left2 r f s l1 l2] behaves like {!fold_left} but acts simultaneously on two lists. Runs [r] (presumably an exception-raising computation) if both lists do not have the same length. *) val fold_left2 : 'a t -> ('a -> 'b -> 'c -> 'a t) -> 'a -> 'b list -> 'c list -> 'a t end module type S = sig include Def module List : ListS with type 'a t := 'a t end (** Expands the monadic definition to extra combinators. *) module Make (M:Def) : S with type +'a t = 'a M.t coq-8.20.0/clib/mutex_aux.mli000066400000000000000000000000641466560755400160400ustar00rootroot00000000000000val with_lock : Mutex.t -> scope:(unit -> 'a) -> 'a coq-8.20.0/clib/mutex_aux_4.x.ml000066400000000000000000000011401466560755400163540ustar00rootroot00000000000000external unlock: Mutex.t -> unit = "caml_mutex_unlock" (* Critical sections : - Mutex.lock does not poll on leaving the blocking section since 4.12. - Never inline, to avoid theoretically-possible reorderings with flambda. - Inline the call to Mutex.unlock to avoid polling in bytecode. (workaround to the lack of masking) *) let[@inline never] with_lock m ~scope = let () = Mutex.lock m (* BEGIN ATOMIC *) in match (* END ATOMIC *) scope () with | (* BEGIN ATOMIC *) x -> unlock m ; (* END ATOMIC *) x | (* BEGIN ATOMIC *) exception e -> unlock m ; (* END ATOMIC *) raise e coq-8.20.0/clib/mutex_aux_5.0.ml000066400000000000000000000012221466560755400162460ustar00rootroot00000000000000(* backport of Mutex.protect from OCaml 5.1 *) external unlock: Mutex.t -> unit = "caml_ml_mutex_unlock" (* Critical sections : - Mutex.lock does not poll on leaving the blocking section since 4.12. - Never inline, to avoid theoretically-possible reorderings with flambda. - Inline the call to Mutex.unlock to avoid polling in bytecode. (workaround to the lack of masking) *) let[@inline never] with_lock m ~scope = let () = Mutex.lock m (* BEGIN ATOMIC *) in match (* END ATOMIC *) scope () with | (* BEGIN ATOMIC *) x -> unlock m ; (* END ATOMIC *) x | (* BEGIN ATOMIC *) exception e -> unlock m ; (* END ATOMIC *) raise e coq-8.20.0/clib/mutex_aux_5.x.ml000066400000000000000000000000571466560755400163630ustar00rootroot00000000000000let with_lock m ~scope = Mutex.protect m scope coq-8.20.0/clib/neList.ml000066400000000000000000000023711466560755400151110ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* None | y::tl -> Some (y,tl) let singleton x = x,[] let iter f (x,tl) = f x; List.iter f tl let map f (x,tl) = let x = f x in let tl = List.map f tl in x, tl let map2 f (x,tl) (x',tl') = let x = f x x' in let tl = List.map2 f tl tl' in x, tl let map_head f (x,tl) = f x, tl let push x = function | None -> x, [] | Some (y,tl) -> x, y::tl let to_list (x,tl) = x::tl let of_list = function | [] -> invalid_arg "NeList.of_list" | x::tl -> x,tl let repr x = x let of_repr x = x coq-8.20.0/clib/neList.mli000066400000000000000000000022231466560755400152560ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* 'a val tail : 'a t -> 'a t option val singleton : 'a -> 'a t val iter : ('a -> unit) -> 'a t -> unit val map : ('a -> 'b) -> 'a t -> 'b t val map2 : ('a -> 'b -> 'c) -> 'a t -> 'b t -> 'c t val map_head : ('a -> 'a) -> 'a t -> 'a t val push : 'a -> 'a t option -> 'a t val to_list : 'a t -> 'a list (** May raise Invalid_argument *) val of_list : 'a list -> 'a t val repr : 'a t -> 'a * 'a list val of_repr : 'a * 'a list -> 'a t coq-8.20.0/clib/option.ml000066400000000000000000000116331466560755400151640ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* false | _ -> true let is_empty = function | None -> true | Some _ -> false (** Lifting equality onto option types. *) let equal f x y = match x, y with | None, None -> true | Some x, Some y -> f x y | _, _ -> false let compare f x y = match x, y with | None, None -> 0 | Some x, Some y -> f x y | None, Some _ -> -1 | Some _, None -> 1 let hash f = function | None -> 0 | Some x -> f x exception IsNone (** [get x] returns [y] where [x] is [Some y]. @raise IsNone if [x] equals [None]. *) let get = function | Some y -> y | _ -> raise IsNone (** [make x] returns [Some x]. *) let make x = Some x (** [bind x f] is [f y] if [x] is [Some y] and [None] otherwise *) let bind x f = match x with Some y -> f y | None -> None let filter f x = bind x (fun v -> if f v then x else None) (** [init b x] returns [Some x] if [b] is [true] and [None] otherwise. *) let init b x = if b then Some x else None (** [flatten x] is [Some y] if [x] is [Some (Some y)] and [None] otherwise. *) let flatten = function | Some (Some y) -> Some y | _ -> None (** [append x y] is the first element of the concatenation of [x] and [y] seen as lists. *) let append o1 o2 = match o1 with | Some _ -> o1 | None -> o2 (** {6 "Iterators"} ***) (** [iter f x] executes [f y] if [x] equals [Some y]. It does nothing otherwise. *) let iter f = function | Some y -> f y | _ -> () exception Heterogeneous (** [iter2 f x y] executes [f z w] if [x] equals [Some z] and [y] equals [Some w]. It does nothing if both [x] and [y] are [None]. And raises [Heterogeneous] otherwise. *) let iter2 f x y = match x,y with | Some z, Some w -> f z w | None,None -> () | _,_ -> raise Heterogeneous (** [map f x] is [None] if [x] is [None] and [Some (f y)] if [x] is [Some y]. *) let map f = function | Some y -> Some (f y) | _ -> None (** [fold_left f a x] is [f a y] if [x] is [Some y], and [a] otherwise. *) let fold_left f a = function | Some y -> f a y | _ -> a (** [fold_left2 f a x y] is [f z w] if [x] is [Some z] and [y] is [Some w]. It is [a] if both [x] and [y] are [None]. Otherwise it raises [Heterogeneous]. *) let fold_left2 f a x y = match x,y with | Some x, Some y -> f a x y | None, None -> a | _ -> raise Heterogeneous (** [fold_right f x a] is [f y a] if [x] is [Some y], and [a] otherwise. *) let fold_right f x a = match x with | Some y -> f y a | _ -> a (** [fold_left_map f a x] is [a, f y] if [x] is [Some y], and [a] otherwise. *) let fold_left_map f a x = match x with | Some y -> let a, z = f a y in a, Some z | _ -> a, None let fold_right_map f x a = match x with | Some y -> let z, a = f y a in Some z, a | _ -> None, a (** [cata f a x] is [a] if [x] is [None] and [f y] if [x] is [Some y]. *) let cata f a = function | Some c -> f c | None -> a (** {6 More Specific operations} ***) (** [default a x] is [y] if [x] is [Some y] and [a] otherwise. *) let default a = function | Some y -> y | _ -> a (** {6 Smart operations} *) module Smart = struct (** [Smart.map f x] does the same as [map f x] except that it tries to share some memory. *) let map f = function | Some y as x -> let y' = f y in if y' == y then x else Some y' | _ -> None end (** {6 Operations with Lists} *) module List = struct (** [List.cons x l] equals [y::l] if [x] is [Some y] and [l] otherwise. *) let cons x l = match x with | Some y -> y::l | _ -> l (** [List.flatten l] is the list of all the [y]s such that [l] contains [Some y] (in the same order). *) let rec flatten = function | x::l -> cons x (flatten l) | [] -> [] let map f l = let rec aux f l = match l with | [] -> [] | x :: l -> match f x with | None -> raise_notrace Exit | Some y -> y :: aux f l in try Some (aux f l) with Exit -> None end coq-8.20.0/clib/option.mli000066400000000000000000000116141466560755400153340ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* bool (** Negation of [has_some] *) val is_empty : 'a option -> bool (** [equal f x y] lifts the equality predicate [f] to option types. That is, if both [x] and [y] are [None] then it returns [true], if they are both [Some _] then [f] is called. Otherwise it returns [false]. *) val equal : ('a -> 'a -> bool) -> 'a option -> 'a option -> bool (** Same as [equal], but with comparison. *) val compare : ('a -> 'a -> int) -> 'a option -> 'a option -> int (** Lift a hash to option types. *) val hash : ('a -> int) -> 'a option -> int (** [get x] returns [y] where [x] is [Some y]. @raise IsNone if [x] equals [None]. *) val get : 'a option -> 'a (** [make x] returns [Some x]. *) val make : 'a -> 'a option (** [bind x f] is [f y] if [x] is [Some y] and [None] otherwise *) val bind : 'a option -> ('a -> 'b option) -> 'b option (** [filter f x] is [x] if [x] [Some y] and [f y] is true, [None] otherwise *) val filter : ('a -> bool) -> 'a option -> 'a option (** [init b x] returns [Some x] if [b] is [true] and [None] otherwise. *) val init : bool -> 'a -> 'a option (** [flatten x] is [Some y] if [x] is [Some (Some y)] and [None] otherwise. *) val flatten : 'a option option -> 'a option (** [append x y] is the first element of the concatenation of [x] and [y] seen as lists. In other words, [append (Some a) y] is [Some a], [append None (Some b)] is [Some b], and [append None None] is [None]. *) val append : 'a option -> 'a option -> 'a option (** {6 "Iterators"} *) (** [iter f x] executes [f y] if [x] equals [Some y]. It does nothing otherwise. *) val iter : ('a -> unit) -> 'a option -> unit exception Heterogeneous (** [iter2 f x y] executes [f z w] if [x] equals [Some z] and [y] equals [Some w]. It does nothing if both [x] and [y] are [None]. @raise Heterogeneous otherwise. *) val iter2 : ('a -> 'b -> unit) -> 'a option -> 'b option -> unit (** [map f x] is [None] if [x] is [None] and [Some (f y)] if [x] is [Some y]. *) val map : ('a -> 'b) -> 'a option -> 'b option (** [fold_left f a x] is [f a y] if [x] is [Some y], and [a] otherwise. *) val fold_left : ('b -> 'a -> 'b) -> 'b -> 'a option -> 'b (** [fold_left2 f a x y] is [f z w] if [x] is [Some z] and [y] is [Some w]. It is [a] if both [x] and [y] are [None]. @raise Heterogeneous otherwise. *) val fold_left2 : ('a -> 'b -> 'c -> 'a) -> 'a -> 'b option -> 'c option -> 'a (** [fold_right f x a] is [f y a] if [x] is [Some y], and [a] otherwise. *) val fold_right : ('a -> 'b -> 'b) -> 'a option -> 'b -> 'b (** [fold_left_map f a x] is [a, f y] if [x] is [Some y], and [a] otherwise. *) val fold_left_map : ('a -> 'b -> 'a * 'c) -> 'a -> 'b option -> 'a * 'c option (** Same as [fold_left_map] on the right *) val fold_right_map : ('b -> 'a -> 'c * 'a) -> 'b option -> 'a -> 'c option * 'a (** [cata f e x] is [e] if [x] is [None] and [f a] if [x] is [Some a] *) val cata : ('a -> 'b) -> 'b -> 'a option -> 'b (** {6 More Specific Operations} *) (** [default a x] is [y] if [x] is [Some y] and [a] otherwise. *) val default : 'a -> 'a option -> 'a (** {6 Smart operations} *) module Smart : sig (** [Smart.map f x] does the same as [map f x] except that it tries to share some memory. *) val map : ('a -> 'a) -> 'a option -> 'a option end (** {6 Operations with Lists} *) module List : sig (** [List.cons x l] equals [y::l] if [x] is [Some y] and [l] otherwise. *) val cons : 'a option -> 'a list -> 'a list (** [List.flatten l] is the list of all the [y]s such that [l] contains [Some y] (in the same order). *) val flatten : 'a option list -> 'a list (** [List.map f [a1;...;an]] is the list [Some [b1;...;bn]] if for all i, there is a [bi] such that [f ai] is [Some bi]; it is [None] if, for at least one i, [f ai] is [None]. *) val map : ('a -> 'b option) -> 'a list -> 'b list option end coq-8.20.0/clib/orderedType.ml000066400000000000000000000022101466560755400161310ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* t -> int end module Pair (M:S) (N:S) = struct type t = M.t * N.t let compare (a,b) (a',b') = let i = M.compare a a' in if Int.equal i 0 then N.compare b b' else i end module UnorderedPair (M:S) = struct type t = M.t * M.t let reorder (a,b as p) = if M.compare a b <= 0 then p else (b,a) let compare p p' = let p = reorder p and p' = reorder p' in let module P = Pair(M)(M) in P.compare p p' end coq-8.20.0/clib/orderedType.mli000066400000000000000000000015201466560755400163050ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* t -> int end module Pair (M:S) (N:S) : S with type t = M.t * N.t module UnorderedPair (M:S) : S with type t = M.t * M.t coq-8.20.0/clib/polyMap.ml000066400000000000000000000044771466560755400153050ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* refl | _ -> None let make (type a) () : a onetag = (module struct type nonrec a = a type _ tag += T : a tag end) let tag_of_onetag (type a) (tag:a onetag) : a tag = let module T = (val tag) in T.T module type MapS = sig type t type _ value val empty : t val find : 'a tag -> t -> 'a value val add : 'a onetag -> 'a value -> t -> t val mem : 'a tag -> t -> bool val modify : 'a tag -> ('a value -> 'a value) -> t -> t end module Map (V:ValueS) = struct type v = V : 'a onetag * 'a V.t -> v let key t = Obj.Extension_constructor.(id (of_val t)) let onekey t = key (tag_of_onetag t) module M = Int.Map type t = v M.t let empty = M.empty let find (type a) (tag:a tag) m : a V.t = let V (tag', v) = M.find (key tag) m in let module T = (val tag') in match tag with | T.T -> v | _ -> assert false let add tag v m = M.add (onekey tag) (V (tag, v)) m let mem tag m = M.mem (key tag) m let modify (type a) (tag:a tag) (f:a V.t -> a V.t) m = M.modify (key tag) (fun _ (V (tag', v)) -> let module T = (val tag') in match tag with | T.T -> V (tag', f v) | _ -> assert false) m end end coq-8.20.0/clib/polyMap.mli000066400000000000000000000033141466560755400154430ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* 'b tag -> ('a,'b) CSig.eq option val make : unit -> 'a onetag val tag_of_onetag : 'a onetag -> 'a tag module type MapS = sig type t type _ value val empty : t val find : 'a tag -> t -> 'a value val add : 'a onetag -> 'a value -> t -> t val mem : 'a tag -> t -> bool val modify : 'a tag -> ('a value -> 'a value) -> t -> t end module Map(V:ValueS) : MapS with type 'a value := 'a V.t end coq-8.20.0/clib/predicate.ml000066400000000000000000000073661466560755400156240ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* t -> int end module type S = sig type elt type t val empty: t val full: t val is_empty: t -> bool val is_full: t -> bool val mem: elt -> t -> bool val singleton: elt -> t val add: elt -> t -> t val remove: elt -> t -> t val union: t -> t -> t val inter: t -> t -> t val diff: t -> t -> t val complement: t -> t val equal: t -> t -> bool val subset: t -> t -> bool val elements: t -> bool * elt list val is_finite : t -> bool end module Make(Ord: OrderedType) = struct module EltSet = Set.Make(Ord) type elt = Ord.t (* (false, s) represents a set which is equal to the set s (true, s) represents a set which is equal to the complement of set s *) type t = bool * EltSet.t let is_finite (b,_) = not b let elements (b,s) = (b, EltSet.elements s) let empty = (false,EltSet.empty) let full = (true,EltSet.empty) (* assumes the set is infinite *) let is_empty (b,s) = not b && EltSet.is_empty s let is_full (b,s) = b && EltSet.is_empty s let mem x (b,s) = if b then not (EltSet.mem x s) else EltSet.mem x s let singleton x = (false,EltSet.singleton x) let add x (b,s) = if b then (b,EltSet.remove x s) else (b,EltSet.add x s) let remove x (b,s) = if b then (b,EltSet.add x s) else (b,EltSet.remove x s) let complement (b,s) = (not b, s) let union s1 s2 = match (s1,s2) with ((false,p1),(false,p2)) -> (false,EltSet.union p1 p2) | ((true,n1),(true,n2)) -> (true,EltSet.inter n1 n2) | ((false,p1),(true,n2)) -> (true,EltSet.diff n2 p1) | ((true,n1),(false,p2)) -> (true,EltSet.diff n1 p2) let inter s1 s2 = complement (union (complement s1) (complement s2)) let diff s1 s2 = inter s1 (complement s2) (* assumes the set is infinite *) let subset s1 s2 = match (s1,s2) with ((false,p1),(false,p2)) -> EltSet.subset p1 p2 | ((true,n1),(true,n2)) -> EltSet.subset n2 n1 | ((false,p1),(true,n2)) -> EltSet.is_empty (EltSet.inter p1 n2) | ((true,_),(false,_)) -> false (* assumes the set is infinite *) let equal (b1,s1) (b2,s2) = b1=b2 && EltSet.equal s1 s2 end coq-8.20.0/clib/predicate.mli000066400000000000000000000052701466560755400157650ustar00rootroot00000000000000(** Infinite sets over a chosen [OrderedType]. All operations over sets are purely applicative (no side-effects). *) (** Input signature of the functor [Make]. *) module type OrderedType = sig type t (** The type of the elements in the set. The chosen [t] {b must be infinite}. *) val compare : t -> t -> int (** A total ordering function over the set elements. This is a two-argument function [f] such that: - [f e1 e2] is zero if the elements [e1] and [e2] are equal, - [f e1 e2] is strictly negative if [e1] is smaller than [e2], - and [f e1 e2] is strictly positive if [e1] is greater than [e2]. *) end module type S = sig type elt (** The type of the elements in the set. *) type t (** The type of sets. *) val empty: t (** The empty set. *) val full: t (** The set of all elements (of type [elm]). *) val is_empty: t -> bool (** Test whether a set is empty or not. *) val is_full: t -> bool (** Test whether a set contains the whole type or not. *) val mem: elt -> t -> bool (** [mem x s] tests whether [x] belongs to the set [s]. *) val singleton: elt -> t (** [singleton x] returns the one-element set containing only [x]. *) val add: elt -> t -> t (** [add x s] returns a set containing all elements of [s], plus [x]. If [x] was already in [s], then [s] is returned unchanged. *) val remove: elt -> t -> t (** [remove x s] returns a set containing all elements of [s], except [x]. If [x] was not in [s], then [s] is returned unchanged. *) val union: t -> t -> t (** Set union. *) val inter: t -> t -> t (** Set intersection. *) val diff: t -> t -> t (** Set difference. *) val complement: t -> t (** Set complement. *) val equal: t -> t -> bool (** [equal s1 s2] tests whether the sets [s1] and [s2] are equal, that is, contain equal elements. *) val subset: t -> t -> bool (** [subset s1 s2] tests whether the set [s1] is a subset of the set [s2]. *) val elements: t -> bool * elt list (** Gives a finite representation of the predicate: if the boolean is false, then the predicate is given in extension. if it is true, then the complement is given *) val is_finite : t -> bool (** [true] if the predicate can be given as a finite set (if [elt] is a finite type, we can have [is_finite x = false] yet [x] is finite, but we don't know how to list its elements) *) end (** The [Make] functor constructs an implementation for any [OrderedType]. *) module Make (Ord : OrderedType) : (S with type elt = Ord.t) coq-8.20.0/clib/range.ml000066400000000000000000000051471466560755400147530ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* if Int.equal h1 h2 then Cons (1 + h1 + h2, Node (x, t1, t2), rem) else Cons (1, Leaf x, l) | _ -> Cons (1, Leaf x, l) let is_empty = function | Nil -> true | _ -> false let rec tree_get h t i = match t with | Leaf x -> if i = 0 then x else oob () | Node (x, t1, t2) -> if i = 0 then x else let h = h / 2 in if i <= h then tree_get h t1 (i - 1) else tree_get h t2 (i - h - 1) let rec get l i = match l with | Nil -> oob () | Cons (h, t, rem) -> if i < h then tree_get h t i else get rem (i - h) let length l = let rec length accu = function | Nil -> accu | Cons (h, _, l) -> length (h + accu) l in length 0 l let rec tree_map f = function | Leaf x -> Leaf (f x) | Node (x, t1, t2) -> Node (f x, tree_map f t1, tree_map f t2) let rec map f = function | Nil -> Nil | Cons (h, t, l) -> Cons (h, tree_map f t, map f l) let rec tree_fold_left f accu = function | Leaf x -> f accu x | Node (x, t1, t2) -> tree_fold_left f (tree_fold_left f (f accu x) t1) t2 let rec fold_left f accu = function | Nil -> accu | Cons (_, t, l) -> fold_left f (tree_fold_left f accu t) l let rec tree_fold_right f t accu = match t with | Leaf x -> f x accu | Node (x, t1, t2) -> f x (tree_fold_right f t1 (tree_fold_right f t2 accu)) let rec fold_right f l accu = match l with | Nil -> accu | Cons (_, t, l) -> tree_fold_right f t (fold_right f l accu) let hd = function | Nil -> failwith "hd" | Cons (_, Leaf x, _) -> x | Cons (_, Node (x, _, _), _) -> x let tl = function | Nil -> failwith "tl" | Cons (_, Leaf _, l) -> l | Cons (h, Node (_, t1, t2), l) -> let h = h / 2 in Cons (h, t1, Cons (h, t2, l)) let rec skipn n l = if n = 0 then l else if is_empty l then failwith "List.skipn" else skipn (pred n) (tl l) coq-8.20.0/clib/range.mli000066400000000000000000000024321466560755400151160ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* 'a t -> 'a t (** {5 List operations} *) val is_empty : 'a t -> bool val length : 'a t -> int val map : ('a -> 'b) -> 'a t -> 'b t val fold_left : ('a -> 'b -> 'a) -> 'a -> 'b t -> 'a val fold_right : ('a -> 'b -> 'b) -> 'a t -> 'b -> 'b val hd : 'a t -> 'a val tl : 'a t -> 'a t val skipn : int -> 'a t -> 'a t (** {5 Indexing operations} *) val get : 'a t -> int -> 'a coq-8.20.0/clib/sList.ml000066400000000000000000000065621466560755400147570ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* 0 *) let empty = Nil let cons x l = Cons (x, l) let defaultn n l = if Int.equal n 0 then l else match l with | Nil | Cons _ -> Default (n, l) | Default (m, l) -> Default (n + m, l) let default l = match l with | Nil | Cons _ -> Default (1, l) | Default (m, l) -> Default (m + 1, l) let cons_opt o l = match o with | None -> default l | Some x -> cons x l let is_empty = function | Nil -> true | Cons _ | Default _ -> false let is_default = function | Nil -> true | Default (_, Nil) -> true | Cons _ | Default _ -> false let view = function | Nil -> None | Cons (x, l) -> Some (Some x, l) | Default (1, l) -> Some (None, l) | Default (n, l) -> Some (None, Default (n - 1, l)) let rec to_list l = match l with | Nil -> [] | Cons (x, l) -> Some x :: to_list l | Default (n, l) -> let l = to_list l in let rec iterate n l = if n <= 0 then l else iterate (n - 1) (None :: l) in iterate n l let of_full_list l = List.fold_right cons l empty let equal eq l1 l2 = let eq o1 o2 = match o1, o2 with | None, None -> true | Some x1, Some x2 -> eq x1 x2 | Some _, None | None, Some _ -> false in CList.for_all2eq eq (to_list l1) (to_list l2) let compare cmp l1 l2 = CList.compare (Option.compare cmp) (to_list l1) (to_list l2) let length l = let rec length n = function | Nil -> n | Cons (_, l) -> length (n + 1) l | Default (k, l) -> length (k + n) l in length 0 l module Skip = struct let rec iter f = function | Nil -> () | Cons (x, l) -> let () = f x in iter f l | Default (_, l) -> iter f l let rec map f = function | Nil -> Nil | Cons (x, l) -> Cons (f x, map f l) | Default (n, l) -> Default (n, map f l) let rec fold f accu = function | Nil -> accu | Cons (x, l) -> fold f (f accu x) l | Default (_, l) -> fold f accu l let rec for_all f l = match l with | Nil -> true | Cons (x, l) -> f x && for_all f l | Default (_, l) -> for_all f l let rec exists f l = match l with | Nil -> false | Cons (x, l) -> f x || exists f l | Default (_, l) -> exists f l end module Smart = struct let rec map f l = match l with | Nil -> empty | Cons (x, r) -> let x' = f x in let r' = map f r in if x' == x && r' == r then l else cons x' r' | Default (n, r) -> let r' = map f r in if r' == r then l else Default (n, r') let rec fold_left_map f accu l0 = match l0 with | Nil -> accu, empty | Cons (x, l) -> let accu, x' = f accu x in let accu, l' = fold_left_map f accu l in let r = if x' == x && l' == l then l0 else Cons (x', l') in accu, r | Default (n, l) -> let accu, l' = fold_left_map f accu l in let r = if l' == l then l0 else Default (n, l') in accu, r end coq-8.20.0/clib/sList.mli000066400000000000000000000041351466560755400151220ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* 'a t -> 'a t (** Isomorphic to [Some x :: l]. *) val default : 'a t -> 'a t (** Isomorphic to [None :: l]. *) val cons_opt : 'a option -> 'a t -> 'a t (** {!cons} if [Some], {!default} otherwise *) val defaultn : int -> 'a t -> 'a t (** Iterated variant of [default]. *) (** {5 Destructor} *) val view : 'a t -> ('a option * 'a t) option val is_empty : 'a t -> bool val is_default : 'a t -> bool (** {5 Usual list-like operators} *) val length : 'a t -> int val equal : ('a -> 'b -> bool) -> 'a t -> 'b t -> bool val compare : ('a -> 'a -> int) -> 'a t -> 'a t -> int val to_list : 'a t -> 'a option list val of_full_list : 'a list -> 'a t (** {5 Iterators ignoring optional values} *) module Skip : sig val iter : ('a -> unit) -> 'a t -> unit val map : ('a -> 'b) -> 'a t -> 'b t val fold : ('a -> 'b -> 'a) -> 'a -> 'b t -> 'a val for_all : ('a -> bool) -> 'a t -> bool val exists : ('a -> bool) -> 'a t -> bool end (** These iterators ignore the default values in the list. *) (** {5 Smart iterators} *) module Smart : sig val map : ('a -> 'a) -> 'a t -> 'a t val fold_left_map : ('a -> 'b -> 'a * 'b) -> 'a -> 'b t -> 'a * 'b t end (** These iterators also ignore the default values in the list. *) coq-8.20.0/clib/segmenttree.ml000066400000000000000000000122241466560755400161730ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* () | x :: xs -> f i x; loop (i + 1) xs in loop 0 l let log2 x = log x /. log 2. let log2n x = int_of_float (ceil (log2 (float_of_int x))) (** We focus on integers but this module can be generalized. *) type elt = int (** A value of type [domain] is interpreted differently given its position in the tree. On internal nodes, a domain represents the set of integers which are _not_ in the set of keys handled by the tree. On leaves, a domain represents the st of integers which are in the set of keys. *) type domain = | Interval of elt * elt (** On internal nodes, a domain [Interval (a, b)] represents the interval [a + 1; b - 1]. On leaves, it represents [a; b]. We always have [a] <= [b]. *) | Universe (** On internal node or root, a domain [Universe] represents all the integers. When the tree is not a trivial root, [Universe] has no interpretation on leaves. (The lookup function should never reach the leaves.) *) (** We use an array to store the almost complete tree. This array contains at least one element. *) type 'a t = (domain * 'a option) array (** The root is the first item of the array. *) (** Standard layout for left child. *) let left_child i = 2 * i + 1 (** Standard layout for right child. *) let right_child i = 2 * i + 2 (** Extract the annotation of a node, be it internal or a leaf. *) let value_of i t = match t.(i) with (_, Some x) -> x | _ -> raise Not_found (** Initialize the array to store [n] leaves. *) let create n init = Array.make (1 lsl (log2n n + 1) - 1) init (** Make a complete interval tree from a list of disjoint segments. Precondition : the segments must be sorted. *) let make segments = let nsegments = List.length segments in let tree = create nsegments (Universe, None) in let leaves_offset = (1 lsl (log2n nsegments)) - 1 in (* The algorithm proceeds in two steps using an intermediate tree to store minimum and maximum of each subtree as annotation of the node. *) (* We start from leaves: the last level of the tree is initialized with the given segments... *) list_iteri (fun i ((start, stop), value) -> let k = leaves_offset + i in let i = Interval (start, stop) in tree.(k) <- (i, Some i)) segments; (* ... the remaining leaves are initialized with neutral information. *) for k = leaves_offset + nsegments to Array.length tree -1 do tree.(k) <- (Universe, Some Universe) done; (* We traverse the tree bottom-up and compute the interval and annotation associated to each node from the annotations of its children. *) for k = leaves_offset - 1 downto 0 do let node, annotation = match value_of (left_child k) tree, value_of (right_child k) tree with | Interval (left_min, left_max), Interval (right_min, right_max) -> (Interval (left_max, right_min), Interval (left_min, right_max)) | Interval (min, max), Universe -> (Interval (max, max), Interval (min, max)) | Universe, Universe -> Universe, Universe | Universe, _ -> assert false in tree.(k) <- (node, Some annotation) done; (* Finally, annotation are replaced with the image related to each leaf. *) let final_tree = Array.mapi (fun i (segment, value) -> (segment, None)) tree in list_iteri (fun i ((start, stop), value) -> final_tree.(leaves_offset + i) <- (Interval (start, stop), Some value)) segments; final_tree (** [lookup k t] looks for an image for key [k] in the interval tree [t]. Raise [Not_found] if it fails. *) let lookup k t = let i = ref 0 in while (snd t.(!i) = None) do match fst t.(!i) with | Interval (start, stop) -> if k <= start then i := left_child !i else if k >= stop then i:= right_child !i else raise Not_found | Universe -> raise Not_found done; match fst t.(!i) with | Interval (start, stop) -> if k >= start && k <= stop then match snd t.(!i) with | Some v -> v | None -> assert false else raise Not_found | Universe -> assert false coq-8.20.0/clib/segmenttree.mli000066400000000000000000000025431466560755400163470ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* 'a t (** [lookup k t] looks for an image for key [k] in the interval tree [t]. Raise [Not_found] if it fails. *) val lookup : int -> 'a t -> 'a coq-8.20.0/clib/store.ml000066400000000000000000000031721466560755400150070ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* 'a field val empty : t val set : t -> 'a field -> 'a -> t val get : t -> 'a field -> 'a option val remove : t -> 'a field -> t val merge : t -> t -> t end module Make() : S = struct module Dyn = Dyn.Make() module Map = Dyn.Map(struct type 'a t = 'a end) type t = Map.t type 'a field = 'a Dyn.tag let field = Dyn.create let empty = Map.empty let set s f v = Map.add f v s let get s f = try Some (Map.find f s) with Not_found -> None let remove s f = Map.remove f s let merge s1 s2 = Map.fold (fun (Map.Any (f, v)) s -> Map.add f v s) s1 s2 end coq-8.20.0/clib/store.mli000066400000000000000000000026151466560755400151610ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* 'a field (** Create a new field. See also [Dyn.create]. *) val empty : t (** Empty store *) val set : t -> 'a field -> 'a -> t (** Set a field *) val get : t -> 'a field -> 'a option (** Get the value of a field, if any *) val remove : t -> 'a field -> t (** Unset the value of the field *) val merge : t -> t -> t (** [merge s1 s2] adds all the fields of [s1] into [s2]. *) end module Make() : S (** Create a new store type. *) coq-8.20.0/clib/terminal.ml000066400000000000000000000176461466560755400155010ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* o2 | Some _ -> match o2 with | None -> o1 | Some _ -> o2 let default = { fg_color = None; bg_color = None; bold = None; italic = None; underline = None; negative = None; prefix = None; suffix = None; } let reset = "\027[0m" let reset_style = { fg_color = Some `DEFAULT; bg_color = Some `DEFAULT; bold = Some false; italic = Some false; underline = Some false; negative = Some false; prefix = None; suffix = None; } let make ?fg_color ?bg_color ?bold ?italic ?underline ?negative ?style ?prefix ?suffix () = let st = match style with | None -> default | Some st -> st in { fg_color = set st.fg_color fg_color; bg_color = set st.bg_color bg_color; bold = set st.bold bold; italic = set st.italic italic; underline = set st.underline underline; negative = set st.negative negative; prefix = set st.prefix prefix; suffix = set st.suffix suffix; } let merge s1 s2 = { fg_color = set s1.fg_color s2.fg_color; bg_color = set s1.bg_color s2.bg_color; bold = set s1.bold s2.bold; italic = set s1.italic s2.italic; underline = set s1.underline s2.underline; negative = set s1.negative s2.negative; prefix = set s1.prefix s2.prefix; suffix = set s1.suffix s2.suffix; } let diff s1 s2 = let diff_op o1 o2 reset_val = match o1 with | None -> o2 | Some _ -> match o2 with | None -> reset_val | Some _ -> if o1 = o2 then None else o2 in { fg_color = diff_op s1.fg_color s2.fg_color reset_style.fg_color; bg_color = diff_op s1.bg_color s2.bg_color reset_style.bg_color; bold = diff_op s1.bold s2.bold reset_style.bold; italic = diff_op s1.italic s2.italic reset_style.italic; underline = diff_op s1.underline s2.underline reset_style.underline; negative = diff_op s1.negative s2.negative reset_style.negative; prefix = diff_op s1.prefix s2.prefix reset_style.prefix; suffix = diff_op s1.suffix s2.suffix reset_style.suffix; } let base_color = function | `DEFAULT -> 9 | `BLACK -> 0 | `RED -> 1 | `GREEN -> 2 | `YELLOW -> 3 | `BLUE -> 4 | `MAGENTA -> 5 | `CYAN -> 6 | `WHITE -> 7 | `LIGHT_BLACK -> 0 | `LIGHT_RED -> 1 | `LIGHT_GREEN -> 2 | `LIGHT_YELLOW -> 3 | `LIGHT_BLUE -> 4 | `LIGHT_MAGENTA -> 5 | `LIGHT_CYAN -> 6 | `LIGHT_WHITE -> 7 | _ -> invalid_arg "base_color" let extended_color off = function | `INDEX i -> [off + 8; 5; i] | `RGB (r, g, b) -> [off + 8; 2; r; g; b] | _ -> invalid_arg "extended_color" let is_light = function | `LIGHT_BLACK | `LIGHT_RED | `LIGHT_GREEN | `LIGHT_YELLOW | `LIGHT_BLUE | `LIGHT_MAGENTA | `LIGHT_CYAN | `LIGHT_WHITE -> true | _ -> false let is_extended = function | `INDEX _ | `RGB _ -> true | _ -> false let repr st = let fg = match st.fg_color with | None -> [] | Some c -> if is_light c then [90 + base_color c] else if is_extended c then extended_color 30 c else [30 + base_color c] in let bg = match st.bg_color with | None -> [] | Some c -> if is_light c then [100 + base_color c] else if is_extended c then extended_color 40 c else [40 + base_color c] in let bold = match st.bold with | None -> [] | Some true -> [1] | Some false -> [22] in let italic = match st.italic with | None -> [] | Some true -> [3] | Some false -> [23] in let underline = match st.underline with | None -> [] | Some true -> [4] | Some false -> [24] in let negative = match st.negative with | None -> [] | Some true -> [7] | Some false -> [27] in fg @ bg @ bold @ italic @ underline @ negative let eval st = let tags = repr st in let tags = List.map string_of_int tags in if List.length tags = 0 then "" else Printf.sprintf "\027[%sm" (String.concat ";" tags) let has_style t = Unix.isatty t && Sys.os_type = "Unix" let split c s = let len = String.length s in let rec split n = try let pos = String.index_from s n c in let dir = String.sub s n (pos-n) in dir :: split (succ pos) with | Not_found -> [String.sub s n (len-n)] in if len = 0 then [] else split 0 let check_char i = if i < 0 || i > 255 then invalid_arg "check_char" let parse_color off rem = match off with | 0 -> (`BLACK, rem) | 1 -> (`RED, rem) | 2 -> (`GREEN, rem) | 3 -> (`YELLOW, rem) | 4 -> (`BLUE, rem) | 5 -> (`MAGENTA, rem) | 6 -> (`CYAN, rem) | 7 -> (`WHITE, rem) | 9 -> (`DEFAULT, rem) | 8 -> begin match rem with | 5 :: i :: rem -> check_char i; (`INDEX i, rem) | 2 :: r :: g :: b :: rem -> check_char r; check_char g; check_char b; (`RGB (r, g, b), rem) | _ -> invalid_arg "parse_color" end | _ -> invalid_arg "parse_color" let set_light = function | `BLACK -> `LIGHT_BLACK | `RED -> `LIGHT_RED | `GREEN -> `LIGHT_GREEN | `YELLOW -> `LIGHT_YELLOW | `BLUE -> `LIGHT_BLUE | `MAGENTA -> `LIGHT_MAGENTA | `CYAN -> `LIGHT_CYAN | `WHITE -> `LIGHT_WHITE | _ -> invalid_arg "parse_color" let rec parse_style style = function | [] -> style | 0 :: rem -> let style = merge style reset_style in parse_style style rem | 1 :: rem -> let style = make ~style ~bold:true () in parse_style style rem | 3 :: rem -> let style = make ~style ~italic:true () in parse_style style rem | 4 :: rem -> let style = make ~style ~underline:true () in parse_style style rem | 7 :: rem -> let style = make ~style ~negative:true () in parse_style style rem | 22 :: rem -> let style = make ~style ~bold:false () in parse_style style rem | 23 :: rem -> let style = make ~style ~italic:false () in parse_style style rem | 24 :: rem -> let style = make ~style ~underline:false () in parse_style style rem | 27 :: rem -> let style = make ~style ~negative:false () in parse_style style rem | code :: rem when (30 <= code && code < 40) -> let color, rem = parse_color (code mod 10) rem in let style = make ~style ~fg_color:color () in parse_style style rem | code :: rem when (40 <= code && code < 50) -> let color, rem = parse_color (code mod 10) rem in let style = make ~style ~bg_color:color () in parse_style style rem | code :: rem when (90 <= code && code < 100) -> let color, rem = parse_color (code mod 10) rem in let style = make ~style ~fg_color:(set_light color) () in parse_style style rem | code :: rem when (100 <= code && code < 110) -> let color, rem = parse_color (code mod 10) rem in let style = make ~style ~bg_color:(set_light color) () in parse_style style rem | _ :: rem -> parse_style style rem (** Parse LS_COLORS-like strings *) let parse s = let defs = split ':' s in let fold accu s = match split '=' s with | [name; attrs] -> let attrs = split ';' attrs in let accu = try let attrs = List.map int_of_string attrs in let attrs = parse_style (make ()) attrs in (name, attrs) :: accu with _ -> accu in accu | _ -> accu in List.fold_left fold [] defs coq-8.20.0/clib/terminal.mli000066400000000000000000000044011466560755400156330ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* ?bg_color:color -> ?bold:bool -> ?italic:bool -> ?underline:bool -> ?negative:bool -> ?style:style -> ?prefix:string -> ?suffix:string -> unit -> style (** Create a style from the given flags. It is derived from the optional [style] argument if given. *) val merge : style -> style -> style (** [merge s1 s2] returns [s1] with all defined values of [s2] overwritten. *) val diff : style -> style -> style (** [diff s1 s2] returns the differences between [s1] and [s2]. *) val repr : style -> int list (** Generate the ANSI code representing the given style. *) val eval : style -> string (** Generate an escape sequence from a style. *) val reset : string (** This escape sequence resets all attributes. *) val reset_style : style (** The default style *) val has_style : Unix.file_descr -> bool (** Whether an output file descriptor handles styles. Very heuristic, only checks it is a terminal. *) val parse : string -> (string * style) list (** Parse strings describing terminal styles in the LS_COLORS syntax. For robustness, ignore meaningless entries and drops undefined styles. *) coq-8.20.0/clib/trie.ml000066400000000000000000000047431466560755400146230ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* data val next : t -> label -> t val labels : t -> label list val add : label list -> data -> t -> t val remove : label list -> data -> t -> t val iter : (label list -> data -> unit) -> t -> unit end module type Grp = sig type t val nil : t val is_nil : t -> bool val add : t -> t -> t val sub : t -> t -> t end module Make (Y : Map.OrderedType) (X : Grp) = struct module T_codom = Map.Make(Y) type data = X.t type label = Y.t type t = Node of X.t * t T_codom.t let codom_for_all f m = let fold key v accu = f v && accu in T_codom.fold fold m true let empty = Node (X.nil, T_codom.empty) let next (Node (_,m)) lbl = T_codom.find lbl m let get (Node (hereset,_)) = hereset let labels (Node (_,m)) = (* FIXME: this is order-dependent. Try to find a more robust presentation? *) List.rev (T_codom.fold (fun x _ acc -> x::acc) m []) let is_empty_node (Node(a,b)) = (X.is_nil a) && (T_codom.is_empty b) let assure_arc m lbl = if T_codom.mem lbl m then m else T_codom.add lbl (Node (X.nil,T_codom.empty)) m let cleanse_arcs (Node (hereset,m)) = let m = if codom_for_all is_empty_node m then T_codom.empty else m in Node(hereset, m) let rec at_path f (Node (hereset,m)) = function | [] -> cleanse_arcs (Node(f hereset,m)) | h::t -> let m = assure_arc m h in cleanse_arcs (Node(hereset, T_codom.add h (at_path f (T_codom.find h m) t) m)) let add path v tm = at_path (fun hereset -> X.add v hereset) tm path let remove path v tm = at_path (fun hereset -> X.sub hereset v) tm path let iter f tlm = let rec apprec pfx (Node(hereset,m)) = let path = List.rev pfx in f path hereset; T_codom.iter (fun l tm -> apprec (l::pfx) tm) m in apprec [] tlm end coq-8.20.0/clib/trie.mli000066400000000000000000000040121466560755400147610ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* data (** Get the data at the current node. *) val next : t -> label -> t (** [next t lbl] returns the subtrie of [t] pointed by [lbl]. @raise Not_found if there is none. *) val labels : t -> label list (** Get the list of defined labels at the current node. *) val add : label list -> data -> t -> t (** [add t path v] adds [v] at path [path] in [t]. *) val remove : label list -> data -> t -> t (** [remove t path v] removes [v] from path [path] in [t]. *) val iter : (label list -> data -> unit) -> t -> unit (** Apply a function to all contents. *) end module type Grp = sig type t val nil : t val is_nil : t -> bool val add : t -> t -> t val sub : t -> t -> t end module Make (Label : Set.OrderedType) (Data : Grp) : S with type label = Label.t and type data = Data.t (** Generating functor, for a given type of labels and data. *) coq-8.20.0/clib/unicode.ml000066400000000000000000000357561466560755400153160ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* 1 lsl ((i land 7) * 3) (* 001 *) | IdentPart -> 2 lsl ((i land 7) * 3) (* 010 *) | Symbol -> 3 lsl ((i land 7) * 3) (* 011 *) | IdentSep -> 4 lsl ((i land 7) * 3) (* 100 *) | Separator -> 5 lsl ((i land 7) * 3) (* 101 *) | Control -> 6 lsl ((i land 7) * 3) (* 110 *) | Unknown -> 0 lsl ((i land 7) * 3) (* 000 *) (* Helper to reset 3 bits in a word. *) let reset_mask i = lnot (7 lsl ((i land 7) * 3)) (* Initialize the lookup table from a list of segments, assigning a status to every character of each segment. The order of these assignments is relevant: it is possible to assign status [s] to a segment [(c1, c2)] and later assign [s'] to [c] even if [c] is between [c1] and [c2]. *) let mk_lookup_table_from_unicode_tables_for status tables = List.iter (List.iter (fun (c1, c2) -> for i = c1 to c2 do table.(i lsr 3) <- (table.(i lsr 3) land (reset_mask i)) lor (mask i status) done)) tables (* Look up into the table and interpret the found pattern. *) let lookup x = let v = (table.(x lsr 3) lsr ((x land 7) * 3)) land 7 in if v = 1 then Letter else if v = 2 then IdentPart else if v = 3 then Symbol else if v = 4 then IdentSep else if v = 5 then Separator else if v = 6 then Control else Unknown (* [classify] discriminates between 5 different kinds of symbols based on the standard unicode classification (extracted from Camomile). *) let classify = let single c = [ (c, c) ] in (* General tables. *) mk_lookup_table_from_unicode_tables_for Symbol [ Unicodetable.sk; (* Symbol, modifiers. *) Unicodetable.sm; (* Symbol, maths. *) Unicodetable.sc; (* Symbol, currency. *) Unicodetable.so; (* Symbol, modifier. *) Unicodetable.pd; (* Punctuation, dash. *) Unicodetable.pc; (* Punctuation, connector. *) Unicodetable.pe; (* Punctuation, open. *) Unicodetable.ps; (* Punctution, close. *) Unicodetable.pi; (* Punctuation, initial quote. *) Unicodetable.pf; (* Punctuation, final quote. *) Unicodetable.po; (* Punctuation, other. *) ]; mk_lookup_table_from_unicode_tables_for Letter [ Unicodetable.lu; (* Letter, uppercase. *) Unicodetable.ll; (* Letter, lowercase. *) Unicodetable.lt; (* Letter, titlecase. *) Unicodetable.lo; (* Letter, others. *) Unicodetable.lm; (* Letter, modifier. *) ]; mk_lookup_table_from_unicode_tables_for IdentPart [ Unicodetable.nd; (* Number, decimal digits. *) Unicodetable.nl; (* Number, letter. *) Unicodetable.no; (* Number, other. *) ]; (* Workaround. Some characters seems to be missing in Camomile's category tables. We add them manually. *) mk_lookup_table_from_unicode_tables_for Letter [ [(0x01D00, 0x01D7F)]; (* Phonetic Extensions. *) [(0x01D80, 0x01DBF)]; (* Phonetic Extensions Suppl. *) [(0x01DC0, 0x01DFF)]; (* Combining Diacritical Marks Suppl.*) ]; (* Exceptions (from a previous version of this function). *) mk_lookup_table_from_unicode_tables_for Symbol [ [(0x000B2, 0x000B3)]; (* Superscript 2-3. *) single 0x000B9; (* Superscript 1. *) single 0x02070; (* Superscript 0. *) [(0x02074, 0x02079)]; (* Superscript 4-9. *) single 0x0002E; (* Dot. *) ]; mk_lookup_table_from_unicode_tables_for Separator [ Unicodetable.zs; (* Separator, Space. *) Unicodetable.zl; (* Separator, Line. *) Unicodetable.zp; (* Separator, Paragraph. *) ]; mk_lookup_table_from_unicode_tables_for Control [ Unicodetable.cc; (* Other, Control. *) ]; mk_lookup_table_from_unicode_tables_for IdentSep [ single 0x005F; (* Underscore. *) single 0x00A0; (* Non breaking space, overrides Sep *) ]; mk_lookup_table_from_unicode_tables_for IdentPart [ single 0x0027; (* Single quote. *) ]; (* Lookup *) lookup exception End_of_input let utf8_of_unicode n = if n < 128 then String.make 1 (Char.chr n) else let (m,s) = if n < 2048 then (2,192) else if n < 65536 then (3,224) else (4,240) in String.init m (fun i -> let j = (n lsr ((m - 1 - i) * 6)) land 63 in Char.chr (j + if i = 0 then s else 128)) (* If [s] is some UTF-8 encoded string and [i] is a position of some UTF-8 character within [s] then [next_utf8 s i] returns [(j,n)] where: - [j] indicates the position of the next UTF-8 character - [n] represents the UTF-8 character at index [i] *) let next_utf8 s i = let err () = invalid_arg "utf8" in let l = String.length s - i in if l = 0 then raise End_of_input else let a = Char.code s.[i] in if a <= 0x7F then 1, a else if a land 0x40 = 0 || l = 1 then err () else let b = Char.code s.[i+1] in if b land 0xC0 <> 0x80 then err () else if a land 0x20 = 0 then 2, (a land 0x1F) lsl 6 + (b land 0x3F) else if l = 2 then err () else let c = Char.code s.[i+2] in if c land 0xC0 <> 0x80 then err () else if a land 0x10 = 0 then 3, (a land 0x0F) lsl 12 + (b land 0x3F) lsl 6 + (c land 0x3F) else if l = 3 then err () else let d = Char.code s.[i+3] in if d land 0xC0 <> 0x80 then err () else if a land 0x08 = 0 then 4, (a land 0x07) lsl 18 + (b land 0x3F) lsl 12 + (c land 0x3F) lsl 6 + (d land 0x3F) else err () let is_utf8 s = let rec check i = let (off, _) = next_utf8 s i in check (i + off) in try check 0 with End_of_input -> true | Invalid_argument _ -> false (* Escape string if it contains non-utf8 characters *) let escaped_non_utf8 s = let mk_escape x = Printf.sprintf "%%%X" x in let buff = Buffer.create (String.length s * 3) in let rec process_trailing_aux i j = if i = j then i else match String.unsafe_get s i with | '\128'..'\191' -> process_trailing_aux (i+1) j | _ -> i in let process_trailing i n = let j = if i+n-1 >= String.length s then i+1 else process_trailing_aux (i+1) (i+n) in (if j = i+n then Buffer.add_string buff (String.sub s i n) else let v = Array.init (j-i) (fun k -> mk_escape (Char.code s.[i+k])) in Buffer.add_string buff (String.concat "" (Array.to_list v))); j in let rec process i = if i >= String.length s then Buffer.contents buff else let c = String.unsafe_get s i in match c with | '\000'..'\127' -> Buffer.add_char buff c; process (i+1) | '\128'..'\191' | '\248'..'\255' -> Buffer.add_string buff (mk_escape (Char.code c)); process (i+1) | '\192'..'\223' -> process (process_trailing i 2) | '\224'..'\239' -> process (process_trailing i 3) | '\240'..'\247' -> process (process_trailing i 4) in process 0 let escaped_if_non_utf8 s = if is_utf8 s then s else escaped_non_utf8 s (* Check the well-formedness of an identifier *) let is_valid_ident_initial = function | Letter | IdentSep -> true | IdentPart | Symbol | Separator | Control | Unknown -> false let initial_refutation j n s = if is_valid_ident_initial (classify n) then None else let c = String.sub s 0 j in Some (false, "Invalid character '"^c^"' at beginning of identifier \""^s^"\".") let is_valid_ident_trailing = function | Letter | IdentSep | IdentPart -> true | Symbol | Separator | Control | Unknown -> false let trailing_refutation i j n s = if is_valid_ident_trailing (classify n) then None else let c = String.sub s i j in Some (false, "Invalid character '"^c^"' in identifier \""^s^"\".") let is_unknown = function | Unknown -> true | Letter | IdentSep | IdentPart | Symbol | Separator | Control -> false let is_ident_part = function | IdentPart -> true | Letter | IdentSep | Symbol | Unknown | Separator | Control -> false let is_ident_sep = function | IdentSep -> true | Letter | IdentPart | Symbol | Unknown | Separator | Control -> false let is_letter = function | Letter -> true | IdentSep | IdentPart | Symbol | Unknown | Separator | Control -> false let ident_refutation s = if s = ".." then None else try let j, n = next_utf8 s 0 in match initial_refutation j n s with |None -> begin try let rec aux i = let j, n = next_utf8 s i in match trailing_refutation i j n s with |None -> aux (i + j) |x -> x in aux j with End_of_input -> None end |x -> x with | End_of_input -> Some (true,"The empty string is not an identifier.") | Invalid_argument _ -> Some (true,escaped_non_utf8 s^": invalid utf8 sequence.") let lowercase_unicode = let tree = Segmenttree.make Unicodetable.to_lower in fun unicode -> try match Segmenttree.lookup unicode tree with | `Abs c -> c | `Delta d -> unicode + d with Not_found -> unicode let lowercase_first_char s = assert (s <> ""); let j, n = next_utf8 s 0 in utf8_of_unicode (lowercase_unicode n) let split_at_first_letter s = let n, v = next_utf8 s 0 in if ((* optim *) n = 1 && s.[0] != '_') || not (is_ident_sep (classify v)) then None else begin let n = ref n in let p = ref 0 in while !n < String.length s && let n', v = next_utf8 s !n in p := n'; (* Test if not letter *) ((* optim *) n' = 1 && (s.[!n] = '_' || s.[!n] = '\'')) || let st = classify v in is_ident_sep st || is_ident_part st do n := !n + !p done; let s1 = String.sub s 0 !n in let s2 = String.sub s !n (String.length s - !n) in Some (s1,s2) end (** For extraction, we need to encode unicode character into ascii ones *) let is_basic_ascii s = let ok = ref true in String.iter (fun c -> if Char.code c >= 128 then ok := false) s; !ok let ascii_of_ident s = let len = String.length s in let has_UU i = i+2 < len && s.[i]='_' && s.[i+1]='U' && s.[i+2]='U' in let i = ref 0 in while !i < len && Char.code s.[!i] < 128 && not (has_UU !i) do incr i done; if !i = len then s else let out = Buffer.create (2*len) in Buffer.add_substring out s 0 !i; while !i < len do let j, n = next_utf8 s !i in if n >= 128 then (Printf.bprintf out "_UU%04x_" n; i := !i + j) else if has_UU !i then (Buffer.add_string out "_UUU"; i := !i + 3) else (Buffer.add_char out s.[!i]; incr i) done; Buffer.contents out (* Compute length of an UTF-8 encoded string Rem 1 : utf8_length <= String.length (equal if pure ascii) Rem 2 : if used for an iso8859_1 encoded string, the result is wrong in very rare cases. Such a wrong case corresponds to any sequence of a character in range 192..253 immediately followed by a character in range 128..191 (typical case in french is "déçu" which is counted 3 instead of 4); then no real harm to use always utf8_length even if using an iso8859_1 encoding *) (** FIXME: duplicate code with Pp *) let utf8_length s = let len = String.length s and cnt = ref 0 and nc = ref 0 and p = ref 0 in while !p < len do begin match s.[!p] with | '\000'..'\127' -> nc := 0 (* ascii char *) | '\128'..'\191' -> nc := 0 (* cannot start with a continuation byte *) | '\192'..'\223' -> nc := 1 (* expect 1 continuation byte *) | '\224'..'\239' -> nc := 2 (* expect 2 continuation bytes *) | '\240'..'\247' -> nc := 3 (* expect 3 continuation bytes *) | '\248'..'\255' -> nc := 0 (* invalid byte *) end ; incr p ; while !p < len && !nc > 0 do match s.[!p] with | '\128'..'\191' (* next continuation byte *) -> incr p ; decr nc | _ (* not a continuation byte *) -> nc := 0 done ; incr cnt done ; !cnt (* Variant of String.sub for UTF8 character positions *) let utf8_sub s start_u len_u = let len_b = String.length s and end_u = start_u + len_u and cnt = ref 0 and nc = ref 0 and p = ref 0 in let start_b = ref len_b in while !p < len_b && !cnt < end_u do if !cnt <= start_u then start_b := !p ; begin match s.[!p] with | '\000'..'\127' -> nc := 0 (* ascii char *) | '\128'..'\191' -> nc := 0 (* cannot start with a continuation byte *) | '\192'..'\223' -> nc := 1 (* expect 1 continuation byte *) | '\224'..'\239' -> nc := 2 (* expect 2 continuation bytes *) | '\240'..'\247' -> nc := 3 (* expect 3 continuation bytes *) | '\248'..'\255' -> nc := 0 (* invalid byte *) end ; incr p ; while !p < len_b && !nc > 0 do match s.[!p] with | '\128'..'\191' (* next continuation byte *) -> incr p ; decr nc | _ (* not a continuation byte *) -> nc := 0 done ; incr cnt done ; let end_b = !p in String.sub s !start_b (end_b - !start_b) coq-8.20.0/clib/unicode.mli000066400000000000000000000051271466560755400154540ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* status (** Return [None] if a given string can be used as a (Coq) identifier. Return [Some (b,s)] otherwise, where [s] is an explanation and [b] is severity. *) val ident_refutation : string -> (bool * string) option (** Tells if a valid initial character for an identifier *) val is_valid_ident_initial : status -> bool (** Tells if a valid non-initial character for an identifier *) val is_valid_ident_trailing : status -> bool (** Tells if a letter *) val is_letter : status -> bool (** Tells if a character is unclassified *) val is_unknown : status -> bool (** First char of a string, converted to lowercase @raise Assert_failure if the input string is empty. *) val lowercase_first_char : string -> string (** Split a string supposed to be an ident at the first letter; as an optimization, return None if the first character is a letter *) val split_at_first_letter : string -> (string * string) option (** Return [true] if all UTF-8 characters in the input string are just plain ASCII characters. Returns [false] otherwise. *) val is_basic_ascii : string -> bool (** [ascii_of_ident s] maps UTF-8 string to a string composed solely from ASCII characters. The non-ASCII characters are translated to ["_UUxxxx_"] where {i xxxx} is the Unicode index of the character in hexadecimal (from four to six hex digits). To avoid potential name clashes, any preexisting substring ["_UU"] is turned into ["_UUU"]. *) val ascii_of_ident : string -> string (** Validate an UTF-8 string *) val is_utf8 : string -> bool (** Return the length of a valid UTF-8 string. *) val utf8_length : string -> int (** Variant of {!String.sub} for UTF-8 strings. *) val utf8_sub : string -> int -> int -> string (** Return a "%XX"-escaped string if it contains non UTF-8 characters. *) val escaped_if_non_utf8 : string -> string coq-8.20.0/clib/unicodetable.mli000066400000000000000000000015211466560755400164560ustar00rootroot00000000000000val lu : (int * int) list val ll : (int * int) list val lt : (int * int) list val mn : (int * int) list val mc : (int * int) list val me : (int * int) list val nd : (int * int) list val nl : (int * int) list val no : (int * int) list val zs : (int * int) list val zl : (int * int) list val zp : (int * int) list val cc : (int * int) list val cf : (int * int) list val cs : (int * int) list val co : (int * int) list val cn : (int * int) list val lm : (int * int) list val lo : (int * int) list val pc : (int * int) list val pd : (int * int) list val ps : (int * int) list val pe : (int * int) list val pi : (int * int) list val pf : (int * int) list val po : (int * int) list val sm : (int * int) list val sc : (int * int) list val sk : (int * int) list val so : (int * int) list val to_lower : ((int * int) * [> `Abs of int | `Delta of int ]) list coq-8.20.0/clib/unicodetable_gen.ml000066400000000000000000006277171466560755400171630ustar00rootroot00000000000000(** Unicode tables generated using UUCD. *) (* Letter, Uppercase *) let lu = [ (0x00041,0x0005A); (0x000C0,0x000D6); (0x000D8,0x000DE); (0x00100,0x00100); (0x00102,0x00102); (0x00104,0x00104); (0x00106,0x00106); (0x00108,0x00108); (0x0010A,0x0010A); (0x0010C,0x0010C); (0x0010E,0x0010E); (0x00110,0x00110); (0x00112,0x00112); (0x00114,0x00114); (0x00116,0x00116); (0x00118,0x00118); (0x0011A,0x0011A); (0x0011C,0x0011C); (0x0011E,0x0011E); (0x00120,0x00120); (0x00122,0x00122); (0x00124,0x00124); (0x00126,0x00126); (0x00128,0x00128); (0x0012A,0x0012A); (0x0012C,0x0012C); (0x0012E,0x0012E); (0x00130,0x00130); (0x00132,0x00132); (0x00134,0x00134); (0x00136,0x00136); (0x00139,0x00139); (0x0013B,0x0013B); (0x0013D,0x0013D); (0x0013F,0x0013F); (0x00141,0x00141); (0x00143,0x00143); (0x00145,0x00145); (0x00147,0x00147); (0x0014A,0x0014A); (0x0014C,0x0014C); (0x0014E,0x0014E); (0x00150,0x00150); (0x00152,0x00152); (0x00154,0x00154); (0x00156,0x00156); (0x00158,0x00158); (0x0015A,0x0015A); (0x0015C,0x0015C); (0x0015E,0x0015E); (0x00160,0x00160); (0x00162,0x00162); (0x00164,0x00164); (0x00166,0x00166); (0x00168,0x00168); (0x0016A,0x0016A); (0x0016C,0x0016C); (0x0016E,0x0016E); (0x00170,0x00170); (0x00172,0x00172); (0x00174,0x00174); (0x00176,0x00176); (0x00178,0x00179); (0x0017B,0x0017B); (0x0017D,0x0017D); (0x00181,0x00182); (0x00184,0x00184); (0x00186,0x00187); (0x00189,0x0018B); (0x0018E,0x00191); (0x00193,0x00194); (0x00196,0x00198); (0x0019C,0x0019D); (0x0019F,0x001A0); (0x001A2,0x001A2); (0x001A4,0x001A4); (0x001A6,0x001A7); (0x001A9,0x001A9); (0x001AC,0x001AC); (0x001AE,0x001AF); (0x001B1,0x001B3); (0x001B5,0x001B5); (0x001B7,0x001B8); (0x001BC,0x001BC); (0x001C4,0x001C4); (0x001C7,0x001C7); (0x001CA,0x001CA); (0x001CD,0x001CD); (0x001CF,0x001CF); (0x001D1,0x001D1); (0x001D3,0x001D3); (0x001D5,0x001D5); (0x001D7,0x001D7); (0x001D9,0x001D9); (0x001DB,0x001DB); (0x001DE,0x001DE); (0x001E0,0x001E0); (0x001E2,0x001E2); (0x001E4,0x001E4); (0x001E6,0x001E6); (0x001E8,0x001E8); (0x001EA,0x001EA); (0x001EC,0x001EC); (0x001EE,0x001EE); (0x001F1,0x001F1); (0x001F4,0x001F4); (0x001F6,0x001F8); (0x001FA,0x001FA); (0x001FC,0x001FC); (0x001FE,0x001FE); (0x00200,0x00200); (0x00202,0x00202); (0x00204,0x00204); (0x00206,0x00206); (0x00208,0x00208); (0x0020A,0x0020A); (0x0020C,0x0020C); (0x0020E,0x0020E); (0x00210,0x00210); (0x00212,0x00212); (0x00214,0x00214); (0x00216,0x00216); (0x00218,0x00218); (0x0021A,0x0021A); (0x0021C,0x0021C); (0x0021E,0x0021E); (0x00220,0x00220); (0x00222,0x00222); (0x00224,0x00224); (0x00226,0x00226); (0x00228,0x00228); (0x0022A,0x0022A); (0x0022C,0x0022C); (0x0022E,0x0022E); (0x00230,0x00230); (0x00232,0x00232); (0x0023A,0x0023B); (0x0023D,0x0023E); (0x00241,0x00241); (0x00243,0x00246); (0x00248,0x00248); (0x0024A,0x0024A); (0x0024C,0x0024C); (0x0024E,0x0024E); (0x00370,0x00370); (0x00372,0x00372); (0x00376,0x00376); (0x0037F,0x0037F); (0x00386,0x00386); (0x00388,0x0038A); (0x0038C,0x0038C); (0x0038E,0x0038F); (0x00391,0x003A1); (0x003A3,0x003AB); (0x003CF,0x003CF); (0x003D2,0x003D4); (0x003D8,0x003D8); (0x003DA,0x003DA); (0x003DC,0x003DC); (0x003DE,0x003DE); (0x003E0,0x003E0); (0x003E2,0x003E2); (0x003E4,0x003E4); (0x003E6,0x003E6); (0x003E8,0x003E8); (0x003EA,0x003EA); (0x003EC,0x003EC); (0x003EE,0x003EE); (0x003F4,0x003F4); (0x003F7,0x003F7); (0x003F9,0x003FA); (0x003FD,0x0042F); (0x00460,0x00460); (0x00462,0x00462); (0x00464,0x00464); (0x00466,0x00466); (0x00468,0x00468); (0x0046A,0x0046A); (0x0046C,0x0046C); (0x0046E,0x0046E); (0x00470,0x00470); (0x00472,0x00472); (0x00474,0x00474); (0x00476,0x00476); (0x00478,0x00478); (0x0047A,0x0047A); (0x0047C,0x0047C); (0x0047E,0x0047E); (0x00480,0x00480); (0x0048A,0x0048A); (0x0048C,0x0048C); (0x0048E,0x0048E); (0x00490,0x00490); (0x00492,0x00492); (0x00494,0x00494); (0x00496,0x00496); (0x00498,0x00498); (0x0049A,0x0049A); (0x0049C,0x0049C); (0x0049E,0x0049E); (0x004A0,0x004A0); (0x004A2,0x004A2); (0x004A4,0x004A4); (0x004A6,0x004A6); (0x004A8,0x004A8); (0x004AA,0x004AA); (0x004AC,0x004AC); (0x004AE,0x004AE); (0x004B0,0x004B0); (0x004B2,0x004B2); (0x004B4,0x004B4); (0x004B6,0x004B6); (0x004B8,0x004B8); (0x004BA,0x004BA); (0x004BC,0x004BC); (0x004BE,0x004BE); (0x004C0,0x004C1); (0x004C3,0x004C3); (0x004C5,0x004C5); (0x004C7,0x004C7); (0x004C9,0x004C9); (0x004CB,0x004CB); (0x004CD,0x004CD); (0x004D0,0x004D0); (0x004D2,0x004D2); (0x004D4,0x004D4); (0x004D6,0x004D6); (0x004D8,0x004D8); (0x004DA,0x004DA); (0x004DC,0x004DC); (0x004DE,0x004DE); (0x004E0,0x004E0); (0x004E2,0x004E2); (0x004E4,0x004E4); (0x004E6,0x004E6); (0x004E8,0x004E8); (0x004EA,0x004EA); (0x004EC,0x004EC); (0x004EE,0x004EE); (0x004F0,0x004F0); (0x004F2,0x004F2); (0x004F4,0x004F4); (0x004F6,0x004F6); (0x004F8,0x004F8); (0x004FA,0x004FA); (0x004FC,0x004FC); (0x004FE,0x004FE); (0x00500,0x00500); (0x00502,0x00502); (0x00504,0x00504); (0x00506,0x00506); (0x00508,0x00508); (0x0050A,0x0050A); (0x0050C,0x0050C); (0x0050E,0x0050E); (0x00510,0x00510); (0x00512,0x00512); (0x00514,0x00514); (0x00516,0x00516); (0x00518,0x00518); (0x0051A,0x0051A); (0x0051C,0x0051C); (0x0051E,0x0051E); (0x00520,0x00520); (0x00522,0x00522); (0x00524,0x00524); (0x00526,0x00526); (0x00528,0x00528); (0x0052A,0x0052A); (0x0052C,0x0052C); (0x0052E,0x0052E); (0x00531,0x00556); (0x010A0,0x010C5); (0x010C7,0x010C7); (0x010CD,0x010CD); (0x013A0,0x013F5); (0x01E00,0x01E00); (0x01E02,0x01E02); (0x01E04,0x01E04); (0x01E06,0x01E06); (0x01E08,0x01E08); (0x01E0A,0x01E0A); (0x01E0C,0x01E0C); (0x01E0E,0x01E0E); (0x01E10,0x01E10); (0x01E12,0x01E12); (0x01E14,0x01E14); (0x01E16,0x01E16); (0x01E18,0x01E18); (0x01E1A,0x01E1A); (0x01E1C,0x01E1C); (0x01E1E,0x01E1E); (0x01E20,0x01E20); (0x01E22,0x01E22); (0x01E24,0x01E24); (0x01E26,0x01E26); (0x01E28,0x01E28); (0x01E2A,0x01E2A); (0x01E2C,0x01E2C); (0x01E2E,0x01E2E); (0x01E30,0x01E30); (0x01E32,0x01E32); (0x01E34,0x01E34); (0x01E36,0x01E36); (0x01E38,0x01E38); (0x01E3A,0x01E3A); (0x01E3C,0x01E3C); (0x01E3E,0x01E3E); (0x01E40,0x01E40); (0x01E42,0x01E42); (0x01E44,0x01E44); (0x01E46,0x01E46); (0x01E48,0x01E48); (0x01E4A,0x01E4A); (0x01E4C,0x01E4C); (0x01E4E,0x01E4E); (0x01E50,0x01E50); (0x01E52,0x01E52); (0x01E54,0x01E54); (0x01E56,0x01E56); (0x01E58,0x01E58); (0x01E5A,0x01E5A); (0x01E5C,0x01E5C); (0x01E5E,0x01E5E); (0x01E60,0x01E60); (0x01E62,0x01E62); (0x01E64,0x01E64); (0x01E66,0x01E66); (0x01E68,0x01E68); (0x01E6A,0x01E6A); (0x01E6C,0x01E6C); (0x01E6E,0x01E6E); (0x01E70,0x01E70); (0x01E72,0x01E72); (0x01E74,0x01E74); (0x01E76,0x01E76); (0x01E78,0x01E78); (0x01E7A,0x01E7A); (0x01E7C,0x01E7C); (0x01E7E,0x01E7E); (0x01E80,0x01E80); (0x01E82,0x01E82); (0x01E84,0x01E84); (0x01E86,0x01E86); (0x01E88,0x01E88); (0x01E8A,0x01E8A); (0x01E8C,0x01E8C); (0x01E8E,0x01E8E); (0x01E90,0x01E90); (0x01E92,0x01E92); (0x01E94,0x01E94); (0x01E9E,0x01E9E); (0x01EA0,0x01EA0); (0x01EA2,0x01EA2); (0x01EA4,0x01EA4); (0x01EA6,0x01EA6); (0x01EA8,0x01EA8); (0x01EAA,0x01EAA); (0x01EAC,0x01EAC); (0x01EAE,0x01EAE); (0x01EB0,0x01EB0); (0x01EB2,0x01EB2); (0x01EB4,0x01EB4); (0x01EB6,0x01EB6); (0x01EB8,0x01EB8); (0x01EBA,0x01EBA); (0x01EBC,0x01EBC); (0x01EBE,0x01EBE); (0x01EC0,0x01EC0); (0x01EC2,0x01EC2); (0x01EC4,0x01EC4); (0x01EC6,0x01EC6); (0x01EC8,0x01EC8); (0x01ECA,0x01ECA); (0x01ECC,0x01ECC); (0x01ECE,0x01ECE); (0x01ED0,0x01ED0); (0x01ED2,0x01ED2); (0x01ED4,0x01ED4); (0x01ED6,0x01ED6); (0x01ED8,0x01ED8); (0x01EDA,0x01EDA); (0x01EDC,0x01EDC); (0x01EDE,0x01EDE); (0x01EE0,0x01EE0); (0x01EE2,0x01EE2); (0x01EE4,0x01EE4); (0x01EE6,0x01EE6); (0x01EE8,0x01EE8); (0x01EEA,0x01EEA); (0x01EEC,0x01EEC); (0x01EEE,0x01EEE); (0x01EF0,0x01EF0); (0x01EF2,0x01EF2); (0x01EF4,0x01EF4); (0x01EF6,0x01EF6); (0x01EF8,0x01EF8); (0x01EFA,0x01EFA); (0x01EFC,0x01EFC); (0x01EFE,0x01EFE); (0x01F08,0x01F0F); (0x01F18,0x01F1D); (0x01F28,0x01F2F); (0x01F38,0x01F3F); (0x01F48,0x01F4D); (0x01F59,0x01F59); (0x01F5B,0x01F5B); (0x01F5D,0x01F5D); (0x01F5F,0x01F5F); (0x01F68,0x01F6F); (0x01FB8,0x01FBB); (0x01FC8,0x01FCB); (0x01FD8,0x01FDB); (0x01FE8,0x01FEC); (0x01FF8,0x01FFB); (0x02102,0x02102); (0x02107,0x02107); (0x0210B,0x0210D); (0x02110,0x02112); (0x02115,0x02115); (0x02119,0x0211D); (0x02124,0x02124); (0x02126,0x02126); (0x02128,0x02128); (0x0212A,0x0212D); (0x02130,0x02133); (0x0213E,0x0213F); (0x02145,0x02145); (0x02183,0x02183); (0x02C00,0x02C2E); (0x02C60,0x02C60); (0x02C62,0x02C64); (0x02C67,0x02C67); (0x02C69,0x02C69); (0x02C6B,0x02C6B); (0x02C6D,0x02C70); (0x02C72,0x02C72); (0x02C75,0x02C75); (0x02C7E,0x02C80); (0x02C82,0x02C82); (0x02C84,0x02C84); (0x02C86,0x02C86); (0x02C88,0x02C88); (0x02C8A,0x02C8A); (0x02C8C,0x02C8C); (0x02C8E,0x02C8E); (0x02C90,0x02C90); (0x02C92,0x02C92); (0x02C94,0x02C94); (0x02C96,0x02C96); (0x02C98,0x02C98); (0x02C9A,0x02C9A); (0x02C9C,0x02C9C); (0x02C9E,0x02C9E); (0x02CA0,0x02CA0); (0x02CA2,0x02CA2); (0x02CA4,0x02CA4); (0x02CA6,0x02CA6); (0x02CA8,0x02CA8); (0x02CAA,0x02CAA); (0x02CAC,0x02CAC); (0x02CAE,0x02CAE); (0x02CB0,0x02CB0); (0x02CB2,0x02CB2); (0x02CB4,0x02CB4); (0x02CB6,0x02CB6); (0x02CB8,0x02CB8); (0x02CBA,0x02CBA); (0x02CBC,0x02CBC); (0x02CBE,0x02CBE); (0x02CC0,0x02CC0); (0x02CC2,0x02CC2); (0x02CC4,0x02CC4); (0x02CC6,0x02CC6); (0x02CC8,0x02CC8); (0x02CCA,0x02CCA); (0x02CCC,0x02CCC); (0x02CCE,0x02CCE); (0x02CD0,0x02CD0); (0x02CD2,0x02CD2); (0x02CD4,0x02CD4); (0x02CD6,0x02CD6); (0x02CD8,0x02CD8); (0x02CDA,0x02CDA); (0x02CDC,0x02CDC); (0x02CDE,0x02CDE); (0x02CE0,0x02CE0); (0x02CE2,0x02CE2); (0x02CEB,0x02CEB); (0x02CED,0x02CED); (0x02CF2,0x02CF2); (0x0A640,0x0A640); (0x0A642,0x0A642); (0x0A644,0x0A644); (0x0A646,0x0A646); (0x0A648,0x0A648); (0x0A64A,0x0A64A); (0x0A64C,0x0A64C); (0x0A64E,0x0A64E); (0x0A650,0x0A650); (0x0A652,0x0A652); (0x0A654,0x0A654); (0x0A656,0x0A656); (0x0A658,0x0A658); (0x0A65A,0x0A65A); (0x0A65C,0x0A65C); (0x0A65E,0x0A65E); (0x0A660,0x0A660); (0x0A662,0x0A662); (0x0A664,0x0A664); (0x0A666,0x0A666); (0x0A668,0x0A668); (0x0A66A,0x0A66A); (0x0A66C,0x0A66C); (0x0A680,0x0A680); (0x0A682,0x0A682); (0x0A684,0x0A684); (0x0A686,0x0A686); (0x0A688,0x0A688); (0x0A68A,0x0A68A); (0x0A68C,0x0A68C); (0x0A68E,0x0A68E); (0x0A690,0x0A690); (0x0A692,0x0A692); (0x0A694,0x0A694); (0x0A696,0x0A696); (0x0A698,0x0A698); (0x0A69A,0x0A69A); (0x0A722,0x0A722); (0x0A724,0x0A724); (0x0A726,0x0A726); (0x0A728,0x0A728); (0x0A72A,0x0A72A); (0x0A72C,0x0A72C); (0x0A72E,0x0A72E); (0x0A732,0x0A732); (0x0A734,0x0A734); (0x0A736,0x0A736); (0x0A738,0x0A738); (0x0A73A,0x0A73A); (0x0A73C,0x0A73C); (0x0A73E,0x0A73E); (0x0A740,0x0A740); (0x0A742,0x0A742); (0x0A744,0x0A744); (0x0A746,0x0A746); (0x0A748,0x0A748); (0x0A74A,0x0A74A); (0x0A74C,0x0A74C); (0x0A74E,0x0A74E); (0x0A750,0x0A750); (0x0A752,0x0A752); (0x0A754,0x0A754); (0x0A756,0x0A756); (0x0A758,0x0A758); (0x0A75A,0x0A75A); (0x0A75C,0x0A75C); (0x0A75E,0x0A75E); (0x0A760,0x0A760); (0x0A762,0x0A762); (0x0A764,0x0A764); (0x0A766,0x0A766); (0x0A768,0x0A768); (0x0A76A,0x0A76A); (0x0A76C,0x0A76C); (0x0A76E,0x0A76E); (0x0A779,0x0A779); (0x0A77B,0x0A77B); (0x0A77D,0x0A77E); (0x0A780,0x0A780); (0x0A782,0x0A782); (0x0A784,0x0A784); (0x0A786,0x0A786); (0x0A78B,0x0A78B); (0x0A78D,0x0A78D); (0x0A790,0x0A790); (0x0A792,0x0A792); (0x0A796,0x0A796); (0x0A798,0x0A798); (0x0A79A,0x0A79A); (0x0A79C,0x0A79C); (0x0A79E,0x0A79E); (0x0A7A0,0x0A7A0); (0x0A7A2,0x0A7A2); (0x0A7A4,0x0A7A4); (0x0A7A6,0x0A7A6); (0x0A7A8,0x0A7A8); (0x0A7AA,0x0A7AE); (0x0A7B0,0x0A7B4); (0x0A7B6,0x0A7B6); (0x0FF21,0x0FF3A); (0x10400,0x10427); (0x104B0,0x104D3); (0x10C80,0x10CB2); (0x118A0,0x118BF); (0x1D400,0x1D419); (0x1D434,0x1D44D); (0x1D468,0x1D481); (0x1D49C,0x1D49C); (0x1D49E,0x1D49F); (0x1D4A2,0x1D4A2); (0x1D4A5,0x1D4A6); (0x1D4A9,0x1D4AC); (0x1D4AE,0x1D4B5); (0x1D4D0,0x1D4E9); (0x1D504,0x1D505); (0x1D507,0x1D50A); (0x1D50D,0x1D514); (0x1D516,0x1D51C); (0x1D538,0x1D539); (0x1D53B,0x1D53E); (0x1D540,0x1D544); (0x1D546,0x1D546); (0x1D54A,0x1D550); (0x1D56C,0x1D585); (0x1D5A0,0x1D5B9); (0x1D5D4,0x1D5ED); (0x1D608,0x1D621); (0x1D63C,0x1D655); (0x1D670,0x1D689); (0x1D6A8,0x1D6C0); (0x1D6E2,0x1D6FA); (0x1D71C,0x1D734); (0x1D756,0x1D76E); (0x1D790,0x1D7A8); (0x1D7CA,0x1D7CA) ] (* Letter, Lowercase *) let ll = [ (0x00061,0x0007A); (0x000B5,0x000B5); (0x000DF,0x000F6); (0x000F8,0x000FF); (0x00101,0x00101); (0x00103,0x00103); (0x00105,0x00105); (0x00107,0x00107); (0x00109,0x00109); (0x0010B,0x0010B); (0x0010D,0x0010D); (0x0010F,0x0010F); (0x00111,0x00111); (0x00113,0x00113); (0x00115,0x00115); (0x00117,0x00117); (0x00119,0x00119); (0x0011B,0x0011B); (0x0011D,0x0011D); (0x0011F,0x0011F); (0x00121,0x00121); (0x00123,0x00123); (0x00125,0x00125); (0x00127,0x00127); (0x00129,0x00129); (0x0012B,0x0012B); (0x0012D,0x0012D); (0x0012F,0x0012F); (0x00131,0x00131); (0x00133,0x00133); (0x00135,0x00135); (0x00137,0x00138); (0x0013A,0x0013A); (0x0013C,0x0013C); (0x0013E,0x0013E); (0x00140,0x00140); (0x00142,0x00142); (0x00144,0x00144); (0x00146,0x00146); (0x00148,0x00149); (0x0014B,0x0014B); (0x0014D,0x0014D); (0x0014F,0x0014F); (0x00151,0x00151); (0x00153,0x00153); (0x00155,0x00155); (0x00157,0x00157); (0x00159,0x00159); (0x0015B,0x0015B); (0x0015D,0x0015D); (0x0015F,0x0015F); (0x00161,0x00161); (0x00163,0x00163); (0x00165,0x00165); (0x00167,0x00167); (0x00169,0x00169); (0x0016B,0x0016B); (0x0016D,0x0016D); (0x0016F,0x0016F); (0x00171,0x00171); (0x00173,0x00173); (0x00175,0x00175); (0x00177,0x00177); (0x0017A,0x0017A); (0x0017C,0x0017C); (0x0017E,0x00180); (0x00183,0x00183); (0x00185,0x00185); (0x00188,0x00188); (0x0018C,0x0018D); (0x00192,0x00192); (0x00195,0x00195); (0x00199,0x0019B); (0x0019E,0x0019E); (0x001A1,0x001A1); (0x001A3,0x001A3); (0x001A5,0x001A5); (0x001A8,0x001A8); (0x001AA,0x001AB); (0x001AD,0x001AD); (0x001B0,0x001B0); (0x001B4,0x001B4); (0x001B6,0x001B6); (0x001B9,0x001BA); (0x001BD,0x001BF); (0x001C6,0x001C6); (0x001C9,0x001C9); (0x001CC,0x001CC); (0x001CE,0x001CE); (0x001D0,0x001D0); (0x001D2,0x001D2); (0x001D4,0x001D4); (0x001D6,0x001D6); (0x001D8,0x001D8); (0x001DA,0x001DA); (0x001DC,0x001DD); (0x001DF,0x001DF); (0x001E1,0x001E1); (0x001E3,0x001E3); (0x001E5,0x001E5); (0x001E7,0x001E7); (0x001E9,0x001E9); (0x001EB,0x001EB); (0x001ED,0x001ED); (0x001EF,0x001F0); (0x001F3,0x001F3); (0x001F5,0x001F5); (0x001F9,0x001F9); (0x001FB,0x001FB); (0x001FD,0x001FD); (0x001FF,0x001FF); (0x00201,0x00201); (0x00203,0x00203); (0x00205,0x00205); (0x00207,0x00207); (0x00209,0x00209); (0x0020B,0x0020B); (0x0020D,0x0020D); (0x0020F,0x0020F); (0x00211,0x00211); (0x00213,0x00213); (0x00215,0x00215); (0x00217,0x00217); (0x00219,0x00219); (0x0021B,0x0021B); (0x0021D,0x0021D); (0x0021F,0x0021F); (0x00221,0x00221); (0x00223,0x00223); (0x00225,0x00225); (0x00227,0x00227); (0x00229,0x00229); (0x0022B,0x0022B); (0x0022D,0x0022D); (0x0022F,0x0022F); (0x00231,0x00231); (0x00233,0x00239); (0x0023C,0x0023C); (0x0023F,0x00240); (0x00242,0x00242); (0x00247,0x00247); (0x00249,0x00249); (0x0024B,0x0024B); (0x0024D,0x0024D); (0x0024F,0x00293); (0x00295,0x002AF); (0x00371,0x00371); (0x00373,0x00373); (0x00377,0x00377); (0x0037B,0x0037D); (0x00390,0x00390); (0x003AC,0x003CE); (0x003D0,0x003D1); (0x003D5,0x003D7); (0x003D9,0x003D9); (0x003DB,0x003DB); (0x003DD,0x003DD); (0x003DF,0x003DF); (0x003E1,0x003E1); (0x003E3,0x003E3); (0x003E5,0x003E5); (0x003E7,0x003E7); (0x003E9,0x003E9); (0x003EB,0x003EB); (0x003ED,0x003ED); (0x003EF,0x003F3); (0x003F5,0x003F5); (0x003F8,0x003F8); (0x003FB,0x003FC); (0x00430,0x0045F); (0x00461,0x00461); (0x00463,0x00463); (0x00465,0x00465); (0x00467,0x00467); (0x00469,0x00469); (0x0046B,0x0046B); (0x0046D,0x0046D); (0x0046F,0x0046F); (0x00471,0x00471); (0x00473,0x00473); (0x00475,0x00475); (0x00477,0x00477); (0x00479,0x00479); (0x0047B,0x0047B); (0x0047D,0x0047D); (0x0047F,0x0047F); (0x00481,0x00481); (0x0048B,0x0048B); (0x0048D,0x0048D); (0x0048F,0x0048F); (0x00491,0x00491); (0x00493,0x00493); (0x00495,0x00495); (0x00497,0x00497); (0x00499,0x00499); (0x0049B,0x0049B); (0x0049D,0x0049D); (0x0049F,0x0049F); (0x004A1,0x004A1); (0x004A3,0x004A3); (0x004A5,0x004A5); (0x004A7,0x004A7); (0x004A9,0x004A9); (0x004AB,0x004AB); (0x004AD,0x004AD); (0x004AF,0x004AF); (0x004B1,0x004B1); (0x004B3,0x004B3); (0x004B5,0x004B5); (0x004B7,0x004B7); (0x004B9,0x004B9); (0x004BB,0x004BB); (0x004BD,0x004BD); (0x004BF,0x004BF); (0x004C2,0x004C2); (0x004C4,0x004C4); (0x004C6,0x004C6); (0x004C8,0x004C8); (0x004CA,0x004CA); (0x004CC,0x004CC); (0x004CE,0x004CF); (0x004D1,0x004D1); (0x004D3,0x004D3); (0x004D5,0x004D5); (0x004D7,0x004D7); (0x004D9,0x004D9); (0x004DB,0x004DB); (0x004DD,0x004DD); (0x004DF,0x004DF); (0x004E1,0x004E1); (0x004E3,0x004E3); (0x004E5,0x004E5); (0x004E7,0x004E7); (0x004E9,0x004E9); (0x004EB,0x004EB); (0x004ED,0x004ED); (0x004EF,0x004EF); (0x004F1,0x004F1); (0x004F3,0x004F3); (0x004F5,0x004F5); (0x004F7,0x004F7); (0x004F9,0x004F9); (0x004FB,0x004FB); (0x004FD,0x004FD); (0x004FF,0x004FF); (0x00501,0x00501); (0x00503,0x00503); (0x00505,0x00505); (0x00507,0x00507); (0x00509,0x00509); (0x0050B,0x0050B); (0x0050D,0x0050D); (0x0050F,0x0050F); (0x00511,0x00511); (0x00513,0x00513); (0x00515,0x00515); (0x00517,0x00517); (0x00519,0x00519); (0x0051B,0x0051B); (0x0051D,0x0051D); (0x0051F,0x0051F); (0x00521,0x00521); (0x00523,0x00523); (0x00525,0x00525); (0x00527,0x00527); (0x00529,0x00529); (0x0052B,0x0052B); (0x0052D,0x0052D); (0x0052F,0x0052F); (0x00561,0x00587); (0x013F8,0x013FD); (0x01C80,0x01C88); (0x01D00,0x01D2B); (0x01D6B,0x01D77); (0x01D79,0x01D9A); (0x01E01,0x01E01); (0x01E03,0x01E03); (0x01E05,0x01E05); (0x01E07,0x01E07); (0x01E09,0x01E09); (0x01E0B,0x01E0B); (0x01E0D,0x01E0D); (0x01E0F,0x01E0F); (0x01E11,0x01E11); (0x01E13,0x01E13); (0x01E15,0x01E15); (0x01E17,0x01E17); (0x01E19,0x01E19); (0x01E1B,0x01E1B); (0x01E1D,0x01E1D); (0x01E1F,0x01E1F); (0x01E21,0x01E21); (0x01E23,0x01E23); (0x01E25,0x01E25); (0x01E27,0x01E27); (0x01E29,0x01E29); (0x01E2B,0x01E2B); (0x01E2D,0x01E2D); (0x01E2F,0x01E2F); (0x01E31,0x01E31); (0x01E33,0x01E33); (0x01E35,0x01E35); (0x01E37,0x01E37); (0x01E39,0x01E39); (0x01E3B,0x01E3B); (0x01E3D,0x01E3D); (0x01E3F,0x01E3F); (0x01E41,0x01E41); (0x01E43,0x01E43); (0x01E45,0x01E45); (0x01E47,0x01E47); (0x01E49,0x01E49); (0x01E4B,0x01E4B); (0x01E4D,0x01E4D); (0x01E4F,0x01E4F); (0x01E51,0x01E51); (0x01E53,0x01E53); (0x01E55,0x01E55); (0x01E57,0x01E57); (0x01E59,0x01E59); (0x01E5B,0x01E5B); (0x01E5D,0x01E5D); (0x01E5F,0x01E5F); (0x01E61,0x01E61); (0x01E63,0x01E63); (0x01E65,0x01E65); (0x01E67,0x01E67); (0x01E69,0x01E69); (0x01E6B,0x01E6B); (0x01E6D,0x01E6D); (0x01E6F,0x01E6F); (0x01E71,0x01E71); (0x01E73,0x01E73); (0x01E75,0x01E75); (0x01E77,0x01E77); (0x01E79,0x01E79); (0x01E7B,0x01E7B); (0x01E7D,0x01E7D); (0x01E7F,0x01E7F); (0x01E81,0x01E81); (0x01E83,0x01E83); (0x01E85,0x01E85); (0x01E87,0x01E87); (0x01E89,0x01E89); (0x01E8B,0x01E8B); (0x01E8D,0x01E8D); (0x01E8F,0x01E8F); (0x01E91,0x01E91); (0x01E93,0x01E93); (0x01E95,0x01E9D); (0x01E9F,0x01E9F); (0x01EA1,0x01EA1); (0x01EA3,0x01EA3); (0x01EA5,0x01EA5); (0x01EA7,0x01EA7); (0x01EA9,0x01EA9); (0x01EAB,0x01EAB); (0x01EAD,0x01EAD); (0x01EAF,0x01EAF); (0x01EB1,0x01EB1); (0x01EB3,0x01EB3); (0x01EB5,0x01EB5); (0x01EB7,0x01EB7); (0x01EB9,0x01EB9); (0x01EBB,0x01EBB); (0x01EBD,0x01EBD); (0x01EBF,0x01EBF); (0x01EC1,0x01EC1); (0x01EC3,0x01EC3); (0x01EC5,0x01EC5); (0x01EC7,0x01EC7); (0x01EC9,0x01EC9); (0x01ECB,0x01ECB); (0x01ECD,0x01ECD); (0x01ECF,0x01ECF); (0x01ED1,0x01ED1); (0x01ED3,0x01ED3); (0x01ED5,0x01ED5); (0x01ED7,0x01ED7); (0x01ED9,0x01ED9); (0x01EDB,0x01EDB); (0x01EDD,0x01EDD); (0x01EDF,0x01EDF); (0x01EE1,0x01EE1); (0x01EE3,0x01EE3); (0x01EE5,0x01EE5); (0x01EE7,0x01EE7); (0x01EE9,0x01EE9); (0x01EEB,0x01EEB); (0x01EED,0x01EED); (0x01EEF,0x01EEF); (0x01EF1,0x01EF1); (0x01EF3,0x01EF3); (0x01EF5,0x01EF5); (0x01EF7,0x01EF7); (0x01EF9,0x01EF9); (0x01EFB,0x01EFB); (0x01EFD,0x01EFD); (0x01EFF,0x01F07); (0x01F10,0x01F15); (0x01F20,0x01F27); (0x01F30,0x01F37); (0x01F40,0x01F45); (0x01F50,0x01F57); (0x01F60,0x01F67); (0x01F70,0x01F7D); (0x01F80,0x01F87); (0x01F90,0x01F97); (0x01FA0,0x01FA7); (0x01FB0,0x01FB4); (0x01FB6,0x01FB7); (0x01FBE,0x01FBE); (0x01FC2,0x01FC4); (0x01FC6,0x01FC7); (0x01FD0,0x01FD3); (0x01FD6,0x01FD7); (0x01FE0,0x01FE7); (0x01FF2,0x01FF4); (0x01FF6,0x01FF7); (0x0210A,0x0210A); (0x0210E,0x0210F); (0x02113,0x02113); (0x0212F,0x0212F); (0x02134,0x02134); (0x02139,0x02139); (0x0213C,0x0213D); (0x02146,0x02149); (0x0214E,0x0214E); (0x02184,0x02184); (0x02C30,0x02C5E); (0x02C61,0x02C61); (0x02C65,0x02C66); (0x02C68,0x02C68); (0x02C6A,0x02C6A); (0x02C6C,0x02C6C); (0x02C71,0x02C71); (0x02C73,0x02C74); (0x02C76,0x02C7B); (0x02C81,0x02C81); (0x02C83,0x02C83); (0x02C85,0x02C85); (0x02C87,0x02C87); (0x02C89,0x02C89); (0x02C8B,0x02C8B); (0x02C8D,0x02C8D); (0x02C8F,0x02C8F); (0x02C91,0x02C91); (0x02C93,0x02C93); (0x02C95,0x02C95); (0x02C97,0x02C97); (0x02C99,0x02C99); (0x02C9B,0x02C9B); (0x02C9D,0x02C9D); (0x02C9F,0x02C9F); (0x02CA1,0x02CA1); (0x02CA3,0x02CA3); (0x02CA5,0x02CA5); (0x02CA7,0x02CA7); (0x02CA9,0x02CA9); (0x02CAB,0x02CAB); (0x02CAD,0x02CAD); (0x02CAF,0x02CAF); (0x02CB1,0x02CB1); (0x02CB3,0x02CB3); (0x02CB5,0x02CB5); (0x02CB7,0x02CB7); (0x02CB9,0x02CB9); (0x02CBB,0x02CBB); (0x02CBD,0x02CBD); (0x02CBF,0x02CBF); (0x02CC1,0x02CC1); (0x02CC3,0x02CC3); (0x02CC5,0x02CC5); (0x02CC7,0x02CC7); (0x02CC9,0x02CC9); (0x02CCB,0x02CCB); (0x02CCD,0x02CCD); (0x02CCF,0x02CCF); (0x02CD1,0x02CD1); (0x02CD3,0x02CD3); (0x02CD5,0x02CD5); (0x02CD7,0x02CD7); (0x02CD9,0x02CD9); (0x02CDB,0x02CDB); (0x02CDD,0x02CDD); (0x02CDF,0x02CDF); (0x02CE1,0x02CE1); (0x02CE3,0x02CE4); (0x02CEC,0x02CEC); (0x02CEE,0x02CEE); (0x02CF3,0x02CF3); (0x02D00,0x02D25); (0x02D27,0x02D27); (0x02D2D,0x02D2D); (0x0A641,0x0A641); (0x0A643,0x0A643); (0x0A645,0x0A645); (0x0A647,0x0A647); (0x0A649,0x0A649); (0x0A64B,0x0A64B); (0x0A64D,0x0A64D); (0x0A64F,0x0A64F); (0x0A651,0x0A651); (0x0A653,0x0A653); (0x0A655,0x0A655); (0x0A657,0x0A657); (0x0A659,0x0A659); (0x0A65B,0x0A65B); (0x0A65D,0x0A65D); (0x0A65F,0x0A65F); (0x0A661,0x0A661); (0x0A663,0x0A663); (0x0A665,0x0A665); (0x0A667,0x0A667); (0x0A669,0x0A669); (0x0A66B,0x0A66B); (0x0A66D,0x0A66D); (0x0A681,0x0A681); (0x0A683,0x0A683); (0x0A685,0x0A685); (0x0A687,0x0A687); (0x0A689,0x0A689); (0x0A68B,0x0A68B); (0x0A68D,0x0A68D); (0x0A68F,0x0A68F); (0x0A691,0x0A691); (0x0A693,0x0A693); (0x0A695,0x0A695); (0x0A697,0x0A697); (0x0A699,0x0A699); (0x0A69B,0x0A69B); (0x0A723,0x0A723); (0x0A725,0x0A725); (0x0A727,0x0A727); (0x0A729,0x0A729); (0x0A72B,0x0A72B); (0x0A72D,0x0A72D); (0x0A72F,0x0A731); (0x0A733,0x0A733); (0x0A735,0x0A735); (0x0A737,0x0A737); (0x0A739,0x0A739); (0x0A73B,0x0A73B); (0x0A73D,0x0A73D); (0x0A73F,0x0A73F); (0x0A741,0x0A741); (0x0A743,0x0A743); (0x0A745,0x0A745); (0x0A747,0x0A747); (0x0A749,0x0A749); (0x0A74B,0x0A74B); (0x0A74D,0x0A74D); (0x0A74F,0x0A74F); (0x0A751,0x0A751); (0x0A753,0x0A753); (0x0A755,0x0A755); (0x0A757,0x0A757); (0x0A759,0x0A759); (0x0A75B,0x0A75B); (0x0A75D,0x0A75D); (0x0A75F,0x0A75F); (0x0A761,0x0A761); (0x0A763,0x0A763); (0x0A765,0x0A765); (0x0A767,0x0A767); (0x0A769,0x0A769); (0x0A76B,0x0A76B); (0x0A76D,0x0A76D); (0x0A76F,0x0A76F); (0x0A771,0x0A778); (0x0A77A,0x0A77A); (0x0A77C,0x0A77C); (0x0A77F,0x0A77F); (0x0A781,0x0A781); (0x0A783,0x0A783); (0x0A785,0x0A785); (0x0A787,0x0A787); (0x0A78C,0x0A78C); (0x0A78E,0x0A78E); (0x0A791,0x0A791); (0x0A793,0x0A795); (0x0A797,0x0A797); (0x0A799,0x0A799); (0x0A79B,0x0A79B); (0x0A79D,0x0A79D); (0x0A79F,0x0A79F); (0x0A7A1,0x0A7A1); (0x0A7A3,0x0A7A3); (0x0A7A5,0x0A7A5); (0x0A7A7,0x0A7A7); (0x0A7A9,0x0A7A9); (0x0A7B5,0x0A7B5); (0x0A7B7,0x0A7B7); (0x0A7FA,0x0A7FA); (0x0AB30,0x0AB5A); (0x0AB60,0x0AB65); (0x0AB70,0x0ABBF); (0x0FB00,0x0FB06); (0x0FB13,0x0FB17); (0x0FF41,0x0FF5A); (0x10428,0x1044F); (0x104D8,0x104FB); (0x10CC0,0x10CF2); (0x118C0,0x118DF); (0x1D41A,0x1D433); (0x1D44E,0x1D454); (0x1D456,0x1D467); (0x1D482,0x1D49B); (0x1D4B6,0x1D4B9); (0x1D4BB,0x1D4BB); (0x1D4BD,0x1D4C3); (0x1D4C5,0x1D4CF); (0x1D4EA,0x1D503); (0x1D51E,0x1D537); (0x1D552,0x1D56B); (0x1D586,0x1D59F); (0x1D5BA,0x1D5D3); (0x1D5EE,0x1D607); (0x1D622,0x1D63B); (0x1D656,0x1D66F); (0x1D68A,0x1D6A5); (0x1D6C2,0x1D6DA); (0x1D6DC,0x1D6E1); (0x1D6FC,0x1D714); (0x1D716,0x1D71B); (0x1D736,0x1D74E); (0x1D750,0x1D755); (0x1D770,0x1D788); (0x1D78A,0x1D78F); (0x1D7AA,0x1D7C2); (0x1D7C4,0x1D7C9); (0x1D7CB,0x1D7CB) ] (* Letter, Titlecase *) let lt = [ (0x001C5,0x001C5); (0x001C8,0x001C8); (0x001CB,0x001CB); (0x001F2,0x001F2); (0x01F88,0x01F8F); (0x01F98,0x01F9F); (0x01FA8,0x01FAF); (0x01FBC,0x01FBC); (0x01FCC,0x01FCC) ] (* Mark, Non-Spacing *) let mn = [ (0x00300,0x0036F); (0x00483,0x00487); (0x00591,0x005BD); (0x005BF,0x005BF); (0x005C1,0x005C2); (0x005C4,0x005C5); (0x005C7,0x005C7); (0x00610,0x0061A); (0x0064B,0x0065F); (0x00670,0x00670); (0x006D6,0x006DC); (0x006DF,0x006E4); (0x006E7,0x006E8); (0x006EA,0x006ED); (0x00711,0x00711); (0x00730,0x0074A); (0x007A6,0x007B0); (0x007EB,0x007F3); (0x00816,0x00819); (0x0081B,0x00823); (0x00825,0x00827); (0x00829,0x0082D); (0x00859,0x0085B); (0x008D4,0x008E1); (0x008E3,0x00902); (0x0093A,0x0093A); (0x0093C,0x0093C); (0x00941,0x00948); (0x0094D,0x0094D); (0x00951,0x00957); (0x00962,0x00963); (0x00981,0x00981); (0x009BC,0x009BC); (0x009C1,0x009C4); (0x009CD,0x009CD); (0x009E2,0x009E3); (0x00A01,0x00A02); (0x00A3C,0x00A3C); (0x00A41,0x00A42); (0x00A47,0x00A48); (0x00A4B,0x00A4D); (0x00A51,0x00A51); (0x00A70,0x00A71); (0x00A75,0x00A75); (0x00A81,0x00A82); (0x00ABC,0x00ABC); (0x00AC1,0x00AC5); (0x00AC7,0x00AC8); (0x00ACD,0x00ACD); (0x00AE2,0x00AE3); (0x00B01,0x00B01); (0x00B3C,0x00B3C); (0x00B3F,0x00B3F); (0x00B41,0x00B44); (0x00B4D,0x00B4D); (0x00B56,0x00B56); (0x00B62,0x00B63); (0x00B82,0x00B82); (0x00BC0,0x00BC0); (0x00BCD,0x00BCD); (0x00C00,0x00C00); (0x00C3E,0x00C40); (0x00C46,0x00C48); (0x00C4A,0x00C4D); (0x00C55,0x00C56); (0x00C62,0x00C63); (0x00C81,0x00C81); (0x00CBC,0x00CBC); (0x00CBF,0x00CBF); (0x00CC6,0x00CC6); (0x00CCC,0x00CCD); (0x00CE2,0x00CE3); (0x00D01,0x00D01); (0x00D41,0x00D44); (0x00D4D,0x00D4D); (0x00D62,0x00D63); (0x00DCA,0x00DCA); (0x00DD2,0x00DD4); (0x00DD6,0x00DD6); (0x00E31,0x00E31); (0x00E34,0x00E3A); (0x00E47,0x00E4E); (0x00EB1,0x00EB1); (0x00EB4,0x00EB9); (0x00EBB,0x00EBC); (0x00EC8,0x00ECD); (0x00F18,0x00F19); (0x00F35,0x00F35); (0x00F37,0x00F37); (0x00F39,0x00F39); (0x00F71,0x00F7E); (0x00F80,0x00F84); (0x00F86,0x00F87); (0x00F8D,0x00F97); (0x00F99,0x00FBC); (0x00FC6,0x00FC6); (0x0102D,0x01030); (0x01032,0x01037); (0x01039,0x0103A); (0x0103D,0x0103E); (0x01058,0x01059); (0x0105E,0x01060); (0x01071,0x01074); (0x01082,0x01082); (0x01085,0x01086); (0x0108D,0x0108D); (0x0109D,0x0109D); (0x0135D,0x0135F); (0x01712,0x01714); (0x01732,0x01734); (0x01752,0x01753); (0x01772,0x01773); (0x017B4,0x017B5); (0x017B7,0x017BD); (0x017C6,0x017C6); (0x017C9,0x017D3); (0x017DD,0x017DD); (0x0180B,0x0180D); (0x01885,0x01886); (0x018A9,0x018A9); (0x01920,0x01922); (0x01927,0x01928); (0x01932,0x01932); (0x01939,0x0193B); (0x01A17,0x01A18); (0x01A1B,0x01A1B); (0x01A56,0x01A56); (0x01A58,0x01A5E); (0x01A60,0x01A60); (0x01A62,0x01A62); (0x01A65,0x01A6C); (0x01A73,0x01A7C); (0x01A7F,0x01A7F); (0x01AB0,0x01ABD); (0x01B00,0x01B03); (0x01B34,0x01B34); (0x01B36,0x01B3A); (0x01B3C,0x01B3C); (0x01B42,0x01B42); (0x01B6B,0x01B73); (0x01B80,0x01B81); (0x01BA2,0x01BA5); (0x01BA8,0x01BA9); (0x01BAB,0x01BAD); (0x01BE6,0x01BE6); (0x01BE8,0x01BE9); (0x01BED,0x01BED); (0x01BEF,0x01BF1); (0x01C2C,0x01C33); (0x01C36,0x01C37); (0x01CD0,0x01CD2); (0x01CD4,0x01CE0); (0x01CE2,0x01CE8); (0x01CED,0x01CED); (0x01CF4,0x01CF4); (0x01CF8,0x01CF9); (0x01DC0,0x01DF5); (0x01DFB,0x01DFF); (0x020D0,0x020DC); (0x020E1,0x020E1); (0x020E5,0x020F0); (0x02CEF,0x02CF1); (0x02D7F,0x02D7F); (0x02DE0,0x02DFF); (0x0302A,0x0302D); (0x03099,0x0309A); (0x0A66F,0x0A66F); (0x0A674,0x0A67D); (0x0A69E,0x0A69F); (0x0A6F0,0x0A6F1); (0x0A802,0x0A802); (0x0A806,0x0A806); (0x0A80B,0x0A80B); (0x0A825,0x0A826); (0x0A8C4,0x0A8C5); (0x0A8E0,0x0A8F1); (0x0A926,0x0A92D); (0x0A947,0x0A951); (0x0A980,0x0A982); (0x0A9B3,0x0A9B3); (0x0A9B6,0x0A9B9); (0x0A9BC,0x0A9BC); (0x0A9E5,0x0A9E5); (0x0AA29,0x0AA2E); (0x0AA31,0x0AA32); (0x0AA35,0x0AA36); (0x0AA43,0x0AA43); (0x0AA4C,0x0AA4C); (0x0AA7C,0x0AA7C); (0x0AAB0,0x0AAB0); (0x0AAB2,0x0AAB4); (0x0AAB7,0x0AAB8); (0x0AABE,0x0AABF); (0x0AAC1,0x0AAC1); (0x0AAEC,0x0AAED); (0x0AAF6,0x0AAF6); (0x0ABE5,0x0ABE5); (0x0ABE8,0x0ABE8); (0x0ABED,0x0ABED); (0x0FB1E,0x0FB1E); (0x0FE00,0x0FE0F); (0x0FE20,0x0FE2F); (0x101FD,0x101FD); (0x102E0,0x102E0); (0x10376,0x1037A); (0x10A01,0x10A03); (0x10A05,0x10A06); (0x10A0C,0x10A0F); (0x10A38,0x10A3A); (0x10A3F,0x10A3F); (0x10AE5,0x10AE6); (0x11001,0x11001); (0x11038,0x11046); (0x1107F,0x11081); (0x110B3,0x110B6); (0x110B9,0x110BA); (0x11100,0x11102); (0x11127,0x1112B); (0x1112D,0x11134); (0x11173,0x11173); (0x11180,0x11181); (0x111B6,0x111BE); (0x111CA,0x111CC); (0x1122F,0x11231); (0x11234,0x11234); (0x11236,0x11237); (0x1123E,0x1123E); (0x112DF,0x112DF); (0x112E3,0x112EA); (0x11300,0x11301); (0x1133C,0x1133C); (0x11340,0x11340); (0x11366,0x1136C); (0x11370,0x11374); (0x11438,0x1143F); (0x11442,0x11444); (0x11446,0x11446); (0x114B3,0x114B8); (0x114BA,0x114BA); (0x114BF,0x114C0); (0x114C2,0x114C3); (0x115B2,0x115B5); (0x115BC,0x115BD); (0x115BF,0x115C0); (0x115DC,0x115DD); (0x11633,0x1163A); (0x1163D,0x1163D); (0x1163F,0x11640); (0x116AB,0x116AB); (0x116AD,0x116AD); (0x116B0,0x116B5); (0x116B7,0x116B7); (0x1171D,0x1171F); (0x11722,0x11725); (0x11727,0x1172B); (0x11C30,0x11C36); (0x11C38,0x11C3D); (0x11C3F,0x11C3F); (0x11C92,0x11CA7); (0x11CAA,0x11CB0); (0x11CB2,0x11CB3); (0x11CB5,0x11CB6); (0x16AF0,0x16AF4); (0x16B30,0x16B36); (0x16F8F,0x16F92); (0x1BC9D,0x1BC9E); (0x1D167,0x1D169); (0x1D17B,0x1D182); (0x1D185,0x1D18B); (0x1D1AA,0x1D1AD); (0x1D242,0x1D244); (0x1DA00,0x1DA36); (0x1DA3B,0x1DA6C); (0x1DA75,0x1DA75); (0x1DA84,0x1DA84); (0x1DA9B,0x1DA9F); (0x1DAA1,0x1DAAF); (0x1E000,0x1E006); (0x1E008,0x1E018); (0x1E01B,0x1E021); (0x1E023,0x1E024); (0x1E026,0x1E02A); (0x1E8D0,0x1E8D6); (0x1E944,0x1E94A) ] (* Mark, Spacing Combining *) let mc = [ (0x00903,0x00903); (0x0093B,0x0093B); (0x0093E,0x00940); (0x00949,0x0094C); (0x0094E,0x0094F); (0x00982,0x00983); (0x009BE,0x009C0); (0x009C7,0x009C8); (0x009CB,0x009CC); (0x009D7,0x009D7); (0x00A03,0x00A03); (0x00A3E,0x00A40); (0x00A83,0x00A83); (0x00ABE,0x00AC0); (0x00AC9,0x00AC9); (0x00ACB,0x00ACC); (0x00B02,0x00B03); (0x00B3E,0x00B3E); (0x00B40,0x00B40); (0x00B47,0x00B48); (0x00B4B,0x00B4C); (0x00B57,0x00B57); (0x00BBE,0x00BBF); (0x00BC1,0x00BC2); (0x00BC6,0x00BC8); (0x00BCA,0x00BCC); (0x00BD7,0x00BD7); (0x00C01,0x00C03); (0x00C41,0x00C44); (0x00C82,0x00C83); (0x00CBE,0x00CBE); (0x00CC0,0x00CC4); (0x00CC7,0x00CC8); (0x00CCA,0x00CCB); (0x00CD5,0x00CD6); (0x00D02,0x00D03); (0x00D3E,0x00D40); (0x00D46,0x00D48); (0x00D4A,0x00D4C); (0x00D57,0x00D57); (0x00D82,0x00D83); (0x00DCF,0x00DD1); (0x00DD8,0x00DDF); (0x00DF2,0x00DF3); (0x00F3E,0x00F3F); (0x00F7F,0x00F7F); (0x0102B,0x0102C); (0x01031,0x01031); (0x01038,0x01038); (0x0103B,0x0103C); (0x01056,0x01057); (0x01062,0x01064); (0x01067,0x0106D); (0x01083,0x01084); (0x01087,0x0108C); (0x0108F,0x0108F); (0x0109A,0x0109C); (0x017B6,0x017B6); (0x017BE,0x017C5); (0x017C7,0x017C8); (0x01923,0x01926); (0x01929,0x0192B); (0x01930,0x01931); (0x01933,0x01938); (0x01A19,0x01A1A); (0x01A55,0x01A55); (0x01A57,0x01A57); (0x01A61,0x01A61); (0x01A63,0x01A64); (0x01A6D,0x01A72); (0x01B04,0x01B04); (0x01B35,0x01B35); (0x01B3B,0x01B3B); (0x01B3D,0x01B41); (0x01B43,0x01B44); (0x01B82,0x01B82); (0x01BA1,0x01BA1); (0x01BA6,0x01BA7); (0x01BAA,0x01BAA); (0x01BE7,0x01BE7); (0x01BEA,0x01BEC); (0x01BEE,0x01BEE); (0x01BF2,0x01BF3); (0x01C24,0x01C2B); (0x01C34,0x01C35); (0x01CE1,0x01CE1); (0x01CF2,0x01CF3); (0x0302E,0x0302F); (0x0A823,0x0A824); (0x0A827,0x0A827); (0x0A880,0x0A881); (0x0A8B4,0x0A8C3); (0x0A952,0x0A953); (0x0A983,0x0A983); (0x0A9B4,0x0A9B5); (0x0A9BA,0x0A9BB); (0x0A9BD,0x0A9C0); (0x0AA2F,0x0AA30); (0x0AA33,0x0AA34); (0x0AA4D,0x0AA4D); (0x0AA7B,0x0AA7B); (0x0AA7D,0x0AA7D); (0x0AAEB,0x0AAEB); (0x0AAEE,0x0AAEF); (0x0AAF5,0x0AAF5); (0x0ABE3,0x0ABE4); (0x0ABE6,0x0ABE7); (0x0ABE9,0x0ABEA); (0x0ABEC,0x0ABEC); (0x11000,0x11000); (0x11002,0x11002); (0x11082,0x11082); (0x110B0,0x110B2); (0x110B7,0x110B8); (0x1112C,0x1112C); (0x11182,0x11182); (0x111B3,0x111B5); (0x111BF,0x111C0); (0x1122C,0x1122E); (0x11232,0x11233); (0x11235,0x11235); (0x112E0,0x112E2); (0x11302,0x11303); (0x1133E,0x1133F); (0x11341,0x11344); (0x11347,0x11348); (0x1134B,0x1134D); (0x11357,0x11357); (0x11362,0x11363); (0x11435,0x11437); (0x11440,0x11441); (0x11445,0x11445); (0x114B0,0x114B2); (0x114B9,0x114B9); (0x114BB,0x114BE); (0x114C1,0x114C1); (0x115AF,0x115B1); (0x115B8,0x115BB); (0x115BE,0x115BE); (0x11630,0x11632); (0x1163B,0x1163C); (0x1163E,0x1163E); (0x116AC,0x116AC); (0x116AE,0x116AF); (0x116B6,0x116B6); (0x11720,0x11721); (0x11726,0x11726); (0x11C2F,0x11C2F); (0x11C3E,0x11C3E); (0x11CA9,0x11CA9); (0x11CB1,0x11CB1); (0x11CB4,0x11CB4); (0x16F51,0x16F7E); (0x1D165,0x1D166) ] (* Mark, Enclosing *) let me = [ (0x00488,0x00489); (0x01ABE,0x01ABE); (0x020DD,0x020E0); (0x020E2,0x020E4) ] (* Number, Decimal Digit *) let nd = [ (0x00030,0x00039); (0x00660,0x00669); (0x006F0,0x006F9); (0x007C0,0x007C9); (0x00966,0x0096F); (0x009E6,0x009EF); (0x00A66,0x00A6F); (0x00AE6,0x00AEF); (0x00B66,0x00B6F); (0x00BE6,0x00BEF); (0x00C66,0x00C6F); (0x00CE6,0x00CEF); (0x00D66,0x00D6F); (0x00DE6,0x00DEF); (0x00E50,0x00E59); (0x00ED0,0x00ED9); (0x00F20,0x00F29); (0x01040,0x01049); (0x01090,0x01099); (0x017E0,0x017E9); (0x01810,0x01819); (0x01946,0x0194F); (0x019D0,0x019D9); (0x01A80,0x01A89); (0x01A90,0x01A99); (0x01B50,0x01B59); (0x01BB0,0x01BB9); (0x01C40,0x01C49); (0x01C50,0x01C59); (0x0A620,0x0A629); (0x0A8D0,0x0A8D9); (0x0A900,0x0A909); (0x0A9D0,0x0A9D9); (0x0A9F0,0x0A9F9); (0x0AA50,0x0AA59); (0x0ABF0,0x0ABF9); (0x0FF10,0x0FF19); (0x104A0,0x104A9); (0x11066,0x1106F); (0x110F0,0x110F9); (0x11136,0x1113F); (0x111D0,0x111D9); (0x112F0,0x112F9); (0x11450,0x11459); (0x114D0,0x114D9); (0x11650,0x11659); (0x116C0,0x116C9); (0x11730,0x11739); (0x118E0,0x118E9); (0x11C50,0x11C59); (0x16A60,0x16A69); (0x16B50,0x16B59); (0x1D7CE,0x1D7FF) ] (* Number, Letter *) let nl = [ (0x016EE,0x016F0); (0x02160,0x02182); (0x02185,0x02188); (0x03007,0x03007); (0x03021,0x03029); (0x03038,0x0303A); (0x0A6E6,0x0A6EF); (0x10140,0x10174); (0x10341,0x10341); (0x1034A,0x1034A); (0x103D1,0x103D5) ] (* Number, Other *) let no = [ (0x000B2,0x000B3); (0x000B9,0x000B9); (0x000BC,0x000BE); (0x009F4,0x009F9); (0x00B72,0x00B77); (0x00BF0,0x00BF2); (0x00C78,0x00C7E); (0x00D58,0x00D5E); (0x00D70,0x00D78); (0x00F2A,0x00F33); (0x01369,0x0137C); (0x017F0,0x017F9); (0x019DA,0x019DA); (0x02070,0x02070); (0x02074,0x02079); (0x02080,0x02089); (0x02150,0x0215F); (0x02189,0x02189); (0x02460,0x0249B); (0x024EA,0x024FF); (0x02776,0x02793); (0x02CFD,0x02CFD); (0x03192,0x03195); (0x03220,0x03229); (0x03248,0x0324F); (0x03251,0x0325F); (0x03280,0x03289); (0x032B1,0x032BF); (0x0A830,0x0A835); (0x10107,0x10133); (0x10175,0x10178); (0x1018A,0x1018B); (0x102E1,0x102FB); (0x10320,0x10323); (0x10858,0x1085F); (0x10879,0x1087F); (0x108A7,0x108AF); (0x108FB,0x108FF); (0x10916,0x1091B); (0x109BC,0x109BD); (0x109C0,0x109CF); (0x109D2,0x109FF); (0x10A40,0x10A47); (0x10A7D,0x10A7E); (0x10A9D,0x10A9F); (0x10AEB,0x10AEF); (0x10B58,0x10B5F); (0x10B78,0x10B7F); (0x10BA9,0x10BAF); (0x10CFA,0x10CFF); (0x10E60,0x10E7E); (0x11052,0x11065); (0x111E1,0x111F4); (0x1173A,0x1173B); (0x118EA,0x118F2); (0x11C5A,0x11C6C); (0x16B5B,0x16B61); (0x1D360,0x1D371); (0x1E8C7,0x1E8CF) ] (* Separator, Space *) let zs = [ (0x00020,0x00020); (0x000A0,0x000A0); (0x01680,0x01680); (0x02000,0x0200A); (0x0202F,0x0202F); (0x0205F,0x0205F) ] (* Separator, Line *) let zl = [ ] (* Separator, Paragraph *) let zp = [ ] (* Other, Control *) let cc = [ (0x00000,0x0001F) ] (* Other, Format *) let cf = [ (0x000AD,0x000AD); (0x00600,0x00605); (0x0061C,0x0061C); (0x006DD,0x006DD); (0x0070F,0x0070F); (0x008E2,0x008E2); (0x0180E,0x0180E); (0x0200B,0x0200F); (0x0202A,0x0202E); (0x02060,0x02064); (0x02066,0x0206F); (0x0FEFF,0x0FEFF); (0x0FFF9,0x0FFFB); (0x110BD,0x110BD); (0x1BCA0,0x1BCA3); (0x1D173,0x1D17A); (0xE0001,0xE0001) ] (* Other, Surrogate *) let cs = [ ] (* Other, Private Use *) let co = [ (0x0E000,0x0F8FF); (0xF0000,0xFFFFD) ] (* Other, Not Assigned *) let cn = [ (0x00378,0x00379); (0x00380,0x00383); (0x0038B,0x0038B); (0x0038D,0x0038D); (0x003A2,0x003A2); (0x00530,0x00530); (0x00557,0x00558); (0x00560,0x00560); (0x00588,0x00588); (0x0058B,0x0058C); (0x00590,0x00590); (0x005C8,0x005CF); (0x005EB,0x005EF); (0x005F5,0x005FF); (0x0061D,0x0061D); (0x0070E,0x0070E); (0x0074B,0x0074C); (0x007B2,0x007BF); (0x007FB,0x007FF); (0x0082E,0x0082F); (0x0083F,0x0083F); (0x0085C,0x0085D); (0x0085F,0x0089F); (0x008B5,0x008B5); (0x008BE,0x008D3); (0x00984,0x00984); (0x0098D,0x0098E); (0x00991,0x00992); (0x009A9,0x009A9); (0x009B1,0x009B1); (0x009B3,0x009B5); (0x009BA,0x009BB); (0x009C5,0x009C6); (0x009C9,0x009CA); (0x009CF,0x009D6); (0x009D8,0x009DB); (0x009DE,0x009DE); (0x009E4,0x009E5); (0x009FC,0x00A00); (0x00A04,0x00A04); (0x00A0B,0x00A0E); (0x00A11,0x00A12); (0x00A29,0x00A29); (0x00A31,0x00A31); (0x00A34,0x00A34); (0x00A37,0x00A37); (0x00A3A,0x00A3B); (0x00A3D,0x00A3D); (0x00A43,0x00A46); (0x00A49,0x00A4A); (0x00A4E,0x00A50); (0x00A52,0x00A58); (0x00A5D,0x00A5D); (0x00A5F,0x00A65); (0x00A76,0x00A80); (0x00A84,0x00A84); (0x00A8E,0x00A8E); (0x00A92,0x00A92); (0x00AA9,0x00AA9); (0x00AB1,0x00AB1); (0x00AB4,0x00AB4); (0x00ABA,0x00ABB); (0x00AC6,0x00AC6); (0x00ACA,0x00ACA); (0x00ACE,0x00ACF); (0x00AD1,0x00ADF); (0x00AE4,0x00AE5); (0x00AF2,0x00AF8); (0x00AFA,0x00B00); (0x00B04,0x00B04); (0x00B0D,0x00B0E); (0x00B11,0x00B12); (0x00B29,0x00B29); (0x00B31,0x00B31); (0x00B34,0x00B34); (0x00B3A,0x00B3B); (0x00B45,0x00B46); (0x00B49,0x00B4A); (0x00B4E,0x00B55); (0x00B58,0x00B5B); (0x00B5E,0x00B5E); (0x00B64,0x00B65); (0x00B78,0x00B81); (0x00B84,0x00B84); (0x00B8B,0x00B8D); (0x00B91,0x00B91); (0x00B96,0x00B98); (0x00B9B,0x00B9B); (0x00B9D,0x00B9D); (0x00BA0,0x00BA2); (0x00BA5,0x00BA7); (0x00BAB,0x00BAD); (0x00BBA,0x00BBD); (0x00BC3,0x00BC5); (0x00BC9,0x00BC9); (0x00BCE,0x00BCF); (0x00BD1,0x00BD6); (0x00BD8,0x00BE5); (0x00BFB,0x00BFF); (0x00C04,0x00C04); (0x00C0D,0x00C0D); (0x00C11,0x00C11); (0x00C29,0x00C29); (0x00C3A,0x00C3C); (0x00C45,0x00C45); (0x00C49,0x00C49); (0x00C4E,0x00C54); (0x00C57,0x00C57); (0x00C5B,0x00C5F); (0x00C64,0x00C65); (0x00C70,0x00C77); (0x00C84,0x00C84); (0x00C8D,0x00C8D); (0x00C91,0x00C91); (0x00CA9,0x00CA9); (0x00CB4,0x00CB4); (0x00CBA,0x00CBB); (0x00CC5,0x00CC5); (0x00CC9,0x00CC9); (0x00CCE,0x00CD4); (0x00CD7,0x00CDD); (0x00CDF,0x00CDF); (0x00CE4,0x00CE5); (0x00CF0,0x00CF0); (0x00CF3,0x00D00); (0x00D04,0x00D04); (0x00D0D,0x00D0D); (0x00D11,0x00D11); (0x00D3B,0x00D3C); (0x00D45,0x00D45); (0x00D49,0x00D49); (0x00D50,0x00D53); (0x00D64,0x00D65); (0x00D80,0x00D81); (0x00D84,0x00D84); (0x00D97,0x00D99); (0x00DB2,0x00DB2); (0x00DBC,0x00DBC); (0x00DBE,0x00DBF); (0x00DC7,0x00DC9); (0x00DCB,0x00DCE); (0x00DD5,0x00DD5); (0x00DD7,0x00DD7); (0x00DE0,0x00DE5); (0x00DF0,0x00DF1); (0x00DF5,0x00E00); (0x00E3B,0x00E3E); (0x00E5C,0x00E80); (0x00E83,0x00E83); (0x00E85,0x00E86); (0x00E89,0x00E89); (0x00E8B,0x00E8C); (0x00E8E,0x00E93); (0x00E98,0x00E98); (0x00EA0,0x00EA0); (0x00EA4,0x00EA4); (0x00EA6,0x00EA6); (0x00EA8,0x00EA9); (0x00EAC,0x00EAC); (0x00EBA,0x00EBA); (0x00EBE,0x00EBF); (0x00EC5,0x00EC5); (0x00EC7,0x00EC7); (0x00ECE,0x00ECF); (0x00EDA,0x00EDB); (0x00EE0,0x00EFF); (0x00F48,0x00F48); (0x00F6D,0x00F70); (0x00F98,0x00F98); (0x00FBD,0x00FBD); (0x00FCD,0x00FCD); (0x00FDB,0x00FFF); (0x010C6,0x010C6); (0x010C8,0x010CC); (0x010CE,0x010CF); (0x01249,0x01249); (0x0124E,0x0124F); (0x01257,0x01257); (0x01259,0x01259); (0x0125E,0x0125F); (0x01289,0x01289); (0x0128E,0x0128F); (0x012B1,0x012B1); (0x012B6,0x012B7); (0x012BF,0x012BF); (0x012C1,0x012C1); (0x012C6,0x012C7); (0x012D7,0x012D7); (0x01311,0x01311); (0x01316,0x01317); (0x0135B,0x0135C); (0x0137D,0x0137F); (0x0139A,0x0139F); (0x013F6,0x013F7); (0x013FE,0x013FF); (0x0169D,0x0169F); (0x016F9,0x016FF); (0x0170D,0x0170D); (0x01715,0x0171F); (0x01737,0x0173F); (0x01754,0x0175F); (0x0176D,0x0176D); (0x01771,0x01771); (0x01774,0x0177F); (0x017DE,0x017DF); (0x017EA,0x017EF); (0x017FA,0x017FF); (0x0180F,0x0180F); (0x0181A,0x0181F); (0x01878,0x0187F); (0x018AB,0x018AF); (0x018F6,0x018FF); (0x0191F,0x0191F); (0x0192C,0x0192F); (0x0193C,0x0193F); (0x01941,0x01943); (0x0196E,0x0196F); (0x01975,0x0197F); (0x019AC,0x019AF); (0x019CA,0x019CF); (0x019DB,0x019DD); (0x01A1C,0x01A1D); (0x01A5F,0x01A5F); (0x01A7D,0x01A7E); (0x01A8A,0x01A8F); (0x01A9A,0x01A9F); (0x01AAE,0x01AAF); (0x01ABF,0x01AFF); (0x01B4C,0x01B4F); (0x01B7D,0x01B7F); (0x01BF4,0x01BFB); (0x01C38,0x01C3A); (0x01C4A,0x01C4C); (0x01C89,0x01CBF); (0x01CC8,0x01CCF); (0x01CF7,0x01CF7); (0x01CFA,0x01CFF); (0x01DF6,0x01DFA); (0x01F16,0x01F17); (0x01F1E,0x01F1F); (0x01F46,0x01F47); (0x01F4E,0x01F4F); (0x01F58,0x01F58); (0x01F5A,0x01F5A); (0x01F5C,0x01F5C); (0x01F5E,0x01F5E); (0x01F7E,0x01F7F); (0x01FB5,0x01FB5); (0x01FC5,0x01FC5); (0x01FD4,0x01FD5); (0x01FDC,0x01FDC); (0x01FF0,0x01FF1); (0x01FF5,0x01FF5); (0x01FFF,0x01FFF); (0x02065,0x02065); (0x02072,0x02073); (0x0208F,0x0208F); (0x0209D,0x0209F); (0x020BF,0x020CF); (0x020F1,0x020FF); (0x0218C,0x0218F); (0x023FF,0x023FF); (0x02427,0x0243F); (0x0244B,0x0245F); (0x02B74,0x02B75); (0x02B96,0x02B97); (0x02BBA,0x02BBC); (0x02BC9,0x02BC9); (0x02BD2,0x02BEB); (0x02BF0,0x02BFF); (0x02C2F,0x02C2F); (0x02C5F,0x02C5F); (0x02CF4,0x02CF8); (0x02D26,0x02D26); (0x02D28,0x02D2C); (0x02D2E,0x02D2F); (0x02D68,0x02D6E); (0x02D71,0x02D7E); (0x02D97,0x02D9F); (0x02DA7,0x02DA7); (0x02DAF,0x02DAF); (0x02DB7,0x02DB7); (0x02DBF,0x02DBF); (0x02DC7,0x02DC7); (0x02DCF,0x02DCF); (0x02DD7,0x02DD7); (0x02DDF,0x02DDF); (0x02E45,0x02E7F); (0x02E9A,0x02E9A); (0x02EF4,0x02EFF); (0x02FD6,0x02FEF); (0x02FFC,0x02FFF); (0x03040,0x03040); (0x03097,0x03098); (0x03100,0x03104); (0x0312E,0x03130); (0x0318F,0x0318F); (0x031BB,0x031BF); (0x031E4,0x031EF); (0x0321F,0x0321F); (0x032FF,0x032FF); (0x04DB6,0x04DBF); (0x09FD6,0x09FFF); (0x0A48D,0x0A48F); (0x0A4C7,0x0A4CF); (0x0A62C,0x0A63F); (0x0A6F8,0x0A6FF); (0x0A7AF,0x0A7AF); (0x0A7B8,0x0A7F6); (0x0A82C,0x0A82F); (0x0A83A,0x0A83F); (0x0A878,0x0A87F); (0x0A8C6,0x0A8CD); (0x0A8DA,0x0A8DF); (0x0A8FE,0x0A8FF); (0x0A954,0x0A95E); (0x0A97D,0x0A97F); (0x0A9CE,0x0A9CE); (0x0A9DA,0x0A9DD); (0x0A9FF,0x0A9FF); (0x0AA37,0x0AA3F); (0x0AA4E,0x0AA4F); (0x0AA5A,0x0AA5B); (0x0AAC3,0x0AADA); (0x0AAF7,0x0AB00); (0x0AB07,0x0AB08); (0x0AB0F,0x0AB10); (0x0AB17,0x0AB1F); (0x0AB27,0x0AB27); (0x0AB2F,0x0AB2F); (0x0AB66,0x0AB6F); (0x0ABEE,0x0ABEF); (0x0ABFA,0x0ABFF); (0x0D7A4,0x0D7AF); (0x0D7C7,0x0D7CA); (0x0D7FC,0x0D7FF); (0x0FA6E,0x0FA6F); (0x0FADA,0x0FAFF); (0x0FB07,0x0FB12); (0x0FB18,0x0FB1C); (0x0FB37,0x0FB37); (0x0FB3D,0x0FB3D); (0x0FB3F,0x0FB3F); (0x0FB42,0x0FB42); (0x0FB45,0x0FB45); (0x0FBC2,0x0FBD2); (0x0FD40,0x0FD4F); (0x0FD90,0x0FD91); (0x0FDC8,0x0FDEF); (0x0FDFE,0x0FDFF); (0x0FE1A,0x0FE1F); (0x0FE53,0x0FE53); (0x0FE67,0x0FE67); (0x0FE6C,0x0FE6F); (0x0FE75,0x0FE75); (0x0FEFD,0x0FEFE); (0x0FF00,0x0FF00); (0x0FFBF,0x0FFC1); (0x0FFC8,0x0FFC9); (0x0FFD0,0x0FFD1); (0x0FFD8,0x0FFD9); (0x0FFDD,0x0FFDF); (0x0FFE7,0x0FFE7); (0x0FFEF,0x0FFF8); (0x0FFFE,0x0FFFF); (0x1000C,0x1000C); (0x10027,0x10027); (0x1003B,0x1003B); (0x1003E,0x1003E); (0x1004E,0x1004F); (0x1005E,0x1007F); (0x100FB,0x100FF); (0x10103,0x10106); (0x10134,0x10136); (0x1018F,0x1018F); (0x1019C,0x1019F); (0x101A1,0x101CF); (0x101FE,0x1027F); (0x1029D,0x1029F); (0x102D1,0x102DF); (0x102FC,0x102FF); (0x10324,0x1032F); (0x1034B,0x1034F); (0x1037B,0x1037F); (0x1039E,0x1039E); (0x103C4,0x103C7); (0x103D6,0x103FF); (0x1049E,0x1049F); (0x104AA,0x104AF); (0x104D4,0x104D7); (0x104FC,0x104FF); (0x10528,0x1052F); (0x10564,0x1056E); (0x10570,0x105FF); (0x10737,0x1073F); (0x10756,0x1075F); (0x10768,0x107FF); (0x10806,0x10807); (0x10809,0x10809); (0x10836,0x10836); (0x10839,0x1083B); (0x1083D,0x1083E); (0x10856,0x10856); (0x1089F,0x108A6); (0x108B0,0x108DF); (0x108F3,0x108F3); (0x108F6,0x108FA); (0x1091C,0x1091E); (0x1093A,0x1093E); (0x10940,0x1097F); (0x109B8,0x109BB); (0x109D0,0x109D1); (0x10A04,0x10A04); (0x10A07,0x10A0B); (0x10A14,0x10A14); (0x10A18,0x10A18); (0x10A34,0x10A37); (0x10A3B,0x10A3E); (0x10A48,0x10A4F); (0x10A59,0x10A5F); (0x10AA0,0x10ABF); (0x10AE7,0x10AEA); (0x10AF7,0x10AFF); (0x10B36,0x10B38); (0x10B56,0x10B57); (0x10B73,0x10B77); (0x10B92,0x10B98); (0x10B9D,0x10BA8); (0x10BB0,0x10BFF); (0x10C49,0x10C7F); (0x10CB3,0x10CBF); (0x10CF3,0x10CF9); (0x10D00,0x10E5F); (0x10E7F,0x10FFF); (0x1104E,0x11051); (0x11070,0x1107E); (0x110C2,0x110CF); (0x110E9,0x110EF); (0x110FA,0x110FF); (0x11135,0x11135); (0x11144,0x1114F); (0x11177,0x1117F); (0x111CE,0x111CF); (0x111E0,0x111E0); (0x111F5,0x111FF); (0x11212,0x11212); (0x1123F,0x1127F); (0x11287,0x11287); (0x11289,0x11289); (0x1128E,0x1128E); (0x1129E,0x1129E); (0x112AA,0x112AF); (0x112EB,0x112EF); (0x112FA,0x112FF); (0x11304,0x11304); (0x1130D,0x1130E); (0x11311,0x11312); (0x11329,0x11329); (0x11331,0x11331); (0x11334,0x11334); (0x1133A,0x1133B); (0x11345,0x11346); (0x11349,0x1134A); (0x1134E,0x1134F); (0x11351,0x11356); (0x11358,0x1135C); (0x11364,0x11365); (0x1136D,0x1136F); (0x11375,0x113FF); (0x1145A,0x1145A); (0x1145C,0x1145C); (0x1145E,0x1147F); (0x114C8,0x114CF); (0x114DA,0x1157F); (0x115B6,0x115B7); (0x115DE,0x115FF); (0x11645,0x1164F); (0x1165A,0x1165F); (0x1166D,0x1167F); (0x116B8,0x116BF); (0x116CA,0x116FF); (0x1171A,0x1171C); (0x1172C,0x1172F); (0x11740,0x1189F); (0x118F3,0x118FE); (0x11900,0x11ABF); (0x11AF9,0x11BFF); (0x11C09,0x11C09); (0x11C37,0x11C37); (0x11C46,0x11C4F); (0x11C6D,0x11C6F); (0x11C90,0x11C91); (0x11CA8,0x11CA8); (0x11CB7,0x11FFF); (0x1239A,0x123FF); (0x1246F,0x1246F); (0x12475,0x1247F); (0x12544,0x12FFF); (0x1342F,0x143FF); (0x14647,0x167FF); (0x16A39,0x16A3F); (0x16A5F,0x16A5F); (0x16A6A,0x16A6D); (0x16A70,0x16ACF); (0x16AEE,0x16AEF); (0x16AF6,0x16AFF); (0x16B46,0x16B4F); (0x16B5A,0x16B5A); (0x16B62,0x16B62); (0x16B78,0x16B7C); (0x16B90,0x16EFF); (0x16F45,0x16F4F); (0x16F7F,0x16F8E); (0x16FA0,0x16FDF); (0x16FE1,0x16FFF); (0x187ED,0x187FF); (0x18AF3,0x1AFFF); (0x1B002,0x1BBFF); (0x1BC6B,0x1BC6F); (0x1BC7D,0x1BC7F); (0x1BC89,0x1BC8F); (0x1BC9A,0x1BC9B); (0x1BCA4,0x1CFFF); (0x1D0F6,0x1D0FF); (0x1D127,0x1D128); (0x1D1E9,0x1D1FF); (0x1D246,0x1D2FF); (0x1D357,0x1D35F); (0x1D372,0x1D3FF); (0x1D455,0x1D455); (0x1D49D,0x1D49D); (0x1D4A0,0x1D4A1); (0x1D4A3,0x1D4A4); (0x1D4A7,0x1D4A8); (0x1D4AD,0x1D4AD); (0x1D4BA,0x1D4BA); (0x1D4BC,0x1D4BC); (0x1D4C4,0x1D4C4); (0x1D506,0x1D506); (0x1D50B,0x1D50C); (0x1D515,0x1D515); (0x1D51D,0x1D51D); (0x1D53A,0x1D53A); (0x1D53F,0x1D53F); (0x1D545,0x1D545); (0x1D547,0x1D549); (0x1D551,0x1D551); (0x1D6A6,0x1D6A7); (0x1D7CC,0x1D7CD); (0x1DA8C,0x1DA9A); (0x1DAA0,0x1DAA0); (0x1DAB0,0x1DFFF); (0x1E007,0x1E007); (0x1E019,0x1E01A); (0x1E022,0x1E022); (0x1E025,0x1E025); (0x1E02B,0x1E7FF); (0x1E8C5,0x1E8C6); (0x1E8D7,0x1E8FF); (0x1E94B,0x1E94F); (0x1E95A,0x1E95D); (0x1E960,0x1EDFF); (0x1EE04,0x1EE04); (0x1EE20,0x1EE20); (0x1EE23,0x1EE23); (0x1EE25,0x1EE26); (0x1EE28,0x1EE28); (0x1EE33,0x1EE33); (0x1EE38,0x1EE38); (0x1EE3A,0x1EE3A); (0x1EE3C,0x1EE41); (0x1EE43,0x1EE46); (0x1EE48,0x1EE48); (0x1EE4A,0x1EE4A); (0x1EE4C,0x1EE4C); (0x1EE50,0x1EE50); (0x1EE53,0x1EE53); (0x1EE55,0x1EE56); (0x1EE58,0x1EE58); (0x1EE5A,0x1EE5A); (0x1EE5C,0x1EE5C); (0x1EE5E,0x1EE5E); (0x1EE60,0x1EE60); (0x1EE63,0x1EE63); (0x1EE65,0x1EE66); (0x1EE6B,0x1EE6B); (0x1EE73,0x1EE73); (0x1EE78,0x1EE78); (0x1EE7D,0x1EE7D); (0x1EE7F,0x1EE7F); (0x1EE8A,0x1EE8A); (0x1EE9C,0x1EEA0); (0x1EEA4,0x1EEA4); (0x1EEAA,0x1EEAA); (0x1EEBC,0x1EEEF); (0x1EEF2,0x1EFFF); (0x1F02C,0x1F02F); (0x1F094,0x1F09F); (0x1F0AF,0x1F0B0); (0x1F0C0,0x1F0C0); (0x1F0D0,0x1F0D0); (0x1F0F6,0x1F0FF); (0x1F10D,0x1F10F); (0x1F12F,0x1F12F); (0x1F16C,0x1F16F); (0x1F1AD,0x1F1E5); (0x1F203,0x1F20F); (0x1F23C,0x1F23F); (0x1F249,0x1F24F); (0x1F252,0x1F2FF); (0x1F6D3,0x1F6DF); (0x1F6ED,0x1F6EF); (0x1F6F7,0x1F6FF); (0x1F774,0x1F77F); (0x1F7D5,0x1F7FF); (0x1F80C,0x1F80F); (0x1F848,0x1F84F); (0x1F85A,0x1F85F); (0x1F888,0x1F88F); (0x1F8AE,0x1F90F); (0x1F91F,0x1F91F); (0x1F928,0x1F92F); (0x1F931,0x1F932); (0x1F93F,0x1F93F); (0x1F94C,0x1F94F); (0x1F95F,0x1F97F); (0x1F992,0x1F9BF); (0x1F9C1,0x1FFFF); (0x2A6D7,0x2A6FF); (0x2B735,0x2B73F); (0x2B81E,0x2B81F); (0x2CEA2,0x2F7FF); (0x2FA1E,0xE0000); (0xE0002,0xE001F); (0xE0080,0xE00FF); (0xE01F0,0xEFFFF); (0xFFFFE,0xFFFFF) ] (* Letter, Modifier *) let lm = [ (0x002B0,0x002C1); (0x002C6,0x002D1); (0x002E0,0x002E4); (0x002EC,0x002EC); (0x002EE,0x002EE); (0x00374,0x00374); (0x0037A,0x0037A); (0x00559,0x00559); (0x00640,0x00640); (0x006E5,0x006E6); (0x007F4,0x007F5); (0x007FA,0x007FA); (0x0081A,0x0081A); (0x00824,0x00824); (0x00828,0x00828); (0x00971,0x00971); (0x00E46,0x00E46); (0x00EC6,0x00EC6); (0x010FC,0x010FC); (0x017D7,0x017D7); (0x01843,0x01843); (0x01AA7,0x01AA7); (0x01C78,0x01C7D); (0x01D2C,0x01D6A); (0x01D78,0x01D78); (0x01D9B,0x01DBF); (0x02071,0x02071); (0x0207F,0x0207F); (0x02090,0x0209C); (0x02C7C,0x02C7D); (0x02D6F,0x02D6F); (0x02E2F,0x02E2F); (0x03005,0x03005); (0x03031,0x03035); (0x0303B,0x0303B); (0x0309D,0x0309E); (0x030FC,0x030FE); (0x0A015,0x0A015); (0x0A4F8,0x0A4FD); (0x0A60C,0x0A60C); (0x0A67F,0x0A67F); (0x0A69C,0x0A69D); (0x0A717,0x0A71F); (0x0A770,0x0A770); (0x0A788,0x0A788); (0x0A7F8,0x0A7F9); (0x0A9CF,0x0A9CF); (0x0A9E6,0x0A9E6); (0x0AA70,0x0AA70); (0x0AADD,0x0AADD); (0x0AAF3,0x0AAF4); (0x0AB5C,0x0AB5F); (0x0FF70,0x0FF70); (0x0FF9E,0x0FF9F); (0x16B40,0x16B43); (0x16F93,0x16F9F) ] (* Letter, Other *) let lo = [ (0x000AA,0x000AA); (0x000BA,0x000BA); (0x001BB,0x001BB); (0x001C0,0x001C3); (0x00294,0x00294); (0x005D0,0x005EA); (0x005F0,0x005F2); (0x00620,0x0063F); (0x00641,0x0064A); (0x0066E,0x0066F); (0x00671,0x006D3); (0x006D5,0x006D5); (0x006EE,0x006EF); (0x006FA,0x006FC); (0x006FF,0x006FF); (0x00710,0x00710); (0x00712,0x0072F); (0x0074D,0x007A5); (0x007B1,0x007B1); (0x007CA,0x007EA); (0x00800,0x00815); (0x00840,0x00858); (0x008A0,0x008B4); (0x008B6,0x008BD); (0x00904,0x00939); (0x0093D,0x0093D); (0x00950,0x00950); (0x00958,0x00961); (0x00972,0x00980); (0x00985,0x0098C); (0x0098F,0x00990); (0x00993,0x009A8); (0x009AA,0x009B0); (0x009B2,0x009B2); (0x009B6,0x009B9); (0x009BD,0x009BD); (0x009CE,0x009CE); (0x009DC,0x009DD); (0x009DF,0x009E1); (0x009F0,0x009F1); (0x00A05,0x00A0A); (0x00A0F,0x00A10); (0x00A13,0x00A28); (0x00A2A,0x00A30); (0x00A32,0x00A33); (0x00A35,0x00A36); (0x00A38,0x00A39); (0x00A59,0x00A5C); (0x00A5E,0x00A5E); (0x00A72,0x00A74); (0x00A85,0x00A8D); (0x00A8F,0x00A91); (0x00A93,0x00AA8); (0x00AAA,0x00AB0); (0x00AB2,0x00AB3); (0x00AB5,0x00AB9); (0x00ABD,0x00ABD); (0x00AD0,0x00AD0); (0x00AE0,0x00AE1); (0x00AF9,0x00AF9); (0x00B05,0x00B0C); (0x00B0F,0x00B10); (0x00B13,0x00B28); (0x00B2A,0x00B30); (0x00B32,0x00B33); (0x00B35,0x00B39); (0x00B3D,0x00B3D); (0x00B5C,0x00B5D); (0x00B5F,0x00B61); (0x00B71,0x00B71); (0x00B83,0x00B83); (0x00B85,0x00B8A); (0x00B8E,0x00B90); (0x00B92,0x00B95); (0x00B99,0x00B9A); (0x00B9C,0x00B9C); (0x00B9E,0x00B9F); (0x00BA3,0x00BA4); (0x00BA8,0x00BAA); (0x00BAE,0x00BB9); (0x00BD0,0x00BD0); (0x00C05,0x00C0C); (0x00C0E,0x00C10); (0x00C12,0x00C28); (0x00C2A,0x00C39); (0x00C3D,0x00C3D); (0x00C58,0x00C5A); (0x00C60,0x00C61); (0x00C80,0x00C80); (0x00C85,0x00C8C); (0x00C8E,0x00C90); (0x00C92,0x00CA8); (0x00CAA,0x00CB3); (0x00CB5,0x00CB9); (0x00CBD,0x00CBD); (0x00CDE,0x00CDE); (0x00CE0,0x00CE1); (0x00CF1,0x00CF2); (0x00D05,0x00D0C); (0x00D0E,0x00D10); (0x00D12,0x00D3A); (0x00D3D,0x00D3D); (0x00D4E,0x00D4E); (0x00D54,0x00D56); (0x00D5F,0x00D61); (0x00D7A,0x00D7F); (0x00D85,0x00D96); (0x00D9A,0x00DB1); (0x00DB3,0x00DBB); (0x00DBD,0x00DBD); (0x00DC0,0x00DC6); (0x00E01,0x00E30); (0x00E32,0x00E33); (0x00E40,0x00E45); (0x00E81,0x00E82); (0x00E84,0x00E84); (0x00E87,0x00E88); (0x00E8A,0x00E8A); (0x00E8D,0x00E8D); (0x00E94,0x00E97); (0x00E99,0x00E9F); (0x00EA1,0x00EA3); (0x00EA5,0x00EA5); (0x00EA7,0x00EA7); (0x00EAA,0x00EAB); (0x00EAD,0x00EB0); (0x00EB2,0x00EB3); (0x00EBD,0x00EBD); (0x00EC0,0x00EC4); (0x00EDC,0x00EDF); (0x00F00,0x00F00); (0x00F40,0x00F47); (0x00F49,0x00F6C); (0x00F88,0x00F8C); (0x01000,0x0102A); (0x0103F,0x0103F); (0x01050,0x01055); (0x0105A,0x0105D); (0x01061,0x01061); (0x01065,0x01066); (0x0106E,0x01070); (0x01075,0x01081); (0x0108E,0x0108E); (0x010D0,0x010FA); (0x010FD,0x01248); (0x0124A,0x0124D); (0x01250,0x01256); (0x01258,0x01258); (0x0125A,0x0125D); (0x01260,0x01288); (0x0128A,0x0128D); (0x01290,0x012B0); (0x012B2,0x012B5); (0x012B8,0x012BE); (0x012C0,0x012C0); (0x012C2,0x012C5); (0x012C8,0x012D6); (0x012D8,0x01310); (0x01312,0x01315); (0x01318,0x0135A); (0x01380,0x0138F); (0x01401,0x0166C); (0x0166F,0x0167F); (0x01681,0x0169A); (0x016A0,0x016EA); (0x016F1,0x016F8); (0x01700,0x0170C); (0x0170E,0x01711); (0x01720,0x01731); (0x01740,0x01751); (0x01760,0x0176C); (0x0176E,0x01770); (0x01780,0x017B3); (0x017DC,0x017DC); (0x01820,0x01842); (0x01844,0x01877); (0x01880,0x01884); (0x01887,0x018A8); (0x018AA,0x018AA); (0x018B0,0x018F5); (0x01900,0x0191E); (0x01950,0x0196D); (0x01970,0x01974); (0x01980,0x019AB); (0x019B0,0x019C9); (0x01A00,0x01A16); (0x01A20,0x01A54); (0x01B05,0x01B33); (0x01B45,0x01B4B); (0x01B83,0x01BA0); (0x01BAE,0x01BAF); (0x01BBA,0x01BE5); (0x01C00,0x01C23); (0x01C4D,0x01C4F); (0x01C5A,0x01C77); (0x01CE9,0x01CEC); (0x01CEE,0x01CF1); (0x01CF5,0x01CF6); (0x02135,0x02138); (0x02D30,0x02D67); (0x02D80,0x02D96); (0x02DA0,0x02DA6); (0x02DA8,0x02DAE); (0x02DB0,0x02DB6); (0x02DB8,0x02DBE); (0x02DC0,0x02DC6); (0x02DC8,0x02DCE); (0x02DD0,0x02DD6); (0x02DD8,0x02DDE); (0x03006,0x03006); (0x0303C,0x0303C); (0x03041,0x03096); (0x0309F,0x0309F); (0x030A1,0x030FA); (0x030FF,0x030FF); (0x03105,0x0312D); (0x03131,0x0318E); (0x031A0,0x031BA); (0x031F0,0x031FF); (0x03400,0x04DB5); (0x04E00,0x09FD5); (0x0A000,0x0A014); (0x0A016,0x0A48C); (0x0A4D0,0x0A4F7); (0x0A500,0x0A60B); (0x0A610,0x0A61F); (0x0A62A,0x0A62B); (0x0A66E,0x0A66E); (0x0A6A0,0x0A6E5); (0x0A78F,0x0A78F); (0x0A7F7,0x0A7F7); (0x0A7FB,0x0A801); (0x0A803,0x0A805); (0x0A807,0x0A80A); (0x0A80C,0x0A822); (0x0A840,0x0A873); (0x0A882,0x0A8B3); (0x0A8F2,0x0A8F7); (0x0A8FB,0x0A8FB); (0x0A8FD,0x0A8FD); (0x0A90A,0x0A925); (0x0A930,0x0A946); (0x0A960,0x0A97C); (0x0A984,0x0A9B2); (0x0A9E0,0x0A9E4); (0x0A9E7,0x0A9EF); (0x0A9FA,0x0A9FE); (0x0AA00,0x0AA28); (0x0AA40,0x0AA42); (0x0AA44,0x0AA4B); (0x0AA60,0x0AA6F); (0x0AA71,0x0AA76); (0x0AA7A,0x0AA7A); (0x0AA7E,0x0AAAF); (0x0AAB1,0x0AAB1); (0x0AAB5,0x0AAB6); (0x0AAB9,0x0AABD); (0x0AAC0,0x0AAC0); (0x0AAC2,0x0AAC2); (0x0AADB,0x0AADC); (0x0AAE0,0x0AAEA); (0x0AAF2,0x0AAF2); (0x0AB01,0x0AB06); (0x0AB09,0x0AB0E); (0x0AB11,0x0AB16); (0x0AB20,0x0AB26); (0x0AB28,0x0AB2E); (0x0ABC0,0x0ABE2); (0x0AC00,0x0D7A3); (0x0D7B0,0x0D7C6); (0x0D7CB,0x0D7FB); (0x0F900,0x0FA6D); (0x0FA70,0x0FAD9); (0x0FB1D,0x0FB1D); (0x0FB1F,0x0FB28); (0x0FB2A,0x0FB36); (0x0FB38,0x0FB3C); (0x0FB3E,0x0FB3E); (0x0FB40,0x0FB41); (0x0FB43,0x0FB44); (0x0FB46,0x0FBB1); (0x0FBD3,0x0FD3D); (0x0FD50,0x0FD8F); (0x0FD92,0x0FDC7); (0x0FDF0,0x0FDFB); (0x0FE70,0x0FE74); (0x0FE76,0x0FEFC); (0x0FF66,0x0FF6F); (0x0FF71,0x0FF9D); (0x0FFA0,0x0FFBE); (0x0FFC2,0x0FFC7); (0x0FFCA,0x0FFCF); (0x0FFD2,0x0FFD7); (0x0FFDA,0x0FFDC); (0x10000,0x1000B); (0x1000D,0x10026); (0x10028,0x1003A); (0x1003C,0x1003D); (0x1003F,0x1004D); (0x10050,0x1005D); (0x10080,0x100FA); (0x10280,0x1029C); (0x102A0,0x102D0); (0x10300,0x1031F); (0x10330,0x10340); (0x10342,0x10349); (0x10350,0x10375); (0x10380,0x1039D); (0x103A0,0x103C3); (0x103C8,0x103CF); (0x10450,0x1049D); (0x10500,0x10527); (0x10530,0x10563); (0x10600,0x10736); (0x10740,0x10755); (0x10760,0x10767); (0x10800,0x10805); (0x10808,0x10808); (0x1080A,0x10835); (0x10837,0x10838); (0x1083C,0x1083C); (0x1083F,0x10855); (0x10860,0x10876); (0x10880,0x1089E); (0x108E0,0x108F2); (0x108F4,0x108F5); (0x10900,0x10915); (0x10920,0x10939); (0x10980,0x109B7); (0x109BE,0x109BF); (0x10A00,0x10A00); (0x10A10,0x10A13); (0x10A15,0x10A17); (0x10A19,0x10A33); (0x10A60,0x10A7C); (0x10A80,0x10A9C); (0x10AC0,0x10AC7); (0x10AC9,0x10AE4); (0x10B00,0x10B35); (0x10B40,0x10B55); (0x10B60,0x10B72); (0x10B80,0x10B91); (0x10C00,0x10C48); (0x11003,0x11037); (0x11083,0x110AF); (0x110D0,0x110E8); (0x11103,0x11126); (0x11150,0x11172); (0x11176,0x11176); (0x11183,0x111B2); (0x111C1,0x111C4); (0x111DA,0x111DA); (0x111DC,0x111DC); (0x11200,0x11211); (0x11213,0x1122B); (0x11280,0x11286); (0x11288,0x11288); (0x1128A,0x1128D); (0x1128F,0x1129D); (0x1129F,0x112A8); (0x112B0,0x112DE); (0x11305,0x1130C); (0x1130F,0x11310); (0x11313,0x11328); (0x1132A,0x11330); (0x11332,0x11333); (0x11335,0x11339); (0x1133D,0x1133D); (0x11350,0x11350); (0x1135D,0x11361); (0x11400,0x11434); (0x11447,0x1144A); (0x11480,0x114AF); (0x114C4,0x114C5); (0x114C7,0x114C7); (0x11580,0x115AE); (0x115D8,0x115DB); (0x11600,0x1162F); (0x11644,0x11644); (0x11680,0x116AA); (0x11700,0x11719); (0x118FF,0x118FF); (0x11AC0,0x11AF8); (0x11C00,0x11C08); (0x11C0A,0x11C2E); (0x11C40,0x11C40); (0x11C72,0x11C8F); (0x12000,0x12399); (0x12480,0x12543); (0x13000,0x1342E); (0x14400,0x14646); (0x16800,0x16A38); (0x16A40,0x16A5E); (0x16AD0,0x16AED); (0x16B00,0x16B2F); (0x16B63,0x16B77); (0x16B7D,0x16B8F); (0x16F00,0x16F44); (0x16F50,0x16F50); (0x17000,0x187EC); (0x18800,0x18AF2); (0x1B000,0x1B001); (0x1BC00,0x1BC6A); (0x1BC70,0x1BC7C); (0x1BC80,0x1BC88); (0x1BC90,0x1BC99); (0x1E800,0x1E8C4); (0x1EE00,0x1EE03); (0x1EE05,0x1EE1F); (0x1EE21,0x1EE22); (0x1EE24,0x1EE24); (0x1EE27,0x1EE27); (0x1EE29,0x1EE32); (0x1EE34,0x1EE37); (0x1EE39,0x1EE39); (0x1EE3B,0x1EE3B); (0x1EE42,0x1EE42); (0x1EE47,0x1EE47); (0x1EE49,0x1EE49); (0x1EE4B,0x1EE4B); (0x1EE4D,0x1EE4F); (0x1EE51,0x1EE52); (0x1EE54,0x1EE54); (0x1EE57,0x1EE57); (0x1EE59,0x1EE59); (0x1EE5B,0x1EE5B); (0x1EE5D,0x1EE5D); (0x1EE5F,0x1EE5F); (0x1EE61,0x1EE62); (0x1EE64,0x1EE64); (0x1EE67,0x1EE6A); (0x1EE6C,0x1EE72); (0x1EE74,0x1EE77); (0x1EE79,0x1EE7C); (0x1EE7E,0x1EE7E); (0x1EE80,0x1EE89); (0x1EE8B,0x1EE9B); (0x1EEA1,0x1EEA3); (0x1EEA5,0x1EEA9); (0x1EEAB,0x1EEBB); (0x20000,0x2A6D6); (0x2A700,0x2B734); (0x2B740,0x2B81D); (0x2B820,0x2CEA1) ] (* Punctuation, Connector *) let pc = [ (0x0005F,0x0005F); (0x0203F,0x02040); (0x02054,0x02054); (0x0FE33,0x0FE34); (0x0FE4D,0x0FE4F) ] (* Punctuation, Dash *) let pd = [ (0x0002D,0x0002D); (0x0058A,0x0058A); (0x005BE,0x005BE); (0x01400,0x01400); (0x01806,0x01806); (0x02010,0x02015); (0x02E17,0x02E17); (0x02E1A,0x02E1A); (0x02E3A,0x02E3B); (0x02E40,0x02E40); (0x0301C,0x0301C); (0x03030,0x03030); (0x030A0,0x030A0); (0x0FE31,0x0FE32); (0x0FE58,0x0FE58); (0x0FE63,0x0FE63) ] (* Punctuation, Open *) let ps = [ (0x00028,0x00028); (0x0005B,0x0005B); (0x0007B,0x0007B); (0x00F3A,0x00F3A); (0x00F3C,0x00F3C); (0x0169B,0x0169B); (0x0201A,0x0201A); (0x0201E,0x0201E); (0x02045,0x02045); (0x0207D,0x0207D); (0x0208D,0x0208D); (0x02308,0x02308); (0x0230A,0x0230A); (0x02329,0x02329); (0x02768,0x02768); (0x0276A,0x0276A); (0x0276C,0x0276C); (0x0276E,0x0276E); (0x02770,0x02770); (0x02772,0x02772); (0x02774,0x02774); (0x027C5,0x027C5); (0x027E6,0x027E6); (0x027E8,0x027E8); (0x027EA,0x027EA); (0x027EC,0x027EC); (0x027EE,0x027EE); (0x02983,0x02983); (0x02985,0x02985); (0x02987,0x02987); (0x02989,0x02989); (0x0298B,0x0298B); (0x0298D,0x0298D); (0x0298F,0x0298F); (0x02991,0x02991); (0x02993,0x02993); (0x02995,0x02995); (0x02997,0x02997); (0x029D8,0x029D8); (0x029DA,0x029DA); (0x029FC,0x029FC); (0x02E22,0x02E22); (0x02E24,0x02E24); (0x02E26,0x02E26); (0x02E28,0x02E28); (0x02E42,0x02E42); (0x03008,0x03008); (0x0300A,0x0300A); (0x0300C,0x0300C); (0x0300E,0x0300E); (0x03010,0x03010); (0x03014,0x03014); (0x03016,0x03016); (0x03018,0x03018); (0x0301A,0x0301A); (0x0301D,0x0301D); (0x0FD3F,0x0FD3F); (0x0FE17,0x0FE17); (0x0FE35,0x0FE35); (0x0FE37,0x0FE37); (0x0FE39,0x0FE39); (0x0FE3B,0x0FE3B); (0x0FE3D,0x0FE3D); (0x0FE3F,0x0FE3F); (0x0FE41,0x0FE41); (0x0FE43,0x0FE43); (0x0FE47,0x0FE47); (0x0FE59,0x0FE59); (0x0FE5B,0x0FE5B); (0x0FE5D,0x0FE5D); (0x0FF08,0x0FF08); (0x0FF3B,0x0FF3B); (0x0FF5B,0x0FF5B); (0x0FF5F,0x0FF5F) ] (* Punctuation, Close *) let pe = [ (0x00029,0x00029); (0x0005D,0x0005D); (0x0007D,0x0007D); (0x00F3B,0x00F3B); (0x00F3D,0x00F3D); (0x0169C,0x0169C); (0x02046,0x02046); (0x0207E,0x0207E); (0x0208E,0x0208E); (0x02309,0x02309); (0x0230B,0x0230B); (0x0232A,0x0232A); (0x02769,0x02769); (0x0276B,0x0276B); (0x0276D,0x0276D); (0x0276F,0x0276F); (0x02771,0x02771); (0x02773,0x02773); (0x02775,0x02775); (0x027C6,0x027C6); (0x027E7,0x027E7); (0x027E9,0x027E9); (0x027EB,0x027EB); (0x027ED,0x027ED); (0x027EF,0x027EF); (0x02984,0x02984); (0x02986,0x02986); (0x02988,0x02988); (0x0298A,0x0298A); (0x0298C,0x0298C); (0x0298E,0x0298E); (0x02990,0x02990); (0x02992,0x02992); (0x02994,0x02994); (0x02996,0x02996); (0x02998,0x02998); (0x029D9,0x029D9); (0x029DB,0x029DB); (0x029FD,0x029FD); (0x02E23,0x02E23); (0x02E25,0x02E25); (0x02E27,0x02E27); (0x02E29,0x02E29); (0x03009,0x03009); (0x0300B,0x0300B); (0x0300D,0x0300D); (0x0300F,0x0300F); (0x03011,0x03011); (0x03015,0x03015); (0x03017,0x03017); (0x03019,0x03019); (0x0301B,0x0301B); (0x0301E,0x0301F); (0x0FD3E,0x0FD3E); (0x0FE18,0x0FE18); (0x0FE36,0x0FE36); (0x0FE38,0x0FE38); (0x0FE3A,0x0FE3A); (0x0FE3C,0x0FE3C); (0x0FE3E,0x0FE3E); (0x0FE40,0x0FE40); (0x0FE42,0x0FE42); (0x0FE44,0x0FE44); (0x0FE48,0x0FE48); (0x0FE5A,0x0FE5A); (0x0FE5C,0x0FE5C); (0x0FE5E,0x0FE5E); (0x0FF09,0x0FF09); (0x0FF3D,0x0FF3D); (0x0FF5D,0x0FF5D); (0x0FF60,0x0FF60) ] (* Punctuation, Initial quote *) let pi = [ (0x000AB,0x000AB); (0x02018,0x02018); (0x0201B,0x0201C); (0x0201F,0x0201F); (0x02039,0x02039); (0x02E02,0x02E02); (0x02E04,0x02E04); (0x02E09,0x02E09); (0x02E0C,0x02E0C); (0x02E1C,0x02E1C) ] (* Punctuation, Final quote *) let pf = [ (0x000BB,0x000BB); (0x02019,0x02019); (0x0201D,0x0201D); (0x0203A,0x0203A); (0x02E03,0x02E03); (0x02E05,0x02E05); (0x02E0A,0x02E0A); (0x02E0D,0x02E0D); (0x02E1D,0x02E1D) ] (* Punctuation, Other *) let po = [ (0x00021,0x00023); (0x00025,0x00027); (0x0002A,0x0002A); (0x0002C,0x0002C); (0x0002E,0x0002F); (0x0003A,0x0003B); (0x0003F,0x00040); (0x0005C,0x0005C); (0x000A1,0x000A1); (0x000A7,0x000A7); (0x000B6,0x000B7); (0x000BF,0x000BF); (0x0037E,0x0037E); (0x00387,0x00387); (0x0055A,0x0055F); (0x00589,0x00589); (0x005C0,0x005C0); (0x005C3,0x005C3); (0x005C6,0x005C6); (0x005F3,0x005F4); (0x00609,0x0060A); (0x0060C,0x0060D); (0x0061B,0x0061B); (0x0061E,0x0061F); (0x0066A,0x0066D); (0x006D4,0x006D4); (0x00700,0x0070D); (0x007F7,0x007F9); (0x00830,0x0083E); (0x0085E,0x0085E); (0x00964,0x00965); (0x00970,0x00970); (0x00AF0,0x00AF0); (0x00DF4,0x00DF4); (0x00E4F,0x00E4F); (0x00E5A,0x00E5B); (0x00F04,0x00F12); (0x00F14,0x00F14); (0x00F85,0x00F85); (0x00FD0,0x00FD4); (0x00FD9,0x00FDA); (0x0104A,0x0104F); (0x010FB,0x010FB); (0x01360,0x01368); (0x0166D,0x0166E); (0x016EB,0x016ED); (0x01735,0x01736); (0x017D4,0x017D6); (0x017D8,0x017DA); (0x01800,0x01805); (0x01807,0x0180A); (0x01944,0x01945); (0x01A1E,0x01A1F); (0x01AA0,0x01AA6); (0x01AA8,0x01AAD); (0x01B5A,0x01B60); (0x01BFC,0x01BFF); (0x01C3B,0x01C3F); (0x01C7E,0x01C7F); (0x01CC0,0x01CC7); (0x01CD3,0x01CD3); (0x02016,0x02017); (0x02020,0x02027); (0x02030,0x02038); (0x0203B,0x0203E); (0x02041,0x02043); (0x02047,0x02051); (0x02053,0x02053); (0x02055,0x0205E); (0x02CF9,0x02CFC); (0x02CFE,0x02CFF); (0x02D70,0x02D70); (0x02E00,0x02E01); (0x02E06,0x02E08); (0x02E0B,0x02E0B); (0x02E0E,0x02E16); (0x02E18,0x02E19); (0x02E1B,0x02E1B); (0x02E1E,0x02E1F); (0x02E2A,0x02E2E); (0x02E30,0x02E39); (0x02E3C,0x02E3F); (0x02E41,0x02E41); (0x02E43,0x02E44); (0x03001,0x03003); (0x0303D,0x0303D); (0x030FB,0x030FB); (0x0A4FE,0x0A4FF); (0x0A60D,0x0A60F); (0x0A673,0x0A673); (0x0A67E,0x0A67E); (0x0A6F2,0x0A6F7); (0x0A874,0x0A877); (0x0A8CE,0x0A8CF); (0x0A8F8,0x0A8FA); (0x0A8FC,0x0A8FC); (0x0A92E,0x0A92F); (0x0A95F,0x0A95F); (0x0A9C1,0x0A9CD); (0x0A9DE,0x0A9DF); (0x0AA5C,0x0AA5F); (0x0AADE,0x0AADF); (0x0AAF0,0x0AAF1); (0x0ABEB,0x0ABEB); (0x0FE10,0x0FE16); (0x0FE19,0x0FE19); (0x0FE30,0x0FE30); (0x0FE45,0x0FE46); (0x0FE49,0x0FE4C); (0x0FE50,0x0FE52); (0x0FE54,0x0FE57); (0x0FE5F,0x0FE61); (0x0FE68,0x0FE68); (0x0FE6A,0x0FE6B); (0x0FF01,0x0FF03); (0x0FF05,0x0FF07); (0x0FF0A,0x0FF0A); (0x0FF0C,0x0FF0C); (0x0FF0E,0x0FF0F); (0x0FF1A,0x0FF1B); (0x0FF1F,0x0FF20); (0x0FF3C,0x0FF3C); (0x0FF61,0x0FF61); (0x0FF64,0x0FF65); (0x10100,0x10102); (0x1039F,0x1039F); (0x103D0,0x103D0); (0x1056F,0x1056F); (0x10857,0x10857); (0x1091F,0x1091F); (0x1093F,0x1093F); (0x10A50,0x10A58); (0x10A7F,0x10A7F); (0x10AF0,0x10AF6); (0x10B39,0x10B3F); (0x10B99,0x10B9C); (0x11047,0x1104D); (0x110BB,0x110BC); (0x110BE,0x110C1); (0x11140,0x11143); (0x11174,0x11175); (0x111C5,0x111C9); (0x111CD,0x111CD); (0x111DB,0x111DB); (0x111DD,0x111DF); (0x11238,0x1123D); (0x112A9,0x112A9); (0x1144B,0x1144F); (0x1145B,0x1145B); (0x1145D,0x1145D); (0x114C6,0x114C6); (0x115C1,0x115D7); (0x11641,0x11643); (0x11660,0x1166C); (0x1173C,0x1173E); (0x11C41,0x11C45); (0x11C70,0x11C71); (0x12470,0x12474); (0x16A6E,0x16A6F); (0x16AF5,0x16AF5); (0x16B37,0x16B3B); (0x16B44,0x16B44); (0x1BC9F,0x1BC9F); (0x1DA87,0x1DA8B) ] (* Symbol, Math *) let sm = [ (0x0002B,0x0002B); (0x0003C,0x0003E); (0x0007C,0x0007C); (0x0007E,0x0007E); (0x000AC,0x000AC); (0x000B1,0x000B1); (0x000D7,0x000D7); (0x000F7,0x000F7); (0x003F6,0x003F6); (0x00606,0x00608); (0x02044,0x02044); (0x02052,0x02052); (0x0207A,0x0207C); (0x0208A,0x0208C); (0x02118,0x02118); (0x02140,0x02144); (0x0214B,0x0214B); (0x02190,0x02194); (0x0219A,0x0219B); (0x021A0,0x021A0); (0x021A3,0x021A3); (0x021A6,0x021A6); (0x021AE,0x021AE); (0x021CE,0x021CF); (0x021D2,0x021D2); (0x021D4,0x021D4); (0x021F4,0x022FF); (0x02320,0x02321); (0x0237C,0x0237C); (0x0239B,0x023B3); (0x023DC,0x023E1); (0x025B7,0x025B7); (0x025C1,0x025C1); (0x025F8,0x025FF); (0x0266F,0x0266F); (0x027C0,0x027C4); (0x027C7,0x027E5); (0x027F0,0x027FF); (0x02900,0x02982); (0x02999,0x029D7); (0x029DC,0x029FB); (0x029FE,0x02AFF); (0x02B30,0x02B44); (0x02B47,0x02B4C); (0x0FB29,0x0FB29); (0x0FE62,0x0FE62); (0x0FE64,0x0FE66); (0x0FF0B,0x0FF0B); (0x0FF1C,0x0FF1E); (0x0FF5C,0x0FF5C); (0x0FF5E,0x0FF5E); (0x0FFE2,0x0FFE2); (0x0FFE9,0x0FFEC); (0x1D6C1,0x1D6C1); (0x1D6DB,0x1D6DB); (0x1D6FB,0x1D6FB); (0x1D715,0x1D715); (0x1D735,0x1D735); (0x1D74F,0x1D74F); (0x1D76F,0x1D76F); (0x1D789,0x1D789); (0x1D7A9,0x1D7A9); (0x1D7C3,0x1D7C3) ] (* Symbol, Currency *) let sc = [ (0x00024,0x00024); (0x000A2,0x000A5); (0x0058F,0x0058F); (0x0060B,0x0060B); (0x009F2,0x009F3); (0x009FB,0x009FB); (0x00AF1,0x00AF1); (0x00BF9,0x00BF9); (0x00E3F,0x00E3F); (0x017DB,0x017DB); (0x020A0,0x020BE); (0x0A838,0x0A838); (0x0FDFC,0x0FDFC); (0x0FE69,0x0FE69); (0x0FF04,0x0FF04); (0x0FFE0,0x0FFE1) ] (* Symbol, Modifier *) let sk = [ (0x0005E,0x0005E); (0x00060,0x00060); (0x000A8,0x000A8); (0x000AF,0x000AF); (0x000B4,0x000B4); (0x000B8,0x000B8); (0x002C2,0x002C5); (0x002D2,0x002DF); (0x002E5,0x002EB); (0x002ED,0x002ED); (0x002EF,0x002FF); (0x00375,0x00375); (0x00384,0x00385); (0x01FBD,0x01FBD); (0x01FBF,0x01FC1); (0x01FCD,0x01FCF); (0x01FDD,0x01FDF); (0x01FED,0x01FEF); (0x01FFD,0x01FFE); (0x0309B,0x0309C); (0x0A700,0x0A716); (0x0A720,0x0A721); (0x0A789,0x0A78A); (0x0AB5B,0x0AB5B); (0x0FBB2,0x0FBC1); (0x0FF3E,0x0FF3E); (0x0FF40,0x0FF40); (0x0FFE3,0x0FFE3) ] (* Symbol, Other *) let so = [ (0x000A6,0x000A6); (0x000A9,0x000A9); (0x000AE,0x000AE); (0x000B0,0x000B0); (0x00482,0x00482); (0x0058D,0x0058E); (0x0060E,0x0060F); (0x006DE,0x006DE); (0x006E9,0x006E9); (0x006FD,0x006FE); (0x007F6,0x007F6); (0x009FA,0x009FA); (0x00B70,0x00B70); (0x00BF3,0x00BF8); (0x00BFA,0x00BFA); (0x00C7F,0x00C7F); (0x00D4F,0x00D4F); (0x00D79,0x00D79); (0x00F01,0x00F03); (0x00F13,0x00F13); (0x00F15,0x00F17); (0x00F1A,0x00F1F); (0x00F34,0x00F34); (0x00F36,0x00F36); (0x00F38,0x00F38); (0x00FBE,0x00FC5); (0x00FC7,0x00FCC); (0x00FCE,0x00FCF); (0x00FD5,0x00FD8); (0x0109E,0x0109F); (0x01390,0x01399); (0x01940,0x01940); (0x019DE,0x019FF); (0x01B61,0x01B6A); (0x01B74,0x01B7C); (0x02100,0x02101); (0x02103,0x02106); (0x02108,0x02109); (0x02114,0x02114); (0x02116,0x02117); (0x0211E,0x02123); (0x02125,0x02125); (0x02127,0x02127); (0x02129,0x02129); (0x0212E,0x0212E); (0x0213A,0x0213B); (0x0214A,0x0214A); (0x0214C,0x0214D); (0x0214F,0x0214F); (0x0218A,0x0218B); (0x02195,0x02199); (0x0219C,0x0219F); (0x021A1,0x021A2); (0x021A4,0x021A5); (0x021A7,0x021AD); (0x021AF,0x021CD); (0x021D0,0x021D1); (0x021D3,0x021D3); (0x021D5,0x021F3); (0x02300,0x02307); (0x0230C,0x0231F); (0x02322,0x02328); (0x0232B,0x0237B); (0x0237D,0x0239A); (0x023B4,0x023DB); (0x023E2,0x023FE); (0x02400,0x02426); (0x02440,0x0244A); (0x0249C,0x024E9); (0x02500,0x025B6); (0x025B8,0x025C0); (0x025C2,0x025F7); (0x02600,0x0266E); (0x02670,0x02767); (0x02794,0x027BF); (0x02800,0x028FF); (0x02B00,0x02B2F); (0x02B45,0x02B46); (0x02B4D,0x02B73); (0x02B76,0x02B95); (0x02B98,0x02BB9); (0x02BBD,0x02BC8); (0x02BCA,0x02BD1); (0x02BEC,0x02BEF); (0x02CE5,0x02CEA); (0x02E80,0x02E99); (0x02E9B,0x02EF3); (0x02F00,0x02FD5); (0x02FF0,0x02FFB); (0x03004,0x03004); (0x03012,0x03013); (0x03020,0x03020); (0x03036,0x03037); (0x0303E,0x0303F); (0x03190,0x03191); (0x03196,0x0319F); (0x031C0,0x031E3); (0x03200,0x0321E); (0x0322A,0x03247); (0x03250,0x03250); (0x03260,0x0327F); (0x0328A,0x032B0); (0x032C0,0x032FE); (0x03300,0x033FF); (0x04DC0,0x04DFF); (0x0A490,0x0A4C6); (0x0A828,0x0A82B); (0x0A836,0x0A837); (0x0A839,0x0A839); (0x0AA77,0x0AA79); (0x0FDFD,0x0FDFD); (0x0FFE4,0x0FFE4); (0x0FFE8,0x0FFE8); (0x0FFED,0x0FFEE); (0x0FFFC,0x0FFFD); (0x10137,0x1013F); (0x10179,0x10189); (0x1018C,0x1018E); (0x10190,0x1019B); (0x101A0,0x101A0); (0x101D0,0x101FC); (0x10877,0x10878); (0x10AC8,0x10AC8); (0x1173F,0x1173F); (0x16B3C,0x16B3F); (0x16B45,0x16B45); (0x1BC9C,0x1BC9C); (0x1D000,0x1D0F5); (0x1D100,0x1D126); (0x1D129,0x1D164); (0x1D16A,0x1D16C); (0x1D183,0x1D184); (0x1D18C,0x1D1A9); (0x1D1AE,0x1D1E8); (0x1D200,0x1D241); (0x1D245,0x1D245); (0x1D300,0x1D356); (0x1D800,0x1D9FF); (0x1DA37,0x1DA3A); (0x1DA6D,0x1DA74); (0x1DA76,0x1DA83); (0x1DA85,0x1DA86); (0x1F000,0x1F02B); (0x1F030,0x1F093); (0x1F0A0,0x1F0AE); (0x1F0B1,0x1F0BF); (0x1F0C1,0x1F0CF); (0x1F0D1,0x1F0F5); (0x1F110,0x1F12E); (0x1F130,0x1F16B); (0x1F170,0x1F1AC); (0x1F1E6,0x1F202); (0x1F210,0x1F23B); (0x1F240,0x1F248); (0x1F250,0x1F251); (0x1F300,0x1F3FA); (0x1F400,0x1F6D2); (0x1F6E0,0x1F6EC); (0x1F6F0,0x1F6F6); (0x1F700,0x1F773); (0x1F780,0x1F7D4); (0x1F800,0x1F80B); (0x1F810,0x1F847); (0x1F850,0x1F859); (0x1F860,0x1F887); (0x1F890,0x1F8AD); (0x1F910,0x1F91E); (0x1F920,0x1F927); (0x1F930,0x1F930); (0x1F933,0x1F93E); (0x1F940,0x1F94B); (0x1F950,0x1F95E); (0x1F980,0x1F991) ] let to_lower = [ (0x00041,0x0005A), `Delta (32); (0x000C0,0x000D6), `Delta (32); (0x000D8,0x000DE), `Delta (32); (0x00100,0x00100), `Abs (0x00101); (0x00102,0x00102), `Abs (0x00103); (0x00104,0x00104), `Abs (0x00105); (0x00106,0x00106), `Abs (0x00107); (0x00108,0x00108), `Abs (0x00109); (0x0010A,0x0010A), `Abs (0x0010B); (0x0010C,0x0010C), `Abs (0x0010D); (0x0010E,0x0010E), `Abs (0x0010F); (0x00110,0x00110), `Abs (0x00111); (0x00112,0x00112), `Abs (0x00113); (0x00114,0x00114), `Abs (0x00115); (0x00116,0x00116), `Abs (0x00117); (0x00118,0x00118), `Abs (0x00119); (0x0011A,0x0011A), `Abs (0x0011B); (0x0011C,0x0011C), `Abs (0x0011D); (0x0011E,0x0011E), `Abs (0x0011F); (0x00120,0x00120), `Abs (0x00121); (0x00122,0x00122), `Abs (0x00123); (0x00124,0x00124), `Abs (0x00125); (0x00126,0x00126), `Abs (0x00127); (0x00128,0x00128), `Abs (0x00129); (0x0012A,0x0012A), `Abs (0x0012B); (0x0012C,0x0012C), `Abs (0x0012D); (0x0012E,0x0012E), `Abs (0x0012F); (0x00130,0x00130), `Abs (0x00069); (0x00132,0x00132), `Abs (0x00133); (0x00134,0x00134), `Abs (0x00135); (0x00136,0x00136), `Abs (0x00137); (0x00139,0x00139), `Abs (0x0013A); (0x0013B,0x0013B), `Abs (0x0013C); (0x0013D,0x0013D), `Abs (0x0013E); (0x0013F,0x0013F), `Abs (0x00140); (0x00141,0x00141), `Abs (0x00142); (0x00143,0x00143), `Abs (0x00144); (0x00145,0x00145), `Abs (0x00146); (0x00147,0x00147), `Abs (0x00148); (0x0014A,0x0014A), `Abs (0x0014B); (0x0014C,0x0014C), `Abs (0x0014D); (0x0014E,0x0014E), `Abs (0x0014F); (0x00150,0x00150), `Abs (0x00151); (0x00152,0x00152), `Abs (0x00153); (0x00154,0x00154), `Abs (0x00155); (0x00156,0x00156), `Abs (0x00157); (0x00158,0x00158), `Abs (0x00159); (0x0015A,0x0015A), `Abs (0x0015B); (0x0015C,0x0015C), `Abs (0x0015D); (0x0015E,0x0015E), `Abs (0x0015F); (0x00160,0x00160), `Abs (0x00161); (0x00162,0x00162), `Abs (0x00163); (0x00164,0x00164), `Abs (0x00165); (0x00166,0x00166), `Abs (0x00167); (0x00168,0x00168), `Abs (0x00169); (0x0016A,0x0016A), `Abs (0x0016B); (0x0016C,0x0016C), `Abs (0x0016D); (0x0016E,0x0016E), `Abs (0x0016F); (0x00170,0x00170), `Abs (0x00171); (0x00172,0x00172), `Abs (0x00173); (0x00174,0x00174), `Abs (0x00175); (0x00176,0x00176), `Abs (0x00177); (0x00178,0x00178), `Abs (0x000FF); (0x00179,0x00179), `Abs (0x0017A); (0x0017B,0x0017B), `Abs (0x0017C); (0x0017D,0x0017D), `Abs (0x0017E); (0x00181,0x00181), `Abs (0x00253); (0x00182,0x00182), `Abs (0x00183); (0x00184,0x00184), `Abs (0x00185); (0x00186,0x00186), `Abs (0x00254); (0x00187,0x00187), `Abs (0x00188); (0x00189,0x0018A), `Delta (205); (0x0018B,0x0018B), `Abs (0x0018C); (0x0018E,0x0018E), `Abs (0x001DD); (0x0018F,0x0018F), `Abs (0x00259); (0x00190,0x00190), `Abs (0x0025B); (0x00191,0x00191), `Abs (0x00192); (0x00193,0x00193), `Abs (0x00260); (0x00194,0x00194), `Abs (0x00263); (0x00196,0x00196), `Abs (0x00269); (0x00197,0x00197), `Abs (0x00268); (0x00198,0x00198), `Abs (0x00199); (0x0019C,0x0019C), `Abs (0x0026F); (0x0019D,0x0019D), `Abs (0x00272); (0x0019F,0x0019F), `Abs (0x00275); (0x001A0,0x001A0), `Abs (0x001A1); (0x001A2,0x001A2), `Abs (0x001A3); (0x001A4,0x001A4), `Abs (0x001A5); (0x001A6,0x001A6), `Abs (0x00280); (0x001A7,0x001A7), `Abs (0x001A8); (0x001A9,0x001A9), `Abs (0x00283); (0x001AC,0x001AC), `Abs (0x001AD); (0x001AE,0x001AE), `Abs (0x00288); (0x001AF,0x001AF), `Abs (0x001B0); (0x001B1,0x001B2), `Delta (217); (0x001B3,0x001B3), `Abs (0x001B4); (0x001B5,0x001B5), `Abs (0x001B6); (0x001B7,0x001B7), `Abs (0x00292); (0x001B8,0x001B8), `Abs (0x001B9); (0x001BC,0x001BC), `Abs (0x001BD); (0x001C4,0x001C4), `Abs (0x001C6); (0x001C7,0x001C7), `Abs (0x001C9); (0x001CA,0x001CA), `Abs (0x001CC); (0x001CD,0x001CD), `Abs (0x001CE); (0x001CF,0x001CF), `Abs (0x001D0); (0x001D1,0x001D1), `Abs (0x001D2); (0x001D3,0x001D3), `Abs (0x001D4); (0x001D5,0x001D5), `Abs (0x001D6); (0x001D7,0x001D7), `Abs (0x001D8); (0x001D9,0x001D9), `Abs (0x001DA); (0x001DB,0x001DB), `Abs (0x001DC); (0x001DE,0x001DE), `Abs (0x001DF); (0x001E0,0x001E0), `Abs (0x001E1); (0x001E2,0x001E2), `Abs (0x001E3); (0x001E4,0x001E4), `Abs (0x001E5); (0x001E6,0x001E6), `Abs (0x001E7); (0x001E8,0x001E8), `Abs (0x001E9); (0x001EA,0x001EA), `Abs (0x001EB); (0x001EC,0x001EC), `Abs (0x001ED); (0x001EE,0x001EE), `Abs (0x001EF); (0x001F1,0x001F1), `Abs (0x001F3); (0x001F4,0x001F4), `Abs (0x001F5); (0x001F6,0x001F6), `Abs (0x00195); (0x001F7,0x001F7), `Abs (0x001BF); (0x001F8,0x001F8), `Abs (0x001F9); (0x001FA,0x001FA), `Abs (0x001FB); (0x001FC,0x001FC), `Abs (0x001FD); (0x001FE,0x001FE), `Abs (0x001FF); (0x00200,0x00200), `Abs (0x00201); (0x00202,0x00202), `Abs (0x00203); (0x00204,0x00204), `Abs (0x00205); (0x00206,0x00206), `Abs (0x00207); (0x00208,0x00208), `Abs (0x00209); (0x0020A,0x0020A), `Abs (0x0020B); (0x0020C,0x0020C), `Abs (0x0020D); (0x0020E,0x0020E), `Abs (0x0020F); (0x00210,0x00210), `Abs (0x00211); (0x00212,0x00212), `Abs (0x00213); (0x00214,0x00214), `Abs (0x00215); (0x00216,0x00216), `Abs (0x00217); (0x00218,0x00218), `Abs (0x00219); (0x0021A,0x0021A), `Abs (0x0021B); (0x0021C,0x0021C), `Abs (0x0021D); (0x0021E,0x0021E), `Abs (0x0021F); (0x00220,0x00220), `Abs (0x0019E); (0x00222,0x00222), `Abs (0x00223); (0x00224,0x00224), `Abs (0x00225); (0x00226,0x00226), `Abs (0x00227); (0x00228,0x00228), `Abs (0x00229); (0x0022A,0x0022A), `Abs (0x0022B); (0x0022C,0x0022C), `Abs (0x0022D); (0x0022E,0x0022E), `Abs (0x0022F); (0x00230,0x00230), `Abs (0x00231); (0x00232,0x00232), `Abs (0x00233); (0x0023A,0x0023A), `Abs (0x02C65); (0x0023B,0x0023B), `Abs (0x0023C); (0x0023D,0x0023D), `Abs (0x0019A); (0x0023E,0x0023E), `Abs (0x02C66); (0x00241,0x00241), `Abs (0x00242); (0x00243,0x00243), `Abs (0x00180); (0x00244,0x00244), `Abs (0x00289); (0x00245,0x00245), `Abs (0x0028C); (0x00246,0x00246), `Abs (0x00247); (0x00248,0x00248), `Abs (0x00249); (0x0024A,0x0024A), `Abs (0x0024B); (0x0024C,0x0024C), `Abs (0x0024D); (0x0024E,0x0024E), `Abs (0x0024F); (0x00370,0x00370), `Abs (0x00371); (0x00372,0x00372), `Abs (0x00373); (0x00376,0x00376), `Abs (0x00377); (0x0037F,0x0037F), `Abs (0x003F3); (0x00386,0x00386), `Abs (0x003AC); (0x00388,0x0038A), `Delta (37); (0x0038C,0x0038C), `Abs (0x003CC); (0x0038E,0x0038F), `Delta (63); (0x00391,0x003A1), `Delta (32); (0x003A3,0x003AB), `Delta (32); (0x003CF,0x003CF), `Abs (0x003D7); (0x003D2,0x003D4), `Delta (0); (0x003D8,0x003D8), `Abs (0x003D9); (0x003DA,0x003DA), `Abs (0x003DB); (0x003DC,0x003DC), `Abs (0x003DD); (0x003DE,0x003DE), `Abs (0x003DF); (0x003E0,0x003E0), `Abs (0x003E1); (0x003E2,0x003E2), `Abs (0x003E3); (0x003E4,0x003E4), `Abs (0x003E5); (0x003E6,0x003E6), `Abs (0x003E7); (0x003E8,0x003E8), `Abs (0x003E9); (0x003EA,0x003EA), `Abs (0x003EB); (0x003EC,0x003EC), `Abs (0x003ED); (0x003EE,0x003EE), `Abs (0x003EF); (0x003F4,0x003F4), `Abs (0x003B8); (0x003F7,0x003F7), `Abs (0x003F8); (0x003F9,0x003F9), `Abs (0x003F2); (0x003FA,0x003FA), `Abs (0x003FB); (0x003FD,0x003FF), `Delta (-130); (0x00400,0x0040F), `Delta (80); (0x00410,0x0042F), `Delta (32); (0x00460,0x00460), `Abs (0x00461); (0x00462,0x00462), `Abs (0x00463); (0x00464,0x00464), `Abs (0x00465); (0x00466,0x00466), `Abs (0x00467); (0x00468,0x00468), `Abs (0x00469); (0x0046A,0x0046A), `Abs (0x0046B); (0x0046C,0x0046C), `Abs (0x0046D); (0x0046E,0x0046E), `Abs (0x0046F); (0x00470,0x00470), `Abs (0x00471); (0x00472,0x00472), `Abs (0x00473); (0x00474,0x00474), `Abs (0x00475); (0x00476,0x00476), `Abs (0x00477); (0x00478,0x00478), `Abs (0x00479); (0x0047A,0x0047A), `Abs (0x0047B); (0x0047C,0x0047C), `Abs (0x0047D); (0x0047E,0x0047E), `Abs (0x0047F); (0x00480,0x00480), `Abs (0x00481); (0x0048A,0x0048A), `Abs (0x0048B); (0x0048C,0x0048C), `Abs (0x0048D); (0x0048E,0x0048E), `Abs (0x0048F); (0x00490,0x00490), `Abs (0x00491); (0x00492,0x00492), `Abs (0x00493); (0x00494,0x00494), `Abs (0x00495); (0x00496,0x00496), `Abs (0x00497); (0x00498,0x00498), `Abs (0x00499); (0x0049A,0x0049A), `Abs (0x0049B); (0x0049C,0x0049C), `Abs (0x0049D); (0x0049E,0x0049E), `Abs (0x0049F); (0x004A0,0x004A0), `Abs (0x004A1); (0x004A2,0x004A2), `Abs (0x004A3); (0x004A4,0x004A4), `Abs (0x004A5); (0x004A6,0x004A6), `Abs (0x004A7); (0x004A8,0x004A8), `Abs (0x004A9); (0x004AA,0x004AA), `Abs (0x004AB); (0x004AC,0x004AC), `Abs (0x004AD); (0x004AE,0x004AE), `Abs (0x004AF); (0x004B0,0x004B0), `Abs (0x004B1); (0x004B2,0x004B2), `Abs (0x004B3); (0x004B4,0x004B4), `Abs (0x004B5); (0x004B6,0x004B6), `Abs (0x004B7); (0x004B8,0x004B8), `Abs (0x004B9); (0x004BA,0x004BA), `Abs (0x004BB); (0x004BC,0x004BC), `Abs (0x004BD); (0x004BE,0x004BE), `Abs (0x004BF); (0x004C0,0x004C0), `Abs (0x004CF); (0x004C1,0x004C1), `Abs (0x004C2); (0x004C3,0x004C3), `Abs (0x004C4); (0x004C5,0x004C5), `Abs (0x004C6); (0x004C7,0x004C7), `Abs (0x004C8); (0x004C9,0x004C9), `Abs (0x004CA); (0x004CB,0x004CB), `Abs (0x004CC); (0x004CD,0x004CD), `Abs (0x004CE); (0x004D0,0x004D0), `Abs (0x004D1); (0x004D2,0x004D2), `Abs (0x004D3); (0x004D4,0x004D4), `Abs (0x004D5); (0x004D6,0x004D6), `Abs (0x004D7); (0x004D8,0x004D8), `Abs (0x004D9); (0x004DA,0x004DA), `Abs (0x004DB); (0x004DC,0x004DC), `Abs (0x004DD); (0x004DE,0x004DE), `Abs (0x004DF); (0x004E0,0x004E0), `Abs (0x004E1); (0x004E2,0x004E2), `Abs (0x004E3); (0x004E4,0x004E4), `Abs (0x004E5); (0x004E6,0x004E6), `Abs (0x004E7); (0x004E8,0x004E8), `Abs (0x004E9); (0x004EA,0x004EA), `Abs (0x004EB); (0x004EC,0x004EC), `Abs (0x004ED); (0x004EE,0x004EE), `Abs (0x004EF); (0x004F0,0x004F0), `Abs (0x004F1); (0x004F2,0x004F2), `Abs (0x004F3); (0x004F4,0x004F4), `Abs (0x004F5); (0x004F6,0x004F6), `Abs (0x004F7); (0x004F8,0x004F8), `Abs (0x004F9); (0x004FA,0x004FA), `Abs (0x004FB); (0x004FC,0x004FC), `Abs (0x004FD); (0x004FE,0x004FE), `Abs (0x004FF); (0x00500,0x00500), `Abs (0x00501); (0x00502,0x00502), `Abs (0x00503); (0x00504,0x00504), `Abs (0x00505); (0x00506,0x00506), `Abs (0x00507); (0x00508,0x00508), `Abs (0x00509); (0x0050A,0x0050A), `Abs (0x0050B); (0x0050C,0x0050C), `Abs (0x0050D); (0x0050E,0x0050E), `Abs (0x0050F); (0x00510,0x00510), `Abs (0x00511); (0x00512,0x00512), `Abs (0x00513); (0x00514,0x00514), `Abs (0x00515); (0x00516,0x00516), `Abs (0x00517); (0x00518,0x00518), `Abs (0x00519); (0x0051A,0x0051A), `Abs (0x0051B); (0x0051C,0x0051C), `Abs (0x0051D); (0x0051E,0x0051E), `Abs (0x0051F); (0x00520,0x00520), `Abs (0x00521); (0x00522,0x00522), `Abs (0x00523); (0x00524,0x00524), `Abs (0x00525); (0x00526,0x00526), `Abs (0x00527); (0x00528,0x00528), `Abs (0x00529); (0x0052A,0x0052A), `Abs (0x0052B); (0x0052C,0x0052C), `Abs (0x0052D); (0x0052E,0x0052E), `Abs (0x0052F); (0x00531,0x00556), `Delta (48); (0x010A0,0x010C5), `Delta (7264); (0x010C7,0x010C7), `Abs (0x02D27); (0x010CD,0x010CD), `Abs (0x02D2D); (0x013A0,0x013EF), `Delta (38864); (0x013F0,0x013F5), `Delta (8); (0x01E00,0x01E00), `Abs (0x01E01); (0x01E02,0x01E02), `Abs (0x01E03); (0x01E04,0x01E04), `Abs (0x01E05); (0x01E06,0x01E06), `Abs (0x01E07); (0x01E08,0x01E08), `Abs (0x01E09); (0x01E0A,0x01E0A), `Abs (0x01E0B); (0x01E0C,0x01E0C), `Abs (0x01E0D); (0x01E0E,0x01E0E), `Abs (0x01E0F); (0x01E10,0x01E10), `Abs (0x01E11); (0x01E12,0x01E12), `Abs (0x01E13); (0x01E14,0x01E14), `Abs (0x01E15); (0x01E16,0x01E16), `Abs (0x01E17); (0x01E18,0x01E18), `Abs (0x01E19); (0x01E1A,0x01E1A), `Abs (0x01E1B); (0x01E1C,0x01E1C), `Abs (0x01E1D); (0x01E1E,0x01E1E), `Abs (0x01E1F); (0x01E20,0x01E20), `Abs (0x01E21); (0x01E22,0x01E22), `Abs (0x01E23); (0x01E24,0x01E24), `Abs (0x01E25); (0x01E26,0x01E26), `Abs (0x01E27); (0x01E28,0x01E28), `Abs (0x01E29); (0x01E2A,0x01E2A), `Abs (0x01E2B); (0x01E2C,0x01E2C), `Abs (0x01E2D); (0x01E2E,0x01E2E), `Abs (0x01E2F); (0x01E30,0x01E30), `Abs (0x01E31); (0x01E32,0x01E32), `Abs (0x01E33); (0x01E34,0x01E34), `Abs (0x01E35); (0x01E36,0x01E36), `Abs (0x01E37); (0x01E38,0x01E38), `Abs (0x01E39); (0x01E3A,0x01E3A), `Abs (0x01E3B); (0x01E3C,0x01E3C), `Abs (0x01E3D); (0x01E3E,0x01E3E), `Abs (0x01E3F); (0x01E40,0x01E40), `Abs (0x01E41); (0x01E42,0x01E42), `Abs (0x01E43); (0x01E44,0x01E44), `Abs (0x01E45); (0x01E46,0x01E46), `Abs (0x01E47); (0x01E48,0x01E48), `Abs (0x01E49); (0x01E4A,0x01E4A), `Abs (0x01E4B); (0x01E4C,0x01E4C), `Abs (0x01E4D); (0x01E4E,0x01E4E), `Abs (0x01E4F); (0x01E50,0x01E50), `Abs (0x01E51); (0x01E52,0x01E52), `Abs (0x01E53); (0x01E54,0x01E54), `Abs (0x01E55); (0x01E56,0x01E56), `Abs (0x01E57); (0x01E58,0x01E58), `Abs (0x01E59); (0x01E5A,0x01E5A), `Abs (0x01E5B); (0x01E5C,0x01E5C), `Abs (0x01E5D); (0x01E5E,0x01E5E), `Abs (0x01E5F); (0x01E60,0x01E60), `Abs (0x01E61); (0x01E62,0x01E62), `Abs (0x01E63); (0x01E64,0x01E64), `Abs (0x01E65); (0x01E66,0x01E66), `Abs (0x01E67); (0x01E68,0x01E68), `Abs (0x01E69); (0x01E6A,0x01E6A), `Abs (0x01E6B); (0x01E6C,0x01E6C), `Abs (0x01E6D); (0x01E6E,0x01E6E), `Abs (0x01E6F); (0x01E70,0x01E70), `Abs (0x01E71); (0x01E72,0x01E72), `Abs (0x01E73); (0x01E74,0x01E74), `Abs (0x01E75); (0x01E76,0x01E76), `Abs (0x01E77); (0x01E78,0x01E78), `Abs (0x01E79); (0x01E7A,0x01E7A), `Abs (0x01E7B); (0x01E7C,0x01E7C), `Abs (0x01E7D); (0x01E7E,0x01E7E), `Abs (0x01E7F); (0x01E80,0x01E80), `Abs (0x01E81); (0x01E82,0x01E82), `Abs (0x01E83); (0x01E84,0x01E84), `Abs (0x01E85); (0x01E86,0x01E86), `Abs (0x01E87); (0x01E88,0x01E88), `Abs (0x01E89); (0x01E8A,0x01E8A), `Abs (0x01E8B); (0x01E8C,0x01E8C), `Abs (0x01E8D); (0x01E8E,0x01E8E), `Abs (0x01E8F); (0x01E90,0x01E90), `Abs (0x01E91); (0x01E92,0x01E92), `Abs (0x01E93); (0x01E94,0x01E94), `Abs (0x01E95); (0x01E9E,0x01E9E), `Abs (0x000DF); (0x01EA0,0x01EA0), `Abs (0x01EA1); (0x01EA2,0x01EA2), `Abs (0x01EA3); (0x01EA4,0x01EA4), `Abs (0x01EA5); (0x01EA6,0x01EA6), `Abs (0x01EA7); (0x01EA8,0x01EA8), `Abs (0x01EA9); (0x01EAA,0x01EAA), `Abs (0x01EAB); (0x01EAC,0x01EAC), `Abs (0x01EAD); (0x01EAE,0x01EAE), `Abs (0x01EAF); (0x01EB0,0x01EB0), `Abs (0x01EB1); (0x01EB2,0x01EB2), `Abs (0x01EB3); (0x01EB4,0x01EB4), `Abs (0x01EB5); (0x01EB6,0x01EB6), `Abs (0x01EB7); (0x01EB8,0x01EB8), `Abs (0x01EB9); (0x01EBA,0x01EBA), `Abs (0x01EBB); (0x01EBC,0x01EBC), `Abs (0x01EBD); (0x01EBE,0x01EBE), `Abs (0x01EBF); (0x01EC0,0x01EC0), `Abs (0x01EC1); (0x01EC2,0x01EC2), `Abs (0x01EC3); (0x01EC4,0x01EC4), `Abs (0x01EC5); (0x01EC6,0x01EC6), `Abs (0x01EC7); (0x01EC8,0x01EC8), `Abs (0x01EC9); (0x01ECA,0x01ECA), `Abs (0x01ECB); (0x01ECC,0x01ECC), `Abs (0x01ECD); (0x01ECE,0x01ECE), `Abs (0x01ECF); (0x01ED0,0x01ED0), `Abs (0x01ED1); (0x01ED2,0x01ED2), `Abs (0x01ED3); (0x01ED4,0x01ED4), `Abs (0x01ED5); (0x01ED6,0x01ED6), `Abs (0x01ED7); (0x01ED8,0x01ED8), `Abs (0x01ED9); (0x01EDA,0x01EDA), `Abs (0x01EDB); (0x01EDC,0x01EDC), `Abs (0x01EDD); (0x01EDE,0x01EDE), `Abs (0x01EDF); (0x01EE0,0x01EE0), `Abs (0x01EE1); (0x01EE2,0x01EE2), `Abs (0x01EE3); (0x01EE4,0x01EE4), `Abs (0x01EE5); (0x01EE6,0x01EE6), `Abs (0x01EE7); (0x01EE8,0x01EE8), `Abs (0x01EE9); (0x01EEA,0x01EEA), `Abs (0x01EEB); (0x01EEC,0x01EEC), `Abs (0x01EED); (0x01EEE,0x01EEE), `Abs (0x01EEF); (0x01EF0,0x01EF0), `Abs (0x01EF1); (0x01EF2,0x01EF2), `Abs (0x01EF3); (0x01EF4,0x01EF4), `Abs (0x01EF5); (0x01EF6,0x01EF6), `Abs (0x01EF7); (0x01EF8,0x01EF8), `Abs (0x01EF9); (0x01EFA,0x01EFA), `Abs (0x01EFB); (0x01EFC,0x01EFC), `Abs (0x01EFD); (0x01EFE,0x01EFE), `Abs (0x01EFF); (0x01F08,0x01F0F), `Delta (-8); (0x01F18,0x01F1D), `Delta (-8); (0x01F28,0x01F2F), `Delta (-8); (0x01F38,0x01F3F), `Delta (-8); (0x01F48,0x01F4D), `Delta (-8); (0x01F59,0x01F59), `Abs (0x01F51); (0x01F5B,0x01F5B), `Abs (0x01F53); (0x01F5D,0x01F5D), `Abs (0x01F55); (0x01F5F,0x01F5F), `Abs (0x01F57); (0x01F68,0x01F6F), `Delta (-8); (0x01FB8,0x01FB9), `Delta (-8); (0x01FBA,0x01FBB), `Delta (-74); (0x01FC8,0x01FCB), `Delta (-86); (0x01FD8,0x01FD9), `Delta (-8); (0x01FDA,0x01FDB), `Delta (-100); (0x01FE8,0x01FE9), `Delta (-8); (0x01FEA,0x01FEB), `Delta (-112); (0x01FEC,0x01FEC), `Abs (0x01FE5); (0x01FF8,0x01FF9), `Delta (-128); (0x01FFA,0x01FFB), `Delta (-126); (0x02102,0x02102), `Abs (0x02102); (0x02107,0x02107), `Abs (0x02107); (0x0210B,0x0210D), `Delta (0); (0x02110,0x02112), `Delta (0); (0x02115,0x02115), `Abs (0x02115); (0x02119,0x0211D), `Delta (0); (0x02124,0x02124), `Abs (0x02124); (0x02126,0x02126), `Abs (0x003C9); (0x02128,0x02128), `Abs (0x02128); (0x0212A,0x0212A), `Abs (0x0006B); (0x0212B,0x0212B), `Abs (0x000E5); (0x0212C,0x0212D), `Delta (0); (0x02130,0x02131), `Delta (0); (0x02132,0x02132), `Abs (0x0214E); (0x02133,0x02133), `Abs (0x02133); (0x0213E,0x0213F), `Delta (0); (0x02145,0x02145), `Abs (0x02145); (0x02183,0x02183), `Abs (0x02184); (0x02C00,0x02C2E), `Delta (48); (0x02C60,0x02C60), `Abs (0x02C61); (0x02C62,0x02C62), `Abs (0x0026B); (0x02C63,0x02C63), `Abs (0x01D7D); (0x02C64,0x02C64), `Abs (0x0027D); (0x02C67,0x02C67), `Abs (0x02C68); (0x02C69,0x02C69), `Abs (0x02C6A); (0x02C6B,0x02C6B), `Abs (0x02C6C); (0x02C6D,0x02C6D), `Abs (0x00251); (0x02C6E,0x02C6E), `Abs (0x00271); (0x02C6F,0x02C6F), `Abs (0x00250); (0x02C70,0x02C70), `Abs (0x00252); (0x02C72,0x02C72), `Abs (0x02C73); (0x02C75,0x02C75), `Abs (0x02C76); (0x02C7E,0x02C7F), `Delta (-10815); (0x02C80,0x02C80), `Abs (0x02C81); (0x02C82,0x02C82), `Abs (0x02C83); (0x02C84,0x02C84), `Abs (0x02C85); (0x02C86,0x02C86), `Abs (0x02C87); (0x02C88,0x02C88), `Abs (0x02C89); (0x02C8A,0x02C8A), `Abs (0x02C8B); (0x02C8C,0x02C8C), `Abs (0x02C8D); (0x02C8E,0x02C8E), `Abs (0x02C8F); (0x02C90,0x02C90), `Abs (0x02C91); (0x02C92,0x02C92), `Abs (0x02C93); (0x02C94,0x02C94), `Abs (0x02C95); (0x02C96,0x02C96), `Abs (0x02C97); (0x02C98,0x02C98), `Abs (0x02C99); (0x02C9A,0x02C9A), `Abs (0x02C9B); (0x02C9C,0x02C9C), `Abs (0x02C9D); (0x02C9E,0x02C9E), `Abs (0x02C9F); (0x02CA0,0x02CA0), `Abs (0x02CA1); (0x02CA2,0x02CA2), `Abs (0x02CA3); (0x02CA4,0x02CA4), `Abs (0x02CA5); (0x02CA6,0x02CA6), `Abs (0x02CA7); (0x02CA8,0x02CA8), `Abs (0x02CA9); (0x02CAA,0x02CAA), `Abs (0x02CAB); (0x02CAC,0x02CAC), `Abs (0x02CAD); (0x02CAE,0x02CAE), `Abs (0x02CAF); (0x02CB0,0x02CB0), `Abs (0x02CB1); (0x02CB2,0x02CB2), `Abs (0x02CB3); (0x02CB4,0x02CB4), `Abs (0x02CB5); (0x02CB6,0x02CB6), `Abs (0x02CB7); (0x02CB8,0x02CB8), `Abs (0x02CB9); (0x02CBA,0x02CBA), `Abs (0x02CBB); (0x02CBC,0x02CBC), `Abs (0x02CBD); (0x02CBE,0x02CBE), `Abs (0x02CBF); (0x02CC0,0x02CC0), `Abs (0x02CC1); (0x02CC2,0x02CC2), `Abs (0x02CC3); (0x02CC4,0x02CC4), `Abs (0x02CC5); (0x02CC6,0x02CC6), `Abs (0x02CC7); (0x02CC8,0x02CC8), `Abs (0x02CC9); (0x02CCA,0x02CCA), `Abs (0x02CCB); (0x02CCC,0x02CCC), `Abs (0x02CCD); (0x02CCE,0x02CCE), `Abs (0x02CCF); (0x02CD0,0x02CD0), `Abs (0x02CD1); (0x02CD2,0x02CD2), `Abs (0x02CD3); (0x02CD4,0x02CD4), `Abs (0x02CD5); (0x02CD6,0x02CD6), `Abs (0x02CD7); (0x02CD8,0x02CD8), `Abs (0x02CD9); (0x02CDA,0x02CDA), `Abs (0x02CDB); (0x02CDC,0x02CDC), `Abs (0x02CDD); (0x02CDE,0x02CDE), `Abs (0x02CDF); (0x02CE0,0x02CE0), `Abs (0x02CE1); (0x02CE2,0x02CE2), `Abs (0x02CE3); (0x02CEB,0x02CEB), `Abs (0x02CEC); (0x02CED,0x02CED), `Abs (0x02CEE); (0x02CF2,0x02CF2), `Abs (0x02CF3); (0x0A640,0x0A640), `Abs (0x0A641); (0x0A642,0x0A642), `Abs (0x0A643); (0x0A644,0x0A644), `Abs (0x0A645); (0x0A646,0x0A646), `Abs (0x0A647); (0x0A648,0x0A648), `Abs (0x0A649); (0x0A64A,0x0A64A), `Abs (0x0A64B); (0x0A64C,0x0A64C), `Abs (0x0A64D); (0x0A64E,0x0A64E), `Abs (0x0A64F); (0x0A650,0x0A650), `Abs (0x0A651); (0x0A652,0x0A652), `Abs (0x0A653); (0x0A654,0x0A654), `Abs (0x0A655); (0x0A656,0x0A656), `Abs (0x0A657); (0x0A658,0x0A658), `Abs (0x0A659); (0x0A65A,0x0A65A), `Abs (0x0A65B); (0x0A65C,0x0A65C), `Abs (0x0A65D); (0x0A65E,0x0A65E), `Abs (0x0A65F); (0x0A660,0x0A660), `Abs (0x0A661); (0x0A662,0x0A662), `Abs (0x0A663); (0x0A664,0x0A664), `Abs (0x0A665); (0x0A666,0x0A666), `Abs (0x0A667); (0x0A668,0x0A668), `Abs (0x0A669); (0x0A66A,0x0A66A), `Abs (0x0A66B); (0x0A66C,0x0A66C), `Abs (0x0A66D); (0x0A680,0x0A680), `Abs (0x0A681); (0x0A682,0x0A682), `Abs (0x0A683); (0x0A684,0x0A684), `Abs (0x0A685); (0x0A686,0x0A686), `Abs (0x0A687); (0x0A688,0x0A688), `Abs (0x0A689); (0x0A68A,0x0A68A), `Abs (0x0A68B); (0x0A68C,0x0A68C), `Abs (0x0A68D); (0x0A68E,0x0A68E), `Abs (0x0A68F); (0x0A690,0x0A690), `Abs (0x0A691); (0x0A692,0x0A692), `Abs (0x0A693); (0x0A694,0x0A694), `Abs (0x0A695); (0x0A696,0x0A696), `Abs (0x0A697); (0x0A698,0x0A698), `Abs (0x0A699); (0x0A69A,0x0A69A), `Abs (0x0A69B); (0x0A722,0x0A722), `Abs (0x0A723); (0x0A724,0x0A724), `Abs (0x0A725); (0x0A726,0x0A726), `Abs (0x0A727); (0x0A728,0x0A728), `Abs (0x0A729); (0x0A72A,0x0A72A), `Abs (0x0A72B); (0x0A72C,0x0A72C), `Abs (0x0A72D); (0x0A72E,0x0A72E), `Abs (0x0A72F); (0x0A732,0x0A732), `Abs (0x0A733); (0x0A734,0x0A734), `Abs (0x0A735); (0x0A736,0x0A736), `Abs (0x0A737); (0x0A738,0x0A738), `Abs (0x0A739); (0x0A73A,0x0A73A), `Abs (0x0A73B); (0x0A73C,0x0A73C), `Abs (0x0A73D); (0x0A73E,0x0A73E), `Abs (0x0A73F); (0x0A740,0x0A740), `Abs (0x0A741); (0x0A742,0x0A742), `Abs (0x0A743); (0x0A744,0x0A744), `Abs (0x0A745); (0x0A746,0x0A746), `Abs (0x0A747); (0x0A748,0x0A748), `Abs (0x0A749); (0x0A74A,0x0A74A), `Abs (0x0A74B); (0x0A74C,0x0A74C), `Abs (0x0A74D); (0x0A74E,0x0A74E), `Abs (0x0A74F); (0x0A750,0x0A750), `Abs (0x0A751); (0x0A752,0x0A752), `Abs (0x0A753); (0x0A754,0x0A754), `Abs (0x0A755); (0x0A756,0x0A756), `Abs (0x0A757); (0x0A758,0x0A758), `Abs (0x0A759); (0x0A75A,0x0A75A), `Abs (0x0A75B); (0x0A75C,0x0A75C), `Abs (0x0A75D); (0x0A75E,0x0A75E), `Abs (0x0A75F); (0x0A760,0x0A760), `Abs (0x0A761); (0x0A762,0x0A762), `Abs (0x0A763); (0x0A764,0x0A764), `Abs (0x0A765); (0x0A766,0x0A766), `Abs (0x0A767); (0x0A768,0x0A768), `Abs (0x0A769); (0x0A76A,0x0A76A), `Abs (0x0A76B); (0x0A76C,0x0A76C), `Abs (0x0A76D); (0x0A76E,0x0A76E), `Abs (0x0A76F); (0x0A779,0x0A779), `Abs (0x0A77A); (0x0A77B,0x0A77B), `Abs (0x0A77C); (0x0A77D,0x0A77D), `Abs (0x01D79); (0x0A77E,0x0A77E), `Abs (0x0A77F); (0x0A780,0x0A780), `Abs (0x0A781); (0x0A782,0x0A782), `Abs (0x0A783); (0x0A784,0x0A784), `Abs (0x0A785); (0x0A786,0x0A786), `Abs (0x0A787); (0x0A78B,0x0A78B), `Abs (0x0A78C); (0x0A78D,0x0A78D), `Abs (0x00265); (0x0A790,0x0A790), `Abs (0x0A791); (0x0A792,0x0A792), `Abs (0x0A793); (0x0A796,0x0A796), `Abs (0x0A797); (0x0A798,0x0A798), `Abs (0x0A799); (0x0A79A,0x0A79A), `Abs (0x0A79B); (0x0A79C,0x0A79C), `Abs (0x0A79D); (0x0A79E,0x0A79E), `Abs (0x0A79F); (0x0A7A0,0x0A7A0), `Abs (0x0A7A1); (0x0A7A2,0x0A7A2), `Abs (0x0A7A3); (0x0A7A4,0x0A7A4), `Abs (0x0A7A5); (0x0A7A6,0x0A7A6), `Abs (0x0A7A7); (0x0A7A8,0x0A7A8), `Abs (0x0A7A9); (0x0A7AA,0x0A7AA), `Abs (0x00266); (0x0A7AB,0x0A7AB), `Abs (0x0025C); (0x0A7AC,0x0A7AC), `Abs (0x00261); (0x0A7AD,0x0A7AD), `Abs (0x0026C); (0x0A7AE,0x0A7AE), `Abs (0x0026A); (0x0A7B0,0x0A7B0), `Abs (0x0029E); (0x0A7B1,0x0A7B1), `Abs (0x00287); (0x0A7B2,0x0A7B2), `Abs (0x0029D); (0x0A7B3,0x0A7B3), `Abs (0x0AB53); (0x0A7B4,0x0A7B4), `Abs (0x0A7B5); (0x0A7B6,0x0A7B6), `Abs (0x0A7B7); (0x0FF21,0x0FF3A), `Delta (32); (0x10400,0x10427), `Delta (40); (0x104B0,0x104D3), `Delta (40); (0x10C80,0x10CB2), `Delta (64); (0x118A0,0x118BF), `Delta (32); (0x1D400,0x1D419), `Delta (0); (0x1D434,0x1D44D), `Delta (0); (0x1D468,0x1D481), `Delta (0); (0x1D49C,0x1D49C), `Abs (0x1D49C); (0x1D49E,0x1D49F), `Delta (0); (0x1D4A2,0x1D4A2), `Abs (0x1D4A2); (0x1D4A5,0x1D4A6), `Delta (0); (0x1D4A9,0x1D4AC), `Delta (0); (0x1D4AE,0x1D4B5), `Delta (0); (0x1D4D0,0x1D4E9), `Delta (0); (0x1D504,0x1D505), `Delta (0); (0x1D507,0x1D50A), `Delta (0); (0x1D50D,0x1D514), `Delta (0); (0x1D516,0x1D51C), `Delta (0); (0x1D538,0x1D539), `Delta (0); (0x1D53B,0x1D53E), `Delta (0); (0x1D540,0x1D544), `Delta (0); (0x1D546,0x1D546), `Abs (0x1D546); (0x1D54A,0x1D550), `Delta (0); (0x1D56C,0x1D585), `Delta (0); (0x1D5A0,0x1D5B9), `Delta (0); (0x1D5D4,0x1D5ED), `Delta (0); (0x1D608,0x1D621), `Delta (0); (0x1D63C,0x1D655), `Delta (0); (0x1D670,0x1D689), `Delta (0); (0x1D6A8,0x1D6C0), `Delta (0); (0x1D6E2,0x1D6FA), `Delta (0); (0x1D71C,0x1D734), `Delta (0); (0x1D756,0x1D76E), `Delta (0); (0x1D790,0x1D7A8), `Delta (0); (0x1D7CA,0x1D7CA), `Abs (0x1D7CA); (0x1E900,0x1E921), `Delta (34); (0x00061,0x0007A), `Delta (0); (0x000B5,0x000B5), `Abs (0x000B5); (0x000DF,0x000F6), `Delta (0); (0x000F8,0x000FF), `Delta (0); (0x00101,0x00101), `Abs (0x00101); (0x00103,0x00103), `Abs (0x00103); (0x00105,0x00105), `Abs (0x00105); (0x00107,0x00107), `Abs (0x00107); (0x00109,0x00109), `Abs (0x00109); (0x0010B,0x0010B), `Abs (0x0010B); (0x0010D,0x0010D), `Abs (0x0010D); (0x0010F,0x0010F), `Abs (0x0010F); (0x00111,0x00111), `Abs (0x00111); (0x00113,0x00113), `Abs (0x00113); (0x00115,0x00115), `Abs (0x00115); (0x00117,0x00117), `Abs (0x00117); (0x00119,0x00119), `Abs (0x00119); (0x0011B,0x0011B), `Abs (0x0011B); (0x0011D,0x0011D), `Abs (0x0011D); (0x0011F,0x0011F), `Abs (0x0011F); (0x00121,0x00121), `Abs (0x00121); (0x00123,0x00123), `Abs (0x00123); (0x00125,0x00125), `Abs (0x00125); (0x00127,0x00127), `Abs (0x00127); (0x00129,0x00129), `Abs (0x00129); (0x0012B,0x0012B), `Abs (0x0012B); (0x0012D,0x0012D), `Abs (0x0012D); (0x0012F,0x0012F), `Abs (0x0012F); (0x00131,0x00131), `Abs (0x00131); (0x00133,0x00133), `Abs (0x00133); (0x00135,0x00135), `Abs (0x00135); (0x00137,0x00138), `Delta (0); (0x0013A,0x0013A), `Abs (0x0013A); (0x0013C,0x0013C), `Abs (0x0013C); (0x0013E,0x0013E), `Abs (0x0013E); (0x00140,0x00140), `Abs (0x00140); (0x00142,0x00142), `Abs (0x00142); (0x00144,0x00144), `Abs (0x00144); (0x00146,0x00146), `Abs (0x00146); (0x00148,0x00149), `Delta (0); (0x0014B,0x0014B), `Abs (0x0014B); (0x0014D,0x0014D), `Abs (0x0014D); (0x0014F,0x0014F), `Abs (0x0014F); (0x00151,0x00151), `Abs (0x00151); (0x00153,0x00153), `Abs (0x00153); (0x00155,0x00155), `Abs (0x00155); (0x00157,0x00157), `Abs (0x00157); (0x00159,0x00159), `Abs (0x00159); (0x0015B,0x0015B), `Abs (0x0015B); (0x0015D,0x0015D), `Abs (0x0015D); (0x0015F,0x0015F), `Abs (0x0015F); (0x00161,0x00161), `Abs (0x00161); (0x00163,0x00163), `Abs (0x00163); (0x00165,0x00165), `Abs (0x00165); (0x00167,0x00167), `Abs (0x00167); (0x00169,0x00169), `Abs (0x00169); (0x0016B,0x0016B), `Abs (0x0016B); (0x0016D,0x0016D), `Abs (0x0016D); (0x0016F,0x0016F), `Abs (0x0016F); (0x00171,0x00171), `Abs (0x00171); (0x00173,0x00173), `Abs (0x00173); (0x00175,0x00175), `Abs (0x00175); (0x00177,0x00177), `Abs (0x00177); (0x0017A,0x0017A), `Abs (0x0017A); (0x0017C,0x0017C), `Abs (0x0017C); (0x0017E,0x00180), `Delta (0); (0x00183,0x00183), `Abs (0x00183); (0x00185,0x00185), `Abs (0x00185); (0x00188,0x00188), `Abs (0x00188); (0x0018C,0x0018D), `Delta (0); (0x00192,0x00192), `Abs (0x00192); (0x00195,0x00195), `Abs (0x00195); (0x00199,0x0019B), `Delta (0); (0x0019E,0x0019E), `Abs (0x0019E); (0x001A1,0x001A1), `Abs (0x001A1); (0x001A3,0x001A3), `Abs (0x001A3); (0x001A5,0x001A5), `Abs (0x001A5); (0x001A8,0x001A8), `Abs (0x001A8); (0x001AA,0x001AB), `Delta (0); (0x001AD,0x001AD), `Abs (0x001AD); (0x001B0,0x001B0), `Abs (0x001B0); (0x001B4,0x001B4), `Abs (0x001B4); (0x001B6,0x001B6), `Abs (0x001B6); (0x001B9,0x001BA), `Delta (0); (0x001BD,0x001BF), `Delta (0); (0x001C6,0x001C6), `Abs (0x001C6); (0x001C9,0x001C9), `Abs (0x001C9); (0x001CC,0x001CC), `Abs (0x001CC); (0x001CE,0x001CE), `Abs (0x001CE); (0x001D0,0x001D0), `Abs (0x001D0); (0x001D2,0x001D2), `Abs (0x001D2); (0x001D4,0x001D4), `Abs (0x001D4); (0x001D6,0x001D6), `Abs (0x001D6); (0x001D8,0x001D8), `Abs (0x001D8); (0x001DA,0x001DA), `Abs (0x001DA); (0x001DC,0x001DD), `Delta (0); (0x001DF,0x001DF), `Abs (0x001DF); (0x001E1,0x001E1), `Abs (0x001E1); (0x001E3,0x001E3), `Abs (0x001E3); (0x001E5,0x001E5), `Abs (0x001E5); (0x001E7,0x001E7), `Abs (0x001E7); (0x001E9,0x001E9), `Abs (0x001E9); (0x001EB,0x001EB), `Abs (0x001EB); (0x001ED,0x001ED), `Abs (0x001ED); (0x001EF,0x001F0), `Delta (0); (0x001F3,0x001F3), `Abs (0x001F3); (0x001F5,0x001F5), `Abs (0x001F5); (0x001F9,0x001F9), `Abs (0x001F9); (0x001FB,0x001FB), `Abs (0x001FB); (0x001FD,0x001FD), `Abs (0x001FD); (0x001FF,0x001FF), `Abs (0x001FF); (0x00201,0x00201), `Abs (0x00201); (0x00203,0x00203), `Abs (0x00203); (0x00205,0x00205), `Abs (0x00205); (0x00207,0x00207), `Abs (0x00207); (0x00209,0x00209), `Abs (0x00209); (0x0020B,0x0020B), `Abs (0x0020B); (0x0020D,0x0020D), `Abs (0x0020D); (0x0020F,0x0020F), `Abs (0x0020F); (0x00211,0x00211), `Abs (0x00211); (0x00213,0x00213), `Abs (0x00213); (0x00215,0x00215), `Abs (0x00215); (0x00217,0x00217), `Abs (0x00217); (0x00219,0x00219), `Abs (0x00219); (0x0021B,0x0021B), `Abs (0x0021B); (0x0021D,0x0021D), `Abs (0x0021D); (0x0021F,0x0021F), `Abs (0x0021F); (0x00221,0x00221), `Abs (0x00221); (0x00223,0x00223), `Abs (0x00223); (0x00225,0x00225), `Abs (0x00225); (0x00227,0x00227), `Abs (0x00227); (0x00229,0x00229), `Abs (0x00229); (0x0022B,0x0022B), `Abs (0x0022B); (0x0022D,0x0022D), `Abs (0x0022D); (0x0022F,0x0022F), `Abs (0x0022F); (0x00231,0x00231), `Abs (0x00231); (0x00233,0x00239), `Delta (0); (0x0023C,0x0023C), `Abs (0x0023C); (0x0023F,0x00240), `Delta (0); (0x00242,0x00242), `Abs (0x00242); (0x00247,0x00247), `Abs (0x00247); (0x00249,0x00249), `Abs (0x00249); (0x0024B,0x0024B), `Abs (0x0024B); (0x0024D,0x0024D), `Abs (0x0024D); (0x0024F,0x00293), `Delta (0); (0x00295,0x002AF), `Delta (0); (0x00371,0x00371), `Abs (0x00371); (0x00373,0x00373), `Abs (0x00373); (0x00377,0x00377), `Abs (0x00377); (0x0037B,0x0037D), `Delta (0); (0x00390,0x00390), `Abs (0x00390); (0x003AC,0x003CE), `Delta (0); (0x003D0,0x003D1), `Delta (0); (0x003D5,0x003D7), `Delta (0); (0x003D9,0x003D9), `Abs (0x003D9); (0x003DB,0x003DB), `Abs (0x003DB); (0x003DD,0x003DD), `Abs (0x003DD); (0x003DF,0x003DF), `Abs (0x003DF); (0x003E1,0x003E1), `Abs (0x003E1); (0x003E3,0x003E3), `Abs (0x003E3); (0x003E5,0x003E5), `Abs (0x003E5); (0x003E7,0x003E7), `Abs (0x003E7); (0x003E9,0x003E9), `Abs (0x003E9); (0x003EB,0x003EB), `Abs (0x003EB); (0x003ED,0x003ED), `Abs (0x003ED); (0x003EF,0x003F3), `Delta (0); (0x003F5,0x003F5), `Abs (0x003F5); (0x003F8,0x003F8), `Abs (0x003F8); (0x003FB,0x003FC), `Delta (0); (0x00430,0x0045F), `Delta (0); (0x00461,0x00461), `Abs (0x00461); (0x00463,0x00463), `Abs (0x00463); (0x00465,0x00465), `Abs (0x00465); (0x00467,0x00467), `Abs (0x00467); (0x00469,0x00469), `Abs (0x00469); (0x0046B,0x0046B), `Abs (0x0046B); (0x0046D,0x0046D), `Abs (0x0046D); (0x0046F,0x0046F), `Abs (0x0046F); (0x00471,0x00471), `Abs (0x00471); (0x00473,0x00473), `Abs (0x00473); (0x00475,0x00475), `Abs (0x00475); (0x00477,0x00477), `Abs (0x00477); (0x00479,0x00479), `Abs (0x00479); (0x0047B,0x0047B), `Abs (0x0047B); (0x0047D,0x0047D), `Abs (0x0047D); (0x0047F,0x0047F), `Abs (0x0047F); (0x00481,0x00481), `Abs (0x00481); (0x0048B,0x0048B), `Abs (0x0048B); (0x0048D,0x0048D), `Abs (0x0048D); (0x0048F,0x0048F), `Abs (0x0048F); (0x00491,0x00491), `Abs (0x00491); (0x00493,0x00493), `Abs (0x00493); (0x00495,0x00495), `Abs (0x00495); (0x00497,0x00497), `Abs (0x00497); (0x00499,0x00499), `Abs (0x00499); (0x0049B,0x0049B), `Abs (0x0049B); (0x0049D,0x0049D), `Abs (0x0049D); (0x0049F,0x0049F), `Abs (0x0049F); (0x004A1,0x004A1), `Abs (0x004A1); (0x004A3,0x004A3), `Abs (0x004A3); (0x004A5,0x004A5), `Abs (0x004A5); (0x004A7,0x004A7), `Abs (0x004A7); (0x004A9,0x004A9), `Abs (0x004A9); (0x004AB,0x004AB), `Abs (0x004AB); (0x004AD,0x004AD), `Abs (0x004AD); (0x004AF,0x004AF), `Abs (0x004AF); (0x004B1,0x004B1), `Abs (0x004B1); (0x004B3,0x004B3), `Abs (0x004B3); (0x004B5,0x004B5), `Abs (0x004B5); (0x004B7,0x004B7), `Abs (0x004B7); (0x004B9,0x004B9), `Abs (0x004B9); (0x004BB,0x004BB), `Abs (0x004BB); (0x004BD,0x004BD), `Abs (0x004BD); (0x004BF,0x004BF), `Abs (0x004BF); (0x004C2,0x004C2), `Abs (0x004C2); (0x004C4,0x004C4), `Abs (0x004C4); (0x004C6,0x004C6), `Abs (0x004C6); (0x004C8,0x004C8), `Abs (0x004C8); (0x004CA,0x004CA), `Abs (0x004CA); (0x004CC,0x004CC), `Abs (0x004CC); (0x004CE,0x004CF), `Delta (0); (0x004D1,0x004D1), `Abs (0x004D1); (0x004D3,0x004D3), `Abs (0x004D3); (0x004D5,0x004D5), `Abs (0x004D5); (0x004D7,0x004D7), `Abs (0x004D7); (0x004D9,0x004D9), `Abs (0x004D9); (0x004DB,0x004DB), `Abs (0x004DB); (0x004DD,0x004DD), `Abs (0x004DD); (0x004DF,0x004DF), `Abs (0x004DF); (0x004E1,0x004E1), `Abs (0x004E1); (0x004E3,0x004E3), `Abs (0x004E3); (0x004E5,0x004E5), `Abs (0x004E5); (0x004E7,0x004E7), `Abs (0x004E7); (0x004E9,0x004E9), `Abs (0x004E9); (0x004EB,0x004EB), `Abs (0x004EB); (0x004ED,0x004ED), `Abs (0x004ED); (0x004EF,0x004EF), `Abs (0x004EF); (0x004F1,0x004F1), `Abs (0x004F1); (0x004F3,0x004F3), `Abs (0x004F3); (0x004F5,0x004F5), `Abs (0x004F5); (0x004F7,0x004F7), `Abs (0x004F7); (0x004F9,0x004F9), `Abs (0x004F9); (0x004FB,0x004FB), `Abs (0x004FB); (0x004FD,0x004FD), `Abs (0x004FD); (0x004FF,0x004FF), `Abs (0x004FF); (0x00501,0x00501), `Abs (0x00501); (0x00503,0x00503), `Abs (0x00503); (0x00505,0x00505), `Abs (0x00505); (0x00507,0x00507), `Abs (0x00507); (0x00509,0x00509), `Abs (0x00509); (0x0050B,0x0050B), `Abs (0x0050B); (0x0050D,0x0050D), `Abs (0x0050D); (0x0050F,0x0050F), `Abs (0x0050F); (0x00511,0x00511), `Abs (0x00511); (0x00513,0x00513), `Abs (0x00513); (0x00515,0x00515), `Abs (0x00515); (0x00517,0x00517), `Abs (0x00517); (0x00519,0x00519), `Abs (0x00519); (0x0051B,0x0051B), `Abs (0x0051B); (0x0051D,0x0051D), `Abs (0x0051D); (0x0051F,0x0051F), `Abs (0x0051F); (0x00521,0x00521), `Abs (0x00521); (0x00523,0x00523), `Abs (0x00523); (0x00525,0x00525), `Abs (0x00525); (0x00527,0x00527), `Abs (0x00527); (0x00529,0x00529), `Abs (0x00529); (0x0052B,0x0052B), `Abs (0x0052B); (0x0052D,0x0052D), `Abs (0x0052D); (0x0052F,0x0052F), `Abs (0x0052F); (0x00561,0x00587), `Delta (0); (0x013F8,0x013FD), `Delta (0); (0x01C80,0x01C88), `Delta (0); (0x01D00,0x01D2B), `Delta (0); (0x01D6B,0x01D77), `Delta (0); (0x01D79,0x01D9A), `Delta (0); (0x01E01,0x01E01), `Abs (0x01E01); (0x01E03,0x01E03), `Abs (0x01E03); (0x01E05,0x01E05), `Abs (0x01E05); (0x01E07,0x01E07), `Abs (0x01E07); (0x01E09,0x01E09), `Abs (0x01E09); (0x01E0B,0x01E0B), `Abs (0x01E0B); (0x01E0D,0x01E0D), `Abs (0x01E0D); (0x01E0F,0x01E0F), `Abs (0x01E0F); (0x01E11,0x01E11), `Abs (0x01E11); (0x01E13,0x01E13), `Abs (0x01E13); (0x01E15,0x01E15), `Abs (0x01E15); (0x01E17,0x01E17), `Abs (0x01E17); (0x01E19,0x01E19), `Abs (0x01E19); (0x01E1B,0x01E1B), `Abs (0x01E1B); (0x01E1D,0x01E1D), `Abs (0x01E1D); (0x01E1F,0x01E1F), `Abs (0x01E1F); (0x01E21,0x01E21), `Abs (0x01E21); (0x01E23,0x01E23), `Abs (0x01E23); (0x01E25,0x01E25), `Abs (0x01E25); (0x01E27,0x01E27), `Abs (0x01E27); (0x01E29,0x01E29), `Abs (0x01E29); (0x01E2B,0x01E2B), `Abs (0x01E2B); (0x01E2D,0x01E2D), `Abs (0x01E2D); (0x01E2F,0x01E2F), `Abs (0x01E2F); (0x01E31,0x01E31), `Abs (0x01E31); (0x01E33,0x01E33), `Abs (0x01E33); (0x01E35,0x01E35), `Abs (0x01E35); (0x01E37,0x01E37), `Abs (0x01E37); (0x01E39,0x01E39), `Abs (0x01E39); (0x01E3B,0x01E3B), `Abs (0x01E3B); (0x01E3D,0x01E3D), `Abs (0x01E3D); (0x01E3F,0x01E3F), `Abs (0x01E3F); (0x01E41,0x01E41), `Abs (0x01E41); (0x01E43,0x01E43), `Abs (0x01E43); (0x01E45,0x01E45), `Abs (0x01E45); (0x01E47,0x01E47), `Abs (0x01E47); (0x01E49,0x01E49), `Abs (0x01E49); (0x01E4B,0x01E4B), `Abs (0x01E4B); (0x01E4D,0x01E4D), `Abs (0x01E4D); (0x01E4F,0x01E4F), `Abs (0x01E4F); (0x01E51,0x01E51), `Abs (0x01E51); (0x01E53,0x01E53), `Abs (0x01E53); (0x01E55,0x01E55), `Abs (0x01E55); (0x01E57,0x01E57), `Abs (0x01E57); (0x01E59,0x01E59), `Abs (0x01E59); (0x01E5B,0x01E5B), `Abs (0x01E5B); (0x01E5D,0x01E5D), `Abs (0x01E5D); (0x01E5F,0x01E5F), `Abs (0x01E5F); (0x01E61,0x01E61), `Abs (0x01E61); (0x01E63,0x01E63), `Abs (0x01E63); (0x01E65,0x01E65), `Abs (0x01E65); (0x01E67,0x01E67), `Abs (0x01E67); (0x01E69,0x01E69), `Abs (0x01E69); (0x01E6B,0x01E6B), `Abs (0x01E6B); (0x01E6D,0x01E6D), `Abs (0x01E6D); (0x01E6F,0x01E6F), `Abs (0x01E6F); (0x01E71,0x01E71), `Abs (0x01E71); (0x01E73,0x01E73), `Abs (0x01E73); (0x01E75,0x01E75), `Abs (0x01E75); (0x01E77,0x01E77), `Abs (0x01E77); (0x01E79,0x01E79), `Abs (0x01E79); (0x01E7B,0x01E7B), `Abs (0x01E7B); (0x01E7D,0x01E7D), `Abs (0x01E7D); (0x01E7F,0x01E7F), `Abs (0x01E7F); (0x01E81,0x01E81), `Abs (0x01E81); (0x01E83,0x01E83), `Abs (0x01E83); (0x01E85,0x01E85), `Abs (0x01E85); (0x01E87,0x01E87), `Abs (0x01E87); (0x01E89,0x01E89), `Abs (0x01E89); (0x01E8B,0x01E8B), `Abs (0x01E8B); (0x01E8D,0x01E8D), `Abs (0x01E8D); (0x01E8F,0x01E8F), `Abs (0x01E8F); (0x01E91,0x01E91), `Abs (0x01E91); (0x01E93,0x01E93), `Abs (0x01E93); (0x01E95,0x01E9D), `Delta (0); (0x01E9F,0x01E9F), `Abs (0x01E9F); (0x01EA1,0x01EA1), `Abs (0x01EA1); (0x01EA3,0x01EA3), `Abs (0x01EA3); (0x01EA5,0x01EA5), `Abs (0x01EA5); (0x01EA7,0x01EA7), `Abs (0x01EA7); (0x01EA9,0x01EA9), `Abs (0x01EA9); (0x01EAB,0x01EAB), `Abs (0x01EAB); (0x01EAD,0x01EAD), `Abs (0x01EAD); (0x01EAF,0x01EAF), `Abs (0x01EAF); (0x01EB1,0x01EB1), `Abs (0x01EB1); (0x01EB3,0x01EB3), `Abs (0x01EB3); (0x01EB5,0x01EB5), `Abs (0x01EB5); (0x01EB7,0x01EB7), `Abs (0x01EB7); (0x01EB9,0x01EB9), `Abs (0x01EB9); (0x01EBB,0x01EBB), `Abs (0x01EBB); (0x01EBD,0x01EBD), `Abs (0x01EBD); (0x01EBF,0x01EBF), `Abs (0x01EBF); (0x01EC1,0x01EC1), `Abs (0x01EC1); (0x01EC3,0x01EC3), `Abs (0x01EC3); (0x01EC5,0x01EC5), `Abs (0x01EC5); (0x01EC7,0x01EC7), `Abs (0x01EC7); (0x01EC9,0x01EC9), `Abs (0x01EC9); (0x01ECB,0x01ECB), `Abs (0x01ECB); (0x01ECD,0x01ECD), `Abs (0x01ECD); (0x01ECF,0x01ECF), `Abs (0x01ECF); (0x01ED1,0x01ED1), `Abs (0x01ED1); (0x01ED3,0x01ED3), `Abs (0x01ED3); (0x01ED5,0x01ED5), `Abs (0x01ED5); (0x01ED7,0x01ED7), `Abs (0x01ED7); (0x01ED9,0x01ED9), `Abs (0x01ED9); (0x01EDB,0x01EDB), `Abs (0x01EDB); (0x01EDD,0x01EDD), `Abs (0x01EDD); (0x01EDF,0x01EDF), `Abs (0x01EDF); (0x01EE1,0x01EE1), `Abs (0x01EE1); (0x01EE3,0x01EE3), `Abs (0x01EE3); (0x01EE5,0x01EE5), `Abs (0x01EE5); (0x01EE7,0x01EE7), `Abs (0x01EE7); (0x01EE9,0x01EE9), `Abs (0x01EE9); (0x01EEB,0x01EEB), `Abs (0x01EEB); (0x01EED,0x01EED), `Abs (0x01EED); (0x01EEF,0x01EEF), `Abs (0x01EEF); (0x01EF1,0x01EF1), `Abs (0x01EF1); (0x01EF3,0x01EF3), `Abs (0x01EF3); (0x01EF5,0x01EF5), `Abs (0x01EF5); (0x01EF7,0x01EF7), `Abs (0x01EF7); (0x01EF9,0x01EF9), `Abs (0x01EF9); (0x01EFB,0x01EFB), `Abs (0x01EFB); (0x01EFD,0x01EFD), `Abs (0x01EFD); (0x01EFF,0x01F07), `Delta (0); (0x01F10,0x01F15), `Delta (0); (0x01F20,0x01F27), `Delta (0); (0x01F30,0x01F37), `Delta (0); (0x01F40,0x01F45), `Delta (0); (0x01F50,0x01F57), `Delta (0); (0x01F60,0x01F67), `Delta (0); (0x01F70,0x01F7D), `Delta (0); (0x01F80,0x01F87), `Delta (0); (0x01F90,0x01F97), `Delta (0); (0x01FA0,0x01FA7), `Delta (0); (0x01FB0,0x01FB4), `Delta (0); (0x01FB6,0x01FB7), `Delta (0); (0x01FBE,0x01FBE), `Abs (0x01FBE); (0x01FC2,0x01FC4), `Delta (0); (0x01FC6,0x01FC7), `Delta (0); (0x01FD0,0x01FD3), `Delta (0); (0x01FD6,0x01FD7), `Delta (0); (0x01FE0,0x01FE7), `Delta (0); (0x01FF2,0x01FF4), `Delta (0); (0x01FF6,0x01FF7), `Delta (0); (0x0210A,0x0210A), `Abs (0x0210A); (0x0210E,0x0210F), `Delta (0); (0x02113,0x02113), `Abs (0x02113); (0x0212F,0x0212F), `Abs (0x0212F); (0x02134,0x02134), `Abs (0x02134); (0x02139,0x02139), `Abs (0x02139); (0x0213C,0x0213D), `Delta (0); (0x02146,0x02149), `Delta (0); (0x0214E,0x0214E), `Abs (0x0214E); (0x02184,0x02184), `Abs (0x02184); (0x02C30,0x02C5E), `Delta (0); (0x02C61,0x02C61), `Abs (0x02C61); (0x02C65,0x02C66), `Delta (0); (0x02C68,0x02C68), `Abs (0x02C68); (0x02C6A,0x02C6A), `Abs (0x02C6A); (0x02C6C,0x02C6C), `Abs (0x02C6C); (0x02C71,0x02C71), `Abs (0x02C71); (0x02C73,0x02C74), `Delta (0); (0x02C76,0x02C7B), `Delta (0); (0x02C81,0x02C81), `Abs (0x02C81); (0x02C83,0x02C83), `Abs (0x02C83); (0x02C85,0x02C85), `Abs (0x02C85); (0x02C87,0x02C87), `Abs (0x02C87); (0x02C89,0x02C89), `Abs (0x02C89); (0x02C8B,0x02C8B), `Abs (0x02C8B); (0x02C8D,0x02C8D), `Abs (0x02C8D); (0x02C8F,0x02C8F), `Abs (0x02C8F); (0x02C91,0x02C91), `Abs (0x02C91); (0x02C93,0x02C93), `Abs (0x02C93); (0x02C95,0x02C95), `Abs (0x02C95); (0x02C97,0x02C97), `Abs (0x02C97); (0x02C99,0x02C99), `Abs (0x02C99); (0x02C9B,0x02C9B), `Abs (0x02C9B); (0x02C9D,0x02C9D), `Abs (0x02C9D); (0x02C9F,0x02C9F), `Abs (0x02C9F); (0x02CA1,0x02CA1), `Abs (0x02CA1); (0x02CA3,0x02CA3), `Abs (0x02CA3); (0x02CA5,0x02CA5), `Abs (0x02CA5); (0x02CA7,0x02CA7), `Abs (0x02CA7); (0x02CA9,0x02CA9), `Abs (0x02CA9); (0x02CAB,0x02CAB), `Abs (0x02CAB); (0x02CAD,0x02CAD), `Abs (0x02CAD); (0x02CAF,0x02CAF), `Abs (0x02CAF); (0x02CB1,0x02CB1), `Abs (0x02CB1); (0x02CB3,0x02CB3), `Abs (0x02CB3); (0x02CB5,0x02CB5), `Abs (0x02CB5); (0x02CB7,0x02CB7), `Abs (0x02CB7); (0x02CB9,0x02CB9), `Abs (0x02CB9); (0x02CBB,0x02CBB), `Abs (0x02CBB); (0x02CBD,0x02CBD), `Abs (0x02CBD); (0x02CBF,0x02CBF), `Abs (0x02CBF); (0x02CC1,0x02CC1), `Abs (0x02CC1); (0x02CC3,0x02CC3), `Abs (0x02CC3); (0x02CC5,0x02CC5), `Abs (0x02CC5); (0x02CC7,0x02CC7), `Abs (0x02CC7); (0x02CC9,0x02CC9), `Abs (0x02CC9); (0x02CCB,0x02CCB), `Abs (0x02CCB); (0x02CCD,0x02CCD), `Abs (0x02CCD); (0x02CCF,0x02CCF), `Abs (0x02CCF); (0x02CD1,0x02CD1), `Abs (0x02CD1); (0x02CD3,0x02CD3), `Abs (0x02CD3); (0x02CD5,0x02CD5), `Abs (0x02CD5); (0x02CD7,0x02CD7), `Abs (0x02CD7); (0x02CD9,0x02CD9), `Abs (0x02CD9); (0x02CDB,0x02CDB), `Abs (0x02CDB); (0x02CDD,0x02CDD), `Abs (0x02CDD); (0x02CDF,0x02CDF), `Abs (0x02CDF); (0x02CE1,0x02CE1), `Abs (0x02CE1); (0x02CE3,0x02CE4), `Delta (0); (0x02CEC,0x02CEC), `Abs (0x02CEC); (0x02CEE,0x02CEE), `Abs (0x02CEE); (0x02CF3,0x02CF3), `Abs (0x02CF3); (0x02D00,0x02D25), `Delta (0); (0x02D27,0x02D27), `Abs (0x02D27); (0x02D2D,0x02D2D), `Abs (0x02D2D); (0x0A641,0x0A641), `Abs (0x0A641); (0x0A643,0x0A643), `Abs (0x0A643); (0x0A645,0x0A645), `Abs (0x0A645); (0x0A647,0x0A647), `Abs (0x0A647); (0x0A649,0x0A649), `Abs (0x0A649); (0x0A64B,0x0A64B), `Abs (0x0A64B); (0x0A64D,0x0A64D), `Abs (0x0A64D); (0x0A64F,0x0A64F), `Abs (0x0A64F); (0x0A651,0x0A651), `Abs (0x0A651); (0x0A653,0x0A653), `Abs (0x0A653); (0x0A655,0x0A655), `Abs (0x0A655); (0x0A657,0x0A657), `Abs (0x0A657); (0x0A659,0x0A659), `Abs (0x0A659); (0x0A65B,0x0A65B), `Abs (0x0A65B); (0x0A65D,0x0A65D), `Abs (0x0A65D); (0x0A65F,0x0A65F), `Abs (0x0A65F); (0x0A661,0x0A661), `Abs (0x0A661); (0x0A663,0x0A663), `Abs (0x0A663); (0x0A665,0x0A665), `Abs (0x0A665); (0x0A667,0x0A667), `Abs (0x0A667); (0x0A669,0x0A669), `Abs (0x0A669); (0x0A66B,0x0A66B), `Abs (0x0A66B); (0x0A66D,0x0A66D), `Abs (0x0A66D); (0x0A681,0x0A681), `Abs (0x0A681); (0x0A683,0x0A683), `Abs (0x0A683); (0x0A685,0x0A685), `Abs (0x0A685); (0x0A687,0x0A687), `Abs (0x0A687); (0x0A689,0x0A689), `Abs (0x0A689); (0x0A68B,0x0A68B), `Abs (0x0A68B); (0x0A68D,0x0A68D), `Abs (0x0A68D); (0x0A68F,0x0A68F), `Abs (0x0A68F); (0x0A691,0x0A691), `Abs (0x0A691); (0x0A693,0x0A693), `Abs (0x0A693); (0x0A695,0x0A695), `Abs (0x0A695); (0x0A697,0x0A697), `Abs (0x0A697); (0x0A699,0x0A699), `Abs (0x0A699); (0x0A69B,0x0A69B), `Abs (0x0A69B); (0x0A723,0x0A723), `Abs (0x0A723); (0x0A725,0x0A725), `Abs (0x0A725); (0x0A727,0x0A727), `Abs (0x0A727); (0x0A729,0x0A729), `Abs (0x0A729); (0x0A72B,0x0A72B), `Abs (0x0A72B); (0x0A72D,0x0A72D), `Abs (0x0A72D); (0x0A72F,0x0A731), `Delta (0); (0x0A733,0x0A733), `Abs (0x0A733); (0x0A735,0x0A735), `Abs (0x0A735); (0x0A737,0x0A737), `Abs (0x0A737); (0x0A739,0x0A739), `Abs (0x0A739); (0x0A73B,0x0A73B), `Abs (0x0A73B); (0x0A73D,0x0A73D), `Abs (0x0A73D); (0x0A73F,0x0A73F), `Abs (0x0A73F); (0x0A741,0x0A741), `Abs (0x0A741); (0x0A743,0x0A743), `Abs (0x0A743); (0x0A745,0x0A745), `Abs (0x0A745); (0x0A747,0x0A747), `Abs (0x0A747); (0x0A749,0x0A749), `Abs (0x0A749); (0x0A74B,0x0A74B), `Abs (0x0A74B); (0x0A74D,0x0A74D), `Abs (0x0A74D); (0x0A74F,0x0A74F), `Abs (0x0A74F); (0x0A751,0x0A751), `Abs (0x0A751); (0x0A753,0x0A753), `Abs (0x0A753); (0x0A755,0x0A755), `Abs (0x0A755); (0x0A757,0x0A757), `Abs (0x0A757); (0x0A759,0x0A759), `Abs (0x0A759); (0x0A75B,0x0A75B), `Abs (0x0A75B); (0x0A75D,0x0A75D), `Abs (0x0A75D); (0x0A75F,0x0A75F), `Abs (0x0A75F); (0x0A761,0x0A761), `Abs (0x0A761); (0x0A763,0x0A763), `Abs (0x0A763); (0x0A765,0x0A765), `Abs (0x0A765); (0x0A767,0x0A767), `Abs (0x0A767); (0x0A769,0x0A769), `Abs (0x0A769); (0x0A76B,0x0A76B), `Abs (0x0A76B); (0x0A76D,0x0A76D), `Abs (0x0A76D); (0x0A76F,0x0A76F), `Abs (0x0A76F); (0x0A771,0x0A778), `Delta (0); (0x0A77A,0x0A77A), `Abs (0x0A77A); (0x0A77C,0x0A77C), `Abs (0x0A77C); (0x0A77F,0x0A77F), `Abs (0x0A77F); (0x0A781,0x0A781), `Abs (0x0A781); (0x0A783,0x0A783), `Abs (0x0A783); (0x0A785,0x0A785), `Abs (0x0A785); (0x0A787,0x0A787), `Abs (0x0A787); (0x0A78C,0x0A78C), `Abs (0x0A78C); (0x0A78E,0x0A78E), `Abs (0x0A78E); (0x0A791,0x0A791), `Abs (0x0A791); (0x0A793,0x0A795), `Delta (0); (0x0A797,0x0A797), `Abs (0x0A797); (0x0A799,0x0A799), `Abs (0x0A799); (0x0A79B,0x0A79B), `Abs (0x0A79B); (0x0A79D,0x0A79D), `Abs (0x0A79D); (0x0A79F,0x0A79F), `Abs (0x0A79F); (0x0A7A1,0x0A7A1), `Abs (0x0A7A1); (0x0A7A3,0x0A7A3), `Abs (0x0A7A3); (0x0A7A5,0x0A7A5), `Abs (0x0A7A5); (0x0A7A7,0x0A7A7), `Abs (0x0A7A7); (0x0A7A9,0x0A7A9), `Abs (0x0A7A9); (0x0A7B5,0x0A7B5), `Abs (0x0A7B5); (0x0A7B7,0x0A7B7), `Abs (0x0A7B7); (0x0A7FA,0x0A7FA), `Abs (0x0A7FA); (0x0AB30,0x0AB5A), `Delta (0); (0x0AB60,0x0AB65), `Delta (0); (0x0AB70,0x0ABBF), `Delta (0); (0x0FB00,0x0FB06), `Delta (0); (0x0FB13,0x0FB17), `Delta (0); (0x0FF41,0x0FF5A), `Delta (0); (0x10428,0x1044F), `Delta (0); (0x104D8,0x104FB), `Delta (0); (0x10CC0,0x10CF2), `Delta (0); (0x118C0,0x118DF), `Delta (0); (0x1D41A,0x1D433), `Delta (0); (0x1D44E,0x1D454), `Delta (0); (0x1D456,0x1D467), `Delta (0); (0x1D482,0x1D49B), `Delta (0); (0x1D4B6,0x1D4B9), `Delta (0); (0x1D4BB,0x1D4BB), `Abs (0x1D4BB); (0x1D4BD,0x1D4C3), `Delta (0); (0x1D4C5,0x1D4CF), `Delta (0); (0x1D4EA,0x1D503), `Delta (0); (0x1D51E,0x1D537), `Delta (0); (0x1D552,0x1D56B), `Delta (0); (0x1D586,0x1D59F), `Delta (0); (0x1D5BA,0x1D5D3), `Delta (0); (0x1D5EE,0x1D607), `Delta (0); (0x1D622,0x1D63B), `Delta (0); (0x1D656,0x1D66F), `Delta (0); (0x1D68A,0x1D6A5), `Delta (0); (0x1D6C2,0x1D6DA), `Delta (0); (0x1D6DC,0x1D6E1), `Delta (0); (0x1D6FC,0x1D714), `Delta (0); (0x1D716,0x1D71B), `Delta (0); (0x1D736,0x1D74E), `Delta (0); (0x1D750,0x1D755), `Delta (0); (0x1D770,0x1D788), `Delta (0); (0x1D78A,0x1D78F), `Delta (0); (0x1D7AA,0x1D7C2), `Delta (0); (0x1D7C4,0x1D7C9), `Delta (0); (0x1D7CB,0x1D7CB), `Abs (0x1D7CB); (0x1E922,0x1E943), `Delta (0); (0x001C5,0x001C5), `Abs (0x001C6); (0x001C8,0x001C8), `Abs (0x001C9); (0x001CB,0x001CB), `Abs (0x001CC); (0x001F2,0x001F2), `Abs (0x001F3); (0x01F88,0x01F8F), `Delta (-8); (0x01F98,0x01F9F), `Delta (-8); (0x01FA8,0x01FAF), `Delta (-8); (0x01FBC,0x01FBC), `Abs (0x01FB3); (0x01FCC,0x01FCC), `Abs (0x01FC3); (0x01FFC,0x01FFC), `Abs (0x01FF3); (0x00300,0x0036F), `Delta (0); (0x00483,0x00487), `Delta (0); (0x00591,0x005BD), `Delta (0); (0x005BF,0x005BF), `Abs (0x005BF); (0x005C1,0x005C2), `Delta (0); (0x005C4,0x005C5), `Delta (0); (0x005C7,0x005C7), `Abs (0x005C7); (0x00610,0x0061A), `Delta (0); (0x0064B,0x0065F), `Delta (0); (0x00670,0x00670), `Abs (0x00670); (0x006D6,0x006DC), `Delta (0); (0x006DF,0x006E4), `Delta (0); (0x006E7,0x006E8), `Delta (0); (0x006EA,0x006ED), `Delta (0); (0x00711,0x00711), `Abs (0x00711); (0x00730,0x0074A), `Delta (0); (0x007A6,0x007B0), `Delta (0); (0x007EB,0x007F3), `Delta (0); (0x00816,0x00819), `Delta (0); (0x0081B,0x00823), `Delta (0); (0x00825,0x00827), `Delta (0); (0x00829,0x0082D), `Delta (0); (0x00859,0x0085B), `Delta (0); (0x008D4,0x008E1), `Delta (0); (0x008E3,0x00902), `Delta (0); (0x0093A,0x0093A), `Abs (0x0093A); (0x0093C,0x0093C), `Abs (0x0093C); (0x00941,0x00948), `Delta (0); (0x0094D,0x0094D), `Abs (0x0094D); (0x00951,0x00957), `Delta (0); (0x00962,0x00963), `Delta (0); (0x00981,0x00981), `Abs (0x00981); (0x009BC,0x009BC), `Abs (0x009BC); (0x009C1,0x009C4), `Delta (0); (0x009CD,0x009CD), `Abs (0x009CD); (0x009E2,0x009E3), `Delta (0); (0x00A01,0x00A02), `Delta (0); (0x00A3C,0x00A3C), `Abs (0x00A3C); (0x00A41,0x00A42), `Delta (0); (0x00A47,0x00A48), `Delta (0); (0x00A4B,0x00A4D), `Delta (0); (0x00A51,0x00A51), `Abs (0x00A51); (0x00A70,0x00A71), `Delta (0); (0x00A75,0x00A75), `Abs (0x00A75); (0x00A81,0x00A82), `Delta (0); (0x00ABC,0x00ABC), `Abs (0x00ABC); (0x00AC1,0x00AC5), `Delta (0); (0x00AC7,0x00AC8), `Delta (0); (0x00ACD,0x00ACD), `Abs (0x00ACD); (0x00AE2,0x00AE3), `Delta (0); (0x00B01,0x00B01), `Abs (0x00B01); (0x00B3C,0x00B3C), `Abs (0x00B3C); (0x00B3F,0x00B3F), `Abs (0x00B3F); (0x00B41,0x00B44), `Delta (0); (0x00B4D,0x00B4D), `Abs (0x00B4D); (0x00B56,0x00B56), `Abs (0x00B56); (0x00B62,0x00B63), `Delta (0); (0x00B82,0x00B82), `Abs (0x00B82); (0x00BC0,0x00BC0), `Abs (0x00BC0); (0x00BCD,0x00BCD), `Abs (0x00BCD); (0x00C00,0x00C00), `Abs (0x00C00); (0x00C3E,0x00C40), `Delta (0); (0x00C46,0x00C48), `Delta (0); (0x00C4A,0x00C4D), `Delta (0); (0x00C55,0x00C56), `Delta (0); (0x00C62,0x00C63), `Delta (0); (0x00C81,0x00C81), `Abs (0x00C81); (0x00CBC,0x00CBC), `Abs (0x00CBC); (0x00CBF,0x00CBF), `Abs (0x00CBF); (0x00CC6,0x00CC6), `Abs (0x00CC6); (0x00CCC,0x00CCD), `Delta (0); (0x00CE2,0x00CE3), `Delta (0); (0x00D01,0x00D01), `Abs (0x00D01); (0x00D41,0x00D44), `Delta (0); (0x00D4D,0x00D4D), `Abs (0x00D4D); (0x00D62,0x00D63), `Delta (0); (0x00DCA,0x00DCA), `Abs (0x00DCA); (0x00DD2,0x00DD4), `Delta (0); (0x00DD6,0x00DD6), `Abs (0x00DD6); (0x00E31,0x00E31), `Abs (0x00E31); (0x00E34,0x00E3A), `Delta (0); (0x00E47,0x00E4E), `Delta (0); (0x00EB1,0x00EB1), `Abs (0x00EB1); (0x00EB4,0x00EB9), `Delta (0); (0x00EBB,0x00EBC), `Delta (0); (0x00EC8,0x00ECD), `Delta (0); (0x00F18,0x00F19), `Delta (0); (0x00F35,0x00F35), `Abs (0x00F35); (0x00F37,0x00F37), `Abs (0x00F37); (0x00F39,0x00F39), `Abs (0x00F39); (0x00F71,0x00F7E), `Delta (0); (0x00F80,0x00F84), `Delta (0); (0x00F86,0x00F87), `Delta (0); (0x00F8D,0x00F97), `Delta (0); (0x00F99,0x00FBC), `Delta (0); (0x00FC6,0x00FC6), `Abs (0x00FC6); (0x0102D,0x01030), `Delta (0); (0x01032,0x01037), `Delta (0); (0x01039,0x0103A), `Delta (0); (0x0103D,0x0103E), `Delta (0); (0x01058,0x01059), `Delta (0); (0x0105E,0x01060), `Delta (0); (0x01071,0x01074), `Delta (0); (0x01082,0x01082), `Abs (0x01082); (0x01085,0x01086), `Delta (0); (0x0108D,0x0108D), `Abs (0x0108D); (0x0109D,0x0109D), `Abs (0x0109D); (0x0135D,0x0135F), `Delta (0); (0x01712,0x01714), `Delta (0); (0x01732,0x01734), `Delta (0); (0x01752,0x01753), `Delta (0); (0x01772,0x01773), `Delta (0); (0x017B4,0x017B5), `Delta (0); (0x017B7,0x017BD), `Delta (0); (0x017C6,0x017C6), `Abs (0x017C6); (0x017C9,0x017D3), `Delta (0); (0x017DD,0x017DD), `Abs (0x017DD); (0x0180B,0x0180D), `Delta (0); (0x01885,0x01886), `Delta (0); (0x018A9,0x018A9), `Abs (0x018A9); (0x01920,0x01922), `Delta (0); (0x01927,0x01928), `Delta (0); (0x01932,0x01932), `Abs (0x01932); (0x01939,0x0193B), `Delta (0); (0x01A17,0x01A18), `Delta (0); (0x01A1B,0x01A1B), `Abs (0x01A1B); (0x01A56,0x01A56), `Abs (0x01A56); (0x01A58,0x01A5E), `Delta (0); (0x01A60,0x01A60), `Abs (0x01A60); (0x01A62,0x01A62), `Abs (0x01A62); (0x01A65,0x01A6C), `Delta (0); (0x01A73,0x01A7C), `Delta (0); (0x01A7F,0x01A7F), `Abs (0x01A7F); (0x01AB0,0x01ABD), `Delta (0); (0x01B00,0x01B03), `Delta (0); (0x01B34,0x01B34), `Abs (0x01B34); (0x01B36,0x01B3A), `Delta (0); (0x01B3C,0x01B3C), `Abs (0x01B3C); (0x01B42,0x01B42), `Abs (0x01B42); (0x01B6B,0x01B73), `Delta (0); (0x01B80,0x01B81), `Delta (0); (0x01BA2,0x01BA5), `Delta (0); (0x01BA8,0x01BA9), `Delta (0); (0x01BAB,0x01BAD), `Delta (0); (0x01BE6,0x01BE6), `Abs (0x01BE6); (0x01BE8,0x01BE9), `Delta (0); (0x01BED,0x01BED), `Abs (0x01BED); (0x01BEF,0x01BF1), `Delta (0); (0x01C2C,0x01C33), `Delta (0); (0x01C36,0x01C37), `Delta (0); (0x01CD0,0x01CD2), `Delta (0); (0x01CD4,0x01CE0), `Delta (0); (0x01CE2,0x01CE8), `Delta (0); (0x01CED,0x01CED), `Abs (0x01CED); (0x01CF4,0x01CF4), `Abs (0x01CF4); (0x01CF8,0x01CF9), `Delta (0); (0x01DC0,0x01DF5), `Delta (0); (0x01DFB,0x01DFF), `Delta (0); (0x020D0,0x020DC), `Delta (0); (0x020E1,0x020E1), `Abs (0x020E1); (0x020E5,0x020F0), `Delta (0); (0x02CEF,0x02CF1), `Delta (0); (0x02D7F,0x02D7F), `Abs (0x02D7F); (0x02DE0,0x02DFF), `Delta (0); (0x0302A,0x0302D), `Delta (0); (0x03099,0x0309A), `Delta (0); (0x0A66F,0x0A66F), `Abs (0x0A66F); (0x0A674,0x0A67D), `Delta (0); (0x0A69E,0x0A69F), `Delta (0); (0x0A6F0,0x0A6F1), `Delta (0); (0x0A802,0x0A802), `Abs (0x0A802); (0x0A806,0x0A806), `Abs (0x0A806); (0x0A80B,0x0A80B), `Abs (0x0A80B); (0x0A825,0x0A826), `Delta (0); (0x0A8C4,0x0A8C5), `Delta (0); (0x0A8E0,0x0A8F1), `Delta (0); (0x0A926,0x0A92D), `Delta (0); (0x0A947,0x0A951), `Delta (0); (0x0A980,0x0A982), `Delta (0); (0x0A9B3,0x0A9B3), `Abs (0x0A9B3); (0x0A9B6,0x0A9B9), `Delta (0); (0x0A9BC,0x0A9BC), `Abs (0x0A9BC); (0x0A9E5,0x0A9E5), `Abs (0x0A9E5); (0x0AA29,0x0AA2E), `Delta (0); (0x0AA31,0x0AA32), `Delta (0); (0x0AA35,0x0AA36), `Delta (0); (0x0AA43,0x0AA43), `Abs (0x0AA43); (0x0AA4C,0x0AA4C), `Abs (0x0AA4C); (0x0AA7C,0x0AA7C), `Abs (0x0AA7C); (0x0AAB0,0x0AAB0), `Abs (0x0AAB0); (0x0AAB2,0x0AAB4), `Delta (0); (0x0AAB7,0x0AAB8), `Delta (0); (0x0AABE,0x0AABF), `Delta (0); (0x0AAC1,0x0AAC1), `Abs (0x0AAC1); (0x0AAEC,0x0AAED), `Delta (0); (0x0AAF6,0x0AAF6), `Abs (0x0AAF6); (0x0ABE5,0x0ABE5), `Abs (0x0ABE5); (0x0ABE8,0x0ABE8), `Abs (0x0ABE8); (0x0ABED,0x0ABED), `Abs (0x0ABED); (0x0FB1E,0x0FB1E), `Abs (0x0FB1E); (0x0FE00,0x0FE0F), `Delta (0); (0x0FE20,0x0FE2F), `Delta (0); (0x101FD,0x101FD), `Abs (0x101FD); (0x102E0,0x102E0), `Abs (0x102E0); (0x10376,0x1037A), `Delta (0); (0x10A01,0x10A03), `Delta (0); (0x10A05,0x10A06), `Delta (0); (0x10A0C,0x10A0F), `Delta (0); (0x10A38,0x10A3A), `Delta (0); (0x10A3F,0x10A3F), `Abs (0x10A3F); (0x10AE5,0x10AE6), `Delta (0); (0x11001,0x11001), `Abs (0x11001); (0x11038,0x11046), `Delta (0); (0x1107F,0x11081), `Delta (0); (0x110B3,0x110B6), `Delta (0); (0x110B9,0x110BA), `Delta (0); (0x11100,0x11102), `Delta (0); (0x11127,0x1112B), `Delta (0); (0x1112D,0x11134), `Delta (0); (0x11173,0x11173), `Abs (0x11173); (0x11180,0x11181), `Delta (0); (0x111B6,0x111BE), `Delta (0); (0x111CA,0x111CC), `Delta (0); (0x1122F,0x11231), `Delta (0); (0x11234,0x11234), `Abs (0x11234); (0x11236,0x11237), `Delta (0); (0x1123E,0x1123E), `Abs (0x1123E); (0x112DF,0x112DF), `Abs (0x112DF); (0x112E3,0x112EA), `Delta (0); (0x11300,0x11301), `Delta (0); (0x1133C,0x1133C), `Abs (0x1133C); (0x11340,0x11340), `Abs (0x11340); (0x11366,0x1136C), `Delta (0); (0x11370,0x11374), `Delta (0); (0x11438,0x1143F), `Delta (0); (0x11442,0x11444), `Delta (0); (0x11446,0x11446), `Abs (0x11446); (0x114B3,0x114B8), `Delta (0); (0x114BA,0x114BA), `Abs (0x114BA); (0x114BF,0x114C0), `Delta (0); (0x114C2,0x114C3), `Delta (0); (0x115B2,0x115B5), `Delta (0); (0x115BC,0x115BD), `Delta (0); (0x115BF,0x115C0), `Delta (0); (0x115DC,0x115DD), `Delta (0); (0x11633,0x1163A), `Delta (0); (0x1163D,0x1163D), `Abs (0x1163D); (0x1163F,0x11640), `Delta (0); (0x116AB,0x116AB), `Abs (0x116AB); (0x116AD,0x116AD), `Abs (0x116AD); (0x116B0,0x116B5), `Delta (0); (0x116B7,0x116B7), `Abs (0x116B7); (0x1171D,0x1171F), `Delta (0); (0x11722,0x11725), `Delta (0); (0x11727,0x1172B), `Delta (0); (0x11C30,0x11C36), `Delta (0); (0x11C38,0x11C3D), `Delta (0); (0x11C3F,0x11C3F), `Abs (0x11C3F); (0x11C92,0x11CA7), `Delta (0); (0x11CAA,0x11CB0), `Delta (0); (0x11CB2,0x11CB3), `Delta (0); (0x11CB5,0x11CB6), `Delta (0); (0x16AF0,0x16AF4), `Delta (0); (0x16B30,0x16B36), `Delta (0); (0x16F8F,0x16F92), `Delta (0); (0x1BC9D,0x1BC9E), `Delta (0); (0x1D167,0x1D169), `Delta (0); (0x1D17B,0x1D182), `Delta (0); (0x1D185,0x1D18B), `Delta (0); (0x1D1AA,0x1D1AD), `Delta (0); (0x1D242,0x1D244), `Delta (0); (0x1DA00,0x1DA36), `Delta (0); (0x1DA3B,0x1DA6C), `Delta (0); (0x1DA75,0x1DA75), `Abs (0x1DA75); (0x1DA84,0x1DA84), `Abs (0x1DA84); (0x1DA9B,0x1DA9F), `Delta (0); (0x1DAA1,0x1DAAF), `Delta (0); (0x1E000,0x1E006), `Delta (0); (0x1E008,0x1E018), `Delta (0); (0x1E01B,0x1E021), `Delta (0); (0x1E023,0x1E024), `Delta (0); (0x1E026,0x1E02A), `Delta (0); (0x1E8D0,0x1E8D6), `Delta (0); (0x1E944,0x1E94A), `Delta (0); (0xE0100,0xE01EF), `Delta (0); (0x00903,0x00903), `Abs (0x00903); (0x0093B,0x0093B), `Abs (0x0093B); (0x0093E,0x00940), `Delta (0); (0x00949,0x0094C), `Delta (0); (0x0094E,0x0094F), `Delta (0); (0x00982,0x00983), `Delta (0); (0x009BE,0x009C0), `Delta (0); (0x009C7,0x009C8), `Delta (0); (0x009CB,0x009CC), `Delta (0); (0x009D7,0x009D7), `Abs (0x009D7); (0x00A03,0x00A03), `Abs (0x00A03); (0x00A3E,0x00A40), `Delta (0); (0x00A83,0x00A83), `Abs (0x00A83); (0x00ABE,0x00AC0), `Delta (0); (0x00AC9,0x00AC9), `Abs (0x00AC9); (0x00ACB,0x00ACC), `Delta (0); (0x00B02,0x00B03), `Delta (0); (0x00B3E,0x00B3E), `Abs (0x00B3E); (0x00B40,0x00B40), `Abs (0x00B40); (0x00B47,0x00B48), `Delta (0); (0x00B4B,0x00B4C), `Delta (0); (0x00B57,0x00B57), `Abs (0x00B57); (0x00BBE,0x00BBF), `Delta (0); (0x00BC1,0x00BC2), `Delta (0); (0x00BC6,0x00BC8), `Delta (0); (0x00BCA,0x00BCC), `Delta (0); (0x00BD7,0x00BD7), `Abs (0x00BD7); (0x00C01,0x00C03), `Delta (0); (0x00C41,0x00C44), `Delta (0); (0x00C82,0x00C83), `Delta (0); (0x00CBE,0x00CBE), `Abs (0x00CBE); (0x00CC0,0x00CC4), `Delta (0); (0x00CC7,0x00CC8), `Delta (0); (0x00CCA,0x00CCB), `Delta (0); (0x00CD5,0x00CD6), `Delta (0); (0x00D02,0x00D03), `Delta (0); (0x00D3E,0x00D40), `Delta (0); (0x00D46,0x00D48), `Delta (0); (0x00D4A,0x00D4C), `Delta (0); (0x00D57,0x00D57), `Abs (0x00D57); (0x00D82,0x00D83), `Delta (0); (0x00DCF,0x00DD1), `Delta (0); (0x00DD8,0x00DDF), `Delta (0); (0x00DF2,0x00DF3), `Delta (0); (0x00F3E,0x00F3F), `Delta (0); (0x00F7F,0x00F7F), `Abs (0x00F7F); (0x0102B,0x0102C), `Delta (0); (0x01031,0x01031), `Abs (0x01031); (0x01038,0x01038), `Abs (0x01038); (0x0103B,0x0103C), `Delta (0); (0x01056,0x01057), `Delta (0); (0x01062,0x01064), `Delta (0); (0x01067,0x0106D), `Delta (0); (0x01083,0x01084), `Delta (0); (0x01087,0x0108C), `Delta (0); (0x0108F,0x0108F), `Abs (0x0108F); (0x0109A,0x0109C), `Delta (0); (0x017B6,0x017B6), `Abs (0x017B6); (0x017BE,0x017C5), `Delta (0); (0x017C7,0x017C8), `Delta (0); (0x01923,0x01926), `Delta (0); (0x01929,0x0192B), `Delta (0); (0x01930,0x01931), `Delta (0); (0x01933,0x01938), `Delta (0); (0x01A19,0x01A1A), `Delta (0); (0x01A55,0x01A55), `Abs (0x01A55); (0x01A57,0x01A57), `Abs (0x01A57); (0x01A61,0x01A61), `Abs (0x01A61); (0x01A63,0x01A64), `Delta (0); (0x01A6D,0x01A72), `Delta (0); (0x01B04,0x01B04), `Abs (0x01B04); (0x01B35,0x01B35), `Abs (0x01B35); (0x01B3B,0x01B3B), `Abs (0x01B3B); (0x01B3D,0x01B41), `Delta (0); (0x01B43,0x01B44), `Delta (0); (0x01B82,0x01B82), `Abs (0x01B82); (0x01BA1,0x01BA1), `Abs (0x01BA1); (0x01BA6,0x01BA7), `Delta (0); (0x01BAA,0x01BAA), `Abs (0x01BAA); (0x01BE7,0x01BE7), `Abs (0x01BE7); (0x01BEA,0x01BEC), `Delta (0); (0x01BEE,0x01BEE), `Abs (0x01BEE); (0x01BF2,0x01BF3), `Delta (0); (0x01C24,0x01C2B), `Delta (0); (0x01C34,0x01C35), `Delta (0); (0x01CE1,0x01CE1), `Abs (0x01CE1); (0x01CF2,0x01CF3), `Delta (0); (0x0302E,0x0302F), `Delta (0); (0x0A823,0x0A824), `Delta (0); (0x0A827,0x0A827), `Abs (0x0A827); (0x0A880,0x0A881), `Delta (0); (0x0A8B4,0x0A8C3), `Delta (0); (0x0A952,0x0A953), `Delta (0); (0x0A983,0x0A983), `Abs (0x0A983); (0x0A9B4,0x0A9B5), `Delta (0); (0x0A9BA,0x0A9BB), `Delta (0); (0x0A9BD,0x0A9C0), `Delta (0); (0x0AA2F,0x0AA30), `Delta (0); (0x0AA33,0x0AA34), `Delta (0); (0x0AA4D,0x0AA4D), `Abs (0x0AA4D); (0x0AA7B,0x0AA7B), `Abs (0x0AA7B); (0x0AA7D,0x0AA7D), `Abs (0x0AA7D); (0x0AAEB,0x0AAEB), `Abs (0x0AAEB); (0x0AAEE,0x0AAEF), `Delta (0); (0x0AAF5,0x0AAF5), `Abs (0x0AAF5); (0x0ABE3,0x0ABE4), `Delta (0); (0x0ABE6,0x0ABE7), `Delta (0); (0x0ABE9,0x0ABEA), `Delta (0); (0x0ABEC,0x0ABEC), `Abs (0x0ABEC); (0x11000,0x11000), `Abs (0x11000); (0x11002,0x11002), `Abs (0x11002); (0x11082,0x11082), `Abs (0x11082); (0x110B0,0x110B2), `Delta (0); (0x110B7,0x110B8), `Delta (0); (0x1112C,0x1112C), `Abs (0x1112C); (0x11182,0x11182), `Abs (0x11182); (0x111B3,0x111B5), `Delta (0); (0x111BF,0x111C0), `Delta (0); (0x1122C,0x1122E), `Delta (0); (0x11232,0x11233), `Delta (0); (0x11235,0x11235), `Abs (0x11235); (0x112E0,0x112E2), `Delta (0); (0x11302,0x11303), `Delta (0); (0x1133E,0x1133F), `Delta (0); (0x11341,0x11344), `Delta (0); (0x11347,0x11348), `Delta (0); (0x1134B,0x1134D), `Delta (0); (0x11357,0x11357), `Abs (0x11357); (0x11362,0x11363), `Delta (0); (0x11435,0x11437), `Delta (0); (0x11440,0x11441), `Delta (0); (0x11445,0x11445), `Abs (0x11445); (0x114B0,0x114B2), `Delta (0); (0x114B9,0x114B9), `Abs (0x114B9); (0x114BB,0x114BE), `Delta (0); (0x114C1,0x114C1), `Abs (0x114C1); (0x115AF,0x115B1), `Delta (0); (0x115B8,0x115BB), `Delta (0); (0x115BE,0x115BE), `Abs (0x115BE); (0x11630,0x11632), `Delta (0); (0x1163B,0x1163C), `Delta (0); (0x1163E,0x1163E), `Abs (0x1163E); (0x116AC,0x116AC), `Abs (0x116AC); (0x116AE,0x116AF), `Delta (0); (0x116B6,0x116B6), `Abs (0x116B6); (0x11720,0x11721), `Delta (0); (0x11726,0x11726), `Abs (0x11726); (0x11C2F,0x11C2F), `Abs (0x11C2F); (0x11C3E,0x11C3E), `Abs (0x11C3E); (0x11CA9,0x11CA9), `Abs (0x11CA9); (0x11CB1,0x11CB1), `Abs (0x11CB1); (0x11CB4,0x11CB4), `Abs (0x11CB4); (0x16F51,0x16F7E), `Delta (0); (0x1D165,0x1D166), `Delta (0); (0x1D16D,0x1D172), `Delta (0); (0x00488,0x00489), `Delta (0); (0x01ABE,0x01ABE), `Abs (0x01ABE); (0x020DD,0x020E0), `Delta (0); (0x020E2,0x020E4), `Delta (0); (0x0A670,0x0A672), `Delta (0); (0x00030,0x00039), `Delta (0); (0x00660,0x00669), `Delta (0); (0x006F0,0x006F9), `Delta (0); (0x007C0,0x007C9), `Delta (0); (0x00966,0x0096F), `Delta (0); (0x009E6,0x009EF), `Delta (0); (0x00A66,0x00A6F), `Delta (0); (0x00AE6,0x00AEF), `Delta (0); (0x00B66,0x00B6F), `Delta (0); (0x00BE6,0x00BEF), `Delta (0); (0x00C66,0x00C6F), `Delta (0); (0x00CE6,0x00CEF), `Delta (0); (0x00D66,0x00D6F), `Delta (0); (0x00DE6,0x00DEF), `Delta (0); (0x00E50,0x00E59), `Delta (0); (0x00ED0,0x00ED9), `Delta (0); (0x00F20,0x00F29), `Delta (0); (0x01040,0x01049), `Delta (0); (0x01090,0x01099), `Delta (0); (0x017E0,0x017E9), `Delta (0); (0x01810,0x01819), `Delta (0); (0x01946,0x0194F), `Delta (0); (0x019D0,0x019D9), `Delta (0); (0x01A80,0x01A89), `Delta (0); (0x01A90,0x01A99), `Delta (0); (0x01B50,0x01B59), `Delta (0); (0x01BB0,0x01BB9), `Delta (0); (0x01C40,0x01C49), `Delta (0); (0x01C50,0x01C59), `Delta (0); (0x0A620,0x0A629), `Delta (0); (0x0A8D0,0x0A8D9), `Delta (0); (0x0A900,0x0A909), `Delta (0); (0x0A9D0,0x0A9D9), `Delta (0); (0x0A9F0,0x0A9F9), `Delta (0); (0x0AA50,0x0AA59), `Delta (0); (0x0ABF0,0x0ABF9), `Delta (0); (0x0FF10,0x0FF19), `Delta (0); (0x104A0,0x104A9), `Delta (0); (0x11066,0x1106F), `Delta (0); (0x110F0,0x110F9), `Delta (0); (0x11136,0x1113F), `Delta (0); (0x111D0,0x111D9), `Delta (0); (0x112F0,0x112F9), `Delta (0); (0x11450,0x11459), `Delta (0); (0x114D0,0x114D9), `Delta (0); (0x11650,0x11659), `Delta (0); (0x116C0,0x116C9), `Delta (0); (0x11730,0x11739), `Delta (0); (0x118E0,0x118E9), `Delta (0); (0x11C50,0x11C59), `Delta (0); (0x16A60,0x16A69), `Delta (0); (0x16B50,0x16B59), `Delta (0); (0x1D7CE,0x1D7FF), `Delta (0); (0x1E950,0x1E959), `Delta (0); (0x016EE,0x016F0), `Delta (0); (0x02160,0x0216F), `Delta (16); (0x02170,0x02182), `Delta (0); (0x02185,0x02188), `Delta (0); (0x03007,0x03007), `Abs (0x03007); (0x03021,0x03029), `Delta (0); (0x03038,0x0303A), `Delta (0); (0x0A6E6,0x0A6EF), `Delta (0); (0x10140,0x10174), `Delta (0); (0x10341,0x10341), `Abs (0x10341); (0x1034A,0x1034A), `Abs (0x1034A); (0x103D1,0x103D5), `Delta (0); (0x12400,0x1246E), `Delta (0); (0x000B2,0x000B3), `Delta (0); (0x000B9,0x000B9), `Abs (0x000B9); (0x000BC,0x000BE), `Delta (0); (0x009F4,0x009F9), `Delta (0); (0x00B72,0x00B77), `Delta (0); (0x00BF0,0x00BF2), `Delta (0); (0x00C78,0x00C7E), `Delta (0); (0x00D58,0x00D5E), `Delta (0); (0x00D70,0x00D78), `Delta (0); (0x00F2A,0x00F33), `Delta (0); (0x01369,0x0137C), `Delta (0); (0x017F0,0x017F9), `Delta (0); (0x019DA,0x019DA), `Abs (0x019DA); (0x02070,0x02070), `Abs (0x02070); (0x02074,0x02079), `Delta (0); (0x02080,0x02089), `Delta (0); (0x02150,0x0215F), `Delta (0); (0x02189,0x02189), `Abs (0x02189); (0x02460,0x0249B), `Delta (0); (0x024EA,0x024FF), `Delta (0); (0x02776,0x02793), `Delta (0); (0x02CFD,0x02CFD), `Abs (0x02CFD); (0x03192,0x03195), `Delta (0); (0x03220,0x03229), `Delta (0); (0x03248,0x0324F), `Delta (0); (0x03251,0x0325F), `Delta (0); (0x03280,0x03289), `Delta (0); (0x032B1,0x032BF), `Delta (0); (0x0A830,0x0A835), `Delta (0); (0x10107,0x10133), `Delta (0); (0x10175,0x10178), `Delta (0); (0x1018A,0x1018B), `Delta (0); (0x102E1,0x102FB), `Delta (0); (0x10320,0x10323), `Delta (0); (0x10858,0x1085F), `Delta (0); (0x10879,0x1087F), `Delta (0); (0x108A7,0x108AF), `Delta (0); (0x108FB,0x108FF), `Delta (0); (0x10916,0x1091B), `Delta (0); (0x109BC,0x109BD), `Delta (0); (0x109C0,0x109CF), `Delta (0); (0x109D2,0x109FF), `Delta (0); (0x10A40,0x10A47), `Delta (0); (0x10A7D,0x10A7E), `Delta (0); (0x10A9D,0x10A9F), `Delta (0); (0x10AEB,0x10AEF), `Delta (0); (0x10B58,0x10B5F), `Delta (0); (0x10B78,0x10B7F), `Delta (0); (0x10BA9,0x10BAF), `Delta (0); (0x10CFA,0x10CFF), `Delta (0); (0x10E60,0x10E7E), `Delta (0); (0x11052,0x11065), `Delta (0); (0x111E1,0x111F4), `Delta (0); (0x1173A,0x1173B), `Delta (0); (0x118EA,0x118F2), `Delta (0); (0x11C5A,0x11C6C), `Delta (0); (0x16B5B,0x16B61), `Delta (0); (0x1D360,0x1D371), `Delta (0); (0x1E8C7,0x1E8CF), `Delta (0); (0x1F100,0x1F10C), `Delta (0); (0x00020,0x00020), `Abs (0x00020); (0x000A0,0x000A0), `Abs (0x000A0); (0x01680,0x01680), `Abs (0x01680); (0x02000,0x0200A), `Delta (0); (0x0202F,0x0202F), `Abs (0x0202F); (0x0205F,0x0205F), `Abs (0x0205F); (0x03000,0x03000), `Abs (0x03000); (0x02028,0x02029), `Delta (0); (0x00001,0x0001F), `Delta (0); (0x0007F,0x0009F), `Delta (0); (0x000AD,0x000AD), `Abs (0x000AD); (0x00600,0x00605), `Delta (0); (0x0061C,0x0061C), `Abs (0x0061C); (0x006DD,0x006DD), `Abs (0x006DD); (0x0070F,0x0070F), `Abs (0x0070F); (0x008E2,0x008E2), `Abs (0x008E2); (0x0180E,0x0180E), `Abs (0x0180E); (0x0200B,0x0200F), `Delta (0); (0x0202A,0x0202E), `Delta (0); (0x02060,0x02064), `Delta (0); (0x02066,0x0206F), `Delta (0); (0x0FEFF,0x0FEFF), `Abs (0x0FEFF); (0x0FFF9,0x0FFFB), `Delta (0); (0x110BD,0x110BD), `Abs (0x110BD); (0x1BCA0,0x1BCA3), `Delta (0); (0x1D173,0x1D17A), `Delta (0); (0xE0001,0xE0001), `Abs (0xE0001); (0xE0020,0xE007F), `Delta (0); (0x0D800,0x0F8FF), `Delta (0); (0xF0000,0xFFFFD), `Delta (0); (0x100000,0x10FFFD), `Delta (0); (0x00378,0x00379), `Delta (0); (0x00380,0x00383), `Delta (0); (0x0038B,0x0038B), `Abs (0x0038B); (0x0038D,0x0038D), `Abs (0x0038D); (0x003A2,0x003A2), `Abs (0x003A2); (0x00530,0x00530), `Abs (0x00530); (0x00557,0x00558), `Delta (0); (0x00560,0x00560), `Abs (0x00560); (0x00588,0x00588), `Abs (0x00588); (0x0058B,0x0058C), `Delta (0); (0x00590,0x00590), `Abs (0x00590); (0x005C8,0x005CF), `Delta (0); (0x005EB,0x005EF), `Delta (0); (0x005F5,0x005FF), `Delta (0); (0x0061D,0x0061D), `Abs (0x0061D); (0x0070E,0x0070E), `Abs (0x0070E); (0x0074B,0x0074C), `Delta (0); (0x007B2,0x007BF), `Delta (0); (0x007FB,0x007FF), `Delta (0); (0x0082E,0x0082F), `Delta (0); (0x0083F,0x0083F), `Abs (0x0083F); (0x0085C,0x0085D), `Delta (0); (0x0085F,0x0089F), `Delta (0); (0x008B5,0x008B5), `Abs (0x008B5); (0x008BE,0x008D3), `Delta (0); (0x00984,0x00984), `Abs (0x00984); (0x0098D,0x0098E), `Delta (0); (0x00991,0x00992), `Delta (0); (0x009A9,0x009A9), `Abs (0x009A9); (0x009B1,0x009B1), `Abs (0x009B1); (0x009B3,0x009B5), `Delta (0); (0x009BA,0x009BB), `Delta (0); (0x009C5,0x009C6), `Delta (0); (0x009C9,0x009CA), `Delta (0); (0x009CF,0x009D6), `Delta (0); (0x009D8,0x009DB), `Delta (0); (0x009DE,0x009DE), `Abs (0x009DE); (0x009E4,0x009E5), `Delta (0); (0x009FC,0x00A00), `Delta (0); (0x00A04,0x00A04), `Abs (0x00A04); (0x00A0B,0x00A0E), `Delta (0); (0x00A11,0x00A12), `Delta (0); (0x00A29,0x00A29), `Abs (0x00A29); (0x00A31,0x00A31), `Abs (0x00A31); (0x00A34,0x00A34), `Abs (0x00A34); (0x00A37,0x00A37), `Abs (0x00A37); (0x00A3A,0x00A3B), `Delta (0); (0x00A3D,0x00A3D), `Abs (0x00A3D); (0x00A43,0x00A46), `Delta (0); (0x00A49,0x00A4A), `Delta (0); (0x00A4E,0x00A50), `Delta (0); (0x00A52,0x00A58), `Delta (0); (0x00A5D,0x00A5D), `Abs (0x00A5D); (0x00A5F,0x00A65), `Delta (0); (0x00A76,0x00A80), `Delta (0); (0x00A84,0x00A84), `Abs (0x00A84); (0x00A8E,0x00A8E), `Abs (0x00A8E); (0x00A92,0x00A92), `Abs (0x00A92); (0x00AA9,0x00AA9), `Abs (0x00AA9); (0x00AB1,0x00AB1), `Abs (0x00AB1); (0x00AB4,0x00AB4), `Abs (0x00AB4); (0x00ABA,0x00ABB), `Delta (0); (0x00AC6,0x00AC6), `Abs (0x00AC6); (0x00ACA,0x00ACA), `Abs (0x00ACA); (0x00ACE,0x00ACF), `Delta (0); (0x00AD1,0x00ADF), `Delta (0); (0x00AE4,0x00AE5), `Delta (0); (0x00AF2,0x00AF8), `Delta (0); (0x00AFA,0x00B00), `Delta (0); (0x00B04,0x00B04), `Abs (0x00B04); (0x00B0D,0x00B0E), `Delta (0); (0x00B11,0x00B12), `Delta (0); (0x00B29,0x00B29), `Abs (0x00B29); (0x00B31,0x00B31), `Abs (0x00B31); (0x00B34,0x00B34), `Abs (0x00B34); (0x00B3A,0x00B3B), `Delta (0); (0x00B45,0x00B46), `Delta (0); (0x00B49,0x00B4A), `Delta (0); (0x00B4E,0x00B55), `Delta (0); (0x00B58,0x00B5B), `Delta (0); (0x00B5E,0x00B5E), `Abs (0x00B5E); (0x00B64,0x00B65), `Delta (0); (0x00B78,0x00B81), `Delta (0); (0x00B84,0x00B84), `Abs (0x00B84); (0x00B8B,0x00B8D), `Delta (0); (0x00B91,0x00B91), `Abs (0x00B91); (0x00B96,0x00B98), `Delta (0); (0x00B9B,0x00B9B), `Abs (0x00B9B); (0x00B9D,0x00B9D), `Abs (0x00B9D); (0x00BA0,0x00BA2), `Delta (0); (0x00BA5,0x00BA7), `Delta (0); (0x00BAB,0x00BAD), `Delta (0); (0x00BBA,0x00BBD), `Delta (0); (0x00BC3,0x00BC5), `Delta (0); (0x00BC9,0x00BC9), `Abs (0x00BC9); (0x00BCE,0x00BCF), `Delta (0); (0x00BD1,0x00BD6), `Delta (0); (0x00BD8,0x00BE5), `Delta (0); (0x00BFB,0x00BFF), `Delta (0); (0x00C04,0x00C04), `Abs (0x00C04); (0x00C0D,0x00C0D), `Abs (0x00C0D); (0x00C11,0x00C11), `Abs (0x00C11); (0x00C29,0x00C29), `Abs (0x00C29); (0x00C3A,0x00C3C), `Delta (0); (0x00C45,0x00C45), `Abs (0x00C45); (0x00C49,0x00C49), `Abs (0x00C49); (0x00C4E,0x00C54), `Delta (0); (0x00C57,0x00C57), `Abs (0x00C57); (0x00C5B,0x00C5F), `Delta (0); (0x00C64,0x00C65), `Delta (0); (0x00C70,0x00C77), `Delta (0); (0x00C84,0x00C84), `Abs (0x00C84); (0x00C8D,0x00C8D), `Abs (0x00C8D); (0x00C91,0x00C91), `Abs (0x00C91); (0x00CA9,0x00CA9), `Abs (0x00CA9); (0x00CB4,0x00CB4), `Abs (0x00CB4); (0x00CBA,0x00CBB), `Delta (0); (0x00CC5,0x00CC5), `Abs (0x00CC5); (0x00CC9,0x00CC9), `Abs (0x00CC9); (0x00CCE,0x00CD4), `Delta (0); (0x00CD7,0x00CDD), `Delta (0); (0x00CDF,0x00CDF), `Abs (0x00CDF); (0x00CE4,0x00CE5), `Delta (0); (0x00CF0,0x00CF0), `Abs (0x00CF0); (0x00CF3,0x00D00), `Delta (0); (0x00D04,0x00D04), `Abs (0x00D04); (0x00D0D,0x00D0D), `Abs (0x00D0D); (0x00D11,0x00D11), `Abs (0x00D11); (0x00D3B,0x00D3C), `Delta (0); (0x00D45,0x00D45), `Abs (0x00D45); (0x00D49,0x00D49), `Abs (0x00D49); (0x00D50,0x00D53), `Delta (0); (0x00D64,0x00D65), `Delta (0); (0x00D80,0x00D81), `Delta (0); (0x00D84,0x00D84), `Abs (0x00D84); (0x00D97,0x00D99), `Delta (0); (0x00DB2,0x00DB2), `Abs (0x00DB2); (0x00DBC,0x00DBC), `Abs (0x00DBC); (0x00DBE,0x00DBF), `Delta (0); (0x00DC7,0x00DC9), `Delta (0); (0x00DCB,0x00DCE), `Delta (0); (0x00DD5,0x00DD5), `Abs (0x00DD5); (0x00DD7,0x00DD7), `Abs (0x00DD7); (0x00DE0,0x00DE5), `Delta (0); (0x00DF0,0x00DF1), `Delta (0); (0x00DF5,0x00E00), `Delta (0); (0x00E3B,0x00E3E), `Delta (0); (0x00E5C,0x00E80), `Delta (0); (0x00E83,0x00E83), `Abs (0x00E83); (0x00E85,0x00E86), `Delta (0); (0x00E89,0x00E89), `Abs (0x00E89); (0x00E8B,0x00E8C), `Delta (0); (0x00E8E,0x00E93), `Delta (0); (0x00E98,0x00E98), `Abs (0x00E98); (0x00EA0,0x00EA0), `Abs (0x00EA0); (0x00EA4,0x00EA4), `Abs (0x00EA4); (0x00EA6,0x00EA6), `Abs (0x00EA6); (0x00EA8,0x00EA9), `Delta (0); (0x00EAC,0x00EAC), `Abs (0x00EAC); (0x00EBA,0x00EBA), `Abs (0x00EBA); (0x00EBE,0x00EBF), `Delta (0); (0x00EC5,0x00EC5), `Abs (0x00EC5); (0x00EC7,0x00EC7), `Abs (0x00EC7); (0x00ECE,0x00ECF), `Delta (0); (0x00EDA,0x00EDB), `Delta (0); (0x00EE0,0x00EFF), `Delta (0); (0x00F48,0x00F48), `Abs (0x00F48); (0x00F6D,0x00F70), `Delta (0); (0x00F98,0x00F98), `Abs (0x00F98); (0x00FBD,0x00FBD), `Abs (0x00FBD); (0x00FCD,0x00FCD), `Abs (0x00FCD); (0x00FDB,0x00FFF), `Delta (0); (0x010C6,0x010C6), `Abs (0x010C6); (0x010C8,0x010CC), `Delta (0); (0x010CE,0x010CF), `Delta (0); (0x01249,0x01249), `Abs (0x01249); (0x0124E,0x0124F), `Delta (0); (0x01257,0x01257), `Abs (0x01257); (0x01259,0x01259), `Abs (0x01259); (0x0125E,0x0125F), `Delta (0); (0x01289,0x01289), `Abs (0x01289); (0x0128E,0x0128F), `Delta (0); (0x012B1,0x012B1), `Abs (0x012B1); (0x012B6,0x012B7), `Delta (0); (0x012BF,0x012BF), `Abs (0x012BF); (0x012C1,0x012C1), `Abs (0x012C1); (0x012C6,0x012C7), `Delta (0); (0x012D7,0x012D7), `Abs (0x012D7); (0x01311,0x01311), `Abs (0x01311); (0x01316,0x01317), `Delta (0); (0x0135B,0x0135C), `Delta (0); (0x0137D,0x0137F), `Delta (0); (0x0139A,0x0139F), `Delta (0); (0x013F6,0x013F7), `Delta (0); (0x013FE,0x013FF), `Delta (0); (0x0169D,0x0169F), `Delta (0); (0x016F9,0x016FF), `Delta (0); (0x0170D,0x0170D), `Abs (0x0170D); (0x01715,0x0171F), `Delta (0); (0x01737,0x0173F), `Delta (0); (0x01754,0x0175F), `Delta (0); (0x0176D,0x0176D), `Abs (0x0176D); (0x01771,0x01771), `Abs (0x01771); (0x01774,0x0177F), `Delta (0); (0x017DE,0x017DF), `Delta (0); (0x017EA,0x017EF), `Delta (0); (0x017FA,0x017FF), `Delta (0); (0x0180F,0x0180F), `Abs (0x0180F); (0x0181A,0x0181F), `Delta (0); (0x01878,0x0187F), `Delta (0); (0x018AB,0x018AF), `Delta (0); (0x018F6,0x018FF), `Delta (0); (0x0191F,0x0191F), `Abs (0x0191F); (0x0192C,0x0192F), `Delta (0); (0x0193C,0x0193F), `Delta (0); (0x01941,0x01943), `Delta (0); (0x0196E,0x0196F), `Delta (0); (0x01975,0x0197F), `Delta (0); (0x019AC,0x019AF), `Delta (0); (0x019CA,0x019CF), `Delta (0); (0x019DB,0x019DD), `Delta (0); (0x01A1C,0x01A1D), `Delta (0); (0x01A5F,0x01A5F), `Abs (0x01A5F); (0x01A7D,0x01A7E), `Delta (0); (0x01A8A,0x01A8F), `Delta (0); (0x01A9A,0x01A9F), `Delta (0); (0x01AAE,0x01AAF), `Delta (0); (0x01ABF,0x01AFF), `Delta (0); (0x01B4C,0x01B4F), `Delta (0); (0x01B7D,0x01B7F), `Delta (0); (0x01BF4,0x01BFB), `Delta (0); (0x01C38,0x01C3A), `Delta (0); (0x01C4A,0x01C4C), `Delta (0); (0x01C89,0x01CBF), `Delta (0); (0x01CC8,0x01CCF), `Delta (0); (0x01CF7,0x01CF7), `Abs (0x01CF7); (0x01CFA,0x01CFF), `Delta (0); (0x01DF6,0x01DFA), `Delta (0); (0x01F16,0x01F17), `Delta (0); (0x01F1E,0x01F1F), `Delta (0); (0x01F46,0x01F47), `Delta (0); (0x01F4E,0x01F4F), `Delta (0); (0x01F58,0x01F58), `Abs (0x01F58); (0x01F5A,0x01F5A), `Abs (0x01F5A); (0x01F5C,0x01F5C), `Abs (0x01F5C); (0x01F5E,0x01F5E), `Abs (0x01F5E); (0x01F7E,0x01F7F), `Delta (0); (0x01FB5,0x01FB5), `Abs (0x01FB5); (0x01FC5,0x01FC5), `Abs (0x01FC5); (0x01FD4,0x01FD5), `Delta (0); (0x01FDC,0x01FDC), `Abs (0x01FDC); (0x01FF0,0x01FF1), `Delta (0); (0x01FF5,0x01FF5), `Abs (0x01FF5); (0x01FFF,0x01FFF), `Abs (0x01FFF); (0x02065,0x02065), `Abs (0x02065); (0x02072,0x02073), `Delta (0); (0x0208F,0x0208F), `Abs (0x0208F); (0x0209D,0x0209F), `Delta (0); (0x020BF,0x020CF), `Delta (0); (0x020F1,0x020FF), `Delta (0); (0x0218C,0x0218F), `Delta (0); (0x023FF,0x023FF), `Abs (0x023FF); (0x02427,0x0243F), `Delta (0); (0x0244B,0x0245F), `Delta (0); (0x02B74,0x02B75), `Delta (0); (0x02B96,0x02B97), `Delta (0); (0x02BBA,0x02BBC), `Delta (0); (0x02BC9,0x02BC9), `Abs (0x02BC9); (0x02BD2,0x02BEB), `Delta (0); (0x02BF0,0x02BFF), `Delta (0); (0x02C2F,0x02C2F), `Abs (0x02C2F); (0x02C5F,0x02C5F), `Abs (0x02C5F); (0x02CF4,0x02CF8), `Delta (0); (0x02D26,0x02D26), `Abs (0x02D26); (0x02D28,0x02D2C), `Delta (0); (0x02D2E,0x02D2F), `Delta (0); (0x02D68,0x02D6E), `Delta (0); (0x02D71,0x02D7E), `Delta (0); (0x02D97,0x02D9F), `Delta (0); (0x02DA7,0x02DA7), `Abs (0x02DA7); (0x02DAF,0x02DAF), `Abs (0x02DAF); (0x02DB7,0x02DB7), `Abs (0x02DB7); (0x02DBF,0x02DBF), `Abs (0x02DBF); (0x02DC7,0x02DC7), `Abs (0x02DC7); (0x02DCF,0x02DCF), `Abs (0x02DCF); (0x02DD7,0x02DD7), `Abs (0x02DD7); (0x02DDF,0x02DDF), `Abs (0x02DDF); (0x02E45,0x02E7F), `Delta (0); (0x02E9A,0x02E9A), `Abs (0x02E9A); (0x02EF4,0x02EFF), `Delta (0); (0x02FD6,0x02FEF), `Delta (0); (0x02FFC,0x02FFF), `Delta (0); (0x03040,0x03040), `Abs (0x03040); (0x03097,0x03098), `Delta (0); (0x03100,0x03104), `Delta (0); (0x0312E,0x03130), `Delta (0); (0x0318F,0x0318F), `Abs (0x0318F); (0x031BB,0x031BF), `Delta (0); (0x031E4,0x031EF), `Delta (0); (0x0321F,0x0321F), `Abs (0x0321F); (0x032FF,0x032FF), `Abs (0x032FF); (0x04DB6,0x04DBF), `Delta (0); (0x09FD6,0x09FFF), `Delta (0); (0x0A48D,0x0A48F), `Delta (0); (0x0A4C7,0x0A4CF), `Delta (0); (0x0A62C,0x0A63F), `Delta (0); (0x0A6F8,0x0A6FF), `Delta (0); (0x0A7AF,0x0A7AF), `Abs (0x0A7AF); (0x0A7B8,0x0A7F6), `Delta (0); (0x0A82C,0x0A82F), `Delta (0); (0x0A83A,0x0A83F), `Delta (0); (0x0A878,0x0A87F), `Delta (0); (0x0A8C6,0x0A8CD), `Delta (0); (0x0A8DA,0x0A8DF), `Delta (0); (0x0A8FE,0x0A8FF), `Delta (0); (0x0A954,0x0A95E), `Delta (0); (0x0A97D,0x0A97F), `Delta (0); (0x0A9CE,0x0A9CE), `Abs (0x0A9CE); (0x0A9DA,0x0A9DD), `Delta (0); (0x0A9FF,0x0A9FF), `Abs (0x0A9FF); (0x0AA37,0x0AA3F), `Delta (0); (0x0AA4E,0x0AA4F), `Delta (0); (0x0AA5A,0x0AA5B), `Delta (0); (0x0AAC3,0x0AADA), `Delta (0); (0x0AAF7,0x0AB00), `Delta (0); (0x0AB07,0x0AB08), `Delta (0); (0x0AB0F,0x0AB10), `Delta (0); (0x0AB17,0x0AB1F), `Delta (0); (0x0AB27,0x0AB27), `Abs (0x0AB27); (0x0AB2F,0x0AB2F), `Abs (0x0AB2F); (0x0AB66,0x0AB6F), `Delta (0); (0x0ABEE,0x0ABEF), `Delta (0); (0x0ABFA,0x0ABFF), `Delta (0); (0x0D7A4,0x0D7AF), `Delta (0); (0x0D7C7,0x0D7CA), `Delta (0); (0x0D7FC,0x0D7FF), `Delta (0); (0x0FA6E,0x0FA6F), `Delta (0); (0x0FADA,0x0FAFF), `Delta (0); (0x0FB07,0x0FB12), `Delta (0); (0x0FB18,0x0FB1C), `Delta (0); (0x0FB37,0x0FB37), `Abs (0x0FB37); (0x0FB3D,0x0FB3D), `Abs (0x0FB3D); (0x0FB3F,0x0FB3F), `Abs (0x0FB3F); (0x0FB42,0x0FB42), `Abs (0x0FB42); (0x0FB45,0x0FB45), `Abs (0x0FB45); (0x0FBC2,0x0FBD2), `Delta (0); (0x0FD40,0x0FD4F), `Delta (0); (0x0FD90,0x0FD91), `Delta (0); (0x0FDC8,0x0FDEF), `Delta (0); (0x0FDFE,0x0FDFF), `Delta (0); (0x0FE1A,0x0FE1F), `Delta (0); (0x0FE53,0x0FE53), `Abs (0x0FE53); (0x0FE67,0x0FE67), `Abs (0x0FE67); (0x0FE6C,0x0FE6F), `Delta (0); (0x0FE75,0x0FE75), `Abs (0x0FE75); (0x0FEFD,0x0FEFE), `Delta (0); (0x0FF00,0x0FF00), `Abs (0x0FF00); (0x0FFBF,0x0FFC1), `Delta (0); (0x0FFC8,0x0FFC9), `Delta (0); (0x0FFD0,0x0FFD1), `Delta (0); (0x0FFD8,0x0FFD9), `Delta (0); (0x0FFDD,0x0FFDF), `Delta (0); (0x0FFE7,0x0FFE7), `Abs (0x0FFE7); (0x0FFEF,0x0FFF8), `Delta (0); (0x0FFFE,0x0FFFF), `Delta (0); (0x1000C,0x1000C), `Abs (0x1000C); (0x10027,0x10027), `Abs (0x10027); (0x1003B,0x1003B), `Abs (0x1003B); (0x1003E,0x1003E), `Abs (0x1003E); (0x1004E,0x1004F), `Delta (0); (0x1005E,0x1007F), `Delta (0); (0x100FB,0x100FF), `Delta (0); (0x10103,0x10106), `Delta (0); (0x10134,0x10136), `Delta (0); (0x1018F,0x1018F), `Abs (0x1018F); (0x1019C,0x1019F), `Delta (0); (0x101A1,0x101CF), `Delta (0); (0x101FE,0x1027F), `Delta (0); (0x1029D,0x1029F), `Delta (0); (0x102D1,0x102DF), `Delta (0); (0x102FC,0x102FF), `Delta (0); (0x10324,0x1032F), `Delta (0); (0x1034B,0x1034F), `Delta (0); (0x1037B,0x1037F), `Delta (0); (0x1039E,0x1039E), `Abs (0x1039E); (0x103C4,0x103C7), `Delta (0); (0x103D6,0x103FF), `Delta (0); (0x1049E,0x1049F), `Delta (0); (0x104AA,0x104AF), `Delta (0); (0x104D4,0x104D7), `Delta (0); (0x104FC,0x104FF), `Delta (0); (0x10528,0x1052F), `Delta (0); (0x10564,0x1056E), `Delta (0); (0x10570,0x105FF), `Delta (0); (0x10737,0x1073F), `Delta (0); (0x10756,0x1075F), `Delta (0); (0x10768,0x107FF), `Delta (0); (0x10806,0x10807), `Delta (0); (0x10809,0x10809), `Abs (0x10809); (0x10836,0x10836), `Abs (0x10836); (0x10839,0x1083B), `Delta (0); (0x1083D,0x1083E), `Delta (0); (0x10856,0x10856), `Abs (0x10856); (0x1089F,0x108A6), `Delta (0); (0x108B0,0x108DF), `Delta (0); (0x108F3,0x108F3), `Abs (0x108F3); (0x108F6,0x108FA), `Delta (0); (0x1091C,0x1091E), `Delta (0); (0x1093A,0x1093E), `Delta (0); (0x10940,0x1097F), `Delta (0); (0x109B8,0x109BB), `Delta (0); (0x109D0,0x109D1), `Delta (0); (0x10A04,0x10A04), `Abs (0x10A04); (0x10A07,0x10A0B), `Delta (0); (0x10A14,0x10A14), `Abs (0x10A14); (0x10A18,0x10A18), `Abs (0x10A18); (0x10A34,0x10A37), `Delta (0); (0x10A3B,0x10A3E), `Delta (0); (0x10A48,0x10A4F), `Delta (0); (0x10A59,0x10A5F), `Delta (0); (0x10AA0,0x10ABF), `Delta (0); (0x10AE7,0x10AEA), `Delta (0); (0x10AF7,0x10AFF), `Delta (0); (0x10B36,0x10B38), `Delta (0); (0x10B56,0x10B57), `Delta (0); (0x10B73,0x10B77), `Delta (0); (0x10B92,0x10B98), `Delta (0); (0x10B9D,0x10BA8), `Delta (0); (0x10BB0,0x10BFF), `Delta (0); (0x10C49,0x10C7F), `Delta (0); (0x10CB3,0x10CBF), `Delta (0); (0x10CF3,0x10CF9), `Delta (0); (0x10D00,0x10E5F), `Delta (0); (0x10E7F,0x10FFF), `Delta (0); (0x1104E,0x11051), `Delta (0); (0x11070,0x1107E), `Delta (0); (0x110C2,0x110CF), `Delta (0); (0x110E9,0x110EF), `Delta (0); (0x110FA,0x110FF), `Delta (0); (0x11135,0x11135), `Abs (0x11135); (0x11144,0x1114F), `Delta (0); (0x11177,0x1117F), `Delta (0); (0x111CE,0x111CF), `Delta (0); (0x111E0,0x111E0), `Abs (0x111E0); (0x111F5,0x111FF), `Delta (0); (0x11212,0x11212), `Abs (0x11212); (0x1123F,0x1127F), `Delta (0); (0x11287,0x11287), `Abs (0x11287); (0x11289,0x11289), `Abs (0x11289); (0x1128E,0x1128E), `Abs (0x1128E); (0x1129E,0x1129E), `Abs (0x1129E); (0x112AA,0x112AF), `Delta (0); (0x112EB,0x112EF), `Delta (0); (0x112FA,0x112FF), `Delta (0); (0x11304,0x11304), `Abs (0x11304); (0x1130D,0x1130E), `Delta (0); (0x11311,0x11312), `Delta (0); (0x11329,0x11329), `Abs (0x11329); (0x11331,0x11331), `Abs (0x11331); (0x11334,0x11334), `Abs (0x11334); (0x1133A,0x1133B), `Delta (0); (0x11345,0x11346), `Delta (0); (0x11349,0x1134A), `Delta (0); (0x1134E,0x1134F), `Delta (0); (0x11351,0x11356), `Delta (0); (0x11358,0x1135C), `Delta (0); (0x11364,0x11365), `Delta (0); (0x1136D,0x1136F), `Delta (0); (0x11375,0x113FF), `Delta (0); (0x1145A,0x1145A), `Abs (0x1145A); (0x1145C,0x1145C), `Abs (0x1145C); (0x1145E,0x1147F), `Delta (0); (0x114C8,0x114CF), `Delta (0); (0x114DA,0x1157F), `Delta (0); (0x115B6,0x115B7), `Delta (0); (0x115DE,0x115FF), `Delta (0); (0x11645,0x1164F), `Delta (0); (0x1165A,0x1165F), `Delta (0); (0x1166D,0x1167F), `Delta (0); (0x116B8,0x116BF), `Delta (0); (0x116CA,0x116FF), `Delta (0); (0x1171A,0x1171C), `Delta (0); (0x1172C,0x1172F), `Delta (0); (0x11740,0x1189F), `Delta (0); (0x118F3,0x118FE), `Delta (0); (0x11900,0x11ABF), `Delta (0); (0x11AF9,0x11BFF), `Delta (0); (0x11C09,0x11C09), `Abs (0x11C09); (0x11C37,0x11C37), `Abs (0x11C37); (0x11C46,0x11C4F), `Delta (0); (0x11C6D,0x11C6F), `Delta (0); (0x11C90,0x11C91), `Delta (0); (0x11CA8,0x11CA8), `Abs (0x11CA8); (0x11CB7,0x11FFF), `Delta (0); (0x1239A,0x123FF), `Delta (0); (0x1246F,0x1246F), `Abs (0x1246F); (0x12475,0x1247F), `Delta (0); (0x12544,0x12FFF), `Delta (0); (0x1342F,0x143FF), `Delta (0); (0x14647,0x167FF), `Delta (0); (0x16A39,0x16A3F), `Delta (0); (0x16A5F,0x16A5F), `Abs (0x16A5F); (0x16A6A,0x16A6D), `Delta (0); (0x16A70,0x16ACF), `Delta (0); (0x16AEE,0x16AEF), `Delta (0); (0x16AF6,0x16AFF), `Delta (0); (0x16B46,0x16B4F), `Delta (0); (0x16B5A,0x16B5A), `Abs (0x16B5A); (0x16B62,0x16B62), `Abs (0x16B62); (0x16B78,0x16B7C), `Delta (0); (0x16B90,0x16EFF), `Delta (0); (0x16F45,0x16F4F), `Delta (0); (0x16F7F,0x16F8E), `Delta (0); (0x16FA0,0x16FDF), `Delta (0); (0x16FE1,0x16FFF), `Delta (0); (0x187ED,0x187FF), `Delta (0); (0x18AF3,0x1AFFF), `Delta (0); (0x1B002,0x1BBFF), `Delta (0); (0x1BC6B,0x1BC6F), `Delta (0); (0x1BC7D,0x1BC7F), `Delta (0); (0x1BC89,0x1BC8F), `Delta (0); (0x1BC9A,0x1BC9B), `Delta (0); (0x1BCA4,0x1CFFF), `Delta (0); (0x1D0F6,0x1D0FF), `Delta (0); (0x1D127,0x1D128), `Delta (0); (0x1D1E9,0x1D1FF), `Delta (0); (0x1D246,0x1D2FF), `Delta (0); (0x1D357,0x1D35F), `Delta (0); (0x1D372,0x1D3FF), `Delta (0); (0x1D455,0x1D455), `Abs (0x1D455); (0x1D49D,0x1D49D), `Abs (0x1D49D); (0x1D4A0,0x1D4A1), `Delta (0); (0x1D4A3,0x1D4A4), `Delta (0); (0x1D4A7,0x1D4A8), `Delta (0); (0x1D4AD,0x1D4AD), `Abs (0x1D4AD); (0x1D4BA,0x1D4BA), `Abs (0x1D4BA); (0x1D4BC,0x1D4BC), `Abs (0x1D4BC); (0x1D4C4,0x1D4C4), `Abs (0x1D4C4); (0x1D506,0x1D506), `Abs (0x1D506); (0x1D50B,0x1D50C), `Delta (0); (0x1D515,0x1D515), `Abs (0x1D515); (0x1D51D,0x1D51D), `Abs (0x1D51D); (0x1D53A,0x1D53A), `Abs (0x1D53A); (0x1D53F,0x1D53F), `Abs (0x1D53F); (0x1D545,0x1D545), `Abs (0x1D545); (0x1D547,0x1D549), `Delta (0); (0x1D551,0x1D551), `Abs (0x1D551); (0x1D6A6,0x1D6A7), `Delta (0); (0x1D7CC,0x1D7CD), `Delta (0); (0x1DA8C,0x1DA9A), `Delta (0); (0x1DAA0,0x1DAA0), `Abs (0x1DAA0); (0x1DAB0,0x1DFFF), `Delta (0); (0x1E007,0x1E007), `Abs (0x1E007); (0x1E019,0x1E01A), `Delta (0); (0x1E022,0x1E022), `Abs (0x1E022); (0x1E025,0x1E025), `Abs (0x1E025); (0x1E02B,0x1E7FF), `Delta (0); (0x1E8C5,0x1E8C6), `Delta (0); (0x1E8D7,0x1E8FF), `Delta (0); (0x1E94B,0x1E94F), `Delta (0); (0x1E95A,0x1E95D), `Delta (0); (0x1E960,0x1EDFF), `Delta (0); (0x1EE04,0x1EE04), `Abs (0x1EE04); (0x1EE20,0x1EE20), `Abs (0x1EE20); (0x1EE23,0x1EE23), `Abs (0x1EE23); (0x1EE25,0x1EE26), `Delta (0); (0x1EE28,0x1EE28), `Abs (0x1EE28); (0x1EE33,0x1EE33), `Abs (0x1EE33); (0x1EE38,0x1EE38), `Abs (0x1EE38); (0x1EE3A,0x1EE3A), `Abs (0x1EE3A); (0x1EE3C,0x1EE41), `Delta (0); (0x1EE43,0x1EE46), `Delta (0); (0x1EE48,0x1EE48), `Abs (0x1EE48); (0x1EE4A,0x1EE4A), `Abs (0x1EE4A); (0x1EE4C,0x1EE4C), `Abs (0x1EE4C); (0x1EE50,0x1EE50), `Abs (0x1EE50); (0x1EE53,0x1EE53), `Abs (0x1EE53); (0x1EE55,0x1EE56), `Delta (0); (0x1EE58,0x1EE58), `Abs (0x1EE58); (0x1EE5A,0x1EE5A), `Abs (0x1EE5A); (0x1EE5C,0x1EE5C), `Abs (0x1EE5C); (0x1EE5E,0x1EE5E), `Abs (0x1EE5E); (0x1EE60,0x1EE60), `Abs (0x1EE60); (0x1EE63,0x1EE63), `Abs (0x1EE63); (0x1EE65,0x1EE66), `Delta (0); (0x1EE6B,0x1EE6B), `Abs (0x1EE6B); (0x1EE73,0x1EE73), `Abs (0x1EE73); (0x1EE78,0x1EE78), `Abs (0x1EE78); (0x1EE7D,0x1EE7D), `Abs (0x1EE7D); (0x1EE7F,0x1EE7F), `Abs (0x1EE7F); (0x1EE8A,0x1EE8A), `Abs (0x1EE8A); (0x1EE9C,0x1EEA0), `Delta (0); (0x1EEA4,0x1EEA4), `Abs (0x1EEA4); (0x1EEAA,0x1EEAA), `Abs (0x1EEAA); (0x1EEBC,0x1EEEF), `Delta (0); (0x1EEF2,0x1EFFF), `Delta (0); (0x1F02C,0x1F02F), `Delta (0); (0x1F094,0x1F09F), `Delta (0); (0x1F0AF,0x1F0B0), `Delta (0); (0x1F0C0,0x1F0C0), `Abs (0x1F0C0); (0x1F0D0,0x1F0D0), `Abs (0x1F0D0); (0x1F0F6,0x1F0FF), `Delta (0); (0x1F10D,0x1F10F), `Delta (0); (0x1F12F,0x1F12F), `Abs (0x1F12F); (0x1F16C,0x1F16F), `Delta (0); (0x1F1AD,0x1F1E5), `Delta (0); (0x1F203,0x1F20F), `Delta (0); (0x1F23C,0x1F23F), `Delta (0); (0x1F249,0x1F24F), `Delta (0); (0x1F252,0x1F2FF), `Delta (0); (0x1F6D3,0x1F6DF), `Delta (0); (0x1F6ED,0x1F6EF), `Delta (0); (0x1F6F7,0x1F6FF), `Delta (0); (0x1F774,0x1F77F), `Delta (0); (0x1F7D5,0x1F7FF), `Delta (0); (0x1F80C,0x1F80F), `Delta (0); (0x1F848,0x1F84F), `Delta (0); (0x1F85A,0x1F85F), `Delta (0); (0x1F888,0x1F88F), `Delta (0); (0x1F8AE,0x1F90F), `Delta (0); (0x1F91F,0x1F91F), `Abs (0x1F91F); (0x1F928,0x1F92F), `Delta (0); (0x1F931,0x1F932), `Delta (0); (0x1F93F,0x1F93F), `Abs (0x1F93F); (0x1F94C,0x1F94F), `Delta (0); (0x1F95F,0x1F97F), `Delta (0); (0x1F992,0x1F9BF), `Delta (0); (0x1F9C1,0x1FFFF), `Delta (0); (0x2A6D7,0x2A6FF), `Delta (0); (0x2B735,0x2B73F), `Delta (0); (0x2B81E,0x2B81F), `Delta (0); (0x2CEA2,0x2F7FF), `Delta (0); (0x2FA1E,0xE0000), `Delta (0); (0xE0002,0xE001F), `Delta (0); (0xE0080,0xE00FF), `Delta (0); (0xE01F0,0xEFFFF), `Delta (0); (0xFFFFE,0xFFFFF), `Delta (0); (0x10FFFE,0x10FFFF), `Delta (0); (0x002B0,0x002C1), `Delta (0); (0x002C6,0x002D1), `Delta (0); (0x002E0,0x002E4), `Delta (0); (0x002EC,0x002EC), `Abs (0x002EC); (0x002EE,0x002EE), `Abs (0x002EE); (0x00374,0x00374), `Abs (0x00374); (0x0037A,0x0037A), `Abs (0x0037A); (0x00559,0x00559), `Abs (0x00559); (0x00640,0x00640), `Abs (0x00640); (0x006E5,0x006E6), `Delta (0); (0x007F4,0x007F5), `Delta (0); (0x007FA,0x007FA), `Abs (0x007FA); (0x0081A,0x0081A), `Abs (0x0081A); (0x00824,0x00824), `Abs (0x00824); (0x00828,0x00828), `Abs (0x00828); (0x00971,0x00971), `Abs (0x00971); (0x00E46,0x00E46), `Abs (0x00E46); (0x00EC6,0x00EC6), `Abs (0x00EC6); (0x010FC,0x010FC), `Abs (0x010FC); (0x017D7,0x017D7), `Abs (0x017D7); (0x01843,0x01843), `Abs (0x01843); (0x01AA7,0x01AA7), `Abs (0x01AA7); (0x01C78,0x01C7D), `Delta (0); (0x01D2C,0x01D6A), `Delta (0); (0x01D78,0x01D78), `Abs (0x01D78); (0x01D9B,0x01DBF), `Delta (0); (0x02071,0x02071), `Abs (0x02071); (0x0207F,0x0207F), `Abs (0x0207F); (0x02090,0x0209C), `Delta (0); (0x02C7C,0x02C7D), `Delta (0); (0x02D6F,0x02D6F), `Abs (0x02D6F); (0x02E2F,0x02E2F), `Abs (0x02E2F); (0x03005,0x03005), `Abs (0x03005); (0x03031,0x03035), `Delta (0); (0x0303B,0x0303B), `Abs (0x0303B); (0x0309D,0x0309E), `Delta (0); (0x030FC,0x030FE), `Delta (0); (0x0A015,0x0A015), `Abs (0x0A015); (0x0A4F8,0x0A4FD), `Delta (0); (0x0A60C,0x0A60C), `Abs (0x0A60C); (0x0A67F,0x0A67F), `Abs (0x0A67F); (0x0A69C,0x0A69D), `Delta (0); (0x0A717,0x0A71F), `Delta (0); (0x0A770,0x0A770), `Abs (0x0A770); (0x0A788,0x0A788), `Abs (0x0A788); (0x0A7F8,0x0A7F9), `Delta (0); (0x0A9CF,0x0A9CF), `Abs (0x0A9CF); (0x0A9E6,0x0A9E6), `Abs (0x0A9E6); (0x0AA70,0x0AA70), `Abs (0x0AA70); (0x0AADD,0x0AADD), `Abs (0x0AADD); (0x0AAF3,0x0AAF4), `Delta (0); (0x0AB5C,0x0AB5F), `Delta (0); (0x0FF70,0x0FF70), `Abs (0x0FF70); (0x0FF9E,0x0FF9F), `Delta (0); (0x16B40,0x16B43), `Delta (0); (0x16F93,0x16F9F), `Delta (0); (0x16FE0,0x16FE0), `Abs (0x16FE0); (0x000AA,0x000AA), `Abs (0x000AA); (0x000BA,0x000BA), `Abs (0x000BA); (0x001BB,0x001BB), `Abs (0x001BB); (0x001C0,0x001C3), `Delta (0); (0x00294,0x00294), `Abs (0x00294); (0x005D0,0x005EA), `Delta (0); (0x005F0,0x005F2), `Delta (0); (0x00620,0x0063F), `Delta (0); (0x00641,0x0064A), `Delta (0); (0x0066E,0x0066F), `Delta (0); (0x00671,0x006D3), `Delta (0); (0x006D5,0x006D5), `Abs (0x006D5); (0x006EE,0x006EF), `Delta (0); (0x006FA,0x006FC), `Delta (0); (0x006FF,0x006FF), `Abs (0x006FF); (0x00710,0x00710), `Abs (0x00710); (0x00712,0x0072F), `Delta (0); (0x0074D,0x007A5), `Delta (0); (0x007B1,0x007B1), `Abs (0x007B1); (0x007CA,0x007EA), `Delta (0); (0x00800,0x00815), `Delta (0); (0x00840,0x00858), `Delta (0); (0x008A0,0x008B4), `Delta (0); (0x008B6,0x008BD), `Delta (0); (0x00904,0x00939), `Delta (0); (0x0093D,0x0093D), `Abs (0x0093D); (0x00950,0x00950), `Abs (0x00950); (0x00958,0x00961), `Delta (0); (0x00972,0x00980), `Delta (0); (0x00985,0x0098C), `Delta (0); (0x0098F,0x00990), `Delta (0); (0x00993,0x009A8), `Delta (0); (0x009AA,0x009B0), `Delta (0); (0x009B2,0x009B2), `Abs (0x009B2); (0x009B6,0x009B9), `Delta (0); (0x009BD,0x009BD), `Abs (0x009BD); (0x009CE,0x009CE), `Abs (0x009CE); (0x009DC,0x009DD), `Delta (0); (0x009DF,0x009E1), `Delta (0); (0x009F0,0x009F1), `Delta (0); (0x00A05,0x00A0A), `Delta (0); (0x00A0F,0x00A10), `Delta (0); (0x00A13,0x00A28), `Delta (0); (0x00A2A,0x00A30), `Delta (0); (0x00A32,0x00A33), `Delta (0); (0x00A35,0x00A36), `Delta (0); (0x00A38,0x00A39), `Delta (0); (0x00A59,0x00A5C), `Delta (0); (0x00A5E,0x00A5E), `Abs (0x00A5E); (0x00A72,0x00A74), `Delta (0); (0x00A85,0x00A8D), `Delta (0); (0x00A8F,0x00A91), `Delta (0); (0x00A93,0x00AA8), `Delta (0); (0x00AAA,0x00AB0), `Delta (0); (0x00AB2,0x00AB3), `Delta (0); (0x00AB5,0x00AB9), `Delta (0); (0x00ABD,0x00ABD), `Abs (0x00ABD); (0x00AD0,0x00AD0), `Abs (0x00AD0); (0x00AE0,0x00AE1), `Delta (0); (0x00AF9,0x00AF9), `Abs (0x00AF9); (0x00B05,0x00B0C), `Delta (0); (0x00B0F,0x00B10), `Delta (0); (0x00B13,0x00B28), `Delta (0); (0x00B2A,0x00B30), `Delta (0); (0x00B32,0x00B33), `Delta (0); (0x00B35,0x00B39), `Delta (0); (0x00B3D,0x00B3D), `Abs (0x00B3D); (0x00B5C,0x00B5D), `Delta (0); (0x00B5F,0x00B61), `Delta (0); (0x00B71,0x00B71), `Abs (0x00B71); (0x00B83,0x00B83), `Abs (0x00B83); (0x00B85,0x00B8A), `Delta (0); (0x00B8E,0x00B90), `Delta (0); (0x00B92,0x00B95), `Delta (0); (0x00B99,0x00B9A), `Delta (0); (0x00B9C,0x00B9C), `Abs (0x00B9C); (0x00B9E,0x00B9F), `Delta (0); (0x00BA3,0x00BA4), `Delta (0); (0x00BA8,0x00BAA), `Delta (0); (0x00BAE,0x00BB9), `Delta (0); (0x00BD0,0x00BD0), `Abs (0x00BD0); (0x00C05,0x00C0C), `Delta (0); (0x00C0E,0x00C10), `Delta (0); (0x00C12,0x00C28), `Delta (0); (0x00C2A,0x00C39), `Delta (0); (0x00C3D,0x00C3D), `Abs (0x00C3D); (0x00C58,0x00C5A), `Delta (0); (0x00C60,0x00C61), `Delta (0); (0x00C80,0x00C80), `Abs (0x00C80); (0x00C85,0x00C8C), `Delta (0); (0x00C8E,0x00C90), `Delta (0); (0x00C92,0x00CA8), `Delta (0); (0x00CAA,0x00CB3), `Delta (0); (0x00CB5,0x00CB9), `Delta (0); (0x00CBD,0x00CBD), `Abs (0x00CBD); (0x00CDE,0x00CDE), `Abs (0x00CDE); (0x00CE0,0x00CE1), `Delta (0); (0x00CF1,0x00CF2), `Delta (0); (0x00D05,0x00D0C), `Delta (0); (0x00D0E,0x00D10), `Delta (0); (0x00D12,0x00D3A), `Delta (0); (0x00D3D,0x00D3D), `Abs (0x00D3D); (0x00D4E,0x00D4E), `Abs (0x00D4E); (0x00D54,0x00D56), `Delta (0); (0x00D5F,0x00D61), `Delta (0); (0x00D7A,0x00D7F), `Delta (0); (0x00D85,0x00D96), `Delta (0); (0x00D9A,0x00DB1), `Delta (0); (0x00DB3,0x00DBB), `Delta (0); (0x00DBD,0x00DBD), `Abs (0x00DBD); (0x00DC0,0x00DC6), `Delta (0); (0x00E01,0x00E30), `Delta (0); (0x00E32,0x00E33), `Delta (0); (0x00E40,0x00E45), `Delta (0); (0x00E81,0x00E82), `Delta (0); (0x00E84,0x00E84), `Abs (0x00E84); (0x00E87,0x00E88), `Delta (0); (0x00E8A,0x00E8A), `Abs (0x00E8A); (0x00E8D,0x00E8D), `Abs (0x00E8D); (0x00E94,0x00E97), `Delta (0); (0x00E99,0x00E9F), `Delta (0); (0x00EA1,0x00EA3), `Delta (0); (0x00EA5,0x00EA5), `Abs (0x00EA5); (0x00EA7,0x00EA7), `Abs (0x00EA7); (0x00EAA,0x00EAB), `Delta (0); (0x00EAD,0x00EB0), `Delta (0); (0x00EB2,0x00EB3), `Delta (0); (0x00EBD,0x00EBD), `Abs (0x00EBD); (0x00EC0,0x00EC4), `Delta (0); (0x00EDC,0x00EDF), `Delta (0); (0x00F00,0x00F00), `Abs (0x00F00); (0x00F40,0x00F47), `Delta (0); (0x00F49,0x00F6C), `Delta (0); (0x00F88,0x00F8C), `Delta (0); (0x01000,0x0102A), `Delta (0); (0x0103F,0x0103F), `Abs (0x0103F); (0x01050,0x01055), `Delta (0); (0x0105A,0x0105D), `Delta (0); (0x01061,0x01061), `Abs (0x01061); (0x01065,0x01066), `Delta (0); (0x0106E,0x01070), `Delta (0); (0x01075,0x01081), `Delta (0); (0x0108E,0x0108E), `Abs (0x0108E); (0x010D0,0x010FA), `Delta (0); (0x010FD,0x01248), `Delta (0); (0x0124A,0x0124D), `Delta (0); (0x01250,0x01256), `Delta (0); (0x01258,0x01258), `Abs (0x01258); (0x0125A,0x0125D), `Delta (0); (0x01260,0x01288), `Delta (0); (0x0128A,0x0128D), `Delta (0); (0x01290,0x012B0), `Delta (0); (0x012B2,0x012B5), `Delta (0); (0x012B8,0x012BE), `Delta (0); (0x012C0,0x012C0), `Abs (0x012C0); (0x012C2,0x012C5), `Delta (0); (0x012C8,0x012D6), `Delta (0); (0x012D8,0x01310), `Delta (0); (0x01312,0x01315), `Delta (0); (0x01318,0x0135A), `Delta (0); (0x01380,0x0138F), `Delta (0); (0x01401,0x0166C), `Delta (0); (0x0166F,0x0167F), `Delta (0); (0x01681,0x0169A), `Delta (0); (0x016A0,0x016EA), `Delta (0); (0x016F1,0x016F8), `Delta (0); (0x01700,0x0170C), `Delta (0); (0x0170E,0x01711), `Delta (0); (0x01720,0x01731), `Delta (0); (0x01740,0x01751), `Delta (0); (0x01760,0x0176C), `Delta (0); (0x0176E,0x01770), `Delta (0); (0x01780,0x017B3), `Delta (0); (0x017DC,0x017DC), `Abs (0x017DC); (0x01820,0x01842), `Delta (0); (0x01844,0x01877), `Delta (0); (0x01880,0x01884), `Delta (0); (0x01887,0x018A8), `Delta (0); (0x018AA,0x018AA), `Abs (0x018AA); (0x018B0,0x018F5), `Delta (0); (0x01900,0x0191E), `Delta (0); (0x01950,0x0196D), `Delta (0); (0x01970,0x01974), `Delta (0); (0x01980,0x019AB), `Delta (0); (0x019B0,0x019C9), `Delta (0); (0x01A00,0x01A16), `Delta (0); (0x01A20,0x01A54), `Delta (0); (0x01B05,0x01B33), `Delta (0); (0x01B45,0x01B4B), `Delta (0); (0x01B83,0x01BA0), `Delta (0); (0x01BAE,0x01BAF), `Delta (0); (0x01BBA,0x01BE5), `Delta (0); (0x01C00,0x01C23), `Delta (0); (0x01C4D,0x01C4F), `Delta (0); (0x01C5A,0x01C77), `Delta (0); (0x01CE9,0x01CEC), `Delta (0); (0x01CEE,0x01CF1), `Delta (0); (0x01CF5,0x01CF6), `Delta (0); (0x02135,0x02138), `Delta (0); (0x02D30,0x02D67), `Delta (0); (0x02D80,0x02D96), `Delta (0); (0x02DA0,0x02DA6), `Delta (0); (0x02DA8,0x02DAE), `Delta (0); (0x02DB0,0x02DB6), `Delta (0); (0x02DB8,0x02DBE), `Delta (0); (0x02DC0,0x02DC6), `Delta (0); (0x02DC8,0x02DCE), `Delta (0); (0x02DD0,0x02DD6), `Delta (0); (0x02DD8,0x02DDE), `Delta (0); (0x03006,0x03006), `Abs (0x03006); (0x0303C,0x0303C), `Abs (0x0303C); (0x03041,0x03096), `Delta (0); (0x0309F,0x0309F), `Abs (0x0309F); (0x030A1,0x030FA), `Delta (0); (0x030FF,0x030FF), `Abs (0x030FF); (0x03105,0x0312D), `Delta (0); (0x03131,0x0318E), `Delta (0); (0x031A0,0x031BA), `Delta (0); (0x031F0,0x031FF), `Delta (0); (0x03400,0x04DB5), `Delta (0); (0x04E00,0x09FD5), `Delta (0); (0x0A000,0x0A014), `Delta (0); (0x0A016,0x0A48C), `Delta (0); (0x0A4D0,0x0A4F7), `Delta (0); (0x0A500,0x0A60B), `Delta (0); (0x0A610,0x0A61F), `Delta (0); (0x0A62A,0x0A62B), `Delta (0); (0x0A66E,0x0A66E), `Abs (0x0A66E); (0x0A6A0,0x0A6E5), `Delta (0); (0x0A78F,0x0A78F), `Abs (0x0A78F); (0x0A7F7,0x0A7F7), `Abs (0x0A7F7); (0x0A7FB,0x0A801), `Delta (0); (0x0A803,0x0A805), `Delta (0); (0x0A807,0x0A80A), `Delta (0); (0x0A80C,0x0A822), `Delta (0); (0x0A840,0x0A873), `Delta (0); (0x0A882,0x0A8B3), `Delta (0); (0x0A8F2,0x0A8F7), `Delta (0); (0x0A8FB,0x0A8FB), `Abs (0x0A8FB); (0x0A8FD,0x0A8FD), `Abs (0x0A8FD); (0x0A90A,0x0A925), `Delta (0); (0x0A930,0x0A946), `Delta (0); (0x0A960,0x0A97C), `Delta (0); (0x0A984,0x0A9B2), `Delta (0); (0x0A9E0,0x0A9E4), `Delta (0); (0x0A9E7,0x0A9EF), `Delta (0); (0x0A9FA,0x0A9FE), `Delta (0); (0x0AA00,0x0AA28), `Delta (0); (0x0AA40,0x0AA42), `Delta (0); (0x0AA44,0x0AA4B), `Delta (0); (0x0AA60,0x0AA6F), `Delta (0); (0x0AA71,0x0AA76), `Delta (0); (0x0AA7A,0x0AA7A), `Abs (0x0AA7A); (0x0AA7E,0x0AAAF), `Delta (0); (0x0AAB1,0x0AAB1), `Abs (0x0AAB1); (0x0AAB5,0x0AAB6), `Delta (0); (0x0AAB9,0x0AABD), `Delta (0); (0x0AAC0,0x0AAC0), `Abs (0x0AAC0); (0x0AAC2,0x0AAC2), `Abs (0x0AAC2); (0x0AADB,0x0AADC), `Delta (0); (0x0AAE0,0x0AAEA), `Delta (0); (0x0AAF2,0x0AAF2), `Abs (0x0AAF2); (0x0AB01,0x0AB06), `Delta (0); (0x0AB09,0x0AB0E), `Delta (0); (0x0AB11,0x0AB16), `Delta (0); (0x0AB20,0x0AB26), `Delta (0); (0x0AB28,0x0AB2E), `Delta (0); (0x0ABC0,0x0ABE2), `Delta (0); (0x0AC00,0x0D7A3), `Delta (0); (0x0D7B0,0x0D7C6), `Delta (0); (0x0D7CB,0x0D7FB), `Delta (0); (0x0F900,0x0FA6D), `Delta (0); (0x0FA70,0x0FAD9), `Delta (0); (0x0FB1D,0x0FB1D), `Abs (0x0FB1D); (0x0FB1F,0x0FB28), `Delta (0); (0x0FB2A,0x0FB36), `Delta (0); (0x0FB38,0x0FB3C), `Delta (0); (0x0FB3E,0x0FB3E), `Abs (0x0FB3E); (0x0FB40,0x0FB41), `Delta (0); (0x0FB43,0x0FB44), `Delta (0); (0x0FB46,0x0FBB1), `Delta (0); (0x0FBD3,0x0FD3D), `Delta (0); (0x0FD50,0x0FD8F), `Delta (0); (0x0FD92,0x0FDC7), `Delta (0); (0x0FDF0,0x0FDFB), `Delta (0); (0x0FE70,0x0FE74), `Delta (0); (0x0FE76,0x0FEFC), `Delta (0); (0x0FF66,0x0FF6F), `Delta (0); (0x0FF71,0x0FF9D), `Delta (0); (0x0FFA0,0x0FFBE), `Delta (0); (0x0FFC2,0x0FFC7), `Delta (0); (0x0FFCA,0x0FFCF), `Delta (0); (0x0FFD2,0x0FFD7), `Delta (0); (0x0FFDA,0x0FFDC), `Delta (0); (0x10000,0x1000B), `Delta (0); (0x1000D,0x10026), `Delta (0); (0x10028,0x1003A), `Delta (0); (0x1003C,0x1003D), `Delta (0); (0x1003F,0x1004D), `Delta (0); (0x10050,0x1005D), `Delta (0); (0x10080,0x100FA), `Delta (0); (0x10280,0x1029C), `Delta (0); (0x102A0,0x102D0), `Delta (0); (0x10300,0x1031F), `Delta (0); (0x10330,0x10340), `Delta (0); (0x10342,0x10349), `Delta (0); (0x10350,0x10375), `Delta (0); (0x10380,0x1039D), `Delta (0); (0x103A0,0x103C3), `Delta (0); (0x103C8,0x103CF), `Delta (0); (0x10450,0x1049D), `Delta (0); (0x10500,0x10527), `Delta (0); (0x10530,0x10563), `Delta (0); (0x10600,0x10736), `Delta (0); (0x10740,0x10755), `Delta (0); (0x10760,0x10767), `Delta (0); (0x10800,0x10805), `Delta (0); (0x10808,0x10808), `Abs (0x10808); (0x1080A,0x10835), `Delta (0); (0x10837,0x10838), `Delta (0); (0x1083C,0x1083C), `Abs (0x1083C); (0x1083F,0x10855), `Delta (0); (0x10860,0x10876), `Delta (0); (0x10880,0x1089E), `Delta (0); (0x108E0,0x108F2), `Delta (0); (0x108F4,0x108F5), `Delta (0); (0x10900,0x10915), `Delta (0); (0x10920,0x10939), `Delta (0); (0x10980,0x109B7), `Delta (0); (0x109BE,0x109BF), `Delta (0); (0x10A00,0x10A00), `Abs (0x10A00); (0x10A10,0x10A13), `Delta (0); (0x10A15,0x10A17), `Delta (0); (0x10A19,0x10A33), `Delta (0); (0x10A60,0x10A7C), `Delta (0); (0x10A80,0x10A9C), `Delta (0); (0x10AC0,0x10AC7), `Delta (0); (0x10AC9,0x10AE4), `Delta (0); (0x10B00,0x10B35), `Delta (0); (0x10B40,0x10B55), `Delta (0); (0x10B60,0x10B72), `Delta (0); (0x10B80,0x10B91), `Delta (0); (0x10C00,0x10C48), `Delta (0); (0x11003,0x11037), `Delta (0); (0x11083,0x110AF), `Delta (0); (0x110D0,0x110E8), `Delta (0); (0x11103,0x11126), `Delta (0); (0x11150,0x11172), `Delta (0); (0x11176,0x11176), `Abs (0x11176); (0x11183,0x111B2), `Delta (0); (0x111C1,0x111C4), `Delta (0); (0x111DA,0x111DA), `Abs (0x111DA); (0x111DC,0x111DC), `Abs (0x111DC); (0x11200,0x11211), `Delta (0); (0x11213,0x1122B), `Delta (0); (0x11280,0x11286), `Delta (0); (0x11288,0x11288), `Abs (0x11288); (0x1128A,0x1128D), `Delta (0); (0x1128F,0x1129D), `Delta (0); (0x1129F,0x112A8), `Delta (0); (0x112B0,0x112DE), `Delta (0); (0x11305,0x1130C), `Delta (0); (0x1130F,0x11310), `Delta (0); (0x11313,0x11328), `Delta (0); (0x1132A,0x11330), `Delta (0); (0x11332,0x11333), `Delta (0); (0x11335,0x11339), `Delta (0); (0x1133D,0x1133D), `Abs (0x1133D); (0x11350,0x11350), `Abs (0x11350); (0x1135D,0x11361), `Delta (0); (0x11400,0x11434), `Delta (0); (0x11447,0x1144A), `Delta (0); (0x11480,0x114AF), `Delta (0); (0x114C4,0x114C5), `Delta (0); (0x114C7,0x114C7), `Abs (0x114C7); (0x11580,0x115AE), `Delta (0); (0x115D8,0x115DB), `Delta (0); (0x11600,0x1162F), `Delta (0); (0x11644,0x11644), `Abs (0x11644); (0x11680,0x116AA), `Delta (0); (0x11700,0x11719), `Delta (0); (0x118FF,0x118FF), `Abs (0x118FF); (0x11AC0,0x11AF8), `Delta (0); (0x11C00,0x11C08), `Delta (0); (0x11C0A,0x11C2E), `Delta (0); (0x11C40,0x11C40), `Abs (0x11C40); (0x11C72,0x11C8F), `Delta (0); (0x12000,0x12399), `Delta (0); (0x12480,0x12543), `Delta (0); (0x13000,0x1342E), `Delta (0); (0x14400,0x14646), `Delta (0); (0x16800,0x16A38), `Delta (0); (0x16A40,0x16A5E), `Delta (0); (0x16AD0,0x16AED), `Delta (0); (0x16B00,0x16B2F), `Delta (0); (0x16B63,0x16B77), `Delta (0); (0x16B7D,0x16B8F), `Delta (0); (0x16F00,0x16F44), `Delta (0); (0x16F50,0x16F50), `Abs (0x16F50); (0x17000,0x187EC), `Delta (0); (0x18800,0x18AF2), `Delta (0); (0x1B000,0x1B001), `Delta (0); (0x1BC00,0x1BC6A), `Delta (0); (0x1BC70,0x1BC7C), `Delta (0); (0x1BC80,0x1BC88), `Delta (0); (0x1BC90,0x1BC99), `Delta (0); (0x1E800,0x1E8C4), `Delta (0); (0x1EE00,0x1EE03), `Delta (0); (0x1EE05,0x1EE1F), `Delta (0); (0x1EE21,0x1EE22), `Delta (0); (0x1EE24,0x1EE24), `Abs (0x1EE24); (0x1EE27,0x1EE27), `Abs (0x1EE27); (0x1EE29,0x1EE32), `Delta (0); (0x1EE34,0x1EE37), `Delta (0); (0x1EE39,0x1EE39), `Abs (0x1EE39); (0x1EE3B,0x1EE3B), `Abs (0x1EE3B); (0x1EE42,0x1EE42), `Abs (0x1EE42); (0x1EE47,0x1EE47), `Abs (0x1EE47); (0x1EE49,0x1EE49), `Abs (0x1EE49); (0x1EE4B,0x1EE4B), `Abs (0x1EE4B); (0x1EE4D,0x1EE4F), `Delta (0); (0x1EE51,0x1EE52), `Delta (0); (0x1EE54,0x1EE54), `Abs (0x1EE54); (0x1EE57,0x1EE57), `Abs (0x1EE57); (0x1EE59,0x1EE59), `Abs (0x1EE59); (0x1EE5B,0x1EE5B), `Abs (0x1EE5B); (0x1EE5D,0x1EE5D), `Abs (0x1EE5D); (0x1EE5F,0x1EE5F), `Abs (0x1EE5F); (0x1EE61,0x1EE62), `Delta (0); (0x1EE64,0x1EE64), `Abs (0x1EE64); (0x1EE67,0x1EE6A), `Delta (0); (0x1EE6C,0x1EE72), `Delta (0); (0x1EE74,0x1EE77), `Delta (0); (0x1EE79,0x1EE7C), `Delta (0); (0x1EE7E,0x1EE7E), `Abs (0x1EE7E); (0x1EE80,0x1EE89), `Delta (0); (0x1EE8B,0x1EE9B), `Delta (0); (0x1EEA1,0x1EEA3), `Delta (0); (0x1EEA5,0x1EEA9), `Delta (0); (0x1EEAB,0x1EEBB), `Delta (0); (0x20000,0x2A6D6), `Delta (0); (0x2A700,0x2B734), `Delta (0); (0x2B740,0x2B81D), `Delta (0); (0x2B820,0x2CEA1), `Delta (0); (0x2F800,0x2FA1D), `Delta (0); (0x0005F,0x0005F), `Abs (0x0005F); (0x0203F,0x02040), `Delta (0); (0x02054,0x02054), `Abs (0x02054); (0x0FE33,0x0FE34), `Delta (0); (0x0FE4D,0x0FE4F), `Delta (0); (0x0FF3F,0x0FF3F), `Abs (0x0FF3F); (0x0002D,0x0002D), `Abs (0x0002D); (0x0058A,0x0058A), `Abs (0x0058A); (0x005BE,0x005BE), `Abs (0x005BE); (0x01400,0x01400), `Abs (0x01400); (0x01806,0x01806), `Abs (0x01806); (0x02010,0x02015), `Delta (0); (0x02E17,0x02E17), `Abs (0x02E17); (0x02E1A,0x02E1A), `Abs (0x02E1A); (0x02E3A,0x02E3B), `Delta (0); (0x02E40,0x02E40), `Abs (0x02E40); (0x0301C,0x0301C), `Abs (0x0301C); (0x03030,0x03030), `Abs (0x03030); (0x030A0,0x030A0), `Abs (0x030A0); (0x0FE31,0x0FE32), `Delta (0); (0x0FE58,0x0FE58), `Abs (0x0FE58); (0x0FE63,0x0FE63), `Abs (0x0FE63); (0x0FF0D,0x0FF0D), `Abs (0x0FF0D); (0x00028,0x00028), `Abs (0x00028); (0x0005B,0x0005B), `Abs (0x0005B); (0x0007B,0x0007B), `Abs (0x0007B); (0x00F3A,0x00F3A), `Abs (0x00F3A); (0x00F3C,0x00F3C), `Abs (0x00F3C); (0x0169B,0x0169B), `Abs (0x0169B); (0x0201A,0x0201A), `Abs (0x0201A); (0x0201E,0x0201E), `Abs (0x0201E); (0x02045,0x02045), `Abs (0x02045); (0x0207D,0x0207D), `Abs (0x0207D); (0x0208D,0x0208D), `Abs (0x0208D); (0x02308,0x02308), `Abs (0x02308); (0x0230A,0x0230A), `Abs (0x0230A); (0x02329,0x02329), `Abs (0x02329); (0x02768,0x02768), `Abs (0x02768); (0x0276A,0x0276A), `Abs (0x0276A); (0x0276C,0x0276C), `Abs (0x0276C); (0x0276E,0x0276E), `Abs (0x0276E); (0x02770,0x02770), `Abs (0x02770); (0x02772,0x02772), `Abs (0x02772); (0x02774,0x02774), `Abs (0x02774); (0x027C5,0x027C5), `Abs (0x027C5); (0x027E6,0x027E6), `Abs (0x027E6); (0x027E8,0x027E8), `Abs (0x027E8); (0x027EA,0x027EA), `Abs (0x027EA); (0x027EC,0x027EC), `Abs (0x027EC); (0x027EE,0x027EE), `Abs (0x027EE); (0x02983,0x02983), `Abs (0x02983); (0x02985,0x02985), `Abs (0x02985); (0x02987,0x02987), `Abs (0x02987); (0x02989,0x02989), `Abs (0x02989); (0x0298B,0x0298B), `Abs (0x0298B); (0x0298D,0x0298D), `Abs (0x0298D); (0x0298F,0x0298F), `Abs (0x0298F); (0x02991,0x02991), `Abs (0x02991); (0x02993,0x02993), `Abs (0x02993); (0x02995,0x02995), `Abs (0x02995); (0x02997,0x02997), `Abs (0x02997); (0x029D8,0x029D8), `Abs (0x029D8); (0x029DA,0x029DA), `Abs (0x029DA); (0x029FC,0x029FC), `Abs (0x029FC); (0x02E22,0x02E22), `Abs (0x02E22); (0x02E24,0x02E24), `Abs (0x02E24); (0x02E26,0x02E26), `Abs (0x02E26); (0x02E28,0x02E28), `Abs (0x02E28); (0x02E42,0x02E42), `Abs (0x02E42); (0x03008,0x03008), `Abs (0x03008); (0x0300A,0x0300A), `Abs (0x0300A); (0x0300C,0x0300C), `Abs (0x0300C); (0x0300E,0x0300E), `Abs (0x0300E); (0x03010,0x03010), `Abs (0x03010); (0x03014,0x03014), `Abs (0x03014); (0x03016,0x03016), `Abs (0x03016); (0x03018,0x03018), `Abs (0x03018); (0x0301A,0x0301A), `Abs (0x0301A); (0x0301D,0x0301D), `Abs (0x0301D); (0x0FD3F,0x0FD3F), `Abs (0x0FD3F); (0x0FE17,0x0FE17), `Abs (0x0FE17); (0x0FE35,0x0FE35), `Abs (0x0FE35); (0x0FE37,0x0FE37), `Abs (0x0FE37); (0x0FE39,0x0FE39), `Abs (0x0FE39); (0x0FE3B,0x0FE3B), `Abs (0x0FE3B); (0x0FE3D,0x0FE3D), `Abs (0x0FE3D); (0x0FE3F,0x0FE3F), `Abs (0x0FE3F); (0x0FE41,0x0FE41), `Abs (0x0FE41); (0x0FE43,0x0FE43), `Abs (0x0FE43); (0x0FE47,0x0FE47), `Abs (0x0FE47); (0x0FE59,0x0FE59), `Abs (0x0FE59); (0x0FE5B,0x0FE5B), `Abs (0x0FE5B); (0x0FE5D,0x0FE5D), `Abs (0x0FE5D); (0x0FF08,0x0FF08), `Abs (0x0FF08); (0x0FF3B,0x0FF3B), `Abs (0x0FF3B); (0x0FF5B,0x0FF5B), `Abs (0x0FF5B); (0x0FF5F,0x0FF5F), `Abs (0x0FF5F); (0x0FF62,0x0FF62), `Abs (0x0FF62); (0x00029,0x00029), `Abs (0x00029); (0x0005D,0x0005D), `Abs (0x0005D); (0x0007D,0x0007D), `Abs (0x0007D); (0x00F3B,0x00F3B), `Abs (0x00F3B); (0x00F3D,0x00F3D), `Abs (0x00F3D); (0x0169C,0x0169C), `Abs (0x0169C); (0x02046,0x02046), `Abs (0x02046); (0x0207E,0x0207E), `Abs (0x0207E); (0x0208E,0x0208E), `Abs (0x0208E); (0x02309,0x02309), `Abs (0x02309); (0x0230B,0x0230B), `Abs (0x0230B); (0x0232A,0x0232A), `Abs (0x0232A); (0x02769,0x02769), `Abs (0x02769); (0x0276B,0x0276B), `Abs (0x0276B); (0x0276D,0x0276D), `Abs (0x0276D); (0x0276F,0x0276F), `Abs (0x0276F); (0x02771,0x02771), `Abs (0x02771); (0x02773,0x02773), `Abs (0x02773); (0x02775,0x02775), `Abs (0x02775); (0x027C6,0x027C6), `Abs (0x027C6); (0x027E7,0x027E7), `Abs (0x027E7); (0x027E9,0x027E9), `Abs (0x027E9); (0x027EB,0x027EB), `Abs (0x027EB); (0x027ED,0x027ED), `Abs (0x027ED); (0x027EF,0x027EF), `Abs (0x027EF); (0x02984,0x02984), `Abs (0x02984); (0x02986,0x02986), `Abs (0x02986); (0x02988,0x02988), `Abs (0x02988); (0x0298A,0x0298A), `Abs (0x0298A); (0x0298C,0x0298C), `Abs (0x0298C); (0x0298E,0x0298E), `Abs (0x0298E); (0x02990,0x02990), `Abs (0x02990); (0x02992,0x02992), `Abs (0x02992); (0x02994,0x02994), `Abs (0x02994); (0x02996,0x02996), `Abs (0x02996); (0x02998,0x02998), `Abs (0x02998); (0x029D9,0x029D9), `Abs (0x029D9); (0x029DB,0x029DB), `Abs (0x029DB); (0x029FD,0x029FD), `Abs (0x029FD); (0x02E23,0x02E23), `Abs (0x02E23); (0x02E25,0x02E25), `Abs (0x02E25); (0x02E27,0x02E27), `Abs (0x02E27); (0x02E29,0x02E29), `Abs (0x02E29); (0x03009,0x03009), `Abs (0x03009); (0x0300B,0x0300B), `Abs (0x0300B); (0x0300D,0x0300D), `Abs (0x0300D); (0x0300F,0x0300F), `Abs (0x0300F); (0x03011,0x03011), `Abs (0x03011); (0x03015,0x03015), `Abs (0x03015); (0x03017,0x03017), `Abs (0x03017); (0x03019,0x03019), `Abs (0x03019); (0x0301B,0x0301B), `Abs (0x0301B); (0x0301E,0x0301F), `Delta (0); (0x0FD3E,0x0FD3E), `Abs (0x0FD3E); (0x0FE18,0x0FE18), `Abs (0x0FE18); (0x0FE36,0x0FE36), `Abs (0x0FE36); (0x0FE38,0x0FE38), `Abs (0x0FE38); (0x0FE3A,0x0FE3A), `Abs (0x0FE3A); (0x0FE3C,0x0FE3C), `Abs (0x0FE3C); (0x0FE3E,0x0FE3E), `Abs (0x0FE3E); (0x0FE40,0x0FE40), `Abs (0x0FE40); (0x0FE42,0x0FE42), `Abs (0x0FE42); (0x0FE44,0x0FE44), `Abs (0x0FE44); (0x0FE48,0x0FE48), `Abs (0x0FE48); (0x0FE5A,0x0FE5A), `Abs (0x0FE5A); (0x0FE5C,0x0FE5C), `Abs (0x0FE5C); (0x0FE5E,0x0FE5E), `Abs (0x0FE5E); (0x0FF09,0x0FF09), `Abs (0x0FF09); (0x0FF3D,0x0FF3D), `Abs (0x0FF3D); (0x0FF5D,0x0FF5D), `Abs (0x0FF5D); (0x0FF60,0x0FF60), `Abs (0x0FF60); (0x0FF63,0x0FF63), `Abs (0x0FF63); (0x000AB,0x000AB), `Abs (0x000AB); (0x02018,0x02018), `Abs (0x02018); (0x0201B,0x0201C), `Delta (0); (0x0201F,0x0201F), `Abs (0x0201F); (0x02039,0x02039), `Abs (0x02039); (0x02E02,0x02E02), `Abs (0x02E02); (0x02E04,0x02E04), `Abs (0x02E04); (0x02E09,0x02E09), `Abs (0x02E09); (0x02E0C,0x02E0C), `Abs (0x02E0C); (0x02E1C,0x02E1C), `Abs (0x02E1C); (0x02E20,0x02E20), `Abs (0x02E20); (0x000BB,0x000BB), `Abs (0x000BB); (0x02019,0x02019), `Abs (0x02019); (0x0201D,0x0201D), `Abs (0x0201D); (0x0203A,0x0203A), `Abs (0x0203A); (0x02E03,0x02E03), `Abs (0x02E03); (0x02E05,0x02E05), `Abs (0x02E05); (0x02E0A,0x02E0A), `Abs (0x02E0A); (0x02E0D,0x02E0D), `Abs (0x02E0D); (0x02E1D,0x02E1D), `Abs (0x02E1D); (0x02E21,0x02E21), `Abs (0x02E21); (0x00021,0x00023), `Delta (0); (0x00025,0x00027), `Delta (0); (0x0002A,0x0002A), `Abs (0x0002A); (0x0002C,0x0002C), `Abs (0x0002C); (0x0002E,0x0002F), `Delta (0); (0x0003A,0x0003B), `Delta (0); (0x0003F,0x00040), `Delta (0); (0x0005C,0x0005C), `Abs (0x0005C); (0x000A1,0x000A1), `Abs (0x000A1); (0x000A7,0x000A7), `Abs (0x000A7); (0x000B6,0x000B7), `Delta (0); (0x000BF,0x000BF), `Abs (0x000BF); (0x0037E,0x0037E), `Abs (0x0037E); (0x00387,0x00387), `Abs (0x00387); (0x0055A,0x0055F), `Delta (0); (0x00589,0x00589), `Abs (0x00589); (0x005C0,0x005C0), `Abs (0x005C0); (0x005C3,0x005C3), `Abs (0x005C3); (0x005C6,0x005C6), `Abs (0x005C6); (0x005F3,0x005F4), `Delta (0); (0x00609,0x0060A), `Delta (0); (0x0060C,0x0060D), `Delta (0); (0x0061B,0x0061B), `Abs (0x0061B); (0x0061E,0x0061F), `Delta (0); (0x0066A,0x0066D), `Delta (0); (0x006D4,0x006D4), `Abs (0x006D4); (0x00700,0x0070D), `Delta (0); (0x007F7,0x007F9), `Delta (0); (0x00830,0x0083E), `Delta (0); (0x0085E,0x0085E), `Abs (0x0085E); (0x00964,0x00965), `Delta (0); (0x00970,0x00970), `Abs (0x00970); (0x00AF0,0x00AF0), `Abs (0x00AF0); (0x00DF4,0x00DF4), `Abs (0x00DF4); (0x00E4F,0x00E4F), `Abs (0x00E4F); (0x00E5A,0x00E5B), `Delta (0); (0x00F04,0x00F12), `Delta (0); (0x00F14,0x00F14), `Abs (0x00F14); (0x00F85,0x00F85), `Abs (0x00F85); (0x00FD0,0x00FD4), `Delta (0); (0x00FD9,0x00FDA), `Delta (0); (0x0104A,0x0104F), `Delta (0); (0x010FB,0x010FB), `Abs (0x010FB); (0x01360,0x01368), `Delta (0); (0x0166D,0x0166E), `Delta (0); (0x016EB,0x016ED), `Delta (0); (0x01735,0x01736), `Delta (0); (0x017D4,0x017D6), `Delta (0); (0x017D8,0x017DA), `Delta (0); (0x01800,0x01805), `Delta (0); (0x01807,0x0180A), `Delta (0); (0x01944,0x01945), `Delta (0); (0x01A1E,0x01A1F), `Delta (0); (0x01AA0,0x01AA6), `Delta (0); (0x01AA8,0x01AAD), `Delta (0); (0x01B5A,0x01B60), `Delta (0); (0x01BFC,0x01BFF), `Delta (0); (0x01C3B,0x01C3F), `Delta (0); (0x01C7E,0x01C7F), `Delta (0); (0x01CC0,0x01CC7), `Delta (0); (0x01CD3,0x01CD3), `Abs (0x01CD3); (0x02016,0x02017), `Delta (0); (0x02020,0x02027), `Delta (0); (0x02030,0x02038), `Delta (0); (0x0203B,0x0203E), `Delta (0); (0x02041,0x02043), `Delta (0); (0x02047,0x02051), `Delta (0); (0x02053,0x02053), `Abs (0x02053); (0x02055,0x0205E), `Delta (0); (0x02CF9,0x02CFC), `Delta (0); (0x02CFE,0x02CFF), `Delta (0); (0x02D70,0x02D70), `Abs (0x02D70); (0x02E00,0x02E01), `Delta (0); (0x02E06,0x02E08), `Delta (0); (0x02E0B,0x02E0B), `Abs (0x02E0B); (0x02E0E,0x02E16), `Delta (0); (0x02E18,0x02E19), `Delta (0); (0x02E1B,0x02E1B), `Abs (0x02E1B); (0x02E1E,0x02E1F), `Delta (0); (0x02E2A,0x02E2E), `Delta (0); (0x02E30,0x02E39), `Delta (0); (0x02E3C,0x02E3F), `Delta (0); (0x02E41,0x02E41), `Abs (0x02E41); (0x02E43,0x02E44), `Delta (0); (0x03001,0x03003), `Delta (0); (0x0303D,0x0303D), `Abs (0x0303D); (0x030FB,0x030FB), `Abs (0x030FB); (0x0A4FE,0x0A4FF), `Delta (0); (0x0A60D,0x0A60F), `Delta (0); (0x0A673,0x0A673), `Abs (0x0A673); (0x0A67E,0x0A67E), `Abs (0x0A67E); (0x0A6F2,0x0A6F7), `Delta (0); (0x0A874,0x0A877), `Delta (0); (0x0A8CE,0x0A8CF), `Delta (0); (0x0A8F8,0x0A8FA), `Delta (0); (0x0A8FC,0x0A8FC), `Abs (0x0A8FC); (0x0A92E,0x0A92F), `Delta (0); (0x0A95F,0x0A95F), `Abs (0x0A95F); (0x0A9C1,0x0A9CD), `Delta (0); (0x0A9DE,0x0A9DF), `Delta (0); (0x0AA5C,0x0AA5F), `Delta (0); (0x0AADE,0x0AADF), `Delta (0); (0x0AAF0,0x0AAF1), `Delta (0); (0x0ABEB,0x0ABEB), `Abs (0x0ABEB); (0x0FE10,0x0FE16), `Delta (0); (0x0FE19,0x0FE19), `Abs (0x0FE19); (0x0FE30,0x0FE30), `Abs (0x0FE30); (0x0FE45,0x0FE46), `Delta (0); (0x0FE49,0x0FE4C), `Delta (0); (0x0FE50,0x0FE52), `Delta (0); (0x0FE54,0x0FE57), `Delta (0); (0x0FE5F,0x0FE61), `Delta (0); (0x0FE68,0x0FE68), `Abs (0x0FE68); (0x0FE6A,0x0FE6B), `Delta (0); (0x0FF01,0x0FF03), `Delta (0); (0x0FF05,0x0FF07), `Delta (0); (0x0FF0A,0x0FF0A), `Abs (0x0FF0A); (0x0FF0C,0x0FF0C), `Abs (0x0FF0C); (0x0FF0E,0x0FF0F), `Delta (0); (0x0FF1A,0x0FF1B), `Delta (0); (0x0FF1F,0x0FF20), `Delta (0); (0x0FF3C,0x0FF3C), `Abs (0x0FF3C); (0x0FF61,0x0FF61), `Abs (0x0FF61); (0x0FF64,0x0FF65), `Delta (0); (0x10100,0x10102), `Delta (0); (0x1039F,0x1039F), `Abs (0x1039F); (0x103D0,0x103D0), `Abs (0x103D0); (0x1056F,0x1056F), `Abs (0x1056F); (0x10857,0x10857), `Abs (0x10857); (0x1091F,0x1091F), `Abs (0x1091F); (0x1093F,0x1093F), `Abs (0x1093F); (0x10A50,0x10A58), `Delta (0); (0x10A7F,0x10A7F), `Abs (0x10A7F); (0x10AF0,0x10AF6), `Delta (0); (0x10B39,0x10B3F), `Delta (0); (0x10B99,0x10B9C), `Delta (0); (0x11047,0x1104D), `Delta (0); (0x110BB,0x110BC), `Delta (0); (0x110BE,0x110C1), `Delta (0); (0x11140,0x11143), `Delta (0); (0x11174,0x11175), `Delta (0); (0x111C5,0x111C9), `Delta (0); (0x111CD,0x111CD), `Abs (0x111CD); (0x111DB,0x111DB), `Abs (0x111DB); (0x111DD,0x111DF), `Delta (0); (0x11238,0x1123D), `Delta (0); (0x112A9,0x112A9), `Abs (0x112A9); (0x1144B,0x1144F), `Delta (0); (0x1145B,0x1145B), `Abs (0x1145B); (0x1145D,0x1145D), `Abs (0x1145D); (0x114C6,0x114C6), `Abs (0x114C6); (0x115C1,0x115D7), `Delta (0); (0x11641,0x11643), `Delta (0); (0x11660,0x1166C), `Delta (0); (0x1173C,0x1173E), `Delta (0); (0x11C41,0x11C45), `Delta (0); (0x11C70,0x11C71), `Delta (0); (0x12470,0x12474), `Delta (0); (0x16A6E,0x16A6F), `Delta (0); (0x16AF5,0x16AF5), `Abs (0x16AF5); (0x16B37,0x16B3B), `Delta (0); (0x16B44,0x16B44), `Abs (0x16B44); (0x1BC9F,0x1BC9F), `Abs (0x1BC9F); (0x1DA87,0x1DA8B), `Delta (0); (0x1E95E,0x1E95F), `Delta (0); (0x0002B,0x0002B), `Abs (0x0002B); (0x0003C,0x0003E), `Delta (0); (0x0007C,0x0007C), `Abs (0x0007C); (0x0007E,0x0007E), `Abs (0x0007E); (0x000AC,0x000AC), `Abs (0x000AC); (0x000B1,0x000B1), `Abs (0x000B1); (0x000D7,0x000D7), `Abs (0x000D7); (0x000F7,0x000F7), `Abs (0x000F7); (0x003F6,0x003F6), `Abs (0x003F6); (0x00606,0x00608), `Delta (0); (0x02044,0x02044), `Abs (0x02044); (0x02052,0x02052), `Abs (0x02052); (0x0207A,0x0207C), `Delta (0); (0x0208A,0x0208C), `Delta (0); (0x02118,0x02118), `Abs (0x02118); (0x02140,0x02144), `Delta (0); (0x0214B,0x0214B), `Abs (0x0214B); (0x02190,0x02194), `Delta (0); (0x0219A,0x0219B), `Delta (0); (0x021A0,0x021A0), `Abs (0x021A0); (0x021A3,0x021A3), `Abs (0x021A3); (0x021A6,0x021A6), `Abs (0x021A6); (0x021AE,0x021AE), `Abs (0x021AE); (0x021CE,0x021CF), `Delta (0); (0x021D2,0x021D2), `Abs (0x021D2); (0x021D4,0x021D4), `Abs (0x021D4); (0x021F4,0x022FF), `Delta (0); (0x02320,0x02321), `Delta (0); (0x0237C,0x0237C), `Abs (0x0237C); (0x0239B,0x023B3), `Delta (0); (0x023DC,0x023E1), `Delta (0); (0x025B7,0x025B7), `Abs (0x025B7); (0x025C1,0x025C1), `Abs (0x025C1); (0x025F8,0x025FF), `Delta (0); (0x0266F,0x0266F), `Abs (0x0266F); (0x027C0,0x027C4), `Delta (0); (0x027C7,0x027E5), `Delta (0); (0x027F0,0x027FF), `Delta (0); (0x02900,0x02982), `Delta (0); (0x02999,0x029D7), `Delta (0); (0x029DC,0x029FB), `Delta (0); (0x029FE,0x02AFF), `Delta (0); (0x02B30,0x02B44), `Delta (0); (0x02B47,0x02B4C), `Delta (0); (0x0FB29,0x0FB29), `Abs (0x0FB29); (0x0FE62,0x0FE62), `Abs (0x0FE62); (0x0FE64,0x0FE66), `Delta (0); (0x0FF0B,0x0FF0B), `Abs (0x0FF0B); (0x0FF1C,0x0FF1E), `Delta (0); (0x0FF5C,0x0FF5C), `Abs (0x0FF5C); (0x0FF5E,0x0FF5E), `Abs (0x0FF5E); (0x0FFE2,0x0FFE2), `Abs (0x0FFE2); (0x0FFE9,0x0FFEC), `Delta (0); (0x1D6C1,0x1D6C1), `Abs (0x1D6C1); (0x1D6DB,0x1D6DB), `Abs (0x1D6DB); (0x1D6FB,0x1D6FB), `Abs (0x1D6FB); (0x1D715,0x1D715), `Abs (0x1D715); (0x1D735,0x1D735), `Abs (0x1D735); (0x1D74F,0x1D74F), `Abs (0x1D74F); (0x1D76F,0x1D76F), `Abs (0x1D76F); (0x1D789,0x1D789), `Abs (0x1D789); (0x1D7A9,0x1D7A9), `Abs (0x1D7A9); (0x1D7C3,0x1D7C3), `Abs (0x1D7C3); (0x1EEF0,0x1EEF1), `Delta (0); (0x00024,0x00024), `Abs (0x00024); (0x000A2,0x000A5), `Delta (0); (0x0058F,0x0058F), `Abs (0x0058F); (0x0060B,0x0060B), `Abs (0x0060B); (0x009F2,0x009F3), `Delta (0); (0x009FB,0x009FB), `Abs (0x009FB); (0x00AF1,0x00AF1), `Abs (0x00AF1); (0x00BF9,0x00BF9), `Abs (0x00BF9); (0x00E3F,0x00E3F), `Abs (0x00E3F); (0x017DB,0x017DB), `Abs (0x017DB); (0x020A0,0x020BE), `Delta (0); (0x0A838,0x0A838), `Abs (0x0A838); (0x0FDFC,0x0FDFC), `Abs (0x0FDFC); (0x0FE69,0x0FE69), `Abs (0x0FE69); (0x0FF04,0x0FF04), `Abs (0x0FF04); (0x0FFE0,0x0FFE1), `Delta (0); (0x0FFE5,0x0FFE6), `Delta (0); (0x0005E,0x0005E), `Abs (0x0005E); (0x00060,0x00060), `Abs (0x00060); (0x000A8,0x000A8), `Abs (0x000A8); (0x000AF,0x000AF), `Abs (0x000AF); (0x000B4,0x000B4), `Abs (0x000B4); (0x000B8,0x000B8), `Abs (0x000B8); (0x002C2,0x002C5), `Delta (0); (0x002D2,0x002DF), `Delta (0); (0x002E5,0x002EB), `Delta (0); (0x002ED,0x002ED), `Abs (0x002ED); (0x002EF,0x002FF), `Delta (0); (0x00375,0x00375), `Abs (0x00375); (0x00384,0x00385), `Delta (0); (0x01FBD,0x01FBD), `Abs (0x01FBD); (0x01FBF,0x01FC1), `Delta (0); (0x01FCD,0x01FCF), `Delta (0); (0x01FDD,0x01FDF), `Delta (0); (0x01FED,0x01FEF), `Delta (0); (0x01FFD,0x01FFE), `Delta (0); (0x0309B,0x0309C), `Delta (0); (0x0A700,0x0A716), `Delta (0); (0x0A720,0x0A721), `Delta (0); (0x0A789,0x0A78A), `Delta (0); (0x0AB5B,0x0AB5B), `Abs (0x0AB5B); (0x0FBB2,0x0FBC1), `Delta (0); (0x0FF3E,0x0FF3E), `Abs (0x0FF3E); (0x0FF40,0x0FF40), `Abs (0x0FF40); (0x0FFE3,0x0FFE3), `Abs (0x0FFE3); (0x1F3FB,0x1F3FF), `Delta (0); (0x000A6,0x000A6), `Abs (0x000A6); (0x000A9,0x000A9), `Abs (0x000A9); (0x000AE,0x000AE), `Abs (0x000AE); (0x000B0,0x000B0), `Abs (0x000B0); (0x00482,0x00482), `Abs (0x00482); (0x0058D,0x0058E), `Delta (0); (0x0060E,0x0060F), `Delta (0); (0x006DE,0x006DE), `Abs (0x006DE); (0x006E9,0x006E9), `Abs (0x006E9); (0x006FD,0x006FE), `Delta (0); (0x007F6,0x007F6), `Abs (0x007F6); (0x009FA,0x009FA), `Abs (0x009FA); (0x00B70,0x00B70), `Abs (0x00B70); (0x00BF3,0x00BF8), `Delta (0); (0x00BFA,0x00BFA), `Abs (0x00BFA); (0x00C7F,0x00C7F), `Abs (0x00C7F); (0x00D4F,0x00D4F), `Abs (0x00D4F); (0x00D79,0x00D79), `Abs (0x00D79); (0x00F01,0x00F03), `Delta (0); (0x00F13,0x00F13), `Abs (0x00F13); (0x00F15,0x00F17), `Delta (0); (0x00F1A,0x00F1F), `Delta (0); (0x00F34,0x00F34), `Abs (0x00F34); (0x00F36,0x00F36), `Abs (0x00F36); (0x00F38,0x00F38), `Abs (0x00F38); (0x00FBE,0x00FC5), `Delta (0); (0x00FC7,0x00FCC), `Delta (0); (0x00FCE,0x00FCF), `Delta (0); (0x00FD5,0x00FD8), `Delta (0); (0x0109E,0x0109F), `Delta (0); (0x01390,0x01399), `Delta (0); (0x01940,0x01940), `Abs (0x01940); (0x019DE,0x019FF), `Delta (0); (0x01B61,0x01B6A), `Delta (0); (0x01B74,0x01B7C), `Delta (0); (0x02100,0x02101), `Delta (0); (0x02103,0x02106), `Delta (0); (0x02108,0x02109), `Delta (0); (0x02114,0x02114), `Abs (0x02114); (0x02116,0x02117), `Delta (0); (0x0211E,0x02123), `Delta (0); (0x02125,0x02125), `Abs (0x02125); (0x02127,0x02127), `Abs (0x02127); (0x02129,0x02129), `Abs (0x02129); (0x0212E,0x0212E), `Abs (0x0212E); (0x0213A,0x0213B), `Delta (0); (0x0214A,0x0214A), `Abs (0x0214A); (0x0214C,0x0214D), `Delta (0); (0x0214F,0x0214F), `Abs (0x0214F); (0x0218A,0x0218B), `Delta (0); (0x02195,0x02199), `Delta (0); (0x0219C,0x0219F), `Delta (0); (0x021A1,0x021A2), `Delta (0); (0x021A4,0x021A5), `Delta (0); (0x021A7,0x021AD), `Delta (0); (0x021AF,0x021CD), `Delta (0); (0x021D0,0x021D1), `Delta (0); (0x021D3,0x021D3), `Abs (0x021D3); (0x021D5,0x021F3), `Delta (0); (0x02300,0x02307), `Delta (0); (0x0230C,0x0231F), `Delta (0); (0x02322,0x02328), `Delta (0); (0x0232B,0x0237B), `Delta (0); (0x0237D,0x0239A), `Delta (0); (0x023B4,0x023DB), `Delta (0); (0x023E2,0x023FE), `Delta (0); (0x02400,0x02426), `Delta (0); (0x02440,0x0244A), `Delta (0); (0x0249C,0x024B5), `Delta (0); (0x024B6,0x024CF), `Delta (26); (0x024D0,0x024E9), `Delta (0); (0x02500,0x025B6), `Delta (0); (0x025B8,0x025C0), `Delta (0); (0x025C2,0x025F7), `Delta (0); (0x02600,0x0266E), `Delta (0); (0x02670,0x02767), `Delta (0); (0x02794,0x027BF), `Delta (0); (0x02800,0x028FF), `Delta (0); (0x02B00,0x02B2F), `Delta (0); (0x02B45,0x02B46), `Delta (0); (0x02B4D,0x02B73), `Delta (0); (0x02B76,0x02B95), `Delta (0); (0x02B98,0x02BB9), `Delta (0); (0x02BBD,0x02BC8), `Delta (0); (0x02BCA,0x02BD1), `Delta (0); (0x02BEC,0x02BEF), `Delta (0); (0x02CE5,0x02CEA), `Delta (0); (0x02E80,0x02E99), `Delta (0); (0x02E9B,0x02EF3), `Delta (0); (0x02F00,0x02FD5), `Delta (0); (0x02FF0,0x02FFB), `Delta (0); (0x03004,0x03004), `Abs (0x03004); (0x03012,0x03013), `Delta (0); (0x03020,0x03020), `Abs (0x03020); (0x03036,0x03037), `Delta (0); (0x0303E,0x0303F), `Delta (0); (0x03190,0x03191), `Delta (0); (0x03196,0x0319F), `Delta (0); (0x031C0,0x031E3), `Delta (0); (0x03200,0x0321E), `Delta (0); (0x0322A,0x03247), `Delta (0); (0x03250,0x03250), `Abs (0x03250); (0x03260,0x0327F), `Delta (0); (0x0328A,0x032B0), `Delta (0); (0x032C0,0x032FE), `Delta (0); (0x03300,0x033FF), `Delta (0); (0x04DC0,0x04DFF), `Delta (0); (0x0A490,0x0A4C6), `Delta (0); (0x0A828,0x0A82B), `Delta (0); (0x0A836,0x0A837), `Delta (0); (0x0A839,0x0A839), `Abs (0x0A839); (0x0AA77,0x0AA79), `Delta (0); (0x0FDFD,0x0FDFD), `Abs (0x0FDFD); (0x0FFE4,0x0FFE4), `Abs (0x0FFE4); (0x0FFE8,0x0FFE8), `Abs (0x0FFE8); (0x0FFED,0x0FFEE), `Delta (0); (0x0FFFC,0x0FFFD), `Delta (0); (0x10137,0x1013F), `Delta (0); (0x10179,0x10189), `Delta (0); (0x1018C,0x1018E), `Delta (0); (0x10190,0x1019B), `Delta (0); (0x101A0,0x101A0), `Abs (0x101A0); (0x101D0,0x101FC), `Delta (0); (0x10877,0x10878), `Delta (0); (0x10AC8,0x10AC8), `Abs (0x10AC8); (0x1173F,0x1173F), `Abs (0x1173F); (0x16B3C,0x16B3F), `Delta (0); (0x16B45,0x16B45), `Abs (0x16B45); (0x1BC9C,0x1BC9C), `Abs (0x1BC9C); (0x1D000,0x1D0F5), `Delta (0); (0x1D100,0x1D126), `Delta (0); (0x1D129,0x1D164), `Delta (0); (0x1D16A,0x1D16C), `Delta (0); (0x1D183,0x1D184), `Delta (0); (0x1D18C,0x1D1A9), `Delta (0); (0x1D1AE,0x1D1E8), `Delta (0); (0x1D200,0x1D241), `Delta (0); (0x1D245,0x1D245), `Abs (0x1D245); (0x1D300,0x1D356), `Delta (0); (0x1D800,0x1D9FF), `Delta (0); (0x1DA37,0x1DA3A), `Delta (0); (0x1DA6D,0x1DA74), `Delta (0); (0x1DA76,0x1DA83), `Delta (0); (0x1DA85,0x1DA86), `Delta (0); (0x1F000,0x1F02B), `Delta (0); (0x1F030,0x1F093), `Delta (0); (0x1F0A0,0x1F0AE), `Delta (0); (0x1F0B1,0x1F0BF), `Delta (0); (0x1F0C1,0x1F0CF), `Delta (0); (0x1F0D1,0x1F0F5), `Delta (0); (0x1F110,0x1F12E), `Delta (0); (0x1F130,0x1F16B), `Delta (0); (0x1F170,0x1F1AC), `Delta (0); (0x1F1E6,0x1F202), `Delta (0); (0x1F210,0x1F23B), `Delta (0); (0x1F240,0x1F248), `Delta (0); (0x1F250,0x1F251), `Delta (0); (0x1F300,0x1F3FA), `Delta (0); (0x1F400,0x1F6D2), `Delta (0); (0x1F6E0,0x1F6EC), `Delta (0); (0x1F6F0,0x1F6F6), `Delta (0); (0x1F700,0x1F773), `Delta (0); (0x1F780,0x1F7D4), `Delta (0); (0x1F800,0x1F80B), `Delta (0); (0x1F810,0x1F847), `Delta (0); (0x1F850,0x1F859), `Delta (0); (0x1F860,0x1F887), `Delta (0); (0x1F890,0x1F8AD), `Delta (0); (0x1F910,0x1F91E), `Delta (0); (0x1F920,0x1F927), `Delta (0); (0x1F930,0x1F930), `Abs (0x1F930); (0x1F933,0x1F93E), `Delta (0); (0x1F940,0x1F94B), `Delta (0); (0x1F950,0x1F95E), `Delta (0); (0x1F980,0x1F991), `Delta (0) ];; let gen_one na (data:(int*int) list) f = Printf.fprintf f "let %s : (int * int) list = Marshal.from_string %S 0\n\n" na (Marshal.to_string data []) let gen_lower (data:((int * int) * [> `Abs of int | `Delta of int ]) list) f = Printf.fprintf f "let to_lower : ((int * int) * [> `Abs of int | `Delta of int ]) list = Marshal.from_string %S 0" (Marshal.to_string data []) let gen () = let f = Sys.argv.(1) in let ch = open_out_bin f in gen_one "lu" lu ch; gen_one "ll" ll ch; gen_one "lt" lt ch; gen_one "mn" mn ch; gen_one "mc" mc ch; gen_one "me" me ch; gen_one "nd" nd ch; gen_one "nl" nl ch; gen_one "no" no ch; gen_one "zs" zs ch; gen_one "zl" zl ch; gen_one "zp" zp ch; gen_one "cc" cc ch; gen_one "cf" cf ch; gen_one "cs" cs ch; gen_one "co" co ch; gen_one "cn" cn ch; gen_one "lm" lm ch; gen_one "lo" lo ch; gen_one "pc" pc ch; gen_one "pd" pd ch; gen_one "ps" ps ch; gen_one "pe" pe ch; gen_one "pi" pi ch; gen_one "pf" pf ch; gen_one "po" po ch; gen_one "sm" sm ch; gen_one "sc" sc ch; gen_one "sk" sk ch; gen_one "so" so ch; gen_lower to_lower ch; close_out ch let () = gen () coq-8.20.0/clib/unicodetable_gen.mli000066400000000000000000000000001466560755400172760ustar00rootroot00000000000000coq-8.20.0/clib/unionfind.ml000066400000000000000000000073301466560755400156440ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* t (** Add (in place) an element in the partition, or do nothing if the element is already in the partition. *) val add : elt -> t -> unit (** Find the canonical representative of an element. Raise [not_found] if the element isn't known yet. *) val find : elt -> t -> elt (** Merge (in place) the equivalence classes of two elements. This will add the elements in the partition if necessary. *) val union : elt -> elt -> t -> unit (** Merge (in place) the equivalence classes of many elements. *) val union_set : set -> t -> unit (** Listing the different components of the partition *) val partition : t -> set list end module type SetS = sig type t type elt val singleton : elt -> t val union : t -> t -> t val choose : t -> elt val iter : (elt -> unit) -> t -> unit end module type MapS = sig type key type +'a t val empty : 'a t val find : key -> 'a t -> 'a val add : key -> 'a -> 'a t -> 'a t val mem : key -> 'a t -> bool val fold : (key -> 'a -> 'b -> 'b) -> 'a t -> 'b -> 'b end module Make (S:SetS)(M:MapS with type key = S.elt) = struct type elt = S.elt type set = S.t type node = | Canon of set | Equiv of elt type t = node ref M.t ref let create () = ref (M.empty : node ref M.t) let fresh x p = let node = ref (Canon (S.singleton x)) in p := M.add x node !p; x, node let rec lookup x p = let node = M.find x !p in match !node with | Canon _ -> x, node | Equiv y -> let ((z,_) as res) = lookup y p in if not (z == y) then node := Equiv z; res let add x p = if not (M.mem x !p) then ignore (fresh x p) let find x p = fst (lookup x p) let canonical x p = try lookup x p with Not_found -> fresh x p let union x y p = let ((x,_) as xcan) = canonical x p in let ((y,_) as ycan) = canonical y p in if x = y then () else let xcan, ycan = if x < y then xcan, ycan else ycan, xcan in let x,xnode = xcan and y,ynode = ycan in match !xnode, !ynode with | Canon lx, Canon ly -> xnode := Canon (S.union lx ly); ynode := Equiv x; | _ -> assert false let union_set s p = try let x = S.choose s in S.iter (fun y -> union x y p) s with Not_found -> () let partition p = List.rev (M.fold (fun x node acc -> match !node with | Equiv _ -> acc | Canon lx -> lx::acc) !p []) end coq-8.20.0/clib/unionfind.mli000066400000000000000000000050651466560755400160200ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* t (** Add (in place) an element in the partition, or do nothing if the element is already in the partition. *) val add : elt -> t -> unit (** Find the canonical representative of an element. Raise [not_found] if the element isn't known yet. *) val find : elt -> t -> elt (** Merge (in place) the equivalence classes of two elements. This will add the elements in the partition if necessary. *) val union : elt -> elt -> t -> unit (** Merge (in place) the equivalence classes of many elements. *) val union_set : set -> t -> unit (** Listing the different components of the partition *) val partition : t -> set list end module type SetS = sig type t type elt val singleton : elt -> t val union : t -> t -> t val choose : t -> elt val iter : (elt -> unit) -> t -> unit end (** Minimal interface for sets, subtype of stdlib's Set. *) module type MapS = sig type key type +'a t val empty : 'a t val find : key -> 'a t -> 'a val add : key -> 'a -> 'a t -> 'a t val mem : key -> 'a t -> bool val fold : (key -> 'a -> 'b -> 'b) -> 'a t -> 'b -> 'b end (** Minimal interface for maps, subtype of stdlib's Map. *) module Make : functor (S:SetS) -> functor (_:MapS with type key = S.elt) -> PartitionSig with type elt = S.elt and type set = S.t coq-8.20.0/config/000077500000000000000000000000001466560755400136525ustar00rootroot00000000000000coq-8.20.0/config/coq_byte_config.mli000066400000000000000000000003141466560755400175050ustar00rootroot00000000000000(* Functions that should be used differently depending on the OCaml version *) val toploop_use_silently : Format.formatter -> string -> bool val compenv_handle_exit_with_status_0 : (unit -> unit) -> unit coq-8.20.0/config/coq_config.mli000066400000000000000000000052461466560755400164730ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* [||] let () = Array.sort compare plugins let () = Array.iter (fun f -> let f' = "plugins/"^f in if Sys.is_directory f' && f.[0] <> '.' then print_endline f) plugins coq-8.20.0/config/list_plugins.mli000066400000000000000000000000001466560755400170570ustar00rootroot00000000000000coq-8.20.0/configure000077500000000000000000000006201466560755400143120ustar00rootroot00000000000000#!/bin/sh ## This micro-configure shell script is here only to ## launch the real configuration via ocaml configure=./tools/configure/configure.exe ## Check that dune is available, provide an error message otherwise if ! command -v dune > /dev/null then 1>&2 echo "Dune could not be found, please ensure you have a working OCaml enviroment" exit 1 fi dune exec --root . -- $configure "$@" coq-8.20.0/coq-core.opam000066400000000000000000000037211466560755400147760ustar00rootroot00000000000000# This file is generated by dune, edit dune-project instead opam-version: "2.0" version: "dev" synopsis: "The Coq Proof Assistant -- Core Binaries and Tools" description: """ Coq is a formal proof management system. It provides a formal language to write mathematical definitions, executable algorithms and theorems together with an environment for semi-interactive development of machine-checked proofs. Typical applications include the certification of properties of programming languages (e.g. the CompCert compiler certification project, or the Bedrock verified low-level programming library), the formalization of mathematics (e.g. the full formalization of the Feit-Thompson theorem or homotopy type theory) and teaching. This package includes the Coq core binaries, plugins, and tools, but not the vernacular standard library. Note that in this setup, Coq needs to be started with the -boot and -noinit options, as will otherwise fail to find the regular Coq prelude, now living in the coq-stdlib package.""" maintainer: ["The Coq development team "] authors: ["The Coq development team, INRIA, CNRS, and contributors"] license: "LGPL-2.1-only" homepage: "https://coq.inria.fr/" doc: "https://coq.github.io/doc/" bug-reports: "https://github.com/coq/coq/issues" depends: [ "dune" {>= "3.6" & >= "3.6.1"} "ocaml" {>= "4.09.0"} "ocamlfind" {>= "1.8.1"} "zarith" {>= "1.11"} "conf-linux-libc-dev" {os = "linux"} "odoc" {with-doc} ] depopts: ["coq-native" "memprof-limits" "memtrace"] dev-repo: "git+https://github.com/coq/coq.git" build: [ ["dune" "subst"] {dev} [ "./configure" "-prefix" prefix "-mandir" man "-libdir" "%{lib}%/coq" "-native-compiler" "yes" {coq-native:installed} "no" {!coq-native:installed} ] [ "dune" "build" "-p" name "-j" jobs "--promote-install-files=false" "@install" "@runtest" {with-test} "@doc" {with-doc} ] ["dune" "install" "-p" name "--create-install-files" name] ] coq-8.20.0/coq-core.opam.template000066400000000000000000000006621466560755400166110ustar00rootroot00000000000000build: [ ["dune" "subst"] {dev} [ "./configure" "-prefix" prefix "-mandir" man "-libdir" "%{lib}%/coq" "-native-compiler" "yes" {coq-native:installed} "no" {!coq-native:installed} ] [ "dune" "build" "-p" name "-j" jobs "--promote-install-files=false" "@install" "@runtest" {with-test} "@doc" {with-doc} ] ["dune" "install" "-p" name "--create-install-files" name] ] coq-8.20.0/coq-doc.opam000066400000000000000000000020161466560755400146070ustar00rootroot00000000000000# This file is generated by dune, edit dune-project instead opam-version: "2.0" version: "dev" synopsis: "The Coq Proof Assistant --- Reference Manual" description: """ Coq is a formal proof management system. It provides a formal language to write mathematical definitions, executable algorithms and theorems together with an environment for semi-interactive development of machine-checked proofs. This package provides the Coq Reference Manual.""" maintainer: ["The Coq development team "] authors: ["The Coq development team, INRIA, CNRS, and contributors"] license: "OPUBL-1.0" homepage: "https://coq.inria.fr/" doc: "https://coq.github.io/doc/" bug-reports: "https://github.com/coq/coq/issues" depends: [ "dune" {>= "3.6"} "conf-python-3" {build} "coq" {build & = version} "odoc" {with-doc} ] build: [ ["dune" "subst"] {dev} [ "dune" "build" "-p" name "-j" jobs "@install" "@runtest" {with-test} "@doc" {with-doc} ] ] dev-repo: "git+https://github.com/coq/coq.git" coq-8.20.0/coq-stdlib.opam000066400000000000000000000031771466560755400153340ustar00rootroot00000000000000# This file is generated by dune, edit dune-project instead opam-version: "2.0" version: "dev" synopsis: "The Coq Proof Assistant -- Standard Library" description: """ Coq is a formal proof management system. It provides a formal language to write mathematical definitions, executable algorithms and theorems together with an environment for semi-interactive development of machine-checked proofs. Typical applications include the certification of properties of programming languages (e.g. the CompCert compiler certification project, or the Bedrock verified low-level programming library), the formalization of mathematics (e.g. the full formalization of the Feit-Thompson theorem or homotopy type theory) and teaching. This package includes the Coq Standard Library, that is to say, the set of modules usually bound to the Coq.* namespace.""" maintainer: ["The Coq development team "] authors: ["The Coq development team, INRIA, CNRS, and contributors"] license: "LGPL-2.1-only" homepage: "https://coq.inria.fr/" doc: "https://coq.github.io/doc/" bug-reports: "https://github.com/coq/coq/issues" depends: [ "dune" {>= "3.6"} "coq-core" {= version} "odoc" {with-doc} ] depopts: ["coq-native"] dev-repo: "git+https://github.com/coq/coq.git" build: [ ["dune" "subst"] {dev} # We tell dunestrap to use coq-config from coq-core [ make "dunestrap" "COQ_DUNE_EXTRA_OPT=-split" "DUNESTRAPOPT=-p coq-stdlib"] [ "dune" "build" "-p" name "-j" jobs "--promote-install-files=false" "@install" "@runtest" {with-test} "@doc" {with-doc} ] ["dune" "install" "-p" name "--create-install-files" name] ] coq-8.20.0/coq-stdlib.opam.template000066400000000000000000000006151466560755400171400ustar00rootroot00000000000000build: [ ["dune" "subst"] {dev} # We tell dunestrap to use coq-config from coq-core [ make "dunestrap" "COQ_DUNE_EXTRA_OPT=-split" "DUNESTRAPOPT=-p coq-stdlib"] [ "dune" "build" "-p" name "-j" jobs "--promote-install-files=false" "@install" "@runtest" {with-test} "@doc" {with-doc} ] ["dune" "install" "-p" name "--create-install-files" name] ] coq-8.20.0/coq.opam000066400000000000000000000032221466560755400140440ustar00rootroot00000000000000# This file is generated by dune, edit dune-project instead opam-version: "2.0" version: "dev" synopsis: "The Coq Proof Assistant" description: """ Coq is a formal proof management system. It provides a formal language to write mathematical definitions, executable algorithms and theorems together with an environment for semi-interactive development of machine-checked proofs. Typical applications include the certification of properties of programming languages (e.g. the CompCert compiler certification project, or the Bedrock verified low-level programming library), the formalization of mathematics (e.g. the full formalization of the Feit-Thompson theorem or homotopy type theory) and teaching.""" maintainer: ["The Coq development team "] authors: ["The Coq development team, INRIA, CNRS, and contributors"] license: "LGPL-2.1-only" homepage: "https://coq.inria.fr/" doc: "https://coq.github.io/doc/" bug-reports: "https://github.com/coq/coq/issues" depends: [ "dune" {>= "3.6"} "coq-core" {= version} "coq-stdlib" {= version} "coqide-server" {= version} "ounit2" {with-test} "conf-python-3" {with-test} "conf-time" {with-test} "odoc" {with-doc} ] dev-repo: "git+https://github.com/coq/coq.git" build: [ ["dune" "subst"] {dev} [ "./configure" "-prefix" prefix "-mandir" man "-libdir" "%{lib}%/coq" "-native-compiler" "yes" {coq-native:installed} "no" {!coq-native:installed} ] {with-test} [ "dune" "build" "-p" name "-j" jobs "--promote-install-files=false" "@install" "@runtest" {with-test} "@doc" {with-doc} ] ["dune" "install" "-p" name "--create-install-files" name] ] coq-8.20.0/coq.opam.template000066400000000000000000000006761466560755400156700ustar00rootroot00000000000000build: [ ["dune" "subst"] {dev} [ "./configure" "-prefix" prefix "-mandir" man "-libdir" "%{lib}%/coq" "-native-compiler" "yes" {coq-native:installed} "no" {!coq-native:installed} ] {with-test} [ "dune" "build" "-p" name "-j" jobs "--promote-install-files=false" "@install" "@runtest" {with-test} "@doc" {with-doc} ] ["dune" "install" "-p" name "--create-install-files" name] ] coq-8.20.0/coqide-server.opam000066400000000000000000000022661466560755400160410ustar00rootroot00000000000000# This file is generated by dune, edit dune-project instead opam-version: "2.0" version: "dev" synopsis: "The Coq Proof Assistant, XML protocol server" description: """ Coq is a formal proof management system. It provides a formal language to write mathematical definitions, executable algorithms and theorems together with an environment for semi-interactive development of machine-checked proofs. This package provides the `coqidetop` language server, an implementation of Coq's [XML protocol](https://github.com/coq/coq/blob/master/dev/doc/xml-protocol.md) which allows clients, such as CoqIDE, to interact with Coq in a structured way.""" maintainer: ["The Coq development team "] authors: ["The Coq development team, INRIA, CNRS, and contributors"] license: "LGPL-2.1-only" homepage: "https://coq.inria.fr/" doc: "https://coq.github.io/doc/" bug-reports: "https://github.com/coq/coq/issues" depends: [ "dune" {>= "3.6"} "coq-core" {= version} "odoc" {with-doc} ] build: [ ["dune" "subst"] {dev} [ "dune" "build" "-p" name "-j" jobs "@install" "@runtest" {with-test} "@doc" {with-doc} ] ] dev-repo: "git+https://github.com/coq/coq.git" coq-8.20.0/coqide.opam000066400000000000000000000023261466560755400145320ustar00rootroot00000000000000# This file is generated by dune, edit dune-project instead opam-version: "2.0" version: "dev" synopsis: "The Coq Proof Assistant --- GTK3 IDE" description: """ Coq is a formal proof management system. It provides a formal language to write mathematical definitions, executable algorithms and theorems together with an environment for semi-interactive development of machine-checked proofs. This package provides the CoqIDE, a graphical user interface for the development of interactive proofs.""" maintainer: ["The Coq development team "] authors: ["The Coq development team, INRIA, CNRS, and contributors"] license: "LGPL-2.1-only" homepage: "https://coq.inria.fr/" doc: "https://coq.github.io/doc/" bug-reports: "https://github.com/coq/coq/issues" depends: [ "dune" {>= "3.6"} "ocamlfind" {build} "conf-findutils" {build} "conf-adwaita-icon-theme" "coqide-server" {= version} "cairo2" {>= "0.6.4"} "lablgtk3-sourceview3" {>= "3.1.2" & (>= "3.1.5" | os != "windows")} "odoc" {with-doc} ] build: [ ["dune" "subst"] {dev} [ "dune" "build" "-p" name "-j" jobs "@install" "@runtest" {with-test} "@doc" {with-doc} ] ] dev-repo: "git+https://github.com/coq/coq.git" coq-8.20.0/coqpp/000077500000000000000000000000001466560755400135275ustar00rootroot00000000000000coq-8.20.0/coqpp/coqpp_ast.mli000066400000000000000000000074541466560755400162350ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* Coqpp_ast.loc val token : Lexing.lexbuf -> Coqpp_parse.token coq-8.20.0/coqpp/coqpp_lex.mll000066400000000000000000000131231466560755400162270ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* Buffer.add_string ocaml_buf "{" | Extend -> ocaml_start_pos := lexeme_start_p lexbuf in incr num_braces let end_ocaml lexbuf = let () = decr num_braces in if !num_braces < 0 then lex_error lexbuf "Unexpected end of OCaml code" else if !num_braces = 0 then let s = Buffer.contents ocaml_buf in let () = Buffer.reset ocaml_buf in let loc = Some { Coqpp_ast.loc_start = !ocaml_start_pos; Coqpp_ast.loc_end = lexeme_end_p lexbuf } in Some (CODE { Coqpp_ast.code = s; loc }) else let () = Buffer.add_string ocaml_buf "}" in None } let letter = ['a'-'z' 'A'-'Z'] let letterlike = ['_' 'a'-'z' 'A'-'Z'] let alphanum = ['_' 'a'-'z' 'A'-'Z' '0'-'9' '\''] let ident = letterlike alphanum* let qualid = ident ('.' ident)* let space = [' ' '\t' '\r'] let number = [ '0'-'9' ] rule extend = parse | "(*" { start_comment (); comment lexbuf } | "{" { start_ocaml lexbuf; ocaml lexbuf } | "GRAMMAR" { GRAMMAR } | "VERNAC" { VERNAC } | "COMMAND" { COMMAND } | "TACTIC" { TACTIC } | "EXTEND" { EXTEND } | "DOC_GRAMMAR" { DOC_GRAMMAR } | "END" { END } | "DECLARE" { DECLARE } | "PLUGIN" { PLUGIN } | "DEPRECATED" { DEPRECATED } | "CLASSIFIED" { CLASSIFIED } | "STATE" { STATE } | "PRINTED" { PRINTED } | "TYPED" { TYPED } | "INTERPRETED" { INTERPRETED } | "GLOBALIZED" { GLOBALIZED } | "SUBSTITUTED" { SUBSTITUTED } | "ARGUMENT" { ARGUMENT } | "RAW_PRINTED" { RAW_PRINTED } | "GLOB_PRINTED" { GLOB_PRINTED } | "SYNTERP" { SYNTERP } | "BY" { BY } | "AS" { AS } (** Camlp5 specific keywords *) | "GLOBAL" { GLOBAL } | "TOP" { TOP } | "FIRST" { FIRST } | "LAST" { LAST } | "BEFORE" { BEFORE } | "AFTER" { AFTER } | "LEVEL" { LEVEL } | "LEFTA" { LEFTA } | "RIGHTA" { RIGHTA } | "NONA" { NONA } (** Standard *) | ident { IDENT (Lexing.lexeme lexbuf) } | qualid { QUALID (Lexing.lexeme lexbuf) } | number { INT (int_of_string (Lexing.lexeme lexbuf)) } | space { extend lexbuf } | '\"' { string lexbuf } | '\n' { newline lexbuf; extend lexbuf } | "![" { BANGBRACKET } | "#[" { HASHBRACKET } | '[' { LBRACKET } | ']' { RBRACKET } | '|' { PIPE } | "->" { ARROW } | "=>" { FUN } | ',' { COMMA } | ':' { COLON } | ';' { SEMICOLON } | '(' { LPAREN } | ')' { RPAREN } | '=' { EQUAL } | '*' { STAR } | _ { lex_error lexbuf "syntax error" } | eof { EOF } and ocaml = parse | "{" { start_ocaml lexbuf; ocaml lexbuf } | "}" { match end_ocaml lexbuf with Some tk -> tk | None -> ocaml lexbuf } | '\n' { newline lexbuf; Buffer.add_char ocaml_buf '\n'; ocaml lexbuf } | '\"' { Buffer.add_char ocaml_buf '\"'; ocaml_string lexbuf } | (_ as c) { Buffer.add_char ocaml_buf c; ocaml lexbuf } | eof { lex_unexpected_eof lexbuf "OCaml code" } and comment = parse | "*)" { match end_comment lexbuf with Some _ -> extend lexbuf | None -> comment lexbuf } | "(*" { start_comment lexbuf; comment lexbuf } | '\n' { newline lexbuf; Buffer.add_char comment_buf '\n'; comment lexbuf } | (_ as c) { Buffer.add_char comment_buf c; comment lexbuf } | eof { lex_unexpected_eof lexbuf "comment" } and string = parse | '\"' { let s = Buffer.contents string_buf in let () = Buffer.reset string_buf in STRING s } | "\\\"" { Buffer.add_char string_buf '\"'; string lexbuf } | '\n' { newline lexbuf; Buffer.add_char string_buf '\n'; string lexbuf } | (_ as c) { Buffer.add_char string_buf c; string lexbuf } | eof { lex_unexpected_eof lexbuf "string" } and ocaml_string = parse | "\\\"" { Buffer.add_string ocaml_buf "\\\""; ocaml_string lexbuf } | '\"' { Buffer.add_char ocaml_buf '\"'; ocaml lexbuf } | (_ as c) { Buffer.add_char ocaml_buf c; ocaml_string lexbuf } | eof { lex_unexpected_eof lexbuf "OCaml string" } { let token lexbuf = match mode () with | OCaml -> ocaml lexbuf | Extend -> extend lexbuf } coq-8.20.0/coqpp/coqpp_main.ml000066400000000000000000000631501466560755400162140ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* fprintf fmt "%s" c.code | Some loc -> (* Print the line location as a source annotation *) let loc = loc.loc_start in let padding = String.make (loc.pos_cnum - loc.pos_bol + 1) ' ' in let code_insert = asprintf "\n# %i \"%s\"\n%s%s" loc.pos_lnum loc.pos_fname padding c.code in fprintf fmt "@[@<0>%s@]@\n" code_insert module StringSet = Set.Make(String) let string_split s = let len = String.length s in let rec split n = try let pos = String.index_from s n '.' in let dir = String.sub s n (pos-n) in dir :: split (succ pos) with | Not_found -> [String.sub s n (len-n)] in if len == 0 then [] else split 0 (* Used to generate unique ids *) let file_name = ref "" (* We used to output __plugin_name = "bla" then refer to __plugin_name in generated code but this is not robust to eg DECLARE PLUGIN "bla" open G_ltac use the plugin name since g_ltac has no mli its __plugin_name will shadow the local one and wreak havoc *) let plugin_name = ref None let force_is_plugin ~what () = match !plugin_name with | Some (Some n) -> n | Some None | None -> fatal ("DECLARE PLUGIN required before "^what) let check_is_plugin ~what () = match !plugin_name with | Some b -> b | None -> fatal ("DECLARE PLUGIN required before "^what) let print_list fmt pr l = let rec prl fmt = function | [] -> () | [x] -> fprintf fmt "%a" pr x | x :: l -> fprintf fmt "%a;@ %a" pr x prl l in fprintf fmt "@[[%a]@]" prl l let rec print_binders fmt = function | [] -> () | ExtTerminal _ :: rem -> print_binders fmt rem | ExtNonTerminal (_, TokNone) :: rem -> fprintf fmt "_@ %a" print_binders rem | ExtNonTerminal (_, TokName id) :: rem -> fprintf fmt "%s@ %a" id print_binders rem let rec print_symbol fmt = function | Ulist1 s -> fprintf fmt "@[Extend.TUlist1 (%a)@]" print_symbol s | Ulist1sep (s, sep) -> fprintf fmt "@[Extend.TUlist1sep (%a, \"%s\")@]" print_symbol s sep | Ulist0 s -> fprintf fmt "@[Extend.TUlist0 (%a)@]" print_symbol s | Ulist0sep (s, sep) -> fprintf fmt "@[Extend.TUlist0sep (%a, \"%s\")@]" print_symbol s sep | Uopt s -> fprintf fmt "@[Extend.TUopt (%a)@]" print_symbol s | Uentry e -> fprintf fmt "@[Extend.TUentry (Genarg.get_arg_tag wit_%s)@]" e | Uentryl (e, l) -> assert (e = "tactic"); fprintf fmt "@[Extend.TUentryl (Genarg.get_arg_tag wit_%s, %i)@]" e l let print_string fmt s = fprintf fmt "\"%s\"" s let print_opt fmt pr = function | None -> fprintf fmt "None" | Some x -> fprintf fmt "Some@ @[(%a)@]" pr x module GramExt : sig val print_extrule : Format.formatter -> (symb list * string option list * code) -> unit val print_ast : Format.formatter -> grammar_ext -> unit end = struct let is_uident s = match s.[0] with | 'A'..'Z' -> true | _ -> false let is_qualified = is_uident let get_local_entries ext = let global = StringSet.of_list ext.gramext_globals in let map e = e.gentry_name in let entries = List.map map ext.gramext_entries in let local = List.filter (fun e -> not (is_qualified e || StringSet.mem e global)) entries in let rec uniquize seen = function | [] -> [] | id :: rem -> let rem = uniquize (StringSet.add id seen) rem in if StringSet.mem id seen then rem else id :: rem in uniquize StringSet.empty local let print_local fmt ext = let locals = get_local_entries ext in match locals with | [] -> () | e :: locals -> let mk_e fmt e = fprintf fmt "Pcoq.Entry.make \"%s\"" e in let () = fprintf fmt "@[let %s =@ @[%a@]@]@ " e mk_e e in let iter e = fprintf fmt "@[and %s =@ @[%a@]@]@ " e mk_e e in let () = List.iter iter locals in fprintf fmt "in@ " let print_position fmt pos = match pos with | First -> fprintf fmt "Gramlib.Gramext.First" | Last -> fprintf fmt "Gramlib.Gramext.Last" | Before s -> fprintf fmt "Gramlib.Gramext.Before@ \"%s\"" s | After s -> fprintf fmt "Gramlib.Gramext.After@ \"%s\"" s let print_assoc fmt = function | LeftA -> fprintf fmt "Gramlib.Gramext.LeftA" | RightA -> fprintf fmt "Gramlib.Gramext.RightA" | NonA -> fprintf fmt "Gramlib.Gramext.NonA" let is_token s = match string_split s with | [s] -> is_uident s | _ -> false let rec parse_tokens ?(in_anon=false) = let err_anon () = if in_anon then fatal (Printf.sprintf "'SELF' or 'NEXT' illegal in anonymous entry level") in function | [GSymbString s] -> SymbToken ("", Some s) | [GSymbQualid ("QUOTATION", None); GSymbString s] -> SymbToken ("QUOTATION", Some s) | [GSymbQualid ("SELF", None)] -> err_anon (); SymbSelf | [GSymbQualid ("NEXT", None)] -> err_anon (); SymbNext | [GSymbQualid ("LIST0", None); tkn] -> SymbList0 (parse_token ~in_anon tkn, None) | [GSymbQualid ("LIST1", None); tkn] -> SymbList1 (parse_token ~in_anon tkn, None) | [GSymbQualid ("LIST0", None); tkn; GSymbQualid ("SEP", None); tkn'] -> SymbList0 (parse_token ~in_anon tkn, Some (parse_token ~in_anon tkn')) | [GSymbQualid ("LIST1", None); tkn; GSymbQualid ("SEP", None); tkn'] -> SymbList1 (parse_token ~in_anon tkn, Some (parse_token ~in_anon tkn')) | [GSymbQualid ("OPT", None); tkn] -> SymbOpt (parse_token ~in_anon tkn) | [GSymbQualid (e, None)] when is_token e -> SymbToken (e, None) | [GSymbQualid (e, None); GSymbString s] when is_token e -> SymbToken (e, Some s) | [GSymbQualid (e, lvl)] when not (is_token e) -> SymbEntry (e, lvl) | [GSymbParen tkns] -> parse_tokens ~in_anon tkns | [GSymbProd prds] -> let map p = let map (pat, tkns) = (pat, parse_tokens ~in_anon:true tkns) in (List.map map p.gprod_symbs, p.gprod_body) in SymbRules (List.map map prds) | t -> let rec db_token = function | GSymbString s -> Printf.sprintf "\"%s\"" s | GSymbQualid (s, _) -> Printf.sprintf "%s" s | GSymbParen s -> Printf.sprintf "(%s)" (db_tokens s) | GSymbProd _ -> Printf.sprintf "[...]" and db_tokens tkns = let s = List.map db_token tkns in String.concat " " s in fatal (Printf.sprintf "Invalid token: %s" (db_tokens t)) and parse_token ~in_anon tkn = parse_tokens ~in_anon [tkn] let print_fun fmt (vars, body) = let vars = List.rev vars in let iter = function | None -> fprintf fmt "_@ " | Some id -> fprintf fmt "%s@ " id in let () = fprintf fmt "fun@ " in let () = List.iter iter vars in let () = fprintf fmt "loc ->@ @[%a@]" print_code body in () (** Meta-program instead of calling Tok.of_pattern here because otherwise violates value restriction *) let print_tok fmt = let print_pat fmt = print_opt fmt print_string in function | "", Some s -> fprintf fmt "Tok.PKEYWORD (%a)" print_string s | "IDENT", s -> fprintf fmt "Tok.PIDENT (%a)" print_pat s | "PATTERNIDENT", s -> fprintf fmt "Tok.PPATTERNIDENT (%a)" print_pat s | "FIELD", s -> fprintf fmt "Tok.PFIELD (%a)" print_pat s | "NUMBER", None -> fprintf fmt "Tok.PNUMBER None" | "NUMBER", Some s -> fprintf fmt "Tok.PNUMBER (Some (NumTok.Unsigned.of_string %a))" print_string s | "STRING", s -> fprintf fmt "Tok.PSTRING (%a)" print_pat s | "LEFTQMARK", None -> fprintf fmt "Tok.PLEFTQMARK" | "BULLET", s -> fprintf fmt "Tok.PBULLET (%a)" print_pat s | "QUOTATION", Some s -> fprintf fmt "Tok.PQUOTATION %a" print_string s | "EOI", None -> fprintf fmt "Tok.PEOI" | _ -> failwith "Tok.of_pattern: not a constructor" let rec print_prod fmt p = let (vars, tkns) = List.split p.gprod_symbs in let tkn = List.map parse_tokens tkns in print_extrule fmt (tkn, vars, p.gprod_body) and print_extrule fmt (tkn, vars, body) = let tkn = List.rev tkn in fprintf fmt "@[Pcoq.Production.make@ @[(%a)@]@ @[(%a)@]@]" (print_symbols ~norec:false) tkn print_fun (vars, body) and print_symbols ~norec fmt = function | [] -> fprintf fmt "Pcoq.Rule.stop" | tkn :: tkns -> let c = if norec then "Pcoq.Rule.next_norec" else "Pcoq.Rule.next" in fprintf fmt "%s @[(%a)@ (%a)@]" c (print_symbols ~norec) tkns print_symbol tkn and print_symbol fmt tkn = match tkn with | SymbToken (t, s) -> fprintf fmt "(Pcoq.Symbol.token (%a))" print_tok (t, s) | SymbEntry (e, None) -> fprintf fmt "(Pcoq.Symbol.nterm %s)" e | SymbEntry (e, Some l) -> fprintf fmt "(Pcoq.Symbol.nterml %s (%a))" e print_string l | SymbSelf -> fprintf fmt "Pcoq.Symbol.self" | SymbNext -> fprintf fmt "Pcoq.Symbol.next" | SymbList0 (s, None) -> fprintf fmt "(Pcoq.Symbol.list0 %a)" print_symbol s | SymbList0 (s, Some sep) -> fprintf fmt "(Pcoq.Symbol.list0sep (%a) (%a) false)" print_symbol s print_anonymized_symbol sep | SymbList1 (s, None) -> fprintf fmt "(Pcoq.Symbol.list1 (%a))" print_symbol s | SymbList1 (s, Some sep) -> fprintf fmt "(Pcoq.Symbol.list1sep (%a) (%a) false)" print_symbol s print_anonymized_symbol sep | SymbOpt s -> fprintf fmt "(Pcoq.Symbol.opt %a)" print_symbol s | SymbRules rules -> let pr fmt (r, body) = let (vars, tkn) = List.split r in let tkn = List.rev tkn in fprintf fmt "Pcoq.Rules.make @[(%a)@ (%a)@]" (print_symbols ~norec:true) tkn print_fun (vars, body) in let pr fmt rules = print_list fmt pr rules in fprintf fmt "(Pcoq.Symbol.rules %a)" pr (List.rev rules) | SymbQuote c -> fprintf fmt "(%s)" c and print_anonymized_symbol fmt tkn = match tkn with | SymbToken (t, s) -> fprintf fmt "(Pcoq.Symbol.tokens [Pcoq.TPattern (%a)])" print_tok (t, s) | _ -> print_symbol fmt (SymbRules [[None, tkn], mk_code "()"]) let print_rule fmt r = let pr_lvl fmt lvl = print_opt fmt print_string lvl in let pr_asc fmt asc = print_opt fmt print_assoc asc in let pr_prd fmt prd = print_list fmt print_prod prd in fprintf fmt "@[(%a,@ %a,@ %a)@]" pr_lvl r.grule_label pr_asc r.grule_assoc pr_prd (List.rev r.grule_prods) let gramext_count = ref 0 let gramext_plugin_uid name = let cnt = !gramext_count in incr gramext_count; " ~plugin_uid:(\""^name^"\", \""^(!file_name)^":"^string_of_int cnt^"\")" let grammar_extend () = match check_is_plugin ~what:"GRAMMAR EXTEND" () with | Some name -> "Egramml.grammar_extend"^gramext_plugin_uid name | None -> "Pcoq.grammar_extend" let print_entry fmt e = match e.gentry_rules with | GDataReuse (pos, r) -> let rules = List.rev r in let pr_pos fmt pos = print_opt fmt print_string pos in let pr_prd fmt prd = print_list fmt print_prod prd in fprintf fmt "let () =@ @[%s@ %s@ @[(Pcoq.Reuse (%a, %a))@]@]@ in@ " (grammar_extend ()) e.gentry_name pr_pos pos pr_prd rules | GDataFresh (pos, rules) -> let print_rules fmt rules = print_list fmt print_rule rules in let pr_check fmt () = match pos with | None -> fprintf fmt "let () =@ @[assert@ (Pcoq.Entry.is_empty@ %s)@]@ in@\n" e.gentry_name | Some _ -> fprintf fmt "" in let pos = match pos with None -> First | Some pos -> pos in fprintf fmt "%alet () =@ @[%s@ %s@ @[(Pcoq.Fresh@ (%a, %a))@]@]@ in@ " pr_check () (grammar_extend ()) e.gentry_name print_position pos print_rules rules let print_ast fmt ext = let () = fprintf fmt "let _ = @[" in let () = fprintf fmt "@[%a@]" print_local ext in let () = List.iter (fun e -> print_entry fmt e) ext.gramext_entries in let () = fprintf fmt "()@]@\n" in () end module VernacExt : sig val print_ast : Format.formatter -> vernac_ext -> unit end = struct let print_rule_classifier fmt r = match r.vernac_class with | None -> fprintf fmt "None" | Some f -> let no_binder = function ExtTerminal _ -> true | ExtNonTerminal _ -> false in if List.for_all no_binder r.vernac_toks then fprintf fmt "Some @[%a@]" print_code f else fprintf fmt "Some @[(fun %a-> %a)@]" print_binders r.vernac_toks print_code f (* let print_atts fmt = function *) (* | None -> fprintf fmt "@[let () = Attributes.unsupported_attributes atts in@] " *) (* | Some atts -> *) (* let rec print_left fmt = function *) (* | [] -> assert false *) (* | [x,_] -> fprintf fmt "%s" x *) (* | (x,_) :: rem -> fprintf fmt "(%s, %a)" x print_left rem *) (* in *) (* let rec print_right fmt = function *) (* | [] -> assert false *) (* | [_,y] -> fprintf fmt "%s" y *) (* | (_,y) :: rem -> fprintf fmt "(%s ++ %a)" y print_right rem *) (* in *) (* let nota = match atts with [_] -> "" | _ -> "Attributes.Notations." in *) (* fprintf fmt "@[let %a = Attributes.parse %s(%a) atts in@] " *) (* print_left atts nota print_right atts *) let print_atts_left fmt = function | None -> fprintf fmt "()" | Some atts -> let rec aux fmt = function | [] -> assert false | [x,_] -> fprintf fmt "%s" x | (x,_) :: rem -> fprintf fmt "(%s, %a)" x aux rem in aux fmt atts let print_atts_right fmt = function | None -> fprintf fmt "(Attributes.unsupported_attributes atts)" | Some atts -> let rec aux fmt = function | [] -> assert false | [_,y] -> print_code fmt y | (_,y) :: rem -> fprintf fmt "(%a ++ %a)" print_code y aux rem in let nota = match atts with [_] -> "" | _ -> "Attributes.Notations." in fprintf fmt "(Attributes.parse %s%a atts)" nota aux atts let understand_state = function | "close_proof" -> "vtcloseproof", ["lemma"; "pm"] | "open_proof" -> "vtopenproof", [] | "proof" -> "vtmodifyproof", ["pstate"] | "proof_opt_query" -> "vtreadproofopt", ["pstate"] | "proof_query" -> "vtreadproof", ["pstate"] | "read_program" -> "vtreadprogram", ["pm"] | "program" -> "vtmodifyprogram", ["pm"] | "declare_program" -> "vtdeclareprogram", ["pm"] | "program_interactive" -> "vtopenproofprogram", ["pm"] | "opaque_access" -> "vtopaqueaccess", ["opaque_access"] | s -> fatal ("unsupported state specifier: " ^ s) let rec pr_named_arguments fmt = function | [] -> assert false | [s] -> fprintf fmt "~%s" s | s :: l -> fprintf fmt "~%s@ %a" s pr_named_arguments l let pr_begin_wrapper fmt = function | [] -> fprintf fmt "fun () ->" | args -> fprintf fmt "fun %a ->" pr_named_arguments args let pr_end_wrapper fmt = function | [] -> fprintf fmt "" | args -> fprintf fmt "@ %a" pr_named_arguments args let print_body_state state fmt r = let state = match r.vernac_state with Some _ as s -> s | None -> state in match state with | None -> fprintf fmt "Vernactypes.vtdefault (fun () -> %a)" print_code r.vernac_body | Some "CUSTOM" -> print_code fmt r.vernac_body | Some state -> let state, wrap = understand_state state in fprintf fmt "Vernactypes.%s (%a (%a)%a)" state pr_begin_wrapper wrap print_code r.vernac_body pr_end_wrapper wrap let print_body_fun state fmt r = match r.vernac_synterp with | None -> fprintf fmt "let coqpp_body %a%a = @[%a@] in " print_binders r.vernac_toks print_atts_left r.vernac_atts (print_body_state state) r | Some (id,pe) -> fprintf fmt "let coqpp_body %a%a = @[(let %s = %a in %a)@] in " print_binders r.vernac_toks print_atts_left r.vernac_atts id print_code pe (print_body_state state) r let print_body state fmt r = fprintf fmt "@[(%afun %a?loc ~atts ()@ -> coqpp_body %a%a)@]" (print_body_fun state) r print_binders r.vernac_toks print_binders r.vernac_toks print_atts_right r.vernac_atts let rec print_sig fmt = function | [] -> fprintf fmt "@[Vernacextend.TyNil@]" | ExtTerminal s :: rem -> fprintf fmt "@[Vernacextend.TyTerminal (\"%s\", %a)@]" s print_sig rem | ExtNonTerminal (symb, _) :: rem -> fprintf fmt "@[Vernacextend.TyNonTerminal (%a, %a)@]" print_symbol symb print_sig rem let print_rule state fmt r = fprintf fmt "Vernacextend.TyML (%b, %a, %a, %a)" r.vernac_depr print_sig r.vernac_toks (print_body state) r print_rule_classifier r let print_rules state fmt rules = print_list fmt (fun fmt r -> fprintf fmt "(%a)" (print_rule state) r) rules let print_classifier fmt = function | ClassifDefault -> fprintf fmt "" | ClassifName "QUERY" -> fprintf fmt "~classifier:(fun _ -> Vernacextend.classify_as_query)" | ClassifName "SIDEFF" -> fprintf fmt "~classifier:(fun _ -> Vernacextend.classify_as_sideeff)" | ClassifName s -> fatal (Printf.sprintf "Unknown classifier %s" s) | ClassifCode c -> fprintf fmt "~classifier:(%s)" c.code let print_entry fmt = function | None -> fprintf fmt "None" | Some e -> fprintf fmt "(Some (%s))" e.code let print_ast fmt ext = let pr fmt () = fprintf fmt "Vernacextend.static_vernac_extend ~plugin:%s ~command:\"%s\" %a ?entry:%a %a" (match check_is_plugin ~what:"VERNAC EXTEND" () with | Some name -> "(Some \""^name^"\")" | None -> "None") ext.vernacext_name print_classifier ext.vernacext_class print_entry ext.vernacext_entry (print_rules ext.vernacext_state) ext.vernacext_rules in let () = fprintf fmt "let () = @[%a@]@\n" pr () in () end module TacticExt : sig val print_ast : Format.formatter -> tactic_ext -> unit end = struct let rec print_clause fmt = function | [] -> fprintf fmt "@[Tacentries.TyNil@]" | ExtTerminal s :: cl -> fprintf fmt "@[Tacentries.TyIdent (\"%s\", %a)@]" s print_clause cl | ExtNonTerminal (g, _) :: cl -> fprintf fmt "@[Tacentries.TyArg (%a, %a)@]" print_symbol g print_clause cl let print_rule fmt r = fprintf fmt "@[Tacentries.TyML (%a, @[(fun %aist@ -> %a)@])@]" print_clause r.tac_toks print_binders r.tac_toks print_code r.tac_body let print_rules fmt rules = print_list fmt (fun fmt r -> fprintf fmt "(%a)" print_rule r) rules let print_ast fmt ext = let deprecation fmt = function | None -> () | Some { code } -> fprintf fmt "~deprecation:(%s) " code in let pr fmt () = let level = match ext.tacext_level with None -> 0 | Some i -> i in let name = force_is_plugin ~what:"TACTIC EXTEND" () in fprintf fmt "Tacentries.tactic_extend \"%s\" \"%s\" ~level:%i %a%a" name ext.tacext_name level deprecation ext.tacext_deprecated print_rules ext.tacext_rules in let () = fprintf fmt "let () = @[%a@]\n" pr () in () end module VernacArgumentExt : sig val print_ast : Format.formatter -> vernac_argument_ext -> unit val print_rules : Format.formatter -> string * tactic_rule list -> unit end = struct let terminal s = let p = if s <> "" && s.[0] >= '0' && s.[0] <= '9' then "CLexer.terminal_number" else "Pcoq.terminal" in let c = Printf.sprintf "Pcoq.Symbol.token (%s \"%s\")" p s in SymbQuote c let rec parse_symb self = function | Ulist1 s -> SymbList1 (parse_symb self s, None) | Ulist1sep (s, sep) -> SymbList1 (parse_symb self s, Some (terminal sep)) | Ulist0 s -> SymbList0 (parse_symb self s, None) | Ulist0sep (s, sep) -> SymbList0 (parse_symb self s, Some (terminal sep)) | Uopt s -> SymbOpt (parse_symb self s) | Uentry e -> if e = self then SymbSelf else SymbEntry (e, None) | Uentryl (e, l) -> assert (e = "tactic"); if l = 5 then SymbEntry ("Pltac.binder_tactic", None) else SymbEntry ("Pltac.ltac_expr", Some (string_of_int l)) let parse_token self = function | ExtTerminal s -> (terminal s, None) | ExtNonTerminal (e, TokNone) -> (parse_symb self e, None) | ExtNonTerminal (e, TokName s) -> (parse_symb self e, Some s) let parse_rule self r = let symbs = List.map (fun t -> parse_token self t) r.tac_toks in let symbs, vars = List.split symbs in (symbs, vars, r.tac_body) let print_rules fmt (name, rules) = (* Rules are reversed. *) let rules = List.rev rules in let rules = List.map (fun r -> parse_rule name r) rules in let pr fmt l = print_list fmt (fun fmt r -> fprintf fmt "(%a)" GramExt.print_extrule r) l in match rules with | [([SymbEntry (e, None)], [Some s], { code = c } )] when String.trim c = s -> (* This is a horrible hack to work around limitations of camlp5 regarding factorization of parsing rules. It allows to recognize rules of the form [ entry(x) ] -> [ x ] so as not to generate a proxy entry and reuse the same entry directly. *) fprintf fmt "@[Vernacextend.Arg_alias (%s)@]" e | _ -> fprintf fmt "@[Vernacextend.Arg_rules (%a)@]" pr rules let print_printer fmt = function | None -> fprintf fmt "@[fun _ -> Pp.str \"missing printer\"@]" | Some f -> print_code fmt f let print_ast fmt arg = let name = arg.vernacargext_name in let pr fmt () = fprintf fmt "Vernacextend.vernac_argument_extend ~plugin:\"%s\" ~name:%a @[{@\n\ Vernacextend.arg_parsing = %a;@\n\ Vernacextend.arg_printer = fun env sigma -> %a;@\n}@]" (force_is_plugin ~what:"VERNAC ARGUMENT EXTEND" ()) print_string name print_rules (name, arg.vernacargext_rules) print_printer arg.vernacargext_printer in fprintf fmt "let (wit_%s, %s) = @[%a@]@\nlet _ = (wit_%s, %s)@\n" name name pr () name name end module ArgumentExt : sig val print_ast : Format.formatter -> argument_ext -> unit end = struct let rec print_argtype fmt = function | ExtraArgType s -> fprintf fmt "Geninterp.val_tag (Genarg.topwit wit_%s)" s | PairArgType (arg1, arg2) -> fprintf fmt "Geninterp.Val.Pair (@[(%a)@], @[(%a)@])" print_argtype arg1 print_argtype arg2 | ListArgType arg -> fprintf fmt "Geninterp.Val.List @[(%a)@]" print_argtype arg | OptArgType arg -> fprintf fmt "Geninterp.Val.Opt @[(%a)@]" print_argtype arg let rec print_wit fmt = function | ExtraArgType s -> fprintf fmt "wit_%s" s | PairArgType (arg1, arg2) -> fprintf fmt "Genarg.PairArg (@[(%a)@], @[(%a)@])" print_wit arg1 print_wit arg2 | ListArgType arg -> fprintf fmt "Genarg.ListArg @[(%a)@]" print_wit arg | OptArgType arg -> fprintf fmt "Genarg.OptArg @[(%a)@]" print_wit arg let print_ast fmt arg = let name = arg.argext_name in let pr_tag fmt t = print_opt fmt print_argtype t in let intern fmt () = match arg.argext_glob, arg.argext_type with | Some f, (None | Some _) -> fprintf fmt "@[Tacentries.ArgInternFun ((fun f ist v -> (ist, f ist v)) (%a))@]" print_code f | None, Some t -> fprintf fmt "@[Tacentries.ArgInternWit (%a)@]" print_wit t | None, None -> fprintf fmt "@[Tacentries.ArgInternFun (fun ist v -> (ist, v))@]" in let subst fmt () = match arg.argext_subst, arg.argext_type with | Some f, (None | Some _) -> fprintf fmt "@[Tacentries.ArgSubstFun (%a)@]" print_code f | None, Some t -> fprintf fmt "@[Tacentries.ArgSubstWit (%a)@]" print_wit t | None, None -> fprintf fmt "@[Tacentries.ArgSubstFun (fun s v -> v)@]" in let interp fmt () = match arg.argext_interp, arg.argext_type with | Some (None, f), (None | Some _) -> fprintf fmt "@[Tacentries.ArgInterpSimple (%a)@]" print_code f | Some (Some kind, f), (None | Some _) -> fatal (Printf.sprintf "Unknown kind %s of interpretation function" kind) | None, Some t -> fprintf fmt "@[Tacentries.ArgInterpWit (%a)@]" print_wit t | None, None -> fprintf fmt "@[Tacentries.ArgInterpRet@]" in let default_printer = mk_code "fun _ _ _ _ -> Pp.str \"missing printer\"" in let rpr = match arg.argext_rprinter, arg.argext_tprinter with | Some f, (None | Some _) -> f | None, Some f -> f | None, None -> default_printer in let gpr = match arg.argext_gprinter, arg.argext_tprinter with | Some f, (None | Some _) -> f | None, Some f -> f | None, None -> default_printer in let tpr = match arg.argext_tprinter with | Some f -> f | None -> default_printer in let pr fmt () = fprintf fmt "Tacentries.argument_extend ~plugin:\"%s\" ~name:%a @[{@\n\ Tacentries.arg_parsing = %a;@\n\ Tacentries.arg_tag = @[%a@];@\n\ Tacentries.arg_intern = @[%a@];@\n\ Tacentries.arg_subst = @[%a@];@\n\ Tacentries.arg_interp = @[%a@];@\n\ Tacentries.arg_printer = @[((fun env sigma -> %a), (fun env sigma -> %a), (fun env sigma -> %a))@];@\n}@]" (force_is_plugin ~what:"ARGUMENT EXTEND" ()) print_string name VernacArgumentExt.print_rules (name, arg.argext_rules) pr_tag arg.argext_type intern () subst () interp () print_code rpr print_code gpr print_code tpr in fprintf fmt "let (wit_%s, %s) = @[%a@]@\nlet _ = (wit_%s, %s)@\n" name name pr () name name end let declare_plugin fmt name = Option.iter (fprintf fmt "let _ = Mltop.add_known_module \"%s\"@\n") name; let () = match !plugin_name with | None -> plugin_name := Some name | Some _ -> fatal "Multiple DECLARE PLUGIN not allowed"; in () let pr_ast fmt = function | Code s -> fprintf fmt "%a@\n" print_code s | Comment s -> fprintf fmt "%s@\n" s | DeclarePlugin name -> declare_plugin fmt name | GramExt gram -> fprintf fmt "%a@\n" GramExt.print_ast gram | VernacExt vernac -> fprintf fmt "%a@\n" VernacExt.print_ast vernac | VernacArgumentExt arg -> fprintf fmt "%a@\n" VernacArgumentExt.print_ast arg | TacticExt tac -> fprintf fmt "%a@\n" TacticExt.print_ast tac | ArgumentExt arg -> fprintf fmt "%a@\n" ArgumentExt.print_ast arg let help () = Format.eprintf "Usage: coqpp file.mlg@\n%!"; exit 1 let parse () = let () = if Array.length Sys.argv <> 2 then help () in match Sys.argv.(1) with | "-help" | "--help" -> help () | file -> file let output_name file = try Filename.chop_extension file ^ ".ml" with | Invalid_argument _ -> fatal "Input file must have an extension for coqpp [input.ext -> input.ml]" let () = let file = parse () in let output = output_name file in let ast = parse_file file in let chan = open_out output in let () = file_name := Filename.basename file in let fmt = formatter_of_out_channel chan in let iter ast = Format.fprintf fmt "@[%a@]%!" pr_ast ast in let () = List.iter iter ast in let () = close_out chan in exit 0 coq-8.20.0/coqpp/coqpp_main.mli000066400000000000000000000000001466560755400163460ustar00rootroot00000000000000coq-8.20.0/coqpp/coqpp_parse.mly000066400000000000000000000240401466560755400165660ustar00rootroot00000000000000/************************************************************************/ /* * The Coq Proof Assistant / The Coq Development Team */ /* v * Copyright INRIA, CNRS and contributors */ /* None | Some s -> ends s pat2 let without_sep k sep r = if sep <> "" then raise Parsing.Parse_error else k r let parse_user_entry s sep = let table = [ "ne_", "_list", without_sep (fun r -> Ulist1 r); "ne_", "_list_sep", (fun sep r -> Ulist1sep (r, sep)); "", "_list", without_sep (fun r -> Ulist0 r); "", "_list_sep", (fun sep r -> Ulist0sep (r, sep)); "", "_opt", without_sep (fun r -> Uopt r); ] in let rec parse s sep = function | [] -> let () = without_sep ignore sep () in begin match starts s "tactic" with | Some ("0"|"1"|"2"|"3"|"4"|"5" as s) -> Uentryl ("tactic", int_of_string s) | Some _ | None -> Uentry s end | (pat1, pat2, k) :: rem -> match between s pat1 pat2 with | None -> parse s sep rem | Some s -> let r = parse s "" table in k sep r in parse s sep table let no_code = { code = ""; loc = None } let rhs_loc n = { loc_start = Parsing.rhs_start_pos n; loc_end = Parsing.rhs_end_pos n } %} %token CODE %token COMMENT %token IDENT QUALID %token STRING %token INT %token VERNAC TACTIC GRAMMAR DOC_GRAMMAR EXTEND END DECLARE PLUGIN DEPRECATED ARGUMENT %token RAW_PRINTED GLOB_PRINTED %token SYNTERP COMMAND CLASSIFIED STATE PRINTED TYPED INTERPRETED GLOBALIZED SUBSTITUTED BY AS %token BANGBRACKET HASHBRACKET LBRACKET RBRACKET PIPE ARROW FUN COMMA EQUAL STAR %token LPAREN RPAREN COLON SEMICOLON %token GLOBAL TOP FIRST LAST BEFORE AFTER LEVEL LEFTA RIGHTA NONA %token EOF %type file %start file %% file: | nodes EOF { $1 } ; nodes: | { [] } | node nodes { $1 :: $2 } ; node: | CODE { Code $1 } | COMMENT { Comment $1 } | declare_plugin { $1 } | grammar_extend { $1 } | vernac_extend { $1 } | tactic_extend { $1 } | argument_extend { $1 } | doc_gram { $1 } ; declare_plugin: | DECLARE PLUGIN STRING { DeclarePlugin (Some $3) } | DECLARE GLOBAL PLUGIN { DeclarePlugin None } ; grammar_extend: | GRAMMAR EXTEND qualid_or_ident globals gram_entries END { GramExt { gramext_name = $3; gramext_globals = $4; gramext_entries = $5 } } ; argument_extend: | ARGUMENT EXTEND IDENT typed_opt printed_opt interpreted_opt globalized_opt substituted_opt raw_printed_opt glob_printed_opt tactic_rules END { ArgumentExt { argext_name = $3; argext_rules = $11; argext_rprinter = $9; argext_gprinter = $10; argext_tprinter = $5; argext_interp = $6; argext_glob = $7; argext_subst = $8; argext_type = $4; } } | VERNAC ARGUMENT EXTEND IDENT printed_opt tactic_rules END { VernacArgumentExt { vernacargext_name = $4; vernacargext_printer = $5; vernacargext_rules = $6; } } ; printed_opt: | { None } | PRINTED BY CODE { Some $3 } ; raw_printed_opt: | { None } | RAW_PRINTED BY CODE { Some $3 } ; glob_printed_opt: | { None } | GLOB_PRINTED BY CODE { Some $3 } ; interpreted_modifier_opt: | { None } | LBRACKET IDENT RBRACKET { Some $2 } ; interpreted_opt: | { None } | INTERPRETED interpreted_modifier_opt BY CODE { Some ($2,$4) } ; globalized_opt: | { None } | GLOBALIZED BY CODE { Some $3 } ; substituted_opt: | { None } | SUBSTITUTED BY CODE { Some $3 } ; typed_opt: | { None } | TYPED AS argtype { Some $3 } ; argtype: | IDENT { ExtraArgType $1 } | argtype IDENT { match $2 with | "list" -> ListArgType $1 | "option" -> OptArgType $1 | _ -> raise Parsing.Parse_error } | LPAREN argtype STAR argtype RPAREN { PairArgType ($2, $4) } ; vernac_extend: | VERNAC vernac_entry EXTEND IDENT vernac_classifier vernac_state vernac_rules END { VernacExt { vernacext_name = $4; vernacext_entry = $2; vernacext_class = $5; vernacext_state = $6; vernacext_rules = $7; } } ; vernac_entry: | COMMAND { None } | CODE { Some $1 } ; vernac_classifier: | { ClassifDefault } | CLASSIFIED BY CODE { ClassifCode $3 } | CLASSIFIED AS IDENT { ClassifName $3 } ; vernac_state: | { None } | STATE IDENT { Some $2 } ; vernac_rules: | vernac_rule { [$1] } | vernac_rule vernac_rules { $1 :: $2 } ; vernac_rule: | PIPE vernac_attributes_opt rule_state LBRACKET ext_tokens RBRACKET rule_deprecation rule_classifier synterp_fun ARROW CODE { { vernac_atts = $2; vernac_state = $3; vernac_toks = $5; vernac_depr = $7; vernac_class= $8; vernac_synterp = $9; vernac_body = $11; } } ; rule_state: | { None } | BANGBRACKET IDENT RBRACKET { Some $2 } ; vernac_attributes_opt: | { None } | HASHBRACKET vernac_attributes RBRACKET { Some $2 } ; vernac_attributes: | vernac_attribute { [$1] } | vernac_attribute SEMICOLON { [$1] } | vernac_attribute SEMICOLON vernac_attributes { $1 :: $3 } ; vernac_attribute: | qualid_or_ident EQUAL qualid_or_ident { ($1, { code = $3; loc = Some (rhs_loc 3) }) } | qualid_or_ident { ($1, { code = $1; loc = Some (rhs_loc 1) }) } ; rule_deprecation: | { false } | DEPRECATED { true } ; rule_classifier: | { None } | FUN CODE { Some $2 } ; synterp_fun: | { None } | SYNTERP AS IDENT CODE { Some ($3,$4) } tactic_extend: | TACTIC EXTEND IDENT tactic_deprecated tactic_level tactic_rules END { TacticExt { tacext_name = $3; tacext_deprecated = $4; tacext_level = $5; tacext_rules = $6 } } ; tactic_deprecated: | { None } | DEPRECATED CODE { Some $2 } ; tactic_level: | { None } | LEVEL INT { Some $2 } ; tactic_rules: | { [] } | tactic_rule tactic_rules { $1 :: $2 } ; tactic_rule: | PIPE LBRACKET ext_tokens RBRACKET ARROW CODE { { tac_toks = $3; tac_body = $6 } } ; ext_tokens: | { [] } | ext_token ext_tokens { $1 :: $2 } ; ext_token: | STRING { ExtTerminal $1 } | IDENT { let e = parse_user_entry $1 "" in ExtNonTerminal (e, TokNone) } | IDENT LPAREN IDENT RPAREN { let e = parse_user_entry $1 "" in ExtNonTerminal (e, TokName $3) } | IDENT LPAREN IDENT COMMA STRING RPAREN { let e = parse_user_entry $1 $5 in ExtNonTerminal (e, TokName $3) } ; qualid_or_ident: | QUALID { $1 } | IDENT { $1 } ; globals: | { [] } | GLOBAL COLON idents SEMICOLON { $3 } ; idents: | { [] } | qualid_or_ident idents { $1 :: $2 } ; gram_entries: | { [] } | gram_entry gram_entries { $1 :: $2 } ; gram_entry: | qualid_or_ident COLON reuse LBRACKET LBRACKET rules_opt RBRACKET RBRACKET SEMICOLON { { gentry_name = $1; gentry_rules = GDataReuse ($3, $6); } } | qualid_or_ident COLON position_opt LBRACKET levels RBRACKET SEMICOLON { { gentry_name = $1; gentry_rules = GDataFresh ($3, $5); } } ; reuse: | TOP { None } | LEVEL STRING { Some $2 } ; position_opt: | { None } | position { Some $1 } ; position: | FIRST { First } | LAST { Last } | BEFORE STRING { Before $2 } | AFTER STRING { After $2 } ; string_opt: | { None } | STRING { Some $1 } ; assoc_opt: | { None } | assoc { Some $1 } ; assoc: | LEFTA { LeftA } | RIGHTA { RightA } | NONA { NonA } ; levels: | level { [$1] } | level PIPE levels { $1 :: $3 } ; level: | string_opt assoc_opt LBRACKET rules_opt RBRACKET { { grule_label = $1; grule_assoc = $2; grule_prods = $4; } } ; rules_opt: | { [] } | rules { $1 } ; rules: | rule { [$1] } | rule PIPE rules { $1 :: $3 } ; rule: | symbols_opt ARROW CODE { { gprod_symbs = $1; gprod_body = $3; } } ; symbols_opt: | { [] } | symbols { $1 } ; symbols: | symbol { [$1] } | symbol SEMICOLON symbols { $1 :: $3 } ; symbol: | IDENT EQUAL gram_tokens { (Some $1, $3) } | gram_tokens { (None, $1) } ; gram_token: | qualid_or_ident { GSymbQualid ($1, None) } | qualid_or_ident LEVEL STRING { GSymbQualid ($1, Some $3) } | LPAREN gram_tokens RPAREN { GSymbParen $2 } | LBRACKET rules RBRACKET { GSymbProd $2 } | STRING { GSymbString $1 } ; gram_tokens: | gram_token { [$1] } | gram_token gram_tokens { $1 :: $2 } ; doc_gram: | DOC_GRAMMAR doc_gram_entries { GramExt { gramext_name = ""; gramext_globals=[]; gramext_entries = $2 } } doc_gram_entries: | { [] } | doc_gram_entry doc_gram_entries { $1 :: $2 } ; doc_gram_entry: | qualid_or_ident COLON LBRACKET PIPE doc_gram_rules RBRACKET { { gentry_name = $1; gentry_rules = GDataFresh (None, [{ grule_label = None; grule_assoc = None; grule_prods = $5; }]) } } | qualid_or_ident COLON LBRACKET RBRACKET { { gentry_name = $1; gentry_rules = GDataFresh (None, [{ grule_label = None; grule_assoc = None; grule_prods = []; }]) } } ; doc_gram_rules: | doc_gram_rule { [$1] } | doc_gram_rule PIPE doc_gram_rules { $1 :: $3 } ; doc_gram_rule: | doc_gram_symbols_opt { { gprod_symbs = $1; gprod_body = no_code; } } ; doc_gram_symbols_opt: | { [] } | doc_gram_symbols { $1 } | doc_gram_symbols SEMICOLON { $1 } ; doc_gram_symbols: | doc_gram_symbol { [$1] } | doc_gram_symbols SEMICOLON doc_gram_symbol { $1 @ [$3] } ; doc_gram_symbol: | IDENT EQUAL doc_gram_gram_tokens { (Some $1, $3) } | doc_gram_gram_tokens { (None, $1) } ; doc_gram_gram_tokens: | doc_gram_gram_token { [$1] } | doc_gram_gram_token doc_gram_gram_tokens { $1 :: $2 } ; doc_gram_gram_token: | qualid_or_ident { GSymbQualid ($1, None) } | LPAREN doc_gram_gram_tokens RPAREN { GSymbParen $2 } | LBRACKET doc_gram_rules RBRACKET { GSymbProd $2 } | STRING { GSymbString $1 } ; coq-8.20.0/coqpp/coqpp_parser.ml000066400000000000000000000032171466560755400165620ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* let () = close_in chan in let () = Printf.eprintf "%s\n%!" (pr_loc loc) in fatal msg | Parsing.Parse_error -> let () = close_in chan in let loc = Coqpp_lex.loc lexbuf in let () = Printf.eprintf "%s\n%!" (pr_loc loc) in fatal "syntax error" in let () = close_in chan in ans coq-8.20.0/coqpp/coqpp_parser.mli000066400000000000000000000014151466560755400167310ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* string val fatal : string -> unit val parse_file : string -> Coqpp_ast.t coq-8.20.0/coqpp/dune000066400000000000000000000004561466560755400144120ustar00rootroot00000000000000(ocamllex coqpp_lex) (ocamlyacc coqpp_parse) (library (name coqpp) (wrapped false) (modules coqpp_ast coqpp_lex coqpp_parse coqpp_parser) (modules_without_implementation coqpp_ast)) (executable (name coqpp_main) (public_name coqpp) (package coq-core) (libraries coqpp) (modules coqpp_main)) coq-8.20.0/default.nix000066400000000000000000000113001466560755400145440ustar00rootroot00000000000000# How to use? # If you have Nix installed, you can get in an environment with everything # needed to compile Coq and CoqIDE by running: # $ nix-shell # at the root of the Coq repository. # How to tweak default arguments? # nix-shell supports the --arg option (see Nix doc) that allows you for # instance to do this: # $ nix-shell --arg ocamlPackages "(import {}).ocaml-ng.ocamlPackages_4_09" --arg buildIde false # You can also compile Coq and "install" it by running: # $ make clean # (only needed if you have left-over compilation files) # $ nix-build # at the root of the Coq repository. # nix-build also supports the --arg option, so you will be able to do: # $ nix-build --arg doInstallCheck false # if you want to speed up things by not running the test-suite. # Once the build is finished, you will find, in the current directory, # a symlink to where Coq was installed. { pkgs ? import ./dev/nixpkgs.nix {} , ocamlPackages ? pkgs.ocaml-ng.ocamlPackages_4_14 , buildIde ? true , buildDoc ? true , doInstallCheck ? true , shell ? false # We don't use lib.inNixShell because that would also apply # when in a nix-shell of some package depending on this one. , coq-version ? "8.14-git" }: with pkgs; with pkgs.lib; stdenv.mkDerivation rec { name = "coq"; buildInputs = [ hostname python311 # coq-makefile timing tools time dune_3 ] ++ optionals buildIde [ ocamlPackages.lablgtk3-sourceview3 glib gnome.adwaita-icon-theme wrapGAppsHook ] ++ optionals buildDoc [ # Sphinx doc dependencies pkg-config (python311.withPackages (ps: [ ps.sphinx ps.sphinx_rtd_theme ps.pexpect ps.beautifulsoup4 (ps.antlr4-python3-runtime.override {antlr4 = pkgs.antlr4_9;}) ps.sphinxcontrib-bibtex ])) antlr4_9 ocamlPackages.odoc ] ++ optionals doInstallCheck [ # Test-suite dependencies ocamlPackages.ounit rsync which ] ++ optionals shell ( [ # Dependencies of the merging script jq curl gitFull gnupg ] ++ (with ocamlPackages; [ # Dev tools ocaml-lsp merlin ocp-indent ocp-index utop ocamlformat ]) ++ [ # Useful for STM debugging graphviz ] ); # 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) propagatedBuildInputs = with ocamlPackages; [ ocaml findlib zarith ]; propagatedUserEnvPkgs = with ocamlPackages; [ ocaml findlib ]; src = if shell then null else with builtins; filterSource (path: _: !elem (baseNameOf path) [".git" "result" "bin" "_build" "_build_ci" "_build_vo" "nix"]) ./.; preConfigure = '' patchShebangs dev/tools/ doc/stdlib ''; prefixKey = "-prefix "; enableParallelBuilding = true; buildFlags = [ "world" ]; # TODO, building of documentation package when not in dev mode # https://github.com/coq/coq/issues/16198 # buildFlags = [ "world" ] ++ optional buildDoc "refman-html"; # From https://github.com/NixOS/nixpkgs/blob/master/pkgs/build-support/ocaml/dune.nix installPhase = '' runHook preInstall dune install --prefix $out --libdir $OCAMLFIND_DESTDIR coq-core coq-stdlib coq coqide-server coqide runHook postInstall ''; # installTargets = # [ "install" ]; # fixme, do we have to do a target, or can we just do a copy? # ++ optional buildDoc "install-doc-html"; createFindlibDestdir = !shell; postInstall = "ln -s $out/lib/coq-core $OCAMLFIND_DESTDIR/coq-core"; inherit doInstallCheck; preInstallCheck = '' patchShebangs tools/ patchShebangs test-suite/ export OCAMLPATH=$OCAMLFIND_DESTDIR:$OCAMLPATH ''; installCheckTarget = [ "check" ]; passthru = { inherit coq-version ocamlPackages; dontFilter = true; # Useful to use mkCoqPackages from }; setupHook = writeText "setupHook.sh" " addCoqPath () { if test -d \"$1/lib/coq/${coq-version}/user-contrib\"; then export COQPATH=\"\${COQPATH-}\${COQPATH:+:}$1/lib/coq/${coq-version}/user-contrib/\" fi } addEnvHooks \"$targetOffset\" addCoqPath "; meta = { description = "Coq proof assistant"; longDescription = '' Coq is a formal proof management system. It provides a formal language to write mathematical definitions, executable algorithms and theorems together with an environment for semi-interactive development of machine-checked proofs. ''; homepage = http://coq.inria.fr; license = licenses.lgpl21; platforms = platforms.unix; }; } coq-8.20.0/dev/000077500000000000000000000000001466560755400131635ustar00rootroot00000000000000coq-8.20.0/dev/Bugzilla_Coq_autolink.user.js000066400000000000000000000011511466560755400207550ustar00rootroot00000000000000// ==UserScript== // @name Bugzilla Coq autolink // @namespace CoqScript // @include https://coq.inria.fr/bugs/* // @description Makes #XXXX into links to Github Coq PRs // @version 1 // @grant none // ==/UserScript== var regex = /#(\d+)/g; var substr = '$&'; function doNode(node) { node.innerHTML = node.innerHTML.replace(regex,substr); } var comments = document.getElementsByClassName("bz_comment_table")[0]; var pars = comments.getElementsByClassName("bz_comment_text"); for(var j=0; j 1) { var range = document.createRange(); var start = content.search(regex); var end = start + matches[0].length; range.setStart(node, start); range.setEnd(node, end); var linkNode = document.createElement("a"); linkNode.href = "https://coq.inria.fr/bugs/show_bug.cgi?id=" + matches[1]; range.surroundContents(linkNode); //handle multiple matches in one text node doNode(linkNode.parentNode); } } } for(var i=0; i /dev/null > /dev/null; then : else echo echo "ERROR: num_of_iterations \"$num_of_iterations\" is not a positive integer." > /dev/stderr print_man_page_hint exit 1 fi bench_dirname="_bench" mkdir -p "${bench_dirname}" working_dir="$PWD/${bench_dirname}" log_dir=$working_dir/logs mkdir "$log_dir" export COQ_LOG_DIR=$log_dir echo "DEBUG: ocaml -version = $(ocaml -version)" echo "DEBUG: working_dir = $working_dir" echo "DEBUG: new_ocaml_switch = $new_ocaml_switch" echo "DEBUG: new_coq_repository = $new_coq_repository" echo "DEBUG: new_coq_commit = $new_coq_commit" echo "DEBUG: new_coq_opam_archive_git_uri = $new_coq_opam_archive_git_uri" echo "DEBUG: new_coq_opam_archive_git_branch = $new_coq_opam_archive_git_branch" echo "DEBUG: old_ocaml_switch = $old_ocaml_switch" echo "DEBUG: old_coq_repository = $old_coq_repository" echo "DEBUG: old_coq_commit = $old_coq_commit" echo "DEBUG: old_coq_opam_archive_git_uri = $old_coq_opam_archive_git_uri" echo "DEBUG: old_coq_opam_archive_git_branch = $old_coq_opam_archive_git_branch" echo "DEBUG: num_of_iterations = $num_of_iterations" echo "DEBUG: coq_opam_packages = $coq_opam_packages" echo "DEBUG: coq_pr_number = $coq_pr_number" echo "DEBUG: coq_pr_comment_id = $coq_pr_comment_id" echo "DEBUG: coq_native = $coq_native" # -------------------------------------------------------------------------------- # Some sanity checks of command-line arguments provided by the user that can be done right now. if which perf > /dev/null; then echo -n else echo > /dev/stderr echo "ERROR: \"perf\" program is not available." > /dev/stderr echo > /dev/stderr exit 1 fi if which curl > /dev/null; then : else echo > /dev/stderr echo "ERROR: \"curl\" program is not available." > /dev/stderr echo > /dev/stderr exit 1 fi if which du > /dev/null; then : else echo > /dev/stderr echo "ERROR: \"du\" program is not available." > /dev/stderr echo > /dev/stderr exit 1 fi if [ ! -e "$working_dir" ]; then echo > /dev/stderr echo "ERROR: \"$working_dir\" does not exist." > /dev/stderr echo > /dev/stderr exit 1 fi if [ ! -d "$working_dir" ]; then echo > /dev/stderr echo "ERROR: \"$working_dir\" is not a directory." > /dev/stderr echo > /dev/stderr exit 1 fi if [ ! -w "$working_dir" ]; then echo > /dev/stderr echo "ERROR: \"$working_dir\" is not writable." > /dev/stderr echo > /dev/stderr exit 1 fi coq_opam_packages_on_separate_lines=$(echo "$coq_opam_packages" | sed 's/ /\n/g') if [ $(echo "$coq_opam_packages_on_separate_lines" | wc -l) != $(echo "$coq_opam_packages_on_separate_lines" | sort | uniq | wc -l) ]; then echo "ERROR: The provided set of OPAM packages contains duplicates." exit 1 fi # -------------------------------------------------------------------------------- # Tell coqbot to update the initial comment, if we know which one to update function coqbot_update_comment() { is_done="$1" comment_body="$2" uninstallable_packages="$3" if [ ! -z "${coq_pr_number}" ]; then comment_text="" artifact_text="" if [ -z "${is_done}" ]; then comment_text="in progress, " artifact_text="eventually " else comment_text="" artifact_text="" fi comment_text="Benchmarking ${comment_text}log available [here](${CI_JOB_URL}) ([raw log here](${CI_JOB_URL}/raw)), artifacts ${artifact_text}available for [download](${CI_JOB_URL}/artifacts/download) and [browsing](${CI_JOB_URL}/artifacts/browse)" if [ ! -z "${comment_body}" ]; then comment_text="${comment_text}${nl}${start_code_block}${nl}${comment_body}${nl}${end_code_block}" fi if [ ! -z "${uninstallable_packages}" ]; then comment_text="${comment_text}${nl}The following packages failed to install: ${uninstallable_packages}" fi comment_text="${comment_text}${nl}${nl}
Old Coq version ${old_coq_commit}" comment_text="${comment_text}${nl}${nl}${start_code_block}${nl}$(git log -n 1 "${old_coq_commit}")${nl}${end_code_block}${nl}
" comment_text="${comment_text}${nl}${nl}
New Coq version ${new_coq_commit}" comment_text="${comment_text}${nl}${nl}${start_code_block}${nl}$(git log -n 1 "${new_coq_commit}")${nl}${end_code_block}${nl}
" comment_text="${comment_text}${nl}${nl}[Diff: ${bt}${old_coq_commit}..${new_coq_commit}${bt}](https://github.com/coq/coq/compare/${old_coq_commit}..${new_coq_commit})" # if there's a comment id, we update the comment while we're # in progress; otherwise, we wait until the end to post a new # comment if [ ! -z "${coq_pr_comment_id}" ]; then # Tell coqbot to update the in-progress comment curl -X POST --data-binary "${coq_pr_number}${nl}${coq_pr_comment_id}${nl}${comment_text}" "${coqbot_url_prefix}/update-comment" elif [ ! -z "${is_done}" ]; then # Tell coqbot to post a new comment that we're done benchmarking curl -X POST --data-binary "${coq_pr_number}${nl}${comment_text}" "${coqbot_url_prefix}/new-comment" fi if [ ! -z "${is_done}" ]; then # Tell coqbot to remove the `needs: benchmarking` label curl -X POST --data-binary "${coq_pr_number}" "${coqbot_url_prefix}/benchmarking-done" fi fi } # initial update to the comment, to say that we're in progress coqbot_update_comment "" "" "" # -------------------------------------------------------------------------------- zulip_post="" if [[ $ZULIP_BENCH_BOT ]]; then pr_full=$(git log -n 1 --pretty=%s) pr_full=${pr_full#"[CI merge] PR #"} pr_num=${pr_full%%:*} pr_msg=${pr_full#*:} zulip_header="Bench at $CI_JOB_URL Testing [$pr_msg](https://github.com/coq/coq/pull/$pr_num) On packages $coq_opam_packages " # 24008 is the "github notifications" stream resp=$(curl -sSX POST https://coq.zulipchat.com/api/v1/messages \ -u "$ZULIP_BENCH_BOT" \ --data-urlencode type=stream \ --data-urlencode to='240008' \ --data-urlencode subject='Bench Notifications' \ --data-urlencode content="$zulip_header") zulip_post=$(echo "$resp" | jq .id) case "$zulip_post" in ''|*[!0-9]*) # not an int echo "Failed to post to zulip: $resp" zulip_post="" ;; esac fi zulip_edit() { if ! [[ $zulip_post ]]; then return; fi ending=$1 if [[ $rendered_results ]]; then msg="$zulip_header ~~~ $rendered_results ~~~ $ending " else msg="$zulip_header $ending " fi curl -sSX PATCH https://coq.zulipchat.com/api/v1/messages/"$zulip_post" \ -u "$ZULIP_BENCH_BOT" \ --data-urlencode content="$msg" >/dev/null || echo "Failed to edit zulip post" >&2 } zulip_autofail() { code=$? com=$BASH_COMMAND zulip_edit "Failed '$com' with exit code $code." } if [[ $zulip_post ]]; then trap zulip_autofail ERR; fi # see https://github.com/coq/coq/pull/15807 ulimit -S -s $((2 * $(ulimit -s))) # Clone the indicated git-repository. coq_dir="$working_dir/coq" git clone -q "$new_coq_repository" "$coq_dir" cd "$coq_dir" git remote rename origin new_coq_repository git remote add old_coq_repository "$old_coq_repository" git fetch -q "$old_coq_repository" git checkout -q $new_coq_commit coq_opam_version=dev # -------------------------------------------------------------------------------- new_opam_root="$working_dir/opam.NEW" old_opam_root="$working_dir/opam.OLD" # -------------------------------------------------------------------------------- old_coq_opam_archive_dir="$working_dir/old_coq_opam_archive" git clone -q --depth 1 -b "$old_coq_opam_archive_git_branch" "$old_coq_opam_archive_git_uri" "$old_coq_opam_archive_dir" new_coq_opam_archive_dir="$working_dir/new_coq_opam_archive" git clone -q --depth 1 -b "$new_coq_opam_archive_git_branch" "$new_coq_opam_archive_git_uri" "$new_coq_opam_archive_dir" initial_opam_packages="num ocamlfind dune" # Create an opam root and install Coq # $1 = root_name {ex: NEW / OLD} # $2 = compiler name # $3 = git hash of Coq to be installed # $4 = directory of coq opam archive # $5 = use flambda if nonempty create_opam() { local RUNNER="$1" local OPAM_DIR="$working_dir/opam.$RUNNER" local OCAML_VER="$2" local COQ_HASH="$3" local COQ_VER="$4" local OPAM_COQ_DIR="$5" local USE_FLAMBDA="$6" local OPAM_COMP=ocaml-base-compiler.$OCAML_VER export OPAMROOT="$OPAM_DIR" export COQ_RUNNER="$RUNNER" opam init --disable-sandboxing -qn -j$number_of_processors --bare # Allow beta compiler switches opam repo add -q --set-default beta https://github.com/ocaml/ocaml-beta-repository.git # Allow experimental compiler switches opam repo add -q --set-default ocaml-pr https://github.com/ejgallego/ocaml-pr-repository.git # Rest of default switches opam repo add -q --set-default iris-dev "https://gitlab.mpi-sws.org/FP/opam-dev.git" if [[ $USE_FLAMBDA = 1 ]]; then flambda=--packages=ocaml-variants.${OCAML_VER}+options,ocaml-option-flambda else flambda= fi opam switch create -qy -j$number_of_processors "ocaml-$RUNNER" "$OPAM_COMP" $flambda eval $(opam env) # For some reason opam guesses an incorrect upper bound on the # number of jobs available on Travis, so we set it here manually: opam var --global jobs=$number_of_processors >/dev/null if [ ! -z "$BENCH_DEBUG" ]; then opam config list; fi opam repo add -q --this-switch coq-extra-dev "$OPAM_COQ_DIR/extra-dev" opam repo add -q --this-switch coq-released "$OPAM_COQ_DIR/released" # Pinning for packages that are not in a repository opam pin add -ynq coq-perennial.dev git+https://github.com/mit-pdos/perennial#coq/tested opam install -qy -j$number_of_processors $initial_opam_packages if [ ! -z "$BENCH_DEBUG" ]; then opam repo list; fi cd "$coq_dir" echo "$1_coq_commit = $COQ_HASH" echo "wrap-build-commands: [\"$program_path/wrapper.sh\"]" >> "$OPAM_DIR/config" git checkout -q $COQ_HASH COQ_HASH_LONG=$(git log --pretty=%H | head -n 1) echo "$1_coq_commit_long = $COQ_HASH_LONG" if [ ! -z "$coq_native" ]; then opam install coq-native; fi for package in coq-core coq-stdlib coqide-server coq; do export COQ_OPAM_PACKAGE=$package export COQ_ITERATION=1 # build stdlib with -j 1 to get nicer timings local this_nproc=$number_of_processors if [ "$package" = coq-stdlib ]; then this_nproc=1; fi _RES=0 opam pin add -y -b -j "$this_nproc" --kind=path $package.$COQ_VER . \ 3>$log_dir/$package.$RUNNER.opam_install.1.stdout.log 1>&3 \ 4>$log_dir/$package.$RUNNER.opam_install.1.stderr.log 2>&4 || \ _RES=$? if [ $_RES = 0 ]; then echo "$package ($RUNNER) installed successfully" else echo "ERROR: \"opam install $package.$coq_opam_version\" has failed (for the $RUNNER commit = $COQ_HASH_LONG)." zulip_edit "Bench failed: could not install $package ($RUNNER)." exit 1 fi # we don't multi compile coq for now (TODO some other time) # the render needs all the files so copy them around for it in $(seq 2 $num_of_iterations); do cp "$log_dir/$package.$RUNNER.1.time" "$log_dir/$package.$RUNNER.$it.time" cp "$log_dir/$package.$RUNNER.1.perf" "$log_dir/$package.$RUNNER.$it.perf" done done } # Create an OPAM-root to which we will install the NEW version of Coq. create_opam "NEW" "$new_ocaml_version" "$new_coq_commit" "$new_coq_version" \ "$new_coq_opam_archive_dir" "$new_ocaml_flambda" new_coq_commit_long="$COQ_HASH_LONG" # Create an OPAM-root to which we will install the OLD version of Coq. create_opam "OLD" "$old_ocaml_version" "$old_coq_commit" "$old_coq_version" \ "$old_coq_opam_archive_dir" "$old_ocaml_flambda" old_coq_commit_long="$COQ_HASH_LONG" # Packages which appear in the rendered table # Deliberately don't include the "coqide-server" and "coq" packages installable_coq_opam_packages="coq-core coq-stdlib" echo "DEBUG: $render_results $log_dir $num_of_iterations $new_coq_commit_long $old_coq_commit_long 0 user_time_pdiff $installable_coq_opam_packages" rendered_results="$($render_results "$log_dir" $num_of_iterations $new_coq_commit_long $old_coq_commit_long 0 user_time_pdiff $installable_coq_opam_packages)" echo "${rendered_results}" zulip_edit "Benching continues..." format_vosize() { old=$(stat -c%s $2) new=$(stat -c%s $3) diff=$((new - old)) diffpercent=$(((diff * 100) / $old)) echo "$1 $old $new $diff $diffpercent%" } # HTML for stdlib # NB: unlike coq_makefile packages, stdlib produces foo.timing not foo.v.timing new_base_path=$new_opam_root/ocaml-NEW/.opam-switch/build/coq-stdlib.dev/_build/default/theories/ old_base_path=$old_opam_root/ocaml-OLD/.opam-switch/build/coq-stdlib.dev/_build/default/theories/ for vo in $(cd $new_base_path/; find . -name '*.vo'); do if [ -e $old_base_path/$vo ]; then format_vosize "$coq_opam_package/$vo" "$old_base_path/$vo" "$new_base_path/$vo" >> "$log_dir/vosize.log" fi if [ -e $old_base_path/${vo%%.vo}.timing ] && \ [ -e $new_base_path/${vo%%.vo}.timing ]; then mkdir -p $working_dir/html/coq-stdlib/$(dirname $vo)/ # NB: sometimes randomly fails $timelog2html $new_base_path/${vo%%o} \ $old_base_path/${vo%%.vo}.timing \ $new_base_path/${vo%%.vo}.timing > \ $working_dir/html/coq-stdlib/${vo%%o}.html || echo "Failed (code $?):" $timelog2html $new_base_path/${vo%%o} \ $old_base_path/${vo%%.vo}.timing \ $new_base_path/${vo%%.vo}.timing fi done # -------------------------------------------------------------------------------- # Measure the compilation times of the specified OPAM packages in both switches # Sort the opam packages sorted_coq_opam_packages=$("${program_path}/sort-by-deps.sh" ${coq_opam_packages}) echo "sorted_coq_opam_packages = ${sorted_coq_opam_packages}" failed_packages= skipped_packages= # Generate per line timing info in devs that use coq_makefile export TIMING=1 export PROFILING=1 export COQ_PROFILE_COMPONENTS=command,parse_command for coq_opam_package in $sorted_coq_opam_packages; do export COQ_OPAM_PACKAGE=$coq_opam_package if [ ! -z "$BENCH_DEBUG" ]; then opam list opam show $coq_opam_package || { failed_packages="$failed_packages $coq_opam_package (unknown package)" continue } else # cause to skip with error if unknown package opam show $coq_opam_package >/dev/null || { failed_packages="$failed_packages $coq_opam_package (unknown package)" continue } fi echo "coq_opam_package = $coq_opam_package" for RUNNER in NEW OLD; do export COQ_RUNNER=$RUNNER # perform measurements for the NEW/OLD commit (provided by the user) if [ $RUNNER = "NEW" ]; then export OPAMROOT="$new_opam_root" echo "Testing NEW commit: $(date)" else export OPAMROOT="$old_opam_root" echo "Testing OLD commit: $(date)" fi eval $(opam env) # If a given OPAM-package was already installed (as a # dependency of some OPAM-package that we have benchmarked # before), remove it. opam uninstall -q $coq_opam_package >/dev/null 2>&1 for dep in $(opam install --show-actions "$coq_opam_package" | grep -o '∗\s*install\s*[^ ]*' | sed 's/∗\s*install\s*//g'); do # show-actions will print transitive deps # so we don't need to look at the skipped_packages if echo "$failed_packages" | grep -q "$dep"; then skipped_packages="$skipped_packages $coq_opam_package (dependency $dep failed)" continue 3 fi done # OPAM 2.0 likes to ignore the -j when it feels like :S so we # workaround that here. opam var --global jobs=$number_of_processors >/dev/null opam install $coq_opam_package -v -b -j$number_of_processors --deps-only -y \ 3>$log_dir/$coq_opam_package.$RUNNER.opam_install.deps_only.stdout.log 1>&3 \ 4>$log_dir/$coq_opam_package.$RUNNER.opam_install.deps_only.stderr.log 2>&4 || { failed_packages="$failed_packages $coq_opam_package (dependency install failed in $RUNNER)" continue 2 } opam var --global jobs=1 >/dev/null if [ ! -z "$BENCH_DEBUG" ]; then ls -l $working_dir; fi for iteration in $(seq $num_of_iterations); do export COQ_ITERATION=$iteration _RES=0 timeout "$timeout" opam install -v -b -j1 $coq_opam_package \ 3>$log_dir/$coq_opam_package.$RUNNER.opam_install.$iteration.stdout.log 1>&3 \ 4>$log_dir/$coq_opam_package.$RUNNER.opam_install.$iteration.stderr.log 2>&4 || \ _RES=$? if [ $_RES = 0 ]; then echo $_RES > $log_dir/$coq_opam_package.$RUNNER.opam_install.$iteration.exit_status # "opam install" was successful. # Remove the benchmarked OPAM-package, unless this is the # very last iteration (we want to keep this OPAM-package # because other OPAM-packages we will benchmark later # might depend on it --- it would be a waste of time to # remove it now just to install it later) if [ $iteration != $num_of_iterations ]; then opam uninstall -q $coq_opam_package fi else # "opam install" failed. echo $_RES > $log_dir/$coq_opam_package.$RUNNER.opam_install.$iteration.exit_status failed_packages="$failed_packages $coq_opam_package" continue 3 fi done done installable_coq_opam_packages="$installable_coq_opam_packages $coq_opam_package" # -------------------------------------------------------------- cat $log_dir/$coq_opam_package.$RUNNER.1.*.time || true cat $log_dir/$coq_opam_package.$RUNNER.1.*.perf || true # Print the intermediate results after we finish benchmarking each OPAM package if [ "$coq_opam_package" = "$(echo $sorted_coq_opam_packages | sed 's/ /\n/g' | tail -n 1)" ]; then # It does not make sense to print the intermediate results when # we finished bechmarking the very last OPAM package because the # next thing will do is that we will print the final results. # It would look lame to print the same table twice. : else echo "DEBUG: $render_results "$log_dir" $num_of_iterations $new_coq_commit_long $old_coq_commit_long 0 user_time_pdiff $installable_coq_opam_packages" rendered_results="$($render_results "$log_dir" $num_of_iterations $new_coq_commit_long $old_coq_commit_long 0 user_time_pdiff $installable_coq_opam_packages)" echo "${rendered_results}" # update the comment coqbot_update_comment "" "${rendered_results}" "" msg="Benching continues..." if [ -n "$failed_packages" ]; then msg="$msg Failed: $failed_packages $skipped_packages" fi zulip_edit "Benching continues..." fi # N.B. Not all packages end in .dev, e.g., coq-lambda-rust uses .dev.timestamp. # So we use a wildcard to catch such packages. coq_opam_package_nover=${coq_opam_package%%.*} new_base_path=$(echo "$new_opam_root/ocaml-NEW/.opam-switch/build/$coq_opam_package_nover".*/) old_base_path=$(echo "$old_opam_root/ocaml-OLD/.opam-switch/build/$coq_opam_package_nover".*/) # Generate per-file comparison for iteration in $(seq $num_of_iterations); do # opam logs prefix the printing with "- " so remove that # remove the base path for nicer printing and so the script can identify common files "$program_path"/../../tools/make-both-time-files.py --real \ <(sed -e 's/^- //' -e "s:$new_base_path::" "$log_dir/$coq_opam_package.NEW.opam_install.$iteration.stdout.log") \ <(sed -e 's/^- //' -e "s:$old_base_path::" "$log_dir/$coq_opam_package.OLD.opam_install.$iteration.stdout.log") \ > "$log_dir/$coq_opam_package.BOTH.perfile_timings.$iteration.log" done # Generate HTML report for LAST run for vo in $(cd $new_base_path/; find . -name '*.vo'); do if [ -e $old_base_path/$vo ]; then format_vosize "$coq_opam_package/$vo" "$old_base_path/$vo" "$new_base_path/$vo" >> "$log_dir/vosize.log" fi if [ -e $old_base_path/${vo%%o}.timing ] && \ [ -e $new_base_path/${vo%%o}.timing ]; then mkdir -p $working_dir/html/$coq_opam_package/$(dirname $vo)/ # NB: sometimes randomly fails $timelog2html $new_base_path/${vo%%o} \ $old_base_path/${vo%%o}.timing \ $new_base_path/${vo%%o}.timing > \ $working_dir/html/$coq_opam_package/${vo%%o}.html || echo "Failed (code $?):" $timelog2html $new_base_path/${vo%%o} \ $old_base_path/${vo%%o}.timing \ $new_base_path/${vo%%o}.timing fi done done # Since we do not upload all files, store a list of the files # available so that if we at some point want to tweak which files we # upload, we'll know which ones are available for upload du -ha "$working_dir" > "$working_dir/files.listing" # The following directories in $working_dir are no longer used: # # - coq, opam.OLD, opam.NEW # Measured data for each `$coq_opam_package`, `$iteration`, `status \in {NEW,OLD}`: # # - $working_dir/$coq_opam_package.$status.$iteration.time # => output of /usr/bin/time --format="%U" ... # # - $working_dir/$coq_opam_package.NEW.$iteration.perf # => output of perf stat -e instructions:u,cycles:u ... # # The next script processes all these files and prints results in a table. # Generate per-file comparison for everything at once new_base_path=$new_opam_root/ocaml-NEW/.opam-switch/build/ old_base_path=$old_opam_root/ocaml-OLD/.opam-switch/build/ for iteration in $(seq $num_of_iterations); do "$program_path"/../../tools/make-both-time-files.py --real \ <(sed -e 's/^- //' -e "s:$new_base_path::" "$log_dir/"*".NEW.opam_install.$iteration.stdout.log") \ <(sed -e 's/^- //' -e "s:$old_base_path::" "$log_dir/"*".OLD.opam_install.$iteration.stdout.log") \ > "$log_dir/ALL.BOTH.perfile_timings.$iteration.log" done # timings data timings=$working_dir/timings mkdir -p $timings # Print line by line slow downs and speed ups if [ -d "$working_dir/html" ]; then # might not exist if all jobs failed cd "$working_dir/html" $render_line_results # Move line timing files to timings folder (they will become artifacts) mv fast_table slow_table timings_table $timings # html tables don't get generated if the bench is run locally ie without CI variables for f in fast_table.html slow_table.html timings_table.html; do if [ -f "$f" ]; then mv "$f" $timings; fi done fi echo "INFO: workspace = ${CI_JOB_URL}/artifacts/browse/${bench_dirname}" # Print the final results. if [ -z "$installable_coq_opam_packages" ]; then # Tell the user that none of the OPAM-package(s) the user provided # /are installable. printf "\n\nINFO: failed to install: $sorted_coq_opam_packages" coqbot_update_comment "done" "" "$sorted_coq_opam_packages" exit 1 fi echo "DEBUG: $render_results $log_dir $num_of_iterations $new_coq_commit_long $old_coq_commit_long 0 user_time_pdiff $installable_coq_opam_packages" rendered_results="$($render_results "$log_dir" $num_of_iterations $new_coq_commit_long $old_coq_commit_long 0 user_time_pdiff $installable_coq_opam_packages)" echo "${rendered_results}" echo "${rendered_results}" > $timings/bench_summary echo "INFO: per line timing: ${CI_JOB_URL}/artifacts/browse/${bench_dirname}/html/" cd "$coq_dir" echo INFO: Old Coq version git log -n 1 "$old_coq_commit" echo INFO: New Coq version git log -n 1 "$new_coq_commit" if [ -n "$failed_packages" ]; then not_installable_coq_opam_packages=$failed_packages if [ -n "$skipped_packages" ]; then not_installable_coq_opam_packages="$not_installable_coq_opam_packages $skipped_packages" fi else # in case the failed package detection is bugged not_installable_coq_opam_packages=$(comm -23 <(echo $sorted_coq_opam_packages | sed 's/ /\n/g' | sort | uniq) <(echo $installable_coq_opam_packages | sed 's/ /\n/g' | sort | uniq) | sed 's/\t//g') fi coqbot_update_comment "done" "${rendered_results}" "${not_installable_coq_opam_packages}" touch $timings/bench_failures if [ -n "$not_installable_coq_opam_packages" ]; then # Tell the user that some of the provided OPAM-package(s) # is/are not installable. printf '\n\nINFO: failed to install %s\n' "$not_installable_coq_opam_packages" | tee $timings/bench_failures zulip_edit "Bench complete, failed to install packages: $not_installable_coq_opam_packages" exit 1 fi zulip_edit "Bench complete: all packages successfully installed." coq-8.20.0/dev/bench/benchUtil.ml000066400000000000000000000035141466560755400165140ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* exit 1) stderr fmt type char_loc = { start_char : int; stop_char : int; } type source_loc = { chars : char_loc; line : int; text : string; } let same_char_locs a b = a.start_char = b.start_char && a.stop_char = b.stop_char type measure = { str: string; q: Q.t; } let dummy_measure = { str="0"; q=Q.zero; } let combine_related_data data = let nvals = Array.length (snd (data.(0))) in let fname0, data0 = data.(0) in let () = Array.iter (fun (fname, v) -> if nvals <> Array.length v then die "Mismatch between %s and %s: different measurement counts\n" fname0 fname) data in Array.init nvals (fun i -> let loc0, _ = data0.(i) in let data = data |> Array.map (fun (fname, fdata) -> let floc, v = fdata.(i) in if same_char_locs loc0 floc then v else die "Mismatch between %s and %s (measurement %d)\n" fname0 fname (i+1)) in loc0, data) let read_whole_file f = let sourcelen = (Unix.stat f).st_size in let ch = try open_in f with Sys_error e -> die "Could not open %s: %s" f e in let s = really_input_string ch sourcelen in close_in ch; s coq-8.20.0/dev/bench/benchUtil.mli000066400000000000000000000023211466560755400166600ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* (char_loc * 'a array) array (** Combine data from multiple files about the same source, ensuring that the locations do not have inconsistencies. *) val read_whole_file : string -> string coq-8.20.0/dev/bench/dune000066400000000000000000000007771466560755400151330ustar00rootroot00000000000000(library (name table) (modules table) (libraries clib)) (executable (name render_results) (modules render_results) (libraries unix table clib)) (executable (name render_line_results) (modules render_line_results) (libraries unix table str clib)) (library (name benchlib) (modules benchUtil sourcehandler timelogparser htmloutput) (libraries unix str clib zarith)) (executable (name timelog2html) (public_name coqtimelog2html) (package coq-core) (modules timelog2html) (libraries benchlib)) coq-8.20.0/dev/bench/gitlab-bench.yml000066400000000000000000000012331466560755400173030ustar00rootroot00000000000000 bench: stage: build-0 needs: [] when: manual before_script: - printenv -0 | sort -z | tr '\0' '\n' script: dev/bench/bench.sh tags: - timing variables: GIT_DEPTH: "" artifacts: name: "$CI_JOB_NAME" paths: - _bench/html/**/*.v.html - _bench/logs - _bench/timings/* - _bench/files.listing - _bench/opam.NEW/**/*.log - _bench/opam.NEW/**/*.timing - _bench/opam.NEW/**/*.prof.json.gz - _bench/opam.OLD/**/*.log - _bench/opam.OLD/**/*.timing - _bench/opam.OLD/**/*.prof.json.gz when: always expire_in: 1 year environment: bench interruptible: false timeout: 1d coq-8.20.0/dev/bench/htmloutput.ml000066400000000000000000000065451466560755400170330ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* \"]" in let subst s = match Str.matched_string s with | "&" -> "&" | "<" -> "<" | ">" -> ">" | "\"" -> """ | _ -> assert false in fun s -> Str.global_substitute r subst s let percentage ~max:m v = Q.to_float Q.(v * of_int 100 / m) let output ch ~vname ~data_files all_data = let out fmt = Printf.fprintf ch fmt in let ndata = Array.length data_files in let maxq = Array.fold_left (fun max (_,data) -> Array.fold_left (fun max d -> let dq = d.q in if Q.lt max dq then dq else max) max data) Q.zero all_data in let () = out {| %s |} in let () = out "

Timings for %s

\n" vname in let () = out "
    \n" in let () = data_files |> Array.iteri (fun i data_file -> out "
  1. %s
    2. \n" colors.(i) data_file) in let () = out "
\n" in let () = out "
" in

let last_seen_line = ref 0 in

let line_id fmt l =
  if l > !last_seen_line then begin
    last_seen_line := l;
    Printf.fprintf fmt "id=\"L%d\" " l
  end
in

let () = all_data |> Array.iteri (fun j (loc,time) ->
    let () = out {|
|} in

    let () = time |> Array.iteri (fun k d ->
        out {|
|}
          (k+1)
          (percentage d.q ~max:maxq))
    in

    let text = loc.text in
    let text = if text <> "" && text.[0] = '\n'
      then String.sub text 1 (String.length text  - 1)
      else text
    in
    let sublines = String.split_on_char '\n' text in
    let () = sublines |> List.iteri (fun i line ->
        let lnum = loc.line + i in
        out "%s\n" line_id lnum lnum (htmlescape line))
    in

    let () = out "
" in
    ())
in

let () =
  out
{|
|} in () coq-8.20.0/dev/bench/htmloutput.mli000066400000000000000000000016031466560755400171720ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* vname:string -> data_files:string array -> (BenchUtil.source_loc * BenchUtil.measure array) array -> unit val max_data_count : int (** Max length supported for the inner [measure array]. *) coq-8.20.0/dev/bench/plotter000077500000000000000000000103721466560755400156640ustar00rootroot00000000000000#!/usr/bin/env python3 import matplotlib.pyplot as plt import xdg import re import pycurl import certifi import os import sys from bs4 import BeautifulSoup from io import BytesIO # where we get the bench list from # sadly message edits don't appear in the public archive so we have to # download the gitlab raw logs too # (maybe we should be getting the messages from the zulip API instead??) archive = 'https://coq.gitlab.io/zulip-archive/stream/240008-GitHub-notifications/topic/Bench.20Notifications.html' print ('Getting bench list.') buffer = BytesIO() c = pycurl.Curl() c.setopt(c.URL, archive) c.setopt(c.WRITEFUNCTION, buffer.write) c.setopt(c.CAINFO, certifi.where()) c.perform() c.close() str = buffer.getvalue().decode('utf8') print ('Parsing bench list.') # parse HTML and remove tags # NB since coq was made default language on zulip the tables are full of tags # so we really don't want to keep them str = BeautifulSoup(str, "html.parser").text # NB: the line with the date starts with a space # (in the original there is the avatar broken image) datere = re.compile(' Bench bot \((.*)\):') jobre = re.compile('Bench at https://gitlab.com/coq/coq/-/jobs/(.*)$') benches=[] curdate=None for line in iter(str.splitlines()): match = re.match(datere, line) if match: # Next post curdate = match[1] else: match = re.match(jobre, line) if match: job = match[1] benches += [(curdate, match[1])] cachedir = xdg.xdg_cache_home() / "coq-bench-plotter" os.makedirs(cachedir, exist_ok=True) ## download job logs print ('Downloading job logs.') m = pycurl.CurlMulti() m.setopt(pycurl.M_MAX_HOST_CONNECTIONS, 8) files=[] for _, job in benches: fname = cachedir / (job + '.log') if not(os.path.exists(fname)): f = open(fname, 'xb') # x: will error if already exists files += [f] c = pycurl.Curl() c.setopt(c.URL, 'https://gitlab.com/coq/coq/-/jobs/' + job + '/raw') c.setopt(c.WRITEFUNCTION, f.write) c.setopt(c.CAINFO, certifi.where()) c.setopt(c.FOLLOWLOCATION, True) m.add_handle(c) num_handles = len(files) while num_handles: print (f'Downloading {num_handles} log files.') ret = m.select(5.0) if ret == -1: continue while 1: ret, num_handles = m.perform() if ret != pycurl.E_CALL_MULTI_PERFORM: break for f in files: f.flush() f.close() ## parse job logs print ('Parsing job logs.') # captures package name and OLD time # the numerals are to avoid matching the table header packre = re.compile('│[ ]+([^ ]+) │[ ]+[^ ]+[ ]+([0-9][^ ]*)[ ]+([^ ]+)') parsed=[] for date, job in benches: cur={} fname = cachedir / (job + '.log') with open(fname) as f: for l in f: match = re.match(packre, l) if match: # the table appears multiple times in the log so this may be overriding the value # that is OK (it's not worth bothering to find the last table) cur[match[1]] = (match[2], match[3]) if cur: parsed += [(date, job, cur)] def filter_to(packname): dates=[] jobs=[] times=[] changes=[] for date, job, packs in parsed: if packname in packs: dates += [date] jobs += [job] time, change = packs[packname] times += [float(time)] changes += [float(change)] return dates, jobs, times, changes def plot(packname): dates, jobs, times, changes = filter_to(packname) # alternatively you can use dates for x axis, times for y axis # with x = jobs, if you find an interesting point, hover the mouse on it # pyplot will say somewhere in the window "x=..., y=..." # now if you don't want to read and type the whole 10 digit number # export as svg and search for the last 3 digits followed by a space # it should be easy to find a xml comment with the job number eg "" plt.plot(jobs, changes) plt.ylabel(packname) plt.show() def list_packs(): known={} for _, _, packs in parsed: for pack in packs.keys(): if pack in known.keys(): known[pack] += 1 else: known[pack] = 1 return known plot(sys.argv[1]) coq-8.20.0/dev/bench/render_line_results.ml000066400000000000000000000135741466560755400206550ustar00rootroot00000000000000 (** Recursively list .html files' relative directories in given directory *) let list_html_files dir = let rec loop result = function | f :: fs when Sys.is_directory f -> Sys.readdir f |> Array.to_list |> CList.map (Filename.concat f) |> CList.append fs |> loop result | f :: fs -> if Filename.check_suffix f ".html" then loop (f::result) fs else loop result fs | [] -> result in Sys.readdir dir |> Array.to_list |> loop [] exception UnableToParse (** Read all the lines of a file into a list *) let read_timing_lines file = let ic = open_in file in (* We tail recursively read lines in the file discarding the uninteresting ones *) let rec read_lines_aux acc = match input_line ic with | line -> if Str.string_match (Str.regexp "Line:.*") line 0 then (* We know this line is ["Line:"] *) let line_num = match Str.split (Str.regexp " ") line with | _ :: ln :: _ -> int_of_string ln | _ -> raise @@ UnableToParse in (* Second line is empty *) let _ = input_line ic in (* Time1 - we have floats written with s so with split that too *) let time1 = match Str.split (Str.regexp "[ s]") (input_line ic) with | _ :: time1_str :: _ -> float_of_string time1_str | _ -> raise @@ UnableToParse in (* Time2 *) let time2 = match Str.split (Str.regexp "[ s]") (input_line ic) with | _ :: time2_str :: _ -> float_of_string time2_str | _ -> raise @@ UnableToParse in (* Difference *) let diff = time2 -. time1 in (* Percentage diff *) let pdiff = if time1 <> 0.0 then (diff *. 100.0) /. time1 else Float.infinity in (* We accumulate the timing data in a tuple if the difference is non-zero *) (* We also check that timed values are not too small (tolerence is trial and error) *) if Float.abs diff <= 1e-4 then acc |> read_lines_aux else (time1, time2, diff, pdiff, line_num, file) :: acc |> read_lines_aux else read_lines_aux acc | exception End_of_file -> acc in let lines = try Some (read_lines_aux []) with End_of_file -> Printf.eprintf "*** Error: Could not read file %s.\n" file; None in close_in ic; lines type html_data = { link_prefix : string } let get_html_data () = match Sys.getenv_opt "CI_PAGES_DOMAIN", Sys.getenv_opt "CI_PROJECT_NAMESPACE", Sys.getenv_opt "CI_PROJECT_NAME", Sys.getenv_opt "CI_JOB_ID" with | Some domain, Some ns, Some project, Some id -> Some { link_prefix = Printf.sprintf "https://%s.%s/-/%s/-/jobs/%s/artifacts/_bench/html/" ns domain project id } | None, _, _, _ | _, None, _, _ | _, _, None, _ | _, _, _, None -> None let html_str ?html lnum s = match html with | None -> Table.raw_str s | Some html -> let size = String.length s in let s = Printf.sprintf "%s" html.link_prefix s lnum s in { Table.str = s; size } let list_timing_data ?html (time1, time2, diff, pdiff, line_num, file) = let str_time1 = Printf.sprintf "%.4f" time1 in let str_time2 = Printf.sprintf "%.4f" time2 in let str_diff = Printf.sprintf "%.4f" diff in let str_pdiff = Printf.sprintf "%3.2f%%" pdiff in let str_line_num = string_of_int line_num in List.append (List.map Table.raw_str [ str_time1; str_time2; str_diff; str_pdiff; str_line_num]) [ html_str ?html line_num file ] let render_table ?(reverse=false) title num table = let open Table.Align in let headers = [Table.raw_str title] in let top = Table.raw_row [["OLD"; "NEW"; "DIFF"; "%DIFF"; "Ln"; "FILE"]] in let align_top = [[Middle; Middle; Middle; Middle; Middle; MidLeft]] in let align_rows = [[Right; Right; Right; Right; Right; Left]] in (if reverse then CList.rev table else table) |> CList.firstn num |> fun x -> Table.print headers top x ~align_top ~align_rows () let to_file fname fmt = Printf.kfprintf close_out (open_out fname) fmt let main () = let () = Printexc.record_backtrace true in let data = Unix.getcwd () |> list_html_files |> CList.filter_map read_timing_lines |> CList.flatten (* Do we want to do a unique sort? *) (* |> CList.sort_uniq (fun (_,_,x,_,_,_) (_,_,y,_,_,_) -> Float.compare x y) *) |> CList.sort (fun (_,_,x,_,_,_) (_,_,y,_,_,_) -> Float.compare x y) in let table = data |> CList.map list_timing_data |> CList.map (fun x -> [ x ]) in (* What is a good number to choose? *) let num = 25 in let num = min num (CList.length table) in let slow_table = render_table (Printf.sprintf "TOP %d SLOW DOWNS" num) ~reverse:true num table in let fast_table = render_table (Printf.sprintf "TOP %d SPEED UPS" num) num table in let timings_table = render_table "Significant line time changes in bench" (CList.length table) table in (* Print tables to stdout *) Printf.printf "%s\n%s\n" slow_table fast_table; (* Print tables to files *) to_file "slow_table" "%s\n" slow_table; to_file "fast_table" "%s\n" fast_table; to_file "timings_table" "%s\n" timings_table; (* html tables *) match get_html_data () with | None -> () | Some html -> let table = data |> CList.map (list_timing_data ~html) |> CList.map (fun x -> [ x ]) in let slow_table = render_table (Printf.sprintf "TOP %d SLOW DOWNS" num) ~reverse:true num table in let fast_table = render_table (Printf.sprintf "TOP %d SPEED UPS" num) num table in let timings_table = render_table "Significant line time changes in bench" (CList.length table) table in to_file "slow_table.html" "
%s
\n" slow_table; to_file "fast_table.html" "
%s
\n" fast_table; to_file "timings_table.html" "
%s
\n" timings_table; () let () = main () coq-8.20.0/dev/bench/render_line_results.mli000066400000000000000000000000001466560755400210020ustar00rootroot00000000000000coq-8.20.0/dev/bench/render_results.ml000077500000000000000000000237041466560755400176450ustar00rootroot00000000000000 (* ASSUMPTIONS: - the 1-st command line argument (working directory): - designates an existing readable directory - which contains *.time and *.perf files produced by bench.sh script - the 2-nd command line argument (number of iterations): - is a positive integer - the 3-rd command line argument (minimal user time): - is a positive floating point number - the 4-th command line argument determines the name of the column according to which the resulting table will be sorted. Valid values are: - package_name - user_time_pdiff - the rest of the command line-arguments - are names of benchamarked Coq OPAM packages for which bench.sh script generated *.time and *.perf files *) open Printf ;; let _ = Printexc.record_backtrace true ;; type ('a,'b) pkg_timings = { user_time : 'a; num_instr : 'b; num_cycles : 'b; num_mem : 'b; } ;; let reduce_pkg_timings (m_f : 'a list -> 'c) (m_a : 'b list -> 'd) (t : ('a,'b) pkg_timings list) : ('c,'d) pkg_timings = { user_time = m_f @@ CList.map (fun x -> x.user_time) t ; num_instr = m_a @@ CList.map (fun x -> x.num_instr) t ; num_cycles = m_a @@ CList.map (fun x -> x.num_cycles) t ; num_mem = m_a @@ CList.map (fun x -> x.num_mem) t } ;; (******************************************************************************) (* BEGIN Copied from batteries, to remove *) (******************************************************************************) let run_and_read cmd = (* This code is before the open of BatInnerIO to avoid using batteries' wrapped IOs *) let string_of_file fn = let buff_size = 1024 in let buff = Buffer.create buff_size in let ic = open_in fn in let line_buff = Bytes.create buff_size in begin let was_read = ref (input ic line_buff 0 buff_size) in while !was_read <> 0 do Buffer.add_subbytes buff line_buff 0 !was_read; was_read := input ic line_buff 0 buff_size; done; close_in ic; end; Buffer.contents buff in let tmp_fn = Filename.temp_file "" "" in let cmd_to_run = cmd ^ " > " ^ tmp_fn in let status = Unix.system cmd_to_run in let output = string_of_file tmp_fn in Unix.unlink tmp_fn; (status, output) ;; let ( %> ) f g x = g (f x) let run = run_and_read %> snd module Float = struct let nan = nan end module CList = struct include CList let rec init_tailrec_aux acc i n f = if i >= n then acc else init_tailrec_aux (f i :: acc) (i+1) n f let rec init_aux i n f = if i >= n then [] else let r = f i in r :: init_aux (i+1) n f let rev_init_threshold = match Sys.backend_type with | Sys.Native | Sys.Bytecode -> 10_000 (* We don't known the size of the stack, better be safe and assume it's small. *) | Sys.Other _ -> 50 let init len f = if len < 0 then invalid_arg "CList.init" else if len > rev_init_threshold then rev (init_tailrec_aux [] 0 len f) else init_aux 0 len f let rec drop n = function | _ :: l when n > 0 -> drop (n-1) l | l -> l let reduce f = function | [] -> invalid_arg "CList.reduce: Empty CList" | h :: t -> fold_left f h t let min l = reduce Stdlib.min l end ;; module String = struct include String let rchop ?(n = 1) s = if n < 0 then invalid_arg "String.rchop: number of characters to chop is negative" else let slen = length s in if slen <= n then "" else sub s 0 (slen - n) end ;; (******************************************************************************) (* END Copied from batteries, to remove *) (******************************************************************************) let add_timings a b = { user_time = a.user_time +. b.user_time; num_instr = a.num_instr + b.num_instr; num_cycles = a.num_cycles + b.num_cycles; num_mem = a.num_mem + b.num_mem; } let mk_pkg_timings work_dir pkg_name suffix iteration = let command_prefix = "cat " ^ work_dir ^ "/" ^ pkg_name ^ suffix ^ string_of_int iteration in let ncoms = command_prefix ^ ".ncoms" |> run |> String.rchop ~n:1 |> int_of_string in let timings = CList.init ncoms (fun ncom -> let command_prefix = command_prefix ^ "." ^ string_of_int (ncom+1) in let time_command_output = command_prefix ^ ".time" |> run |> String.rchop ~n:1 |> String.split_on_char ' ' in let nth x i = CList.nth i x in { user_time = time_command_output |> nth 0 |> float_of_string (* Perf can indeed be not supported in some systems, so we must fail gracefully *) ; num_instr = (try command_prefix ^ ".perf | grep instructions:u | awk '{print $1}' | sed 's/,//g'" |> run |> String.rchop ~n:1 |> int_of_string with Failure _ -> 0) ; num_cycles = (try command_prefix ^ ".perf | grep cycles:u | awk '{print $1}' | sed 's/,//g'" |> run |> String.rchop ~n:1 |> int_of_string with Failure _ -> 0) ; num_mem = time_command_output |> nth 1 |> int_of_string }) in match timings with | [] -> assert false | timing :: rest -> CList.fold_left add_timings timing rest ;; (* process command line paramters *) assert (Array.length Sys.argv > 5); let work_dir = Sys.argv.(1) in let num_of_iterations = int_of_string Sys.argv.(2) in let new_coq_version = Sys.argv.(3) in let old_coq_version = Sys.argv.(4) in let minimal_user_time = float_of_string Sys.argv.(5) in let sorting_column = Sys.argv.(6) in let coq_opam_packages = Sys.argv |> Array.to_list |> CList.drop 7 in (* ASSUMPTIONS: "working_dir" contains all the files produced by the following command: two_points_on_the_same_branch.sh $working_directory $coq_repository $coq_branch[:$new:$old] $num_of_iterations coq_opam_package_1 coq_opam_package_2 ... coq_opam_package_N -sf *) (* Run a given bash command; wait until it termines; check if its exit status is 0; return its whole stdout as a string. *) let proportional_difference_of_integers new_value old_value = if old_value = 0 then Float.nan else float_of_int (new_value - old_value) /. float_of_int old_value *. 100.0 in (* parse the *.time and *.perf files *) coq_opam_packages |> CList.map (fun package_name -> package_name,(* compilation_results_for_NEW : (float * int * int * int) list *) CList.init num_of_iterations succ |> CList.map (mk_pkg_timings work_dir package_name ".NEW."), CList.init num_of_iterations succ |> CList.map (mk_pkg_timings work_dir package_name ".OLD.")) (* from the list of measured values, select just the minimal ones *) |> CList.map (fun ((package_name : string), (new_measurements : (float, int) pkg_timings list), (old_measurements : (float, int) pkg_timings list)) -> let f_min : float list -> float = CList.min in let i_min : int list -> int = CList.min in package_name, reduce_pkg_timings f_min i_min new_measurements, reduce_pkg_timings f_min i_min old_measurements ) (* compute the "proportional differences in % of the NEW measurement and the OLD measurement" of all measured values *) |> CList.map (fun (package_name, new_t, old_t) -> package_name, new_t, old_t, { user_time = (new_t.user_time -. old_t.user_time) /. old_t.user_time *. 100.0 ; num_instr = proportional_difference_of_integers new_t.num_instr old_t.num_instr ; num_cycles = proportional_difference_of_integers new_t.num_cycles old_t.num_cycles ; num_mem = proportional_difference_of_integers new_t.num_mem old_t.num_mem }) (* sort the table with results *) |> CList.sort (match sorting_column with | "user_time_pdiff" -> fun (_,_,_,perf1) (_,_,_,perf2) -> compare perf1.user_time perf2.user_time | "package_name" -> fun (n1,_,_,_) (n2,_,_,_) -> compare n1 n2 | _ -> assert false ) (* Keep only measurements that took at least "minimal_user_time" (in seconds). *) |> CList.filter (fun (_, new_t, old_t, _) -> minimal_user_time <= new_t.user_time && minimal_user_time <= old_t.user_time) (* Below we take the measurements and format them to stdout. *) |> CList.map begin fun (package_name, new_t, old_t, perc) -> let precision = 2 in let prf f = Printf.sprintf "%.*f" precision f in let pri n = Printf.sprintf "%d" n in [ [ package_name ]; [ prf new_t.user_time; prf old_t.user_time; prf perc.user_time ]; [ pri new_t.num_cycles; pri old_t.num_cycles; prf perc.num_cycles ]; [ pri new_t.num_instr; pri old_t.num_instr; prf perc.num_instr ]; [ pri new_t.num_mem; pri old_t.num_mem; prf perc.num_mem ]; ] end |> fun measurements -> let headers = [ ""; "user time [s]"; "CPU cycles"; "CPU instructions"; "max resident mem [KB]"; ] in let descr = ["NEW"; "OLD"; "PDIFF"] in let top = [ [ "package_name" ]; descr; descr; descr; descr ] in printf "%s%!" (Table.raw_print headers top measurements ()) ; (* ejgallego: disable this as it is very verbose and brings up little info in the log. *) if false then begin printf " PDIFF = proportional difference between measurements done for the NEW and the OLD Coq version = (NEW_measurement - OLD_measurement) / OLD_measurement * 100%% NEW = %s OLD = %s Columns: 1. user time [s] Total number of CPU-seconds that the process used directly (in user mode), in seconds. (In other words, \"%%U\" quantity provided by the \"/usr/bin/time\" command.) 2. CPU cycles Total number of CPU-cycles that the process used directly (in user mode). (In other words, \"cycles:u\" quantity provided by the \"/usr/bin/perf\" command.) 3. CPU instructions Total number of CPU-instructions that the process used directly (in user mode). (In other words, \"instructions:u\" quantity provided by the \"/usr/bin/perf\" command.) 4. max resident mem [KB] Maximum resident set size of the process during its lifetime, in Kilobytes. (In other words, \"%%M\" quantity provided by the \"/usr/bin/time\" command.) " new_coq_version old_coq_version; end coq-8.20.0/dev/bench/render_results.mli000066400000000000000000000000001466560755400177730ustar00rootroot00000000000000coq-8.20.0/dev/bench/sort-by-deps000066400000000000000000000020421466560755400165130ustar00rootroot00000000000000#!/usr/bin/env ocaml let get_pkg_name arg = List.nth (String.split_on_char ':' arg) 0 let get_pkg_deps arg = String.split_on_char ',' (List.nth (String.split_on_char ':' arg) 1) let split_pkg arg = get_pkg_name arg, get_pkg_deps arg let depends_on arg1 arg2 = let pkg1, deps1 = split_pkg arg1 in let pkg2, deps2 = split_pkg arg2 in pkg1 != pkg2 && List.mem pkg2 deps1 let rec sort = function | [], [] -> [] | [], deferred -> sort (List.rev deferred, []) | arg :: rest, deferred -> (* check if any remaining package reverse-depends on this one *) if List.exists (fun other_arg -> depends_on arg other_arg) rest then (* defer this package *) sort (rest, arg :: deferred) else (* emit this package, and then try again with any deferred packages *) arg :: sort (List.rev deferred @ rest, []) let main () = let args = Array.to_list Sys.argv in let pkgs = List.tl args in let sorted_pkgs = sort (pkgs, []) in Printf.printf "%s\n%!" (String.concat " " (List.map get_pkg_name sorted_pkgs)) let () = main () coq-8.20.0/dev/bench/sort-by-deps.sh000077500000000000000000000011711466560755400171310ustar00rootroot00000000000000#!/usr/bin/env bash program_name="$0" program_path=$(readlink -f "${program_name%/*}") # We add || true (which may not be needed without set -e) to be # explicit about the fact that this script does not fail even if `opam # install --show-actions` does, e.g., because of a non-existent # package # # TODO: Figure out how to use the OPAM API # (https://opam.ocaml.org/doc/api/) to call this from OCaml. for i in "$@"; do echo -n "$i:"; ((echo -n "$(opam install --show-actions "$i" | grep -o '∗\s*install\s*[^ ]*' | sed 's/∗\s*install\s*//g')" | tr '\n' ',') || true); echo done | xargs ocaml "${program_path}/sort-by-deps" coq-8.20.0/dev/bench/sourcehandler.ml000066400000000000000000000063471466560755400174440ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* = 4.13 *) let str_fold_left f x a = let open String in let r = ref x in for i = 0 to length a - 1 do r := f !r (unsafe_get a i) done; !r (* stdlib version needs ocaml >= 4.13 *) let str_for_all p s = let open String in let n = length s in let rec loop i = if i = n then true else if p (unsafe_get s i) then loop (succ i) else false in loop 0 end open Compat let source_substring source start stop = (* substring from start to stop inclusive, both 1-based *) (* start=0 is the same as start=1 *) let start = if start = 0 then 1 else start in let len = stop - start + 1 (* +1 for inclusive *) in String.sub source (start-1) len let count_newlines s = str_fold_left (fun n c -> if c = '\n' then n+1 else n) 0 s let is_white_char = function ' '|'\n'|'\t' -> true | _ -> false let rec join_loop ~dummy ~source ~last_end ~lines acc = function | [] -> let sourcelen = String.length source in let acc = if last_end + 1 <= sourcelen then let text = source_substring source (last_end+1) sourcelen in if str_for_all is_white_char text then acc else ({ chars = { start_char = last_end+1; stop_char = sourcelen; }; line = lines+1; text}, dummy) :: acc else acc in List.rev acc | (loc,v) :: rest -> let acc, lines, last_end = if loc.start_char > last_end + 1 then let text = source_substring source (last_end + 1) (loc.start_char - 1) in (* if only spaces since last command, include them in the next command typically "Module Foo.\n Cmd." *) if not (str_for_all is_white_char text) then let n = count_newlines text in let acc = ({ chars = { start_char = last_end + 1; stop_char = loc.start_char - 1; }; line = lines; text }, dummy) :: acc in acc, (lines+n), loc.start_char - 1 else acc, lines, last_end else acc, lines, last_end in let text = source_substring source (last_end+1) loc.stop_char in let lines, n = if text <> "" && text.[0] = '\n' then lines+1, 1 else lines, 0 in let n = count_newlines text - n in let acc = ({ chars = { start_char = last_end + 1; stop_char = loc.stop_char; }; line = lines; text }, v) :: acc in join_loop ~dummy ~source ~last_end:loc.stop_char ~lines:(lines + n) acc rest let join_to_source ~dummy ~source vals = join_loop ~dummy ~source ~last_end:(-1) ~lines:1 [] vals coq-8.20.0/dev/bench/sourcehandler.mli000066400000000000000000000020551466560755400176050ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* source:string -> (char_loc * 'a) list -> (source_loc * 'a) list (** Given a list of values ordered by locations with no overlaps but maybe gaps, associate them to substrings of the source and fill in the gaps using [dummy]. When a gap is all whitespace in the source, it is merged to the next value (dropped if at the end). *) coq-8.20.0/dev/bench/table.ml000066400000000000000000000127621466560755400156730ustar00rootroot00000000000000type sized_string = { str : string; size : int } let size s = s.size type header = sized_string type row = sized_string list list module Align = struct type t = | Left | MidLeft | Middle | MidRight | Right end let rec map3 f l1 l2 l3 = match (l1, l2, l3) with | ([], [], []) -> [] | (a1::l1, a2::l2, a3::l3) -> let r = f a1 a2 a3 in r :: map3 f l1 l2 l3 | (_, _, _) -> invalid_arg "Table.map3" let val_padding = 2 (* Padding between data in the same row *) let row_padding = 1 (* Padding between rows *) let homogeneous b = if b then () else failwith "Heterogeneous data" let vert_split (ls : 'a list list) = let split l = match l with | [] -> failwith "vert_split" | x :: l -> (x, l) in let ls = CList.map split ls in CList.split ls let justify align n s = let len = s.size in let s = s.str in let () = assert (len <= n) in let pad = n - len in match align with | Align.Left -> s ^ String.make pad ' ' | Align.Right -> String.make pad ' ' ^ s | Align.Middle -> let pad = pad / 2 in String.make pad ' ' ^ s ^ String.make (n - pad - len) ' ' | Align.MidLeft -> let pad = pad / 5 in String.make pad ' ' ^ s ^ String.make (n - pad - len) ' ' | Align.MidRight -> let pad = pad / 5 in String.make (n - pad - len) ' ' ^ s ^ String.make pad ' ' let justify_row align_row layout data = let data = map3 justify align_row layout data in { str = String.concat (String.make val_padding ' ') data; size = List.fold_left (+) (val_padding * (List.length data - 1)) layout; } let angle hkind vkind = match hkind, vkind with | `Lft, `Top -> "┌" | `Rgt, `Top -> "┐" | `Mid, `Top -> "┬" | `Lft, `Mid -> "├" | `Rgt, `Mid -> "┤" | `Mid, `Mid -> "┼" | `Lft, `Bot -> "└" | `Rgt, `Bot -> "┘" | `Mid, `Bot -> "┴" let print_separator vkind col_size = let rec dashes n = if n = 0 then "" else "─" ^ dashes (n - 1) in let len = CList.length col_size in let pad = dashes row_padding in let () = assert (0 < len) in let map n = dashes n in angle `Lft vkind ^ pad ^ String.concat (pad ^ angle `Mid vkind ^ pad) (CList.map map col_size) ^ pad ^ angle `Rgt vkind let print_blank col_size = let len = CList.length col_size in let () = assert (0 < len) in let pad = String.make row_padding ' ' in let map n = String.make n ' ' in "│" ^ pad ^ String.concat (pad ^ "│" ^ pad) (CList.map map col_size) ^ pad ^ "│" let print_row row = let len = CList.length row in let () = assert (0 < len) in let pad = String.make row_padding ' ' in "│" ^ pad ^ String.concat (pad ^ "│" ^ pad) row ^ pad ^ "│" let default_align_headers = CList.map (fun _ -> Align.Middle) let default_align_top = CList.map @@ CList.map (fun _ -> Align.Middle) let default_align_rows rows = CList.hd rows |> CList.map @@ CList.map (fun _ -> Align.Right) (* Invariant : all rows must have the same shape *) let print (headers : header list) (top : row) (rows : row list) ?(align_headers = default_align_headers headers) ?(align_top = default_align_top top) ?(align_rows = default_align_rows rows) () = (* Sanitize input *) let ncolums = CList.length headers in let shape = ref None in let check row = let () = homogeneous (CList.length row = ncolums) in let rshape : int list = CList.map (fun data -> CList.length data) row in match !shape with | None -> shape := Some rshape | Some s -> homogeneous (rshape = s) in let () = CList.iter check rows in (* TODO: check is broken please fix *) (* let () = CList.iter check (CList.map (CList.map (fun _ -> [])) align_rows) in *) let () = homogeneous (CList.length align_headers = ncolums) in (* Compute layout *) let rec layout n (rows : row list) = if n = 0 then [] else let (col, rows) = vert_split rows in let ans = layout (n - 1) rows in let data = ref None in let iter args = let size = CList.map size args in match !data with | None -> data := Some size | Some s -> data := Some (CList.map2 (fun len1 len2 -> max len1 len2) s size) in let () = CList.iter iter col in let data = match !data with None -> [] | Some s -> s in data :: ans in let layout = layout ncolums (top::rows) in let map hd shape = let data_size = match shape with | [] -> 0 | n :: shape -> CList.fold_left (fun accu n -> accu + n + val_padding) n shape in max (size hd) data_size in let col_size = CList.map2 map headers layout in (* Justify the data *) let headers = map3 justify align_headers col_size headers in let top = CList.map2 (justify Align.Middle) col_size (map3 justify_row align_top layout top) in let rows = CList.map (fun row -> CList.map2 (justify Align.Right) col_size (map3 justify_row align_rows layout row)) rows in (* Print the table *) let lines = print_separator `Top col_size :: print_row headers :: print_blank col_size :: print_row top :: print_separator `Mid col_size :: CList.map print_row rows @ print_separator `Bot col_size :: [] in String.concat "\n" lines type raw_header = string type raw_row = string list list let raw_str s = { str = s; size = String.length s } let raw_row r : row = List.map (List.map raw_str) r let raw_print (headers : raw_header list) (top : raw_row) (rows : raw_row list) ?align_headers ?align_top ?align_rows () = let headers = List.map raw_str headers in let top = raw_row top in let rows = List.map raw_row rows in print headers top rows ?align_headers ?align_top ?align_rows () coq-8.20.0/dev/bench/table.mli000066400000000000000000000025301466560755400160340ustar00rootroot00000000000000module Align : sig type t = | Left | MidLeft | Middle | MidRight | Right (** Type of Alignments. During the justification phase of printing, the alignment decides how much space should be left on the left and right of the data. *) end type sized_string = { str : string; size : int } (** String with a display size. [size] is usually but not always [String.length str] (or rather unicode length but currently no unicode support). *) type header = sized_string type row = sized_string list list (** Print the table with optional alignment parameters. The alignment parametrs must have the same shape as the corresponding data. Due to a limitation of OCaml, the entire thing has to be thunked in order for optional arguments to come at the end. *) val print : header list -> row -> row list -> ?align_headers:Align.t list -> ?align_top:Align.t list list -> ?align_rows:Align.t list list -> unit -> string type raw_header = string type raw_row = string list list val raw_str : string -> sized_string (** string which displays as itself *) val raw_row : raw_row -> row val raw_print : raw_header list -> raw_row -> raw_row list -> ?align_headers:Align.t list -> ?align_top:Align.t list list -> ?align_rows:Align.t list list -> unit -> string (** Print with display size = string length *) coq-8.20.0/dev/bench/timelog2html.ml000066400000000000000000000032241466560755400172040ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* exit 1) stderr fmt let usage () = die "Usage: %s VFILE TIMEFILES\n\n%a\n" Sys.argv.(0) (fun fmt len -> Printf.fprintf fmt "(1 to %d time files are supported.)" len) Htmloutput.max_data_count let () = if Array.length Sys.argv < 3 || Array.length Sys.argv > 2 + Htmloutput.max_data_count then usage () let vfile = Sys.argv.(1) let data_files = Array.sub Sys.argv 2 (Array.length Sys.argv - 2) let source = BenchUtil.read_whole_file vfile let file_data data_file = let data = Timelogparser.parse ~file:data_file in data_file, CArray.of_list data let all_data = Array.map file_data data_files let all_data = BenchUtil.combine_related_data all_data let dummy = Array.make (Array.length data_files) BenchUtil.dummy_measure let all_data = Array.of_list (Sourcehandler.join_to_source ~dummy ~source (Array.to_list all_data)) let vname = Filename.basename vfile let () = Htmloutput.output stdout ~vname ~data_files all_data coq-8.20.0/dev/bench/timelog2html.mli000066400000000000000000000012431466560755400173540ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* List.rev acc | l -> if not (Str.string_match time_regex l 0) then parse_loop filech acc else let b = int_of_string @@ Str.matched_group 1 l and e = int_of_string @@ Str.matched_group 2 l and t = Str.matched_group 3 l in let v = { start_char = b; stop_char = e; }, { str = t; q = Q.of_string t } in parse_loop filech (v :: acc) let parse ~file = let ch = open_in file in let v = parse_loop ch [] in close_in ch; v coq-8.20.0/dev/bench/timelogparser.mli000066400000000000000000000013551466560755400176260ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* (BenchUtil.char_loc * BenchUtil.measure) list coq-8.20.0/dev/bench/wrapper.sh000077500000000000000000000014241466560755400162620ustar00rootroot00000000000000#!/bin/sh log_dir=$COQ_LOG_DIR runner=$COQ_RUNNER package=$COQ_OPAM_PACKAGE iteration=$COQ_ITERATION echo "wrap[$package.$runner.$iteration|$OPAM_PACKAGE_NAME]" "$@" >> "$log_dir/wraplog.txt" echo >> "$log_dir/wraplog.txt" # we could be running commands for a dependency # NB $package may contain the version if [ "$package" ] && [ "$OPAM_PACKAGE_NAME" = "${package%%.*}" ] ; then prefix=$log_dir/$package.$runner.$iteration if [ -e "$prefix.ncoms" ]; then ncoms=$(cat "$prefix.ncoms") ncoms=$((ncoms+1)) else ncoms=1 fi echo $ncoms > "$prefix.ncoms" exec /usr/bin/time \ -o "$prefix.$ncoms.time" --format="%U %M %F" \ perf stat -e instructions:u,cycles:u -o "$prefix.$ncoms.perf" \ "$@" else exec "$@" fi coq-8.20.0/dev/bugzilla2github_stripped.csv000066400000000000000000000116231466560755400207130ustar00rootroot000000000000002, 1156 3, 1157 4, 1158 7, 1160 8, 1161 10, 1163 12, 1164 13, 1165 14, 1169 16, 1171 17, 1184 18, 1190 19, 1191 20, 1193 21, 1200 23, 1201 24, 1203 25, 1208 26, 1210 27, 1212 28, 1216 30, 1217 31, 1223 34, 1227 35, 1232 36, 1235 38, 1238 39, 1244 40, 1245 41, 1246 42, 1247 44, 1248 45, 1249 46, 1250 47, 1252 48, 1253 49, 1254 50, 1256 52, 1262 54, 1263 55, 1264 56, 1265 59, 1266 60, 1267 61, 1268 63, 1270 64, 1272 65, 1274 66, 1275 69, 1276 70, 1279 71, 1283 72, 1284 73, 1285 74, 1286 75, 1287 78, 1288 79, 1291 80, 1292 82, 1293 83, 1295 84, 1296 85, 1297 86, 1299 88, 1301 89, 1303 90, 1304 91, 1305 92, 1307 93, 1308 94, 1310 95, 1312 96, 1313 97, 1314 98, 1316 99, 1318 100, 1319 101, 1320 102, 1321 103, 1323 105, 1324 106, 1327 107, 1328 108, 1330 109, 1334 112, 1335 115, 1336 119, 1337 121, 1341 123, 1342 124, 1343 125, 1344 126, 1345 127, 1346 128, 1348 129, 1349 134, 1350 135, 1351 136, 1352 137, 1353 138, 1354 139, 1355 140, 1356 142, 1357 143, 1358 144, 1359 145, 1360 147, 1361 148, 1362 149, 1363 150, 1365 152, 1366 154, 1368 155, 1369 160, 1370 161, 1371 162, 1372 164, 1373 165, 1374 166, 1376 167, 1377 169, 1378 170, 1380 178, 1382 179, 1383 180, 1384 181, 1385 182, 1386 183, 1387 184, 1390 185, 1391 186, 1392 187, 1393 189, 1394 190, 1398 191, 1401 192, 1402 194, 1403 195, 1404 196, 1405 197, 1407 198, 1409 199, 1410 202, 1412 204, 1413 205, 1421 207, 1422 209, 1423 210, 1426 212, 1427 213, 1428 214, 1429 215, 1433 216, 1435 219, 1436 220, 1437 221, 1440 222, 1444 224, 1445 225, 1450 228, 1452 229, 1453 235, 1457 236, 1458 238, 1459 239, 1460 240, 1462 242, 1465 243, 1466 244, 1470 245, 1471 248, 1472 250, 1473 253, 1474 254, 1475 259, 1476 261, 1478 262, 1479 263, 1480 264, 1481 265, 1484 266, 1485 267, 1486 268, 1488 269, 1489 270, 1490 271, 1492 272, 1493 273, 1494 274, 1498 275, 1500 277, 1503 278, 1504 279, 1505 282, 1506 283, 1511 289, 1513 290, 1514 291, 1516 292, 1517 294, 1520 295, 1521 299, 1523 301, 1524 302, 1525 303, 1527 305, 1529 311, 1530 315, 1531 316, 1532 317, 1534 320, 1535 322, 1539 324, 1541 328, 1542 329, 1543 330, 1544 331, 1545 333, 1546 335, 1547 336, 1548 338, 1549 343, 1550 348, 1551 350, 1552 351, 1553 352, 1554 353, 1555 356, 1556 363, 1557 368, 1558 371, 1559 372, 1560 413, 1561 418, 1562 420, 1563 426, 1564 431, 1565 444, 1566 447, 1567 452, 1569 459, 1570 462, 1571 463, 1573 468, 1574 472, 1575 473, 1577 509, 1578 519, 1579 529, 1580 540, 1581 541, 1583 545, 1584 546, 1585 547, 1589 550, 1590 552, 1591 553, 1592 554, 1593 574, 1594 592, 1595 602, 1597 603, 1598 606, 1599 607, 1600 667, 1601 668, 1602 686, 1603 690, 1605 699, 1606 705, 1607 708, 1609 711, 1610 728, 1611 739, 1612 742, 1613 743, 1615 774, 1617 775, 1619 776, 1623 777, 1624 778, 1625 779, 1627 780, 1628 781, 1629 782, 1630 783, 1631 784, 1632 785, 1633 786, 1636 787, 1637 788, 1638 789, 1639 790, 1640 793, 1641 794, 1642 795, 1644 797, 1645 798, 1646 803, 1647 804, 1649 805, 1650 808, 1652 813, 1653 815, 1655 816, 1656 818, 1657 820, 1658 821, 1659 822, 1660 823, 1661 826, 1662 828, 1663 829, 1664 830, 1665 831, 1666 832, 1667 834, 1668 835, 1669 836, 1670 837, 5689 839, 5791 840, 5792 841, 5793 842, 5794 843, 5795 844, 5796 846, 5797 849, 5798 850, 5799 854, 5800 855, 5801 856, 5802 857, 5803 860, 5804 861, 5805 862, 5806 863, 5807 864, 5808 865, 5809 867, 5810 868, 5811 869, 5812 870, 5813 871, 5814 872, 5815 874, 5816 875, 5817 878, 5818 879, 5819 881, 5820 883, 5821 884, 5822 885, 5823 886, 5824 888, 5825 889, 5826 890, 5827 891, 5828 892, 5829 893, 5830 894, 5831 896, 5832 898, 5833 901, 5834 903, 5835 905, 5836 906, 5837 909, 5838 914, 5839 915, 5840 922, 5841 923, 5842 925, 5843 927, 5844 931, 5845 932, 5846 934, 5847 935, 5848 936, 5849 937, 5850 938, 5851 939, 5852 940, 5853 941, 5854 945, 5855 946, 5856 947, 5857 949, 5858 950, 5859 951, 5860 952, 5861 953, 5862 954, 5863 957, 5864 960, 5865 963, 5866 965, 5867 967, 5868 968, 5869 969, 5870 972, 5871 973, 5872 974, 5873 975, 5874 976, 5875 977, 5876 979, 5877 983, 5878 984, 5879 985, 5880 986, 5881 987, 5882 988, 5883 990, 5884 991, 5885 993, 5886 996, 5887 997, 5888 1000, 5889 1001, 5890 1002, 5891 1003, 5892 1004, 5893 1005, 5894 1006, 5895 1007, 5896 1010, 5897 1012, 5898 1013, 5899 1014, 5900 1015, 5901 1016, 5902 1017, 5903 1018, 5904 1025, 5905 1028, 5906 1029, 5907 1030, 5908 1031, 5909 1033, 5910 1035, 5911 1036, 5912 1037, 5913 1039, 5914 1041, 5915 1042, 5916 1044, 5917 1045, 5918 1052, 5919 1053, 5920 1054, 5921 1055, 5922 1056, 5923 1060, 5924 1064, 5925 1067, 5926 1070, 5927 1072, 5928 1075, 5929 1076, 5930 1085, 5931 1086, 5932 1087, 5933 1089, 5934 1091, 5935 1096, 5936 1097, 5937 1098, 5938 1099, 5939 1100, 5940 1101, 5941 1102, 5942 1104, 5943 1107, 5944 1108, 5945 1111, 5946 1113, 5947 1114, 5948 1115, 5949 1116, 5950 1118, 5951 1119, 5952 1120, 5953 1122, 5954 1123, 5955 1124, 5956 1128, 5957 1129, 5958 1132, 5959 1136, 5960 1137, 5961 1138, 5962 1140, 5963 1141, 5964 1142, 5965 1144, 5966 1145, 5967 1149, 5968 1151, 5969 1153, 5970 coq-8.20.0/dev/ci/000077500000000000000000000000001466560755400135565ustar00rootroot00000000000000coq-8.20.0/dev/ci/README-developers.md000066400000000000000000000175631466560755400172170ustar00rootroot00000000000000Information for developers about the CI system ---------------------------------------------- When you submit a pull request (PR) on the Coq GitHub repository, this will automatically launch a battery of CI tests. The PR will not be integrated unless these tests pass. We are currently running tests on the following platforms: - GitLab CI is the main CI platform. It tests the compilation of Coq, of the documentation, and of CoqIDE on Linux with several versions of OCaml and with warnings as errors; it runs the test-suite and tests the compilation of several external developments. It also runs a linter that checks whitespace discipline. A [pre-commit hook](../tools/pre-commit) is automatically installed by `./configure`. It should allow complying with this discipline without pain. - Github Actions are used to test the compilation of Coq on Windows and macOS. For Windows, the Coq platform script is used, producing an installer that can be used to test Coq. You can anticipate the results of most of these tests prior to submitting your PR by running GitLab CI on your private branches. To do so follow these steps: 1. Log into GitLab CI (the easiest way is to sign in with your GitHub account). 2. Click on "New Project". 3. Choose "CI / CD for external repository" then click on "GitHub". 4. Find your fork of the Coq repository and click on "Connect". 5. If GitLab did not do so automatically, [enable the Container Registry](https://docs.gitlab.com/ee/user/project/container_registry.html#enable-the-container-registry-for-your-project). 6. You are encouraged to go to the CI / CD general settings and increase the timeout from 1h to 2h for better reliability. Now every time you push (including force-push unless you changed the default GitLab setting) to your fork on GitHub, it will be synchronized on GitLab and CI will be run. You will receive an e-mail with a report of the failures if there are some. You can also run one CI target locally (using `make ci-somedev`). See also [`test-suite/README.md`](../../test-suite/README.md) for information about adding new tests to the test-suite. ### Breaking changes When your PR breaks an external project we test in our CI, you must prepare a patch (or ask someone—possibly the project author—to prepare a patch) to fix the project. There is experimental support for an improved workflow, see [the next section](#experimental-automatic-overlay-creation-and-building), below are the steps to manually prepare a patch: 1. Fork the external project, create a new branch, push a commit adapting the project to your changes. 2. Test your pull request with your adapted version of the external project by adding an overlay file to your pull request (cf. [`dev/ci/user-overlays/README.md`](user-overlays/README.md)). 3. Fixes to external libraries (pure Coq projects) *must* be backward compatible (i.e. they should also work with the development version of Coq, and the latest stable version). This will allow you to open a PR on the external project repository to have your changes merged *before* your PR on Coq can be integrated. On the other hand, patches to plugins (projects linking to the Coq ML API) can very rarely be made backward compatible and plugins we test will generally have a dedicated branch per Coq version. You can still open a pull request but the merging will be requested by the developer who merges the PR on Coq. There are plans to improve this, cf. [#6724](https://github.com/coq/coq/issues/6724). Moreover your PR must absolutely update the [`CHANGES.md`](../../CHANGES.md) file. ### Experimental automatic overlay creation and building If you break external projects that are hosted on GitHub, you can use the `create_overlays.sh` script to automatically perform most of the above steps. In order to do so: - determine the list of failing projects: IDs can be found as ci-XXX1 ci-XXX2 ci-XXX3 in the list of GitLab CI failures; - for each project XXXi, look in [ci-basic-overlay.sh](https://github.com/coq/coq/blob/master/dev/ci/ci-basic-overlay.sh) to see if the corresponding `XXXi_CI_GITURL` is hosted on GitHub; - log on GitHub and fork all the XXXi projects hosted there; - call the script as: ``` ./dev/tools/create_overlays.sh ejgallego 9873 XXX1 XXX2 XXX3 ``` replacing `ejgallego` by your GitHub nickname, `9873` by the actual PR number, and selecting the XXXi hosted on GitHub. The script will: + checkout the contributions and prepare the branch/remote so you can just commit the fixes and push, + add the corresponding overlay file in `dev/ci/user-overlays`; - go to `_build_ci/XXXi` to prepare your overlay (you can test your modifications by using `make -C ../.. ci-XXXi`) and push using `git push ejgallego` (replacing `ejgallego` by your GitHub nickname); - finally push the `dev/ci/user-overlays/9873-elgallego-YYY.sh` file on your Coq fork (replacing `9873` by the actual PR number, and `ejgallego` by your GitHub nickname). For problems related to ML-plugins, if you use `dune build` to build Coq, it will actually be aware of the broken contributions and perform a global build. This is very convenient when using `merlin` as you will get a coherent view of all the broken plugins, with full incremental cross-project rebuild. Advanced GitLab CI information ------------------------------ GitLab CI is set up to use the "build artifact" feature to avoid rebuilding Coq. In one job, Coq is built with `./configure -prefix _install_ci` and `make install` is run, then the `_install_ci` directory persists to and is used by the next jobs. ### Artifacts Build artifacts from GitLab can be linked / downloaded in a systematic way, see [GitLab's documentation](https://docs.gitlab.com/ce/user/project/pipelines/job_artifacts.html#downloading-the-latest-job-artifacts) for more information. For example, to access the documentation of the `master` branch, you can do: https://gitlab.com/coq/coq/-/jobs/artifacts/master/file/_install_ci/share/doc/coq/sphinx/html/index.html?job=doc:refman Browsing artifacts is also possible: https://gitlab.com/coq/coq/-/jobs/artifacts/master/browse/_install_ci/?job=build:base Above, you can replace `master` and `job` by the desired GitLab branch and job name. Currently available artifacts are: - the Coq executables and stdlib, in four copies varying in architecture and OCaml version used to build Coq: https://gitlab.com/coq/coq/-/jobs/artifacts/master/browse/_install_ci/?job=build:base Additionally, an experimental Dune build is provided: https://gitlab.com/coq/coq/-/jobs/artifacts/master/browse/_build/?job=build:edge:dune:dev - the Coq documentation, built in the `doc:*` jobs. When submitting a documentation PR, this can help reviewers checking the rendered result. **@coqbot** will automatically post links to these artifacts in the PR checks section. Furthermore, these artifacts are automatically deployed at: + Coq's Reference Manual [master branch]: + Coq's Standard Library Documentation [master branch]: + Coq's ML API Documentation [master branch]: ### GitLab and Docker System and opam packages are installed in a Docker image. The image is automatically built and uploaded to your GitLab registry, and is loaded by subsequent jobs. **IMPORTANT**: When updating Coq's CI docker image, you must modify the `CACHEKEY` variable in [`.gitlab-ci.yml`](../../.gitlab-ci.yml) (see comment near it for details). The Docker building job reuses the uploaded image if it is available, but if you wish to save more time you can skip the job by setting `SKIP_DOCKER` to `true`. In the case of the main Coq repository, this variable is set to true by default, but coqbot will set it to `false` anytime a PR modifies a path matching `dev/ci/docker/.*Dockerfile.*`. See also [`docker/README.md`](docker/README.md). coq-8.20.0/dev/ci/README-users.md000066400000000000000000000174341466560755400162050ustar00rootroot00000000000000Information for external library / Coq plugin authors ----------------------------------------------------- You are encouraged to consider submitting your project for addition to Coq's CI. This means that: - Any time that a proposed change is breaking your project, Coq developers and contributors will send you patches to adapt it or will explain how to adapt it and work with you to ensure that you manage to do it. On the condition that: - At the time of the submission, your project works with Coq's `master` branch. - Your project is publicly available in a git repository and we can easily send patches to you (e.g. through pull / merge requests). - You react in a timely manner to discuss / integrate those patches. When seeking your help for preparing such patches, we will accept that it takes longer than when we are just requesting to integrate a simple (and already fully prepared) patch. - You do not push, to the branches that we test, commits that haven't been first tested to compile with the corresponding branch(es) of Coq. For that, we recommend setting a CI system for you project, see [supported CI images for Coq](#supported-ci-images-for-coq) below. - You maintain a reasonable build time for your project, or you provide a "lite" target that we can use. - You keep points-of-contact up to date. In case you forget to comply with these last four conditions, we would reach out to you and give you a 30-day grace period during which your project would be moved into our "allow failure" category. At the end of the grace period, in the absence of progress, the project would be removed from our CI. ### Timely merging of overlays A pitfall of the current CI setup is that when a breaking change is merged in Coq upstream, CI for your contrib will be broken until you merge the corresponding pull request with the fix for your contribution. As of today, you have to worry about synchronizing with Coq upstream every once in a while; we hope we will improve this in the future by using [coqbot](https://github.com/coq/bot); meanwhile, a workaround is to give merge permissions to someone from the Coq team as to help with these kind of merges. ### OCaml and plugin-specific considerations Projects that link against Coq's OCaml API [most of them are known as "plugins"] do have some special requirements: - Coq's OCaml API is not stable. We hope to improve this in the future but as of today you should expect to have to merge a fair amount of "overlays", usually in the form of Pull Requests from Coq developers in order to keep your plugin compatible with Coq master. In order to alleviate the load, you can delegate the merging of such compatibility pull requests to Coq developers themselves, by granting access to the plugin repository or by using `bots` such as [Bors](https://github.com/apps/bors) that allow for automatic management of Pull Requests. - Plugins in the CI should compile with the OCaml flags that Coq uses. In particular, warnings that are considered fatal by the Coq developers _must_ be also fatal for plugin CI code. ### Add your project by submitting a pull request Add a new `ci-mydev.sh` script to [`dev/ci`](.); set the corresponding variables in [`ci-basic-overlay.sh`](ci-basic-overlay.sh); add the corresponding target to [`Makefile.ci`](../../Makefile.ci) and a new job to [`.gitlab-ci.yml`](../../.gitlab-ci.yml) so that this new target is run. Have a look at [#17241](https://github.com/coq/coq/pull/17241/files) for an example. **Do not hesitate to submit an incomplete pull request if you need help to finish it.** Some important points: - Mention one or a few points of contact in [`ci-basic-overlay.sh`](ci-basic-overlay.sh). - Let `$job` be the name of the new job as used for the name of the added script file `dev/ci/ci-$job.sh`. Then the added target in `Makefile.ci` must be named `ci-$job` and the added job in `.gitlab-ci.yml` must be named `library:$job` or `plugin:$job`. `$job` must be a valid shell variable name, typically this means replacing dashs (`-`) with underscores (`_`). - Let `$project` be the name of your project as used for the first argument to `project` in `ci-basic-overlay.sh`. Usually this is the same as `$job` in the above bullet. It must also be a valid shell variable name. In some cases a script will handle multiple source repositories and so will need multiple `$project`, see for instance script `verdi_raft`. - If you wish to run a test suite for your project which takes non-negligible time, it may be useful to run the test suite in a separate `Makefile.ci` target and GitLab job, using a separate shell script. In terms of the above bullet points this means a `$project` used in multiple `$job`s. See for instance `mathcomp` and `mathcomp_test`. - When declaring the job in `.gitlab-ci.yml` you must choose the opam switch by using `extends: .ci-template` or `extends: .ci-template-flambda`. The first one uses the minimum version of OCaml supported by Coq. The second one uses the highest version of OCaml supported by Coq, with flambda enabled (currently it actually uses OCaml 4.14.1 as 5.0 has significant performance issues). See also the corresponding [`Dockerfiles`](docker/) to find out what specific packages are available in each switch. If your job depends on other jobs, you must use the same opam switch. If you wish to depend on jobs currently declared in separate switches, please open a draft pull request and the Coq developers will decide which jobs should change switches. If you need an exception to this rule for some other reason, please discuss with the Coq developers. - Job dependencies are declared in 2 places: `Makefile.ci` using the usual Makefile syntax, and `.gitlab-ci.yml` using `needs`. If you only depend on Coq itself the implicit `needs` from the template suffices. Otherwise the `needs` list must include `build:base` or `build:edge+flambda` (depending on the switch you chose). See for instance the declaration for `library:ci-analysis`. - If you depend on more than Coq itself you must specify the `stage`: `build-2` if all your dependencies depend only on Coq itself, otherwise `build-3+` (the number is the max depth of the dependency chain, with Coq itself at 0 and the default from the template at 1). - If needed you can disable native compilation by doing `export COQEXTRAFLAGS='-native-compiler no'` before the build commands in the script file. If any of your dependencies disable native compilation you must do the same. You may also be interested in having your project tested in our performance benchmark. Currently this is done by providing a `.dev` OPAM package in https://github.com/coq/opam-coq-archive and opening an issue at https://github.com/coq/coq/issues. ### Recommended branching policy. It is sometimes the case that you will need to maintain a branch of your project for particular Coq versions. This is in fact very likely if your project includes a Coq ML plugin. For such projects, we recommend a branching convention that mirrors Coq's branching policy. Then, you would have a `master` branch that follows Coq's `master`, a `v8.8` branch that works with Coq's `v8.8` branch and so on. This convention will be supported by tools in the future to make some developer commands work more seamlessly. ### Supported CI images for Coq The Coq developers and contributors provide official Docker and Nix images for testing against Coq master. Using these images is highly recommended: - For Docker, see: https://github.com/coq-community/docker-coq The https://github.com/coq-community/docker-coq/wiki/CI-setup wiki page contains additional information and templates to help setting Docker-based CI up for your Coq project - For Nix, see the setup at https://github.com/coq-community/manifesto/wiki/Continuous-Integration-with-Nix coq-8.20.0/dev/ci/README.md000066400000000000000000000016651466560755400150450ustar00rootroot00000000000000Continuous Integration for the Coq Proof Assistant ================================================== Changes to Coq are systematically tested for regression and compatibility breakage on our Continuous Integration (CI) platforms *before* integration, so as to ensure better robustness and catch problems as early as possible. These tests include the compilation of several external libraries / plugins. This README is split into two specific documents: - [README-users.md](./README-users.md) which contains information for authors of external libraries and plugins who might be interested in having their development tested in our CI system. - [README-developers.md](./README-developers.md) for Coq developers / contributors, who must ensure that they don't break these external developments accidentally. *Remark:* the CI policy outlined in these documents is susceptible to evolve and specific accommodations are of course possible. coq-8.20.0/dev/ci/ci-aac_tactics.sh000066400000000000000000000003211466560755400167350ustar00rootroot00000000000000#!/usr/bin/env bash set -e ci_dir="$(dirname "$0")" . "${ci_dir}/ci-common.sh" git_download aac_tactics if [ "$DOWNLOAD_ONLY" ]; then exit 0; fi ( cd "${CI_BUILD_DIR}/aac_tactics" make make install ) coq-8.20.0/dev/ci/ci-analysis.sh000066400000000000000000000003131466560755400163230ustar00rootroot00000000000000#!/usr/bin/env bash set -e ci_dir="$(dirname "$0")" . "${ci_dir}/ci-common.sh" git_download analysis if [ "$DOWNLOAD_ONLY" ]; then exit 0; fi ( cd "${CI_BUILD_DIR}/analysis" make make install ) coq-8.20.0/dev/ci/ci-argosy.sh000066400000000000000000000003121466560755400160030ustar00rootroot00000000000000#!/usr/bin/env bash set -e ci_dir="$(dirname "$0")" . "${ci_dir}/ci-common.sh" WITH_SUBMODULES=1 git_download argosy if [ "$DOWNLOAD_ONLY" ]; then exit 0; fi ( cd "${CI_BUILD_DIR}/argosy" make ) coq-8.20.0/dev/ci/ci-async_test.sh000066400000000000000000000003171466560755400166600ustar00rootroot00000000000000#!/usr/bin/env bash set -e ci_dir="$(dirname "$0")" . "${ci_dir}/ci-common.sh" git_download async_test if [ "$DOWNLOAD_ONLY" ]; then exit 0; fi ( cd "${CI_BUILD_DIR}/async_test" make make install ) coq-8.20.0/dev/ci/ci-atbr.sh000066400000000000000000000003031466560755400154270ustar00rootroot00000000000000#!/usr/bin/env bash set -e ci_dir="$(dirname "$0")" . "${ci_dir}/ci-common.sh" git_download atbr if [ "$DOWNLOAD_ONLY" ]; then exit 0; fi ( cd "${CI_BUILD_DIR}/atbr" make make install ) coq-8.20.0/dev/ci/ci-autosubst.sh000066400000000000000000000003151466560755400165330ustar00rootroot00000000000000#!/usr/bin/env bash set -e ci_dir="$(dirname "$0")" . "${ci_dir}/ci-common.sh" git_download autosubst if [ "$DOWNLOAD_ONLY" ]; then exit 0; fi ( cd "${CI_BUILD_DIR}/autosubst" make make install ) coq-8.20.0/dev/ci/ci-autosubst_ocaml.sh000066400000000000000000000005341466560755400177110ustar00rootroot00000000000000#!/usr/bin/env bash set -e ci_dir="$(dirname "$0")" . "${ci_dir}/ci-common.sh" git_download autosubst_ocaml if [ "$DOWNLOAD_ONLY" ]; then exit 0; fi export COQEXTRAFLAGS='-native-compiler no' ( cd "${CI_BUILD_DIR}/autosubst_ocaml" dune build @install -p coq-autosubst-ocaml dune install -p coq-autosubst-ocaml --prefix="$CI_INSTALL_DIR" ) coq-8.20.0/dev/ci/ci-basic-overlay.sh000066400000000000000000000652071466560755400172550ustar00rootroot00000000000000#!/usr/bin/env bash # This is the list of repositories used by the CI scripts, unless overridden # by a call to the "overlay" function in ci-common declare -a projects # the list of project repos that can be be overlayed # checks if the given argument is a known project function is_in_projects { for x in "${projects[@]}"; do if [ "$1" = "$x" ]; then return 0; fi; done return 1 } # project [] # [] defaults to /archive on github.com # and /-/archive on gitlab function project { local var_ref=${1}_CI_REF local var_giturl=${1}_CI_GITURL local var_archiveurl=${1}_CI_ARCHIVEURL local giturl=$2 local ref=$3 local archiveurl=$4 case $giturl in *github.com*) archiveurl=${archiveurl:-$giturl/archive} ;; *gitlab*) archiveurl=${archiveurl:-$giturl/-/archive} ;; esac # register the project in the list of projects projects[${#projects[*]}]=$1 # bash idiom for setting a variable if not already set : "${!var_ref:=$ref}" : "${!var_giturl:=$giturl}" : "${!var_archiveurl:=$archiveurl}" } # subproject # In the case of nested submodules, each subproject should be declared # a subproject of its immediate parent, to ensure overlays are applied # in the right order function subproject { local var_parent_project=${1}_CI_PARENT_PROJECT local var_submodule_folder=${1}_CI_SUBMODULE_FOLDER local var_submodule_giturl=${1}_CI_SUBMODULE_GITURL local var_submodule_branch=${1}_CI_SUBMODULE_BRANCH local parent_project=$2 local submodule_folder=$3 local submodule_giturl=$4 local submodule_branch=$5 # register the project in the list of projects projects[${#projects[*]}]=$1 : "${!var_parent_project:=$parent_project}" : "${!var_submodule_folder:=$submodule_folder}" : "${!var_submodule_giturl:=$submodule_giturl}" : "${!var_submodule_branch:=$submodule_branch}" } ######################################################################## # MathComp ######################################################################## project mathcomp 'https://github.com/math-comp/math-comp' 'd15522db878ddab2f17669d20159126b6274dd1a' # Contact @CohenCyril, @proux01 on github project mathcomp_1 "https://github.com/math-comp/math-comp" "a526d8dc7956ce1c1bc88051d0656d35b76608a3" # Contact @CohenCyril, @proux01 on github project fourcolor 'https://github.com/math-comp/fourcolor' '91ff6b8b846c8ad683260a5e6ce400e186f43c6e' # Contact @ybertot, @proux01 on github project oddorder 'https://github.com/math-comp/odd-order' '8dbbae0e53a6d1fcf3471c8fae4dd14c8f18bd93' # Contact @gares, @proux01 on github project mczify 'https://github.com/math-comp/mczify' '3ea1c2d2baebf1c7b0bcc4ba74825da1d27901a8' # Contact @pi8027 on github project finmap 'https://github.com/math-comp/finmap' 'a907a9e160a3ce0a546934a36016e75a05c73f3f' # Contact @CohenCyril on github project bigenough 'https://github.com/math-comp/bigenough' 'ff71b25f31658d80fdae9657e8cf34e5e1052647' # Contact @CohenCyril on github project analysis 'https://github.com/math-comp/analysis' '9c311a9344f3af02fbb12101b24482846d64e8ea' # Contact @affeldt-aist, @CohenCyril on github ######################################################################## # UniMath ######################################################################## project unimath 'https://github.com/UniMath/UniMath' '05b0156b527423f980c493317a766d665b5e1401' # Contact @benediktahrens, @m-lindgren, @nmvdw, @rmatthes on github ######################################################################## # Unicoq + Mtac2 ######################################################################## project unicoq 'https://github.com/unicoq/unicoq' '88f3964f4db12910b53f213ad7fcb6f868f76548' # Contact @beta-ziliani, @Janno, @mattam82 on github project mtac2 'https://github.com/Mtac2/Mtac2' 'caa52a1e21c5368105f4ab8e9f4bf3235aedfa7c' # Contact @beta-ziliani, @Janno, @mattam82 on github ######################################################################## # Mathclasses + Corn ######################################################################## project math_classes 'https://github.com/coq-community/math-classes' '2a8e12360cceee510f39e3ef4d0a7472d70fa684' # Contact @spitters on github project corn 'https://github.com/coq-community/corn' '5e74c2920f76c9888e70dba466b92787dcf0d077' # Contact @spitters on github ######################################################################## # Iris ######################################################################## # NB: stdpp and Iris refs are gotten from the opam files in the Iris and # iris_examples repos respectively. So just getting a fix landed in stdpp or # Iris is not enough. Ping @RalfJung and @robbertkrebbers if you need the # versions of stdpp or Iris to be bumped. Perennial also has its own pinned # versions of stdpp and Iris; ping @tchajed and @zeldovich to get that bumped. project stdpp "https://gitlab.mpi-sws.org/iris/stdpp" "" # Contact @RalfJung, @robbertkrebbers on github project iris "https://gitlab.mpi-sws.org/iris/iris" "" # Contact @RalfJung, @robbertkrebbers on github project autosubst 'https://github.com/coq-community/autosubst' '6ba0acccef68c75f6cca8928706c726754d69791' # Contact @RalfJung, @co-dan on github project iris_examples 'https://gitlab.mpi-sws.org/iris/examples' 'e17e7e92f0a0f52dce65e1189d7c32fa20c23815' # Contact @RalfJung, @robbertkrebbers on github ######################################################################## # HoTT ######################################################################## project hott 'https://github.com/HoTT/HoTT' '5661e6850709f6f56e2a80fc3dc2d72498780758' # Contact @Alizter, @jdchristensen on github ######################################################################## # CoqHammer ######################################################################## project coqhammer 'https://github.com/lukaszcz/coqhammer' '7dcbc6ad043c4fef109906ad4cbc623c8e343a87' # Contact @lukaszcz on github ######################################################################## # Flocq ######################################################################## project flocq 'https://gitlab.inria.fr/flocq/flocq' '561210b49466c1a0f911f6051fa50653e3fc6ca0' # Contact @silene on github ######################################################################## # coq-performance-tests ######################################################################## project coq_performance_tests 'https://github.com/coq-community/coq-performance-tests' 'd1fb22459af24d77b0ab0c224403cfd942f37fe9' # Contact @JasonGross on github ######################################################################## # coq-tools ######################################################################## project coq_tools 'https://github.com/JasonGross/coq-tools' '1c520114230875e0dbb00216d868391a338febaf' # Contact @JasonGross on github ######################################################################## # Coquelicot ######################################################################## project coquelicot 'https://gitlab.inria.fr/coquelicot/coquelicot' 'ca1a747aa8b7ccbfa67a55ae5c8e5c8df71cc396' # Contact @silene on github ######################################################################## # CompCert ######################################################################## project compcert 'https://github.com/AbsInt/CompCert' '2ca39a2801d333abcfa3d691620d03abde4e7e37' # Contact @xavierleroy on github ######################################################################## # VST ######################################################################## project vst 'https://github.com/PrincetonUniversity/VST' '0eed04f85ecfa9607d200b37aa69ac0fb39a1071' # Contact @andrew-appel on github ######################################################################## # cross-crypto ######################################################################## project cross_crypto 'https://github.com/mit-plv/cross-crypto' '208894a6efd2fe952eb384918cf38403e8a7cc15' # Contact @andres-erbsen on github ######################################################################## # rewriter ######################################################################## project rewriter 'https://github.com/mit-plv/rewriter' 'edcec730f68469475fdc4b78495ae941a5b320ec' # Contact @JasonGross on github ######################################################################## # fiat_parsers ######################################################################## project fiat_parsers 'https://github.com/mit-plv/fiat' '33cee618160f76e7b15ea3e0db02f8198df347a5' # Contact @JasonGross on github ######################################################################## # fiat_crypto_legacy ######################################################################## project fiat_crypto_legacy 'https://github.com/mit-plv/fiat-crypto' '9ace037e9c48960853ff597ba506ee25abb39789' # Contact @JasonGross on github ######################################################################## # fiat_crypto ######################################################################## project fiat_crypto 'https://github.com/mit-plv/fiat-crypto' '7ff747f57d44c7e9ffe3302c647dc96b3f203c7b' # Contact @andres-erbsen, @JasonGross on github # bedrock2, coqutil, rupicola, kami, riscv_coq # fiat-crypto is not guaranteed to build with the latest version of # bedrock2, so we use the pinned version of bedrock2 for fiat-crypto # overlays do not have to follow suite subproject rupicola fiat_crypto "rupicola" "https://github.com/mit-plv/rupicola" "71a5a07a837baeb90c4cec554c0462fa48194f04" subproject bedrock2 rupicola "bedrock2" "https://github.com/mit-plv/bedrock2" "6fcb247abe8480600e3ddd1b0de1d5d7e628d772" subproject coqutil bedrock2 "deps/coqutil" "https://github.com/mit-plv/coqutil" "126561ce8d32df8be7ea7de10eebd0e35b9fa8e9" subproject kami bedrock2 "deps/kami" "https://github.com/mit-plv/kami" "de880ce21dc927b050e33e803c903238978f8021" subproject riscv_coq bedrock2 "deps/riscv-coq" "https://github.com/mit-plv/riscv-coq" "d0afd4b58178976a2887c07e4f05c15d757fa0fc" # Contact @samuelgruetter, @andres-erbsen on github ######################################################################## # coq_dpdgraph ######################################################################## project coq_dpdgraph 'https://github.com/coq-community/coq-dpdgraph' '83711f445936dc8a2d09581edccece934d34a8d4' # Contact @Karmaki, @ybertot on github ######################################################################## # CoLoR ######################################################################## project color 'https://github.com/fblanqui/color' 'b063daf21dc89734c999cbb0893ae25830f1d0f4' # Contact @fblanqui on github ######################################################################## # TLC ######################################################################## project tlc 'https://github.com/charguer/tlc' 'd060155ce52e95c2bf450519f00b2f073732a588' # Contact @charguer on github ######################################################################## # Bignums ######################################################################## project bignums 'https://github.com/coq/bignums' 'da802e5c9469e4e13d0a1c22ed98092037b77010' # Contact @erikmd, @proux01 on github ######################################################################## # coqprime ######################################################################## project coqprime 'https://github.com/thery/coqprime' '6c225a2060ef2a47bdd487bca775f21bfe1fa5de' # Contact @thery on github ######################################################################## # bbv ######################################################################## project bbv 'https://github.com/mit-plv/bbv' 'c53d5b95c70839ae8e947010d85503bd1ada1120' # Contact @JasonGross, @samuelgruetter on github ######################################################################## # Coinduction ######################################################################## project coinduction 'https://github.com/damien-pous/coinduction' '421077f5de6f5094d656f0f272317b57ee82f83f' # Contact @damien-pous on github ######################################################################## # coq-lsp ######################################################################## project coq_lsp 'https://github.com/ejgallego/coq-lsp' 'ad2040fa33a741afd30183050ad3b53bf5eb1366' # Contact @ejgallego on github ######################################################################## # Equations ######################################################################## project equations 'https://github.com/mattam82/Coq-Equations' 'f9f7d3cdf91bae89f255335e083e9ddd5325f8df' # Contact @mattam82 on github ######################################################################## # Elpi + Hierarchy Builder ######################################################################## project elpi 'https://github.com/LPCIC/coq-elpi' '92de5c8f8fc58b207f0a23a52edabc614425bd93' # Contact @gares on github project hierarchy_builder 'https://github.com/math-comp/hierarchy-builder' '8b1725c9d99e2f0ce6514998b125706aaeb550ac' # Contact @CohenCyril, @gares on github ######################################################################## # Engine-Bench ######################################################################## project engine_bench 'https://github.com/mit-plv/engine-bench' '8c0b15abc38b1d3f7dc606f4eeef9fba1a986b05' # Contact @JasonGross on github ######################################################################## # fcsl-pcm ######################################################################## project fcsl_pcm 'https://github.com/imdea-software/fcsl-pcm' '6f462300ae8a6f98b1407652943d3ac74e6f2b88' # Contact @aleksnanevski, @clayrat on github ######################################################################## # ext-lib ######################################################################## project ext_lib 'https://github.com/coq-community/coq-ext-lib' 'b1fa2800a867df12eaced8ad324a04c2ada12a5a' # Contact @gmalecha, @liyishuai on github ######################################################################## # simple-io ######################################################################## project simple_io 'https://github.com/Lysxia/coq-simple-io' 'b4f11fb9481fbc43c481112e096dd4bab85d8b2f' # Contact @Lysxia, @liyishuai on github ######################################################################## # quickchick ######################################################################## project quickchick 'https://github.com/QuickChick/QuickChick' 'b7c8bb7545a7dd435696033153d43d32f62f323e' # Contact @lemonidas, @Lysxia, @liyishuai on github ######################################################################## # reduction-effects ######################################################################## project reduction_effects 'https://github.com/coq-community/reduction-effects' 'f0570f498bc8a0d25e878115b4066b140908c4b4' # Contact @liyishuai, @JasonGross on github ######################################################################## # menhirlib ######################################################################## # Note: menhirlib is now in subfolder coq-menhirlib of menhir project menhirlib 'https://gitlab.inria.fr/fpottier/menhir' '8a424e9842f2ea3e68caaf79e0741bad122ee14f' # Contact @fpottier, @jhjourdan on github ######################################################################## # coq-neural-net-interp ######################################################################## project neural_net_interp 'https://github.com/JasonGross/neural-net-coq-interp' 'dc100dd8b5858407607acc83ea896cf781375173' # Contact @JasonGross on github ######################################################################## # aac_tactics ######################################################################## project aac_tactics 'https://github.com/coq-community/aac-tactics' 'aa70a2d40b4bf659cccc187b25cff03a08f5a63f' # Contact @palmskog on github ######################################################################## # paco ######################################################################## project paco 'https://github.com/snu-sf/paco' '5c5693f46c8957f36a2349a0d906e911366136de' # Contact @minkiminki on github ######################################################################## # coq-itree ######################################################################## project itree 'https://github.com/DeepSpec/InteractionTrees' 'e7fed212b1061b358428b57e11ee489184e241a2' # Contact @Lysxia on github ######################################################################## # coq-itree_io ######################################################################## project itree_io 'https://github.com/Lysxia/coq-itree-io' 'af0326793a19f142eba800dba6044143b108ceaa' # Contact @Lysxia, @liyishuai on github ######################################################################## # coq-ceres ######################################################################## project ceres 'https://github.com/Lysxia/coq-ceres' 'f61b24d48222db0100de19f88c19151a3aeb826f' # Contact @Lysxia on github ######################################################################## # coq-parsec ######################################################################## project parsec 'https://github.com/liyishuai/coq-parsec' '2efb4437f8451dfbeb174368f860e629135c08ab' # Contact @liyishuai on github ######################################################################## # coq-json ######################################################################## project json 'https://github.com/liyishuai/coq-json' '71974c15819ade300bcff5d9aa62cb0774387c4d' # Contact @liyishuai on github ######################################################################## # coq-async-test ######################################################################## project async_test 'https://github.com/liyishuai/coq-async-test' '0637b95ae52060d8a808261ca97890d03c9a4503' # Contact @liyishuai on github ######################################################################## # coq-http ######################################################################## project http 'https://github.com/liyishuai/coq-http' 'cabde79a4a0d978d031475c7443be7fd43a711c5' # Contact @liyishuai on github ######################################################################## # paramcoq ######################################################################## project paramcoq 'https://github.com/coq-community/paramcoq' '7db5cb1ae8f330365548bb576c6928c803645885' # Contact @proux01 on github ######################################################################## # relation_algebra ######################################################################## project relation_algebra 'https://github.com/damien-pous/relation-algebra' 'dbb5713ab490fdfabc87785e0f17370edce7723f' # Contact @damien-pous on github ######################################################################## # StructTact + InfSeqExt + Cheerios + Verdi + Verdi Raft ######################################################################## project struct_tact 'https://github.com/uwplse/StructTact' '97268e11564c8fe59aa72b062478458d7aa53e9d' # Contact @palmskog on github project inf_seq_ext 'https://github.com/DistributedComponents/InfSeqExt' '601e89ec019501c48c27fcfc14b9a3c70456e408' # Contact @palmskog on github project cheerios 'https://github.com/uwplse/cheerios' '5c9318c269f9cae1c1c6583a44405969ac0be0dd' # Contact @palmskog on github project verdi 'https://github.com/uwplse/verdi' 'b7f77848819878b1faf0e2e6a730f9bb850130be' # Contact @palmskog on github project verdi_raft 'https://github.com/uwplse/verdi-raft' 'a3375e867326a82225e724cc1a7b4758b029376f' # Contact @palmskog on github ######################################################################## # stdlib2 ######################################################################## project stdlib2 'https://github.com/coq/stdlib2' '33212e05c51efa012c9dfccd0b9e735a42f2d924' # Contact @maximedenes, @vbgl on github ######################################################################## # argosy ######################################################################## project argosy 'https://github.com/mit-pdos/argosy' 'a6a5aa0d3868efd4ada0b40927b5748e5d8967d3' # Contact @tchajed on github ######################################################################## # ATBR ######################################################################## project atbr 'https://github.com/coq-community/atbr' '5e3f4fe63d6423f672e03f15052068fe2fd5a3fc' # Contact @palmskog, @tchajed on github ######################################################################## # perennial ######################################################################## project perennial 'https://github.com/mit-pdos/perennial' '43507a79689a8745477e6662d4dfb46d4cb64c73' # Contact @upamanyus, @RalfJung, @tchajed on github # PRs to fix Perennial failures should be submitted against the Perennial # `master` branch. `coq/tested` is automatically updated every night to the # `master` branch if CI on `master` is green. This is to avoid breaking Coq CI # when Perennial CI breaks. ######################################################################## # metacoq ######################################################################## project metacoq 'https://github.com/MetaCoq/metacoq' 'b4d67e4dbd075fe3f0fdd5566cc56ab345afcfa6' # Contact @mattam82, @yforster on github ######################################################################## # SF suite ######################################################################## project sf 'https://github.com/DeepSpec/sf' '291e3b86b8c9ba22bf2edfaa183b3e7b03df7e95' # Contact @bcpierce00, @liyishuai on github ######################################################################## # Coqtail ######################################################################## project coqtail 'https://github.com/whonore/Coqtail' 'a36352930b5e5f8d33dda09eef0c9d7c96190a02' # Contact @whonore on github ######################################################################## # Deriving ######################################################################## project deriving 'https://github.com/arthuraa/deriving' '5712f82f94d00c2229fbb8cb144bac495d03e7ab' # Contact @arthuraa on github ######################################################################## # VsCoq ######################################################################## project vscoq 'https://github.com/coq-community/vscoq' '2918fb053f7bc1be9ea4891e4faba9f284772d21' # Contact @rtetley, @gares on github ######################################################################## # category-theory ######################################################################## project category_theory 'https://github.com/jwiegley/category-theory' 'f8295f0d77ab0dd9f989e8e45d43670a69f424df' # Contact @jwiegley on github ######################################################################## # itauto ######################################################################## project itauto 'https://gitlab.inria.fr/fbesson/itauto' '90a359a652ec8f42c5d8832d12362b9218618705' # Contact @fajb on github ######################################################################## # Mathcomp-word ######################################################################## project mathcomp_word "https://github.com/jasmin-lang/coqword" "v2.2" # Contact @vbgl, @strub on github # go back to "main" and change dependency to MC 2 when # https://github.com/jasmin-lang/jasmin/pull/560 is merged ######################################################################## # Jasmin ######################################################################## project jasmin "https://github.com/jasmin-lang/jasmin" "e8380c779b5c284c6d4c654d4ea86c56521a6d4c" # Contact @vbgl, @bgregoir on github # go back to "main" and change dependency to MC 2 when # https://github.com/jasmin-lang/jasmin/pull/560 is merged ######################################################################## # Lean Importer ######################################################################## project lean_importer 'https://github.com/SkySkimmer/coq-lean-import' 'ce8ed08172d3247d992dacab08e0e8f59864a57b' # Contact @SkySkimmer on github ######################################################################## # SerAPI ######################################################################## project serapi 'https://github.com/ejgallego/coq-serapi' 'eb845aa47fca05b743478a7878c218503c1cc0c7' # Contact @ejgallego on github ######################################################################## # SMTCoq ######################################################################## project smtcoq 'https://github.com/smtcoq/smtcoq' 'd951f13947d75c6e52c56523fd3cfcc7c8911b2b' # Contact @ckeller on github ######################################################################## # Stalmarck ######################################################################## project stalmarck 'https://github.com/coq-community/stalmarck' 'd32acd3c477c57b48dd92bdd96d53fb8fa628512' # Contact @palmskog on github ######################################################################## # coq-library-undecidability ######################################################################## project coq_library_undecidability 'https://github.com/uds-psl/coq-library-undecidability' '40d38b1f94712322b12610418e1a02a7e3772977' # Contact @mrhaandi, @yforster on github ######################################################################## # Tactician ######################################################################## project tactician 'https://github.com/coq-tactician/coq-tactician' '4a788f26ad8c8b0c02dad2b41b80cf331a4b64fc' # Contact @LasseBlaauwbroek on github ######################################################################## # Ltac2 compiler ######################################################################## project ltac2_compiler 'https://github.com/SkySkimmer/coq-ltac2-compiler' '30ee5bbf04ab841deb3481465ef4753f2c69338e' # Contact @SkySkimmer on github ######################################################################## # Waterproof ######################################################################## project waterproof 'https://github.com/impermeable/coq-waterproof' 'fb0bd1d8b4007f362acf5e7ce1d1b844b4f83d77' # Contact @jellooo038, @jim-portegies on github ######################################################################## # Autosubst (2) OCaml ######################################################################## project autosubst_ocaml 'https://github.com/uds-psl/autosubst-ocaml' '830b3d6c561fa9227fc83738b4d02e8da9f68bab' # Contact @yforster on github ######################################################################## # Trakt ######################################################################## project trakt 'https://github.com/ecranceMERCE/trakt' 'f9bb47018b3368b79b9d91fffdfe400762bc3010' # Contact @ckeller, @louiseddp on github coq-8.20.0/dev/ci/ci-bbv.sh000066400000000000000000000003011466560755400152460ustar00rootroot00000000000000#!/usr/bin/env bash set -e ci_dir="$(dirname "$0")" . "${ci_dir}/ci-common.sh" git_download bbv if [ "$DOWNLOAD_ONLY" ]; then exit 0; fi ( cd "${CI_BUILD_DIR}/bbv" make make install ) coq-8.20.0/dev/ci/ci-bedrock2.sh000066400000000000000000000006331466560755400162000ustar00rootroot00000000000000#!/usr/bin/env bash set -e ci_dir="$(dirname "$0")" . "${ci_dir}/ci-common.sh" WITH_SUBMODULES=1 git_download bedrock2 if [ "$DOWNLOAD_ONLY" ]; then exit 0; fi make_args=(EXTERNAL_COQUTIL=1 EXTERNAL_RISCV_COQ=1 EXTERNAL_KAMI=1) export COQEXTRAFLAGS='-native-compiler no' ( cd "${CI_BUILD_DIR}/bedrock2" COQMF_ARGS='-arg "-async-proofs-tac-j 1"' make "${make_args[@]}" make "${make_args[@]}" install ) coq-8.20.0/dev/ci/ci-bigenough.sh000066400000000000000000000003151466560755400164510ustar00rootroot00000000000000#!/usr/bin/env bash set -e ci_dir="$(dirname "$0")" . "${ci_dir}/ci-common.sh" git_download bigenough if [ "$DOWNLOAD_ONLY" ]; then exit 0; fi ( cd "${CI_BUILD_DIR}/bigenough" make make install ) coq-8.20.0/dev/ci/ci-bignums.sh000066400000000000000000000003331466560755400161460ustar00rootroot00000000000000#!/usr/bin/env bash set -e ci_dir="$(dirname "$0")" . "${ci_dir}/ci-common.sh" git_download bignums if [ "$DOWNLOAD_ONLY" ]; then exit 0; fi ( cd "${CI_BUILD_DIR}/bignums" make make install cd tests make ) coq-8.20.0/dev/ci/ci-category_theory.sh000066400000000000000000000004041466560755400177100ustar00rootroot00000000000000#!/usr/bin/env bash set -e ci_dir="$(dirname "$0")" . "${ci_dir}/ci-common.sh" git_download category_theory if [ "$DOWNLOAD_ONLY" ]; then exit 0; fi export COQEXTRAFLAGS='-native-compiler no' ( cd "${CI_BUILD_DIR}/category_theory" make make install ) coq-8.20.0/dev/ci/ci-ceres.sh000066400000000000000000000003131466560755400156010ustar00rootroot00000000000000#!/usr/bin/env bash set -e ci_dir="$(dirname "$0")" . "${ci_dir}/ci-common.sh" git_download ceres if [ "$DOWNLOAD_ONLY" ]; then exit 0; fi ( cd "${CI_BUILD_DIR}/ceres" make build make install ) coq-8.20.0/dev/ci/ci-coinduction.sh000066400000000000000000000003211466560755400170150ustar00rootroot00000000000000#!/usr/bin/env bash set -e ci_dir="$(dirname "$0")" . "${ci_dir}/ci-common.sh" git_download coinduction if [ "$DOWNLOAD_ONLY" ]; then exit 0; fi ( cd "${CI_BUILD_DIR}/coinduction" make make install ) coq-8.20.0/dev/ci/ci-color.sh000066400000000000000000000003411466560755400156170ustar00rootroot00000000000000#!/usr/bin/env bash set -e ci_dir="$(dirname "$0")" . "${ci_dir}/ci-common.sh" git_download color if [ "$DOWNLOAD_ONLY" ]; then exit 0; fi export COQEXTRAFLAGS='-native-compiler no' ( cd "${CI_BUILD_DIR}/color" make ) coq-8.20.0/dev/ci/ci-common.sh000066400000000000000000000165241466560755400160030ustar00rootroot00000000000000#!/usr/bin/env bash set -xe # default value for NJOBS : "${NJOBS:=1}" export NJOBS # We add $PWD/_install_ci/lib unconditionally due to a hack in the # ci-menhir script, which will install some OCaml libraries outside # our docker-opam / Nix setup; we have to do this for all the 3 cases # below; would we fix ci-menhir, then we just do this for the first # branch [ci case] if which cygpath >/dev/null 2>&1; then OCAMLFINDSEP=\;; else OCAMLFINDSEP=:; fi export OCAMLPATH="$PWD/_install_ci/lib$OCAMLFINDSEP$OCAMLPATH" export PATH="$PWD/_install_ci/bin:$PATH" # We can remove setting COQLIB and COQCORELIB from here, but better to # wait until we have merged the coq.boot patch so we can do this in a # more controlled way. if [ -n "${GITLAB_CI}" ]; then # Gitlab build, Coq installed into `_install_ci` export COQBIN="$PWD/_install_ci/bin" # Where we install external binaries and ocaml libraries # also generally used for dune install --prefix so needs to match coq's expected user-contrib path CI_INSTALL_DIR="$PWD/_install_ci" export CI_BRANCH="$CI_COMMIT_REF_NAME" if [[ ${CI_BRANCH#pr-} =~ ^[0-9]*$ ]] then export CI_PULL_REQUEST="${CI_BRANCH#pr-}" fi elif [ -d "$PWD/_build/install/default/" ]; then # Full Dune build, we basically do what `dune exec --` does export OCAMLPATH="$PWD/_build/install/default/lib/$OCAMLFINDSEP$OCAMLPATH" export COQBIN="$PWD/_build/install/default/bin" export COQLIB="$PWD/_build/install/default/lib/coq" export COQCORELIB="$PWD/_build/install/default/lib/coq-core" CI_INSTALL_DIR="$PWD/_build/install/default/" CI_BRANCH="$(git rev-parse --abbrev-ref HEAD)" export CI_BRANCH fi export PATH="$COQBIN:$PATH" # Coq's tools need an ending slash :S, we should fix them. export COQBIN="$COQBIN/" ls -l "$COQBIN" # Where we download and build external developments CI_BUILD_DIR="$PWD/_build_ci" ls -l "$CI_BUILD_DIR" || true declare -A overlays # overlay [] # creates an overlay for project using a given url and branch which is # active for prnumber or prbranch. prbranch defaults to ref. function overlay() { local project=$1 local ov_url=$2 local ov_ref=$3 local ov_prnumber=$4 local ov_prbranch=$5 : "${ov_prbranch:=$ov_ref}" if [ "$CI_PULL_REQUEST" = "$ov_prnumber" ] || [ "$CI_BRANCH" = "$ov_prbranch" ]; then if ! is_in_projects "$project"; then echo "Error: $1 is not a known project which can be overlayed" exit 1 fi overlays[${project}_URL]=$ov_url overlays[${project}_REF]=$ov_ref fi } set +x # shellcheck source=ci-basic-overlay.sh . "${ci_dir}/ci-basic-overlay.sh" for overlay in "${ci_dir}"/user-overlays/*.sh; do # shellcheck source=/dev/null # the directoy can be empty if [ -e "${overlay}" ]; then . "${overlay}"; fi done set -x # [git_download []] will download and # unpack it in (if given; default: # $CI_BUILD_DIR/) if the folder does not exist already; if it # does, it will do nothing except print a warning (this can be useful # when building locally). # Note: when there is an overlay, $WITH_SUBMODULES is set to 1 or $CI # is unset or empty (local build), it uses git clone to perform the # download. git_download() { local project=$1 local dest="${2:-$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 parent_project_var="${project}_CI_PARENT_PROJECT" local parent_project="${!parent_project_var}" local submodule_folder_var="${project}_CI_SUBMODULE_FOLDER" local submodule_folder="${!submodule_folder_var}" local ov_url=${overlays[${project}_URL]} local ov_ref=${overlays[${project}_REF]} local dest_prefix="$(dirname "$dest")/" if [ "${CI}${USE_CI_DIRECTORY_STRUCTURE}" = "" ]; then # we can reuse the parent project download when not on CI local parent_project_dest="$CI_BUILD_DIR/$parent_project" # we use relative symlinks so they are relocatable local parent_project_relative_dest="${parent_project_dest#$dest_prefix}" else # on CI, we need to ensure that there's no overlap in directory tree # between sibling jobs, since otherwise they will scribble over # each others .v timestamps and result in duplicated builds local parent_project_dest="${dest}-PARENT-${parent_project}" # we use relative symlinks so they are relocatable local parent_project_relative_dest="${parent_project_dest#$dest_prefix}" fi if [ -d "$dest" ]; then echo "Warning: download and unpacking of $project skipped because $dest already exists." elif [[ $ov_url ]] || [ "$WITH_SUBMODULES" = "1" ] || [ "$CI" = "" ] || [ -n "${parent_project}" ]; then if [ -n "${parent_project}" ]; then # if there is a parent project, we first download the parent # project then symlink the submodule_folder to dest; this allows # project CI scripts to be transparent w.r.t. whether or not the # project is cloned from a submodule / submodule_folder. if [ ! -d "${parent_project_dest}" ]; then WITH_SUBMODULES=1 git_download "${parent_project}" "${parent_project_dest}" fi # now we can create the symlinks ln -s "${parent_project_relative_dest}/${submodule_folder}" "$dest" pushd "$dest" ref="$(git rev-parse HEAD)" else git clone "$giturl" "$dest" pushd "$dest" git checkout "$ref" fi git log -n 1 if [[ $ov_url ]]; then # In CI we merge into the upstream branch to stay synchronized # Locally checkout the overlay and rebase on upstream # We act differently because merging is what will happen when the PR is merged # but rebasing produces something that is nicer to edit if [[ $CI ]]; then git -c pull.rebase=false -c user.email=nobody@example.invalid -c user.name=Nobody \ pull --no-edit --no-ff "$ov_url" "$ov_ref" git log -n 1 HEAD^2 || true # no merge commit if the overlay was merged upstream git log -n 1 else git remote add -t "$ov_ref" -f overlay "$ov_url" git checkout -b "$ov_ref" overlay/"$ov_ref" git rebase "$ref" git log -n 1 fi fi if [ "$WITH_SUBMODULES" = 1 ]; then git submodule update --init --recursive fi popd else # When possible, we download tarballs to reduce bandwidth and latency local archiveurl_var="${project}_CI_ARCHIVEURL" local archiveurl="${!archiveurl_var}" mkdir -p "$dest" pushd "$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" popd fi } make() { # +x: add x only if defined if [ -z "${MAKEFLAGS+x}" ] && [ -n "${NJOBS}" ]; then # Not submake and parallel make requested command make -j "$NJOBS" "$@" else command make "$@" fi } # run make -k; make again if it failed so that the failing file comes last # makes it easier to find the error messages in the CI log function make_full() { if ! make -k "$@"; then make -k "$@"; exit 1; fi } coq-8.20.0/dev/ci/ci-compcert.sh000066400000000000000000000012461466560755400163220ustar00rootroot00000000000000#!/usr/bin/env bash set -e ci_dir="$(dirname "$0")" . "${ci_dir}/ci-common.sh" git_download compcert if [ "$DOWNLOAD_ONLY" ]; then exit 0; fi # CompCert does compile with -native-compiler yes # but with excessive memory requirements export COQCOPTS='-native-compiler no -w -undeclared-scope -w -omega-is-deprecated' ( cd "${CI_BUILD_DIR}/compcert" [ -e Makefile.config ] || ./configure -ignore-coq-version x86_32-linux -install-coqdev -clightgen -use-external-MenhirLib -use-external-Flocq -prefix ${CI_INSTALL_DIR} -coqdevdir ${CI_INSTALL_DIR}/lib/coq/user-contrib/compcert make make check-proof COQCHK='"$(COQBIN)coqchk" -silent -o $(COQINCLUDES)' make install ) coq-8.20.0/dev/ci/ci-coq_dpdgraph.sh000066400000000000000000000004311466560755400171340ustar00rootroot00000000000000#!/usr/bin/env bash set -e ci_dir="$(dirname "$0")" . "${ci_dir}/ci-common.sh" git_download coq_dpdgraph if [ "$DOWNLOAD_ONLY" ]; then exit 0; fi ( cd "${CI_BUILD_DIR}/coq_dpdgraph" if ! [ -e Make_coq ]; then autoconf ./configure fi make make test-suite ) coq-8.20.0/dev/ci/ci-coq_library_undecidability.sh000066400000000000000000000004321466560755400220610ustar00rootroot00000000000000#!/usr/bin/env bash set -e ci_dir="$(dirname "$0")" . "${ci_dir}/ci-common.sh" git_download coq_library_undecidability if [ "$DOWNLOAD_ONLY" ]; then exit 0; fi export COQEXTRAFLAGS='-native-compiler no' ( cd "${CI_BUILD_DIR}/coq_library_undecidability" make make install ) coq-8.20.0/dev/ci/ci-coq_lsp.sh000066400000000000000000000007011466560755400161410ustar00rootroot00000000000000#!/usr/bin/env bash set -e ci_dir="$(dirname "$0")" . "${ci_dir}/ci-common.sh" git_download coq_lsp if [ "$DOWNLOAD_ONLY" ]; then exit 0; fi ( cd "${CI_BUILD_DIR}/coq_lsp" dune build --root . --only-packages=coq-lsp @install # Tests _build/install/default/bin/coq-lsp --version dune runtest --root . test/serlib dune runtest --root . test/compiler # Needed by coq-serapi in CI dune install -p coq-lsp --prefix="$CI_INSTALL_DIR" ) coq-8.20.0/dev/ci/ci-coq_performance_tests.sh000066400000000000000000000004121466560755400210650ustar00rootroot00000000000000#!/usr/bin/env bash set -e ci_dir="$(dirname "$0")" . "${ci_dir}/ci-common.sh" git_download coq_performance_tests if [ "$DOWNLOAD_ONLY" ]; then exit 0; fi ( cd "${CI_BUILD_DIR}/coq_performance_tests" make_full coq perf-Sanity make validate make install ) coq-8.20.0/dev/ci/ci-coq_tools.sh000066400000000000000000000006561466560755400165140ustar00rootroot00000000000000#!/usr/bin/env bash set -e ci_dir="$(dirname "$0")" . "${ci_dir}/ci-common.sh" git_download coq_tools if [ "$DOWNLOAD_ONLY" ]; then exit 0; fi jason_msg() { echo "The build broke, if an overlay is needed, mention @JasonGross in describing the expected change in Coq that needs to be taken into account, and he'll prepare a fix for coq-tools" exit $1 } ( cd "${CI_BUILD_DIR}/coq_tools" make check || jason_msg $? ) coq-8.20.0/dev/ci/ci-coqhammer.sh000066400000000000000000000003531466560755400164600ustar00rootroot00000000000000#!/usr/bin/env bash set -e ci_dir="$(dirname "$0")" . "${ci_dir}/ci-common.sh" git_download coqhammer if [ "$DOWNLOAD_ONLY" ]; then exit 0; fi ( cd "${CI_BUILD_DIR}/coqhammer" make tactics make install-tactics make plugin ) coq-8.20.0/dev/ci/ci-coqprime.sh000066400000000000000000000003571466560755400163270ustar00rootroot00000000000000#!/usr/bin/env bash set -e ci_dir="$(dirname "$0")" . "${ci_dir}/ci-common.sh" git_download coqprime if [ "$DOWNLOAD_ONLY" ]; then exit 0; fi ulimit -s ulimit -s 65536 ulimit -s ( cd "${CI_BUILD_DIR}/coqprime" make make install ) coq-8.20.0/dev/ci/ci-coqtail.sh000066400000000000000000000003431466560755400161370ustar00rootroot00000000000000#!/usr/bin/env bash set -e ci_dir="$(dirname "$0")" . "${ci_dir}/ci-common.sh" git_download coqtail if [ "$DOWNLOAD_ONLY" ]; then exit 0; fi ( cd "${CI_BUILD_DIR}/coqtail" PYTHONPATH=python python3 -m pytest tests/coq ) coq-8.20.0/dev/ci/ci-coquelicot.sh000066400000000000000000000004621466560755400166540ustar00rootroot00000000000000#!/usr/bin/env bash set -e ci_dir="$(dirname "$0")" . "${ci_dir}/ci-common.sh" git_download coquelicot if [ "$DOWNLOAD_ONLY" ]; then exit 0; fi ( cd "${CI_BUILD_DIR}/coquelicot" if ! [ -x ./configure ]; then autoreconf -i -s ./configure fi ./remake "-j${NJOBS}" ./remake install ) coq-8.20.0/dev/ci/ci-coqutil.sh000066400000000000000000000004331466560755400161630ustar00rootroot00000000000000#!/usr/bin/env bash set -e ci_dir="$(dirname "$0")" . "${ci_dir}/ci-common.sh" WITH_SUBMODULES=1 git_download coqutil if [ "$DOWNLOAD_ONLY" ]; then exit 0; fi export COQEXTRAFLAGS='-native-compiler no' # following bedrock2 ( cd "${CI_BUILD_DIR}/coqutil" make make install ) coq-8.20.0/dev/ci/ci-corn.sh000066400000000000000000000003771466560755400154530ustar00rootroot00000000000000#!/usr/bin/env bash set -e ci_dir="$(dirname "$0")" . "${ci_dir}/ci-common.sh" git_download corn if [ "$DOWNLOAD_ONLY" ]; then exit 0; fi export COQEXTRAFLAGS='-native-compiler no' ( cd "${CI_BUILD_DIR}/corn" ./configure.sh make make install ) coq-8.20.0/dev/ci/ci-cross_crypto.sh000066400000000000000000000003261466560755400172350ustar00rootroot00000000000000#!/usr/bin/env bash set -e ci_dir="$(dirname "$0")" . "${ci_dir}/ci-common.sh" WITH_SUBMODULES=1 git_download cross_crypto if [ "$DOWNLOAD_ONLY" ]; then exit 0; fi ( cd "${CI_BUILD_DIR}/cross_crypto" make ) coq-8.20.0/dev/ci/ci-deriving.sh000066400000000000000000000003301466560755400163060ustar00rootroot00000000000000#!/usr/bin/env bash set -e ci_dir="$(dirname "$0")" . "${ci_dir}/ci-common.sh" git_download deriving if [ "$DOWNLOAD_ONLY" ]; then exit 0; fi ( cd "${CI_BUILD_DIR}/deriving" make make tests make install ) coq-8.20.0/dev/ci/ci-elpi.sh000066400000000000000000000003401466560755400154310ustar00rootroot00000000000000#!/usr/bin/env bash set -e ci_dir="$(dirname "$0")" . "${ci_dir}/ci-common.sh" git_download elpi if [ "$DOWNLOAD_ONLY" ]; then exit 0; fi ( cd "${CI_BUILD_DIR}/elpi" make build-core make build-apps make install ) coq-8.20.0/dev/ci/ci-elpi_test.sh000066400000000000000000000002761466560755400165000ustar00rootroot00000000000000#!/usr/bin/env bash set -e ci_dir="$(dirname "$0")" . "${ci_dir}/ci-common.sh" if [ "$DOWNLOAD_ONLY" ]; then exit 0; fi ( cd "${CI_BUILD_DIR}/elpi" make test-core examples test-apps ) coq-8.20.0/dev/ci/ci-engine_bench.sh000066400000000000000000000004201466560755400171030ustar00rootroot00000000000000#!/usr/bin/env bash set -e ci_dir="$(dirname "$0")" . "${ci_dir}/ci-common.sh" git_download engine_bench if [ "$DOWNLOAD_ONLY" ]; then exit 0; fi export COQEXTRAFLAGS='-native-compiler ondemand' ( cd "${CI_BUILD_DIR}/engine_bench" make coq make coq-perf-Sanity ) coq-8.20.0/dev/ci/ci-equations.sh000066400000000000000000000005031466560755400165110ustar00rootroot00000000000000#!/usr/bin/env bash set -e ci_dir="$(dirname "$0")" . "${ci_dir}/ci-common.sh" git_download equations if [ "$DOWNLOAD_ONLY" ]; then exit 0; fi export COQEXTRAFLAGS='-native-compiler no' ( cd "${CI_BUILD_DIR}/equations" [ -e Makefile.coq ] || ./configure.sh coq make -f Makefile.coq .merlin make make install ) coq-8.20.0/dev/ci/ci-equations_test.sh000066400000000000000000000003451466560755400175540ustar00rootroot00000000000000#!/usr/bin/env bash set -e ci_dir="$(dirname "$0")" . "${ci_dir}/ci-common.sh" if [ "$DOWNLOAD_ONLY" ]; then exit 0; fi export COQEXTRAFLAGS='-native-compiler no' ( cd "${CI_BUILD_DIR}/equations" make test-suite examples ) coq-8.20.0/dev/ci/ci-ext_lib.sh000066400000000000000000000003111466560755400161240ustar00rootroot00000000000000#!/usr/bin/env bash set -e ci_dir="$(dirname "$0")" . "${ci_dir}/ci-common.sh" git_download ext_lib if [ "$DOWNLOAD_ONLY" ]; then exit 0; fi ( cd "${CI_BUILD_DIR}/ext_lib" make make install ) coq-8.20.0/dev/ci/ci-fcsl_pcm.sh000066400000000000000000000002741466560755400162740ustar00rootroot00000000000000#!/usr/bin/env bash set -e ci_dir="$(dirname "$0")" . "${ci_dir}/ci-common.sh" git_download fcsl_pcm if [ "$DOWNLOAD_ONLY" ]; then exit 0; fi ( cd "${CI_BUILD_DIR}/fcsl_pcm" make ) coq-8.20.0/dev/ci/ci-fiat_crypto.sh000066400000000000000000000017511466560755400170320ustar00rootroot00000000000000#!/usr/bin/env bash set -e ci_dir="$(dirname "$0")" . "${ci_dir}/ci-common.sh" WITH_SUBMODULES=1 git_download fiat_crypto if [ "$DOWNLOAD_ONLY" ]; then exit 0; fi # We need a larger stack size to not overflow ocamlopt+flambda when # building the executables. # c.f. https://github.com/coq/coq/pull/8313#issuecomment-416650241 stacksize=32768 # fiat-crypto is not guaranteed to build with the latest version of # bedrock2, so we use the pinned version of bedrock2 (set in # ci-basic-overlay), but the external version of other developments make_args=(EXTERNAL_REWRITER=1 EXTERNAL_COQPRIME=1 EXTERNAL_COQUTIL=1 EXTERNAL_BEDROCK2=1) export COQEXTRAFLAGS='-native-compiler no' # following bedrock2 ( cd "${CI_BUILD_DIR}/fiat_crypto" ulimit -s $stacksize make "${make_args[@]}" pre-standalone-extracted printlite lite || make -j 1 "${make_args[@]}" pre-standalone-extracted printlite lite make "${make_args[@]}" all-except-compiled || make -j 1 "${make_args[@]}" all-except-compiled ) coq-8.20.0/dev/ci/ci-fiat_crypto_legacy.sh000066400000000000000000000011751466560755400203560ustar00rootroot00000000000000#!/usr/bin/env bash set -e ci_dir="$(dirname "$0")" . "${ci_dir}/ci-common.sh" WITH_SUBMODULES=1 git_download fiat_crypto_legacy if [ "$DOWNLOAD_ONLY" ]; then exit 0; fi targets1=( print-old-pipeline-lite-hardcoded old-pipeline-lite-hardcoded lite-display-hardcoded ) targets2=( print-old-pipeline-nobigmem-hardcoded old-pipeline-nobigmem-hardcoded nonautogenerated-specific nonautogenerated-specific-display selected-specific selected-specific-display ) export COQEXTRAFLAGS='-native-compiler no' ( cd "${CI_BUILD_DIR}/fiat_crypto_legacy" make "${targets1[@]}" make -j 1 "${targets2[@]}" ) coq-8.20.0/dev/ci/ci-fiat_crypto_ocaml.sh000066400000000000000000000013431466560755400202020ustar00rootroot00000000000000#!/usr/bin/env bash set -e # fiat-crypto job sets up the sources if [ "$DOWNLOAD_ONLY" ]; then exit 0; fi ci_dir="$(dirname "$0")" . "${ci_dir}/ci-common.sh" # We set the stack size to 128MiB to be able to build with flambda # See https://github.com/ocaml/ocaml/issues/7842 ulimit -s 131072 # Regardless of where the dependencies came from when building # ci-fiat_crypto, we don't need them for building the OCaml # binaries and lite C files, so we use all external dependencies. # we explicitly pass OCAMLFIND so that we pick up the opam # (non-flambda one) rather than the one used to build coq make_args=(EXTERNAL_DEPENDENCIES=1 OCAMLFIND=ocamlfind) ( cd "${CI_BUILD_DIR}/fiat_crypto" make "${make_args[@]}" -j 1 lite-c-files ) coq-8.20.0/dev/ci/ci-fiat_parsers.sh000066400000000000000000000004441466560755400171670ustar00rootroot00000000000000#!/usr/bin/env bash set -e ci_dir="$(dirname "$0")" . "${ci_dir}/ci-common.sh" WITH_SUBMODULES=1 git_download fiat_parsers if [ "$DOWNLOAD_ONLY" ]; then exit 0; fi ulimit -s ulimit -s 65536 ulimit -s ( cd "${CI_BUILD_DIR}/fiat_parsers" make parsers parsers-examples make fiat-core ) coq-8.20.0/dev/ci/ci-finmap.sh000066400000000000000000000003071466560755400157550ustar00rootroot00000000000000#!/usr/bin/env bash set -e ci_dir="$(dirname "$0")" . "${ci_dir}/ci-common.sh" git_download finmap if [ "$DOWNLOAD_ONLY" ]; then exit 0; fi ( cd "${CI_BUILD_DIR}/finmap" make make install ) coq-8.20.0/dev/ci/ci-flocq.sh000066400000000000000000000004551466560755400156130ustar00rootroot00000000000000#!/usr/bin/env bash set -e ci_dir="$(dirname "$0")" . "${ci_dir}/ci-common.sh" git_download flocq if [ "$DOWNLOAD_ONLY" ]; then exit 0; fi ( cd "${CI_BUILD_DIR}/flocq" if ! [ -x ./configure ]; then autoconf ./configure fi ./remake "-j${NJOBS}" ./remake install install-glob ) coq-8.20.0/dev/ci/ci-fourcolor.sh000066400000000000000000000003151466560755400165140ustar00rootroot00000000000000#!/usr/bin/env bash set -e ci_dir="$(dirname "$0")" . "${ci_dir}/ci-common.sh" git_download fourcolor if [ "$DOWNLOAD_ONLY" ]; then exit 0; fi ( cd "${CI_BUILD_DIR}/fourcolor" make make install ) coq-8.20.0/dev/ci/ci-hb.sh000066400000000000000000000003611466560755400150740ustar00rootroot00000000000000#!/usr/bin/env bash set -e ci_dir="$(dirname "$0")" . "${ci_dir}/ci-common.sh" git_download hierarchy_builder if [ "$DOWNLOAD_ONLY" ]; then exit 0; fi ( cd "${CI_BUILD_DIR}/hierarchy_builder" make config make build make install ) coq-8.20.0/dev/ci/ci-hb_test.sh000066400000000000000000000002711466560755400161330ustar00rootroot00000000000000#!/usr/bin/env bash set -e ci_dir="$(dirname "$0")" . "${ci_dir}/ci-common.sh" if [ "$DOWNLOAD_ONLY" ]; then exit 0; fi ( cd "${CI_BUILD_DIR}/hierarchy_builder" make test-suite ) coq-8.20.0/dev/ci/ci-hott.sh000066400000000000000000000003041466560755400154560ustar00rootroot00000000000000#!/usr/bin/env bash set -e ci_dir="$(dirname "$0")" . "${ci_dir}/ci-common.sh" git_download hott if [ "$DOWNLOAD_ONLY" ]; then exit 0; fi ( cd "${CI_BUILD_DIR}/hott" make make validate ) coq-8.20.0/dev/ci/ci-http.sh000066400000000000000000000003031466560755400154560ustar00rootroot00000000000000#!/usr/bin/env bash set -e ci_dir="$(dirname "$0")" . "${ci_dir}/ci-common.sh" git_download http if [ "$DOWNLOAD_ONLY" ]; then exit 0; fi ( cd "${CI_BUILD_DIR}/http" make make install ) coq-8.20.0/dev/ci/ci-iris.sh000066400000000000000000000017711466560755400154570ustar00rootroot00000000000000#!/usr/bin/env bash set -e ci_dir="$(dirname "$0")" . "${ci_dir}/ci-common.sh" git_download iris_examples # Extract required version of Iris (avoiding "+" which does not work on MacOS :( *) iris_CI_REF=$(grep -F '"coq-iris-heap-lang"' < "${CI_BUILD_DIR}/iris_examples/coq-iris-examples.opam" | sed 's/.*"dev\.[0-9][0-9.-]*\.\([0-9a-z][0-9a-z]*\)".*/\1/') [ -n "$iris_CI_REF" ] || { echo "Could not find Iris dependency version" && exit 1; } # Download Iris git_download iris # Extract required version of std++ 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/') [ -n "$stdpp_CI_REF" ] || { echo "Could not find stdpp dependency version" && exit 1; } # Download std++ git_download stdpp if [ "$DOWNLOAD_ONLY" ]; then exit 0; fi # Build ( cd "${CI_BUILD_DIR}/stdpp" make make install ) ( cd "${CI_BUILD_DIR}/iris" make make validate make install ) ( cd "${CI_BUILD_DIR}/iris_examples" make make install ) coq-8.20.0/dev/ci/ci-itauto.sh000066400000000000000000000003631466560755400160120ustar00rootroot00000000000000#!/usr/bin/env bash set -e ci_dir="$(dirname "$0")" . "${ci_dir}/ci-common.sh" git_download itauto if [ "$DOWNLOAD_ONLY" ]; then exit 0; fi export COQCOPTS='-native-compiler ondemand' ( cd "${CI_BUILD_DIR}/itauto" make make install ) coq-8.20.0/dev/ci/ci-itree.sh000066400000000000000000000003111466560755400156060ustar00rootroot00000000000000#!/usr/bin/env bash set -e ci_dir="$(dirname "$0")" . "${ci_dir}/ci-common.sh" git_download itree if [ "$DOWNLOAD_ONLY" ]; then exit 0; fi ( cd "${CI_BUILD_DIR}/itree" make all make install ) coq-8.20.0/dev/ci/ci-itree_io.sh000066400000000000000000000003131466560755400162770ustar00rootroot00000000000000#!/usr/bin/env bash set -e ci_dir="$(dirname "$0")" . "${ci_dir}/ci-common.sh" git_download itree_io if [ "$DOWNLOAD_ONLY" ]; then exit 0; fi ( cd "${CI_BUILD_DIR}/itree_io" make make install ) coq-8.20.0/dev/ci/ci-jasmin.sh000066400000000000000000000003561466560755400157700ustar00rootroot00000000000000#!/usr/bin/env bash set -e ci_dir="$(dirname "$0")" . "${ci_dir}/ci-common.sh" git_download jasmin if [ "$DOWNLOAD_ONLY" ]; then exit 0; fi export COQEXTRAFLAGS='-native-compiler no' ( cd "${CI_BUILD_DIR}/jasmin" make -C proofs ) coq-8.20.0/dev/ci/ci-json.sh000066400000000000000000000003031466560755400154500ustar00rootroot00000000000000#!/usr/bin/env bash set -e ci_dir="$(dirname "$0")" . "${ci_dir}/ci-common.sh" git_download json if [ "$DOWNLOAD_ONLY" ]; then exit 0; fi ( cd "${CI_BUILD_DIR}/json" make make install ) coq-8.20.0/dev/ci/ci-kami.sh000066400000000000000000000004251466560755400154250ustar00rootroot00000000000000#!/usr/bin/env bash set -e ci_dir="$(dirname "$0")" . "${ci_dir}/ci-common.sh" WITH_SUBMODULES=1 git_download kami if [ "$DOWNLOAD_ONLY" ]; then exit 0; fi export COQEXTRAFLAGS='-native-compiler no' # following bedrock2 ( cd "${CI_BUILD_DIR}/kami" make make install ) coq-8.20.0/dev/ci/ci-lean_importer.sh000066400000000000000000000004151466560755400173430ustar00rootroot00000000000000#!/usr/bin/env bash set -e ci_dir="$(dirname "$0")" . "${ci_dir}/ci-common.sh" git_download lean_importer if [ "$DOWNLOAD_ONLY" ]; then exit 0; fi export COQEXTRAFLAGS='-native-compiler no' ( cd "${CI_BUILD_DIR}/lean_importer" make .merlin make make test ) coq-8.20.0/dev/ci/ci-ltac2_compiler.sh000066400000000000000000000004361466560755400174050ustar00rootroot00000000000000#!/usr/bin/env bash set -e ci_dir="$(dirname "$0")" . "${ci_dir}/ci-common.sh" git_download ltac2_compiler if [ "$DOWNLOAD_ONLY" ]; then exit 0; fi export COQEXTRAFLAGS='-native-compiler no' ( cd "${CI_BUILD_DIR}/ltac2_compiler" make .merlin make make test make install ) coq-8.20.0/dev/ci/ci-math_classes.sh000066400000000000000000000003441466560755400171520ustar00rootroot00000000000000#!/usr/bin/env bash set -e ci_dir="$(dirname "$0")" . "${ci_dir}/ci-common.sh" git_download math_classes if [ "$DOWNLOAD_ONLY" ]; then exit 0; fi ( cd "${CI_BUILD_DIR}/math_classes" ./configure.sh make make install ) coq-8.20.0/dev/ci/ci-mathcomp.sh000066400000000000000000000003241466560755400163120ustar00rootroot00000000000000#!/usr/bin/env bash set -e ci_dir="$(dirname "$0")" . "${ci_dir}/ci-common.sh" git_download mathcomp if [ "$DOWNLOAD_ONLY" ]; then exit 0; fi ( cd "${CI_BUILD_DIR}/mathcomp/mathcomp" make make install ) coq-8.20.0/dev/ci/ci-mathcomp_1.sh000066400000000000000000000003301466560755400165270ustar00rootroot00000000000000#!/usr/bin/env bash set -e ci_dir="$(dirname "$0")" . "${ci_dir}/ci-common.sh" git_download mathcomp_1 if [ "$DOWNLOAD_ONLY" ]; then exit 0; fi ( cd "${CI_BUILD_DIR}/mathcomp_1/mathcomp" make make install ) coq-8.20.0/dev/ci/ci-mathcomp_test.sh000066400000000000000000000002711466560755400173520ustar00rootroot00000000000000#!/usr/bin/env bash set -e ci_dir="$(dirname "$0")" . "${ci_dir}/ci-common.sh" if [ "$DOWNLOAD_ONLY" ]; then exit 0; fi ( cd "${CI_BUILD_DIR}/mathcomp/mathcomp" make test-suite ) coq-8.20.0/dev/ci/ci-mathcomp_word.sh000066400000000000000000000004511466560755400173460ustar00rootroot00000000000000#!/usr/bin/env bash set -e ci_dir="$(dirname "$0")" . "${ci_dir}/ci-common.sh" git_download mathcomp_word if [ "$DOWNLOAD_ONLY" ]; then exit 0; fi ( cd "${CI_BUILD_DIR}/mathcomp_word" dune build @install -p coq-mathcomp-word dune install -p coq-mathcomp-word --prefix="$CI_INSTALL_DIR" ) coq-8.20.0/dev/ci/ci-mczify.sh000066400000000000000000000002701466560755400160030ustar00rootroot00000000000000#!/usr/bin/env bash set -e ci_dir="$(dirname "$0")" . "${ci_dir}/ci-common.sh" git_download mczify if [ "$DOWNLOAD_ONLY" ]; then exit 0; fi ( cd "${CI_BUILD_DIR}/mczify" make ) coq-8.20.0/dev/ci/ci-menhir.sh000066400000000000000000000011131466560755400157610ustar00rootroot00000000000000#!/usr/bin/env bash set -e ci_dir="$(dirname "$0")" . "${ci_dir}/ci-common.sh" git_download menhirlib if [ "$DOWNLOAD_ONLY" ]; then exit 0; fi ( cd "${CI_BUILD_DIR}/menhirlib" if grep -q unreleased dune-project; then date=$(date +%Y%m%d) sed -i.bak "s/unreleased/$date/" dune-project echo "Definition require_$date := tt." > coq-menhirlib/src/Version.v fi dune build @install -p menhirLib,menhirSdk,menhir dune install -p menhirLib,menhirSdk,menhir menhir menhirSdk menhirLib --prefix="$CI_INSTALL_DIR" make -C coq-menhirlib make -C coq-menhirlib install ) coq-8.20.0/dev/ci/ci-metacoq.sh000066400000000000000000000005461466560755400161410ustar00rootroot00000000000000#!/usr/bin/env bash set -e ci_dir="$(dirname "$0")" . "${ci_dir}/ci-common.sh" git_download metacoq if [ "$DOWNLOAD_ONLY" ]; then exit 0; fi export COQEXTRAFLAGS='-native-compiler no' ( cd "${CI_BUILD_DIR}/metacoq" [ -e pcuic/metacoq-config ] || ./configure.sh local make all TIMED=pretty-timed make test-suite TIMED=pretty-timed make install ) coq-8.20.0/dev/ci/ci-mtac2.sh000066400000000000000000000003571466560755400155160ustar00rootroot00000000000000#!/usr/bin/env bash set -e ci_dir="$(dirname "$0")" . "${ci_dir}/ci-common.sh" git_download mtac2 if [ "$DOWNLOAD_ONLY" ]; then exit 0; fi ( cd "${CI_BUILD_DIR}/mtac2" coq_makefile -f _CoqProject -o Makefile make .merlin make ) coq-8.20.0/dev/ci/ci-neural_net_interp.sh000066400000000000000000000003341466560755400202200ustar00rootroot00000000000000#!/usr/bin/env bash set -e ci_dir="$(dirname "$0")" . "${ci_dir}/ci-common.sh" git_download neural_net_interp if [ "$DOWNLOAD_ONLY" ]; then exit 0; fi ( cd "${CI_BUILD_DIR}/neural_net_interp" make coq-ci-target ) coq-8.20.0/dev/ci/ci-oddorder.sh000066400000000000000000000003131466560755400163020ustar00rootroot00000000000000#!/usr/bin/env bash set -e ci_dir="$(dirname "$0")" . "${ci_dir}/ci-common.sh" git_download oddorder if [ "$DOWNLOAD_ONLY" ]; then exit 0; fi ( cd "${CI_BUILD_DIR}/oddorder" make make install ) coq-8.20.0/dev/ci/ci-paco.sh000066400000000000000000000003271466560755400154270ustar00rootroot00000000000000#!/usr/bin/env bash set -e ci_dir="$(dirname "$0")" . "${ci_dir}/ci-common.sh" git_download paco if [ "$DOWNLOAD_ONLY" ]; then exit 0; fi ( cd "${CI_BUILD_DIR}/paco/src" make make -f Makefile.coq install ) coq-8.20.0/dev/ci/ci-paramcoq.sh000066400000000000000000000003531466560755400163070ustar00rootroot00000000000000#!/usr/bin/env bash set -e ci_dir="$(dirname "$0")" . "${ci_dir}/ci-common.sh" git_download paramcoq if [ "$DOWNLOAD_ONLY" ]; then exit 0; fi ( cd "${CI_BUILD_DIR}/paramcoq" make make install cd test-suite make examples ) coq-8.20.0/dev/ci/ci-parsec.sh000066400000000000000000000003071466560755400157600ustar00rootroot00000000000000#!/usr/bin/env bash set -e ci_dir="$(dirname "$0")" . "${ci_dir}/ci-common.sh" git_download parsec if [ "$DOWNLOAD_ONLY" ]; then exit 0; fi ( cd "${CI_BUILD_DIR}/parsec" make make install ) coq-8.20.0/dev/ci/ci-perennial.sh000066400000000000000000000004051466560755400164570ustar00rootroot00000000000000#!/usr/bin/env bash set -e ci_dir="$(dirname "$0")" . "${ci_dir}/ci-common.sh" WITH_SUBMODULES=1 git_download perennial if [ "$DOWNLOAD_ONLY" ]; then exit 0; fi ulimit -s ulimit -s 65536 ulimit -s ( cd "${CI_BUILD_DIR}/perennial" make TIMED=false lite ) coq-8.20.0/dev/ci/ci-quickchick.sh000066400000000000000000000004331466560755400166210ustar00rootroot00000000000000#!/usr/bin/env bash set -e ci_dir="$(dirname "$0")" . "${ci_dir}/ci-common.sh" git_download quickchick if [ "$DOWNLOAD_ONLY" ]; then exit 0; fi ( cd "${CI_BUILD_DIR}/quickchick" dune build -p coq-quickchick @install dune install -p coq-quickchick --prefix=$CI_INSTALL_DIR ) coq-8.20.0/dev/ci/ci-quickchick_test.sh000066400000000000000000000003441466560755400176610ustar00rootroot00000000000000#!/usr/bin/env bash set -e ci_dir="$(dirname "$0")" . "${ci_dir}/ci-common.sh" if [ "$DOWNLOAD_ONLY" ]; then exit 0; fi ( cd "${CI_BUILD_DIR}/quickchick" dune build -p coq-quickchick @runtest @cram --stop-on-first-error ) coq-8.20.0/dev/ci/ci-reduction_effects.sh000066400000000000000000000003511466560755400201750ustar00rootroot00000000000000#!/usr/bin/env bash set -e ci_dir="$(dirname "$0")" . "${ci_dir}/ci-common.sh" git_download reduction_effects if [ "$DOWNLOAD_ONLY" ]; then exit 0; fi ( cd "${CI_BUILD_DIR}/reduction_effects" make make test make install ) coq-8.20.0/dev/ci/ci-relation_algebra.sh000066400000000000000000000003521466560755400177750ustar00rootroot00000000000000#!/usr/bin/env bash set -e ci_dir="$(dirname "$0")" . "${ci_dir}/ci-common.sh" git_download relation_algebra if [ "$DOWNLOAD_ONLY" ]; then exit 0; fi ( cd "${CI_BUILD_DIR}/relation_algebra" make .merlin make make install ) coq-8.20.0/dev/ci/ci-rewriter.sh000066400000000000000000000003131466560755400163430ustar00rootroot00000000000000#!/usr/bin/env bash set -e ci_dir="$(dirname "$0")" . "${ci_dir}/ci-common.sh" git_download rewriter if [ "$DOWNLOAD_ONLY" ]; then exit 0; fi ( cd "${CI_BUILD_DIR}/rewriter" make make install ) coq-8.20.0/dev/ci/ci-riscv_coq.sh000066400000000000000000000005471466560755400165010ustar00rootroot00000000000000#!/usr/bin/env bash set -e ci_dir="$(dirname "$0")" . "${ci_dir}/ci-common.sh" WITH_SUBMODULES=1 git_download riscv_coq if [ "$DOWNLOAD_ONLY" ]; then exit 0; fi make_args=(EXTERNAL_COQUTIL=1) export COQEXTRAFLAGS='-native-compiler no' # following bedrock2 ( cd "${CI_BUILD_DIR}/riscv_coq" make "${make_args[@]}" all make "${make_args[@]}" install ) coq-8.20.0/dev/ci/ci-rupicola.sh000066400000000000000000000005651466560755400163270ustar00rootroot00000000000000#!/usr/bin/env bash set -e ci_dir="$(dirname "$0")" . "${ci_dir}/ci-common.sh" WITH_SUBMODULES=1 git_download rupicola if [ "$DOWNLOAD_ONLY" ]; then exit 0; fi make_args=(EXTERNAL_COQUTIL=1 EXTERNAL_BEDROCK2=1) export COQEXTRAFLAGS='-native-compiler no' # following bedrock2 ( cd "${CI_BUILD_DIR}/rupicola" make "${make_args[@]}" make "${make_args[@]}" install ) coq-8.20.0/dev/ci/ci-serapi.sh000066400000000000000000000005161466560755400157700ustar00rootroot00000000000000#!/usr/bin/env bash set -e ci_dir="$(dirname "$0")" . "${ci_dir}/ci-common.sh" git_download serapi if [ "$DOWNLOAD_ONLY" ]; then exit 0; fi ( cd "${CI_BUILD_DIR}/serapi" make make test # Not needed by any other CI job for now, but we still install just # in case dune install -p coq-serapi --prefix="$CI_INSTALL_DIR" ) coq-8.20.0/dev/ci/ci-sf.sh000066400000000000000000000004751466560755400151210ustar00rootroot00000000000000#!/usr/bin/env bash set -e ci_dir="$(dirname "$0")" . "${ci_dir}/ci-common.sh" git_download sf if [ "$DOWNLOAD_ONLY" ]; then exit 0; fi cd "$CI_BUILD_DIR/sf" ( cd lf-current make ) ( cd plf-current make ) ( cd vfa-current make ) ( cd slf-current make ) # ( cd qc-current # make clean # make # ) coq-8.20.0/dev/ci/ci-simple_io.sh000066400000000000000000000004271466560755400164660ustar00rootroot00000000000000#!/usr/bin/env bash set -e ci_dir="$(dirname "$0")" . "${ci_dir}/ci-common.sh" git_download simple_io if [ "$DOWNLOAD_ONLY" ]; then exit 0; fi ( cd "${CI_BUILD_DIR}/simple_io" dune build -p coq-simple-io @install dune install -p coq-simple-io --prefix=$CI_INSTALL_DIR ) coq-8.20.0/dev/ci/ci-smtcoq.sh000066400000000000000000000003351466560755400160120ustar00rootroot00000000000000#!/usr/bin/env bash set -e ci_dir="$(dirname "$0")" . "${ci_dir}/ci-common.sh" git_download smtcoq if [ "$DOWNLOAD_ONLY" ]; then exit 0; fi ( cd "${CI_BUILD_DIR}/smtcoq" make -C src .merlin make make install ) coq-8.20.0/dev/ci/ci-stalmarck.sh000066400000000000000000000006211466560755400164630ustar00rootroot00000000000000#!/usr/bin/env bash set -e ci_dir="$(dirname "$0")" . "${ci_dir}/ci-common.sh" git_download stalmarck if [ "$DOWNLOAD_ONLY" ]; then exit 0; fi ( cd "${CI_BUILD_DIR}/stalmarck" make make install rm -f coq-stalmarck.opam # work around https://github.com/ocaml/dune/issues/4814 dune build @install -p coq-stalmarck-tactic dune install -p coq-stalmarck-tactic --prefix="$CI_INSTALL_DIR" ) coq-8.20.0/dev/ci/ci-stdlib2.sh000066400000000000000000000003331466560755400160450ustar00rootroot00000000000000#!/usr/bin/env bash set -e ci_dir="$(dirname "$0")" . "${ci_dir}/ci-common.sh" git_download stdlib2 if [ "$DOWNLOAD_ONLY" ]; then exit 0; fi ( cd "${CI_BUILD_DIR}/stdlib2/src" ./bootstrap make make install ) coq-8.20.0/dev/ci/ci-tactician.sh000077500000000000000000000003371466560755400164500ustar00rootroot00000000000000#!/usr/bin/env bash set -e ci_dir="$(dirname "$0")" . "${ci_dir}/ci-common.sh" git_download tactician if [ "$DOWNLOAD_ONLY" ]; then exit 0; fi ( cd "${CI_BUILD_DIR}/tactician" dune build --root . theories/Ltac1.vo ) coq-8.20.0/dev/ci/ci-tlc.sh000066400000000000000000000003011466560755400152570ustar00rootroot00000000000000#!/usr/bin/env bash set -e ci_dir="$(dirname "$0")" . "${ci_dir}/ci-common.sh" git_download tlc if [ "$DOWNLOAD_ONLY" ]; then exit 0; fi ( cd "${CI_BUILD_DIR}/tlc" make make install ) coq-8.20.0/dev/ci/ci-trakt.sh000066400000000000000000000003051466560755400156260ustar00rootroot00000000000000#!/usr/bin/env bash set -e ci_dir="$(dirname "$0")" . "${ci_dir}/ci-common.sh" git_download trakt if [ "$DOWNLOAD_ONLY" ]; then exit 0; fi ( cd "${CI_BUILD_DIR}/trakt" make make install ) coq-8.20.0/dev/ci/ci-unicoq.sh000066400000000000000000000004001466560755400157730ustar00rootroot00000000000000#!/usr/bin/env bash set -e ci_dir="$(dirname "$0")" . "${ci_dir}/ci-common.sh" git_download unicoq if [ "$DOWNLOAD_ONLY" ]; then exit 0; fi ( cd "${CI_BUILD_DIR}/unicoq" coq_makefile -f _CoqProject -o Makefile make .merlin make make install ) coq-8.20.0/dev/ci/ci-unimath.sh000066400000000000000000000007521466560755400161540ustar00rootroot00000000000000#!/usr/bin/env bash set -e ci_dir="$(dirname "$0")" . "${ci_dir}/ci-common.sh" git_download unimath if [ "$DOWNLOAD_ONLY" ]; then exit 0; fi export COQEXTRAFLAGS='-native-compiler no' ( cd "${CI_BUILD_DIR}/unimath" # these files consumes too much memory for the shared workers # (at least with -j 2 when the scheduler runs them in parallel) for p in SubstitutionSystems Bicategories ModelCategories; do sed -i.bak "s|PACKAGES += $p||" Makefile done make BUILD_COQ=no ) coq-8.20.0/dev/ci/ci-verdi_raft.sh000066400000000000000000000010021466560755400166210ustar00rootroot00000000000000#!/usr/bin/env bash set -e ci_dir="$(dirname "$0")" . "${ci_dir}/ci-common.sh" git_download struct_tact git_download inf_seq_ext git_download cheerios git_download verdi git_download verdi_raft if [ "$DOWNLOAD_ONLY" ]; then exit 0; fi ( cd "${CI_BUILD_DIR}/struct_tact" make make install ) ( cd "${CI_BUILD_DIR}/inf_seq_ext" make make install ) ( cd "${CI_BUILD_DIR}/cheerios" make make install ) ( cd "${CI_BUILD_DIR}/verdi" make make install ) ( cd "${CI_BUILD_DIR}/verdi_raft" make ) coq-8.20.0/dev/ci/ci-vscoq.sh000066400000000000000000000004321466560755400156350ustar00rootroot00000000000000#!/usr/bin/env bash set -e ci_dir="$(dirname "$0")" . "${ci_dir}/ci-common.sh" git_download vscoq if [ "$DOWNLOAD_ONLY" ]; then exit 0; fi ( cd "$CI_BUILD_DIR/vscoq/language-server" dune build --root . --only-packages=vscoq-language-server @install dune runtest --root . ) coq-8.20.0/dev/ci/ci-vst.sh000066400000000000000000000010011466560755400153070ustar00rootroot00000000000000#!/usr/bin/env bash set -e ci_dir="$(dirname "$0")" . "${ci_dir}/ci-common.sh" git_download vst if [ "$DOWNLOAD_ONLY" ]; then exit 0; fi # sometimes (rarely) CompCert master can break VST and it can take # weeks or months for VST to catch up, in this case, just uncomment # the line below to use the compcert version bundled in VST # export COMPCERT=bundled # See ci-compcert.sh export COQEXTRAFLAGS='-native-compiler no' ( cd "${CI_BUILD_DIR}/vst" make IGNORECOQVERSION=true IGNORECOMPCERTVERSION=true ) coq-8.20.0/dev/ci/ci-waterproof.sh000066400000000000000000000004231466560755400166720ustar00rootroot00000000000000#!/usr/bin/env/ bash set -e ci_dir="$(dirname "$0")" . "${ci_dir}/ci-common.sh" git_download waterproof if [ "$DOWNLOAD_ONLY" ]; then exit 0; fi ( cd "${CI_BUILD_DIR}/waterproof" dune build -p coq-waterproof dune install -p coq-waterproof --prefix=$CI_INSTALL_DIR ) coq-8.20.0/dev/ci/ci-wrapper.sh000077500000000000000000000061571466560755400161770ustar00rootroot00000000000000#!/usr/bin/env bash # Use this script to preserve the exit code of $CI_SCRIPT when piping # it to `tee time-of-build.log`. We have a separate script, because # this only works in bash, which we don't require project-wide. set -o pipefail set -x CI_NAME="$1" CI_SCRIPT="ci-${CI_NAME}.sh" DIR="$( cd "$( dirname "${BASH_SOURCE[0]}" )" && pwd )" # assume this script is in dev/ci/, cd to the root Coq directory cd "${DIR}/../.." || exit 1 export TIMED=1 # if COQ_CI_COLOR is set (from the environment) keep it intact (even when it's the empty string)' if ! [ "${COQ_CI_COLOR+1}" ]; then # NB: in CI TERM is unset in the environment # when TERM is unset, bash sets it to "dumb" as a bash variable (not exported?) if { [ -t 1 ] && ! [ "$TERM" = dumb ]; } || [ "$CI" ] then COQ_CI_COLOR=1 else COQ_CI_COLOR= fi fi # we don't want to block commands on user interaction export GIT_PAGER= if [ "$COQ_CI_COLOR" = 1 ] && command -v script > /dev/null; then # prevent piping from disabling auto colors / enable auto colors in CI if [ "$CI" ]; then export TERM=xterm-color fi # on some macos systems OSTYPE is just "darwin", on others it's followed by version info if [[ "$OSTYPE" =~ ^darwin ]]; then script -q /dev/null bash "${DIR}/${CI_SCRIPT}" 2>&1 | tee "$CI_NAME.log" else script --quiet --flush --return -c "bash '${DIR}/${CI_SCRIPT}'" /dev/null 2>&1 | tee "$CI_NAME.log" fi else if [ "$COQ_CI_COLOR" = 1 ]; then >&2 echo 'script command not available, colors will be hidden' fi bash "${DIR}/${CI_SCRIPT}" 2>&1 | tee "$CI_NAME.log" fi code=$? echo 'Aggregating timing log...' echo python ./tools/make-one-time-file.py --real "$CI_NAME.log" if [ "$CI" ] && ! [ $code = 0 ]; then set +x escape_re=$(printf '\033%s' '\[[0-9;]+m') # File ".* file_re="($escape_re)?"'File ".*\n' # OCaml: error message may contain some code extracts starting with the line number, # followed by a line containing "^^^" to point at the columns (possibly colored) codeline_re='([0-9].*\n)*' carets_re="((($escape_re)|[ ^])*\n)?" # Error messages may be multiline, but it's hard to find the end # heuristic: if the line ends with ":" or ",", also print the next # (typically if the start of the message got moved to the next line, # the first line is just "Error:", # also note that OCaml colors just "Error" but Coq colors the whole "Error:") error_re="($escape_re)?Error(.*[:,]($escape_re)?\n)*.*\n" # for some reason when testing with colors on # I also got carriage returns in my output which confused grep, so remove them # -P: perl-like # -z: multiline using \0 chars (which is why we have to tr to cleanup the output) # -o: print only matched (otherwise it prints the whole file due to -z) # || true: if no error is matched by this pattern, we still want to use the error code from the build < "$CI_NAME.log" tr -d "$(printf '\r')" \ | grep -Pzo "$file_re$codeline_re$carets_re$error_re" \ | tr -d '\0' > errors \ || true if [ -s errors ]; then { echo echo "Error list (may be incomplete):" echo cat errors } >&2 fi rm errors fi exit $code coq-8.20.0/dev/ci/docker/000077500000000000000000000000001466560755400150255ustar00rootroot00000000000000coq-8.20.0/dev/ci/docker/README.md000066400000000000000000000037201466560755400163060ustar00rootroot00000000000000## Overall Docker Setup for Coq's CI. This directory provides Docker images to be used by Coq's CI. The images do support Docker autobuild on `hub.docker.com` and Gitlab's private registry. The Gitlab CI will build a Docker image unless the CI environment variable `SKIP_DOCKER` is set to `true`. This image will be stored in the [Gitlab container registry](https://gitlab.com/coq/coq/container_registry) under the name given by the `CACHEKEY` variable from the [Gitlab CI configuration file](../../../.gitlab-ci.yml). `SKIP_DOCKER` is set to "true" in `https://gitlab.com/coq/coq` to avoid running a lengthy redundant job. For efficiency, users should enable that setting in forked repositories after the initial Docker build in the fork succeeds. The steps to generate a new Docker image are: - Update the `CACHEKEY` variable in .gitlab-ci.yml with the date and md5. - Submit the change in a PR. coqbot will detect that the Dockerfile has changed and will trigger a pipeline build with `SKIP_DOCKER` set to `false`. This will run a `docker-boot` process, and once completed, a new Docker image will be available in the container registry, with the name set in `CACHEKEY`. - Any pipeline with the same `CACHEKEY` will now automatically reuse that image without rebuilding it from scratch. ## Manual Building You can also manually build and push any image: - Build the image `docker build -t base:$VERSION .` To upload/push to your hub: - Create a https://hub.docker.com account. - Login into your space `docker login --username=$USER` - Push the image: + `docker tag base:$VERSION $USER/base:$VERSION` + `docker push $USER/base:$VERSION` ## Debugging / Misc To open a shell inside an image do `docker run -ti --entrypoint /bin/bash ` Each `RUN` command creates an "layer", thus a Docker build is incremental and it always help to put things updated more often at the end. ## Possible Improvements: - Use ARG for customizing versions, centralize variable setup; coq-8.20.0/dev/ci/docker/edge_ubuntu/000077500000000000000000000000001466560755400173335ustar00rootroot00000000000000coq-8.20.0/dev/ci/docker/edge_ubuntu/Dockerfile000066400000000000000000000051231466560755400213260ustar00rootroot00000000000000# Update CACHEKEY in the .gitlab-ci.yml when modifying this file. FROM ubuntu:23.04 LABEL maintainer="e@x80.org" ENV DEBIAN_FRONTEND="noninteractive" # We need libgmp-dev:i386 for zarith; maybe we could also install GTK RUN dpkg --add-architecture i386 RUN apt-get update -qq && apt-get install --no-install-recommends -y -qq \ # Dependencies of the image, the test-suite and external projects m4 automake autoconf time wget rsync git gcc-multilib build-essential unzip jq \ # Dependencies of ZArith perl libgmp-dev libgmp-dev:i386 \ # Dependencies of lablgtk (for CoqIDE) libgtksourceview-3.0-dev adwaita-icon-theme-full \ # Dependencies of source-doc and coq-makefile texlive-latex-extra texlive-science tipa \ # Dependencies of HB (test suite) wdiff \ # Required to get the wget step to succeed ca-certificates \ # Required for fiat-crypto and Coqtail python-is-python3 \ && rm -rf /var/lib/apt/lists /usr/share/doc # We need to install OPAM 2.0 manually for now. RUN wget https://github.com/ocaml/opam/releases/download/2.1.5/opam-2.1.5-x86_64-linux -O /usr/bin/opam && chmod 755 /usr/bin/opam # Basic OPAM setup ENV NJOBS="2" \ OPAMJOBS="2" \ OPAMROOT=/root/.opamcache \ OPAMROOTISOK="true" \ OPAMYES="true" # Edge opam is the set of edge packages required by Coq ENV COMPILER="4.14.1" \ BASE_OPAM="zarith.1.13 ounit2.2.2.6" \ CI_OPAM="ocamlgraph.2.0.0 cppo.1.6.9" \ BASE_OPAM_EDGE="dune.3.14.0 dune-build-info.3.14.0 dune-release.2.0.0 ocamlfind.1.9.6 odoc.2.3.1" \ CI_OPAM_EDGE="elpi.1.18.1 ppx_import.1.10.0 cmdliner.1.1.1 sexplib.v0.15.1 ppx_sexp_conv.v0.15.1 ppx_hash.v0.15.0 ppx_compare.v0.15.0 ppx_deriving_yojson.3.7.0 yojson.2.1.0 uri.4.2.0 ppx_yojson_conv.v0.15.1 ppx_inline_test.v0.15.1 ppx_assert.v0.15.0 ppx_optcomp.v0.15.0 lsp.1.16.2 sel.0.4.0" \ COQIDE_OPAM_EDGE="lablgtk3-sourceview3.3.1.3" # EDGE+flambda switch, we install CI_OPAM as to be able to use # `ci-template-flambda` with everything. RUN opam init -a --disable-sandboxing --bare && eval $(opam env) && opam update && \ opam switch create "${COMPILER}+flambda" \ --repositories default,ocaml-beta=git+https://github.com/ocaml/ocaml-beta-repository.git \ --packages="ocaml-variants.${COMPILER}+options,ocaml-option-flambda" && eval $(opam env) && \ opam install $BASE_OPAM $BASE_OPAM_EDGE $COQIDE_OPAM_EDGE $CI_OPAM $CI_OPAM_EDGE && \ opam clean -a -c && \ find ~ '(' -name '*.cmt' -o -name '*.cmti' ')' -delete # set the locale for the benefit of Python ENV LANG C.UTF-8 coq-8.20.0/dev/ci/docker/old_ubuntu_lts/000077500000000000000000000000001466560755400200675ustar00rootroot00000000000000coq-8.20.0/dev/ci/docker/old_ubuntu_lts/Dockerfile000066400000000000000000000055021466560755400220630ustar00rootroot00000000000000# Update CACHEKEY in the .gitlab-ci.yml when modifying this file. FROM ubuntu:20.04 LABEL maintainer="e@x80.org" ENV DEBIAN_FRONTEND="noninteractive" # We need libgmp-dev:i386 for zarith; maybe we could also install GTK RUN dpkg --add-architecture i386 RUN apt-get update -qq && apt-get install --no-install-recommends -y -qq \ # Dependencies of the image, the test-suite and external projects m4 automake autoconf time wget rsync git gcc-multilib build-essential unzip jq \ # Dependencies of ZArith perl libgmp-dev libgmp-dev:i386 \ # Dependencies of lablgtk (for CoqIDE) libgtksourceview-3.0-dev adwaita-icon-theme-full \ # Dependencies of stdlib and sphinx doc texlive-latex-extra texlive-fonts-recommended texlive-xetex latexmk \ python3-pip python3-setuptools python3-pexpect python3-bs4 fonts-freefont-otf \ # Dependencies of source-doc and coq-makefile texlive-science tipa \ # Dependencies of HB (test suite) wdiff \ # Required for fiat-crypto and Coqtail python-is-python3 \ && rm -rf /var/lib/apt/lists /usr/share/doc # More dependencies of the sphinx doc, pytest for coqtail RUN pip3 install docutils==0.17.1 sphinx==4.5.0 sphinx_rtd_theme==1.0.0 \ antlr4-python3-runtime==4.7.1 sphinxcontrib-bibtex==0.4.2 \ pytest==5.4.3 \ && rm -rf ~/.cache/pip # We need to install OPAM 2.0 manually for now. RUN wget https://github.com/ocaml/opam/releases/download/2.0.6/opam-2.0.6-x86_64-linux -O /usr/bin/opam && chmod 755 /usr/bin/opam # Basic OPAM setup ENV NJOBS="2" \ OPAMJOBS="2" \ OPAMROOT=/root/.opamcache \ OPAMROOTISOK="true" \ OPAMYES="true" # Base opam is the set of base packages required by Coq ENV COMPILER="4.09.0" # Common OPAM packages ENV BASE_OPAM="zarith.1.11 ounit2.2.2.6" \ CI_OPAM="ocamlgraph.2.0.0 cppo.1.6.9" \ BASE_ONLY_OPAM="dune.3.6.1 stdlib-shims.0.1.0 ocamlfind.1.8.1 odoc.2.0.2 yojson.1.7.0 num.1.4" # BASE switch; CI_OPAM contains Coq's CI dependencies. ENV COQIDE_OPAM="cairo2.0.6.1 lablgtk3-sourceview3.3.1.2" # Must add this to COQIDE_OPAM{,_EDGE} when we update the opam # packages "lablgtk3-gtksourceview3" # base switch RUN opam init -a --disable-sandboxing --compiler="$COMPILER" default https://opam.ocaml.org && eval $(opam env) && opam update && \ opam install $BASE_OPAM $COQIDE_OPAM $CI_OPAM $BASE_ONLY_OPAM && \ opam clean -a -c && \ find ~ '(' -name '*.cmt' -o -name '*.cmti' ')' -delete # base+32bit switch, note the zarith hack RUN opam switch create "${COMPILER}+32bit" && eval $(opam env) && \ i386 env CC='gcc -m32' opam install zarith.1.11 && \ opam install $BASE_OPAM && \ opam clean -a -c && \ find ~ '(' -name '*.cmt' -o -name '*.cmti' ')' -delete # set the locale for the benefit of Python ENV LANG C.UTF-8 coq-8.20.0/dev/ci/gitlab-modes/000077500000000000000000000000001466560755400161255ustar00rootroot00000000000000coq-8.20.0/dev/ci/gitlab-modes/normal-mode.yml000066400000000000000000000001131466560755400210550ustar00rootroot00000000000000 default: interruptible: true timeout: 1h tags: - not-a-real-tag coq-8.20.0/dev/ci/gitlab-modes/protected-mode.yml000066400000000000000000000001141466560755400215570ustar00rootroot00000000000000 default: interruptible: false timeout: 1h tags: - not-a-real-tag coq-8.20.0/dev/ci/gitlab-modes/tagged-runners.yml000066400000000000000000000003761466560755400216030ustar00rootroot00000000000000.auto-use-tags: tags: - $TAGGED_RUNNERS # making this configurable is too annoying if we want to support > 1 tag # and not sure small is enough # so just hardcode ci.inria.fr && medium .auto-use-docker-tags: tags: - ci.inria.fr - medium coq-8.20.0/dev/ci/gitlab-modes/untagged-runners.yml000066400000000000000000000001101466560755400221300ustar00rootroot00000000000000.auto-use-tags: tags: [] .auto-use-docker-tags: tags: - docker coq-8.20.0/dev/ci/gitlab-section.sh000077500000000000000000000004571466560755400170270ustar00rootroot00000000000000#!/bin/sh case "$1" in start) printf '\e[0Ksection_start:%s:%s\r\e[0K%s\n' "$(date +%s)" "$2" "$3" ;; end) printf '\e[0Ksection_end:%s:%s\r\e[0K\n' "$(date +%s)" "$2" ;; *) >&2 echo "usage: $0 start|end section_name [header_content]" ;; esac coq-8.20.0/dev/ci/nix/000077500000000000000000000000001466560755400143545ustar00rootroot00000000000000coq-8.20.0/dev/ci/nix/CoLoR.nix000066400000000000000000000000621466560755400160500ustar00rootroot00000000000000{ bignums }: { coqBuildInputs = [ bignums ]; } coq-8.20.0/dev/ci/nix/CompCert.nix000066400000000000000000000002651466560755400166130ustar00rootroot00000000000000{ ocamlPackages }: { buildInputs = with ocamlPackages; [ ocaml findlib menhir ]; configure = "./configure -ignore-coq-version x86_64-linux"; make = "make all check-proof"; } coq-8.20.0/dev/ci/nix/Corn.nix000066400000000000000000000001151466560755400157720ustar00rootroot00000000000000{ bignums, math-classes }: { coqBuildInputs = [ bignums math-classes ]; } coq-8.20.0/dev/ci/nix/Elpi.nix000066400000000000000000000001231466560755400157610ustar00rootroot00000000000000{ ocamlPackages }: { buildInputs = with ocamlPackages; [ ocaml findlib elpi ]; } coq-8.20.0/dev/ci/nix/HoTT.nix000066400000000000000000000002161466560755400157110ustar00rootroot00000000000000{ autoconf, automake }: { buildInputs = [ autoconf automake ]; configure = "./autogen.sh && ./configure"; make = "make all validate"; } coq-8.20.0/dev/ci/nix/README.md000066400000000000000000000022351466560755400156350ustar00rootroot00000000000000# Working on third-party developments with *this* version of Coq Aim: getting an environment suitable for working on a third-party development using the current version of Coq (i.e., built from the current state of this repository). Dive into such an environment, for the project `example` by running, from the root of this repository: ./dev/ci/nix/shell example This will build Coq and the other dependencies of the `example` project, then open a shell with all these dependencies available (e.g., `coqtop` is in path). Additionally, three environment variables are set, to abstract over the build-system of that project: `configure`, `make`, and `clean`. Therefore, after changing the working directory to the root of the sources of that project, the contents of these variables can be evaluated to respectively set-up, build, and clean the project. ## Variant: nocoq The dependencies of the third-party developments are split into `buildInputs` and `coqBuildInputs`. The second list gathers the Coq libraries. In case you only want the non-coq dependencies (because you want to use Coq from your `PATH`), set the environment variable `NOCOQ` to some non-empty value. coq-8.20.0/dev/ci/nix/VST.nix000066400000000000000000000001171466560755400155470ustar00rootroot00000000000000{}: rec { make = "make IGNORECOQVERSION=true"; clean = "${make} clean"; } coq-8.20.0/dev/ci/nix/bedrock2.nix000066400000000000000000000003071466560755400165670ustar00rootroot00000000000000{}: { configure = "git submodule update --init --recursive"; clean = "(cd deps/bbv && make clean); (cd deps/riscv-coq && make clean); (cd compiler && make clean); (cd bedrock2 && make clean)"; } coq-8.20.0/dev/ci/nix/bignums.nix000066400000000000000000000001011466560755400165300ustar00rootroot00000000000000{ ocamlPackages }: { buildInputs = [ ocamlPackages.ocaml ]; } coq-8.20.0/dev/ci/nix/coq.nix000066400000000000000000000003341466560755400156560ustar00rootroot00000000000000{ stdenv, callPackage, branch, wd }: let coq = callPackage wd { buildDoc = false; doInstallCheck = false; coq-version = "8.9"; }; in coq.overrideAttrs (o: { name = "coq-local-${branch}"; src = fetchGit "${wd}"; }) coq-8.20.0/dev/ci/nix/coq_dpdgraph.nix000066400000000000000000000003061466560755400175260ustar00rootroot00000000000000{ autoconf, ocamlPackages }: { buildInputs = [ autoconf ] ++ (with ocamlPackages; [ ocaml findlib camlp5 ocamlgraph ]); configure = "autoconf && ./configure"; make = "make all test-suite"; } coq-8.20.0/dev/ci/nix/coquelicot.nix000066400000000000000000000003171466560755400172440ustar00rootroot00000000000000{ autoconf, automake, ssreflect }: { buildInputs = [ autoconf automake ]; coqBuildInputs = [ ssreflect ]; configure = "./autogen.sh && ./configure"; make = "./remake"; clean = "./remake clean"; } coq-8.20.0/dev/ci/nix/cross_crypto.nix000066400000000000000000000001341466560755400176230ustar00rootroot00000000000000{}: { configure = "git submodule update --init --recursive"; clean = "make cleanall"; } coq-8.20.0/dev/ci/nix/default.nix000066400000000000000000000111751466560755400165250ustar00rootroot00000000000000{ pkgs ? import ../../nixpkgs.nix {} , branch , wd , project ? "xyz" , withCoq ? true , bn ? "master" }: with pkgs; # Coq from this directory let coq = callPackage ./coq.nix { inherit branch wd; }; in # Third-party libraries, built with this Coq let coqPackages = mkCoqPackages coq; in let mathcomp = coqPackages.mathcomp.overrideAttrs (o: { name = "coq-git-mathcomp-git"; src = fetchTarball https://github.com/math-comp/math-comp/archive/master.tar.gz; }); in let ssreflect = coqPackages.ssreflect.overrideAttrs (o: { inherit (mathcomp) src; }); in let coq-ext-lib = coqPackages.coq-ext-lib.overrideAttrs (o: { src = fetchTarball "https://github.com/coq-community/coq-ext-lib/tarball/master"; }); in let simple-io = (coqPackages.simple-io.override { inherit coq-ext-lib; }) .overrideAttrs (o: { src = fetchTarball "https://github.com/Lysxia/coq-simple-io/tarball/master"; }); in let bignums = coqPackages.bignums.overrideAttrs (o: if bn == "release" then {} else if bn == "master" then { src = fetchTarball https://github.com/coq/bignums/archive/master.tar.gz; } else { src = fetchTarball bn; } ); in let coqprime = coqPackages.coqprime.override { inherit coq bignums; }; in let math-classes = (coqPackages.math-classes.override { inherit coq bignums; }) .overrideAttrs (o: { src = fetchTarball "https://github.com/coq-community/math-classes/archive/master.tar.gz"; }); in let corn = (coqPackages.corn.override { inherit coq bignums math-classes; }) .overrideAttrs (o: { src = fetchTarball "https://github.com/coq-community/corn/archive/master.tar.gz"; }); in let stdpp = coqPackages.stdpp.overrideAttrs (o: { src = fetchTarball "https://gitlab.mpi-sws.org/iris/stdpp/-/archive/master/stdpp-master.tar.bz2"; }); in let iris = (coqPackages.iris.override { inherit coq stdpp; }) .overrideAttrs (o: { src = fetchTarball "https://gitlab.mpi-sws.org/iris/iris/-/archive/master/iris-master.tar.bz2"; propagatedBuildInputs = [ stdpp ]; }); in let unicoq = callPackage ./unicoq { inherit coq; }; in let StructTact = coqPackages.StructTact.overrideAttrs (o: { src = fetchTarball "https://github.com/uwplse/StructTact/tarball/master"; }); in let Cheerios = (coqPackages.Cheerios.override { inherit StructTact; }) .overrideAttrs (o: { src = fetchTarball "https://github.com/uwplse/cheerios/tarball/master"; }); in let Verdi = (coqPackages.Verdi.override { inherit Cheerios ssreflect; }) .overrideAttrs (o: { src = fetchTarball "https://github.com/uwplse/verdi/tarball/master"; }); in let flocq = coqPackages.flocq.overrideAttrs (o: { src = fetchTarball "https://gitlab.inria.fr/flocq/flocq/-/archive/master/flocq-master.tar.gz"; configurePhase = '' autoreconf ${bash}/bin/bash configure --libdir=$out/lib/coq/${coq.coq-version}/user-contrib/Flocq ''; buildPhase = '' ./remake ''; }); in let callPackage = newScope { inherit coq bignums coq-ext-lib coqprime corn iris math-classes mathcomp simple-io ssreflect stdpp unicoq Verdi flocq; }; in # Environments for building CI libraries with this Coq let projects = { bedrock2 = callPackage ./bedrock2.nix {}; bignums = callPackage ./bignums.nix {}; CoLoR = callPackage ./CoLoR.nix {}; CompCert = callPackage ./CompCert.nix {}; coq_dpdgraph = callPackage ./coq_dpdgraph.nix {}; coquelicot = callPackage ./coquelicot.nix {}; Corn = callPackage ./Corn.nix {}; cross_crypto = callPackage ./cross_crypto.nix {}; Elpi = callPackage ./Elpi.nix {}; fiat_crypto = callPackage ./fiat_crypto.nix {}; flocq = callPackage ./flocq.nix {}; formal-topology = callPackage ./formal-topology.nix {}; HoTT = callPackage ./HoTT.nix {}; iris = callPackage ./iris.nix {}; lambda-rust = callPackage ./lambda-rust.nix {}; math_classes = callPackage ./math_classes.nix {}; mathcomp = {}; mtac2 = callPackage ./mtac2.nix {}; oddorder = callPackage ./oddorder.nix {}; quickchick = callPackage ./quickchick.nix {}; simple-io = callPackage ./simple-io.nix {}; verdi-raft = callPackage ./verdi-raft.nix {}; VST = callPackage ./VST.nix {}; }; in if !builtins.hasAttr project projects then throw "Unknown project “${project}”; choose from: ${pkgs.lib.concatStringsSep ", " (builtins.attrNames projects)}." else let prj = projects."${project}"; in let inherit (stdenv.lib) optional optionals; in stdenv.mkDerivation { name = "shell-for-${project}-in-${branch}"; buildInputs = [ python ] ++ optional withCoq coq ++ (prj.buildInputs or []) ++ optionals withCoq (prj.coqBuildInputs or []) ; configure = prj.configure or "true"; make = prj.make or "make"; clean = prj.clean or "make clean"; } coq-8.20.0/dev/ci/nix/fiat_crypto.nix000066400000000000000000000003231466560755400174150ustar00rootroot00000000000000{ ocamlPackages }: { buildInputs = with ocamlPackages; [ ocaml findlib ]; configure = "git submodule update --init --recursive && ulimit -s 32768"; make = "make c-files printlite lite && make -j 1 coq"; } coq-8.20.0/dev/ci/nix/flocq.nix000066400000000000000000000002421466560755400161760ustar00rootroot00000000000000{ autoconf, automake }: { buildInputs = [ autoconf automake ]; configure = "./autogen.sh && ./configure"; make = "./remake"; clean = "./remake clean"; } coq-8.20.0/dev/ci/nix/formal-topology.nix000066400000000000000000000000531466560755400202240ustar00rootroot00000000000000{ corn }: { coqBuildInputs = [ corn ]; } coq-8.20.0/dev/ci/nix/iris.nix000066400000000000000000000000551466560755400160420ustar00rootroot00000000000000{ stdpp }: { coqBuildInputs = [ stdpp ]; } coq-8.20.0/dev/ci/nix/lambda-rust.nix000066400000000000000000000000531466560755400173050ustar00rootroot00000000000000{ iris }: { coqBuildInputs = [ iris ]; } coq-8.20.0/dev/ci/nix/math_classes.nix000066400000000000000000000001221466560755400175350ustar00rootroot00000000000000{ bignums }: { coqBuildInputs = [ bignums ]; configure = "./configure.sh"; } coq-8.20.0/dev/ci/nix/mtac2.nix000066400000000000000000000002261466560755400161020ustar00rootroot00000000000000{ coq, unicoq }: { buildInputs = with coq.ocamlPackages; [ ocaml findlib camlp5 ]; coqBuildInputs = [ unicoq ]; configure = "./configure.sh"; } coq-8.20.0/dev/ci/nix/oddorder.nix000066400000000000000000000000631466560755400166750ustar00rootroot00000000000000{ mathcomp }: { coqBuildInputs = [ mathcomp ]; } coq-8.20.0/dev/ci/nix/quickchick.nix000066400000000000000000000002541466560755400172130ustar00rootroot00000000000000{ ocamlPackages, ssreflect, coq-ext-lib, simple-io }: { buildInputs = with ocamlPackages; [ ocaml findlib ocamlbuild num ]; coqBuildInputs = [ ssreflect simple-io ]; } coq-8.20.0/dev/ci/nix/shell000077500000000000000000000007271466560755400154170ustar00rootroot00000000000000#!/usr/bin/env sh ## This file should be run from the root of the Coq source tree BRANCH=$(git rev-parse --abbrev-ref HEAD) echo "Branch: $BRANCH in $PWD" if [ "$#" -ne 1 ]; then PROJECT="" else PROJECT="--argstr project $1" fi if [ "$BN" ]; then BN="--argstr bn ${BN}" else BN="" fi if [ "$NOCOQ" ]; then NOCOQ="--arg withCoq false" else NOCOQ="" fi nix-shell ./dev/ci/nix/ --show-trace --argstr wd $PWD --argstr branch $BRANCH $PROJECT $BN $NOCOQ coq-8.20.0/dev/ci/nix/simple-io.nix000066400000000000000000000002561466560755400167750ustar00rootroot00000000000000{ ocamlPackages, ssreflect, coq-ext-lib, simple-io }: { buildInputs = with ocamlPackages; [ ocaml findlib ocamlbuild num ]; coqBuildInputs = [ ssreflect coq-ext-lib ]; } coq-8.20.0/dev/ci/nix/unicoq/000077500000000000000000000000001466560755400156525ustar00rootroot00000000000000coq-8.20.0/dev/ci/nix/unicoq/default.nix000066400000000000000000000013631466560755400200210ustar00rootroot00000000000000{ stdenv, writeText, coq }: let META = writeText "META" '' archive(native) = "unicoq.cmxa" plugin(native) = "unicoq.cmxs" ''; in stdenv.mkDerivation { name = "coq${coq.coq-version}-unicoq-0.0-git"; src = fetchTarball https://github.com/unicoq/unicoq/archive/master.tar.gz; patches = [ ./unicoq-num.patch ]; buildInputs = [ coq ] ++ (with coq.ocamlPackages; [ ocaml findlib camlp5 num ]); configurePhase = "coq_makefile -f Make -o Makefile"; installFlags = [ "COQLIB=$(out)/lib/coq/${coq.coq-version}/" ]; postInstall = '' cp ${META} META install -d $OCAMLFIND_DESTDIR ln -s $out/lib/coq/${coq.coq-version}/user-contrib/Unicoq $OCAMLFIND_DESTDIR/ install -m 0644 META src/unicoq.a $OCAMLFIND_DESTDIR/Unicoq ''; } coq-8.20.0/dev/ci/nix/unicoq/unicoq-num.patch000066400000000000000000000005361466560755400207720ustar00rootroot00000000000000commit f29bc64ee3d8b36758d17e1f5d50812e0c93063b Author: Vincent Laporte Date: Thu Nov 29 08:59:22 2018 +0000 Make explicit dependency to num diff --git a/Makefile.local b/Makefile.local new file mode 100644 index 0000000..88be365 --- /dev/null +++ b/Makefile.local @@ -0,0 +1 @@ +CAMLPKGS += -package num coq-8.20.0/dev/ci/nix/verdi-raft.nix000066400000000000000000000000551466560755400171370ustar00rootroot00000000000000{ Verdi }: { coqBuildInputs = [ Verdi ]; } coq-8.20.0/dev/ci/platform/000077500000000000000000000000001466560755400154025ustar00rootroot00000000000000coq-8.20.0/dev/ci/platform/coq-pf-01-sysinfo.bat000066400000000000000000000003051466560755400211630ustar00rootroot00000000000000REM Print some debug information ECHO "Root folders" DIR C:\ ECHO "Powershell version" powershell -Command "Get-Host" ECHO "Git installation of Mingw" DIR "C:\Program Files\Git\mingw64\bin\*.exe" coq-8.20.0/dev/ci/platform/coq-pf-02-download.bat000066400000000000000000000002741466560755400213060ustar00rootroot00000000000000REM Download platform script SET PATH=%PATH%;C:\Program Files\7-Zip;C:\Program Files\Git\mingw64\bin ECHO "Downloading %PLATFORM%" curl -L -o platform.zip "%PLATFORM%" 7z x platform.zip coq-8.20.0/dev/ci/platform/coq-pf-03-build.bat000066400000000000000000000020031466560755400205670ustar00rootroot00000000000000REM Build the platform SET CYGROOT=C:\ci\cygwin%ARCH% SET CYGCACHE=C:\ci\cache\cgwin REM Try CYGWIN_QUIET, but still this stage is super verbose SET CYGWIN_QUIET=y SET COQREGTESTING=y REM XXX: make this a variable with the branch name cd platform-* call coq_platform_make_windows.bat ^ -arch=%ARCH% ^ -pick=dev ^ -destcyg=%CYGROOT% ^ -cygcache=%CYGCACHE% ^ -extent=i ^ -parallel=p ^ -jobs=2 ^ -switch=d ^ -set-switch=y ^ -override-dev-pkg="coq-core=%GITHUB_SERVER_URL%/%GITHUB_REPOSITORY%/archive/%GITHUB_SHA%.tar.gz" ^ -override-dev-pkg="coq-stdlib=%GITHUB_SERVER_URL%/%GITHUB_REPOSITORY%/archive/%GITHUB_SHA%.tar.gz" ^ -override-dev-pkg="coq=%GITHUB_SERVER_URL%/%GITHUB_REPOSITORY%/archive/%GITHUB_SHA%.tar.gz" ^ -override-dev-pkg="coqide-server=%GITHUB_SERVER_URL%/%GITHUB_REPOSITORY%/archive/%GITHUB_SHA%.tar.gz" ^ -override-dev-pkg="coqide=%GITHUB_SERVER_URL%/%GITHUB_REPOSITORY%/archive/%GITHUB_SHA%.tar.gz" ^ || GOTO ErrorExit GOTO :EOF :ErrorExit ECHO ERROR %0 failed EXIT /b 1 coq-8.20.0/dev/ci/platform/coq-pf-04-installer.bat000066400000000000000000000015751466560755400215030ustar00rootroot00000000000000REM build the installer artifact REM XXX: make this a variable with the branch name cd platform-* REM XXX: This is redundant with the previous scripts, we could centralize it REM In fact, the variable is only needed to access bash SET CYGROOT=C:\ci\cygwin%ARCH% SET BASH=%CYGROOT%\bin\bash MKDIR %GITHUB_WORKSPACE%\artifacts %BASH% --login -c "pwd && ls -la && cd /platform && windows/create_installer_windows.sh" || GOTO ErrorExit REM Output is in cygwin home; in general the script has a bit of a REM mess in terms of using the GITHUB_WORKSPACE sometimes, and the REM CYGWIN home some others. I use the path here directly as to avoid REM issues with quoting, which in the previous script required some REM really obscure code. COPY /v /b %CYGROOT%\platform\windows_installer\*.exe %GITHUB_WORKSPACE%\artifacts || GOTO ErrorExit GOTO :EOF :ErrorExit ECHO ERROR %0 failed EXIT /b 1 coq-8.20.0/dev/ci/user-overlays/000077500000000000000000000000001466560755400163765ustar00rootroot00000000000000coq-8.20.0/dev/ci/user-overlays/12324-proux01-enable-notation.sh000066400000000000000000000001051466560755400237720ustar00rootroot00000000000000overlay serapi https://github.com/proux01/coq-serapi coq_12324 12324 coq-8.20.0/dev/ci/user-overlays/13445-herbelin-master+reworking-assumptions.sh000066400000000000000000000006131466560755400270570ustar00rootroot00000000000000overlay coq_lsp https://github.com/herbelin/coq-lsp main+adapt-13445-LetContext-definition-kind 13445 master+reworking-assumptions overlay smtcoq https://github.com/herbelin/smtcoq coq-master+adapt-13445-declare_variable-api 13445 master+reworking-assumptions overlay elpi https://github.com/herbelin/coq-elpi coq-master+adapt-coq-pr13445-declare_variable-api 13445 master+reworking-assumptions coq-8.20.0/dev/ci/user-overlays/17393-ejgallego-skip_vofile.sh000066400000000000000000000002131466560755400236530ustar00rootroot00000000000000overlay coq_lsp https://github.com/ejgallego/coq-lsp skip_vofile 17393 overlay vscoq https://github.com/ejgallego/vscoq skip_vofile 17393 coq-8.20.0/dev/ci/user-overlays/17674-ppedrot-vm-split-bytecode.sh000066400000000000000000000001151466560755400244370ustar00rootroot00000000000000overlay serapi https://github.com/ppedrot/coq-serapi vm-split-bytecode 17674 coq-8.20.0/dev/ci/user-overlays/18038-Yann-Leray-rewrite-rules.sh000066400000000000000000000010441466560755400242000ustar00rootroot00000000000000overlay elpi https://github.com/Yann-Leray/coq-elpi rewrite-rules 18038 overlay coq_dpdgraph https://github.com/Yann-Leray/coq-dpdgraph rewrite-rules 18038 overlay coqhammer https://github.com/Yann-Leray/coqhammer rewrite-rules 18038 overlay metacoq https://github.com/Yann-Leray/metacoq rewrite-rules-adapt 18038 overlay mtac2 https://github.com/Yann-Leray/Mtac2 rewrite-rules 18038 overlay serapi https://github.com/Yann-Leray/coq-serapi rewrite-rules 18038 overlay tactician https://github.com/Yann-Leray/coq-tactician rewrite-rules 18038 coq-8.20.0/dev/ci/user-overlays/18094-JasonGross-stratfix.sh000066400000000000000000000002251466560755400233460ustar00rootroot00000000000000overlay serapi https://github.com/JasonGross/coq-serapi stratfix 18094 overlay tactician https://github.com/JasonGross/coq-tactician stratfix 18094 coq-8.20.0/dev/ci/user-overlays/18143-SkySkimmer-print-relevance.sh000066400000000000000000000005011466560755400245760ustar00rootroot00000000000000overlay elpi https://github.com/SkySkimmer/coq-elpi print-relevance 18143 overlay quickchick https://github.com/SkySkimmer/QuickChick print-relevance 18143 overlay serapi https://github.com/SkySkimmer/coq-serapi print-relevance 18143 overlay tactician https://github.com/SkySkimmer/coq-tactician print-relevance 18143 coq-8.20.0/dev/ci/user-overlays/18224-proux01-ssr_17876.sh000066400000000000000000000003171466560755400223100ustar00rootroot00000000000000overlay equations https://github.com/proux01/Coq-Equations coq_18224 18224 overlay metacoq https://github.com/proux01/metacoq coq_18224 18224 overlay elpi https://github.com/proux01/coq-elpi coq_18224 18224 coq-8.20.0/dev/ci/user-overlays/18229-herbelin-master+guard-merging-rec-nested.sh000066400000000000000000000001761466560755400272550ustar00rootroot00000000000000overlay serapi https://github.com/herbelin/coq-serapi main+adapt-coq-pr18129-nested-ind 18229 master+guard-merging-rec-nested coq-8.20.0/dev/ci/user-overlays/18236-Tragicus-coercion-hook.sh000066400000000000000000000001101466560755400237210ustar00rootroot00000000000000overlay elpi https://github.com/Tragicus/coq-elpi master-coercion 18236 coq-8.20.0/dev/ci/user-overlays/18248-herbelin-master-extend-deprecation.sh000066400000000000000000000001011466560755400262470ustar00rootroot00000000000000overlay elpi https://github.com/proux01/coq-elpi coq_18248 18248 coq-8.20.0/dev/ci/user-overlays/18253-herbelin-master+useless-poly-flag-coercion.sh000066400000000000000000000004221466560755400276370ustar00rootroot00000000000000overlay mtac2 https://github.com/herbelin/Mtac2 master+adapt-coq-pr18253-no-poly-for-coercion 18253 master+useless-poly-flag-coercion overlay elpi https://github.com/herbelin/coq-elpi coq-master+adapt-coq-pr18253-no-poly-for-coercion 18253 master+useless-poly-flag-coercion coq-8.20.0/dev/ci/user-overlays/18327-rlepigre-brfix-18281.sh000066400000000000000000000010331466560755400230130ustar00rootroot00000000000000overlay elpi https://github.com/rlepigre/coq-elpi br/fix-18281 18327 overlay equations https://github.com/rlepigre/Coq-Equations br/fix-18281 18327 overlay lean_importer https://github.com/rlepigre/coq-lean-import br/fix-18281 18327 overlay mtac2 https://github.com/rlepigre/Mtac2 br/fix-18281 18327 overlay serapi https://github.com/rlepigre/coq-serapi br/fix-18281 18327 overlay tactician https://github.com/rlepigre/coq-tactician br/fix-18281 18327 overlay waterproof https://github.com/rlepigre/coq-waterproof br/fix-18281 18327 coq-8.20.0/dev/ci/user-overlays/18331-SkySkimmer-sort-poly-ind.sh000066400000000000000000000004711466560755400242250ustar00rootroot00000000000000overlay elpi https://github.com/SkySkimmer/coq-elpi sort-poly-ind 18331 overlay lean_importer https://github.com/SkySkimmer/coq-lean-import sort-poly-ind 18331 overlay metacoq https://github.com/SkySkimmer/metacoq sort-poly-ind 18331 overlay serapi https://github.com/SkySkimmer/coq-serapi sort-poly-ind 18331 coq-8.20.0/dev/ci/user-overlays/18336-SkySkimmer-micromega-split-library.sh000066400000000000000000000001221466560755400262410ustar00rootroot00000000000000overlay smtcoq https://github.com/SkySkimmer/smtcoq micromega-split-library 18336 coq-8.20.0/dev/ci/user-overlays/18345-ppedrot-harden-vernacextend-naming.sh000066400000000000000000000002511466560755400262610ustar00rootroot00000000000000overlay elpi https://github.com/ppedrot/coq-elpi harden-vernacextend-naming 18345 overlay serapi https://github.com/ppedrot/coq-serapi harden-vernacextend-naming 18345 coq-8.20.0/dev/ci/user-overlays/18397-herbelin-master+small-cleanup-declare_variable.sh000066400000000000000000000006521466560755400305020ustar00rootroot00000000000000overlay smtcoq https://github.com/herbelin/smtcoq coq-master+adapt-18397-declare_variable_api 18397 master+small-cleanup-declare_variable overlay metacoq https://github.com/herbelin/template-coq main+adapt-coq-pr18397-declare_variable-api 18397 master+small-cleanup-declare_variable overlay elpi https://github.com/proux01/coq-elpi coq-master+adapt-coq-pr18397-declare_variable-api 18397 master+small-cleanup-declare_variable coq-8.20.0/dev/ci/user-overlays/18422-SkySkimmer-indirect.sh000066400000000000000000000011051466560755400233020ustar00rootroot00000000000000overlay equations https://github.com/SkySkimmer/Coq-Equations indirect 18422 overlay paramcoq https://github.com/SkySkimmer/paramcoq indirect 18422 overlay simple_io https://github.com/SkySkimmer/coq-simple-io indirect 18422 overlay quickchick https://github.com/SkySkimmer/QuickChick indirect 18422 overlay vscoq https://github.com/SkySkimmer/vscoq indirect 18422 overlay serapi https://github.com/SkySkimmer/coq-serapi indirect 18422 overlay coq_lsp https://github.com/SkySkimmer/coq-lsp indirect 18422 overlay metacoq https://github.com/SkySkimmer/metacoq indirect 18422 coq-8.20.0/dev/ci/user-overlays/18437-gares-bump-elpi.sh000066400000000000000000000002241466560755400224050ustar00rootroot00000000000000overlay elpi https://github.com/LPCIC/coq-elpi 8.19 18437 overlay hierarchy_builder https://github.com/math-comp/hierarchy-builder coq-elpi-2 18437 coq-8.20.0/dev/ci/user-overlays/18443-herbelin-master+wish18097-print-about-see-through-aliases.sh000066400000000000000000000002261466560755400321640ustar00rootroot00000000000000overlay coq_lsp https://github.com/herbelin/coq-lsp main+adapt-18443-print_abbreviation-sigma 18443 master+wish18097-print-about-see-through-aliases coq-8.20.0/dev/ci/user-overlays/18445-herbelin-master+more-robust-notations-with-max-impargs.sh000066400000000000000000000005641466560755400321650ustar00rootroot00000000000000overlay category_theory https://github.com/herbelin/category-theory master+adapt-coq-pr18445-fix-applied-notations-multiple-implicit 18445 master+more-robust-notations-with-max-impargs overlay fiat_crypto_legacy https://github.com/herbelin/fiat-crypto sp2019latest+adapt-coq-pr18445-notation-multiple-implicit-arguments 18445 master+more-robust-notations-with-max-impargs coq-8.20.0/dev/ci/user-overlays/18528-SkySkimmer-ltac2-uncommon.sh000066400000000000000000000002411466560755400243460ustar00rootroot00000000000000overlay tactician https://github.com/SkySkimmer/coq-tactician ltac2-uncommon 18528 overlay serapi https://github.com/SkySkimmer/coq-serapi ltac2-uncommon 18528 coq-8.20.0/dev/ci/user-overlays/18529-SkySkimmer-dyn-no-anon.sh000066400000000000000000000003501466560755400236470ustar00rootroot00000000000000overlay tactician https://github.com/SkySkimmer/coq-tactician dyn-no-anon 18529 overlay vscoq https://github.com/SkySkimmer/vscoq dyn-no-anon 18529 overlay waterproof https://github.com/SkySkimmer/coq-waterproof dyn-no-anon 18529 coq-8.20.0/dev/ci/user-overlays/18546-rlepigre-brevaluable_refactoring.sh000066400000000000000000000007031466560755400260750ustar00rootroot00000000000000overlay elpi https://github.com/rlepigre/coq-elpi br/evaluable_refactoring 18546 overlay equations https://github.com/rlepigre/Coq-Equations br/evaluable_refactoring 18546 overlay lean_importer https://github.com/rlepigre/coq-lean-import br/evaluable_refactoring 18546 overlay serapi https://github.com/rlepigre/coq-serapi br/evaluable_refactoring 18546 overlay waterproof https://github.com/rlepigre/coq-waterproof br/evaluable_refactoring 18546 coq-8.20.0/dev/ci/user-overlays/18603-SkySkimmer-temrops-use-evd.sh000066400000000000000000000002431466560755400245430ustar00rootroot00000000000000overlay equations https://github.com/SkySkimmer/Coq-Equations temrops-use-evd 18603 overlay paramcoq https://github.com/SkySkimmer/paramcoq temrops-use-evd 18603 coq-8.20.0/dev/ci/user-overlays/18624-SkySkimmer-split-tac2ffi.sh000066400000000000000000000003761466560755400241650ustar00rootroot00000000000000overlay ltac2_compiler https://github.com/SkySkimmer/coq-ltac2-compiler split-tac2ffi 18624 overlay rewriter https://github.com/SkySkimmer/rewriter split-tac2ffi 18624 overlay waterproof https://github.com/SkySkimmer/coq-waterproof split-tac2ffi 18624 coq-8.20.0/dev/ci/user-overlays/18652-ppedrot-prettyp-explicit-env.sh000066400000000000000000000001121466560755400251760ustar00rootroot00000000000000overlay vscoq https://github.com/ppedrot/vscoq prettyp-explicit-env 18652 coq-8.20.0/dev/ci/user-overlays/18664-ppedrot-cleanup-hint-path-derivate.sh000066400000000000000000000002511466560755400262130ustar00rootroot00000000000000overlay elpi https://github.com/ppedrot/coq-elpi cleanup-hint-path-derivate 18664 overlay serapi https://github.com/ppedrot/coq-serapi cleanup-hint-path-derivate 18664 coq-8.20.0/dev/ci/user-overlays/18666-ppedrot-patternops-rm-canonical.sh000066400000000000000000000002511466560755400256330ustar00rootroot00000000000000overlay elpi https://github.com/ppedrot/coq-elpi patternops-rm-canonical 18666 overlay tactician https://github.com/ppedrot/coq-tactician patternops-rm-canonical 18666 coq-8.20.0/dev/ci/user-overlays/18707-SkySkimmer-vernac-focus.sh000066400000000000000000000001051466560755400241010ustar00rootroot00000000000000overlay mtac2 https://github.com/SkySkimmer/Mtac2 vernac-focus 18707 coq-8.20.0/dev/ci/user-overlays/18719-SkySkimmer-less-ltac-plugin.sh000066400000000000000000000001171466560755400246770ustar00rootroot00000000000000overlay serapi https://github.com/SkySkimmer/coq-serapi less-ltac-plugin 18719 coq-8.20.0/dev/ci/user-overlays/18743-herbelin-master+more-flexible-theorem-with.sh000066400000000000000000000002261466560755400276370ustar00rootroot00000000000000overlay equations https://github.com/herbelin/Coq-Equations main+adapt+coq-pr18743-more-flexible-theorem-with 18743 master+more-flexible-theorem-with coq-8.20.0/dev/ci/user-overlays/18771-afdw-drop.sh000066400000000000000000000001701466560755400213000ustar00rootroot00000000000000overlay serapi https://github.com/afdw/coq-serapi drop 18771 overlay coq_lsp https://github.com/afdw/coq-lsp drop 18771 coq-8.20.0/dev/ci/user-overlays/18795-herbelin-master+uniform-API-declare.ml.sh000066400000000000000000000004331466560755400265740ustar00rootroot00000000000000overlay metacoq https://github.com/herbelin/template-coq main+adapt-coq-pr18795-more-uniform-declare.ml 18795 master+uniform-API-declare.ml overlay equations https://github.com/herbelin/Coq-Equations main+adapt-coq-pr18795-more-uniform-declare.ml 18795 master+uniform-API-declare.ml coq-8.20.0/dev/ci/user-overlays/18833-SkySkimmer-indrec-no-family.sh000066400000000000000000000001331466560755400246440ustar00rootroot00000000000000overlay lean_importer https://github.com/SkySkimmer/coq-lean-import indrec-no-family 18833 coq-8.20.0/dev/ci/user-overlays/18852-SkySkimmer-redexpr-clean.sh000066400000000000000000000004661466560755400242520ustar00rootroot00000000000000overlay metacoq https://github.com/SkySkimmer/metacoq redexpr-clean 18852 overlay elpi https://github.com/SkySkimmer/coq-elpi redexpr-clean 18852 overlay serapi https://github.com/SkySkimmer/coq-serapi redexpr-clean 18852 overlay tactician https://github.com/coq-tactician/coq-tactician 18852-overlay 18852 coq-8.20.0/dev/ci/user-overlays/18864-SkySkimmer-check-guard-evars.sh000066400000000000000000000001261466560755400250100ustar00rootroot00000000000000overlay equations https://github.com/SkySkimmer/Coq-Equations check-guard-evars 18864 coq-8.20.0/dev/ci/user-overlays/18867-SkySkimmer-non-prop-template.sh000066400000000000000000000002331466560755400251000ustar00rootroot00000000000000overlay metacoq https://github.com/SkySkimmer/metacoq non-prop-template 18867 overlay elpi https://github.com/SkySkimmer/coq-elpi non-prop-template 18867 coq-8.20.0/dev/ci/user-overlays/18881-SkySkimmer-program-ref-by-tactic.sh000066400000000000000000000001161466560755400256110ustar00rootroot00000000000000overlay mtac2 https://github.com/SkySkimmer/Mtac2 program-ref-by-tactic 18881 coq-8.20.0/dev/ci/user-overlays/18890-ejgallego-no_using_cinfo.sh000066400000000000000000000002171466560755400243470ustar00rootroot00000000000000overlay elpi https://github.com/ejgallego/coq-elpi no_using_cinfo 18890 overlay vscoq https://github.com/ejgallego/vscoq no_using_cinfo 18890 coq-8.20.0/dev/ci/user-overlays/18911-ppedrot-econstr-einstance-api.sh000066400000000000000000000001271466560755400252610ustar00rootroot00000000000000overlay equations https://github.com/ppedrot/Coq-Equations econstr-einstance-api 18911 coq-8.20.0/dev/ci/user-overlays/18921-herbelin-master+fix11030-bugs-program-pattern-matching.sh000066400000000000000000000002321466560755400315070ustar00rootroot00000000000000overlay metacoq https://github.com/herbelin/template-coq main+adapt-coq-pr18921-program-return-clause 18921 master+fix11030-bugs-program-pattern-matching coq-8.20.0/dev/ci/user-overlays/18935-ppedrot-econstr-inductiveops-api.sh000066400000000000000000000004201466560755400260260ustar00rootroot00000000000000overlay equations https://github.com/ppedrot/Coq-Equations econstr-inductiveops-api 18935 overlay paramcoq https://github.com/ppedrot/paramcoq econstr-inductiveops-api 18935 overlay lean_importer https://github.com/ppedrot/coq-lean-import econstr-inductiveops-api 18935 coq-8.20.0/dev/ci/user-overlays/18938-SkySkimmer-erelevance.sh000066400000000000000000000025261466560755400236360ustar00rootroot00000000000000overlay aac_tactics https://github.com/SkySkimmer/aac-tactics erelevance 18938 overlay atbr https://github.com/SkySkimmer/atbr erelevance 18938 overlay coinduction https://github.com/SkySkimmer/coinduction erelevance 18938 overlay coqhammer https://github.com/SkySkimmer/coqhammer erelevance 18938 overlay elpi https://github.com/SkySkimmer/coq-elpi erelevance 18938 overlay equations https://github.com/SkySkimmer/Coq-Equations erelevance 18938 overlay lean_importer https://github.com/SkySkimmer/coq-lean-import erelevance 18938 overlay mtac2 https://github.com/SkySkimmer/Mtac2 erelevance 18938 overlay paramcoq https://github.com/SkySkimmer/paramcoq erelevance 18938 overlay serapi https://github.com/SkySkimmer/coq-serapi erelevance 18938 overlay smtcoq https://github.com/SkySkimmer/smtcoq erelevance 18938 overlay stalmarck https://github.com/SkySkimmer/stalmarck erelevance 18938 overlay tactician https://github.com/SkySkimmer/coq-tactician erelevance 18938 overlay waterproof https://github.com/SkySkimmer/coq-waterproof erelevance 18938 overlay itauto https://gitlab.inria.fr/ggilbert/itauto erelevance 18938 overlay unicoq https://github.com/SkySkimmer/unicoq erelevance 18938 overlay metacoq https://github.com/SkySkimmer/metacoq erelevance 18938 overlay relation_algebra https://github.com/SkySkimmer/relation-algebra erelevance 18938 coq-8.20.0/dev/ci/user-overlays/18973-rlepigre-brprim-string.sh000066400000000000000000000013111466560755400240250ustar00rootroot00000000000000overlay coqhammer https://github.com/rlepigre/coqhammer br/prim-string 18973 overlay elpi https://github.com/rlepigre/coq-elpi br/prim-string 18973 overlay tactician https://github.com/rlepigre/coq-tactician br/prim-string 18973 overlay unicoq https://github.com/rlepigre/unicoq br/prim-string 18973 overlay coq_lsp https://github.com/rlepigre/coq-lsp br/prim-string 18973 overlay quickchick https://github.com/rlepigre/QuickChick br/prim-string 18973 overlay vscoq https://github.com/rlepigre/vscoq br/prim-string 18973 overlay metacoq https://github.com/rlepigre/metacoq br/prim-string 18973 overlay coq_library_undecidability https://github.com/rlepigre/coq-library-undecidability br/prim-string 18973 coq-8.20.0/dev/ci/user-overlays/18981-SkySkimmer-sort-expr-anon-univ.sh000066400000000000000000000004061466560755400253710ustar00rootroot00000000000000overlay autosubst_ocaml https://github.com/SkySkimmer/autosubst-ocaml sort-expr-anon-univ 18981 overlay elpi https://github.com/SkySkimmer/coq-elpi sort-expr-anon-univ 18981 overlay quickchick https://github.com/SkySkimmer/QuickChick sort-expr-anon-univ 18981 coq-8.20.0/dev/ci/user-overlays/18989-SkySkimmer-warn-auto-lower.sh000066400000000000000000000001121466560755400245630ustar00rootroot00000000000000overlay elpi https://github.com/SkySkimmer/coq-elpi warn-auto-lower 18989 coq-8.20.0/dev/ci/user-overlays/18996-ppedrot-case-info-rm-tags.sh000066400000000000000000000002271466560755400243200ustar00rootroot00000000000000overlay paramcoq https://github.com/ppedrot/paramcoq case-info-rm-tags 18996 overlay elpi https://github.com/ppedrot/coq-elpi case-info-rm-tags 18996 coq-8.20.0/dev/ci/user-overlays/19073-SkySkimmer-abstract-sort-poly.sh000066400000000000000000000001151466560755400252550ustar00rootroot00000000000000overlay elpi https://github.com/SkySkimmer/coq-elpi abstract-sort-poly 19073 coq-8.20.0/dev/ci/user-overlays/19078-SkySkimmer-csig-umap.sh000066400000000000000000000001101466560755400233710ustar00rootroot00000000000000overlay serapi https://github.com/SkySkimmer/coq-serapi csig-umap 19078 coq-8.20.0/dev/ci/user-overlays/19120-ppedrot-conversion-no-inner-exception-api.sh000066400000000000000000000001311466560755400275250ustar00rootroot00000000000000overlay smtcoq https://github.com/ppedrot/smtcoq conversion-no-inner-exception-api 19120 coq-8.20.0/dev/ci/user-overlays/19124-ejgallego-export_locate_result.sh000066400000000000000000000001301466560755400255770ustar00rootroot00000000000000overlay tactician https://github.com/ejgallego/coq-tactician export_locate_result 19124 coq-8.20.0/dev/ci/user-overlays/19135-ejgallego-intern_error_handling.sh000066400000000000000000000001101466560755400257050ustar00rootroot00000000000000overlay coq_lsp https://github.com/ejgallego/coq-lsp error_intern 19135 coq-8.20.0/dev/ci/user-overlays/19187-ejgallego-vernacstate_remove_pcoq.sh000066400000000000000000000003711466560755400262670ustar00rootroot00000000000000overlay coq_lsp https://github.com/ejgallego/coq-lsp vernacstate_remove_pcoq 19187 overlay serapi https://github.com/ejgallego/coq-serapi vernacstate_remove_pcoq 19187 overlay vscoq https://github.com/ejgallego/vscoq vernacstate_remove_pcoq 19187 coq-8.20.0/dev/ci/user-overlays/19193-ejgallego-vernacstate_remove_parsing.sh000066400000000000000000000004021466560755400267600ustar00rootroot00000000000000overlay coq_lsp https://github.com/ejgallego/coq-lsp vernacstate_remove_parsing 19193 overlay serapi https://github.com/ejgallego/coq-serapi vernacstate_remove_parsing 19193 overlay vscoq https://github.com/ejgallego/vscoq vernacstate_remove_parsing 19193 coq-8.20.0/dev/ci/user-overlays/README.md000066400000000000000000000070361466560755400176630ustar00rootroot00000000000000# Add overlays for your pull requests in this directory _Overlays_ let you test pull requests that break the base version of external projects by applying PRs of the external project during CI testing (1 PR per broken external project). Once Coq CI's tests of the external projects pass, the Coq PR can be merged, then the assignee must ask the external projects to merge their PRs (for example by commenting in the external PRs). External projects are then expected to merge their PRs promptly. An overlay file specifies the external PRs that should be applied during CI. A single file can cover multiple external projects. Create your overlay file in the `dev/ci/user-overlays` directory. The name of the overlay file should start with a five-digit pull request number, followed by a dash, anything (by convention, your GitHub nickname and the branch name), then an `.sh` extension (`[0-9]{5}-[a-zA-Z0-9-_]+.sh`). The file must contain a call to the `overlay` function for each affected external project: ``` overlay [] ``` Each call creates an overlay for `project` using a given `giturl` and `ref` which is active for `prnumber` or `prbranch` (`prbranch` defaults to `ref`). For example, an overlay for the project `elpi` that uses the branch `noinstance` from the fork of `SkySkimmer` and is active for pull request `13128`: ``` overlay elpi https://github.com/SkySkimmer/coq-elpi noinstance 13128 ``` The github URL and base branch name for each external project are listed in [`ci-basic-overlay.sh`](../ci-basic-overlay.sh). For example, the entry for `elpi` is ``` project elpi "https://github.com/LPCIC/coq-elpi" "coq-master" ``` But substitute the name of your fork into the URL, e.g. `SkySkimmer/coq-elpi` rather than `LPCIC/coq-elpi`. Use `#` to mark any comments. If the branch name in the external project differs from the Coq branch name, include the external branch name as `[prbranch]` to apply it when you run the test suite locally, e.g. `make ci-elpi`. Overlay files can be created automatically using the script [`create_overlays.sh`](../../tools/create_overlays.sh). ### Branching conventions We suggest you use the convention of identical branch names for the Coq branch and the CI project branch used in the overlay. For example, if your Coq PR is in your branch `more_efficient_tc` and breaks `ltac2`, we suggest you create an `ltac2` overlay with a branch named `more_efficient_tc`. ### Typical workflow - Observe that your changes breaks some external projects in CI - Compile your PR. - For each broken project, run `make `, e.g. `make ci-elpi`, which checks out, builds and runs the project in the `_build_ci/` directory. - Make necessary changes, then rerun the script to verify they work. - From the `` subdirectory, commit your changes to a new branch, based on the base branch name listed in `ci-basic-overlay.sh`, for example `coq-master` for elpi. - If necessary, fork the external project from the project's github page. (Only needs to be done once, ever.) - Push to the external project and create a new PR. Make sure you pick the correct base branch in the github GUI for the comparison (e.g. `coq-master` for elpi). - Create the overlay file, add to your Coq PR, push the updated version and verify that the external projects now pass. - When your PR is merged, the assignee notifies the maintainers of the external project to merge the changes you submitted. This should happen promptly; the external project's CI will fail until the change is merged. - Beer. coq-8.20.0/dev/core_dune.dbg000066400000000000000000000011771466560755400156120ustar00rootroot00000000000000load_printer threads.cma load_printer str.cma load_printer zarith.cma load_printer config.cma load_printer clib.cma load_printer boot.cma load_printer perf.cma load_printer lib.cma load_printer gramlib.cma load_printer coqrun.cma load_printer kernel.cma load_printer library.cma load_printer engine.cma load_printer pretyping.cma load_printer interp.cma load_printer proofs.cma load_printer parsing.cma load_printer printing.cma load_printer tactics.cma load_printer findlib.cma load_printer findlib_dynload.cma load_printer vernac.cma load_printer sysinit.cma load_printer coqworkmgrlib.cma load_printer stm.cma load_printer toplevel.cma coq-8.20.0/dev/db000066400000000000000000000014571466560755400135020ustar00rootroot00000000000000load_printer threads.cma load_printer str.cma load_printer zarith.cma load_printer memprof_limits.cma load_printer findlib.cma load_printer findlib_dynload.cma load_printer config.cma load_printer boot.cma load_printer clib.cma load_printer coqperf.cma load_printer lib.cma load_printer gramlib.cma load_printer coqrun.cma load_printer kernel.cma load_printer library.cma load_printer engine.cma load_printer pretyping.cma load_printer interp.cma load_printer proofs.cma load_printer parsing.cma load_printer printing.cma load_printer tactics.cma load_printer vernac.cma load_printer sysinit.cma load_printer coqworkmgrlib.cma load_printer stm.cma load_printer toplevel.cma load_printer ltac_plugin.cma load_printer ltac2_plugin.cma load_printer dev.cma load_printer debugger_support.cma source top_printers.dbg coq-8.20.0/dev/debugger_support.ml000066400000000000000000000024221466560755400170750ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* Prod (x, a, type_of (push_rel (LocalAssum (x,a)) env) b)`. Otherwise see `context.mli` for a few combinators on the `binder_annot` type. When making `Relevant` annotations you can use some convenience functions from `Context` (eg `annotR x = make_annot x Relevant`), also `mkArrowR` from `Constr`/`EConstr` which has the signature of the old `mkArrow`. Relevance can be inferred from a well-typed term using functions in `Retypeops` (for `Constr`) and `Retyping` (for `EConstr`). For `x` a term, note the difference between its relevance as a term (is `x : (_ : SProp)`) and as a type (is `x : SProp`), there are functions for both kinds. ## Case inversion Inductives in SProp with 1 constructor which has no arguments have a special reduction rule for matches. To implement it the Case constructor is extended with a `case_invert` field. If you are constructing a match on a normal (non-special reduction) inductive you must fill the new field with `NoInvert`. Otherwise you must fill it with `CaseInvert {univs ; args}` where `univs` is the universe instance of the type you are matching and `args` the parameters and indices. For instance, in ~~~coq Inductive seq {A} (a:A) : A -> SProp := srefl : seq a a. Definition seq_to_eq {A x y} (e:seq x y) : x = y :> A := match e with srefl => eq_refl end. ~~~ the `match e with ...` has `CaseInvert {univs = Instance.empty; args = [|A x y|]}`. (empty instance since we defined a universe monomorphic `seq`). In practice, you should use `Inductiveops.make_case_or_project` which will take care of this for you (and also handles primitive records correctly etc). coq-8.20.0/dev/doc/archive/000077500000000000000000000000001466560755400153515ustar00rootroot00000000000000coq-8.20.0/dev/doc/archive/COMPATIBILITY000066400000000000000000000010251466560755400173030ustar00rootroot00000000000000Note: this file isn't used anymore. Incompatibilities are documented as part of CHANGES. Incompatibilities beyond 8.4... - Syntax: "x -> y" has now lower priority than "<->" "A -> B <-> C" is now "A -> (B <-> C)" - Tactics: tauto and intuition no longer accidentally destruct binary connectives or records other than and, or, prod, sum, iff. In most of cases, dtauto or dintuition, though stronger than 8.3 tauto and 8.3 intuition will provide compatibility. - "Solve Obligations using" is now "Solve Obligations with". coq-8.20.0/dev/doc/archive/Translator.tex000066400000000000000000000755731466560755400202450ustar00rootroot00000000000000\ifx\pdfoutput\undefined % si on est pas en pdflatex \documentclass[11pt,a4paper]{article} \else \documentclass[11pt,a4paper,pdftex]{article} \fi \usepackage[latin1]{inputenc} \usepackage[T1]{fontenc} \usepackage{pslatex} \usepackage{url} \usepackage{verbatim} \usepackage{amsmath} \usepackage{amssymb} \usepackage{array} \usepackage{fullpage} \title{Translation from Coq V7 to V8} \author{The Coq Development Team} %% Macros etc. \catcode`\_=13 \let\subscr=_ \def_{\ifmmode\sb\else\subscr\fi} \def\NT#1{\langle\textit{#1}\rangle} \def\NTL#1#2{\langle\textit{#1}\rangle_{#2}} %\def\TERM#1{\textsf{\bf #1}} \def\TERM#1{\texttt{#1}} \newenvironment{transbox} {\begin{center}\tt\begin{tabular}{l|ll} \hfil\textrm{V7} & \hfil\textrm{V8} \\ \hline} {\end{tabular}\end{center}} \def\TRANS#1#2 {\begin{tabular}[t]{@{}l@{}}#1\end{tabular} & \begin{tabular}[t]{@{}l@{}}#2\end{tabular} \\} \def\TRANSCOM#1#2#3 {\begin{tabular}[t]{@{}l@{}}#1\end{tabular} & \begin{tabular}[t]{@{}l@{}}#2\end{tabular} & #3 \\} %% %% %% \begin{document} \maketitle \section{Introduction} Coq version 8.0 is a major version and carries major changes: the concrete syntax was redesigned almost from scratch, and many notions of the libraries were renamed for uniformisation purposes. We felt that these changes could discourage users with large theories from switching to the new version. The goal of this document is to introduce these changes on simple examples (mainly the syntactic changes), and describe the automated tools to help moving to V8.0. Essentially, it consists of a translator that takes as input a Coq source file in old syntax and produces a file in new syntax and adapted to the new standard library. The main extra features of this translator is that it keeps comments, even those within expressions\footnote{The position of those comment might differ slightly since there is no exact matching of positions between old and new syntax.}. The document is organised as follows: first section describes the new syntax on simple examples. It is very translation-oriented. This should give users of older versions the flavour of the new syntax, and allow them to make translation manually on small examples. Section~\ref{Translation} explains how the translation process can be automatised for the most part (the boring one: applying similar changes over thousands of lines of code). We strongly advise users to follow these indications, in order to avoid many potential complications of the translation process. \section{The new syntax on examples} The goal of this section is to introduce to the new syntax of Coq on simple examples, rather than just giving the new grammar. It is strongly recommended to read first the definition of the new syntax (in the reference manual), but this document should also be useful for the eager user who wants to start with the new syntax quickly. The toplevel has an option {\tt -translate} which allows interactively translating commands. This toplevel translator accepts a command, prints the translation on standard output (after a % \verb+New syntax:+ balise), executes the command, and waits for another command. The only requirements is that they should be syntactically correct, but they do not have to be well-typed. This interactive translator proved to be useful in two main usages. First as a ``debugger'' of the translation. Before the translation, it may help in spotting possible conflicts between the new syntax and user notations. Or when the translation fails for some reason, it makes it easy to find the exact reason why it failed and make attempts in fixing the problem. The second usage of the translator is when trying to make the first proofs in new syntax. Well trained users will automatically think their scripts in old syntax and might waste much time (and the intuition of the proof) if they have to search the translation in a document. Running a translator in the background will allow the user to instantly have the answer. The rest of this section is a description of all the aspects of the syntax that changed and how they were translated. All the examples below can be tested by entering the V7 commands in the toplevel translator. %% \subsection{Changes in lexical conventions w.r.t. V7} \subsubsection{Identifiers} The lexical conventions changed: \TERM{_} is not a regular identifier anymore. It is used in terms as a placeholder for subterms to be inferred at type-checking, and in patterns as a non-binding variable. Furthermore, only letters (Unicode letters), digits, single quotes and _ are allowed after the first character. \subsubsection{Quoted string} Quoted strings are used typically to give a filename (which may not be a regular identifier). As before they are written between double quotes ("). Unlike for V7, there is no escape character: characters are written normally except the double quote which is doubled. \begin{transbox} \TRANS{"abcd$\backslash\backslash$efg"}{"abcd$\backslash$efg"} \TRANS{"abcd$\backslash$"efg"}{"abcd""efg"} \end{transbox} \subsection{Main changes in terms w.r.t. V7} \subsubsection{Precedence of application} In the new syntax, parentheses are not really part of the syntax of application. The precedence of application (10) is tighter than all prefix and infix notations. It makes it possible to remove parentheses in many contexts. \begin{transbox} \TRANS{(A x)->(f x)=(g y)}{A x -> f x = g y} \TRANS{(f [x]x)}{f (fun x => x)} \end{transbox} \subsubsection{Arithmetics and scopes} The specialized notation for \TERM{Z} and \TERM{R} (introduced by symbols \TERM{`} and \TERM{``}) have disappeared. They have been replaced by the general notion of scope. \begin{center} \begin{tabular}{l|l|l} type & scope name & delimiter \\ \hline types & type_scope & \TERM{type} \\ \TERM{bool} & bool_scope & \\ \TERM{nat} & nat_scope & \TERM{nat} \\ \TERM{Z} & Z_scope & \TERM{Z} \\ \TERM{R} & R_scope & \TERM{R} \\ \TERM{positive} & positive_scope & \TERM{P} \end{tabular} \end{center} In order to use notations of arithmetics on \TERM{Z}, its scope must be opened with command \verb+Open Scope Z_scope.+ Another possibility is using the scope change notation (\TERM{\%}). The latter notation is to be used when notations of several scopes appear in the same expression. In examples below, scope changes are not needed if the appropriate scope has been opened. Scope \verb|nat_scope| is opened in the initial state of Coq. \begin{transbox} \TRANSCOM{`0+x=x+0`}{0+x=x+0}{\textrm{Z_scope}} \TRANSCOM{``0 + [if b then ``1`` else ``2``]``}{0 + if b then 1 else 2}{\textrm{R_scope}} \TRANSCOM{(0)}{0}{\textrm{nat_scope}} \end{transbox} Below is a table that tells which notation is available in which scope. The relative precedences and associativity of operators is the same as in usual mathematics. See the reference manual for more details. However, it is important to remember that unlike V7, the type operators for product and sum are left-associative, in order not to clash with arithmetic operators. \begin{center} \begin{tabular}{l|l} scope & notations \\ \hline nat_scope & \texttt{+ - * < <= > >=} \\ Z_scope & \texttt{+ - * / mod < <= > >= ?=} \\ R_scope & \texttt{+ - * / < <= > >=} \\ type_scope & \texttt{* +} \\ bool_scope & \texttt{\&\& || -} \\ list_scope & \texttt{:: ++} \end{tabular} \end{center} \subsubsection{Notation for implicit arguments} The explicitation of arguments is closer to the \emph{bindings} notation in tactics. Argument positions follow the argument names of the head constant. The example below assumes \verb+f+ is a function with two implicit dependent arguments named \verb+x+ and \verb+y+. \begin{transbox} \TRANS{f 1!t1 2!t2 t3}{f (x:=t1) (y:=t2) t3} \TRANS{!f t1 t2}{@f t1 t2} \end{transbox} \subsubsection{Inferred subterms} Subterms that can be automatically inferred by the type-checker is now written {\tt _} \begin{transbox} \TRANS{?}{_} \end{transbox} \subsubsection{Universal quantification} The universal quantification and dependent product types are now introduced by the \texttt{forall} keyword before the binders and a comma after the binders. The syntax of binders also changed significantly. A binder can simply be a name when its type can be inferred. In other cases, the name and the type of the variable are put between parentheses. When several consecutive variables have the same type, they can be grouped. Finally, if all variables have the same type, parentheses can be omitted. \begin{transbox} \TRANS{(x:A)B}{forall (x:~A), B ~~\textrm{or}~~ forall x:~A, B} \TRANS{(x,y:nat)P}{forall (x y :~nat), P ~~\textrm{or}~~ forall x y :~nat, P} \TRANS{(x,y:nat;z:A)P}{forall (x y :~nat) (z:A), P} \TRANS{(x,y,z,t:?)P}{forall x y z t, P} \TRANS{(x,y:nat;z:?)P}{forall (x y :~nat) z, P} \end{transbox} \subsubsection{Abstraction} The notation for $\lambda$-abstraction follows that of universal quantification. The binders are surrounded by keyword \texttt{fun} and \verb+=>+. \begin{transbox} \TRANS{[x,y:nat; z](f a b c)}{fun (x y:nat) z => f a b c} \end{transbox} \subsubsection{Pattern-matching} Beside the usage of the keyword pair \TERM{match}/\TERM{with} instead of \TERM{Cases}/\TERM{of}, the main change is the notation for the type of branches and return type. It is no longer written between \TERM{$<$ $>$} before the \TERM{Cases} keyword, but interleaved with the destructured objects. The idea is that for each destructured object, one may specify a variable name (after the \TERM{as} keyword) to tell how the branches types depend on this destructured objects (case of a dependent elimination), and also how they depend on the value of the arguments of the inductive type of the destructured objects (after the \TERM{in} keyword). The type of branches is then given after the keyword \TERM{return}, unless it can be inferred. Moreover, when the destructured object is a variable, one may use this variable in the return type. \begin{transbox} \TRANS{Cases n of\\~~ O => O \\| (S k) => (1) end}{match n with\\~~ 0 => 0 \\| S k => 1 end} \TRANS{Cases m n of \\~~0 0 => t \\| ... end}{match m, n with \\~~0, 0 => t \\| ... end} \TRANS{<[n:nat](P n)>Cases T of ... end}{match T as n return P n with ... end} \TRANS{<[n:nat][p:(even n)]\~{}(odd n)>Cases p of\\~~ ... \\end}{match p in even n return \~{} odd n with\\~~ ...\\end} \end{transbox} The annotations of the special pattern-matching operators (\TERM{if}/\TERM{then}/\TERM{else}) and \TERM{let()} also changed. The only restriction is that the destructuring \TERM{let} does not allow dependent case analysis. \begin{transbox} \TRANS{ \begin{tabular}{@{}l} <[n:nat;x:(I n)](P n x)>if t then t1 \\ else t2 \end{tabular}}% {\begin{tabular}{@{}l} if t as x in I n return P n x then t1 \\ else t2 \end{tabular}} \TRANS{<[n:nat](P n)>let (p,q) = t1 in t2}% {let (p,q) in I n return P n := t1 in t2} \end{transbox} \subsubsection{Fixpoints and cofixpoints} An simpler syntax for non-mutual fixpoints is provided, making it very close to the usual notation for non-recursive functions. The decreasing argument is now indicated by an annotation between curly braces, regardless of the binders grouping. The annotation can be omitted if the binders introduce only one variable. The type of the result can be omitted if inferable. \begin{transbox} \TRANS{Fix plus\{plus [n:nat] : nat -> nat :=\\~~ [m]...\}}{fix plus (n m:nat) \{struct n\}: nat := ...} \TRANS{Fix fact\{fact [n:nat]: nat :=\\ ~~Cases n of\\~~~~ O => (1) \\~~| (S k) => (mult n (fact k)) end\}}{fix fact (n:nat) :=\\ ~~match n with \\~~~~0 => 1 \\~~| (S k) => n * fact k end} \end{transbox} There is a syntactic sugar for single fixpoints (defining one variable) associated to a local definition: \begin{transbox} \TRANS{let f := Fix f \{f [x:A] : T := M\} in\\(g (f y))}{let fix f (x:A) : T := M in\\g (f x)} \end{transbox} The same applies to cofixpoints, annotations are not allowed in that case. \subsubsection{Notation for type cast} \begin{transbox} \TRANS{O :: nat}{0 : nat} \end{transbox} \subsection{Main changes in tactics w.r.t. V7} The main change is that all tactic names are lowercase. This also holds for Ltac keywords. \subsubsection{Renaming of induction tactics} \begin{transbox} \TRANS{NewDestruct}{destruct} \TRANS{NewInduction}{induction} \TRANS{Induction}{simple induction} \TRANS{Destruct}{simple destruct} \end{transbox} \subsubsection{Ltac} Definitions of macros are introduced by \TERM{Ltac} instead of \TERM{Tactic Definition}, \TERM{Meta Definition} or \TERM{Recursive Definition}. They are considered recursive by default. \begin{transbox} \TRANS{Meta Definition my_tac t1 t2 := t1; t2.}% {Ltac my_tac t1 t2 := t1; t2.} \end{transbox} Rules of a match command are not between square brackets anymore. Context (understand a term with a placeholder) instantiation \TERM{inst} became \TERM{context}. Syntax is unified with subterm matching. \begin{transbox} \TRANS{Match t With [C[x=y]] -> Inst C[y=x]}% {match t with context C[x=y] => context C[y=x] end} \end{transbox} Arguments of macros use the term syntax. If a general Ltac expression is to be passed, it must be prefixed with ``{\tt ltac :}''. In other cases, when a \'{} was necessary, it is replaced by ``{\tt constr :}'' \begin{transbox} \TRANS{my_tac '(S x)}{my_tac (S x)} \TRANS{my_tac (Let x=tac In x)}{my_tac ltac:(let x:=tac in x)} \TRANS{Let x = '[x](S (S x)) In Apply x}% {let x := constr:(fun x => S (S x)) in apply x} \end{transbox} {\tt Match Context With} is now called {\tt match goal with}. Its argument is an Ltac expression by default. \subsubsection{Named arguments of theorems ({\em bindings})} \begin{transbox} \TRANS{Apply thm with x:=t 1:=u}{apply thm with (x:=t) (1:=u)} \end{transbox} \subsubsection{Occurrences} To avoid ambiguity between a numeric literal and the optional occurrence numbers of this term, the occurrence numbers are put after the term itself and after keyword \TERM{as}. \begin{transbox} \TRANS{Pattern 1 2 (f x) 3 4 d y z}{pattern f x at 1 2, d at 3 4, y, z} \end{transbox} \subsubsection{{\tt LetTac} and {\tt Pose}} Tactic {\tt LetTac} was renamed into {\tt set}, and tactic {\tt Pose} was a particular case of {\tt LetTac} where the abbreviation is folded in the conclusion\footnote{There is a tactic called {\tt pose} in V8, but its behaviour is not to fold the abbreviation at all.}. \begin{transbox} \TRANS{LetTac x = t in H}{set (x := t) in H} \TRANS{Pose x := t}{set (x := t)} \end{transbox} {\tt LetTac} could be followed by a specification (called a clause) of the places where the abbreviation had to be folded (hypothese and/or conclusion). Clauses are the syntactic notion to denote in which parts of a goal a given transformation should occur. Its basic notation is either \TERM{*} (meaning everywhere), or {\tt\textrm{\em hyps} |- \textrm{\em concl}} where {\em hyps} is either \TERM{*} (to denote all the hypotheses), or a comma-separated list of either hypothesis name, or {\tt (value of $H$)} or {\tt (type of $H$)}. Moreover, occurrences can be specified after every hypothesis after the {\TERM{at}} keyword. {\em concl} is either empty or \TERM{*}, and can be followed by occurrences. \begin{transbox} \TRANS{in Goal}{in |- *} \TRANS{in H H1}{in H1, H2 |-} \TRANS{in H H1 ...}{in * |-} \TRANS{in H H1 Goal}{in H1, H2 |- *} \TRANS{in H H1 H2 ... Goal}{in *} \TRANS{in 1 2 H 3 4 H0 1 3 Goal}{in H at 1 2, H0 at 3 4 |- * at 1 3} \end{transbox} \subsection{Main changes in vernacular commands w.r.t. V7} \subsubsection{Require} The default behaviour of {\tt Require} is not to open the loaded module. \begin{transbox} \TRANS{Require Arith}{Require Import Arith} \end{transbox} \subsubsection{Binders} The binders of vernacular commands changed in the same way as those of fixpoints. This also holds for parameters of inductive definitions. \begin{transbox} \TRANS{Definition x [a:A] : T := M}{Definition x (a:A) : T := M} \TRANS{Inductive and [A,B:Prop]: Prop := \\~~conj : A->B->(and A B)}% {Inductive and (A B:Prop): Prop := \\~~conj : A -> B -> and A B} \end{transbox} \subsubsection{Hints} Both {\tt Hints} and {\tt Hint} commands are beginning with {\tt Hint}. Command {\tt HintDestruct} has disappeared. The syntax of \emph{Extern} hints changed: the pattern and the tactic to be applied are separated by a {\tt =>}. \begin{transbox} \TRANS{Hint name := Resolve (f ? x)}% {Hint Resolve (f _ x)} \TRANS{Hint name := Extern 4 (toto ?) Apply lemma}% {Hint Extern 4 (toto _) => apply lemma} \TRANS{Hints Resolve x y z}{Hint Resolve x y z} \TRANS{Hints Resolve f : db1 db2}{Hint Resolve f : db1 db2} \TRANS{Hints Immediate x y z}{Hint Immediate x y z} \TRANS{Hints Unfold x y z}{Hint Unfold x y z} %% \TRANS{\begin{tabular}{@{}l} %% HintDestruct Local Conclusion \\ %% ~~name (f ? ?) 3 [Apply thm] %% \end{tabular}}% %% {\begin{tabular}{@{}l} %% Hint Local Destuct name := \\ %% ~~3 Conclusion (f _ _) => apply thm %% \end{tabular}} \end{transbox} \subsubsection{Implicit arguments} {\tt Set Implicit Arguments} changed its meaning in V8: the default is to turn implicit only the arguments that are {\em strictly} implicit (or rigid), i.e. that remains inferable whatever the other arguments are. For instance {\tt x} inferable from {\tt P x} is not strictly inferable since it can disappears if {\tt P} is instantiated by a term which erases {\tt x}. \begin{transbox} \TRANS{Set Implicit Arguments}% {\begin{tabular}{l} Set Implicit Arguments. \\ Unset Strict Implicits. \end{tabular}} \end{transbox} However, you may wish to adopt the new semantics of {\tt Set Implicit Arguments} (for instance because you think that the choice of arguments it sets implicit is more ``natural'' for you). \subsection{Changes in standard library} Many lemmas had their named changed to improve uniformity. The user generally do not have to care since the translators performs the renaming. Type {\tt entier} from fast_integer.v is renamed into {\tt N} by the translator. As a consequence, user-defined objects of same name {\tt N} are systematically qualified even tough it may not be necessary. The following table lists the main names with which the same problem arises: \begin{transbox} \TRANS{IF}{IF_then_else} \TRANS{ZERO}{Z0} \TRANS{POS}{Zpos} \TRANS{NEG}{Zneg} \TRANS{SUPERIEUR}{Gt} \TRANS{EGAL}{Eq} \TRANS{INFERIEUR}{Lt} \TRANS{add}{Pplus} \TRANS{true_sub}{Pminus} \TRANS{entier}{N} \TRANS{Un_suivi_de}{Ndouble_plus_one} \TRANS{Zero_suivi_de}{Ndouble} \TRANS{Nul}{N0} \TRANS{Pos}{Npos} \end{transbox} \subsubsection{Implicit arguments} %% Hugo: Main definitions of standard library have now implicit arguments. These arguments are dropped in the translated files. This can exceptionally be a source of incompatibilities which has to be solved by hand (it typically happens for polymorphic functions applied to {\tt nil} or {\tt None}). %% preciser: avant ou apres trad ? \subsubsection{Logic about {\tt Type}} Many notations that applied to {\tt Set} have been extended to {\tt Type}, so several definitions in {\tt Type} are superseded by them. \begin{transbox} \TRANS{x==y}{x=y} \TRANS{(EXT x:Prop | Q)}{exists x:Prop, Q} \TRANS{identityT}{identity} \end{transbox} %% Doc of the translator \section{A guide to translation} \label{Translation} %%\subsection{Overview of the translation process} Here is a short description of the tools involved in the translation process: \begin{description} \item{\tt coqc -translate} is the automatic translator. It is a parser/pretty-printer. This means that the translation is made by parsing every command using a parser of old syntax, which is printed using the new syntax. Many efforts were made to preserve as much as possible of the quality of the presentation: it avoids expansion of syntax extensions, comments are not discarded and placed at the same place. \item{\tt translate-v8} (in the translation package) is a small shell-script that will help translate developments that compile with a Makefile with minimum requirements. \end{description} \subsection{Preparation to translation} This step is very important because most of work shall be done before translation. If a problem occurs during translation, it often means that you will have to modify the original source and restart the translation process. This also means that it is recommended not to edit the output of the translator since it would be overwritten if the translation has to be restarted. \subsubsection{Compilation with {\tt coqc -v7}} First of all, it is mandatory that files compile with the current version of Coq (8.0) with option {\tt -v7}. Translation is a complicated task that involves the full compilation of the development. If your development was compiled with older versions, first upgrade to Coq V8.0 with option {\tt -v7}. If you use a Makefile similar to those produced by {\tt coq\_makefile}, you probably just have to do {\tt make OPT="-opt -v7"} ~~~or~~~ {\tt make OPT="-byte -v7"} When the development compiles successfully, there are several changes that might be necessary for the translation. Essentially, this is about syntax extensions (see section below dedicated to porting syntax extensions). If you do not use such features, then you are ready to try and make the translation. \subsection{Translation} \subsubsection{The general case} The preferred way is to use script {\tt translate-v8} if your development is compiled by a Makefile with the following constraints: \begin{itemize} \item compilation is achieved by invoking make without specifying a target \item options are passed to Coq with make variable COQFLAGS that includes variables OPT, COQLIBS, and OTHERFLAGS. \end{itemize} These constraints are met by the makefiles produced by {\tt coq\_makefile} Otherwise, modify your build program so as to pass option {\tt -translate} to program {\tt coqc}. The effect of this option is to output the translated source of any {\tt .v} file in a file with extension {\tt .v8} located in the same directory than the original file. \subsubsection{What may happen during the translation} This section describes events that may happen during the translation and measures to adopt. These are the warnings that may arise during the translation, but they generally do not require any modification for the user: Warnings: \begin{itemize} \item {\tt Unable to detect if $id$ denotes a local definition}\\ This is due to a semantic change in clauses. In a command such as {\tt simpl in H}, the old semantics were to perform simplification in the type of {\tt H}, or in its body if it is defined. With the new semantics, it is performed both in the type and the body (if any). It might lead to incompatibilities \item {\tt Forgetting obsolete module}\\ Some modules have disappeared in V8.0 (new syntax). The user does not need to worry about it, since the translator deals with it. \item {\tt Replacing obsolete module}\\ Same as before but with the module that were renamed. Here again, the translator deals with it. \end{itemize} \subsection{Verification of the translation} The shell-script {\tt translate-v8} also renames {\tt .v8} files into {\tt .v} files (older {\tt .v} files are put in a subdirectory called {\tt v7}) and tries to recompile them. To do so it invokes {\tt make} without option (which should cause the compilation using {\tt coqc} without particular option). If compilation fails at this stage, you should refrain from repairing errors manually on the new syntax, but rather modify the old syntax script and restart the translation. We insist on that because the problem encountered can show up in many instances (especially if the problem comes from a syntactic extension), and fixing the original sources (for instance the {\tt V8only} parts of notations) once will solve all occurrences of the problem. %%\subsubsection{Errors occurring after translation} %%Equality in {\tt Z} or {\tt R}... \subsection{Particular cases} \subsubsection{Lexical conventions} The definition of identifiers changed. Most of those changes are handled by the translator. They include: \begin{itemize} \item {\tt \_} is not an identifier anymore: it is translated to {\tt x\_} \item avoid clash with new keywords by adding a trailing {\tt \_} \end{itemize} If the choices made by translation is not satisfactory or in the following cases: \begin{itemize} \item use of latin letters \item use of iso-latin characters in notations \end{itemize} users should change their development prior to translation. \subsubsection{{\tt Case} and {\tt Match}} These very low-level case analysis are no longer supported. The translator tries hard to translate them into a user-friendly one, but it might lack type information to do so\footnote{The translator tries to typecheck terms before printing them, but it is not always possible to determine the context in which terms appearing in tactics live.}. If this happens, it is preferable to transform it manually before translation. \subsubsection{Syntax extensions with {\tt Grammar} and {\tt Syntax}} {\tt Grammar} and {\tt Syntax} are no longer supported. They should be replaced by an equivalent {\tt Notation} command and be processed as described above. Before attempting translation, users should verify that compilation with option {\tt -v7} succeeds. In the cases where {\tt Grammar} and {\tt Syntax} cannot be emulated by {\tt Notation}, users have to change manually they development as they wish to avoid the use of {\tt Grammar}. If this is not done, the translator will simply expand the notations and the output of the translator will use the regular Coq syntax. \subsubsection{Syntax extensions with {\tt Notation} and {\tt Infix}} These commands do not necessarily need to be changed. Some work will have to be done manually if the notation conflicts with the new syntax (for instance, using keywords like {\tt fun} or {\tt exists}, overloading of symbols of the old syntax, etc.) or if the precedences are not right. Precedence levels are now from 0 to 200. In V8, the precedence and associativity of an operator cannot be redefined. Typical level are (refer to the chapter on notations in the Reference Manual for the full list): \begin{center} \begin{tabular}{|cll|} \hline Notation & Precedence & Associativity \\ \hline \verb!_ <-> _! & 95 & no \\ \verb!_ \/ _! & 85 & right \\ \verb!_ /\ _! & 80 & right \\ \verb!~ _! & 75 & right \\ \verb!_ = _!, \verb!_ <> _!, \verb!_ < _!, \verb!_ > _!, \verb!_ <= _!, \verb!_ >= _! & 70 & no \\ \verb!_ + _!, \verb!_ - _! & 50 & left \\ \verb!_ * _!, \verb!_ / _! & 40 & left \\ \verb!- _! & 35 & right \\ \verb!_ ^ _! & 30 & left \\ \hline \end{tabular} \end{center} By default, the translator keeps the associativity given in V7 while the levels are mapped according to the following table: \begin{center} \begin{tabular}{l|l|l} V7 level & mapped to & associativity \\ \hline 0 & 0 & no \\ 1 & 20 & left \\ 2 & 30 & right \\ 3 & 40 & left \\ 4 & 50 & left \\ 5 & 70 & no \\ 6 & 80 & right \\ 7 & 85 & right \\ 8 & 90 & right \\ 9 & 95 & no \\ 10 & 100 & left \end{tabular} \end{center} If this is OK, just simply apply the translator. \paragraph{Associativity conflict} Since the associativity of the levels obtained by translating a V7 level (as shown on table above) cannot be changed, you have to choose another level with a compatible associativity. You can choose any level between 0 and 200, knowing that the standard operators are already set at the levels shown on the list above. Assume you have a notation \begin{verbatim} Infix NONA 2 "=_S" my_setoid_eq. \end{verbatim} By default, the translator moves it to level 30 which is right associative, hence a conflict with the expected no associativity. To solve the problem, just add the "V8only" modifier to reset the level and enforce the associativity as follows: \begin{verbatim} Infix NONA 2 "=_S" my_setoid_eq V8only (at level 70, no associativity). \end{verbatim} The translator now knows that it has to translate "=_S" at level 70 with no associativity. Remark: 70 is the "natural" level for relations, hence the choice of 70 here, but any other level accepting a no-associativity would have been OK. Second example: assume you have a notation \begin{verbatim} Infix RIGHTA 1 "o" my_comp. \end{verbatim} By default, the translator moves it to level 20 which is left associative, hence a conflict with the expected right associativity. To solve the problem, just add the "V8only" modifier to reset the level and enforce the associativity as follows: \begin{verbatim} Infix RIGHTA 1 "o" my_comp V8only (at level 20, right associativity). \end{verbatim} The translator now knows that it has to translate "o" at level 20 which has the correct "right associativity". Remark: we assumed here that the user wants a strong precedence for composition, in such a way, say, that "f o g + h" is parsed as "(f o g) + h". To get "o" binding less than the arithmetical operators, an appropriated level would have been close of 70, and below, e.g. 65. \paragraph{Conflict: notation hides another notation} Remark: use {\tt Print Grammar constr} in V8 to diagnose the overlap and see the section on factorization in the chapter on notations of the Reference Manual for hints on how to factorize. Example: \begin{verbatim} Notation "{ x }" := (my_embedding x) (at level 1). \end{verbatim} overlaps in V8 with notation \verb#{ x : A & P }# at level 0 and with x at level 99. The conflicts can be solved by left-factorizing the notation as follows: \begin{verbatim} Notation "{ x }" := (my_embedding x) (at level 1) V8only (at level 0, x at level 99). \end{verbatim} \paragraph{Conflict: a notation conflicts with the V8 grammar} Again, use the {\tt V8only} modifier to tell the translator to automatically take in charge the new syntax. Example: \begin{verbatim} Infix 3 "@" app. \end{verbatim} Since {\tt @} is used in the new syntax for deactivating the implicit arguments, another symbol has to be used, e.g. {\tt @@}. This is done via the {\tt V8only} option as follows: \begin{verbatim} Infix 3 "@" app V8only "@@" (at level 40, left associativity). \end{verbatim} or, alternatively by \begin{verbatim} Notation "x @ y" := (app x y) (at level 3, left associativity) V8only "x @@ y" (at level 40, left associativity). \end{verbatim} \paragraph{Conflict: my notation is already defined at another level (or with another associativity)} In V8, the level and associativity of a given notation can no longer be changed. Then, either you adopt the standard reserved levels and associativity for this notation (as given on the list above) or you change your notation. \begin{itemize} \item To change the notation, follow the directions in the previous paragraph \item To adopt the standard level, just use {\tt V8only} without any argument. \end{itemize} Example: \begin{verbatim} Infix 6 "*" my_mult. \end{verbatim} is not accepted as such in V8. Write \begin{verbatim} Infix 6 "*" my_mult V8only. \end{verbatim} to tell the translator to use {\tt *} at the reserved level (i.e. 40 with left associativity). Even better, use interpretation scopes (look at the Reference Manual). \subsubsection{Strict implicit arguments} In the case you want to adopt the new semantics of {\tt Set Implicit Arguments} (only setting rigid arguments as implicit), add the option {\tt -strict-implicit} to the translator. Warning: changing the number of implicit arguments can break the notations. Then use the {\tt V8only} modifier of {\tt Notation}. \end{document} coq-8.20.0/dev/doc/archive/extensions.txt000066400000000000000000000013221466560755400203070ustar00rootroot00000000000000Comment ajouter une nouvelle entrée primitive pour les TACTIC EXTEND ? ====================================================================== Exemple de l'ajout de l'entrée "clause": - ajouter un type ClauseArgType dans interp/genarg.ml{,i}, avec les wit_, rawwit_, et globwit_ correspondants - ajouter partout où Genarg.argument_type est filtré le cas traitant de ce nouveau ClauseArgType - utiliser le rawwit_clause pour définir une entrée clause du bon type et du bon nom dans le module Tactic de pcoq.ml4 - il faut aussi exporter la règle hors de g_tactic.ml4. Pour cela, il faut rejouter clause dans le GLOBAL du GEXTEND - seulement après, le nom clause sera accessible dans les TACTIC EXTEND ! coq-8.20.0/dev/doc/archive/naming-conventions.tex000066400000000000000000000544271466560755400217230ustar00rootroot00000000000000\documentclass[a4paper]{article} \usepackage{fullpage} \usepackage[utf8]{inputenc} \usepackage[T1]{fontenc} \usepackage{amsfonts} \parindent=0pt \parskip=10pt %%%%%%%%%%%%% % Macros \newcommand\itemrule[3]{ \subsubsection{#1} \begin{quote} \begin{tt} #3 \end{tt} \end{quote} \begin{quote} Name: \texttt{#2} \end{quote}} \newcommand\formula[1]{\begin{tt}#1\end{tt}} \newcommand\tactic[1]{\begin{tt}#1\end{tt}} \newcommand\command[1]{\begin{tt}#1\end{tt}} \newcommand\term[1]{\begin{tt}#1\end{tt}} \newcommand\library[1]{\texttt{#1}} \newcommand\name[1]{\texttt{#1}} \newcommand\zero{\texttt{zero}} \newcommand\op{\texttt{op}} \newcommand\opPrime{\texttt{op'}} \newcommand\opSecond{\texttt{op''}} \newcommand\phimapping{\texttt{phi}} \newcommand\D{\texttt{D}} \newcommand\elt{\texttt{elt}} \newcommand\rel{\texttt{rel}} \newcommand\relp{\texttt{rel'}} %%%%%%%%%%%%% \begin{document} \begin{center} \begin{huge} Proposed naming conventions for the Coq standard library \end{huge} \end{center} \bigskip The following document describes a proposition of canonical naming schemes for the Coq standard library. Obviously and unfortunately, the current state of the library is not as homogeneous as it would be if it would systematically follow such a scheme. To tend in this direction, we however recommend to follow the following suggestions. \tableofcontents \section{General conventions} \subsection{Variable names} \begin{itemize} \item Variables are preferably quantified at the head of the statement, even if some premisses do not depend of one of them. For instance, one would state \begin{quote} \begin{tt} {forall x y z:D, x <= y -> x+z <= y+z} \end{tt} \end{quote} and not \begin{quote} \begin{tt} {forall x y:D, x <= y -> forall z:D, x+z <= y+z} \end{tt} \end{quote} \item Variables are preferably quantified (and named) in the order of ``importance'', then of appearance, from left to right, even if for the purpose of some tactics it would have been more convenient to have, say, the variables not occurring in the conclusion first. For instance, one would state \begin{quote} \begin{tt} {forall x y z:D, x+z <= y+z -> x <= y} \end{tt} \end{quote} and not \begin{quote} \begin{tt} {forall z x y:D, x+z <= y+z -> x <= y} \end{tt} \end{quote} nor \begin{quote} \begin{tt} {forall x y z:D, y+x <= z+x -> y <= z} \end{tt} \end{quote} \item Choice of effective names is domain-dependent. For instance, on natural numbers, the convention is to use the variables $n$, $m$, $p$, $q$, $r$, $s$ in this order. On generic domains, the convention is to use the letters $x$, $y$, $z$, $t$. When more than three variables are needed, indexing variables It is conventional to use specific names for variables having a special meaning. For instance, $eps$ or $\epsilon$ can be used to denote a number intended to be as small as possible. Also, $q$ and $r$ can be used to denote a quotient and a rest. This is good practice. \end{itemize} \subsection{Disjunctive statements} A disjunctive statement with a computational content will be suffixed by \name{\_inf}. For instance, if \begin{quote} \begin{tt} {forall x y, op x y = zero -> x = zero \/ y = zero} \end{tt} \end{quote} has name \texttt{D\_integral}, then \begin{quote} \begin{tt} {forall x y, op x y = zero -> \{x = zero\} + \{y = zero\}} \end{tt} \end{quote} will have name \texttt{D\_integral\_inf}. As an exception, decidability statements, such as \begin{quote} \begin{tt} {forall x y, \{x = y\} + \{x <> y\}} \end{tt} \end{quote} will have a named ended in \texttt{\_dec}. Idem for cotransitivity lemmas which are inherently computational that are ended in \texttt{\_cotrans}. \subsection{Inductive types constructor names} As a general rule, constructor names start with the name of the inductive type being defined as in \texttt{Inductive Z := Z0 : Z | Zpos : Z -> Z | Zneg : Z -> Z} to the exception of very standard types like \texttt{bool}, \texttt{nat}, \texttt{list}... For inductive predicates, constructor names also start with the name of the notion being defined with one or more suffixes separated with \texttt{\_} for discriminating the different cases as e.g. in \begin{verbatim} Inductive even : nat -> Prop := | even_O : even 0 | even_S n : odd n -> even (S n) with odd : nat -> Prop := | odd_S n : even n -> odd (S n). \end{verbatim} As a general rule, inductive predicate names should be lowercase (to the exception of notions referring to a proper name, e.g. \texttt{Bezout}) and multiple words must be separated by ``{\_}''. As an exception, when extending libraries whose general rule is that predicates names start with a capital letter, the convention of this library should be kept and the separation between multiple words is done by making the initial of each work a capital letter (if one of these words is a proper name, then a ``{\_}'' is added to emphasize that the capital letter is proper and not an application of the rule for marking the change of word). Inductive predicates that characterize the specification of a function should be named after the function it specifies followed by \texttt{\_spec} as in: \begin{verbatim} Inductive nth_spec : list A -> nat -> A -> Prop := | nth_spec_O a l : nth_spec (a :: l) 0 a | nth_spec_S n a b l : nth_spec l n a -> nth_spec (b :: l) (S n) a. \end{verbatim} \section{Equational properties of operations} \subsection{General conventions} If the conclusion is in the other way than listed below, add suffix \name{\_reverse} to the lemma name. \subsection{Specific conventions} \itemrule{Associativity of binary operator {\op} on domain {\D}}{Dop\_assoc} {forall x y z:D, op x (op y z) = op (op x y) z} Remark: Symmetric form: \name{Dop\_assoc\_reverse}: \formula{forall x y z:D, op (op x y) z = op x (op y z)} \itemrule{Commutativity of binary operator {\op} on domain {\D}}{Dop\_comm} {forall x y:D, op x y = op y x} Remark: Avoid \formula{forall x y:D, op y x = op x y}, or at worst, call it \name{Dop\_comm\_reverse} \itemrule{Left neutrality of element elt for binary operator {\op}}{Dop\_elt\_l} {forall x:D, op elt x = x} Remark: In English, ``{\elt} is an identity for {\op}'' seems to be a more common terminology. \itemrule{Right neutrality of element elt for binary operator {\op}}{Dop\_elt\_r} {forall x:D, op x elt = x} Remark: By convention, if the identities are reminiscent to zero or one, they are written 1 and 0 in the name of the property. \itemrule{Left absorption of element elt for binary operator {\op}}{Dop\_elt\_l} {forall x:D, op elt x = elt} Remarks: \begin{itemize} \item In French school, this property is named "elt est absorbant pour op" \item English, the property seems generally named "elt is a zero of op" \item In the context of lattices, this a boundedness property, it may be called "elt is a bound on D", or referring to a (possibly arbitrarily oriented) order "elt is a least element of D" or "elt is a greatest element of D" \end{itemize} \itemrule{Right absorption of element {\elt} for binary operator {\op}}{Dop\_elt\_l [BAD ??]} {forall x:D, op x elt = elt} \itemrule{Left distributivity of binary operator {\op} over {\opPrime} on domain {\D}}{Dop\_op'\_distr\_l} {forall x y z:D, op (op' x y) z = op' (op x z) (op y z)} Remark: Some authors say ``distribution''. \itemrule{Right distributivity of binary operator {\op} over {\opPrime} on domain {\D}}{Dop\_op'\_distr\_r} {forall x y z:D, op z (op' x y) = op' (op z x) (op z y)} Remark: Note the order of arguments. \itemrule{Distributivity of unary operator {\op} over binary op' on domain {\D}}{Dop\_op'\_distr} {forall x y:D, op (op' x y) = op' (op x) (op y)} \itemrule{Distributivity of unary operator {\op} over binary op' on domain {\D}}{Dop\_op'\_distr} {forall x y:D, op (op' x y) = op' (op x) (op y)} Remark: For a non commutative operation with inversion of arguments, as in \formula{forall x y z:D, op (op' x y) = op' (op y) (op y z)}, we may probably still call the property distributivity since there is no ambiguity. Example: \formula{forall n m : Z, -(n+m) = (-n)+(-m)}. Example: \formula{forall l l' : list A, rev (l++l') = (rev l)++(rev l')}. \itemrule{Left extrusion of unary operator {\op} over binary op' on domain {\D}}{Dop\_op'\_distr\_l} {forall x y:D, op (op' x y) = op' (op x) y} Question: Call it left commutativity ?? left swap ? \itemrule{Right extrusion of unary operator {\op} over binary op' on domain {\D}}{Dop\_op'\_distr\_r} {forall x y:D, op (op' x y) = op' x (op y)} \itemrule{Idempotency of binary operator {\op} on domain {\D}}{Dop\_idempotent} {forall x:D, op x x = x} \itemrule{Idempotency of unary operator {\op} on domain {\D}}{Dop\_idempotent} {forall x:D, op (op x) = op x} Remark: This is actually idempotency of {\op} wrt to composition and identity. \itemrule{Idempotency of element elt for binary operator {\op} on domain {\D}}{Dop\_elt\_idempotent} {op elt elt = elt} Remark: Generally useless in CIC for concrete, computable operators Remark: The general definition is ``exists n, iter n op x = x''. \itemrule{Nilpotency of element elt wrt a ring D with additive neutral element {\zero} and multiplicative binary operator {\op}}{Delt\_nilpotent} {op elt elt = zero} Remark: We leave the ring structure of D implicit; the general definition is ``exists n, iter n op elt = zero''. \itemrule{Zero-product property in a ring D with additive neutral element {\zero} and multiplicative binary operator {\op}}{D\_integral} {forall x y, op x y = zero -> x = zero \/ y = zero} Remark: We leave the ring structure of D implicit; the Coq library uses either \texttt{\_is\_O} (for \texttt{nat}), \texttt{\_integral} (for \texttt{Z}, \texttt{Q} and \texttt{R}), \texttt{eq\_mul\_0} (for \texttt{NZ}). Remark: The French school says ``integrité''. \itemrule{Nilpotency of binary operator {\op} wrt to its absorbing element zero in D}{Dop\_nilpotent} {forall x, op x x = zero} Remark: Did not find this definition on the web, but it used in the Coq library (to characterize \name{xor}). \itemrule{Involutivity of unary op on D}{Dop\_involutive} {forall x:D, op (op x) = x} \itemrule{Absorption law on the left for binary operator {\op} over binary operator {\op}' on the left}{Dop\_op'\_absorption\_l\_l} {forall x y:D, op x (op' x y) = x} \itemrule{Absorption law on the left for binary operator {\op} over binary operator {\op}' on the right}{Dop\_op'\_absorption\_l\_r} {forall x y:D, op x (op' y x) = x} Remark: Similarly for \name{Dop\_op'\_absorption\_r\_l} and \name{Dop\_op'\_absorption\_r\_r}. \itemrule{De Morgan law's for binary operators {\opPrime} and {\opSecond} wrt to unary op on domain {\D}}{Dop'\_op''\_de\_morgan, Dop''\_op'\_de\_morgan ?? \mbox{leaving the complementing operation implicit})} {forall x y:D, op (op' x y) = op'' (op x) (op y)\\ forall x y:D, op (op'' x y) = op' (op x) (op y)} \itemrule{Left complementation of binary operator {\op} by means of unary {\opPrime} wrt neutral element {\elt} of {\op} on domain {\D}}{Dop\_op'\_opp\_l} {forall x:D, op (op' x) x = elt} Remark: If the name of the opposite function is reminiscent of the notion of complement (e.g. if it is called \texttt{opp}), one can simply say {Dop\_opp\_l}. \itemrule{Right complementation of binary operator {\op} by means of unary {\op'} wrt neutral element {\elt} of {\op} on domain {\D}}{Dop\_opp\_r} {forall x:D, op x (op' x) = elt} Example: \formula{Radd\_opp\_l: forall r : R, - r + r = 0} \itemrule{Associativity of binary operators {\op} and {\op'}}{Dop\_op'\_assoc} {forall x y z, op x (op' y z) = op (op' x y) z} Example: \formula{forall x y z, x + (y - z) = (x + y) - z} \itemrule{Right extrusion of binary operator {\opPrime} over binary operator {\op}}{Dop\_op'\_extrusion\_r} {forall x y z, op x (op' y z) = op' (op x y) z} Remark: This requires {\op} and {\opPrime} to have their right and left argument respectively and their return types identical. Example: \formula{forall x y z, x + (y - z) = (x + y) - z} Remark: Other less natural combinations are possible, such as \formula{forall x y z, op x (op' y z) = op' y (op x z)}. \itemrule{Left extrusion of binary operator {\opPrime} over binary operator {\op}}{Dop\_op'\_extrusion\_l} {forall x y z, op (op' x y) z = op' x (op y z)} Remark: Operations are not necessarily internal composition laws. It is only required that {\op} and {\opPrime} have their right and left argument respectively and their return type identical. Remark: When the type are heterogeneous, only one extrusion law is possible and it can simply be named {Dop\_op'\_extrusion}. Example: \formula{app\_cons\_extrusion : forall a l l', (a :: l) ++ l' = a :: (l ++ l')}. %====================================================================== %\section{Properties of elements} %Remark: Not used in current library %====================================================================== \section{Preservation and compatibility properties of operations} \subsection{With respect to equality} \itemrule{Injectivity of unary operator {\op}}{Dop\_inj} {forall x y:D, op x = op y -> x = y} \itemrule{Left regularity of binary operator {\op}}{Dop\_reg\_l, Dop\_inj\_l, or Dop\_cancel\_l} {forall x y z:D, op z x = op z y -> x = y} Remark: Note the order of arguments. Remark: The Coq usage is to called it regularity but the English standard seems to be cancellation. The recommended form is not decided yet. Remark: Shall a property like $n^p \leq n^q \rightarrow p \leq q$ (for $n\geq 1$) be called cancellation or should it be reserved for operators that have an inverse? \itemrule{Right regularity of binary operator {\op}}{Dop\_reg\_r, Dop\_inj\_r, Dop\_cancel\_r} {forall x y z:D, op x z = op y z -> x = y} \subsection{With respect to a relation {\rel}} \itemrule{Compatibility of unary operator {\op}}{Dop\_rel\_compat} {forall x y:D, rel x y -> rel (op x) (op y)} \itemrule{Left compatibility of binary operator {\op}}{Dop\_rel\_compat\_l} {forall x y z:D, rel x y -> rel (op z x) (op z y)} \itemrule{Right compatibility of binary operator {\op}}{Dop\_rel\_compat\_r} {forall x y z:D, rel x y -> rel (op x z) (op y z)} Remark: For equality, use names of the form \name{Dop\_eq\_compat\_l} or \name{Dop\_eq\_compat\_r} (\formula{forall x y z:D, y = x -> op y z = op x z} and \formula{forall x y z:D, y = x -> op y z = op x z}) Remark: Should we admit (or even prefer) the name \name{Dop\_rel\_monotone}, \name{Dop\_rel\_monotone\_l}, \name{Dop\_rel\_monotone\_r} when {\rel} is an order ? \itemrule{Left regularity of binary operator {\op}}{Dop\_rel\_reg\_l} {forall x y z:D, rel (op z x) (op z y) -> rel x y} \itemrule{Right regularity of binary operator {\op}}{Dop\_rel\_reg\_r} {forall x y z:D, rel (op x z) (op y z) -> rel x y} Question: Would it be better to have \name{z} as first argument, since it is missing in the conclusion ?? (or admit we shall use the options ``\texttt{with p}''?) \itemrule{Left distributivity of binary operator {\op} over {\opPrime} along relation {\rel} on domain {\D}}{Dop\_op'\_rel\_distr\_l} {forall x y z:D, rel (op (op' x y) z) (op' (op x z) (op y z))} Example: standard property of (not necessarily distributive) lattices Remark: In a (non distributive) lattice, by swapping join and meet, one would like also, \formula{forall x y z:D, rel (op' (op x z) (op y z)) (op (op' x y) z)}. How to name it with a symmetric name (use \name{Dop\_op'\_rel\_distr\_mon\_l} and \name{Dop\_op'\_rel\_distr\_anti\_l})? \itemrule{Commutativity of binary operator {\op} along (equivalence) relation {\rel} on domain {\D}}{Dop\_op'\_rel\_comm} {forall x y z:D, rel (op x y) (op y x)} Example: \formula{forall l l':list A, Permutation (l++l') (l'++l)} \itemrule{Irreducibility of binary operator {\op} on domain {\D}}{Dop\_irreducible} {forall x y z:D, z = op x y -> z = x $\backslash/$ z = y} Question: What about the constructive version ? Call it \name{Dop\_irreducible\_inf} ? \formula{forall x y z:D, z = op x y -> \{z = x\} + \{z = y\}} \itemrule{Primality of binary operator {\op} along relation {\rel} on domain {\D}}{Dop\_rel\_prime} {forall x y z:D, rel z (op x y) -> rel z x $\backslash/$ rel z y} %====================================================================== \section{Morphisms} \itemrule{Morphism between structures {\D} and {\D'}}{\name{D'\_of\_D}}{D -> D'} Remark: If the domains are one-letter long, one can used \texttt{IDD'} as for \name{INR} or \name{INZ}. \itemrule{Morphism {\phimapping} mapping unary operators {\op} to {\op'}}{phi\_op\_op', phi\_op\_op'\_morphism} {forall x:D, phi (op x) = op' (phi x)} Remark: If the operators have the same name in both domains, one use \texttt{D'\_of\_D\_op} or \texttt{IDD'\_op}. Example: \formula{Z\_of\_nat\_mult: forall n m : nat, Z\_of\_nat (n * m) = (Z\_of\_nat n * Z\_of\_nat m)\%Z}. Remark: If the operators have different names on distinct domains, one can use \texttt{op\_op'}. \itemrule{Morphism {\phimapping} mapping binary operators {\op} to {\op'}}{phi\_op\_op', phi\_op\_op'\_morphism} {forall x y:D, phi (op x y) = op' (phi x) (phi y)} Remark: If the operators have the same name in both domains, one use \texttt{D'\_of\_D\_op} or \texttt{IDD'\_op}. Remark: If the operators have different names on distinct domains, one can use \texttt{op\_op'}. \itemrule{Morphism {\phimapping} mapping binary operator {\op} to binary relation {\rel}}{phi\_op\_rel, phi\_op\_rel\_morphism} {forall x y:D, phi (op x y) <-> rel (phi x) (phi y)} Remark: If the operator and the relation have similar name, one uses \texttt{phi\_op}. Question: How to name each direction? (add \_elim for -> and \_intro for <- ?? -- as done in Bool.v ??) Example: \formula{eq\_true\_neg: \~{} eq\_true b <-> eq\_true (negb b)}. %====================================================================== \section{Preservation and compatibility properties of operations wrt order} \itemrule{Compatibility of binary operator {\op} wrt (strict order) {\rel} and (large order) {\rel'}}{Dop\_rel\_rel'\_compat} {forall x y z t:D, rel x y -> rel' z t -> rel (op x z) (op y t)} \itemrule{Compatibility of binary operator {\op} wrt (large order) {\relp} and (strict order) {\rel}}{Dop\_rel'\_rel\_compat} {forall x y z t:D, rel' x y -> rel z t -> rel (op x z) (op y t)} %====================================================================== \section{Properties of relations} \itemrule{Reflexivity of relation {\rel} on domain {\D}}{Drel\_refl} {forall x:D, rel x x} \itemrule{Symmetry of relation {\rel} on domain {\D}}{Drel\_sym} {forall x y:D, rel x y -> rel y x} \itemrule{Transitivity of relation {\rel} on domain {\D}}{Drel\_trans} {forall x y z:D, rel x y -> rel y z -> rel x z} \itemrule{Antisymmetry of relation {\rel} on domain {\D}}{Drel\_antisym} {forall x y:D, rel x y -> rel y x -> x = y} \itemrule{Irreflexivity of relation {\rel} on domain {\D}}{Drel\_irrefl} {forall x:D, \~{} rel x x} \itemrule{Asymmetry of relation {\rel} on domain {\D}}{Drel\_asym} {forall x y:D, rel x y -> \~{} rel y x} \itemrule{Cotransitivity of relation {\rel} on domain {\D}}{Drel\_cotrans} {forall x y z:D, rel x y -> \{rel z y\} + \{rel x z\}} \itemrule{Linearity of relation {\rel} on domain {\D}}{Drel\_trichotomy} {forall x y:D, \{rel x y\} + \{x = y\} + \{rel y x\}} Questions: Or call it \name{Drel\_total}, or \name{Drel\_linear}, or \name{Drel\_connected}? Use $\backslash/$ ? or use a ternary sumbool, or a ternary disjunction, for nicer elimination. \itemrule{Informative decidability of relation {\rel} on domain {\D}}{Drel\_dec (or Drel\_dect, Drel\_dec\_inf ?)} {forall x y:D, \{rel x y\} + \{\~{} rel x y\}} Remark: If equality: \name{D\_eq\_dec} or \name{D\_dec} (not like \name{eq\_nat\_dec}) \itemrule{Non informative decidability of relation {\rel} on domain {\D}}{Drel\_dec\_prop (or Drel\_dec)} {forall x y:D, rel x y $\backslash/$ \~{} rel x y} \itemrule{Inclusion of relation {\rel} in relation {\rel}' on domain {\D}}{Drel\_rel'\_incl (or Drel\_incl\_rel')} {forall x y:D, rel x y -> rel' x y} Remark: Use \name{Drel\_rel'\_weak} for a strict inclusion ?? %====================================================================== \section{Relations between properties} \itemrule{Equivalence of properties \texttt{P} and \texttt{Q}}{P\_Q\_iff} {forall x1 .. xn, P <-> Q} Remark: Alternatively use \name{P\_iff\_Q} if it is too difficult to recover what pertains to \texttt{P} and what pertains to \texttt{Q} in their concatenation (as e.g. in \texttt{Godel\_Dummett\_iff\_right\_distr\_implication\_over\_disjunction}). %====================================================================== \section{Arithmetical conventions} \begin{minipage}{6in} \renewcommand{\thefootnote}{\thempfootnote} % For footnotes... \begin{tabular}{lll} Zero on domain {\D} & D0 & (notation \verb=0=)\\ One on domain {\D} & D1 (if explicitly defined) & (notation \verb=1=)\\ Successor on domain {\D} & Dsucc\\ Predecessor on domain {\D} & Dpred\\ Addition on domain {\D} & Dadd/Dplus\footnote{Coq historically uses \texttt{plus} and \texttt{mult} for addition and multiplication which are inconsistent notations, the recommendation is to use \texttt{add} and \texttt{mul} except in existing libraries that already use \texttt{plus} and \texttt{mult}} & (infix notation \verb=+= [50,L])\\ Multiplication on domain {\D} & Dmul/Dmult\footnotemark[\value{footnote}] & (infix notation \verb=*= [40,L]))\\ Subtraction on domain {\D} & Dminus & (infix notation \verb=-= [50,L])\\ Opposite on domain {\D} & Dopp (if any) & (prefix notation \verb=-= [35,R]))\\ Inverse on domain {\D} & Dinv (if any) & (prefix notation \verb=/= [35,R]))\\ Power on domain {\D} & Dpower & (infix notation \verb=^= [30,R])\\ Minimal element on domain {\D} & Dmin\\ Maximal element on domain {\D} & Dmax\\ Large less than order on {\D} & Dle & (infix notations \verb!<=! and \verb!>=! [70,N]))\\ Strict less than order on {\D} & Dlt & (infix notations \verb=<= and \verb=>= [70,N]))\\ \end{tabular} \bigskip \end{minipage} \bigskip The status of \verb!>=! and \verb!>! is undecided yet. It will eithet be accepted only as parsing notations or may also accepted as a {\em definition} for the \verb!<=! and \verb! ... \end{verbatim} ce qui introduit un constructeur moralement équivalent à une application situé à une priorité totalement différente (les ``bindings'' seraient au plus haut niveau alors que l'application est à un niveau bas). \begin{figure} \begin{rulebox} \DEFNT{binding-term} \NT{constr} ~\TERM{with} ~\STAR{\NT{binding}} \SEPDEF \DEFNT{binding} \NT{constr} \end{rulebox} \caption{Grammaire des bindings} \label{bindings} \end{figure} \subsection{Enregistrements} Il faudrait aménager la syntaxe des enregistrements dans l'optique d'avoir des enregistrements anonymes (termes de première classe), même si pour l'instant, on ne dispose que d'enregistrements définis a toplevel. Exemple de syntaxe pour les types d'enregistrements: \begin{verbatim} { x1 : A1; x2 : A2(x1); _ : T; (* Pas de projection disponible *) y; (* Type infere *) ... (* ; optionnel pour le dernier champ *) } \end{verbatim} Exemple de syntaxe pour le constructeur: \begin{verbatim} { x1 = O; x2 : A2(x1) = v1; _ = v2; ... } \end{verbatim} Quant aux dépendences, une convention pourrait être de considérer les champs non annotés par le type comme non dépendants. Plusieurs interrogations: \begin{itemize} \item l'ordre des champs doit-il être respecté ? sinon, que faire pour les champs sans projection ? \item autorise-t-on \texttt{v1} a mentionner \texttt{x1} (comme dans la définition d'un module), ce qui se comporterait comme si on avait écrit \texttt{v1} à la place. Cela pourrait être une autre manière de déclarer les dépendences \end{itemize} La notation pointée pour les projections pose un problème de parsing, sauf si l'on a une convention lexicale qui discrimine les noms de modules des projections et identificateurs: \texttt{x.y.z} peut être compris comme \texttt{(x.y).z} ou texttt{x.(y.z)}. \section{Grammaire des termes} \label{constrsyntax} \subsection{Quelques principes} \begin{enumerate} \item Diminuer le nombre de niveaux de priorité en regroupant les règles qui se ressemblent: infixes, préfixes, lieurs (constructions ouvertes à droite), etc. \item Éviter de surcharger la signification d'un symbole (ex: \verb+( )+ comme parenthésage et produit dans la V7). \item Faire en sorte que les membres gauches (motifs de Cases, lieurs d'abstraction ou de produits) utilisent une syntaxe compatible avec celle des membres droits (branches de Cases et corps de fonction). \end{enumerate} \subsection{Présentation de la grammaire} \begin{figure} \begin{rulebox} \DEFNT{paren-constr} \NT{cast-constr}~\TERM{,}~\NT{paren-constr} &\RNAME{pair} \nlsep \NT{cast-constr} \SEPDEF \DEFNT{cast-constr} \NT{constr}~\TERM{\!\!:}~\NT{cast-constr} &\RNAME{cast} \nlsep \NT{constr} \SEPDEF \DEFNT{constr} \NT{appl-constr}~\NT{infix}~\NT{constr} &\RNAME{infix} \nlsep \NT{prefix}~\NT{constr} &\RNAME{prefix} \nlsep \NT{constr}~\NT{postfix} &\RNAME{postfix} \nlsep \NT{appl-constr} \SEPDEF \DEFNT{appl-constr} \NT{appl-constr}~\PLUS{\NT{appl-arg}} &\RNAME{apply} \nlsep \TERM{@}~\NT{global}~\PLUS{\NT{simple-constr}} &\RNAME{expl-apply} \nlsep \NT{simple-constr} \SEPDEF \DEFNT{appl-arg} \TERM{@}~\NT{int}~\TERM{\!:=}~\NT{simple-constr} &\RNAME{impl-arg} \nlsep \NT{simple-constr} \SEPDEF \DEFNT{simple-constr} \NT{atomic-constr} \nlsep \TERM{(}~\NT{paren-constr}~\TERM{)} \nlsep \NT{match-constr} \nlsep \NT{fix-constr} %% \nlsep \TERM{<\!\!:ast\!\!:<}~\NT{ast}~\TERM{>\!>} &\RNAME{quotation} \end{rulebox} \caption{Grammaire des termes} \label{constr} \end{figure} \begin{figure} \begin{rulebox} \DEFNT{prefix} \TERM{!}~\PLUS{\NT{binder}}~\TERM{.}~ &\RNAME{prod} \nlsep \TERM{fun} ~\PLUS{\NT{binder}} ~\TERM{$\Rightarrow$} &\RNAME{lambda} \nlsep \TERM{let}~\NT{ident}~\STAR{\NT{binder}} ~\TERM{=}~\NT{constr} ~\TERM{in} &\RNAME{let} %\nlsep \TERM{let (}~\NT{comma-ident-list}~\TERM{) =}~\NT{constr} % ~\TERM{in} &~~~\RNAME{let-case} \nlsep \TERM{if}~\NT{constr}~\TERM{then}~\NT{constr}~\TERM{else} &\RNAME{if-case} \nlsep \TERM{eval}~\NT{red-fun}~\TERM{in} &\RNAME{eval} \SEPDEF \DEFNT{infix} \TERM{$\rightarrow$} & \RNAME{impl} \SEPDEF \DEFNT{atomic-constr} \TERM{_} \nlsep \TERM{?}\NT{int} \nlsep \NT{sort} \nlsep \NT{global} \SEPDEF \DEFNT{binder} \NT{ident} &\RNAME{infer} \nlsep \TERM{(}~\NT{ident}~\NT{type}~\TERM{)} &\RNAME{binder} \SEPDEF \DEFNT{type} \TERM{\!:}~\NT{constr} \nlsep \epsilon \end{rulebox} \caption{Grammaires annexes aux termes} \label{gram-annexes} \end{figure} La grammaire des termes (correspondant à l'état \texttt{barestate}) est décrite figures~\ref{constr} et~\ref{gram-annexes}. On constate par rapport aux précédentes versions de Coq d'importants changements de priorité, le plus marquant étant celui de l'application qui se trouve désormais juste au dessus\footnote{La convention est de considérer les opérateurs moins lieurs comme ``au dessus'', c'est-à-dire ayant un niveau de priorité plus élévé (comme c'est le cas avec le niveau de la grammaire actuelle des termes).} des constructions fermées à gauche et à droite. La grammaire des noms globaux est la suivante: \begin{eqnarray*} \DEFNT{global} \NT{ident} %% \nlsep \TERM{\$}\NT{ident} \nlsep \NT{ident}\TERM{.}\NT{global} \end{eqnarray*} Le $\TERM{_}$ dénote les termes à synthétiser. Les métavariables sont reconnues au niveau du lexer pour ne pas entrer en conflit avec le $\TERM{?}$ de l'existentielle. Les opérateurs infixes ou préfixes sont tous au même niveau de priorité du point de vue de Camlp4. La solution envisagée est de les gérer à la manière de Yacc, avec une pile (voir discussions plus bas). Ainsi, l'implication est un infixe normal; la quantification universelle et le let sont vus comme des opérateurs préfixes avec un niveau de priorité plus haut (i.e. moins lieur). Il subsiste des problèmes si l'on ne veut pas écrire de parenthèses dans: \begin{verbatim} A -> (!x. B -> (let y = C in D)) \end{verbatim} La solution proposée est d'analyser le membre droit d'un infixe de manière à autoriser les préfixes et les infixes de niveau inférieur, et d'exiger le parenthésage que pour les infixes de niveau supérieurs. En revanche, à l'affichage, certains membres droits seront plus lisibles s'ils n'utilisent pas cette astuce: \begin{verbatim} (fun x => x) = fun x => x \end{verbatim} La proposition est d'autoriser ce type d'écritures au parsing, mais l'afficheur écrit de manière standardisée en mettant quelques parenthèses superflues: $\TERM{=}$ serait symétrique alors que $\rightarrow$ appellerait l'afficheur de priorité élevée pour son sous-terme droit. Les priorités des opérateurs primitifs sont les suivantes (le signe $*$ signifie que pour le membre droit les opérateurs préfixes seront affichés sans parenthèses quel que soit leur priorité): $$ \begin{array}{c|l} $symbole$ & $priorité$ \\ \hline \TERM{!} & 200\,R* \\ \TERM{fun} & 200\,R* \\ \TERM{let} & 200\,R* \\ \TERM{if} & 200\,R \\ \TERM{eval} & 200\,R \\ \rightarrow & 90\,R* \end{array} $$ Il y a deux points d'entrée pour les termes: $\NT{constr}$ et $\NT{simple-constr}$. Le premier peut être utilisé lorsqu'il est suivi d'un séparateur particulier. Dans le cas où l'on veut une liste de termes séparés par un espace, il faut lire des $\NT{simple-constr}$. Les constructions $\TERM{fix}$ et $\TERM{cofix}$ (voir aussi figure~\ref{gram-fix}) sont fermées par end pour simplifier l'analyse. Sinon, une expression de point fixe peut être suivie par un \TERM{in} ou un \TERM{and}, ce qui pose les mêmes problèmes que le ``dangling else'': dans \begin{verbatim} fix f1 x {x} = fix f2 y {y} = ... and ... in ... \end{verbatim} il faut définir une stratégie pour associer le \TERM{and} et le \TERM{in} au bon point fixe. Un autre avantage est de faire apparaitre que le \TERM{fix} est un constructeur de terme de première classe et pas un lieur: \begin{verbatim} fix f1 ... and f2 ... in f1 end x \end{verbatim} Les propositions précédentes laissaient \texttt{f1} et \texttt{x} accolés, ce qui est source de confusion lorsque l'on fait par exemple \texttt{Pattern (f1 x)}. Les corps de points fixes et co-points fixes sont identiques, bien que ces derniers n'aient pas d'information de décroissance. Cela fonctionne puisque l'annotation est optionnelle. Cela préfigure des cas où l'on arrive à inférer quel est l'argument qui décroit structurellement (en particulier dans le cas où il n'y a qu'un seul argument). \begin{figure} \begin{rulebox} \DEFNT{fix-expr} \TERM{fix}~\NT{fix-decls} ~\NT{fix-select} ~\TERM{end} &\RNAME{fix} \nlsep \TERM{cofix}~\NT{cofix-decls}~\NT{fix-select} ~\TERM{end} &\RNAME{cofix} \SEPDEF \DEFNT{fix-decls} \NT{fix-decl}~\TERM{and}~\NT{fix-decls} \nlsep \NT{fix-decl} \SEPDEF \DEFNT{fix-decl} \NT{ident}~\PLUS{\NT{binder}}~\NT{type}~\NT{annot} ~\TERM{=}~\NT{constr} \SEPDEF \DEFNT{annot} \TERM{\{}~\NT{ident}~\TERM{\}} \nlsep \epsilon \SEPDEF \DEFNT{fix-select} \TERM{in}~\NT{ident} \nlsep \epsilon \end{rulebox} \caption{Grammaires annexes des points fixes} \label{gram-fix} \end{figure} La construction $\TERM{Case}$ peut-être considérée comme obsolète. Quant au $\TERM{Match}$ de la V6, il disparaît purement et simplement. \begin{figure} \begin{rulebox} \DEFNT{match-expr} \TERM{match}~\NT{case-items}~\NT{case-type}~\TERM{with}~ \NT{branches}~\TERM{end} &\RNAME{match} \nlsep \TERM{match}~\NT{case-items}~\TERM{with}~ \NT{branches}~\TERM{end} &\RNAME{infer-match} %%\nlsep \TERM{case}~\NT{constr}~\NT{case-predicate}~\TERM{of}~ %% \STAR{\NT{constr}}~\TERM{end} &\RNAME{case} \SEPDEF \DEFNT{case-items} \NT{case-item} ~\TERM{\&} ~\NT{case-items} \nlsep \NT{case-item} \SEPDEF \DEFNT{case-item} \NT{constr}~\NT{pred-pattern} &\RNAME{dep-case} \nlsep \NT{constr} &\RNAME{nodep-case} \SEPDEF \DEFNT{case-type} \TERM{$\Rightarrow$}~\NT{constr} \nlsep \epsilon \SEPDEF \DEFNT{pred-pattern} \TERM{as}~\NT{ident} ~\TERM{\!:}~\NT{constr} \SEPDEF \DEFNT{branches} \TERM{|} ~\NT{patterns} ~\TERM{$\Rightarrow$} ~\NT{constr} ~\NT{branches} \nlsep \epsilon \SEPDEF \DEFNT{patterns} \NT{pattern} ~\TERM{\&} ~\NT{patterns} \nlsep \NT{pattern} \SEPDEF \DEFNT{pattern} ... \end{rulebox} \caption{Grammaires annexes du filtrage} \label{gram-match} \end{figure} De manière globale, l'introduction de définitions dans les termes se fait avec le symbole $=$, et le $\!:=$ est réservé aux définitions au niveau vernac. Il y avait un manque de cohérence dans la V6, puisque l'on utilisait $=$ pour le $\TERM{let}$ et $\!:=$ pour les points fixes et les commandes vernac. % OBSOLETE: lieurs multiples supprimes %On peut remarquer que $\NT{binder}$ est un sous-ensemble de %$\NT{simple-constr}$, à l'exception de $\texttt{(a,b\!\!:T)}$: en tant %que lieur, {\tt a} et {\tt b} sont tous deux contraints, alors qu'en %tant que terme, seul {\tt b} l'est. Cela qui signifie que l'objectif %de rendre compatibles les membres gauches et droits est {\it presque} %atteint. \subsection{Infixes} \subsubsection{Infixes extensibles} Le problème de savoir si la liste des symboles pouvant apparaître en infixe est fixée ou extensible par l'utilisateur reste à voir. Notons que la solution où les symboles infixes sont des identificateurs que l'on peut définir paraît difficilement praticable: par exemple $\texttt{Logic.eq}$ n'est pas un opérateur binaire, mais ternaire. Il semble plus simple de garder des déclarations infixes qui relient un symbole infixe à un terme avec deux ``trous''. Par exemple: $$\begin{array}{c|l} $infixe$ & $identificateur$ \\ \hline = & \texttt{Logic.eq _ ?1 ?2} \\ == & \texttt{JohnMajor.eq _ ?1 _ ?2} \end{array}$$ La syntaxe d'une déclaration d'infixe serait par exemple: \begin{verbatim} Infix "=" 50 := Logic.eq _ ?1 ?2; \end{verbatim} \subsubsection{Gestion des précédences} Les infixes peuvent être soit laissé à Camlp4, ou bien (comme ici) considérer que tous les opérateurs ont la même précédence et gérer soit même la recomposition des termes à l'aide d'une pile (comme Yacc). \subsection{Extensions de syntaxe} \subsubsection{Litéraux numériques} La proposition est de considerer les litéraux numériques comme de simples identificateurs. Comme il en existe une infinité, il faut un nouveau mécanisme pour leur associer une définition. Par exemple, en ce qui concerne \texttt{Arith}, la définition de $5$ serait $\texttt{S}~4$. Pour \texttt{ZArith}, $5$ serait $\texttt{xI}~2$. Comme les infixes, les constantes numériques peuvent être qualifiées pour indiquer dans quels module est le type que l'on veut référencer. Par exemple (si on renomme \texttt{Arith} en \texttt{N} et \texttt{ZArith} en \texttt{Z}): \verb+N.5+, \verb+Z.5+. \begin{eqnarray*} \EXTNT{global} \NT{int} \end{eqnarray*} \subsubsection{Nouveaux lieurs} $$ \begin{array}{rclr} \EXTNT{constr} \TERM{ex}~\PLUS{\NT{binder}}~\TERM{.}~\NT{constr} &\RNAME{ex} \nlsep \TERM{ex}~\PLUS{\NT{binder}}~\TERM{.}~\NT{constr}~\TERM{,}~\NT{constr} &\RNAME{ex2} \nlsep \TERM{ext}~\PLUS{\NT{binder}}~\TERM{.}~\NT{constr} &\RNAME{exT} \nlsep \TERM{ext}~\PLUS{\NT{binder}}~\TERM{.}~\NT{constr}~\TERM{,}~\NT{constr} &\RNAME{exT2} \end{array} $$ Pour l'instant l'existentielle n'admet qu'une seule variable, ce qui oblige à écrire des cascades de $\TERM{ex}$. Pour parser les existentielles avec deux prédicats, on peut considérer \TERM{\&} comme un infixe intermédiaire et l'opérateur existentiel en présence de cet infixe se transforme en \texttt{ex2}. \subsubsection{Nouveaux infixes} Précédences des opérateurs infixes (les plus grands associent moins fort): $$ \begin{array}{l|l|c|l} $identificateur$ & $module$ & $infixe/préfixe$ & $précédence$ \\ \hline \texttt{iff} & $Logic$ & \longleftrightarrow & 100 \\ \texttt{or} & $Logic$ & \vee & 80\, R \\ \texttt{sum} & $Datatypes$ & + & 80\, R \\ \texttt{and} & $Logic$ & \wedge & 70\, R \\ \texttt{prod} & $Datatypes$ & * & 70\, R \\ \texttt{not} & $Logic$ & \tilde{} & 60\, L \\ \texttt{eq _} & $Logic$ & = & 50 \\ \texttt{eqT _} & $Logic_Type$ & = & 50 \\ \texttt{identityT _} & $Data_Type$ & = & 50 \\ \texttt{le} & $Peano$ & $<=$ & 50 \\ \texttt{lt} & $Peano$ & $<$ & 50 \\ \texttt{ge} & $Peano$ & $>=$ & 50 \\ \texttt{gt} & $Peano$ & $>$ & 50 \\ \texttt{Zle} & $zarith_aux$ & $<=$ & 50 \\ \texttt{Zlt} & $zarith_aux$ & $<$ & 50 \\ \texttt{Zge} & $zarith_aux$ & $>=$ & 50 \\ \texttt{Zgt} & $zarith_aux$ & $>$ & 50 \\ \texttt{Rle} & $Rdefinitions$ & $<=$ & 50 \\ \texttt{Rlt} & $Rdefinitions$ & $<$ & 50 \\ \texttt{Rge} & $Rdefinitions$ & $>=$ & 50 \\ \texttt{Rgt} & $Rdefinitions$ & $>$ & 50 \\ \texttt{plus} & $Peano$ & + & 40\,L \\ \texttt{Zplus} & $fast_integer$ & + & 40\,L \\ \texttt{Rplus} & $Rdefinitions$ & + & 40\,L \\ \texttt{minus} & $Minus$ & - & 40\,L \\ \texttt{Zminus} & $zarith_aux$ & - & 40\,L \\ \texttt{Rminus} & $Rdefinitions$ & - & 40\,L \\ \texttt{Zopp} & $fast_integer$ & - & 40\,L \\ \texttt{Ropp} & $Rdefinitions$ & - & 40\,L \\ \texttt{mult} & $Peano$ & * & 30\,L \\ \texttt{Zmult} & $fast_integer$ & * & 30\,L \\ \texttt{Rmult} & $Rdefinitions$ & * & 30\,L \\ \texttt{Rdiv} & $Rdefinitions$ & / & 30\,L \\ \texttt{pow} & $Rfunctions$ & \hat & 20\,L \\ \texttt{fact} & $Rfunctions$ & ! & 20\,L \\ \end{array} $$ Notons qu'il faudrait découper {\tt Logic_Type} en deux car celui-ci définit deux égalités, ou alors les mettre dans des modules différents. \subsection{Exemples} \begin{verbatim} Definition not (A:Prop) := A->False; Inductive eq (A:Set) (x:A) : A->Prop := refl_equal : eq A x x; Inductive ex (A:Set) (P:A->Prop) : Prop := ex_intro : !x. P x -> ex A P; Lemma not_all_ex_not : !(P:U->Prop). ~(!n. P n) -> ?n. ~ P n; Fixpoint plus n m : nat {struct n} := match n with O => m | (S k) => S (plus k m) end; \end{verbatim} \subsection{Questions ouvertes} Voici les points sur lesquels la discussion est particulièrement ouverte: \begin{itemize} \item choix d'autres symboles pour les quantificateurs \TERM{!} et \TERM{?}. En l'état actuel des discussions, on garderait le \TERM{!} pour la qunatification universelle, mais on choisirait quelquechose comme \TERM{ex} pour l'existentielle, afin de ne pas suggérer trop de symétrie entre ces quantificateurs (l'un est primitif, l'autre pas). \item syntaxe particulière pour les \texttt{sig}, \texttt{sumor}, etc. \item la possibilité d'introduire plusieurs variables du même type est pour l'instant supprimée au vu des problèmes de compatibilité de syntaxe entre les membres gauches et membres droits. L'idée étant que l'inference de type permet d'éviter le besoin de déclarer tous les types. \end{itemize} \subsection{Autres extensions} \subsubsection{Lieur multiple} L'écriture de types en présence de polymorphisme est souvent assez pénible: \begin{verbatim} Check !(A:Set) (x:A) (B:Set) (y:B). P A x B y; \end{verbatim} On pourrait avoir des déclarations introduisant à la fois un type d'une certaine sorte et une variable de ce type: \begin{verbatim} Check !(x:A:Set) (y:B:Set). P A x B y; \end{verbatim} Noter que l'on aurait pu écrire: \begin{verbatim} Check !A x B y. P A (x:A:Set) B (y:B:Set); \end{verbatim} \section{Syntaxe des tactiques} \subsection{Questions diverses} Changer ``Pattern nl c ... nl c'' en ``Pattern [ nl ] c ... [ nl ] c'' pour permettre des chiffres seuls dans la catégorie syntaxique des termes. Par uniformité remplacer ``Unfold nl c'' par ``Unfold [ nl ] c'' ? Même problème pour l'entier de Specialize (ou virer Specialize ?) ? \subsection{Questions en suspens} \verb=EAuto= : deux syntaxes différentes pour la recherche en largeur et en profondeur ? Quelle recherche par défaut ? \section*{Remarques pêle-mêle (HH)} Autoriser la syntaxe \begin{verbatim} Variable R (a : A) (b : B) : Prop. Hypotheses H (a : A) (b : B) : Prop; Y (u : U) : V. Variables H (a : A) (b : B), J (k : K) : nat; Z (v : V) : Set. \end{verbatim} Renommer eqT, refl_eqT, eqT_ind, eqT_rect, eqT_rec en eq, refl_equal, etc. Remplacer == en =. Mettre des \verb=?x= plutot que des \verb=?1= dans les motifs de ltac ?? \section{Moulinette} \begin{itemize} \item Mettre \verb=/= et * au même niveau dans R. \item Changer la précédence du - unaire dans R. \item Ajouter Require Arith par necessite si Require ArithRing ou Require ZArithRing. \item Ajouter Require ZArith par necessite si Require ZArithRing ou Require Omega. \item Enlever le Export de Bool, Arith et ZARith de Ring quand inapproprié et l'ajouter à côté des Require Ring. \item Remplacer "Check n" par "n:Check ..." \item Renommer Variable/Hypothesis hors section en Parameter/Axiom. \item Renommer les \verb=command0=, \verb=command1=, ... \verb=lcommand= etc en \verb=constr0=, \verb=constr1=, ... \verb=lconstr=. \item Remplacer les noms Coq.omega.Omega par Coq.Omega ... \item Remplacer AddPath par Add LoadPath (ou + court) \item Unify + and \{\}+\{\} and +\{\} using Prop $\leq$ Set ?? \item Remplacer Implicit Arguments On/Off par Set/Unset Implicit Arguments. \item La syntaxe \verb=Intros (a,b)= est inutile, \verb=Intros [a b]= fait l'affaire. \item Virer \verb=Goal= sans argument (synonyme de \verb=Proof= et sans effets). \item Remplacer Save. par Qed. \item Remplacer \verb=Zmult_Zplus_distr= par \verb=Zmult_plus_distr_r= et \verb=Zmult_plus_distr= par \verb=Zmult_plus_distr_l=. \end{itemize} \end{document} coq-8.20.0/dev/doc/archive/notes-on-conversion.v000066400000000000000000000050141466560755400214650ustar00rootroot00000000000000(**********************************************************************) (* A few examples showing the current limits of the conversion algorithm *) (**********************************************************************) (*** We define (pseudo-)divergence from Ackermann function ***) Definition ack (n : nat) := (fix F (n0 : nat) : nat -> nat := match n0 with | O => S | S n1 => fun m : nat => (fix F0 (n2 : nat) : nat := match n2 with | O => F n1 1 | S n3 => F n1 (F0 n3) end) m end) n. Notation OMEGA := (ack 4 4). Definition f (x:nat) := x. (* Evaluation in tactics can somehow be controlled *) Lemma l1 : OMEGA = OMEGA. reflexivity. (* succeed: identity *) Qed. (* succeed: identity *) Lemma l2 : OMEGA = f OMEGA. reflexivity. (* fail: conversion wants to convert OMEGA with f OMEGA *) Abort. (* but it reduces the right side first! *) Lemma l3 : f OMEGA = OMEGA. reflexivity. (* succeed: reduce left side first *) Qed. (* succeed: expected concl (the one with f) is on the left *) Lemma l4 : OMEGA = OMEGA. assert (f OMEGA = OMEGA) by reflexivity. (* succeed *) unfold f in H. (* succeed: no type-checking *) exact H. (* succeed: identity *) Qed. (* fail: "f" is on the left *) (* This example would fail whatever the preferred side is *) Lemma l5 : OMEGA = f OMEGA. unfold f. assert (f OMEGA = OMEGA) by reflexivity. unfold f in H. exact H. Qed. (* needs to convert (f OMEGA = OMEGA) and (OMEGA = f OMEGA) *) (**********************************************************************) (* Analysis of the inefficiency in Nijmegen/LinAlg/LinAlg/subspace_dim.v *) (* (proof of span_ind_uninject_prop *) In the proof, a problem of the form (Equal S t1 t2) is "simpl"ified, then "red"uced to (Equal S' t1 t1) where the new t1's are surrounded by invisible coercions. A reflexivity steps conclude the proof. The trick is that Equal projects the equality in the setoid S, and that (Equal S) itself reduces to some (fun x y => Equal S' (f x) (g y)). At the Qed time, the problem to solve is (Equal S t1 t2) = (Equal S' t1 t1) and the algorithm is to first compare S and S', and t1 and t2. Unfortunately it does not work, and since t1 and t2 involve concrete instances of algebraic structures, it takes a lot of time to realize that it is not convertible. The only hope to improve this problem is to observe that S' hides (behind two indirections) a Setoid constructor. This could be the argument to solve the problem. coq-8.20.0/dev/doc/archive/old_svn_branches.txt000066400000000000000000000025011466560755400214210ustar00rootroot00000000000000## During the migration to git, some old branches and tags have not been ## converted to directly visible git branches or tags. They are still there ## in the archive, their names on the gforge repository are in the 3rd ## column below (e.g. remotes/V8-0-bugfix). After a git clone, they ## could always be accessed by their git hashref (2nd column below). # SVN # GIT # Symbolic name on gforge repository r5 d2f789d remotes/tags/start r1714 0605b7c remotes/V7 r2583 372f3f0 remotes/tags/modules-2-branching r2603 6e15d9a remotes/modules r2866 76a93fa remotes/tags/modules-2-before-grammar r2951 356f749 remotes/tags/before-modules r2952 8ee67df remotes/tags/modules-2-update r2956 fb11bd9 remotes/modules-2 r3193 4d23172 remotes/mowgli r3194 c91e99b remotes/tags/mowgli-before-merge r3500 5078d29 remotes/mowgli2 r3672 63b0886 remotes/V7-3-bugfix r5086 bdceb72 remotes/V7-4-bugfix r5731 a274456 remotes/recriture r9046 e19553c remotes/tags/trunk r9146 b38ce05 remotes/coq-diff-tool r9786 a05abf8 remotes/ProofIrrelevance r10294 fdf8871 remotes/InternalExtraction r10408 df97909 remotes/TypeClasses r10673 4e19bca remotes/bertot r11130 bfd1cb3 remotes/proofs r12282 a726b30 remotes/revised-theories r13855 bae3a8e remotes/native r14062 b77191b remotes/recdef r16421 9f4bfa8 remotes/V8-0-bugfix coq-8.20.0/dev/doc/archive/perf-analysis000066400000000000000000000131231466560755400200510ustar00rootroot00000000000000Performance analysis (trunk repository) --------------------------------------- Jun 7, 2010: delayed re-typing of Ltac instances in matching (-1% on HighSchoolGeometry, -2% on JordanCurveTheorem) Jun 4, 2010: improvement in eauto and type classes inference by removing systematic preparation of debugging pretty-printing streams (std_ppcmds) (-7% in ATBR, visible only on V8.3 logs since ATBR is broken in trunk; -6% in HighSchoolGeometry) Apr 19, 2010: small improvement obtained by reducing evar instantiation from O(n^3) to O(n^2) in the size of the instance (-2% in Compcert, -2% AreaMethod, -15% in Ssreflect) Apr 17, 2010: small improvement obtained by not repeating unification twice in auto (-2% in Compcert, -2% in Algebra) Feb 15, 2010: Global decrease due to unicode inefficiency repaired Jan 8, 2010: Global increase due to an inefficiency in unicode treatment Dec 1, 2009 - Dec 19, 2009: Temporary addition of [forall x, P x] hints to exact (generally not significative but, e.g., +25% on Subst, +8% on ZFC, +5% on AreaMethod) Oct 19, 2009: Change in modules (CoLoR +35%) Aug 9, 2009: new files added in AreaMethod May 21, 2008: New version of CoRN (needs +84% more time to compile) Apr 25-29, 2008: Temporary attempt with delta in eauto (Matthieu) (+28% CoRN) Apr 17, 2008: improvement probably due to commit 10807 or 10813 (bug fixes, control of zeta in rewrite, auto (??)) (-18% Buchberger, -40% PAutomata, -28% IntMap, -43% CoRN, -13% LinAlg, but CatsInZFC -0.5% only, PiCalc stable, PersistentUnionFind -1%) Mar 11, 2008: (+19% PersistentUnionFind wrt Mar 3, +21% Angles, +270% Continuations between 7/3 and 18/4) Mar 7, 2008: (-10% PersistentUnionFind wrt Mar 3) Feb 20, 2008: temporary 1-day slow down (+64% LinAlg) Feb 14, 2008: (-10% PersistentUnionFind, -19% Groups) Feb 7, 8, 2008: temporary 2-days long slow down (+20 LinAlg, +50% BDDs) Feb 2, 2008: many updates of the module system (-13% LinAlg, -50% AMM11262, -5% Goedel, -1% PersistentUnionFind, -42% ExactRealArithmetic, -41% Icharate, -42% Kildall, -74% SquareMatrices) Jan 1, 2008: merge of TypeClasses branch (+8% PersistentUnionFind, +36% LinAlg, +76% Goedel) Nov 16, 17, 2007: (+18% Cantor, +4% LinAlg, +27% IEEE1394 on 2 days) Nov 8, 2007: (+18% Cantor, +16% LinAlg, +55% Continuations, +200% IEEE1394, +170% CTLTCTL, +220% SquareMatrices) Oct 29, V8.1 (+ 3% geometry but CoRN, Godel, Kildall, Stalmark stables) Between Oct 12 and Oct 27, 2007: inefficiency temporarily introduced in the tactic interpreter (from revision 10222 to 10267) (+22% CoRN, +10% geometry, ...) Sep 16, 2007: (+16% PersistentUnionFind on 3 days, LinAlg stable, Sep 4, 2007: (+26% PersistentUnionFind, LinAlg stable, Jun 6, 2007: optimization of the need for type unification in with-bindings (-3.5% Stalmark, -6% Kildall) May 20, 21, 22, 2007: improved inference of with-bindings (including activation of unification on types) (+4% PICALC, +5% Stalmark, +7% Kildall) May 11, 2007: added primitive integers (+6% CoLoR, +7% CoRN, +5% FSets, ...) Between Feb 22 and March 16, 2007: bench temporarily moved on JMN's computer (-25% CoRN, -25% Fairisle, ...) Oct 29 and Oct 30, 2006: abandoned attempt to add polymorphism on definitions (+4% in general during these two days) Oct 17, 2006: improvement in new field [r9248] (QArith -3%, geometry: -2%) Oct 5, 2006: fixing wrong unification of Meta below binders (e.g. CatsInZFC: +10%, CoRN: -2.5%, Godel: +4%, LinAlg: +7%, DISTRIBUTED_REFERENCE_COUNTING: +10%, CoLoR: +1%) Sep 26, 2006: new field [r9178-9181] (QArith: -16%, geometry: -5%, Float: +6%, BDDS:+5% but no ring in it) Sep 12, 2006: Rocq/AREA_METHOD extended (~ 530s) Aug 12, 2006: Rocq/AREA_METHOD added (~ 480s) May 30, 2006: Nancy/CoLoR added (~ 319s) May 23, 2006: new, lighter version of polymorphic inductive types (CoRN: -27%, back to Mar-24 time) May 17, 2006: changes in List.v (DISTRIBUTED_REFERENCE_COUNTING: -) May 5, 2006: improvement in closure (array instead of lists) (e.g. CatsInZFC: -10%, CoRN: -3%, May 23, 2006: polymorphic inductive types (precise, heavy algorithm) (CoRN: +37%) Dec 29, 2005: new test and use of -vm in Stalmarck Dec 27, 2005: contrib Karatsuba added (~ 30s) Dec 28, 2005: size decrease mainly due to Defined moved to Qed in FSets (reduction from 95M to 7Mo) Dec 1-14, 2005: benchmarking server down between the two dates: Godel: -10%, CoRN: -10% probably due to changes around vm (new informative Cast, change of equality in named_context_val) Oct 6, 2005: contribs IPC and Tait added (~ 22s and ~ 25s) Aug 19, 2005: time decrease after application of "Array.length x=0" Xavier's suggestions for optimisation (e.g. Nijmegen/QArith: -3%, Nijmegen/CoRN: -7%, Godel: -3%) Aug 1, 2005: contrib Kildall added (~ 65s) Jul 26-Aug 2, 2005: bench down Jul 14-15, 2005: 4 contribs failed including CoRN Jul 14, 2005: time increase after activation of "closure optimisation" (e.g. Nijmegen/QArith: +8%, Nijmegen/CoRN: +3%, Godel: +13%) Jul 7, 2005: adding contrib Fermat4 Jun 17, 2005: contrib Goodstein extended and moved to CantorOrdinals (~ 30s) May 19, 2005: contrib Goodstein and prfx (~ 9s) added Apr 21, 2005: strange time decrease (could it be due to the change of Back and Reset mechanism) (e.g. Nijmegen/CoRN: -2%, Nijmegen/QARITH: -4%, Godel: -11%) Mar 20, 2005: fixed Logic.with_check bug global time decrease (e.g. Nijmegen/CoRN: -3%, Nijmegen/QARITH: -1.5%) Jan 31-Feb 8, 2005: small instability (e.g. CoRN: ~2015s -> ~1999s -> ~2032s, Godel: ~340s -> ~370s) Jan 13, 2005: contrib SumOfTwoSquare added (~ 38s) coq-8.20.0/dev/doc/archive/v8-syntax/000077500000000000000000000000001466560755400172325ustar00rootroot00000000000000coq-8.20.0/dev/doc/archive/v8-syntax/check-grammar000077500000000000000000000022711466560755400216630ustar00rootroot00000000000000#!/bin/sh # This scripts checks that the new grammar of Coq as defined in syntax-v8.tex # is consistent in the sense that all invoked non-terminals are defined defined_nt() { grep "\\DEFNT{.*}" syntax-v8.tex | sed -e "s|.*DEFNT{\([^}]*\)}.*|\1|"|\ sort | sort -u } used_nt() { cat syntax-v8.tex | tr \\\\ \\n | grep "^NT{.*}" |\ sed -e "s|^NT{\([^}]*\)}.*|\1|" | egrep -v ^\#1\|non-terminal | sort -u } used_term() { cat syntax-v8.tex | tr \\\\ \\n | grep "^TERM{.*}" |\ sed -e "s|^TERM{\([^}]*\)}.*|\1|" -e "s|\\$||g" | egrep -v ^\#1\|terminal | sort -u } used_kwd() { cat syntax-v8.tex | tr \\\\ \\n | grep "^KWD{.*}" |\ sed -e "s|^KWD{\([^}]*\)}.*|\1|" -e "s|\\$||g" | egrep -v ^\#1 | sort -u } defined_nt > def used_nt > use used_term > use-t used_kwd > use-k diff def use > df ############################### echo if grep ^\> df > /dev/null 2>&1 ; then echo Undefined non-terminals: echo ======================== echo grep ^\> df | sed -e "s|^> ||" echo fi if grep ^\< df > /dev/null 2>&1 ; then echo Unused non-terminals: echo ===================== echo grep ^\< df | sed -e "s|^< ||" echo fi #echo Used terminals: #echo =============== #echo #cat use-tcoq-8.20.0/dev/doc/archive/v8-syntax/memo-v8.tex000066400000000000000000000230511466560755400212450ustar00rootroot00000000000000 \documentclass{article} \usepackage{verbatim} \usepackage{amsmath} \usepackage{amssymb} \usepackage{array} \usepackage{fullpage} \author{B.~Barras} \title{An introduction to syntax of Coq V8} %% Le _ est un caractère normal \catcode`\_=13 \let\subscr=_ \def_{\ifmmode\sb\else\subscr\fi} \def\NT#1{\langle\textit{#1}\rangle} \def\NTL#1#2{\langle\textit{#1}\rangle_{#2}} \def\TERM#1{\textsf{\bf #1}} \newenvironment{transbox} {\begin{center}\tt\begin{tabular}{l|ll} \hfil\textrm{V7} & \hfil\textrm{V8} \\ \hline} {\end{tabular}\end{center}} \def\TRANS#1#2 {\begin{tabular}[t]{@{}l@{}}#1\end{tabular} & \begin{tabular}[t]{@{}l@{}}#2\end{tabular} \\} \def\TRANSCOM#1#2#3 {\begin{tabular}[t]{@{}l@{}}#1\end{tabular} & \begin{tabular}[t]{@{}l@{}}#2\end{tabular} & #3 \\} \begin{document} \maketitle The goal of this document is to introduce by example to the new syntax of Coq. It is strongly recommended to read first the definition of the new syntax, but this document should also be useful for the eager user who wants to start with the new syntax quickly. \section{Changes in lexical conventions w.r.t. V7} \subsection{Identifiers} The lexical conventions changed: \TERM{_} is not a regular identifier anymore. It is used in terms as a placeholder for subterms to be inferred at type-checking, and in patterns as a non-binding variable. Furthermore, only letters (unicode letters), digits, single quotes and _ are allowed after the first character. \subsection{Quoted string} Quoted strings are used typically to give a filename (which may not be a regular identifier). As before they are written between double quotes ("). Unlike for V7, there is no escape character: characters are written normally but the double quote which is doubled. \section{Main changes in terms w.r.t. V7} \subsection{Precedence of application} In the new syntax, parentheses are not really part of the syntax of application. The precedence of application (10) is tighter than all prefix and infix notations. It makes it possible to remove parentheses in many contexts. \begin{transbox} \TRANS{(A x)->(f x)=(g y)}{A x -> f x = g y} \TRANS{(f [x]x)}{f (fun x => x)} \end{transbox} \subsection{Arithmetics and scopes} The specialized notation for \TERM{Z} and \TERM{R} (introduced by symbols \TERM{`} and \TERM{``}) have disappeared. They have been replaced by the general notion of scope. \begin{center} \begin{tabular}{l|l|l} type & scope name & delimiter \\ \hline types & type_scope & \TERM{T} \\ \TERM{bool} & bool_scope & \\ \TERM{nat} & nat_scope & \TERM{nat} \\ \TERM{Z} & Z_scope & \TERM{Z} \\ \TERM{R} & R_scope & \TERM{R} \\ \TERM{positive} & positive_scope & \TERM{P} \end{tabular} \end{center} In order to use notations of arithmetics on \TERM{Z}, its scope must be opened with command \verb+Open Scope Z_scope.+ Another possibility is using the scope change notation (\TERM{\%}). The latter notation is to be used when notations of several scopes appear in the same expression. In examples below, scope changes are not needed if the appropriate scope has been opened. Scope nat_scope is opened in the initial state of Coq. \begin{transbox} \TRANSCOM{`0+x=x+0`}{0+x=x+0}{\textrm{Z_scope}} \TRANSCOM{``0 + [if b then ``1`` else ``2``]``}{0 + if b then 1 else 2}{\textrm{R_scope}} \TRANSCOM{(0)}{0}{\textrm{nat_scope}} \end{transbox} Below is a table that tells which notation is available in which scope. The relative precedences and associativity of operators is the same as in usual mathematics. See the reference manual for more details. However, it is important to remember that unlike V7, the type operators for product and sum are left associative, in order not to clash with arithmetic operators. \begin{center} \begin{tabular}{l|l} scope & notations \\ \hline nat_scope & $+ ~- ~* ~< ~\leq ~> ~\geq$ \\ Z_scope & $+ ~- ~* ~/ ~\TERM{mod} ~< ~\leq ~> ~\geq ~?=$ \\ R_scope & $+ ~- ~* ~/ ~< ~\leq ~> ~\geq$ \\ type_scope & $* ~+$ \\ bool_scope & $\TERM{\&\&} ~\TERM{$||$} ~\TERM{-}$ \\ list_scope & $\TERM{::} ~\TERM{++}$ \end{tabular} \end{center} (Note: $\leq$ is written \TERM{$<=$}) \subsection{Notation for implicit arguments} The explicitation of arguments is closer to the \emph{bindings} notation in tactics. Argument positions follow the argument names of the head constant. \begin{transbox} \TRANS{f 1!t1 2!t2}{f (x:=t1) (y:=t2)} \TRANS{!f t1 t2}{@f t1 t2} \end{transbox} \subsection{Universal quantification} The universal quantification and dependent product types are now materialized with the \TERM{forall} keyword before the binders and a comma after the binders. The syntax of binders also changed significantly. A binder can simply be a name when its type can be inferred. In other cases, the name and the type of the variable are put between parentheses. When several consecutive variables have the same type, they can be grouped. Finally, if all variables have the same type parentheses can be omitted. \begin{transbox} \TRANS{(x:A)B}{forall (x:~A), B ~~\textrm{or}~~ forall x:~A, B} \TRANS{(x,y:nat)P}{forall (x y :~nat), P ~~\textrm{or}~~ forall x y :~nat, P} \TRANS{(x,y:nat;z:A)P}{forall (x y :~nat) (z:A), P} \TRANS{(x,y,z,t:?)P}{forall x y z t, P} \TRANS{(x,y:nat;z:?)P}{forall (x y :~nat) z, P} \end{transbox} \subsection{Abstraction} The notation for $\lambda$-abstraction follows that of universal quantification. The binders are surrounded by keyword \TERM{fun} and $\Rightarrow$ (\verb+=>+ in ascii). \begin{transbox} \TRANS{[x,y:nat; z](f a b c)}{fun (x y:nat) z => f a b c} \end{transbox} \subsection{Pattern-matching} Beside the usage of the keyword pair \TERM{match}/\TERM{with} instead of \TERM{Cases}/\TERM{of}, the main change is the notation for the type of branches and return type. It is no longer written between \TERM{$<$ $>$} before the \TERM{Cases} keyword, but interleaved with the destructured objects. The idea is that for each destructured object, one may specify a variable name to tell how the branches types depend on this destructured objects (case of a dependent elimination), and also how they depend on the value of the arguments of the inductive type of the destructured objects. The type of branches is then given after the keyword \TERM{return}, unless it can be inferred. Moreover, when the destructured object is a variable, one may use this variable in the return type. \begin{transbox} \TRANS{Cases n of\\~~ O => O \\| (S k) => (1) end}{match n with\\~~ 0 => 0 \\| (S k) => 1 end} \TRANS{Cases m n of \\~~0 0 => t \\| ... end}{match m, n with \\~~0, 0 => t \\| .. end} \TRANS{<[n:nat](P n)>Cases T of ... end}{match T as n return P n with ... end} \TRANS{<[n:nat][p:(even n)]\~{}(odd n)>Cases p of\\~~ ... \\end}{match p in even n return \~{} odd n with\\~~ ...\\end} \end{transbox} \subsection{Fixpoints and cofixpoints} An easier syntax for non-mutual fixpoints is provided, making it very close to the usual notation for non-recursive functions. The decreasing argument is now indicated by an annotation between curly braces, regardless of the binders grouping. The annotation can be omitted if the binders introduce only one variable. The type of the result can be omitted if inferable. \begin{transbox} \TRANS{Fix plus\{plus [n:nat] : nat -> nat :=\\~~ [m]...\}}{fix plus (n m:nat) \{struct n\}: nat := ...} \TRANS{Fix fact\{fact [n:nat]: nat :=\\ ~~Cases n of\\~~~~ O => (1) \\~~| (S k) => (mult n (fact k)) end\}}{fix fact (n:nat) :=\\ ~~match n with \\~~~~0 => 1 \\~~| (S k) => n * fact k end} \end{transbox} There is a syntactic sugar for mutual fixpoints associated to a local definition: \begin{transbox} \TRANS{let f := Fix f \{f [x:A] : T := M\} in\\(g (f y))}{let fix f (x:A) : T := M in\\g (f x)} \end{transbox} The same applies to cofixpoints, annotations are not allowed in that case. \subsection{Notation for type cast} \begin{transbox} \TRANS{O :: nat}{0 : nat} \end{transbox} \section{Main changes in tactics w.r.t. V7} The main change is that all tactic names are lowercase. This also holds for Ltac keywords. \subsection{Ltac} Definitions of macros are introduced by \TERM{Ltac} instead of \TERM{Tactic Definition}, \TERM{Meta Definition} or \TERM{Recursive Definition}. Rules of a match command are not between square brackets anymore. Context (understand a term with a placeholder) instantiation \TERM{inst} became \TERM{context}. Syntax is unified with subterm matching. \begin{transbox} \TRANS{match t with [C[x=y]] => inst C[y=x]}{match t with context C[x=y] => context C[y=x]} \end{transbox} \subsection{Named arguments of theorems} \begin{transbox} \TRANS{Apply thm with x:=t 1:=u}{apply thm with (x:=t) (1:=u)} \end{transbox} \subsection{Occurrences} To avoid ambiguity between a numeric literal and the optional occurrence numbers of this term, the occurrence numbers are put after the term itself. This applies to tactic \TERM{pattern} and also \TERM{unfold} \begin{transbox} \TRANS{Pattern 1 2 (f x) 3 4 d y z}{pattern (f x at 1 2) (d at 3 4) y z} \end{transbox} \section{Main changes in vernacular commands w.r.t. V7} \subsection{Binders} The binders of vernacular commands changed in the same way as those of fixpoints. This also holds for parameters of inductive definitions. \begin{transbox} \TRANS{Definition x [a:A] : T := M}{Definition x (a:A) : T := M} \TRANS{Inductive and [A,B:Prop]: Prop := \\~~conj : A->B->(and A B)}% {Inductive and (A B:Prop): Prop := \\~~conj : A -> B -> and A B} \end{transbox} \subsection{Hints} The syntax of \emph{extern} hints changed: the pattern and the tactic to be applied are separated by a \TERM{$\Rightarrow$}. \begin{transbox} \TRANS{Hint Extern 4 (toto ?) Apply lemma}{Hint Extern 4 (toto _) => apply lemma} \end{transbox} \end{document} coq-8.20.0/dev/doc/archive/v8-syntax/syntax-v8.tex000066400000000000000000001162261466560755400216450ustar00rootroot00000000000000 \documentclass{article} \usepackage{verbatim} \usepackage{amsmath} \usepackage{amssymb} \usepackage{array} \usepackage{fullpage} \author{B.~Barras} \title{Syntax of Coq V8} %% Le _ est un caractère normal \catcode`\_=13 \let\subscr=_ \def_{\ifmmode\sb\else\subscr\fi} \def\bfbar{\ensuremath{|\hskip -0.22em{}|\hskip -0.24em{}|}} \def\TERMbar{\bfbar} \def\TERMbarbar{\bfbar\bfbar} \def\notv{\text{_}} \def\infx#1{\notv#1\notv} %% Macros pour les grammaires \def\GR#1{\text{\large(}#1\text{\large)}} \def\NT#1{\langle\textit{#1}\rangle} \def\NTL#1#2{\langle\textit{#1}\rangle_{#2}} \def\TERM#1{{\bf\textrm{\bf #1}}} %\def\TERM#1{{\bf\textsf{#1}}} \def\KWD#1{\TERM{#1}} \def\ETERM#1{\TERM{#1}} \def\CHAR#1{\TERM{#1}} \def\STAR#1{#1*} \def\STARGR#1{\GR{#1}*} \def\PLUS#1{#1+} \def\PLUSGR#1{\GR{#1}+} \def\OPT#1{#1?} \def\OPTGR#1{\GR{#1}?} %% Tableaux de definition de non-terminaux \newenvironment{cadre} {\begin{array}{|c|}\hline\\} {\\\\\hline\end{array}} \newenvironment{rulebox} {$$\begin{cadre}\begin{array}{r@{~}c@{~}l@{}l@{}r}} {\end{array}\end{cadre}$$} \def\DEFNT#1{\NT{#1} & ::= &} \def\EXTNT#1{\NT{#1} & ::= & ... \\&|&} \def\RNAME#1{(\textsc{#1})} \def\SEPDEF{\\\\} \def\nlsep{\\&|&} \def\nlcont{\\&&} \newenvironment{rules} {\begin{center}\begin{rulebox}} {\end{rulebox}\end{center}} \begin{document} \maketitle \section{Meta notations used in this document} Non-terminals are printed between angle brackets (e.g. $\NT{non-terminal}$) and terminal symbols are printed in bold font (e.g. $\ETERM{terminal}$). Lexemes are displayed as non-terminals. The usual operators on regular expressions: \begin{center} \begin{tabular}{l|l} \hfil notation & \hfil meaning \\ \hline $\STAR{regexp}$ & repeat $regexp$ 0 or more times \\ $\PLUS{regexp}$ & repeat $regexp$ 1 or more times \\ $\OPT{regexp}$ & $regexp$ is optional \\ $regexp_1~\mid~regexp_2$ & alternative \end{tabular} \end{center} Parenthesis are used to group regexps. Beware to distinguish this operator $\GR{~}$ from the terminals $\ETERM{( )}$, and $\mid$ from terminal \TERMbar. Rules are optionally annotated in the right margin with: \begin{itemize} \item a precedence and associativity (L for left, R for right and N for no associativity), indicating how to solve conflicts; lower levels are tighter; \item a rule name. \end{itemize} In order to solve some conflicts, a non-terminal may be invoked with a precedence (notation: $\NTL{entry}{prec}$), meaning that rules with higher precedence do not apply. \section{Lexical conventions} Lexical categories are: \begin{rules} \DEFNT{ident} \STARGR{\NT{letter}\mid\CHAR{_}} \STARGR{\NT{letter}\mid \NT{digit} \mid \CHAR{'} \mid \CHAR{_}} \SEPDEF \DEFNT{field} \CHAR{.}\NT{ident} \SEPDEF \DEFNT{meta-ident} \CHAR{?}\NT{ident} \SEPDEF \DEFNT{num} \PLUS{\NT{digit}} \SEPDEF \DEFNT{int} \NT{num} \mid \CHAR{-}\NT{num} \SEPDEF \DEFNT{digit} \CHAR{0}-\CHAR{9} \SEPDEF \DEFNT{letter} \CHAR{a}-\CHAR{z}\mid\CHAR{A}-\CHAR{Z} \mid\NT{unicode-letter} \SEPDEF \DEFNT{string} \CHAR{"}~\STARGR{\CHAR{""}\mid\NT{unicode-char-but-"}}~\CHAR{"} \end{rules} Reserved identifiers for the core syntax are: \begin{quote} \KWD{as}, \KWD{cofix}, \KWD{else}, \KWD{end}, \KWD{fix}, \KWD{for}, \KWD{forall}, \KWD{fun}, \KWD{if}, \KWD{in}, \KWD{let}, \KWD{match}, \KWD{Prop}, \KWD{return}, \KWD{Set}, \KWD{then}, \KWD{Type}, \KWD{with} \end{quote} Symbols used in the core syntax: $$ \KWD{(} ~~ \KWD{)} ~~ \KWD{\{} ~~ \KWD{\}} ~~ \KWD{:} ~~ \KWD{,} ~~ \Rightarrow ~~ \rightarrow ~~ \KWD{:=} ~~ \KWD{_} ~~ \TERMbar ~~ \KWD{@} ~~ \KWD{\%} ~~ \KWD{.(} $$ Note that \TERM{struct} is not a reserved identifier. \section{Syntax of terms} \subsection{Core syntax} The main entry point of the term grammar is $\NTL{constr}{9}$. When no conflict can appear, $\NTL{constr}{200}$ is also used as entry point. \begin{rules} \DEFNT{constr} \NT{binder-constr} &200R~~ &\RNAME{binders} \nlsep \NT{constr}~\KWD{:}~\NT{constr} &100R &\RNAME{cast} \nlsep \NT{constr}~\KWD{:}~\NT{binder-constr} &100R &\RNAME{cast'} \nlsep \NT{constr}~\KWD{$\rightarrow$}~\NT{constr} &80R &\RNAME{arrow} \nlsep \NT{constr}~\KWD{$\rightarrow$}~\NT{binder-constr} &80R &\RNAME{arrow'} \nlsep \NT{constr}~\PLUS{\NT{appl-arg}} &10L &\RNAME{apply} \nlsep \KWD{@}~\NT{reference}~\STAR{\NTL{constr}{9}} &10L &\RNAME{expl-apply} \nlsep \NT{constr}~\KWD{.(} ~\NT{reference}~\STAR{\NT{appl-arg}}~\TERM{)} &1L & \RNAME{proj} \nlsep \NT{constr}~\KWD{.(}~\TERM{@} ~\NT{reference}~\STAR{\NTL{constr}{9}}~\TERM{)} &1L & \RNAME{expl-proj} \nlsep \NT{constr} ~ \KWD{\%} ~ \NT{ident} &1L &\RNAME{scope-chg} \nlsep \NT{atomic-constr} &0 \nlsep \NT{match-expr} &0 \nlsep \KWD{(}~\NT{constr}~\KWD{)} &0 \SEPDEF \DEFNT{binder-constr} \KWD{forall}~\NT{binder-list}~\KWD{,}~\NTL{constr}{200} &&\RNAME{prod} \nlsep \KWD{fun} ~\NT{binder-list} ~\KWD{$\Rightarrow$}~\NTL{constr}{200} &&\RNAME{lambda} \nlsep \NT{fix-expr} \nlsep \KWD{let}~\NT{ident-with-params} ~\KWD{:=}~\NTL{constr}{200} ~\KWD{in}~\NTL{constr}{200} &&\RNAME{let} \nlsep \KWD{let}~\NT{single-fix} ~\KWD{in}~\NTL{constr}{200} &&\RNAME{rec-let} \nlsep \KWD{let}~\KWD{(}~\OPT{\NT{let-pattern}}~\KWD{)}~\OPT{\NT{return-type}} ~\KWD{:=}~\NTL{constr}{200}~\KWD{in}~\NTL{constr}{200} &&\RNAME{let-case} \nlsep \KWD{if}~\NT{if-item} ~\KWD{then}~\NTL{constr}{200}~\KWD{else}~\NTL{constr}{200} &&\RNAME{if-case} \SEPDEF \DEFNT{appl-arg} \KWD{(}~\NT{ident}~\!\KWD{:=}~\NTL{constr}{200}~\KWD{)} &&\RNAME{impl-arg} \nlsep \KWD{(}~\NT{num}~\!\KWD{:=}~\NTL{constr}{200}~\KWD{)} &&\RNAME{impl-arg} \nlsep \NTL{constr}{9} \SEPDEF \DEFNT{atomic-constr} \NT{reference} && \RNAME{variables} \nlsep \NT{sort} && \RNAME{CIC-sort} \nlsep \NT{num} && \RNAME{number} \nlsep \KWD{_} && \RNAME{hole} \nlsep \NT{meta-ident} && \RNAME{meta/evar} \end{rules} \begin{rules} \DEFNT{ident-with-params} \NT{ident}~\STAR{\NT{binder-let}}~\NT{type-cstr} \SEPDEF \DEFNT{binder-list} \NT{binder}~\STAR{\NT{binder-let}} \nlsep \PLUS{\NT{name}}~\KWD{:}~\NT{constr} \SEPDEF \DEFNT{binder} \NT{name} &&\RNAME{infer} \nlsep \KWD{(}~\PLUS{\NT{name}}~\KWD{:}~\NT{constr} ~\KWD{)} &&\RNAME{binder} \SEPDEF \DEFNT{binder-let} \NT{binder} \nlsep \KWD{(}~\NT{name}~\NT{type-cstr}~\KWD{:=}~\NT{constr}~\KWD{)} \SEPDEF \DEFNT{let-pattern} \NT{name} \nlsep \NT{name} ~\KWD{,} ~\NT{let-pattern} \SEPDEF \DEFNT{type-cstr} \OPTGR{\KWD{:}~\NT{constr}} \SEPDEF \DEFNT{reference} \NT{ident} && \RNAME{short-ident} \nlsep \NT{ident}~\PLUS{\NT{field}} && \RNAME{qualid} \SEPDEF \DEFNT{sort} \KWD{Prop} ~\mid~ \KWD{Set} ~\mid~ \KWD{Type} \SEPDEF \DEFNT{name} \NT{ident} ~\mid~ \KWD{_} \end{rules} \begin{rules} \DEFNT{fix-expr} \NT{single-fix} \nlsep \NT{single-fix}~\PLUSGR{\KWD{with}~\NT{fix-decl}} ~\KWD{for}~\NT{ident} \SEPDEF \DEFNT{single-fix} \NT{fix-kw}~\NT{fix-decl} \SEPDEF \DEFNT{fix-kw} \KWD{fix} ~\mid~ \KWD{cofix} \SEPDEF \DEFNT{fix-decl} \NT{ident}~\STAR{\NT{binder-let}}~\OPT{\NT{annot}}~\NT{type-cstr} ~\KWD{:=}~\NTL{constr}{200} \SEPDEF \DEFNT{annot} \KWD{\{}~\TERM{struct}~\NT{ident}~\KWD{\}} \end{rules} \begin{rules} \DEFNT{match-expr} \KWD{match}~\NT{match-items}~\OPT{\NT{return-type}}~\KWD{with} ~\OPT{\TERMbar}~\OPT{\NT{branches}}~\KWD{end} &&\RNAME{match} \SEPDEF \DEFNT{match-items} \NT{match-item} ~\KWD{,} ~\NT{match-items} \nlsep \NT{match-item} \SEPDEF \DEFNT{match-item} \NTL{constr}{100}~\OPTGR{\KWD{as}~\NT{name}} ~\OPTGR{\KWD{in}~\NTL{constr}{100}} \SEPDEF \DEFNT{return-type} \KWD{return}~\NTL{constr}{100} \SEPDEF \DEFNT{if-item} \NT{constr}~\OPTGR{\OPTGR{\KWD{as}~\NT{name}}~\NT{return-type}} \SEPDEF \DEFNT{branches} \NT{eqn}~\TERMbar~\NT{branches} \nlsep \NT{eqn} \SEPDEF \DEFNT{eqn} \NT{pattern} ~\STARGR{\KWD{,}~\NT{pattern}} ~\KWD{$\Rightarrow$}~\NT{constr} \SEPDEF \DEFNT{pattern} \NT{reference}~\PLUS{\NT{pattern}} &1L~~ & \RNAME{constructor} \nlsep \NT{pattern}~\KWD{as}~\NT{ident} &1L & \RNAME{alias} \nlsep \NT{pattern}~\KWD{\%}~\NT{ident} &1L & \RNAME{scope-change} \nlsep \NT{reference} &0 & \RNAME{pattern-var} \nlsep \KWD{_} &0 & \RNAME{hole} \nlsep \NT{num} &0 \nlsep \KWD{(}~\NT{tuple-pattern}~\KWD{)} \SEPDEF \DEFNT{tuple-pattern} \NT{pattern} \nlsep \NT{tuple-pattern}~\KWD{,}~\NT{pattern} && \RNAME{pair} \end{rules} \subsection{Notations of the prelude (logic and basic arithmetic)} Reserved notations: $$ \begin{array}{l|c} \text{Symbol} & \text{precedence} \\ \hline \infx{,} & 250L \\ \KWD{IF}~\notv~\KWD{then}~\notv~\KWD{else}~\notv & 200R \\ \infx{:} & 100R \\ \infx{\leftrightarrow} & 95N \\ \infx{\rightarrow} & 90R \\ \infx{\vee} & 85R \\ \infx{\wedge} & 80R \\ \tilde{}\notv & 75R \\ \begin{array}[c]{@{}l@{}} \infx{=}\quad \infx{=}\KWD{$:>$}\notv \quad \infx{=}=\notv \quad \infx{\neq} \quad \infx{\neq}\KWD{$:>$}\notv \\ \infx{<}\quad\infx{>} \quad \infx{\leq}\quad\infx{\geq} \quad \infx{<}<\notv \quad \infx{<}\leq\notv \quad \infx{\leq}<\notv \quad \infx{\leq}\leq\notv \end{array} & 70N \\ \infx{+}\quad\infx{-}\quad -\notv & 50L \\ \infx{*}\quad\infx{/}\quad /\notv & 40L \\ \end{array} $$ Existential quantifiers follows the \KWD{forall} notation (with same precedence 200), but only one quantified variable is allowed. \begin{rules} \EXTNT{binder-constr} \NT{quantifier-kwd}~\NT{name}~\NT{type-cstr}~\KWD{,}~\NTL{constr}{200} \\ \SEPDEF \DEFNT{quantifier-kwd} \TERM{exists} && \RNAME{ex} \nlsep \TERM{exists2} && \RNAME{ex2} \end{rules} $$ \begin{array}{l|c|l} \text{Symbol} & \text{precedence} \\ \hline \notv+\{\notv\} & 50 & \RNAME{sumor} \\ \{\notv:\notv~|~\notv\} & 0 & \RNAME{sig} \\ \{\notv:\notv~|~\notv \& \notv \} & 0 & \RNAME{sig2} \\ \{\notv:\notv~\&~\notv \} & 0 & \RNAME{sigS} \\ \{\notv:\notv~\&~\notv \& \notv \} & 0 & \RNAME{sigS2} \\ \{\notv\}+\{\notv\} & 0 & \RNAME{sumbool} \\ \end{array} $$ %% Strange: nat + {x:nat|x=x} * nat == ( + ) * \section{Grammar of tactics} \def\tacconstr{\NTL{constr}{9}} \def\taclconstr{\NTL{constr}{200}} Additional symbols are: $$ \TERM{'} ~~ \KWD{;} ~~ \TERM{()} ~~ \TERMbarbar ~~ \TERM{$\vdash$} ~~ \TERM{[} ~~ \TERM{]} ~~ \TERM{$\leftarrow$} $$ Additional reserved keywords are: $$ \KWD{at} ~~ \TERM{using} $$ \subsection{Basic tactics} \begin{rules} \DEFNT{simple-tactic} \TERM{intros}~\TERM{until}~\NT{quantified-hyp} \nlsep \TERM{intros}~\NT{intro-patterns} \nlsep \TERM{intro}~\OPT{\NT{ident}}~\OPTGR{\TERM{after}~\NT{ident}} %% \nlsep \TERM{assumption} \nlsep \TERM{exact}~\tacconstr %% \nlsep \TERM{apply}~\NT{constr-with-bindings} \nlsep \TERM{elim}~\NT{constr-with-bindings}~\OPT{\NT{eliminator}} \nlsep \TERM{elimtype}~\tacconstr \nlsep \TERM{case}~\NT{constr-with-bindings} \nlsep \TERM{casetype}~\tacconstr \nlsep \KWD{fix}~\OPT{\NT{ident}}~\NT{num} \nlsep \KWD{fix}~\NT{ident}~\NT{num}~\KWD{with}~\PLUS{\NT{fix-spec}} \nlsep \KWD{cofix}~\OPT{\NT{ident}} \nlsep \KWD{cofix}~\NT{ident}~\PLUS{\NT{fix-spec}} %% \nlsep \TERM{cut}~\tacconstr \nlsep \TERM{assert}~\tacconstr \nlsep \TERM{assert}~ \TERM{(}~\NT{ident}~\KWD{:}~\taclconstr~\TERM{)} \nlsep \TERM{assert}~ \TERM{(}~\NT{ident}~\KWD{:=}~\taclconstr~\TERM{)} \nlsep \TERM{pose}~\tacconstr \nlsep \TERM{pose}~ \TERM{(}~\NT{ident}~\KWD{:=}~\taclconstr~\TERM{)} \nlsep \TERM{generalize}~\PLUS{\tacconstr} \nlsep \TERM{generalize}~\TERM{dependent}~\tacconstr \nlsep \TERM{set}~\tacconstr~\OPT{\NT{clause}} \nlsep \TERM{set}~ \TERM{(}~\NT{ident}~\KWD{:=}~\taclconstr~\TERM{)}~\OPT{\NT{clause}} \nlsep \TERM{instantiate}~ \TERM{(}~\NT{num}~\TERM{:=}~\taclconstr~\TERM{)}~\OPT{\NT{clause}} %% \nlsep \TERM{specialize}~\OPT{\NT{num}}~\NT{constr-with-bindings} \nlsep \TERM{lapply}~\tacconstr %% \nlsep \TERM{simple}~\TERM{induction}~\NT{quantified-hyp} \nlsep \TERM{induction}~\NT{induction-arg}~\OPT{\NT{with-names}} ~\OPT{\NT{eliminator}} \nlsep \TERM{double}~\TERM{induction}~\NT{quantified-hyp}~\NT{quantified-hyp} \nlsep \TERM{simple}~\TERM{destruct}~\NT{quantified-hyp} \nlsep \TERM{destruct}~\NT{induction-arg}~\OPT{\NT{with-names}} ~\OPT{\NT{eliminator}} \nlsep \TERM{decompose}~\TERM{record}~\tacconstr \nlsep \TERM{decompose}~\TERM{sum}~\tacconstr \nlsep \TERM{decompose}~\TERM{[}~\PLUS{\NT{reference}}~\TERM{]} ~\tacconstr %% \nlsep ... \end{rules} \begin{rules} \EXTNT{simple-tactic} \TERM{trivial}~\OPT{\NT{hint-bases}} \nlsep \TERM{auto}~\OPT{\NT{num}}~\OPT{\NT{hint-bases}} %% %%\nlsep \TERM{autotdb}~\OPT{\NT{num}} %%\nlsep \TERM{cdhyp}~\NT{ident} %%\nlsep \TERM{dhyp}~\NT{ident} %%\nlsep \TERM{dconcl} %%\nlsep \TERM{superauto}~\NT{auto-args} \nlsep \TERM{auto}~\OPT{\NT{num}}~\TERM{decomp}~\OPT{\NT{num}} %% \nlsep \TERM{clear}~\PLUS{\NT{ident}} \nlsep \TERM{clearbody}~\PLUS{\NT{ident}} \nlsep \TERM{move}~\NT{ident}~\TERM{after}~\NT{ident} \nlsep \TERM{rename}~\NT{ident}~\TERM{into}~\NT{ident} %% \nlsep \TERM{left}~\OPT{\NT{with-binding-list}} \nlsep \TERM{right}~\OPT{\NT{with-binding-list}} \nlsep \TERM{split}~\OPT{\NT{with-binding-list}} \nlsep \TERM{exists}~\OPT{\NT{binding-list}} \nlsep \TERM{constructor}~\NT{num}~\OPT{\NT{with-binding-list}} \nlsep \TERM{constructor}~\OPT{\NT{tactic}} %% \nlsep \TERM{reflexivity} \nlsep \TERM{symmetry}~\OPTGR{\KWD{in}~\NT{ident}} \nlsep \TERM{transitivity}~\tacconstr %% \nlsep \NT{inversion-kwd}~\NT{quantified-hyp}~\OPT{\NT{with-names}}~\OPT{\NT{clause}} \nlsep \TERM{dependent}~\NT{inversion-kwd}~\NT{quantified-hyp} ~\OPT{\NT{with-names}}~\OPTGR{\KWD{with}~\tacconstr} \nlsep \TERM{inversion}~\NT{quantified-hyp}~\TERM{using}~\tacconstr~\OPT{\NT{clause}} %% \nlsep \NT{red-expr}~\OPT{\NT{clause}} \nlsep \TERM{change}~\NT{conversion}~\OPT{\NT{clause}} \SEPDEF \DEFNT{red-expr} \TERM{red} ~\mid~ \TERM{hnf} ~\mid~ \TERM{compute} \nlsep \TERM{simpl}~\OPT{\NT{pattern-occ}} \nlsep \TERM{cbv}~\PLUS{\NT{red-flag}} \nlsep \TERM{lazy}~\PLUS{\NT{red-flag}} \nlsep \TERM{unfold}~\NT{unfold-occ}~\STARGR{\KWD{,}~\NT{unfold-occ}} \nlsep \TERM{fold}~\PLUS{\tacconstr} \nlsep \TERM{pattern}~\NT{pattern-occ}~\STARGR{\KWD{,}~\NT{pattern-occ}} \SEPDEF \DEFNT{conversion} \NT{pattern-occ}~\KWD{with}~\tacconstr \nlsep \tacconstr \SEPDEF \DEFNT{inversion-kwd} \TERM{inversion} ~\mid~ \TERM{invesion_clear} ~\mid~ \TERM{simple}~\TERM{inversion} \end{rules} Conflicts exists between integers and constrs. \begin{rules} \DEFNT{quantified-hyp} \NT{int}~\mid~\NT{ident} \SEPDEF \DEFNT{induction-arg} \NT{int}~\mid~\tacconstr \SEPDEF \DEFNT{fix-spec} \KWD{(}~\NT{ident}~\STAR{\NT{binder}}~\OPT{\NT{annot}} ~\KWD{:}~\taclconstr~\KWD{)} \SEPDEF \DEFNT{intro-patterns} \STAR{\NT{intro-pattern}} \SEPDEF \DEFNT{intro-pattern} \NT{name} \nlsep \TERM{[}~\NT{intro-patterns}~\STARGR{\TERMbar~\NT{intro-patterns}} ~\TERM{]} \nlsep \KWD{(}~\NT{intro-pattern}~\STARGR{\KWD{,}~\NT{intro-pattern}} ~\KWD{)} \SEPDEF \DEFNT{with-names} % \KWD{as}~\TERM{[}~\STAR{\NT{ident}}~\STARGR{\TERMbar~\STAR{\NT{ident}}} % ~\TERM{]} \KWD{as}~\NT{intro-pattern} \SEPDEF \DEFNT{eliminator} \TERM{using}~\NT{constr-with-bindings} \SEPDEF \DEFNT{constr-with-bindings} % dangling ``with'' of ``fix'' can conflict with ``with'' \tacconstr~\OPT{\NT{with-binding-list}} \SEPDEF \DEFNT{with-binding-list} \KWD{with}~\NT{binding-list} \SEPDEF \DEFNT{binding-list} \PLUS{\tacconstr} \nlsep \PLUS{\NT{simple-binding}} \SEPDEF \DEFNT{simple-binding} \KWD{(}~\NT{quantified-hyp}~\KWD{:=}~\taclconstr~\KWD{)} \SEPDEF \DEFNT{red-flag} \TERM{beta} ~\mid~ \TERM{iota} ~\mid~ \TERM{zeta} ~\mid~ \TERM{delta} ~\mid~ \TERM{delta}~\OPT{\TERM{-}}~\TERM{[}~\PLUS{\NT{reference}}~\TERM{]} \SEPDEF \DEFNT{clause} \KWD{in}~\TERM{*} \nlsep \KWD{in}~\TERM{*}~\KWD{$\vdash$}~\OPT{\NT{concl-occ}} \nlsep \KWD{in}~\OPT{\NT{hyp-ident-list}} ~\KWD{$\vdash$} ~\OPT{\NT{concl-occ}} \nlsep \KWD{in}~\OPT{\NT{hyp-ident-list}} \SEPDEF \DEFNT{hyp-ident-list} \NT{hyp-ident} \nlsep \NT{hyp-ident}~\KWD{,}~\NT{hyp-ident-list} \SEPDEF \DEFNT{hyp-ident} \NT{ident} \nlsep \KWD{(}~\TERM{type}~\TERM{of}~\NT{ident}~\KWD{)} \nlsep \KWD{(}~\TERM{value}~\TERM{of}~\NT{ident}~\KWD{)} \SEPDEF \DEFNT{concl-occ} \TERM{*} ~\NT{occurrences} \SEPDEF \DEFNT{pattern-occ} \tacconstr ~\NT{occurrences} \SEPDEF \DEFNT{unfold-occ} \NT{reference}~\NT{occurrences} \SEPDEF \DEFNT{occurrences} ~\OPTGR{\KWD{at}~\PLUS{\NT{int}}} \SEPDEF \DEFNT{hint-bases} \KWD{with}~\TERM{*} \nlsep \KWD{with}~\PLUS{\NT{ident}} \SEPDEF \DEFNT{auto-args} \OPT{\NT{num}}~\OPTGR{\TERM{adding}~\TERM{[}~\PLUS{\NT{reference}} ~\TERM{]}}~\OPT{\TERM{destructuring}}~\OPTGR{\TERM{using}~\TERM{tdb}} \end{rules} \subsection{Ltac} %% Currently, there are conflicts with keyword \KWD{in}: in the following, %% has the keyword to be associated to \KWD{let} or to tactic \TERM{simpl} ? %% \begin{center} %% \texttt{let x := simpl in ...} %% \end{center} \begin{rules} \DEFNT{tactic} \NT{tactic} ~\KWD{;} ~\NT{tactic} &5 &\RNAME{Then} \nlsep \NT{tactic} ~\KWD{;}~\TERM{[} ~\OPT{\NT{tactic-seq}} ~\TERM{]} &5 &\RNAME{Then-seq} %% \nlsep \TERM{try} ~\NT{tactic} &3R &\RNAME{Try} \nlsep \TERM{do} ~\NT{int-or-var} ~\NT{tactic} \nlsep \TERM{repeat} ~\NT{tactic} \nlsep \TERM{progress} ~\NT{tactic} \nlsep \TERM{info} ~\NT{tactic} \nlsep \TERM{abstract}~\NTL{tactic}{2}~\OPTGR{\TERM{using}~\NT{ident}} %% \nlsep \NT{tactic} ~\TERMbarbar ~\NT{tactic} &2R &\RNAME{Orelse} %% \nlsep \KWD{fun} ~\PLUS{\NT{name}} ~\KWD{$\Rightarrow$} ~\NT{tactic} &1 &\RNAME{Fun-tac} \nlsep \KWD{let} ~\NT{let-clauses} ~\KWD{in} ~\NT{tactic} \nlsep \KWD{let} ~\TERM{rec} ~\NT{rec-clauses} ~\KWD{in} ~\NT{tactic} \nlsep \KWD{match}~\OPT{\TERM{reverse}}~\TERM{goal}~\KWD{with} ~\OPT{\TERMbar}~\OPT{\NT{match-goal-rules}} ~\KWD{end} \nlsep \KWD{match} ~\NT{tactic} ~\KWD{with} ~\OPT{\TERMbar}~\OPT{\NT{match-rules}} ~\KWD{end} \nlsep \TERM{first}~\TERM{[} ~\NT{tactic-seq} ~\TERM{]} \nlsep \TERM{solve}~\TERM{[} ~\NT{tactic-seq} ~\TERM{]} \nlsep \TERM{idtac} \nlsep \TERM{fail} ~\OPT{\NT{num}} ~\OPT{\NT{string}} \nlsep \TERM{constr}~\KWD{:}~\tacconstr \nlsep \TERM{ipattern}~\KWD{:}~\NT{intro-pattern} \nlsep \NT{term-ltac} \nlsep \NT{reference}~\STAR{\NT{tactic-arg}} &&\RNAME{call-tactic} \nlsep \NT{simple-tactic} %% \nlsep \NT{tactic-atom} &0 &\RNAME{atomic} \nlsep \KWD{(} ~\NT{tactic} ~\KWD{)} \SEPDEF \DEFNT{tactic-arg} \TERM{ltac}~\KWD{:}~\NTL{tactic}{0} \nlsep \TERM{ipattern}~\KWD{:}~\NT{intro-pattern} \nlsep \NT{term-ltac} \nlsep \NT{tactic-atom} \nlsep \tacconstr \SEPDEF \DEFNT{term-ltac} \TERM{fresh} ~\OPT{\NT{string}} \nlsep \TERM{context} ~\NT{ident} ~\TERM{[} ~\taclconstr ~\TERM{]} \nlsep \TERM{eval} ~\NT{red-expr} ~\KWD{in} ~\tacconstr \nlsep \TERM{type} ~\tacconstr \SEPDEF \DEFNT{tactic-atom} \NT{reference} \nlsep \TERM{()} \SEPDEF \DEFNT{tactic-seq} \NT{tactic} ~\TERMbar ~\NT{tactic-seq} \nlsep \NT{tactic} \end{rules} \begin{rules} \DEFNT{let-clauses} \NT{let-clause} ~\STARGR{\KWD{with}~\NT{let-clause}} \SEPDEF \DEFNT{let-clause} \NT{ident} ~\STAR{\NT{name}} ~\KWD{:=} ~\NT{tactic} \SEPDEF \DEFNT{rec-clauses} \NT{rec-clause} ~\KWD{with} ~\NT{rec-clauses} \nlsep \NT{rec-clause} \SEPDEF \DEFNT{rec-clause} \NT{ident} ~\PLUS{\NT{name}} ~\KWD{:=} ~\NT{tactic} \SEPDEF \DEFNT{match-goal-rules} \NT{match-goal-rule} \nlsep \NT{match-goal-rule} ~\TERMbar ~\NT{match-goal-rules} \SEPDEF \DEFNT{match-goal-rule} \NT{match-hyps-list} ~\TERM{$\vdash$} ~\NT{match-pattern} ~\KWD{$\Rightarrow$} ~\NT{tactic} \nlsep \KWD{[}~\NT{match-hyps-list} ~\TERM{$\vdash$} ~\NT{match-pattern} ~\KWD{]}~\KWD{$\Rightarrow$} ~\NT{tactic} \nlsep \KWD{_} ~\KWD{$\Rightarrow$} ~\NT{tactic} \SEPDEF \DEFNT{match-hyps-list} \NT{match-hyps} ~\KWD{,} ~\NT{match-hyps-list} \nlsep \NT{match-hyps} \SEPDEF \DEFNT{match-hyps} \NT{name} ~\KWD{:} ~\NT{match-pattern} \SEPDEF \DEFNT{match-rules} \NT{match-rule} \nlsep \NT{match-rule} ~\TERMbar ~\NT{match-rules} \SEPDEF \DEFNT{match-rule} \NT{match-pattern} ~\KWD{$\Rightarrow$} ~\NT{tactic} \nlsep \KWD{_} ~\KWD{$\Rightarrow$} ~\NT{tactic} \SEPDEF \DEFNT{match-pattern} \TERM{context}~\OPT{\NT{ident}} ~\TERM{[} ~\NT{constr-pattern} ~\TERM{]} &&\RNAME{subterm} \nlsep \NT{constr-pattern} \SEPDEF \DEFNT{constr-pattern} \tacconstr \end{rules} \subsection{Other tactics} \begin{rules} \EXTNT{simple-tactic} \TERM{rewrite} ~\NT{orient} ~\NT{constr-with-bindings} ~\OPTGR{\KWD{in}~\NT{ident}} \nlsep \TERM{replace} ~\tacconstr ~\KWD{with} ~\tacconstr ~\OPTGR{\KWD{in}~\NT{ident}} \nlsep \TERM{replace} ~\OPT{\NT{orient}} ~\tacconstr ~\OPTGR{\KWD{in}~\NT{ident}} \nlsep \TERM{symplify_eq} ~\OPT{\NT{quantified-hyp}} \nlsep \TERM{discriminate} ~\OPT{\NT{quantified-hyp}} \nlsep \TERM{injection} ~\OPT{\NT{quantified-hyp}} \nlsep \TERM{conditional}~\NT{tactic}~\TERM{rewrite}~\NT{orient} ~\NT{constr-with-bindings}~\OPTGR{\KWD{in}~\NT{ident}} \nlsep \TERM{dependent}~\TERM{rewrite}~\NT{orient}~\NT{ident} \nlsep \TERM{cutrewrite}~\NT{orient}~\tacconstr ~\OPTGR{\KWD{in}~\NT{ident}} \nlsep \TERM{absurd} ~\tacconstr \nlsep \TERM{contradiction} \nlsep \TERM{autorewrite}~\NT{hint-bases}~\OPTGR{\KWD{using}~\NT{tactic}} \nlsep \TERM{refine}~\tacconstr \nlsep \TERM{setoid_replace} ~\tacconstr ~\KWD{with} ~\tacconstr \nlsep \TERM{setoid_rewrite} ~\NT{orient} ~\tacconstr \nlsep \TERM{subst} ~\STAR{\NT{ident}} %% eqdecide.mlg \nlsep \TERM{decide}~\TERM{equality} ~\OPTGR{\tacconstr~\tacconstr} \nlsep \TERM{compare}~\tacconstr~\tacconstr %% eauto \nlsep \TERM{eexact}~\tacconstr \nlsep \TERM{eapply}~\NT{constr-with-bindings} \nlsep \TERM{prolog}~\TERM{[}~\STAR{\tacconstr}~\TERM{]} ~\NT{quantified-hyp} \nlsep \TERM{eauto}~\OPT{\NT{quantified-hyp}}~\OPT{\NT{quantified-hyp}} ~\NT{hint-bases} \nlsep \TERM{eautod}~\OPT{\NT{quantified-hyp}}~\OPT{\NT{quantified-hyp}} ~\NT{hint-bases} %% tauto \nlsep \TERM{tauto} \nlsep \TERM{simplif} \nlsep \TERM{intuition}~\OPT{\NTL{tactic}{0}} \nlsep \TERM{linearintuition}~\OPT{\NT{num}} %% plugins/cc \nlsep \TERM{cc} %% plugins/field \nlsep \TERM{field}~\STAR{\tacconstr} %% plugins/firstorder \nlsep \TERM{ground}~\OPT{\NTL{tactic}{0}} \nlsep \TERM{ground}~\OPT{\NTL{tactic}{0}}~\KWD{with}~\PLUS{\NT{reference}} \nlsep \TERM{ground}~\OPT{\NTL{tactic}{0}}~\KWD{using}~\PLUS{\NT{ident}} %%\nlsep \TERM{gtauto} \nlsep \TERM{gintuition}~\OPT{\NTL{tactic}{0}} %% plugins/fourier \nlsep \TERM{fourierZ} %% plugins/funind \nlsep \TERM{functional}~\TERM{induction}~\tacconstr~\PLUS{\tacconstr} %% plugins/jprover \nlsep \TERM{jp}~\OPT{\NT{num}} %% plugins/omega \nlsep \TERM{omega} %% plugins/ring \nlsep \TERM{quote}~\NT{ident}~\OPTGR{\KWD{[}~\PLUS{\NT{ident}}~\KWD{]}} \nlsep \TERM{ring}~\STAR{\tacconstr} \SEPDEF \DEFNT{orient} \KWD{$\rightarrow$}~\mid~\KWD{$\leftarrow$} \end{rules} \section{Grammar of commands} New symbols: $$ \TERM{.} ~~ \TERM{..} ~~ \TERM{\tt >->} ~~ \TERM{:$>$} ~~ \TERM{$<$:} $$ New keyword: $$ \KWD{where} $$ \subsection{Classification of commands} \begin{rules} \DEFNT{vernac} \TERM{Time}~\NT{vernac} &2~~ &\RNAME{Timing} %% \nlsep \NT{gallina}~\TERM{.} &1 \nlsep \NT{command}~\TERM{.} \nlsep \NT{syntax}~\TERM{.} \nlsep \TERM{[}~\PLUS{\NT{vernac}}~\TERM{]}~\TERM{.} %% \nlsep \OPTGR{\NT{num}~\KWD{:}}~\NT{subgoal-command}~\TERM{.} ~~~&0 \SEPDEF \DEFNT{subgoal-command} \NT{check-command} \nlsep %\OPT{\TERM{By}}~ \NT{tactic}~\OPT{\KWD{..}} \end{rules} \subsection{Gallina and extensions} \begin{rules} \DEFNT{gallina} \NT{thm-token}~\NT{ident}~\STAR{\NT{binder-let}}~\KWD{:}~\NT{constr} \nlsep \NT{def-token}~\NT{ident}~\NT{def-body} \nlsep \NT{assum-token}~\NT{assum-list} \nlsep \NT{finite-token}~\NT{inductive-definition} ~\STARGR{\KWD{with}~\NT{inductive-definition}} \nlsep \TERM{Fixpoint}~\NT{fix-decl}~\STARGR{\KWD{with}~\NT{fix-decl}} \nlsep \TERM{CoFixpoint}~\NT{fix-decl}~\STARGR{\KWD{with}~\NT{fix-decl}} \nlsep \TERM{Scheme}~\NT{scheme}~\STARGR{\KWD{with}~\NT{scheme}} %% Extension: record \nlsep \NT{record-tok}~\OPT{\TERM{$>$}}~\NT{ident}~\STAR{\NT{binder-let}} ~\KWD{:}~\NT{constr}~\KWD{:=} ~\OPT{\NT{ident}}~\KWD{\{}~\NT{field-list}~\KWD{\}} \nlsep \TERM{Ltac}~\NT{ltac-def}~\STARGR{~\TERM{with}~\NT{ltac-def}} \end{rules} \begin{rules} \DEFNT{thm-token} \TERM{Theorem} ~\mid~ \TERM{Lemma} ~\mid~ \TERM{Fact} ~\mid~ \TERM{Remark} \SEPDEF \DEFNT{def-token} \TERM{Definition} ~\mid~ \TERM{Let} ~\mid~ \OPT{\TERM{Local}}~\TERM{SubClass} \SEPDEF \DEFNT{assum-token} \TERM{Hypothesis} ~\mid~ \TERM{Variable} ~\mid~ \TERM{Axiom} ~\mid~ \TERM{Parameter} \SEPDEF \DEFNT{finite-token} \TERM{Inductive} ~\mid~ \TERM{CoInductive} \SEPDEF \DEFNT{record-tok} \TERM{Record} ~\mid~ \TERM{Structure} \end{rules} \begin{rules} \DEFNT{def-body} \STAR{\NT{binder-let}}~\NT{type-cstr}~\KWD{:=} ~\OPT{\NT{reduce}}~\NT{constr} \nlsep \STAR{\NT{binder-let}}~\KWD{:}~\NT{constr} \SEPDEF \DEFNT{reduce} \TERM{Eval}~\NT{red-expr}~\KWD{in} \SEPDEF \DEFNT{ltac-def} \NT{ident}~\STAR{\NT{name}}~\KWD{:=}~\NT{tactic} \SEPDEF \DEFNT{rec-definition} \NT{fix-decl}~\OPT{\NT{decl-notation}} \SEPDEF \DEFNT{inductive-definition} \OPT{\NT{string}}~\NT{ident}~\STAR{\NT{binder-let}}~\KWD{:} ~\NT{constr}~\KWD{:=} ~\OPT{\TERMbar}~\OPT{\NT{constructor-list}} ~\OPT{\NT{decl-notation}} \SEPDEF \DEFNT{constructor-list} \NT{constructor}~\TERMbar~\NT{constructor-list} \nlsep \NT{constructor} \SEPDEF \DEFNT{constructor} \NT{ident}~\STAR{\NT{binder-let}}\OPTGR{\NT{coerce-kwd}~\NT{constr}} \SEPDEF \DEFNT{decl-notation} \TERM{where}~\NT{string}~\TERM{:=}~\NT{constr} \SEPDEF \DEFNT{field-list} \NT{field}~\KWD{;}~\NT{field-list} \nlsep \NT{field} \SEPDEF \DEFNT{field} \NT{ident}~\OPTGR{\NT{coerce-kwd}~\NT{constr}} \nlsep \NT{ident}~\NT{type-cstr-coe}~\KWD{:=}~\NT{constr} \SEPDEF \DEFNT{assum-list} \PLUS{\GR{\KWD{(}~\NT{simple-assum-coe}~\KWD{)}}} \nlsep \NT{simple-assum-coe} \SEPDEF \DEFNT{simple-assum-coe} \PLUS{\NT{ident}}~\NT{coerce-kwd}~\NT{constr} \SEPDEF \DEFNT{coerce-kwd} \TERM{:$>$} ~\mid~ \KWD{:} \SEPDEF \DEFNT{type-cstr-coe} \OPTGR{\NT{coerce-kwd}~\NT{constr}} \SEPDEF \DEFNT{scheme} \NT{ident}~\KWD{:=}~\NT{dep-scheme}~\KWD{for}~\NT{reference} ~\TERM{Sort}~\NT{sort} \SEPDEF \DEFNT{dep-scheme} \TERM{Induction}~\mid~\TERM{Minimality} \end{rules} \subsection{Modules and sections} \begin{rules} \DEFNT{gallina} \TERM{Module}~\NT{ident}~\STAR{\NT{mbinder}}~\OPT{\NT{of-mod-type}} ~\OPTGR{\KWD{:=}~\NT{mod-expr}} \nlsep \TERM{Module}~\KWD{Type}~\NT{ident}~\STAR{\NT{mbinder}} ~\OPTGR{\KWD{:=}~\NT{mod-type}} \nlsep \TERM{Declare}~\TERM{Module}~\NT{ident}~\STAR{\NT{mbinder}} ~\OPT{\NT{of-mod-type}} ~\OPTGR{\KWD{:=}~\NT{mod-expr}} \nlsep \TERM{Section}~\NT{ident} \nlsep \TERM{Chapter}~\NT{ident} \nlsep \TERM{End}~\NT{ident} %% \nlsep \TERM{Require}~\OPT{\NT{export-token}}~\OPT{\NT{specif-token}} ~\PLUS{\NT{reference}} \nlsep \TERM{Require}~\OPT{\NT{export-token}}~\OPT{\NT{specif-token}} ~\NT{string} \nlsep \TERM{Import}~\PLUS{\NT{reference}} \nlsep \TERM{Export}~\PLUS{\NT{reference}} \SEPDEF \DEFNT{export-token} \TERM{Import} ~\mid~ \TERM{Export} \SEPDEF \DEFNT{specif-token} \TERM{Implementation} ~\mid~ \TERM{Specification} \SEPDEF \DEFNT{mod-expr} \NT{reference} \nlsep \NT{mod-expr}~\NT{mod-expr} & L \nlsep \KWD{(}~\NT{mod-expr}~\KWD{)} \SEPDEF \DEFNT{mod-type} \NT{reference} \nlsep \NT{mod-type}~\KWD{with}~\NT{with-declaration} \SEPDEF \DEFNT{with-declaration} %on forcera les ( ) %si exceptionnellemt %un fixpoint ici \TERM{Definition}~\NT{ident}~\KWD{:=}~\NTL{constr}{} %{100} \nlsep \TERM{Module}~\NT{ident}~\KWD{:=}~\NT{reference} \SEPDEF \DEFNT{of-mod-type} \KWD{:}~\NT{mod-type} \nlsep \TERM{$<$:}~\NT{mod-type} \SEPDEF \DEFNT{mbinder} \KWD{(}~\PLUS{\NT{ident}}~\KWD{:}~\NT{mod-type}~\KWD{)} \end{rules} \begin{rules} \DEFNT{gallina} \TERM{Transparent}~\PLUS{\NT{reference}} \nlsep \TERM{Opaque}~\PLUS{\NT{reference}} \nlsep \TERM{Canonical}~\TERM{Structure}~\NT{reference}~\OPT{\NT{def-body}} \nlsep \TERM{Coercion}~\OPT{\TERM{Local}}~\NT{reference}~\NT{def-body} \nlsep \TERM{Coercion}~\OPT{\TERM{Local}}~\NT{reference}~\KWD{:} ~\NT{class-rawexpr}~\TERM{$>->$}~\NT{class-rawexpr} \nlsep \TERM{Identity}~\TERM{Coercion}~\OPT{\TERM{Local}}~\NT{ident}~\KWD{:} ~\NT{class-rawexpr}~\TERM{$>->$}~\NT{class-rawexpr} \nlsep \TERM{Implicit}~\TERM{Arguments}~\NT{reference}~\TERM{[}~\STAR{\NT{num}}~\TERM{]} \nlsep \TERM{Implicit}~\TERM{Arguments}~\NT{reference} \nlsep \TERM{Implicit}~\KWD{Type}~\PLUS{\NT{ident}}~\KWD{:}~\NT{constr} \SEPDEF \DEFNT{command} \TERM{Comments}~\STAR{\NT{comment}} \nlsep \TERM{Pwd} \nlsep \TERM{Cd}~\OPT{\NT{string}} \nlsep \TERM{Drop} ~\mid~ \TERM{ProtectedLoop} ~\mid~\TERM{Quit} %% \nlsep \TERM{Load}~\OPT{\TERM{Verbose}}~\NT{ident} \nlsep \TERM{Load}~\OPT{\TERM{Verbose}}~\NT{string} \nlsep \TERM{Declare}~\TERM{ML}~\TERM{Module}~\PLUS{\NT{string}} \nlsep \TERM{Locate}~\NT{locatable} \nlsep \TERM{Add}~\OPT{\TERM{Rec}}~\TERM{LoadPath}~\NT{string}~\OPT{\NT{as-dirpath}} \nlsep \TERM{Remove}~\TERM{LoadPath}~\NT{string} \nlsep \TERM{Add}~\OPT{\TERM{Rec}}~\TERM{ML}~\TERM{Path}~\NT{string} %% \nlsep \KWD{Type}~\NT{constr} \nlsep \TERM{Print}~\NT{printable} \nlsep \TERM{Print}~\NT{reference} \nlsep \TERM{Inspect}~\NT{num} \nlsep \TERM{About}~\NT{reference} %% \nlsep \TERM{Search}~\NT{reference}~\OPT{\NT{in-out-modules}} \nlsep \TERM{SearchPattern}~\NT{constr-pattern}~\OPT{\NT{in-out-modules}} \nlsep \TERM{SearchRewrite}~\NT{constr-pattern}~\OPT{\NT{in-out-modules}} \nlsep \TERM{SearchAbout}~\NT{reference}~\OPT{\NT{in-out-modules}} \nlsep \TERM{SearchAbout}~\TERM{[}~\STAR{\NT{ref-or-string}}~\TERM{]}\OPT{\NT{in-out-modules}} \nlsep \KWD{Set}~\NT{ident}~\OPT{\NT{opt-value}} \nlsep \TERM{Unset}~\NT{ident} \nlsep \KWD{Set}~\NT{ident}~\NT{ident}~\OPT{\NT{opt-value}} \nlsep \KWD{Set}~\NT{ident}~\NT{ident}~\PLUS{\NT{opt-ref-value}} \nlsep \TERM{Unset}~\NT{ident}~\NT{ident}~\STAR{\NT{opt-ref-value}} %% \nlsep \TERM{Print}~\TERM{Table}~\NT{ident}~\NT{ident} \nlsep \TERM{Print}~\TERM{Table}~\NT{ident} \nlsep \TERM{Add}~\NT{ident}~\OPT{\NT{ident}}~\PLUS{\NT{opt-ref-value}} %% \nlsep \TERM{Test}~\NT{ident}~\OPT{\NT{ident}}~\STAR{\NT{opt-ref-value}} %% \nlsep \TERM{Remove}~\NT{ident}~\OPT{\NT{ident}}~\PLUS{\NT{opt-ref-value}} \SEPDEF \DEFNT{check-command} \TERM{Eval}~\NT{red-expr}~\KWD{in}~\NT{constr} \nlsep \TERM{Check}~\NT{constr} \SEPDEF \DEFNT{ref-or-string} \NT{reference} \nlsep \NT{string} \end{rules} \begin{rules} \DEFNT{printable} \TERM{Term}~\NT{reference} \nlsep \TERM{All} \nlsep \TERM{Section}~\NT{reference} \nlsep \TERM{Grammar}~\NT{ident} \nlsep \TERM{LoadPath} \nlsep \TERM{Module}~\OPT{\KWD{Type}}~\NT{reference} \nlsep \TERM{Modules} \nlsep \TERM{ML}~\TERM{Path} \nlsep \TERM{ML}~\TERM{Modules} \nlsep \TERM{Graph} \nlsep \TERM{Classes} \nlsep \TERM{Coercions} \nlsep \TERM{Coercion}~\TERM{Paths}~\NT{class-rawexpr}~\NT{class-rawexpr} \nlsep \TERM{Tables} % \nlsep \TERM{Proof}~\NT{reference} % Obsolete, useful in V6.3 ?? \nlsep \TERM{Hint}~\OPT{\NT{reference}} \nlsep \TERM{Hint}~\TERM{*} \nlsep \TERM{HintDb}~\NT{ident} \nlsep \TERM{Scopes} \nlsep \TERM{Scope}~\NT{ident} \nlsep \TERM{Visibility}~\OPT{\NT{ident}} \nlsep \TERM{Implicit}~\NT{reference} \SEPDEF \DEFNT{class-rawexpr} \TERM{Funclass}~\mid~\TERM{Sortclass}~\mid~\NT{reference} \SEPDEF \DEFNT{locatable} \NT{reference} \nlsep \TERM{File}~\NT{string} \nlsep \TERM{Library}~\NT{reference} \nlsep \NT{string} \SEPDEF \DEFNT{opt-value} \NT{ident} ~\mid~ \NT{string} \SEPDEF \DEFNT{opt-ref-value} \NT{reference} ~\mid~ \NT{string} \SEPDEF \DEFNT{as-dirpath} \KWD{as}~\NT{reference} \SEPDEF \DEFNT{in-out-modules} \TERM{inside}~\PLUS{\NT{reference}} \nlsep \TERM{outside}~\PLUS{\NT{reference}} \SEPDEF \DEFNT{comment} \NT{constr} \nlsep \NT{string} \end{rules} \subsection{Other commands} %% TODO: min/maj pas a jour \begin{rules} \EXTNT{command} \TERM{Debug}~\TERM{On} \nlsep \TERM{Debug}~\TERM{Off} %% TODO: vernac \nlsep \TERM{Add}~\TERM{setoid}~\tacconstr~\tacconstr~\tacconstr \nlsep \TERM{Add}~\TERM{morphism}~\tacconstr~\KWD{:}~\NT{ident} \nlsep \TERM{Derive}~\TERM{inversion_clear} ~\OPT{\NT{num}}~\NT{ident}~\NT{ident} \nlsep \TERM{Derive}~\TERM{inversion_clear} ~\NT{ident}~\KWD{with}~\tacconstr~\OPTGR{\TERM{Sort}~\NT{sort}} \nlsep \TERM{Derive}~\TERM{inversion} ~\OPT{\NT{num}}~\NT{ident}~\NT{ident} \nlsep \TERM{Derive}~\TERM{inversion} ~\NT{ident}~\KWD{with}~\tacconstr~\OPTGR{\TERM{Sort}~\NT{sort}} \nlsep \TERM{Derive}~\TERM{dependent}~\TERM{inversion_clear} ~\NT{ident}~\KWD{with}~\tacconstr~\OPTGR{\TERM{Sort}~\NT{sort}} \nlsep \TERM{Derive}~\TERM{dependent}~\TERM{inversion} ~\NT{ident}~\KWD{with}~\tacconstr~\OPTGR{\TERM{Sort}~\NT{sort}} %% Correctness: obsolete ? %\nlsep Correctness %\nlsep Global Variable %% TODO: extraction \nlsep Extraction ... %% field \nlsep \TERM{Add}~\TERM{Field}~\tacconstr~\tacconstr~\tacconstr ~\tacconstr~\tacconstr~\tacconstr \nlcont~~~~\tacconstr~\tacconstr~\OPT{\NT{minus-div}} %% funind \nlsep \TERM{Functional}~\TERM{Scheme}~\NT{ident}~\KWD{:=} ~\TERM{Induction}~\KWD{for}~\tacconstr ~\OPTGR{\KWD{with}~\PLUS{\tacconstr}} %% ring \nlsep \TERM{Add}~\TERM{Ring}~\tacconstr~\tacconstr~\tacconstr ~\tacconstr~\tacconstr~\tacconstr \nlcont~~~~\tacconstr~\tacconstr~\KWD{[}~\PLUS{\tacconstr}~\KWD{]} \nlsep \TERM{Add}~\TERM{Semi}~\TERM{Ring}~\tacconstr~\tacconstr~\tacconstr ~\tacconstr~\tacconstr~\tacconstr \nlcont~~~~\tacconstr~\KWD{[}~\PLUS{\tacconstr}~\KWD{]} \nlsep \TERM{Add}~\TERM{Abstract}~\TERM{Ring}~\tacconstr~\tacconstr~\tacconstr ~\tacconstr~\tacconstr~\tacconstr \nlcont~~~~\tacconstr~\tacconstr \nlsep \TERM{Add}~\TERM{Abstract}~\TERM{Semi}~\TERM{Ring}~\tacconstr ~\tacconstr~\tacconstr~\tacconstr~\tacconstr~\tacconstr \nlcont~~~~\tacconstr \nlsep \TERM{Add}~\TERM{Setoid}~\TERM{Ring}~\tacconstr~\tacconstr~\tacconstr ~\tacconstr~\tacconstr~\tacconstr \nlcont~~~~\tacconstr~\tacconstr~\tacconstr~\tacconstr~\tacconstr~\tacconstr ~\tacconstr~\KWD{[}~\PLUS{\tacconstr}~\KWD{]} \nlsep \TERM{Add}~\TERM{Setoid}~\TERM{Semi}~\TERM{Ring}~\tacconstr~\tacconstr ~\tacconstr~\tacconstr~\tacconstr~\tacconstr \nlcont~~~~\tacconstr~\tacconstr~\tacconstr~\tacconstr~\tacconstr ~\KWD{[}~\PLUS{tacconstr}~\KWD{]} \SEPDEF \DEFNT{minus-div} \KWD{with}~\NT{minus-arg}~\NT{div-arg} \nlsep \KWD{with}~\NT{div-arg}~\NT{minus-arg} \SEPDEF \DEFNT{minus-arg} \TERM{minus}~\KWD{:=}~\tacconstr \SEPDEF \DEFNT{div-arg} \TERM{div}~\KWD{:=}~\tacconstr \end{rules} \begin{rules} \EXTNT{command} \TERM{Write}~\TERM{State}~\NT{ident} \nlsep \TERM{Write}~\TERM{State}~\NT{string} \nlsep \TERM{Restore}~\TERM{State}~\NT{ident} \nlsep \TERM{Restore}~\TERM{State}~\NT{string} \nlsep \TERM{Reset}~\NT{ident} \nlsep \TERM{Reset}~\TERM{Initial} \nlsep \TERM{Back}~\OPT{\NT{num}} \end{rules} \subsection{Proof-editing commands} \begin{rules} \EXTNT{command} \TERM{Goal}~\NT{constr} \nlsep \TERM{Proof}~\OPT{\NT{constr}} \nlsep \TERM{Proof}~\KWD{with}~\NT{tactic} \nlsep \TERM{Abort}~\OPT{\TERM{All}} \nlsep \TERM{Abort}~\NT{ident} \nlsep \TERM{Existential}~\NT{num}~\KWD{:=}~\NT{constr-body} \nlsep \TERM{Qed} \nlsep \TERM{Save}~\NT{ident} \nlsep \TERM{Defined}~\OPT{\NT{ident}} \nlsep \TERM{Suspend} \nlsep \TERM{Resume}~\OPT{\NT{ident}} \nlsep \TERM{Restart} \nlsep \TERM{Undo}~\OPT{\NT{num}} \nlsep \TERM{Focus}~\OPT{\NT{num}} \nlsep \TERM{Unfocus} \nlsep \TERM{Show}~\OPT{\NT{num}} \nlsep \TERM{Show}~\TERM{Implicit}~\TERM{Arguments}~\OPT{\NT{num}} \nlsep \TERM{Show}~\TERM{Node} \nlsep \TERM{Show}~\TERM{Existentials} \nlsep \TERM{Show}~\TERM{Tree} \nlsep \TERM{Show}~\TERM{Conjecture} \nlsep \TERM{Show}~\TERM{Proof} \nlsep \TERM{Show}~\TERM{Intro} \nlsep \TERM{Show}~\TERM{Intros} %% Correctness: obsolete ? %%\nlsep \TERM{Show}~\TERM{Programs} \nlsep \TERM{Hint}~\OPT{\TERM{Local}}~\NT{hint}~\OPT{\NT{inbases}} %% PrintConstr not documented \end{rules} \begin{rules} \DEFNT{constr-body} \NT{type-cstr}~\KWD{:=}~\NT{constr} \SEPDEF \DEFNT{hint} \TERM{Resolve}~\PLUS{\NTL{constr}{9}} \nlsep \TERM{Immediate}~\PLUS{\NTL{constr}{9}} \nlsep \TERM{Unfold}~\PLUS{\NT{reference}} \nlsep \TERM{Constructors}~\PLUS{\NT{reference}} \nlsep \TERM{Extern}~\NT{num}~\NT{constr}~\KWD{$\Rightarrow$}~\NT{tactic} \nlsep \TERM{Destruct}~\NT{ident}~\KWD{:=}~\NT{num}~\NT{destruct-loc} ~\NT{constr}~\KWD{$\Rightarrow$}~\NT{tactic} \nlsep \TERM{Rewrite}~\NT{orient}~\PLUS{\NTL{constr}{9}} ~\OPTGR{\KWD{using}~\NT{tactic}} \SEPDEF \DEFNT{inbases} \KWD{:}~\PLUS{\NT{ident}} \SEPDEF \DEFNT{destruct-loc} \TERM{Conclusion} \nlsep \OPT{\TERM{Discardable}}~\TERM{Hypothesis} \end{rules} \subsection{Syntax extensions} \begin{rules} \DEFNT{syntax} \TERM{Open}~\TERM{Scope}~\NT{ident} \nlsep \TERM{Close}~\TERM{Scope}~\NT{ident} \nlsep \TERM{Delimit}~\TERM{Scope}~\NT{ident}~\KWD{with}~\NT{ident} \nlsep \TERM{Bind}~\TERM{Scope}~\NT{ident}~\KWD{with}~\PLUS{\NT{class-rawexpr}} \nlsep \TERM{Arguments}~\TERM{Scope}~\NT{reference} ~\TERM{[}~\PLUS{\NT{name}}~\TERM{]} \nlsep \TERM{Infix}~\OPT{\TERM{Local}} %%% ~\NT{prec}~\OPT{\NT{num}} ~\NT{string}~\KWD{:=}~\NT{reference}~\OPT{\NT{modifiers}} ~\OPT{\NT{in-scope}} \nlsep \TERM{Notation}~\OPT{\TERM{Local}}~\NT{string}~\KWD{:=}~\NT{constr} ~\OPT{\NT{modifiers}}~\OPT{\NT{in-scope}} \nlsep \TERM{Notation}~\OPT{\TERM{Local}}~\NT{ident}~\KWD{:=}~\NT{constr} ~\OPT{\KWD{(}\TERM{only~\TERM{parsing}\KWD{)}}} \nlsep \TERM{Reserved}~\TERM{Notation}~\OPT{\TERM{Local}}~\NT{string} ~\OPT{\NT{modifiers}} \nlsep \TERM{Tactic}~\TERM{Notation}~\NT{string}~\STAR{\NT{tac-production}} ~\KWD{:=}~\NT{tactic} \SEPDEF \DEFNT{modifiers} \KWD{(}~\NT{mod-list}~\KWD{)} \SEPDEF \DEFNT{mod-list} \NT{modifier} \nlsep \NT{modifier}~\KWD{,}~\NT{mod-list} \SEPDEF \DEFNT{modifier} \NT{ident}~\KWD{at}~\NT{num} \nlsep \NT{ident}~\STARGR{\KWD{,}~\NT{ident}}~\KWD{at}~\NT{num} \nlsep \KWD{at}~\TERM{next}~\TERM{level} \nlsep \KWD{at}~\TERM{level}~\NT{num} \nlsep \TERM{left}~\TERM{associativity} \nlsep \TERM{right}~\TERM{associativity} \nlsep \TERM{no}~\TERM{associativity} \nlsep \NT{ident}~\NT{syntax-entry} \nlsep \TERM{only}~\TERM{parsing} \nlsep \TERM{format}~\NT{string} \SEPDEF \DEFNT{in-scope} \KWD{:}~\NT{ident} \SEPDEF \DEFNT{syntax-entry} \TERM{ident}~\mid~\TERM{global}~\mid~\TERM{bigint} \SEPDEF \DEFNT{tac-production} \NT{string} \nlsep \NT{ident}~\TERM{(}~\NT{ident}~\TERM{)} %%% \SEPDEF %%% \DEFNT{prec} %%% \TERM{LeftA}~\mid~\TERM{RightA}~\mid~\TERM{NonA} \end{rules} \end{document} coq-8.20.0/dev/doc/archive/versions-history.tex000066400000000000000000000347361466560755400214570ustar00rootroot00000000000000\documentclass[a4paper]{book} \usepackage{fullpage} \usepackage[utf8]{inputenc} \usepackage[T1]{fontenc} \usepackage{amsfonts} \newcommand{\feature}[1]{{\em #1}} \begin{document} \begin{center} \begin{huge} A history of Coq versions \end{huge} \end{center} \bigskip \centerline{\large 1984-1989: The Calculus of Constructions} \bigskip \centerline{\large (see README.V1-V5 for details)} \mbox{}\\ \mbox{}\\ \begin{tabular}{l|l|l} version & date & comments \\ \hline CONSTR V1.10& mention of dates from 6 December & \feature{type-checker for Coquand's Calculus }\\ & 1984 to 13 February 1985 & \feature{of Constructions}, implementation \\ & frozen 22 December 1984 & language is a predecessor of CAML\\ CONSTR V1.11& mention of dates from 6 December\\ & 1984 to 19 February 1985 (freeze date) &\\ CoC V2.8& dated 16 December 1985 (freeze date)\\ CoC V2.9& & \feature{cumulative hierarchy of universes}\\ CoC V2.13& dated 25 June 1986 (freeze date)\\ CoC V3.1& started summer 1986 & \feature{AUTO tactic}\\ & dated 20 November 1986 & implementation language now named CAML\\ CoC V3.2& dated 27 November 1986\\ CoC V3.3& dated 1 January 1987 & creation of a directory for examples\\ CoC V3.4& dated 1 January 1987 & \feature{lambda and product distinguished in the syntax}\\ CoC V4.1& dated 24 July 1987 (freeze date)\\ CoC V4.2& dated 10 September 1987\\ CoC V4.3& dated 15 September 1987 & \feature{mathematical vernacular toplevel}\\ & frozen November 1987 & \feature{section mechanism}\\ & & \feature{logical vs computational content (sorte Spec)}\\ & & \feature{LCF engine}\\ CoC V4.4& dated 27 January 1988 & \feature{impredicatively encoded inductive types}\\ & frozen March 1988\\ CoC V4.5 and V4.5.5& dated 15 March 1988 & \feature{program extraction}\\ & demonstrated in June 1988\\ CoC V4.6& dated 1 September 1988 & start of LEGO fork\\ CoC V4.7& started 6 September 1988 \\ CoC V4.8& dated 1 December 1988 (release time) & \feature{floating universes}\\ CoC V4.8.5& dated 1 February 1989 & \\ CoC V4.9& dated 1 March 1989 (release date)\\ CoC V4.10 and 4.10.1& dated 1 May 1989 & released with documentation in English\\ \end{tabular} \bigskip \noindent Note: CoC above stands as an abbreviation for {\em Calculus of Constructions}, official name of the system. \bigskip \bigskip \newpage \centerline{\large 1989-now: The Calculus of Inductive Constructions} \mbox{}\\ \centerline{I- RCS archives in Caml and Caml-Light} \mbox{}\\ \mbox{}\\ \begin{tabular}{l|l|l} version & date & comments \\ \hline Coq V5.0 & headers dated 1 January 1990 & internal use \\ & & \feature{inductive types with primitive recursor}\\ Coq V5.1 & ended 12 July 1990 & internal use \\ Coq V5.2 & log dated 4 October 1990 & internal use \\ Coq V5.3 & log dated 12 October 1990 & internal use \\ Coq V5.4 & headers dated 24 October 1990 & internal use, new \feature{extraction} (version 1) [3-12-90]\\ Coq V5.5 & started 6 December 1990 & internal use \\ Coq V5.6 beta & 1991 & first announce of the new Coq based on CIC \\ & & (in May at TYPES?)\\ & & \feature{rewrite tactic}\\ & & use of RCS at least from February 1991\\ Coq V5.6& 7 August 1991 & \\ Coq V5.6 patch 1& 13 November 1991 & \\ Coq V5.6 (last) & mention of 27 November 1992\\ Coq V5.7.0& 1992 & translation to Caml-Light \footnotemark\\ Coq V5.8& 12 February 1993 & \feature{Program} (version 1), \feature{simpl}\\ & & has the xcoq graphical interface\\ & & first explicit notion of standard library\\ & & includes a MacOS 7-9 version\\ Coq V5.8.1& released 28 April 1993 & with xcoq graphical interface and MacOS 7-9 support\\ Coq V5.8.2& released 9 July 1993 & with xcoq graphical interface and MacOS 7-9 support\\ Coq V5.8.3& released 6 December 1993 % Announce on coq-club & with xcoq graphical interface and MacOS 7-9 support\\ & & 3 branches: Lyon (V5.8.x), Ulm (V5.10.x) and Rocq (V5.9)\\ Coq V5.9 alpha& 7 July 1993 & experimental version based on evars refinement \\ & & (merge from experimental ``V6.0'' and some pre-V5.8.3 \\ & & version), not released\\ & March 1994 & \feature{tauto} tactic in V5.9 branch\\ Coq V5.9 & 27 January 1993 & experimental version based on evars refinement\\ & & not released\\ \end{tabular} \bigskip \bigskip \footnotetext{archive lost?} \newpage \centerline{II- Starting with CVS archives in Caml-Light} \mbox{}\\ \mbox{}\\ \begin{tabular}{l|l|l} version & date & comments \\ \hline Coq V5.10 ``Murthy'' & 22 January 1994 & introduction of the ``DOPN'' structure\\ & & \feature{eapply/prolog} tactics\\ & & private use of cvs on madiran.inria.fr\\ Coq V5.10.1 ``Murthy''& 15 April 1994 \\ Coq V5.10.2 ``Murthy''& 19 April 1994 & \feature{mutual inductive types, fixpoint} (from Lyon's branch)\\ Coq V5.10.3& 28 April 1994 \\ Coq V5.10.5& dated 13 May 1994 & \feature{inversion}, \feature{discriminate}, \feature{injection} \\ & & \feature{type synthesis of hidden arguments}\\ & & \feature{separate compilation}, \feature{reset mechanism} \\ Coq V5.10.6& dated 30 May 1994\\ Coq Lyon's archive & in 1994 & cvs server set up on woodstock.ens-lyon.fr\\ Coq V5.10.9& announced on 17 August 1994 & % Announced by Catherine Parent on coqdev % Version avec une copie de THEORIES pour les inductifs mutuels \\ Coq V5.10.11& announced on 2 February 1995 & \feature{compute}\\ Coq Rocq's archive & on 16 February 1995 & set up of ``V5.10'' cvs archive on pauillac.inria.fr \\ & & with first dispatch of files over src/* directories\\ Coq V5.10.12& dated 30 January 1995 & on Lyon's cvs\\ Coq V5.10.13& dated 9 June 1995 & on Lyon's cvs\\ Coq V5.10.14.OO& dated 30 June 1995 & on Lyon's cvs\\ Coq V5.10.14.a& announced 5 September 1995 & bug-fix release \\ % Announce on coq-club by BW Coq V5.10.14.b& released 2 October 1995 & bug-fix release\\ & & MS-DOS version released on 30 October 1995\\ % still available at ftp://ftp.ens-lyon.fr/pub/LIP/COQ/V5.10.14.old/ in May 2009 % also known in /net/pauillac/constr archive as ``V5.11 old'' \\ % A copy of Coq V5.10.15 dated 1 January 1996 coming from Lyon's CVS is % known in /net/pauillac/constr archive as ``V5.11 new old'' \\ Coq V5.10.15 & released 20 February 1996 & \feature{Logic, Sorting, new Sets and Relations libraries} \\ % Announce on coq-club by BW % dated 15 February 1996 and bound to pauillac's cvs in /net/pauillac/constr archive & & MacOS 7-9 version released on 1 March 1996 \\ % Announce on coq-club by BW Coq V5.11 & dated 1 March 1996 & not released, not in pauillac's CVS, \feature{eauto} \\ \end{tabular} \bigskip \bigskip \newpage \centerline{III- A CVS archive in Caml Special Light} \mbox{}\\ \mbox{}\\ \begin{tabular}{l|l|l} version & date & comments \\ \hline Coq ``V6'' archive & 20 March 1996 & new cvs repository on pauillac.inria.fr with code ported \\ & & to Caml Special Light (to later become Objective Caml)\\ & & has implicit arguments and coercions\\ & & has coinductive types\\ Coq V6.1beta& released 18 November 1996 & \feature{coercions} [23-5-1996], \feature{user-level implicit arguments} [23-5-1996]\\ & & \feature{omega} [10-9-1996] \\ & & \feature{natural language proof printing} (stopped from Coq V7) [6-9-1996]\\ & & \feature{pattern-matching compilation} [7-10-1996]\\ & & \feature{ring} (version 1, ACSimpl) [11-12-1996]\\ Coq V6.1& released December 1996 & \\ Coq V6.2beta& released 30 January 1998 & % Announced on coq-club 2-2-1998 by CP \feature{SearchIsos} (stopped from Coq V7) [9-11-1997]\\ & & grammar extension mechanism moved to Camlp4 [12-6-1997]\\ & & \feature{refine tactic}\\ & & includes a Windows version\\ Coq V6.2& released 4 May 1998 & % Announced on coq-club 5-5-1998 by CP \feature{ring} (version 2) [7-4-1998] \\ Coq V6.2.1& released 23 July 1998\\ Coq V6.2.2 beta& released 30 January 1998\\ Coq V6.2.2& released 23 September 1998\\ Coq V6.2.3& released 22 December 1998 & \feature{Real numbers library} [from 13-11-1998] \\ Coq V6.2.4& released 8 February 1999\\ Coq V6.3& released 27 July 1999 & \feature{autorewrite} [25-3-1999]\\ & & \feature{Correctness} (deprecated in V8, led to Why) [28-10-1997]\\ Coq V6.3.1& released 7 December 1999\\ \end{tabular} \medskip \bigskip \newpage \centerline{IV- New CVS, back to a kernel-centric implementation} \mbox{}\\ \mbox{}\\ \begin{tabular}{l|l|l} version & date & comments \\ \hline Coq ``V7'' archive & August 1999 & new cvs archive based on J.-C. Filliâtre's \\ & & \feature{kernel-centric} architecture \\ & & more care for outside readers\\ & & (indentation, ocaml warning protection)\\ Coq V7.0beta& released 27 December 2000 & \feature{${\mathcal{L}}_{\mathit{tac}}$} \\ Coq V7.0beta2& released 2 February 2001\\ Coq V7.0& released 25 April 2001 & \feature{extraction} (version 2) [6-2-2001] \\ & & \feature{field} (version 1) [19-4-2001], \feature{fourier} [20-4-2001] \\ Coq V7.1& released 25 September 2001 & \feature{setoid rewriting} (version 1) [10-7-2001]\\ Coq V7.2& released 10 January 2002\\ Coq V7.3& released 16 May 2002\\ Coq V7.3.1& released 5 October 2002 & \feature{module system} [2-8-2002]\\ & & \feature{pattern-matching compilation} (version 2) [13-6-2002]\\ Coq V7.4& released 6 February 2003 & \feature{notation}, \feature{scopes} [13-10-2002]\\ \end{tabular} \medskip \bigskip \centerline{V- New concrete syntax} \mbox{}\\ \mbox{}\\ \begin{tabular}{l|l|l} version & date & comments \\ \hline Coq V8.0& released 21 April 2004 & \feature{new concrete syntax}, \feature{Set predicative}, \feature{CoqIDE} [from 4-2-2003]\\ Coq V8.0pl1& released 18 July 2004\\ Coq V8.0pl2& released 22 January 2005\\ Coq V8.0pl3& released 13 January 2006\\ Coq V8.0pl4& released 26 January 2007\\ Coq ``svn'' archive & 6 March 2006 & cvs archive moved to subversion control management\\ Coq V8.1beta& released 12 July 2006 & \feature{bytecode compiler} [20-10-2004] \\ & & \feature{setoid rewriting} (version 2) [3-9-2004]\\ & & \feature{functional induction} [1-2-2006]\\ & & \feature{Strings library} [8-2-2006], \feature{FSets/FMaps library} [15-3-2006] \\ & & \feature{Program} (version 2, Russell) [5-3-2006] \\ & & \feature{declarative language} [20-9-2006]\\ & & \feature{ring} (version 3) [18-11-2005]\\ Coq V8.1gamma& released 7 November 2006 & \feature{field} (version 2) [29-9-2006]\\ Coq V8.1& released 10 February 2007 & \\ Coq V8.1pl1& released 27 July 2007 & \\ Coq V8.1pl2& released 13 October 2007 & \\ Coq V8.1pl3& released 13 December 2007 & \\ Coq V8.1pl4& released 9 October 2008 & \\ Coq V8.2 beta1& released 13 June 2008 & \\ Coq V8.2 beta2& released 19 June 2008 & \\ Coq V8.2 beta3& released 27 June 2008 & \\ Coq V8.2 beta4& released 8 August 2008 & \\ Coq V8.2 & released 17 February 2009 & \feature{type classes} [10-12-2007], \feature{machine words} [11-5-2007]\\ & & \feature{big integers} [11-5-2007], \feature{abstract arithmetics} [9-2007]\\ & & \feature{setoid rewriting} (version 3) [18-12-2007] \\ & & \feature{micromega solving platform} [19-5-2008]\\ & & a first package released on February 11 was incomplete\\ Coq V8.2pl1& released 4 July 2009 & \\ Coq V8.2pl2& released 29 June 2010 & \\ \end{tabular} \medskip \bigskip \newpage \mbox{}\\ \mbox{}\\ \begin{tabular}{l|l|l} Coq V8.3 beta & released 16 February 2010 & \feature{MSets library} [13-10-2009] \\ Coq V8.3 & released 14 October 2010 & \feature{nsatz} [3-6-2010] \\ Coq V8.3pl1& released 23 December 2010 & \\ Coq V8.3pl2& released 19 April 2011 & \\ Coq V8.3pl3& released 19 December 2011 & \\ Coq V8.3pl3& released 26 March 2012 & \\ Coq V8.3pl5& released 28 September 2012 & \\ Coq V8.4 beta & released 27 December 2011 & \feature{modular arithmetic library} [2010-2012]\\ && \feature{vector library} [10-12-2010]\\ && \feature{structured scripts} [22-4-2010]\\ && \feature{eta-conversion} [20-9-2010]\\ && \feature{new proof engine available} [10-12-2010]\\ Coq V8.4 beta2 & released 21 May 2012 & \\ Coq V8.4 & released 12 August 2012 &\\ Coq V8.4pl1& released 22 December 2012 & \\ Coq V8.4pl2& released 4 April 2013 & \\ Coq V8.4pl3& released 21 December 2013 & \\ Coq V8.4pl4& released 24 April 2014 & \\ Coq V8.4pl5& released 22 October 2014 & \\ Coq V8.4pl6& released 9 April 2015 & \\ Coq V8.5 beta1 & released 21 January 2015 & \feature{computation via compilation to OCaml} [22-1-2013]\\ && \feature{asynchronous evaluation} [8-8-2013]\\ && \feature{new proof engine deployed} [2-11-2013]\\ && \feature{universe polymorphism} [6-5-2014]\\ && \feature{primitive projections} [6-5-2014]\\ && \feature{miscellaneous optimizations}\\ Coq V8.5 beta2 & released 22 April 2015 & \feature{MMaps library} [4-3-2015]\\ Coq V8.5 & released 22 January 2016 & \\ Coq V8.6 beta 1 & released 19 November 2016 & \feature{irrefutable patterns} [15-2-2016]\\ && \feature{Ltac profiling} [14-6-2016]\\ && \feature{warning system} [29-6-2016]\\ && \feature{miscellaneous optimizations}\\ Coq V8.6 & released 14 December 2016 & \\ Coq V8.7 beta 1 & released 6 September 2017 & \feature{bundled with Ssreflect plugin} [6-6-2017]\\ && \feature{cumulative polymorphic inductive types} [19-6-2017]\\ && \feature{further optimizations}\\ Coq V8.7 beta 2 & released 6 October 2017 & \\ Coq V8.7.0 & released 18 October 2017 & \\ Coq V8.7.1 & released 15 December 2017 & \\ Coq V8.7.2 & released 17 February 2018 & \\ Coq V8.8 beta1 & released 19 March 2018 & \\ Coq V8.8.0 & released 17 April 2018 & \feature{reference manual moved to Sphinx} \\ && \feature{effort towards better documented, better structured ML API}\\ && \feature{miscellaneous changes/improvements of existing features}\\ \end{tabular} \medskip \bigskip \newpage \centerline{\large Other important dates} \mbox{}\\ \mbox{}\\ \begin{tabular}{l|l|l} version & date & comments \\ \hline Lechenadec's version in C& mention of \\ & 13 January 1985 on \\ & some vernacular files\\ Set up of the coq-club mailing list & 28 July 1993\\ Coq V6.0 ``evars'' & & experimentation based on evars refinement started \\ & & in 1991 by Gilles from V5.6 beta,\\ & & with work by Hugo in July 1992\\ Coq V6.0 ``evars'' ``light'' & July 1993 & Hugo's port of the first evars-based experimentation \\ & & to Coq V5.7, version from October/November 1992\\ CtCoq & released 25 October 1995 & first beta-version \\ % Announce on coq-club by Janet Proto with explicit substitutions & 1997 &\\ Coq web site & 15 April 1998 & new site designed by David Delahaye \\ Coq web site & January 2004 & web site new style \\ & & designed by Julien Narboux and Florent Kirchner \\ Coq web site & April 2009 & new Drupal-based site \\ & & designed by Jean-Marc Notin and Denis Cousineau \\ \end{tabular} \end{document} coq-8.20.0/dev/doc/archive/whodidwhat/000077500000000000000000000000001466560755400175135ustar00rootroot00000000000000coq-8.20.0/dev/doc/archive/whodidwhat/whodidwhat-8.2update.tex000066400000000000000000000316601466560755400241150ustar00rootroot00000000000000\documentclass{article} \usepackage{fullpage} \usepackage[utf8]{inputenc} \usepackage{t1enc} \begin{document} \title{Who did what in the Coq archive?} \author{The Coq development team} \maketitle \centerline{(updated for Coq 8.2)} \section{The Calculus of Inductive Constructions} \begin{itemize} \item The Calculus of Constructions \begin{itemize} \item Core type-checker: Gérard Huet and Thierry Coquand with optimizations by Chet Murthy, Bruno Barras \item Head reduction functions: Gérard Huet, Christine Paulin, Bruno Barras \end{itemize} \item Conversion and reduction \begin{itemize} \item Lazy conversion machine: Bruno Barras \item Transparency/opacity: Bruno Barras \item Bytecode-based conversion: Benjamin Grégoire \item Binary-words retroknowledge: Arnaud Spiwack \end{itemize} \item The universe hierarchy \begin{itemize} \item Floating universes: Gérard Huet, with contributions from Bruno Barras \item Algebraic universes: Hugo Herbelin \end{itemize} \item Mutual inductive types and recursive definitions \begin{itemize} \item Type-checking: Christine Paulin \item Positivity condition: Christine Paulin \item Guardness condition for fixpoints: Christine Paulin; extensions by Eduardo Gimenez and Bruno Barras \item Recursively non-uniform parameters: Christine Paulin \item Sort-polymorphism of inductive types: Hugo Herbelin \end{itemize} \item Local definitions: Hugo Herbelin \item Mutual coinductive types and corecursive definitions: Eduardo Gimenez \item Module system \begin{itemize} \item Core system: Jacek Chrz\k{a}szcz \item Inlining: Claudio Sacerdoti Coen and Élie Soubiran \item Module inclusion: Élie Soubiran \item Functorial signature application: Élie Soubiran \item Transparent name space: Élie Soubiran \item Resolution of qualified names: Hugo Herbelin \end{itemize} \item Minimalist stand-alone type-checker (\texttt{coqchk}): Bruno Barras \end{itemize} \section{Specification language} \begin{itemize} \item Sections: Gilles Dowek with extra contributions by Gérard Huet, Chet Murthy, Hugo Herbelin \item The \texttt{Russell} specifications language, proof obligations (\texttt{Program}): Matthieu Sozeau \item Type inference: Chet Murthy, with extra contributions by Bruno Barras, Hugo Herbelin and Matthieu Sozeau \item Pattern-matching: Hugo Herbelin on top of a first version by Cristina Cornes \item Implicit arguments: Amokrane Saïbi, with extensions by Hugo Herbelin and Matthieu Sozeau \item Coercions: Amokrane Saïbi \item Records: Amokrane Saïbi with extensions by Arnaud Spiwack and Matthieu Sozeau \item Canonical structures: Amokrane Saïbi \item Type classes: Matthieu Sozeau \item Functional schemes (\texttt{Function}, \texttt{Functional Scheme}, ...): Julien Forest and Pierre Courtieu (preliminary version by Yves Bertot) \item Generation of induction schemes: Christine Paulin, Vincent Siles, Matthieu Sozeau \end{itemize} \section{Tactics} \subsection{General tactic support} \begin{itemize} \item Proof engine: Chet Murthy (first version by Thierry Coquand) \item Ltac: David Delahaye, with extensions by Hugo Herbelin, Bruno Barras, ... \item Tactic notations: Hugo Herbelin (first version by Chet Murthy) \item Main tactic unification procedure: Chet Murthy with contributions from Hugo Herbelin and Matthieu Sozeau \item Mathematical-style language (C-Zar): Pierre Corbineau \item Communication with external tools (\texttt{external}): Hugo Herbelin \end{itemize} \subsection{Predefined tactics} \begin{itemize} \item Basic tactics (\texttt{intro}, \texttt{apply}, \texttt{assumption}, \texttt{exact}): Thierry Coquand, with further collective extensions \item Reduction tactics: Christine Paulin (\texttt{simpl}), Bruno Barras (\texttt{cbv}, \texttt{lazy}), ... \item Tacticals: Thierry Coquand, Chet Murthy, Eduardo Gimenez, ... \item Induction: Christine Paulin (\texttt{elim}, \texttt{case}), Hugo Herbelin (\texttt{induction}, \texttt{destruct} \item Refinement (\texttt{refine}): Jean-Christophe Filliâtre \item Introduction patterns: Eduardo Gimenez with collective extensions \item Forward reasoning: Hugo Herbelin (\texttt{assert}, \texttt{apply in}), Pierre Letouzey (\texttt{specialize}, initial version by Amy Felty) \item Rewriting tactics (\texttt{rewrite}): basic version by Christine Paulin, extensions by Jean-Christophe Filliâtre and Pierre Letouzey \item Tactics about equivalence properties (\texttt{reflexivity}, \texttt{symmetry}, \texttt{transitivity}): Christine Paulin (?), \item Equality tactics (\texttt{injection}/\texttt{discriminate}): Cristina Cornes \item Inversion tactics (\texttt{inversion}): Cristina Cornes, Chet Murthy \item Setoid rewriting: Matthieu Sozeau (first version by Clément Renard, second version by Claudio Sacerdoti Coen), contributions from Nicolas Tabareau \item Decision of equality: Eduardo Gimenez \item Basic Ltac-level tactics: Pierre Letouzey, Matthieu Sozeau, Evgeny Makarov \end{itemize} \subsection{General automation tactics} \begin{itemize} \item Resolution (\texttt{auto}, \texttt{trivial}): Christine Paulin with extensions from Chet Murthy, Eduardo Gimenez, Patrick Loiseleur (hint bases), Matthieu Sozeau \item Resolution with existential variables (\texttt{eauto}): Chet Murthy, Jean-Christophe Filliâtre, with extensions from Matthieu Sozeau \item Automatic rewriting (\texttt{autorewrite}): David Delahaye \end{itemize} \subsection{Domain-specific decision tactics} \begin{itemize} \item Congruence closure (\texttt{cc}): Pierre Corbineau \item Decision of first-order logic (\texttt{firstorder}): Pierre Corbineau \item Simplification of polynomial fractions (\texttt{field}): Laurent Théry and Benjamin Grégoire (first version by David Delahaye and Micaela Mayero) \item Simplification of polynomial expressions (\texttt{ring}): Assia Mahboubi, Bruno Barras and Benjamin Grégoire (first version by Samuel Boutin, second version by Patrick Loiseleur) \item Decision of systems of linear inequations: Frédéric Besson (\texttt{psatzl}); Loïc Pottier (\texttt{fourier}) \item Decision of systems of linear inequations over integers: Frédéric Besson (\texttt{lia}); Pierre Crégut (\texttt{omega} and \texttt{romega}) \item (Partial) decision of systems of polynomical inequations (\texttt{sos}, \texttt{psatz}): Frédéric Besson, with generalization over arbitrary rings by Evgeny Makarov; uses HOL-Light interface to \texttt{csdp} by John Harrisson \item Decision/simplification of intuitionistic propositional logic: David Delahaye (\texttt{tauto}, \texttt{intuition}, first version by Cesar Mu\~noz, second version by Chet Murthy), with contributions from Judicaël Courant; Pierre Corbineau (\texttt{rtauto}) \item Decision/simplification of intuition first-order logic: Pierre Corbineau (\texttt{firstorder}) \end{itemize} \section{Extra tools} \begin{itemize} \item Program extraction: Pierre Letouzey (first implementation by Benjamin Werner, second by Jean-Christophe Filliâtre) \item Export of context to external communication tools (\texttt{dp}): Nicolas Ayache and Jean-Christophe Filliâtre, with contributions by Claude Marché \item Export of terms and environments to XML format: Claudio Sacerdoti Coen, with extensions from Cezary Kaliszyk \end{itemize} \section{Environment management} \begin{itemize} \item Separate compilation: initiated by Chet Murthy \item Import/Export: initiated by Chet Murthy \item Options management: Hugo Herbelin with contributions by Arnaud Spiwack \item Resetting and backtracking: Chet Murthy with contributions from Pierre Courtieu \item Searching: Hugo Herbelin, Yves Bertot \item Whelp support: Hugo Herbelin \end{itemize} \section{Parsing and printing} \begin{itemize} \item General parsing support: Chet Murthy, Bruno Barras, Daniel de Rauglaudre \item General printing support: Chet Murthy, Jean-Christophe Filliâtre \item Lexing: Daniel de Rauglaudre \item Support for UTF-8: Hugo Herbelin, with contributions from Alexandre Miquel \item Numerical notations: Hugo Herbelin, Patrick Loiseleur, Micaela Mayero \item String notations: Hugo Herbelin \item New ``V8'' syntax: Bruno Barras, Hugo Herbelin with contributions by Olivier Desmettre \item Abbreviations: Chet Murthy \item Notations: Chet Murthy, Hugo Herbelin \end{itemize} \section{Libraries} \begin{itemize} \item Init: collective (initiated by Christine Paulin and Gérard Huet) \item Arith: collective (initiated by Christine Paulin) \item ZArith: collective (initiated by Pierre Crégut) \item Bool: collective (initiated by Christine Paulin) \item NArith: Hugo Herbelin, Pierre Letouzey, Evgeny Makarov (out of initial contibution by Pierre Crégut) \item Lists: Pierre Letouzey, Jean-Marc Notin (initiated by Christine Paulin) \item Reals: Micaela Mayero (axiomatization and main properties), Olivier Desmettre (convergence, derivability, integrals, trigonometric functions), contributions from Russell O'Connor and Cezary Kaliszyk \item Relations: Bruno Barras, Cristina Cornes with contributions from Pierre Castéran \item Wellfounded: Bruno Barras, Cristina Cornes \item FSets: Pierre Letouzey, from initial work with Jean-Christophe Filliâtre, decision tactic for FSets by Aaron Bohannon \item Logic: Christine Paulin, Hugo Herbelin, Bruno Barras \item Numbers: Evgeny Makarov (abstractions), Laurent Théry and Benjamin Grégoire (big numbers), Arnaud Spiwack and Pierre Letouzey (word-based arithmetic) \item Classes: Matthieu Sozeau \item QArith: Pierre Letouzey, with contributions from Russell O'Connor \item Setoid: Matthieu Sozeau (first version by Clément Renard, second version by Claudio Sacerdoti Coen) \item Sets: Gilles Kahn and Gérard Huet \item Sorting: Gérard Huet \item Strings: Laurent Théry \item Program: Matthieu Sozeau \item Unicode: Claude Marché \end{itemize} \section{Commands} \begin{itemize} \item Batch compiler (\texttt{coqc}): Chet Murthy (?) \item Compilation dependency calculator (\texttt{coqdep}): Jean-Christophe Filliâtre \item Statistic tool (\texttt{coqwc}): Jean-Christophe Filliâtre \item Simple html presentation tool (\texttt{gallina}) (deprecated): Jean-Christophe Filliâtre \item Auto-maker (\texttt{coq\_makefile}): Jean-Christophe Filliâtre, with contributions from Judicaël Courant \item LaTeX presentation tool (\texttt{coq-tex}): Jean-Christophe Filliâtre \item Multi-purpose presentation tool (\texttt{coqdoc}): Jean-Christophe Filliâtre with extensions from Matthieu Sozeau, Jean-Marc Notin, Hugo Herbelin \item Interactive toplevel (\texttt{coqtop}): Jean-Christophe Filliâtre (?) \item Custom toplevel builder (\texttt{coqmktop}): Jean-Christophe Filliâtre (?) \end{itemize} \section{Graphical interfaces} \begin{itemize} \item Support for {\em PCoq}: Yves Bertot with contributions by Laurence Rideau and Loïc Pottier; additional support for {\em TmEgg} by Lionel Mamane \item Support for {\em Proof General}: Pierre Courtieu \item {\em CoqIDE}: Benjamin Monate with contributions from Jean-Christophe Filliâtre, Claude Marché, Pierre Letouzey, Julien Narboux, Hugo Herbelin, Pierre Corbineau; uses the Cameleon library by Maxence Guesdon \end{itemize} \section{Architecture} \begin{itemize} \item Functional-kernel-based architecture: Jean-Christophe Filliâtre \item Extensible objects and summaries: Chet Murthy \item Hash-consing: Bruno Barras \item Error locations: Jean-Christophe Filliâtre, Bruno Barras, Hugo Herbelin \item Existential variables engine: Chet Murthy with a revision by Bruno Barras and extensions by Clément Renard and Hugo Herbelin \end{itemize} \section{Development tools} \begin{itemize} \item Makefile's: Chet Murthy, Jean-Christophe Filliâtre, Judicaël Courant, Lionel Mamane, Pierre Corbineau, Pierre Letouzey \item Debugging: Jean-Christophe Filliâtre with contributions from Jacek Chrz\k{a}szcz, Hugo Herbelin, Bruno Barras, ... \item ML quotations: David Delahaye and Daniel de Rauglaudre \item ML tactic and vernacular extensions: Hugo Herbelin (first version by Chet Murthy) \item Test suite: collective content, initiated by Jean-Christophe Filliâtre with further extensions by Hugo Herbelin, Jean-Marc Notin \end{itemize} \section{Documentation} \begin{itemize} \item Reference Manual: collective, layout by Patrick Loiseleur, Claude Marché (former User's Guide in 1991 by Gilles Dowek, Amy Felty, Hugo Herbelin, Gérard Huet, Christine Paulin, Benjamin Werner; initial documentation in 1989 by Thierry Coquand, Gilles Dowek, Gérard Huet, Christine Paulin), \item Basic tutorial: Gérard Huet, Gilles Kahn, Christine Paulin \item Tutorial on recursive types: Eduardo Gimenez with updates by Pierre Castéran \item FAQ: Hugo Herbelin, Julien Narboux, Florent Kirchner \end{itemize} \section{Features discontinued by lack of support} \begin{itemize} \item Searching modulo isomorphism: David Delahaye \item Explanation of proofs in pseudo-natural language: Yann Coscoy \end{itemize} Errors may have been inopportunely introduced, please report them to Hugo~\verb=.=~Herbelin~\verb=@=~inria~\verb=.=~fr \end{document} coq-8.20.0/dev/doc/archive/whodidwhat/whodidwhat-8.3update.tex000066400000000000000000000333731466560755400241210ustar00rootroot00000000000000\documentclass{article} \usepackage{fullpage} \usepackage[utf8]{inputenc} \usepackage{t1enc} \begin{document} \title{Who did what in the Coq archive?} \author{The Coq development team} \maketitle \centerline{(updated for Coq 8.3)} \section{The Calculus of Inductive Constructions} \begin{itemize} \item The Calculus of Constructions \begin{itemize} \item Core type-checker: Gérard Huet and Thierry Coquand with optimizations by Chet Murthy, Bruno Barras \item Head reduction functions: Gérard Huet, Christine Paulin, Bruno Barras \end{itemize} \item Conversion and reduction \begin{itemize} \item Lazy conversion machine: Bruno Barras \item Transparency/opacity: Bruno Barras \item Bytecode-based conversion: Benjamin Grégoire \item Binary-words retroknowledge: Arnaud Spiwack \end{itemize} \item The universe hierarchy \begin{itemize} \item Floating universes: Gérard Huet, with contributions from Bruno Barras \item Algebraic universes: Hugo Herbelin \end{itemize} \item Mutual inductive types and recursive definitions \begin{itemize} \item Type-checking: Christine Paulin \item Positivity condition: Christine Paulin \item Guardness condition for fixpoints: Christine Paulin; extensions by Eduardo Gimenez and Bruno Barras \item Recursively non-uniform parameters: Christine Paulin \item Sort-polymorphism of inductive types: Hugo Herbelin \end{itemize} \item Local definitions: Hugo Herbelin \item Mutual coinductive types and corecursive definitions: Eduardo Gimenez \item Module system \begin{itemize} \item Core system: Jacek Chrz\k{a}szcz \item Inlining: Claudio Sacerdoti Coen and Élie Soubiran \item Module inclusion: Élie Soubiran \item Functorial signature application: Élie Soubiran \item Transparent name space: Élie Soubiran \item Resolution of qualified names: Hugo Herbelin \item Operator for nested functor application: Élie Soubiran and Pierre Letouzey \end{itemize} \item Minimalist stand-alone type-checker (\texttt{coqchk}): Bruno Barras, with extra support for modules by Élie Soubiran \end{itemize} \section{Specification language} \begin{itemize} \item Sections: Gilles Dowek with extra contributions by Gérard Huet, Chet Murthy, Hugo Herbelin \item The \texttt{Russell} specifications language, proof obligations (\texttt{Program}): Matthieu Sozeau \item Type inference: Chet Murthy, with extra contributions by Bruno Barras, Hugo Herbelin and Matthieu Sozeau \item Pattern-matching: Hugo Herbelin on top of a first version by Cristina Cornes \item Implicit arguments: Amokrane Saïbi, with extensions by Hugo Herbelin and Matthieu Sozeau \item Coercions: Amokrane Saïbi \item Records: Amokrane Saïbi with extensions by Arnaud Spiwack and Matthieu Sozeau \item Canonical structures: Amokrane Saïbi \item Type classes: Matthieu Sozeau \item Functional schemes (\texttt{Function}, \texttt{Functional Scheme}, ...): Julien Forest and Pierre Courtieu (preliminary version by Yves Bertot) \item Generation of induction schemes: Christine Paulin, Vincent Siles, Matthieu Sozeau \end{itemize} \section{Tactics} \subsection{General tactic support} \begin{itemize} \item Proof engine: Chet Murthy (first version by Thierry Coquand) \item Ltac: David Delahaye, with extensions by Hugo Herbelin, Bruno Barras, ... \item Tactic notations: Hugo Herbelin (first version by Chet Murthy) \item Main tactic unification procedure: Chet Murthy with contributions from Hugo Herbelin and Matthieu Sozeau \item Mathematical-style language (C-Zar): Pierre Corbineau \item Communication with external tools (\texttt{external}): Hugo Herbelin \end{itemize} \subsection{Predefined tactics} \begin{itemize} \item Basic tactics (\texttt{intro}, \texttt{apply}, \texttt{assumption}, \texttt{exact}): Thierry Coquand, with further collective extensions \item Reduction tactics: Christine Paulin (\texttt{simpl}), Bruno Barras (\texttt{cbv}, \texttt{lazy}), ... \item Tacticals: Thierry Coquand, Chet Murthy, Eduardo Gimenez, ... \item Induction: Christine Paulin (\texttt{elim}, \texttt{case}), Hugo Herbelin (\texttt{induction}, \texttt{destruct}, {\tt e}-variants of them), Matthieu Sozeau ({\tt dependent destruction}, {\tt dependent induction}) \item Refinement (\texttt{refine}): Jean-Christophe Filliâtre \item Introduction patterns: Eduardo Gimenez with collective extensions \item Forward reasoning: Hugo Herbelin (\texttt{assert}, \texttt{apply in}), Pierre Letouzey (\texttt{specialize}, initial version by Amy Felty) \item Rewriting tactics (\texttt{rewrite}): basic version by Christine Paulin, extensions by Jean-Christophe Filliâtre ({\tt subst}), Pierre Letouzey (\verb=!=, \verb=?= modifiers) and Matthieu Sozeau (\verb=*=) \item Tactics about equivalence properties (\texttt{reflexivity}, \texttt{symmetry}, \texttt{transitivity}): Christine Paulin (?), {\tt e}-variants by Hugo Herbelin, type-classes-based generalization to arbitrary appropriate relations by Matthieu Sozeau \item Equality tactics (\texttt{injection}/\texttt{discriminate}): Cristina Cornes \item Inversion tactics (\texttt{inversion}): Cristina Cornes, Chet Murthy \item Setoid rewriting: Matthieu Sozeau (first version by Clément Renard, second version by Claudio Sacerdoti Coen), contributions from Nicolas Tabareau \item Decision of equality: Eduardo Gimenez \item Basic Ltac-level tactics: Pierre Letouzey, Matthieu Sozeau, Evgeny Makarov, Hugo Herbelin \end{itemize} \subsection{General automation tactics} \begin{itemize} \item Resolution (\texttt{auto}, \texttt{trivial}): Christine Paulin with extensions from Chet Murthy, Eduardo Gimenez, Patrick Loiseleur (hint bases), Matthieu Sozeau \item Resolution with existential variables (\texttt{eauto}): Chet Murthy, Jean-Christophe Filliâtre, with extensions from Matthieu Sozeau \item Automatic rewriting (\texttt{autorewrite}): David Delahaye \end{itemize} \subsection{Domain-specific decision tactics} \begin{itemize} \item Congruence closure (\texttt{cc}): Pierre Corbineau \item Decision of first-order logic (\texttt{firstorder}): Pierre Corbineau \item Simplification of polynomial fractions (\texttt{field}): Laurent Théry and Benjamin Grégoire (first version by David Delahaye and Micaela Mayero) \item Simplification of polynomial expressions (\texttt{ring}): Assia Mahboubi, Bruno Barras and Benjamin Grégoire (first version by Samuel Boutin, second version by Patrick Loiseleur) \item Decision of systems of polynomial equations: Loïc Pottier (\texttt{nsatz}) \item Decision of systems of linear inequations: Frédéric Besson (\texttt{psatzl}); Loïc Pottier (\texttt{fourier}) \item Decision of systems of linear inequations over integers: Frédéric Besson (\texttt{lia}); Pierre Crégut (\texttt{omega} and \texttt{romega}) \item (Partial) decision of systems of polynomical inequations (\texttt{sos}, \texttt{psatz}): Frédéric Besson, with generalization over arbitrary rings by Evgeny Makarov; uses HOL-Light interface to \texttt{csdp} by John Harrisson \item Decision/simplification of intuitionistic propositional logic: David Delahaye (\texttt{tauto}, \texttt{intuition}, first version by Cesar Mu\~noz, second version by Chet Murthy), with contributions from Judicaël Courant; Pierre Corbineau (\texttt{rtauto}) \item Decision/simplification of intuition first-order logic: Pierre Corbineau (\texttt{firstorder}) \item Reification ({\tt quote}): Patrick Loiseleur, with generalization by Stéphane Glondu \end{itemize} \section{Extra tools} \begin{itemize} \item Program extraction: Pierre Letouzey (first implementation by Benjamin Werner, second by Jean-Christophe Filliâtre) \item Export of context to external communication tools (\texttt{dp}): Nicolas Ayache and Jean-Christophe Filliâtre, with contributions by Claude Marché \item Export of terms and environments to XML format: Claudio Sacerdoti Coen, with extensions from Cezary Kaliszyk \end{itemize} \section{Environment management} \begin{itemize} \item Separate compilation: initiated by Chet Murthy \item Import/Export: initiated by Chet Murthy \item Options management: Hugo Herbelin with contributions by Arnaud Spiwack \item Resetting and backtracking: Chet Murthy with contributions from Pierre Courtieu \item Searching: Hugo Herbelin and Yves Bertot with extensions by Matthias Puech \item Whelp support: Hugo Herbelin \end{itemize} \section{Parsing and printing} \begin{itemize} \item General parsing support: Chet Murthy, Bruno Barras, Daniel de Rauglaudre \item General printing support: Chet Murthy, Jean-Christophe Filliâtre \item Lexing: Daniel de Rauglaudre \item Support for UTF-8: Hugo Herbelin, with contributions from Alexandre Miquel and Yann Régis-Gianas \item Numerical notations: Hugo Herbelin, Patrick Loiseleur, Micaela Mayero \item String notations: Hugo Herbelin \item New ``V8'' syntax: Bruno Barras, Hugo Herbelin with contributions by Olivier Desmettre \item Abbreviations: Chet Murthy \item Notations: Chet Murthy, Hugo Herbelin \end{itemize} \section{Libraries} \begin{itemize} \item Init: collective (initiated by Christine Paulin and Gérard Huet) \item Arith: collective (initiated by Christine Paulin) \item ZArith: collective (initiated by Pierre Crégut) \item Bool: collective (initiated by Christine Paulin) \item NArith: Hugo Herbelin, Pierre Letouzey, Evgeny Makarov (out of initial contibution by Pierre Crégut) \item Lists: Pierre Letouzey, Jean-Marc Notin (initiated by Christine Paulin) \item Reals: Micaela Mayero (axiomatization and main properties), Olivier Desmettre (convergence, derivability, integrals, trigonometric functions), contributions from Russell O'Connor, Cezary Kaliszyk, Guillaume Melquiond \item Relations: Bruno Barras, Cristina Cornes with contributions from Pierre Castéran \item Wellfounded: Bruno Barras, Cristina Cornes \item FSets: Pierre Letouzey, from initial work with Jean-Christophe Filliâtre, decision tactic for FSets by Aaron Bohannon \item MSets: Pierre Letouzey \item Logic: Christine Paulin, Hugo Herbelin, Bruno Barras \item Numbers: Evgeny Makarov (abstractions), Laurent Théry and Benjamin Grégoire (big numbers), Arnaud Spiwack and Pierre Letouzey (word-based arithmetic), further extensions by Pierre Letouzey \item Classes: Matthieu Sozeau \item QArith: Pierre Letouzey, with contributions from Russell O'Connor \item Setoid: Matthieu Sozeau (first version by Clément Renard, second version by Claudio Sacerdoti Coen) \item Sets: Gilles Kahn and Gérard Huet \item Sorting: Gérard Huet with revisions by Hugo Herbelin \item Strings: Laurent Théry \item Program: Matthieu Sozeau \item Unicode: Claude Marché \end{itemize} \section{Commands} \begin{itemize} \item Batch compiler (\texttt{coqc}): Chet Murthy (?) \item Compilation dependency calculator (\texttt{coqdep}): Jean-Christophe Filliâtre \item Statistic tool (\texttt{coqwc}): Jean-Christophe Filliâtre \item Simple html presentation tool (\texttt{gallina}) (deprecated): Jean-Christophe Filliâtre \item Auto-maker (\texttt{coq\_makefile}): Jean-Christophe Filliâtre, with contributions from Judicaël Courant \item LaTeX presentation tool (\texttt{coq-tex}): Jean-Christophe Filliâtre \item Multi-purpose presentation tool (\texttt{coqdoc}): Jean-Christophe Filliâtre with extensions from Matthieu Sozeau, Jean-Marc Notin, Hugo Herbelin \item Interactive toplevel (\texttt{coqtop}): Jean-Christophe Filliâtre (?) \item Custom toplevel builder (\texttt{coqmktop}): Jean-Christophe Filliâtre (?) \end{itemize} \section{Graphical interfaces} \begin{itemize} \item Support for {\em PCoq}: Yves Bertot with contributions by Laurence Rideau and Loïc Pottier; additional support for {\em TmEgg} by Lionel Mamane \item Support for {\em Proof General}: Pierre Courtieu \item {\em CoqIDE}: Benjamin Monate with contributions from Jean-Christophe Filliâtre, Claude Marché, Pierre Letouzey, Julien Narboux, Hugo Herbelin, Pierre Corbineau, Vincent Gross; uses the Cameleon library by Maxence Guesdon \end{itemize} \section{Architecture} \begin{itemize} \item Functional-kernel-based architecture: Jean-Christophe Filliâtre \item Extensible objects and summaries: Chet Murthy \item Hash-consing: Bruno Barras \item Error locations: Jean-Christophe Filliâtre, Bruno Barras, Hugo Herbelin \item Existential variables engine: Chet Murthy with revisions by Bruno Barras and Arnaud Spiwack and extensions by Clément Renard and Hugo Herbelin \end{itemize} \section{Development tools} \begin{itemize} \item Makefile's: Chet Murthy, Jean-Christophe Filliâtre, Judicaël Courant, Lionel Mamane, Pierre Corbineau, Pierre Letouzey \item Debugging: Jean-Christophe Filliâtre with contributions from Jacek Chrz\k{a}szcz, Hugo Herbelin, Bruno Barras, ... \item ML quotations: David Delahaye and Daniel de Rauglaudre \item ML tactic and vernacular extensions: Hugo Herbelin (first version by Chet Murthy) \item Test suite: collective content, initiated by Jean-Christophe Filliâtre with further extensions by Hugo Herbelin, Jean-Marc Notin \end{itemize} \section{Documentation} \begin{itemize} \item Reference Manual: collective, layout by Patrick Loiseleur, Claude Marché (former User's Guide in 1991 by Gilles Dowek, Amy Felty, Hugo Herbelin, Gérard Huet, Christine Paulin, Benjamin Werner; initial documentation in 1989 by Thierry Coquand, Gilles Dowek, Gérard Huet, Christine Paulin), \item Basic tutorial: Gérard Huet, Gilles Kahn, Christine Paulin \item Tutorial on recursive types: Eduardo Gimenez with updates by Pierre Castéran \item FAQ: Hugo Herbelin, Julien Narboux, Florent Kirchner \end{itemize} \section{Features discontinued by lack of support} \begin{itemize} \item Searching modulo isomorphism: David Delahaye \item Explanation of proofs in pseudo-natural language: Yann Coscoy \end{itemize} Errors may have been inopportunely introduced, please report them to Hugo~\verb=.=~Herbelin~\verb=@=~inria~\verb=.=~fr \end{document} coq-8.20.0/dev/doc/archive/whodidwhat/whodidwhat-8.4update.tex000066400000000000000000000372261466560755400241230ustar00rootroot00000000000000\documentclass{article} \usepackage{fullpage} \usepackage[utf8]{inputenc} \usepackage{t1enc} \usepackage{hyperref} \begin{document} \title{Who did what in the Coq archive?} \author{The Coq development team} \maketitle \centerline{(updated for Coq 8.4)} \section{The Calculus of Inductive Constructions} \begin{itemize} \item The Calculus of Constructions \begin{itemize} \item Core type-checker: Gérard Huet and Thierry Coquand with optimizations by Chet Murthy, Bruno Barras \item Head reduction functions: Gérard Huet, Christine Paulin, Bruno Barras \end{itemize} \item Conversion and reduction \begin{itemize} \item Lazy conversion machine: Bruno Barras \item Transparency/opacity: Bruno Barras \item Bytecode-based conversion: Benjamin Grégoire \item Binary-words retroknowledge: Arnaud Spiwack \end{itemize} \item The universe hierarchy \begin{itemize} \item Floating universes: Gérard Huet, with contributions from Bruno Barras and Pierre Letouzey \item Algebraic universes: Hugo Herbelin \end{itemize} \item Mutual inductive types and recursive definitions \begin{itemize} \item Type-checking: Christine Paulin \item Positivity condition: Christine Paulin \item Guardness condition for fixpoints: Christine Paulin; extensions by Eduardo Gimenez, Bruno Barras, Pierre Boutillier \item Recursively non-uniform parameters: Christine Paulin \item Sort-polymorphism of inductive types: Hugo Herbelin \end{itemize} \item Local definitions: Hugo Herbelin \item Mutual coinductive types and corecursive definitions: Eduardo Gimenez \item Module system \begin{itemize} \item Core system: Jacek Chrz\k{a}szcz \item Inlining: Claudio Sacerdoti Coen and Élie Soubiran \item Module inclusion: Élie Soubiran \item Functorial signature application: Élie Soubiran \item Transparent name space: Élie Soubiran \item Resolution of qualified names: Hugo Herbelin \item Operator for nested functor application: Élie Soubiran and Pierre Letouzey \end{itemize} \item Minimalist stand-alone type-checker (\texttt{coqchk}): Bruno Barras, with extra support for modules by Élie Soubiran and Pierre Letouzey \item Eta-conversion: Hugo Herbelin, with contributions from Stéphane Glondu, Benjamin Grégoire \end{itemize} \section{Specification language} \begin{itemize} \item Sections: Gilles Dowek with extra contributions by Gérard Huet, Chet Murthy, Hugo Herbelin \item The \texttt{Russell} specifications language, proof obligations (\texttt{Program}): Matthieu Sozeau \item Type inference: Chet Murthy, with extra contributions by Bruno Barras, Hugo Herbelin, Matthieu Sozeau, Enrico Tassi \item Pattern-matching: Hugo Herbelin on top of a first version by Cristina Cornes \item Implicit arguments: Amokrane Saïbi, with extensions by Hugo Herbelin, Matthieu Sozeau, Pierre Boutillier \item Synthetic {\tt Arguments} command: Enrico Tassi \item Coercions: Amokrane Saïbi \item Records: Amokrane Saïbi with extensions by Arnaud Spiwack and Matthieu Sozeau \item Canonical structures: Amokrane Saïbi \item Type classes: Matthieu Sozeau \item Functional schemes (\texttt{Function}, \texttt{Functional Scheme}, ...): Julien Forest and Pierre Courtieu (preliminary version by Yves Bertot) \item Generation of induction schemes: Christine Paulin, Vincent Siles, Matthieu Sozeau \end{itemize} \section{Tactics} \subsection{General tactic support} \begin{itemize} \item Proof engine: Arnaud Spiwack (first version by Thierry Coquand, second version by Chet Murthy) \item Ltac: David Delahaye, with extensions by Hugo Herbelin, Bruno Barras, ... \item Tactic notations: Hugo Herbelin (first version by Chet Murthy) \item Main tactic unification procedure: Chet Murthy with contributions from Hugo Herbelin and Matthieu Sozeau \item Mathematical-style language (C-Zar): Pierre Corbineau \item Communication with external tools (\texttt{external}): Hugo Herbelin \item Proof structuring (bullets and brackets): Arnaud Spiwack \end{itemize} \subsection{Predefined tactics} \begin{itemize} \item Basic tactics (\texttt{intro}, \texttt{apply}, \texttt{assumption}, \texttt{exact}): Thierry Coquand, with further collective extensions \item Reduction tactics: Christine Paulin (\texttt{simpl}), Bruno Barras (\texttt{cbv}, \texttt{lazy}), with contributions from Hugo Herbelin, Enrico Tassi, ... \item Tacticals: Thierry Coquand, Chet Murthy, Eduardo Gimenez, ...; new versions of {\tt info} and {\tt Show Script} by Pierre Letouzey; {\tt timeout} by Pierre Letouzey \item Induction: Christine Paulin (\texttt{elim}, \texttt{case}), Hugo Herbelin (\texttt{induction}, \texttt{destruct} \item Refinement (\texttt{refine}): Jean-Christophe Filliâtre \item Introduction patterns: Eduardo Gimenez with collective extensions \item Forward reasoning: Hugo Herbelin (\texttt{assert}, \texttt{apply in}), Pierre Letouzey (\texttt{specialize}, initial version by Amy Felty) \item Rewriting tactics (\texttt{rewrite}): basic version by Christine Paulin, extensions by Jean-Christophe Filliâtre and Pierre Letouzey \item Tactics about equivalence properties (\texttt{reflexivity}, \texttt{symmetry}, \texttt{transitivity}): Christine Paulin (?), \item Equality tactics (\texttt{injection}/\texttt{discriminate}): Cristina Cornes \item Inversion tactics (\texttt{inversion}): Cristina Cornes, Chet Murthy \item Setoid rewriting: Matthieu Sozeau (first version by Clément Renard, second version by Claudio Sacerdoti Coen), contributions from Nicolas Tabareau \item Decision of equality: Eduardo Gimenez \item Basic Ltac-level tactics: Pierre Letouzey, Matthieu Sozeau, Evgeny Makarov \item Tactics about existential variables: Clément Renard, Pierre Corbineau, Stéphane Glondu, Arnaud Spiwack, ... \end{itemize} \subsection{General automation tactics} \begin{itemize} \item Resolution (\texttt{auto}, \texttt{trivial}): Christine Paulin with extensions from Chet Murthy, Eduardo Gimenez, Patrick Loiseleur (hint bases), Matthieu Sozeau \item Resolution with existential variables (\texttt{eauto}): Chet Murthy, Jean-Christophe Filliâtre, with extensions from Matthieu Sozeau \item Automatic rewriting (\texttt{autorewrite}): David Delahaye \end{itemize} \subsection{Domain-specific decision tactics} \begin{itemize} \item Congruence closure (\texttt{cc}): Pierre Corbineau \item Decision of first-order logic (\texttt{firstorder}): Pierre Corbineau \item Simplification of polynomial fractions (\texttt{field}): Laurent Théry and Benjamin Grégoire (first version by David Delahaye and Micaela Mayero) \item Simplification of polynomial expressions (\texttt{ring}): Assia Mahboubi, Bruno Barras and Benjamin Grégoire (first version by Samuel Boutin, second version by Patrick Loiseleur) \item Decision of systems of polynomial equations: Loïc Pottier (\texttt{nsatz}) \item Decision of systems of linear inequations: Frédéric Besson (\texttt{psatzl}); Loïc Pottier (\texttt{fourier}) \item Decision of systems of linear inequations over integers: Frédéric Besson (\texttt{lia}); Pierre Crégut (\texttt{omega} and \texttt{romega}) \item (Partial) decision of systems of polynomical inequations (\texttt{sos}, \texttt{psatz}): Frédéric Besson, with generalization over arbitrary rings by Evgeny Makarov; uses HOL-Light interface to \texttt{csdp} by John Harrisson \item Decision/simplification of intuitionistic propositional logic: David Delahaye (\texttt{tauto}, \texttt{intuition}, first version by Cesar Mu\~noz, second version by Chet Murthy), with contributions from Judicaël Courant; Pierre Corbineau (\texttt{rtauto}) \item Decision/simplification of intuition first-order logic: Pierre Corbineau (\texttt{firstorder}) \end{itemize} \section{Extra tools} \begin{itemize} \item Program extraction: Pierre Letouzey (first implementation by Benjamin Werner, second by Jean-Christophe Filliâtre) \item Export of context to external communication tools (\texttt{dp}): Nicolas Ayache and Jean-Christophe Filliâtre, with contributions by Claude Marché \item Export of terms and environments to XML format: Claudio Sacerdoti Coen, with extensions from Cezary Kaliszyk \end{itemize} \section{Environment management} \begin{itemize} \item Separate compilation: initiated by Chet Murthy \item Import/Export: initiated by Chet Murthy \item Options management: Hugo Herbelin with contributions by Arnaud Spiwack \item Resetting and backtracking: Chet Murthy with contributions from Pierre Courtieu \item Searching: Hugo Herbelin and Yves Bertot with extensions by Matthias Puech \item Whelp support: Hugo Herbelin \end{itemize} \section{Parsing and printing} \begin{itemize} \item General parsing support: Chet Murthy, Bruno Barras, Daniel de Rauglaudre \item General printing support: Chet Murthy, Jean-Christophe Filliâtre \item Lexing: Daniel de Rauglaudre \item Support for UTF-8: Hugo Herbelin, with contributions from Alexandre Miquel and Yann Régis-Gianas \item Numerical notations: Hugo Herbelin, Patrick Loiseleur, Micaela Mayero \item String notations: Hugo Herbelin \item New ``V8'' syntax: Bruno Barras, Hugo Herbelin with contributions by Olivier Desmettre \item Abbreviations: Chet Murthy \item Notations: Chet Murthy, Hugo Herbelin \end{itemize} \section{Libraries} \begin{itemize} \item Init: collective (initiated by Christine Paulin and Gérard Huet) \item Arith: collective (initiated by Christine Paulin) \item ZArith: collective (initiated by Pierre Crégut) \item Bool: collective (initiated by Christine Paulin) \item NArith: Hugo Herbelin, Pierre Letouzey, Evgeny Makarov (out of initial contibution by Pierre Crégut) \item Lists: Pierre Letouzey, Jean-Marc Notin (initiated by Christine Paulin) \item Vectors: Pierre Boutillier \item Reals: Micaela Mayero (axiomatization and main properties), Olivier Desmettre (convergence, derivability, integrals, trigonometric functions), contributions from Russell O'Connor, Cezary Kaliszyk, Guillaume Melquiond, Yves Bertot, Guillaume Allais \item Relations: Bruno Barras, Cristina Cornes with contributions from Pierre Castéran \item Wellfounded: Bruno Barras, Cristina Cornes \item FSets: Pierre Letouzey, from initial work with Jean-Christophe Filliâtre, decision tactic for FSets by Aaron Bohannon, red-black trees by Andrew Appel and Pierre Letouzey \item MSets: Pierre Letouzey \item Logic: Christine Paulin, Hugo Herbelin, Bruno Barras \item Numbers: Evgeny Makarov (abstractions), Laurent Théry and Benjamin Grégoire (big numbers), Arnaud Spiwack and Pierre Letouzey (word-based arithmetic), further extensions by Pierre Letouzey; integration of Arith and ZArith to Numbers by Pierre Letouzey \item Classes: Matthieu Sozeau \item QArith: Pierre Letouzey, with contributions from Russell O'Connor \item Setoid: Matthieu Sozeau (first version by Clément Renard, second version by Claudio Sacerdoti Coen) \item Sets: Gilles Kahn and Gérard Huet \item Sorting: Gérard Huet with revisions by Hugo Herbelin \item Strings: Laurent Théry \item Program: Matthieu Sozeau \item Unicode: Claude Marché \end{itemize} \section{Commands} \begin{itemize} \item Batch compiler (\texttt{coqc}): Chet Murthy (?) \item Compilation dependency calculator (\texttt{coqdep}): Jean-Christophe Filliâtre \item Statistic tool (\texttt{coqwc}): Jean-Christophe Filliâtre \item Simple html presentation tool (\texttt{gallina}) (deprecated): Jean-Christophe Filliâtre \item Auto-maker (\texttt{coq\_makefile}): Jean-Christophe Filliâtre, with contributions from Judicaël Courant, updated by Pierre Boutillier \item LaTeX presentation tool (\texttt{coq-tex}): Jean-Christophe Filliâtre \item Multi-purpose presentation tool (\texttt{coqdoc}): Jean-Christophe Filliâtre with extensions from Matthieu Sozeau, Jean-Marc Notin, Hugo Herbelin and contributions from Adam Chlipala \item Interactive toplevel (\texttt{coqtop}): Jean-Christophe Filliâtre (?) \item Custom toplevel builder (\texttt{coqmktop}): Jean-Christophe Filliâtre (?) \end{itemize} \section{Graphical interfaces} \begin{itemize} \item Support for {\em PCoq}: Yves Bertot with contributions by Laurence Rideau and Loïc Pottier; additional support for {\em TmEgg} by Lionel Mamane \item Support for {\em Proof General}: Pierre Courtieu with contributions from Arnaud Spiwack \item {\em CoqIDE}: Benjamin Monate with contributions from Jean-Christophe Filliâtre, Claude Marché, Pierre Letouzey, Julien Narboux, Hugo Herbelin, Pierre Corbineau, Pierre Boutillier, Pierre-Marie Pédrot; processus-based communication protocol by Vincent Gross with contributions from Pierre Letouzey, Pierre Boutillier, Pierre-Marie Pédrot; backtracking revised by Pierre Letouzey; uses the Cameleon library by Maxence Guesdon; \end{itemize} \section{Architecture} \begin{itemize} \item Functional-kernel-based architecture: Jean-Christophe Filliâtre \item Extensible objects and summaries: Chet Murthy \item Hash-consing: Bruno Barras \item Error locations: Jean-Christophe Filliâtre, Bruno Barras, Hugo Herbelin, with contributions from Arnaud Spiwack \item Existential variables engine: Chet Murthy with revisions by Bruno Barras and Arnaud Spiwack and extensions by Clément Renard and Hugo Herbelin \end{itemize} \section{Development tools} \begin{itemize} \item Makefile's: Chet Murthy, Jean-Christophe Filliâtre, Judicaël Courant, Lionel Mamane, Pierre Corbineau, Pierre Letouzey with contributions from Stéphane Glondu, Hugo Herbelin, ... \item Debugging: Jean-Christophe Filliâtre with contributions from Jacek Chrz\k{a}szcz, Hugo Herbelin, Bruno Barras, ... \item ML quotations: David Delahaye and Daniel de Rauglaudre \item ML tactic and vernacular extensions: Hugo Herbelin (first version by Chet Murthy) \item Test suite: collective content, initiated by Jean-Christophe Filliâtre with further extensions by Hugo Herbelin, Jean-Marc Notin \end{itemize} \section{Maintenance and system engineering} \begin{itemize} %\item General maintenance in version 8.0: Bruno Barras, Hugo Herbelin %\item General maintenance in version 8.1: Bruno Barras, Hugo Herbelin, Jean-Marc Notin %\item General maintenance in version 8.2: Hugo Herbelin, Pierre Letouzey, Jean-Marc Notin, %\item General maintenance in version 8.3: Hugo Herbelin, Pierre % Letouzey \item General maintenance in version 8.4: Pierre Letouzey, Hugo Herbelin, Pierre Boutillier, Matthieu Sozeau, Stéphane Glondu with contributions from Guillaume Melquiond, Julien Narboux and Pierre-Marie Pédrot \item Team coordination: Gérard Huet, Christine Paulin, Hugo Herbelin, with various other contributions \item Packaging tools: Henri Laulhere, David Delahaye, Julien Narboux, Pierre Letouzey, Enrico Tassi (Windows); Damien Doligez, Hugo Herbelin, Pierre Boutillier (MacOS); Jean-Christophe Filliâtre, Judicaël Courant, Hugo Herbelin, Stéphane Glondu (Linux) \end{itemize} \section{Documentation} \begin{itemize} \item Reference Manual: collective, layout by Patrick Loiseleur, Claude Marché (former User's Guide in 1991 by Gilles Dowek, Amy Felty, Hugo Herbelin, Gérard Huet, Christine Paulin, Benjamin Werner; initial documentation in 1989 by Thierry Coquand, Gilles Dowek, Gérard Huet, Christine Paulin), \item Basic tutorial: Gérard Huet, Gilles Kahn, Christine Paulin \item Tutorial on recursive types: Eduardo Gimenez with updates by Pierre Castéran \item FAQ: Hugo Herbelin, Julien Narboux, Florent Kirchner \end{itemize} \section{Features discontinued by lack of support} \begin{itemize} \item Searching modulo isomorphism: David Delahaye \item Explanation of proofs in pseudo-natural language: Yann Coscoy \item Dp: Jean-Christophe Filliâtre, Nicolas Ayache with contributions from Claude Marché (now integrated to \href{http://why3.lri.fr/}{Why3}) \end{itemize} For oversights or accidental errors, please report to Hugo~\verb=.=~Herbelin~\verb=@=~inria~\verb=.=~fr \end{document} coq-8.20.0/dev/doc/archive/whodidwhat/whodidwhat-8.5update.tex000066400000000000000000000376661466560755400241340ustar00rootroot00000000000000\documentclass{article} \usepackage{fullpage} \usepackage[utf8]{inputenc} \usepackage{t1enc} \begin{document} \title{Who did what in the Coq archive?} \author{The Coq development team} \maketitle \centerline{(updated for Coq 8.5)} \section{The Calculus of Inductive Constructions} \begin{itemize} \item The Calculus of Constructions \begin{itemize} \item Core type-checker: Gérard Huet and Thierry Coquand with optimizations by Chet Murthy, Bruno Barras \item Head reduction functions: Gérard Huet, Christine Paulin, Bruno Barras \end{itemize} \item Conversion and reduction \begin{itemize} \item Lazy conversion machine: Bruno Barras \item Transparency/opacity: Bruno Barras \item Bytecode-based conversion: Benjamin Grégoire \item Binary-words retroknowledge: Arnaud Spiwack \item Native code based conversion: Maxime Dénès, Benjamin Grégoire \end{itemize} \item The universe hierarchy \begin{itemize} \item Floating universes: Gérard Huet, with contributions from Bruno Barras \item Algebraic universes: Hugo Herbelin \end{itemize} \item Mutual inductive types and recursive definitions \begin{itemize} \item Type-checking: Christine Paulin \item Positivity condition: Christine Paulin \item Guardness condition for fixpoints: Christine Paulin; extensions by Eduardo Gimenez, Bruno Barras, Pierre Boutillier; fixes by Bruno Barras, Maxime Dénès \item Recursively non-uniform parameters: Christine Paulin \item Sort-polymorphism of inductive types: Hugo Herbelin \end{itemize} \item Local definitions: Hugo Herbelin \item Mutual coinductive types and corecursive definitions: Eduardo Gimenez \item Module system \begin{itemize} \item Core system: Jacek Chrz\k{a}szcz \item Inlining: Claudio Sacerdoti Coen and Élie Soubiran \item Module inclusion: Élie Soubiran \item Functorial signature application: Élie Soubiran \item Transparent name space: Élie Soubiran \item Resolution of qualified names: Hugo Herbelin \item Operator for nested functor application: Élie Soubiran and Pierre Letouzey \end{itemize} \item Minimalist stand-alone type-checker (\texttt{coqchk}): Bruno Barras, with extra support for modules by Élie Soubiran and Pierre Letouzey \item Eta-conversion: Hugo Herbelin, with contributions from Stéphane Glondu, Benjamin Grégoire \end{itemize} \section{Specification language} \begin{itemize} \item Sections: Gilles Dowek with extra contributions by Gérard Huet, Chet Murthy, Hugo Herbelin \item The \texttt{Russell} specifications language, proof obligations (\texttt{Program}): Matthieu Sozeau \item Type inference: Chet Murthy, with extra contributions by Bruno Barras, Hugo Herbelin, Matthieu Sozeau, Enrico Tassi \item Pattern-matching: Hugo Herbelin on top of a first version by Cristina Cornes, contributions by Arnaud Spiwack \item Implicit arguments: Amokrane Saïbi, with extensions by Hugo Herbelin, Matthieu Sozeau, Pierre Boutillier \item Synthetic {\tt Arguments} command: Enrico Tassi \item Coercions: Amokrane Saïbi \item Records \begin{itemize} \item Core implementation: Amokrane Saïbi with extensions by Matthieu Sozeau \item Extension to inductive and co-inductive records: Arnaud Spiwack \item Non-recursive variants: Arnaud Spiwack \end{itemize} \item Canonical structures: Amokrane Saïbi \item Type classes: Matthieu Sozeau \item Function (\texttt{Function}, \texttt{functional induction}...): Julien Forest (preliminary versions by Pierre Courtieu (\texttt{Functional Schemes}) and Yves Bertot (\texttt{Recursive Definition})) \item Generation of induction schemes: Christine Paulin, Vincent Siles, Matthieu Sozeau \end{itemize} \section{Tactics} \subsection{General tactic support} \begin{itemize} \item Proof engine: Arnaud Spiwack (first version by Thierry Coquand, second version by Chet Murthy) \item Ltac: David Delahaye, with extensions by Hugo Herbelin, Bruno Barras, ... Evolution to the new proof engine Arnaud Spiwack, Pierre-Marie P\'edrot \item Tactic notations: Hugo Herbelin (first version by Chet Murthy) \item Main tactic unification procedure: Chet Murthy with contributions from Hugo Herbelin and Matthieu Sozeau \item Mathematical-style language (C-Zar): Pierre Corbineau \item Communication with external tools (\texttt{external}): Hugo Herbelin \item Proof structuring (bullets and brackets): Arnaud Spiwack \end{itemize} \subsection{Predefined tactics} \begin{itemize} \item Basic refinement tactic (\texttt{refine}): Arnaud Spiwack (previous non-basic version by Jean-Christophe Filliâtre) \item Core tactics (\texttt{intro}, \texttt{apply}, \texttt{assumption}, \texttt{exact}): Thierry Coquand, with further collective extensions \item Reduction tactics: Christine Paulin (\texttt{simpl}), Bruno Barras (\texttt{cbv}, \texttt{lazy}), Pierre Boutillier (\texttt{cbn}) with contributions from Hugo Herbelin, Enrico Tassi, ... \item Tacticals: Thierry Coquand, Chet Murthy, Eduardo Gimenez, ...; new versions of {\tt info} and {\tt Show Script} by Pierre Letouzey; {\tt timeout} by Pierre Letouzey; backtracking-related tacticals by Arnaud Spiwack \item Generic tactic traces ({\tt Info}) by Arnaud Spiwack (based on the former {\tt info} tactical) \item Induction: Christine Paulin (\texttt{elim}, \texttt{case}), Hugo Herbelin (\texttt{induction}, \texttt{destruct} \item Introduction patterns: Eduardo Gimenez with collective extensions \item Forward reasoning: Hugo Herbelin (\texttt{assert}, \texttt{enough}, \texttt{apply in}), Pierre Letouzey (\texttt{specialize}, initial version by Amy Felty) \item Rewriting tactics (\texttt{rewrite}): basic version by Christine Paulin, extensions by Jean-Christophe Filliâtre and Pierre Letouzey \item Setoid rewriting: Matthieu Sozeau (first version by Clément Renard, second version by Claudio Sacerdoti Coen), contributions from Nicolas Tabareau \item Tactics about equivalence properties (\texttt{reflexivity}, \texttt{symmetry}, \texttt{transitivity}): Christine Paulin (?), \item Equality tactics (\texttt{injection}/\texttt{discriminate}): Cristina Cornes, extensions by Hugo Herbelin \item Inversion tactics (\texttt{inversion}): Cristina Cornes, Chet Murthy \item Decision of equality: Eduardo Gimenez \item Basic Ltac-level tactics: Pierre Letouzey, Matthieu Sozeau, Evgeny Makarov \item Tactics about existential variables: Clément Renard, Pierre Corbineau, Stéphane Glondu, Arnaud Spiwack, ... \end{itemize} \subsection{General automation tactics} \begin{itemize} \item Resolution (\texttt{auto}, \texttt{trivial}): Christine Paulin with extensions from Chet Murthy, Eduardo Gimenez, Patrick Loiseleur (hint bases), Matthieu Sozeau \item Resolution with existential variables (\texttt{eauto}): Chet Murthy, Jean-Christophe Filliâtre, with extensions from Matthieu Sozeau \item Automatic rewriting (\texttt{autorewrite}): David Delahaye \end{itemize} \subsection{Domain-specific decision tactics} \begin{itemize} \item Congruence closure (\texttt{cc}): Pierre Corbineau \item Decision of first-order logic (\texttt{firstorder}): Pierre Corbineau \item Simplification of polynomial fractions (\texttt{field}): Laurent Théry and Benjamin Grégoire (first version by David Delahaye and Micaela Mayero) \item Simplification of polynomial expressions (\texttt{ring}): Assia Mahboubi, Bruno Barras and Benjamin Grégoire (first version by Samuel Boutin, second version by Patrick Loiseleur) \item Decision of systems of polynomial equations: Loïc Pottier (\texttt{nsatz}) \item Decision of systems of linear inequations: Frédéric Besson (\texttt{psatzl}); Loïc Pottier (\texttt{fourier}) \item Decision of systems of linear inequations over integers: Frédéric Besson (\texttt{lia}); Pierre Crégut (\texttt{omega} and \texttt{romega}) \item (Partial) decision of systems of polynomical inequations (\texttt{sos}, \texttt{psatz}): Frédéric Besson, with generalization over arbitrary rings by Evgeny Makarov; uses HOL-Light interface to \texttt{csdp} by John Harrisson \item Decision/simplification of intuitionistic propositional logic: David Delahaye (\texttt{tauto}, \texttt{intuition}, first version by Cesar Mu\~noz, second version by Chet Murthy), with contributions from Judicaël Courant; Pierre Corbineau (\texttt{rtauto}) \item Decision/simplification of intuition first-order logic: Pierre Corbineau (\texttt{firstorder}) \end{itemize} \section{Extra tools} \begin{itemize} \item Program extraction: Pierre Letouzey (first implementation by Benjamin Werner, second by Jean-Christophe Filliâtre) \end{itemize} \section{Environment management} \begin{itemize} \item Separate compilation: initiated by Chet Murthy \item Import/Export: initiated by Chet Murthy \item Options management: Hugo Herbelin with contributions by Arnaud Spiwack \item Resetting and backtracking: Chet Murthy with contributions from Pierre Courtieu \item Searching: Hugo Herbelin and Yves Bertot with extensions by Matthias Puech \item Whelp support: Hugo Herbelin \end{itemize} \section{Parsing and printing} \begin{itemize} \item General parsing support: Chet Murthy, Bruno Barras, Daniel de Rauglaudre \item General printing support: Chet Murthy, Jean-Christophe Filliâtre \item Lexing: Daniel de Rauglaudre \item Support for UTF-8: Hugo Herbelin, with contributions from Alexandre Miquel and Yann Régis-Gianas \item Numerical notations: Hugo Herbelin, Patrick Loiseleur, Micaela Mayero \item String notations: Hugo Herbelin \item New ``V8'' syntax: Bruno Barras, Hugo Herbelin with contributions by Olivier Desmettre \item Abbreviations: Chet Murthy \item Notations: Chet Murthy, Hugo Herbelin \end{itemize} \section{Libraries} \begin{itemize} \item Init: collective (initiated by Christine Paulin and Gérard Huet) \item Arith: collective (initiated by Christine Paulin) \item ZArith: collective (initiated by Pierre Crégut) \item Bool: collective (initiated by Christine Paulin) \item NArith: Hugo Herbelin, Pierre Letouzey, Evgeny Makarov (out of initial contibution by Pierre Crégut) \item Lists: Pierre Letouzey, Jean-Marc Notin (initiated by Christine Paulin) \item Vectors: Pierre Boutillier \item Reals: Micaela Mayero (axiomatization and main properties), Olivier Desmettre (convergence, derivability, integrals, trigonometric functions), contributions from Russell O'Connor, Cezary Kaliszyk, Guillaume Melquiond, Yves Bertot, Guillaume Allais \item Relations: Bruno Barras, Cristina Cornes with contributions from Pierre Castéran \item Wellfounded: Bruno Barras, Cristina Cornes \item FSets: Pierre Letouzey, from initial work with Jean-Christophe Filliâtre, decision tactic for FSets by Aaron Bohannon, red-black trees by Andrew Appel and Pierre Letouzey \item MSets: Pierre Letouzey \item Logic: Christine Paulin, Hugo Herbelin, Bruno Barras, contributions by Arnaud Spiwack \item Numbers: Evgeny Makarov (abstractions), Laurent Théry and Benjamin Grégoire (big numbers), Arnaud Spiwack and Pierre Letouzey (word-based arithmetic), further extensions by Pierre Letouzey; integration of Arith and ZArith to Numbers by Pierre Letouzey \item Classes: Matthieu Sozeau \item QArith: Pierre Letouzey, with contributions from Russell O'Connor \item Setoid: Matthieu Sozeau (first version by Clément Renard, second version by Claudio Sacerdoti Coen) \item Sets: Gilles Kahn and Gérard Huet \item Sorting: Gérard Huet with revisions by Hugo Herbelin \item Strings: Laurent Théry \item Program: Matthieu Sozeau \item Unicode: Claude Marché \end{itemize} \section{Commands} \begin{itemize} \item Batch compiler (\texttt{coqc}): Chet Murthy (?) \item Compilation dependency calculator (\texttt{coqdep}): Jean-Christophe Filliâtre \item Statistic tool (\texttt{coqwc}): Jean-Christophe Filliâtre \item Simple html presentation tool (\texttt{gallina}) (deprecated): Jean-Christophe Filliâtre \item Auto-maker (\texttt{coq\_makefile}): Jean-Christophe Filliâtre, with contributions from Judicaël Courant, updated by Pierre Boutillier \item LaTeX presentation tool (\texttt{coq-tex}): Jean-Christophe Filliâtre \item Multi-purpose presentation tool (\texttt{coqdoc}): Jean-Christophe Filliâtre with extensions from Matthieu Sozeau, Jean-Marc Notin, Hugo Herbelin and contributions from Adam Chlipala \item Interactive toplevel (\texttt{coqtop}): Jean-Christophe Filliâtre (?) \item Custom toplevel builder (\texttt{coqmktop}): Jean-Christophe Filliâtre (?) \end{itemize} \section{Graphical interfaces} \begin{itemize} \item Support for {\em Proof General}: Pierre Courtieu with contributions from Arnaud Spiwack \item {\em CoqIDE}: Benjamin Monate with contributions from Jean-Christophe Filliâtre, Claude Marché, Pierre Letouzey, Julien Narboux, Hugo Herbelin, Pierre Corbineau, Pierre Boutillier, Pierre-Marie Pédrot; processus-based communication protocol by Vincent Gross with contributions from Pierre Letouzey, Pierre Boutillier, Pierre-Marie Pédrot; backtracking revised by Pierre Letouzey; uses the Cameleon library by Maxence Guesdon; \end{itemize} \section{Architecture} \begin{itemize} \item Functional-kernel-based architecture: Jean-Christophe Filliâtre \item Extensible objects and summaries: Chet Murthy \item Hash-consing: Bruno Barras \item Error locations: Jean-Christophe Filliâtre, Bruno Barras, Hugo Herbelin, with contributions from Arnaud Spiwack \item Existential variables engine: Chet Murthy with revisions by Bruno Barras and Arnaud Spiwack and extensions by Clément Renard and Hugo Herbelin \end{itemize} \section{Development tools} \begin{itemize} \item Makefile's: Chet Murthy, Jean-Christophe Filliâtre, Judicaël Courant, Lionel Mamane, Pierre Corbineau, Pierre Letouzey with contributions from Stéphane Glondu, Hugo Herbelin, ... \item Debugging: Jean-Christophe Filliâtre with contributions from Jacek Chrz\k{a}szcz, Hugo Herbelin, Bruno Barras, ... \item ML quotations: David Delahaye and Daniel de Rauglaudre \item ML tactic and vernacular extensions: Hugo Herbelin (first version by Chet Murthy) \item Test suite: collective content, initiated by Jean-Christophe Filliâtre with further extensions by Hugo Herbelin, Jean-Marc Notin \end{itemize} \section{Maintenance and system engineering} \begin{itemize} \item General bug support: Gérard Huet, Christine Paulin, Chet Murthy, Jean-Christophe Filliâtre, Hugo Herbelin, Bruno Barras, Pierre Letouzey with contributions at some time from Benjamin Werner, Jean-Marc Notin, Pierre Boutillier, ... \item Team coordination: Gérard Huet, Christine Paulin, Hugo Herbelin, with various other contributions \item Packaging tools: Henri Laulhere, David Delahaye, Julien Narboux, Pierre Letouzey, Enrico Tassi (Windows); Damien Doligez, Hugo Herbelin, Pierre Boutillier (MacOS); Jean-Christophe Filliâtre, Judicaël Courant, Hugo Herbelin, Stéphane Glondu (Linux) \end{itemize} \section{Documentation} \begin{itemize} \item Reference Manual: collective, layout by Patrick Loiseleur, Claude Marché (former User's Guide in 1991 by Gilles Dowek, Amy Felty, Hugo Herbelin, Gérard Huet, Christine Paulin, Benjamin Werner; initial documentation in 1989 by Thierry Coquand, Gilles Dowek, Gérard Huet, Christine Paulin), \item Basic tutorial: Gérard Huet, Gilles Kahn, Christine Paulin \item Tutorial on recursive types: Eduardo Gimenez with updates by Pierre Castéran \item FAQ: Hugo Herbelin, Julien Narboux, Florent Kirchner \end{itemize} \section{Features discontinued by lack of support} \begin{itemize} \item Searching modulo isomorphism: David Delahaye \item Explanation of proofs in pseudo-natural language: Yann Coscoy \item Export of context to external communication tools (\texttt{dp}): Nicolas Ayache and Jean-Christophe Filliâtre, with contributions by Claude Marché \item Support for {\em PCoq}: Yves Bertot with contributions by Laurence Rideau and Loïc Pottier; additional support for {\em TmEgg} by Lionel Mamane \item Export of terms and environments to XML format: Claudio Sacerdoti Coen, with extensions from Cezary Kaliszyk \end{itemize} For probable oversights or accidental errors, please report to Hugo~\verb=.=~Herbelin~\verb=@=~inria~\verb=.=~fr \end{document} coq-8.20.0/dev/doc/build-system.dune.md000066400000000000000000000303261466560755400176310ustar00rootroot00000000000000This file documents what a Coq developer needs to know about the Dune-based build system. About Dune ========== Coq uses the [Dune](https://github.com/ocaml/dune) build system. ## Quick Start Usually, using the latest version of Dune is recommended, see the first line of the `dune-project` file for the minimum required version. It is strongly recommended that you use the helper targets available in `Makefile`, `make` will display help. Note that dune will call configure for you if needed, so no need to call `./configure` in the regular development workflow, unless you want to tweak options. 4 common operations are: - `make check` : build all ml targets as fast as possible - `make world` : build a complete Coq distribution - `dune exec -- dev/shim/coqtop` : build and launch coqtop + prelude [equivalent to `make states`]. - `dune build $target`: where `$target` can refer to the build directory or the source directory [but will be placed under `_build`] `dune build @install` will build all the public Coq artifacts; `dune build` builds the `@default` alias, defined in the top level `dune` file. Dune puts build artifacts in a separate directory `_build/$context`; usual `context` is `default`; dune also produces an "install" layout under `_build/install/$context/`. Depending on whether you want refer to the source layout or to the install layout, you may refer to targets in one or the other directory. It will also generate an `.install` file so files can be properly installed by package managers. Dune doesn't allow leftovers of object files it may generate in-tree [as to avoid conflicts], so please be sure your tree is clean from objects files generated by the make-based system or from manual compilation. Contrary to other systems, Dune doesn't use a global `Makefile` but local build files named `dune` which are later composed to form a global build, for example `plugins/ltac/dune` or `kernel/dune`. As a developer, Dune should take care of all OCaml-related build tasks including library management, `merlin` setup, linking order, etc... You should not have to modify `dune` files in regular workflow unless you are adding a new binary, library, or plugin, or want to tweak some low-level option. ## The bootstrap process / rule generation Dune is able to build all the OCaml parts of Coq in a pretty standard way, using its built-in rule generation for OCaml. Public tools written in OCaml are distributed in the `coq-core` package. The set of public `.v` files present in this repository, usually referred as the "Coq Standard Library" are distributed in the `coq-stdlib` package. As of June 2022, Dune has a set of built-in rules for `.v` files which is capable of building Coq's standard library. However, in order to have a bit more control, we generate ourselves a set of custom rules using the `tools/dune_rule_gen` binary, which are then stored in the `theories/dune` file. This allows us to have a finer control over the build rules without having to bump the Dune version. The generation of the `theories/dune` and `user-contrib/*/dune` files is known as "bootstrap". The rule generation code in `tools/dune_rule_gen` is mostly derived from Dune's built-in rules, and it works in an straightforward way: it will scan a directory with `.v` files in it, and output the corresponding build rule. The script will look at some configuration values such as whether native is enabled or not and adapt rule generation accordingly. In the case of native, the script supports two modes, `coqc -native-compiler on` and `coqnative`. The default is the first, as currently `coqnative` incurs a 33% build time overhead on a powerful 16-core machine. There are several modes for the rule generation script to work, depending on the parameter passed. As of today, it support `-async`. `-async` will pass `-async-proofs on` to `coqc`. ## Per-User Custom Settings Dune will read the file `~/.config/dune/config`; see `man dune-config`. Among others, you can set in this file the custom number of build threads `(jobs N)` and display options `(display _mode_)`. ## Running binaries [coqtop / coqide] Running `coqtop` directly with `dune exec -- coqtop` won't in general work well unless you are using `dune exec -- coqtop -noinit`. The `coqtop` binary doesn't depend itself on Coq's prelude, so plugins / vo files may go stale if you rebuild only `coqtop`. Instead, you should use the provided "shims" for running `coqtop` and `coqide` in a fast build. In order to use them, do: ``` $ dune exec -- dev/shim/coqtop ``` or `quickide` / `dev/shim/coqide` for CoqIDE, etc.... See `dev/shim/dune` for a complete list of targets. These targets enjoy quick incremental compilation thanks to `-opaque` so they tend to be very fast while developing. Note that for a fast developer build of ML files, the `check` target is faster, as it doesn't link the binaries and uses the non-optimizing compiler. If you built the full standard library with the `world` target, then you can run the commands in the `_build/install/default/bin` directories (including `coq_makefile`). ## Building custom toplevels You can build custom toplevels by tweaking the `toplevel/dune` files, for example, to add plugins to be linked statically using the `(libraries ...)` field. Note that Coq relies on a hidden Dune hack, which will add `-linkall` to binaries if they depend on the `findlib.dynload` library. As of today, `coq-core.vernac` uses `findlib.dynload`, so if your toplevel hooks at the `coq-core.vernac` or above level, you should be OK, otherwise add `-linkall` to Dune's `(link_flags ...)` field for your binary. ## Targets The default dune target is `dune build` (or `dune build @install`), which will scan all sources in the Coq tree and then build the whole project, creating an "install" overlay in `_build/install/default`. You can build some other target by doing `dune build $TARGET`, where `$TARGET` can be a `.cmxa`, a binary, a file that Dune considers a target, an alias, etc... In order to build a single package, you can do `dune build $PACKAGE.install`. A very useful target is `dune build @check`, that will compile all the ml files in quick mode. Dune also provides targets for documentation, testing, and release builds, please see below. ## Testing and documentation targets There are two ways to run the test suite using Dune: - After building Coq with `make world`, you can run the test-suite in place, generating output files in the source tree by running `make -C test-suite` from the top directory of the source tree (equivalent to running `make test-suite` from the `test-suite` directory). This permits incremental usage since output files will be preserved. - You can also run the test suite in a hygienic way using `make test-suite` or `dune runtest`. This is convenient for full runs from scratch, for instance in CI. Since `dune` still invokes the test-suite makefile, the environment variable `NJOBS` is used to set the `-j` option that is passed to make (for example, with the command `NJOBS=8 dune runtest`). This use of `NJOBS` will be removed when the test suite is fully ported to Dune. There is preliminary support to build the API documentation and reference manual in HTML format, use `dune build {@doc,@refman-html}` to generate them. So far these targets will build the documentation artifacts, however no install rules are generated yet. ## Developer shell You can create a developer shell with `dune utop $library`, where `$library` can be any directory in the current workspace. For example, `dune utop engine` or `dune utop plugins/ltac` will launch `utop` with the right libraries already loaded. ## ocamldebug You can use [ocamldebug](https://ocaml.org/learn/tutorials/debug.html#The-OCaml-debugger) with Dune; after a build, do: ``` dune exec -- dev/dune-dbg coqc foo.v (ocd) source db ``` to start `coqc.byte foo.v`, other targets are `{checker,coqide,coqtop}`: ``` dune exec -- dev/dune-dbg checker foo.vo (ocd) source db ``` Unfortunately, dependency handling is not fully refined / automated, you may find the occasional hiccup due to libraries being renamed, etc... Please report any issue. For running in emacs, use `coqdev-ocamldebug` from `coqdev.el`. ### Debugging hints - To debug a failure/error/anomaly, add a breakpoint in `Vernacinterp.interp_gen` (in `vernac/vernacinterp.ml`) at the with clause of the "try ... with ..." block, then go "back" a few steps to find where the failure/error/anomaly has been raised - Alternatively, for an error or an anomaly, add breakpoints where it was raised (eg in `user_err` or `anomaly` in `lib/cErrors.ml`, or the functions in `pretyping/pretype_errors.ml`, or other raises depending on the error) - If there is a linking error (eg from "source db"), do a "dune build coq-core.install" and try again. ## Dropping from coqtop: The following commands should work: ``` dune exec -- dev/shim/coqtop.byte > Drop. ``` ## Compositionality, developer and release modes. By default [in "developer mode"], Dune will compose all the packages present in the tree and perform a global build. That means that for example you could drop the `ltac2` folder under `plugins` and get a build using `ltac2`, that will use the current Coq version. This is very useful to develop plugins and Coq libraries as your plugin will correctly track dependencies and rebuild incrementally as needed. However, it is not always desirable to go this way. For example, the current Coq source tree contains two packages [Coq and CoqIDE], and in the OPAM CoqIDE package we don't want to build CoqIDE against the local copy of Coq. For this purpose, Dune supports the `-p` option, so `dune build -p coqide` will build CoqIDE against the system-installed version of Coq libs, and use a "release" profile that for example enables stronger compiler optimizations. ## OPAM file generation `.opam` files will be automatically generated by Dune from the package descriptions in the `dune-project` file; see Dune's manual for more details. For now we have disabled this due to some bugs. ## Stanzas `dune` files contain the so-called "stanzas", that may declare: - libraries, - executables, - documentation, arbitrary blobs. The concrete options for each stanza can be seen in the Dune manual, but usually the default setup will work well with the current Coq sources. Note that declaring a library or an executable won't make it installed by default, for that, you need to provide a "public name". ## Workspaces and Profiles Dune provides support for tree workspaces so the developer can set global options --- such as flags --- on all packages, or build Coq with different OPAM switches simultaneously [for example to test compatibility]; for more information, please refer to the Dune manual. ## Inlining reports The `ireport` profile will produce standard OCaml [inlining reports](https://caml.inria.fr/pub/docs/manual-ocaml/flambda.html#sec488). These are to be found under `_build/default/$lib/$lib.objs/$module.$round.inlining.org` and are in Emacs `org-mode` format. Note that due to https://github.com/ocaml/dune/issues/1401 , we must perform a full rebuild each time as otherwise Dune will remove the files. We hope to solve this in the future. ## Planned and Advanced features Dune supports or will support extra functionality that may result very useful to Coq, some examples are: - Cross-compilation. - Automatic Generation of OPAM files. - Multi-directory libraries. ## FAQ - I get "Error: Dynlink error: Interface mismatch": You are likely running a partial build which doesn't include implicitly loaded plugins / vo files. See the "Running binaries [coqtop / coqide]" section above as to how to correctly call Coq's binaries. ## Dune cheat sheet - `dune build` build all targets in the current workspace - `dune build @check` build all ML targets as fast as possible, setup merlin - `dune utop $dir` open a shell for libraries in `$dir` - `dune exec -- $file` build and execute binary `$file`, can be in path or be an specific name - `dune build _build/$context/$foo` build target `$foo$` in `$context`, with build dir layout - `dune build _build/install/$context/foo` build target `$foo$` in `$context`, with install dir layout ### packaging: - `dune subst` generate metadata for a package to be installed / distributed, necessary for opam - `dune build -p $pkg` build a package in release mode coq-8.20.0/dev/doc/case-repr.md000066400000000000000000000107001466560755400161310ustar00rootroot00000000000000## Case representation Starting from Coq 8.14, the term representation of pattern-matching uses a so-called *compact form*. Compared to the previous representation, the major difference is that all type and term annotations on lambda and let abstractions that were present in branches and return clause of pattern-matchings were removed. In order to keep the ability to construct the old expanded form out of the new compact form, the case node also makes explicit data that was stealthily present in the expanded return clause, namely universe instances and parameters of the inductive type being eliminated. ### ML Representation The case node now looks like ``` Case of case_info * Instance.t * (* universe instances of the inductive *) constr array * (* parameters of the inductive *) case_return * (* erased return clause *) case_invert * (* SProp inversion data *) constr * (* scrutinee *) case_branch array (* erased branches *) ``` where ``` type case_branch = Name.t binder_annot array * constr type case_return = Name.t binder_annot array * types ``` For comparison, pre-8.14 case nodes were defined as follows. ``` Case of case_info * constr * (* annotated return clause *) case_invert * (* SProp inversion data *) constr * (* scrutinee *) constr array (* annotated branches *) ``` ### Typing Rules and Invariants Disregarding the `case_info` cache and the SProp inversion, the typing rules for the case node can be given as follows. Provided - Γ ⊢ c : Ind@{u} pms Indices - Inductive Ind@{i} Δ : forall Θ, Type := cᵢ : forall Ξᵢ, Ind Δ Aᵢ - Γ, Θ@{i := u}{Δ := pms} ⊢ p : Type - Γ, Ξᵢ@{i := u}{Δ := pms} ⊢ snd brᵢ : p{Θ := Aᵢ{Δ := pms}} Then Γ ⊢ Case (_, u, pms, ( _, p), _, c, br) : p{Θ := Indices} In particular, this implies that Γ ⊢ pms : Δ@{i := u}. Parameters are stored in the same order as in the application node. The u universe instance must be a valid instance for the corresponding inductive type, in particular their length must coincide. The `Name.t binder_annot array` appearing both in the return clause and in the branches must satisfy these invariants: - For branches, it must have the same length as the corresponding Ξᵢ context (including let-ins) - For the return clause, it must have the same length as the context Θ, self : Ind@{u} pms Θ (including let-ins). The last variable appears as the term being destructed and corresponds to the variable introduced by the "as" clause of the user-facing syntax. - The relevance annotations must match with the corresponding sort of the variable from the context. Note that the annotated variable array is reversed w.r.t. the context, i.e. variables appear left to right as in standard practice. Let-bindings can appear in Δ, Θ or Ξᵢ, since they are arbitrary contexts. As a general rule, let bindings appear as binders but not as instances. That is, they MUST appear in the variable array, but they MUST NOT appear in the parameter array. Example: ``` Inductive foo (X := tt) : forall (Y := X), Type := Foo : forall (Z := X), foo. Definition case (x : foo) : unit := match x as x₀ in foo with Foo _ z => z end ``` The case node of the `case` function is represented as ``` Case ( _, Instance.empty, [||], ([|(Y, Relevant); (x₀, Relevant)|], unit), (* let (Y := tt) in fun (x₀ : foo) => unit *) NoInvert, #1, [| ([|(z, Relevant)|], #1) (* let z := tt in z *) |] ) ``` This choice of representation for let-bindings requires access to the environment in some cases, e.g. to compute branch reduction. There is a fast-path for non-let-containing inductive types though, which are the vast majority. ### Porting plugins The conversion functions from and to the expanded form are: - `[Inductive, EConstr].expand_case` which goes from the compact to the expanded form and cannot fail (assuming the term was well-typed) - `[Inductive, EConstr].contract_case` which goes the other way and will raise anomalies if the expanded forms are not fully eta-expanded. As such, it is always painless to convert to the old representation. Converting the other way, you must ensure that all the terms you provide the compatibility function with are fully eta-expanded, **including let-bindings**. This works as expected for the common case with eta-expanded branches but will fail for plugins that generate non-eta-expanded branches. Some other useful variants of these functions are: - `Inductive.expand_case_specif` - `EConstr.annotate_case` - `EConstr.expand_branch` coq-8.20.0/dev/doc/changes.md000066400000000000000000002151061466560755400156670ustar00rootroot00000000000000## Changes between Coq 8.17 and Coq 8.18 ### XML protocol Version 20230413, see xml-protocol.md for details. - Coq locations are now fully transmitted, including line and column information vs the previous start/end offset. ## Changes between Coq 8.15 and Coq 8.16 ### Plugin Interface Plugins are now identified by a findlib library name of the form `pkg.lib`. This way, plugins can depend on other libraries and Coq can properly load the required dependencies. It is necessary to adjust plugin code: - `.mlg` files must now use `DECLARE PLUGIN "pkg.lib"` instead of `DECLARE PLUGIN "library_name"`. - `.v` files should use `Declare ML Module "pkg.lib"`, or, if using Dune, `Declare ML Module "library_name:pkg.lib"` until Dune is adapted. You must also provide the corresponding `META` file if your build system doesn't generate it automatically (see the documentation of `-generate-meta-for-package` for how `coq_makefile` can generate it automatically). ### XML protocol See xml-protocol.md for details. - Added a `Subgoals` command to give more fine-grained control over which of the foreground, background, shelved and given up goals are returned. ## Changes between Coq 8.14 and Coq 8.15 ### XML protocol See xmlprotocol.md for details. - Added 4 new "db_*" messages to support the Ltac debugger - Modified the "add" request (not backward compatible), adding 3 additional parameters to the request giving the buffer offset of the added statement. The parameters are Loc.bp, Loc.line_nb and Loc.bol_pos, which are needed so the debugger gets back a buffer-relative Loc.t rather than a sentence-relative Loc.t. For other use cases, these can be set to 0. ### Internal representation of the type of constructors The type of constructors in fields `mind_user_lc` and `mind_nf_lc` of an inductive packet (see `declarations.ml`) now directly refer to the inductive type rather than to a `Rel` poimting in a context made of the declaration of the inductive types of the block. Thus, instead of `Rel n`, one finds `Ind((mind,ntypes-n),u)` where `ntypes` is the number of types in the block and `u` is the canonical instance of polymoprhic universes (i.e. `Level.Var 0` ... `Level.Var (nbuniv-1)`). In general, code can be adapted by: - either removing a substitution `Rel`->`Ind` if such substitution was applied - or inserting a call to `Inductive.abstract_constructor_type_relatively_to_inductive_types_context` to restore `Rel`s in place of `Ind`s if `Rel`s were expected. ### Universes - Type `UVars.UContext` now embeds universe user names, generally resulting in more concise code. - Renaming `Univ.Constraint` into `Univ.Constraints` - Renaming `LSet` into `Level.Set` and `LMap` into `Level.Map` ### Concrete syntax - Explicit nodes `CProj` and `GProj` have been added for the syntax of projections `t.(f)` in `constr_expr` and `glob_constr`, while they were previously encoded in the `CApp` and `GApp` nodes. There may be a need for adding a new case in pattern-matching. The types of `CApp` and `CAppExpl` have been simplified accordingly. ### Functions manipulating contexts A few functions in Vars, Context, Termops, EConstr have moved. The deprecation warning tells what to do. ### Build system and infrastructure - The Windows installer CI build has been moved from the custom workers based on Inria cloud to a standard Github Action, see https://github.com/coq/coq/pull/12425 . Fixes https://github.com/coq/coq/issues/6807 https://github.com/coq/coq/issues/7428 https://github.com/coq/coq/issues/8046 https://github.com/coq/coq/issues/8622 https://github.com/coq/coq/issues/9401 https://github.com/coq/coq/issues/11073 . - Location of Coq's runtime environment and files is now handled by a new library, `coq-core.boot`, which provides a more uniform and centralized API to locate files. ## Changes between Coq 8.13 and Coq 8.14 ### Build system and library infrastructure - ocamlfind library names `coq.*` have been renamed to `coq-core.*`. - Dune is now used to build the OCaml parts of Coq, thus: + ML object files live now in `_build`, as standard in Dune world + you can build object files using `make _build/install/default/bin/coqc`, thanks to our implementation of a make-Dune bridge + .vo files live now in `_build_vo/` + `_build_vo` follows a standard "Coq install layout", that is to say: * `_build_vo/default/bin`: coq-core binaries * `_build_vo/default/lib/coq-core`: coq-core libraries * `_build_vo/default/lib/coq`: coq libraries, such as stdlib This greatly simplifies layout as tooling can assume that `_build_vo/default` has the structure of an installed Coq, thus making the `-local` flag obsolete. + Some developer targets have changed or have been removed in favor of Dune's counterparts, for example `byte` and `install-byte` are no longer needed. For the large majority of developers, we recommend using the full dune build, which is accessible by `make -f Makefile.dune` or by setting the `COQ_USE_DUNE` environment variable. - As a consequence of the above, the packing of plugins has changed. Plugins are now packed using modules aliases which is in general safer w.r.t. scoping, as the container module is just a regular OCaml module. ### Gramlib - A few functions change their interfaces to take benefit of a new abstraction level `LStream` for streams with location function. - Grammar extensions now require specifying whether they create a level or they reuse an existing one. In addition to the Gramlib API changes, GRAMMAR EXTEND stanzas may need a few tweaks. Their grammar was changed so that level and associativity arguments that would have been ignored are now forbidden. Furthermore, extensions without an explicit position now expect the entry to be empty. If it is not the case, the extension will fail at runtime with an assertion failure located near the offending entry. To recover the old behaviour, one needs to explicitly add the new TOP position to the extension. This position expects the entry to be non-empty and populates the topmost defined level with the provided rules. Note that this differs from FIRST, which creates a new level and prepends it to the list of levels of the entry. ### Notations: - The type `notation_entry_level` has been split into two: the name `notation_entry_level` still exists and is used to characterize the level and custom entry name (if any) where a grammar rule lives; the new `notation_subentry_level` is to characterize the level (possibly none) and custom entry name associated to the variables (= non-terminal subentries) of the grammar rule. ## Changes between Coq 8.12 and Coq 8.13 ### 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`. Dumpglob: - The function `Dumpglob.pause` and `Dumpglob.continue` are replaced by `Dumpglob.push_output` and `Dumpglob.pop_output`. This allows plugins to temporarily change/pause the output of Dumpglob, and then restore it to the original setting. Glob_term: - Removing useless `binding_kind` argument of `GLocalDef` in `extended_glob_local_binder`. ## Changes between Coq 8.11 and Coq 8.12 ### Code formatting - The automatic code formatting tool `ocamlformat` is enabled now for the micromega codebase. Version 0.13.0 is required. See `ocalmformat`'s documentation for more details on integration with your editor. ### ML API Proof state and constant declaration: - A large consolidation of the API handling interactive and non-interactive constant has been performed; low-level APIs are no longer available, and the functionality of the `Proof_global` module has been merged into `Declare`. Notations: - Most operators on numerals have moved to file numTok.ml. - Types `precedence`, `parenRelation`, `tolerability` in `notgram_ops.ml` have been reworked. See `entry_level` and `entry_relative_level` in `constrexpr.ml`. Exception handling: - Coq's custom `Backtrace` module has been removed in favor of OCaml's native backtrace implementation. Please use the functions in `Exninfo.capture` and `iraise` when re-raising inside an exception handler. - Registration of exception printers now follows more closely OCaml's API, thus: + printers are of type `exn -> Pp.t option` [`None` == not handled] + it is forbidden for exception printers to raise. - Refiner.catchable_exception is deprecated, use instead CErrors.noncritical in try-with block. Note that nothing is needed in tclORELSE block since the exceptions there are supposed to be non-critical by construction. Printers: - Functions such as Printer.pr_lconstr_goal_style_env have been removed, use instead functions such as pr_lconstr with label `goal_concl_style:true`. Functions such as Constrextern.extern_constr which were taking a boolean argument for the goal style now take instead a label. Implicit arguments: - The type `Impargs.implicit_kind` was removed in favor of `Glob_term.binding_kind`. ## Changes between Coq 8.10 and Coq 8.11 ### ML API - Function UnivGen.global_of_constr has been removed. - Functions and types deprecated in 8.10 have been removed in Coq 8.11. - Type Decl_kinds.locality has been restructured, see commit message. Main change to do generally is to change the flag "Global" to "Global ImportDefaultBehavior". Proof state: Proofs that are attached to a top-level constant (such as lemmas) are represented by `Lemmas.t`, as they do contain additional information related to the constant declaration. Some functions have been renamed from `start_proof` to `start_lemma` Plugins that require access to the information about currently opened lemmas can add one of the `![proof]` attributes to their `mlg` entry, which will refine the type accordingly. See documentation in `vernacentries` for more information. Proof `terminators` have been removed in favor of a principled proof-saving path. This should not affect the regular API user, but if plugin writes need special handling of the proof term they should now work with Coq upstream to unsure the provided API does work and is principled. Closing `hooks` are still available for simple registration on constant save path, and essentially they do provide the same power as terminators, but don't encourage their use other than for simple tasks [such as adding a constant to a database] Additionally, the API for proof/lemma handling has been refactored, triples have been split into named arguments, and a few bits of duplicated information among layers has been cleaned up. Most proof information is now represented in a direct-style, as opposed to it living inside closures in previous Coq versions; thus, proof manipulation possibilities have been improved. ## Changes between Coq 8.9 and Coq 8.10 ### ML4 Pre Processing - Support for `.ml4` files, processed by camlp5 has been removed in favor of `.mlg` files processed by `coqpp`. Porting is usually straightforward, and involves renaming the `file.ml4` file to `file.mlg` and adding a few brackets. See "Transitioning away from Camlp5" below for update instructions. ### ML API SProp was added, see General deprecation - All functions marked [@@ocaml.deprecated] in 8.8 have been removed. Please, make sure your plugin is warning-free in 8.8 before trying to port it over 8.9. Warnings - Coq now builds plugins with `-warn-error` enabled by default. The amount of dangerous warnings in plugin code was very high, so we now require plugins in the CI to adhere to the Coq warning policy. We _strongly_ recommend against disabling the default set of warnings. If you have special needs, see the documentation of your build system and/or OCaml for further help. Names - Kernel names no longer contain a section path. They now have only two components (module path and label), which led to some changes in the API: KerName.make takes only 2 components KerName.repr returns only 2 components KerName.make2 is now KerName.make Constant.make3 has been removed, use Constant.make2 Constant.repr3 has been removed, use Constant.repr2 - `Names.transparent_state` has been moved to its own module `TransparentState`. This module gathers utility functions that used to be defined in several places. Coqlib: - Most functions from the `Coqlib` module have been deprecated in favor of `register_ref` and `lib_ref`. The first one is available through the vernacular `Register` command; it binds a name to a constant. The second command then enables to locate the registered constant through its name. The name resolution is dynamic. Proof state: - Handling of proof state has been fully functionalized, thus it is not possible to call global functions such as `get_current_context ()`. The main type for functions that need to handle proof state is `Proof_global.t`. Unfortunately, this change was not possible to do in a backwards-compatible way, but in most case the api changes are straightforward, with functions taking and returning an extra argument. Macros: - The RAW_TYPED AS and GLOB_TYPED AS stanzas of the ARGUMENT EXTEND macro are deprecated. Use TYPED AS instead. - coqpp (.mlg) based VERNAC EXTEND accesses attributes through a `#[ x = att ]` syntax, where `att : 'a Attributes.attribute` and `x` will be bound with type `'a` in the expression, unlike the old system where `atts : Vernacexpr.vernac_flags` was bound in the expression and had to be manually parsed. - `PRINTED BY` now binds `env` and `sigma`, and expects printers which take as parameters term printers parametrized by an environment and an `evar_map`. Printers - `Ppconstr.pr_constr_expr`, `Ppconstr.lconstr_expr`, `Ppconstr.pr_constr_pattern_expr` and `Ppconstr.pr_lconstr_pattern_expr` now all take an environment and an `evar_map`. Libobject - A Higher-level API for objects with fixed scope was introduced. It supports the following kinds of objects: * Local objects, meaning that objects cannot be imported from outside. * Global objects, meaning that they can be imported (by importing the module that contains the object). * Superglobal objects, meaning that objects survive to closing a module, and are imported when the file which contains them is Required (even without Import). * Objects that survive section closing or don't (see `nodischarge` variants, however we discourage defining such objects) This API is made of the following functions: * `Libobject.local_object` * `Libobject.local_object_nodischarge` * `Libobject.global_object` * `Libobject.global_object_nodischarge` * `Libobject.superglobal_object` * `Libobject.superglobal_object_nodischarge` AST - Minor changes in the AST have been performed, for example https://github.com/coq/coq/pull/9165 Implicit Arguments - `Impargs.declare_manual_implicits` is restricted to only support declaration of implicit binders at constant declaration time. `Impargs.set_implicits` should be used for redeclaration of implicit arguments. ## Changes between Coq 8.8 and Coq 8.9 ### ML API Names - In `Libnames`, the type `reference` and its two constructors `Qualid` and `Ident` have been removed in favor of `qualid`. `Qualid` is now the identity, `Ident` can be replaced by `qualid_of_ident`. Matching over `reference` can be replaced by a test using `qualid_is_ident`. Extracting the `ident` part of a `qualid` can be done using `qualid_basename`. Misctypes - Syntax for universe sorts and kinds has been moved from `Misctypes` to `Glob_term`, as these are turned into kernel terms by `Pretyping`. Proof engine - More functions have been changed to use `EConstr`, notably the functions in `Evd`, and in particular `Evd.define`. Note that the core function `EConstr.to_constr` now _enforces_ by default that the resulting term is ground, that is to say, free of Evars. This is usually what you want, as open terms should be of type `EConstr.t` to benefit from the invariants the `EConstr` API is meant to guarantee. In case you'd like to violate this API invariant, you can use the `abort_on_undefined_evars` flag to `EConstr.to_constr`, but note that setting this flag to false is deprecated so it is only meant to be used as to help port pre-EConstr code. - A few type alias have been deprecated, in all cases the message should indicate what the canonical form is. An important change is the move of `Globnames.global_reference` to `Names.GlobRef.t`. - Unification API returns `evar_map option` instead of `bool * evar_map` with the guarantee that the `evar_map` was unchanged if the boolean was false. ML Libraries used by Coq - Introduction of a `Smart` module for collecting `smart*` functions, e.g. `Array.Smart.map`. - Uniformization of some names, e.g. `Array.Smart.fold_left_map` instead of `Array.smartfoldmap`. Printer.ml API - The mechanism in `Printer` that allowed dynamically overriding `pr_subgoals`, `pr_subgoal` and `pr_goal` was removed to simplify the code. It was earlier used by PCoq. Kernel - The following renamings happened: - `Context.Rel.t` into `Constr.rel_context` - `Context.Named.t` into `Constr.named_context` - `Context.Compacted.t` into `Constr.compacted_context` - `Context.Rel.Declaration.t` into `Constr.rel_declaration` - `Context.Named.Declaration.t` into `Constr.named_declaration` - `Context.Compacted.Declaration.t` into `Constr.compacted_declaration` Source code organization - We have eliminated / fused some redundant modules and relocated a few interfaces files. The `intf` folder is gone, and now for example `Constrexpr` is located in `interp/`, `Vernacexpr` in `vernac/` and so on. Changes should be compatible, but in a few cases stricter layering requirements may mean that functions have moved. In all cases adapting is a matter of changing the module name. Vernacular commands - The implementation of vernacular commands has been refactored so it is self-contained now, including the parsing and extension mechanisms. This involves a couple of non-backward compatible changes due to layering issues, where some functions have been moved from `Pcoq` to `Pvernac` and from `Vernacexpr` to modules in `tactics/`. In all cases adapting is a matter of changing the module name. Primitive number parsers - For better modularity, the primitive parsers for `positive`, `N` and `Z` have been split over three files (`plugins/syntax/positive_syntax.ml`, `plugins/syntax/n_syntax.ml`, `plugins/syntax/z_syntax.ml`). Parsing - Manual uses of the `Pcoq.Gram` module have been deprecated. Wrapper modules `Pcoq.Entry` and `Pcoq.Parsable` were introduced to replace it. Termops - Internal printing functions have been placed under the `Termops.Internal` namespace. ### Unit testing The test suite now allows writing unit tests against OCaml code in the Coq code base. Those unit tests create a dependency on the OUnit test framework. ### Transitioning away from Camlp5 In an effort to reduce dependency on camlp5, the use of several grammar macros is discouraged. Coq is now shipped with its own preprocessor, called coqpp, which serves the same purpose as camlp5. To perform the transition to coqpp macros, one first needs to change the extension of a macro file from `.ml4` to `.mlg`. Not all camlp5 macros are handled yet. Due to parsing constraints, the syntax of the macros is slightly different, but updating the source code is mostly a matter of straightforward search-and-replace. The main differences are summarized below. #### OCaml code Every piece of toplevel OCaml code needs to be wrapped into braces. For instance, code of the form ``` let myval = 0 ``` should be turned into ``` { let myval = 0 } ``` #### TACTIC EXTEND Steps to perform: - replace the brackets enclosing OCaml code in actions with braces - if not there yet, add a leading `|` to the first rule For instance, code of the form: ``` TACTIC EXTEND my_tac [ "tac1" int_or_var(i) tactic(t) ] -> [ mytac1 ist i t ] | [ "tac2" tactic(t) ] -> [ mytac2 t ] END ``` should be turned into ``` TACTIC EXTEND my_tac | [ "tac1" int_or_var(i) tactic(t) ] -> { mytac1 ist i t } | [ "tac2" tactic(t) ] -> { mytac2 t } END ``` #### VERNAC EXTEND Steps to perform: - replace the brackets enclosing OCaml code in actions and rule classifiers with braces - if not there yet, add a leading `|̀ to the first rule Handwritten classifiers declared through the `CLASSIFIED BY` statement are considered OCaml code, so they also need to be wrapped in braces. For instance, code of the form: ``` VERNAC COMMAND EXTEND my_command CLASSIFIED BY classifier [ "foo" int(i) ] => [ classif' ] -> [ cmd1 i ] | [ "bar" ] -> [ cmd2 ] END ``` should be turned into ``` VERNAC COMMAND EXTEND my_command CLASSIFIED BY { classifier } | [ "foo" int(i) ] => { classif' } -> { cmd1 i } | [ "bar" ] -> { cmd2 } END ``` #### ARGUMENT EXTEND Steps to perform: - replace the brackets enclosing OCaml code in actions with braces - if not there yet, add a leading `|` to the first rule - syntax of `TYPED AS` has been restricted not to accept compound generic arguments as a literal, e.g. `foo_opt` should be rewritten into `foo option` and similarly `foo_list` into `foo list`. - parenthesis around pair types in `TYPED AS` are now mandatory - `RAW_TYPED AS` and `GLOB_TYPED AS` clauses need to be removed `BY` clauses are considered OCaml code, and thus need to be wrapped in braces, but not the `TYPED AS` clauses. For instance, code of the form: ``` ARGUMENT EXTEND my_arg TYPED AS int_opt PRINTED BY printer INTERPRETED BY interp_f GLOBALIZED BY glob_f SUBSTITUTED BY subst_f RAW_TYPED AS int_opt RAW_PRINTED BY raw_printer GLOB_TYPED AS int_opt GLOB_PRINTED BY glob_printer [ "foo" int(i) ] -> [ my_arg1 i ] | [ "bar" ] -> [ my_arg2 ] END ``` should be turned into ``` ARGUMENT EXTEND my_arg TYPED AS { int_opt } PRINTED BY { printer } INTERPRETED BY { interp_f } GLOBALIZED BY { glob_f } SUBSTITUTED BY { subst_f } RAW_PRINTED BY { raw_printer } GLOB_PRINTED BY { glob_printer } | [ "foo" int(i) ] -> { my_arg1 i } | [ "bar" ] -> { my_arg2 } END ``` #### GEXTEND Most plugin writers do not need this low-level interface, but for the sake of completeness we document it. Steps to perform are: - replace `GEXTEND` with `GRAMMAR EXTEND` - wrap every occurrence of OCaml code in actions into braces `{ }` For instance, code of the form ``` GEXTEND Gram GLOBAL: my_entry; my_entry: [ [ x = bar; y = qux -> do_something x y | "("; z = LIST0 my_entry; ")" -> do_other_thing z ] ]; END ``` should be turned into ``` GRAMMAR EXTEND Gram GLOBAL: my_entry; my_entry: [ [ x = bar; y = qux -> { do_something x y } | "("; z = LIST0 my_entry; ")" -> { do_other_thing z } ] ]; END ``` Caveats: - No `GLOBAL` entries mean that they are all local, while camlp5 special-cases this as a shorthand for all global entries. Solution: always define a `GLOBAL` section. - No complex patterns allowed in token naming. Solution: match on it inside the OCaml quotation. ## Changes between Coq 8.7 and Coq 8.8 ### Bug tracker As of 18/10/2017, Coq uses [GitHub issues](https://github.com/coq/coq/issues) as bug tracker. Old bug reports were migrated from Bugzilla to GitHub issues using [this migration script](https://gist.github.com/Zimmi48/d923e52f64fe17c72852d9c148bfcdc6#file-bugzilla2github) as detailed in [this blog post](https://www.theozimmermann.net/2017/10/bugzilla-to-github/). All the bugs with a number below 1154 had to be renumbered, you can find a correspondence table [here](/dev/bugzilla2github_stripped.csv). All the other bugs kept their number. ### ML API General deprecation - All functions marked `[@@ocaml.deprecated]` in 8.7 have been removed. Please, make sure your plugin is warning-free in 8.7 before trying to port it over 8.8. Proof engine - Due to the introduction of `EConstr` in 8.7, it is not necessary to track "goal evar normal form status" anymore, thus the type `'a Proofview.Goal.t` loses its ghost argument. This may introduce some minor incompatibilities at the typing level. Code-wise, things should remain the same. We removed the following functions: - `Universes.unsafe_constr_of_global`: use `Global.constr_of_global_in_context` instead. The returned term contains De Bruijn universe variables. If you don't depend on universes being instantiated, simply drop the context. - `Universes.unsafe_type_of_global`: same as above with `Global.type_of_global_in_context` We changed the type of the following functions: - `Global.body_of_constant_body`: now also returns the abstract universe context. The returned term contains De Bruijn universe variables. - `Global.body_of_constant`: same as above. - `Constrinterp.*`: generally, many functions that used to take an `evar_map ref` have now been switched to functions that will work in a functional way. The old style of passing `evar_map`s as references is not supported anymore. Changes in the abstract syntax tree: - The practical totality of the AST has been nodified using `CAst.t`. This means that all objects coming from parsing will be indeed wrapped in a `CAst.t`. `Loc.located` is on its way to deprecation. Some minor interfaces changes have resulted from this. We have changed the representation of the following types: - `Lib.object_prefix` is now a record instead of a nested tuple. Some tactics and related functions now support static configurability, e.g.: - `injectable`, `dEq`, etc. take an argument `~keep_proofs` which, - if `None`, tells to behave as told with the flag `Keep Proof Equalities` - if `Some b`, tells to keep proof equalities iff `b` is true Declaration of printers for arguments used only in vernac command - It should now use `declare_extra_vernac_genarg_pprule` rather than `declare_extra_genarg_pprule`, otherwise, a failure at runtime might happen. An alternative is to register the corresponding argument as a value, using `Geninterp.register_val0 wit None`. Types Alias deprecation and type relocation. - A few type alias have been deprecated, in all cases the message should indicate what the canonical form is. ### STM API The STM API has seen a general overhaul. The main change is the introduction of a "Coq document" type, which all operations now take as a parameter. This effectively functionalize the STM API and will allow in the future to handle several documents simultaneously. The main remarkable point is that key implicit global parameters such as load-paths and required modules are now arguments to the document creation function. This helps enforcing some key invariants. ### XML IDE Protocol - Before 8.8, `Query` only executed the first command present in the `query` string; starting with 8.8, the caller may include several statements. This is useful for instance for temporarily setting an option and then executing a command. ## Changes between Coq 8.6 and Coq 8.7 ### Ocaml Coq is compiled with `-safe-string` enabled and requires plugins to do the same. This means that code using `String` in an imperative way will fail to compile now. They should switch to `Bytes.t` Configure supports passing flambda options, use `-flambda-opts OPTS` with a flambda-enabled Ocaml to tweak the compilation to your taste. ### ML API - Added two functions for declaring hooks to be executed in reduction functions when some given constants are traversed: * `declare_reduction_effect`: to declare a hook to be applied when some constant are visited during the execution of some reduction functions (primarily `cbv`). * `set_reduction_effect`: to declare a constant on which a given effect hook should be called. - We renamed the following functions: ``` Context.Rel.Declaration.fold -> Context.Rel.Declaration.fold_constr Context.Named.Declaration.fold -> Context.Named.Declaration.fold_constr Printer.pr_var_list_decl -> Printer.pr_compacted_decl Printer.pr_var_decl -> Printer.pr_named_decl Nameops.lift_subscript -> Nameops.increment_subscript ``` - We removed the following functions: * `Termops.compact_named_context_reverse`: practical substitute is `Termops.compact_named_context`. * `Namegen.to_avoid`: equivalent substitute is `Names.Id.List.mem`. - We renamed the following modules: * `Context.ListNamed` -> `Context.Compacted` - The following type aliases where removed * `Context.section_context`: it was just an alias for `Context.Named.t` which is still available. - The module `Constrarg` was merged into `Stdarg`. - The following types have been moved and modified: * `local_binder` -> `local_binder_expr` * `glob_binder` merged with `glob_decl` - The following constructors have been renamed: ``` LocalRawDef -> CLocalDef LocalRawAssum -> CLocalAssum LocalPattern -> CLocalPattern ``` - In `Constrexpr_ops`: Deprecating `abstract_constr_expr` in favor of `mkCLambdaN`, and `prod_constr_expr` in favor of `mkCProdN`. Note: the first ones were interpreting `(x y z:_)` as `(x:_) (y:_) (z:_)` while the second ones were preserving the original sharing of the type. - In `Nameops`: The API has been made more uniform. New combinators added in the `Name` space name. Function `out_name` now fails with `IsAnonymous` rather than with `Failure "Nameops.out_name"`. - Location handling and AST attributes: Location handling has been reworked. First, `Loc.ghost` has been removed in favor of an option type, all objects carrying an optional source code location have been switched to use `Loc.t option`. Storage of location information has been also refactored. The main datatypes representing Coq AST (`constrexpr`, `glob_expr`) have been switched to a generic "node with attributes" representation `'a CAst.ast`, which is a record of the form: ```ocaml type 'a ast = private { v : 'a; loc : Loc.t option; ... } ``` consumers of AST nodes are recommended to use accessor-based pattern matching `{ v; loc }` to destruct `ast` object. Creation is done with `CAst.make ?loc obj`, where the attributes are optional. Some convenient combinators are provided in the module. A typical match: ```ocaml | CCase(loc, a1) -> CCase(loc, f a1) ``` is now done as: ```ocaml | { v = CCase(a1); loc } -> CAst.make ?loc @@ CCase(f a1) ``` or even better, if plan to preserve the attributes you can wrap your top-level function in `CAst.map` to have: ```ocaml | CCase(a1) -> CCase(f a1) ``` This scheme based on records enables easy extensibility of the AST node type without breaking compatibility. Not all objects carrying a location have been converted to the generic node representation, some of them may be converted in the future, for some others the abstraction is not just worth it. Thus, we still maintain a `'a Loc.located == Loc.t option * a'`, tuple type which should be treated as private datatype (ok to match against, but forbidden to manually build), and it is mandatory to use it for objects that carry a location. This policy has been implemented in the whole code base. Matching a located object hasn't changed, however, `Loc.tag ?loc obj` must be used to build one. - In `GOption`: Support for non-synchronous options has been removed. Now all options are handled as a piece of normal document state, and thus passed to workers, etc... As a consequence, the field `Goptions.optsync` has been removed. - In `Coqlib` / reference location: We have removed from Coqlib functions returning `constr` from names. Now it is only possible to obtain references, that must be processed wrt the particular needs of the client. We have changed in constrintern the functions returnin `constr` as well to return global references instead. Users of `coq_constant/gen_constant` can do `Universes.constr_of_global (find_reference dir r)` _however_ note the warnings in the `Universes.constr_of_global` in the documentation. It is very likely that you were previously suffering from problems with polymorphic universes due to using `Coqlib.coq_constant` that used to do this. You must rather use `pf_constr_of_global` in tactics and `Evarutil.new_global` variants when constructing terms in ML (see univpoly.txt for more information). ### Tactic API - `pf_constr_of_global` now returns a tactic instead of taking a continuation. Thus it only generates one instance of the global reference, and it is the caller's responsibility to perform a focus on the goal. - `pf_global`, `construct_reference`, `global_reference`, `global_reference_in_absolute_module` now return a `global_reference` instead of a `constr`. - The `tclWEAK_PROGRESS` and `tclNOTSAMEGOAL` tacticals were removed. Their usecase was very specific. Use `tclPROGRESS` instead. - New (internal) tactical `tclINDEPENDENTL` that combined with enter_one allows to iterate a non-unit tactic on all goals and access their returned values. - The unsafe flag of the `Refine.refine` function and its variants has been renamed and dualized into typecheck and has been made mandatory. ### Ltac API Many Ltac specific API has been moved in its own ltac/ folder. Amongst other important things: - `Pcoq.Tactic` -> `Pltac` - `Constrarg.wit_tactic` -> `Tacarg.wit_tactic` - `Constrarg.wit_ltac` -> `Tacarg.wit_ltac` - API below `ltac/` that accepted a *`_tactic_expr` now accept a *`_generic_argument` instead - Some printing functions were moved from `Pptactic` to `Pputils` - A part of `Tacexpr` has been moved to `Tactypes` - The `TacFun` tactic expression constructor now takes a `Name.t list` for the variable list rather than an `Id.t option list`. The folder itself has been turned into a plugin. This does not change much, but because it is a packed plugin, it may wreak havoc for third-party plugins depending on any module defined in the `ltac/` directory. Namely, even if everything looks OK at compile time, a plugin can fail to load at link time because it mistakenly looks for a module `Foo` instead of `Ltac_plugin.Foo`, with an error of the form: ``` Error: while loading myplugin.cmxs, no implementation available for Foo. ``` In particular, most `EXTEND` macros will trigger this problem even if they seemingly do not use any Ltac module, as their expansion do. The solution is simple, and consists in adding a statement `open Ltac_plugin` in each file using a Ltac module, before such a module is actually called. An alternative solution would be to fully qualify Ltac modules, e.g. turning any call to Tacinterp into `Ltac_plugin.Tacinterp`. Note that this solution does not work for `EXTEND` macros though. ### Additional changes in tactic extensions Entry `constr_with_bindings` has been renamed into `open_constr_with_bindings`. New entry `constr_with_bindings` now uses type classes and rejects terms with unresolved holes. ### Error handling - All error functions now take an optional parameter `?loc:Loc.t`. For functions that used to carry a suffix `_loc`, such suffix has been dropped. - `errorlabstrm` and `error` has been removed in favor of `user_err`. - The header parameter to `user_err` has been made optional. ### Pretty printing Some functions have been removed, see pretty printing below for more details. #### Pretty Printing and XML protocol The type `std_cmdpps` has been reworked and made the canonical "Coq rich document type". This allows for a more uniform handling of printing (specially in IDEs). The main consequences are: - Richpp has been confined to IDE use. Most of previous uses of the `richpp` type should be replaced now by `Pp.std_cmdpps`. Main API has been updated. - The XML protocol will send a new message type of `pp`, which should be rendered client-wise. - `Set Printing Width` is deprecated, now width is controlled client-side. - `Pp_control` has removed. The new module `Topfmt` implements console control for the toplevel. - The impure tag system in `Pp` has been removed. This also does away with the printer signatures and functors. Now printers tag unconditionally. - The following functions have been removed from `Pp`: ```ocaml val stras : int * string -> std_ppcmds val tbrk : int * int -> std_ppcmds val tab : unit -> std_ppcmds val pifb : unit -> std_ppcmds val comment : int -> std_ppcmds val comments : ((int * int) * string) list ref val eval_ppcmds : std_ppcmds -> std_ppcmds val is_empty : std_ppcmds -> bool val t : std_ppcmds -> std_ppcmds val hb : int -> std_ppcmds val vb : int -> std_ppcmds val hvb : int -> std_ppcmds val hovb : int -> std_ppcmds val tb : unit -> std_ppcmds val close : unit -> std_ppcmds val tclose : unit -> std_ppcmds val open_tag : Tag.t -> std_ppcmds val close_tag : unit -> std_ppcmds val msg_with : ... module Tag ``` ### Stm API - We have streamlined the `Stm` API, now `add` and `query` take a `coq_parsable` instead a `string` so clients can have more control over their input stream. As a consequence, their types have been modified. - The main parsing entry point has also been moved to the `Stm`. Parsing is considered a synchronous operation so it will either succeed or raise an exception. - `Feedback` is now only emitted for asynchronous operations. As a consequence, it always carries a valid stateid and the type has changed to accommodate that. - A few unused hooks were removed due to cleanups, no clients known. ### Toplevel and Vernacular API - The components related to vernacular interpretation have been moved to their own folder `vernac/` whereas toplevel now contains the proper toplevel shell and compiler. - Coq's toplevel has been ported to directly use the common `Stm` API. The signature of a few functions has changed as a result. ### XML Protocol - The legacy `Interp` call has been turned into a noop. - The `query` call has been modified, now it carries a mandatory `route_id` integer parameter, that associated the result of such query with its generated feedback. ## Changes between Coq 8.5 and Coq 8.6 ### Parsing `Pcoq.parsable` now takes an extra optional filename argument so as to bind locations to a file name when relevant. ### Files To avoid clashes with OCaml's compiler libs, the following files were renamed: ``` kernel/closure.ml{,i} -> kernel/cClosure.ml{,i} lib/errors.ml{,i} -> lib/cErrors.ml{,i} toplevel/cerror.ml{,i} -> toplevel/explainErr.mli{,i} ``` All IDE-specific files, including the XML protocol have been moved to `ide/` ### Reduction functions In `closure.ml`, we introduced the more precise reduction flags `fMATCH`, `fFIX`, `fCOFIX`. We renamed the following functions: ``` Closure.betadeltaiota -> Closure.all Closure.betadeltaiotanolet -> Closure.allnolet Reductionops.beta -> Closure.beta Reductionops.zeta -> Closure.zeta Reductionops.betaiota -> Closure.betaiota Reductionops.betaiotazeta -> Closure.betaiotazeta Reductionops.delta -> Closure.delta Reductionops.betalet -> Closure.betazeta Reductionops.betadelta -> Closure.betadeltazeta Reductionops.betadeltaiota -> Closure.all Reductionops.betadeltaiotanolet -> Closure.allnolet Closure.no_red -> Closure.nored Reductionops.nored -> Closure.nored Reductionops.nf_betadeltaiota -> Reductionops.nf_all Reductionops.whd_betadelta -> Reductionops.whd_betadeltazeta Reductionops.whd_betadeltaiota -> Reductionops.whd_all Reductionops.whd_betadeltaiota_nolet -> Reductionops.whd_allnolet Reductionops.whd_betadelta_stack -> Reductionops.whd_betadeltazeta_stack Reductionops.whd_betadeltaiota_stack -> Reductionops.whd_all_stack Reductionops.whd_betadeltaiota_nolet_stack -> Reductionops.whd_allnolet_stack Reductionops.whd_betadelta_state -> Reductionops.whd_betadeltazeta_state Reductionops.whd_betadeltaiota_state -> Reductionops.whd_all_state Reductionops.whd_betadeltaiota_nolet_state -> Reductionops.whd_allnolet_state Reductionops.whd_eta -> Reductionops.shrink_eta Tacmach.pf_whd_betadeltaiota -> Tacmach.pf_whd_all Tacmach.New.pf_whd_betadeltaiota -> Tacmach.New.pf_whd_all ``` And removed the following ones: ``` Reductionops.whd_betaetalet Reductionops.whd_betaetalet_stack Reductionops.whd_betaetalet_state Reductionops.whd_betadeltaeta_stack Reductionops.whd_betadeltaeta_state Reductionops.whd_betadeltaeta Reductionops.whd_betadeltaiotaeta_stack Reductionops.whd_betadeltaiotaeta_state Reductionops.whd_betadeltaiotaeta ``` In `intf/genredexpr.mli`, `fIota` was replaced by `FMatch`, `FFix` and `FCofix`. Similarly, `rIota` was replaced by `rMatch`, `rFix` and `rCofix`. ### Notation_ops Use `Glob_ops.glob_constr_eq` instead of `Notation_ops.eq_glob_constr`. ### Logging and Pretty Printing * Printing functions have been removed from `Pp.mli`, which is now a purely pretty-printing interface. Functions affected are: ```` ocaml val pp : std_ppcmds -> unit val ppnl : std_ppcmds -> unit val pperr : std_ppcmds -> unit val pperrnl : std_ppcmds -> unit val pperr_flush : unit -> unit val pp_flush : unit -> unit val flush_all : unit -> unit val msg : std_ppcmds -> unit val msgnl : std_ppcmds -> unit val msgerr : std_ppcmds -> unit val msgerrnl : std_ppcmds -> unit val message : string -> unit ```` which are no more available. Users of `Pp.pp msg` should now use the proper `Feedback.msg_*` function. Clients also have no control over flushing, the back end takes care of it. Also, the `msg_*` functions now take an optional `?loc` parameter for relaying location to the client. * Feedback related functions and definitions have been moved to the `Feedback` module. `message_level` has been renamed to level. Functions moved from `Pp` to `Feedback` are: ```` ocaml val set_logger : logger -> unit val std_logger : logger val emacs_logger : logger val feedback_logger : logger ```` * Changes in the Feedback format/Protocol. - The `Message` feedback type now carries an optional location, the main payload is encoded using the richpp document format. - The `ErrorMsg` feedback type is thus unified now with `Message` at level `Error`. * We now provide several loggers, `log_via_feedback` is removed in favor of `set_logger feedback_logger`. Output functions are: ```` ocaml val with_output_to_file : string -> ('a -> 'b) -> 'a -> 'b val msg_error : ?loc:Loc.t -> Pp.std_ppcmds -> unit val msg_warning : ?loc:Loc.t -> Pp.std_ppcmds -> unit val msg_notice : ?loc:Loc.t -> Pp.std_ppcmds -> unit val msg_info : ?loc:Loc.t -> Pp.std_ppcmds -> unit val msg_debug : ?loc:Loc.t -> Pp.std_ppcmds -> unit ```` with the `msg_*` functions being just an alias for `logger $Level`. * The main feedback functions are: ```` ocaml val set_feeder : (feedback -> unit) -> unit val feedback : ?id:edit_or_state_id -> ?route:route_id -> feedback_content -> unit val set_id_for_feedback : ?route:route_id -> edit_or_state_id -> unit ```` Note that `feedback` doesn't take two parameters anymore. After refactoring the following function has been removed: ```` ocaml val get_id_for_feedback : unit -> edit_or_state_id * route_id ```` ### Kernel API changes - The interface of the `Context` module was changed. Related types and functions were put in separate submodules. The mapping from old identifiers to new identifiers is the following: ``` Context.named_declaration ---> Context.Named.Declaration.t Context.named_list_declaration ---> Context.NamedList.Declaration.t Context.rel_declaration ---> Context.Rel.Declaration.t Context.map_named_declaration ---> Context.Named.Declaration.map_constr Context.map_named_list_declaration ---> Context.NamedList.Declaration.map Context.map_rel_declaration ---> Context.Rel.Declaration.map_constr Context.fold_named_declaration ---> Context.Named.Declaration.fold Context.fold_rel_declaration ---> Context.Rel.Declaration.fold Context.exists_named_declaration ---> Context.Named.Declaration.exists Context.exists_rel_declaration ---> Context.Rel.Declaration.exists Context.for_all_named_declaration ---> Context.Named.Declaration.for_all Context.for_all_rel_declaration ---> Context.Rel.Declaration.for_all Context.eq_named_declaration ---> Context.Named.Declaration.equal Context.eq_rel_declaration ---> Context.Rel.Declaration.equal Context.named_context ---> Context.Named.t Context.named_list_context ---> Context.NamedList.t Context.rel_context ---> Context.Rel.t Context.empty_named_context ---> Context.Named.empty Context.add_named_decl ---> Context.Named.add Context.vars_of_named_context ---> Context.Named.to_vars Context.lookup_named ---> Context.Named.lookup Context.named_context_length ---> Context.Named.length Context.named_context_equal ---> Context.Named.equal Context.fold_named_context ---> Context.Named.fold_outside Context.fold_named_list_context ---> Context.NamedList.fold Context.fold_named_context_reverse ---> Context.Named.fold_inside Context.instance_from_named_context ---> Context.Named.to_instance Context.extended_rel_list ---> Context.Rel.to_extended_list Context.extended_rel_vect ---> Context.Rel.to_extended_vect Context.fold_rel_context ---> Context.Rel.fold_outside Context.fold_rel_context_reverse ---> Context.Rel.fold_inside Context.map_rel_context ---> Context.Rel.map_constr Context.map_named_context ---> Context.Named.map_constr Context.iter_rel_context ---> Context.Rel.iter Context.iter_named_context ---> Context.Named.iter Context.empty_rel_context ---> Context.Rel.empty Context.add_rel_decl ---> Context.Rel.add Context.lookup_rel ---> Context.Rel.lookup Context.rel_context_length ---> Context.Rel.length Context.rel_context_nhyps ---> Context.Rel.nhyps Context.rel_context_tags ---> Context.Rel.to_tags ``` - Originally, rel-context was represented as: ```ocaml type Context.rel_context = Names.Name.t * Constr.t option * Constr.t ``` Now it is represented as: ```ocaml type Context.Rel.Declaration.t = LocalAssum of Names.Name.t * Constr.t | LocalDef of Names.Name.t * Constr.t * Constr.t ``` - Originally, named-context was represented as: ```ocaml type Context.named_context = Names.Id.t * Constr.t option * Constr.t ``` Now it is represented as: ```ocaml type Context.Named.Declaration.t = LocalAssum of Names.Id.t * Constr.t | LocalDef of Names.Id.t * Constr.t * Constr.t ``` - The various `EXTEND` macros do not handle specially the Coq-defined entries anymore. Instead, they just output a name that have to exist in the scope of the ML code. The parsing rules (`VERNAC`) `ARGUMENT EXTEND` will look for variables `$name` of type `Gram.entry`, while the parsing rules of (`VERNAC COMMAND` | `TACTIC`) `EXTEND`, as well as the various `TYPED AS` clauses will look for variables `wit_$name` of type `Genarg.genarg_type`. The small DSL for constructing compound entries still works over this scheme. Note that in the case of (`VERNAC`) `ARGUMENT EXTEND`, the name of the argument entry is bound in the parsing rules, so beware of recursive calls. For example, to get `wit_constr` you must `open Constrarg` at the top of the file. - `Evarutil` was split in two parts. The new `Evardefine` file exposes functions `define_evar_`* mostly used internally in the unification engine. - The `Refine` module was moved out of `Proofview`. ``` Proofview.Refine.* ---> Refine.* ``` - A statically monotonic evarmap type was introduced in `Sigma`. Not all the API has been converted, so that the user may want to use compatibility functions `Sigma.to_evar_map` and `Sigma.Unsafe.of_evar_map` or `Sigma.Unsafe.of_pair` when needed. Code can be straightforwardly adapted in the following way: ```ocaml let (sigma, x1) = ... in ... let (sigma, xn) = ... in (sigma, ans) ``` should be turned into: ```ocaml open Sigma.Notations let Sigma (x1, sigma, p1) = ... in ... let Sigma (xn, sigma, pn) = ... in Sigma (ans, sigma, p1 +> ... +> pn) ``` Examples of `Sigma.Unsafe.of_evar_map` include: ``` Evarutil.new_evar env (Tacmach.project goal) ty ----> Evarutil.new_evar env (Sigma.Unsafe.of_evar_map (Tacmach.project goal)) ty ``` - The `Proofview.Goal.`*`enter` family of functions now takes a polymorphic continuation given as a record as an argument. ```ocaml Proofview.Goal.enter begin fun gl -> ... end ``` should be turned into ```ocaml open Proofview.Notations Proofview.Goal.enter { enter = begin fun gl -> ... end } ``` - `Tacexpr.TacDynamic(Loc.dummy_loc, Pretyping.constr_in c)` ---> `Tacinterp.Value.of_constr c` - `Vernacexpr.HintsResolveEntry(priority, poly, hnf, path, atom)` ---> `Vernacexpr.HintsResolveEntry(Vernacexpr.({hint_priority = priority; hint_pattern = None}), poly, hnf, path, atom)` - `Pretyping.Termops.mem_named_context` ---> `Engine.Termops.mem_named_context_val` - `Global.named_context` ---> `Global.named_context_val` - `Context.Named.lookup` ---> `Environ.lookup_named_val` ### Search API The main search functions now take a function iterating over the results. This allows for clients to use streaming or more economic printing. ### XML Protocol - In several places, flat text wrapped in `` tags now appears as structured text inside `` tags. - The "errormsg" feedback has been replaced by a "message" feedback which contains `` tag, with a message_level attribute of "error". ## Changes between Coq 8.4 and Coq 8.5 ### Refactoring : more mli interfaces and simpler grammar.cma - A new directory intf/ now contains mli-only interfaces : * `Constrexpr` : definition of `constr_expr`, was in `Topconstr` * `Decl_kinds` : now contains `binding_kind = Explicit | Implicit` * `Evar_kinds` : type `Evar_kinds.t` was previously `Evd.hole_kind` * `Extend` : was `parsing/extend.mli` * `Genredexpr` : regroup `Glob_term.red_expr_gen` and `Tacexpr.glob_red_flag` * `Glob_term` : definition of `glob_constr` * `Locus` : definition of occurrences and stuff about clauses * `Misctypes` : `intro_pattern_expr`, `glob_sort`, `cast_type`, `or_var`, ... * `Notation_term` : contains `notation_constr`, was `Topconstr.aconstr` * `Pattern` : contains `constr_pattern` * `Tacexpr` : was `tactics/tacexpr.ml` * `Vernacexpr` : was `toplevel/vernacexpr.ml` - Many files have been divided : * vernacexpr: vernacexpr.mli + Locality * decl_kinds: decl_kinds.mli + Kindops * evd: evar_kinds.mli + evd * tacexpr: tacexpr.mli + tacops * glob_term: glob_term.mli + glob_ops + genredexpr.mli + redops * topconstr: constrexpr.mli + constrexpr_ops + notation_expr.mli + notation_ops + topconstr * pattern: pattern.mli + patternops * libnames: libnames (qualid, reference) + globnames (global_reference) * egrammar: egramml + egramcoq - New utility files : miscops (cf. misctypes.mli) and redops (cf genredexpr.mli). - Some other directory changes : * grammar.cma and the source files specific to it are now in grammar/ * pretty-printing files are now in printing/ - Inner-file changes : * aconstr is now notation_constr, all constructors for this type now start with a N instead of a A (e.g. NApp instead of AApp), and functions about aconstr may have been renamed (e.g. match_aconstr is now match_notation_constr). * occurrences (now in Locus.mli) is now an algebraic type, with - AllOccurrences instead of all_occurrences_expr = (false,[]) - (AllOccurrencesBut l) instead of (all_occurrences_expr_but l) = (false,l) - NoOccurrences instead of no_occurrences_expr = (true,[]) - (OnlyOccurrences l) instead of (no_occurrences_expr_but l) = (true,l) * move_location (now in Misctypes) has two new constructors MoveFirst and MoveLast replacing (MoveToEnd false) and (MoveToEnd true) - API of pretyping.ml and constrintern.ml has been made more uniform * Parametrization of understand_* functions is now made using "inference flags" * Functions removed: - interp_constr_judgment (inline its former body if really needed) - interp_casted_constr, interp_type: use instead interp_constr with expected_type set to OfType or to IsType - interp_gen: use any of interp_constr, interp_casted_constr, interp_type - interp_open_constr_patvar - interp_context: use interp_context_evars (with a "evar_map ref") and call solve_remaining_evars afterwards with a failing flag (e.g. all_and_fail_flags) - understand_type, understand_gen: use understand with appropriate parameters * Change of semantics: - Functions interp_*_evars_impls have a different interface and do not any longer check resolution of evars by default; use check_evars_are_solved explicitly to check that evars are solved. See also the corresponding commit log. - Tactics API: new_induct -> induction; new_destruct -> destruct; letin_pat_tac do not accept a type anymore - New file find_subterm.ml for gathering former functions `subst_closed_term_occ_modulo`, `subst_closed_term_occ_decl` (which now take and outputs also an `evar_map`), and `subst_closed_term_occ_modulo`, `subst_closed_term_occ_decl_modulo` (now renamed into `replace_term_occ_modulo` and `replace_term_occ_decl_modulo`). - API of Inductiveops made more uniform (see commit log or file itself). - API of intros_pattern style tactic changed; "s" is dropped in "intros_pattern" and "intros_patterns" is not anymore behaving like tactic "intros" on the empty list. - API of cut tactics changed: for instance, cut_intro should be replaced by "assert_after Anonymous" - All functions taking an env and a sigma (or an evdref) now takes the env first. ## Changes between Coq 8.3 and Coq 8.4 - Functions in unification.ml have now the evar_map coming just after the env - Removal of Tacinterp.constr_of_id Use instead either global_reference or construct_reference in constrintern.ml. - Optimizing calls to Evd functions Evars are split into defined evars and undefined evars; for efficiency, when an evar is known to be undefined, it is preferable to use specific functions about undefined evars since these ones are generally fewer than the defined ones. - Type changes in TACTIC EXTEND rules Arguments bound with tactic(_) in TACTIC EXTEND rules are now of type glob_tactic_expr, instead of glob_tactic_expr * tactic. Only the first component is kept, the second one can be obtained via Tacinterp.eval_tactic. - ARGUMENT EXTEND It is now forbidden to use TYPED simultaneously with {RAW,GLOB}_TYPED in ARGUMENT EXTEND statements. - Renaming of rawconstr to glob_constr The "rawconstr" type has been renamed to "glob_constr" for consistency. The "raw" in everything related to former rawconstr has been changed to "glob". For more details about the rationale and scripts to migrate code using Coq's internals, see commits 13743, 13744, 13755, 13756, 13757, 13758, 13761 (by glondu, end of December 2010) in Subversion repository. Contribs have been fixed too, and commit messages there might also be helpful for migrating. ## Changes between Coq 8.2 and Coq 8.3 ### Light cleaning in evaruil.ml whd_castappevar is now whd_head_evar obsolete whd_ise disappears ### Restructuration of the syntax of binders ``` binders_let -> binders binders_let_fixannot -> binders_fixannot binder_let -> closed_binder (and now covers only bracketed binders) binder was already obsolete and has been removed ``` ### Semantical change of h_induction_destruct Warning, the order of the isrec and evar_flag was inconsistent and has been permuted. Tactic induction_destruct in tactics.ml is unchanged. ### Internal tactics renamed There is no more difference between bindings and ebindings. The following tactics are therefore renamed ``` apply_with_ebindings_gen -> apply_with_bindings_gen left_with_ebindings -> left_with_bindings right_with_ebindings -> right_with_bindings split_with_ebindings -> split_with_bindings ``` and the following tactics are removed - apply_with_ebindings (use instead apply_with_bindings) - eapply_with_ebindings (use instead eapply_with_bindings) ### Obsolete functions in typing.ml For mtype_of, msort_of, mcheck, now use type_of, sort_of, check ### Renaming functions renamed ``` concrete_name -> compute_displayed_name_in concrete_let_name -> compute_displayed_let_name_in rename_rename_bound_var -> rename_bound_vars_as_displayed lookup_name_as_renamed -> lookup_name_as_displayed next_global_ident_away true -> next_ident_away_in_goal next_global_ident_away false -> next_global_ident_away ``` ### Cleaning in command.ml Functions about starting/ending a lemma are in lemmas.ml Functions about inductive schemes are in indschemes.ml Functions renamed: ``` declare_one_assumption -> declare_assumption declare_assumption -> declare_assumptions Command.syntax_definition -> Metasyntax.add_syntactic_definition declare_interning_data merged with add_notation_interpretation compute_interning_datas -> compute_full_internalization_env implicits_env -> internalization_env full_implicits_env -> full_internalization_env build_mutual -> do_mutual_inductive build_recursive -> do_fixpoint build_corecursive -> do_cofixpoint build_induction_scheme -> build_mutual_induction_scheme build_indrec -> build_induction_scheme instantiate_type_indrec_scheme -> weaken_sort_scheme instantiate_indrec_scheme -> modify_sort_scheme make_case_dep, make_case_nodep -> build_case_analysis_scheme make_case_gen -> build_case_analysis_scheme_default ``` Types: decl_notation -> decl_notation option ### Cleaning in libnames/nametab interfaces Functions: ``` dirpath_prefix -> pop_dirpath extract_dirpath_prefix pop_dirpath_n extend_dirpath -> add_dirpath_suffix qualid_of_sp -> qualid_of_path pr_sp -> pr_path make_short_qualid -> qualid_of_ident sp_of_syntactic_definition -> path_of_syntactic_definition sp_of_global -> path_of_global id_of_global -> basename_of_global absolute_reference -> global_of_path locate_syntactic_definition -> locate_syndef path_of_syntactic_definition -> path_of_syndef push_syntactic_definition -> push_syndef ``` Types: section_path -> full_path ### Cleaning in parsing extensions (commit 12108) Many moves and renamings, one new file (Extrawit, that contains wit_tactic). ### Cleaning in tactical.mli ``` tclLAST_HYP -> onLastHyp tclLAST_DECL -> onLastDecl tclLAST_NHYPS -> onNLastHypsId tclNTH_DECL -> onNthDecl tclNTH_HYP -> onNthHyp onLastHyp -> onLastHypId onNLastHyps -> onNLastDecls onClauses -> onClause allClauses -> allHypsAndConcl ``` and removal of various unused combinators on type "clause" ## Changes between Coq 8.1 and Coq 8.2 ### Datatypes List of occurrences moved from "int list" to "Termops.occurrences" (an alias to "bool * int list") ETIdent renamed to ETName ### Functions ``` Eauto: e_resolve_constr, vernac_e_resolve_constr -> simplest_eapply Tactics: apply_with_bindings -> apply_with_bindings_wo_evars Eauto.simplest_apply -> Hiddentac.h_simplest_apply Evarutil.define_evar_as_arrow -> define_evar_as_product Old version of Tactics.assert_tac disappears Tactics.true_cut renamed into Tactics.assert_tac Constrintern.interp_constrpattern -> intern_constr_pattern Hipattern.match_with_conjunction is a bit more restrictive Hipattern.match_with_disjunction is a bit more restrictive ``` ### Universe names (univ.mli) ```ocaml base_univ -> type0_univ (* alias of Set is the Type hierarchy *) prop_univ -> type1_univ (* the type of Set in the Type hierarchy *) neutral_univ -> lower_univ (* semantic alias of Prop in the Type hierarchy *) is_base_univ -> is_type1_univ is_empty_univ -> is_lower_univ ``` ### Sort names (term.mli) ``` mk_Set -> set_sort mk_Prop -> prop_sort type_0 -> type1_sort ``` ## Changes between Coq 8.0 and Coq 8.1 ### Functions - Util: option_app -> option_map - Term: substl_decl -> subst_named_decl - Lib: library_part -> remove_section_part - Printer: prterm -> pr_lconstr - Printer: prterm_env -> pr_lconstr_env - Ppconstr: pr_sort -> pr_rawsort - Evd: in_dom, etc got standard ocaml names (i.e. mem, etc) - Pretyping: - understand_gen_tcc and understand_gen_ltac merged into understand_ltac - type_constraints can now say typed by a sort (use OfType to get the previous behavior) - Library: import_library -> import_module ### Constructors * Declarations: mind_consnrealargs -> mind_consnrealdecls * NoRedun -> NoDup * Cast and RCast have an extra argument: you can recover the previous behavior by setting the extra argument to "CastConv DEFAULTcast" and "DEFAULTcast" respectively * Names: "kernel_name" is now "constant" when argument of Term.Const * Tacexpr: TacTrueCut and TacForward(false,_,_) merged into new TacAssert * Tacexpr: TacForward(true,_,_) branched to TacLetTac ### Modules * module Decl_kinds: new interface * module Bigint: new interface * module Tacred spawned module Redexpr * module Symbols -> Notation * module Coqast, Ast, Esyntax, Termast, and all other modules related to old syntax are removed * module Instantiate: integrated to Evd * module Pretyping now a functor: use Pretyping.Default instead ### Internal names OBJDEF and OBJDEF1 -> CANONICAL-STRUCTURE ### Tactic extensions * printers have an extra parameter which is a constr printer at high precedence * the tactic printers have an extra arg which is the expected precedence * level is now a precedence in declare_extra_tactic_pprule * "interp" functions now of types the actual arg type, not its encapsulation as a generic_argument ## Changes between Coq 7.4 and Coq 8.0 See files in dev/syntax-v8 ## Main changes between Coq 7.4 and Coq 8.0 ### Changes due to introduction of modules #### Kernel The module level has no effect on constr except for the structure of section_path. The type of unique names for constructions (what section_path served) is now called a kernel name and is defined by ```ocaml type uniq_ident = int * string * dir_path (* int may be enough *) type module_path = | MPfile of dir_path (* reference to physical module, e.g. file *) | MPbound of uniq_ident (* reference to a module parameter in a functor *) | MPself of uniq_ident (* reference to one of the containing module *) | MPdot of module_path * label type label = identifier type kernel_name = module_path * dir_path * label ^^^^^^^^^^^ ^^^^^^^^ ^^^^^ | | \ | | the base name | \ / the (true) section path example: (non empty only inside open sections) L = (* i.e. some file of logical name L *) struct module A = struct Def a = ... end end M = (* i.e. some file of logical name M *) struct Def t = ... N = functor (X : sig module T = struct Def b = ... end end) -> struct module O = struct Def u = ... end Def x := ... .t ... .O.u ... X.T.b ... L.A.a ``` and are self-references, X is a bound reference and L is a reference to a physical module. Notice that functor application is not part of a path: it must be named by a "module M = F(A)" declaration to be used in a kernel name. Notice that Jacek chose a practical approach, making directories not modules. Another approach could have been to replace the constructor MPfile by a constant constructor MProot representing the root of the world. Other relevant informations are in kernel/entries.ml (type module_expr) and kernel/declarations.ml (type module_body and module_type_body). #### Library 1. tables [Summaries] - the only change is the special treatment of the global environment. 2. objects [Libobject] declares persistent objects, given with methods: * cache_function specifying how to add the object in the current scope; * load_function, specifying what to do when the module containing the object is loaded; * open_function, specifying what to do when the module containing the object is opened (imported); * classify_function, specyfying what to do with the object, when the current module (containing the object) is ended. * subst_function * export_function, to signal end_section survival (Almost) Each of these methods is called with a parameter of type object_name = section_path * kernel_name where section_path is the full user name of the object (such as Coq.Init.Datatypes.Fst) and kernel_name is its substitutive internal version such as (MPself,[],"Fst") (see above) #### What happens at the end of an interactive module ? (or when a file is stored and reloaded from disk) All summaries (except Global environment) are reverted to the state from before the beginning of the module, and: 1. the objects (again, since last Declaremods.start_module or Library.start_library) are classified using the classify_function. To simplify consider only those who returned Substitute _ or Keep _. 2. If the module is not a functor, the subst_function for each object of the first group is called with the substitution [MPself "" |-> MPfile "Coq.Init.Datatypes"]. Then the load_function is called for substituted objects and the "keep" object. (If the module is a library the substitution is done at reloading). 3. The objects which returned substitute are stored in the modtab together with the self ident of the module, and functor argument names if the module was a functor. They will be used (substituted and loaded) when a command like Module M := F(N) or Module Z := N is evaluated #### The difference between "substitute" and "keep" objects 1. The "keep" objects can _only_ reference other objects by section_paths and qualids. They do not need the substitution function. They will work after end_module (or reloading a compiled library), because these operations do not change section_path's They will obviously not work after Module Z:=N. These would typically be grammar rules, pretty printing rules etc. 2. The "substitute" objects can _only_ reference objects by kernel_names. They must have a valid subst_function. They will work after end_module _and_ after Module Z:=N or Module Z:=F(M). Other kinds of objects: 3. "Dispose" - objects which do not survive end_module As a consequence, objects which reference other objects sometimes by kernel_names and sometimes by section_path must be of this kind... 4. "Anticipate" - objects which must be treated individually by end_module (typically "REQUIRE" objects) #### Writing subst_thing functions The subst_thing should not copy the thing if it hasn't actually changed. to help writing subst functions this way quickly and without errors. Also there are *_smartmap functions in Util. The subst_thing functions are already written for many types, including constr (Term.subst_mps), global_reference (Libnames.subst_global), rawconstr (Rawterm.subst_raw) etc They are all (apart from constr, for now) written in the non-copying way. #### Nametab Nametab has been made more uniform. For every kind of thing there is only one "push" function and one "locate" function. #### Lib library_segment is now a list of object_name * library_item, where object_name = section_path * kernel_name (see above) New items have been added for open modules and module types #### Declaremods Functions to declare interactive and noninteractive modules and module types. #### Library Uses Declaremods to actually communicate with Global and to register objects. ### Other changes Internal representation of tactics bindings has changed (see type Rawterm.substitution). New parsing model for tactics and vernacular commands - Introduction of a dedicated type for tactic expressions (Tacexpr.raw_tactic_expr) - Introduction of a dedicated type for vernac expressions (Vernacexpr.vernac_expr) - Declaration of new vernacular parsing rules by a new camlp4 macro GRAMMAR COMMAND EXTEND ... END to be used in ML files - Declaration of new tactics parsing/printing rules by a new camlp4 macro TACTIC EXTEND ... END to be used in ML files New organisation of THENS: - tclTHENS tac tacs : tacs is now an array - tclTHENSFIRSTn tac1 tacs tac2 : apply tac1 then, apply the array tacs on the first n subgoals and tac2 on the remaining subgoals (previously tclTHENST) - tclTHENSLASTn tac1 tac2 tacs : apply tac1 then, apply tac2 on the first subgoals and apply the array tacs on the last n subgoals - tclTHENFIRSTn tac1 tacs = tclTHENSFIRSTn tac1 tacs tclIDTAC (prev. tclTHENSI) - tclTHENLASTn tac1 tacs = tclTHENSLASTn tac1 tclIDTAC tacs - tclTHENFIRST tac1 tac2 = tclTHENFIRSTn tac1 [|tac2|] - tclTHENLAST tac1 tac2 = tclTHENLASTn tac1 [|tac2|] (previously tclTHENL) - tclTHENS tac1 tacs = tclTHENSFIRSTn tac1 tacs (fun _ -> error "wrong number") - tclTHENSV same as tclTHENS but with an array - tclTHENSi : no longer available Proof_type: subproof field in type proof_tree glued with the ref field Tacmach: no more echo from functions of module Refiner Files plugins/*/g_*.ml4 take the place of files plugins/*/*.v. Files parsing/{vernac,tac}extend.ml{4,i} implements TACTIC EXTEND andd VERNAC COMMAND EXTEND macros File syntax/PPTactic.v moved to parsing/pptactic.ml Tactics about False and not now in tactics/contradiction.ml Tactics depending on Init now tactics/*.ml4 (no longer in tactics/*.v) File tacinterp.ml moved from proofs to directory tactics ## Changes between Coq 7.1 and Coq 7.2 The core of Coq (kernel) has meen minimized with the following effects: - kernel/term.ml split into kernel/term.ml, pretyping/termops.ml - kernel/reduction.ml split into kernel/reduction.ml, pretyping/reductionops.ml - kernel/names.ml split into kernel/names.ml, library/nameops.ml - kernel/inductive.ml split into kernel/inductive.ml, pretyping/inductiveops.ml the prefixes "Is" ans "IsMut" have been dropped from kind_of_term constructors, e.g. IsRel is now Rel, IsMutCase is now Case, etc. coq-8.20.0/dev/doc/coq-src-description.txt000066400000000000000000000040671466560755400203700ustar00rootroot00000000000000 Coq main source components (in link order) ------------------------------------------ clib : Basic files in lib/, such as util.ml lib : Other files in lib/ kernel library pretyping interp proofs printing parsing tactics toplevel Special components ------------------ grammar : Camlp5 syntax extensions. The file grammar/grammar.cma is used to pre-process .mlg files containing EXTEND constructions, either TACTIC EXTEND, ARGUMENTS EXTEND or VERNAC ... EXTEND. This grammar.cma incorporates many files from other directories (mainly parsing/), plus some specific files in grammar/. The other syntax extension grammar/q_constr.cmo is a addition to grammar.cma with a constr PATTERN quotation. Hierarchy of A.S.T. ------------------- *** Terms *** ... ... | /\ parsing | | printing | | V | Constrexpr.constr_expr | /\ constrintern | | constrextern (in interp) | | (in interp) globalization | | V | Glob_term.glob_constr | /\ pretyping | | detyping | | (in pretyping) V | Term.constr | /\ safe_typing | | (validation | | by kernel) |______| *** Patterns *** | | parsing V constr_pattern_expr = constr_expr | | Constrintern.interp_constr_pattern (in interp) | reverse way in Constrextern V Pattern.constr_pattern | ---> used for instance by Matching.matches (in pretyping) *** Notations *** Notation_term.notation_constr Conversion from/to glob_constr in Notation_ops TODO... *** Tactics *** | | parsing V Tacexpr.raw_tactic_expr | | Tacinterp.intern_pure_tactic (?) V Tacexpr.glob_tactic_expr | | Tacinterp.eval_tactic (?) V unit Proofview.tactic TODO: check with Hugo *** Vernac expressions *** Vernacexpr.vernac_expr, produced by parsing, used in Vernacentries and Vernac coq-8.20.0/dev/doc/critical-bugs.md000066400000000000000000001304421466560755400170060ustar00rootroot00000000000000Compilation of critical bugs in stable releases of Coq ====================================================== This file recollects knowledge about critical bugs found in Coq since version 8.0. ## Table of Contents - [Non fixed bugs](#non-fixed-bugs) - [buffer overflow on large records and closures (infinite loop with OCaml 5)](#buffer-overflow-on-large-records-and-closures-infinite-loop-with-ocaml-5) - [memory corruption by evaluating on ill-typed terms (obtained from unsafe tactics)](#memory-corruption-by-evaluating-on-ill-typed-terms-obtained-from-unsafe-tactics) - [kernel and checker accept incorrect name aliasing information](#kernel-and-checker-accept-incorrect-name-aliasing-information) - [coqchk checks too little about primitive declarations](#coqchk-checks-too-little-about-primitive-declarations) - [Print Assumptions + Parameter Inline fails to report some inconsistent flags](#print-assumptions-parameter-inline-fails-to-report-some-inconsistent-flags) - [Print Assumptions does not report Unset Universe Checking used during functor application](#print-assumptions-does-not-report-unset-universe-checking-used-during-functor-application) - [Fixed bugs](#fixed-bugs) - [Typing constructions](#typing-constructions) - [substitution missing in the body of a let](#substitution-missing-in-the-body-of-a-let) - [missing lift in checking guard](#missing-lift-in-checking-guard) - [de Bruijn indice bug in checking guard of nested cofixpoints](#de-bruijn-indice-bug-in-checking-guard-of-nested-cofixpoints) - [de Bruijn indice bug in computing allowed elimination principle](#de-bruijn-indice-bug-in-computing-allowed-elimination-principle) - [bug in Prop<=Set conversion which made Set identifiable with Prop, preventing a proof-irrelevant interpretation of Prop](#bug-in-propset-conversion-which-made-set-identifiable-with-prop-preventing-a-proof-irrelevant-interpretation-of-prop) - [incorrect abstraction of sort variables in relevance marks on opaque constants](#incorrect-abstraction-of-sort-variables-in-relevance-marks-on-opaque-constants) - [Module system](#module-system) - [missing universe constraints in typing "with" clause of a module type](#missing-universe-constraints-in-typing-with-clause-of-a-module-type) - [universe constraints for module subtyping not stored in vo files](#universe-constraints-for-module-subtyping-not-stored-in-vo-files) - [module subtyping disrespected squashing status of inductives](#module-subtyping-disrespected-squashing-status-of-inductives) - [Functor inlining drops universe substitution](#functor-inlining-drops-universe-substitution) - [Primitives are incorrectly considered convertible to anything by module subtyping](#primitives-are-incorrectly-considered-convertible-to-anything-by-module-subtyping) - [Universes](#universes) - [issue with two parameters in the same universe level](#issue-with-two-parameters-in-the-same-universe-level) - [universe polymorphism can capture global universes](#universe-polymorphism-can-capture-global-universes) - [template polymorphism not collecting side constraints on the universe level of a parameter](#template-polymorphism-not-collecting-side-constraints-on-the-universe-level-of-a-parameter) - [more template polymorphism missing constraints](#more-template-polymorphism-missing-constraints) - [universe constraints erroneously discarded when forcing an asynchronous proof containing delayed monomorphic constraints inside a universe polymorphic section](#universe-constraints-erroneously-discarded-when-forcing-an-asynchronous-proof-containing-delayed-monomorphic-constraints-inside-a-universe-polymorphic-section) - [Set+2 incorrectly simplified to Set+1](#set2-incorrectly-simplified-to-set1) - [variance inference for section universes ignored use of section universes in inductives and axioms defined before the inductive being inferred](#variance-inference-for-section-universes-ignored-use-of-section-universes-in-inductives-and-axioms-defined-before-the-inductive-being-inferred) - [Primitive projections](#primitive-projections) - [check of guardedness of extra arguments of primitive projections missing](#check-of-guardedness-of-extra-arguments-of-primitive-projections-missing) - [records based on primitive projections became possibly recursive without the guard condition being updated](#records-based-on-primitive-projections-became-possibly-recursive-without-the-guard-condition-being-updated) - [incorrect checking of subtyping with algebraic universes](#incorrect-checking-of-subtyping-with-algebraic-universes) - [Conversion machines](#conversion-machines) - [the invariant justifying some optimization was wrong for some combination of sharing side effects](#the-invariant-justifying-some-optimization-was-wrong-for-some-combination-of-sharing-side-effects) - [collision between constructors when more than 256 constructors in a type](#collision-between-constructors-when-more-than-256-constructors-in-a-type) - [wrong universe constraints](#wrong-universe-constraints) - [missing pops in executing 31bit arithmetic](#missing-pops-in-executing-31bit-arithmetic) - [primitive integer emulation layer on 32 bits not robust to garbage collection](#primitive-integer-emulation-layer-on-32-bits-not-robust-to-garbage-collection) - [broken long multiplication primitive integer emulation layer on 32 bits](#broken-long-multiplication-primitive-integer-emulation-layer-on-32-bits) - [broken addmuldiv operation for large shifts](#broken-addmuldiv-operation-for-large-shifts) - [translation of identifier from Coq to OCaml was not bijective, leading to identify True and False](#translation-of-identifier-from-coq-to-ocaml-was-not-bijective-leading-to-identify-true-and-false) - [stuck primitive projections computed incorrectly by native_compute](#stuck-primitive-projections-computed-incorrectly-by-native_compute) - [incorrect De Bruijn handling when inferring the relevance mark for a lambda](#incorrect-de-bruijn-handling-when-inferring-the-relevance-mark-for-a-lambda) - [buffer overflow on large accumulators](#buffer-overflow-on-large-accumulators) - [buffer overflow, arbitrary code execution on floating-point operations](#buffer-overflow-arbitrary-code-execution-on-floating-point-operations) - [arbitrary code execution on irreducible PArray.set](#arbitrary-code-execution-on-irreducible-parrayset) - [arbitrary code execution on arrays of floating point numbers](#arbitrary-code-execution-on-arrays-of-floating-point-numbers) - [conversion of Prod / Prod values was comparing the wrong components](#conversion-of-prod-prod-values-was-comparing-the-wrong-components) - [η-expansion of cofixpoints was performed in the wrong environment](#-expansion-of-cofixpoints-was-performed-in-the-wrong-environment) - [conversion would compare the mutated version of primitive arrays instead of undoing mutation where needed](#conversion-would-compare-the-mutated-version-of-primitive-arrays-instead-of-undoing-mutation-where-needed) - [tactic code could mutate a global cache of values for section variables](#tactic-code-could-mutate-a-global-cache-of-values-for-section-variables) - [incorrect handling of universe polymorphism](#incorrect-handling-of-universe-polymorphism) - [Side-effects](#side-effects) - [polymorphic side-effects inside monomorphic definitions incorrectly handled as not inlined](#polymorphic-side-effects-inside-monomorphic-definitions-incorrectly-handled-as-not-inlined) - [Forgetting unsafe flags](#forgetting-unsafe-flags) - [unsafe typing flags used inside a section would not be reported by Print Assumptions after closing the section](#unsafe-typing-flags-used-inside-a-section-would-not-be-reported-by-print-assumptions-after-closing-the-section) - [Conflicts with axioms in library](#conflicts-with-axioms-in-library) - [axiom of description and decidability of equality on real numbers in library Reals was inconsistent with impredicative Set](#axiom-of-description-and-decidability-of-equality-on-real-numbers-in-library-reals-was-inconsistent-with-impredicative-set) - [guard condition was unknown to be inconsistent with propositional extensionality in library Sets](#guard-condition-was-unknown-to-be-inconsistent-with-propositional-extensionality-in-library-sets) - [incompatibility axiom of choice and excluded-middle with elimination of large singletons to Set](#incompatibility-axiom-of-choice-and-excluded-middle-with-elimination-of-large-singletons-to-set) - [Incorrect specification of PrimFloat.leb](#incorrect-specification-of-primfloatleb) - [Incorrect implementation of SFclassify.](#incorrect-implementation-of-sfclassify) - [nativenorm reading back closures as arbitrary floating-point values](#nativenorm-reading-back-closures-as-arbitrary-floating-point-values) - [Deserialization](#deserialization) - [deserialization of .vo data not properly checked](#deserialization-of-vo-data-not-properly-checked) - [Probably non exploitable fixed bugs](#probably-non-exploitable-fixed-bugs) - [bug in 31bit arithmetic](#bug-in-31bit-arithmetic) ## Non fixed bugs #### buffer overflow on large records and closures (infinite loop with OCaml 5) - component: VM reduction machine - introduced: 8.1 - impacted versions: 8.1-NOW - impacted coqchk versions: none (no VM in coqchk) - fixed in: NONE - found by: Dolan, Roux, Melquiond - GH issue number: ocaml/ocaml#6385, coq/coq#13439 - exploit: ?? - risk: requires very large number of arguments, fix block size or nested letins #### memory corruption by evaluating on ill-typed terms (obtained from unsafe tactics) - component: VM and native reduction machines - introduced: 8.1 - impacted versions: 8.1-NOW - impacted coqchk versions: none (no VM or native in coqchk) - fixed in: NONE - found by: Gaëtan Gilbert, Andres Erbsen - GH issue number: coq/coq#16891 - exploit: requires a memory corruption to craft something that doesn't just SIGSEV - risk: could be activated by chance but unlikely to produce anything other than SIGSEV outside a deliberate attack #### kernel and checker accept incorrect name aliasing information - component: name handling / typechecker - introduced: a long time ago - impacted versions: -NOW - impacted coqchk versions: same - fixed in: NONE - found by: Pierre-Marie Pédrot - GH issue number: coq/coq#7609 - exploit: see issue (requires a plugin or hand crafted .vo file) - risk: low #### coqchk checks too little about primitive declarations - component: primitive types and operators - introduced: v8.10 (#6914 primitive integers) - impacted versions: coqchk only - impacted coqchk versions: V8.10-NOW - fixed in: NONE - found by: Gaëtan Gilbert - GH issue number: coq/coq#12439 - exploit: not fully worked out, requires crafted .vo file - risk: none (requires crafted .vo file) #### Print Assumptions + Parameter Inline fails to report some inconsistent flags - component: module functors - introduced: coq/coq#79 - impacted versions: V8.6-NOW - impacted coqchk versions: none - found by: Jason Gross - GH issue number: coq/coq#12155 - exploit: see issue - risk: moderate if not using coqchk, none if using coqchk (coqchk rejects the produced file) #### Print Assumptions does not report Unset Universe Checking used during functor application - component: module functors - introduced: v8.11 (#10291) or earlier - impacted versions: V8.11-NOW - impacted coqchk versions: none - found by: Gaëtan Gilbert - GH issue number: coq/coq#16646 - exploit: see issue - risk: moderate if not using coqchk, none if using coqchk (coqchk rejects the produced file) ## Fixed bugs ### Typing constructions #### substitution missing in the body of a let - component: "match" - introduced: ? - impacted released versions: V8.3-V8.3pl2, V8.4-V8.4pl4 - impacted development branches: none - impacted coqchk versions: ? - fixed in: master/trunk/v8.5 ([e583a79b5](https://github.com/coq/coq/commit/e583a79b5a0298fd08f34305cc876d5117913e95), 22 Nov 2015, Herbelin), v8.4 ([525056f1](https://github.com/coq/coq/commit/525056f1a630426b78668ab583e228c25b492c35), 22 Nov 2015, Herbelin), v8.3 ([4bed0289](https://github.com/coq/coq/commit/4bed0289d66e6e413ccdea7a33dc747c83bce92e), 22 Nov 2015, Herbelin) - found by: Herbelin - exploit: test-suite/success/Case22.v - GH issue number: ? - risk: ? #### missing lift in checking guard - component: fixpoint, guard - introduced: probably from V5.10 - impacted released versions: probably V5-V7, V8.0-V8.0pl4, V8.1-V8.1pl4 - impacted development branches: v8.0 ? - impacted coqchk versions: ? - fixed in: master/trunk/v8.2 ([ff45afa8](https://github.com/coq/coq/commit/ff45afa83a9235cbe33af525b6b0c7985dc7e091), r11646, 2 Dec 2008, Barras), v8.1 ([f8e7f273](https://github.com/coq/coq/commit/f8e7f273f2e6009c3c0f0eee47c33542a6fdf361), r11648, 2 Dec 2008, Barras) - found by: Barras - exploit: test-suite/failure/guard.v - GH issue number: none - risk: unprobable by chance #### de Bruijn indice bug in checking guard of nested cofixpoints - component: cofixpoint, guard - introduced: after V6.3.1, before V7.0 - impacted released versions: V8.0-V8.0pl4, V8.1-V8.1pl4, V8.2-V8.2pl2, V8.3-V8.3pl2, V8.4-V8.4pl4 - impacted development branches: none - impacted coqchk versions: ? - fixed in: master ([9f81e2c36](https://github.com/coq/coq/commit/9f81e2c360c2be764e71d21ed7c266ee6e8a88c5), 10 Apr 2014, Dénès), v8.4 ([f50ec9e7d](https://github.com/coq/coq/commit/f50ec9e7dbd082c9a465aedda25427d93e12cabe), 11 Apr 2014, Dénès), v8.3 ([40c0fe7f4](https://github.com/coq/coq/commit/40c0fe7f44b3c99bec5188e01197c8a77348a4ee), 11 Apr 2014, Dénès), v8.2 ([06d66df8c](https://github.com/coq/coq/commit/06d66df8c713307625b1c40c054ca06c00ff74b3), 11 Apr 2014, Dénès), v8.1 ([977afae90](https://github.com/coq/coq/commit/977afae90c4e2aa974232b0c664346db72aadaa3), 11 Apr 2014, Dénès), v8.0 ([f1d632992](https://github.com/coq/coq/commit/f1d632992e33a74b30e79271bd3748d69c5a2152), 29 Nov 2015, Herbelin, backport) - found by: Dénès - exploit: ? - GH issue number: none ? - risk: ? #### de Bruijn indice bug in computing allowed elimination principle - component: inductive types, elimination principle - introduced: 23 May 2006, [9c2d70b](https://github.com/coq/coq/commit/9c2d70b91341552e964979ba09d5823cc023a31c), r8845, Herbelin (part of template polymorphism) - impacted released versions: V8.1-V8.1pl4, V8.2-V8.2pl2, V8.3-V8.3pl2, V8.4-V8.4pl4 - impacted development branches: none - impacted coqchk versions: ? - fixed in: master ([8a01c3685](https://github.com/coq/coq/commit/8a01c36850353c1875383cbc788cec9c42590b57), 24 Jan 2014, Dénès), v8.4 ([8a01c3685](https://github.com/coq/coq/commit/8a01c36850353c1875383cbc788cec9c42590b57), 25 Feb 2014, Dénès), v8.3 ([2b3cc4f85](https://github.com/coq/coq/commit/2b3cc4f85cc134fe58c21d720851e275e6a77ea0), 25 Feb 2014, Dénès), v8.2 ([459888488](https://github.com/coq/coq/commit/4598884884d6db00c485189e3a3b793b05814928), 25 Feb 2014, Dénès), v8.1 ([79aa20872](https://github.com/coq/coq/commit/79aa208728420747a933f38b3aa101c92f4dcde0), 25 Feb 2014, Dénès) - found by: Dénès - exploit: see coq/coq#3211 - GH issue number: coq/coq#3211 - risk: ? #### bug in Prop<=Set conversion which made Set identifiable with Prop, preventing a proof-irrelevant interpretation of Prop - component: universe subtyping - introduced: V8.2 ([bba897d5f](https://github.com/coq/coq/commit/bba897d5fd964bef0aa10102ef41cee1ac5fc3bb), 12 May 2008, Herbelin) - impacted released versions: V8.2-V8.2pl2 - impacted development branches: none - impacted coqchk versions: ? - fixed in: master/trunk ([679801](https://github.com/coq/coq/commit/679801623c1f55d0081f952c2094c3572fa39d4f), r13450, 23 Sep 2010, Glondu), v8.3 ([309a53f2](https://github.com/coq/coq/commit/309a53f2e1aa9b2a39654cf5fa23eb632a04c22f), r13449, 22 Sep 2010, Glondu), v8.2 (41ea5f08, r14263, 6 Jul 2011, Herbelin, backport) - found by: Georgi Guninski - exploit: test-suite/failure/prop_set_proof_irrelevance.v - GH issue number: none? - risk: ? #### incorrect abstraction of sort variables in relevance marks on opaque constants and lack of checking of relevance marks on constants in coqchk - component: sort polymorphism / proof irrelevance - introduced: V8.10 for the coqchk bug, V8.19 for the coqc bug - impacted released versions: V8.19.0 - impacted coqchk: versions: V8.10-V8.19.0 - fixed in: V8.19.1, V8.20 - found by: Gaëtan Gilbert - exploit / GH issue: [#18629](https://github.com/coq/coq/issues/18629) - risk: low (requires specific plugin code unlikely to be found in non malicious plugin) ### Module system #### missing universe constraints in typing "with" clause of a module type - component: modules, universes - introduced: ? - impacted released versions: V8.3-V8.3pl2, V8.4-V8.4pl6; unclear for V8.2 and previous versions - impacted development branches: none - impacted coqchk versions: ? - fixed in: master/trunk ([d4869e059](https://github.com/coq/coq/commit/d4869e059bfb73d99e1f5ef1b0a1f0906fa27056), 2 Oct 2015, Sozeau), v8.4 ([40350ef3b](https://github.com/coq/coq/commit/40350ef3b34b0be9d5ceddde772218c2f2dafe32), 9 Sep 2015, Sozeau) - found by: Dénès - exploit: test-suite/bugs/bug_4294.v - GH issue number: coq/coq#4294 - risk: ? #### universe constraints for module subtyping not stored in vo files - component: modules, universes - introduced: presumably 8.2 ([b3d3b56](https://github.com/coq/coq/commit/b3d3b566c5b5f34ab518c587f62530abde131be8)) - impacted released versions: 8.2, 8.3, 8.4 - impacted development branches: v8.5 - impacted coqchk versions: none - fixed in: v8.2 ([c1d9889](https://github.com/coq/coq/commit/c1d988904483eb1f3a8917ea08fced1240e3844b)), v8.3 (8056d02), v8.4 ([a07deb4](https://github.com/coq/coq/commit/a07deb4eac1d5f886159784ef5d8d006892be547)), trunk ([0cd0a3e](https://github.com/coq/coq/commit/0cd0a3ecdc7f942da153c59369ca3572bd18dd10)) Mar 5, 2014, Tassi - found by: Tassi by running coqchk on the mathematical components library - exploit: requires multiple files, no test provided - GH issue number: coq/coq#3243 - risk: could be exploited by mistake #### module subtyping disrespected squashing status of inductives - component: modules, universes, inductives - introduced: probably 7.4 ([1296520](https://github.com/coq/coq/commit/12965209478bd99dfbe57f07d5b525e51b903f22)) - impacted released versions: until 8.15.0 - impacted coqchk versions: none - fixed in: 8.15.1, 8.16 - found by: Pédrot - exploit: see GitHub issue - GH issue number: coq/coq#15838 - risk: unlikely (caught by coqchk, needs Unset Elimination Schemes in the module type) #### Functor inlining drops universe substitution - component: Modules - introduced: ? - impacted released versions: ??-V8.8.0 - impacted coqchk versions: same? not sure if coqchk has a this bug - fixed in: V8.8.1, V8.9.0 (#7616) - found by: Pierre-Marie Pédrot - GH issue number: coq/coq#7615 - exploit: see issue - risk: medium #### Primitives are incorrectly considered convertible to anything by module subtyping - component: modules, primitive types - introduced: 8.11 - impacted released versions: V8.11.0-V8.18.0 - impacted coqchk versions: same - fixed in: V8.19.0 - found by: Gaëtan Gilbert - GH issue number: coq/coq#18503 - exploit: see issue - risk: high if there is a Primitive in a Module Type, otherwise low ### Universes #### issue with two parameters in the same universe level - component: template polymorphism - introduced: 23 May 2006, [9c2d70b](https://github.com/coq/coq/commit/9c2d70b91341552e964979ba09d5823cc023a31c), r8845, Herbelin - impacted released versions: V8.1-V8.1pl4, V8.2-V8.2pl2, V8.3-V8.3pl2 - impacted development branches: none - impacted coqchk versions: ? - fixed in: trunk/master/v8.4 ([8082d1faf](https://github.com/coq/coq/commit/8082d1faf85a0ab29f6c144a137791902a4e9c1f), 5 Oct 2011, Herbelin), V8.3pl3 ([bb582bca2](https://github.com/coq/coq/commit/bb582bca2ca3fd94df01aad8d8070f8d129b25b3), 5 Oct 2011, Herbelin), v8.2 branch ([3333e8d3](https://github.com/coq/coq/commit/3333e8d3387b3bc4d3ceb75aad853f8e455af444), 5 Oct 2011, Herbelin), v8.1 branch ([a8fc2027](https://github.com/coq/coq/commit/a8fc2027258e1fb2defd05344e1249374f6e4e19), 5 Oct 2011, Herbelin), - found by: Barras - exploit: test-suite/failure/inductive.v - GH issue number: none - risk: unlikely to be activated by chance #### universe polymorphism can capture global universes - component: universe polymorphism - impacted released versions: V8.5 to V8.8 - impacted coqchk versions: V8.5 to V8.9 - fixed in: [ec4aa4971f](https://github.com/coq/coq/commit/ec4aa4971f7789eeccec2f38f2bb7ec976f87ede) ([58e1d0f200](https://github.com/coq/coq/commit/58e1d0f2006f3243cbf7b57a9858f5119ffea666) for the checker) - found by: Gaëtan Gilbert - exploit: test-suite/misc/poly-capture-global-univs - GH issue number: coq/coq#8341 - risk: unlikely to be activated by chance (requires a plugin) #### template polymorphism not collecting side constraints on the universe level of a parameter this is a general form of the previous issue about template polymorphism exploiting other ways to generate untracked constraints - component: template polymorphism - introduced: morally at the introduction of template polymorphism, 23 - May 2006, [9c2d70b](https://github.com/coq/coq/commit/9c2d70b91341552e964979ba09d5823cc023a31c), r8845, Herbelin - impacted released versions: at least V8.4-V8.4pl6, V8.5-V8.5pl3, V8.6-V8.6pl2, V8.7.0-V8.7.1, V8.8.0-V8.8.1, V8.9.0-V8.9.1, in theory also V8.1-V8.1pl4, V8.2-V8.2pl2, V8.3-V8.3pl2 but not exploit found there yet (an exploit using a plugin to force sharing of universe level is in principle possible though) - impacted development branches: all from 8.4 to 8.9 at the time of writing and suspectingly also all from 8.1 to 8.4 if a way to create untracked constraints can be found - impacted coqchk versions: a priori all (tested with V8.4 and V8.9 which accept the exploit) - fixed in: V8.10.0 ([eb3f8225a2](https://github.com/coq/coq/commit/eb3f8225a286aef3a57ad876584b4a927241ff69), PR coq/coq#9918, Aug 2019, Dénès and Sozeau) - found by: Gilbert using explicit sharing of universes, exploit found for 8.5-8.9 by Pédrot, other variants generating sharing using sections, or using ltac tricks by Sozeau, exploit in 8.4 by Herbelin and Jason Gross by adding new tricks to Sozeau's variants - exploit: test-suite/failure/Template.v - GH issue number: coq/coq#9294 - risk: moderate risk to be activated by chance #### more template polymorphism missing constraints using the same universe in the parameters and the constructor arguments of a template polymorphic inductive (using named universes in modern Coq, or unification tricks in older Coq) produces implicit equality constraints not caught by the previous template polymorphism fix. - component: template polymorphism - introduced: same as the previous template polymorphism bug, morally from V8.1, first verified impacted version V8.5 (the universe unification is sufficiently different in V8.4 to prevent our trick from working) - fixed in: expected in 8.10.2, 8.11+beta, master (#11128, Nov 2019, Gilbert) - found by: Gilbert - exploit: test-suite/bugs/bug_11039.v - GH issue number: coq/coq#11039 - risk: moderate risk (found by investigating coq/coq#10504) #### universe constraints erroneously discarded when forcing an asynchronous proof containing delayed monomorphic constraints inside a universe polymorphic section - component: universe polymorphism, asynchronous proofs - introduced: between 8.4 and 8.5 by merging the asynchronous proofs feature branch and universe polymorphism one - impacted released versions: V8.5-V8.10 - impacted development branches: none - impacted coqchk versions: immune - fixed in: coq/coq#10664 - found by: Pédrot - exploit: no test - GH issue number: none - risk: unlikely to be triggered in interactive mode, not present in batch mode (i.e. coqc) #### Set+2 incorrectly simplified to Set+1 - component: algebraic universes - introduced: V8.10 (with the SProp commit [7550876976](https://github.com/coq/coq/commit/75508769762372043387c67a9abe94e8f940e80a)) - impacted released versions: V8.10.0 V8.10.1 V8.10.2 - impacted coqchk versions: same - fixed in: coq/coq#11422 - found by: Gilbert - exploit: see PR (custom application of Hurkens to get around the refreshing at elaboration) - GH issue number: see PR - risk: unlikely to be triggered through the vernacular (the system "refreshes" algebraic universes such that +2 increments do not appear), mild risk from plugins which manipulate algebraic universes. #### variance inference for section universes ignored use of section universes in inductives and axioms defined before the inductive being inferred - component: cumulative inductives and sections - introduced: V8.12 ([73c3b87463](https://github.com/coq/coq/commit/73c3b874633d6f6f8af831d4a37d0c1ae52575bc)) - impacted released versions: V8.12 to V8.15 including patch releases - impacted coqchk versions: none - fixed in: V8.16 coq/coq#15950 ([118ffbc010](https://github.com/coq/coq/commit/118ffbc010ce53ebd45baa42edd28335301ca9a5)) - found by: Gilbert and Pédrot - exploit: see coq/coq#15916 - risk: could be used inadvertently in developments with complex universe usage, only when using cumulative inductives declared in sections. coqchk still works. ### Primitive projections #### check of guardedness of extra arguments of primitive projections missing - component: primitive projections, guard condition - introduced: 6 May 2014, [a4043608f](https://github.com/coq/coq/commit/a4043608f704f026de7eb5167a109ca48e00c221), Sozeau - impacted released versions: V8.5-V8.5pl2, - impacted development branches: none - impacted coqchk versions: ? - fixed in: trunk/master/v8.5 ([ba00867d5](https://github.com/coq/coq/commit/ba00867d515624aee734d998bfbe3880f559d907), 25 Jul 2016, Sozeau) - found by: Sozeau, by analyzing bug report coq/coq#4876 - exploit: to be done (?) - GH issue number: coq/coq#4876 - risk: consequence of bug found by chance, unlikely to be exploited by chance (MS?) #### records based on primitive projections became possibly recursive without the guard condition being updated - component: primitive projections, guard condition - introduced: 10 Sep 2014, [6624459e4](https://github.com/coq/coq/commit/6624459e492164b3d189e3518864379ff985bf8c), Sozeau (?) - impacted released versions: V8.5 - impacted development branches: none - impacted coqchk versions: ? - fixed in: trunk/master/v8.5 ([120053a50](https://github.com/coq/coq/commit/120053a50f87bd53398eedc887fa5e979f56f112), 4 Mar 2016, Dénès) - found by: Dénès exploiting bug coq/coq#4588 - exploit: test-suite/bugs/bug_4588.v - GH issue number: coq/coq#4588 - risk: ? #### incorrect checking of subtyping with algebraic universes - component: modules and universes - introduced: a long time ago - impacted released versions: ??-V8.8.0 - impacted coqchk versions: same - fixed in: V8.8.1, V8.9.0 (#7798) - found by: Gaëtan Gilbert - GH issue number: coq/coq#7695 - exploit: see issue - risk: needs usage of explicit algebraic universe annotations, coqchk may catch through defunctorialization ### Conversion machines #### the invariant justifying some optimization was wrong for some combination of sharing side effects - component: "lazy machine" (lazy krivine abstract machine) - introduced: prior to V7.0 - impacted released versions: V8.0-V8.0pl4, V8.1-V8.1pl3 - impacted development branches: none - impacted coqchk versions: ([eefe63d52](https://github.com/coq/coq/commit/eefe63d523b1b4c1b855e0f18e2574f98ff4ae64), Barras, 20 May 2008), was in beta-development for 8.2 at this time - fixed in: master/trunk/8.2 ([f13aaec57](https://github.com/coq/coq/commit/f13aaec57df12380323edf450aec14c372422d58) / [a8b034513](https://github.com/coq/coq/commit/a8b034513e0c03ceb7e154949b15f62ac6862f3b), 15 May 2008, Barras), v8.1 ([e7611477a](https://github.com/coq/coq/commit/e7611477a0a0d1b7e8c233330def46a066985cdc), 15 May 2008, Barras), v8.0 ([6ed40a8bc](https://github.com/coq/coq/commit/6ed40a8bc000b0419f3f4731bf83d05ab5062e76), 29 Nov 2016, Herbelin, backport) - found by: Gonthier - exploit: by Gonthier - GH issue number: none - risk: unrealistic to be exploited by chance #### collision between constructors when more than 256 constructors in a type - component: "virtual machine" (compilation to bytecode ran by a C-interpreter) - introduced: V8.1 - impacted released versions: V8.1-V8.5pl3, V8.2-V8.2pl2, V8.3-V8.3pl3, V8.4-V8.4pl5 - impacted development branches: none - impacted coqchk versions: none (no virtual machine in coqchk) - fixed in: master/trunk/v8.5 ([00894adf6](https://github.com/coq/coq/commit/00894adf6fc11f4336a3ece0c347676bbf0b4c11) / [596a4a525](https://github.com/coq/coq/commit/596a4a5251cc50f50bd6d25e36c81341bf65cfed), 26-39 Mar 2015, Grégoire), v8.4 ([cd2101a39](https://github.com/coq/coq/commit/cd2101a39b3b8d58ce569761c905a5baf1dcdc86), 1 Apr 2015, Grégoire), v8.3 ([a0c7fc05b](https://github.com/coq/coq/commit/a0c7fc05b302e38a2869c20f6db1dc376cdb59da), 1 Apr 2015, Grégoire), v8.2 ([2c6189f61](https://github.com/coq/coq/commit/2c6189f61b85bbe1a2a56754c9effc2d7a72f16d), 1 Apr 2015, Grégoire), v8.1 ([bb877e5b5](https://github.com/coq/coq/commit/bb877e5b54678bc34e4362fcf0315224e7c4f4cc), 29 Nov 2015, Herbelin, backport) - found by: Dénès, Pédrot - exploit: test-suite/bugs/bug_4157.v - GH issue number: coq/coq#4157 - risk: #### wrong universe constraints - component: "virtual machine" (compilation to bytecode ran by a C-interpreter) - introduced: possibly exploitable from V8.1; exploitable at least from V8.5 - impacted released versions: V8.1-V8.4pl5 unknown, V8.5-V8.5pl3, V8.6-V8.6.1, V8.7.0-V8.7.1 - impacted development branches: unknown for v8.1-v8.4, none from v8.5 - impacted coqchk versions: none (no virtual machine in coqchk) - fixed in: master ([c9f3a6cbe](https://github.com/coq/coq/commit/c9f3a6cbe5c410256fe88580019f5c7183bab097), 12 Feb 2018, coq/coq#6713, Dénès), v8.7 ([c058a4182](https://github.com/coq/coq/commit/c058a4182b39460ba2b256c479a1389216c25ca9), 15 Feb 2018, Zimmermann, backport), v8.6 ([a2cc54c64](https://github.com/coq/coq/commit/a2cc54c649c0b13190268cc5d490342d5f0cec10), 21 Feb 2018, Herbelin, backport), v8.5 ([d4d550d0f](https://github.com/coq/coq/commit/d4d550d0f1ae5f4a8d29bbcdf991a2526ab555a6), 21 Feb 2018, Herbelin, backport) - found by: Dénès - exploit: test-suite/bugs/bug_6677.v - GH issue number: coq/coq#6677 - risk: #### missing pops in executing 31bit arithmetic - component: "virtual machine" (compilation to bytecode ran by a C-interpreter) - introduced: V8.5 - impacted released versions: V8.1-V8.4pl5 - impacted development branches: v8.1 (probably) - impacted coqchk versions: none (no virtual machine in coqchk) - fixed in: master/trunk/v8.5 ([a5e04d9dd](https://github.com/coq/coq/commit/a5e04d9dd178b2870b79776e1fbf1a858cdac49d), 6 Sep 2015, Dénès), v8.4 ([d5aa3bf6](https://github.com/coq/coq/commit/d5aa3bf6fc7382e31b6f1bac58b644843d783f13), 9 Sep 2015, Dénès), v8.3 ([5da5d751](https://github.com/coq/coq/commit/5da5d751c92df23ff3f42a04061960b287a4d3ea), 9 Sep 2015, Dénès), v8.2 ([369e82d2](https://github.com/coq/coq/commit/369e82d2cdcd0d66d0c474dc1d062a4fc62aa24a), 9 Sep 2015, Dénès), - found by: Catalin Hritcu - exploit: lost? - GH issue number: ? - risk: #### primitive integer emulation layer on 32 bits not robust to garbage collection - component: "virtual machine" (compilation to bytecode ran by a C-interpreter) - introduced: master (before v8.10 in GH pull request coq/coq#6914) - impacted released versions: none - impacted development branches: v8.10 - impacted coqchk versions: none (no virtual machine in coqchk) - fixed in: [5914313](https://github.com/coq/coq/commit/591431312465291e85fb352a69e947eedeb2e199) (v8.10) - found by: Roux, Melquiond - exploit: - GH issue number: coq/coq#9925 - risk: #### broken long multiplication primitive integer emulation layer on 32 bits - component: all 3 kernel conversion machines (lazy, VM, native) - introduced: [e43b176](https://github.com/coq/coq/commit/e43b1768d0f8399f426b92f4dfe31955daceb1a4) - impacted released versions: 8.10.0, 8.10.1, 8.10.2 - impacted development branches: 8.11 - impacted coqchk versions: none (no virtual machine in coqchk) - fixed in: [4e176a7](https://github.com/coq/coq/commit/4e176a7ee4660d505321ca55c5ce70a6c3d50d3b) - found by: Soegtrop, Melquiond - exploit: test-suite/bugs/bug_11321.v - GH issue number: coq/coq#11321 - risk: critical, as any BigN computation on 32-bit architectures is wrong #### broken addmuldiv operation for large shifts - component: "virtual machine" (compilation to bytecode ran by a C-interpreter) - impacted released versions: 8.10 to 8.19 - impacted development branches: 8.20 - impacted coqchk versions: none (no virtual machine in coqchk) - fixed in: [bc0adb4](https://github.com/coq/coq/commit/bc0adb41a7c311f8d8305839c19e4812ff602720) - found by: Martin Karup Jensen - GH issue number: coq/coq#19402 - risk: could be exploited by chance (though not in BigNums) #### translation of identifier from Coq to OCaml was not bijective, leading to identify True and False For instance `α` and `__U03b1_` were the same in the native compiler. - component: "native" conversion machine (translation to OCaml which compiles to native code) - introduced: V8.5 - impacted released versions: V8.5-V8.5pl1 - impacted development branches: none - impacted coqchk versions: none (no native computation in coqchk) - fixed in: master/trunk/v8.6 ([244d7a9aa](https://github.com/coq/coq/commit/244d7a9aafe7ad613dd2095ca3126560cb3ea1d0), 19 May 2016, letouzey), v8.5 ([088b3161c](https://github.com/coq/coq/commit/088b3161c93e46ec2d865fe71a206cee15acd30c), 19 May 2016, letouzey), - found by: Letouzey, Dénès - exploit: see commit message for [244d7a9aa](https://github.com/coq/coq/commit/244d7a9aafe7ad613dd2095ca3126560cb3ea1d0) - GH issue number: ? - risk: #### stuck primitive projections computed incorrectly by native_compute - component: primitive projections, native_compute - introduced: 1 Jun 2018, [e1e7888a](https://github.com/coq/coq/commit/e1e7888ac4519f4b7470cc8469f9fd924514e352), ppedrot - impacted released versions: 8.9.0 - impacted coqchk versions: none - fixed in: 8.9.1 coq/coq#9900 - found by: maximedenes exploiting bug coq/coq#9684 - exploit: test-suite/bugs/bug_9684.v - GH issue number: coq/coq#9684 #### incorrect De Bruijn handling when inferring the relevance mark for a lambda - component: lazy machine - introduced: 2019-03-15, [23f84f37c6](https://github.com/coq/coq/commit/23f84f37c674a07e925925b7e0d50d7ee8414093) and [71b9ad8526](https://github.com/coq/coq/commit/71b9ad8526155020c8451dd326a52e391a9a8585), SkySkimmer - impacted released versions: 8.10.0 - impacted coqchk versions: 8.10.0 - fixed in: 8.10.1 coq/coq#10904 - found by: ppedrot investigating unexpected conversion failures with SProp - exploit: test-suite/bugs/bug_10904.v - GH issue number: coq/coq#10904 - risk: none without using -allow-sprop (off by default in 8.10.0), otherwise could be exploited by mistake #### buffer overflow on large accumulators - component: "virtual machine" (compilation to bytecode ran by a C-interpreter) - introduced: 8.1 - impacted released versions: 8.1-8.12.1 - impacted coqchk versions: none (no virtual machine in coqchk) - fixed in: 8.13.0 (#13431) - found by: Dolan, Roux, Melquiond - GH issue number: ocaml/ocaml#6385, coq/coq#11170 - risk: medium, as it can happen for large irreducible applications #### buffer overflow, arbitrary code execution on floating-point operations - component: "virtual machine" (compilation to bytecode ran by a C-interpreter) - introduced: 8.13 - impacted released versions: 8.13.0 - impacted coqchk versions: none (no virtual machine in coqchk) - fixed in: 8.13.1 - found by: Melquiond - GH issue number: coq/coq#13867 - risk: none, unless using floating-point operations; high otherwise; noticeable if activated by chance, since it usually breaks control-flow integrity #### arbitrary code execution on irreducible PArray.set - component: "virtual machine" (compilation to bytecode ran by a C-interpreter) - introduced: 8.13 - impacted released versions: 8.13.0, 8.13.1 - impacted coqchk versions: none (no virtual machine in coqchk) - fixed in: 8.13.2 - found by: Melquiond - GH issue number: coq/coq#13998 - risk: none, unless using primitive array operations; systematic otherwise #### arbitrary code execution on arrays of floating point numbers - component: "virtual" and "native" conversion machines - introduced: 8.13 - impacted released versions: 8.13.0, 8.13.1, 8.14.0 - impacted coqchk versions: none (no VM / native computation in coqchk) - fixed in: 8.14.1 - found by: Melquiond - GH issue number: coq/coq#15070 - risk: none, unless mixing open terms and primitive floats inside primitive - arrays; critical otherwise #### conversion of Prod / Prod values was comparing the wrong components - component: "native" conversion machine (translation to OCaml which compiles to native code) - introduced: V8.5 - impacted released versions: V8.5-V8.16.0 (when built with native computation enabled) - impacted coqchk versions: none (no native computation in coqchk) - fixed in: 8.16.1 - found by: Melquiond - GH issue number: coq/coq#16645 - risk: systematic #### η-expansion of cofixpoints was performed in the wrong environment - component: "virtual" and "native" conversion machines - introduced: V8.9 - impacted released versions: V8.9-V8.16.0 - impacted coqchk versions: none (no VM / native computation in coqchk) - fixed in: 8.16.1 - found by: Gaëtan Gilbert and Pierre-Marie Pédrot - GH issue number: coq/coq#16831 - risk: low, as it requires carefully crafted cofixpoints #### conversion would compare the mutated version of primitive arrays instead of undoing mutation where needed - component: all 3 kernel conversion machines (lazy, VM, native), primitive arrays - introduced: V8.13 - impacted released versions: V8.13 to V8.16.0 - impacted coqchk versions: same - fixed in: V8.16.1, V8.17 - found by: Maxime Buyse and Andres Erbsen - exploit: Andres Erbsen - GH issue number: coq/coq#16829 - risk: some if using primitive arrays #### tactic code could mutate a global cache of values for section variables - component: "virtual" reduction machine - introduced: V8.1 - impacted released versions: V8.1-V8.16.1 - impacted coqchk versions: none (no tactics in coqchk, VM only sees checked terms) - fixed in: V8.17.0 - found by: Gaëtan Gilbert with hint from Pierre-Marie Pédrot - GH issue number: coq/coq#16957 - risk: the full exploitation seems to require "Definition := ltac:()" with change_no_check on a section variable in the ltac #### incorrect handling of universe polymorphism - component: VM machine - introduced: V8.5 - impacted released versions: V8.5-V8.8.0 - impacted coqchk versions: none (no VM in coqchk) - fixed in: V8.8.1, V8.9.0 - found by: Jason Gross - GH issue number: coq/coq#7723 - exploit: see issue - risk: ?? ### Side-effects #### polymorphic side-effects inside monomorphic definitions incorrectly handled as not inlined - component: side-effects - introduced: ? - impacted released versions: at least from 8.6 to 8.12.0 - impacted coqchk versions: none (no side-effects in the checker) - fixed in: V8.12.1 (coq/coq#13331) - found by: ppedrot - exploit: test-suite/bugs/bug_13330.v - GH issue number: coq/coq#13330 - risk: unlikely to be exploited by mistake, requires the use of unsafe tactics ### Forgetting unsafe flags #### unsafe typing flags used inside a section would not be reported by Print Assumptions after closing the section - component: sections - introduced: [abab878b8d](https://github.com/coq/coq/commit/abab878b8d8b5ca85a4da688abed68518f0b17bd) (#10291, 8.11), technically available earlier through plugins - impacted coqchk versions: none (coqchk rejects affected files) - fixed in: 8.14 coq/coq#14395 - found by: Anton Trunov - GH issue number: coq/coq#14317 - risk: low as it needs the use of explicit unsafe flags ### Conflicts with axioms in library #### axiom of description and decidability of equality on real numbers in library Reals was inconsistent with impredicative Set - component: library of real numbers - introduced: [67c75fa01](https://github.com/coq/coq/commit/67c75fa01adbbe1d4e39eff2b930ad168510072c), 20 Jun 2002 - impacted released versions: 7.3.1, 7.4 - impacted coqchk versions: - fixed by deciding to drop impredicativity of Set: [bac707973](https://github.com/coq/coq/commit/bac707973955ef64eadae24ea01e029a5394626e), 28 Oct 2004 - found by: Herbelin & Werner - exploit: need to find the example again - GH issue number: no - risk: unlikely to be exploited by chance #### guard condition was unknown to be inconsistent with propositional extensionality in library Sets - component: library of extensional sets, guard condition - introduced: not a bug per se but an incompatibility discovered late - impacted released versions: technically speaking from V6.1 with the introduction of the Sets library which was then inconsistent from the very beginning without we knew it - impacted coqchk versions: ? - fixed by constraining the guard condition: ([9b272a8](https://github.com/coq/coq/commit/9b272a861bc3263c69b699cd2ac40ab2606543fa), [ccd7546c](https://github.com/coq/coq/commit/ccd7546cd32c8a7901a4234f86aa23b4a7e1a043) 28 Oct 2014, Barras, Dénès) - found by: Schepler, Dénès, Azevedo de Amorim - exploit: ? - GH issue number: none - risk: unlikely to be exploited by chance (?) #### incompatibility axiom of choice and excluded-middle with elimination of large singletons to Set - component: library for axiom of choice and excluded-middle - introduced: not a bug but a change of intended "model" - impacted released versions: strictly before 8.1 - impacted coqchk versions: ? - fixed by constraining singleton elimination: [b19397ed8](https://github.com/coq/coq/commit/b19397ed88ef8aa1ea1ca228b5d23b94e15f419f), r9633, 9 Feb 2007, Herbelin - found by: Benjamin Werner - exploit: - GH issue number: none - risk: #### Incorrect specification of PrimFloat.leb - component: primitive floating-points - introduced: 8.11 - impacted released versions: 8.11.0, 8.11.1, 8.11.2 - fixed by fixing the spec: coq/coq#12484 - found by: Pierre Roux - exploit: test-suite/bugs/bug_12483.v - GH issue number: coq/coq#12483 - risk: proof of false when using the incorrect axiom #### Incorrect implementation of SFclassify. - component: floating-point library - introduced: 8.11 - impacted released versions: 8.11.0-8.15.1 - fixed by fixing the implementation: coq/coq#16101 - found by: François Bobot - exploit: test-suite/bugs/bug_16096.v - GH_issue_number: coq/coq#16096 - risk: proof of false when using the axioms in Floats.Axioms. #### nativenorm reading back closures as arbitrary floating-point values - component: primitive floating-points + "native" conversion machine (translation to OCaml which compiles to native code) - introduced: 8.11 - impacted released versions: 8.11.0-8.17.1 - impacted coqchk versions: none (no native computation in coqchk) - fixed in: 8.18.0 - found by: Jason Gross - GH issue number: coq/coq#17871 - risk: proof of false when using primitive floats and native_compute ### Deserialization #### deserialization of .vo data not properly checked - component: coqchk (coqc trusts that .vo files are well formed) - introduced: 8.16 (univ levels), 8.10 (retroknowledge) - impacted released versions: 8.10-8.18.1 - impacted coqchk versions: same - fixed in: 8.19 - found by: Mario Carneiro - GH issue number: N/A (fix pull requests: coq/coq#18403, coq/coq#18406) - risk: can lead to segfaults or arbitrary code execution on crafted .vo files (files produced by coqc are fine) There were otherwise several bugs in beta-releases, from memory, bugs with beta versions of primitive projections or template polymorphism or native compilation or guard (e7fc96366, 2a4d714a1). ## Probably non exploitable fixed bugs There were otherwise maybe unexploitable kernel bugs, e.g. 2df88d83 (Require overloading), 0adf0838 ("Univs: uncovered bug in strengthening of opaque polymorphic definitions."), 5122a398 (#3746 about functors), coq/coq#4346 (casts in VM), a14bef4 (guard condition in 8.1), 6ed40a8 ("Georges' bug" with ill-typed lazy machine), and various other bugs in 8.0 or 8.1 without knowing if they are critical. #### bug in 31bit arithmetic - component: "virtual machine" (compilation to bytecode ran by a C-interpreter) - introduced: V8.1 - impacted released versions: none - impacted development branches: - impacted coqchk versions: none (no virtual machine in coqchk) - fixed in: master/trunk/v8.5 (0f8d1b92c, 6 Sep 2015, Dénès) - found by: Dénès, from a bug report by Tahina Ramananandro - exploit: non exploitable? - GH issue number: ? - risk: coq-8.20.0/dev/doc/debugging.md000066400000000000000000000024521466560755400162100ustar00rootroot00000000000000Debugging from Coq toplevel using OCaml toplevel ====================================================== 1. Launch bytecode version of Coq (`dune exec -- dev/shim/coqtop.byte`) 2. Access OCaml toplevel using vernacular command `Drop.` 3. Use `#trace` to tell which function(s) to trace, or type any other OCaml toplevel commands or OCaml expressions 4. Go back to Coq toplevel with `#quit;;` or `#go;;` 5. Test your Coq command and observe the result of tracing your functions 6. Freely switch from Coq to OCaml toplevels with `Drop.` and `#quit;;`/`#go;;` > [!NOTE] > To access plugin modules in the OCaml toplevel, you have to > use names such as `Ltac_plugin__Tacinterp`. > [!TIP] > To remove high-level pretty-printing features (coercions, > notations, ...), use `Set Printing All`. It will affect the `#trace` > printers too. Debugging with ocamldebug from Emacs or command line ==================================================== See [build-system.dune.md#ocamldebug](build-system.dune.md#ocamldebug) Global gprof-based profiling ============================ Coq must be configured with option `-profile`. 1. Run native Coq which must end normally (use `Quit` or option `-batch`) 2. `gprof ./coqtop gmon.out` Per function profiling ====================== See the documentation in `lib/newProfile.mli`. coq-8.20.0/dev/doc/drop.txt000066400000000000000000000025431466560755400154410ustar00rootroot00000000000000When you start byte-compiled Coq toplevel: rlwrap bin/coqtop.byte then if you type: Drop. you will decend from Coq toplevel down to Ocaml toplevel. So if you want to learn: - the current values of some global variables you are interested in - or see what happens when you invoke certain functions this is the place where you can do that. When you try to print values belonging to abstract data types: # let sigma, env = Lemmas.get_current_context ();; val sigma : Evd.evar_map = val env : Environ.env = # Typeops.infer env (snd (Pretyping.understand_tcc env sigma (Constrintern.intern_constr env (Pcoq.parse_string Pcoq.Constr.lconstr "plus"))));; - : Environ.unsafe_judgment = {Environ.uj_val = ; uj_type = } the printed values are not very helpful. One way how to deal with that is to load the corresponding printers: # #use "dev/include";; Consequently, the result of: # Typeops.infer env (snd (Pretyping.understand_tcc env sigma (Constrintern.intern_constr env (Pcoq.parse_string Pcoq.Constr.lconstr "plus"))));; will be printed as: - : Environ.unsafe_judgment = Nat.add : nat -> nat -> nat which makes more sense. To be able to understand the meaning of the data types, sometimes the best option is to turn those data types from abstract to concrete and look at them without any kind of pretty printing. coq-8.20.0/dev/doc/econstr.md000066400000000000000000000130041466560755400157250ustar00rootroot00000000000000# Evar-insensitive terms (EConstr) Evar-insensitive terms were introduced in 8.7, following [CEP #10](https://github.com/coq/ceps/blob/master/text/010-econstr.md). We will not recap the motivations in this document and rather summarize the code changes to perform. ## Overview The essential datastructures are defined in [the `EConstr` module](/engine/eConstr.mli) module. It defines the tactic counterparts of kernel data structures such as terms (`EConstr.constr`), universes (`EConstr.ESorts.t`) and contexts (`EConstr.*_context`). The main difference with kernel-side types is that observing them requires an evar-map at hand in order to normalize evars on the fly. The basic primitive to observe an `EConstr.t` is the following function: ``` val kind : Evd.evar_map -> t -> (t, t, ESorts.t, EInstance.t) Constr.kind_of_term (** Same as {!Constr.kind} except that it expands evars and normalizes universes on the fly. *) ``` Essentially, each time it sees an evar which happens to be defined in the provided evar-map, it replaces it with the corresponding body and carries on. Due to universe unification occurring at the tactic level, the same goes for universe instances and sorts. See the `ESort` and `EInstance` modules in `EConstr`. This normalization is critical for the soundness of tactics. Before EConstr, a lot of bugs were lurking in the code base, a few still are (most notably in meta-based unification) and failure to respect the guidelines thereafter may result in nasal demons. ## Transition path ### Types As a rule of thumb, all functions living at the tactic level should manipulate `EConstr.t` instead of `Constr.t`, and similarly for the other data structures. To ease the transition, the `EConstr` module defines a handful of aliases to shadow the type names from the kernel. It is recommended to perform the following replacement in headers. ```ocaml (** Kernel types. You may remove the two following opens if you want. Beware that [kind_of_term] needs to be in scope if you use [EConstr.kind] so that you may still need to open one of the two. *) open Term open Constr (** Tactic types. Open this after to shadow kernel types. *) open EConstr ``` Note that the `EConstr` module also redefines a `Vars` submodule. ### Evar-map-passing All functions deconstructing an econstr need to take an evar-map as a parameter. Therefore, you need to pass one as an argument virtually everywhere. In the Coq source code, it is recommended to take the evar-map as a first argument called `sigma`, except if the function also takes an environment in which case it is passed second. Namely, the two typical instances are: ```ocaml let foo sigma c = mycode val foo : Evd.evar_map -> EConstr.t -> Foo.t let bar env sigma c = mycode val bar : Environ.env -> Evd.evar_map -> EConstr.t -> Bar.t ``` The EConstr API makes the code much more sensitive to evar-maps, because a lot of now useless normalizations were removed. Thus one should be cautious of **not** dropping the evar-map when it has been updated, and should rather stick to a strict state-passing discipline. Unsound primitives like `Typing.unsafe_type_of` are also a known source of problems, so you should replace them with the corresponding evar-map-returning function and thread it properly. ### Functions Many functions from `Constr` and `Term` are redefined to work on econstr in the `EConstr` module, so that it is often enough to perform the `open` as described above to replace them. Their type may differ though, because they now need access to an evar-map. A lot of econstr-manipulating functions are also defined in [`Termops`](/engine/termops.mli). Functions manipulating tactic terms and kernel terms share the same name if they are the equivalent one of the other. Do not hesitate to grep Coq mli files to find the equivalent of a function you want to port if it is neither in `EConstr` nor in `Termops` (this should be very rare). ### Conversion Sometimes you do not have any other choice than calling kernel-side functions on terms, and conversely to turn a kernel term into a tactic term. There are two functions to do so. * `EConstr.of_constr` turns kernel terms into tactic terms. It is currently the physical identity, and thus O(1), but this may change in the future. * `EConstr.to_constr` turns tactic terms into kernel terms. It performs a full-blown normalization of the given term, which is O(n) and potentially costly. For performance reasons, avoiding to jump back and forth between kernel and tactic terms is recommended. There are also a few unsafe conversion functions that take advantage of the fact that `EConstr.t` is internally the same as `Constr.t`. Namely, `EConstr.Unsafe.to_constr` is the physical identity. It should **not** be used in typical code and is instead provided for efficiency **when you know what you are doing**. Either use it to reimplement low-level functions that happen to be insensitive externally, or use it to provide backward compatibility with broken code that relies on evar-sensitivity. **Do not use it because it is easier than stuffing evar-maps everywhere.** You've been warned. ## Notes The EConstr branch fixed a lot of eisenbugs linked to lack of normalization everywhere, most notably in unification. It may also have introduced a few, so if you see a change in behaviour *that looks like a bug*, please report it. Obviously, unification is not specified, so it's hard to tell apart, but still. Efficiency has been affected as well. We now pay an overhead when observing a term, but at the same time a lot of costly upfront normalizations were removed. coq-8.20.0/dev/doc/parsing.md000066400000000000000000000372461466560755400157310ustar00rootroot00000000000000# Parsing Coq's parser is based on Camlp5 using an extensible grammar. Somewhat helpful Camlp5 documentation is available [here](http://camlp5.github.io/doc/htmlc/grammars.html). However, the Camlp5 code has been copied into the Coq source tree and may differ from the Camlp5 release. Notable attributes of the parser include: * The grammar is extensible at run time. This is essential for supporting notations and optionally-loaded plugins that extend the grammar. * The grammar is split into multiple source files. Nonterminals can be local to a file or global. * While 95% of the nonterminals and almost all the productions are defined in the grammar, a few are defined directly in OCaml code. Since many developers have worked on the parser over the years, this code can be idiosyncratic, reflecting various coding styles. * The parser is a recursive descent parser that, by default, only looks at the next token to make a parsing decision. It's possible to hand-code additional lookahead where necessary by writing OCaml code. * There's no code that checks whether a grammar is ambiguous or whether every production can be recognized. Developers who modify the grammar may, in some cases, need to structure their added productions in specific ways to ensure that their additions are parsable and that they don't break existing productions. ## Contents ## - [Grammars: `*.mlg` File Structure](#grammars-mlg-file-structure) - [Grammars: Nonterminals and Productions](#grammars-nonterminals-and-productions) - [Alternate production syntax](#alternate-production-syntax) - [Usage notes](#usage-notes) - [Other components](#other-components) - [Parsing productions](#parsing-productions) - [Lookahead](#lookahead) ## Grammars: `*.mlg` File Structure ## Grammars are defined in `*.mlg` files, which `coqpp` compiles into `*.ml` files at build time. `coqpp` code is in the `coqpp` directory. `coqpp` uses yacc and lex to parse the grammar files. You can examine its yacc and lex input files in `coqpp_lex.mll` and `coqpp_parse.mly` for details not fully covered here. In addition, there is a `doc_grammar` build utility that uses the `coqpp` parser to extract the grammar, then edits and inserts it into the documentation. This is described in [`doc/tools/docgram/README.md`](../../doc/tools/docgram/README.md). `doc_grammar` generates [`doc/tools/docgram/fullGrammar`](../../doc/tools/docgram/fullGrammar), which has the full grammar for Coq (not including some optionally-loaded plugins). This may be easier to read since everything is in one file and the parser action routines and other OCaml code are omitted. `*.mlg` files contain the following types of nodes (See `node` in the yacc grammar). This part is very specific to Coq (not so similar to Camlp5): * OCaml code - OCaml code enclosed in curly braces, which is copied verbatim to the generated `*.ml` file * Comments - comments in the `*.mlg` file in the form `(* … *)`, which are not copied to the generated `*.ml` file. Comments in OCaml code are preserved. * `DECLARE_PLUGIN "*_plugin"` - associates the file with a specific plugin, for example "ltac_plugin" * `GRAMMAR EXTEND` - adds additional nonterminals and productions to the grammar and declares global nonterminals referenced in the `GRAMMAR EXTEND`: ``` GRAMMAR EXTEND Gram GLOBAL: bignat bigint …; END ``` Global nonterminals are declared in `pcoq.ml`, e.g. `let bignat = Entry.create "bignat"`. All the `*.mlg` files include `open Pcoq` and often its modules, e.g. `open Pcoq.Prim`. `GRAMMAR EXTEND` should be used only for large syntax additions. To add new commands and tactics, use these instead: - `VERNAC COMMAND EXTEND` to add new commands - `TACTIC EXTEND` to add new tactics - `ARGUMENT EXTEND` to add new nonterminals These constructs provide essential semantic information that's provided in a more complex, less readable way with `GRAMMAR EXTEND`. * `VERNAC COMMAND EXTEND` - adds new command syntax by adding productions to the `command` nonterminal. For example: ``` VERNAC COMMAND EXTEND ExtractionLibrary CLASSIFIED AS QUERY | [ "Extraction" "Library" ident(m) ] -> { extraction_library false m } END ``` Productions here are represented with alternate syntax, described later. New commands should be added using this construct rather than `GRAMMAR EXTEND` so they are correctly registered, such as having the correct command classifier. TODO: explain "ExtractionLibrary", CLASSIFIED AS, CLASSIFIED BY, "{ tactic_mode }", STATE * `VERNAC { … } EXTEND` - TODO. A variant. The `{ … }` is a block of OCaml code. * `TACTIC EXTEND` - adds new tactic syntax by adding productions to `simple_tactic`. For example: ``` TACTIC EXTEND btauto | [ "btauto" ] -> { Refl_btauto.Btauto.tac } END ``` adds a new nonterminal `btauto`. New tactics should be added using this construct rather than `GRAMMAR EXTEND`. TODO: explain DEPRECATED, LEVEL (not shown) * `ARGUMENT EXTEND` - defines a new nonterminal ``` ARGUMENT EXTEND ast_closure_term PRINTED BY { pp_ast_closure_term } INTERPRETED BY { interp_ast_closure_term } GLOBALIZED BY { glob_ast_closure_term } SUBSTITUTED BY { subst_ast_closure_term } RAW_PRINTED BY { pp_ast_closure_term } GLOB_PRINTED BY { pp_ast_closure_term } | [ term_annotation(a) constr(c) ] -> { mk_ast_closure_term a c } END ``` See comments in `tacentries.mli` for partial information on the various arguments. * `VERNAC ARGUMENT EXTEND` - (part of `argument_extend` in the yacc grammar) defines productions for a single nonterminal. For example: ``` VERNAC ARGUMENT EXTEND language PRINTED BY { pr_language } | [ "Ocaml" ] -> { let _ = warn_deprecated_ocaml_spelling () in Ocaml } | [ "OCaml" ] -> { Ocaml } | [ "Haskell" ] -> { Haskell } | [ "Scheme" ] -> { Scheme } | [ "JSON" ] -> { JSON } END ``` TODO: explain PRINTED BY, CODE * DOC_GRAMMAR - Used in `doc_grammar`-generated files to permit simplified syntax Note that you can reverse engineer many details by comparing the `.mlg` input file with the `.ml` generated by `coqpp`. ## Grammars: Nonterminals and Productions Here's a simple nonterminal definition in the Camlp5 format: ``` universe: [ [ IDENT "max"; "("; ids = LIST1 universe_expr SEP ","; ")" -> { ids } | u = universe_expr -> { [u] } ] ] ; ``` In which: * `universe` is the nonterminal being defined * productions are separated by `|` and, as a group, are enclosed in `[ [ … ] ];` * `u = universe_expr` refers to the `universe_expr` nonterminal. `u` is bound to the value returned by that nonterminal's action routine, which can be referred to in the action routine. For `ids = LIST1 universe_expr SEP ","`, `ids` is bound to the list of values returned by `universe_expr`. * `-> { … }` contains the OCaml action routine, which is executed when the production is recognized and returns a value * Semicolons separate adjacent grammatical elements (nonterminals, strings or other constructs) Grammatical elements that appear in productions are: - nonterminal names - identifiers in the form `[a-zA-Z0-9_]*`. These correspond to variables in the generated `.ml` code. In some cases a qualified name, such as `Prim.name`, is used. - `"…"` - a literal string that becomes a keyword and cannot be used as an `ident`. The string doesn't have to be a valid identifier; frequently the string will contain only punctuation characters. Generally we try to avoid adding new keywords that are also valid identifiers--though there is an unresolved debate among the developers about whether having more such keywords in general is good (e.g. it makes it easier to highlight keywords in GUIs) or bad (more keywords for the user to avoid and new keywords may require changes to existing proof files). - `IDENT "…"` - a literal string that has the form of an `ident` that doesn't become a keyword - `OPT element` - optionally include `element` (e.g. a nonterminal, IDENT "…" or "…"). The value is of type `'a option`. - `LIST1 element` - a list of one or more `element`s. The value is of type `'a list`. - `LIST0 element` - an optional list of `element`s - `LIST1 element SEP sep` - a list of `element`s separated by `sep` - `LIST0 element SEP sep` - an optional list of `element`s separated by `sep` - `( elements )` - grouping to represent a series of elements as a unit, useful within `OPT` and `LIST*`. - `[ elements1 | elements2 | … ]` - alternatives (either `elements1` or `elements2` or …), actually nested productions, each of which can have its own action routines Nonterminals can also be defined with multiple levels to specify precedence and associativity of its productions. This is described in the Coq documentation under the `Print Grammar` command. The first square bracket around a nonterminal definition is for grouping level definitions, which are separated with `|`, for example: ``` ltac_expr: [ "5" RIGHTA [ te = binder_tactic -> { te } ] | "4" LEFTA : ``` Grammar extensions can specify what level they are modifying, for example: ``` ltac_expr: LEVEL "1" [ RIGHTA [ tac = ltac_expr; intros = ssrintros_ne -> { tclintros_expr ~loc tac intros } ] ]; ``` ### Alternate production syntax ### Except for `GRAMMAR EXTEND`, the `EXTEND` nodes in the `*.mlg`s use simplified syntax in productions that's similar to what's used in the `Tactic Notation` and `Ltac2 Notation` commands. For example: ``` TACTIC EXTEND cc | [ "congruence" ] -> { congruence_tac 1000 [] } | [ "congruence" integer(n) ] -> { congruence_tac n [] } | [ "congruence" "with" ne_constr_list(l) ] -> { congruence_tac 1000 l } | [ "congruence" integer(n) "with" ne_constr_list(l) ] -> { congruence_tac n l } END ``` Nonterminals appearing in the alternate production syntax are accessed through `wit_*` symbols defined in the OCaml code. Some commonly used symbols are defined in `stdarg.ml`. Others are defined in the code generated by `ARGUMENT EXTEND` and `VERNAC ARGUMENT EXTEND` constructs. References to nonterminals that don't have `wit_*` symbols cause compilation errors. The differences are: * The outer `: [ … ];` is omitted. Each production is enclosed in `| [ … ]`. * The action routine is outside the square brackets * Literal strings that are valid identifiers don't become reserved keywords * No semicolons separating elements of the production * `integer(n)` is used to bind a nonterminal value to a variable instead of `n = integer` * Alternate forms of constructs are used: * `ne_entry_list` for `LIST1 entry` * `entry_list` for `LIST0 entry` * `ne_entry_list_sep(var, sep)` for `LIST1 entry SEP sep` where the list is bound to `var` * `entry_list_sep(var, sep)` for `LIST0 entry SEP sep` where the list is bound to `var` * `entry_opt` for OPT entry * There's no way to define `LEVEL`s * There's no equivalent to `( elements )` or `[ elements1 | elements2 | … ]`, which may require repeating similar syntax several times. For example, this single production is equivalent to 8 productions in `TACTIC EXTEND` representing all possible expansions of three `OPT`s: ``` | IDENT "Add"; IDENT "Parametric"; IDENT "Relation"; LIST0 binder; ":"; constr; constr; OPT [ IDENT "reflexivity"; IDENT "proved"; IDENT "by"; constr -> { … } ]; OPT [ IDENT "symmetry"; IDENT "proved"; IDENT "by"; constr -> { … } ]; OPT [ IDENT "transitivity"; IDENT "proved"; IDENT "by"; constr -> { … } ]; IDENT "as"; ident -> { … } ``` ## Usage notes ### Other components Coq's lexer is in `clexer.ml`. Its 10 token types are defined in `tok.ml`. The parser is in `grammar.ml`. The extensive use of GADT (generalized algebraic datatypes) makes it harder for the uninitiated to understand it. When the parser is invoked, the call tells the parser which nonterminal to parse. `vernac_control` is the start symbol for commands. `tactic_mode` is the start symbol for tactics. Tactics give syntax errors if Coq is not in proof mode. There are additional details not mentioned here. ### Parsing productions Some thoughts, not to be taken as identifying all the issues: Since the parser examines only the next token to make a parsing decision (and perhaps because of other potentially fixable limitations), some productions have to be ordered or structured in a particular way to parse correctly in all cases. For example, consider these productions: ``` command: [ [ | IDENT "Print"; p = printable -> { VernacPrint p } | IDENT "Print"; qid = smart_global; l = OPT univ_name_list -> { VernacPrint (PrintName (qid,l)) } | IDENT "Print"; IDENT "Module"; "Type"; qid = global -> { VernacPrint (PrintModuleType qid) } | IDENT "Print"; IDENT "Module"; qid = global -> { VernacPrint (PrintModule qid) } | IDENT "Print"; IDENT "Namespace" ; ns = dirpath -> { VernacPrint (PrintNamespace ns) } : printable: [ [ IDENT "Term"; qid = smart_global; l = OPT univ_name_list -> { PrintName (qid,l) } | IDENT "All" -> { PrintFullContext } | IDENT "Section"; s = global -> { PrintSectionContext s } : ``` Reversing the order of the first two productions in `command` causes the `All` in `Print All` to be parsed incorrectly as a `smart_global`, making that command unavailable. `Print Namespace nat.` still works correctly, though. Similarly, the production for `Print Module Type` has to appear before `Print Module ` in order to be reachable. Internally, the parser generates a tree that represents the possible prefixes for the productions of a nonterminal as described in [the Camlp5 documentation](http://camlp5.github.io/doc/htmlc/grammars.html#b:Rules-insertion). Here's another example in which the way the productions are written matters. `OPT` at the beginning of a production doesn't always work well: ``` command: [ [ | IDENT "Foo"; n = natural -> { VernacBack 1 } | OPT (IDENT "ZZ"); IDENT "Foo" -> { VernacBack 1 } : ``` `Foo.` looks like it should be accepted, but it gives a parse error: ``` Unnamed_thm < Foo. Toplevel input, characters 3-4: > Foo. > ^ Error: Syntax error: [prim:natural] expected after 'Foo' (in [vernac:command]). ``` Reversing the order of the productions doesn't help, but splitting the 'OPT' production into 2 productions works: ``` | IDENT "Foo" -> { VernacBack 1 } | IDENT "ZZ"; IDENT "Foo" -> { VernacBack 1 } | IDENT "Foo"; n = natural -> { VernacBack 1 } ``` On the other hand, `OPT` works just fine when the parser has already found the right production. For example `Back` and `Back ` can be combined using an `OPT`: ``` | IDENT "Back"; n = OPT natural -> { VernacBack (Option.default 1 n) } ``` ### Lookahead It's possible to look ahead more than one symbol using OCaml code. Generally we avoid doing this unless there's a strong reason to do so. For example, this code defines a new nonterminal `local_test_lpar_id_colon` that checks that the next 3 tokens are `"("` `ident` and `":"` without consuming any input: ``` let local_test_lpar_id_colon = let open Pcoq.Lookahead in to_entry "lpar_id_colon" begin lk_kw "(" >> lk_ident >> lk_kw ":" end ``` This one checks that the next 2 tokens are `"["` and `"|"` with no space between. This is a special case: intropatterns can have sequences like `"[|]"` that are 3 different tokens with empty nonterminals between them. Making `"[|"` a keyword would break existing code with "[|]": ``` let test_array_opening = let open Pcoq.Lookahead in to_entry "test_array_opening" begin lk_kw "[" >> lk_kw "|" >> check_no_space end ``` TODO: how to add a tactic or command coq-8.20.0/dev/doc/primproj.md000066400000000000000000000044601466560755400161200ustar00rootroot00000000000000Primitive Projections --------------------- | Proj of Projection.t * constr Projections are always applied to a term, which must be of a record type (i.e. reducible to an inductive type `I params`). Type-checking, reduction and conversion are fast (not as fast as they could be yet) because we don't keep parameters around. As you can see, it's currently a `constant` that is used here to refer to the projection, that will change to an abstract `projection` type in the future. Basically a projection constant records which inductive it is a projection for, the number of params and the actual position in the constructor that must be projected. For compatibility reason, we also define an eta-expanded form (accessible from user syntax `@f`). The constant_entry of a projection has both informations. Declaring a record (under `Set Primitive Projections`) will generate such definitions. The API to declare them is not stable at the moment, but the inductive type declaration also knows about the projections, i.e. a record inductive type decl contains an array of terms representing the projections. This is used to implement eta-conversion for record types (with at least one field and having all projections definable). The canonical value being `Build_R (pn x) ... (pn x)`. Unification and conversion work up to this eta rule. The records can also be universe polymorphic of course, and we don't need to keep track of the universe instance for the projections either. Projections are reduced _eagerly_ everywhere, and introduce a new `Zproj` constructor in the abstract machines that obeys both the delta (for the constant opacity) and iota laws (for the actual reduction). Refolding works as well (afaict), but there is a slight hack there related to universes (not projections). For the ML programmer, the biggest change is that pattern-matchings on kind_of_term require an additional case, that is handled usually exactly like an `App (Const p) arg`. There are slight hacks related to hints is well, to use the primitive projection form of f when one does `Hint Resolve f`. Usually hint resolve will typecheck the term, resulting in a partially applied projection (disallowed), so we allow it to take `constr_or_global_reference` arguments instead and special-case on projections. Other tactic extensions might need similar treatment. coq-8.20.0/dev/doc/profiling.md000066400000000000000000000061451466560755400162510ustar00rootroot00000000000000# How to profile Coq? I (Pierre-Marie Pédrot) mainly use two OCaml branches to profile Coq, whether I want to profile time or memory consumption. AFAIK, this only works for Linux. ## Time In Coq source folder: ``` opam switch 4.09.0+trunk+fp make world perf record -g _build/install/default/bin/coqc file.v perf report -g fractal,callee --no-children ``` To profile only part of a file, first load it using ``` bin/coqtop -l file.v ``` and plug into the process ``` perf record -g -p PID ``` ### Per-component [flame graphs](https://github.com/brendangregg/FlameGraph) I (Andres Erbsen) have found it useful to look at library-wide flame graphs of coq time consumption. As the Ltac interpreter stack is reflected in the OCaml stack, calls to the same primitive can appear on top of multiple essentially equivalent stacks. To make the profiles more readable, one could either try to edit the stack trace to merge "equivalent" frames, or simply look at the aggregate profile on a component-by-component basis. Here is how to do the second for the standard library ([example output](https://cdn.rawgit.com/andres-erbsen/b29b29cb6480dfc6a662062e4fcd0ae3/raw/304fc3fea9630c8e453929aa7920ca8a2a570d0b/stdlib_categorized_outermost.svg)). ``` #!/usr/bin/env bash make clean make states perf record -F99 `# ~1GB of data` --call-graph=dwarf -- make world perf script --time '0%-100%' | stackcollapse-perf.pl | grep Coqtop__compile | sed -rf <(cat <<'EOF' s/;caml/;/g s/_[0-9]*;/;/g s/Logic_monad__fun;//g s/_apply[0-9];//g s/;System/@&@/ s/;Hashcons/@&@/ s/;Grammar/@&@/ s/;Declaremods/@&@/ s/;Tactics/@&@/ s/;Pretyping/@&@/ s/;Typeops/@&@/ s/;Reduction/@&@/ s/;Unification/@&@/ s/;Evarutil/@&@/ s/;Evd/@&@/ s/;EConstr/@&@/ s/;Constr/@&@/ s/;Univ/@&@/ s/;Ugraph/@&@/ s/;UState/@&@/ s/;Micromega/@&@/ s/;Omega/@&@/ s/;Auto/@&@/ s/;Ltac_plugin__Tacinterp/@&@/ s/;Ltac_plugin__Rewrite/@&@/ s/[^@]*@;([^@]*)@/\1;\1/ s/@//g :a; s/;([^;]+);\1;/;\1;/g;ta EOF ) | flamegraph.pl ``` ## Memory (memtrace) [memtrace](https://github.com/janestreet/memtrace) is a client library for OCaml's Memprof statistical memory profiler. See this blog post for more details: https://blog.janestreet.com/finding-memory-leaks-with-memtrace/ To profile a file, you need to install the `memtrace` library, then recompile Coq. We also recommend you make a copy of the .v file (if working on the stdlib to avoid issues with artifacts. The following command sequence will do all that: ``` opam install memtrace dune build theories/Strings/Byte.vo # to build deps of Byte cp theories/Strings/Byte.v ./MyByte.v MEMTRACE=trace-byte.tcr dune exec -- dev/shim/coqc MyByte.v memtrace-viewer trace-byte.tcr ``` coq-8.20.0/dev/doc/proof-engine.md000066400000000000000000000155701466560755400166520ustar00rootroot00000000000000Tutorial on the new proof engine for ML tactic writers ====================================================== Starting from Coq 8.5, a new proof engine has been introduced, replacing the old meta-based engine which had a lot of drawbacks, ranging from expressivity to soundness, the major one being that the type of tactics was transparent. This was pervasively abused and made virtually impossible to tweak the implementation of the engine. The old engine is deprecated and is slowly getting removed from the source code. The new engine relies on a monadic API defined in the `Proofview` module. Helper functions and higher-level operations are defined in the `Tacmach` and `Tacticals` modules, and end-user tactics are defined amongst other in the `Tactics` module. At the root of the engine is a representation of proofs as partial terms that can contain typed holes, called evars, short for *existential variable*. An evar is essentially defined by its context and return type, that we will write `?e : [Γ ⊢ _ : A]`. An evar `?e` must be applied to a substitution `σ` of type `Γ` (i.e. a list of terms) to produce a term of type `A`, which is done by applying `EConstr.mkEvar`, and which we will write `?e{σ}`. The engine monad features a notion of global state called `evar_map`, defined in the `Evd` module, which is the structure containing the incremental refinement of evars. `Evd` is a low-level API and its use is discouraged in favour of the `Evarutil` module which provides more abstract primitives. In addition to this state, the monad also features a goal state, that is an ordered list of current holes to be filled. While these holes are referred to as goals at a high-enough level, they are actually no more than evars. The API provided to deal with these holes can be found in the `Proofview.Goal` module. Tactics are naturally operating on several goals at once, so that it is usual to use the `Proofview.Goal.enter` function and its variants to dispatch a tactic to each of the goals under focus. Primitive tactics by term refining ------------------------------------- A typical low-level tactic will be defined by plugging partial terms in the goal holes thanks to the `Refine` module, and in particular to the `Refine.refine` primitive. ```ocaml val refine : typecheck:bool -> (Evd.evar_map -> Evd.evar_map * EConstr.t) -> unit tactic (** In [refine ~typecheck t], [t] is a term with holes under some [evar_map] context. The term [t] is used as a partial solution for the current goal (refine is a goal-dependent tactic), the new holes created by [t] become the new subgoals. Exceptions raised during the interpretation of [t] are caught and result in tactic failures. If [typecheck] is [true] [t] is type-checked beforehand. *) ``` What the function does is first evaluate the `t` argument in the current proof state, and then use the resulting term as a filler for the proof under focus. All evars that have been created by the invocation of this thunk are then turned into new goals added in the order of their creation. To see how we can use it, let us have a look at an idealized example, the `cut` tactic. Assuming `X` is a type, `cut X` fills the current goal `[Γ ⊢ _ : A]` with a term `let x : X := ?e2{Γ} in ?e1{Γ} x` where `x` is a fresh variable and `?e1 : [Γ ⊢ _ : X -> A]` and `?e2 : [Γ ⊢ _ : X]`. The current goal is solved and two new holes `[e1, e2]` are added to the goal state in this order. ```ocaml let cut c = Proofview.Goal.enter begin fun gl -> (* In this block, we focus on one goal at a time indicated by gl *) let env = Proofview.Goal.env gl in (* Get the context of the goal, essentially [Γ] *) let concl = Proofview.Goal.concl gl in (* Get the conclusion [A] of the goal *) let hyps = Tacmach.pf_ids_set_of_hyps gl in (* List of hypotheses from the context of the goal *) let id = Namegen.next_name_away Anonymous hyps in (* Generate a fresh identifier *) let t = mkArrowR c (Vars.lift 1 concl) in (* Build [X -> A]. Note the lifting of [A] due to being on the right hand side of the arrow. *) Refine.refine ~typecheck:true begin fun sigma -> (* All evars generated by this block will be added as goals *) let sigma, f = Evarutil.new_evar env sigma t in (* Generate ?e1 : [Γ ⊢ _ : X -> A], add it to sigma, and return the term [f := Γ ⊢ ?e1{Γ} : X -> A] with the updated sigma. The identity substitution for [Γ] is extracted from the [env] argument, so that one must be careful to pass the correct context here in order for the resulting term to be well-typed. The [p] return value is a proof term used to enforce sigma monotonicity. *) let sigma, x = Evarutil.new_evar env sigma c in (* Generate ?e2 : [Γ ⊢ _ : X] in sigma and return [x := Γ ⊢ ?e2{Γ} : X]. *) let r = mkLetIn (Context.annotR (Name id), x, c, mkApp (Vars.lift 1 f, [|mkRel 1|])) in (* Build [r := Γ ⊢ let id : X := ?e2{Γ} in ?e1{Γ} id : A] *) (sigma, r) end end ``` The `Evarutil.new_evar` function is the preferred way to generate evars in tactics. It returns a ready-to-use term, so that one does not have to call the `mkEvar` primitive. There are lower-level variants whose use is dedicated to special use cases, *e.g.* whenever one wants a non-identity substitution. One should take care to call it with the proper `env` argument so that the evar and term it generates make sense in the context they will be plugged in. For the sake of completeness, the old engine was relying on the `Tacmach.refine` function to provide a similar feature. Nonetheless, it was using untyped metas instead of evars, so that it had to mangle the argument term to actually produce the term that would be put into the hole. For instance, to work around the untypedness, some metas had to be coerced with a cast to enforce their type, otherwise leading to runtime errors. This was working for very simple instances, but was unreliable for everything else. High-level composition of tactics ------------------------------------ It is possible to combine low-level refinement tactics to create more powerful abstractions. While it was the standard way of doing things in the old engine to overcome its technical limitations (namely that one was forced to go through a limited set of derivation rules), it is recommended to generate proofs as much as possible by refining in ML tactics when it is possible and easy enough. Indeed, this prevents dependence on fragile constructions such as unification. Obviously, it does not forbid the use of tacticals to mimic what one would do in Ltac. Each Ltac primitive has a corresponding ML counterpart with simple semantics. A list of such tacticals can be found in the `Tacticals` module. Most of them are a porting of the tacticals from the old engine to the new one, so that if they share the same name they are expected to have the same semantics. coq-8.20.0/dev/doc/release-process.md000066400000000000000000000256751466560755400173650ustar00rootroot00000000000000# Release checklist # ## When the release managers for version `X.X` get nominated ## - [ ] Create a new issue to track the release process where you can copy-paste the present checklist from `dev/doc/release-process.md`. - [ ] Decide the release calendar with the team (date of branching, preview and final release). - [ ] Create a wiki page that you link to from https://github.com/coq/coq/wiki/Release-Plan with this information and the link to the issue. ## About one month before the branching date ## - [ ] Create both the upcoming final release (`X.X.0`) and the following major release (`Y.Y+rc1`) milestones if they do not already exist. - [ ] Send an announcement of the upcoming branching date on Coqdev + the Coq development category on Discourse (coqdev@inria.fr + coq+coq-development@discoursemail.com) and ask people to remove from the `X.X+rc1` milestone any feature and clean up PRs that they already know won't be ready on time. - [ ] In a PR on `master`, call [`dev/tools/update-compat.py`](../tools/update-compat.py) with the `--release` flag; this sets up Coq to support three `-compat` flag arguments including the upcoming one (instead of four). To ensure that CI passes, you will have to decide what to do about all test-suite files that mention `-compat U.U` or `Coq.Compat.CoqUU` (which is no longer valid, since we only keep compatibility against the two previous versions), and you may have to ping maintainers of projects that are still relying on the old compatibility flag so that they fix this. - [ ] Make sure that this change is merged in time for the branching date. - [ ] Prepare a PR on `master` (not yet to be merged) changing the version name to the next major version and both magic numbers in [`tools/configure/configure.ml`](../../tools/configure/configure.ml). For example, for `8.5`, the version name will be `8.5+alpha` while the magic numbers will end with `80490`. Additionally, in the same commit, update the compatibility infrastructure, which consists of invoking [`dev/tools/update-compat.py`](../tools/update-compat.py) with the `--master` flag. Note that the `update-compat.py` script must be run twice: once in preparation of the release with the `--release` flag (see earlier in this section) and once on the branching date with the `--master` flag to mark the start of the next version. This PR should be opened before the branching date to have time to deal with CI issues, but should not be merged until branching. ## On the branching date ## - [ ] Merge the above PR and create the `vX.X` branch from the last merge commit before this one (using this name will ensure that the branch will be automatically protected). - [ ] Set the next major version alpha tag using `git tag -s`. The `VY.Y+alpha` tag marks the first commit to be in `master` and not in the `vX.X` release branch. Note that this commit is the first commit in the first PR merged in master, not the merge commit for that PR. Therefore, if you proceeded as described above, this should be the commit updating the version, magic numbers and compatibility infrastructure. After tagging, double-check that `git describe` picks up the tag you just made (if not, you tagged the wrong commit). - [ ] Push the new tag with `git push upstream VY.Y+alpha --dry-run` (remove the `--dry-run` and redo if everything looks OK). - [ ] Start a new ["classic" project](https://github.com/coq/coq/projects?type=classic) to track PR backporting. The project should have a `Request X.X+rc1 inclusion` column for the PRs that were merged in `master` that are to be considered for backporting, and a `Shipped in X.X+rc1` columns to put what was backported. A message to `@coqbot` in the milestone description tells it to automatically add merged PRs to the `Request ... inclusion` column and backported PRs to the `Shipped in ...` column. See previous milestones for examples. When moving to the next milestone (e.g. `X.X.0`), you can clear and remove the `Request X.X+rc1 inclusion` column and create new `Request X.X.0 inclusion` and `Shipped in X.X.0` columns. The release manager is the person responsible for merging PRs that target the release branch and backporting appropriate PRs (mostly safe bug fixes, user message improvements and documentation updates) that are merged into `master`. - [ ] Pin the versions of libraries and plugins in [`dev/ci/ci-basic-overlay.sh`](../ci/ci-basic-overlay.sh) to use commit hashes. You can use the [`dev/tools/pin-ci.sh`](../tools/pin-ci.sh) script to do this semi-automatically. - [ ] In a PR on `master` to be backported, add a new link to the `'versions'` list of the refman (in `html_context` in [`doc/sphinx/conf.py`](../../doc/sphinx/conf.py)). - [ ] Ping `@Zimmi48` and `@erikmd` to set up the infrastructure to have alpha Docker images built for the branch. ## In the days following the branching ## - [ ] Make sure that all the last feature PRs that you want to include in the release are finished and backported quickly and clean up the milestone. We recommend backporting as few feature PRs as possible after branching. In particular, any PR with overlays will require manually bumping the pinned commits when backporting. - [ ] Delay non-blocking issues to the appropriate milestone and ensure blocking issues are solved. If required to solve some blocking issues, it is possible to revert some feature PRs in the release branch only (but in this case, the blocking issue should be postponed to the next major release instead of being closed). - [ ] Once the final list of features is known, in a PR on `master` to be backported, generate the release changelog by calling [`dev/tools/generate-release-changelog.sh`](../tools/generate-release-changelog.sh) and include it in a new section in [`doc/sphinx/changes.rst`](../../doc/sphinx/changes.rst). The script automatically reorders the entries to show first the **Changed**, then the **Removed**, **Deprecated**, **Added** and last the **Fixed**. Manual adjustement is still needed when multiple entries are combined in a single changelog file. - [ ] Ping the development coordinator (`@mattam82`) to get him started on writing the release summary. The [`dev/tools/list-contributors.sh`](../tools/list-contributors.sh) script computes the number and list of contributors between Coq revisions. Typically used with `VX.X+alpha..vX.X` to check the contributors of version `VX.X`. Note that this script relies on [`.mailmap`](../../.mailmap) to merge multiple identities. If you notice anything incorrect while using it, use the opportunity to fix the `.mailmap` file. Same thing if you want to have the full name of a contributor shown instead of a pseudonym. - [ ] Put the branch name in the `CACHEKEY` variables in [`.gitlab-ci.yml`](../../.gitlab-ci.yml) (for instance ``old_ubuntu_lts-V2022-05-20-c34331afa5`` to ``"old_ubuntu_lts-v8.16-V2022-05-20-c34331afa5``) to indicate that it shouldn't be cleaned up even once it gets old. This should be done after all PRs touching the `CACHEKEY` variables have been merged. ## For each release (preview, final, patch-level) ## - [ ] Ensure that there exists a milestone for the following version. - [ ] Ensure the release changelog has been merged (the release summary is required for the final release). - [ ] In a PR against `vX.X` (for testing): - Update the version number in [`tools/configure/configure.ml`](../../tools/configure/configure.ml). - Only update the magic numbers for the final release. - Set `is_a_released_version` to `true`. - [ ] Set the tag `VX.X...` using `git tag -s`. - [ ] Push the new tag with `git push upstream VX.X... --dry-run` (remove the `--dry-run` and redo if everything looks OK). - [ ] Set `is_a_released_version` to `false` (if you forget about it, you'll be reminded by the test-suite failing whenever you try to backport a PR with a changelog entry). - [ ] Close the milestone. - [ ] Send an e-mail on coqdev + coq-club + the Coq announcement category on Discourse (coqdev@inria.fr + coq-club@inria.fr + coq+announcements@discoursemail.com) announcing that the tag has been set so that package managers can start preparing package updates (including a `coq-bignums` compatible version), after which library authors can safely start preparing compatible releases. - [ ] In particular, ensure that someone is working on providing an opam package (either in the main [ocaml/opam-repository](https://github.com/ocaml/opam-repository) for standard releases or in the `core-dev` category of the [coq/opam-coq-archive](https://github.com/coq/opam-coq-archive) for preview releases. - [ ] Make sure to cc `@ejgallego` to ensure that a release for [coq-serapi](https://github.com/ejgallego/coq-serapi) is available in `opam-repository` (typically, using `dune-release tag` and `dune-release`). - [ ] Make sure to cc `@proux01` to ensure that a `coq-bignums` opam package is available in [`extra-dev`](https://github.com/coq/opam-coq-archive/tree/master/extra-dev) or [`released`](https://github.com/coq/opam-coq-archive/tree/master/released), respectively. - [ ] Make sure to cc `@erikmd` to ensure that the necessary configuration is ready to release the Docker images in [`coqorg/coq`](https://hub.docker.com/r/coqorg/coq) (gathering `coq`, `coq-bignums`, and `coq-serapi` opam packages). - [ ] Publish a release on GitHub with the PDF version of the reference manual attached. The PDF can be recovered from the artifacts of the `doc:refman-pdf` job from continuous integration. Also attach a `tar.gz` archive of the sources (to ensure a stable hash, you can copy the archive autogenerated by github when the release is published). - [ ] If pinged by opam package providers in pull requests to [ocaml/opam-repository](https://github.com/ocaml/opam-repository), transfer any changes to opam packages required by opam-repository CI (such as missing dependencies) to the corresponding package definitions in the Coq repository. ## For each non-preview release ## - [ ] Modify the version number in the file [`incl/macros.html`](https://github.com/coq/www/blob/master/incl/macros.html) on the website. ## Only for the final release of each major version ## - [ ] Ping `@Zimmi48` to publish a new version on Zenodo. *TODO:* automate this with coqbot. ## This is now delegated to the platform maintainers ## - [ ] Sign the Windows and MacOS packages and upload them on GitHub. + The Windows packages must be signed by the Inria IT security service. They should be sent as a link to the binary (via [filesender](https://filesender.renater.fr) for example) together with its SHA256 hash in a signed e-mail to `dsi.securite` @ `inria.fr` putting `@maximedenes` in carbon copy. + The MacOS packages should be signed with our own certificate. + The Snap package has to be built and uploaded to the snap store by running a [platform CI job manually](https://github.com/coq/platform/tree/2021.02/linux/snap/github_actions). Then ask a Platform maintainer with access to the store to publish the upload or give you access so that you can do it yourself. - [ ] Announce the release to Coq-Club and Discourse (coq-club@inria.fr + coq+announcements@discoursemail.com). coq-8.20.0/dev/doc/shield-icon.png000066400000000000000000000206061466560755400166400ustar00rootroot00000000000000PNG  IHDRMFasBITO IDATx^ TSYO:g˓u9NO%\BݩYm^*ūaA(\ ((Ay)" ""(\j!0{g[ϟ?Ё "0~2:JD@ʰh "0_P/H/" (â1 |@v"" " Ee"""MϞ~Ï?`$ N-Gq{_w&e>fP"(ְY.AjEr" |o_ " #0)ٟ.㊤Dpd Ϸz BD-װ@#Z+GDp("R" s 2&"8DeX0!!D@@e9@CMDpʰaBB"́ʰs "5됦mw `60ȏyxd @_U~ϩ,Tu{/@bh4fN7I   =ΔahldC}9Vk::}2ȼϞ=G~|){A:D@3ÂQL'Cz * xot?Rʛ!~(9!䌌biߓJ\arOZEөI ù~N *lN#~ '3"fotr#ekfg㌷`h:J˴ 7ۛk'#ql\xʙvx涚tiYw-c0мGљʫWvh+զ_c"eYYe?V;|&sz DCT|py @;oݠy$3Hr2xw%fӿ>XY4`?-#i9,CU@p^ow#\)Q-@ǟ0 6$mn201[g|F}C$ fJcʓ壡  EhCU8%ؔ'3),_]؍Iؽ=6W+@U!^_,76"@mN,ԀlH1<}B3&)uM r#muE>IG[ui?lz?l'N5N 6 fI\ 9fX.AjGZ jĪX8aLW{5RkH 6iE 6%[ oXab:Z%3#N01:emxP@bҢRԭ#z̍)e"S:Y$٦W\2݆&Bނb0SɑCO~Ƈk~ѹ2!A/ai<˓Nn]w8 >ma IN>ԟTT)B> Zr]6+G 06P0RJ;- 9VʸLg90|*`.M'0-g8Zp}9Mz-/~=Sg.0a8,tp0:<1Xw@hi#" PK)j)g :ef]$vpsrPyb٣GRL{ 1(M}VI7Ʒ_U|/eaf˯%t<|M.Wq Iǎo *naO`knҩk.{ 2覂[ƻFR) {s͓}FAcb[_S^[6 V$sG`+$Ԭ;tKyF(dhN W  8cxKkv ̇!1ICrnBK'$ i#D"dVS\R~ެC"p}X[&^2Ľy o g]ÚWgJM(ND8e5O(:ըC"o ˰2ZQXh;wU_|g9ev[JD@wݶuK8j3q rŸ-Q9" _.-}7.AC(6T 7SчEan~#D@^->֋.74Zj:" m_reof;ED1_- ٳWJ GDQ3Ea !" 8w #}ypVnSY?+] gKPl6aIΦU -ml#'_v 2M[_{i~4iiU|mT1?uq9CMs/Ӎ #Yvb#x&܄{w?iB|viw`83 _ےlP ` 8$ N6Pv T$JS\Sɹ Ė'bFדvH:wmvN!/?)Wϒ%֧ ػa! P!{ ֛gI6/Z8,̾ N:!6\˰\ݷI upֆJP̍**ئ,UpwqΕv27hAi&"I8i{p=Gz]CEdŸsYHi1`!68 !7v-|'*oЪ!&Vvbf$):TW~(c;6' {e)$JN ij&c`(9{+տ%o*۪*RzS;+ۓiְ_BJI-9uZ&_vgTO9z Fgh~.+Wg=( ޒ%Q*7Q+fIY+ ʁl?s;.A"\ka)D:Kct"L(:5}DYۋ*)pAʹXͩCO$KFBmbFf⻿D9Xq雱|ƸAHk g *Gg7grږ^PU[uEC,LެQF`&L끤$JHۊjkKp ީ&xB$Ykym8B9ךz WP7dhPSf{֘1dZvG3} 9lq !(i^vO\׿JzjAXiZF'O w3O.~jX= ~[mPDx37`x{`NaLtN}3@<)U_!ih;{ t 0#OOU>#Qad؅ I6$5|‚$I'wJΉ7V޸omΪKᡜ04?֘07D ^m p?t ID_kF'NI |얐 EX@ihaސ#JA ]W;\(F[z$p8Gx8N)m3%NO  "útll] ܿН+C M(mHzq*4y;68l^e 0'+-iJlf[1N"wddw4f{XRtcJX<(mkD+\>!#WR% >;r LX:"hY$tcI%5CM7mZ|7B&3wuj `E%pՋAڝ9.AF@^F,lR\ hcw]r'@4~tCuDO];3Tս)[ڦ>5T-4?Q ZT&+0cwUu~TpJ;GE .wit}+(Pfl<ʎl\MfSExK:@$ha>3tYQ~1ɤnXf;k0fg*T+9IZ+9],̩;ǺP[}{6$m?R*0tЪ m'lN+t9فzuf^eCku6R=^(Yw rd{vDLrҍʔLvZ15y@O@6VJmw9w\Xtw BҤ=R'DC78;?hRY{NDmmᚮjţ=#lRٞ5V(R7CIjI܈VzhYS*p [OGfL}@LcbΫh-o*{69-39RT&d?52:ᢆRU݉8Nّic 03O㕜dS)آ;.Ql('&@l T9<GƤWp, N oWp{] GIbE'& _tpF"r(¾(;~_BZ|\uS2IDAT~ @&{.{ Ffn+'xqEmez@D`nIX|neXouwGJn~ -t@lE*ԿI\jV/jJ Z8[./lάŶww*olojSoP{t`9DʰeXH;TP?-)>OY`|o@G8I(B: eXT 'ty@EMeE=9Dpj(:u!D`Q@vQwr@Hgݠ1IENDB`coq-8.20.0/dev/doc/style.md000066400000000000000000000152241466560755400154160ustar00rootroot00000000000000# OCaml Style for Coq > Style uniformity is more important than style itself > -- Kernigan & Pike, The Practice of Programming ## Spacing and indentation - indent your code (using tuareg default) - no strong constraints in formatting `let in`; possible styles are: ```ocaml let x = ... in ``` ```ocaml let x = ... in ``` ```ocaml let x = ... in ``` - but: no extra indentation before a `in` coming on next line, otherwise, it first shifts further and further on the right, reducing the amount of space available; second, it is not robust to insertion of a new `let` - it is established usage to have space around `|` as in ```ocaml match c with | [] | [a] -> ... | a::b::l -> ... ``` - in a one-line `match`, it is preferred to have no `|` in front of the first case (this saves spaces for the match to hold in the line) - from about 8.2, the tendency is to use the following format which limit excessive indentation while providing an interesting "block" aspect ```ocaml type t = | A | B of machin let f expr = match expr with | A -> ... | B x -> ... let f expr = function | A -> ... | B x -> ... ``` - add spaces around `=` and `==` (make the code "breathe") - the common usage is to write `let x,y = ... in ...` rather than `let (x,y) = ... in ...` - parenthesizing with either `(` and `)` or with `begin` and `end` is common practice - preferred layout for conditionals: ```ocaml if condition then first-case else second-case ``` - in case of effects in branches, use `begin ... end` rather than parentheses ```ocaml if condition then begin instr1; instr2 end else begin instr3; instr4 end ``` - if the first branch raises an exception, avoid the `else`, i.e. use ```ocaml if condition then error "foo"; bar ``` instead of ```ocaml if condition then error "foo" else bar ``` - it is the usage not to use `;;` to end OCaml sentences (however, inserting `;;` can be useful for debugging syntax errors crossing the boundary of functions) - relevant options in tuareg: ``` (setq tuareg-in-indent 2) (setq tuareg-with-indent 0) (setq tuareg-function-indent 0) (setq tuareg-let-always-indent nil) ``` - when a match fails to compile due to unbound constructors (eg `match x with VarRef x -> bla | ConstRef x -> bli | _ -> blo` when `GlobRef` is not open) it can be resolved in several ways: + locally or globally open `GlobRef` + type annotate `x : GlobRef.t` (where it is introduced, or in the `match` expression, whichever is nicer) + annotate the first branch `GlobRef.VarRef x -> bla` this last solution is not robust to branch reordering so should not be prefered ## Coding methodology - no `try ... with _ -> ...` which catches even `Sys.Break` (Ctrl-C), `Out_of_memory`, `Stack_overflow`, etc. at least, use `try with e when Errors.noncritical e -> ...` (to be detailed, Pierre L. ?) - do not abuse fancy combinators: sometimes what a `let rec` loop does is more readable and simpler to grasp than what a `fold` does - do not break abstractions: if an internal property is hidden behind an interface, do no rely on it in code which uses this interface (e.g. do not use `List.map` thinking it is left-to-right, use `map_left`) - in particular, do not use `=` on abstract types: there is no reason a priori that it is the intended equality on this type; use the `equal` function normally provided with the abstract type - avoid polymorphically typed `=` whose implementation is not optimized in OCaml and which has moreover no reason to be the intended implementation of the equality when it comes to be instantiated on a particular type (e.g. use `List.mem_f`, `List.assoc_f`, rather than `List.mem`, `List.assoc`, etc, unless it is absolutely clear that `=` will implement the intended equality, and with the right complexity) - any new general-purpose enough combinator on list should be put in `cList.ml`, on type option in `cOpt.ml`, etc. - unless for a good reason not to do so, follow the style of the surrounding code in the same file as much as possible, the general guidelines are otherwise "let spacing breathe" (we have large screen nowadays), "make your code easy to read and to understand" - document what is tricky, but do not overdocument, sometimes the choice of names and the structure of the code are better documentation than a long discourse; use of unicode in comments is welcome if it can make comments more readable (then `toggle-enable-multibyte-characters` can help when using the debugger in emacs) - all of initial `open File`, or of small-scope `File.(...)`, or per-ident `File.foo` are common practices ## Choice of variable names - be consistent when naming from one function to another - be consistent with the naming adopted in the functions from the same file, or with the naming used elsewhere by similar functions - use variable names which express meaning - keep `cst` for constants and avoid it for constructors which is otherwise a source of confusion - for constructors, use `cstr` in type constructor (resp. `cstru` in constructor puniverse); avoid `constr` for `constructor` which could be think as the name of an arbitrary Constr.t - for inductive types, use `ind` in the type inductive (resp `indu` in inductive puniverse) - for `env`, use `env` - for `evar_map`, use `sigma`, with tolerance into `evm` and `evd` - for `named_context` or `rel_context`, use `ctxt` or `ctx` (or `sign`) - for formal/actual indices of inductive types: `realdecls`, `realargs` - for formal/actual parameters of inductive types: `paramdecls`, `paramargs` - for terms, use e.g. `c`, `b`, `a`, ... - if a term is known to be a function: `f`, ... - if a term is known to be a type: `t`, `u`, `typ`, ... - for a declaration, use `d` or `decl` - for errors, exceptions, use `e` ## Common OCaml pitfalls - in ```ocaml match ... with Case1 -> try ... with ... -> ... | Case2 -> ... ``` or in ```ocaml match ... with Case1 -> match ... with SubCase -> ... | Case2 -> ... ``` parentheses are needed around the `try` and the inner `match` - even if streams are lazy, the `Pp.(++)` combinator is strict and forces the evaluation of its arguments (use a `lazy` or a `fun () ->`) to make it lazy explicitly - in ```ocaml if ... then ... else ... ++ ... ``` the default parenthesizing is somehow counter-intuitive; use ```ocaml (if ... then ... else ...) ++ ... ``` - in `let myspecialfun = mygenericfun args`, be sure that it does not do side-effect; prefer otherwise ```ocaml let mygenericfun arg = mygenericfun args arg ``` to ensure that the function is evaluated at runtime coq-8.20.0/dev/doc/unification.txt000066400000000000000000000122251466560755400170030ustar00rootroot00000000000000Some notes about the use of unification in Coq ---------------------------------------------- There are several applications of unification and pattern-matching ** Unification of types ** - For type inference, inference of implicit arguments * this basically amounts to solve problems of the form T <= U or T = U where T and U are types coming from a given typing problem * this kind of problem has to succeed and all the power of unification is a priori expected (full beta/delta/iota/zeta/nu/mu, pattern-unification, pruning, imitation/projection heuristics, ...) - For lemma application (apply, auto, ...) * these are also problems of the form T <= U on types but with T coming from a lemma and U from the goal * it is not obvious that we always want unification and not matching * it is not clear which amounts of delta one wants to use ** Looking for subterms ** - For tactics applying on subterms: induction, destruct, rewrite - As part of unification of types in the presence of higher-order evars (e.g. when applying a lemma of conclusion "?P t") ---------------------------------------------------------------------- Here are examples of features one may want or not when looking for subterms A- REWRITING 1- Full conversion on closed terms 1a- Full conversion on closed terms in the presence of at least one evars (meta) Section A1. Variable y: nat. Hypothesis H: forall x, x+2 = 0. Goal y+(1+1) = 0. rewrite H. (* 0 = 0 *) Abort. Goal 2+(1+1) = 0. rewrite H. (* 0 = 0 *) Abort. (* This exists since the very beginning of Chet's unification for tactics *) (* But this fails for setoid rewrite *) 1b- Full conversion on closed terms without any evars in the lemma 1b.1- Fails on rewrite (because Unification.w_unify_to_subterm_list replaces unification by check for a syntactic subterm if terms has no evar/meta) Goal 0+1 = 0 -> 0+(1+0) = 0. intros H; rewrite H. (* fails *) Abort. 1b.2- Works with setoid rewrite Require Import Setoid. Goal 0+1 = 0 -> 0+(1+0) = 0. intros H; rewrite H at 1. (* 0 = 0 *) Abort. 2- Using known instances in full conversion on closed terms Section A2. Hypothesis H: forall x, x+(2+x) = 0. Goal 1+(1+2) = 0. rewrite H. Abort. End A2. (* This exists since 8.2 (HH) *) 3- Pattern-unification on Rels Section A3a. Variable F: (nat->nat->nat)->nat. Goal exists f, F (fun x y => f x y) = 0 -> F (fun x y => plus y x) = 0. eexists. intro H; rewrite H. (* 0 = 0 *) Abort. End A3a. (* Works since pattern unification on Meta applied to Rel was introduced *) (* in unification.ml (8.1, Sep 2006, HH) *) Section A3b. Variables x y: nat. Variable H: forall f, f x y = 0. Goal plus y x = 0. rewrite H. (* 0 = 0 *) Abort. End A3b. (* Works since pattern unification on all Meta was supported *) (* in unification.ml (8.4, Jun 2011, HH) *) 4- Unification with open terms Section A4. Hypothesis H: forall x, S x = 0. Goal S 0 = 0. rewrite (H _). (* 0 = 0 *) Abort. End A4. (* Works since unification on Evar was introduced so as to support rewriting *) (* with open terms (8.2, MS, r11543, Unification.w_unify_to_subterm_list ) *) 5- Unification of pre-existing evars 5a- Basic unification of pre-existing evars Section A4. Variables x y: nat. Goal exists z, S z = 0 -> S (plus y x) = 0. eexists. intro H; rewrite H. (* 0 = 0 *) Abort. End A4. (* This worked in 8.2 and 8.3 as a side-effect of support for rewriting *) (* with open terms (8.2, MS, r11543) *) 5b- Pattern-unification of pre-existing evars in rewriting lemma Goal exists f, forall x y, f x y = 0 -> plus y x = 0. eexists. intros x y H; rewrite H. (* 0 = 0 *) Abort. (* Works since pattern-unification on Evar was introduced *) (* in unification.ml (8.3, HH, r12229) *) (* currently governed by a flag: use_evars_pattern_unification *) 5c- Pattern-unification of pre-existing evars in goal Goal exists f, forall x y, plus x y = 0 -> f y x = 0. eexists. intros x y H; rewrite H. (* 0 = 0 *) Abort. (* This worked in 8.2 and 8.3 but was removed for autorewrite in 8.4 *) 5d- Mixing pattern-unification of pre-existing evars in goal and evars in lemma Goal exists f, forall x, (forall y, plus x y = 0) -> forall y:nat, f y x = 0. eexists. intros x H y. rewrite H. (* 0 = 0 *) Abort. (* This worked in 8.2 and 8.3 but was removed for autorewrite in 8.4 *) 6- Multiple non-identical but convertible occurrences Tactic rewrite only considers the first one, from left-to-right, e.g.: Section A6. Variable y: nat. Hypothesis H: forall x, x+2 = 0. Goal (y+(2+0))+(y+(1+1)) = (y+(1+1))+(y+(2+0)). rewrite H. (* 0+(y+(1+1)) = y+(1+1)+0 *) Abort. End A6. Tactic setoid rewrite first looks for syntactically equal terms and if not uses the leftmost occurrence modulo delta. Require Import Setoid. Section A6. Variable y: nat. Hypothesis H: forall x, x+2 = 0. Goal (y+(2+0))+(y+2) = (y+2)+(y+(2+0)). rewrite H at 1 2 3 4. (* (y+(2+0))+0 = 0+(y+(2+0)) *) Abort. Goal (y+(2+0))+(y+(1+1)) = (y+(1+1))+(y+(2+0)). rewrite H at 1 2 3 4. (* 0+(y+(1+1)) = y+(1+1)+0 *) Abort. End A6. 7- Conversion Section A6. Variable y: nat. Hypothesis H: forall x, S x = 0. Goal id 1 = 0. rewrite H. B- ELIMINATION (INDUCTION / CASE ANALYSIS) This is simpler because open terms are not allowed and no unification is involved (8.3). coq-8.20.0/dev/doc/universes.md000066400000000000000000000245541466560755400163070ustar00rootroot00000000000000Notes on universe polymorphism ------------------------------ The implementation of universe polymorphism introduces a few changes to the API of Coq. First and foremost, the term language changes, as global references now carry a universe level substitution: ~~~ocaml type 'a puniverses = 'a * UVars.Instance.t type pconstant = constant puniverses type pinductive = inductive puniverses type pconstructor = constructor puniverses type constr = ... | Const of puniverses | Ind of pinductive | Constr of pconstructor ~~~ Universes --------- Universe instances (an array of levels) gets substituted when unfolding definitions, are used to typecheck and are unified according to the rules in the ITP'14 paper on universe polymorphism in Coq. ~~~ocaml type Level.t = Set | Prop | Level of int * dirpath (* hashconsed *) type Instance.t = Level.t array type Universe.t = Level.t list (* hashconsed *) ~~~ The universe module defines modules and abstract types for levels, universes etc.. Structures are hashconsed (with a hack to take care of the fact that deserialization breaks sharing). Definitions (constants, inductives) now carry around not only constraints but also the universes they introduced (a UVars.UContext.t). There is another kind of contexts `Univ.ContextSet.t`, the latter has a set of universes, while the former has serialized the levels in an array, and is used for polymorphic objects. Both have "reified" constraints depending on global and local universes. A polymorphic definition is abstract w.r.t. the variables in this context, while a monomorphic one (or template polymorphic) just adds the universes and constraints to the global universe context when it is put in the environment. No other universes than the global ones and the declared local ones are needed to check a declaration, hence the kernel does not produce any constraints anymore, apart from module subtyping.... There are hence two conversion functions now: `check_conv` and `infer_conv`: the former just checks the definition in the current env (in which we usually push_universe_context of the associated context), and `infer_conv` which produces constraints that were not implied by the ambient constraints. Ideally, that one could be put out of the kernel, but currently module subtyping needs it. Inference of universes is now done during refinement, and the evar_map carries the incrementally built universe context, starting from the global universe constraints (see `Evd.from_env`). `Evd.conversion` is a wrapper around `infer_conv` that will do the bookkeeping for you, it uses `evar_conv_x`. There is a universe substitution being built incrementally according to the constraints, so one should normalize at the end of a proof (or during a proof) with that substitution just like we normalize evars. There are some nf_* functions in library/universes.ml to do that. Additionally, there is a minimization algorithm in there that can be applied at the end of a proof to simplify the universe constraints used in the term. It is heuristic but validity-preserving. No user-introduced universe (i.e. coming from a user-written anonymous Type) gets touched by this, only the fresh universes generated for each global application. Using ~~~ocaml val pf_constr_of_global : Globnames.global_reference -> (constr -> tactic) -> tactic ~~~ Is the way to make a constr out of a global reference in the new API. If they constr is polymorphic, it will add the necessary constraints to the evar_map. Even if a constr is not polymorphic, we have to take care of keeping track of its universes. Typically, using: ~~~ocaml mkApp (coq_id_function, [| A; a |]) ~~~ and putting it in a proof term is not enough now. One has to somehow show that A's type is in cumululativity relation with id's type argument, incurring a universe constraint. To do this, one can simply call Typing.resolve_evars env evdref c which will do some infer_conv to produce the right constraints and put them in the evar_map. Of course in some cases you might know from an invariant that no new constraint would be produced and get rid of it. Anyway the kernel will tell you if you forgot some. As a temporary way out, `Universes.constr_of_global` allows you to make a constr from any non-polymorphic constant, but it will fail on polymorphic ones. Other than that, unification (w_unify and evarconv) now take account of universes and produce only well-typed evar_maps. Some syntactic comparisons like the one used in `change` have to be adapted to allow identification up-to-universes (when dealing with polymorphic references), `make_eq_univs_test` is there to help. In constr, there are actually many new comparison functions to deal with that: ~~~ocaml (** [equal a b] is true if [a] equals [b] modulo alpha, casts, and application grouping *) val equal : constr -> constr -> bool (** [eq_constr_univs u a b] is [true] if [a] equals [b] modulo alpha, casts, application grouping and the universe equalities in [u]. *) val eq_constr_univs : constr Univ.check_function (** [leq_constr_univs u a b] is [true] if [a] is convertible to [b] modulo alpha, casts, application grouping and the universe inequalities in [u]. *) val leq_constr_univs : constr Univ.check_function (** [eq_constr_universes a b] [true, c] if [a] equals [b] modulo alpha, casts, application grouping and the universe equalities in [c]. *) val eq_constr_universes : constr -> constr -> bool Univ.universe_constrained (** [leq_constr_universes a b] [true, c] if [a] is convertible to [b] modulo alpha, casts, application grouping and the universe inequalities in [c]. *) val leq_constr_universes : constr -> constr -> bool Univ.universe_constrained (** [eq_constr_univs a b] [true, c] if [a] equals [b] modulo alpha, casts, application grouping and ignoring universe instances. *) val eq_constr_nounivs : constr -> constr -> bool ~~~ The `_univs` versions are doing checking of universe constraints according to a graph, while the `_universes` are producing (non-atomic) universe constraints. The non-atomic universe constraints include the `ULub` constructor: when comparing `f (* u1 u2 *) c` and `f (* u1' u2' *) c` we add ULub constraints on `u1, u1'` and `u2, u2'`. These are treated specially: as unfolding `f` might not result in these unifications, we need to keep track of the fact that failure to satisfy them does not mean that the term are actually equal. This is used in unification but probably not necessary to the average programmer. Another issue for ML programmers is that tables of constrs now usually need to take a `constr Univ.in_universe_context_set` instead, and properly refresh the universes context when using the constr, e.g. using Clenv.refresh_undefined_univs clenv or: ~~~ocaml (** Get fresh variables for the universe context. Useful to make tactics that manipulate constrs in universe contexts polymorphic. *) val fresh_universe_context_set_instance : universe_context_set -> universe_level_subst * universe_context_set ~~~ The substitution should be applied to the constr(s) under consideration, and the context_set merged with the current evar_map with: ~~~ocaml val merge_context_set : rigid -> evar_map -> Univ.universe_context_set -> evar_map ~~~ The `rigid` flag here should be `Evd.univ_flexible` most of the time. This means the universe levels of polymorphic objects in the constr might get instantiated instead of generating equality constraints (Evd.univ_rigid does that). On this issue, I recommend forcing commands to take `global_reference`s only. Users can declare their specialized terms used as hints as constants and this is cleaner. Alas, backward-compatibility-wise, this is the only solution I found. In the case of global_references only, it's just a matter of using `Evd.fresh_global` / `pf_constr_of_global` to let the system take care of universes. The universe graph ------------------ To accommodate universe polymorphic definitions, the graph structure in kernel/univ.ml was modified. The new API forces every universe to be declared before it is mentioned in any constraint. This forces to declare every universe to be >= Set or > Set. Every universe variable introduced during elaboration is >= Set. Every _global_ universe is now declared explicitly > Set, _after_ typechecking the definition. In polymorphic definitions Type@{i} ranges over Set and any other universe j. However, at instantiation time for polymorphic references, one can try to instantiate a universe parameter with Prop as well, if the instantiated constraints allow it. The graph invariants ensure that no universe i can be set lower than Set, so the chain of universes always bottoms down at Prop < Set. Modules ------- One has to think of universes in modules as being globally declared, so when including a module (type) which declares a type i (e.g. through a parameter), we get back a copy of i and not some fresh universe. Incompatibilities ----------------- Old-style universe polymorphic definitions were implemented by taking advantage of the fact that elaboration (i.e., pretyping and unification) were _not_ universe aware, so some of the constraints generated during pretypechecking would be forgotten. In the current setting, this is not possible, as unification ensures that the substitution is built is entirely well-typed, even w.r.t universes. This means that some terms that type-checked before no longer do, especially projections of the pair: ~~~coq @fst ?x ?y : prod ?x ?y : Type (max(Datatypes.i, Datatypes.j)). ~~~ The "template universe polymorphic" variables i and j appear during typing without being refreshed, meaning that they can be lowered (have upper constraints) with user-introduced universes. In most cases this won't work, so ?x and ?y have to be instantiated earlier, either from the type of the actual projected pair term (some t : prod A B) or the typing constraint. Adding the correct type annotations will always fix this. Unification semantics --------------------- In Ltac, matching with: - a universe polymorphic constant `c` matches any instance of the constant. - a variable ?x already bound to a term `t` (non-linear pattern) uses strict equality of universes (e.g., Type@{i} and Type@{j} are not equal). In tactics: - `change foo with bar`, `pattern foo` will unify all instances of `foo` (and convert them with `bar`). This might incur unifications of universes. `change` uses conversion while `pattern` only does syntactic matching up-to unification of universes. - `apply`, `refine` use unification up to universes. coq-8.20.0/dev/doc/xml-protocol.md000066400000000000000000000735761466560755400167330ustar00rootroot00000000000000# Coq XML Protocol This document is based on documentation originally written by CJ Bell for his [vscoq](https://github.com/coq-community/vscoq/) project. Here, the aim is to provide a "hands on" description of the XML protocol that coqtop and IDEs use to communicate. The protocol first appeared with Coq 8.5, and is used by CoqIDE, [vscoq](https://github.com/coq-community/vscoq/), and other user interfaces. A somewhat out-of-date description of the async state machine is [documented here](https://github.com/ejgallego/jscoq/blob/v8.16/etc/notes/coq-notes.md). OCaml types for the protocol can be found in the [`ide/protocol/interface.ml` file](/ide/protocol/interface.ml). Changes to the XML protocol are documented as part of [`dev/doc/changes.md`](/dev/doc/changes.md). * [Commands](#commands) - [About](#command-about) - [Add](#command-add) - [EditAt](#command-editAt) - [Init](#command-init) - [Goal](#command-goal) - [Subgoals](#command-subgoals) - [Status](#command-status) - [Query](#command-query) - [Evars](#command-evars) - [Hints](#command-hints) - [Search](#command-search) - [GetOptions](#command-getoptions) - [SetOptions](#command-setoptions) - [MkCases](#command-mkcases) - [StopWorker](#command-stopworker) - [PrintAst](#command-printast) - [Annotate](#command-annotate) - [Db_cmd](#command-db_cmd) - [Db_upd_bpts](#command-db_upd_bpts) - [Db_continue](#command-db_continue) - [Db_stack](#command-db_stack) - [Db_vars](#command-db_vars) * [Feedback messages](#feedback) - [Added Axiom](#feedback-addedaxiom) - [Processing](#feedback-processing) - [Processed](#feedback-processed) - [Incomplete](#feedback-incomplete) - [Complete](#feedback-complete) - [GlobRef](#feedback-globref) - [Error](#feedback-error) - [InProgress](#feedback-inprogress) - [WorkerStatus](#feedback-workerstatus) - [File Dependencies](#feedback-filedependencies) - [File Loaded](#feedback-fileloaded) - [Message](#feedback-message) - [Custom](#feedback-custom) * [Ltac-debug messages](ltac_debug) * [Highlighting Text](#highlighting) Sentences: each command sent to Coqtop is a "sentence"; they are typically terminated by ".\s" (followed by whitespace or EOF). Examples: "Lemma a: True.", "(* asdf *) Qed.", "auto; reflexivity." In practice, the command sentences sent to Coqtop are terminated at the "." and start with any previous whitespace. Each sentence is assigned a unique stateId after being sent to Coq (via Add). States: * Processing: has been received by Coq and has no obvious syntax error (that would prevent future parsing) * Processed: * InProgress: * Incomplete: the validity of the sentence cannot be checked due to a prior error * Complete: * Error: the sentence has an error State ID 0 is reserved as a 'dummy' state. -------------------------- ## Commands ### **About(unit)** Returns information about the protocol and build dates for Coqtop. ``` ``` #### *Returns* ```html 8.6 20150913 December 2016 Dec 23 2016 16:16:30 ``` The string fields are the Coq version, the protocol version, the release date, and the compile time of Coqtop. The protocol version is a date in YYYYMMDD format, where "20150913" corresponds to Coq 8.6. An IDE that wishes to support multiple Coq versions can use the protocol version information to know how to handle output from Coqtop. ### **Add(command: string, editId: integer, stateId: integer, verbose: boolean, bp: integer, line_nb: integer, bol_pos: integer)** Adds a toplevel command (e.g. vernacular, definition, tactic) to the given state. `verbose` controls whether out-of-band messages will be generated for the added command (e.g. "foo is assumed" in response to adding "Axiom foo: nat."). `bp`, `line_nb` and `bol_pos` are the `Loc.t` values relative to the IDE buffer. ```html ${command} ${editId} ${bp} ${line_nb} ${bol_pos} ``` #### *Returns* * The added command is given a fresh `stateId` and becomes the next "tip". ```html ``` * When closing a focused proof (in the middle of a bunch of interpreted commands), the `Qed` will be assigned a prior `stateId` and `nextStateId` will be the id of an already-interpreted state that should become the next tip. ```html ${message} ``` * Failure: - Syntax error. Error offsets are byte offsets (not character offsets) with respect to the start of the sentence, starting at 0. ```html ${errorMessage} ``` - Another kind of error, for example, Qed with a pending goal. ```html ${errorMessage} ``` Note that IDEs may need to convert byte offsets passed in the four position fields of the location to character offsets to correctly handle multi-byte characters. Also, due to asynchronous evaluation, line number fields of locations may need to be adjusted if the sentence has moved since it was sent to Coqtop. ------------------------------- ### **EditAt(stateId: integer)** Moves current tip to `${stateId}`, such that commands may be added to the new state ID. ```html ``` #### *Returns* * Simple backtrack; focused stateId becomes the parent state ```html ``` * New focus; focusedQedStateId is the closing Qed of the new focus; sentences between the two should be cleared ```html ``` * Failure: If `stateId` is in an error-state and cannot be jumped to, `errorFreeStateId` is the parent state of `stateId` that should be edited instead. ```html ${errorMessage} ``` ------------------------------- ### **Init()** * No options. ```html ``` * With options: ```html ``` Providing the script file `$v_file.v` enables Coq to use the `.$v_file.aux` file created during compilation. Those file contain timing information that allow Coq to choose smartly between asynchronous and synchronous processing of proofs. #### *Returns* * The initial stateId (not associated with a sentence) ```html ``` ------------------------------- ### **Goal()** ```html ``` #### *Returns* * If there is a goal. `shelvedGoals` and `abandonedGoals` have the same structure as the first set of (current/foreground) goals. `backgroundGoals` contains a list of pairs of lists of goals (list ((list Goal)*(list Goal))); it represents a "focus stack" ([see code for reference](https://github.com/coq/coq/blob/trunk/engine/proofview.ml#L113)). Each time a proof is focused, it will add a new pair of lists-of-goals. The first pair is the most nested set of background goals, the last pair is the top level set of background goals. The first list in the pair is in reverse order. Each time you focus the goal (e.g. using `Focus` or a bullet), a new pair will be prefixed to the list. ```html ``` For example, this script: ```coq Goal P -> (1=1/\2=2) /\ (3=3 /\ (4=4 /\ 5=5) /\ 6=6) /\ 7=7. intros. split; split. (* current visible goals are [1=1, 2=2, 3=3/\(4=4/\5=5)/\6=6, 7=7] *) Focus 3. (* focus on 3=3/\(4=4/\5=5)/\6=6; bg-before: [1=1, 2=2], bg-after: [7=7] *) split; [ | split ]. (* current visible goals are [3=3, 4=4/\5=5, 6=6] *) Focus 2. (* focus on 4=4/\5=5; bg-before: [3=3], bg-after: [6=6] *) * (* focus again on 4=4/\5=5; bg-before: [], bg-after: [] *) split. (* current visible goals are [4=4,5=5] *) ``` should generate the following goals structure: ``` goals: [ P|-4=4, P|-5=5 ] background: [ ( [], [] ), (* bullet with one goal has no before or after background goals *) ( [ P|-3=3 ], [ P|-6=6 ] ), (* Focus 2 *) ( [ P|-2=2, P|-1=1 ], [ P|-7=7 ] ) (* Focus 3; notice that 1=1 and 2=2 are reversed *) ] ``` Pseudocode for listing all of the goals in order: `rev (flat_map fst background) ++ goals ++ flat_map snd background`. * No goal: ```html ``` ------------------------------- ### **Subgoals(flags: goal_flags)** Similar to [Goal](#command-goal), but with `flags` to control whether to include information about `fg`, `bg`, `shelved`, or `given_up` goals. The flags also include `mode`, which is either "full" (return hypotheses and conclusion for each goal) or "short" (return only the conclusion). The "short" mode is useful for speeding up goal display when there are many shelved or admitted goals with large proof contexts, but the IDE only needs to know their conclusions or how many there are. ```html ${mode} ``` #### Returns * The same as [Goal](#command-goal). ------------------------------- ### **Status(force: bool)** Returns information about the current proofs. CoqIDE typically sends this message with `force = false` after each sentence, and with `force = true` if the user wants to force the checking of all proofs (wheels button). In terms of the STM API, `force` triggers a `Join`. ```html ``` #### *Returns* * ```html ${path} ${proofName} ${allProofs} ${proofNumber} ``` ------------------------------- ### **Query(route_id: integer, query: string, stateId: integer)** `routeId` can be used to distinguish the result of a particular query, `stateId` should be set to the state the query should be run. ```html ${query} ``` #### *Returns* * ```html ${message} ``` Before 8.8, `Query` only executed the first command present in the `query` string; starting with 8.8, the caller may include several statements. This is useful for instance for temporarily setting an option and then executing a command. ------------------------------- ### **Evars()** ```html ``` #### *Returns* * ```html ``` ------------------------------- ### **Hints()** ```html ``` #### *Returns* * ```html ``` ------------------------------- ### **Search([(constraintTypeN: string, constraintValueN: string, positiveConstraintN: boolean)])** Searches for objects that satisfy a list of constraints. If `${positiveConstraint}` is `false`, then the constraint is inverted. ```html ${constraintValue1} ... bool_rect ``` #### *Returns* * ```html ${metaInfo} ... ${name} ${definition} ... ``` ##### Types of constraints: * Name pattern: `${constraintType} = "name_pattern"`; `${constraintValue}` is a regular expression string. * Type pattern: `${constraintType} = "type_pattern"`; `${constraintValue}` is a pattern (???: an open gallina term) string. * SubType pattern: `${constraintType} = "subtype_pattern"`; `${constraintValue}` is a pattern (???: an open gallina term) string. * In module: `${constraintType} = "in_module"`; `${constraintValue}` is a list of strings specifying the module/directory structure. * Include blacklist: `${constraintType} = "include_blacklist"`; `${constraintValue}` *is omitted*. ------------------------------- ### **GetOptions()** ```html ``` #### *Returns* * ```html ${string1}... ${sync} ${deprecated} ${name} ${option_value} ... ``` ------------------------------- ### **SetOptions(options)** Sends a list of option settings, where each setting roughly looks like: `([optionNamePart1, ..., optionNamePartN], value)`. ```html optionNamePart1 ... optionNamePartN ... Printing Width ``` CoqIDE sends the following settings (defaults in parentheses): ``` Printing Width : (60), Printing Coercions : (), Printing Matching : (...true...) Printing Notations : (...true...) Printing Existential Instances : (...false...) Printing Implicit : (...false...) Printing All : (...false...) Printing Universes : (...false...) ``` #### *Returns* * ```html ``` ------------------------------- ### **MkCases(...)** ```html ... ``` #### *Returns* * ```html ${string1}... ... ``` ------------------------------- ### **StopWorker(worker: string)** ```html ${worker} ``` #### *Returns* * ```html ``` ------------------------------- ### **PrintAst(stateId: integer)** ```html ``` #### *Returns* * ```html ... ${token} ... ... ... ``` ------------------------------- ### **Annotate(annotation: string)** ```html ${annotation} ``` #### *Returns* * take `Theorem plus_0_r : forall n : nat, n + 0 = n.` as an example. ```html Theorem  plus_0_r :  forall  n :  nat ,  n  +   0  =   n . ``` ------------------------------- ### **Db_cmd(user_input: string)** ```html ${user_input} ``` #### *Returns* * `h` directs Coq to process the debugger command "h". It returns unit. This call is processed only when the debugger is stopped and has just sent a `prompt` message. ------------------------------- ### **Db_upd_bpts(...)** The call passes a list of breakpoints to set or clear. The string is the absolute pathname of the .v file (or "ToplevelInput"), the int is the byte offset within the file and the boolean is true to set a breakpoint and false to clear it. Breakpoints can be updated when Coq is not busy or when Coq is stopped in the debugger. If this message is sent in other states, it will be received and processed when Coq is no longer busy or execution stops in the debugger. ```html /home/proj/coq/ide/coqide/debug.v 22 ``` #### *Returns* * Unit. ------------------------------- ### **Db_continue(option: integer)** Tells Coq to continue processing the proof when it is stopped in the debugger. The integer indicates when the debugger should stop again: ``` 0: StepIn - step one tactic. If it is an Ltac tactic, stop at the first tactic within it 1: StepOver - step over one tactic. if it is an Ltac tactic, don't stop within it 2: StepOut - stop on the first tactic after exiting the current Ltac tactic 3: Continue - continue running until the next breakpoint or the debugger exits 4: Interrupt - generate a User interrupt (for use when stopped in the debugger; otherwise interrupt is sent as a signal) ``` If the debugger encounters a breakpoint during a StepOver or a StepOut, it will stop at the breakpoint. ```html 1 ``` #### *Returns* * Unit. ### **Db_stack()** Returns the Ltac call stack. Each entry has a description of what was called (e.g. the tactic name) plus the absolute pathname of the file and the offset of the call therein. The top of stack is the first entry in the list. Offsets are in bytes, not counts of unicode characters. ```html ``` #### *Returns* ```html vars2.z : ``` ### **Db_vars(frame: integer)** Returns a list of the names and values of the local variables defined in the specified frame of the Ltac call stack. (0 = top of stack, 1, 2, ...). ```html 0 ``` #### *Returns* ```html w 0 : ``` ------------------------------- ## Feedback messages Feedback messages are issued out-of-band, giving updates on the current state of sentences/stateIds, worker-thread status, etc. In the descriptions of feedback syntax below, wherever a `state_id` tag may occur, there may instead be an `edit_id` tag. * Added Axiom: in response to `Axiom`, `admit`, `Admitted`, etc. ```html ``` * Processing ```html ${workerName} ``` * Processed ```html ``` * Incomplete ```html ``` * Complete * GlobRef * Error. Issued, for example, when a processed tactic has failed or is unknown. The error offsets may both be 0 if there is no particular syntax involved. * InProgress ```html 1 ``` * WorkerStatus Ex: `workername = "proofworker:0"` Ex: `status = "Idle"` or `status = "proof: myLemmaName"` or `status = "Dead"` ```html ${workerName} ${status} ``` * File Dependencies. Typically in response to a `Require`. Dependencies are *.vo files. - State `stateId` directly depends on `dependency`: ```html ``` - State `stateId` depends on `dependency` via dependency `sourceDependency` ```xml ${dependency} ``` * File Loaded. For state `stateId`, module `module` is being loaded from `voFileName` ```xml ${module} ${voFileName`} ``` * Message. `level` is one of `{info,warning,notice,error,debug}`. For example, in response to an add `"Axiom foo: nat."` with `verbose=true`, message `foo is assumed` will be emitted in response. ```xml ${message} ``` * Location, a Coq location (`Loc.t`) ```xml Custom. A feedback message that Coq plugins can use to return structured results, including results from Ltac profiling. `customTag` is intended as a unique string that identifies what kind of payload is contained in `customXML`. An optional location may be attached if present in the message. ```xml ${customTag} ${customXML} ``` ------------------------------- ## Ltac-debug messages Ltac-debug messages are issued out-of-band, similar to Feedback messages. The response contains an identifying tag and a ``. Currently these tags are used: * **output** - ordinary output for display in the Messages panel * **goal** - the current goal for the debugger, for display in the Messages panel or elsewhere * **prompt** - output for display in the Messages panel prompting the user to enter a debug command, allowing CoqIDE to display it without appending a newline. It also signals that coqidetop is waiting to receive a debugger-specific message such as [Db_cmd](#command-db_cmd). ```xml prompt : ``` ------------------------------- ## Highlighting Text [Proof diffs](https://coq.inria.fr/distrib/current/refman/proof-engine/proof-handling.html#showing-differences-between-proof-steps) highlight differences between the current and previous proof states in the displayed output. These are represented by tags embedded in output fields of the XML document. There are 4 tags that indicate how the enclosed text should be highlighted: - diff.added - added text - diff.removed - removed text - diff.added.bg - unchanged text in a line that has additions ("bg" for "background") - diff.removed.bg - unchanged text in a line that has removals CoqIDE, Proof General and coqtop currently use 2 shades of green and 2 shades of red as the background color for highlights. Coqtop and CoqIDE also apply underlining and/or strikeout highlighting for the sake of the color blind. For example, `ABC` indicates that "ABC" should be highlighted as added text. Tags can be nested, such as: `A + 1 + B`. IDE code displaying highlighted strings should maintain a stack for nested tags and the associated highlight. Currently the diff code only nests at most 2 tags deep. If an IDE uses other highlights such as text foreground color or italic text, it may need to merge the background color with those other highlights to give the desired (IDE dependent) behavior. The current implementations avoid highlighting white space at the beginning or the end of a line. This gives a better appearance. There may be additional text that is marked with other tags in the output text. IDEs probably should ignore and not display tags they don't recognize. Some internal details about generating tags within Coq (e.g. if you want to add additional tags): Tagged output strings are generated from Pp.t's. Use Pp.tag to highlight a Pp.t using one of the tags listed above. A span of tokens can be marked by using "start." on the first token and "end." on the last token. (Span markers are needed because a span of tokens in the output may not match nesting of layout boxes in the Pp.t.) The conversion from the Pp.t to the XML-tagged string replaces the "start.\*" and "end.\*" tags with the basic tags. coq-8.20.0/dev/dune000066400000000000000000000045001466560755400140400ustar00rootroot00000000000000(library (name dev) (public_name coq-core.dev) (synopsis "Coq's Debug Printers") (wrapped false) (modules top_printers vm_printers) (libraries coq-core.toplevel coq-core.plugins.ltac)) (library (name debugger_support) (public_name coq-core.debugger_support) (synopsis "Coq Support for ocamldebug") (wrapped false) (modules debugger_support) (libraries coq-core.dev)) (rule (targets dune-dbg) (deps dune-dbg.in ../checker/coqchk.bc ../topbin/coqc_byte_bin.bc ../topbin/coqnative_bin.bc ../ide/coqide/coqide_main.bc ../tools/coqdep/coqdep.bc ; We require all the OCaml libs to be in place and searchable ; by OCamlfind, this is a bit of a hack but until Dune gets ; proper ocamldebug support we have to live with that. %{lib:coq-core.config:config.cma} %{lib:coq-core.clib:clib.cma} %{lib:coq-core.lib:lib.cma} %{lib:coq-core.kernel:kernel.cma} %{lib:coq-core.vm:coqrun.cma} %{lib:coq-core.vm:../../stublibs/dllcoqrun_stubs.so} %{lib:coq-core.library:library.cma} %{lib:coq-core.engine:engine.cma} %{lib:coq-core.pretyping:pretyping.cma} %{lib:coq-core.gramlib:gramlib.cma} %{lib:coq-core.interp:interp.cma} %{lib:coq-core.proofs:proofs.cma} %{lib:coq-core.parsing:parsing.cma} %{lib:coq-core.printing:printing.cma} %{lib:coq-core.tactics:tactics.cma} %{lib:coq-core.vernac:vernac.cma} %{lib:coq-core.stm:stm.cma} %{lib:coq-core.sysinit:sysinit.cma} %{lib:coq-core.toplevel:toplevel.cma} %{lib:coq-core.plugins.ltac:ltac_plugin.cma} %{lib:coq-core.dev:dev.cma} %{lib:coq-core.debugger_support:debugger_support.cmi} %{lib:coq-core.debugger_support:debugger_support.cma} %{lib:coq-core.debugger_support:../META}) (action (copy dune-dbg.in dune-dbg))) (alias (name ml_toplevel_files) (deps (glob_files ml_toplevel/**))) (install (section lib) (package coq-core) (files (ml_toplevel/include as dev/ml_toplevel/include) (ml_toplevel/include_directories as dev/ml_toplevel/include_directories) (ml_toplevel/include_printers as dev/ml_toplevel/include_printers) (ml_toplevel/include_utilities as dev/ml_toplevel/include_utilities))) ; TODO: the above can be written as follow: ; (files (glob_files (ml_toplevel/** with_prefix dev))) ; , but this is only possible with dune language 3.11 or later coq-8.20.0/dev/dune-dbg.in000077500000000000000000000024611466560755400152060ustar00rootroot00000000000000#!/usr/bin/env bash # Run in a proper install dune env. opts=() while [[ $# -gt 0 ]]; do case $1 in -emacs) shift opts+=("-emacs") ;; coqchk) shift exe=_build/default/checker/coqchk.bc opts+=($(ocamlfind query -recursive -i-format coq-core.checklib)) break ;; coqide) shift exe=_build/default/ide/coqide/coqide_main.bc break ;; coqc) shift exe=_build/default/topbin/coqc_byte_bin.bc break ;; coqtop) shift exe=_build/default/topbin/coqtop_byte_bin.bc break ;; coqdep) shift exe=_build/default/tools/coqdep/coqdep.bc break ;; coqnative) shift exe=_build/default/topbin/coqnative_bin.bc break ;; *) echo "usage: dune exec -- dev/dune-dbg [-emacs] {coqchk|coqide|coqc|coqtop|coqdep|coqnative} coqargs" exit 1 ;; esac done ocamldebug "${opts[@]}" $(ocamlfind query -recursive -i-format coq-core.dev) $(ocamlfind query -i-format -descendants coq-core.vernac) -I +threads -I dev $exe "$@" coq-8.20.0/dev/dune-workspace.all000066400000000000000000000003371466560755400166070ustar00rootroot00000000000000(lang dune 2.0) ; Add custom flags here. Default developer profile is `dev` (context (opam (switch 4.09.0))) (context (opam (switch 4.09.0+32bit))) (context (opam (switch 4.12.0))) (context (opam (switch 4.12.0+flambda))) coq-8.20.0/dev/dynlink.ml000066400000000000000000000033141466560755400151660ustar00rootroot00000000000000 (** Some architectures may have a native ocaml compiler but no native dynlink.cmxa (e.g. ARM). If you still want to build a native coqtop there, you'll need this dummy implementation of Dynlink. Compile it and install with: ocamlopt -a -o dynlink.cmxa dynlink.ml sudo cp -i dynlink.cmxa `ocamlopt -where` Then build coq this way: ./configure -natdynlink no && make world *) let is_native = true (* This file will only be given to the native compiler *) type linking_error = | Undefined_global of string | Unavailable_primitive of string | Uninitialized_global of string type error = | Not_a_bytecode_file of string | Inconsistent_import of string | Unavailable_unit of string | Unsafe_file | Linking_error of string * linking_error | Corrupted_interface of string | File_not_found of string | Cannot_open_dll of string | Inconsistent_implementation of string exception Error of error let error_message = function | Not_a_bytecode_file s -> "Native dynamic link not supported (module "^s^")" | _ -> "Native dynamic link not supported" let loadfile : string -> unit = fun s -> raise (Error (Not_a_bytecode_file s)) let loadfile_private = loadfile let adapt_filename s = s let init () = () let allow_only : string list -> unit = fun _ -> () let prohibit : string list -> unit = fun _ -> () let default_available_units : unit -> unit = fun _ -> () let allow_unsafe_modules : bool -> unit = fun _ -> () let add_interfaces : string list -> string list -> unit = fun _ _ -> () let add_available_units : (string * Digest.t) list -> unit = fun _ -> () let clear_available_units : unit -> unit = fun _ -> () let digest_interface : string -> string list -> Digest.t = fun _ _ -> failwith "digest_interface" coq-8.20.0/dev/header.c000066400000000000000000000012431466560755400145570ustar00rootroot00000000000000/************************************************************************/ /* * The Coq Proof Assistant / The Coq Development Team */ /* v * Copyright INRIA, CNRS and contributors */ /* &2 echo "usage: $CALLNAME " >&2 echo "The order of commits is as given to 'git diff'" } if [ "$#" != 2 ]; then usage exit 1 fi REDBOLD="\033[31;1m" RESET="\033[0m" function redprint { if true || [ "$COQ_CI_COLOR" ]; then printf "$REDBOLD%s$RESET\n" "$1" else printf '%s\n' "$1" fi } BASE_COMMIT="$1" HEAD_COMMIT="$2" tmp=$(mktemp -d) git worktree add "$tmp" "$HEAD_COMMIT" pushd "$tmp" bad_ws=() bad_compile=() while IFS= read -r commit; do echo Checking "$commit" git checkout "$commit" # git diff --check # uses .gitattributes to know what to check if ! git diff --check "${commit}^" "$commit"; then bad_ws+=("$commit") fi if ! make check then bad_compile+=("$commit") fi done < <(git rev-list "$HEAD_COMMIT" --not "$BASE_COMMIT" --) popd git worktree remove "$tmp" # report errors CODE=0 if [ "${#bad_ws[@]}" != 0 ] then >&2 redprint "Whitespace errors!" >&2 echo "In commits ${bad_ws[*]}" >&2 echo "If you use emacs, you can prevent this kind of error from reoccurring by installing ws-butler and enabling ws-butler-convert-leading-tabs-or-spaces." >&2 echo CODE=1 fi if [ "${#bad_compile[@]}" != 0 ] then >&2 redprint "Compilation errors!" >&2 echo "In commits ${bad_compile[*]}" >&2 echo CODE=1 fi exit $CODE coq-8.20.0/dev/lint-repository.sh000077500000000000000000000033041466560755400167050ustar00rootroot00000000000000#!/usr/bin/env bash # A script to check prettyness over the repository. # lint-commits.sh seeks to prevent the worsening of already present # problems, such as tab indentation in ml files. lint-repository.sh # also seeks to prevent the (re-)introduction of solved problems, such # as newlines at the end of .v files. CODE=0 # if COQ_CI_COLOR is set (from the environment) keep it intact (even when it's the empty string)' if ! [ "${COQ_CI_COLOR+1}" ]; then # NB: in CI TERM is unset in the environment # when TERM is unset, bash sets it to "dumb" as a bash variable (not exported?) if { [ -t 1 ] && ! [ "$TERM" = dumb ]; } || [ "$CI" ] then export COQ_CI_COLOR=1 else export COQ_CI_COLOR= fi fi if [[ $(git log -n 1 --pretty='format:%s') == "[CI merge]"* ]]; then # The second parent of bot merges is from the PR, the first is # current master head=$(git rev-parse HEAD^2) else head=$(git rev-parse HEAD) fi # We assume that all non-bot merge commits are from the main branch # For Coq it is extremely rare for this assumption to be broken read -r base < <(git log -n 1 --merges --pretty='format:%H' "$head") dev/lint-commits.sh "$base" "$head" || CODE=1 # Check that the files with 'whitespace' gitattribute end in a newline. # xargs exit status is 123 if any file failed the test echo Checking end of file newlines find . "(" -path ./.git -prune ")" -o -type f -print0 | xargs -0 dev/tools/check-eof-newline.sh || CODE=1 echo Checking overlays dev/tools/check-overlays.sh || CODE=1 echo Checking CACHEKEY dev/tools/check-cachekey.sh || CODE=1 # Check that doc/tools/docgram/fullGrammar is up-to-date echo Checking grammar files make SHOW='@true ""' doc_gram_verify || CODE=1 exit $CODE coq-8.20.0/dev/macosify_accel.sh000077500000000000000000000001641466560755400164640ustar00rootroot00000000000000#!/usr/bin/sed -f s/^;\{0,1\} *\(.*\)\(.*\)$/\1\2/ s/^;\{0,1\} *\(.*\)\(.*\)$/\1\2/ coq-8.20.0/dev/ml_toplevel/000077500000000000000000000000001466560755400155055ustar00rootroot00000000000000coq-8.20.0/dev/ml_toplevel/include000066400000000000000000000013751466560755400170610ustar00rootroot00000000000000(* The main file included in the OCaml toplevel. *) #use "ml_toplevel/include_directories";; #use "ml_toplevel/include_printers";; #use "ml_toplevel/include_utilities";; let go () = Flags.with_option Toploop.may_trace (fun () -> Coqloop.ml_toplevel_state := Some (Coqloop.loop ~state:(Option.get !Coqloop.ml_toplevel_state))) (); print_newline () let () = if not !Coqloop.ml_toplevel_include_ran then Toploop.add_directive "go" (Toploop.Directive_none go) Toploop.{section="Coq"; doc="Run Coq toplevel loop"} let _ = print_newline (); print_endline "OCaml toplevel with Coq printers and utilities (to go back to Coq, use `#quit;;`, or `#go;;` if `#trace` was used)" let _ = Coqloop.ml_toplevel_include_ran := true coq-8.20.0/dev/ml_toplevel/include_directories000066400000000000000000000017421466560755400214530ustar00rootroot00000000000000#directory "+compiler-libs";; #directory "_build/default/lib/.lib.objs/byte/";; #directory "_build/default/clib/.clib.objs/byte/";; #directory "_build/default/kernel/.kernel.objs/byte/";; #directory "_build/default/library/.library.objs/byte/";; #directory "_build/default/engine/.engine.objs/byte/";; #directory "_build/default/pretyping/.pretyping.objs/byte/";; #directory "_build/default/interp/.interp.objs/byte/";; #directory "_build/default/parsing/.parsing.objs/byte/";; #directory "_build/default/gramlib/.gramlib.objs/byte/";; #directory "_build/default/proofs/.proofs.objs/byte/";; #directory "_build/default/tactics/.tactics.objs/byte/";; #directory "_build/default/printing/.printing.objs/byte/";; #directory "_build/default/vernac/.vernac.objs/byte/";; #directory "_build/default/stm/.stm.objs/byte/";; #directory "_build/default/toplevel/.toplevel.objs/byte/";; #directory "_build/default/plugins/ltac/.ltac_plugin.objs/byte/";; #directory "_build/default/dev/.dev.objs/byte/";; coq-8.20.0/dev/ml_toplevel/include_printers000066400000000000000000000113731466560755400210060ustar00rootroot00000000000000#install_printer (* identifier *) Top_printers.ppid;; #install_printer (* identifier *) Top_printers.ppidset;; #install_printer (* Intset.t *) Top_printers.ppintset;; #install_printer (* label *) Top_printers.pplab;; #install_printer (* mod_bound_id *) Top_printers.ppmbid;; #install_printer (* dir_path *) Top_printers.ppdir;; #install_printer (* module_path *) Top_printers.ppmp;; #install_printer (* section_path *) Top_printers.ppsp;; #install_printer (* qualid *) Top_printers.ppqualid;; #install_printer (* kernel_name *) Top_printers.ppkn;; #install_printer (* constant *) Top_printers.ppcon;; #install_printer (* projection *) Top_printers.ppproj;; #install_printer (* projection *) Top_printers.ppprojrepr;; #install_printer (* recarg *) Top_printers.pprecarg;; #install_printer (* recarg Rtree.t *) Top_printers.ppwf_paths;; #install_printer (* constr *) Top_printers.print_pure_constr;; #install_printer (* Idpred.t *) Top_printers.pp_idpred;; #install_printer (* Cpred.t *) Top_printers.pp_cpred;; #install_printer (* loc *) Top_printers.pploc;; #install_printer (* substitution *) Top_printers.ppsubst;; #install_printer (* pp_stdcmds *) Top_printers.pp;; #install_printer (* pattern *) Top_printers.pppattern;; #install_printer (* glob_constr *) Top_printers.ppglob_constr;; #install_printer (* open constr *) Top_printers.ppopenconstr;; #install_printer (* constr *) Top_printers.ppconstr;; #install_printer (* econstr *) Top_printers.ppeconstr;; #install_printer (* constraints *) Top_printers.ppconstraints;; #install_printer (* univ constraints *) Top_printers.ppuniverseconstraints;; #install_printer (* universe *) Top_printers.ppuni;; #install_printer (* universes *) Top_printers.ppuniverses;; #install_printer (* univ level *) Top_printers.ppuni_level;; #install_printer (* sort variable *) Top_printers.ppqvar;; #install_printer (* univ context *) Top_printers.ppuniverse_context;; #install_printer (* univ context *) Top_printers.ppaucontext;; #install_printer (* univ context future *) Top_printers.ppuniverse_context_future;; #install_printer (* univ context set *) Top_printers.ppuniverse_context_set;; #install_printer (* qvar set *) Top_printers.ppqvarset;; #install_printer (* univ set *) Top_printers.ppuniverse_set;; #install_printer (* univ instance *) Top_printers.ppuniverse_instance;; #install_printer (* univ subst *) Top_printers.ppuniverse_subst;; #install_printer (* univ full subst *) Top_printers.ppuniverse_level_subst;; #install_printer Top_printers.ppqvar_subst;; #install_printer (* univ opt subst *) Top_printers.ppuniverse_opt_subst;; #install_printer (* evar univ ctx *) Top_printers.ppevar_universe_context;; #install_printer (* cclosure partial_subst *) Top_printers.pp_partialfsubst;; #install_printer (* reductionops partial_subst *) Top_printers.pp_partialsubst;; #install_printer (* inductive *) Top_printers.ppind;; #install_printer (* 'a scheme_kind *) Top_printers.ppscheme;; #install_printer (* type_judgement *) Top_printers.pptype;; #install_printer (* judgement *) Top_printers.ppj;; #install_printer (* id set *) Top_printers.ppidset;; #install_printer (* int set *) Top_printers.ppintset;; #install_printer (* id set *) Top_printers.ppidmapgen;; #install_printer (* int set *) Top_printers.ppintmapgen;; (* #install_printer (* hint_db *) Top_printers.print_hint_db;; *) (* #install_printer (* hints_path *) Top_printers.pphintspath;; *) #install_printer (* goal *) Top_printers.ppgoal;; #install_printer Top_printers.ppgoal_with_state;; (* #install_printer (* sigma goal *) Top_printers.ppsigmagoal;; *) #install_printer (* proof *) Top_printers.pproof;; #install_printer (* proofview *) Top_printers.ppproofview;; #install_printer (* metaset.t *) Top_printers.ppmetas;; #install_printer (* evar *) Top_printers.ppevar;; #install_printer (* evar_map *) Top_printers.ppevm;; #install_printer (* Evar.Set.t *) Top_printers.ppexistentialset;; #install_printer (* clenv *) Top_printers.ppclenv;; #install_printer (* env *) Top_printers.ppenv;; #install_printer (* Hint_db.t *) Top_printers.pphintdb;; #install_printer (* named_context_val *) Top_printers.ppnamedcontextval;; #install_printer (* tactic *) Top_printers.pptac;; #install_printer (* object *) Top_printers.ppobj;; #install_printer (* global_reference *) Top_printers.ppglobal;; #install_printer (* generic_argument *) Top_printers.pp_generic_argument;; #install_printer (* fconstr *) Top_printers.ppfconstr;; #install_printer (* fsubst *) Top_printers.ppfsubst;; #install_printer (* Future.computation *) Top_printers.ppfuture;; #install_printer (* patch *) Vm_printers.ppripos;; #install_printer (* values *) Vm_printers.ppvalues;; #install_printer Vm_printers.ppzipper;; #install_printer Vm_printers.ppstack;; #install_printer Vm_printers.ppatom;; #install_printer Vm_printers.ppwhd;; #install_printer Vm_printers.ppvblock;; coq-8.20.0/dev/ml_toplevel/include_utilities000066400000000000000000000024271466560755400211530ustar00rootroot00000000000000(* File included to get some Coq facilities under the OCaml toplevel. *) (* parsing of terms *) let parse_constr = Pcoq.parse_string Pcoq.Constr.constr let parse_vernac = Pcoq.parse_string Pvernac.Vernac_.vernac_control let parse_tac = Pcoq.parse_string Ltac_plugin.Pltac.tactic (* build a term of type glob_constr without type-checking or resolution of implicit syntax *) let e s = let env = Global.env () in let sigma = Evd.from_env env in Constrintern.intern_constr env sigma (parse_constr s) (* build a term of type constr with type-checking and resolution of implicit syntax *) let constr_of_string s = let env = Global.env () in let sigma = Evd.from_env env in Constrintern.interp_constr env sigma (parse_constr s) (* get the body of a constant *) let constbody_of_string s = let b = Global.lookup_constant (Nametab.locate_constant (Libnames.qualid_of_string s)) in Option.get (Global.body_of_constant_body Library.indirect_accessor b) (* Get the current goal *) (* let getgoal x = top_goal_of_pftreestate (Pfedit.get_pftreestate x);; let get_nth_goal n = nth_goal_of_pftreestate n (Pfedit.get_pftreestate ());; let current_goal () = get_nth_goal 1;; *) let pf_e gl s = Constrintern.interp_constr (Tacmach.pf_env gl) (Tacmach.project gl) (parse_constr s) coq-8.20.0/dev/nixpkgs.nix000066400000000000000000000003011466560755400153600ustar00rootroot00000000000000import (fetchTarball { url = "https://github.com/NixOS/nixpkgs/archive/1c0bec249943cd3e03f876554b8af7d1e32a09e1.tar.gz"; sha256 = "06wpxiykzrwqsham8v8kzd79nyh0qb707r0svycz32w8j0x6b1mq"; }) coq-8.20.0/dev/ocamldebug-coq.run000066400000000000000000000031641466560755400165770ustar00rootroot00000000000000#!/bin/sh # Wrapper around ocamldebug for Coq # This file is to be launched via the generated script ocamldebug-coq, # which will set the env variables $OCAMLDEBUG, $CAMLP5LIB, $COQTOP # Anyway, just in case someone tries to use this script directly, # here are some reasonable default values [ -z "$OCAMLDEBUG" ] && OCAMLDEBUG=ocamldebug [ -z "$COQTOP" -a -d "$PWD/kernel" ] && COQTOP=$PWD [ -z "$COQTOP" -a -d "$PWD/../kernel" ] && COQTOP=`dirname $PWD` export CAML_LD_LIBRARY_PATH=$COQTOP/kernel/byterun:$CAML_LD_LIBRARY_PATH exec $OCAMLDEBUG \ -I +threads \ -I $COQTOP \ -I $COQTOP/config -I $COQTOP/printing -I $COQTOP/grammar -I $COQTOP/clib \ -I $COQTOP/gramlib/.pack \ -I $COQTOP/lib -I $COQTOP/kernel -I $COQTOP/kernel/byterun \ -I $COQTOP/library -I $COQTOP/engine -I $COQTOP/sysinit \ -I $COQTOP/pretyping -I $COQTOP/parsing -I $COQTOP/vernac \ -I $COQTOP/interp -I $COQTOP/proofs -I $COQTOP/tactics -I $COQTOP/stm \ -I $COQTOP/toplevel -I $COQTOP/dev -I $COQTOP/config -I $COQTOP/ltac \ -I $COQTOP/plugins/cc -I $COQTOP/plugins/dp \ -I $COQTOP/plugins/extraction -I $COQTOP/plugins/field \ -I $COQTOP/plugins/firstorder \ -I $COQTOP/plugins/funind -I $COQTOP/plugins/groebner \ -I $COQTOP/plugins/interface -I $COQTOP/plugins/micromega \ -I $COQTOP/plugins/omega -I $COQTOP/plugins/quote \ -I $COQTOP/plugins/ring \ -I $COQTOP/plugins/rtauto \ -I $COQTOP/plugins/subtac -I $COQTOP/plugins/syntax \ -I $COQTOP/plugins/xml -I $COQTOP/plugins/ltac \ -I $COQTOP/ide \ $(ocamlfind query -recursive -i-format zarith) \ "$@" coq-8.20.0/dev/shim/000077500000000000000000000000001466560755400141235ustar00rootroot00000000000000coq-8.20.0/dev/shim/dune000066400000000000000000000065561466560755400150150ustar00rootroot00000000000000; ; Shims for running coq binaries with minimal dependencies ; ; coqtop (alias (name coqtop-prelude) (deps %{bin:coqtop} ; XXX: bug, we are missing the dep on the _install meta file... %{project_root}/theories/Init/Prelude.vo)) (rule (targets coqtop) (deps (alias coqtop-prelude)) (action (with-stdout-to %{targets} (progn (echo "#!/usr/bin/env bash\n") (bash "echo '\"$(dirname \"$0\")\"/%{bin:coqtop} -I \"$(dirname \"$0\")/%{project_root}/../install/default/lib\" -coqlib \"$(dirname \"$0\")/%{project_root}\" \"$@\"'") (run chmod +x %{targets}))))) ; coqc (alias (name coqc-prelude) (deps %{bin:coqc} %{bin:coqworker.opt} %{project_root}/theories/Init/Prelude.vo)) (rule (targets coqc) (deps (alias coqc-prelude)) (action (with-stdout-to %{targets} (progn (echo "#!/usr/bin/env bash\n") (bash "echo '\"$(dirname \"$0\")\"/%{bin:coqc} -I \"$(dirname \"$0\")/%{project_root}/../install/default/lib\" -coqlib \"$(dirname \"$0\")\"/%{project_root} -nI \"$(dirname \"$0\")\"/%{project_root}/kernel/.kernel.objs/byte \"$@\"'") (run chmod +x %{targets}))))) ; coqtop.byte (alias (name coqtop.byte-prelude) (deps %{project_root}/theories/Init/Prelude.vo %{bin:coqtop.byte} %{lib:coq-core.config:config.cma} %{lib:coq-core.clib:clib.cma} %{lib:coq-core.lib:lib.cma} %{lib:coq-core.kernel:kernel.cma} %{lib:coq-core.vm:coqrun.cma} %{lib:coq-core.vm:../../stublibs/dllcoqrun_stubs.so} %{lib:coq-core.library:library.cma} %{lib:coq-core.engine:engine.cma} %{lib:coq-core.pretyping:pretyping.cma} %{lib:coq-core.gramlib:gramlib.cma} %{lib:coq-core.interp:interp.cma} %{lib:coq-core.proofs:proofs.cma} %{lib:coq-core.parsing:parsing.cma} %{lib:coq-core.printing:printing.cma} %{lib:coq-core.tactics:tactics.cma} %{lib:coq-core.vernac:vernac.cma} %{lib:coq-core.stm:stm.cma} %{lib:coq-core.sysinit:sysinit.cma} %{lib:coq-core.toplevel:toplevel.cma} %{lib:coq-core.plugins.number_string_notation:number_string_notation_plugin.cma} %{lib:coq-core.plugins.tauto:tauto_plugin.cma} %{lib:coq-core.plugins.cc:cc_plugin.cma} %{lib:coq-core.plugins.firstorder:firstorder_plugin.cma} %{lib:coq-core.plugins.ltac:ltac_plugin.cma} (alias %{project_root}/dev/ml_toplevel_files))) (rule (targets coqtop.byte) (deps (alias coqtop.byte-prelude)) (action (with-stdout-to %{targets} (progn (echo "#!/usr/bin/env bash\n") (bash "echo '\"$(dirname \"$0\")\"/%{bin:coqtop.byte} -I \"$(dirname \"$0\")/%{project_root}/../install/default/lib\" -coqlib \"$(dirname \"$0\")\"/%{project_root} \"$@\"'") (run chmod +x %{targets}))))) ; coqide (alias (name coqide-prelude) (deps ; without this if the gtk libs are not available dune can try to use ; coqide from PATH instead of giving a nice error ; there is no problem with the other shims since they don't depend on optional build products %{project_root}/ide/coqide/coqide_main.exe %{bin:coqworker.opt} %{project_root}/theories/Init/Prelude.vo %{project_root}/coqide-server.install %{project_root}/coqide.install)) (rule (targets coqide) (deps (alias coqide-prelude)) (action (with-stdout-to %{targets} (progn (echo "#!/usr/bin/env bash\n") (bash "echo '\"$(dirname \"$0\")\"/%{bin:coqide} -I \"$(dirname \"$0\")/%{project_root}/../install/default/lib\" -coqlib \"$(dirname \"$0\")\"/%{project_root} \"$@\"'") (run chmod +x %{targets}))))) coq-8.20.0/dev/tools/000077500000000000000000000000001466560755400143235ustar00rootroot00000000000000coq-8.20.0/dev/tools/backport-pr.sh000077500000000000000000000066011466560755400171110ustar00rootroot00000000000000#!/usr/bin/env bash set -e if [[ $# == 0 ]]; then echo "Usage: $0 [--no-conflict] [--no-signature-check] [--stop-before-merging] prnum" exit 1 fi while [[ $# -gt 0 ]]; do case "$1" in --no-conflict) NO_CONFLICTS="true" shift ;; --no-signature-check) NO_SIGNATURE_CHECK="true" shift ;; --stop-before-merging) STOP_BEFORE_MERGING="true" shift ;; *) if [[ "$PRNUM" != "" ]]; then echo "PRNUM was already set to $PRNUM and is now being overridden with $1." fi PRNUM="$1" shift esac done REMOTE=$(git config --get "branch.master.remote" || true) if [ -z "$REMOTE" ]; then echo "Branch master has no remote. Using the local state of the master branch instead." MASTER=master else MASTER="$REMOTE/master" fi if ! git log $MASTER --grep "Merge PR #$PRNUM" | grep "." > /dev/null; then echo "PR #${PRNUM} does not exist." exit 1 fi SIGNATURE_STATUS=$(git log $MASTER --grep "Merge PR #$PRNUM" --format="%G?") git log $MASTER --grep "Merge PR #$PRNUM" --format="%GG" if [[ "$NO_SIGNATURE_CHECK" != "true" && "$SIGNATURE_STATUS" != "G" ]]; then echo read -p "Merge commit does not have a good (valid) signature. Bypass? [y/N] " -n 1 -r echo if [[ ! $REPLY =~ ^[Yy]$ ]]; then exit 1 fi fi BRANCH=backport-pr-${PRNUM} RANGE=$(git log $MASTER --grep "Merge PR #$PRNUM" --format="%P" | sed 's/ /../') MESSAGE=$(git log $MASTER --grep "Merge PR #$PRNUM" --format="%s" | sed 's/Merge/Backport/') if [[ "$(git rev-parse --abbrev-ref HEAD)" == "$BRANCH" ]]; then if ! git cherry-pick --continue; then echo "Please fix the conflicts, then relaunch the script." exit 1 fi git checkout - elif git checkout -b "$BRANCH"; then if ! git cherry-pick -x "${RANGE}"; then if [[ "$NO_CONFLICTS" == "true" ]]; then git status echo "Conflicts! Aborting..." git cherry-pick --abort git checkout - git branch -d "$BRANCH" exit 1 fi echo "Please fix the conflicts, then relaunch the script." exit 1 fi git checkout - else echo read -p "Skip directly to merging phase? [y/N] " -n 1 -r echo if [[ ! $REPLY =~ ^[Yy]$ ]]; then exit 1 fi fi if ! git diff --exit-code HEAD "${BRANCH}" -- "*.mli"; then echo read -p "Some mli files are modified. Bypass? [y/N] " -n 1 -r echo if [[ ! $REPLY =~ ^[Yy]$ ]]; then exit 1 fi fi if [[ "$STOP_BEFORE_MERGING" == "true" ]]; then exit 0 fi git merge -S --no-ff "${BRANCH}" -m "${MESSAGE}" git branch -d "${BRANCH}" # To-Do: # - Support for backporting a PR before it is merged # - Automatically backport all PRs in the "Waiting to be backported" column using a command like: # $ curl -s -H "Authorization: token ${GITHUB_TOKEN}" -H "Accept: application/vnd.github.inertia-preview+json" https://api.github.com/projects/columns/1358120/cards | jq -r '.[].content_url' | grep issue | sed 's/^.*issues\/\([0-9]*\)$/\1/' | tac # (The ID of the column must first be obtained through https://api.github.com/repos/coq/coq/projects then https://api.github.com/projects/819866/columns.) # - Then move each of the backported PR to the subsequent columns automatically as well... coq-8.20.0/dev/tools/change-header000077500000000000000000000024531466560755400167300ustar00rootroot00000000000000#!/bin/sh #This script changes the header of .ml* files if [ ! $# = 2 ]; then echo Usage: change-header old-header-file new-header-file exit 1 fi oldheader=$1 newheader=$2 if [ ! -f $oldheader ]; then echo Cannot read file $oldheader; exit 1; fi if [ ! -f $newheader ]; then echo Cannot read file $newheader; exit 1; fi n=$(wc -l $oldheader | sed -e "s/ *\([0-9]*\).*/\1/g") nsucc=$(expr $n + 1) modified=0 kept=0 for i in $(git grep --name-only --fixed-strings "$(head -1 $oldheader)"); do headline=$(head -n 1 $i) if $(echo $headline | grep "(\* -\*- .* \*)" > /dev/null) || $(echo $headline | grep "^#\!" > /dev/null); then # Has header head -n +$nsucc $i | tail -n $n > $i.head.tmp$$ hasheadline=1 nnext=$(expr $nsucc + 1) else head -n +$n $i > $i.head.tmp$$ hasheadline=0 nnext=$nsucc fi if diff -a -q $oldheader $i.head.tmp$$ > /dev/null; then echo "$i: header changed" if [ $hasheadline = 1 ]; then echo $headline > $i.tmp$$ else touch $i.tmp$$ fi cat $newheader >> $i.tmp$$ tail -n +$nnext $i >> $i.tmp$$ mv $i.tmp$$ $i modified=$(expr $modified + 1) else echo "$i: header unchanged" kept=$(expr $kept + 1) fi rm $i.head.tmp$$ done echo $modified files updated echo $kept files unchanged coq-8.20.0/dev/tools/check-cachekey.sh000077500000000000000000000014621466560755400175140ustar00rootroot00000000000000#!/bin/sh REDBOLD="\033[31;1m" RESET="\033[0m" redprint() { if [ "$COQ_CI_COLOR" ]; then printf "$REDBOLD%s$RESET\n" "$1" else printf '%s\n' "$1" fi } base_hash=$(md5sum dev/ci/docker/old_ubuntu_lts/Dockerfile | head -c 10) base_key=$(grep BASE_CACHEKEY: .gitlab-ci.yml) base_keyhash=${base_key%\"} base_keyhash=${base_keyhash##*-} if ! [ "$base_hash" = "$base_keyhash" ]; then >&2 redprint "Bad BASE_CACHEKEY: expected '$base_hash' but got '$base_keyhash'" exit 1 fi edge_hash=$(md5sum dev/ci/docker/edge_ubuntu/Dockerfile | head -c 10) edge_key=$(grep EDGE_CACHEKEY: .gitlab-ci.yml) edge_keyhash=${edge_key%\"} edge_keyhash=${edge_keyhash##*-} if ! [ "$edge_hash" = "$edge_keyhash" ]; then >&2 redprint "Bad EDGE_CACHEKEY: expected '$edge_hash' but got '$edge_keyhash'" exit 1 fi coq-8.20.0/dev/tools/check-eof-newline.sh000077500000000000000000000024351466560755400201510ustar00rootroot00000000000000#!/usr/bin/env bash # Usage: check-eof-newline.sh [--fix] FILES... # Detect missing end of file newlines for FILES. # Files are skipped if untracked by git and depending on gitattributes. # With --fix, automatically append a newline. # Exit status: # Without --fix: 1 if any file had a missing newline, 0 otherwise. # With --fix: 1 if any non writable file had a missing newline, 0 otherwise. FIX= if [ "$1" = --fix ]; then FIX=1 shift fi REDBOLD="\033[31m" YELLOW="\033[33m" RESET="\033[0m" function colorprint { if [ "$COQ_CI_COLOR" ]; then printf "$1%s$RESET\n" "$2" else printf '%s\n' "$2" fi } CODE=0 for f in "$@"; do if git ls-files --error-unmatch "$f" >/dev/null 2>&1 && \ git check-attr whitespace -- "$f" | grep -q -v -e 'unset$' -e 'unspecified$' && \ [ -n "$(tail -c 1 "$f")" ] then if [ -n "$FIX" ]; then if [ -w "$f" ]; then echo >> "$f" colorprint "$YELLOW" "Newline appended to file $f!" else colorprint "$REDBOLD" "File $f is missing a newline and not writable!" CODE=1 fi else colorprint "$REDBOLD" "No newline at end of file $f!" CODE=1 fi fi done exit "$CODE" coq-8.20.0/dev/tools/check-overlays.sh000077500000000000000000000007271466560755400176070ustar00rootroot00000000000000#!/usr/bin/env bash REDBOLD="\033[31;1m" RESET="\033[0m" function redprint { if [ "$COQ_CI_COLOR" ]; then printf "$REDBOLD%s$RESET\n" "$1" else printf '%s\n' "$1" fi } for f in $(git ls-files "dev/ci/user-overlays/") do if ! { [[ "$f" = dev/ci/user-overlays/README.md ]] || [[ "$f" == *.sh ]]; } then >&2 redprint "Bad overlay '$f'." >&2 echo "User overlays need to have extension .sh to be picked up!" exit 1 fi done coq-8.20.0/dev/tools/coqdev.el000066400000000000000000000232031466560755400161260ustar00rootroot00000000000000;;; coqdev.el --- Emacs helpers for Coq development -*- lexical-binding:t -*- ;; Copyright (C) 2018 The Coq Development Team ;; Maintainer: coqdev@inria.fr ;;; Commentary: ;; Helpers to set compilation commands, proof general variables, etc ;; for Coq development ;; You can disable individual features without editing this file by ;; using `remove-hook', for instance ;; (remove-hook 'hack-local-variables-hook #'coqdev-setup-compile-command) ;;; Installation: ;; To use this, with coqdev.el located at /path/to/coqdev.el, add the ;; following to your init: ;; (add-to-list 'load-path "/path/to/coqdev/") ;; (require 'coqdev) ;; If you load this file from a git repository, checking out an old ;; commit will make it disappear and cause errors for your Emacs ;; startup. To ignore those errors use (require 'coqdev nil t). If you ;; check out a malicious commit Emacs startup would allow it to run ;; arbitrary code, to avoid this you can copy coqdev.el to any ;; location and adjust the load path accordingly (of course if you run ;; ./configure to compile Coq it is already too late). ;;; Code: (require 'ocamldebug nil 'noerror) (require 'seq) (require 'subr-x) (defun coqdev-default-directory () "Return the Coq repository containing `default-directory'." (let ((dir (seq-some (lambda (f) (locate-dominating-file default-directory f)) '("META.coq" "META.coq.in" "META.coq-core.in" "coqpp")))) (when dir (expand-file-name dir)))) (defun coqdev-setup-compile-command () "Setup `compile-command' for Coq development." (let ((dir (coqdev-default-directory))) (when dir (setq-local compile-command (concat "cd " (shell-quote-argument dir) " dune build @check # coq-core.install dev/shim/coqtop"))))) (add-hook 'hack-local-variables-hook #'coqdev-setup-compile-command) (defvar camldebug-command-name) ; from camldebug.el (caml package) (defvar ocamldebug-command-name) ; from ocamldebug.el (tuareg package) (defun coqdev-setup-camldebug () "Setup ocamldebug for Coq development. Specifically `camldebug-command-name' and `ocamldebug-command-name'." (let ((dir (coqdev-default-directory))) (when dir (setq-local camldebug-command-name (concat dir "dev/ocamldebug-coq")) (setq-local ocamldebug-command-name (concat dir "dev/ocamldebug-coq"))))) (add-hook 'hack-local-variables-hook #'coqdev-setup-camldebug) (defun coqdev-setup-tags () "Setup `tags-file-name' for Coq development." (let ((dir (coqdev-default-directory))) (when dir (setq-local tags-file-name (concat dir "TAGS"))))) (add-hook 'hack-local-variables-hook #'coqdev-setup-tags) (defvar coq-prog-args) (defvar coq-prog-name) ;; Lets us detect whether there are file local variables ;; even though PG sets it with `setq' when there's a _Coqproject. ;; Also makes sense generally, so might make it into PG someday. (make-variable-buffer-local 'coq-prog-args) (setq-default coq-prog-args nil) (defun coqdev-setup-proofgeneral () "Setup Proofgeneral variables for Coq development. Note that this function is executed before _Coqproject is read if it exists." (let ((dir (coqdev-default-directory))) (when dir (if (string-prefix-p (concat dir "_build_ci") default-directory) (setq-local coq-prog-name (concat dir "_build/install/default/bin/coqtop")) (setq-local coq-prog-name (concat dir "_build/default/dev/shim/coqtop")))))) (add-hook 'hack-local-variables-hook #'coqdev-setup-proofgeneral) (defvar coqdev-ocamldebug-command "dune exec -- dev/dune-dbg -emacs coqc /tmp/foo.v" "Command run by `coqdev-ocamldebug'") (declare-function comint-check-proc "comint") (declare-function tuareg--split-args "tuareg") (declare-function ocamldebug-filter "ocamldebug") (declare-function ocamldebug-sentinel "ocamldebug") (declare-function ocamldebug-mode "ocamldebug") (declare-function ocamldebug-set-buffer "ocamldebug") (defun coqdev-ocamldebug () "Runs a command in an ocamldebug buffer." (interactive) (require 'ocamldebug) (let* ((dir (read-directory-name "Run from directory: " (coqdev-default-directory))) (name "ocamldebug-coq") (buffer-name (concat "*" name "*"))) (pop-to-buffer buffer-name) (unless (comint-check-proc buffer-name) (setq default-directory dir) (setq coqdev-ocamldebug-command (read-from-minibuffer "Command to run: " coqdev-ocamldebug-command)) (let* ((cmdlist (tuareg--split-args coqdev-ocamldebug-command)) (cmdlist (mapcar #'substitute-in-file-name cmdlist))) (apply #'make-comint name (car cmdlist) nil (cdr cmdlist)) (set-process-filter (get-buffer-process (current-buffer)) #'ocamldebug-filter) (set-process-sentinel (get-buffer-process (current-buffer)) #'ocamldebug-sentinel) (ocamldebug-mode))) (ocamldebug-set-buffer) (insert "source db"))) ;; Provide correct breakpoint setting in dune wrapped libraries ;; (assuming only 1 library/dune file) (defun coqdev--read-from-file (file) "Read FILE as a list of sexps. If invalid syntax, return nil and message the error." (with-temp-buffer (save-excursion (insert "(\n") (insert-file-contents file) (goto-char (point-max)) (insert "\n)\n")) (condition-case err (read (current-buffer)) ((error err) (progn (message "Error reading file %S: %S" file err) nil))))) (defun coqdev--find-single-library (sexps) "If list SEXPS has an element whose `car' is \"library\", return the first one. Otherwise return `nil'." (let ((libs (seq-filter (lambda (elt) (equal (car elt) 'library)) sexps))) (and libs (car libs)))) (defun coqdev--dune-library-name (lib) "With LIB a dune-syntax library stanza, get its name as a string." (let ((field (or (seq-find (lambda (field) (and (consp field) (equal (car field) 'name))) lib) (seq-find (lambda (field) (and (consp field) (equal (car field) 'public\_name))) lib)))) (symbol-name (car (cdr field))))) (defun coqdev--upcase-first-char (arg) "Set the first character of ARG to uppercase." (concat (upcase (substring arg 0 1)) (substring arg 1 (length arg)))) (defun coqdev--real-module-name (filename) "Return module name for ocamldebug, taking into account dune wrapping. (for now only understands dune files with a single library stanza)" (let ((mod (substring filename (string-match "\\([^/]*\\)\\.ml$" filename) (match-end 1))) (dune (concat (file-name-directory filename) "dune"))) (if (file-exists-p dune) (if-let* ((contents (coqdev--read-from-file dune)) (lib (coqdev--find-single-library contents)) (is-wrapped (null (seq-contains-p lib '(wrapped false)))) (libname (coqdev--dune-library-name lib))) (concat libname "__" (coqdev--upcase-first-char mod)) mod) mod))) (with-eval-after-load 'ocamldebug (defun ocamldebug-module-name (arg) (coqdev--real-module-name arg))) ;; This Elisp snippet adds a regexp parser for the format of Anomaly ;; backtraces (coqc -bt ...), to the error parser of the Compilation ;; mode (C-c C-c: "Compile command: ..."). File locations in traces ;; are recognized and can be jumped from easily in the *compilation* ;; buffer. (defvar compilation-error-regexp-alist-alist) (defvar compilation-error-regexp-alist) (with-eval-after-load 'compile (add-to-list 'compilation-error-regexp-alist-alist '(coq-backtrace "^ *\\(?:raise\\|frame\\) @ file \\(\"?\\)\\([^,\" \n\t<>]+\\)\\1,\ lines? \\([0-9]+\\)-?\\([0-9]+\\)?\\(?:$\\|,\ \\(?: characters? \\([0-9]+\\)-?\\([0-9]+\\)?:?\\)?\\)" 2 (3 . 4) (5 . 6))) (add-to-list 'compilation-error-regexp-alist 'coq-backtrace)) (defvar bug-reference-bug-regexp) (defvar bug-reference-url-format) (defun coqdev-setup-bug-reference-mode () "Setup `bug-reference-bug-regexp' and `bug-reference-url-format' for Coq. This does not enable `bug-reference-mode'." (let ((dir (coqdev-default-directory))) (when dir (setq-local bug-reference-bug-regexp "\\(#\\(?2:[0-9]+\\)\\)") (setq-local bug-reference-url-format "https://github.com/coq/coq/issues/%s") (when (derived-mode-p 'prog-mode) (bug-reference-prog-mode 1))))) (add-hook 'hack-local-variables-hook #'coqdev-setup-bug-reference-mode) (defun coqdev-sphinx-quote-coq-refman-region (left right &optional offset beg end) "Add LEFT and RIGHT around the BEG..END. Leave the point after RIGHT. BEG and END default to the bounds of the current region. Leave point OFFSET characters after the left quote (if OFFSET is nil, leave the point after the right quote)." (unless beg (if (region-active-p) (setq beg (region-beginning) end (region-end)) (setq beg (point) end nil))) (save-excursion (goto-char (or end beg)) (insert right)) (save-excursion (goto-char beg) (insert left)) (if (and end (not offset)) ;; Second test handles the ::`` case (goto-char (+ end (length left) (length right))) (goto-char (+ beg (or offset (length left)))))) (defun coqdev-sphinx-rst-coq-action () "Insert a Sphinx role template or quote the current region." (interactive) (pcase (read-char "Command [gntm:`]?") (?g (coqdev-sphinx-quote-coq-refman-region ":g:`" "`")) (?n (coqdev-sphinx-quote-coq-refman-region ":n:`" "`")) (?t (coqdev-sphinx-quote-coq-refman-region ":token:`" "`")) (?m (coqdev-sphinx-quote-coq-refman-region ":math:`" "`")) (?: (coqdev-sphinx-quote-coq-refman-region "::`" "`" 1)) (?` (coqdev-sphinx-quote-coq-refman-region "``" "``")))) (provide 'coqdev) ;;; coqdev ends here coq-8.20.0/dev/tools/create_overlays.sh000077500000000000000000000053241466560755400200550ustar00rootroot00000000000000#!/usr/bin/env bash # TODO: # # - Check if the branch already exists in the remote => checkout # - Better error handling # - Just checkout, don't build # - Rebase functionality # set -x set -e set -o pipefail # setup_contrib_git("_build_ci/fiat", "https://github.com/ejgallego/fiat-core.git") setup_contrib_git() { local _DIR=$1 local _GITURL=$2 ( cd $_DIR git checkout -b $OVERLAY_BRANCH || true # allow the branch to exist already git remote add $DEVELOPER_NAME $_GITURL || true # allow the remote to exist already ) } if [ $# -lt 3 ]; then echo "usage: $0 github_username pr_number contrib1 ... contribN" exit 1 fi set +x . dev/ci/ci-basic-overlay.sh set -x DEVELOPER_NAME=$1 shift PR_NUMBER=$1 shift OVERLAY_BRANCH=$(git rev-parse --abbrev-ref HEAD) OVERLAY_FILE=$(mktemp overlay-XXXX) # Create the overlay file > "$OVERLAY_FILE" skipped_repos= # We first try to build the contribs while test $# -gt 0 do _CONTRIB_NAME=$1 _CONTRIB_GITURL=${_CONTRIB_NAME}_CI_GITURL _CONTRIB_GITURL=${!_CONTRIB_GITURL} _CONTRIB_SUBMODULE_GITURL=${_CONTRIB_NAME}_CI_SUBMODULE_GITURL _CONTRIB_SUBMODULE_GITURL=${!_CONTRIB_SUBMODULE_GITURL} _CONTRIB_SUBMODULE_BRANCH=${_CONTRIB_NAME}_CI_SUBMODULE_BRANCH _CONTRIB_SUBMODULE_BRANCH=${!_CONTRIB_SUBMODULE_BRANCH} if [[ -n "${_CONTRIB_SUBMODULE_GITURL}" ]]; then _CONTRIB_GITURL="${_CONTRIB_SUBMODULE_GITURL}" fi echo "Processing Contrib $_CONTRIB_NAME" shift # check _CONTRIB_GIT exists and it is of the from github... _CONTRIB_DIR=_build_ci/$_CONTRIB_NAME # extract the relevant part of the repository if [[ $_CONTRIB_GITURL == https://github.com/*/* ]]; then _CONTRIB_GITSUFFIX=${_CONTRIB_GITURL#https://github.com/*/} _CONTRIB_GITURL="https://github.com/$DEVELOPER_NAME/$_CONTRIB_GITSUFFIX" _CONTRIB_GITPUSHURL="git@github.com:$DEVELOPER_NAME/${_CONTRIB_GITSUFFIX}.git" else skipped_repos="$skipped_repos $_CONTRIB_NAME" continue fi DOWNLOAD_ONLY=1 make ci-$_CONTRIB_NAME || true setup_contrib_git $_CONTRIB_DIR $_CONTRIB_GITPUSHURL echo "overlay ${_CONTRIB_NAME} $_CONTRIB_GITURL $OVERLAY_BRANCH $PR_NUMBER" >> $OVERLAY_FILE if [ -n "${_CONTRIB_SUBMODULE_BRANCH}${_CONTRIB_SUBMODULE_GITURL}" ]; then echo "# Make PRs against ${_CONTRIB_SUBMODULE_GITURL} base branch ${_CONTRIB_SUBMODULE_BRANCH}" >> $OVERLAY_FILE fi if [ $# -gt 0 ]; then echo "" >> $OVERLAY_FILE; fi done # Copy to overlays folder. PR_NUMBER=$(printf '%05d' "$PR_NUMBER") mv $OVERLAY_FILE dev/ci/user-overlays/$PR_NUMBER-$DEVELOPER_NAME-${OVERLAY_BRANCH///}.sh if [ -n "$skipped_repos" ]; then >&2 echo "Skipped non-github repos: $skipped_repos" exit 1 fi coq-8.20.0/dev/tools/deprecate_file.sh000077500000000000000000000014321466560755400176150ustar00rootroot00000000000000#!/bin/sh usage() { cat 1>&2 <&2 exit 1 fi attr="((Local|Global|Program|Canonical)[[:space:]]+)" deprable="Theorem|Lemma|Fact|Corollary|Proposition|Property|\ Definition|Example|Fixpoint|\ Instance|Axiom|Parameter|Notation|Coercion" annot="#[deprecated(since=\"$vers\", note=\"$note\")]" tmp="$file".depr sed -E "s/(^[[:space:]]*)(($attr)*($deprable).*\$)/\\1$annot\\n\\1\\2/" \ "$file" >"$tmp" mv "$tmp" "$file" coq-8.20.0/dev/tools/generate-release-changelog.sh000077500000000000000000000064321466560755400220240ustar00rootroot00000000000000#!/usr/bin/env bash set -e set -o pipefail if [ $# != 1 ]; then echo "Usage: $0 BRANCH" exit fi branch=$1 # Set SLOW_CONF to have the confirmation output wait for a newline # Emacs doesn't send characters until the RET so we can't quick_conf if [ -z ${SLOW_CONF+x} ] || [ -n "$INSIDE_EMACS" ]; then quick_conf=(-n 1) else quick_conf=() fi ask_confirmation() { read -p "Continue anyway? [y/N] " "${quick_conf[@]}" -r echo if [[ ! $REPLY =~ ^[Yy]$ ]]; then exit 1 fi } if ! git diff --quiet; then echo "Warning: current tree is dirty." ask_confirmation fi remote=$(git config --get "branch.${branch}.remote" || true) if [ -z "$remote" ]; then echo "Warning: branch $branch has no associated remote." ask_confirmation else if [[ "$remote" != $(git config --get "branch.master.remote") ]]; then echo "Warning: branch master and branch $branch do not have the same remote." ask_confirmation fi official_remote_git_url="git@github.com:coq/coq" official_remote_https_url="github.com/coq/coq" remote_url=$(git remote get-url "$remote" --all) if [ "$remote_url" != "${official_remote_git_url}" ] && \ [ "$remote_url" != "${official_remote_git_url}.git" ] && \ [ "$remote_url" != "https://${official_remote_https_url}" ] && \ [ "$remote_url" != "https://${official_remote_https_url}.git" ] && \ [[ "$remote_url" != "https://"*"@${official_remote_https_url}" ]] && \ [[ "$remote_url" != "https://"*"@${official_remote_https_url}.git" ]] ; then echo "Warning: remote $remote does not point to the official Coq repo," echo "that is $official_remote_git_url" echo "It points to $remote_url instead." ask_confirmation fi git fetch "$remote" if [[ $(git rev-parse master) != $(git rev-parse "${remote}/master") ]]; then echo "Warning: branch master is not up-to-date with ${remote}/master." ask_confirmation fi if [[ $(git rev-parse "$branch") != $(git rev-parse "${remote}/${branch}") ]]; then echo "Warning: branch ${branch} is not up-to-date with ${remote}/${branch}." ask_confirmation fi fi git checkout "$branch" --detach > /dev/null 2>&1 changelog_entries_with_title=(doc/changelog/*/*.rst) git checkout master > /dev/null 2>&1 tmp=$(mktemp) for f in "${changelog_entries_with_title[@]}"; do if ! [ -f "$f" ]; then >&2 echo "Warning: $f is missing in master branch." continue fi cat=${f%/*} # dirname if [[ ${f##*/} = 00000-title.rst ]]; then type=0 else type_name=$(head -n 1 "$f" | cut -f 2 -d ' ') type_name=${type_name%":**"} type_name=${type_name#"**"} case "$type_name" in Changed) type=1;; Removed) type=2;; Deprecated) type=3;; Added) type=4;; Fixed) type=5;; *) >&2 echo "Unknown changelog type $type_name in $f"; type=6;; esac fi printf '%s %s %s\n' "$cat" "$type" "$f" >> "$tmp" done while read -r _ type f; do cat "$f" >> released.rst if ! [[ $type = 0 ]]; then git rm "$f" >> /dev/null; fi done < <(sort "$tmp") echo echo "Changelog written in released.rst. Move its content to a new section in doc/sphinx/changes.rst." coq-8.20.0/dev/tools/list-contributors.sh000077500000000000000000000017561466560755400204010ustar00rootroot00000000000000#!/usr/bin/env bash # For compat with OSX which has a non-gnu sed which doesn't support -z SED=`(which gsed || which sed) 2> /dev/null` if [ $# != 1 ]; then echo "usage: $0 rev0..rev1" exit 1 fi git shortlog -s -n --no-merges --group=author --group=trailer:Co-authored-by $1 | cut -f2 | sort -k 2 | grep -v -e "coqbot" -e "^$" > contributors.tmp cat contributors.tmp | wc -l | xargs echo "Contributors:" cat contributors.tmp | $SED -z "s/\n/, /g" echo rm contributors.tmp git shortlog -s -n --merges --group=author --group=trailer:Co-authored-by $1 | cut -f2 | sort -k 2 | grep -v -e "coqbot" -e "^$" > assignees.tmp cat assignees.tmp | wc -l | xargs echo "Assignees:" cat assignees.tmp | $SED -z "s/\n/, /g" echo rm assignees.tmp git shortlog -s -n --merges --group=trailer:reviewed-by --group=trailer:ack-by $1 | cut -f2 | sort -k 2 | grep -v -e "coqbot" -e "^$" > reviewers.tmp cat reviewers.tmp | wc -l | xargs echo "Reviewers:" cat reviewers.tmp | $SED -z "s/\n/, /g" echo rm reviewers.tmp coq-8.20.0/dev/tools/make-changelog.sh000077500000000000000000000031121466560755400175210ustar00rootroot00000000000000#!/bin/sh printf "PR number? " read -r PR printf "Category? (type a prefix)\n" (cd doc/changelog && ls -d */) read -r where where="doc/changelog/$where" if ! [ -d "$where" ]; then where=$(echo "$where"*); fi where="$where/$PR-$(git rev-parse --abbrev-ref HEAD | tr / -).rst" printf "Type? (type first letter)\n" printf "[A]dded \t[C]hanged \t[D]eprecated \t[F]ixed \t[R]emoved\n" read -r type_first_letter case "$type_first_letter" in [Aa]) type_full="Added";; [Cc]) type_full="Changed";; [Dd]) type_full="Deprecated";; [Ff]) type_full="Fixed";; [Rr]) type_full="Removed";; *) printf "Invalid input!\n" exit 1;; esac printf "Fixes? (space separated list of bug numbers)\n" read -r fixes_list fixes_string="$(echo $fixes_list | sed 's/ /~ and /g; s,\([0-9][0-9]*\),`#\1 `_,g' | tr '~' '\n')" if [ ! -z "$fixes_string" ]; then fixes_string="$(printf '\n fixes %s,' "$fixes_string")"; fi # shellcheck disable=SC2016 # the ` are regular strings, this is intended # use %s for the leading - to avoid looking like an option (not sure # if necessary but doesn't hurt) printf '%s **%s:**\n Describe your change here but do not end with a period\n (`#%s `_,%s\n by %s).\n' - "$type_full" "$PR" "$PR" "$fixes_string" "$(git config user.name)" > "$where" printf 'Name of created changelog file:\n' printf '%s\n' "$where" giteditor=$(git config core.editor) if [ "$giteditor" ]; then $giteditor "$where" elif [ "$EDITOR" ]; then $EDITOR "$where" else printf "Describe the changes in the above file\n" fi coq-8.20.0/dev/tools/make_git_revision.sh000077500000000000000000000007621466560755400203650ustar00rootroot00000000000000#!/usr/bin/env bash if ! command -v git >/dev/null; then >&2 echo "skipping make_git_revision: git not found" exit 0 fi if [ -d .git ] || git rev-parse --git-dir > /dev/null 2>&1 then export LANG=C GIT_BRANCH=$(git branch -a | sed -ne '/^\* /s/^\* \(.*\)/\1/p') GIT_HOST=$(hostname) GIT_PATH=$(pwd) echo "${GIT_HOST}:${GIT_PATH},${GIT_BRANCH}" echo $(git log -1 --pretty='format:%H') else >&2 echo "skipping make_git_revision: git dir not found" exit 0 fi coq-8.20.0/dev/tools/markdown-toc000077500000000000000000000033511466560755400166600ustar00rootroot00000000000000#!/usr/bin/env bash # from https://github.com/Lirt/markdown-toc-bash # MIT license FILE=${1:?No file was specified as first argument} declare -a TOC CODE_BLOCK=0 CODE_BLOCK_REGEX='^```' HEADING_REGEX='^#{1,}' while read -r LINE; do # Treat code blocks if [[ "${LINE}" =~ $CODE_BLOCK_REGEX ]]; then # Ignore things until we see code block ending CODE_BLOCK=$((CODE_BLOCK + 1)) if [[ "${CODE_BLOCK}" -eq 2 ]]; then # We hit the closing code block CODE_BLOCK=0 fi continue fi # Treat normal line if [[ "${CODE_BLOCK}" == 0 ]]; then # If we see heading, we save it to ToC map if [[ "${LINE}" =~ ${HEADING_REGEX} ]]; then TOC+=("${LINE}") fi fi done < <(grep -v '## Table of Contents' "${FILE}") echo -e "## Table of Contents\n" for LINE in "${TOC[@]}"; do case "${LINE}" in '#####'*) echo -n " - " ;; '####'*) echo -n " - " ;; '###'*) echo -n " - " ;; '##'*) echo -n " - " ;; '#'*) echo -n "- " ;; esac LINK=${LINE} # Detect markdown links in heading and remove link part from them if grep -qE "\[.*\]\(.*\)" <<< "${LINK}"; then LINK=$(sed 's/\(\]\)\((.*)\)/\1/' <<< "${LINK}") fi # Special characters (besides '-') in page links in markdown # are deleted and spaces are converted to dashes LINK=$(tr -dc "[:alnum:] _-" <<< "${LINK}") LINK=${LINK/ /} LINK=${LINK// /-} LINK=${LINK,,} LINK=$(tr -s "-" <<< "${LINK}") # Print in format [Very Special Heading](#very-special-heading) echo "[${LINE#\#* }](#${LINK})" done coq-8.20.0/dev/tools/merge-pr.sh000077500000000000000000000170521466560755400164050ustar00rootroot00000000000000#!/usr/bin/env bash set -e set -o pipefail API=https://api.github.com/repos/coq/coq OFFICIAL_REMOTE_GIT_URL="git@github.com:coq/coq" OFFICIAL_REMOTE_HTTPS_URL="github.com/coq/coq" # This script depends (at least) on git (>= 2.7) and jq. # It should be used like this: dev/tools/merge-pr.sh /PR number/ # Set SLOW_CONF to have the confirmation output wait for a newline # E.g. call $ SLOW_CONF= dev/tools/merge-pr.sh /PR number/ # emacs doesn't send characters until the RET so we can't quick_conf if [ -z ${SLOW_CONF+x} ] || [ -n "$INSIDE_EMACS" ]; then QUICK_CONF="-n 1" else QUICK_CONF="" fi RED="\033[31m" RESET="\033[0m" GREEN="\033[32m" YELLOW="\033[33m" info() { echo -e "${GREEN}info:${RESET} $1 ${RESET}" } error() { echo -e "${RED}error:${RESET} $1 ${RESET}" } warning() { echo -e "${YELLOW}warning:${RESET} $1 ${RESET}" } check_util() { if ! command -v "$1" > /dev/null 2>&1; then error "this script requires the $1 command line utility" exit 1 fi } ask_confirmation() { read -p "Continue anyway? [y/N] " $QUICK_CONF -r echo if [[ ! $REPLY =~ ^[Yy]$ ]] then exit 1 fi } curl_paginate_array() { # as per https://developer.github.com/v3/guides/traversing-with-pagination/#changing-the-number-of-items-received, GitHub will never give us more than 100 url="$1?per_page=100" # we keep fetching pages until the response is below the per-page limit (possibly 0 elements) page=1 while true; do response="$(curl -s "${url}&page=${page}")" echo "${response}" if [ "$(jq 'length' <<< "$response")" -lt 100 ]; then # done break fi page=$(($page + 1)) done | jq '[.[]]' # we concatenate the arrays } check_util jq check_util curl check_util git check_util gpg check_util grep # command line parsing if [ $# != 1 ]; then error "usage: $0 PR-number" exit 1 fi if [[ "$1" =~ ^[1-9][0-9]*$ ]]; then PR=$1 else error "$1 is not a number" exit 1 fi # Fetching PR metadata # The main API call returns a dict/object, not an array, so we don't # bother paginating PRDATA=$(curl -s "$API/pulls/$PR") TITLE=$(echo "$PRDATA" | jq -r '.title') info "title for PR $PR is $TITLE" BASE_BRANCH=$(echo "$PRDATA" | jq -r '.base.label') info "PR $PR targets branch $BASE_BRANCH" CURRENT_LOCAL_BRANCH=$(git rev-parse --abbrev-ref HEAD) info "you are merging in $CURRENT_LOCAL_BRANCH" REMOTE=$(git config --get "branch.$CURRENT_LOCAL_BRANCH.remote" || true) if [ -z "$REMOTE" ]; then error "branch $CURRENT_LOCAL_BRANCH has not associated remote" error "don't know where to fetch the PR from" error "please run: git branch --set-upstream-to=THE_REMOTE/$CURRENT_LOCAL_BRANCH" exit 1 fi REMOTE_URL=$(git remote get-url "$REMOTE" --all) if [ "$REMOTE_URL" != "${OFFICIAL_REMOTE_GIT_URL}" ] && \ [ "$REMOTE_URL" != "${OFFICIAL_REMOTE_GIT_URL}.git" ] && \ [ "$REMOTE_URL" != "https://${OFFICIAL_REMOTE_HTTPS_URL}" ] && \ [ "$REMOTE_URL" != "https://${OFFICIAL_REMOTE_HTTPS_URL}.git" ] && \ [[ "$REMOTE_URL" != "https://"*"@${OFFICIAL_REMOTE_HTTPS_URL}" ]] && \ [[ "$REMOTE_URL" != "https://"*"@${OFFICIAL_REMOTE_HTTPS_URL}.git" ]] ; then error "remote $REMOTE does not point to the official Coq repo" error "that is $OFFICIAL_REMOTE_GIT_URL" error "it points to $REMOTE_URL instead" ask_confirmation fi info "remote for $CURRENT_LOCAL_BRANCH is $REMOTE" info "fetching from $REMOTE the PR" git remote update "$REMOTE" if ! git ls-remote "$REMOTE" | grep pull >/dev/null; then error "remote $REMOTE is not configured to fetch pull requests" error "run: git config remote.$REMOTE.fetch +refs/pull/*/head:refs/remotes/$REMOTE/pr/*" exit 1 fi git fetch "$REMOTE" "refs/pull/$PR/head" COMMIT=$(git rev-parse FETCH_HEAD) info "commit for PR $PR is $COMMIT" # Sanity check: merge to a different branch if [ "$BASE_BRANCH" != "coq:$CURRENT_LOCAL_BRANCH" ]; then error "PR requests merge in $BASE_BRANCH but you are merging in $CURRENT_LOCAL_BRANCH" ask_confirmation fi; # Sanity check: the local branch is up-to-date with upstream LOCAL_BRANCH_COMMIT=$(git rev-parse HEAD) UPSTREAM_COMMIT=$(git rev-parse @{u}) if [ "$LOCAL_BRANCH_COMMIT" != "$UPSTREAM_COMMIT" ]; then # Is it just that the upstream branch is behind? # It could just be that we merged other PRs and we didn't push yet if git merge-base --is-ancestor -- "$UPSTREAM_COMMIT" "$LOCAL_BRANCH_COMMIT"; then warning "Your branch is ahead of ${REMOTE}." warning "On master, GitHub's branch protection rule prevents merging several PRs at once." warning "You should run [git push ${REMOTE}] between each call to the merge script." ask_confirmation else error "Local branch is not up-to-date with ${REMOTE}." error "Pull before merging." # This check should never be bypassed. exit 1 fi fi # Sanity check: PR has an outdated version of CI BASE_COMMIT=$(echo "$PRDATA" | jq -r '.base.sha') CI_FILES=(".gitlab-ci.yml" ".github/workflows/ci.yml") if ! git diff --quiet "$BASE_COMMIT" "$LOCAL_BRANCH_COMMIT" -- "${CI_FILES[@]}" then warning "This PR didn't run with the latest version of CI." warning "It is probably a good idea to ask for a rebase." read -p "Do you want to see the diff? [Y/n] " $QUICK_CONF -r echo if [[ ! $REPLY =~ ^[Nn]$ ]] then git diff "$BASE_COMMIT" "$LOCAL_BRANCH_COMMIT" -- "${CI_FILES[@]}" fi ask_confirmation fi # Sanity check: CI failed STATUS=$(curl -s "$API/commits/$COMMIT/status") if [ "$(echo "$STATUS" | jq -r '.state')" != "success" ]; then error "CI unsuccessful on $(echo "$STATUS" | jq -r -c '.statuses|map(select(.state != "success"))|map(.context)')" ask_confirmation fi; # Sanity check: has labels named "needs:" NEEDS_LABELS=$(echo "$PRDATA" | jq -rc '.labels | map(select(.name | match("needs:"))) | map(.name)') if [ "$NEEDS_LABELS" != "[]" ]; then error "needs:something labels still present: $NEEDS_LABELS" ask_confirmation fi # Sanity check: has milestone MILESTONE=$(echo "$PRDATA" | jq -rc '.milestone.title') if [ "$MILESTONE" = "null" ]; then error "no milestone set, please set one" ask_confirmation fi # Sanity check: has kind KIND=$(echo "$PRDATA" | jq -rc '.labels | map(select(.name | match("kind:"))) | map(.name)') if [ "$KIND" = "[]" ]; then error "no kind:something label set, please set one" ask_confirmation fi # Sanity check: user.signingkey if [ -z "$(git config user.signingkey)" ]; then warning "git config user.signingkey is empty" warning "gpg will guess a key out of your git config user.* data" fi # Generate commit message info "Fetching review data" reviews=$(curl_paginate_array "$API/pulls/$PR/reviews") msg="Merge PR #$PR: $TITLE" has_state() { [ "$(jq -rc 'map(select(.user.login == "'"$1"'") | .state) | any(. == "'"$2"'")' <<< "$reviews")" = true ] } author=$(echo "$PRDATA" | jq -rc '.user.login') for reviewer in $(jq -rc 'map(.user.login | select(. != "'"$author"'")) | unique | join(" ")' <<< "$reviews" ); do if has_state "$reviewer" APPROVED; then msg=$(printf '%s\n' "$msg" | git interpret-trailers --trailer Reviewed-by="$reviewer") elif has_state "$reviewer" COMMENTED; then msg=$(printf '%s\n' "$msg" | git interpret-trailers --trailer Ack-by="$reviewer") fi done info "merging" git merge -v -S --no-ff FETCH_HEAD -m "$msg" -e # TODO: improve this check if ! git diff --quiet --diff-filter=A "$REMOTE/$CURRENT_LOCAL_BRANCH" -- dev/ci/user-overlays; then warning "this PR has overlays, please check the following:" warning "- each overlay has a corresponding open PR on the upstream repo" warning "- after merging please notify the upstream they can merge the PR" fi coq-8.20.0/dev/tools/notify-upstream-pins.sh000077500000000000000000000052101466560755400207750ustar00rootroot00000000000000 #!/usr/bin/env bash # Script to notify upstreams that we need a tag to put in a platform/installer VERSION="8.13" DATEBETA="December 7, 2020" DATEFINAL="January 7, 2020" CC="CC: https://github.com/coq/coq/issues/12334" #CC="\n@coqbot column:...." REASON="bundled in the Windows installer" #REASON="bundled in the Coq platform" git show master:dev/ci/ci-basic-overlay.sh > /tmp/master-ci-basic-overlay.sh git show v${VERSION}:dev/ci/ci-basic-overlay.sh > /tmp/branch-ci-basic-overlay.sh # reads a variable value from a ci-basic-overlay.sh file function read_from() { ( . $1; varname="$2"; echo ${!varname} ) } # https://gist.github.com/cdown/1163649 function urlencode() { # urlencode old_lc_collate=$LC_COLLATE LC_COLLATE=C local length="${#1}" for (( i = 0; i < length; i++ )); do local c="${1:$i:1}" case $c in [a-zA-Z0-9.~_-]) printf '%s' "$c" ;; *) printf '%%%02X' "'$c" ;; esac done LC_COLLATE=$old_lc_collate } function template { TITLE="Please create a tag for the upcoming release of Coq $VERSION" BODY="The Coq team is planning to release Coq $VERSION-beta1 on $DATEBETA, and Coq $VERSION.0 on $DATEFINAL. Your project is currently scheduled for being $REASON. We are currently testing commit $3 on branch $1/tree/$2 but we would like to ship a released version instead (a tag in git's slang). Could you please tag that commit, or communicate us any other tag that works with the Coq branch v$VERSION at the *latest* 15 days before the date of the final release? Thanks! $CC " UUTITLE=$(urlencode "$TITLE") UUBODY=$(urlencode "$BODY") case $1 in ( http*github.com* ) echo "$1/issues/new?title=$UUTITLE&body=$UUBODY" ;; ( http*gitlab* ) echo "$1/-/issues/new" echo echo -e "$TITLE" echo echo -e "$BODY" ;; ( * ) echo "$1" echo echo -e "$TITLE" echo echo -e "$BODY" ;; esac } # TODO: filter w.r.t. what is in the platform PROJECTS=`read_from /tmp/branch-ci-basic-overlay.sh "projects[@]"` for addon in $PROJECTS; do URL=`read_from /tmp/master-ci-basic-overlay.sh "${addon}_CI_GITURL"` REF=`read_from /tmp/master-ci-basic-overlay.sh "${addon}_CI_REF"` PIN=`read_from /tmp/branch-ci-basic-overlay.sh "${addon}_CI_REF"` if [ "${#PIN}" = "40" ]; then echo -e "Addon $addon is pinned to a hash, to open an issue open the following url:\n" template $URL $REF $PIN elif [ "${#PIN}" = "0" ]; then echo "Addon $addon has no pin!" exit 1 else echo "Addon $addon is already pinned to version $PIN" fi echo -e "\n----------------------------------------------" done coq-8.20.0/dev/tools/pin-ci.sh000077500000000000000000000022441466560755400160430ustar00rootroot00000000000000#!/usr/bin/env bash # Use this script to pin the commit used by the developments tracked by the CI OVERLAYS="./dev/ci/ci-basic-overlay.sh" process_development() { local DEV=$1 local REPO_VAR="${DEV}_CI_GITURL" local REPO=${!REPO_VAR} local BRANCH_VAR="${DEV}_CI_REF" local BRANCH=${!BRANCH_VAR} if [[ -z "$BRANCH" ]] then echo "$DEV has no branch set, skipping" return 0 fi if [[ $BRANCH =~ ^[a-f0-9]{40}$ ]] then echo "$DEV is already set to hash $BRANCH, skipping" return 0 fi echo "Resolving $DEV as $BRANCH from $REPO" local HASH=$(git ls-remote --heads $REPO $BRANCH | cut -f 1) if [[ -z "$HASH" ]] then echo "Could not resolve reference $BRANCH for $DEV (something went wrong), skipping" return 0 fi read -p "Expand $DEV from $BRANCH to $HASH? [y/N] " -n 1 -r echo if [[ $REPLY =~ ^[Yy]$ ]]; then # use -i.bak to be compatible with MacOS; see, e.g., https://stackoverflow.com/a/7573438/377022 sed -i.bak -E "s|project +$DEV +.*|project $DEV '$REPO' '$HASH'|" $OVERLAYS fi } # Execute the script to set the overlay variables . $OVERLAYS for project in ${projects[@]} do process_development $project done coq-8.20.0/dev/tools/pre-commit000077500000000000000000000045661466560755400163400ustar00rootroot00000000000000#!/bin/sh # configure automatically sets up a wrapper at .git/hooks/pre-commit # which calls this script (if it exists). set -e dev/tools/check-overlays.sh log=$(mktemp "git-fix-ws-log.XXXXXX") exec > "$log" 1>&2 echo "Auto fixing whitespace issues ($log)..." # We fix whitespace in the index and in the working tree # separately to preserve non-added changes. index=$(mktemp "git-fix-ws-index.XXXXXX") fixed_index=$(mktemp "git-fix-ws-index-fixed.XXXXXX") tree=$(mktemp "git-fix-ws-tree.XXXXXX") echo "Patches are saved in '$index', '$fixed_index' and '$tree'." echo "If an error destroys your changes you can recover using them." echo "(The files are cleaned up on success.)" echo #newline git diff-index -p --binary --cached HEAD > "$index" git diff-index -p --binary HEAD > "$tree" # reset work tree and index # NB: untracked files which were not added are untouched if [ -s "$index" ]; then git apply --whitespace=nowarn --cached -R "$index"; fi if [ -s "$tree" ]; then git apply --whitespace=nowarn -R "$tree"; fi # Fix index # For end of file newlines we must go through the worktree if [ -s "$index" ]; then echo "Fixing staged changes..." git apply --cached --whitespace=fix "$index" git apply --whitespace=fix "$index" 2>/dev/null # no need to repeat yourself git diff --cached --name-only -z | xargs -0 dev/tools/check-eof-newline.sh --fix git add -u echo #newline fi # reset work tree git diff-index -p --binary --cached HEAD > "$fixed_index" # If all changes were bad whitespace changes the patch is empty # making git fail. Don't fail now: we fix the worktree first. if [ -s "$fixed_index" ]; then git apply --whitespace=nowarn -R "$fixed_index"; fi # Fix worktree if [ -s "$tree" ]; then echo "Fixing unstaged changes..." git apply --whitespace=fix "$tree" git diff --name-only -z | xargs -0 dev/tools/check-eof-newline.sh --fix echo #newline fi if [ -s "$index" ] && ! [ -s "$fixed_index" ]; then echo "Fixing whitespace issues cancelled all changes." exit 1 fi # Check that we did fix whitespace if ! git diff-index --check --cached HEAD; then echo "Auto-fixing whitespace failed: errors remain." echo "This may fix itself if you try again." echo "(Consider whether the number of errors decreases after each run.)" exit 1 fi echo "Whitespace pass complete." # clean up temporary files rm "$index" "$tree" "$fixed_index" "$log" coq-8.20.0/dev/tools/update-compat.py000077500000000000000000000511651466560755400174530ustar00rootroot00000000000000#!/usr/bin/env python3 import os, re, sys, subprocess from io import open # When passed `--release`, this script sets up Coq to support three # `-compat` flag arguments. If executed manually, this would consist # of doing the following steps: # # - Delete the file `theories/Compat/CoqUU.v`, where U.U is four # versions prior to the new version X.X. After this, there # should be exactly three `theories/Compat/CoqNN.v` files. # - Update # [`doc/stdlib/index-list.html.template`](/doc/stdlib/index-list.html.template) # with the deleted file. # - Remove any notations in the standard library which have `compat "U.U"`. # - Update the function `get_compat_file` in [`toplevel/coqargs.ml`](/toplevel/coqargs.ml) # by bumping all the version numbers by one. # # - Remove the file # [`test-suite/success/CompatOldOldFlag.v`](/test-suite/success/CompatOldOldFlag.v). # - Update # [`test-suite/tools/update-compat/run.sh`](/test-suite/tools/update-compat/run.sh) # to ensure that it passes `--release` to the `update-compat.py` # script. # When passed the `--master` flag, this script sets up Coq to support # four `-compat` flag arguments. If executed manually, this would # consist of doing the following steps: # # - Add a file `theories/Compat/CoqXX.v` which contains just the header # from [`dev/header.ml`](/dev/header.ml) # - Add the line `Require Export Coq.Compat.CoqXX.` at the top of # `theories/Compat/CoqYY.v`, where Y.Y is the version prior to X.X. # - Update # [`doc/stdlib/index-list.html.template`](/doc/stdlib/index-list.html.template) # with the added file. # - Update the function `get_compat_file` in [`toplevel/coqargs.ml`](/toplevel/coqargs.ml) # by bumping all the version numbers by one. # - Update the files # [`test-suite/success/CompatCurrentFlag.v`](/test-suite/success/CompatCurrentFlag.v), # [`test-suite/success/CompatPreviousFlag.v`](/test-suite/success/CompatPreviousFlag.v), # and # [`test-suite/success/CompatOldFlag.v`](/test-suite/success/CompatOldFlag.v) # by bumping all version numbers by 1. Re-create the file # [`test-suite/success/CompatOldOldFlag.v`](/test-suite/success/CompatOldOldFlag.v) # with its version numbers also bumped by 1 (file should have # been removed before branching; see above). # - Update # [`test-suite/tools/update-compat/run.sh`](/test-suite/tools/update-compat/run.sh) # to ensure that it passes `--master` to the `update-compat.py` # script. # Obtain the absolute path of the script being run. By assuming that # the script lives in dev/tools/, and basing all calls on the path of # the script, rather than the current working directory, we can be # robust to users who choose to run the script from any location. SCRIPT_PATH = os.path.dirname(os.path.realpath(__file__)) ROOT_PATH = os.path.realpath(os.path.join(SCRIPT_PATH, '..', '..')) CONFIGURE_PATH = os.path.join(ROOT_PATH, 'tools/configure/configure.ml') HEADER_PATH = os.path.join(ROOT_PATH, 'dev', 'header.ml') DEFAULT_NUMBER_OF_OLD_VERSIONS = 2 RELEASE_NUMBER_OF_OLD_VERSIONS = 2 MASTER_NUMBER_OF_OLD_VERSIONS = 3 EXTRA_HEADER = '\n(** Compatibility file for making Coq act similar to Coq v%s *)\n' COQARGS_ML_PATH = os.path.join(ROOT_PATH, 'sysinit', 'coqargs.ml') DOC_INDEX_PATH = os.path.join(ROOT_PATH, 'doc', 'stdlib', 'index-list.html.template') TEST_SUITE_RUN_PATH = os.path.join(ROOT_PATH, 'test-suite', 'tools', 'update-compat', 'run.sh') TEST_SUITE_PATHS = tuple(os.path.join(ROOT_PATH, 'test-suite', 'success', i) for i in ('CompatOldOldFlag.v', 'CompatOldFlag.v', 'CompatPreviousFlag.v', 'CompatCurrentFlag.v')) TEST_SUITE_DESCRIPTIONS = ('current-minus-three', 'current-minus-two', 'current-minus-one', 'current') # sanity check that we are where we think we are assert(os.path.normpath(os.path.realpath(SCRIPT_PATH)) == os.path.normpath(os.path.realpath(os.path.join(ROOT_PATH, 'dev', 'tools')))) assert(os.path.exists(CONFIGURE_PATH)) BUG_HEADER = r"""(* DO NOT MODIFY THIS FILE DIRECTLY *) (* It is autogenerated by %s. *) """ % os.path.relpath(os.path.realpath(__file__), ROOT_PATH) def get_file_lines(file_name): with open(file_name, 'rb') as f: lines = f.readlines() return [line.decode('utf-8') for line in lines] def get_file(file_name): return ''.join(get_file_lines(file_name)) def get_header(): return get_file(HEADER_PATH) HEADER = get_header() def fatal_error(msg): if hasattr(sys.stderr, 'buffer'): sys.stderr.buffer.write(msg.encode("utf-8")) else: sys.stderr.write(msg.encode("utf-8")) sys.exit(1) def maybe_git_add(local_path, suggest_add=True, **args): if args['git_add']: print("Running 'git add %s'..." % local_path) retc = subprocess.call(['git', 'add', local_path], cwd=ROOT_PATH) if retc is not None and retc != 0: print('!!! Process returned code %d' % retc) elif suggest_add: print(r"!!! Don't forget to 'git add %s'!" % local_path) def maybe_git_rm(local_path, **args): if args['git_add']: print("Running 'git rm %s'..." % local_path) retc = subprocess.call(['git', 'rm', local_path], cwd=ROOT_PATH) if retc is not None and retc != 0: print('!!! Process returned code %d' % retc) def get_version(cur_version=None): if cur_version is not None: return cur_version for line in get_file_lines(CONFIGURE_PATH): found = re.findall(r'let coq_version = "([0-9]+\.[0-9]+)', line) if len(found) > 0: return found[0] raise Exception("No line 'let coq_version = \"X.X' found in %s" % os.path.relpath(CONFIGURE_PATH, ROOT_PATH)) def compat_name_to_version_name(compat_file_name): assert(compat_file_name.startswith('Coq') and compat_file_name.endswith('.v')) v = compat_file_name[len('Coq'):][:-len('.v')] assert(len(v) == 2 or (len(v) >= 2 and v[0] in ('8', '9'))) # we'll have to change this scheme when we hit Coq 10.* return '%s.%s' % (v[0], v[1:]) def version_name_to_compat_name(v, ext='.v'): return 'Coq%s%s%s' % tuple(v.split('.') + [ext]) # returns (lines of compat files, lines of not compat files def get_doc_index_lines(): lines = get_file_lines(DOC_INDEX_PATH) return (tuple(line for line in lines if 'theories/Compat/Coq' in line), tuple(line for line in lines if 'theories/Compat/Coq' not in line)) COMPAT_INDEX_LINES, DOC_INDEX_LINES = get_doc_index_lines() def version_to_int_pair(v): return tuple(map(int, v.split('.'))) def get_known_versions(): # We could either get the files from the doc index, or from the # directory list. We assume that the doc index is more # representative. If we wanted to use the directory list, we # would do: # compat_files = os.listdir(os.path.join(ROOT_PATH, 'theories', 'Compat')) compat_files = re.findall(r'Coq[^\.]+\.v', '\n'.join(COMPAT_INDEX_LINES)) return tuple(sorted((compat_name_to_version_name(i) for i in compat_files if i.startswith('Coq') and i.endswith('.v')), key=version_to_int_pair)) def get_new_versions(known_versions, **args): if args['cur_version'] in known_versions: assert(known_versions[-1] == args['cur_version']) known_versions = known_versions[:-1] assert(len(known_versions) >= args['number_of_old_versions']) return tuple(list(known_versions[-args['number_of_old_versions']:]) + [args['cur_version']]) def print_diff(olds, news, numch=30): for ch in range(min(len(olds), len(news))): if olds[ch] != news[ch]: print('Character %d differs:\nOld: %s\nNew: %s' % (ch, repr(olds[ch:][:numch]), repr(news[ch:][numch]))) return ch = min(len(olds), len(news)) assert(len(olds) != len(news)) print('Strings are different lengths:\nOld tail: %s\nNew tail: %s' % (repr(olds[ch:]), repr(news[ch:]))) def update_shebang_to_match(contents, new_contents, path): contents_lines = contents.split('\n') new_contents_lines = new_contents.split('\n') if not (contents_lines[0].startswith('#!/') and contents_lines[0].endswith('bash')): raise Exception('Unrecognized #! line in existing %s: %s' % (os.path.relpath(path, ROOT_PATH), repr(contents_lines[0]))) if not (new_contents_lines[0].startswith('#!/') and new_contents_lines[0].endswith('bash')): raise Exception('Unrecognized #! line in new %s: %s' % (os.path.relpath(path, ROOT_PATH), repr(new_contents_lines[0]))) new_contents_lines[0] = contents_lines[0] return '\n'.join(new_contents_lines) def update_if_changed(contents, new_contents, path, exn_string='%s changed!', suggest_add=False, pass_through_shebang=False, assert_unchanged=False, **args): if contents is not None and pass_through_shebang: new_contents = update_shebang_to_match(contents, new_contents, path) if contents is None or contents != new_contents: if not assert_unchanged: print('Updating %s...' % os.path.relpath(path, ROOT_PATH)) with open(path, 'w', encoding='utf-8') as f: f.write(new_contents) maybe_git_add(os.path.relpath(path, ROOT_PATH), suggest_add=suggest_add, **args) else: if contents is not None: print('Unexpected change:\nOld contents:\n%s\n\nNew contents:\n%s\n' % (contents, new_contents)) print_diff(contents, new_contents) raise Exception(exn_string % os.path.relpath(path, ROOT_PATH)) def remove_if_exists(path, exn_string='%s exists when it should not!', assert_unchanged=False, **args): if os.path.exists(path): if not assert_unchanged: print('Removing %s...' % os.path.relpath(path, ROOT_PATH)) os.remove(path) maybe_git_rm(os.path.relpath(path, ROOT_PATH), **args) else: raise Exception(exn_string % os.path.relpath(path, ROOT_PATH)) def update_file(new_contents, path, **args): update_if_changed(None, new_contents, path, **args) def update_compat_files(old_versions, new_versions, assert_unchanged=False, **args): for v in old_versions: if v not in new_versions: compat_file = os.path.join('theories', 'Compat', version_name_to_compat_name(v)) if not assert_unchanged: print('Removing %s...' % compat_file) compat_path = os.path.join(ROOT_PATH, compat_file) os.rename(compat_path, compat_path + '.bak') maybe_git_rm(compat_file, **args) else: raise Exception('%s exists!' % compat_file) for v, next_v in zip(new_versions, list(new_versions[1:]) + [None]): compat_file = os.path.join('theories', 'Compat', version_name_to_compat_name(v)) compat_path = os.path.join(ROOT_PATH, compat_file) if not os.path.exists(compat_path): print('Creating %s...' % compat_file) contents = HEADER + (EXTRA_HEADER % v) if next_v is not None: contents += '\nRequire Export Coq.Compat.%s.\n' % version_name_to_compat_name(next_v, ext='') update_file(contents, compat_path, exn_string='%s does not exist!', assert_unchanged=assert_unchanged, **args) else: # print('Checking %s...' % compat_file) contents = get_file(compat_path) header = HEADER + (EXTRA_HEADER % v) if not contents.startswith(HEADER): raise Exception("Invalid header in %s; does not match %s" % (compat_file, os.path.relpath(HEADER_PATH, ROOT_PATH))) if not contents.startswith(header): raise Exception("Invalid header in %s; missing line %s" % (compat_file, EXTRA_HEADER.strip('\n') % v)) if next_v is not None: line = 'Require Export Coq.Compat.%s.' % version_name_to_compat_name(next_v, ext='') if ('\n%s\n' % line) not in contents: if not contents.startswith(header + '\n'): contents = contents.replace(header, header + '\n') contents = contents.replace(header, '%s\n%s' % (header, line)) update_file(contents, compat_path, exn_string=('Compat file %%s is missing line %s' % line), assert_unchanged=assert_unchanged, **args) def update_get_compat_file(new_versions, contents, relpath): line_count = 3 # 1 for the first line, 1 for the invalid flags, and 1 for Current first_line = 'let get_compat_file = function' split_contents = contents[contents.index(first_line):].split('\n') while True: cur_line = split_contents[:line_count][-1] if re.match(r'^ \| \([0-9 "\.\|]*\) as s ->$', cur_line) is not None: break elif re.match(r'^ \| "[0-9\.]*" -> "Coq.Compat.Coq[0-9]*"$', cur_line) is not None: line_count += 1 else: raise Exception('Could not recognize line %d of get_compat_file in %s as a list of invalid versions (line was %s)' % (line_count, relpath, repr(cur_line))) old_function_lines = split_contents[:line_count] all_versions = re.findall(r'"([0-9\.]+)"', ''.join(old_function_lines)) invalid_versions = tuple(i for i in all_versions if i not in new_versions) new_function_lines = [first_line] for v, V in reversed(list(zip(new_versions, ['"Coq.Compat.Coq%s%s"' % tuple(v.split('.')) for v in new_versions]))): new_function_lines.append(' | "%s" -> %s' % (v, V)) new_function_lines.append(' | (%s) as s ->' % ' | '.join('"%s"' % v for v in invalid_versions)) new_lines = '\n'.join(new_function_lines) new_contents = contents.replace('\n'.join(old_function_lines), new_lines) if new_lines not in new_contents: raise Exception('Could not find get_compat_file in %s' % relpath) return new_contents def update_coqargs_ml(old_versions, new_versions, **args): contents = get_file(COQARGS_ML_PATH) new_contents = update_get_compat_file(new_versions, contents, os.path.relpath(COQARGS_ML_PATH, ROOT_PATH)) update_if_changed(contents, new_contents, COQARGS_ML_PATH, **args) def update_flags(old_versions, new_versions, **args): update_coqargs_ml(old_versions, new_versions, **args) def update_test_suite(new_versions, assert_unchanged=False, test_suite_paths=TEST_SUITE_PATHS, test_suite_descriptions=TEST_SUITE_DESCRIPTIONS, test_suite_outdated_paths=tuple(), **args): assert(len(new_versions) == len(test_suite_paths)) assert(len(new_versions) == len(test_suite_descriptions)) for i, (v, path, descr) in enumerate(zip(new_versions, test_suite_paths, test_suite_descriptions)): contents = None suggest_add = False if os.path.exists(path): contents = get_file(path) else: suggest_add = True if '%s' in descr: descr = descr % v lines = ['(* -*- coq-prog-args: ("-compat" "%s") -*- *)' % v, '(** Check that the %s compatibility flag actually requires the relevant modules. *)' % descr] for imp_v in reversed(new_versions[i:]): lines.append('Import Coq.Compat.%s.' % version_name_to_compat_name(imp_v, ext='')) lines.append('') new_contents = '\n'.join(lines) update_if_changed(contents, new_contents, path, suggest_add=suggest_add, **args) for path in test_suite_outdated_paths: remove_if_exists(path, assert_unchanged=assert_unchanged, **args) def update_doc_index(new_versions, **args): contents = get_file(DOC_INDEX_PATH) firstline = ' theories/Compat/AdmitAxiom.v' new_contents = ''.join(DOC_INDEX_LINES) if firstline not in new_contents: raise Exception("Could not find line '%s' in %s" % (firstline, os.path.relpath(DOC_INDEX_PATH, ROOT_PATH))) extra_lines = [' theories/Compat/%s' % version_name_to_compat_name(v) for v in new_versions] new_contents = new_contents.replace(firstline, '\n'.join([firstline] + extra_lines)) update_if_changed(contents, new_contents, DOC_INDEX_PATH, **args) def update_test_suite_run(**args): contents = get_file(TEST_SUITE_RUN_PATH) new_contents = r'''#!/usr/bin/env bash # allow running this script from any directory by basing things on where the script lives SCRIPT_DIR="$( cd "$( dirname "${BASH_SOURCE[0]}" )" >/dev/null && pwd )" # we assume that the script lives in test-suite/tools/update-compat/, # and that update-compat.py lives in dev/tools/ cd "${SCRIPT_DIR}/../../.." dev/tools/update-compat.py --assert-unchanged %s || exit $? ''' % ' '.join([('--master' if args['master'] else ''), ('--release' if args['release'] else '')]).strip() update_if_changed(contents, new_contents, TEST_SUITE_RUN_PATH, pass_through_shebang=True, **args) def update_compat_notations_in(old_versions, new_versions, contents): for v in old_versions: if v not in new_versions: reg = re.compile(r'^[ \t]*(?:Notation|Infix)[^\n]*?compat "%s"[^\n]*?\n' % v, flags=re.MULTILINE) contents = re.sub(r'^[ \t]*(?:Notation|Infix)[^\n]*?compat "%s"[^\n]*?\n' % v, '', contents, flags=re.MULTILINE) return contents def update_compat_notations(old_versions, new_versions, **args): for root, dirs, files in os.walk(os.path.join(ROOT_PATH, 'theories')): for fname in files: if not fname.endswith('.v'): continue contents = get_file(os.path.join(root, fname)) new_contents = update_compat_notations_in(old_versions, new_versions, contents) update_if_changed(contents, new_contents, os.path.join(root, fname), **args) def display_git_grep(old_versions, new_versions): Vs = ['V%s_%s' % tuple(v.split('.')) for v in old_versions if v not in new_versions] compat_vs = ['compat "%s"' % v for v in old_versions if v not in new_versions] all_options = tuple(Vs + compat_vs) options = (['"-compat" "%s"' % v for v in old_versions if v not in new_versions] + [version_name_to_compat_name(v, ext='') for v in old_versions if v not in new_versions]) if len(options) > 0 or len(all_options) > 0: print('To discover what files require manual updating, run:') if len(options) > 0: print("git grep -- '%s' test-suite/" % r'\|'.join(options)) if len(all_options) > 0: print("git grep -- '%s'" % r'\|'.join(all_options)) def parse_args(argv): args = { 'assert_unchanged': False, 'cur_version': None, 'number_of_old_versions': None, 'master': False, 'release': False, 'git_add': False, } if '--master' not in argv and '--release' not in argv: fatal_error(r'''ERROR: You should pass either --release (sometime before branching) or --master (right after branching and updating the version number in version.ml)''') for arg in argv[1:]: if arg == '--assert-unchanged': args['assert_unchanged'] = True elif arg == '--git-add': args['git_add'] = True elif arg == '--master': args['master'] = True if args['number_of_old_versions'] is None: args['number_of_old_versions'] = MASTER_NUMBER_OF_OLD_VERSIONS elif arg == '--release': args['release'] = True if args['number_of_old_versions'] is None: args['number_of_old_versions'] = RELEASE_NUMBER_OF_OLD_VERSIONS elif arg.startswith('--cur-version='): args['cur_version'] = arg[len('--cur-version='):] assert(len(args['cur_version'].split('.')) == 2) assert(all(map(str.isdigit, args['cur_version'].split('.')))) elif arg.startswith('--number-of-old-versions='): args['number_of_old_versions'] = int(arg[len('--number-of-old-versions='):]) else: print('USAGE: %s [--assert-unchanged] [--cur-version=NN.NN] [--number-of-old-versions=NN] [--git-add]' % argv[0]) print('') print('ERROR: Unrecognized argument: %s' % arg) sys.exit(1) if args['number_of_old_versions'] is None: args['number_of_old_versions'] = DEFAULT_NUMBER_OF_OLD_VERSIONS return args if __name__ == '__main__': args = parse_args(sys.argv) args['cur_version'] = get_version(args['cur_version']) args['number_of_compat_versions'] = args['number_of_old_versions'] + 1 known_versions = get_known_versions() new_versions = get_new_versions(known_versions, **args) assert(len(TEST_SUITE_PATHS) >= args['number_of_compat_versions']) args['test_suite_paths'] = tuple(TEST_SUITE_PATHS[-args['number_of_compat_versions']:]) args['test_suite_outdated_paths'] = tuple(TEST_SUITE_PATHS[:-args['number_of_compat_versions']]) args['test_suite_descriptions'] = tuple(TEST_SUITE_DESCRIPTIONS[-args['number_of_compat_versions']:]) update_compat_files(known_versions, new_versions, **args) update_flags(known_versions, new_versions, **args) update_test_suite(new_versions, **args) update_test_suite_run(**args) update_doc_index(new_versions, **args) update_compat_notations(known_versions, new_versions, **args) display_git_grep(known_versions, new_versions) coq-8.20.0/dev/top_printers.dbg000066400000000000000000000100061466560755400163660ustar00rootroot00000000000000install_printer Top_printers.pP install_printer Top_printers.ppfuture install_printer Top_printers.ppid install_printer Top_printers.pplab install_printer Top_printers.ppmbid install_printer Top_printers.ppdir install_printer Top_printers.ppmp install_printer Top_printers.ppcon install_printer Top_printers.ppproj install_printer Top_printers.ppprojrepr install_printer Top_printers.ppkn install_printer Top_printers.ppmind install_printer Top_printers.ppind install_printer Top_printers.ppsp install_printer Top_printers.ppqualid install_printer Top_printers.ppscheme install_printer Top_printers.ppwf_paths install_printer Top_printers.ppevar install_printer Top_printers.ppuint63 install_printer Top_printers.pp_constr_parray install_printer Top_printers.pp_fconstr_parray install_printer Top_printers.ppconstr install_printer Top_printers.ppeconstr install_printer Top_printers.ppconstr_expr install_printer Top_printers.ppglob_constr install_printer Top_printers.pppattern install_printer Top_printers.ppfconstr install_printer Top_printers.ppfsubst install_printer Top_printers.ppnumtokunsigned install_printer Top_printers.ppnumtokunsignednat install_printer Top_printers.ppintset install_printer Top_printers.ppidset install_printer Top_printers.ppidmapgen install_printer Top_printers.ppintmapgen install_printer Top_printers.ppmpmapgen install_printer Top_printers.ppdpmapgen install_printer Top_printers.ppconmapenvgen install_printer Top_printers.ppmindmapenvgen install_printer Top_printers.ppididmap install_printer Top_printers.ppmodidmapgen install_printer Top_printers.ppconstrunderbindersidmap install_printer Top_printers.ppevarsubst install_printer Top_printers.ppunbound_ltac_var_map install_printer Top_printers.ppclosure install_printer Top_printers.ppclosedglobconstr install_printer Top_printers.ppclosedglobconstridmap install_printer Top_printers.ppglobal install_printer Top_printers.ppconst install_printer Top_printers.ppvar install_printer Top_printers.ppj install_printer Top_printers.ppsubst install_printer Top_printers.ppdelta install_printer Top_printers.pp_idpred install_printer Top_printers.pp_cpred install_printer Top_printers.pp_transparent_state install_printer Top_printers.pp_estack_t install_printer Top_printers.pp_state_t install_printer Top_printers.ppmetas install_printer Top_printers.ppevm install_printer Top_printers.ppexistentialset install_printer Top_printers.ppexistentialfilter install_printer Top_printers.ppclenv install_printer Top_printers.ppgoal install_printer Top_printers.ppgoal_with_state install_printer Top_printers.pphintdb install_printer Top_printers.ppproofview install_printer Top_printers.ppopenconstr install_printer Top_printers.pproof install_printer Top_printers.ppuni install_printer Top_printers.ppesorts install_printer Top_printers.ppqvar install_printer Top_printers.ppuni_level install_printer Top_printers.ppqvarset install_printer Top_printers.ppuniverse_set install_printer Top_printers.ppuniverse_instance install_printer Top_printers.ppuniverse_context install_printer Top_printers.ppaucontext install_printer Top_printers.ppuniverse_context_set install_printer Top_printers.ppuniverse_subst install_printer Top_printers.ppuniverse_opt_subst install_printer Top_printers.ppqvar_subst install_printer Top_printers.ppuniverse_level_subst install_printer Top_printers.ppevar_universe_context install_printer Top_printers.ppconstraints install_printer Top_printers.ppuniverseconstraints install_printer Top_printers.ppuniverse_context_future install_printer Top_printers.ppuniverses install_printer Top_printers.pp_partialfsubst install_printer Top_printers.pp_partialsubst install_printer Top_printers.ppnamedcontextval install_printer Top_printers.ppenv install_printer Top_printers.ppglobenv install_printer Top_printers.pptac install_printer Top_printers.ppobj install_printer Top_printers.pploc install_printer Top_printers.pp_argument_type install_printer Top_printers.pp_generic_argument install_printer Top_printers.ppgenarginfo install_printer Top_printers.ppgenargargt install_printer Top_printers.ppist coq-8.20.0/dev/top_printers.ml000066400000000000000000000641031466560755400162510ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* str "_") kx) (* name printers *) let ppid id = pp (Id.print id) let pplab l = pp (Label.print l) let ppmbid mbid = pp (str (MBId.debug_to_string mbid)) let ppdir dir = pp (DirPath.print dir) let ppmp mp = pp(str (ModPath.debug_to_string mp)) let ppcon con = pp(Constant.debug_print con) let ppprojrepr con = pp(Constant.debug_print (Projection.Repr.constant con)) let ppproj p = pp(Projection.debug_print p) let ppkn kn = pp(str (KerName.to_string kn)) let ppmind kn = pp(MutInd.debug_print kn) let ppind (kn,i) = pp(MutInd.debug_print kn ++ str"," ++int i) let ppsp sp = pp(pr_path sp) let ppqualid qid = pp(pr_qualid qid) let ppscheme k = pp (Ind_tables.pr_scheme_kind k) let pprecarg r = pp (Declareops.pr_recarg r) let ppwf_paths x = pp (Declareops.pr_wf_paths x) let get_current_context () = try Vernacstate.Declare.get_current_context () with Vernacstate.Declare.NoCurrentProof -> let env = Global.env() in Evd.from_env env, env [@@ocaml.warning "-3"] (* term printers *) let envpp pp = let sigma,env = get_current_context () in pp env sigma let ppevar evk = pp (Evar.print evk) let pr_constr t = let sigma, env = get_current_context () in Printer.pr_constr_env env sigma t let pr_econstr t = let sigma, env = get_current_context () in Printer.pr_econstr_env env sigma t let ppconstr x = pp (pr_constr x) let ppeconstr x = pp (pr_econstr x) let ppconstr_expr x = let sigma,env = get_current_context () in pp (Ppconstr.pr_constr_expr env sigma x) let ppconstr_univ x = Constrextern.with_universes ppconstr x let ppglob_constr = (fun x -> pp(with_env_evm pr_lglob_constr_env x)) let pppattern = (fun x -> pp(envpp pr_constr_pattern_env x)) let pptype = (fun x -> try pp(envpp (fun env evm t -> pr_ltype_env env evm t) x) with e -> pp (str (Printexc.to_string e))) let ppfconstr c = ppconstr (CClosure.term_of_fconstr c) let ppuint63 i = pp (str (Uint63.to_string i)) let pp_parray pr a = let a, def = Parray.to_array a in let a = Array.to_list a in pp (str "[|" ++ prlist_with_sep (fun () -> str ";" ++ spc()) pr a ++ spc() ++ str "|" ++ spc() ++ pr def ++ str "|]") let pp_constr_parray = pp_parray pr_constr let pp_fconstr_parray = pp_parray (fun f -> pr_constr (CClosure.term_of_fconstr f)) let ppfsubst s = let (s, k) = Esubst.Internal.repr s in let sep () = str ";" ++ spc () in let pr = function | Esubst.Internal.REL n -> str "<#" ++ int n ++ str ">" | Esubst.Internal.VAL (k, x) -> pr_constr (Vars.lift k (CClosure.term_of_fconstr x)) in pp @@ str "[" ++ prlist_with_sep sep pr s ++ str "| " ++ int k ++ str "]" let ppnumtokunsigned n = pp (NumTok.Unsigned.print n) let ppnumtokunsignednat n = pp (NumTok.UnsignedNat.print n) let prset pr l = str "[" ++ hov 0 (prlist_with_sep spc pr l) ++ str "]" let ppintset l = pp (prset int (Int.Set.elements l)) let ppidset l = pp (prset Id.print (Id.Set.elements l)) let prset' pr l = str "[" ++ hov 0 (prlist_with_sep pr_comma pr l) ++ str "]" let pridmap pr l = let pr (id,b) = Id.print id ++ str "=>" ++ pr id b in prset' pr (Id.Map.fold (fun a b l -> (a,b)::l) l []) let ppidmap pr l = pp (pridmap pr l) let prmapgen pr dom = if dom = [] then str "[]" else str "[domain= " ++ hov 0 (prlist_with_sep spc pr dom) ++ str "]" let pridmapgen l = prmapgen Id.print (Id.Set.elements (Id.Map.domain l)) let ppidmapgen l = pp (pridmapgen l) let printmapgen l = prmapgen int (Int.Set.elements (Int.Map.domain l)) let ppintmapgen l = pp (printmapgen l) let prmodidmapgen l = prmapgen Id.print (ModIdset.elements (ModIdmap.domain l)) let ppmodidmapgen l = pp (prmodidmapgen l) let ppmpmapgen l = pp (prmapgen (fun mp -> str (ModPath.debug_to_string mp)) (MPset.elements (MPmap.domain l))) let ppdpmapgen l = pp (prmapgen (fun mp -> str (DirPath.to_string mp)) (DPset.elements (DPmap.domain l))) let ppconmapenvgen l = pp (prmapgen (fun mp -> str (Constant.debug_to_string mp)) (Cset_env.elements (Cmap_env.domain l))) let ppmindmapenvgen l = pp (prmapgen (fun mp -> str (MutInd.debug_to_string mp)) (Mindmap_env.Set.elements (Mindmap_env.domain l))) let ppevarsubst = ppidmap (fun id0 -> prset (fun (c,copt,id) -> hov 0 (pr_constr c ++ (match copt with None -> mt () | Some c -> spc () ++ str "") ++ (if id = id0 then mt () else spc () ++ str "")))) let prididmap = pridmap (fun _ -> Id.print) let ppididmap = ppidmap (fun _ -> Id.print) let prconstrunderbindersidmap = pridmap (fun _ (l,c) -> hov 1 (str"[" ++ prlist_with_sep spc Id.print l ++ str"]") ++ str "," ++ spc () ++ pr_econstr c) let ppconstrunderbindersidmap l = pp (prconstrunderbindersidmap l) let ppunbound_ltac_var_map l = ppidmap (fun _ arg -> str"") l open Ltac_pretype let rec pr_closure {idents=idents;typed=typed;untyped=untyped} = hov 1 (str"{idents=" ++ prididmap idents ++ str";" ++ spc() ++ str"typed=" ++ prconstrunderbindersidmap typed ++ str";" ++ spc() ++ str"untyped=" ++ pr_closed_glob_constr_idmap untyped ++ str"}") and pr_closed_glob_constr_idmap x = pridmap (fun _ -> pr_closed_glob_constr) x and pr_closed_glob_constr {closure=closure;term=term} = pr_closure closure ++ with_env_evm pr_lglob_constr_env term let ppclosure x = pp (pr_closure x) let ppclosedglobconstr x = pp (pr_closed_glob_constr x) let ppclosedglobconstridmap x = pp (pr_closed_glob_constr_idmap x) let pP s = pp (hov 0 s) let safe_pr_global = let open GlobRef in function | ConstRef kn -> pp (str "CONSTREF(" ++ Constant.debug_print kn ++ str ")") | IndRef (kn,i) -> pp (str "INDREF(" ++ MutInd.debug_print kn ++ str "," ++ int i ++ str ")") | ConstructRef ((kn,i),j) -> pp (str "CONSTRUCTREF(" ++ MutInd.debug_print kn ++ str "," ++ int i ++ str "," ++ int j ++ str ")") | VarRef id -> pp (str "VARREF(" ++ Id.print id ++ str ")") let ppglobal x = try pp(pr_global x) with _ -> safe_pr_global x let ppconst (sp,j) = pp (str"#" ++ KerName.print sp ++ str"=" ++ envpp pr_lconstr_env j.uj_val) let ppvar ((id,a)) = pp (str"#" ++ Id.print id ++ str":" ++ envpp pr_lconstr_env a) let genppj f j = let (c,t) = f j in (c ++ str " : " ++ t) let ppj j = pp (genppj (envpp pr_ljudge_env) j) let ppsubst s = pp (Mod_subst.debug_pr_subst s) let ppdelta s = pp (Mod_subst.debug_pr_delta s) let pp_idpred s = pp (pr_idpred s) let pp_cpred s = pp (pr_cpred s) let pp_transparent_state s = pp (pr_transparent_state s) let pp_estack_t n = pp (Reductionops.Stack.pr pr_econstr n) let pp_state_t n = pp (Reductionops.pr_state Global.(env()) Evd.empty n) (* proof printers *) let pr_evar ev = Pp.int (Evar.repr ev) let ppmetas metas = pp(Termops.pr_metaset metas) let ppevm evd = pp(Termops.pr_evar_map ~with_univs:!Detyping.print_universes (Some 2) (Global.env ()) evd) let ppevmall evd = pp(Termops.pr_evar_map ~with_univs:!Detyping.print_universes None (Global.env ()) evd) let pr_existentialset evars = prlist_with_sep spc pr_evar (Evar.Set.elements evars) let ppexistentialset evars = pp (pr_existentialset evars) let ppexistentialfilter filter = match Evd.Filter.repr filter with | None -> pp (Pp.str "ø") | Some f -> pp (prlist_with_sep spc bool f) let pr_goal e = Pp.(str "GOAL:" ++ int (Evar.repr e)) let ppclenv clenv = pp(pr_clenv clenv) let ppgoal g = pp(Printer.Debug.pr_goal g) let ppgoal_with_state g = ppevar (Proofview_monad.drop_state g) let pphintdb db = pp(envpp Hints.pr_hint_db_env db) let ppproofview p = let gls,sigma = Proofview.proofview p in pp(pr_enum pr_goal gls ++ fnl () ++ Termops.pr_evar_map (Some 1) (Global.env ()) sigma) let ppopenconstr (x : Evd.open_constr) = let (evd,c) = x in pp (Termops.pr_evar_map (Some 2) (Global.env ()) evd ++ envpp pr_econstr_env c) (* spiwack: deactivated until a replacement is found let pppftreestate p = pp(print_pftreestate p) *) (* let ppgoal g = pp(db_pr_goal g) *) (* let pr_gls gls = *) (* hov 0 (pr_evar_defs (sig_sig gls) ++ fnl () ++ db_pr_goal (sig_it gls)) *) (* let pr_glls glls = *) (* hov 0 (pr_evar_defs (sig_sig glls) ++ fnl () ++ *) (* prlist_with_sep fnl db_pr_goal (sig_it glls)) *) (* let ppsigmagoal g = pp(pr_goal (sig_it g)) *) (* let prgls gls = pp(pr_gls gls) *) (* let prglls glls = pp(pr_glls glls) *) let pproof p = pp(Proof.pr_proof p) let ppuni u = pp(Universe.raw_pr u) let ppuni_level u = pp (Level.raw_pr u) let ppqvar q = pp (QVar.raw_pr q) let ppesorts s = pp (Sorts.debug_print (Evd.MiniEConstr.ESorts.unsafe_to_sorts s)) let prlev l = UnivNames.pr_level_with_global_universes l let prqvar q = Sorts.QVar.raw_pr q let ppqvarset l = pp (hov 1 (str "{" ++ prlist_with_sep spc QVar.raw_pr (QVar.Set.elements l) ++ str "}")) let ppuniverse_set l = pp (Level.Set.pr prlev l) let ppuniverse_instance l = pp (Instance.pr prqvar prlev l) let ppuniverse_context l = pp (pr_universe_context prqvar prlev l) let ppuniverse_context_set l = pp (pr_universe_context_set prlev l) let ppuniverse_subst l = pp (UnivSubst.pr_universe_subst Level.raw_pr l) let ppuniverse_opt_subst l = pp (UnivFlex.pr Level.raw_pr l) let ppqvar_subst l = pp (UVars.pr_quality_level_subst QVar.raw_pr l) let ppuniverse_level_subst l = pp (Univ.pr_universe_level_subst Level.raw_pr l) let ppevar_universe_context l = pp (Termops.pr_evar_universe_context l) let ppconstraints c = pp (Constraints.pr Level.raw_pr c) let ppuniverseconstraints c = pp (UnivProblem.Set.pr c) let ppuniverse_context_future c = let ctx = Future.force c in ppuniverse_context ctx let ppuniverses u = pp (UGraph.pr_universes Level.raw_pr (UGraph.repr u)) let ppnamedcontextval e = let env = Global.env () in let sigma = Evd.from_env env in pp (pr_named_context env sigma (named_context_of_val e)) let ppaucontext auctx = let qnas, unas = AbstractContext.names auctx in let prgen pr var_index nas l = match var_index l with | Some n -> (match nas.(n) with | Anonymous -> pr l | Name id -> Id.print id) | None -> pr l in let prqvar l = prgen prqvar Sorts.QVar.var_index qnas l in let prlev l = prgen prlev Level.var_index unas l in pp (pr_universe_context prqvar prlev (AbstractContext.repr auctx)) let pp_partialfsubst psubst = pp (Partial_subst.pr (fun f -> pr_constr (CClosure.term_of_fconstr f)) (Quality.pr prqvar) (Universe.pr prlev) psubst) let pp_partialsubst psubst = pp (Partial_subst.pr pr_econstr (Quality.pr prqvar) (Universe.pr prlev) psubst) let ppenv e = pp (str "[" ++ pr_named_context_of e Evd.empty ++ str "]" ++ spc() ++ str "[" ++ pr_rel_context e Evd.empty (rel_context e) ++ str "]") let ppglobenv e = ppenv (GlobEnv.env e) let ppenvwithcst e = pp (str "[" ++ pr_named_context_of e Evd.empty ++ str "]" ++ spc() ++ str "[" ++ pr_rel_context e Evd.empty (rel_context e) ++ str "]" ++ spc() ++ str "{" ++ Environ.fold_constants (fun a _ s -> Constant.print a ++ spc () ++ s) e (mt ()) ++ str "}") let pptac = (fun x -> pp(Ltac_plugin.Pptactic.pr_glob_tactic (Global.env()) x)) let ppobj obj = let Libobject.Dyn.Dyn (tag, _) = obj in Format.print_string (Libobject.Dyn.repr tag) let cnt = ref 0 let cast_kind_display k = match k with | VMcast -> "VMcast" | DEFAULTcast -> "DEFAULTcast" | NATIVEcast -> "NATIVEcast" let constr_display csr = let rec term_display c = match kind c with | Rel n -> "Rel("^(string_of_int n)^")" | Meta n -> "Meta("^(string_of_int n)^")" | Var id -> "Var("^(Id.to_string id)^")" | Sort s -> "Sort("^(sort_display s)^")" | Cast (c,k, t) -> "Cast("^(term_display c)^","^(cast_kind_display k)^","^(term_display t)^")" | Prod (na,t,c) -> "Prod("^(name_display na)^","^(term_display t)^","^(term_display c)^")\n" | Lambda (na,t,c) -> "Lambda("^(name_display na)^","^(term_display t)^","^(term_display c)^")\n" | LetIn (na,b,t,c) -> "LetIn("^(name_display na)^","^(term_display b)^"," ^(term_display t)^","^(term_display c)^")" | App (c,l) -> "App("^(term_display c)^","^(array_display l)^")\n" | Evar (e,l) -> let l = SList.to_list l in let map = function None -> "?" | Some t -> term_display t in let l = List.map map l in "Evar("^(Pp.string_of_ppcmds (Evar.print e))^", [|"^(String.concat "; " l)^"|])" | Const (c,u) -> "Const("^(Constant.to_string c)^","^(universes_display u)^")" | Ind ((sp,i),u) -> "MutInd("^(MutInd.to_string sp)^","^(string_of_int i)^","^(universes_display u)^")" | Construct (((sp,i),j),u) -> "MutConstruct(("^(MutInd.to_string sp)^","^(string_of_int i)^")," ^","^(universes_display u)^(string_of_int j)^")" | Proj (p, r, c) -> "Proj("^(Projection.to_string p)^","^term_display c ^")" | Case (ci,u,pms,((_,p),_),iv,c,bl) -> "MutCase(,"^(term_display p)^","^(term_display c)^"," ^(array_display (Array.map snd bl))^")" | Fix ((t,i),(lna,tl,bl)) -> "Fix(([|"^(Array.fold_right (fun x i -> (string_of_int x)^(if not(i="") then (";"^i) else "")) t "")^"|],"^(string_of_int i)^")," ^(array_display tl)^",[|" ^(Array.fold_right (fun x i -> (name_display x)^(if not(i="") then (";"^i) else "")) lna "")^"|]," ^(array_display bl)^")" | CoFix(i,(lna,tl,bl)) -> "CoFix("^(string_of_int i)^")," ^(array_display tl)^"," ^(Array.fold_right (fun x i -> (name_display x)^(if not(i="") then (";"^i) else "")) lna "")^"," ^(array_display bl)^")" | Int i -> "Int("^(Uint63.to_string i)^")" | Float f -> "Float("^(Float64.to_string f)^")" | String s -> Printf.sprintf "String(%S)" (Pstring.to_string s) | Array (u,t,def,ty) -> "Array("^(array_display t)^","^(term_display def)^","^(term_display ty)^")@{" ^universes_display u^"\n" and array_display v = "[|"^ (Array.fold_right (fun x i -> (term_display x)^(if not(i="") then (";"^i) else "")) v "")^"|]" and univ_display u = incr cnt; pp (str "with " ++ int !cnt ++ str" " ++ Universe.raw_pr u ++ fnl ()) and quality_display q = incr cnt; pp (str "with " ++ int !cnt ++ str" " ++ Sorts.Quality.raw_pr q ++ fnl ()) and level_display u = incr cnt; pp (str "with " ++ int !cnt ++ str" " ++ Level.raw_pr u ++ fnl ()) and sort_display = function | SProp -> "SProp" | Set -> "Set" | Prop -> "Prop" | Type u -> univ_display u; "Type("^(string_of_int !cnt)^")" | QSort (q, u) -> univ_display u; Printf.sprintf "QSort(%s, %i)" (Sorts.QVar.to_string q) !cnt and universes_display l = let qs, us = Instance.to_array l in let qs = Array.fold_right (fun x i -> quality_display x; (string_of_int !cnt)^ (if not(i="") then (" "^i) else "")) qs "" in Array.fold_right (fun x i -> level_display x; (string_of_int !cnt)^(if not(i="") then (" "^i) else "")) us (if qs = "" then "" else (qs^" | ")) and name_display x = match x.binder_name with | Name id -> "Name("^(Id.to_string id)^")" | Anonymous -> "Anonymous" in pp (str (term_display csr) ++fnl ()) let econstr_display c = constr_display EConstr.Unsafe.(to_constr c) ;; open Format;; let print_pure_constr csr = let rec term_display c = match Constr.kind c with | Rel n -> print_string "#"; print_int n | Meta n -> print_string "Meta("; print_int n; print_string ")" | Var id -> print_string (Id.to_string id) | Sort s -> sort_display s | Cast (c,_, t) -> open_hovbox 1; print_string "("; (term_display c); print_cut(); print_string "::"; (term_display t); print_string ")"; close_box() | Prod ({binder_name=Name(id)},t,c) -> open_hovbox 1; print_string"("; print_string (Id.to_string id); print_string ":"; box_display t; print_string ")"; print_cut(); box_display c; close_box() | Prod ({binder_name=Anonymous},t,c) -> print_string"("; box_display t; print_cut(); print_string "->"; box_display c; print_string ")"; | Lambda (na,t,c) -> print_string "["; name_display na; print_string ":"; box_display t; print_string "]"; print_cut(); box_display c; | LetIn (na,b,t,c) -> print_string "["; name_display na; print_string "="; box_display b; print_cut(); print_string ":"; box_display t; print_string "]"; print_cut(); box_display c; | App (c,l) -> print_string "("; box_display c; Array.iter (fun x -> print_space (); box_display x) l; print_string ")" | Evar (e,l) -> print_string "Evar#"; print_int (Evar.repr e); print_string "{"; let iter = function None -> print_space (); print_string "?" | Some t -> print_space (); box_display t in List.iter iter (SList.to_list l); print_string"}" | Const (c,u) -> print_string "Cons("; sp_con_display c; print_string ","; universes_display u; print_string ")" | Proj (p,_,c') -> print_string "Proj("; sp_prj_display p; print_string ","; box_display c'; print_string ")" | Ind ((sp,i),u) -> print_string "Ind("; sp_display sp; print_string ","; print_int i; print_string ","; universes_display u; print_string ")" | Construct (((sp,i),j),u) -> print_string "Constr("; sp_display sp; print_string ","; print_int i; print_string ","; print_int j; print_string ","; universes_display u; print_string ")" | Case (ci,u,pms,(p,_),iv,c,bl) -> let pr_ctx (nas, c) = Array.iter (fun na -> print_cut (); name_display na) nas; print_string " |- "; box_display c in open_vbox 0; print_cut(); print_string "Case"; print_space(); box_display c; print_space (); print_cut(); print_string "in"; print_cut(); print_string "Ind("; sp_display (fst ci.ci_ind); print_string ","; print_int (snd ci.ci_ind); print_string ")"; print_string "@{"; universes_display u; print_string "}"; Array.iter (fun x -> print_space (); box_display x) pms; print_cut(); print_string "return <"; pr_ctx p; print_string ">"; print_cut(); print_string "with"; open_vbox 0; Array.iter (fun x -> print_cut(); pr_ctx x) bl; close_box(); print_cut(); print_string "end"; close_box() | Fix ((t,i),(lna,tl,bl)) -> print_string "Fix("; print_int i; print_string ")"; print_cut(); open_vbox 0; let print_fix () = for k = 0 to (Array.length tl) - 1 do open_vbox 0; name_display lna.(k); print_string "/"; print_int t.(k); print_cut(); print_string ":"; box_display tl.(k) ; print_cut(); print_string ":="; box_display bl.(k); close_box (); print_cut() done in print_string"{"; print_fix(); print_string"}" | CoFix(i,(lna,tl,bl)) -> print_string "CoFix("; print_int i; print_string ")"; print_cut(); open_vbox 0; let print_fix () = for k = 0 to (Array.length tl) - 1 do open_vbox 1; name_display lna.(k); print_cut(); print_string ":"; box_display tl.(k) ; print_cut(); print_string ":="; box_display bl.(k); close_box (); print_cut(); done in print_string"{"; print_fix (); print_string"}" | Int i -> print_string ("Int("^(Uint63.to_string i)^")") | Float f -> print_string ("Float("^(Float64.to_string f)^")") | String s -> print_string (Printf.sprintf "String(%S)" (Pstring.to_string s)) | Array (u,t,def,ty) -> print_string "Array("; Array.iter (fun x -> box_display x; print_space()) t; print_string "|"; box_display def; print_string ":"; box_display ty; print_string ")@{"; universes_display u; print_string "}" and box_display c = open_hovbox 1; term_display c; close_box() and universes_display u = let qs, us = Instance.to_array u in Array.iter (fun u -> print_space (); pp (Sorts.Quality.raw_pr u)) qs; Array.iter (fun u -> print_space (); pp (Level.raw_pr u)) us and sort_display = function | SProp -> print_string "SProp" | Set -> print_string "Set" | Prop -> print_string "Prop" | Type u -> open_hbox(); print_string "Type("; pp (Universe.raw_pr u); print_string ")"; close_box() | QSort (q, u) -> open_hbox(); print_string "QSort("; pp (QVar.raw_pr q); print_string ", "; pp (Universe.raw_pr u); print_string ")"; close_box() and name_display x = match x.binder_name with | Name id -> print_string (Id.to_string id) | Anonymous -> print_string "_" (* Remove the top names for library and Scratch to avoid long names *) and sp_display sp = (* let dir,l = decode_kn sp in let ls = match List.rev_map Id.to_string (DirPath.repr dir) with ("Top"::l)-> l | ("Coq"::_::l) -> l | l -> l in List.iter (fun x -> print_string x; print_string ".") ls;*) print_string (MutInd.debug_to_string sp) and sp_con_display sp = (* let dir,l = decode_kn sp in let ls = match List.rev_map Id.to_string (DirPath.repr dir) with ("Top"::l)-> l | ("Coq"::_::l) -> l | l -> l in List.iter (fun x -> print_string x; print_string ".") ls;*) print_string (Constant.debug_to_string sp) and sp_prj_display sp = print_string (Projection.debug_to_string sp) in try box_display csr; print_flush() with e -> print_string (Printexc.to_string e);print_flush (); raise e let print_pure_econstr c = print_pure_constr EConstr.Unsafe.(to_constr c) ;; let pploc x = let (l,r) = Loc.unloc x in print_string"(";print_int l;print_string",";print_int r;print_string")" let pp_argument_type t = pp (pr_argument_type t) let pp_generic_argument arg = pp(str"") let prgenarginfo arg = let Geninterp.Val.Dyn (tag, _) = arg in let tpe = Geninterp.Val.pr tag in (* FIXME *) (* try *) (* let data = Pptactic.pr_top_generic (Global.env ()) arg in *) (* str "" *) (* with _any -> *) str "" let ppgenarginfo arg = pp (prgenarginfo arg) let ppgenargargt arg = pp (str (Genarg.ArgT.repr arg)) let ppist ist = let pr id arg = prgenarginfo arg in pp (pridmap pr ist.Geninterp.lfun) (**********************************************************************) (* Vernac-level debugging commands *) let in_current_context f c = let (evmap,sign) = get_current_context () in f (fst (Constrintern.interp_constr sign evmap c))(*FIXME*) (* We expand the result of preprocessing to be independent of camlp5 VERNAC COMMAND EXTEND PrintPureConstr | [ "PrintPureConstr" constr(c) ] -> [ in_current_context print_pure_constr c ] END VERNAC COMMAND EXTEND PrintConstr [ "PrintConstr" constr(c) ] -> [ in_current_context constr_display c ] END *) let () = let open Vernacextend in let open Vernactypes in let ty_constr = Extend.TUentry (get_arg_tag Stdarg.wit_constr) in let cmd_sig = TyTerminal("PrintConstr", TyNonTerminal(ty_constr, TyNil)) in let cmd_fn c ?loc:_ ~atts () = vtdefault (fun () -> in_current_context econstr_display c) in let cmd_class _ = VtQuery in let cmd : ty_ml = TyML (false, cmd_sig, cmd_fn, Some cmd_class) in static_vernac_extend ~plugin:None ~command:"PrintConstr" [cmd] let () = let open Vernacextend in let open Vernactypes in let ty_constr = Extend.TUentry (get_arg_tag Stdarg.wit_constr) in let cmd_sig = TyTerminal("PrintPureConstr", TyNonTerminal(ty_constr, TyNil)) in let cmd_fn c ?loc:_ ~atts () = vtdefault (fun () -> in_current_context print_pure_econstr c) in let cmd_class _ = VtQuery in let cmd : ty_ml = TyML (false, cmd_sig, cmd_fn, Some cmd_class) in static_vernac_extend ~plugin:None ~command:"PrintPureConstr" [cmd] (* Setting printer of unbound global reference *) open Names open Libnames let encode_path ?loc prefix mpdir suffix id = let dir = match mpdir with | None -> [] | Some mp -> DirPath.repr (dirpath_of_string (ModPath.to_string mp)) in make_qualid ?loc (DirPath.make (List.rev (Id.of_string prefix::dir@suffix))) id let raw_string_of_ref ?loc _ = let open GlobRef in function | ConstRef cst -> let (mp,id) = KerName.repr (Constant.user cst) in encode_path ?loc "CST" (Some mp) [] (Label.to_id id) | IndRef (kn,i) -> let (mp,id) = KerName.repr (MutInd.user kn) in encode_path ?loc "IND" (Some mp) [Label.to_id id] (Id.of_string ("_"^string_of_int i)) | ConstructRef ((kn,i),j) -> let (mp,id) = KerName.repr (MutInd.user kn) in encode_path ?loc "CSTR" (Some mp) [Label.to_id id;Id.of_string ("_"^string_of_int i)] (Id.of_string ("_"^string_of_int j)) | VarRef id -> encode_path ?loc "SECVAR" None [] id let short_string_of_ref ?loc _ = let open GlobRef in function | VarRef id -> qualid_of_ident ?loc id | ConstRef cst -> qualid_of_ident ?loc (Label.to_id (Constant.label cst)) | IndRef (kn,0) -> qualid_of_ident ?loc (Label.to_id (MutInd.label kn)) | IndRef (kn,i) -> encode_path ?loc "IND" None [Label.to_id (MutInd.label kn)] (Id.of_string ("_"^string_of_int i)) | ConstructRef ((kn,i),j) -> encode_path ?loc "CSTR" None [Label.to_id (MutInd.label kn);Id.of_string ("_"^string_of_int i)] (Id.of_string ("_"^string_of_int j)) coq-8.20.0/dev/top_printers.mli000066400000000000000000000160401466560755400164170ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* unit val pP : Pp.t -> unit (* with surrounding box *) val ppfuture : 'a Future.computation -> unit val ppid : Names.Id.t -> unit val pplab : Names.Label.t -> unit val ppmbid : Names.MBId.t -> unit val ppdir : Names.DirPath.t -> unit val ppmp : Names.ModPath.t -> unit val ppcon : Names.Constant.t -> unit val ppproj : Names.Projection.t -> unit val ppprojrepr : Names.Projection.Repr.t -> unit val ppkn : Names.KerName.t -> unit val ppmind : Names.MutInd.t -> unit val ppind : Names.inductive -> unit val ppuint63 : Uint63.t -> unit val ppsp : Libnames.full_path -> unit val ppqualid : Libnames.qualid -> unit val ppscheme : 'a Ind_tables.scheme_kind -> unit val pprecarg : Declarations.recarg -> unit val ppwf_paths : Declarations.recarg Rtree.t -> unit val pr_evar : Evar.t -> Pp.t val ppevar : Evar.t -> unit (* Multiple printers for Constr.t *) val ppconstr : Constr.t -> unit (* by Termops printer *) val ppconstr_univ : Constr.t -> unit val pp_constr_parray : Constr.t Parray.t -> unit val pp_fconstr_parray : CClosure.fconstr Parray.t -> unit (* Extern as type *) val pptype : Constr.types -> unit val ppeconstr : EConstr.constr -> unit (* Termops printer *) val ppconstr_expr : Constrexpr.constr_expr -> unit val ppglob_constr : 'a Glob_term.glob_constr_g -> unit val pppattern : Pattern.constr_pattern -> unit val ppfconstr : CClosure.fconstr -> unit val ppfsubst : CClosure.fconstr Esubst.subs -> unit val ppnumtokunsigned : NumTok.Unsigned.t -> unit val ppnumtokunsignednat : NumTok.UnsignedNat.t -> unit val ppintset : Int.Set.t -> unit val ppidset : Names.Id.Set.t -> unit val pridmap : (Names.Id.Map.key -> 'a -> Pp.t) -> 'a Names.Id.Map.t -> Pp.t val ppidmap : (Names.Id.Map.key -> 'a -> Pp.t) -> 'a Names.Id.Map.t -> unit val pridmapgen : 'a Names.Id.Map.t -> Pp.t val ppidmapgen : 'a Names.Id.Map.t -> unit val printmapgen : 'a Int.Map.t -> Pp.t val ppintmapgen : 'a Int.Map.t -> unit val ppmpmapgen : 'a Names.MPmap.t -> unit val ppdpmapgen : 'a Names.DPmap.t -> unit val ppconmapenvgen : 'a Names.Cmap_env.t -> unit val ppmindmapenvgen : 'a Names.Mindmap_env.t -> unit val prmodidmapgen : 'a Names.ModIdmap.t -> Pp.t val ppmodidmapgen : 'a Names.ModIdmap.t -> unit val prididmap : Names.Id.t Names.Id.Map.t -> Pp.t val ppididmap : Names.Id.t Names.Id.Map.t -> unit val prconstrunderbindersidmap : (Names.Id.t list * EConstr.constr) Names.Id.Map.t -> Pp.t val ppconstrunderbindersidmap : (Names.Id.t list * EConstr.constr) Names.Id.Map.t -> unit val ppevarsubst : (Constr.t * Constr.t option * Names.Id.Map.key) list Names.Id.Map.t -> unit val ppunbound_ltac_var_map : 'a Genarg.generic_argument Names.Id.Map.t -> unit val pr_closure : Ltac_pretype.closure -> Pp.t val pr_closed_glob_constr_idmap : Ltac_pretype.closed_glob_constr Names.Id.Map.t -> Pp.t val pr_closed_glob_constr : Ltac_pretype.closed_glob_constr -> Pp.t val ppclosure : Ltac_pretype.closure -> unit val ppclosedglobconstr : Ltac_pretype.closed_glob_constr -> unit val ppclosedglobconstridmap : Ltac_pretype.closed_glob_constr Names.Id.Map.t -> unit val ppglobal : Names.GlobRef.t -> unit val ppconst : Names.KerName.t * (Constr.constr, 'a) Environ.punsafe_judgment -> unit val ppvar : Names.Id.t * Constr.constr -> unit val genppj : ('a -> Pp.t * Pp.t) -> 'a -> Pp.t val ppj : EConstr.unsafe_judgment -> unit val ppsubst : Mod_subst.substitution -> unit val ppdelta : Mod_subst.delta_resolver -> unit val pp_idpred : Names.Id.Pred.t -> unit val pp_cpred : Names.Cpred.t -> unit val pp_transparent_state : TransparentState.t -> unit val pp_estack_t : Reductionops.Stack.t -> unit val pp_state_t : Reductionops.state -> unit val ppmetas : Evd.Metaset.t -> unit val ppevm : Evd.evar_map -> unit val ppevmall : Evd.evar_map -> unit val pr_existentialset : Evar.Set.t -> Pp.t val ppexistentialset : Evar.Set.t -> unit val ppexistentialfilter : Evd.Filter.t -> unit val ppclenv : Clenv.clausenv -> unit val ppgoal : Proofview.Goal.t -> unit val ppgoal_with_state : Proofview_monad.goal_with_state -> unit val pphintdb : Hints.Hint_db.t -> unit val ppproofview : Proofview.proofview -> unit val ppopenconstr : Evd.open_constr -> unit val pproof : Proof.t -> unit (* Universes *) val ppuni : Univ.Universe.t -> unit val ppuni_level : Univ.Level.t -> unit (* raw *) val ppqvar : Sorts.QVar.t -> unit val ppesorts : EConstr.ESorts.t -> unit val prlev : Univ.Level.t -> Pp.t (* with global names (does this work?) *) val ppqvarset : Sorts.QVar.Set.t -> unit val ppuniverse_set : Univ.Level.Set.t -> unit val ppuniverse_instance : UVars.Instance.t -> unit val ppuniverse_context : UVars.UContext.t -> unit val ppaucontext : UVars.AbstractContext.t -> unit val ppuniverse_context_set : Univ.ContextSet.t -> unit val ppuniverse_subst : UnivSubst.universe_subst -> unit val ppuniverse_opt_subst : UState.universe_opt_subst -> unit val ppqvar_subst : Sorts.Quality.t Sorts.QVar.Map.t -> unit val ppuniverse_level_subst : Univ.universe_level_subst -> unit val ppevar_universe_context : UState.t -> unit val ppconstraints : Univ.Constraints.t -> unit val ppuniverseconstraints : UnivProblem.Set.t -> unit val ppuniverse_context_future : UVars.UContext.t Future.computation -> unit val ppuniverses : UGraph.t -> unit val pp_partialfsubst : (CClosure.fconstr, Sorts.Quality.t, Univ.Universe.t) Partial_subst.t -> unit val pp_partialsubst : (EConstr.constr, Sorts.Quality.t, Univ.Universe.t) Partial_subst.t -> unit val ppnamedcontextval : Environ.named_context_val -> unit val ppenv : Environ.env -> unit val ppglobenv : GlobEnv.t -> unit val ppenvwithcst : Environ.env -> unit val pptac : Ltac_plugin.Tacexpr.glob_tactic_expr -> unit val ppobj : Libobject.obj -> unit (* Some super raw printers *) val cast_kind_display : Constr.cast_kind -> string val constr_display : Constr.constr -> unit val econstr_display : EConstr.constr -> unit val print_pure_constr : Constr.types -> unit val print_pure_econstr : EConstr.types -> unit val pploc : Loc.t -> unit val pp_argument_type : Genarg.argument_type -> unit val pp_generic_argument : 'a Genarg.generic_argument -> unit val prgenarginfo : Geninterp.Val.t -> Pp.t val ppgenarginfo : Geninterp.Val.t -> unit val ppgenargargt : ('a, 'b, 'c) Genarg.ArgT.tag -> unit val ppist : Geninterp.interp_sign -> unit val raw_string_of_ref : ?loc:Loc.t -> Names.Id.Set.t -> Names.GlobRef.t -> Libnames.qualid val short_string_of_ref : ?loc:Loc.t -> Names.Id.Set.t -> Names.GlobRef.t -> Libnames.qualid coq-8.20.0/dev/vm_printers.ml000066400000000000000000000055471466560755400161000ustar00rootroot00000000000000open Format open Term open Names open Vmemitcodes open Values open Vmvalues let ppripos (ri,pos) = (match ri with | Reloc_annot a -> print_string "switch\n" | Reloc_const _ -> print_string "structured constant\n" | Reloc_getglobal kn -> print_string ("getglob "^(Constant.to_string kn)^"\n") | Reloc_caml_prim op -> print_string ("caml primitive "^ CPrimitives.to_string @@ Vmbytecodes.caml_prim_to_prim op) ); print_flush () let ppsort = function | SProp -> print_string "SProp" | Set -> print_string "Set" | Prop -> print_string "Prop" | Type _ -> print_string "Type" | QSort _ -> print_string "QSort" let print_idkey idk = match idk with | ConstKey sp -> print_string "Cons("; print_string (Constant.to_string sp); print_string ")" | VarKey id -> print_string (Id.to_string id) | RelKey i -> print_string "~";print_int i | EvarKey evk -> print_string "Evar("; print_int (Evar.repr evk); print_string ")" let rec ppzipper z = match z with | Zapp args -> let n = nargs args in open_hbox (); for i = 0 to n-2 do ppvalues (arg args i);print_string ";";print_space() done; if n-1 >= 0 then ppvalues (arg args (n-1)); close_box() | Zfix _ -> print_string "Zfix" | Zswitch _ -> print_string "Zswitch" | Zproj _ -> print_string "Zproj" and ppstack s = open_hovbox 0; print_string "["; List.iter (fun z -> ppzipper z;print_string " | ") s; print_string "]"; close_box() and ppatom a = match a with | Aid idk -> print_idkey idk | Asort u -> print_string "Sort(...)" | Aind(sp,i) -> print_string "Ind("; print_string (MutInd.to_string sp); print_string ","; print_int i; print_string ")" and ppwhd whd = match whd with | Vprod _ -> print_string "product" | Vfun _ -> print_string "function" | Vfix _ -> print_string "vfix" | Vcofix _ -> print_string "cofix" | Vconst i -> print_string "C(";print_int i;print_string")" | Vblock b -> ppvblock b | Vint64 i -> printf "int64(%LiL)" i | Vfloat64 f -> printf "float64(%.17g)" f | Vstring s -> printf "string(%S)" (Pstring.to_string s) | Varray t -> ppvarray t | Vaccu (a, s) -> open_hbox();ppatom a;close_box(); print_string"@";ppstack s and ppvblock b = open_hbox(); print_string "Cb(";print_int (btag b); let n = bsize b in for i = 0 to n -1 do print_string ",";ppvalues (bfield b i) done; print_string")"; close_box() and ppvarray t = let length = Parray.length_int t in open_hbox(); print_string "[|"; for i = 0 to length - 2 do ppvalues (Parray.get t (Uint63.of_int i)); print_string "; " done; ppvalues (Parray.get t (Uint63.of_int (length - 1))); print_string " | "; ppvalues (Parray.default t); print_string " |]"; close_box() and ppvalues v = open_hovbox 0;ppwhd (whd_val v);close_box(); print_flush() coq-8.20.0/dev/vm_printers.mli000066400000000000000000000020541466560755400162370ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* unit val ppsort : Sorts.t -> unit val print_idkey : Vmvalues.id_key -> unit val ppzipper : Vmvalues.zipper -> unit val ppstack : Vmvalues.stack -> unit val ppatom : Vmvalues.atom -> unit val ppwhd : Vmvalues.kind -> unit val ppvblock : Vmvalues.vblock -> unit val ppvarray : Vmvalues.values Parray.t -> unit val ppvalues : Vmvalues.values -> unit coq-8.20.0/doc/000077500000000000000000000000001466560755400131525ustar00rootroot00000000000000coq-8.20.0/doc/LICENSE000066400000000000000000000753021466560755400141660ustar00rootroot00000000000000The Coq Reference Manual is a collective work from the Coq Development Team whose members are listed in the file CREDITS of the Coq source package. All related documents (the LaTeX and BibTeX sources, the embedded png files, and the PostScript, PDF and html outputs) are copyright (c) 1999-2019, Inria, CNRS and contributors, with the exception of the Ubuntu font file UbuntuMono-B.ttf, which is Copyright 2010,2011 Canonical Ltd and licensed under the Ubuntu font license, version 1.0 (https://www.ubuntu.com/legal/terms-and-policies/font-licence), its derivative CoqNotations.ttf distributed under the same license, and the _templates/versions.html file derived from sphinx_rtd_theme, which is Copyright 2013-2018 Dave Snider, Read the Docs, Inc. & contributors and distributed under the MIT License included in that file. The material connected to the Reference Manual may be distributed only subject to the terms and conditions set forth in the Open Publication License, v1.0 or later (the latest version is presently available at http://www.opencontent.org/openpub/). Options A and B are *not* elected. The Coq Standard Library is a collective work from the Coq Development Team whose members are listed in the file CREDITS of the Coq source package. All related documents (the Coq vernacular source files and the PostScript, PDF and html outputs) are copyright (c) 1999-2019, Inria, CNRS and contributors. The material connected to the Standard Library is distributed under the terms of the Lesser General Public License version 2.1 or later. ---------------------------------------------------------------------- *Open Publication License* v1.0, 8 June 1999 *I. REQUIREMENTS ON BOTH UNMODIFIED AND MODIFIED VERSIONS* The Open Publication works may be reproduced and distributed in whole or in part, in any medium physical or electronic, provided that the terms of this license are adhered to, and that this license or an incorporation of it by reference (with any options elected by the author(s) and/or publisher) is displayed in the reproduction. Proper form for an incorporation by reference is as follows: Copyright (c) by . This material may be distributed only subject to the terms and conditions set forth in the Open Publication License, vX.Y or later (the latest version is presently available at http://www.opencontent.org/openpub/). The reference must be immediately followed with any options elected by the author(s) and/or publisher of the document (see section VI). Commercial redistribution of Open Publication-licensed material is permitted. Any publication in standard (paper) book form shall require the citation of the original publisher and author. The publisher and author's names shall appear on all outer surfaces of the book. On all outer surfaces of the book the original publisher's name shall be as large as the title of the work and cited as possessive with respect to the title. *II. COPYRIGHT* The copyright to each Open Publication is owned by its author(s) or designee. *III. SCOPE OF LICENSE* The following license terms apply to all Open Publication works, unless otherwise explicitly stated in the document. Mere aggregation of Open Publication works or a portion of an Open Publication work with other works or programs on the same media shall not cause this license to apply to those other works. The aggregate work shall contain a notice specifying the inclusion of the Open Publication material and appropriate copyright notice. SEVERABILITY. If any part of this license is found to be unenforceable in any jurisdiction, the remaining portions of the license remain in force. NO WARRANTY. Open Publication works are licensed and provided "as is" without warranty of any kind, express or implied, including, but not limited to, the implied warranties of merchantability and fitness for a particular purpose or a warranty of non-infringement. *IV. REQUIREMENTS ON MODIFIED WORKS* All modified versions of documents covered by this license, including translations, anthologies, compilations and partial documents, must meet the following requirements: 1. The modified version must be labeled as such. 2. The person making the modifications must be identified and the modifications dated. 3. Acknowledgement of the original author and publisher if applicable must be retained according to normal academic citation practices. 4. The location of the original unmodified document must be identified. 5. The original author's (or authors') name(s) may not be used to assert or imply endorsement of the resulting document without the original author's (or authors') permission. *V. GOOD-PRACTICE RECOMMENDATIONS * In addition to the requirements of this license, it is requested from and strongly recommended of redistributors that: 1. If you are distributing Open Publication works on hardcopy or CD-ROM, you provide email notification to the authors of your intent to redistribute at least thirty days before your manuscript or media freeze, to give the authors time to provide updated documents. This notification should describe modifications, if any, made to the document. 2. All substantive modifications (including deletions) be either clearly marked up in the document or else described in an attachment to the document. 3. Finally, while it is not mandatory under this license, it is considered good form to offer a free copy of any hardcopy and CD-ROM expression of an Open Publication-licensed work to its author(s). *VI. LICENSE OPTIONS* The author(s) and/or publisher of an Open Publication-licensed document may elect certain options by appending language to the reference to or copy of the license. These options are considered part of the license instance and must be included with the license (or its incorporation by reference) in derived works. A. To prohibit distribution of substantively modified versions without the explicit permission of the author(s). "Substantive modification" is defined as a change to the semantic content of the document, and excludes mere changes in format or typographical corrections. To accomplish this, add the phrase `Distribution of substantively modified versions of this document is prohibited without the explicit permission of the copyright holder.' to the license reference or copy. B. To prohibit any publication of this work or derivative works in whole or in part in standard (paper) book form for commercial purposes is prohibited unless prior permission is obtained from the copyright holder. To accomplish this, add the phrase 'Distribution of the work or derivative of the work in any standard (paper) book form is prohibited unless prior permission is obtained from the copyright holder.' to the license reference or copy. ---------------------------------------------------------------------- GNU LESSER GENERAL PUBLIC LICENSE Version 2.1, February 1999 Copyright (C) 1991, 1999 Free Software Foundation, Inc. 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA Everyone is permitted to copy and distribute verbatim copies of this license document, but changing it is not allowed. [This is the first released version of the Lesser GPL. It also counts as the successor of the GNU Library Public License, version 2, hence the version number 2.1.] Preamble The licenses for most software are designed to take away your freedom to share and change it. By contrast, the GNU General Public Licenses are intended to guarantee your freedom to share and change free software--to make sure the software is free for all its users. This license, the Lesser General Public License, applies to some specially designated software packages--typically libraries--of the Free Software Foundation and other authors who decide to use it. You can use it too, but we suggest you first think carefully about whether this license or the ordinary General Public License is the better strategy to use in any particular case, based on the explanations below. When we speak of free software, we are referring to freedom of use, not price. Our General Public Licenses are designed to make sure that you have the freedom to distribute copies of free software (and charge for this service if you wish); that you receive source code or can get it if you want it; that you can change the software and use pieces of it in new free programs; and that you are informed that you can do these things. To protect your rights, we need to make restrictions that forbid distributors to deny you these rights or to ask you to surrender these rights. These restrictions translate to certain responsibilities for you if you distribute copies of the library or if you modify it. For example, if you distribute copies of the library, whether gratis or for a fee, you must give the recipients all the rights that we gave you. You must make sure that they, too, receive or can get the source code. If you link other code with the library, you must provide complete object files to the recipients, so that they can relink them with the library after making changes to the library and recompiling it. And you must show them these terms so they know their rights. We protect your rights with a two-step method: (1) we copyright the library, and (2) we offer you this license, which gives you legal permission to copy, distribute and/or modify the library. To protect each distributor, we want to make it very clear that there is no warranty for the free library. Also, if the library is modified by someone else and passed on, the recipients should know that what they have is not the original version, so that the original author's reputation will not be affected by problems that might be introduced by others. Finally, software patents pose a constant threat to the existence of any free program. We wish to make sure that a company cannot effectively restrict the users of a free program by obtaining a restrictive license from a patent holder. Therefore, we insist that any patent license obtained for a version of the library must be consistent with the full freedom of use specified in this license. Most GNU software, including some libraries, is covered by the ordinary GNU General Public License. This license, the GNU Lesser General Public License, applies to certain designated libraries, and is quite different from the ordinary General Public License. We use this license for certain libraries in order to permit linking those libraries into non-free programs. When a program is linked with a library, whether statically or using a shared library, the combination of the two is legally speaking a combined work, a derivative of the original library. The ordinary General Public License therefore permits such linking only if the entire combination fits its criteria of freedom. The Lesser General Public License permits more lax criteria for linking other code with the library. We call this license the "Lesser" General Public License because it does Less to protect the user's freedom than the ordinary General Public License. It also provides other free software developers Less of an advantage over competing non-free programs. These disadvantages are the reason we use the ordinary General Public License for many libraries. However, the Lesser license provides advantages in certain special circumstances. For example, on rare occasions, there may be a special need to encourage the widest possible use of a certain library, so that it becomes a de-facto standard. To achieve this, non-free programs must be allowed to use the library. A more frequent case is that a free library does the same job as widely used non-free libraries. In this case, there is little to gain by limiting the free library to free software only, so we use the Lesser General Public License. In other cases, permission to use a particular library in non-free programs enables a greater number of people to use a large body of free software. For example, permission to use the GNU C Library in non-free programs enables many more people to use the whole GNU operating system, as well as its variant, the GNU/Linux operating system. Although the Lesser General Public License is Less protective of the users' freedom, it does ensure that the user of a program that is linked with the Library has the freedom and the wherewithal to run that program using a modified version of the Library. The precise terms and conditions for copying, distribution and modification follow. Pay close attention to the difference between a "work based on the library" and a "work that uses the library". The former contains code derived from the library, whereas the latter must be combined with the library in order to run. GNU LESSER GENERAL PUBLIC LICENSE TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION 0. This License Agreement applies to any software library or other program which contains a notice placed by the copyright holder or other authorized party saying it may be distributed under the terms of this Lesser General Public License (also called "this License"). Each licensee is addressed as "you". A "library" means a collection of software functions and/or data prepared so as to be conveniently linked with application programs (which use some of those functions and data) to form executables. The "Library", below, refers to any such software library or work which has been distributed under these terms. A "work based on the Library" means either the Library or any derivative work under copyright law: that is to say, a work containing the Library or a portion of it, either verbatim or with modifications and/or translated straightforwardly into another language. (Hereinafter, translation is included without limitation in the term "modification".) "Source code" for a work means the preferred form of the work for making modifications to it. For a library, complete source code means all the source code for all modules it contains, plus any associated interface definition files, plus the scripts used to control compilation and installation of the library. Activities other than copying, distribution and modification are not covered by this License; they are outside its scope. The act of running a program using the Library is not restricted, and output from such a program is covered only if its contents constitute a work based on the Library (independent of the use of the Library in a tool for writing it). Whether that is true depends on what the Library does and what the program that uses the Library does. 1. You may copy and distribute verbatim copies of the Library's complete source code as you receive it, in any medium, provided that you conspicuously and appropriately publish on each copy an appropriate copyright notice and disclaimer of warranty; keep intact all the notices that refer to this License and to the absence of any warranty; and distribute a copy of this License along with the Library. You may charge a fee for the physical act of transferring a copy, and you may at your option offer warranty protection in exchange for a fee. 2. You may modify your copy or copies of the Library or any portion of it, thus forming a work based on the Library, and copy and distribute such modifications or work under the terms of Section 1 above, provided that you also meet all of these conditions: a) The modified work must itself be a software library. b) You must cause the files modified to carry prominent notices stating that you changed the files and the date of any change. c) You must cause the whole of the work to be licensed at no charge to all third parties under the terms of this License. d) If a facility in the modified Library refers to a function or a table of data to be supplied by an application program that uses the facility, other than as an argument passed when the facility is invoked, then you must make a good faith effort to ensure that, in the event an application does not supply such function or table, the facility still operates, and performs whatever part of its purpose remains meaningful. (For example, a function in a library to compute square roots has a purpose that is entirely well-defined independent of the application. Therefore, Subsection 2d requires that any application-supplied function or table used by this function must be optional: if the application does not supply it, the square root function must still compute square roots.) These requirements apply to the modified work as a whole. If identifiable sections of that work are not derived from the Library, and can be reasonably considered independent and separate works in themselves, then this License, and its terms, do not apply to those sections when you distribute them as separate works. But when you distribute the same sections as part of a whole which is a work based on the Library, the distribution of the whole must be on the terms of this License, whose permissions for other licensees extend to the entire whole, and thus to each and every part regardless of who wrote it. Thus, it is not the intent of this section to claim rights or contest your rights to work written entirely by you; rather, the intent is to exercise the right to control the distribution of derivative or collective works based on the Library. In addition, mere aggregation of another work not based on the Library with the Library (or with a work based on the Library) on a volume of a storage or distribution medium does not bring the other work under the scope of this License. 3. You may opt to apply the terms of the ordinary GNU General Public License instead of this License to a given copy of the Library. To do this, you must alter all the notices that refer to this License, so that they refer to the ordinary GNU General Public License, version 2, instead of to this License. (If a newer version than version 2 of the ordinary GNU General Public License has appeared, then you can specify that version instead if you wish.) Do not make any other change in these notices. Once this change is made in a given copy, it is irreversible for that copy, so the ordinary GNU General Public License applies to all subsequent copies and derivative works made from that copy. This option is useful when you wish to copy part of the code of the Library into a program that is not a library. 4. You may copy and distribute the Library (or a portion or derivative of it, under Section 2) in object code or executable form under the terms of Sections 1 and 2 above provided that you accompany it with the complete corresponding machine-readable source code, which must be distributed under the terms of Sections 1 and 2 above on a medium customarily used for software interchange. If distribution of object code is made by offering access to copy from a designated place, then offering equivalent access to copy the source code from the same place satisfies the requirement to distribute the source code, even though third parties are not compelled to copy the source along with the object code. 5. A program that contains no derivative of any portion of the Library, but is designed to work with the Library by being compiled or linked with it, is called a "work that uses the Library". Such a work, in isolation, is not a derivative work of the Library, and therefore falls outside the scope of this License. However, linking a "work that uses the Library" with the Library creates an executable that is a derivative of the Library (because it contains portions of the Library), rather than a "work that uses the library". The executable is therefore covered by this License. Section 6 states terms for distribution of such executables. When a "work that uses the Library" uses material from a header file that is part of the Library, the object code for the work may be a derivative work of the Library even though the source code is not. Whether this is true is especially significant if the work can be linked without the Library, or if the work is itself a library. The threshold for this to be true is not precisely defined by law. If such an object file uses only numerical parameters, data structure layouts and accessors, and small macros and small inline functions (ten lines or less in length), then the use of the object file is unrestricted, regardless of whether it is legally a derivative work. (Executables containing this object code plus portions of the Library will still fall under Section 6.) Otherwise, if the work is a derivative of the Library, you may distribute the object code for the work under the terms of Section 6. Any executables containing that work also fall under Section 6, whether or not they are linked directly with the Library itself. 6. As an exception to the Sections above, you may also combine or link a "work that uses the Library" with the Library to produce a work containing portions of the Library, and distribute that work under terms of your choice, provided that the terms permit modification of the work for the customer's own use and reverse engineering for debugging such modifications. You must give prominent notice with each copy of the work that the Library is used in it and that the Library and its use are covered by this License. You must supply a copy of this License. If the work during execution displays copyright notices, you must include the copyright notice for the Library among them, as well as a reference directing the user to the copy of this License. Also, you must do one of these things: a) Accompany the work with the complete corresponding machine-readable source code for the Library including whatever changes were used in the work (which must be distributed under Sections 1 and 2 above); and, if the work is an executable linked with the Library, with the complete machine-readable "work that uses the Library", as object code and/or source code, so that the user can modify the Library and then relink to produce a modified executable containing the modified Library. (It is understood that the user who changes the contents of definitions files in the Library will not necessarily be able to recompile the application to use the modified definitions.) b) Use a suitable shared library mechanism for linking with the Library. A suitable mechanism is one that (1) uses at run time a copy of the library already present on the user's computer system, rather than copying library functions into the executable, and (2) will operate properly with a modified version of the library, if the user installs one, as long as the modified version is interface-compatible with the version that the work was made with. c) Accompany the work with a written offer, valid for at least three years, to give the same user the materials specified in Subsection 6a, above, for a charge no more than the cost of performing this distribution. d) If distribution of the work is made by offering access to copy from a designated place, offer equivalent access to copy the above specified materials from the same place. e) Verify that the user has already received a copy of these materials or that you have already sent this user a copy. For an executable, the required form of the "work that uses the Library" must include any data and utility programs needed for reproducing the executable from it. However, as a special exception, the materials to be distributed need not include anything that is normally distributed (in either source or binary form) with the major components (compiler, kernel, and so on) of the operating system on which the executable runs, unless that component itself accompanies the executable. It may happen that this requirement contradicts the license restrictions of other proprietary libraries that do not normally accompany the operating system. Such a contradiction means you cannot use both them and the Library together in an executable that you distribute. 7. You may place library facilities that are a work based on the Library side-by-side in a single library together with other library facilities not covered by this License, and distribute such a combined library, provided that the separate distribution of the work based on the Library and of the other library facilities is otherwise permitted, and provided that you do these two things: a) Accompany the combined library with a copy of the same work based on the Library, uncombined with any other library facilities. This must be distributed under the terms of the Sections above. b) Give prominent notice with the combined library of the fact that part of it is a work based on the Library, and explaining where to find the accompanying uncombined form of the same work. 8. You may not copy, modify, sublicense, link with, or distribute the Library except as expressly provided under this License. Any attempt otherwise to copy, modify, sublicense, link with, or distribute the Library is void, and will automatically terminate your rights under this License. However, parties who have received copies, or rights, from you under this License will not have their licenses terminated so long as such parties remain in full compliance. 9. You are not required to accept this License, since you have not signed it. However, nothing else grants you permission to modify or distribute the Library or its derivative works. These actions are prohibited by law if you do not accept this License. Therefore, by modifying or distributing the Library (or any work based on the Library), you indicate your acceptance of this License to do so, and all its terms and conditions for copying, distributing or modifying the Library or works based on it. 10. Each time you redistribute the Library (or any work based on the Library), the recipient automatically receives a license from the original licensor to copy, distribute, link with or modify the Library subject to these terms and conditions. You may not impose any further restrictions on the recipients' exercise of the rights granted herein. You are not responsible for enforcing compliance by third parties with this License. 11. If, as a consequence of a court judgment or allegation of patent infringement or for any other reason (not limited to patent issues), conditions are imposed on you (whether by court order, agreement or otherwise) that contradict the conditions of this License, they do not excuse you from the conditions of this License. If you cannot distribute so as to satisfy simultaneously your obligations under this License and any other pertinent obligations, then as a consequence you may not distribute the Library at all. For example, if a patent license would not permit royalty-free redistribution of the Library by all those who receive copies directly or indirectly through you, then the only way you could satisfy both it and this License would be to refrain entirely from distribution of the Library. If any portion of this section is held invalid or unenforceable under any particular circumstance, the balance of the section is intended to apply, and the section as a whole is intended to apply in other circumstances. It is not the purpose of this section to induce you to infringe any patents or other property right claims or to contest validity of any such claims; this section has the sole purpose of protecting the integrity of the free software distribution system which is implemented by public license practices. Many people have made generous contributions to the wide range of software distributed through that system in reliance on consistent application of that system; it is up to the author/donor to decide if he or she is willing to distribute software through any other system and a licensee cannot impose that choice. This section is intended to make thoroughly clear what is believed to be a consequence of the rest of this License. 12. If the distribution and/or use of the Library is restricted in certain countries either by patents or by copyrighted interfaces, the original copyright holder who places the Library under this License may add an explicit geographical distribution limitation excluding those countries, so that distribution is permitted only in or among countries not thus excluded. In such case, this License incorporates the limitation as if written in the body of this License. 13. The Free Software Foundation may publish revised and/or new versions of the Lesser General Public License from time to time. Such new versions will be similar in spirit to the present version, but may differ in detail to address new problems or concerns. Each version is given a distinguishing version number. If the Library specifies a version number of this License which applies to it and "any later version", you have the option of following the terms and conditions either of that version or of any later version published by the Free Software Foundation. If the Library does not specify a license version number, you may choose any version ever published by the Free Software Foundation. 14. If you wish to incorporate parts of the Library into other free programs whose distribution conditions are incompatible with these, write to the author to ask for permission. For software which is copyrighted by the Free Software Foundation, write to the Free Software Foundation; we sometimes make exceptions for this. Our decision will be guided by the two goals of preserving the free status of all derivatives of our free software and of promoting the sharing and reuse of software generally. NO WARRANTY 15. BECAUSE THE LIBRARY IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY FOR THE LIBRARY, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES PROVIDE THE LIBRARY "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE LIBRARY IS WITH YOU. SHOULD THE LIBRARY PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING, REPAIR OR CORRECTION. 16. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR REDISTRIBUTE THE LIBRARY AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE THE LIBRARY (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A FAILURE OF THE LIBRARY TO OPERATE WITH ANY OTHER SOFTWARE), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGES. END OF TERMS AND CONDITIONS coq-8.20.0/doc/Makefile.docgram000066400000000000000000000057321466560755400162340ustar00rootroot00000000000000###################################################################### # doc_grammar tool ###################################################################### DOCGRAMWARN ?= 0 ifeq ($(DOCGRAMWARN),0) DOCGRAMWARNFLAG=-no-warn else DOCGRAMWARNFLAG= endif # List mlg files explicitly to avoid ordering problems (across # different installations / make versions). DOC_MLGS := \ parsing/g_constr.mlg parsing/g_prim.mlg \ toplevel/g_toplevel.mlg \ vernac/g_proofs.mlg vernac/g_redexpr.mlg vernac/g_vernac.mlg \ plugins/btauto/g_btauto.mlg \ plugins/cc/g_congruence.mlg \ plugins/derive/g_derive.mlg \ plugins/extraction/g_extraction.mlg \ plugins/firstorder/g_ground.mlg \ plugins/funind/g_indfun.mlg \ plugins/ltac/coretactics.mlg plugins/ltac/extraargs.mlg plugins/ltac/extratactics.mlg \ plugins/ltac/g_auto.mlg plugins/ltac/g_class.mlg plugins/ltac/g_eqdecide.mlg \ plugins/ltac/g_ltac.mlg plugins/ltac/g_obligations.mlg plugins/ltac/g_rewrite.mlg \ plugins/ltac/g_tactic.mlg plugins/ltac/profile_ltac_tactics.mlg \ plugins/micromega/g_micromega.mlg plugins/micromega/g_zify.mlg \ plugins/nsatz/g_nsatz.mlg \ plugins/ring/g_ring.mlg \ plugins/rtauto/g_rtauto.mlg \ plugins/syntax/g_number_string.mlg \ plugins/ltac2/g_ltac2.mlg plugins/ltac2_ltac1/g_ltac2_ltac1.mlg DOC_EDIT_MLGS := $(wildcard doc/tools/docgram/*.edit_mlg) DOC_RSTS := $(wildcard doc/sphinx/*/*.rst) $(wildcard doc/sphinx/*/*/*.rst) REAL_DOC_MLGS := $(wildcard */*.mlg plugins/*/*.mlg) # omit SSR MLGS and chapter for now SSR_MLGS := \ plugins/ssr/ssrparser.mlg plugins/ssr/ssrtacs.mlg plugins/ssr/ssrvernac.mlg \ plugins/ssrmatching/g_ssrmatching.mlg REAL_DOC_MLGS := $(filter-out $(SSR_MLGS),$(REAL_DOC_MLGS)) SSR_RSTS := doc/sphinx/proof-engine/ssreflect-proof-language.rst DOC_RSTS := $(filter-out $(SSR_RSTS),$(DOC_RSTS)) ifneq ($(sort $(DOC_MLGS)),$(sort $(REAL_DOC_MLGS))) missing_mlgs := $(filter-out $(REAL_DOC_MLGS),$(DOC_MLGS)) extra_mlgs := $(filter-out $(DOC_MLGS),$(SSR_MLGS),$(REAL_DOC_MLGS)) $(error mlg file list mismatch in Makefile.doc: $(if $(missing_mlgs),$(missing_mlgs) not found) $(if $(extra_mlgs),$(extra_mlgs) not listed)) endif doc/tools/docgram/fullGrammar: $(DOC_GRAM) $(DOC_MLGS) $(SHOW)'DOC_GRAM' $(HIDE)$(DOC_GRAM) -short -no-warn $(DOC_MLGS) #todo: add a dependency of sphinx on updated_rsts when we're ready doc/tools/docgram/orderedGrammar doc/tools/docgram/updated_rsts: doc/tools/docgram/fullGrammar $(DOC_GRAM) $(DOC_EDIT_MLGS) $(SHOW)'DOC_GRAM_RSTS' $(HIDE)$(DOC_GRAM) $(DOCGRAMWARNFLAG) -check-cmds -check-tacs $(DOC_MLGS) $(DOC_RSTS) .PRECIOUS: doc/tools/docgram/orderedGrammar doc/tools/docgram/updated_rsts: doc/tools/docgram/orderedGrammar .PHONY: doc_gram doc_gram_verify doc_gram_rsts doc_gram: doc/tools/docgram/fullGrammar doc_gram_verify: $(DOC_GRAM) $(DOC_MLGS) $(SHOW)'DOC_GRAM_VERIFY' $(HIDE)$(DOC_GRAM) -no-warn -verify -check-cmds -check-tacs $(DOC_MLGS) $(DOC_RSTS) doc_gram_rsts: doc/tools/docgram/updated_rsts # For emacs: # Local Variables: # mode: makefile # End: coq-8.20.0/doc/README.md000066400000000000000000000104231466560755400144310ustar00rootroot00000000000000The Coq documentation ===================== The Coq documentation includes - A Reference Manual - A document presenting the Coq standard library The documentation of the latest released version is available on the Coq web site at [coq.inria.fr/documentation](http://coq.inria.fr/documentation). Additionally, you can view the reference manual for the development version at , and the documentation of the standard library for the development version at . The reference manual is written is reStructuredText and compiled using Sphinx. See [`sphinx/README.rst`](sphinx/README.rst) to learn more about the format that is used. The documentation for the standard library is generated from the `.v` source files using coqdoc. Dependencies ------------ ### HTML documentation To produce the complete documentation in HTML, you will need Coq dependencies listed in [`INSTALL.md`](../INSTALL.md). Additionally, the Sphinx-based reference manual requires Python 3, and the following Python packages: - sphinx >= 4.5.0 - sphinx_rtd_theme >= 1.0.0 - beautifulsoup4 >= 4.8.2 - antlr4-python3-runtime >= 4.7.1 & <= 4.9.3 - pexpect >= 4.6.0 - sphinxcontrib-bibtex >= 0.4.2 To install them, you should first install pip and setuptools (for instance, with `apt install python3-pip python3-setuptools` on Debian / Ubuntu) then run: pip3 install sphinx sphinx_rtd_theme beautifulsoup4 \ antlr4-python3-runtime==4.7.1 pexpect sphinxcontrib-bibtex Nix users should get the correct development environment to build the HTML documentation from Coq's [`default.nix`](../default.nix) (note this doesn't include the LaTeX packages needed to build the full documentation). You can check the dependencies using the `doc/tools/coqrst/checkdeps.py` script. ### Other formats To produce the documentation in PDF and PostScript formats, the following additional tools are required: - latex (latex2e) - pdflatex - dvips - makeindex - xelatex - latexmk All of them are part of the TexLive distribution. E.g. on Debian / Ubuntu, install them with: apt install texlive-full Or if you want to use less disk space: apt install texlive-latex-extra texlive-fonts-recommended texlive-xetex \ latexmk fonts-freefont-otf ### Setting the locale for Python Make sure that the locale is configured on your platform so that Python encodes printed messages with utf-8 rather than generating runtime exceptions for non-ascii characters. The `.UTF-8` in `export LANG=C.UTF-8` sets UTF-8 encoding. The `C` can be replaced with any supported language code. You can set the default for a Docker build with `ENV LANG C.UTF-8`. (Python may look at other environment variables to determine the locale; see the [Python documentation](https://docs.python.org/3/library/locale.html#locale.getdefaultlocale)). Compilation ----------- The current documentation targets are: - `make refman-html` Build the reference manual in HTML form into `_build/default/doc/refman-html` - `make refman-pdf` Build the reference manual in PDF form into `_build/default/doc/refman-pdf` - `make stdlib-html` Build Coq's standard library documentation into `_build/default/doc/stdlib/html` - `make apidoc` Build the ML API's documentation into `_build/default/_doc/_html` To build the Sphinx documentation without stopping at the first warning, change the value of the `SPHINXWARNOPT` variable (default is `-W`). The following will build the Sphinx documentation without stopping at the first warning, and store all the warnings in the file `/tmp/warn.log`: ``` SPHINXWARNOPT="-w/tmp/warn.log" make refman-html ``` Note that inspecting local copies of the docs may behave in unexpected ways if opening the sources with a browser (eg with `firefox _build/default/doc/refman-html/index.html`). In order to avoid this, either inspect the version generated by the CI or run a local server, for example with: ``` cd _build/default/doc/refman-html/ && python3 -m http.server ``` Installation ------------ The produced documents are stored in the described directories above, you can install them just by copying the contents to the desired directory. In the future, the `coq-doc` and `coq-stdlib` opam packages will install the documentation automatically. coq-8.20.0/doc/changelog/000077500000000000000000000000001466560755400151015ustar00rootroot00000000000000coq-8.20.0/doc/changelog/00-title.rst000066400000000000000000000001001466560755400171600ustar00rootroot00000000000000Unreleased changes ------------------ .. contents:: :local: coq-8.20.0/doc/changelog/01-kernel/000077500000000000000000000000001466560755400165775ustar00rootroot00000000000000coq-8.20.0/doc/changelog/01-kernel/00000-title.rst000066400000000000000000000000201466560755400210770ustar00rootroot00000000000000 Kernel ^^^^^^ coq-8.20.0/doc/changelog/02-specification-language/000077500000000000000000000000001466560755400217215ustar00rootroot00000000000000coq-8.20.0/doc/changelog/02-specification-language/00000-title.rst000066400000000000000000000001201466560755400242220ustar00rootroot00000000000000 Specification language, type inference ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ coq-8.20.0/doc/changelog/03-notations/000077500000000000000000000000001466560755400173375ustar00rootroot00000000000000coq-8.20.0/doc/changelog/03-notations/00000-title.rst000066400000000000000000000000261466560755400216450ustar00rootroot00000000000000 Notations ^^^^^^^^^ coq-8.20.0/doc/changelog/04-tactics/000077500000000000000000000000001466560755400167545ustar00rootroot00000000000000coq-8.20.0/doc/changelog/04-tactics/00000-title.rst000066400000000000000000000000221466560755400212560ustar00rootroot00000000000000 Tactics ^^^^^^^ coq-8.20.0/doc/changelog/05-Ltac-language/000077500000000000000000000000001466560755400177675ustar00rootroot00000000000000coq-8.20.0/doc/changelog/05-Ltac-language/00000-title.rst000066400000000000000000000000351466560755400222750ustar00rootroot00000000000000 Ltac language ^^^^^^^^^^^^^ coq-8.20.0/doc/changelog/06-Ltac2-language/000077500000000000000000000000001466560755400200525ustar00rootroot00000000000000coq-8.20.0/doc/changelog/06-Ltac2-language/00000-title.rst000066400000000000000000000000371466560755400223620ustar00rootroot00000000000000 Ltac2 language ^^^^^^^^^^^^^^ coq-8.20.0/doc/changelog/07-ssreflect/000077500000000000000000000000001466560755400173175ustar00rootroot00000000000000coq-8.20.0/doc/changelog/07-ssreflect/00000-title.rst000066400000000000000000000000261466560755400216250ustar00rootroot00000000000000 SSReflect ^^^^^^^^^ coq-8.20.0/doc/changelog/08-vernac-commands-and-options/000077500000000000000000000000001466560755400226345ustar00rootroot00000000000000coq-8.20.0/doc/changelog/08-vernac-commands-and-options/00000-title.rst000066400000000000000000000000541466560755400251430ustar00rootroot00000000000000 Commands and options ^^^^^^^^^^^^^^^^^^^^ coq-8.20.0/doc/changelog/09-cli-tools/000077500000000000000000000000001466560755400172345ustar00rootroot00000000000000coq-8.20.0/doc/changelog/09-cli-tools/00000-title.rst000066400000000000000000000000501466560755400215370ustar00rootroot00000000000000 Command-line tools ^^^^^^^^^^^^^^^^^^ coq-8.20.0/doc/changelog/10-coqide/000077500000000000000000000000001466560755400165635ustar00rootroot00000000000000coq-8.20.0/doc/changelog/10-coqide/00000-title.rst000066400000000000000000000000201466560755400210630ustar00rootroot00000000000000 CoqIDE ^^^^^^ coq-8.20.0/doc/changelog/11-standard-library/000077500000000000000000000000001466560755400205625ustar00rootroot00000000000000coq-8.20.0/doc/changelog/11-standard-library/00000-title.rst000066400000000000000000000000441466560755400230700ustar00rootroot00000000000000 Standard library ^^^^^^^^^^^^^^^^ coq-8.20.0/doc/changelog/12-infrastructure-and-dependencies/000077500000000000000000000000001466560755400235655ustar00rootroot00000000000000coq-8.20.0/doc/changelog/12-infrastructure-and-dependencies/00000-title.rst000066400000000000000000000001021466560755400260660ustar00rootroot00000000000000 Infrastructure and dependencies ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ coq-8.20.0/doc/changelog/13-extraction/000077500000000000000000000000001466560755400175025ustar00rootroot00000000000000coq-8.20.0/doc/changelog/13-extraction/00000-title.rst000066400000000000000000000000301466560755400220030ustar00rootroot00000000000000 Extraction ^^^^^^^^^^ coq-8.20.0/doc/changelog/14-misc/000077500000000000000000000000001466560755400162565ustar00rootroot00000000000000coq-8.20.0/doc/changelog/14-misc/00000-title.rst000066400000000000000000000000361466560755400205650ustar00rootroot00000000000000 Miscellaneous ^^^^^^^^^^^^^ coq-8.20.0/doc/changelog/README.md000066400000000000000000000037441466560755400163700ustar00rootroot00000000000000# Unreleased changelog # ## When to add an entry? ## All new features, user-visible changes to features, user-visible or otherwise important infrastructure changes, and important bug fixes should get a changelog entry. Compatibility-breaking changes should always get a changelog entry, which should explain what compatibility breakage is to expect. Pull requests changing the ML API in significant ways should add an entry in [`dev/doc/changes.md`](../../dev/doc/changes.md). ## How to add an entry? ## Run `./dev/tools/make-changelog.sh`: it will ask you for your PR number, and to choose among the predefined categories, and the predefined types of changes. Afterward, fill in the automatically generated entry with a short description of your change (which should describe any compatibility issues in particular). You may also add a reference to the relevant fixed issue, and credit reviewers, co-authors, and anyone who helped advance the PR. The format for changelog entries is the same as in the reference manual. In particular, you may reference the documentation you just added with `:ref:`, `:tacn:`, `:cmd:`, `:opt:`, `:token:`, etc. See the [documentation of the Sphinx format](../sphinx/README.rst) of the manual for details. Here is a summary of the structure of a changelog entry: ``` rst - **Added / Changed / Deprecated / Fixed / Removed:** Description of the changes, with possible link to :ref:`relevant-section` of the updated documentation (`#PRNUM `_, [fixes `#ISSUE1 `_ [ and `#ISSUE2 `_],] by Full Name[, with help / review of Full Name]). ``` The first line indicates the type of change. Available types come from the [Keep a Changelog 1.0.0](https://keepachangelog.com/en/1.0.0/) specification. We exclude the "Security" type for now because of the absence of a process for handling critical bugs (proof of False) as security vulnerabilities. coq-8.20.0/doc/common/000077500000000000000000000000001466560755400144425ustar00rootroot00000000000000coq-8.20.0/doc/common/macros.tex000066400000000000000000000476571466560755400164730ustar00rootroot00000000000000%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % MACROS FOR THE REFERENCE MANUAL OF COQ % %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % For commentaries (define \com as {} for the release manual) %\newcommand{\com}[1]{{\it(* #1 *)}} %\newcommand{\com}[1]{} %%OPTIONS for HACHA %\renewcommand{\cuttingunit}{section} %BEGIN LATEX \newenvironment{centerframe}% {\bgroup \dimen0=\textwidth \advance\dimen0 by -2\fboxrule \advance\dimen0 by -2\fboxsep \setbox0=\hbox\bgroup \begin{minipage}{\dimen0}% \begin{center}}% {\end{center}% \end{minipage}\egroup \centerline{\fbox{\box0}}\egroup } %END LATEX %HEVEA \newenvironment{centerframe}{\begin{center}}{\end{center}} %HEVEA \renewcommand{\vec}[1]{\mathbf{#1}} %\renewcommand{\ominus}{-} % Hevea does a good job translating these commands %\renewcommand{\oplus}{+} %\renewcommand{\otimes}{\times} %\newcommand{\land}{\wedge} %\newcommand{\lor}{\vee} %HEVEA \renewcommand{\k}[1]{#1} % \k{a} is supposed to produce a with a little stroke %HEVEA \newcommand{\phantom}[1]{\qquad} %%%%%%%%%%%%%%%%%%%%%%% % Formatting commands % %%%%%%%%%%%%%%%%%%%%%%% \newcommand{\ErrMsg}{\medskip \noindent {\bf Error message: }} \newcommand{\ErrMsgx}{\medskip \noindent {\bf Error messages: }} \newcommand{\variant}{\medskip \noindent {\bf Variant: }} \newcommand{\variants}{\medskip \noindent {\bf Variants: }} \newcommand{\SeeAlso}{\medskip \noindent {\bf See also: }} \newcommand{\Rem}{\medskip \noindent {\bf Remark: }} \newcommand{\Rems}{\medskip \noindent {\bf Remarks: }} \newcommand{\Example}{\medskip \noindent {\bf Example: }} \newcommand{\examples}{\medskip \noindent {\bf Examples: }} \newcommand{\Warning}{\medskip \noindent {\bf Warning: }} \newcommand{\Warns}{\medskip \noindent {\bf Warnings: }} \newcounter{ex} \newcommand{\firstexample}{\setcounter{ex}{1}} \newcommand{\example}[1]{ \medskip \noindent \textbf{Example \arabic{ex}: }\textit{#1} \addtocounter{ex}{1}} \newenvironment{Variant}{\variant\begin{enumerate}}{\end{enumerate}} \newenvironment{Variants}{\variants\begin{enumerate}}{\end{enumerate}} \newenvironment{ErrMsgs}{\ErrMsgx\begin{enumerate}}{\end{enumerate}} \newenvironment{Remarks}{\Rems\begin{enumerate}}{\end{enumerate}} \newenvironment{Warnings}{\Warns\begin{enumerate}}{\end{enumerate}} \newenvironment{Examples}{\medskip\noindent{\bf Examples:} \begin{enumerate}}{\end{enumerate}} %\newcommand{\bd}{\noindent\bf} %\newcommand{\sbd}{\vspace{8pt}\noindent\bf} %\newcommand{\sdoll}[1]{\begin{small}$ #1~ $\end{small}} %\newcommand{\sdollnb}[1]{\begin{small}$ #1 $\end{small}} \newcommand{\kw}[1]{\textsf{#1}} %\newcommand{\spec}[1]{\{\,#1\,\}} % Building regular expressions \newcommand{\zeroone}[1]{\mbox{\sl [}{#1}\mbox{\sl ]}} \newcommand{\zeroonelax}[1]{\mbox{\sl [}#1\mbox{\sl ]}} %\newcommand{\zeroonemany}[1]{$\{$#1$\}$*} %\newcommand{\onemany}[1]{$\{$#1$\}$+} \newcommand{\nelistnosep}[1]{{#1} \mbox{\dots} {#1}} \newcommand{\nelist}[2]{{#1} {\tt #2} \mbox{\dots} {\tt #2} {#1}} \newcommand{\sequence}[2]{{\sl [}{#1} {\tt #2} \mbox{\dots} {\tt #2} {#1}{\sl ]}} \newcommand{\nelistwithoutblank}[2]{#1{\tt #2}\mbox{\dots}{\tt #2}#1} \newcommand{\sequencewithoutblank}[2]{$[$#1{\tt #2}\mbox{\dots}{\tt #2}#1$]$} % Used for RefMan-gal %\newcommand{\ml}[1]{\hbox{\tt{#1}}} %\newcommand{\op}{\,|\,} %%%%%%%%%%%%%%%%%%%%%%%% % Trademarks and so on % %%%%%%%%%%%%%%%%%%%%%%%% \newcommand{\Coq}{\textsc{Coq}} \newcommand{\gallina}{\textsc{Gallina}} \newcommand{\Gallina}{\textsc{Gallina}} \newcommand{\CoqIDE}{\textsc{CoqIDE}} \newcommand{\ocaml}{\textsc{OCaml}} \newcommand{\camlpppp}{\textsc{Camlp5}} \newcommand{\emacs}{\textsc{GNU Emacs}} \newcommand{\ProofGeneral}{\textsc{Proof General}} \newcommand{\CIC}{\textsc{Cic}} \newcommand{\iCIC}{\textsc{Cic}} \newcommand{\FW}{\ensuremath{F_{\omega}}} \newcommand{\Program}{\textsc{Program}} \newcommand{\Russell}{\textsc{Russell}} \newcommand{\PVS}{\textsc{PVS}} %\newcommand{\bn}{{\sf BNF}} %%%%%%%%%%%%%%%%%%% % Name of tactics % %%%%%%%%%%%%%%%%%%% %\newcommand{\Natural}{\mbox{\tt Natural}} %%%%%%%%%%%%%%%%% % \rm\sl series % %%%%%%%%%%%%%%%%% \newcommand{\nterm}[1]{\textrm{\textsl{#1}}} \newcommand{\qstring}{\nterm{string}} %% New syntax specific entries \newcommand{\annotation}{\nterm{annotation}} \newcommand{\assums}{\nterm{assums}} % vernac \newcommand{\simpleassums}{\nterm{simple\_assums}} % assumptions \newcommand{\binder}{\nterm{binder}} \newcommand{\binders}{\nterm{binders}} \newcommand{\caseitems}{\nterm{match\_items}} \newcommand{\caseitem}{\nterm{match\_item}} \newcommand{\eqn}{\nterm{equation}} \newcommand{\ifitem}{\nterm{dep\_ret\_type}} \newcommand{\hyplocation}{\nterm{hyp\_location}} \newcommand{\convclause}{\nterm{conversion\_clause}} \newcommand{\occclause}{\nterm{occurrence\_clause}} \newcommand{\occgoalset}{\nterm{goal\_occurrences}} \newcommand{\atoccurrences}{\nterm{at\_occurrences}} \newcommand{\occlist}{\nterm{occurrences}} \newcommand{\params}{\nterm{params}} % vernac \newcommand{\returntype}{\nterm{return\_type}} \newcommand{\idparams}{\nterm{ident\_with\_params}} \newcommand{\statkwd}{\nterm{assertion\_keyword}} % vernac \newcommand{\termarg}{\nterm{arg}} \newcommand{\hintdef}{\nterm{hint\_definition}} \newcommand{\typecstr}{\zeroone{{\tt :}~{\term}}} \newcommand{\typecstrwithoutblank}{\zeroone{{\tt :}{\term}}} \newcommand{\typecstrtype}{\zeroone{{\tt :}~{\type}}} \newcommand{\Fwterm}{\nterm{Fwterm}} \newcommand{\Index}{\nterm{index}} \newcommand{\abbrev}{\nterm{abbreviation}} \newcommand{\atomictac}{\nterm{atomic\_tactic}} \newcommand{\bindinglist}{\nterm{bindings\_list}} \newcommand{\cast}{\nterm{cast}} \newcommand{\cofixpointbodies}{\nterm{cofix\_bodies}} \newcommand{\cofixpointbody}{\nterm{cofix\_body}} \newcommand{\commandtac}{\nterm{tactic\_invocation}} \newcommand{\constructor}{\nterm{constructor}} \newcommand{\convtactic}{\nterm{conv\_tactic}} \newcommand{\assumptionkeyword}{\nterm{assumption\_keyword}} \newcommand{\assumption}{\nterm{assumption}} \newcommand{\definition}{\nterm{definition}} \newcommand{\digit}{\nterm{digit}} \newcommand{\exteqn}{\nterm{ext\_eqn}} \newcommand{\field}{\nterm{field}} \newcommand{\fielddef}{\nterm{field\_def}} \newcommand{\firstletter}{\nterm{first\_letter}} \newcommand{\fixpg}{\nterm{fix\_pgm}} \newcommand{\fixpointbodies}{\nterm{fix\_bodies}} \newcommand{\fixpointbody}{\nterm{fix\_body}} \newcommand{\fixpoint}{\nterm{fixpoint}} \newcommand{\flag}{\nterm{flag}} \newcommand{\form}{\nterm{form}} \newcommand{\entry}{\nterm{entry}} \newcommand{\proditem}{\nterm{prod\_item}} \newcommand{\taclevel}{\nterm{tactic\_level}} \newcommand{\tacargtype}{\nterm{tactic\_argument\_type}} \newcommand{\scope}{\nterm{scope}} \newcommand{\delimkey}{\nterm{key}} \newcommand{\optscope}{\nterm{opt\_scope}} \newcommand{\declnotation}{\nterm{decl\_notation}} \newcommand{\symbolentry}{\nterm{symbol}} \newcommand{\modifiers}{\nterm{modifiers}} \newcommand{\binderinterp}{\nterm{binder\_interp}} \newcommand{\localdef}{\nterm{local\_def}} \newcommand{\localdecls}{\nterm{local\_decls}} \newcommand{\ident}{\nterm{ident}} \newcommand{\accessident}{\nterm{access\_ident}} \newcommand{\possiblybracketedident}{\nterm{possibly\_bracketed\_ident}} \newcommand{\inductivebody}{\nterm{ind\_body}} \newcommand{\inductive}{\nterm{inductive}} \newcommand{\naturalnumber}{\nterm{natural}} \newcommand{\integer}{\nterm{integer}} \newcommand{\multpattern}{\nterm{mult\_pattern}} \newcommand{\mutualcoinductive}{\nterm{mutual\_coinductive}} \newcommand{\mutualinductive}{\nterm{mutual\_inductive}} \newcommand{\nestedpattern}{\nterm{nested\_pattern}} \newcommand{\name}{\nterm{name}} \newcommand{\num}{\nterm{num}} \newcommand{\pattern}{\nterm{pattern}} % pattern for pattern-matching \newcommand{\orpattern}{\nterm{or\_pattern}} \newcommand{\intropattern}{\nterm{intro\_pattern}} \newcommand{\intropatternlist}{\nterm{intro\_pattern\_list}} \newcommand{\disjconjintropattern}{\nterm{disj\_conj\_intro\_pattern}} \newcommand{\namingintropattern}{\nterm{naming\_intro\_pattern}} \newcommand{\termpattern}{\nterm{term\_pattern}} % term with holes \newcommand{\pat}{\nterm{pat}} \newcommand{\pgs}{\nterm{pgms}} \newcommand{\pg}{\nterm{pgm}} \newcommand{\abullet}{\nterm{bullet}} %BEGIN LATEX \newcommand{\proof}{\nterm{proof}} %END LATEX %HEVEA \renewcommand{\proof}{\nterm{proof}} \newcommand{\record}{\nterm{record}} \newcommand{\recordkw}{\nterm{record\_keyword}} \newcommand{\rewrule}{\nterm{rewriting\_rule}} \newcommand{\sentence}{\nterm{sentence}} \newcommand{\simplepattern}{\nterm{simple\_pattern}} \newcommand{\sort}{\nterm{sort}} \newcommand{\specif}{\nterm{specif}} \newcommand{\assertion}{\nterm{assertion}} \newcommand{\str}{\nterm{string}} \newcommand{\subsequentletter}{\nterm{subsequent\_letter}} \newcommand{\switch}{\nterm{switch}} \newcommand{\messagetoken}{\nterm{message\_token}} \newcommand{\tac}{\nterm{tactic}} \newcommand{\terms}{\nterm{terms}} \newcommand{\term}{\nterm{term}} \newcommand{\module}{\nterm{module}} \newcommand{\modexpr}{\nterm{module\_expression}} \newcommand{\modtype}{\nterm{module\_type}} \newcommand{\onemodbinding}{\nterm{module\_binding}} \newcommand{\modbindings}{\nterm{module\_bindings}} \newcommand{\qualid}{\nterm{qualid}} \newcommand{\qualidorstring}{\nterm{qualid\_or\_string}} \newcommand{\class}{\nterm{class}} \newcommand{\dirpath}{\nterm{dirpath}} \newcommand{\typedidents}{\nterm{typed\_idents}} \newcommand{\type}{\nterm{type}} \newcommand{\vref}{\nterm{ref}} \newcommand{\zarithformula}{\nterm{zarith\_formula}} \newcommand{\zarith}{\nterm{zarith}} \newcommand{\ltac}{\mbox{${\mathcal{L}}_{tac}$}} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % \mbox{\sf } series for roman text in maths formulas % %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \newcommand{\alors}{\mbox{\textsf{then}}} \newcommand{\alter}{\mbox{\textsf{alter}}} \newcommand{\bool}{\mbox{\textsf{bool}}} \newcommand{\conc}{\mbox{\textsf{conc}}} \newcommand{\cons}{\mbox{\textsf{cons}}} \newcommand{\consf}{\mbox{\textsf{consf}}} \newcommand{\emptyf}{\mbox{\textsf{emptyf}}} \newcommand{\EqSt}{\mbox{\textsf{EqSt}}} \newcommand{\false}{\mbox{\textsf{false}}} \newcommand{\filter}{\mbox{\textsf{filter}}} \newcommand{\forest}{\mbox{\textsf{forest}}} \newcommand{\from}{\mbox{\textsf{from}}} \newcommand{\hd}{\mbox{\textsf{hd}}} \newcommand{\haslength}{\mbox{\textsf{has\_length}}} \newcommand{\length}{\mbox{\textsf{length}}} \newcommand{\haslengthA}{\mbox {\textsf{has\_length~A}}} \newcommand{\List}{\mbox{\textsf{list}}} \newcommand{\ListA}{\mbox{\textsf{list}}~\ensuremath{A}} \newcommand{\nilhl}{\mbox{\textsf{nil\_hl}}} \newcommand{\conshl}{\mbox{\textsf{cons\_hl}}} \newcommand{\nat}{\mbox{\textsf{nat}}} \newcommand{\nO}{\mbox{\textsf{O}}} \newcommand{\nS}{\mbox{\textsf{S}}} \newcommand{\node}{\mbox{\textsf{node}}} \newcommand{\Nil}{\mbox{\textsf{nil}}} \newcommand{\SProp}{\mbox{\textsf{SProp}}} \newcommand{\Prop}{\mbox{\textsf{Prop}}} \newcommand{\Set}{\mbox{\textsf{Set}}} \newcommand{\si}{\mbox{\textsf{if}}} \newcommand{\sinon}{\mbox{\textsf{else}}} \newcommand{\Str}{\mbox{\textsf{Stream}}} \newcommand{\tl}{\mbox{\textsf{tl}}} \newcommand{\tree}{\mbox{\textsf{tree}}} \newcommand{\true}{\mbox{\textsf{true}}} \newcommand{\Type}{\mbox{\textsf{Type}}} \newcommand{\unfold}{\mbox{\textsf{unfold}}} \newcommand{\zeros}{\mbox{\textsf{zeros}}} \newcommand{\even}{\mbox{\textsf{even}}} \newcommand{\odd}{\mbox{\textsf{odd}}} \newcommand{\evenO}{\mbox{\textsf{even\_O}}} \newcommand{\evenS}{\mbox{\textsf{even\_S}}} \newcommand{\oddS}{\mbox{\textsf{odd\_S}}} \newcommand{\Prod}{\mbox{\textsf{prod}}} \newcommand{\Pair}{\mbox{\textsf{pair}}} %%%%%%%%% % Misc. % %%%%%%%%% \newcommand{\T}{\texttt{T}} \newcommand{\U}{\texttt{U}} \newcommand{\real}{\textsf{Real}} \newcommand{\Data}{\textit{Data}} \newcommand{\In} {{\textbf{in }}} \newcommand{\AND} {{\textbf{and}}} \newcommand{\If}{{\textbf{if }}} \newcommand{\Else}{{\textbf{else }}} \newcommand{\Then} {{\textbf{then }}} %\newcommand{\Let}{{\textbf{let }}} % looks like this is never used \newcommand{\Where}{{\textbf{where rec }}} \newcommand{\Function}{{\textbf{function }}} \newcommand{\Rec}{{\textbf{rec }}} %\newcommand{\cn}{\centering} \newcommand{\nth}{\mbox{$^{\mbox{\scriptsize th}}$}} %%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Math commands and symbols % %%%%%%%%%%%%%%%%%%%%%%%%%%%%% \newcommand{\la}{\leftarrow} \newcommand{\ra}{\rightarrow} \newcommand{\Ra}{\Rightarrow} \newcommand{\rt}{\Rightarrow} \newcommand{\lla}{\longleftarrow} \newcommand{\lra}{\longrightarrow} \newcommand{\Llra}{\Longleftrightarrow} \newcommand{\mt}{\mapsto} \newcommand{\ov}{\overrightarrow} \newcommand{\wh}{\widehat} \newcommand{\up}{\uparrow} \newcommand{\dw}{\downarrow} \newcommand{\nr}{\nearrow} \newcommand{\se}{\searrow} \newcommand{\sw}{\swarrow} \newcommand{\nw}{\nwarrow} \newcommand{\mto}{.\;} \newcommand{\vm}[1]{\vspace{#1em}} \newcommand{\vx}[1]{\vspace{#1ex}} \newcommand{\hm}[1]{\hspace{#1em}} \newcommand{\hx}[1]{\hspace{#1ex}} \newcommand{\sm}{\mbox{ }} \newcommand{\mx}{\mbox} %\newcommand{\nq}{\neq} %\newcommand{\eq}{\equiv} \newcommand{\fa}{\forall} %\newcommand{\ex}{\exists} \newcommand{\impl}{\rightarrow} %\newcommand{\Or}{\vee} %\newcommand{\And}{\wedge} \newcommand{\ms}{\models} \newcommand{\bw}{\bigwedge} \newcommand{\ts}{\times} \newcommand{\cc}{\circ} %\newcommand{\es}{\emptyset} %\newcommand{\bs}{\backslash} \newcommand{\vd}{\vdash} %\newcommand{\lan}{{\langle }} %\newcommand{\ran}{{\rangle }} %\newcommand{\al}{\alpha} \newcommand{\bt}{\beta} %\newcommand{\io}{\iota} \newcommand{\lb}{\lambda} %\newcommand{\sg}{\sigma} %\newcommand{\sa}{\Sigma} %\newcommand{\om}{\Omega} %\newcommand{\tu}{\tau} %%%%%%%%%%%%%%%%%%%%%%%%% % Custom maths commands % %%%%%%%%%%%%%%%%%%%%%%%%% \newcommand{\sumbool}[2]{\{#1\}+\{#2\}} \newcommand{\myifthenelse}[3]{\kw{if} ~ #1 ~\kw{then} ~ #2 ~ \kw{else} ~ #3} \newcommand{\fun}[2]{\item[]{\tt {#1}}. \quad\\ #2} \newcommand{\WF}[2]{\ensuremath{{\mathcal{W\!F}}(#1)[#2]}} \newcommand{\WFTWOLINES}[2]{\ensuremath{{\mathcal{W\!F}}\begin{array}{l}(#1)\\\mbox{}[{#2}]\end{array}}} \newcommand{\WFE}[1]{\WF{E}{#1}} \newcommand{\WT}[4]{\ensuremath{#1[#2] \vdash #3 : #4}} \newcommand{\WTE}[3]{\WT{E}{#1}{#2}{#3}} \newcommand{\WTEG}[2]{\WTE{\Gamma}{#1}{#2}} \newcommand{\WTM}[3]{\WT{#1}{}{#2}{#3}} \newcommand{\WFT}[2]{\ensuremath{#1[] \vdash {\mathcal{W\!F}}(#2)}} \newcommand{\WS}[3]{\ensuremath{#1[] \vdash #2 <: #3}} \newcommand{\WSE}[2]{\WS{E}{#1}{#2}} \newcommand{\WEV}[3]{\mbox{$#1[] \vdash #2 \lra #3$}} \newcommand{\WEVT}[3]{\mbox{$#1[] \vdash #2 \lra$}\\ \mbox{$ #3$}} \newcommand{\WTRED}[5]{\mbox{$#1[#2] \vdash #3 #4 #5$}} \newcommand{\WTERED}[4]{\mbox{$E[#1] \vdash #2 #3 #4$}} \newcommand{\WTELECONV}[3]{\WTERED{#1}{#2}{\leconvert}{#3}} \newcommand{\WTEGRED}[3]{\WTERED{\Gamma}{#1}{#2}{#3}} \newcommand{\WTECONV}[3]{\WTERED{#1}{#2}{\convert}{#3}} \newcommand{\WTEGCONV}[2]{\WTERED{\Gamma}{#1}{\convert}{#2}} \newcommand{\WTEGLECONV}[2]{\WTERED{\Gamma}{#1}{\leconvert}{#2}} \newcommand{\lab}[1]{\mathit{labels}(#1)} \newcommand{\dom}[1]{\mathit{dom}(#1)} \newcommand{\CI}[2]{\mbox{$\{#1\}^{#2}$}} \newcommand{\CIP}[3]{\mbox{$\{#1\}_{#2}^{#3}$}} \newcommand{\CIPV}[1]{\CIP{#1}{I_1.. I_k}{P_1.. P_k}} \newcommand{\CIPI}[1]{\CIP{#1}{I}{P}} \newcommand{\CIF}[1]{\mbox{$\{#1\}_{f_1.. f_n}$}} %BEGIN LATEX \newcommand{\NInd}[3]{\mbox{{\sf Ind}$(\begin{array}[t]{@{}l}#2:=#3 \,)\end{array}$}} \newcommand{\Ind}[4]{\mbox{{\sf Ind}$[#2](\begin{array}[t]{@{}l@{}}#3:=#4 \,)\end{array}$}} %END LATEX %HEVEA \newcommand{\NInd}[3]{\mbox{{\sf Ind}$(#2\,:=\,#3)$}} %HEVEA \newcommand{\Ind}[4]{\mbox{{\sf Ind}$[#2](#3\,:=\,#4)$}} \newcommand{\Indp}[5]{\mbox{{\sf Ind}$_{#5}(#1)[#2](\begin{array}[t]{@{}l}#3:=#4 \,)\end{array}$}} \newcommand{\Indpstr}[6]{\mbox{{\sf Ind}$_{#5}(#1)[#2](\begin{array}[t]{@{}l}#3:=#4 \,)/{#6}\end{array}$}} \newcommand{\Def}[4]{\mbox{{\sf Def}$(#1)(#2:=#3:#4)$}} \newcommand{\Assum}[3]{\mbox{{\sf Assum}$(#1)(#2:#3)$}} \newcommand{\Match}[3]{\mbox{$<\!#1\!>\!{\mbox{\tt Match}}~#2~{\mbox{\tt with}}~#3~{\mbox{\tt end}}$}} \newcommand{\Case}[3]{\mbox{$\kw{case}(#2,#1,#3)$}} \newcommand{\match}[3]{\mbox{$\kw{match}~ #2 ~\kw{with}~ #3 ~\kw{end}$}} \newcommand{\Fix}[2]{\mbox{\tt Fix}~#1\{#2\}} \newcommand{\CoFix}[2]{\mbox{\tt CoFix}~#1\{#2\}} \newcommand{\With}[2]{\mbox{\tt ~with~}} \newcommand{\letin}[3]{\kw{let}~#1:=#2~\kw{in}~#3} \newcommand{\subst}[3]{#1\{#2/#3\}} \newcommand{\substs}[4]{#1\{(#2/#3)_{#4}\}} \newcommand{\Sort}{\mbox{$\mathcal{S}$}} \newcommand{\convert}{=_{\beta\delta\iota\zeta\eta}} \newcommand{\leconvert}{\leq_{\beta\delta\iota\zeta\eta}} \newcommand{\NN}{\mathbb{N}} \newcommand{\inference}[1]{$${#1}$$} \newcommand{\compat}[2]{\mbox{$[#1|#2]$}} \newcommand{\tristackrel}[3]{\mathrel{\mathop{#2}\limits_{#3}^{#1}}} \newcommand{\Impl}{{\it Impl}} \newcommand{\elem}{{\it e}} \newcommand{\Mod}[3]{{\sf Mod}({#1}:{#2}\,\zeroone{:={#3}})} \newcommand{\ModS}[2]{{\sf Mod}({#1}:{#2})} \newcommand{\ModType}[2]{{\sf ModType}({#1}:={#2})} \newcommand{\ModA}[2]{{\sf ModA}({#1}=={#2})} \newcommand{\functor}[3]{\ensuremath{{\sf Functor}(#1:#2)\;#3}} \newcommand{\funsig}[3]{\ensuremath{{\sf Funsig}(#1:#2)\;#3}} \newcommand{\sig}[1]{\ensuremath{{\sf Sig}~#1~{\sf End}}} \newcommand{\struct}[1]{\ensuremath{{\sf Struct}~#1~{\sf End}}} \newcommand{\structe}[1]{\ensuremath{ {\sf Struct}~\elem_1;\ldots;\elem_i;#1;\elem_{i+2};\ldots ;\elem_n~{\sf End}}} \newcommand{\structes}[2]{\ensuremath{ {\sf Struct}~\elem_1;\ldots;\elem_i;#1;\elem_{i+2}\{#2\} ;\ldots;\elem_n\{#2\}~{\sf End}}} \newcommand{\with}[3]{\ensuremath{#1~{\sf with}~#2 := #3}} \newcommand{\Spec}{{\it Spec}} \newcommand{\ModSEq}[3]{{\sf Mod}({#1}:{#2}:={#3})} %\newbox\tempa %\newbox\tempb %\newdimen\tempc %\newcommand{\mud}[1]{\hfil $\displaystyle{\mathstrut #1}$\hfil} %\newcommand{\rig}[1]{\hfil $\displaystyle{#1}$} % \newcommand{\irulehelp}[3]{\setbox\tempa=\hbox{$\displaystyle{\mathstrut #2}$}% % \setbox\tempb=\vbox{\halign{##\cr % \mud{#1}\cr % \noalign{\vskip\the\lineskip} % \noalign{\hrule height 0pt} % \rig{\vbox to 0pt{\vss\hbox to 0pt{${\; #3}$\hss}\vss}}\cr % \noalign{\hrule} % \noalign{\vskip\the\lineskip} % \mud{\copy\tempa}\cr}} % \tempc=\wd\tempb % \advance\tempc by \wd\tempa % \divide\tempc by 2 } % \newcommand{\irule}[3]{{\irulehelp{#1}{#2}{#3} % \hbox to \wd\tempa{\hss \box\tempb \hss}}} \newcommand{\sverb}[1]{{\tt #1}} \newcommand{\mover}[2]{{#1\over #2}} \newcommand{\jd}[2]{#1 \vdash #2} \newcommand{\mathline}[1]{\[#1\]} \newcommand{\zrule}[2]{#2: #1} \newcommand{\orule}[3]{#3: {\mover{#1}{#2}}} \newcommand{\trule}[4]{#4: \mover{#1 \qquad #2} {#3}} \newcommand{\thrule}[5]{#5: {\mover{#1 \qquad #2 \qquad #3}{#4}}} % placement of figures %BEGIN LATEX \renewcommand{\topfraction}{.99} \renewcommand{\bottomfraction}{.99} \renewcommand{\textfraction}{.01} \renewcommand{\floatpagefraction}{.9} %END LATEX % Macros Bruno pour description de la syntaxe \def\bfbar{\ensuremath{|\hskip -0.22em{}|\hskip -0.24em{}|}} \def\TERMbar{\bfbar} \def\TERMbarbar{\bfbar\bfbar} %% Macros pour les grammaires \def\GR#1{\text{\large(}#1\text{\large)}} \def\NT#1{\langle\textit{#1}\rangle} \def\NTL#1#2{\langle\textit{#1}\rangle_{#2}} \def\TERM#1{{\bf\textrm{\bf #1}}} %\def\TERM#1{{\bf\textsf{#1}}} \def\KWD#1{\TERM{#1}} \def\ETERM#1{\TERM{#1}} \def\CHAR#1{\TERM{#1}} \def\STAR#1{#1*} \def\STARGR#1{\GR{#1}*} \def\PLUS#1{#1+} \def\PLUSGR#1{\GR{#1}+} \def\OPT#1{#1?} \def\OPTGR#1{\GR{#1}?} %% Tableaux de definition de non-terminaux \newenvironment{cadre} {\begin{array}{|c|}\hline\\} {\\\\\hline\end{array}} \newenvironment{rulebox} {$$\begin{cadre}\begin{array}{r@{~}c@{~}l@{}l@{}r}} {\end{array}\end{cadre}$$} \def\DEFNT#1{\NT{#1} & ::= &} \def\EXTNT#1{\NT{#1} & ::= & ... \\&|&} \def\RNAME#1{(\textsc{#1})} \def\SEPDEF{\\\\} \def\nlsep{\\&|&} \def\nlcont{\\&&} \newenvironment{rules} {\begin{center}\begin{rulebox}} {\end{rulebox}\end{center}} %%% Local Variables: %%% mode: latex %%% TeX-master: "Reference-Manual" %%% End: coq-8.20.0/doc/common/styles/000077500000000000000000000000001466560755400157655ustar00rootroot00000000000000coq-8.20.0/doc/common/styles/html/000077500000000000000000000000001466560755400167315ustar00rootroot00000000000000coq-8.20.0/doc/common/styles/html/coqremote/000077500000000000000000000000001466560755400207275ustar00rootroot00000000000000coq-8.20.0/doc/common/styles/html/coqremote/cover.html000066400000000000000000000062311466560755400227350ustar00rootroot00000000000000 Reference Manual | The Coq Proof Assistant

Reference Manual

Version COQVERSION


The Coq Development Team




Copyright © 1999-2019, Inria, CNRS and contributors

This material may be distributed only subject to the terms and conditions set forth in the Open Publication License, v1.0 or later (the latest version is presently available at http://www.opencontent.org/openpub). Options A and B are not elected.

coq-8.20.0/doc/common/styles/html/coqremote/footer.html000066400000000000000000000015611466560755400231160ustar00rootroot00000000000000
coq-8.20.0/doc/common/styles/html/coqremote/header.html000066400000000000000000000034561466560755400230550ustar00rootroot00000000000000 Standard Library | The Coq Proof Assistant
coq-8.20.0/doc/common/styles/html/coqremote/hevea.css000066400000000000000000000034461466560755400225400ustar00rootroot00000000000000 .li-itemize{margin:1ex 0ex;} .li-enumerate{margin:1ex 0ex;} .dd-description{margin:0ex 0ex 1ex 4ex;} .dt-description{margin:0ex;} .toc{list-style:none;} .thefootnotes{text-align:left;margin:0ex;} .dt-thefootnotes{margin:0em;} .dd-thefootnotes{margin:0em 0em 0em 2em;} .footnoterule{margin:1em auto 1em 0px;width:50%;} .caption{padding-left:2ex; padding-right:2ex; margin-left:auto; margin-right:auto} .title{margin:2ex auto;text-align:center} .center{text-align:center;margin-left:auto;margin-right:auto;} .flushleft{text-align:left;margin-left:0ex;margin-right:auto;} .flushright{text-align:right;margin-left:auto;margin-right:0ex;} DIV TABLE{margin-left:inherit;margin-right:inherit;} PRE{text-align:left;margin-left:0ex;margin-right:auto;} BLOCKQUOTE{margin-left:4ex;margin-right:4ex;text-align:left;} TD P{margin:0px;} .boxed{border:1px solid black} .textboxed{border:1px solid black} .vbar{border:none;width:2px;background-color:black;} .hbar{border:none;height:2px;width:100%;background-color:black;} .hfill{border:none;height:1px;width:200%;background-color:black;} .vdisplay{border-collapse:separate;border-spacing:2px;width:auto; empty-cells:show; border:2px solid red;} .vdcell{white-space:nowrap;padding:0px;width:auto; border:2px solid green;} .display{border-collapse:separate;border-spacing:2px;width:auto; border:none;} .dcell{white-space:nowrap;padding:0px;width:auto; border:none;} .dcenter{margin:0ex auto;} .vdcenter{border:solid #FF8000 2px; margin:0ex auto;} .minipage{text-align:left; margin-left:0em; margin-right:auto;} .marginpar{border:solid thin black; width:20%; text-align:left;} .marginparleft{float:left; margin-left:0ex; margin-right:1ex;} .marginparright{float:right; margin-left:1ex; margin-right:0ex;} .theorem{text-align:left;margin:1ex auto 1ex 0ex;} .part{margin:2ex auto;text-align:center} coq-8.20.0/doc/common/styles/html/coqremote/modules/000077500000000000000000000000001466560755400223775ustar00rootroot00000000000000coq-8.20.0/doc/common/styles/html/coqremote/modules/node/000077500000000000000000000000001466560755400233245ustar00rootroot00000000000000coq-8.20.0/doc/common/styles/html/coqremote/modules/node/node.css000066400000000000000000000012531466560755400247640ustar00rootroot00000000000000 .node-unpublished { background-color: #fff4f4; } .preview .node { background-color: #ffffea; } #node-admin-filter ul { list-style-type: none; padding: 0; margin: 0; width: 100%; } #node-admin-buttons { float: left; /* LTR */ margin-left: 0.5em; /* LTR */ clear: right; /* LTR */ } td.revision-current { background: #ffc; } .node-form .form-text { display: block; width: 95%; } .node-form .container-inline .form-text { display: inline; width: auto; } .node-form .standard { clear: both; } .node-form textarea { display: block; width: 95%; } .node-form .attachments fieldset { float: none; display: block; } .terms-inline { display: inline; } coq-8.20.0/doc/common/styles/html/coqremote/modules/system/000077500000000000000000000000001466560755400237235ustar00rootroot00000000000000coq-8.20.0/doc/common/styles/html/coqremote/modules/system/defaults.css000066400000000000000000000012671466560755400262520ustar00rootroot00000000000000 /* ** HTML elements */ fieldset { margin-bottom: 1em; padding: .5em; } form { margin: 0; padding: 0; } hr { height: 1px; border: 1px solid gray; } img { border: 0; } table { border-collapse: collapse; } th { text-align: left; /* LTR */ padding-right: 1em; /* LTR */ border-bottom: 3px solid #ccc; } /* ** Markup free clearing ** Details: http://www.positioniseverything.net/easyclearing.html */ .clear-block:after { content: "."; display: block; height: 0; clear: both; visibility: hidden; } .clear-block { display: inline-block; } /* Hides from IE-mac \*/ * html .clear-block { height: 1%; } .clear-block { display: block; } /* End hide from IE-mac */ coq-8.20.0/doc/common/styles/html/coqremote/modules/system/system.css000066400000000000000000000233511466560755400257650ustar00rootroot00000000000000 /* ** HTML elements */ body.drag { cursor: move; } th.active img { display: inline; } tr.even, tr.odd { background-color: #eee; border-bottom: 1px solid #ccc; padding: 0.1em 0.6em; } tr.drag { background-color: #fffff0; } tr.drag-previous { background-color: #ffd; } td.active { background-color: #ddd; } td.checkbox, th.checkbox { text-align: center; } tbody { border-top: 1px solid #ccc; } tbody th { border-bottom: 1px solid #ccc; } thead th { text-align: left; /* LTR */ padding-right: 1em; /* LTR */ border-bottom: 3px solid #ccc; } /* ** Other common styles */ .breadcrumb { padding-bottom: .5em } div.indentation { width: 20px; height: 1.7em; margin: -0.4em 0.2em -0.4em -0.4em; /* LTR */ padding: 0.42em 0 0.42em 0.6em; /* LTR */ float: left; /* LTR */ } div.tree-child { background: url(../../misc/tree.png) no-repeat 11px center; /* LTR */ } div.tree-child-last { background: url(../../misc/tree-bottom.png) no-repeat 11px center; /* LTR */ } div.tree-child-horizontal { background: url(../../misc/tree.png) no-repeat -11px center; } .error { color: #e55; } div.error { border: 1px solid #d77; } div.error, tr.error { background: #fcc; color: #200; padding: 2px; } .warning { color: #e09010; } div.warning { border: 1px solid #f0c020; } div.warning, tr.warning { background: #ffd; color: #220; padding: 2px; } .ok { color: #008000; } div.ok { border: 1px solid #00aa00; } div.ok, tr.ok { background: #dfd; color: #020; padding: 2px; } .item-list .icon { color: #555; float: right; /* LTR */ padding-left: 0.25em; /* LTR */ clear: right; /* LTR */ } .item-list .title { font-weight: bold; } .item-list ul { margin: 0 0 0.75em 0; padding: 0; } .item-list ul li { margin: 0 0 0.25em 1.5em; /* LTR */ padding: 0; list-style: disc; } ol.task-list li.active { font-weight: bold; } .form-item { margin-top: 1em; margin-bottom: 1em; } tr.odd .form-item, tr.even .form-item { margin-top: 0; margin-bottom: 0; white-space: nowrap; } tr.merge-down, tr.merge-down td, tr.merge-down th { border-bottom-width: 0 !important; } tr.merge-up, tr.merge-up td, tr.merge-up th { border-top-width: 0 !important; } .form-item input.error, .form-item textarea.error, .form-item select.error { border: 2px solid red; } .form-item .description { font-size: 0.85em; } .form-item label { display: block; font-weight: bold; } .form-item label.option { display: inline; font-weight: normal; } .form-checkboxes, .form-radios { margin: 1em 0; } .form-checkboxes .form-item, .form-radios .form-item { margin-top: 0.4em; margin-bottom: 0.4em; } .marker, .form-required { color: #f00; } .more-link { text-align: right; /* LTR */ } .more-help-link { font-size: 0.85em; text-align: right; /* LTR */ } .nowrap { white-space: nowrap; } .item-list .pager { clear: both; text-align: center; } .item-list .pager li { background-image:none; display:inline; list-style-type:none; padding: 0.5em; } .pager-current { font-weight:bold; } .tips { margin-top: 0; margin-bottom: 0; padding-top: 0; padding-bottom: 0; font-size: 0.9em; } dl.multiselect dd.b, dl.multiselect dd.b .form-item, dl.multiselect dd.b select { font-family: inherit; font-size: inherit; width: 14em; } dl.multiselect dd.a, dl.multiselect dd.a .form-item { width: 10em; } dl.multiselect dt, dl.multiselect dd { float: left; /* LTR */ line-height: 1.75em; padding: 0; margin: 0 1em 0 0; /* LTR */ } dl.multiselect .form-item { height: 1.75em; margin: 0; } /* ** Inline items (need to override above) */ .container-inline div, .container-inline label { display: inline; } /* ** Tab navigation */ ul.primary { border-collapse: collapse; padding: 0 0 0 1em; /* LTR */ white-space: nowrap; list-style: none; margin: 5px; height: auto; line-height: normal; border-bottom: 1px solid #bbb; } ul.primary li { display: inline; } ul.primary li a { background-color: #ddd; border-color: #bbb; border-width: 1px; border-style: solid solid none solid; height: auto; margin-right: 0.5em; /* LTR */ padding: 0 1em; text-decoration: none; } ul.primary li.active a { background-color: #fff; border: 1px solid #bbb; border-bottom: #fff 1px solid; } ul.primary li a:hover { background-color: #eee; border-color: #ccc; border-bottom-color: #eee; } ul.secondary { border-bottom: 1px solid #bbb; padding: 0.5em 1em; margin: 5px; } ul.secondary li { display: inline; padding: 0 1em; border-right: 1px solid #ccc; /* LTR */ } ul.secondary a { padding: 0; text-decoration: none; } ul.secondary a.active { border-bottom: 4px solid #999; } /* ** Autocomplete styles */ /* Suggestion list */ #autocomplete { position: absolute; border: 1px solid; overflow: hidden; z-index: 100; } #autocomplete ul { margin: 0; padding: 0; list-style: none; } #autocomplete li { background: #fff; color: #000; white-space: pre; cursor: default; } #autocomplete li.selected { background: #0072b9; color: #fff; } /* Animated throbber */ html.js input.form-autocomplete { background-image: url(../../misc/throbber.gif); background-repeat: no-repeat; background-position: 100% 2px; /* LTR */ } html.js input.throbbing { background-position: 100% -18px; /* LTR */ } /* ** Collapsing fieldsets */ html.js fieldset.collapsed { border-bottom-width: 0; border-left-width: 0; border-right-width: 0; margin-bottom: 0; height: 1em; } html.js fieldset.collapsed * { display: none; } html.js fieldset.collapsed legend { display: block; } html.js fieldset.collapsible legend a { padding-left: 15px; /* LTR */ background: url(../../misc/menu-expanded.png) 5px 75% no-repeat; /* LTR */ } html.js fieldset.collapsed legend a { background-image: url(../../misc/menu-collapsed.png); /* LTR */ background-position: 5px 50%; /* LTR */ } /* Note: IE-only fix due to '* html' (breaks Konqueror otherwise). */ * html.js fieldset.collapsed legend, * html.js fieldset.collapsed legend *, * html.js fieldset.collapsed table * { display: inline; } /* For Safari 2 to prevent collapsible fieldsets containing tables from disappearing due to tableheader.js. */ html.js fieldset.collapsible { position: relative; } html.js fieldset.collapsible legend a { display: block; } /* Avoid jumping around due to margins collapsing into collapsible fieldset border */ html.js fieldset.collapsible .fieldset-wrapper { overflow: auto; } /* ** Resizable text areas */ .resizable-textarea { width: 95%; } .resizable-textarea .grippie { height: 9px; overflow: hidden; background: #eee url(../../misc/grippie.png) no-repeat center 2px; border: 1px solid #ddd; border-top-width: 0; cursor: s-resize; } html.js .resizable-textarea textarea { margin-bottom: 0; width: 100%; display: block; } /* ** Table drag and drop. */ .draggable a.tabledrag-handle { cursor: move; float: left; /* LTR */ height: 1.7em; margin: -0.4em 0 -0.4em -0.5em; /* LTR */ padding: 0.42em 1.5em 0.42em 0.5em; /* LTR */ text-decoration: none; } a.tabledrag-handle:hover { text-decoration: none; } a.tabledrag-handle .handle { margin-top: 4px; height: 13px; width: 13px; background: url(../../misc/draggable.png) no-repeat 0 0; } a.tabledrag-handle-hover .handle { background-position: 0 -20px; } /* ** Teaser splitter */ .joined + .grippie { height: 5px; background-position: center 1px; margin-bottom: -2px; } /* Keeps inner content contained in Opera 9. */ .teaser-checkbox { padding-top: 1px; } div.teaser-button-wrapper { float: right; /* LTR */ padding-right: 5%; /* LTR */ margin: 0; } .teaser-checkbox div.form-item { float: right; /* LTR */ margin: 0 5% 0 0; /* LTR */ padding: 0; } textarea.teaser { display: none; } html.js .no-js { display: none; } /* ** Progressbar styles */ .progress { font-weight: bold; } .progress .bar { background: #fff url(../../misc/progress.gif); border: 1px solid #00375a; height: 1.5em; margin: 0 0.2em; } .progress .filled { background: #0072b9; height: 1em; border-bottom: 0.5em solid #004a73; width: 0%; } .progress .percentage { float: right; /* LTR */ } .progress-disabled { float: left; /* LTR */ } .ahah-progress { float: left; /* LTR */ } .ahah-progress .throbber { width: 15px; height: 15px; margin: 2px; background: transparent url(../../misc/throbber.gif) no-repeat 0px -18px; float: left; /* LTR */ } tr .ahah-progress .throbber { margin: 0 2px; } .ahah-progress-bar { width: 16em; } /* ** Formatting for welcome page */ #first-time strong { display: block; padding: 1.5em 0 .5em; } /* ** To be used with tableselect.js */ tr.selected td { background: #ffc; } /* ** Floating header for tableheader.js */ table.sticky-header { margin-top: 0; background: #fff; } /* ** Installation clean URLs */ #clean-url.install { display: none; } /* ** For anything you want to hide on page load when JS is enabled, so ** that you can use the JS to control visibility and avoid flicker. */ html.js .js-hide { display: none; } /* ** Styles for the system modules page (admin/build/modules) */ #system-modules div.incompatible { font-weight: bold; } /* ** Styles for the system themes page (admin/build/themes) */ #system-themes-form div.incompatible { font-weight: bold; } /* ** Password strength indicator */ span.password-strength { visibility: hidden; } input.password-field { margin-right: 10px; /* LTR */ } div.password-description { padding: 0 2px; margin: 4px 0 0 0; font-size: 0.85em; max-width: 500px; } div.password-description ul { margin-bottom: 0; } .password-parent { margin: 0 0 0 0; } /* ** Password confirmation checker */ input.password-confirm { margin-right: 10px; /* LTR */ } .confirm-parent { margin: 5px 0 0 0; } span.password-confirm { visibility: hidden; } span.password-confirm span { font-weight: normal; } coq-8.20.0/doc/common/styles/html/coqremote/modules/user/000077500000000000000000000000001466560755400233555ustar00rootroot00000000000000coq-8.20.0/doc/common/styles/html/coqremote/modules/user/user.css000066400000000000000000000020531466560755400250450ustar00rootroot00000000000000 #permissions td.module { font-weight: bold; } #permissions td.permission { padding-left: 1.5em; /* LTR */ } #access-rules .access-type, #access-rules .rule-type { margin-right: 1em; /* LTR */ float: left; /* LTR */ } #access-rules .access-type .form-item, #access-rules .rule-type .form-item { margin-top: 0; } #access-rules .mask { clear: both; } #user-login-form { text-align: center; } #user-admin-filter ul { list-style-type: none; padding: 0; margin: 0; width: 100%; } #user-admin-buttons { float: left; /* LTR */ margin-left: 0.5em; /* LTR */ clear: right; /* LTR */ } #user-admin-settings fieldset .description { font-size: 0.85em; padding-bottom: .5em; } /* Generated by user.module but used by profile.module: */ .profile { clear: both; margin: 1em 0; } .profile .picture { float: right; /* LTR */ margin: 0 1em 1em 0; /* LTR */ } .profile h3 { border-bottom: 1px solid #ccc; } .profile dl { margin: 0 0 1.5em 0; } .profile dt { margin: 0 0 0.2em 0; font-weight: bold; } .profile dd { margin: 0 0 1em 0; } coq-8.20.0/doc/common/styles/html/coqremote/styles.hva000066400000000000000000000047561466560755400227660ustar00rootroot00000000000000\renewcommand{\@meta}{ \begin{rawhtml} \end{rawhtml}} % for HeVeA \htmlhead{\begin{rawhtml} \end{rawhtml}} coq-8.20.0/doc/common/styles/html/simple/000077500000000000000000000000001466560755400202225ustar00rootroot00000000000000coq-8.20.0/doc/common/styles/html/simple/cover.html000066400000000000000000000033141466560755400222270ustar00rootroot00000000000000 Reference Manual | The Coq Proof Assistant

Reference Manual

Version COQVERSION


The Coq Development Team




Copyright © 1999-2019, Inria, CNRS and contributors

This material may be distributed only subject to the terms and conditions set forth in the Open Publication License, v1.0 or later (the latest version is presently available at http://www.opencontent.org/openpub). Options A and B are not elected.

coq-8.20.0/doc/common/styles/html/simple/footer.html000066400000000000000000000000201466560755400223760ustar00rootroot00000000000000 coq-8.20.0/doc/common/styles/html/simple/header.html000066400000000000000000000005761466560755400223500ustar00rootroot00000000000000 The Coq Standard Library coq-8.20.0/doc/common/styles/html/simple/hevea.css000066400000000000000000000034461466560755400220330ustar00rootroot00000000000000 .li-itemize{margin:1ex 0ex;} .li-enumerate{margin:1ex 0ex;} .dd-description{margin:0ex 0ex 1ex 4ex;} .dt-description{margin:0ex;} .toc{list-style:none;} .thefootnotes{text-align:left;margin:0ex;} .dt-thefootnotes{margin:0em;} .dd-thefootnotes{margin:0em 0em 0em 2em;} .footnoterule{margin:1em auto 1em 0px;width:50%;} .caption{padding-left:2ex; padding-right:2ex; margin-left:auto; margin-right:auto} .title{margin:2ex auto;text-align:center} .center{text-align:center;margin-left:auto;margin-right:auto;} .flushleft{text-align:left;margin-left:0ex;margin-right:auto;} .flushright{text-align:right;margin-left:auto;margin-right:0ex;} DIV TABLE{margin-left:inherit;margin-right:inherit;} PRE{text-align:left;margin-left:0ex;margin-right:auto;} BLOCKQUOTE{margin-left:4ex;margin-right:4ex;text-align:left;} TD P{margin:0px;} .boxed{border:1px solid black} .textboxed{border:1px solid black} .vbar{border:none;width:2px;background-color:black;} .hbar{border:none;height:2px;width:100%;background-color:black;} .hfill{border:none;height:1px;width:200%;background-color:black;} .vdisplay{border-collapse:separate;border-spacing:2px;width:auto; empty-cells:show; border:2px solid red;} .vdcell{white-space:nowrap;padding:0px;width:auto; border:2px solid green;} .display{border-collapse:separate;border-spacing:2px;width:auto; border:none;} .dcell{white-space:nowrap;padding:0px;width:auto; border:none;} .dcenter{margin:0ex auto;} .vdcenter{border:solid #FF8000 2px; margin:0ex auto;} .minipage{text-align:left; margin-left:0em; margin-right:auto;} .marginpar{border:solid thin black; width:20%; text-align:left;} .marginparleft{float:left; margin-left:0ex; margin-right:1ex;} .marginparright{float:right; margin-left:1ex; margin-right:0ex;} .theorem{text-align:left;margin:1ex auto 1ex 0ex;} .part{margin:2ex auto;text-align:center} coq-8.20.0/doc/common/styles/html/simple/style.css000066400000000000000000000003061466560755400220730ustar00rootroot00000000000000#footer { border-top: solid black 1pt; text-align: center; text-indent: 0pt; } .menu { } .menu li { display: inline; margin: 0pt; padding: .5ex 1em; list-style: none } coq-8.20.0/doc/common/styles/html/simple/styles.hva000066400000000000000000000017211466560755400222460ustar00rootroot00000000000000\renewcommand{\@meta}{ \begin{rawhtml} \end{rawhtml}} % for HeVeA \htmlhead{\begin{rawhtml}
\end{rawhtml}} \htmlfoot{\begin{rawhtml}
\end{rawhtml}} coq-8.20.0/doc/common/title.tex000066400000000000000000000026611466560755400163120ustar00rootroot00000000000000%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % File title.tex % Page formatting commands % Macro \coverpage %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %\setlength{\marginparwidth}{0pt} %\setlength{\oddsidemargin}{0pt} %\setlength{\evensidemargin}{0pt} %\setlength{\marginparsep}{0pt} %\setlength{\topmargin}{0pt} %\setlength{\textwidth}{16.9cm} %\setlength{\textheight}{22cm} %\usepackage{fullpage} %\newcommand{\printingdate}{\today} %\newcommand{\isdraft}{\Large\bf\today\\[20pt]} %\newcommand{\isdraft}{\vspace{20pt}} \newcommand{\coverpage}[3]{ \thispagestyle{empty} \begin{center} \bfseries % for the rest of this page, until \end{center} \Huge The Coq Proof Assistant\\[12pt] #1\\[20pt] \Large\today\\[20pt] Version \coqversion\footnote[1]{This research was partly supported by IST working group ``Types''} \vspace{0pt plus .5fill} #2 \par\vfill $\pi r^2$ Project (formerly LogiCal, then TypiCal) \vspace*{15pt} \end{center} \newpage \thispagestyle{empty} \hbox{}\vfill % without \hbox \vfill does not work at the top of the page \begin{flushleft} %BEGIN LATEX V\coqversion, \today \par\vspace{20pt} %END LATEX \copyright 1999-2019, Inria, CNRS and contributors #3 \end{flushleft} } % end of \coverpage definition % \newcommand{\shorttitle}[1]{ % \begin{center} % \begin{huge} % \begin{bf} % The Coq Proof Assistant\\ % \vspace{10pt} % #1\\ % \end{bf} % \end{huge} % \end{center} % \vspace{5pt} % } % Local Variables: % mode: LaTeX % TeX-master: "" % End: coq-8.20.0/doc/dune000066400000000000000000000033451466560755400140350ustar00rootroot00000000000000(rule (targets unreleased.rst) (deps (source_tree changelog)) (action (with-stdout-to %{targets} (bash "cat changelog/00-title.rst changelog/*/*.rst")))) (alias (name refman-deps) (deps ; We could use finer dependencies here so the build is faster: ; ; - vo files: generated by sphinx after parsing the doc, promoted, ; - Static files: ; + %{bin:coqdoc} etc... ; + config/coq_config.py ; + tools/coqdoc/coqdoc.css (package coq-core) (package coq-stdlib) (source_tree sphinx) (source_tree tools/coqrst) unreleased.rst (env_var SPHINXWARNOPT))) (rule (targets (dir refman-html)) (alias refman-html) (package coq-doc) ; Cannot use this deps alias because of ocaml/dune#3415 ; (deps (alias refman-deps)) ; EJGA: note this should've been fixed in dune master as of 05/03/2021 (deps (package coq-core) (package coq-stdlib) (source_tree sphinx) (source_tree tools/coqrst) ../config/coq_config.py unreleased.rst (env_var SPHINXWARNOPT)) (action (run env sphinx-build -q %{env:SPHINXWARNOPT=-W} -b html sphinx %{targets}))) (rule (targets (dir refman-pdf)) (alias refman-pdf) (package coq-doc) ; Cannot use this deps alias because of ocaml/dune#3415 ; (deps (alias refman-deps)) ; EJGA: note this should've been fixed in dune master as of 05/03/2021 (deps (package coq-core) (package coq-stdlib) (source_tree sphinx) (source_tree tools/coqrst) unreleased.rst (env_var SPHINXWARNOPT)) (action (progn (run env sphinx-build -q %{env:SPHINXWARNOPT=-W} -b latex sphinx %{targets}) (chdir %{targets} (run make LATEXMKOPTS=-silent))))) (install (dirs (refman-html as html/refman) (refman-pdf as pdf/refman)) (section doc) (package coq-doc)) (documentation (package coq-doc)) coq-8.20.0/doc/index.mld000066400000000000000000000001641466560755400147600ustar00rootroot00000000000000{0 coq-doc } The coq-doc package only contains user documentation on the Coq proof assistant and no OCaml library. coq-8.20.0/doc/plugin_tutorial/000077500000000000000000000000001466560755400163735ustar00rootroot00000000000000coq-8.20.0/doc/plugin_tutorial/LICENSE000066400000000000000000000022721466560755400174030ustar00rootroot00000000000000This is free and unencumbered software released into the public domain. Anyone is free to copy, modify, publish, use, compile, sell, or distribute this software, either in source code form or as a compiled binary, for any purpose, commercial or non-commercial, and by any means. In jurisdictions that recognize copyright laws, the author or authors of this software dedicate any and all copyright interest in the software to the public domain. We make this dedication for the benefit of the public at large and to the detriment of our heirs and successors. We intend this dedication to be an overt act of relinquishment in perpetuity of all present and future rights to this software under copyright law. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. For more information, please refer to coq-8.20.0/doc/plugin_tutorial/Makefile000066400000000000000000000003451466560755400200350ustar00rootroot00000000000000 TUTOS:= \ tuto0 \ tuto1 \ tuto2 \ tuto3 all: $(TUTOS) .PHONY: $(TUTOS) all $(TUTOS): %: +$(MAKE) -C $@ CLEANS:=$(addsuffix -clean, $(TUTOS)) .PHONY: clean $(CLEANS) clean: $(CLEANS) %-clean: +$(MAKE) -C $* clean coq-8.20.0/doc/plugin_tutorial/README.md000066400000000000000000000072231466560755400176560ustar00rootroot00000000000000How to write plugins in Coq =========================== # Working environment In addition to installing OCaml and Coq, you need to make sure that you also have the development headers for Coq, because you will need them to compile extensions. If you installed Coq from source or from [OPAM](http://opam.ocaml.org/doc/Install.html), you already have the required headers. If you installed them from your system package manager, there may be a separate package which contains the development headers (for example, in Ubuntu they are contained in the package `libcoq-ocaml-dev`). It can help to install several tools for development. ## Tuareg and Merlin These instructions use [OPAM](http://opam.ocaml.org/doc/Install.html) ```shell opam install merlin # prints instructions for vim and emacs opam install tuareg # syntax highlighting for OCaml opam user-setup install # automatically configures editors for merlin ``` Adding this line to your .emacs helps Tuareg recognize the .mlg extension: ```shell (add-to-list 'auto-mode-alist '("\\.mlg$" . tuareg-mode) t) ``` If you are using [vscoq](https://github.com/coq-community/vscoq), you will need to ensure that vscoq loads the `_CoqProject` file for the extension you are working on. You can do this by opening Visual Studio Code with the `_CoqProject` file in the project root directory, or by editing the `coqtop.coqProjectRoot` setting for vscoq. ## This tutorial ```shell cd plugin_tutorials/tuto0 make .merlin # run before opening .ml files in your editor make # build ``` # tuto0 : basics of project organization package an mlg file in a plugin, organize a `Makefile`, `_CoqProject` - Example of syntax to add a new toplevel command - Example of function call to print a simple message - Example of function call to print a simple warning - Example of function call to raise a simple error to the user - Example of syntax to add a simple tactic (that does nothing and prints a message) - To use it: ```bash cd tuto0; make coqtop -I src -R theories Tuto0 ``` In the Coq session type: ```coq Require Import Tuto0.Loader. HelloWorld. ``` You can also modify and run `theories/Demo.v`. # tuto1 : OCaml to Coq communication Explore the memory of Coq, modify it - Commands that take arguments: strings, integers, symbols, expressions of the calculus of constructions - Examples of using environments correctly - Examples of using state (the evar_map) correctly - Commands that interact with type-checking in Coq - A command that checks convertibility between two terms - A command that adds a new definition or theorem - A command that uses a name and exploits the existing definitions or theorems - A command that exploits an existing ongoing proof - A command that defines a new tactic Compilation and loading must be performed as for `tuto0`. # tuto2 : OCaml to Coq communication A more step by step introduction to writing commands - Explanation of the syntax of entries - Adding a new type to and parsing to the available choices - Handling commands that store information in user-chosen registers and tables Compilation and loading must be performed as for `tuto0`. # tuto3 : manipulating terms of the calculus of constructions Manipulating terms, inside commands and tactics. - Obtaining existing values from memory - Composing values - Verifying types - Using these terms in commands - Using these terms in tactics - Automatic proofs without tactics using type classes and canonical structures compilation and loading must be performed as for `tuto0`. coq-8.20.0/doc/plugin_tutorial/dune000066400000000000000000000004711466560755400172530ustar00rootroot00000000000000; We get a super bizarre error here... ; (rule ; (alias plugin-tutorial) ; (deps ; (source_tree .) ; (package coq-core) ; ../../tools/CoqMakefile.in ; ../../theories/Init/Prelude.vo) ; (action ; (bash "make COQCORELIB=$(pwd)/../../ COQLIB=$(pwd)/../../"))) (env (dev (flags :standard -w -70))) coq-8.20.0/doc/plugin_tutorial/tuto0/000077500000000000000000000000001466560755400174465ustar00rootroot00000000000000coq-8.20.0/doc/plugin_tutorial/tuto0/Makefile000066400000000000000000000003741466560755400211120ustar00rootroot00000000000000ifeq "$(COQBIN)" "" COQBIN=$(dir $(shell which coqtop))/ endif %: Makefile.coq Makefile.coq: _CoqProject $(COQBIN)coq_makefile -f _CoqProject -o Makefile.coq tests: all @$(MAKE) -C tests -s clean @$(MAKE) -C tests -s all -include Makefile.coq coq-8.20.0/doc/plugin_tutorial/tuto0/_CoqProject000066400000000000000000000002501466560755400215760ustar00rootroot00000000000000src/META.coq-plugin-tutorial -R theories/ Tuto0 -I src theories/Loader.v theories/Demo.v src/tuto0_main.ml src/tuto0_main.mli src/g_tuto0.mlg src/tuto0_plugin.mlpack coq-8.20.0/doc/plugin_tutorial/tuto0/src/000077500000000000000000000000001466560755400202355ustar00rootroot00000000000000coq-8.20.0/doc/plugin_tutorial/tuto0/src/META.coq-plugin-tutorial000066400000000000000000000004661466560755400246320ustar00rootroot00000000000000package "tuto0" ( directory = "." version = "dev" description = "A tuto0 plugin" requires = "coq-core.plugins.ltac" archive(byte) = "tuto0_plugin.cma" archive(native) = "tuto0_plugin.cmxa" plugin(byte) = "tuto0_plugin.cma" plugin(native) = "tuto0_plugin.cmxs" ) directory = "." coq-8.20.0/doc/plugin_tutorial/tuto0/src/dune000066400000000000000000000002121466560755400211060ustar00rootroot00000000000000(library (name tuto0_plugin) (public_name coq-core.plugins.tutorial.p0) (libraries coq-core.plugins.ltac)) (coq.pp (modules g_tuto0)) coq-8.20.0/doc/plugin_tutorial/tuto0/src/g_tuto0.mlg000066400000000000000000000032761466560755400223270ustar00rootroot00000000000000DECLARE PLUGIN "coq-plugin-tutorial.tuto0" { open Pp open Ltac_plugin let cat = CWarnings.create_category ~name:"plugin-tuto-cat" () let tuto_warn = CWarnings.create ~name:"name" ~category:cat (fun _ -> strbrk Tuto0_main.message) } (*** Printing messages ***) (* * This defines a command that prints HelloWorld. * Note that Feedback.msg_notice can be used to print messages. *) VERNAC COMMAND EXTEND HelloWorld CLASSIFIED AS QUERY | [ "HelloWorld" ] -> { Feedback.msg_notice (strbrk Tuto0_main.message) } END (* * This is a tactic version of the same thing. *) TACTIC EXTEND hello_world_tactic | [ "hello_world" ] -> { let _ = Feedback.msg_notice (str Tuto0_main.message) in Tacticals.tclIDTAC } END (*** Printing warnings ***) (* * This defines a command that prints HelloWorld as a warning. * tuto_warn is defined at the top-level, before the command runs, * which is standard. *) VERNAC COMMAND EXTEND HelloWarning CLASSIFIED AS QUERY | [ "HelloWarning" ] -> { tuto_warn () } END (* * This is a tactic version of the same thing. *) TACTIC EXTEND hello_warning_tactic | [ "hello_warning" ] -> { let _ = tuto_warn () in Tacticals.tclIDTAC } END (*** Printing errors ***) (* * This defines a command that prints HelloWorld inside of an error. * Note that CErrors.user_err can be used to raise errors to the user. *) VERNAC COMMAND EXTEND HelloError CLASSIFIED AS QUERY | [ "HelloError" ] -> { CErrors.user_err (str Tuto0_main.message) } END (* * This is a tactic version of the same thing. *) TACTIC EXTEND hello_error_tactic | [ "hello_error" ] -> { let _ = CErrors.user_err (str Tuto0_main.message) in Tacticals.tclIDTAC } END coq-8.20.0/doc/plugin_tutorial/tuto0/src/tuto0_main.ml000066400000000000000000000000351466560755400226440ustar00rootroot00000000000000let message = "Hello world!" coq-8.20.0/doc/plugin_tutorial/tuto0/src/tuto0_main.mli000066400000000000000000000000251466560755400230140ustar00rootroot00000000000000val message : string coq-8.20.0/doc/plugin_tutorial/tuto0/src/tuto0_plugin.mlpack000066400000000000000000000000231466560755400240520ustar00rootroot00000000000000Tuto0_main G_tuto0 coq-8.20.0/doc/plugin_tutorial/tuto0/theories/000077500000000000000000000000001466560755400212705ustar00rootroot00000000000000coq-8.20.0/doc/plugin_tutorial/tuto0/theories/Demo.v000066400000000000000000000004721466560755400223460ustar00rootroot00000000000000From Tuto0 Require Import Loader. (*** Printing messages ***) HelloWorld. Lemma test : True. Proof. hello_world. Abort. (*** Printing warnings ***) HelloWarning. Lemma test : True. Proof. hello_warning. Abort. (*** Signaling errors ***) Fail HelloError. Lemma test : True. Proof. Fail hello_error. Abort. coq-8.20.0/doc/plugin_tutorial/tuto0/theories/Loader.v000066400000000000000000000000571466560755400226670ustar00rootroot00000000000000Declare ML Module "coq-plugin-tutorial.tuto0". coq-8.20.0/doc/plugin_tutorial/tuto1/000077500000000000000000000000001466560755400174475ustar00rootroot00000000000000coq-8.20.0/doc/plugin_tutorial/tuto1/Makefile000066400000000000000000000003741466560755400211130ustar00rootroot00000000000000ifeq "$(COQBIN)" "" COQBIN=$(dir $(shell which coqtop))/ endif %: Makefile.coq Makefile.coq: _CoqProject $(COQBIN)coq_makefile -f _CoqProject -o Makefile.coq tests: all @$(MAKE) -C tests -s clean @$(MAKE) -C tests -s all -include Makefile.coq coq-8.20.0/doc/plugin_tutorial/tuto1/_CoqProject000066400000000000000000000004441466560755400216040ustar00rootroot00000000000000src/META.coq-plugin-tutorial -R theories Tuto1 -I src theories/Loader.v theories/Demo.v src/inspector.mli src/inspector.ml src/simple_check.mli src/simple_check.ml src/simple_declare.mli src/simple_declare.ml src/simple_print.ml src/simple_print.mli src/g_tuto1.mlg src/tuto1_plugin.mlpack coq-8.20.0/doc/plugin_tutorial/tuto1/src/000077500000000000000000000000001466560755400202365ustar00rootroot00000000000000coq-8.20.0/doc/plugin_tutorial/tuto1/src/META.coq-plugin-tutorial000066400000000000000000000004661466560755400246330ustar00rootroot00000000000000package "tuto1" ( directory = "." version = "dev" description = "A tuto1 plugin" requires = "coq-core.plugins.ltac" archive(byte) = "tuto1_plugin.cma" archive(native) = "tuto1_plugin.cmxa" plugin(byte) = "tuto1_plugin.cma" plugin(native) = "tuto1_plugin.cmxs" ) directory = "." coq-8.20.0/doc/plugin_tutorial/tuto1/src/dune000066400000000000000000000002121466560755400211070ustar00rootroot00000000000000(library (name tuto1_plugin) (public_name coq-core.plugins.tutorial.p1) (libraries coq-core.plugins.ltac)) (coq.pp (modules g_tuto1)) coq-8.20.0/doc/plugin_tutorial/tuto1/src/g_tuto1.mlg000066400000000000000000000255561466560755400223360ustar00rootroot00000000000000DECLARE PLUGIN "coq-plugin-tutorial.tuto1" { (* If we forget this line and include our own tactic definition using TACTIC EXTEND, as below, then we get the strange error message no implementation available for Tacentries, only when compiling theories/Loader.v *) open Ltac_plugin open Pp (* This module defines the types of arguments to be used in the EXTEND directives below, for example the string one. *) open Stdarg } (*** Printing inputs ***) (* * This command prints an input from the user. * * A list with allowable inputs can be found in interp/stdarg.mli, * plugin/ltac/extraargs.mli, and plugin/ssr/ssrparser.mli * (remove the wit_ prefix), but not all of these are allowable * (unit and bool, for example, are not usable from within here). * * We include only some examples that are standard and useful for commands. * Some of the omitted examples are useful for tactics. * * Inspector is our own file that defines a simple messaging function. * The printing functions (pr_qualid and so on) are in printing. * * Some of these cases would be ambiguous if we used "What's" for each of * these. For example, all of these are terms. We purposely disambiguate. *) VERNAC COMMAND EXTEND WhatIsThis CLASSIFIED AS QUERY | [ "What's" constr(e) ] -> { let env = Global.env () in (* we'll explain later *) let sigma = Evd.from_env env in (* we'll explain later *) Inspector.print_input e (Ppconstr.pr_constr_expr env sigma) "term" } | [ "What" "kind" "of" "term" "is" string(s) ] -> { Inspector.print_input s strbrk "string" } | [ "What" "kind" "of" "term" "is" int(i) ] -> { Inspector.print_input i Pp.int "int" } | [ "What" "kind" "of" "term" "is" ident(id) ] -> { Inspector.print_input id Ppconstr.pr_id "identifier" } | [ "What" "kind" "of" "identifier" "is" reference(r) ] -> { Inspector.print_input r Ppconstr.pr_qualid "reference" } END (* * This command demonstrates basic combinators built into the DSL here. * You can generalize this for constr_list, constr_opt, int_list, and so on. *) VERNAC COMMAND EXTEND WhatAreThese CLASSIFIED AS QUERY | [ "What" "is" int_list(l) "a" "list" "of" ] -> { let print l = str "[" ++ Pp.prlist_with_sep (fun () -> str ";") Pp.int l ++ str "]" in Inspector.print_input l print "int list" } | [ "Is" ne_int_list(l) "nonempty" ] -> { let print l = str "[" ++ Pp.prlist_with_sep (fun () -> str ";") Pp.int l ++ str "]" in Inspector.print_input l print "nonempty int list" } | [ "And" "is" int_opt(o) "provided" ] -> { let print o = strbrk (if Option.has_some o then "Yes" else "No") in Feedback.msg_notice (print o) } END (*** Interning terms ***) (* * The next step is to make something of parsed expression. * Interesting information in interp/constrintern.mli. * * When you read in constr(e), e will have type Constrexpr.constr_expr, * which is defined in pretyping/constrexpr.ml. Your plugin * will want a different representation. * * The important function is Constrintern.interp_constr_evars, * which converts between a constr_expr and an * (EConstr.constr, evar_map) pair. This essentially contains * an internal representation of the term along with some state. * For more on the state, read /dev/doc/econstr.md. * * NOTE ON INTERNING: Always prefer Constrintern.interp_constr_evars * over Constrintern.interp_constr. The latter is an internal function * not meant for external use. * * To get your initial environment, call Global.env (). * To get state from that environment, call Evd.from_env on that environment. * It is important to NEVER use the empty environment or Evd.empty; * if you do, you will get confusing errors. * * NOTE ON STATE: It is important to use the evar_map that is returned to you. * Otherwise, you may get cryptic errors later in your plugin. * For example, you may get universe inconsistency errors. * In general, if a function returns an evar_map to you, that's the one * you want to thread through the rest of your command. * * NOTE ON STYLE: In general, it's better practice to move large * chunks of OCaml code like this one into an .ml file. We include * this here because it's really important to understand how to * thread state in a plugin, and it's easier to see that if it's in the * top-level file itself. *) VERNAC COMMAND EXTEND Intern CLASSIFIED AS QUERY | [ "Intern" constr(e) ] -> { let env = Global.env () in (* use this; never use empty *) let sigma = Evd.from_env env in (* use this; never use empty *) let debug sigma = Termops.pr_evar_map ~with_univs:true None env sigma in Feedback.msg_notice (strbrk "State before intern: " ++ debug sigma); let (sigma, t) = Constrintern.interp_constr_evars env sigma e in Feedback.msg_notice (strbrk "State after intern: " ++ debug sigma); let print t = Printer.pr_econstr_env env sigma t in Feedback.msg_notice (strbrk "Interned: " ++ print t) } END (*** Defining terms ***) (* * To define a term, we start similarly to our intern functionality, * then we call another function. We define this function in * the Simple_declare module. * * The line #[ poly = Attributes.polymorphic ] says that this command accepts * polymorphic attributes. * @SkySkimmer: Here, poly is what the result is bound to in the * rule's code. Multiple attributes may be used separated by ;, and we have * punning so foo is equivalent to foo = foo. * * The declare_definition function returns the reference * that was defined. This reference will be present in the new environment. * If you want to refer to it later in your plugin, you must use an * updated environment and the constructed reference. * * Note since we are now defining a term, we must classify this * as a side-effect (CLASSIFIED AS SIDEFF). *) VERNAC COMMAND EXTEND MyDefine CLASSIFIED AS SIDEFF | #[ poly = Attributes.polymorphic ] [ "MyDefine" ident(i) ":=" constr(e) ] -> { let env = Global.env () in let sigma = Evd.from_env env in let (sigma, t) = Constrintern.interp_constr_evars env sigma e in let r = Simple_declare.declare_definition ~poly i sigma t in let print r = strbrk "Defined " ++ Printer.pr_global r ++ strbrk "." in Feedback.msg_notice (print r) } END (*** Printing terms ***) (* * This command takes a name and return its value. It does less * than Print, because it fails on constructors, axioms, and inductive types. * It signals an error to the user for unsupported terms. * * Simple_print contains simple_body_access, which shows how to look up * a global reference. * * It needs the ability to access the body of opaque constants, which is given by STATE opaque_access. * This makes the expected type of the implementation be * [opaque_access:Global.indirect_accessor -> unit] instead of [unit]. *) VERNAC COMMAND EXTEND ExamplePrint CLASSIFIED AS QUERY STATE opaque_access | [ "MyPrint" reference(r) ] -> { fun ~opaque_access -> let env = Global.env () in let sigma = Evd.from_env env in try let t = Simple_print.simple_body_access ~opaque_access (Nametab.global r) in Feedback.msg_notice (Printer.pr_econstr_env env sigma t) with Failure s -> CErrors.user_err (str s) } END (* * This command shows that after you define a new term, * you can also look it up. But there's a catch! You need to actually * refresh your environment. Otherwise, the defined term * will not be in the environment. * * Using the global reference as opposed to the ID is generally * a good idea, otherwise you might end up running into unforeseen * problems inside of modules and sections and so on. * * Inside of simple_body_access, note that it uses Global.env (), * which refreshes the environment before looking up the term. * * [![opaque_access]] is equivalent to [STATE opaque_access] but is specific to that parsing rule. *) VERNAC COMMAND EXTEND DefineLookup CLASSIFIED AS SIDEFF | #[ poly = Attributes.polymorphic ] ![opaque_access] [ "DefineLookup" ident(i) ":=" constr(e) ] -> { fun ~opaque_access -> let env = Global.env () in let sigma = Evd.from_env env in let (sigma, t) = Constrintern.interp_constr_evars env sigma e in let r = Simple_declare.declare_definition ~poly i sigma t in let print r = strbrk "Defined " ++ Printer.pr_global r ++ strbrk "." in Feedback.msg_notice (print r); let env = Global.env () in let sigma = Evd.from_env env in let t = Simple_print.simple_body_access ~opaque_access r in let print t = strbrk "Found " ++ Printer.pr_econstr_env env sigma t in Feedback.msg_notice (print t) } END (*** Checking terms ***) (* * These are two commands for simple type-checking of terms. * The bodies and explanations of the differences are in simple_check.ml. *) VERNAC COMMAND EXTEND Check1 CLASSIFIED AS QUERY | [ "Check1" constr(e) ] -> { let env = Global.env () in let sigma = Evd.from_env env in let (sigma, t) = Constrintern.interp_constr_evars env sigma e in let (sigma, typ) = Simple_check.simple_check1 env sigma t in Feedback.msg_notice (Printer.pr_econstr_env env sigma typ) } END VERNAC COMMAND EXTEND Check2 CLASSIFIED AS QUERY | [ "Check2" constr(e) ] -> { let env = Global.env () in let sigma = Evd.from_env env in let (sigma, t) = Constrintern.interp_constr_evars env sigma e in let typ = Simple_check.simple_check2 env sigma t in Feedback.msg_notice (Printer.pr_econstr_env env sigma typ) } END (*** Convertibility ***) (* * This command checks if there is a possible assignment of * constraints in the state under which the two terms are * convertible. *) VERNAC COMMAND EXTEND Convertible CLASSIFIED AS QUERY | [ "Convertible" constr(e1) constr(e2) ] -> { let env = Global.env () in let sigma = Evd.from_env env in let (sigma, t1) = Constrintern.interp_constr_evars env sigma e1 in let (sigma, t2) = Constrintern.interp_constr_evars env sigma e2 in match Reductionops.infer_conv env sigma t1 t2 with | Some _ -> Feedback.msg_notice (strbrk "Yes :)") | None -> Feedback.msg_notice (strbrk "No :(") } END (*** Introducing terms ***) (* * We can call the tactics defined in Tactics within our tactics. * Here we call intros. *) TACTIC EXTEND my_intro | [ "my_intro" ident(i) ] -> { Tactics.introduction i } END (*** Exploring proof state ***) (* * This command demonstrates exploring the proof state from within * a command. * * Note that Pfedit.get_current_context gets us the environment * and state within a proof, as opposed to the global environment * and state. This is important within tactics. *) VERNAC COMMAND EXTEND ExploreProof CLASSIFIED AS QUERY | ![ proof_query ] [ "ExploreProof" ] -> { fun ~pstate -> let sigma, env = Declare.Proof.get_current_context pstate in let pprf = Proof.partial_proof (Declare.Proof.get pstate) in Feedback.msg_notice (Pp.prlist_with_sep Pp.fnl (Printer.pr_econstr_env env sigma) pprf) } END coq-8.20.0/doc/plugin_tutorial/tuto1/src/inspector.ml000066400000000000000000000004071466560755400225770ustar00rootroot00000000000000open Pp (* * Inspect an input and print a feedback message explaining what it is *) let print_input (a : 'a) (printer : 'a -> Pp.t) (type_str : string) : unit = let msg = printer a ++ strbrk (Printf.sprintf " is a %s." type_str) in Feedback.msg_notice msg coq-8.20.0/doc/plugin_tutorial/tuto1/src/inspector.mli000066400000000000000000000002051466560755400227440ustar00rootroot00000000000000(* * Inspect an input and print a feedback message explaining what it is *) val print_input : 'a -> ('a -> Pp.t) -> string -> unit coq-8.20.0/doc/plugin_tutorial/tuto1/src/simple_check.ml000066400000000000000000000012351466560755400232170ustar00rootroot00000000000000let simple_check1 env sigma evalue = (* This version should be preferred if you want to really verify that the input is well-typed, and if you want to obtain the type. *) (* Note that the output value is a pair containing a new evar_map: typing will fill out blanks in the term by add evar bindings. *) Typing.type_of env sigma evalue let simple_check2 env sigma evalue = (* This version should be preferred if you already expect the input to have been type-checked before. Set ~lax to false if you want an anomaly to be raised in case of a type error. Otherwise a ReTypeError exception is raised. *) Retyping.get_type_of ~lax:true env sigma evalue coq-8.20.0/doc/plugin_tutorial/tuto1/src/simple_check.mli000066400000000000000000000002741466560755400233720ustar00rootroot00000000000000val simple_check1 : Environ.env -> Evd.evar_map -> EConstr.constr -> Evd.evar_map * EConstr.constr val simple_check2 : Environ.env -> Evd.evar_map -> EConstr.constr -> EConstr.constr coq-8.20.0/doc/plugin_tutorial/tuto1/src/simple_declare.ml000066400000000000000000000003251466560755400235400ustar00rootroot00000000000000let declare_definition ~poly name sigma body = let cinfo = Declare.CInfo.make ~name ~typ:None () in let info = Declare.Info.make ~poly () in Declare.declare_definition ~info ~cinfo ~opaque:false ~body sigma coq-8.20.0/doc/plugin_tutorial/tuto1/src/simple_declare.mli000066400000000000000000000001531466560755400237100ustar00rootroot00000000000000open Names val declare_definition : poly:bool -> Id.t -> Evd.evar_map -> EConstr.t -> Names.GlobRef.t coq-8.20.0/doc/plugin_tutorial/tuto1/src/simple_print.ml000066400000000000000000000014361466560755400233010ustar00rootroot00000000000000(* A more advanced example of how to explore the structure of terms of type constr is given in the coq-dpdgraph plugin. *) let simple_body_access ~opaque_access gref = let open Names.GlobRef in match gref with | VarRef _ -> failwith "variables are not covered in this example" | IndRef _ -> failwith "inductive types are not covered in this example" | ConstructRef _ -> failwith "constructors are not covered in this example" | ConstRef cst -> let cb = Environ.lookup_constant cst (Global.env()) in (* most commands should not use body_of_constant_body and opaque accessors, but for printing it's ok *) match Global.body_of_constant_body opaque_access cb with | Some(e, _, _) -> EConstr.of_constr e | None -> failwith "This term has no value" coq-8.20.0/doc/plugin_tutorial/tuto1/src/simple_print.mli000066400000000000000000000001451466560755400234460ustar00rootroot00000000000000val simple_body_access : opaque_access:Global.indirect_accessor -> Names.GlobRef.t -> EConstr.constr coq-8.20.0/doc/plugin_tutorial/tuto1/src/tuto1_plugin.mlpack000066400000000000000000000000731466560755400240610ustar00rootroot00000000000000Inspector Simple_check Simple_declare Simple_print G_tuto1 coq-8.20.0/doc/plugin_tutorial/tuto1/theories/000077500000000000000000000000001466560755400212715ustar00rootroot00000000000000coq-8.20.0/doc/plugin_tutorial/tuto1/theories/Demo.v000066400000000000000000000034741466560755400223540ustar00rootroot00000000000000From Tuto1 Require Import Loader. (*** Printing user inputs ***) Definition definition := 5. What's definition. What kind of term is definition. What kind of identifier is definition. What is 1 2 3 a list of. What is a list of. (* no arguments = empty list *) Is 1 2 3 nonempty. (* Is nonempty *) (* does not parse *) And is 1 provided. And is provided. (*** Interning terms ***) Intern 3. Intern definition. Intern (fun (x : Prop) => x). Intern (fun (x : Type) => x). Intern (forall (T : Type), T). Intern (fun (T : Type) (t : T) => t). Intern _. Intern (Type : Type). (*** Defining terms ***) MyDefine n := 1. Print n. MyDefine f := (fun (x : Type) => x). Print f. (*** Printing terms ***) MyPrint f. MyPrint n. Fail MyPrint nat. DefineLookup n' := 1. DefineLookup f' := (fun (x : Type) => x). (*** Checking terms ***) Check1 3. Check1 definition. Check1 (fun (x : Prop) => x). Check1 (fun (x : Type) => x). Check1 (forall (T : Type), T). Check1 (fun (T : Type) (t : T) => t). Check1 _. Check1 (Type : Type). Check2 3. Check2 definition. Check2 (fun (x : Prop) => x). Check2 (fun (x : Type) => x). Check2 (forall (T : Type), T). Check2 (fun (T : Type) (t : T) => t). Check2 _. Check2 (Type : Type). (*** Convertibility ***) Convertible 1 1. Convertible (fun (x : Type) => x) (fun (x : Type) => x). Convertible Type Type. Convertible 1 ((fun (x : nat) => x) 1). Convertible 1 2. Convertible (fun (x : Type) => x) (fun (x : Prop) => x). Convertible Type Prop. Convertible 1 ((fun (x : nat) => x) 2). (*** Introducing variables ***) Theorem foo: forall (T : Set) (t : T), T. Proof. my_intro T. my_intro t. apply t. Qed. (*** Exploring proof state ***) Fail ExploreProof. (* not in a proof *) Theorem bar: forall (T : Set) (t : T), T. Proof. ExploreProof. my_intro T. ExploreProof. my_intro t. ExploreProof. apply t. Qed. coq-8.20.0/doc/plugin_tutorial/tuto1/theories/Loader.v000066400000000000000000000000571466560755400226700ustar00rootroot00000000000000Declare ML Module "coq-plugin-tutorial.tuto1". coq-8.20.0/doc/plugin_tutorial/tuto2/000077500000000000000000000000001466560755400174505ustar00rootroot00000000000000coq-8.20.0/doc/plugin_tutorial/tuto2/Makefile000066400000000000000000000003741466560755400211140ustar00rootroot00000000000000ifeq "$(COQBIN)" "" COQBIN=$(dir $(shell which coqtop))/ endif %: Makefile.coq Makefile.coq: _CoqProject $(COQBIN)coq_makefile -f _CoqProject -o Makefile.coq tests: all @$(MAKE) -C tests -s clean @$(MAKE) -C tests -s all -include Makefile.coq coq-8.20.0/doc/plugin_tutorial/tuto2/_CoqProject000066400000000000000000000004041466560755400216010ustar00rootroot00000000000000src/META.coq-plugin-tutorial -R theories Tuto2 -I src theories/Loader.v theories/Demo.v theories/Count.v src/custom.ml src/custom.mli src/counter.ml src/counter.mli src/persistent_counter.ml src/persistent_counter.mli src/g_tuto2.mlg src/tuto2_plugin.mlpack coq-8.20.0/doc/plugin_tutorial/tuto2/src/000077500000000000000000000000001466560755400202375ustar00rootroot00000000000000coq-8.20.0/doc/plugin_tutorial/tuto2/src/META.coq-plugin-tutorial000066400000000000000000000004661466560755400246340ustar00rootroot00000000000000package "tuto2" ( directory = "." version = "dev" description = "A tuto2 plugin" requires = "coq-core.plugins.ltac" archive(byte) = "tuto2_plugin.cma" archive(native) = "tuto2_plugin.cmxa" plugin(byte) = "tuto2_plugin.cma" plugin(native) = "tuto2_plugin.cmxs" ) directory = "." coq-8.20.0/doc/plugin_tutorial/tuto2/src/counter.ml000066400000000000000000000006651466560755400222570ustar00rootroot00000000000000(* * This file defines our counter, which we use in the Count command. *) (* * Our counter is simply a reference called "counter" to an integer. * * Summary.ref behaves like ref, but also registers a summary to Coq. *) let counter = Summary.ref ~name:"counter" 0 (* * We can increment our counter: *) let increment () = counter := succ !counter (* * We can also read the value of our counter: *) let value () = !counter coq-8.20.0/doc/plugin_tutorial/tuto2/src/counter.mli000066400000000000000000000003201466560755400224140ustar00rootroot00000000000000(* * This file defines our counter, which we use in the Count command. *) (* * Increment the counter *) val increment : unit -> unit (* * Determine the value of the counter *) val value : unit -> int coq-8.20.0/doc/plugin_tutorial/tuto2/src/custom.ml000066400000000000000000000001441466560755400221020ustar00rootroot00000000000000(* * This file defines a custom type for the PassCustom command. *) type custom_type = Foo | Bar coq-8.20.0/doc/plugin_tutorial/tuto2/src/custom.mli000066400000000000000000000001441466560755400222530ustar00rootroot00000000000000(* * This file defines a custom type for the PassCustom command. *) type custom_type = Foo | Bar coq-8.20.0/doc/plugin_tutorial/tuto2/src/dune000066400000000000000000000002121466560755400211100ustar00rootroot00000000000000(library (name tuto2_plugin) (public_name coq-core.plugins.tutorial.p2) (libraries coq-core.plugins.ltac)) (coq.pp (modules g_tuto2)) coq-8.20.0/doc/plugin_tutorial/tuto2/src/g_tuto2.mlg000066400000000000000000000473751466560755400223430ustar00rootroot00000000000000(* -------------------------------------------------------------------------- *) (* *) (* Initial ritual dance *) (* *) (* -------------------------------------------------------------------------- *) DECLARE PLUGIN "coq-plugin-tutorial.tuto2" (* Use this macro before any of the other OCaml macros. Each plugin has a unique name made of a package name (here "coq-plugin-tutorial") followed by an internal plugin name. We have decided to name this plugin as "coq-plugin-tutorial.tuto2". That means that: (1) We write the following command in a file called Loader.v: Declare ML Module "coq-plugin-tutorial.tuto2". to load this command into the Coq top-level. (2) Users can then load our plugin in other Coq files by writing: From Tuto2 Require Import Loader. where Loader is the name of the file that declares "coq-plugin-tutorial.tuto2", and where Tuto2 is the name passed to the -R argument in our _CoqProject. (3) The above commands will succeed only if there is a META.coq-plugin-tutorial file mapping the name "coq-plugin-tutorial.tuto2" to an actual "tuto2_plugin.cmxs" file. The META file can be had written and listed in _CoqProject, or generated by coq_makefile using the "-generate-meta-for-package coq-plugin-tutorial" flag. (4) The file "tuto2_plugin.mlpack" lists the OCaml modules to be linked in "tuto2_plugin.cmxs". (5) The file "tuto2_plugin.mlpack" as well as all .ml, .mli and .mlg files are listed in the "_CoqProject" file. *) (* -------------------------------------------------------------------------- *) (* *) (* Importing OCaml dependencies *) (* *) (* -------------------------------------------------------------------------- *) (* * This .mlg file is parsed into a .ml file. You can put OCaml in this file * inside of curly braces. It's best practice to use this only to import * other modules, and include most of your functionality in those modules. * * Here we list all of the dependencies that these commands have, and explain * why. We also refer to the first command that uses them, where further * explanation can be found in context. *) { (*** Dependencies from Coq ***) (* * This lets us take non-terminal arguments to a command (for example, * the PassInt command that takes an integer argument needs this * this dependency). * * First used by: PassInt *) open Stdarg (* * This is Coq's pretty-printing module. Here, we need it to use some * useful syntax for pretty-printing. * * First use by: Count *) open Pp } (* -------------------------------------------------------------------------- *) (* *) (* How to define a new Vernacular command? *) (* *) (* -------------------------------------------------------------------------- *) (* This command does nothing: *) VERNAC COMMAND EXTEND NoOp CLASSIFIED AS QUERY | [ "Nothing" ] -> { () } END (* --- Defining a Command --- These: VERNAC COMMAND EXTEND and END mark the beginning and the end of the definition of a new Vernacular command. --- Assigning a Command a Unique Identifier --- NoOp is a unique identifier (which must start with an upper-case letter) associated with the new Vernacular command we are defining. It is good to make this identifier descriptive. --- Classifying a Command --- CLASSIFIED AS QUERY tells Coq that the new Vernacular command neither: - changes the global environment, nor - modifies the plugin's state. If the new command could: - change the global environment - or modify a plugin's state then one would have to use CLASSIFIED AS SIDEFF instead. --- Defining Parsing and Interpretation Rules --- This: [ "Nothing" ] -> { () } defines: - the parsing rule (left) - the interpretation rule (right) The parsing rule and the interpretation rule are separated by -> token. The parsing rule, in this case, is: [ "Nothing" ] By convention, all vernacular command start with an upper-case letter. The '[' and ']' characters mark the beginning and the end of the parsing rule, respectively. The parsing rule itself says that the syntax of the newly defined command is composed from a single terminal Nothing. The interpretation rule, in this case, is: { () } Similarly to the case of the parsing rule, the '{' and '}' characters mark the beginning and the end of the interpretation rule. In this case, the following Ocaml expression: () defines the effect of the Vernacular command we have just defined. That is, it behaves is no-op. --- Calling a Command --- In Demo.v, we call this command by writing: Nothing. since our parsing rule is "Nothing". This does nothing, since our interpretation rule is (). *) (* -------------------------------------------------------------------------- *) (* *) (* How to define a new Vernacular command with some terminal parameters? *) (* *) (* -------------------------------------------------------------------------- *) (* This command takes some terminal parameters and does nothing. *) VERNAC COMMAND EXTEND NoOpTerminal CLASSIFIED AS QUERY | [ "Command" "With" "Some" "Terminal" "Parameters" ] -> { () } END (* --- Defining a Command with Terminal Parameters --- As shown above, the Vernacular command can be composed from any number of terminals. By convention, each of these terminals starts with an upper-case letter. --- Calling a Command with Terminal Parameters --- In Demo.v, we call this command by writing: Command With Some Terminal Parameters. to match our parsing rule. As expected, this does nothing. --- Recognizing Syntax Errors --- Note that if we were to omit any of these terminals, for example by writing: Command. it would fail to parse (as expected), showing this error to the user: Syntax error: illegal begin of vernac. *) (* -------------------------------------------------------------------------- *) (* *) (* How to define a new Vernacular command with some non-terminal parameter? *) (* *) (* -------------------------------------------------------------------------- *) (* This command takes an integer argument and does nothing. *) VERNAC COMMAND EXTEND PassInt CLASSIFIED AS QUERY | [ "Pass" int(i) ] -> { () } END (* --- Dependencies --- Since this command takes a non-terminal argument, it is the first to depend on Stdarg (opened at the top of this file). --- Defining a Command with Non-Terminal Arguments --- This: int(i) means that the new command is expected to be followed by an integer. The integer is bound in the parsing rule to variable i. This variable i then can be used in the interpretation rule. To see value of which Ocaml types can be bound this way, look at the wit_* function declared in interp/stdarg.mli (in the Coq's codebase). There are more examples in tuto1. If we drop the wit_ prefix, we will get the token that we can use in the parsing rule. That is, since there exists wit_int, we know that we can write: int(i) By looking at the signature of the wit_int function: val wit_int : int uniform_genarg_type we also know that variable i will have the type int. --- Recognizing Build Errors --- The mapping from int(i) to wit_int is automatic. This is why, if we forget to open Stdarg, we will get this error: Unbound value wit_int when we try to build our plugin. It is good to recognize this error, since this is a common mistake in plugin development, and understand that the fix is to open the file (Stdarg) where wit_int is defined. --- Calling a Command with Terminal Arguments --- We call this command in Demo.v by writing: Pass 42. We could just as well pass any other integer. As expected, this command does nothing. --- Recognizing Syntax Errors --- As in our previous command, if we were to omit the arguments to the command, for example by writing: Pass. it would fail to parse (as expected), showing this error to the user: Syntax error: [prim:integer] expected after 'Pass' (in [vernac:command]). The same thing would happen if we passed the wrong argument type: Pass True. If we pass too many arguments: Pass 15 20. we will get a different syntax error: Syntax error: '.' expected after [vernac:command] (in [vernac_aux]). It is good to recognize these errors, since doing so can help you catch mistakes you make defining your parser rules during plugin development. *) (* -------------------------------------------------------------------------- *) (* *) (* How to define a new Vernacular command with variable number of arguments? *) (* *) (* -------------------------------------------------------------------------- *) (* This command takes a list of integers and does nothing: *) VERNAC COMMAND EXTEND AcceptIntList CLASSIFIED AS QUERY | [ "Accept" int_list(l) ] -> { () } END (* --- Dependencies --- Much like PassInt, this command depends on Stdarg. --- Defining a Command that Takes a Variable Number of Arguments --- This: int_list(l) means that the new Vernacular command is expected to be followed by a (whitespace separated) list of integers. This list of integers is bound to the indicated l. In this case, as well as in the cases we point out below, instead of int in int_list we could use any other supported type, e.g. ident, bool, ... --- Other Ways to Take a Variable Number of Arguments --- To see which other Ocaml type constructors (in addition to list) are supported, have a look at the parse_user_entry function defined in the coqpp/coqpp_parse.mly file. E.g.: - ne_int_list(x) would represent a non-empty list of integers, - int_list(x) would represent a list of integers, - int_opt(x) would represent a value of type int option, - ··· Much like with int_list, we could use any other supported type here. There are some more examples of this in tuto1. --- Calling a Command with a Variable Number of Arguments --- We call this command in Demo.v by writing: Accept 100 200 300 400. As expected, this does nothing. Since our parser rule uses int_list, the arguments to Accept can be a list of integers of any length. For example, we can pass the empty list: Accept. or just one argument: Accept 2. and so on. *) (* -------------------------------------------------------------------------- *) (* *) (* How to define a new Vernacular command that takes values of a custom type? *) (* *) (* -------------------------------------------------------------------------- *) (* --- Defining Custom Types --- Vernacular commands can take custom types in addition to the built-in ones. The first step to taking these custom types as arguments is to define them. We define a type of values that we want to pass to our Vernacular command in custom.ml/custom.mli. The type is very simple: type custom_type : Foo | Bar. --- Using our New Module --- Now that we have a new OCaml module Custom, in order to use it, we must do the following: 1. Add src/custom.ml and src/custom.mli to our _CoqProject 2. Add Custom to our tuto2_plugin.mlpack This workflow will become very familiar to you when you add new modules to your plugins, so it is worth getting used to. --- Depending on our New Module --- Now that our new module is listed in both _CoqProject and tuto2_plugin.mlpack, we can use fully qualified names Custom.Foo and Custom.Bar. Alternatively, we could add the dependency on our module: open Custom. to the top of the file, and then refer to Foo and Bar directly. --- Telling Coq About our New Argument Type --- By default, we are able to define new Vernacular commands that can take parameters of some of the supported types. Which types are supported, that was discussed earlier. If we want to be able to define Vernacular command that takes parameters of a type that is not supported by default, we must use the following macro: *) VERNAC ARGUMENT EXTEND custom | [ "Foo" ] -> { Custom.Foo } | [ "Bar" ] -> { Custom.Bar } END (* where: custom indicates that, from now on, in our parsing rules we can write: custom(some_variable) in those places where we expect user to provide an input that can be parsed by the parsing rules above (and interpreted by the interpretations rules above). *) (* --- Defining a Command that Takes an Argument of a Custom Type --- Now that Coq is aware of our new argument type, we can define a command that uses it. This command takes an argument Foo or Bar and does nothing: *) VERNAC COMMAND EXTEND PassCustom CLASSIFIED AS QUERY | [ "Foobar" custom(x) ] -> { () } END (* --- Calling a Command that Takes an Argument of a Custom Type --- We call this command in Demo.v by writing: Foobar Foo. Foobar Bar. As expected, both of these do nothing. In the first case, x gets the value Custom.Foo : Custom.custom_type, since our custom parsing and interpretation rules (VERNAC ARGUMENT EXTEND custom ...) map the input Foo to Custom.Foo. Similarly, in the second case, x gets the value Custom.Bar : Custom.custom_type. *) (* -------------------------------------------------------------------------- *) (* *) (* How to give a feedback to the user? *) (* *) (* -------------------------------------------------------------------------- *) (* So far we have defined commands that do nothing. We can also signal feedback to the user. This command tells the user that everything is awesome: *) VERNAC COMMAND EXTEND Awesome CLASSIFIED AS QUERY | [ "Is" "Everything" "Awesome" ] -> { Feedback.msg_notice (Pp.str "Everything is awesome!") } END (* --- Pretty Printing --- User feedback functions like Feedback.msg_notice take a Pp.t as an argument. Check the Pp module to see which functions are available to construct a Pp.t. The Pp module enable us to represent and construct pretty-printing instructions. The concepts defined and the services provided by the Pp module are in various respects related to the concepts and services provided by the Format module that is part of the Ocaml standard library. --- Giving Feedback --- Once we have a Pp.t, we can use the following functions: - Feedback.msg_info : Pp.t -> unit - Feedback.msg_notice : Pp.t -> unit - Feedback.msg_warning : Pp.t -> unit - Feedback.msg_debug : Pp.t -> unit to give user a textual feedback. Examples of some of these can be found in tuto0. --- Signaling Errors --- While there is a Feedback.msg_error, when signaling an error, it is currently better practice to use user_err. There is an example of this in tuto0. *) (* -------------------------------------------------------------------------- *) (* *) (* How to implement a Vernacular command with (undoable) side-effects? *) (* *) (* -------------------------------------------------------------------------- *) (* This command counts how many times it has been called since importing our plugin, and signals that information to the user: *) VERNAC COMMAND EXTEND Count CLASSIFIED AS SIDEFF | [ "Count" ] -> { Counter.increment (); let v = Counter.value () in Feedback.msg_notice (Pp.str "Times Count has been called: " ++ Pp.int v) } END (* --- Dependencies --- If we want to use the ++ syntax, then we need to depend on Pp explicitly. This is why, at the top, we write: open Pp. --- Defining the Counter --- We define our counter in the Counter module. Please see counter.ml and counter.mli for details. As with Custom, we must modify our _CoqProject and tuto2_plugin.mlpack so that we can use Counter in our code. --- Classifying the Command --- This command has undoable side-effects: When the plugin is first loaded, the counter is instantiated to 0. After each time we call Count, the value of the counter increases by 1. Thus, we must write CLASSIFIED AS SIDEEFF for this command, rather than CLASSIFIED AS QUERY. See the explanation from the NoOp command earlier if you do not remember the distinction. --- Calling the Command --- We call our command three times in Demo.v by writing: Count. Count. Count. This gives us the following output: Times Count has been called: 1 Times Count has been called: 2 Times Count has been called: 3 Note that when the plugin is first loaded, the counter is 0. It increases each time Count is called. --- Behavior with Imports --- Count.v shows the behavior with imports. Note that if we import Demo.v, the counter is set to 0 from the beginning, even though Demo.v calls Count three times. In other words, this is not persistent! *) (* -------------------------------------------------------------------------- *) (* *) (* How to implement a Vernacular command that uses persistent storage? *) (* *) (* -------------------------------------------------------------------------- *) (* * This command is like Count, but it is persistent across modules: *) VERNAC COMMAND EXTEND CountPersistent CLASSIFIED AS SIDEFF | [ "Count" "Persistent" ] -> { Persistent_counter.increment (); let v = Persistent_counter.value () in Feedback.msg_notice (Pp.str "Times Count Persistent has been called: " ++ Pp.int v) } END (* --- Persistent Storage --- Everything is similar to the Count command, except that we use a counter that is persistent. See persistent_counter.ml for details. The key trick is that we must create a persistent object for our counter to persist across modules. Coq has some useful APIs for this in Libobject. We demonstrate these in persistent_counter.ml. This is really, really useful if you want, for example, to cache some results that your plugin computes across modules. A persistent object can be a hashtable, for example, that maps inputs to outputs your command has already computed, if you know the result will not change. --- Calling the Command --- We call the command in Demo.v and in Count.v, just like we did with Count. Note that this time, the value of the counter from Demo.v persists in Count.v. *) coq-8.20.0/doc/plugin_tutorial/tuto2/src/persistent_counter.ml000066400000000000000000000031201466560755400245240ustar00rootroot00000000000000(* * This file defines our persistent counter, which we use in the * CountPersistent command. *) (* * At its core, our persistent counter looks exactly the same as * our non-persistent counter (with a different name to prevent collisions): *) let counter = Summary.ref ~name:"persistent_counter" 0 (* * The difference is that we need to declare it as a persistent object * using Libobject.declare_object. To do that, we define a function that * saves the value that is passed to it into the reference we have just defined: *) let cache_count v = counter := v (* * We then use declare_object to create a function that takes an integer value * (the type our counter refers to) and creates a persistent object from that * value: *) let declare_counter : int -> Libobject.obj = let open Libobject in declare_object { (default_object "COUNTER") with cache_function = cache_count; load_function = (fun _ -> cache_count); } (* * See Libobject for more information on what other information you * can pass here, and what all of these functions mean. * * For example, if we passed the same thing that we pass to load_function * to open_function, then our last call to Count Persistent in Count.v * would return 4 and not 6. *) (* * Incrementing our counter looks almost identical: *) let increment () = Lib.add_leaf (declare_counter (succ !counter)) (* * except that we must call our declare_counter function to get a persistent * object. We then pass this object to Lib.add_leaf. *) (* * Reading a value does not change at all: *) let value () = !counter coq-8.20.0/doc/plugin_tutorial/tuto2/src/persistent_counter.mli000066400000000000000000000003761466560755400247070ustar00rootroot00000000000000(* * This file defines our persistent counter, which we use in the * CountPersistent command. *) (* * Increment the persistent counter *) val increment : unit -> unit (* * Determine the value of the persistent counter *) val value : unit -> int coq-8.20.0/doc/plugin_tutorial/tuto2/src/tuto2_plugin.mlpack000066400000000000000000000000521466560755400240600ustar00rootroot00000000000000Custom Counter Persistent_counter G_tuto2 coq-8.20.0/doc/plugin_tutorial/tuto2/theories/000077500000000000000000000000001466560755400212725ustar00rootroot00000000000000coq-8.20.0/doc/plugin_tutorial/tuto2/theories/Count.v000066400000000000000000000002471466560755400225540ustar00rootroot00000000000000Require Import Demo. (*** Local ***) Count. Count. Import Demo. Count. (*** Persistent ***) Count Persistent. Count Persistent. Import Demo. Count Persistent. coq-8.20.0/doc/plugin_tutorial/tuto2/theories/Demo.v000066400000000000000000000016361466560755400223530ustar00rootroot00000000000000From Tuto2 Require Import Loader. (*** A no-op command ***) Nothing. (*** No-op commands with arguments ***) (* * Terminal parameters: *) Command With Some Terminal Parameters. (* Command. *) (* does not parse *) (* * A single non-terminal argument: *) Pass 42. (* Pass. *) (* does not parse *) (* Pass True. *) (* does not parse *) (* Pass 15 20. *) (* does not parse *) (* * A list of non-terminal arguments: *) Accept 100 200 300 400. Accept. Accept 2. (* * A custom argument: *) Foobar Foo. Foobar Bar. (*** Commands that give feedback ***) (* * Simple feedback: *) Is Everything Awesome. (*** Storage and side effects ***) (* * Local side effects: *) Count. Count. Count. (* * See Count.v for behavior in modules that import this one. *) (* * Persistent side effects: *) Count Persistent. Count Persistent. Count Persistent. (* * See Count.v for behavior in modules that import this one. *) coq-8.20.0/doc/plugin_tutorial/tuto2/theories/Loader.v000066400000000000000000000000571466560755400226710ustar00rootroot00000000000000Declare ML Module "coq-plugin-tutorial.tuto2". coq-8.20.0/doc/plugin_tutorial/tuto3/000077500000000000000000000000001466560755400174515ustar00rootroot00000000000000coq-8.20.0/doc/plugin_tutorial/tuto3/Makefile000066400000000000000000000003741466560755400211150ustar00rootroot00000000000000ifeq "$(COQBIN)" "" COQBIN=$(dir $(shell which coqtop))/ endif %: Makefile.coq Makefile.coq: _CoqProject $(COQBIN)coq_makefile -f _CoqProject -o Makefile.coq tests: all @$(MAKE) -C tests -s clean @$(MAKE) -C tests -s all -include Makefile.coq coq-8.20.0/doc/plugin_tutorial/tuto3/_CoqProject000066400000000000000000000003341466560755400216040ustar00rootroot00000000000000src/META.coq-plugin-tutorial -R theories Tuto3 -I src theories/Data.v theories/Loader.v src/tuto_tactic.ml src/tuto_tactic.mli src/construction_game.ml src/construction_game.mli src/g_tuto3.mlg src/tuto3_plugin.mlpack coq-8.20.0/doc/plugin_tutorial/tuto3/src/000077500000000000000000000000001466560755400202405ustar00rootroot00000000000000coq-8.20.0/doc/plugin_tutorial/tuto3/src/META.coq-plugin-tutorial000066400000000000000000000004661466560755400246350ustar00rootroot00000000000000package "tuto3" ( directory = "." version = "dev" description = "A tuto3 plugin" requires = "coq-core.plugins.ltac" archive(byte) = "tuto3_plugin.cma" archive(native) = "tuto3_plugin.cmxa" plugin(byte) = "tuto3_plugin.cma" plugin(native) = "tuto3_plugin.cmxs" ) directory = "." coq-8.20.0/doc/plugin_tutorial/tuto3/src/construction_game.ml000066400000000000000000000164061466560755400243240ustar00rootroot00000000000000open Pp open EConstr let example_sort sigma = (* creating a new sort requires that universes should be recorded in the evd datastructure, so this datastructure also needs to be passed around. *) let sigma, s = Evd.new_sort_variable Evd.univ_rigid sigma in let new_type = mkSort s in sigma, new_type let c_one env sigma = (* In the general case, global references may refer to universe polymorphic objects, and their universe has to be made afresh when creating an instance. *) let gr_S = Coqlib.lib_ref "num.nat.S" in (* the long name of "S" was found with the command "Print Registered." *) let gr_O = Coqlib.lib_ref "num.nat.O" in let sigma, c_O = Evd.fresh_global env sigma gr_O in let sigma, c_S = Evd.fresh_global env sigma gr_S in (* Here is the construction of a new term by applying functions to argument. *) sigma, mkApp (c_S, [| c_O |]) let dangling_identity env sigma = (* I call this a dangling identity, because it is not polymorph, but the type on which it applies is left unspecified, as it is represented by an existential variable. The declaration for this existential variable needs to be added in the evd datastructure. *) let sigma, type_type = example_sort sigma in let sigma, arg_type = Evarutil.new_evar env sigma type_type in (* Notice the use of a De Bruijn index for the inner occurrence of the bound variable. *) sigma, mkLambda(nameR (Names.Id.of_string "x"), arg_type, mkRel 1) let dangling_identity2 env sigma = (* This example uses directly a function that produces an evar that is meant to be a type. *) let sigma, (arg_type, type_type) = Evarutil.new_type_evar env sigma Evd.univ_rigid in sigma, mkLambda(nameR (Names.Id.of_string "x"), arg_type, mkRel 1) let example_sort_app_lambda () = let env = Global.env () in let sigma = Evd.from_env env in let sigma, c_v = c_one env sigma in (* dangling_identity and dangling_identity2 can be used interchangeably here *) let sigma, c_f = dangling_identity2 env sigma in let c_1 = mkApp (c_f, [| c_v |]) in let _ = Feedback.msg_notice (Printer.pr_econstr_env env sigma c_1) in (* type verification happens here. Type verification will update existential variable information in the evd part. *) let sigma, the_type = Typing.type_of env sigma c_1 in (* At display time, you will notice that the system knows about the existential variable being instantiated to the "nat" type, even though c_1 still contains the meta-variable. *) Feedback.msg_notice ((Printer.pr_econstr_env env sigma c_1) ++ str " has type " ++ (Printer.pr_econstr_env env sigma the_type)) let c_S env sigma = let gr = Coqlib.lib_ref "num.nat.S" in Evd.fresh_global env sigma gr let c_O env sigma = let gr = Coqlib.lib_ref "num.nat.O" in Evd.fresh_global env sigma gr let c_E env sigma = let gr = Coqlib.lib_ref "Tuto3.EvenNat" in Evd.fresh_global env sigma gr let c_D env sigma = let gr = Coqlib.lib_ref "Tuto3.tuto_div2" in Evd.fresh_global env sigma gr let c_Q env sigma = let gr = Coqlib.lib_ref "core.eq.type" in Evd.fresh_global env sigma gr let c_R env sigma = let gr = Coqlib.lib_ref "core.eq.eq_refl" in Evd.fresh_global env sigma gr let c_N env sigma = let gr = Coqlib.lib_ref "num.nat.type" in Evd.fresh_global env sigma gr let c_C env sigma = let gr = Coqlib.lib_ref "Tuto3.C" in Evd.fresh_global env sigma gr let c_F env sigma = let gr = Coqlib.lib_ref "Tuto3.S_ev" in Evd.fresh_global env sigma gr let c_P env sigma = let gr = Coqlib.lib_ref "Tuto3.s_half_proof" in Evd.fresh_global env sigma gr (* If c_S was universe polymorphic, we should have created a new constant at each iteration of buildup. *) let mk_nat env sigma n = let sigma, c_S = c_S env sigma in let sigma, c_O = c_O env sigma in let rec buildup = function | 0 -> c_O | n -> mkApp (c_S, [| buildup (n - 1) |]) in if n <= 0 then sigma, c_O else sigma, buildup n let example_classes n = let env = Global.env () in let sigma = Evd.from_env env in let sigma, c_n = mk_nat env sigma n in let sigma, n_half = mk_nat env sigma (n / 2) in let sigma, c_N = c_N env sigma in let sigma, c_div = c_D env sigma in let sigma, c_even = c_E env sigma in let sigma, c_Q = c_Q env sigma in let sigma, c_R = c_R env sigma in let arg_type = mkApp (c_even, [| c_n |]) in let sigma0 = sigma in let sigma, instance = Evarutil.new_evar env sigma arg_type in let c_half = mkApp (c_div, [|c_n; instance|]) in let _ = Feedback.msg_notice (Printer.pr_econstr_env env sigma c_half) in let sigma, the_type = Typing.type_of env sigma c_half in let _ = Feedback.msg_notice (Printer.pr_econstr_env env sigma c_half) in let proved_equality = mkCast(mkApp (c_R, [| c_N; c_half |]), Constr.DEFAULTcast, mkApp (c_Q, [| c_N; c_half; n_half|])) in (* This is where we force the system to compute with type classes. *) (* Question to coq developers: why do we pass two evd arguments to solve_remaining_evars? Is the choice of sigma0 relevant here? *) let sigma = Pretyping.solve_remaining_evars (Pretyping.default_inference_flags true) env sigma ~initial:sigma0 in let sigma, final_type = Typing.type_of env sigma proved_equality in Feedback.msg_notice (Printer.pr_econstr_env env sigma proved_equality) (* This function, together with definitions in Data.v, shows how to trigger automatic proofs at the time of typechecking, based on canonical structures. n is a number for which we want to find the half (and a proof that this half is indeed the half) *) let example_canonical n = let env = Global.env () in let sigma = Evd.from_env env in (* Construct a natural representation of this integer. *) let sigma, c_n = mk_nat env sigma n in (* terms for "nat", "eq", "S_ev", "eq_refl", "C" *) let sigma, c_N = c_N env sigma in let sigma, c_F = c_F env sigma in let sigma, c_R = c_R env sigma in let sigma, c_C = c_C env sigma in let sigma, c_P = c_P env sigma in (* the last argument of C *) let refl_term = mkApp (c_R, [|c_N; c_n |]) in (* Now we build two existential variables, for the value of the half and for the "S_ev" structure that triggers the proof search. *) let sigma, ev1 = Evarutil.new_evar env sigma c_N in (* This is the type for the second existential variable *) let csev = mkApp (c_F, [| ev1 |]) in let sigma, ev2 = Evarutil.new_evar env sigma csev in (* Now we build the C structure. *) let test_term = mkApp (c_C, [| c_n; ev1; ev2; refl_term |]) in (* Type-checking this term will compute values for the existential variables *) let sigma, final_type = Typing.type_of env sigma test_term in (* The computed type has two parameters, the second one is the proof. *) let value = match kind sigma final_type with | Constr.App(_, [| _; the_half |]) -> the_half | _ -> failwith "expecting the whole type to be \"cmp _ the_half\"" in let _ = Feedback.msg_notice (Printer.pr_econstr_env env sigma value) in (* I wish for a nicer way to get the value of ev2 in the evar_map *) let prf_struct = of_constr (to_constr sigma ev2) in let the_prf = mkApp (c_P, [| ev1; prf_struct |]) in let sigma, the_statement = Typing.type_of env sigma the_prf in Feedback.msg_notice (Printer.pr_econstr_env env sigma the_prf ++ str " has type " ++ Printer.pr_econstr_env env sigma the_statement) coq-8.20.0/doc/plugin_tutorial/tuto3/src/construction_game.mli000066400000000000000000000003011466560755400244600ustar00rootroot00000000000000val dangling_identity : Environ.env -> Evd.evar_map -> Evd.evar_map * EConstr.t val example_sort_app_lambda : unit -> unit val example_classes : int -> unit val example_canonical : int -> unit coq-8.20.0/doc/plugin_tutorial/tuto3/src/dune000066400000000000000000000002541466560755400211170ustar00rootroot00000000000000(library (name tuto3_plugin) (public_name coq-core.plugins.tutorial.p3) (flags :standard -warn-error -3) (libraries coq-core.plugins.ltac)) (coq.pp (modules g_tuto3)) coq-8.20.0/doc/plugin_tutorial/tuto3/src/g_tuto3.mlg000066400000000000000000000023111466560755400223220ustar00rootroot00000000000000DECLARE PLUGIN "coq-plugin-tutorial.tuto3" { open Ltac_plugin open Construction_game (* This one is necessary, to avoid message about missing wit_string *) open Stdarg } VERNAC COMMAND EXTEND ShowTypeConstruction CLASSIFIED AS QUERY | [ "Tuto3_1" ] -> { let env = Global.env () in let sigma = Evd.from_env env in let sigma, s = Evd.new_sort_variable Evd.univ_rigid sigma in let new_type_2 = EConstr.mkSort s in let sigma, _ = Typing.type_of env (Evd.from_env env) new_type_2 in Feedback.msg_notice (Printer.pr_econstr_env env sigma new_type_2) } END VERNAC COMMAND EXTEND ShowOneConstruction CLASSIFIED AS QUERY | [ "Tuto3_2" ] -> { example_sort_app_lambda () } END TACTIC EXTEND collapse_hyps | [ "pack" "hypothesis" ident(i) ] -> { Tuto_tactic.pack_tactic i } END (* More advanced examples, where automatic proof happens but no tactic is being called explicitly. The first one uses type classes. *) VERNAC COMMAND EXTEND TriggerClasses CLASSIFIED AS QUERY | [ "Tuto3_3" int(n) ] -> { example_classes n } END (* The second one uses canonical structures. *) VERNAC COMMAND EXTEND TriggerCanonical CLASSIFIED AS QUERY | [ "Tuto3_4" int(n) ] -> { example_canonical n } END coq-8.20.0/doc/plugin_tutorial/tuto3/src/tuto3_plugin.mlpack000066400000000000000000000000461466560755400240650ustar00rootroot00000000000000Construction_game Tuto_tactic G_tuto3 coq-8.20.0/doc/plugin_tutorial/tuto3/src/tuto_tactic.ml000066400000000000000000000126121466560755400231160ustar00rootroot00000000000000open Proofview let constants = ref ([] : EConstr.t list) (* This is a pattern to collect terms from the Coq memory of valid terms and proofs. This pattern extends all the way to the definition of function c_U *) let collect_constants () = if (!constants = []) then let open EConstr in let open UnivGen in let find_reference = Coqlib.find_reference [@ocaml.warning "-3"] in let gr_H = find_reference "Tuto3" ["Tuto3"; "Data"] "pack" in let gr_M = find_reference "Tuto3" ["Tuto3"; "Data"] "packer" in let gr_R = find_reference "Tuto3" ["Coq"; "Init"; "Datatypes"] "pair" in let gr_P = find_reference "Tuto3" ["Coq"; "Init"; "Datatypes"] "prod" in let gr_U = find_reference "Tuto3" ["Tuto3"; "Data"] "uncover" in constants := List.map (fun x -> of_constr (constr_of_monomorphic_global (Global.env ()) x)) [gr_H; gr_M; gr_R; gr_P; gr_U]; !constants else !constants let c_H () = match collect_constants () with it :: _ -> it | _ -> failwith "could not obtain an internal representation of pack" let c_M () = match collect_constants () with _ :: it :: _ -> it | _ -> failwith "could not obtain an internal representation of pack_marker" let c_R () = match collect_constants () with _ :: _ :: it :: _ -> it | _ -> failwith "could not obtain an internal representation of pair" let c_P () = match collect_constants () with _ :: _ :: _ :: it :: _ -> it | _ -> failwith "could not obtain an internal representation of prod" let c_U () = match collect_constants () with _ :: _ :: _ :: _ :: it :: _ -> it | _ -> failwith "could not obtain an internal representation of prod" (* The following tactic is meant to pack an hypothesis when no other data is already packed. The main difficulty in defining this tactic is to understand how to construct the input expected by apply_in. *) let package i = Goal.enter begin fun gl -> Tactics.apply_in true false i [(* this means that the applied theorem is not to be cleared. *) None, (CAst.make (c_M (), (* we don't specialize the theorem with extra values. *) Tactypes.NoBindings))] (* we don't destruct the result according to any intro_pattern *) None end (* This function is meant to observe a type of shape (f a) and return the value a. *) (* Remark by Maxime: look for destApp combinator. *) let unpack_type sigma term = let report () = CErrors.user_err (Pp.str "expecting a packed type") in match EConstr.kind sigma term with | Constr.App (_, [| ty |]) -> ty | _ -> report () (* This function is meant to observe a type of shape A -> pack B -> C and return A, B, C but it is not used in the current version of our tactic. It is kept as an example. *) let two_lambda_pattern sigma term = let report () = CErrors.user_err (Pp.str "expecting two nested implications") in (* Note that pattern-matching is always done through the EConstr.kind function, which only provides one-level deep patterns. *) match EConstr.kind sigma term with (* Here we recognize the outer implication *) | Constr.Prod (_, ty1, l1) -> (* Here we recognize the inner implication *) (match EConstr.kind sigma l1 with | Constr.Prod (n2, packed_ty2, deep_conclusion) -> (* Here we recognized that the second type is an application *) ty1, unpack_type sigma packed_ty2, deep_conclusion | _ -> report ()) | _ -> report () (* In the environment of the goal, we can get the type of an assumption directly by a lookup. The other solution is to call a low-cost retyping function like *) let get_type_of_hyp env id = match EConstr.lookup_named id env with | Context.Named.Declaration.LocalAssum (_, ty) -> ty | _ -> CErrors.user_err (let open Pp in str (Names.Id.to_string id) ++ str " is not a plain hypothesis") let repackage i h_hyps_id = Goal.enter begin fun gl -> let env = Goal.env gl in let sigma = Tacmach.project gl in let concl = Tacmach.pf_concl gl in let (ty1 : EConstr.t) = get_type_of_hyp env i in let (packed_ty2 : EConstr.t) = get_type_of_hyp env h_hyps_id in let ty2 = unpack_type sigma packed_ty2 in let new_packed_type = EConstr.mkApp (c_P (), [| ty1; ty2 |]) in let open EConstr in let new_packed_value = mkApp (c_R (), [| ty1; ty2; mkVar i; mkApp (c_U (), [| ty2; mkVar h_hyps_id|]) |]) in Refine.refine ~typecheck:true begin fun sigma -> let sigma, new_goal = Evarutil.new_evar env sigma (mkArrowR (mkApp(c_H (), [| new_packed_type |])) (Vars.lift 1 concl)) in sigma, mkApp (new_goal, [|mkApp(c_M (), [|new_packed_type; new_packed_value |]) |]) end end let pack_tactic i = let h_hyps_id = (Names.Id.of_string "packed_hyps") in Proofview.Goal.enter begin fun gl -> let hyps = Environ.named_context_val (Proofview.Goal.env gl) in if not (Termops.mem_named_context_val i hyps) then (CErrors.user_err (Pp.str ("no hypothesis named" ^ (Names.Id.to_string i)))) else if Termops.mem_named_context_val h_hyps_id hyps then tclTHEN (repackage i h_hyps_id) (tclTHEN (Tactics.clear [h_hyps_id; i]) (Tactics.introduction h_hyps_id)) else tclTHEN (package i) (tclTHEN (Tactics.rename_hyp [i, h_hyps_id]) (Tactics.move_hyp h_hyps_id Logic.MoveLast)) end coq-8.20.0/doc/plugin_tutorial/tuto3/src/tuto_tactic.mli000066400000000000000000000002221466560755400232610ustar00rootroot00000000000000val two_lambda_pattern : Evd.evar_map -> EConstr.t -> EConstr.t * EConstr.t * EConstr.t val pack_tactic : Names.Id.t -> unit Proofview.tactic coq-8.20.0/doc/plugin_tutorial/tuto3/theories/000077500000000000000000000000001466560755400212735ustar00rootroot00000000000000coq-8.20.0/doc/plugin_tutorial/tuto3/theories/Data.v000066400000000000000000000036351466560755400223420ustar00rootroot00000000000000 Inductive pack (A: Type) : Type := packer : A -> pack A. Arguments packer {A}. Definition uncover (A : Type) (packed : pack A) : A := match packed with packer v => v end. Notation "!!!" := (pack _) (at level 0, only printing). (* The following data is used as material for automatic proofs based on type classes. *) Class EvenNat the_even := {half : nat; half_prop : 2 * half = the_even}. #[export] Instance EvenNat0 : EvenNat 0 := {half := 0; half_prop := eq_refl}. Register EvenNat as Tuto3.EvenNat. Lemma even_rec n h : 2 * h = n -> 2 * S h = S (S n). Proof. intros []. simpl. rewrite <-plus_n_O, <-plus_n_Sm. reflexivity. Qed. #[export] Instance EvenNat_rec n (p : EvenNat n) : EvenNat (S (S n)) := {half := S (@half _ p); half_prop := even_rec n (@half _ p) (@half_prop _ p)}. Definition tuto_div2 n (p : EvenNat n) := @half _ p. Register tuto_div2 as Tuto3.tuto_div2. (* to be used in the following examples Compute (@half 8 _). Check (@half_prop 8 _). Check (@half_prop 7 _). and in command Tuto3_3 8. *) (* The following data is used as material for automatic proofs based on canonical structures. *) Record S_ev n := Build_S_ev {double_of : nat; _ : 2 * n = double_of}. Register S_ev as Tuto3.S_ev. Definition s_half_proof n (r : S_ev n) : 2 * n = double_of n r := match r with Build_S_ev _ _ h => h end. Register s_half_proof as Tuto3.s_half_proof. Canonical Structure can_ev_default n d (Pd : 2 * n = d) : S_ev n := Build_S_ev n d Pd. Canonical Structure can_ev0 : S_ev 0 := Build_S_ev 0 0 (@eq_refl _ 0). Lemma can_ev_rec n : forall (s : S_ev n), S_ev (S n). Proof. intros s; exists (S (S (double_of _ s))). destruct s as [a P]. exact (even_rec _ _ P). Defined. Canonical Structure can_ev_rec. Record cmp (n : nat) (k : nat) := C {h : S_ev k; _ : double_of k h = n}. Register C as Tuto3.C. (* To be used in, e.g., Check (C _ _ _ eq_refl : cmp 6 _). Check (C _ _ _ eq_refl : cmp 7 _). *) coq-8.20.0/doc/plugin_tutorial/tuto3/theories/Loader.v000066400000000000000000000001201466560755400226610ustar00rootroot00000000000000From Tuto3 Require Export Data. Declare ML Module "coq-plugin-tutorial.tuto3". coq-8.20.0/doc/plugin_tutorial/tuto3/theories/test.v000066400000000000000000000013111466560755400224350ustar00rootroot00000000000000(* to be used e.g. in : coqtop -I src -R theories Tuto3 < theories/test.v *) Require Import Tuto3.Loader. (* This should print Type. *) Tuto3_1. (* This should print a term that contains an existential variable. *) (* And then print the same term, where the variable has been correctly instantiated. *) Tuto3_2. Lemma tutu x y (A : 0 < x) (B : 10 < y) : True. Proof. pack hypothesis A. (* Hypothesis A should have disappeared and a "packed_hyps" hypothesis should have appeared, with unreadable content. *) pack hypothesis B. (* Hypothesis B should have disappeared *) destruct packed_hyps as [unpacked_hyps]. (* Hypothesis unpacked_hyps should contain the previous contents of A and B. *) exact I. Qed. coq-8.20.0/doc/sphinx/000077500000000000000000000000001466560755400144635ustar00rootroot00000000000000coq-8.20.0/doc/sphinx/README.rst000066400000000000000000000445701466560755400161640ustar00rootroot00000000000000============================= Documenting Coq with Sphinx ============================= .. README.rst is auto-generated from README.template.rst and the coqrst/*.py files (in particular coqdomain.py). Use ``doc/tools/coqrst/regen_readme.py`` to rebuild it. Coq's reference manual is written in `reStructuredText `_ (“reST”), and compiled with `Sphinx `_. See `this README <../README.md>`_ for compilation instructions. In addition to standard reST directives (a directive is similar to a LaTeX environment) and roles (a role is similar to a LaTeX command), the ``coqrst`` plugin loaded by the documentation uses a custom *Coq domain* — a set of Coq-specific directives that define *objects* like tactics, commands (vernacs), warnings, etc. —, some custom *directives*, and a few custom *roles*. Finally, this manual uses a small DSL to describe tactic invocations and commands. Coq objects =========== Our Coq domain define multiple `objects`_. Each object has a *signature* (think *type signature*), followed by an optional body (a description of that object). The following example defines two objects: a variant of the ``simpl`` tactic, and an error that it may raise:: .. tacv:: simpl @pattern at {+ @natural} :name: simpl_at This applies ``simpl`` only to the :n:`{+ @natural}` occurrences of the subterms matching :n:`@pattern` in the current goal. .. exn:: Too few occurrences :undocumented: Objects are automatically collected into indices, and can be linked to using the role version of the object's directive. For example, you could link to the tactic variant above using ``:tacv:`simpl_at```, and to its exception using ``:exn:`Too few occurrences```. Names (link targets) are auto-generated for most simple objects, though they can always be overwritten using a ``:name:`` option, as shown above. - Options, errors, warnings have their name set to their signature, with ``...`` replacing all notation bits. For example, the auto-generated name of ``.. exn:: @qualid is not a module`` is ``... is not a module``, and a link to it would take the form ``:exn:`... is not a module```. - Vernacs (commands) have their name set to the first word of their signature. For example, the auto-generated name of ``Axiom @ident : @term`` is ``Axiom``, and a link to it would take the form ``:cmd:`Axiom```. - Vernac variants, tactic notations, and tactic variants do not have a default name. Most objects should have a body (i.e. a block of indented text following the signature, called “contents” in Sphinx terms). Undocumented objects should have the ``:undocumented:`` flag instead, as shown above. When multiple objects have a single description, they can be grouped into a single object, like this (semicolons can be used to separate the names of the objects; names starting with ``_`` will be omitted from the indexes):: .. cmdv:: Lemma @ident {* @binder } : @type Remark @ident {* @binder } : @type Fact @ident {* @binder } : @type Corollary @ident {* @binder } : @type Proposition @ident {* @binder } : @type :name: Lemma; Remark; Fact; Corollary; Proposition These commands are all synonyms of :n:`Theorem @ident {* @binder } : type`. Notations --------- The signatures of most objects can be written using a succinct DSL for Coq notations (think regular expressions written with a Lispy syntax). A typical signature might look like ``Hint Extern @natural {? @pattern} => @tactic``, which means that the ``Hint Extern`` command takes a number (``natural``), followed by an optional pattern, and a mandatory tactic. The language has the following constructs (the full grammar is in `TacticNotations.g `_): ``@…`` A placeholder (``@ident``, ``@natural``, ``@tactic``\ …) ``{? …}`` an optional block ``{* …}``, ``{+ …}`` an optional (``*``) or mandatory (``+``) block that can be repeated, with repetitions separated by spaces ``{*, …}``, ``{+, …}`` an optional or mandatory repeatable block, with repetitions separated by commas ``{| … | … | … }`` an alternative, indicating than one of multiple constructs can be used ``%{``, ``%}``, ``%|`` an escaped character (rendered without the leading ``%``). In most cases, escaping is not necessary. In particular, the following expressions are all parsed as plain text, and do not need escaping: ``{ xyz }``, ``x |- y``. But the following escapes *are* needed: ``{| a b %| c | d }``, ``all: %{``. (We use ``%`` instead of the usual ``\`` because you'd have to type ``\`` twice in your reStructuredText file.) For more details and corner cases, see `Advanced uses of notations`_ below. .. FIXME document the new subscript support As an exercise, what do the following patterns mean? .. code:: pattern {+, @term {? at {+ @natural}}} generalize {+, @term at {+ @natural} as @ident} fix @ident @natural with {+ (@ident {+ @binder} {? {struct @ident'}} : @type)} Objects ------- Here is the list of all objects of the Coq domain (The symbol :black_nib: indicates an object whose signature can be written using the notations DSL): ``.. attr::`` :black_nib: An attribute. Example:: .. attr:: local ``.. cmd::`` :black_nib: A Coq command. Example:: .. cmd:: Infix @string := @one_term {? ( {+, @syntax_modifier } ) } {? : @ident } This command is equivalent to :n:`…`. ``.. cmdv::`` :black_nib: A variant of a Coq command. Example:: .. cmd:: Axiom @ident : @term. This command links :token:`term` to the name :token:`term` as its specification in the global environment. The fact asserted by :token:`term` is thus assumed as a postulate. .. cmdv:: Parameter @ident : @term. This is equivalent to :n:`Axiom @ident : @term`. ``.. exn::`` :black_nib: An error raised by a Coq command or tactic. This commonly appears nested in the ``.. tacn::`` that raises the exception. Example:: .. tacv:: assert @form by @tactic This tactic applies :n:`@tactic` to solve the subgoals generated by ``assert``. .. exn:: Proof is not complete Raised if :n:`@tactic` does not fully solve the goal. ``.. flag::`` :black_nib: A Coq flag (i.e. a boolean setting). Example:: .. flag:: Nonrecursive Elimination Schemes Controls whether types declared with the keywords :cmd:`Variant` and :cmd:`Record` get an automatic declaration of induction principles. ``.. opt::`` :black_nib: A Coq option (a setting with non-boolean value, e.g. a string or numeric value). Example:: .. opt:: Hyps Limit @natural :name Hyps Limit Controls the maximum number of hypotheses displayed in goals after application of a tactic. ``.. prodn::`` A grammar production. Use ``.. prodn`` to document grammar productions instead of Sphinx `production lists `_. prodn displays multiple productions together with alignment similar to ``.. productionlist``, however unlike ``.. productionlist``\ s, this directive accepts notation syntax. Example:: .. prodn:: occ_switch ::= { {? {| + | - } } {* @natural } } term += let: @pattern := @term in @term | second_production The first line defines "occ_switch", which must be unique in the document. The second references and expands the definition of "term", whose main definition is elsewhere in the document. The third form is for continuing the definition of a nonterminal when it has multiple productions. It leaves the first column in the output blank. ``.. table::`` :black_nib: A Coq table, i.e. a setting that is a set of values. Example:: .. table:: Search Blacklist @string :name: Search Blacklist Controls ... ``.. tacn::`` :black_nib: A tactic, or a tactic notation. Example:: .. tacn:: do @natural @expr :token:`expr` is evaluated to ``v`` which must be a tactic value. … ``.. tacv::`` :black_nib: A variant of a tactic. Example:: .. tacn:: fail This is the always-failing tactic: it does not solve any goal. It is useful for defining other tacticals since it can be caught by :tacn:`try`, :tacn:`repeat`, :tacn:`match goal`, or the branching tacticals. … .. tacv:: fail @natural The number is the failure level. If no level is specified, it defaults to 0. … ``.. thm::`` A theorem. Example:: .. thm:: Bound on the ceiling function Let :math:`p` be an integer and :math:`c` a rational constant. Then :math:`p \ge c \rightarrow p \ge \lceil{c}\rceil`. ``.. warn::`` :black_nib: An warning raised by a Coq command or tactic.. Do not mistake this for ``.. warning::``; this directive is for warning messages produced by Coq. Example:: .. warn:: Ambiguous path When the coercion :token:`qualid` is added to the inheritance graph, non valid coercion paths are ignored. Coq directives ============== In addition to the objects above, the ``coqrst`` Sphinx plugin defines the following directives: ``.. coqtop::`` A reST directive to describe interactions with Coqtop. Usage:: .. coqtop:: options… Coq code to send to coqtop Example:: .. coqtop:: in reset Print nat. Definition a := 1. The blank line after the directive is required. If you begin a proof, use the ``abort`` option to reset coqtop for the next example. Here is a list of permissible options: - Display options (choose exactly one) - ``all``: Display input and output - ``in``: Display only input - ``out``: Display only output - ``none``: Display neither (useful for setup commands) - Behavior options - ``reset``: Send a ``Reset Initial`` command before running this block - ``fail``: Don't die if a command fails, implies ``warn`` (so no need to put both) - ``warn``: Don't die if a command emits a warning - ``restart``: Send a ``Restart`` command before running this block (only works in proof mode) - ``abort``: Send an ``Abort All`` command after running this block (leaves all pending proofs if any) ``coqtop``\ 's state is preserved across consecutive ``.. coqtop::`` blocks of the same document (``coqrst`` creates a single ``coqtop`` process per reST source file). Use the ``reset`` option to reset Coq's state. ``.. coqdoc::`` A reST directive to display Coqtop-formatted source code. Usage:: .. coqdoc:: Coq code to highlight Example:: .. coqdoc:: Definition test := 1. ``.. example::`` A reST directive for examples. This behaves like a generic admonition; see http://docutils.sourceforge.net/docs/ref/rst/directives.html#generic-admonition for more details. Optionally, any text immediately following the ``.. example::`` header is used as the example's title. Example:: .. example:: Adding a hint to a database The following adds ``plus_comm`` to the ``plu`` database: .. coqdoc:: Hint Resolve plus_comm : plu. ``.. inference::`` A reST directive to format inference rules. This also serves as a small illustration of the way to create new Sphinx directives. Usage:: .. inference:: name newline-separated premises -------------------------- conclusion Example:: .. inference:: Prod-Pro \WTEG{T}{s} s \in \Sort \WTE{\Gamma::(x:T)}{U}{\Prop} ----------------------------- \WTEG{\forall~x:T,U}{\Prop} ``.. preamble::`` A reST directive to include a TeX file. Mostly useful to let MathJax know about `\def`\s and `\newcommand`\s. The contents of the TeX file are wrapped in a math environment, as MathJax doesn't process LaTeX definitions otherwise. Usage:: .. preamble:: preamble.tex Coq roles ========= In addition to the objects and directives above, the ``coqrst`` Sphinx plugin defines the following roles: ``:g:`` Coq code. Use this for Gallina and Ltac snippets:: :g:`apply plus_comm; reflexivity` :g:`Set Printing All.` :g:`forall (x: t), P(x)` ``:n:`` Any text using the notation syntax (``@id``, ``{+, …}``, etc.). Use this to explain tactic equivalences. For example, you might write this:: :n:`generalize @term as @ident` is just like :n:`generalize @term`, but it names the introduced hypothesis :token:`ident`. Note that this example also uses ``:token:``. That's because ``ident`` is defined in the Coq manual as a grammar production, and ``:token:`` creates a link to that. When referring to a placeholder that happens to be a grammar production, ``:token:`…``` is typically preferable to ``:n:`@…```. ``:production:`` A grammar production not included in a ``prodn`` directive. Useful to informally introduce a production, as part of running text. Example:: :production:`string` indicates a quoted string. You're not likely to use this role very commonly; instead, use a ``prodn`` directive and reference its tokens using ``:token:`…```. ``:gdef:`` Marks the definition of a glossary term inline in the text. Matching :term:`XXX` constructs will link to it. Use the form :gdef:`text ` to display "text" for the definition of "term", such as when "term" must be capitalized or plural for grammatical reasons. The term will also appear in the Glossary Index. Examples:: A :gdef:`prime` number is divisible only by itself and 1. :gdef:`Composite ` numbers are the non-prime numbers. Common mistakes =============== Improper nesting ---------------- DO .. code:: .. cmd:: Foo @bar Foo the first instance of :token:`bar`\ s. .. cmdv:: Foo All Foo all the :token:`bar`\ s in the current context DON'T .. code:: .. cmd:: Foo @bar Foo the first instance of :token:`bar`\ s. .. cmdv:: Foo All Foo all the :token:`bar`\ s in the current context You can set the ``report_undocumented_coq_objects`` setting in ``conf.py`` to ``"info"`` or ``"warning"`` to get a list of all Coq objects without a description. Overusing ``:token:`` --------------------- DO .. code:: This is equivalent to :n:`Axiom @ident : @term`. DON'T .. code:: This is equivalent to ``Axiom`` :token:`ident` : :token:`term`. .. DO .. code:: :n:`power_tac @term [@ltac]` allows :tacn:`ring` and :tacn:`ring_simplify` to recognize … DON'T .. code:: power_tac :n:`@term` [:n:`@ltac`] allows :tacn:`ring` and :tacn:`ring_simplify` to recognize … .. DO .. code:: :n:`name={*; attr}` DON'T .. code:: ``name=``:n:`{*; attr}` Omitting annotations -------------------- DO .. code:: .. tacv:: assert @form as @simple_intropattern DON'T .. code:: .. tacv:: assert form as simple_intropattern Using the ``.. coqtop::`` directive for syntax highlighting ----------------------------------------------------------- DO .. code:: A tactic of the form: .. coqdoc:: do [ t1 | … | tn ]. is equivalent to the standard Ltac expression: .. coqdoc:: first [ t1 | … | tn ]. DON'T .. code:: A tactic of the form: .. coqtop:: in do [ t1 | … | tn ]. is equivalent to the standard Ltac expression: .. coqtop:: in first [ t1 | … | tn ]. Overusing plain quotes ---------------------- DO .. code:: The :tacn:`refine` tactic can raise the :exn:`Invalid argument` exception. The term :g:`let a = 1 in a a` is ill-typed. DON'T .. code:: The ``refine`` tactic can raise the ``Invalid argument`` exception. The term ``let a = 1 in a a`` is ill-typed. Plain quotes produce plain text, without highlighting or cross-references. Overusing the ``example`` directive ----------------------------------- DO .. code:: Here is a useful axiom: .. coqdoc:: Axiom proof_irrelevance : forall (P : Prop) (x y : P), x=y. DO .. code:: .. example:: Using proof-irrelevance If you assume the axiom above, … DON'T .. code:: Here is a useful axiom: .. example:: .. coqdoc:: Axiom proof_irrelevance : forall (P : Prop) (x y : P), x=y. Tips and tricks =============== Nested lemmas ------------- The ``.. coqtop::`` directive does *not* reset Coq after running its contents. That is, the following will create two nested lemmas (which by default results in a failure):: .. coqtop:: all Lemma l1: 1 + 1 = 2. .. coqtop:: all Lemma l2: 2 + 2 <> 1. Add either ``abort`` to the first block or ``reset`` to the second block to avoid nesting lemmas. Abbreviations and macros ------------------------ Substitutions for specially-formatted names (like ``|Cic|``, ``|Ltac|`` and ``|Latex|``), along with some useful LaTeX macros, are defined in a `separate file `_. This file is automatically included in all manual pages. Emacs ----- The ``dev/tools/coqdev.el`` folder contains a convenient Emacs function to quickly insert Sphinx roles and quotes. It takes a single character (one of ``gntm:```), and inserts one of ``:g:``, ``:n:``, ``:t:``, or an arbitrary role, or double quotes. You can also select a region of text, and wrap it in single or double backticks using that function. Use the following snippet to bind it to `F12` in ``rst-mode``:: (with-eval-after-load 'rst (define-key rst-mode-map (kbd "") #'coqdev-sphinx-rst-coq-action)) Advanced uses of notations -------------------------- - Use `%` to escape grammar literal strings that are the same as metasyntax, such as ``{``, ``|``, ``}`` and ``{|``. (While this is optional for ``|`` and ``{ ... }`` outside of ``{| ... }``, always using the escape requires less thought.) - Literals such as ``|-`` and ``||`` don't need to be escaped. - The literal ``%`` shouldn't be escaped. - Don't use the escape for a ``|`` separator in ``{*`` and ``{+``. These should appear as ``{*|`` and ``{+|``. coq-8.20.0/doc/sphinx/README.template.rst000066400000000000000000000237441466560755400177760ustar00rootroot00000000000000============================= Documenting Coq with Sphinx ============================= .. README.rst is auto-generated from README.template.rst and the coqrst/*.py files (in particular coqdomain.py). Use ``doc/tools/coqrst/regen_readme.py`` to rebuild it. Coq's reference manual is written in `reStructuredText `_ (“reST”), and compiled with `Sphinx `_. See `this README <../README.md>`_ for compilation instructions. In addition to standard reST directives (a directive is similar to a LaTeX environment) and roles (a role is similar to a LaTeX command), the ``coqrst`` plugin loaded by the documentation uses a custom *Coq domain* — a set of Coq-specific directives that define *objects* like tactics, commands (vernacs), warnings, etc. —, some custom *directives*, and a few custom *roles*. Finally, this manual uses a small DSL to describe tactic invocations and commands. Coq objects =========== Our Coq domain define multiple `objects`_. Each object has a *signature* (think *type signature*), followed by an optional body (a description of that object). The following example defines two objects: a variant of the ``simpl`` tactic, and an error that it may raise:: .. tacv:: simpl @pattern at {+ @natural} :name: simpl_at This applies ``simpl`` only to the :n:`{+ @natural}` occurrences of the subterms matching :n:`@pattern` in the current goal. .. exn:: Too few occurrences :undocumented: Objects are automatically collected into indices, and can be linked to using the role version of the object's directive. For example, you could link to the tactic variant above using ``:tacv:`simpl_at```, and to its exception using ``:exn:`Too few occurrences```. Names (link targets) are auto-generated for most simple objects, though they can always be overwritten using a ``:name:`` option, as shown above. - Options, errors, warnings have their name set to their signature, with ``...`` replacing all notation bits. For example, the auto-generated name of ``.. exn:: @qualid is not a module`` is ``... is not a module``, and a link to it would take the form ``:exn:`... is not a module```. - Vernacs (commands) have their name set to the first word of their signature. For example, the auto-generated name of ``Axiom @ident : @term`` is ``Axiom``, and a link to it would take the form ``:cmd:`Axiom```. - Vernac variants, tactic notations, and tactic variants do not have a default name. Most objects should have a body (i.e. a block of indented text following the signature, called “contents” in Sphinx terms). Undocumented objects should have the ``:undocumented:`` flag instead, as shown above. When multiple objects have a single description, they can be grouped into a single object, like this (semicolons can be used to separate the names of the objects; names starting with ``_`` will be omitted from the indexes):: .. cmdv:: Lemma @ident {* @binder } : @type Remark @ident {* @binder } : @type Fact @ident {* @binder } : @type Corollary @ident {* @binder } : @type Proposition @ident {* @binder } : @type :name: Lemma; Remark; Fact; Corollary; Proposition These commands are all synonyms of :n:`Theorem @ident {* @binder } : type`. Notations --------- The signatures of most objects can be written using a succinct DSL for Coq notations (think regular expressions written with a Lispy syntax). A typical signature might look like ``Hint Extern @natural {? @pattern} => @tactic``, which means that the ``Hint Extern`` command takes a number (``natural``), followed by an optional pattern, and a mandatory tactic. The language has the following constructs (the full grammar is in `TacticNotations.g `_): ``@…`` A placeholder (``@ident``, ``@natural``, ``@tactic``\ …) ``{? …}`` an optional block ``{* …}``, ``{+ …}`` an optional (``*``) or mandatory (``+``) block that can be repeated, with repetitions separated by spaces ``{*, …}``, ``{+, …}`` an optional or mandatory repeatable block, with repetitions separated by commas ``{| … | … | … }`` an alternative, indicating than one of multiple constructs can be used ``%{``, ``%}``, ``%|`` an escaped character (rendered without the leading ``%``). In most cases, escaping is not necessary. In particular, the following expressions are all parsed as plain text, and do not need escaping: ``{ xyz }``, ``x |- y``. But the following escapes *are* needed: ``{| a b %| c | d }``, ``all: %{``. (We use ``%`` instead of the usual ``\`` because you'd have to type ``\`` twice in your reStructuredText file.) For more details and corner cases, see `Advanced uses of notations`_ below. .. FIXME document the new subscript support As an exercise, what do the following patterns mean? .. code:: pattern {+, @term {? at {+ @natural}}} generalize {+, @term at {+ @natural} as @ident} fix @ident @natural with {+ (@ident {+ @binder} {? {struct @ident'}} : @type)} Objects ------- Here is the list of all objects of the Coq domain (The symbol :black_nib: indicates an object whose signature can be written using the notations DSL): [OBJECTS] Coq directives ============== In addition to the objects above, the ``coqrst`` Sphinx plugin defines the following directives: [DIRECTIVES] Coq roles ========= In addition to the objects and directives above, the ``coqrst`` Sphinx plugin defines the following roles: [ROLES] Common mistakes =============== Improper nesting ---------------- DO .. code:: .. cmd:: Foo @bar Foo the first instance of :token:`bar`\ s. .. cmdv:: Foo All Foo all the :token:`bar`\ s in the current context DON'T .. code:: .. cmd:: Foo @bar Foo the first instance of :token:`bar`\ s. .. cmdv:: Foo All Foo all the :token:`bar`\ s in the current context You can set the ``report_undocumented_coq_objects`` setting in ``conf.py`` to ``"info"`` or ``"warning"`` to get a list of all Coq objects without a description. Overusing ``:token:`` --------------------- DO .. code:: This is equivalent to :n:`Axiom @ident : @term`. DON'T .. code:: This is equivalent to ``Axiom`` :token:`ident` : :token:`term`. .. DO .. code:: :n:`power_tac @term [@ltac]` allows :tacn:`ring` and :tacn:`ring_simplify` to recognize … DON'T .. code:: power_tac :n:`@term` [:n:`@ltac`] allows :tacn:`ring` and :tacn:`ring_simplify` to recognize … .. DO .. code:: :n:`name={*; attr}` DON'T .. code:: ``name=``:n:`{*; attr}` Omitting annotations -------------------- DO .. code:: .. tacv:: assert @form as @simple_intropattern DON'T .. code:: .. tacv:: assert form as simple_intropattern Using the ``.. coqtop::`` directive for syntax highlighting ----------------------------------------------------------- DO .. code:: A tactic of the form: .. coqdoc:: do [ t1 | … | tn ]. is equivalent to the standard Ltac expression: .. coqdoc:: first [ t1 | … | tn ]. DON'T .. code:: A tactic of the form: .. coqtop:: in do [ t1 | … | tn ]. is equivalent to the standard Ltac expression: .. coqtop:: in first [ t1 | … | tn ]. Overusing plain quotes ---------------------- DO .. code:: The :tacn:`refine` tactic can raise the :exn:`Invalid argument` exception. The term :g:`let a = 1 in a a` is ill-typed. DON'T .. code:: The ``refine`` tactic can raise the ``Invalid argument`` exception. The term ``let a = 1 in a a`` is ill-typed. Plain quotes produce plain text, without highlighting or cross-references. Overusing the ``example`` directive ----------------------------------- DO .. code:: Here is a useful axiom: .. coqdoc:: Axiom proof_irrelevance : forall (P : Prop) (x y : P), x=y. DO .. code:: .. example:: Using proof-irrelevance If you assume the axiom above, … DON'T .. code:: Here is a useful axiom: .. example:: .. coqdoc:: Axiom proof_irrelevance : forall (P : Prop) (x y : P), x=y. Tips and tricks =============== Nested lemmas ------------- The ``.. coqtop::`` directive does *not* reset Coq after running its contents. That is, the following will create two nested lemmas (which by default results in a failure):: .. coqtop:: all Lemma l1: 1 + 1 = 2. .. coqtop:: all Lemma l2: 2 + 2 <> 1. Add either ``abort`` to the first block or ``reset`` to the second block to avoid nesting lemmas. Abbreviations and macros ------------------------ Substitutions for specially-formatted names (like ``|Cic|``, ``|Ltac|`` and ``|Latex|``), along with some useful LaTeX macros, are defined in a `separate file `_. This file is automatically included in all manual pages. Emacs ----- The ``dev/tools/coqdev.el`` folder contains a convenient Emacs function to quickly insert Sphinx roles and quotes. It takes a single character (one of ``gntm:```), and inserts one of ``:g:``, ``:n:``, ``:t:``, or an arbitrary role, or double quotes. You can also select a region of text, and wrap it in single or double backticks using that function. Use the following snippet to bind it to `F12` in ``rst-mode``:: (with-eval-after-load 'rst (define-key rst-mode-map (kbd "") #'coqdev-sphinx-rst-coq-action)) Advanced uses of notations -------------------------- - Use `%` to escape grammar literal strings that are the same as metasyntax, such as ``{``, ``|``, ``}`` and ``{|``. (While this is optional for ``|`` and ``{ ... }`` outside of ``{| ... }``, always using the escape requires less thought.) - Literals such as ``|-`` and ``||`` don't need to be escaped. - The literal ``%`` shouldn't be escaped. - Don't use the escape for a ``|`` separator in ``{*`` and ``{+``. These should appear as ``{*|`` and ``{+|``. coq-8.20.0/doc/sphinx/_static/000077500000000000000000000000001466560755400161115ustar00rootroot00000000000000coq-8.20.0/doc/sphinx/_static/CoqNotations.ttf000066400000000000000000001121441466560755400212540ustar00rootroot00000000000000 FFTMt˕HGDEF5*GPOS5N@GSUBD:ROS/2r`cmap{1jcvt :[)v \zfpgmvD#gaspglyfZ- :tzhead,6hhea/d$hmtx alocav maxp name5xpostP0NprepXû 8#̡p3_<O~>V~`/Ys2  P [DAMA [1> V W"^U.(~q/#0+)#.1&-v-((E 66??-6*-G.66('  .q1m,>,$!?$1?$??Y6$; C??.& 1Sh2-qll(qq;J2 2$- ^Uq/q1m??r622EOmJJJowwMMM`\]ZfkG~ - dH ~    !"#$%&'()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_`ardeixpkvjsgwl|cnm}byqz@?XUTSRQPONMLKJIHGFEDCBA@?>=<;:98765/.-,(&%$#" ,E#F` &`&#HH-,E#F#a &a&#HH-,E#F` a F`&#HH-,E#F#a ` &a a&#HH-,E#F`@a f`&#HH-,E#F#a@` &a@a&#HH-, <<-, E# D# ZQX# D#Y QX# MD#Y &QX# D#Y!!-, EhD ` EFvhE`D-, C#Ce -, C#C -,(#p(>(#p(E: -, E%EadPQXED!!Y-, EC`D-,CCe -, i@a ,b`+ d#da\XaY-,E+)#D)z-,Ee,#DE+#D-,KRXED!!Y-,%# `#-,%# a#-,%-, ` <<-, a <<-,CC -,!! d#d@b-,!QX d#d b@/+Y`-,!QX d#dUb/+Y`-, d#d@b`#!-,E#E`#E`#E`#vhb -,&&%%E#E &`bch &ae#DD-, ETX@D E@aD!!Y-,E0/E#Ea``iD-,KQX/#p#B!!Y-,KQX %EiSXD!!Y!!Y-,EC`c`iD-,/ED-,E# E`D-,E#E`D-,K#QX34 34YDD-,CX&EXdf`d `f X!@YaY#XeY)#D#)!!!!!Y-,CX%Ed `f X!@Ya#XeY)#D%% XY%% F%#B<%% F%`#B< XY%%)%%)%% XY%%CH%%`CH!Y!!!!!!!-,CX%Ed `f X!@Ya#XeY)#D%% XY%% F%#B<%%%% F%`#B< XY%%)) EeD%%)%% XY%%CH%%%%`CH!Y!!!!!!!-,% F%#B%%EH!!!!-,% %%CH!!!-,E# E P X#e#Y#h @PX!@Y#XeY`D-,KS#KQZX E`D!!Y-,KTX E`D!!Y-,KS#KQZX8!!Y-,KTX8!!Y-,CTXF+!!!!Y-,CTXG+!!!Y-,CTXH+!!!!Y-,CTXI+!!!Y-, #KSKQZX#8!!Y-, IQX@# 84!!Y-,F#F`#Fa#  Fab@@pE`h:-, #Id#SX<!Y-,KRX}zY-,KKTB-,B#Q@SZX TXBYY-,Eh#KQX# E d@PX|Yh`YD-,%%#>#> #eB #B#?#? #eB#B-@vn)uodtrdrC)qodpndoBnBia)gedeC)dBcadaBYQ)XBWUdUC)TBSQdRBQBLD)JHdHC)FDdDBCA/B?B* * U*U*U * U*U*U *U*UTSKRKP[%S@QZUZ[XYBKSXYKSXBY++++++++t+++s++++++++++++++++++++++++++++kk [[||f|P}fPkr{d}fk{}ofk{}fTkvfPP<<::dd_@~rU*W!Gxo{9jZ\.r+z4Y*CrrQY=****b "8>N6  h  J r  N  8pNN |l &< VplRLhFh""\  !>!b""<"#X###$$$%T%&J&`&&''8'p'( (),)**2*+$+:+^+|+++++,F,X,f,x,,,--"-0-B-j---. .Z..//\/00040P001V122223"3v34.445Z566T66727|78@89 9x9:P:;@;<<.<|<=M./<2<2/<2<233'3#rbbM-M6 @qo u ??10#.=3#"&54632Af 3 33 3$:44 44:$(,,(&,,Wm 6@n n@@ H ??/+]_q10#.=##.= H B G 0:><<><00:><<><00jMLO M LM LpM M@ M@M MгM L| L M M@  MML @e My  y!yy  r r??]22/223??22229]9]]]]]]]9]910++++]+++]+++++++]++++]++733733#3##7##7#537#537#fPf>RgzfPf753.#"#?M& V08,!08,!6'r.GO*0% &'B0%=.r' b %5'4,! a\g " !+:'5-!k='3' M" M M@ M MMM@BM""""|(|(((|` p  55...|44+@,H+}} p}%}1111??99//]]]]?]?+]]]99//]]]]10+++++]+++#34632#"&74&#"3264632#"&74&#"326[YY<45<<54<p<36<<63<  <k#LOOLLOOL*$$**""zLOOLLPPL*##**"";)5A¹?@ M%@ M"@ M M @ M9@ M. M. M-@ L9-  &C""y#C?<_<3267'.'326>54&#"m "H#-C-11.96*:>,f& <#*.f ">.>"0X H((<("6"0\ 24F8`&"F"|$B * "2x.<"d= =nR  @ H   H H ?++]q+_q10#.== H B:>>>>:B^B @ p ??107.5467m`9~9`q{8LKKL8UB @ p  ??210%4&'7'>&q`9~9`m|8LK犉KL8.6@Y@<@M<:.'4"'@M AB/-;4 ' ?9/2+9=/2+107'7>7*./7.=3>?"#'. ^ #$" %   t   $ "$# ^ "" B  n  $" "$  p D ""(  M@ M@M@M@ M M M@4 M@M@M R`@ P  U ?]]9/]]32]10++++++++++3533##5#(jj,d~Z[@z {??107>7.54632~%!&*3'*/1N8 4 '280#F<,q7?10!!q6xTS_M@He L H M HjM@Hez {?10]++]++++]++%#".54>32T6#  #6,. !! ./J-@v??/+}10#3~`#= #U@4d d%d$!!!@e e ??9/]]]/9/]]]]10%#"&546324&#"326'#"&54632niinpgino532662350joojkoou''((00/@@ M a  ee ??9310+7'>733!5H(882T{*Z f "&ff+7%&@c ' c&g! e ??210!!&654>54&#"'>32(2 " l%9A9%.#@=(i4&F6  <84 $$f 2TF>84&*"V*(,B)=0- M, M+ M M M @* M L)c&, c,,21g!))e! g ?2?9/9=/2]310+++++++".'732654&+532>54&#"'>323/( I3?3N<&.&)$#E,Y84M2*#05:ZI g 6(1'f"'Z%/@%%DN6+H500@ ae  ??9/932222231033##5!5>7&%" {CC{7!##".'732>A3^L <|z>\=2.% D3$/ +TKf Fh^+I6 f  .8->@&c`p/+cc @ H .e&g% g ??9+]107"32>54&'2#"&54>3>( # *$6K00J3hm5bT(L@/ $  5*$/3f 6H($J>'Z^0i!4' 10)a c@ H ee ??+10>7!5!$3<@9+<@|.f^pP&>+76@ M4 M2@ M0@ M/ M/ M. L, M , M@ M @ M M5 M/ L#M# M#"@ M"2#d M@& H95d9//d&dP82##),g)g ??9/9]/]++910]+]++++++++]++++++++#".5467.54>324.'326">54&*-9/3R2 *@&0R D&B4"X8(*,$$",8"$-9*@@%))c c@  ,&c 0@+e&g% g??9]]//10267>54.#"".54>32#'267*  # ,$6L01J2hn4aTP~' 4*&02f 6F*$J>&|Z^0jDH T#".54>32#".54>32T6#  #66#  #6,.    .,. "" .vT2##".54>32>7.54632T6#  #6%!&*3'*/1N8,. "" . 4 &280"F<,-!*@??9=/999910% %-""2lmml(e!@ UU?2210!!!!(\\f\f(!.@??9=/9999910%'-7##âlmmlE=01@22q'''1,u" g??]107&5467>54&#"'>32#".54>32*"(* <#"#^.9J*#(##3  (H*^.80*$$&&,  zz5EZ>M8@M!@M!8 M @ M M@M: M:@ M @ M @M@M@M MM@ M@ LLMML@rL@ M@ M@ M@ M M MP==@>>y 505`55GO6_66y+!G|+F@Py=@APAAy &> = = &}0 }&/]?99//999]]]]9/]]]22]10++++++++++++++++++]++++++++++%#".54>3254&#"3267#".54>323275.#"G&A0$9*0.!;+3U?/6 BrS0)FZ2)H6  8 1O9*J7 &5FuYFlI& W$Yol['6W>( " 0 D @' L L   H ????9/9910++'##6733.g,Z*,W)  y <,β$>>> >>>67#0T@'F Fp20D @ H   1#H$$,J J ??9/9=/^]+2]]10%#"&'>32%32>54&#'2654.#"&AY3)X+#T)FX2+$?- (90/0  8K- Y /:,DN)#-'f)$=:`  @H!F J JJJ ??+2]210"&54>32.#"3267(*Kg=!5( A*7+IS0?YIMxS+ b1R=jq a67!6@ F#D@ H" HH ??^]+}/]107232>54.#"#"&'>32 *9# 4)(+Li?!?$*J =eF') 8M.(L:#VyL#\ $Mw?0 Q@ 0  D 0 H@MM@ M H H??9/+++]2]10!#3#!?w<lfff?0 J@/@ M@ D@ M0 H H???9/]+2^]]+10!!3#?{<lff=#4@ %F$ D0  !JJ ????9//]10"326753#".54>32.8,<'FD  {]B:]B$*Hb8$9* @ 9O0oi)QyPOyR) b-0 ;@  D  D@ H  H@???9/]?+2210###335{{{0l60 .  D@ H H H?2?2+1053#5!#3673^ )27{{0+$ '29@9.<$PNBlDDBDLN$NX^,G0, HD@ HH??++10!3!{| <l0o M@ M0 M@[ M@ L?@ M? M M L @ M M @ M @ L @ L?  @M L M M@M@ M M L@ L@ M@ M M M? M@1 M@ M@ M/?@ M DD@Mo  ??9/9??9/9|]]+/9=/9999/10+]++]++]+++]++++++++++]++++++++]+]]+++]++>73###>7 f qLZIq 0BLN $PH@RPLB.0S@ @ M @ M?/ ?  DD@ H  ????99+2]210]+]+.'#33c*c9oc85-o54.#"4632#"&& '& &}vimrtjms-O:"";N--O:"";N-63?@ F`D @ H  HJ??99//?+2]102+#>"32654&vx,{-., ' 2;<;3anocck/96-j&/@F (F' J J  "J??32/9104632.'.732>54.#"vimrZU UJuw QW}& '& &G! XKF-N;"";N--O:"";N63$Y@D` p  &F`p&!DD@ H%H!!  J?????9/2+]]22102#.'##>4&#"3265V>!,3&$! =#@{+,(|<1 ?832M46X?EE54.'.54632.#"#"&'7) "*<1 qc9U$=(b'?5"qsM\$K  (;,Wb_G -C3W_!d0@DH???210###5ۣ|0ff'6/@ D`pD@ H J ??3+]10".5332>53X6}'5 !5'u6X>! 0@ MMH@ M$ M+M@0LG @ M   /  ???3??9]]910+]++]+]+]++.'3>7360& !  #-67( r f,0f r T8DN*4x|~@FL<~|x4 LJ> 0f MM M @'M    ??9??//99=//9910++++.'#>7373d7: '/4bg|4-" <4|><~4LX\,$*^ZL 0>@!D     ???9??9/]29=/210>73#5.'3  &*0|7S&8FNP 4`^\2`fH.0f@ M M@ H H @ H @ HHH???/+]++99+]10++!!5>7#5!+H>7 h2>I,Btj`0fH*`l~JfqJ/@_@_@ nrr??]]]]10!#3!q```1J*@v???/+}103#1~mJ/@n@@ Prr??]]]210!53#5!ꠠ``D)@r?29=/9910%''3o~~piz6660@ U??10!!0lsS}?10'՞-SoCT,.S@ $QS0, S@$ H/_oWP"`"""@W(@ M(W ?+?]9/]]+10]72675.#"2#".54>3254&#"'>& "$0:M.jB-I4 6F&0%,6#ATfl  2F,$<**8""0 d >[ [@ @ M @ M@ M@ MS` p  !QQ@ H UW W????+]10++++%4&#"3267#"&'7>32Y+,' 08}:T60d"{0.F/BF @L8\@"  "BZ,5@0@`p!S@ H W W ??+]10]74>32.#"3267#"., BeF*D#1&,;$IX?J2HgB2ZD& b $4BJ f &BZ[ `@@@@ M@ M@ MQSU W W????210+++]q]q]q73267.#"#"&5463257/4$,("b/nq_]0{>P F pt %\@7LS ?  '% Sp& @MO _  U@W0  W ?]?]9/]]+]2]10+74>32!3267#".%4.#"&>P*hlL<%C H-<_C$; "# >^> zv .6h >Zl"$$UV MP@) MP  Q`pOU W U ????]]22]10]+]+#5354>32.#"3#gg!8H&'R!E`pf:J.d&f!> 'G@'LQQ`  )S`"p""(W W% @W?]?9/]]10+32675.#"#"&'732>=#"&54632*-# lo{,Q%@0 * +\_nMZX:= sn h # tgtr?UB@Q@ ` p  QQ@ H W ??????}/+]107>32#54&#"?{*4F*{*! a 9O0B:$V L@. MQp?!! !`!T `pWUX ??/]]]]]10+#"&54632#".=#533267. -- .&C0A'$0$**$&**6L0f*(1OM@ MQ @! H!T @PpUX W??/]+]10+%#"&'73265#5!'#"&546321C'0R&&G"9. -- .9M/h%2Wf$**$%**?UQ@ @`0 Q@ H0p  ??9??/]3+22]]2107>73#.'#7%# .11:8/ ',-||/2/684CHH?=7$X6@!`p? Q P ` p   U W???]]]10#"&5#533267"1UN&%2D f`f0" '@^+@M@M/?_R@M/?OR_) 0@R(W" % W ?3??9/?]]]]+9/]++10_]]2#4.#"#54&#"#>32>W'2 d  dd'L).0J0 ".^l0&  ? - QQ@ H 0W ?]??+10>32#54&#"#?!a98J+{.{ 9O0B:&@S@ M!S W W??+10%#".54>3232654&#" :Q22Q; !;R01Q; -201-2018\B$$B\86\@$$@\8>NN>@LL?= 6@S` p  QQ@ HW  W???+]104&#"#3267#"'#>32X23 (,*}.F./2{"c0mtD>R FF6\@$l = !5@QQ`p#Sp  "UW W ???]]103267"&#"4>32#5#".+,% 33}9U630+{3.F/DBF R:6Z@$  "@\Y !Q @ H W ??+10.#"#>32 !" 2|1gE %*+d61L/@ MS &&@ H&3S .@ H.2!W+W ??99++]10+72654.'.54>32.#"#"&'7-0#8.1L5.OH-/!!:/3R<=V#Ol   0&4* h "2&4& h$0f@@ M 0@M@ Mo ` QP`pW U ?32?]22]^]]++]+10#53573#32>7#".5kk{ "O%+B.@fvf  j (J:; 2@ Q Q @ H   W???]+]10%#".533273"a9:J+{-|$ :P0@@pPM M M L@ L   ???910+++++7.'3>73-]*   }*f-Y&VWR""RWV&Y (@(ж M`('M'г M!@ M@MM M@ M@M M@ M M M M M @ M@MMMM L LM@> M(`$$  ) %`%%*@ M0)(%   ??9/9??]+]9///q33333]310+++++++++++++++++++++++]+%.'#.'3>73>73B   ] i  Y  i '415 324 ,kyDWX&A;77;A&.TSS-[)@     ????//91073#.'#>7'3`}.*" 60}'+/RAB<3P (L/=?>9"/@"Q$ #Q   ???/9]10#"&'73267.'3>7#&+%-7%3$, ,X$  9Byt7(:% g 0!X%TTQ##QST&CW H H@ H@Pp U U????/]/+99++]103!5>7#5!4==664]?NU$fK&PMFf?J$7@"n n%r rr ??9/9=/2107;#"&=4&+5326=46;#"6/ ]hZE66EZh] / D@q*&`NJ*+`+)JN`%+q@DJ9(@_ @??]]]2103#||?J(C@%(@ M@ Mn&n* )r !r r ??9/9=/210++%.=4&+532;#"+5326=46960 \g-=%77%=-g\ 0 D@q*&`&9%*+`+)%9&`%+q@DW@  ?]10%".#"'>3232>7Y/,) [!2#/,( ["18.60M5 #@q ou  ??_]1074>73#4632#"&f 3 33 3c$944 449$$'++''++.`![@2 M #QQS 0P"W" W??29/2]]]]10+746753.#"3267#5..Y`|-/$S@ES<2|0F-T|| h @<<@j ~ *7#5354>32.#"ꔔ MM4K/#?!$$f&&$fH|2f4BZ6b * )۵%@MMȳ M LM@ L@ M M @ L M@ L M@ M@ M M@ M L @/ L@ M@ M P$*+ '*!??9/]]10++++++++++++++++++++27'#"&''7&547'764&#"326,&BS@@TB''BS@@TB$v++++?Q>$,,$>R@  ?Q>"..">R@&((&&(( 0! @E MD# !!  "#D" ss ????9/93222?9=////////99333310+%##5#535#53.'36733#3|e)&! 3$G% #'^,hhT>T"LJH@H|FLL"T>J9$@ n???221073#3#||||`1h4D'@ M @ M=@L5@>LF.F5=/@?@@d((F#F8d0044E&5= =5& g1 g??9////]]]]9910++++732654&'.5467.54632.#"#"&'>54.R$$(!#%-#=. &d^(V#!=()* d[E` 5- 5  &2#$@$,EMb  0q&8-#KG)(S>  @ 0 ??]107"&546323"&54632))**))))$ $$ $$ $$ $1ED MC M?@G L: MO94 M7?(_(((G@AF O 0  <2-<# ??99//]]]]99//9910+]++++%#".54>32.#"3267%4>32#".2>54.#"G%++#  !  &?Q,+R?&&?R+,Q?&8-,98--8#-.$6( %:=\==\==[==[w.D,+C..C+,D.hG +l@ )@M @MM M@* M!`-) 0`p, }(%} ?/]9]]]210+++++%2635.#"2#"&54>3254&#"'> ( +:#N4FQ)6 %2 CF$2  2>*  N 2* [@ _y R_y@ H     ??99=//99=//+]]10'%'A^^?OB]]@(*(*-Y@ yr?10%#5!5!iZfq7!!q6x1ED MDC?@! L:@ M: M4 MK4`M@MM@tM@M@M@ M @M_  @H  ? O  7(?(_(((G@HAF<2-/?<# ?q?99//3+q2/23]]]]+q+2//2/10+++++++]++++]+7#5>32#./32654&#"4>32#".2>54.#"6"97(  9  $  &?Q,+R?&&?R+,Q?&8-,98--8M,*0/%2 J=\==\==[==[w.D,+C..C+,D.l&s?10!!l &Xlo@||  }}?102#"&5462654&#"5&&5BNP@ $4 4$HB@J(} M@ Mp    Rpp@& MpUp  @ L@ / ?  U?]]+]22]+?]]2]2]10++7!!3533##5#(\jjIffqD7@ | }t?9/]992103!5467>54&#"'>32y. /-,.H(F;B(4 R,F& D">qA*@ "@ M!@ M MM@ M@ M(M(M(M( M( M(@O L@L@M L@ L M@M ?,'+($}}, }t?9=////2/]10+]+++++++++++++++++72654+532654#"'>32#"&'7 ?%%'("C $1 $:*E*$IF%! -* O sS}?10%'7s-TCo;87@ Q  Q@ H W ????+22]1032673#"&'#  | ^30{8$, r:  &T|n>@) 0  R 0R r???9/]]107.54>32#.#LM#A\90e&e 0f\V0J4 NTS%#".54>32T6#  #6,. !! .gX@   ??10#"'73254/>73,!!,-# ")$P . ' ? $ H;@!@M @L  yys   ?9/9992210++7535'>733d%&FMRHQ  N&QJFd M M M M MM@M_@  tt?]]10+++++++%#".54>324&#"326.@''@..@''@.f%#"'&##%*B..B**D..D*+11+)002* 8@         ??9///99910%'7'7'7'7;A^^?B]]@*()()3  ӹMM M M ML MM@L M@ L  "@"! !!  !    ?2?2?????99//9]]22ԇ+}10++++++++++%3##5#5>7>73#53#$$P|- "2?Uf 3Ed=?''-+L/3 )k3(,o@A @M M*),+*+,)*)*). |.+-##$-%(-",+ )#" ??????9]Ї+}10++!#&4546?>54#"'>32>73#5%#)  ): '= $"2?Ud=? #&   5(*"  yk 7(5:>@U+ M(@M@M<>=>;<;<;@ |  @=?(? %  ?>= < ;6:,0/ 5). ??2?2????9=///9///932Ї+}10+++32654+532654&#"'>32#"&'3##5#5>73# '; ( 840 *"-3$$P|-  3Wd=z  :  6 ( , @&&.*L0@(j2q2@!0@ 0`p??]]10!'!22}2v$V #"&54632#".=#533267. -- .&C0A'$0$**$&**6L0f*(-T*e@ a,$@,,@ H  0Q@ H+*#   ???99//9??+]22/2/3+]10.'#3>73.7>7 $&rr  *3$:-"  E`$PNBlDDBDJP("RXX& "4,(2X0   U@ @L@L@M 0@@CM@ H!/?Oo`p/O_  ????99?]]]q+]+]q10+++.'#33'>54&'{WK  X  E`4^^b6xj&Z^`,j&.($(F& 1g?10#51OgP9 ?103#"&'52>5_=8# 80.< MQ ?10%#&67mB>,JR<*(/P?10#5/MP^B 7.5467m`9~9`q{8LKKL8UB %4&'7'>&q`9~9`m|8LK犉KL8q7!!q6x/J#3~`zz5E%#".54>3254&#"3267#".54>323275.#"G&A0$9*0.!;+3U?/6 BrS0)FZ2)H6  8 1O9*J7 &5FuYFlI& W$Yol['6W>( "qJ!#3!q```1J3#1~mJ!53#5!ꠠ``?J$7;#"&=4&+5326=46;#"6/ ]hZE66EZh] / D@q*&`NJ*+`+)JN`%+q@D?J(%.=4&+532;#"+5326=46960 \g-=%77%=-g\ 0 D@q*&`&9%*+`+)%9&`%+q@D#|%'7![ee0.rk%#".54>32#3 2##2 3#3((34((46(!!6w(\(!! (\#7'7ee[.0O5 74>73#4632#"&f 3 33 3c$944 449$$'++''++2* '%'A^^?OB]]@(*(*2* %'7'7'7'7;A^^?B]]@*()()E8 23267#".54>5'4632#".Q*"  * <#"#^.9J*#(##3 K (I  ^/7/'#"$',  OT@ ??10/'>l6zgl6zT,pD,p^V#+@$$ !?]10'7#".54>324&#"326R#    8  T8.L" "   mc >@%o0 JJPJJ ??]]]]]107#"&54632#"&54632%3#"!!"""""~Fnb @ J  J ?10%#"&54632'3#3""""~GJx|-@J  JJ J???]10'4632#"&'4632#"&k9x"!!""!!"|*Jx|7@!JJ JJ ???]]10'7#"&54632#"&54632tx8jr!!!!""""B*Js JM@"!H JJJJ ???]+10+7#"&54632#"&54632%77!!!!"""",UW-j4@@4rob> M@ M /?  ?]10++%#".#"'>323267'3#  1    (   \HiF?10%'7i>>Zw}F?10%''7}&\^&9669_w}F@ ??107'77&^\&`8668MW C@*JOOJ@  J J?]?]?]q]]10%4632#"&'4632#"&7'5"!!"""""V-^P5EMW K@2 J//?OOJ@JJ  ?]?]?]]]q107#"&54632#"&54632''7"!!"""""_]-U(E5PMW j@JJ  O _   O_J@P`JJ  ?]?]?]?]q]]]]107#"&54632#"&54632%77"!!"""""%1/'V:.##.N[,<@@&-F #@#`#p##>F7Fp=2W :J(W ??9/]]1074>7.54>3:63#"#".%4.'326 5+$)?,($! #R&  -!;F9Q12Q; :$#5**38:88*4$Z "&hH6Z> 32+3"32654&{CCCC*+)lwxn"Ȗ '300XXcHbVabWGc-+)"`F@  ??107".'732676*\""\*6!0##0 Ii?10'7IGW1Ke &6%'##6733.>7.546323#"&5473g,Z*,W)  y  $'B3N #8=_.в"@<>""><@ " ""(P", <.0e &6%'##6733..546323#"&5473g,Z*,W)  y 3B'$  #8=_.в"@<>""><@0"P("" " <.0e *:%'##6733.%'>7.546323#"&5473g,Z*,W)  y l; " ?0" #8=_.в"@<>""><@," ""(P", <.0e *:%'##6733.%'.546323#"&5473g,Z*,W)  y l;.0> " ! #8=_.в"@<>""><@, R("" " <.0e *:%'##6733.''7>7.546323#"&5473g,Z*,W)  y ~;l! "!@/ #8=_.в"@<>""><@v," ""(P", <.0e *:%'##6733.''7.546323#"&5473g,Z*,W)  y ;l0?!" !| #8=_.в"@<>""><@v, R("" " <.0\= ,>N'##6733.'.#"#>32>7.546323#"&5473g,Z*,W)  y    E'11'   ""] #8=_-ϲ#?=>!!>=?s%5##5%    !- ;.0]= ,>N'##6733.'.#"#>32.546323#"&5473g,Z*,W)  y    E'11'h#"   #8=_-ϲ#?=>!!>=?s%5##5%!     ;.0Ze +###335>7.546323#"&5473{{{ $'B3 #8=_zj" ""(P", <.0fe +###335.546323#"&5473{{{3B'$ & #8=_zj"P("" " <.0e /###335%'>7.546323#"&5473{{{Ll; " ?0r #8=_zj," ""(P", <.0e /###335%'.546323#"&5473{{{Kl;.0> " ! #8=_zj, R("" " <.0e /###335'7>7.546323#"&5473{{{~;l! "!@/R #8=_zj$," ""(P", <.0e /###335'7.546323#"&5473{{{;l0?!" ! #8=_zj$, R("" " <.0= !3C###335.#"#>32>7.546323#"&5473{{{}   E'11'   "" #8=_Rk(%5##5%    !- ;.0= !3C###335.#"#>32.546323#"&5473{{{}   E'11'h#"   c #8=_Rk(%5##5%!     ;.0keG>7.546323#"&54734>323#5>54.#"#53. $'B3 #8=_)BU-,UC)$*Q"5 + + 1&T*%" ""(P", <.0JjDDjJB~323#5>54.#"#53.D3B'$ E #8=_)BU-,UC)$*Q"5 + + 1&T*%"P("" " <.0JjDDjJB~7.546323#"&54734>323#5>54.#"#53.zl; " ?0 #8=_)BU-,UC)$*Q"5 + + 1&T*%," ""(P", <.0JjDDjJB~323#5>54.#"#53.zl;.0> " ! #8=_)BU-,UC)$*Q"5 + + 1&T*%, R("" " <.0JjDDjJB~7.546323#"&54734>323#5>54.#"#53."~;l! "!@/7 #8=_)BU-,UC)$*Q"5 + + 1&T*%V," ""(P", <.0JjDDjJB~323#5>54.#"#53.!;l0?!" ! #8=_)BU-,UC)$*Q"5 + + 1&T*%V, R("" " <.0JjDDjJB~32>7.546323#"&54734>323#5>54.#"#53..   E'11'   "" #8=_)BU-,UC)$*Q"5 + + 1&T*%*%5##5%    !- ;.0KjCCjKB~32.546323#"&54734>323#5>54.#"#53./   E'11'h#"   [ #8=_)BU-,UC)$*Q"5 + + 1&T*%*%5##5%!     ;.0KjCCjKB~""><@ <.0-o ###3353#"&5473{{{" #8=_jb <.0 h73#"&54734>323#5>54.#"#53.* #8=_)BU-,UC)$*Q"5 + + 1&T*%" :.0LjB BjLB~?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_`a      !"#$%&'()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNuni00A0uni00AD SF030000.001i.loclkgreenlandic.casenapostrophe.case caron.alt commaaccentrevcommaaccentcaron.alt.short Parenleft ParenrightHyphenSlashAt Bracketleft Backslash Bracketright Braceleft Braceright GuilsinglleftBulletEndashEmdashGuilsinglright Exclamdown GuillemotleftGuillemotright Questiondown double_grave ring_acutedieresis_macron dot_macrondieresis_gravedieresis_acutedieresis_breve tilde_macron acute.asccircumflex.asc caron.ascdieresis_grave.capdieresis_acute.capdieresis_breve.capafii10066.locltengeroublekratka tonos.cap uni1F88.alt uni1F89.alt uni1F8A.alt uni1F8B.alt uni1F8C.alt uni1F8D.alt uni1F8E.alt uni1F8F.alt uni1F98.alt uni1F99.alt uni1F9A.alt uni1F9B.alt uni1F9C.alt uni1F9D.alt uni1F9E.alt uni1F9F.alt uni1FA8.alt uni1FA9.alt uni1FAA.alt uni1FAB.alt uni1FAC.alt uni1FAD.alt uni1FAE.alt uni1FAF.alt uni1FBC.alt uni1FCC.alt uni1FFC.alt SF540000.001 SF530000.001 "}~ *cyrlgrek8latnJBGR MKD SRB "AZE 2CRT BMOL RROM RTRK ^afrc2case:loclBloclHloclNnumrTordnZss02` $,4<DLTHLPTblz6L6L6L {tu l|DR {tutu{  #>?@^`cm}D] <>cyrlgreklatn(!zOcoq-8.20.0/doc/sphinx/_static/ansi-dark.css000066400000000000000000000042661466560755400205040ustar00rootroot00000000000000/************************************************************************/ /* * The Coq Proof Assistant / The Coq Development Team */ /* v * Copyright INRIA, CNRS and contributors */ /* ?AG$ ]֪~tǥw˂vժr gcg{s&XSOz_' pOEuæ#Ҧ]{]u95h|J˸oTռ?Us6->ʽlN1j:U*c[wSR2} woS5t,E=^{{$}k{o#^SW!v v|=@iqriۨjI: UJauꔢomڶ |}]&녜<9w2E+VON,W;BNF8}Atp+?1"ߗ\AGoOРa!mP(㹰HaFan/ݽccǏpS8z^?(b?<&vw)p ]};DzYwTzDz^V`Q"ըf(yѦHDB'&%['{"""""""""""d "DDDDDDDDDDD|Dr/%_ "DDDDDDDDDDDD%[ "DDDDDDDDDDD1Q BDDDDDDDDDDDI%} "DDDDDDDDDDD1Q BDDDDDDDDDDDI_D|8r潄(v r`k9/tY|Uu:i݌9_w)"""""""""""+AdW3sN풳َ~ͻ4Qt C:dgg](Jd =MV+V]RvZLQmڴ9VruC4ArV?)pOADDDDDDDDDDeQ#Tp!gJ4nc>r~ȶE/z^Y29EդN9Wλ4b5d0D((uY "?rV=)gGOi1N80y&"""""""""HTa#QƐP%2!fҤI9Sg驵wlJI[0)'jՓTM -b%҂ݖK˙T[/)}x~cHJJDDDDDDDDD\e8e 4*Adݺu93% s=z4gN%^gҶ)mAJNռO\U5&TU'& c;Oh 8a!""""""""sF[S֊dH1$Am۶9!s'DBen*]^H$!M p4HK[vPG "Us&޸пzI99Tuʎ:"""""""""/VCFS;cH֭[K̓Cɓ5tǏ K&o;B!Z ROUPED,߿ѿ`!""""""""]X4|$ ̲O?#{l޼9f#CAcBi(A$TAJw "'wI1$ɧ*A$Ç7zʢEaCi9 &JBs?d gRw u'b1強 "DDDDDDDDDEsA}}H!J|ٳ杓#ǘO=NEC&9)))eA_]/Tw1"#QQ=;XGױA$FB>eV!eEhPB<+ܰt=M^1H8EbX,CBm)AcG$z衜cǎ)WiE)y]TA/=RBHժ9U$AJ4D[SVsǐ,Q*A$hc|̘19?IrnPur+zᆚx "E;TG"qD}0poex$gʕyGF"FH$+A$塚DDDDDDDDDH1l 8}ߜ#O#F?3};ZUaKA$3Q.VCFS*БhHPQd9>}1{s~n{ｗ__yG)da^GAE8B"^#wSx BDDDDDDDDD;(G""%2X?zYSh=:gΜ99Cyss/EďGSW?no/J"փ'r "DDDDDDDDDT=o Ϣ6e)A$Thpǐ~;vL$X!?dcjJΤBڂI9))q#-ܰqa"clIKYR5m*+B "DDDDDDDDDT=o;TpjՠEB* j "f{Mq3)%_|Zj'HN!eSRrR<'uIH佝' DBDzۜRN/H%DDDDDDDDDTr;Tp6m֐Ϳ]7tбJcb!!}QkF~4rI !/0TK$]Gz#ܿֈ`vW/?tc""""""""""JJ|qǐ^3\AbY"nDBoߞwdA( %p Ytiޥ9""""""""""xT7ǐE]*c!""""""""""G%:_Ξ={rm#'NȻT2 BDDDDDDDDDDJt!""""""""""x BDDDDDDDDDDDI%} "DDDDDDDDDDD1Q BDDDDDDDDDDDI%} "DDDDDDDDDDD1Q BDDDDDDDDDDDI%} "DDDDDDDDDDD1Q BDDDDDDDDDDDI%} "DDDDDDDDDDDh9|8 0 Hz " 1 Hz " 1 Hz 34iJ^yU ۾c\{c%ٽ{](*~ |4o/{쑠ˆ߰^fYj]DZYY^W "ES?/U^Ieʂ0_|l"vo)Uj.O/AD(_6j_/kV˨O;+A,˒qb~qHRקp1R*2X`)5k׈e}^Kd䘱^o\U/J H|:}dnZDJX/H~ " "Q?/HDp* "%A$qb~ XDDSMA PQ {/~콭Zu뉝 صrm߾MԸ/Klݿ=Gz.] w0}]6~h֪w>ޝ3W2ߍ6~%Rm!c${ Zw{'h'D "v?a֝w#'M,K@?~6o{j[6۶I]ǡ~_a?/ z?v)[SgIۓ&l{>ؾa >MA'~c#E6Rb|Yp;!go>.TKL zmOaajWz%/> ?v"ݐ}-qp b8iն|ku;R㮬=)T_ף~AD|'%貑ϧD>R|/iߠG>NG{DU#\nb/ϟ.Ι#1BFz}H6m}}Aq,ў7(ׯ=8Q=> "~Wԯ#PZ<ܳ0_. "bW:1c_SAǏ{vhD? 8eH| ">R|/iAA$ 8no=>D :I3t}Xvs߾b'h tKJa/@e *6n,6ݿv⺴?Ğ}u-S\7NXSqzPW_^'L~FxK {7Nޜ=[nhvݏm{;v9)-V\)cS˴Q8h޺Gv)|$+DyYa'&;v*ۼ_VC~U-{{}~?6kOb[E)Dco_ؖ-_.o _,섕biOgWo//\(v;/q㷨==%bfŋ]֮[+uN]o{ݏ['b_y{weNA_}nge#kO}GuO?Lq.u룽?xF}$?7Ǜzi{?4jRM(rS}sw X uhND+(-D㔔_.\ "% " "Ŭ "~ܸ[;YN2pC!NEu=8&ΠF">DNu;>/ D^د` bHÙRpwoz¼jjq/WR"`b?|׷tGz⪤({"wn?8R܏7Aɵa^޽bkc^^Z~;~q mO㾾ýɰn=g!7lpO6)2asb?SNuC =e{"܉X} /Tr=z{;O{pHE_)d܏CicA b'H&=ˋz"}y{;΅_]#Q:X}_qLK;tSkO}$cuő贡o;#ڏgQf?ؐh/﷏ "{s޽{MA7q whWNuHHND+(-D˕~#LD?Hɰ1H.\~1s/WZ0<&R>~īA \pDAA(b " " )A$ _|9D⃏>(If?]&~`?EqB{=5C:~x_<.n)Pk׭;^iacD_|H 7S8?ǹ{?wrwvA~NO?(=:~}EEyYa:~O?ͷG qo+-hA~{<7v}߰~]27V}}kO)bJrעȊ~֛om{ܕC8NEu=V hX=eV_|J#^fpRקJh?E>bhn.i6 m;p3S %{mycp>}]qG~{|_1:aw׉H^o}҂A6JRa/6"܉҆AdA$WAw}B~ "DVq?~cu'{rA$eH|u:貧>H;b9%A$6_D+ {|0@t~?etwn_72Wl̂oN\6ϟ'_{A )ǛQ.y!6&/!!c&8vӭg/3` cٞZo}bOy /}o+N/pO_=3E'.V_ݐ{Q1s/WZ;X8q_opx=~cuB1?l.g "vB^oI<Yzܛpx'שhBc8y[Si>R~{;Y.VGϢ~fr%˳?/y~\._&wC(ӯ8sw b+^'~LJ;D~҂A(eD1 {3 y&3 "t1* R<]H|'ҡ10ycp "{aNACҩ[wI]^eK.w!!=NI)岧$#kN\Z&ݿ#FHff+- wջW?Oƪr* >\} {}icp@n);?ն?-J쏾j^쩻*qЬUkٻDy/˂ޏmډ={jw{b^wD_YyfOu`Å}U׮qoQ|"o;{o!6 S2o|Gb~˴=ibOAeOh'h'PO99xl~S~穽ޮ_ԏ]ǽ 3Expu*گ^?1?T7z?Ä3Vap5b'y]D{TڿD~))~J>jSy}+$#ڏgGs]x'M^~zb2q/o c~A_q߃JDL_'"} "qJJa/H~ "% " "~ "? D_w ￉xp1  u"{|0@tf/G']h{fQ)FT /,v}/-zns/_ZLm?]֯#VvRz;iyn4qA~NO٦;woFtY?;nǁ!yg'v۷WѾ~^{?u[j֒[S)ܯ&_JN4F_Y+`c F=n-m'쏚S}/vS~J_~!v>~dÔ{e':Zi+6 SRLyqY7vpx0}zqL?Tt!vbޏ5{?]?D>RS~gAl'KA hn.-)xv9R.b vUWKeC>> ;~2=8ѿ׉p_]7Du^_㯨_G`)%oa H|AAďA$ D_wxex0 "%AA$~caaa1u"a=>D :6@Yg?? P\p0#S e]#'~nJ?/H "PL%_X?7$ (}Gޝ3W(XR)/(.R6|r}b>P|A,s3 Y0@J3~a)D H||_,Dv햇#Ok֮+ /,h}@d E/v( H||_,D@cIA$=D@cIA$=~4l޼ 0A$蟑$2D@cIA$=D@cIA$=D@cIA$=D@cIA$=68_/^,ϗyɇ~(sΕw}WfϞ-ok+K/$/L:U@ӦM~[I H~ `>cΒ q00@ P6m/eݺu&w;vHjjp4sa8f˖-qFOĆیuHv>D5W'pwc$ k q|}]W6HN1{y!td);f<*i7KFɉ/w˶}%;+CYeH5l-otAOm,[]v"ٙ6ʂzg;}G^1I :Fidڶm%cC=W_}%ALj3OλnĔ'ɿFEv9ޮ*gljP lz.fhǦim߆fJ[}3Y39$~l{DclJRIۓc]7d?O? .ڶm+ " "IA$?`aɇADDS"/B/v"jϞ=baзSdSo.ׯ#6lڴI^}Uٵk%͛ҥK$貅a;E_JeGBOsKα}G=rM}QEg{/7oP9>:$S"em-cZgˑsQn+Gfn'9:}lyd#Ao3*G>%B;!s:ˑԳ[e :Fid_}!5kc/'|lذAF2ܶU7#:6o_ {=wӞo񾖄L_rvogױloRWݦ;Ǐȷ_o#>%'>k~9}(䣮>"O5}CwˑY5$6&zЫeȖtdyt+x|bd)[#5ADDH(000 [AA;w=EɁdŊ)GNX} ~v9DNn*/vb̞hnOg%-[aÇIfg}*6 ~rۉ&)7 ;tvrb^YӮ#e)u؂>VIQiX )'b33d1gj;IJh&Yy'Vrq6vӚȖ Şz,6$5ϑ}SVJQ|k=e}_X|7Yz,]TgܹllwU;7Ϗw#Džcϱ'!N^/8v܃t{m90YrR[:F'd>Nj'^5d%6&lkgN>ͻB'-)kS*J౒.o=ħ#dSc DDDbN200A$FDa*Ad˖b==uÇla#I4AĞN=uʕ+$}_~YZn-<;Y&?3I&N -ZIб>cħ瞑I'I[Ɍ3$XN$WJ}SDnMCIƛ=S>ydBf6ï#oxG&4 }݆B`Jw9r;IB2^o-$GK#z'O=^<,;Ւm/ېV ?%_#M{]eU+$K/$6{+8S/[~Ivݲ{{92Q8WJ#=<{y-H_s^nqvvk'ԕC%6 .Zk~49C 7?&5ͣK! | lכcsykw+᷼Şo>)tMCKбax-E]8X+o=A,tДAAA$10H!0 H~ "__s-uoYn?o>?n'I>wllhJvpD͛' ~.ACq3f^&?;I {R5\?NlA=$6{)5zq"6kNM&qKd;[[e%Gkuɕwb%Ֆb?/7/7ci"z%Hm_|(挕ȁ]%N^m/G)'G,gFs_i5~dȵ5tsIˍsMo(Gfw.c&/ؐaÆ}9s"+"6' cS}rxأrE<w޶c^ϻL]oXyǔ1i %)^?Ŷ}T9>!:+4BʱȮM>eaa[lW]]2V])G>/]+ˡk% 뵲{_CWSGyblx] :& ҵk@H@67Vl?>wiޢ}jt̐J۶mŞ*&6fv"7CR% ۪rtvf^o9<y;Eg47BO6'\G˄dN{@AMj$:אC[ImuK'/wGW-[5/o#olj'rVՒqݖdrNwL_FV6LQ2uT?nŋŞ]oY4ړ&˫,<"[7} wˊMdE׶Iou_>)eEFbǵrp`oY^d#ACڻSnSiuUM}dï>(?~T6tY~3=Yߥ?1xM~8@R;,雼Kc~AADD H. H0DA;dOUk.bSs;z˦yLh|Jv9ފ}7+?%}Yz7%}(NK[CzcO<*njVZ $ƌO>!AP7iּ؉ۚDn8GfZ[2Vj#>xH,k^#G$$rMYmeM+%}jszTWg=B'xڿW-HΛ*&_kr򺡓מ)7I$cGlHHex߆dd7ڊ-Y /cF֭|n*iiibOh)r6\Bl߶kʔzKc/8$*O*SK>PGߖMb7'dieG:a]Y,.g;Fގ]kOvel9R{ۚ囏췻J!:nvr'货!m$6FbkKb׃jɎWFK1˂3߳O 9:z^9C1^S2I1?`aaI@ "DHx "a)(^>|b'G+xVljkY|SZ,!2cAfbOj*H z(AeҽG7P@.?>ryAtnݻIfdĉtIuPQ}c9%bOa7IƔ{s=WOf_ִ?~ɚogC=94*Hmir`oG}n0994ND 2I6+_*c" wIƲt/c6ر#+WyɢEdΜ9{]o^nqFVn-[[dgZrr^qodIeqǏ?}+{ގݴflmLVn#AC\ :_/-%GΒvwY:)p~*94d\Wx YxK۷etG\K91?[O^xvW6 m'3s,Ȼ6(%/4A %G/2@DDDH~ "  D5HnH "P-ݧ(m( Rg~j}Y)EzXY}yfʲ>YvSESO`oȐ'Eҵ{֣kt;= (NT~"lJv[] zUHmLH6uQ2/5N3Ytd%9{\x8TMic$~0i$fʔ)b%/'NȡC?555{{y;Nm.RCvk')!]vԮ);!S|sB|߹qvNݼaKOtc>"Yov]ok[]/m(3מCSȚtJom%|3zdOcEv|~dL?CO%)[&;fcDDDHl0caa ADbAG ">Ho-]wg(m#sVSG}PzxLG!dӦMa@D1cٓ&AS<02tPiޢt"]u.-[Сq=2r"7s4~lxzt<]KOŽ_mM}ˊd}&cK+{,Y{ҷuCkȡQduryדyHo4 wd<>dNG}>5_5d$mr`R!Jz5oԶvtJmoó:!{KHS㐉V-ϡͫ%XoKrh譒=\5McDDDH0 Ha0Hl1@l sY`Sf͝;Wm&ݹs{!b%yoY\˛#o1oHACȚ5kd̙zK7ߐx*ȡCҲeKi߾t.];Kn]iӦr zIͲ沪uaPSqODO},JI}dl$vDs~/oQ}ɜ|K; YRU6vYu.Α.u$}-rhh5eeӿʁ eUJtJҏe]'X_e\$#'!$k\mYZrhnzc rzK)lXbl߾]cH.g8v\w+U5o)x Ϧ>9f9^?Y»oB2S ʒ96YZrYq_U^SSHm*I'[Ȝں,{d=]G#kT-YRO+[ZXu)G>V7oS=.YD }i>ozTv\{;vnS,ͭ|l~*\*ƛst|ZcoŮgDZ9vn{UkJP!zqr1dzVseKcEvjsSEVGoGK1 " " " " " " " R " "`QlȪU+e…bOeel =-Iɧ d֭lٺYq>6o̕7a섕Z@=e/})AS<GyD) }R&:/{ O>!]v=zȁ%6+HM3>r-1YR+\%*YCo5fxYrtAh~t%+^&= cc#o\)Y#nAr Q2*X*c#$둊ߞ.11}y}^xF!5VO*v~^z%IOOTꫯO?8|@rv=ޮ{Xߴ,Y_FI熛zɿ=*F7k!5>vL8qB@vX|K-YЬQY|vou9L}x<}g{J~@+9+eAֲwx.n#mo}ZH " " " "'OL100HQ00I ţ/BKG.{Çņ;1~ٳgO>6322ѣ';]VJLT'ݻwˠJ)ҮC@ZJ.1 |ttӭ[7tKBjc|CI^CM~XV6B :?H<\-k:#A1 7;u~xtDa`K=>!^n'gtи{C>%#%*urMUY׳ݦdǶm~~|^E{Gǀʒ޻~qͲ)G^|E9p@>6o,/qv98ljܛn[WU5WZ{ ݚubuƲ,;ގ]soM͘%ACiThGցm5\=#cd$e)CeÃȑ$%[e#Ude\<DAAAAAAADDAA(Dx GٳgN ;1dC "~|Cɉ'СCsNYnCeܹbOab3}*{F=9)))Ү};ۯtAڶkeҨQ#iҤlRҾC;ةtuͲ OVc3;љ]{Y=om+*J5tpv~yܻAʕbٸqL>] w;c/t;-e֕5dAd_*ɂnOr|糿rv=;潝ׯ!3n}@Km. oݭIбNJZk{䑿ںIOJбc   "Dc*_|;Şzɞ鷿TPAnviذo^<2l0=z;6QFСCAɀo߾һwoիSWթSWާ4{[bC -Z6MO˖-cS۱ϫΔc&YIC ecjbO1QЉwYV'G-'ZȕwpϢ/AH&6l^ԹP{Vs})W/>mŎ6J= ޑŷ/v"[窖kM]|t =V9!WvdmM|yy5wVfKm{j,{JwyGS'SjbݧIJ?nv9ǎko}-#l[N&^~Lwy\U*2ϕenrv;Kx}m ͥ+;Dg?} UAO1QvVT4\?t}ɑW.c%ny5Kd]&b_бkڡH0H0 c " A$?/b>4nD4i*G?5\#v؉mC=$6d 2DF)61B,wѣtU:w,:t I6m%}*NGtyOliԨae[n͛7ڲe|V⋅bOոq#";㐤m-P~8;x<{W+IE%S9y¿ݥ6s#)egeU?JFK$Ųd$NH-:v&Zz\ G^r,jfB6qM%tjѢE2gΜ|l@rPb_7_x|x ٺuk>rv;ǚ}9x޽KmZVL=22ϷO5r]pk?ޒ.w)cL^knNASiΕ{{);F+N~=^retdw,_Iv4D) տHV[ V[v4XtZv6XWI : r " "b'n[i 0DDDD ȩ1b*A[Rb')).6|O쿍=uc=&6Gw.X6xҪU+iѢPcO%}%DԞ=icv?koܹfjYj\BV^n}чbǵp۷oݒh'2d hs؉%;3lGdT2[^"5ΗMzK1ʂmSF.URQtDk`prTHjumŅ9W?ɱ&j\ rdq+$6':ꫯqUV=uÇždzbyaz'Nc^nq5D6n()!= UzvY{;v}C :橼k2~|A) 쏗߿Olܞqe2gԳ2V+q32w9;ގ]GO~<} ˾ua D6H0O "ƞ NȯXTe3}(I vBȆ˾}{ņ {?턒]ޮoK/^,V = ʜ_z*~aGlrv=;߇@00p" @Rc ~aGD@)A1 Hz " 1 Hz " 1 Hz " 1 Hz " 1 Hz " 1W qz " {H: w/_^D@py;Ha;H w0 " {H: w0D@q Ha;H w0 " {H: wJk J5tP:{H "$.w`q_ {>ٖ1I^ Q[\Jw08DH| gTr09pbd~Ld :V2r퍕d%dٲ%b7yO@ܽA$H~ "D "y]8Mi">#iGʎ{mzR :V2`$2w`  {GDR7c 7dꂖ2s( :V2v(8{H @"s2?6)yv^sI;2Be=,kE㤦z닝ط!bҭgOOhy54p{r{}.]dɒɧ n6uW{^Đ!bCM=^oD " " "I3M])C^o$_#-#_1y~~xۛ" 6tGg֓ S=+3gЯxsYv~0WrW,V;654,]X8) oܬ\R|cĂw00b$2wHAd۝y õ5_#kȲ=sh)k'_+.zMfȸ =},vhQGg{QyCj  ܽAA$ {G"sxYϪ-Kwʧ:c)fԑ>i$K=(o,n&f57c+b'ZΩP?x_2 :@"sD>Y2[N!sW6˧[˳ד7xdpSkm96lb'?M2m"OV\.v{AnOc.dbOewCQAw{CȊˤKb7 "Xp@qD_&_!/v_H>\SO6ޟP6Neeb]{ ;-=zy?8ؠa׿~yjxqD86<<b} %RA^gHV-J{O?-v} w`aa$wHA,^@쏧?=NV;#OUT w00tܽ#j2z26ysqoc " "$wHAĬ߰V&S\]&XE~VYv$w`a {G"<-=UYL " "$w(sH~ w0 " {H: w0 " {H: w0 " {H: w0 " {G"wO:AU@pIAU@pIAU@pIAU@p >Jh=V;DP&=V; D-w`!"""""""""";D(r"""""""""""JܽA.w`!"""""""""";D(r"""""""""""JܽA.w`!"""""""""";b6,X1@4w` #ܽ#?}6I1qHZHeN%%.zדHlDDD*55U,/3~DDDDDD;Dt(D$""S BDDDDD;b>ٓ&˖-=%ܿ;~L_,O˛{rwR)n~N :.7QrS}/JQ-A8^0+˾N4 x8^pu<GDDDDDܽA$Hg/~= ][p`/ VOɂrx8^p/ Abw| zZd42EO+~/Uwg< E:4TN_r%2xw\ȴr=׊ +]7Rԧ*SL`OeO6|p{#}/BdbOQfOY BDDDT2G?"""""X " "a E#"""""UQjIj{Q.L:v(U?~]MbC]vʞ=iRreiҤqtirO~"OL1ƈ]^nPq Rw`]q_G;&7<ab|nAAD ~DDDDDD;DD" """",GDDDDDܽ~ʵ^+$!k׮4ʕ;SJӧ\tхbKK-v7f!3g"o}-Afr/{yeŮc6Jji<3\wub/﷤˟|Jo;N QAbw0 A$2DDDDYď(V{G "BJe K.ҠASn7|C yN׻"D"ոLǿG-DD}ve)J6GDDDDDܽAw` "!""" ~DDDDDD;>G:9t(].dʔ)gJVVt⋅^m6RMlR "v FNtU(ԻF98F:IlXqJAD_RJbHߟ˟-Wu]&"?*w`aQ, ~DDDDDD;6?~Ll((HZ=q5kg!*Tٳg{=%M4:K~_<ҡDNTt~T?^K ?^z, A+ r~w{<D}o>K_*? %7YDSjjXď(V{H DA❻wmIVnA'QvQp "DDDDDܽA$JnA'QvQp "DDDDDܽ7tG]  $GADDDD1Qs($GADDDD1Qs($GADDDD1Qs($GADDDD1Qs($GADDDD1Qs($GADDDD1Qs(Q ~DDDDDD;DDDDDDD?*w`>GDDDDDܽA$JDDDDDT#Qr(Q ~DDDDDD;DDDDDDD?*w`>GDDDDDܽA$JDDDDDT#Qr"},UTrΔ / >\~}ԨQCʕ+'w 4Pm۶MN;p EDDDDD?*w` A ~DDDDDD;>ԭ[G,/G ?:KM&v\~ҡC{Β˗ #SNێč7UF)A#""""KMM?*w`q0>"""""wA kז֭{Ν;Ğʞݐ^zI͚5}}86~r ;w` BDDDDT|1QsR38q\ʗ//&M{;l߾MA .iZ7n,A BDDDDD BDDDDD;D0_ "DDDDDܽ "۷jժw}+z]vtQ?~˹+$33CWZ8$A YvpRܙrWJ>墋.c=XK%2BDDDDD BDDDDD;DD="""""wQbHĆtҥ4h@.gO5jH ̩Q ~DDDDDD;DD#"""""UAo>ruɡCt SL>T2套=_,c̟?O~$貧BDDDDD?*w`a!""""{ď(V{GǏiZj{RfM93B 2{lq_4jH. """""*|ď(V{Q ~DDDDDD;6$+"""""*|ď(V{HG?"""""X "Q"""""Abw0D #"""""U %"""""*T#Qr(Q1Qs(Q1Qs(Q1Qs ? D4$3IL(Yc!""""x "Qr : D(Yc!""""x "Qr : D(Yc!""""x "Qr : D(Yc!""""x "Qr :7[=6]!M %2~DDDD;w`[In?A(7"""""w %!ϭ|L^L>6Q.̞Q22y lQY?*w`[IA(8GDDDDDܽ#ȼyK*U\3 ,Ç놬_*5jԐry' l۶Mj׮-/׿<`+9r-$w#KeN)OHebU+ȬkU=A׍)jʬoٶtJ~0]&Abw00b/A(ď(V{GuȂņ ?:KM&v\~ҡC{Β˗ #SN!nǡC}6ꪫgϞ^'&+ʔ/ȏ.ѧL[N_G^xth&&g)+{C b|_N_xt"""#"""""U AA8 ~DDDDDD;>Ğʪu^s9Ğݐ^zI͚5}o[>Eq_ýVZ~vy㪫dĽkr2}LKyvy[兗:ɤcr8nyFtdOAeOEth?9\QY?*w`q^ """h ~DDDDDD;J rq)_L4I bOq?F "\pرԫwdd;W_->w'__Nw^qlK S$њ|lLY2HN>e$:azdڌ l4b}?y0^Abw00DAA(G?"""""Xfi߾TVM[UˤcǎQ?_=\񿍐 \b6m*=]A?mC@qQu3;v7G6-j.Xm*v1QY+55U,GDDDDDܽAADDb;w(A_r׊=UeC֮]#6+w\yҧOo ŮM:ܹdeeʞ=ibԽI&AU&)q/W'?#A)N6<(c!""""x "Qr :S "(N "[iDD1Qs() DDvVk7Z&$AM&C eu(YCD;w`[I`AqbI " "e % "DDDDDܽ#ȼyK*U\3 ,Ç놬_*5jԐry' D{}Wo6;O+;1 hv$hn?-g*A)}I?ވ(c!""""x " "(DHYBD;w RnY`9rX.\:,6mrK%;;K/_&6lL:Ubup< 6||J3Qnh0Jg~u<=I?q\zC䢛 GJq "~v""E."򽃮3Gvlxmk.8_$NLyQrvKJ]?C*bizLK%,,stho "fm vnGu;z~Poʨ›˵&N*#vO;N#.غ b',#boNډd{ ;!Z\HIq?eV>~%5bMv⾰ȷ` b:FHQ\.e kAĞ2 ~wŞ .>eWQ ŋ*{H;pϽ`_6^&$?!sx˛FJN8 OuCNPw{)^ ;龾k䗿*Ma1r, ./gr6Tm3Z.QQ?*w`aX`}9HHQ?*w(A_rJF! lڵkĆrΔ+R-]t.7Oq{|m.HU?WP[fc׊]-^"_%cuI; Ma'?](gۉ>Ƌ;h˯\q{&wT!ZcvgX"&)Q)#dԾb cOdS2$ ߣk' T˞JQ_q \5^= CA+_rM\Ol cNNo>-UZcBQX2]lꮫ$2!DAbw00D~| #V'DAAAA7"""""wQ|y)AcriEVZ'-mԬYS8 P̞=[hrsO{1/,Al{O"/,_3DV3)[&Se"?Y'Js/z2.{#6Tl(()A$)Q'L?uuErKQ 89bOTh ]_y]߆^0Lr\m_ ;oC{}Wa#zfW3B, cnGn?D(޹{GAA$ E~baaa!čA❻wJ6nA'y,AsOIe% "DDDDDܽA$JnA'y,aAQQ BDDDDD;Dt% "DDDDDܽA$JnA'y,aAQQ BDDDDD;DtHǞ W cSmDi"QF$x% "DDDDDܽA$JnA'yDt7pm'cAEAD;w`[IpjDT ~DDDDDD;:0D-$85"*{G?"""""X˗"r :(#QrAD-$`DDT ~DDDDDD;DtP0""*[G?"""""X "Qr :(#Qr(K? 4rɨK$:޿:thEDDT ~DDDDDD;ni |ɀApF"""*[G?"""""X0[IdPRj2 l2uЈ@YBDDe+GDDDDDܽA$JnA'P܈lAbw}Y|ԭ[G:,?ȑ#$!G͛Kr׿ _]nA'C.vKIeʲnw˟-A%""JRSS ~DDDDDD;DD" Ab;w ҢE 7c9r,^X~_Ɍ/{.]_.۷o%K9#?.|7#Vt$#e "DDD(޹{HDDDP0Q,c!""""x'v儸4&h4({')))b/ SLuCu&ժU{y-$_"hEb'ùd%^䡑ró7ș=ϔ{-z<}iqoTVI.ukx_]oRيoYbo?E7{?OkE쌟e5.QFI1KΓ_{e'g{cE/ꝫ3~q{\z#AA઻ǣ'2ofsoǿ綮3 =^#p{ADD;w`]7A$H.a ""JD(޹{G"}|BzYb۳'MD=ŖX!6t{b/K)*>SQ.s O.~Lt}#utXA:]'䮷#㎎7#$y$wy3 :FQ BF%t\{ϵbg{Wψ#$Ea98GDnOt D񻫯{{{eycǿcǿǽ)(1QsuCD10DA$6D(c!""""x%6< Go޼Ir6z~믿&~K"T?M\S5H?^^DN*A):oב&_'A IA^wȍMnEe=œrޞs/8W//h RgqoZ{~)KZq~> L2"""""w q R `!"dA❻w b)VX._~ >\r*?ןJ$貧r˟g L#Qr00DA$6c!"D?*w bOY/IŊϗΝ;ˑ#G=ѣGyRܙbCFĽ.|ɠ >Ξ3:S~/28 :FHaxAc!g]~&6 2E{S`՘YC 'ԣU;z!r/ΐxKϘc$~2==6{{ DL.s毼cQv;NuP]&Vď(V{HDDD"  "DDT ~DDDDDD;ʗ//揪'|ϵˠL)^=>!A !"#"""""U!܂N/ҁAN#"""""U %|AthZ{Et?""JRSS ~DDDDDD;Dt@|1 "DDA❻w7Dt@|1$&""JD(޹{B$JnA'Hb""A❻w0D-$`DD1Qs(;"""""w %|t#A❻wƐ2[IPQ BDDDDD;ʗ:[2[IPQ BDDDDD;xʬ(d "DDDDDܽA$JnA'Yu]'-k!Ab嶮IAu%2eoʭ*Ke⒬?"ď(V{H܂N$H0$"Uď(V{H܂N$>ȯ+pt]a;ə)#˖% "(I "D#Qr(dI "( "DPD(VG?"""""XqD/_&u֑:K.2r nѣGyR\9-놌;FN;|_Es*nA'Y-o;z!A)vt~]Uw^%|@.S0$1Q ~DDDDDD;DD" J*GDDDDDܽCDZh!},Gŋ˯~+1eqߥKemdb9sw}WDM<1QՙtҤRJ2;EN"t&Hu$Dn  LY BD?*whܶaN-DD1$ BD?*w (Rj=ԓ)S!ݺujժzȩ=Qsp]/Zג*y?j\&cD㩌wo/h\#pl#\T\]~w_!74A"?AKΓ_{ lvsAOUoc?gm]oOl|B.R?Oq.mx)ox*ſyMQ R``{"H4V^K J14jP, EDDQkb7I&{s;p<< ;̙}5g!HXp!Oʒ@8+lSuKA:Үߴ,Ur]>$,@RyG3YiSfM6UZ{WZaަ +%ZrWu; Ѿ6>pvʡKow\#"n roODj-L^5þ}u$N D6n}=z!:hبH[g_\׾X'vY{V6 CV޾g+_ @x,uA:׮O;Q[g!*_`?(=˖-F8 nA B N D\\Dt`_@ڸyGaÆJ5h@_5i/Ev~}+^Bf¸헻<~mߨrC i""@8U#'r]ToTu@!qn/4X6e֢E eǎ#cʬp kr+tyž]"3I_$i7&ιTznn_$]wA$)6vS9>wM[P_IkoNfI|27!?;D ])oZ*_`?(="6nA B N D "Ѥ XioZ*_`?(="6nQ@uK.>odMM7n :`ٵkW.w%Y7fٴeSycJ_۰{˭i/Ov'm"sJ'Dukq߂b,_[AR,kק}&=[oTn/PzD mܼ@@dg z$f O@ڸyGjիdmm\EW_ŋN:>}zKw=nժrM+0q%g/e6a D^-[_KiG;>]{wu$i]Dv>jgy'J_$Lj^TƑoW,Bݱt_mnwvryhS xdlب,uARߴ,UMm"w.&+H7 !$HaVZA@$+MR]Q L#D mܼ#@Ħ8Nٹsg٤Iپ}{ٯ_?f/^zf͚J B ,~?$ӭlѢ#Rִ7}qjjD(f6ƍe2F+4QM|kdM2׾wt%eR?򝑲iMS٢m澒~|i+W\)w$,@RyHL]|E$H4)('#HyrZ'H 7h׮$)R_O XrZ'H 7@H]|E>)(c]i?Hp )ܼ@$." V.\O8 nA S_O XrZ'H 7 Ȃ-O8 nA S_+[Hp )ܼ@$." 'T&˖-F8 nA S_*H7 H wWʄ@;Db+-7rt_*3#T&"6nA S_ DH7 H_~~dy˚Q>1ʄ@;Db+W"@;RD.\ u;N6o\v谍ڑ7_z͚5[]6Df={<efMmĈק4ZGx5rI2\ԯOZ~pqI_$ʄ@;DDJ*d!qZiĚ5͓-[&Mnˎ;UVɚ9n8 'g}FZ@3awuHW-_(4}MnL٭~}pԢ;"^&! !HXpJ >!HXp|]W~cر27\ v*|ҥϿYSS#Ǎ'}0@vUkty+HxddMͺ>q Ljʬ\^޵|6u.;Pq@ľ^./V!HXpG%!.'CI"WrɒW_})/^$;u$-_ZUV ^6U$}W_7kaKI (0X,41^q#ˮmwl+sȟN^tMi7&q% [|r#J:ڔmv=d!H 7 !Y"""P !HXpj;eΝe&Mde~5k/X#{%5k*-2dt%}W+*?lܢ &]?ai˦ҶoAObOMk2آm yhCo>t_JLvl?Xn?IVZ rG6۷7Μv^,#,CI""" DDCI"U_iHZkS l2iCI"1uy"4"6nA S_I IC i"1uy"4"6nA S_I IC i"1uy"4"6nA S_ H7 ȋ wdq-M"$,@RyHL@ D mܼ@$? Ї߹jUw a;Db}H )"1ᇾuyY?q QGk_u}m0?ؠSvx%6;ql@_J\?6H7 ?K X"Gݐ@$"@&{C )"1ᇾuIA 1ҬoKXQ7|- x"׶y뭁u=O}@R;Db}뒂&"Q7$'HeH IJ )" .ݺ'7o.;tF^{H/^zf͚֭[."}}}O_wQhBᇾuYW ֵBHRV3? @.\xMkK/ ZhA̙nnl$]nc~>QJ,\"2nA B n+ Dc^"@2$!#HyI )"rYr͚?yɖ-[I&JeǎU+dMMyw8RK\b/fIymzOvY'WvР Z@J w Ds~@ʸyȺ@[-J DJ+HeH B G@R;RD٣Gwٷo_i7cp߬\pڵt6uWΝw% D>Vsc U|@+w??sGƁmf\4=@i|p 'vF+X?;NCי5sm# tc[M}΁'Z\|0ж|ƽ~y&CKMeW;_]n+`GvlX[XX}0 ?Ii?@ &5 o @]^v?syg.ib?@~"֯TK߶m-HsiS:ၶ{cF\A$w]J \'&Ha{%YKp"_9gγҦ̚6mvlyjSlוՂVZIw_g{ȹsʩS+ڃ=ۃ=z{ZkΜ@+Txbۿw@+p?tΘ7mf]@{iOV+6 ^uU ? {n3v{uT`EY3cDNؼy_\oU]vo]7hQCnM!n\OZ b mvcG:ź',(d@w]wg M¸RqގH`_H{=<0NxEbՂ\7li a;DD]@b D DDDD @$@$@$@$@; 6TZa4PWxMZ_ݻ/$LG6]I~5n JDYWrT _2])">;>|@s%qܼ@ϳaHVǸb D DDD~@$%!K/Z$w-1mʬEʎ;#FHkw, Pڷo/?ci˳aH؁Ƚq N;-}@U{g@dw) ʋZ?׸a{ 0 g@drHj"Æm*++Z+RMK^I~5n bێ) ĽԀ556mkN)tsI u7 n9w\} ' $!!ruO#""q$)lsI u7({ :|p٥Ki7&u\!+ko]vw!-P /̗mL_Y7/7rvRiM@_ui^~K"K姜 Ԕ?q\_~9En y@+2ˮ[;X}}nl ]>vQSfˁ[ t;ޮ2mW[hSJ]& ] {=Dǵп_zu?v8hP`Ob"6nA Gb D H Mw%).P )^?n{!H7H-YzK(Kx"٩S'٧Oo鮧ڭZR.Xr&LlʬoO8!Ц:D ~xV(??O:)o z*0ה4Md/ٶ)}|m}@~o/n+n0x565]7~T56a^?Cz݁ohbN[/ y6M]d|rr??j4ضgF>,#vnYE6UVզ&eRRq-mg DTkkS ~\%~w74~w/nw-6jUw!HXpJ 7nAr%Y[O ""ь{%I"6ĉwΝ;&~5kHw=_|FK6kTZ2d`Ԥ+o`ƁVwL+-d%OX DDH R@=;R D?0GuRZX-><צ.}z~}m0nA#קT6̙hSv[m)/O}) eܼ@$? Ї"X `VJ @R;DboDDDDDY;H 7 ?!""""b w@2+\( o.nQ/?)˔YL)"1>*_w" "O D eܼ@$? Їrٔ)A$w1@;Db[!""""f]aY6Ɇ!A$wX* "6nA SC*""""b+@ڸyHL]|@ i"1u=brxlyo6X<<^&lqr<#/L+ϸxҙ+@ڸyHL]|뇅)'+dz%7m^N_ʗ|y+/,&D޽dMD mܼ@$.T/%OW_X D+H7H=Yp8ټys١6kGJ_߬_|FK6kLnZ^v뛵GAߒuu=b|< yH_$< m7hQ]~]{'f[n-tta4)ȗWFU i+.%z&ocmϴ]%H 7 !HeI R _^9J @dv"E8 nޑz R[[+gϞ%׬7olٲ4it_vQZRΟ?OqI"կP]|X3W*oR#g͚TAdÏWO!-WlҬIArӱWxa\~Tu'x]*{_>BZkSLuɲ@$_W a;D{H%R/t$ D&$,@RyGH>-۷Ͽiرceo .@vU Du>rwMo,~m~j/<ZmVpn_yH䥫tZֿə>n ?ly;iq\\ o{*6Mj𣥯M%9~]N]v*[dWѹrƍWޑn_`~ -wSk?){BMR"Vt߫I5}=Kߒ;Q NN;ˋ%嶾Cz$j͚mVI;6nl<7{޵ i;>j׫'kOoRz2-|vlCGy֥äoq>t-KUحgĽyz}q-@$_W a;DXܷb@@@@P+"YG R7 a; 6T9h@_5i/Ev~ٴiSymOX{0i֬CFO-۴6`C9r27MYb_w.{:ʔߒvozltgdӍ[HwyR DYh rigIgʏm5j/;cY,vV؋Z/49krMg$:7Vд >>A>oŖҦ;Ku76a{Mڸ{'l<]W rT݂RT\܁r}jAoZHTq]%H 7 !YKuK n DDcH2M!HXp"MhBٱcG9bi풚2+}ڄuS+F~hzz/P4=t_6.٢e+.)Olj[v贋MebۏjWuk Y݂HRSfd6eLԀJ;Fvy2jA@y 66eՓgMZo*iA}ϖG6%ҍ>%Rb@KJ_IZ˴@ĂwQw.OZ DcIJ9D$a}Z}J7kl2iCI"""> DI B @@+"YG R7 q"Ç]t~#kjjqdoȮ]Jwy>?ڄuS+X*К 5߽<>Sf%+;WJ[n/_54S|y=3m֤ "Ra BVVդ|[)L{)]ֿ}O.h|R:jsoz2+-IJ9f"?s>Wv]$i_"iw8%)L^l"Q ""YpJ B 5>w%YHy!qիWZdɋ򫯾/:u6uKkjJ` Ҧr}ygW^Y&3gΔ͚5')bVش]{9j{0>Oe6Aǝ z)~9^kKo msH+z|OI7urΔn=3Mk5O^$e79Ump+0T;｟<ӥ]߿dQ# _l rwS6kB0 Ǥ qǿX D̸ߤz2m=W·!U&Iu*5{D mܼ@@@@$q DD~|T#)r?wؔW4tY6iDo^OYFW^ B ,~歷*}-"}}}؃N<EdK+Y2Poȃ[l"[i+mʟWA'v`r請˝OZͶZ= 4UwT"~)ȗW?B-H7H=ٳ;wӟ'-mm\>#oViG)^;RZ;GyXwnWC2o]DfT6ߤF^sLk[+KaRuס&b ½/!@kɝ}?F^=y]9r#I_,b~ǽ q@/RH R%Y[A i"6ս+pEIkgMmթS'.oذu]-77|sKwy{~<. nkg-[oNZaOS-ߦ6}sytVfͳn\Za]O/iG?@F9KnwV8e_ypeYѹr:w7=-5n"x 1n/aw B<&˟ci[mVpn_yH㟔Ŏ!Go|ci?դ\+5B]w3V~,}m3 Gʌ>a; όӌ'qx>rZ=F"'X-}(R?W̦bʮZ-Zvt~@ qgyi4 D2d=Ŏ?HXh@~D mܼlȐ!|goLZ>Z?_~l׮p ~#}iwi'i/UoҤw}%/>tqif+moZmV7tGZ+!=N."yP򬁗KwyjB NQKګ.k^{K+\߳-ixzigygכXiFN~iamaFoH[]{tZ(~Ńex&}5i)V蜸5i&uZ_ȘIۯw>{No2l>h{\盶k/1i. -țT-4gKBd{|gD27Vyi~q ibKiS}.l9ai͟]y>//B_R׿]8Pˇ([i+q-w L+ Ѷ[W3&en d./R?6uI_RzzfLd=&+D!H 7 !!@0 DֶO B @$"kK Q a;mVnf>w 2+7k)VZ)[o-{v|tۙ.4ϼttZa϶U{MҢe+yvKGgi_r7>L+{|'~}mg55R3ϓQgy 6.63Sf/הY^kGı'j2DǿXӾ2SYq-@#e.J_RZ/ܽdMB(,[}nl)] ."M8 nA r@dm \D1nA@@$ D֖@$"kK Q a;R D/^$?|KK5k ;\鮧VrΜg1c9rtu֙=l˥TCnW@=~G'Y".{[yxigJ>#?0[7 oG?L9e=2Gچ{ȓϐ'l #N:]T[V`΢b#'mf-ZfUҦN"~'mߦMV(p )ܼ@@@s@$"k[HXhm;+p )ܼ#@Ħ[.4i"j+9`f>T|ɲiӦFZ۞?gqlѢZv~|}@.i/9~ sMo,9ycsAWH{i˥lxt-\6ݸ#z[m%yv[|/#RFH+e|R߂ 谝M¤ w-~Cԭ), )_i̸?)u@/vޭ.v}R+&cgWlsi\Md?ۿ"v? u/(־We[F o۳ݨ۷P&u"ɲl2iCI"0@"kK M-@@$+Had!q!Ѵ\wA,\뛥M}ڿy¹}9C qM d%A.D@;Db{HFDK baB4D mܼ@$.dDĺ$"&D@;Db{HF}/V;tu%}- DD0!"6nA SC2b+G@@$ABh@ڸyHL]|ɈXh@ڸyHL]|ɈXh@ڸyHL]|Ɉ6!HXp\6!HXp\6!HXp\6!HXp\<<^l 4h,}K ʞ27Q27  a;Db+r!H`%I F8 nA S_ Xo$AT$,@RyHL]|E.b%Ap )ܼ#@d[dek)}}~٫W/٬Y3ٺukyeCoʕ ҥt+ralvskS%A/I/>t ulԤt_utIkٖ[˳]!~q6!HXpT""Q%[CI"rYr͚?yɖ-[I&JeǎU+dMM7nts}]w +ra F5@dÏWO!-WlҬ7Kw-[&p )ܼ@đ@$!A*@eC i"ѣ۷Ͽiرceo .@vUsiSy5jH~6['.wp@gwYeOnNxnz|OioѪ<ܾrʏ??vY_@+''wܳB]_fogGʌߌ>a; \OB}F=F"'猾ucRH>v<3M1wD mܼ@; DD@$""I P@ڸyG3YiSfM6UZ{WZ˦ +%Z\SO=Utq \(lԸl$ykKi];HZߔV=Ziqu^σg \ˋW ."NUKJ+X[cAąɎ{--#k],;vGNZ?/q=翐oC嘧-^k?ojZ(mϸxt0 aÆo\i?i{NȌߌ" G-gCƭ.(Ϛ{\盶k/1i. D@Ăwe6m,W rK(m )]<=Y@z]^n BԁW~$}mC i""""?X7P("J hA q"MhBٱcG9biJ5e֍7 wqGk.] g^:T]ozt 8wMԢe+yvKGgiS4lH>ƇݟB?i"qohHkn?.[} D캱vso١. 6?C'Lﶧlܴ 9Bm\{E^w%m|ҥϿYSS#Ǎ'}0@vU]wi'yuJ_u,P8a]jo+˘}m}\lb{5ҦceGHȷ. D{ڄ{\m{9}M6]n޽d,˼zt2W K)K͋Ղe;%ru˸?Sf֗@Į3 B&!@A$w@$ $)NE8 nޑZ z*Y[[+,yQ~՗rESNO]O[j\iSe L-7h#H_u Swqr%r겷1)~v_lH N/,w 2 ̿{d {i6u)]}6gg^&_f2W bKo ev7ߺqV[O^~TiSS7W w?].>XnyEߦT`GKͮ^.I[mO^$e7iץ.6~~k a;DDDD~?n P""I P a;R Dlʫ;wM4۷k֬zbիl֬ dȐz'SN9ED-p(X9K+7icM͕n]!;/V0r}omRvrtҷvoR#-n/xrI۾6Vh#MB綿{v| yLxn+Z!;ooȃ6#_7-a\~]v7xBƱͥl69.u5as%A$w⾒@&.n@@dm8d%!I P a;R D."V\뛥 "bXj#H 7 ȅ'"*@A$wW@  a;Db+raI PmCI"1u@(nCG['bPYl4!HXp\X}&"D mܼ@$."""b>;"6nA S_ 1H7 ȅ@;Db{GDDDBu@ i"1u=#"""bn: q1P@ڸyHL]|<<^`٠Ag[ק.~PI/b<{NȜGʜ6_D mܼ@$.| X"B_x#T"6nA SC>"b1>I ʽ}(T'$,@RyHL]|H ܁DX$H 7H=Yp8ټys١6kGJ_߬_|FK6kLnZ^vuʕcog}\ҷ.|,n.}m09}IZˡGJ eӍ[HwyRV'[@ۏ*ҽ m7hQ]~]{'f[n-ttp )ܼ@@"%r~TV"P a;RDjkkٳ͓-[&Mnˎ;UVɚ9n8?ä2./nWC>/tu j7\ H:-w QGguT ȫ'ϐӖ+GN{D6i\^뛥ۿX: 7 !h)+HeI ܁DU%E37H=ge߾}}H <Ǝ+}^pk׮]ަMyKw/~q<裥}'.wp.@aqYeOoZnr>[Agƍ\}}7~I+P eGZ+!=N."yP򬁗KwyjA)_=~If~lѲE׏{[G?.7i)_!yz_]+fS]Ӻ*q]7 5w-~Czp^Wώv>~\~],;vGNZ5y!G=>_֑X˽}Xh rԢy8qy澑q:ʳ&uc_@Z0VPf 1*nA B B B ""Y DD&u/ro$ $R~ADDDDD,ĨyGaÆJ{p7 (+V&H 6$LG6jHO zK j.t9,.wM͕n>t }Zv%{~Җ^k_65G:tEҦ0#kX˽}@]~ڤx ]^;)l mwUDDDDDLʨyHF@f&!!n@8˽}@@@2*nQ@uK.>odMM7n :`ٵkWi\RZ嗗p߬w}l֬tVq ՟-6]#m :V|t . D{ڄ{gIjĂ*+$_|í^Z[G5-B DaÆo;%^.ozZt 2Iiq!WK}zKw=nժrM&*6e&=iSf~2m.~}?gm9tdyigJ>#[i+`oN/L UlAp l(k6+ߍ}}-ٿm'ȍ7n 2Ur֓>U>#="{]m }m&Voi/)fe5n&"o|1#N:]Ny-iz/ n&BV Ҷo1z#kX˽}Hnn nFBu@ X˗//|ǥo'{;Fi˸d\bt/R7 !!!^f""""iY"""K!BVK%Fx)Qqj;eΝe&Mdk֬zbիl֬ dȐgΝ;WtAҦƲ{o)}>[б|˳7m^6icM͕n]!m>w_.`r,vl-ҎCMjB>V݂ۖO_ly;e_$ aV@\uBϿkԂ\RmϿ,wܳt;j rmS1RFH 2W@\n?϶oiF3ߵS?)˵6f_g:l: s^2j bg bZ!eG}$${ϟ#Ĵe\2.1K){~DDDD-ٿm9H|/n\n@$˵}>sר_D B$<K.RJ➟!s I8 {AVmʍ>Pڔբ}o;cK%Fx)QqAD$= V($aɸd\bt/R7 !s I8 {AVm\,$$K"%R"1u=#"""bn:WbjW\&?`%ɸ d\b/7 !1 }/>V;tu%}-[߱"Bubjg}ZrJqȸ(2^/1*nA SC>"bQ/iw"d(r1+T'{AVm\+$$K"%R"1u=#"""bn:WbjW\&?`%ɸ d\b/7 !s Չ=?vUJ5+Ie x dƨyHL]|QXڸOZXI2.EK 4F;Db+r#FZWbjW\&?`%ɸ d\b/7 ȍUʲeˤajƅRMrJqȸ(2^/1*nA S_1µq+Td\2.1@KiwWF*@}@pm\|U-$K"%R"1u P_!A,\J5+Ie x dƨyHL]|EnĨWD ƅRMrJqȸ(2^/1*nA S_1µq+Td\2.1@Kiw,\@vvl޼ay#o/X#{%5k&[n-/l+a&fm&+rclvskS ?$2qQd2^JcTܼ@@%  _q$2qQd2^JcTܼ#@VΞ=KYG9o<ٲeK9iD߿ر\j?ƍo֯O?X02~x޶O_@~@ X6.|ŕjV@ey5fM7'|RږSK 4F;DD*ZbڸWIXI2.@nx)Qq|]WhX1vX .]v[o 4+WY/yGJw'/]-?l֢lY[YUH7r 6w.xUr_o?%y٘Irm[S;s_!oR#?4iߜ]yYe;UN]~7zNyg}N{lF3h2w*@`JtwH+D3fΔ>Y{~󮻤V6.>êJwIff#&}e\2.`ʴi6 Z ⻆IKiwf%!!(={ةD D0 m\+d]?Zʸ d\-_K 4F;|_9J2kڴڽ޻ 6Vx]Y-(iժ@Ħ jV[m%.V>Ųc}Eˉ _^re(S}Y/3.$w?`i[QӺ*q4 5w-~Coqp$'tOe rm߹\?i?16N9C"~bo7Uٳ>#;7 !!H PZSbK>m\+iH!2%!a\VH %Re DL2kѢcǎrĈŝ2˴tYrw^*ݶtXaWߓ65N{-;tE?xfȩ˫'ϐMo,ݩ,а >g˳.&ͷ o|)#v:wL*9ҡg?Ղ=?v*Q ƌ/w˗I+[; V^~%9{-g -%gI[Rill;O?vv<`cl{wiҖTq>CY//k!G-}}Ja]?R"1]K?^Zv|}|K[wr`}icG O=!?|\s޹Gqȸ\|+k:2?aA-Ή~l}n QZpsn$c`Tܼ@@@c?Ղ=?v*Qd &"ƅ*SeI x)Qq"Ç]tMyUSS#Ǎ'}0@Z.gO~kW{rvZk^:~I~|<3۾@c2n{%-谗[Bfmͺ@z P-au 3zP>wHٳs7yg-TIM1Җ2z`b[T>]v,s#mn-Tq _q_ $809$")AçD̨߿fio )oL(]{mOˆw]Z *2qg}Fr~Wn^Z;7q4m -kg1^QqG"\};(HƅRJ)$U""ʓ@/%R"WrɒW_})*ݩS'٧Oo kjJi/*+W`bSj=S>wy)yV]]}rK7MsH ]} ^w,٨IM}/w bw=}ޖCOO.l#sϸH?6폯MVʲeˤaJ4W b{ٷ-)/yl,i u֗k*) ĈGnM^}j?ǥ-՞3jH|ڸ~d i^~YYYoJ$5e#GH_۬QˤfͤΦֲv]+]fqI bl NVK!n/qw0w3|Ii@od𺲺SL;7 !Y+ YB. D!!!TuPj DD'_K 4F;R Dlʫ;wM4۷k֬zbիÂ!CK#]=ṥ҂5ng' }nNrI_Kһsܴ]{i/#cM͕/HyOָ@j Dldݖ?Җ Dܩ5~w(TP-y8l;VZisRxd幦r?eVe\ڸUJaҧ~"?iߺJa]?JDbO5Ni O^n$NŸ d\m@1Ne/ D 2mXieƨ6 DDD"H "KJ)T$!a\V"~/;fjH}WNB (jKgZRmH>"VmM9CZ%MNa/Z``SrXoS}俗/6ըcs[ IkI+[O'6.尥r˃?RZO>>iZ n+?;_ZK[*_͌!niSW'(ߺw\Y߽viW̽#\2.k/߇q߰n惙23dyt?@d ='m+sAfew,]/1*nA S_; D+@<D֖@@$6.|ŕ$T$!a\V"~/7 +''7lP«7P_!Y|tKri TT4QZa;'MVIN1]2zt`OֻGZ"ŋ/^cJ[i[O|ڸW F\FVJɬkR"M6z fx~㿶l/F[n)ל})DݮT^{I >gߺt'2qs%҂qlM J1q#}{~ґR"1uH R^ D@dm DDhW\IR IuKJq"~/7 ][Qlw \RL`c""d/I_J{｛V-+d\2.vwSV$%R"1u@$ !H<)$!qȸ\[@KiwWF*@`DG6ŇM}eSiٔVo]uANU+Ie`K9J1}VVj/2*nA S_1Ղ=?vMVj"dVx)Qq܈o{~p= /DG+寷q,i+ߺ6.yVj[2zΉ򩧟>(%Kw%Ї"")$>. Dx R*"1u ?!""""b bڸxZXI2.EK 4F;Db~CDDDD@µq+Td\2.1@Kiw%WIal w@yQ6fkSX'Wq`kk5h`-YK ZUrJqȸ(2^/1*nA SC_%I "uS_D$)"jƅRMrJqȸ(2^/1*nA SC_%ic8GN_zOM۵u "⺜5ټ&%+-&^"hbU-$K"%R"1u ?U"$ADj@xQJ5+Ie x dƨyG… dn͛^;Rf= l kd^dfd֭e >]}!zy 6uIDҦkn}4v٨IS.rn-gBr尣yC65mjʕoVd\2.1@Kiw` D`Xb5jW\&?`%ɸ d\b/7h׮L-gϒkQΛ7OlRN4Qvƌ2j ҿٱcGjJ9rƍ"'/]-qR~ro{$v{;n//b>6[l)oz4=36ȩKko6;,s+b Qg/6(e=tەjʬJ1=@$"wM9}G6BJ̽7r 4>.2zl٦to fE}>sVKn-}{cj˗/+VZU._;Fi˸d\bt/R7 !$H!^?$AJ@$ DD($aɸd\bt/R7([ bڔY-;v#F>a"2KJwm?:woYZ./ Jv`k tҝ΋@cܳ/Jko^6.٢e+ig55[3ϓQg{͸]^QL: D2~mwUN^ZRsmOٸi3gf|oFkn?.[}9s'Җo{IÊ'ϐr|SjԿ~𥴿!HXb ٳK(_{my־}󟗾cK%Fx)Qq_`;",q bK ""M Id\2.1K)wkN-q>|ҥ 5odMM7nt 0@vU]]Y`sil/-D{@T߿Xmk)}m|RZ);^v5e WKw~*o{2kSȬd5e'W R3@H B^Rڮ>Wv_-ذaCyHqexY-аwg_]i߃OGt<ǧcN;SѾbfoF^;~hCӥ1BL[%xaҨy "I @@ DD0 DI "G Id\2.1K)w^JJ}՗rESNOҷQҶjJ` Ҧ]);89~9ur2ꃭ=xVz b&j/ѶydZX bt rϮI^pnyF~ !6/oHF=zYצhlu^?^vs1 S?0[6kB D~J&Er]v_Z%vQUf]v贋q.& {zۧ_@_6k+"k/G͞'-' ڪ7H5|m^w,iIM}GDDDDDLۨyH$ DD @@ @$"kK ݨyGjMY5q❲sβI&}_~r͚5]?$`-ZH_z͚5 2Xr~8Zl b/I~eq鱹ҷ5iŖwl6ݸt\盶BJn!S6ol٦~vy?HgNxnB,(9'R"=0V:qׯlKyw}/ioq]Xz"{ǭKJ -]V}&IwÂkyoƉ_ 谝$ۦHΟ>r퇯M "ۈ5*nA B @dm D @@ @$w@$@1]}\Do!"fwW]X\woK\"b]s3rL͘ϻ^|SV3SVh\뛥ͺ?i-_J_4@Av낾b."7F;Db~'f%A.H)$A5DĬQq~J n(;vGT%r}rÆ /*}mԦ CD5DĬQq~J n DD| b}WEx"b֨yHL]}u w q:J:5(&u}"gaX@ĮǚM7Aږèo }C8J SCb]Wb D6[w>ۯʐ@@B3:%Ї"L8"1u ?!""""b d)9 #+HL]}(e˖I#MϙqgY Db I"L8"1u$Rs&@YGVBjd)9 #+HL]|!A%:f7-VJ_bB8 B3:T"PN!HX p֑@$.%rABL8"1u(p7>g!udM=Yp8ټys١6kGJ_߬7plРZn'l. LSyoɱߔZN:]LP! DC)Sod)9 #+H]], M8 [.DҡL8"rYr͚?yɖ-[I&J:Θ1Chb{c)c9mrL7we8THC('$lLAiƜ瞗Q!IB3]yT@u:@CB R7(9Ӆ@ !udm׮]Wڄ@>xy oJTZ3_L>w(?㸖o^)'v[X ;?Y)ݩDC7t(9Ӆ :ZB B Q aByݠL3B8Z@"yVڔYӦM>a+-z"wtKZ; R|S9aUr\'>|Xt s]I]+xCS__P~IϼΉڊe.7rOH;|Pƛ׬FR>:@! fϙ.qϳ|AC<$uJ8Z@dذAk9h@)/-pwy7#yJ|Rwbwr}~wi D [ rӥNy=i'q.I+xZ; VK>7o .פX_~>g=φ{> ?YDmy.HK3~V; ekF[#J`]~F Dfgm "-°aL[nk~(sb_J])Ql0tb|S.|u lق4.B3*n bSIoHG܂#O?ܦz͕>_ϓǟ|"mn pL D:@8J B B %@@$Kϙ.""Y DD:=q>|ҥ [i;z[V1)gw҇=%Sf@%RwOr o\)Q;ER`TAQsKl;.Qۻ^bSY;Ӧ^3 Ϩw{OwO.n b/g7m*\SIVwXjfe i/C+cޖ^~O^WV D:@8ڧ,>g{?B RX@:kN<YzK(Kx"٩S'٧Oo[WJ D,mϷ&oJkژw~3_*9nӕə}*GʱM3hnjȻ/x_F DxcinkG"7VxZ FJ>gTz gӝ(הYeFR]2t;^`v\S` Jk5e?B*.`x%$ !Rs Ⱥ3*""Ղi|7r;eΝe&Mde~̏|Vw=?lР:mѢL_Tq[rl7 Z3~"á?m9~7fߦβƵxSN:]9f̾d$rAK"V|`LiDKw23ʤyy+k>gTz b3[}EҖ?#Ҧv2 Ϩ$u&{) ~Җ믥#w3EZ;7ti,&^z*~PɄ"9$ $RA HaT#kjH} /~OEA[(ϧ||"?OxiQf}͗Vh/<ΧKH >ei'N@u`pB;.֛T bĽ-(?,iŤ̾e}$YV 8/Z4igp|ǥ퇽K[iQ("1ua DDYs Ⱥ;.K B P_gY Db rUL?޶uP(CP)9[2;?O gY Db ֒@`$,o }FD#ud%/$&ABLȊ_6M}eSiٔ^{a gY Db I(CP)9>B #+HL]|!A5 p7>gG 'O*/:㡇U/ :TQ a~Ss&@}@ =YGV@~-[&p7>g!ud%)@ p֑@$Rs&@YGV@~D KϙqgY Db !,>g!ud%)@ p֑@$Rs&@YGV@~D KϙqgYSD.\ u;N6o\v谍ڑ7 7\/4hl ;{,yf͚J#Od)9 #+@!,>g!udM=LYG9o<ٲeK9iD[G3fȨ1O=Xy9gK_P8$,@Ry#@ a;ڵk'|_9J2kڴ'lRȟr-H_۰P8$,@Ry ""A$w-6llРZ4PL*<ٵkWiAmX(p )ܼ@; D#H 7([ bZhBٱcG9b6n 2x {O>X a;DDR'H 7({ :|p٥Kk@dȐ҂>PڮKϲeˤA$wH7H-YzK(Kx"٩S'٧Oo[WB{i{)?#kE@ /RBe;C[Py@!>D"PqoFNxܹlҤl߾ׯ\ftI*-Zς_[G} o'@ [@:I꼻yH D@ [+<%U(?IR;R D(c=V^r%{˻KHR]#_)TT<äM~}ɣ:Jԕ0,%㥗^={[믗e]ܿ^?N¡\5~:nA SC ,uJ)-DMriio/"@:p@~D]`TJ@nA n -ו0L;(9sȟ҂ '|R6jH8P??o!*xYW(uO>YGViߺwC PK]R $"u uSh\ig\j{"~{]@~"1 a++GqxN;$~iY(qʋ/XnrM6ݻw|t5jСlڴ<+"O?]Zjm#}gqy1cmԁHۖzҎ#JҎ}dT]ocǧ@55k^z6m6Ls9O,g}V|E}|KP".[n3l0^vsY,qqOzt?^Dž/񛋙3gJ;.vm}i,YDhB4{:Qq@CaJ]`GIj{"(]PD w0Р> AZ`B֦ 9r\\]I'$u&`fo:sҦbT6l(.\(/4ht:Fgr! FVpy>#R@(v ˗/;찃6mt#[ʕ Vv5kJR-*<ǽ^|Z㏗~裏`myZ`O:,ju| =~q)t{7,תU+ٯ_? /|'6n8(>r߯?;a+W R_o.?__~8;(˰n{.{Tܼ@$P8$,@RXw""Q [Wxʵ@@$-ťE @_hPuϷ -@AZ`~']A |Jw Vxpxץ͚5yTHЬ\֮ʝ >}]R}|\^w>m ;nBסQjߤ{Ҧ,yI[ %u|ƛKK_ &N(?)8SN9E~[K7 ȍUj!SK>][  ?gZB)uh$hxBȍUj!2ebS~boSQ}Ǥa`;Ok%_$Y ๰‹@dҦƱYv* 6@:'*q[1-/zGin(sWTo#y+uARo)n&^{I2r2LjʬuR߯^Do/a򗿔GyDwq?6,hlԨ\jtwޣ"1u P-CaJ]`G' ) ?gZBɷFF "">DA ."wIt^ }mxUo:Gڄ!HX0.GѯJŦ쥴ƾ+sH_)XΝ+]ZHoO ~a7H+t˕ cUubyS.Q|;0v]N S( {iR.TM ^C VС˥ ?k7`Y(qܯ^从%W ]rm۶ҮwwvM1Bn2{Tܼ@$."wX@O8 |~+8BM0g*<[B R )-DM]B  OhPuY|r~rԗ7K_[?ur?\/}mW-[&p L ,Ow%nҷMؤHwq ܗ{_L+_1 ?˸>[ˮ.}mt%/5&iώ]ƹmP&"PϸyHI@mB wtQV<;v/9z(gHZ DmADVU/է#_ZPkWVЂsJ6i|v@AwXB R绸nd'$,@ZyGӖ3K6a D̤݇_ym{FI_,ےQ3ޙ"}mЂ.5`[yŇK6ity:@s!HXpXI8 nQ@Βo 4q-]LK?EO*}dk[I0y}M-y?Oh!HXpG#@s!HXp"/:t|G˹snݺaÎ}d."wO,x%ګ)67J^]M^ Η3?C^[/y՘}o_G"/l)(Cyc뭷W^ytM 7 Cm۶?я$4_<#K,_^Bc""^ Dҕ@9$,@ H nQ@/W_}޽lժԩ1b\pt3kҝȮڵ]Z+r94y[I{HmU.xGy;KB Dl~{}寻o"m?W1D|W xk{l&h!HXQ dIZQ|6}?f͒'"w F B @$U DCy#pVz ߤ5DDҀ@|yGǎe\I.Ǐ;w<o/]N!ӧOV^eU-Cb AI+HV]w% n&}J+.{쳏=,u- +qYa "s̑Vc LV gԨQw6+,Hۿ-fEIXAӰR^z8@[G<M?ꫯ V{+e]VZ`7G}TwK%RK.6~iioQ$=?qRn M.RwޑFϞ=/nK;>ä$=I5~w,Q뱵}gG!-ÂW_}Ur-2-+*q)zR:.r7=@UV҂36.~\guxbiÂoY kV0tq Vs{NaKf Jn8Yn·^X_p [Ƃ)[*q"n!= [ƖprIZgZߗXzWK l9{}}=9Q+y,w&%O*WzlXiӦI+RSRA$O=Ti".Ů'I^O-x@ΰ%,n2,#m\ i~XŰQظ^RqqqqgD 0 iA B RNAF0.I~G_TRc#]^;6^]=c\m~;i]2-f/OŖгԎ_/~ i׷g-m^w$W,GR a A"ͩQ5/H7jD/L^q F>}mow}WO0@RC -V(ѣ[X)F/nn9BO4>hQ+;'wEJ]5IzR:ο۰sliVZIZvm7iK򗿔w;w-go߾O9sdָy]DW,GR a*Hsu|q p""B:HsD#O#) na׹"<0`Wir ҷm)S&K8&6-'/k/G~%yK+`ԦD8 PX0pJ+X /0R Vx+a|t Ƃ  oK7͜9S}qDQ[`bѲk׮ nVDDޭi ^a"{Ȼ}~,pD^z\iyЭ[7imK#QXAזd2e%Ong\#<"8mi;ÎߖZn=d]vFI/Icvk[F=dێ;>ä$=I5~qJ]51^Oʽ^'Zo!m!F~ ܼ#6")@#A"""""vϤŨ8ǡC.pGN+,jG[oUu4q }VJBLTֱS6z}UWoKYK["e""؀ԦD8 !I";*D9pr&l-ս{wyuZ D36|z'OW~|M_Vr7ϑW1Nl[/o/)W/v_/84LUZ.:z3 ƴ?*/^x5;Gvp\ssqSdN~&>]n$iw8Gn̹/gu\\:[3Qftl3\iǿŠ}wK> q`tr=&JIoN (['mw?mBnھc{K_̼yA@|Dҡn=֖9c$TZ^?k%liL{-Uay;:vm'!i=Hy4I \, IH;߮ʁg}*^id-}ۄ-5ӿM6D׿AZ bg-7Xv-@.> o[G^t9;_KZ;|i2i>Aw';!2i-3HχvwivI҂cg/Ylu Α̹@4i3\Gj";8Yc}A.'Mc&] DD@$j=YxM5rH_KF_\@ EO׵w4>"% t "dwT-;vt'ѣo"v<#^ȿw[V뗾?Y>:qvj/i/v?VK{Jw{ ݥLؒY}L7%,`%n|$i%+< 8uW|< 䴏/K-syڛN";n|׭`oOMm Z0u bO'j"n[pDgi{ޏ묿-0i?v.o~&]ܩwNX3i DS)Z bt{}'ɁgNj#G=pt3&9YuOzi۟t޶`ΕY"M"ORgb'V rނ&mi.[N~<^?\Y P@q'!!IOgDҸyG׳:Kn&l@䪫]Q>Ѓҷς.nҁ=y (Z2S6}L"_ .e_V̲qϻ_.x|mO"{9I Diqgk[ T7 @@ D$)Oz@*wT,yСCc=*/XΝ;GvMv+l@$zY2K7=yy_~irQ=xKʗm!m{@$i9QvWMk?^i7 { $'}<ˏY"+u< }mqoyr'J_ۂ}+v}l9X ӨsaWO6~gu\kp?;Ｑ)HCaC=TmVG?y_<#-*GN0@Z}^q$iڞ@T"M4@ a@43.v ~ꫯݻwZ#Fȅ Jw?f. ZjQ/y+gW\}X^.YW9ϖfpk!>w^/.e^ N$[4N[>#ΕS?.m;gL˵'-(I2@ruϑ+8Nvyc֬Yq<䓒@ ;zkyWJQz!p$i=Hy4I \%C iA  !if\Գ."'biЙI__p i&?pW8 Y8D ?4h\uU?Oɓ_-."O8Yib yʸ|7іwJ?K?4wK.7ܼ@$."'bI RD8 @@$[-tC#J@;J2u9Mh$!HX0Jqˉ'(99w\Y+?w<ä.s1j(+ȯJ>r̘1oy!H쳏6l5j_+"/+պ~7G- 7@L]|ENF@<p LT"/4zCVnxJ?K? Hu qn`|A=+r"E{Xyvv'@#A}ݥoyѩS'yJ{O~46tSy~W\QF?ɸ=B%\RǏ`9`ie袋?ƌ3}^֭vm'z)Y+ :t뭷7n|7dXN9ZkIϱc7|Sv>e…\c5䡇*?H<9s,6 D~O=T}oWۮ\rwSRE_~)G)^{mپ}{ioKJ_(ӗ]vld6DWD̋#"HC(r \FN1HT@eD>w +{64 .v Y_1̼yA9d%,r \pc&L UQ*O?Bэ7(]z%8h"i=zHbK2-GG}T=Z-e[VӧOݻwCɨy4|ik].}|+pi[Z r--E7){jk71Z )*q)Ο(Fb{7,0oA.m>Fڿv~~7.nA P_1 CTHZJ腖b!iwFb{7DD nA P_@!@a$-pY ..ߤmoK[%B-aK~/n;+iF>s^c=ܠ x?piKДٳ b5[o%]ΖȲ^ ol|7){@ĥȺt%orIzw @ڵk'߅O wZF&qn`|A=+!"bP@9D( 8^hU8 D(V%IH<F/{ DC oܼ@$."""F CTHZ 7 ]l qIZh[-QbiKnVPo۶,l?nA;VG!yY%_{-bfuG\>nɬiӦI{8-uGˇ~XF-֒Y6YfY wR7ͻbDͣ("~Ok5)md]O:w/?^m)?{=`{ZwNPBzWCDh!r*PI \ip\RmDhm{wňGQ"!ii/?^ DD |g\Գ."_=xgʵ^[.5|)ޤoq*uT;jdTAT"IF_q'?q2IϥZJ.^XJiߍ;=|pYw$W D$ɇ"(EZA B @@~0^-zo$!q|`{^WOorcySoD ƾ+,owQZ!-p%-DQn K.|?9w\kbmFprѢE J=zv|Vh,nj#:r6'x%̙#k+Tْ=ɓ=#WXay)W_}UZ^cǎ7|4#(kkׯ0`t^ "#Kj" V׿%]åX ;/q'?QՏFr)zo^+H<Iպ~7:#mi2s=W2oyHB]|Ez@$F| CTHZJZ -@@=Hu QՏFr)zon`|AGyXtC9q۶)Mio.]_yeGX_|vgyCGH_z@$㱳;6i E8 ;jO.X@C:G-m֭[K軥%b_%GT°A޽K/v^WNZS5\S.rgϞZɁ0nݺIۿ.ON2Eڒ%Z6nDd=ty=v;?OZ~]V_}uyK@j 66h#9sLiOTAځ#<"{avWQR,1~^w5nq(U.^ [>ڵqq%Z4?,_}iTv>D DK  H "%$l\@*PI \YpB B ԸGW{7DDDb70 СC\#9{l+kZ[o"gq)E_\xԜM=J O Dґ@$-pK+XCAwm7vIΝ;gyFڒV~eӦMVгVw}qr].@r瓬Λ|-bXmg 7 )E_$!ɓ"H YAƅ@ =(A>\IV@BHX >\ڄ%u&#_&''7Qn~ֲ n,_tt77`crIe^FZ?xi۝ƙemVG=>:[/pǟ(eWXVnw9Iҷrv0zkvkn4nlr0{@߾X,Tmnr![iyGX *$=g>ت}0ۮ ഏNs(O?;XCiaA=إSN../߽_~Y0Jw;~nMڒ(R1s(>p޲;DewT=O}+x㯥o"۷0{H=ݷO_\d%_]n0y9WOkYCe"0yo;ߴO]4U]H> =Ykp<6F%8u(}(G DV\}E9IV]&7֏ekW'H> D&3Yv&:x#lrΣxįhAiO?}?d,pM/ $i,^XZGŰ|Ұ1anA@j}ZK9R(y뭷}zaI}>ewĒ@$!@$ Dפ/ZHcy7Z 2v~G%},5q]h馛\~eҷMX_TK _J|*{_}ߴ@d+6ͻMgl*}m =prj-d?_}% %ϟ/-@""~ D,H:@=B ;:v(uYr76aD~akW"Y-5wM>:O.}t0y׭N7$Mv{px_[I/"zR oA[u]WN8mkry yrzI0ukӨ`v!@{;;6i Mց-eij>+ 4."bKi/Qwry "I @$%@$ D!!4nQ@䥗^C=\c9w٭[7iKW6n oC9X>3Җ0 ;5o߾2.,""$ijO Ҳ"H 4 ";*|҂ݻVZI'#F .~fͺ]ڵO/BnWL_,5Eylֲ/>rꢩҷ"?7ȁD,{~qs˕F$m 7ȁm&ݾT Dy҃'eWE=q!([o-J P@~w|"-K B Gt$z@(@@ a.nQ@^uщMw/}m @}v -YfK%tMDF돔XGڄ"UA?a&r=_^Rkꫯ?/nj#ofZb}Æ F BQJ?K?ʉ'(99w\Z+gM":Tz" uQhp BA:T E#3u߿&ܼ@$."""F E8 & / O9Zk.]ȱc7|Sa,\PxrWkW\QnFr̙\TAhM7~ׯ~lOt)P_Z]mr*xْvǏ/m>tI{ޓO?TzIO1JGW , .o{_ʑ#Gʵ^[o^%ԮV'С\oqo!v?#9}tٽ{w*#FȇzH7ϟ/Gbdzn_ ,K޽8@-RZ*YkKL0AZ_+p!V -~iioQ[2wEߨU^z8@.ZHZУGi~O,-PB.m"HF碑?CVn_.eHZ/F08e}=.uχW;D+!"bXCaPʣ BqOW1DDҸ:^Ƌ@yA P_翑!HX$aM̞=[pS*V[Jkl+VrZ B\pt&m #/!3fH[%PƿQ^b߿_.V]v瞓Fi\{챇viDrǩRR?w$%|ӇM@% DAH<F/4z\*@ 7 IK$JwKL6MnfҖ 9?,+dYfYoFْ}6md1P`gU+Z[-1claRH.YΟˏ}n۶me1}Om)#{=wy4~O]l {X=ږ̲|eI|eEyX8y+FqF;DCDDDD& DP @$qǟcK B R THnA PM_=8tPk1cH_Fqdσ{J_$zʮr76(tdb5oޯ%CY`Kq|nt"m+V0vw,wɇwyG$]2Rsiؒ5G]vc;;C$慤08% ~ è<.naE B ҢD+ 7+i@ B0Rh*ʐt&~վ;* :TwɅ ?gϖ+暫oaoV7<\i?EʫR}oa]7}O+:;l{ȼT>woٵgPM#P^h7z3o߿A =V0CT[Z w(HmHAy/EllK R[mܼ_?D@C >AKyG(]>\ڄ-5Yk^#}mJ%|W}b w&K_۰l;uz;p@Nzs#M+Uv0zkvkn4n˷#0R.2rӤm=v7־}rcxt?g{/ky>~+]Tmnr![z}x޾&km8W_i?~A =o[ymI[g1# 9AKyM)oALJA@0ƙ@W@J@!Tw߽7Z 7y7}1;v7o+K<"|m|ڍj]Wc#ǿ2^vA'ͪm~҃'Iϓm >̺ dtP0O揓mɼ}M7̿&Ӟ5>4nA #i.Hi&-oP^$a!/y~@q"gu|ͥMظȗ_~!W\qE(v^{\s5Ktz;a DJ,?J{O[ڸڤa[%CV!um-v]va\Zr5oo՚7̿&Ӟ5>4nA #i.Hi&-oP1m~Ǖ@Io՚$a,w|_?DҸyG^zQ:T>أrܹsdn XaGJ߾ D?L豕,P:H%|WOڍ= &l {Anɽ&%}m0of *^ Ow\s5ZkϮRMe_Vf]x獥~ނ!w o[m/`߿|K䉭 +KQzl۶я~$+EHʇ~(-%@ZyH, DVAŕH5%a&@W@  "M@ָyG[ꫯݻwZ:u#F .~fͺ]Ll׮t~'ϕW^Ytwu ֓Е:$-&}m Z R)*tl>N|}tۥeZ}{zֲݚ2ψ>rSmgr>Z-'PdJL{+,+ZVdߴ2LkW7{?A}mdd}I!qX Zm*((ׂy3l/W_i?~DMAH"5nQ@^u ֣ā(}m0=?f{Yli J+%)䉬N;M~Z$=@ָyHB]7}(JAkIX)O D ODI&D kܼ@$.>DDDDDl@DTP4H8-]-GRD kܼ@$.>DDDDDl@DTP4H i@;DCDDDD& D>s9rH٥KJ+Ç˿}ݥڗ\rIiۏ?^.QAAA/W[J˨q|ז۷ֿ~[|ڭ&?sLiG i" u !""""b"P""IpoI(ANΟ?_~/wu,ƿoO[Ox%iq'K]21x`9`oJ F ׁݻwѻwo>ȅ _]n喒@;DCDDDD& DDC PnA PMV^$,@wyGZ^i1c KAB".Y{'m}bHvs='--q#qX9 CDA 2nA P_+'p>(^ziYŸ[-ԦMiwW^ҥ !.qjC=$ω;gϖb[Ҷ'qX9 CD Hw$W q-NOʙK=dmS!HX.GI Rf͚% iӥ.ł#(jRK-%/^,wɬ_Z;H7 IH"Мp@yHB]|EËVʋ7xL^pFm 3p@ٻwo/>L^qӒK.)xCΝ;WbA~QH^{%<+򫯾O=Xٹsg*H Kcԩr5ה-ٳ_ \ Dj-5zhٵkWiK`9`+ʍ6HΜ9S}8wO""H >!HX0"""7ﰿ* :TwɅ ?gϖ+暫oaoVu-&M6a]0} S33[?#/^s s\_m@m2o\ڄM+_~y;oK_۰.V@$T/x|+Am򻥶l﷿F/R^4>9sɋ#/|&mvֿv~Rۗ+&"Piܼ@; D." T7z gWڒY7k&lZa* "}m|Xa>2` *9 ߸Dθ&gJ\o:WZaq~ѐ{t{G"Piܼ@; D\4nQ@d1r%hѣoI_ [n-֧'$x6ȢU.>Hnɬ/?_#?I[Αnƻ3Lێ@ @qI YB ;d֜9 7P?^ 49)rח6-b]_#E}";͖q5E')v|@Z R&mG DҸy$,!JUD\:,K_I 6@N4QڴDlɬP>N r޶!Y2 @8 nA B " DCi D^zE9tPcŋ?sΑݺuÆ)} [n rݿ-|睷mKXaZȅ7yO6SrW49WrRɋOc@Wo@$,?Oy衇ʶmGRl+q`6%XB~Z;DDDC>!0 (7ر</W_%w.[j%;u$G!.\(̚ubkNۛ{w}M]0_@|=3W~Z^&,U@|CL nF>iu|:~7&D;,!񴉣 D$$,@=S*e3&D;*ԫ."=VN$,46| nhK)W-B^{8.E ʵBVm@<ܼ@$."=VN$,46"@AbJ?Mw$W h}G6L ^>-Q]-DbJ?Mw$W h \[|1j&D;D+cd޼y aZ"*}ݥ \rI٥K9~xW|rȑҶ[iwKiV\qEi9s#w$W I B 7 IHjH@|z'oF2h vK+_~Fܥ ~~w,uɡR/O+С3g0,  |MiԨQdi.EUH:qin&}~I{T2Ϋ޽{KY-R"w$W H\J@6q􈈈Y P@̘1Cڒ@;#kɸ-+&(-(?#`~ZȄ ]Pݮ];sɴ;_:Y"oz-KkgKCťoyemoA}'@<ܼ@$."""b:""A DuZĝ/QDd5+lqTY P@D"r%iڴi#hK>\ze.#nXA5G\Ŏψz?@믗.= KNqKu 2{l2b|7>qt^8ZamO 7 IHHy4A ; Dj7 IHUqdσ{J_ZܷΕ? 8ms!ҁ$}mzʮr76qYgin߱ELf׬uD "}@a֬Y/0L>]ZaHdV[m% ^2+Ŏψzz],xꩧS@n.6K-\x4Q%t<.eY՞IU%~iD" u `%"!@:@H6"M4^/u&W"" u[?mKV+1G@dy#hb-%Kx@sΕk¦e޽/(?3yWȻK'׿KQGUPNk/}Wz2n ҷo_i{+_|qxȑ#oa]|Ej(VWJ B Ry#H 7 !A,*Hu%!)EAwT<råMR'W^ytOp1}W+L 9TZ!ypO.b\gu?N.²rIoN)sNqdZArmו,qҶDޛ+;R0LÆ)$m<{@߾ҰLv&mM}MZdmgϔwkZ[iinoߟ! v~7cSiR+p -ܼ@y@V&!)H B B B $,@ZyG>Tw߽Җ̺_K6aK D~arw '_~%i⋥oa]|EV+5YjrccW:ȁg}L-y'}Wwi'OV0ftĝ^ yIHw5j+IoL]"- ~,|p^'OoI@d;em^GqF D\K Dٳt?W*Xn 2} m)r =l[k֖YjȻGJݾS7(w9y^dKSE"6oyy'K{=-8tYHmZR鴭V ƠM}*uq%HyI#H 7 q>@"""Փ@@j4nQ@ĴaΜGn(Ǐ/}ۄ|rM7#F||."o?WX_`H  6_'}$)(iAmsIwj]ҺT7 !iQI B RT7z zYg7\ڄ̟?_Z'n뮻ViFﻺTwq}צ%DB|1ZƜDi{sRR-;ӲځH~ݤA[u]W| oQRD.\p= zPi[F$> O,{K}C "Piܼ@iG \I B RT7X K/ʡC{T.^;w֭6HWظ\i-7x]ݒY[oCW*X@dcOz$k@lͤ'2A>tkb-aW&'=Y3j]WMO'@j"6u+̯r;>mnCkIǿ7&%\R%@[nFJ ("}\Mz3o٣e5ɬ_I?Dl; P@qH4i DD\Dj4nQ@/W_}޽lժԩb…ϬYK+]vn,(} / ]]0JUoaWh  ]{t_z>߂6Wj 2 ^ylR K`}Jw3=Svlh+~`>"MZ bIrm #ki6^.s ]@Β 7W+@:@qoAѴHK4i[L o_R6mDDҀ@*wtQfԫ."b^u f{H6>˵fԂ&J[B;Yc2˝I_p -ܼcw9HTy@@ D"H 7@L]|E*FZHRHNu ֿyy#H 7 IH`%Ȇp -ܼ@$."""bp -ܼ@$."""bp -ܼ@$."""bp -ܼ@$."""bp -ܼ@$."""""֮P!HXpa"td#"""b !H 7ر$)SM6""""֮P͛'p -ܼr2ud#"""b @*w$w㦃6Cg6X}w=eWK_^3@Բu\b%ҷMO< [jz-l!3HYgi߻K_4@ ;D@$Ԇ"~K-7zATC ;D;QrVMX} Djs^>G^Dk[/-}mK;6"[GH@*w$w@$_Ԇ"~ D$0"Piܼ#<, UmVvC9q۶)̥^Z Sd߾}e6mk!nj9U=vֱ2BH[BkSgΔ6/<>F편\ex\j饤۾<X^\+#q G DyɭJ.fyfz蝥o[@׾6(Z$0"Piܼ@@%i> DI L& D0&T4nQ@dСK.\={\y5\-}{뭷ʨ@/n6HH j,/)} vAg'ӥxk[0@y D:t 9t9 ҖPg>_$}H"H2 #`My<-uJ>}޲kϮצ%LnF҂'7gsyži}]qEH]ߣJ>ﻎHib׽bVj3ח=_gubЙC}7@Iz7mp./;oYpO{۶ۮv0zkv 7HX~I:vwr\ve}7v!ϴ~Mhp -ܼ@iG $H"I Ҳ"""""v$o!HXp"}{-u㍿m–|鶳@s}nGiӞߖF[zw5p%C}Nyiim+$i~ƿ2^.|ЯX[ Zդ}-)8́>fi"v nA #i2H҂X$)M4i=/H\ DpH 7Z 2vi&sQҷϸ=T} 6?OPN:UVYEw Tr.r^bKk'=Y—nrv+H} bir :i4RHۭNڒ+6Ge;\IC[ hXai߶-yScH[oR߶hiˏXZkq~K DeΛr{Vb-M^͸o}un'^_s;x'K{ݵ@< m),3@Z"H 7 !i&Hs Dʓ@@$_R{"%)M$,@ZyGӖ̚3K6a"O<.{%۴i-7h#9jԉruH>º؍|̍)/xނ-me.ӏ;I+203)N>3J(Cտ+t+(*dVxӥw Gm`h dոo$Ζ)793ncw߶ՒYI^-K DNz$i- 2nԂ|ߏ ~{פ3[ bAnKֹKTjrZ[ 2!}u=R~ҿR?7 D%!HXpf4@$] DDDDJ54@4:CiUD\:,K_"Q}r6a]>^F$򖴇.wܸBϨ=6R jKV^d=ܖz%|m ӎ'nATح_ ׷>hkʬ ?Sp] %,BA>Æ7[ZȂb^6-iK=C}m@ڳ1]~Y^jA>ߖJ,miS=Uq޴_3=Iϴ~j"q2̛7O$,@:F D?J5q"%)M""" DK d? "P "-t䇨yЖlm]]u& D~r bU:"užIZ%OD۶}J{i"Iǿ@Lki"@ [Hɖ=նcN?S⋲V!lD8Py]wIm8_M^o;DD4@4 D-H""-~I \C -"kZ&0&׷j DUM6֏Tb#16-9Җ|m Dm"7,{Wn W "bȔ/?Oo .!o/TWm[pn~$A/"@l!iN^ 7|6yU 7 I&K돔XG bm[n Ri2dK@g3^8`wW|7yi˾;"߹:[~K._|! +ϘyPwiu=e~9'ɯZQz-|7r䉣q'\12nax.KkN6]ڼݺw_אsϿ uï}6}q&?>G1j|%8]tɥG˞}{g]9QD3yv1{+>t6nA PM6"".b%0"B Ҝ`=&DDS"nsQ[?DDw+Tl)5y':|-iX },?#i4{%v;O{JZ~%MQ>Y;rKΐVX.V.V~7筷ϒ>4~kmNj9L?w,uK0%wQD_Zւ/$|s-;+weӽIrQJ=qr%=޸EciUXݒ@Ű%o+kM+YA^Q|λɸD2s0h/iDӚwQDoZ#],teƜ~08]Ubߏ(}8YQ:޸"jGo7J?Bq,\Hu^*w$w+Tpʃ@@@$%i@9ioD5޷~&I8 Qj .o'zJvzYIޖ\1*,+ޙ].bύQ{iY]j&Bf~ww;@ROI*5ߴ-=sK{z1?A>;#j6NwYvioD5޷~qX3+ܼ㨣"eIGDDD|A@yD5"M4'۟(qtݤ#"""bvB> a_ӨaDKx'y~T?"iJÇ"eIGDDD|A@y$\o+uqEÎ>F;e)ʟ>YZ>Ï=^ZXa;J[_}%r>˿o҈*|IҎwޑ||a|iO{Qo%Ky۬YFT/s= '2QrtI:mBsځHߏ(j|%F#nsQGX b$=/;DIG &H}x6"v*H|A@y(s)x~NQ8~n`|A=IG(Z+iI_8Rc7k Dyzrm=ǟ7!CPXr{)ǜ~|e1>^XI}vYi9挳䧟~*]l+خ{ͷ& μD:(ٳO_9dUΐ9XZڶ`T,8<{H+`3\_K#QQR+g<#w?itE5~ibv R#Z9_IQÈ.(츋d}L7 I&@dKI8 A Ҝ`=4A RIQÈ.(츋A aya9`m۶Kʉ'H߶6l#۴i-mK߶-Z(<@٦MꪫSN9YI=vֱ}&n}ֲ M)RcYN?czr$ 8)ҷ$'p& |LK1n#;B.z9oK-tGYOj~=q|0ogd^!wԴ"~)WWƿ1$i@@$"@@D8pwii]vEz!^/\r o[cz. z !v]H+XǶgxiKXanߙ,m:bs{br?tPiQS"iiw?_ڎ}b3z\ l|e,wO~d bKh\_6nRv0zkvkn4n`^ow0N־}rcxtO:iY/YggD} + Rq;uz;}7ޜ$}HR6﬽mkLv&zH?6}Mb":~gq>lվlZ[i/i~-!Jc=lϑy@ >nA ڶ H?HTM~&K$@I|@ @ܼg}*^iKfx㯥o|XvQ^xaphk DWx-(YeU{n)+Yϓn{ m&Mn"{Sv[컅mn2O.8k_n]RjقR(w;VHe. uRǿ(K?ojkWޘ$m<켍e\v`^ڒDV8=ye2܇iVaZ bAZm' \jj]Wc#<ڒT(}HR֪]VvN{}ۦXuA}ktoiYHy_hAî_ozŒYPK@q> 4Z7-;~iK R6D$i@Id4I RDҸyGꁈ?PvX[4 ˯J߈#G)m,ϫ"-0ezI[bsΑ?m__ ިF5ºQ|4oaW&|r>HNC"|k˭J~ڭNxۉ2ܗ#:B}il?#'3z|~?Y_vL:~Q3SdmzȨK_T=ȝ,} {Hw]V·yhco_״v|84oϘ}mn`zաvZTSOzDlm 0imvb+f}]uҮ=sYC8D.f9oɟ]3Sqwh=nj?t{CN #з?w{Wkn_럫``pMiKe#~W{qr>G(i׿>^'] + j/׷GGب5oa l o_&˾nj]orIjp^+ߋ/(]8 nA B B B ?kG B R޵D_4nޑz [V%mɬ9sn?~mFM6D.XtYbJ/5}jm=ږijyނn`Ė%.%RH:~}&dk[O־H-g g˥[ZNxe<'ۮVF=TmIz'u+K$j c6mx iM :{bg5Zǖo~2-xZr%eܥjKf `t߷%6cS龟~<}rɍw omm|ߛ )o[e7kꎿk>ykĬyj@$cÓM-MbkVd"u- " O66Y?ҏZhYw|L_rm5~mgm}cQ׶V_百IύP6K}}(k[yo26K}}(k[ /6Y?kzGt t3< ԲnM_$fJ?jEƣe1}mѷհVrnϳ׶EA_jX~g"&՛Bz^>7k@A_,m-筿YxTWwM_,m5KL_$f{U;HyӀ@$_צuo&1ǵVQ+2-뎏k[}گmlt~o, VJ<1"RU] f}mkټ?oZƣof}ma^e&1gm_t3< ԲnM_$fJ?jEƣe1}mѷհVrnϳ׶EA_jX~g"&՛Bz^>7k@A_,m-筿YxTWwM_,m5KL_$f{U;"}mjYm\k"ѲwA_jXJF9F7kƢm5t3}mM!=/UE_A5mP׶[߬e<;mP׶_m O66Y?ҏZhYw|L_rm5~mgm}cQ׶V_百IύP6K}}(k[yo26K}}(k[ /6Y?kzHƆ'A_ZkĬZGx;>m9]׶jҶQyvo6(k[ +/L_[ĤzS@KUFw (k>e7kꎿk>ykĬyj@$cÓM-MbkVd7k@A_,m-筿YxTWwM_,m5KL_$f{U;Ȗ[n"e}mjYm\k"ѲwA_jXJF9F7kƢm5t3}mM!=/UE_A5mP׶[߬e<;mP׶_m@4 gxeIzq~ԊG˺cږo}ma+m8ݼgm#հr?EL7T}}n}׀YCA_Z6o[YCA_j~IzY׫v>D26< ԲnM_$fJ?jEƣe1}mѷհVrnϳ׶EA_jX~g"&՛Bz^>7k@A_,m-筿YxTWwM_,m5KL_$f{U;"}mjYm\k"ѲwA_jXJF9F7kƢm5t3}mM!=/UE_A5mP׶[߬e<;mP׶_m O66Y?ҏZhYw|L_rm5~mgm}cQ׶V_百IύP6K}}(k[yo26K}}(k[ /6Y?kzG@o}mjYm\k"ѲwA_jXJF9F7kƢm5t3}mM!=/UE_A5mP׶[߬e<;mP׶_m@duۀ@$_צuo&1ǵVQ+2-뎏k[}گmlt~o, VJ<1"RU] f}mkټ?oZƣof}ma^e&1gm_ Dܲ߷?3< ԲnM_$fJ?jEƣe1}mѷհVrnϳ׶EA_jX~g"&՛Bz^>7k@A_,m-筿YxTWwM_,m5KL_$f{U;?nx'A_ZkĬZGx;>m9]׶jҶQyvo6(k[ +/L_[ĤzS@KUFw (k>e7kꎿk>ykĬyj@$cÓM-MbkVdD26< ԲnM_$fJ?jEƣe1}mѷհVrnϳ׶EA_jX~g"&՛Bz^>7k@A_,m-筿YxTWwM_,m5KL_$f{U;"}mjYm\k"ѲwA_jXJF9F7kƢm5t3}mM!=/UE_A5mP׶[߬e<;mP׶_m O66Y?ҏZhYw|L_rm5~mgm}cQ׶V_百IύP6K}}(k[yo26K}}(k[ /6Y?kzHƆ'A_ZkĬZGx;>m9]׶jҶQyvo6(k[ +/L_[ĤzS@KUFw (k>e7kꎿk>ykĬyj@$cÓM-MbkVdD26< ԲnM_$fJ?jEƣe1}mѷհVrnϳ׶EA_jX~g"&՛Bz^>7k@A_,m-筿YxTWwM_,m5KL_$f{U;DDDDDDDDDDDļ"XwymA"""""""""""b޵@bKf!""""""""""""ADDDDDDDDDDz@^DDDDDDDDDDD{ D%ADDDDDDDDDDĺ@}W """"""""""bJ u%"""""""""""֭"X """"""""""bK u/"""""""""""ֽ"X """"""""""bK u/"""""""""""ֽ"#FvСFy@do߾Fyvǃ D a"""""""""""֣"X~dV=ȱmgD a"""""""""""֣{Y R?"X~|0/dW_!oI` I[#{_inI~葇ex} ҷoo &@IƔ@Ȑ!C-k%ADDDzpW1Jw-xui/Xn#@DDDLUVDDDD D0 DSDDD59br7ҷZ@kIsK_,ݧ~Z0j®yO/̟/?}9~$imիyࡇImzP8x]3gw}G"M{}{^eWyYg7|C۟~2|]p=۾\ygrmzɽ?@77I> N91}UZ?鶫p_K_J83{]/ nM~ҷ mשGDc\ K>0/&WG!]b.m"@kI@$] DDJ@"$ADİiW,vC;o˯RF= %ADDDZߘq'͚%_uɟ}za gH{G_/8F|đ< {lG^}u_VHw[lKtS~mҔ-*m?"MҖ'Q"}S}M)K;SM6_}UyÍVh?gVwG}~@qy<#~TGDl4^:yw1- KDDDDĊI ""H }xf( "ˤl aw7K{ޒgq 1 p ﻠoŦ[m-wmU?!]q DZ9h!ݯOI;bǁr[{C&K{}ҿg\|u=~Ėra]aO< 1FqI ?|mtʃ-p}ooEV{>+λ!}m¦;n[o#{ꞯR}eْ 4>2g `חb]}&@ߒto~[Kz"ADLפ^|/e/J ""X9 D#HI& DDH O^Zwȱ%+ 1?)=3ɱSn{؛,oH ,ǝp|嗥}*mY b:wa#u bF{]?mEώ;I`j9|i!oK_fϖ}-E`{l"[r{A۷'|B_Ikoﴋjm> V >(}mms[^'nzaYl,[oyiuq,wɬ獍6^To.}yMp x ƴ:egDF3r\m)[wcB@dwvСF@@+'He%inyZ}>_D7r\.۷}*ݐ t?x.i۽0iF#>tI{b}!m ?Jkgo?8di /ovi#""""cց%Lýݛ v<^Cv Ζ63l]vv¶aR[oJ li(wg K_8;Ov,vfxW[{mN_۰i";OL _t m F"=]o)7￿@}~ַO;ΕIS6?"bu.@#w """b$V-wI B oS@@jlW^yYRTO_ډw?ismI݁&m;C>d{'{(]wOFDDDD,լ;}ߖzi-ig-wmwiKD%]wߑpӦI߶mIn .տ(˝'~o}st߯%|m}V2{o1+t9ѹڧu}ϩ@v=*\ٸ[{f&N,j˶ÇK_R@oJX소@@ӷQ&r牽O @@`"b>un?ۂF0i᫯|gݾ/7i?vsWH.?IZ;71>H9_J~)mXQ3@$yі~a]lyO͓{-"vcK;ON Vc$‹/ǟx\ڶdZwqϷ}s@{4q >ߖ14f<åMؤש( DK3G˯Jڔ"w4I @:4Ya{h=ޒm'm)/w?ż-kSO?%BdV@-Nn'=)-X9'8&m(w{nsy!I |Ï=^="/i}ΓoQof5֎/b}},v'mI{/+`G-%4eW)my^_iKuzγCwuno[sK[zܷ=nYf{7fSʜ28kqLm;֯-ޏ!B[aOsprk%N&g_׷>tg?xW=IENDB`coq-8.20.0/doc/sphinx/_static/coqdoc.css000066400000000000000000000026661466560755400201050ustar00rootroot00000000000000/************************************************************************/ /* * The Coq Proof Assistant / The Coq Development Team */ /* v * Copyright INRIA, CNRS and contributors */ /* IDATxwxlKo$A4Ek^]UQrUWEET, ("vEK)$f˔. 鰛ه;̙3s;̌n:+ طoWOzF!B!8\Ns27p`Q~Wtg <>}iZ}W!Bq0MիWl D\\իş.o,|>awZB!UUq8빙5l(ڶ+/MFFYB!BK,But]'5%l>ҧO;}B!Bc\6miwB!80HOp1 ˲;MB!BaGt!B!D#"B!S!V!k'b9ɜy8W!۷nݺ*PkҠA7n|X "B!u&߳ٴMؔƴ>tlC9Kw/|nG4퇽2!UXd Æ 85k0MMҥK8ٻw/rReKBL 7.7AN'^M[ٯbG\k,Gk1o2)C#BDOαnݚ͛7{nE0 ?7##@ PeK "ǃ>|\t.@4@^&Y |*#f]8uH:Q(//~7~U[u4)ܲBHh~]²L9Xkr$ >o4U7(} wl66l]¿uؑN:Z BQ'@|5)d>BAQ,L>{gk=6Nя|,+΢O?ݺFy`_^$r(Xoҽx. |һB+cn8XQY|>o1yrX:g_?.FBYlY@`ҥ8^eYdggӣG2339pу^!qԋ%b1Í!Y1y\/zWo]inOhu.GJYE,"YiҤ߳f`lr˶,uֱo>ti_>]Ν+YBqВ[2 ryG/h*CŕeeQdB@%!%5(g\?\,J-_<7+"+XGVxWr"vhuWj+ EE >&8F *r$Be2C ؿ?:tk׮@qqFOӦMIJJ%B〥d0V~52[4'iP\.ۏS~?]4~1=܎f.壥{hdeMX9ںm?.݅]ic]y&qr:ٶ+6Y&ȐM!7ouFY?GdeeгgOLӤe˖8|>_5K*O9r-[<]B!ikj/;wgSیn:qB\2]G?+ObS3q$MM/'uPعi ;wgK?vҤ{?gF v =tgGg_͚-At?1t[6;ngGNj.p!BޙgI^ɉt]'..-[СC,z[nE9s5p@v$6gb RuGG{0Aގd@*!c%m@^}'C!QK!B!D !B!"B!B:'B!I "B!s!B!"B!_(!3v]|?.%yZVcfp7ARi&SMb>EOs_űߏY_n6=Q~} us$ƻ <4Mx}ZNmU J?G^l~8 zP%!^7#\2圸SY-Yxu`(b5sywYa/9svb^?NV6<ěb T+?ͤåI}ߤgW#[xXz5|v<ێ[!Oó#SpU3Yނs'5ӗ^g7pbLƑسY=fʄ{oglLޘt;ۯ-ӳ]/Μ lSSzϘ|w&ke/ƼC ߶矚 P;0l\9 Os|: KU[9y8fUR x~Ϸ@b&<>6 Jt.L3xL''.MXTu ;?qϕnH'ԠVTzq*v/|x,i.@QS;r˹!a|#^8? V y*ge4pރ^x Cְ",@Z͒qb#i<̨Ekx鱅_&>g{Vl-\/&.xEygGq^yܸ'_~[^gv.,~>#nR> Ѐŷ<0‘3h]ۦi5T~vO>ec5gcc[Wy{a  \: 'fyViKy}tv:3-t\X_IڈX?ٙAcЃ0MZ3t^*oZ5˿eo)JUgun1+b완`Ye 1MȖ"YٛJ[vTF>݌3IW*~91\e]R~,W۾YQ/!C!_G˲F1fƌ%}GR@ c2qMzuM̯0,y#G,9аv~Ϯ\ԷB/Gq^KWd~qC2t;Z>46Phd^NVǑt?d|re۽&IÓl31z~> ?ru,tRz.~4bZUc8Xv :5ѧwk>#c6͝_s(g/,"ьnrمU.Cv~jm( <j8W/, 1=JـmmD2Q9 Hְ ΥPEw+SCUHQ1KmPВkUO͓@gZ w/]4+Ö No`&w}Z:}Z!ۚiv%6e6^>gOaeڔ͟T6[FI!N)[t$A \VO52;){~L1WyGnRYͱ[{KUt_L%-E3m46ۺ-Ԡ5g{~`s\OT/*Jme6)55`9ܞLR^[/%I@FIMBQpSyq%'] -x߯prw]\Xr+n3hx:ecw(As-XRqz#Ȭva乖ԐX^ n%q*n[~uq n{LW^jtO3-@ͺb-> g/ dTtUOXw]/gsig8A*F#ؑ-9:Ԯ,Uw~Dh O/6z9-܆;Wv74T,P" M@6ʖb*O{nHQa:*Bzr뺯\rzH"XϙJFq.Zʧf:8ᥥ|˥meUcU3ںJ#Xm[X$ϦsQ錬x%//9-?Z|7y{ٺv9‰e蘦Y1L,tz>e,IO`sNXKug㶂Z`lƔn-[~d`zR\߾@ze.͹l5ݕB w+n+tH!dsfK\wL7R>26eRX\mF0P]/3 >4YE=eAls9i\^\Q z2x N)USe9YOQĦmh y5c d߲?ha_ rFRIPci/ۼXXv~G%_Uy_'3nivcv?o}}lߴ"K/S9{>w OWNmR|"MiWTU?VoZ ꪺ(! !Z"\$?sFryWb\v.sN'Xk8{"}ELy ˝ #/=]_K=$B~Ch1_jMS%W:7/nm7EmNȟn4hqv(_M`aD `p Ӄ[>3bng61ZԶL6oeܨQ\x*Z^(q1ўg} C*ȏUGWn~dosa/MZu>U89_c9ќ{kcnaxC$aՒiKoy{,Mŗ:TwъN卮O]'syqe3WÓOO~ {&^w2:.s*ږCeV*}\.FLd_y eAut|]Q"7xyV>C[ch4NqSH}_YoQΏ@ >jr.D9s_ؼPYz1=[Y*%<+݇B+VTݧjTpPSo4˜XWe [qhڎ" -C2̡˭j}>>cm[u*U4r(Ma,b[7'iY;wvȖ1feWaT^9(h ddd0b&LfXS4N=Z7D54McذaD 5bccСQTTDzz:EEE᲻m6|>;v0Pz ׭co@Rt@qܹ^yʩ(G͸qt(7M_NN=3gά '555j7M0,P,TTEtJ(YP0- ,~roB8@$ԳPQ bFxD4McѢE l6np0)Sصk/0|#eUzEPU: 5̙@ڰЕޅ ( yyy|駼 |\s5鎔,_wxb:r˫@$CQnO?Mbb"+VtKXy5kF-"/ ?謁Zҁ&&@tv=/~oͫ`n3|^uNg ,={pWp3vبXE`=ؖ֗!n!֑>,DS5_DzƲ|SѿU /K !ZGfL]'TUeɒ%K$%%Off&7|s2$>>$^z%,Y-NO]l6}QG}F0t]|l6CDt=ONN6m駟駟fӦM䔙&òBnW)=MӴipYHNN&&&\bbbHNNOפI#UU̓n6Np@qh4*]VBU?ijZ\6h'z*B~~>SLa$$$iHC65M#>>fϞ͔)SϏx0M]`` ٝX*s<-/g_vbٝACa IɲBBWkҚVB:fFD>kƺuHNN.n ++L#nn: 3ԨO;g\.{wa̘1`0tw6iӦ{Mƌ3~n75MtUU ?iF4]5/^|_|15HZEhz ѬT7Soh .SNe5G;̣hHm;Dn>`8N4h3(7ŋ#jYgU rp\dee1yd.2;（="l^SQ<'4m/ r<7܊׾##"BT簇fU5t2|r|GyDh0f֬Y|999%!gFt8`HӴJބn ݬi~,XJ ׯ 44BOI UUyw$&&L}];ＨfӦMc͚5K/{q UR,XPBƍ ŋw2/XW0ڦ%oP%> @`?_{'|[֓ԫ&@ޢh8%2JOAA?8۶mAz]7o^nHO˲*\GiN43g_5wy'G{D~>M&W\.G⴩1iv=XGJnn.ĔYСCqx^^/nC&&&Trsskߵ  &p b+1vmGUU m`ߵUU#VFhݺ5)))U'jZn]pXE@Q6IM8!}?V8M^ܹsƑ`Y_&-"??\b&#=v-"%!݆n z1_nW`l6X? c:t;"94="Pqƅfu$ &Y{i֢ *ٹmTi˖]&A=w!86wI&N{2W+UH>)̇z]}mC=w5NN8S+椓NSNmhfxWhԨVjX+w} yYd :6}5͡{e/_^ic ))˗sꩧF50z\xl޼\ /Fti2`6mDVVVߖ/_駟x`&˗//;Nv(H, 4%w7xpo\֪E~<Ï+'J_ui>76X=@UU0aׯg5:6#ݫ[rǨQԩ A?o~߶{ۮҋ'v갊%B@˲qWmݺ5. ˲1bDae1w#KyrHMMtTn7?{x^?|o^aCϏxC4UU1cP|/M7TtӧOJ`i+V`РA(nOΖ-[HIIA4 g/^Yf\F6W_}FYݎW_{ڰPP~e+.xOeYرcq8#ڵkW崱{A۶m+&Ieۙ6m@\ңG~w0}t뮨<*7noFƍQ}:\TD}raUUeРA,Y$|Cp鞴+"&ԣG";41 'Y(>/?ùĝ;]+|+qd XX|GL>UU شi-" 7Dr`ܱzd\\#F]vaK b&f;qGI?b5lzLOM7p*Jrb*,!5R@DuvJ޽Q4tCj W894L0# 8q"Tݻws'YA/b`*K]i޼9{B=zyQU˲|'G4ABCر#em߾}-[rӾ}{| E ߸_P`VW (ýÇ}1o޼rcbb*}0yhذaD*fY4b&O w&m]u' .2|?4(>0 hڴ)^{-˖- )Cղ,tСC>D ? CIzkbI\}(<O8X޶g= |oFA7 O!5R mH{>]fwy=*,0.cܹ`ipgik׮f1~xýx:t(۷o`Сוh4hu=V 4CB/T WĬa_T" #%ŷٸ XGPwdذaQ+U1 aÆE44 *&r}W4J-qS&`:9;ٓ5[bkW7p&Y覅eXX!zViuLhhiذ!}]i&O̐!C]!?>d.~wN?2Ck >|8..] pԨQy'7Ʌ|> g}6={w!//{Hm6wqGy'"XEÆ 4io1h ֬YݻLۤIwΊ+0 &eQ` Hy:ڼtL@UVj:c9pr6%O+i/hԵ@ fYa"`ZAN^Q>۟=h1L⊷HnM ¢8F!ՋKLӤ!CxذaC;H]|$&&2xHCBLQQQ!!a+:wyg8p j뭨e2e⋈'T[nݺ = \wu|ɼK򐒒ĉ|t9|zđ,|'ޥ+1)j׋@|D89^Z@q@jePɼ!e`E( (7+`XK$z̙3MѠ*qqq̟?]vѴiSƎkץ*:)lU[nnnT2_պ+Yl6S:uD~u=h8  ~??ݻOއO0B)vcCZe{:ώaxkz!Ǘ_~%z="!iz3f ˖-cСx^ BsGFʕu:[_e݇*ݰuaƽxfe wЈIKKe+ɍīhUP UQQi?[ֵvBSnV?\>|8n[n0il?˲=>e|V\ɯYER⪣u,EQhѢC n~BQ: DxEnnn#=i4ZlI˖-#<)OB!jB!B!?!B!\ B!BB!B9 DB!uNf !B!"B!B:'CB!uN!B!Dlذ!B!8_B!B'VX!CB!uV 8At]4NQGUU4MpwRB!D-I R|>n$UUq\$''$ !BZ@A yw:EEE\MӰ"!BQS"2\(F:yyyy晘INNN=r0`~) !BE"B|>yz("%%%<4M|>111&GZZ kB!8 DBÅ޽; (R_i;fX~xG!BO@Du8@q8J1pЭ[7֬YCBBB}'G!BzU& tL h(5,K !BN{D,˒XQ(JA(<裼[*u8\r%}!BJO͒QjB˲裏{d !BG/(߅ Z49.%B!Dq jjo˲AȕڳيwKbb"@\*Bbbbx:!B!6dk@ƍyشi;wYfk׎1cо}{yj-^W?!Bq(<,Xݎn'115j_=i#5t =ex_!BqPk;C(ꪫ0$%%rGRR,\ЭC~y|?#ޞ|]FD:Ӆie>QݻԧF&͵b~ʭ<_B!ı7(̙3"999˲HNN&++3gr5הjoxsSIlDJJCT_^$uT[?~鞢5NQz](W6[zx~},{ BJB!/z|(lܸe˖fCUaÆĜ9scٲe 2mۖ,$󓻹9B^']5u{0O2()21k~tK"j(ɇyRGkhuT5LKlhZ醿wxY6ØTkB)/5bo{Y8#/MdzYr4u,%~éh~m|qsqB>&['ij7~1&M̼Z.[ p5!BW˗il {DN:$Ə(x<}bbbX|9m۶-YJ13d>{^խ/X4|[yc'Ļ#: IDAT}MꆄN\\gf)CLcCykz >w~`G%.NF3]7^I'q̩t[r%e'߳ˣѤߕ{ٴ"G7~/_Hѯ붗\+iȮy7roIyfޥL}}b5< ;g:c &\pO\"s>gpto.ka#Hn}te8n7xn0︟ԧ5mKm%g Oi$*~|j'B!P@DUUAH BEyL<χ4i$|>++ UUK pk[r獹<5kgJ:ŀ{Ͼ7Z{i /|ygBK :_3kXk>'*hڧoc/^ur/3H~%.oi3,vV^3sA̼@wxUB !P7iA*(JG"M U7i&d|B ^\̜339ϩHݵi_"r5 EVhZcV\kcvpQ!}"&Oc 4y1f#p*A6pUDҡ ^25R9`TnWlTLh' oWt !B"!+^<FfΜ7F4l”)SkcccŎ0Z lJECwQ1U۴,x:GװMm["TcZu0xS~<r9#U6^Q/}Ix^INVbF" +81t2z:JCRr Dbbb DfΜ}+-S׍0yjQL^v-&!~#;0¨i/@D cVTw\/wgS F<0*:v]`뜉_1'٭o*ъY'Z+٠7 wO!BꊦiFGڵ Ʉ;vٳgfCu\]o,L?uZ2{Km1Oh<, -̩џRlgQRz)R]是W JA[`T:wˋ b3NNNTX16kYt]1#p>dxWb?M `ȡ]C'1m^YTϤJڟ>v3c(-;òOy;O!B% Dt]'22;v*.]fi躎i$$$0uTݳ+:օZxVwś~ʊ_8R|>5$m{+JƄc }9obq*݂j-/ GI8y0 _dlξ*h1]TZV .8/&g.%ɷԩSz趟a۱8;\T2{#j)>y{m>xR|"*͟d*U:'K/o6zi875{n'&tχIyc !B#-"ua͚5]?@>}4S( ׵L&ԩ`&GSUYڇ(ۃ _|MF]v1o<0LhF*UHMM%>>EQ VB߾}V 2OOO֯_Or8|0}ŋy:(/͛o^~}:t耦iW3o<ʕ+{A'G!B8 :::fl6j֬Çٻw/9d%{&ݎ`vԬYq~eLNIKKc*UD D!B]5Kuf3cݬXֿУGVJzz+?wlɓӽ{w!Br@V7--J*Q\9<牏XbQBL&iii4zWիVm۶ٿB!0S rlFUUThDU4-{l' :cZ%B!]"th&G!-@B!0`uwrMB!Ȓ_ !B!D6 DB!Nf#B!Bd))W\4JOO^UãSreh!B= Dt]'..'Da:gϞ-d!Bk(r|S йs,!.]tB!m,[[#r "OU!BV]5I!B!(n D4M+t!B!P9""B!w!B!-d !șng9nwBB!Z.P} |"/唅-O}ϒ +_bXyufiLj2%d,&7Ĵ!I"rvɝ;ułJmzPv;Dd~Z)o@z#et')]F~yNMl+O2 W2fD`:fϩM؈7h0{p&B^kS.~76eP< ,;6^ٚ2Q6Ӕkl_4r!#rk.mXK?:q"1dW/4M=s~2 Yc=p*/c.7б%p I9{`dS"@q Q atjB䧛]Kb׍f&IMWX7yvdtPCEVMф x=/߇XioNi5|.>U[ ;/TdAl;i8e)U&`4xp~+ kJrc>F#mWO)'v~^;xXcxEcM6UrFJq!Jx++Gd~I#DORƛAM?I|ԅ7~q3Yc+Yb3e.X]2+kRmLW:ד> kO_&^O>M\ۇn}|Pļ3_c*xhI7Ut'1UƔE|-O.PHszWWGx~ ְzN c-؝)֦-_v/d xxO^R jC\LsvP M-r6f$lr4ߊ!ҧgphwljB؛%ÉUtvGwO 8,~ӘǦD H\u_) xxS_[A=ɾn=)J`Z;U +PڅmKfn#CqƯ|^]t Dφ}l/$xV#^OtM/'2b Yx ίqBM6>+Kч*oet4'?c;QٽH(!k9E$jRrK k̆X z&"XND{i! ،xgrCAI=ta}#_©$V;өqޙ&͈OI?{3_Kzgw6tJh0 _dsC,8ѡ&i7N8qÏ P\H3L34ɗp*ɇs@\*^):X2aQ՘U7s1%;3x)8k[b']WzݜC;6ccgaE-VO*O3жc'fgctҍ*Yΐ b%bͱbE J3›PS.0z\} tMAǷ; X?gN[--[E-EFflW\!/=!GYoW{kNk4mfڴ[PܜGŭ{ 4 )5\{ޫ/8|8?w3K5as./䞂gǎ lsHfw,95-޲bGy有r-{h4fòf; $Ic)N^n]R/{sՀ{1.؈;ְd`KM\ق?BQ(8M܈;&$'o#敇H6esAI? xb|1n0lNgnj,Ogtbhdut1O7EbeHXSFJ[Ε3BbIa^ 7g6{0<䁱xq| QGF5DT|V-IA~{Cze7ndH;?L g1o덟TPn:NǑJgK0E;A +Sۙc/ ]s>n|(*--vAu_%X Jn%i_&MKᓯAݻ'Og'er|{sŎAor{|bHqNM;^< &l+mhv2S7i$MF#&'gFD;4+VR8hxK^Oyg/( ر=(M !k:5 ~%=0v]_͇i+lZlg}-u@҄c~;!ZM5 ι(7\ɞ:͟i͜(J:;>Z4<;:a v:T쨰3.xfi=U9u!+NJ?n6tO+s|ˍ]^$-]Ś)?264sl4/%^llw%7&/f(R.p-JUpnZUQ-_t;Ъ e]@7yS!2whv1g[.+M_r_Ff1ٿI(?U'$mږ%уcgPf jEf+$56G֧; PcOYN+\߅u꒢_傴ڝVe5lQ q5cvS :&3㬎O3j]||V"Ӎp0o`ݯRW A-/w2'Jfp R0ؕ bXuce>.ixy'2>@)?_-:<{/%t^"oM8Jzo_JH$͟8'@;N~z#R ?MF|zuרb\1E=MAYͥD;;a;L>ՈϬaV-x"4I$Ppیom"z\~ ބhKkgg WX ɏ#{,Wj?8͞Oֳ(U|c)ҝ3gķJ2l³xV5՜ 9vAS78D֚@EO3HB[,.揧g )ӉQ^yaQ%}`JՕBO4iެY3RRR8s ݺuŋ7}x̙k׎2YLH_~-k^G-l,k/Fy"EKf 9:E g%~ !؈?vfjAO:o=WPnRhN帟OZʠArv;`kV$/ !ăV/^L ::/EC*t9&F$bmL/M\`|ijCzYqI9](uzb=ӷL+"B4VBDȋxłNxYnx51Bqܣݻ.-d䝓Jm޴.t!-1!(r1wB!"E"nIJB̢7ym濘᫊LB!(-dز IDATO}M@"#3xqR/)= !BF:Ig٦<}\{ ZdkDڔ& /$BGl"Not<ȃπWzݜ7FA7!-- T>{H7B!diƍV TkǠja*붒x[Ɣ+C'S*ElW7AO}e2}Iuiv5:SA|-VW;a jɨ[b>2udYȗ?J1 {ٹڕJܮ }-zdI,X ;xq4wh7/Advx S1"C,9-"Lb]·BI5jc,,z)x>B!"̧ws̐м/Ԫgˌ.'Vp/U9bKѪh.Ԫw @\)ABߊ:%qUTrԯGʉs `ԝNUqVT0 5K%Ns;F)9~+誀ɝZnOu` $9MȖI/ғX:L{ n'B!rbOK"{33$2o'z Eou Q * *UtYf;G/fb4s:6fgr)E#҇ pt^`45W/9ϒIFb<wChxO!B,iy_~&ZKO%Cqϭ/zcゆeQC=f[#g_?`ӧT6멒vJ ٷJZ4]L$E暛B!sXUaY ms=ƱggX/Vpc tO" [7ŀn Cw'? S?7lp9,oJ5pڿ{cq=;OQNT LuqEbl^{ͳt !B[IՎ۱Z,-Zv=yf&|T+s-YIccxhFD`|HC̙۽pq li_)dWXl0gۇaB-#{-gOyeşP`t=ŝX¨삗{U<T! +4|=l22-oiUFB!Oٻ84` ҶKa}QGpk?ΩeYӕEȩva+obl/ʤIf͚ӧ޽; 7}x̙k׎2Y% 3֩ x|>i) qۍ!x hqS:;6P>ux/~Ԏ~y좔OGyZB0DV???-ZDXX^^^DGG!B! 55>͢O.v%%kB1-< DB?IL]1sΛ$kx"RXw///׷oɠ5u! DPH RI*!DNϑ :B! P5K!B`*$gfD*Bpx{A'sf|/'aQ鲶= :]Bqc;5]JFT. _XO+r] (eA^׌BE$4*uuky)\}Քa(Ӳ !=]p!(pE:O{B53T<%y~n1K>%+Xf5O++TDΥ )n*7K!nd?_7%荁Lʊi z'/Yh^#PFףά1__dD,}ۉRŖHuݟ f.T݅*;S>5Q!͑ h|pZ9E9rE-O1[KoKs)?o\AhWoFꕟe6B )YѴJ?r#/ yKd.BHms$i\af7s$fϋ< 2<?zbmtʄP02Ŀ;Qtr)n~2?ѱ7l i G-Bo>#mlxzr.L}DcoR5xW =I]ޗF񼰱*}ځ;T5K0g˭6]\ґT}q =-a~TG\l%M&a%oόLp9I8P;7y~I=ґ7 GU"W5Oą֧t L92O% `ğq&D!QLjf3*&>KɄAOlсٗI'i~ws70ЪF( -I{Ku##i0)8P!+=};ӏgt7UpnȘ6b9F¼w<Rs-IF6~W>)ΔCH+]]#0q^|IG0ӱO[˱A( |j# 5b>.O{HDTrSj1S'GZ7%2KSCh؅WN'_Q:< >LYD/Wqwt 8;a^ :tb~)xv9}T "DJ" %- 7ݯDj"S jэOýyA[ŒjkGIf=n..iVU-?[\oKը`/Ω_%&[ȬauB{H"j@ 8gN#ho e˙Q,7uU= ZE9 tDReDOZ.VBK JӬd$]\C{ ~78Z,R~þ*47t%] bg܌ZVAZ i%F?l4޹xٓX>Kqj%w< G{{iͥY{'t-D!TŷU.b?$թ ~}^@M1rF^Ih6;UGu6IZS6ŽJ_fޔ3ɧT "ca&duX <RͶSXѽM9[8C^\OyzOlQ<; S?ӿEr+&|X<{a4к'.͜T,!Gb<;4,ûSIY4cS5! "zPᝎ$ŭ7aU] ܊.KwoݹW/7U,|;HvWw] 3qd}a,_jDzչWo6_7&uk,bxqD(ok=>тs4Cd߻կ;mϑN0OEW/ ^2+EuׯL{зr.Y:^hՁ1(CV_5^!S9iȸ0X[̬7h#Υry3󊳑rOd;~WkIW{F0Z0B;Q&M7k $Μ9CIHH3gΤ]vD6!}=Jgf_ ֩ |R !AZHJn1Kŧ}8$B!%/{=Gi1zI1~n65+T)($cDT|ƧQܻq"/kr*ŨeTAC!%B!w$̞xOgB]d|,bv( I׬ұ6dp(N1m_Eƛd8gTLzπ/ɞo\+p8K/H8}_/ Yfȇ.K IHeƳibJ5#v],Gս; X53sשn^ ^!;+3`ޞ?Sp7/?fK9YqC.L}'ViEFY E/5F1lx^$.#4-8 [xI^ kٳ2jxae|˹ط3yg֥USAV9CRp;>IZN=?F:_tp/V˿ik;CW|Yߩ W:/H)yef'HN}n4 <޸j_9)  jgMY=6kj0}\_뀅UjSqZWA:çٙSnv.l9Al5E:)Gh]܇dꀖʁaZG1jy[Bwcɤx.,w2u3sas qS9"6Ŗu cd\7XH#i~=pFRww?!:NIW4bW煍UwB*dѺ|w*MaW\f%M&a%oόl9̩Lka+56]\NL?8S)RQ#}"z~K=w[8JfWw95w>;oж~/N؉Zi6R ́'D""kM{߬us,k< 8{Yu7AF%-XOnn4x9ijRP*=ђԽG9dY=2R@St}f;PQ>x˗B{Zd0?o_H]=ñ| (q}LT\é58˥ě_Α31gR9ỷ=Qbc+f$,@(?"[K\ZYJ{^MSԨyy܏7]~B5>LßeE7_&_j0ѥ% Zu|xy̔?ϧؠA>O ɷK9 tz7nR>m*r]K[#xW>֒޿o*EQQ|yvⅿb X+C唼ߟ?[?Bmy}+4,qyS?ܚN;Z=.8R SR(|Ns5o3`TdNJC)&ԩ!n*(!eQm %(}|&{  BܚE|x ӫ[|Z+^-#W{* N"ׯr_g#Ʃ?_~D;Ωd_:OP; 銳?5:F~ 3W4>]":_LBW Yg$1E;QM8'发ILCUQջ1^ùW/72_z`;O:PπWϞbKk ׆C7ܙ=Mf9;ՒYD߁qh-VՅbY v$'}#pK<_OG]_H(ބ~'șN0OEW/ ^2Je=ʰ`<}߻EuׯL{зro B'nF'u6.%(Ъc0P~ݛa`ӣB2^B%2FV;fӓw՜pa͖\Pu [浥bI&͚5 ))ӧOӣGn̙3i׮e&/Gɰ46K>E{*5q|Vk'hN! '-eРA9n".w(S}ŪgJABq… h) !NEL$K"O)$O:T,B!,1|ٵՇlscV8:!D~)$cDT|'*]kk],B%RWFt:!B!XY&o IDATsA'E!BqK7"zB!BqG9XB!((z 6,Y]Hќ ܚ=[R]EK6Ĺ9u>7+= %~+?[_g3q N-2B![>g+.U>wԅ{Hnq>Ɖfk/Җ, w|U׹#7{fC^"CP@ZZkֺSu.D "" "7;!B ~>~?;NfQ۝UNDDDDDzMD̔M #hCϋ{ڳE[ى՛>8Bh:COV6&E1xx'B62C"ik'$Yf2߾?Dfٶf-pp:O' ,ӃiDp-E*DwBKi1<  $'3SCEDDDDzº2I,C,Cv^6t {hgzF䇍)gMw3^ىEDDDD]Κe h>}C>AMh 8;(ÈW4?\;ـoÆق=i^"\0j4X41\}u7`/<}+Ԃeq\yzS7Cph}X.;ƳG %b>r2bf`\")/P]{adca[ƗHmq|<-f^CϤV؇El@w,xiW4ϗQMz N>H՜=6ƗV?=Ysglڗf[Z'VqM? d}0X>q!y>;㽯zrL`Ye"n'2꯽hzV;oz ñپ%Z?w,?abg$Mʤ\<eڋ] (ӵs?tf ChQJ.bFENRf6"ZɜxA$"&` Q} 6+x֔xhlŞ\cX1_< b[v_N7AX}bφhl7v[PXnvDW]^Fn;cx>LT|x6nr"װ<EuCz{WO>>fK\aPpZ\|Eygt%:N7qg(/al!x*,Y2H%;V z4*v͞1ls63.ebկH!v֧8}Age|כ+w MG,z,Ot]Cڢ^ɍ=}!3|{)nzc|+|הKt8 9CF'cgO#ƑƛeNK0pF|ѮZEDDDJQ+VFيg ?a[hVl ui-`kp֔bz{<& 3> Ƕ' #V_"fO[CD[)`q Ve*&(lojwߛ0kc[9O'.-mgvpA3⮊vN涠inrՎD/^7F+Hs0CC<[\l~t%ﲈC[0mu~t'"@8n۶՚AD3p=z殁!DT9f̣l3TZGTGNI/ۖ}qXd[T.ZꚕlbcpVi:m\XMNH6 w?ƣ +Pz%".wr:iê\$ $:ZϽ*ޥݧ0ި!vUNv>F?ΜDr$%8Jn=+<Oq;{SðoOQ_D7΁Ht66;q"?xގ\@5l_܃/.`{Pwb`˙ ;XY;fvnÁIDkA?]meeyXLwa(bU![QAf(4>c%(W<(ZtĮ!>+VEƢxcg` EGӦuH[$p&Ory\>`k䒞X`"O@c\vp4%ZnruAfVDCBpD)tmTA+EuhӍv kX2'3k ršDDDDDUWaHמY ,ΣXIc69 VE[`fbDf`3L6:5Mpq |N)F cU_ i(F{c0_\I|b6W_:o3y|w"v5Δ'[n<~<< WTFh3:wfÚL-Q7IF&4-R"}iBzm=مЬxֿa3q|tz q0c\6;[ӣf 1BT(9-6bG5Ưa 0I[kc=g͓E|uCzTeV> KN6%F->X`|VTR,؂6b0i7qfk^̏;a[~Xs}g޽% < FjBplw+Vasa<;` DĹ f/ʂ|HSx1GY̞Ž<$~f;Hp@-@[ZS[99uPYlpEI`>{ 2mH}hMݗ#Fs{Om -}tzr"Ϭdd8##<W- gRqab݇s4;63t?s1UODDD&YfYÇ %%xLBrYM̞=cұUN/dXEIg˝S$n\+!إ* XRp g.L.,9g=7k!3f(u]9Oll,aaaX{0]^];s)("""RwjoHԨED]3[g"""" ZDDDDDD딈)S"""""""^DDDDDDDNx:%""""""uJDDDDDD딈)S"""""""^DDDDDDDNx?,˪/dVȹee#JgT5)Oi9Fvf oD8-͜Yn0]6OeSNwy$[dgAč./5#U򲈈;É&(#e;29.cpn\O|Id{AE-Y$ D^)q!k~=cT||$.I;DF= 1ź3!'7ʳĖk3 4ohqrn&l ֶo\eam<00v7ǏO~\Oܵ%um?~_$u(c5&"""""ԨE V|)_M;?"d"~vC jG=ܿ1[%^Ey= J>IߟUro6Eˣ"މe?mDk@~~4j/헯&(ˤm9<$۩m>Ye.y's0I_;ҏ0Fc ؉AAH~dbAA|iRtFN\eo>S|ƳgfرtlU8"ϼ403/DynBf̘Q꺒!""r~); <U@ C[HvNęs_DDDaD?u!G>2s͆brWU]{>/]FǦh:Ihڄg%ŷ0J?}(Fuw7޺Hs Ui#]j;e~l7]ΰz#""Atr9BDF%±驪>'O+ʭ1SY7-V9&W7+YnNn-i{01Mrx4 'k_*7#GΏݯX]S.ӹ$ޢ#64 %[HmsW" n?[*p=G:ozs:{Wu(T+}ʞtF3 nY8Z/zY׬tǔϋao>] Wʿ8 ;o^At<-fѴؕ(Qa5"w3[ƓGIѥMj\pbڃ.zև>6i#?q|\͋η8 (|Ic4p M6 nˀ|'ˤѭb-L>) [3mxBEͷ1#Ȫ\;7EF5˥Al!+GCr}VoGy:Y 빤G`]֑&tm$[ӭ|yr̎07}R뛻i=˞XρZ^։!uX}a]4D;f榑mPk žJbs\J _uM[_Fr{}(Zw.bWLyuWx8O7O8t[ve IDATa|huK+j+'")|Kc ϵ7rb<ȷЬǕ:@vգve]p0~1nd ]m.aA?/h}, gRqab݇s4;62:;w]V~.k*<4s8r \o `Dfy9I5b4Ȉ7OP8M{a?s;Gn {Wjk&q]ѿrxr9VF8*WZ֜#*c#~Q@jpr k:[CӘnL[-&vgͮHYfYÇ 992m4xٌ; /dV{fu)'o| 27^bG \>o ̷Lf̘Q꺒!""r~ynRÙ;w.qqqbŊ"`˿K}qα۴{¹a$ց{Hŕ#.$DԑH'vﮠKr9RQ_"""RěL;PQJTs,DD*-#Nkljh7쯄B>}O;*7xYm//ZI¼8Uڱhl dGcEfbiRvZDl[X(ƢhlӜX7`5W,TGXjH-4̇vysf/ S}nk=|$M#|$VZ Aˣ5#X&QlFW5]Gѡ=FNLDDDDD@ApPbdM1ˆ#dc[kJVfaCpa7H<{Rsܠ]X6m.aqׁ(?ɉYNz,C{a\7nCơ| Nu#u% ({<[iۼ\?auL?'Ұpn&|λ붑_‹HuB3k:8~0WLOlC3&wÝE+W µXjǫEʰNn}}cu<8ּt"""""RjkMto< H> S7-_k """""QDē\Yl~V._r|;|֔<ž/gsY':7O[' ?b1X~C>8aHmRO$˪DDDDDD cԨk"""""rR,:%""""""uJDDDDDD딈)S"""""""^DDDDDDDNx:%""""""uJDDDDDD딈)S"""""""^DDDDDDDNxeYJg(TZY"""""uJDDDDDD딈)S"""""""^DDDDO; iH0 CQiҤI4`jӛEDDDDN""54PJDDDN,]Kw""@iԉѣGIԉADD0uS"""""""^DDDDO; iHD4PDDja4 %s V:1iҤADD0Y]DDDDDެ.""""" fH8x qqqŋY\AH1MJ+:tRnnzFDD%"""R'Fq""R&:{[w|#Gb&IIIyחCl2"""N'"WkQW=iȔWIVV~~~JBPnn.gt}+OVVI0ygt];_OYi(לoOk]%.>>.]t²,222زe Pu 8oOiUˈ4$JDDDDcnCѥK|||Ȩꕏ]ta֭DDDקdyHCDDDDOvv6e50 ߟX=vQ@233k;sN~~>gt];Oii(ԣd9q\@`N')yyy]˲/e7ݍjag${)Y^DD7w߿AaYYYtһwoV^]a"Tr!):|-{Jދgf񞴴4|}}-HZZZEp9r 6QkAAAуf͚y1qW. %""R*yx>?/raV^asݬ^AS raS""""RI˦M !44chظq#M6ԹfyEzT4Qu+ !T#---[R徾XZW[il\ v3kb 3ߗx'qCqޘ1ѣ}.kQ Ae/gӟiK[ x_f3S_3ŋ Xz| ?ǯg!rxub(V~NƓ(Y+pF<_`ث q#"Ui~\~w|)8uVE|c]-c[kͥSiu'L|Zxd "%]SlFvHFltWqLݳ.Q1DkZV3]_ۿ3kVXZ_fMW]S˫9+\-wEDDD#ޓ۫HفE+||s~ē~?_siF\nOᥗ˸gbpCWrI־otlXIUxDr;R-iQ1Q?,9P8xs 7q8}MoV|v-zWꂫݿ>{~g-60tS v|9-_WJ×u102>Md-F1:3ؒz:oe+唓|s zaB~䥻9Y^oQ4=&#Sc |^fjDxym2-[Ʋe+n{ 8pO'2ȍͻëCЩ+8E=xjCZ4J?%O;;>!0\>sVeZEJmI$3fL:[ns١ey{c8ӆ7elw{ryQtn.mR|e +cǩeaZFt4ʕ_r8LσCl)H=P""""r\/zCj#cyMkkY*T?q7RW剏(eƎpOCA@x*bM+RDx!iL$((D Tc'N ((fͪaLvv6U7??lU1v[^o(k"dDDD;|||hݺ5ׯk׮VD QRR7oSN\./F=^zb@ݗ1YYY9raÆv2B+\XJ15KDDJپ};(JTBCCi׮x1jϧe˖l6֭[ǁ*}}BBB>|8͛7'33ӋQW߅V^%""""0 p\WI ((Jm.V,t4i”)S4-!//R[ڲ>,HCDDDD= Prrr; +.FDDDDDN-""""h]Z.9) .ů1M^Ui2p>߯Oj ԵW""""^q>?qn,bӦMJN-ݵk*DDDDBw]q\@-ZTJDDD+xWRRR} "futlSaRpJmWZ{EDDDDF<OQ""""RSY?q+{,:W YDBDDDD1(^N3W}廬?{R<Ǭ3m]^>HPJDDDlw""JDDDa7n>|s+gr-<hqOaؚU.L~5C~ԓsWgT&J:ctpWC@.{b1ޘ0+s*NoIK "r!Q""""^S~ӽm xXy ;K /q˅O)[!^Nh8C֭ZSٞR=_3$>mJ"""%Uk#""" `n9aHk\t:Ӌ/bYV\Ǫ*gtKb5 &M3siš474frh5_ze""B4Ӟˇ:W4 R@""l9g|=B3ϒ~cX;I'G<Ɯܗɉπ r J7$;us.wA_xZT}- IDATMxFЬG9"Ya)>ǘ`:'[-&}$ *T6ͫS>s=﬘ϯ}A܆xh+P sAWB$RU7>˗凰zLtA➡zE֧sWI?ao">X_?(( 5T!0֓\v'g'jL`.s/5IM74_!eYe$ƤRg&""E~>lE^L"K>mCM6u>#" x< L]xFZ{4G KgϚ>OfӳcjOsCDY1wL٧uIg;wb3Wm[öcLvmLe}h{S̪=ϵ|JǻNԚ&_Vz[Bxٔn+ߝ8;&i<O=pvzڮ1jw">n9rsR/ގKNՉq R3 ;L&E_0LOԣk2K;6V#Rmp먦т/>f]y_ǷbS}`b+uiع+[5qOe t|!!aX֥ۈs8q20ݑD?H=Sgx/X͉6qnT4n_-fi 1y7͇ ^J j<E[6ˆݨʰo1V>֝'|"Vw]'#B }1y2`ڇZ='L;S ssI9vwcآس3cLAY2vN'!f4+_%=98*X''dL-g>Gh˚}Vtu ދ}&6G;mksDٿ[m`߄M;'C=/jº. n^_Ā2fy8q~XՃcX~08yy)޼+=;p{f|KjT QɟraOOQqV(__ĞG/>numGo(M@i[˖_+WE>hk޴hɈɤfXZ>z0mu <37O\/G yydʶ=ְ{kLcC LfăyR5U xaaAgoR6W}Guyjԥgd g/O }|V Lq4WD~'\~k2'JDDDe n6E<ꗥ{f f L7& LXL60e=JRݥLxy\(l`Z"S3 pf`ϰNҿx?+`O' r mɉ^{{hg vWw..6Iۦ}^ږ^qԹn HKt.P\ټhHT|eg`ONMwkΟ3QhoфW⪢fȵ~{㞔ou~,gDŽ }&eym&Lر߆Gn:Eڥ"b?~ۍcmDɺg|i10ɇw\Z~yq+ۀj93Y0O6O_ze3g``lrhebv:%9Ke eLCۿ"TOŶTsirywk]K̿Cx叴Wq S""""%f|6`=0?ʋ Oq/1vU1dd-(X%?Ԁqd/t{y^~r}ֵg~?L`;}f%fI巜Ƶ8ؾm[0&,t[&,fX 3ޞHy7y7g>3rl yqh_q=yysSx1~DXf?(|oY+iv0Y١?6-"߯ɚ̿NH~(/c'޼g[~Ib~*6̄1 )CzΏp(/y䉇i}m:tȝOG`b67rhGt؝yk1[|92:):X׭JuefnOY7wperK&> &8tWpt p4jfƍ/Y3z|C|iw8y}DLOUE] ja}7{a7k`>E'_ij?˿Fmam/sY_C/q&1`ΝKF 2OPPӧO',,rf V)V!:'=)?\:<;;[8_W/R6q.y{HN$"j""""R}:Bm'zǽhQ+-dkɂ 7AdZN%`qVIDgP^^9dW mVMxy\bl`:rZPvugaR55kR\9֬Yq=%"""2^):+S""""""".wI"&s%;#}PDD\&sEDɈ\{4@}FN؊:DD.'C]DDDlzc$v4߱{p=XDDAHn>FMe=u úۜ ;};G揥338)xP %"""vE`or $r 9g\tz9a'yz< gF'"rsW""""<{Z2L1lnV&RI4QANg5[SGG0wB־ߍ+ޥ'7?0GrVeOnEHQ3yxiHF.X8^x#Gv&*tlZ8Lx{;eBkPNM}9{&qeOJDDDek,spujzd<0Α'Rk*y䶴 _q;IβOU?0o R;]^m^?sa'"Rs}W""""]{o 沱EFd֌ & g[DoN Ì_ Q0p^=oFR3 WHDDDDsya j1DKiŤBp>[J9Ow"psj]HqDDDD\v:Ƀ|ƒM+n 3>po*\+|ED$g7]-"""RXWED9%"""RXҋТCDDrF"""""rJDDDIf#wpG{rHa&sN؊:")JDDDDp w\d5#צe6b>~;H1""""ь輞oM+QHeGبu""FLq}u)֜l|hܵ]Aa&w{[QAN'$`~чvsнW':7>O)uwKf 7c@2?=v?E~~坾u1xgW̤6ͼ 7+<>DJ\/yS\+V7Ig3}e4S9<#fMc) ^Đ[D=^8sOO?xyYݨʰo1V>֝'|"VwM糢_9Po]ێUye*lᛃymm9{]uJv䶜OѠ~'3LjX֣#z!kFɕ ғ# ˷F%@jT\JOQq_9)y4&UDDDE3 Ar)>{{pjZYe/<3ᕼ،ܖ3Qhfa+ن;eBkPNM}9yl↛ل ɁՖ[o'j>a)8Zo^kY/(=>g}"W7}Y]DD$Wޕ2^uRMDlJ)܁$xv.|[$9$siz'Ǫ`PMG.6ߕAʼnR2_~w̉lbk(; YXf&Lر7T~%""""Ig0 zV^xFfHـ??9Yq3xDx}UaƯc8/7#ڞf B)eݿ4BMٟ=w^b !8a'߮!jقBy[K^#"EDkv#aݾv0ܩվ& Oݨ'oދc" r WfRTyzY+ww!~<ԋ&O{.D*"r.P,q9%""""""rJDDDDDD唈)(H5^U"qϔ%*ȵEg}hFb&_Vz[Bxٔn+ߝ8;&i<O=pvzڮ1jw">n9rsRPvKgf0oqR{N+\\cD:t&avwcآس3cLA,i, y;w3oƒ xDe[ra,ۓQwqtW\(Z{y? [?i~^+)s}W"""",:~%nG)# S{Ӣ'Ƿ&{"n溁F-Cx'6đR= Y~7Ndx$:'rr+DDD ^n sOD-^9OӱtRٰ:<'=ٰ{z⎳tD~_KBtLh ԩIX0GSmQ |"%q 7gㇸ݄L{3cb"We.EK{Jzg3ɑv?V+X>Jm:rwyyإT|"Ŝ^+""RR=h Vυ=58'g|4+Lzo>B2['jN ʝI $((ӧӴiS*Te@MFxxk֬Q,q=%""""""r$"z̹F%#""RX _Ǚk{v5KDDDDD\Nq9%""""""rJDDDDDD唈KmY""%[^JDDDeL+S""""""".DDDD\F]DDJ&uq9%"""%"R""Rl))4FDDDDDD JDDDDDۉet@&wn$u@rcf^4՛˶5Ha?#}uzVMhڹɸ*yToq]2%z2&E\ﮈ;ћ[0ױ@zQ$""(s) l^ y).X= IDAT?%#E;xGh.FlI rуhu& C`;n:6D]GGA9<#fMc) ^Đ[;e˟[|q`TSrv|&379ϕ?g7M-"""29WRb,g-Ҫ厬L|M1& +T0_vm,eQ/)WDTџ1/E2UH;7.c{5ֵu qd :30AFv&bF <ߙ<_?[CJG~K%Mn5KmM'-lwMd l;AP2xf- ?*ߓ&|tx`p÷'f A-\Y9+MYIkbiuӱ:࿌2{|rg_សW'%"""R 3oc*hV&,YOCU~Qmeޕ&7f Iؼabk>vRpW%<a }g١󕜘jgvzd= *Xޔ/m!f)=Ӳf`fpNX}^1R w =8 AX(nR65 2/U1etېu쎿3&/Jh]LDDKj8c\΁]+9k%|֎}?㿹UlFjG&gIڱa1S'nKq;vUcHn_cRpX}0; ;Ngr uIwX4q?WVx87WKlqXd7v0sgd&8?C7S#`főtl{Xw ˙9HP+<>&lg֢c.?>l%_kZDDD%m{m6:>Â5'y򗯰,Uޓ&-K#^l Ͻhô~m:tЪ5i0'C4^!)<}NxN˻s>ӝrnI软1oXl\NyibSc٣^!4WLg[?4oyA30ηFr=RYɁV}\OiqΞU-K"Dg: -]cEǵȣ =P1\_瑱HDDDDDDD\Nq9%"""^)J+S""""""".DDDDDDD\NƈLgIDTIHAҗEDDDDXP"""".Vw@f6%""""""rJDDDDDD唈˹u}o_a""""""׊<'"JDDDd:ۛppA;FJJJ&""s8x{{Bhh(fCʖ+|EDJ^8nJPPڵ;̞={߈0IDD$GJDߏuf OD9L&j"55ÇSZKDD$GJD9Bdd$iiinjRjUnJ5:$+0 v{a$""W0 V1}"""Q%KDp8l6%"""R+qww'-- R1H>9ӱX,JDDDXW"RJ>L͚5Uщ#vRzbw}k{EDJ^󜈘fԩO?Į] K]DD 99( àVZ.HvI"Lc20Lmۖݻw""Ed2Mhh(k.4Xٲe9XQd5eċ֭Kݺu 0<)DžVE$ݞcS~Y"""yu"4iRQ"""PLjvN ȵrt-Zpa4""J/O+9O_zw;5Aq9%""""""r9V1c%  СCc"b20S"""""""4#I4DDDDD唈)S""""""".DDDDDDD\Nq9%""""""rJDDDDDD唈)S""""""".DDDDDDD\Nq9%""""""rJDDDDDDr`a #n8Dp\yС\v;˒8&MDDDDDd5]KﲉHhh+ckޚ%""""".[DDDD$222زe gΜ)P(UM4bu(FH!زe AAADFFu(R۷۷ӤI()4mڴÐ"<t{e gާ7k$ fyc̶9Z%E|(N= ^動S>WQeL\|8gÉ_}EprdfYΖqdI:x|ywUtr+>jĒeS/?Bd3_-z<҇00"'>I9ޞÖDtfȈi^:{L}- {";ݩxm=a?;ȻOQtۧ?ǫﮢR{`Ǘi %> )Gٽ;P_DL"bҗxlJ7rN_%R4lSVTsexx=87둌{k%5_o+ފ1g p÷b#7+g x/%*ϪnAO[M(/[uO lm'.xw4ieGiO24f'mf#s.6CL|eZfC7R:e3ݔ43_oǁ%|0+P~ "}1Sr"Oגg|;潕у>Gxۨa#nWL}s}d?ϠKSygۼwFG?ˮ&J`G֍| (sqH_̚:C?V|Ӹߥ3-dByۨq{lϞ3x<2bާ?e;3??ѶWp;?= y=X[c+၍3xo#΃n;mI{fr7'0cacŻ9i=˲`\kREFǓ||2ݞAo}_R>8~7ǧ߇_5ovI`*ONeٽw^oNvI9bW?>N.;`^ϧ3s׻3fRdدI,^Ĭ1-84mҦ?;V"U5Z=ؿXc4?9=w ?bys| gegֲ yO.$̝L 3'ŲV|Ew$\͟Ey,*2-:SilCal̠qZx_.rnS/L>!km5дoӍ?ŭ ZUd735秵'(ݲ-;V+iY  ĽyI:U(QK`Fyh=94_o{︁mZԶphLZs9RbH*KG/g#tϪUQ$<;p_x-nzf3 L2]'De3)Gʁ~`К~C֩'5N&ͨ⍛[wL߽:pJb#F6ݩ;āzYiڵ. (iyg'=%F$sR!%žk=f+O4;bϙn?q$FuٹcH EC߳k05>gU[F <]3P'~ R^d'`BKw%&ջ rޤHT&/fŮ$ \fǍ ;7^|t4KU/jq6Q1,Xv~%KY.y 7'>v`x5*v_i;^ZH׹Zևy& <Ҏ`rxևهR>Յ8B[]]=[7` <=wĭFh,~ou|XN^ҏj:[7WUwߧa-/٩f SNhG*)=>ᛡٳTϭ[-V(X;YeN:NBxpvxdvXß]Wh<Ț;˖F|jN4DpKqId)˅hr=6|<.MDD)gG#gUmU&ۮW J~3&7eW_:ϵ.̾-dW#m,e Ȳ_-A!x'#n:7VFdW $:LL-d;~%ZJ,x?cnc[>ac_iSQl鿛A tUF/„$L҆gY|3ǘvdH;1_=b=/QTߵpNtFKzi) w=4(s7HבNo߆}z>^|s4䋕IÖGHHL {!oQf&bc;X҃i_v;5/2Ѭ}ճ<i?NlZ6w'qfNI?9+ݦF.UgN0UIHѲe%1SY{J94o[5LJ-zɫYV}i/x>g&/-q; =#s ~=r#i'_._2)EĖJjj*6|ӻ{65 :%c0/_.n,n5gkL!;ikq&%vn5g!a'odmۇցVOF,ܟٌ18{q/vOaXVV9] -Kx^9/$82z<}$`Y=cٚN=@jn2þ\EBL4Ӧjp3$!Ef2υt+/=M;%EDjG%38kBo{0sl\. | Sbet`pCIDAT 0ģr ` ~ ֔3:m% Q &'m[JqI\ܙ}7 AFǞDOHOt%J`0/\~b\ڮ^5֜0~ȁz*v-"1΄ddzmwuo:'y%̎3źONr'i]Ee}kc-ImM#vr8y4 ǂxd15,襇[6sqEeiB7QB4Naܗ F 7gDj cYA%M83"kKř4`;h::"ags`yvG>`틒J!xTa0lF0_<#3Kȟ)}=3ճT IDATxwEowO. QD0dP$$8SQ==;=08z0 ݝ :؝as]i"B!BUUN')))4mÁn(((`mۖÇiZCW!Bq0M׳qFN;4bbbP֯_omٲcbY^0:B!B8}:v숶;˼!/CB!aeY::yy{5tB!'mے-i7tB!'80,0 ,j4 !B!NersB!^B!B+ DB+ Cќ\pS$8tݺuCUUxhƍiԨM6=!':o߲vݏl?!FtbSڜ1!=Pv}oQO (3QW&+V`ذaaYÇٰaii]t !СC\.lBIe pФ4.ҕhX}5`+|hr8,2,;B9:ǦҦMvQ08x P(T~-B -pEWpsgmOd8oхC9َEp/Pm݋1W悖I;-"4Y&;؟-ϠUbYXI kkW}}t$v&?jBնuYl6l¾}Buؑ38Z B;yw6!BAQ,L>ys lң/mY?QW^Hkc =u&Ϧ;r(X@I%RpocN5#˧Ka,].@g> p%݈[BQ+V\2?mYу4> @RR=z 33-="Bq0"|1qEP#xHl-̘ͥ:[q[]NLKfycX%ìJ"eO+G9u 3'e-ѽb5方,ٻ}]-İjժj:thD|˲Xvm(f͚5tE9"BqPѶҿ Ivr2PP@E^N& 7=},X3BܹmY6mСCt4ټysΝ;U0"C$%ugdy6^&#U+1;)ȠJ$iJlh5(k%l{.tSIO%#4+!;`z1׌i+ EE >&8A *s,BU2HOOCt(mFzz:͛7'>>˖@D!Nʀ ӻHkՒdA~v&FLӗse+xg>ilޮCTO=9MζW4qop&}lޑ@oզ5I;m;[w-]ibSyfqf&ڽksZϓIё!!oB(vQ SN=gϞI֭q8xT6r[n}cB,{ 3 {݂n:qJL]Gˎؗ#MoMIsք3:(ݾ3&LqҬ{߽mUgg^3zt@ώ*{,)1 ;4~:ͣ֯=lW=:IuTR+ !D]pՋ,Oubbbhݺ5iii СeQXXXڵ eրړBTq4J#ڡF':$&@B/#;#\ (܍hKΞXκ tnG#tXu<dciw7^ &9%*0 KB!"oժUGflBq\3榳/72yȨG'=y-/PAl;TK@V`=djB!Nd6!OBQ{ CBԕt!;7>0AΞ]@*!uc%NB"B!Bz'B!B; DB!N!B!D@D!BQ$B!B; DB?EQ: BQo*Q eΕwQ#x +rp4;/ί(Ij=>EbN|)?a9^cztx2"JLLʺNRΘ½^Bkv~ޤ7}41Q+Yn2}46:tRgb /w'e ye/NE9,l:_Rŷ;,yy7 L@P:2],i4w[\qˏy񞩼4qWe=1̹j#ܾY7Gk?7K[~kL@)t?dža0IOlʩ=#ZiܫΥ_q p:ly'aHz)T;L)Tm5K}|@բJ^ߚsv܇B4z-Ex/y>Y#yاw8Z3xf϶ VF y6gto`",@Xϊ8ݍbiWݿbvN"{އ݉|~ƹ#i<̨Ex᥸~U|SyYv-B.&<7_4> dϳ=yijc"zq!{Q|ꟑ}ҹ9 ?߂^@ׂ/鰂һcLʺRMXU-=VuUC "^u݇B?3Uaܸq7?= yJ=Xg A2i%(٬y#G,)Ѱ~Ə\ڧBpqkWd>_qC2t<;X e[ȷ 2֯&H\vou.'gVRNOU=;B'7]A'@_MS!MNutGnf'aÇljܑG9IRwXƞvU!σX{?a6? 8ù>~rڣPh6i62Q8کHа)GrXNQp赻WU~)*f6_9-jQZ|#jyb Ln{jY*)Y1l91pЩ hB;nC%6g඘xS5<͟ Rv|TElaŗ/*luw(X<ȬX0#\yNg nI-VaQ*?k>zp_ ٞwZvS6 n1=XITq4̷$֢j$\bܸ\Fu݇B?f YnZ|"S챸o*q8}_y =v~)/DE)l+htLbʝxn[޴]̎3λ};Mv8ZK?↧V2n瑡F6߿?߉ գx}orF0 JmݑhE8eWd@T215xgMDQ,3WlɴNP1͒+qg2}ڬaчm@-o.=IU8:鿿ǂgs5reƄdMǰnplY v´ipۃ)PKsCY.m0ӻ|riL bPɨ~;s`WW@ nPCt".^t(;洆%,3pӵw#~;c{U6: íe{/;Τ(s~ϗz5cu֢Ћ$<\,e%!ڇ i\"jq#4N߇W@Sݩ$6ģJ ujbF [t4uHKNQ5xelO >zYrz XeTݺ-o$M=SKkxΞTlԖ+4s >ͳ/+9Zx7Xڊ󜙨Q.&܊[) [+6-(Si1I8 SdָJ\oLtAb9PHTXT<6L#'tsָ=z9*t|. g9-0stVF٩sNyn%zi=-vT~~.pXW@aE|ԑlj>]!ڍ:m86q0C^AvmNV?2tL,&l3 IxoGNXKue#:IeF8e]*VmA,]ώwSxf_R1H:\\_Zz.-^~(ݕH#/WV3+xH!_~]w:n+yltˤ`2j]!K cqu5>;4u3p`.z˂讣9#}/}oXZyls>=+Y~ _^)SUY|q@&j%ǰO㷿&=`aեt9cFUyW>\FTpݝ/igὍ:M,{bN^1Q)4s݅XX~%1_uy_/3niEwc%|9>^{x\Rs9-OaΥ3tw^pnT|jQWG9 K>W],W@įGl\4Q_hkd\tEşKe Փ﹐`ŗ2m'#7p:4fL=r c/{訒` QNQeTUvJj.X{ukYM9=fcViZ:LLw:cs1L~eDgp Ճ[S7v27,69mVyE~4f̙A⇷2i&%I-9 hgnJjѕdEUϧJQ qGe/M›<Wk&)3ds:TwhMQ*FFUZOzsg0,ǧf/rTc̿ UjVƩSM \6~,'_σomja=\NS9y*}[ھ?JJIz5nѪ˷*^aP]Pǡ̟?8p`?jFtttIsQ{Á+2GUUN'6[qX:>Vc+[wyvv;b60ʤpp8PnX/tԴ. N ٶ|,nMU%&&UU|JQreO4 1 UU)]PPi)ǚat4>"ev٥4P~?t:iO  p-** Vf-_S-ƨUʖYzWp8lXP6+˧2_z9Gm)=p,l Vt4`\( @WfTNK ߕ-yp8gf<$9*xj<jWu|V[ "AUCCUm%(z@Q>祏eϗUՏjTW^ߪ`,]Ot,Q}(c[fM}F%gN>ofѪjA@@{+ʧX*2t]/Sɔ_nuzz ijRen?YaI ص!6-IvZl\̛{Nad(L_s0*y/LKA_y,=w79YuV2k*a!-5.U/wrc6Y~.OQ3azc6*.㳺ߪU8%*,˪t; |.}~nTWVUC!_dwJLQ}\OEnBKhÅ)V4c6^ݛY38i˲,&L) ڋ)Du @dȑ^G !ڡ 62 IDATYUK|"8D-HUDOǯfW8U6DM; @O7yB!I "B!w6@nB!B+B!B;B!B;B!B;B!B;B!B;B!B; DB!Nf !B!"B!Bz'CB!VEAUUTUEQj, 41MS!r̞|~?@aq8aJB]UUyꩧxwkv;cǎn0cJ8qI)f ˲uEtۂ>l򼪋N-*lN#gǰO!ĉNCEaʕ֪Gdʕ̚5+ii-0 , kyleSazP^uil*__֭>l >~E) QG|>] '`ࡠ#Xx;ƖBRozkNgnBOfvEa$&&Vh (Ç8q"ehVU_00M3iifel.OQ4Mc~RSS1bSNfi{<_}UDI4 Vo^Ď`c~":::iEEEPTT*wұcLj '&v[o[ءMs,󰥺eH(/y4,P(*`Y %eRP E20CIFr/BթGIJPcn]ip2n@hҥKYlQ%NEQ0Mk#F0rȈSUʆ%K5@}YYY<̟?A3gr}Ia( *aU:L} \)n|lQ e`aÇ] BQ G{* D MWi,[gy 7 F5kgAQ`IJ*Z/2A… ׯ_D6һtRE!''?gy?k64ݱuիWNQ/_^Xa=999 D|(®]xlj`͚58 iu5k Oؾ%j\(*194Cg ovz-^~eNg ,pWrW0a„XEc=ؖև!n!:~,DS$Ǵo4z'zcׁ%BF#bBAFm b {9qݤq7*Ûo4n7 iYml~@qb{/bkٚ|\ztu<6Yg'_Ga4jԨBK˖-+iYV(tb& ./;$..P|gqn8핗a-0}t4M/V;iӦx^QZܹsC ͘J:u*Pм[#Val6͛а4y裏ӀJ+[fYydk8FQ222x}p8xӧ~nﾛ*v馛J[zAȝw޽{-sl4mڔz#yyyL4-Z0gΜc FEq`ΒSD3 ,x p60nOEk9 6˗h"hڴihڴ)̚5)SpSόeYt?"#²sxٝ3_ʸA#nG2"@#"v"~ \Jʲ,6m r6mZ{B7x#r U#!!SN9o1bA[t:+t[o{e*|ra(GfOZwǓO>{gӱP`r*$%%Uf}CPXXHaa!C&**$k߷  [!gpbƫ0ɩ8oҦMOe݉iӦBoѰ, c{Jhlc֥,.{>"_J"V<4NWݰpVXVyex<-8$mڴi,XiMzX)BZZ+W,s<ʕ+ӧ)))xPU|yfϞ|T[eOUnnnćh:w̹_4zsΡeY$$$T[nnn, =؏ص,hԢva7{_Z@w3_oNպ-bc1tۗo^XЬ@K''Mzձ0 'ddIr2+df"`m|F/;nt}"p7߿f͚U:\Y~Bv*f8\<>wػt]SNs9㏕NsgЩS64Kl<4iUUu 6,yްI<X_~V澚4TU 2W1իݻwDB&NȎ;*&NHaaaXi&gdddm 4(t4MV^]w(%%vSfYiչ;J~(m#ک-q=|;pۮ7`չ;a*SNe,YVf{ukScbb3f :u"???l/_мoRUydQVBZS bYn^mM6\.,bĈeQXŢE-%?%))ix<kĂBƏoViCsaoh*馛*nܹ 5Mc͚5 84Qܹsٹs'hF @UU8q\hf/ҤI:+cq\s=6 /r2]~a), ]י0a'|ݻw~u3gҧOK"z*7x#~2Mm?zEg0 r|$4CףP3eѢdRmXI^^mڴncɒ%l޼(.?sOumawz :uĘ1cBi ˲؜oYta=#w?(f@e,- |z!: 2 qЮ]jfiV4@X*-Μ9s=zO?KJJ"//sr]wEUߤIxW6i$t]ә^/^(碪>|8Pk׆*dŊK]y啡|$$$0l0@HQ}Q8H[+G ?///@ @V8sBCzEV"ZE^^6=zwo6;0=z'ݙw8-@Su" w? twxĞzQUK.۷l2^7t3P8*M0bڵkH xf\9G>Dh?}|0m 8}B7🥳Q2_@f !:"ӵkW:jo ސ|}1 㘮<M믿^"޽;]tP > ?yd@*K]iٲ%guV(ѣ-[ؐXU;9"5 Gǎ/3mCoݺ5 }x5)q2P ><;1|p #{5СC,^Ũ*' xb7nYEAl2Q3#ho_GOi밵D?1v[;Rf gGAl2ff9994oޜ뮻UVER|,.]0t-''"-ċ#Ngn`hhG< `Pf|4pA7 W!RklHwy{]Vfʔ)\|Ō;*,0HMM/gѢE`i0j(4Mcƍl6LBBBB R :t(C =TDeѭ[74i"^޽{ӿ-[Ɨ_~G u""0︩H66+{✪L0!AajԨQ|_L s#9/vo7Wu*n3@pߢ>;@=CޑaÆELV0 ^Lį_b8b$"~Iˁlع]p7p[覅eXX!zViMLphҔ)Shܸ1|Mif̘!C*\!?^?믿2hР2Ck>|8..] p̘1ay'Ѩ7{^FgϞp zf;<>h˲hܸ1ӧOW_E4Ȇ ؿi5kFYf a0uTbbb6Ѳ, ](z$t?mtGUVj:9|3'|4C4NK, 0K01ץy'#c=v SGqG Ta[XH"f{ii3d زeK跎;p]z1xHLQQQ!Aaԫ:wyg>|8b뭬e$%%1k,>쳰'TW iӦ =̜9UUQU3<{.T6m^Ν;H+˲w]J;&j{=3Ezo{:3'GQ=!'@ (Hc/yݙ?l\Hr{0"BQ0 #A~BQ3eVHPUz-G͙0as-TUv굧f\o}|uJVVV؇ffXn])Q:uo߾zq`$P>=N3BG8rOf䣃jϴl 6Vٞbh2u~KBO? 4),,dܸqZCRXX(AI.H=B*Vo {]6lX~?ԫnV`*{du+Hhb'ѭivTMCU4TEEACS3c:eG{Hq*]p !89f:^Çxfó,rH_vƳvZ~~j?*Wec)BVҿ?v]BK ,#!DIֺukZnIyBQjC'@!Bq@D!BQmhB!BIB!I "B!w24K!BQ$B!B;%B!w!B! `˖- !B!IЯ_NB!$f%B!N.:i6tR;i"B!Hzx<>|+H"!!8\.WC'I!Bԁ" $ . **t)**bڵhno !Bڪ4BW~p`&YYY |J "Bq eggza( .0"4zDEEIr^/2M!8T& ɡ{Ƣ(JCaY_~(FH9L$B!?e]9|0ݻwpx*]'Anذa !B!T n~Cq2H!BBC˲d8V("!BAOͲ,K< ˔%B!'ㄢ(lڴ7x[gZlIǎKܹ$B!ṕHʼeSyxbv;8233Yz5˗/gĉz뭒B!@6YUUٶm۷og޽hтv1n8ڷo/7gEQ}og}ax\{:Cv*B!N\G̟? p8ABB̟?B bf⚐ؘXě^Frd~ }C8W˗ :H{ԩS;v,\r 6h/_^1S6֯__Ή>}e؞B!ɨ@$m۶j*bbb\/@=SbۉaժUl۶ > #'2_z'?WyfiG?g/sy0߲loK?c\|ygbݼqd&L}oX.`1ь1}Eaez?fΜ_OTTM4nC4֭[ǓO>v{1eP0%|) F䙻_cwg#SXq˫XIR<:WѬKy%,]t}:`#Hn#֮[mE;cTV\rV0}bKcoͅ_X>v~1ǜB!⏣NUUU'x(lْ3fzQUf͚n@UU #8ٻ(M6JЫtH(*XП +"A!4Q# A*қP ɖy`B ޏsLfgޙ}nM=NGщ|5kJKO1iYW.dej!fSDzHb1J_ZѝQ.%֚_F%/_`ii#x6' ѡf͢Ǵަ|iO fez, Z  TU|w`XPU{hM`Vlfϡ8 şj+l[ !z2s{ qɨhxxi]iZ A|勾}U\4Gjxq6 U+5xҭ^:Jj+9ICӬSᇕ  CWV#yjDEEȑ#s;w2k,t:]ξ7͊@ZoJ&IAFtpaR' .΋o;#pј&iz74h% XkT/)hPSϒXyוnE{%Ԯ]WWW\\\tʙ3gX`ۋ!7~0$8g0&Mߙ{ۤIёt*>Mj:A%K#gյbLM¬ csbh4dY`0p!9s&q5 ˶8F0p[96P7^Vo2_4iL_۬;a7[6te4 ۼڵIהNG[jNrv?  P"kԩS7t:r?#zBQfϞ$ItRUNG:ul,leor:Mћn.@F`nL5M 3>gt9û,[vv$tÍͺҴU}yzf]ޜ>J9qGez=ǏGt{( ק~Mper g Ԉ)=wjz魟ue?e䜍}ɯ +:}?Oy{KAAO6mڬY39y$M6%555Z-`9*BժUIKK#>>IX,X,f3&޽{RO/lٲPN|F^ԩSt:z}NmjEPvmj֬hs'I~n6Q+Vѣser8::AAYb4ӧdڵZzIZzuFjO!JQz=uA$4=7(kw,AAA(@v0Nʕ \zx|||bŊt: 4U  O|"7FdYjժ93dAv1"F@*  “ K8AAAU '   d+AAAD "  B]  @$444g^`edd䬪TyrܼbhAA`0q8SU5gyAAx$鎟@SN9YPp:w\IAA`4pwǞ <==: %xVAAwŬYEL~  %=(EAAAPEDAAB'AAA }fܹh4"vArgZ4hP;Dw@nh4ڶmKX9;&eSAacrܯﶻ! “ARՔCJ&rXAAvXQ}ܻ {~*Urbu'~`4 3gXUL5d3;~>3Mc-$"3;ue E7tF x1k -/x+y?1 ?}螯TRڽ]qhIppulYmݷu߿ rѯt݃{|F^ؕޞIIl,S\=z'"5bSjQjՆ_سl(EA—1"rnhKmEv7{'~ނ9YK:%3`L24^eYc xo{.wQ$Y rNDwKdKQD1F}F?g~ZԩA =Nџzq#ާU}lKSrYN' t*{}Oe=-ϭ\"lW%vJVQp"ZWbЦ 0cGk=mo 2vaAԱ e$?jsBP-$mGpNyvx}}r.0HZA)o_,hphˀHۺs\M&jg=y&@%>NJsYǾJ/+.XIٷAS׳|:a0Mo'ήg3XUkKaۤn~{ s%CFNvTt'O͹8|9΃؎T1%r1 E$9QRS&IGb۞l OkIs/ſ=w3߂ ^{;IH7>tl~K_mwb~4WoҌTk]Sz.ϟ|nlfk8G߮)9_ۮ5ߗAj.쪤T<\G%ov"Hr`h*s8**{`^ϫIS>qO5U)XȷnɊ{K-ʞAg9[b*GkxgʵFX{R8/A˥K$Zwg%@}Y/ݩ;뷗բ*Br($67YE >~!$L6[uD|I.讟csY/G-Wjc޳ߵs;.K\KU[Ětg8uM3kkk: )Gr*ۜ>ǐƠzHK&dW1fK7"\vUĆCcKii.׼NT쟟Ǚ.CӾbnFOV vY\:|y9Mi2~0r\6Oir9fk!'~d@1rec>b~l>C'cەpDEѕc! !q/ˋ}̍`^?:zdsa[z!b 6 %dRfCGLݳ* ]ocCM7PUH:F8 [|,5b3l~vKpegF؀k|  XC8Ѽ.eҫhz@AYC:MF.ez̮P ; ii1Z&e,4a]2`6Z9qBC&&jh=!qP5;4q~4oOF&=\ ]ڴQ?g}ނyi@GJx;H3PˑiiȦޟfQk^jk%4ޥ oLƁyxqԣUdfeG3_cj_8dIwKHZ$ĤctT-["P \F./sӦ4lN#q!/օ̖CGF: fbU'WI^3MfPRNħqP05J*qKȩV2-WG/á ڝfKMTc%be[TUT22Y;؄Z0ZvҢe'XP"kӭPAUBt[Iۺ-q PҳTR>پ:]n;ahjWgڴ[׼G1ؐ/DjCc"Ʌ-χvpLO0w:пq!ݱeO22ꊎЖ=q5q piaӹzd:Bъ%8~XJZI3n7]5|ܰKF`!6zM(%-c  E6wI 遡bx9$4Detw /zjoX._wma>χ,դ(/X,Zd;=e2Ϥt6Qfdܴ n冄yY:bMU̎R ԭotP-l_=ਡr&Y (SĎ,iqւ&PGz 5rZvq?K-t[ U*epv]^$Z]A)'Fn5 wU7OY'61ZN96n?k\vRj"n5웆➯Nj%@!9c2QT Y:wT>4}#;^FKʞdZAMlMI\x*緕jŢYq~z/ҡ=Vbqx1**&f+jl2a4)6v3sMl;I9:58_n 鹴$׭`M>ʲM ..POH йe"l%:f4JnUs2Ê?|ݿxjBy=TRW*cЀr We(e߉A/yo#MqXWoRg*/U#bS$dv̎yGqW]ƶrbʲmYk%?<.2htJ4)yhO~mY }|:Hl¼*n Z u3pux&_$Kvw4ZHT,9тoݬ I|e*rbAV =W_Z7f}R1ïm{xhtZztH?.kB P{wӀzOpb:}6p=ɊdgmS~CfHhh:tcD+P heCu˒%u:g'z+:f <4xo;uBAJb ѻCAABD l &LJ̅D̲y'_-%&  %ϏC3tuz 88~(?;BzД'OD b<5w>Z\W~hޞrϿ  Bq&]nʫo_3G"ZS.-6>0il}!Yu=UoT+<ȓOKzԯիAAB$av\]szK43)㪡} ?XWe  NTYYf0nI&b9g*Gj8 zJxf-f֣\UB鈧L$?>{3qYida槇J2rRًǩf\;Zދ2Uٜ9- {qfv_@؄ 1̾>9X-߳?ѷ '5C7ߑkBnʵ`s^\Zvt*p@i#mOAA/r̕kE[D[D@ֵ.8+v@t-nKL3@G@V A]BiPÃsW04('3[T+zc/IȆ@"j%]9< s!BsC%$H4+ $E2$vN:Yʉ+ q/nX?AA!7d2N]oԗakΐqP3I(y#lEI5$4Ȓ(${8PKYlʚT07i(ȡY8FA*~%4hn]FIUe qZ{={Dg<}ͣOAAȍ2^÷?8 V2Ȕp,Kk亠aqYPM ¹H^pϘxIH5zܝe⓰_Hi1^=~ I:aOAA>4pಉ\=™W`pg T2Ο ѣ27ŀj$S5P{ i{h8ay)woql]ƚW1`ͼ̡,v;?*{'8Q)vl:|Y,?  q{X2rowhhV&FӫGM9DlEPn? Xw)aա V{m}3?b z_ʗuG{ѾqM|ղ.!c [QF$'#ht'@PwqTbs%|+zew%\3v͂%3:4.5yndwAA᱑=iR$_}R` }-gZݗu&,s,+Ve3,kBn`ka/U1fqM6k .^H׮]ILLQQQmۖr%Ik 3Bر i0`@~ <8~| 6vY{S ]o_uA]U⯐8 ׮Y8/pAXP ߍbF0:e ł&/m!(F;qf?HJϳs Nљ]iw/Cm>SڇyyM}A۱B)j\dLG҉];׷U =|r[&.hpvTL`[zVSY*]PɟnB 5Mg2JbϬSM\=w1Z^[ٞOu})FOIf]s娎\Kx"wgIdaUr;g7u';ǹ7A(&JhDAFgIШM*82$/]ʢqv86jP*Вç9݌5,qMXDǁ g ݅p{2M]#Sp {Bܳ_jZvcyN)f8CZ}!twu1yf+bR:c2ml]|@G!|=gg X*# ]|0| .yҹ%%ZuUC8T4oIACX߲TwG6 pjo_?e`dRUB <H(ͷl*i{@:пq;Z.W%__fY) R % +e 7# ήHR@DO.f.ƫT,%+ c!# lݝfbyK0䡊LƷEj9Oue=+#ԃ޸hp5vS)(^A9̱g(&?>fE Axc1"2njV(a kk ]FEADtAA@D̨,T3j Jc2E/%X1隕_*RT xVVb'ֳ}|AbOЌȌg毜NvA"%s58~- KӬ0>Q^ O1iɧxHLc#6ep*ٹ*8J~ ӹw~}AJ+&2'?>\2Upv$?;E̒EcC-ۖˆ\/,&%:fUr!J=Ct.4MV0{/2JKа%=WJ_ٸ˃U.M4jE!w/rCfB~KUq}XD"Eai۶͉鹀C!pp4#2UhQ]ݲ=Z ;ޏfdZ|G*xJql~fƏжgSI^d8q`flBE[[KĐބJ9v8SKţ^= <k~>xwdbgM!xrV~׉dYKSya51tz5! ޤCŕX:՟}D_[x^ySV jw.OÐ_*;rn);F3x܃T_Fɠ%q7*TYص]j>d+KtC^it,)⥻{Cޫ1sPUsgVm oDրDn;<HqׁKSsڶx?GOpAXP ߍbF0kj$@}Y_~{)Z}RA*Ɠٟ#VCWCӍA c.(/G~AZ'u'cL?Nډ_Lh @±JmA!7~'t6Bh31:k:6dfF`lfW5}İpd gJLt ~X8ST{cCd>Tv[[WqϿ]ǒ1C^;{ylyYI:>} 3WQcqAbd Oi3ޱ{xT{T-k//\!@;.f FRR(ڨKY4>&HaѪF_ -I;|+Xˆה*֦8'MEyOG%G 8Yͮh{RQ=lv݃ײP*G8+ O 8Qk7gĕ_=1â]G?cHٷǁ5 * ^ηRaـ5oqrӶ+h׏< <2^Lsg/&3&ӦPjoҹ%%ZuUj7l̀TW\%bDC 7V.:?9Fݛd/ΙlqWw%_wb-:p ˯w/otr%:TNIo3щx)] 9?cC~j,/6+ف Sk\0P1]ЧkX>Q5q!w,gnu2,!A֨X:}so\bƫ/ǯquR E N^&DT}H@?|\5ʄQAL`4˃_'Ѡw,KX-\^WXia%$ r2-P|'+YXo5tf}V}.܇<_mdU gooPgo={oqodwTJ壧x<3m}7}*ċ{OP+P¶oƑ&̜׃0"ADnRo ;\&d[ *װ{~NT1VFl9ΑU8+&aTޝV<-drvFbBQ!n'u7I8fJLd) ہdpB/e@P1]@1c/tj4g-d5i@3{8]KZr8KȮPw~O=$(oX\?A%?>OttyX84G^n/eLCƣN'Y$hhQ2${}|YۆhMaDŽ|эEPaAҍejLY|+_'y"p~j9;o,cPuwmMzH*$uY󞣁[/]ˌcϬXڔÿ3rr,.` coSpО~ʽ {oװz#6'xb%yz6 ͢Np!^7kf?$/[9K]:8տ-<{^ySeS4*O 8OŮcCeS#b';&px)s5ᑿ/7v`4I0ޭU-#y';~y{J$O 'ϯ"t_-…_xYKDmd3l;{ uu-BdI}ѱe/kX[l)׉ F7sSAhT@^'6%;u'HJd{#xeу!}5W1ïm{xh*.OܩdYĈc6s,-x^CщG1"}GUߙI$^^*ۮ.϶k]uuu]ѵ* @T("BHH3s@)65Nkn#|c2AMho2 8;(2?{ rC2EuK+G[n}\J 9{ #"""QDd]'l#5늑 `Ÿi(XGbлAt:n73vo\Ʒ6|1/\E/ݗ2곀.:ZawOjK $-^D]ݛ/WAp""">fˎIJԧV^9߯Ğ#Φ6Y\8fgj<~.F/O^lIǗa}elNA2FDDDMV?H<{h,w/X a~ 5ae7lWDԸ}0ہpۋcxa qgWk4jf\*(P]zbdc87.6#FL 8~4yn6VILxė/f{cù솑bUuat͈o6}ѵ푟-aG\t +LKdToHa*or89Y8wb}hZy|???Sh#z߉#U ]23I39_ڷ;⟕ĦWay29v/Ba_{$d%\v_1_:Jv~5^tjG$~fFAwt!RAtoTl; s?5buf/3)k;uooYg"aķ5 #*.g4~f{qW$ O1Vj;H_˸/dZ`-#3M\> ~v9Ųb5SI)6z1n4bll}HܝQ넁W\4~8iS˙Hj%1;3_0[q:G`@_,aNŒ;t†9( sJA2 0G-cQe7gZAD;[l'p>|3ǁ1FLW\&^1{.?MztȳSr:wdrd`.~ D]ۘ_d M?'a/%aTw[9m>xA3/v5'6[7yDY/EcCB"|l~x4IM㛃0l ~t{M#@8mohn!)-NG=?{宁!Dxb|ؖSiQ'?U&=n[J&"`fcZ-"""R344+'t#8SԤ[ԶÌyAq41un(\a(6+8)#:-+8ɸ<>-װW~2{ԹtL ;A&0}pmaU4(,sSMk#d "%8In5;|.qVaݸþɍO ǡtl]~/.a'EAAjYѝ,d{ub`xȆL㬿gN>vÆqIDs.IJ|L f`(M!KqT+b_(4>#,fWKZ>473^?;S%8d.^œg=AHg09lYdUHKI^b.Nt}# _#4Yc98c[8b]m'oHzldŶ$:w4}ޛBFRT\6͍ =1ܰ&D)8=c6h+]bkDhK;a0fJ4}DMN݃آvs,L28yO9: zfF'\R`, |C1>w W7SJ2g,cV'|s !wHO滛0C `յ<\St~z:{:s13SvQDDD*QfHTEDDD#)S"""""""nDDDDDDDNq;%""""""vJDDDDDD픈)S"""""""nDDDDDDDNq;[LӬ/,`2"O """"ҹY="UMFDDDDDD*RVQC2ƻy;4˫#9V&q\Ρ2UK?7$5Z:ó2uk{$?-<Hl=kwca8V1~ܿܛ%6OF$""""R [q:Y]ذNp%+n3ȄU xu`KsoĖo-o)xK썴`=o,˖Tl@Ūr$(Z9[AH!wnHƋ?;yWPIG>l|G#6"/r4Oi9V| 1_> /q|ӏ^g'y9]1)+Gn7 ur Ɛ&?]o"LYv8},4˔hh`ߑk哔aZrǟxn%h<+nEDDDD?ŵCy11Q<ޚYH&e[Oodh־ir &7*D-?07xh(/G9y'/wn !<#fvDDDDDTђo4]ht'DOմ?=/ےOw`tH9{\?t!ޗ{ohڋMQ%a,wGO/ hv@؏ї_Gݪue;qs[.O5ro\ y׆wb0hc,Ǜ 8Eec(3 1V"B,oނ_(D0!ޠ 4)./7M+^sۘ_dd-'""""D'oNp❒^p %w&$Ӂ->@F\8JrEpJ&"dq i &N{\*`Ώ}?y6 _NN^O֓;LrlV(62{) e`gQ,O+`>'4)vkSQn ,~)K'4tJN oeⰧ@Fң*+ ~!Φ5܂1+شB1HiB>;|b' =.1Lrt-JBI->yd6ܿ\RDDDDjgЎUO'K 2 7ej nC+/,_f\2;JhW ]f\@!s&+X9s;>΂,*LX7"jy"""""1k,sذaԩSIMM=kٳg3n8:,rw*L<33fw_> ..wX^ڳCDDDDDaR"""""""n9"rN<.՟G[ϞK KeH&9{9_'ˁO)%F7 I~{K>vTxR񋈈H5ՏlI)c3cYV"/ s&Y+bѧ g*S_@ߗB΍F*~zDL_fZ"~zC'X+,>Cvv{OoI̜ы 83Y3k ͺOIh}򞦙ϳf镶2+u16OӬXL@S'jf$zRMeP`Socwbq)7?߬ϑίW݈wȏ" 9n~2?ܶs-sWz|;V|~)@|3?!%+X8aV&rmQ5.?Kz": ?/WZgڞSvuw*-'7_]]MaYL2>py't+fطٲp.fh7SVQ/f"DF±Gk?ȧϽJqa;|kO':o'^76ϗsYv#\G2#8Ivim&йi8ٿko߯ub7es=/t˾eN&! WP,89l i/m3W"6b[0)oJUi;HŸӈeY3#qwFauAL(pEgвc0^'Mόֲ٫ΆfU5C_|Qr ~3}ЩUZTeZ60b[/Ow3mĴ~DKhtsKJrg?au V!d!|B{ &=n[Pmȯf2j!p|"xӨft0-?ЌV@ꪕ뫺 sO~Vtu GJjB֑ۚdmmepvG.֕7oϬ|gE<{q}NO>/""RaQXXݜyDaO#A.A|b{Rp c8_*<;-^Y!t]FR hulӋm˰AUS{ ӦW`  ]'2`ސUm&0#uHg0 w=}}[L,"yl]sҁ.Q}8-UIz[>ws5#'vmPrkT^$"FhS:.廭KʟrMwD:_J 53 s5hάݬ%GЙYc:ζ}z֐֗IeXǘCi7,.;/S[bkVa&>Ie|<s,Zw7/fgaLy+-7|ĥu IDATqCD"?OyfFP ^$wҸiW#}o o?;-W-~kO7~VŔx f@w >QUO2d| i{`<Ox3i<f$v}=)MglϿHǷ57r|@zoY,a:}0vǕ^bI6Ca؎Ч _ܙ7>~g&Nn~/I |B5𞌿 s&:ҵ&W ʯtX\}TeG~)Y[^#F 5Qx#k™Zw5yr2W}ÑǑ/50>7Zj[s6.G̍8W Ԡr} +jK=y-1niLMN0^5;"""0f͚e6 T8iHMM=kٳg3n8:,jb"R!G{_LenxQb'Vĵ\&`l3 |0BYzblk!flV"""""R{|ޮ#NX8e04g"*Y}MLhᝂcF̠T^~7X ;Ƽ8,+0yHsR͚A)8VVMǽ8RQz.~ """""VI]f;4OP3C=HGDDDDDDܮ%"y qEDDDD=5y[K-2XkՆ/[^0vȋwwd""""" RK$؏MA` =.t""""" F͇fyyOQI/Qqg^1C`RV.F@>pՓpt?zrAem|X"L zIf0a)\4ƌw>`(ݫY7rLW/""""rr /ρ瀱|`o{P'Y9xd-Z3 K/බ'7`س| \uv`Mk%ǢUP/0 -hՑo`31mBٙ0g FƁŀ0S,W7M DkB\REDDDD=nHD 9'>$p-bj/ܒY">,(ި{<ޠ0r xNRsJl`)a̼ Rj̻#8`zq"""""RHaPPӵ} fl_G [C/l^T~f6DApX:6`ٶ3F %(Y:w5õk澈jJGd-)GĻ֜ʷ9="Tzk,|]pǢ?xwx4 & -Zf//?0kp*_%\߷+?DD%""""v 4 aGXXXe $++C?xеU_Br! P;XSIJ~~>ׯ4M+wWӔxP񓌪vIH]hт*M(4MwֺH}`t""b֤ߗz#y17Ms<}4MNg?ϊhUϹohMxW(M6tN7f!w[U4M, Vx:??ypY쨕}}EjyO3,Д-"e?̪E 0۩IΎxxpLjipo&`⣇2j@?;ǎC>{>x3h@L;sO&B6& waL?}h/OìF ÑG^E0fʳ]v8+)ga̘㧜'FjCPf+x|OVy ^ߙRZ}Ez!dZ,[ግP/ -6n_Ic1$~4zDw/o4-i؛MI؈2+l|a*w{ƿ2<|g~ĺ 1}OnyaՉzWX Cz'f7)Yp?&w?Y `'?"R%ze28(d+`̅Sõrw,s7kՏNuj6sՂCXj'iF(mc,i]b~P{|N% y߅\7)ކ}VՌzWtwryq.ib:eNZˌX?}X.+R3Xt3v7 S_"2Rr[ ?~3+1efoO<̟{Ǟ| @!= _ SuwwW=#"""FK;»ߒ<=W2fx<#0GhJ<']gkd qLf/8ʻ_$ f>2{'3KZil~ KOT/~+o!w? "M<^NJnVrv-:Rӿ>[~Z曷KX0&]yǘUoT _ 7<̻Kij qUČ?Nb>bKQh޾+'9Y{1Bջ9Y_wQ/{g||ֆ^g/5"5t%+Wd5|nhxZ=Ճߞ Y^H'xpA k6oכ 50d?v䑖A e+(=rw.x?0-FCOrW̞G*+رc>c,!*5 e,߽mØ6>1gkV%6?%kwN-c1*_ޝ~GfȠȳﭖܯsDNnbbWY=3jB7,` KƆ}"7nL[EDn"Cym2`38(8-sqEx4S`/o4 }# ҏ7qj,ݳ7I~GU;L$NO埞}C0ڏ1⹅,]Ds[#ܾ2{1tje,c{ߎCI_g* 掔 .˺aiUQi=8 32ùY_wQ""""?&%ڑKFrּin|vB?1zg$y72Ly7aSfQxLnf-gQ`J\5d0cȑadM KηWpgeJ;y˓k|z"vZ1C9N=V2Q+5D,zQqV Ղa I2)O|Zc _y!}"9oy nc/-iKh\k}S`/WdI%;!;%QЬKNJYW60ic+lHgצ#whCIs [aJN6NcoWw``u>xz_\ja-pUKo)IaɲE&?/ ;e1[N%Li``TZO[!\>`:\| űs"DDDD,y[߱B[h{fEOr~"Ղ%ו|Ee,7n,2{Jq]nou9ĚyG+; !V*osե֝C%""""Yc\r:a8?ap1YgPPPP} !88Z sw'!C\%#"""MVҥ .BoFǎqcp8ٳ'k׮0 /c9tCne.HC4,e%""!Ү];oNZZZs9PڶmKxx8n} hѢ 6~OHHÆ Yfdee1khQ""""!aUm "88إiA&M2eJKp8'33rZJDDDD =/ЬrK}JDDDm=BQ\0yNj*ɀN|DvkUw^|ǹ>2MM6y: 9~t.]q %"u%x:i@/^\㕈[(qO " DDDPHzxDrr2Zz{:S~#"nvez|Ԉ>JDDD^#NkaćPf!5J]۔9Le}@q/ܾvS ρ0䔷7\y\ҝQ?*=h?Ldu,#Vl'<G@w=ۼDOFp z4t$e[0 FËN%V|hO=}.ya0zk W|G?6}@xb/eIZ  /*;/!d -zR+dBÍs k`0o }`_Q+=߅JGM?3JDDDmjd|Y B΢U#0}$] eX (iqY[; +/ݳi ]ECK\/;?l^ NLX8ܸrvW^k篒s[^|;a_!}3:Q+_[`zxL]:8n_. ҄ v551 Qcb`!Jl VXPP@[~.Ҷ<}XvΜ93;33g`0{pݰm8Ů θB pMJR$u wZtxm ? ^o`mDu~'=[i¤c!9JVJZ2 )|UۿD$Iw6tLè0 W`N*lhɝ0gUd~)ZyLէ_WephhV0! }=Pxעi83jҔR߄eACZv IDAT4*cjA2\;u|ʱ|j# XâD} ' [tG+Pxirg$!iE(ZT-O3"DZ$(pU|X\mð){Z_T[!6QxUs&ձ?D&³90RXxB~~(8 07vSEapM_>R~~oV$ՔH$R3Ǚ6áJz:ˇH|1P2g%IS̞TH| :w}`DXSx_'C&}õ {Vz,/~U^ C{@ӡY )=/S8 gG/ !&\ Ӟ>˿|[8 N̅ -|0L=.ȝͺ@0-_Y)0lO=!o;k#C1p,}aYrha_wKYGTS'O 45kְtRcرlذkz<4i3<ÁHJJ.㤦2uT:wL˖-3gwD$I$EAD$IRD$I$EAD(I[$}ʂ)F<_ zyZ~$UbADT;\ [jf^~j[b|$ kmHHЦ?L\x΂C{BB]qXh ”[$zX8C/@b`ث}= W>'@ˡ0wKV근WӿBš{| SSY=\nsCF|{8g?h7.;f֗vKuADTapvɅ`||~.,f'a0v#Sãs`ۦ~Kg 8+D`΍pi&lY 'APa)\xᛩ5*)[+EUhh,x%8Th|Os:} O>mKz.K ~,($i7 k|<Ɲ 0Ŷ|?φVq  sf@Zyzv`S8/R ۸4){x_[w3@%<@E RBl>Hk@W/@V9к4nRaÆگIRT 4NߘWLۄErm!8z0F)ȁ}!'Li VVU,c,t) *coOӡp׸)~B14-Eh !keO(@l Ą F R/EAeIүHrQ;ڄg*3B5g3)aؔ]e↗UrPgC;[0j24xQ!6QxjUsT/Q6͒$zM_ޝ6áJz:ˇH|1N86lڵk=Hnn}F M4aƌ|2Njj*SNsδl9sxGD$IRD"H{5$IB% H ]TUfo$IuI$IQg$IuI$IQg$IuI$IQg$EJRe$Iv I$IQg$IuI$IQg$IuI$IQg$EJRTAD$IRD$I$EA[$IjYc;"I$Iթa,I$IQg$IuIRTD"JR=U}AD$IRD$I$EAD56͒7K$I-D$I$EAD6˒ʽfy$] ]taٵ]je$I``qU}d$I!@ YI "Vm{2H$fշ&9WUo){쨋_~w/vQ$I_,#;^Ka d|^k@]xc ]J~-/EkJOSb%T@rF}2͛TJ߹NGEwXqjꔷ//_WR7h;q_Xx~C̚Av8ӯl#sW|3y$|\|Y/n4+ʷfѷ#ϣwo3]{ih"P]Z/N%T~{ pc:VѸ(.9kV9`\x;Mb\MJ 2p1d7_;P^R`* Ytد(yD P[`-oO{KD$>YE3XfRv+7eh֛|;&͟ r>rWr1ϛAؘGAdz,#_:C53Lm߾w> 4ޛag]9rykw@Β)ck3.x~It91?XΦL-^6l^)lU&z7lFv!,fY7 Ӡ| oc1& 7j\?'C%v7WUw^ɕۈ$IuXG\J>׿ m0w\8ia6B[GYi<@JWC9>9,6:#ߘME_μ9l7iyH cgcsˀ²~s/^%LO1.9̏~ BO O3o0F6K^7gleQ>(`˪=7!!{Soz`ƳOkyO2 nGp婙sCw|#I{2陏sx-l͠-zgrY1=r>Ņ" y7x*~t'n" 7ǃχ8'~4&>N1 xbe nW."3Ê7>oӾ'K/N߷3>cmI>|qn &kuYRǝ_}hgpvľTP62^GC$Ztă)v=Φ&UpYKYwD'X/Ҍb9w__r^ {ey1 {_]Ǧ1USt=La$:?(mw?}&S}6&_1id//w&>Ɋ@,Mz{fqk%L2t>" y_}Icsy{"=:%H@ _ޣٿaKYlILحm+:$gk^Cc;F9Dy1j1p$y%߾ʇ8epC | ~~@]zҽy<`2{w&n:2#MHĉ[c6Ң(Z2l C |G]I*q{2hp'Lƈa)|=gi`cy }Z7$)!o_g^`N؆`]Fۃx540_ʢ 8dxgvךGt!9cX*sX?&.CpTț>c2vXNkV.K n @BbwsfҕAte&ܔW$Jp w:Kc8woi0~;pOC4?DFO(! ؼ= VsL]=I)f` ]8mRhGyAޞd:8Nk`,Mz~iH]3Y]%{Rc'z.yy!42f'o+Kbl;F\4/RѯU(33.yMi5lZ%>㭢怜0lgfed" ڲ.4ܺ &ӼAMNM>?+.vh([WFeI&omoUNM Z&&1s(SH_;P)ۭ`HAp:r;\-P\н0b,/eIz!HL(_"@L`CC+U{ vdu2kY8nnｔkLJ%>Jica (CQֱl5ψ$7!!{[Q8}-]hux)^An:ruX!-?$w1L|)_Im8?qmI~ށftlKEVq.?_̆@x?1G\B:!"ߑxp᝕$w/11pw~[R>P_ڶPa$.)HN ʋ%)viG2rBZ欝4*G7( }[q8yvy:{O.ldLIDAT9¡T~&#"٤emQyX#8j:, 2g4jHlmP$e&=ZS8-$lH0ԊÆ6׾`q5tg B&e۶\9e}`F4imKO ]Ҕ#l~h_g ЂF{|m>mW7/շQ eyg+uU|t xzMmEROE [7&aS֒  lWN$EwJbit&=?{[FF"2 䥧߄&A3(J|O0Ks~Gb摷zD 6^ͦbΖ̏X&jwڵIqCo+!E!Zz=CҮċ-ʼno8nyL~$Ly~iN_Z(VA0,>"I"r-P޷v:EgFlx\s?ð~-ݒIȞ9|ן!m Rm^dz$e`\whƜ{]S_nn8GN>XN=ڜ}t,OE_5~̻zqCY7lƎ9˞̧g (O YURmvAtƜ:$"?1c~-n)ǣpZei1Ƴ8Q:f_oI.WÝ[V|>rN?~,ǟzͥ^I+XX^>q-޿g':c#Ϗ|&_@ʬ1p z3LUĠÏ'T| +ּg1)wcĖ0vK>o?_?x~+҉ 9c1t#[Bݨ\9a$'̠Gpc5[`?aI_GٟJiK1蓹Î{͑1;:yžB<Өɓ# K$O~>u3NmK ^x}>ؾ+u}=?Ǯ$Izw3fLm#:"y<},]uY$ǟĝ&1쎻{fΜɀjbΜ9xF$*"d/{iq{o`M*Hg54ܻ`xve+F`?$^|/GH`ψY?Ϳ?ڋ/@nTA$w9^} l-VpfoZ-\9rXڝHˋjܙ^ɑ؝IuUjN[ o A$w uSW4gwp1uXi%IT{;zg_~]jQfI$/UH*N}f$IUHI}۞ "$I5QF,Z=zvQT|Wv1AD$tڕe˖hѢ.T:w\ŨV1P$I)++UVv1BFVݼ@IENDB`coq-8.20.0/doc/sphinx/_static/coqnotations.sty000066400000000000000000000064501466560755400214000ustar00rootroot00000000000000% The LaTeX generator wraps all custom spans in \DUrole{class}{contents}. That % command then checks for another command called \DUroleclass. % Most of our CSS class names have dashes, so we need ‘\csname … \endcsname’ % % \def\newcssclass#1#2{\expandafter\def\csname DUrole#1\endcsname ##1{#2}} % \RequirePackage{adjustbox} \RequirePackage{xcolor} \RequirePackage{amsmath} \definecolor{nbordercolor}{HTML}{AAAAAA} \definecolor{nbgcolor}{HTML}{EAEAEA} \definecolor{nholecolor}{HTML}{4E9A06} \newlength{\nscriptsize} \setlength{\nscriptsize}{0.8em} \newlength{\nboxsep} \setlength{\nboxsep}{2pt} \newcommand*{\scriptsmallsquarebox}[1]{% % Force width \makebox[\nscriptsize]{% % Force height and center vertically \raisebox{\dimexpr .5\nscriptsize - .5\height \relax}[\nscriptsize][0pt]{% % Cancel depth \raisebox{\depth}{#1}}}} \newcommand*{\nscriptdecoratedbox}[2][]{\adjustbox{cfbox=nbordercolor 0.5pt 0pt,bgcolor=nbgcolor}{#2}} \newcommand*{\nscriptbox}[1]{\nscriptdecoratedbox{\scriptsmallsquarebox{\textbf{#1}}}} \newcommand*{\nscript}[2]{\text{\hspace{-.5\nscriptsize}\raisebox{-#1\nscriptsize}{\nscriptbox{\small#2}}}} \newcommand*{\nsup}[1]{^{\nscript{0.15}{#1}}} \newcommand*{\nsub}[1]{_{\nscript{0.35}{#1}}} \newcommand*{\nnotation}[1]{#1} \newcommand*{\nbox}[1]{\adjustbox{cfbox=nbordercolor 0.5pt \nboxsep,bgcolor=nbgcolor}{#1}} \newcommand*{\nrepeat}[1]{\text{\nbox{#1\hspace{.5\nscriptsize}}}} \newcommand*{\nwrapper}[1]{\ensuremath{\displaystyle#1}} % https://tex.stackexchange.com/questions/310877/ \newcommand*{\nhole}[1]{\textit{\color{nholecolor}#1}} % % Make it easier to define new commands matching CSS classes \newcommand{\newcssclass}[2]{% \expandafter\def\csname DUrole#1\endcsname##1{#2} } % % https://tex.stackexchange.com/questions/490262/ \def\naltsep{} \newsavebox{\nsavedalt} \newlength{\naltvruleht} \newlength{\naltvruledp} \def\naltvrule{\smash{\vrule height\naltvruleht depth\naltvruledp}} \newcommand{\nalternative}[2]{% % First measure the contents of the box without the bar \bgroup% \def\naltsep{}% \savebox{\nsavedalt}{#1}% \setlength{\naltvruleht}{\ht\nsavedalt}% \setlength{\naltvruledp}{\dp\nsavedalt}% \addtolength{\naltvruleht}{#2}% \addtolength{\naltvruledp}{#2}% % Then redraw it with the bar \def\naltsep{\naltvrule}% #1\egroup} \newcssclass{notation-sup}{\nsup{#1}} \newcssclass{notation-sub}{\nsub{#1}} \newcssclass{notation}{\nnotation{\textbf{#1}}} \newcssclass{repeat}{\nrepeat{#1}} \newcssclass{repeat-wrapper}{\nwrapper{#1}} \newcssclass{repeat-wrapper-with-sub}{\nwrapper{#1}} \newcssclass{hole}{\nhole{#1}} \newcssclass{alternative}{\nalternative{\nbox{#1}}{0pt}} \newcssclass{alternative-block}{#1} \newcssclass{repeated-alternative}{\nalternative{#1}{\nboxsep}} \newcssclass{alternative-separator}{\quad\naltsep{}\quad} \newcssclass{prodn-table}{% \begin{savenotes} \sphinxattablestart \begin{tabulary}{\linewidth}[t]{lLLL} #1 \end{tabulary} \par \sphinxattableend \end{savenotes}} % latex puts targets 1 line below where they should be; prodn-target corrects for this \newcssclass{prodn-target}{\raisebox{\dimexpr \nscriptsize \relax}{#1}} \newcssclass{prodn-cell-nonterminal}{#1 &} \newcssclass{prodn-cell-op}{#1 &} \newcssclass{prodn-cell-production}{#1 &} \newcssclass{prodn-cell-tag}{#1\\} coq-8.20.0/doc/sphinx/_static/debugger.png000066400000000000000000002417431466560755400204160ustar00rootroot00000000000000PNG  IHDRD,sRGBgAMA a pHYseIDATx^TsS4&7&%jFA"{Q@AQ*t (X+^(,KUS{~;;3;;z<{=̙=Μ&UK$گw_dF{_|i٦}^4PX=te/u2~},4h@bTS-SMqUN dwP@@12;}ϧuޓ(t_}L{<銁Lj';^oqjwRuZV "DDDDDDDDDDDD"""""""""""Q@2>"DDDDDDDDDDD1!""""""""""e| D(c BDDDDDDDDDDD"""""""""""Q@2>"DDDDDDDDDDD5jHQƖß-ˑy?BDDDDDDDDDDDlȞ/孞>oųmmU`yQ@d'SVktLK3f__(d fb -rss&"""""""""""2.|cɒ%KQ6uI'%V5﫯J Fh[X"m{ADDDDDDDDDDٔo* 'w54 Z7жRDByOG2U&"""""""""l*Q "WxQҡH<&2[6Uw ļ>~޳gϼcǎ/MDDDDDDDDDD)F CB@$TA9rd3cF} wbڞ}ȼP+zdIsZ뾴mY}-|XZېEo(ٹxKv 8i"V{g DƎwȑy9[?-=}}?mW>!  ʏ+HB~ u0 D d[ :m"v"r|R뮙3g/FsC济8PHF D޹пziW0)ʶQٗAFhÐPe6)t5Jo/Ph]Ɨ*X"V@RD 2l7HaH2B4H@$o DbsAK>b_'Ct*Ȏ 9xDJ:@# 4nZ|ͷ땷?Ǥ|@?b BDDDDDDDDKCK>b_'&" 7(ΜY%$|+P*@?X>h8"6D"u%&;_oN6Wxt@˜aG4:uw-ES|*bq^bf BDDDDDDDDDe_-QaH}_Kd rZ4pV1^AM2" J;"e߉:I@dgy>3f`ҥK}Q 5E;@b DY"CՉ(b RE3HǡH"׿>?^CG>hs==kW"3!"""""""".QDm'*ɠ#݆"I E⋼UO,2(쓙#6;v7s̼J y[fH D ]+"""""""""JM 8i(R&GEKh=yf۷oԩSۗ;ز1!C"Z$z R0-@RyS",F Et *4p!=PѣGABNJwM6 o7r}ȼ֭ Ml@nl48`b7L@dfRYޅQJ>o8T|U@P$T",x@dڴi)l/>/_>__ 7Be[k(5ߐ_:vʏa8Q@$-a> o0,!""""""""[~кm@0$wN}\ FhG-: !'Z>?"Ö`HZ#ȷuM'چa BDDDDDDDDDDUDaH?D&i BDDDDDDDDDDDL"nDBlْT&@(@dF0$d…Ker DQD<; ?~R""""""""""dTy;vۼy?~<LQ2*Ӂ1!""""""""""JF D(c BDDDDDDDDDDD"""""""""""Q@2>"DDDDDDDDDDD1!""""""""""e| D(c BDDDDDDDDDDD"""""""""""Q@2>"DDDDDDDDDDD1!""""""""""[Cr2 @d<" 1x D@c 2@dmX^xE-ȶl"^u|[~产N=+[Av}@` %P+? ^'@Av}@HHqo1ǧ?lؿE?)^ψ^w!Žx$P? D,@dɔgĂ ^NHz( "ٍe٢"۴E-Fa2sO|ZKӧoԦCG[ƧqX'ķ 美gϙ+eCu5q[eڷ봤.:m;]^љ74kZ\u ro2utm'ߧ2O~*獕UokבQcʾ}{ŷl鯓Hw}k;ŋķD` q'J;2!eBy{.gWww@$}O[0{:|G/a "_HQ DR:f RR2U1Ni"ىHjc :t|@$0a R}$WD}c/N1'z2} b;v߲!k֮ˮV.[&e={ۉ;!p`늁HlR2]uE~{5;ab7m/!S,W,O &m"sT9b? k޽{d2hSŷlzjB]{zM)D` +WGo˵I 6jb?={=&v;vBnǞԒ]]M^oݯoIl,^Dʊ/^NpEz?׏)ng?{aA^O>5T7m.TA^}5)umH{}={W>[6_yJ#}?ޟV㻇yTyם}?i+#\*ZM^:USRey},]F`߇4/žXA_}K>aHx'}>H(r1a u@$X_I.{:1c_"'}cȷ_!v|;O2)l{=D@$ܟK"=Ry/k%=c @$ {cH-k%}O Du,ܵk Z{Y)rTvl]VHu_d؈bjroDpxJfv.}bۭ>~WM4E5ZC<^ǃ_}U*rh|qG]wݎ-g.idR)L-~qM]oN3\8d˶dspMbZ}w}KTS܉xE|< ;aev?zmL)| ߎGb>,kq7mKR؁}X'  }]VZ)a'|f{"+Q{{$x>rŽIqSǻ~1S~.~F~Hqߏ}>{ZJxx$d }Q^Mۏ~ݠ >B릸 {c;~Hqp~/>" D} "vJIHec" DJr`j}ȉ_7zƺ3+ocH")}*x׏֖jo߷?7^ b@]2].UD:ј5~^7,T{w9;0K/߷۱~%Hhw]B}RՇ߲>vd1b_Dx_vBEz{?Ix{!)?vϷ$jSD586m'v?}>c=KbD hVfܹCl `ϯ-o17w}x$+'lE$}"_#*8˕"?Le?ac"a D"˥ "GzD+o;SN~-@$^0I." Dba3a @+}W@|J} ŽFI_x띷m/chofq?mNbNh_K#=޷^~ف}o%[J7].r* {@ľbng*@.`^9rc*bз?+^sg\xŠEsYbu rni}0u.n˥H'_o_v;Wt^7_dkYlKf5Y~O{)|ۅEze!HS'Bq<$YڿG"}?Q?e^ߑ^Z?}>c=bxn.k6g M[p[~3ψ Jx~ny<y}*`{S {}DOD}}RBQJLEWHٰ1~J)qw}"'_r"_d.'^H$siӾeO$Q~H'罬;u19eHb޿U {}0@>ۿ릃/?}uv,nۇE:qjޝ3[>_tS^ߺ!z*yB|W:2l(V*ױ;1;wn=zDn*zvճ&=_o+NzXyqq3^v`DK2p黽 R?}].UD:јWOd=Pqo"Hd~]`.f>,~?- D섂}>=5{~NDV^&.[_Dz}=Q"=dϥ+QT=Rm$=Jz|gCo.KH7˕)c}V}^.^$} Nfa?7HW{I'D>/H DRDIa @l똁HXdP6GN0)@$,Qەȶ_W"a \\yb Jz|@HHq?7a"7^wg@ĴIZ ׬pB$)+%_.$I?&}aYmӡ0@rr\?Coq4/O:7t2_z~qAn);m>Pl_؇U }kܴإ*uPqܵDseq^vby iѦz`.*"h4}"~R6n(#nuy={N.6@K2_V~gs}vKP%=pv:KccpK~ϩ}֏y{ݛH;H׃x]?σ]o}W\!v赙m'[S)+RIvIѬ7ߔ w|{$ֿmTѫOWn_rv⌋o̫"t@l똁/n1)\;$o\ D"%" DLH@"{?hv]b}h~YexǽĈ}Ha*N4Il}F{`SQA[G^oZ Uowfv6R# Dkpr??d5Ol;ۻ[0nׁvv[?ϥwaֱo*7UEc,w1ޟWOdهW}ۇ0I7m'CMRvn.e륚},vɞ?y{e':Tl0lxnd'Juol;^wz0ŽOLyPѺ}GC8]Gq۷Wlxt=R})kd`{CbXm+$xnNv ^}߲!?-_.eCysacA_&Q{'"i }_#*l@_a "ec" D c RtǺ3+׃a R0F;" D01>}e"R@?JD:`FzK@L}@,=df {@` ;%X2#H&nRd "&zC(/YTዾmλ\'!e$=Df {@` 1@@i_Ho.Td~ H^)@8C*~ H^)θl@d," 1x D@c 25ٰa=@Fa 2޷"F@d<" 1x D@c 2@d<" 1x D@c 2Ȟ=e2g={o믿.L>]^z%y矗'ʸqg?~̘1Cv. |s`}]=(u>0@ ;$m 2oDl=ێٸq[N{=A># /ۦ>!k){b9,FYpEYoŷN:ۿ~l;x|-mS{w[ķd?G?/k uJI7+"ӟxdݺ`$r`$>uOY"{:5/Oێ6RО%o޷ʚW؃W=)9_VuM+[.>xD:0zȔ'ķL{0GN~T+_~:H'[.u܃ķTvpv2S؀oJə2_ =lSYM{Brs69n79Nؖ'N#mO?TX7odlPovOķ͌olj׹?r^# }H*_.|R~|QYLE#^5:le:wсkeƲղߺ"? (9" D2 0"E0"HRڵS>cٽ{؉;v $ 6l=l9[o˖-fq_?&PlԠAYS-[y뭷dڵ⻍LylSMv+_0\45W-g}59lW:nuݧ[W˗u :( ~.쭶raZɑ-^k.gYkɚwӉUCrf< _/~JF6 l$md O6KJΫeݣK>Dc @H&b @$ D0)Hb+"L>ٶm%J#K,9r|Ro蹲f@.ui&Y`؇ۉ1d}h1$ӫ"5~IuOot%=N(L&+]$m}ef{rkrtn7f4/?|T>Y߯ꉘܜe`1XO/_ C wzc98aoƁ.=hE%pѷ:&o䭷ޔ^zI쒉{.8}"/_. .ay7$>ln-/{/"Gk+^#>-roǶVbj=ޒ=Ȫ._KeǸF>C K@|t()radߔ`|`l]N^)_=W I-dS-o[1a @$0a vB"` D` U7 @#vC Drss)!Ha;K 0w bNYtC2L4I4i"njQGʈåaÆ2glmOl1l2fh9j4LdM/ctC/@zrtf;Ym#}ȶ{|˪r|n7qчCA/?%_ W6<\rG{i󗇄5%+{qˏȁZ ķL_^j-_}[V_}:X ;lj|"Db @H 0)"E1*ȪU>>D}׮]bn'$::T6h~B\m̞=[>C=4x`iޢ3RG _6Tl0bw dOɠ'mo'#͚5NjTi'r&YvyA1rdf۰+/6əTWM'aFוU]n7>%Ώߖ=i=dϔvoj˖OאïCBCr_R9VC&Z~جrpRjW[odĉb l)S7/^x~D{J6־K{T6N.Yx-iM6k`[owh[۔Fmv7־CxZ|,ܻSCwNl*Y=NyPl}04vϟW'z’5{|92}~aY:ٿi |RV5؛PwTˏ].m"c @Hc @40a @x DJHR,^H$6iR{E7|zl9[ݞ굫N}GRV*޽{7i׮<ҫty J "6cYҠa`o!=)M6T>L;ͫeuʒ#e#ȫ-]Ыm֒;T[M]6iށŽ˄䌿GOo!F֖Um*MwaߪOe{M.^*ՒowM(_n&'@ĚrƲŲoRݗLrdF+ə쏐qwˡ:6R/OqƉ}X @,X vBcnـӦMC?C1cF-ܱ]pnRWvժ..K#֯%wȾwa__>9a,i\[lv;#{{v7\#9;v1$]:pZȟW=#G,;>B}ɝ0zrtVG1y.9sS*;ir}O[ȡc>*k_+;?!mf]fʚѷˡ!prյo}{)&0"酁H@ 0(KU}bW?~FڎRo*<,Zl9[oɶ٫w>@C]/Ciڿ 3IAt)ָͤ﬚OՔuO/b&9> f?,6p?v7쑪'ŷluJU#:1wʑV͒k " D0""10Uw}W]zdΝcl(75}B75uɳ d/^,ve˖]">GzJƍCұSG ؇8@ iߡԯ__F!N2DkErrxf'9Z˰Y -.afr;֐S~1}yGgj>&Sg\k;lm}l{䌻Gz(w;fiKno\Y\\m#}bn[tRygϖˬYd̙b}WEm9[϶cM`di&aC^lv|~{U)Tm.8~L}|>Yдcbdob۵۱^?M&1$E uUvadeˤA}JKQpLȊF}Lo-eFr|#oL 9B{';e}fr(7'̷l6 l)UL#{?|1nY׻db0a @$ 1)Hb1a @#D5b?"1 Dt@>dN|gb'%{R:J>XR殾GYY9kG[KlذARYv铕+W]*.e{L`}aҮC[i߱=*·Lm.eCU56/._ {ԓUmokI~y에Iu eEk*ˁ1.ɚ>]#_%[ 6ѯynm+,L6UyD {ȳʎeerpvm3XѦ|ѧ~UY6uAN"m0a $?" DD@$(6ٽ{;b'f̘!/BFt~zj2{}e2jV7q!ׯk׊].2ydٱcS2`oҠaiӮm&& 5}2ebDne}FrW}念_*{C&pٚV˚udɽɚu b˧*d܃m\)\,G!{(U&`9%n 7gTi}xo`y,l)ndad2aM6ۻwȂ dΜ9bh4s|zۮݎﾖ7/R>oL6VI6R|s0XT$[5}W_g۱%W1$dMNJduJgRAzoM/n=K>}J%˛^-}OCF-7,߶^˾eߛ$wackҺo[" D%"%@("E1a R DNHb1*ȶm[e9bz7d~m{Ne52sQu箕!+V)SAf嗧KODg}ҨQ#i޼i:*m۵vIzd=Tm},kt}'c=k'W?XKGY`m9e` K`dߠ`rF)~Iw{},ZuU-+Ȯfêɾ~7,K]){$^#\ +\%}(T?:\'Z#gi8GC 7~+Q?+Q׿ZRuDbL_yK`cɒ%e)< rƶcuo~ѕA#Yw}ϷdM7ʦ aoA>SKv:ֳvvvݯ/gB`1cD{~[~UrƲX'eyNo"]*{@N`J34=XR2m @6S ` @$Ht0?"@"ׯ_l b'l`a>7~5Ezll/$ >엀6ґ}wɑɪ% yǮ~daeɝȮ7˾^> ,mxSY*jʑW:Y=dukdQUOFqqXU ?[o]ZqbzO~o`/_[ֳKEvvv})޸f7]um5ɺkV\s_ߣGW_acbvlv;?qQf=TS6W @ 3$x lYA7ٵ]|F?|z[A%G:tl/-Z6/V>KvmcǎgnݧE3]C&^ ^卮]rMroʁnOo9W|1_ Koi%,{\EL*PYXNr{XX὏gkɁ!UȋkeI"p*}+J` rǡ*Hze߾}E~''v{or^ton'k. n"kWU]%j]?G_ʖ esGmnnǂ-RQ|}f{94x,5{gKkdMr(7'̷l=D O Oy 94*Yӭdb0a @H)" D|"` @$&R|2o<G.TȡCرcb;1{nٱcG6H8p@9"-0[wrJKc*MwK^=MҬESMk,eBZn!=!m o^~cYX^He}_Q^,)D[+AQ>PN=|-eE;wӁpPbӛ6ڞWI;$'xCNj&&F a^'^/9.]-_$:}*K?6wk% rtrs9B[9;oɾˡGˋC_+??Tњ8qٳ~͝;Gm9vIՓWW7U z*~|voYuUEm9˶c۵۱۵Օdi{ (ю{vfdg[z{Ԑ5 .6g./o^/Kq1" D0a @0"` "؇ƾꫲfHN ٠"_}/b?I?.m۶ɪU,^Xx K=Ұsgh#uҬy3P7i٪4mvWF vRn]iԸ iޢtlR~dڿa,k|l{؉})-ȔvR܉ܽ]DΗɑʖɾu+wӁpWI_ A`A3ŷt}hu|֢r>nGΗʁvHn|/C]M.*K|,}k Gz {N?D?3!r[?QReq]Oȴid۶~oڵk_9sf}ݖҎ]]~&ھ; ˧W]Ken?-_)Wl-gvlv;v "{ ([Ѯ{.o!݃}[U8W=M|D;̐ew'Q prUŷM1?@" D0a ( DD$G Df̘!˖-%KHl`b'mv ,w-Z$6 2eSihժ4iD:u(͚7&ՠa}S,YXV\!Փ o!7m";u_l0e rhmbNhvSWˁ|)|Zג۫%k%mwwʡ>$r%Jn[GeK\"9ܷ EHqP5 ~B3u[~֭b۱~ E+nyJWNw,}آ_&azۮݎKWCF>lDG}ْXOWɁ߽ŷ.63=ŷQw ~v$ke-"m"c @" D0a ` Db @"&LH'R ^F-T&Mz^4h 75_%ln#v m&we-g6Y6xr(t7`:.oNj_$('>W5"9ۃ C:ZPLGn!`'? m#'k7 yy%cX](;\&FV-6SٷǽC ;^*mG91xV[Ixqh轨`m]2q׮]bKmgݺsω~_|!c_KCۮNǐ 9ɤkʴ?VUٿFs|l=NvogeMwSY#lP7DCWM.-ko[`E;e{K~JYY4(| D0a @H"@ďHQ D Jm R-b^K;򗿔.H*W,jՒ͛ݟG}T'O> 2AI߾}GyDz!ݻw]J.].]UZu=ꫯ :lѰQW~ZhU]֯϶kcϋ/N߶RduZr.1Q܉5V7!rɣ3-C̿tm# `m沢ْ۹jaZ_(++%5ێ6RɎ⚗˂;ɍgz?Vy[嶹PV+ZxEWw.ez7t]R]}ع;Pw/en붜g۱_/WWέ(3Ͽ9~suF1l9[`;}>T-+W/}Ne *Z=| |3m#̑U:ˡN5p|rYV&W=/M':mgs" D0a @" @ďHQ D lH:unzb_J.T؉MJNO< 8Pl02`ݻS܁Gǎ]vҦMiѢԪU[Siѝ5k`vZm'6m(6ڸq|&.UNm~xp=_Vwo"n?[9n)8[,YեˉX}zrERp¿@Ӱ|HeÀ@$񹲴¯dc%NH-29n9Em6澰Q  vrE=mWCɁf˧7Q|1TϗYfaddԩb&L(biӦ"ۮݎ{fw#_|l,qv2bY7Ƣ\z{ 2;n/v}),G9>xPmBC ޏ?m#B׼F>Ok#]|˛.[=WX:Wum=" DN[*c "0a @H)a rb D@r@}Rb'Vv >z!6v^z @u&:t Kr] ؉ܜf&0r%y♲_Wm#l~IYPa/$u;.mC-<7]XsH| ۰zu Zg+s˂>&{|>|ٲeb:t7_/=X̙3[֮]#~9bK7u[ֳ$kb~;Yn,~@o 27dacϨ$"OIl=δ}nn7" wncXR`U3e}7F6ط~,kRM_s,m\M_-u3=]u%@$0@H&c " D0I"a @"a_\})BJ2o<=Ґs@D $l0bgV+W :-o 'o;w=(2vb=( *'t{KeΐE.H~>_ _]G8E?A^},MӦMO>DfΜ)/ؠ!W~[|<^zI V}ݷN*/߽{ vI ɬAcdT2__Ā?_zrvlv;vv?C w *!]H>" D2@H4$RO D] N/Y8{ e. b'lPgnٵk Pm}^\zbe',X rK.C47[].[ =bH}ݖl;@'d4"a/nJ} P@d<" 1x D@c 2@d<" 1x D@c 2@d<" 1xD֭[VyqyqyqyqyqyqyqyqyqyqyqyqyqyqyqyqyqyqyqyFN=WY^;DV]!u@jp D"` @r DsL~FʄJɷol""?w@$uKw/ɞOJ+߶|-T."fΚ)u@ly| DH?/CgՕ}_G֜aJ|Bmˇ;c @pY?Yv؇WyX~9Tm$Sf߶N;0 4)3l?<@6|@Vx\OYVY&v>}߸\{MR=2tR@dEPϞr57J;' kWKRbeyOӠUS^:U!U$W 9ַ}7-!={e˖w0a @qyGDV^,ݟ$+v<"-{>#vV^)ָSlOȒ%mb76ԨYS>,]Xw,=$r"w[K.\ ~X- >] +,gƏUV Vlǂb۽{֓5kVI@y"E0dwޑ1SkKf{ɳsʺ=]e2wm{ytJ Ynۙ:}؉~tRz-q S}ܵʕŶ[o-w5׉{ *w 2xP}_v^ ĖA}KŖxb˙&;0"L;2f 2tF+;t{p,^1O|,9lk#Y3=%fȨ1cNۇ}|)< ~ޝg=+'}ڛ*}߸pv{F]Z˖3ώ/Ýw0a " Dĝw@䍏'Ii-d[j2閦doZ]fad{+A f45YΘ!;0"L;~ ާJ*KGkkɇȘwkȇknh}>|hn0Xr{ K,:Ja@ Dl;]S?؇ϛ<3~4kZ] ڝwIrcYtt{a׬SW֬Y%ox" D w?yIN(>S欪-o!sWבwWޝؠW[6Nޓz57$[<@@Ķx"rk;.UұK=])|_B51}*6ZvRz  a $#c"fҹbKkk櫒y`Mŷmy"dwޑql"7<1L_E^^6J2nH/2;؁YvYTAF}<0&Yrҋ;` @;2~ :i<p- ғ;` @;n 2;` 2;` 2;hժ0Ýw0ǝwnZ;;;;;;;;;;;J} rρ2{m2;` {m2;` {m2;` {m2;8s$@dw;9 $ \QVy D|M@ra "v@d," 5iD@d; @d<" 1/as(UE4QD#/im# FDDDDD);n(@w l͎\DDDDDDߌ" D|@iEDDDDD);n(@w l͎\DDDDDDߌ" D|@?Fƞ)e]I7} ?AԮ$^l+eNd%]xa=%u2ɔze[&=߯Lz^-x_ ?QO&o"e }ߕN:J7'A*64"@$> D@! Dˎ\""""ߌ" D|@` .%S+_#߲_NH|0/ F$Ӯ-'v߲!ٚ?2 """"g E48R@$%1I."a "a ]vŞ7fHȐ! t:'f<'c*}*cs9snLXDb'G!eit˹b;i[DQNj=lP4KF l+& DRҤ62'2f{ķ @$2> D@$Bj2a\ -+R׿drg˩*+W͛7K@(7';0e @$ D@$1c ` R+R DȎ|3h@K"GӀ >n<.lذaىmm"0I/@d ^7#VL#duy=Ļl!ՔqJ d mdoٌH?"8DNRԿY|˄dkvTn䬳Β ȟgׯj Dbώ|3h0qb @$6 DP2@$fH1!""""";n(@ib'\XJ|iɘ;5aw2j8lPpB8t;ցHje׆^TTFol3e2G1k`ԇŷn," D 96Ju`gd0[.Ϸ"]%cn$.[*#>f`ݐo= Zn^_c. {na? @wc?!'?%e uiynp#yŻo ϷGyQ9CuN`gR 5)uL+ww_&wS]sLJyz 6nA]l'0} t&ցH/VcVűxzfgdJ2~qM|gXH?ןH瞾O& p?zyᾪ2=xB]?QdR`Ud嗈ǽE|ۈEYS~GZ/[?RҎ;&ח_J|A&n{zOS/)?OT"gyԨQC!;n(@ĉH0_0a  b @H<$7;~p1@1;n(@ĩr^G91,X+#WLQ˟;o'# \Yc:ϖQ/M?? bz?jRp>ΨUsKXǪ؁H1僯l9q"}:Il="F_jt7e@ُae|!['&hOȕ0Ҩ؀bB|{]Ntu2v2zbdSeܛ]dTn?c6 ϵw};!=2vUo/8a&ցH/QdV_Y?~xlcx_c6xK`+wD=622x/:_{߲{ekvr{Vn]Z:tH>s9%%{19s|b3F"@(7'"a Db@Ha DsB8^ D0)9"͎\n D1!"""l̎|3h0qQo('pͯW]`^[ntľoHlQ+'\D3e7ȷ)JI ͝@]JpN~Q(}R}"^}(M􇪏؉;;.7vc25t};ܰ&~ .~8C턴t?`"SҁH_;)W֏Ab?fS?q Dx_K:?D|uC&]]?Ͽ D&%eJC0gwl͎\n3f _M6b7?.a}O.\(n<\r%RҞx ]D*Q""""l̎|3h!f bف)"` @0" D9!/" Df.7"DDDDDdqoF]t D,>{.Upbˏ5jT)rۡe@$M{#cYfxߎ.d߫e6J(EQD"\2+׏;Kb9?R1DEǀ}ߌ麰 n' }˞H oDv5PzB<;LL2qof.cc=&Q\I"@_Y?+nK+=xqO'yG?[?@d⨦~?Y}CO?/^,6@8z-[Ll9}}Ν[o/~ q{w媫b5ժUH1!""""=;n(qg]t[S"{@$1 "1a H'@$ }" DJHf.7"DDDDDdqoF3.-i D,[rG˘;qB^WNC˦;o'*#]ڥ8е3v2nz{rv)*uc'#].7vhG_%ý}۳/%u}0WmqRM Y%]?@$‡ [\ _ʩ*fHx/׿U~Ȕ)SľnKn6Աc};7f>TP"" Dg  D0){ DN?e E48ى1wϓQ vy`؉ZB)Q 3@Fz]s u!a[~̍ egdžo܁ ^!#w ZDS" DF+~ mq"RV;066ho>om zR{]? ]$!vI!/n b9X4"?RK] /t w%]m%ɘob}LY?)oIk]D/T&.Ieˍ;D >ƫ$q{X]qDzog@.7a| -+R~" DR gH1)""""7F D| H~򓟈oى^dnQ:|-0ޏe.5E2ޱ2§bĻn܁HqFM.VIvsd uO}oێ;1F&c.X&v~Ջe']/V@@(ސX_?@> HԤW`bB"~ qݮ{>} 2vi/y2- CL|Lrܪ؇({Bֳv / D@^^^]uLx؉rw}׳s=vI ?D+h*]>篬-r'P0(PF:7z|Xmmo=~tt)-^?QDFo$Ӯ w.[6$[WW}:KN9KeҤIv[g?38C:w,+nƍD[n@dΜ9bÎct"@1;n(@ĉH0_H D~H\"I@$)"Ec BDDDD٘7fHKfw A^sWw 42~j;-iR;owla52ekv""""""7f` ;H D(S DHt񃋈(RvQD @ɌzEKy~z%lmJn܌aۋ]O\.cDdkv""""""7f Cw d@` 5;~pEʎ|3h0q(eLa>>2r06%6jS2[MƋ]/6Mf."""""HqoF "NT%@񃋈(RvQD (-ٚ?"e E48RҒ񃋈(RvQD%=;~pEʎ|3h0!""""g."""""HqoF "DDDDDEDDDDD);n(@?"e E4QҳQ7"""""Jzv""""""7f` BDDDDDIώ\DDDDDDߌ" D(񃋈(RvQD#"g+_GgV/u}(񃋈(RvQD%=;~pEʎ|3h@zj2w9||чXƏ/mFDDDDDώ\DDDDDDߌ"M4"DDDDDEDDDDD);n(vvmҤ}[0"""""J~v""""""7fHKfQg."""""HqoF?~L8 9r-?"e E4QҳQ7F D7o&7p|W[0"""""J~v""""""7f` BDDDDDIώ\DDDDDDߌ"i?yr饗ʁŷ%?;~pEʎ|3h0!""""g."""""HqoF|H,X ?dIFanvbBd"""J^v""""""7f` d'F Hv!""e."""""HqoF;jH֭ŷLanvb4ց-gh3δ=dgϋޮ<&0G[!d9yu[7-:~~?SWi0HlGWo)|!}6n\.WR= Nz"*;<)vzoO=凧"R'eёo*'KoDh;?>Yκ,^Hq\x[&(y񃋈(RvQDe "a DQe."""""HqoF|W]2ki[07;1@%V"\(=$ۍnwWmͽdŸ[]?V6_A;GWK(?!? bvιg=+ %n>X8T)V 2D&dcpkǫ뼮|W>P,=jo@䞁I'T"l/DDDj1B|CG}$eNY?'"J7';@$6 D$""ˎ\VYb}g}-s"X(Uߌ"i;yG}޽qe=)αg?j@?[vO"\3@5$6Ȱ~ab_o0)ľ>x;4-ցHq,5P_w_Ws_ڮ:[&QQ7';1@$6 D@$5QQ7FD]2kɒrKŷNanvb"G~!v,ێk̑abkȿRdn M}n}a! o?-g_y*gz@+CrCXe_i~i;Rs֣DDDDEDDDDD);n(@N2 0"鉈?"e E4~ ӧ\q[07;1H 7yk^k볾oa}ODD7f` d'VĆ@(}WU'XY}˜~"'"J7F Dn" 6˗ɱcGe%rHŷj"Ϭ/գoQGݎ-dށ2gb7@/ԍ=eۤ}G"|0L~pa?+uwD{tp=!-&eC!浧ܑybH؇7Rz.&w"qW+7!He=>wotɅ^(e?"e E48ىQ"a @40!""ʼEDDDDD);n(62iR\9(gyiF>,mf'F݁Hq>l`5~ іgJ:!I`J?~$إ?ێ;1^W5;]~`5]/V/<)M>)؇W6Dؿr @lHcߔ/쿾t YoDhZM?:Y~}ٯ뼮[7e^v""""""7f` d'FĆHb BDDy񃋈(RvQD#m"we,5,exQQ7'IR="H"""J^v""""""7f` ;IvPeEDDDˎ\DDDDDDߌ" D|'IQv (y񃋈(RvQD$) O+ķlaa%e&%/;~pEʎ|3h0q$E1AY ""e."""""HqoF "N%/;~pEʎ|3h0q$(y񃋈(RvQD$)Jegv""""""7f` ;H@̎\DDDDDDߌ" D|(=񃋈(RvQD 3;~pEʎ|3h0qhrR˓x2I鲻.co;{oy:,xOwRT}-Cٙ?"e E4*T Dl?! 0Nd'EDDDDD);n(as"l;! utM~#ŷuA $g?Dٙ?"e E48R:&l}g (;Q7FD?&'?q>!~e{9i[_7ig??2FJ.Uķ̉Yla3-}.@$5$3;~peZ5jԐN KGBDDDDDd E48RYc ĎH޿0I D(+b BDDDD7FDu*^{0I,"@} 29gJw:oE_H%ķL& @?nMt"DDDDDT|vQD , 1"@1a R DRJFvʖ<;n(ŋIrdʔHؐCC ~*v>Uw >8Xl[z^q*TY v"V?>Yκ,^ppc\qb'tO;4Ԯ9;+`?X7p7N#j/ҩS'-?ϥI&?IJ#;n(@w^b=!@H*` rb DHNJHQ~Svʖ<;n(vR.R7oL6U]1 9NىKG/pķdVy]?4| {v/W؉^z_Ro'~_#.wC-r G ]ŷXwK[ND|On{6x/9cϷm1 D(+[w ҺukX"_fƍvZ9}#@DDDDTqoF "NTb D"a D0) " D({W@qoF]Fw?>.9uZC9HO.m#Svt|=h"uɬ;f/[=%m]iaCrr\Rx%e x?`_RV<@m$ D"^2+.炙X߿UR+[w hZ~kN܁W_}%wC,ߌ" D|e'0a @$Q0a |%(;W@qoF'S/el Qwn]eCʍ)'D؇ZJx珊|資ķl"u؉ː}C粞rg;]/ *_ > ~L->N.Yb'}ˤtT낟/~ ;BN٩[6]I Dм{wN|$֯Jķ /lGIeϲB񃋈(RvQD$C6c "Hg*v){ozo-)'?<_X*$Ï6NhV\EN?t9?OL$myngߓoOxJnz_ʙ)֖Ҿmg۟'d9{]ķn:+2OgI-ߛ\7:S9Αӫ9| r?`cv""""""7fh֬Y^۶mXOJH}B" D0a B?"e E4瞼VZ@NO>Y~ɐ!ŷ[b'|Vib3zpZKZCjoTV'4O;=x^إ[}( |1@|&B n{BuN,vUJg z,!5z6bajf{m3e$QR'URҁ/zB<{.w̺Cl=t̎\DDDDDDߌ"v[M2 X1OYׇh1o'VeG@H<EΎ\DDDDDDߌ"Uo5I&3q9rX^y9Se„[0'%@8av2HvBN(or+9'}WO H\gX)UWolVZ??&[L}(L{u R}Fuq_eZ٫ľN񃋈(RvQDjӿq1)] Db@$>euB<]Ϗ矁HX= DR7;~pEʎ|3hԪU+u;qh\jԸ]|V<g-+rg?:Yl;U(m$eNhڇIwt.g2t~NT??Y:3߯6#/F^&ut̎\DDDDDDߌ"-[k۶-I0 dc @" 񃋈(RvQD#4 ɨHhb[0'02orNt߲!am97_ QfK~u{k2$[/??VV$n'񃋈(RvQDS` +") =NHb J@(uQ7F Dv)X֬Y-3gΔT4ym0'k]+UT2!v|;bktKvicI9Riym04Ŕ5ŷL&qW@eȾ!sYOϝF:J՟dK??M~d B9;~pEʎ|3h0q*|` R2 Dj'ēHX= D+?͎\DDDDDDߌ"i31G?_~ȑ#ŷ[FgT.eC #q|ܡd ];ysrOr5IqRok?i<0p@-l rp__k:MgcOG/ϟ?s9I'tJS]eSv""""""7f` T@d$Fg ?x"D?g>,+_e`nj"A"& HNJHN(Q$"Asjr"oYSu>ӵӵ_k/ه&97vmw ^WoVkvz-}|Gc$IA QeMrn(ڴkF"vA/ ne!/2&97vm!ZkmJڔHmϕj$I9r~(hsCmG& B"$IR?QeMrn(d!R]d$I`< I E,D $IG9?4ɹhHvA$(2&97vm).2H$s0P$ڎM"EIkNWoYjSҠ(2&97vm).RHjWm1j58վA QeMrn(d!R]Ԯڒc$.kp}OI PQBPH!]%H]$T%D9?4ɹhHvȗ?-Q협瓦T[rLN;v̔jkw̵aՎ=.AC@j;6Yj)!4-9d!6վ!?E0r~(hsCmG& B"D9E%H]$e!21}OMU-D9?4ɹhHvb"悜Ƣڒc$.ײվ&b~ PQi.Dvao~S4묳F_;uEX r_ݗ9_;gT;f"[<]ψnQ1S=?o{8[kz-9FR"y ն;=硿Fc&rD֧F[Q jғO?~s'EۨS_ۮwGQGGwDT{씺 (2&97vm).RL\k^Y,De!ҟۮg!/2&97vmw ]v9z_x ~՞cJ15Nw>=7s/˨V[ryS"ޅȦ1?oݣ?^qoto~Y]w/?=9m?e]՞cJ]AC@j;6Yj)&b.ȵkz/YyS"mhYC@j;6蠃jnjR"Ōh՟4L4컗~7z"ofm-%[FT^؛.^~ z/x-nQlNܛys4Do7FYT{l/ b7|¯\M輭΋j^] s/=wT;b}J~V4d_:&ӕFyk9gRT.D>㣶rQ^/D=ttEo[7Q۟]zÃ_ltE+|用^HDxT~~}^21q8.*k[~ QeMrn(d!R]\_~",D,D_ 6D9?4ɹhӸY\~eQ.DZh믋nhVZi\SW]^|sw}}X]e\&z_`ɟYaxoF{ݻWml;⃢sjK)]vž|LT^8?;Z ]pQCO)9^.D\;h~՞c4վ!?x5E㎈jc0r~(hsCmG& B"E?ܴ,DBdڏ{",D` I EBoB!**;ʏj)8k(_^-9v!O_8,*/룱ZY7==sQKǟs=_r!R2kэw>}Cc4վ!?x{F/hzou0r~(hsCmG& B"E?ܴ,DBdڏ{",D` I EB'^WD!QyAۿ[T~TH Gykzo壿sFcw~?*ߌ7<[kKEZ]1z˖9-M3=Qc%ǔ.D](M-VއՎ||3<'*:һcJYB$[xGi͏FZ{wڏ{~.jc0r~(hsCmG& B"E?ܴ,D i?YL~߳#2&97vm7 l5׈oިMտ/D瘺R"E?\ g4ߪEL% l4?E=߷.V8{vvy%/yID?Ѧ'l r_=Q^[gE޾ky[Em\T>~F#~}7*;wGE{oQy\z>z E?b􉯟ՎR;W94Z;D`iZ|f\l?E_9>WEgtM w[~TRW߿M;>~fGvt,G'hID:Wѥ^՞-^zv̔`P$ڎM"E~9 BBd$YL"ӓ4 I EB{VZih9^WGwq{T{+.R̈z\QzY_9kT>{/zof~Q^ Gm/-bl-ʿ?/ǯ\>\7Eoxըѕ_ݶmQ)_/љ;ՎE޳{1(=`4kT.DL(/}Qrp 㯋y(w̵Qyw 7cL.@qM ,*Po~GꤨY.DJ?lt)}aӢsԔj-;q~ 5BPQBPH1#rAn( d!b!2,DHo r~(hsCmGѦquE i;Fy 8ۋr1j58O]J32D9?4ɹhHvBYhR3U;uc5EeMrn(d!R]OY,DAC@j;6YjsBd|d! PQiW,DW"xBd|e! PQi 7B䬳Ό>G>[4sF.믋j1uY!zxK~mtĹG"s/=w4L3nѨ0(r~(hsCmG& ByBddYL_" I EBo{[o.hYf_~SW \+wpI;F[Q.Oui]K+ZlŢ1GeMrn(d!R "B]" I EBd7EM u]7=ԕ~nӟ-zfYv~7oGO}n艕.we[F7o('gn;NT>> |uF/eQrk׊qo-ъ?Z19̖D_Q]5ZtEWUl-FܶKT>~Y"2&97vmZy" e!26YB9?4ɹhfm5\ ox| sL]闗o/GTx]kχv[ Q.2~q7(/v|htIkG?mWn=n;DYӬu)MB0zowo1z'-Qf! PQ) "Bdli0(r~(hsCmGѦqYdE׾ѕW^'G/{ˢ 6 =ԕfQ.nQ^sE,)(]={QӻwzpF-;sT;fJe! Fcjv!ˤ]\myԏz4+gʏ6 `PP$ڎM" B]" I EB$o/Eq /p4GJ\(wmp}\Q|M~_[E{<{}]5Q"+/E3Q"'1F9߈m޾k41,DAC@j;6Y,D& vY"2&97vm7 n> M Z(zի^/+团?+g%Dyi!2:{7|SMF0yt2Qwq_ƺ^|QZXgwlT~|'L\|Q~mԏ,DAC@j;6Y,D& vY"2&97vm7 뿢MO:(T}Wj1u0}+DHlE}9*oE =-G]~W+Y_^\%uS׋yۢݶcTޒ+kZwZQwNG?GQyXBd޺[n)7C忾2*">˾7ߍvmh_}Ǘ9zjLB9?4ɹhH!/L[6  P$ڎMn!rEK/tW2zk^w՞cJ3_FyKvqߴM곳EY_([e[b]Q.TQ> U;=G|qWly7G4?Ey,QB$$=?WѬ5z2hvDl=|,/-7)Z߉jh'2&97vm)Ԗ#v|Ff!b!Џr~(hsCmGѦqyǣw:sѹbd}j5uڒc$.u!ŗ!pg#xݣs& I E,D %H]$YXPQi,Dhf>Fx{Gǎe\>3h'2&97vm)X e!2h'2&97vm k:*˅ƨxY)"?Xt˺_/\ݲы>ݲ&Q^Vڷ/O|=z G{hoF_~o.%^F~wǨ|G)d=_]t}1E~e˨|Xuߢ%;h'2&97vm)X e!2h'2&97vm7 |SwѺo׿>ksM])"O]cz]F}Q^NGϏh{h"õ_>OFǗ\qhO~6*?>Zjբ] :ۣڱ vr~(hsCmG& H,DNeMrn(4n"-BFoyD瘺R.DzuQ.>=?{}& 㿾(D|_.GD/ѯ/9z/B?Ez4lGy˲|$*VkQ[~M=/.6;=NeMrn(d!RBdtNeMrn(4"õF1SWB[DuG>rاWZ Qy|ã|1S7,~)-E:ۋh'2&97vm)XXLOC@j;6{|Iw~QBSOj1u^/Dv:h6Ԭ/{^'/~tQ)k%ѷUt9:KBdÏrooe,ʹhйjC4B/Rs8_Ƣj;6Y6HZr{D:^#뜗K|rn(d!t.燲# j.$yT/Η(ڎM"@r~( =ҠŠ\@*˯SK|qEzvm:CYmr^T/C9_z[E,DPVzA-ϋŕASˡje(Ko׳hйjC4yQ2H~y9Rmr |mzvm:CYmr^弜Y/-_ڎM"@r~( ='?}oFLi}-*վ-ϋomo?ƺ}/ õGs^弜!Dc{x[Ծ)Ko׳hйjCO?f!.vqeo?: r(Ys |mzvm:CYmǚ"/Xty3:3gq"mM!]~iꫢcƢa«y9r,D9_r|=k;6Y6c"2}*y]K.(*g Zzy>Pe>mGvj7->0|:g'h׈_xh|&ϑ=2u]\nM4BDz~SjχW^ qDFNFzzaOY=?Ï<" <1?yO'Ey9rڞcu^tPO'S:?D8_uΗޖgmG& s9?Ն~BBdJ W+]BRf!b!,D9_r|=k;6Y6co|["K|[2:3֒DB$/<.+ӹї64ʏu-|}tgsN?5mݣ|^=\0#wQG.rdz\ڶGr!rG9:(A?׿MbGя(>m_r(64ʏ׿Y,"-ϋŕ[nG ,XtyJ.$ Õ*zem),y\^-;3<{Ey{sQ^ y9m-D/?-C?(ʏᅢ#-6vXɚn4Ǘ_G.BMZsVZu(ަ[fEnկkSy^.. uםmM:@Ƣa3N~Y'//NwMir^弜˱>/Fzˬ8|mzH:CYm,D,Dnz_צ]\e.$,D,DH=PΗޖg;4 s9?Ն~lp  $g<.-ާ~jZo('|l|zhϟʿzE"E'|bZ#r!ϷEymB"oar!3_|"v:_" HwyGT{Lc]/D??ϣ<6 ~Xw\{:(4ϊ ?rrƙGy˫sΊ/|mzvm:CYm,D,DuO |-ϋŕ^ﾨ_. eXW^x=~WT>OEC6sAx>я3#p<#{ͧ;(/>5sC9/mH6Vᓏ~?ytNqtYQB\eץmy^.2W""r,D9_r|=k;6Y6HmSEϷ@tιgGsy^tӍnj~y9rڦܮjJȅGA2YQB\eGjB4|ˡf!R2YQB\eGvu(oU[i孫r!_j5o|P?j˼u)"$;Sc)P~|=k;6Y6H`)P~^Z2Ԡ/._ڎM"@r~( =RvYgFeh%_dS/Q{Cy^p꧜C yyAG{WN:ĨA2Ԡ/._ڎM"@r~( =Rf!2~y9Ԡ"r 5K׳hйjC4yq t~>r^T/C9_z[E,DPVzA-ϋŕASˡje(Ko׳hйjC4yqu t~>r^T/C9_z[E,DPVzA-ϋŕASˡje(Ko׳hйjC4yqWt~>r^T/C9_z[E,DPVzA-ϋŕASˡje(Ko׳hйjC4yqW t~>r^T/C9_z[E,DPVzA-ϋŕASˡje(Ko׳hйjC4yqUWt~>r^T/C9_z[E,DPVzA-ϋŕASˡje(Ko׳hйjC4yq啗t~>r^T/C9_z[E,DPVzA-ϋŕASˡje(Ko׳hйjC4yq t~>r^T/C9_z[E,DPVzA-ϋŕASˡje(Ko׳hйjC4t%\]~%\P{s^:/>e,ʹhйjC4B/Rs8_Ƣj;6Y6Hgwџ|^teL̯ΈjuK|qE97vm:CYm5\HRt^}XsCmG& s9?ՆiP :"gG{ >uQH:Rs8_Ƣj;6Y6H I.$r^:/>e,ʹhйjC$I$M)ڎM"@r~( =$I4j;6Y6Oq$I_PQB\eg$.rJRj?S$IRsCmG& s9?ՆT)ImL$IU E,DPVzFR"$3E$W97vm:C]䔤6~Hhй^V)ImL$IYmG& sS3S$ڎM"@r~(hsCmG& s9?4ɹhйPQB\eMrn(d!t.2&97vm:C@j;6Y I E,DP$ڎM"@r~(hsCmG& s9?4ɹhйPQiM6,DP$ڎM+Rd!t&2&97vm:C@j;6Y I E\sBLeMrn(d!t.2&97vm:C@j;6Y I E,DP$ڎM"@r~(hsCmG& s9?4ɹhйPQB\eMrn(d!t.2&97vm:C@j;6Y I E,DP$ڎM"@r~(hsCmG& s9?4ɹhйPQB\eMrn(d!t.2&97vm:C@j;6Y I E,DP$ڎM"@r~(hsCmG& s9?Q7~G]_Đ_!:҃IG۝]@rn(d!t.2,D,DK E,DPFȴ.M)z碱vDу}097vm:Cu"ӲL97vm:CYiCff)[FGnN=h褛NƊȴQ'}2Zգ9v#z_}Dm}OD{@7rn(d!t.燲 iY j;6Ycf'nr!rDw=~WͲ,)7Ȑk׹3n=#&'l'&=:)  g?-|ȹhйڲL"-ڎM"@r~(kk o:9Cj{Q*">pmTZu%gɨ3ODya ! _Ǟ~,*Sͽ+w~e+D?pTZ者}.'*m}-n{h_,ͶlQ.V;jh߯.+%_Tpι(aϿ|k?*G / j;6Y-    `PQB\emt!Fy/;8 WwE;DBdߋyΨ?x(oD=Q.VJyݏ^]~ѽ7ZGw!X9K޲;<i"b8w?qw~y~TE?pnx('z> j[U} 0PQB\emYXXX'ڎM"@r~(kk \4U.D%ۼ$[5=Q>>/K$jZotDMB$.">B\\ߧ~[}+:ã{Gcir7E۝]o'MN] E,DP֖ȴ,DB`|˹hйBdY* m]w~Qy[[3G)/t}Q/O?tFK|'}2*ŏB|S\85[fuMn~hr!2~E"DsCmG& s9?e!2- : %ڎM"@r~(kk ezǬ-?KF鑧y ʅH-h]Jy~Qi6ʅHyˬUT[f7uoǿzWG\r@TI'<Mc%T}(T}Sy`˹hйڲH]o!01PQiU>Y.DVI3o?s孩hswRB$oŔuY?+G93-=cQ)z.VJ Wwet_BnVyO=囹=*")_G>IgF8{4 ׎r!0{hң([e5-LJjhv.Y#?tI / j;6mᆑЙڲO Erb!t&燲FI'xB4Fs4G0 T.D|".xQ\困/+"*Bd?lhbWD+R&=z[ϓ ||H>~_,ͶlQ.JV?jh6Z.2޸^x.jog.prt+R.^˫ȹhйڲ<97vm:C*GpQWV<|K'mm{ʹhй,DB E,DPF:C/;8[s{ќ;]uUj;6Yd!@?ȹhйO{tgD{G?&j;6YsCmG& s9?5~13<]{L3tM0PQB\eM,Dj;6Yj}򓟌J0PQB\eM,Dj;6YFzի5VS?L<97vm:CYBH97vm:CYO^җF{oT:S%wG E,DPVR E,DPVZwu%\2j /D}k=3&j;6Yd!j;6Y I E,DP$ڎM"@r~(hsCmG& s9?4ɹhйPQB\eMrn(d!t.2&97vm:C@j;6Y I E,DP$ڎM"@r~(hsCmG& s9?4ɹhйPQB\eMrn(d!t.2&97vm:C@j;6Y I E,DP$ڎM"@r~(hsCmG& s9?4ɹhйPQB\eMrn(d!t.2&97vm:C@j;6Y I E,DP$ڎM"@r~(hsCmG& s9?4ɹhйPQB\eMrn(d!t.2&97vm:C@j;6Y I E,DP$ڎM"@r~(hsCmG& s9?4ɹhйPQB\eMrn(d!t.2&97vm:C@j;6Y I E,DP$ڎM"@r~(hsCmG& s9?4ɹhйPQB\eMrn(d!t.2oh+D]zP46?ihV E,DPFH`ɹhйʨEw_i7EϽ\4yջ:zFt#ڎM"@r~(BdZ")ڎM"@r~(+-{ȲL4w~[o>}oE_}xy(w"Mnzh `˹hйڲH]~[o97vm:CY[#],?KEy῭ ./79Oyk||(/;*]|Q>矎h"siOF|^o &cuˬTmQ.DoBrn(d!t.燲,De!Rg!0PQB\emt!2ַZ%g(=#Q>>oA5Rieֱ͵\Q)?=*mtFQ)o*uuˬY~MWKJ_9i<<|䛜i䛪u^/囪oyʖ5\Lt97vm:CY["Ӳ-D&j;6Y.DVI3o?s孩hswRB$oŔuY?+G93-=cQ)z.VJ Wwet_BnVyO=囹=*")_G>IgF8{4 ׎r!0{hң([e5-LJjhv.Y#?tI / j;6Y-    `PQB\emt!Nh}i?`t]D\dE\$:&xM)7a_EWwETʅ"7~NV:bMo{('8:~/GM |X"m٢\~цm\dq7FϽ\$ >?\"Vd\jWEyK+sCmG& s9?e!b!b!0xrn(d!t.2ƧU\%xсOYЅj;6YtD_vp:s9w3" 97vm:CB~sCmG& s9?џyh߭{#ʅ j;6JЙO"j;6mᆑЙPQB\eMrn(d!t.2&97vm:C@j;6Y I EV^yBLeMrn(:C@j;6Y I E,DP$ڎM"@r~(hsCmG& s9?4ɹhйPQB\eMrn(d!t.2&97vm:C@j;6Y I E,DP$ڎM"@r~(hsCmG& s9?4ɹhйPQB\eMrn(d!t.2&97vm:C@j;6Y I E,DP$ڎM"@r~(hsCmG& s9?4ɹhйPQB\eMrn(/9:C@j;6BLeMrn(d!t.2&97vm:C@j;6Y I E,DP$ڎM"@r~(hsCmG& s9?4ɹhйPQB\eMrn(d!t.2&97vm:C@j;6Y I E,DP$ڎM"@r~(hsCmG& s9?4ɹhйPQB\eMrn(d!t.2&97vmBD$I$I$i(d!"I$I$IMEz$I$I$I,D$I$I$I҄BD$I$I$M,D$I$I$I҄BD$I$I$M,D$I$I$I҄BD$I$I$M,D$I$I$I҄BD$I$I$M,D$I$I$I҄o؅ '+I$I$I4*"$I$I$iU;]s_rIQ'RuםCH$Ih1I$IB! I$Ic]I$Im.Dr!?=cѳ>;˯3/(*_I$Im"$IRwY4d!"I$i$Ik؅H:(o!5Q˯u(_I$Im"$IRwY4d!"I$i$Ik؅H>( *$Iz9C$I. a$I4V3$Ij:$I^gΐ$IBeI$IΜ!I$uH&ʠV/~|+G7QI$meΘM IBeeP}?BD$Il3: I$B䮻&ʠ2/$IzD3k I$BeeP}?BD$Il5s$Id!Ҳ^ *g}V7G-pVOo-=h.hM6Rт$Zg SO;-*W_Egt"$Ie3r7ՎZkGzvxBD$Imih2  I$)a!2m"$IjSȝw1ЍvPɎ=h/mNQ.nmRÏ<"=hY[|#ꫢ[n%:u7(*o!"IAjs1ꦛnjNK.?џ;/;$IR,DZ6A%$IF;gXL$Id!Ҳ*sw'>}{뭣ڱmZw/E|Q4?c(?A뮍Վ_ey:r>孽D&\h rS>^$Iw}WǗ~~Q)mNWb>W;jkͿȢѡ 7ga٪k-bV|tGn(|?G⊨|7ʯgޅ<I$YlJžZԳ$I 69Bda!"ITw>ЍvP 3όjǎѯ=4*>T&g|SzoNة-F:"w[ p/sLA+"\{MWELwJ$Ie3GVʏk. {Hߏ_cigt?rJC=hE(?&FlQtEyK\矷H F(\X$IzHF;XXH$IMv,DBD$I[~mQcS^5ANE|r+ڱ(SU~uWGz(??򨣢]5W\yE_rI4cQ9hE9`#I$559#zS<(?~G([Nx=ϦwhydzO~sQϛ>*!_x \?G8oE$I& vP$I휑Y U^~<$IZ/Dr1Vj|E^zITweFvXt 7DqnJouGFb/*_\#*? 2G[{Ϸ@){v!2N[}M[rhϭ,#I$559lÍ7淢/nm~̔wߏDdz^}1GQywiE1\G('7 ʹg?Ey$I& vPBD$Iv($I^Zng?'tMW\]sn(sojG/ܗ'TԵ]y~o^O~**VBԴסWoӯ~-Zyգ|Sc%Ie\|3;/C~x/^;Ql!?&ϜSʏVny?k$Ig!Ҳ* ȴYH$I"<,D$Ia In=hMm6zG;s-vm78o^4ʱ} E;kt%GQ"GD_qyCo~gDK~|٨iPhEǛ7S_K_N<(7<@qI'F<|yhv(?ޫ!?UX3 <Oʁ/-(?~uES$IRY^'&<].Ze5^^]~\~<ǗsF?_"éDXD ,XtE/hM#.(縳9;?|dy!X0r+^IBe;XXH$Ie;gd""$I \`믿>gDo^_ͣ64Ɩ[D뮷n>7[';ыz5uY_8_?ѧWX1{GE>;q[6mQӠ0/}|9h֏\#Q'恿0}rm}tOD~7|p_.r>FW]}UT'I$MWsF[ڱS߫87\lNQ8oQ?裣|ܝw|O}:/?U$IzHz5XXH$IYBBD$IM46Z|?Z{|e_^iY9  Ds{徣B+/ugG7XtF7X`zg#ϸ% __w}ІGGϿ0-Yx2cx[_zc޶o?=ʛV)QS /+3uw?djs~OW=sEsΤi!>(C}3o޻Q>nzs'}Q~sC|Ds{Be:X e!2crzw^\qe]yAG>?tѼtϳoweQyWDyx-:h囏dc`E?IѳϽ}'Ey~חG.D>4dJ)/\ۢ߭_\\#|H.Lλ(\CO)?{=Q)nρ)&3N=hf}-oyK뮻FBe:X e!2c7 - ' V;V^yq!r)'E\rQtT\raC^Ps~>-stݏGPDou] ]pQs&EǪ\ؤ/GGy \Xu |ž|LTr!/\Z'F'^ \L~D4m:zvOGDY|"`y=h|^{n ,Dq"3& Bdb}ǰ 3:};sNpbh/j˓,ou7GGukSn{].`MkL].r7C?~۫.;94n$˅ӆ?8'*t?F?TT~|Fo> M7_O|S?5n0 g9:{,+v!w=iF)~:z^>*" YԳYL,"c!@c؅=孳Z~uCE}(<}t㢼@Վ<2zſEkxFUV)Q.X"(+ykr|TM-NvBT3nj1uHt Fczم?)"-,=\O?|T.Dcx[twD~轓_)YQ-:{sTF7XTI;DxFjĐ_?ZtE{.[B! ",D,DF#BB?a"ӟ΍?}~g'tu=o޴n薻jnje]Dic㿳Q."|.@qM ,*Po~GꤨةB$/-?P9fS:;1l~{\}QrQB$O~OFy+: Q>W?=gktGZ(0ьRK-mѠַwGB! !"""cBdb/c؅H:f{]^`/jǨZbl}jT;VD3"3Y\ U^iBDm6Bdt,Dh?B$A{|sA)|ji/nzo.zjǪgG_@T;F `9c:g9/=W_.Do~3>=CwX Q"01^YXrz!R[ R:.Ҏn4ovԍV}KM ';s}.hxꩧmj}cViYBDyM㝅?B`("-סvVR7L49gW;,DZC"nhrzwX̠9N'V,Dɠ9NXwu+}hib`?՞c,3fS;6pBd *@3` kLꫢ^7zg{7:}SѤIF *#}-Zgu"2g)"-3 ϜcwBd֎xᇣ6$:񤓢c,3 Ϝcg]ǔ,DZfP 9Ի)Blw͡Q혱׃5\-sۿ[}/,D`x3wX׃9}Ǹ[l卣SO;-3jPywl=c_b ^ *"-ՠb!^U;~!rD?wtt]wFS?X6ܠ׿>Zve&~{4L3EzkT׿-RQ[|#-B*5-DxhM67Ds5W/~1EQ~{(L|5X#*=?(^mO?XnFwXlABBFj9rz! ʫiEKѕW]墢\cph"&MJyӛQ..ySNfei! _<>F뮻nr!{衇|q{o4묳FVZih%믿>ʅvmXnFwXlABBFj9r7 {;zg)oYX{seTMwEmQ7U[H?s/(:7tSTDyG|W\.h9R.D\p(߳Fo~stG?|,:쳣{`,jra!Ҳ^ *""z5gW蛅HA+]t(ߔ=yOV[EK/4ʅƓO>6x\b"߶<ʅb- 6 y督ַ5袋rs7G>:zk^X?BeT,D]x Q )"-zPdM|~o> 2+|=h"^xaY $Be]*"u"L$]0H}HˆT^G.l4?:묳|_QBsύ? Gkfi:QI+r|&[|sc9&Zo4 +FK/tt}E7xcoz_I;ps0zBe *""0R ;cnPB䮻Zj(y|SG-\4&M-ld֊"&mY7)z+_qWDW ?[կ^FniSOE03+"-nPnFw}!&*_kK^vE|[n%=X֯<%/8:gDP;,DZ֯_:gDP;Y6$eW\yEF}ku{]GO?tTZh*_h%~R;,DZ6A`8#3,De!?R;n!R{#)}dech pF:g hU;sGuD3]>):3<=M_ch pF;gv1ҫEHZwuUW]5j+eg{}oTʅȶnrhV,BeTvΰb!?R;n!o^;fF6Am#^Z*z뭣(o%u7G>:zk^r!>D_~R;,DZ6 @iz  W^)ꛅH է.j1MP՜ѴEH[fuCXs5" aՠz5gXXYu]o^+=X֫A zE1=V?hg~_F?xtWGKTZq^:o1z׻5iZ0>e0hz=gXLB`[o/Dn׃ D3N8hyc`tD?ZiWk_hM7zꩨd!?R;6xBd&ʠ2gXЏ}"뭷ߦTזDTaS;,DZfPz͜cw}!kmJ zmI0HT^3g)& k ; OEڒ`2fS;~, A5sr1"7|Sתv)=XfPz͜cwX̠9NhIcR.~ih͢+2?衇se0v}H *@3`ij79vLT^3g)"-3fS;,DZfPz͜cwX̠9NiA5sra!2 k ;Be0v}H *@3` In\}9Q.3fS;,DZfPz͜cwBΨvLT^3g)"-3fS;v!oT^3g)"-3fS;,DZfPz͜эVX!:蠃nhy^җF-X47L3M#< gz??~3^iA5sF7,Dڙޅ>~S;,DZfPz͜1.MozSsEm:цnwv1,D T^3g- ѱ ?徣B[o *@3kmH3<ёG ѱrJ׿>` T^3g- ѱ `!}G.D7UV_#ec_k3ΈFmo{[tFBdt,DS+"-3f"Bdt,DS+}3ъ~! cȠ9cl\wuQ^Ǣ,BQ>[,*=?(2{71Q~^2,5 ^} \|.(?\Ʌ>zh嗏J`jBecBBdzѲYw>4?lvj1T^3g_|1k38# eVӛOD3G*"ox+2E]4` ~?.Dze](]}H *@3Ɩ|#e!b!@)"7|Әorw]wFomR< *@3E]o{.DhV^WG}kM74_.DR^ :kE]PN|_k63^#ηb~wW"ѾH >[_>pG-\T;,DZfPz͜1,D,D)  O蛅HgPz͜эՁ4yg0> T^3gtBhB`b)"&惚A5s@9ꨣ\0`|+"-3f/"KiA5sra!2 k ; ϭM< A: k ;Be0v}G-DN9h׈_xS˯sQcA; <_E#va(.r:ȡ8:\/2r} *\# %2! rӓdMUueVgg/SYݕUٙLgIU8C$I@GT$I$U I$"?P-?l6}pŕ? ½9Pur"I$gH$IUwn@ *$Iq$IT_yo~sx炤f RM++; Dz@E$IR9hv"e "iTʊ"=V\zY8#B2Ɂ$IscpaOhΜ93via؝|a޼yn馰׿|g8餓?ܚ6R*; Dz@E$IR9hv"e 2XSxӲTWyGk^V \tQ}7#9&=FH$I:_ kV[dkaX'Ī>yg""d8y |ʁȽv{XoÍvv 7|K(޿nT$I$Uf|W*z'N;\s𖷼%̙3'_ u7Q'4=7o f CDk_P׿5q]zWx>0W,/rk[Wmo?mO"=r"I$g43e Ro>!> DV߰׿Ԗ>" c=? =?['*$IqF3CH굣:*\q{xûpYgkvXhQo-{V>o9*?y䑡xBs >3:wPUWU5;5ٷֶ?9P$ITu32O#^  D DTw<y4*$IqF3@[ay闪j <']}MozSC=^y"U{6x /V]ln?mO"=r"I$g43e ROu,ɦ7YQֿ⼣Ȳ)́$Is̊χn]s5au oxB>N1cF<'<.Oh[pa!/өP=Dtɛy" uC^Tuɤ&aNMd?URYy*QrlH08P$ITu32|uB<_eC1aNLLUieyGSI$IU8 ^W޼K^dmmo K, B~(>F:SC;ϰkۏVm?Uwȁ$Is D@dvB|X53욶 D[@DZYq@dٲ_p#f}jP̨MH(NT$I$Uf`= Ss o}[^'p:yBC y{kvqCy晰kdа?.KUWTcUjO"n ҙI$IU8rB|E"뻨m?f R/D!Ou?an. ed"Ta ַB2c}x''>/n([f!=P ÷|yb}82{0襇~}?lx|w7|!od=.~bz>3֠ͷv{u l'wwi({Q'rJ8C/τr6bȍ7{o6>#y~`U~ѡxmohe Rbn{gyyw?د +ra3wx`Ys}î .meu?qX_ D@*md L"۠A_d *` ҟDR> ??x8f侣!wsa_#>=OH\/l9s+ӟ ?; B.(lBq{;y@!SN_;9 xzm.P|R<#!?qǺ!Eۇtq׿>Ǟ!},\wȎۈ.[AtR@dПw˯u 7g? 8gnl# 6n_ƻ}(>NsP+A.?zz`r@AqYa6ۅM7s(~ς{B7,]4+܏Kޔ-ۋAs9ƻ9zl3Ͱ_4*Sٲc}V\_:w^//ɑqGmG}]ԵIsGݨ|tP +OΐrJ̞{`o~dO=̐TxP)?ow auEN }!{r;˯"Πۗn~%}Խ\֠כv"_y?ODe>篓_ː3l^ r='ozt1Sq}|)[v|?tdV~HwKf<uZۇ^uQv$zHe˗u+@Re?2-3ְ^M6ic RÜ;"""?P5)g D2i&A D D D&@dDc"\~7c{T ~P\S<_?Oty7$r7CCoFvFm+ y{Ur?/Ų;d}F@ ⥬R~b.?!9=wr`pAͨ=z}sCZx! pC\'u DyAM]zP={y'x<s!+#Qn_>WǺS~o 븡?,B>)7wc#q?<-ۋrf :Ultv!=;F^oUۇ^E]ۑlY㩲eX{/y驲eGm:}F负Iw eˎ5_0sU'Ng(;S7*(?t.Ol?oǮBw{ȝt)!=]gT>Oyɳ)9 9 #O(=v>ۋ_BY,/u{t?zyT2c%оsBy.uxޟqd(nݾuIǺS~oUu0gg~dEy<[/[]y{Uo&ʠA)JP\ΐW}ui}]TAFoveҰ.I}C2e@_g;UJUl DVe w4u0z`rM]kU7Lvm?@\q}x^E@&OsO'M,;;yp!]ORL|󼐿^K%凎㜹!wпN 嫒;heˌvɬN,Kfz+.Y!/!rU};A/#=6-3*7M7ˍ{Aw xO}zЯ 0wRڠ'-?5-;*H{r!Ol-ۋagNA?Fu}_刼=gЁHQGK^W}uiz}]T9&[NwP\9`.ޞ BqN>ŃB/뗁Ȁ;"+ 6Y}}&H D DsϣȪ DVe 0u DjSaK&{>_Xpa凕j~oƐ/zvspsB^+;k;? x-C~__\>1򜌚vl8~sn?_9e!SO?ˍw=ZL.M^t{b d~x^ҨuKZxs8]L~= :Eyɨ||!KyKSB\7o^|]%~OyA7m;bH}ۇ_ޝra3C^y5ϣ=F=@eWo D*a6@@dTUn_@@c L""ܿ@d탁D0Ϥˆm.'OW y.wtP|<^wO v.[r /1uat3O\矌~fϽBq#9&ĕ-:Qy7O|ǑGu| c~xZ^ a3O-;Vs}>uяmu__#o7Ȍowc}N}jЯo%qX%G7y=Uڠכv"_MrCaAȲeKC6c @x@^1hYf</ DӬIENDB`coq-8.20.0/doc/sphinx/_static/diffs-coqide-compacted.png000066400000000000000000000032731466560755400231160ustar00rootroot00000000000000PNG  IHDR[EdEsRGBgAMA a pHYsePIDATx^ܿjZq=N[p7(Y`_s toYB'O t)Nswcɖ%5p,ɒe*9Կ_@l`6Y/j>QHϟTڿ|} 8Yrl3TDZ}Rto20\Nicpb=YOʉ]p5J^jϗeеNcFjg,b `]Փgbdgl |2*#'ilM,c3:"2bɃ.غ:Ŕef%6i(O5:fAUe'\W{ sXDXvٟ䛽c{h?Ē @ԐMf:|^'[ߟZ~ʷϐȓ eĶ#@<PFl;"O*==ߞ(yԼO߫ޏ7QckԽ~F9&[mTc+Cxtco@acI}яml?Ϸm{u8S|[] ylZ},d Kb|Vg=2¶fk/Ʒ[{!c9ȓ ed R6ٟud871#o}V^?~\˕Aw 2k:&3u_Rp&f,@3L.'3$@αM'yRd>C"O*ێȓ eEl!0b  Oɻ b (-'jj5qCD*&*5nnm$b Gge'  ls{]egl׸~60y5}C<^߻kX'wy7DžOJAcM1?y]]}u.[?-+fZl}Y^;6pk^˫{Ϋu'X=aNXWtXW.? p}ƅz3y7_ 8qe[w.Ah|J_}?c W!B嗬DkVe;6an<6w8gcmdN.y:նhU421P]68/}+xMMqrg)0nwr8F2ZA3gi< "k Ҷ*7y7Bkq\9W1~GoS,G/xeWzP {+cS @,0Xa Ǥ'q߈0NV]Xݴuk~Ֆ ,izʡ'NJ*.zo'18IP TUܕ|X' KFxW\nPV)Rwa8=:lx${{c0jI c±m~}kSr@$~JQycn~Efi@[,GVŁ0X:^ _aRS,0Xa `:av>_(A2n?FX>q2{ȮH&q'J1d*cbqg|إha 0٤6Q1d`:a\6W<_(]&@,0Xa `1cazxM']><6W{4rg~mW~lu8k#e2O<^ggƹҭm*TUhͶM`U<>>Ц8HVUkghU<2|xҶa6Ya uw>eRkTƩ R<15a `14x34ƿd7^ᚴ{nF~kqyr{3B@zuw}W7v 6ޭ*߸!|8T(W2](_{m}{yʗ 0!<]x6<6o}!qL@!x7&tufMH7:p &Jn|>U7J )8~fA8 Q | [|Zìj\f'y^7?'R,@SPmx߿d5Lw aq|tTE:e}CzoՓP%{0cu\!KݗJpz =#房W6!l0\O\uo&}iw =oݛ ַe*Of=` J)SOp*a! #U7 C 00BX C 00 v 1V1Ɇ!TʰIa;Cc}l[+9{ns ע+~X6 !YƎ!\<~EnϷqX6 )wO|z2B;Gsba`s tr!4aӔM[FBxsJdsnBuQ(ҍ Cs;L˛}\*9 CB8gJ6 JX C 00("`D0 3uq\v(0uw~6fַ|"\WjոF//BiTU岦k__/|BIje6p m߱& 2!k7ǎANFwdh*pzV ήUXI3`RըBoMUp7@jGԒJ+Q _㒇kq3mJ090100r`b>a`"|Dȁ)B=3?b-lvfX~,jtyw8W?˽n'&c@`‘p396–+B8諍rouG};`^uDV ->.ĺ"I,Z޴}|T~ ʘ߶cgm۴{߾aP1Zڜ_ sN2u/>fiÆ_'޵ۧ_Vq}!\3>ڨr`b>oٮ~n`w.b~d?zSUW!W8MFfAZxnsVhu <}f_|_.OMTI>hpیuOLG®CNZUj%;q/OS\}*h}yW;~C„u5קd'kk=>j?901np#;oP?_0Bi:[~tZ[V0RJkJm}(iqo3x3\QɁHNGyw۩]P0NUNWϏ:L7̅귤ukuo%s~Ԇ;Ӿ!\>u:KPb=+k3p|?O?%/:MNGTi?AѠɁhqcNp?mϛA.밾gDXJi%hv R{rb3*nBFP>B2D4_j̮m틬y ֬t?mcne箖a:ͬ(@a95c8&LDp(ȁ Oyܱ |Dȁ 0`X00"BFDa! fƑIENDB`coq-8.20.0/doc/sphinx/_static/diffs-coqide-removed.png000066400000000000000000000101331466560755400226110ustar00rootroot00000000000000PNG  IHDRiL*sRGBgAMA a pHYseIDATx^OoH~9hQ;Kf,-p͈A@mhC"vo0yVjS:v]=|W$?d$$-ӓEvNv}k]1qjGglv%?O?6H;ӈWtf~낃9}yDtWʪS;MCޛ+rAi67]֝(E8T:*7>*5M8()cԠbr+Ϊlg_BDZ1]bBrVkź ۠=ASŠ;.eNaA//+#S4# u}Gg*S82L."4jQtQNjD֣G;LRUA޺To][6(ꎠA T&Ha$6x40I.GF a b}3;[w ZWtkB ftՖTeԭuE@"l44nz#{vwF EJH~loneS7Etz\<}璙Ƌ솚Vpw9VC۟`X|;~Z=tHeV̿Xoe|t6t3vU{Tt>&3޺lھO[6Agow~aG4`sF6Fi~ G 3^|.N6GPѥL4`sAW@; TttmLuѝHANstA9SpA1!c+.Rci*]Iw 񠳿~K\KݔumԿ̸ּgV]Rw;zan]K]ppUm{wSh ԹVp20`,ѥ?Z@:ڿ00L]mҼ?ul l.e~ Zզ-.ltm?^pNA'jO//V:dS(v6@:)tt@: E i iD]1: 녠+Id]ߚE6 ~D'OʹDHϻ;qZWеVs-ݟewq:7UWct] -OU:Ƀ(:ZmLq:ijي+$EGPV!z=iIЭ@bu!.W A 9J咭jkyQVA =j񂨏[?^:I#[Y iy٧"`x׿t(MF\V)t jС4!vrX : g_f"4&]lwk@5;l{StEvfײWX%?gA#ӆ|[<3JSݯ'j8o/Y}u;;=7^dTt~?WW;bn}?/&Pkj)Aw$ OM-3M~y ٖ]^ ̋ٽ'nR))CnsuӴ]̖ 7=e{mWnڬ2hh.@rʽ]Y/m}\\T?4}kkz>FvmvzbEfl<ϾӞguqN+O٫k<~ S,ߓhd0+cQgOy18~{;ߖY ev.j_?+zFp?]7|}Sm>+󣧦ooޓޯ_h ?{{ѳko` ?oȠ]rA'oM˧׃lʊnτPYJA{Mm݌_Č>cm+vU2\pʉmN 2U1m|`U[g.~yk􆁮rA'শ^:O;eEݾ)Iݾ|kՐ 2lA# 3?y~tPBtJ[[p5 Cm@7'w>_eQ|0+ {.2m:v`!aîׂҨ-ދ%oC/x?JS_J/UՖL(Iev]P!IE2QEӾ}?3?[m~cNn[i4+8>d(rfxpEձ^U퐊.а|h I@l_.TU 3[y~ti:t(Ma[?/vq 1?05n]#iGfJk`Vbry vuAw[UēWW0>PG # ms|,ߥX,The@lu~wIkˬEorr?JSnxPD Qb,k o=3><kz;d}m[ưִ.7,l_#ȡ}g 7B76|f&̤j ԰\=[7K7vI)A"};HrdjA~=lx5L|xXA ~Gwȃppo{>훜 .of("F-/}#g_ b߶hCO֘1UUR b'Rcjӡ4.%GR L 4t(MF\V)t jС4"?\}RA}RA}RA}RAK3eW_l6%:,zώ#Tr>|~ 6}ﳫSw>D;1"FOƵr|AƳ͚ݔrl؍tV~tT}v ;59UdNQ_JV}]':P+`|@L w-߭h~vz |!,f}m]׿~_yfr= or궴IyyIgyJؠrMkؿƠk9?h;I `\eй;;[w -b0QӔ@of>5_M[hܠN}b۩nXB zJàu_OMPcN>s~th;I `\E' uAch>NyR|Yo6zw ie5Gt-R4Tm}~h;I `\Z / 2u ]˷~ͅמWcikUtM`uEM܃.ޟmڎ?}RW֥~[;NH;p䃱llV&]nԄ`s6`Jny{]cT/^{PLv3wݺV ߴ1U[v:F1Tޗ5L{ŠD@Em(> 5d0_.jǭ+= /M06;t/6}^kwIx}dCӮ*W}#˗vֻc[Tcǰ{Ce⺎#uRWtH jpZ'%qti9\<}RA}RA}RWt$$$$$$$$$5oKIENDB`coq-8.20.0/doc/sphinx/_static/diffs-coqtop-compacted.png000066400000000000000000000066021466560755400231560ustar00rootroot00000000000000PNG  IHDREzsRGBgAMA a pHYse IDATx^=J`x jdbWdB$TM84 !qgKkG1Dt7`;*M}jLU=N5U!WQMsM9^®NY3t r]W 4}7juɠi/gSm޶}[YusvF֋SOm'b±2Ձδ)Fv!۶o! moOz':F#3e%!hV*Q<T2ڠ-mM=iYZfvolP h]NnO􅁦o 3.ٺ}-hΜqe64ڦO k>I  b{i/e /q Ppa2~զjPon\fsmzS,^U{j,L6㙖&e}MgW!{;;HDyE",wPi( A",uPG",8<,L7S^3T#+~ԦjڔQ`1L2|6(Kl aѱpiÐ؀jIݛѺQ`1Pֶ%Xhzvnk/ݘk+%who~ hV數w^ǟ*u/bJPIl//brE7XLC Q`D'X$<" (O4}lcۣ,Q`1HώlcۭPFn(OHDyE",Q`D'XLBD~~e/ί3?~^Ftc(?4{n!ƾ\[$>6:4b=X /u؁1ДbGfoҮKͯ?vO߰?_Kh( tҘ2ׯ#Oe]>C?6RsmwqujSbX)Pp^"͞Ob D; wﾮ#m@K?HUh C{@X87ZRL+YqhvzX6z˹vAt-Zvu''~`1vb"߻`~lgt7K:Q؇7ÝUj( ! h?32_gIyokf'~`1vbk:r!vf@kaߣ =ܱ,˯k]fK~lWo|l'&™ tz/~u} =5^/Cē'ůIesE[:zSl!v-|/}G]{)R]b{.>^Hʷh@qЁ ,RB,'1b:p"C,Q`D'X$<" (OHDyE",Q`D'X$<" (OHDy p*PRƥ1LS(i8 S5GȚ0N-{@oq/ `M@2u>kd6mEmN]wjY&lS SҶO!}KXS7Nq' ׯ}ikr.> 9xmS.w ~LZA!eT<2 ;nr nv28`ꖷۗ{C8\*:IzQu'hӻ?ܞ]н= 6/aV\[ضŃZvP069 ̹^ڿOy莯^%iHܴ.h@J%=qA{/I:l_$]{ ۓ}R- }=l åݖ\m0tgAgXG}8p^{\wr6B]e߽?KE_rc AֽR u M1kmS 6}H\ozzdo _.CŌ_`&OHDyE",Q`;cfߥ&ʊhK _;Н!ݺhoVHD mCȲ]L tWop? ]޶e} ih-7?.{cq?O=DN*QQGQemr: 4=cCZ @rr;/ 4=cmg?hΜqe64ڦO k>I  b{i/e$>~GE@맮 u:86X]qhzx3E2Q<צ|jڔ:WDi6 2?*S,% Kmm7yY=Q<ɓJXv ӆچ@ۖmŵ843{_ڣ bZNð3tL$?2UBCmفǰ{.Ѝ][/C{ +Ŵ q Tk/_O::WDi~PCQH k sEt=ZsH\],\h?Gb ~+E",Q`D'X$'`1 <:D,G@Ŵ*I2~LBJ{ޫb_[ٿ?ivPI}믧݅nI$h km DŴėOq_V?$`nݯϪu[7{>'`1mc[f-elZfhiz+2i <nzv?ih>'`1 <:D,G@E",Q`D'X$<" (OHDyE",Q`DO吖tIENDB`coq-8.20.0/doc/sphinx/_static/diffs-coqtop-multigoal.png000066400000000000000000000107711466560755400232160ustar00rootroot00000000000000PNG  IHDRQohssRGBgAMA a pHYseIDATx^ەaS ̛C C&n- *@-'lEt1NS!1}dc<74<S}vP@Pu]71t3 AFUI;WcX3,h. aDa BxhL[<ڋ˲|򰞻2zgN&w5W뤐zQO#y:.u;ڌaɤ.>ucdKzmd ]xrg,E"lE"[d-Y`,E"lE"[d-Y`,E"lE"[dqWXuZ`%\7iLצ,EwYz7cӾz"[d-Y`,E",SAK} _}{ M|7P*h?{q'uo<1@FʏuT*Yܷ>F;6*p,{W> |6YdPoxJ}"vO.BݥP>T; Y`,E"lE"[d-Y`,E"lE"[d-x \3izC{yұwbwH~^{&YjvPFi׻A{~L1i.}~G|aLXwVW5 :D~ӷx9^Bo{/^7:{jYlymؾ0oMĕѡ:O/8)3ヒ:2|^<qmqJjAt9Lބڏh{D D,mA_f ޴OϣTκt|Ui7kbkUZ_cN@ߞCw9]; ˒ߌim^?j/b#O >_O5I%/S6#4嵐F̴K IF1]Z~w-_t1.Ϻ,oӻ/W_ky3 |6ucoy7Տ/k#O "t𚩣_jkIHLk@uRk)'B;e 3ׇG>i݇ަsAǚ,~ϪNԳot0AFP!Y`,E"oFɦgm#gh37ϼם80-lKTIw3~3QDp?R#.|HSoԺm`N+szd\3c/U;qZ7Oa+Ӛo}['>94xjoV5?aN7Q#:T6FmKbzPcj\o[l֫uq7,zd73d-Y`,E"lE"[d-Y`,E"lE"[d-Y`,E"Ū+ẹLcڿ6Me d-һӘTF@"lE"[d-Y`,E[>:1[s7qY<Z>x0NGءMP d@0R~\ Acq8mT*Y<W |2Y<\Pw$E"[d-Y`,E"lE"[d-Y`,E"lE"[d-x \3^t의RI|vPp-8]?Nc 8L,3xM]MqfV%v÷\sZyZOØϻÈVN};CuPeс:J>wG\e9֗3fYy>o xvdtU'> j g?N+i9L1|eZ3c<Դ\׮!޿qYmfe/ }:~; jYCzX5o֌h 8yUP놑TP2lm3m?%lv=C?0ߴІ==EL{ftndn]Kt. aa̻}i 9>˴u㪽,'WzV51}sy6`/j>H!BO#V:.u{،aɤ.dkKo(ˮwdLikYdW81m\&7+HGy4,Y`,E{3dQ.3dO>]}c0u?43d+}VڕPBMݯnr?>%gȢ*y~8?~SpU;ΐE6wUU;ΐ9d1?<}HRS8CS.U] Yz>I 3d٠vn3'dQT;ΐET;ΐET;ΐET;ΐEpf۵g?]2dguq 9\ߗ,>A ,WrtB3k'[.5 >];2=_4uviYFPjƽg4^ jޅ xaw-֮5v觃?頖i{~yD}K :۬̓x|{ϔ:O.'pd񆰋َbh YY`,ꯩݥp,ݥp,`JB{ϸ_3zgȢVt {x?]̏3rB>Y![5=kv!>XmP{MewgȢg4rE6YZ>)Xʯp,=T3I]C|Pj.Y|Kv!:hwv!:hwv!:hwv!lE"[d-Y`,E"lEfa3IENDB`coq-8.20.0/doc/sphinx/_static/diffs-coqtop-on.png000066400000000000000000000155761466560755400216450ustar00rootroot00000000000000PNG  IHDRPfsRGBgAMA a pHYseIDATx^ɒƵ~w;RY醨M* j$s3 H^. GT8eoz=nD&HP2s0Tn]N$$I7H/+8:*e)e\ }s68UdaYVhS:61v8DŲ G˼\3őePvzAXbsz&;&M1ہp;$pheYIȊES'}2gM=6_0=.~*mlOq٭^[sٝTY\TyUA3` S뭧YV8Z`1 RizNkCU{kQT:mWx%_&93lXˉDj F{Iy<5}\uROjN91-Ep=?_f{=_\iƣzm.AvLAr[:y#D iJv5ہX!UBo]њֆ.*YgXSXޤ߲j=ުKg jؾ>~$!E: Rf}eȪhE}gk3r>1YO{f擄Hڷ;eNNY,161@$:+d@~=!:^ l׆(m>W&魖$3cuL}[fDž)oèR2sՎWXlpgXD_йzfv7vKÃA\۝TU&:ivɢ:hYS}?rwWuIu9{p}c:H[[¬wUQV8IB nsPl7;V{ l,#:hՀ|pmA< [Y#)A&k71uYX/);%Xc$&sD='<594R3 m;% YίǞSA?ƈtYGn1+9~rR})m(3zr IwAEQp*}oIC$dp28Z/ IRN.I ٞo0*_*'{\`OVW;EN4?*VZ/(Ro[46ӗf`==$S^EO$ i$_Wyhe$Q%?\ 6|ϛy+9$oJA{U ޝ+e^,zA +${6=I`r~$`{Lo ~$zۢ~)[펶.q$`$$i*mP9c뭐JbKdՉM+ypO/8Q{.W "7ۘ$[$ @^$ @u $H~{$ @=n7"IR޽p$H|M  $H"IH˷I\IR Wn$|Yu,2L#Nz^Wk&m:.Ӯq%H!II$ @ W۷ZJ`'h1|\IPT6~gS6sn4 XŢ,w gJq:,V͚c_z!kn\O响%9Rl0hisg:/4I|ukgv$~(0hisg:6I\]3I.R._,eϊr馇e҉FQ.*+ͫ&s3-jӸTdϋx(3l>܊gn>۟:<ԧ)_C(\ha96pt/ 2 :73_}ۮA9J^=EMUWxbE0ZeD$aK~=&aM W;I{A^4D`io:re[&+691Ygغ4 ~qfQ}xf*@ӒNY.2`2إ9jw'ITx=$znRSNb& ??iGu5! $^aN 3ПqTaF| ;ve[uVUN@4vɢ}xV$!E:RfYs8~?WK+KzRagOcM\+}ڞ_>d%ef>Ⱦ$cv-6I}cZ;:' _fn:~Kql_z}cWǘ$>J}}W綧-rDfOpCak6ql'ֱs֗v Ϯ0띥}ZvS}6ᘁ/g~SSS^a%r)A,8>veܾ'}۷eq]V:]z~F7I M]!Mbu<#y,sy{ә$g'D R@:LkO&BaapnYY``>zgZՒ,e(c4b9]{Vgc5veZ퓇MAg҆:,W/$/Z rM`Nqwݩ-Cҍ;zXZl-|^b+7n\qp&Ipuk~p]W`\I\+k7xp HzxM/ʺo^~3 @{] xﳫz\ W= v{V6똛\R$O"Y/-pjԼۘ$Vr(?>${v8șK!ape,^sEtò,_2~> _4ǯ Uˢhg6 s\䦮CLۖAvn93-z1Zٗ`sSvYZHsˑ$q܇xI enlJ;L1)s?e6.]rA Mk*@5@XdYmt9JR" ZH-m;gID>Iؤ,ϴ^gzļ݇n@\I2H+ϦܟZUYheymZLŖԼ [59x$ѳǶ/$~.՜z>CLc XCH$X7L}tui6H}fb CLIy/Up :x 2p+ w߮L~AL{F0*OڰzݔM޾p]GN93u7ֳzDzLUxÏfַUD3X}@h|VAR$|0 <Veup9܆W%׵UD_󵘫 u|?ӈN 4i$ {. v`*cwA/yW/'+D^}x `ol\o'Wl>K@ǝ$W~~w"'I;7FnW)4%)3o3}i ֓/#IFz܅I"":$`e~^W 5_sꭳCIBnBDP^Caw'JY o歐$`/hOX!ITCoIg~O$# 35I) 6gahRl$K$J)l%N66׷hm7o%ȅIB+dY.>4L Rzp/xl(H0[? NX^؄ѽ"l[烿'520\߶ߝ^^kZ] P^0tV{h.@yMSv$`3ﳼ,~|poWX˞M/i\rZWc٠my3t;JI"p%|%`8ڠ?!IL6=$FjA[(,cmU:u!I$_~}I?vS_Xų,{n5]􂱶*IT~ E[OMy[7]k`$q hV/9+]ZˇzXڙ(>yW/K Fk<^0tO/._+fӚ~%5~<+Nk3{M`N/~c$&2EKqKl&(G:VZͲZ`_D;^jC?|ڛe6x?>s_Gw{6]YdW}hm}Χ3*|$yIW[/|^0ֺIbM!;-+`jE1a$ Pܙ}|'y[!I_3 u I^0V+؞BZ`_\XJ9?685`,4 Oci4 ^ ]ϗN/$ ? tk`,3(ۻ2m;5|)_,2NL#N{^{zoz?/_5 7 z@M#.vY/K(T#{8Sʎieج9}:U.,g{vO? Ɗɱ;ϽMڥ1G{ƭc=IAr,xwcўq I+83`,;82yUE5\šO>(EP早qEPeen=Yslmwŋa}.aW eߛf#}ە6(BO۫hceG`,3Hڃ 3Pm#3͠}8ID̓eZyjz\J\9+% 3َ ,vE,U%%{x`L`_9jw'ITx=$znRSNo >DK2xes&0˥T+̲zտ)wgĕM'̭/IY+A}>OB seTS6F]ZW}֩iI—-QgA!Z.ŭ.Yꯜޝ=꒶1&$mO/vٟ[/ | ;X2?q9;V2?2Am@j%jv5\Jd|2 XfL|TJ}UOyugoA+pu uMɾ쳸hceg1>xgo`ujIGy\?ƈt7.͓$`'0Qm=Ipr\ _OiCQmWDz6F] 4y.S]/mu6PprL| f`s `,mJ#.zX@6F]vmX/? x^&IR>xU/ࣛ|P/_\gs@/ۻzN Mm:;%p5:zʬ̗8Լۓ$U}|} Il[pe,GlwgԲ2[M˲|i~v Ȯ'~!rf΃,VQ C(<݆z57ٶ6Nĸ+ )3Ar l;LL`u?e6.Ϧ\\*JPof~~ؗ#DEMaê u,`_.t%̙2> W)wg{heymZLŖEI[>yA#ZrvjD3Asܕ{ouee&?"=#ӮO<}$MK\I*Lgc}k\E47D˪ A]IID(~pm_Teup9܆W%U<>-q-AXW'A&" p"UO3 HoL@IENDB`coq-8.20.0/doc/sphinx/_static/diffs-coqtop-on3.png000066400000000000000000000041151466560755400217130ustar00rootroot00000000000000PNG  IHDR P sRGBgAMA a pHYseIDATx^Krޏoc&'<"<4nB*)J(俁h )$"R0xcНuN)[! M 7p"1j: NC׵,D\H|?tU`ִCקGIex/idKc mz,HmV|\$R۬HmljK_&?;z' ͊O^Qn~>cƏڞ~Q mH 17o8`&%KC" wׅED0h̯J0hՠ~Q mP 3 J=A}&: ?_nC}&:7D6-L幡էuT۟+5f)34eXGRgAM;oW, hfm.|x`ЦNEbKZ*'<0h"qF~417ba6# mH6^O D2g)l8 s`fl;Lt<0h2 `}x`%֞> )$"R0HD`H Aז|c׆rd'`H3Uqm(Gv )$"R0HD`H AQrd`Mߑ8v/|Cmt[8kۈ+*le(GmtNko^X-6/_A$ŵmEW`&7_WU&_߽nh6]'/hsк(mseuEm\v!"떃ׅkƶs}܄{nׯFkAEbaZ/(Gm$MO@P ھ+c^}}.Ee\nCKz%z1A[zEEBQQޚqUr/~,K/-0q?<}|=+1y":v2/(GmZ,:BE_-fޒNxmO,ݺH˵=6)X; +st~ rd`&:N5avAQ[ZoI^X U,i}cYvLEb~EbmbihO~%|N^pAѤ9 Ii-)0`lzX7%ǿe s8 myU3f* oS+7>M8i˟0_bDKI0]>ǻu]uD, a{<~4]={ˢwz]AX2rd`fv{tt_(GmЉwb󌆮> :QDGrd`(B90HD`H A""DD  )$"?BIENDB`coq-8.20.0/doc/sphinx/_static/diffs-error-message.png000066400000000000000000000127471466560755400224760ustar00rootroot00000000000000PNG  IHDRGoEEsRGBgAMA a pHYs]|IDATx^LUgǿвmՎ0-nJӰE!@՘"۬vǔ¬`&?fW(Q4̴l6ԄAlA[g-0"LvնcRgܡʏ}ss﹗$/_y<}_qM L@Asԯ  ׈AA1h B\1h%@ 5PY@霃j{AUi.=)ʷjgɘ g^UaMo0?lLq(}\_wl2gAr.iAֻ VbRQltPcmR5d}0Sl 5OĆrdC\s</uCȬ~(S3,=?S? CfNqF*ظ [!ƱnJIYU>r)  ojR`*nc0~}֑iԃn')Jnc2x琣읺B5V| jGƊcC+qz*I 9N)lA] %jA1(8p5 Ը/~L1 V >* &G'gxh('%5jʹM AR V87NyJc*,&dV& cIO?j8㐂 1AKiܫ T+$őPO;ַvCh1n(o\cLȳO=1H˟{յ"}e"腕gžA7Ѭ)5~Dq [1FY (uF᧯LW>l7\K0~=t %@ f:רcbq݅[q¸w ~.N,;&~t9ܚTTQ M<>?+ )'O㼊c=_|Lb ۋ- P?*JWWGKAhsǏS,M9fR*OH4=9>c®6{G]U$=`ϲ} M"wEfx=9Vb ǘHªQDB4RG\jݐ&eʡz u {mm# Fjv9}#tP9,k1ۮASV6 z{X-_~)*o2+̵Ԉݒt}o%ǧ3Utz3<~_7} u-$aK'G{jCgѾaj]q *P]g4=Ȁ]#?7XY~4`9Ξ(Y+YO7^U~/Vc5*D/,*F)o#>ۧ4QZj ݍuZҭXM'Ky`<ҭ/ۢ׾՗xWqذYglM+#8~0uֶ;N}䩚=o`o~"'+_)j' 6ǓjJ~.D繆6b>f g4T¥F@3J0~*\%~@#["XV6No';qsZLl8I!{V]UZ0Ot(d>jԞ1A& @ C\!v\PCٯJ?IY{?8QpIʪ9.>̴~ O,z 4L֐6M:(xiy5n-*_1Z#̓ަP5HOå@",0b0 ?ѻ?_Th#xHugˎi@'p 6+$Ҏ"/rr iX9zPdb) #҄S]'&ǧ?r\Sq_ AxZjn$bCu<1@3#Hmb"A:by۾  L#jA!.& bA@ L͠N tuAAp'dx$& G CxZ6'/mE}It>W]Sq`' 1h d\7/жg(U}=mmh-|XmQq.AS_f226=yiq 3ۂ &ޓBX1 kHez~M BmX1K*mj}8 EXcn2N& Do 4A}y (1 kպE0Cǟ*Q3y#D`c<2& QA   ܧAA1h B\3%A{\HZr7& v.GA!.&  ?Jr>9 0]9yoR tC>Fo1NpR ~JϤidpɇ0/v>tR{aS eH6ZôvڦVK]ElXeRk #mB7[<(t\cGc4~# MX8v~Iҍo\K|]KqB}cVKfRPRQaf8'%C˯褓W䧛pkO9[됤@n>F!f AJ.&cf~DȔ jZٺW8n ˏx8"Wlg6K 3Wc9?/XS<9!-Bc2w`V^MCޏqÐʳ }e637F?Ϯ.AIw&?Kܨ>{~b,}1Flܦ-yx We(n*r0]|囶ejv{Ěgy9RX_9JHrR]#̭<SCIE)OJ ?pZ Mb i_cϠ-f.YS>-J7#/{+bnɍ6B},.Ǜ!*6r} z1'\3ΣȕݘkٛוUM)lI6j +{v}w$7\r{s4N;7:>҄Аڻ}+/QzVc7`)N1&43]}~7z+0&0)r]Fb?sFVw77r[9*#uulkT~\~r+ؗpi5s)p—.sc?Sȍ#CFcNvVb.RKRH#<Y/A^h/}Sx؇^cN~G"#QQ;w#SkM~R;y2…pU;QP_Lyl)9W}f\=­P2{_7# b, b~|bp'.--8gFͧ+/K;~ v Ji,V кhVb{_4# s+:nl碝GP9F/Dh©VM,k\)YmP?gZٗ`L1!Y>77)HWqӆYzB2u¹?]_x 7mC"2^gV1jU.&{ɷ#6^y OJ`c*\hOyEYH '&5/WH M/ a(;p%5N~_Y)7Y;l8n.!Je!}ܥX΅/@PN?oPyCHnX0~i֏9!oy&r0w{9F<8ĒuOC0_|rS _.#Mc;hyilz?"a׿Q"R)fd 7iR'0sޕ0k=(jdobV[xH%6H݉ލLѲhjrSIF5G;ƅhDǒjQi^`;(!b>^Ht|h<^]./XG{b9^}n`>5FH&\)<+i\ن.""fqBYx堺= Oow;dsn_sh]\~ح+1jd)x3Oe`tNmXF5[cO7Fo xF,\_Ir}zp+~&%D&`hP<8פoկ}blLc4?V caBb%ԿȠ XCZlm_A MA(4A!.& bA@ AA1h B? -aIENDB`coq-8.20.0/doc/sphinx/_static/diffs-show-proof.png000066400000000000000000000325111466560755400220150ustar00rootroot00000000000000PNG  IHDRftO2sRGBgAMA a pHYse4IDATx^}gXUIh眧9+fE `9+,(*9 ("DED1c ж{}.{ >`׮]a[knݺIII:vE&dI3IbI&dX,L2ɤT)1dÇ$$$$$~gTJ$f RbNNN$ UĘTc޽t %$$$4I O<:p`&QAA>=zXƦ <QKKuAP7kItH߿3(3sedi޽YhHr0&Xˡt1fZҟ=\' u&ʚ,ݿ?~ C!3gNӵkW5B/^P7-u,aU,QHb~>1Z$fm1W7-u,aUPim3u uR{P3&ؗwSPH0SĮL/'EQ|߹Cd0 ͋C)3+dVBoS!ټuYwڣqSFԻڰi}?0@}ӳBY53b.+W.x@8&WX 1|m#߸6nvBWRrJ]ZZ ?Nuj S#k?h @^#F-Zј <&弼pjԼ$O:D:%09LgϞM0SaH ?As{Ĭ6n59Yx:s1*.)V5M>17jђ m;ɧqHI3jҪ5}װq9byCCeh”)4r82cm$ڒXyQiڵBn*3&NJW&N#Fp=F Ъ5k)rwN8GD3&ONk]\ez$qݛC^4ٙ{f͝K>~+3iᒥ,7jx:s&uu8ČI%8͜EC-]Ƨ>,gme >mED81VkX% ʈKhھcE9$ !QQ};=1#&i# =4ya0ԑ(Vln J΋Ӓ˙׻.1)Sm 5|fϛOOyBᓙ0IӦSni &%輁UkPOdZr LħϚMCr\֯gdܫ_. PӃ+5>1ê-]ޔ4>{.b m?1nOW7u}`o??yxz2:)YyI*A#Z ֬,Au+_ .2sA mYh0"6yxP p<ʂn`Q&vn1gbZ؟s2ڸ 񲛜FmQVm.Q5('fʨqȦWo1 ܽ' 5ML 3,ŸXek+r:u$ #v58AX!IɉBAT1brT'XTf Bn۹ EףYlxrrmdiөLa%,sm1aV:1)c&$ƋE#}}ZR/spՔx!ѧk.FbC~>1{"> tEt 1#6&xSA\Q.ח6{= )Č|X{z!I$tLۓJI)j2mԇE'#3Sx3QȆi3Te$fOA,[ -[ .?hBj,i6TQ&DX PDl$" r&"B&=rhߗ-ꬬ ({urJ8",11W 뎝h;q"o m@AQwEwkx{xqm7zt,W[09c:$fL1}ر8x(x-f?%d O OC,XJ lXQ7&tI E l3HqGYUAxP~^.~HψDuj"~6!5E"/TMXnkCbFlۋ 9ú\|[ ^j55 % ma#q.~ѹGO>~BLJJ3 G4nD6c&ox!V6itH X,[7O+ļՅ7*ac1fhA[ blJg @,kӫ9'7@S9uRMbWtYx@8ꆉM7CYX8Slxl FH3*|8,;"xv lX]{0Bٰ@liUd Q[b3萹Il\8WVˍ 9 ʤ\Bi1uL ;bAY3M_C H\dza#>ajP&0Ha yE|(r?(+~ ح48"L&S[`<ѧjm~:|E0n go *A2ކ2{( Rò|]^CVGB!fsS7cubgYx*' x 18$a}>H 4# '&$V e]3_4(ČX&$1M67(V!G'U rr /aY(Čoiq2&:6?ـMW#B̈#%qsڃBڸiY _p<#TTtFĬMRSA̅n$f Bp<{f!uRxJON6nZ:Jb(ČY IڄBx_mܴMUA!悂C*U?ڃBxAImܴMU1._f!YPuU7-u,aUPGiYYR'5ڸi$f 3b>.V!YP?Ib*9b~G -D C~s8գ6vZ:jm"$1fd1!<5@cRf&B%, c %Nh7kM$x$77RRhL0|_<`kyL4^`?t"XZ ꄺZIlU$''RXX{&A[;٢='ac@TKKu BQ\GU Z$f VXX{fe O @e|Wav^4`u0fjci .x?/o-&樬](!i@OWBB51Cm6KHhS5"*%f|uRu"HHh S5"*%>]PZTM%$JgHwJQYI*ΞDyGo\}1wwUm@[TS5 7Μ{jJuCmQk)R G+3̀J/wϷϵ2G~{jUm@[(Q=CK% 4W2qʦCt܅r,^/g(9b8uFU*XKVSz=ݎI')ٺQ}iNGIޝ: ~nv:1O_ԕ~M;MfMsD/qң}ٝ*$1]ӇO)tgã\^ewU% 痎dJ!Es|SJC =7[L4)rxlʈ ]Š_HJؑz5oE[/'bpKrbEԷPt;&NSZ7#,E~LʤHbb?]C?m^ YMΒ\v׬xCUw010V/\D6/>6lHgͦcz+̵:kO_~}Wd׻ <̉ɶg/1xuhӆ>#j}ڸj5:[Q`u^=z#O^庱PYp'gэ 4{/|O".[MȮm !. 2:ИxɶM{ s^Fur%B=}.@b ^\Z2M_MwKG'u:]N39||sȶu[M/0R0m[B_.fkhE9KGiBʉ*0?Z6iJ~x^:F>~+(X'ySFa ׊ ٪mwj&%3)@f@VEܶ믽fbc՞i@]7ZYTL"Xu+uraKii|-[?9|XnMJX\&fe|:;‚4{dֱyr ehv|àȩK7q}Z̊uۑCN&e%~1 o/;.:m/])rY³ gIbƤ\`}(\pw;1.]}cpsw.;d|oyyL]yІ+S9l9[Xk-7eebFnٰB;Ӗ9tvNPo >JL7s9 WnӰJbKۡ}'vӰxGB@޼畆E3EƳ2]MBA݄*rY}Ύ!J<uElX%f͎/emO{fZ:|4ΜKAsfuM&fkCKϜDAQ7rO @ΒČ^Lw~]K ~X\NbRzp @|k4i #kU:Aty=2(DE+]h.OAm'a072z7B_1 ڃwzހLeos Ao'@ s Gܳ¥$Rخ#}g_[LIm֠\LZПhl>ڀ2([o5Dnbun׎NJwJhD>_S ?+uk\G􅨓)zXk7_U7x+n~rMK޹%"CLܷ`z|jJqSk&;V=>.=XcU0q89񦐒*\"+7ئ;Ukf7{W@1kz= ^7PfE |lDyro*5/;Đt^Gjw|jD6֋e|!G%igSUw;u2ĽoWÐ@'ocV/zhߠ(S?BU M|'AmR$1X-"xEQW㺁'9'11Q _BC;ٰb-}}Za.ݏC!EhțoFX;MXƥq,sL)!B㌦&.,>kYpR.)ڡ -^ A]KWzdr7FyE%vcC 1==(x*7G bxvțC8j{1xxL[:g.ϚÛ V"gib %M{=m6߾[@㌝dlf{D\=)(9gy0޴)A#lzƈ8שacvyk V{CEq\3aQ$tz Y1ԬQ#wۤ'_ȇuPA~7zhEm1/ %46&͚MEumO9K36y6{KY1qLG/UcWM7,&:svW:;SnݨOԷ{л7ys)b9~+};:no P~1ic3 `p..JC>[-BvYhcӤT-Bw.;ӈA!3JL8(wQAY؝PS'$7Xg]_CCm*xYE539LZ1z`r*8V~1 e+G-/^>tLi>.ɜ}6ЖJ^_DL Խ\\yhӪXD[ L%Ki_UXb콜S48qҸWEƩ'ܛnF%@τ절%+AUe?s-1VO,C$AaAyFYx5yFrWxk,>oݛ[g% -ǼrMrL:,t(Z!h9Mk Q"꼴\@O Cۯ;5"fXrpkSyWyj2UAQ<}%F:! ꨋ]&wUu[NNX@ZsZ)n2N5٪ '6a5R!HbVo;7 TBᣛT\Μήgѽ&B joӹET|&Qz ;޷Qӥ犳NjMѹ"׹s~WOÔ_dɜiT-1"! kܢ=?GU2U+CzϖW5p 8F$b..>D~J-r=2:UVDW^*S@QкDR<mEVM2(& X tU˽ mVP$fd1T&̜DkcaO_5hB_h׍Iװ ĬjL_ԬMs߹J_,іߦ3J)"uUeԉ[XX6fмk\?zWȯ`+M]7u|+k,⽁vjG珱:9I|qZAIyiU0eIpk'ѠN0c6y%.ybrļfQpZs^5n5̓"&y-y5 1[{{ ;D݆/CΡ)d8_I;#q&>W_ĬjL{ȦO7Zr!:wT_WLթ;}z鵗ޢo['):nC' ].$5y C{t]3ip\vnLM`tpJcĢ?q$fko8FO6FRMU߶9~>Bd!ahba:POQ$fT#bƦUhi[v*{^!,p o7K8vR:sNfS 6iP"K˯wV ]Z9kτ̉kg'̱a'5ЈzG>u5 bsv T,BǨgԵ ҵoQڣ}4~Tjر @|iוa(|}3v\( +{;&VƒL.KrOtr(0'1[{{[7uiJF䙷uo$bu~e95oӂ&}T&'Y=Ո^~鍷ޤy)O[;܎>sjҲ-\dp"!pW0ЛKkoq0L.G@s/aGЄY}׎p|9Įo2~l_Sp7/H8}4nGAt?7)z*՚ZiC"RܝtJ|ńR7i֥ԪO[ˏo?n{*obf.{@#:w9lwL-EYX$gP+0שB ,+y=6:* U&'Y=Ո-;KGjKkeԵw7YwGn)<1B'X1N4d#l^oP;md&Ξ̱CWy K 8E$u|['sͧ^~Bu׍$fk鿹M?C|OXi uדcGs'7[1[gJߪanb&N=hΖE4gЁLOk6VD i,ZB'7`oiNbV`G ][}%s6Xzz;yYIbVO5"fXU V->|N^?[l1hsr<;uDȀOI%/A ~hR]y Z4p+ - Oژ_݌Al-{ezz"oa lg}=v^K0 X>V7.^ޘñܸ;{ح` n4sNxlMI[m]RW. &k^'//LIbVOOZ|K\1v_W{. wc4tS9͠i4T7 o GAބ"Ƚ~9i(LmQޭ+ [ 5}T&'Y=c9w>0sl>c`VIP%Oa<@bq;SSeb3'1K昶6_ޤT]Emlq!oאzKő:bl: vvwHWǻQ_[MG!9u D^KOPSk8uѠ}CYr p,v/Ŏ Q$fT#b6TўmXYԹGWz-IY*p\44phAقY \X_p>y>sjrS;O\NI*Vt<{W{Y|Jb+A.ݟ;ϤS_{[>ޕylNRĬK_޵~Ϝļ3e7} Ʈ+ȥLR1`8/H,3y,FXDC~q4x0wD` ܶv$;ymgZk{nf=[& Bq5oLAF߳HUIbVO5&fZWPHL2O8Ǵ㡗[SBG"ALJ{ ty8˕χ*y Lq60^ S} g,HAD ,0 tqΖ-Xw!0lh>wsX17N@wBVM1U` zCVD<^ztrIuV<=jx[rIZ絞tl[JNz11gMҿfiXHtb~f%+.]9VW Y2oXL?cal?[ _5hB_qCs1rIbVO&36@.8 #,WT@ӜgM{XYL_~*@ٮ{MPXgK6XK&FQ.]r:*\(5٪b7d V5\ ~=Zo0wHbVOu&p%UA*1`j R?W_XϖW5Ib= .repeat-wrapper { margin-top: 0.28em; } .prodn-table .notation > .repeat-wrapper-with-sub { margin-top: 0.28em; margin-bottom: 0.28em; } .term-defn { font-style: italic; } .std-term { color: #2980B9; /* override if :visited */ } /* We can't display nested blocks otherwise */ code, .rst-content tt, .rst-content code { background: transparent !important; border: none !important; font-size: inherit !important; } code { padding: 0 !important; /* This padding doesn't make sense without a border */ } dt > .property { margin-right: 0.25em; } .icon-home:visited { color: #FFFFFF; } /* Pygments for Coq is confused by ‘…’ */ code span.error { background: inherit !important; line-height: inherit !important; margin-bottom: 0 !important; padding: 0 !important; } /* Red is too aggressive */ .rst-content tt.literal, .rst-content tt.literal, .rst-content code.literal { color: inherit !important; } .coqdoc-comment { color: #808080 !important } /* make the error message index readable */ .indextable code { white-space: inherit; /* break long lines */ } .indextable tr td + td { padding-left: 2em; /* indent 2nd & subsequent lines */ text-indent: -2em; } coq-8.20.0/doc/sphinx/_static/notations.js000066400000000000000000000031701466560755400204660ustar00rootroot00000000000000/************************************************************************/ /* * The Coq Proof Assistant / The Coq Development Team */ /* v * Copyright INRIA, CNRS and contributors */ /* sup") .attr("data-hint", function() { return annotateSup($(this).text()); }).addClass("hint--top hint--rounded"); $(".repeat-wrapper > sub") .attr("data-hint", function() { return annotateSub($(this).text()); }).addClass("hint--bottom hint--rounded"); //.text(function(i, text) { return translatePunctuation(text); }); } $(annotateNotations); coq-8.20.0/doc/sphinx/_static/pre-text.css000066400000000000000000000017671466560755400204060ustar00rootroot00000000000000/************************************************************************/ /* * The Coq Proof Assistant / The Coq Development Team */ /* v * Copyright INRIA, CNRS and contributors */ /* Other versions v: {{ version }} {% endif %} coq-8.20.0/doc/sphinx/addendum/000077500000000000000000000000001466560755400162445ustar00rootroot00000000000000coq-8.20.0/doc/sphinx/addendum/canonical-structures.rst000066400000000000000000000001561466560755400231500ustar00rootroot00000000000000:orphan: .. raw:: html coq-8.20.0/doc/sphinx/addendum/extended-pattern-matching.rst000066400000000000000000000001521466560755400240370ustar00rootroot00000000000000:orphan: .. raw:: html coq-8.20.0/doc/sphinx/addendum/extraction.rst000066400000000000000000000770551466560755400211740ustar00rootroot00000000000000.. _extraction: Program extraction ================== :Authors: Jean-Christophe Filliâtre and Pierre Letouzey We present here the Coq extraction commands, used to build certified and relatively efficient functional programs, extracting them from either Coq functions or Coq proofs of specifications. The functional languages available as output are currently OCaml, Haskell and Scheme. In the following, "ML" will be used (abusively) to refer to any of the three. .. versionchanged:: 8.11 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``. .. coqtop:: in Require Extraction. Generating ML Code ------------------- .. note:: In the following, a qualified identifier :token:`qualid` can be used to refer to any kind of Coq global "object" : :term:`constant`, inductive type, inductive constructor or module name. .. cmd:: Extraction @qualid Recursive Extraction {+ @qualid } Extraction @string {+ @qualid } The first two forms display the extracted term(s) in Coq as a convenient preview of the extracted term(s): - the first form extracts :n:`@qualid` and displays the resulting term; - the second form extracts the listed :n:`@qualid`\s and all their dependencies, and displays the resulting terms. The third form produces a single extraction file named :n:`@string` for all the specified objects and all of their dependencies. Global and local identifiers are renamed as needed to fulfill the syntactic requirements of the target language, keeping original names as much as possible. The following commands also generate file(s). The generated file(s) are produced in the current working directory. It is possible to inspect what is the current directory with the command :cmd:`Pwd` and to change it with the command :cmd:`Cd`. .. cmd:: Extraction Library @ident Extraction of the whole Coq library :n:`@ident.v` to an ML module :n:`@ident.ml`. In case of name clash, identifiers are here renamed using prefixes ``coq_`` or ``Coq_`` to ensure a session-independent renaming. .. cmd:: Recursive Extraction Library @ident Extraction of the Coq library :n:`@ident.v` and all other modules :n:`@ident.v` depends on. .. cmd:: Separate Extraction {+ @qualid } 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 ``.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. 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_``. The following command is meant to help automatic testing of the extraction, see for instance the ``test-suite`` directory in the Coq sources. .. cmd:: Extraction TestCompile {+ @qualid } All the mentioned objects and all their dependencies are extracted to a temporary OCaml file, just as in ``Extraction "file"``. Then this temporary file and its signature are compiled with the same OCaml compiler used to built Coq. This command succeeds only if the extraction and the OCaml compilation succeed. It fails if the current target language of the extraction is not OCaml. .. cmd:: Show Extraction :undocumented: .. cmd:: Pwd This command displays the current working directory (where the extracted files are produced). .. cmd:: Cd {? @string } .. deprecated:: 8.20 Use the command line option :n:`-output-directory` instead (see :ref:`command-line-options`), or the :opt:`Extraction Output Directory` option. If :n:`@string` is specified, changes the current directory according to :token:`string` which can be any valid path. Otherwise, it displays the current directory as :cmd:`Pwd` does. Extraction Options ------------------- Setting the target language ~~~~~~~~~~~~~~~~~~~~~~~~~~~ .. cmd:: Extraction Language @language .. 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: it contains the raw ML term produced as an intermediary target. Inlining and optimizations ~~~~~~~~~~~~~~~~~~~~~~~~~~~ Since OCaml is a strict language, the extracted code has to be optimized in order to be efficient (for instance, when using induction principles we do not want to compute all the recursive calls but only the needed ones). So the extraction mechanism provides an automatic optimization routine that will be called each time the user wants to generate an OCaml program. The optimizations can be split in two groups: the type-preserving ones (essentially constant inlining and reductions) and the non-type-preserving ones (some function abstractions of dummy types are removed when it is deemed safe in order to have more elegant types). Therefore some :term:`constants ` may not appear in the resulting monolithic OCaml program. In the case of modular extraction, even if some inlining is done, the inlined constants are nevertheless printed, to ensure session-independent programs. Concerning Haskell, type-preserving optimizations are less useful because of laziness. We still make some optimizations, for example in order to produce more readable code. The type-preserving optimizations are controlled by the following Coq flags and commands: .. flag:: Extraction Optimize Default is on. This :term:`flag` 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. .. flag:: Extraction Conservative Types Default is off. This :term:`flag` controls the non-type-preserving optimizations made on ML terms (which try to avoid function abstraction of dummy types). Turn this flag on to make sure that ``e:t`` implies that ``e':t'`` where ``e'`` and ``t'`` are the extracted code of ``e`` and ``t`` respectively. .. flag:: Extraction KeepSingleton Default is off. Normally, when the extraction of an inductive type produces a singleton type (i.e. a type with only one constructor, and only one argument to this constructor), the inductive structure is removed and this type is seen as an alias to the inner type. The typical example is ``sig``. This :term:`flag` allows disabling this optimization when one wishes to preserve the inductive structure of types. .. flag:: Extraction AutoInline Default is off. When enabled, the extraction mechanism inlines the :term:`bodies ` of some defined :term:`constants `, according to some heuristics like size of bodies, uselessness of some arguments, etc. Even when this flag is off, recursors (`_rect` and `_rec` schemes, such as `nat_rect`), projections, and a few specific constants such as `andb` and `orb` (for the lazy behaviour) and well founded recursion combinators are still automatically inlined. .. cmd:: Extraction Inline {+ @qualid } In addition to the automatic inline feature, the :term:`constants ` mentioned by this command will always be inlined during extraction. .. cmd:: Extraction NoInline {+ @qualid } Conversely, the constants mentioned by this command will never be inlined during extraction. .. cmd:: Print Extraction Inline Prints the current state of the table recording the custom inlinings declared by the two previous commands. .. cmd:: Reset Extraction Inline Empties the table recording the custom inlinings (see the previous commands). **Inlining and printing of a constant declaration:** The user can explicitly ask for a :term:`constant` to be extracted by two means: * by mentioning it on the extraction command line * by extracting the whole Coq module of this :term:`constant`. In both cases, the declaration of this :term:`constant` will be present in the produced file. But this same :term:`constant` may or may not be inlined in the following terms, depending on the automatic/custom inlining mechanism. For the :term:`constants ` non-explicitly required but needed for dependency reasons, there are two cases: * If an inlining decision is taken, whether automatically or not, all occurrences of this :term:`constant` are replaced by its extracted :term:`body`, and this :term:`constant` is not declared in the generated file. * If no inlining decision is taken, the :term:`constant` is normally declared in the produced file. Extra elimination of useless arguments ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ The following command provides some extra manual control on the 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 | @integer } } ] 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 if any of the implicit arguments still occurs in the final code. This behavior can be relaxed via the following flag: .. flag:: Extraction SafeImplicits Default is on. When this :term:`flag` is off, a warning is emitted instead of an error if some implicit arguments still occur in the final code of an extraction. This way, the extracted code may be obtained nonetheless and reviewed manually to locate the source of the issue (in the code, some comments mark the location of these remaining implicit arguments). Note that this extracted code might not compile or run properly, depending of the use of these remaining implicit arguments. Realizing axioms ~~~~~~~~~~~~~~~~ Extraction will fail if it encounters an informative axiom not realized. A warning will be issued if it encounters a logical axiom, to remind the user that inconsistent logical axioms may lead to incorrect or non-terminating extracted terms. It is possible to assume some axioms while developing a proof. Since these axioms can be any kind of proposition or object or type, they may perfectly well have some computational content. But a program must be 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__tv } => {| @ident | @string } Give an ML extraction for the given :term:`constant`. :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 ". .. note:: The extraction recognizes whether the realized axiom should become a ML type constant or a ML object declaration. For example: .. coqtop:: in Axiom X:Set. Axiom x:X. Extract Constant X => "int". Extract Constant x => "0". .. caution:: It is the responsibility of the user to ensure that the ML terms given to realize the axioms do have the expected types. In fact, the strings containing realizing code are just copied to the extracted files. .. 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``. .. note:: This command is sugar for an :cmd:`Extract Constant` followed by a :cmd:`Extraction Inline`. Hence a :cmd:`Reset Extraction Inline` will have an effect on the realized and inlined axiom. .. exn:: The term @qualid is already defined as foreign custom constant. The :n:`@qualid` was previously used in a :cmd:`Extract Foreign Constant` command. Using :cmd:`Extract Inlined Constant` for :n:`@qualid` would override this command. 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 terms. But a warning is nonetheless issued if extraction encounters a logical axiom. This warning reminds user that inconsistent logical axioms may lead to incorrect or non-terminating extracted terms. If an informative axiom has not been realized before an extraction, a warning is also issued and the definition of the axiom is filled with an exception labeled ``AXIOM TO BE REALIZED``. The user must then search these exceptions inside the extracted file and replace them by real code. Realizing inductive types ~~~~~~~~~~~~~~~~~~~~~~~~~ The system also provides a mechanism to specify ML terms for inductive types and constructors. For instance, the user may want to use the ML native boolean type instead of the Coq one. The syntax is the following: .. 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 (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 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. :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: * The ML code provided by the user is currently **not** checked at all by extraction, even for syntax errors. * Extracting an inductive type to a pre-existing ML inductive type is quite sound. But extracting to a general type (by providing an ad-hoc pattern matching) will often **not** be fully rigorously correct. For instance, when extracting ``nat`` to OCaml ``int``, it is theoretically possible to build ``nat`` values that are larger than OCaml ``max_int``. It is the user's responsibility to be sure that no overflow or other bad events occur in practice. * Translating an inductive type to an arbitrary ML type does **not** magically improve the asymptotic complexity of functions, even if the ML type is an efficient representation. For instance, when extracting ``nat`` to OCaml ``int``, the function ``Nat.mul`` stays quadratic. It might be interesting to associate this translation with some specific :cmd:`Extract Constant` when primitive counterparts exist. Typical examples are the following: .. coqtop:: in Extract Inductive unit => "unit" [ "()" ]. Extract Inductive bool => "bool" [ "true" "false" ]. Extract Inductive sumbool => "bool" [ "true" "false" ]. .. note:: When extracting to OCaml, if an inductive constructor or type has arity 2 and the corresponding string is enclosed by parentheses, and the string meets OCaml's lexical criteria for an infix symbol, then the rest of the string is used as an infix constructor or type. .. coqtop:: in Extract Inductive list => "list" [ "[]" "(::)" ]. Extract Inductive prod => "(*)" [ "(,)" ]. As an example of translation to a non-inductive datatype, let's turn ``nat`` into OCaml ``int`` (see caveat above): .. coqtop:: in Extract Inductive nat => int [ "0" "succ" ] "(fun fO fS n -> if n=0 then fO () else fS (n-1))". Generating FFI Code ~~~~~~~~~~~~~~~~~~~ The plugin provides mechanisms to generate only OCaml code to interface the generated OCaml code with C programs. In order to link compiled OCaml code with C code, the linker needs to know * which C functions will be called by the ML code (external) * which ML functions shall be accessible by the C code (callbacks) .. cmd:: Extract Foreign Constant @qualid => @string Like :cmd:`Extract Constant`, except that the referenced ML terms will be declared in the form ``external`` :n:`@qualid` ``: ML type =`` ":n:`@string`". For example: .. coqtop:: in Require Extraction. Require Coq.extraction.ExtrOcamlNatInt. Axiom f : nat -> nat -> nat. Extract Foreign Constant f => "f_impl". Here, the extracted external definition will be: ``external f : int -> int -> int = "f_impl"`` .. caution:: * The external function name :n:`@string` is not checked in any way. * The user must ensure that the C functions given to realize the axioms have the expected or compatible types. In fact, the strings containing realizing code are just copied to the extracted files. .. exn:: Extract Foreign Constant is supported only for OCaml extraction. Foreign function calls are only supported for OCaml. .. exn:: Extract Foreign Constant is supported only for functions. This error is thrown if :n:`@qualid` is of sort ``Type`` as external functions only work for functions. .. exn:: The term @qualid is already defined as inline custom constant. The :n:`@qualid` was previously used in a :cmd:`Extract Inlined Constant` command. Using :cmd:`Extract Foreign Constant` for :n:`@qualid` would override this command. .. cmd:: Extract Callback {? @string } @qualid This command makes sure that after extracting the :term:`constants ` specified by :n:`@qualid`, a constant ML function will be generated that registers :n:`@qualid` as callback, callable by :n:`@string`. This is done by declaring a function ``let _ = Callback.register`` ":n:`@string`" :n:`@qualid`. This expression signals OCaml that the given ML function :n:`@qualid` shall be accessible via the alias :n:`@string`, when calling from C/C++. If no alias is specified, it is set to the string representation of :n:`@qualid`. .. caution:: * The optional alias :n:`@string` is currently **not** checked in any way. * The user must ensure that the callback aliases are unique, i.e. when multiple modules expose a callback, the user should make sure that no two :n:`@qualid` share the same alias. .. note:: Using Extract Callback has no impact on the rest of the synthesised code since it is an additional declaration. Thus, there is no impact on the correctness and type safety of the generated code. .. exn:: Extract Callback is supported only for OCaml extraction. The callback registration mechanism ``Callback.register`` is specific to OCaml. Thus, the command is only usable when extracting OCaml code. .. cmd:: Print Extraction Foreign Prints the current set of custom foreign functions declared by the command :cmd:`Extract Foreign Constant` together with its associated foreign ML function name. .. .. cmd:: Reset Extraction Foreign .. Resets the set of custom externals .. declared by the command :cmd:`Extract Foreign Constant`. .. cmd:: Print Extraction Callback Prints the map of callbacks declared by the command :cmd:`Extract Callback`, showing the :token:`qualid` and callback alias :token:`string` (if specified) for each callback. .. cmd:: Reset Extraction Callback Resets the the map recording the callbacks declared by the command :cmd:`Extract Callback`. Avoiding conflicts with existing filenames ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ When using :cmd:`Extraction Library`, the names of the extracted files directly depend on the names of the Coq files. It may happen that these filenames are in conflict with already existing files, either in the standard library of the target language or in other code that is meant to be linked with the extracted code. For instance the module ``List`` exists both in Coq and in OCaml. It is possible to instruct the extraction not to use particular filenames. .. cmd:: Extraction Blacklist {+ @ident } Instruct the extraction to avoid using these names as filenames for extracted code. .. cmd:: Print Extraction Blacklist Show the current list of filenames the extraction should avoid. .. cmd:: Reset Extraction Blacklist Allow the extraction to use any filename. For OCaml, a typical use of these commands is ``Extraction Blacklist String List``. Additional settings ~~~~~~~~~~~~~~~~~~~ .. opt:: Extraction File Comment @string This :term:`option` provides a comment that is included at the beginning of the output files. .. opt:: Extraction Flag @natural This :term:`option` 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. Values are: +-----+-------+----------------------------------------------------------------+ | Bit | Value | Optimization (default is on unless noted otherwise) | +-----+-------+----------------------------------------------------------------+ | 0 | 1 | Remove local dummy variables | +-----+-------+----------------------------------------------------------------+ | 1 | 2 | Use special treatment for fixpoints | +-----+-------+----------------------------------------------------------------+ | 2 | 4 | Simplify case with iota-redux | +-----+-------+----------------------------------------------------------------+ | 3 | 8 | Factor case branches as functions | +-----+-------+----------------------------------------------------------------+ | 4 | 16 | (not available, default false) | +-----+-------+----------------------------------------------------------------+ | 5 | 32 | Simplify case as function of one argument | +-----+-------+----------------------------------------------------------------+ | 6 | 64 | Simplify case by swapping case and lambda | +-----+-------+----------------------------------------------------------------+ | 7 | 128 | Some case optimization | +-----+-------+----------------------------------------------------------------+ | 8 | 256 | Push arguments inside a letin | +-----+-------+----------------------------------------------------------------+ | 9 | 512 | Use linear let reduction (default false) | +-----+-------+----------------------------------------------------------------+ | 10 | 1024 | Use linear beta reduction (default false) | +-----+-------+----------------------------------------------------------------+ .. flag:: Extraction TypeExpand If this :term:`flag` is set, fully expand Coq types in ML. See the Coq source code to learn more. .. opt:: Extraction Output Directory @string Sets the directory where extracted files will be written. If not set, files will be written to the directory specified by the command line option :n:`-output-directory`, if set (see :ref:`command-line-options`) and otherwise, the current directory. Use :cmd:`Pwd` to display the current directory. Differences between Coq and ML type systems ---------------------------------------------- Due to differences between Coq and ML type systems, some extracted programs are not directly typable in ML. We now solve this problem (at least in OCaml) by adding when needed some unsafe casting ``Obj.magic``, which give a generic type ``'a`` to any term. First, if some part of the program is *very* polymorphic, there may be no ML type for it. In that case the extraction to ML works alright but the generated code may be refused by the ML type checker. A very well known example is the ``distr-pair`` function: .. coqtop:: in Definition dp {A B:Type}(x:A)(y:B)(f:forall C:Type, C->C) := (f A x, f B y). In OCaml, for instance, the direct extracted term would be:: let dp x y f = Pair((f () x),(f () y)) and would have type:: dp : 'a -> 'a -> (unit -> 'a -> 'b) -> ('b,'b) prod which is not its original type, but a restriction. We now produce the following correct version:: let dp x y f = Pair ((Obj.magic f () x), (Obj.magic f () y)) Secondly, some Coq definitions may have no counterpart in ML. This happens when there is a quantification over types inside the type of a constructor; for example: .. coqtop:: in Inductive anything : Type := dummy : forall A:Set, A -> anything. which corresponds to the definition of an ML dynamic type. In OCaml, we must cast any argument of the constructor dummy (no GADT are produced yet by the extraction). 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 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). 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 type checker without any ``Obj.magic`` (see examples below). Some examples ------------- We present here two examples of extraction, taken from the Coq Standard Library. We choose OCaml as the target language, but everything, with slight modifications, can also be done in the other languages supported by extraction. We then indicate where to find other examples and tests of extraction. A detailed example: Euclidean division ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ The file ``Euclid`` contains the proof of Euclidean division. The natural numbers used here are unary, represented by the type ``nat``, which is defined by two constructors ``O`` and ``S``. This module contains a theorem ``eucl_dev``, whose type is:: forall b:nat, b > 0 -> forall a:nat, diveucl a b where ``diveucl`` is a type for the pair of the quotient and the modulo, plus some logical assertions that disappear during extraction. We can now extract this program to OCaml: .. coqtop:: reset all Require Extraction. Require Import Euclid Wf_nat. Extraction Inline gt_wf_rec lt_wf_rec induction_ltof2. Recursive Extraction eucl_dev. The inlining of ``gt_wf_rec`` and others is not mandatory. It only enhances readability of extracted code. You can then copy-paste the output to a file ``euclid.ml`` or let Coq do it for you with the following command:: Extraction "euclid" eucl_dev. Let us play the resulting program (in an OCaml toplevel):: #use "euclid.ml";; type nat = O | S of nat type sumbool = Left | Right val sub : nat -> nat -> nat = val le_lt_dec : nat -> nat -> sumbool = val le_gt_dec : nat -> nat -> sumbool = type diveucl = Divex of nat * nat val eucl_dev : nat -> nat -> diveucl = # eucl_dev (S (S O)) (S (S (S (S (S O)))));; - : diveucl = Divex (S (S O), S O) It is easier to test on OCaml integers:: # let rec nat_of_int = function 0 -> O | n -> S (nat_of_int (n-1));; val nat_of_int : int -> nat = # let rec int_of_nat = function O -> 0 | S p -> 1+(int_of_nat p);; val int_of_nat : nat -> int = # let div a b = let Divex (q,r) = eucl_dev (nat_of_int b) (nat_of_int a) in (int_of_nat q, int_of_nat r);; val div : int -> int -> int * int = # div 173 15;; - : int * int = (11, 8) Note that these ``nat_of_int`` and ``int_of_nat`` are now available via a mere ``Require Import ExtrOcamlIntConv`` and then adding these functions to the list of functions to extract. This file ``ExtrOcamlIntConv.v`` and some others in ``plugins/extraction/`` are meant to help building concrete program via extraction. Extraction's horror museum ~~~~~~~~~~~~~~~~~~~~~~~~~~ Some pathological examples of extraction are grouped in the file ``test-suite/success/extraction.v`` of the sources of Coq. Users' Contributions ~~~~~~~~~~~~~~~~~~~~ Several of the Coq Users' Contributions use extraction to produce certified programs. In particular the following ones have an automatic extraction test: * ``additions`` : https://github.com/coq-contribs/additions * ``bdds`` : https://github.com/coq-contribs/bdds * ``canon-bdds`` : https://github.com/coq-contribs/canon-bdds * ``chinese`` : https://github.com/coq-contribs/chinese * ``continuations`` : https://github.com/coq-contribs/continuations * ``coq-in-coq`` : https://github.com/coq-contribs/coq-in-coq * ``exceptions`` : https://github.com/coq-contribs/exceptions * ``firing-squad`` : https://github.com/coq-contribs/firing-squad * ``founify`` : https://github.com/coq-contribs/founify * ``graphs`` : https://github.com/coq-contribs/graphs * ``higman-cf`` : https://github.com/coq-contribs/higman-cf * ``higman-nw`` : https://github.com/coq-contribs/higman-nw * ``hardware`` : https://github.com/coq-contribs/hardware * ``multiplier`` : https://github.com/coq-contribs/multiplier * ``search-trees`` : https://github.com/coq-contribs/search-trees * ``stalmarck`` : https://github.com/coq-contribs/stalmarck Note that ``continuations`` and ``multiplier`` are a bit particular. They are examples of developments where ``Obj.magic`` is needed. This is probably due to a heavy use of impredicativity. After compilation, those two examples run nonetheless, thanks to the correction of the extraction :cite:`Let02`. coq-8.20.0/doc/sphinx/addendum/generalized-rewriting.rst000066400000000000000000001215501466560755400233030ustar00rootroot00000000000000.. _generalizedrewriting: Generalized rewriting ===================== :Author: Matthieu Sozeau This chapter presents the extension of several equality related tactics to work over user-defined structures (called setoids) that are equipped with ad-hoc equivalence relations meant to behave as equalities. Actually, the tactics have also been generalized to relations weaker than equivalences (e.g. rewriting systems). The toolbox also extends the automatic rewriting capabilities of the system, allowing the specification of custom strategies for rewriting. This documentation is adapted from the previous setoid documentation by Claudio Sacerdoti Coen (based on previous work by Clément Renard). The new implementation is a drop-in replacement for the old one [#tabareau]_, hence most of the documentation still applies. The work is a complete rewrite of the previous implementation, based on the typeclass infrastructure. It also improves on and generalizes the previous implementation in several ways: + User-extensible algorithm. The algorithm is separated into two parts: generation of the rewriting constraints (written in ML) and solving these constraints using typeclass resolution. As typeclass resolution is extensible using tactics, this allows users to define general ways to solve morphism constraints. + Subrelations. An example extension to the base algorithm is the ability to define one relation as a subrelation of another so that morphism declarations on one relation can be used automatically for the other. This is done purely using tactics and typeclass search. + Rewriting under binders. It is possible to rewrite under binders in the new implementation, if one provides the proper morphisms. Again, most of the work is handled in the tactics. + First-class morphisms and signatures. Signatures and morphisms are 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 the first solution to a set of constraints which can be as fast as linear in the size of the term, and the size of the proof term is linear in the size of the original term. Besides, the extensibility allows the user to customize the proof search if necessary. .. [#tabareau] Nicolas Tabareau helped with the gluing. Introduction to generalized rewriting ------------------------------------- Relations and morphisms ~~~~~~~~~~~~~~~~~~~~~~~ A parametric *relation* ``R`` is any term of type ``forall (x1 : T1) ... (xn : Tn), relation A``. The expression ``A``, which depends on ``x1 ... xn`` , is called the *carrier* of the relation and ``R`` is said to be a relation over ``A``; the list ``x1,...,xn`` is the (possibly empty) list of parameters of the relation. .. example:: Parametric relation It is possible to implement finite sets of elements of type ``A`` as unordered lists of elements of type ``A``. The function ``set_eq: forall (A : Type), relation (list A)`` satisfied by two lists with the same elements is a parametric relation over ``(list A)`` with one parameter ``A``. The type of ``set_eq`` is convertible with ``forall (A : Type), list A -> list A -> Prop.`` An *instance* of a parametric relation ``R`` with n parameters is any term ``(R t1 ... tn)``. Let ``R`` be a relation over ``A`` with ``n`` parameters. A term is a parametric proof of reflexivity for ``R`` if it has type ``forall (x1 : T1) ... (xn : Tn), reflexive (R x1 ... xn)``. Similar definitions are given for parametric proofs of symmetry and transitivity. .. example:: Parametric relation (continued) The ``set_eq`` relation of the previous example can be proved to be reflexive, symmetric and transitive. A parametric unary function ``f`` of type ``forall (x1 : T1) ... (xn : Tn), A1 -> A2`` covariantly respects two parametric relation instances ``R1`` and ``R2`` if, whenever ``x``, ``y`` satisfy ``R1 x y``, their images (``f x``) and (``f y``) satisfy ``R2 (f x) (f y)``. An ``f`` that respects its input and output relations will be called a unary covariant *morphism*. We can also say that ``f`` is a monotone function with respect to ``R1`` and ``R2`` . The sequence ``x1 ... xn`` represents the parameters of the morphism. Let ``R1`` and ``R2`` be two parametric relations. The *signature* of a parametric morphism of type ``forall (x1 : T1) ... (xn : Tn), A1 -> A2`` that covariantly respects two instances :math:`I_{R_1}` and :math:`I_{R_2}` of ``R1`` and ``R2`` is written :math:`I_{R_1} ++> I_{R_2}`. Notice that the special arrow ++>, which reminds the reader of covariance, is placed between the two relation instances, not between the two carriers. The signature relation instances and morphism will be typed in a context introducing variables for the parameters. The previous definitions are extended straightforwardly to n-ary morphisms, that are required to be simultaneously monotone on every argument. Morphisms can also be contravariant in one or more of their arguments. A morphism is contravariant on an argument associated with 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 ``-->`` is used in signatures for contravariant morphisms. Functions having arguments related by symmetric relations instances are both covariant and contravariant in those arguments. The special arrow ``==>`` is used in signatures for morphisms that are both covariant and contravariant. An instance of a parametric morphism :math:`f` with :math:`n` parameters is any term :math:`f \, t_1 \ldots t_n`. .. example:: Morphisms Continuing the previous example, let ``union: forall (A : Type), list A -> list A -> list A`` perform the union of two sets by appending one list to the other. ``union`` is a binary morphism parametric over ``A`` that respects the relation instance ``(set_eq A)``. The latter condition is proved by showing: .. coqdoc:: forall (A: Type) (S1 S1' S2 S2': list A), set_eq A S1 S1' -> set_eq A S2 S2' -> set_eq A (union A S1 S2) (union A S1' S2'). The signature of the function ``union A`` is ``set_eq A ==> set_eq A ==> set_eq A`` for all ``A``. .. example:: Contravariant morphisms The division function ``Rdiv : R -> R -> R`` is a morphism of signature ``le ++> le --> le`` where ``le`` is the usual order relation over real numbers. Notice that division is covariant in its first argument and contravariant in its second argument. Leibniz equality is a relation and every function is a morphism that respects Leibniz equality. Unfortunately, Leibniz equality is not always the intended equality for a given structure. In the next section we will describe the commands to register terms as parametric relations and morphisms. Several tactics that deal with equality in Coq can also work with the registered relations. The exact list of tactics will be given :ref:`in this section `. For instance, the tactic reflexivity can be used to solve a goal ``R n n`` whenever ``R`` is an instance of a registered reflexive relation. However, the tactics that replace in a context ``C[]`` one term with another one related by ``R`` must verify that ``C[]`` is a morphism that respects the intended relation. Currently the verification consists of checking whether ``C[]`` is a syntactic composition of morphism instances that respects some obvious compatibility constraints. .. example:: Rewriting Continuing the previous examples, suppose that the user must prove ``set_eq int (union int (union int S1 S2) S2) (f S1 S2)`` under the hypothesis ``H : set_eq int S2 (@nil int)``. It is possible to use the ``rewrite`` tactic to replace the first two occurrences of ``S2`` with ``@nil int`` in the goal since the context ``set_eq int (union int (union int S1 nil) nil) (f S1 S2)``, being a composition of morphisms instances, is a morphism. However the tactic will fail replacing the third occurrence of ``S2`` unless ``f`` has also been declared as a morphism. Adding new relations and morphisms ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ These commands support the :attr:`local` and :attr:`global` locality attributes. The default is :attr:`local` if the command is used inside a section, :attr:`global` otherwise. They also support the :attr:`universes(polymorphic)` attributes. .. 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 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 lemmas used internally. Notice that the carrier and relation parameters may refer to the context of variables introduced at the beginning of the declaration, but the instances need not be made only of variables. Also notice that ``A`` is *not* required to be a term having the same parameters as ``Aeq``, although that is often the case in practice (this departs from the previous implementation). To use this command, you need to first import the module ``Setoid`` using the command ``Require Import Setoid``. .. cmd:: Add Relation @one_term @one_term {? reflexivity proved by @one_term } {? symmetry proved by @one_term } {? transitivity proved by @one_term } as @ident 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)`. Each proof may refer to the introduced variables as well. .. example:: Parametric relation For Leibniz equality, we may declare: .. coqdoc:: Add Parametric Relation (A : Type) : A (@eq A) [reflexivity proved by @refl_equal A] ... Some tactics (:tacn:`reflexivity`, :tacn:`symmetry`, :tacn:`transitivity`) work only on relations that respect the expected properties. The remaining tactics (:tacn:`replace`, :tacn:`rewrite` and derived tactics such as :tacn:`autorewrite`) do not require any properties over the relation. However, they are able to replace terms with related ones only in contexts that are syntactic compositions of parametric morphism instances declared with the following command. .. cmd:: Add Parametric Morphism {* @binder } : @one_term with signature @term as @ident 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 the signature may refer to the context of variables. The command asks the user to prove interactively that the function denoted by the first :token:`ident` respects the relations identified from the signature. .. example:: We start the example by assuming a small theory over homogeneous sets and we declare set equality as a parametric equivalence relation and union of two sets as a parametric morphism. .. coqtop:: in Require Export Setoid. Require Export Relation_Definitions. Set Implicit Arguments. Parameter set : Type -> Type. Parameter empty : forall A, set A. Parameter eq_set : forall A, set A -> set A -> Prop. Parameter union : forall A, set A -> set A -> set A. Axiom eq_set_refl : forall A, reflexive _ (eq_set (A:=A)). Axiom eq_set_sym : forall A, symmetric _ (eq_set (A:=A)). Axiom eq_set_trans : forall A, transitive _ (eq_set (A:=A)). Axiom empty_neutral : forall A (S : set A), eq_set (union S (empty A)) S. Axiom union_compat : forall (A : Type), forall x x' : set A, eq_set x x' -> forall y y' : set A, eq_set y y' -> eq_set (union x y) (union x' y'). Add Parametric Relation A : (set A) (@eq_set A) reflexivity proved by (eq_set_refl (A:=A)) symmetry proved by (eq_set_sym (A:=A)) transitivity proved by (eq_set_trans (A:=A)) as eq_set_rel. Add Parametric Morphism A : (@union A) with signature (@eq_set A) ==> (@eq_set A) ==> (@eq_set A) as union_mor. Proof. exact (@union_compat A). Qed. It is possible to reduce the burden of specifying parameters using (maximally inserted) implicit arguments. If ``A`` is always set as maximally implicit in the previous example, one can write: .. coqdoc:: Add Parametric Relation A : (set A) eq_set reflexivity proved by eq_set_refl symmetry proved by eq_set_sym transitivity proved by eq_set_trans as eq_set_rel. Add Parametric Morphism A : (@union A) with signature eq_set ==> eq_set ==> eq_set as union_mor. Proof. exact (@union_compat A). Qed. We proceed now by proving a simple lemma performing a rewrite step and then applying reflexivity, as we would do working with Leibniz equality. Both tactic applications are accepted since the required properties over ``eq_set`` and ``union`` can be established from the two declarations above. .. coqtop:: in Goal forall (S : set nat), eq_set (union (union S (empty nat)) S) (union S S). .. coqtop:: in Proof. intros. rewrite empty_neutral. reflexivity. Qed. The tables of relations and morphisms are managed by the typeclass instance mechanism. The behavior on section close is to generalize the instances by the variables of the section (and possibly hypotheses used in the proofs of instance declarations) but not to export them in the rest of the development for proof search. One can use the cmd:`Existing Instance` command to do so outside the section, using the name of the declared morphism suffixed by ``_Morphism``, or use the ``Global`` modifier for the corresponding class instance declaration (see :ref:`First Class Setoids and Morphisms `) at definition time. When loading a compiled file or importing a module, all the declarations of this module will be loaded. Rewriting and nonreflexive relations ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ To replace only one argument of an n-ary morphism it is necessary to prove that all the other arguments are related to themselves by the respective relation instances. .. example:: To replace ``(union S empty)`` with ``S`` in ``(union (union S empty) S) (union S S)`` the rewrite tactic must exploit the monotony of ``union`` (axiom ``union_compat`` in the previous example). Applying ``union_compat`` by hand we are left with the goal ``eq_set (union S S) (union S S)``. When the relations associated with some arguments are not reflexive, the tactic cannot automatically prove the reflexivity goals, that are left to the user. Setoids whose relations are partial equivalence relations (PER) are useful for dealing with partial functions. Let ``R`` be a PER. We say that an element ``x`` is defined if ``R x x``. A partial function whose domain comprises all the defined elements is declared as a morphism that respects ``R``. Every time a rewriting step is performed the user must prove that the argument of the morphism is defined. .. example:: Let ``eqO`` be ``fun x y => x = y /\ x <> 0`` (the smallest PER over nonzero elements). Division can be declared as a morphism of signature ``eq ==> eq0 ==> eq``. Replacing ``x`` with ``y`` in ``div x n = div y n`` opens an additional goal ``eq0 n n`` which is equivalent to ``n = n /\ n <> 0``. Rewriting and nonsymmetric relations ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ When the user works up to relations that are not symmetric, it is no longer the case that any covariant morphism argument is also contravariant. As a result it is no longer possible to replace a term with a related one in every context, since the obtained goal implies the previous one if and only if the replacement has been performed in a contravariant position. In a similar way, replacement in an hypothesis can be performed only if the replaced term occurs in a covariant position. .. example:: Covariance and contravariance Suppose that division over real numbers has been defined as a morphism of signature ``Z.div : Z.lt ++> Z.lt --> Z.lt`` (i.e. ``Z.div`` is increasing in its first argument, but decreasing on the second one). Let ``<`` denote ``Z.lt``. Under the hypothesis ``H : x < y`` we have ``k < x / y -> k < x / x``, but not ``k < y / x -> k < x / x``. Dually, under the same hypothesis ``k < x / y -> k < y / y`` holds, but ``k < y / x -> k < y / y`` does not. Thus, if the current goal is ``k < x / x``, it is possible to replace only the second occurrence of ``x`` (in contravariant position) with ``y`` since the obtained goal must imply the current one. On the contrary, if ``k < x / x`` is an hypothesis, it is possible to replace only the first occurrence of ``x`` (in covariant position) with ``y`` since the current hypothesis must imply the obtained one. Contrary to the previous implementation, no specific error message will be raised when trying to replace a term that occurs in the wrong position. It will only fail because the rewriting constraints are not satisfiable. However it is possible to use the at modifier to specify which occurrences should be rewritten. As expected, composing morphisms together propagates the variance annotations by switching the variance every time a contravariant position is traversed. .. example:: Let us continue the previous example and let us consider the goal ``x / (x / x) < k``. The first and third occurrences of ``x`` are in a contravariant position, while the second one is in covariant position. More in detail, the second occurrence of ``x`` occurs covariantly in ``(x / x)`` (since division is covariant in its first argument), and thus contravariantly in ``x / (x / x)`` (since division is contravariant in its second argument), and finally covariantly in ``x / (x / x) < k`` (since ``<``, as every transitive relation, is contravariant in its first argument with respect to the relation itself). Rewriting in ambiguous setoid contexts ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ One function can respect several different relations and thus it can be declared as a morphism having multiple signatures. .. example:: Union over homogeneous lists can be given all the following signatures: ``eq ==> eq ==> eq`` (``eq`` being the equality over ordered lists) ``set_eq ==> set_eq ==> set_eq`` (``set_eq`` being the equality over unordered lists up to duplicates), ``multiset_eq ==> multiset_eq ==> multiset_eq`` (``multiset_eq`` being the equality over unordered lists). To declare multiple signatures for a morphism, repeat the :cmd:`Add Morphism` command. When morphisms have multiple signatures it can be the case that a rewrite request is ambiguous, since it is unclear what relations should be used to perform the rewriting. Contrary to the previous implementation, the tactic will always choose the first possible solution to the set of constraints generated by a rewrite and will not try to find *all* the possible solutions to warn the user about them. Rewriting with ``Type`` valued relations ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Definitions in ``Classes.Relations``, ``Classes.Morphisms`` and ``Classes.Equivalence`` are based on ``Prop``. Analogous definitions with the same names based on ``Type`` are in ``Classes.CRelations``, ``Classes.CMorphisms`` and ``Classes.CEquivalence``. The ``C`` identifies the "computational" versions. Importing these modules allows for generalized rewriting with relations of the form ``R : A -> A -> Type`` together with support for universe polymorphism. Declaring rewrite relations --------------------------- The ``RewriteRelation A R`` typeclass, indexed by a type and relation, registers relations that generalized rewriting handles. The default instances of this class are the ``iff```, ``impl`` and ``flip impl`` relations on ``Prop``, any declared ``Equivalence`` on a type ``A`` (including :term:`Leibniz equality`), and pointwise extensions of declared relations for function types. Users can simply add new instances of this class to register relations with the generalized rewriting machinery. It is used in two cases: + Inference of morphisms: In some cases, generalized rewriting might face constraints of the shape ``Proper (S ==> ?R) f`` for a function ``f`` with no matching ``Proper`` instance. In this situation, the ``RewriteRelation`` instances are used to instantiate the relation ``?R``. If the instantiated relation is reflexive, then the ``Proper`` constraint can be automatically discharged. + Compatibility with ssreflect's rewrite: The :tacn:`rewrite (ssreflect)` tactic uses generalized rewriting when possible, by checking that a ``RewriteRelation R`` instance exists when rewriting with a term of type ``R t u``. Commands and tactics -------------------- .. _first-class-setoids-and-morphisms: First class setoids and morphisms ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ The implementation is based on a first-class representation of properties of relations and morphisms as typeclasses. That is, the various combinations of properties on relations and morphisms are represented as records and instances of these classes are put in a hint database. For example, the declaration: .. coqdoc:: Add Parametric Relation (x1 : T1) ... (xn : Tn) : (A t1 ... tn) (Aeq t′1 ... t′m) [reflexivity proved by refl] [symmetry proved by sym] [transitivity proved by trans] as id. is equivalent to an instance declaration: .. coqdoc:: Instance id (x1 : T1) ... (xn : Tn) : @Equivalence (A t1 ... tn) (Aeq t′1 ... t′m) := [Equivalence_Reflexive := refl] [Equivalence_Symmetric := sym] [Equivalence_Transitive := trans]. The declaration itself amounts to the definition of an object of the record type ``Coq.Classes.RelationClasses.Equivalence`` and a hint added to the of a typeclass named ``Proper``` defined in ``Classes.Morphisms``. See the documentation on :ref:`typeclasses` and the theories files in Classes for further explanations. One can inform the rewrite tactic about morphisms and relations just by using the typeclass mechanism to declare them using the :cmd:`Instance` and :cmd:`Context` commands. Any object of type ``Proper`` (the type of morphism declarations) in the local context will also be automatically used by the rewriting tactic to solve constraints. Other representations of first class setoids and morphisms can also be handled by encoding them as records. In the following example, the projections of the setoid relation and of the morphism function can be registered as parametric relations and morphisms. .. example:: First class setoids .. coqtop:: in reset Require Import Relation_Definitions Setoid. Record Setoid : Type := { car: Type; eq: car -> car -> Prop; refl: reflexive _ eq; sym: symmetric _ eq; trans: transitive _ eq }. Add Parametric Relation (s : Setoid) : (@car s) (@eq s) reflexivity proved by (refl s) symmetry proved by (sym s) transitivity proved by (trans s) as eq_rel. Record Morphism (S1 S2 : Setoid) : Type := { f: car S1 -> car S2; compat: forall (x1 x2 : car S1), eq S1 x1 x2 -> eq S2 (f x1) (f x2) }. Add Parametric Morphism (S1 S2 : Setoid) (M : Morphism S1 S2) : (@f S1 S2 M) with signature (@eq S1 ==> @eq S2) as apply_mor. Proof. apply (compat S1 S2 M). Qed. Lemma test : forall (S1 S2 : Setoid) (m : Morphism S1 S2) (x y : car S1), eq S1 x y -> eq S2 (f _ _ m x) (f _ _ m y). Proof. intros. rewrite H. reflexivity. Qed. .. _tactics-enabled-on-user-provided-relations: Tactics enabled on user provided relations ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ The following tactics, all prefixed by ``setoid_``, deal with arbitrary registered relations and morphisms. Moreover, all the corresponding unprefixed tactics (i.e. :tacn:`reflexivity`, :tacn:`symmetry`, :tacn:`transitivity`, :tacn:`replace`, :tacn:`rewrite`) have been extended to fall back to their prefixed 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``. .. tacn:: setoid_reflexivity setoid_symmetry {? in @ident } setoid_transitivity @one_term setoid_etransitivity setoid_rewrite {? {| -> | <- } } @one_term_with_bindings {? at @rewrite_occs } {? in @ident } setoid_rewrite {? {| -> | <- } } @one_term_with_bindings in @ident at @rewrite_occs 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_etransitivity; setoid_rewrite; _; setoid_replace .. todo: move rewrite_occs to rewrite chapter when that chapter is revised .. insertprodn rewrite_occs rewrite_occs .. prodn:: rewrite_occs ::= {+ @integer } | @ident The ``using relation`` arguments cannot be passed to the unprefixed form. The latter argument tells the tactic what parametric relation should be used to replace the first tactic argument with the second one. If omitted, it defaults to the ``DefaultRelation`` instance on the type of the objects. By default, it means the most recent ``Equivalence`` instance in the global environment, but it can be customized by declaring new ``DefaultRelation`` instances. As Leibniz equality is a declared equivalence, it will fall back to it if no other relation is declared on a given type. Every derived tactic that is based on the unprefixed forms of the tactics considered above will also work up to user defined relations. For instance, it is possible to register hints for :tacn:`autorewrite` that are not proofs of Leibniz equalities. In particular it is possible to exploit :tacn:`autorewrite` to simulate normalization in a term rewriting system up to user defined equalities. Printing relations and morphisms ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 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. 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 @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:`@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 Parametric Setoid {* @binder } : @one_term @one_term @one_term as @ident :undocumented: .. 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 property the user is asked to prove is slightly different: for n-ary morphisms the hypotheses of the property are permuted; moreover, when the morphism returns a proposition, the property is now stated using a bi-implication in place of a simple implication. In practice, porting an old development to the new semantics is usually quite simple. .. cmd:: Declare Morphism @one_term : @ident 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 with the same carrier and several signatures for the same morphism. Moreover, it is now also possible to declare several morphisms having the same signature. Finally, the :tacn:`replace` and :tacn:`rewrite` tactics can be used to replace terms in contexts that were refused by the old implementation. As discussed in the next section, the semantics of the new :tacn:`setoid_rewrite` tactic differs slightly from the old one and :tacn:`rewrite`. .. tacn:: head_of_constr @ident @one_term For internal use only. It may be removed without warning. Do not use. Extensions ---------- Rewriting under binders ~~~~~~~~~~~~~~~~~~~~~~~ .. warning:: Due to compatibility issues, this feature is enabled only when calling the :tacn:`setoid_rewrite` tactic directly and not :tacn:`rewrite`. To be able to rewrite under binding constructs, one must declare morphisms with respect to pointwise (setoid) equivalence of functions. Example of such morphisms are the standard ``all`` and ``ex`` combinators for universal and existential quantification respectively. They are declared as morphisms in the ``Classes.Morphisms_Prop`` module. For example, to declare that universal quantification is a morphism for logical equivalence: .. coqtop:: none Require Import Morphisms. .. coqtop:: in Instance all_iff_morphism (A : Type) : Proper (pointwise_relation A iff ==> iff) (@all A). .. coqtop:: all abort Proof. simpl_relation. One then has to show that if two predicates are equivalent at every point, their universal quantifications are equivalent. Once we have declared such a morphism, it will be used by the setoid rewriting tactic each time we try to rewrite under an ``all`` application (products in ``Prop`` are implicitly translated to such applications). Indeed, when rewriting under a lambda, binding variable ``x``, say from ``P x`` to ``Q x`` using the relation iff, the tactic will generate a proof of ``pointwise_relation A iff (fun x => P x) (fun x => Q x)`` from the proof of ``iff (P x) (Q x)`` and a constraint of the form ``Proper (pointwise_relation A iff ==> ?) m`` will be generated for the surrounding morphism ``m``. Hence, one can add higher-order combinators as morphisms by providing signatures using pointwise extension for the relations on the functional arguments (or whatever subrelation of the pointwise extension). For example, one could declare the ``map`` combinator on lists as a morphism: .. coqdoc:: Instance map_morphism `{Equivalence A eqA, Equivalence B eqB} : Proper ((eqA ==> eqB) ==> list_equiv eqA ==> list_equiv eqB) (@map A B). where ``list_equiv`` implements an equivalence on lists parameterized by an equivalence on the elements. Note that when one does rewriting with a lemma under a binder using :tacn:`setoid_rewrite`, the application of the lemma may capture the bound variable, as the semantics are different from rewrite where the lemma is first matched on the whole term. With the new :tacn:`setoid_rewrite`, matching is done on each subterm separately and in its local context, and all matches are rewritten *simultaneously* by default. The semantics of the previous :tacn:`setoid_rewrite` implementation can almost be recovered using the ``at 1`` modifier. Subrelations ~~~~~~~~~~~~~ Subrelations can be used to specify that one relation is included in another, so that morphism signatures for one can be used for the other. If a signature mentions a relation ``R`` on the left of an arrow ``==>``, then the signature also applies for any relation ``S`` that is smaller than ``R``, and the inverse applies on the right of an arrow. One can then declare only a few morphisms instances that generate the complete set of signatures for a particular :term:`constant`. By default, the only declared subrelation is ``iff``, which is a subrelation of ``impl`` and ``inverse impl`` (the dual of implication). That’s why we can declare only two morphisms for conjunction: ``Proper (impl ==> impl ==> impl) and`` and ``Proper (iff ==> iff ==> iff) and``. This is sufficient to satisfy any rewriting constraints arising from a rewrite using ``iff``, ``impl`` or ``inverse impl`` through ``and``. Subrelations are implemented in ``Classes.Morphisms`` and are a prime example of a mostly user-space extension of the algorithm. Constant unfolding ~~~~~~~~~~~~~~~~~~ The resolution tactic is based on typeclasses and hence regards user-defined :term:`constants ` as transparent by default. This may slow down the resolution due to a lot of unifications (all the declared ``Proper`` instances are tried at each node of the search tree). To speed it up, declare your constant as rigid for proof search using the command :cmd:`Typeclasses Opaque`. .. _strategies4rewriting: Strategies for rewriting ------------------------ Usage ~~~~~ .. tacn:: rewrite_strat @rewstrategy {? in @ident } :name: rewrite_strat Rewrite using :n:`@rewstrategy` in the conclusion or in the hypothesis :n:`@ident`. .. exn:: Nothing to rewrite. The strategy didn't find any matches. .. exn:: No progress made. If the strategy succeeded but made no progress. .. exn:: Unable to satisfy the rewriting constraints. If the strategy succeeded and made progress but the corresponding rewriting constraints are not satisfied. :tacn:`setoid_rewrite` :n:`@one_term` is basically equivalent to :n:`rewrite_strat outermost @one_term`. .. tacn:: rewrite_db @ident__1 {? in @ident__2 } Equivalent to :tacn:`rewrite_strat` :n:`(topdown (hints @ident__1)) {? in @ident__2 }` Definitions ~~~~~~~~~~~ The generalized rewriting tactic is based on a set of strategies that can be combined to create custom rewriting procedures. Its set of strategies is based on the programmable rewriting strategies with generic traversals by Visser et al. :cite:`Luttik97specificationof` :cite:`Visser98`, which formed the core of the Stratego transformation language :cite:`Visser01`. Rewriting strategies are applied using the :tacn:`rewrite_strat` tactic. .. insertprodn rewstrategy rewstrategy0 .. prodn:: rewstrategy ::= fix @ident := @rewstrategy1 | {+; @rewstrategy1 } rewstrategy1 ::= <- @one_term | progress @rewstrategy1 | try @rewstrategy1 | choice {+ @rewstrategy0 } | repeat @rewstrategy1 | any @rewstrategy1 | subterm @rewstrategy1 | subterms @rewstrategy1 | innermost @rewstrategy1 | outermost @rewstrategy1 | bottomup @rewstrategy1 | topdown @rewstrategy1 | hints @ident | terms {* @one_term } | eval @red_expr | fold @one_term | @rewstrategy0 | old_hints @ident rewstrategy0 ::= @one_term | fail | id | refl | ( @rewstrategy ) :n:`@one_term` lemma, left to right :n:`fail` failure :n:`id` identity :n:`refl` reflexivity :n:`<- @one_term` lemma, right to left :n:`progress @rewstrategy1` progress :n:`try @rewstrategy1` try catch :n:`@rewstrategy ; @rewstrategy1` composition :n:`choice {+ @rewstrategy0 }` first successful strategy :n:`repeat @rewstrategy1` one or more :n:`any @rewstrategy1` zero or more :n:`subterm @rewstrategy1` one subterm :n:`subterms @rewstrategy1` all subterms :n:`innermost @rewstrategy1` Innermost first. When there are multiple nested matches in a subterm, the innermost subterm is rewritten. For :ref:`example `, rewriting :n:`(a + b) + c` with Nat.add_comm gives :n:`(b + a) + c`. :n:`outermost @rewstrategy1` Outermost first. When there are multiple nested matches in a subterm, the outermost subterm is rewritten. For :ref:`example `, rewriting :n:`(a + b) + c` with Nat.add_comm gives :n:`c + (a + b)`. :n:`bottomup @rewstrategy1` bottom-up :n:`topdown @rewstrategy1` top-down :n:`hints @ident` apply hints from hint database :n:`terms {* @one_term }` any of the terms :n:`eval @red_expr` apply reduction :n:`fold @term` unify :n:`fix @ident := @rewstrategy1` fixpoint operator, where :math:`\texttt{fix }f := v` evaluates to :math:`\subst{v}{f}{(\texttt{fix }f := v)}` :n:`( @rewstrategy )` to be documented :n:`old_hints @ident` to be documented Conceptually, a few of these are defined in terms of the others: - :n:`try @rewstrategy1 := choice (@rewstrategy1) id` - :n:`any @rewstrategy1 := fix @ident := try (@rewstrategy1 ; @ident)` - :n:`repeat @rewstrategy1 := @rewstrategy1; any @rewstrategy1` - :n:`bottomup @rewstrategy1 := fix @ident := (choice (progress subterms @ident) (@rewstrategy1) ; try @ident)` - :n:`topdown @rewstrategy1 := fix @ident := (choice (@rewstrategy1) (progress subterms @ident) ; try @ident)` - :n:`innermost @rewstrategy1 := fix @ident := choice (subterm @ident) (@rewstrategy1)` - :n:`outermost @rewstrategy1 := fix @ident := choice (@rewstrategy1) (subterm @ident)` The basic control strategy semantics are straightforward: strategies are applied to subterms of the term to rewrite, starting from the root of the term. The lemma strategies unify the left-hand-side of the lemma with the current subterm and on success rewrite it to the right- hand-side. Composition can be used to continue rewriting on the current subterm. The ``fail`` strategy always fails while the identity strategy succeeds without making progress. The reflexivity strategy succeeds, making progress using a reflexivity proof of rewriting. ``progress`` tests progress of the argument :n:`@rewstrategy1` and fails if no progress was made, while ``try`` always succeeds, catching failures. ``choice`` uses the first successful strategy in the list of :n:`@rewstrategy0`s. One can iterate a strategy at least 1 time using ``repeat`` and at least 0 times using ``any``. The ``subterm`` and ``subterms`` strategies apply their argument :n:`@rewstrategy1` to respectively one or all subterms of the current term under consideration, left-to-right. ``subterm`` stops at the first subterm for which :n:`@rewstrategy1` made progress. The composite strategies ``innermost`` and ``outermost`` perform a single innermost or outermost rewrite using their argument :n:`@rewstrategy1`. Their counterparts ``bottomup`` and ``topdown`` perform as many rewritings as possible, starting from the bottom or the top of the term. Hint databases created for :tacn:`autorewrite` can also be used by :tacn:`rewrite_strat` using the ``hints`` strategy that applies any of the lemmas at the current subterm. The ``terms`` strategy takes the lemma names directly as arguments. The ``eval`` strategy expects a reduction expression (see :ref:`applyingconversionrules`) and succeeds if it reduces the subterm under consideration. The ``fold`` strategy takes a :token:`term` and tries to *unify* it to the current subterm, converting it to :token:`term` on success. It is stronger than the tactic ``fold``. .. note:: The symbol ';' is used to separate sequences of tactics as well as sequences of rewriting strategies. `rewrite_strat s; fail` is interpreted as `rewrite_strat (s; fail)`, in which `fail` is a rewriting strategy. Use `(rewrite_strat s); fail` to make `fail` a tactic. `rewrite_strat s; apply I` gives a syntax error (`apply` is not a valid rewrite strategy). .. _rewrite_strat_innermost_outermost: .. example:: :n:`innermost` and :n:`outermost` The type of `Nat.add_comm` is `forall n m : nat, n + m = m + n`. .. coqtop:: all Require Import Coq.Arith.Arith. Set Printing Parentheses. Goal forall a b c: nat, a + b + c = 0. rewrite_strat innermost Nat.add_comm. .. coqtop:: none Abort. Goal forall a b c: nat, a + b + c = 0. Using :n:`outermost` instead gives this result: .. coqtop:: all rewrite_strat outermost Nat.add_comm. .. coqtop:: none Abort. coq-8.20.0/doc/sphinx/addendum/implicit-coercions.rst000066400000000000000000000441071466560755400226000ustar00rootroot00000000000000.. _coercions: Implicit Coercions ==================== :Author: Amokrane Saïbi General Presentation --------------------- This section describes the inheritance mechanism of Coq. In Coq with inheritance, we are not interested in adding any expressive power to our theory, but only convenience. Given a term, possibly not typable, we are interested in the problem of determining if it can be well typed modulo insertion of appropriate coercions. We allow to write: * :g:`f a` where :g:`f:(forall x:A,B)` and :g:`a:A'` when ``A'`` can be seen in some sense as a subtype of ``A``. * :g:`x:A` when ``A`` is not a type, but can be seen in a certain sense as a type: set, group, category etc. * :g:`f a` when ``f`` is not a function, but can be seen in a certain sense as a function: bijection, functor, any structure morphism etc. .. _classes-implicit-coercions: Coercion Classes ---------------- A class with :math:`n` parameters is any defined name with a type :n:`forall (@ident__1 : @type__1)..(@ident__n:@type__n), @sort`. Thus a class with parameters is considered as a single class and not as a family of classes. An object of a coercion class is any term of type :n:`@coercion_class @term__1 .. @term__n`. In addition to these user-defined classes, we have two built-in classes: * ``Sortclass``, the class of sorts; its objects are the terms whose type is a sort (e.g. :g:`Prop` or :g:`Type`). * ``Funclass``, the class of functions; its objects are all the terms with a functional type, i.e. of form :g:`forall x:A,B`. Formally, the syntax of classes is defined as: .. insertprodn coercion_class coercion_class .. prodn:: coercion_class ::= Funclass | Sortclass | @reference .. note:: Don't confuse coercion classes with typeclasses, which are records with special properties defined with the :cmd:`Class` command. Coercions --------- A name ``f`` can be declared as a coercion between a source user-defined class ``C`` with :math:`n` parameters and a target class ``D`` if one of these conditions holds: * ``D`` is a user-defined class, then the type of ``f`` must have the form :g:`forall (x₁:A₁)..(xₖ:Aₖ)(y:C v₁..vₙ), D u₁..uₘ` where :math:`m` is the number of parameters of ``D``. * ``D`` is ``Funclass``, then the type of ``f`` must have the form :g:`forall (x₁:A₁)..(xₖ:Aₖ)(y:C v₁..vₙ)(x:A), B`. * ``D`` is ``Sortclass``, then the type of ``f`` must have the form :g:`forall (x₁:A₁)..(xₖ:Aₖ)(y:C v₁..vₙ), s` with ``s`` a sort. We then write :g:`f : C >-> D`. .. _ambiguous-paths: When you declare a new coercion (e.g. with :cmd:`Coercion`), new coercion paths with the same classes as existing ones are ignored. Coq will generate a warning when the two paths may be non convertible. When the :g:`x₁..xₖ` are exactly the :g:`v₁..vₙ` (in the same order), the coercion is said to satisfy the :gdef:`uniform inheritance condition`. When possible, we recommend using coercions that satisfy this condition. This guarantees that no spurious warning will be generated. .. note:: The built-in class ``Sortclass`` can be used as a source class, but the built-in class ``Funclass`` cannot. To coerce an object :g:`t:C t₁..tₙ` of ``C`` towards ``D``, we have to apply the coercion ``f`` to it; the obtained term :g:`f _.._ t` is then an object of ``D``. Reversible Coercions -------------------- When a term cannot be coerced (directly) to its expected type, Coq tries to use a :gdef:`reversible coercion` (see the :attr:`reversible` attribute). Intuitively, Coq synthesizes a new term of the right type that can be coerced to the original one. The new term is obtained by reversing the coercion, that is guessing its input given the output. More precisely, in order to coerce a term :g:`a : A` to type :g:`B`, Coq finds a reversible coercion :g:`f : B >-> A`, then synthesizes some :g:`?x : B` such that :g:`f ?x = a` (typically through :ref:`canonicalstructures` or :ref:`typeclasses`) and finally replaces :g:`a` with the value of :g:`?x`. If Coq doesn't find a reversible coercion :g:`f : B >-> A`, then it looks for a coercion class :g:`C` equipped with an incoming reversible coercion :g:`g : B >-> C` and a coercion :g:`h : A >-> C` (not necessarily reversible), then synthesizes some :g:`?x : B` such that :g:`g ?x = h a`, and finally replaces :g:`a` with the value of :g:`?x`. If there's another class :g:`D` with a coercion from :g:`C` to :g:`D` and incoming coercions from :g:`A` and :g:`B`, Coq tries :g:`C` before :g:`D`. This ordering is well defined only if the coercion graph happens to be a semi lattice. The intuition behind this ordering is that since coercions forget information, :g:`D` has less information that :g:`C`, and hence inferring :g:`?x : B` from :g:`h a : D` would be harder. See the :ref:`example below `. Identity Coercions ------------------- To make coercions work for both a named class and for ``Sortclass`` or ``Funclass``, use the :cmd:`Identity Coercion` command. There is an example :ref:`here `. Inheritance Graph ------------------ Coercions form an inheritance graph with classes as nodes. We call *coercion path* an ordered list of coercions between two nodes of the graph. A class ``C`` is said to be a subclass of ``D`` if there is a coercion path in the graph from ``C`` to ``D``; we also say that ``C`` inherits from ``D``. Our mechanism supports multiple inheritance since a class may inherit from several classes, contrary to simple inheritance where a class inherits from at most one class. However there must be at most one path between two classes. If this is not the case, only the *oldest* one is valid and the others are ignored. So the order of declaration of coercions is important. We extend notations for coercions to coercion paths. For instance :g:`[f₁;..;fₖ] : C >-> D` is the coercion path composed by the coercions ``f₁..fₖ``. The application of a coercion path to a term consists of the successive application of its coercions. Coercion Classes ---------------- .. cmd:: Coercion @reference {? : @coercion_class >-> @coercion_class } Coercion @ident_decl @def_body The first form declares the construction denoted by :token:`reference` as a coercion between the two given classes. The second form defines :token:`ident_decl` just like :cmd:`Definition` :n:`@ident_decl @def_body` and then declares :token:`ident_decl` 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. :n:`{? : @coercion_class >-> @coercion_class }` The source and target classes of the coercion. If unspecified, :n:`@reference` must already be a coercion, which enables modifying the :attr:`reversible` attribute of :n:`@reference`. See the :ref:`example ` below. .. attr:: reversible{? = {| yes | no } } :name: reversible This :term:`attribute` allows the coercion to be used as a :term:`reversible coercion`. By default coercions are not reversible except for :cmd:`Record` fields specified using :g:`:>`. .. attr:: nonuniform Silence the non uniform inheritance warning. .. deprecated:: 8.18 Use the :attr:`warnings` attribute instead with "-uniform-inheritance". .. exn:: @qualid not declared. :token:`qualid` is not defined globally. .. exn:: @qualid is already a coercion. :token:`qualid` is already registered as a coercion. .. exn:: Funclass cannot be a source class. Funclass as a source class is currently not supported. This may change in the future. .. exn:: @qualid is not a function. :token:`qualid` is not a function, so it cannot be used as a coercion. .. exn:: Cannot find the source class of @qualid. Coq can not infer a valid source class. .. exn:: Cannot recognize @coercion_class as a source class of @qualid. The inferred source class of the coercion differs from the one specified. .. exn:: Cannot find the target class The target class of the coercion is not specified and cannot be inferred. Make sure that the target is not a variable. .. exn:: Found target class @coercion_class instead of @coercion_class The inferred target class of the coercion differs from the one specified. .. warn:: @qualid does not respect the uniform inheritance condition. The :ref:`test for ambiguous coercion paths ` may yield false positives involving the coercion :token:`qualid`. Use the :attr:`warnings` attribute with "-uniform-inheritance" to silence this warning. .. warn:: New coercion path ... is ambiguous with existing ... The check for :ref:`ambiguous paths ` failed. The paths for which this check fails are displayed by a warning in the form :g:`[f₁;..;fₙ] : C >-> D`. The convertibility checking procedure for coercion paths is complete for paths consisting of coercions satisfying the :term:`uniform inheritance condition`, but some coercion paths could be reported as ambiguous even if they are convertible with existing ones when they have coercions that don't satisfy this condition. .. warn:: ... is not definitionally an identity function. If a coercion path has the same source and target class, that is said to be circular. When a new circular coercion path is not convertible with the identity function, it will be reported as ambiguous. Some objects can be declared as coercions when they are defined. This applies to :ref:`assumptions` and constructors of :ref:`inductive types and record fields`. Use :n:`:>` instead of :n:`:` before the type of the assumption to do so. See :n:`@of_type`. .. cmd:: Identity Coercion @ident : @coercion_class__src >-> @coercion_class__dest Checks that :n:`@coercion_class__src` is a :term:`constant` with a :term:`body` of the form :n:`fun (x₁:T₁)..(xₙ:Tₙ) => @coercion_class__dest t₁..tₘ` where `m` is the number of parameters of :n:`@coercion_class__dest`. Then we define an identity 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``. See below for an :ref:`example `. This command supports the :attr:`local` attribute, which makes the coercion local to the current section. .. exn:: @coercion_class must be a transparent constant. :undocumented: .. cmd:: SubClass @ident_decl @def_body If :n:`@type` is a coercion class :n:`@ident'` applied to some arguments then :n:`@ident` is defined and an identity coercion of name :n:`Id_@ident_@ident'` is declared. In other words, this is an abbreviation for :n:`Definition @ident := @type.` :n:`Identity Coercion Id_@ident_@ident' : @ident >-> @ident'`. This command supports the :attr:`local` attribute, which makes the coercion local to the current section. Displaying Available Coercions ------------------------------- .. cmd:: Print Classes Print the list of declared coercion classes in the current context. .. cmd:: Print Coercions Print the list of declared coercions in the current context. .. cmd:: Print Graph Print the list of valid coercion paths in the current context. .. cmd:: Print Coercion Paths @coercion_class @coercion_class Print the list of valid coercion paths between the two given classes. Activating the Printing of Coercions ------------------------------------- .. flag:: Printing Coercions When on, this :term:`flag` forces all the coercions to be printed. By default, coercions are not printed. .. table:: Printing Coercion @qualid This :term:`table` specifies a set of qualids for which coercions are always displayed. Use the :cmd:`Add` and :cmd:`Remove` commands to update the set of qualids. .. _coercions-classes-as-records: Classes as Records ------------------ .. index:: :> (coercion) *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. 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. For these coercions, the :attr:`reversible` attribute defaults to :g:`yes`. See :token:`of_type`. Coercions and Sections ---------------------- The inheritance mechanism is compatible with the section mechanism. The global classes and coercions defined inside a section are redefined after its closing, using their new value and new type. The classes and coercions which are local to the section are simply forgotten. Coercions with a local source class or a local target class are also forgotten. Coercions and Modules --------------------- The coercions present in a module are activated only when the module is explicitly imported. Examples -------- There are three situations: .. example:: Coercion at function application :g:`f a` is ill-typed where :g:`f:forall x:A,B` and :g:`a:A'`. If there is a coercion path between ``A'`` and ``A``, then :g:`f a` is transformed into :g:`f a'` where ``a'`` is the result of the application of this coercion path to ``a``. We first give an example of coercion between atomic inductive types .. coqtop:: all Definition bool_in_nat (b:bool) := if b then 0 else 1. Coercion bool_in_nat : bool >-> nat. Check (0 = true). Set Printing Coercions. Check (0 = true). Unset Printing Coercions. .. warning:: Note that ``Check (true = O)`` would fail. This is "normal" behavior of coercions. To validate ``true=O``, the coercion is searched from ``nat`` to ``bool``. There is none. We give an example of coercion between classes with parameters. .. coqtop:: all Parameters (C : nat -> Set) (D : nat -> bool -> Set) (E : bool -> Set). Parameter f : forall n:nat, C n -> D (S n) true. Coercion f : C >-> D. Parameter g : forall (n:nat) (b:bool), D n b -> E b. Coercion g : D >-> E. Parameter c : C 0. Parameter T : E true -> nat. Check (T c). Set Printing Coercions. Check (T c). Unset Printing Coercions. In the case of functional arguments, we use the monotonic rule of sub-typing. To coerce :g:`t : forall x : A, B` towards :g:`forall x : A', B'`, we have to coerce ``A'`` towards ``A`` and ``B`` towards ``B'``. An example is given below: .. coqtop:: all Parameters (A B : Set) (h : A -> B). Coercion h : A >-> B. Parameter U : (A -> E true) -> nat. Parameter t : B -> C 0. Check (U t). Set Printing Coercions. Check (U t). Unset Printing Coercions. Remark the changes in the result following the modification of the previous example. .. coqtop:: all Parameter U' : (C 0 -> B) -> nat. Parameter t' : E true -> A. Check (U' t'). Set Printing Coercions. Check (U' t'). Unset Printing Coercions. .. example:: Coercion to a type An assumption ``x:A`` when ``A`` is not a type, is ill-typed. It is replaced by ``x:A'`` where ``A'`` is the result of the application to ``A`` of the coercion path between the class of ``A`` and ``Sortclass`` if it exists. This case occurs in the abstraction :g:`fun x:A => t`, universal quantification :g:`forall x:A,B`, global variables and parameters of (co)inductive definitions and functions. In :g:`forall x:A,B`, such a coercion path may also be applied to ``B`` if necessary. .. coqtop:: all Parameter Graph : Type. Parameter Node : Graph -> Type. Coercion Node : Graph >-> Sortclass. Parameter G : Graph. Parameter Arrows : G -> G -> Type. Check Arrows. Parameter fg : G -> G. Check fg. Set Printing Coercions. Check fg. Unset Printing Coercions. .. example:: Coercion to a function ``f a`` is ill-typed because ``f:A`` is not a function. The term ``f`` is replaced by the term obtained by applying to ``f`` the coercion path between ``A`` and ``Funclass`` if it exists. .. coqtop:: all Parameter bij : Set -> Set -> Set. Parameter ap : forall A B:Set, bij A B -> A -> B. Coercion ap : bij >-> Funclass. Parameter b : bij nat nat. Check (b 0). Set Printing Coercions. Check (b 0). Unset Printing Coercions. .. _example-reversible-coercion: .. example:: Reversible coercions Notice the :n:`:>` on `ssort` making it a :term:`reversible coercion`. .. coqtop:: in Structure S := { ssort :> Type; sstuff : ssort; }. Definition test (s : S) := sstuff s. Canonical Structure S_nat := {| ssort := nat; sstuff := 0; |}. .. coqtop:: all Check test (nat : Type). .. _example-reversible-coercion-attribute: .. example:: Reversible coercions using the :attr:`reversible` attribute Notice there is no `:>` on `ssort'` and the added :cmd:`Coercion` compared to the previous example. .. coqtop:: in Structure S' := { ssort' : Type; sstuff' : ssort'; }. Coercion ssort' : S' >-> Sortclass. Definition test' (s : S') := sstuff' s. Canonical Structure S_nat' := {| ssort' := nat; sstuff' := 0; |}. Since there's no `:>` on the definition of `ssort'`, the :attr:`reversible` attribute is not set: .. coqtop:: all Fail Check test' (nat : Type). The attribute can be set after declaring the coercion: .. coqtop:: all #[reversible] Coercion ssort'. Check test' (nat : Type). .. _example-identity-coercion: .. example:: Identity coercions. .. coqtop:: in Definition fct := nat -> nat. Parameter incr_fct : Set. Parameter fct_of_incr_fct : incr_fct -> fct. .. coqtop:: all Fail Coercion fct_of_incr_fct : incr_fct >-> Funclass. .. coqtop:: in Coercion fct_of_incr_fct : incr_fct >-> fct. Parameter f' : incr_fct. .. coqtop:: all Check f' : fct. Fail Check f' 0. Identity Coercion Id_fct_Funclass : fct >-> Funclass. Check f' 0. .. example:: Inheritance Graph Let us see the resulting graph after all these examples. .. coqtop:: all Print Graph. coq-8.20.0/doc/sphinx/addendum/micromega.rst000066400000000000000000000472031466560755400207470ustar00rootroot00000000000000.. _micromega: Micromega: solvers for arithmetic goals over ordered rings ================================================================== :Authors: Frédéric Besson and Evgeny Makarov Short description of the tactics -------------------------------- The Psatz module (``Require Import Psatz``) gives access to several tactics for solving arithmetic goals over :math:`\mathbb{Q}`, :math:`\mathbb{R}`, and :math:`\mathbb{Z}` but also :g:`nat` and :g:`N`. It is also possible to get only the tactics for integers by ``Require Import Lia``, only for rationals by ``Require Import Lqa`` or only for reals by ``Require Import Lra``. + :tacn:`lia` is a decision procedure for linear integer arithmetic; + :tacn:`nia` is an incomplete proof procedure for integer non-linear arithmetic; + :tacn:`lra` is a decision procedure for linear (real or rational) arithmetic; + :tacn:`nra` is an incomplete proof procedure for non-linear (real or rational) arithmetic; + :tacn:`psatz` ``D n`` is an incomplete proof procedure for non-linear arithmetic. ``D`` is :math:`\mathbb{Z}` or :math:`\mathbb{Q}` or :math:`\mathbb{R}` and ``n`` is an optional integer limiting the proof search depth. It is based on John Harrison’s HOL Light 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. .. opt:: Dump Arith This :term:`option` (unset by default) may be set to a file path where debug info will be written. .. cmd:: Show Lia Profile This command prints some statistics about the amount of pivoting operations needed by :tacn:`lia` and may be useful to detect inefficiencies. .. flag:: Lia Cache This :term:`flag` (set by default) instructs :tacn:`lia` to cache its results in the file `.lia.cache` .. flag:: Nia Cache This :term:`flag` (set by default) instructs :tacn:`nia` to cache its results in the file `.nia.cache` .. flag:: Nra Cache This :term:`flag` (set by default) instructs :tacn:`nra` to cache its results in the file `.nra.cache` The tactics solve propositional formulas parameterized by atomic arithmetic expressions interpreted over a domain :math:`D \in \{\mathbb{Z},\mathbb{Q},\mathbb{R}\}`. The syntax for formulas is: .. note the following is not an insertprodn .. prodn:: F ::= {| @A | P | True | False | @F /\ @F | @F \/ @F | @F <-> @F | @F -> @F | ~ @F | @F = @F } A ::= {| @p = @p | @p > @p | @p < @p | @p >= @p | @p <= @p } p ::= {| c | x | −@p | @p − @p | @p + @p | @p * @p | @p ^ n } where - :token:`F` is interpreted over either `Prop` or `bool` - :n:`P` is an arbitrary proposition - :n:`c` is a numeric constant of :math:`D` - :n:`x` :math:`\in D` is a numeric variable - :n:`−`, :n:`+` and :n:`*` are respectively subtraction, addition and product - :n:`p ^ n` is exponentiation by a natural integer constant :math:`n` When :math:`F` is interpreted over `bool`, the boolean operators are `&&`, `||`, `Bool.eqb`, `Bool.implb`, `Bool.negb` and the comparisons in :math:`A` are also interpreted over the booleans (e.g., for :math:`\mathbb{Z}`, we have `Z.eqb`, `Z.gtb`, `Z.ltb`, `Z.geb`, `Z.leb`). For :math:`\mathbb{Q}`, the equality of rationals ``==`` is used rather than Leibniz equality ``=``. For :math:`\mathbb{Z}` (resp. :math:`\mathbb{Q}`), :n:`c` ranges over integer constants (resp. rational constants). For :math:`\mathbb{R}`, the tactic recognizes as real constants the following expressions: :: c ::= R0 | R1 | Rmult c c | Rplus c c | Rminus c c | IZR z | Q2R q | Rdiv c c | Rinv c where `z` is a constant in :math:`\mathbb{Z}` and `q` is a constant in :math:`\mathbb{Q}`. This includes :n:`@number` written using the decimal notation, *i.e.*, ``c%R``. *Positivstellensatz* refutations -------------------------------- The name `psatz` is an abbreviation for *positivstellensatz* – literally "positivity theorem" – which generalizes Hilbert’s *nullstellensatz*. It relies on the notion of Cone. Given a (finite) set of polynomials :math:`S`, :math:`\mathit{Cone}(S)` is inductively defined as the smallest set of polynomials closed under the following rules: .. math:: \begin{array}{l} \dfrac{p \in S}{p \in \mathit{Cone}(S)} \quad \dfrac{}{p^2 \in \mathit{Cone}(S)} \quad \dfrac{p_1 \in \mathit{Cone}(S) \quad p_2 \in \mathit{Cone}(S) \quad \Join \in \{+,*\}} {p_1 \Join p_2 \in \mathit{Cone}(S)}\\ \end{array} The following theorem provides a proof principle for checking that a set of polynomial inequalities does not have solutions [#fnpsatz]_. .. _psatz_thm: .. thm:: Psatz Let :math:`S` be a set of polynomials. If :math:`-1` belongs to :math:`\mathit{Cone}(S)`, then the conjunction :math:`\bigwedge_{p \in S} p\ge 0` is unsatisfiable. *Proof:* Let's assume that :math:`\bigwedge_{p \in S} p\ge 0` is satisfiable, meaning there exists :math:`x` such that for all :math:`p \in S` , we have :math:`p(x) \ge 0`. Since the cone building rules preserve non negativity, any polynomial in :math:`\mathit{Cone}(S)` is non negative in :math:`x`. Thus :math:`-1 \in \mathit{Cone}(S)` is non negative, which is absurd. :math:`\square` A proof based on this theorem is called a *positivstellensatz* refutation. The tactics work as follows. Formulas are normalized into conjunctive normal form :math:`\bigwedge_i C_i` where :math:`C_i` has the general form :math:`(\bigwedge_{j\in S_i} p_j \Join 0) \to \mathit{False}` and :math:`\Join \in \{>,\ge,=\}` for :math:`D\in \{\mathbb{Q},\mathbb{R}\}` and :math:`\Join \in \{\ge, =\}` for :math:`\mathbb{Z}`. For each conjunct :math:`C_i`, the tactic calls an oracle which searches for :math:`-1` within the cone. Upon success, the oracle returns a :gdef:`cone expression` that is normalized by the :tacn:`ring` tactic (see :ref:`theringandfieldtacticfamilies`) and checked to be :math:`-1`. `lra`: a decision procedure for linear real and rational arithmetic ------------------------------------------------------------------- .. tacn:: lra This tactic is searching for *linear* refutations. As a result, this tactic explores a subset of the *Cone* defined as .. math:: \mathit{LinCone}(S) =\left\{ \left. \sum_{p \in S} \alpha_p \times p~\right|~\alpha_p \mbox{ are positive constants} \right\} The deductive power of :tacn:`lra` overlaps with the one of :tacn:`field` tactic *e.g.*, :math:`x = 10 * x / 10` is solved by :tacn:`lra`. .. tacn:: xlra_Q @ltac_expr xlra_R @ltac_expr For internal use only (it may change without notice). .. tacn:: wlra_Q @ident @one_term For advanced users interested in deriving tactics for specific needs. See the :ref:`example below ` and comments in `plugin/micromega/coq_micromega.mli`. `lia`: a tactic for linear integer arithmetic --------------------------------------------- .. tacn:: lia This tactic solves linear goals over :g:`Z` by searching for *linear* refutations and cutting planes. :tacn:`lia` provides support for :g:`Z`, :g:`nat`, :g:`positive` and :g:`N` by pre-processing via the :tacn:`zify` tactic. High level view of `lia` ~~~~~~~~~~~~~~~~~~~~~~~~ Over :math:`\mathbb{R}`, *positivstellensatz* refutations are a complete proof principle [#mayfail]_. However, this is not the case over :math:`\mathbb{Z}`. Actually, *positivstellensatz* refutations are not even sufficient to decide linear *integer* arithmetic. The canonical example is :math:`2 * x = 1 \to \mathtt{False}` which is a theorem of :math:`\mathbb{Z}` but not a theorem of :math:`{\mathbb{R}}`. To remedy this weakness, the :tacn:`lia` tactic is using recursively a combination of: + linear *positivstellensatz* refutations; + cutting plane proofs; + case split. Cutting plane proofs ~~~~~~~~~~~~~~~~~~~~~~ are a way to take into account the discreteness of :math:`\mathbb{Z}` by rounding (rational) constants to integers. .. _ceil_thm: .. thm:: Bound on the ceiling function Let :math:`p` be an integer and :math:`c` a rational constant. Then :math:`p \ge c \rightarrow p \ge \lceil{c}\rceil`. .. example:: Cutting plane For instance, from :math:`2 x = 1` we can deduce + :math:`x \ge 1/2` whose cut plane is :math:`x \ge \lceil{1/2}\rceil = 1`; + :math:`x \le 1/2` whose cut plane is :math:`x \le \lfloor{1/2}\rfloor = 0`. By combining these two facts (in normal form) :math:`x − 1 \ge 0` and :math:`-x \ge 0`, we conclude by exhibiting a *positivstellensatz* refutation: :math:`−1 \equiv x−1 + −x \in \mathit{Cone}({x−1,x})`. Cutting plane proofs and linear *positivstellensatz* refutations are a complete proof principle for integer linear arithmetic. Case split ~~~~~~~~~~~ enumerates over the possible values of an expression. .. _casesplit_thm: .. thm:: Case split Let :math:`p` be an integer and :math:`c_1` and :math:`c_2` integer constants. Then: .. math:: c_1 \le p \le c_2 \Rightarrow \bigvee_{x \in [c_1,c_2]} p = x Our current oracle tries to find an expression :math:`e` with a small range :math:`[c_1,c_2]`. We generate :math:`c_2 − c_1` subgoals whose contexts are enriched with an equation :math:`e = i` for :math:`i \in [c_1,c_2]` and recursively search for a proof. .. tacn:: xlia @ltac_expr For internal use only (it may change without notice). .. tacn:: wlia @ident @one_term For advanced users interested in deriving tactics for specific needs. See the :ref:`example below ` and comments in `plugin/micromega/coq_micromega.mli`. `nra`: a proof procedure for non-linear arithmetic -------------------------------------------------- .. tacn:: nra This tactic is an *experimental* proof procedure for non-linear arithmetic. The tactic performs a limited amount of non-linear reasoning before running the linear prover of :tacn:`lra`. This pre-processing does the following: + If the context contains an arithmetic expression of the form :math:`e[x^2]` where :math:`x` is a monomial, the context is enriched with :math:`x^2 \ge 0`; + For all pairs of hypotheses :math:`e_1 \ge 0`, :math:`e_2 \ge 0`, the context is enriched with :math:`e_1 \times e_2 \ge 0`. After this pre-processing, the linear prover of :tacn:`lra` searches for a proof by abstracting monomials by variables. .. tacn:: xnra_Q @ltac_expr xnra_R @ltac_expr For internal use only (it may change without notice). .. tacn:: wnra_Q @ident @one_term For advanced users interested in deriving tactics for specific needs. See the :ref:`example below ` and comments in `plugin/micromega/coq_micromega.mli`. `nia`: a proof procedure for non-linear integer arithmetic ---------------------------------------------------------- .. tacn:: nia This tactic is a proof procedure for non-linear integer arithmetic. It performs a pre-processing similar to :tacn:`nra`. The obtained goal is solved using the linear integer prover :tacn:`lia`. .. tacn:: xnia @ltac_expr For internal use only (it may change without notice). .. tacn:: wnia @ident @one_term For advanced users interested in deriving tactics for specific needs. See the :ref:`example below ` and comments in `plugin/micromega/coq_micromega.mli`. `psatz`: a proof procedure for non-linear arithmetic ---------------------------------------------------- .. tacn:: psatz @one_term {? @nat_or_var } This tactic explores the *Cone* by increasing degrees – hence the depth parameter :token:`nat_or_var`. In theory, such a proof search is complete – if the goal is provable the search eventually stops. Unfortunately, the external oracle is using numeric (approximate) optimization techniques that might miss a refutation. To illustrate the working of the tactic, consider we wish to prove the following Coq goal: .. needs csdp .. coqdoc:: Require Import ZArith Psatz. Open Scope Z_scope. Goal forall x, -x^2 >= 0 -> x - 1 >= 0 -> False. intro x. psatz Z 2. Qed. As shown, such a goal is solved by ``intro x. psatz Z 2``. The oracle returns the :term:`cone expression` :math:`2 \times p_2 + p_2^2 + p_1` with :math:`p_1 := -x^2` and :math:`p_2 := x - 1`. By construction, this expression belongs to :math:`\mathit{Cone}({p_1, p_2})`. Moreover, by running :tacn:`ring` we obtain :math:`-1`. Thus, by Theorem :ref:`Psatz `, the goal is valid. .. tacn:: xsos_Q @ltac_expr xsos_R @ltac_expr xsos_Z @ltac_expr xpsatz_Q @nat_or_var @ltac_expr xpsatz_R @nat_or_var @ltac_expr xpsatz_Z @nat_or_var @ltac_expr For internal use only (it may change without notice). .. tacn:: wsos_Q @ident @one_term wsos_Z @ident @one_term wpsatz_Q @nat_or_var @ident @one_term wpsatz_Z @nat_or_var @ident @one_term For advanced users interested in deriving tactics for specific needs. See the :ref:`example below ` and comments in `plugin/micromega/coq_micromega.mli`. `zify`: pre-processing of arithmetic goals ------------------------------------------ .. tacn:: zify 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 unsigned 63 bit integers, require the module :g:`ZifyUint63`. + For native signed 63 bit integers, require the module :g:`ZifySint63`. + For operators :g:`Nat.div`, :g:`Nat.mod`, and :g:`Nat.pow`, require the module :g:`ZifyNat`. + For operators :g:`N.div`, :g:`N.mod`, and :g:`N.pow`, require the module :g:`ZifyN`. :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.divide`: ``Ltac Zify.zify_post_hook ::= Z.divide_to_equations``. + 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.divide`, :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 :g:`Z.to_euclidean_division_equations` tactic consists of the following passes: - :g:`Z.divide_to_equations'`, posing characteristic equations using factors from :g:`Z.divide` - :g:`Z.div_mod_to_equations'`, posing characteristic equations for and generalizing over :g:`Z.div` and :g:`Z.modulo` - :g:`Z.quot_rem_to_equations'`, posing characteristic equations for and generalizing over :g:`Z.quot` and :g:`Z.rem` - :g:`Z.euclidean_division_equations_cleanup`, removing impossible hypotheses introduced by the above passes, such as those presupposing :g:`x <> x` - :g:`Z.euclidean_division_equations_find_duplicate_quotients`, which heuristically adds equations of the form :g:`q1 = q2 \/ q1 <> q2` when it seems that two quotients might be equal, allowing :g:`nia` to prove more goals, including those relating :g:`Z.quot` and :g:`Z.modulo` to :g:`Z.quot` and :g:`Z.rem`. 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 @add_zify @qualid .. insertprodn add_zify add_zify .. prodn:: add_zify ::= {| InjTyp | BinOp | UnOp | CstOp | BinRel | UnOpSpec | BinOpSpec } | {| PropOp | PropBinOp | PropUOp | Saturate } Registers an instance of the specified typeclass. The typeclass type (e.g. :g:`BinOp Z.mul` or :g:`BinRel (@eq Z)`) has the additional constraint that the non-implicit argument (here, :g:`Z.mul` or :g:`(@eq Z)`) is either a :n:`@reference` (here, :g:`Z.mul`) or the application of a :n:`@reference` (here, :g:`@eq`) to a sequence of :n:`@one_term`. .. 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`. .. tacn:: zify_elim_let zify_iter_let @ltac_expr zify_iter_specs zify_op zify_saturate For internal use only (it may change without notice). .. _lra_example: .. example:: Lra The :tacn:`lra` tactic automatically proves the following goal. .. coqtop:: in Require Import QArith Lqa. #[local] Open Scope Q_scope. Lemma example_lra x y : x + 2 * y <= 4 -> 2 * x + y <= 4 -> x + y < 3. Proof. lra. Qed. Although understanding what's going on under the hood is not required to use the tactic, here are the details for curious users or advanced users interested in deriving their own tactics for arithmetic types other than ``Q`` or ``R`` from the standard library. Mathematically speaking, one needs to prove that :math:`p_2 \ge 0 \land p_1 \ge 0 \land p_0 \ge 0` is unsatisfiable with :math:`p_2 := 4 - x - 2y` and :math:`p_1 := 4 - 2x - y` and :math:`p_0 := x + y - 3`. This is done thanks to the :term:`cone expression` :math:`p_2 + p_1 + 3 \times p_0 \equiv -1`. .. coqtop:: all From Coq.micromega Require Import RingMicromega QMicromega EnvRing Tauto. Print example_lra. Here, ``__ff`` is a reified representation of the goal and ``__varmap`` is a variable map giving the interpretation of each variable (here that ``PEX 1`` in ``__ff`` stands for ``__x1`` and ``PEX 2`` for ``__x2``). Finally, ``__wit`` is the :term:`cone expression` also called *witness*. This proof could also be obtained by the following tactics where :n:`wlra_Q wit ff` calls the oracle on the goal ``ff`` and puts the resulting :term:`cone expression` in ``wit``. ``QTautoChecker_sound`` is a theorem stating that, when the function call ``QTautoChecker ff wit`` returns ``true``, then the goal represented by ``ff`` is valid. .. coqtop:: in Lemma example_lra' x y : x + 2 * y <= 4 -> 2 * x + y <= 4 -> x + y < 3. Proof. pose (ff := IMPL (A isProp {| Flhs := PEadd (PEX 1) (PEmul (PEc 2) (PEX 2)); Fop := OpLe; Frhs := PEc 4 |} tt) None (IMPL (A isProp {| Flhs := PEadd (PEmul (PEc 2) (PEX 1)) (PEX 2); Fop := OpLe; Frhs := PEc 4 |} tt) None (A isProp {| Flhs := PEadd (PEX 1) (PEX 2); Fop := OpLt; Frhs := PEc 3 |} tt)) : BFormula (Formula Q) isProp). .. coqtop:: all pose (varmap := VarMap.Branch (VarMap.Elt y) x VarMap.Empty). let ff' := eval unfold ff in ff in wlra_Q wit ff'. change (eval_bf (Qeval_formula (@VarMap.find Q 0 varmap)) ff). apply (QTautoChecker_sound ff wit). .. coqtop:: in vm_compute. reflexivity. Qed. .. [#csdp] Sources and binaries can be found at ``_ .. [#fnpsatz] Variants deal with equalities and strict inequalities. .. [#mayfail] In practice, the oracle might fail to produce such a refutation. .. comment in original TeX: .. %% \paragraph{The {\tt sos} tactic} -- where {\tt sos} stands for \emph{sum of squares} -- tries to prove that a .. %% single polynomial $p$ is positive by expressing it as a sum of squares \emph{i.e.,} $\sum_{i\in S} p_i^2$. .. %% This amounts to searching for $p$ in the cone without generators \emph{i.e.}, $Cone(\{\})$. coq-8.20.0/doc/sphinx/addendum/miscellaneous-extensions.rst000066400000000000000000000034001466560755400240330ustar00rootroot00000000000000Program derivation ================== Coq comes with an extension called ``Derive``, which supports program derivation. Typically in the style of Bird and Meertens or derivations 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 @one_term As @ident__2 :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`). When the proof ends two :term:`constants ` are defined: + The first one is named :n:`@ident__1` and is defined as the proof of the shelved goal (which is also the value of :g:`?x`). It is always transparent. + The second one is named :n:`@ident__2`. It has type :n:`@type`, and its :term:`body` is the proof of the initially visible goal. It is opaque if the proof ends with :cmd:`Qed`, and transparent if the proof ends with :cmd:`Defined`. .. example:: .. coqtop:: all Require Coq.derive.Derive. Require Import PeanoNat. Section P. Variables (n m k:nat). Derive p SuchThat ((k*n)+(k*m) = p) As h. Proof. rewrite <- Nat.mul_add_distr_l. subst p. reflexivity. Qed. End P. Print p. Check h. Any property can be used as `term`, not only an equation. In particular, it could be an order relation specifying some form of program refinement or a non-executable property from which deriving a program is convenient. coq-8.20.0/doc/sphinx/addendum/nsatz.rst000066400000000000000000000105161466560755400201400ustar00rootroot00000000000000.. _nsatz_chapter: Nsatz: a solver for equalities in integral domains =========================================================== :Author: Loïc Pottier 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 :math:`\begin{array}{l} \forall X_1, \ldots, X_n \in A, \\ P_1(X_1, \ldots, X_n) = Q_1(X_1, \ldots, X_n), \ldots, P_s(X_1, \ldots, X_n) = Q_s(X_1, \ldots, X_n) \\ \vdash P(X_1, \ldots, X_n) = Q(X_1, \ldots, X_n) \\ \end{array}` where :math:`P, Q, P_1, Q_1, \ldots, P_s, Q_s` are polynomials and :math:`A` is an integral domain, i.e. a commutative ring with no zero divisors. For example, :math:`A` can be :math:`\mathbb{R}`, :math:`\mathbb{Z}`, or :math:`\mathbb{Q}`. Note that the equality :math:`=` used in these goals can be any setoid equality (see :ref:`tactics-enabled-on-user-provided-relations`) , not only Leibniz equality. It also proves formulas :math:`\begin{array}{l} \forall X_1, \ldots, X_n \in A, \\ P_1(X_1, \ldots, X_n) = Q_1(X_1, \ldots, X_n) \wedge \ldots \wedge P_s(X_1, \ldots, X_n) = Q_s(X_1, \ldots, X_n) \\ \rightarrow P(X_1, \ldots, X_n) = Q(X_1, \ldots, X_n) \\ \end{array}` doing automatic introductions. `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). `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 `_ for examples, especially in geometry. More about `nsatz` --------------------- Hilbert’s Nullstellensatz theorem shows how to reduce proofs of equalities on polynomials on a commutative ring :math:`A` with no zero divisors to algebraic computations: it is easy to see that if a polynomial :math:`P` in :math:`A[X_1,\ldots,X_n]` verifies :math:`c P^r = \sum_{i=1}^{s} S_i P_i`, with :math:`c \in A`, :math:`c \not = 0`, :math:`r` a positive integer, and the :math:`S_i` s in :math:`A[X_1,\ldots,X_n ]`, then :math:`P` is zero whenever polynomials :math:`P_1,\ldots,P_s` are zero (the converse is also true when :math:`A` is an algebraically closed field: the method is complete). So, solving our initial problem reduces to finding :math:`S_1, \ldots, S_s`, :math:`c` and :math:`r` such that :math:`c (P-Q)^r = \sum_{i} S_i (P_i-Q_i)`, which will be proved by the tactic ring. This is achieved by the computation of a Gröbner basis of the ideal generated by :math:`P_1-Q_1,...,P_s-Q_s`, with an adapted version of the Buchberger algorithm. This computation is done after a step of *reification*, which is performed using :ref:`typeclasses`. .. tacn:: nsatz_compute @one_term :undocumented: coq-8.20.0/doc/sphinx/addendum/parallel-proof-processing.rst000066400000000000000000000172551466560755400241010ustar00rootroot00000000000000.. _asynchronousandparallelproofprocessing: Asynchronous and Parallel Proof Processing ========================================== :Author: Enrico Tassi This chapter explains how proofs can be asynchronously processed by Coq. This feature improves the reactivity of the system when used in interactive mode via CoqIDE. In addition, it allows Coq to take advantage of parallel hardware when used as a batch compiler by decoupling the checking of statements and definitions from the construction and checking of proofs objects. This feature is designed to help dealing with huge libraries of theorems characterized by long proofs. In the current state, it may not be beneficial on small sets of short files. This feature has some technical limitations that may make it unsuitable for some use cases. For example, in interactive mode, some errors coming from the kernel of Coq are signaled late. The type of errors belonging to this category are universe inconsistencies. At the time of writing, only opaque proofs (ending with :cmd:`Qed` or :cmd:`Admitted`) can be processed asynchronously. Finally, asynchronous processing is disabled when running CoqIDE in Windows. The current implementation of the feature is not stable on Windows. It can be enabled, as described below at :ref:`interactive-mode`, though doing so is not recommended. .. _proof-annotations: Proof annotations ---------------------- To process a proof asynchronously Coq needs to know the precise statement of the theorem without looking at the proof. This requires some annotations if the theorem is proved inside a Section (see Section :ref:`section-mechanism`). When a :ref:`section ` ends, Coq looks at the proof object to decide which section variables are actually used and hence have to be quantified in the statement of the theorem. To avoid making the construction of proofs mandatory when ending a section, one can start each proof with the :cmd:`Proof using` command (Section :ref:`proof-editing-mode`) that declares which section variables the theorem uses. The presence of :cmd:`Proof using` is needed to process proofs asynchronously in interactive mode. It is not strictly mandatory in batch mode if it is not the first time the file is compiled and if the file itself did not change. When the proof does not begin with :cmd:`Proof using`, the system records in an auxiliary file, produced along with the ``.vo`` file, the list of section variables used. If a theorem has an incorrect annotation that omits a needed variable, you may see a message like this: .. code-block:: File "./Pff.v", line 2372, characters 0-4: Error: The following section variable is used but not declared: precisionNotZero. You can either update your proof to not depend on precisionNotZero, or you can update your Proof line from Proof using FtoRradix b pGivesBound precision radix radixMoreThanOne radixMoreThanZERO to Proof using FtoRradix b pGivesBound precision precisionNotZero radix radixMoreThanOne radixMoreThanZERO In this case the minimal annotation suggested by the :flag:`Suggest Proof Using` flag is `Print Using pGivesBound precisionNotZero radixMoreThanOne.` The other variables in the suggestion are unnecessary because they will be transitively included from the minimal annotation. Alternatively, if the :cmd:`Proof using` included unneeded variables, they become extra parameters of the theorem, which may generate errors. This :ref:`example ` shows an example of an unneeded variable. One possible error is `(in proof ) Attempt to save an incomplete proof`, which may indicate that the named theorem refers to an an earlier theorem that has an incorrect annotation. Automatic suggestion of proof annotations ````````````````````````````````````````` The :flag:`Suggest Proof Using` flag makes Coq suggest, when a :cmd:`Qed` command is processed, a correct proof annotation. It is up to the user to modify the proof script accordingly. Proof blocks and error resilience -------------------------------------- In interactive mode Coq is able to completely check a document containing errors instead of bailing out at the first failure. Two kind of errors are handled: errors occurring in commands and errors occurring in proofs. To properly recover from a failing tactic, Coq needs to recognize the structure of the proof in order to confine the error to a sub proof. Proof block detection is performed by looking at the syntax of the proof script (i.e. also looking at indentation). Coq comes with four kind of proof blocks, and an ML API to add new ones. :curly: blocks are delimited by { and }, see Chapter :ref:`proofhandling` :par: blocks are atomic, i.e. just one tactic introduced by the `par:` goal selector :indent: blocks end with a tactic indented less than the previous one :bullet: blocks are delimited by two equal bullet signs at the same indentation level Caveats ```````` When a command fails the subsequent error messages may be bogus, i.e. caused by the first error. Error resilience for commands can be switched off by passing ``-async-proofs-command-error-resilience off`` to CoqIDE. An incorrect proof block detection can result into an incorrect error recovery and hence in bogus errors. Proof block detection cannot be precise for bullets or any other non-well parenthesized proof structure. Error resilience can be turned off or selectively activated for any set of block kind passing to CoqIDE one of the following options: - ``-async-proofs-tactic-error-resilience off`` - ``-async-proofs-tactic-error-resilience all`` - ``-async-proofs-tactic-error-resilience`` :n:`{*, blocktype}` Valid proof block types are: “curly”, “par”, “indent”, and “bullet”. .. _interactive-mode: Interactive mode --------------------- .. todo: How about PG and coqtail? CoqIDE and VsCoq support asynchronous proof processing. When CoqIDE is started and async mode is enabled, two or more Coq processes are created. The master one follows the user, giving feedback as soon as possible by skipping proofs, which are delegated to the worker processes. The worker processes asynchronously processes the proofs. The *Jobs panel* in the main CoqIDE window shows the status of each worker process. If a proof contains an error, it's reported in red in the label of the very same button, that can also be used to see the list of errors and jump to the corresponding line. If a proof is processed asynchronously the corresponding :cmd:`Qed` command is colored using a lighter color than usual. This signals that the proof has been delegated to a worker process (or will be processed lazily if the ``-async-proofs lazy`` option is used). Once finished, the worker process will provide the proof object, but this will not be automatically checked by the kernel of the main process. To force the kernel to check all the proof objects, one has to click the button with the gears (Fully check the document) on the top bar. Only then all the universe constraints are checked. Caveats ``````` The number of worker processes can be increased by passing CoqIDE the ``-async-proofs-j n`` flag. Note that the memory consumption increases too, since each worker requires the same amount of memory as the master process. Also note that increasing the number of workers may reduce the reactivity of the master process to user commands. To disable this feature, one can pass the ``-async-proofs off`` flag to CoqIDE. Conversely, on Windows, where the feature is disabled by default, pass the ``-async-proofs on`` flag to enable it. Proofs that are known to take little time to process are not delegated to a worker process. The threshold can be configured with ``-async-proofs-delegation-threshold``. Default is 0.03 seconds. coq-8.20.0/doc/sphinx/addendum/program.rst000066400000000000000000000334631466560755400204560ustar00rootroot00000000000000.. this should be just "_program", but refs to it don't work .. _programs: Program ======== :Author: Matthieu Sozeau We present here the |Program| tactic commands, used to build certified Coq programs, elaborating them from their algorithmic skeleton and a rich specification :cite:`sozeau06`. It can be thought of as a dual of :ref:`Extraction `. The goal of |Program| is to program as in a regular functional programming language whilst using as rich a specification as desired and proving that the code meets the specification using the whole Coq proof apparatus. This is done using a technique originating from the “Predicate subtyping” mechanism of PVS :cite:`Rushby98`, which generates type checking conditions while typing a term constrained to a particular type. Here we insert existential variables in the term, which must be filled with proofs to get a complete Coq term. |Program| replaces the |Program| tactic by Catherine 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 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 into Coq terms. The interpretation process may produce some proof 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 :g:`P : Prop`. If we go from :g:`T` to the subset of :g:`T` verifying property :g:`P`, we must prove that the object under consideration verifies it. Russell will generate an obligation for every such coercion. In the other direction, Russell will automatically insert a projection. Another distinction is the treatment of pattern matching. Apart from the following differences, it is equivalent to the standard match operation (see :ref:`extendedpatternmatching`). + Generation of equalities. A match expression is always generalized by the corresponding equality. As an example, the expression: :: match x with | 0 => t | S n => u end. will be first rewritten to: :: (match x as y return (x = y -> _) with | 0 => fun H : x = 0 -> t | S n => fun H : x = S n -> u end) (eq_refl x). This permits to get the proper equalities in the context of proof obligations inside clauses, without which reasoning is very limited. + Generation of disequalities. If a pattern intersects with a previous one, a disequality is added in the context of the second branch. See for example the definition of div2 below, where the second branch is typed in a context where :g:`∀ p, _ <> S (S p)`. + Coercion. If the object being matched is coercible to an inductive type, the corresponding coercion will be automatically inserted. This also works with the previous mechanism. There are flags to control the generation of equalities and coercions. .. flag:: Program Cases This :term:`flag` 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 deactivated. .. flag:: Program Generalized Coercion This :term:`flag` 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. .. flag:: Program Mode This :term:`flag` enables the program mode, in which 1) typechecking allows subset coercions and 2) the elaboration of pattern matching of :cmd:`Fixpoint` and :cmd:`Definition` acts as if the :attr:`program` attribute has been used, generating obligations if there are unresolved holes after typechecking. .. attr:: program{? = {| yes | no } } :name: program; Program This :term:`boolean attribute` allows using or disabling the Program mode on a specific definition. An alternative and commonly used syntax is to use the legacy ``Program`` 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 pattern matching if a ``return`` or ``in`` clause is specified. Likewise, the if construct is not treated specially by |Program| so boolean tests in the code are not automatically reflected in the obligations. One can use the :g:`dec` combinator to get the correct hypotheses as in: .. coqtop:: in Require Import Program Arith. .. coqtop:: all Program Definition id (n : nat) : { x : nat | x = n } := if dec (leb n 0) then 0 else S (pred n). The :g:`let` tupling construct :g:`let (x1, ..., xn) := t in b` does not produce an equality, contrary to the let pattern construct :g:`let '(x1,..., xn) := t in b`. The next two commands are similar to their standard counterparts :cmd:`Definition` and :cmd:`Fixpoint` in that they define :term:`constants `. However, they may require the user to prove some goals to construct the final definitions. .. _program_definition: Program Definition ~~~~~~~~~~~~~~~~~~ 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 global environment. :n:`Program Definition @ident_decl : @type := @term` 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:: Non extensible universe declaration not supported with monomorphic Program Definition. The absence of additional universes or constraints cannot be properly enforced even without Program. .. seealso:: Sections :ref:`controlling-the-reduction-strategies`, :tacn:`unfold` .. _program_fixpoint: Program Fixpoint ~~~~~~~~~~~~~~~~ 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 Require Import Program Arith. .. coqtop:: all Program Fixpoint div2 (n : nat) : { x : nat | n = 2 * x \/ n = 2 * x + 1 } := match n with | S (S p) => S (div2 p) | _ => 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). .. coqtop:: all Obligation 1. .. coqtop:: reset none Require Import Program Arith. One can use a well-founded order or a measure as termination orders using the syntax: .. coqtop:: in Program Fixpoint div2 (n : nat) {measure n} : { x : nat | n = 2 * x \/ n = 2 * x + 1 } := match n with | S (S p) => S (div2 p) | _ => O end. .. note:: The :g:`measure f R` and :g:`wf R x` annotations add an implicit argument to the functions being defined. When the function name is prefixed with :g:`@` (see :ref:`deactivation-of-implicit-arguments`), the position of the extra argument needs to be taken into account, e.g. by providing :g:`_` or an an explicit value. .. 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 transparent (e.g. defined using :g:`Defined`) so that the guardedness condition on recursive calls can be checked by the kernel’s type- checker. There is an optimization in the generation of obligations which gets rid of the hypothesis corresponding to the functional when it is not necessary, so that the obligation can be declared opaque (e.g. using :g:`Qed`). However, as soon as it appears in the context, the proof of the obligation is *required* to be declared transparent. No such problems arise when using measures or well-founded recursion. .. _program_lemma: Program Lemma ~~~~~~~~~~~~~ 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:: Obligation Tactic := @ltac_expr Sets the default obligation solving tactic applied to all obligations automatically, whether to solve them or when starting to prove one, e.g. using :cmd:`Next Obligation`. This command supports the :attr:`local`, :attr:`export` 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. :attr:`export` and :attr:`global` may be used together. When :attr:`global` is used without :attr:`export` and when no explicit locality is used outside sections, the meaning is different from the usual meaning of :attr:`global`: the command's effect persists after the current module is closed (as with the usual :attr:`global`), but it is also reapplied when the module or any of its parents is imported. This will change in a future version. .. cmd:: Show Obligation Tactic Displays the current default tactic. .. cmd:: Obligations {? of @ident } Displays all remaining obligations. .. cmd:: Obligation @natural {? of @ident } {? : @type {? with @ltac_expr } } Start the proof of obligation :token:`natural`. .. cmd:: Next Obligation {? of @ident } {? with @ltac_expr } Start the proof of the next unsolved obligation. .. cmd:: Final Obligation {? of @ident } {? with @ltac_expr } Like :cmd:`Next Obligation`, starts the proof of the next unsolved obligation. Additionally, at :cmd:`Qed` time, after the automatic solver has run on any remaining obligations, Coq checks that no obligations remain for the given :token:`ident` when provided and otherwise in the current module. .. cmd:: Solve Obligations {? of @ident } {? with @ltac_expr } 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 } 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 } Admits all obligations (of :token:`ident`). .. note:: Does not work with structurally recursive programs. .. cmd:: Preterm {? of @ident } Shows the term that will be fed to the kernel once the obligations are solved. Useful for debugging. .. flag:: Transparent Obligations This :term:`flag` controls whether all obligations should be declared as transparent (the default), or if the system should infer which obligations can be declared opaque. The module :g:`Coq.Program.Tactics` defines the default tactic for solving obligations called :g:`program_simpl`. Importing :g:`Coq.Program.Program` also adds some useful notations, as documented in the file itself. .. _program-faq: Frequently Asked Questions --------------------------- .. exn:: Ill-formed recursive definition. This error can happen when one tries to define a function by structural recursion on a subset object, which means the Coq function looks like: :: Program Fixpoint f (x : A | P) := match x with A b => f b end. Supposing ``b : A``, the argument at the recursive call to ``f`` is not a direct subterm of ``x`` as ``b`` is wrapped inside an ``exist`` constructor to build an object of type ``{x : A | P}``. Hence the definition is rejected by the guardedness condition checker. However one can use wellfounded recursion on subset objects like this: :: Program Fixpoint f (x : A | P) { measure (size x) } := match x with A b => f b end. One will then just have to prove that the measure decreases at each recursive call. There are three drawbacks though: #. A measure function has to be defined; #. The reduction is a little more involved, although it works well using lazy evaluation; #. Mutual recursion on the underlying inductive type isn’t possible anymore, but nested mutual recursion is always possible. coq-8.20.0/doc/sphinx/addendum/rewrite-rules.rst000066400000000000000000000172651466560755400216220ustar00rootroot00000000000000:COQTOP_ARGS: -allow-rewrite-rules .. _rewrite_rules: User-defined rewrite rules ========================== .. warning:: Rewrite rules are highly experimental. In particular, ill-typed rewrite rules will lead to mistyped expressions, and manipulating these will most often result in inconsistencies and anomalies. This section describes the extension of Coq's reduction mechanisms with user-defined rewrite rules, as a means to extend definitional equality. It should not be confused with the :ref:`rewrite tactic ` or :ref:`setoid rewriting ` which operate on propositional equality and other relations which are defined in Coq. Rewrite rules need to be enabled by passing the option ``-allow-rewrite-rules`` to the Coq program. .. exn:: Rewrite rule declaration requires passing the flag "-allow-rewrite-rules". :undocumented: Symbols ----------------- Rewrite rules operate on symbols, which are their own kind of constants. They stand in-between defined constants and axioms, in that they don't always reduce as defined constants do, but they may still reduce using the provided rules, unlike axioms. .. cmd:: {| Symbol | Symbols } {| @assumpt | {+ ( @assumpt ) } } :name: Symbol; Symbols Binds an :n:`@ident` to a :n:`@type` as a symbol. .. coqtop:: in Symbol pplus : nat -> nat -> nat. Notation "a ++ b" := (pplus a b). Rewrite rules --------------- .. cmd:: Rewrite {| Rule | Rules } @ident := {? %| } {+| @rewrite_rule } :name: Rewrite Rule; Rewrite Rules .. insertprodn rewrite_rule rewrite_rule .. prodn:: rewrite_rule ::= {? @univ_decl %|- } @rw_pattern => @term Declares a named block of rewrite rules. The name is declared in the same namespace as constants and inductives. Rewrite rules have two parts named pattern (left-hand side) and replacement (right-hand side). Patterns are a subclass of :n:`@term`\s described :ref:`below`, while replacements are regular :n:`@term`\s, which can also refer to the pattern variables matched by the pattern with the :n:`?@name` syntax. When a rule is applied, the term is matched against the pattern, subterms aligned with pattern variables are collected and then substituted into the replacement, which is returned. .. coqtop:: all Rewrite Rule pplus_rewrite := | ?n ++ 0 => ?n | ?n ++ S ?m => S (?n ++ ?m) | 0 ++ ?n => ?n | S ?n ++ ?m => S (?n ++ ?m). .. _Pattern syntax: Pattern syntax -------------- Patterns are a subclass of :n:`@term`\s which are rigid enough to be matched against. Informally, they are terms with pattern variables (:n:`?@name`), where those may not appear on the left of applications or as the discriminee of a match or a primitive projection; furthermore a pattern may not have let-bindings, (co-)fixpoints or non-symbol constants. As a formal grammar, it is easier to understand them with the separation between head-pattern (:n:`@rw_head_pattern`) and eliminations (non-base-case constructions for :n:`@rw_pattern`): .. prodn:: rw_pattern ::= @rw_head_pattern | @rw_pattern {+ @rw_pattern_arg } | @rw_pattern .( @qualid {? @univ_annot } ) | match @rw_pattern {? as @name } {? in @pattern } {? return @rw_pattern_arg } with {? | } {*| @pattern => @rw_pattern_arg } end rw_head_pattern ::= @ident | @qualid {? @univ_annot } | fun {+ ({+ @name } {? : @rw_pattern_arg}) } => @rw_pattern_arg | forall {+ ({+ @name } {? : @rw_pattern_arg}) }, @rw_pattern_arg rw_pattern_arg ::= ?@name | _ | @rw_pattern where :n:`@qualid {? @univ_annot }` (in the second line for :n:`@rw_head_pattern`) can refer to symbols, sorts, inductives and constructors, but not arbitrary constants. The projections must be primitive to be allowed. Finally, a valid pattern needs its head head-pattern to be a symbol. Higher-order pattern holes -------------------------- Patterns with lambdas (:n:`fun`), products (:n:`forall`) and :n:`match`\es introduce new variables in the context which need to be substituted in the replacement. To this end, the user can add what to substitute each new variable with, using the syntax :n:`?@name@%{{+; @name := @term }%}`. Note that if in the replacement, the context was extended with a variable bearing the same name, this explicit substitution is inferred automatically (like for existential variable instantiations). .. coqtop:: all warn Symbol raise : forall (A : Type), A. Rewrite Rule raise_nat := match raise nat as n return ?P with 0 => _ | S _ => _ end => raise ?P@{n := raise nat}. Symbol id : forall (A : Type), A -> A. Rewrite Rule id_rew := id (forall (x : ?A), ?P) ?f => fun (x : ?A) => id ?P (?f x). Universe polymorphic rules -------------------------- Rewrite rules support universe and sort quality polymorphism. Universe levels and sort quality variables must be declared with the notation :n:`@{q1 q2|u1 u2+|+}` (the same notation as universe instance declarations); each variable must appear exactly once in the pattern. If any universe level isn't bound in the rule, as is often the case with the level of a pattern variable when it is a type, you need to make the universe instance extensible (with the final +). Universe level constraints, as inferred from the pattern, must imply those given, which in turn must imply the constraints needed for the replacement. You can make the declared constraints extensible so all inferred constraints from the left-hand side are used for the replacement. .. coqtop:: reset all warn #[universes(polymorphic)] Symbol raise@{q|u|} : forall (A : Type@{q|u}), A. Rewrite Rule raise_nat := @{q|u+|+} |- raise@{q|u} (forall (x : ?A), ?P) => fun (x : ?A) => raise@{q|u} ?P. Rewrite rules, type preservation, confluence and termination ------------------------------------------------------------ Currently, rewrite rules do not ensure that types must be preserved. There is a superficial check that the replacement needs to be typed against the type inferred for the pattern (for an unclear definition of type of a pattern), but it is known to be incomplete and only emits a warning if failed. This then means that reductions using rewrite rules have no reason to preserve well-typedness at all. The responsibility of ensuring type preservation falls on the user entirely. Similarly, neither confluence nor termination are checked by the compiler. There are future plans to add a check on confluence using the triangle criterion :cite:`TotR21` and a more complete check on type preservation. Compatibility with the eta laws ------------------------------- Currently, pattern matching against rewrite rules pattern cannot do eta-expansion or contraction, which means that it cannot properly match against terms of functional types or primitive records. As with type preservation, a check is done to test whether this may happen, but it is not complete (false positives) and thus only emits a warning if failed. Level of support ---------------- Rewrite rules have been integrated into the kernel and the most used parts of the upper layers. Notably, reduction machines simpl, cbn and cbv can reduce on rewrite rules, with some limitations (e.g. simpl cannot reduce on rules which contain a match). Also, regular unification can work with rewrite rules, as well as apply's unification mechanism in a limited manner (only if the pattern contains no match or projections). On the other hand, some operations are not supported, such as declaring rules in sections and some interactions with modules. Since rewrite rules may introduce untyped terms, which the VM and native reduction machines don't support (risk of segfault or code injection), they are turned off when rewrite rules are enabled. coq-8.20.0/doc/sphinx/addendum/ring.rst000066400000000000000000000732451466560755400177500ustar00rootroot00000000000000.. |bdi| replace:: βδι .. |ra| replace:: :math:`\rightarrow_{\beta\delta\iota}` .. |la| replace:: :math:`\leftarrow_{\beta\delta\iota}` .. |eq| replace:: `=`:sub:`(by the main correctness theorem)` .. |re| replace:: ``(PEeval`` `v` `ap`\ ``)`` .. |le| replace:: ``(Pphi_dev`` `v` ``(norm`` `ap`\ ``))`` .. |N| replace:: ``N`` .. |nat| replace:: ``nat`` .. |Z| replace:: ``Z`` .. _theringandfieldtacticfamilies: ring and field: solvers for polynomial and rational equations ============================================================= :Author: Bruno Barras, Benjamin Grégoire, Assia Mahboubi, Laurent Théry [#f1]_ This chapter presents the tactics dedicated to dealing with ring and field equations. What does this tactic do? ------------------------------ ``ring`` does associative-commutative rewriting in ring and semiring structures. Assume you have two binary functions :math:`\oplus` and :math:`\otimes` that are associative and commutative, with :math:`\oplus` distributive on :math:`\otimes`, and two constants 0 and 1 that are unities for :math:`\oplus` and :math:`\otimes`. A polynomial is an expression built on variables :math:`V_0`, :math:`V_1`, :math:`\dots` and constants by application of :math:`\oplus` and :math:`\otimes`. Let an ordered product be a product of variables :math:`V_{i_1} \otimes \dots \otimes V_{i_n}` verifying :math:`i_1 ≤ i_2 ≤ \dots ≤ i_n` . Let a monomial be the product of a constant and an ordered product. We can order the monomials by the lexicographic order on products of variables. Let a canonical sum be an ordered sum of monomials that are all different, i.e. each monomial in the sum is strictly less than the following monomial according to the lexicographic order. It is an easy theorem to show that every polynomial is equivalent (modulo the ring properties) to exactly one canonical sum. This canonical sum is called the normal form of the polynomial. In fact, the actual representation shares monomials with same prefixes. So what does the ``ring`` tactic do? It normalizes polynomials over any ring or semiring structure. The basic use of ``ring`` is to simplify ring expressions, so that the user does not have to deal manually with the theorems of associativity and commutativity. .. example:: In the ring of integers, the normal form of :math:`x (3 + yx + 25(1 − z)) + zx` is :math:`28x + (−24)xz + xxy`. ``ring`` is also able to compute a normal form modulo monomial equalities. For example, under the hypothesis that :math:`2x^2 = yz+1`, the normal form of :math:`2(x + 1)x − x − zy` is :math:`x+1`. The variables map ---------------------- It is frequent to have an expression built with :math:`+` and :math:`\times`, but rarely on variables only. Let us associate a number to each subterm of a ring expression in the Gallina language. For example, consider this expression in the semiring ``nat``: :: (plus (mult (plus (f (5)) x) x) (mult (if b then (4) else (f (3))) (2))) As a ring expression, it has 3 subterms. Give each subterm a number in an arbitrary order: ===== =============== ========================= 0 :math:`\mapsto` if b then (4) else (f (3)) 1 :math:`\mapsto` (f (5)) 2 :math:`\mapsto` x ===== =============== ========================= Then normalize the “abstract” polynomial :math:`((V_1 \oplus V_2 ) \otimes V_2) \oplus (V_0 \otimes 2)` In our example the normal form is: :math:`(2 \otimes V_0 ) \oplus (V_1 \otimes V_2) \oplus (V_2 \otimes V_2 )`. Then substitute the variables by their values in the variables map to get the concrete normal polynomial: :: (plus (mult (2) (if b then (4) else (f (3)))) (plus (mult (f (5)) x) (mult x x))) Is it automatic? --------------------- 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 -------------------------- .. tacn:: ring {? [ {+ @one_term } ] } Solves polynomical equations of a ring (or semiring) structure. It proceeds by normalizing both sides of the equation (w.r.t. associativity, commutativity and distributivity, constant propagation, rewriting of monomials) and syntactically comparing the results. :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 :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 first require the module ``ArithRing`` exported by ``Arith``); for |Z|, do ``Require Import ZArithRing`` or simply ``Require Import ZArith``; for |N|, do ``Require Import NArithRing`` or ``Require Import NArith``. All declared field structures can be printed with the :cmd:`Print Rings` command. .. cmd:: Print Rings :undocumented: .. example:: .. coqtop:: all Require Import ZArith. Open Scope Z_scope. Goal forall a b c:Z, (a + b + c) ^ 2 = a * a + b ^ 2 + c * c + 2 * a * b + 2 * a * c + 2 * b * c. intros; ring. Abort. Goal forall a b:Z, 2 * a * b = 30 -> (a + b) ^ 2 = a ^ 2 + b ^ 2 + 30. intros a b H; ring [H]. Abort. Error messages: .. exn:: Not a valid ring equation. The conclusion of the goal is not provable in the corresponding ring theory. .. exn:: Arguments of ring_simplify do not have all the same type. :tacn:`ring_simplify` cannot simplify terms of several rings at the same time. Invoke the tactic once per ring structure. .. exn:: Cannot find a declared ring structure over @term. No ring has been declared for the type of the terms to be simplified. Use :cmd:`Add Ring` first. .. exn:: Cannot find a declared ring structure for equality @term. Same as above in the case of the :tacn:`ring` tactic. .. tacn:: ring_lookup @ltac_expr0 [ {* @one_term } ] {+ @one_term } protect_fv @string {? in @ident } For internal use only. Adding a ring structure ---------------------------- Declaring a new ring consists in proving that a ring signature (a carrier set, an equality, and ring operations: ``Ring_theory.ring_theory`` and ``Ring_theory.semi_ring_theory``) satisfies the ring axioms. Semi- rings (rings without + inverse) are also supported. The equality can be either Leibniz equality, or any relation declared as a setoid (see :ref:`tactics-enabled-on-user-provided-relations`). The definitions of ring and semiring (see module ``Ring_theory``) are: .. coqdoc:: Record ring_theory : Prop := mk_rt { Radd_0_l : forall x, 0 + x == x; Radd_sym : forall x y, x + y == y + x; Radd_assoc : forall x y z, x + (y + z) == (x + y) + z; Rmul_1_l : forall x, 1 * x == x; Rmul_sym : forall x y, x * y == y * x; Rmul_assoc : forall x y z, x * (y * z) == (x * y) * z; Rdistr_l : forall x y z, (x + y) * z == (x * z) + (y * z); Rsub_def : forall x y, x - y == x + -y; Ropp_def : forall x, x + (- x) == 0 }. Record semi_ring_theory : Prop := mk_srt { SRadd_0_l : forall n, 0 + n == n; SRadd_sym : forall n m, n + m == m + n ; SRadd_assoc : forall n m p, n + (m + p) == (n + m) + p; SRmul_1_l : forall n, 1*n == n; SRmul_0_l : forall n, 0*n == 0; SRmul_sym : forall n m, n*m == m*n; SRmul_assoc : forall n m p, n*(m*p) == (n*m)*p; SRdistr_l : forall n m p, (n + m)*p == n*p + m*p }. This implementation of ``ring`` also features a notion of constant that can be parameterized. This can be used to improve the handling of closed expressions when operations are effective. It consists in introducing a type of *coefficients* and an implementation of the ring operations, and a morphism from the coefficient type to the ring carrier type. The morphism needs not be injective, nor surjective. As an example, one can consider the real numbers. The set of coefficients could be the rational numbers, upon which the ring operations can be implemented. The fact that there exists a morphism is defined by the following properties: .. coqdoc:: Record ring_morph : Prop := mkmorph { morph0 : [cO] == 0; morph1 : [cI] == 1; morph_add : forall x y, [x +! y] == [x]+[y]; morph_sub : forall x y, [x -! y] == [x]-[y]; morph_mul : forall x y, [x *! y] == [x]*[y]; morph_opp : forall x, [-!x] == -[x]; morph_eq : forall x y, x?=!y = true -> [x] == [y] }. Record semi_morph : Prop := mkRmorph { Smorph0 : [cO] == 0; Smorph1 : [cI] == 1; Smorph_add : forall x y, [x +! y] == [x]+[y]; Smorph_mul : forall x y, [x *! y] == [x]*[y]; Smorph_eq : forall x y, x?=!y = true -> [x] == [y] }. where ``c0`` and ``cI`` denote the 0 and 1 of the coefficient set, ``+!``, ``*!``, ``-!`` are the implementations of the ring operations, ``==`` is the equality of the coefficients, ``?+!`` is an implementation of this equality, and ``[x]`` is a notation for the image of ``x`` by the ring morphism. Since |Z| is an initial ring (and |N| is an initial semiring), it can always be considered as a set of coefficients. There are basically three kinds of (semi-)rings: abstract rings to be used when operations are not effective. The set of coefficients is |Z| (or |N| for semirings). computational rings to be used when operations are effective. The set of coefficients is the ring itself. The user only has to provide an implementation for the equality. customized ring for other cases. The user has to provide the coefficient set and the morphism. This implementation of ring can also recognize simple power expressions as ring expressions. A power function is specified by the following property: .. coqtop:: in Require Import Reals. Section POWER. Variable Cpow : Set. Variable Cp_phi : N -> Cpow. Variable rpow : R -> Cpow -> R. Record power_theory : Prop := mkpow_th { rpow_pow_N : forall r n, rpow r (Cp_phi n) = pow_N 1%R Rmult r n }. End POWER. The syntax for adding a new ring is .. cmd:: Add Ring @ident : @one_term {? ( {+, @ring_mod } ) } .. insertprodn ring_mod ring_mod .. prodn:: ring_mod ::= decidable @one_term | abstract | morphism @one_term | constants [ @ltac_expr ] | preprocess [ @ltac_expr ] | postprocess [ @ltac_expr ] | setoid @one_term @one_term | sign @one_term | power @one_term [ {+ @qualid } ] | power_tac @one_term [ @ltac_expr ] | div @one_term | closed [ {+ @qualid } ] The :n:`@ident` is used only for error messages. The :n:`@one_term` is a proof that the ring signature satisfies the (semi-)ring axioms. The optional list of modifiers is used to tailor the behavior of the tactic. Here are their effects: :n:`abstract` declares the ring as abstract. This is the default. :n:`decidable @one_term` declares the ring as computational. The expression :n:`@one_term` is the correctness proof of an equality test ``?=!`` (which should be evaluable). Its type should be of the form ``forall x y, x ?=! y = true → x == y``. :n:`morphism @one_term` declares the ring as a customized one. The expression :n:`@one_term` is a proof that there exists a morphism between a set of coefficient and the ring carrier (see ``Ring_theory.ring_morph`` and ``Ring_theory.semi_morph``). :n:`setoid @one_term @one_term` forces the use of given setoid. The first :n:`@one_term` is a proof that the equality is indeed a setoid (see ``Setoid.Setoid_Theory``), and the second a proof that the ring operations are morphisms (see ``Ring_theory.ring_eq_ext`` and ``Ring_theory.sring_eq_ext``). This modifier needs not be used if the setoid and morphisms have been declared. :n:`constants [ @ltac_expr ]` specifies a tactic expression :n:`@ltac_expr` that, given a term, returns either an object of the coefficient set that is mapped to the expression via the morphism, or returns ``InitialRing.NotConstant``. The default behavior is to map only 0 and 1 to their counterpart in the coefficient set. This is generally not desirable for nontrivial computational rings. :n:`preprocess [ @ltac_expr ]` specifies a tactic :n:`@ltac_expr` that is applied as a preliminary step for :tacn:`ring` and :tacn:`ring_simplify`. It can be used to transform a goal so that it is better recognized. For instance, ``S n`` can be changed to ``plus 1 n``. :n:`postprocess [ @ltac_expr ]` specifies a tactic :n:`@ltac_expr` that is applied as a final step for :tacn:`ring_simplify`. For instance, it can be used to undo modifications of the preprocessor. :n:`power @one_term [ {+ @qualid } ]` to be documented :n:`power_tac @one_term @ltac_expr ]` allows :tacn:`ring` and :tacn:`ring_simplify` to recognize power expressions with a constant positive integer exponent (example: :math:`x^2` ). The term :n:`@one_term` is a proof that a given power function satisfies the specification of a power function (term has to be a proof of ``Ring_theory.power_theory``) and :n:`@tactic` specifies a tactic expression that, given a term, “abstracts” it into an object of type |N| whose interpretation via ``Cp_phi`` (the evaluation function of power coefficient) is the original term, or returns ``InitialRing.NotConstant`` if not a constant coefficient (i.e. |Ltac| is the inverse function of ``Cp_phi``). See files ``plugins/ring/ZArithRing.v`` and ``plugins/ring/RealField.v`` for examples. By default the tactic does not recognize power expressions as ring expressions. :n:`sign @one_term` allows :tacn:`ring_simplify` to use a minus operation when outputting its normal form, i.e writing ``x − y`` instead of ``x + (− y)``. The term :token:`term` is a proof that a given sign function indicates expressions that are signed (:token:`term` has to be a proof of ``Ring_theory.get_sign``). See ``plugins/ring/InitialRing.v`` for examples of sign function. :n:`div @one_term` allows :tacn:`ring` and :tacn:`ring_simplify` to use monomials with coefficients other than 1 in the rewriting. The term :n:`@one_term` is a proof that a given division function satisfies the specification of an euclidean division function (:n:`@one_term` has to be a proof of ``Ring_theory.div_theory``). For example, this function is called when trying to rewrite :math:`7x` by :math:`2x = z` to tell that :math:`7 = 3 \times 2 + 1`. See ``plugins/ring/InitialRing.v`` for examples of div function. :n:`closed [ {+ @qualid } ]` to be documented Error messages: .. exn:: Bad ring structure. The proof of the ring structure provided is not of the expected type. .. exn:: Bad lemma for decidability of equality. The equality function provided in the case of a computational ring has not the expected type. .. exn:: Ring operation should be declared as a morphism. A setoid associated with the carrier of the ring structure has been found, but the ring operation should be declared as morphism. See :ref:`tactics-enabled-on-user-provided-relations`. 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 philosophical point of view, reflection is using the ability of the Calculus of Constructions to speak and reason about itself. For the ``ring`` tactic we used Coq as a programming language and also as a proof environment to build a tactic and to prove its correctness. The interested reader is strongly advised to have a look at the file ``Ring_polynom.v``. Here a type for polynomials is defined: .. coqdoc:: Inductive PExpr : Type := | PEc : C -> PExpr | PEX : positive -> PExpr | PEadd : PExpr -> PExpr -> PExpr | PEsub : PExpr -> PExpr -> PExpr | PEmul : PExpr -> PExpr -> PExpr | PEopp : PExpr -> PExpr | PEpow : PExpr -> N -> PExpr. Polynomials in normal form are defined as: .. coqdoc:: Inductive Pol : Type := | Pc : C -> Pol | Pinj : positive -> Pol -> Pol | PX : Pol -> positive -> Pol -> Pol. where ``Pinj n P`` denotes ``P`` in which :math:`V_i` is replaced by :math:`V_{i+n}` , and ``PX P n Q`` denotes :math:`P \otimes V_1^n \oplus Q'`, `Q'` being `Q` where :math:`V_i` is replaced by :math:`V_{i+1}`. Variable maps are represented by lists of ring elements, and two interpretation functions, one that maps a variables map and a polynomial to an element of the concrete ring, and the second one that does the same for normal forms: .. coqdoc:: Definition PEeval : list R -> PExpr -> R := [...]. Definition Pphi_dev : list R -> Pol -> R := [...]. A function to normalize polynomials is defined, and the big theorem is its correctness w.r.t interpretation, that is: .. coqdoc:: Definition norm : PExpr -> Pol := [...]. Lemma Pphi_dev_ok : forall l pe npe, norm pe = npe -> PEeval l pe == Pphi_dev l npe. So now, what is the scheme for a normalization proof? Let p be the polynomial expression that the user wants to normalize. First a little piece of ML code guesses the type of `p`, the ring theory `T` to use, an abstract polynomial `ap` and a variables map `v` such that `p` is |bdi|- equivalent to `(PEeval v ap)`. Then we replace it by `(Pphi_dev v (norm ap))`, using the main correctness theorem and we reduce it to a concrete expression `p’`, which is the concrete normal form of `p`. This is summarized in this diagram: ========= ====== ==== `p` |ra| |re| \ |eq| \ `p’` |la| |le| ========= ====== ==== The user does not see the right part of the diagram. From outside, the tactic behaves like a |bdi| simplification extended with rewriting rules for associativity and commutativity. Basically, the proof is only the application of the main correctness theorem to well-chosen arguments. Dealing with fields ------------------------ .. tacn:: field {? [ {+ @one_term } ] } 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 which is a conjunction if there are several denominators. Nonzero conditions are always polynomial expressions. For example when reducing the expression :math:`1/(1 + 1/x)`, two side conditions are generated: :math:`x \neq 0` and :math:`x + 1 \neq 0`. Factorized expressions are broken since a field is an integral domain, and when the equality test on coefficients is complete w.r.t. the equality of the target field, constants can be proven different from zero automatically. The tactic must be loaded by ``Require Import Field``. New field structures can be declared to the system with the ``Add Field`` command (see below). The field of real numbers is defined in module ``RealField`` (in ``plugins/ring``). It is exported by module ``Rbase``, so that requiring ``Rbase`` or ``Reals`` is enough to use the field tactics on real numbers. Rational numbers in canonical form are also declared as a field in the module ``Qcanon``. .. example:: .. coqtop:: all Require Import Reals. Open Scope R_scope. Goal forall x, x <> 0 -> (1 - 1 / x) * x - x + 1 = 0. intros; field; auto. Abort. Goal forall x y, y <> 0 -> y = x -> x / y = 1. intros x y H H1; field [H1]; auto. Abort. .. example:: :tacn:`field` that generates side goals .. coqtop:: reset all Require Import Reals. Goal forall x y:R, (x * y > 0)%R -> (x * (1 / x + x / (x + y)))%R = ((- 1 / y) * y * (- x * (x / (x + y)) - 1))%R. intros; field. .. tacn:: field_simplify {? [ {+ @one_term__eq } ] } {+ @one_term } {? in @ident } 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. :n:`[ {+ @one_term__eq } ]` Do simplification in the conclusion of the goal using the equalities defined by these :token:`one_term`\s. :n:`{+ @one_term }` Terms to simplify in the conclusion. :n:`in @ident` If specified, substitute in the hypothesis :n:`@ident` instead of the conclusion. .. tacn:: field_simplify_eq {? [ {+ @one_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 } ]` Do simplification in the conclusion of the goal using the equalities defined by these :token:`one_term`\s. :n:`in @ident` If specified, simplify in the hypothesis :n:`@ident` instead of the conclusion. .. tacn:: field_lookup @ltac_expr [ {* @one_term } ] {+ @one_term } For internal use only. Adding a new field structure --------------------------------- Declaring a new field consists in proving that a field signature (a carrier set, an equality, and field operations: ``Field_theory.field_theory`` and ``Field_theory.semi_field_theory``) satisfies the field axioms. Semi-fields (fields without + inverse) are also supported. The equality can be either Leibniz equality, or any relation declared as a setoid (see :ref:`tactics-enabled-on-user-provided-relations`). The definition of fields and semifields is: .. coqdoc:: Record field_theory : Prop := mk_field { F_R : ring_theory rO rI radd rmul rsub ropp req; F_1_neq_0 : ~ 1 == 0; Fdiv_def : forall p q, p / q == p * / q; Finv_l : forall p, ~ p == 0 -> / p * p == 1 }. Record semi_field_theory : Prop := mk_sfield { SF_SR : semi_ring_theory rO rI radd rmul req; SF_1_neq_0 : ~ 1 == 0; SFdiv_def : forall p q, p / q == p * / q; SFinv_l : forall p, ~ p == 0 -> / p * p == 1 }. The result of the normalization process is a fraction represented by the following type: .. coqdoc:: Record linear : Type := mk_linear { num : PExpr C; denum : PExpr C; condition : list (PExpr C) }. where ``num`` and ``denum`` are the numerator and denominator; ``condition`` is a list of expressions that have appeared as a denominator during the normalization process. These expressions must be proven different from zero for the correctness of the algorithm. The syntax for adding a new field is .. cmd:: Add Field @ident : @one_term {? ( {+, @field_mod } ) } .. insertprodn field_mod field_mod .. prodn:: field_mod ::= @ring_mod | completeness @one_term The :n:`@ident` is used only for error messages. :n:`@one_term` is a proof that the field signature satisfies the (semi-)field axioms. The optional list of modifiers is used to tailor the behavior of the tactic. Since field tactics are built upon ``ring`` tactics, all modifiers of :cmd:`Add Ring` apply. There is only one specific modifier: completeness :n:`@one_term` allows the field tactic to prove automatically that the image of nonzero coefficients are mapped to nonzero elements of the field. :n:`@one_term` is a proof of :g:`forall x y, [x] == [y] -> x ?=! y = true`, which is the completeness of equality on coefficients w.r.t. the field equality. .. cmd:: Print Fields :undocumented: History of ring -------------------- First Samuel Boutin designed the tactic ``ACDSimpl``. This tactic did lot of rewriting. But the proofs terms generated by rewriting were too big for Coq’s type checker. Let us see why: .. coqtop:: reset all Require Import ZArith. Open Scope Z_scope. Goal forall x y z : Z, x + 3 + y + y * z = x + 3 + y + z * y. intros; rewrite (Zmult_comm y z); reflexivity. Save foo. Print foo. At each step of rewriting, the whole context is duplicated in the proof term. Then, a tactic that does hundreds of rewriting generates huge proof terms. Since ``ACDSimpl`` was too slow, Samuel Boutin rewrote it using reflection (see :cite:`Bou97`). Later, it was rewritten by Patrick Loiseleur: the new tactic does not any more require ``ACDSimpl`` to compile and it makes use of |bdi|-reduction not only to replace the rewriting steps, but also to achieve the interleaving of computation and reasoning (see :ref:`discussion_reflection`). He also wrote some ML code for the ``Add Ring`` command that allows registering new rings dynamically. Proofs terms generated by ring are quite small, they are linear in the number of :math:`\oplus` and :math:`\otimes` operations in the normalized terms. Type checking those terms requires some time because it makes a large use of the conversion rule, but memory requirements are much smaller. .. _discussion_reflection: Discussion ---------------- Efficiency is not the only motivation to use reflection here. ``ring`` also deals with constants, it rewrites for example the expression ``34 + 2 * x − x + 12`` to the expected result ``x + 46``. For the tactic ``ACDSimpl``, the only constants were 0 and 1. So the expression ``34 + 2 * (x − 1) + 12`` is interpreted as :math:`V_0 \oplus V_1 \otimes (V_2 \ominus 1) \oplus V_3`\ , with the variables mapping :math:`\{V_0 \mapsto 34; V_1 \mapsto 2; V_2 \mapsto x; V_3 \mapsto 12\}`\ . Then it is rewritten to ``34 − x + 2 * x + 12``, very far from the expected result. Here rewriting is not sufficient: you have to do some kind of reduction (some kind of computation) to achieve the normalization. The tactic ``ring`` is not only faster than the old one: by using reflection, we get for free the integration of computation and reasoning that would be very difficult to implement without it. Is it the ultimate way to write tactics? The answer is: yes and no. The ``ring`` tactic intensively uses the conversion rules of the Calculus of Inductive Constructions, i.e. it replaces proofs by computations as much as possible. It can be useful in all situations where a classical tactic generates huge proof terms, like symbolic processing and tautologies. But there are also tactics like ``auto`` or ``linear`` that do many complex computations, using side-effects and backtracking, and generate a small proof term. Clearly, it would be significantly less efficient to replace them by tactics using reflection. Another idea suggested by Benjamin Werner: reflection could be used to couple an external tool (a rewriting program or a model checker) with Coq. We define (in Coq) a type of terms, a type of *traces*, and prove a correctness theorem that states that *replaying traces* is safe with respect to some interpretation. Then we let the external tool do every computation (using side-effects, backtracking, exception, or others features that are not available in pure lambda calculus) to produce the trace. Now we can check in Coq that the trace has the expected semantics by applying the correctness theorem. .. rubric:: Footnotes .. [#f1] based on previous work from Patrick Loiseleur and Samuel Boutin coq-8.20.0/doc/sphinx/addendum/sprop.rst000066400000000000000000000201011466560755400201330ustar00rootroot00000000000000.. _sprop: SProp (proof irrelevant propositions) ===================================== .. warning:: The status of strict propositions is experimental. In particular, conversion checking through bytecode or native code compilation currently does not understand proof irrelevance. This section describes the extension of Coq with definitionally proof irrelevant propositions (types in the sort :math:`\SProp`, also known as strict propositions) as described in :cite:`Gilbert:POPL2019`. Use of |SProp| may be disabled by passing ``-disallow-sprop`` to the Coq program or by turning the :flag:`Allow StrictProp` flag off. .. flag:: Allow StrictProp This :term:`flag` enables or disables the use of |SProp|. It is enabled by default. The command-line flag ``-disallow-sprop`` disables |SProp| at startup. .. exn:: SProp is disallowed because the "Allow StrictProp" flag is off. :undocumented: Some of the definitions described in this document are available through ``Coq.Logic.StrictProp``, which see. Basic constructs ---------------- The purpose of :math:`\SProp` is to provide types where all elements are convertible: .. coqtop:: all Theorem irrelevance (A : SProp) (P : A -> Prop) : forall x : A, P x -> forall y : A, P y. Proof. intros * Hx *. exact Hx. Qed. Since we have definitional :ref:`eta-expansion-sect` for functions, the property of being a type of definitionally irrelevant values is impredicative, and so is :math:`\SProp`: .. coqtop:: all Check fun (A:Type) (B:A -> SProp) => (forall x:A, B x) : SProp. In order to keep conversion tractable, cumulativity for :math:`\SProp` is forbidden. .. coqtop:: all Fail Check (fun (A:SProp) => A : Type). We can explicitly lift strict propositions into the relevant world by using a wrapping inductive type. The inductive stops definitional proof irrelevance from escaping. .. coqtop:: in Inductive Box (A:SProp) : Prop := box : A -> Box A. Arguments box {_} _. .. coqtop:: all Fail Check fun (A:SProp) (x y : Box A) => eq_refl : x = y. .. doesn't get merged with the above if coqdoc .. coqtop:: in Definition box_irrelevant (A:SProp) (x y : Box A) : x = y := match x, y with box x, box y => eq_refl end. In the other direction, we can use impredicativity to "squash" a relevant type, making an irrelevant approximation. .. coqdoc:: Definition iSquash (A:Type) : SProp := forall P : SProp, (A -> P) -> P. Definition isquash A : A -> iSquash A := fun a P f => f a. Definition iSquash_sind A (P : iSquash A -> SProp) (H : forall x : A, P (isquash A x)) : forall x : iSquash A, P x := fun x => x (P x) (H : A -> P x). Or more conveniently (but equivalently) .. coqdoc:: Inductive Squash (A:Type) : SProp := squash : A -> Squash A. Most inductives types defined in :math:`\SProp` are squashed types, i.e. they can only be eliminated to construct proofs of other strict propositions. Empty types are the only exception. .. coqtop:: in Inductive sEmpty : SProp := . .. coqtop:: all Check sEmpty_rect. .. note:: Eliminators to strict propositions are called ``foo_sind``, in the same way that eliminators to propositions are called ``foo_ind``. Primitive records in :math:`\SProp` are allowed when fields are strict propositions, for instance: .. coqtop:: in Set Primitive Projections. Record sProd (A B : SProp) : SProp := { sfst : A; ssnd : B }. On the other hand, to avoid having definitionally irrelevant types in non-:math:`\SProp` sorts (through record η-extensionality), primitive records in relevant sorts must have at least one relevant field. .. coqtop:: all Set Warnings "+non-primitive-record". Fail Record rBox (A:SProp) : Prop := rbox { runbox : A }. .. coqdoc:: Record ssig (A:Type) (P:A -> SProp) : Type := { spr1 : A; spr2 : P spr1 }. Note that ``rBox`` works as an emulated record, which is equivalent to the Box inductive. Encodings for strict propositions --------------------------------- The elimination for unit types can be encoded by a trivial function thanks to proof irrelevance: .. coqdoc:: Inductive sUnit : SProp := stt. Definition sUnit_rect (P:sUnit->Type) (v:P stt) (x:sUnit) : P x := v. By using empty and unit types as base values, we can encode other strict propositions. For instance: .. coqdoc:: Definition is_true (b:bool) : SProp := if b then sUnit else sEmpty. Definition is_true_eq_true b : is_true b -> true = b := match b with | true => fun _ => eq_refl | false => sEmpty_ind _ end. Definition eq_true_is_true b (H:true=b) : is_true b := match H in _ = x return is_true x with eq_refl => stt end. Definitional UIP ---------------- .. flag:: Definitional UIP This :term:`flag`, off by default, allows the declaration of non-squashed inductive types with 1 constructor which takes no argument in |SProp|. Since this includes equality types, it provides definitional uniqueness of identity proofs. Because squashing is a universe restriction, unsetting :flag:`Universe Checking` is stronger than setting :flag:`Definitional UIP`. Definitional UIP involves a special reduction rule through which reduction depends on conversion. Consider the following code: .. coqtop:: in Set Definitional UIP. Inductive seq {A} (a:A) : A -> SProp := srefl : seq a a. Axiom e : seq 0 0. Definition hidden_arrow := match e return Set with srefl _ => nat -> nat end. Check (fun (f : hidden_arrow) (x:nat) => (f : nat -> nat) x). By the usual reduction rules :g:`hidden_arrow` is a stuck match, but by proof irrelevance :g:`e` is convertible to :g:`srefl 0` and then by congruence :g:`hidden_arrow` is convertible to `nat -> nat`. The special reduction reduces any match on a type which uses definitional UIP when the indices are convertible to those of the constructor. For `seq`, this means a match on a value of type `seq x y` reduces if and only if `x` and `y` are convertible. Such matches are indicated in the printed representation by inserting a cast around the discriminee: .. coqtop:: out Print hidden_arrow. Non Termination with UIP ++++++++++++++++++++++++ The special reduction rule of UIP combined with an impredicative sort breaks termination of reduction :cite:`abel19:failur_normal_impred_type_theor`: .. coqtop:: all Axiom all_eq : forall (P Q:Prop), P -> Q -> seq P Q. Definition transport (P Q:Prop) (x:P) (y:Q) : Q := match all_eq P Q x y with srefl _ => x end. Definition top : Prop := forall P : Prop, P -> P. Definition c : top := fun P p => transport (top -> top) P (fun x : top => x (top -> top) (fun x => x) x) p. Fail Timeout 1 Eval lazy in c (top -> top) (fun x => x) c. The term :g:`c (top -> top) (fun x => x) c` infinitely reduces to itself. Debugging |SProp| issues ------------------------ Every binder in a term (such as `fun x` or `forall x`) caches information called the :gdef:`relevance mark` indicating whether its type is in |SProp| or not. This is used to efficiently implement proof irrelevance. The user should usually not be concerned with relevance marks, so by default they are not displayed. However code outside the kernel may generate incorrect marks resulting in bugs. Typically this means a conversion will incorrectly fail as a variable was incorrectly marked proof relevant. .. warn:: Bad relevance This is a developer warning, which is treated as an error by default. It is emitted by the kernel when it is passed a term with incorrect relevance marks. This is always caused by a bug in Coq (or a plugin), which should thus be reported and fixed. In order to allow the user to work around such bugs, we leave the ability to unset the ``bad-relevance`` warning for the time being, so that the kernel will silently repair the proof term instead of failing. .. flag:: Printing Relevance Marks This :term:`flag` enables debug printing of relevance marks. It is off by default. Note that :flag:`Printing All` does not affect printing of relevance marks. .. coqtop:: all Set Printing Relevance Marks. Check fun x : nat => x. Check fun (P:SProp) (p:P) => p. coq-8.20.0/doc/sphinx/addendum/type-classes.rst000066400000000000000000000622001466560755400214120ustar00rootroot00000000000000.. _typeclasses: Typeclasses =========== Typeclasses are types whose values Coq can automatically infer by using user declared instances. It allows for a form of programmatic proof or term search. This chapter presents a quick reference of the commands related to typeclasses. Additional helpful information can be found in the paper introducing typeclasses to Coq :cite:`sozeau08` and the literature on type classes in Haskell. Typeclass and instance declarations ----------------------------------- The syntax for typeclasses and instance declarations is the same as the record syntax of Coq: .. coqdoc:: Class classname (p1 : t1) ⋯ (pn : tn) [: sort] := { f1 : u1 ; ⋯ ; fm : um }. Instance instancename q1 ⋯ qm : classname p1 ⋯ pn := { f1 := t1 ; ⋯ ; fm := tm }. The ``pi : ti`` variables are called the *parameters* of the typeclass and the ``fi : ti`` are called the *methods*. Each typeclass definition gives rise to a corresponding record declaration and each instance is a regular definition whose name is given by `instancename` and type is an instantiation of the record type. We’ll use the following example typeclass in the rest of the chapter: .. coqtop:: in Class EqDec (A : Type) := { eqb : A -> A -> bool ; eqb_leibniz : forall x y, eqb x y = true -> x = y }. This typeclass implements a boolean equality test which is compatible with Leibniz equality on some type. An example implementation is: .. coqtop:: in Instance unit_EqDec : EqDec unit := { eqb x y := true ; eqb_leibniz x y H := match x, y return x = y with | tt, tt => eq_refl tt end }. Using the :attr:`refine` attribute, if the term is not sufficient to finish the definition (e.g. due to a missing field or non-inferable hole) it must be finished in proof mode. If it is sufficient a trivial proof mode with no open goals is started. .. coqtop:: in #[refine] Instance unit_EqDec' : EqDec unit := { eqb x y := true }. Proof. intros [] [];reflexivity. Defined. 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 remaining fields, e.g.: .. coqtop:: in Require Import Program.Tactics. Program Instance eq_bool : EqDec bool := { eqb x y := if x then y else negb y }. .. coqtop:: all Next Obligation. destruct x ; destruct y ; (discriminate || reflexivity). Defined. One has to take care that the transparency of every field is determined by the transparency of the :cmd:`Instance` proof. One can use alternatively the :attr:`program` attribute to get richer facilities for dealing with obligations. Binding typeclasses ------------------- Once a typeclass is declared, one can use it in typeclass binders: .. coqtop:: all Definition neqb {A} {eqa : EqDec A} (x y : A) := negb (eqb x y). When one calls a typeclass method, a constraint is generated that is satisfied only in contexts where the appropriate instances can be found. In the example above, a constraint ``EqDec A`` is generated and satisfied by ``eqa : EqDec A``. In case no satisfying constraint can be found, an error is raised: .. coqtop:: all Fail Definition neqb' (A : Type) (x y : A) := negb (eqb x y). The algorithm used to solve constraints is a variant of the :tacn:`eauto` tactic that does proof search with a set of lemmas (the instances). It will use local hypotheses as well as declared lemmas in the ``typeclass_instances`` database. Hence the example can also be written: .. coqtop:: all Definition neqb' A (eqa : EqDec A) (x y : A) := negb (eqb x y). However, the generalizing binders should be used instead as they have particular support for typeclasses: + They automatically set the maximally implicit status for typeclass arguments, making derived functions as easy to use as typeclass methods. In the example above, ``A`` and ``eqa`` should be set maximally implicit. + They support implicit quantification on partially applied typeclasses (:ref:`implicit-generalization`). Any argument not given as part of a typeclass binder will be automatically generalized. + They also support implicit quantification on :ref:`superclasses`. Following the previous example, one can write: .. coqtop:: all Generalizable Variables A B C. Definition neqb_implicit `{eqa : EqDec A} (x y : A) := negb (eqb x y). Here ``A`` is implicitly generalized, and the resulting function is equivalent to the one above. Parameterized instances ----------------------- One can declare parameterized instances as in Haskell simply by giving the constraints as a binding context before the instance, e.g.: .. coqtop:: in Program Instance prod_eqb `(EA : EqDec A, EB : EqDec B) : EqDec (A * B) := { eqb x y := match x, y with | (la, ra), (lb, rb) => andb (eqb la lb) (eqb ra rb) end }. .. coqtop:: none Admit Obligations. These instances are used just as well as lemmas in the instance hint database. .. _contexts: Sections and contexts --------------------- To ease developments parameterized by many instances, one can use the :cmd:`Context` command to introduce the parameters into the :term:`local context`, which works similarly to the command :cmd:`Variable`, except it accepts any binding context as an argument, so variables can be implicit, and :ref:`implicit-generalization` can be used. For example: .. coqtop:: all Section EqDec_defs. Context `{EA : EqDec A}. .. coqtop:: in #[ global, program ] Instance option_eqb : EqDec (option A) := { eqb x y := match x, y with | Some x, Some y => eqb x y | None, None => true | _, _ => false end }. Admit Obligations. .. coqtop:: all End EqDec_defs. About option_eqb. Here the :attr:`global` attribute redeclares the instance at the end of the section, once it has been generalized by the context variables it uses. .. seealso:: Section :ref:`section-mechanism` Building hierarchies -------------------- .. _superclasses: Superclasses ~~~~~~~~~~~~ One can also parameterize typeclasses by other typeclasses, generating a hierarchy of typeclasses and superclasses. In the same way, we give the superclasses as a binding context: .. coqtop:: all Class Ord `(E : EqDec A) := { le : A -> A -> bool }. Contrary to Haskell, we have no special syntax for superclasses, but this declaration is equivalent to: .. coqdoc:: Class `(E : EqDec A) => Ord A := { le : A -> A -> bool }. This declaration means that any instance of the ``Ord`` typeclass must have an instance of ``EqDec``. The parameters of the subclass contain at least all the parameters of its superclasses in their order of appearance (here A is the only one). As we have seen, ``Ord`` is encoded as a record type with two parameters: a type ``A`` and an ``E`` of type ``EqDec A``. However, one can still use it as if it had a single parameter inside generalizing binders: the generalization of superclasses will be done automatically. .. coqtop:: all Definition le_eqb `{Ord A} (x y : A) := andb (le x y) (le y x). To specify sharing of structures, you may want to explicitly specify the superclasses. You can do this directly in regular binders, and with the ``!`` modifier before typeclass binders. For example: .. coqtop:: all Definition lt `{eqa : EqDec A, !Ord eqa} (x y : A) := andb (le x y) (neqb x y). The ``!`` modifier switches how Coq interprets a binder. In particular, it uses the implicit arguments mechanism if available, as shown in the example. Substructures ~~~~~~~~~~~~~ .. index:: :: (substructure) Substructures are components of a typeclass which are themselves instances of a typeclass. They often arise when using typeclasses for logical properties, e.g.: .. coqtop:: none Require Import Relation_Definitions. .. coqtop:: in Class Reflexive (A : Type) (R : relation A) := reflexivity : forall x, R x x. Class Transitive (A : Type) (R : relation A) := transitivity : forall x y z, R x y -> R y z -> R x z. This declares singleton typeclasses for reflexive and transitive relations, (see the :ref:`singleton class ` variant for an explanation). These may be used as parts of other typeclasses: .. coqtop:: all Class PreOrder (A : Type) (R : relation A) := { PreOrder_Reflexive :: Reflexive A R ; PreOrder_Transitive :: Transitive A R }. The syntax ``::`` indicates that each ``PreOrder`` can be seen as a ``Reflexive`` relation. So each time a reflexive relation is needed, a preorder can be used instead. This is very similar to the coercion mechanism of ``Structure`` declarations. The implementation simply declares each projection as an instance. One can also declare existing objects or structure projections using the :cmd:`Existing Instance` command to achieve the same effect. Command summary --------------- .. cmd:: Class @record_definition Class @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* typeclass with a single projection. This singleton typeclass is a so-called *definitional typeclass*, represented simply as a definition ``ident binders := term`` and whose instances are themselves objects of this type. Definitional typeclasses are not wrapped inside records, and the trivial projection of an instance of such a typeclass 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 trivial projections. The typeclass :term:`constant` itself is declared rigid during resolution so that the typeclass abstraction is maintained. The `>` in :token:`record_definition` currently does nothing. In a future version, it will create coercions as it does when used in :cmd:`Record` commands. Like any command declaring a record, this command supports the :attr:`universes(polymorphic)`, :attr:`universes(template)`, :attr:`universes(cumulative)` and :attr:`private(matching)` attributes. .. note:: Don't confuse typeclasses with "coercion classes", described in `implicit coercions`. When record syntax is used, this command also supports the :attr:`projections(primitive)` :term:`attribute`. .. cmd:: Existing Class @qualid Declares a typeclass from a previously declared :term:`constant` or inductive definition. No methods or instances are defined. .. warn:: @ident is already declared as a typeclass This command has no effect when used on a typeclass. .. _warn-future-coercion-class-field: .. warn:: A coercion will be introduced instead of an instance in future versions when using ':>' in 'Class' declarations. Replace ':>' with '::' (or use '#[global] Existing Instance field.' for compatibility with Coq < 8.17). In future versions, :g:`:>` in the :n:`@record_definition` or :n:`@constructor` will declare a :ref:`coercion`, as it does for other :cmd:`Record` commands. To eliminate the warning, use :g:`::` instead. .. warn:: Ignored instance declaration for “@ident”: “@term” is not a class Using the ``::`` (or deprecated ``:>``) syntax in the :n:`@record_definition` or :n:`@constructor` with a right-hand-side that is not itself a Class has no effect (apart from emitting this warning). .. cmd:: Instance {? @ident_decl {* @binder } } : @type {? @hint_info } {? {| := %{ {* @field_val } %} | := @term } } Declares a typeclass instance named :token:`ident_decl` of the typeclass :n:`@type` with the specified parameters and with fields defined by :token:`field_val`, where each field must be a declared field of the typeclass. Adds one or more :token:`binder`\s to declare a parameterized instance. :token:`hint_info` may be used to specify the hint priority. If the priority is not specified, the default is the number of non-dependent binders of the instance. If :token:`one_pattern` is given, terms matching that pattern will trigger use of the instance. Otherwise, use is triggered based on the conclusion of the type. This command supports the :attr:`local`, :attr:`global` and :attr:`export` locality attributes. .. versionchanged:: 8.18 The default value for instance locality outside sections is now :attr:`export`. It used to be :attr:`global`. Like :cmd:`Definition`, it also supports the :attr:`program` attribute to switch the type checking to `Program` (chapter :ref:`programs`) and to use the obligation mechanism to manage missing fields. Finally, it supports the lighter :attr:`refine` attribute: .. attr:: refine This :term:`attribute` can be used to leave holes or not provide all fields in the definition of an instance and open the tactic mode to fill them. It works exactly as if no :term:`body` had been given and the :tacn:`refine` tactic has been used first. .. cmd:: Declare Instance @ident_decl {* @binder } : @term {? @hint_info } 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`. .. cmd:: Existing Instance @qualid {? @hint_info } Existing Instances {+ @qualid } {? %| @natural } Adds a :term:`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 Shows the list of instances associated with the typeclass :token:`reference`. .. cmd:: Print Typeclasses Shows the list of declared typeclasses. .. tacn:: typeclasses eauto {? {| bfs | dfs | best_effort } } {? @nat_or_var } {? with {+ @ident } } This proof search tactic uses the resolution engine that is run implicitly during type checking, known as *typeclass search*. This tactic uses a different resolution engine than :tacn:`eauto` and :tacn:`auto`. The main differences are the following: + 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. + 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 state of the first hint database given. Using an empty database (created with :cmd:`Create HintDb` for example) with unfoldable variables and :term:`constants ` as the first argument of ``typeclasses eauto`` hence makes resolution with the local hypotheses use full conversion during unification. + The mode hints (see :cmd:`Hint Mode`) associated with a typeclass are taken into account by :tacn:`typeclasses eauto`. When a goal does not match any of the declared modes for its head (if any), instead of failing like :tacn:`eauto`, the goal is suspended and resolution proceeds on the remaining goals. If after one run of resolution, there remain suspended goals, resolution is launched against on them, until it reaches a fixed point when the set of remaining suspended goals does not change. Using `solve [typeclasses eauto]` can be used to ensure that no suspended goals remain. + When considering local hypotheses, we use the union of all the modes declared in the given databases. + The tactic may produce more than one success when used in backtracking tactics such as `typeclasses eauto; ...`. See :tacn:`ltac-seq`. + Use the :cmd:`Typeclasses eauto` command to customize the behavior of this tactic. :n:`{| bfs | dfs}` Specifies whether to use breadth-first search or depth-first search. The default is depth-first search, which can be changed with the :flag:`Typeclasses Iterative Deepening` flag. .. _TypeclassesEautoBestEffort: :n:`best_effort` If the `best_effort` option is given and resolution fails, `typeclasses eauto` returns the first partial solution in which all remaining subgoals fall into one of these categories: - Stuck goals: the head of the goal has at least one associated declared mode and the constraint does not match any mode declared for its head. These goals are shelved. - Mode failures: the head of the constraint has at least one matching declared mode, but the constraint couldn't be solved. These goals are left as subgoals of :n:`typeclasses eauto best_effort`. During type inference, typeclass resolution always uses the `best_effort` option: in case of failure, it constructs a partial solution for the goals and gives a more informative error message. It can be used the same way in interactive proofs to check which instances/hints are missing for a typeclass resolution to succeed. :n:`@nat_or_var` Specifies the maximum depth of the search. .. warning:: The semantics for the limit :n:`@nat_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). .. note:: ``all:once (typeclasses eauto)`` faithfully mimics what happens during typeclass resolution when it is called during refinement/type inference, except that *only* declared typeclass subgoals are considered at the start of resolution during type inference, while ``all`` can select non-typeclass subgoals as well. It might move to ``all:typeclasses eauto`` in future versions when the refinement engine will be able to backtrack. .. tacn:: autoapply @one_term with @ident 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 resolution locally at the hint application time. .. _TypeclassesTransparent: Typeclasses Transparent, Typeclasses Opaque ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ .. cmd:: Typeclasses Transparent {+ @qualid } Makes :token:`qualid` transparent during typeclass resolution. A shortcut for :cmd:`Hint Transparent` :n:`{+ @qualid } : typeclass_instances` .. cmd:: Typeclasses Opaque {+ @qualid } Make :token:`qualid` opaque for typeclass search. A shortcut for :cmd:`Hint Opaque` :n:`{+ @qualid } : typeclass_instances`. It is useful when some :term:`constants ` prevent some unifications and make resolution fail. It is also useful to declare constants which should never be unfolded during proof search, like fixpoints or anything which does not look like an abbreviation. This can additionally speed up proof search as the typeclass map can be indexed by such rigid constants (see :ref:`hintdatabases`). By default, all :term:`constants ` and local variables are considered transparent. One should take care not to make opaque any constant that is used to abbreviate a type, like: .. coqdoc:: Definition relation A := A -> A -> Prop. .. versionadded:: 8.15 :cmd:`Typeclasses Transparent` and :cmd:`Typeclasses Opaque` support locality attributes like :cmd:`Hint ` commands. .. deprecated:: 8.15 The default value for typeclass transparency hints will change in a future release. Hints added outside of sections without an explicit locality are now deprecated. We recommend using :attr:`export` where possible. Settings ~~~~~~~~ .. flag:: Typeclasses Dependency Order This :term:`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 quite different performance behaviors of proof search. .. flag:: Typeclasses Limit Intros This :term:`flag` (on by default) controls the ability to apply hints while avoiding (functional) eta-expansions in the generated proof term. It does so by allowing hints that conclude in a product to apply to a goal with a matching product directly, avoiding an introduction. .. warning:: This can be expensive as it requires rebuilding hint clauses dynamically, and does not benefit from the invertibility status of the product introduction rule, resulting in potentially more expensive proof search (i.e. more useless backtracking). .. flag:: Typeclass Resolution For Conversion This :term:`flag` (on by default) controls the use of typeclass resolution when a unification problem cannot be solved during elaboration/type inference. With this flag on, when a unification fails, typeclass resolution is tried before launching unification once again. .. flag:: Typeclasses Strict Resolution Typeclass declarations introduced when this :term:`flag` is set have a stricter resolution behavior (the flag is off by default). When looking for unifications of a goal with an instance of this typeclass, we “freeze” all the existentials appearing in the goals, meaning that they are considered rigid during unification and cannot be instantiated. .. flag:: Typeclasses Unique Solutions When a typeclass resolution is launched we ensure that it has a single solution or fail. This :term:`flag` ensures that the resolution is canonical, but can make proof search much more expensive. .. flag:: Typeclasses Unique Instances Typeclass declarations introduced when this :term:`flag` is set have a more efficient resolution behavior (the flag is off by default). When a solution to the typeclass goal of this typeclass is found, we never backtrack on it, assuming that it is canonical. .. flag:: Typeclasses Iterative Deepening When this :term:`flag` is set, the proof search strategy is breadth-first search. Otherwise, the search strategy is depth-first search. The default is off. :cmd:`Typeclasses eauto` is another way to set this flag. .. opt:: Typeclasses Depth @natural This :term:`option` sets the maximum proof search depth. The default is unbounded. :cmd:`Typeclasses eauto` is another way to set this option. .. flag:: Typeclasses Debug Controls whether typeclass resolution steps are shown during search. Setting this :term:`flag` also sets :opt:`Typeclasses Debug Verbosity` to 1. :cmd:`Typeclasses eauto` is another way to set this flag. .. opt:: Typeclasses Debug Verbosity @natural Determines how much information is shown for typeclass resolution steps during search. 1 is the default level. 2 shows additional information such as tried tactics and shelving of goals. Setting this :term:`option` to 1 or 2 turns on the :flag:`Typeclasses Debug` flag; setting this option to 0 turns that flag off. Typeclasses eauto ~~~~~~~~~~~~~~~~~ .. cmd:: Typeclasses eauto := {? debug } {? ( {| bfs | dfs } ) } {? @natural } Allows more global customization of the :tacn:`typeclasses eauto` tactic. The options are: ``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`. :n:`{| bfs | dfs }` Specifies whether to use breadth-first search or depth-first search. The default is depth-first search, which can be changed with the :flag:`Typeclasses Iterative Deepening` flag. :token:`natural` Sets the depth limit for the search. The limit can also be set with :opt:`Typeclasses Depth`. coq-8.20.0/doc/sphinx/addendum/universe-polymorphism.rst000066400000000000000000000734601466560755400234100ustar00rootroot00000000000000.. _polymorphicuniverses: Polymorphic Universes ====================== :Author: Matthieu Sozeau General Presentation --------------------- .. warning:: The status of Universe Polymorphism is experimental. This section describes the universe polymorphic extension of Coq. Universe polymorphism makes it possible to write generic definitions making use of universes and reuse them at different and sometimes incompatible universe levels. A standard example of the difference between universe *polymorphic* and *monomorphic* definitions is given by the identity function: .. coqtop:: in Definition identity {A : Type} (a : A) := a. By default, :term:`constant` declarations are monomorphic, hence the identity function declares a global universe (automatically named ``identity.u0``) for its domain. Subsequently, if we try to self-apply the identity, we will get an error: .. coqtop:: all Fail Definition selfid := identity (@identity). Indeed, the global level ``identity.u0`` would have to be strictly smaller than itself for this self-application to type check, as the type of :g:`(@identity)` is :g:`forall (A : Type@{identity.u0}), A -> A` whose type is itself :g:`Type@{identity.u0+1}`. A universe polymorphic identity function binds its domain universe level at the definition level instead of making it global. .. coqtop:: in Polymorphic Definition pidentity {A : Type} (a : A) := a. .. coqtop:: all About pidentity. It is then possible to reuse the constant at different levels, like so: .. coqtop:: in Polymorphic Definition selfpid := pidentity (@pidentity). Of course, the two instances of :g:`pidentity` in this definition are different. This can be seen when the :flag:`Printing Universes` flag is on: .. coqtop:: all Set Printing Universes. Print selfpid. Now :g:`pidentity` is used at two different levels: at the head of the application it is instantiated at ``u`` while in the argument position it is instantiated at ``u0``. This definition is only valid as long as ``u0`` is strictly smaller than ``u``, as shown by the constraints. Note that if we made ``selfpid`` universe monomorphic, the two universes (in this case ``u`` and ``u0``) would be declared in the global universe graph with names ``selfpid.u0`` and ``selfpid.u1``. Since the constraints would be global, ``Print selfpid.`` will not show them, however they will be shown by :cmd:`Print Universes`. When printing :g:`pidentity`, we can see the universes it binds in the annotation :g:`@{u}`. Additionally, when :flag:`Printing Universes` is on we print the "universe context" of :g:`pidentity` consisting of the bound universes and the constraints they must verify (for :g:`pidentity` there are no constraints). Inductive types can also be declared universe polymorphic on universes appearing in their parameters or fields. A typical example is given by monoids. We first put ourselves in a mode where every declaration is universe-polymorphic: .. coqtop:: in Set Universe Polymorphism. .. coqtop:: in Record Monoid := { mon_car :> Type; mon_unit : mon_car; mon_op : mon_car -> mon_car -> mon_car }. A monoid is here defined by a carrier type, a unit in this type and a binary operation. .. coqtop:: all Print Monoid. The Monoid's carrier universe is polymorphic, hence it is possible to instantiate it for example with :g:`Monoid` itself. First we build the trivial unit monoid in any universe :g:`i >= Set`: .. coqtop:: in Definition unit_monoid@{i} : Monoid@{i} := {| mon_car := unit; mon_unit := tt; mon_op x y := tt |}. Here we are using the fact that :g:`unit : Set` and by cumulativity, any polymorphic universe is greater or equal to `Set`. From this we can build a definition for the monoid of monoids, where multiplication is given by the product of monoids. To do so, we first need to define a universe-polymorphic variant of pairs: .. coqtop:: in Record pprod@{i j} (A : Type@{i}) (B : Type@{j}) : Type@{max(i,j)} := ppair { pfst : A; psnd : B }. Arguments ppair {A} {B}. Infix "**" := pprod (at level 40, left associativity) : type_scope. Notation "( x ; y ; .. ; z )" := (ppair .. (ppair x y) .. z) (at level 0) : core_scope. The monoid of monoids uses the cartesian product of monoids as its operation: .. coqtop:: in Definition monoid_op@{i} (m m' : Monoid@{i}) (x y : mon_car m ** mon_car m') : mon_car m ** mon_car m' := let (l, r) := x in let (l', r') := y in (mon_op m l l'; mon_op m' r r'). Definition prod_monoid@{i} (m m' : Monoid@{i}): Monoid@{i} := {| mon_car := (m ** m')%type; mon_unit := (mon_unit m; mon_unit m'); mon_op := (monoid_op m m') |}. Definition monoids_monoid@{i j | i < j} : Monoid@{j} := {| mon_car := Monoid@{i}; mon_unit := unit_monoid@{i}; mon_op := prod_monoid@{i} |}. .. coqtop:: all Print monoids_monoid. As one can see from the constraints, this monoid is “large”, it lives in a universe strictly higher than its objects, monoids in the universes :g:`i`. Polymorphic, Monomorphic ------------------------- .. attr:: universes(polymorphic{? = {| yes | no } }) :name: universes(polymorphic); Polymorphic; Monomorphic This :term:`boolean attribute` can be used to control whether universe polymorphism is enabled in the definition of an inductive type. There is also a legacy syntax using the ``Polymorphic`` prefix (see :n:`@legacy_attr`) which, as shown in the examples, is more commonly used. When ``universes(polymorphic=no)`` is used, global universe constraints are produced, even when the :flag:`Universe Polymorphism` flag is on. There is also a legacy syntax using the ``Monomorphic`` prefix (see :n:`@legacy_attr`). .. flag:: Universe Polymorphism This :term:`flag` is off by default. When it is on, new declarations are polymorphic unless the :attr:`universes(polymorphic=no) ` attribute is used to override the default. Many other commands can be used to declare universe polymorphic or monomorphic :term:`constants ` depending on whether the :flag:`Universe Polymorphism` flag is on or the :attr:`universes(polymorphic)` attribute is used: - :cmd:`Lemma`, :cmd:`Axiom`, etc. can be used to declare universe polymorphic constants. - Using the :attr:`universes(polymorphic)` attribute with the :cmd:`Section` command will locally set the polymorphism flag inside the section. - :cmd:`Variable`, :cmd:`Context`, :cmd:`Universe` and :cmd:`Constraint` in a section support polymorphism. See :ref:`universe-polymorphism-in-sections` for more details. - Using the :attr:`universes(polymorphic)` attribute with the :cmd:`Hint Resolve` or :cmd:`Hint Rewrite` commands will make :tacn:`auto` / :tacn:`rewrite` use the hint polymorphically, not at a single instance. .. _cumulative: Cumulative, NonCumulative ------------------------- .. attr:: universes(cumulative{? = {| yes | no } }) :name: universes(cumulative); Cumulative; NonCumulative Polymorphic inductive types, coinductive types, variants and records can be declared cumulative using this :term:`boolean attribute` or the legacy ``Cumulative`` prefix (see :n:`@legacy_attr`) which, as shown in the examples, is more commonly used. This means that two instances of the same inductive type (family) are convertible based on the universe variances; they do not need to be equal. When the attribtue is off, the inductive type is non-cumulative even if the :flag:`Polymorphic Inductive Cumulativity` flag is on. There is also a legacy syntax using the ``NonCumulative`` prefix (see :n:`@legacy_attr`). This means that two instances of the same inductive type (family) are convertible only if all the universes are equal. .. exn:: The cumulative attribute can only be used in a polymorphic context. Using this attribute requires being in a polymorphic context, i.e. either having the :flag:`Universe Polymorphism` flag on, or having used the :attr:`universes(polymorphic)` attribute as well. .. note:: :n:`#[ universes(polymorphic{? = yes }), universes(cumulative{? = {| yes | no } }) ]` can be abbreviated into :n:`#[ universes(polymorphic{? = yes }, cumulative{? = {| yes | no } }) ]`. .. flag:: Polymorphic Inductive Cumulativity When this :term:`flag` is on (it is off by default), it makes all subsequent *polymorphic* inductive definitions cumulative, unless the :attr:`universes(cumulative=no) ` attribute is used to override the default. It has no effect on *monomorphic* inductive definitions. Consider the examples below. .. coqtop:: in reset Polymorphic Cumulative Inductive list {A : Type} := | nil : list | cons : A -> list -> list. .. coqtop:: all Set Printing Universes. Print list. When printing :g:`list`, the universe context indicates the subtyping constraints by prefixing the level names with symbols. Because inductive subtypings are only produced by comparing inductives to themselves with universes changed, they amount to variance information: each universe is either invariant, covariant or irrelevant (there are no contravariant subtypings in Coq), respectively represented by the symbols `=`, `+` and `*`. Here we see that :g:`list` binds an irrelevant universe, so any two instances of :g:`list` are convertible: :math:`E[Γ] ⊢ \mathsf{list}@\{i\}~A =_{βδιζη} \mathsf{list}@\{j\}~B` whenever :math:`E[Γ] ⊢ A =_{βδιζη} B` and this applies also to their corresponding constructors, when they are comparable at the same type. See :ref:`Conversion-rules` for more details on convertibility and subtyping. The following is an example of a record with non-trivial subtyping relation: .. coqtop:: all Polymorphic Cumulative Record packType := {pk : Type}. About packType. :g:`packType` binds a covariant universe, i.e. .. math:: E[Γ] ⊢ \mathsf{packType}@\{i\} =_{βδιζη} \mathsf{packType}@\{j\}~\mbox{ whenever }~i ≤ j Looking back at the example of monoids, we can see that they are naturally covariant for cumulativity: .. coqtop:: in Set Universe Polymorphism. Cumulative Record Monoid := { mon_car :> Type; mon_unit : mon_car; mon_op : mon_car -> mon_car -> mon_car }. .. coqtop:: all Set Printing Universes. Print Monoid. This means that a monoid in a lower universe (like the unit monoid in set), can be seen as a monoid in any higher universe, without introducing explicit lifting. .. coqtop:: in Definition unit_monoid : Monoid@{Set} := {| mon_car := unit; mon_unit := tt; mon_op x y := tt |}. .. coqtop:: all Monomorphic Universe i. Check unit_monoid : Monoid@{i}. Finally, invariant universes appear when there is no possible subtyping relation between different instances of the inductive. Consider: .. coqtop:: in Polymorphic Cumulative Record monad@{i} := { m : Type@{i} -> Type@{i}; unit : forall (A : Type@{i}), A -> m A }. .. coqtop:: all Set Printing Universes. Print monad. The universe of :g:`monad` is invariant due to its use on the left side of an arrow in the :g:`m` field: one cannot lift or lower the level of the type constructor to build a monad in a higher or lower universe. Specifying cumulativity ~~~~~~~~~~~~~~~~~~~~~~~ The variance of the universe parameters for a cumulative inductive may be specified by the user. For the following type, universe ``a`` has its variance automatically inferred (it is irrelevant), ``b`` is required to be irrelevant, ``c`` is covariant and ``d`` is invariant. With these annotations ``c`` and ``d`` have less general variances than would be inferred. .. coqtop:: all Polymorphic Cumulative Inductive Dummy@{a *b +c =d} : Prop := dummy. About Dummy. Insufficiently restrictive variance annotations lead to errors: .. coqtop:: all Fail Polymorphic Cumulative Record bad@{*a} := {p : Type@{a}}. .. example:: Demonstration of universe variances .. coqtop:: in Set Printing Universes. Set Universe Polymorphism. Set Polymorphic Inductive Cumulativity. Inductive Invariant @{=u} : Type@{u}. Inductive Covariant @{+u} : Type@{u}. Inductive Irrelevant@{*u} : Type@{u}. Section Universes. Universe low high. Constraint low < high. (* An invariant universe blocks cumulativity from upper or lower levels. *) Axiom inv_low : Invariant@{low}. Axiom inv_high : Invariant@{high}. .. coqtop:: all Fail Check (inv_low : Invariant@{high}). Fail Check (inv_high : Invariant@{low}). .. coqtop:: in (* A covariant universe allows cumulativity from a lower level. *) Axiom co_low : Covariant@{low}. Axiom co_high : Covariant@{high}. .. coqtop:: all Check (co_low : Covariant@{high}). Fail Check (co_high : Covariant@{low}). .. coqtop:: in (* An irrelevant universe allows cumulativity from any level *) Axiom irr_low : Irrelevant@{low}. Axiom irr_high : Irrelevant@{high}. .. coqtop:: all Check (irr_low : Irrelevant@{high}). Check (irr_high : Irrelevant@{low}). .. coqtop:: in End Universes. .. example:: A proof using cumulativity .. coqtop:: in reset Set Universe Polymorphism. Set Polymorphic Inductive Cumulativity. Set Printing Universes. Inductive eq@{i} {A : Type@{i}} (x : A) : A -> Type@{i} := eq_refl : eq x x. .. coqtop:: all Print eq. The universe of :g:`eq` is irrelevant here, hence proofs of equalities can inhabit any universe. The universe must be big enough to fit `A`. .. coqtop:: in Definition funext_type@{a b e} (A : Type@{a}) (B : A -> Type@{b}) := forall f g : (forall a, B a), (forall x, eq@{e} (f x) (g x)) -> eq@{e} f g. Section down. Universes a b e e'. Constraint e' < e. Lemma funext_down {A B} (H : @funext_type@{a b e} A B) : @funext_type@{a b e'} A B. Proof. exact H. Defined. End down. Cumulativity Weak Constraints ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ .. flag:: Cumulativity Weak Constraints When set, which is the default, this :term:`flag` causes "weak" constraints to be produced when comparing universes in an irrelevant position. Processing weak constraints is delayed until minimization time. A weak constraint between `u` and `v` when neither is smaller than the other and one is flexible causes them to be unified. Otherwise the constraint is silently discarded. This heuristic is experimental and may change in future versions. Disabling weak constraints is more predictable but may produce arbitrary numbers of universes. Global and local universes --------------------------- Each universe is declared in a global or local context before it can be used. To ensure compatibility, every *global* universe is set to be strictly greater than :g:`Set` when it is introduced, while every *local* (i.e. polymorphically quantified) universe is introduced as greater or equal to :g:`Set`. Conversion and unification --------------------------- The semantics of conversion and unification have to be modified a little to account for the new universe instance arguments to polymorphic references. The semantics respect the fact that definitions are transparent, so indistinguishable from their :term:`bodies ` during conversion. This is accomplished by changing one rule of unification, the first- order approximation rule, which applies when two applicative terms with the same head are compared. It tries to short-cut unfolding by comparing the arguments directly. In case the :term:`constant` is universe polymorphic, we allow this rule to fire only when unifying the universes results in instantiating a so-called flexible universe variables (not given by the user). Similarly for conversion, if such an equation of applicative terms fail due to a universe comparison not being satisfied, the terms are unfolded. This change implies that conversion and unification can have different unfolding behaviors on the same development with universe polymorphism switched on or off. Minimization ------------- Universe polymorphism with cumulativity tends to generate many useless inclusion constraints in general. Typically at each application of a polymorphic :term:`constant` :g:`f`, if an argument has expected type :g:`Type@{i}` and is given a term of type :g:`Type@{j}`, a :math:`j ≤ i` constraint will be generated. It is however often the case that an equation :math:`j = i` would be more appropriate, when :g:`f`\'s universes are fresh for example. Consider the following example: .. coqtop:: none Polymorphic Definition pidentity {A : Type} (a : A) := a. .. coqtop:: in Definition id0 := @pidentity nat 0. .. coqtop:: all Set Printing Universes. Print id0. This definition is elaborated by minimizing the universe of :g:`id0` to level :g:`Set` while the more general definition would keep the fresh level :g:`i` generated at the application of :g:`id` and a constraint that :g:`Set` :math:`≤ i`. This minimization process is applied only to fresh universe variables. It simply adds an equation between the variable and its lower bound if it is an atomic universe (i.e. not an algebraic max() universe). .. flag:: Universe Minimization ToSet Turning this :term:`flag` off (it is on by default) disallows minimization to the sort :g:`Set` and only collapses floating universes between themselves. .. _explicit-universes: Explicit Universes ------------------- .. insertprodn universe_name univ_constraint .. prodn:: universe_name ::= @qualid | Set | Prop univ_annot ::= @%{ {* @univ_level_or_quality } {? %| {* @univ_level_or_quality } } %} univ_level_or_quality ::= Set | SProp | Prop | Type | _ | @qualid univ_decl ::= @%{ {? {* @ident } %| } {* @ident } {? + } {? %| {*, @univ_constraint } {? + } } %} cumul_univ_decl ::= @%{ {? {* @ident } %| } {* {? {| + | = | * } } @ident } {? + } {? %| {*, @univ_constraint } {? + } } %} univ_constraint ::= @universe_name {| < | = | <= } @universe_name The syntax has been extended to allow users to explicitly bind names to universes and explicitly instantiate polymorphic definitions. .. cmd:: Universe {+ @ident } Universes {+ @ident } 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 } Declares new constraints between named universes. 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`` legacy attribute) in sections only to declare constraints discharged at section closing time. One cannot declare a global constraint on polymorphic universes. .. exn:: Undeclared universe @ident. :undocumented: .. exn:: Universe inconsistency. :undocumented: .. exn:: Polymorphic universe constraints can only be declared inside sections, use Monomorphic Constraint instead :undocumented: .. _printing-universes: Printing universes ------------------ .. flag:: Printing Universes Turn this :term:`flag` on to activate the display of the actual level of each occurrence of :g:`Type`. See :ref:`Sorts` for details. This wizard flag, in combination with :flag:`Printing All` can help to diagnose failures to unify terms apparently identical but internally different in the Calculus of Inductive Constructions. .. cmd:: Print {? Sorted } Universes {? Subgraph ( {* @qualid } ) } {? @string } :name: Print Universes This command can be used to print the constraints on the internal level of the occurrences of :math:`\Type` (see :ref:`Sorts`). The :n:`Subgraph` clause limits the printed graph to the requested names (adjusting constraints to preserve the implied transitive constraints between kept universes). The :n:`Sorted` clause makes each universe equivalent to a numbered label reflecting its level (with a linear ordering) in the universe hierarchy. :n:`@string` is an optional output filename. If :n:`@string` ends in ``.dot`` or ``.gv``, the constraints are printed in the DOT language, and can be processed by Graphviz tools. The format is unspecified if `string` doesn’t end in ``.dot`` or ``.gv``. If :n:`@string` is a relative filename, it refers to the directory specified by the command line option `-output-directory`, if set (see :ref:`command-line-options`) and otherwise, the current directory. Use :cmd:`Pwd` to display the current directory. Polymorphic definitions ~~~~~~~~~~~~~~~~~~~~~~~ For polymorphic definitions, the declaration of (all) universe levels introduced by a definition uses the following syntax: .. coqtop:: in Polymorphic Definition le@{i j} (A : Type@{i}) : Type@{j} := A. .. coqtop:: all Print le. During refinement we find that :g:`j` must be larger or equal than :g:`i`, as we are using :g:`A : Type@{i} <= Type@{j}`, hence the generated constraint. At the end of a definition or proof, we check that the only remaining universes are the ones declared. In the term and in general in proof mode, introduced universe names can be referred to in terms. Note that local universe names shadow global universe names. During a proof, one can use :cmd:`Show Universes` to display the current context of universes. It is possible to provide only some universe levels and let Coq infer the others by adding a :g:`+` in the list of bound universe levels: .. coqtop:: all Fail Definition foobar@{u} : Type@{u} := Type. Definition foobar@{u +} : Type@{u} := Type. Set Printing Universes. Print foobar. This can be used to find which universes need to be explicitly bound in a given definition. Definitions can also be instantiated explicitly, giving their full instance: .. coqtop:: all Check (pidentity@{Set}). Monomorphic Universes k l. Check (le@{k l}). User-named universes and the anonymous universe implicitly attached to an explicit :g:`Type` are considered rigid for unification and are never minimized. Flexible anonymous universes can be produced with an underscore or by omitting the annotation to a polymorphic definition. .. coqtop:: all Check (fun x => x) : Type -> Type. Check (fun x => x) : Type -> Type@{_}. Check le@{k _}. Check le. .. flag:: Strict Universe Declaration Turning this :term:`flag` off allows one to freely use identifiers for universes without declaring them first, with the semantics that the first use declares it. In this mode, the universe names are not associated with the definition or proof once it has been defined. This is meant mainly for debugging purposes. .. flag:: Private Polymorphic Universes This :term:`flag`, on by default, removes universes which appear only in the :term:`body` of an opaque polymorphic definition from the definition's universe arguments. As such, no value needs to be provided for these universes when instantiating the definition. Universe constraints are automatically adjusted. Consider the following definition: .. coqtop:: in Lemma foo@{i} : Type@{i}. Proof. exact Type. Qed. .. coqtop:: all Print foo. The universe :g:`Top.xxx` for the :g:`Type` in the :term:`body` cannot be accessed, we only care that one exists for any instantiation of the universes appearing in the type of :g:`foo`. This is guaranteed when the transitive constraint ``Set <= Top.xxx < i`` is verified. Then when using the :term:`constant` we don't need to put a value for the inner universe: .. coqtop:: all Check foo@{_}. and when not looking at the :term:`body` we don't mention the private universe: .. coqtop:: all About foo. To recover the same behavior with regard to universes as :g:`Defined`, the :flag:`Private Polymorphic Universes` flag may be unset: .. coqtop:: in Unset Private Polymorphic Universes. Lemma bar : Type. Proof. exact Type. Qed. .. coqtop:: all About bar. Fail Check bar@{_}. Check bar@{_ _}. Note that named universes are always public. .. coqtop:: in Set Private Polymorphic Universes. Unset Strict Universe Declaration. Lemma baz : Type@{outer}. Proof. exact Type@{inner}. Qed. .. coqtop:: all About baz. .. _sort-polymorphism: Sort polymorphism ----------------- Quantifying over universes does not allow instantiation with `Prop` or `SProp`. For instance .. coqtop:: in reset Polymorphic Definition type@{u} := Type@{u}. .. coqtop:: all Fail Check type@{Prop}. To be able to instantiate a sort with `Prop` or `SProp`, we must quantify over :gdef:`sort qualities`. Definitions which quantify over sort qualities are called :gdef:`sort polymorphic`. All sort quality variables must be explicitly bound. .. coqtop:: all Polymorphic Definition sort@{s | u |} := Type@{s|u}. To help the parser, both `|` in the :n:`@univ_decl` are required. Sort quality variables of a sort polymorphic definition may be instantiated by the concrete values `SProp`, `Prop` and `Type` or by a bound variable. Instantiating `s` in `Type@{s|u}` with the impredicative `Prop` or `SProp` produces `Prop` or `SProp` respectively regardless of the instantiation fof `u`. .. coqtop:: all Eval cbv in sort@{Prop|Set}. Eval cbv in sort@{Type|Set}. When no explicit instantiation is provided or `_` is used, a temporary variable is generated. Temporary sort variables are instantiated with `Type` if not unified with another quality when universe minimization runs (typically at the end of a definition). :cmd:`Check` and :cmd:`Eval` run minimization so we cannot use them to witness these temporary variables. .. coqtop:: in Goal True. Set Printing Universes. .. coqtop:: all abort let c := constr:(sort) in idtac c. .. note:: We recommend you do not name explicitly quantified sort variables `α` followed by a number as printing will not distinguish between your bound variables and temporary variables. Sort polymorphic inductives may be declared when every instantiation is valid. Elimination at a given universe instance requires that elimination is allowed at every ground instantiation of the sort variables in the instance. Additionally if the output sort at the given universe instance is sort polymorphic, the return type of the elimination must be at the same quality. These restrictions ignore :flag:`Definitional UIP`. For instance .. coqtop:: all reset Set Universe Polymorphism. Inductive Squash@{s|u|} (A:Type@{s|u}) : Prop := squash (_:A). Elimination to `Prop` and `SProp` is always allowed, so `Squash_ind` and `Squash_sind` are automatically defined. Elimination to `Type` is not allowed with variable `s`, because the instantiation `s := Type` does not allow elimination to `Type`. However elimination to `Type` or to a polymorphic sort with `s := Prop` is allowed: .. coqtop:: all Definition Squash_Prop_rect A (P:Squash@{Prop|_} A -> Type) (H:forall x, P (squash _ x)) : forall s, P s := fun s => match s with squash _ x => H x end. Definition Squash_Prop_srect@{s|u +|} A (P:Squash@{Prop|_} A -> Type@{s|u}) (H:forall x, P (squash _ x)) : forall s, P s := fun s => match s with squash _ x => H x end. .. note:: Since inductive types with sort polymorphic output may only be polymorphically eliminated to the same sort quality, containers such as sigma types may be better defined as primitive records (which do not have this restriction) when possible. .. coqtop:: all Set Primitive Projections. Record sigma@{s|u v|} (A:Type@{s|u}) (B:A -> Type@{s|v}) : Type@{s|max(u,v)} := pair { pr1 : A; pr2 : B pr1 }. .. _universe-polymorphism-in-sections: Universe polymorphism and sections ---------------------------------- :cmd:`Variables`, :cmd:`Context`, :cmd:`Universe` and :cmd:`Constraint` in a section support polymorphism. This means that the universe variables and their associated constraints are discharged polymorphically over definitions that use them. In other words, two definitions in the section sharing a common variable will both get parameterized by the universes produced by the variable declaration. This is in contrast to a “mononorphic” variable which introduces global universes and constraints, making the two definitions depend on the *same* global universes associated with the variable. It is possible to mix universe polymorphism and monomorphism in sections, except in the following ways: - no monomorphic constraint may refer to a polymorphic universe: .. coqtop:: all reset Section Foo. Polymorphic Universe i. Fail Constraint i = i. This includes constraints implicitly declared by commands such as :cmd:`Variable`, which may need to be used with universe polymorphism activated (locally by attribute or globally by option): .. coqtop:: all Fail Variable A : (Type@{i} : Type). Polymorphic Variable A : (Type@{i} : Type). (in the above example the anonymous :g:`Type` constrains polymorphic universe :g:`i` to be strictly smaller.) - no monomorphic :term:`constant` or inductive may be declared if polymorphic universes or universe constraints are present. These restrictions are required in order to produce a sensible result when closing the section (the requirement on :term:`constants ` and inductive types is stricter than the one on constraints, because constants and inductives are abstracted by *all* the section's polymorphic universes and constraints). coq-8.20.0/doc/sphinx/appendix/000077500000000000000000000000001466560755400162735ustar00rootroot00000000000000coq-8.20.0/doc/sphinx/appendix/history-and-changes/000077500000000000000000000000001466560755400221425ustar00rootroot00000000000000coq-8.20.0/doc/sphinx/appendix/history-and-changes/index.rst000066400000000000000000000013351466560755400240050ustar00rootroot00000000000000.. _history-and-changes: ========================== History and recent changes ========================== This chapter is divided in two parts. The first one is about the :ref:`early history of Coq ` and is presented in chronological order. The second one provides :ref:`release notes about recent versions of Coq ` 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 upgrade your projects. .. toctree:: :maxdepth: 1 ../../history ../../changes coq-8.20.0/doc/sphinx/appendix/indexes/000077500000000000000000000000001466560755400177325ustar00rootroot00000000000000coq-8.20.0/doc/sphinx/appendix/indexes/index.rst000066400000000000000000000010431466560755400215710ustar00rootroot00000000000000:orphan: .. _indexes: ======== Indexes ======== We provide various specialized indexes that are helpful to quickly find what you are looking for. .. toctree:: ../../std-glossindex ../../coq-cmdindex ../../coq-tacindex ../../coq-attrindex ../../coq-optindex ../../coq-exnindex ../../genindex For reference, here are direct links to the documentation of: - :ref:`attributes` - :ref:`flags-options-tables`; - controlling the display of warning messages with the :opt:`Warnings` option or the :attr:`warnings` attribute; coq-8.20.0/doc/sphinx/biblio.bib000066400000000000000000000566571466560755400164240ustar00rootroot00000000000000@String{jfp = "Journal of Functional Programming"} @String{lncs = "Lecture Notes in Computer Science"} @String{lnai = "Lecture Notes in Artificial Intelligence"} @String{SV = "{Springer-Verlag}"} @InCollection{Asp00, Title = {Proof General: A Generic Tool for Proof Development}, Author = {Aspinall, David}, Booktitle = {Tools and Algorithms for the Construction and Analysis of Systems, {TACAS} 2000}, Publisher = {Springer Berlin Heidelberg}, Year = {2000}, Editor = {Graf, Susanne and Schwartzbach, Michael}, Pages = {38--43}, Series = {Lecture Notes in Computer Science}, Volume = {1785}, Doi = {10.1007/3-540-46419-0_3}, ISBN = {978-3-540-67282-1}, } @Book{Bar81, author = {H.P. Barendregt}, publisher = {North-Holland}, title = {The Lambda Calculus its Syntax and Semantics}, year = {1981} } @InProceedings{Bou97, title = {Using reflection to build efficient and certified decision procedure s}, author = {S. Boutin}, booktitle = {TACS'97}, editor = {Martin Abadi and Takahashi Ito}, publisher = SV, series = lncs, volume = 1281, year = {1997} } @Article{Bru72, author = {N.J. de Bruijn}, journal = {Indag. Math.}, title = {{Lambda-Calculus Notation with Nameless Dummies, a Tool for Automatic Formula Manipulation, with Application to the Church-Rosser Theorem}}, volume = {34}, year = {1972} } @inproceedings{CH85, title={Constructions: a higher order proof system for mechanizing mathematics}, author={Coquand, Thierry and Huet, Gérard}, booktitle={European Conference on Computer Algebra}, pages={151--184}, year={1985}, issn = {1611-3349}, doi = {10.1007/3-540-15983-5_13}, url = {http://dx.doi.org/10.1007/3-540-15983-5_13}, isbn = 9783540396840, publisher = {Springer Berlin Heidelberg} } @techreport{CH88 TITLE = {{The calculus of constructions}}, AUTHOR = {Coquand, T. and Huet, G{\'e}rard}, URL = {https://hal.inria.fr/inria-00076024}, NUMBER = {RR-0530}, INSTITUTION = {{INRIA}}, YEAR = {1986}, MONTH = May, PDF = {https://hal.inria.fr/inria-00076024/file/RR-0530.pdf}, HAL_ID = {inria-00076024}, HAL_VERSION = {v1}, } @techreport{CH87, TITLE = {{Concepts mathematiques et informatiques formalises dans le calcul des constructions}}, AUTHOR = {Coquand, T. and Huet, G{\'e}rard}, URL = {https://hal.inria.fr/inria-00076039}, NUMBER = {RR-0515}, INSTITUTION = {{INRIA}}, YEAR = {1986}, MONTH = Apr, PDF = {https://hal.inria.fr/inria-00076039/file/RR-0515.pdf}, HAL_ID = {inria-00076039}, HAL_VERSION = {v1}, } @techreport{C90, TITLE = {{Metamathematical investigations of a calculus of constructions}}, AUTHOR = {Coquand, T.}, URL = {https://hal.inria.fr/inria-00075471}, NUMBER = {RR-1088}, INSTITUTION = {{INRIA}}, YEAR = {1989}, MONTH = Sep, PDF = {https://hal.inria.fr/inria-00075471/file/RR-1088.pdf}, HAL_ID = {inria-00075471}, HAL_VERSION = {v1}, } @PhDThesis{Coq85, author = {Th. Coquand}, month = jan, school = {Universit\'e Paris~7}, title = {Une Th\'eorie des Constructions}, year = {1985} } @InProceedings{Coq86, author = {Th. Coquand}, address = {Cambridge, MA}, booktitle = {Symposium on Logic in Computer Science}, publisher = {IEEE Computer Society Press}, title = {{An Analysis of Girard's Paradox}}, year = {1986} } @InProceedings{Coq92, author = {Th. Coquand}, title = {{Pattern Matching with Dependent Types}}, year = {1992}, booktitle = {Proceedings of the 1992 Workshop on Types for Proofs and Programs} } @InProceedings{DBLP:conf/types/CornesT95, author = {Cristina Cornes and Delphine Terrasse}, title = {Automating Inversion of Inductive Predicates in Coq}, booktitle = {TYPES}, year = {1995}, pages = {85-104}, crossref = {DBLP:conf/types/1995}, bibsource = {DBLP, http://dblp.uni-trier.de} } @inproceedings{CP90, title={Inductively defined types}, author={Coquand, Thierry and Paulin, Christine}, booktitle={COLOG-88}, pages={50--66}, year={1990}, issn = {1611-3349}, doi = {10.1007/3-540-52335-9_47}, url = {http://dx.doi.org/10.1007/3-540-52335-9_47}, isbn = 9783540469636, publisher = {Springer Berlin Heidelberg} } @Book{Cur58, author = {Haskell B. Curry and Robert Feys and William Craig}, title = {Combinatory Logic}, volume = 1, publisher = "North-Holland", year = 1958, note = {{\S{9E}}}, } @Article{CSlessadhoc, author = {Gonthier, Georges and Ziliani, Beta and Nanevski, Aleksandar and Dreyer, Derek}, title = {How to Make Ad Hoc Proof Automation Less Ad Hoc}, journal = {SIGPLAN Not.}, issue_date = {September 2011}, volume = {46}, number = {9}, month = sep, year = {2011}, issn = {0362-1340}, pages = {163--175}, numpages = {13}, url = {http://doi.acm.org/10.1145/2034574.2034798}, doi = {10.1145/2034574.2034798}, acmid = {2034798}, publisher = {ACM}, address = {New York, NY, USA}, keywords = {canonical structures, coq, custom proof automation, hoare type theory, interactive theorem proving, tactics, type classes}, } @InProceedings{CSwcu, hal_id = {hal-00816703}, url = {http://hal.inria.fr/hal-00816703}, title = {{Canonical Structures for the working Coq user}}, author = {Mahboubi, Assia and Tassi, Enrico}, booktitle = {{ITP 2013, 4th Conference on Interactive Theorem Proving}}, publisher = {Springer}, pages = {19-34}, address = {Rennes, France}, volume = {7998}, editor = {Sandrine Blazy and Christine Paulin and David Pichardie }, series = {LNCS }, doi = {10.1007/978-3-642-39634-2_5}, year = {2013}, } @InProceedings{Del00, author = {Delahaye, D.}, title = {A {T}actic {L}anguage for the {S}ystem {Coq}}, booktitle = {Proceedings of Logic for Programming and Automated Reasoning (LPAR), Reunion Island}, publisher = SV, series = LNCS, volume = {1955}, pages = {85--95}, month = {November}, year = {2000}, url = {http://www.lirmm.fr/%7Edelahaye/papers/ltac%20(LPAR%2700).pdf} } @Article{Dyc92, author = {Roy Dyckhoff}, journal = {The Journal of Symbolic Logic}, month = sep, number = {3}, title = {Contraction-free sequent calculi for intuitionistic logic}, volume = {57}, year = {1992} } @Book{Fourier, author = {Jean-Baptiste-Joseph Fourier}, publisher = {Gauthier-Villars}, title = {Fourier's method to solve linear inequations/equations systems.}, year = {1890} } @article{Gilbert:POPL2019, author = {Gilbert, Ga\"{e}tan and Cockx, Jesper and Sozeau, Matthieu and Tabareau, Nicolas}, title = {{Definitional Proof Irrelevance Without K}}, journal = {Proc. ACM Program. Lang.}, issue_date = {January 2019}, volume = {3}, number = {POPL}, year = {2019}, issn = {2475-1421}, pages = {3:1--3:28}, articleno = {3}, numpages = {28}, url = {http://doi.acm.org/10.1145/3290316}, acmid = {3290316}, publisher = {ACM}, address = {New York, NY, USA}, keywords = {proof assistants, proof irrelevance, type theory}, } @InProceedings{Gim94, author = {E. Gim\'enez}, booktitle = {Types'94 : Types for Proofs and Programs}, note = {Extended version in LIP research report 95-07, ENS Lyon}, publisher = SV, series = LNCS, title = {Codifying guarded definitions with recursive schemes}, volume = {996}, year = {1994} } @TechReport{Gim98, author = {E. Gim\'enez}, title = {A Tutorial on Recursive Types in Coq}, institution = {INRIA}, year = 1998, month = mar } @Unpublished{GimCas05, author = {E. Gim\'enez and P. Cast\'eran}, title = {A Tutorial on [Co-]Inductive Types in Coq}, institution = {INRIA}, year = 2005, month = jan, note = {available at \url{http://coq.inria.fr/doc}} } @InProceedings{Gimenez95b, author = {E. Gim\'enez}, booktitle = {Workshop on Types for Proofs and Programs}, series = LNCS, number = {1158}, pages = {135-152}, title = {An application of co-Inductive types in Coq: verification of the Alternating Bit Protocol}, editorS = {S. Berardi and M. Coppo}, publisher = SV, year = {1995} } @Book{Gir89, author = {J.-Y. Girard and Y. Lafont and P. Taylor}, publisher = {Cambridge University Press}, series = {Cambridge Tracts in Theoretical Computer Science 7}, title = {Proofs and Types}, year = {1989} } @InCollection{How80, author = {W.A. Howard}, booktitle = {to H.B. Curry : Essays on Combinatory Logic, Lambda Calculus and Formalism.}, editor = {J.P. Seldin and J.R. Hindley}, note = {Unpublished 1969 Manuscript}, publisher = {Academic Press}, title = {The Formulae-as-Types Notion of Constructions}, year = {1980} } @inproceedings{H88, title={Induction principles formalized in the Calculus of Constructions}, author={Huet, G{\'e}rard}, booktitle={Programming of Future Generation Computers. Elsevier Science}, year={1988}, issn = {1611-3349}, doi = {10.1007/3-540-17660-8_62}, url = {http://dx.doi.org/10.1007/3-540-17660-8_62}, isbn = 9783540477464, publisher = {Springer Berlin Heidelberg} } @InProceedings{H89, author = {G. Huet}, booktitle = {A perspective in Theoretical Computer Science. Commemorative Volume for Gift Siromoney}, editor = {R. Narasimhan}, publisher = {World Scientific Publishing}, title = {{The Constructive Engine}}, year = {1989} } @Article{LeeWerner11, author = {Gyesik Lee and Benjamin Werner}, title = {Proof-irrelevant model of {CC} with predicative induction and judgmental equality}, journal = {Logical Methods in Computer Science}, volume = {7}, number = {4}, year = {2011}, ee = {http://dx.doi.org/10.2168/LMCS-7(4:5)2011}, bibsource = {DBLP, http://dblp.uni-trier.de} } @TechReport{Leroy90, author = {X. Leroy}, title = {The {ZINC} experiment: an economical implementation of the {ML} language}, institution = {INRIA}, number = {117}, year = {1990} } @InProceedings{Let02, author = {P. Letouzey}, title = {A New Extraction for Coq}, booktitle = {TYPES}, year = 2002, crossref = {DBLP:conf/types/2002}, url = {http://www.irif.fr/~letouzey/download/extraction2002.pdf} } @InProceedings{Luttik97specificationof, author = {Sebastiaan P. Luttik and Eelco Visser}, booktitle = {2nd International Workshop on the Theory and Practice of Algebraic Specifications (ASF+SDF'97), Electronic Workshops in Computing}, publisher = SV, title = {Specification of Rewriting Strategies}, year = {1997} } @inproceedings{Visser98, author = {Eelco Visser and Zine{-}El{-}Abidine Benaissa and Andrew P. Tolmach}, title = {Building Program Optimizers with Rewriting Strategies}, booktitle = {ICFP}, pages = {13--26}, year = {1998}, } @inproceedings{Visser01, author = {Eelco Visser}, title = {Stratego: {A} Language for Program Transformation Based on Rewriting Strategies}, booktitle = {RTA}, pages = {357--362}, year = {2001}, series = {LNCS}, volume = {2051}, } @InProceedings{DBLP:conf/types/McBride00, author = {Conor McBride}, title = {Elimination with a Motive}, booktitle = {TYPES}, year = {2000}, pages = {197-216}, ee = {http://link.springer.de/link/service/series/0558/bibs/2277/22770197.htm}, crossref = {DBLP:conf/types/2000}, bibsource = {DBLP, http://dblp.uni-trier.de} } @InProceedings{Moh93, author = {C. Paulin-Mohring}, booktitle = {Proceedings of the conference Typed Lambda Calculi and Applications}, editor = {M. Bezem and J.-F. Groote}, note = {Also LIP research report 92-49, ENS Lyon}, number = {664}, publisher = SV, series = {LNCS}, title = {{Inductive Definitions in the System Coq - Rules and Properties}}, year = {1993} } @MastersThesis{Mun94, author = {C. Muñoz}, month = sep, school = {DEA d'Informatique Fondamentale, Universit\'e Paris 7}, title = {D\'emonstration automatique dans la logique propositionnelle intuitionniste}, year = {1994} } @Article{Myers, author = {Eugene Myers}, title = {An {O(ND)} difference algorithm and its variations}, journal = {Algorithmica}, volume = {1}, number = {2}, year = {1986}, bibsource = {https://link.springer.com/article/10.1007\%2FBF01840446}, url = {http://www.xmailserver.org/diff2.pdf} } @inproceedings{P86, title={Algorithm development in the calculus of constructions}, author={Mohring, Christine}, booktitle={LICS}, pages={84--91}, year={1986} } @inproceedings{P89, title={Extracting $\Omega$'s programs from proofs in the calculus of constructions}, author={Paulin-Mohring, Christine}, booktitle={Proceedings of the 16th ACM SIGPLAN-SIGACT symposium on Principles of programming languages}, pages={89--104}, year={1989}, doi = {10.1145/75277.75285}, url = {http://dx.doi.org/10.1145/75277.75285}, isbn = 0897912942, organization = {ACM Press} } @inproceedings{P93, title={Inductive definitions in the system coq rules and properties}, author={Paulin-Mohring, Christine}, booktitle={International Conference on Typed Lambda Calculi and Applications}, pages={328--345}, year={1993}, doi = {10.1007/bfb0037116}, url = {http://dx.doi.org/10.1007/bfb0037116}, isbn = 3540565175, organization = {Springer-Verlag} } @inproceedings{PP90, title={Inductively defined types in the Calculus of Constructions}, author={Pfenning, Frank and Paulin-Mohring, Christine}, booktitle={International Conference on Mathematical Foundations of Programming Semantics}, pages={209--228}, year={1989}, doi = {10.1007/bfb0040259}, url = {http://dx.doi.org/10.1007/bfb0040259}, isbn = 0387973753, organization = {Springer-Verlag} } @InProceedings{Parent95b, author = {C. Parent}, booktitle = {{Mathematics of Program Construction'95}}, publisher = SV, series = {LNCS}, title = {{Synthesizing proofs from programs in the Calculus of Inductive Constructions}}, volume = {947}, year = {1995} } @InProceedings{Pit16, Title = {Company-Coq: Taking Proof General one step closer to a real IDE}, Author = {Pit-Claudel, Clément and Courtieu, Pierre}, Booktitle = {CoqPL'16: The Second International Workshop on Coq for PL}, Year = {2016}, Month = jan, Doi = {10.5281/zenodo.44331}, } @Book{RC95, author = {di~Cosmo, R.}, title = {Isomorphisms of Types: from $\lambda$-calculus to information retrieval and language design}, series = {Progress in Theoretical Computer Science}, publisher = {Birkhauser}, year = {1995}, note = {ISBN-0-8176-3763-X} } @Article{Rushby98, title = {Subtypes for Specifications: Predicate Subtyping in {PVS}}, author = {John Rushby and Sam Owre and N. Shankar}, journal = {IEEE Transactions on Software Engineering}, pages = {709--720}, volume = 24, number = 9, month = sep, year = 1998 } @InProceedings{sozeau06, author = {Matthieu Sozeau}, title = {Subset Coercions in {C}oq}, year = {2007}, booktitle = {TYPES'06}, pages = {237-252}, volume = {4502}, publisher = "Springer", series = {LNCS} } @InProceedings{sozeau08, Author = {Matthieu Sozeau and Nicolas Oury}, booktitle = {TPHOLs'08}, Pdf = {http://www.lri.fr/~sozeau/research/publications/drafts/classes.pdf}, Title = {{F}irst-{C}lass {T}ype {C}lasses}, Year = {2008}, } @InProceedings{sugar, author = {Alessandro Giovini and Teo Mora and Gianfranco Niesi and Lorenzo Robbiano and Carlo Traverso}, title = {"One sugar cube, please" or Selection strategies in the Buchberger algorithm}, booktitle = { Proceedings of the ISSAC'91, ACM Press}, year = {1991}, pages = {5--4}, publisher = {} } @PhDThesis{Wer94, author = {B. Werner}, school = {Universit\'e Paris 7}, title = {Une th\'eorie des constructions inductives}, type = {Th\`ese de Doctorat}, year = {1994} } @InProceedings{CompiledStrongReduction, author = {Benjamin Gr{\'{e}}goire and Xavier Leroy}, editor = {Mitchell Wand and Simon L. Peyton Jones}, title = {A compiled implementation of strong reduction}, booktitle = {Proceedings of the Seventh {ACM} {SIGPLAN} International Conference on Functional Programming {(ICFP} '02), Pittsburgh, Pennsylvania, USA, October 4-6, 2002.}, pages = {235--246}, publisher = {{ACM}}, year = {2002}, url = {http://doi.acm.org/10.1145/581478.581501}, doi = {10.1145/581478.581501}, timestamp = {Tue, 11 Jun 2013 13:49:16 +0200}, biburl = {http://dblp.uni-trier.de/rec/bib/conf/icfp/GregoireL02}, bibsource = {dblp computer science bibliography, http://dblp.org} } @InProceedings{FullReduction, author = {Mathieu Boespflug and Maxime D{\'{e}}n{\`{e}}s and Benjamin Gr{\'{e}}goire}, editor = {Jean{-}Pierre Jouannaud and Zhong Shao}, title = {Full Reduction at Full Throttle}, booktitle = {Certified Programs and Proofs - First International Conference, {CPP} 2011, Kenting, Taiwan, December 7-9, 2011. Proceedings}, series = {Lecture Notes in Computer Science}, volume = {7086}, pages = {362--377}, publisher = {Springer}, year = {2011}, url = {http://dx.doi.org/10.1007/978-3-642-25379-9_26}, doi = {10.1007/978-3-642-25379-9_26}, timestamp = {Thu, 17 Nov 2011 13:33:48 +0100}, biburl = {http://dblp.uni-trier.de/rec/bib/conf/cpp/BoespflugDG11}, bibsource = {dblp computer science bibliography, http://dblp.org} } @inproceedings{MilnerPrincipalTypeSchemes, author = {Damas, Luis and Milner, Robin}, title = {Principal Type-schemes for Functional Programs}, booktitle = {Proceedings of the 9th ACM SIGPLAN-SIGACT Symposium on Principles of Programming Languages}, series = {POPL '82}, year = {1982}, isbn = {0-89791-065-6}, location = {Albuquerque, New Mexico}, pages = {207--212}, numpages = {6}, url = {http://doi.acm.org/10.1145/582153.582176}, doi = {10.1145/582153.582176}, acmid = {582176}, publisher = {ACM}, address = {New York, NY, USA}, } @techreport{abel19:failur_normal_impred_type_theor, author = {Andreas Abel AND Thierry Coquand}, title = {{Failure of Normalization in Impredicative Type Theory with Proof-Irrelevant Propositional Equality}}, year = 2019, institution = {Chalmers and Gothenburg University}, } @inproceedings{ConchonFilliatre07wml, author = {Sylvain Conchon and Jean-Christophe Filliâtre}, title = {A Persistent Union-Find Data Structure}, booktitle = {ACM SIGPLAN Workshop on ML}, publisher = {ACM Press}, pages = {37--45}, year = 2007, address = {Freiburg, Germany}, month = {October}, topics = {team, lri}, type_publi = {icolcomlec}, type_digiteo = {conf_isbn}, x-pdf = {https://www.lri.fr/~filliatr/ftp/publis/puf-wml07.pdf}, url = {https://www.lri.fr/~filliatr/ftp/publis/puf-wml07.pdf}, abstract = { The problem of disjoint sets, also known as union-find, consists in maintaining a partition of a finite set within a data structure. This structure provides two operations: a function find returning the class of an element and a function union merging two classes. An optimal and imperative solution is known since 1975. However, the imperative nature of this data structure may be a drawback when it is used in a backtracking algorithm. This paper details the implementation of a persistent union-find data structure as efficient as its imperative counterpart. To achieve this result, our solution makes heavy use of imperative features and thus it is a significant example of a data structure whose side effects are safely hidden behind a persistent interface. To strengthen this last claim, we also detail a formalization using the Coq proof assistant which shows both the correctness of our solution and its observational persistence. }, x-equipes = {demons PROVAL}, x-type = {article}, x-support = {actes_aux}, x-cle-support = {ML} } @phdthesis{Zimmermann19, author = {Th{\'{e}}o Zimmermann}, title = {Challenges in the collaborative evolution of a proof language and its ecosystem.}, school = {Université de Paris, France}, year = {2019}, url = {https://tel.archives-ouvertes.fr/tel-02451322}, timestamp = {Tue, 21 Jul 2020 00:40:54 +0200}, biburl = {https://dblp.org/rec/phd/hal/Zimmermann19.bib}, bibsource = {dblp computer science bibliography, https://dblp.org} } @article{TotR21, author = {Cockx, Jesper and Tabareau, Nicolas and Winterhalter, Th\'{e}o}, title = {The Taming of the Rew: A Type Theory with Computational Assumptions}, year = {2021}, issue_date = {January 2021}, publisher = {Association for Computing Machinery}, address = {New York, NY, USA}, volume = {5}, number = {POPL}, url = {https://doi.org/10.1145/3434341}, doi = {10.1145/3434341}, abstract = {Dependently typed programming languages and proof assistants such as Agda and Coq rely on computation to automatically simplify expressions during type checking. To overcome the lack of certain programming primitives or logical principles in those systems, it is common to appeal to axioms to postulate their existence. However, one can only postulate the bare existence of an axiom, not its computational behaviour. Instead, users are forced to postulate equality proofs and appeal to them explicitly to simplify expressions, making axioms dramatically more complicated to work with than built-in primitives. On the other hand, the equality reflection rule from extensional type theory solves these problems by collapsing computation and equality, at the cost of having no practical type checking algorithm. This paper introduces Rewriting Type Theory (RTT), a type theory where it is possible to add computational assumptions in the form of rewrite rules. Rewrite rules go beyond the computational capabilities of intensional type theory, but in contrast to extensional type theory, they are applied automatically so type checking does not require input from the user. To ensure type soundness of RTT—as well as effective type checking—we provide a framework where confluence of user-defined rewrite rules can be checked modularly and automatically, and where adding new rewrite rules is guaranteed to preserve subject reduction. The properties of RTT have been formally verified using the MetaCoq framework and an implementation of rewrite rules is already available in the Agda proof assistant.}, journal = {Proc. ACM Program. Lang.}, month = {jan}, articleno = {60}, numpages = {29}, keywords = {termination, dependent types, rewriting theory, confluence, type theory} } coq-8.20.0/doc/sphinx/changes.rst000066400000000000000000023431211466560755400166330ustar00rootroot00000000000000.. _changes: -------------- Recent changes -------------- .. ifconfig:: not is_a_released_version .. include:: ../unreleased.rst Version 8.20 ------------ Summary of changes ~~~~~~~~~~~~~~~~~~ Coq version 8.20 adds a new rewrite rule mechanism along with a few new features, a host of improvements to the virtual machine, the notation system, Ltac2 and the standard library. We highlight some of the most impactful changes here: - :ref:`rewrite_rules` - :ref:`primitive strings ` - A lot of work went into reducing the size of the bytecode segment, which in turn means that .vo files might now be considerably smaller. - A new version of the `docker-keeper `_ compiler to build and maintain Docker images of Coq. Notable breaking changes: - Syntactic global references passed through the `using` clauses of :tacn:`auto`-like tactics are now handled as plain references rather than interpreted terms. In particular, their typeclass arguments will not be inferred. In general, the previous behaviour can be emulated by replacing `auto using foo` with `pose proof foo; auto`. - Argument order for the Ltac2 combinators `List.fold_left2` and `List.fold_right2` changed to be the same as in OCaml. - :cmd:`Import`\ing a module containing a mutable Ltac2 definition does not undo its mutations. Replace `Ltac2 mutable foo := some_expr.` with `Ltac2 mutable foo := some_expr. Ltac2 Set foo := some_expr.` to recover the previous behaviour. - Some :ref:`renaming <820_renaming_stdlib>` in the standard library. Deprecations are provided for a smooth transition. See the `Changes in 8.20.0`_ section below for the detailed list of changes, including potentially breaking changes marked with **Changed**. Coq's `reference manual for 8.20 `_, `documentation of the 8.20 standard library `_ and `developer documentation of the 8.20 ML API `_ are also available. Théo Zimmermann with help from Ali Caglayan and Jason Gross maintained `coqbot `_ used to run Coq's CI and other pull request management tasks. Jason Gross maintained the `bug minimizer `_ and its `automatic use through coqbot `_. Erik Martin-Dorel maintained the `Coq Docker images `_ and the `docker-keeper `_ compiler used to build and keep those images up to date (note that the tool is not Coq specific). Cyril Cohen, Vincent Laporte, Pierre Roux and Théo Zimmermann maintained the `Nix toolbox `_ used by many Coq projects for continuous integration. Ali Caglayan, Emilio Jesús Gallego Arias, Rudi Grinberg and Rodolphe Lepigre maintained the `Dune build system for OCaml and Coq `_ used to build Coq itself and many Coq projects. The opam repository for Coq packages has been maintained by Guillaume Claret, Guillaume Melquiond, Karl Palmskog and Enrico Tassi with contributions from many users. A list of packages is `available on the Coq website `_. Coq 8.20 was made possible thanks to the following reviewers: Frédéric Besson, Lasse Blaauwbroek, Ali Caglayan, Cyril Cohen, Andrej Dudenhefner, Andres Erbsen, Jim Fehrle, Emilio Jesús Gallego Arias, Gaëtan Gilbert, Jason Gross, Hugo Herbelin, Ralf Jung, Jan-Oliver Kaiser, Chantal Keller, Olivier Laurent, Rodolphe Lepigre, Yishuai Li, Ralph Matthes, Guillaume Melquiond, Pierre-Marie Pédrot, Karl Palmskog, Clément Pit-Claudel, Pierre Rousselin, Pierre Roux, Michael Soegtrop, soukouki, Matthieu Sozeau, Nicolas Tabareau, Enrico Tassi, Niels van der Weide, Nickolai Zeldovich and Théo Zimmermann. See the `Coq Team face book `_ page for more details on Coq's development team. The 59 contributors to the 8.20 version are: Timur Aminev, Frédéric Besson, Lasse Blaauwbroek, Björn Brandenburg, Ali Caglayan, Nikolaos Chatzikonstantinou, Sylvain Chiron, chluebi, Cyril Cohen, Anton Danilkin, Louise Dubois de Prisque, Andrej Dudenhefner, Maxime Dénès, Andres Erbsen, Jim Fehrle, Davide Fissore, Andreas Florath, Yannick Forster, Mario Frank, Gaëtan Gilbert, Georges Gonthier, Jason Gross, Stefan Haan, Hugo Herbelin, Lennart Jablonka, Emilio Jesús Gallego Arias, Ralf Jung, Jan-Oliver Kaiser, Evgenii Kosogorov, Rodolphe Lepigre, Yann Leray, David M. Cooke, Erik Martin-Dorel, Guillaume Melquiond, Guillaume Munch-Maccagnoni, Karl Palmskog, Julien Puydt, Pierre-Marie Pédrot, Ramkumar Ramachandra, Pierre Rousselin, Pierre Roux, Kazuhiko Sakaguchi, Bernhard Schommer, Remy Seassau, Matthieu Sozeau, Enrico Tassi, Romain Tetley, Laurent Théry, Alexey Trilis, Oliver Turner, Quentin Vermande, Li-yao Xia and Théo Zimmermann, The Coq community at large helped improve this new version via the GitHub issue and pull request system, the coq-club@inria.fr mailing list, the `Discourse forum `_ and the `Coq Zulip chat `_. Version 8.20's development spanned 7 months from the release of Coq 8.19.0 (9 months since the branch for 8.19.0). Pierre Roux and Guillaume Melquiond are the release managers of Coq 8.20. This release is the result of 470 merged PRs, closing 113 issues. | Toulouse, September 2024 | Pierre Roux and Guillaume Melquiond for the Coq development team Changes in 8.20.0 ~~~~~~~~~~~~~~~~~ .. contents:: :local: Kernel ^^^^^^ - **Changed:** The guard checker now recognizes uniform parameters of a fixpoint and treats their instances as constant over the recursive call (`#17986 `_, grants `#16040 `_, by Hugo Herbelin). - **Added:** A mechanism to add user-defined rewrite rules to Coq's reduction mechanisms; see chapter :ref:`rewrite_rules` (`#18038 `_, by Yann Leray). - **Added:** Support for primitive strings in terms (`#18973 `_, by Rodolphe Lepigre). Specification language, type inference ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ - **Changed:** warnings `future-coercion-class-constructor` and `future-coercion-class-field` about ``:>`` in :cmd:`Class` as errors by default. This offers a last opportunity to replace ``:>`` with ``::`` (available since Coq 8.18) to declare typeclass instances before making ``:>`` consistently declare coercions in all records in next version. To adapt huge codebases, you can try `this script `_ or the one below. But beware that both are incomplete. .. code-block:: sh #!/bin/awk -f BEGIN { startclass = 0; inclass = 0; indefclass = 0; # definitionalclasses (single field, without { ... }) } { if ($0 ~ "[ ]*Class") { startclass = 1; } if (startclass == 1 && $0 ~ ":=") { inclass = 1; indefclass = 1; } if (startclass == 1 && $0 ~ ":=.*{") { indefclass = 0; } if (inclass == 1) startclass = 0; if (inclass == 1 && $0 ~ ":>") { if ($0 ~ "{ .*:>") { # first field on a single line sub("{ ", "{ #[global] "); } else if ($0 ~ ":=.*:>") { # definitional classes on a single line sub(":= ", ":= #[global] "); } else if ($0 ~ "^ ") { sub(" ", " #[global] "); } else { $0 = "#[global] " $0; } sub(":>", "::") } print $0; if ($0 ~ ".*}[.]" || indefclass == 1 && $0 ~ "[.]$") inclass = 0; } (`#18590 `_, by Pierre Roux). - **Changed:** Mutually-proved theorems with statements in different coinductive types now supported (`#18743 `_, by Hugo Herbelin). - **Added:** :cmd:`CoFixpoint` supports attributes `bypass_guard`, `clearbody`, `deprecated` and `warn` (`#18754 `_, by Hugo Herbelin). - **Added:** `Program Fixpoint` with `measure` or `wf` (see :ref:`program_fixpoint`) now supports the `where` clause for notations, the `local` and `clearbody` attributes, as well as non-atomic conclusions (`#18834 `_, by Hugo Herbelin, fixes in particular `#13812 `_ and `#14841 `_). - **Fixed:** Anomaly on the absence of remaining obligations of some name now an error (`#18873 `_, fixes `#3889 `_, by Hugo Herbelin). - **Fixed:** Universe polymorphic `Program`'s obligations are now generalized only over the universe variables that effectively occur in the obligation (`#18915 `_, fixes `#11766 `_ and `#11988 `_, by Hugo Herbelin). - **Fixed:** Anomaly `assertion failed` in pattern-matching compilation, with :flag:`Program Mode` or with let-ins in the arity of an inductive type (`#18921 `_, fixes `#5777 `_ and `#11030 `_ and `#11586 `_, by Hugo Herbelin). - **Fixed:** Support for `Program`-style pattern-matching on more than one argument in an inductive family (`#18929 `_, fixes `#1956 `_ and `#5777 `_, by Hugo Herbelin). - **Fixed:** anomaly with obligations in the binders of a `measure`- or `wf`-based `Program Fixpoint` (`#18958 `_, fixes `#18920 `_, by Hugo Herbelin). - **Fixed:** Incorrect registration of universe names attached to a primitive polymorphic constant (`#19100 `_, fixes `#19099 `_, by Hugo Herbelin). Notations ^^^^^^^^^ - **Changed:** an :g:`only printing` interpretation of a notation with a specific format does no longer change the printing rule of other interpretations of the notation; to globally change the default printing rule of all interpretations of a notation, use :g:`Reserved Notation` instead (`#16329 `_, fixes `#16262 `_, by Hugo Herbelin). - **Changed:** levels of :cmd:`Reserved Notation` now default to levels of previous notations with longest common prefix, if any. This helps to :ref:`factorize notations ` with common prefixes (`#19149 `_, by Pierre Roux). - **Added:** :warn:`closed-notation-not-level-0` and :warn:`postfix-notation-not-level-1` warnings about closed and postfix notations at unusual levels (`#18588 `_, by Pierre Roux). - **Added:** :warn:`notation-incompatible-prefix` warning when two notation definitions have incompatible prefixes (`#19049 `_, by Pierre Roux). - **Fixed:** Notations for applied constants equipped with multiple signatures of implicit arguments were not correctly inserting as many maximal implicit arguments as they should have (`#18445 `_, by Hugo Herbelin). - **Fixed:** Add support for printing notations applied to extra arguments in custom entries, thus eliminating an anomaly (`#18447 `_, fixes `#18342 `_, by Hugo Herbelin). Tactics ^^^^^^^ - **Changed:** When using :g:`Z.to_euclidean_division_equations`, :tacn:`nia` can now relate :g:`Z.div`/:g:`Z.modulo` to :g:`Z.quot`/:g:`Z.rem` a bit better, by virtue of being noticing when there are two equations of the form ``x = y * q₁ + _`` and ``x = y * q₂ + _`` (or minor variations thereof), suggesting that ``q₁ = q₂``. Users can replace :g:`Z.to_euclidean_division_equations` with :g:`let flags := Z.euclidean_division_equations_flags.default_with Z.euclidean_division_equations_flags.find_duplicate_quotients false in Z.to_euclidean_division_equations_with flags` or, using :g:`Import Z.euclidean_division_equations_flags.`, with :g:`Z.to_euclidean_division_equations_with ltac:(default_with find_duplicate_quotients false)` (`#17934 `_, by Jason Gross). - **Changed:** The opacity/transparency of primitive projections is now attached to the projections themselves, not the compatibility constants, and compatibility constants are always considered transparent (`#18327 `_, fixes `#18281 `_, by Jan-Oliver Kaiser and Rodolphe Lepigre). - **Changed:** Tactic :g:`intro z` on an existential variable goal forces the resolution of the existential variable into a goal :g:`forall z:?T, ?P`, which becomes :g:`?P` in context :g:`z:?T` after introduction. The existential variable :n:`?P` itself is now defined in a context where the variable of type `?T` is also named :g:`z`, as specified by :tacn:`intro` instead of :g:`x` as it was conventionally the case before (`#18395 `_, by Hugo Herbelin). - **Changed:** syntactic global references passed through the `using` clauses of :tacn:`auto`-like tactics are now handled as plain references rather than interpreted terms. In particular, their typeclass arguments will not be inferred. In general, the previous behaviour can be emulated by replacing `auto using foo` with `pose proof foo; auto` (`#18909 `_, by Pierre-Marie Pédrot). - **Changed:** Use Coqlib's :cmd:`Register` mechanism for the generalized rewriting tactic and make the (C)RelationClasses/(C)Morphisms independent of the `rewrite` tactic to ease maintainance. (`#19115 `_, by Matthieu Sozeau). - **Removed:** the `clear` modifier which was deprecated since 8.17 (`#18887 `_, by Pierre-Marie Pédrot). - **Removed:** the `cutrewrite` tactic, which was deprecated since Coq 8.5 (`#19027 `_, by Pierre-Marie Pédrot). - **Deprecated:** non-reference hints in `using` clauses of :tacn:`auto`-like tactics (`#19006 `_, by Pierre-Marie Pédrot). - **Deprecated:** the :tacn:`gintuition` tactic, which used to be undocumented until Coq 8.16 (`#19129 `_, by Pierre-Marie Pédrot). - **Deprecated:** :tacn:`destauto`, see `#11537 `_ (`#19179 `_, by Jim Fehrle). - **Added:** When using :g:`Z.to_euclidean_division_equations`, you can now pose equations of the form ``x = y * q`` using :g:`Z.divide` (`#17927 `_, by Evgenii Kosogorov). - **Added:** support for :g:`Nat.double` and :g:`Nat.div2` to :g:`zify` and :g:`lia` (`#18729 `_, by Andres Erbsen). - **Added:** the :tacn:`replace` tactic now accepts `->` and `<-` to specify the direction of the replacement when used with a `with` clause (`#19060 `_, fixes `#13480 `_, by Pierre-Marie Pédrot). - **Fixed:** The name of a cofixpoint globally defined with a name is now systematically reused by :tacn:`simpl` after reduction, even when the named cofixpoint is mutually defined or defined in a section (`#18576 `_, fixes `#4056 `_, by Hugo Herbelin). - **Fixed:** The reduction of primitive projections of cofixpoints by :tacn:`simpl` is now implemented (`#18577 `_, fixes `#7982 `_, by Hugo Herbelin). - **Fixed:** Support for refolding reduced global mutual fixpoints/cofixpoints with parameters in :tacn:`cbn` (`#18601 `_, fixes part of `#4056 `_, by Hugo Herbelin). - **Fixed:** :tacn:`cbn` was leaving behind unnamable constants when refolding mutual fixpoints/cofixpoints from aliased modules (`#18616 `_, fixes `#17897 `_, by Hugo Herbelin). - **Fixed:** :tacn:`cbv` of primitive projections applied to a tuple now ignores `beta` like it does for :tacn:`cbn`, :tacn:`lazy` and :tacn:`simpl` (`#18618 `_, fixes `#9086 `_, by Hugo Herbelin). Ltac language ^^^^^^^^^^^^^ - **Added:** In :tacn:`rewrite_strat`, :n:`@rewstrategy` now supports the fixpoint operator :n:`fix @ident := @rewstrategy1` (`#18094 `_, fixes `#13702 `_, by Jason Gross and Gaëtan Gilbert). - **Fixed:** :tacn:`rewrite_strat` now works inside module functors (`#18094 `_, fixes `#18463 `_, by Jason Gross). Ltac2 language ^^^^^^^^^^^^^^ - **Changed:** recursive `let` and non mutable projections of syntactic values are considered syntactic values (`#18411 `_, by Gaëtan Gilbert). - **Changed:** Ltac2 are typechecked at declaration time by default. This should produce better errors when a notation argument does not have the expected type (e.g. wrong branch type in `match! goal`). In the previous behaviour of typechecking, only the expansion result can be recovered using :flag:`Ltac2 Typed Notations`. We believe there are no real use cases for this, please report if you have any (`#18432 `_, fixes `#17477 `_, by Gaëtan Gilbert). - **Changed:** argument order for the Ltac2 combinators `List.fold_left2` and `List.fold_right2` changed to be the same as in OCaml (`#18706 `_, by Gaëtan Gilbert). - **Changed:** :cmd:`Import`\ing a module containing a mutable Ltac2 definition does not undo its mutations. Replace `Ltac2 mutable foo := some_expr.` with `Ltac2 mutable foo := some_expr. Ltac2 Set foo := some_expr.` to recover the previous behaviour (`#18713 `_, by Gaëtan Gilbert). - **Changed:** the `using` clause argument of :tacn:`auto`-like tactics in Ltac2 now take a global `reference` rather than arbitrary `constr` (`#18940 `_, by Pierre-Marie Pédrot). - **Deprecated:** `Ltac2.Constr.Pretype.Flags.open_constr_flags` whose name is misleading as it runs typeclass inference unlike `open_constr:()` (`#18765 `_, by Gaëtan Gilbert). - **Added:** `fst` and `snd` in `Ltac2.Init` (`#18370 `_, by Gaëtan Gilbert). - **Added:** `Ltac2.Ltac1.of_preterm` and `to_preterm` (`#18551 `_, by Gaëtan Gilbert). - **Added:** `of_intro_pattern` and `to_intro_pattern` in `Ltac2.Ltac1` (`#18558 `_, by Gaëtan Gilbert). - **Added:** basic APIs in `Ltac2.Ltac1` to produce slightly more informative errors when failing to convert a Ltac1 value to some Ltac2 type (`#18558 `_, by Gaëtan Gilbert). - **Added:** APIs `Ltac2.Control.unshelve` and `Ltac2.Notations.unshelve` (`#18604 `_, by Gaëtan Gilbert). - **Added:** warning on unused Ltac2 variables (except when starting with `_`) (`#18641 `_, by Gaëtan Gilbert). - **Added:** `Ltac2.Control.numgoals` (`#18690 `_, by Gaëtan Gilbert). - **Added:** `intropattern` and `intropatterns` notation scopes support views (`foo%bar`) (`#18757 `_, by Gaëtan Gilbert). - **Added:** open recursion combinators in `Ltac2.Constr.Unsafe` (`#18764 `_, by Gaëtan Gilbert). - **Added:** APIs in `Ltac2.Constr.Pretype.Flags` to customize pretyping flags. (`#18765 `_, by Gaëtan Gilbert). - **Added:** :attr:`abstract` attribute for :cmd:`Ltac2 Type` to turn types abstract at the end of the current module (`#18766 `_, fixes `#18656 `_, by Gaëtan Gilbert). - **Added:** APIs in `Ltac2.Message` to interact with the boxing system of the pretty printer (`#18988 `_, by Gaëtan Gilbert). - **Added:** :flag:`Automatic Proposition Inductives`, :flag:`Dependent Proposition Eliminators` and :warn:`warning when automatically lowering an inductive declared with Type to Prop ` (`#18989 `_, by Gaëtan Gilbert). - **Added:** `String.sub` (`#19204 `_, by Rodolphe Lepigre). - **Fixed:** `Ltac2.Control.new_goal` removes the new goal from the shelf and future goals (`#19141 `_, fixes `#19138 `_, by Gaëtan Gilbert). SSReflect ^^^^^^^^^ - **Changed:** ssreflect no longer relies on the recovery mechanism of the parsing engine, this can slightly change the parsing priorities in rare occurences, for instance when combining :tacn:`unshelve` and ``=>`` (`#18224 `_, by Pierre Roux). - **Changed:** notations ``_.1`` and ``_.2`` are now defined in the prelude at level 1 rather than in ``ssrfun`` at level 2 (`#18224 `_, by Pierre Roux). - **Changed:** The :tacn:`have` tactic generates a proof term containing an opaque constant, as it did up to PR `#15121 `_ included in Coq 8.16.0. See the variant `have @H` to generate a (transparent) let-in instead (:ref:`generating_let_ssr`). (`#18449 `_, fixes `#18017 `_, by Enrico Tassi). - **Deprecated:** The ``fun_scope`` notation scope declared in `ssrfun.v` is deprecated. Use ``function_scope`` instead (`#18374 `_, by Kazuhiko Sakaguchi). - **Fixed:** handling of primitive projections in ssrewrite (`#19213 `_, fixes `#19229 `_, by Pierre Roux, Kazuhiko Sakaguchi, Enrico Tassi and Quentin Vermande). Commands and options ^^^^^^^^^^^^^^^^^^^^ - **Changed:** the default reversibility status of most coercions. The refman states that By default coercions are not reversible except for Record fields specified using ``:>``. The previous code was making way too many coercion reversible by default. The new behavior should be closer from the spec in the doc (`#18705 `_, by Pierre Roux). - **Changed:** focus commands such as `1:{` and goal selection for query commands such as `1: Check` do not need `Classic` (Ltac1) proof mode to function. In particular they function in Ltac2 mode (`#18707 `_, fixes `#18351 `_, by Gaëtan Gilbert). - **Changed:** inductives declared with `: Type` or no annotation and automatically put in `Prop` are not declared template polymorphic (`#18867 `_, by Gaëtan Gilbert). - **Changed:** Clarify the warning about use of :cmd:`Let`, :cmd:`Variable`, :cmd:`Hypothesis` and :cmd:`Context` outside sections and make it an error by default (`#18880 `_, by Pierre Roux). - **Changed:** The "fragile-hint-constr" warning is now an error by default, as the corresponding feature will be removed in a later version (`#18895 `_, by Pierre-Marie Pédrot). - **Changed:** :cmd:`Scheme` automatically registers the resulting schemes in the :cmd:`Register Scheme` database (`#19016 `_, fixes `#3132 `_, by Gaëtan Gilbert). - **Changed:** :cmd:`Typeclasses Transparent` and :cmd:`Typeclasses Opaque` default locality outside section is now :attr:`export` (`#19069 `_, by Gaëtan Gilbert). - **Deprecated:** The :cmd:`Cd` command. Instead use the command line option `-output-directory` (see :ref:`command-line-options`) or, for extraction, :opt:`Extraction Output Directory` (`#17403 `_, by Ali Caglayan and Hugo Herbelin). - **Added:** :attr:`warn` attribute generalizing the deprecation machinery to other forms of comments (`#18248 `_, by Hugo Herbelin and Pierre Roux). - **Added:** :cmd:`Register Scheme` to add entries to the scheme database used by some tactics (`#18299 `_, by Gaëtan Gilbert). - **Added:** :cmd:`Print` :n:`@reference` now shows the implicit arguments of a :n:`@reference` directly on the type of :n:`@reference`, using `{...}` and `[...]` markers for respectively maximally-inserted and non-maximally-inserted implicit arguments, as :cmd:`About` does (`#18444 `_, by Hugo Herbelin). - **Added:** :n:`@import_categories` supports category `options` controlling :ref:`flags-options-tables` (`#18536 `_, by Gaëtan Gilbert). - **Added:** When a name is a projection, :cmd:`About` and :cmd:`Print` now indicate it (`#18725 `_, by Hugo Herbelin). - **Added:** :cmd:`Hint Projections` command that sets the transparency flag for projections for the specified hint databases (`#18785 `_, by Jan-Oliver Kaiser and Rodolphe Lepigre). - **Added:** :cmd:`Search` now admits the `is:Fixpoint` and `is:CoFixpoint` logical kinds to search for constants defined with the `Fixpoint` and `CoFixpoint` keywords (`#18983 `_, by Pierre Rousselin). - **Added:** The :cmd:`Include` command can now include module types with a `with` clause (:n:`@with_declaration`) to instantiate some parameters (`#19144 `_, by Pierre Rousselin). - **Fixed:** Fixes missing implicit arguments coming after a :g:`->` in the main type printed by :cmd:`Print` and :cmd:`About` (`#18442 `_, fixes `#15020 `_, by Hugo Herbelin). - **Fixed:** :flag:`Cumulativity Weak Constraints` can unify universes to `Set` when :flag:`Universe Minimization ToSet` is enabled (`#18458 `_, by Gaëtan Gilbert). - **Fixed:** :cmd:`Search` with modifier `is:Scheme` restricted the search to inductive types which have schemes instead of the schemes themselves. For instance `Search nat is:Scheme` with just the prelude loaded would return `le` i.e. the only inductive type whose type mentions `nat` (`#18537 `_, fixes `#18298 `_, by Gaëtan Gilbert). - **Fixed:** :cmd:`Search` now searches also in included module types (`#18662 `_, fixes `#18657 `_, by Hugo Herbelin). - **Fixed:** :cmd:`Eval` and :cmd:`Definition` with `:= Eval` work without needing to load the Ltac plugin (`#18852 `_, fixes `#12948 `_, by Gaëtan Gilbert). - **Fixed:** :cmd:`Scheme` declares non-recursive schemes for :n:`@scheme_type` `Case` and `Elimination` (`#19017 `_, fixes `#10816 `_, by Gaëtan Gilbert). - **Fixed:** :flag:`Cumulativity Weak Constraints` had its meaning flipped since 8.12 (`#19201 `_, by Gaëtan Gilbert). Command-line tools ^^^^^^^^^^^^^^^^^^ - **Changed:** signal `SIGINT` interrupts the process with " "user interrupt" error instead of aborting. This is intended to produce better messages when interrupting Coq (`#18716 `_, by Gaëtan Gilbert). - **Added:** Command line option :n:`-output-directory dir` to set the default output directory for extraction, :cmd:`Redirect` and :cmd:`Print Universes` (`#17392 `_, fixes `#8649 `_, by Hugo Herbelin). - **Fixed:** coqdoc links to section variables introduced with :cmd:`Context` (`#18527 `_, fixes `#18516 `_, by Pierre Roux). CoqIDE ^^^^^^ - **Changed:** Find/replace UI was improved: margins, icons for found/not found (`#18523 `_, fixes `#11024 `_, by Sylvain Chiron). - **Changed:** The default key binding modifier for the Navigation menu was changed to Alt on non-macOS systems. The previous default, Ctrl, hid some conventional cursor movement bindings such as Ctrl-Left, Ctrl-Right, Ctrl-Home and Ctrl-End. The new default generally has no effect if you've previously installed Coq on your system. See :ref:`Shortcuts` to change the default. The Edit/Undo key binding was changed from Ctrl-U to Ctrl-Z to be more consistent with common conventions. `View/Previous Tab` and `View/Next Tab` were changed from `Alt-Left/Right` to `Ctrl-PgUp/PgDn` (`Cmd-PgUp/PgDn` on macOS). To change key bindings on your system (e.g. back to Ctrl-U), see :ref:`key_bindings` (`#18717 `_, by Sylvain Chiron). - **Changed:** Changing modifiers for the View menu only applies to toggleable items; View/Show Proof was changed to Shift-F2 (`#18717 `_, by Sylvain Chiron). - **Added:** Edit/Select All and Navigation/Fully Check menu items (`#18717 `_, fixes `#16141 `_, by Sylvain Chiron). - **Fixed:** Opening a file with drag and drop now works correctly (fixed regression) (`#18524 `_, fixes `#3977 `_, by Sylvain Chiron). - **Fixed:** Incorrect highlight locations and line numbers for errors and warnings, especially in the presence of unicode characters. This updates the XML protocol (`#19040 `_, fixes `#18682 `_, by Hugo Herbelin). - **Fixed:** Show tooltips for syntax errors (`#19153 `_, fixes `#19152 `_, by Jim Fehrle). .. _820_renaming_stdlib: Standard library ^^^^^^^^^^^^^^^^ - **Changed:** names of "push" lemmas for :g:`List.length` to follow the same convention as push lemmas for other operations. For example, :g:`app_length` became :g:`length_app`. The standard library was migrated using the following script: .. code-block:: sh find theories -name '*.v' | xargs sed -i -E ' s/\/length_app/g; s/\/length_rev/g; s/\/length_map/g; s/\/fold_left_S_O/g; s/\/length_fst_split/g; s/\/length_snd_split/g; s/\/length_combine/g; s/\/length_prod/g; s/\/length_firstn/g; s/\/length_skipn/g; s/\/length_seq/g; s/\/length_concat/g; s/\/length_flat_map/g; s/\/length_list_power/g; ' (`#18564 `_, by Andres Erbsen). - **Changed:** ``Coq.CRelationClasses.arrow``, ``Coq.CRelationClasses.iffT`` and ``Coq.CRelationClasses.flip`` are now :cmd:`Typeclasses Opaque` (`#18910 `_, by Pierre-Marie Pédrot). - **Removed:** The library files ``Coq.NArith.Ndigits``, ``Coq.NArith.Ndist``, and ``Coq.Strings.ByteVector`` which were deprecated since 8.19 (`#18936 `_, by Andres Erbsen). - **Deprecated:** The library files * ``Coq.Numbers.Integer.Binary.ZBinary`` * ``Coq.Numbers.Integer.NatPairs.ZNatPairs`` * ``Coq.Numbers.Natural.Binary.NBinary`` have been deprecated. Users should require ``Coq.Arith.PeanoNat`` or ``Coq.Arith.NArith.BinNat`` if they want implementations of natural numbers and ``Coq.Arith.ZArith.BinInt`` if they want an implementation of integers (`#18500 `_, by Pierre Rousselin). - **Deprecated:** The library file ``Coq.Numbers.NatInt.NZProperties`` is deprecated. Users can require ``Coq.Numbers.NatInt.NZMulOrder`` instead and replace the module ``NZProperties.NZProp`` with ``NZMulOrder.NZMulOrderProp`` (`#18501 `_, by Pierre Rousselin). - **Deprecated:** The library file ``Coq.Arith.Bool_nat`` has been deprecated (`#18538 `_, by Pierre Rousselin). - **Deprecated:** The library file ``Coq.Numbers.NatInt.NZDomain`` is deprecated (`#18539 `_, by Pierre Rousselin). - **Deprecated:** The library files ``Coq.Numbers.Integers.Abstract.ZDivEucl`` and ``Coq.ZArith.Zeuclid`` are deprecated (`#18544 `_, by Pierre Rousselin). - **Deprecated:** The library files ``Coq.Numbers.Natural.Abstract.NIso`` and ``Coq.Numbers.Natural.Abstract.NDefOps`` are deprecated (`#18668 `_, by Pierre Rousselin). - **Deprecated:** ``Bool.Bvector``. Users are encouraged to consider ``list bool`` instead. Please open an issue if you would like to keep using ``Bvector``. (`#18947 `_, by Andres Erbsen). - **Added:** A warning on :g:`Vector.t` to make its new users aware that using this dependently typed representation of fixed-length lists is more technically difficult, compared to bundling lists with a proof of their length. This is not a deprecation and there is no intent to remove it from the standard library. Use option `-w -stdlib-vector` to silence the warning (`#18032 `_, by Pierre Roux, reviewed by Andres Erbsen, Jim Fehrle, Emilio Jesús Gallego Arias, Gaëtan Gilbert, Hugo Herbelin, Olivier Laurent, Yishuai Li, Pierre-Marie Pédrot and Michael Soegtrop). - **Added:** lemmas :g:`NoDup_app`, :g:`NoDup_iff_ForallOrdPairs`, :g:`NoDup_map_NoDup_ForallPairs` and :g:`NoDup_concat` (`#18172 `_, by Stefan Haani and Andrej Dudenhefner). - **Added:** lemmas :g:`In_iff_nth_error` :g:`nth_error_app`, :g:`nth_error_cons_0`, :g:`nth_error_cons_succ`, :g:`nth_error_rev`, :g:`nth_error_firstn`, :g:`nth_error_skipn`, :g:`hd_error_skipn`, :g:`nth_error_seq` (`#18563 `_, by Andres Erbsen) - **Added:** to :g:`N` and :g:`Nat` lemmas :g:`strong_induction_le`, :g:`binary_induction`, :g:`strong_induction_le`, :g:`even_even`, :g:`odd_even`, :g:`odd_odd`, :g:`even_odd`, :g:`b2n_le_1`, :g:`testbit_odd_succ'`, :g:`testbit_even_succ'`, :g:`testbit_div2`, :g:`div2_0`, :g:`div2_1`, :g:`div2_le_mono`, :g:`div2_even`, :g:`div2_odd'`, :g:`le_div2_diag_l`, :g:`div2_le_upper_bound`, :g:`div2_le_lower_bound`, :g:`lt_div2_diag_l`, :g:`le_div2`, :g:`lt_div2`, :g:`div2_decr`, :g:`land_even_l`, :g:`land_even_r`, :g:`land_odd_l`, :g:`land_odd_r`, :g:`land_even_even`, :g:`land_odd_even`, :g:`land_even_odd`, :g:`land_odd_odd`, :g:`land_le_l`, :g:`land_le_r`, :g:`ldiff_even_l`, :g:`ldiff_odd_l`, :g:`ldiff_even_r`, :g:`ldiff_odd_r`, :g:`ldiff_even_even`, :g:`ldiff_odd_even`, :g:`ldiff_even_odd`, :g:`ldiff_odd_odd`, :g:`ldiff_le_l`, :g:`shiftl_lower_bound`, :g:`shiftr_upper_bound`, :g:`ones_0`, :g:`ones_succ`, :g:`pow_lower_bound` (`#18628 `_, by Pierre Rousselin). - **Fixed:** :g:`Z.euclidean_division_equations_cleanup` has been reordered so that :tacn:`zify` (and :tacn:`lia`, :tacn:`nia`, etc) are no longer as slow when the context contains many assumptions of the form :g:`0 <= ... < ...` (`#18818 `_, fixes `#18770 `_, by Jason Gross). Infrastructure and dependencies ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ - **Changed:** Bump minimal Dune version required to build Coq to 3.6.1 (`#18359 `_, by Emilio Jesus Gallego Arias). - **Removed:** Support for ``.vio`` files and for ``.vio2vo`` transformation has been removed, compilation to ``.vos`` is the supported method for quick compilation now (`#18424 `_, fixes `#4007 `_ and `#4013 `_ and `#4123 `_ and `#5308 `_ and `#5223 `_ and `#6720 `_ and `#8402 `_ and `#9637 `_ and `#11471 `_ and `#18380 `_, by Emilio Jesus Gallego Arias). - **Added:** The `coq-doc` opam / Dune package will now build and install Coq's documentation (`#17808 `_, by Emilio Jesus Gallego Arias). - **Added:** Coq is now compatible with `memprof-limits` interruption methods. This means that Coq will be recompiled when the library is installed / removed from an OPAM switch. (`#18906 `_, fixes `#17760 `_, by Emilio Jesus Gallego Arias). - **Added:** ability to exit from `Drop.` in Coq toplevel by a simple `Ctrl + D`, without leaving the OCaml toplevel on the stack. Also add a custom OCaml toplevel directory `#go` which does the same action as `go ()`, but with a more native syntax (`#18771 `_, by Anton Danilkin). Extraction ^^^^^^^^^^ - **Added:** Extension for OCaml extraction: Commands to extract foreign function calls to C (external) and ML function exposition (Callback.register) for calling being able to call them by C functions (`#18270 `_, fixes `#18212 `_, by Mario Frank). - **Fixed:** Wrongly self-referencing extraction of primitive projections to OCaml in functors (`#17321 `_, fixes `#16288 `_, by Hugo Herbelin). Note that OCaml wrappers assuming that the applicative syntax of projections is provided may have to use the dot notation instead. Version 8.19 ------------ Summary of changes ~~~~~~~~~~~~~~~~~~ Coq version 8.19 extends the kernel universe polymorphism to polymorphism over sorts (e.g. `Prop`, `SProp`) along with a few new features, a host of improvements to the notation system, the Ltac2 standard library, and the removal of some standard library files after a long deprecation period. We highlight some of the most impactful changes here: - :ref:`sort-polymorphism` makes it possible to share common constructs over `Type` `Prop` and `SProp`. - The notation :g:`term%_scope` to set a scope only temporarily (in addition to :g:`term%scope` for opening a scope applying to all subterms). - :tacn:`lazy`, :tacn:`simpl`, :tacn:`cbn` and :tacn:`cbv` and the associated :cmd:`Eval` and :tacn:`eval` reductions learned to do head reduction when given flag `head`. - :ref:`New Ltac2 APIs <819Ltac2>`, improved Ltac2 `exact` and dynamic building of Ltac2 term patterns. - New performance evaluation facilities: :cmd:`Instructions` to count CPU instructions used by a command (Linux only) and :ref:`profiling` system to produce trace files. - New command :cmd:`Attributes` to assign attributes such as :attr:`deprecated` to a library file. Notable breaking changes: - :tacn:`replace` with `by tac` does not automatically attempt to solve the generated equality subgoal using the hypotheses. Use `by first [assumption | symmetry;assumption | tac]` if you need the previous behaviour. - :ref:`Removed old deprecated files <819Stdlib>` from the standard library. See the `Changes in 8.19.0`_ section below for the detailed list of changes, including potentially breaking changes marked with **Changed**. Coq's `reference manual for 8.19 `_, `documentation of the 8.19 standard library `_ and `developer documentation of the 8.19 ML API `_ are also available. Maxime Dénès and Thierry Martinez with support from Erik Martin-Dorel and Théo Zimmermann moved the CI away from `gitlab.com `_ to use Inria supported runner machines through `gitlab.inria.fr `_. Théo Zimmermann with help from Ali Caglayan and Jason Gross maintained `coqbot `_ used to run Coq's CI and other pull request management tasks. Jason Gross maintained the `bug minimizer `_ and its `automatic use through coqbot `_. Jaime Arias and Erik Martin-Dorel maintained the `Coq Docker images `_ and Cyril Cohen, Vincent Laporte, Pierre Roux and Théo Zimmermann maintained the `Nix toolbox `_ used by many Coq projects for continuous integration. Ali Caglayan, Emilio Jesús Gallego Arias, Rudi Grinberg and Rodolphe Lepigre maintained the `Dune build system for OCaml and Coq `_ used to build Coq itself and many Coq projects. The opam repository for Coq packages has been maintained by Guillaume Claret, Guillaume Melquiond, Karl Palmskog and Enrico Tassi with contributions from many users. A list of packages is `available on the Coq website `_. Our current maintainers are Yves Bertot, Frédéric Besson, Ana Borges, Ali Caglayan, Tej Chajed, Cyril Cohen, Pierre Corbineau, Pierre Courtieu, Andres Erbsen, Jim Fehrle, Julien Forest, Emilio Jesús Gallego Arias, Gaëtan Gilbert, Georges Gonthier, Benjamin Grégoire, Jason Gross, Hugo Herbelin, Vincent Laporte, Olivier Laurent, Assia Mahboubi, Kenji Maillard, Guillaume Melquiond, Pierre-Marie Pédrot, Clément Pit-Claudel, Pierre Roux, Kazuhiko Sakaguchi, Vincent Semeria, Michael Soegtrop, Arnaud Spiwack, Matthieu Sozeau, Enrico Tassi, Laurent Théry, Anton Trunov, Li-yao Xia and Théo Zimmermann. See the `Coq Team face book `_ page for more details. The 40 contributors to the 8.19 version are: quarkcool, Khalid Abdullah, Tanaka Akira, Isaac van Bakel, Frédéric Besson, Lasse Blaauwbroek, Ana Borges, Ali Caglayan, Nikolaos Chatzikonstantinou, Maxime Dénès, Andrej Dudenhefner, Andres Erbsen, Jim Fehrle, Gaëtan Gilbert, Jason Gross, Stefan Haan, Hugo Herbelin, Emilio Jesús Gallego Arias, Pierre Jouvelot, Ralf Jung, Jan-Oliver Kaiser, Robbert Krebbers, Jean-Christophe Léchenet, Rodolphe Lepigre, Yann Leray, Yishuai Li, Guillaume Melquiond, Guillaume Munch-Maccagnoni, Sotaro Okada, Karl Palmskog, Pierre-Marie Pédrot, Jim Portegies, Pierre Rousselin, Pierre Roux, Michael Soegtrop, David Swasey, Enrico Tassi, Shengyi Wang and Théo Zimmermann. The Coq community at large helped improve this new version via the GitHub issue and pull request system, the coq-club@inria.fr mailing list, the `Discourse forum `_ and the `Coq Zulip chat `_. Version 8.19's development spanned 4 months from the release of Coq 8.18.0 (6 months since the branch for 8.18.0). Gaëtan Gilbert and Matthieu Sozeau are the release managers of Coq 8.19. This release is the result of 285 merged PRs, closing 70 issues. | Nantes, January 2024 | Gaëtan Gilbert for the Coq development team Changes in 8.19.0 ~~~~~~~~~~~~~~~~~ .. contents:: :local: Kernel ^^^^^^ - **Added:** :ref:`sort-polymorphism` makes it possible to share common constructs over `Type` `Prop` and `SProp` (`#17836 `_, `#18331 `_, by Gaëtan Gilbert). - **Fixed:** Primitives being incorrectly considered convertible to anything by module subtyping (`#18507 `_, fixes `#18503 `_, by Gaëtan Gilbert). Specification language, type inference ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ - **Changed:** :token:`term_forall_or_fun`, :token:`term_let`, :token:`term_fix`, :token:`term_cofix` and :token:`term_if` from :token:`term` at level 200 to :token:`term10` at level 10. This is a first step towards getting rid of the recovery mechanism of camlp5/coqpp. The impact will mostly be limited to rare cases of additional parentheses around the above (`#18014 `_, by Hugo Herbelin). - **Changed:** Declarations of the form :g:`(id := body)` in :cmd:`Context` outside a section in a :cmd:`Module Type` do not any more try to declare a class instance. Assumptions whose type is a class and declared using :cmd:`Context` outside a section in a :cmd:`Module Type` are now declared as global, instead of local (`#18254 `_, by Hugo Herbelin). - **Fixed:** Anomaly in the presence of duplicate variables within a disjunctive pattern (`#17857 `_ and `#18005 `_, fixes `#17854 `_ and `#18004 `_, by Hugo Herbelin). - **Fixed:** Printing of constructors and of :g:`in` clause of :g:`match` now respects the :flag:`Printing Implicit` and :flag:`Printing All` flags (`#18176 `_, fixes `#18163 `_, by Hugo Herbelin). - **Fixed:** Wrong shift of argument names when using :cmd:`Arguments` in nested sections (`#18393 `_, fixes `#12755 `_ and `#18392 `_, by Hugo Herbelin). Notations ^^^^^^^^^ - **Changed:** More informative message when a notation cannot be intepreted as a reference (`#18104 `_, addresses `#18096 `_, by Hugo Herbelin). - **Changed:** In casts like :g:`term : t` where :g:`t` is bound to some scope :g:`t_scope`, via :cmd:`Bind Scope`, the :g:`term` is now interpreted in scope :g:`t_scope`. In particular when :g:`t` is :g:`Type` the :g:`term` is interpreted in :g:`type_scope` and when :g:`t` is a product the :g:`term` is interpreted in :g:`fun_scope` (`#6134 `_, fixes `#14959 `_, by Hugo Herbelin, reviewed by Maxime Dénès, Jim Fehrle, Emilio Gallego, Gaëtan Gilbert, Jason Gross, Pierre-Marie Pédrot, Pierre Roux, Bas Spitters and Théo Zimmermann). - **Added:** the notation :g:`term%_scope` to set a scope only temporarily (in addition to :g:`term%scope` for opening a scope applying to all subterms) (`#14928 `_, fixes `#11486 `_ and `#12157 `_ and `#14305 `_, by Hugo Herbelin, reviewed by Pierre Roux). - **Removed** the ability to declare scopes whose name starts with `_` (would be ambiguous with the new :g:`%_scope` notation) (`#14928 `_, by Pierre Roux, reviewed by Hugo Herbelin). - **Deprecated** the notation :n:`term%scope` in :cmd:`Arguments` command. In a few version, we'll make it an error and in next version give it the same semantics as in terms (i.e., deep scope opening for all subterms rather than just temporary opening) (`#14928 `_, fixes `#11486 `_ and `#12157 `_ and `#14305 `_, by Hugo Herbelin, reviewed by Pierre Roux). - **Added:** Quoted strings can be used as tokens in notations; double quotes can be used in symbols in :g:`only printing` notations; see :ref:`Basic notations ` for details (`#17123 `_, by Hugo Herbelin). - **Added:** Parsing support for notations with recursive binders involving not only variables bound by :n:`fun` or :n:`forall` but also by :n:`let` or :n:`match` (`#17856 `_, fixes `#17845 `_, by Hugo Herbelin). - **Added:** Declaring more than once the level of a notation variable is now an error (`#17988 `_, fixes `#17985 `_, by Hugo Herbelin). - **Fixed:** Various bugs and limitations to using custom binders in non-recursive and recursive notations (`#17115 `_, fixes parts of `#17094 `_, by Hugo Herbelin). - **Fixed:** An invalid case of eta-expansion in notation pretty-printer (`#17841 `_, fixes `#15221 `_, by Hugo Herbelin). - **Fixed:** :flag:`Printing Parentheses` now works also when an explicit level is set for the right-hand side of a right-open notation (`#17844 `_, fixes `#15322 `_, by Hugo Herbelin). - **Fixed:** anomaly when a notation variable denoting a binder occurs nested more than once in a recursive pattern (`#17861 `_, fixes `#17860 `_, by Hugo Herbelin). - **Fixed:** Anomaly when trying to disable a non-existent custom notation (`#17891 `_, fixes `#17782 `_, by Hugo Herbelin). - **Fixed:** appropriate error instead of anomaly in the presence of notations with constructors applied to too many arguments in pattern-matching (`#17892 `_, fixes `#17071 `_, by Hugo Herbelin). - **Fixed:** support constructors with parameters in number or string notations for patterns (`#17902 `_, fixes `#11237 `_, by Hugo Herbelin). - **Fixed:** Chains of entry coercions possibly printed in the wrong order depending on the order in which they were declared (`#18230 `_, fixes `#18223 `_, by Hugo Herbelin). Tactics ^^^^^^^ - **Changed:** `open_constr` in Ltac1 and Ltac2 does not perform evar normalization. Normalization may be recovered using `let c := open_constr:(...) in constr:(c)` if necessary for performance (`#17704 `_, by Gaëtan Gilbert). - **Changed:** :tacn:`abstract` now supports existential variables (`#17745 `_, by Gaëtan Gilbert). - **Changed:** instances declared with :flag:`Typeclasses Unique Instances` do not allow backtracking even when the goal contains evars (`#17789 `_, fixes `#6714 `_, by Jan-Oliver Kaiser). - **Changed:** In :tacn:`rewrite_strat`, the syntax for the :g:`choice` strategy has changed slightly. You may need to add parentheses around its arguments (one such case found in our continuous integration tests) (`#17832 `_, by Hugo Herbelin, Jim Fehrle and Jason Gross). - **Changed:** :tacn:`replace` with `by tac` does not automatically attempt to solve the generated equality subgoal using the hypotheses. Use `by first [assumption | symmetry;assumption | tac]` if you need the previous behaviour (`#17964 `_, fixes `#17959 `_, by Gaëtan Gilbert). - **Changed:** ``Z.euclidean_division_equations_cleanup`` now breaks up hypotheses of the form `0 <= _ < _` for better cleanup in ``zify`` (`#17984 `_, by Jason Gross). - **Changed:** :tacn:`simpl` now refolds applied constants unfolding to reducible fixpoints into the original constant even when this constant would become partially applied (`#17991 `_, by Hugo Herbelin). - **Added:** Ltac2 tactic `Std.resolve_tc` to resolve typeclass evars appearing in a given term (`#13071 `_, by Gaëtan Gilbert and Maxime Dénès). - **Added:** :tacn:`lazy`, :tacn:`simpl`, :tacn:`cbn` and :tacn:`cbv` and the associated :cmd:`Eval` and :tacn:`eval` reductions learned to do head reduction when given flag `head` (eg `Eval lazy head in (fun x => Some ((fun y => y) x)) 0` produces `Some ((fun y => y) 0)`) (`#17503 `_, by Gaëtan Gilbert; :tacn:`cbv` case added in `#18190 `_, by Hugo Herbelin). - **Fixed:** ensure that opaque primitive projections are correctly handled by "Evarconv" unification (`#17788 `_, fixes `#17774 `_, by Rodolphe Lepigre). - **Fixed:** Useless duplications with :cmd:`Hint Cut` and :cmd:`Hint Mode` (`#17887 `_, fixes `#17417 `_, by Hugo Herbelin). - **Fixed:** `zify` / `Z.euclidean_division_equations_cleanup` now no longer instantiates dependent hypotheses. This will by necessity make `Z.to_euclidean_division_equations` a bit weaker, but the previous behavior was overly sensitive to hypothesis ordering. See `#17935 `_ for a recipe to recapture the power of the previous behavior in a more robust albeit slower way (`#17935 `_, fixes `#17936 `_, by Jason Gross). - **Fixed:** :tacn:`simpl` now working on reducible named mutual fixpoints with parameters (`#17993 `_, fixes `#12521 `_ and part of `#3488 `_, by Hugo Herbelin). - **Fixed:** support for reasoning up to polymorphic universe variables in :tacn:`congruence` and :tacn:`f_equal` (`#18106 `_, fixes `#5481 `_ and `#9979 `_, by Hugo Herbelin). - **Fixed:** Only run zify saturation on existing hypotheses of the goal (`#18152 `_, fixes `#18151 `_, by Frédéric Besson and Rodolphe Lepigre). - **Fixed:** A stack overflow due to a non-tail recursive function in `lia` (`#18159 `_, fixes `#18158 `_, by Jan-Oliver Kaiser and Rodolphe Lepigre). - **Fixed:** Apply substitution in Case stack node for cbv reify (`#18195 `_, fixes `#18194 `_, by Yann Leray). - **Fixed:** Anomaly of :tacn:`simpl` on partially applied named mutual fixpoints (`#18243 `_, fixes `#18239 `_, by Hugo Herbelin). - **Changed:** :tacn:`simpl` tries to reduce named mutual fixpoints also when they return functions (`#18243 `_, by Hugo Herbelin). Ltac language ^^^^^^^^^^^^^ - **Fixed:** Fix broken "r " and "r " commands in the coqtop Ltac debugger, which also affected the Proof General Ltac debugger (`#18068 `_, fixes `#18067 `_, by Jim Fehrle). .. _819Ltac2: Ltac2 language ^^^^^^^^^^^^^^ - **Changed:** `Array.empty`, `Message.Format.stop` and `Pattern.empty_context` are not thunked (`#17534 `_, by Gaëtan Gilbert). - **Changed:** Ltac2 `exact` and `eexact` elaborate their argument using the type of the goal as expected type, instead of elaborating with no expected type then unifying the resulting type with the goal (`#18157 `_, fixes `#12827 `_, by Gaëtan Gilbert). - **Changed:** argument order for the Ltac2 combinators `List.fold_left` `List.fold_right` and `Array.fold_right` changed to be the same as in OCaml (`#18197 `_, fixes `#16485 `_, by Gaëtan Gilbert). - **Changed:** `Ltac2.Std.red_flags` added field `rStrength` to support head-only reduction (`#18273 `_, fixes `#18209 `_, by Gaëtan Gilbert). - **Added:** Ltac2 supports pattern quotations when building `pattern` values. This allows building dynamic patterns, eg `Ltac2 eq_pattern a b := pattern:($pattern:a = $pattern:b)` (`#17667 `_, by Gaëtan Gilbert). - **Added:** new standard library modules `Ltac2.Unification` and `Ltac2.TransparentState` providing access to "Evarconv" unification, including the configuration of the transparency state (`#17777 `_, by Rodolphe Lepigre). - **Added:** ``Ltac2.Constr.is_float``, ``Ltac2.Constr.is_uint63``, ``Ltac2.Constr.is_array`` (`#17894 `_, by Jason Gross). - **Added:** new Ltac2 standard library modules `Ltac2.Ref`, `Ltac2.Lazy` and `Ltac2.RedFlags` - **Added:** new Ltac2 standard library functions to `Ltac2.Control`, `Ltac2.Array`, and `Ltac2.List` (`#18095 `_, fixes `#10112 `_, by Rodolphe Lepigre). - **Added:** Support for the ``setoid_rewrite`` tactic (`#18102 `_, by quarkcool). - **Added:** :cmd:`Ltac2 Globalize` and :cmd:`Ltac2 Check` useful to investigate the expansion of Ltac2 notations (`#18139 `_, by Gaëtan Gilbert). - **Added:** A new flag :flag:`Ltac2 In Ltac1 Profiling` (unset by default) to control whether Ltac2 stack frames are included in Ltac profiles (`#18293 `_, by Rodolphe Lepigre). - **Added:** `Ltac2.Message.Format.ikfprintf` useful to implement conditional printing efficiently (i.e. without building an unused message when not printing) (`#18311 `_, fixes `#18292 `_, by Gaëtan Gilbert). - **Fixed:** Ltac2 mutable references are not considered values anymore (`#18082 `_, by Gaëtan Gilbert). Commands and options ^^^^^^^^^^^^^^^^^^^^ - **Changed:** :cmd:`Let` with :cmd:`Qed` produces an opaque side definition instead of being treated as a transparent `let` after the section is closed. The previous behaviour can be recovered using :attr:`clearbody` and :cmd:`Defined` (`#17576 `_, by Gaëtan Gilbert). - **Changed:** automatic lowering of record types to `Prop` now matches the behavior for inductives: no lowering when universe polymorphism is on, more lowering with recursive records (`#17795 `_, fixes `#17801 `_ and `#17796 `_ and `#17801 `_ and `#17805 `_, by Gaëtan Gilbert). - **Added:** :opt:`Extraction Output Directory` option for specifying the directory in which extracted files are written (`#16126 `_, fixes `#9148 `_, by Ali Caglayan). - **Added:** `-profile` command line argument and `PROFILE` variable in `coq_makefile` to control a new :ref:`profiling` system (`#17702 `_, by Gaëtan Gilbert). - **Added:** new command modifier :cmd:`Instructions` that executes the given command and displays the number of CPU instructions it took to execute it. This command is currently only supported on Linux systems, but it does not fail on other systems, where it simply shows an error message instead of the count. (`#17744 `_, by Rodolphe Lepigre). - **Added:** support for instruction counts to the `-profile` option. (`#17744 `_, by Rodolphe Lepigre). - **Added:** New command :cmd:`Attributes` to assign attributes such as :attr:`deprecated` to a library file (`#18193 `_, fixes `#8032 `_, by Hugo Herbelin). - **Fixed:** Anomaly with :cmd:`Search` in the context of a goal (`#17987 `_, fixes `#17963 `_, by Hugo Herbelin). - **Fixed:** The printer for :cmd:`Guarded` was possibly raising an anomaly in the presence of existential variables (`#18008 `_, fixes `#18006 `_, by Hugo Herbelin). Command-line tools ^^^^^^^^^^^^^^^^^^ - **Changed:** Add a `coqdep` option `-w` to adjust warnings and allow turning then into errors like the corresponding `coqc` option (`#17946 `_, fixes `#10156 `_, by David Swasey and Rodolphe Lepigre). - **Fixed:** properly delayed variable expansion when `coq_makefile` uses the combined rule for `.vo` and `.glob` targets, i.e. on GNU Make 4.4 and later. (`#18077 `_, fixes `#18076 `_, by Gaëtan Gilbert). - **Fixed:** Spurious `coqdep` warnings due to missing path normalization for plugins (`#18165 `_, by Rodolphe Lepigre). - **Fixed:** Regression in option :g:`--external` of `coqdoc`, whose two arguments were inadvertently swapped (`#18448 `_, fixes `#18434 `_, by Hugo Herbelin). .. _819Stdlib: Standard library ^^^^^^^^^^^^^^^^ - **Changed:** reimplemented `Ncring_tac` reification (used by :tacn:`nsatz`, `cring`, but not :tacn:`ring`) in Ltac instead of typeclasses (`#18325 `_, by Gaëtan Gilbert). - **Removed:** :g:`Numbers.Cyclic.ZModulo` from the standard library. This file was deprecated in 8.17 and has no known use cases. It is retained in the test suite to ensure consistency of :g:`CyclicAxioms` (`#17258 `_, by Andres Erbsen). - **Removed:** :g:`ZArith.Zdigits` in favor of :g:`Z.testbit` (`#18025 `_, by Andres Erbsen). - **Removed:** long deprecated files in `Arith`: `Div2.v`, `Even.v`, `Gt.v`, `Le.v`, `Lt.v`, `Max.v`, `Minus.v`, `Min.v`, `Mult.v`, `Plus.v`, `Arith_prebase.v` (`#18164 `_, by Pierre Rousselin). - **Deprecated:** :g:`NArith.Ndigits` and :g:`NArith.Ndist` due to disuse. For most uses of `Ndigits`, `N.testbit` and similar functions seem more desirable. If you would like to continue using these files, please consider volunteering to maintain them, within stdlib or otherwise (`#17732 `_, by Andres Erbsen). - **Deprecated:** :g:`Strings.ByteVector` in favor of :g:`Init.Byte` (`#18022 `_, by Andres Erbsen). - **Deprecated:** :g:`Numbers.NaryFunctions` due to disuse. If you are interested in continuting to use this module, please consider volunteering to maintain it, in stdlib or otherwise (`#18026 `_, by Andres Erbsen). - **Added:** Lemma `cardinal_Add_In` says that inserting an existing key with a new value doesn't change the size of a map, lemma `Add_transpose_neqkey` says that unequal keys can be inserted into a map in any order (`#12096 `_, by Isaac van Bakel and Jean-Christophe Léchenet). - **Added:** lemmas :g:`app_eq_cons`, :g:`app_inj_pivot` and :g:`rev_inj` (`#17787 `_, by Stefan Haan, with help of Olivier Laurent). - **Added:** ``unfold_nth_error``, ``nth_error_nil``, ``nth_error_cons``, ``nth_error_O``, ``nth_error_S`` to ``Coq.Lists.List`` (`#17998 `_, by Jason Gross). - **Added:** ``Reflexive``, ``Symmetric``, ``Transitive``, ``Antisymmetric``, ``Asymmetric`` instances for ``Rle``, ``Rge``, ``Rlt``, ``Rgt`` (`#18059 `_, by Jason Gross). Extraction ^^^^^^^^^^ - **Fixed:** In the error message about extraction of sort-polymorphic singleton inductive types, do not specifically refer to OCaml as other languages are also concerned (`#17889 `_, fixes `#17817 `_, by Hugo Herbelin). Changes in 8.19.1 ~~~~~~~~~~~~~~~~~ .. contents:: :local: Kernel ^^^^^^ - **Fixed:** incorrect abstraction of sort variables for opaque constants leading to an inconsistency (`#18596 `_ and `#18630 `_, fixes `#18594 `_, by Gaëtan Gilbert). - **Fixed:** memory corruption with :tacn:`vm_compute` (rare but more likely with OCaml 5.1) (`#18599 `_, by Guillaume Melquiond). Notations ^^^^^^^^^ - **Changed:** :warn:`Found no matching notation to enable or disable` is a warning instead of an error (`#18670 `_, by Pierre Roux). Tactics ^^^^^^^ - **Fixed:** undeclared universe with multiple uses of :tacn:`abstract` (`#18640 `_, fixes `#18636 `_, by Gaëtan Gilbert). Ltac2 language ^^^^^^^^^^^^^^ - **Fixed:** incorrect printing of constructor values with multiple arguments, and over-parenthesizing of constructor printing (`#18560 `_, fixes `#18556 `_, by Gaëtan Gilbert). - **Fixed:** incorrect declared type for `Ltac2.FMap.fold` (`#18649 `_, fixes `#18635 `_, by Gaëtan Gilbert). Infrastructure and dependencies ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ - **Fixed:** missing `conf-` dependencies of the opam packages: `coq-core` depends on `conf-linux-libc-dev` when compiled on linux, and `coq` depends on `conf-python-3` and `conf-time` to run the test suite (`#18565 `_, by Gaëtan Gilbert). - **Fixed:** avoid comitting symlinks to git which caused build failures on some Windows setups (`#18550 `_, fixes `#18548 `_, by Gaëtan Gilbert). Changes in 8.19.2 ~~~~~~~~~~~~~~~~~ .. contents:: :local: Specification language, type inference ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ - **Fixed:** Regression from Coq 8.18 in the presence of a defined field in a primitive :n:`Record` (`#19088 `_, fixes `#19082 `_, by Hugo Herbelin). Notations ^^^^^^^^^ - **Fixed:** Printer sometimes failing to use a prefix or infix custom notation whose right-hand side refers to a different custom entry (`#18089 `_, fixes `#18914 `_, by Hugo Herbelin). Tactics ^^^^^^^ - **Fixed:** :tacn:`abstract` failing in the presence of admitted goals in the surrounding proof (`#18945 `_, fixes `#18942 `_, by Gaëtan Gilbert). Ltac2 language ^^^^^^^^^^^^^^ - **Fixed:** anomalies when using Ltac2 in VsCoq due to incorrect state handling of Ltac2 notations (`#19096 `_, fixes `coq-community/vscoq#772 `_, by Gaëtan Gilbert) Commands and options ^^^^^^^^^^^^^^^^^^^^ - **Fixed:** anomaly when using :cmd:`Include` on a module containing a record declared with :flag:`Primitive Projections` (`#18772 `_, fixes `#18769 `_, by Jan-Oliver Kaiser) - **Fixed:** anomaly from :cmd:`Fixpoint` with no arguments (`#18741 `_, by Hugo Herbelin) CoqIDE ^^^^^^ - **Fixed:** Position error/warning tooltips correctly when multibyte UTF-8 characters are present (`#19137 `_, fixes `#19136 `_, by Jim Fehrle). Infrastructure and dependencies ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ - **Fixed:** compatibility with OCaml versions where `effect` is a keyword (`#18863 `_, by Remy Seassau) - **Added:** Coq is now compatible with `memprof-limits` interruption methods. This means that Coq will be recompiled when the library is installed / removed from an OPAM switch. (`#18906 `_, fixes `#17760 `_, by Emilio Jesus Gallego Arias). Version 8.18 ------------ Summary of changes ~~~~~~~~~~~~~~~~~~ Coq version 8.18 integrates two soundness fixes to the Coq kernel along with a host of improvements. We highlight a few impactful changes: - the default :ref:`locality <818HintLocality>` of `Hint` and :cmd:`Instance` commands was switched to :attr:`export`. - the universe unification algorithm can now delay the commitment to a sort (the algorithm used to pick `Type`). Thanks to this feature many `Prop` and `SProp` annotations can be now omitted. - Ltac2 supports array literals, maps and sets of primitive datatypes such as names (of constants, inductive types, etc) and fine-grained control over profiling. - The warning system offers new categories, enabling finer (de)activation of specific warnings. This should be particularly useful to handle deprecations. - Many new lemmas useful for teaching analysis with Coq are now part of the standard library about real numbers. - The `#[deprecated]` attribute can now be applied to definitions. The 41 contributors to the 8.18 version are: Reynald Affeldt, Tanaka Akira, Matthieu Baty, Yves Bertot, Lasse Blaauwbroek, Ana Borges, Kate Deplaix, Ali Caglayan, Cyril Cohen, Maxime Dénès, Andrej Dudenhefner, Andres Erbsen, Jim Fehrle, Yannick Forster, Paolo G. Giarrusso, Gaëtan Gilbert, Jason Gross, Samuel Gruetter, Stefan Haan, Hugo Herbelin, Yoshihiro Imai, Emilio Jesús Gallego Arias, Olivier Laurent, Meven Lennon-Bertrand, Rodolphe Lepigre, Yishuai Li, Guillaume Melquiond, Karl Palmskog, Pierre-Marie Pédrot, Stefan Radziuk, Ramkumar Ramachandra, Pierre Rousselin, Pierre Roux, Julin Shaji, Kazuhiko Sakaguchi, Weng Shiwei, Michael Soegtrop, Matthieu Sozeau, Enrico Tassi, Hao Yang, Théo Zimmermann. We are very grateful to the Coq community for their help in creating 8.18 in the 6 months since the release of Coq 8.17.0. Maxime Dénès and Enrico Tassi were the release managers. | Sophia-Antipolis, September 2023, | Enrico Tassi for the Coq development team Changes in 8.18.0 ~~~~~~~~~~~~~~~~~ .. contents:: :local: Kernel ^^^^^^ - **Changed:** the `bad-relevance` warning is now an error by default (`#17172 `_, by Pierre-Marie Pédrot). - **Fixed:** the kernel now checks that case elimination of private inductive types (cf :attr:`private(matching)`) is not used outside their defining module. Previously this was only checked in elaboration and the check could be avoided through some tactics, breaking consistency in the presence of axioms which rely on the elimination restriction to be consistent (`#17452 `_, fixes `#9608 `_, by Gaëtan Gilbert). - **Fixed:** a bug enabling :tacn:`native_compute` to yield arbitrary floating-point values (`#17872 `_, fixes `#17871 `_, by Guillaume Melquiond and Pierre Roux, bug found by Jason Gross). Specification language, type inference ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ - **Changed:** enhance the universe unification algorithm, which is now able to delay the definition of a sort. This allows omitting some explicit `Prop` and `SProp` annotations when writing terms. Some minor backwards compatibility issues can arise in rare cases, which can be solved with more explicit sort annotations (`#16903 `_, by Pierre-Marie Pédrot). - **Changed:** match compilation for primitive record avoids producing an encoding overhead for matches that are equivalent to a primitive projection (`#17008 `_, by Gaëtan Gilbert). - **Added:** volatile casts :n:`@term :> @type` which do not leave a trace in the elaborated term. They are used by :flag:`Printing Match All Subterms` to display otherwise hidden subterms of match constructs (`#16992 `_, fixes `#16918 `_, by Gaëtan Gilbert). - **Added:** when printing uninterpreted terms (for instance through :cmd:`Print Ltac` on `Ltac foo := exact some_term`), extensions to the term language (for instance :ref:`tactics-in-terms`) are now printed correctly instead of as holes (`_`) (`#17221 `_, by Gaëtan Gilbert). - **Added:** Support for the :attr:`local`, :attr:`global` and :attr:`export` locality attributes for the single "field" of :ref:`definitional typeclasses ` when using the ``:>`` and ``::`` syntaxes for coercion and substructures (`#17754 `_, fixes `#17451 `_, by Pierre Roux). - **Added:** a hook in the coercion mechanism to enable programming coercions in external metalanguages such as Ltac, Ltac2, Elpi or OCaml plugins (`#17794 `_, by Pierre Roux). - **Fixed:** canonical instance matching `match` terms (`#17206 `_, fixes `#17079 `_, by Gaëtan Gilbert). - **Fixed:** universe constraint inference in module subtyping can trigger constant unfoldings (`#17305 `_, fixes `#17303 `_, by Gaëtan Gilbert). Notations ^^^^^^^^^ - **Removed:** The `\'[=\'` keyword. `\'[=\'` tokens in notation definitions should be replaced with the pair of tokens `\'[\' \'=\'`. If compatibility with Coq < 8.18 is needed, replace `[=` in uses of the notation with an added space (`[ =`) (`#16788 `_, fixes `#16785 `_, by Pierre Roux). - **Added:** Support for :flag:`Printing Parentheses` in custom notations (`#17117 `_, by Hugo Herbelin). - **Added:** Improve printing of reverse coercions. When a term :g:`x` is elaborated to :g:`x'` through a reverse coercion, return the term :g:`reverse_coercion x' x` that is convertible to :g:`x'` but displayed :g:`x` thanks to the coercion :g:`reverse_coercion` (`#17484 `_, by Pierre Roux). - **Fixed:** Add support to parse a recursive pattern as a sequence of terms in a recursive notation even when this recursive pattern is used in position of binders; it was formerly raising an anomaly (`#16937 `_, fixes `#12467 `_, by Hugo Herbelin). - **Fixed:** Improved ability to print notations involving anonymous binders (`#17050 `_, by Hugo Herbelin). - **Fixed:** anomaly with notations abbreviating a local variable or record field name (`#17217 `_, fixes `#14975 `_, by Hugo Herbelin). - **Fixed:** Ensure in all cases that a parsing rule is declared when the :n:`only parsing` flag is given (`#17318 `_, fixes `#17316 `_, by Hugo Herbelin). - **Fixed:** In :cmd:`Number Notation`, "abstract after N" was applied when number >= N. Now it is applied when number > N (`#17478 `_, by Jim Fehrle). Tactics ^^^^^^^ - **Changed:** in the fringe case where the ``with`` clause of a call to :tacn:`specialize` depends on a variable bound in the type, the tactic will now fail instead of silently producing a shelved evar (`#17322 `_, by Pierre-Marie Pédrot). - **Changed:** extensions to the term syntax through generic arguments (typically `ltac:()`, `ltac2:()` or ltac2's `$`) produce errors when used in term patterns (for instance patterns used to filter hints) instead of being treated as holes (`_`) (`#17352 `_, by Gaëtan Gilbert). - **Changed:** the :tacn:`case` tactic and its variants always generate a pattern-matching node, regardless of their argument. In particular, they are now guaranteed to generate as many goals as there are constructors in the inductive type. Previously, they used to reduce to the corresponding branch when the argument βι-normalized to a constructor, resulting in a single goal (`#17541 `_, by Pierre-Marie Pédrot). - **Changed:** :tacn:`injection` continues working using sigma types when `Eqdep_dec` has not been required even if an equality scheme was found, instead of failing (`#17670 `_, by Gaëtan Gilbert). - **Changed:** the unification heuristics for implicit arguments of the :tacn:`case` tactic. We unconditionally recommend using :tacn:`destruct` instead, and even more so in case of incompatibility (`#17564 `_, by Pierre-Marie Pédrot). - **Removed:** the no-argument form of the :tacn:`instantiate` tactic, deprecated since 8.16 (`#16910 `_, by Pierre-Marie Pédrot). - **Removed:** undocumented tactics `hresolve_core` and `hget_evar` (`#17035 `_, by Gaëtan Gilbert). - **Deprecated:** the `elimtype` and `casetype` tactics (`#16904 `_, by Pierre-Marie Pédrot). - **Deprecated:** `revert dependent`, which is a misleadingly named alias of :tacn:`generalize dependent` (`#17669 `_, by Gaëtan Gilbert). - **Fixed:** The :tacn:`simpl` tactic now respects the :n:`simpl never` flag even when the subject function is referred to through another definition (`#13448 `_, fixes `#13428 `_, by Yves Bertot). - **Fixed:** unification is less sensitive to whether a subterm is an indirection through a defined existential variable or a direct term node. This results in less constant unfoldings in rare cases (`#16960 `_, by Gaëtan Gilbert). - **Fixed:** untypable proof states generated by setoid_rewrite, which may cause some backwards-incompatibilities (`#17304 `_, fixes `#17295 `_, by Lasse Blaauwbroek). - **Fixed:** intropatterns destructing a term whose type is a product cannot silently create shelved evars anymore. Instead, it fails with an unsolvable variable. This can be fixed in a backwards compatible way by using the e-variant of the parent tactic (`#17564 `_, by Pierre-Marie Pédrot). - **Fixed:** the :tacn:`field_simplify` tactic, so that it no longer introduces side-conditions when working on a hypothesis (`#17591 `_, by Guillaume Melquiond). - **Fixed:** the :tacn:`tauto` tactic and its variants now try to match types up to universe unification. This makes them compatible with universe-polymorphic code (`#8905 `_, fixes `#4721 `_ and `#5351 `_, by Pierre-Marie Pédrot). Ltac2 language ^^^^^^^^^^^^^^ - **Added:** Support for parsing Ltac2 array literals ``[| ... |]`` (`#16859 `_, fixes `#13976 `_, by Samuel Gruetter). - **Added:** Finite set and map APIs for identifier, string, int, constant, inductive and constructor keys (`#17347 `_, c.f. `#16409 `_, by Gaëtan Gilbert). - **Added:** Ltac2 preterm antiquotation `$preterm:` (`#17359 `_, fixes `#13977 `_, by Gaëtan Gilbert). - **Added:** :flag:`Ltac Profiling` also profiles Ltac2 tactics. Ltac2 also provides tactics `start_profiling` `stop_profiling` and `show_profile` for finer grained control (`#17371 `_, fixes `#10111 `_, by Gaëtan Gilbert). - **Added:** primitives to build and compare values in `Ltac2.Init.cast` (`#17468 `_, by Gaëtan Gilbert). - **Added:** It is possible to define 0-argument externals (`#17475 `_, by Gaëtan Gilbert). - **Added:** Ltac2 quotations :ref:`ltac2val:(ltac2 tactic) ` in Ltac1 which produce Ltac1 values (as opposed to `ltac2:()` quotations which are only useful for their side effects) (`#17575 `_, by Gaëtan Gilbert). - **Fixed:** nested notations involving :ref:`term-antiquotations` (`#17232 `_, fixes `#15864 `_, by Gaëtan Gilbert). - **Fixed:** Parsing level of :g:`by` clause of Ltac2's :g:`assert` (`#17508 `_, fixes `#17491 `_, by Samuel Gruetter). - **Fixed:** `multi_match!`, `multi_match! goal` and the underlying `Ltac2.Pattern.multi_match0` and `Ltac2.Pattern.multi_goal_match0` now preserve exceptions from backtracking after a branch succeeded instead of replacing them with `Match_failure` (e.g. `multi_match! constr:(tt) with tt => () end; Control.zero Not_found` now fails with `Not_found` instead of `Match_failure`) (`#17597 `_, fixes `#17594 `_, by Gaëtan Gilbert). Commands and options ^^^^^^^^^^^^^^^^^^^^ .. _818HintLocality: - **Changed:** the default locality of `Hint` and :cmd:`Instance` commands was switched to :attr:`export` (`#16258 `_, by Pierre-Marie Pédrot). - **Changed:** warning `non-primitive-record` is now in category `records` instead of `record`. This was the only use of `record` but the plural version is also used by `cannot-define-projection` `future-coercion-class-constructor` and `future-coercion-class-field`. (`#16989 `_, by Gaëtan Gilbert). - **Changed:** :cmd:`Eval` prints information about existential variables like :cmd:`Check` (`#17274 `_, by Gaëtan Gilbert). - **Changed:** The names of deprecation warnings now depend on the version in which they were introduced, using their "since" field. This enables deprecation warnings to be selectively enabled, disabled, or treated as an error, according to the version number provided in the :attr:`deprecated` attribute (`#17489 `_, fixes `#16287 `_, by Pierre Roux, reviewed by Ali Caglayan, Théo Zimmermann and Gaëtan Gilbert). - **Changed:** warnings can now have multiple categories allowing for finer user control on which warning to enable, disable or treat as an error (`#17585 `_, by Gaëtan Gilbert). - **Changed:** :attr:`Template polymorphic ` inductive types are not implicitly added to the :table:`Keep Equalities` table anymore when defined. This may change the behavior of equality-related tactics on such types (`#17718 `_, by Pierre-Marie Pédrot). - **Changed:** :opt:`Warnings` and :attr:`warnings` now emit a warning when trying to enable an unknown warning (there is still no warning when disabling an unknown warning as this behavior is useful for compatibility, or when enabling an unknown warning through the command line `-w` as the warning may be in a yet to be loaded plugin) (`#17747 `_, by Gaëtan Gilbert). - **Removed:** the flag `Apply With Renaming` which was deprecated since 8.15 (`#16909 `_, by Pierre-Marie Pédrot). - **Removed:** the `Typeclasses Filtered Unification` flag, deprecated since 8.16 (`#16911 `_, by Pierre-Marie Pédrot). - **Removed:** :attr:`program` attribute is not accepted anymore with commands :cmd:`Add Relation`, :cmd:`Add Parametric Relation`, :cmd:`Add Setoid`, :cmd:`Add Parametric Setoid`, :cmd:`Add Morphism`, :cmd:`Add Parametric Morphism`, :cmd:`Declare Morphism`. Previously, it was accepted but ignored (`#17042 `_, by Théo Zimmermann). - **Removed:** the `Elaboration StrictProp Cumulativity` and `Cumulative SProp` flags. These flags became counterproductive after the introduction of sort variables in unification (`#17114 `_, fixes `#17108 `_, by Pierre-Marie Pédrot). - **Removed:** The ``Add LoadPath``, ``Add Rec LoadPath``, ``Add ML Path``, and ``Remove LoadPath`` commands have been removed following deprecation. Users are encouraged to use the existing mechanisms in ``coq_makefile`` or ``dune`` to configure workspaces of Coq theories (`#17394 `_, by Emilio Jesus Gallego Arias). - **Deprecated:** `Export` modifier for :cmd:`Set`. Use attribute :attr:`export` instead (`#17333 `_, by Gaëtan Gilbert). - **Deprecated:** the :attr:`nonuniform` attribute, now subsumed by :attr:`warnings` with "-uniform-inheritance" (`#17716 `_, by Pierre Roux). - **Deprecated:** Using :cmd:`Qed` with :cmd:`Let`. End the proof with :cmd:`Defined` and use :attr:`clearbody` instead to get the same behavior (`#17544 `_, by Gaëtan Gilbert). - **Added:** :cmd:`About` now prints information when a constant or inductive is syntactically equal to another through module aliasing (`#16796 `_, by Gaëtan Gilbert). - **Added:** :cmd:`Final Obligation` command (`#16817 `_, by Gaëtan Gilbert). - **Added:** The :attr:`deprecated` attribute is now supported for definition-like constructions (`#16890 `_, fixes `#12266 `_, by Maxime Dénès and Gaëtan Gilbert). - **Added:** attributes :attr:`warnings` and alias :attr:`warning` to set warnings locally for a command (`#16902 `_, fixes `#15893 `_, by Gaëtan Gilbert). - **Added:** flag :flag:`Printing Unfolded Projection As Match` (off by default) to be able to distinguish unfolded and folded primitive projections (`#16994 `_, by Gaëtan Gilbert). - **Added:** option `-time-file`, like `time` but outputting to a file (`#17430 `_, by Gaëtan Gilbert). - **Added:** :cmd:`Validate Proof` runs the type checker on the current proof, complementary with :cmd:`Guarded` which runs the guard checker (`#17467 `_, by Gaëtan Gilbert). - **Added:** :attr:`clearbody` for :cmd:`Let` to clear the body of a let-in in an interactive proof without kernel enforcement. (This is the behavior that was previously provided by using :cmd:`Qed`, which is now deprecated for `Let`\s.) (`#17544 `_, by Gaëtan Gilbert). - **Added:** option `-time-file`, like `time` but outputting to a file (`#17430 `_, by Gaëtan Gilbert). - **Fixed:** universe monomorphic inductives and records do not ignore :flag:`Universe Minimization ToSet` (`#17285 `_, fixes `#13927 `_, by Gaëtan Gilbert). Command-line tools ^^^^^^^^^^^^^^^^^^ - **Changed:** Do not pass the ``-rectypes`` flag by default in ``coq_makefile`` when compiling OCaml code, since it is no longer required by Coq. To re-enable passing the flag, put ``CAMLFLAGS+=-rectypes`` in the local makefile, e.g., ``CoqMakefile.local`` (see :ref:`coqmakefilelocal`) (`#17038 `_, by Karl Palmskog with help from Gaëtan Gilbert). - **Changed:** disable inclusion of variable binders in coqdoc indexes by default, and provide a new coqdoc option `--binder-index` for including them (`#17045 `_, fixes `#13155 `_, by Karl Palmskog). - **Added:** `coqdoc` handles multiple links to the same source. For example when declaring an inductive type `t` all occurences of `t` itself and its elimination principles like `t_ind` point to its declaration (`#17118 `_, by Enrico Tassi). - **Added:** Command line options :n:`-require lib` (replacing :n:`-load-vernac-object lib`) and :n:`-require-from root lib` respectively equivalent to vernacular commands :n:`Require lib` and :n:`From root Require lib` (`#17364 `_, by Hugo Herbelin). - **Added:** `coqtimelog2html` command-line tool used to render the timing files produced with `-time` (which is passed by `coq_makefile` when environment variable `TIMING` is defined) (`#17411 `_, by Gaëtan Gilbert). - **Fixed:** `coq_makefile` avoids generating a command containing all files to install in a make rule, which could surpass the maximum single argument size in some developments (`#17697 `_, fixes `#17721 `_, by Gaëtan Gilbert). CoqIDE ^^^^^^ - **Changed:** XML Protocol now sends (and expects) full Coq locations, including line and column information. This makes some IDE operations (such as UTF-8 decoding) more efficient. Clients of the XML protocol can just ignore the new fields if they are not useful for them (`#17382 `_, fixes `#17023 `_, by Emilio Jesus Gallego Arias). Standard library ^^^^^^^^^^^^^^^^ - **Changed:** implementation of :g:`Vector.nth` to follow OCaml and compute strict subterms (`#16731 `_, fixes `#16738 `_, by Andrej Dudenhefner). - **Changed:** drop the unnecessary second assumption :g:`NoDup l'` from :g:`set_diff_nodup` in ``ListSet.v``, with `-compat 8.17` providing the old version of :g:`set_diff_nodup` for compatibility (`#16926 `_, by Karl Palmskog with help from Traian Florin Şerbănuţă and Andres Erbsen). - **Changed:** Moved instances from :g:`DecidableClass` to files that prove the relevant decidability facts: :g:`Bool`, :g:`PeanoNat`, and :g:`BinInt` (`#17021 `_, by Andres Erbsen). - **Changed:** `Hint Extern` `btauto.Algebra.bool` locality from :attr:`global` to :attr:`export` (`#17281 `_, by Andres Erbsen). - **Changed:** :g:`xorb` to a simpler definition (`#17427 `_, by Guillaume Melquiond). - **Changed** lemmas in `Reals/RIneq.v` - :g:`completeness_weak` renamed as :g:`upper_bound_thm`, - :g:`le_epsilon` renamed as :g:`Rle_epsilon`, - :g:`Rplus_eq_R0` renamed as :g:`Rplus_eq_0`, - :g:`Req_EM_T` renamed as :g:`Req_dec_T`, - :g:`Rinv_r_simpl_m` renamed as :g:`Rmult_inv_r_id_m`, - :g:`Rinv_r_simpl_l` renamed as :g:`Rmult_inv_r_id_l`, - :g:`Rinv_r_simpl_r` renamed as :g:`Rmult_inv_m_id_r`, - :g:`tech_Rgt_minus` renamed as :g:`Rgt_minus_pos`, - :g:`tech_Rplus` renamed as :g:`Rplus_le_lt_0_neq_0`, - :g:`IZR_POS_xI` modified with `2` instead of `1 + 1`, - :g:`IZR_POS_xO` modified with `2` instead of `1 + 1`, - :g:`Rge_refl` modified with `>=` instead of `<=` (`#17036 `_, by Pierre Rousselin, reviewer Laurent Théry). - **Removed:** :g:`Datatypes.prod_curry`, :g:`Datatypes.prod_uncurry`, :g:`Datatypes.prodT_curry`, :g:`Datatypes.prodT_uncurry`, :g:`Combinators.prod_curry_uncurry`, :g:`Combinators.prod_uncurry_curry`, :g:`Bool.leb`, :g:`Bool.leb_implb`, :g:`List.skipn_none`, :g:`Zdiv.Z_div_mod_eq`, :g:`Zdiv.div_Zdiv`, :g:`Zdiv.mod_Zmod`, :g:`FloatOps.frexp`, :g:`FloatOps.ldexp`, :g:`FloatLemmas.frexp_spec`, :g:`FloatLemmas.ldexp_spec`, :g:`RList.Rlist`, :g:`Rlist.cons`, :g:`Rlist.nil`, :g:`RList.Rlength`, :g:`Rtrigo_calc.cos3PI4`, :g:`Rtrigo_calc.sin3PI4`, :g:`MSetRBT.filter_app` after deprecation for at least two Coq versions (`#16920 `_, by Olivier Laurent). - **Deprecated:** :g:`List.app_nil_end`, :g:`List.app_assoc_reverse`, :g:`List.ass_app`, :g:`List.app_ass` (`#16920 `_, by Olivier Laurent). - **Deprecated:** `Coq.Lists.List.Forall2_refl` (`Coq.Lists.List.Forall2_nil` has the same type) (`#17646 `_, by Gaëtan Gilbert). - **Deprecated:** :g:`ZArith.Zdigits` in favor of :g:`Z.testbit`. If you are aware of a use case of this module and would be interested in a drop-in replacement, please comment on the PR with information about the context that would benefit from such functinality (`#17733 `_, by Andres Erbsen). - **Deprecated:** Deprecation warnings are now generated for :g:`Numbers.Cyclic.Int31.Cyclic31`, :g:`NNumbers.Cyclic.Int31.Int31`, and :g:`NNumbers.Cyclic.Int31.Ring31`. These modules have been deprecated since Coq 8.10. The modules under :g:`Numbers.Cyclic.Int63` remain available (`#17734 `_, by Andres Erbsen). - **Deprecated** lemmas in `Reals/RIneq.v` :g:`inser_trans_R`, :g:`IZR_neq`, :g:`double`, :g:`double_var`, :g:`Rinv_mult_simpl`, :g:`Rle_Rinv`, :g:`Rlt_Rminus`, :g:`Rminus_eq_0`, :g:`Rminus_gt_0_lt`, :g:`Ropp_div`, :g:`Ropp_minus_distr'`, :g:`Rplus_sqr_eq_0_l`, :g:`sum_inequa_Rle_lt_depr`, :g:`S_O_plus_INR_depr`, :g:`single_z_r_R1_depr`, :g:`tech_single_z_r_R1_depr`, (`#17036 `_, by Pierre Rousselin, reviewer Laurent Théry). - **Added:** lemmas :g:`L_inj`, :g:`R_inj`, :g:`L_R_neq`, :g:`case_L_R`, :g:`case_L_R'` to ``Fin.v``, and :g:`nil_spec`, :g:`nth_append_L`, :g:`nth_append_R`, :g:`In_nth`, :g:`nth_replace_eq`, :g:`nth_replace_neq`, :g:`replace_append_L`, :g:`replace_append_R`, :g:`append_const`, :g:`map_append`, :g:`map2_ext`, :g:`append_inj`, :g:`In_cons_iff`, :g:`Forall_cons_iff`, :g:`Forall_map`, :g:`Forall_append`, :g:`Forall_nth`, :g:`Forall2_nth`, :g:`Forall2_append`, :g:`map_shiftin`, :g:`fold_right_shiftin`, :g:`In_shiftin`, :g:`Forall_shiftin`, :g:`rev_nil`, :g:`rev_cons`, :g:`rev_shiftin`, :g:`rev_rev`, :g:`map_rev`, :g:`fold_left_rev_right`, :g:`In_rev`, :g:`Forall_rev` to ``VectorSpec.v`` (`#16765 `_, closes `#6459 `_, by Andrej Dudenhefner). - **Added:** lemmas :g:`iter_swap_gen`, :g:`iter_swap`, :g:`iter_succ`, :g:`iter_succ_r`, :g:`iter_add`, :g:`iter_ind`, :g:`iter_rect`, :g:`iter_invariant` for `Nat.iter` (`#17013 `_, by Stefan Haan with help from Jason Gross). - **Added:** module :g:`Zbitwise` with basic relationships between bitwise and arithmetic operations on integers (`#17022 `_, by Andres Erbsen). - **Added:** lemmas :g:`forallb_filter`, :g:`forallb_filter_id`, :g:`partition_as_filter`, :g:`filter_length`, :g:`filter_length_le` and :g:`filter_length_forallb` (`#17027 `_, by Stefan Haan with help from Olivier Laurent and Andres Erbsen). - **Added:** lemmas in `Reals/RIneq.v`: :g:`eq_IZR_contrapositive`, :g:`INR_0`, :g:`INR_1`, :g:`INR_archimed`, :g:`INR_unbounded`, :g:`IPR_2_xH`, :g:`IPR_2_xI`, :g:`IPR_2_xO`, :g:`IPR_eq`, :g:`IPR_ge_1`, :g:`IPR_gt_0`, :g:`IPR_IPR_2`, :g:`IPR_le`, :g:`IPR_lt`, :g:`IPR_not_1`, :g:`IPR_xH`, :g:`IPR_xI`, :g:`IPR_xO`, :g:`le_IPR`, :g:`lt_1_IPR`, :g:`lt_IPR`, :g:`minus_IPR`, :g:`mult_IPR`, :g:`not_1_IPR`, :g:`not_IPR`, :g:`plus_IPR`, :g:`pow_IPR`, :g:`Rdiv_0_l`, :g:`Rdiv_0_r`, :g:`Rdiv_1_l`, :g:`Rdiv_1_r`, :g:`Rdiv_def`, :g:`Rdiv_diag_eq`, :g:`Rdiv_diag`, :g:`Rdiv_diag_uniq`, :g:`Rdiv_eq_compat_l`, :g:`Rdiv_eq_compat_r`, :g:`Rdiv_eq_reg_l`, :g:`Rdiv_eq_reg_r`, :g:`Rdiv_mult_distr`, :g:`Rdiv_mult_l_l`, :g:`Rdiv_mult_l_r`, :g:`Rdiv_mult_r_l`, :g:`Rdiv_mult_r_r`, :g:`Rdiv_neg_neg`, :g:`Rdiv_neg_pos`, :g:`Rdiv_opp_l`, :g:`Rdiv_pos_cases`, :g:`Rdiv_pos_neg`, :g:`Rdiv_pos_pos`, :g:`Rexists_between`, :g:`Rge_gt_or_eq_dec`, :g:`Rge_gt_or_eq`, :g:`Rge_lt_dec`, :g:`Rge_lt_dec`, :g:`Rgt_le_dec`, :g:`Rgt_minus_pos`, :g:`Rgt_or_le`, :g:`Rgt_or_not_gt`, :g:`Rinv_0_lt_contravar`, :g:`Rinv_eq_compat`, :g:`Rinv_eq_reg`, :g:`Rinv_lt_0_contravar`, :g:`Rinv_neg`, :g:`Rinv_pos`, :g:`Rle_gt_dec`, :g:`Rle_half_plus`, :g:`Rle_lt_or_eq`, :g:`Rle_or_gt`, :g:`Rle_or_not_le`, :g:`Rlt_0_2`, :g:`Rlt_0_minus`, :g:`Rlt_ge_dec`, :g:`Rlt_half_plus`, :g:`Rlt_minus_0`, :g:`Rlt_or_ge`, :g:`Rlt_or_not_lt`, :g:`Rminus_def`, :g:`Rminus_diag`, :g:`Rminus_eq_compat_l`, :g:`Rminus_eq_compat_r`, :g:`Rminus_plus_distr`, :g:`Rminus_plus_l_l`, :g:`Rminus_plus_l_r`, :g:`Rminus_plus_r_l`, :g:`Rminus_plus_r_r`, :g:`Rmult_div_assoc`, :g:`Rmult_div_l`, :g:`Rmult_div_r`, :g:`Rmult_div_swap`, :g:`Rmult_gt_reg_r`, :g:`Rmult_inv_l`, :g:`Rmult_inv_m_id_r`, :g:`Rmult_inv_r`, :g:`Rmult_inv_r_id_l`, :g:`Rmult_inv_r_id_m`, :g:`Rmult_inv_r_uniq`, :g:`Rmult_neg_cases`, :g:`Rmult_neg_neg`, :g:`Rmult_neg_pos`, :g:`Rmult_pos_cases`, :g:`Rmult_pos_neg`, :g:`Rmult_pos_pos`, :g:`Ropp_div_distr_l`, :g:`Ropp_eq_reg`, :g:`Ropp_neg`, :g:`Ropp_pos`, :g:`Rplus_0_l_uniq`, :g:`Rplus_eq_0`, :g:`Rplus_ge_reg_r`, :g:`Rplus_gt_reg_r`, :g:`Rplus_minus_assoc`, :g:`Rplus_minus_l`, :g:`Rplus_minus_r`, :g:`Rplus_minus_swap`, :g:`Rplus_neg_lt`, :g:`Rplus_neg_neg`, :g:`Rplus_neg_npos`, :g:`Rplus_nneg_ge`, :g:`Rplus_nneg_nneg`, :g:`Rplus_nneg_pos`, :g:`Rplus_npos_le`, :g:`Rplus_npos_neg`, :g:`Rplus_npos_npos`, :g:`Rplus_pos_gt`, :g:`Rplus_pos_nneg`, :g:`Rplus_pos_pos`, :g:`Rsqr_def` lemmas in `Reals/R_Ifp.v`: :g:`Int_part_spec`, :g:`Rplus_Int_part_frac_part`, :g:`Int_part_frac_part_spec` (`#17036 `_, by Pierre Rousselin, reviewer Laurent Théry). - **Added:** lemmas :g:`concat_length`, :g:`flat_map_length`, :g:`flat_map_constant_length`, :g:`list_power_length` to `Lists.List` (`#17082 `_, by Stefan Haan with help from Olivier Laurent). Infrastructure and dependencies ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ - **Changed:** Sphinx 4.5.0 or above is now required to build the reference manual, so now / can be used as a quick search shortcut and Esc as a shortcut to remove search highlighting (`#17772 `_, fixes `#15778 `_, by Ana Borges). Extraction ^^^^^^^^^^ - **Fixed:** Anomaly when extracting within a module or module type (`#17344 `_, fixes `#10739 `_, by Hugo Herbelin). Version 8.17 ------------ Summary of changes ~~~~~~~~~~~~~~~~~~ Coq version 8.17 integrates a soundness fix to the Coq kernel along with a few new features and a host of improvements to the Ltac2 language and libraries. We highlight some of the most impactful changes here: - :ref:`Fixed <817VmCompute>` a logical inconsistency due to :tacn:`vm_compute` in presence of side-effects in the enviroment (e.g. using `Back` or `Fail`). - It is now possible to dynamically :ref:`enable or disable <817Notations>` notations. - Support :ref:`multiple scopes <817Scopes>` in :cmd:`Arguments` and :cmd:`Bind Scope`. - The tactics chapter of the manual has :ref:`many improvements <817TacticsRefman>` in presentation and wording. The documented grammar is semi-automatically checked for consistency with the implementation. - :ref:`Fixes <817Eauto>` to the :tacn:`auto` and :tacn:`eauto` tactics, to respect hint priorities and the documented use of :tacn:`simple apply`. This is a potentially breaking change. - :ref:`New Ltac2 <817Ltac2>` APIs, deep pattern-matching with ``as`` clauses and handling of literals, support for record types and preterms. - :ref:`Move <817ClassFieldSyntax>` from :g:`:>` to :g:`::` syntax for declaring typeclass fields as instances, fixing a confusion with declaration of coercions. - :ref:`Standard library <817Stdlib>` improvements. - While Coq supports OCaml 5, users are likely to experience slowdowns ranging from +10% to +50% compared to OCaml 4. Moreover, the :tacn:`native_compute` machinery is not available when Coq is compiled with OCaml 5. Therefore, OCaml 5 support should still be considered experimental and not production-ready. See the `Changes in 8.17.0`_ section below for the detailed list of changes, including potentially breaking changes marked with **Changed**. Coq's `reference manual for 8.17 `_, `documentation of the 8.17 standard library `_ and `developer documentation of the 8.17 ML API `_ are also available. Ali Caglayan, Emilio Jesús Gallego Arias, Gaëtan Gilbert 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 `_ that are used in many Coq projects for continuous integration. Maxime Dénès, Paolo G. Giarrusso, Huỳnh Trần Khanh, and Laurent Théry have maintained the VsCoq extension for VS Code. The opam repository for Coq packages has been maintained by 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/. The `Coq Platform `_ has been maintained by Michael Soegtrop, with help from Karl Palmskog, Pierre Roux, Enrico Tassi and Théo Zimmermann. Our current maintainers are Yves Bertot, Frédéric Besson, Ana Borges, Ali Caglayan, Tej Chajed, Cyril Cohen, Pierre Corbineau, Pierre Courtieu, Maxime Dénès, Andres Erbsen, Jim Fehrle, Julien Forest, Emilio Jesús Gallego Arias, Gaëtan Gilbert, Georges Gonthier, Benjamin Grégoire, Jason Gross, Hugo Herbelin, Vincent Laporte, Olivier Laurent, Assia Mahboubi, Kenji Maillard, Guillaume Melquiond, Pierre-Marie Pédrot, Clément Pit-Claudel, Pierre Roux, Kazuhiko Sakaguchi, Vincent Semeria, Michael Soegtrop, Arnaud Spiwack, Matthieu Sozeau, Enrico Tassi, Laurent Théry, Anton Trunov, Li-yao Xia and Théo Zimmermann. See the `Coq Team face book `_ page for more details. The 45 contributors to the 8.17 version are: Reynald Affeldt, Tanaka Akira, Lasse Blaauwbroek, Stephan Boyer, Ali Caglayan, Cyril Cohen, Maxime Dénès, Andrej Dudenhefner, Andres Erbsen, František Farka, Jim Fehrle, Paolo G. Giarrusso, Gaëtan Gilbert, Jason Gross, Alban Gruin, Stefan Haan, Hugo Herbelin, Wolf Honore, Bodo Igler, Jerry James, Emilio Jesús Gallego Arias, Ralf Jung, Jan-Oliver Kaiser, Wojciech Karpiel, Chantal Keller, Thomas Klausner, Olivier Laurent, Yishuai Li, Guillaume Melquiond, Karl Palmskog, Sudha Parimala, Pierre-Marie Pédrot, Valentin Robert, Pierre Roux, Julin S, Dmitry Shachnev, Michael Soegtrop, Matthieu Sozeau, Naveen Srinivasan, Sergei Stepanenko, Karolina Surma, Enrico Tassi, Li-yao Xia and Théo Zimmermann. The Coq community at large helped improve this new version via the GitHub issue and pull request system, the coq-club@inria.fr mailing list, the `Discourse forum `_ and the `Coq Zulip chat `_. Version 8.17's development spanned 5 months from the release of Coq 8.16.0. Théo Zimmermann is the release manager of Coq 8.17. This release is the result of 414 merged PRs, closing 105 issues. | Nantes, February 2023, | Matthieu Sozeau for the Coq development team Changes in 8.17.0 ~~~~~~~~~~~~~~~~~ .. contents:: :local: Kernel ^^^^^^ .. _817VmCompute: - **Fixed:** inconsistency linked to :tacn:`vm_compute`. The fix removes a vulnerable cache, thus it may result in slowdowns when :tacn:`vm_compute` is used repeatedly, if you encounter such slowdowns please report your use case (`#16958 `_, fixes `#16957 `_, by Gaëtan Gilbert). - **Fixed:** Unexpected anomaly when checking termination of fixpoints containing :g:`match` expressions with inaccessible branches (`#17116 `_, fixes `#17073 `_, by Hugo Herbelin). Specification language, type inference ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ - **Changed:** :warn:`Unused variable ` warning triggers even when catching a single case. This warning used to be triggered only when the unused variable was catching at least two cases (`#16135 `_, by Pierre Roux). - **Fixed:** Pattern-matching clauses were possibly lost when matching over a constructor from a singleton inductive type in the presence of implicit coercions (`#17138 `_, fixes `#17137 `_, by Hugo Herbelin). - **Fixed:** Possible anomaly when using syntax :g:`term.(proj)` with projections defined in sections (`#17174 `_, fixes `#17173 `_, by Hugo Herbelin). Notations ^^^^^^^^^ - **Changed:** When multiple tokens match the beginning of a sequence of characters, the longest matching token not cutting a subsequence of contiguous letters in the middle is used. Previously, this was only the longest matching token. See :ref:`lexical conventions ` for details and examples (`#16322 `_, fixes `#4712 `_, by Hugo Herbelin). .. _817Notations: - **Added:** :cmd:`Enable Notation` and :cmd:`Disable Notation` commands to enable or disable previously defined notations (`#12324 `_ and `#16945 `_, by Hugo Herbelin and Pierre Roux, extending previous work by Lionel Rieg, review by Jim Fehrle). .. _817Scopes: - **Added:** Support for multiple scopes in the :cmd:`Arguments` command (`#16472 `_, by Pierre Roux, review by Jim Fehrle, Hugo Herbelin and Enrico Tassi). - **Added:** Attributes :attr:`add_top` and :attr:`add_bottom` to bind multiple scopes through the :cmd:`Bind Scope` command (`#16472 `_, by Pierre Roux, review by Jim Fehrle, Hugo Herbelin and Enrico Tassi). Tactics ^^^^^^^ .. _817TacticsRefman: - **Changed:** Documentation in the tactics chapter to give the current correct syntax, consolidate tactic variants for each tactic into a single, unified description for each tactic and many wording improvements. With this change, following similar changes to other chapters in previous releases, the correctness of documented syntax is assured by semi-automated tooling in all chapters except SSReflect (`#15015 `_, `#16498 `_, and `#16659 `_, by Jim Fehrle, reviewed by Théo Zimmermann, with help from many others). .. _817Eauto: - **Changed:** :tacn:`eauto` respects priorities of :cmd:`Extern ` hints (`#16289 `_, fixes `#5163 `_ and `#16282 `_, by Andrej Dudenhefner). .. warning:: Code that relies on eager evaluation of :cmd:`Extern ` hints with high assigned cost by :tacn:`eauto` will change its performance profile or potentially break. To approximate prior behavior, set to zero the cost of :cmd:`Extern ` hints, which may solve the goal in one step. - **Changed:** less discrepancies between :tacn:`auto` hint evaluation and :tacn:`simple apply`, :tacn:`exact` tactics (`#16293 `_, fixes `#16062 `_ and `#16323 `_, by Andrej Dudenhefner). .. warning:: :tacn:`auto` may solve more goals. As a result, non-monotone use of :tacn:`auto` such as :g:`tac1; auto. tac2.` may break. For backwards compatibility use explicit goal management. - **Removed:** `absurd_hyp` tactic, that was marked as obsolete 15 years ago. Use :tacn:`contradict` instead (`#16670 `_, by Théo Zimmermann). - **Removed:** the undocumented `progress_evars` tactical (`#16843 `_, by Théo Zimmermann). - **Deprecated:** the default ``intuition_solver`` (see :tacn:`intuition`) now outputs warning ``intuition-auto-with-star`` if it solves a goal with ``auto with *`` that was not solved with just :tacn:`auto`. In a future version it will be changed to just :tacn:`auto`. Use ``intuition tac`` locally or ``Ltac Tauto.intuition_solver ::= tac`` globally to silence the warning in a forward-compatible way with your choice of tactic ``tac`` (``auto``, ``auto with *``, ``auto with`` your prefered databases, or any other tactic) (`#16026 `_, by Gaëtan Gilbert). - **Deprecated:** `>` clear modifier that could be used in some tactics like :tacn:`apply` and :tacn:`rewrite` but was never documented. Open an issue if you actually depend on this feature (`#16407 `_, by Théo Zimmermann). - **Fixed:** :tacn:`auto` now properly updates local hypotheses after hint application (`#16302 `_, fixes `#15814 `_ and `#6332 `_, by Andrej Dudenhefner). - **Fixed:** Make the behavior of :tacn:`destruct ... using ... ` more powerful and more similar to :tacn:`destruct ... ` (`#16605 `_, by Lasse Blaauwbroek). - **Fixed:** typeclass inference sometimes caused remaining holes to fail to be detected (`#16743 `_, fixes `#5239 `_, by Gaëtan Gilbert). Ltac language ^^^^^^^^^^^^^ - **Changed:** :cmd:`Ltac` redefinitions (with ``::=``) now respect :attr:`local` (`#16106 `_, by Gaëtan Gilbert). - **Changed:** In :tacn:`match goal`, ``match goal with hyp := body : typ |- _`` is syntax sugar for ``match goal with hyp := [ body ] : typ |- _`` i.e. it matches ``typ`` with the type of the hypothesis rather than matching the body as a cast term. This transformation used to be done with any kind of cast (e.g. VM cast ``<:``) and is now done only for default casts ``:`` (`#16764 `_, by Gaëtan Gilbert). .. _817Ltac2: Ltac2 language ^^^^^^^^^^^^^^ - **Changed:** ``Ltac2.Bool`` notations are now in a module ``Ltac2.Bool.BoolNotations`` (exported by default), so that these notations can be imported separately (`#16536 `_, by Jason Gross). - **Changed:** ``Constr.in_context`` enforces that the ``constr`` passed to it is a type (`#16547 `_, fixes `#16540 `_, by Gaëtan Gilbert). - **Changed:** goal matching functions from ``Ltac2.Pattern`` (``matches_goal``, ``lazy_goal_match0``, ``multi_goal_match0`` and ``one_goal_match0``) have changed types to support matching hypothesis bodies (`#16655 `_, by Gaëtan Gilbert). - **Added:** Deep :ref:`pattern matching ` for Ltac2 (`#16023 `_, by Gaëtan Gilbert). - **Added:** patterns for Ltac2 matches: ``as``, records and literal integers and strings (`#16179 `_, by Gaëtan Gilbert). - **Added:** APIs for working with strings: `Message.to_string`, `String.concat`, `cat`, `equal`, `compare`, `is_empty` (`#16217 `_, by Gaëtan Gilbert). - **Added:** ``Ltac2.Constr.Unsafe.liftn`` (`#16413 `_, by Jason Gross). - **Added:** ``Ltac2.Constr.Unsafe.closedn``, ``Ltac2.Constr.Unsafe.is_closed``, ``Ltac2.Constr.Unsafe.occur_between``, ``Ltac2.Constr.Unsafe.occurn`` (`#16414 `_, by Jason Gross). - **Added:** `Ltac2.List.equal` (`#16429 `_, by Jason Gross). - **Added:** :cmd:`Print Ltac2`, :cmd:`Print Ltac2 Signatures` and :cmd:`Locate` can now find Ltac2 definitions (`#16466 `_, fixes `#16418 `_ and `#16415 `_, by Gaëtan Gilbert). - **Added:** ``Ltac2.Array.for_all2`` and ``Ltac2.Array.equal`` (`#16535 `_, by Jason Gross). - **Added:** ``Ltac2.Constant.equal``, ``Ltac2.Constant.t``, ``Ltac2.Constructor.equal``, ``Ltac2.Constructor.t``, ``Ltac2.Evar.equal``, ``Ltac2.Evar.t``, ``Ltac2.Float.equal``, ``Ltac2.Float.t``, ``Ltac2.Meta.equal``, ``Ltac2.Meta.t``, ``Ltac2.Proj.equal``, ``Ltac2.Proj.t``, ``Ltac2.Uint63.equal``, ``Ltac2.Uint63.t``, ``Ltac2.Char.equal``, ``Ltac2.Char.compare``, ``Ltac2.Constr.Unsafe.Case.equal`` (`#16537 `_, by Jason Gross). - **Added:** ``Ltac2.Option.equal`` (`#16538 `_, by Jason Gross). - **Added:** syntax for Ltac2 record update ``{ foo with field := bar }`` (`#16552 `_, fixes `#10117 `_, by Gaëtan Gilbert). - **Added:** Ltac2 record expressions support punning, i.e. ``{ foo; M.bar }`` is equivalent to ``{ foo := foo; M.bar := bar }`` (`#16556 `_, by Gaëtan Gilbert). - **Added:** :tacn:`match! goal` support for matching hypothesis bodies (`#16655 `_, fixes `#12803 `_, by Gaëtan Gilbert). - **Added:** quotation and syntax class for :ref:`preterms ` (`#16740 `_, by Gaëtan Gilbert). SSReflect ^^^^^^^^^ - **Added:** port the additions made to `ssrfun.v` and `ssrbool.v` in math-comp `PR #872 `_ and `PR #874 `_, namely definitions `olift` and `pred_oapp` as well as lemmas `all_sig2_cond`, `compA`, `obindEapp`, `omapEbind`, `omapEapp`, `omap_comp`, `oapp_comp`, `olift_comp`, `ocan_comp`, `eqbLR`, `eqbRL`, `can_in_pcan`, `pcan_in_inj`, `in_inj_comp`, `can_in_comp`, `pcan_in_comp` and `ocan_in_comp` (`#16158 `_, by Pierre Roux). Commands and options ^^^^^^^^^^^^^^^^^^^^ - **Changed:** commands which set tactic options (currently :opt:`Firstorder Solver` and :cmd:`Obligation Tactic`, as well as any defined by third party plugins) now support :attr:`export` locality. Note that such commands using :attr:`global` without :attr:`export` or using no explicit locality outside sections apply their effects when any module containing it (recursively) is imported. This will change in a future version. (`#15274 `_, fixes `#15072 `_, by Gaëtan Gilbert). - **Changed:** `Hint` and :cmd:`Instance` commands with no locality attribute are deprecated. Previous versions generated a warning, but this version generates an error by default. This includes all `Hint` commands described in :ref:`creating_hints`, :cmd:`Hint Rewrite`, and :cmd:`Instance`. As mentioned in the error, please add an explicit locality to the hint command. The default was #[:attr:`global`], but we recommend using #[:attr:`export`] where possible (`#16004 `_, fixes `#13394 `_, by Ali Caglayan). - **Changed:** Transparent obligations generated by :attr:`Program ` do not produce an implicit :cmd:`Hint Unfold` anymore (`#16340 `_, by Pierre-Marie Pédrot). - **Changed:** :cmd:`Print Typeclasses` replaces the undocumented `Print TypeClasses` command which displays the list of typeclasses (`#16690 `_, fixes `#16686 `_, by Ali Caglayan). - **Changed:** The -async-proofs-tac-j command line option now accepts the argument 0, which makes `par` block interpreted without spawning any new process (`#16837 `_, by Pierre-Marie Pédrot). - **Removed:** the ``Program Naming`` flag, which was introduced as an immediately deprecated option in Coq 8.16 (`#16519 `_, by Pierre-Marie Pédrot). - **Removed:** undocumented and broken `Solve Obligation` command (the :cmd:`Solve Obligations` command is untouched) (`#16842 `_, by Théo Zimmermann). .. _817ClassFieldSyntax: - **Deprecated** :g:`:>` syntax, to declare fields of :ref:`typeclasses` as instances, since it is now replaced by :g:`::` (see :n:`@of_type_inst`). This will allow, in a future release, making :g:`:>` declare :ref:`coercions` as it does in :ref:`record ` definitions (`#16230 `_, fixes `#16224 `_, by Pierre Roux, reviewed by Ali Caglayan, Jim Fehrle, Gaëtan Gilbert and Pierre-Marie Pédrot). - **Added:** An improved description of :cmd:`Proof using` and section variables (`#16168 `_, by Jim Fehrle). - **Added:** :g:`::` syntax (see :n:`@of_type_inst`) to declare fields of records as :ref:`typeclass ` instances (`#16230 `_, fixes `#16224 `_, by Pierre Roux, reviewed by Ali Caglayan, Jim Fehrle, Gaëtan Gilbert and Pierre-Marie Pédrot). - **Added:** The :cmd:`Print Keywords` command, which prints all the currently-defined parser keywords and tokens (`#16438 `_, fixes `#16375 `_, by Gaëtan Gilbert). - **Added:** :cmd:`Print Grammar` can print arbitrary nonterminals or the whole grammar instead of a small adhoc list of nonterminals (`#16440 `_, by Gaëtan Gilbert). - **Fixed:** :flag:`Fast Name Printing` flag no longer causes variable name capture when displaying a goal (`#16395 `_, fixes `#14141 `_, by Wojciech Karpiel). - **Fixed:** :tacn:`vm_compute` ignored the ``bytecode-compiler`` command line flag (`#16931 `_, fixes `#16929 `_, by Gaëtan Gilbert). - **Fixed:** The :cmd:`Proof Mode` command now gives an error if the specified proof mode doesn't exist. The command was not previously documented (`#16981 `_, fixes `#16602 `_, by Jim Fehrle). - **Fixed:** Backtracking over grammar modifications from plugins (such as added commands) (`#17069 `_, fixes `#12575 `_, by Gaëtan Gilbert). - **Fixed:** Anomaly instead of regular error on unsupported applied :g:`fix` in :cmd:`Function` (`#17113 `_, fixes `#17110 `_, by Hugo Herbelin). Command-line tools ^^^^^^^^^^^^^^^^^^ - **Added:** New documentation section :ref:`configuration_basics` covering use cases such as setting up Coq with opam, where/how to set up source code for your projects and use of _CoqProject (`#15888 `_, by Jim Fehrle). - **Added:** In _CoqProject files, expand paths that are directories to include appropriate files in (sub)directories (`#16308 `_, by Jim Fehrle). - **Fixed:** issues when using ``coq_makefile`` to build targets requiring both ``.vo`` and ``.glob`` files (typically documentation targets), where ``make`` would run multiple ``coqc`` processes on the same source file with racy behaviour (only fixed when using a ``make`` supporting "grouped targets" such as GNU Make 4.3) (`#16757 `_, by Gaëtan Gilbert). - **Fixed:** Properly process legacy attributes such as ``Global`` and ``Polymorphic`` in coqdoc to avoid omissions when using the ``-g`` (Gallina only) option (`#17090 `_, fixes `#15933 `_, by Karl Palmskog). .. _817Stdlib: Standard library ^^^^^^^^^^^^^^^^ - **Changed:** Class :g:`Saturate` in ``ZifyCLasses.v``, :g:`PRes` now also takes operands (`#16355 `_, by František Farka on behalf of BedRock Systems, Inc.). - **Changed:** For uniformity of naming and ease of remembering, `R_dist` and theorems mentioning `R_dist` in their name become available with spelling `Rdist` (`#16874 `_, by Hugo Herbelin). - **Removed:** from :g:`Nat` and :g:`N` superfluous lemmas :g:`rs_rs'`, :g:`rs'_rs''`, :g:`rbase`, :g:`A'A_right`, :g:`ls_ls'`, :g:`ls'_ls''`, :g:`rs'_rs''`, :g:`lbase`, :g:`A'A_left`, and also redundant non-negativity assumptions in :g:`gcd_unique`, :g:`gcd_unique_alt`, :g:`divide_gcd_iff`, and :g:`gcd_mul_diag_l` (`#16203 `_, by Andrej Dudenhefner). - **Deprecated:** notation ``_ ~= _`` for ``JMeq`` in ``Coq.Program.Equality`` (`#16436 `_, by Gaëtan Gilbert). - **Deprecated:** lemma :g:`Finite_alt` in ``FinFun.v``, which is a weaker version of the newly added lemma :g:`Finite_dec` (`#16489 `_, fixes `#16479 `_, by Bodo Igler, with help from Olivier Laurent). - **Deprecated:** :g:`Zmod`, :g:`Zdiv_eucl_POS`, :g:`Zmod_POS_bound`, :g:`Zmod_pos_bound`, and :g:`Zmod_neg_bound` in `ZArith.Zdiv` (`#16892 `_, by Andres Erbsen). - **Deprecated:** :g:`Cyclic.ZModulo.ZModulo` because there have been no known use cases for this module and because it does not implement `Z/nZ` for arbitrary `n` as one might expect based on the name. The same construction will remain a part of the Coq test suite to ensure consistency of `CyclicAxioms` (`#16914 `_, by Andres Erbsen). - **Added:** lemmas :g:`Permutation_incl_cons_inv_r`, :g:`Permutation_pigeonhole`, :g:`Permutation_pigeonhole_rel` to ``Permutation.v``, and :g:`Forall2_cons_iff`, :g:`Forall2_length`, :g:`Forall2_impl`, :g:`Forall2_flip`, :g:`Forall_Exists_exists_Forall2` to ``List.v`` (`#15986 `_, by Andrej Dudenhefner, with help from Dominique Larchey-Wendling and Olivier Laurent). - **Added:** modules :g:`Nat.Div0` and :g:`Nat.Lcm0` in :g:`PeanoNat`, and :g:`N.Div0` and :g:`N.Lcm0` in :g:`BinNat` containing lemmas regarding :g:`div` and :g:`mod`, which take into account `n div 0 = 0` and `n mod 0 = n`. Strictly weaker lemmas are deprecated, and will be removed in the future. After the weaker lemmas are removed, the modules :g:`Div0` and :g:`Lcm0` will be deprecated, and their contents included directly into :g:`Nat` and :g:`N`. Locally, you can use :g:`Module Nat := Nat.Div0.` or :g:`Module Nat := Nat.Lcm0.` to approximate this inclusion (`#16203 `_, fixes `#16186 `_, by Andrej Dudenhefner). - **Added:** lemma :g:`measure_induction` in :g:`Nat` and :g:`N` analogous to :g:`Wf_nat.induction_ltof1`, which is compatible with the `using` clause for the :tacn:`induction` tactic (`#16203 `_, by Andrej Dudenhefner). - **Added:** three lemmata related to finiteness and decidability of equality: :g:`Listing_decidable_eq`, :g:`Finite_dec` to ``FinFun.v`` and lemma :g:`NoDup_list_decidable` to ``ListDec.v`` (`#16489 `_, fixes `#16479 `_, by Bodo Igler, with help from Olivier Laurent and Andrej Dudenhefner). - **Added:** lemma :g:`not_NoDup` to ``ListDec.v`` and :g:`NoDup_app_remove_l`, :g:`NoDup_app_remove_r` to ``List.v`` (`#16588 `_, by Stefan Haan with a lot of help from Olivier Laurent and Ali Caglayan). - **Added:** the `skipn_skipn` lemma in `Lists/List.v` (`#16632 `_, by Stephan Boyer). - **Added:** lemmas :g:`nth_error_ext`, :g:`map_repeat`, :g:`rev_repeat` to ``List.v``, and :g:`to_list_nil_iff`, :g:`to_list_inj` to ``VectorSpec.v`` (`#16756 `_, by Stefan Haan). - **Added:** transparent :g:`extgcd` to replace opaque :g:`euclid`, :g:`euclid_rec`, :g:`Euclid`, and :g:`Euclid_intro` in :g:`Znumtheory`. Deprecated compatibility wrappers are provided (`#16915 `_, by Andres Erbsen). Infrastructure and dependencies ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ - **Changed:** Coq is now built entirely using the Dune build system. Packagers and users that build Coq manually must use the new build instructions in the documentation (`#15560 `_, by Ali Caglayan, Emilio Jesus Gallego Arias, and Rudi Grinberg). - **Changed:** Coq is not compiled with OCaml's ``-rectypes`` option anymore. This means plugins which do not exploit it can also stop passing it to OCaml (`#16007 `_, by Gaëtan Gilbert). - **Changed:** Building Coq now requires Dune >= 2.9 (`#16118 `_, by Emilio Jesus Gallego Arias). - **Changed:** Coq Makefile targets `pretty-timed`, `make-pretty-timed`, `make-pretty-timed-before`, `make-pretty-timed-after`, `print-pretty-timed`, `print-pretty-timed-diff`, `print-pretty-single-time-diff` now generate more readable timing tables when absolute paths are used in `_CoqProject` / the arguments to `coq_makefile`, by stripping off the absolute prefix (`#16268 `_, by Jason Gross). - **Changed:** Coq's configure script now defaults to `-native-compiler no`. Previously, the default was `-native-compiler ondemand`, except on Windows. The behavior for users installing through opam does not change, i.e., it is `-native-compiler no` if the `coq-native` package is not installed, and `-native-compiler yes` otherwise (`#16997 `_, by Théo Zimmermann). - **Removed:** the ``-coqide`` switch to ``configure`` in Coq's build infrastructure (it stopped controlling what got compiled in the move to dune) (`#16512 `_, by Gaëtan Gilbert). - **Removed:** the ``-nomacintegration`` configure flag for CoqIDE. Now CoqIDE will always build with the proper platform-specific integration if available (`#16531 `_, by Emilio Jesus Gallego Arias). - **Added:** Coq now supports OCaml 5; note that OCaml 5 is not compatible with Coq's native reduction machine (`#15494 `_, `#16925 `_, `#16947 `_, `#16959 `_, `#16988 `_, `#16991 `_, `#16996 `_, `#16997 `_, `#16999 `_, `#17010 `_, and `#17015 `_ by Emilio Jesus Gallego Arias, Gaëtan Gilbert, Guillaume Melquiond, Pierre-Marie Pédrot, and others). - **Added:** OCaml 4.14 is now officially supported (`#15867 `_, by Gaëtan Gilbert). Miscellaneous ^^^^^^^^^^^^^ - **Changed:** Module names are now added to the loadpath in alphabetical order for each (sub-)directory. Previously they were added in the order of the directory entries (as shown by "ls -U") (`#16725 `_, by Jim Fehrle). Changes in 8.17.1 ~~~~~~~~~~~~~~~~~ A variety of bug fixes and improvements to error messages, including: - **Fixed:** in some cases, coqdep emitted incorrect paths for META files which prevented dune builds for plugins from working correctly (`#17270 `_, fixes `#16571 `_, by Rodolphe Lepigre). - **Fixed:** Shadowing of record fields in extraction to OCaml (`#17324 `_, fixes `#12813 `_ and `#14843 `_ and `#16677 `_, by Hugo Herbelin). - **Fixed:** an impossible to turn off debug message "backtracking and redoing byextend on ..." (`#17495 `_, fixes `#17488 `_, by Gaëtan Gilbert). - **Fixed:** major memory regression affecting MathComp 2 (`#17743 `_, by Enrico Tassi and Pierre Roux). Version 8.16 ------------ Summary of changes ~~~~~~~~~~~~~~~~~~ Coq version 8.16 integrates changes to the Coq kernel and performance improvements along with a few new features. We highlight some of the most impactful changes here: - The guard checker (see :cmd:`Guarded`) now ensures strong :ref:`normalization <816Normalization>` under any reduction strategy. - Irrelevant terms (in the ``SProp`` sort) are now squashed to a dummy value during :ref:`conversion <816SPropConversion>`, fixing a subject reduction issue and making proof conversion faster. - Introduction of :ref:`reversible coercions <816ReversibleCoercions>`, which allow coercions relying on meta-level resolution such as type-classes or canonical structures. Also :ref:`allow coercions <816UniformInh>` that do not fullfill the :term:`uniform inheritance condition`. - :ref:`Generalized rewriting <816GeneralizeRew>` support for rewriting with ``Type``-valued relations and in ``Type`` contexts, using the ``Classes.CMorphisms`` library. - Added the :ref:`boolean equality <816BooleanEquality>` scheme command for decidable inductive types. - Added a :ref:`Print Notation <816PrintNotation>` command. - Incompatibilities in :ref:`name generation <816ProgramObls>` for Program obligations, :tacn:`eauto` treatment of :ref:`tactic failure levels <816EautoLevels>`, use of ``ident`` :ref:`in notations <816IdentNotations>`, parsing of :ref:`module expressions <816ModuleExprs>`. - Standard library :ref:`reorganization and deprecations <816Stdlib>`. - Improve the treatment of standard library numbers by :cmd:`Extraction`. See the `Changes in 8.16.0`_ section below for the detailed list of changes, including potentially breaking changes marked with **Changed**. Coq's `reference manual for 8.16 `_, `documentation of the 8.16 standard library `_ and `developer documentation of the 8.16 ML API `_ are also available. Ali Caglayan, Emilio Jesús Gallego Arias, Gaëtan Gilbert 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 `_ that are used in many Coq projects for continuous integration. The opam repository for Coq packages has been maintained by 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/. The `Coq Platform `_ has been maintained by Michael Soegtrop, with help from Karl Palmskog, Enrico Tassi and Théo Zimmermann. Our current maintainers are Yves Bertot, Frédéric Besson, Ana Borges, Ali Caglayan, Tej Chajed, Cyril Cohen, Pierre Corbineau, Pierre Courtieu, Maxime Dénès, Jim Fehrle, Julien Forest, Emilio Jesús Gallego Arias, Gaëtan Gilbert, Georges Gonthier, Benjamin Grégoire, Jason Gross, Hugo Herbelin, Vincent Laporte, Olivier Laurent, Assia Mahboubi, Kenji Maillard, Guillaume Melquiond, Pierre-Marie Pédrot, Clément Pit-Claudel, Pierre Roux, Kazuhiko Sakaguchi, Vincent Semeria, Michael Soegtrop, Arnaud Spiwack, Matthieu Sozeau, Enrico Tassi, Laurent Théry, Anton Trunov, Li-yao Xia and Théo Zimmermann. See the `Coq Team face book `_ page for more details. The 57 contributors to the 8.16 versions are Tanaka Akira, Frédéric Besson, Martin Bodin, Ana Borges, Ali Caglayan, Minki Cho, Cyril Cohen, Juan Conejero, "stop-cran", Adrian Dapprich, Maxime Dénès, Stéphane Desarzens, Christian Doczkal, Andrej Dudenhefner, Andres Erbsen, Jim Fehrle, Emilio Jesús Gallego Arias, Attila Gáspár, Paolo G. Giarrusso, Gaëtan Gilbert, Rudi Grinberg, Jason Gross, Hugo Herbelin, Wolf Honore, Jasper Hugunin, Bart Jacobs, Pierre Jouvelot, Ralf Jung, Grant Jurgensen, Jan-Oliver Kaiser, Wojciech Karpiel, Thomas Klausner, Ethan Kuefner, Fabian Kunze, Olivier Laurent, Yishuai Li, Erik Martin-Dorel, Guillaume Melquiond, Jean-Francois Monin, Pierre-Marie Pédrot, Rudy Peterson, Clément Pit-Claudel, Seth Poulsen, Ramkumar Ramachandra, Pierre Roux, Takafumi Saikawa, Kazuhiko Sakaguchi, Gabriel Scherer, Vincent Semeria, Kartik Singhal, Michael Soegtrop, Matthieu Sozeau, Enrico Tassi, Laurent Théry, Anton Trunov, Li-yao Xia and Théo Zimmermann. The Coq community at large helped improve this new version via the GitHub issue and pull request system, the coq-club@inria.fr mailing list, the `Discourse forum `_ and the `Coq Zulip chat `_. Version 8.16's development spanned 6 months from the release of Coq 8.15.0. Pierre-Marie Pédrot is the release manager of Coq 8.16. This release is the result of 356 merged PRs, closing 99 issues. | Nantes, June 2022, | Matthieu Sozeau for the Coq development team Changes in 8.16.0 ~~~~~~~~~~~~~~~~~ .. contents:: :local: Kernel ^^^^^^ .. _816Normalization: - **Changed:** Fixpoints are now expected to be guarded even in subterms erasable by reduction, thus getting rid of an artificial obstacle preventing to lift the assumption of weak normalization of Coq to an assumption of strong normalization; for instance (barring implementation bugs) termination of the type-checking algorithm of Coq is now restored (of course, as usual, up to the assumption of the consistency of set theory and type theory, i.e., equivalently, up to the weak normalization of type theory, a "physical" assumption, which has not been contradicted for decades and which specialists commonly believe to be a truth) (`#15434 `_, incidentally fixes the complexity issue `#5702 `_, by Hugo Herbelin). - **Changed:** Flag :n:`Unset Guard Checking` nevertheless requires fixpoints to have an argument marked as decreasing in a type which is inductive (`#15668 `_, fixes `#15621 `_, by Hugo Herbelin). - **Removed:** :ref:`Template-polymorphism` is now forbidden for mutual inductive types (`#15965 `_, by Gaëtan Gilbert). - **Fixed:** Inlining of non-logical objects (notations, hints, ...) was missing when applying a functor returning one of its arguments as e.g. in :n:`Module F (E:T) := E` (`#15412 `_, fixes `#15403 `_, by Hugo Herbelin). .. _816SPropConversion: - **Fixed:** We introduce a new irrelevant term in the reduction machine. It is used to shortcut computation of terms living in a strict proposition, and behaves as an exception. This restores subject reduction, and also makes conversion of large terms in SProp cheap (`#15575 `_, fixes `#14015 `_, by Pierre-Marie Pédrot). - **Fixed:** performance blowups while inferring variance information for :ref:`cumulative` inductive types (`#15662 `_, fixes `#11741 `_, by Gaëtan Gilbert). Specification language, type inference ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ - **Added:** New clause :n:`as @ident` to the :cmd:`Record` command to specify the name of the main argument to use by default in the type of projections (`#14563 `_, by Hugo Herbelin). .. _816ReversibleCoercions: - **Added:** :term:`Reversible coercions ` are coercions which cannot be represented by a regular coercion (a Gallina function) but rather a meta procedure, such as type class inference or canonical structure resolution (`#15693 `_, by Cyril Cohen, Pierre Roux, Enrico Tassi, reviewed by Ali Caglayan, Jim Fehrle and Gaëtan Gilbert). .. _816UniformInh: - **Added:** support for coercions not fulfilling the uniform inheritance condition, allowing more freedom for the parameters that are now inferred using unification, canonical structures or typeclasses (`#15789 `_, fixes `#2828 `_, `#4593 `_, `#3115 `_, `#5222 `_, `#9696 `_ and `#8540 `_, by Pierre Roux, reviewed by Ali Caglayan, Enrico Tassi, Kazuhiko Sakaguchi and Jim Fehrle). - **Fixed:** interpretation of `{struct}` fixpoint annotations when the principal argument comes from an implicit generalization (`#15581 `_, fixes `#13157 `_, by Gaëtan Gilbert). Notations ^^^^^^^^^ .. _816IdentNotations: - **Removed:** ``_`` in ``ident`` entries in notations, which was deprecated in favor of ``name`` in 8.13. When you see messages like .. code:: Error: Notation "[ rel _ _ : _ | _ ]" is already defined at level 0 with arguments name, name, constr, constr while it is now required to be at level 0 with arguments ident, ident, constr, constr. replace ``ident`` with ``name`` in the :cmd:`Notation` command. To ease the change, you can fix the ``deprecated-ident-entry`` warnings in Coq 8.15 (or 8.14 or 8.13). The warning can be turned into an error with ``-arg -w -arg +deprecated-ident-entry`` in the ``_CoqProject`` file (`#15754 `_, by Pierre Roux). - **Added:** When defining a recursive notation referring to another recursive notation, expressions of the form :n:`x .. y` can be used where a sequence of binders is expected (`#15291 `_, grants `#7911 `_, by Hugo Herbelin). - **Fixed:** Coercions are disabled when typechecking parsers and printers of :cmd:`Number Notation` (`#15884 `_, fixes `#15843 `_, by Pierre Roux). Tactics ^^^^^^^ - **Changed:** The ``RewriteRelation`` type class is now used to declare relations inferable by the :tacn:`setoid_rewrite` tactic to construct ``Proper`` instances. This can break developments that relied on existing ``Reflexive`` instances to infer relations. The fix is to simply add a (backwards compatible) ``RewriteRelation`` declaration for the relation. This change allows to set stricter modes on the relation type classes ``Reflexive``, ``Symmetric``, etc. (`#13969 `_, fixes `#7916 `_, by Matthieu Sozeau). - **Changed:** The :tacn:`setoid_rewrite` tactic can now properly recognize homogeneous relations applied to types in different universes (`#14138 `_, fixes `#13618 `_, by Matthieu Sozeau). .. _816EautoLevels: - **Changed:** The :tacn:`eauto` tactic does not propagate internal Ltac failures with level > 0 anymore. Any failure caused by a hint now behaves as if it were a level 0 error (`#15215 `_, fixes `#15214 `_, by Pierre-Marie Pédrot). - **Changed:** :tacn:`rewrite` when used to rewrite in multiple hypotheses (eg `rewrite foo in H,H'`) requires that the term (`foo`) does not depend on the hypotheses it rewrites. When using `rewrite in *`, this means we only rewrite in hypotheses which do not appear in the term (`#15426 `_, fixes `#3051 `_ and `#15448 `_, by Gaëtan Gilbert). - **Changed:** When it fails, :tacn:`assert_succeeds` fails with the argument tactic's original error instead of ``Tactic failure: fails.`` (`#15728 `_, fixes `#10970 `_, by Gaëtan Gilbert). - **Deprecated:** the :tacn:`instantiate` tactic without arguments. Since the move to the monadic tactic engine in 8.5, it was behaving as the identity (`#15277 `_, by Pierre-Marie Pédrot). .. _816GeneralizeRew: - **Added:** generalized rewriting now supports rewriting with (possibly polymorphic) relations valued in ``Type``. Use ``Classes.CMorphisms`` instead of ``Classes.Morphisms`` to declare ``Proper`` instances for :tacn:`rewrite` (or :tacn:`setoid_rewrite`) to use when rewriting with ``Type`` valued relations (`#14137 `_, fixes `#4632 `_, `#5384 `_, `#5521 `_, `#6278 `_, `#7675 `_, `#8739 `_, `#11011 `_, `#12240 `_, and `#15279 `_, by Matthieu Sozeau helped by Ali Caglayan). - **Added:** Tactics to obtain a micromega :term:`cone expression` (aka witness) from an already reified goal. Using those tactics, the user can develop their own micromega tactics for their own types, using their own parsers (`#15921 `_, by Pierre Roux, reviewed by Frédéric Besson and Jim Fehrle). - **Fixed:** :tacn:`typeclasses eauto` used with multiple hint databases respects priority differences for hints from separate databases (`#15289 `_, fixes `#5304 `_, by Gaëtan Gilbert). - **Fixed:** :tacn:`cbn` has better support for combining `simpl nomatch`, `!` and `/` specifiers (c.f. :cmd:`Arguments`) (`#15657 `_, fixes `#3989 `_ and `#15206 `_, by Gaëtan Gilbert). Tactic language ^^^^^^^^^^^^^^^ - **Changed:** Ltac `match` does not fail when the term to match contains an unfolded primitive projection (`#15559 `_, fixes `#15554 `_, by Gaëtan Gilbert). - **Added:** ``Ltac2`` understands :token:`toplevel_selector` and obeys :opt:`Default Goal Selector`. Note that ``par:`` is buggy when combined with :tacn:`abstract`. Unlike ``Ltac1`` even ``par: abstract tac`` is not properly treated (`#15378 `_, by Gaëtan Gilbert). - **Added:** Ltac2 `Int` functions `div`, `mod`, `asr`, `lsl`, `lsr`, `land`, `lor` , `lxor` and `lnot` (`#15637 `_, by Michael Soegtrop). - **Fixed:** Ltac2 `apply` and `eapply` not unifying with implicit arguments; unification inconsistent with `exact` and `eexact` (`#15741 `_, by Ramkumar Ramachandra). SSReflect ^^^^^^^^^ - **Fixed:** :tacn:`have`, :tacn:`suff` and :tacn:`wlog` support goals in `SProp` (`#15121 `_, by Enrico Tassi). Commands and options ^^^^^^^^^^^^^^^^^^^^ .. _816ModuleExprs: - **Changed:** :cmd:`Module` now only allows parentheses around module arguments. For instance, ``Module M := (F X).`` is now a parsing error (`#15355 `_, by Gaëtan Gilbert). - **Changed:** :cmd:`Fail` no longer catches anomalies, which it has done since Coq version 8.11. Now it only catches user errors (`#15366 `_, by Hugo Herbelin). - **Changed:** :ref:`program_definition` in universe monomorphic mode does not accept non-extensible universe declarations (`#15424 `_, fixes `#15410 `_, by Gaëtan Gilbert). .. _816ProgramObls: - **Changed:** The algorithm for name generation of anonymous variables for ``Program`` subproofs is now the same as the one used in the general case. This can create incompatibilities in scripts relying on such autogenerated names. The old scheme can be reactivated using the deprecated flag ``Program Naming`` (`#15442 `_, by Pierre-Marie Pédrot). - **Removed:** `Universal Lemma Under Conjunction` flag, that was deprecated in 8.15 (`#15268 `_, by Théo Zimmermann). - **Removed:** :cmd:`Abort` no longer takes an :n:`@ident` as an argument (it has been ignored since 8.5) (`#15669 `_, by Gaëtan Gilbert). - **Removed:** `Simplex` flag, that was deprecated in 8.14. :tacn:`lia` and :tacn:`lra` will always use the simplex solver (that was already the default behaviour) (`#15690 `_, by Frédéric Besson). - **Deprecated:** ``Add LoadPath`` and ``Add Rec LoadPath``. If this command is an important feature for you, please open an issue on `GitHub ` and explain your workflow (`#15652 `_, by Gaëtan Gilbert). - **Deprecated:** the `Typeclasses Filtered Unification` flag. Due to a buggy implementation, it is unlikely this is used in the wild (`#15752 `_, by Pierre-Marie Pédrot). .. _816BooleanEquality: - **Added:** :cmd:`Scheme Boolean Equality` command to generate the boolean equality for an inductive type whose equality is decidable. It is useful when Coq is able to generate the boolean equality but isn't powerful enough to prove the decidability of equality (unlike :cmd:`Scheme Equality`, which tries to prove the decidability of the type) (`#15526 `_, by Hugo Herbelin). - **Added:** New more extensive algorithm based on the "parametricity" translation for canonically generating Boolean equalities associated to a decidable inductive type (`#15527 `_, by Hugo Herbelin). - **Added:** :cmd:`From … Dependency` command to declare a dependency of a ``.v`` file on an external file. The ``coqdep`` tool generates build dependencies accordingly (`#15650 `_, fixes `#15600 `_, by Enrico Tassi). .. _816PrintNotation: - **Added:** :cmd:`Print Notation` command that prints the level and associativity of a given notation definition string (`#15683 `_, fixes `#14907 `_ and `#4436 `_ and `#7730 `_, by Ali Caglayan and Ana Borges, with help from Emilio Jesus Gallego Arias). - **Added:** a warning when trying to deprecate a definition (`#15760 `_, by Pierre Roux). - **Added:** A deprecation warning that the :g:`Class >` syntax, which currently does nothing, will in the future declare :ref:`coercions ` as it does when used in :cmd:`Record` commands (`#15802 `_, by Pierre Roux, reviewed by Gaëtan Gilbert, Ali Caglayan, Jason Gross, Jim Fehrle and Théo Zimmermann). - **Added:** the :attr:`nonuniform` boolean attribute that silences the non-uniform-inheritance warning when user needs to declare such a coercion on purpose (`#15853 `_, by Pierre Roux, reviewed by Gaëtan Gilbert and Jim Fehrle). - **Added:** All commands which can import modules (e.g. ``Module Import M.``, ``Module F (Import X : T).``, ``Require Import M.``, etc) now support :token:`import_categories`. :cmd:`Require Import` and :cmd:`Require Export` also support :token:`filtered_import` (`#15945 `_, fixes `#14872 `_, by Gaëtan Gilbert). - **Fixed:** Make `Require Import M.` equivalent to `Require M. Import M.` (`#15347 `_, fixes `#3556 `_, by Maxime Dénès). Command-line tools ^^^^^^^^^^^^^^^^^^ - **Added:** coq_makefile variable `COQPLUGININSTALL` to configure the installation of ML plugins (`#15788 `_, by Cyril Cohen and Enrico Tassi). - **Added:** Added :n:`-bytecode-compiler {| yes | no }` flag for ``coqchk`` enabling :tacn:`vm_compute` during checks, which is off by default (`#15886 `_, by Ali Caglayan). - **Fixed:** ``coqdoc`` confused by the presence of command :cmd:`Load` in a file (`#15511 `_, fixes `#15497 `_, by Hugo Herbelin). CoqIDE ^^^^^^ - **Added:** Documentation of editing failed async mode proofs, how to configure key bindings and various previously undocumented details (`#16070 `_, by Jim Fehrle). Standard library ^^^^^^^^^^^^^^^^ .. _816Stdlib: - **Changed:** the ``signature`` scope of ``Classes.CMorphisms`` into ``signatureT`` (`#15446 `_, by Olivier Laurent). - **Changed:** the locality of typeclass instances `Permutation_app'` and `Permutation_cons` from :attr:`global` to :attr:`export` (`#15597 `_, fixes `#15596 `_, by Gaëtan Gilbert). - **Removed:** ``Int63``, which was deprecated in favor of ``Uint63`` in 8.14 (`#15754 `_, by Pierre Roux). - **Deprecated:** some obsolete files from the ``Arith`` part of the standard library (``Div2``, ``Even``, ``Gt``, ``Le``, ``Lt``, ``Max``, ``Min``, ``Minus``, ``Mult``, ``NPeano``, ``Plus``). Import ``Arith_base`` instead of these files. References to items in the deprecated files should be replaced with references to ``PeanoNat.Nat`` as suggested by the warning messages. Concerning the definitions of parity properties (even and odd), it is recommended to use ``Nat.Even`` and ``Nat.Odd``. If an inductive definition of parity is required, the mutually inductive ``Nat.Even_alt`` and ``Nat.Odd_alt`` can be used. However, induction principles for ``Nat.Odd`` and ``Nat.Even`` are available as ``Nat.Even_Odd_ind`` and ``Nat.Odd_Even_ind``. The equivalence between the non-inductive and mutually inductive definitions of parity can be found in ``Nat.Even_alt_Even`` and ``Nat.Odd_alt_Odd``. All ``Hint`` declarations in the ``arith`` database have been moved to ``Arith_prebase`` and ``Arith_base``. To use the results about Peano arithmetic, we recommend importing ``PeanoNat`` (or ``Arith_base`` to base it on the ``arith`` hint database) and using the ``Nat`` module. ``Arith_prebase`` has been introduced temporarily to ensure compatibility, but it will be removed at the end of the deprecation phase, e.g. in 8.18. Its use is thus discouraged (`#14736 `_, `#15411 `_, by Olivier Laurent, with help of Karl Palmskog). - **Deprecated:** `identity` inductive (replaced by the equivalent `eq`). `Init.Logic_Type` is removed (the only remaining definition `notT` is moved to `Init.Logic`) (`#15256 `_, by Olivier Laurent). - **Deprecated:** `P_Rmin`: use more general `Rmin_case` instead (`#15388 `_, fixes `#15382 `_, by Olivier Laurent). - **Added:** lemma `count_occ_rev` (`#15397 `_, by Olivier Laurent). - **Added:** ``Nat.EvenT`` and ``Nat.OddT`` (almost the same as ``Nat.Even`` and ``Nat.Odd`` but with output in ``Type``. Decidability of parity (with output ``Type``) is provided ``EvenT_OddT_dec`` as well as induction principles ``Nat.EvenT_OddT_rect`` and ``Nat.OddT_EvenT_rect`` (with output ``Type``) (`#15427 `_, by Olivier Laurent). - **Added:** Added a proof of ``sin x < x`` for positive ``x`` and ``x < sin x`` for negative ``x`` (`#15599 `_, by stop-cran). - **Added:** decidability typeclass instances for Z.le, Z.lt, Z.ge and Z.gt, added lemmas Z.geb_ge and Z.gtb_gt (`#15620 `_, by Michael Soegtrop). - **Added:** lemmas ``Rinv_inv``, ``Rinv_mult``, ``Rinv_opp``, ``Rinv_div``, ``Rdiv_opp_r``, ``Rsqr_div'``, ``Rsqr_inv'``, ``sqrt_inv``, ``Rabs_inv``, ``pow_inv``, ``powerRZ_inv'``, ``powerRZ_neg'``, ``powerRZ_mult``, ``cv_infty_cv_0``, which are variants of existing lemmas, but without any hypothesis (`#15644 `_, by Guillaume Melquiond). - **Added:** a Leibniz equality test for primitive floats (`#15719 `_, by Pierre Roux, reviewed by Guillaume Melquiond). - **Added:** support for primitive floats in Scheme Boolean Equality (`#15719 `_, by Pierre Roux, reviewed by Hugo Herbelin). - **Added:** lemma :g:`le_add_l` to ``NAddOrder.v``. Use :g:`Nat.le_add_l` as replacement for the deprecated :g:`Plus.le_plus_r` (`#16184 `_, by Andrej Dudenhefner). Infrastructure and dependencies ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ - **Changed:** Bumped lablgtk3 lower bound to 3.1.2 (`#15947 `_, by Pierre-Marie Pédrot). - **Changed:** Load plugins using `findlib `_. This requires projects built with ``coq_makefile`` to either provide a hand written ``META`` file or use the ``-generate-meta-for-package`` option when applicable. As a consequence :cmd:`Declare ML Module` now uses plugin names according to ``findlib``, e.g. `coq-aac-tactics.plugin`. ``coqdep`` accepts ``-m META`` and uses the file to resolve plugin names to actual file names (`#15220 `_, fixes `#7698 `_, by Enrico Tassi). - **Changed:** Minimum supported zarith version is now 1.11 (`#15483 `_ and `#16005 `_ and `#16030 `_, closes `#15496 `_, by Gaëtan Gilbert and Théo Zimmermann and Jason Gross). - **Changed:** Bump the minimum OCaml version to 4.09.0. As a consequence the minimum supported ocamlfind version is now 1.8.1 (`#15947 `_ and `#16046 `_, fixes `#14260 `_ and `#16015 `_, by Pierre-Marie Pédrot and Théo Zimmermann). Extraction ^^^^^^^^^^ .. _816Extraction: - **Changed:** `ExtrOCamlInt63` no longer extracts `comparison` to `int` in OCaml; the extraction of `Uint63.compare` and `Sint63.compare` was also adapted accordingly (`#15294 `_, fixes `#15280 `_, by Li-yao Xia). - **Changed:** Extraction from :g:`nat` to OCaml :g:`int` uses Stdlib instead of Pervasives (`#15333 `_, by Rudy Nicolo Peterson). - **Changed:** The empty inductive type is now extracted to OCaml empty type available since OCaml 4.07 (`#15967 `_, by Pierre Roux). - **Added:** More extraction definitions for division and comparison of Z and N (`#15098 `_, by Li-yao Xia). - **Fixed:** Type :n:`int` in files :n:`Number.v`, :n:`Decimal.v` and :n:`Hexadecimal.v` have been renamed to :n:`signed_int` (together with a compatibility alias :n:`int`) so that they can be used in extraction without conflicting with OCaml's :n:`int` type (`#13460 `_, fixes `#7017 `_ and `#13288 `_, by Hugo Herbelin). Changes in 8.16.1 ~~~~~~~~~~~~~~~~~ .. contents:: :local: Kernel ^^^^^^ - **Fixed:** conversion of Prod values in the native compiler (`#16651 `_, fixes `#16645 `_, by Pierre-Marie Pédrot). - **Fixed:** Coq 8.16.0 missed `SProp` check for opaque names in conversion (`#16768 `_, fixes `#16752 `_, by Hugo Herbelin). - **Fixed:** Pass the correct environment to compute η-expansion of cofixpoints in VM and native compilation (`#16845 `_, fixes `#16831 `_, by Pierre-Marie Pédrot). - **Fixed:** inconsistency with conversion of primitive arrays, and associated incomplete strong normalization of primitive arrays with ``lazy`` (`#16850 `_, fixes `#16829 `_, by Gaëtan Gilbert, reported by Maxime Buyse and Andres Erbsen). Commands and options ^^^^^^^^^^^^^^^^^^^^ - **Fixed:** :cmd:`Print Assumptions` treats opaque definitions with missing proofs (as found in ``.vos`` files, see :ref:`compiled-interfaces`) as axioms instead of ignoring them (`#16434 `_, fixes `#16411 `_, by Gaëtan Gilbert). CoqIDE ^^^^^^ - **Fixed:** "Interrupt computations" now works correctly on Windows—except if you start CoqIDE as a background process, e.g. with `coqide &` in `bash`, in which case it won't work at all (`#16142 `_, fixes `#13550 `_, by Jim Fehrle). Version 8.15 ------------ Summary of changes ~~~~~~~~~~~~~~~~~~ Coq version 8.15 integrates many bug fixes, deprecations and cleanups as well as a few new features. We highlight some of the most impactful changes here: - The :tacn:`apply with ` tactic :ref:`no longer renames arguments <815ApplyWith>` unless compatibility flag `Apply With Renaming` is set. - :ref:`Improvements <815Auto>` to the :tacn:`auto` tactic family, fixing the :cmd:`Hint Unfold` behavior, and generalizing the use of discrimination nets. - The :tacn:`typeclasses eauto` tactic has a new :ref:`best_effort <815BestEffort>` option allowing it to return *partial* solutions to a proof search problem, depending on the mode declarations associated to each constraint. This mode is used by typeclass resolution during type inference to provide more precise error messages. - Many :ref:`commands and options <815Commands>` were deprecated or removed after deprecation and more consistently support locality attributes. - The :cmd:`Import` command is extended with :token:`import_categories` to :ref:`select the components <815Import>` of a module to import or not, including features such as hints, coercions, and notations. - A :ref:`visual Ltac debugger <815LtacDebugger>` is now available in CoqIDE. See the `Changes in 8.15.0`_ section below for the detailed list of changes, including potentially breaking changes marked with **Changed**. Coq's `reference manual for 8.15 `_, `documentation of the 8.15 standard library `_ and `developer documentation of the 8.15 ML API `_ are also available. 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 `_ that are used in many Coq projects for continuous integration. The opam repository for Coq packages has been maintained by 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/. The `Coq Platform `_ has been maintained by Michael Soegtrop and Enrico Tassi. Our current maintainers are Yves Bertot, Frédéric Besson, Ali Caglayan, Tej Chajed, Cyril Cohen, Pierre Corbineau, Pierre Courtieu, Maxime Dénès, Jim Fehrle, Julien Forest, Emilio Jesús Gallego Arias, Gaëtan Gilbert, Georges Gonthier, Benjamin Grégoire, Jason Gross, Hugo Herbelin, Vincent Laporte, Olivier Laurent, Assia Mahboubi, Kenji Maillard, Guillaume Melquiond, Pierre-Marie Pédrot, Clément Pit-Claudel, Pierre Roux, Kazuhiko Sakaguchi, Vincent Semeria, Michael Soegtrop, Arnaud Spiwack, Matthieu Sozeau, Enrico Tassi, Laurent Théry, Anton Trunov, Li-yao Xia and Théo Zimmermann. See the `Coq Team face book `_ page for more details. The 41 contributors to this version are Tanaka Akira, Frédéric Besson, Juan Conejero, Ali Caglayan, Cyril Cohen, Adrian Dapprich, Maxime Dénès, Stéphane Desarzens, Christian Doczkal, Andrej Dudenhefner, Jim Fehrle, Emilio Jesús Gallego Arias, Attila Gáspár, Gaëtan Gilbert, Jason Gross, Hugo Herbelin, Jasper Hugunin, Bart Jacobs, Ralf Jung, Grant Jurgensen, Jan-Oliver Kaiser, Wojciech Karpiel, Fabian Kunze, Olivier Laurent, Yishuai Li, Erik Martin-Dorel, Guillaume Melquiond, Jean-Francois Monin, Pierre-Marie Pédrot, Rudy Peterson, Clément Pit-Claudel, Seth Poulsen, Pierre Roux, Takafumi Saikawa, Kazuhiko Sakaguchi, Michael Soegtrop, Matthieu Sozeau, Enrico Tassi, Laurent Théry, Anton Trunov and Théo Zimmerman. The Coq community at large helped 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 `_ and the `Coq Zulip chat `_. Version 8.15's development spanned 3 months from the release of Coq 8.14.0. Gaëtan Gilbert is the release manager of Coq 8.15. This release is the result of 384 merged PRs, closing 143 issues. | Nantes, January 2022, | Matthieu Sozeau for the Coq development team Changes in 8.15.0 ~~~~~~~~~~~~~~~~~ .. contents:: :local: Kernel ^^^^^^ - **Fixed:** Name clash in a computation of the type of parameters of functorial module types; this computation was provided for the purpose of clients using the algebraic form of module types such as :cmd:`Print Module Type` (`#15385 `_, fixes `#9555 `_, by Hugo Herbelin). Specification language, type inference ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ - **Changed:** :cmd:`Instance` warns about the default locality immediately rather than waiting until the instance is ready to be defined. This changes which command warns when the instance has a separate proof: the :cmd:`Instance` command itself warns instead of the proof closing command (such as :cmd:`Defined`) (`#14705 `_, by Gaëtan Gilbert). - **Removed:** Arguments of section variables may no longer be renamed with :cmd:`Arguments` (this was previously applied inconsistently) (`#14573 `_, by Gaëtan Gilbert). - **Added:** Non-dependent implicit arguments can be provided explicitly using the syntax :n:`(@natural := @term)` where :token:`natural` is the index of the implicit argument among all non-dependent arguments of the function, starting from 1 (`#11099 `_, by Hugo Herbelin). - **Added:** :cmd:`Succeed`, a :n:`@control_command` that verifies that the given :n:`@sentence` succeeds without changing the proof state (`#14750 `_, by Gaëtan Gilbert). - **Fixed:** The :n:`@term.(@qualid {* @arg })` syntax now takes into account the position of the main argument :n:`@term` when computing the implicit arguments of :n:`@qualid` (`#14606 `_, fixes `#4167 `_, by Hugo Herbelin). - **Fixed:** Source and target of coercions preserved by module instantiation (`#14668 `_, fixes `#3527 `_, by Hugo Herbelin). - **Fixed:** Made reference manual consistent with the implementation regarding the role of recursively non-uniform parameters of inductive types in the nested positivity condition (`#14967 `_, fixes `#14938 `_, by Hugo Herbelin) Notations ^^^^^^^^^ - **Changed:** Terms printed in error messages may be more verbose if syntactic sugar would make it appear that the obtained and expected terms only differ in existential variables (`#14672 `_, by Gaëtan Gilbert). - **Removed:** the ``Numeral Notation`` command that was renamed to :cmd:`Number Notation` in 8.13 (`#14819 `_, by Pierre Roux). - **Removed:** primitive float notations ``<``, ``<=`` and ``==`` that were replaced by ```_, by Pierre Roux). - **Removed:** primitive integer notations ``\%``, ``<``, ``<=`` and ``==`` that were replaced by ``mod``, ```_, by Pierre Roux). - **Added:** Include floats in the number notation mechanism (`#14525 `_, by Pierre Roux). - **Added:** Coercion entries and :n:`ident`/:n:`global` entries in custom notations now respect the :n:`only parsing` modifier (`#15340 `_, fixes `#15335 `_, by Hugo Herbelin). - **Fixed:** :cmd:`Reserved Infix` now accept further parameters in the infix notation (`#14379 `_, fixes `#11402 `_, by Hugo Herbelin). - **Fixed:** Useless self reference when printing abbreviations declared in nested modules (`#14493 `_, fixes one part of `#12777 `_ and `#14486 `_, by Hugo Herbelin). - **Fixed:** anomalies with notation applied in `match` patterns when the notation have a notation variable at head (`#14713 `_, fixes `#14708 `_, by Hugo Herbelin). - **Fixed:** Regression in parsing error reporting in case of empty custom entry (`#15338 `_, fixes `#15334 `_, by Hugo Herbelin). Tactics ^^^^^^^ .. _815ApplyWith: - **Changed:** ``apply with`` does not rename arguments unless using compatibility flag `Apply With Renaming` (`#13837 `_, fixes `#13759 `_, by Gaëtan Gilbert). Porting hint: if the renaming is because of a goal variable (eg ``intros x; apply foo with (x0 := bar)`` where ``About foo.`` says the argument is called ``x``) it is probably caused by an interaction with implicit arguments and ``apply @foo with (x := bar)`` will usually be a backwards compatible fix. .. _815Auto: - **Changed:** :cmd:`Hint Unfold` in discriminated databases now respects its specification, namely that a constant may be unfolded only when it is the head of the goal. The previous behavior was to perform unfolding on any goal, without any limitation. An unexpected side-effect of this was that a database that contained ``Unfold`` hints would sometimes trigger silent strong βι-normalization of the goal. Indeed, :tacn:`unfold` performs such a normalization regardless of the presence of its argument in the goal. This does introduce a bit of backwards incompatibility, but it occurs in very specific situations and is easily circumvented. Since by default hint bases are not discriminated, it means that incompatibilities are typically observed when adding unfold hints to the typeclass database. In order to recover the previous behavior, it is enough to replace instances of ``Hint Unfold foo.`` with ``Hint Extern 4 => progress (unfold foo).``. A less compatible but finer-grained change can be achieved by only adding the missing normalization phase with ``Hint Extern 4 => progress (lazy beta iota).`` (`#14679 `_, fixes `#14874 `_, by Pierre-Marie Pédrot). - **Changed:** Correctly consider variables without a body to be rigid for the pattern recognition algorithm of discriminated hints (`#14722 `_, by Pierre-Marie Pédrot). - **Changed:** Use discrimination nets for goals containing evars in all :tacn:`auto` tactics. It essentially makes the behavior of undiscriminated databases to be the one of discriminated databases where all constants are considered transparent. This may be incompatible with previous behavior in very rare cases (`#14848 `_, by Pierre-Marie Pédrot). - **Changed:** The ``choice`` strategy for :tacn:`rewrite_strat` is now of arbitrary arity (`#14989 `_, fixes `#6109 `_, by Gaëtan Gilbert). - **Changed:** The :tacn:`exact` tactic now takes a :g:`uconstr` as argument instead of an ad-hoc one. In very rare cases, this can change the order of resolution of dependent evars when used over several goals at once (`#15171 `_, by Pierre-Marie Pédrot). - **Changed:** :tacn:`cbn` interprets the combination of the ``!`` and ``/`` modifiers (from :cmd:`Arguments`) to mean "unfold as soon as all arguments before the ``/`` are provided and all arguments marked with ``!`` reduce to a constructor". This makes it unfold more often than without the ``/`` when all arguments are provided. Previously adding ``/`` would only prevent unfolding when insufficient arguments are provided without adding new unfoldings. Note that this change only takes effect in default mode (as opposed to when ``simpl nomatch`` was used) (`#15204 `_, fixes `#4555 `_ and `#7674 `_, by Gaëtan Gilbert). - **Removed:** the deprecated new auto tactic (`#14527 `_, by Pierre-Marie Pédrot). - **Removed:** deprecated syntax for :tacn:`instantiate` using capitalized ``Value`` or ``Type`` (`#15193 `_, by Gaëtan Gilbert). - **Removed:** deprecated ``autoapply ... using`` syntax for :tacn:`autoapply` (`#15194 `_, by Gaëtan Gilbert). - **Deprecated:** the `bfs eauto` tactic. Since its introduction it has behaved exactly like the :tacn:`eauto` tactic. Use :tacn:`typeclasses eauto` with the `bfs` flag instead (`#15314 `_, fixes `#15300 `_, by Pierre-Marie Pédrot). - **Added:** The :tacn:`zify` tactic can now recognize `Pos.Nsucc_double`, `Pos.Ndouble`, `N.succ_double`, `N.double`, `N.succ_pos`, `N.div2`, `N.pow`, `N.square`, and `Z.to_pos`. Moreover, importing module `ZifyBool` lets it recognize `Pos.eqb`, `Pos.leb`, `Pos.ltb`, `N.eqb`, `N.leb`, and `N.ltb` (`#10998 `_, by Kazuhiko Sakaguchi). .. _815BestEffort: - **Added:** :ref:`best_effort ` option to :tacn:`typeclasses eauto`, to return a *partial* solution to its initial proof-search problem. The goals that can remain unsolved are determined according to the modes declared for their head (see :cmd:`Hint Mode`). This is used by typeclass resolution during type inference to provide more informative error messages (`#13952 `_, fixes `#13942 `_ and `#14125 `_, by Matthieu Sozeau). - **Added:** A new :table:`Keep Equalities` table to selectively control the preservation of subterm equalities for the :tacn:`injection` tactic. It allows a finer control than the boolean flag :flag:`Keep Proof Equalities` that acts globally (`#14439 `_, by Pierre-Marie Pédrot). - **Added:** :tacn:`simple congruence` tactic which works like :tacn:`congruence` but does not unfold definitions (`#14657 `_, fixes `#13778 `_ and `#5394 `_ and `#13189 `_, by Andrej Dudenhefner). - **Added:** Small enhancement of unification in the presence of local definitions (`#14673 `_, fixes `#4415 `_, by Hugo Herbelin). - **Added:** `dfs` option in :tacn:`typeclasses eauto` to use depth-first search (`#14693 `_, fixes `#13859 `_, by Ali Caglayan). - **Fixed:** More flexible hypothesis specialization in :tacn:`congruence` (`#14650 `_, fixes `#14651 `_ and `#14662 `_, by Andrej Dudenhefner). - **Fixed:** Added caching to congruence initialization to avoid quadratic runtime (`#14683 `_, fixes `#5548 `_, by Andrej Dudenhefner). - **Fixed:** Correctly handle matching up to η-expansion in discriminated hints (`#14732 `_, fixes `#14731 `_, by Pierre-Marie Pédrot). - **Fixed:** Old unification understands some inductive cumulativity (`#14758 `_, fixes `#14734 `_ and `#6976 `_, by Gaëtan Gilbert). - **Fixed:** The :tacn:`clear dependent ` tactic now does not backtrack internally, preventing an exponential blowup (`#14984 `_, fixes `#11689 `_, by Pierre-Marie Pédrot). - **Fixed:** :tacn:`setoid_rewrite` now works when the rewriting lemma has non dependent arguments and rewriting under binders (`#14986 `_, fixes `#5369 `_, by Gaëtan Gilbert). - **Fixed:** Regression in 8.14.0 and 8.14.1 with action pattern :n:`%` in :n:`as` clause of tactic :tacn:`specialize` (`#15245 `_, fixes `#15244 `_, by Hugo Herbelin). Tactic language ^^^^^^^^^^^^^^^ - **Fixed:** the parsing level of the Ltac2 tactic :tacn:`now` was set to level 6 in order to behave as it did before 8.14 (`#15250 `_, fixes `#15122 `_, by Pierre-Marie Pédrot). SSReflect ^^^^^^^^^ - **Changed:** rewrite generates subgoals in the expected order (side conditions first, by default) also when rewriting with a setoid relation (`#14314 `_, fixes `#5706 `_, by Enrico Tassi). - **Removed:** The ssrsearch plugin and the ssr Search command (`#13760 `_, by Jim Fehrle). - **Added:** port the additions made to `ssrbool.v` in math-comp `PR #757 `_, namely `reflect` combinators `negPP`, `orPP`, `andPP` and `implyPP` (`#15059 `_, by Christian Doczkal). - **Fixed:** SSR patterns now work with primitive values such as ints, floats or arrays (`#14660 `_, fixes `#12770 `_, by Juan Conejero). - **Fixed:** A bug where :tacn:`suff` would fail due to use of :tacn:`apply` under the hood (`#14687 `_, fixes `#14678 `_, by Ali Caglayan helped by Enrico Tassi). Commands and options ^^^^^^^^^^^^^^^^^^^^ .. _815Commands: - **Changed:** :cmd:`About` and :cmd:`Print` now display all known argument names (`#14596 `_, grants `#13830 `_, by Hugo Herbelin). - **Changed:** :cmd:`Typeclasses Transparent` and :cmd:`Typeclasses Opaque` support ``#[local]``, ``#[export]`` and ``#[global]`` attributes (`#14685 `_, fixes `#14513 `_, by Gaëtan Gilbert). - **Changed:** In extraction to OCaml, empty types in :n:`Type` (such as :n:`Empty_set`) are now extracted to an abstract type (empty by construction) rather than to the OCaml's :n:`unit` type (`#14802 `_, fixes a remark at `#14801 `_, by Hugo Herbelin). - **Changed:** Closed modules now live in a separate namespace from open modules and sections (`#15078 `_, fixes `#14529 `_, by Gaëtan Gilbert). - **Removed:** boolean attributes ``monomorphic``, ``noncumulative`` and ``notemplate`` that were replaced by ``polymorphic=no``, ``cumulative=no`` and ``template=no`` in 8.13 (`#14819 `_, by Pierre Roux). - **Removed:** command ``Grab Existential Variables`` that was deprecated in 8.13. Use :cmd:`Unshelve` that is mostly equivalent, up to the reverse order of the resulting subgoals (`#14819 `_, by Pierre Roux). - **Removed:** command ``Existential`` that was deprecated in 8.13. Use :cmd:`Unshelve` and :tacn:`exact` (`#14819 `_, by Pierre Roux). - **Removed:** the `-outputstate` command line argument and the corresponding vernacular commands `Write State` and `Restore State` (`#14940 `_, by Pierre-Marie Pédrot) - **Deprecated:** ambiguous :cmd:`Proof using` and :cmd:`Collection` usage (`#15056 `_, fixes `#13296 `_, by Wojciech Karpiel). - **Deprecated:** `Universal Lemma Under Conjunction` flag that was introduced for compatibility with Coq versions prior to 8.4 (`#15272 `_, by Théo Zimmermann). - **Deprecated:** using :cmd:`Hint Cut`, :cmd:`Hint Mode`, :cmd:`Hint Transparent`, :cmd:`Hint Opaque`, :cmd:`Typeclasses Transparent` or :cmd:`Typeclasses Opaque` without an explicit locality outside sections. (`#14697 `_, by Pierre-Marie Pédrot, and `#14685 `_, by Gaëtan Gilbert) - **Added:** The :flag:`Mangle Names Light` flag, which changes the behavior of :flag:`Mangle Names`. For example, the name `foo` becomes `_0` with :flag:`Mangle Names`, but with :flag:`Mangle Names Light` set, it will become `_foo` (`#14695 `_, fixes `#14548 `_, by Ali Caglayan). - **Added:** The :cmd:`Hint Cut`, :cmd:`Hint Mode`, :cmd:`Hint Transparent`, :cmd:`Hint Opaque`, :cmd:`Typeclasses Transparent` and :cmd:`Typeclasses Opaque` commands now accept the :attr:`local`, :attr:`export` and :attr:`global` locality attributes inside sections. With either attribute, the commands will trigger the `non-local-section-hint` warning if the arguments refer to local section variables (`#14697 `_, by Pierre-Marie Pédrot, and `#14685 `_, fixes `#14513 `_, by Gaëtan Gilbert). - **Added:** :attr:`projections(primitive)` attribute to make a record use primitive projections (`#14699 `_, fixes `#13150 `_, by Ali Caglayan). .. _815Import: - **Added:** Syntax for :token:`import_categories` providing selective import of module components (eg ``Import(notations) M`` (`#14892 `_, by Gaëtan Gilbert). - **Added:** :cmd:`Search` understands modifier ``in`` as an alias of ``inside`` (`#15139 `_, fixes `#14930 `_, by Gaëtan Gilbert). This is intended to ease transition for ssreflect Search users. - **Fixed:** interaction of Program's obligation state and modules and sections: obligations started in a parent module or section are not available to be solved until the submodules and subsections are closed (`#14780 `_, fixes `#14446 `_, by Gaëtan Gilbert). - **Fixed:** :cmd:`Eval` and :cmd:`Compute` now beta-iota-simplify the type of the result, like :cmd:`Check` does (`#14901 `_, fixes `#14899 `_, by Hugo Herbelin) Command-line tools ^^^^^^^^^^^^^^^^^^ - **Changed:** Coqdoc options ``--coqlib`` and ``--coqlib_path`` have been renamed to ``--coqlib_url`` and ``--coqlib`` to make them more consistent with flags used by other Coq executables (`#14059 `_, by Emilio Jesus Gallego Arias). - **Changed:** Syntax of `_CoqProject` files: `-arg` is now handled by :ref:`coq_makefile ` and not by `make`. Unquoted `#` now start line comments (`#14558 `_, by Stéphane Desarzens, with help from Jim Fehrle and Enrico Tassi). - **Changed:** :cmd:`Require` now selects files whose logical name exactly matches the required name, making it possible to unambiguously select a given file: if several :n:`-Q` or :n:`-R` options bind the same logical name to a different file, the option appearing last on the command line takes precedence. Moreover, it is now an error to require a file using a partial logical name which does not resolve to a non-ambiguous path (`#14718 `_, by Hugo Herbelin). - **Changed:** ``coq_makefile`` now declares variable ``COQBIN`` to avoid warnings in ``make --warn`` mode (`#14787 `_, by Clément Pit-Claudel). - **Changed:** ``coqchk`` respects the :flag:`Kernel Term Sharing` flag instead of forcing it on (`#14957 `_, by Gaëtan Gilbert) - **Removed:** These options of :ref:`coq_makefile `: `-extra`, `-extra-phony`, `-custom`, `-no-install`, `-install`, `-no-opt`, `-byte`. Support for subdirectories is also removed (`#14558 `_, by Stéphane Desarzens, with help from Jim Fehrle and Enrico Tassi). - **Added:** :ref:`coq_makefile ` now takes the `-docroot` option as alternative to the `INSTALLCOQDOCROOT` variable (`#14558 `_, by Stéphane Desarzens, with help from Jim Fehrle and Enrico Tassi). - **Fixed:** Various `coqdep` issues with the `From` clause of :cmd:`Require` and a few inconsistencies between `coqdep` and `coqc` disambiguation of :cmd:`Require` (`#14718 `_, fixes `#11631 `_ and `#14539 `_, by Hugo Herbelin). - **Fixed:** ``coq_makefile`` has improved logic when dealing with incorrect ``_CoqProject`` files (`#13541 `_, fixes `#9319 `_, by Fabian Kunze). - **Fixed:** ``coqdep`` was confusing periods occurring in comments with periods ending Coq sentences (`#14996 `_, fixes `#7393 `_, by Hugo Herbelin). CoqIDE ^^^^^^ - **Changed:** CoqIDE unicode keys for brackets (e.g. `\langle`) now bind to unicode mathematical symbols rather than unicode CJK brackets (`#14452 `_, by Bart Jacobs). - **Changed:** All occurrences of the name `CoqIde` to `CoqIDE`. This may cause issues with installing and uninstalling desktop icons, causing apparent duplicates (`#14696 `_, fixes `#14310 `_, by Ali Caglayan). .. _815LtacDebugger: - **Added:** Initial version of a visual debugger in CoqIDE. Supports setting breakpoints visually and jumping to the stopping point plus continue, step over, step in and step out operations. Displays the call stack and variable values for each stack frame. Currently only for Ltac. See the documentation :ref:`here ` (`#14644 `_, fixes `#13967 `_, by Jim Fehrle) - **Fixed:** It is now possible to deactivate the unicode completion mechanism in CoqIDE (`#14863 `_, by Pierre-Marie Pédrot). Standard library ^^^^^^^^^^^^^^^^ - **Changed:** Permutation-related Proper instances are now at default priority instead of priority ``10`` (`#14574 `_, fixes `#14571 `_, by Gaëtan Gilbert). - **Changed:** The new type of `epsilon_smallest` is `(exists n : nat, P n) -> { n : nat | P n /\ forall k, P k -> n <= k }`. Here the minimality of `n` is expressed by `forall k, P k -> n <= k` corresponding to the intuitive meaning of minimality "the others are greater", whereas the previous version used the negative equivalent formulation `forall k, k < n -> ~P k`. Scripts using `epsilon_smallest` can easily be adapted using lemmas `le_not_lt` and `lt_not_le` from the standard library (`#14601 `_, by Jean-Francois Monin). - **Changed:** ``ltb`` and ``leb`` functions for ``ascii``, into comparison-based definition (`#14234 `_, by Yishuai Li). - **Removed:** the file ``Numeral.v`` that was replaced by ``Number.v`` in 8.13 (`#14819 `_, by Pierre Roux). - **Removed:** some ``*_invol`` functions that were renamed ``*_involutive`` for consistency with the remaining of the stdlib in 8.13 (`#14819 `_, by Pierre Roux). - **Deprecated:** ``frexp`` and ``ldexp`` in `FloatOps.v`, renamed ``Z.frexp`` and ``Z.ldexp`` (`#15085 `_, by Pierre Roux). - **Added:** A proof that incoherent equivalences can be adjusted to adjoint equivalences in ``Logic.Adjointification`` (`#13408 `_, by Jasper Hugunin). - **Added:** ``ltb`` and ``leb`` functions for ``string``, and some lemmas about them; - **Added:** simple non dependent product ``slexprod`` in ``Relations/Relation_Operators.v`` and its proof of well-foundness ``wf_slexprod`` in ``Wellfounded/Lexicographic_Product.v`` (`#14809 `_, by Laurent Thery). - **Added:** The notations ``(x; y)``, ``x.1``, ``x.2`` for sigT are now exported and available after ``Import SigTNotations.`` (`#14813 `_, by Laurent Théry). - **Added:** The function ``sigT_of_prod`` turns a pair ``A * B`` into ``{_ : A & B}``. Its inverse function is ``prod_of_sigT``. This is shown by theorems ``sigT_prod_sigT`` and ``prod_sigT_prod`` (`#14813 `_, by Laurent Théry). - **Fixed:** ``split_combine`` lemma for lists, making it usable (`#14458 `_, by Yishuai Li). Infrastructure and dependencies ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ - **Changed:** Coq's continuous integration now provides a more accessible Windows installer artifact in the "Checks" GitHub tab, both for pull requests and the `master` branch. This facilitates testing Coq's bleeding edge builds on Windows, and should be more reliable than the previous setup (`#12425 `_, by Emilio Jesus Gallego Arias). - **Changed:** Coq's ``./configure`` script has gone through a major cleanup. In particular, the following options have been removed: - ``-force-caml-version``, ``-force-findlib-version``: Coq won't compile with OCaml or findlib lower than the required versions; - ``-vmbyteflags``, ``-custom``, ``-no-custom``: linking options for toplevels are now controlled in ``topbin/dune``; - ``-ocamlfind``: Coq will now use the toolchain specified in the Dune configuration; this can be controlled using the workspaces feature; - ``-nodebug``: Coq will now follow the standard, which is to always pass ``-g`` to OCaml; this can be modified using a custom Dune workspace; - ``-flambda-opts``: compilation options are now set in Coq's root ``dune`` file, can be updated using a custom Dune workspace; - ``-local``, ``-bindir``, ``-coqdocdir``, ``-annotate``, ``-camldir``, ``-profiling``: these flags were deprecated in 8.14, and are now removed. Moreover, the ``-annot`` and ``-bin-annot`` flags only take effect to set ``coq-makefile``'s defaults (`#14189 `_, by Emilio Jesus Gallego Arias). - **Changed:** Configure will now detect the Dune version, and will correctly pass ``-etcdir`` and ``-docdir`` to the install procedure if Dune >= 2.9 is available. Note that the ``-docdir`` configure option now refers to root path for documentation. If you would like to install Coq documentation in ``foo/coq``, use ``-docdir foo`` (`#14844 `_, by Emilio Jesus Gallego Arias). - **Changed:** OCaml 4.13 is now officially supported (`#14879 `_, by Emilio Jesus Gallego Arias) - **Changed:** Sphinx 3.0.2 or above is now required to build the reference manual (`#14963 `_, by Théo Zimmermann) Extraction ^^^^^^^^^^ - **Changed:** replaced ``Big`` module with ``Big_int_Z`` functions from ``zarith``. OCaml code extracted with the following modules should be linked to the `Zarith `_ library. + ``ExtrOcamlNatBigInt`` + ``ExtrOcamlZBigInt`` Removed ``ExtrOcamlBigIntConv`` module. (`#8252 `_, by Yishuai Li). - **Fixed:** compilation errors in ExtrOcamlString and ExtrOcamlNativeString (`#15075 `_, fixes `#15076 `_, by Yishuai Li). Changes in 8.15.1 ~~~~~~~~~~~~~~~~~ .. contents:: :local: Kernel ^^^^^^ - **Fixed:** cases of incompletenesses in the guard condition for fixpoints in the presence of cofixpoints or primitive projections (`#15498 `_, fixes `#15451 `_, by Hugo Herbelin). - **Fixed:** inconsistency when using module subtyping with squashed inductives (`#15839 `_, fixes `#15838 `_ (reported by Pierre-Marie Pédrot), by Gaëtan Gilbert). Notations ^^^^^^^^^ - **Fixed:** Check for prior declaration of a custom entry was missing for notations in only printing mode (`#15628 `_, fixes `#15619 `_, by Hugo Herbelin). Tactics ^^^^^^^ - **Fixed:** :tacn:`rewrite_strat` regression in 8.15.0 related to `Transitive` instances (`#15577 `_, fixes `#15568 `_, by Gaëtan Gilbert). - **Fixed:** When :tacn:`setoid_rewrite` succeeds in rewriting at some occurrence but the resulting equality is the identity, it now tries rewriting in subterms of that occurrence instead of giving up (`#15612 `_, fixes `#8080 `_, by Gaëtan Gilbert). - **Fixed:** Ill-typed goals created by :tacn:`clearbody` in the presence of transitive dependencies in the body of a hypothesis (`#15634 `_, fixes `#15606 `_, by Hugo Herbelin). - **Fixed:** :tacn:`cbn` knows to refold fixpoints when :cmd:`Arguments` with ``/`` and ``!`` was used (`#15653 `_, fixes `#15567 `_, by Gaëtan Gilbert). Command-line tools ^^^^^^^^^^^^^^^^^^ - **Fixed:** a bug where :n:`coqc -vok` was not creating an empty '.vok' file (`#15745 `_, by Ramkumar Ramachandra). CoqIDE ^^^^^^ - **Fixed:** Line numbers shown in the Errors panel were incorrect; they didn't match the error locations in the script panel (`#15532 `_, fixes `#15531 `_, by Jim Fehrle). - **Fixed:** anomaly when using proof diffs with no focused goal (`#15633 `_, fixes `#15578 `_, by Jim Fehrle). - **Fixed:** Attempted edits to the processed part of a buffer while Coq is busy processing a request are now ignored to ensure "processed" highlighting is accurate (`#15714 `_, fixes `#15733 `_ and `#15675 `_ and `#15725 `_, by Jim Fehrle). Miscellaneous ^^^^^^^^^^^^^ - **Fixed:** Ensure that the names of arguments of inductive schemes are distinct so that the new Coq 8.15 preservation of argument names in the ``with`` clause of tactics in `#13837 `_ works as in Coq 8.14 for these schemes (`#15537 `_, fixes `#15420 `_, by Hugo Herbelin). Changes in 8.15.2 ~~~~~~~~~~~~~~~~~ .. contents:: :local: Tactics ^^^^^^^ - **Added:** :tacn:`intuition` and :tacn:`dintuition` use ``Tauto.intuition_solver`` (defined as ``auto with *``) instead of hardcoding ``auto with *``. This makes it possible to change the default solver with ``Ltac Tauto.intuition_solver ::= ...`` (`#15866 `_, fixes `#7725 `_, by Gaëtan Gilbert). - **Fixed:** uncaught exception ``UnableToUnify`` with bidirectionality hints (`#16066 `_, fixes `#16063 `_, by Gaëtan Gilbert). CoqIDE ^^^^^^ - **Fixed:** multiple CoqIDE bugs (`#15938 `_, fixes `#15861 `_, `#15939 `_, fixes `#15882 `_, `#15964 `_, fixes `#15799 `_, `#15984 `_, partially fixes `#15873 `_, `#15996 `_, `#15912 `_, fixes `#15903 `_, all by Jim Fehrle). Standard library ^^^^^^^^^^^^^^^^ - **Fixed:** an incorrect implementation of SFClassify, allowing for a proof of False since 8.11.0, due to Axioms present in Float.Axioms (`#16101 `_, fixes `#16096 `_, by Ali Caglayan). Version 8.14 ------------ Summary of changes ~~~~~~~~~~~~~~~~~~ Coq version 8.14 integrates many usability improvements, as well as an important change in the core language. The main changes include: - The :ref:`internal representation <814CaseRepresentation>` of `match` has changed to a more space-efficient and cleaner structure, allowing the fix of a completeness issue with cumulative inductive types in the type-checker. The internal representation is now closer to the user-level view of `match`, where the argument context of branches and the inductive binders `in` and `as` do not carry type annotations. - A :ref:`new <814CoqNative>` `coqnative` binary performs separate native compilation of libraries, starting from a `.vo` file. It is supported by `coq_makefile`. - :ref:`Improvements <814TCCanon>` to typeclasses and canonical structure resolution, allowing more terms to be considered as classes or keys. - More control over :ref:`notations <814Notations>` declarations and support for primitive types in string and number notations. - :ref:`Removal <814Tactics>` of deprecated tactics, notably `omega`, which has been replaced by a greatly improved `lia`, along with many bug fixes. - New :ref:`Ltac2 <814Ltac2>` APIs for interaction with Ltac1, manipulation of inductive types and printing. - Many :ref:`changes and additions <814Stdlib>` to the standard library in the numbers, vectors and lists libraries. A new signed primitive integers library `Sint63` is available in addition to the unsigned `Uint63` library. See the `Changes in 8.14.0`_ section below for the detailed list of changes, including potentially breaking changes marked with **Changed**. Coq's `reference manual `_, `documentation of the standard library `_ and `developer documentation of the ML API `_ are also available. 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 `_ that are used in many Coq projects for continuous integration. The opam repository for Coq packages has been maintained by 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/. The `Coq Platform `_ has been maintained by Michael Soegtrop and Enrico Tassi. Our current maintainers are Yves Bertot, Frédéric Besson, Ali Caglayan, Tej Chajed, Cyril Cohen, Pierre Corbineau, Pierre Courtieu, Maxime Dénès, Jim Fehrle, Julien Forest, Emilio Jesús Gallego Arias, Gaëtan Gilbert, Georges Gonthier, Benjamin Grégoire, Jason Gross, Hugo Herbelin, Vincent Laporte, Olivier Laurent, Assia Mahboubi, Kenji Maillard, Guillaume Melquiond, Pierre-Marie Pédrot, Clément Pit-Claudel, Pierre Roux, Kazuhiko Sakaguchi, Vincent Semeria, Michael Soegtrop, Arnaud Spiwack, Matthieu Sozeau, Enrico Tassi, Laurent Théry, Anton Trunov, Li-yao Xia and Théo Zimmermann. See the `Coq Team face book `_ page for more details. The 54 contributors to this version are Reynald Affeldt, Arthur Azevedo de Amorim, Yves Bertot, Frédéric Besson, Lasse Blaauwbroek, Ana Borges, Ali Caglayan, Cyril Cohen, Pierre Courtieu, Maxime Dénès, Stéphane Desarzens, Andrej Dudenhefner, Jim Fehrle, Yannick Forster, Simon Friis Vindum, Gaëtan Gilbert, Jason Gross, Samuel Gruetter, Stefan Haan, Hugo Herbelin, Jasper Hugunin, Emilio Jesús Gallego Arias, Jacques-Henri Jourdan, Ralf Jung, Jan-Oliver Kaiser, Fabian Kunze, Vincent Laporte, Olivier Laurent, Yishuai Li, Barry M. Trager, Kenji Maillard, Erik Martin-Dorel, Guillaume Melquiond, Isaac Oscar Gariano, Pierre-Marie Pédrot, Rudy Peterson, Clément Pit-Claudel, Pierre Roux, Takafumi Saikawa, Kazuhiko Sakaguchi, Gabriel Scherer, Vincent Semeria, shenlebantongying, Avi Shinnar, slrnsc, Michael Soegtrop, Matthieu Sozeau, Enrico Tassi, Hendrik Tews, Anton Trunov, Karolin Varner, Li-yao Xia, Beta Ziliani and Théo Zimmermann. The Coq community at large helped 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 `_ and the `Coq Zulip chat `_. Version 8.14's development spanned 9 months from the release of Coq 8.13.0. Guillaume Melquiond is the release manager of Coq 8.14. This release is the result of 522 merged PRs, closing ~150 issues. | Nantes, September 2021, | Matthieu Sozeau for the Coq development team Changes in 8.14.0 ~~~~~~~~~~~~~~~~~ .. contents:: :local: Kernel ^^^^^^ .. _814CaseRepresentation: - **Changed:** The term representation of pattern-matchings now uses a compact form that provides a few static guarantees such as eta-expansion of branches and return clauses and is usually more efficient. The most visible user change is that for the time being, the :tacn:`destruct` tactic and its variants generate dummy cuts (β redexes) in the branches of the generated proof. This can also generate very uncommon backwards incompatibilities, such as a change of occurrence numbering for subterms, or breakage of unification in complex situations involving pattern-matchings whose underlying inductive type declares let-bindings in parameters, arity or constructor types. For ML plugin developers, an in-depth description of the new representation, as well as porting tips, can be found in dev/doc/case-repr.md (`#13563 `_, fixes `#3166 `_, by Pierre-Marie Pédrot). - **Changed:** Linking of native-code libraries used by :tacn:`native_compute` is now delayed until an actual call to the :tacn:`native_compute` machinery is performed. This should make Coq more responsive on some systems (`#13853 `_, fixes `#13849 `_, by Guillaume Melquiond). - **Removed:** The ability to change typing flags inside sections to prevent exploiting a weakness in :cmd:`Print Assumptions` (`#14395 `_, fixes `#14317 `_, by Gaëtan Gilbert). Specification language, type inference ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ .. _814TCCanon: - **Changed:** The hints mode ``!`` matches a term iff the applicative head is not an existential variable. It now also matches projections applied to any term or a `match` on any term (`#14392 `_, by Matthieu Sozeau). - **Removed:** The little used `:>` type cast, which was only interpreted in Program-mode (`#13911 `_, by Jim Fehrle and Théo Zimmermann). - **Added:** Enable canonical `fun _ => _` projections, see :ref:`canonicalstructures` for details (`#14041 `_, by Jan-Oliver Kaiser and Pierre Roux, reviewed by Cyril Cohen and Enrico Tassi). - **Added:** :cmd:`Canonical Structure` declarations now accept dependent function types `forall _, _` as keys (`#14386 `_, by Jan-Oliver Kaiser and Kazuhiko Sakaguchi). - **Added:** Ability to declare primitive projections as class, for dependent typeclass resolutions (`#9711 `_, fixes `#12975 `_, by Matthieu Sozeau). - **Fixed:** Multiple printing of same warning about unused variables catching several cases (`#14261 `_, fixes `#14207 `_, by Hugo Herbelin). - **Fixed:** Constants :g:`id` and :g:`not` were unduly set opaque in some parts of the unification algorithm (`#14371 `_, fixes `#14374 `_, by Hugo Herbelin). Notations ^^^^^^^^^ .. _814Notations: - **Changed:** Flag :flag:`Printing Notations` no longer controls whether strings and numbers are printed raw (`#13840 `_, by Enrico Tassi). - **Changed:** The error ``Argument X was previously inferred to be in scope XXX_scope but is here used in YYY_scope.`` is now the warning ``[inconsistent-scopes,syntax]`` and can be silenced by specifying the scope of the argument (`#13965 `_, by Enrico Tassi). - **Removed:** Decimal-only number notations which were deprecated in 8.12 (`#13842 `_, by Pierre Roux). - **Added:** :cmd:`Number Notation` and :cmd:`String Notation` now support parsing and printing of primitive floats, primitive arrays and type constants of primitive types (`#13519 `_, fixes `#13484 `_ and `#13517 `_, by Fabian Kunze, with help of Jason Gross) - **Added:** Flag :flag:`Printing Raw Literals` to control whether strings and numbers are printed raw (`#13840 `_, by Enrico Tassi). - **Added:** Let the user specify a scope for abbreviation arguments, e.g. ``Notation abbr X := t (X in scope my_scope)`` (`#13965 `_, by Enrico Tassi). - **Added:** Look-ahead of tokens is changed from sequential to tree-based, allowing more automatic rule factorizations in notations (`#14070 `_, by Hugo Herbelin). - **Fixed:** Non-local custom entries survive module closing and are declared when a file is Required (`#14183 `_, fixes `#13654 `_, by Gaëtan Gilbert). - **Fixed:** :g:`ident` modifier in custom entry notations gave fatal errors at printing time (`#14257 `_, fixes `#14211 `_, by Hugo Herbelin). - **Fixed:** Anomaly when overriding a notation with different applicability in :g:`match` patterns (`#14377 `_, fixes `#13966 `_, by Hugo Herbelin). Tactics ^^^^^^^ .. _814Tactics: - **Changed:** More systematic checks that occurrences of an :n:`at` clause are valid in tactics such as :tacn:`rewrite` or :tacn:`pattern` (`#13568 `_, fixes `#13566 `_, by Hugo Herbelin). - **Removed:** :tacn:`fail` and :tacn:`gfail`, which formerly accepted negative values as a parameter, now give syntax errors for negative values (`#13469 `_, by Jim Fehrle). - **Removed:** Deprecated flag ``Bracketing Last Introduction Pattern`` affecting the behavior of trailing disjunctive introduction patterns is definitively removed (`#13509 `_, by Hugo Herbelin). - **Removed:** The `omega` tactic (deprecated in 8.12) and four `* Omega *` flags. Use `lia` instead (`#13741 `_, by Jim Fehrle, who addressed the final details, building on much work by Frédéric Besson, who greatly improved :tacn:`lia`, Maxime Dénès, Vincent Laporte and with the help of many package maintainers, among others). - **Removed:** convert_concl_no_check. Use :tacn:`change_no_check` instead (`#13761 `_, by Jim Fehrle). - **Removed:** double induction tactic. Replace :n:`double induction @ident @ident` with :n:`induction @ident; induction @ident` (or :n:`induction @ident ; destruct @ident` depending on the exact needs). Replace :n:`double induction @natural__1 @natural__2` with :n:`induction @natural__1; induction natural__3` where :n:`natural__3` is the result of :n:`natural__2 - natural__1` (`#13762 `_, by Jim Fehrle). - **Deprecated:** In :tacn:`change` and :tacn:`change_no_check`, the `at ... with ...` form is deprecated. Use `with ... at ...` instead. For `at ... with ... in H |-`, use `with ... in H at ... |-` (`#13696 `_, by Jim Fehrle). - **Deprecated:** The micromega option `Simplex`, which is currently set by default (`#13781 `_, by Frédéric Besson). - **Deprecated:** the undocumented `new auto` tactic (`#14528 `_, by Pierre-Marie Pédrot). - **Added:** :tacn:`lia` supports the boolean operator `Bool.implb` (`#13715 `_, by Frédéric Besson). - **Added:** ``zify`` (``lia``/``nia``) support for :g:`div`, :g:`mod`, :g:`pow` for :g:`Nat` (via ``ZifyNat`` module) and :g:`N` (via ``ZifyN`` module). The signature of :g:`Z_div_mod_eq_full` has no assumptions (`#14037 `_, fixes `#11447 `_, by Andrej Dudenhefner, Jason Gross, and Frédéric Besson). - **Added:** Ltac2 now has a `unify` tactic (`#14089 `_, fixes `#14083 `_, by Samuel Gruetter). - **Added:** :tacn:`inversion_sigma` can now be applied to a specified hypothesis and additionally supports intropatterns, so it can be used much like :tacn:`induction` and :tacn:`inversion`. Additionally, :tacn:`inversion_sigma` now supports the types :n:`ex` (:n:`exists x : A, P x`) and :n:`ex2` (:n:`exists2 x : A, P x & Q x`) in cases where the first argument :n:`A` is a :n:`Prop` (`#14174 `_, by Jason Gross). - **Added:** ``zify`` (``lia``/``nia``) support for ``Sint63`` (`#14408 `_, by Ana Borges, with help from Frédéric Besson). - **Fixed:** Possible collision between a user-level name and an internal name when using the :n:`%` introduction pattern (`#13512 `_, fixes `#13413 `_, by Hugo Herbelin). - **Fixed:** :tacn:`simpl` and :tacn:`hnf` now reduce primitive functions on primitive integers, floats and arrays (`#13699 `_, fixes `#13579 `_, by Pierre Roux). - **Fixed:** Setoid rewriting now remembers the (invisible) binder names of non-dependent product types. SSReflect's rewrite tactic expects these names to be retained when using ``rewrite foo in H``. This also fixes SSR ``rewrite foo in H *`` erroneously reverting ``H`` (`#13882 `_, fixes `#12011 `_, by Gaëtan Gilbert). - **Fixed:** Properly expand projection parameters in hint discrimination nets. (`#14033 `_, fixes `#9000 `_, `#14009 `_, by Pierre-Marie Pédrot). - **Fixed:** anomalies caused by empty strings in Ltac notations are now errors (`#14378 `_, fixes `#14124 `_, by Hugo Herbelin). - **Fixed:** Print a message instead of a Diff_Failure anomaly when old and new goals can't be matched; show the goal without diff highlights (`#14457 `_, fixes `#14425 `_, by Jim Fehrle). - **Fixed:** Anomaly of :tacn:`destruct` on terms with dependent variables unused in goal (`#15099 `_, fixes `#11504 `_ and `#14090 `_, by Lasse Blaauwbroek and Hugo Herbelin). - **Fixed:** Correct convertibility of multiple terms selected by patterns in tactics such as :tacn:`set` when these terms have subterms in `SProp` (`#14610 `_, fixes `#14609 `_, by Hugo Herbelin). Tactic language ^^^^^^^^^^^^^^^ .. _814Ltac2: - **Changed:** Renamed Ltac2 ``Bool.eq`` into ``Bool.equal`` for uniformity. The old function is now a deprecated alias (`#14128 `_, by Pierre-Marie Pédrot). - **Added:** A ``printf`` macro to Ltac2. It can be made accessible by importing the ``Ltac2.Printf`` module. See the documentation there for more information (`#13236 `_, fixes `#10108 `_, by Pierre-Marie Pédrot). - **Added:** A function ``Ltac1.lambda`` allowing to embed Ltac2 functions into Ltac1 runtime values (`#13442 `_, fixes `#12871 `_, by Pierre-Marie Pédrot). - **Added:** Ltac2 commands defining terms now accept the :attr:`deprecated` attribute (`#13774 `_, fixes `#12317 `_, by Pierre-Marie Pédrot). - **Added:** Allow the presence of type casts for function return values, let bindings and global definitions in Ltac2 (`#13914 `_, by Pierre-Marie Pédrot). - **Added:** The Ltac2 API `Ltac2.Ind` for manipulating inductive types (`#13920 `_, fixes `#10095 `_, by Pierre-Marie Pédrot). - **Added:** Allow scope delimiters in Ltac2 ``open_constr:(...)`` quotation (`#13939 `_, fixes `#12806 `_, by Pierre-Marie Pédrot). - **Added:** A FFI to convert between Ltac1 and Ltac2 identifiers (`#13997 `_, fixes `#13996 `_, by Pierre-Marie Pédrot). - **Added:** Lazy evaluating boolean operators ``lazy_and``, ``lazy_or``, ``lazy_impl`` and infix notations ``&&`` and ``||`` to the Ltac2 `Bool.v` library l (`#14081 `_, fixes `#13964 `_, by Michael Soegtrop). - **Fixed:** Ltac2 notations now correctly take into account their assigned level (`#14094 `_, fixes `#11866 `_, by Pierre-Marie Pédrot). SSReflect ^^^^^^^^^ - **Added:** A test that the notations `{in _, _}` and `{pred _}` from `ssrbool.v` are displayed correctly (`#13473 `_, by Cyril Cohen). - **Added:** Lemmas about interaction between :n:`{in _, _}`, :n:`{on _, _}`, and :n:`sig` have been backported from Mathematical Components 1.12.0 (`#13490 `_, by Kazuhiko Sakaguchi). Commands and options ^^^^^^^^^^^^^^^^^^^^ - **Changed:** :cmd:`Hint Rewrite` now supports locality attributes (including :attr:`export`) like other :ref:`Hint ` commands (`#13725 `_, fixes `#13724 `_, by Gaëtan Gilbert). - **Changed:** In :cmd:`Record`, alpha-rename the variable associated with the record to avoid alpha-renaming parameters of projections (`#13852 `_, fixes `#13727 `_, by Li-yao Xia). - **Changed:** Improve the :cmd:`Coercion` command to reduce the number of ambiguous paths to report. A pair of multiple inheritance paths that can be reduced to smaller adjoining pairs will not be reported as ambiguous paths anymore (`#13909 `_, by Kazuhiko Sakaguchi). - **Changed:** The printing order of :cmd:`Print Classes` and :cmd:`Print Graph`, due to the changes for the internal tables of coercion classes and coercion paths (`#13912 `_, by Kazuhiko Sakaguchi). - **Removed:** The Hide Obligations flag, deprecated in 8.12 (`#13758 `_, by Jim Fehrle). - **Removed:** SearchHead command. Use the `headconcl:` clause of :cmd:`Search` instead (`#13763 `_, by Jim Fehrle). - **Removed:** `Show Zify Spec`, `Add InjTyp` and 11 similar `Add *` commands. For `Show Zify Spec`, use `Show Zify UnOpSpec` or `Show Zify BinOpSpec` instead. For `Add *`, `Use Add Zify *` intead of `Add *` (`#13764 `_, by Jim Fehrle). - **Deprecated:** Like hints, typeclass instances added outside of sections without an explicit locality now generate a deprecation warning. See :ref:`Hint ` (`#14208 `_, fixes `#13562 `_, by Pierre-Marie Pédrot). - **Deprecated:** the :flag:`Regular Subst Tactic` flag (`#14336 `_, by Pierre-Marie Pédrot). - **Added:** :opt:`Debug` to control debug messages, functioning similarly to the warning system (`#13202 `_, by Maxime Dénès and Gaëtan Gilbert). The following flags have been converted (such that ``Set Flag`` becomes ``Set Debug "flag"``): - ``Debug Unification`` to ``unification`` - ``Debug HO Unification`` to ``ho-unification`` - ``Debug Tactic Unification`` to ``tactic-unification`` - ``Congruence Verbose`` to ``congruence`` - ``Debug Cbv`` to ``cbv`` - ``Debug RAKAM`` to ``RAKAM`` - ``Debug Ssreflect`` to ``ssreflect`` - **Added:** The Ltac2 grammar can now be printed using the Print Grammar ltac2 command (`#14093 `_, fixes `#14092 `_, by Pierre-Marie Pédrot). - **Added:** :cmd:`Instance` now accepts the :attr:`export` locality attribute (`#14148 `_, by Pierre-Marie Pédrot). - **Fixed:** extraction failure of a parameterized type in :g:`Prop` exported in an module interface as an assumption in :g:`Type` (`#14102 `_, fixes `#14100 `_, by Hugo Herbelin). - **Fixed:** Print Assumptions now treats delayed opaque proofs generated by vos compilation as if they were axioms (`#14382 `_, fixes `#13589 `_, by Pierre-Marie Pédrot). - **Fixed:** Incorrect de Bruijn index handling in vernac class declaration, preventing users from marking existing instances of existing classes which are primitive projections (`#14664 `_, fixes `#14652 `_, by Ali Caglayan and Hugo Herbelin). Command-line tools ^^^^^^^^^^^^^^^^^^ - **Changed:** `coqc` now enforces that at most a single `.v` file can be passed in the command line. Support for multiple `.v` files in the form of `coqc f1.v f2.v` didn't properly work in 8.13, tho it was accepted (`#13876 `_, by Emilio Jesus Gallego Arias). - **Changed:** ``coqdep`` now reports an error if files specified on the command line don't exist or if it encounters unreadable files. Unknown options now generate a warning. Previously these conditions were ignored (`#14024 `_, fixes `#14023 `_, by Hendrik Tews). - **Changed:** Makefiles produced by ``coq_makefile`` now use ``.DELETE_ON_ERROR`` (`#14238 `_, by Gaëtan Gilbert). - **Removed:** Previously deprecated command line options ``-sprop-cumulative`` and ``-input-state`` and its alias ``-is`` (`#13822 `_, by Gaëtan Gilbert). - **Added:** ``coq_makefile``\-made ``Makefile``\s now support inclusion of a ``.local-late`` file at the end, allowing the user to access more variables (`#12411 `_, fixes `#10912 `_, by Jason Gross). - **Fixed:** Failure of extraction in the presence of inductive types with local definitions in parameters (`#13624 `_, fixes `#13581 `_, by Hugo Herbelin). - **Fixed:** File name was missing in coqdoc error position reporting (`#14285 `_, fixes `#14283 `_, by Arthur Charguéraud and Hugo Herbelin). Native Compilation ^^^^^^^^^^^^^^^^^^ .. _814CoqNative: - **Changed:** `coq_makefile` now uses the `coqnative` binary to generate native compilation files. Project files also understand directly the `-native-compiler` flag without having to wrap it with `-arg` (`#14265 `_, by Pierre-Marie Pédrot). - **Deprecated:** the `-native-compiler` option for coqc. It is now recommended to use the :ref:`coqnative` binary instead to generate native compilation files ahead of time (`#14309 `_, by Pierre-Marie Pédrot). - **Added:** A standalone `coqnative` binary that performs native compilation out of `vo` files, allowing to split library compilation from native compilation. See :ref:`coqnative`. The hybrid build system was adapted to perform a split compilation on the stdlib (`#13287 `_, by Pierre-Marie Pédrot). CoqIDE ^^^^^^ .. _814CoqIDE: - **Added:** Ltac debugger support in CoqIDE (see :flag:`Ltac Debug`). Debugger output and prompts appear in the Messages panel (`#13783 `_, by Jim Fehrle and Emilio J. Gallego Arias). - **Added:** Shift-return in the Find dialog now searches backwards (`#13810 `_, by slrnsc). Standard library ^^^^^^^^^^^^^^^^ .. _814Stdlib: - **Changed:** Minor Changes to ``Rpower``: Generalizes ``exp_ineq1`` to hold for all non-zero numbers. Adds ``exp_ineq1_le``, which holds for all reals (but is a ``<=`` instead of a ``<``) (`#13582 `_, by Avi Shinnar and Barry Trager, with help from Laurent Théry). - **Changed:** set :g:`n mod 0 = n` uniformly for :g:`nat`, :g:`N`, :g:`Z`, :g:`int63`, :g:`sint63`, :g:`int31` such that :g:`m = (m / n) * n + (m mod n)` holds (also for :g:`n = 0`) .. warning:: code that relies on :g:`n mod 0 = 0` will break; for compatibility with both :g:`n mod 0 = n` and :g:`n mod 0 = 0` you can use :g:`n mod 0 = ltac:(match eval hnf in (1 mod 0) with |0 => exact 0 |_ => exact n end)` (`#14086 `_, by Andrej Dudenhefner with help of Guillaume Melquiond, Jason Gross, and Kazuhiko Sakaguchi). - **Changed:** The standard library now contains a more complete theory of equality on types of the form :g:`exists x : A, P x` and :g:`exists2 x : A, P x & Q x` when we have :g:`A : Prop`. To bring this theory more in line with the existing theory about sigma types, :g:`eq_ex_uncurried`, :g:`eq_ex2_uncurried`, :g:`eq_ex`, :g:`eq_ex2`, :g:`eq_ex_hprop`, :g:`eq_ex2_hprop` have been renamed into :g:`eq_ex_intro_uncurried`, :g:`eq_ex_intro2_uncurried`, :g:`eq_ex_intro`, :g:`eq_ex_intro2`, :g:`eq_ex_intro_hprop`, :g:`eq_ex_intro2_hprop` respectively and the implicit status of these lemmas has changed slightly (`#14174 `_, by Jason Gross). - **Changed** Moved 39 lemmas and notations about the rationals `Q` from the constructive reals private file `theories/Reals/Cauchy/QExtra.v` to appropriate files in `theories/QArith`. The now public lemmas are mostly about compatibility of multiplication and power with relational operators and simple convenience lemmas e.g. for reduction of `Q` values. The following moved lemmas have been renamed: `Q_factorDenom` to `Qmult_frac_l`, `Q_reduce_fl` to `Qreduce_num_l`, `Qle_neq` to `Qlt_leneq`, `Qmult_lt_le_compat_nonneg` to `Qmult_le_lt_compat_pos`, `Qpower_pos_lt` to `Qpower_0_lt`, `Qpower_lt_1_increasing` to `Qpower_1_lt_pos`, `Qpower_lt_1_increasing'` to `Qpower_1_lt`, `Qpower_le_1_increasing` to `Qpower_1_le_pos`, `Qpower_le_1_increasing'` to `Qpower_1_le`, `Qzero_eq` to `Qreduce_zero`, `Qpower_lt_compat` to `Qpower_lt_compat_l`, `Qpower_le_compat` to `Qpower_le_compat_l`, `Qpower_lt_compat_inv` to `Qpower_lt_compat_l_inv`, `Qpower_le_compat_inv` to `Qpower_le_compat_l_inv`, `Qpower_decomp'` to `Qpower_decomp_pos` and `QarchimedeanExp2_Pos` to `Qarchimedean_power2_pos`. The following lemmas have been renamed and the sides of the equality swapped: `Qinv_swap_pos` to `Qinv_pos`, `Qinv_swap_neg` to `Qinv_neg` and. The following lemmas have been deleted: `Q_factorNum_l` and `Q_factorNum`. The lemma `Qopp_lt_compat` has been moved from `theories/QArith/Qround.v` to `theories/QArith/QArith_base.v`. About 10 additional lemmas have been added for similar cases as the moved lemmas. Compatibility notations are not provided because QExtra is considered internal (excluded from the library documentation) (`#14293 `_, by Michael Soegtrop). - **Changed:** Importing `ZArith` no longer has the side-effect of closing `Z_scope` (`#14343 `_, fixes `#13307 `_, by Ralf Jung). - **Removed:** ``IF_then_else`` definition and corresponding ``IF P then Q else R`` notation (`#13871 `_, by Yishuai Li). - **Removed:** from ``List.v`` deprecated/unexpected dependencies ``Setoid``, ``Le``, ``Gt``, ``Minus``, ``Lt`` (`#13986 `_, by Andrej Dudenhefner). - **Deprecated:** Unsigned primitive integers are now named ``uint63`` instead of ``int63``. The ``Int63`` module is replaced by ``Uint63``. The full list of changes is described in the PR (`#13895 `_, by Ana Borges). - **Added:** ``leb`` and ``ltb`` functions for ``ascii`` (`#13080 `_, by Yishuai Li). - **Added:** Library for signed primitive integers, Sint63. The following operations were added to the kernel: division, remainder, comparison functions, and arithmetic shift right. Everything else works the same for signed and unsigned ints (`#13559 `_, fixes `#12109 `_, by Ana Borges, Guillaume Melquiond and Pierre Roux). - **Added:** Lemmas about vectors related with ``to_list``: ``length_to_list``, ``of_list_to_list_opp``, ``to_list_nil``, ``to_list_cons``, ``to_list_hd``, ``to_list_last``, ``to_list_const``, ``to_list_nth_order``, ``to_list_tl``, ``to_list_append``, ``to_list_rev_append_tail``, ``to_list_rev_append``, ``to_list_rev``, ``to_list_map``, ``to_list_fold_left``, ``to_list_fold_right``, ``to_list_Forall``, ``to_list_Exists``, ``to_list_In``, ``to_list_Forall2`` (`#13671 `_, by Olivier Laurent). - **Added:** Lemmas about ``count_occ``: ``count_occ_app``, ``count_occ_elt_eq``, ``count_occ_elt_neq``, ``count_occ_bound``, ``count_occ_repeat_eq``, ``count_occ_repeat_neq``, ``count_occ_unique``, ``count_occ_repeat_excl``, ``count_occ_sgt``, ``Permutation_count_occ`` (`#13804 `_, by Olivier Laurent with help of Jean-Christophe Léchenet). - **Added:** Lemmas to ``List``: ``Exists_map``, ``Exists_concat``, ``Exists_flat_map``, ``Forall_map``, ``Forall_concat``, ``Forall_flat_map``, ``nth_error_map``, ``nth_repeat``, ``nth_error_repeat`` (`#13955 `_, by Andrej Dudenhefner, with help from Olivier Laurent). - **Added:** ``Cantor.v`` containing the Cantor pairing function and its inverse. ``Cantor.to_nat : nat * nat -> nat`` and ``Cantor.of_nat : nat -> nat * nat`` are the respective bijections between ``nat * nat`` and ``nat`` (`#14008 `_, by Andrej Dudenhefner). - **Added:** Lemmas to ``Q``: ``Qeq_from_parts``, ``Qden_cancel``, ``Qnum_cancel``, ``Qreduce_l``, ``Qreduce_r``, ``Qmult_inject_Z_l``, ``Qmult_inject_Z_r`` QArith_base Reduction of rationals; establishing equality for Qden/Qnum separately (`#14087 `_, by Karolin Varner). - **Added:** ``Coq.Structures.OrdersEx.String_as_OT`` and ``Coq.Structures.OrdersEx.Ascii_as_OT`` to make strings and ascii ordered types (using lexical order). (`#14096 `_, by Jason Gross). - **Added:** Lemmas :g:`app_eq_app`, :g:`Forall_nil_iff`, :g:`Forall_cons_iff` to ``List.v`` (`#14153 `_, closes `#1803 `_, by Andrej Dudenhefner, with help from Olivier Laurent). - **Added:** ``Z``, ``positive`` and ``N`` constants can now be printed in hexadecimal by opening ``hex_Z_scope``, ``hex_positive_scope``, and ``hex_N_scope`` respectively (`#14263 `_, by Jason Gross). - **Added:** Absolute value function for Sint63 (`#14384 `_, by Ana Borges). - **Added:** Lemmas showing :g:`firstn` and :g:`skipn` commute with :g:`map` (`#14406 `_, by Rudy Peterson). - **Fixed:** Haskell extraction is now compatible with GHC versions >= 9.0. Some ``#if`` statements have been added to extract ``unsafeCoerce`` to its new location in newer versions of GHC. (`#14345 `_, fixes `#14256 `_, by Jason Gross). Infrastructure and dependencies ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ .. _814Dune: - **Changed:** Coq's configure script now requires absolute paths for the `-prefix` option (`#12567 `_, by Emilio Jesus Gallego Arias). - **Changed:** The regular Coq package has been split in two: coq-core, with OCaml-based libraries and tools; and coq-stdlib, which contains the Gallina-based standard library. The package Coq now depends on both for compatiblity (`#12567 `_, by Emilio Jesus Gallego Arias, review by Vincent Laporte, Guillaume Melquiond, Enrico Tassi, and Théo Zimmerman). - **Changed:** Coq's OCaml parts and tools [``coq-core``] are now built using Dune. The main user-facing change is that Dune >= 2.5 is now required to build Coq. This was a large and complex change. If you are packager you may find some minor differences if you were using a lot of custom optimizations. Note that, in particular, the configure option ``-datadir`` is not customizable anymore, and ``-bindir`` has been removed in favor of ``$prefix/bin``. Moreover, the install procedure will ignore ``-docdir`` and ``-etcdir``, unless you patch the makefile and use Dune >= 2.9. We usually recommended using a recent Dune version, if possible. For developers and plugin authors, see the entry in `dev/doc/changes.md`. For packagers and users, see `dev/doc/INSTALL.make.md` (`#13617 `_, by Emilio Jesús Gallego Arias, Rudi Grinberg, and Théo Zimmerman; review and testing by Gaëtan Gilbert, Guillaume Melquiond, and Enrico Tassi) - **Changed:** Undocumented variables ``OLDROOT`` and ``COQPREFIXINSTALL`` which added a prefix path to ``make install`` have been removed. Now, ``make install`` does support the more standard ``DESTDIR`` variable, akin to what ``coq_makefile`` does (`#14258 `_, by Emilio Jesus Gallego Arias). - **Added:** Support OCaml 4.12 (`#13885 `_, by Emilio Jesus Gallego Arias, review by Gaëtan Gilbert and Théo Zimmerman). Miscellaneous ^^^^^^^^^^^^^ - **Changed:** The representation of micromega caches was slightly altered for efficiency purposes. As a consequence all stale caches must be cleaned up (`#13405 `_, by Pierre-Marie Pédrot). - **Fixed:** Fix the timeout facility on Unix to allow for nested timeouts. Previous behavior on nested timeouts was that an "inner" timeout would replace an "outer" timeout, so that the outer timeout would no longer fire. With the new behavior, Unix and Windows implementations should be (approximately) equivalent (`#13586 `_, by Lasse Blaauwbroek). Changes in 8.14.1 ~~~~~~~~~~~~~~~~~ Kernel ^^^^^^ - **Fixed:** Fix the implementation of persistent arrays used by the VM and native compute so that it uses a uniform representation. Previously, storing primitive floats inside primitive arrays could cause memory corruption (`#15081 `_, closes `#15070 `_, by Pierre-Marie Pédrot). Specification language, type inference ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ - **Fixed:** Missing registration of universe constraints in :cmd:`Module Type` elaboration (`#14666 `_, fixes `#14505 `_, by Hugo Herbelin). Tactics ^^^^^^^ - **Fixed:** :tacn:`abstract` more robust with respect to Ltac `constr` bindings containing existential variables (`#14671 `_, fixes `#10796 `_, by Hugo Herbelin). - **Fixed:** correct support of trailing :n:`let` by tactic :tacn:`specialize` (`#15046 `_, fixes `#15043 `_, by Hugo Herbelin). Commands and options ^^^^^^^^^^^^^^^^^^^^ - **Fixed:** anomaly with :flag:`Extraction Conservative Types` when extracting pattern-matching on singleton types (`#14669 `_, fixes `#3527 `_, by Hugo Herbelin). - **Fixed:** a regular error instead of an anomaly when calling :cmd:`Separate Extraction` in a module (`#14670 `_, fixes `#10796 `_, by Hugo Herbelin). Version 8.13 ------------ Summary of changes ~~~~~~~~~~~~~~~~~~ Coq version 8.13 integrates many usability improvements, as well as extensions of the core language. The main changes include: - :ref:`Introduction <813PrimArrays>` of :ref:`primitive persistent arrays` in the core language, implemented using imperative persistent arrays. - Introduction of :ref:`definitional proof irrelevance <813UIP>` for the equality type defined in the SProp sort. - Cumulative record and inductive type declarations can now :ref:`specify <813VarianceDecl>` the variance of their universes. - Various bugfixes and uniformization of behavior with respect to the use of implicit arguments and the handling of existential variables in declarations, unification and tactics. - New warning for :ref:`unused variables <813UnusedVar>` in catch-all match branches that match multiple distinct patterns. - New :ref:`warning <813HintWarning>` for `Hint` commands outside sections without a locality attribute, whose goal is to eventually remove the fragile default behavior of importing hints only when using `Require`. The recommended fix is to declare hints as `export`, instead of the current default `global`, meaning that they are imported through `Require Import` only, not `Require`. See the following `rationale and guidelines `_ for details. - General support for :ref:`boolean attributes <813BooleanAttrs>`. - Many improvements to the handling of :ref:`notations <813Notations>`, including number notations, recursive notations and notations with bindings. A new algorithm chooses the most precise notation available to print an expression, which might introduce changes in printing behavior. - Tactic :ref:`improvements <813Tactics>` in :tacn:`lia` and its :tacn:`zify` preprocessing step, now supporting reasoning on boolean operators such as :g:`Z.leb` and supporting primitive integers :g:`Int63`. - Typing flags can now be specified :ref:`per-constant / inductive <813TypingFlags>`. - Improvements to the reference manual including updated syntax descriptions that match Coq's grammar in several chapters, and splitting parts of the tactics chapter to independent sections. See the `Changes in 8.13+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.13/refman (reference manual), and https://coq.github.io/doc/v8.13/stdlib (documentation of the standard library). Developer documentation of the ML API is available at https://coq.github.io/doc/v8.13/api. 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 `_ that are used in many Coq projects for continuous integration. The opam repository for Coq packages has been maintained by 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/. Our current 32 maintainers are Yves Bertot, Frédéric Besson, Tej Chajed, Cyril Cohen, Pierre Corbineau, Pierre Courtieu, Maxime Dénès, Jim Fehrle, Julien Forest, Emilio Jesús Gallego Arias, Gaëtan Gilbert, Georges Gonthier, Benjamin Grégoire, Jason Gross, Hugo Herbelin, Vincent Laporte, Olivier Laurent, Assia Mahboubi, Kenji Maillard, Guillaume Melquiond, Pierre-Marie Pédrot, Clément Pit-Claudel, Kazuhiko Sakaguchi, Vincent Semeria, Michael Soegtrop, Arnaud Spiwack, Matthieu Sozeau, Enrico Tassi, Laurent Théry, Anton Trunov, Li-yao Xia and Théo Zimmermann. The 51 contributors to this version are Reynald Affeldt, Tanaka Akira, Frédéric Besson, Lasse Blaauwbroek, Clément Blaudeau, Martin Bodin, Ali Caglayan, Tej Chajed, Cyril Cohen, Julien Coolen, Matthew Dempsky, Maxime Dénès, Andres Erbsen, Jim Fehrle, Emilio Jesús Gallego Arias, Attila Gáspár, Paolo G. Giarrusso, Gaëtan Gilbert, Jason Gross, Benjamin Grégoire, Hugo Herbelin, Wolf Honore, Jasper Hugunin, Ignat Insarov, Ralf Jung, Fabian Kunze, Vincent Laporte, Olivier Laurent, Larry D. Lee Jr, Thomas Letan, Yishuai Li, James Lottes, Jean-Christophe Léchenet, Kenji Maillard, Erik Martin-Dorel, Yusuke Matsushita, Guillaume Melquiond, Carl Patenaude-Poulin, Clément Pit-Claudel, Pierre-Marie Pédrot, Pierre Roux, Kazuhiko Sakaguchi, Vincent Semeria, Michael Soegtrop, Matthieu Sozeau, Enrico Tassi, Anton Trunov, Edward Wang, Li-yao Xia, Beta Ziliani and Théo Zimmermann. The Coq community at large helped 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 `_ and the `Coq Zulip chat `_. Version 8.13's development spanned 5 months from the release of Coq 8.12.0. Enrico Tassi and Maxime Dénès are the release managers of Coq 8.13. This release is the result of 400 merged PRs, closing ~100 issues. | Nantes, November 2020, | Matthieu Sozeau for the Coq development team | Changes in 8.13+beta1 ~~~~~~~~~~~~~~~~~~~~~ .. contents:: :local: Kernel ^^^^^^ .. _813UIP: - **Added:** Definitional UIP, only when :flag:`Definitional UIP` is enabled. This models definitional uniqueness of identity proofs for the equality type in SProp. It is deactivated by default as it can lead to non-termination in combination with impredicativity. Use of this flag is also printed by :cmd:`Print Assumptions`. See documentation of the flag for details (`#10390 `_, by Gaëtan Gilbert). .. _813PrimArrays: - **Added:** Built-in support for persistent arrays, which expose a functional interface but are implemented using an imperative data structure, for better performance (`#11604 `_, by Maxime Dénès and Benjamin Grégoire, with help from Gaëtan Gilbert). Primitive arrays are irrelevant in their single polymorphic universe (same as a polymorphic cumulative list inductive would be) (`#13356 `_, fixes `#13354 `_, by Gaëtan Gilbert). - **Fixed:** A loss of definitional equality for declarations obtained through :cmd:`Include` when entering the scope of a :cmd:`Module` or :cmd:`Module Type` was causing :cmd:`Search` not to see the included declarations (`#12537 `_, fixes `#12525 `_ and `#12647 `_, by Hugo Herbelin). - **Fixed:** Fix an incompleteness in the typechecking of `match` for cumulative inductive types. This could result in breaking subject reduction (`#13501 `_, fixes `#13495 `_, by Matthieu Sozeau). Specification language, type inference ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ .. _813BooleanAttrs: - **Changed:** :term:`Boolean attributes ` are now specified using key/value pairs, that is to say :n:`@ident__attr{? = {| yes | no } }`. If the value is missing, the default is :n:`yes`. The old syntax is still supported, but produces the ``deprecated-attribute-syntax`` warning. Deprecated attributes are ``universes(monomorphic)``, ``universes(notemplate)`` and ``universes(noncumulative)``, which are respectively replaced by :attr:`universes(polymorphic=no) `, :attr:`universes(template=no) ` and :attr:`universes(cumulative=no) `. Attributes :attr:`program` and :attr:`canonical` are also affected, with the syntax :n:`@ident__attr(false)` being deprecated in favor of :n:`@ident__attr=no` (`#13312 `_, by Emilio Jesus Gallego Arias). - **Changed:** Heuristics for universe minimization to :g:`Set`: also use constraints ``Prop <= i`` (`#10331 `_, by Gaëtan Gilbert with help from Maxime Dénès and Matthieu Sozeau, fixes `#12414 `_). - **Changed:** The type given to :cmd:`Instance` is no longer automatically generalized over unbound and :ref:`generalizable ` variables. Use ``Instance : `{type}`` instead of :n:`Instance : @type` to get the old behavior, or enable the compatibility flag ``Instance Generalized Output`` (`#13188 `_, fixes `#6042 `_, by Gaëtan Gilbert). - **Changed:** Tweaked the algorithm giving default names to arguments. Should reduce the frequency that argument names get an unexpected suffix. Also makes :flag:`Mangle Names` not mess up argument names (`#12756 `_, fixes `#12001 `_ and `#6785 `_, by Jasper Hugunin). - **Removed:** Undocumented and experimental forward class hint feature ``:>>``. Use ``:>`` (see :n:`@of_type`) instead (`#13106 `_, by Pierre-Marie Pédrot). .. _813VarianceDecl: - **Added:** Commands :cmd:`Inductive`, :cmd:`Record` and synonyms now support syntax `Inductive foo@{=i +j *k l}` to specify variance information for their universes (in :ref:`Cumulative ` mode) (`#12653 `_, by Gaëtan Gilbert). .. _813UnusedVar: - **Added:** Warning on unused variables in pattern-matching branches of :n:`match` serving as catch-all branches for at least two distinct patterns (`#12768 `_, fixes `#12762 `_, by Hugo Herbelin). - **Added:** Definition and (Co)Fixpoint now support the :attr:`using` attribute. It has the same effect as :cmd:`Proof using`, which is only available in interactive mode (`#13183 `_, by Enrico Tassi). .. _813TypingFlags: - **Added:** Typing flags can now be specified per-constant / inductive, this allows to fine-grain specify them from plugins or attributes. See :ref:`controlling-typing-flags` for details on attribute syntax (`#12586 `_, by Emilio Jesus Gallego Arias). - **Added:** Inference of return predicate of a :g:`match` by inversion takes sort elimination constraints into account (`#13290 `_, grants `#13278 `_, by Hugo Herbelin). - **Fixed:** Implicit arguments taken into account in defined fields of a record type declaration (`#13166 `_, fixes `#13165 `_, by Hugo Herbelin). - **Fixed:** Allow use of typeclass inference for the return predicate of a :n:`match` (was deactivated in versions 8.10 to 8.12, `#13217 `_, fixes `#13216 `_, by Hugo Herbelin). - **Fixed:** A case of unification raising an anomaly IllTypedInstance (`#13376 `_, fixes `#13266 `_, by Hugo Herbelin). - **Fixed:** Using :n:`{wf ...}` in local fixpoints is an error, not an anomaly (`#13383 `_, fixes `#11816 `_, by Hugo Herbelin). - **Fixed:** Issue when two expressions involving different projections and one is primitive need to be unified (`#13386 `_, fixes `#9971 `_, by Hugo Herbelin). - **Fixed:** A bug producing ill-typed instances of existential variables when let-ins interleaved with assumptions (`#13387 `_, fixes `#12348 `_, by Hugo Herbelin). .. _813Notations: Notations ^^^^^^^^^ - **Changed:** In notations (except in custom entries), the misleading :n:`@syntax_modifier` :n:`@ident ident` (which accepted either an identifier or a :g:`_`) is deprecated and should be replaced by :n:`@ident name`. If the intent was really to only parse identifiers, this will eventually become possible, but only as of Coq 8.15. In custom entries, the meaning of :n:`@ident ident` is silently changed from parsing identifiers or :g:`_` to parsing only identifiers without warning, but this presumably affects only rare, recent and relatively experimental code (`#11841 `_, fixes `#9514 `_, by Hugo Herbelin). - **Changed:** Improved support for notations/abbreviations with mixed terms and patterns (such as the forcing modality) (`#12099 `_, by Hugo Herbelin). - **Changed** Rational and real constants are parsed differently. The exponent is now encoded separately from the fractional part using ``Z.pow_pos``. This way, parsing large exponents can no longer blow up and constants are printed in a form closer to the one in which they were parsed (i.e., ``102e-2`` is reprinted as such and not ``1.02``) (`#12218 `_, by Pierre Roux). - **Changed:** Scope information is propagated in indirect applications to a reference prefixed with :g:`@`; this covers for instance the case :g:`r.(@p) t` where scope information from :g:`p` is now taken into account for interpreting :g:`t` (`#12685 `_, by Hugo Herbelin). - **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 `_, fixes `#4738 `_ and `#9682 `_ and part 2 of `#12908 `_, by Hugo Herbelin). - **Changed:** Redeclaring a notation also reactivates its printing rule; in particular a second :cmd:`Import` of the same module reactivates the printing rules declared in this module. In theory, this leads to changes in behavior for printing. However, this is mitigated in general by the adoption in `#12986 `_ of a priority given to notations which match a larger part of the term to print (`#12984 `_, fixes `#7443 `_ and `#10824 `_, by Hugo Herbelin). - **Changed:** Use of notations for printing now gives preference to notations which match a larger part of the term to abbreviate (`#12986 `_, by Hugo Herbelin). - **Removed** OCaml parser and printer for real constants have been removed. Real constants are now handled with proven Coq code (`#12218 `_, by Pierre Roux). - **Deprecated** ``Numeral.v`` is deprecated, please use ``Number.v`` instead (`#12218 `_, by Pierre Roux). - **Deprecated:** `Numeral Notation`, please use :cmd:`Number Notation` instead (`#12979 `_, by Pierre Roux). - **Added:** :flag:`Printing Float` flag to print primitive floats as hexadecimal instead of decimal values. This is included in the :flag:`Printing All` flag (`#11986 `_, by Pierre Roux). - **Added:** :ref:`Number Notation ` and :ref:`String Notation ` commands now support parameterized inductive and non-inductive types (`#12218 `_, fixes `#12035 `_, by Pierre Roux, review by Jason Gross and Jim Fehrle for the reference manual). - **Added:** Added support for encoding notations of the form :g:`x ⪯ y ⪯ .. ⪯ z ⪯ t`. This feature is considered experimental (`#12765 `_, by Hugo Herbelin). - **Added:** The :n:`@binder` entry of :cmd:`Notation` can now be used in notations expecting a single (non-recursive) binder (`#13265 `_, by Hugo Herbelin, see section :ref:`notations-and-binders` of the reference manual). - **Fixed:** Issues in the presence of notations recursively referring to another applicative notations, such as missing scope propagation, or failure to use a notation for printing (`#12960 `_, fixes `#9403 `_ and `#10803 `_, by Hugo Herbelin). - **Fixed:** Capture the names of global references by binders in the presence of notations for binders (`#12965 `_, fixes `#9569 `_, by Hugo Herbelin). - **Fixed:** Preventing notations for constructors to involve binders (`#13092 `_, fixes `#13078 `_, by Hugo Herbelin). - **Fixed:** Notations understand universe names without getting confused by different imported modules between declaration and use locations (`#13415 `_, fixes `#13303 `_, by Gaëtan Gilbert). .. _813Tactics: Tactics ^^^^^^^ - **Changed:** In :tacn:`refine`, new existential variables unified with existing ones are no longer considered as fresh. The behavior of :tacn:`simple refine ` no longer depends on the orientation of evar-evar unification problems, and new existential variables are always turned into (unshelved) goals. This can break compatibility in some cases (`#7825 `_, by Matthieu Sozeau, with help from Maxime Dénès, review by Pierre-Marie Pédrot and Enrico Tassi, fixes `#4095 `_ and `#4413 `_). - **Changed:** Giving an empty list of occurrences after :n:`in` in tactics is no longer permitted. Omitting the :n:`in` gives the same behavior (`#13237 `_, fixes `#13235 `_, by Hugo Herbelin). - **Removed:** :n:`at @occs_nums` clauses in tactics such as :tacn:`unfold` no longer allow negative values. A "-" before the list (for set complement) is still supported. Ex: "at -1 -2" is no longer supported but "at -1 2" is (`#13403 `_, by Jim Fehrle). - **Removed:** A number of tactics that formerly accepted negative numbers as parameters now give syntax errors for negative values. These include {e}constructor, do, timeout, 9 {e}auto tactics and psatz* (`#13417 `_, by Jim Fehrle). - **Removed:** The deprecated and undocumented `prolog` tactic was removed (`#12399 `_, by Pierre-Marie Pédrot). - **Removed:** `info` tactic that was deprecated in 8.5 (`#12423 `_, by Jim Fehrle). - **Deprecated:** Undocumented :n:`eauto @nat_or_var @nat_or_var` syntax in favor of new `bfs eauto`. Also deprecated 2-integer syntax for :tacn:`debug eauto` and :tacn:`info_eauto` (Use `bfs eauto` with the :flag:`Info Eauto` or :flag:`Debug Eauto` flags instead.) (`#13381 `_, by Jim Fehrle). - **Added:** :tacn:`lia` is extended to deal with boolean operators e.g. `andb` or `Z.leb` (as `lia` gets more powerful, this may break proof scripts relying on `lia` failure, `#11906 `_, by Frédéric Besson). - **Added:** :tacn:`apply … in ` supports several hypotheses (`#12246 `_, by Hugo Herbelin; grants `#9816 `_). - **Added:** The :tacn:`zify` tactic can now be extended by redefining the `zify_pre_hook` tactic. (`#12552 `_, by Kazuhiko Sakaguchi). - **Added:** The :tacn:`zify` tactic provides support for primitive integers (module :g:`ZifyInt63`) (`#12648 `_, by Frédéric Besson). - **Fixed:** Avoid exposing an internal name of the form :n:`_tmp` when applying the :n:`_` introduction pattern which would break a dependency (`#13337 `_, fixes `#13336 `_, by Hugo Herbelin). - **Fixed:** The case of tactics, such as :tacn:`eapply`, producing existential variables under binders with an ill-formed instance (`#13373 `_, fixes `#13363 `_, by Hugo Herbelin). Tactic language ^^^^^^^^^^^^^^^ - **Added:** An if-then-else syntax to Ltac2 (`#13232 `_, fixes `#10110 `_, by Pierre-Marie Pédrot). - **Fixed:** Printing of the quotation qualifiers when printing :g:`Ltac` functions (`#13028 `_, fixes `#9716 `_ and `#13004 `_, by Hugo Herbelin). SSReflect ^^^^^^^^^ - **Added:** SSReflect intro pattern ltac views ``/[dup]``, ``/[swap]`` and ``/[apply]`` (`#13317 `_, by Cyril Cohen). - **Fixed:** Working around a bug of interaction between + and /(ltac:(...)) cf `#13458 `_ (`#13459 `_, by Cyril Cohen). Commands and options ^^^^^^^^^^^^^^^^^^^^ - **Changed:** Drop prefixes from grammar non-terminal names, e.g. "constr:global" -> "global", "Prim.name" -> "name". Visible in the output of :cmd:`Print Grammar` and :cmd:`Print Custom Grammar` (`#13096 `_, by Jim Fehrle). - **Changed:** When declaring arbitrary terms as hints, unsolved evars are not abstracted implicitly anymore and instead raise an error (`#13139 `_, by Pierre-Marie Pédrot). - **Removed:** In the :cmd:`Extraction Language` command, remove `Ocaml` as a valid value. Use `OCaml` instead. This was deprecated in Coq 8.8, `#6261 `_ (`#13016 `_, by Jim Fehrle). .. _813HintWarning: - **Deprecated:** Hint locality currently defaults to :attr:`local` in a section and :attr:`global` otherwise, but this will change in a future release. Hints added outside of sections without an explicit locality now generate a deprecation warning. We recommend using :attr:`export` where possible (`#13384 `_, by Pierre-Marie Pédrot). - **Deprecated:** ``Grab Existential Variables`` and ``Existential`` commands (`#12516 `_, by Maxime Dénès). - **Added:** The :attr:`export` locality can now be used for all Hint commands, including :cmd:`Hint Cut`, :cmd:`Hint Mode`, :cmd:`Hint Transparent` / :cmd:`Opaque ` and :cmd:`Remove Hints` (`#13388 `_, by Pierre-Marie Pédrot). - **Added:** Support for automatic insertion of coercions in :cmd:`Search` patterns. Additionally, head patterns are now automatically interpreted as types (`#13255 `_, fixes `#13244 `_, by Hugo Herbelin). - **Added:** The :cmd:`Proof using` command can now be used without loading the Ltac plugin (`-noinit` mode) (`#13339 `_, by Théo Zimmermann). - **Added:** Clarify in the documentation that ``Add ML Path`` is not exported to compiled files (`#13345 `_, fixes `#13344 `_, by Hugo Herbelin). Tools ^^^^^ - **Changed:** Option `-native-compiler` of the configure script now impacts the default value of the `-native-compiler` option of coqc. The `-native-compiler` option of the configure script supports a new `ondemand` value, which becomes the default, thus preserving the previous default behavior. The stdlib is still precompiled when configuring with `-native-compiler yes`. It is not precompiled otherwise. This an implementation of point 2 of `CEP #48 `_ (`#13352 `_, by Pierre Roux). - **Changed:** Added the ability for coq_makefile to directly set the installation folders, through the `COQLIBINSTALL` and `COQDOCINSTALL` variables. See :ref:`coqmakefilelocal` (`#12389 `_, by Martin Bodin, review of Enrico Tassi). - **Removed:** The option ``-I`` of coqchk was removed (it was deprecated in Coq 8.8) (`#12613 `_, by Gaëtan Gilbert). - **Fixed:** ``coqchk`` no longer reports names from inner modules of opaque modules as axioms (`#12862 `_, fixes `#12845 `_, by Jason Gross). CoqIDE ^^^^^^ - **Added:** Support showing diffs for :cmd:`Show Proof` in CoqIDE from the :n:`View` menu. See :ref:`showing_proof_diffs` (`#12874 `_, by Jim Fehrle and Enrico Tassi) - **Added:** Support for flag :flag:`Printing Goal Names` in View menu (`#13145 `_, by Hugo Herbelin). Standard library ^^^^^^^^^^^^^^^^ - **Changed:** In the reals theory changed the epsilon in the definition of the modulus of convergence for CReal from 1/n (n in positive) to 2^z (z in Z) so that a precision coarser than one is possible. Also added an upper bound to CReal to enable more efficient computations (`#12186 `_, by Michael Soegtrop). - **Changed:** Int63 notations now match up with the rest of the standard library: :g:`a \% m`, :g:`m == n`, :g:`m < n`, :g:`m <= n`, and :g:`m ≤ n` have been replaced with :g:`a mod m`, :g:`m =? n`, :g:`m `_, fixes `#12454 `_, by Jason Gross). - **Changed:** PrimFloat notations now match up with the rest of the standard library: :g:`m == n`, :g:`m < n`, and :g:`m <= n` have been replaced with :g:`m =? n`, :g:`m `_, fixes `#12454 `_, by Jason Gross). - **Changed:** the sort of cyclic numbers from Type to Set. For backward compatibility, a dynamic sort was defined in the 3 packages bignums, coqprime and color. See for example commit 6f62bda in bignums (`#12801 `_, by Vincent Semeria). - **Changed:** ``Require Import Coq.nsatz.NsatzTactic`` now allows using :tacn:`nsatz` with `Z` and `Q` without having to supply instances or using ``Require Import Coq.nsatz.Nsatz``, which transitively requires unneeded files declaring axioms used in the reals (`#12861 `_, fixes `#12860 `_, by Jason Gross). - **Deprecated:** ``prod_curry`` and ``prod_uncurry``, in favor of ``uncurry`` and ``curry`` (`#12716 `_, by Yishuai Li). - **Added:** New lemmas about ``repeat`` in ``List`` and ``Permutation``: ``repeat_app``, ``repeat_eq_app``, ``repeat_eq_cons``, ``repeat_eq_elt``, ``Forall_eq_repeat``, ``Permutation_repeat`` (`#12799 `_, by Olivier Laurent). - **Added:** Extend some list lemmas to both directions: `app_inj_tail_iff`, `app_inv_head_iff`, `app_inv_tail_iff` (`#12094 `_, fixes `#12093 `_, by Edward Wang). - **Added:** ``Decidable`` instance for negation (`#12420 `_, by Yishuai Li). - **Fixed:** `Coq.Program.Wf.Fix_F_inv` and `Coq.Program.Wf.Fix_eq` are now axiom-free, and no longer assuming proof irrelevance (`#13365 `_, by Li-yao Xia). Infrastructure and dependencies ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ - **Changed:** When compiled with OCaml >= 4.10.0, Coq will use the new best-fit GC policy, which should provide some performance benefits. Coq's policy is optimized for speed, but could increase memory consumption in some cases. You are welcome to tune it using the ``OCAMLRUNPARAM`` variable and report back on good settings so we can improve the defaults (`#13040 `_, fixes `#11277 `_, by Emilio Jesus Gallego Arias). - **Changed:** Coq now uses the `zarith `_ library, based on GNU's gmp instead of ``num`` which is deprecated upstream. The custom ``bigint`` module is no longer provided (`#11742 `_, `#13007 `_, by Emilio Jesus Gallego Arias and Vicent Laporte, with help from Frédéric Besson). Changes in 8.13.0 ~~~~~~~~~~~~~~~~~ Commands and options ^^^^^^^^^^^^^^^^^^^^ - **Changed:** The warning `custom-entry-overriden` has been renamed to `custom-entry-overridden` (with two d's) (`#13556 `_, by Simon Friis Vindum). Changes in 8.13.1 ~~~~~~~~~~~~~~~~~ Kernel ^^^^^^ - **Fixed:** Fix arities of VM opcodes for some floating-point operations that could cause memory corruption (`#13867 `_, by Guillaume Melquiond). CoqIDE ^^^^^^ - **Added:** Option ``-v`` and ``--version`` to CoqIDE (`#13870 `_, by Guillaume Melquiond). Changes in 8.13.2 ~~~~~~~~~~~~~~~~~ Kernel ^^^^^^ - **Fixed:** Crash when using :tacn:`vm_compute` on an irreducible ``PArray.set`` (`#14005 `_, fixes `#13998 `_, by Guillaume Melquiond). - **Fixed:** Never store persistent arrays as VM / native structured values. This could be used to make vo marshalling crash, and probably breaking some other invariants of the kernel (`#14007 `_, fixes `#14006 `_, by Pierre-Marie Pédrot). Tactic language ^^^^^^^^^^^^^^^^ - **Fixed:** Ltac2 ``Array.init`` no longer incurs exponential overhead when used recursively (`#14012 `_, fixes `#14011 `_, by Jason Gross). Version 8.12 ------------ Summary of changes ~~~~~~~~~~~~~~~~~~ Coq version 8.12 integrates many usability improvements, in particular with respect to notations, scopes and implicit arguments, along with many bug fixes and major improvements to the reference manual. The main changes include: - New :ref:`binder notation<812Implicit>` for non-maximal implicit arguments using :g:`[ ]` allowing to set and see the implicit status of arguments immediately. - New notation :g:`Inductive I A | x : s := ...` to distinguish the :ref:`uniform<812Uniform>` from the non-uniform parameters in inductive definitions. - More robust and expressive treatment of :ref:`implicit inductive<812ImplicitInductive>` parameters in inductive declarations. - Improvements in the treatment of implicit arguments and partially applied constants in :ref:`notations<812Notations>`, parsing of hexadecimal number notation and better handling of scopes and coercions for printing. - A correct and efficient :ref:`coercion coherence<812Coercions>` checking algorithm, avoiding spurious or duplicate warnings. - An improved :cmd:`Search` :ref:`command<812Search>` which accepts complex queries. Note that 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 in most but not all chapters. Additionally, the `omega` tactic is deprecated in this version of Coq, and we recommend users to switch to :tacn:`lia` in new proof scripts. 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 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. 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 `_ that are used in many Coq projects for continuous integration. The opam repository for Coq packages has been maintained by 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. This was changed in 8.12 (`#11295 `_) so that every component now has a team of maintainers, who are in charge of reviewing and merging incoming pull requests. This gave us a chance to significantly expand the pool of maintainters and provide faster feedback to contributors. Special thanks to all our maintainers! Our current 31 maintainers are Yves Bertot, Frédéric Besson, Tej Chajed, Cyril Cohen, Pierre Corbineau, Pierre Courtieu, Maxime Dénès, Jim Fehrle, Julien Forest, Emilio Jesús Gallego Arias, Gaëtan Gilbert, Georges Gonthier, Benjamin Grégoire, Jason Gross, Hugo Herbelin, Vincent Laporte, Assia Mahboubi, Kenji Maillard, Guillaume Melquiond, Pierre-Marie Pédrot, Clément Pit-Claudel, Kazuhiko Sakaguchi, Vincent Semeria, Michael Soegtrop, Arnaud Spiwack, Matthieu Sozeau, Enrico Tassi, Laurent Théry, Anton Trunov, Li-yao Xia, Théo Zimmermann The 59 contributors to this version are Abhishek Anand, Yves Bertot, Frédéric Besson, Lasse Blaauwbroek, Simon Boulier, Quentin Carbonneaux, Tej Chajed, Arthur Charguéraud, Cyril Cohen, Pierre Courtieu, Matthew Dempsky, Maxime Dénès, Andres Erbsen, Erika (@rrika), Nikita Eshkeev, Jim Fehrle, @formalize, Emilio Jesús Gallego Arias, Paolo G. Giarrusso, Gaëtan Gilbert, Jason Gross, Samuel Gruetter, Attila Gáspár, Hugo Herbelin, Jan-Oliver Kaiser, Robbert Krebbers, Vincent Laporte, Olivier Laurent, Xavier Leroy, Thomas Letan, Yishuai Li, Kenji Maillard, Erik Martin-Dorel, Guillaume Melquiond, Ike Mulder, Guillaume Munch-Maccagnoni, Antonio Nikishaev, Karl Palmskog, Pierre-Marie Pédrot, Clément Pit-Claudel, Ramkumar Ramachandra, Lars Rasmusson, Daniel de Rauglaudre, Talia Ringer, Pierre Roux, Kazuhiko Sakaguchi, Vincent Semeria, @scinart, Kartik Singhal, Michael Soegtrop, Matthieu Sozeau, Enrico Tassi, Laurent Théry, Ralf Treinen, Anton Trunov, Bernhard M. Wiedemann, Li-yao Xia, 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 `_ and the new `Coq Zulip chat `_ (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 ~500 PRs merged, closing ~100 issues. | Nantes, June 2020, | Matthieu Sozeau for the Coq development team | Changes in 8.12+beta1 ~~~~~~~~~~~~~~~~~~~~~ .. contents:: :local: Kernel ^^^^^^ - **Fixed:** Specification of :n:`PrimFloat.leb` which made :n:`(x <= y)%float` true for any non-NaN :n:`x` and :n:`y` (`#12484 `_, fixes `#12483 `_, by Pierre Roux). Specification language, type inference ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ - **Changed:** 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 `_, by SimonBoulier). - **Changed:** Typeclass resolution, accessible through :tacn:`typeclasses eauto`, now suspends constraints according to their modes instead of failing. If a typeclass constraint does not match any of the declared modes for its class, the constraint is postponed, and the proof search continues on other goals. Proof search does a fixed point computation to try to solve them at a later stage of resolution. It does not fail if there remain only stuck constraints at the end of resolution. This makes typeclasses with declared modes more robust with respect to the order of resolution (`#10858 `_, fixes `#9058 `_, by Matthieu Sozeau). - **Added:** Warn when manual implicit arguments are used in unexpected positions of a term (e.g. in `Check id (forall {x}, x)`) or when an implicit argument name is shadowed (e.g. in `Check fun f : forall {x:nat} {x}, nat => f`) (`#10202 `_, by Hugo Herbelin). - **Added:** :cmd:`Arguments` now supports setting implicit an anonymous argument, as e.g. in `Arguments id {A} {_}` (`#11098 `_, by Hugo Herbelin, fixes `#4696 `_, `#5173 `_, `#9098 `_). .. _812Implicit: - **Added:** Syntax for non-maximal implicit arguments in definitions and terms using square brackets. The syntax is ``[x : A]``, ``[x]``, ```[A]`` to be consistent with the command :cmd:`Arguments` (`#11235 `_, by Simon Boulier). - **Added:** :cmd:`Implicit Types` are now taken into account for printing. To inhibit it, unset the :flag:`Printing Use Implicit Types` flag (`#11261 `_, by Hugo Herbelin, granting `#10366 `_). .. _812Uniform: - **Added:** New syntax :cmd:`Inductive` :n:`@ident {* @binder } | {* @binder } := ...` to specify which parameters of an inductive type are uniform. See :ref:`parametrized-inductive-types` (`#11600 `_, by Gaëtan Gilbert). - **Added:** Warn when using :cmd:`Fixpoint` or :cmd:`CoFixpoint` for definitions which are not recursive (`#12121 `_, by Hugo Herbelin). .. _812ImplicitInductive: - **Fixed:** More robust and expressive treatment of implicit inductive parameters in inductive declarations (`#11579 `_, by Maxime Dénès, Gaëtan Gilbert and Jasper Hugunin; fixes `#7253 `_ and `#11585 `_). - **Fixed:** Anomaly which could be raised when printing binders with implicit types (`#12323 `_, by Hugo Herbelin; fixes `#12322 `_). - **Fixed:** Case of an anomaly in trying to infer the return clause of an ill-typed :g:`match` (`#12422 `_, fixes `#12418 `_, by Hugo Herbelin). .. _812Notations: Notations ^^^^^^^^^ - **Changed:** Notation scopes are now always inherited in notations binding a partially applied constant, including for notations binding an expression of the form :n:`@@qualid`. The latter was not the case beforehand (part of `#11120 `_). - **Changed:** The printing algorithm now interleaves search for notations and removal of coercions (`#11172 `_, by Hugo Herbelin). - **Changed:** Nicer printing for decimal constants in R and Q. 1.5 is now printed 1.5 rather than 15e-1 (`#11848 `_, by Pierre Roux). - **Removed:** deprecated ``compat`` modifier of :cmd:`Notation` and :cmd:`Infix` commands. Use the :attr:`deprecated` attribute instead (`#11113 `_, by Théo Zimmermann, with help from Jason Gross). - **Deprecated:** Numeral Notation on ``Decimal.uint``, ``Decimal.int`` and ``Decimal.decimal`` are replaced respectively by numeral notations on ``Numeral.uint``, ``Numeral.int`` and ``Numeral.numeral`` (`#11948 `_, by Pierre Roux). - **Added:** Notations declared with the ``where`` clause in the declaration of inductive types, coinductive types, record fields, fixpoints and cofixpoints now support the ``only parsing`` modifier (`#11602 `_, by Hugo Herbelin). - **Added:** :flag:`Printing Parentheses` flag to print parentheses even when implied by associativity or precedence (`#11650 `_, by Hugo Herbelin and Abhishek Anand). - **Added:** Numeral notations now parse hexadecimal constants such as ``0x2a`` or ``0xb.2ap-2``. Parsers added for :g:`nat`, :g:`positive`, :g:`Z`, :g:`N`, :g:`Q`, :g:`R`, primitive integers and primitive floats (`#11948 `_, by Pierre Roux). - **Added:** Abbreviations support arguments occurring both in term and binder position (`#8808 `_, by Hugo Herbelin). - **Fixed:** Different interpretations in different scopes of the same notation string can now be associated with different printing formats (`#10832 `_, by Hugo Herbelin, fixes `#6092 `_ and `#7766 `_). - **Fixed:** Parsing and printing consistently handle inheritance of implicit arguments in notations. With the exception of notations of the form :n:`Notation @string := @@qualid` and :n:`Notation @ident := @@qualid` which inhibit implicit arguments, all notations binding a partially applied constant, as e.g. in :n:`Notation @string := (@qualid {+ @arg })`, or :n:`Notation @string := (@@qualid {+ @arg })`, or :n:`Notation @ident := (@qualid {+ @arg })`, or :n:`Notation @ident := (@@qualid {+ @arg })`, inherit the remaining implicit arguments (`#11120 `_, by Hugo Herbelin, fixing `#4690 `_ and `#11091 `_). - **Fixed:** Notations in ``only printing`` mode do not uselessly reserve parsing keywords (`#11590 `_, by Hugo Herbelin, fixes `#9741 `_). - **Fixed:** Numeral Notations now play better with multiple scopes for the same inductive type. Previously, when multiple numeral notations were defined for the same inductive, only the last one was considered for printing. Now, among the notations that are usable for printing and either have a scope delimiter or are open, the selection is made according to the order of open scopes, or according to the last defined notation if no appropriate scope is open (`#12163 `_, fixes `#12159 `_, by Pierre Roux, review by Hugo Herbelin and Jason Gross). Tactics ^^^^^^^ - **Changed:** The :tacn:`rapply` tactic in :g:`Coq.Program.Tactics` now handles arbitrary numbers of underscores and takes in a :g:`uconstr`. In rare cases where users were relying on :tacn:`rapply` inserting exactly 15 underscores and no more, due to the lemma having a completely unspecified codomain (and thus allowing for any number of underscores), the tactic will now loop instead (`#10760 `_, by Jason Gross). - **Changed:** The :g:`auto with zarith` tactic and variations (including :tacn:`intuition`) may now call :tacn:`lia` instead of `omega` (when the `Omega` module is loaded); more goals may be automatically solved, fewer section variables will be captured spuriously (`#11018 `_, by Vincent Laporte). - **Changed:** The new :flag:`NativeCompute Timing` flag causes calls to :tacn:`native_compute` (as well as kernel calls to the native compiler) to emit separate timing information about conversion to native code, compilation, execution, and reification. It replaces the timing information previously emitted when the `-debug` command-line flag was set, and allows more fine-grained timing of the native compiler (`#11025 `_, by Jason Gross). Additionally, the timing information now uses real time rather than user time (fixes `#11962 `_, `#11963 `_, by Jason Gross) - **Changed:** Improve the efficiency of `PreOmega.elim_let` using an iterator implemented in OCaml (`#11370 `_, by Frédéric Besson). - **Changed:** Improve the efficiency of :tacn:`zify` by rewriting the remaining Ltac code in OCaml (`#11429 `_, by Frédéric Besson). - **Changed:** Backtrace information for tactics has been improved (`#11755 `_, by Emilio Jesus Gallego Arias). - **Changed:** The default tactic used by :g:`firstorder` is :g:`auto with core` instead of :g:`auto with *`; see :ref:`decisionprocedures` for details; old behavior can be reset by using the `-compat 8.12` command-line flag; to ease the migration of legacy code, the default solver can be set to `debug auto with *` with `Set Firstorder Solver debug auto with *` (`#11760 `_, by Vincent Laporte). - **Changed:** :tacn:`autounfold` no longer fails when the :cmd:`Opaque` command is used on constants in the hint databases (`#11883 `_, by Attila Gáspár). - **Changed:** Tactics with qualified name of the form ``Coq.Init.Notations`` are now qualified with prefix ``Coq.Init.Ltac``; users of the ``-noinit`` option should now import ``Coq.Init.Ltac`` if they want to use Ltac (`#12023 `_, by Hugo Herbelin; minor source of incompatibilities). - **Changed:** Tactic :tacn:`subst` :n:`@ident` now fails over a section variable which is indirectly dependent in the goal; the incompatibility can generally be fixed by first clearing the hypotheses causing an indirect dependency, as reported by the error message, or by using :tacn:`rewrite` :n:`... in *` instead; similarly, :tacn:`subst` has no more effect on such variables (`#12146 `_, by Hugo Herbelin; fixes `#10812 `_ and `#12139 `_). - **Changed:** The check that :tacn:`unfold` arguments were indeed unfoldable has been moved to runtime (`#12256 `_, by Pierre-Marie Pédrot; fixes `#5764 `_, `#5159 `_, `#4925 `_ and `#11727 `_). - **Changed** When the tactic :tacn:`functional induction` :n:`c__1 c__2 ... c__n` is used with no parenthesis around :n:`c__1 c__2 ... c__n`, :n:`c__1 c__2 ... c__n` is now read as one single applicative term. In particular implicit arguments should be omitted. Rare source of incompatibility (`#12326 `_, by Pierre Courtieu). - **Changed:** When using :tacn:`exists` or :tacn:`eexists` with multiple arguments, the evaluation of arguments and applications of constructors are now interleaved. This improves unification in some cases (`#12366 `_, fixes `#12365 `_, by Attila Gáspár). - **Removed:** Undocumented ``omega with``. Using :tacn:`lia` is the recommended replacement, although the old semantics of ``omega with *`` can also be recovered with ``zify; omega`` (`#11288 `_, by Emilio Jesus Gallego Arias). - **Removed:** Deprecated syntax `_eqn` for :tacn:`destruct` and :tacn:`remember`. Use `eqn:` syntax instead (`#11877 `_, by Hugo Herbelin). - **Removed:** `at` clauses can no longer be used with :tacn:`autounfold`. Since they had no effect, it is safe to remove them (`#11883 `_, by Attila Gáspár). - **Deprecated:** The `omega` tactic is deprecated; use :tacn:`lia` from the :ref:`Micromega ` plugin instead (`#11976 `_, by Vincent Laporte). - **Added:** The :tacn:`zify` tactic is now aware of `Pos.pred_double`, `Pos.pred_N`, `Pos.of_nat`, `Pos.add_carry`, `Pos.pow`, `Pos.square`, `Z.pow`, `Z.double`, `Z.pred_double`, `Z.succ_double`, `Z.square`, `Z.div2`, and `Z.quot2`. Injections for internal definitions in module `ZifyBool` (`isZero` and `isLeZero`) are also added to help users to declare new :tacn:`zify` class instances using Micromega tactics (`#10998 `_, by Kazuhiko Sakaguchi). - **Added:** :cmd:`Show Lia Profile` prints some statistics about :tacn:`lia` calls (`#11474 `_, by Frédéric Besson). - **Added:** Syntax :tacn:`pose proof` :n:`(@ident:=@term)` as an alternative to :tacn:`pose proof` :n:`@term as @ident`, following the model of :tacn:`pose` :n:`(@ident:=@term)` (`#11522 `_, by Hugo Herbelin). - **Added:** New tactical :tacn:`with_strategy` which behaves like the command :cmd:`Strategy`, with effects local to the given tactic (`#12129 `_, by Jason Gross). - **Added:** The :tacn:`zify` tactic is now aware of `Nat.le`, `Nat.lt` and `Nat.eq` (`#12213 `_, by Frédéric Besson; fixes `#12210 `_). - **Fixed:** :tacn:`zify` now handles :g:`Z.pow_pos` by default. 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 `_, fixes `#11191 `_, by Frédéric Besson). - **Fixed:** Efficiency regression of :tacn:`lia` (`#11474 `_, fixes `#11436 `_, by Frédéric Besson). - **Fixed:** The behavior of :tacn:`autounfold` no longer depends on the names of terms and modules (`#11883 `_, fixes `#7812 `_, by Attila Gáspár). - **Fixed:** Wrong type error in tactic :tacn:`functional induction` (`#12326 `_, by Pierre Courtieu, fixes `#11761 `_, reported by Lasse Blaauwbroek). Tactic language ^^^^^^^^^^^^^^^ - **Changed:** The "reference" tactic generic argument now accepts arbitrary variables of the goal context (`#12254 `_, by Pierre-Marie Pédrot). - **Added:** An array library for Ltac2 (as compatible as possible with OCaml standard library) (`#10343 `_, by Michael Soegtrop). - **Added:** The Ltac2 rebinding command :cmd:`Ltac2 Set` has been extended with the ability to give a name to the old value so as to be able to reuse it inside the new one (`#11503 `_, by Pierre-Marie Pédrot). - **Added:** Ltac2 notations for :tacn:`enough` and :tacn:`eenough` (`#11740 `_, by Michael Soegtrop). - **Added:** New Ltac2 function ``Fresh.Free.of_goal`` to return the list of names of declarations of the current goal; new Ltac2 function ``Fresh.in_goal`` to return a variable fresh in the current goal (`#11882 `_, by Hugo Herbelin). - **Added:** Ltac2 notations for reductions in terms: :n:`eval @red_expr in @term` (`#11981 `_, by Michael Soegtrop). - **Fixed:** The :flag:`Ltac Profiling` machinery now correctly handles backtracking into multi-success tactics. The call-counts of some tactics are unfortunately inflated by 1, as some tactics are implicitly implemented as :g:`tac + fail`, which has two entry-points rather than one (fixes `#12196 `_, `#12197 `_, by Jason Gross). SSReflect ^^^^^^^^^ .. _812SSRSearch: - **Changed:** The `Search (ssreflect)` command that used to be available when loading the `ssreflect` plugin has been moved to a separate plugin that needs to be loaded separately: `ssrsearch` (part of `#8855 `_, fixes `#12253 `_, by Théo Zimmermann). - **Deprecated:** `Search (ssreflect)` (available through `Require ssrsearch.`) in favor of the `headconcl:` clause of :cmd:`Search` (part of `#8855 `_, by Théo Zimmermann). Flags, options and attributes ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ - **Changed:** :term:`Legacy attributes ` can now be passed in any order (`#11665 `_, by Théo Zimmermann). - **Removed:** ``Typeclasses Axioms Are Instances`` flag, deprecated since 8.10. Use :cmd:`Declare Instance` for axioms which should be instances (`#11185 `_, by Théo Zimmermann). - **Removed:** Deprecated unsound compatibility ``Template Check`` flag that was introduced in 8.10 to help users gradually move their template polymorphic inductive type definitions outside sections (`#11546 `_, by Pierre-Marie Pédrot). - **Removed:** Deprecated ``Shrink Obligations`` flag (`#11828 `_, by Emilio Jesus Gallego Arias). - **Removed:** Unqualified ``polymorphic``, ``monomorphic``, ``template``, ``notemplate`` attributes (they were deprecated since Coq 8.10). Use :attr:`universes(polymorphic)`, ``universes(monomorphic)``, :attr:`universes(template)` and ``universes(notemplate)`` instead (`#11663 `_, by Théo Zimmermann). - **Deprecated:** `Hide Obligations` flag (`#11828 `_, by Emilio Jesus Gallego Arias). - **Added:** Handle the :attr:`local` attribute in :cmd:`Canonical Structure` declarations (`#11162 `_, by Enrico Tassi). - **Added:** New attributes supported when defining an inductive type :attr:`universes(cumulative)`, ``universes(noncumulative)`` and :attr:`private(matching)`, which correspond to legacy attributes ``Cumulative``, ``NonCumulative``, and the previously undocumented ``Private`` (`#11665 `_, by Théo Zimmermann). - **Added:** The :ref:`Hint ` commands now accept the :attr:`export` locality as an attribute, allowing to make import-scoped hints (`#11812 `_, by Pierre-Marie Pédrot). - **Added:** `Cumulative StrictProp` to control cumulativity of |SProp| (`#12034 `_, by Gaëtan Gilbert). Commands ^^^^^^^^ .. _812Coercions: - **Changed:** The :cmd:`Coercion` command has been improved to check the coherence of the inheritance graph. It checks whether a circular inheritance path of `C >-> C` is convertible with the identity function or not, then report it as an ambiguous path if it is not. The new mechanism does not report ambiguous paths that are redundant with others. For example, checking the ambiguity of `[f; g]` and `[f'; g]` is redundant with that of `[f]` and `[f']` thus will not be reported (`#11258 `_, by Kazuhiko Sakaguchi). - **Changed:** Several commands (:cmd:`Search`, :cmd:`About`, ...) now print the implicit arguments in brackets when printing types (`#11795 `_, by Simon Boulier). - **Changed:** The warning when using :cmd:`Require` inside a section moved from the ``deprecated`` category to the ``fragile`` category, because there is no plan to remove the functionality at this time (`#11972 `_, by Gaëtan Gilbert). - **Changed:** :cmd:`Redirect` now obeys the :opt:`Printing Width` and :opt:`Printing Depth` options (`#12358 `_, by Emilio Jesus Gallego Arias). - **Removed:** Recursive OCaml loadpaths are not supported anymore; the command ``Add Rec ML Path`` has been removed; ``Add ML Path`` is now the preferred one. We have also dropped support for the non-qualified version of the ``Add LoadPath`` command, that is to say, the ``Add LoadPath dir`` version; now, you must always specify a prefix now using ``Add Loadpath dir as Prefix`` (`#11618 `_, by Emilio Jesus Gallego Arias). - **Removed:** undocumented ``Chapter`` command. Use :cmd:`Section` instead (`#11746 `_, by Théo Zimmermann). - **Removed:** ``SearchAbout`` command that was deprecated since 8.5. Use :cmd:`Search` instead (`#11944 `_, by Jim Fehrle). - **Deprecated:** Declaration of arbitrary terms as hints. Global references are now preferred (`#7791 `_, by Pierre-Marie Pédrot). - **Deprecated:** `SearchHead` in favor of the new `headconcl:` clause of :cmd:`Search` (part of `#8855 `_, by Théo Zimmermann). - **Added:** :cmd:`Print Canonical Projections` can now take constants as arguments and prints only the unification rules that involve or are synthesized from the given constants (`#10747 `_, by Kazuhiko Sakaguchi). - **Added:** A section variable introduced with :cmd:`Let` can be declared as a :cmd:`Canonical Structure` (`#11164 `_, by Enrico Tassi). - **Added:** Support for universe bindings and universe contrainsts in :cmd:`Let` definitions (`#11534 `_, by Théo Zimmermann). .. _812Search: - **Added:** Support for new clauses `hyp:`, `headhyp:`, `concl:`, `headconcl:`, `head:` and `is:` in :cmd:`Search`. Support for complex search queries combining disjunctions, conjunctions and negations (`#8855 `_, by Hugo Herbelin, with ideas from Cyril Cohen and help from Théo Zimmermann). - **Fixed:** A printing bug in the presence of elimination principles with local definitions (`#12295 `_, by Hugo Herbelin; fixes `#12233 `_). - **Fixed:** Anomalies with :cmd:`Show Proof` (`#12296 `_, by Hugo Herbelin; fixes `#12234 `_). Tools ^^^^^ - **Changed:** Internal options and behavior of ``coqdep``. ``coqdep`` no longer works as a replacement for ``ocamldep``, thus ``.ml`` files are not supported as input. Also, several deprecated options have been removed: ``-w``, ``-D``, ``-mldep``, ``-prefix``, ``-slash``, and ``-dumpbox``. Passing ``-boot`` to ``coqdep`` will not load any path by default now, ``-R/-Q`` should be used instead (`#11523 `_ and `#11589 `_, by Emilio Jesus Gallego Arias). - **Changed:** The order in which the require flags `-ri`, `-re`, `-rfrom`, etc. and the option flags `-set`, `-unset` are given now matters. In particular, it is now possible to interleave the loading of plugins and the setting of options by choosing the right order for these flags. The load flags `-l` and `-lv` are still processed afterward for now (`#11851 `_ and `#12097 `_, by Lasse Blaauwbroek). - **Changed:** The ``cleanall`` target of a makefile generated by ``coq_makefile`` now erases ``.lia.cache`` and ``.nia.cache`` (`#12006 `_, by Olivier Laurent). - **Changed:** The output of ``make TIMED=1`` (and therefore the timing targets such as ``print-pretty-timed`` and ``print-pretty-timed-diff``) now displays the full name of the output file being built, rather than the stem of the rule (which was usually the filename without the extension, but in general could be anything for user-defined rules involving ``%``) (`#12126 `_, by Jason Gross). - **Changed:** 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 `_, by Jason Gross). - **Changed:** The pretty-timed scripts and targets now print a newline at the end of their tables, rather than creating text with no trailing newline (`#12368 `_, by Jason Gross). - **Removed:** The `-load-ml-source` and `-load-ml-object` command-line options have been removed; their use was very limited, you can achieve the same adding additional object files in the linking step or using a plugin (`#11409 `_, by Emilio Jesus Gallego Arias). - **Removed:** The confusingly-named `-require` command-line option, which was deprecated since 8.11. Use the equivalent `-require-import` / `-ri` options instead (`#12005 `_, by Théo Zimmermann). - **Deprecated:** ``-cumulative-sprop`` command-line flag in favor of the new `Cumulative StrictProp` flag (`#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` (`#10592 `_, by Thomas Letan). - **Added:** The ``make-both-single-timing-files.py`` script now accepts a ``--fuzz=N`` parameter on the command line which determines how many characters two lines may be offset in the "before" and "after" timing logs while still being considered the same line. When invoking this script via the ``print-pretty-single-time-diff`` target in a ``Makefile`` made by ``coq_makefile``, you can set this argument by passing ``TIMING_FUZZ=N`` to ``make`` (`#11302 `_, by Jason Gross). - **Added:** The ``make-one-time-file.py`` and ``make-both-time-files.py`` scripts now accept a ``--real`` parameter on the command line to print real times rather than user times in the tables. The ``make-both-single-timing-files.py`` script accepts a ``--user`` parameter to use user times. When invoking these scripts via the ``print-pretty-timed`` or ``print-pretty-timed-diff`` or ``print-pretty-single-time-diff`` targets in a ``Makefile`` made by ``coq_makefile``, you can set this argument by passing ``TIMING_REAL=1`` (to pass ``--real``) or ``TIMING_REAL=0`` (to pass ``--user``) to ``make`` (`#11302 `_, by Jason Gross). - **Added:** Coq's build system now supports both ``TIMING_FUZZ``, ``TIMING_SORT_BY``, and ``TIMING_REAL`` just like a ``Makefile`` made by ``coq_makefile`` (`#11302 `_, by Jason Gross). - **Added:** The ``make-one-time-file.py`` and ``make-both-time-files.py`` scripts now include peak memory usage information in the tables (can be turned off by the ``--no-include-mem`` command-line parameter), and a ``--sort-by-mem`` parameter to sort the tables by memory rather than time. When invoking these scripts via the ``print-pretty-timed`` or ``print-pretty-timed-diff`` targets in a ``Makefile`` made by ``coq_makefile``, you can set this argument by passing ``TIMING_INCLUDE_MEM=0`` (to pass ``--no-include-mem``) and ``TIMING_SORT_BY_MEM=1`` (to pass ``--sort-by-mem``) to ``make`` (`#11606 `_, by Jason Gross). - **Added:** Coq's build system now supports both ``TIMING_INCLUDE_MEM`` and ``TIMING_SORT_BY_MEM`` just like a ``Makefile`` made by ``coq_makefile`` (`#11606 `_, by Jason Gross). - **Added:** New ``coqc`` / ``coqtop`` option ``-boot`` that will not bind the `Coq` library prefix by default (`#11617 `_, by Emilio Jesus Gallego Arias). - **Added:** Definitions in coqdoc link to themselves, giving access in html to their own url (`#12026 `_, by Hugo Herbelin; granting `#7093 `_). - **Added:** Hyperlinks on bound variables in coqdoc (`#12033 `_, by Hugo Herbelin; it incidentally fixes `#7697 `_). - **Added:** Highlighting of link targets in coqdoc (`#12091 `_, by Hugo Herbelin). - **Fixed:** 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 `_ fixes `#11301 `_, by Jason Gross). - **Fixed:** The sorting order of the timing script ``make-both-time-files.py`` and the target ``print-pretty-timed-diff`` is now deterministic even when the sorting order is ``absolute`` or ``diff``; previously the relative ordering of two files with identical times was non-deterministic (`#11606 `_, by Jason Gross). - **Fixed:** Fields of a record tuple now link in coqdoc to their definition (`#12027 `_, fixes `#3415 `_, by Hugo Herbelin). - **Fixed:** ``coqdoc`` now reports the location of a mismatched opening ``[[`` instead of throwing an uninformative exception (`#12037 `_, fixes `#9670 `_, by Xia Li-yao). - **Fixed:** coqchk incorrectly reporting names from opaque modules as axioms (`#12076 `_, by Pierre Roux; fixes `#5030 `_). - **Fixed:** coq_makefile-generated ``Makefile``\s ``pretty-timed-diff`` target no longer raises Python exceptions in the rare corner case where the log of times contains no files (`#12388 `_, fixes `#12387 `_, by Jason Gross). CoqIDE ^^^^^^^^ - **Removed:** "Tactic" menu from CoqIDE which had been unmaintained for a number of years (`#11414 `_, by Pierre-Marie Pédrot). - **Removed:** "Revert all buffers" command from CoqIDE which had been broken for a long time (`#11415 `_, by Pierre-Marie Pédrot). .. _812Stdlib: Standard library ^^^^^^^^^^^^^^^^ - **Changed:** Notations :n:`[|@term|]` and :n:`[||@term||]` for morphisms from 63-bit integers to :g:`Z` and :g:`zn2z int` have been removed in favor of :n:`φ(@term)` and :n:`Φ(@term)` respectively. These notations were breaking Ltac parsing (`#11686 `_, by Maxime Dénès). - **Changed:** The names of ``Sorted_sort`` and ``LocallySorted_sort`` in ``Coq.Sorting.MergeSort`` have been swapped to appropriately reflect their meanings (`#11885 `_, by Lysxia). - **Changed:** Notations :g:`<=?` and :g:``_, `#11891 `_, by Jason Gross). - **Changed:** The level of :g:`≡` in ``Coq.Numbers.Cyclic.Int63.Int63`` is now 70, no associativity, in line with :g:`=`. Note that this is a minor incompatibility with developments that declare their own :g:`≡` notation and import ``Int63`` (fixes `#11905 `_, `#11909 `_, by Jason Gross). - **Changed:** No longer re-export ``ListNotations`` from ``Program`` (``Program.Syntax``) (`#11992 `_, by Antonio Nikishaev). - **Changed:** It is now possible to import the :g:`nsatz` machinery without transitively depending on the axioms of the real numbers nor of classical logic by loading ``Coq.nsatz.NsatzTactic`` rather than ``Coq.nsatz.Nsatz``. Note that some constants have changed kernel names, living in ``Coq.nsatz.NsatzTactic`` rather than ``Coq.nsatz.Nsatz``; this might cause minor incompatibilities that can be fixed by actually running :g:`Import Nsatz` rather than relying on absolute names (`#12073 `_, by Jason Gross; fixes `#5445 `_). - **Changed:** new lemma ``NoDup_incl_NoDup`` in ``List.v`` to remove useless hypothesis `NoDup l'` in ``Sorting.Permutation.NoDup_Permutation_bis`` (`#12120 `_, by Olivier Laurent). - **Changed:** :cmd:`Fixpoints ` of the standard library without a recursive call turned into ordinary :cmd:`Definitions ` (`#12121 `_, by Hugo Herbelin; fixes `#11903 `_). - **Deprecated:** ``Bool.leb`` in favor of ``Bool.le``. The definition of ``Bool.le`` is made local to avoid conflicts with ``Nat.le``. As a consequence, previous calls to ``leb`` based on importing ``Bool`` should now be qualified into ``Bool.le`` even if ``Bool`` is imported (`#12162 `_, by Olivier Laurent). - **Added:** Theorem :g:`bezout_comm` for natural numbers (`#11127 `_, by Daniel de Rauglaudre). - **Added** :g:`rew dependent` notations for the dependent version of :g:`rew` in :g:`Coq.Init.Logic.EqNotations` to improve the display and parsing of :g:`match` statements on :g:`Logic.eq` (`#11240 `_, by Jason Gross). - **Added:** Lemmas about lists: - properties of ``In``: ``in_elt``, ``in_elt_inv`` - properties of ``nth``: ``app_nth2_plus``, ``nth_middle``, ``nth_ext`` - properties of ``last``: ``last_last``, ``removelast_last`` - properties of ``remove``: ``remove_cons``, ``remove_app``, ``notin_remove``, ``in_remove``, ``in_in_remove``, ``remove_remove_comm``, ``remove_remove_eq``, ``remove_length_le``, ``remove_length_lt`` - properties of ``concat``: ``in_concat``, ``remove_concat`` - properties of ``map`` and ``flat_map``: ``map_last``, ``map_eq_cons``, ``map_eq_app``, ``flat_map_app``, ``flat_map_ext``, ``nth_nth_nth_map`` - properties of ``incl``: ``incl_nil_l``, ``incl_l_nil``, ``incl_cons_inv``, ``incl_app_app``, ``incl_app_inv``, ``remove_incl``, ``incl_map``, ``incl_filter``, ``incl_Forall_in_iff`` - properties of ``NoDup`` and ``nodup``: ``NoDup_rev``, ``NoDup_filter``, ``nodup_incl`` - properties of ``Exists`` and ``Forall``: ``Exists_nth``, ``Exists_app``, ``Exists_rev``, ``Exists_fold_right``, ``incl_Exists``, ``Forall_nth``, ``Forall_app``, ``Forall_elt``, ``Forall_rev``, ``Forall_fold_right``, ``incl_Forall``, ``map_ext_Forall``, ``Exists_or``, ``Exists_or_inv``, ``Forall_and``, ``Forall_and_inv``, ``exists_Forall``, ``Forall_image``, ``concat_nil_Forall``, ``in_flat_map_Exists``, ``notin_flat_map_Forall`` - properties of ``repeat``: ``repeat_cons``, ``repeat_to_concat`` - definitions and properties of ``list_sum`` and ``list_max``: ``list_sum_app``, ``list_max_app``, ``list_max_le``, ``list_max_lt`` - misc: ``elt_eq_unit``, ``last_length``, ``rev_eq_app``, ``removelast_firstn_len``, ``cons_seq``, ``seq_S`` (`#11249 `_, `#12237 `_, by Olivier Laurent). - **Added:** Well-founded induction principles for `nat`: ``lt_wf_rect1``, ``lt_wf_rect``, ``gt_wf_rect``, ``lt_wf_double_rect`` (`#11335 `_, by Olivier Laurent). - **Added:** ``remove'`` and ``count_occ'`` over lists, alternatives to ``remove`` and ``count_occ`` based on ``filter`` (`#11350 `_, by Yishuai Li). - **Added:** Facts about ``N.iter`` and ``Pos.iter``: - ``N.iter_swap_gen``, ``N.iter_swap``, ``N.iter_succ``, ``N.iter_succ_r``, ``N.iter_add``, ``N.iter_ind``, ``N.iter_invariant`` - ``Pos.iter_succ_r``, ``Pos.iter_ind`` (`#11880 `_, by Lysxia). - **Added:** Facts about ``Permutation``: - structure: ``Permutation_refl'``, ``Permutation_morph_transp`` - compatibilities: ``Permutation_app_rot``, ``Permutation_app_swap_app``, ``Permutation_app_middle``, ``Permutation_middle2``, ``Permutation_elt``, ``Permutation_Forall``, ``Permutation_Exists``, ``Permutation_Forall2``, ``Permutation_flat_map``, ``Permutation_list_sum``, ``Permutation_list_max`` - inversions: ``Permutation_app_inv_m``, ``Permutation_vs_elt_inv``, ``Permutation_vs_cons_inv``, ``Permutation_vs_cons_cons_inv``, ``Permutation_map_inv``, ``Permutation_image``, ``Permutation_elt_map_inv`` - length-preserving definition by means of transpositions ``Permutation_transp`` with associated properties: ``Permutation_transp_sym``, ``Permutation_transp_equiv``, ``Permutation_transp_cons``, ``Permutation_Permutation_transp``, ``Permutation_ind_transp`` (`#11946 `_, by Olivier Laurent). - **Added:** Notations for sigma types: ``{ x & P & Q }``, ``{ ' pat & P }``, ``{ ' pat & P & Q }`` (`#11957 `_, by Olivier Laurent). - **Added:** Order relations ``lt`` and ``compare`` added in ``Bool.Bool``. Order properties for ``bool`` added in ``Bool.BoolOrder`` as well as two modules ``Bool_as_OT`` and ``Bool_as_DT`` in ``Structures.OrdersEx`` (`#12008 `_, by Olivier Laurent). - **Added:** Properties of some operations on vectors: - ``nth_order``: ``nth_order_hd``, ``nth_order_tl``, ``nth_order_ext`` - ``replace``: ``nth_order_replace_eq``, ``nth_order_replace_neq``, ``replace_id``, ``replace_replace_eq``, ``replace_replace_neq`` - ``map``: ``map_id``, ``map_map``, ``map_ext_in``, ``map_ext`` - ``Forall`` and ``Forall2``: ``Forall_impl``, ``Forall_forall``, ``Forall_nth_order``, ``Forall2_nth_order`` (`#12014 `_, by Olivier Laurent). - **Added:** Lemmas :g:`orb_negb_l`, :g:`andb_negb_l`, :g:`implb_true_iff`, :g:`implb_false_iff`, :g:`implb_true_r`, :g:`implb_false_r`, :g:`implb_true_l`, :g:`implb_false_l`, :g:`implb_same`, :g:`implb_contrapositive`, :g:`implb_negb`, :g:`implb_curry`, :g:`implb_andb_distrib_r`, :g:`implb_orb_distrib_r`, :g:`implb_orb_distrib_l` in library :g:`Bool` (`#12018 `_, by Hugo Herbelin). - **Added:** Definition and properties of cyclic permutations / circular shifts: ``CPermutation`` (`#12031 `_, by Olivier Laurent). - **Added:** ``Structures.OrderedTypeEx.Ascii_as_OT`` (`#12044 `_, by formalize.eth (formalize@protonmail.com)). - **Fixed:** Rewrote ``Structures.OrderedTypeEx.String_as_OT.compare`` to avoid huge proof terms (`#12044 `_, by formalize.eth (formalize@protonmail.com); fixes `#12015 `_). Reals library ^^^^^^^^^^^^^ - **Changed:** Cleanup of names in the Reals theory: replaced `tan_is_inj` with `tan_inj` and replaced `atan_right_inv` with `tan_atan` - compatibility notations are provided. Moved various auxiliary lemmas from `Ratan.v` to more appropriate places (`#9803 `_, by Laurent Théry and Michael Soegtrop). - **Changed:** Replace `CRzero` and `CRone` by `CR_of_Q 0` and `CR_of_Q 1` in `ConstructiveReals`. Use implicit arguments for `ConstructiveReals`. Move `ConstructiveReals` into new directory `Abstract`. Remove imports of implementations inside those `Abstract` files. Move implementation by means of Cauchy sequences in new directory `Cauchy`. Split files `ConstructiveMinMax` and `ConstructivePower`. .. warning:: The constructive reals modules are marked as experimental. (`#11725 `_, `#12287 `_ and `#12288 `_, by Vincent Semeria). - **Removed:** Type `RList` has been removed. All uses have been replaced by `list R`. Functions from `RList` named `In`, `Rlength`, `cons_Rlist`, `app_Rlist` have also been removed as they are essentially the same as `In`, `length`, `app`, and `map` from `List`, modulo the following changes: - `RList.In x (RList.cons a l)` used to be convertible to `(x = a) \\/ RList.In x l`, but `List.In x (a :: l)` is convertible to `(a = x) \\/ List.In l`. The equality is reversed. - `app_Rlist` and `List.map` take arguments in different order. (`#11404 `_, by Yves Bertot). - **Added:** inverse trigonometric functions `asin` and `acos` with lemmas for the derivatives, bounds and special values of these functions; an extensive set of identities between trigonometric functions and their inverse functions; lemmas for the injectivity of sine and cosine; lemmas on the derivative of the inverse of decreasing functions and on the derivative of horizontally mirrored functions; various generic auxiliary lemmas and definitions for `Rsqr`, `sqrt`, `posreal` and others (`#9803 `_, by Laurent Théry and Michael Soegtrop). Extraction ^^^^^^^^^^ - **Added:** Support for better extraction of strings in OCaml and Haskell: `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 `_, by Xavier Leroy, with help from Maxime Dénès, review by Hugo Herbelin). - **Fixed:** In Haskell extraction with ``ExtrHaskellString``, equality comparisons on strings and characters are now guaranteed to be uniquely well-typed, even in very polymorphic contexts under ``unsafeCoerce``; this is achieved by adding type annotations to the extracted code, and by making ``ExtrHaskellString`` export ``ExtrHaskellBasic`` (`#12263 `_, by Jason Gross, fixes `#12257 `_ and `#12258 `_). .. _812Refman: Reference manual ^^^^^^^^^^^^^^^^ - **Changed:** The reference manual has been restructured to get a more logical 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 (`CEP#43 `_, implemented in `#11601 `_, `#11871 `_, `#11914 `_, `#12148 `_, `#12172 `_, `#12239 `_ and `#12330 `_, effort inspired by Matthieu Sozeau, led by Théo Zimmermann, with 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 which is documented in :ref:`syntax-conventions` (`#11183 `_, `#11314 `_, `#11423 `_, `#11705 `_, `#11718 `_, `#11720 `_, `#11961 `_ and `#12103 `_, by Jim Fehrle, reviewed by Théo Zimmermann). - **Added:** A glossary of terms and an index of attributes (`#11869 `_, `#12150 `_ and `#12224 `_, by Jim Fehrle and Théo Zimmermann, reviewed by Clément Pit-Claudel) - **Added:** A selector that allows switching between versions of the reference manual (`#12286 `_, by Clément Pit-Claudel). - **Fixed:** Most of the documented syntax has been thoroughly updated to make it accurate and easily understood. This was done using a semi-automated `doc_grammar` tool introduced for this purpose and through significant revisions to the text (`#9884 `_, `#10614 `_, `#11314 `_, `#11423 `_, `#11705 `_, `#11718 `_, `#11720 `_ `#11797 `_, `#11913 `_, `#11958 `_, `#11960 `_, `#11961 `_ and `#12103 `_, by Jim Fehrle, reviewed by Théo Zimmermann and Jason Gross). Infrastructure and dependencies ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ - **Changed:** Minimal versions of dependencies for building the reference manual: now requires Sphinx >= 2.3.1 & < 3.0.0, sphinx_rtd_theme 0.4.3+ and sphinxcontrib-bibtex 0.4.2+. .. warning:: The reference manual is known not to build properly with Sphinx 3. (`#12224 `_, by Jim Fehrle and Théo Zimmermann). - **Removed:** Python 2 is no longer required in any part of the codebase (`#11245 `_, by Emilio Jesus Gallego Arias). Changes in 8.12.0 ~~~~~~~~~~~~~~~~~~~~~ **Notations** - **Added:** Simultaneous definition of terms and notations now support custom entries (`#12523 `_, fixes `#11121 `_ by Maxime Dénès). - **Fixed:** Printing bug with notations for n-ary applications used with applied references (`#12683 `_, fixes `#12682 `_, by Hugo Herbelin). **Tactics** - **Fixed:** :tacn:`typeclasses eauto` (and discriminated hint bases) now correctly classify local variables as being unfoldable (`#12572 `_, fixes `#12571 `_, by Pierre-Marie Pédrot). **Tactic language** - **Fixed:** Excluding occurrences was causing an anomaly in tactics (e.g., :g:`pattern _ at L` where :g:`L` is :g:`-2`) (`#12541 `_, fixes `#12228 `_, by Pierre Roux). - **Fixed:** Parsing of multi-parameters Ltac2 types (`#12594 `_, fixes `#12595 `_, by Pierre-Marie Pédrot). **SSReflect** - **Fixed:** Do not store the full environment inside ssr ast_closure_term (`#12708 `_, fixes `#12707 `_, by Pierre-Marie Pédrot). **Commands and options** - **Fixed:** Properly report the mismatched magic number of vo files (`#12677 `_, fixes `#12513 `_, by Pierre-Marie Pédrot). - **Changed:** Arbitrary hints have been undeprecated, and their definition now triggers a standard warning instead (`#12678 `_, fixes `#11970 `_, by Pierre-Marie Pédrot). **CoqIDE** - **Fixed:** CoqIDE no longer exits when trying to open a file whose name is not a valid identifier (`#12562 `_, fixes `#10988 `_, by Vincent Laporte). **Infrastructure and dependencies** - **Fixed:** Running ``make`` in ``test-suite/`` twice (or more) in a row will no longer rebuild the ``modules/`` tests on subsequent runs, if they have not been modified in the meantime (`#12583 `_, fixes `#12582 `_, by Jason Gross). Changes in 8.12.1 ~~~~~~~~~~~~~~~~~~~~~ **Kernel** - **Fixed:** Incompleteness of conversion checking on problems involving :ref:`eta-expansion-sect` and :ref:`cumulative universe polymorphic inductive types ` (`#12738 `_, fixes `#7015 `_, by Gaëtan Gilbert). - **Fixed:** Polymorphic side-effects inside monomorphic definitions were incorrectly handled as not inlined. This allowed deriving an inconsistency (`#13331 `_, fixes `#13330 `_, by Pierre-Marie Pédrot). **Notations** - **Fixed:** Undetected collision between a lonely notation and a notation in scope at printing time (`#12946 `_, fixes the first part of `#12908 `_, by Hugo Herbelin). - **Fixed:** Printing of notations in custom entries with variables not mentioning an explicit level (`#13026 `_, fixes `#12775 `_ and `#13018 `_, by Hugo Herbelin). **Tactics** - **Added:** :tacn:`replace` and :tacn:`inversion` support registration of a :g:`core.identity`\-like equality in :g:`Type`, such as HoTT's :g:`path` (`#12847 `_, partially fixes `#12846 `_, by Hugo Herbelin). - **Fixed:** Anomaly with :tacn:`injection` involving artificial dependencies disappearing by reduction (`#12816 `_, fixes `#12787 `_, by Hugo Herbelin). **Tactic language** - **Fixed:** Miscellaneous issues with locating tactic errors (`#13247 `_, fixes `#12773 `_ and `#12992 `_, by Hugo Herbelin). **SSReflect** - **Fixed:** Regression in error reporting after :tacn:`case `. A generic error message "Could not fill dependent hole in apply" was reported for any error following :tacn:`case ` or :tacn:`elim ` (`#12857 `_, fixes `#12837 `_, by Enrico Tassi). **Commands and options** - **Fixed:** Failures of :cmd:`Search` in the presence of primitive projections (`#13301 `_, fixes `#13298 `_, by Hugo Herbelin). - **Fixed:** :cmd:`Search` supports filtering on parts of identifiers which are not proper identifiers themselves, such as :n:`"1"` (`#13351 `_, fixes `#13349 `_, by Hugo Herbelin). **Tools** - **Fixed:** Special symbols now escaped in the index produced by coqdoc, avoiding collision with the syntax of the output format (`#12754 `_, fixes `#12752 `_, by Hugo Herbelin). - **Fixed:** The `details` environment added in the 8.12 release can now be used as advertised in the reference manual (`#12772 `_, by Thomas Letan). - **Fixed:** Targets such as ``print-pretty-timed`` in ``coq_makefile``\-made ``Makefile``\s no longer error in rare cases where ``--output-sync`` is not passed to make and the timing output gets interleaved in just the wrong way (`#13063 `_, fixes `#13062 `_, by Jason Gross). **CoqIDE** - **Fixed:** View menu "Display parentheses" (`#12794 `_ and `#13067 `_, fixes `#12793 `_, by Jean-Christophe Léchenet and Hugo Herbelin). **Infrastructure and dependencies** - **Added:** Coq is now tested against OCaml 4.11.1 (`#12972 `_, by Emilio Jesus Gallego Arias). - **Fixed:** The reference manual can now build with Sphinx 3 (`#13011 `_, fixes `#12332 `_, by Théo Zimmermann and Jim Fehrle). Changes in 8.12.2 ~~~~~~~~~~~~~~~~~ **Notations** - **Fixed:** 8.12 regression causing notations mentioning a coercion to be ignored (`#13436 `_, fixes `#13432 `_, by Hugo Herbelin). **Tactics** - **Fixed:** 8.12 regression: incomplete inference of implicit arguments in :tacn:`exists` (`#13468 `_, fixes `#13456 `_, by Hugo Herbelin). Version 8.11 ------------ Summary of changes ~~~~~~~~~~~~~~~~~~ The main changes brought by Coq version 8.11 are: - :ref:`Ltac2<811Ltac2>`, a new tactic language for writing more robust larger scale tactics, with built-in support for datatypes and the multi-goal tactic monad. - :ref:`Primitive floats<811PrimitiveFloats>` are integrated in terms and follow the binary64 format of the IEEE 754 standard, as specified in the `Coq.Float.Floats` library. - :ref:`Cleanups<811Sections>` of the section mechanism, delayed proofs and further restrictions of template polymorphism to fix soundness issues related to universes. - New :ref:`unsafe flags<811UnsafeFlags>` to disable locally guard, positivity and universe checking. Reliance on these flags is always printed by :g:`Print Assumptions`. - :ref:`Fixed bugs<811ExportBug>` of :g:`Export` and :g:`Import` that can have a significant impact on user developments (**common source of incompatibility!**). - New interactive development method based on `vos` :ref:`interface files<811vos>`, allowing to work on a file without recompiling the proof parts of their dependencies. - New :g:`Arguments` annotation for :ref:`bidirectional type inference<811BidirArguments>` configuration for reference (e.g. constants, inductive) applications. - New :ref:`refine attribute<811RefineInstance>` for :cmd:`Instance` can be used instead of the removed ``Refine Instance Mode``. - Generalization of the :g:`under` and :g:`over` :ref:`tactics<811SSRUnderOver>` of SSReflect to arbitrary relations. - :ref:`Revision<811Reals>` of the :g:`Coq.Reals` library, its axiomatisation and instances of the constructive and classical real numbers. Additionally, while the `omega` tactic is not yet deprecated in this version of Coq, it should soon be the case and we already recommend users to switch to :tacn:`lia` in new proof scripts. The ``dev/doc/critical-bugs`` file documents the known critical bugs 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 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). 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. The opam repository for Coq packages has been maintained by 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/. The 61 contributors to this version are Michael D. Adams, Guillaume Allais, Helge Bahmann, Langston Barrett, Guillaume Bertholon, Frédéric Besson, Simon Boulier, Michele Caci, Tej Chajed, Arthur Charguéraud, Cyril Cohen, Frédéric Dabrowski, Arthur Azevedo de Amorim, Maxime Dénès, Nikita Eshkeev, Jim Fehrle, Emilio Jesús Gallego Arias, Paolo G. Giarrusso, Gaëtan Gilbert, Georges Gonthier, Jason Gross, Samuel Gruetter, Armaël Guéneau, Hugo Herbelin, Florent Hivert, Jasper Hugunin, Shachar Itzhaky, Jan-Oliver Kaiser, Robbert Krebbers, Vincent Laporte, Olivier Laurent, Samuel Lelièvre, Nicholas Lewycky, Yishuai Li, Jose Fernando Lopez Fernandez, Andreas Lynge, Kenji Maillard, Erik Martin-Dorel, Guillaume Melquiond, Alexandre Moine, Oliver Nash, Wojciech Nawrocki, Antonio Nikishaev, Pierre-Marie Pédrot, Clément Pit-Claudel, Lars Rasmusson, Robert Rand, Talia Ringer, JP Rodi, Pierre Roux, Kazuhiko Sakaguchi, Vincent Semeria, Michael Soegtrop, Matthieu Sozeau, spanjel, Claude Stolze, Enrico Tassi, Laurent Théry, James R. Wilcox, Xia Li-yao, Théo Zimmermann Many power users helped to improve the design of the new features via the issue and pull request system, the Coq development mailing list, the coq-club@inria.fr mailing list or the `Discourse forum `_. It would be impossible to mention exhaustively the names of everybody who to some extent influenced the development. Version 8.11 is the sixth release of Coq developed on a time-based development cycle. Its development spanned 3 months from the release of Coq 8.10. Pierre-Marie Pédrot is the release manager and maintainer of this release, assisted by Matthieu Sozeau. This release is the result of 2000+ commits and 300+ PRs merged, closing 75+ issues. | Paris, November 2019, | Matthieu Sozeau for the Coq development team | Changes in 8.11+beta1 ~~~~~~~~~~~~~~~~~~~~~ **Kernel** .. _811PrimitiveFloats: - **Added:** A built-in support of floating-point arithmetic, allowing one to devise efficient reflection tactics involving numerical 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 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`. See Section :ref:`primitive-floats` (`#9867 `_, closes `#8276 `_, by Guillaume Bertholon, Erik Martin-Dorel, Pierre Roux). - **Changed:** Internal definitions generated by :tacn:`abstract`\-like tactics are now inlined inside universe :cmd:`Qed`\-terminated polymorphic definitions, similarly to what happens for their monomorphic counterparts, (`#10439 `_, by Pierre-Marie Pédrot). .. _811Sections: - **Fixed:** Section data is now part of the kernel. Solves a soundness issue in interactive mode where global monomorphic universe constraints would be dropped when forcing a delayed opaque proof inside a polymorphic section. Also relaxes the nesting criterion for sections, as polymorphic sections can now appear inside a monomorphic one (`#10664 `_, by Pierre-Marie Pédrot). - **Changed:** Using ``SProp`` is now allowed by default, without needing to pass ``-allow-sprop`` or use :flag:`Allow StrictProp` (`#10811 `_, by Gaëtan Gilbert). **Specification language, type inference** .. _811BidirArguments: - **Added:** Annotation in `Arguments` for bidirectionality hints: it is now possible to tell type inference to use type information from the context once the `n` first arguments of an application are known. The syntax is: `Arguments foo x y & z`. See :ref:`bidirectionality_hints` (`#10049 `_, by Maxime Dénès with help from Enrico Tassi). - **Added:** Record fields can be annotated to prevent them from being used as canonical projections; see :ref:`canonicalstructures` for details (`#10076 `_, by Vincent Laporte). - **Changed:** Require parentheses around nested disjunctive patterns, so that pattern and term syntax are consistent; match branch patterns no longer require parentheses for notation at level 100 or more. .. warning:: Incompatibilities + In :g:`match p with (_, (0|1)) => ...` parentheses may no longer be omitted around :n:`0|1`. + Notation :g:`(p | q)` now potentially clashes with core pattern syntax, and should be avoided. ``-w disj-pattern-notation`` flags such :cmd:`Notation`. See :ref:`extendedpatternmatching` for details (`#10167 `_, by Georges Gonthier). - **Changed:** :cmd:`Function` always opens a proof when used with a ``measure`` or ``wf`` annotation, see :ref:`advanced-recursive-functions` for the updated documentation (`#10215 `_, by Enrico Tassi). - **Changed:** The legacy command :cmd:`Add Morphism` always opens a proof and cannot be used inside a module type. In order to declare a module type parameter that happens to be a morphism, use :cmd:`Declare Morphism`. See :ref:`deprecated_syntax_for_generalized_rewriting` for the updated documentation (`#10215 `_, by Enrico Tassi). - **Changed:** The universe polymorphism setting now applies from the opening of a section. In particular, it is not possible anymore to mix polymorphic and monomorphic definitions in a section when there are no variables nor universe constraints defined in this section. This makes the behavior consistent with the documentation. (`#10441 `_, by Pierre-Marie Pédrot) - **Added:** The :cmd:`Section` command now accepts the "universes" attribute. In addition to setting the section universe polymorphism, it also locally sets the universe polymorphic option inside the section (`#10441 `_, by Pierre-Marie Pédrot) - **Fixed:** ``Program Fixpoint`` now uses ``ex`` and ``sig`` to make telescopes involving ``Prop`` types (`#10758 `_, by Gaëtan Gilbert, fixing `#10757 `_ reported by Xavier Leroy). - **Changed:** 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 `_, by Gaëtan Gilbert). .. _811RefineInstance: - **Added:** :attr:`refine` attribute for :cmd:`Instance`, a more predictable version of the old ``Refine Instance Mode`` which unconditionally opens a proof (`#10996 `_, by Gaëtan Gilbert). - **Changed:** The unsupported attribute error is now an error-by-default warning, meaning it can be disabled (`#10997 `_, by Gaëtan Gilbert). - **Fixed:** Bugs sometimes preventing to define valid (co)fixpoints with implicit arguments in the presence of local definitions, see `#3282 `_ (`#11132 `_, by Hugo Herbelin). .. example:: The following features an implicit argument after a local definition. It was wrongly rejected. .. coqtop:: in Definition f := fix f (o := true) {n : nat} m {struct m} := match m with 0 => 0 | S m' => f (n:=n+1) m' end. **Notations** - **Added:** Numeral Notations now support sorts in the input to printing functions (e.g., numeral notations can be defined for terms containing things like `@cons Set nat nil`). (`#9883 `_, by Jason Gross). - **Added:** The :cmd:`Notation` and :cmd:`Infix` commands now support the `deprecated` attribute (`#10180 `_, by Maxime Dénès). - **Deprecated:** The former `compat` annotation for notations is deprecated, and its semantics changed. It is now made equivalent to using a `deprecated` attribute, and is no longer connected with the `-compat` command-line flag (`#10180 `_, by Maxime Dénès). - **Changed:** 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 `_, by Théo Zimmermann, simplification initially noticed by Jim Fehrle). **Tactics** - **Added:** Syntax :n:`injection @term as [= {+ @intropattern} ]` as an alternative to :n:`injection @term as {+ @simple_intropattern}` using the standard injection intropattern syntax (`#9288 `_, by Hugo Herbelin). - **Changed:** Reimplementation of the :tacn:`zify` tactic. The tactic is more efficient and copes with dependent hypotheses. It can also be extended by redefining the tactic ``zify_post_hook`` (`#9856 `_, fixes `#8898 `_, `#7886 `_, `#9848 `_ and `#5155 `_, by Frédéric Besson). - **Changed:** The goal selector tactical ``only`` now checks that the goal range it is given is valid instead of ignoring goals out of the focus range (`#10318 `_, by Gaëtan Gilbert). - **Added:** Flags :flag:`Lia Cache`, :flag:`Nia Cache` and :flag:`Nra Cache` (`#10765 `_, by Frédéric Besson, see `#10772 `_ for use case). - **Added:** The :tacn:`zify` tactic is now aware of `Z.to_N` (`#10774 `_, grants `#9162 `_, by Kazuhiko Sakaguchi). - **Changed:** The :tacn:`assert_succeeds` and :tacn:`assert_fails` tactics now only run their tactic argument once, even if it has multiple successes. This prevents blow-up and looping from using multisuccess tactics with :tacn:`assert_succeeds`. (`#10966 `_ fixes `#10965 `_, by Jason Gross). - **Fixed:** The :tacn:`assert_succeeds` and :tacn:`assert_fails` tactics now behave correctly when their tactic fully solves the goal. (`#10966 `_ fixes `#9114 `_, by Jason Gross). **Tactic language** .. _811Ltac2: - **Added:** Ltac2, a new version of the tactic language Ltac, that doesn't 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 ` (`#10002 `_, plugin authored by Pierre-Marie Pédrot, with contributions by various users, integration by Maxime Dénès, help on integrating / improving the documentation by Théo Zimmermann and Jim Fehrle). - **Added:** Ltac2 tactic notations with “constr” arguments can specify the notation scope for these arguments; see :ref:`ltac2_notations` for details (`#10289 `_, by Vincent Laporte). - **Changed:** White spaces are forbidden in the :n:`&@ident` syntax for ltac2 references that are described in :ref:`ltac2_built-in-quotations` (`#10324 `_, fixes `#10088 `_, authored by Pierre-Marie Pédrot). **SSReflect** .. _811SSRUnderOver: - **Added:** 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 calling the tactic :tacn:`rewrite `, 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 (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 being also needed so :tacn:`over` can discharge the ``'Under[ _ ]`` goal by instantiating the hidden evar.) This feature generalizing support for setoid-like relations is enabled as soon as we do both ``Require Import ssreflect.`` and ``Require Setoid.`` Finally, a rewrite rule ``UnderE`` has been added if one wants to "unprotect" the evar, and instantiate it manually with another rule than reflexivity (i.e., without using the :tacn:`over` tactic nor the ``over`` rewrite rule). See also Section :ref:`under_ssr` (`#10022 `_, by Erik Martin-Dorel, with suggestions and review by Enrico Tassi and Cyril Cohen). - **Added:** A :g:`void` notation for the standard library empty type (:g:`Empty_set`) (`#10932 `_, by Arthur Azevedo de Amorim). - **Added:** Lemma :g:`inj_compr` to :g:`ssr.ssrfun` (`#11136 `_, by Cyril Cohen). **Commands and options** - **Removed:** Deprecated flag `Refine Instance Mode` (`#9530 `_, fixes `#3632 `_, `#3890 `_ and `#4638 `_ by Maxime Dénès, review by Gaëtan Gilbert). - **Changed:** :cmd:`Fail` does not catch critical errors (including "stack overflow") anymore (`#10173 `_, by Gaëtan Gilbert). - **Removed:** Undocumented :n:`Instance : !@type` syntax (`#10185 `_, by Gaëtan Gilbert). - **Removed:** Deprecated ``Show Script`` command (`#10277 `_, by Gaëtan Gilbert). .. _811UnsafeFlags: - **Added:** Unsafe commands to enable/disable guard checking, positivity checking and universes checking (providing a local `-type-in-type`). See :ref:`controlling-typing-flags` (`#10291 `_ by Simon Boulier). .. _811ExportBug: - **Fixed:** Two bugs in :cmd:`Export`. This can have an impact on the behavior of the :cmd:`Import` command on libraries. `Import A` when `A` imports `B` which exports `C` was importing `C`, whereas :cmd:`Import` is not transitive. Also, after `Import A B`, the import of `B` was sometimes incomplete (`#10476 `_, by Maxime Dénès). .. warning:: This is a common source of incompatibilities in projects migrating to Coq 8.11. - **Changed:** Output generated by :flag:`Printing Dependent Evars Line` flag used by the Prooftree tool in Proof General (`#10489 `_, closes `#4504 `_, `#10399 `_ and `#10400 `_, by Jim Fehrle). - **Added:** Optionally highlight the differences between successive proof steps in the :cmd:`Show Proof` command. Experimental; only available in coqtop and Proof General for now, may be supported in other IDEs in the future (`#10494 `_, by Jim Fehrle). - **Removed:** Legacy commands ``AddPath``, ``AddRecPath``, and ``DelPath`` which were undocumented, broken variants of ``Add LoadPath``, ``Add Rec LoadPath``, and ``Remove LoadPath`` (`#11187 `_, by Maxime Dénès and Théo Zimmermann). **Tools** .. _811vos: - **Added:** `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 first compile the proofs contained in its dependencies (`#8642 `_ by Arthur Charguéraud, review by Maxime Dénès and Emilio Gallego). - **Added:** Command-line options `-require-import`, `-require-export`, `-require-import-from` and `-require-export-from`, as well as their shorthand, `-ri`, `-re`, `-refrom` and -`rifrom`. Deprecate confusing command line option `-require` (`#10245 `_ by Hugo Herbelin, review by Emilio Gallego). - **Changed:** Renamed `VDFILE` from `.coqdeps.d` to `..d` in the `coq_makefile` utility, where `` is the name of the output file given by the `-o` option. In this way two generated makefiles can coexist in the same directory (`#10947 `_, by Kazuhiko Sakaguchi). - **Fixed:** ``coq_makefile`` now supports environment variable ``COQBIN`` with no ending ``/`` character (`#11068 `_, by Gaëtan Gilbert). **Standard library** - **Changed:** Moved the :tacn:`auto` hints of the `OrderedType` module into a new `ordered_type` database (`#9772 `_, by Vincent Laporte). - **Removed:** Deprecated modules `Coq.ZArith.Zlogarithm` and `Coq.ZArith.Zsqrt_compat` (`#9811 `_, by Vincent Laporte). .. _811Reals: - **Added:** Module `Reals.Cauchy.ConstructiveCauchyReals` defines constructive real numbers by Cauchy sequences of rational numbers (`#10445 `_, by Vincent Semeria, with the help and review of Guillaume Melquiond and Bas Spitters). This module is not meant to be imported directly, please import `Reals.Abstract.ConstructiveReals` instead. - **Added:** New module `Reals.ClassicalDedekindReals` defines Dedekind real numbers as boolean-valued functions along with 3 logical axioms: limited principle of omniscience, excluded middle of negations, and functional extensionality. The exposed type :g:`R` in module :g:`Reals.Rdefinitions` now corresponds to these Dedekind reals, hidden behind an opaque module, which significantly reduces the number of axioms needed (see `Reals.Rdefinitions` and `Reals.Raxioms`), while preserving backward compatibility. Classical Dedekind reals are a quotient of constructive reals, which allows to transport many constructive proofs to the classical case (`#10827 `_, by Vincent Semeria, based on discussions with Guillaume Melquiond, Bas Spitters and Hugo Herbelin, code review by Hugo Herbelin). - **Added:** New lemmas on :g:`combine`, :g:`filter`, :g:`nodup`, :g:`nth`, and :g:`nth_error` functions on lists (`#10651 `_, and `#10731 `_, by Oliver Nash). - **Changed:** The lemma :g:`filter_app` was moved to the :g:`List` module (`#10651 `_, by Oliver Nash). - **Added:** Standard equivalence between weak excluded-middle and the classical instance of De Morgan's law, in module :g:`ClassicalFacts` (`#10895 `_, by Hugo Herbelin). **Infrastructure and dependencies** - **Changed:** Coq now officially supports OCaml 4.08. See `INSTALL` file for details (`#10471 `_, by Emilio Jesús Gallego Arias). Changes in 8.11.0 ~~~~~~~~~~~~~~~~~ **Kernel** - **Changed:** the native compilation (:tacn:`native_compute`) now creates a directory to contain temporary files instead of putting them in the root of the system temporary directory (`#11081 `_, by Gaëtan Gilbert). - **Fixed:** `#11360 `_. Broken section closing when a template polymorphic inductive type depends on a section variable through its parameters (`#11361 `_, by Gaëtan Gilbert). - **Fixed:** The type of :g:`Set+1` would be computed to be itself, leading to a proof of False (`#11422 `_, by Gaëtan Gilbert). **Specification language, type inference** - **Changed:** Heuristics for universe minimization to :g:`Set`: only minimize flexible universes (`#10657 `_, by Gaëtan Gilbert with help from Maxime Dénès and Matthieu Sozeau). - **Fixed:** A dependency was missing when looking for default clauses in the algorithm for printing pattern matching clauses (`#11233 `_, by Hugo Herbelin, fixing `#11231 `_, reported by Barry Jay). **Notations** - **Fixed:** :cmd:`Print Visibility` was failing in the presence of only-printing notations (`#11276 `_, by Hugo Herbelin, fixing `#10750 `_). - **Fixed:** Recursive notations with custom entries were incorrectly parsing `constr` instead of custom grammars (`#11311 `_ by Maxime Dénès, fixes `#9532 `_, `#9490 `_). **Tactics** - **Changed:** The tactics :tacn:`eapply`, :tacn:`refine` and variants no longer allow shelved goals to be solved by typeclass resolution (`#10762 `_, by Matthieu Sozeau). - **Fixed:** The optional string argument to :tacn:`time` is now properly quoted under :cmd:`Print Ltac` (`#11203 `_, fixes `#10971 `_, by Jason Gross) - **Fixed:** Efficiency regression of :tacn:`lia` introduced in 8.10 by PR `#9725 `_ (`#11263 `_, fixes `#11063 `_, and `#11242 `_, and `#11270 `_, by Frédéric Besson). - **Deprecated:** The undocumented ``omega with`` tactic variant has been deprecated. Using :tacn:`lia` is the recommended replacement, though the old semantics of ``omega with *`` can be recovered with ``zify; omega`` (`#11337 `_, by Emilio Jesus Gallego Arias). - **Fixed** For compatibility reasons, in 8.11, :tacn:`zify` does not support :g:`Z.pow_pos` by default. It can be enabled by explicitly loading the module :g:`ZifyPow` (`#11430 `_ by Frédéric Besson fixes `#11191 `_). **Tactic language** - **Fixed:** Syntax of tactic `cofix ... with ...` was broken since Coq 8.10 (`#11241 `_, by Hugo Herbelin). **Commands and options** - **Deprecated:** The `-load-ml-source` and `-load-ml-object` command line options have been deprecated; their use was very limited, you can achieve the same by adding object files in the linking step or by using a plugin (`#11428 `_, by Emilio Jesus Gallego Arias). **Tools** - **Fixed:** ``coqtop --version`` was broken when called in the middle of an installation process (`#11255 `_, by Hugo Herbelin, fixing `#11254 `_). - **Deprecated:** The ``-quick`` command is renamed to ``-vio``, for consistency with the new ``-vos`` and ``-vok`` flags. Usage of ``-quick`` is now deprecated (`#11280 `_, by Arthur Charguéraud). - **Fixed:** ``coq_makefile`` does not break when using the ``CAMLPKGS`` variable together with an unpacked (``mllib``) plugin (`#11357 `_, by Gaëtan Gilbert). - **Fixed:** ``coqdoc`` with option ``-g`` (Gallina only) now correctly prints commands with attributes (`#11394 `_, fixes `#11353 `_, by Karl Palmskog). **CoqIDE** - **Changed:** CoqIDE now uses the GtkSourceView native implementation of the autocomplete mechanism (`#11400 `_, by Pierre-Marie Pédrot). **Standard library** - **Removed:** Export of module :g:`RList` in :g:`Ranalysis` and :g:`Ranalysis_reg`. Module :g:`RList` is still there but must be imported explicitly where required (`#11396 `_, by Michael Soegtrop). **Infrastructure and dependencies** - **Added:** Build date can now be overridden by setting the `SOURCE_DATE_EPOCH` environment variable (`#11227 `_, by Bernhard M. Wiedemann). Changes in 8.11.1 ~~~~~~~~~~~~~~~~~ **Kernel** - **Fixed:** Allow more inductive types in `Unset Positivity Checking` mode (`#11811 `_, by SimonBoulier). **Notations** - **Fixed:** Bugs in dealing with precedences of notations in custom entries (`#11530 `_, by Hugo Herbelin, fixing in particular `#9517 `_, `#9519 `_, `#9521 `_, `#11331 `_). - **Added:** In primitive floats, print a warning when parsing a decimal value that is not exactly a binary64 floating-point number. For instance, parsing 0.1 will print a warning whereas parsing 0.5 won't (`#11859 `_, by Pierre Roux). **CoqIDE** - **Fixed:** Compiling file paths containing spaces (`#10008 `_, by snyke7, fixing `#11595 `_). **Infrastructure and dependencies** - **Added:** Bump official OCaml support and CI testing to 4.10.0 (`#11131 `_, `#11123 `_, `#11102 `_, by Emilio Jesus Gallego Arias, Jacques-Henri Jourdan, Guillaume Melquiond, and Guillaume Munch-Maccagnoni). **Miscellaneous** - **Fixed:** :cmd:`Extraction Implicit` on the constructor of a record was leading to an anomaly (`#11329 `_, by Hugo Herbelin, fixes `#11114 `_). Changes in 8.11.2 ~~~~~~~~~~~~~~~~~ **Kernel** - **Fixed:** Using :cmd:`Require` inside a section caused an anomaly when closing the section. (`#11972 `_, by Gaëtan Gilbert, fixing `#11783 `_, reported by Attila Boros). **Tactics** - **Fixed:** Anomaly with induction schemes whose conclusion is not normalized (`#12116 `_, by Hugo Herbelin; fixes `#12045 `_) - **Fixed:** Loss of location of some tactic errors (`#12223 `_, by Hugo Herbelin; fixes `#12152 `_ and `#12255 `_). **Commands and options** - **Changed:** Ignore -native-compiler option when built without native compute support (`#12070 `_, by Pierre Roux). **CoqIDE** - **Changed:** 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 `_, fixes `#11080 `_, by Attila Gáspár). - **Fixed:** New patch presumably fixing the random Coq 8.11 segfault issue with CoqIDE completion (`#12068 `_, by Hugo Herbelin, presumably fixing `#11943 `_). - **Fixed:** Highlighting style consistently applied to all three buffers of CoqIDE (`#12106 `_, by Hugo Herbelin; fixes `#11506 `_). Version 8.10 ------------ Summary of changes ~~~~~~~~~~~~~~~~~~ Coq version 8.10 contains two major new features: support for a native fixed-precision integer type and a new sort :math:`\SProp` of strict propositions. It is also the result of refinements and stabilization of previous features, deprecations or removals of deprecated features, cleanups of the internals of the system and API, and many documentation improvements. This release includes many user-visible changes, including deprecations that are documented in the next subsection, and new features that are documented in the reference manual. Here are the most important user-visible changes: - Kernel: - A notion of primitive object was added to the calculus. Its first instance is primitive cyclic unsigned integers, axiomatized in module :g:`UInt63`. See Section :ref:`primitive-integers`. The `Coq.Numbers.Cyclic.Int31` library is deprecated (`#6914 `_, by Maxime Dénès, Benjamin Grégoire and Vincent Laporte, with help and reviews from many others). - The :math:`\SProp` sort of definitionally proof-irrelevant propositions was introduced. :math:`\SProp` allows to mark proof terms as irrelevant for conversion, and is treated like :math:`\Prop` during extraction. It is enabled using the `-allow-sprop` command-line flag or the :flag:`Allow StrictProp` flag. See Chapter :ref:`sprop` (`#8817 `_, by Gaëtan Gilbert). - The unfolding heuristic in termination checking was made more complete, allowing more constants to be unfolded to discover valid recursive calls. Performance regression may occur in Fixpoint declarations without an explicit ``{struct}`` annotation, since guessing the decreasing argument can now be more expensive (`#9602 `_, by Enrico Tassi). - Universes: - Added Subgraph variant to :cmd:`Print Universes`. Try for instance :g:`Print Universes Subgraph(sigT2.u1 sigT_of_sigT2.u1 projT3_eq.u1).` (`#8451 `_, by Gaëtan Gilbert). - Added private universes for opaque polymorphic constants, see the documentation for the :flag:`Private Polymorphic Universes` flag, and unset it to get the previous behavior (`#8850 `_, by Gaëtan Gilbert). - Notations: - New command :cmd:`String Notation` to register string syntax for custom inductive types (`#8965 `_, by Jason Gross). - Experimental: :ref:`Number Notations ` now parse decimal constants such as ``1.02e+01`` or ``10.2``. Parsers added for :g:`Q` and :g:`R`. In the rare case when such numeral notations were used in a development along with :g:`Q` or :g:`R`, they may have to be removed or disambiguated through explicit scope annotations (`#8764 `_, by Pierre Roux). - Ltac backtraces can be turned on using the :flag:`Ltac Backtrace` flag, which is off by default (`#9142 `_, fixes `#7769 `_ and `#7385 `_, by Pierre-Marie Pédrot). - The tactics :tacn:`lia`, :tacn:`nia`, :tacn:`lra`, :tacn:`nra` are now using a novel Simplex-based proof engine. In case of regression, unset `Simplex` to get the venerable Fourier-based engine (`#8457 `_, by Fréderic Besson). - SSReflect: - New intro patterns: - temporary introduction: `=> +` - block introduction: `=> [^ prefix ] [^~ suffix ]` - fast introduction: `=> >` - tactics as views: `=> /ltac:mytac` - replace hypothesis: `=> {}H` See Section :ref:`introduction_ssr` (`#6705 `_, by Enrico Tassi, with help from Maxime Dénès, ideas coming from various users). - New tactic :tacn:`under` to rewrite under binders, given an extensionality lemma: - interactive mode: :n:`under @term`, associated terminator: :tacn:`over` - one-liner mode: :n:`under @term do [@tactic | ...]` It can take occurrence switches, contextual patterns, and intro patterns: :g:`under {2}[in RHS]eq_big => [i|i ?]` (`#9651 `_, by Erik Martin-Dorel and Enrico Tassi). - :cmd:`Combined Scheme` now works when inductive schemes are generated in sort :math:`\Type`. It used to be limited to sort `Prop` (`#7634 `_, by Théo Winterhalter). - A new registration mechanism for reference from ML code to Coq constructs has been added (`#186 `_, by Emilio Jesús Gallego Arias, Maxime Dénès and Vincent Laporte). - 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 the new dependencies (`#9279 `_, by Hugo Herbelin, with help from Jacques Garrigue, Emilio Jesús Gallego Arias, Michael Sogetrop and Vincent Laporte). - Smart input for Unicode characters. For example, typing ``\alpha`` then ``Shift+Space`` will insert the greek letter alpha. A larger number of default bindings are provided, following the latex naming convention. Bindings can be customized, either globally, or on a per-project basis. See Section :ref:`coqide-unicode` for details (`#8560 `_, by Arthur Charguéraud). - Infrastructure and dependencies: - Coq 8.10 requires OCaml >= 4.05.0, bumped from 4.02.3 See the `INSTALL` file for more information on dependencies (`#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 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 `coqpp` that plugin authors must switch to (`#7902 `_, `#7979 `_, `#8161 `_, `#8667 `_, and `#8945 `_, by Pierre-Marie Pédrot and Emilio Jesús Gallego Arias). 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 Makefile which is scheduled for deprecation (`#6857 `_, by Emilio Jesús Gallego Arias, with help from Rudi Grinberg). Experimental support for building Coq projects has been integrated in Dune at the same time, providing an `improved experience `_ for plugin developers. We thank the Dune team for their work supporting Coq. Version 8.10 also comes with a bunch of smaller-scale changes and improvements regarding the different components of the system, including many additions to the standard library (see the next subsection for details). 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 originally made by Yves Bertot is now in `doc/plugin_tutorial`. The ``dev/doc/critical-bugs`` file documents the known critical bugs of Coq and affected releases. The efficiency of the whole system has seen improvements thanks to 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 the OCaml trunk, in addition to the oldest supported and latest OCaml releases. 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 the standard library). Similar links exist for the `v8.10` branch. The opam repository for Coq packages has been maintained by Guillaume Melquiond, Matthieu Sozeau, Enrico Tassi (who migrated it to opam 2) with contributions from many users. A list of packages is available at https://coq.inria.fr/opam/www/. The 61 contributors to this version are Tanaka Akira, Benjamin Barenblat, Yves Bertot, Frédéric Besson, Lasse Blaauwbroek, Martin Bodin, Joachim Breitner, Tej Chajed, Frédéric Chapoton, Arthur Charguéraud, Cyril Cohen, Lukasz Czajka, David A. Dalrymple, Christian Doczkal, Maxime Dénès, Andres Erbsen, Jim Fehrle, Emilio Jesus Gallego Arias, Gaëtan Gilbert, Matěj Grabovský, Simon Gregersen, Jason Gross, Samuel Gruetter, Hugo Herbelin, Jasper Hugunin, Mirai Ikebuchi, Chantal Keller, Matej Košík, Sam Pablo Kuper, Vincent Laporte, Olivier Laurent, Larry Darryl Lee Jr, Nick Lewycky, Yao Li, Yishuai Li, Assia Mahboubi, Simon Marechal, Erik Martin-Dorel, Thierry Martinez, Guillaume Melquiond, Kayla Ngan, Karl Palmskog, Pierre-Marie Pédrot, Clément Pit-Claudel, Pierre Roux, Kazuhiko Sakaguchi, Ryan Scott, Vincent Semeria, Gan Shen, Michael Soegtrop, Matthieu Sozeau, Enrico Tassi, Laurent Théry, Kamil Trzciński, whitequark, Théo Winterhalter, Xia Li-yao, Beta Ziliani and Théo Zimmermann. Many power users helped to improve the design of the new features via the issue and pull request system, the Coq development mailing list, the coq-club@inria.fr mailing list or the new Discourse forum. It would be impossible to mention exhaustively the names of everybody who to some extent influenced the development. Version 8.10 is the fifth release of Coq developed on a time-based development cycle. Its development spanned 6 months from the release of Coq 8.9. Vincent Laporte is the release manager and maintainer of this release. This release is the result of ~2500 commits and ~650 PRs merged, closing 150+ issues. | Santiago de Chile, April 2019, | Matthieu Sozeau for the Coq development team | Other changes in 8.10+beta1 ~~~~~~~~~~~~~~~~~~~~~~~~~~~ - Command-line tools and options: - The use of `coqtop` as a compiler has been deprecated, in favor of `coqc`. Consequently option `-compile` will stop to be accepted in the next release. `coqtop` is now reserved to interactive use (`#9095 `_, by Emilio Jesús Gallego Arias). - New option ``-topfile filename``, which will set the current module name (*à 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 its path (`#8991 `_, closes `#8989 `_, by Gaëtan Gilbert). - Experimental: Coq flags and options can now be set on the command-line, e.g. ``-set "Universe Polymorphism=true"`` (`#9876 `_, by Gaëtan Gilbert). - The `-native-compiler` flag of `coqc` and `coqtop` now takes an argument which can have three values: - `no` disables native_compute - `yes` enables native_compute and precompiles `.v` files to native code - `ondemand` enables native_compute but compiles code only when `native_compute` is called The default value is `ondemand`. Note that this flag now has priority over the configure flag of the same name. A new `-bytecode-compiler` flag for `coqc` and `coqtop` controls whether conversion can use the VM. The default value is `yes`. (`#8870 `_, by Maxime Dénès) - The pretty timing diff scripts (flag `TIMING=1` to a `coq_makefile`\-made `Makefile`, also `tools/make-both-single-timing-files.py`, `tools/make-both-time-files.py`, and `tools/make-one-time-file.py`) now correctly support non-UTF-8 characters in the output of `coqc` / `make` as well as printing to stdout, on both python2 and python3 (`#9872 `_, closes `#9767 `_ and `#9705 `_, by Jason Gross) - coq_makefile's install target now errors if any file to install is missing (`#9906 `_, by Gaëtan Gilbert). - Preferences from ``coqide.keys`` are no longer overridden by modifiers preferences in ``coqiderc`` (`#10014 `_, by Hugo Herbelin). - Specification language, type inference: - Fixing a missing check in interpreting instances of existential variables that are bound to local definitions. Might exceptionally induce an overhead if the cost of checking the conversion of the corresponding definitions is additionally high (`#8217 `_, closes `#8215 `_, by Hugo Herbelin). - A few improvements in inference of the return clause of `match` that can exceptionally introduce incompatibilities. This can be solved by writing an explicit `return` clause, sometimes even simply an explicit `return _` clause (`#262 `_, by Hugo Herbelin). - Using non-projection values with the projection syntax is not allowed. For instance :g:`0.(S)` is not a valid way to write :g:`S 0`. Projections from non-primitive (emulated) records are allowed with warning "nonprimitive-projection-syntax" (`#8829 `_, by Gaëtan Gilbert). - An option and attributes to control the automatic decision to declare an inductive type as template polymorphic were added. Warning "auto-template" (off by default) can trigger when an inductive is automatically declared template polymorphic without the attribute. Inductive types declared by Funind will never be template polymorphic. (`#8488 `_, by Gaëtan Gilbert) - Notations: - New command :cmd:`Declare Scope` to explicitly declare a scope name before any use of it. Implicit declaration of a scope at the time of :cmd:`Bind Scope`, :cmd:`Delimit Scope`, :cmd:`Undelimit Scope`, or :cmd:`Notation` is deprecated (`#7135 `_, by Hugo Herbelin). - Various bugs have been fixed (e.g. `#9214 `_ on removing spurious parentheses on abbreviations shortening a strict prefix of an application, by Hugo Herbelin). - :cmd:`Number Notation` now support inductive types in the input to printing functions (e.g., numeral notations can be defined for terms containing things like :g:`@cons nat O O`), and parsing functions now fully normalize terms including parameters of constructors (so that, e.g., a numeral notation whose parsing function outputs a proof of :g:`Nat.gcd x y = 1` will no longer fail to parse due to containing the constant :g:`Nat.gcd` in the parameter-argument of :g:`eq_refl`) (`#9874 `_, closes `#9840 `_ and `#9844 `_, by Jason Gross). - 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 8.8 and 8.9. For projects that require more than a handful of such fixes, there is `a script `_ that will do it automatically, using the output of ``coqc`` (`#8638 `_, by Jason Gross). - Allow inspecting custom grammar entries by :cmd:`Print Custom Grammar` (`#10061 `_, fixes `#9681 `_, by Jasper Hugunin, review by Pierre-Marie Pédrot and Hugo Herbelin). - The `quote plugin `_ was removed. If some users are interested in maintaining this plugin externally, the Coq development team can provide assistance for extracting the plugin and setting up a new repository (`#7894 `_, by Maxime Dénès). - Ltac: - Tactic names are no longer allowed to clash, even if they are not defined in the same section. For example, the following is no longer accepted: :g:`Ltac foo := idtac. Section S. Ltac foo := fail. End S.` (`#8555 `_, by Maxime Dénès). - Names of existential variables occurring in Ltac functions (e.g. :g:`?[n]` or :g:`?n` in terms - not in patterns) are now interpreted the same way as other variable names occurring in Ltac functions (`#7309 `_, by Hugo Herbelin). - Tactics: - Removed the deprecated `romega` tactic (`#8419 `_, by Maxime Dénès and Vincent Laporte). - Hint declaration and removal should now specify a database (e.g. `Hint Resolve foo : database`). When the database name is omitted, the hint is added to the `core` database (as previously), but a deprecation warning is emitted (`#8987 `_, by Maxime Dénès). - There are now tactics in `PreOmega.v` called `Z.div_mod_to_equations`, `Z.quot_rem_to_equations`, and `Z.to_euclidean_division_equations` (which combines the `div_mod` and `quot_rem` variants) which allow :tacn:`lia`, :tacn:`nia`, etc to support `Z.div` and `Z.modulo` (`Z.quot` and `Z.rem`, respectively), by posing the specifying equation for `Z.div` and `Z.modulo` before replacing them with atoms (`#8062 `_, by Jason Gross). - The syntax of the :tacn:`autoapply` tactic was fixed to conform with preexisting documentation: it now takes a `with` clause instead of a `using` clause (`#9524 `_, closes `#7632 `_, by Théo Zimmermann). - Modes are now taken into account by :tacn:`typeclasses eauto` for local hypotheses (`#9996 `_, fixes `#5752 `_, by Maxime Dénès, review by Pierre-Marie Pédrot). - New variant :tacn:`change_no_check` of :tacn:`change`, usable as a documented replacement of `convert_concl_no_check` (`#10012 `_, `#10017 `_, `#10053 `_, and `#10059 `_, by Hugo Herbelin and Paolo G. Giarrusso). - The simplified value returned by :tacn:`field_simplify` is not always a fraction anymore. When the denominator is :g:`1`, it returns :g:`x` while previously it was returning :g:`x/1`. This change could break codes that were post-processing application of :tacn:`field_simplify` to get rid of these :g:`x/1` (`#9854 `_, by Laurent Théry, with help from Michael Soegtrop, Maxime Dénès, and Vincent Laporte). - SSReflect: - Clear discipline made consistent across the entire proof language. Whenever a clear switch `{x..}` comes immediately before an existing proof context entry (used as a view, as a rewrite rule or as name for a new context entry) then such entry is cleared too. E.g. The following sentences are elaborated as follows (when H is an existing proof context entry): - `=> {x..} H` -> `=> {x..H} H` - `=> {x..} /H` -> `=> /v {x..H}` - `rewrite {x..} H` -> `rewrite E {x..H}` (`#9341 `_, by Enrico Tassi). - `inE` now expands `y \in r x` when `r` is a `simpl_rel`. New `{pred T}` notation for a `pred T` alias in the `pred_sort` coercion class, simplified `predType` interface: `pred_class` and `mkPredType` deprecated, `{pred T}` and `PredType` should be used instead. `if c return t then ...` now expects `c` to be a variable bound in `t`. New `nonPropType` interface matching types that do _not_ have sort `Prop`. New `relpre R f` definition for the preimage of a relation R under f (`#9995 `_, by Georges Gonthier). - Commands: - Binders for an :cmd:`Instance` now act more like binders for a :cmd:`Theorem`. Names may not be repeated, and may not overlap with section variable names (`#8820 `_, closes `#8791 `_, by Jasper Hugunin). - Removed the deprecated `Implicit Tactic` family of commands (`#8779 `_, by Pierre-Marie Pédrot). - The `Automatic Introduction` option has been removed and is now the default (`#9001 `_, by Emilio Jesús Gallego Arias). - `Arguments` now accepts names for arguments provided with `extra_scopes` (`#9117 `_, by Maxime Dénès). - The naming scheme for anonymous binders in a `Theorem` has changed to avoid conflicts with explicitly named binders (`#9160 `_, closes `#8819 `_, by Jasper Hugunin). - Computation of implicit arguments now properly handles local definitions in the binders for an `Instance`, and can be mixed with implicit binders `{x : T}` (`#9307 `_, closes `#9300 `_, by Jasper Hugunin). - :cmd:`Declare Instance` now requires an instance name. The flag `Refine Instance Mode` has been turned off by default, meaning that :cmd:`Instance` no longer opens a proof when a body is provided. The flag has been deprecated and will be removed in the next version. (`#9270 `_, and `#9825 `_, by Maxime Dénès) - Command :cmd:`Instance`, when no body is provided, now always opens a proof. This is a breaking change, as instance of :n:`Instance @ident__1 : @ident__2.` where :n:`@ident__2` is a trivial class will have to be changed into :n:`Instance @ident__1 : @ident__2 := %{%}.` or :n:`Instance @ident__1 : @ident__2. Proof. Qed.` (`#9274 `_, by Maxime Dénès). - The flag :flag:`Program Mode` now means that the `Program` attribute is enabled for all commands that support it. In particular, it does not have any effect on tactics anymore. May cause some incompatibilities (`#9410 `_, by Maxime Dénès). - The algorithm computing implicit arguments now behaves uniformly for primitive projection and application nodes (`#9509 `_, closes `#9508 `_, by Pierre-Marie Pédrot). - :cmd:`Hypotheses` and :cmd:`Variables` can now take implicit binders inside sections (`#9364 `_, closes `#9363 `_, by Jasper Hugunin). - Removed deprecated option `Automatic Coercions Import` (`#8094 `_, by Maxime Dénès). - The ``Show Script`` command has been deprecated (`#9829 `_, by Vincent Laporte). - :cmd:`Coercion` does not warn ambiguous paths which are obviously convertible with existing ones. The ambiguous paths messages have been turned to warnings, thus now they could appear in the output of ``coqc``. The convertibility checking procedure for coercion paths is complete for paths consisting of coercions satisfying the uniform inheritance condition, but some coercion paths could be reported as ambiguous even if they are convertible with existing ones when they have coercions that don't satisfy the uniform inheritance condition (`#9743 `_, closes `#3219 `_, by Kazuhiko Sakaguchi). - A new flag :flag:`Fast Name Printing` has been introduced. It changes the algorithm used for allocating bound variable names for a faster but less clever one (`#9078 `_, by Pierre-Marie Pédrot). - Option ``Typeclasses Axioms Are Instances`` (compatibility option introduced in the previous version) is deprecated. Use :cmd:`Declare Instance` for axioms which should be instances (`#8920 `_, by Gaëtan Gilbert). - Removed option `Printing Primitive Projection Compatibility` (`#9306 `_, by Gaëtan Gilbert). - Standard Library: - Added `Bvector.BVeq` that decides whether two `Bvector`\s are equal. Added notations for `BVxor`, `BVand`, `BVor`, `BVeq` and `BVneg` (`#8171 `_, by Yishuai Li). - Added `ByteVector` type that can convert to and from `string` (`#8365 `_, by Yishuai Li). - Added lemmas about monotonicity of `N.double` and `N.succ_double`, and about the upper bound of number represented by a vector. Allowed implicit vector length argument in `Ndigits.Bv2N` (`#8815 `_, by Yishuai Li). - The prelude used to be automatically Exported and is now only Imported. This should be relevant only when importing files which don't use `-noinit` into files which do (`#9013 `_, by Gaëtan Gilbert). - Added `Coq.Structures.OrderedTypeEx.String_as_OT` to make strings an ordered type, using lexical order (`#7221 `_, by Li Yao). - Added lemmas about `Z.testbit`, `Z.ones`, and `Z.modulo` (`#9425 `_, by Andres Erbsen). - Moved the `auto` hints of the `FSet` library into a new `fset` database (`#9725 `_, by Frédéric Besson). - Added :g:`Coq.Structures.EqualitiesFacts.PairUsualDecidableTypeFull` (`#9984 `_, by Jean-Christophe Léchenet and Oliver Nash). - Some error messages that show problems with a pair of non-matching values will now highlight the differences (`#8669 `_, by Jim Fehrle). - 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 Changes chapter which was enriched with the content formerly in `CHANGES.md` and `COMPATIBILITY` (`#9133 `_, `#9668 `_, `#9939 `_, `#9964 `_, and `#10085 `_, by Théo Zimmermann, with help and ideas from Emilio Jesús Gallego Arias, Gaëtan Gilbert, Clément Pit-Claudel, Matthieu Sozeau, and Enrico Tassi). Changes in 8.10+beta2 ~~~~~~~~~~~~~~~~~~~~~ Many bug fixes and documentation improvements, in particular: **Tactics** - Make the :tacn:`discriminate` tactic work together with :flag:`Universe Polymorphism` and equality in :g:`Type`. This, in particular, makes :tacn:`discriminate` compatible with the HoTT library https://github.com/HoTT/HoTT (`#10205 `_, by Andreas Lynge, review by Pierre-Marie Pédrot and Matthieu Sozeau). **SSReflect** - Make the ``case E: t`` tactic work together with :flag:`Universe Polymorphism` and equality in :g:`Type`. This makes :tacn:`case ` compatible with the HoTT library https://github.com/HoTT/HoTT (`#10302 `_, fixes `#10301 `_, by Andreas Lynge, review by Enrico Tassi) - Make the ``rewrite /t`` tactic work together with :flag:`Universe Polymorphism`. This makes :tacn:`rewrite ` compatible with the HoTT library https://github.com/HoTT/HoTT (`#10305 `_, fixes `#9336 `_, by Andreas Lynge, review by Enrico Tassi) **CoqIDE** - Fix CoqIDE instability on Windows after the update to gtk3 (`#10360 `_, by Michael Soegtrop, closes `#9885 `_). **Miscellaneous** - Proof General can now display Coq-generated diffs between proof steps in color (`#10019 `_ and (in Proof General) `#421 `_, by Jim Fehrle). Changes in 8.10+beta3 ~~~~~~~~~~~~~~~~~~~~~ **Kernel** - Fix soundness issue with template polymorphism (`#9294 `_). Declarations of template-polymorphic inductive types ignored the provenance of the universes they were abstracting on and did not detect if they should be greater or equal to :math:`\Set` in general. Previous universes and universes introduced by the inductive definition could have constraints that prevented their instantiation with e.g. :math:`\Prop`, resulting in unsound instantiations later. The implemented fix only allows abstraction over universes introduced by the inductive declaration, and properly records all their constraints by making them by default only :math:`>= \Prop`. It is also checked that a template polymorphic inductive actually is polymorphic on at least one universe. This prevents inductive declarations in sections to be universe polymorphic over section parameters. For a backward compatible fix, simply hoist the inductive definition out of the section. An alternative is to declare the inductive as universe-polymorphic and cumulative in a universe-polymorphic section: all universes and constraints will be properly gathered in this case. See :ref:`Template-polymorphism` for a detailed exposition of the rules governing template-polymorphic types. To help users incrementally fix this issue, a command line option `-no-template-check` and a global flag ``Template Check`` are available to selectively disable the new check. Use at your own risk. (`#9918 `_, by Matthieu Sozeau and Maxime Dénès). **User messages** - Improve the ambiguous paths warning to indicate which path is ambiguous with new one (`#10336 `_, closes `#3219 `_, by Kazuhiko Sakaguchi). **Extraction** - Fix extraction to OCaml of primitive machine integers; see :ref:`primitive-integers` (`#10430 `_, fixes `#10361 `_, by Vincent Laporte). - Fix a printing bug of OCaml extraction on dependent record projections, which produced improper `assert false`. This change makes the OCaml extractor internally inline record projections by default; thus the monolithic OCaml extraction (:cmd:`Extraction` and :cmd:`Recursive Extraction`) does not produce record projection constants anymore except for record projections explicitly instructed to extract, and records declared in opaque modules (`#10577 `_, fixes `#7348 `_, by Kazuhiko Sakaguchi). **Standard library** - Added ``splitat`` function and lemmas about ``splitat`` and ``uncons`` (`#9379 `_, by Yishuai Li, with help of Konstantinos Kallas, follow-up of `#8365 `_, which added ``uncons`` in 8.10+beta1). Changes in 8.10.0 ~~~~~~~~~~~~~~~~~ - Micromega tactics (:tacn:`lia`, :tacn:`nia`, etc) are no longer confused by primitive projections (`#10806 `_, fixes `#9512 `_ by Vincent Laporte). Changes in 8.10.1 ~~~~~~~~~~~~~~~~~ A few bug fixes and documentation improvements, in particular: **Kernel** - Fix proof of False when using |SProp| (incorrect De Bruijn handling when inferring the relevance mark of a function) (`#10904 `_, by Pierre-Marie Pédrot). **Tactics** - Fix an anomaly when unsolved evar in :cmd:`Add Ring` (`#10891 `_, fixes `#9851 `_, by Gaëtan Gilbert). **Tactic language** - Fix Ltac regression in binding free names in uconstr (`#10899 `_, fixes `#10894 `_, by Hugo Herbelin). **CoqIDE** - Fix handling of unicode input before space (`#10852 `_, fixes `#10842 `_, by Arthur Charguéraud). **Extraction** - Fix custom extraction of inductives to JSON (`#10897 `_, fixes `#4741 `_, by Helge Bahmann). Changes in 8.10.2 ~~~~~~~~~~~~~~~~~ **Kernel** - Fixed a critical bug of template polymorphism and nonlinear universes (`#11128 `_, fixes `#11039 `_, by Gaëtan Gilbert). - Fixed an anomaly “Uncaught exception Constr.DestKO” on :g:`Inductive` (`#11052 `_, fixes `#11048 `_, by Gaëtan Gilbert). - Fixed an anomaly “not enough abstractions in fix body” (`#11014 `_, fixes `#8459 `_, by Gaëtan Gilbert). **Notations** - Fixed an 8.10 regression related to the printing of coercions associated with notations (`#11090 `_, fixes `#11033 `_, by Hugo Herbelin). **CoqIDE** - Fixed uneven dimensions of CoqIDE panels when window has been resized (`#11070 `_, fixes 8.10-regression `#10956 `_, by Guillaume Melquiond). - Do not include final stops in queries (`#11069 `_, fixes 8.10-regression `#11058 `_, by Guillaume Melquiond). **Infrastructure and dependencies** - Enable building of executables when they are running (`#11000 `_, fixes 8.9-regression `#10728 `_, by Gaëtan Gilbert). Version 8.9 ----------- Summary of changes ~~~~~~~~~~~~~~~~~~ Coq version 8.9 contains the result of refinements and stabilization of features and deprecations or removals of deprecated features, cleanups of the internals of the system and API along with a few new features. This release includes many user-visible changes, including deprecations that are documented in the next subsection and new features that are documented in the reference manual. Here are the most important changes: - Kernel: mutually recursive records are now supported, by Pierre-Marie Pédrot. - Notations: - Support for autonomous grammars of terms called “custom entries”, by Hugo Herbelin (see Section :ref:`custom-entries` of the reference manual). - Deprecated notations of the standard library will be removed in the next version of Coq, see the next subsection for a script to ease porting, by Jason Gross and Jean-Christophe Léchenet. - Added the :cmd:`Number Notation` command for registering decimal numeral notations for custom types, by Daniel de Rauglaudre, Pierre Letouzey and Jason Gross. - Tactics: Introduction tactics :tacn:`intro`/:tacn:`intros` on a goal that is an existential variable now force a refinement of the goal into a dependent product rather than failing, by Hugo Herbelin. - Decision procedures: deprecation of tactic ``romega`` in favor of :tacn:`lia` and removal of ``fourier``, replaced by :tacn:`lra` which subsumes it, by Frédéric Besson, Maxime Dénès, Vincent Laporte and Laurent Théry. - Proof language: focusing bracket ``{`` now supports named :ref:`goals `, e.g. ``[x]:{`` will focus on a goal (existential variable) named ``x``, by Théo Zimmermann. - SSReflect: the implementation of delayed clear was simplified by Enrico Tassi: the variables are always renamed using inaccessible names when the clear switch is processed and finally cleared at the end of the intro pattern. In addition to that, the use-and-discard flag ``{}`` typical of rewrite rules can now be also applied to views, e.g. ``=> {}/v`` applies ``v`` and then clears ``v``. See Section :ref:`introduction_ssr`. - Vernacular: - Experimental support for :term:`attributes ` on commands, by Vincent Laporte, as in ``#[local] Lemma foo : bar.`` Tactics and tactic notations now support the ``deprecated`` attribute. - Removed deprecated commands ``Arguments Scope`` and ``Implicit Arguments`` in favor of :cmd:`Arguments`, with the help of Jasper Hugunin. - New flag :flag:`Uniform Inductive Parameters` by Jasper Hugunin to avoid repeating uniform parameters in constructor declarations. - New commands :cmd:`Hint Variables` and :cmd:`Hint Constants`, by Matthieu Sozeau, for controlling the opacity status of variables and constants in hint databases. It is recommended to always use these commands after creating a hint database with :cmd:`Create HintDb`. - Multiple sections with the same name are now allowed, by Jasper Hugunin. - Library: additions and changes in the ``VectorDef``, ``Ascii``, and ``String`` libraries. Syntax notations are now available only when using ``Import`` of libraries and not merely ``Require``, by various contributors (source of incompatibility, see the next subsection for details). - Toplevels: ``coqtop`` and ``coqide`` can now display diffs between proof steps in color, using the :opt:`Diffs` option, by Jim Fehrle. - Documentation: we integrated a large number of fixes to the new Sphinx documentation by various contributors, coordinated by Clément Pit-Claudel and Théo Zimmermann. - Tools: removed the ``gallina`` utility and the homebrewed ``Emacs`` mode. - Packaging: as in Coq 8.8.2, the Windows installer now includes many more external packages that can be individually selected for installation, by Michael Soegtrop. Version 8.9 also comes with a bunch of smaller-scale changes and improvements regarding the different components of the system. Most 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 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. The efficiency of the whole system has seen improvements thanks to 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. The opam repository for Coq packages has been maintained by Guillaume Melquiond, Matthieu Sozeau, Enrico Tassi with contributions from many users. A list of packages is available at https://coq.inria.fr/opam/www/. The 54 contributors for this version are Léo Andrès, Rin Arakaki, Benjamin Barenblat, Langston Barrett, Siddharth Bhat, Martin Bodin, Simon Boulier, Timothy Bourke, Joachim Breitner, Tej Chajed, Arthur Charguéraud, Pierre Courtieu, Maxime Dénès, Andres Erbsen, Jim Fehrle, Julien Forest, Emilio Jesus Gallego Arias, Gaëtan Gilbert, Matěj Grabovský, Jason Gross, Samuel Gruetter, Armaël Guéneau, Hugo Herbelin, Jasper Hugunin, Ralf Jung, Sam Pablo Kuper, Ambroise Lafont, Leonidas Lampropoulos, Vincent Laporte, Peter LeFanu Lumsdaine, Pierre Letouzey, Jean-Christophe Léchenet, Nick Lewycky, Yishuai Li, Sven M. Hallberg, Assia Mahboubi, Cyprien Mangin, Guillaume Melquiond, Perry E. Metzger, Clément Pit-Claudel, Pierre-Marie Pédrot, Daniel R. Grayson, Kazuhiko Sakaguchi, Michael Soegtrop, Matthieu Sozeau, Paul Steckler, Enrico Tassi, Laurent Théry, Anton Trunov, whitequark, Théo Winterhalter, Zeimer, Beta Ziliani, Théo Zimmermann. Many power users helped to improve the design of the new features via the issue and pull request system, the Coq development mailing list or the coq-club@inria.fr mailing list. It would be impossible to mention exhaustively the names of everybody who to some extent influenced the development. Version 8.9 is the fourth release of Coq developed on a time-based development cycle. Its development spanned 7 months from the release of Coq 8.8. The development moved to a decentralized merging process during this cycle. Guillaume Melquiond was in charge of the release process and is the maintainer of this release. This release is the result of ~2,000 commits and ~500 PRs merged, closing 75+ issues. The Coq development team welcomed Vincent Laporte, a new Coq engineer working with Maxime Dénès in the Coq consortium. | Paris, November 2018, | Matthieu Sozeau for the Coq development team | Details of changes in 8.9+beta1 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Kernel - Mutually defined records are now supported. Notations - New support for autonomous grammars of terms, called "custom entries" (see chapter "Syntax extensions" of the reference manual). - Deprecated compatibility notations will actually be removed in the 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 `_ that will do it automatically, using the output of ``coqc``. The script contains documentation on its usage in a comment at the top. Tactics - Added toplevel goal selector `!` which expects a single focused goal. Use with `Set Default Goal Selector` to force focusing before tactics are called. - The undocumented "nameless" forms `fix N`, `cofix` that were deprecated in 8.8 have been removed from Ltac's syntax; please use `fix ident N/cofix ident` to explicitly name the (co)fixpoint hypothesis to be introduced. - Introduction tactics `intro`/`intros` on a goal that is an existential variable now force a refinement of the goal into a dependent product rather than failing. - Support for `fix`/`cofix` added in Ltac `match` and `lazymatch`. - Ltac backtraces now include trace information about tactics called by OCaml-defined tactics. - Option `Ltac Debug` now applies also to terms built using Ltac functions. - Deprecated the `Implicit Tactic` family of commands. - The default program obligation tactic uses a bounded proof search instead of an unbounded and potentially non-terminating one now (source of incompatibility). - The `simple apply` tactic now respects the `Opaque` flag when called from Ltac (`auto` still does not respect it). - Tactic `constr_eq` now adds universe constraints needed for the identity to the context (it used to ignore them). New tactic `constr_eq_strict` checks that the required constraints already hold without adding new ones. Preexisting tactic `constr_eq_nounivs` can still be used if you really want to ignore universe constraints. - Tactics and tactic notations now understand the `deprecated` attribute. - The `fourier` tactic has been removed. Please now use `lra` instead. You may need to add `Require Import Lra` to your developments. For compatibility, we now define `fourier` as a deprecated alias of `lra`. - The `romega` tactics have been deprecated; please use `lia` instead. Focusing - Focusing bracket `{` now supports named goal selectors, e.g. `[x]: {` will focus on a goal (existential variable) named `x`. As usual, unfocus with `}` once the subgoal is fully solved. Specification language - A fix to unification (which was sensitive to the ascii name of variables) may occasionally change type inference in incompatible ways, especially regarding the inference of the return clause of `match`. Standard Library - Added `Ascii.eqb` and `String.eqb` and the `=?` notation for them, and proved some lemmas about them. Note that this might cause incompatibilities if you have, e.g., `string_scope` and `Z_scope` both open with `string_scope` on top, and expect `=?` to refer to `Z.eqb`. Solution: wrap `_ =? _` in `(_ =? _)%Z` (or whichever scope you want). - Added `Ndigits.N2Bv_sized`, and proved some lemmas about it. Deprecated `Ndigits.N2Bv_gen`. - The scopes `int_scope` and `uint_scope` have been renamed to `dec_int_scope` and `dec_uint_scope`, to clash less with ssreflect and other packages. They are still delimited by `%int` and `%uint`. - Syntax notations for `string`, `ascii`, `Z`, `positive`, `N`, `R`, and `int31` are no longer available merely by :cmd:`Require`\ing the files that define the inductives. You must :cmd:`Import` `Coq.Strings.String.StringSyntax` (after `Require` `Coq.Strings.String`), `Coq.Strings.Ascii.AsciiSyntax` (after `Require` `Coq.Strings.Ascii`), `Coq.ZArith.BinIntDef`, `Coq.PArith.BinPosDef`, `Coq.NArith.BinNatDef`, `Coq.Reals.Rdefinitions`, and `Coq.Numbers.Cyclic.Int31.Int31`, respectively, to be able to use these notations. Note that passing `-compat 8.8` or issuing `Require Import Coq.Compat.Coq88` will make these notations available. Users wishing to port their developments automatically may download `fix.py` from https://gist.github.com/JasonGross/5d4558edf8f5c2c548a3d96c17820169 and run a command like `while true; do make -Okj 2>&1 | /path/to/fix.py; done` and get a cup of coffee. (This command must be manually interrupted once the build finishes all the way though. Note also that this method is not fail-proof; you may have to adjust some scopes if you were relying on string notations not being available even when `string_scope` was open.) - Numeral syntax for `nat` is no longer available without loading the entire prelude (`Require Import Coq.Init.Prelude`). This only impacts users running Coq without the init library (`-nois` or `-noinit`) and also issuing `Require Import Coq.Init.Datatypes`. Tools - Coq_makefile lets one override or extend the following variables from the command line: `COQFLAGS`, `COQCHKFLAGS`, `COQDOCFLAGS`. `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). If you would like to maintain this tool externally, please contact us. - Removed the Emacs modes distributed with Coq. You are advised to use `Proof-General `_ (and optionally `Company-Coq `_) instead. If your use case is not covered by these alternative Emacs modes, please open an issue. We can help set up external maintenance as part of Proof-General, or independently as part of coq-community. Commands - Removed deprecated commands `Arguments Scope` and `Implicit Arguments` (not the option). Use the `Arguments` command instead. - Nested proofs may be enabled through the option `Nested Proofs Allowed`. By default, they are disabled and produce an error. The deprecation warning which used to occur when using nested proofs has been removed. - Added option `Uniform Inductive Parameters` which abstracts over parameters before typechecking constructors, allowing to write for example `Inductive list (A : Type) := nil : list | cons : A -> list -> list.` - New `Set Hint Variables/Constants Opaque/Transparent` commands for setting globally the opacity flag of variables and constants in hint databases, overriding the opacity setting of the hint database. - Added generic syntax for "attributes", as in: `#[local] Lemma foo : bar.` - Added the `Numeral Notation` command for registering decimal numeral notations for custom types - The `Set SsrHave NoTCResolution` command no longer has special global scope. If you want the previous behavior, use `Global Set SsrHave NoTCResolution`. - Multiple sections with the same name are allowed. Coq binaries and process model - 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 `coq{proof,tactic,query}worker` are in charge of task-specific and parallel proof checking. SSReflect - The implementation of delayed clear switches in intro patterns is now simpler to explain: 1. The immediate effect of a clear switch like `{x}` is to rename the variable `x` to `_x_` (i.e. a reserved identifier that cannot be mentioned explicitly) 2. The delayed effect of `{x}` is that `_x_` is cleared at the end of the intro pattern 3. A clear switch immediately before a view application like `{x}/v` is translated to `/v{x}`. In particular, the third rule lets one write `{x}/v` even if `v` uses the variable `x`: indeed the view is executed before the renaming. - An empty clear switch is now accepted in intro patterns before a view application whenever the view is a variable. One can now write `{}/v` to mean `{v}/v`. Remark that `{}/x` is very similar to the idiom `{}e` for the rewrite tactic (the equation `e` is used for rewriting and then discarded). Standard Library - There are now conversions between `string` and `positive`, `Z`, `nat`, and `N` in binary, octal, and hex. Display diffs between proof steps - `coqtop` and `coqide` can now highlight the differences between proof steps in color. This can be enabled from the command line or the `Set Diffs "on"/"off"/"removed"` command. Please see the documentation for details. Showing diffs in Proof General requires small changes to PG (under discussion). Notations - Added `++` infix for `VectorDef.append`. Note that this might cause incompatibilities if you have, e.g., `list_scope` and `vector_scope` both open with `vector_scope` on top, and expect `++` to refer to `app`. Solution: wrap `_ ++ _` in `(_ ++ _)%list` (or whichever scope you want). Changes in 8.8.0 ~~~~~~~~~~~~~~~~ Various bug fixes. 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. Version 8.8 ----------- Summary of changes ~~~~~~~~~~~~~~~~~~ Coq version 8.8 contains the result of refinements and stabilization of features and deprecations, cleanups of the internals of the system along with a few new features. The main user visible changes are: - Kernel: fix a subject reduction failure due to allowing fixpoints on non-recursive values, by Matthieu Sozeau. Handling of evars in the VM (the kernel still does not accept evars) by Pierre-Marie Pédrot. - Notations: many improvements on recursive notations and support for destructuring patterns in the syntax of notations by Hugo Herbelin. - Proof language: tacticals for profiling, timing and checking success or failure of tactics by Jason Gross. The focusing bracket ``{`` supports single-numbered goal selectors, e.g. ``2:{``, by Théo Zimmermann. - Vernacular: deprecation of commands and more uniform handling of the ``Local`` flag, by Vincent Laporte and Maxime Dénès, part of a larger attribute system overhaul. Experimental ``Show Extraction`` command by Pierre Letouzey. Coercion now accepts ``Prop`` or ``Type`` as a source by Arthur Charguéraud. ``Export`` modifier for options allowing to export the option to modules that ``Import`` and not only ``Require`` a module, by Pierre-Marie Pédrot. - Universes: many user-level and API level enhancements: qualified naming and printing, variance annotations for cumulative inductive types, more general constraints and enhancements of the minimization heuristics, interaction with modules by Gaëtan Gilbert, Pierre-Marie Pédrot and Matthieu Sozeau. - Library: Decimal Numbers library by Pierre Letouzey and various small improvements. - Documentation: a large community effort resulted in the migration of the reference manual to the Sphinx documentation tool. The result is this manual. The new documentation infrastructure (based on Sphinx) is by Clément Pit-Claudel. The migration was coordinated by Maxime Dénès and Paul Steckler, with some help of Théo Zimmermann during the final integration phase. The 14 people who ported the manual are Calvin Beck, Heiko Becker, Yves Bertot, Maxime Dénès, Richard Ford, Pierre Letouzey, Assia Mahboubi, Clément Pit-Claudel, Laurence Rideau, Matthieu Sozeau, Paul Steckler, Enrico Tassi, Laurent Théry, Nikita Zyuzin. - Tools: experimental ``-mangle-names`` option to ``coqtop``/``coqc`` for linting proof scripts, by Jasper Hugunin. 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. Version 8.8 also comes with a bunch of smaller-scale changes and improvements regarding the different components of the system. Most important ones are documented in the next subsection file. The efficiency of the whole system has seen improvements thanks to contributions from Gaëtan Gilbert, Pierre-Marie Pédrot, Maxime Dénès and Matthieu Sozeau and performance issue tracking by Jason Gross and Paul Steckler. The official wiki and the bugtracker of Coq migrated to the GitHub platform, thanks to the work of Pierre Letouzey and Théo Zimmermann. Gaëtan Gilbert, Emilio Jesús Gallego Arias worked on maintaining and improving the continuous integration system. The opam repository for Coq packages has been maintained by Guillaume Melquiond, Matthieu Sozeau, Enrico Tassi with contributions from many users. A list of packages is available at https://coq.inria.fr/opam/www/. The 44 contributors for this version are Yves Bertot, Joachim Breitner, Tej Chajed, Arthur Charguéraud, Jacques-Pascal Deplaix, Maxime Dénès, Jim Fehrle, Julien Forest, Yannick Forster, Gaëtan Gilbert, Jason Gross, Samuel Gruetter, Thomas Hebb, Hugo Herbelin, Jasper Hugunin, Emilio Jesus Gallego Arias, Ralf Jung, Johannes Kloos, Matej Košík, Robbert Krebbers, Tony Beta Lambda, Vincent Laporte, Peter LeFanu Lumsdaine, Pierre Letouzey, Farzon Lotfi, Cyprien Mangin, Guillaume Melquiond, Raphaël Monat, Carl Patenaude Poulin, Pierre-Marie Pédrot, Clément Pit-Claudel, Matthew Ryan, Matt Quinn, Sigurd Schneider, Bernhard Schommer, Michael Soegtrop, Matthieu Sozeau, Arnaud Spiwack, Paul Steckler, Enrico Tassi, Anton Trunov, Martin Vassor, Vadim Zaliva and Théo Zimmermann. Version 8.8 is the third release of Coq developed on a time-based development cycle. Its development spanned 6 months from the release of Coq 8.7 and was based on a public roadmap. The development process was coordinated by Matthieu Sozeau. Maxime Dénès was in charge of the release process. Théo Zimmermann is the maintainer of this release. Many power users helped to improve the design of the new features via the bug tracker, the pull request system, the Coq development mailing list or the coq-club@inria.fr mailing list. Special thanks to the users who contributed patches and intensive brain-storming and code reviews, starting with Jason Gross, Ralf Jung, Robbert Krebbers and Amin Timany. It would however be impossible to mention exhaustively the names 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. | Santiago de Chile, March 2018, | Matthieu Sozeau for the Coq development team | Details of changes in 8.8+beta1 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Kernel - Support for template polymorphism for definitions was removed. May trigger more "universe inconsistency" errors in rare occasions. - Fixpoints are no longer allowed on non-recursive inductive types. Notations - Recursive notations with the recursive pattern repeating on the right (e.g. "( x ; .. ; y ; z )") now supported. - Notations with a specific level for the leftmost nonterminal, when printing-only, are supported. - Notations can now refer to the syntactic category of patterns (as in "fun 'pat =>" or "match p with pat => ... end"). Two variants are available, depending on whether a single variable is considered as a pattern or not. - Recursive notations now support ".." patterns with several occurrences of the recursive term or binder, possibly mixing terms and binders, possibly in reverse left-to-right order. - "Locate" now working also on notations of the form "x + y" (rather than "_ + _"). Specification language - When printing clauses of a "match", clauses with same right-hand side are factorized and the last most factorized clause with no variables, if it exists, is turned into a default clause. Use "Unset Printing Allow Default Clause" do deactivate printing of a default clause. Use "Unset Printing Factorizable Match Patterns" to deactivate factorization of clauses with same right-hand side. Tactics - On Linux, "native_compute" calls can be profiled using the "perf" utility. The command "Set NativeCompute Profiling" enables profiling, and "Set NativeCompute Profile Filename" customizes the profile filename. - The tactic "omega" is now aware of the bodies of context variables such as "x := 5 : Z" (see #1362). This could be disabled via Unset Omega UseLocalDefs. - The tactic "romega" is also aware now of the bodies of context variables. - The tactic "zify" resp. "omega with N" is now aware of N.pred. - Tactic "decide equality" now able to manage constructors which contain proofs. - Added tactics reset ltac profile, show ltac profile (and variants) - Added tactics restart_timer, finish_timing, and time_constr as an experimental way of timing Ltac's evaluation phase - Added tactic optimize_heap, analogous to the Vernacular Optimize Heap, which performs a major garbage collection and heap compaction in the OCaml run-time system. - The tactics "dtauto", "dintuition", "firstorder" now handle inductive types with let bindings in the parameters. - The tactic ``dtauto`` now handles some inductives such as ``@sigT A (fun _ => B)`` as non-dependent conjunctions. - A bug fixed in ``rewrite H in *`` and ``rewrite H in * |-`` may cause a few rare incompatibilities (it was unintendedly recursively rewriting in the side conditions generated by H). - Added tactics "assert_succeeds tac" and "assert_fails tac" to ensure properties of the execution of a tactic without keeping the effect of the execution. - `vm_compute` now supports existential variables. - Calls to `shelve` and `give_up` within calls to tactic `refine` now working. - Deprecated tactic `appcontext` was removed. Focusing - Focusing bracket `{` now supports single-numbered goal selector, e.g. `2: {` will focus on the second subgoal. As usual, unfocus with `}` once the subgoal is fully solved. The `Focus` and `Unfocus` commands are now deprecated. Commands - Proofs ending in "Qed exporting ident, .., ident" are not supported anymore. Constants generated during `abstract` are kept private to the local environment. - The deprecated Coercion Local, Open Local Scope, Notation Local syntax was removed. Use Local as a prefix instead. - For the Extraction Language command, "OCaml" is spelled correctly. The older "Ocaml" is still accepted, but deprecated. - Using “Require” inside a section is deprecated. - An experimental command "Show Extraction" allows to extract the content of the current ongoing proof (grant wish #4129). - Coercion now accepts the type of its argument to be "Prop" or "Type". - The "Export" modifier can now be used when setting and unsetting options, and will result in performing the same change when the module corresponding the command is imported. - The `Axiom` command does not automatically declare axioms as instances when their type is a class. Previous behavior can be restored using `Set Typeclasses Axioms Are Instances`. Universes - Qualified naming of global universes now works like other namespaced objects (e.g. constants), with a separate namespace, inside and across module and library boundaries. Global universe names introduced in an inductive / constant / Let declaration get qualified with the name of the declaration. - Universe cumulativity for inductive types is now specified as a variance for each polymorphic universe. See the reference manual for more information. - Inference of universe constraints with cumulative inductive types produces more general constraints. Unsetting new option Cumulativity Weak Constraints produces even more general constraints (but may produce too many universes to be practical). - Fix #5726: Notations that start with `Type` now support universe instances with `@{u}`. - `with Definition` now understands universe declarations (like `@{u| Set < u}`). Tools - 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. - GeoProof support was removed. Checker - The checker now accepts filenames in addition to logical paths. CoqIDE - Find and Replace All report the number of occurrences found; Find indicates when it wraps. coqdep - Learned to read -I, -Q, -R and filenames from _CoqProject files. This is used by coq_makefile when generating dependencies for .v files (but not other files). Documentation - 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 of the reference manual to the Sphinx documentation tool. The result is partially integrated in this version. Standard Library - New libraries Coq.Init.Decimal, Coq.Numbers.DecimalFacts, Coq.Numbers.DecimalNat, Coq.Numbers.DecimalPos, Coq.Numbers.DecimalN, Coq.Numbers.DecimalZ, Coq.Numbers.DecimalString providing a type of decimal numbers, some facts about them, and conversions between decimal numbers and nat, positive, N, Z, and string. - Added [Coq.Strings.String.concat] to concatenate a list of strings inserting a separator between each item - Notation `'` for Zpos in QArith was removed. - Some deprecated aliases are now emitting warnings when used. Compatibility support - Support for compatibility with versions before 8.6 was dropped. Options - The following deprecated options have been removed: + `Refolding Reduction` + `Standard Proposition Elimination` + `Dependent Propositions Elimination` + `Discriminate Introduction` + `Shrink Abstract` + `Tactic Pattern Unification` + `Intuition Iff Unfolding` + `Injection L2R Pattern Order` + `Record Elimination Schemes` + `Match Strict` + `Tactic Compat Context` + `Typeclasses Legacy Resolution` + `Typeclasses Module Eta` + `Typeclass Resolution After Apply` 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` option did not have the expected behavior. Tactic language - The undocumented "nameless" forms `fix N`, `cofix` have been deprecated; please use `fix ident N /cofix ident` to explicitly name the (co)fixpoint hypothesis to be introduced. Documentation - The reference manual is now fully ported to Sphinx. Other small deprecations and bug fixes. Details of changes in 8.8.1 ~~~~~~~~~~~~~~~~~~~~~~~~~~~ Kernel - Fix a critical bug with cofixpoints and `vm_compute`/`native_compute` (#7333). - Fix a critical bug with modules and algebraic universes (#7695) - Fix a critical bug with inlining of polymorphic constants (#7615). - Fix a critical bug with universe polymorphism and `vm_compute` (#7723). Was present since 8.5. Notations - Fixed unexpected collision between only-parsing and only-printing notations (issue #7462). Windows installer - The Windows installer now includes external packages Ltac2 and Equations (it included the Bignums package since 8.8+beta1). Many other bug fixes, documentation improvements (including fixes of regressions due to the Sphinx migration), and user message improvements (for details, see the 8.8.1 milestone at https://github.com/coq/coq/milestone/13?closed=1). Details of changes in 8.8.2 ~~~~~~~~~~~~~~~~~~~~~~~~~~~ Documentation - A PDF version of the reference manual is available once again. Tools - The coq-makefile targets `print-pretty-timed`, `print-pretty-timed-diff`, and `print-pretty-single-time-diff` now correctly label the "before" and "after" columns, rather than swapping them. Kernel - The kernel does not tolerate capture of global universes by polymorphic universe binders, fixing a soundness break (triggered only through custom plugins) Windows installer - The Windows installer now includes many more external packages that can be individually selected for installation. Many other bug fixes and lots of documentation improvements (for details, see the 8.8.2 milestone at https://github.com/coq/coq/milestone/15?closed=1). Version 8.7 ----------- Summary of changes ~~~~~~~~~~~~~~~~~~ Coq version 8.7 contains the result of refinements, stabilization of features and cleanups of the internals of the system along with a few new features. The main user visible changes are: - New tactics: variants of tactics supporting existential variables :tacn:`eassert`, :tacn:`eenough`, etc... by Hugo Herbelin. Tactics ``extensionality in H`` and :tacn:`inversion_sigma` by Jason Gross, ``specialize with ...`` accepting partial bindings by Pierre Courtieu. - ``Cumulative Polymorphic Inductive`` types, allowing cumulativity of universes to go through applied inductive types, by Amin Timany and Matthieu Sozeau. - Integration of the SSReflect plugin and its documentation in the reference manual, by Enrico Tassi, Assia Mahboubi and Maxime Dénès. - The ``coq_makefile`` tool was completely redesigned to improve its maintainability and the extensibility of generated Makefiles, and to make ``_CoqProject`` files more palatable to IDEs by Enrico Tassi. Coq 8.7 involved a large amount of work on cleaning and speeding up the code base, notably the work of Pierre-Marie Pédrot on making the tactic-level system insensitive to existential variable expansion, providing a safer API to plugin writers and making the code more robust. The ``dev/doc/changes.txt`` file documents the numerous changes to the implementation and improvements of interfaces. An effort to provide an official, streamlined API to plugin writers is in progress, thanks to the work of Matej Košík. Version 8.7 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. The efficiency of the whole system has been significantly improved thanks to contributions from Pierre-Marie Pédrot, Maxime Dénès and Matthieu Sozeau and performance issue tracking by Jason Gross and Paul Steckler. Thomas Sibut-Pinote and Hugo Herbelin added support for side effect hooks in cbv, cbn and simpl. The side effects are provided via a plugin available at https://github.com/herbelin/reduction-effects/. The BigN, BigZ, BigQ libraries are no longer part of the Coq standard library, they are now provided by a separate repository https://github.com/coq/bignums, maintained by Pierre Letouzey. In the Reals library, ``IZR`` has been changed to produce a compact representation of integers and real constants are now represented using ``IZR`` (work by Guillaume Melquiond). Standard library additions and improvements by Jason Gross, Pierre Letouzey and others, documented in the next subsection file. The mathematical proof language/declarative mode plugin was removed from the archive. The opam repository for Coq packages has been maintained by Guillaume Melquiond, Matthieu Sozeau, Enrico Tassi with contributions from many users. A list of packages is available at https://coq.inria.fr/opam/www/. Packaging tools and software development kits were prepared by Michael Soegtrop with the help of Maxime Dénès and Enrico Tassi for Windows, and Maxime Dénès for MacOS X. Packages are regularly built on the Travis continuous integration server. The contributors for this version are Abhishek Anand, C.J. Bell, Yves Bertot, Frédéric Besson, Tej Chajed, Pierre Courtieu, Maxime Dénès, Julien Forest, Gaëtan Gilbert, Jason Gross, Hugo Herbelin, Emilio Jesús Gallego Arias, Ralf Jung, Matej Košík, Xavier Leroy, Pierre Letouzey, Assia Mahboubi, Cyprien Mangin, Erik Martin-Dorel, Olivier Marty, Guillaume Melquiond, Sam Pablo Kuper, Benjamin Pierce, Pierre-Marie Pédrot, Lars Rasmusson, Lionel Rieg, Valentin Robert, Yann Régis-Gianas, Thomas Sibut-Pinote, Michael Soegtrop, Matthieu Sozeau, Arnaud Spiwack, Paul Steckler, George Stelle, Pierre-Yves Strub, Enrico Tassi, Hendrik Tews, Amin Timany, Laurent Théry, Vadim Zaliva and Théo Zimmermann. The development process was coordinated by Matthieu Sozeau with the help of Maxime Dénès, who was also in charge of the release process. Théo Zimmermann is the maintainer of this release. Many power users helped to improve the design of the new features via the bug tracker, the pull request system, the Coq development mailing list or the Coq-Club mailing list. Special thanks to the users who contributed patches and intensive brain-storming and code reviews, starting with Jason Gross, Ralf Jung, Robbert Krebbers, Xavier Leroy, Clément Pit–Claudel and Gabriel Scherer. It would however be impossible to mention exhaustively the names of everybody who to some extent influenced the development. Version 8.7 is the second release of Coq developed on a time-based development cycle. Its development spanned 9 months from the release of Coq 8.6 and was based on a public road-map. It attracted many external contributions. Code reviews and continuous integration testing were systematically used 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.6 while maintaining compatibility. Coq Enhancement Proposals (CEPs for short) and open pull request discussions were used to discuss publicly the new features. The Coq consortium, an organization directed towards users and supporters of the system, is now upcoming and will rely on Inria’s newly created Foundation. | Paris, August 2017, | Matthieu Sozeau and the Coq development team | Potential compatibility issues ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - Extra superfluous names in introduction patterns may now raise an error rather than a warning when the superfluous name is already in use. The easy fix is to remove the superfluous name. Details of changes in 8.7+beta1 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Tactics - New tactic "extensionality in H" which applies (possibly dependent) functional extensionality in H supposed to be a quantified equality until giving a bare equality. - New tactic ``inversion_sigma`` which turns equalities of dependent pairs (e.g., ``existT P x p = existT P y q``, frequently left over by ``inversion`` on a dependent type family) into pairs of equalities (e.g., a hypothesis ``H : x = y`` and a hypothesis of type ``rew H in p = q``); these hypotheses can subsequently be simplified using ``subst``, without ever invoking any kind of axiom asserting uniqueness of identity proofs. If you want to explicitly specify the hypothesis to be inverted, or name the generated hypotheses, you can invoke ``induction H as [H1 H2] using eq_sigT_rect``. The tactic also works for ``sig``, ``sigT2``, and ``sig2``, and there are similar ``eq_sig*_rect`` induction lemmas. - Tactic "specialize with ..." now accepts any partial bindings. Missing bindings are either solved by unification or left quantified in the hypothesis. - New representation of terms that statically ensure stability by evar-expansion. This has several consequences. * In terms of performance, this adds a cost to every term destructuration, but at the same time most eager evar normalizations were removed, which couterbalances this drawback and even sometimes outperforms the old implementation. For instance, many operations that would require O(n) normalization of the term are now O(1) in tactics. YMMV. * This triggers small changes in unification, which was not evar-insensitive. Most notably, the new implementation recognizes Miller patterns that were missed before because of a missing normalization step. Hopefully this should be fairly uncommon. - Tactic "auto with real" can now discharge comparisons of literals. - The types of variables in patterns of "match" are now beta-iota-reduced after type checking. This has an impact on the type of the variables that the tactic "refine" introduces in the context, producing types that should be closer to the expectations. - In "Tactic Notation" or "TACTIC EXTEND", entry "constr_with_bindings" now uses type classes and rejects terms with unresolved holes, like entry "constr" does. To get the former behavior use "open_constr_with_bindings" (possible source of incompatibility). - New e-variants eassert, eenough, epose proof, eset, eremember, epose which behave like the corresponding variants with no "e" but turn unresolved implicit arguments into existential variables, on the shelf, rather than failing. - Tactic injection has become more powerful (closes bug #4890) and its documentation has been updated. - New variants of the `first` and `solve` tacticals that do not rely on parsing rules, meant to define tactic notations. - Added support for side effects hooks in `cbv`, `cbn` and `simpl`. The side effects are provided via a plugin: https://github.com/herbelin/reduction-effects/ - It is now possible to take hint database names as parameters in a Ltac definition or a Tactic Notation. - New option `Set Ltac Batch Debug` on top of `Set Ltac Debug` for non-interactive Ltac debug output. Gallina - Now supporting all kinds of binders, including 'pat, in syntax of record fields. Commands - Goals context can be printed in a more compact way when `Set Printing Compact Contexts` is activated. - Unfocused goals can be printed with the `Set Printing Unfocused` option. - `Print` now shows the types of let-bindings. - The compatibility options for printing primitive projections (`Set Printing Primitive Projection Parameters` and `Set Printing Primitive Projection Compatibility`) are now off by default. - 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. - `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`. - `Search` now sorts results by relevance (the relevance metric is a weighted sum of number of distinct symbols and size of the term). Standard Library - New file PropExtensionality.v to explicitly work in the axiomatic context of propositional extensionality. - New file SetoidChoice.v axiomatically providing choice over setoids, and, consequently, choice of representatives in equivalence classes. Various proof-theoretic characterizations of choice over setoids in file ChoiceFacts.v. - 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 library, they are now provided by a separate repository https://github.com/coq/bignums The split has been done just after the Int31 library. - IZR (Reals) has been changed to produce a compact representation of integers. As a consequence, IZR is no longer convertible to INR and lemmas such as INR_IZR_INZ should be used instead. - Real constants are now represented using IZR rather than R0 and R1; this might cause rewriting rules to fail to apply to constants. - Added new notation {x & P} for sigT (without a type for x) Plugins - 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. - The extraction plugin is no longer loaded by default. It must be explicitly loaded with [Require Extraction], which is backwards compatible. - The functional induction plugin (which provides the [Function] vernacular) is no longer loaded by default. It must be explicitly loaded with [Require FunInd], which is backwards compatible. Dependencies - Support for camlp4 has been removed. Tools - coq_makefile was completely redesigned to improve its maintainability and 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 files, -R options, ...) * coq_makefile translates _CoqProject to Makefile.conf and copies in the desired location a standard Makefile (that reads Makefile.conf) * Makefile extensions can be implemented in a Makefile.local file (read by the main Makefile) by installing a hook in the extension points provided by the standard Makefile The current version contains code for retro compatibility that prints warnings when a deprecated feature is used. Please upgrade your _CoqProject accordingly. * Additionally, coq_makefile-made Makefiles now support experimental timing targets `pretty-timed`, `pretty-timed-before`, `pretty-timed-after`, `print-pretty-timed-diff`, `print-pretty-single-time-diff`, `all.timing.diff`, and the variable `TIMING=1` (or `TIMING=before` or `TIMING=after`); see the documentation for more details. Build Infrastructure - Note that 'make world' does not build the bytecode binaries anymore. For that, you can use 'make byte' (and 'make install-byte' afterwards). Warning: native and byte compilations should *not* be mixed in the same instance of 'make -j', otherwise both ocamlc and ocamlopt might race for access to the same .cmi files. In short, use "make -j && make -j byte" instead of "make -j world byte". Universes - Cumulative inductive types. see prefixes "Cumulative", "NonCumulative" for inductive definitions and the option "Set Polymorphic Inductive Cumulativity" in the reference manual. - New syntax `foo@{_}` to instantiate a polymorphic definition with anonymous universes (can also be used with `Type`). XML Protocol and internal changes See dev/doc/changes.txt Many bugfixes including #1859, #2884, #3613, #3943, #3994, #4250, #4709, #4720, #4824, #4844, #4911, #5026, #5233, #5275, #5315, #5336, #5360, #5390, #5414, #5417, #5420, #5439, #5449, #5475, #5476, #5482, #5501, #5507, #5520, #5523, #5524, #5553, #5577, #5578, #5589, #5597, #5598, #5607, #5618, #5619, #5620, #5641, #5648, #5651, #5671. Many bugfixes on OS X and Windows (now the test-suite passes on these platforms too). Many optimizations. Many documentation improvements. Details of changes in 8.7+beta2 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Tools - 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 (in particular, make sure the `-safe-string` option is used to compile plugins). Details of changes in 8.7.0 ~~~~~~~~~~~~~~~~~~~~~~~~~~~ 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 experimental and may require large amounts of RAM and CPU, see INSTALL for more details. Details of changes in 8.7.1 ~~~~~~~~~~~~~~~~~~~~~~~~~~~ Compatibility with OCaml 4.06.0. Many bug fixes, documentation improvements, and user message improvements (for details see the 8.7.1 milestone at https://github.com/coq/coq/milestone/10?closed=1). Details of changes in 8.7.2 ~~~~~~~~~~~~~~~~~~~~~~~~~~~ Fixed a critical bug in the VM handling of universes (#6677). This bug affected all releases since 8.5. Improved support for building with OCaml 4.06.0 and external num package. Many other bug fixes, documentation improvements, and user message improvements (for details, see the 8.7.2 milestone at https://github.com/coq/coq/milestone/11?closed=1). Version 8.6 ----------- Summary of changes ~~~~~~~~~~~~~~~~~~ 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: - A new, faster state-of-the-art universe constraint checker, by Jacques-Henri Jourdan. - In CoqIDE and other asynchronous interfaces, more fine-grained asynchronous processing and error reporting by Enrico Tassi, making Coq capable of recovering from errors and continue processing the document. - More access to the proof engine features from Ltac: goal management primitives, range selectors and a :tacn:`typeclasses eauto` engine handling multiple goals and multiple successes, by Cyprien Mangin, Matthieu Sozeau and Arnaud Spiwack. - Tactic behavior uniformization and specification, generalization of intro-patterns by Hugo Herbelin and others. - A brand new warning system allowing to control warnings, turn them into errors or ignore them selectively by Maxime Dénès, Guillaume Melquiond, Pierre-Marie Pédrot and others. - Irrefutable patterns in abstractions, by Daniel de Rauglaudre. - The ssreflect subterm selection algorithm by Georges Gonthier and Enrico Tassi is now accessible to tactic writers through the ssrmatching plugin. - 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 improvements regarding the different components of the system. We shall only list a few of them. The iota reduction flag is now a shorthand for match, fix and cofix flags controlling the corresponding reduction rules (by Hugo Herbelin and Maxime Dénès). Maxime Dénès maintained the native compilation machinery. Pierre-Marie Pédrot separated the Ltac code from general purpose tactics, and generalized and rationalized the handling of generic arguments, allowing to create new versions of Ltac more easily in the future. In patterns and terms, @, abbreviations and notations are now interpreted the same way, by Hugo Herbelin. Name handling for universes has been improved by Pierre-Marie Pédrot and Matthieu Sozeau. The minimization algorithm has been improved by Matthieu Sozeau. The unifier has been improved by Hugo Herbelin and Matthieu Sozeau, fixing some incompatibilities introduced in Coq 8.5. Unification constraints can now be left floating around and be seen by the user thanks to a new option. The Keyed Unification mode has been improved by Matthieu Sozeau. The typeclass resolution engine and associated proof search tactic have been reimplemented on top of the proof-engine monad, providing better integration in tactics, and new options have been introduced to control it, by Matthieu Sozeau with help from Théo Zimmermann. The efficiency of the whole system has been significantly improved thanks to contributions from Pierre-Marie Pédrot, Maxime Dénès and Matthieu Sozeau and performance issue tracking by Jason Gross and Paul Steckler. Standard library improvements by Jason Gross, Sébastien Hinderer, Pierre Letouzey and others. Emilio Jesús Gallego Arias contributed many cleanups and refactorings of the pretty-printing and user interface communication components. Frédéric Besson maintained the micromega tactic. The opam repository for Coq packages has been maintained by Guillaume Claret, Guillaume Melquiond, Matthieu Sozeau, Enrico Tassi and others. A list of packages is now available at https://coq.inria.fr/opam/www/. Packaging tools and software development kits were prepared by Michael Soegtrop with the help of Maxime Dénès and Enrico Tassi for Windows, and Maxime Dénès and Matthieu Sozeau for MacOS X. Packages are now regularly built on the continuous integration server. Coq now comes with a META file usable with ocamlfind, contributed by Emilio Jesús Gallego Arias, Gregory Malecha, and Matthieu Sozeau. Matej Košík maintained and greatly improved the continuous integration setup and the testing of Coq contributions. He also contributed many API improvements and code cleanups throughout the system. The contributors for this version are Bruno Barras, C.J. Bell, Yves Bertot, Frédéric Besson, Pierre Boutillier, Tej Chajed, Guillaume Claret, Xavier Clerc, Pierre Corbineau, Pierre Courtieu, Maxime Dénès, Ricky Elrod, Emilio Jesús Gallego Arias, Jason Gross, Hugo Herbelin, Sébastien Hinderer, Jacques-Henri Jourdan, Matej Košík, Xavier Leroy, Pierre Letouzey, Gregory Malecha, Cyprien Mangin, Erik Martin-Dorel, Guillaume Melquiond, Clément Pit–Claudel, Pierre-Marie Pédrot, Daniel de Rauglaudre, Lionel Rieg, Gabriel Scherer, Thomas Sibut-Pinote, Matthieu Sozeau, Arnaud Spiwack, Paul Steckler, Enrico Tassi, Laurent Théry, Nickolai Zeldovich and Théo Zimmermann. The development process was coordinated by Hugo Herbelin and Matthieu Sozeau with the help of Maxime Dénès, who was also in charge of the release process. Many power users helped to improve the design of the new features via the bug tracker, the pull request system, the Coq development mailing list or the Coq-Club mailing list. Special thanks to the users who contributed patches and intensive brain-storming and code reviews, starting with Cyril Cohen, Jason Gross, Robbert Krebbers, Jonathan Leivent, Xavier Leroy, Gregory Malecha, Clément Pit–Claudel, Gabriel Scherer and Beta Ziliani. It would however be impossible to mention exhaustively the names of everybody who to some extent influenced the 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 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 Tassi to provide more visibility and a discussion period on new features, they are publicly available https://github.com/coq/ceps. Started during this period, an effort is led by Yves Bertot and Maxime Dénès to put together a Coq consortium. | Paris, November 2016, | Matthieu Sozeau and the Coq development team | Potential sources of incompatibilities ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - Symptom: An obligation generated by Program or an abstracted subproof has different arguments. Cause: Set Shrink Abstract and Set Shrink Obligations are on by default and the subproof does not use the argument. Remedy: + Adapt the script. + Write an explicit lemma to prove the obligation/subproof and use it instead (compatible with 8.4). + Unset the option for the program/proof the obligation/subproof originates from. - Symptom: In a goal, order of hypotheses, or absence of an equality of the form "x = t" or "t = x", or no unfolding of a local definition. Cause: This might be connected to a number of fixes in the tactic "subst". The former behavior can be reactivated by issuing "Unset Regular Subst Tactic". Details of changes in 8.6beta1 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Kernel - A new, faster state-of-the-art universe constraint checker. Specification language - Giving implicit arguments explicitly to a constant with multiple choices of implicit arguments does not break any more insertion of further maximal implicit arguments. - Ability to put any pattern in binders, prefixed by quote, e.g. "fun '(a,b) => ...", "λ '(a,(b,c)), ...", "Definition foo '(x,y) := ...". It expands into a "let 'pattern := ..." Tactics - Flag "Bracketing Last Introduction Pattern" is now on by default. - Flag "Regular Subst Tactic" is now on by default: it respects the initial order of hypothesis, it contracts cycles, it unfolds no local definitions (common source of incompatibilities, fixable by "Unset Regular Subst Tactic"). - New flag "Refolding Reduction", now disabled by default, which turns on refolding of constants/fixpoints (as in cbn) during the reductions done during type inference and tactic retyping. Can be extremely expensive. When set off, this recovers the 8.4 behavior of unification and type inference. Potential source of incompatibility with 8.5 developments (the option is set on in Compat/Coq85.v). - New flag "Shrink Abstract" that minimalizes proofs generated by the abstract tactical w.r.t. variables appearing in the body of the proof. On by default and deprecated. Minor source of incompatibility for code relying on the precise arguments of abstracted proofs. - Serious bugs are fixed in tactic "double induction" (source of incompatibilities as soon as the inductive types have dependencies in the type of their constructors; "double induction" remains however deprecated). - In introduction patterns of the form (pat1,...,patn), n should match the exact number of hypotheses introduced (except for local definitions for which pattern can be omitted, as in regular pattern-matching). - Tactic scopes in Ltac like constr: and ltac: now require parentheses around their argument. - Every generic argument type declares a tactic scope of the form "name:(...)" where name is the name of the argument. This generalizes the constr: and ltac: instances. - When in strict mode (i.e. in a Ltac definition), if the "intro" tactic is given a free identifier, it is not bound in subsequent tactics anymore. In order to introduce a binding, use e.g. the "fresh" primitive instead (potential source of incompatibilities). - New tactics is_ind, is_const, is_proj, is_constructor for use in Ltac. - New goal selectors. Sets of goals can be selected by listing integers ranges. Example: "1,4-7,24: tac" focuses "tac" on goals 1,4,5,6,7,24. - For uniformity with "destruct"/"induction" and for a more natural behavior, "injection" can now work in place by activating option "Structural Injection". In this case, hypotheses are also put in the context in the natural left-to-right order and the hypothesis on which injection applies is cleared. - Tactic "contradiction" (hence "easy") now also solve goals with hypotheses of the form "~True" or "t<>t" (possible source of incompatibilities because of more successes in automation, but generally a more intuitive strategy). - Option "Injection On Proofs" was renamed "Keep Proof Equalities". When enabled, injection and inversion do not drop equalities between objects in Prop. Still disabled by default. - New tactics "notypeclasses refine" and "simple notypeclasses refine" that disallow typeclass resolution when typechecking their argument, for use in typeclass hints. - Integration of LtacProf, a profiler for Ltac. - Reduction tactics now accept more fine-grained flags: iota is now a shorthand for the new flags match, fix and cofix. - The ssreflect subterm selection algorithm is now accessible to tactic writers through the ssrmatching plugin. - When used as an argument of an ltac function, "auto" without "with" nor "using" clause now correctly uses only the core hint database by default. Hints - Revised the syntax of [Hint Cut] to follow standard notation for regexps. - Hint Mode now accepts "!" which means that the mode matches only if the argument's head is not an evar (it goes under applications, casts, and scrutinees of matches and projections). - Hints can now take an optional user-given pattern, used only by [typeclasses eauto] with the [Filtered Unification] option on. Typeclasses - Many new options and new engine based on the proof monad. The [typeclasses eauto] tactic is now a multi-goal, multi-success tactic. See reference manual for more information. It is planned to replace auto and eauto in the following version. The 8.5 resolution engine is still available to help solve compatibility issues. Program - The "Shrink Obligations" flag now applies to all obligations, not only those solved by the automatic tactic. - "Shrink Obligations" is on by default and deprecated. Minor source of incompatibility for code relying on the precise arguments of obligations. Notations - "Bind Scope" can once again bind "Funclass" and "Sortclass". 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 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 easy to parse format - Setting [Printing Dependent Evars Line] can be unset to disable the computation associated with printing the "dependent evars: " line in -emacs mode - Removed the -verbose-compat-notations flag and the corresponding Set Verbose Compat vernacular, since these warnings can now be silenced or turned into errors using "-w". XML protocol - message format has changed, see dev/doc/changes.txt for more details. Many bug fixes, minor changes and documentation improvements are not mentioned here. Details of changes in 8.6 ~~~~~~~~~~~~~~~~~~~~~~~~~ Kernel - Fixed critical bug #5248 in VM long multiplication on 32-bit architectures. Was there only since 8.6beta1, so no stable release impacted. 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 plugin warnings - Document named evars (including Show ident) - Fix Bug #5574, document function scope - Adding a test case as requested in bug 5205. - Fix Bug #5568, no dup notation warnings on repeated module imports - Fix documentation of Typeclasses eauto := - Refactor documentation of records. - Protecting from warnings while compiling 8.6 - Fixing an inconsistency between configure and configure.ml - Add test-suite checks for coqchk with constraints - Fix bug #5019 (looping zify on dependent types) - Fix bug 5550: "typeclasses eauto with" does not work with section variables. - Bug 5546, qualify datatype constructors when needed in Show Match - Bug #5535, test for Show with -emacs - Fix bug #5486, don't reverse ids in tuples - Fixing #5522 (anomaly with free vars of pat) - Fix bug #5526, don't check for nonlinearity in notation if printing only - Fix bug #5255 - Fix bug #3659: -time should understand multibyte encodings. - FIx bug #5300: Anomaly: Uncaught exception Not_found" in "Print Assumptions". - Fix outdated description in RefMan. - Repairing `Set Rewriting Schemes` - Fixing #5487 (v8.5 regression on ltac-matching expressions with evars). - Fix description of command-line arguments for Add (Rec) LoadPath - Fix bug #5377: @? patterns broken. - add XML protocol doc - Fix anomaly when doing [all:Check _.] during a proof. - Correction of bug #4306 - Fix #5435: [Eval native_compute in] raises anomaly. - Instances should obey universe binders even when defined by tactics. - Intern names bound in match patterns - funind: Ignore missing info for current function - Do not typecheck twice the type of opaque constants. - show unused intro pattern warning - [future] Be eager when "chaining" already resolved future values. - Opaque side effects - Fix #5132: coq_makefile generates incorrect install goal - Run non-tactic comands without resilient_command - Univs: fix bug #5365, generation of u+k <= v constraints - make ``emit`` tail recursive - Don't require printing-only notation to be productive - Fix the way setoid_rewrite handles bindings. - Fix for bug 5244 - set printing width ignored when given enough space - Fix bug 4969, autoapply was not tagging shelved subgoals correctly Version 8.5 ----------- Summary of changes ~~~~~~~~~~~~~~~~~~ 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. - Full integration of the new proof engine by Arnaud Spiwack helped by Pierre-Marie Pédrot, - Addition of conversion and reduction based on native compilation by Maxime Dénès and Benjamin Grégoire. - Full universe polymorphism for definitions and inductive types by Matthieu Sozeau. - An implementation of primitive projections with η-conversion bringing significant performance improvements when using records by Matthieu Sozeau. The full integration of the proof engine, by Arnaud Spiwack and Pierre-Marie Pédrot, brings to primitive tactics and the user level Ltac language dependent subgoals, deep backtracking and multiple goal handling, along with miscellaneous features and an improved potential for future modifications. Dependent subgoals allow statements in a goal to mention the proof of another. Proofs of unsolved subgoals appear as existential variables. Primitive backtracking makes it possible to write a tactic with several possible outcomes which are tried successively when subsequent tactics fail. Primitives are also available to control the backtracking behavior of tactics. Multiple goal handling paves the way for smarter automation tactics. It is currently used for simple goal manipulation such as goal reordering. The way Coq processes a document in batch and interactive mode has been redesigned by Enrico Tassi with help from Bruno Barras. Opaque proofs, the text between Proof and Qed, can be processed asynchronously, decoupling the checking of definitions and statements from the checking of proofs. It improves the responsiveness of interactive development, since proofs can be processed in the background. Similarly, compilation of a file can be split into two phases: the first one checking only definitions and statements and the second one checking proofs. A file resulting from the first phase – with the .vio extension – can be already Required. All .vio files can be turned into complete .vo files in parallel. The same infrastructure also allows terminating tactics to be run in parallel on a set of goals via the ``par:`` goal selector. CoqIDE was modified to cope with asynchronous checking of the document. Its source code was also made separate from that of Coq, so that CoqIDE no longer has a special status among user interfaces, paving the way for decoupling its release cycle from that of Coq in the future. Carst Tankink developed a Coq back-end for user interfaces built on Makarius Wenzel’s Prover IDE framework (PIDE), like PIDE/jEdit (with help from Makarius Wenzel) or PIDE/Coqoon (with help from Alexander Faithfull and Jesper Bengtson). The development of such features was funded by the Paral-ITP French ANR project. The full universe polymorphism extension was designed by Matthieu Sozeau. It conservatively extends the universes system and core calculus with definitions and inductive declarations parameterized by universes and constraints. It is based on a modification of the kernel architecture to handle constraint checking only, leaving the generation of constraints to the refinement/type inference engine. Accordingly, tactics are now fully universe aware, resulting in more localized error messages in case of inconsistencies and allowing higher-level algorithms like unification to be entirely type safe. The internal representation of universes has been modified but this is invisible to the user. The underlying logic has been extended with η-conversion for records defined with primitive projections by Matthieu Sozeau. This additional form of η-conversion is justified using the same principle than the previously added η-conversion for function types, based on formulations of the Calculus of Inductive Constructions with typed equality. Primitive projections, which do not carry the parameters of the record and are rigid names (not defined as a pattern matching construct), make working with nested records more manageable in terms of time and space consumption. This extension and universe polymorphism were carried out partly while Matthieu Sozeau was working at the IAS in Princeton. The guard condition has been made compliant with extensional equality principles such as propositional extensionality and univalence, thanks to Maxime Dénès and Bruno Barras. To ensure compatibility with the univalence axiom, a new flag ``-indices-matter`` has been implemented, taking into account the universe levels of indices when computing the levels of inductive types. This supports using Coq as a tool to explore the relations between homotopy theory and type theory. Maxime Dénès and Benjamin Grégoire developed an implementation of 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 and improvements regarding the different components of the system. We shall only list a few of them. Pierre Boutillier developed an improved tactic for simplification of expressions called :tacn:`cbn`. Maxime Dénès maintained the bytecode-based reduction machine. Pierre Letouzey maintained the extraction mechanism. Pierre-Marie Pédrot has extended the syntax of terms to, experimentally, allow holes in terms to be solved by a locally specified tactic. Existential variables are referred to by identifiers rather than mere numbers, thanks to Hugo Herbelin who also improved the tactic language here and there. Error messages for universe inconsistencies have been improved by Matthieu Sozeau. Error messages for unification and type inference failures have been improved by Hugo Herbelin, Pierre-Marie Pédrot and Arnaud Spiwack. Pierre Courtieu contributed new features for using Coq through Proof General and for better interactive experience (bullets, Search, etc). The efficiency of the whole system has been significantly improved thanks to contributions from Pierre-Marie Pédrot. A distribution channel for Coq packages using the opam tool has been initiated by Thomas Braibant and developed by Guillaume Claret, with contributions by Enrico Tassi and feedback from Hugo Herbelin. Packaging tools were provided by Pierre Letouzey and Enrico Tassi (Windows), Pierre Boutillier, Matthieu Sozeau and Maxime Dénès (MacOS X). Maxime Dénès improved significantly the testing and benchmarking support. Many power users helped to improve the design of the new features via the bug tracker, the coq development mailing list or the Coq-Club mailing list. Special thanks are going to the users who contributed patches and intensive brain-storming, starting with Jason Gross, Jonathan Leivent, Greg Malecha, Clément Pit-Claudel, Marc Lasson, Lionel Rieg. It would however be impossible to mention with precision all names of people who to some extent influenced the development. Version 8.5 is one of the most important releases of Coq. Its development spanned over about 3 years and a half with about one year of beta-testing. General maintenance during part or whole of this period has been done by Pierre Boutillier, Pierre Courtieu, Maxime Dénès, Hugo Herbelin, Pierre Letouzey, Guillaume Melquiond, Pierre-Marie Pédrot, Matthieu Sozeau, Arnaud Spiwack, Enrico Tassi as well as Bruno Barras, Yves Bertot, Frédéric Besson, Xavier Clerc, Pierre Corbineau, Jean-Christophe Filliâtre, Julien Forest, Sébastien Hinderer, Assia Mahboubi, Jean-Marc Notin, Yann Régis-Gianas, François Ripault, Carst Tankink. Maxime Dénès coordinated the release process. | Paris, January 2015, revised December 2015, | Hugo Herbelin, Matthieu Sozeau and the Coq development team | 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``. - Symptom: "The reference omega was not found in the current environment". Cause: "Require Omega" does not import the tactic "omega" any more Possible solutions: + use "Require Import OmegaTactic" (not compatible with 8.4) + use "Require Import Omega" (compatible with 8.4) + add definition "Ltac omega := Coq.omega.Omega.omega." - Symptom: "intuition" cannot solve a goal (not working anymore on nonstandard connective) Cause: "intuition" had an accidental non-uniform behavior fixed on nonstandard connectives Possible solutions: + use "dintuition" instead; it is stronger than "intuition" and works uniformly on nonstandard connectives, such as n-ary conjunctions or disjunctions (not compatible with 8.4) + do the script differently - Symptom: The constructor foo (in type bar) expects n arguments. Cause: parameters must now be given in patterns Possible solutions: + use option "Set Asymmetric Patterns" (compatible with 8.4) + add "_" for the parameters (not compatible with 8.4) + turn the parameters into implicit arguments (compatible with 8.4) - Symptom: "NPeano.Nat.foo" not existing anymore\ Possible solutions: + use "Nat.foo" instead Symptom: typing problems with proj1_sig or similar Cause: coercion from sig to sigT and similar coercions have been removed so as to make the initial state easier to understand for beginners Solution: change proj1_sig into projT1 and similarly (compatible with 8.4) Other detailed changes - options for *coq* compilation (see below for ocaml). + [-I foo] is now deprecated and will not add directory foo to the coq load path (only for ocaml, see below). Just replace [-I foo] by [-Q foo ""] in your project file and re-generate makefile. Or perform the same operation directly in your makefile if you edit it by hand. + Option -R Foo bar is the same in v8.5 than in v8.4 concerning coq load path. + Option [-I foo -as bar] is unchanged but discouraged unless you compile ocaml code. Use -Q foo bar instead. for more details: see section "Customization at launch time" of the reference manual. - Command line options for ocaml Compilation of ocaml code (plugins) + [-I foo] is *not* deprecated to add foo to the ocaml load path. + [-I foo -as bar] adds foo to the ocaml load path *and* adds foo to the coq load path with logical name bar (shortcut for -I foo -Q foo bar). for more details: section "Customization at launch time" of the reference manual. - Universe Polymorphism. - Refinement, unification and tactics are now aware of universes, resulting in more localized errors. Universe inconsistencies should no more get raised at Qed time but during the proof. Unification *always* produces well-typed substitutions, hence some rare cases of unifications that succeeded while producing ill-typed terms before will now fail. - The [change p with c] tactic semantics changed, now typechecking [c] at each matching occurrence [t] of the pattern [p], and converting [t] with [c]. - Template polymorphic inductive types: the partial application of a template polymorphic type (e.g. list) is not polymorphic. An explicit parameter application (e.g [fun A => list A]) or [apply (list _)] will result in a polymorphic instance. - The type inference algorithm now takes opacity of constants into account. This may have effects on tactics using type inference (e.g. induction). Extra "Transparent" might have to be added to revert opacity of constants. Type classes. - When writing an ``Instance foo : Class A := {| proj := t |}`` (note the vertical bars), support for typechecking the projections using the type information and switching to proof mode is no longer available. Use ``{ }`` (without the vertical bars) instead. Tactic abstract. - Auxiliary lemmas generated by the abstract tactic are removed from the global environment and inlined in the proof term when a proof is ended with Qed. The behavior of 8.4 can be obtained by ending proofs with "Qed exporting" or "Qed exporting ident, .., ident". Details of changes in 8.5beta1 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Logic - Primitive projections for records allow for a compact representation of projections, without parameters and avoid the behavior of defined projections that can unfold to a case expression. To turn the use of native projections on, use [Set Primitive Projections]. Record, Class and Structure types defined while this option is set will be defined with primitive projections instead of the usual encoding as a case expression. For compatibility, when p is a primitive projection, @p can be used to refer to the projection with explicit parameters, i.e. [@p] is definitionally equal to [λ params r. r.(p)]. Records with primitive projections have eta-conversion, the canonical form being [mkR pars (p1 t) ... (pn t)]. - New universe polymorphism (see reference manual) - New option -type-in-type to collapse the universe hierarchy (this makes the 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 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 leads to a non-dependent induction principle being generated in place of the dependent one. To recover the old behavior, explicitly define your inductive types in Set. Commands - A command "Variant" allows to define non-recursive variant types. - The command "Record foo ..." does not generate induction principles (foo_rect, foo_rec, foo_ind) anymore by default (feature wish #2693). The command "Variant foo ..." does not either. A flag "Set/Unset Nonrecursive Elimination Schemes" allows changing this. The tactic "induction" on a "Record" or a "Variant" is now actually doing "destruct". - The "Open Scope" command can now be given also a delimiter (e.g. Z). - The "Definition" command now allows the "Local" modifier, allowing for non-importable definitions. The same goes for "Axiom" and "Parameter". - Section-specific commands such as "Let" (resp. "Variable", "Hypothesis") used out of a section now behave like the corresponding "Local" command, i.e. "Local Definition" (resp. "Local Parameter", "Local Axiom"). (potential source of rare incompatibilities). - The "Let" command can now define local (co)fixpoints. - Command "Search" has been renamed into "SearchHead". The command name "Search" now behaves like former "SearchAbout". The latter name is deprecated. - "Search", "About", "SearchHead", "SearchRewrite" and "SearchPattern" now search for hypothesis (of the current goal by default) first. They now also support the goal selector prefix to specify another goal to search: e.g. "n:Search id". This is also true for SearchAbout although it is deprecated. - The coq/user-contrib directory and the XDG directories are no longer recursively added to the load path, so files from installed libraries now need to be fully qualified for the "Require" command to find them. The tools/update-require script can be used to convert a development. - 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 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 obligations in incomplete typeclass instances, raising an error instead. - "Collection" command to name sets of section hypotheses. Named collections can be used in the syntax of "Proof using" to assert which section variables are used in a proof. - The "Optimize Proof" command can be placed in the middle of a proof to force the compaction of the data structure used to represent the ongoing proof (evar map). This may result in a lower memory footprint and speed up the execution of the following tactics. - "Optimize Heap" command to tell the OCaml runtime to perform a major garbage collection step and heap compaction. - ``Instance`` no longer treats the ``{|...|}`` syntax specially; it handles it in the same way as other commands, e.g. "Definition". Use the ``{...}`` syntax (no pipe symbols) to recover the old behavior. Specification Language - Slight changes in unification error messages. - Added a syntax $(...)$ that allows putting tactics in terms (may break user notations using "$(", fixable by inserting a space or rewriting the notation). - Constructors in pattern-matching patterns now respect the same rules regarding implicit arguments as in applicative position. The old behavior can be recovered by the command "Set Asymmetric Patterns". As a side effect, notations for constructors explicitly mentioning non-implicit parameters can now be used in patterns. Considering that the pattern language is already rich enough, binding local definitions is however now forbidden in patterns (source of incompatibilities for local definitions that delta-reduce to a constructor). - Type inference algorithm now granting opacity of constants. This might also affect behavior of tactics (source of incompatibilities, solvable by re-declaring transparent constants which were set opaque). - Existential variables are now referred to by an identifier and the relevant part of their instance is displayed by default. They can be reparsed. The naming policy is yet unstable and subject to changes in future releases. Tactics - New tactic engine allowing dependent subgoals, fully backtracking (also known as multiple success) tactics, as well as tactics which can consider multiple goals together. In the new tactic engine, instantiation information of existential variables is always propagated to tactics, removing the need to manually use the "instantiate" tactics to mark propagation points. * New tactical (a+b) inserts a backtracking point. When (a+b);c fails during the execution of c, it can backtrack and try b instead of a. * New tactical (once a) removes all the backtracking points from a (i.e. it selects the first success of a). * Tactic "constructor" is now fully backtracking. In case of incompatibilities (e.g. combinatoric explosion), the former behavior of "constructor" can be retrieved by using instead "[> once constructor ..]". Thanks to backtracking, undocumented "constructor " syntax is now equivalent to "[> once (constructor; tac) ..]". * New "multimatch" variant of "match" tactic which backtracks to new branches in case of a later failure. The "match" tactic is equivalent to "once multimatch". * New selector "all:" such that "all:tac" applies tactic "tac" to all the focused goals, instead of just the first one as is the default. * A corresponding new option Set Default Goal Selector "all" makes the tactics in scripts be applied to all the focused goal by default * New selector "par:" such that "par:tac" applies the (terminating) tactic "tac" to all the focused goal in parallel. The number of worker can be selected with -async-proofs-tac-j and also limited using the coqworkmgr utility. * New tactics "revgoals", "cycle" and "swap" to reorder goals. * The semantics of recursive tactics (introduced with "Ltac t := ..." or "let rec t := ... in ...") changed slightly as t is now applied to every goal, not each goal independently. In particular it may be applied when no goals are left. This may cause tactics such as "let rec t := constructor;t" to loop indefinitely. The simple fix is to rewrite the recursive calls as follows: "let rec t := constructor;[t..]" which recovers the earlier behavior (source of rare incompatibilities). * New tactic language feature "numgoals" to count number of goals. It is accompanied by a "guard" tactic which fails if a Boolean test over integers does not pass. * New tactical "[> ... ]" to apply tactics to individual goals. * New tactic "gfail" which works like "fail" except it will also fail if every goal has been solved. * The refine tactic is changed not to use an ad hoc typing algorithm to generate subgoals. It also uses the dependent subgoal feature to generate goals to materialize every existential variable which is introduced by the refinement (source of incompatibilities). * A tactic shelve is introduced to manage the subgoals which may be solved by unification: shelve removes every goal it is applied to from focus. These goals can later be called back into focus by the Unshelve command. * A variant shelve_unifiable only removes those goals which appear as existential variables in other goals. To emulate the old refine, use "refine c;shelve_unifiable". This can still cause incompatibilities in rare occasions. * New "give_up" tactic to skip over a goal. A proof containing given up goals cannot be closed with "Qed", but only with "Admitted". - The implementation of the admit tactic has changed: no axiom is generated for the admitted sub proof. "admit" is now an alias for "give_up". Code relying on this specific behavior of "admit" can be made to work by: * Adding an "Axiom" for each admitted subproof. * Adding a single "Axiom proof_admitted : False." and the Ltac definition "Ltac admit := case proof_admitted.". - Matching using "lazymatch" was fundamentally modified. It now behaves like "match" (immediate execution of the matching branch) but without the backtracking mechanism in case of failure. - New "tryif t then u else v" tactical which executes "u" in case of success of "t" and "v" in case of failure. - New conversion tactic "native_compute": evaluates the goal (or an hypothesis) with a call-by-value strategy, using the OCaml native compiler. Useful on very intensive computations. - New "cbn" tactic, a well-behaved simpl. - Repeated identical calls to omega should now produce identical proof terms. - Tactics btauto, a reflexive Boolean tautology solver. - Tactic "tauto" was exceptionally able to destruct other connectives than the binary connectives "and", "or", "prod", "sum", "iff". This non-uniform behavior has been fixed (bug #2680) and tauto is slightly weaker (possible source of incompatibilities). On the opposite side, new tactic "dtauto" is able to destruct any record-like inductive types, superseding the old version of "tauto". - Similarly, "intuition" has been made more uniform and, where it now fails, "dintuition" can be used (possible source of incompatibilities). - New option "Unset Intuition Negation Unfolding" for deactivating automatic unfolding of "not" in intuition. - Tactic notations can now be defined locally to a module (use "Local" prefix). - Tactic "red" now reduces head beta-iota redexes (potential source of rare incompatibilities). - Tactic "hnf" now reduces inner beta-iota redexes (potential source of rare incompatibilities). - Tactic "intro H" now reduces beta-iota redexes if these hide a product (potential source of rare incompatibilities). - In Ltac matching on patterns of the form "_ pat1 ... patn" now behaves like if matching on "?X pat1 ... patn", i.e. accepting "_" to be instantiated by an applicative term (experimental at this stage, potential source of incompatibilities). - In Ltac matching on goal, types of hypotheses are now interpreted in the %type scope (possible source of incompatibilities). - "change ... in ..." and "simpl ... in ..." now properly consider nested occurrences (possible source of incompatibilities since this alters the numbering of occurrences), but do not support nested occurrences. - Tactics simpl, vm_compute and native_compute can be given a notation string to a constant as argument. - When given a reference as argument, simpl, vm_compute and native_compute now strictly interpret it as the head of a pattern starting with this reference. - The "change p with c" tactic semantics changed, now type checking "c" at each matching occurrence "t" of the pattern "p", and converting "t" with "c". - Now "appcontext" and "context" behave the same. The old buggy behavior of "context" can be retrieved at parse time by setting the "Tactic Compat Context" flag (possible source of incompatibilities). - New introduction pattern p/c which applies lemma c on the fly on the hypothesis under consideration before continuing with introduction pattern p. - New introduction pattern [= x1 .. xn] applies "injection as [x1 .. xn]" on the fly if injection is applicable to the hypothesis under consideration (idea borrowed from Georges Gonthier). Introduction pattern [=] applies "discriminate" if a discriminable equality. - New introduction patterns * and ** to respectively introduce all forthcoming dependent variables and all variables/hypotheses dependent or not. - Tactic "injection c as ipats" now clears c if c refers to an hypothesis and moves the resulting equations in the hypotheses independently of the number of ipats, which has itself to be less than the number of new hypotheses (possible source of incompatibilities; former behavior obtainable by "Unset Injection L2R Pattern Order"). - Tactic "injection" now automatically simplifies subgoals "existT n p = existT n p'" into "p = p'" when "n" is in an inductive type for which a decidable equality scheme has been generated with "Scheme Equality" (possible source of incompatibilities). - New tactic "rewrite_strat" for generalized rewriting with user-defined strategies, subsuming autorewrite. - Injection can now also deduce equality of arguments of sort Prop, by using the option "Set Injection On Proofs" (disabled by default). Also improved the error messages. - Tactic "subst id" now supports id occurring in dependent local definitions. - Bugs fixed about intro-pattern "*" might lead to some rare incompatibilities. - New tactical "time" to display time spent executing its argument. - Tactics referring or using a constant dependent in a section variable which has been cleared or renamed in the current goal context now fail (possible source of incompatibilities solvable by avoiding clearing the relevant hypotheses). - New construct "uconstr:c" and "type_term c" to build untyped terms. - Binders in terms defined in Ltac (either "constr" or "uconstr") can now take their names from identifiers defined in Ltac. As a consequence, a name cannot be used in a binder "constr:(fun x => ...)" if an Ltac variable of that name already exists and does not contain an identifier. Source of occasional incompatibilities. - The "refine" tactic now accepts untyped terms built with "uconstr" so that terms with holes can be constructed piecewise in Ltac. - New bullets --, ++, **, ---, +++, ***, ... made available. - More informative messages when wrong bullet is used. - Bullet suggestion when a subgoal is solved. - New tactic "enough", symmetric to "assert", but with subgoals swapped, as a more friendly replacement of "cut". - In destruct/induction, experimental modifier "!" prefixing the hypothesis name to tell not erasing the hypothesis. - Bug fixes in "inversion as" may occasionally lead to incompatibilities. - Behavior of introduction patterns -> and <- made more uniform (hypothesis is cleared, rewrite in hypotheses and conclusion and erasing the variable when rewriting a variable). - New experimental option "Set Standard Proposition Elimination Names" so that case analysis or induction on schemes in Type containing propositions now produces "H"-based names. - Tactics from plugins are now active only when the corresponding module is imported (source of incompatibilities, solvable by adding an "Import"; in the particular case of Omega, use "Require Import OmegaTactic"). - Semantics of destruct/induction has been made more regular in some edge cases, possibly leading to incompatibilities: + new goals are now opened when the term does not match a subterm of the goal and has unresolved holes, while in 8.4 these holes were turned into existential variables + when no "at" option is given, the historical semantics which selects all subterms syntactically identical to the first subterm matching the given pattern is used + non-dependent destruct/induction on an hypothesis with premises in an inductive type with indices is fixed + residual local definitions are now correctly removed. - The rename tactic may now replace variables in parallel. - A new "Info" command replaces the "info" tactical discontinued in v8.4. It still gives informative results in many cases. - The "info_auto" tactic is known to be broken and does not print a trace anymore. Use "Info 1 auto" instead. The same goes for "info_trivial". On the other hand "info_eauto" still works fine, while "Info 1 eauto" prints a trivial trace. - When using a lemma of the prototypical form "forall A, {a:A & P a}", "apply" and "apply in" do not instantiate anymore "A" with the current goal and use "a" as the proof, as they were sometimes doing, now considering that it is a too powerful decision. Program - "Solve Obligations using" changed to "Solve Obligations with", consistent with "Proof with". - Program Lemma, Definition now respect automatic introduction. - Program Lemma, Definition, etc.. now interpret "->" like Lemma and Definition as a non-dependent arrow (potential source of incompatibility). - Add/document "Set Hide Obligations" (to hide obligations in the final term inside an implicit argument) and "Set Shrink Obligations" (to minimize dependencies of obligations defined by tactics). Notations - The syntax "x -> y" is now declared at level 99. In particular, it has now a lower priority than "<->": "A -> B <-> C" is now "A -> (B <-> C)" (possible source of incompatibilities) - Notations accept term-providing tactics using the $(...)$ syntax. - "Bind Scope" can no longer bind "Funclass" and "Sortclass". - A notation can be given a (compat "8.x") annotation, making it behave like a "only parsing" notation, but the annotation may lead to eventually issue warnings or errors in further versions when this notation is used. - More systematic insertion of spaces as a default for printing notations ("format" still available to override the default). - In notations, a level modifier referring to a non-existent variable is now considered an error rather than silently ignored. Tools - Option -I now only adds directories to the ml path. - Option -Q behaves as -R, except that the logical path of any loaded file has to be fully qualified. - Option -R no longer adds recursively to the ml path; only the root directory is added. (Behavior with respect to the load path is unchanged.) - Option -nois prevents coq/theories and coq/plugins to be recursively added to the load path. (Same behavior as with coq/user-contrib.) - coqdep accepts a -dumpgraph option generating a dot file. - Makefiles generated through coq_makefile have three new targets "quick" "checkproofs" and "vio2vo", allowing respectively to asynchronously compile the files without playing the proof scripts, asynchronously checking that the quickly generated proofs are correct and generating the object 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. This is of interest for users of the par: goal selector. Interfaces - 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 declarations, and tactics like "give_up". - 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 locked text. - 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 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 be displayed with the -list-tags command line option. - Third party user interfaces can install their main loop in $COQLIB/toploop and call coqtop with the -toploop flag to select it. 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 a new directory intf/, for instance constrexpr.mli or glob_term.mli. More details in dev/doc/changes. - The file states/initial.coq does not exist anymore. Instead, coqtop initially does a "Require" of Prelude.vo (or nothing when given the options -noinit or -nois). - The format of vo files has slightly changed: cf final comments in checker/cic.mli. - The build system does not produce anymore programs named coqtop.opt and a symbolic link to coqtop. Instead, coqtop is now directly an executable compiled with the best OCaml compiler available. The bytecode program coqtop.byte is still produced. Same for other utilities. - Some options of the ./configure script slightly changed: * The -coqrunbyteflags and its blank-separated argument is replaced by option -vmbyteflags which expects a comma-separated argument. * The -coqtoolsbyteflags option is discontinued, see -no-custom instead. Miscellaneous - ML plugins now require a "DECLARE PLUGIN \"foo\"" statement. The "foo" name must be exactly the name of the ML module that will be loaded through a "Declare ML \"foo\"" command. Details of changes in 8.5beta2 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Logic - The VM now supports inductive types with up to 8388851 non-constant constructors and up to 8388607 constant ones. Specification language - Syntax "$(tactic)$" changed to "ltac: tactic". Tactics - A script using the admit tactic can no longer be concluded by either Qed or Defined. In the first case, Admitted can be used instead. In the second case, a subproof should be used. - The easy tactic and the now tactical now have a more predictable behavior, but they might now discharge some previously unsolved goals. Extraction - Definitions extracted to Haskell GHC should no longer randomly segfault when some Coq types cannot be represented by Haskell types. - Definitions can now be extracted to Json for post-processing. Tools - Option -I -as has been removed, and option -R -as has been deprecated. In both cases, option -R can be used instead. - coq_makefile now generates double-colon rules for rules such as clean. API - The interface of [change] has changed to take a [change_arg], which can be built from a [constr] using [make_change_arg]. Details of changes in 8.5beta3 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Commands - New command "Redirect" to redirect the output of a command to a file. - New command "Undelimit Scope" to remove the delimiter of a scope. - New option "Strict Universe Declaration", set by default. It enforces the declaration of all polymorphic universes appearing in a definition when introducing it. - New command "Show id" to show goal named id. - Option "Virtual Machine" removed. Tactics - New flag "Regular Subst Tactic" which fixes "subst" in situations where it failed to substitute all substitutable equations or failed to simplify cycles, or accidentally unfolded local definitions (flag is off by default). - New flag "Loose Hint Behavior" to handle hints loaded but not imported in a special way. It accepts three distinct flags: * "Lax", which is the default one, sets the old behavior, i.e. a non-imported hint behaves the same as an imported one. * "Warn" outputs a warning when a non-imported hint is used. Note that this is an over-approximation, because a hint may be triggered by an eauto run that will eventually fail and backtrack. * "Strict" changes the behavior of an unloaded hint to the one of the fail tactic, allowing to emulate the hopefully future import-scoped hint mechanism. - New compatibility flag "Universal Lemma Under Conjunction" which let tactics working under conjunctions apply sublemmas of the form "forall A, ... -> A". - New compatibility flag "Bracketing Last Introduction Pattern" which can be set so that the last disjunctive-conjunctive introduction pattern given to "intros" automatically complete the introduction of its subcomponents, as the the disjunctive-conjunctive introduction patterns in non-terminal position already do. - New flag "Shrink Abstract" that minimalizes proofs generated by the abstract tactical w.r.t. variables appearing in the body of the proof. Program - The "Shrink Obligations" flag now applies to all obligations, not only those solved by the automatic tactic. - Importing Program no longer overrides the "exists" tactic (potential source of incompatibilities). - Hints costs are now correctly taken into account (potential source of incompatibilities). - Documented the Hint Cut command that allows control of the proof search during typeclass resolution (see reference manual). API - Some functions from pretyping/typing.ml and their derivatives were potential source of evarmap leaks, as they dropped their resulting evarmap. The situation was clarified by renaming them according to a ``unsafe_*`` scheme. Their sound variant is likewise renamed to their old name. The following renamings were made. * ``Typing.type_of`` -> ``unsafe_type_of`` * ``Typing.e_type_of`` -> ``type_of`` * A new ``e_type_of`` function that matches the ``e_`` prefix policy * ``Tacmach.pf_type_of`` -> ``pf_unsafe_type_of`` * A new safe ``pf_type_of`` function. All uses of ``unsafe_*`` functions should be eventually eliminated. Tools - Added an option -w to control the output of coqtop warnings. - Configure now takes an optional -native-compiler (yes|no) flag replacing -no-native-compiler. The new flag is set to no by default under Windows. - Flag -no-native-compiler was removed and became the default for coqc. If precompilation of files for native conversion test is desired, use -native-compiler. - The -compile command-line option now takes the full path of the considered file, including the ".v" extension, and outputs a warning if such an extension is lacking. - The -require and -load-vernac-object command-line options now take a logical path of a given library rather than a physical path, thus they behave like Require [Import] path. - The -vm command-line option has been removed. 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 line flags "-require Coq.Compat.Coq84 -compat 8.4". 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 "-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. Specification language - Syntax "$(tactic)$" changed to "ltac:(tactic)". Tactics - Syntax "destruct !hyp" changed to "destruct (hyp)", and similarly for induction (rare source of incompatibilities easily solvable by removing parentheses around "hyp" when not for the purpose of keeping the hypothesis). - Syntax "p/c" for on-the-fly application of a lemma c before introducing along pattern p changed to p%c1..%cn. The feature and syntax are in experimental stage. - "Proof using" does not clear unused section variables. - Tactic "refine" has been changed back to the 8.4 behavior of shelving subgoals that occur in other subgoals. The "refine" tactic of 8.5beta3 has been renamed "simple refine"; it does not shelve any subgoal. - New tactical "unshelve tac" which grab existential variables put on the tactic shelve by the execution of "tac". Details of changes in 8.5pl1 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Critical bugfix - The subterm relation for the guard condition was incorrectly defined on primitive projections (#4588) Plugin development tools - add a .merlin target to the makefile 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. - 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. - Add -compat 8.4 econstructor tactics, and tests - Add compatibility Nonrecursive Elimination Schemes - Fixing the "No applicable tactic" uninformative error message regression on apply. - Univs: fix get_current_context (bug #4603, part I) - Fix a bug in Program coercion code - Fix handling of arity of definitional classes. - #4630: Some tactics are 20x slower in 8.5 than 8.4. - #4627: records with no declared arity can be template polymorphic. - #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. - #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 - Primitive projections: protect kernel from erroneous definitions. - Fixed bug #4533 with previous Keyed Unification commit - Win: kill unreliable hence do not waitpid after kill -9 (Close #4369) - 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. - #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. - 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 - 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. - #4522: Incorrect "Warning..." on windows. - #4373: coqdep does not know about .vio files. - #3826: "Incompatible module types" is uninformative. - #4495: Failed assertion in metasyntax.ml. - #4511: evar tactic can create non-typed evars. - #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 Details of changes in 8.5pl2 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Critical bugfix - Checksums of .vo files dependencies were not correctly checked. - Unicode-to-ASCII translation was not injective, leading in a soundness bug in the native compiler. Other bugfixes - #4097: more efficient occur-check in presence of primitive projections - #4398: type_scope used consistently in "match goal". - #4450: eauto does not work with polymorphic lemmas - #4677: fix alpha-conversion in notations needing eta-expansion. - Fully preserve initial order of hypotheses in "Regular Subst Tactic" mode. - #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". - #4777: printing inefficiency with implicit arguments - #4818: "Admitted" fails due to undefined universe anomaly after calling "destruct" - #4823: remote counter: avoid thread race on sockets - #4841: -verbose flag changed semantics in 8.5, is much harder to use - #4851: [nsatz] cannot handle duplicated hypotheses - #4858: Anomaly: Uncaught exception Failure("hd"). Please report. in variant of nsatz - #4880: [nsatz_compute] generates invalid certificates if given redundant hypotheses - #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 - #4069, #4718: congruence fails when universes are involved. Universes - Disallow silently dropping universe instances applied to variables (forward compatible) - Allow explicit universe instances on notations, when they can apply to the head reference of their expansion. Build infrastructure - New update on how to find camlp5 binary and library at configure time. Details of changes in 8.5pl3 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Critical bugfix - #4876: Guard checker incompleteness when using primitive projections Other bugfixes - #4780: Induction with universe polymorphism on was creating ill-typed terms. - #4673: regression in setoid_rewrite, unfolding let-ins for type unification. - #4754: Regression in setoid_rewrite, allow postponed unification problems to remain. - #4769: Anomaly with universe polymorphic schemes defined inside sections. - #3886: Program: duplicate obligations of mutual fixpoints. - #4994: Documentation typo. - #5008: Use the "md5" command on OpenBSD. - #5007: Do not assume the "TERM" environment variable is always set. - #4606: Output a break before a list only if there was an empty line. - #5001: metas not cleaned properly in clenv_refine_in. - #2336: incorrect glob data for module symbols (bug #2336). - #4832: Remove extraneous dot in error message. - Anomaly in printing a unification error message. - #4947: Options which take string arguments are not backwards compatible. - #4156: micromega cache files are now hidden files. - #4871: interrupting par:abstract kills coqtop. - #5043: [Admitted] lemmas pick up section variables. - Fix name of internal refine ("simple refine"). - #5062: probably a typo in Strict Proofs mode. - #5065: Anomaly: Not a proof by induction. - Restore native compiler optimizations, they were disabled since 8.5! - #5077: failure on typing a fixpoint with evars in its type. - Fix recursive notation bug. - #5095: irrelevant too strict test in let-in abstraction. - Ensuring that the evar name is preserved by "rename". - #4887: confusion between using and with in documentation of firstorder. - Bug in subst with let-ins. - #4762: eauto weaker than auto. - Remove if_then_else (was buggy). Use tryif instead. - #4970: confusion between special "{" and non-special "{{" in notations. - #4529: primitive projections unfolding. - #4416: Incorrect "Error: Incorrect number of goals". - #4863: abstract in typeclass hint fails. - #5123: unshelve can impact typeclass resolution - Fix a collision about the meta-variable ".." in recursive notations. - Fix printing of info_auto. - #3209: Not_found due to an occur-check cycle. - #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. - #4822: Incorrect assertion in cbn. - #3479 parsing of "{" and "}" when a keyword starts with "{" or "}". - #5127: Memory corruption with the VM. - #5102: bullets parsing broken by calls to parse_entry. Various documentation improvements Version 8.4 ----------- Summary of changes ~~~~~~~~~~~~~~~~~~ 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. The new modular library of arithmetic extends, generalizes and unifies the existing libraries on Peano arithmetic (types nat, N and BigN), positive arithmetic (type positive), integer arithmetic (Z and BigZ) and machine word arithmetic (type Int31). It provides with unified notations (e.g. systematic use of add and mul for denoting the addition and multiplication operators), systematic and generic development of operators and properties of these operators for all the types mentioned above, including gcd, pcm, power, square root, base 2 logarithm, division, modulo, bitwise operations, logical shifts, comparisons, iterators, ... The most visible feature of the new proof engine is the support for structured scripts (bullets and proof brackets) but, even if yet not user-available, the new engine also provides the basis for refining existential variables using tactics, for applying tactics to several goals simultaneously, for reordering goals, all features which are planned for the next release. The new proof engine forced Pierre Letouzey to reimplement info and Show Script differently. Before version 8.4, CoqIDE was linked to Coq with the graphical interface living in a separate thread. From version 8.4, CoqIDE is a separate process communicating with Coq through a textual channel. This allows for a more robust interfacing, the ability to interrupt Coq without interrupting the interface, and the ability to manage several 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 and improvements regarding the different components of the system. The underlying logic has been extended with η-conversion thanks to Hugo Herbelin, Stéphane Glondu and Benjamin Grégoire. The addition of η-conversion is justified by the confidence that the formulation of the Calculus of Inductive Constructions based on typed equality (such as the one considered in Lee and Werner to build a set-theoretic model of CIC :cite:`LeeWerner11`) is applicable to the concrete implementation of Coq. The underlying logic benefited also from a refinement of the guard condition for fixpoints by Pierre Boutillier, the point being that it is safe to propagate the information about structurally smaller arguments through β-redexes that are blocked by the “match” construction (blocked commutative cuts). Relying on the added permissiveness of the guard condition, Hugo Herbelin could extend the pattern matching compilation algorithm so that matching over a sequence of terms involving dependencies of a term or of the indices of the type of a term in the type of other terms is systematically supported. Regarding the high-level specification language, Pierre Boutillier introduced the ability to give implicit arguments to anonymous functions, Hugo Herbelin introduced the ability to define notations with several binders (e.g. ``exists x y z, P``), Matthieu Sozeau made the typeclass inference mechanism more robust and predictable, Enrico Tassi introduced a command Arguments that generalizes Implicit Arguments and Arguments Scope for assigning various properties to arguments of constants. Various improvements in the type inference algorithm were provided by Matthieu Sozeau and Hugo Herbelin with contributions from Enrico Tassi. Regarding tactics, Hugo Herbelin introduced support for referring to expressions occurring in the goal by pattern in tactics such as set or destruct. Hugo Herbelin also relied on ideas from Chung-Kil Hur’s Heq plugin to introduce automatic computation of occurrences to generalize when using destruct and induction on types with indices. Stéphane Glondu introduced new tactics :tacn:`constr_eq`, :tacn:`is_evar`, and :tacn:`has_evar`, to be used when writing complex tactics. Enrico Tassi added support to fine-tuning the behavior of :tacn:`simpl`. Enrico Tassi added the ability to specify over which variables of a section a lemma has to be exactly generalized. Pierre Letouzey added a tactic timeout and the interruptibility of :tacn:`vm_compute`. Bug fixes and miscellaneous improvements of the tactic language came from Hugo Herbelin, Pierre Letouzey and Matthieu Sozeau. Regarding decision tactics, Loïc Pottier maintained nsatz, moving in particular to a typeclass based reification of goals while Frédéric Besson maintained Micromega, adding in particular support for division. Regarding commands, Stéphane Glondu provided new commands to analyze the structure of type universes. Regarding libraries, a new library about lists of a given length (called vectors) has been provided by Pierre Boutillier. A new instance of finite sets based on Red-Black trees and provided by Andrew Appel has been adapted for the standard library by Pierre Letouzey. In the library of real analysis, Yves Bertot changed the definition of :math:`\pi` and provided a proof of the long-standing fact yet remaining unproved in this library, namely that :math:`sin \frac{\pi}{2} = 1`. Pierre Corbineau maintained the Mathematical Proof Language (C-zar). Bruno Barras and Benjamin Grégoire maintained the call-by-value reduction machines. The extraction mechanism benefited from several improvements provided by Pierre Letouzey. Pierre Letouzey maintained the module system, with contributions from Élie Soubiran. Julien Forest maintained the Function command. Matthieu Sozeau maintained the setoid rewriting mechanism. 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. The Dp plugin has been removed. Use the plugin provided with Why 3 instead (http://why3.lri.fr/). Under the hood, the Coq architecture benefited from improvements in terms of efficiency and robustness, especially regarding universes management and existential variables management, thanks to Pierre Letouzey and Yann Régis-Gianas with contributions from Stéphane Glondu and Matthias Puech. The build system is maintained by Pierre Letouzey with contributions from Stéphane Glondu and Pierre Boutillier. A new backtracking mechanism simplifying the task of external interfaces has been designed by Pierre Letouzey. The general maintenance was done by Pierre Letouzey, Hugo Herbelin, Pierre Boutillier, Matthieu Sozeau and Stéphane Glondu with also specific contributions from Guillaume Melquiond, Julien Narboux and Pierre-Marie Pédrot. Packaging tools were provided by Pierre Letouzey (Windows), Pierre Boutillier (MacOS), Stéphane Glondu (Debian). Releasing, testing and benchmarking support was provided by Jean-Marc Notin. Many suggestions for improvements were motivated by feedback from users, on either the bug tracker or the Coq-Club mailing list. Special thanks are going to the users who contributed patches, starting with Tom Prince. Other patch contributors include Cédric Auger, David Baelde, Dan Grayson, Paolo Herms, Robbert Krebbers, Marc Lasson, Hendrik Tews and Eelis van der Weegen. | Paris, December 2011 | Hugo Herbelin | Potential sources of incompatibilities ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ The main known incompatibilities between 8.3 and 8.4 are consequences of the following changes: - The reorganization of the library of numbers: Several definitions have new names or are defined in modules of different names, but a special care has been taken to have this renaming transparent for the user thanks to compatibility notations. However some definitions have changed, what might require some adaptations. The most noticeable examples are: + The "?=" notation which now bind to Pos.compare rather than former Pcompare (now Pos.compare_cont). + Changes in names may induce different automatically generated names in proof scripts (e.g. when issuing "destruct Z_le_gt_dec"). + Z.add has a new definition, hence, applying "simpl" on subterms of its body might give different results than before. + BigN.shiftl and BigN.shiftr have reversed arguments order, the power function in BigN now takes two BigN. - Other changes in libraries: + The definition of functions over "vectors" (list of fixed length) have changed. + TheoryList.v has been removed. - Slight changes in tactics: + Less unfolding of fixpoints when applying destruct or inversion on a fixpoint hiding an inductive type (add an extra call to simpl to preserve compatibility). + Less unexpected local definitions when applying "destruct" (incompatibilities solvable by adapting name hypotheses). + Tactic "apply" might succeed more often, e.g. by now solving pattern-matching of the form ?f x y = g(x,y) (compatibility ensured by using "Unset Tactic Pattern Unification"), but also because it supports (full) betaiota (using "simple apply" might then help). + Tactic autorewrite does no longer instantiate pre-existing existential variables. + Tactic "info" is now available only for auto, eauto and trivial. - Miscellaneous changes: + The command "Load" is now atomic for backtracking (use "Unset Atomic Load" for compatibility). Details of changes in 8.4beta ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Logic - Standard eta-conversion now supported (dependent product only). - Guard condition improvement: subterm property is propagated through beta-redex blocked by pattern-matching, as in "(match v with C .. => fun x => u end) x"; this allows for instance to use "rewrite ... in ..." without breaking the guard condition. Specification language and notations - Maximal implicit arguments can now be set locally by { }. The registration traverses fixpoints and lambdas. Because there is conversion in types, maximal implicit arguments are not taken into account in partial applications (use eta expanded form with explicit { } instead). - Added support for recursive notations with binders (allows for instance to write "exists x y z, P"). - Structure/Record printing can be disable by "Unset Printing Records". In addition, it can be controlled on type by type basis using "Add Printing Record" or "Add Printing Constructor". - Pattern-matching compilation algorithm: in "match x, y with ... end", possible dependencies of x (or of the indices of its type) in the type of y are now taken into account. Tactics - New proof engine. - Scripts can now be structured thanks to bullets - * + and to subgoal delimitation via { }. Note: for use with Proof General, a cvs version of Proof General no older than mid-July 2011 is currently required. - Support for tactical "info" is suspended. - Support for command "Show Script" is suspended. - New tactics constr_eq, is_evar and has_evar for use in Ltac (DOC TODO). - Removed the two-argument variant of "decide equality". - New experimental tactical "timeout ". Since is a time in second for the moment, this feature should rather be avoided in scripts meant to be machine-independent. - Fix in "destruct": removal of unexpected local definitions in context might result in some rare incompatibilities (solvable by adapting name hypotheses). - Introduction pattern "_" made more robust. - Tactic (and Eval command) vm_compute can now be interrupted via Ctrl-C. - Unification in "apply" supports unification of patterns of the form ?f x y = g(x,y) (compatibility ensured by using "Unset Tactic Pattern Unification"). It also supports (full) betaiota. - Tactic autorewrite does no longer instantiate pre-existing existential variables (theoretical source of possible incompatibilities). - Tactic "dependent rewrite" now supports equality in "sig". - Tactic omega now understands Zpred (wish #1912) and can prove any goal from a context containing an arithmetical contradiction (wish #2236). - Using "auto with nocore" disables the use of the "core" database (wish #2188). This pseudo-database "nocore" can also be used with trivial and eauto. - Tactics "set", "destruct" and "induction" accepts incomplete terms and use the goal to complete the pattern assuming it is unambiguous. - When used on arguments with a dependent type, tactics such as "destruct", "induction", "case", "elim", etc. now try to abstract automatically the dependencies over the arguments of the types (based on initial ideas from Chung-Kil Hur, extension to nested dependencies suggested by Dan Grayson) - Tactic "injection" now failing on an equality showing no constructors while it was formerly generalizing again the goal over the given equality. - In Ltac, the "context [...]" syntax has now a variant "appcontext [...]" allowing to match partial applications in larger applications. - When applying destruct or inversion on a fixpoint hiding an inductive type, recursive calls to the fixpoint now remain folded by default (rare source of incompatibility generally solvable by adding a call to simpl). - In an ltac pattern containing a "match", a final "| _ => _" branch could be used now instead of enumerating all remaining constructors. Moreover, the pattern "match _ with _ => _ end" now allows to match any "match". A "in" annotation can also be added to restrict to a precise inductive type. - The behavior of "simpl" can be tuned using the "Arguments" vernacular. In particular constants can be marked so that they are always/never unfolded by "simpl", or unfolded only when a set of arguments evaluates to a constructor. Last one can mark a constant so that it is unfolded only if the simplified term does not expose a match in head position. Commands - It is now mandatory to have a space (or tabulation or newline or end-of-file) after a "." ending a sentence. - In SearchAbout, the [ ] delimiters are now optional. - New command "Add/Remove Search Blacklist ...": a Search or SearchAbout or similar query will never mention lemmas whose qualified names contain any of the declared substrings. The default blacklisted substrings are ``_subproof``, ``Private_``. - When the output file of "Print Universes" ends in ".dot" or ".gv", the universe graph is printed in the DOT language, and can be processed by Graphviz tools. - New command "Print Sorted Universes". - The undocumented and obsolete option "Set/Unset Boxed Definitions" has been removed, as well as syntaxes like "Boxed Fixpoint foo". - A new option "Set Default Timeout n / Unset Default Timeout". - Qed now uses information from the reduction tactics used in proof script to avoid conversion at Qed time to go into a very long computation. - New command "Show Goal ident" to display the statement of a goal, even a closed one (available from Proof General). - Command "Proof" accept a new modifier "using" to force generalization over a given list of section variables at section ending (DOC TODO). - New command "Arguments" generalizing "Implicit Arguments" and "Arguments Scope" and that also allows to rename the parameters of a definition and to tune the behavior of the tactic "simpl". Module System - During subtyping checks, an opaque constant in a module type could now be implemented by anything of the right type, even if bodies differ. Said otherwise, with respect to subtyping, an opaque constant behaves just as a parameter. Coqchk was already implementing this, but not coqtop. - The inlining done during application of functors can now be controlled more precisely, by the annotations (no inline) or (inline at level XX). With the latter annotation, only functor parameters whose levels are lower or equal than XX will be inlined. The level of a parameter can be fixed by "Parameter Inline(30) foo". When levels aren't given, the default value is 100. One can also use the flag "Set Inline Level ..." to set a level (DOC TODO). - Print Assumptions should now handle correctly opaque modules (#2168). - Print Module (Type) now tries to print more details, such as types and bodies of the module elements. Note that Print Module Type could be used on a module to display only its interface. The option "Set Short Module Printing" could be used to switch back to the earlier behavior were only field names were displayed. Libraries - Extension of the abstract part of Numbers, which now provide axiomatizations and results about many more integer functions, such as pow, gcd, lcm, sqrt, log2 and bitwise functions. These functions are implemented for nat, N, BigN, Z, BigZ. See in particular file NPeano for new functions about nat. - The definition of types positive, N, Z is now in file BinNums.v - Major reorganization of ZArith. The initial file ZArith/BinInt.v now contains an internal module Z implementing the Numbers interface for integers. This module Z regroups: * all functions over type Z : Z.add, Z.mul, ... * the minimal proofs of specifications for these functions : Z.add_0_l, ... * an instantiation of all derived properties proved generically in Numbers : Z.add_comm, Z.add_assoc, ... A large part of ZArith is now simply compatibility notations, for instance Zplus_comm is an alias for Z.add_comm. The direct use of module Z is now recommended instead of relying on these compatibility notations. - Similar major reorganization of NArith, via a module N in NArith/BinNat.v - Concerning the positive datatype, BinPos.v is now in a specific directory PArith, and contains an internal submodule Pos. We regroup there functions such as Pos.add Pos.mul etc as well as many results about them. These results are here proved directly (no Number interface for strictly positive numbers). - Note that in spite of the compatibility layers, all these reorganizations may induce some marginal incompatibilies in scripts. In particular: * the "?=" notation for positive now refers to a binary function Pos.compare, instead of the infamous ternary Pcompare (now Pos.compare_cont). * some hypothesis names generated by the system may changed (typically for a "destruct Z_le_gt_dec") since naming is done after the short name of the head predicate (here now "le" in module Z instead of "Zle", etc). * the internals of Z.add has changed, now relying of Z.pos_sub. - Also note these new notations: * "= XP SP1. - 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 "Backtrack" command similarly to Proof General. - 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 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, $XDG_DATA_DIRS/coq, and user-contribs before the standard library. - Coq rc file has moved to $XDG_CONFIG_HOME/coq. - Major changes to coq_makefile: * mli/mlpack/mllib taken into account, ml not preproccessed anymore, ml4 work; * mlihtml generates doc of mli, install-doc install the html doc in DOCDIR with the same policy as vo in COQLIB; * More variables are given by coqtop -config, others are defined only if the users doesn't have defined them elsewhere. Consequently, generated makefile should work directly on any architecture; * Packagers can take advantage of $(DSTROOT) introduction. Installation can be made in $XDG_DATA_HOME/coq; * -arg option allows to send option as argument to coqc. Details of changes in 8.4beta2 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Commands - Commands "Back" and "BackTo" are now handling the proof states. They may perform some extra steps of backtrack to avoid states where the proof state is unavailable (typically a closed proof). - The commands "Suspend" and "Resume" have been removed. - A basic Show Script has been reintroduced (no indentation). - New command "Set Parsing Explicit" for deactivating parsing (and printing) of implicit arguments (useful for teaching). - New command "Grab Existential Variables" to transform the unresolved evars at the end of a proof into goals. Tactics - Still no general "info" tactical, but new specific tactics info_auto, info_eauto, info_trivial which provides information on the proofs found by auto/eauto/trivial. Display of these details could also be activated by "Set Info Auto"/"Set Info Eauto"/"Set Info Trivial". - Details on everything tried by auto/eauto/trivial during a proof search could be obtained by "debug auto", "debug eauto", "debug trivial" or by a global "Set Debug Auto"/"Set Debug Eauto"/"Set Debug Trivial". - New command "r string" in Ltac debugger that interprets "idtac string" in Ltac code as a breakpoint and jumps to its next use. - Tactics from the Dp plugin (simplify, ergo, yices, cvc3, z3, cvcl, harvey, zenon, gwhy) have been removed, since Why2 has not been maintained for the last few years. The Why3 plugin should be a suitable replacement in most cases. Libraries - MSetRBT: a new implementation of MSets via Red-Black trees (initial contribution by Andrew Appel). - MSetAVL: for maximal sharing with the new MSetRBT, the argument order of Node has changed (this should be transparent to regular MSets users). Module System - The names of modules (and module types) are now in a fully separated namespace from ordinary definitions: "Definition E:=0. Module E. End E." is now accepted. CoqIDE - CoqIDE now supports the "Restart" command, and "Undo" (with a warning). Better support for "Abort". Details of changes in 8.4 ~~~~~~~~~~~~~~~~~~~~~~~~~ Commands - The "Reset" command is now supported again in files given to coqc or Load. - "Show Script" now indents again the displayed scripts. It can also work correctly across Load'ed files if the option "Unset Atomic Load" is used. - "Open Scope" can now be given the delimiter (e.g. Z) instead of the full scope name (e.g. Z_scope). 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". These notations behave as (only parsing) notations, except that they may 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. - For a strict mode without these compatibility notations, use "Unset Compat Notations" or the command-line flag -no-compat-notations. Tactics - An annotation "eqn:H" or "eqn:?" can be added to a "destruct" or "induction" to make it generate equations in the spirit of "case_eq". The former syntax "_eqn" is discontinued. - The name of the hypothesis introduced by tactic "remember" can be set via the new syntax "remember t as x eqn:H" (wish #2489). Libraries - Reals: changed definition of PI, no more axiom about sin(PI/2). - SetoidPermutation: a notion of permutation for lists modulo a setoid equality. - BigN: fixed the ocaml code doing the parsing/printing of big numbers. - List: a couple of lemmas added especially about no-duplication, partitions. - Init: Removal of the coercions between variants of sigma-types and subset types (possible source of incompatibility). Version 8.3 ----------- Summary of changes ~~~~~~~~~~~~~~~~~~ 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. With respect to libraries, the main evolutions are due to Pierre Letouzey with a rewriting of the library of finite sets FSets and a new round of evolutions in the modular development of arithmetic (library Numbers). The reason for making FSets evolve is that the computational and logical contents were quite intertwined in the original implementation, leading in some cases to longer computations than expected and this problem is solved in the new MSets implementation. As for the modular arithmetic library, it was only dealing with the basic arithmetic operators in the former version and its current extension adds the standard theory of the division, min and max functions, all made available for free to any implementation of :math:`\mathbb{N}`, :math:`\mathbb{Z}` or :math:`\mathbb{Z}/n\mathbb{Z}`. The main other evolutions of the library are due to Hugo Herbelin who made a revision of the sorting library (including a certified merge-sort) and to Guillaume Melquiond who slightly revised and cleaned up the library of reals. The module system evolved significantly. Besides the resolution of some efficiency issues and a more flexible construction of module types, Élie Soubiran brought a new model of name equivalence, the :math:`\Delta`-equivalence, which respects as much as possible the names given by the users. He also designed with Pierre Letouzey a new, convenient operator ``<+`` for nesting functor application that provides a light notation for inheriting the properties of cascading modules. The new tactic nsatz is due to Loïc Pottier. It works by computing Gröbner bases. Regarding the existing tactics, various improvements have been done by Matthieu Sozeau, Hugo Herbelin and Pierre Letouzey. Matthieu Sozeau extended and refined the 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 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. Pierre Courtieu maintained the support for the Proof General Emacs interface. Claude Marché maintained the plugin for calling external provers (dp). Yves Bertot made some improvements to the libraries of lists and integers. Matthias Puech improved the search functions. Guillaume Melquiond usefully contributed here and there. Yann Régis-Gianas grounded the support for Unicode on a more standard and more robust basis. Though invisible from outside, Arnaud Spiwack improved the general process of management of existential variables. Pierre Letouzey and Stéphane Glondu improved the compilation scheme of the Coq archive. Vincent Gross provided support to CoqIDE. Jean-Marc Notin provided support for benchmarking and archiving. Many users helped by reporting problems, providing patches, suggesting improvements or making useful comments, either on the bug tracker or on the Coq-Club mailing list. This includes but not exhaustively Cédric Auger, Arthur Charguéraud, François Garillot, Georges Gonthier, Robin Green, Stéphane Lescuyer, Eelis van der Weegen, ... Though not directly related to the implementation, special thanks are going to Yves Bertot, Pierre Castéran, Adam Chlipala, and Benjamin Pierce for the excellent teaching materials they provided. | Paris, April 2010 | Hugo Herbelin | Details of changes ~~~~~~~~~~~~~~~~~~ Rewriting tactics - Tactic "rewrite" now supports rewriting on ad hoc equalities such as eq_true. - "Hint Rewrite" now checks that the lemma looks like an equation. - New tactic "etransitivity". - Support for heterogeneous equality (JMeq) in "injection" and "discriminate". - Tactic "subst" now supports heterogeneous equality and equality proofs that are dependent (use "simple subst" for preserving compatibility). - Added support for Leibniz-rewriting of dependent hypotheses. - Renamed "Morphism" into "Proper" and "respect" into "proper_prf" (possible source of incompatibility). A partial fix is to define "Notation Morphism R f := (Proper (R%signature) f)." - New tactic variants "rewrite* by" and "autorewrite*" that rewrite respectively the first and all matches whose side-conditions are solved. - "Require Import Setoid" does not export all of "Morphisms" and "RelationClasses" anymore (possible source of incompatibility, fixed by importing "Morphisms" too). - Support added for using Chung-Kil Hur's Heq library for rewriting over heterogeneous equality (courtesy of the library's author). - Tactic "replace" supports matching terms with holes. Automation tactics - Tactic ``intuition`` now preserves inner ``iff`` and ``not`` (exceptional source of incompatibilities solvable by redefining ``intuition`` as ``unfold iff, not in *; intuition``, or, for iff only, by using ``Set Intuition Iff Unfolding``.) - Tactic ``tauto`` now proves classical tautologies as soon as classical logic (i.e. library ``Classical_Prop`` or ``Classical``) is loaded. - Tactic ``gappa`` has been removed from the Dp plugin. - Tactic ``firstorder`` now supports the combination of its ``using`` and ``with`` options. - New ``Hint Resolve ->`` (or ``<-``) for declaring iff's as oriented hints (wish #2104). - An inductive type as argument of the ``using`` option of ``auto`` / ``eauto`` / ``firstorder`` is interpreted as using the collection of its constructors. - New decision tactic "nsatz" to prove polynomial equations by computation of Groebner bases. Other tactics - Tactic "discriminate" now performs intros before trying to discriminate an hypothesis of the goal (previously it applied intro only if the goal had the form t1<>t2) (exceptional source of incompatibilities - former behavior can be obtained by "Unset Discriminate Introduction"). - Tactic "quote" now supports quotation of arbitrary terms (not just the goal). - Tactic "idtac" now displays its "list" arguments. - New introduction patterns "*" for introducing the next block of dependent variables and "**" for introducing all quantified variables and hypotheses. - Pattern Unification for existential variables activated in tactics and new option "Unset Tactic Evars Pattern Unification" to deactivate it. - Resolution of canonical structure is now part of the tactic's unification algorithm. - New tactic "decide lemma with hyp" for rewriting decidability lemmas when one knows which side is true. - Improved support of dependent goals over objects in dependent types for "destruct" (rare source of incompatibility that can be avoided by unsetting option "Dependent Propositions Elimination"). - Tactic "exists", "eexists", "destruct" and "edestruct" supports iteration using comma-separated arguments. - Tactic names "case" and "elim" now support clauses "as" and "in" and become then synonymous of "destruct" and "induction" respectively. - A new tactic name "exfalso" for the use of 'ex-falso quodlibet' principle. This tactic is simply a shortcut for "elimtype False". - Made quantified hypotheses get the name they would have if introduced in the context (possible but rare source of incompatibilities). - When applying a component of a conjunctive lemma, "apply in" (and sequences of "apply in") now leave the side conditions of the lemmas uniformly after the main goal (possible source of rare incompatibilities). - In "simpl c" and "change c with d", c can be a pattern. - Tactic "revert" now preserves let-in's making it the exact inverse of "intro". - New tactics "clear dependent H" and "revert dependent H" that clears (resp. reverts) H and all the hypotheses that depend on H. - Ltac's pattern-matching now supports matching metavariables that depend on variables bound upwards in the pattern. Tactic definitions - Ltac definitions support Local option for non-export outside modules. - Support for parsing non-empty lists with separators in tactic notations. - New command "Locate Ltac" to get the full name of an Ltac definition. Notations - Record syntax ``{|x=...; y=...|}`` now works inside patterns too. - Abbreviations from non-imported module now invisible at printing time. - Abbreviations now use implicit arguments and arguments scopes for printing. - Abbreviations to pure names now strictly behave like the name they refer to (make redirections of qualified names easier). - Abbreviations for applied constant now propagate the implicit arguments and arguments scope of the underlying reference (possible source of incompatibilities generally solvable by changing such abbreviations from e.g. ``Notation foo' := (foo x)`` to ``Notation foo' y := (foo x (y:=y))``). - The "where" clause now supports multiple notations per defined object. - Recursive notations automatically expand one step on the left for better factorization; recursion notations inner separators now ensured being tokens. - Added "Reserved Infix" as a specific shortcut of the corresponding "Reserved Notation". - Open/Close Scope command supports Global option in sections. Specification language - New support for local binders in the syntax of Record/Structure fields. - Fixpoint/CoFixpoint now support building part or all of bodies using tactics. - Binders given before ":" in lemmas and in definitions built by tactics are now automatically introduced (possible source of incompatibility that can be resolved by invoking "Unset Automatic Introduction"). - New support for multiple implicit arguments signatures per reference. Module system - Include Type is now deprecated since Include now accepts both modules and module types. - Declare ML Module supports Local option. - The sharing between non-logical object and the management of the name-space has been improved by the new "Delta-equivalence" on qualified name. - The include operator has been extended to high-order structures - Sequences of Include can be abbreviated via new syntax "<+". - A module (or module type) can be given several "<:" signatures. - Interactive proofs are now permitted in module type. Functors can hence be declared as Module Type and be used later to type themselves. - A functor application can be prefixed by a "!" to make it ignore any "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). Extraction - When using (Recursive) Extraction Library, the filenames are directly the 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 of functions body are now avoided, clever partial applications will likely be preserved, let-ins are almost always kept, etc. - In the same spirit, auto-inlining is now disabled by default, except for induction principles, since this feature was producing more frequently weird code than clear gain. The previous behavior can be restored via "Set Extraction AutoInline". - Unicode characters in identifiers are now transformed into ascii strings that are legal in Ocaml and other languages. - Harsh support of module extraction to Haskell and Scheme: module hierarchy is flattened, module abbreviations and functor applications are expanded, module types and unapplied functors are discarded. - Less unsupported situations when extracting modules to Ocaml. In particular module parameters might be alpha-renamed if a name clash is detected. - Extract Inductive is now possible toward non-inductive types (e.g. nat => int) - Extraction Implicit: this new experimental command allows to mark some arguments of a function or constructor for removed during extraction, even if these arguments don't fit the usual elimination principles of extraction, for instance the length n of a vector. - Files ExtrOcaml*.v in plugins/extraction try to provide a library of common extraction commands: mapping of basics types toward Ocaml's counterparts, conversions from/to int and big_int, or even complete mapping of nat,Z,N to int or big_int, or mapping of ascii to char and string to char list (in this case recognition of ascii constants is hard-wired in the extraction). Program - Streamlined definitions using well-founded recursion and measures so that they can work on any subset of the arguments directly (uses currying). - Try to automatically clear structural fixpoint prototypes in obligations to avoid issues with opacity. - Use return type clause inference in pattern-matching as in the standard typing algorithm. - Support [Local Obligation Tactic] and [Next Obligation with tactic]. - Use [Show Obligation Tactic] to print the current default tactic. - [fst] and [snd] have maximal implicit arguments in Program now (possible source of incompatibility). Type classes - Declaring axiomatic type class instances in Module Type should be now done via new command "Declare Instance", while the syntax "Instance" now always provides a concrete instance, both in and out of Module Type. - Use [Existing Class foo] to declare a preexisting object [foo] as a class. [foo] can be an inductive type or a constant definition. No projections or instances are defined. - Various bug fixes and improvements: support for defined fields, anonymous instances, declarations giving terms, better handling of sections and [Context]. Commands - New command "Timeout ." interprets a command and a timeout interrupts the execution after seconds. - New command "Compute ." is a shortcut for "Eval vm_compute in ". - New command "Fail ." interprets a command and is successful iff the command fails on an error (but not an anomaly). Handy for tests and illustration of wrong commands. - Most commands referring to constant (e.g. Print or About) now support referring to the constant by a notation string. - New option "Boolean Equality Schemes" to make generation of boolean equality automatic for datatypes (together with option "Decidable Equality Schemes", this replaces deprecated option "Equality Scheme"). - Made support for automatic generation of case analysis schemes available to user (governed by option "Set Case Analysis Schemes"). - New command :n:`{? Global } Generalizable {| All | No } {| Variable | Variables } {* @ident}` to declare which identifiers are generalizable in `` `{} `` and `` `() `` binders. - New command "Print Opaque Dependencies" to display opaque constants in addition to all variables, parameters or axioms a theorem or definition relies on. - New command "Declare Reduction := ", allowing to write later "Eval in ...". This command accepts a Local variant. - Syntax of Implicit Type now supports more than one block of variables of a given type. - Command "Canonical Structure" now warns when it has no effects. - Commands of the form "Set X" or "Unset X" now support "Local" and "Global" prefixes. Library - 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, instead of relying on lt_eq_lt_dec. The earlier version is still available under the name nat_compare_alt. - Lemmas in library Relations and Reals have been homogenized a bit. - The implicit argument of Logic.eq is now maximally inserted, allowing to simply write "eq" instead of "@eq _" in morphism signatures. - Wrongly named lemmas (Zlt_gt_succ and Zlt_succ_gt) fixed (potential source of incompatibilities) - List library: + Definitions of list, length and app are now in Init/Datatypes. Support for compatibility is provided. + Definition of Permutation is now in Sorting/Permtation.v + Some other light revisions and extensions (possible source of incompatibilities solvable by qualifying names accordingly). - In ListSet, set_map has been fixed (source of incompatibilities if used). - Sorting library: + new mergesort of worst-case complexity O(n*ln(n)) made available in Mergesort.v; + former notion of permutation up to setoid from Permutation.v is deprecated and moved to PermutSetoid.v; + heapsort from Heap.v of worst-case complexity O(n*n) is deprecated; + new file Sorted.v for some definitions of being sorted. - Structure library. This new library is meant to contain generic structures such as types with equalities or orders, either in Module version (for now) or Type Classes (still to do): + DecidableType.v and OrderedType.v: initial notions for FSets/FMaps, left for compatibility but considered as deprecated. + Equalities.v and Orders.v: evolutions of the previous files, with fine-grain Module architecture, many variants, use of Equivalence and other relevant Type Classes notions. + OrdersTac.v: a generic tactic for solving chains of (in)equalities over variables. See {Nat,N,Z,P}OrderedType.v for concrete instances. + GenericMinMax.v: any ordered type can be equipped with min and max. We derived here all the generic properties of these functions. - 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: + The use of Equivalence, Proper and other Type Classes features easing the handling of setoid equalities. + The interfaces are now stated in iff-style. Old specifications are now derived properties. + The compare functions are now pure, and return a "comparison" value. Thanks to the CompSpec inductive type, reasoning on them remains easy. + Sets structures requiring invariants (i.e. sorted lists) are built first as "Raw" sets (pure objects and separate proofs) and attached with their proofs thanks to a generic functor. "Raw" sets have now a proper interface and can be manipulated directly. 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. - Numbers library: + The abstract layer (NatInt, Natural/Abstract, Integer/Abstract) has been simplified and enhance thanks to new features of the module system such as Include (see above). It has been extended to Euclidean division (three flavors for integers: Trunc, Floor and Math). + The arbitrary-large efficient numbers (BigN, BigZ, BigQ) has also been reworked. They benefit from the abstract layer improvements (especially for div and mod). Note that some specifications have slightly changed (compare, div, mod, shift{r,l}). Ring/Field should work better (true recognition of constants). Tools - 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). Coqdoc - List have been revamped. List depth and scope is now determined by an "offside" whitespace rule. - Text may be italicized by placing it in _underscores_. - The "--index " flag changes the filename of the index. - The "--toc-depth " flag limits the depth of headers which are included in the table of contents. - The "--lib-name " flag prints " Foo" instead of "Library Foo" where library titles are called for. The "--no-lib-name" flag eliminates the extra title. - 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 using the available globalization information. - New option "--external url root" to refer to external libraries. - Links to section variables and notations now supported. Internal infrastructure - To avoid confusion with the repository of user's contributions, the subdirectory "contrib" has been renamed into "plugins". On platforms supporting ocaml native dynlink, code located there is built as loadable plugins for coqtop. - 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 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 of .mllib files for building .cma/.cmxa. The .vo files to compile are now listed in several vo.itarget files. Version 8.2 ----------- Summary of changes ~~~~~~~~~~~~~~~~~~ Coq version 8.2 adds new features, new libraries and improves on many various aspects. Regarding the language of Coq, the main novelty is the introduction by Matthieu Sozeau of a package of commands providing Haskell-style typeclasses. Typeclasses, which come with a few convenient features such as type-based resolution of implicit arguments, play a new landmark role in the architecture of Coq with respect to automation. For instance, thanks to typeclass support, Matthieu Sozeau could implement a new resolution-based version of the tactics dedicated to rewriting on arbitrary transitive relations. Another major improvement of Coq 8.2 is the evolution of the arithmetic libraries and of the tools associated with them. Benjamin Grégoire and Laurent Théry contributed a modular library for building arbitrarily large integers from bounded integers while Evgeny Makarov contributed a modular library of abstract natural and integer arithmetic together with a few convenient tactics. On his side, Pierre Letouzey made numerous extensions to the arithmetic libraries on :math:`\mathbb{Z}` and :math:`\mathbb{Q}`, including extra support for automation in presence of various number-theory concepts. Frédéric Besson contributed a reflective tactic based on Krivine-Stengle Positivstellensatz (the easy way) for validating provability of systems of inequalities. The platform is flexible enough to support the validation of any algorithm able to produce a “certificate” for the Positivstellensatz and this covers the case of Fourier-Motzkin (for linear systems in :math:`\mathbb{Q}` and :math:`\mathbb{R}`), Fourier-Motzkin with cutting planes (for linear systems in :math:`\mathbb{Z}`) and sum-of-squares (for non-linear systems). Evgeny Makarov made the platform generic over arbitrary ordered rings. Arnaud Spiwack developed a library of 31-bits machine integers and, relying on Benjamin Grégoire and Laurent Théry’s library, delivered a library of unbounded integers in base :math:`2^{31}`. As importantly, he developed a notion of “retro-knowledge” so as to safely extend the kernel-located bytecode-based efficient evaluation algorithm of Coq version 8.1 to use 31-bits machine arithmetic for efficiently computing with the library of integers he developed. Beside the libraries, various improvements were contributed to provide a more comfortable end-user language and more expressive tactic language. Hugo Herbelin and Matthieu Sozeau improved the pattern matching compilation algorithm (detection of impossible clauses in pattern matching, automatic inference of the return type). Hugo Herbelin, Pierre Letouzey and Matthieu Sozeau contributed various new convenient syntactic constructs and new tactics or tactic features: more inference of redundant information, better unification, better support for proof or definition by fixpoint, more expressive rewriting tactics, better support for meta-variables, more convenient notations... Élie Soubiran improved the module system, adding new features (such as an “include” command) and making it more flexible and more general. He and Pierre Letouzey improved the support for modules in the extraction mechanism. Matthieu Sozeau extended the Russell language, ending in an convenient way to write programs of given specifications, Pierre Corbineau extended the Mathematical Proof Language and the automation tools that accompany it, Pierre Letouzey supervised and extended various parts of the standard library, Stéphane Glondu contributed a few tactics and improvements, Jean-Marc Notin provided help in debugging, general maintenance and coqdoc support, Vincent Siles contributed extensions of the Scheme command and of injection. Bruno Barras implemented the ``coqchk`` tool: this is a stand-alone type checker that can be used to certify .vo files. Especially, as this verifier runs in a separate process, it is granted not to be “hijacked” by virtually malicious extensions added to Coq. Yves Bertot, Jean-Christophe Filliâtre, Pierre Courtieu and Julien Forest acted as maintainers of features they implemented in previous versions of Coq. Julien Narboux contributed to CoqIDE. Nicolas Tabareau made the adaptation of the interface of the old “setoid rewrite” tactic to the new version. Lionel Mamane worked on the interaction between Coq and its external interfaces. With Samuel Mimram, he also helped making Coq compatible with recent software tools. Russell O’Connor, Cezary Kaliszyk, Milad Niqui contributed to improve the libraries of integers, rational, and real numbers. We also thank many users and partners for suggestions and feedback, in particular Pierre Castéran and Arthur Charguéraud, the INRIA Marelle team, Georges Gonthier and the INRIA-Microsoft Mathematical Components team, the Foundations group at Radboud university in Nijmegen, reporters of bugs and participants to the Coq-Club mailing list. | Palaiseau, June 2008 | Hugo Herbelin | Details of changes ~~~~~~~~~~~~~~~~~~ Language - If a fixpoint is not written with an explicit { struct ... }, then all arguments are tried successively (from left to right) until one is found that satisfies the structural decreasing condition. - New experimental typeclass system giving ad-hoc polymorphism and overloading based on dependent records and implicit arguments. - New syntax "let 'pat := b in c" for let-binding using irrefutable patterns. - New syntax "forall {A}, T" for specifying maximally inserted implicit arguments in terms. - Sort of Record/Structure, Inductive and CoInductive defaults to Type if omitted. - (Co)Inductive types can be defined as records (e.g. "CoInductive stream := { hd : nat; tl : stream }.") - New syntax "Theorem id1:t1 ... with idn:tn" for proving mutually dependent statements. - Support for sort-polymorphism on constants denoting inductive types. - Several evolutions of the module system (handling of module aliases, functorial module types, an Include feature, etc). - Prop now a subtype of Set (predicative and impredicative forms). - Recursive inductive types in Prop with a single constructor of which all arguments are in Prop is now considered to be a singleton type. It consequently supports all eliminations to Prop, Set and Type. As a consequence, Acc_rect has now a more direct proof [possible source of easily fixed incompatibility in case of manual definition of a recursor in a recursive singleton inductive type]. Commands - Added option Global to "Arguments Scope" for section surviving. - Added option "Unset Elimination Schemes" to deactivate the automatic generation of elimination schemes. - Modification of the Scheme command so you can ask for the name to be automatically computed (e.g. Scheme Induction for nat Sort Set). - New command "Combined Scheme" to build combined mutual induction principles from existing mutual induction principles. - New command "Scheme Equality" to build a decidable (boolean) equality for simple inductive datatypes and a decision property over this equality (e.g. Scheme Equality for nat). - Added option "Set Equality Scheme" to make automatic the declaration of the boolean equality when possible. - Source of universe inconsistencies now printed when option "Set Printing Universes" is activated. - New option "Set Printing Existential Instances" for making the display of existential variable instances explicit. - Support for option "[id1 ... idn]", and "-[id1 ... idn]", for the "compute"/"cbv" reduction strategy, respectively meaning reduce only, or everything but, the constants id1 ... idn. "lazy" alone or followed by "[id1 ... idn]", and "-[id1 ... idn]" also supported, meaning apply all of beta-iota-zeta-delta, possibly restricting delta. - New command "Strategy" to control the expansion of constants during conversion tests. It generalizes commands Opaque and Transparent by introducing a range of levels. Lower levels are assigned to constants that should be expanded first. - New options Global and Local to Opaque and Transparent. - New command "Print Assumptions" to display all variables, parameters or axioms a theorem or definition relies on. - "Add Rec LoadPath" now provides references to libraries using partially 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 compiled in native code with a version of OCaml that supports native Dynlink (>= 3.11). - Specific sort constraints on Record now taken into account. - "Print LoadPath" supports a path argument to filter the display. Libraries - Several parts of the libraries are now in Type, in particular FSets, SetoidList, ListSet, Sorting, Zmisc. This may induce a few incompatibilities. In case of trouble while fixing existing development, it may help to simply declare Set as an alias for Type (see file SetIsType). - New arithmetical library in theories/Numbers. It contains: * an abstract modular development of natural and integer arithmetics in Numbers/Natural/Abstract and Numbers/Integer/Abstract * an implementation of efficient computational bounded and unbounded integers that can be mapped to processor native arithmetics. See Numbers/Cyclic/Int31 for 31-bit integers and Numbers/Natural/BigN for unbounded natural numbers and Numbers/Integer/BigZ for unbounded integers. * some proofs that both older libraries Arith, ZArith and NArith and newer BigN and BigZ implement the abstract modular development. This allows in particular BigN and BigZ to already come with a large database of basic lemmas and some generic tactics (ring), This library has still an experimental status, as well as the processor-acceleration mechanism, but both its abstract and its concrete parts are already quite usable and could challenge the use of nat, N and Z in actual developments. Moreover, an extension of this framework to rational numbers is ongoing, and an efficient Q structure is already provided (see Numbers/Rational/BigQ), but this part is currently incomplete (no abstract layer and generic lemmas). - Many changes in FSets/FMaps. In practice, compatibility with earlier 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 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 "eq_dec" has been added to OrderedType. The old version of OrderedType is now called MiniOrderedType and functor MOT_to_OT allow to convert to the new version. The interfaces and implementations of sets now contain also such a "eq_dec" field. * FSetDecide, contributed by Aaron Bohannon, contains a decision procedure allowing to solve basic set-related goals (for instance, is a point in a particular set ?). See FSetProperties for examples. * Functors of properties have been improved, especially the ones about maps, that now propose some induction principles. Some properties of fold need less hypothesis. * More uniformity in implementations of sets and maps: they all use implicit arguments, and no longer export unnecessary scopes (see bug #1347) * Internal parts of the implementations based on AVL have evolved a lot. The main files FSetAVL and FMapAVL are now much more lightweight now. In particular, minor changes in some functions has allowed to fully separate the proofs of operational correctness from the proofs of well-balancing: well-balancing is critical for efficiency, but not anymore for proving that these trees implement our interfaces, hence we have moved these proofs into appendix files FSetFullAVL and FMapFullAVL. Moreover, a few functions like union and compare have been modified in order to be structural yet efficient. The appendix files also contains alternative versions of these few functions, much closer to the 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 - Better computational behavior of some constants (eq_nat_dec and le_lt_dec more efficient, Z_lt_le_dec and Positive_as_OT.compare transparent, ...) (exceptional source of incompatibilities). - Boolean operators moved from module Bool to module Datatypes (may need to rename qualified references in script and force notations || and && to be at levels 50 and 40 respectively). - The constructors xI and xO of type positive now have postfix notations "~1" and "~0", allowing to write numbers in binary form easily, for instance 6 is 1~1~0 and 4*p is p~0~0 (see BinPos.v). - Improvements to NArith (Nminus, Nmin, Nmax), and to QArith (in particular a better power function). - Changes in ZArith: several additional lemmas (used in theories/Numbers), especially in Zdiv, Znumtheory, Zpower. Moreover, many results in Zdiv have been generalized: the divisor may simply be non-null instead of strictly positive (see lemmas with name ending by "_full"). An alternative file ZOdiv proposes a different behavior (the one of Ocaml) when dividing by negative numbers. - Changes in Arith: EqNat and Wf_nat now exported from Arith, some constructions on nat that were outside Arith are now in (e.g. iter_nat). - In SetoidList, eqlistA now expresses that two lists have similar elements at the same position, while the predicate previously called eqlistA is now equivlistA (this one only states that the lists contain the same elements, nothing more). - Changes in Reals: * Most statement in "sigT" (including the completeness axiom) are now in "sig" (in case of incompatibility, use proj1_sig instead of projT1, sig instead of sigT, etc). * More uniform naming scheme (identifiers in French moved to English, consistent use of 0 -- zero -- instead of O -- letter O --, etc). * Lemma on prod_f_SO is now on prod_f_R0. * Useless hypothesis of ln_exists1 dropped. * New Rlogic.v states a few logical properties about R axioms. * RIneq.v extended and made cleaner. - Slight restructuration of the Logic library regarding choice and classical logic. Addition of files providing intuitionistic axiomatizations of descriptions: Epsilon.v, Description.v and IndefiniteDescription.v. - Definition of pred and minus made compatible with the structural decreasing criterion for use in fixpoints. - Files Relations/Rstar.v and Relations/Newman.v moved out to the user contribution repository (contribution CoC_History). New lemmas about transitive closure added and some bound variables renamed (exceptional risk of incompatibilities). - Syntax for binders in terms (e.g. for "exists") supports anonymous names. Notations, coercions, implicit arguments and type inference - More automation in the inference of the return clause of dependent pattern-matching problems. - Experimental allowance for omission of the clauses easily detectable as impossible in pattern-matching problems. - Improved inference of implicit arguments. - New options "Set Maximal Implicit Insertion", "Set Reversible Pattern Implicit", "Set Strongly Strict Implicit" and "Set Printing Implicit Defensive" for controlling inference and use of implicit arguments. - New modifier in "Implicit Arguments" to force an implicit argument to be maximally inserted. - New modifier of "Implicit Arguments" to enrich the set of implicit arguments. - New options Global and Local to "Implicit Arguments" for section surviving or non-export outside module. - Level "constr" moved from 9 to 8. - Structure/Record now printed as Record (unless option Printing All is set). - Support for parametric notations defining constants. - Insertion of coercions below product types refrains to unfold constants (possible source of incompatibility). - New support for fix/cofix in notations. Tactic Language - Second-order pattern-matching now working in Ltac "match" clauses (syntax for second-order unification variable is "@?X"). - Support for matching on let bindings in match context using syntax "H := body" or "H := body : type". - Ltac accepts integer arguments (syntax is "ltac:nnn" for nnn an integer). - The general sequence tactical "expr_0 ; [ expr_1 | ... | expr_n ]" is extended so that at most one expr_i may have the form "expr .." or just "..". Also, n can be different from the number of subgoals generated by expr_0. In this case, the value of expr (or idtac in case of just "..") is applied to the intermediate subgoals to make the number of tactics equal to the number of subgoals. - A name used as the name of the parameter of a lemma (like f in "apply f_equal with (f:=t)") is now interpreted as a ltac variable if such a variable exists (this is a possible source of incompatibility and it can be fixed by renaming the variables of a ltac function into names that do not clash with the lemmas parameter names used in the tactic). - New syntax "Ltac tac ::= ..." to rebind a tactic to a new expression. - "let rec ... in ... " now supported for expressions without explicit parameters; interpretation is lazy to the contrary of "let ... in ..."; hence, the "rec" keyword can be used to turn the argument of a "let ... in ..." into a lazy one. - Patterns for hypotheses types in "match goal" are now interpreted in type_scope. - A bound variable whose name is not used elsewhere now serves as metavariable in "match" and it gets instantiated by an identifier (allow e.g. to extract the name of a statement like "exists x, P x"). - New printing of Ltac call trace for better debugging. Tactics - New tactics "apply -> term", "apply <- term", "apply -> term in ident", "apply <- term in ident" for applying equivalences (iff). - Slight improvement of the hnf and simpl tactics when applied on expressions with explicit occurrences of match or fix. - New tactics "eapply in", "erewrite", "erewrite in". - New tactics "ediscriminate", "einjection", "esimplify_eq". - Tactics "discriminate", "injection", "simplify_eq" now support any term as argument. Clause "with" is also supported. - Unfoldable references can be given by notation's string rather than by name in unfold. - The "with" arguments are now typed using informations from the current goal: allows support for coercions and more inference of implicit arguments. - Application of "f_equal"-style lemmas works better. - Tactics elim, case, destruct and induction now support variants eelim, ecase, edestruct and einduction. - Tactics destruct and induction now support the "with" option and the "in" clause option. If the option "in" is used, an equality is added to remember the term to which the induction or case analysis applied (possible source of parsing incompatibilities when destruct or induction is part of a let-in expression in Ltac; extra parentheses are then required). - New support for "as" clause in tactics "apply in" and "eapply in". - Some new intro patterns: * intro pattern "?A" genererates a fresh name based on A. Caveat about a slight loss of compatibility: Some intro patterns don't need space between them. In particular intros ?a?b used to be legal and equivalent to intros ? a ? b. Now it is still legal but equivalent to intros ?a ?b. * intro pattern "(A & ... & Y & Z)" synonym to "(A,....,(Y,Z)))))" for right-associative constructs like /\ or exists. - Several syntax extensions concerning "rewrite": * "rewrite A,B,C" can be used to rewrite A, then B, then C. These rewrites occur only on the first subgoal: in particular, side-conditions of the "rewrite A" are not concerned by the "rewrite B,C". * "rewrite A by tac" allows to apply tac on all side-conditions generated by the "rewrite A". * "rewrite A at n" allows to select occurrences to rewrite: rewrite only happen at the n-th exact occurrence of the first successful matching of A in the goal. * "rewrite 3 A" or "rewrite 3!A" is equivalent to "rewrite A,A,A". * "rewrite !A" means rewriting A as long as possible (and at least once). * "rewrite 3?A" means rewriting A at most three times. * "rewrite ?A" means rewriting A as long as possible (possibly never). * many of the above extensions can be combined with each other. - Introduction patterns better respect the structure of context in presence of missing or extra names in nested disjunction-conjunction patterns [possible source of rare incompatibilities]. - New syntax "rename a into b, c into d" for "rename a into b; rename c into d" - New tactics "dependent induction/destruction H [ generalizing id_1 .. id_n ]" to do induction-inversion on instantiated inductive families à la BasicElim. - Tactics "apply" and "apply in" now able to reason modulo unfolding of constants (possible source of incompatibility in situations where apply may fail, e.g. as argument of a try or a repeat and in a ltac function); versions that do not unfold are renamed into "simple apply" and "simple apply in" (usable for compatibility or for automation). - Tactics "apply" and "apply in" now able to traverse conjunctions and to select the first matching lemma among the components of the conjunction; tactic "apply" also able to apply lemmas of conclusion an empty type. - Tactic "apply" now supports application of several lemmas in a row. - Tactics "set" and "pose" can set functions using notation "(f x1..xn := c)". - New tactic "instantiate" (without argument). - Tactic firstorder "with" and "using" options have their meaning swapped for consistency with auto/eauto (source of incompatibility). - Tactic "generalize" now supports "at" options to specify occurrences and "as" options to name the quantified hypotheses. - 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. - 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. If H is already a negation, say ~T, then a proof of T is asked. If the current goal is a negation, say ~U, then U is saved in H afterwards, hence this new tactic "contradict" extends earlier tactic "swap", which is now obsolete. - Tactics f_equal is now done in ML instead of Ltac: it now works on any equality of functions, regardless of the arity of the function. - New options "before id", "at top", "at bottom" for tactics "move"/"intro". - Some more debug of reflexive omega (``romega``), and internal clarifications. Moreover, romega now has a variant ``romega with *`` that can be also used on non-Z goals (nat, N, positive) via a call to a translation tactic named zify (its purpose is to Z-ify your goal...). This zify may also be used independently of romega. - Tactic "remember" now supports an "in" clause to remember only selected occurrences of a term. - Tactic "pose proof" supports name overriding in case of specialization of an hypothesis. - Semi-decision tactic "jp" for first-order intuitionistic logic moved to user contributions (subsumed by "firstorder"). Program - Moved useful tactics in theories/Program and documented them. - Add Program.Basics which contains standard definitions for functional programming (id, apply, flip...) - More robust obligation handling, dependent pattern-matching and well-founded definitions. - New syntax " dest term as pat in term " for destructing objects using an irrefutable pattern while keeping equalities (use this instead of "let" in Programs). - Program CoFixpoint is accepted, Program Fixpoint uses the new way to infer which argument decreases structurally. - 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 debugging purposes. - New option "Transparent Obligations" to control the declaration of obligations as transparent or opaque. All obligations are now transparent by default, otherwise the system declares them opaque if possible. - Changed the notations "left" and "right" to "in_left" and "in_right" to hide the proofs in standard disjunctions, to avoid breaking existing scripts when importing Program. Also, put them in program_scope. Type Classes - New "Class", "Instance" and "Program Instance" commands to define classes and instances documented in the reference manual. - New binding construct " [ Class_1 param_1 .. param_n, Class_2 ... ] " for binding type classes, usable everywhere. - New command " Print Classes " and " Print Instances some_class " to print tables for typeclasses. - New default eauto hint database "typeclass_instances" used by the default typeclass instance search tactic. - New theories directory "theories/Classes" for standard typeclasses declarations. Module Classes.RelationClasses is a typeclass port of Relation_Definitions plus a generic development of algebra on n-ary heterogeneous predicates. Setoid rewriting - Complete (and still experimental) rewrite of the tactic based on typeclasses. The old interface and semantics are almost entirely respected, except: + Import Setoid is now mandatory to be able to call setoid_replace and declare morphisms. + "-->", "++>" and "==>" are now right associative notations declared at level 55 in scope signature_scope. Their introduction may break existing scripts that defined them as notations with different levels. + One needs to use [Typeclasses unfold [cst]] if [cst] is used as an abbreviation hiding products in types of morphisms, e.g. if ones redefines [relation] and declares morphisms whose type mentions [relation]. + The [setoid_rewrite]'s semantics change when rewriting with a lemma: it can rewrite two different instantiations of the lemma at once. Use [setoid_rewrite H at 1] for (almost) the usual semantics. [setoid_rewrite] will also try to rewrite under binders now, and can succeed on different terms than before. In particular, it will unify under let-bound variables. When called through [rewrite], the semantics are unchanged though. + [Add Morphism term : id] has different semantics when used with parametric morphism: it will try to find a relation on the parameters too. The behavior has also changed with respect to default relations: the most recently declared Setoid/Relation will be used, the documentation explains how to customize this behavior. + Parametric Relation and Morphism are declared differently, using the new [Add Parametric] commands, documented in the manual. + Setoid_Theory is now an alias to Equivalence, scripts building objects of type Setoid_Theory need to unfold (or "red") the definitions of Reflexive, Symmetric and Transitive in order to get the same goals as before. Scripts which introduced variables explicitly will not break. + The order of subgoals when doing [setoid_rewrite] with side-conditions is always the same: first the new goal, then the conditions. - New standard library modules ``Classes.Morphisms`` declares standard morphisms on ``refl`` / ``sym`` / ``trans`` relations. ``Classes.Morphisms_Prop`` declares morphisms on propositional connectives and ``Classes.Morphisms_Relations`` on generalized predicate connectives. ``Classes.Equivalence`` declares notations and tactics related to equivalences and ``Classes.SetoidTactics`` defines the setoid_replace tactics and some support for the ``Add *`` interface, notably the tactic applied automatically before each ``Add Morphism`` proof. - User-defined subrelations are supported, as well as higher-order morphisms and rewriting under binders. The tactic is also extensible entirely in Ltac. The documentation has been updated to cover these features. - [setoid_rewrite] and [rewrite] now support the [at] modifier to select occurrences to rewrite, and both use the [setoid_rewrite] code, even when rewriting with leibniz equality if occurrences are specified. Extraction - Improved behavior of the Caml extraction of modules: name clashes should 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 OCaml ones: + Extract Inductive list => list [ "[]" "(::)" ]. + Extract Inductive prod => "(*)" [ "(,)" ]. - In pattern matchings, a default pattern "| _ -> ..." is now used whenever possible if several branches are identical. For instance, functions corresponding to decidability of equalities are now linear instead of quadratic. - A new instruction Extraction Blacklist id1 .. idn allows to prevent filename conflits with existing code, for instance when extracting module List to Ocaml. 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 of a proof. - 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. Tools - New stand-alone .vo files verifier "coqchk". - Extended -I coqtop/coqc option to specify a logical dir: "-I dir -as coqdir". - 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 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). - 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 non-(Windows or MacOS) systems. Bytecode executables are now pure. The behavior is configurable with -coqrunbyteflags, -coqtoolsbyteflags and -custom configure options. - Complexity tests can be skipped by setting the environment variable COQTEST_SKIPCOMPLEXITY. Version 8.1 ----------- Summary of changes ~~~~~~~~~~~~~~~~~~ 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 algorithm works by compilation to an efficient bytecode that is interpreted in an abstract machine similar to Xavier Leroy’s ZINC machine. Convertibility is performed by comparing the normal forms. This alternative algorithm is specifically interesting for proofs by reflection. More generally, it is convenient in case of intensive computations. Christine Paulin implemented an extension of inductive types allowing recursively non-uniform parameters. Hugo Herbelin implemented sort-polymorphism for inductive types (now called template polymorphism). Claudio Sacerdoti Coen improved the tactics for rewriting on arbitrary compatible equivalence relations. He also generalized rewriting to arbitrary transition systems. Claudio Sacerdoti Coen added new features to the module system. Benjamin Grégoire, Assia Mahboubi and Bruno Barras developed a new, more efficient and more general simplification algorithm for rings and semirings. Laurent Théry and Bruno Barras developed a new, significantly more efficient simplification algorithm for fields. Hugo Herbelin, Pierre Letouzey, Julien Forest, Julien Narboux and Claudio Sacerdoti Coen added new tactic features. Hugo Herbelin implemented matching on disjunctive patterns. New mechanisms made easier the communication between Coq and external provers. Nicolas Ayache and Jean-Christophe Filliâtre implemented connections with the provers cvcl, Simplify and zenon. Hugo Herbelin implemented an experimental protocol for calling external tools from the tactic language. Matthieu Sozeau developed Russell, an experimental language to specify the behavior of programs with subtypes. A mechanism to automatically use some specific tactic to solve unresolved implicit has been implemented by Hugo Herbelin. Laurent Théry’s contribution on strings and Pierre Letouzey and Jean-Christophe Filliâtre’s contribution on finite maps have been integrated to the Coq standard library. Pierre Letouzey developed a library about finite sets “à la Objective Caml”. With Jean-Marc Notin, he extended the library on lists. Pierre Letouzey’s contribution on rational numbers has been integrated and extended. Pierre Corbineau extended his tactic for solving first-order statements. He wrote a reflection-based intuitionistic tautology solver. Pierre Courtieu, Julien Forest and Yves Bertot added extra support to reason on the inductive structure of recursively defined functions. Jean-Marc Notin significantly contributed to the general maintenance of the system. He also took care of ``coqdoc``. Pierre Castéran contributed to the documentation of (co)inductive types and suggested improvements to the libraries. Pierre Corbineau implemented a declarative mathematical proof language, usable in combination with the tactic-based style of proof. Finally, many users suggested improvements of the system through the Coq-Club mailing list and bug-tracker systems, especially user groups from INRIA Rocquencourt, Radboud University, University of Pennsylvania and Yale University. | Palaiseau, July 2006 | Hugo Herbelin | Details of changes in 8.1beta ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Logic - Added sort-polymorphism on inductive families - Allowance for recursively non-uniform parameters in inductive types Syntax - No more support for version 7 syntax and for translation to version 8 syntax. - In fixpoints, the { struct ... } annotation is not mandatory any more when only one of the arguments has an inductive type - Added disjunctive patterns in match-with patterns - Support for primitive interpretation of string literals - Extended support for Unicode ranges Commands - Added "Print Ltac qualid" to print a user defined tactic. - Added "Print Rewrite HintDb" to print the content of a DB used by autorewrite. - Added "Print Canonical Projections". - Added "Example" as synonym of "Definition". - Added "Proposition" and "Corollary" as extra synonyms of "Lemma". - New command "Whelp" to send requests to the Helm database of proofs formalized in the Calculus of Inductive Constructions. - Command "functional induction" has been re-implemented from the new "Function" command. Ltac and tactic syntactic extensions - 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 goal with" does). The keyword "lazymatch" can be used to delay the evaluation of tactics occurring in matching clauses. - Hint base names can be parametric in auto and trivial. - Occurrence values can be parametric in unfold, pattern, etc. - Added entry constr_may_eval for tactic extensions. - Low-priority term printer made available in ML-written tactic extensions. - "Tactic Notation" extended to allow notations of tacticals. Tactics - New implementation and generalization of ``setoid_*`` (``setoid_rewrite``, ``setoid_symmetry``, ``setoid_transitivity``, ``setoid_reflexivity`` and ``autorewite``). New syntax for declaring relations and morphisms (old syntax still working with minor modifications, but deprecated). - New implementation (still experimental) of the ring tactic with a built-in notion of coefficients and a better usage of setoids. - 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 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. - Fixed various bugs about (setoid) rewrite ... in ... (in particular bug #5941) - "rewrite ... in" now accepts a clause as place where to rewrite instead of just a simple hypothesis name. For instance: ``rewrite H in H1,H2 |- *`` means ``rewrite H in H1; rewrite H in H2; rewrite H`` ``rewrite H in * |-`` will do try ``rewrite H in Hi`` for all hypothesis Hi <> H. - Added "dependent rewrite term" and "dependent rewrite term in hyp". - Added "autorewrite with ... in hyp [using ...]". - Tactic "replace" now accepts a "by" tactic clause. - Added "clear - id" to clear all hypotheses except the ones depending in id. - The argument of Declare Left Step and Declare Right Step is now a term (it used to be a reference). - Omega now handles arbitrary precision integers. - Several bug fixes in Reflexive Omega (romega). - Idtac can now be left implicit in a [...|...] construct: for instance, [ foo | | bar ] stands for [ foo | idtac | bar ]. - Fixed a "fold" bug (noncritical but possible source of incompatibilities). - Added classical_left and classical_right which transforms ``|- A \/ B`` into ``~B |- A`` and ``~A |- B`` respectively. - Added command "Declare Implicit Tactic" to set up a default tactic to be used to solve unresolved subterms of term arguments of tactics. - Better support for coercions to Sortclass in tactics expecting type arguments. - Tactic "assert" now accepts "as" intro patterns and "by" tactic clauses. - New tactic "pose proof" that generalizes "assert (id:=p)" with intro patterns. - New introduction pattern "?" for letting Coq choose a name. - Introduction patterns now support side hypotheses (e.g. intros [|] on "(nat -> nat) -> nat" works). - New introduction patterns "->" and "<-" for immediate rewriting of introduced hypotheses. - Introduction patterns coming after nontrivial introduction patterns now force full introduction of the first pattern (e.g. ``intros [[|] p]`` on ``nat->nat->nat`` now behaves like ``intros [[|?] p]``) - Added "eassumption". - Added option 'using lemmas' to auto, trivial and eauto. - Tactic "congruence" is now complete for its intended scope (ground equalities and inequalities with constructors). Furthermore, it tries to equates goal and hypotheses. - New tactic "rtauto" solves pure propositional logic and gives a reflective version of the available proof. - Numbering of "pattern", "unfold", "simpl", ... occurrences in "match with" made consistent with the printing of the return clause after the term to match in the "match-with" construct (use "Set Printing All" to see hidden occurrences). - Generalization of induction "induction x1...xn using scheme" where scheme is an induction principle with complex predicates (like the ones generated by function induction). - Some small Ltac tactics has been added to the standard library (file Tactics.v): * f_equal : instead of using the different f_equalX lemmas * case_eq : a "case" without loss of information. An equality stating the current situation is generated in every sub-cases. * swap : for a negated goal ~B and a negated hypothesis H:~A, swap H asks you to prove A from hypothesis B * revert : revert H is generalize H; clear H. Extraction - All type parts should now disappear instead of sometimes producing _ (for instance in Map.empty). - Haskell extraction: types of functions are now printed, better unsafeCoerce mechanism, both for hugs and ghc. - Scheme extraction improved, see http://www.pps.jussieu.fr/~letouzey/scheme. - Many bug fixes. Modules - Added "Locate Module qualid" to get the full path of a module. - Module/Declare Module syntax made more uniform. - Added syntactic sugar "Declare Module Export/Import" and "Module Export/Import". - Added syntactic sugar "Module M(Export/Import X Y: T)" and "Module Type M(Export/Import X Y: T)" (only for interactive definitions) - Construct "with" generalized to module paths: T with (Definition|Module) M1.M2....Mn.l := l'. Notations - Option "format" aware of recursive notations. - Added insertion of spaces by default in recursive notations w/o separators. - No more automatic printing box in case of user-provided printing "format". - New notation "exists! x:A, P" for unique existence. - Notations for specific numerals now compatible with generic notations of numerals (e.g. "1" can be used to denote the unit of a group without hiding 1%nat) Libraries - New library on String and Ascii characters (contributed by L. Thery). - New library FSets+FMaps of finite sets and maps. - New library QArith on rational numbers. - Small extension of Zmin.V, new Zmax.v, new Zminmax.v. - Reworking and extension of the files on classical logic and description principles (possible incompatibilities) - Few other improvements in ZArith potentially exceptionally breaking the compatibility (useless hypothesys of Zgt_square_simpl and 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. - 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. - Acc in Wf.v and clos_refl_trans in Relation_Operators.v now rely on the allowance for recursively non-uniform parameters (possible source of incompatibilities: explicit pattern-matching on these types may require to remove the occurrence associated with their recursively non-uniform parameter). - Coq.List.In_dec has been set transparent (this may exceptionally break proof scripts, set it locally opaque for compatibility). - More on permutations of lists in List.v and Permutation.v. - List.v has been much expanded. - New file SetoidList.v now contains results about lists seen with respect to a setoid equality. - Library NArith has been expanded, mostly with results coming from Intmap (for instance a bitwise xor), plus also a bridge between N and Bitvector. - Intmap has been reorganized. In particular its address type "addr" is now N. User contributions known to use Intmap have been adapted accordingly. If you're using this library please contact us. A wrapper FMapIntMap now presents Intmap as a particular implementation of FMaps. New developments are strongly encouraged to use either this wrapper or any other implementations of FMap instead of using directly this obsolete Intmap. Tools - New semantics for coqtop options ("-batch" expects option "-top dir" for loading vernac file that contains definitions). - 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: "%s" is the placeholder for the URL. Details of changes in 8.1gamma ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Syntax - changed parsing precedence of let/in and fun constructions of Ltac: let x := t in e1; e2 is now parsed as let x := t in (e1;e2). Language and commands - Added sort-polymorphism for definitions in Type (but finally abandoned). - Support for implicit arguments in the types of parameters in (co)fixpoints and (co)inductive declarations. - Improved type inference: use as much of possible general information. before applying irreversible unification heuristics (allow e.g. to infer the predicate in "(exist _ 0 (refl_equal 0) : {n:nat | n=0 })"). - Support for Miller-Pfenning's patterns unification in type synthesis (e.g. can infer P such that P x y = phi(x,y)). - Support for "where" clause in cofixpoint definitions. - New option "Set Printing Universes" for making Type levels explicit. Tactics - Improved implementation of the ring and field tactics. For compatibility reasons, the previous tactics are renamed as legacy ring and legacy field, but should be considered as deprecated. - New declarative mathematical proof language. - Support for argument lists of arbitrary length in Tactic Notation. - ``rewrite ... in H`` now fails if ``H`` is used either in an hypothesis or in the goal. - The semantics of ``rewrite ... in *`` has been slightly modified (see doc). - Support for ``as`` clause in tactic injection. - New forward-reasoning tactic "apply in". - Ltac fresh operator now builds names from a concatenation of its arguments. - New ltac tactic "remember" to abstract over a subterm and keep an equality - Support for Miller-Pfenning's patterns unification in apply/rewrite/... (may lead to few incompatibilities - generally now useless tactic calls). Bug fixes - Fix for notations involving basic "match" expressions. - Numerous other bugs solved (a few fixes may lead to incompatibilities). Details of changes in 8.1 ~~~~~~~~~~~~~~~~~~~~~~~~~ Bug fixes - Many bugs have been fixed (cf coq-bugs web page) Tactics - New tactics ring, ring_simplify and new tactic field now able to manage power to a positive integer constant. Tactic ring on Z and R, and field on R manage power (may lead to incompatibilities with V8.1gamma). - Tactic field_simplify now applicable in hypotheses. - New field_simplify_eq for simplifying field equations into ring equations. - Tactics ring, ring_simplify, field, field_simplify and field_simplify_eq all able to apply user-given equations to rewrite monoms on the fly (see documentation). Libraries - New file ConstructiveEpsilon.v defining an epsilon operator and proving the axiom of choice constructively for a countable domain and a decidable predicate. Version 8.0 ----------- Summary of changes ~~~~~~~~~~~~~~~~~~ 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 principle for formalizing mathematics within classical logic. Moreover, even in an constructive setting, the impredicativity of Set does not add so much in practice and is even subject of criticism from a large part of the intuitionistic mathematician community. Nevertheless, the impredicativity of Set remains optional for users interested in investigating mathematical developments which rely on it. Secondly, the concrete syntax of terms has been completely revised. The main motivations were - a more uniform, purified style: all constructions are now lowercase, with a functional programming perfume (e.g. abstraction is now written fun), and more directly accessible to the novice (e.g. dependent product is now written forall and allows omission of types). Also, parentheses are no longer mandatory for function application. - extensibility: some standard notations (e.g. “<” and “>”) were incompatible with the previous syntax. Now all standard arithmetic notations (=, +, \*, /, <, <=, ... and more) are directly part of the syntax. Together with the revision of the concrete syntax, a new mechanism of *notation scopes* permits to reuse the same symbols (typically +, -, \*, /, <, <=) in various mathematical theories without any ambiguities for Coq, leading to a largely improved readability of Coq scripts. New commands to easily add new symbols are also provided. Coming with the new syntax of terms, a slight reform of the tactic language and of the language of commands has been carried out. The 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 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 follow a standard pattern and the symbolic notations for the standard definitions as well. The fourth point is the release of CoqIDE, a new graphical gtk2-based interface fully integrated with Coq. Close in style to the Proof General Emacs interface, it is faster and its integration with Coq makes interactive developments more friendly. All mathematical Unicode symbols are usable within CoqIDE. Finally, the module system of Coq completes the picture of Coq version 8.0. Though released with an experimental status in the previous version 7.4, it should be considered as a salient feature of the new version. Besides, Coq comes with its load of novelties and improvements: new or improved tactics (including a new tactic for solving first-order statements), new management commands, extended libraries. Bruno Barras and Hugo Herbelin have been the main contributors of the reflection and the implementation of the new syntax. The smart automatic translator from old to new syntax released with Coq is also their work with contributions by Olivier Desmettre. Hugo Herbelin is the main designer and implementer of the notion of notation scopes and of the commands for easily adding new notations. Hugo Herbelin is the main implementer of the restructured standard library. Pierre Corbineau is the main designer and implementer of the new tactic for solving first-order statements in presence of inductive types. He is also the maintainer of the non-domain specific automation tactics. Benjamin Monate is the developer of the CoqIDE graphical interface with contributions by Jean-Christophe Filliâtre, Pierre Letouzey, Claude Marché and Bruno Barras. Claude Marché coordinated the edition of the Reference Manual for Coq V8.0. Pierre Letouzey and Jacek Chrząszcz respectively maintained the extraction tool and module system of Coq. Jean-Christophe Filliâtre, Pierre Letouzey, Hugo Herbelin and other contributors from Sophia-Antipolis and Nijmegen participated in extending the library. Julien Narboux built a NSIS-based automatic Coq installation tool for the Windows platform. Hugo Herbelin and Christine Paulin coordinated the development which was under the responsibility of Christine Paulin. | Palaiseau & Orsay, Apr. 2004 | Hugo Herbelin & Christine Paulin | (updated Apr. 2006) | Details of changes in 8.0beta old syntax ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Logic - Set now predicative by default - New option -impredicative-set to set Set impredicative - The standard library doesn't need impredicativity of Set and is compatible with the classical axioms which contradict Set impredicativity Syntax for arithmetic - Notation "=" and "<>" in Z and R are no longer implicitly in Z or R (with possible introduction of a coercion), use ...=... or ...<>... instead - Locate applied to a simple string (e.g. "+") searches for all notations containing this string Commands - "Declare ML Module" now allows to import .cma files. This avoids to use a bunch of "Declare ML Module" statements when using several ML files. - "Set Printing Width n" added, allows to change the size of width printing. - "Implicit Variables Type x,y:t" (new syntax: "Implicit Types x y:t") assigns default types for binding variables. - Declarations of Hints and Notation now accept a "Local" flag not to be exported outside the current file even if not in section - "Print Scopes" prints all notations - New command "About name" for light printing of type, implicit arguments, etc. - New command "Admitted" to declare incompletely proven statement as axioms - New keyword "Conjecture" to declare an axiom intended to be provable - SearchAbout can now search for lemmas referring to more than one constant and on substrings of the name of the lemma - "Print Implicit" displays the implicit arguments of a constant - Locate now searches for all names having a given suffix - New command "Functional Scheme" for building an induction principle from a function defined by case analysis and fix. Commands - new coqtop/coqc option -dont-load-proofs not to load opaque proofs in memory Implicit arguments - Inductive in sections declared with implicits now "discharged" with implicits (like constants and variables) - Implicit Arguments flags are now synchronous with reset - New switch "Unset/Set Printing Implicits" (new syntax: "Unset/Set Printing Implicit") to globally control printing of implicits Grammar extensions - Many newly supported UTF-8 encoded unicode blocks - Greek letters (0380-03FF), Hebrew letters (U05D0-05EF), letter-like symbols (2100-214F, that includes double N,Z,Q,R), prime signs (from 2080-2089) and characters from many written languages are valid in identifiers - mathematical operators (2200-22FF), supplemental mathematical operators (2A00-2AFF), miscellaneous technical (2300-23FF that includes sqrt symbol), miscellaneous symbols (2600-26FF), arrows (2190-21FF and 2900-297F), invisible mathematical operators (from 2080-2089), ... are valid symbols Library - New file about the factorial function in Arith - An additional elimination Acc_iter for Acc, simpler than Acc_rect. This new elimination principle is used for definition well_founded_induction. - New library NArith on binary natural numbers - R is now of type Set - Restructuration in ZArith library + "true_sub" used in Zplus now a definition, not a local one (source of incompatibilities in proof referring to true_sub, may need extra Unfold) + Some lemmas about minus moved from fast_integer to Arith/Minus.v (le_minus, lt_mult_left) (theoretical source of incompatibilities) + Several lemmas moved from auxiliary.v and zarith_aux.v to fast_integer.v (theoretical source of incompatibilities) + Variables names of iff_trans changed (source of incompatibilities) + ZArith lemmas named ``OMEGA`` something or ``fast_`` something, and lemma ``new_var`` are now out of ZArith (except ``OMEGA2``) + Redundant ZArith lemmas have been renamed: for the following pairs, use the second name (Zle_Zmult_right2, Zle_mult_simpl), (OMEGA2, Zle_0_plus), (Zplus_assoc_l, Zplus_assoc), (Zmult_one, Zmult_1_n), (Zmult_assoc_l, Zmult_assoc), (Zmult_minus_distr, Zmult_Zminus_distr_l) (add_un_double_moins_un_xO, is_double_moins_un), (Rlt_monotony_rev,Rlt_monotony_contra) (source of incompatibilities) - Few minor changes (no more implicit arguments in Zmult_Zminus_distr_l and Zmult_Zminus_distr_r, lemmas moved from Zcomplements to other files) (rare source of incompatibilities) - New lemmas provided by users added Tactic language - Fail tactic now accepts a failure message - Idtac tactic now accepts a message - New primitive tactic "FreshId" (new syntax: "fresh") to generate new names - Debugger prints levels of calls Tactics - Replace can now replace proofs also - Fail levels are now decremented at "Match Context" blocks only and if the right-hand-side of "Match term With" are tactics, these tactics are never evaluated immediately and do not induce backtracking (in contrast with "Match Context") - Quantified names now avoid global names of the current module (like Intro names did) [source of rare incompatibilities: 2 changes in the set of user contribs] - NewDestruct/NewInduction accepts intro patterns as introduction names - NewDestruct/NewInduction now work for non-inductive type using option "using" - A NewInduction naming bug for inductive types with functional arguments (e.g. the accessibility predicate) has been fixed (source of incompatibilities) - Symmetry now applies to hypotheses too - Inversion now accept option "as [ ... ]" to name the hypotheses - Contradiction now looks also for contradictory hypotheses stating ~A and A (source of incompatibility) - "Contradiction c" try to find an hypothesis in context which contradicts the type of c - Ring applies to new library NArith (require file NArithRing) - Field now works on types in Set - Auto with reals now try to replace le by ge (Rge_le is no longer an immediate hint), resulting in shorter proofs - Instantiate now works in hyps (syntax : Instantiate in ...) - Some new tactics : EConstructor, ELeft, Eright, ESplit, EExists - New tactic "functional induction" to perform case analysis and induction following the definition of a function. - Clear now fails when trying to remove a local definition used by a constant appearing in the current goal Extraction (See details in plugins/extraction/CHANGES) - The old commands: (Recursive) Extraction Module M. are now: (Recursive) Extraction Library M. To use these commands, M should come from a library M.v - The other syntax Extraction & Recursive Extraction now accept module names as arguments. Bugs - see coq-bugs server for the complete list of fixed bugs Miscellaneous - Implicit parameters of inductive types definition now taken into account for inferring other implicit arguments Incompatibilities - 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) - 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) - 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) - ML programs referring to constants from fast_integer.v must use "Coqlib.gen_constant_modules Coqlib.zarith_base_modules" instead Details of changes in 8.0beta new syntax ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ New concrete syntax - A completely new syntax for terms - A more uniform syntax for tactics and the tactic language - A few syntactic changes for commands - A smart automatic translator translating V8.0 files in old syntax to files valid for V8.0 Syntax extensions - "Grammar" for terms disappears - "Grammar" for tactics becomes "Tactic Notation" - "Syntax" disappears - Introduction of a notion of notation scope allowing to use the same notations in various contexts without using specific delimiters (e.g the same expression "4<=3+x" is interpreted either in "nat", "positive", "N" (previously "entier"), "Z", "R", depending on which Notation scope is currently open) [see documentation for details] - Notation now requires a precedence and associativity (default was to set precedence to 1 and associativity to none) Revision of the standard library - Many lemmas and definitions names have been made more uniform mostly in Arith, NArith, ZArith and Reals (e.g : "times" -> "Pmult", "times_sym" -> "Pmult_comm", "Zle_Zmult_pos_right" -> "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 - 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) - Similarly, ex, ex2, all, identity are merged with exT, exT2, allT, identityT - Arithmetical notations for nat, positive, N, Z, R, without needing any backquote or double-backquotes delimiters. - In Lists: new concrete notations; argument of nil is now implicit - All changes in the library are taken in charge by the translator Semantical changes during translation - Recursive keyword set by default (and no longer needed) in Tactic Definition - Set Implicit Arguments is strict by default in new syntax - reductions in hypotheses of the form "... in H" now apply to the type also if H is a local definition - etc Gallina - New syntax of the form "Inductive bool : Set := true, false : bool." for enumerated types - Experimental syntax of the form p.(fst) for record projections (activable with option "Set Printing Projections" which is recognized by the translator) 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 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 in ZArith by "Require Import ZArith_base" or "Require Import ZArith" - Some implicit arguments must be made explicit before translation: typically for "length nil", the implicit argument of length must be made explicit - Grammar rules, Infix notations and V7.4 Notations must be updated wrt the new scheme for syntactic extensions (see translator documentation) - Unsafe for annotation Cases when constructors coercions are used or when annotations are eta-reduced predicates Details of changes in 8.0 ~~~~~~~~~~~~~~~~~~~~~~~~~ Commands - New option "Set Printing All" to deactivate all high-level forms of printing (implicit arguments, coercions, destructing let, if-then-else, notations, projections) - "Functional Scheme" and "Functional Induction" extended to polymorphic types and dependent types - Notation now allows recursive patterns, hence recovering parts of the functionalities of pre-V8 Grammar/Syntax commands - Command "Print." discontinued. - Redundant syntax "Implicit Arguments On/Off" discontinued New syntax - Semantics change of the if-then-else construction in new syntax: "if c then t1 else t2" now stands for "match c with c1 _ ... _ => t1 | c2 _ ... _ => t2 end" with no dependency of t1 and t2 in the arguments of the constructors; this may cause incompatibilities for files translated using coq 8.0beta Notation scopes - Delimiting key %bool for bool_scope added - Import no more needed to activate argument scopes from a module Tactics and the tactic Language - Semantics of "assert" is now consistent with the reference manual - New tactics stepl and stepr for chaining transitivity steps - Tactic "replace ... with ... in" added - Intro patterns now supported in Ltac (parsed with prefix "ipattern:") 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 - XML exportation tool now exports the structure of vernacular files (cf chapter 13 in the reference manual) User contributions - User contributions have been updated to the new syntax Bug fixes - Many bugs have been fixed (cf coq-bugs web page) coq-8.20.0/doc/sphinx/conf.py000066400000000000000000000410151466560755400157630ustar00rootroot00000000000000#!/usr/bin/env python3 ########################################################################## ## # The Coq Proof Assistant / The Coq Development Team ## ## v # Copyright INRIA, CNRS and contributors ## ## v documentation" by default. #html_title = 'Coq 8.5 v8.5pl1' # A shorter title for the navigation bar. Default is the same as html_title. #html_short_title = None # The name of an image file (relative to this directory) to place at the top # of the sidebar. #html_logo = None # The name of an image file (relative to this directory) to use as a favicon of # the docs. This file should be a Windows icon file (.ico) being 16x16 or 32x32 # pixels large. #html_favicon = None # Add any paths that contain custom static files (such as style sheets) here, # relative to this directory. They are copied after the builtin static files, # so a file named "default.css" will overwrite the builtin "default.css". html_static_path = ['_static'] # Add any extra paths that contain custom files (such as robots.txt or # .htaccess) here, relative to this directory. These files are copied # directly to the root of the documentation. #html_extra_path = [] # If not None, a 'Last updated on:' timestamp is inserted at every page # bottom, using the given strftime format. # The empty string is equivalent to '%b %d, %Y'. #html_last_updated_fmt = None # FIXME: this could be re-enabled after ensuring that smart quotes are locally # disabled for all relevant directives smartquotes = False # Custom sidebar templates, maps document names to template names. #html_sidebars = {} # Additional templates that should be rendered to pages, maps page names to # template names. #html_additional_pages = {} # If false, no module index is generated. #html_domain_indices = True # If false, no index is generated. #html_use_index = True # If true, the index is split into individual pages for each letter. #html_split_index = False # If true, links to the reST sources are added to the pages. #html_show_sourcelink = True # If true, "Created using Sphinx" is shown in the HTML footer. Default is True. #html_show_sphinx = True # If true, "(C) Copyright ..." is shown in the HTML footer. Default is True. #html_show_copyright = True # If true, an OpenSearch description file will be output, and all pages will # contain a tag referring to it. The value of this option must be the # base URL from which the finished HTML is served. #html_use_opensearch = '' # This is the file name suffix for HTML files (e.g. ".xhtml"). #html_file_suffix = None # Language to be used for generating the HTML full-text search index. # Sphinx supports the following languages: # 'da', 'de', 'en', 'es', 'fi', 'fr', 'h', 'it', 'ja' # 'nl', 'no', 'pt', 'ro', 'r', 'sv', 'tr', 'zh' #html_search_language = 'en' # A dictionary with options for the search language support, empty by default. # 'ja' uses this config value. # 'zh' user can custom change `jieba` dictionary path. #html_search_options = {'type': 'default'} # The name of a javascript file (relative to the configuration directory) that # implements a search results scorer. If empty, the default will be used. #html_search_scorer = 'scorer.js' # -- Options for LaTeX output --------------------------------------------- ########################### # Set things up for XeTeX # ########################### latex_elements = { 'babel': '', 'fontenc': '', 'inputenc': '', 'utf8extra': '', 'cmappkg': '', 'papersize': 'letterpaper', 'classoptions': ',openany', # No blank pages 'polyglossia': '\\usepackage{polyglossia}', 'sphinxsetup': 'verbatimwithframe=false', 'preamble': r""" \usepackage{unicode-math} \usepackage{microtype} % Macro definitions \usepackage{refman-preamble} % Style definitions for notations \usepackage{coqnotations} % Style tweaks \newcssclass{sigannot}{\textrm{#1:}} % Silence 'LaTeX Warning: Command \nobreakspace invalid in math mode' \everymath{\def\nobreakspace{\ }} """ } latex_engine = "xelatex" # Cf. https://github.com/sphinx-doc/sphinx/issues/7015 latex_use_xindy = False ######## # done # ######## latex_additional_files = [ "refman-preamble.sty", "_static/coqnotations.sty" ] latex_documents = [('index', 'CoqRefMan.tex', 'The Coq Reference Manual', author, 'manual')] # The name of an image file (relative to this directory) to place at the top of # the title page. # latex_logo = "../../ide/coq.png" # If true, show page references after internal links. #latex_show_pagerefs = False # If true, show URL addresses after external links. latex_show_urls = 'footnote' # -- Options for manual page output --------------------------------------- # One entry per manual page. List of tuples # (source start file, name, description, authors, manual section). #man_pages = [ # (master_doc, 'coq', 'Coq Documentation', # [author], 1) #] # If true, show URL addresses after external links. #man_show_urls = False # -- Options for Texinfo output ------------------------------------------- # Grouping the document tree into Texinfo files. List of tuples # (source start file, target name, title, author, # dir menu entry, description, category) #texinfo_documents = [ # (master_doc, 'Coq', 'Coq Documentation', # author, 'Coq', 'One line description of project.', # 'Miscellaneous'), #] # Documents to append as an appendix to all manuals. #texinfo_appendices = [] # If false, no module index is generated. #texinfo_domain_indices = True # How to display URL addresses: 'footnote', 'no', or 'inline'. #texinfo_show_urls = 'footnote' # If true, do not generate a @detailmenu in the "Top" node's menu. #texinfo_no_detailmenu = False # -- Options for Epub output ---------------------------------------------- # Bibliographic Dublin Core info. #epub_title = project #epub_author = author #epub_publisher = author #epub_copyright = copyright # The basename for the epub file. It defaults to the project name. #epub_basename = project # The HTML theme for the epub output. Since the default themes are not # optimized for small screen space, using the same theme for HTML and epub # output is usually not wise. This defaults to 'epub', a theme designed to save # visual space. #epub_theme = 'epub' # The language of the text. It defaults to the language option # or 'en' if the language is not set. #epub_language = '' # The scheme of the identifier. Typical schemes are ISBN or URL. #epub_scheme = '' # The unique identifier of the text. This can be a ISBN number # or the project homepage. #epub_identifier = '' # A unique identification for the text. #epub_uid = '' # A tuple containing the cover image and cover page html template filenames. #epub_cover = () # A sequence of (type, uri, title) tuples for the guide element of content.opf. #epub_guide = () # HTML files that should be inserted before the pages created by sphinx. # The format is a list of tuples containing the path and title. #epub_pre_files = [] # HTML files that should be inserted after the pages created by sphinx. # The format is a list of tuples containing the path and title. #epub_post_files = [] # A list of files that should not be packed into the epub file. epub_exclude_files = ['search.html'] # The depth of the table of contents in toc.ncx. #epub_tocdepth = 3 # Allow duplicate toc entries. #epub_tocdup = True # Choose between 'default' and 'includehidden'. #epub_tocscope = 'default' # Fix unsupported image types using the Pillow. #epub_fix_images = False # Scale large images. #epub_max_image_width = 0 # How to display URL addresses: 'footnote', 'no', or 'inline'. #epub_show_urls = 'inline' # If false, no index is generated. #epub_use_index = True # navtree options navtree_shift = True # since sphinxcontrib-bibtex version 2 we need this bibtex_bibfiles = [ "biblio.bib" ] coq-8.20.0/doc/sphinx/coq-attrindex.rst000066400000000000000000000001551466560755400200000ustar00rootroot00000000000000:orphan: .. hack to get index in TOC .. _attribute_index: --------------- Attribute index --------------- coq-8.20.0/doc/sphinx/coq-cmdindex.rst000066400000000000000000000001551466560755400175710ustar00rootroot00000000000000:orphan: .. hack to get index in TOC .. _command_index: ----------------- Command index ----------------- coq-8.20.0/doc/sphinx/coq-exnindex.rst000066400000000000000000000001651466560755400176210ustar00rootroot00000000000000:orphan: .. hack to get index in TOC ------------------------- Errors and warnings index ------------------------- coq-8.20.0/doc/sphinx/coq-optindex.rst000066400000000000000000000002331466560755400176250ustar00rootroot00000000000000:orphan: .. hack to get index in TOC .. _options_index: ------------------------------- Flags, options and tables index ------------------------------- coq-8.20.0/doc/sphinx/coq-tacindex.rst000066400000000000000000000001431466560755400175720ustar00rootroot00000000000000:orphan: .. hack to get index in TOC .. _tactic_index: ------------- Tactic index ------------- coq-8.20.0/doc/sphinx/dune000066400000000000000000000004031466560755400153360ustar00rootroot00000000000000(dirs :standard _static _templates) (rule (targets README.gen.rst) (deps (source_tree ../tools/coqrst) README.template.rst) (action (run ../tools/coqrst/regen_readme.py %{targets}))) (rule (alias refman-html) (action (diff README.rst README.gen.rst))) coq-8.20.0/doc/sphinx/genindex.rst000066400000000000000000000001211466560755400170100ustar00rootroot00000000000000:orphan: .. hack to get index in TOC ------------- General index ------------- coq-8.20.0/doc/sphinx/history.rst000066400000000000000000001726131466560755400167300ustar00rootroot00000000000000.. _history: ---------------------- Early history of Coq ---------------------- Historical roots ---------------- 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 *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 synthesizes computer programs obeying their formal specifications, written as logical assertions in the language. The logical language used by Coq is a variety of type theory, called the *Calculus of Inductive Constructions*. Without going back to Leibniz and Boole, we can date the creation of what is now called mathematical logic to the work of Frege and Peano at the turn of the century. The discovery of antinomies in the free use of predicates or comprehension principles prompted Russell to restrict predicate calculus with a stratification of *types*. This effort culminated with *Principia Mathematica*, the first systematic attempt at a formal foundation of mathematics. A simplification of this system along the lines of simply typed λ-calculus occurred with Church’s *Simple Theory of Types*. The λ-calculus notation, originally used for expressing functionality, could also be used as an encoding of natural deduction proofs. This Curry-Howard isomorphism was used by N. de Bruijn in the *Automath* project, the first full-scale attempt to develop and mechanically verify mathematical proofs. This effort culminated with Jutting’s verification of Landau’s *Grundlagen* in the 1970’s. Exploiting this Curry-Howard isomorphism, notable achievements in proof theory saw the emergence of two type-theoretic frameworks; the first one, Martin-Löf’s *Intuitionistic Theory of Types*, attempts a new foundation of mathematics on constructive principles. The second one, Girard’s polymorphic λ-calculus :math:`F_\omega`, is a very strong functional system in which we may represent higher-order logic proof structures. Combining both systems in a higher-order extension of the Automath language, T. Coquand presented in 1985 the first version of the *Calculus of Constructions*, CoC. This strong logical system allowed powerful axiomatizations, but direct inductive definitions were not possible, and inductive notions had to be defined indirectly through functional encodings, which introduced inefficiencies and awkwardness. The formalism was extended in 1989 by T. Coquand and C. Paulin with primitive inductive definitions, leading to the current *Calculus of Inductive Constructions*. This extended formalism is not rigorously defined here. Rather, numerous concrete examples are discussed. We refer the interested reader to relevant research papers for more information about the formalism, its meta-theoretic properties, and semantics. However, it should not be necessary to understand this theoretical material in order to write specifications. It is possible to understand the Calculus of Inductive Constructions at a higher level, as a mixture of predicate calculus, inductive predicate definitions presented as typed PROLOG, and recursive function definitions close to the language ML. Automated theorem-proving was pioneered in the 1960’s by Davis and Putnam in propositional calculus. A complete mechanization (in the sense of a semidecision procedure) of classical first-order logic was proposed in 1965 by J.A. Robinson, with a single uniform inference rule called *resolution*. Resolution relies on solving equations in free algebras (i.e. term structures), using the *unification algorithm*. Many refinements of resolution were studied in the 1970’s, but few convincing implementations were realized, except of course that PROLOG is in some sense issued from this effort. A less ambitious approach to proof development is computer-aided proof-checking. The most notable proof-checkers developed in the 1970’s were LCF, designed by R. Milner and his colleagues at U. Edinburgh, specialized in proving properties about denotational semantics recursion equations, and the Boyer and Moore theorem-prover, an automation of primitive recursion over inductive data types. While the Boyer-Moore theorem-prover attempted to synthesize proofs by a combination of automated methods, LCF constructed its proofs through the programming of *tactics*, written in a high-level functional meta-language, ML. The salient feature which clearly distinguishes our proof assistant from say LCF or Boyer and Moore’s, is its possibility to extract programs from the constructive contents of proofs. This computational interpretation of proof objects, in the tradition of Bishop’s constructive mathematics, is based on a realizability interpretation, in the sense of Kleene, due to C. Paulin. The user must just mark his intention by separating in the logical statements the assertions stating the existence of a computational object from the logical assertions which specify its properties, but which may be considered as just comments in the corresponding program. Given this information, the system automatically extracts a functional term from a consistency proof of its specifications. This functional term may be in turn compiled into an actual computer program. This methodology of extracting programs from proofs is a revolutionary paradigm for software engineering. Program synthesis has long been a theme of research in artificial intelligence, pioneered by R. Waldinger. The Tablog system of Z. Manna and R. Waldinger allows the deductive synthesis of functional programs from proofs in tableau form of their specifications, written in a variety of first-order logic. Development of a systematic *programming logic*, based on extensions of Martin-Löf’s type theory, was undertaken at Cornell U. by the Nuprl team, headed by R. Constable. The first actual program extractor, PX, was designed and implemented around 1985 by S. Hayashi from Kyoto University. It allows the extraction of a LISP program from a proof in a logical system inspired by the logical formalisms of S. Feferman. Interest in this methodology is growing in the theoretical computer science community. We can foresee the day when actual computer systems used in applications will contain certified modules, automatically generated from a consistency proof of their formal specifications. We are however still far from being able to use this methodology in a smooth interaction with the standard tools from software engineering, i.e. compilers, linkers, run-time systems taking advantage of special hardware, debuggers, and the like. We hope that Coq can be of use to researchers interested in experimenting with this new methodology. .. [#years] At the time of writing, i.e. 1995. Versions 1 to 5 --------------- .. note:: This summary was written in 1995 together with the previous section and formed the initial version of the Credits chapter. A more comprehensive description of these early versions is available in the following subsections, which come from a document written in September 2015 by Gérard Huet, Thierry Coquand and Christine Paulin. A first implementation of CoC was started in 1984 by G. Huet and T. Coquand. Its implementation language was CAML, a functional programming language from the ML family designed at INRIA in Rocquencourt. The core of this system was a proof-checker for CoC seen as a typed λ-calculus, called the *Constructive Engine*. This engine was operated through a high-level notation permitting the declaration of axioms and parameters, the definition of mathematical types and objects, and the explicit construction of proof objects encoded as λ-terms. A section mechanism, designed and implemented by G. Dowek, allowed hierarchical developments of mathematical theories. This high-level language was called the *Mathematical Vernacular*. Furthermore, an interactive *Theorem Prover* permitted the incremental construction of proof trees in a top-down manner, subgoaling recursively and backtracking from dead-ends. The theorem prover executed tactics written in CAML, in the LCF fashion. A basic set of tactics was predefined, which the user could extend by his own specific tactics. This system (Version 4.10) was released in 1989. Then, the system was extended to deal with the new calculus with inductive types by C. Paulin, with corresponding new tactics for proofs by induction. A new standard set of tactics was streamlined, and the vernacular extended for tactics execution. A package to compile programs extracted from proofs to actual computer programs in CAML or some other functional language was designed and implemented by B. Werner. A new user-interface, relying on a CAML-X interface by D. de Rauglaudre, was designed and implemented 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. 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 extraction) and a new user-interaction loop. This system (Version 5.8) was released in May 1993. A Centaur interface CTCoq was then developed by Y. Bertot from the Croap project from INRIA-Sophia-Antipolis. In parallel, G. Dowek and H. Herbelin developed a new proof engine, allowing the general manipulation of existential variables consistently with dependent types in an experimental version of Coq (V5.9). The version V5.10 of Coq is based on a generic system for manipulating terms with binding operators due to Chet Murthy. A new proof engine allows the parallel development of partial proofs for independent subgoals. The structure of these proof trees is a mixed representation of derivation trees for the Calculus of Inductive Constructions with abstract syntax trees for the tactics scripts, allowing the navigation in a proof at various levels of details. The proof engine allows generic environment items managed in an object-oriented way. This new architecture, due to C. Murthy, supports several new facilities which make the system easier to extend and to scale up: - User-programmable tactics are allowed - It is possible to separately verify development modules, and to load their compiled images without verifying them again - a quick relocation process allows their fast loading - A generic parsing scheme allows user-definable notations, with a symmetric table-driven pretty-printer - Syntactic definitions allow convenient abbreviations - A limited facility of meta-variables allows the automatic synthesis of certain type expressions, allowing generic notations for e.g. equality, pairing, and existential quantification. In the Fall of 1994, C. Paulin-Mohring replaced the structure of inductively defined types and families by a new structure, allowing the mutually recursive definitions. P. Manoury implemented a translation of recursive definitions into the primitive recursive style imposed by the internal recursion operators, in the style of the ProPre system. C. Muñoz implemented a decision procedure for intuitionistic propositional logic, based on results of R. Dyckhoff. J.C. Filliâtre implemented a decision procedure for first-order logic without contraction, based on results of J. Ketonen and R. Weyhrauch. Finally C. Murthy implemented a library of inversion tactics, relieving the user from tedious definitions of “inversion predicates”. | Rocquencourt, Feb. 1st 1995 | Gérard Huet | Version 1 ~~~~~~~~~ This software is a prototype type checker for a higher-order logical formalism known as the Theory of Constructions, presented in his PhD thesis by Thierry Coquand, with influences from Girard's system F and de Bruijn's Automath. The metamathematical analysis of the system is the PhD work of Thierry Coquand. The software is mostly the work of Gérard Huet. Most of the mathematical examples verified with the software are due to Thierry Coquand. The programming language of the CONSTR software (as it was called at the time) was a version of ML adapted from the Edinburgh LCF system and running on a LISP backend. The main improvements from the original LCF ML were that ML was compiled rather than interpreted (Gérard Huet building on the original translator by Lockwood Morris), and that it was enriched by recursively defined types (work of Guy Cousineau). This ancestor of CAML was used and improved by Larry Paulson for his implementation of Cambridge LCF. Software developments of this prototype occurred from late 1983 to early 1985. Version 1.10 was frozen on December 22nd 1984. It is the version used for the examples in Thierry Coquand's thesis, defended on January 31st 1985. There was a unique binding operator, used both for universal quantification (dependent product) at the level of types and functional abstraction (λ) at the level of terms/proofs, in the manner of Automath. Substitution (λ-reduction) was implemented using de Bruijn's indexes. Version 1.11 was frozen on February 19th, 1985. It is the version used for the examples in the paper: T. Coquand, G. Huet. *Constructions: A Higher Order Proof System for Mechanizing Mathematics* :cite:`CH85`. Christine Paulin joined the team at this point, for her DEA research internship. In her DEA memoir (August 1985) she presents developments for the *lambo* function – :math:`\text{lambo}(f)(n)` computes the minimal :math:`m` such that :math:`f(m)` is greater than :math:`n`, for :math:`f` an increasing integer function, a challenge for constructive mathematics. She also encoded the majority voting algorithm of Boyer and Moore. Version 2 ~~~~~~~~~ The formal system, now renamed as the *Calculus of Constructions*, was presented with a proof of consistency and comparisons with proof systems of Per Martin Löf, Girard, and the Automath family of N. de Bruijn, in the paper: T. Coquand and G. Huet. *The Calculus of Constructions* :cite:`CH88`. An abstraction of the software design, in the form of an abstract machine for proof checking, and a fuller sequence of mathematical developments was presented in: T. Coquand, G. Huet. *Concepts Mathématiques et Informatiques Formalisés dans le Calcul des Constructions* :cite:`CH87`. Version 2.8 was frozen on December 16th, 1985, and served for developing the examples in the above papers. This calculus was then enriched in version 2.9 with a cumulative hierarchy of universes. Universe levels were initially explicit natural numbers. Another improvement was the possibility of automatic synthesis of implicit type arguments, relieving the user of tedious redundant declarations. Christine Paulin wrote an article *Algorithm development in the Calculus of Constructions* :cite:`P86`. Besides *lambo* and *majority*, she presents *quicksort* and a text formatting algorithm. Version 2.13 of the Calculus of Constructions with universes was frozen on June 25th, 1986. A synthetic presentation of type theory along constructive lines with ML algorithms was given by Gérard Huet in his May 1986 CMU course notes *Formal Structures for Computation and Deduction*. Its chapter *Induction and Recursion in the Theory of Constructions* was presented as an invited paper at the Joint Conference on Theory and Practice of Software Development TAPSOFT’87 at Pise in March 1987, and published as *Induction Principles Formalized in the Calculus of Constructions* :cite:`H88`. Version 3 ~~~~~~~~~ This version saw the beginning of proof automation, with a search algorithm inspired from PROLOG and the applicative logic programming programs of the course notes *Formal structures for computation and deduction*. The search algorithm was implemented in ML by Thierry Coquand. The proof system could thus be used in two modes: proof verification and proof synthesis, with tactics such as ``AUTO``. The implementation language was now called CAML, for Categorical Abstract Machine Language. It used as backend the LLM3 virtual machine of Le Lisp by Jérôme Chailloux. The main developers of CAML were Michel Mauny, Ascander Suarez and Pierre Weis. V3.1 was started in the summer of 1986, V3.2 was frozen at the end of November 1986. V3.4 was developed in the first half of 1987. Thierry Coquand held a post-doctoral position in Cambridge University in 1986-87, where he developed a variant implementation in SML, with which he wrote some developments on fixpoints in Scott's domains. Version 4 ~~~~~~~~~ This version saw the beginning of program extraction from proofs, with two varieties of the type ``Prop`` of propositions, indicating constructive intent. The proof extraction algorithms were implemented by Christine Paulin-Mohring. V4.1 was frozen on July 24th, 1987. It had a first identified library of mathematical developments (directory ``exemples``), with libraries ``Logic`` (containing impredicative encodings of intuitionistic logic and algebraic primitives for booleans, natural numbers and list), ``Peano`` developing second-order Peano arithmetic, ``Arith`` defining addition, multiplication, euclidean division and factorial. Typical developments were the Knaster-Tarski theorem and Newman's lemma from rewriting theory. V4.2 was a joint development of a team consisting of Thierry Coquand, Gérard Huet and Christine Paulin-Mohring. A file V4.2.log records the log of changes. It was frozen on September 1987 as the last version implemented in CAML 2.3, and V4.3 followed on CAML 2.5, a more stable development system. V4.3 saw the first top-level of the system. Instead of evaluating explicit quotations, the user could develop his mathematics in a high-level language called the mathematical vernacular (following Automath terminology). The user could develop files in the vernacular notation (with ``.v`` extension) which were now separate from the ``ml`` sources of the implementation. Gilles Dowek joined the team to develop the vernacular language as his DEA internship research. A notion of sticky constant was introduced, in order to keep names of lemmas when local hypotheses of proofs were discharged. This gave a notion of global mathematical environment with local sections. Another significant practical change was that the system, originally developed on the VAX central computer of our lab, was transferred on SUN personal workstations, allowing a level of distributed development. The extraction algorithm was modified, with three annotations ``Pos``, ``Null`` and ``Typ`` decorating the sorts ``Prop`` and ``Type``. Version 4.3 was frozen at the end of November 1987, and was distributed to an early community of users (among those were Hugo Herbelin and Loic Colson). V4.4 saw the first version of (encoded) inductive types. Now natural numbers could be defined as:: [source, coq] Inductive NAT : Prop = O : NAT | Succ : NAT->NAT. These inductive types were encoded impredicatively in the calculus, using a subsystem *rec* due to Christine Paulin. V4.4 was frozen on March 6th 1988. Version 4.5 was the first one to support inductive types and program extraction. Its banner was *Calcul des Constructions avec Réalisations et Synthèse*. The vernacular language was enriched to accommodate extraction commands. The verification engine design was presented as: G. Huet. *The Constructive Engine*. Version 4.5. Invited Conference, 2nd European Symposium on Programming, Nancy, March 88. The final paper, describing the V4.9 implementation, appeared in: A perspective in Theoretical Computer Science, Commemorative Volume in memory of Gift Siromoney, Ed. R. Narasimhan, World Scientific Publishing, 1989. Version 4.5 was demonstrated in June 1988 at the YoP Institute on Logical Foundations of Functional Programming organized by Gérard Huet at Austin, Texas. Version 4.6 was started during the summer of 1988. Its main improvement was the complete rehaul of the proof synthesis engine by Thierry Coquand, with a tree structure of goals. Its source code was communicated to Randy Pollack on September 2nd 1988. It evolved progressively into LEGO, proof system for Luo's formalism of Extended Calculus of Constructions. The discharge tactic was modified by Gérard Huet to allow for inter-dependencies in discharged lemmas. Christine Paulin improved the inductive definition scheme in order to accommodate predicates of any arity. Version 4.7 was started on September 6th, 1988. This version starts exploiting the CAML notion of module in order to improve the modularity of the implementation. Now the term verifier is identified as a proper module Machine, which the structure of its internal data structures being hidden and thus accessible only through the legitimate operations. This machine (the constructive engine) was the trusted core of the implementation. The proof synthesis mechanism was a separate proof term generator. Once a complete proof term was synthesized with the help of tactics, it was entirely re-checked by the engine. Thus there was no need to certify the tactics, and the system took advantage of this fact by having tactics ignore the universe levels, universe consistency check being relegated to the final type checking pass. This induced a certain puzzlement in early users who saw, after a successful proof search, their ``QED`` followed by silence, followed by a failure message due to a universe inconsistency… The set of examples comprise set theory experiments by Hugo Herbelin, and notably the Schroeder-Bernstein theorem. Version 4.8, started on October 8th, 1988, saw a major re-implementation of the abstract syntax type ``constr``, separating variables of the formalism and metavariables denoting incomplete terms managed by the search mechanism. A notion of level (with three values ``TYPE``, ``OBJECT`` and ``PROOF``) is made explicit and a type judgement clarifies the constructions, whose implementation is now fully explicit. Structural equality is speeded up by using pointer equality, yielding spectacular improvements. Thierry Coquand adapts the proof synthesis to the new representation, and simplifies pattern matching to first-order predicate calculus matching, with important performance gain. A new representation of the universe hierarchy is then defined by Gérard Huet. Universe levels are now implemented implicitly, through a hidden graph of abstract levels constrained with an order relation. Checking acyclicity of the graph insures well-foundedness of the ordering, and thus consistency. This was documented in a memo *Adding Type:Type to the Calculus of Constructions* which was never published. The development version is released as a stable 4.8 at the end of 1988. Version 4.9 is released on March 1st 1989, with the new "elastic" universe hierarchy. The spring of 1989 saw the first attempt at documenting the system usage, with a number of papers describing the formalism: - *Metamathematical Investigations of a Calculus of Constructions*, by Thierry Coquand :cite:`C90`, - *Inductive definitions in the Calculus of Constructions*, by Christine Paulin-Mohrin, - *Extracting Fω's programs from proofs in the Calculus of Constructions*, by Christine Paulin-Mohring* :cite:`P89`, - *The Constructive Engine*, by Gérard Huet :cite:`H89`, as well as a number of user guides: - *A short user's guide for the Constructions*, Version 4.10, by Gérard Huet - *A Vernacular Syllabus*, by Gilles Dowek. - *The Tactics Theorem Prover, User's guide*, Version 4.10, by Thierry Coquand. Stable V4.10, released on May 1st, 1989, was then a mature system, distributed with CAML V2.6. In the mean time, Thierry Coquand and Christine Paulin-Mohring had been investigating how to add native inductive types to the Calculus of Constructions, in the manner of Per Martin-Löf's Intuitionistic Type Theory. The impredicative encoding had already been presented in: F. Pfenning and C. Paulin-Mohring. *Inductively defined types in the Calculus of Constructions* :cite:`PP90`. An extension of the calculus with primitive inductive types appeared in: T. Coquand and 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 and Properties* :cite:`P93`. The last version of CONSTR is Version 4.11, which was last distributed in the spring of 1990. It was demonstrated at the first workshop of the European Basic Research Action Logical Frameworks In Sophia Antipolis in May 1990. 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 the new stand-alone implementation of ML called Caml-light. In 1990 many changes occurred. Thierry Coquand left for Chalmers 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 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. Chetan Murthy joined the team in 1991 and became the main software architect of Version 5. He completely rehauled the implementation for efficiency. Versions 5.6 and 5.8 were major distributed versions, with complete documentation and a library of users' developments. The use of the RCS revision control system, and systematic ChangeLog files, allow a more precise tracking of the software developments. | September 2015 + | Thierry Coquand, Gérard Huet and Christine Paulin-Mohring. | Versions 6 ---------- Version 6.1 ~~~~~~~~~~~ The present version 6.1 of Coq is based on the V5.10 architecture. It was ported to the new language Objective Caml by Bruno Barras. The underlying framework has slightly changed and allows more conversions between sorts. The new version provides powerful tools for easier developments. Cristina Cornes designed an extension of the Coq syntax to allow definition of terms using a powerful pattern matching analysis in the style of ML programs. Amokrane Saïbi wrote a mechanism to simulate inheritance between types families extending a proposal by Peter Aczel. He also developed a mechanism to automatically compute which arguments of a constant may be inferred by the system and consequently do not need to be explicitly written. Yann Coscoy designed a command which explains a proof term using natural language. Pierre Crégut built a new tactic which solves problems in quantifier-free Presburger Arithmetic. Both functionalities have been integrated to the Coq system by Hugo Herbelin. Samuel Boutin designed a tactic for simplification of commutative rings using a canonical set of rewriting rules and equality modulo associativity and commutativity. Finally the organisation of the Coq distribution has been supervised by Jean-Christophe Filliâtre with the help of Judicaël Courant and Bruno Barras. | Lyon, Nov. 18th 1996 | Christine Paulin | Version 6.2 ~~~~~~~~~~~ In version 6.2 of Coq, the parsing is done using camlp4, a preprocessor and pretty-printer for CAML designed by Daniel de Rauglaudre at INRIA. Daniel de Rauglaudre made the first adaptation of Coq for camlp4, this work was continued by Bruno Barras who also changed the structure of Coq abstract syntax trees and the primitives to manipulate them. The result of these changes is a faster parsing procedure with greatly improved syntax-error messages. The user-interface to introduce grammar or pretty-printing rules has also changed. Eduardo Giménez redesigned the internal tactic libraries, giving uniform names to Caml functions corresponding to Coq tactic names. Bruno Barras wrote new, more efficient reduction functions. Hugo Herbelin introduced more uniform notations in the Coq specification language: the definitions by fixpoints and pattern matching have a more readable syntax. Patrick Loiseleur introduced user-friendly notations for arithmetic expressions. New tactics were introduced: Eduardo Giménez improved the mechanism to introduce macros for tactics, and designed special tactics for (co)inductive definitions; Patrick Loiseleur designed a tactic to simplify polynomial expressions in an arbitrary commutative ring which generalizes the previous tactic implemented by Samuel Boutin. Jean-Christophe Filliâtre introduced a tactic for refining a goal, using a proof term with holes as a proof scheme. David Delahaye designed the tool to search an object in the library given its type (up to isomorphism). Henri Laulhère produced the Coq distribution for the Windows environment. Finally, Hugo Herbelin was the main coordinator of the Coq documentation with principal contributions by Bruno Barras, David Delahaye, Jean-Christophe Filliâtre, Eduardo Giménez, Hugo Herbelin and Patrick Loiseleur. | Orsay, May 4th 1998 | Christine Paulin | Version 6.3 ~~~~~~~~~~~ The main changes in version V6.3 were the introduction of a few new tactics and the extension of the guard condition for fixpoint definitions. B. Barras extended the unification algorithm to complete partial terms and fixed various tricky bugs related to universes. D. Delahaye developed the ``AutoRewrite`` tactic. He also designed the new behavior of ``Intro`` and provided the tacticals ``First`` and ``Solve``. J.-C. Filliâtre developed the ``Correctness`` tactic. \E. Giménez extended the guard condition in fixpoints. H. Herbelin designed the new syntax for definitions and extended the ``Induction`` tactic. P. Loiseleur developed the ``Quote`` tactic and the new design of the ``Auto`` tactic, he also introduced the index of errors in the documentation. C. Paulin wrote the ``Focus`` command and introduced the reduction functions in definitions, this last feature was proposed by J.-F. Monin from CNET Lannion. | Orsay, Dec. 1999 | Christine Paulin | Versions 7 ---------- Summary of changes ~~~~~~~~~~~~~~~~~~ The version V7 is a new implementation started in September 1999 by Jean-Christophe Filliâtre. This is a major revision with respect to the internal architecture of the system. The Coq version 7.0 was distributed in March 2001, version 7.1 in September 2001, version 7.2 in January 2002, version 7.3 in May 2002 and version 7.4 in February 2003. Jean-Christophe Filliâtre designed the architecture of the new system. He introduced a new representation for environments and wrote a new kernel for type checking terms. His approach was to use functional data-structures in order to get more sharing, to prepare the addition of modules and also to get closer to a certified kernel. Hugo Herbelin introduced a new structure of terms with local definitions. He introduced “qualified” names, wrote a new pattern matching compilation algorithm and designed a more compact algorithm for checking the logical consistency of universes. He contributed to the simplification of Coq internal structures and the optimisation of the system. He added basic tactics for forward reasoning and coercions in patterns. David Delahaye introduced a new language for tactics. General tactics using pattern matching on goals and context can directly be written from the Coq toplevel. He also provided primitives for the design of user-defined tactics in Caml. Micaela Mayero contributed the library on real numbers. Olivier Desmettre extended this library with axiomatic trigonometric functions, square, square roots, finite sums, Chasles property and basic plane geometry. Jean-Christophe Filliâtre and Pierre Letouzey redesigned a new extraction procedure from Coq terms to Caml or Haskell programs. This new extraction procedure, unlike the one implemented in previous version of Coq is able to handle all terms in the Calculus of Inductive Constructions, even involving universes and strong elimination. P. Letouzey adapted user contributions to extract ML programs when it was sensible. Jean-Christophe Filliâtre wrote ``coqdoc``, a documentation tool for Coq libraries usable from version 7.2. Bruno Barras improved the efficiency of the reduction algorithm and the confidence level in the correctness of Coq critical type checking algorithm. Yves Bertot designed the ``SearchPattern`` and ``SearchRewrite`` tools and the support for the pcoq interface (http://www-sop.inria.fr/lemme/pcoq/). Micaela Mayero and David Delahaye introduced Field, a decision tactic for commutative fields. Christine Paulin changed the elimination rules for empty and singleton propositional inductive types. Loïc Pottier developed Fourier, a tactic solving linear inequalities on real numbers. Pierre Crégut developed a new, reflection-based version of the Omega decision procedure. Claudio Sacerdoti Coen designed an XML output for the Coq modules to be used in the Hypertextual Electronic Library of Mathematics (HELM cf http://www.cs.unibo.it/helm). A library for efficient representation of finite maps using binary trees contributed by Jean Goubault was integrated in the basic theories. Pierre Courtieu developed a command and a tactic to reason on the inductive structure of recursively defined functions. Jacek Chrząszcz designed and implemented the module system of Coq whose foundations are in Judicaël Courant’s PhD thesis. The development was coordinated by C. Paulin. Many discussions within the Démons team and the LogiCal project influenced significantly the design of Coq especially with J. Courant, J. Duprat, J. Goubault, A. Miquel, C. Marché, B. Monate and B. Werner. Intensive users suggested improvements of the system : Y. Bertot, L. Pottier, L. Théry, P. Zimmerman from INRIA, C. Alvarado, P. Crégut, J.-F. Monin from France Telecom R & D. | Orsay, May. 2002 | Hugo Herbelin & Christine Paulin | Details of changes in 7.0 and 7.1 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Notes: - items followed by (**) are important sources of incompatibilities - items followed by (*) may exceptionally be sources of incompatibilities - items followed by (+) have been introduced in version 7.0 Main novelties ^^^^^^^^^^^^^^ 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) - New high-level tactic language (see chapter 10) - Improved search facilities (see section 5.2) - New extraction algorithm managing the Type level (see chapter 17) - New rewriting tactic for arbitrary equalities (see chapter 19) - New tactic Field to decide equalities on commutative fields (see 7.11) - New tactic Fourier to solve linear inequalities on reals numbers (see 7.11) - New tactics for induction/case analysis in "natural" style (see 7.7) - Deep restructuration of the code (safer, simpler and more efficient) - Export of theories to XML for publishing and rendering purposes (see http://www.cs.unibo.it/helm) Details of changes ^^^^^^^^^^^^^^^^^^ Language: new "let-in" construction *********************************** - New construction for local definitions (let-in) with syntax [x:=u]t (*)(+) - Local definitions allowed in Record (a.k.a. record à la Randy Pollack) Language: long names ******************** - Each construction has a unique absolute names built from a base 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 library and "PolyList" means it is in the file Polylist) (+) - Constructions can be referred by their base name, or, in case of conflict, by a "qualified" name, where the base name is prefixed by the module name (and possibly by a directory name, and so on). A fully qualified name is an absolute name which always refer to the construction it denotes (to preserve the visibility of all constructions, no conflict is allowed for an absolute name) (+) - Long names are available for modules with the possibility of using the directory name as a component of the module full name (with option -R to coqtop and coqc, or command Add LoadPath) (+) - Improved conflict resolution strategy (the Unix PATH model), allowing more constructions to be referred just by their base name Language: miscellaneous *********************** - The names of variables for Record projections _and_ for induction principles (e.g. sum_ind) is now based on the first letter of their type (main source of incompatibility) (**)(+) - Most typing errors have now a precise location in the source (+) - Slightly different mechanism to solve "?" (*)(+) - More arguments may be considered implicit at section closing (*)(+) - Bug with identifiers ended by a number greater than 2^30 fixed (+) - New visibility discipline for Remark, Fact and Local: Remark's and Fact's now survive at the end of section, but are only accessible using a qualified names as soon as their strength expires; Local's disappear and are moved into local definitions for each construction persistent at section closing Language: Cases *************** - Cases no longer considers aliases inferable from dependencies in types (*)(+) - A redundant clause in Cases is now an error (*) Reduction ********* - New reduction flags "Zeta" and "Evar" in Eval Compute, for inlining of local definitions and instantiation of existential variables - Delta reduction flag does not perform Zeta and Evar reduction any more (*) - 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 constants (*) New tactics *********** - New set of tactics to deal with types equipped with specific equalities (a.k.a. Setoids, e.g. nat equipped with eq_nat) [by C. Renard] - New tactic Assert, similar to Cut but expected to be more user-friendly - New tactic NewDestruct and NewInduction intended to replace Elim and Induction, Case and Destruct in a more user-friendly way (see restrictions in the reference manual) - New tactic ROmega: an experimental alternative (based on reflexion) to Omega [by P. Crégut] - New tactic language Ltac (see reference manual) (+) - New versions of Tauto and Intuition, fully rewritten in the new Ltac language; they run faster and produce more compact proofs; Tauto is fully compatible but, in exchange of a better uniformity, Intuition is slightly weaker (then use Tauto instead) (**)(+) - New tactic Field to decide equalities on commutative fields (as a special case, it works on real numbers) (+) - New tactic Fourier to solve linear inequalities on reals numbers [by L. Pottier] (+) - New tactics dedicated to real numbers: DiscrR, SplitRmult, SplitAbsolu (+) Changes in existing tactics *************************** - Reduction tactics in local definitions apply only to the body - New syntax of the form "Compute in Type of H." to require a reduction on the types of local definitions - Inversion, Injection, Discriminate, ... apply also on the quantified premises of a goal (using the "Intros until" syntax) - Decompose has been fixed but hypotheses may get different names (*)(+) - Tauto now manages uniformly hypotheses and conclusions of the form ``t=t`` which all are considered equivalent to ``True``. Especially, Tauto now solves goals of the form ``H : ~ t = t |- A``. - The "Let" tactic has been renamed "LetTac" and is now based on the primitive "let-in" (+) - Elim can no longer be used with an elimination schema different from the one defined at definition time of the inductive type. To overload an elimination schema, use "Elim using " (*)(+) - Simpl no longer unfolds the recursive calls of a mutually defined fixpoint (*)(+) - Intro now fails if the hypothesis name already exists (*)(+) - "Require Prolog" is no longer needed (i.e. it is available by default) (*)(+) - Unfold now fails on a non-unfoldable identifier (*)(+) - Unfold also applies on definitions of the local context - AutoRewrite now deals only with the main goal and it is the purpose of Hint Rewrite to deal with generated subgoals (+) - Redundant or incompatible instantiations in Apply ... with ... are now correctly managed (+) Efficiency ********** - Excessive memory uses specific to V7.0 fixed - Sizes of .vo files vary a lot compared to V6.3 (from -30% to +300% depending on the developments) - An improved reduction strategy for lazy evaluation - A more economical mechanism to ensure logical consistency at the Type level; warning: this is experimental and may produce "universes" anomalies (please report) Concrete syntax of constructions ******************************** - Only identifiers starting with "_" or a letter, and followed by letters, digits, "_" or "'" are allowed (e.g. "$" and "@" are no longer allowed) (*) - A multiple binder like (a:A)(a,b:(P a))(Q a) is no longer parsed as (a:A)(a0:(P a))(b:(P a))(Q a0) but as (a:A)(a0:(P a))(b:(P a0))(Q a0) (*)(+) - A dedicated syntax has been introduced for Reals (e.g ``3+1/x``) (+) - Pretty-printing of Infix notations fixed. (+) Parsing and grammar extension ***************************** - More constraints when writing ast - "{...}" and the macros $LIST, $VAR, etc. now expect a metavariable (an identifier starting with $) (*) - identifiers should starts with a letter or "_" and be followed by letters, digits, "_" or "'" (other characters are still supported but it is not advised to use them) (*)(+) - Entry "command" in "Grammar" and quotations (<<...>> stuff) is renamed "constr" as in "Syntax" (+) - New syntax "[" sentence_1 ... sentence_n"]." to group sentences (useful for Time and to write grammar rules abbreviating several commands) (+) - The default parser for actions in the grammar rules (and for patterns in the pretty-printing rules) is now the one associated with the grammar (i.e. vernac, tactic or constr); no need then for quotations as in <:vernac:<...>>; to return an "ast", the grammar must be explicitly typed with tag ": ast" or ": ast list", or if a syntax rule, by using <<...>> in the patterns (expression inside these angle brackets are parsed as "ast"); for grammars other than vernac, tactic or constr, you may explicitly type the action with tags ": constr", ": tactic", or ":vernac" (**)(+) - Interpretation of names in Grammar rule is now based on long names, which allows to avoid problems (or sometimes tricks;) related to overloaded names (+) New commands ************ - New commands "Print XML All", "Show XML Proof", ... to show or export theories to XML to be used with Helm's publishing and rendering tools (see http://www.cs.unibo.it/helm) (by Claudio Sacerdoti Coen) (+) - New commands to manually set implicit arguments (+) - "Implicits ident." to activate the implicit arguments mode just for ident - "Implicits ident [num1 num2 ...]." to explicitly give which arguments have to be considered as implicit - New SearchPattern/SearchRewrite (by Yves Bertot) (+) - New commands "Debug on"/"Debug off" to activate/deactivate the tactic language debugger (+) - New commands to map physical paths to logical paths (+) - Add LoadPath physical_dir as logical_dir - Add Rec LoadPath physical_dir as logical_dir Changes in existing commands **************************** - Generalization of the usage of qualified identifiers in tactics and commands about globals, e.g. Decompose, Eval Delta; Hints Unfold, Transparent, Require - Require synchronous with Reset; Require's scope stops at Section ending (*) - For a module indirectly loaded by a "Require" but not exported, the command "Import module" turns the constructions defined in the module accessible by their short name, and activates the Grammar, Syntax, Hint, ... declared in the module (+) - The scope of the "Search" command can be restricted to some modules (+) - Final dot in command (full stop/period) must be followed by a blank (newline, tabulation or whitespace) (+) - Slight restriction of the syntax for Cbv Delta: if present, option [-myconst] must immediately follow the Delta keyword (*)(+) - SearchIsos currently not supported - Add ML Path is now implied by Add LoadPath (+) - New names for the following commands (+) AddPath -> Add LoadPath Print LoadPath -> Print LoadPath DelPath -> Remove LoadPath AddRecPath -> Add Rec LoadPath Print Path -> Print Coercion Paths Implicit Arguments On -> Set Implicit Arguments Implicit Arguments Off -> Unset Implicit Arguments Begin Silent -> Set Silent End Silent -> Unset Silent. Tools ***** - coqtop (+) - Two executables: coqtop.byte and coqtop.opt (if supported by the platform) - coqtop is a link to the more efficient executable (coqtop.opt if present) - option -full is obsolete (+) - do_Makefile renamed into coq_makefile (+) - New option -R to coqtop and coqc to map a physical directory to a logical one (+) - coqc no longer needs to create a temporary file - No more warning if no initialization file .coqrc exists Extraction ********** - New algorithm for extraction able to deal with "Type" (+) (by J.-C. Filliâtre and P. Letouzey) Standard library **************** - New library on maps on integers (IntMap, contributed by Jean Goubault) - New lemmas about integer numbers [ZArith] - New lemmas and a "natural" syntax for reals [Reals] (+) - Exc/Error/Value renamed into Option/Some/None (*) New user contributions ********************** - Constructive complex analysis and the Fundamental Theorem of Algebra [FTA] (Herman Geuvers, Freek Wiedijk, Jan Zwanenburg, Randy Pollack, Henk Barendregt, Nijmegen) - A new axiomatization of ZFC set theory [Functions_in_ZFC] (C. Simpson, Sophia-Antipolis) - Basic notions of graph theory [GRAPHS-BASICS] (Jean Duprat, Lyon) - A library for floating-point numbers [Float] (Laurent Théry, Sylvie Boldo, Sophia-Antipolis) - Formalisation of CTL and TCTL temporal logic [CtlTctl] (Carlos Daniel Luna,Montevideo) - Specification and verification of the Railroad Crossing Problem in CTL and TCTL [RailroadCrossing] (Carlos Daniel Luna,Montevideo) - P-automaton and the ABR algorithm [PAutomata] (Christine Paulin, Emmanuel Freund, Orsay) - Semantics of a subset of the C language [MiniC] (Eduardo Giménez, Emmanuel Ledinot, Suresnes) - Correctness proofs of the following imperative algorithms: Bresenham line drawing algorithm [Bresenham], Marché's minimal edition distance algorithm [Diff] (Jean-Christophe Filliâtre, Orsay) - Correctness proofs of Buchberger's algorithm [Buchberger] and RSA cryptographic algorithm [Rsa] (Laurent Théry, Sophia-Antipolis) - Correctness proof of Stalmarck tautology checker algorithm [Stalmarck] (Laurent Théry, Pierre Letouzey, Sophia-Antipolis) Details of changes in 7.2 ~~~~~~~~~~~~~~~~~~~~~~~~~ Language - Automatic insertion of patterns for local definitions in the type of the constructors of an inductive types (for compatibility with V6.3 let-in style) - Coercions allowed in Cases patterns - New declaration "Canonical Structure id = t : I" to help resolution of equations of the form (proj ?)=a; if proj(e)=a then a is canonically equipped with the remaining fields in e, i.e. ? is instantiated by e Tactics - New tactic "ClearBody H" to clear the body of definitions in local context - New tactic "Assert H := c" for forward reasoning - Slight improvement in naming strategy for NewInduction/NewDestruct - Intuition/Tauto do not perform useless unfolding and work up to conversion Extraction (details in plugins/extraction/CHANGES or documentation) - Syntax changes: there are no more options inside the extraction commands. New commands for customization and options have been introduced instead. - More optimizations on extracted code. - Extraction tests are now embedded in 14 user contributions. Standard library - In [Relations], Rstar.v and Newman.v now axiom-free. - In [Sets], Integers.v now based on nat - In [Arith], more lemmas in Min.v, new file Max.v, tail-recursive plus and mult added to Plus.v and Mult.v respectively - New directory [Sorting] with a proof of heapsort (dragged from 6.3.1 lib) - In [Reals], more lemmas in Rbase.v, new lemmas on square, square root and trigonometric functions (R_sqr.v - Rtrigo.v); a complementary approach and new theorems about continuity and derivability in Ranalysis.v; some properties in plane geometry such as translation, rotation or similarity in Rgeom.v; finite sums and Chasles property in Rsigma.v Bugs - Confusion between implicit args of locals and globals of same base name fixed - Various incompatibilities wrt inference of "?" in V6.3.1 fixed - Implicits in infix section variables bug fixed - Known coercions bugs fixed - Apply "universe anomaly" bug fixed - NatRing now working - "Discriminate 1", "Injection 1", "Simplify_eq 1" now working - NewInduction bugs with let-in and recursively dependent hypotheses fixed - Syntax [x:=t:T]u now allowed as mentioned in documentation - Bug with recursive inductive types involving let-in fixed - Known pattern-matching bugs fixed - Known Cases elimination predicate bugs fixed - Improved errors messages for pattern-matching and projections - Better error messages for ill-typed Cases expressions 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 for a description of the main changes in the interface files of V7.2) - New behavior of Intuition/Tauto may exceptionally lead to incompatibilities Details of changes in 7.3 ~~~~~~~~~~~~~~~~~~~~~~~~~ Language - Slightly improved compilation of pattern-matching (slight source of incompatibilities) - Record's now accept anonymous fields "_" which does not build projections - Changes in the allowed elimination sorts for certain class of inductive definitions : an inductive definition without constructors of Sort Prop can be eliminated on sorts Set and Type A "singleton" inductive definition (one constructor with arguments in the sort Prop like conjunction of two propositions or equality) can be eliminated directly on sort Type (In V7.2, only the sorts Prop and Set were allowed) Tactics - New tactic "Rename x into y" for renaming hypotheses - New tactics "Pose x:=u" and "Pose u" to add definitions to local context - Pattern now working on partially applied subterms - Ring no longer applies irreversible congruence laws of mult but better applies congruence laws of plus (slight source of incompatibilities). - Field now accepts terms to be simplified as arguments (as for Ring). This extension has been also implemented using the toplevel tactic language. - Intuition does no longer unfold constants except "<->" and "~". It can be parameterized by a tactic. It also can introduce dependent 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 - Better simplification and discrimination made by Inversion (source of incompatibilities) Bugs - "Intros H" now working like "Intro H" trying first to reduce if not a product - Forward dependencies in Cases now taken into account - Known bugs related to Inversion and let-in's fixed - Bug unexpected Delta with let-in now fixed Extraction (details in plugins/extraction/CHANGES or documentation) - Signatures of extracted terms are now mostly expunged from dummy arguments. - Haskell extraction is now operational (tested & debugged). Standard library - Some additions in [ZArith]: three files (Zcomplements.v, Zpower.v and Zlogarithms.v) moved from plugins/omega in order to be more visible, one Zsgn function, more induction principles (Wf_Z.v and tail of Zcomplements.v), one more general Euclid theorem - Peano_dec.v and Compare_dec.v now part of Arith.v Tools - new option -dump-glob to coqtop to dump globalizations (to be used by the new documentation tool coqdoc; see http://www.lri.fr/~filliatr/coqdoc) User Contributions - CongruenceClosure (congruence closure decision procedure) [Pierre Corbineau, ENS Cachan] - MapleMode (an interface to embed Maple simplification procedures over rational fractions in Coq) [David Delahaye, Micaela Mayero, Chalmers University] - Presburger: A formalization of Presburger's algorithm [Laurent Thery, INRIA Sophia Antipolis] - Chinese has been rewritten using Z from ZArith as datatype ZChinese is the new version, Chinese the obsolete one [Pierre Letouzey, LRI Orsay] Incompatibilities - Ring: exceptional incompatibilities (1 above 650 in submitted user contribs, leading to a simplification) - Intuition: does not unfold any definition except "<->" and "~" - Cases: removal of some extra Cases in configurations of the form "Cases ... of C _ => ... | _ D => ..." (effects on 2 definitions of submitted user contributions necessitating the removal of now superfluous proof steps in 3 different proofs) - Match Context, in case of incompatibilities because of a now non trapped error (e.g. Not_found or Failure), use instead tactic Fail to force Match Context trying the next clause - Inversion: better simplification and discrimination may occasionally lead to less subgoals and/or hypotheses and different naming of hypotheses - Unification done by Apply/Elim has been changed and may exceptionally lead to incompatible instantiations - Peano_dec.v and Compare_dec.v parts of Arith.v make Auto more powerful if these files were not already required (1 occurrence of this in submitted user contribs) Changes in 7.3.1 ^^^^^^^^^^^^^^^^ Bug fixes - Corrupted Field tactic and Match Context tactic construction fixed - Checking of names already existing in Assert added (#1386) - Invalid argument bug in Exact tactic solved (#1387) - Colliding bound names bug fixed (#1412) - Wrong non-recursivity test for Record fixed (#1394) - Out of memory/seg fault bug related to parametric inductive fixed (#1404) - Setoid_replace/Setoid_rewrite bug wrt "==" fixed Misc - Ocaml version >= 3.06 is needed to compile Coq from sources - Simplification of fresh names creation strategy for Assert, Pose and LetTac (#1402) Details of changes in 7.4 ~~~~~~~~~~~~~~~~~~~~~~~~~ Symbolic notations - Introduction of a notion of scope gathering notations in a consistent set; a notation sets has been developed for nat, Z and R (undocumented) - New command "Notation" for declaring notations simultaneously for parsing and printing (see chap 10 of the reference manual) - Declarations with only implicit arguments now handled (e.g. the argument of nil can be set implicit; use !nil to refer to nil without arguments) - "Print Scope sc" and "Locate ntn" allows to know to what expression a notation is bound - New defensive strategy for printing or not implicit arguments to ensure re-type-checkability of the printed term - In Grammar command, the only predefined non-terminal entries are ident, global, constr and pattern (e.g. nvar, numarg disappears); the only allowed grammar types are constr and pattern; ast and ast list are no longer supported; some incompatibilities in Grammar: when a syntax is a initial segment of an other one, Grammar does not work, use Notation Library - Lemmas in Set from Compare_dec.v (le_lt_dec, ...) and Wf_nat.v (lt_wf_rec, ...) are now transparent. This may be source of incompatibilities. - Syntactic Definitions Fst, Snd, Ex, All, Ex2, AllT, ExT, ExT2, ProjS1, ProjS2, Error, Value and Except are turned to notations. They now must be applied (incompatibilities only in unrealistic cases). - More efficient versions of Zmult and times (30% faster) - Reals: the library is now divided in 6 parts (Rbase, Rfunctions, SeqSeries, Rtrigo, Ranalysis, Integration). New tactics: Sup and RCompute. See Reals.v for details. Modules - Beta version, see doc chap 2.5 for commands and chap 5 for theory Language - Inductive definitions now accept ">" in constructor types to declare the corresponding constructor as a coercion. - Idem for assumptions declarations and constants when the type is mentioned. - The "Coercion" and "Canonical Structure" keywords now accept the same syntax as "Definition", i.e. "hyps :=c (:t)?" or "hyps :t". - Theorem-like declaration now accepts the syntax "Theorem thm [x:t;...] : u". - Remark's and Fact's now definitively behave as Theorem and Lemma: when sections are closed, the full name of a Remark or a Fact has no longer a section part (source of incompatibilities) - Opaque Local's (i.e. built by tactics and ended by Qed), do not survive section closing any longer; as a side-effect, Opaque Local's now appear in the local context of proofs; their body is hidden though (source of incompatibilities); use one of Remark/Fact/Lemma/Theorem instead to simulate the old behavior of Local (the section part of the name is not kept though) ML tactics and commands - "Grammar tactic" and "Grammar vernac" of type "ast" are no longer supported (only "Grammar tactic simple_tactic" of type "tactic" remains available). - Concrete syntax for ML written commands and tactics is now declared at ML level using camlp4 macros TACTIC EXTEND et VERNAC COMMAND EXTEND. - "Check n c" now "n:Check c", "Eval n ..." now "n:Eval ..." - ``Proof with T`` (no documentation) - SearchAbout id - prints all theorems which contain id in their type Tactic definitions - Static globalisation of identifiers and global references (source of incompatibilities, especially, Recursive keyword is required for mutually recursive definitions). - New evaluation semantics: no more partial evaluation at definition time; evaluation of all Tactic/Meta Definition, even producing terms, expect a proof context to be evaluated (especially "()" is no longer needed). - Debugger now shows the nesting level and the reasons of failure Tactics - Equality tactics (Rewrite, Reflexivity, Symmetry, Transitivity) now understand JM equality - Simpl and Change now apply to subterms also - "Simpl f" reduces subterms whose :term:`head constant` is f - Double Induction now referring to hypotheses like "Intros until" - "Inversion" now applies also on quantified hypotheses (naming as for Intros until) - NewDestruct now accepts terms with missing hypotheses - NewDestruct and NewInduction now accept user-provided elimination scheme - NewDestruct and NewInduction now accept user-provided introduction names - Omega could solve goals such as ``~x=y`` but failed when the hypothesis was unfolded to ``x < y -> False``. This is fixed. In addition, it can also recognize 'False' in the hypothesis and use it to solve the goal. - Coercions now handled in "with" bindings - "Subst x" replaces all occurrences of x by t in the goal and hypotheses when an hypothesis x=t or x:=t or t=x exists - Fresh names for Assert and Pose now based on collision-avoiding Intro naming strategy (exceptional source of incompatibilities) - LinearIntuition (no documentation) - Unfold expects a correct evaluable argument - Clear expects existing hypotheses 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. Proof rendering in natural language - Export of theories to XML for publishing and rendering purposes now includes proof-trees (see http://www.cs.unibo.it/helm) Miscellaneous - Printing Coercion now used through the standard keywords Set/Add, Test, Print - "Print Term id" is an alias for "Print id" - New switch "Unset/Set Printing Symbols" to control printing of symbolic notations - Two new variants of implicit arguments are available + ``Unset``/``Set Contextual Implicits`` tells to consider implicit also the arguments inferable from the context (e.g. for nil or refl_eq) + ``Unset``/``Set Strict Implicits`` tells to consider implicit only the arguments that are inferable in any case (i.e. arguments that occurs as argument of rigid constants in the type of the remaining arguments; e.g. the witness of an existential is not strict since it can vanish when applied to a predicate which does not use its argument) Incompatibilities - "Grammar tactic ... : ast" and "Grammar vernac ... : ast" are no longer supported, use TACTIC EXTEND and VERNAC COMMAND EXTEND on the ML-side instead - Transparency of le_lt_dec and co (leads to some simplification in proofs; in some cases, incompatibilites is solved by declaring locally opaque the relevant constant) - Opaque Local do not now survive section closing (rename them into Remark/Lemma/... to get them still surviving the sections; this renaming allows also to solve incompatibilites related to now forbidden calls to the tactic Clear) - Remark and Fact have no longer (very) long names (use Local instead in case of name conflict) Bugs - Improved localisation of errors in Syntactic Definitions - Induction principle creation failure in presence of let-in fixed (#1459) - Inversion bugs fixed (#1427 and #1437) - Omega bug related to Set fixed (#1384) - Type-checking inefficiency of nested destructuring let-in fixed (#1435) - Improved handling of let-in during holes resolution phase (#1460) Efficiency - Implementation of a memory sharing strategy reducing memory requirements by an average ratio of 3. coq-8.20.0/doc/sphinx/index.html.rst000066400000000000000000000012241466560755400172660ustar00rootroot00000000000000========================== Introduction and Contents ========================== .. include:: introduction.rst Contents -------- .. toctree:: self .. toctree:: :caption: Specification language language/core/index language/extensions/index .. toctree:: :caption: Proofs proofs/writing-proofs/index proofs/automatic-tactics/index proofs/creating-tactics/index .. toctree:: :caption: Using Coq using/libraries/index using/tools/index .. toctree:: :caption: Appendix appendix/history-and-changes/index appendix/indexes/index zebibliography .. No entries yet * :index:`thmindex` .. include:: license.rst coq-8.20.0/doc/sphinx/index.latex.rst000066400000000000000000000012001466560755400174310ustar00rootroot00000000000000========================== The Coq Reference Manual ========================== ------------ Introduction ------------ .. include:: introduction.rst .. include:: license.rst ---------------------- Specification language ---------------------- .. toctree:: language/core/index language/extensions/index ------ Proofs ------ .. toctree:: proofs/writing-proofs/index proofs/automatic-tactics/index proofs/creating-tactics/index --------- Using Coq --------- .. toctree:: using/libraries/index using/tools/index -------- Appendix -------- .. toctree:: appendix/history-and-changes/index zebibliography coq-8.20.0/doc/sphinx/introduction.rst000066400000000000000000000067261466560755400177510ustar00rootroot00000000000000This 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 used in a number of flagship verification projects, including the `CompCert verified C compiler `_, and has served to verify the proof of the `four color theorem `_ (among many other mathematical formalizations). Users generate proofs by entering a series of tactics that constitute steps in the proof. There are many built-in tactics, some of which are elementary, while others implement complex decision procedures (such as :tacn:`lia`, a decision procedure for linear integer arithmetic). :ref:`Ltac ` and its planned replacement, :ref:`Ltac2 `, provide languages to define new tactics by 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. 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 software libraries. 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 allows to define programs and state mathematical theorems. :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 proof mode**, the central feature of Coq. :ref:`writing-proofs` introduces this interactive 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.** :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. - 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 :ref:`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. .. only:: html The full table of contents is presented below: coq-8.20.0/doc/sphinx/language/000077500000000000000000000000001466560755400162465ustar00rootroot00000000000000coq-8.20.0/doc/sphinx/language/cic.rst000066400000000000000000000406341466560755400175450ustar00rootroot00000000000000Typing rules ==================================== The underlying formal language of Coq is a :gdef:`Calculus of Inductive Constructions` (|Cic|) whose inference rules are presented in this chapter. The history of this formalism as well as pointers to related work are provided in a separate chapter; see :ref:`history`. .. _The-terms: The terms ------------- The expressions of the |Cic| are *terms* and all terms have a *type*. There are types for functions (or programs), there are atomic types (especially datatypes)... but also types for proofs and types for the types themselves. Especially, any object handled in the formalism must belong to a type. For instance, universal quantification is relative to a type and takes the form “*for all x of type* :math:`T`, :math:`P`”. The expression “:math:`x` *of type* :math:`T`” is written “:math:`x:T`”. Informally, “:math:`x:T`” can be thought as “:math:`x` *belongs to* :math:`T`”. Terms are built from sorts, variables, constants, abstractions, applications, local definitions, and products. From a syntactic point of view, types cannot be distinguished from terms, except that they cannot start by an abstraction or a constructor. More precisely the language of the *Calculus of Inductive Constructions* is built from the following rules. #. the sorts :math:`\SProp`, :math:`\Prop`, :math:`\Set`, :math:`\Type(i)` are terms. #. variables, hereafter ranged over by letters :math:`x`, :math:`y`, etc., are terms #. constants, hereafter ranged over by letters :math:`c`, :math:`d`, etc., are terms. #. if :math:`x` is a variable and :math:`T`, :math:`U` are terms then :math:`∀ x:T,~U` (:g:`forall x:T, U` in Coq concrete syntax) is a term. If :math:`x` occurs in :math:`U`, :math:`∀ x:T,~U` reads as “for all :math:`x` of type :math:`T`, :math:`U`”. As :math:`U` depends on :math:`x`, one says that :math:`∀ x:T,~U` is a *dependent product*. If :math:`x` does not occur in :math:`U` then :math:`∀ x:T,~U` reads as “if :math:`T` then :math:`U`”. A *non-dependent product* can be written: :math:`T \rightarrow U`. #. if :math:`x` is a variable and :math:`T`, :math:`u` are terms then :math:`λ x:T .~u` (:g:`fun x:T => u` in Coq concrete syntax) is a term. This is a notation for the λ-abstraction of λ-calculus :cite:`Bar81`. The term :math:`λ x:T .~u` is a function which maps elements of :math:`T` to the expression :math:`u`. #. if :math:`t` and :math:`u` are terms then :math:`(t~u)` is a term (:g:`t u` in Coq concrete syntax). The term :math:`(t~u)` reads as “:math:`t` applied to :math:`u`”. #. if :math:`x` is a variable, and :math:`t`, :math:`T` and :math:`u` are terms then :math:`\letin{x}{t:T}{u}` is a term which denotes the term :math:`u` where the variable :math:`x` is locally bound to :math:`t` of type :math:`T`. This stands for the common “let-in” construction of functional programs such as ML or Scheme. .. _Free-variables: **Free variables.** The notion of free variables is defined as usual. In the expressions :math:`λx:T.~U` and :math:`∀ x:T,~U` the occurrences of :math:`x` in :math:`U` are bound. .. _Substitution: **Substitution.** The notion of substituting a term :math:`t` to free occurrences of a variable :math:`x` in a term :math:`u` is defined as usual. The resulting term is written :math:`\subst{u}{x}{t}`. .. _The-logical-vs-programming-readings: **The logical vs programming readings.** The constructions of the |Cic| can be used to express both logical and programming notions, according to the Curry-Howard correspondence between proofs and programs, and between propositions and types :cite:`Cur58,How80,Bru72`. For instance, let us assume that :math:`\nat` is the type of natural numbers with zero element written :math:`0` and that :g:`True` is the always true proposition. Then :math:`→` is used both to denote :math:`\nat→\nat` which is the type of functions from :math:`\nat` to :math:`\nat`, to denote True→True which is an implicative proposition, to denote :math:`\nat →\Prop` which is the type of unary predicates over the natural numbers, etc. Let us assume that ``mult`` is a function of type :math:`\nat→\nat→\nat` and ``eqnat`` a predicate of type :math:`\nat→\nat→ \Prop`. The λ-abstraction can serve to build “ordinary” functions as in :math:`λ x:\nat.~(\kw{mult}~x~x)` (i.e. :g:`fun x:nat => mult x x` in Coq notation) but may build also predicates over the natural numbers. For instance :math:`λ x:\nat.~(\kw{eqnat}~x~0)` (i.e. :g:`fun x:nat => eqnat x 0` in Coq notation) will represent the predicate of one variable :math:`x` which asserts the equality of :math:`x` with :math:`0`. This predicate has type :math:`\nat → \Prop` and it can be applied to any expression of type :math:`\nat`, say :math:`t`, to give an object :math:`P~t` of type :math:`\Prop`, namely a proposition. Furthermore :g:`forall x:nat, P x` will represent the type of functions which associate with each natural number :math:`n` an object of type :math:`(P~n)` and consequently represent the type of proofs of the formula “:math:`∀ x.~P(x)`”. .. _Typing-rules: Typing rules ---------------- As objects of type theory, terms are subjected to *type discipline*. The well typing of a term depends on a local context and a global environment. .. _Local-context: **Local context.** A :term:`local context` is an ordered list of declarations of *variables*. The declaration of a variable :math:`x` is either an *assumption*, written :math:`x:T` (where :math:`T` is a type) or a *definition*, written :math:`x:=t:T`. Local contexts are written in brackets, for example :math:`[x:T;~y:=u:U;~z:V]`. The variables declared in a local context must be distinct. If :math:`Γ` is a local context that declares :math:`x`, we write :math:`x ∈ Γ`. Writing :math:`(x:T) ∈ Γ` means there is an assumption or a definition giving the type :math:`T` to :math:`x` in :math:`Γ`. If :math:`Γ` defines :math:`x:=t:T`, we also write :math:`(x:=t:T) ∈ Γ`. For the rest of the chapter, :math:`Γ::(y:T)` denotes the local context :math:`Γ` enriched with the local assumption :math:`y:T`. Similarly, :math:`Γ::(y:=t:T)` denotes the local context :math:`Γ` enriched with the :term:`local definition ` :math:`(y:=t:T)`. The notation :math:`[]` denotes the empty local context. Writing :math:`Γ_1 ; Γ_2` means concatenation of the local context :math:`Γ_1` and the local context :math:`Γ_2`. .. _Global-environment: **Global environment.** A :term:`global environment` is an ordered list of *declarations*. Global declarations are either *assumptions*, *definitions* or declarations of inductive objects. Inductive objects declare both constructors and inductive or coinductive types (see Section :ref:`inductive-definitions`). In the global environment, *assumptions* are written as :math:`(c:T)`, indicating that :math:`c` is of the type :math:`T`. *Definitions* are written as :math:`c:=t:T`, indicating that :math:`c` has the value :math:`t` and type :math:`T`. We shall call such names :term:`constants `. For the rest of the chapter, the :math:`E;~c:T` denotes the global environment :math:`E` enriched with the assumption :math:`c:T`. Similarly, :math:`E;~c:=t:T` denotes the global environment :math:`E` enriched with the definition :math:`(c:=t:T)`. The rules for inductive definitions (see Section :ref:`inductive-definitions`) have to be considered as assumption rules in which the following definitions apply: if the name :math:`c` is declared in :math:`E`, we write :math:`c ∈ E` and if :math:`c:T` or :math:`c:=t:T` is declared in :math:`E`, we write :math:`(c : T) ∈ E`. .. _Typing-rules2: **Typing rules.** In the following, we define simultaneously two judgments. The first one :math:`\WTEG{t}{T}` means the term :math:`t` is well-typed and has type :math:`T` in the global environment :math:`E` and local context :math:`Γ`. The second judgment :math:`\WFE{Γ}` means that the global environment :math:`E` is well-formed and the local context :math:`Γ` is a valid local context in this global environment. A term :math:`t` is well typed in a global environment :math:`E` iff there exists a local context :math:`\Gamma` and a term :math:`T` such that the judgment :math:`\WTEG{t}{T}` can be derived from the following rules. .. inference:: W-Empty --------- \WF{[]}{} .. inference:: W-Local-Assum \WTEG{T}{s} s \in \Sort x \not\in \Gamma % \cup E ------------------------- \WFE{\Gamma::(x:T)} .. inference:: W-Local-Def \WTEG{t}{T} x \not\in \Gamma % \cup E ------------------------- \WFE{\Gamma::(x:=t:T)} .. inference:: W-Global-Assum \WTE{}{T}{s} s \in \Sort c \notin E ------------ \WF{E;~c:T}{} .. inference:: W-Global-Def \WTE{}{t}{T} c \notin E --------------- \WF{E;~c:=t:T}{} .. inference:: Ax-SProp \WFE{\Gamma} ---------------------- \WTEG{\SProp}{\Type(1)} .. inference:: Ax-Prop \WFE{\Gamma} ---------------------- \WTEG{\Prop}{\Type(1)} .. inference:: Ax-Set \WFE{\Gamma} --------------------- \WTEG{\Set}{\Type(1)} .. inference:: Ax-Type \WFE{\Gamma} --------------------------- \WTEG{\Type(i)}{\Type(i+1)} .. inference:: Var \WFE{\Gamma} (x:T) \in \Gamma~~\mbox{or}~~(x:=t:T) \in \Gamma~\mbox{for some $t$} -------------------------------------------------------------------- \WTEG{x}{T} .. inference:: Const \WFE{\Gamma} (c:T) \in E~~\mbox{or}~~(c:=t:T) \in E~\mbox{for some $t$} ---------------------------------------------------------- \WTEG{c}{T} .. inference:: Prod-SProp \WTEG{T}{s} s \in {\Sort} \WTE{\Gamma::(x:T)}{U}{\SProp} ----------------------------- \WTEG{\forall~x:T,U}{\SProp} .. inference:: Prod-Prop \WTEG{T}{s} s \in \Sort \WTE{\Gamma::(x:T)}{U}{\Prop} ----------------------------- \WTEG{∀ x:T,~U}{\Prop} .. inference:: Prod-Set \WTEG{T}{s} s \in \{\SProp, \Prop, \Set\} \WTE{\Gamma::(x:T)}{U}{\Set} ---------------------------- \WTEG{∀ x:T,~U}{\Set} .. inference:: Prod-Type \WTEG{T}{s} s \in \{\SProp, \Type(i)\} \WTE{\Gamma::(x:T)}{U}{\Type(i)} -------------------------------- \WTEG{∀ x:T,~U}{\Type(i)} .. inference:: Lam \WTEG{∀ x:T,~U}{s} \WTE{\Gamma::(x:T)}{t}{U} ------------------------------------ \WTEG{λ x:T\mto t}{∀ x:T,~U} .. _app_rule: .. inference:: App \WTEG{t}{∀ x:U,~T} \WTEG{u}{U} ------------------------------ \WTEG{(t\ u)}{\subst{T}{x}{u}} .. inference:: Let \WTEG{t}{T} \WTE{\Gamma::(x:=t:T)}{u}{U} ----------------------------------------- \WTEG{\letin{x}{t:T}{u}}{\subst{U}{x}{t}} .. note:: **Prod-Prop** and **Prod-Set** typing-rules make sense if we consider the semantic difference between :math:`\Prop` and :math:`\Set`: + All values of a type that has a sort :math:`\Set` are extractable. + No values of a type that has a sort :math:`\Prop` are extractable. .. note:: We may have :math:`\letin{x}{t:T}{u}` well-typed without having :math:`((λ x:T.~u)~t)` well-typed (where :math:`T` is a type of :math:`t`). This is because the value :math:`t` associated with :math:`x` may be used in a conversion rule (see Section :ref:`Conversion-rules`). .. _subtyping-rules: Subtyping rules ------------------- At the moment, we did not take into account one rule between universes which says that any term in a universe of index :math:`i` is also a term in the universe of index :math:`i+1` (this is the *cumulativity* rule of |Cic|). This property extends the equivalence relation of convertibility into a *subtyping* relation inductively defined by: #. if :math:`E[Γ] ⊢ t =_{βδιζη} u` then :math:`E[Γ] ⊢ t ≤_{βδιζη} u`, #. if :math:`i ≤ j` then :math:`E[Γ] ⊢ \Type(i) ≤_{βδιζη} \Type(j)`, #. for any :math:`i`, :math:`E[Γ] ⊢ \Set ≤_{βδιζη} \Type(i)`, #. :math:`E[Γ] ⊢ \Prop ≤_{βδιζη} \Set`, hence, by transitivity, :math:`E[Γ] ⊢ \Prop ≤_{βδιζη} \Type(i)`, for any :math:`i` (note: :math:`\SProp` is not related by cumulativity to any other term) #. if :math:`E[Γ] ⊢ T =_{βδιζη} U` and :math:`E[Γ::(x:T)] ⊢ T' ≤_{βδιζη} U'` then :math:`E[Γ] ⊢ ∀x:T,~T′ ≤_{βδιζη} ∀ x:U,~U′`. #. if :math:`\ind{p}{Γ_I}{Γ_C}` is a universe polymorphic and cumulative (see Chapter :ref:`polymorphicuniverses`) inductive type (see below) and :math:`(t : ∀Γ_P ,∀Γ_{\mathit{Arr}(t)}, S)∈Γ_I` and :math:`(t' : ∀Γ_P' ,∀Γ_{\mathit{Arr}(t)}', S')∈Γ_I` are two different instances of *the same* inductive type (differing only in universe levels) with constructors .. math:: [c_1 : ∀Γ_P ,∀ T_{1,1} … T_{1,n_1} ,~t~v_{1,1} … v_{1,m} ;~…;~ c_k : ∀Γ_P ,∀ T_{k,1} … T_{k,n_k} ,~t~v_{k,1} … v_{k,m} ] and .. math:: [c_1 : ∀Γ_P' ,∀ T_{1,1}' … T_{1,n_1}' ,~t'~v_{1,1}' … v_{1,m}' ;~…;~ c_k : ∀Γ_P' ,∀ T_{k,1}' … T_{k,n_k}' ,~t'~v_{k,1}' … v_{k,m}' ] respectively then .. math:: E[Γ] ⊢ t~w_1 … w_m ≤_{βδιζη} t'~w_1' … w_m' (notice that :math:`t` and :math:`t'` are both fully applied, i.e., they have a sort as a type) if .. math:: E[Γ] ⊢ w_i =_{βδιζη} w_i' for :math:`1 ≤ i ≤ m` and we have .. math:: E[Γ] ⊢ T_{i,j} ≤_{βδιζη} T_{i,j}' and .. math:: E[Γ] ⊢ A_i ≤_{βδιζη} A_i' where :math:`Γ_{\mathit{Arr}(t)} = [a_1 : A_1 ;~ … ;~a_l : A_l ]` and :math:`Γ_{\mathit{Arr}(t)}' = [a_1 : A_1';~ … ;~a_l : A_l']`. The conversion rule up to subtyping is now exactly: .. inference:: Conv E[Γ] ⊢ U : s E[Γ] ⊢ t : T E[Γ] ⊢ T ≤_{βδιζη} U -------------- E[Γ] ⊢ t : U .. _Normal-form: **Normal form**. A term which cannot be any more reduced is said to be in *normal form*. There are several ways (or strategies) to apply the reduction rules. Among them, we have to mention the *head reduction* which will play an important role (see Chapter :ref:`tactics`). Any term :math:`t` can be written as :math:`λ x_1 :T_1 .~… λ x_k :T_k .~(t_0~t_1 … t_n )` where :math:`t_0` is not an application. We say then that :math:`t_0` is the *head of* :math:`t`. If we assume that :math:`t_0` is :math:`λ x:T.~u_0` then one step of β-head reduction of :math:`t` is: .. math:: λ x_1 :T_1 .~… λ x_k :T_k .~(λ x:T.~u_0~t_1 … t_n ) ~\triangleright~ λ (x_1 :T_1 )…(x_k :T_k ).~(\subst{u_0}{x}{t_1}~t_2 … t_n ) Iterating the process of head reduction until the head of the reduced term is no more an abstraction leads to the *β-head normal form* of :math:`t`: .. math:: t \triangleright … \triangleright λ x_1 :T_1 .~…λ x_k :T_k .~(v~u_1 … u_m ) where :math:`v` is not an abstraction (nor an application). Note that the head normal form must not be confused with the normal form since some :math:`u_i` can be reducible. Similar notions of head-normal forms involving δ, ι and ζ reductions or any combination of those can also be defined. .. _The-Calculus-of-Inductive-Construction-with-impredicative-Set: The Calculus of Inductive Constructions with impredicative Set ----------------------------------------------------------------- Coq can be used as a type checker for the Calculus of Inductive Constructions with an impredicative sort :math:`\Set` by using the compiler option ``-impredicative-set``. For example, using the ordinary `coqtop` command, the following is rejected, .. example:: .. coqtop:: all Fail Definition id: Set := forall X:Set,X->X. while it will type check, if one uses instead the `coqtop` ``-impredicative-set`` option.. The major change in the theory concerns the rule for product formation in the sort :math:`\Set`, which is extended to a domain in any sort: .. inference:: ProdImp E[Γ] ⊢ T : s s ∈ \Sort E[Γ::(x:T)] ⊢ U : \Set --------------------- E[Γ] ⊢ ∀ x:T,~U : \Set This extension has consequences on the inductive definitions which are allowed. In the impredicative system, one can build so-called *large inductive definitions* like the example of second-order existential quantifier (:g:`exSet`). There should be restrictions on the eliminations which can be performed on such definitions. The elimination rules in the impredicative system for sort :math:`\Set` become: .. inference:: Set1 s ∈ \{\Prop, \Set\} ----------------- [I:\Set|I→ s] .. inference:: Set2 I~\kw{is a small inductive definition} s ∈ \{\Type(i)\} ---------------- [I:\Set|I→ s] coq-8.20.0/doc/sphinx/language/coq-library.rst000066400000000000000000001012561466560755400212310ustar00rootroot00000000000000.. _thecoqlibrary: The Coq library ================= .. index:: single: Theories The Coq library has two parts: * The :gdef:`prelude`: definitions and theorems for the most commonly used elementary logical notions and data types. Coq normally loads these files automatically when it starts. * The :gdef:`standard library`: general-purpose libraries with definitions and theorems for sets, lists, sorting, arithmetic, etc. To use these files, users must load them explicitly with the ``Require`` command (see :ref:`compiled-files`) There are also many libraries provided by Coq users' community. These libraries and developments are available for download at https://coq.inria.fr/ (see :ref:`userscontributions`). This chapter briefly reviews the Coq libraries whose contents can also be browsed at https://coq.inria.fr/stdlib/. The prelude ----------- This section lists the basic notions and results which are directly available in the standard Coq system. Most of these constructions are defined in the ``Prelude`` module in directory ``theories/Init`` in the Coq root directory; this includes the modules ``Notations``, ``Logic``, ``Datatypes``, ``Specif``, ``Peano``, ``Wf`` and ``Tactics``. Module ``Logic_Type`` also makes it in the initial state. .. _init-notations: Notations ~~~~~~~~~ This module defines the parsing and pretty-printing of many symbols (infixes, prefixes, etc.). However, it does not assign a meaning to these notations. The purpose of this is to define and fix once for all the precedence and associativity of very common notations. The main notations fixed in the initial state are : ================ ============ =============== Notation Precedence Associativity ================ ============ =============== ``_ -> _`` 99 right ``_ <-> _`` 95 no ``_ \/ _`` 85 right ``_ /\ _`` 80 right ``~ _`` 75 right ``_ = _`` 70 no ``_ = _ = _`` 70 no ``_ = _ :> _`` 70 no ``_ <> _`` 70 no ``_ <> _ :> _`` 70 no ``_ < _`` 70 no ``_ > _`` 70 no ``_ <= _`` 70 no ``_ >= _`` 70 no ``_ < _ < _`` 70 no ``_ < _ <= _`` 70 no ``_ <= _ < _`` 70 no ``_ <= _ <= _`` 70 no ``_ + _`` 50 left ``_ || _`` 50 left ``_ - _`` 50 left ``_ * _`` 40 left ``_ && _`` 40 left ``_ / _`` 40 left ``- _`` 35 right ``/ _`` 35 right ``_ ^ _`` 30 right ================ ============ =============== .. _coq-library-logic: Logic ~~~~~ `Logic.v` in the basic library of Coq has the definitions of standard (intuitionistic) logical connectives defined as inductive constructions. They are equipped with an appealing syntax enriching the subclass :token:`form` of the syntactic class :token:`term`. The constructs for :production:`form` are: ============================================== ======= True True False False :n:`~ @form` not :n:`@form /\ @form` and :n:`@form \/ @form` or :n:`@form -> @form` primitive implication :n:`@form <-> @form` iff :n:`forall @ident : @type, @form` primitive for all :n:`exists @ident {? @specif}, @form` ex :n:`exists2 @ident {? @specif}, @form & @form` ex2 :n:`@term = @term` eq :n:`@term = @term :> @specif` eq ============================================== ======= .. note:: Implication is not defined but primitive (it is a non-dependent product of a proposition over another proposition). There is also a primitive universal quantification (it is a dependent product over a proposition). The primitive universal quantification allows both first-order and higher-order quantification. Propositional Connectives +++++++++++++++++++++++++ .. index:: single: Connectives single: True (term) single: I (term) single: False (term) single: not (term) single: and (term) single: conj (term) single: proj1 (term) single: proj2 (term) single: or (term) single: or_introl (term) single: or_intror (term) single: iff (term) First, we find propositional calculus connectives. At times, it's helpful to know exactly what these notations represent. .. coqdoc:: Inductive True : Prop := I. Inductive False : Prop := . Definition not (A: Prop) := A -> False. Inductive and (A B:Prop) : Prop := conj (_:A) (_:B). Section Projections. Variables A B : Prop. Theorem proj1 : A /\ B -> A. Theorem proj2 : A /\ B -> B. End Projections. Inductive or (A B:Prop) : Prop := | or_introl (_:A) | or_intror (_:B). Definition iff (P Q:Prop) := (P -> Q) /\ (Q -> P). We also have the `Type` level negation: .. index:: single: notT (term) .. coqtop:: in Definition notT (A:Type) := A -> False. Quantifiers +++++++++++ .. index:: single: Quantifiers single: all (term) single: ex (term) single: exists (term) single: ex_intro (term) single: ex2 (term) single: exists2 (term) single: ex_intro2 (term) Then we find first-order quantifiers: .. coqtop:: in Definition all (A:Set) (P:A -> Prop) := forall x:A, P x. Inductive ex (A: Set) (P:A -> Prop) : Prop := ex_intro (x:A) (_:P x). Inductive ex2 (A:Set) (P Q:A -> Prop) : Prop := ex_intro2 (x:A) (_:P x) (_:Q x). The following abbreviations are allowed: ====================== ======================================= ``exists x:A, P`` ``ex A (fun x:A => P)`` ``exists x, P`` ``ex _ (fun x => P)`` ``exists2 x:A, P & Q`` ``ex2 A (fun x:A => P) (fun x:A => Q)`` ``exists2 x, P & Q`` ``ex2 _ (fun x => P) (fun x => Q)`` ====================== ======================================= The type annotation ``:A`` can be omitted when ``A`` can be synthesized by the system. .. _coq-equality: Equality ++++++++ .. index:: single: Equality single: eq (term) single: eq_refl (term) Then, we find equality, defined as an inductive relation. That is, given a type ``A`` and an ``x`` of type ``A``, the predicate :g:`(eq A x)` is the smallest one which contains ``x``. This definition, due to Christine Paulin-Mohring, is equivalent to define ``eq`` as the smallest reflexive relation, and it is also equivalent to Leibniz' equality. .. coqtop:: in Inductive eq (A:Type) (x:A) : A -> Prop := eq_refl : eq A x x. Lemmas ++++++ Finally, a few easy lemmas are provided. .. index:: single: absurd (term) single: eq_sym (term) single: eq_trans (term) single: f_equal (term) single: sym_not_eq (term) single: eq_ind_r (term) single: eq_rec_r (term) single: eq_rect (term) single: eq_rect_r (term) .. coqdoc:: Theorem absurd : forall A C:Prop, A -> ~ A -> C. Section equality. Variables A B : Type. Variable f : A -> B. Variables x y z : A. Theorem eq_sym : x = y -> y = x. Theorem eq_trans : x = y -> y = z -> x = z. Theorem f_equal : x = y -> f x = f y. Theorem not_eq_sym : x <> y -> y <> x. End equality. Definition eq_ind_r : forall (A:Type) (x:A) (P:A->Prop), P x -> forall y:A, y = x -> P y. Definition eq_rec_r : forall (A:Type) (x:A) (P:A->Set), P x -> forall y:A, y = x -> P y. Definition eq_rect_r : forall (A:Type) (x:A) (P:A->Type), P x -> forall y:A, y = x -> P y. Hint Immediate eq_sym not_eq_sym : core. .. index:: single: f_equal2 ... f_equal5 (term) The theorem ``f_equal`` is extended to functions with two to five arguments. The theorem are names ``f_equal2``, ``f_equal3``, ``f_equal4`` and ``f_equal5``. For instance ``f_equal3`` is defined the following way. .. coqtop:: in abort Theorem f_equal3 : forall (A1 A2 A3 B:Type) (f:A1 -> A2 -> A3 -> B) (x1 y1:A1) (x2 y2:A2) (x3 y3:A3), x1 = y1 -> x2 = y2 -> x3 = y3 -> f x1 x2 x3 = f y1 y2 y3. .. _datatypes: Datatypes ~~~~~~~~~ .. index:: single: Datatypes In the basic library, we find in ``Datatypes.v`` the definition of the basic data-types of programming, defined as inductive constructions over the sort ``Set``. Some of them come with a special syntax shown below (this syntax table is common with the next section :ref:`specification`). The constructs for :production:`specif` are: ============================================= ======= :n:`@specif * @specif` prod :n:`@specif + @specif` sum :n:`@specif + { @specif }` sumor :n:`{ @specif } + { @specif }` sumbool :n:`{ @ident : @specif | @form }` sig :n:`{ @ident : @specif | @form & @form }` sig2 :n:`{ @ident : @specif & @specif }` sigT :n:`{ @ident : @specif & @specif & @specif }` sigT2 ============================================= ======= The notation for pairs (elements of type prod) is: :n:`(@term, @term)` Programming +++++++++++ .. index:: single: Programming single: unit (term) single: tt (term) single: bool (term) single: true (term) single: false (term) single: nat (term) single: O (term) single: S (term) single: option (term) single: Some (term) single: None (term) single: identity (term) single: refl_identity (term) .. coqtop:: in Inductive unit : Set := tt. Inductive bool : Set := true | false. Inductive nat : Set := O | S (n:nat). Inductive option (A:Set) : Set := Some (_:A) | None. Note that zero is the letter ``O``, and *not* the numeral ``0``. We then define the disjoint sum of ``A+B`` of two sets ``A`` and ``B``, and their product ``A*B``. .. index:: single: sum (term) single: A+B (term) single: + (term) single: inl (term) single: inr (term) single: prod (term) single: A*B (term) single: * (term) single: pair (term) single: fst (term) single: snd (term) .. coqtop:: in Inductive sum (A B:Set) : Set := inl (_:A) | inr (_:B). Inductive prod (A B:Set) : Set := pair (_:A) (_:B). Section projections. Variables A B : Set. Definition fst (H: prod A B) := match H with | pair _ _ x y => x end. Definition snd (H: prod A B) := match H with | pair _ _ x y => y end. End projections. Some operations on ``bool`` are also provided: ``andb`` (with infix notation ``&&``), ``orb`` (with infix notation ``||``), ``xorb``, ``implb`` and ``negb``. .. _specification: Specification ~~~~~~~~~~~~~ The following notions defined in module ``Specif.v`` allow to build new data-types and specifications. They are available with the syntax shown in the previous section :ref:`datatypes`. For instance, given :g:`A:Type` and :g:`P:A->Prop`, the construct :g:`{x:A | P x}` (in abstract syntax :g:`(sig A P)`) is a ``Type``. We may build elements of this set as :g:`(exist x p)` whenever we have a witness :g:`x:A` with its justification :g:`p:P x`. From such a :g:`(exist x p)` we may in turn extract its witness :g:`x:A` (using an elimination construct such as ``match``) but *not* its justification, which stays hidden, like in an abstract data-type. In technical terms, one says that ``sig`` is a *weak (dependent) sum*. A variant ``sig2`` with two predicates is also provided. .. index:: single: {x:A | P x} (term) single: sig (term) single: exist (term) single: sig2 (term) single: exist2 (term) .. coqtop:: in Inductive sig (A:Set) (P:A -> Prop) : Set := exist (x:A) (_:P x). Inductive sig2 (A:Set) (P Q:A -> Prop) : Set := exist2 (x:A) (_:P x) (_:Q x). A *strong (dependent) sum* :g:`{x:A & P x}` may be also defined, when the predicate ``P`` is now defined as a constructor of types in ``Type``. .. index:: single: {x:A & P x} (term) single: sigT (term) single: existT (term) single: sigT2 (term) single: existT2 (term) single: projT1 (term) single: projT2 (term) .. coqtop:: in Inductive sigT (A:Type) (P:A -> Type) : Type := existT (x:A) (_:P x). Section Projections2. Variable A : Type. Variable P : A -> Type. Definition projT1 (H:sigT A P) := let (x, h) := H in x. Definition projT2 (H:sigT A P) := match H return P (projT1 H) with existT _ _ x h => h end. End Projections2. Inductive sigT2 (A: Type) (P Q:A -> Type) : Type := existT2 (x:A) (_:P x) (_:Q x). A related non-dependent construct is the constructive sum :g:`{A}+{B}` of two propositions ``A`` and ``B``. .. index:: single: sumbool (term) single: left (term) single: right (term) single: {A}+{B} (term) .. coqtop:: in Inductive sumbool (A B:Prop) : Set := left (_:A) | right (_:B). This ``sumbool`` construct may be used as a kind of indexed boolean data-type. An intermediate between ``sumbool`` and ``sum`` is the mixed ``sumor`` which combines :g:`A:Set` and :g:`B:Prop` in the construction :g:`A+{B}` in ``Set``. .. index:: single: sumor (term) single: inleft (term) single: inright (term) single: A+{B} (term) .. coqtop:: in Inductive sumor (A:Set) (B:Prop) : Set := | inleft (_:A) | inright (_:B). We may define variants of the axiom of choice, like in Martin-Löf's Intuitionistic Type Theory. .. index:: single: Choice (term) single: Choice2 (term) single: bool_choice (term) .. coqdoc:: Lemma Choice : forall (S S':Set) (R:S -> S' -> Prop), (forall x:S, {y : S' | R x y}) -> {f : S -> S' | forall z:S, R z (f z)}. Lemma Choice2 : forall (S S':Set) (R:S -> S' -> Set), (forall x:S, {y : S' & R x y}) -> {f : S -> S' & forall z:S, R z (f z)}. Lemma bool_choice : forall (S:Set) (R1 R2:S -> Prop), (forall x:S, {R1 x} + {R2 x}) -> {f : S -> bool | forall x:S, f x = true /\ R1 x \/ f x = false /\ R2 x}. The next construct builds a sum between a data-type :g:`A:Type` and an exceptional value encoding errors: .. index:: single: Exc (term) single: value (term) single: error (term) .. coqtop:: in Definition Exc := option. Definition value := Some. Definition error := None. This module ends with theorems, relating the sorts ``Set`` or ``Type`` and ``Prop`` in a way which is consistent with the realizability interpretation. .. index:: single: False_rect (term) single: False_rec (term) single: eq_rect (term) single: absurd_set (term) single: and_rect (term) .. coqdoc:: Definition except := False_rec. Theorem absurd_set : forall (A:Prop) (C:Set), A -> ~ A -> C. Theorem and_rect2 : forall (A B:Prop) (P:Type), (A -> B -> P) -> A /\ B -> P. Basic Arithmetic ~~~~~~~~~~~~~~~~ The basic library includes a few elementary properties of natural numbers, together with the definitions of predecessor, addition and multiplication, in module ``Peano.v``. It also provides a scope ``nat_scope`` gathering standard notations for common operations (``+``, ``*``) and a decimal notation for numbers, allowing, for instance, writing ``3`` for :g:`S (S (S O))`. This also works on the left hand side of a ``match`` expression (see for example section :tacn:`refine`). This scope is opened by default. .. example:: The following example is not part of the standard library, but it shows the usage of the notations: .. coqtop:: in reset Fixpoint even (n:nat) : bool := match n with | 0 => true | 1 => false | S (S n) => even n end. .. index:: single: eq_S (term) single: pred (term) single: pred_Sn (term) single: eq_add_S (term) single: not_eq_S (term) single: IsSucc (term) single: O_S (term) single: n_Sn (term) single: plus (term) single: plus_n_O (term) single: plus_n_Sm (term) single: mult (term) single: mult_n_O (term) single: mult_n_Sm (term) Now comes the content of module ``Peano``: .. coqdoc:: Theorem eq_S : forall x y:nat, x = y -> S x = S y. Definition pred (n:nat) : nat := match n with | 0 => 0 | S u => u end. Theorem pred_Sn : forall m:nat, m = pred (S m). Theorem eq_add_S : forall n m:nat, S n = S m -> n = m. Hint Immediate eq_add_S : core. Theorem not_eq_S : forall n m:nat, n <> m -> S n <> S m. Definition IsSucc (n:nat) : Prop := match n with | 0 => False | S p => True end. Theorem O_S : forall n:nat, 0 <> S n. Theorem n_Sn : forall n:nat, n <> S n. Fixpoint plus (n m:nat) {struct n} : nat := match n with | 0 => m | S p => S (p + m) end where "n + m" := (plus n m) : nat_scope. Lemma plus_n_O : forall n:nat, n = n + 0. Lemma plus_n_Sm : forall n m:nat, S (n + m) = n + S m. Fixpoint mult (n m:nat) {struct n} : nat := match n with | 0 => 0 | S p => m + p * m end where "n * m" := (mult n m) : nat_scope. Lemma mult_n_O : forall n:nat, 0 = n * 0. Lemma mult_n_Sm : forall n m:nat, n * m + n = n * (S m). Finally, it gives the definition of the usual orderings ``le``, ``lt``, ``ge`` and ``gt``. .. index:: single: le (term) single: le_n (term) single: le_S (term) single: lt (term) single: ge (term) single: gt (term) .. This emits a notation already used warning but it won't be shown to the user. .. coqtop:: in warn Inductive le (n:nat) : nat -> Prop := | le_n : le n n | le_S : forall m:nat, n <= m -> n <= (S m) where "n <= m" := (le n m) : nat_scope. Definition lt (n m:nat) := S n <= m. Definition ge (n m:nat) := m <= n. Definition gt (n m:nat) := m < n. Properties of these relations are not initially known, but may be required by the user from modules ``Le`` and ``Lt``. Finally, ``Peano`` gives some lemmas allowing pattern matching, and a double induction principle. .. index:: single: nat_case (term) single: nat_double_ind (term) .. coqdoc:: Theorem nat_case : forall (n:nat) (P:nat -> Prop), P 0 -> (forall m:nat, P (S m)) -> P n. Theorem nat_double_ind : forall R:nat -> nat -> Prop, (forall n:nat, R 0 n) -> (forall n:nat, R (S n) 0) -> (forall n m:nat, R n m -> R (S n) (S m)) -> forall n m:nat, R n m. Well-founded recursion ~~~~~~~~~~~~~~~~~~~~~~ The basic library contains the basics of well-founded recursion and well-founded induction, in module ``Wf.v``. .. index:: single: Well foundedness single: Recursion single: Well founded induction single: Acc (term) single: Acc_inv (term) single: Acc_rect (term) single: well_founded (term) .. coqdoc:: Section Well_founded. Variable A : Type. Variable R : A -> A -> Prop. Inductive Acc (x:A) : Prop := Acc_intro : (forall y:A, R y x -> Acc y) -> Acc x. Lemma Acc_inv x : Acc x -> forall y:A, R y x -> Acc y. Definition well_founded := forall a:A, Acc a. Hypothesis Rwf : well_founded. Theorem well_founded_induction : forall P:A -> Set, (forall x:A, (forall y:A, R y x -> P y) -> P x) -> forall a:A, P a. Theorem well_founded_ind : forall P:A -> Prop, (forall x:A, (forall y:A, R y x -> P y) -> P x) -> forall a:A, P a. The automatically generated scheme ``Acc_rect`` can be used to define functions by fixpoints using well-founded relations to justify termination. Assuming extensionality of the functional used for the recursive call, the fixpoint equation can be proved. .. index:: single: Fix_F (term) single: Fix_eq (term) single: Fix_F_inv (term) single: Fix_F_eq (term) .. coqdoc:: Section FixPoint. Variable P : A -> Type. Variable F : forall x:A, (forall y:A, R y x -> P y) -> P x. Fixpoint Fix_F (x:A) (r:Acc x) {struct r} : P x := F x (fun (y:A) (p:R y x) => Fix_F y (Acc_inv x r y p)). Definition Fix (x:A) := Fix_F x (Rwf x). Hypothesis F_ext : forall (x:A) (f g:forall y:A, R y x -> P y), (forall (y:A) (p:R y x), f y p = g y p) -> F x f = F x g. Lemma Fix_F_eq : forall (x:A) (r:Acc x), F x (fun (y:A) (p:R y x) => Fix_F y (Acc_inv x r y p)) = Fix_F x r. Lemma Fix_F_inv : forall (x:A) (r s:Acc x), Fix_F x r = Fix_F x s. Lemma Fix_eq : forall x:A, Fix x = F x (fun (y:A) (p:R y x) => Fix y). End FixPoint. End Well_founded. Tactics ~~~~~~~ A few tactics defined at the user level are provided in the initial state, in module ``Tactics.v``. They are listed at https://coq.inria.fr/stdlib/, in paragraph ``Init``, link ``Tactics``. The standard library -------------------- Survey ~~~~~~ The rest of the standard library is structured into the following subdirectories: * **Logic** : Classical logic and dependent equality * **Arith** : Basic Peano arithmetic * **PArith** : Basic positive integer arithmetic * **NArith** : Basic binary natural number arithmetic * **ZArith** : Basic relative integer arithmetic * **Numbers** : Various approaches to natural, integer and cyclic numbers (currently axiomatically and on top of 2^31 binary words) * **Bool** : Booleans (basic functions and results) * **Lists** : Monomorphic and polymorphic lists (basic functions and results), Streams (infinite sequences defined with coinductive types) * **Sets** : Sets (classical, constructive, finite, infinite, power set, etc.) * **FSets** : Specification and implementations of finite sets and finite maps (by lists and by AVL trees) * **Reals** : Axiomatization of real numbers (classical, basic functions, integer part, fractional part, limit, derivative, Cauchy series, power series and results,...) * **Floats** : Machine implementation of floating-point arithmetic (for the binary64 format) * **Relations** : Relations (definitions and basic results) * **Sorting** : Sorted list (basic definitions and heapsort correctness) * **Strings** : 8-bits characters and strings * **Wellfounded** : Well-founded relations (basic results) These directories belong to the initial :term:`load path` of the system, and the modules they provide are compiled at installation time. So they are directly accessible with the command ``Require`` (see Section :ref:`compiled-files`). The different modules of the Coq standard library are documented online at https://coq.inria.fr/stdlib/. Peano’s arithmetic (nat) ~~~~~~~~~~~~~~~~~~~~~~~~ .. index:: single: Peano's arithmetic single: nat_scope While in the initial state, many operations and predicates of Peano's arithmetic are defined, further operations and results belong to other modules. For instance, the decidability of the basic predicates are defined here. This is provided by requiring the module ``Arith``. The following table describes the notations available in scope ``nat_scope`` : =============== =================== Notation Interpretation =============== =================== ``_ < _`` ``lt`` ``_ <= _`` ``le`` ``_ > _`` ``gt`` ``_ >= _`` ``ge`` ``x < y < z`` ``x < y /\ y < z`` ``x < y <= z`` ``x < y /\ y <= z`` ``x <= y < z`` ``x <= y /\ y < z`` ``x <= y <= z`` ``x <= y /\ y <= z`` ``_ + _`` ``plus`` ``_ - _`` ``minus`` ``_ * _`` ``mult`` =============== =================== Notations for integer arithmetic ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ .. index:: single: Arithmetical notations single: + (term) single: * (term) single: - (term) singel: / (term) single: <= (term) single: >= (term) single: < (term) single: > (term) single: ?= (term) single: mod (term) The following table describes the syntax of expressions for integer arithmetic. It is provided by requiring and opening the module ``ZArith`` and opening scope ``Z_scope``. It specifies how notations are interpreted and, when not already reserved, the precedence and associativity. =============== ==================== ========== ============= Notation Interpretation Precedence Associativity =============== ==================== ========== ============= ``_ < _`` ``Z.lt`` ``_ <= _`` ``Z.le`` ``_ > _`` ``Z.gt`` ``_ >= _`` ``Z.ge`` ``x < y < z`` ``x < y /\ y < z`` ``x < y <= z`` ``x < y /\ y <= z`` ``x <= y < z`` ``x <= y /\ y < z`` ``x <= y <= z`` ``x <= y /\ y <= z`` ``_ ?= _`` ``Z.compare`` 70 no ``_ + _`` ``Z.add`` ``_ - _`` ``Z.sub`` ``_ * _`` ``Z.mul`` ``_ / _`` ``Z.div`` ``_ mod _`` ``Z.modulo`` 40 no ``- _`` ``Z.opp`` ``_ ^ _`` ``Z.pow`` =============== ==================== ========== ============= .. example:: .. coqtop:: all reset Require Import ZArith. Check (2 + 3)%Z. Open Scope Z_scope. Check 2 + 3. Real numbers library ~~~~~~~~~~~~~~~~~~~~ Notations for real numbers ++++++++++++++++++++++++++ This is provided by requiring and opening the module ``Reals`` and opening scope ``R_scope``. This set of notations is very similar to the notation for integer arithmetic. The inverse function was added. =============== =================== Notation Interpretation =============== =================== ``_ < _`` ``Rlt`` ``_ <= _`` ``Rle`` ``_ > _`` ``Rgt`` ``_ >= _`` ``Rge`` ``x < y < z`` ``x < y /\ y < z`` ``x < y <= z`` ``x < y /\ y <= z`` ``x <= y < z`` ``x <= y /\ y < z`` ``x <= y <= z`` ``x <= y /\ y <= z`` ``_ + _`` ``Rplus`` ``_ - _`` ``Rminus`` ``_ * _`` ``Rmult`` ``_ / _`` ``Rdiv`` ``- _`` ``Ropp`` ``/ _`` ``Rinv`` ``_ ^ _`` ``pow`` =============== =================== .. example:: .. coqtop:: all reset Require Import Reals. Check (2 + 3)%R. Open Scope R_scope. Check 2 + 3. Some tactics for real numbers +++++++++++++++++++++++++++++ In addition to the powerful ``ring``, ``field`` and ``lra`` tactics (see Chapter :ref:`tactics`), there are also: .. tacn:: discrR Proves that two real integer constants are different. .. example:: .. coqtop:: all reset Require Import DiscrR. Open Scope R_scope. Goal 5 <> 0. discrR. .. tacn:: split_Rabs Allows unfolding the ``Rabs`` constant and splits corresponding conjunctions. .. example:: .. coqtop:: all reset Require Import Reals. Open Scope R_scope. Goal forall x:R, x <= Rabs x. intro; split_Rabs. .. tacn:: split_Rmult Splits a condition that a product is non-null into subgoals corresponding to the condition on each operand of the product. .. example:: .. coqtop:: all reset Require Import Reals. Open Scope R_scope. Goal forall x y z:R, x * y * z <> 0. intros; split_Rmult. List library ~~~~~~~~~~~~ .. index:: single: Notations for lists single: length (term) single: head (term) single: tail (term) single: app (term) single: rev (term) single: nth (term) single: map (term) single: flat_map (term) single: fold_left (term) single: fold_right (term) Some elementary operations on polymorphic lists are defined here. They can be accessed by requiring module ``List``. It defines the following notions: * ``length`` * ``head`` : first element (with default) * ``tail`` : all but first element * ``app`` : concatenation * ``rev`` : reverse * ``nth`` : accessing n-th element (with default) * ``map`` : applying a function * ``flat_map`` : applying a function returning lists * ``fold_left`` : iterator (from head to tail) * ``fold_right`` : iterator (from tail to head) The following table shows notations available when opening scope ``list_scope``. ========== ============== ========== ============= Notation Interpretation Precedence Associativity ========== ============== ========== ============= ``_ ++ _`` ``app`` 60 right ``_ :: _`` ``cons`` 60 right ========== ============== ========== ============= .. _floats_library: Floats library ~~~~~~~~~~~~~~ The standard library has a small ``Floats`` module for accessing processor floating-point operations through the Coq kernel. However, while this module supports computation and has a bit-level specification, it doesn't include elaborate theorems, such as a link to real arithmetic or various error bounds. To do proofs by reflection, use ``Floats`` in conjunction with the complementary `Flocq `_ library, which provides many such theorems. The library of primitive floating-point arithmetic can be loaded by requiring module ``Floats``: .. coqtop:: in Require Import Floats. It exports the module ``PrimFloat`` that provides a primitive type named ``float``, defined in the kernel (see section :ref:`primitive-floats`), as well as two variant types ``float_comparison`` and ``float_class``: .. coqtop:: all Print float. Print float_comparison. Print float_class. It then defines the primitive operators below, using the processor floating-point operators for binary64 in rounding-to-nearest even: * ``abs`` * ``opp`` * ``sub`` * ``add`` * ``mul`` * ``div`` * ``sqrt`` * ``compare`` : compare two floats and return a ``float_comparison`` * ``classify`` : analyze a float and return a ``float_class`` * ``of_int63`` : round a primitive integer and convert it into a float * ``normfr_mantissa`` : take a float in ``[0.5; 1.0)`` and return its mantissa * ``frshiftexp`` : convert a float to fractional part in ``[0.5; 1.0)`` and integer part * ``ldshiftexp`` : multiply a float by an integral power of ``2`` * ``next_up`` : return the next float towards positive infinity * ``next_down`` : return the next float towards negative infinity For special floating-point values, the following constants are also defined: * ``zero`` * ``neg_zero`` * ``one`` * ``two`` * ``infinity`` * ``neg_infinity`` * ``nan`` : Not a Number (assumed to be unique: the "payload" of NaNs is ignored) The following table shows the notations available when opening scope ``float_scope``. =========== ============== Notation Interpretation =========== ============== ``- _`` ``opp`` ``_ - _`` ``sub`` ``_ + _`` ``add`` ``_ * _`` ``mul`` ``_ / _`` ``div`` ``_ =? _`` ``eqb`` ``_  t` can be shortened in :g:`fun x y z : A => t`). .. index:: fun .. index:: forall Functions (fun) and function types (forall) ------------------------------------------- .. insertprodn term_forall_or_fun term_forall_or_fun .. prodn:: term_forall_or_fun ::= forall @open_binders , @type | fun @open_binders => @term The expression :n:`fun @ident : @type => @term` defines the *abstraction* of the variable :n:`@ident`, of type :n:`@type`, over the term :n:`@term`. It denotes a function of the variable :n:`@ident` that evaluates to the expression :n:`@term` (e.g. :g:`fun x : A => x` denotes the identity function on type :g:`A`). The keyword :g:`fun` can be followed by several binders as given in Section :ref:`binders`. Functions over several variables are equivalent to an iteration of one-variable functions. For instance the expression :n:`fun {+ @ident__i } : @type => @term` denotes the same function as :n:`{+ fun @ident__i : @type => } @term`. If a let-binder occurs in the list of binders, it is expanded to a let-in definition (see Section :ref:`let-in`). The expression :n:`forall @ident : @type__1, @type__2` denotes the :gdef:`product type ` (or *product*) of the variable :n:`@ident` of type :n:`@type__1` over the type :n:`@type__2`. If :n:`@ident` is used in :n:`@type__2`, then we say the expression is a :gdef:`dependent product`, and otherwise a :gdef:`non-dependent product`. The intention behind a dependent product :g:`forall x : A, B` is twofold. It denotes either the universal quantification of the variable :g:`x` of type :g:`A` in the proposition :g:`B` or the functional dependent product from :g:`A` to :g:`B` (a construction usually written :math:`\Pi_{x:A}.B` in set theory). Non-dependent product types have a special notation: :g:`A -> B` stands for :g:`forall _ : A, B`. *Non-dependent product* is used to denote both propositional implication and function types. These terms are also useful: * `n : nat` is a :gdef:`dependent premise` of `forall n:nat, n + 0 = n` because `n` appears both in the binder of the `forall` and in the quantified statement `n + 0 = n`. Note that if `n` isn't used in the statement, Coq considers it a non-dependent premise. Similarly, :n:`let n := ... in @term` is a dependent premise only if `n` is used in :n:`@term`. * `A` and `B` are :gdef:`non-dependent premises ` (or, often, just ":gdef:`premises `") of `A -> B -> C` because they don't appear in a `forall` binder. `C` is the *conclusion* of the type, which is a second meaning for the term :term:`conclusion`. (As noted, `A -> B` is notation for the term `forall _ : A, B`; the wildcard `_` can't be referred to in the quantified statement.) As for abstractions, :g:`forall` is followed by a binder list, and products over several variables are equivalent to an iteration of one-variable products. .. _function_application: Function application -------------------- .. insertprodn term_application arg .. prodn:: term_application ::= @term1 {+ @arg } | @ @qualid_annotated {+ @term1 } arg ::= ( @ident := @term ) | ( @natural := @term ) | @term1 :n:`@term1__fun @term1` denotes applying the function :n:`@term1__fun` to :token:`term1`. .. todo: What is the relevant definition of a function here? See https://github.com/coq/coq/pull/16659#discussion_r1039540851 :n:`@term1__fun {+ @term1__i }` denotes applying :n:`@term1__fun` to the arguments :n:`@term1__i`. It is equivalent to :n:`( … ( @term1__fun @term1__1 ) … ) @term1__n`: associativity is to the left. The :n:`@ @qualid_annotated {+ @term1 }` form requires specifying all arguments, including implicit ones. Otherwise, implicit arguments need not be given. See :ref:`ImplicitArguments`. The notations :n:`(@ident := @term)` and :n:`(@natural := @term)` for arguments are used for making explicit the value of implicit arguments. See :ref:`explicit-applications`. .. _gallina-assumptions: Assumptions ----------- Assumptions extend the global environment with axioms, parameters, hypotheses or variables. An assumption binds an :n:`@ident` to a :n:`@type`. It is accepted by Coq only if :n:`@type` is a correct type in the global environment before 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` has type :n:`@type`. .. _Axiom: .. cmd:: @assumption_token {? Inline {? ( @natural ) } } {| @assumpt | {+ ( @assumpt ) } } :name: Axiom; Axioms; Conjecture; Conjectures; Hypothesis; Hypotheses; Parameter; Parameters; Variable; Variables .. insertprodn assumption_token of_type .. prodn:: assumption_token ::= {| Axiom | Axioms } | {| Conjecture | Conjectures } | {| Parameter | Parameters } | {| Hypothesis | Hypotheses } | {| Variable | Variables } assumpt ::= {+ @ident_decl } @of_type ident_decl ::= @ident {? @univ_decl } of_type ::= {| : | :> } @type These commands bind one or more :n:`@ident`\(s) to specified :n:`@type`\(s) as their specifications in the global environment. 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`, :attr:`deprecated` and :attr:`warn` attributes. :cmd:`Axiom`, :cmd:`Conjecture`, :cmd:`Parameter` and their plural forms are equivalent. They can take the :attr:`local` :term:`attribute`, which makes the declared :n:`@ident` accessible only through their fully qualified names, even if :cmd:`Import` or its variants has been used on the current module. which makes the defined :n:`@ident`\s accessible by :cmd:`Import` and its variants only through their fully qualified names. Similarly, :cmd:`Hypothesis`, :cmd:`Variable` and their plural forms are equivalent. They should only be used inside :ref:`section-mechanism`. The :n:`@ident`\s defined are only accessible within the section. When the current section 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 .. coqtop:: reset in Parameter X Y : Set. Parameter (R : X -> Y -> Prop) (S : Y -> X -> Prop). Axiom R_S_inv : forall x y, R x y <-> S y x. .. exn:: @ident already exists. :name: ‘ident’ already exists. (Axiom) :undocumented: .. warn:: Use of "Variable" or "Hypothesis" outside sections behaves as "#[local] Parameter" or "#[local] Axiom". Warning generated when using :cmd:`Variable` or its equivalent instead of :n:`Local Parameter` or its equivalent. This message is an error by default, it may be convenient to disable it while debuging. .. note:: We advise using the commands :cmd:`Axiom`, :cmd:`Conjecture` and :cmd:`Hypothesis` (and their plural forms) for logical postulates (i.e. when the assertion :n:`@type` is of sort :g:`Prop`), and to use the commands :cmd:`Parameter` and :cmd:`Variable` (and their plural forms) in other cases (corresponding to the declaration of an abstract object of the given type). coq-8.20.0/doc/sphinx/language/core/basic.rst000066400000000000000000000601111466560755400210100ustar00rootroot00000000000000============================= Basic notions and conventions ============================= This section provides some essential notions and conventions for reading the manual. We start by explaining the syntax and lexical conventions used in the manual. Then, we present the essential vocabulary necessary to read the rest of the manual. Other terms are defined throughout the manual. The reader may refer to the :ref:`glossary index ` for a complete list of defined terms. Finally, we describe the various types of settings that Coq provides. Syntax and lexical conventions ------------------------------ .. _syntax-conventions: Syntax conventions ~~~~~~~~~~~~~~~~~~ The syntax described in this documentation is equivalent to that accepted by the Coq parser, but the grammar has been edited to improve readability and presentation. In the grammar presented in this manual, the terminal symbols are black (e.g. :n:`forall`), whereas the nonterminals are green, italic and hyperlinked (e.g. :n:`@term`). Some syntax is represented graphically using the following kinds of blocks: :n:`{? item }` An optional item. :n:`{+ item }` A list of one or more items. :n:`{* item }` An optional list of items. :n:`{+s item}` A list of one or more items separated by "s" (e.g. :n:`item__1 s item__2 s item__3`). :n:`{*s item}` An optional list of items separated by "s". :n:`{| item__1 | item__2 | ... }` Alternatives (either :n:`item__1` or :n:`item__2` or ...). `Precedence levels `_ that are implemented in the Coq parser are shown in the documentation by appending the level to the nonterminal name (as in :n:`@term100` or :n:`@ltac_expr3`). .. note:: Coq uses an extensible parser. Plugins and the :ref:`notation system ` can extend the syntax at run time. Some notations are defined in the :term:`prelude`, which is loaded by default. The documented grammar doesn't include these notations. Precedence levels not used by the base grammar are omitted from the documentation, even though they could still be populated by notations or plugins. Furthermore, some parsing rules are only activated in certain contexts (:ref:`proof mode `, :ref:`custom entries `...). .. warning:: Given the complexity of these parsing rules, it would be extremely difficult to create an external program that can properly parse a Coq document. Therefore, tool writers are advised to delegate parsing to Coq, by communicating with it, for instance through `SerAPI `_. .. seealso:: :cmd:`Print Grammar` .. _lexical-conventions: Lexical conventions ~~~~~~~~~~~~~~~~~~~ Blanks Space, newline and horizontal tab are considered blanks. Blanks are ignored but they separate tokens. Comments Comments are enclosed between ``(*`` and ``*)``. They can be nested. They can contain any character. However, embedded :n:`@string` literals must be correctly closed. Comments are treated as blanks. Identifiers Identifiers, written :n:`@ident`, are sequences of letters, digits, ``_`` and ``'``, that do not start with a digit or ``'``. That is, they are recognized by the following grammar (except that the string ``_`` is reserved; it is not a valid identifier): .. insertprodn ident subsequent_letter .. prodn:: ident ::= @first_letter {* @subsequent_letter } first_letter ::= {| a .. z | A .. Z | _ | @unicode_letter } subsequent_letter ::= {| @first_letter | @digit | ' | @unicode_id_part } All characters are meaningful. In particular, identifiers are case-sensitive. :production:`unicode_letter` non-exhaustively includes Latin, Greek, Gothic, Cyrillic, Arabic, Hebrew, Georgian, Hangul, Hiragana and Katakana characters, CJK ideographs, mathematical letter-like symbols and non-breaking space. :production:`unicode_id_part` non-exhaustively includes symbols for prime letters and subscripts. Numbers Numbers are sequences of digits with an optional fractional part and exponent, optionally preceded by a minus sign. Hexadecimal numbers start with ``0x`` or ``0X``. :n:`@integer`\s are signed numbers without fraction or exponent parts. :n:`@natural`\s are non-negative integers. Underscores embedded in the digits are ignored, for example ``1_000_000`` is the same as ``1000000``. .. insertprodn number hexdigit .. prodn:: number ::= {? - } @decnat {? . {+ {| @digit | _ } } } {? {| e | E } {? {| + | - } } @decnat } | {? - } @hexnat {? . {+ {| @hexdigit | _ } } } {? {| p | P } {? {| + | - } } @decnat } integer ::= @bigint bigint ::= {? - } @bignat natural ::= @bignat bignat ::= {| @decnat | @hexnat } decnat ::= @digit {* {| @digit | _ } } digit ::= 0 .. 9 hexnat ::= {| 0x | 0X } @hexdigit {* {| @hexdigit | _ } } hexdigit ::= {| 0 .. 9 | a .. f | A .. F } :n:`number`, :n:`@bigint` and :n:`@bignat`, which are used in :token:`term`\s, generally have no range limitation. :n:`@integer` and :n:`@natural`, which are used as arguments in tactics and commands, are limited to the range that fits into an OCaml integer (63-bit integers on most architectures). The :ref:`standard library ` provides a few :ref:`interpretations ` for :n:`@number`. Some of these interpretations support exponential notation for decimal numbers, for example ``5.02e-6`` means 5.02×10\ :sup:`-6`; and base 2 exponential notation for hexadecimal numbers denoted by ``p`` or ``P``, for example ``0xAp12`` means 10×2\ :sup:`12`. The :cmd:`Number Notation` mechanism lets the user define custom parsers and printers for :n:`@number`. By default, numbers are interpreted as :n:`nat`\s, which is a unary representation. For example, :n:`3` is represented as `S (S (S O))`. While this is a convenient representation for doing proofs, computing with large :n:`nat`\s can lead to stack overflows or running out of memory. You can explicitly specify a different interpretation to avoid this problem. For example, :n:`1000000%Z` is a more efficient binary representation of that number as an integer. See :ref:`Scopes` and :n:`@term_scope`. .. example:: Stack overflow with :n:`nat` .. coqtop:: all reset Fail Eval compute in 100000 + 100000. (* gives a stack overflow (not shown) *) .. coqtop:: in Require Import ZArith. (* for definition of Z *) .. coqtop:: all Eval compute in (1000000000000000000000000000000000 + 1)%Z. Strings Strings begin and end with ``"`` (double quote). Use ``""`` to represent a double quote character within a string. In the grammar, strings are identified with :production:`string`. The :cmd:`String Notation` mechanism offers the user a way to define custom parsers and printers for :token:`string`. .. _keywords: 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` command-line flag):: _ Axiom CoFixpoint Definition Fixpoint Hypothesis Parameter Prop SProp Set Theorem Type Variable as at cofix else end fix for forall fun if in let match return then where with The following are keywords defined in notations or plugins loaded in the :term:`prelude`:: by exists exists2 using Note that loading additional modules or plugins may expand the set of reserved keywords. :cmd:`Print Keywords` can be used to print the current keywords and tokens. 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 notations or plugins loaded in the :term:`prelude`:: ** |- || -> Note that loading additional modules or plugins may expand the set of defined tokens. .. _lexing-unseparated-keywords: When multiple tokens match the beginning of a sequence of characters, the longest matching token not cutting a subsequence of contiguous letters in the middle is used. Occasionally you may need to insert spaces to separate tokens. For example, if ``~`` and ``~~`` are both defined as tokens, the inputs ``~ ~`` and ``~~`` generate different tokens, whereas if ``~~`` is not defined, then the two inputs are equivalent. Also, if ``~`` and ``~_h`` are both defined as tokens, the input ``~_ho`` is interpreted as ``~ _ho`` rather than ``~_h o`` so as not to cut the identifier-like subsequence ``ho``. Contrastingly, if only ``~_h`` is defined as a token, then ``~_ho`` is an error because no token can be found that includes the whole subsequence ``ho`` without cutting it in the middle. Finally, if all of ``~``, ``~_h`` and ``~_ho`` are defined as tokens, the input ``~_ho`` is interpreted using the longest match rule, i.e. as the token ``~_ho``. Essential vocabulary -------------------- This section presents the most essential notions to understand the rest of the Coq manual: :term:`terms ` and :term:`types ` on the one hand, :term:`commands ` and :term:`tactics ` on the other hand. .. glossary:: term Terms are the basic expressions of Coq. Terms can represent mathematical expressions, propositions and proofs, but also executable programs and program types. Here is the top-level syntax of terms. Each of the listed constructs is presented in a dedicated section. Some of these constructs (like :n:`@term_forall_or_fun`) are part of the core language that the kernel of Coq understands and are therefore described in :ref:`this chapter `, while others (like :n:`@term_if`) are language extensions that are presented in :ref:`the next chapter `. .. insertprodn term qualid_annotated .. prodn:: term ::= @term100 term100 ::= @term_cast | @term10 term10 ::= @term_application | @term_forall_or_fun | @term_let | @term_fix | @term_cofix | @term_if | @one_term one_term ::= @term_explicit | @term1 term1 ::= @term_projection | @term_scope | @term0 term0 ::= @qualid_annotated | @sort | @number_or_string | @term_evar | @term_match | @term_record | @term_generalizing | [| {*; @term } %| @term {? : @type } |] {? @univ_annot } | @term_ltac | ( @term ) qualid_annotated ::= @qualid {? @univ_annot } .. note:: Many :term:`commands ` and :term:`tactics ` use :n:`@one_term` (in the syntax of their arguments) rather than :n:`@term`. The former need to be enclosed in parentheses unless they're very simple, such as a single identifier. This avoids confusing a space-separated list of terms or identifiers with a :n:`@term_application`. type To be valid and accepted by the Coq kernel, a term needs an associated type. We express this relationship by “:math:`x` *of type* :math:`T`”, which we write as “:math:`x:T`”. Informally, “:math:`x:T`” can be thought as “:math:`x` *belongs to* :math:`T`”. The Coq kernel is a type checker: it verifies that a term has the expected type by applying a set of typing rules (see :ref:`Typing-rules`). If that's indeed the case, we say that the term is :gdef:`well-typed`. A special feature of the Coq language is that types can depend on terms (we say that the language is `dependently-typed `_). Because of this, types and terms share a common syntax. All types are :term:`terms `, but not all terms are types. The syntactic aliases :n:`@type` and :n:`@one_type` are used to make clear when the provided :term:`term` must semantically be a type: .. insertprodn type one_type .. prodn:: type ::= @term one_type ::= @one_term Intuitively, types may be viewed as sets containing terms. We say that a type is :gdef:`inhabited` if it contains at least one term (i.e. if we can find a term which is associated with this type). We call such terms :gdef:`inhabitants `. Note that deciding whether a type is inhabited is `undecidable `_. Formally, types can be used to construct logical foundations for mathematics alternative to the standard `"set theory" `_: we call such logical foundations `"type theories" `_. Coq is based on the Calculus of Inductive Constructions, which is a particular instance of type theory. sentence Coq documents are made of a series of sentences that contain :term:`commands ` or :term:`tactics `, generally terminated with a period and optionally decorated with :term:`attributes `. .. insertprodn document sentence .. prodn:: document ::= {* @sentence } sentence ::= {? @attributes } @command . | {? @attributes } {? @natural : } @query_command . | {? @attributes } {? @toplevel_selector : } @ltac_expr {| . | ... } | @control_command :n:`@ltac_expr` syntax supports both simple and compound :term:`tactics `. For example: ``split`` is a simple tactic while ``split; auto`` combines two simple tactics. command A :production:`command` can be used to modify the state of a Coq document, for instance by declaring a new object, or to get information about the current state. By convention, command names begin with uppercase letters. Commands appear in the HTML documentation in blue or gray boxes after the label "Command". In the pdf, they appear after the boldface label "Command:". Commands are listed in the :ref:`command_index`. Example: .. cmd:: Comments {* {| @one_term | @string | @natural } } Prints "Comments ok" and does not change the state of the document. tactic A :production:`tactic` specifies how to transform the current proof state as a step in creating a proof. They are syntactically valid only when Coq is in :term:`proof mode`, such as after a :cmd:`Theorem` command and before any subsequent proof-terminating command such as :cmd:`Qed`. See :ref:`proofhandling` for more on proof mode. By convention, tactic names begin with lowercase letters. Tactic appear in the HTML documentation in blue or gray boxes after the label "Tactic". In the pdf, they appear after the boldface label "Tactic:". Tactics are listed in the :ref:`tactic_index`. Settings -------- There are several mechanisms for changing the behavior of Coq. The :term:`attribute` mechanism is used to modify the default behavior of a :term:`sentence` or to attach information to Coq objects. The :term:`flag`, :term:`option` and :term:`table` mechanisms are used to modify the behavior of Coq more globally in a document or project. .. _attributes: Attributes ~~~~~~~~~~ An :gdef:`attribute` is used to modify the default behavior of a sentence or to attach information to a Coq object. Syntactically, most commands and tactics can be decorated with attributes (cf. :n:`@sentence`), but attributes not supported by the command or tactic will trigger :warn:`This command does not support this attribute`. There is also a command :cmd:`Attributes` to assign attributes to a whole document. .. insertprodn attributes legacy_attr .. prodn:: attributes ::= {* #[ {*, @attribute } ] } {* @legacy_attr } attribute ::= @ident {? @attr_value } attr_value ::= = @string | = @ident | ( {+, @attribute } ) legacy_attr ::= {| Local | Global } | {| Polymorphic | Monomorphic } | {| Cumulative | NonCumulative } | Private | Program The order of top-level attributes doesn't affect their meaning. ``#[foo,bar]``, ``#[bar,foo]``, ``#[foo]#[bar]`` and ``#[bar]#[foo]`` are equivalent. :gdef:`Boolean attributes ` take the form :n:`@ident__attr{? = {| yes | no } }`. When the :n:`{| yes | no }` value is omitted, the default is :n:`yes`. The legacy attributes (:n:`@legacy_attr`) provide an older, alternate syntax for certain attributes. They are equivalent to new attributes as follows: ============================= ================================ Legacy attribute New attribute ============================= ================================ `Local` :attr:`local` `Global` :attr:`global` `Polymorphic`, `Monomorphic` :attr:`universes(polymorphic)` `Cumulative`, `NonCumulative` :attr:`universes(cumulative)` `Private` :attr:`private(matching)` `Program` :attr:`program` ============================= ================================ Attributes appear in the HTML documentation in blue or gray boxes after the label "Attribute". In the pdf, they appear after the boldface label "Attribute:". Attributes are listed in the :ref:`attribute_index`. .. warn:: This command does not support this attribute: @ident. :name: This command does not support this attribute This warning is configured to behave as an error by default. You may turn it into a normal warning by using the :opt:`Warnings` option: .. coqtop:: none Set Silent. .. coqtop:: all warn Set Warnings "unsupported-attributes". #[ foo ] Comments. Generic attributes ^^^^^^^^^^^^^^^^^^ The following attribute is supported by every command: .. attr:: warnings = @string :name: warnings Sets the given warning string locally for the command. After the command finishes the warning state is reset to what it was before the command. For instance if the current warning state is `some-warnings,-other-warning`, .. coqdoc:: #[warnings="+other-warning"] Command. is equivalent to .. coqdoc:: Set Warnings "+other-warning". Command. Set Warnings "some-warnings,-other-warning". and `other-warning` is an error while executing the command. Consequently, using this attribute around an :cmd:`Import` command will prevent it from changing the warning state. See also :opt:`Warnings` for the concrete syntax to use inside the quoted string. .. attr:: warning = @string :name: warning Alias of :attr:`warnings`. Document-level attributes ^^^^^^^^^^^^^^^^^^^^^^^^^ .. cmd:: Attributes {+, @attribute } :name: Attributes Associates attributes with the document. When compiled with ``coqc`` (see Section :ref:`thecoqcommands`), the attributes are associated with the compiled file and may have an effect when the file is loaded with :cmd:`Require`. Supported attributes include :attr:`deprecated` and :attr:`warn`. .. _flags-options-tables: Flags, Options and Tables ~~~~~~~~~~~~~~~~~~~~~~~~~ The following types of settings can be used to change the behavior of Coq in subsequent commands and tactics (see :ref:`set_unset_scope_qualifiers` for a more precise description of the scope of these settings): * A :gdef:`flag` has a boolean value, such as :flag:`Universe Polymorphism`. * An :gdef:`option` generally has a numeric or string value, such as :opt:`Firstorder Depth`. * A :gdef:`table` contains a set of :token:`string`\s or :token:`qualid`\s. * In addition, some commands provide settings, such as :cmd:`Extraction Language`. .. FIXME Convert "Extraction Language" to an option. .. insertprodn setting_name setting_name .. prodn:: setting_name ::= {+ @ident } .. Flags, options and tables are identified by a series of identifiers. By convention, each of the identifiers start with an initial capital letter. Flags, options and tables appear in the HTML documentation in blue or gray boxes after the labels "Flag", "Option" and "Table". In the pdf, they appear after a boldface label. They are listed in the :ref:`options_index`. .. cmd:: Set @setting_name {? {| @integer | @string } } If :n:`@setting_name` is a flag, no value may be provided; the flag is set to on. If :n:`@setting_name` is an option, a value of the appropriate type must be provided; the option is set to the specified value. This command supports the :attr:`local`, :attr:`global` and :attr:`export` attributes. They are described :ref:`here `. .. warn:: There is no flag or option with this name: "@setting_name". This warning message can be raised by :cmd:`Set` and :cmd:`Unset` when :n:`@setting_name` is unknown. It is a warning rather than an error because this helps library authors produce Coq code that is compatible with several Coq versions. To preserve the same behavior, they may need to set some compatibility flags or options that did not exist in previous Coq versions. .. cmd:: Unset @setting_name If :n:`@setting_name` is a flag, it is set to off. If :n:`@setting_name` is an option, it is set to its default value. This command supports the :attr:`local`, :attr:`global` and :attr:`export` attributes. They are described :ref:`here `. .. cmd:: Add @setting_name {+ {| @qualid | @string } } Adds the specified values to the table :n:`@setting_name`. .. cmd:: Remove @setting_name {+ {| @qualid | @string } } Removes the specified value from the table :n:`@setting_name`. .. cmd:: Test @setting_name {? for {+ {| @qualid | @string } } } If :n:`@setting_name` is a flag or option, prints its current value. If :n:`@setting_name` is a table: if the `for` clause is specified, reports whether the table contains each specified value, otherwise this is equivalent to :cmd:`Print Table`. The `for` clause is not valid for flags and options. .. exn:: There is no flag, option or table with this name: "@setting_name". This error message is raised when calling the :cmd:`Test` command (without the `for` clause), or the :cmd:`Print Table` command, for an unknown :n:`@setting_name`. .. exn:: There is no qualid-valued table with this name: "@setting_name". There is no string-valued table with this name: "@setting_name". These error messages are raised when calling the :cmd:`Add` or :cmd:`Remove` commands, or the :cmd:`Test` command with the `for` clause, if :n:`@setting_name` is unknown or does not have the right type. .. cmd:: Print Options Prints the current value of all flags and options, and the names of all tables. .. cmd:: Print Table @setting_name Prints the values in the table :n:`@setting_name`. .. cmd:: Print Tables A synonym for :cmd:`Print Options`. .. _set_unset_scope_qualifiers: Locality attributes supported by :cmd:`Set` and :cmd:`Unset` ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ The :cmd:`Set` and :cmd:`Unset` commands support the mutually exclusive :attr:`local`, :attr:`export` and :attr:`global` locality attributes. * If no attribute is specified, the original value of the flag or option is restored at the end of the current module but it is *not* restored at the end of the current section. * The :attr:`local` attribute makes the setting local to the current :cmd:`Section` (if applicable) or :cmd:`Module`. * The :attr:`export` attribute makes the setting local to the current :cmd:`Module`, unless :cmd:`Import` (or one of its variants) is used on the :cmd:`Module`. * The :attr:`global` attribute makes the setting persist outside the current :cmd:`Module` in the current file, or whenever :cmd:`Require` is used on the current file. .. note:: We discourage using the :attr:`global` locality attribute with the :cmd:`Set` and :cmd:`Unset` commands. If your goal is to define project-wide settings, you should rather use the command-line arguments ``-set`` and ``-unset`` for setting flags and options (see :ref:`command-line-options`). coq-8.20.0/doc/sphinx/language/core/coinductive.rst000066400000000000000000000173411466560755400222520ustar00rootroot00000000000000Coinductive types and corecursive functions ============================================= .. _coinductive-types: Coinductive types ------------------ The objects of an inductive type are well-founded with respect to the constructors of the type. In other words, such objects contain only a *finite* number of constructors. Coinductive types arise from relaxing this condition, and admitting types whose objects contain an infinity of constructors. Infinite objects are introduced by a non-ending (but effective) process of construction, defined in terms of the constructors of the type. More information on coinductive definitions can be found in :cite:`Gimenez95b,Gim98,GimCas05`. .. cmd:: CoInductive @inductive_definition {* with @inductive_definition } CoInductive @record_definition {* with @record_definition } This command introduces a coinductive type. The syntax of the command is the same as the command :cmd:`Inductive`. No principle of induction is derived from the definition of a coinductive type, since such principles only make sense for inductive types. For coinductive types, the only elimination principle is case analysis. This command supports the :attr:`universes(polymorphic)`, :attr:`universes(template)`, :attr:`universes(cumulative)`, :attr:`private(matching)`, :attr:`bypass_check(universes)`, :attr:`bypass_check(positivity)` and :attr:`using` attributes. When record syntax is used, this command also supports the :attr:`projections(primitive)` :term:`attribute`. .. example:: The type of infinite sequences of natural numbers, usually called streams, is an example of a coinductive type. .. coqtop:: in CoInductive Stream : Set := Seq : nat -> Stream -> Stream. The usual destructors on streams :g:`hd:Stream->nat` and :g:`tl:Str->Str` can be defined as follows: .. coqtop:: in Definition hd (x:Stream) := let (a,s) := x in a. Definition tl (x:Stream) := let (a,s) := x in s. Definitions of coinductive predicates and blocks of mutually coinductive definitions are also allowed. .. example:: The extensional equality on streams is an example of a coinductive type: .. coqtop:: in CoInductive EqSt : Stream -> Stream -> Prop := eqst : forall s1 s2:Stream, hd s1 = hd s2 -> EqSt (tl s1) (tl s2) -> EqSt s1 s2. In order to prove the extensional equality of two streams :g:`s1` and :g:`s2` we have to construct an infinite proof of equality, that is, an infinite object of type :g:`(EqSt s1 s2)`. We will see how to introduce infinite objects in Section :ref:`cofixpoint`. Caveat ~~~~~~ The ability to define coinductive types by constructors, hereafter called *positive coinductive types*, is known to break subject reduction. The story is a bit long: this is due to dependent pattern-matching which implies 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 presentation is available, called *negative coinductive types*. This consists in defining a coinductive type as a primitive record type through its projections. Such a technique is akin to the *copattern* style that can be found in e.g. Agda, and preserves subject reduction. The above example can be rewritten in the following way. .. coqtop:: none Reset Stream. .. coqtop:: all Set Primitive Projections. CoInductive Stream : Set := Seq { hd : nat; tl : Stream }. CoInductive EqSt (s1 s2: Stream) : Prop := eqst { eqst_hd : hd s1 = hd s2; eqst_tl : EqSt (tl s1) (tl s2); }. Some properties that hold over positive streams are lost when going to the negative presentation, typically when they imply equality over streams. For instance, propositional η-equality is lost when going to the negative presentation. It is nonetheless logically consistent to recover it through an axiom. .. coqtop:: all Axiom Stream_eta : forall s: Stream, s = Seq (hd s) (tl s). More generally, as in the case of positive coinductive types, it is consistent to further identify extensional equality of coinductive types with propositional equality: .. coqtop:: all Axiom Stream_ext : forall (s1 s2: Stream), EqSt s1 s2 -> s1 = s2. As of Coq 8.9, it is now advised to use negative coinductive types rather than their positive counterparts. .. seealso:: :ref:`primitive_projections` for more information about negative records and primitive projections. .. index:: single: cofix Co-recursive functions: cofix ----------------------------- .. insertprodn term_cofix cofix_body .. prodn:: term_cofix ::= let cofix @cofix_body in @term | cofix @cofix_body {? {+ with @cofix_body } for @ident } cofix_body ::= @ident {* @binder } {? : @type } := @term The expression ":n:`cofix @ident__1 @binder__1 : @type__1 with … with @ident__n @binder__n : @type__n for @ident__i`" denotes the :math:`i`-th component of a block of terms defined by a mutual guarded corecursion. It is the local counterpart of the :cmd:`CoFixpoint` command. When :math:`n=1`, the ":n:`for @ident__i`" clause is omitted. .. _cofixpoint: Top-level definitions of corecursive functions ----------------------------------------------- .. cmd:: CoFixpoint @cofix_definition {* with @cofix_definition } .. insertprodn cofix_definition cofix_definition .. prodn:: cofix_definition ::= @ident_decl {* @binder } {? : @type } {? := @term } {? @decl_notations } This command introduces a method for constructing an infinite object of a coinductive type. For example, the stream containing all natural numbers can be introduced by applying the following method to the number :g:`O` (see Section :ref:`coinductive-types` for the definition of :g:`Stream`, :g:`hd` and :g:`tl`): .. coqtop:: all CoFixpoint from (n:nat) : Stream := Seq n (from (S n)). Unlike recursive definitions, there is no decreasing argument in a corecursive definition. To be admissible, a method of construction must provide at least one extra constructor of the infinite object for each iteration. A syntactical guard condition is imposed on corecursive definitions in order to ensure this: each recursive call in the definition must be protected by at least one constructor, and only by constructors. That is the case in the former definition, where the single recursive call of :g:`from` is guarded by an application of :g:`Seq`. On the contrary, the following recursive function does not satisfy the guard condition: .. coqtop:: all Fail CoFixpoint filter (p:nat -> bool) (s:Stream) : Stream := if p (hd s) then Seq (hd s) (filter p (tl s)) else filter p (tl s). The elimination of corecursive definition is done lazily, i.e. the definition is expanded only when it occurs at the head of an application which is the argument of a case analysis expression. In any other context, it is considered as a canonical expression which is completely evaluated. We can test this using the command :cmd:`Eval`, which computes the normal forms of a term: .. coqtop:: all Eval compute in (from 0). Eval compute in (hd (from 0)). Eval compute in (tl (from 0)). 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 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 :term:`constant` for which the computational behavior is relevant. See :ref:`proof-editing-mode`. coq-8.20.0/doc/sphinx/language/core/conversion.rst000066400000000000000000000235551466560755400221270ustar00rootroot00000000000000.. _Conversion-rules: Conversion rules ---------------- Coq has conversion rules that can be used to determine if two terms are equal by definition in |CiC|, or :term:`convertible`. Conversion rules consist of reduction rules and expansion rules. Equality is determined by converting both terms to a normal form, then verifying they are syntactically equal (ignoring differences in the names of bound variables by :term:`alpha-conversion `). .. seealso:: :ref:`applyingconversionrules`, which describes tactics that apply these conversion rules. :gdef:`Reductions ` convert terms to something that is incrementally closer to its normal form. For example, :term:`zeta-reduction` removes :n:`let @ident := @term__1 in @term__2` constructs from a term by replacing :n:`@ident` with :n:`@term__1` wherever :n:`@ident` appears in :n:`@term__2`. The resulting term may be longer or shorter than the original. .. coqtop:: all Eval cbv zeta in let i := 1 in i + i. :gdef:`Expansions ` are reductions applied in the opposite direction, for example expanding `2 + 2` to `let i := 2 in i + i`. While applying reductions gives a unique result, the associated expansion may not be unique. For example, `2 + 2` could also be expanded to `let i := 2 in i + 2`. Reductions that have a unique inverse expansion are also referred to as :gdef:`contractions `. The normal form is defined as the result of applying a particular set of conversion rules (beta-, delta-, iota- and zeta-reduction and eta-expansion) repeatedly until it's no longer possible to apply any of them. Sometimes the result of a reduction tactic will be a simple value, for example reducing `2*3+4` with `cbv beta delta iota` to `10`, which requires applying several reduction rules repeatedly. In other cases, it may yield an expression containing variables, axioms or opaque contants that can't be reduced. The useful conversion rules are shown below. All of them except for eta-expansion can be applied with conversion tactics such as :tacn:`cbv`: .. list-table:: :header-rows: 1 * - Conversion name - Description * - beta-reduction - eliminates `fun` * - delta-reduction - replaces a defined variable or constant with its definition * - zeta-reduction - eliminates `let` * - eta-expansion - replaces a term `f` of type `forall a : A, B` with `fun x : A => f x` * - match-reduction - eliminates `match` * - fix-reduction - replaces a `fix` with a :term:`beta-redex`; recursive calls to the symbol are replaced with the `fix` term * - cofix-reduction - replaces a `cofix` with a :term:`beta-redex`; recursive calls to the symbol are replaced with the `cofix` term * - iota-reduction - match-, fix- and cofix-reduction together :ref:`applyingconversionrules` describes tactics that only apply conversion rules. (Other tactics may use conversion rules in addition to other changes to the proof state.) α-conversion ~~~~~~~~~~~~ Two terms are :gdef:`α-convertible ` if they are syntactically equal ignoring differences in the names of variables bound within the expression. For example `forall x, x + 0 = x` is α-convertible with `forall y, y + 0 = y`. β-reduction ~~~~~~~~~~~ :gdef:`β-reduction ` reduces a :gdef:`beta-redex`, which is a term in the form `(fun x => t) u`. (Beta-redex is short for "beta-reducible expression", a term from lambda calculus. See `Beta reduction `_ for more background.) Formally, in any :term:`global environment` :math:`E` and :term:`local context` :math:`Γ`, the beta-reduction rule is: .. inference:: Beta -------------- E[Γ] ⊢ ((λx:T.~t)~u)~\triangleright_β~\subst{t}{x}{u} We say that :math:`\subst{t}{x}{u}` is the *β-contraction* of :math:`((λx:T.~t)~u)` and, conversely, that :math:`((λ x:T.~t)~u)` is the *β-expansion* of :math:`\subst{t}{x}{u}`. .. todo: :term:`Calculus of Inductive Constructions` fails to build in CI for some reason :-() Terms of the *Calculus of Inductive Constructions* enjoy some fundamental properties such as confluence, strong normalization, subject reduction. These results are theoretically of great importance but we will not detail them here and refer the interested reader to :cite:`Coq85`. .. _delta-reduction-sect: δ-reduction ~~~~~~~~~~~ :gdef:`δ-reduction ` replaces variables defined in :term:`local contexts ` or :term:`constants ` defined in the :term:`global environment` with their values. :gdef:`Unfolding ` means to replace a constant by its definition. Formally, this is: .. inference:: Delta-Local \WFE{\Gamma} (x:=t:T) ∈ Γ -------------- E[Γ] ⊢ x~\triangleright_Δ~t .. inference:: Delta-Global \WFE{\Gamma} (c:=t:T) ∈ E -------------- E[Γ] ⊢ c~\triangleright_δ~t :term:`Delta-reduction ` only unfolds :term:`constants ` that are marked :gdef:`transparent`. :gdef:`Opaque ` is the opposite of transparent; :term:`delta-reduction` doesn't unfold opaque constants. ι-reduction ~~~~~~~~~~~ A specific conversion rule is associated with the inductive objects in the global environment. We shall give later on (see Section :ref:`Well-formed-inductive-definitions`) the precise rules but it just says that a destructor applied to an object built from a constructor behaves as expected. This reduction is called :gdef:`ι-reduction ` and is more precisely studied in :cite:`Moh93,Wer94`. ζ-reduction ~~~~~~~~~~~ :gdef:`ζ-reduction ` removes :ref:`let-in definitions ` in terms by replacing the defined variable by its value. One way this reduction differs from δ-reduction is that the declaration is removed from the term entirely. Formally, this is: .. inference:: Zeta \WFE{\Gamma} \WTEG{u}{U} \WTE{\Gamma::(x:=u:U)}{t}{T} -------------- E[Γ] ⊢ \letin{x}{u:U}{t}~\triangleright_ζ~\subst{t}{x}{u} .. _eta-expansion-sect: η-expansion ~~~~~~~~~~~ Another important concept is :gdef:`η-expansion `. It is legal to identify any term :math:`t` of functional type :math:`∀ x:T,~U` with its so-called η-expansion .. math:: λx:T.~(t~x) for :math:`x` an arbitrary variable name fresh in :math:`t`. .. note:: We deliberately do not define η-reduction: .. math:: λ x:T.~(t~x)~\not\triangleright_η~t This is because, in general, the type of :math:`t` need not be convertible to the type of :math:`λ x:T.~(t~x)`. E.g., if we take :math:`f` such that: .. math:: f ~:~ ∀ x:\Type(2),~\Type(1) then .. math:: λ x:\Type(1).~(f~x) ~:~ ∀ x:\Type(1),~\Type(1) We could not allow .. math:: λ x:\Type(1).~(f~x) ~\triangleright_η~ f because the type of the reduced term :math:`∀ x:\Type(2),~\Type(1)` would not be convertible to the type of the original term :math:`∀ x:\Type(1),~\Type(1)`. Examples ~~~~~~~~ .. example:: Simple delta, fix, beta and match reductions ``+`` is a :ref:`notation ` for ``Nat.add``, which is defined with a :cmd:`Fixpoint`. .. coqtop:: all abort Print Nat.add. Goal 1 + 1 = 2. cbv delta. cbv fix. cbv beta. cbv match. The term can be fully reduced with `cbv`: .. coqtop:: all abort Goal 1 + 1 = 2. cbv. .. _proof-irrelevance: Proof Irrelevance ~~~~~~~~~~~~~~~~~ It is legal to identify any two terms whose common type is a strict proposition :math:`A : \SProp`. Terms in a strict propositions are therefore called *irrelevant*. .. _convertibility: Convertibility ~~~~~~~~~~~~~~ Let us write :math:`E[Γ] ⊢ t \triangleright u` for the contextual closure of the relation :math:`t` reduces to :math:`u` in the global environment :math:`E` and local context :math:`Γ` with one of the previous reductions β, δ, ι or ζ. We say that two terms :math:`t_1` and :math:`t_2` are *βδιζη-convertible*, or simply :gdef:`convertible`, or :term:`definitionally equal `, in the global environment :math:`E` and local context :math:`Γ` iff there exist terms :math:`u_1` and :math:`u_2` such that :math:`E[Γ] ⊢ t_1 \triangleright … \triangleright u_1` and :math:`E[Γ] ⊢ t_2 \triangleright … \triangleright u_2` and either :math:`u_1` and :math:`u_2` are identical up to irrelevant subterms, or they are convertible up to η-expansion, i.e. :math:`u_1` is :math:`λ x:T.~u_1'` and :math:`u_2 x` is recursively convertible to :math:`u_1'`, or, symmetrically, :math:`u_2` is :math:`λx:T.~u_2'` and :math:`u_1 x` is recursively convertible to :math:`u_2'`. We then write :math:`E[Γ] ⊢ t_1 =_{βδιζη} t_2`. Apart from this we consider two instances of polymorphic and cumulative (see Chapter :ref:`polymorphicuniverses`) inductive types (see below) convertible .. math:: E[Γ] ⊢ t~w_1 … w_m =_{βδιζη} t~w_1' … w_m' if we have subtypings (see below) in both directions, i.e., .. math:: E[Γ] ⊢ t~w_1 … w_m ≤_{βδιζη} t~w_1' … w_m' and .. math:: E[Γ] ⊢ t~w_1' … w_m' ≤_{βδιζη} t~w_1 … w_m. Furthermore, we consider .. math:: E[Γ] ⊢ c~v_1 … v_m =_{βδιζη} c'~v_1' … v_m' convertible if .. math:: E[Γ] ⊢ v_i =_{βδιζη} v_i' and we have that :math:`c` and :math:`c'` are the same constructors of different instances of the same inductive types (differing only in universe levels) such that .. math:: E[Γ] ⊢ c~v_1 … v_m : t~w_1 … w_m and .. math:: E[Γ] ⊢ c'~v_1' … v_m' : t'~ w_1' … w_m ' and we have .. math:: E[Γ] ⊢ t~w_1 … w_m =_{βδιζη} t~w_1' … w_m'. The convertibility relation allows introducing a new typing rule which says that two convertible well-formed types have the same inhabitants. coq-8.20.0/doc/sphinx/language/core/definitions.rst000066400000000000000000000220621466560755400222450ustar00rootroot00000000000000Definitions =========== .. index:: let ... := ... (term) .. _let-in: Let-in definitions ------------------ .. insertprodn term_let term_let .. prodn:: term_let ::= let @name {? : @type } := @term in @term | let @name {+ @binder } {? : @type } := @term in @term | @destructuring_let :n:`let @ident := @term__1 in @term__2` represents the local binding of the variable :n:`@ident` to the value :n:`@term__1` in :n:`@term__2`. :n:`let @ident {+ @binder} := @term__1 in @term__2` is an abbreviation for :n:`let @ident := fun {+ @binder} => @term__1 in @term__2`. .. seealso:: Extensions of the `let ... in ...` syntax are described in :ref:`irrefutable-patterns`. .. index:: single: ... : ... (type cast) single: ... <: ... (VM type cast) single: ... <<: ... (native compute type cast) single: ... :> ... (volatile type cast) .. _type-cast: Type cast --------- .. insertprodn term_cast term_cast .. prodn:: term_cast ::= @term10 : @type | @term10 <: @type | @term10 <<: @type | @term10 :> @type The expression :n:`@term10 : @type` is a type cast expression. It enforces the type of :n:`@term10` to be :n:`@type`. :n:`@term10 <: @type` specifies that the virtual machine will be used to type check that :n:`@term10` has type :n:`@type` (see :tacn:`vm_compute`). :n:`@term10 <<: @type` specifies that compilation to OCaml will be used to type check that :n:`@term10` has type :n:`@type` (see :tacn:`native_compute`). :n:`@term10 :> @type` enforces the type of :n:`@term10` to be :n:`@type` without leaving a trace in the produced value. This is a :gdef:`volatile cast`. If a scope is :ref:`bound ` to :n:`@type` then :n:`@term10` is interpreted in that scope. .. _gallina-definitions: Top-level definitions --------------------- Definitions extend the global environment by associating names to terms. A definition can be seen as a way to give a meaning to a name or as a way to abbreviate a term. In any case, the name can later be replaced at any time by its definition. The operation of unfolding a name into its definition is called :term:`delta-reduction`. A definition is accepted by the system if and only if the defined term is well-typed in the current context of the definition and if the name is not already used. The name defined by the definition is called a :gdef:`constant` and the term it refers to is its :gdef:`body`. A definition has a type, which is the type of its :term:`body`. A formal presentation of constants and environments is given in Section :ref:`typing-rules`. .. cmd:: {| Definition | Example } @ident_decl @def_body :name: Definition; Example .. insertprodn def_body reduce .. prodn:: def_body ::= {* @binder } {? : @type } := {? @reduce } @term | {* @binder } : @type reduce ::= Eval @red_expr in These commands bind :n:`@term` to the name :n:`@ident` in the global environment, provided that :n:`@term` is well-typed. They can take the :attr:`local` :term:`attribute`, which makes the defined :n:`@ident` accessible only through their fully qualified names, even if :cmd:`Import` or its variants has been used on the current :cmd:`Module`. If :n:`@reduce` is present then :n:`@ident` is bound to the result of the specified computation on :n:`@term`. These commands also support the :attr:`universes(polymorphic)`, :attr:`program` (see :ref:`program_definition`), :attr:`canonical`, :attr:`bypass_check(universes)`, :attr:`bypass_check(guard)`, :attr:`deprecated`, :attr:`warn` and :attr:`using` attributes. If :n:`@term` is omitted, :n:`@type` is required and Coq enters proof 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 :term:`constant` for which the computational behavior is relevant. See :ref:`proof-editing-mode`. The form :n:`Definition @ident : @type := @term` checks that the type of :n:`@term` is definitionally equal to :n:`@type`, and registers :n:`@ident` as being of type :n:`@type`, and bound to value :n:`@term`. The form :n:`Definition @ident {* @binder } : @type := @term` is equivalent to :n:`Definition @ident : forall {* @binder }, @type := fun {* @binder } => @term`. .. seealso:: :cmd:`Opaque`, :cmd:`Transparent`, :tacn:`unfold`. .. exn:: @ident already exists. :name: ‘ident’ already exists. (Definition) :undocumented: .. exn:: The term @term has type @type while it is expected to have type @type'. :undocumented: .. _Assertions: Assertions and proofs --------------------- An assertion states a proposition (or a type) for which the proof (or an inhabitant of the type) is interactively built using :term:`tactics `. Assertions cause Coq to enter :term:`proof mode` (see :ref:`proofhandling`). Common tactics are described in the :ref:`writing-proofs` chapter. The basic assertion command is: .. cmd:: @thm_token @ident_decl {* @binder } : @type {* with @ident_decl {* @binder } : @type } :name: Theorem; Lemma; Fact; Remark; Corollary; Proposition; Property .. insertprodn thm_token thm_token .. prodn:: thm_token ::= Theorem | Lemma | Fact | Remark | Corollary | Proposition | Property 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 global 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 coinductive type. It is equivalent to :cmd:`Fixpoint` or :cmd:`CoFixpoint` but using tactics to build the proof of the statements (or the :term:`body` of the specification, depending on the point of view). The inductive or coinductive types on which the induction or coinduction has to be done is assumed to be unambiguous and is guessed by the system. Like in a :cmd:`Fixpoint` or :cmd:`CoFixpoint` definition, the induction hypotheses have to be used on *structurally smaller* arguments (for a :cmd:`Fixpoint`) or be *guarded by a constructor* (for a :cmd:`CoFixpoint`). The verification that recursive proof arguments are correct is done only at the time of registering the lemma in the global environment. To know if the use of induction hypotheses is correct at some time of the interactive development of a proof, use the command :cmd:`Guarded`. This command accepts the :attr:`bypass_check(universes)`, :attr:`bypass_check(guard)`, :attr:`deprecated`, :attr:`warn`, and :attr:`using` attributes. .. exn:: The term @term has type @type which should be Set, Prop or Type. :undocumented: .. exn:: @ident already exists. :name: ‘ident’ already exists. (Theorem) The name you provided is already defined. You have then to choose another name. .. exn:: Nested proofs are discouraged and not allowed by default. This error probably means that you forgot to close the last "Proof." with "Qed." or "Defined.". \ If you really intended to use nested proofs, you can do so by turning the "Nested Proofs Allowed" flag on. You are asserting a new statement when you're already in proof mode. 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 mode until the proof is completed. In proof mode, the user primarily enters tactics (see :ref:`writing-proofs`). The user may also enter commands to manage the proof mode (see :ref:`proofhandling`). When the proof is complete, use the :cmd:`Qed` command so the kernel verifies the proof and adds it to the global environment. .. note:: #. Several statements can be simultaneously asserted provided the :flag:`Nested Proofs Allowed` flag was turned on. #. Not only other assertions but any command can be given while in the process of proving a given assertion. In this case, the command is understood as if it would have been given before the statements still to be proved. Nonetheless, this practice is discouraged and may stop working in future versions. #. Proofs ended by :cmd:`Qed` are declared :term:`opaque`. Their content cannot be unfolded (see :ref:`applyingconversionrules`), thus realizing some form of *proof-irrelevance*. Proofs that end with :cmd:`Defined` can be unfolded. #. :cmd:`Proof` is recommended but can currently be omitted. On the opposite side, :cmd:`Qed` (or :cmd:`Defined`) is mandatory to validate a proof. #. One can also use :cmd:`Admitted` in place of :cmd:`Qed` to turn the current asserted statement into an axiom and exit proof mode. coq-8.20.0/doc/sphinx/language/core/index.rst000066400000000000000000000034751466560755400210500ustar00rootroot00000000000000.. _core-language: ============= Core language ============= 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 `, :ref:`implicit arguments `, etc. (presented in the :ref:`next chapter `), those features are translated into the core language (the Calculus of Inductive Constructions) that the kernel understands, which we present here. Furthermore, while users can build proofs interactively using tactics (see Chapter :ref:`writing-proofs`), the role of these tactics is to incrementally build a "proof term" which the kernel will verify. More precisely, a proof term is a :term:`term` of the Calculus of Inductive Constructions whose :term:`type` corresponds to a theorem statement. The kernel is a type checker which verifies that terms have their expected types. This separation between the kernel on one hand and the :ref:`elaboration engine ` and :ref:`tactics ` on the other follows what is known as the :gdef:`de Bruijn criterion` (keeping a small and well delimited trusted code base within a proof assistant which can be much more complex). This separation makes it necessary to trust only a smaller, critical component (the kernel) instead of the entire system. In particular, users may rely on external plugins that provide advanced and complex tactics without fear of these tactics being buggy, because the kernel will have to check their output. .. toctree:: :maxdepth: 1 basic sorts assumptions definitions conversion ../cic variants records inductive coinductive sections modules primitive ../../addendum/universe-polymorphism ../../addendum/sprop ../../addendum/rewrite-rules coq-8.20.0/doc/sphinx/language/core/inductive.rst000066400000000000000000002051761466560755400217350ustar00rootroot00000000000000Inductive types and recursive functions ======================================= The :cmd:`Inductive` command allows defining types by cases on the form of the :term:`inhabitants ` of the type. These constructors can recursively have arguments in the type being defined. In contrast, in types defined by the :cmd:`Variant` command, such recursive references are not permitted. Inductive types include natural numbers, lists and well-founded trees. Inhabitants of inductive types can recursively nest only a finite number of constructors. So, they are well-founded. This distinguishes them from :cmd:`CoInductive` types, such as streams, whose constructors can be infinitely nested. In Coq, :cmd:`Variant` types thus correspond to the common subset of inductive and coinductive types that are non-recursive. Due to the recursive structure of inductive types, functions on inductive types generally must be defined recursively using the :n:`fix` expression (see :n:`@term_fix`) or the :cmd:`Fixpoint` command. .. _gallina-inductive-definitions: Inductive types --------------- .. cmd:: Inductive @inductive_definition {* with @inductive_definition } Inductive @record_definition {* with @record_definition } .. insertprodn inductive_definition constructor .. prodn:: inductive_definition ::= @ident {? @cumul_univ_decl } {* @binder } {? %| {* @binder } } {? : @type } := {? %| } {+| @constructor } {? @decl_notations } constructor ::= {* #[ {+, @attribute } ] } @ident {* @binder } {? @of_type_inst } Defines one or more inductive types and its constructors. Coq generates :gdef:`induction principles ` depending on the universe that the inductive type belongs to. The induction principles are named :n:`@ident`\ ``_rect``, :n:`@ident`\ ``_ind``, :n:`@ident`\ ``_rec`` and :n:`@ident`\ ``_sind``, which respectively correspond to on :g:`Type`, :g:`Prop`, :g:`Set` and :g:`SProp`. Their types expresses structural induction/recursion principles over objects of type :n:`@ident`. These :term:`constants ` are generated when possible (for instance :n:`@ident`\ ``_rect`` may be impossible to derive when :n:`@ident` is a proposition). .. flag:: Dependent Proposition Eliminators The inductive principles express dependent elimination when the inductive type allows it (always true when not using :flag:`Primitive Projections`), except by default when the inductive is explicitly declared in `Prop`. Explicitly `Prop` inductive types declared when this flag is enabled also automatically declare dependent inductive principles. Name generation may also change when using tactics such as :tacn:`destruct` on such inductives. Note that explicit declarations through :cmd:`Scheme` are not affected by this flag. :n:`{? %| {* @binder } }` The :n:`|` separates uniform and non uniform parameters. See :flag:`Uniform Inductive Parameters`. The :cmd:`Inductive` command supports the :attr:`universes(polymorphic)`, :attr:`universes(template)`, :attr:`universes(cumulative)`, :attr:`bypass_check(positivity)`, :attr:`bypass_check(universes)` and :attr:`private(matching)` attributes. When record syntax is used, this command also supports the :attr:`projections(primitive)` :term:`attribute`. Also, in the record syntax, if given, the :n:`as @ident` part specifies the name to use for inhabitants of the record in the type of projections. Mutually inductive types can be defined by including multiple :n:`@inductive_definition`\s. The :n:`@ident`\s are simultaneously added to the global environment before the types of constructors are checked. Each :n:`@ident` can be used independently thereafter. However, the induction principles currently generated for such types are not useful. Use the :cmd:`Scheme` command to generate useful induction principles. See :ref:`mutually_inductive_types`. If the entire inductive definition is parameterized with :n:`@binder`\s, those :gdef:`inductive parameters ` correspond to a local context in which the entire set of inductive declarations is interpreted. For this reason, the parameters must be strictly the same for each inductive type. See :ref:`parametrized-inductive-types`. Constructor :n:`@ident`\s can come with :n:`@binder`\s, in which case the actual type of the constructor is :n:`forall {* @binder }, @type`. .. exn:: Non strictly positive occurrence of @ident in @type. The types of the constructors have to satisfy a *positivity condition* (see Section :ref:`positivity`). This condition ensures the soundness of the inductive definition. Positivity checking can be disabled using the :flag:`Positivity Checking` flag or the :attr:`bypass_check(positivity)` attribute (see :ref:`controlling-typing-flags`). .. exn:: The conclusion of @type is not valid; it must be built from @ident. The conclusion of the type of the constructors must be the inductive type :n:`@ident` being defined (or :n:`@ident` applied to arguments in the case of indexed inductive types — cf. next section). The following subsections show examples of simple inductive types, simple indexed inductive types, simple parametric inductive types, mutually inductive types and private (matching) inductive types. .. _simple-inductive-types: Simple inductive types ~~~~~~~~~~~~~~~~~~~~~~ A simple inductive type belongs to a universe that is a simple :n:`@sort`. .. example:: The set of natural numbers is defined as: .. coqtop:: reset all Inductive nat : Set := | O : nat | S : nat -> nat. The type nat is defined as the least :g:`Set` containing :g:`O` and closed by the :g:`S` constructor. The names :g:`nat`, :g:`O` and :g:`S` are added to the global environment. This definition generates four :term:`induction principles `: :g:`nat_rect`, :g:`nat_ind`, :g:`nat_rec` and :g:`nat_sind`. The type of :g:`nat_ind` is: .. coqtop:: all Check nat_ind. This is the well known structural induction principle over natural numbers, i.e. the second-order form of Peano’s induction principle. It allows proving universal properties of natural numbers (:g:`forall n:nat, P n`) by induction on :g:`n`. The types of :g:`nat_rect`, :g:`nat_rec` and :g:`nat_sind` are similar, except that they apply to, respectively, :g:`(P:nat->Type)`, :g:`(P:nat->Set)` and :g:`(P:nat->SProp)`. They correspond to primitive induction principles (allowing dependent types) respectively over sorts ``Type``, ``Set`` and ``SProp``. In the case where inductive types don't have indices (the next section gives an example of indices), a constructor can be defined by giving the type of its arguments alone. .. example:: .. coqtop:: reset none Reset nat. .. coqtop:: in Inductive nat : Set := O | S (_:nat). Automatic Prop lowering +++++++++++++++++++++++ When an inductive is declared without an explicit sort, it is put in the smallest sort which permits large elimination (excluding `SProp`). For :ref:`empty and singleton ` types this means they are declared in `Prop`. .. flag:: Automatic Proposition Inductives By default the above behaviour is extended to empty and singleton inductives explicitly declared in `Type` (but not those in explicit universes using `Type@{u}`, or in `Type` through an auxiliary definition such as `Definition typ := Type.`). Disabling this flag prevents inductives with an explicit non-`Prop` type from being lowered to `Prop`. This will become the default in a future version. Use :flag:`Dependent Proposition Eliminators` to declare the inductive type in `Prop` while preserving compatibility. Depending on universe minimization they may then be declared in `Set` or in a floating universe level, see also :flag:`Universe Minimization ToSet`. .. warn:: Automatically putting @ident in Prop even though it was declared with Type. :name: automatic-prop-lowering This warning is produced when :flag:`Automatic Proposition Inductives` is enabled and resulted in an inductive type being lowered to `Prop`. Simple indexed inductive types ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ In indexed inductive types, the universe where the inductive type is defined is no longer a simple :n:`@sort`, but what is called an arity, which is a type whose conclusion is a :n:`@sort`. .. example:: As an example of indexed inductive types, let us define the :g:`even` predicate: .. coqtop:: all Inductive even : nat -> Prop := | even_0 : even O | even_SS : forall n:nat, even n -> even (S (S n)). The type :g:`nat->Prop` means that :g:`even` is a unary predicate (inductively defined) over natural numbers. The type of its two constructors are the defining clauses of the predicate :g:`even`. The type of :g:`even_ind` is: .. coqtop:: all Check even_ind. From a mathematical point of view, this asserts that the natural numbers satisfying the predicate :g:`even` are exactly in the smallest set of naturals satisfying the clauses :g:`even_0` or :g:`even_SS`. This is why, when we want to prove any predicate :g:`P` over elements of :g:`even`, it is enough to prove it for :g:`O` and to prove that if any natural number :g:`n` satisfies :g:`P` its double successor :g:`(S (S n))` satisfies also :g:`P`. This is analogous to the structural induction principle we got for :g:`nat`. .. _parametrized-inductive-types: Parameterized inductive types ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ In the previous example, each constructor introduces a different instance of the predicate :g:`even`. In some cases, all the constructors introduce the same generic instance of the inductive definition, in which case, instead of an index, we use a context of parameters which are :n:`@binder`\s shared by all the constructors of the definition. Parameters differ from inductive type indices in that the conclusion of each type of constructor invokes the inductive type with the same parameter values of its specification. .. example:: A typical example is the definition of polymorphic lists: .. coqtop:: all Inductive list (A:Set) : Set := | nil : list A | cons : A -> list A -> list A. In the type of :g:`nil` and :g:`cons`, we write ":g:`list A`" and not just ":g:`list`". The constructors :g:`nil` and :g:`cons` have these types: .. coqtop:: all Check nil. Check cons. Observe that the induction principles are also quantified with :g:`(A:Set)`, for example: .. coqtop:: all Check list_ind. Once again, the names of the constructor arguments and the type of the conclusion can be omitted: .. coqtop:: none Reset list. .. coqtop:: in Inductive list (A:Set) : Set := nil | cons (_:A) (_:list A). .. note:: + The constructor type can recursively invoke the inductive definition on an argument which is not the parameter itself. One can define : .. coqtop:: all Inductive list2 (A:Set) : Set := | nil2 : list2 A | cons2 : A -> list2 (A*A) -> list2 A. that can also be written by specifying only the type of the arguments: .. coqtop:: all reset Inductive list2 (A:Set) : Set := | nil2 | cons2 (_:A) (_:list2 (A*A)). But the following definition will give an error: .. coqtop:: all Fail Inductive listw (A:Set) : Set := | nilw : listw (A*A) | consw : A -> listw (A*A) -> listw (A*A). because the conclusion of the type of constructors should be :g:`listw A` in both cases. + A parameterized inductive definition can be defined using indices instead of parameters but it will sometimes give a different (bigger) sort for the inductive definition and will produce a less convenient rule for case elimination. .. flag:: Uniform Inductive Parameters When this :term:`flag` is set (it is off by default), inductive definitions are abstracted over their parameters before type checking constructors, allowing to write: .. coqtop:: all Set Uniform Inductive Parameters. Inductive list3 (A:Set) : Set := | nil3 : list3 | cons3 : A -> list3 -> list3. This behavior is essentially equivalent to starting a new section and using :cmd:`Context` to give the uniform parameters, like so (cf. :ref:`section-mechanism`): .. coqtop:: all reset Section list3. Context (A:Set). Inductive list3 : Set := | nil3 : list3 | cons3 : A -> list3 -> list3. End list3. For finer control, you can use a ``|`` between the uniform and the non-uniform parameters: .. coqtop:: in reset Inductive Acc {A:Type} (R:A->A->Prop) | (x:A) : Prop := Acc_in : (forall y, R y x -> Acc y) -> Acc x. The flag can then be seen as deciding whether the ``|`` is at the beginning (when the flag is unset) or at the end (when it is set) of the parameters when not explicitly given. .. seealso:: Section :ref:`inductive-definitions` and the :tacn:`induction` tactic. .. _mutually_inductive_types: Mutually defined inductive types ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ .. todo: combine with the very similar tree/forest example in reasoning-inductives.rst The induction principles currently generated for mutually defined types are not useful. Use the :cmd:`Scheme` command to generate a useful induction principle. .. example:: Mutually defined inductive types A typical example of mutually inductive data types is trees and forests. We assume two types :g:`A` and :g:`B` that are given as variables. The types can be declared like this: .. coqtop:: in Parameters A B : Set. Inductive tree : Set := node : A -> forest -> tree with forest : Set := | leaf : B -> forest | cons : tree -> forest -> forest. This declaration automatically generates eight induction principles. They are not the most general principles, but they correspond to each inductive part seen as a single inductive definition. To illustrate this point on our example, here are the types of :g:`tree_rec` and :g:`forest_rec`. .. coqtop:: all Check tree_rec. Check forest_rec. Assume we want to parameterize our mutual inductive definitions with the two type variables :g:`A` and :g:`B`, the declaration should be done as follows: .. coqdoc:: Inductive tree (A B:Set) : Set := node : A -> forest A B -> tree A B with forest (A B:Set) : Set := | leaf : B -> forest A B | cons : tree A B -> forest A B -> forest A B. Assume we define an inductive definition inside a section (cf. :ref:`section-mechanism`). When the section is closed, the variables declared in the section and occurring free in the declaration are added as parameters to the inductive definition. .. seealso:: A generic command :cmd:`Scheme` is useful to build automatically various mutual induction principles. .. index:: single: fix Recursive functions: fix ------------------------ .. insertprodn term_fix fixannot .. prodn:: term_fix ::= let fix @fix_decl in @term | fix @fix_decl {? {+ with @fix_decl } for @ident } fix_decl ::= @ident {* @binder } {? @fixannot } {? : @type } := @term fixannot ::= %{ struct @ident %} | %{ wf @one_term @ident %} | %{ measure @one_term {? @ident } {? @one_term } %} The expression ":n:`fix @ident__1 @binder__1 : @type__1 := @term__1 with … with @ident__n @binder__n : @type__n := @term__n for @ident__i`" denotes the :math:`i`-th component of a block of functions defined by mutual structural recursion. It is the local counterpart of the :cmd:`Fixpoint` command. When :math:`n=1`, the ":n:`for @ident__i`" clause is omitted. The association of a single fixpoint and a local definition have a special syntax: :n:`let fix @ident {* @binder } := @term in` stands for :n:`let @ident := fix @ident {* @binder } := @term in`. The same applies for cofixpoints. 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:`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: Top-level recursive functions ----------------------------- This section describes the primitive form of definition by recursion over inductive objects. See the :cmd:`Function` command for more advanced constructions. .. cmd:: Fixpoint @fix_definition {* with @fix_definition } .. insertprodn fix_definition fix_definition .. prodn:: fix_definition ::= @ident_decl {* @binder } {? @fixannot } {? : @type } {? := @term } {? @decl_notations } 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 corresponding to these :n:`@binder`\s has type :n:`@type`, and is equivalent to the expression :n:`@term`. The type of :n:`@ident` is consequently :n:`forall {* @binder }, @type` and its value is equivalent to :n:`fun {* @binder } => @term`. This command accepts the :attr:`program`, :attr:`bypass_check(universes)`, and :attr:`bypass_check(guard)` attributes. 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. The point of the :n:`{struct @ident}` annotation (see :n:`@fixannot`) is to let the user tell the system which argument decreases along the recursive calls. The :n:`{struct @ident}` annotation may be left implicit, in which case the system successively tries arguments from left to right until it finds one 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`. 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`. If :n:`@term` is omitted, :n:`@type` is required and Coq enters proof 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 :term:`constant` for which the computational behavior is relevant. See :ref:`proof-editing-mode`. This command accepts the :attr:`using` attribute. .. note:: + Some fixpoints may have several arguments that fit as decreasing arguments, and this choice influences the reduction of the fixpoint. Hence an explicit annotation must be used if the leftmost decreasing argument is not the desired one. Writing explicit annotations can also speed up type checking of large mutual fixpoints. + In order to keep the strong normalization property, the fixed point reduction will only be performed when the argument in position of the decreasing argument (which type should be in an inductive definition) starts with a constructor. .. example:: One can define the addition function as : .. coqtop:: all Fixpoint add (n m:nat) {struct n} : nat := match n with | O => m | S p => S (add p m) end. The match operator matches a value (here :g:`n`) with the various constructors of its (inductive) type. The remaining arguments give the respective values to be returned, as functions of the parameters of the corresponding constructor. Thus here when :g:`n` equals :g:`O` we return :g:`m`, and when :g:`n` equals :g:`(S p)` we return :g:`(S (add p m))`. The match operator is formally described in Section :ref:`match-construction`. The system recognizes that in the inductive call :g:`(add p m)` the first argument actually decreases because it is a *pattern variable* coming from :g:`match n with`. .. example:: The following definition is not correct and generates an error message: .. coqtop:: all Fail Fixpoint wrongplus (n m:nat) {struct n} : nat := match m with | O => n | S p => S (wrongplus n p) end. because the declared decreasing argument :g:`n` does not actually decrease in the recursive call. The function computing the addition over the second argument should rather be written: .. coqtop:: all Fixpoint plus (n m:nat) {struct m} : nat := match m with | O => n | S p => S (plus n p) end. .. example:: The recursive call may not only be on direct subterms of the recursive variable :g:`n` but also on a deeper subterm and we can directly write the function :g:`mod2` which gives the remainder modulo 2 of a natural number. .. coqtop:: all Fixpoint mod2 (n:nat) : nat := match n with | O => O | S p => match p with | O => S O | S q => mod2 q end end. .. _example_mutual_fixpoints: .. example:: Mutual fixpoints The size of trees and forests can be defined the following way: .. coqtop:: all Fixpoint tree_size (t:tree) : nat := match t with | node a f => S (forest_size f) end with forest_size (f:forest) : nat := match f with | leaf b => 1 | cons t f' => (tree_size t + forest_size f') end. .. extracted from CIC chapter .. _inductive-definitions: Theory of inductive definitions ------------------------------- Formally, we can represent any *inductive definition* as :math:`\ind{p}{Γ_I}{Γ_C}` where: + :math:`Γ_I` determines the names and types of inductive types; + :math:`Γ_C` determines the names and types of constructors of these inductive types; + :math:`p` determines the number of parameters of these inductive types. These inductive definitions, together with global assumptions and global definitions, then form the global environment. Additionally, for any :math:`p` there always exists :math:`Γ_P =[a_1 :A_1 ;~…;~a_p :A_p ]` such that each :math:`T` in :math:`(t:T)∈Γ_I \cup Γ_C` can be written as: :math:`∀Γ_P , T'` where :math:`Γ_P` is called the *context of parameters*. Furthermore, we must have that each :math:`T` in :math:`(t:T)∈Γ_I` can be written as: :math:`∀Γ_P,∀Γ_{\mathit{Arr}(t)}, S` where :math:`Γ_{\mathit{Arr}(t)}` is called the *Arity* of the inductive type :math:`t` and :math:`S` is called the sort of the inductive type :math:`t` (not to be confused with :math:`\Sort` which is the set of sorts). .. example:: The declaration for parameterized lists is: .. math:: \ind{1}{[\List:\Set→\Set]}{\left[\begin{array}{rcl} \Nil & : & ∀ A:\Set,~\List~A \\ \cons & : & ∀ A:\Set,~A→ \List~A→ \List~A \end{array} \right]} which corresponds to the result of the Coq declaration: .. coqtop:: in reset Inductive list (A:Set) : Set := | nil : list A | cons : A -> list A -> list A. .. example:: The declaration for a mutual inductive definition of tree and forest is: .. math:: \ind{0}{\left[\begin{array}{rcl}\tree&:&\Set\\\forest&:&\Set\end{array}\right]} {\left[\begin{array}{rcl} \node &:& \forest → \tree\\ \emptyf &:& \forest\\ \consf &:& \tree → \forest → \forest\\ \end{array}\right]} which corresponds to the result of the Coq declaration: .. coqtop:: in Inductive tree : Set := | node : forest -> tree with forest : Set := | emptyf : forest | consf : tree -> forest -> forest. .. example:: The declaration for a mutual inductive definition of even and odd is: .. math:: \ind{0}{\left[\begin{array}{rcl}\even&:&\nat → \Prop \\ \odd&:&\nat → \Prop \end{array}\right]} {\left[\begin{array}{rcl} \evenO &:& \even~0\\ \evenS &:& ∀ n,~\odd~n → \even~(\nS~n)\\ \oddS &:& ∀ n,~\even~n → \odd~(\nS~n) \end{array}\right]} which corresponds to the result of the Coq declaration: .. coqtop:: in Inductive even : nat -> Prop := | even_O : even 0 | even_S : forall n, odd n -> even (S n) with odd : nat -> Prop := | odd_S : forall n, even n -> odd (S n). .. _Types-of-inductive-objects: Types of inductive objects ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ We have to give the type of constants in a global environment :math:`E` which contains an inductive definition. .. inference:: Ind \WFE{Γ} \ind{p}{Γ_I}{Γ_C} ∈ E (a:A)∈Γ_I --------------------- E[Γ] ⊢ a : A .. inference:: Constr \WFE{Γ} \ind{p}{Γ_I}{Γ_C} ∈ E (c:C)∈Γ_C --------------------- E[Γ] ⊢ c : C .. example:: Provided that our global environment :math:`E` contains inductive definitions we showed before, these two inference rules above enable us to conclude that: .. math:: \begin{array}{l} E[Γ] ⊢ \even : \nat→\Prop\\ E[Γ] ⊢ \odd : \nat→\Prop\\ E[Γ] ⊢ \evenO : \even~\nO\\ E[Γ] ⊢ \evenS : ∀ n:\nat,~\odd~n → \even~(\nS~n)\\ E[Γ] ⊢ \oddS : ∀ n:\nat,~\even~n → \odd~(\nS~n) \end{array} .. _Well-formed-inductive-definitions: Well-formed inductive definitions ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ We cannot accept any inductive definition because some of them lead to inconsistent systems. We restrict ourselves to definitions which satisfy a syntactic criterion of positivity. Before giving the formal rules, we need a few definitions: Arity of a given sort +++++++++++++++++++++ A type :math:`T` is an *arity of sort* :math:`s` if it converts to the sort :math:`s` or to a product :math:`∀ x:T,~U` with :math:`U` an arity of sort :math:`s`. .. example:: :math:`A→\Set` is an arity of sort :math:`\Set`. :math:`∀ A:\Prop,~A→ \Prop` is an arity of sort :math:`\Prop`. Arity +++++ A type :math:`T` is an *arity* if there is a :math:`s∈ \Sort` such that :math:`T` is an arity of sort :math:`s`. .. example:: :math:`A→ \Set` and :math:`∀ A:\Prop,~A→ \Prop` are arities. .. Convention in describing inductive types: k is the number of inductive types (I_i : forall params, A_i) n is the number of constructors in the whole block (c_i : forall params, C_i) r is the number of parameters l is the size of the context of parameters (p_i : P_i) m is the number of recursively non-uniform parameters among parameters s is the number of indices q = r+s is the number of parameters and indices Type of constructor +++++++++++++++++++ We say that :math:`T` is a *type of constructor of* :math:`I` in one of the following two cases: + :math:`T` is :math:`(I~t_1 … t_q )` + :math:`T` is :math:`∀ x:U,~T'` where :math:`T'` is also a type of constructor of :math:`I` .. example:: :math:`\nat` and :math:`\nat→\nat` are types of constructor of :math:`\nat`. :math:`∀ A:\Type,~\List~A` and :math:`∀ A:\Type,~A→\List~A→\List~A` are types of constructor of :math:`\List`. .. _positivity: Positivity Condition ++++++++++++++++++++ The type of constructor :math:`T` will be said to *satisfy the positivity condition* for a set of constants :math:`X_1 … X_k` in the following cases: + :math:`T=(X_j~t_1 … t_q )` for some :math:`j` and no :math:`X_1 … X_k` occur free in any :math:`t_i` + :math:`T=∀ x:U,~V` and :math:`X_1 … X_k` occur only strictly positively in :math:`U` and the type :math:`V` satisfies the positivity condition for :math:`X_1 … X_k`. Strict positivity +++++++++++++++++ The constants :math:`X_1 … X_k` *occur strictly positively* in :math:`T` in the following cases: + no :math:`X_1 … X_k` occur in :math:`T` + :math:`T` converts to :math:`(X_j~t_1 … t_q )` for some :math:`j` and no :math:`X_1 … X_k` occur in any of :math:`t_i` + :math:`T` converts to :math:`∀ x:U,~V` and :math:`X_1 … X_k` occur strictly positively in type :math:`V` but none of them occur in :math:`U` + :math:`T` converts to :math:`(I~a_1 … a_r~t_1 … t_s )` where :math:`I` is the name of an inductive definition of the form .. math:: \ind{r}{I:A}{c_1 :∀ p_1 :P_1 ,… ∀p_r :P_r ,~C_1 ;~…;~c_n :∀ p_1 :P_1 ,… ∀p_r :P_r ,~C_n} (in particular, it is not mutually defined and it has :math:`r` parameters) and no :math:`X_1 … X_k` occur in any of the :math:`t_i` nor in any of the :math:`a_j` for :math:`m < j ≤ r` where :math:`m ≤ r` is the number of recursively uniform parameters, and the (instantiated) types of constructor :math:`\subst{C_i}{p_j}{a_j}_{j=1… m}` of :math:`I` satisfy the nested positivity condition for :math:`X_1 … X_k` Nested Positivity +++++++++++++++++ If :math:`I` is a non-mutual inductive type with :math:`r` parameters, then, the type of constructor :math:`T` of :math:`I` *satisfies the nested positivity condition* for a set of constants :math:`X_1 … X_k` in the following cases: + :math:`T=(I~b_1 … b_r~u_1 … u_s)` and no :math:`X_1 … X_k` occur in any :math:`u_i` nor in any of the :math:`b_j` for :math:`m < j ≤ r` where :math:`m ≤ r` is the number of recursively uniform parameters + :math:`T=∀ x:U,~V` and :math:`X_1 … X_k` occur only strictly positively in :math:`U` and the type :math:`V` satisfies the nested positivity condition for :math:`X_1 … X_k` .. example:: For instance, if one considers the following variant of a tree type branching over the natural numbers: .. coqtop:: in Inductive nattree (A:Type) : Type := | leaf : nattree A | natnode : A -> (nat -> nattree A) -> nattree A. Then every instantiated constructor of ``nattree A`` satisfies the nested positivity condition for ``nattree``: + Type ``nattree A`` of constructor ``leaf`` satisfies the positivity condition for ``nattree`` because ``nattree`` does not appear in any (real) arguments of the type of that constructor (primarily because ``nattree`` does not have any (real) arguments) ... (bullet 1) + Type ``A → (nat → nattree A) → nattree A`` of constructor ``natnode`` satisfies the positivity condition for ``nattree`` because: - ``nattree`` occurs only strictly positively in ``A`` ... (bullet 1) - ``nattree`` occurs only strictly positively in ``nat → nattree A`` ... (bullet 3 + 2) - ``nattree`` satisfies the positivity condition for ``nattree A`` ... (bullet 1) .. _Correctness-rules: Correctness rules +++++++++++++++++ We shall now describe the rules allowing the introduction of a new inductive definition. Let :math:`E` be a global environment and :math:`Γ_P`, :math:`Γ_I`, :math:`Γ_C` be contexts such that :math:`Γ_I` is :math:`[I_1 :∀ Γ_P ,A_1 ;~…;~I_k :∀ Γ_P ,A_k]`, and :math:`Γ_C` is :math:`[c_1:∀ Γ_P ,C_1 ;~…;~c_n :∀ Γ_P ,C_n ]`. Then .. inference:: W-Ind \WFE{Γ_P} (E[Γ_I ;Γ_P ] ⊢ C_i : s_{q_i} )_{i=1… n} ------------------------------------------ \WF{E;~\ind{l}{Γ_I}{Γ_C}}{} provided that the following side conditions hold: + :math:`k>0` and all of :math:`I_j` and :math:`c_i` are distinct names for :math:`j=1… k` and :math:`i=1… n`, + :math:`l` is the size of :math:`Γ_P` which is called the context of parameters, + for :math:`j=1… k` we have that :math:`A_j` is an arity of sort :math:`s_j` and :math:`I_j ∉ E`, + for :math:`i=1… n` we have that :math:`C_i` is a type of constructor of :math:`I_{q_i}` which satisfies the positivity condition for :math:`I_1 … I_k` and :math:`c_i ∉ E`. One can remark that there is a constraint between the sort of the arity of the inductive type and the sort of the type of its constructors which will always be satisfied for the impredicative sorts :math:`\SProp` and :math:`\Prop` but may fail to define inductive type on sort :math:`\Set` and generate constraints between universes for inductive types in the Type hierarchy. .. example:: It is well known that the existential quantifier can be encoded as an inductive definition. The following declaration introduces the second-order existential quantifier :math:`∃ X.P(X)`. .. coqtop:: in Inductive exProp (P:Prop->Prop) : Prop := | exP_intro : forall X:Prop, P X -> exProp P. The same definition on :math:`\Set` is not allowed and fails: .. coqtop:: all Fail Inductive exSet (P:Set->Prop) : Set := exS_intro : forall X:Set, P X -> exSet P. It is possible to declare the same inductive definition in the universe :math:`\Type`. The :g:`exType` inductive definition has type :math:`(\Type(i)→\Prop)→\Type(j)` with the constraint that the parameter :math:`X` of :math:`\kw{exT}_{\kw{intro}}` has type :math:`\Type(k)` with :math:`kProp) : Type := exT_intro : forall X:Type, P X -> exType P. .. example:: Negative occurrence (first example) The following inductive definition is rejected because it does not satisfy the positivity condition: .. coqtop:: all Fail Inductive I : Prop := not_I_I (not_I : I -> False) : I. If we were to accept such definition, we could derive a contradiction from it (we can test this by disabling the :flag:`Positivity Checking` flag): .. coqtop:: in #[bypass_check(positivity)] Inductive I : Prop := not_I_I (not_I : I -> False) : I. .. coqtop:: all Definition I_not_I : I -> ~ I := fun i => match i with not_I_I not_I => not_I end. .. coqtop:: in Lemma contradiction : False. Proof. enough (I /\ ~ I) as [] by contradiction. split. - apply not_I_I. intro. now apply I_not_I. - intro. now apply I_not_I. Qed. .. example:: Negative occurrence (second example) Here is another example of an inductive definition which is rejected because it does not satify the positivity condition: .. coqtop:: all Fail Inductive Lam := lam (_ : Lam -> Lam). Again, if we were to accept it, we could derive a contradiction (this time through a non-terminating recursive function): .. coqtop:: in #[bypass_check(positivity)] Inductive Lam := lam (_ : Lam -> Lam). .. coqtop:: all Fixpoint infinite_loop l : False := match l with lam x => infinite_loop (x l) end. Check infinite_loop (lam (@id Lam)) : False. .. example:: Non strictly positive occurrence It is less obvious why inductive type definitions with occurences that are positive but not strictly positive are harmful. We will see that in presence of an impredicative type they are unsound: .. coqtop:: all Fail Inductive A: Type := introA: ((A -> Prop) -> Prop) -> A. If we were to accept this definition we could derive a contradiction by creating an injective function from :math:`A → \Prop` to :math:`A`. This function is defined by composing the injective constructor of the type :math:`A` with the function :math:`λx. λz. z = x` injecting any type :math:`T` into :math:`T → \Prop`. .. coqtop:: in #[bypass_check(positivity)] Inductive A: Type := introA: ((A -> Prop) -> Prop) -> A. .. coqtop:: all Definition f (x: A -> Prop): A := introA (fun z => z = x). .. coqtop:: in Lemma f_inj: forall x y, f x = f y -> x = y. Proof. unfold f; intros ? ? H; injection H. set (F := fun z => z = y); intro HF. symmetry; replace (y = x) with (F y). + unfold F; reflexivity. + rewrite <- HF; reflexivity. Qed. The type :math:`A → \Prop` can be understood as the powerset of the type :math:`A`. To derive a contradiction from the injective function :math:`f` we use Cantor's classic diagonal argument. .. coqtop:: all Definition d: A -> Prop := fun x => exists s, x = f s /\ ~s x. Definition fd: A := f d. .. coqtop:: in Lemma cantor: (d fd) <-> ~(d fd). Proof. split. + intros [s [H1 H2]]; unfold fd in H1. replace d with s. * assumption. * apply f_inj; congruence. + intro; exists d; tauto. Qed. Lemma bad: False. Proof. pose cantor; tauto. Qed. This derivation was first presented by Thierry Coquand and Christine Paulin in :cite:`CP90`. .. _Template-polymorphism: Template polymorphism +++++++++++++++++++++ Inductive types can be made polymorphic over the universes introduced by their parameters in :math:`\Type`, if the minimal inferred sort of the inductive declarations either mention some of those parameter universes or is computed to be :math:`\Prop` or :math:`\Set`. If :math:`A` is an arity of some sort and :math:`s` is a sort, we write :math:`A_{/s}` for the arity obtained from :math:`A` by replacing its sort with :math:`s`. Especially, if :math:`A` is well-typed in some global environment and local context, then :math:`A_{/s}` is typable by typability of all products in the Calculus of Inductive Constructions. The following typing rule is added to the theory. Let :math:`\ind{p}{Γ_I}{Γ_C}` be an inductive definition. Let :math:`Γ_P = [p_1 :P_1 ;~…;~p_p :P_p ]` be its context of parameters, :math:`Γ_I = [I_1:∀ Γ_P ,A_1 ;~…;~I_k :∀ Γ_P ,A_k ]` its context of definitions and :math:`Γ_C = [c_1 :∀ Γ_P ,C_1 ;~…;~c_n :∀ Γ_P ,C_n]` its context of constructors, with :math:`c_i` a constructor of :math:`I_{q_i}`. Let :math:`m ≤ p` be the length of the longest prefix of parameters such that the :math:`m` first arguments of all occurrences of all :math:`I_j` in all :math:`C_k` (even the occurrences in the hypotheses of :math:`C_k`) are exactly applied to :math:`p_1 … p_m` (:math:`m` is the number of *recursively uniform parameters* and the :math:`p−m` remaining parameters are the *recursively non-uniform parameters*). Let :math:`q_1 , …, q_r`, with :math:`0≤ r≤ m`, be a (possibly) partial instantiation of the recursively uniform parameters of :math:`Γ_P`. We have: .. inference:: Ind-Family \left\{\begin{array}{l} \ind{p}{Γ_I}{Γ_C} \in E\\ (E[] ⊢ q_l : P'_l)_{l=1\ldots r}\\ (E[] ⊢ P'_l ≤_{βδιζη} \subst{P_l}{p_u}{q_u}_{u=1\ldots l-1})_{l=1\ldots r}\\ 1 \leq j \leq k \end{array} \right. ----------------------------- E[] ⊢ I_j~q_1 … q_r :∀ [p_{r+1} :P_{r+1} ;~…;~p_p :P_p], (A_j)_{/s_j} provided that the following side conditions hold: + :math:`Γ_{P′}` is the context obtained from :math:`Γ_P` by replacing each :math:`P_l` that is an arity with :math:`P_l'` for :math:`1≤ l ≤ r` (notice that :math:`P_l` arity implies :math:`P_l'` arity since :math:`E[] ⊢ P_l' ≤_{βδιζη} \subst{P_l}{p_u}{q_u}_{u=1\ldots l-1}`); + there are sorts :math:`s_i`, for :math:`1 ≤ i ≤ k` such that, for :math:`Γ_{I'} = [I_1 :∀ Γ_{P'} ,(A_1)_{/s_1} ;~…;~I_k :∀ Γ_{P'} ,(A_k)_{/s_k}]` we have :math:`(E[Γ_{I′} ;Γ_{P′}] ⊢ C_i : s_{q_i})_{i=1… n}` ; + the sorts :math:`s_i` are all introduced by the inductive declaration and have no universe constraints beside being greater than or equal to :math:`\Prop`, and such that all eliminations, to :math:`\Prop`, :math:`\Set` and :math:`\Type(j)`, are allowed (see Section :ref:`Destructors`). Notice that if :math:`I_j~q_1 … q_r` is typable using the rules **Ind-Const** and **App**, then it is typable using the rule **Ind-Family**. Conversely, the extended theory is not stronger than the theory without **Ind-Family**. We get an equiconsistency result by mapping each :math:`\ind{p}{Γ_I}{Γ_C}` occurring into a given derivation into as many different inductive types and constructors as the number of different (partial) replacements of sorts, needed for this derivation, in the parameters that are arities (this is possible because :math:`\ind{p}{Γ_I}{Γ_C}` well-formed implies that :math:`\ind{p}{Γ_{I'}}{Γ_{C'}}` is well-formed and has the same allowed eliminations, where :math:`Γ_{I′}` is defined as above and :math:`Γ_{C′} = [c_1 :∀ Γ_{P′} ,C_1 ;~…;~c_n :∀ Γ_{P′} ,C_n ]`). That is, the changes in the types of each partial instance :math:`q_1 … q_r` can be characterized by the ordered sets of arity sorts among the types of parameters, and to each signature is associated a new inductive definition with fresh names. Conversion is preserved as any (partial) instance :math:`I_j~q_1 … q_r` or :math:`C_i~q_1 … q_r` is mapped to the names chosen in the specific instance of :math:`\ind{p}{Γ_I}{Γ_C}`. .. warning:: The restriction that sorts are introduced by the inductive declaration prevents inductive types declared in sections to be template-polymorphic on universes introduced previously in the section: they cannot parameterize over the universes introduced with section variables that become parameters at section closing time, as these may be shared with other definitions from the same section which can impose constraints on them. .. flag:: Auto Template Polymorphism This :term:`flag`, enabled by default, makes every inductive type declared at level :math:`\Type` (without an explicit universe instance or hiding it behind a definition) template polymorphic if possible. This can be prevented using the :attr:`universes(template=no) ` attribute. Template polymorphism and full universe polymorphism (see Chapter :ref:`polymorphicuniverses`) are incompatible, so if the latter is enabled (through the :flag:`Universe Polymorphism` flag or the :attr:`universes(polymorphic)` attribute) it will prevail over automatic template polymorphism. .. warn:: Automatically declaring @ident as template polymorphic. Warning ``auto-template`` can be used (it is off by default) to find which types are implicitly declared template polymorphic by :flag:`Auto Template Polymorphism`. An inductive type can be forced to be template polymorphic using the :attr:`universes(template)` attribute: in this case, the warning is not emitted. .. attr:: universes(template{? = {| yes | no } }) :name: universes(template) This :term:`boolean attribute` can be used to explicitly declare an inductive type as template polymorphic, whether the :flag:`Auto Template Polymorphism` flag is on or off. .. exn:: template and polymorphism not compatible This attribute cannot be used in a full universe polymorphic context, i.e. if the :flag:`Universe Polymorphism` flag is on or if the :attr:`universes(polymorphic)` attribute is used. .. exn:: Ill-formed template inductive declaration: not polymorphic on any universe. The attribute was used but the inductive definition does not satisfy the criterion to be template polymorphic. When ``universes(template=no)`` is used, it will prevent an inductive type to be template polymorphic, even if the :flag:`Auto Template Polymorphism` flag is on. In practice, the rule **Ind-Family** is used by Coq only when there is only one inductive type in the inductive definition and it is declared with an arity whose sort is in the Type hierarchy. Then, the polymorphism is over the parameters whose type is an arity of sort in the Type hierarchy. The sorts :math:`s_j` are chosen canonically so that each :math:`s_j` is minimal with respect to the hierarchy :math:`\Prop ⊂ \Set_p ⊂ \Type` where :math:`\Set_p` is predicative :math:`\Set`. More precisely, an empty or small singleton inductive definition (i.e. an inductive definition of which all inductive types are singleton – see Section :ref:`Destructors`) is set in :math:`\Prop`, a small non-singleton inductive type is set in :math:`\Set` (even in case :math:`\Set` is impredicative – see :ref:`The-Calculus-of-Inductive-Construction-with-impredicative-Set`), and otherwise in the Type hierarchy. Note that the side-condition about allowed elimination sorts in the rule **Ind-Family** avoids to recompute the allowed elimination sorts at each instance of a pattern matching (see Section :ref:`Destructors`). As an example, let us consider the following definition: .. example:: .. coqtop:: in Inductive option (A:Type) : Type := | None : option A | Some : A -> option A. As the definition is set in the Type hierarchy, it is used polymorphically over its parameters whose types are arities of a sort in the Type hierarchy. Here, the parameter :math:`A` has this property, hence, if :g:`option` is applied to a type in :math:`\Set`, the result is in :math:`\Set`. Note that if :g:`option` is applied to a type in :math:`\Prop`, then, the result is not set in :math:`\Prop` but in :math:`\Set` still. This is because :g:`option` is not a singleton type (see Section :ref:`Destructors`) and it would lose the elimination to :math:`\Set` and :math:`\Type` if set in :math:`\Prop`. .. example:: .. coqtop:: all Check (fun A:Set => option A). Check (fun A:Prop => option A). Here is another example. .. example:: .. coqtop:: in Inductive prod (A B:Type) : Type := pair : A -> B -> prod A B. As :g:`prod` is a singleton type, it will be in :math:`\Prop` if applied twice to propositions, in :math:`\Set` if applied twice to at least one type in :math:`\Set` and none in :math:`\Type`, and in :math:`\Type` otherwise. In all cases, the three kind of eliminations schemes are allowed. .. example:: .. coqtop:: all Check (fun A:Set => prod A). Check (fun A:Prop => prod A A). Check (fun (A:Prop) (B:Set) => prod A B). Check (fun (A:Type) (B:Prop) => prod A B). .. note:: Template polymorphism used to be called “sort-polymorphism of inductive types” before universe polymorphism (see Chapter :ref:`polymorphicuniverses`) was introduced. .. _Destructors: Destructors ~~~~~~~~~~~~~~~~~ The specification of inductive definitions with arities and constructors is quite natural. But we still have to say how to use an object in an inductive type. This problem is rather delicate. There are actually several different ways to do that. Some of them are logically equivalent but not always equivalent from the computational point of view or from the user point of view. From the computational point of view, we want to be able to define a function whose domain is an inductively defined type by using a combination of case analysis over the possible constructors of the object and recursion. Because we need to keep a consistent theory and also we prefer to keep a strongly normalizing reduction, we cannot accept any sort of recursion (even terminating). So the basic idea is to restrict ourselves to primitive recursive functions and functionals. For instance, assuming a parameter :math:`A:\Set` exists in the local context, we want to build a function :math:`\length` of type :math:`\List~A → \nat` which computes the length of the list, such that :math:`(\length~(\Nil~A)) = \nO` and :math:`(\length~(\cons~A~a~l)) = (\nS~(\length~l))`. We want these equalities to be recognized implicitly and taken into account in the conversion rule. From the logical point of view, we have built a type family by giving a set of constructors. We want to capture the fact that we do not have any other way to build an object in this type. So when trying to prove a property about an object :math:`m` in an inductive type it is enough to enumerate all the cases where :math:`m` starts with a different constructor. In case the inductive definition is effectively a recursive one, we want to capture the extra property that we have built the smallest fixed point of this recursive equation. This says that we are only manipulating finite objects. This analysis provides induction principles. For instance, in order to prove :math:`∀ l:\List~A,~(\kw{has}\_\kw{length}~A~l~(\length~l))` it is enough to prove: + :math:`(\kw{has}\_\kw{length}~A~(\Nil~A)~(\length~(\Nil~A)))` + :math:`∀ a:A,~∀ l:\List~A,~(\kw{has}\_\kw{length}~A~l~(\length~l)) →` :math:`(\kw{has}\_\kw{length}~A~(\cons~A~a~l)~(\length~(\cons~A~a~l)))` which given the conversion equalities satisfied by :math:`\length` is the same as proving: + :math:`(\kw{has}\_\kw{length}~A~(\Nil~A)~\nO)` + :math:`∀ a:A,~∀ l:\List~A,~(\kw{has}\_\kw{length}~A~l~(\length~l)) →` :math:`(\kw{has}\_\kw{length}~A~(\cons~A~a~l)~(\nS~(\length~l)))` One conceptually simple way to do that, following the basic scheme proposed by Martin-Löf in his Intuitionistic Type Theory, is to introduce for each inductive definition an elimination operator. At the logical level it is a proof of the usual induction principle and at the computational level it implements a generic operator for doing primitive recursion over the structure. But this operator is rather tedious to implement and use. We choose in this version of Coq to factorize the operator for primitive recursion into two more primitive operations as was first suggested by Th. Coquand in :cite:`Coq92`. One is the definition by pattern matching. The second one is a definition by guarded fixpoints. .. _match-construction: The match ... with ... end construction +++++++++++++++++++++++++++++++++++++++ The basic idea of this operator is that we have an object :math:`m` in an inductive type :math:`I` and we want to prove a property which possibly depends on :math:`m`. For this, it is enough to prove the property for :math:`m = (c_i~u_1 … u_{p_i} )` for each constructor of :math:`I`. The Coq term for this proof will be written: .. math:: \Match~m~\with~(c_1~x_{11} ... x_{1p_1} ) ⇒ f_1 | … | (c_n~x_{n1} ... x_{np_n} ) ⇒ f_n~\kwend In this expression, if :math:`m` eventually happens to evaluate to :math:`(c_i~u_1 … u_{p_i})` then the expression will behave as specified in its :math:`i`-th branch and it will reduce to :math:`f_i` where the :math:`x_{i1} …x_{ip_i}` are replaced by the :math:`u_1 … u_{p_i}` according to the ι-reduction. Actually, for type checking a :math:`\Match…\with…\kwend` expression we also need to know the predicate :math:`P` to be proved by case analysis. In the general case where :math:`I` is an inductively defined :math:`n`-ary relation, :math:`P` is a predicate over :math:`n+1` arguments: the :math:`n` first ones correspond to the arguments of :math:`I` (parameters excluded), and the last one corresponds to object :math:`m`. Coq can sometimes infer this predicate but sometimes not. The concrete syntax for describing this predicate uses the :math:`\as…\In…\return` construction. For instance, let us assume that :math:`I` is an unary predicate with one parameter and one argument. The predicate is made explicit using the syntax: .. math:: \Match~m~\as~x~\In~I~\_~a~\return~P~\with~ (c_1~x_{11} ... x_{1p_1} ) ⇒ f_1 | … | (c_n~x_{n1} ... x_{np_n} ) ⇒ f_n~\kwend The :math:`\as` part can be omitted if either the result type does not depend on :math:`m` (non-dependent elimination) or :math:`m` is a variable (in this case, :math:`m` can occur in :math:`P` where it is considered a bound variable). The :math:`\In` part can be omitted if the result type does not depend on the arguments of :math:`I`. Note that the arguments of :math:`I` corresponding to parameters *must* be :math:`\_`, because the result type is not generalized to all possible values of the parameters. The other arguments of :math:`I` (sometimes called indices in the literature) have to be variables (:math:`a` above) and these variables can occur in :math:`P`. The expression after :math:`\In` must be seen as an *inductive type pattern*. Notice that expansion of implicit arguments and notations apply to this pattern. For the purpose of presenting the inference rules, we use a more compact notation: .. math:: \case(m,(λ a x . P), λ x_{11} ... x_{1p_1} . f_1~| … |~λ x_{n1} ...x_{np_n} . f_n ) .. _Allowed-elimination-sorts: **Allowed elimination sorts.** An important question for building the typing rule for :math:`\Match` is what can be the type of :math:`λ a x . P` with respect to the type of :math:`m`. If :math:`m:I` and :math:`I:A` and :math:`λ a x . P : B` then by :math:`[I:A|B]` we mean that one can use :math:`λ a x . P` with :math:`m` in the above match-construct. .. _cic_notations: **Notations.** The :math:`[I:A|B]` is defined as the smallest relation satisfying the following rules: We write :math:`[I|B]` for :math:`[I:A|B]` where :math:`A` is the type of :math:`I`. The case of inductive types in sorts :math:`\Set` or :math:`\Type` is simple. There is no restriction on the sort of the predicate to be eliminated. .. inference:: Prod [(I~x):A′|B′] ----------------------- [I:∀ x:A,~A′|∀ x:A,~B′] .. inference:: Set & Type s_1 ∈ \{\Set,\Type(j)\} s_2 ∈ \Sort ---------------- [I:s_1 |I→ s_2 ] The case of Inductive definitions of sort :math:`\Prop` is a bit more complicated, because of our interpretation of this sort. The only harmless allowed eliminations, are the ones when predicate :math:`P` is also of sort :math:`\Prop` or is of the morally smaller sort :math:`\SProp`. .. inference:: Prop s ∈ \{\SProp,\Prop\} -------------------- [I:\Prop|I→s] :math:`\Prop` is the type of logical propositions, the proofs of properties :math:`P` in :math:`\Prop` could not be used for computation and are consequently ignored by the extraction mechanism. Assume :math:`A` and :math:`B` are two propositions, and the logical disjunction :math:`A ∨ B` is defined inductively by: .. example:: .. coqtop:: in Inductive or (A B:Prop) : Prop := or_introl : A -> or A B | or_intror : B -> or A B. The following definition which computes a boolean value by case over the proof of :g:`or A B` is not accepted: .. example:: .. coqtop:: all Fail Definition choice (A B: Prop) (x:or A B) := match x with or_introl _ _ a => true | or_intror _ _ b => false end. From the computational point of view, the structure of the proof of :g:`(or A B)` in this term is needed for computing the boolean value. In general, if :math:`I` has type :math:`\Prop` then :math:`P` cannot have type :math:`I→\Set`, because it will mean to build an informative proof of type :math:`(P~m)` doing a case analysis over a non-computational object that will disappear in the extracted program. But the other way is safe with respect to our interpretation we can have :math:`I` a computational object and :math:`P` a non-computational one, it just corresponds to proving a logical property of a computational object. In the same spirit, elimination on :math:`P` of type :math:`I→\Type` cannot be allowed because it trivially implies the elimination on :math:`P` of type :math:`I→ \Set` by cumulativity. It also implies that there are two proofs of the same property which are provably different, contradicting the proof-irrelevance property which is sometimes a useful axiom: .. example:: .. coqtop:: all Axiom proof_irrelevance : forall (P : Prop) (x y : P), x=y. The elimination of an inductive type of sort :math:`\Prop` on a predicate :math:`P` of type :math:`I→ \Type` leads to a paradox when applied to impredicative inductive definition like the second-order existential quantifier :g:`exProp` defined above, because it gives access to the two projections on this type. .. _Empty-and-singleton-elimination: **Empty and singleton elimination.** There are special inductive definitions in :math:`\Prop` for which more eliminations are allowed. .. inference:: Prop-extended I~\kw{is an empty or singleton definition} s ∈ \Sort ------------------------------------- [I:\Prop|I→ s] A *singleton definition* has only one constructor and all the arguments of this constructor have type :math:`\Prop`. In that case, there is a canonical way to interpret the informative extraction on an object in that type, such that the elimination on any sort :math:`s` is legal. Typical examples are the conjunction of non-informative propositions and the equality. If there is a hypothesis :math:`h:a=b` in the local context, it can be used for rewriting not only in logical propositions but also in any type. .. example:: .. coqtop:: all Print eq_rec. Require Extraction. Extraction eq_rec. An empty definition has no constructors, in that case also, elimination on any sort is allowed. .. _Eliminaton-for-SProp: Inductive types in :math:`\SProp` must have no constructors (i.e. be empty) to be eliminated to produce relevant values. Note that thanks to proof irrelevance elimination functions can be produced for other types, for instance the elimination for a unit type is the identity. .. _Type-of-branches: **Type of branches.** Let :math:`c` be a term of type :math:`C`, we assume :math:`C` is a type of constructor for an inductive type :math:`I`. Let :math:`P` be a term that represents the property to be proved. We assume :math:`r` is the number of parameters and :math:`s` is the number of arguments. We define a new type :math:`\{c:C\}^P` which represents the type of the branch corresponding to the :math:`c:C` constructor. .. math:: \begin{array}{ll} \{c:(I~q_1\ldots q_r\ t_1 \ldots t_s)\}^P &\equiv (P~t_1\ldots ~t_s~c) \\ \{c:∀ x:T,~C\}^P &\equiv ∀ x:T,~\{(c~x):C\}^P \end{array} We write :math:`\{c\}^P` for :math:`\{c:C\}^P` with :math:`C` the type of :math:`c`. .. example:: The following term in concrete syntax:: match t as l return P' with | nil _ => t1 | cons _ hd tl => t2 end can be represented in abstract syntax as .. math:: \case(t,P,f_1 | f_2 ) where .. math:: :nowrap: \begin{eqnarray*} P & = & λ l.~P^\prime\\ f_1 & = & t_1\\ f_2 & = & λ (hd:\nat).~λ (tl:\List~\nat).~t_2 \end{eqnarray*} According to the definition: .. math:: \{(\Nil~\nat)\}^P ≡ \{(\Nil~\nat) : (\List~\nat)\}^P ≡ (P~(\Nil~\nat)) .. math:: \begin{array}{rl} \{(\cons~\nat)\}^P & ≡\{(\cons~\nat) : (\nat→\List~\nat→\List~\nat)\}^P \\ & ≡∀ n:\nat,~\{(\cons~\nat~n) : (\List~\nat→\List~\nat)\}^P \\ & ≡∀ n:\nat,~∀ l:\List~\nat,~\{(\cons~\nat~n~l) : (\List~\nat)\}^P \\ & ≡∀ n:\nat,~∀ l:\List~\nat,~(P~(\cons~\nat~n~l)). \end{array} Given some :math:`P` then :math:`\{(\Nil~\nat)\}^P` represents the expected type of :math:`f_1`, and :math:`\{(\cons~\nat)\}^P` represents the expected type of :math:`f_2`. .. _Typing-rule: **Typing rule.** Our very general destructor for inductive definitions has the following typing rule .. inference:: match \begin{array}{l} E[Γ] ⊢ c : (I~q_1 … q_r~t_1 … t_s ) \\ E[Γ] ⊢ P : B \\ [(I~q_1 … q_r)|B] \\ (E[Γ] ⊢ f_i : \{(c_{p_i}~q_1 … q_r)\}^P)_{i=1… l} \end{array} ------------------------------------------------ E[Γ] ⊢ \case(c,P,f_1 |… |f_l ) : (P~t_1 … t_s~c) provided :math:`I` is an inductive type in a definition :math:`\ind{r}{Γ_I}{Γ_C}` with :math:`Γ_C = [c_1 :C_1 ;~…;~c_n :C_n ]` and :math:`c_{p_1} … c_{p_l}` are the only constructors of :math:`I`. .. example:: Below is a typing rule for the term shown in the previous example: .. inference:: list example \begin{array}{l} E[Γ] ⊢ t : (\List ~\nat) \\ E[Γ] ⊢ P : B \\ [(\List ~\nat)|B] \\ E[Γ] ⊢ f_1 : \{(\Nil ~\nat)\}^P \\ E[Γ] ⊢ f_2 : \{(\cons ~\nat)\}^P \end{array} ------------------------------------------------ E[Γ] ⊢ \case(t,P,f_1 |f_2 ) : (P~t) .. _Definition-of-ι-reduction: **Definition of ι-reduction.** We still have to define the ι-reduction in the general case. An ι-redex is a term of the following form: .. math:: \case((c_{p_i}~q_1 … q_r~a_1 … a_m ),P,f_1 |… |f_l ) with :math:`c_{p_i}` the :math:`i`-th constructor of the inductive type :math:`I` with :math:`r` parameters. The ι-contraction of this term is :math:`(f_i~a_1 … a_m )` leading to the general reduction rule: .. math:: \case((c_{p_i}~q_1 … q_r~a_1 … a_m ),P,f_1 |… |f_l ) \triangleright_ι (f_i~a_1 … a_m ) .. _Fixpoint-definitions: Fixpoint definitions ~~~~~~~~~~~~~~~~~~~~ The second operator for elimination is fixpoint definition. This fixpoint may involve several mutually recursive definitions. The basic concrete syntax for a recursive set of mutually recursive declarations is (with :math:`Γ_i` contexts): .. math:: \fix~f_1 (Γ_1 ) :A_1 :=t_1~\with … \with~f_n (Γ_n ) :A_n :=t_n The terms are obtained by projections from this set of declarations and are written .. math:: \fix~f_1 (Γ_1 ) :A_1 :=t_1~\with … \with~f_n (Γ_n ) :A_n :=t_n~\for~f_i In the inference rules, we represent such a term by .. math:: \Fix~f_i\{f_1 :A_1':=t_1' … f_n :A_n':=t_n'\} with :math:`t_i'` (resp. :math:`A_i'`) representing the term :math:`t_i` abstracted (resp. generalized) with respect to the bindings in the context :math:`Γ_i`, namely :math:`t_i'=λ Γ_i . t_i` and :math:`A_i'=∀ Γ_i , A_i`. Typing rule +++++++++++ The typing rule is the expected one for a fixpoint. .. inference:: Fix (E[Γ] ⊢ A_i : s_i )_{i=1… n} (E[Γ;~f_1 :A_1 ;~…;~f_n :A_n ] ⊢ t_i : A_i )_{i=1… n} ------------------------------------------------------- E[Γ] ⊢ \Fix~f_i\{f_1 :A_1 :=t_1 … f_n :A_n :=t_n \} : A_i Any fixpoint definition cannot be accepted because non-normalizing terms allow proofs of absurdity. The basic scheme of recursion that should be allowed is the one needed for defining primitive recursive functionals. In that case the fixpoint enjoys a special syntactic restriction, namely one of the arguments belongs to an inductive type, the function starts with a case analysis and recursive calls are done on variables coming from patterns and representing subterms. For instance in the case of natural numbers, a proof of the induction principle of type .. math:: ∀ P:\nat→\Prop,~(P~\nO)→(∀ n:\nat,~(P~n)→(P~(\nS~n)))→ ∀ n:\nat,~(P~n) can be represented by the term: .. math:: \begin{array}{l} λ P:\nat→\Prop.~λ f:(P~\nO).~λ g:(∀ n:\nat,~(P~n)→(P~(\nS~n))).\\ \Fix~h\{h:∀ n:\nat,~(P~n):=λ n:\nat.~\case(n,P,f | λp:\nat.~(g~p~(h~p)))\} \end{array} Before accepting a fixpoint definition as being correctly typed, we check that the definition is “guarded”. A precise analysis of this notion can be found in :cite:`Gim94`. The first stage is to precise on which argument the fixpoint will be decreasing. The type of this argument should be an inductive type. For doing this, the syntax of fixpoints is extended and becomes .. math:: \Fix~f_i\{f_1/k_1 :A_1:=t_1 … f_n/k_n :A_n:=t_n\} where :math:`k_i` are positive integers. Each :math:`k_i` represents the index of parameter of :math:`f_i`, on which :math:`f_i` is decreasing. Each :math:`A_i` should be a type (reducible to a term) starting with at least :math:`k_i` products :math:`∀ y_1 :B_1 ,~… ∀ y_{k_i} :B_{k_i} ,~A_i'` and :math:`B_{k_i}` an inductive type. Now in the definition :math:`t_i`, if :math:`f_j` occurs then it should be applied to at least :math:`k_j` arguments and the :math:`k_j`-th argument should be syntactically recognized as structurally smaller than :math:`y_{k_i}`. The definition of being structurally smaller is a bit technical. One needs first to define the notion of *recursive arguments of a constructor*. For an inductive definition :math:`\ind{r}{Γ_I}{Γ_C}`, if the type of a constructor :math:`c` has the form :math:`∀ p_1 :P_1 ,~… ∀ p_r :P_r,~∀ x_1:T_1,~… ∀ x_m :T_m,~(I_j~p_1 … p_r~t_1 … t_s )`, then the recursive arguments will correspond to :math:`T_i` in which one of the :math:`I_l` occurs. The main rules for being structurally smaller are the following. Given a variable :math:`y` of an inductively defined type in a declaration :math:`\ind{r}{Γ_I}{Γ_C}` where :math:`Γ_I` is :math:`[I_1 :A_1 ;~…;~I_k :A_k]`, and :math:`Γ_C` is :math:`[c_1 :C_1 ;~…;~c_n :C_n ]`, the terms structurally smaller than :math:`y` are: + :math:`(t~u)` and :math:`λ x:U .~t` when :math:`t` is structurally smaller than :math:`y`. + :math:`\case(c,P,f_1 … f_n)` when each :math:`f_i` is structurally smaller than :math:`y`. If :math:`c` is :math:`y` or is structurally smaller than :math:`y`, its type is an inductive type :math:`I_p` part of the inductive definition corresponding to :math:`y`. Each :math:`f_i` corresponds to a type of constructor :math:`C_q ≡ ∀ p_1 :P_1 ,~…,∀ p_r :P_r ,~∀ y_1 :B_1 ,~… ∀ y_m :B_m ,~(I_p~p_1 … p_r~t_1 … t_s )` and can consequently be written :math:`λ y_1 :B_1' .~… λ y_m :B_m'.~g_i`. (:math:`B_i'` is obtained from :math:`B_i` by substituting parameters for variables) the variables :math:`y_j` occurring in :math:`g_i` corresponding to recursive arguments :math:`B_i` (the ones in which one of the :math:`I_l` occurs) are structurally smaller than :math:`y`. The following definitions are correct, we enter them using the :cmd:`Fixpoint` command and show the internal representation. .. example:: .. coqtop:: all Fixpoint plus (n m:nat) {struct n} : nat := match n with | O => m | S p => S (plus p m) end. Print plus. Fixpoint lgth (A:Set) (l:list A) {struct l} : nat := match l with | nil _ => O | cons _ a l' => S (lgth A l') end. Print lgth. Fixpoint sizet (t:tree) : nat := let (f) := t in S (sizef f) with sizef (f:forest) : nat := match f with | emptyf => O | consf t f => plus (sizet t) (sizef f) end. Print sizet. .. _Reduction-rule: Reduction rule ++++++++++++++ Let :math:`F` be the set of declarations: :math:`f_1 /k_1 :A_1 :=t_1 …f_n /k_n :A_n:=t_n`. The reduction for fixpoints is: .. math:: (\Fix~f_i \{F\}~a_1 …a_{k_i}) ~\triangleright_ι~ \subst{t_i}{f_k}{\Fix~f_k \{F\}}_{k=1… n} ~a_1 … a_{k_i} when :math:`a_{k_i}` starts with a constructor. This last restriction is needed in order to keep strong normalization and corresponds to the reduction for primitive recursive operators. The following reductions are now possible: .. math:: :nowrap: \begin{eqnarray*} \plus~(\nS~(\nS~\nO))~(\nS~\nO)~& \trii & \nS~(\plus~(\nS~\nO)~(\nS~\nO))\\ & \trii & \nS~(\nS~(\plus~\nO~(\nS~\nO)))\\ & \trii & \nS~(\nS~(\nS~\nO))\\ \end{eqnarray*} .. _Mutual-induction: **Mutual induction** The principles of mutual induction can be automatically generated using the Scheme command described in Section :ref:`proofschemes-induction-principles`. coq-8.20.0/doc/sphinx/language/core/modules.rst000066400000000000000000001061231466560755400214030ustar00rootroot00000000000000.. _themodulesystem: The Module System ================= The module system extends the Calculus of Inductive Constructions providing a convenient way to structure large developments as well as a means of massive abstraction. Modules and module types ---------------------------- **Access path.** An access path is denoted by :math:`p` and can be either a module variable :math:`X` or, if :math:`p′` is an access path and :math:`id` an identifier, then :math:`p′.id` is an access path. **Structure element.** A structure element is denoted by :math:`e` and is either a definition of a :term:`constant`, an assumption, a definition of an inductive, a definition of a module, an alias of a module or a module type abbreviation. **Structure expression.** A structure expression is denoted by :math:`S` and can be: + an access path :math:`p` + a plain structure :math:`\Struct~e ; … ; e~\End` + a functor :math:`\Functor(X:S)~S′`, where :math:`X` is a module variable, :math:`S` and :math:`S′` are structure expressions + an application :math:`S~p`, where :math:`S` is a structure expression and :math:`p` an access path + a refined structure :math:`S~\with~p := p′` or :math:`S~\with~p := t:T` where :math:`S` is a structure expression, :math:`p` and :math:`p′` are access paths, :math:`t` is a term and :math:`T` is the type of :math:`t`. **Module definition.** A module definition is written :math:`\Mod{X}{S}{S'}` and consists of a module variable :math:`X`, a module type :math:`S` which can be any structure expression and optionally a module implementation :math:`S′` which can be any structure expression except a refined structure. **Module alias.** A module alias is written :math:`\ModA{X}{p}` and consists of a module variable :math:`X` and a module path :math:`p`. **Module type abbreviation.** A module type abbreviation is written :math:`\ModType{Y}{S}`, where :math:`Y` is an identifier and :math:`S` is any structure expression . .. extracted from Gallina extensions chapter Using modules ------------- The module system provides a way of packaging related elements together, as well as a means of massive abstraction. .. cmd:: Module {? {| Import | Export } {? @import_categories } } @ident {* @module_binder } {? @of_module_type } {? := {+<+ @module_expr_inl } } .. insertprodn module_binder module_expr_inl .. prodn:: module_binder ::= ( {? {| Import | Export } {? @import_categories } } {+ @ident } : @module_type_inl ) module_type_inl ::= ! @module_type | @module_type {? @functor_app_annot } functor_app_annot ::= [ inline at level @natural ] | [ no inline ] module_type ::= @qualid | ( @module_type ) | @module_type @module_expr_atom | @module_type with @with_declaration with_declaration ::= Definition @qualid {? @univ_decl } := @term | Module @qualid := @qualid module_expr_atom ::= @qualid | ( @module_expr_atom ) of_module_type ::= : @module_type_inl | {* <: @module_type_inl } module_expr_inl ::= ! {+ @module_expr_atom } | {+ @module_expr_atom } {? @functor_app_annot } Defines a module named :token:`ident`. See the examples :ref:`here`. The :n:`Import` and :n:`Export` flags specify whether the module should be automatically imported or exported. Specifying :n:`{* @module_binder }` starts a functor with parameters given by the :n:`@module_binder`\s. (A *functor* is a function from modules to modules.) :n:`@of_module_type` specifies the module type. :n:`{+ <: @module_type_inl }` starts a module that satisfies each :n:`@module_type_inl`. .. todo: would like to find a better term than "interactive", not very descriptive :n:`:= {+<+ @module_expr_inl }` specifies the body of a module or functor definition. If it's not specified, then the module is defined *interactively*, meaning that the module is defined as a series of commands terminated with :cmd:`End` instead of in a single :cmd:`Module` command. Interactively defining the :n:`@module_expr_inl`\s in a series of :cmd:`Include` commands is equivalent to giving them all in a single non-interactive :cmd:`Module` command. The ! prefix indicates that any assumption command (such as :cmd:`Axiom`) with an :n:`Inline` clause in the type of the functor arguments will be ignored. .. todo: What is an Inline directive? sb command but still unclear. Maybe referring to the "inline" in functor_app_annot? or assumption_token Inline assum_list? .. cmd:: Module Type @ident {* @module_binder } {* <: @module_type_inl } {? := {+<+ @module_type_inl } } Defines a module type named :n:`@ident`. See the example :ref:`here`. Specifying :n:`{* @module_binder }` starts a functor type with parameters given by the :n:`@module_binder`\s. :n:`:= {+<+ @module_type_inl }` specifies the body of a module or functor type definition. If it's not specified, then the module type is defined *interactively*, meaning that the module type is defined as a series of commands terminated with :cmd:`End` instead of in a single :cmd:`Module Type` command. Interactively defining the :n:`@module_type_inl`\s in a series of :cmd:`Include` commands is equivalent to giving them all in a single non-interactive :cmd:`Module Type` command. .. _terminating_module: **Terminating an interactive module or module type definition** Interactive modules are terminated with the :cmd:`End` command, which is also used to terminate :ref:`Sections`. :n:`End @ident` closes the interactive module or module type :token:`ident`. If the module type was given, the command verifies that the content of the module matches the module type. If the module is not a functor, its components (:term:`constants `, inductive types, submodules etc.) are now available through the dot notation. .. exn:: Signature components for field @ident do not match. :undocumented: .. exn:: The field @ident is missing in @qualid. :undocumented: .. |br| raw:: html
.. note:: #. Interactive modules and module types can be nested. #. Interactive modules and module types can't be defined inside of :ref:`sections`. Sections can be defined inside of interactive modules and module types. #. Hints and notations (the :ref:`Hint ` and :cmd:`Notation` commands) can also appear inside interactive modules and module types. Note that with module definitions like: :n:`Module @ident__1 : @module_type := @ident__2.` or :n:`Module @ident__1 : @module_type.` |br| :n:`Include @ident__2.` |br| :n:`End @ident__1.` hints and the like valid for :n:`@ident__1` are the ones defined in :n:`@module_type` rather then those defined in :n:`@ident__2` (or the module body). #. Within an interactive module type definition, the :cmd:`Parameter` command declares a :term:`constant` instead of definining a new axiom (which it does when not in a module type definition). #. Assumptions such as :cmd:`Axiom` that include the :n:`Inline` clause will be automatically expanded when the functor is applied, except when the function application is prefixed by ``!``. .. cmd:: Include @module_type_inl {* <+ @module_type_inl } Includes the content of module(s) in the current interactive module. Here :n:`@module_type_inl` can be a module expression or a module type expression. If it is a high-order module or module type expression then the system tries to instantiate :n:`@module_type_inl` with the current interactive module. Including multiple modules in a single :cmd:`Include` is equivalent to including each module in a separate :cmd:`Include` command. .. cmd:: Include Type {+<+ @module_type_inl } .. deprecated:: 8.3 Use :cmd:`Include` instead. .. cmd:: Declare Module {? {| Import | Export } {? @import_categories } } @ident {* @module_binder } : @module_type_inl Declares a module :token:`ident` of type :token:`module_type_inl`. If :n:`@module_binder`\s are specified, declares a functor with parameters given by the list of :token:`module_binder`\s. .. cmd:: Import {? @import_categories } {+ @filtered_import } .. insertprodn import_categories filtered_import .. prodn:: import_categories ::= {? - } ( {+, @qualid } ) filtered_import ::= @qualid {? ( {+, @qualid {? ( .. ) } } ) } If :token:`qualid` denotes a valid basic module (i.e. its module type is a signature), makes its components available by their short names. .. example:: .. coqtop:: reset in Module Mod. Definition T:=nat. Check T. End Mod. Check Mod.T. .. coqtop:: all Fail Check T. Import Mod. Check T. Some features defined in modules are activated only when a module is imported. This is for instance the case of notations (see :ref:`Notations`). Declarations made with the :attr:`local` attribute are never imported by the :cmd:`Import` command. Such declarations are only accessible through their fully qualified name. .. example:: .. coqtop:: in Module A. Module B. Local Definition T := nat. End B. End A. Import A. .. coqtop:: all fail Check B.T. Appending a module name with a parenthesized list of names will make only those names available with short names, not other names defined in the module nor will it activate other features. The names to import may be :term:`constants `, inductive types and constructors, and notation aliases (for instance, Ltac definitions cannot be selectively imported). If they are from an inner module to the one being imported, they must be prefixed by the inner path. The name of an inductive type may also be followed by ``(..)`` to import it, its constructors and its eliminators if they exist. For this purpose "eliminator" means a :term:`constant` in the same module whose name is the inductive type's name suffixed by one of ``_sind``, ``_ind``, ``_rec`` or ``_rect``. .. example:: .. coqtop:: reset in Module A. Module B. Inductive T := C. Definition U := nat. End B. Definition Z := Prop. End A. Import A(B.T(..), Z). .. coqtop:: all Check B.T. Check B.C. Check Z. Fail Check B.U. Check A.B.U. .. warn:: Cannot import local constant, it will be ignored. This warning is printed when a name in the list of names to import was declared as a local constant, and the name is not imported. Putting a list of :n:`@import_categories` after ``Import`` will restrict activation of features according to those categories. Currently supported categories are: - ``coercions`` corresponding to :cmd:`Coercion`. - ``hints`` corresponding to the `Hint` commands (e.g. :cmd:`Hint Resolve` or :cmd:`Hint Rewrite`) and :ref:`typeclass ` instances. - ``canonicals`` corresponding to :cmd:`Canonical Structure`. - ``notations`` corresponding to :cmd:`Notation` (including :cmd:`Reserved Notation`), scope controls (:cmd:`Delimit Scope`, :cmd:`Bind Scope`, :cmd:`Open Scope`) but not :ref:`Abbreviations`. - ``options`` for :ref:`flags-options-tables` - ``ltac.notations`` corresponding to :cmd:`Tactic Notation`. - ``ltac2.notations`` corresponding to :cmd:`Ltac2 Notation` (including Ltac2 abbreviations). Plugins may define their own categories. .. cmd:: Export {? @import_categories } {+ @filtered_import } Similar to :cmd:`Import`, except that when the module containing this command is imported, the :n:`{+ @qualid }` are imported as well. The selective import syntax also works with Export. .. exn:: @qualid is not a module. :undocumented: .. warn:: Trying to mask the absolute name @qualid! :undocumented: .. cmd:: Print Module @qualid Prints the module type and (optionally) the body of the module :n:`@qualid`. .. cmd:: Print Module Type @qualid Prints the module type corresponding to :n:`@qualid`. .. flag:: Short Module Printing This :term:`flag` (off by default) disables the printing of the types of fields, leaving only their names, for the commands :cmd:`Print Module` and :cmd:`Print Module Type`. .. cmd:: Print Namespace @dirpath Prints the names and types of all loaded constants whose fully qualified names start with :n:`@dirpath`. For example, the command ``Print Namespace Coq.`` displays the names and types of all loaded constants in the standard library. The command ``Print Namespace Coq.Init`` only shows constants defined in one of the files in the ``Init`` directory. The command ``Print Namespace Coq.Init.Nat`` shows what is in the ``Nat`` library file inside the ``Init`` directory. Module names may appear in :n:`@dirpath`. .. example:: .. coqtop:: reset in Module A. Definition foo := 0. Module B. Definition bar := 1. End B. End A. .. coqtop:: all Print Namespace Top. Print Namespace Top.A. Print Namespace Top.A.B. .. _module_examples: Examples ~~~~~~~~ .. example:: Defining a simple module interactively .. coqtop:: in Module M. Definition T := nat. Definition x := 0. .. coqtop:: all Definition y : bool. exact true. .. coqtop:: in Defined. End M. Inside a module one can define :term:`constants `, prove theorems and do anything else that can be done in the toplevel. Components of a closed module can be accessed using the dot notation: .. coqtop:: all Print M.x. .. _example_def_simple_module_type: .. example:: Defining a simple module type interactively .. coqtop:: in Module Type SIG. Parameter T : Set. Parameter x : T. End SIG. .. _example_filter_module: .. example:: Creating a new module that omits some items from an existing module Since :n:`SIG`, the type of the new module :n:`N`, doesn't define :n:`y` or give the body of :n:`x`, which are not included in :n:`N`. .. coqtop:: all Module N : SIG with Definition T := nat := M. Print N.T. Print N.x. Fail Print N.y. .. reset to remove N (undo in last coqtop block doesn't seem to do that), invisibly redefine M, SIG .. coqtop:: none reset Module M. Definition T := nat. Definition x := 0. Definition y : bool. exact true. Defined. End M. Module Type SIG. Parameter T : Set. Parameter x : T. End SIG. The definition of :g:`N` using the module type expression :g:`SIG` with :g:`Definition T := nat` is equivalent to the following one: .. coqtop:: in Module Type SIG'. Definition T : Set := nat. Parameter x : T. End SIG'. Module N : SIG' := M. .. exn:: No field named @ident in @qualid. Raised when the final :n:`@ident` in the left-hand side :n:`@qualid` of a :n:`@with_declaration` is applied to a module type :n:`@qualid` that has no field named this :n:`@ident`. If we just want to be sure that our implementation satisfies a given module type without restricting the interface, we can use a transparent constraint .. coqtop:: in Module P <: SIG := M. .. coqtop:: all Print P.y. .. example:: Creating a functor (a module with parameters) .. coqtop:: in Module Two (X Y: SIG). Definition T := (X.T * Y.T)%type. Definition x := (X.x, Y.x). End Two. and apply it to our modules and do some computations: .. coqtop:: in Module Q := Two M N. .. coqtop:: all Eval compute in (fst Q.x + snd Q.x). .. example:: A module type with two sub-modules, sharing some fields .. coqtop:: in Module Type SIG2. Declare Module M1 : SIG. Module M2 <: SIG. Definition T := M1.T. Parameter x : T. End M2. End SIG2. .. coqtop:: in Module Mod <: SIG2. Module M1. Definition T := nat. Definition x := 1. End M1. Module M2 := M. End Mod. Notice that ``M`` is a correct body for the component ``M2`` since its ``T`` component is ``nat`` as specified for ``M1.T``. .. extracted from Gallina extensions chapter .. _qualified-names: Qualified names --------------- Qualified names (:token:`qualid`\s) are hierarchical names that are used to identify items such as definitions, theorems and parameters that may be defined inside modules (see :cmd:`Module`). In addition, they are used to identify compiled files. Syntactically, they have this form: .. insertprodn qualid qualid .. prodn:: qualid ::= @ident {* .@ident } *Fully qualified* or *absolute* qualified names uniquely identify files (as in the `Require` command) and items within files, such as a single :cmd:`Variable` definition. It's usually possible to use a suffix of the fully qualified name (a *short name*) that uniquely identifies an item. The first part of a fully qualified name identifies a file, which may be followed by a second part that identifies a specific item within that file. Qualified names that identify files don't have a second part. While qualified names always consist of a series of dot-separated :n:`@ident`\s, *the following few paragraphs omit the dots for the sake of simplicity.* **File part.** Files are identified by :gdef:`logical paths `, which are prefixes in the form :n:`{* @ident__logical } {+ @ident__file }`, such as :n:`Coq.Init.Logic`, in which: - :n:`{* @ident__logical }`, the :gdef:`logical name`, maps to one or more directories (or :gdef:`physical paths `) in the user's file system. The logical name is used so that Coq scripts don't depend on where files are installed. For example, the directory associated with :n:`Coq` contains Coq's standard library. The logical name is generally a single :n:`@ident`. - :n:`{+ @ident__file }` corresponds to the file system path of the file relative to the directory that contains it. For example, :n:`Init.Logic` corresponds to the file system path :n:`Init/Logic.v` on Linux) When Coq is processing a script that hasn't been saved in a file, such as a new buffer in CoqIDE or anything in coqtop, definitions in the script are associated with the logical name :n:`Top` and there is no associated file system path. **Item part.** Items are further qualified by a suffix in the form :n:`{* @ident__module } @ident__base` in which: - :n:`{* @ident__module }` gives the names of the nested modules, if any, that syntactically contain the definition of the item. (See :cmd:`Module`.) - :n:`@ident__base` is the base name used in the command defining the item. For example, :n:`eq` in the :cmd:`Inductive` command defining it in `Coq.Init.Logic` is the base name for `Coq.Init.Logic.eq`, the standard library definition of :term:`Leibniz equality`. If :n:`@qualid` is the fully qualified name of an item, Coq always interprets :n:`@qualid` as a reference to that item. If :n:`@qualid` is also a partially qualified name for another item, then you must provide a more-qualified name to uniquely identify that other item. For example, if there are two fully qualified items named `Foo.Bar` and `Coq.X.Foo.Bar`, then `Foo.Bar` refers to the first item and `X.Foo.Bar` is the shortest name for referring to the second item. Definitions with the :attr:`local` attribute are only accessible with their fully qualified name (see :ref:`gallina-definitions`). .. example:: .. coqtop:: all Check 0. Definition nat := bool. Check 0. Check Datatypes.nat. Locate nat. .. seealso:: Commands :cmd:`Locate`. :ref:`logical-paths-load-path` describes how :term:`logical paths ` become associated with specific files. .. _controlling-locality-of-commands: Controlling the scope of commands with locality attributes ---------------------------------------------------------- Many commands have effects that apply only within a specific scope, typically the section or the module in which the command was called. Locality :term:`attributes ` can alter the scope of the effect. Below, we give the semantics of each locality attribute while noting a few exceptional commands for which :attr:`local` and :attr:`global` attributes are interpreted differently. .. attr:: local This :term:`attribute` limits the effect of the command to the current scope (section or module). The ``Local`` prefix is an alternative syntax for the :attr:`local` attribute (see :n:`@legacy_attr`). .. note:: - For some commands, this is the only locality supported within sections (e.g., for :cmd:`Notation`, :cmd:`Ltac` and :ref:`Hint ` commands). - For some commands, this is the default locality within sections even though other locality attributes are supported as well (e.g., for the :cmd:`Arguments` command). .. warning:: **Exception:** when :attr:`local` is applied to :cmd:`Definition`, :cmd:`Theorem` or their variants, its semantics are different: it makes the defined objects available only through their fully qualified names rather than their unqualified names after an :cmd:`Import`. .. attr:: export This :term:`attribute` makes the effect of the command persist when the section is closed and applies the effect when the module containing the command is imported. Commands supporting this attribute include :cmd:`Set`, :cmd:`Unset` and the :ref:`Hint ` commands, although the latter don't support it within sections. .. attr:: global This :term:`attribute` makes the effect of the command persist even when the current section or module is closed. Loading the file containing the command (possibly transitively) applies the effect of the command. The ``Global`` prefix is an alternative syntax for the :attr:`global` attribute (see :n:`@legacy_attr`). .. warning:: **Exception:** for a few commands (like :cmd:`Notation` and :cmd:`Ltac`), this attribute behaves like :attr:`export`. .. warning:: We strongly discourage using the :attr:`global` locality attribute because the transitive nature of file loading gives the user little control. We recommend using the :attr:`export` locality attribute where it is supported. .. _visibility-attributes-modules: Summary of locality attributes in a module ------------------------------------------ This table sums up the effect of locality attributes on the scope of vernacular commands in a module, when outside the module where they were entered. In the following table: * a cross (❌) marks an unsupported attribute (compilation error); * “not available” means that the command has no effect outside the :cmd:`Module` it was entered; * “when imported” means that the command has effect outside the :cmd:`Module` if, and only if, the :cmd:`Module` (or the command, via :n:`@filtered_import`) is imported (with :cmd:`Import` or :cmd:`Export`). * “short name when imported” means that the command has effects outside the :cmd:`Module`; if the :cmd:`Module` (or command, via :n:`@filtered_import`) is not imported, the associated identifiers must be qualified; * “qualified name” means that the command has effects outside the :cmd:`Module`, but the corresponding identifier may only be referred to with a qualified name; * “always” means that the command always has effects outside the :cmd:`Module` (even if it is not imported). A similar table for :cmd:`Section` can be found :ref:`here`. .. list-table:: :header-rows: 1 * - ``Command`` - no attribute - :attr:`local` - :attr:`export` - :attr:`global` * - :cmd:`Definition`, :cmd:`Lemma`, :cmd:`Axiom`, ... - :attr:`global` - qualified name - ❌ - short name when imported * - :cmd:`Ltac` - :attr:`global` - not available - ❌ - short name when imported * - :cmd:`Ltac2` - :attr:`global` - not available - ❌ - short name when imported * - :cmd:`Notation (abbreviation)` - :attr:`global` - not available - ❌ - short name when imported * - :cmd:`Notation` - :attr:`global` - not available - ❌ - when imported * - :cmd:`Tactic Notation` - :attr:`global` - not available - ❌ - when imported * - :cmd:`Ltac2 Notation` - :attr:`global` - not available - ❌ - when imported * - :cmd:`Coercion` - :attr:`global` - not available - ❌ - when imported * - :cmd:`Canonical Structure` - :attr:`global` - when imported - ❌ - when imported * - ``Hints`` (and :cmd:`Instance`) - :attr:`export` - not available - when imported - always * - :cmd:`Set` or :cmd:`Unset` a flag - :attr:`local` - not available - when imported - always Typing Modules ------------------ In order to introduce the typing system we first slightly extend the syntactic class of terms and environments given in section :ref:`The-terms`. The environments, apart from definitions of :term:`constants ` and inductive types now also hold any other structure elements. Terms, apart from variables, :term:`constants ` and complex terms, also include access paths. We also need additional typing judgments: + :math:`\WFT{E}{S}`, denoting that a structure :math:`S` is well-formed, + :math:`\WTM{E}{p}{S}`, denoting that the module pointed by :math:`p` has type :math:`S` in the global environment :math:`E`. + :math:`\WEV{E}{S}{\ovl{S}}`, denoting that a structure :math:`S` is evaluated to a structure :math:`\ovl{S}` in weak head normal form. + :math:`\WS{E}{S_1}{S_2}` , denoting that a structure :math:`S_1` is a subtype of a structure :math:`S_2`. + :math:`\WS{E}{e_1}{e_2}` , denoting that a structure element :math:`e_1` is more precise than a structure element :math:`e_2`. The rules for forming structures are the following: .. inference:: WF-STR \WF{E;E′}{} ------------------------ \WFT{E}{ \Struct~E′ ~\End} .. inference:: WF-FUN \WFT{E; \ModS{X}{S}}{ \ovl{S′} } -------------------------- \WFT{E}{ \Functor(X:S)~S′} Evaluation of structures to weak head normal form: .. inference:: WEVAL-APP \begin{array}{c} \WEV{E}{S}{\Functor(X:S_1 )~S_2}~~~~~\WEV{E}{S_1}{\ovl{S_1}} \\ \WTM{E}{p}{S_3}~~~~~ \WS{E}{S_3}{\ovl{S_1}} \end{array} -------------------------- \WEV{E}{S~p}{\subst{S_2}{X}{p}} .. inference:: WEVAL-WITH-MOD \begin{array}{c} E[] ⊢ S \lra \Struct~e_1 ;…;e_i ; \ModS{X}{S_1 };e_{i+2} ;… ;e_n ~\End \\ E;e_1 ;…;e_i [] ⊢ S_1 \lra \ovl{S_1} ~~~~~~ E[] ⊢ p : S_2 \\ E;e_1 ;…;e_i [] ⊢ S_2 <: \ovl{S_1} \end{array} ---------------------------------- \begin{array}{c} \WEV{E}{S~\with~X := p}{}\\ \Struct~e_1 ;…;e_i ; \ModA{X}{p};\subst{e_{i+2}}{X}{p} ;…;\subst{e_n}{X}{p} ~\End \end{array} .. inference:: WEVAL-WITH-MOD-REC \begin{array}{c} \WEV{E}{S}{\Struct~e_1 ;…;e_i ; \ModS{X_1}{S_1 };e_{i+2} ;… ;e_n ~\End} \\ \WEV{E;e_1 ;…;e_i }{S_1~\with~p := p_1}{\ovl{S_2}} \end{array} -------------------------- \begin{array}{c} \WEV{E}{S~\with~X_1.p := p_1}{} \\ \Struct~e_1 ;…;e_i ; \ModS{X}{\ovl{S_2}};\subst{e_{i+2}}{X_1.p}{p_1} ;…;\subst{e_n}{X_1.p}{p_1} ~\End \end{array} .. inference:: WEVAL-WITH-DEF \begin{array}{c} \WEV{E}{S}{\Struct~e_1 ;…;e_i ;(c:T_1);e_{i+2} ;… ;e_n ~\End} \\ \WS{E;e_1 ;…;e_i }{(c:=t:T)}{(c:T_1)} \end{array} -------------------------- \begin{array}{c} \WEV{E}{S~\with~c := t:T}{} \\ \Struct~e_1 ;…;e_i ;(c:=t:T);e_{i+2} ;… ;e_n ~\End \end{array} .. inference:: WEVAL-WITH-DEF-REC \begin{array}{c} \WEV{E}{S}{\Struct~e_1 ;…;e_i ; \ModS{X_1 }{S_1 };e_{i+2} ;… ;e_n ~\End} \\ \WEV{E;e_1 ;…;e_i }{S_1~\with~p := p_1}{\ovl{S_2}} \end{array} -------------------------- \begin{array}{c} \WEV{E}{S~\with~X_1.p := t:T}{} \\ \Struct~e_1 ;…;e_i ; \ModS{X}{\ovl{S_2} };e_{i+2} ;… ;e_n ~\End \end{array} .. inference:: WEVAL-PATH-MOD1 \begin{array}{c} \WEV{E}{p}{\Struct~e_1 ;…;e_i ; \Mod{X}{S}{S_1};e_{i+2} ;… ;e_n ~\End} \\ \WEV{E;e_1 ;…;e_i }{S}{\ovl{S}} \end{array} -------------------------- E[] ⊢ p.X \lra \ovl{S} .. inference:: WEVAL-PATH-MOD2 \WF{E}{} \Mod{X}{S}{S_1}∈ E \WEV{E}{S}{\ovl{S}} -------------------------- \WEV{E}{X}{\ovl{S}} .. inference:: WEVAL-PATH-ALIAS1 \begin{array}{c} \WEV{E}{p}{~\Struct~e_1 ;…;e_i ; \ModA{X}{p_1};e_{i+2} ;… ;e_n ~\End} \\ \WEV{E;e_1 ;…;e_i }{p_1}{\ovl{S}} \end{array} -------------------------- \WEV{E}{p.X}{\ovl{S}} .. inference:: WEVAL-PATH-ALIAS2 \WF{E}{} \ModA{X}{p_1 }∈ E \WEV{E}{p_1}{\ovl{S}} -------------------------- \WEV{E}{X}{\ovl{S}} .. inference:: WEVAL-PATH-TYPE1 \begin{array}{c} \WEV{E}{p}{~\Struct~e_1 ;…;e_i ; \ModType{Y}{S};e_{i+2} ;… ;e_n ~\End} \\ \WEV{E;e_1 ;…;e_i }{S}{\ovl{S}} \end{array} -------------------------- \WEV{E}{p.Y}{\ovl{S}} .. inference:: WEVAL-PATH-TYPE2 \WF{E}{} \ModType{Y}{S}∈ E \WEV{E}{S}{\ovl{S}} -------------------------- \WEV{E}{Y}{\ovl{S}} Rules for typing module: .. inference:: MT-EVAL \WEV{E}{p}{\ovl{S}} -------------------------- E[] ⊢ p : \ovl{S} .. inference:: MT-STR E[] ⊢ p : S -------------------------- E[] ⊢ p : S/p The last rule, called strengthening is used to make all module fields manifestly equal to themselves. The notation :math:`S/p` has the following meaning: + if :math:`S\lra~\Struct~e_1 ;…;e_n ~\End` then :math:`S/p=~\Struct~e_1 /p;…;e_n /p ~\End` where :math:`e/p` is defined as follows (note that opaque definitions are processed as assumptions): + :math:`(c:=t:T)/p = (c:=t:T)` + :math:`(c:U)/p = (c:=p.c:U)` + :math:`\ModS{X}{S}/p = \ModA{X}{p.X}` + :math:`\ModA{X}{p′}/p = \ModA{X}{p′}` + :math:`\ind{r}{Γ_I}{Γ_C}/p = \Indp{r}{Γ_I}{Γ_C}{p}` + :math:`\Indpstr{r}{Γ_I}{Γ_C}{p'}{p} = \Indp{r}{Γ_I}{Γ_C}{p'}` + if :math:`S \lra \Functor(X:S′)~S″` then :math:`S/p=S` The notation :math:`\Indp{r}{Γ_I}{Γ_C}{p}` denotes an inductive definition that is definitionally equal to the inductive definition in the module denoted by the path :math:`p`. All rules which have :math:`\ind{r}{Γ_I}{Γ_C}` as premises are also valid for :math:`\Indp{r}{Γ_I}{Γ_C}{p}`. We give the formation rule for :math:`\Indp{r}{Γ_I}{Γ_C}{p}` below as well as the equality rules on inductive types and constructors. The module subtyping rules: .. inference:: MSUB-STR \begin{array}{c} \WS{E;e_1 ;…;e_n }{e_{σ(i)}}{e'_i ~\for~ i=1..m} \\ σ : \{1… m\} → \{1… n\} ~\injective \end{array} -------------------------- \WS{E}{\Struct~e_1 ;…;e_n ~\End}{~\Struct~e'_1 ;…;e'_m ~\End} .. inference:: MSUB-FUN \WS{E}{\ovl{S_1'}}{\ovl{S_1}} \WS{E; \ModS{X}{S_1'}}{\ovl{S_2}}{\ovl{S_2'}} -------------------------- E[] ⊢ \Functor(X:S_1 ) S_2 <: \Functor(X:S_1') S_2' Structure element subtyping rules: .. inference:: ASSUM-ASSUM E[] ⊢ T_1 ≤_{βδιζη} T_2 -------------------------- \WS{E}{(c:T_1)}{(c:T_2)} .. inference:: DEF-ASSUM E[] ⊢ T_1 ≤_{βδιζη} T_2 -------------------------- \WS{E}{(c:=t:T_1)}{(c:T_2)} .. inference:: ASSUM-DEF E[] ⊢ T_1 ≤_{βδιζη} T_2 E[] ⊢ c =_{βδιζη} t_2 -------------------------- \WS{E}{(c:T_1)}{(c:=t_2:T_2)} .. inference:: DEF-DEF E[] ⊢ T_1 ≤_{βδιζη} T_2 E[] ⊢ t_1 =_{βδιζη} t_2 -------------------------- \WS{E}{(c:=t_1:T_1)}{(c:=t_2:T_2)} .. inference:: IND-IND E[] ⊢ Γ_I =_{βδιζη} Γ_I' E[Γ_I] ⊢ Γ_C =_{βδιζη} Γ_C' -------------------------- \WS{E}{\ind{r}{Γ_I}{Γ_C}}{\ind{r}{Γ_I'}{Γ_C'}} .. inference:: INDP-IND E[] ⊢ Γ_I =_{βδιζη} Γ_I' E[Γ_I] ⊢ Γ_C =_{βδιζη} Γ_C' -------------------------- \WS{E}{\Indp{r}{Γ_I}{Γ_C}{p}}{\ind{r}{Γ_I'}{Γ_C'}} .. inference:: INDP-INDP E[] ⊢ Γ_I =_{βδιζη} Γ_I' E[Γ_I] ⊢ Γ_C =_{βδιζη} Γ_C' E[] ⊢ p =_{βδιζη} p' -------------------------- \WS{E}{\Indp{r}{Γ_I}{Γ_C}{p}}{\Indp{r}{Γ_I'}{Γ_C'}{p'}} .. inference:: MOD-MOD \WS{E}{S_1}{S_2} -------------------------- \WS{E}{\ModS{X}{S_1 }}{\ModS{X}{S_2 }} .. inference:: ALIAS-MOD E[] ⊢ p : S_1 \WS{E}{S_1}{S_2} -------------------------- \WS{E}{\ModA{X}{p}}{\ModS{X}{S_2 }} .. inference:: MOD-ALIAS E[] ⊢ p : S_2 \WS{E}{S_1}{S_2} E[] ⊢ X =_{βδιζη} p -------------------------- \WS{E}{\ModS{X}{S_1 }}{\ModA{X}{p}} .. inference:: ALIAS-ALIAS E[] ⊢ p_1 =_{βδιζη} p_2 -------------------------- \WS{E}{\ModA{X}{p_1 }}{\ModA{X}{p_2 }} .. inference:: MODTYPE-MODTYPE \WS{E}{S_1}{S_2} \WS{E}{S_2}{S_1} -------------------------- \WS{E}{\ModType{Y}{S_1 }}{\ModType{Y}{S_2 }} New environment formation rules .. inference:: WF-MOD1 \WF{E}{} \WFT{E}{S} -------------------------- \WF{E; \ModS{X}{S}}{} .. inference:: WF-MOD2 \WS{E}{S_2}{S_1} \WF{E}{} \WFT{E}{S_1} \WFT{E}{S_2} -------------------------- \WF{E; \ModImp{X}{S_1}{S_2}}{} .. inference:: WF-ALIAS \WF{E}{} E[] ⊢ p : S -------------------------- \WF{E; \ModA{X}{p}}{} .. inference:: WF-MODTYPE \WF{E}{} \WFT{E}{S} -------------------------- \WF{E; \ModType{Y}{S}}{} .. inference:: WF-IND \begin{array}{c} \WF{E;\ind{r}{Γ_I}{Γ_C}}{} \\ E[] ⊢ p:~\Struct~e_1 ;…;e_n ;\ind{r}{Γ_I'}{Γ_C'};… ~\End \\ E[] ⊢ \ind{r}{Γ_I'}{Γ_C'} <: \ind{r}{Γ_I}{Γ_C} \end{array} -------------------------- \WF{E; \Indp{r}{Γ_I}{Γ_C}{p} }{} Component access rules .. inference:: ACC-TYPE1 E[Γ] ⊢ p :~\Struct~e_1 ;…;e_i ;(c:T);… ~\End -------------------------- E[Γ] ⊢ p.c : T .. inference:: ACC-TYPE2 E[Γ] ⊢ p :~\Struct~e_1 ;…;e_i ;(c:=t:T);… ~\End -------------------------- E[Γ] ⊢ p.c : T Notice that the following rule extends the delta rule defined in section :ref:`Conversion-rules` .. inference:: ACC-DELTA E[Γ] ⊢ p :~\Struct~e_1 ;…;e_i ;(c:=t:U);… ~\End -------------------------- E[Γ] ⊢ p.c \triangleright_δ t In the rules below we assume :math:`Γ_P` is :math:`[p_1{:}P_1 ; …; p_r {:}P_r ]`, :math:`Γ_I` is :math:`[I_1{:}∀ Γ_P, A_1 ; …; I_k{:}∀ Γ_P, A_k ]`, and :math:`Γ_C` is :math:`[c_1{:}∀ Γ_P, C_1 ; …; c_n{:}∀ Γ_P, C_n ]`. .. inference:: ACC-IND1 E[Γ] ⊢ p :~\Struct~e_1 ;…;e_i ;\ind{r}{Γ_I}{Γ_C};… ~\End -------------------------- E[Γ] ⊢ p.I_j : ∀ Γ_P, A_j .. inference:: ACC-IND2 E[Γ] ⊢ p :~\Struct~e_1 ;…;e_i ;\ind{r}{Γ_I}{Γ_C};… ~\End -------------------------- E[Γ] ⊢ p.c_m : ∀ Γ_P, C_m .. inference:: ACC-INDP1 E[] ⊢ p :~\Struct~e_1 ;…;e_i ; \Indp{r}{Γ_I}{Γ_C}{p'} ;… ~\End -------------------------- E[] ⊢ p.I_i \triangleright_δ p'.I_i .. inference:: ACC-INDP2 E[] ⊢ p :~\Struct~e_1 ;…;e_i ; \Indp{r}{Γ_I}{Γ_C}{p'} ;… ~\End -------------------------- E[] ⊢ p.c_i \triangleright_δ p'.c_i coq-8.20.0/doc/sphinx/language/core/primitive.rst000066400000000000000000000221111466560755400217350ustar00rootroot00000000000000Primitive objects ================= .. _primitive-integers: Primitive Integers ------------------ The language of terms features 63-bit machine integers as values. The type of such a value is *axiomatized*; it is declared through the following sentence (excerpt from the :g:`PrimInt63` module): .. coqdoc:: Primitive int := #int63_type. This type can be understood as representing either unsigned or signed integers, depending on which module is imported or, more generally, which scope is open. :g:`Uint63` and :g:`uint63_scope` refer to the unsigned version, while :g:`Sint63` and :g:`sint63_scope` refer to the signed one. The :g:`PrimInt63` module declares the available operators for this type. For instance, equality of two unsigned primitive integers can be determined using the :g:`Uint63.eqb` function, declared and specified as follows: .. coqdoc:: Primitive eqb := #int63_eq. Notation "m '==' n" := (eqb m n) (at level 70, no associativity) : uint63_scope. Axiom eqb_correct : forall i j, (i == j)%uint63 = true -> i = j. The complete set of such operators can be found in the :g:`PrimInt63` module. The specifications and notations are in the :g:`Uint63` and :g:`Sint63` modules. These primitive declarations are regular axioms. As such, they must be trusted and are listed by the :g:`Print Assumptions` command, as in the following example. .. coqtop:: in reset From Coq Require Import Uint63. Lemma one_minus_one_is_zero : (1 - 1 = 0)%uint63. Proof. apply eqb_correct; vm_compute; reflexivity. Qed. .. coqtop:: all Print Assumptions one_minus_one_is_zero. The reduction machines implement dedicated, efficient rules to reduce the 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 (including signed functions for :g:`Sint63` despite the name). 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. Literal values (at type :g:`Uint63.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). .. _primitive-floats: Primitive Floats ---------------- The language of terms features Binary64 floating-point numbers as values. The type of such a value is *axiomatized*; it is declared through the following sentence (excerpt from the :g:`PrimFloat` module): .. coqdoc:: Primitive float := #float64_type. This type is equipped with a few operators, that must be similarly declared. For instance, the product of two primitive floats can be computed using the :g:`PrimFloat.mul` function, declared and specified as follows: .. coqdoc:: Primitive mul := #float64_mul. Notation "x * y" := (mul x y) : float_scope. Axiom mul_spec : forall x y, Prim2SF (x * y)%float = SF64mul (Prim2SF x) (Prim2SF y). where :g:`Prim2SF` is defined in the :g:`FloatOps` module. The set of such operators is described in section :ref:`floats_library`. These primitive declarations are regular axioms. As such, they must be trusted, and are listed by the :g:`Print Assumptions` command. The reduction machines (:tacn:`vm_compute`, :tacn:`native_compute`) implement dedicated, efficient rules to reduce the applications of these primitive operations, using the floating-point processor operators that are assumed 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 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. 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)`. .. _primitive-arrays: Primitive Arrays ---------------- The language of terms features persistent arrays as values. The type of such a value is *axiomatized*; it is declared through the following sentence (excerpt from the :g:`PArray` module): .. coqdoc:: Primitive array := #array_type. This type is equipped with a few operators, that must be similarly declared. For instance, elements in an array can be accessed and updated using the :g:`PArray.get` and :g:`PArray.set` functions, declared and specified as follows: .. coqdoc:: Primitive get := #array_get. Primitive set := #array_set. Notation "t .[ i ]" := (get t i). Notation "t .[ i <- a ]" := (set t i a). Axiom get_set_same : forall A t i (a:A), (i < length t) = true -> t.[i<-a].[i] = a. Axiom get_set_other : forall A t i j (a:A), i <> j -> t.[i<-a].[j] = t.[j]. The rest of these operators can be found in the :g:`PArray` module. These primitive declarations are regular axioms. As such, they must be trusted and are listed by the :g:`Print Assumptions` command. The reduction machines (:tacn:`vm_compute`, :tacn:`native_compute`) implement dedicated, efficient rules to reduce the 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:`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 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``). 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 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 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 changes dynamically upon each get and set call: the current list of modifications is applied to the native array and the lists of modifications of the other versions are updated so that they still represent the same values. .. _primitive-string: Primitive (Byte-Based) Strings ------------------------------ The language of terms supports immutable strings as values. Primitive strings are *axiomatized*. The type is declared through the following sentence (excerpt from the :g:`PrimString` module): .. coqdoc:: Primitive string := #string_type. This type is equipped with functions that must be similarly declared. For example, the length of a string can be computed with :g:`PrimString.length`, and the character (i.e., byte) at a given position can be obtained with :g:`PrimString.get`. These functions are defined as follows: .. coqdoc:: Definition char63 := int. Primitive length : string -> int := #string_length. Primitive get : string -> int -> char63 := #string_get. The remaining primitives can be found in the :g:`PrimString` module. These primitive declarations are regular axioms. As such, they must be trusted and are listed by the :g:`Print Assumptions` command. The reduction machines (:tacn:`vm_compute`, :tacn:`native_compute`) implement dedicated, efficient rules to reduce the 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:`ExtrOCamlPString` module can be used when extracting to OCaml: it maps the Coq primitives to types and functions of a :g:`Pstring` 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/pstring.ml``). Literal values (of type :g:`Pstring.t`, or equivalently :g:`string`) are extracted to literal OCaml values (of type :g:`string`). coq-8.20.0/doc/sphinx/language/core/records.rst000066400000000000000000000453431466560755400214020ustar00rootroot00000000000000.. _record-types: Record types ------------ The :cmd:`Record` command defines types similar to :gdef:`records` in programming languages. Those types describe tuples whose components, called :gdef:`fields `, can be accessed with :gdef:`projections `. Records can also be used to describe mathematical structures, such as groups or rings, hence the synonym :cmd:`Structure`. Defining record types ~~~~~~~~~~~~~~~~~~~~~ .. _record_grammar: .. cmd:: {| Record | Structure } @record_definition :name: Record; Structure .. insertprodn record_definition of_type_inst .. prodn:: record_definition ::= {? > } @ident_decl {* @binder } {? : @sort } {? := {? @ident } %{ {*; @record_field } {? ; } %} {? as @ident } } record_field ::= {* #[ {+, @attribute } ] } @name {? @field_spec } {? %| @natural } field_spec ::= {* @binder } @of_type_inst | {* @binder } := @term | {* @binder } @of_type_inst := @term of_type_inst ::= {| : | :> | :: | ::> } @type Defines a non-recursive record type, creating projections for each field that has a name other than `_`. The field body and type can depend on previous fields, so the order of fields in the definition may matter. Use the :cmd:`Inductive` and :cmd:`CoInductive` commands to define recursive (inductive or coinductive) records. These commands also permit defining mutually recursive records provided that all of the types in the block are records. These commands automatically generate induction schemes. Enable the :flag:`Nonrecursive Elimination Schemes` flag to enable automatic generation of elimination schemes for :cmd:`Record`. See :ref:`proofschemes-induction-principles`. The :cmd:`Class` command can be used to define records that are also :ref:`typeclasses`, which permit Coq to automatically infer the inhabitants of the record. :n:`{? > }` If specified, the constructor is declared as a coercion from the class of the last field type to the record name. See :ref:`coercions`. :n:`@ident_decl` The :n:`@ident` within is the record name. :n:`{* @binder }` :n:`@binder`\s may be used to declare the :term:`inductive parameters ` of the record. :n:`: @sort` The sort the record belongs to. The default is :n:`Type`. :n:`:= {? @ident }` :n:`@ident` is the name of the record constructor. If omitted, the name defaults to :n:`Build_@ident` where :n:`@ident` is the record name. :n:`as {? @ident}` Specifies the name used to refer to the argument corresponding to the record in the type of projections. If not specified, the name is the first letter of the record name converted to lowercase (see :ref:`example `). In constrast, :cmd:`Class` command uses the record name as the default (see :ref:`example `). In :n:`@record_field`: :n:`@attribute`, if specified, can only be :attr:`canonical`. :n:`@name` is the field name. Since field names define projections, you can't reuse the same field name in two different records in the same module. This :ref:`example ` shows how to reuse the same field name in multiple records. :n:`@field_spec` can be omitted only when the type of the field can be inferred from other fields. For example: the type of :n:`n` can be inferred from :n:`npos` in :n:`Record positive := { n; npos : 0 < n }`. :n:`| @natural` Specifies the priority of the field. It is only allowed in :cmd:`Class` commands. :n:`:` Specifies the type of the field. :n:`:>` If specified, the field is declared as a coercion from the record name to the class of the field type. See :ref:`coercions`. Note that this currently does something else in :cmd:`Class` commands. :n:`::` If specified, the field is declared a typeclass instance of the class of the field type. See :ref:`typeclasses`. :n:`::>` Acts as a combination of :n:`::` and :n:`:>`. - :n:`{+ @binder } : @of_type_inst` is equivalent to :n:`: forall {+ @binder } , @of_type_inst` - :n:`{+ @binder } := @term` is equivalent to :n:`:= fun {+ @binder } => @term` - :n:`{+ @binder } @of_type_inst := @term` is equivalent to :n:`: forall {+ @binder } , @type := fun {+ @binder } => @term` :n:`:= @term`, if present, gives the value of the field, which may depend on the fields that appear before it. Since their values are already defined, such fields cannot be specified when constructing a record. The :cmd:`Record` command supports the :attr:`universes(polymorphic)`, :attr:`universes(template)`, :attr:`universes(cumulative)`, :attr:`private(matching)` and :attr:`projections(primitive)` attributes. .. example:: Defining a record The set of rational numbers may be defined as: .. coqtop:: reset all Record Rat : Set := mkRat { negative : bool ; top : nat ; bottom : nat ; Rat_bottom_nonzero : 0 <> bottom ; Rat_irreducible : forall x y z:nat, (x * y) = top /\ (x * z) = bottom -> x = 1 }. The :n:`Rat_*` fields depend on :n:`top` and :n:`bottom`. :n:`Rat_bottom_nonzero` is a proof that :n:`bottom` (the denominator) is not zero. :n:`Rat_irreducible` is a proof that the fraction is in lowest terms. .. _reuse_field_name: .. example:: Reusing a field name in multiple records .. coqtop:: in Module A. Record R := { f : nat }. End A. Module B. Record S := { f : nat }. End B. .. coqtop:: all Check {| A.f := 0 |}. Check {| B.f := 0 |}. .. _record_as_clause: .. example:: Using the "as" clause in a record definition .. coqtop:: all Record MyRecord := { myfield : nat } as VarName. About myfield. (* observe the MyRecord variable is named "VarName" *) (* make "VarName" implicit without having to rename the variable, which would be necessary without the "as" clause *) Arguments myfield {VarName}. (* make "VarName" an implicit parameter *) Check myfield. Check (myfield (VarName:={| myfield := 0 |})). .. _class_arg_name: .. example:: Argument name for a record type created using :cmd:`Class` Compare to :cmd:`Record` in the previous example: .. coqtop:: all Class MyClass := { myfield2 : nat }. About myfield2. (* Argument name defaults to the class name and is marked implicit *) .. exn:: Records declared with the keyword Record or Structure cannot be recursive. The record name :token:`ident` appears in the type of its fields, but uses the :cmd:`Record` command. Use the :cmd:`Inductive` or :cmd:`CoInductive` command instead. .. exn:: @ident already exists The fieldname :n:`@ident` is already defined as a global. .. warn:: @ident__1 cannot be defined because the projection @ident__2 was not defined The type of the projection :n:`@ident__1` depends on previous projections which themselves could not be defined. .. warn:: @ident cannot be defined. The projection cannot be defined. This message is followed by an explanation of why it's not possible, such as: #. The :term:`body` of :token:`ident` uses an incorrect elimination for :token:`ident` (see :cmd:`Fixpoint` and :ref:`Destructors`). .. warn:: @ident__field cannot be defined because it is informative and @ident__record is not The projection for the named field :n:`@ident__field` can't be defined. For example, :n:`Record R:Prop := { f:nat }` generates the message "f cannot be defined ... and R is not". Records of sort :n:`Prop` must be non-informative (i.e. indistinguishable). Since :n:`nat` has multiple inhabitants, such as :n:`%{%| f := 0 %|%}` and :n:`%{%| f := 1 %|%}`, the record would be informative and therefore the projection can't be defined. .. seealso:: Coercions and records in section :ref:`coercions-classes-as-records`. .. todo below: Need a better description for Variant and primitive projections. Hugo says "the model to think about primitive projections is not fully stabilized". .. note:: Records exist in two flavors. In the first, a record :n:`@ident` with parameters :n:`{* @binder }`, constructor :n:`@ident__0`, and fields :n:`{* @name @field_spec }` is represented as a variant type with a single constructor: :n:`Variant @ident {* @binder } : @sort := @ident__0 {* ( @name @field_spec ) }` and projections are defined by case analysis. In the second implementation, records have primitive projections: see :ref:`primitive_projections`. During the definition of the one-constructor inductive definition, all the errors of inductive definitions, as described in Section :ref:`gallina-inductive-definitions`, may also occur. Constructing records ~~~~~~~~~~~~~~~~~~~~ .. insertprodn term_record field_val .. prodn:: term_record ::= %{%| {*; @field_val } {? ; } %|%} field_val ::= @qualid {* @binder } := @term Instances of record types can be constructed using either *record form* (:n:`@term_record`, shown here) or *application form* (see :n:`@term_application`) using the constructor. The associated record definition is selected using the provided field names or constructor name, both of which are global. In the record form, the fields can be given in any order. Fields that can be inferred by unification or by using obligations (see :ref:`programs`) may be omitted. In application form, all fields of the record must be passed, in order, as arguments to the constructor. .. example:: Constructing 1/2 as a record Constructing the rational :math:`1/2` using either the record or application syntax: .. coqtop:: in Theorem one_two_irred : forall x y z:nat, x * y = 1 /\ x * z = 2 -> x = 1. Admitted. (* Record form: top and bottom can be inferred from other fields *) Definition half := {| negative := false; Rat_bottom_nonzero := O_S 1; Rat_irreducible := one_two_irred |}. (* Application form: use the constructor and provide values for all the fields in order. "mkRat" is defined by the Record command *) Definition half' := mkRat true 1 2 (O_S 1) one_two_irred. Accessing fields (projections) ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ .. insertprodn term_projection term_projection .. prodn:: term_projection ::= @term0 .( @qualid {? @univ_annot } {* @arg } ) | @term0 .( @ @qualid {? @univ_annot } {* @term1 } ) The value of a field can be accessed using *projection form* (:n:`@term_projection`, shown here) or with *application form* (see :n:`@term_application`) using the projection function associated with the field. Don't forget the parentheses for the projection form. Glossing over some syntactic details, the two forms are: - :n:`@qualid__record.( {? @ } @qualid__field {* @arg })`   (projection) and - :n:`{? @ } @qualid__field {* @arg } @qualid__record`   (application) where the :n:`@arg`\s are the parameters of the inductive type. If :n:`@` is specified, all implicit arguments must be provided. In projection form, since the projected object is part of the notation, it is always considered an explicit argument of :token:`qualid`, even if it is formally declared as implicit (see :ref:`ImplicitArguments`). .. example:: Accessing record fields .. coqtop:: all (* projection form *) Eval compute in half.(top). (* application form *) Eval compute in top half. .. example:: Matching on records .. coqtop:: all Eval compute in ( match half with | {| negative := false; top := n |} => n | _ => 0 end). .. example:: Accessing anonymous record fields with match .. coqtop:: in Record T := const { _ : nat }. Definition gett x := match x with const n => n end. Definition inst := const 3. .. coqtop:: all Eval compute in gett inst. Settings for printing records ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ The following settings let you control the display format for record types: .. flag:: Printing Records When this :term:`flag` is on (this is the default), use the record syntax (shown above) as the default display format. You can override the display format for specified record types by adding entries to these tables: .. table:: Printing Record @qualid This :term:`table` specifies a set of qualids which are displayed as records. Use the :cmd:`Add` and :cmd:`Remove` commands to update the set of qualids. .. table:: Printing Constructor @qualid This :term:`table` specifies a set of qualids which are displayed as constructors. Use the :cmd:`Add` and :cmd:`Remove` commands to update the set of qualids. .. flag:: Printing Projections Activates the projection form (dot notation) for printing projections (off by default). .. example:: .. coqtop:: all Check top half. (* off: application form *) Set Printing Projections. Check top half. (* on: projection form *) .. _primitive_projections: Primitive Projections ~~~~~~~~~~~~~~~~~~~~~ Note: the design of primitive projections is still evolving. When the :flag:`Primitive Projections` flag is on or the :attr:`projections(primitive)` attribute is supplied for a :cmd:`Record` definition, its :g:`match` construct is disabled. To eliminate the record type, one must use its defined primitive projections. For compatibility, the parameters still appear when printing terms even though they are absent in the actual AST manipulated by the kernel. This can be changed by unsetting the :flag:`Printing Primitive Projection Parameters` flag. There are currently two ways to introduce primitive records types: #. Through the :cmd:`Record` command, in which case the type has to be non-recursive. The defined type enjoys eta-conversion definitionally, that is the generalized form of surjective pairing for records: `r` ``= Build_``\ `R` ``(``\ `r`\ ``.(``\ |p_1|\ ``) …`` `r`\ ``.(``\ |p_n|\ ``))``. Eta-conversion allows to define dependent elimination for these types as well. #. Through the :cmd:`Inductive` and :cmd:`CoInductive` commands, when the :term:`body` of the definition is a record declaration of the form ``Build_``\ `R` ``{`` |p_1| ``:`` |t_1|\ ``; … ;`` |p_n| ``:`` |t_n| ``}``. In this case the types can be recursive and eta-conversion is disallowed. Dependent elimination is not available for such types; you must use non-dependent case analysis for these. For both cases the :flag:`Primitive Projections` :term:`flag` must be set or the :attr:`projections(primitive)` :term:`attribute` must be supplied. .. flag:: Primitive Projections This :term:`flag` turns on the use of primitive projections when defining subsequent records (even through the :cmd:`Inductive` and :cmd:`CoInductive` commands). Primitive projections extend the Calculus of Inductive Constructions with a new binary term constructor `r.(p)` representing a primitive projection `p` applied to a record object `r` (i.e., primitive projections are always applied). Even if the record type has parameters, these do not appear in the internal representation of applications of the projection, considerably reducing the sizes of terms when manipulating parameterized records and type checking time. On the user level, primitive projections can be used as a replacement for the usual defined ones, although there are a few notable differences. .. attr:: projections(primitive{? = {| yes | no } }) :name: projections(primitive) This :term:`boolean attribute` can be used to override the value of the :flag:`Primitive Projections` :term:`flag` for the record type being defined. .. flag:: Printing Primitive Projection Parameters This compatibility :term:`flag` (off by default) reconstructs internally omitted parameters at printing time (even though they are absent in the actual AST manipulated by the kernel). Reduction +++++++++ The basic reduction rule of a primitive projection is |p_i| ``(Build_``\ `R` |t_1| … |t_n|\ ``)`` :math:`{\rightarrow_{\iota}}` |t_i|. However, to take the δ flag into account, projections can be in two states: folded or unfolded. An unfolded primitive projection application obeys the rule above, while the folded version delta-reduces to the unfolded version. This allows to precisely mimic the usual unfolding rules of :term:`constants `. Projections obey the usual ``simpl`` flags of the :cmd:`Arguments` command in particular. Unfolded primitive projections can be built using the compatibility match syntax for primitive records, or by reducing the compatibility constant. User-written :g:`match` constructs on primitive records are desugared using the unfolded primitive projections and `let` bindings. .. example:: .. coqtop:: reset all #[projections(primitive)] Record Sigma A B := sigma { p1 : A; p2 : B p1 }. Arguments sigma {_ _} _ _. Check fun x : Sigma nat (fun _ => nat) => match x with sigma v _ => v + v end. Check fun x : Sigma nat (fun x => x = 0) => match x return exists y, y = 0 with sigma v e => ex_intro _ v e end. Matches which are equivalent to just a projection have adhoc handling to avoid generating useless ``let``: .. coqtop:: all Arguments p1 {_ _} _. Check fun x : Sigma nat (fun x => x = 0) => match x return x.(p1) = 0 with sigma v e => e end. .. flag:: Printing Unfolded Projection As Match By default this flag is off and unfolded primitive projections are printed the same as folded primitive projections. By setting this flag, unfolded primitive projections are instead printed as let-style matches in the form ``let '{| p := p |} := c in p``. Compatibility Constants for Projections +++++++++++++++++++++++++++++++++++++++ To ease compatibility with ordinary record types, each primitive projection is also defined as an ordinary :term:`constant` taking parameters and an object of the record type as arguments, and whose :term:`body` is an application of the unfolded primitive projection of the same name. These constants are used when elaborating partial applications of the projection. One can distinguish them from applications of the primitive projection if the :flag:`Printing Primitive Projection Parameters` flag is off: For a primitive projection application, parameters are printed as underscores while for the compatibility projections they are printed as usual. They cannot be distinguished if the record has no parameters. coq-8.20.0/doc/sphinx/language/core/sections.rst000066400000000000000000000265021466560755400215640ustar00rootroot00000000000000.. _section-mechanism: Sections ==================================== Sections are naming scopes that permit creating section-local declarations that can be used by other declarations in the section. Declarations made with :cmd:`Variable`, :cmd:`Hypothesis`, :cmd:`Context` (or the plural variants of the first two) and definitions made with :cmd:`Let`, :cmd:`Let Fixpoint` and :cmd:`Let CoFixpoint` within sections are local to the section. In proofs done within the section, section-local declarations are included in the :term:`local context` of the initial goal of the proof. They are also accessible in definitions made with the :cmd:`Definition` command. Using sections -------------- Sections are opened by the :cmd:`Section` command, and closed by :cmd:`End`. Sections can be nested. When a section is closed, its local declarations are no longer available. Global declarations that refer to them will be adjusted so they're still usable outside the section as shown in this :ref:`example `. .. cmd:: Section @ident Opens the section named :token:`ident`. Section names do not need to be unique. .. cmd:: End @ident Closes the section or module named :token:`ident`. See :ref:`Terminating an interactive module or module type definition ` for a description of its use with modules. After closing the section, the section-local declarations (variables and :gdef:`section-local definitions `, see :cmd:`Variable`) are *discharged*, meaning that they stop being visible and that all global objects defined in the section are generalized with respect to the variables and local definitions they each depended on in the section. .. exn:: There is nothing to end. :undocumented: .. exn:: Last block to end has name @ident. :undocumented: .. note:: Most commands, such as the :ref:`Hint ` commands, :cmd:`Notation` and option management commands that appear inside a section are canceled when the section is closed. In some cases, this behaviour can be tuned with locality attributes. See :ref:`this table`. .. cmd:: Let @ident_decl @def_body Let Fixpoint @fix_definition {* with @fix_definition } Let CoFixpoint @cofix_definition {* with @cofix_definition } :name: Let; Let Fixpoint; Let CoFixpoint These are similar to :cmd:`Definition`, :cmd:`Fixpoint` and :cmd:`CoFixpoint`, except that the declared :term:`constant` is local to the current section. When the section is closed, all persistent definitions and theorems within it that depend on the constant 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 mode. This can be used to define a term incrementally, in particular by relying on the :tacn:`refine` tactic. See :ref:`proof-editing-mode`. .. attr:: clearbody When used with :cmd:`Let` in a section, clears the body of the definition in the proof context of following proofs. The kernel will still use the body when checking. .. note:: Terminating the proof for a :cmd:`Let` with :cmd:`Qed` produces an opaque side definition. `Let foo : T. Proof. tactics. Qed.` is equivalent to .. coqdoc:: Lemma foo_subproof : T. Proof. tactics. Qed. #[clearbody] Let foo := foo_subproof. .. cmd:: Context {+ @binder } Declare variables in the context of the current section, like :cmd:`Variable`, but also allowing implicit variables, :ref:`implicit-generalization`, and let-binders. .. coqdoc:: Context {A : Type} (a b : A). Context `{EqDec A}. Context (b' := b). .. seealso:: Section :ref:`binders`. Section :ref:`contexts` in chapter :ref:`typeclasses`. .. _section_local_declarations: .. example:: Section-local declarations .. coqtop:: all Section s1. .. coqtop:: all Variables x y : nat. The command :cmd:`Let` introduces section-wide :ref:`let-in`. These definitions won't persist when the section is closed, and all persistent definitions which depend on `y'` will be prefixed with `let y' := y in`. .. coqtop:: in Let y' := y. Definition x' := S x. Definition x'' := x' + y'. .. coqtop:: all Print x'. Print x''. End s1. Print x'. Print x''. Notice the difference between the value of :g:`x'` and :g:`x''` inside section :g:`s1` and outside. .. _visibility-attributes-sections: Summary of locality attributes in a section ------------------------------------------- This table sums up the effect of locality attributes on the scope of vernacular commands in a :cmd:`Section`, when outside the :cmd:`Section` where they were entered. In the following table: * a cross (❌) marks an unsupported attribute (compilation error); * “not available” means that the command has no effect outside the :cmd:`Section` it was entered; * “available” means that the effects of the command persists outside the :cmd:`Section`. * For :cmd:`Definition` (and :cmd:`Lemma`, ...), :cmd:`Canonical Structure`, :cmd:`Coercion` and :cmd:`Set` (and :cmd:`Unset`), some locality attributes will be passed on to the :cmd:`Module` containing the current :cmd:`Section`, see the associated footnotes. A similar table for :cmd:`Module` can be found :ref:`here `. .. list-table:: :header-rows: 1 * - ``Command`` - no attribute - :attr:`local` - :attr:`export` - :attr:`global` * - :cmd:`Definition`, :cmd:`Lemma`, :cmd:`Axiom`, ... - available [#note1]_ - :attr:`local` in module [#note1]_ - ❌ - ❌ * - :cmd:`Ltac` - :attr:`local` - not available - ❌ - ❌ * - :cmd:`Ltac2` - :attr:`local` - not available - ❌ - ❌ * - :cmd:`Notation (abbreviation)` - :attr:`local` - not available - ❌ - ❌ * - :cmd:`Notation` - :attr:`local` - not available - ❌ - ❌ * - :cmd:`Tactic Notation` - :attr:`local` - not available - ❌ - ❌ * - :cmd:`Ltac2 Notation` - :attr:`local` - not available - ❌ - ❌ * - :cmd:`Coercion` - :attr:`global` - not available - ❌ - :attr:`global` in module [#note2]_ * - :cmd:`Canonical Structure` - :attr:`global` - not available - ❌ - :attr:`global` in module [#note2]_ * - ``Hints`` (and :cmd:`Instance`) - :attr:`local` - not available - ❌ - ❌ * - :cmd:`Set` or :cmd:`Unset` a flag - available [#note3]_ - not available - :attr:`export` in module [#note3]_ - :attr:`global` in module [#note3]_ .. [#note1] For :cmd:`Definition`, :cmd:`Lemma`, ... the default visibility is to be available outside the section and available with a short name when the current :cmd:`Module` is imported (with :cmd:`Import` or cmd:`Export`) outside the current :cmd:`Module`. The :attr:`local` attribute make the corresponding identifiers available in the current :cmd:`Module` but only with a fully qualified name outside the current :cmd:`Module`. .. [#note2] For :cmd:`Coercion` and :cmd:`Canonical Structure`, the :attr:`global` visibility, which is the default, makes them available outside the section, in the current :cmd:`Module`, and outside the current :cmd:`Module` when it is imported (with :cmd:`Import` or cmd:`Export`). .. [#note3] For :cmd:`Set` and :cmd:`Unset`, the :attr:`export` and :attr:`global` attributes both make the command's effects persist outside the current section, in the current :cmd:`Module`. It will also persist outside the current :cmd:`Module` with the :attr:`global` attribute, or with the :attr:`export` attribute, when the :cmd:`Module` is imported (with :cmd:`Import` or cmd:`Export`). The default behaviour (no attribute) is to make the setting persist outside the section in the current :cmd:`Module`, but not outside the current :cmd:`Module`. .. _Admissible-rules-for-global-environments: Typing rules used at the end of a section -------------------------------------------- From the original rules of the type system, one can show the admissibility of rules which change the local context of definition of objects in the global environment. We show here the admissible rules that are used in the discharge mechanism at the end of a section. .. _Abstraction: **Abstraction.** One can modify a global declaration by generalizing it over a previously assumed constant :math:`c`. For doing that, we need to modify the reference to the global declaration in the subsequent global environment and local context by explicitly applying this constant to the constant :math:`c`. Below, if :math:`Γ` is a context of the form :math:`[y_1 :A_1 ;~…;~y_n :A_n]`, we write :math:`∀x:U,~\subst{Γ}{c}{x}` to mean :math:`[y_1 :∀ x:U,~\subst{A_1}{c}{x};~…;~y_n :∀ x:U,~\subst{A_n}{c}{x}]` and :math:`\subst{E}{|Γ|}{|Γ|c}` to mean the parallel substitution :math:`E\{y_1 /(y_1~c)\}…\{y_n/(y_n~c)\}`. .. _First-abstracting-property: **First abstracting property:** .. math:: \frac{\WF{E;~c:U;~E′;~c′:=t:T;~E″}{Γ}} {\WF{E;~c:U;~E′;~c′:=λ x:U.~\subst{t}{c}{x}:∀x:U,~\subst{T}{c}{x};~\subst{E″}{c′}{(c′~c)}} {\subst{Γ}{c′}{(c′~c)}}} .. math:: \frac{\WF{E;~c:U;~E′;~c′:T;~E″}{Γ}} {\WF{E;~c:U;~E′;~c′:∀ x:U,~\subst{T}{c}{x};~\subst{E″}{c′}{(c′~c)}}{\subst{Γ}{c′}{(c′~c)}}} .. math:: \frac{\WF{E;~c:U;~E′;~\ind{p}{Γ_I}{Γ_C};~E″}{Γ}} {\WFTWOLINES{E;~c:U;~E′;~\ind{p+1}{∀ x:U,~\subst{Γ_I}{c}{x}}{∀ x:U,~\subst{Γ_C}{c}{x}};~ \subst{E″}{|Γ_I ;Γ_C |}{|Γ_I ;Γ_C | c}} {\subst{Γ}{|Γ_I ;Γ_C|}{|Γ_I ;Γ_C | c}}} One can similarly modify a global declaration by generalizing it over a previously defined constant :math:`c`. Below, if :math:`Γ` is a context of the form :math:`[y_1 :A_1 ;~…;~y_n :A_n]`, we write :math:`\subst{Γ}{c}{u}` to mean :math:`[y_1 :\subst{A_1} {c}{u};~…;~y_n:\subst{A_n} {c}{u}]`. .. _Second-abstracting-property: **Second abstracting property:** .. math:: \frac{\WF{E;~c:=u:U;~E′;~c′:=t:T;~E″}{Γ}} {\WF{E;~c:=u:U;~E′;~c′:=(\letin{x}{u:U}{\subst{t}{c}{x}}):\subst{T}{c}{u};~E″}{Γ}} .. math:: \frac{\WF{E;~c:=u:U;~E′;~c′:T;~E″}{Γ}} {\WF{E;~c:=u:U;~E′;~c′:\subst{T}{c}{u};~E″}{Γ}} .. math:: \frac{\WF{E;~c:=u:U;~E′;~\ind{p}{Γ_I}{Γ_C};~E″}{Γ}} {\WF{E;~c:=u:U;~E′;~\ind{p}{\subst{Γ_I}{c}{u}}{\subst{Γ_C}{c}{u}};~E″}{Γ}} .. _Pruning-the-local-context: **Pruning the local context.** If one abstracts or substitutes constants with the above rules then it may happen that some declared or defined constant does not occur any more in the subsequent global environment and in the local context. One can consequently derive the following property. .. _First-pruning-property: .. inference:: First pruning property: \WF{E;~c:U;~E′}{Γ} c~\kw{does not occur in}~E′~\kw{and}~Γ -------------------------------------- \WF{E;E′}{Γ} .. _Second-pruning-property: .. inference:: Second pruning property: \WF{E;~c:=u:U;~E′}{Γ} c~\kw{does not occur in}~E′~\kw{and}~Γ -------------------------------------- \WF{E;E′}{Γ} coq-8.20.0/doc/sphinx/language/core/sorts.rst000066400000000000000000000101331466560755400211000ustar00rootroot00000000000000.. index:: single: Set (sort) single: SProp single: Prop single: Type .. _sorts: Sorts ~~~~~~~~~~~ .. insertprodn sort universe_expr .. prodn:: sort ::= Set | Prop | SProp | Type | Type @%{ _ %} | Type @%{ {? @qualid %| } @universe %} universe ::= max ( {+, @universe_expr } ) | _ | @universe_expr universe_expr ::= @universe_name {? + @natural } The types of types are called :gdef:`sorts `. All sorts have a type and there is an infinite well-founded typing hierarchy of sorts whose base sorts are :math:`\SProp`, :math:`\Prop` and :math:`\Set`. The sort :math:`\Prop` intends to be the type of logical propositions. If :math:`M` is a logical proposition then it denotes the class of terms representing proofs of :math:`M`. An object :math:`m` belonging to :math:`M` witnesses the fact that :math:`M` is provable. An object of type :math:`\Prop` is called a :gdef:`proposition`. We denote propositions by :n:`@form`. This constitutes a semantic subclass of the syntactic class :n:`@term`. The sort :math:`\SProp` is like :math:`\Prop` but the propositions in :math:`\SProp` are known to have irrelevant proofs (all proofs are equal). Objects of type :math:`\SProp` are called :gdef:`strict propositions `. See :ref:`sprop` for information about using :math:`\SProp`, and :cite:`Gilbert:POPL2019` for meta theoretical considerations. The sort :math:`\Set` intends to be the type of small sets. This includes data types such as booleans and naturals, but also products, subsets, and function types over these data types. We denote specifications (program types) by :n:`@specif`. This constitutes a semantic subclass of the syntactic class :n:`@term`. :math:`\SProp`, :math:`\Prop` and :math:`\Set` themselves can be manipulated as ordinary terms. Consequently they also have a type. Because assuming simply that :math:`\Set` has type :math:`\Set` leads to an inconsistent theory :cite:`Coq86`, the language of |Cic| has infinitely many sorts. There are, in addition to the base sorts, a hierarchy of universes :math:`\Type(i)` for any integer :math:`i ≥ 1`. Like :math:`\Set`, all of the sorts :math:`\Type(i)` contain small sets such as booleans, natural numbers, as well as products, subsets and function types over small sets. But, unlike :math:`\Set`, they also contain large sets, namely the sorts :math:`\Set` and :math:`\Type(j)` for :math:`j` of the type. Each inhabitant is specified by a :gdef:`constructor`. For instance, Booleans have two constructors: :g:`true` and :g:`false`. Types can include enumerated types from programming languages, such as Booleans, characters or even the degenerate cases of the unit and empty types. Variant types more generally include enumerated types with arguments or even enumerated types with parametric arguments such as option types and sum types. It also includes predicates or type families defined by cases such as the Boolean reflection or equality predicates. Observing the form of the :term:`inhabitants ` of a variant type is done by case analysis using the `match` expression. When a constructor of a type takes an argument of that same type, the type becomes recursive, in which case it can be either :cmd:`Inductive` or :cmd:`CoInductive`. The keyword :cmd:`Variant` is reserved for non-recursive types. Natural numbers, lists or streams cannot be defined using :cmd:`Variant`. .. cmd:: Variant @ident_decl {* @binder } {? %| {* @binder } } {? : @type } := {? %| } {+| @constructor } {? @decl_notations } Defines a variant type named :n:`@ident` (in :n:`@ident_decl`) with the given list of constructors. No induction scheme is generated for this variant, unless the :flag:`Nonrecursive Elimination Schemes` flag is on. :n:`{? %| {* @binder } }` The :n:`|` separates uniform and non uniform parameters. See :flag:`Uniform Inductive Parameters`. This command supports the :attr:`universes(polymorphic)`, :attr:`universes(template)`, :attr:`universes(cumulative)`, and :attr:`private(matching)` attributes. .. exn:: The @natural th argument of @ident must be @ident in @type. :undocumented: .. example:: The Booleans, the unit type and the empty type are respectively defined by: .. coqtop:: none Module FreshNameSpace. .. coqtop:: in Variant bool : Set := true : bool | false : bool. Variant unit : Set := tt : unit. Variant Empty_set : Set :=. The option and sum types are defined by: .. coqtop:: in Variant option (A : Type) : Type := None : option A | Some : A -> option A. Variant sum (A B : Type) : Type := inl : A -> sum A B | inr : B -> sum A B. *Boolean reflection* is a relation reflecting under the form of a Boolean value when a given proposition :n:`P` holds. It can be defined as a two-constructor type family over :g:`bool` parameterized by the proposition :n:`P`: .. coqtop:: in Variant reflect (P : Prop) : bool -> Set := | ReflectT : P -> reflect P true | ReflectF : ~ P -> reflect P false. .. coqtop:: none End FreshNameSpace. :term:`Leibniz equality` is another example of variant type. .. note:: The standard library commonly uses :cmd:`Inductive` in place of :cmd:`Variant` even for non-recursive types in order to automatically derive the schemes :n:`@ident`\ ``_rect``, :n:`@ident`\ ``_ind``, :n:`@ident`\ ``_rec`` and :n:`@ident`\ ``_sind``. (These schemes are also created for :cmd:`Variant` if the :flag:`Nonrecursive Elimination Schemes` flag is set.) Private (matching) inductive types ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ .. attr:: private(matching) :name: private(matching); Private This :term:`attribute` can be used to forbid the use of the :g:`match` construct on objects of this inductive type outside of the module where it is defined. There is also a legacy syntax using the ``Private`` prefix (cf. :n:`@legacy_attr`). The main use case of private (matching) inductive types is to emulate quotient types / higher-order inductive types in projects such as the `HoTT library `_. Reducing definitions from the inductive's module can expose :g:`match` constructs to unification, which may result in invalid proof terms. Errors from such terms are delayed until proof completion (i.e. on the :cmd:`Qed`). Use :cmd:`Validate Proof` to identify which tactic produced the problematic term. .. example:: .. coqtop:: all Module Foo. #[ private(matching) ] Inductive my_nat := my_O : my_nat | my_S : my_nat -> my_nat. Check (fun x : my_nat => match x with my_O => true | my_S _ => false end). End Foo. Import Foo. Fail Check (fun x : my_nat => match x with my_O => true | my_S _ => false end). .. index:: match ... with ... .. _match_term: Definition by cases: match -------------------------- Objects of inductive types can be destructured by a case-analysis construction called *pattern matching* expression. A pattern matching expression is used to analyze the structure of an inductive object and to apply specific treatments accordingly. .. insertprodn term_match pattern0 .. prodn:: term_match ::= match {+, @case_item } {? return @term100 } with {? %| } {*| @eqn } end case_item ::= @term100 {? as @name } {? in @pattern } eqn ::= {+| {+, @pattern } } => @term pattern ::= @pattern10 : @term | @pattern10 pattern10 ::= @pattern1 as @name | @pattern1 {* @pattern1 } | @ @qualid {* @pattern1 } pattern1 ::= @pattern0 % @scope_key | @pattern0 %_ @scope_key | @pattern0 pattern0 ::= @qualid | %{%| {* @qualid := @pattern } %|%} | _ | ( {+| @pattern } ) | @number | @string Note that the :n:`@pattern ::= @pattern10 : @term` production is not supported in :n:`match` patterns. Trying to use it will give this error: .. exn:: Casts are not supported in this pattern. :undocumented: This paragraph describes the basic form of pattern matching. See Section :ref:`Mult-match` and Chapter :ref:`extendedpatternmatching` for the description of the general form. The basic form of pattern matching is characterized by a single :n:`@case_item` expression, an :n:`@eqn` restricted to a single :n:`@pattern` and :n:`@pattern` restricted to the form :n:`@qualid {* @ident}`. The expression :n:`match @term {? return @term100 } with {+| @pattern__i => @term__i } end` denotes a *pattern matching* over the term :n:`@term` (expected to be of an inductive type :math:`I`). The :n:`@term__i` are the *branches* of the pattern matching expression. Each :n:`@pattern__i` has the form :n:`@qualid @ident` where :n:`@qualid` must denote a constructor. There should be exactly one branch for every constructor of :math:`I`. The :n:`return @term100` clause gives the type returned by the whole match expression. There are several cases. In the *non-dependent* case, all branches have the same type, and the :n:`return @term100` specifies that type. In this case, :n:`return @term100` can usually be omitted as it can be inferred from the type of the branches [1]_. In the *dependent* case, there are three subcases. In the first subcase, the type in each branch may depend on the exact value being matched in the branch. In this case, the whole pattern matching itself depends on the term being matched. This dependency of the term being matched in the return type is expressed with an :n:`@ident` clause where :n:`@ident` is dependent in the return type. For instance, in the following example: .. coqtop:: in Inductive bool : Type := true : bool | false : bool. Inductive eq (A:Type) (x:A) : A -> Prop := eq_refl : eq A x x. Inductive or (A:Prop) (B:Prop) : Prop := | or_introl : A -> or A B | or_intror : B -> or A B. Definition bool_case (b:bool) : or (eq bool b true) (eq bool b false) := match b as x return or (eq bool x true) (eq bool x false) with | true => or_introl (eq bool true true) (eq bool true false) (eq_refl bool true) | false => or_intror (eq bool false true) (eq bool false false) (eq_refl bool false) end. the branches have respective types ":g:`or (eq bool true true) (eq bool true false)`" and ":g:`or (eq bool false true) (eq bool false false)`" while the whole pattern matching expression has type ":g:`or (eq bool b true) (eq bool b false)`", the identifier :g:`b` being used to represent the dependency. .. note:: When the term being matched is a variable, the ``as`` clause can be omitted and the term being matched can serve itself as binding name in the return type. For instance, the following alternative definition is accepted and has the same meaning as the previous one. .. coqtop:: none Reset bool_case. .. coqtop:: in Definition bool_case (b:bool) : or (eq bool b true) (eq bool b false) := match b return or (eq bool b true) (eq bool b false) with | true => or_introl (eq bool true true) (eq bool true false) (eq_refl bool true) | false => or_intror (eq bool false true) (eq bool false false) (eq_refl bool false) end. The second subcase is only relevant for indexed inductive types such as the equality predicate (see Section :ref:`coq-equality`), the order predicate on natural numbers or the type of lists of a given length (see Section :ref:`matching-dependent`). In this configuration, the type of each branch can depend on the type dependencies specific to the branch and the whole pattern matching expression has a type determined by the specific dependencies in the type of the term being matched. This dependency of the return type in the indices of the inductive type is expressed with a clause in the form :n:`in @qualid {+ _ } {+ @pattern }`, where - :n:`@qualid` is the inductive type of the term being matched; - the holes :n:`_` match the parameters of the inductive type: the return type is not dependent on them. - each :n:`@pattern` matches the indices of the inductive type: the return type is dependent on them - in the basic case which we describe below, each :n:`@pattern` is a name :n:`@ident`; see :ref:`match-in-patterns` for the general case For instance, in the following example: .. coqtop:: in Definition eq_sym (A:Type) (x y:A) (H:eq A x y) : eq A y x := match H in eq _ _ z return eq A z x with | eq_refl _ _ => eq_refl A x end. the type of the branch is :g:`eq A x x` because the third argument of :g:`eq` is :g:`x` in the type of the pattern :g:`eq_refl`. On the contrary, the type of the whole pattern matching expression has type :g:`eq A y x` because the third argument of eq is y in the type of H. This dependency of the case analysis in the third argument of :g:`eq` is expressed by the identifier :g:`z` in the return type. Finally, the third subcase is a combination of the first and second subcase. In particular, it only applies to pattern matching on terms in a type with indices. For this third subcase, both the clauses ``as`` and ``in`` are available. There are specific notations for case analysis on types with one or two constructors: ``if … then … else …`` and ``let (…,…) := … in …`` (see Sections :ref:`if-then-else` and :ref:`irrefutable-patterns`). .. [1] Except if the inductive type is empty in which case there is no equation that can be used to infer the return type. coq-8.20.0/doc/sphinx/language/extensions/000077500000000000000000000000001466560755400204455ustar00rootroot00000000000000coq-8.20.0/doc/sphinx/language/extensions/arguments-command.rst000066400000000000000000000430041466560755400246210ustar00rootroot00000000000000.. _ArgumentsCommand: Setting properties of a function's arguments ++++++++++++++++++++++++++++++++++++++++++++ .. cmd:: Arguments @reference {* @arg_specs } {* , {* @implicits_alt } } {? : {+, @args_modifier } } .. insertprodn arg_specs args_modifier .. prodn:: arg_specs ::= @argument_spec | / | & | ( {+ @argument_spec } ) {* {| % @scope | %_ @scope } } | [ {+ @argument_spec } ] {* {| % @scope | %_ @scope } } | %{ {+ @argument_spec } %} {* {| % @scope | %_ @scope } } argument_spec ::= {? ! } @name {* {| % @scope | %_ @scope } } implicits_alt ::= @name | [ {+ @name } ] | %{ {+ @name } %} args_modifier ::= simpl nomatch | simpl never | default implicits | clear implicits | clear scopes | clear bidirectionality hint | rename | assert | extra scopes | clear scopes and implicits | clear implicits and scopes Specifies properties of the arguments of a function after the function has already been defined. It gives fine-grained control over the elaboration process (i.e. the translation of Gallina language extensions into the core language used by the kernel). The command's effects include: * Making arguments implicit. Afterward, :term:`implicit arguments ` must be omitted in any expression that applies :token:`reference`. * Declaring that some arguments of a given function should be interpreted in a given :term:`notation scope`. * Affecting when the :tacn:`simpl` and :tacn:`cbn` tactics unfold the function. See :ref:`Args_effect_on_unfolding`. * Providing bidirectionality hints. See :ref:`bidirectionality_hints`. This command supports the :attr:`local` and :attr:`global` attributes. Default behavior is to limit the effect to the current section but also to extend their effect outside the current module or library file. Applying :attr:`local` limits the effect of the command to the current module if it's not in a section. Applying :attr:`global` within a section extends the effect outside the current sections and current module in which the command appears. `/` the function will be unfolded only if it's applied to at least the arguments appearing before the `/`. See :ref:`Args_effect_on_unfolding`. .. exn:: The / modifier may only occur once. :undocumented: `&` tells the type checking algorithm to first type check the arguments before the `&` and then to propagate information from that typing context to type check the remaining arguments. See :ref:`bidirectionality_hints`. .. exn:: The & modifier may only occur once. :undocumented: :n:`( {+ @argument_spec } ) {* %_ @scope }` :n:`(@name__1 @name__2 ...){* %@scope }` is shorthand for :n:`@name__1{* %@scope } @name__2{* %@scope } ...` :n:`[ {+ @argument_spec } ] {* %_ @scope }` declares the enclosed names as implicit, non-maximally inserted. :n:`[@name__1 @name__2 ... ]{* %_@scope }` is equivalent to :n:`[@name__1]{* %_@scope } [@name__2]{* %_@scope } ...` :n:`%{ {+ @argument_spec } %} {* %_ @scope }` declares the enclosed names as implicit, maximally inserted. :n:`%{@name__1 @name__2 ... %}{* %_@scope }` is equivalent to :n:`%{@name__1%}{* %_@scope } %{@name__2%}{* %_@scope } ...` `!` the function will be unfolded only if all the arguments marked with `!` evaluate to constructors. See :ref:`Args_effect_on_unfolding`. :n:`@name {* %_ @scope }` a *formal parameter* of the function :n:`@reference` (i.e. the parameter name used in the function definition). Unless `rename` is specified, the list of :n:`@name`\s must be a prefix of the formal parameters, including all implicit arguments. `_` can be used to skip over a formal parameter. This construct declares :n:`@name` as non-implicit if `clear implicits` is specified or any other :n:`@name` in the :cmd:`Arguments` command is declared implicit. :token:`scope` can be either scope names or their delimiting keys. When multiple scopes are present, notations are interpreted in the leftmost scope containing them. See :ref:`binding_to_scope`. .. deprecated:: 8.19 The :n:`% @scope` syntax is deprecated in favor of the currently equivalent :n:`%_ @scope`. It will be reused in future versions with the same semantics as in terms. .. exn:: To rename arguments the 'rename' flag must be specified. :undocumented: .. exn:: Flag 'rename' expected to rename @name into @name. :undocumented: .. exn:: Arguments of section variables such as @name may not be renamed. :undocumented: `clear implicits` makes all implicit arguments into explicit arguments .. exn:: The 'clear implicits' flag must be omitted if implicit annotations are given. :undocumented: `default implicits` automatically determine the implicit arguments of the object. See :ref:`auto_decl_implicit_args`. .. exn:: The 'default implicits' flag is incompatible with implicit annotations. :undocumented: `rename` rename implicit arguments for the object. See the example :ref:`here `. `assert` assert that the object has the expected number of arguments with the expected names. See the example here: :ref:`renaming_implicit_arguments`. .. warn:: This command is just asserting the names of arguments of @qualid. If this is what you want, add ': assert' to silence the warning. If you want to clear implicit arguments, add ': clear implicits'. If you want to clear notation scopes, add ': clear scopes' :undocumented: `clear scopes` clears argument scopes of :n:`@reference` `extra scopes` defines extra argument scopes, to be used in case of coercion to ``Funclass`` (see :ref:`coercions`) or with a computed type. `simpl nomatch` prevents performing a simplification step for :n:`@reference` that would expose a match construct in the head position. See :ref:`Args_effect_on_unfolding`. `simpl never` prevents performing a simplification step for :n:`@reference`. See :ref:`Args_effect_on_unfolding`. `clear bidirectionality hint` removes the bidirectionality hint, the `&` :n:`@implicits_alt` use to specify alternative implicit argument declarations for functions that can only be applied to a fixed number of arguments (excluding, for instance, functions whose type is polymorphic). For parsing, the longest list of implicit arguments matching the function application is used to select which implicit arguments are inserted. For printing, the alternative with the most implicit arguments is used; the implict arguments will be omitted if :flag:`Printing Implicit` is not set. See the example :ref:`here`. .. todo the above feature seems a bit unnatural and doesn't play well with partial application. See https://github.com/coq/coq/pull/11718#discussion_r408841762 Use :cmd:`About` to view the current implicit arguments setting for a :token:`reference`. Or use the :cmd:`Print Implicit` command to see the implicit arguments of an object (see :ref:`displaying-implicit-args`). Manual declaration of implicit arguments ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ .. example:: .. coqtop:: reset all Inductive list (A : Type) : Type := | nil : list A | cons : A -> list A -> list A. Check (cons nat 3 (nil nat)). Arguments cons [A] _ _. Arguments nil {A}. Check (cons 3 nil). Fixpoint map (A B : Type) (f : A -> B) (l : list A) : list B := match l with nil => nil | cons a t => cons (f a) (map A B f t) end. Fixpoint length (A : Type) (l : list A) : nat := match l with nil => 0 | cons _ m => S (length A m) end. Arguments map [A B] f l. Arguments length {A} l. (* A has to be maximally inserted *) Check (fun l:list (list nat) => map length l). .. _example_more_implicits: .. example:: Multiple alternatives with :n:`@implicits_alt` .. coqtop:: all Arguments map [A B] f l, [A] B f l, A B f l. Check (fun l => map length l = map (list nat) nat length l). .. _auto_decl_implicit_args: Automatic declaration of implicit arguments ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ The ":n:`default implicits`" :token:`args_modifier` clause tells Coq to automatically determine the implicit arguments of the object. Auto-detection is governed by flags specifying whether strict, contextual, or reversible-pattern implicit arguments must be considered or not (see :ref:`controlling-strict-implicit-args`, :ref:`controlling-contextual-implicit-args`, :ref:`controlling-rev-pattern-implicit-args` and also :ref:`controlling-insertion-implicit-args`). .. example:: Default implicits .. coqtop:: reset all Inductive list (A:Set) : Set := | nil : list A | cons : A -> list A -> list A. Arguments cons : default implicits. Print Implicit cons. Arguments nil : default implicits. Print Implicit nil. Set Contextual Implicit. Arguments nil : default implicits. Print Implicit nil. The computation of implicit arguments takes account of the unfolding of :term:`constants `. For instance, the variable ``p`` below has type ``(Transitivity R)`` which is reducible to ``forall x,y:U, R x y -> forall z:U, R y z -> R x z``. As the variables ``x``, ``y`` and ``z`` appear strictly in the :term:`body` of the type, they are implicit. .. coqtop:: all Parameter X : Type. Definition Relation := X -> X -> Prop. Definition Transitivity (R:Relation) := forall x y:X, R x y -> forall z:X, R y z -> R x z. Parameters (R : Relation) (p : Transitivity R). Arguments p : default implicits. Print p. Print Implicit p. Parameters (a b c : X) (r1 : R a b) (r2 : R b c). Check (p r1 r2). .. _renaming_implicit_arguments: Renaming implicit arguments ~~~~~~~~~~~~~~~~~~~~~~~~~~~ .. example:: (continued) Renaming implicit arguments .. coqtop:: all Arguments p [s t] _ [u] _: rename. Check (p r1 (u:=c)). Check (p (s:=a) (t:=b) r1 (u:=c) r2). Fail Arguments p [s t] _ [w] _ : assert. .. _binding_to_scope: Binding arguments to scopes ~~~~~~~~~~~~~~~~~~~~~~~~~~~ The following command declares that the first two arguments of :g:`plus_fct` are interpreted in the :token:`scope` delimited by the key ``F`` and the third argument is first interpreted in the scope delimited by the key ``R``, then in ``F`` (when a notation has no interpretation in ``R``). .. coqdoc:: Arguments plus_fct (f1 f2)%_F x%_R%_F. When interpreting a term, if some of the arguments of :token:`reference` are built from a notation, then this notation is interpreted in the scope stack extended by the scopes bound (if any) to this argument. The effect of these scopes is limited to the argument itself. It does not propagate to subterms but the subterms that, after interpretation of the notation, turn to be themselves arguments of a reference are interpreted according to the argument scopes bound to this reference. .. note:: In notations, the subterms matching the identifiers of the notations are interpreted in the scope in which the identifiers occurred at the time of the declaration of the notation. Here is an example: .. coqtop:: all Parameter g : bool -> bool. Declare Scope mybool_scope. Notation "@@" := true (only parsing) : bool_scope. Notation "@@" := false (only parsing): mybool_scope. Bind Scope bool_scope with bool. Notation "# x #" := (g x) (at level 40). Check # @@ #. Arguments g _%_mybool_scope. Check # @@ #. Delimit Scope mybool_scope with mybool. Check # @@%mybool #. .. _Args_effect_on_unfolding: Effects of :cmd:`Arguments` on unfolding ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + `simpl never` indicates that a :term:`constant` should not be unfolded by :tacn:`cbn` or :tacn:`simpl` when in head position. Note that in the case of :tacn:`simpl`, the modifier does not apply to reduction of the main argument of a `match`, `fix`, primitive projection, or of an unfoldable constant hiding a `match`, `fix` or primitive projection. .. example:: .. coqtop:: all Arguments Nat.sub n m : simpl never. After that command an expression like :g:`(Nat.sub (S x) y)` is left untouched by the tactics :tacn:`cbn` and :tacn:`simpl`. Otherwise, an expression like :g:`(Nat.sub (S x) 0) + 1` reduces to :g:`S (x + 1)` for :tacn:`simpl` because `Nat.sub` is the main argument of `+` in this case. + A :term:`constant` can be marked to be unfolded only if it's applied to at least the arguments appearing before the `/` in a :cmd:`Arguments` command. .. example:: .. coqtop:: all Definition fcomp A B C f (g : A -> B) (x : A) : C := f (g x). Arguments fcomp {A B C} f g x /. Notation "f \o g" := (fcomp f g) (at level 50). After that command the expression :g:`(f \o g)` is left untouched by :tacn:`simpl` while :g:`((f \o g) t)` is reduced to :g:`(f (g t))`. The same mechanism can be used to make a :term:`constant` volatile, i.e. always unfolded. .. example:: .. coqtop:: all Definition volatile := fun x : nat => x. Arguments volatile / x. + A :term:`constant` can be marked to be unfolded only if an entire set of arguments evaluates to a constructor. The ``!`` symbol can be used to mark such arguments. .. example:: .. coqtop:: all Arguments minus !n !m. After that command, the expression :g:`(minus (S x) y)` is left untouched by :tacn:`simpl`, while :g:`(minus (S x) (S y))` is reduced to :g:`(minus x y)`. + `simpl nomatch` indicates that a :term:`constant` should not be unfolded if it would expose a `match` construct in the head position. This affects the :tacn:`cbn`, :tacn:`simpl` and :tacn:`hnf` tactics. .. example:: .. coqtop:: all Arguments minus n m : simpl nomatch. In this case, :g:`(minus (S (S x)) (S y))` is simplified to :g:`(minus (S x) y)` even if an extra simplification is possible. In detail: the tactic :tacn:`simpl` first applies βι-reduction. Then, it expands transparent :term:`constants ` and tries to reduce further using βι-reduction. But, when no ι rule is applied after unfolding then δ-reductions are not applied. For instance trying to use :tacn:`simpl` on :g:`(plus n O) = n` changes nothing. .. _bidirectionality_hints: Bidirectionality hints ~~~~~~~~~~~~~~~~~~~~~~ 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 first arguments of an application, typing information should be propagated from the context to help inferring the types of the remaining arguments. .. todo the following text is a start on better wording but not quite complete. See https://github.com/coq/coq/pull/11718#discussion_r410219992 .. Two common methods to determine the type of a construct are: * *type checking*, which is verifying that a construct matches a known type, and * *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, 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`), typing information from them is propagated to the remaining arguments to help infer their types. An :cmd:`Arguments` command containing :n:`@arg_specs__1 & @arg_specs__2` provides bidirectionality hints. It tells the typechecking algorithm, when type checking applications of :n:`@qualid`, to first type check the arguments in :n:`@arg_specs__1` and then propagate information from the typing context to type check the remaining arguments (in :n:`@arg_specs__2`). .. example:: Bidirectionality hints In a context where a coercion was declared from ``bool`` to ``nat``: .. coqtop:: in reset Definition b2n (b : bool) := if b then 1 else 0. Coercion b2n : bool >-> nat. 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: .. coqtop:: all Fail Check (ex_intro _ true _ : exists n : nat, n > 0). However, a suitable bidirectionality hint makes the example work: .. coqtop:: all Arguments ex_intro _ _ & _ _. Check (ex_intro _ true _ : exists n : nat, n > 0). 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. coq-8.20.0/doc/sphinx/language/extensions/canonical.rst000066400000000000000000000506451466560755400231400ustar00rootroot00000000000000.. _canonicalstructures: Canonical Structures ====================== :Authors: Assia Mahboubi and Enrico Tassi This chapter explains the basics of canonical structures and how they can be used to overload notations and build a hierarchy of algebraic structures. The examples are taken from :cite:`CSwcu`. We invite the interested reader to refer to this paper for all the details that are omitted here for brevity. The interested reader shall also find in :cite:`CSlessadhoc` a detailed description of another, complementary, use of canonical structures: advanced proof search. This latter papers also presents many techniques one can employ to tune the inference of canonical structures. .. extracted from implicit arguments section .. _canonical-structure-declaration: Declaration of canonical structures ----------------------------------- A canonical structure is an instance of a record/structure type that can be used to solve unification problems involving a projection applied to an unknown structure instance (an implicit argument) and a value. The complete documentation of canonical structures can be found in :ref:`canonicalstructures`; here only a simple example is given. .. cmd:: Canonical {? Structure } @reference Canonical {? Structure } @ident_decl @def_body :name: Canonical Structure; _ The first form of this command declares an existing :n:`@reference` as a canonical instance of a structure (a record). The second form defines a new :term:`constant` as if the :cmd:`Definition` command had been used, then declares it as a canonical instance as if the first form had been used on the defined object. This command supports the :attr:`local` attribute. When used, the structure is canonical only within the :cmd:`Section` containing it. Outside a :cmd:`Section`, the structure is canonical as soon as :cmd:`Import` (or one of its variants) has been used on the :cmd:`Module` in which it is defined, regardless of its locality attribute, if any. :token:`qualid` (in :token:`reference`) denotes an object :n:`(Build_struct c__1 … c__n)` in the structure :g:`struct` for which the fields are :n:`x__1, …, x__n`. Then, each time an equation of the form :n:`(x__i _)` |eq_beta_delta_iota_zeta| :n:`c__i` has to be solved during the type checking process, :token:`qualid` is used as a solution. Otherwise said, :token:`qualid` is canonically used to extend the field :n:`x__i` into a complete structure built on :n:`c__i` when :n:`c__i` unifies with :n:`(x__i _)`. The following kinds of terms are supported for the fields :n:`c__i` of :token:`qualid`: * :term:`Constants ` and section variables of an active section, applied to zero or more arguments. * :token:`sort`\s. * Literal functions: `fun … => …`. * Literal, (possibly dependent) function types: `… -> …` and `forall …, …`. * Variables bound in :token:`qualid`. Only the head symbol of an existing instance's field :n:`c__i` is considered when searching for a canonical extension. We call this head symbol the *key* and we say ":token:`qualid` *keys* the field :n:`x__i` to :n:`k`" when :n:`c__i`'s head symbol is :n:`k`. Keys are the only piece of information that is used for canonical extension. The keys corresponding to the kinds of terms listed above are: * For constants and section variables, potentially applied to arguments: the constant or variable itself, disregarding any arguments. * For sorts: the sort itself. * For literal functions: skip the abstractions and use the key of the body. * For literal function types: a disembodied implication key denoted `forall _, _`, disregarding both its domain and codomain. * For variables bound in :token:`qualid`: a catch-all key denoted `_`. This means that, for example, `(some_constant x1)` and `(some_constant (other_constant y1 y2) x2)` are not distinct keys. Variables bound in :token:`qualid` match any term for the purpose of canonical extension. This has two major consequences for a field :n:`c__i` keyed to a variable of :token:`qualid`: 1. Unless another key—and, thus, instance—matches :n:`c__i`, the instance will always be considered by unification. 2. :n:`c__i` will be considered overlapping not distinct from any other canonical instance that keys :n:`x__i` to one of its own variables. A record field :n:`x__i` can only be keyed once to each key. Coq prints a warning when :token:`qualid` keys :n:`x__i` to a term whose head symbol is already keyed by an existing canonical instance. In this case, Coq will not register that :token:`qualid` as a canonical extension. (The remaining fields of the instance can still be used for canonical extension.) Canonical structures are particularly useful when mixed with coercions and strict implicit arguments. .. example:: Here is an example. .. coqtop:: all reset Require Import Relations. Require Import EqNat. Set Implicit Arguments. Unset Strict Implicit. Structure Setoid : Type := {Carrier :> Set; Equal : relation Carrier; Prf_equiv : equivalence Carrier Equal}. Definition is_law (A B:Setoid) (f:A -> B) := forall x y:A, Equal x y -> Equal (f x) (f y). Axiom eq_nat_equiv : equivalence nat eq_nat. Definition nat_setoid : Setoid := Build_Setoid eq_nat_equiv. Canonical nat_setoid. Thanks to :g:`nat_setoid` declared as canonical, the implicit arguments :g:`A` and :g:`B` can be synthesized in the next statement. .. coqtop:: all abort Lemma is_law_S : is_law S. .. note:: If a same field occurs in several canonical structures, then only the structure declared first as canonical is considered. .. attr:: canonical{? = {| yes | no } } :name: canonical This :term:`boolean attribute` can decorate a :cmd:`Definition` or :cmd:`Let` command. It is equivalent to having a :cmd:`Canonical Structure` declaration just after the command. To prevent a field from being involved in the inference of canonical instances, its declaration can be annotated with ``canonical=no`` (cf. the syntax of :n:`@record_field`). .. example:: For instance, when declaring the :g:`Setoid` structure above, the :g:`Prf_equiv` field declaration could be written as follows. .. coqdoc:: #[canonical=no] Prf_equiv : equivalence Carrier Equal See :ref:`hierarchy_of_structures` for a more realistic example. .. cmd:: Print Canonical Projections {* @reference } This displays the list of global names that are components of some canonical structure. For each of them, the canonical structure of which it is a projection is indicated. If :term:`constants ` are given as its arguments, only the unification rules that involve or are synthesized from simultaneously all given constants will be shown. .. example:: For instance, the above example gives the following output: .. coqtop:: all Print Canonical Projections. .. coqtop:: all Print Canonical Projections nat. .. note:: The last line in the first example would not show up if the corresponding projection (namely :g:`Prf_equiv`) were annotated as not canonical, as described above. Notation overloading ------------------------- We build an infix notation == for a comparison predicate. Such notation will be overloaded, and its meaning will depend on the types of the terms that are compared. .. coqtop:: all reset Module EQ. Record class (T : Type) := Class { cmp : T -> T -> Prop }. Structure type := Pack { obj : Type; class_of : class obj }. Definition op (e : type) : obj e -> obj e -> Prop := let 'Pack _ (Class _ the_cmp) := e in the_cmp. Check op. Arguments op {e} x y : simpl never. Arguments Class {T} cmp. Module theory. Notation "x == y" := (op x y) (at level 70). End theory. End EQ. 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 defining is very simplistic, and characterizes terms on which a binary relation is defined, without requiring such relation to validate any property. The inner theory module contains the overloaded notation ``==`` and will eventually contain lemmas holding all the instances of the algebraic structure (in this case there are no lemmas). Note that in practice the user may want to declare ``EQ.obj`` as a coercion, but we will not do that here. The following line tests that, when we assume a type ``e`` that is in the ``EQ`` class, we can relate two of its objects with ``==``. .. coqtop:: all Import EQ.theory. Check forall (e : EQ.type) (a b : EQ.obj e), a == b. Still, no concrete type is in the ``EQ`` class. .. coqtop:: all Fail Check 3 == 3. We amend that by equipping ``nat`` with a comparison relation. .. coqtop:: all Definition nat_eq (x y : nat) := Nat.compare x y = Eq. Definition nat_EQcl : EQ.class nat := EQ.Class nat_eq. Canonical Structure nat_EQty : EQ.type := EQ.Pack nat nat_EQcl. Check 3 == 3. Eval compute in 3 == 4. This last test shows that Coq is now not only able to type check ``3 == 3``, but also that the infix relation was bound to the ``nat_eq`` relation. This relation is selected whenever ``==`` is used on terms of type nat. This can be read in the line declaring the canonical structure ``nat_EQty``, where the first argument to ``Pack`` is the key and its second argument a group of canonical values associated with the key. In this case we associate with nat only one canonical value (since its class, ``nat_EQcl`` has just one member). The use of the projection ``op`` requires its argument to be in the class ``EQ``, and uses such a member (function) to actually compare its arguments. Similarly, we could equip any other type with a comparison relation, and use the ``==`` notation on terms of this type. Derived Canonical Structures ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ We know how to use ``==`` on base types, like ``nat``, ``bool``, ``Z``. Here we show how to deal with type constructors, i.e. how to make the following example work: .. coqtop:: all 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 how to do that. .. coqtop:: all Definition pair_eq (e1 e2 : EQ.type) (x y : EQ.obj e1 * EQ.obj e2) := fst x == fst y /\ snd x == snd y. Definition pair_EQcl e1 e2 := EQ.Class (pair_eq e1 e2). Canonical Structure pair_EQty (e1 e2 : EQ.type) : EQ.type := EQ.Pack (EQ.obj e1 * EQ.obj e2) (pair_EQcl e1 e2). Check forall (e : EQ.type) (a b : EQ.obj e), (a, b) == (a, b). Check forall n m : nat, (3, 4) == (n, m). Thanks to the ``pair_EQty`` declaration, Coq is able to build a comparison relation for pairs whenever it is able to build a comparison relation for each component of the pair. The declaration associates to the key ``*`` (the type constructor of pairs) the canonical comparison relation ``pair_eq`` whenever the type constructor ``*`` is applied to two types being themselves in the ``EQ`` class. .. _hierarchy_of_structures: Hierarchy of structures ---------------------------- To get to an interesting example we need another base class to be available. We choose the class of types that are equipped with an order relation, to which we associate the infix ``<=`` notation. .. coqtop:: all Module LE. Record class T := Class { cmp : T -> T -> Prop }. Structure type := Pack { obj : Type; class_of : class obj }. Definition op (e : type) : obj e -> obj e -> Prop := let 'Pack _ (Class _ f) := e in f. Arguments op {_} x y : simpl never. Arguments Class {T} cmp. Module theory. Notation "x <= y" := (op x y) (at level 70). End theory. End LE. As before we register a canonical ``LE`` class for ``nat``. .. coqtop:: all Import LE.theory. Definition nat_le x y := Nat.compare x y <> Gt. Definition nat_LEcl : LE.class nat := LE.Class nat_le. Canonical Structure nat_LEty : LE.type := LE.Pack nat nat_LEcl. And we enable Coq to relate pair of terms with ``<=``. .. coqtop:: all Definition pair_le e1 e2 (x y : LE.obj e1 * LE.obj e2) := fst x <= fst y /\ snd x <= snd y. Definition pair_LEcl e1 e2 := LE.Class (pair_le e1 e2). Canonical Structure pair_LEty (e1 e2 : LE.type) : LE.type := LE.Pack (LE.obj e1 * LE.obj e2) (pair_LEcl e1 e2). Check (3,4,5) <= (3,4,5). At the current stage we can use ``==`` and ``<=`` on concrete types, like tuples of natural numbers, but we can’t develop an algebraic theory over the types that are equipped with both relations. .. coqtop:: all Check 2 <= 3 /\ 2 == 2. Fail Check forall (e : EQ.type) (x y : EQ.obj e), x <= y -> y <= x -> x == y. Fail Check forall (e : LE.type) (x y : LE.obj e), x <= y -> y <= x -> x == y. We need to define a new class that inherits from both ``EQ`` and ``LE``. .. coqtop:: all Module LEQ. Record mixin (e : EQ.type) (le : EQ.obj e -> EQ.obj e -> Prop) := Mixin { compat : forall x y : EQ.obj e, le x y /\ le y x <-> x == y }. Record class T := Class { EQ_class : EQ.class T; LE_class : LE.class T; extra : mixin (EQ.Pack T EQ_class) (LE.cmp T LE_class) }. Structure type := _Pack { obj : Type; #[canonical=no] class_of : class obj }. Arguments Mixin {e le} _. Arguments Class {T} _ _ _. The mixin component of the ``LEQ`` class contains all the extra content we are adding to ``EQ`` and ``LE``. In particular it contains the requirement that the two relations we are combining are compatible. The `class_of` projection of the `type` structure is annotated as *not canonical*; it plays no role in the search for instances. Unfortunately there is still an obstacle to developing the algebraic theory of this new class. .. coqtop:: all Module theory. Fail Check forall (le : type) (n m : obj le), n <= m -> n <= m -> n == m. The problem is that the two classes ``LE`` and ``LEQ`` are not yet related by a subclass relation. In other words Coq does not see that an object of the ``LEQ`` class is also an object of the ``LE`` class. The following two constructions tell Coq how to canonically build the ``LE.type`` and ``EQ.type`` structure given an ``LEQ.type`` structure on the same type. .. coqtop:: all Definition to_EQ (e : type) : EQ.type := EQ.Pack (obj e) (EQ_class _ (class_of e)). Canonical Structure to_EQ. Definition to_LE (e : type) : LE.type := LE.Pack (obj e) (LE_class _ (class_of e)). Canonical Structure to_LE. We can now formulate out first theorem on the objects of the ``LEQ`` structure. .. coqtop:: all Lemma lele_eq (e : type) (x y : obj e) : x <= y -> y <= x -> x == y. now intros; apply (compat _ _ (extra _ (class_of e)) x y); split. Qed. Arguments lele_eq {e} x y _ _. End theory. End LEQ. Import LEQ.theory. Check lele_eq. Of course one would like to apply results proved in the algebraic setting to any concrete instate of the algebraic structure. .. coqtop:: all Example test_algebraic (n m : nat) : n <= m -> m <= n -> n == m. Fail apply (lele_eq n m). Abort. Example test_algebraic2 (l1 l2 : LEQ.type) (n m : LEQ.obj l1 * LEQ.obj l2) : n <= m -> m <= n -> n == m. Fail apply (lele_eq n m). Abort. Again one has to tell Coq that the type ``nat`` is in the ``LEQ`` class, and how the type constructor ``*`` interacts with the ``LEQ`` class. In the following proofs are omitted for brevity. .. coqtop:: all Lemma nat_LEQ_compat (n m : nat) : n <= m /\ m <= n <-> n == m. Admitted. Definition nat_LEQmx := LEQ.Mixin nat_LEQ_compat. Lemma pair_LEQ_compat (l1 l2 : LEQ.type) (n m : LEQ.obj l1 * LEQ.obj l2) : n <= m /\ m <= n <-> n == m. Admitted. Definition pair_LEQmx l1 l2 := LEQ.Mixin (pair_LEQ_compat l1 l2). The following script registers an ``LEQ`` class for ``nat`` and for the type constructor ``*``. It also tests that they work as expected. Unfortunately, these declarations are very verbose. In the following subsection we show how to make them more compact. .. coqtop:: all Module Add_instance_attempt. Canonical Structure nat_LEQty : LEQ.type := LEQ._Pack nat (LEQ.Class nat_EQcl nat_LEcl nat_LEQmx). Canonical Structure pair_LEQty (l1 l2 : LEQ.type) : LEQ.type := LEQ._Pack (LEQ.obj l1 * LEQ.obj l2) (LEQ.Class (EQ.class_of (pair_EQty (to_EQ l1) (to_EQ l2))) (LE.class_of (pair_LEty (to_LE l1) (to_LE l2))) (pair_LEQmx l1 l2)). Example test_algebraic (n m : nat) : n <= m -> m <= n -> n == m. now apply (lele_eq n m). Qed. Example test_algebraic2 (n m : nat * nat) : n <= m -> m <= n -> n == m. now apply (lele_eq n m). Qed. End Add_instance_attempt. Note that no direct proof of ``n <= m -> m <= n -> n == m`` is provided by the user for ``n`` and m of type ``nat * nat``. What the user provides is a proof of this statement for ``n`` and ``m`` of type ``nat`` and a proof that the pair constructor preserves this property. The combination of these two facts is a simple form of proof search that Coq performs automatically while inferring canonical structures. Compact declaration of Canonical Structures ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ We need some infrastructure for that. .. coqtop:: all Require Import Strings.String. Module infrastructure. Inductive phantom {T : Type} (t : T) := Phantom. Definition unify {T1 T2} (t1 : T1) (t2 : T2) (s : option string) := phantom t1 -> phantom t2. Definition id {T} {t : T} (x : phantom t) := x. Notation "[find v | t1 ~ t2 ] p" := (fun v (_ : unify t1 t2 None) => p) (at level 50, v name, only parsing). Notation "[find v | t1 ~ t2 | s ] p" := (fun v (_ : unify t1 t2 (Some s)) => p) (at level 50, v name, only parsing). Notation "'Error : t : s" := (unify _ t (Some s)) (at level 50, format "''Error' : t : s"). Open Scope string_scope. End infrastructure. To explain the notation ``[find v | t1 ~ t2]`` let us pick one of its instances: ``[find e | EQ.obj e ~ T | "is not an EQ.type" ]``. It should be read as: “find a class e such that its objects have type T or fail with message "T is not an EQ.type"”. The other utilities are used to ask Coq to solve a specific unification problem, that will in turn require the inference of some canonical structures. They are explained in more details in :cite:`CSwcu`. We now have all we need to create a compact “packager” to declare instances of the ``LEQ`` class. .. coqtop:: all Import infrastructure. Definition packager T e0 le0 (m0 : LEQ.mixin e0 le0) := [find e | EQ.obj e ~ T | "is not an EQ.type" ] [find o | LE.obj o ~ T | "is not an LE.type" ] [find ce | EQ.class_of e ~ ce ] [find co | LE.class_of o ~ co ] [find m | m ~ m0 | "is not the right mixin" ] LEQ._Pack T (LEQ.Class ce co m). Notation Pack T m := (packager T _ _ m _ id _ id _ id _ id _ id). The object ``Pack`` takes a type ``T`` (the key) and a mixin ``m``. It infers all the other pieces of the class ``LEQ`` and declares them as canonical values associated with the ``T`` key. All in all, the only new piece of information we add in the ``LEQ`` class is the mixin, all the rest is already canonical for ``T`` and hence can be inferred by Coq. ``Pack`` is a notation, hence it is not type checked at the time of its declaration. It will be type checked when it is used, an in that case ``T`` is going to be a concrete type. The odd arguments ``_`` and ``id`` we pass to the packager represent respectively the classes to be inferred (like ``e``, ``o``, etc) and a token (``id``) to force their inference. Again, for all the details the reader can refer to :cite:`CSwcu`. The declaration of canonical instances can now be way more compact: .. coqtop:: all Canonical Structure nat_LEQty := Eval hnf in Pack nat nat_LEQmx. Canonical Structure pair_LEQty (l1 l2 : LEQ.type) := Eval hnf in Pack (LEQ.obj l1 * LEQ.obj l2) (pair_LEQmx l1 l2). Error messages are also quite intelligible (if one skips to the end of the message). .. coqtop:: all Fail Canonical Structure err := Eval hnf in Pack bool nat_LEQmx. coq-8.20.0/doc/sphinx/language/extensions/evars.rst000066400000000000000000000210271466560755400223210ustar00rootroot00000000000000.. extracted from Gallina extensions chapter .. _existential-variables: Existential variables --------------------- :gdef:`Existential variables ` represent as yet unknown values. .. insertprodn term_evar term_evar .. prodn:: term_evar ::= _ | ?[ @ident ] | ?[ ?@ident ] | ?@ident {? @%{ {+; @ident := @term } %} } Coq terms can include existential variables that represent unknown subterms that are eventually replaced with actual subterms. Existential variables are generated in place of unsolved implicit arguments or “_” placeholders when using commands such as ``Check`` (see Section :ref:`requests-to-the-environment`) or when using tactics such as :tacn:`refine`, as well as in place of unsolved instances when using tactics such that :tacn:`eapply`. An existential variable is defined in a context, which is the context of variables of the placeholder which generated the existential variable, and a type, which is the expected type of the placeholder. As a consequence of typing constraints, existential variables can be duplicated in such a way that they possibly appear in different contexts than their defining context. Thus, any occurrence of a given existential variable comes with an instance of its original context. In the simple case, when an existential variable denotes the placeholder which generated it, or is used in the same context as the one in which it was generated, the context is not displayed and the existential variable is represented by “?” followed by an identifier. .. coqtop:: all Parameter identity : forall (X:Set), X -> X. Check identity _ _. Check identity _ (fun x => _). In the general case, when an existential variable :n:`?@ident` appears outside its context of definition, its instance, written in the form :n:`{ {*; @ident := @term} }`, is appended to its name, indicating how the variables of its defining context are instantiated. Only the variables that are defined in another context are displayed: this is why an existential variable used in the same context as its context of definition is written with no instance. This behavior may be changed: see :ref:`explicit-display-existentials`. .. coqtop:: all Check (fun x y => _) 0 1. Existential variables can be named by the user upon creation using the syntax :n:`?[@ident]`. This is useful when the existential variable needs to be explicitly handled later in the script (e.g. with a named-goal selector, see :ref:`goal-selectors`). .. extracted from Gallina chapter .. index:: _ Inferable subterms ~~~~~~~~~~~~~~~~~~ .. todo: This topic deserves considerably more explanation, but this will have to do for now @name allows `_` (used in 43 places in the grammar), but IIUC is semantically restricted. Some of the cases: * match expressions in terms (see :n:`@term_match`) * binders (see :n:`@name`) in let, functions * function parameters * universe levels relation to implicit arguments? also intropatterns and hints paths, which are not terms :n:`@term`\s may use :gdef:`holes `, denoted by :n:`_`, for purposes such as: * Omitting redundant subterms. Redundant subterms that Coq is able to infer can be replaced with :n:`_`. For example HELP ME HERE. * Indicating where existential variables should be created in e* tactics such as :tacn:`assert`. is it possible to see holes in the context for any of these? Expressions often contain redundant pieces of information. Subterms that can be automatically inferred by Coq can be replaced by the symbol ``_`` and Coq will guess the missing piece of information. e* tactics that can create existential variables ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ A number of tactics have companion tactics that create existential variables when the base tactic would fail because of uninstantiated variables. The companion tactic names begin with an :n:`e` followed by the name of the base tactic. For example, :tacn:`eapply` works the same way as :tacn:`apply`, except that it will create new existential variable(s) when :tacn:`apply` would fail. .. example:: apply vs eapply Both tactics unify the goal with :n:`n < p` in the theorem. :n:`m` is unspecified. This makes :tacn:`apply` fail, while :tacn:`eapply` creates a new existential variable :n:`?m`. .. coqtop:: none reset Require Import Arith. Goal forall i j, i < j. intros. .. coqtop:: all (* Theorem lt_trans : forall n m p, n < m -> m < p -> n < p. *) Fail apply Nat.lt_trans. eapply Nat.lt_trans. The :n:`e*` tactics include: .. list-table:: * - :tacn:`eapply` - :tacn:`eassert` - :tacn:`eassumption` - :tacn:`eauto` * - :tacn:`ecase` - :tacn:`econstructor` - :tacn:`edestruct` - :tacn:`ediscriminate` * - :tacn:`eelim` - :tacn:`eenough` - :tacn:`eexact` - :tacn:`eexists` * - :tacn:`einduction` - :tacn:`einjection` - :tacn:`eintros` - :tacn:`eleft` * - :tacn:`epose` - :tacn:`eremember` - :tacn:`erewrite` - :tacn:`eright` * - :tacn:`eset` - :tacn:`esimplify_eq` - :tacn:`esplit` - :tacn:`etransitivity` Note that :tacn:`eassumption` and :tacn:`eauto` behave differently from the others. Automatic resolution of existential variables ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Existential variables that are used in other goals are generally resolved automatically as a side effect of other tactics. .. _automatic-evar-resolution: .. example:: Automatic resolution of existential variables :n:`?x` and :n:`?m` are used in other goals. The :tacn:`exact` shown below determines the values of these variables by unification, which resolves them. .. coqtop:: reset in Require Import Arith. Set Printing Goal Names. Goal forall n m, n <= m -> ~ m < n. .. coqtop:: all intros x y H1 H2. eapply Nat.lt_irrefl. (* creates ?x : nat as a shelved goal *) eapply Nat.le_lt_trans. (* creates ?m : nat as a shelved goal *) Unshelve. (* moves the shelved goals into focus--not needed and usually not done *) exact H1. (* resolves the first goal and by side effect ?x and ?m *) The :n:`?x` and :n:`?m` goals ask for proof that :n:`nat` has an :term:`inhabitant`, i.e. it is not an empty type. This can be proved directly by applying a constructor of :n:`nat`, which assigns values for :n:`?x` and :n:`?m`. However if you choose poorly, you can end up with unprovable goals (in this case :n:`0 < 0`). Like this: .. coqtop:: reset none Require Import Arith. Set Printing Goal Names. Goal forall n m, n <= m -> ~ m < n. intros x y H1 H2. eapply Nat.lt_irrefl. (* creates ?x : nat as a shelved goal *) eapply Nat.le_lt_trans. (* creates ?m : nat as a shelved goal *) .. coqtop:: out Unshelve. (* moves the shelved goals into focus--not needed and usually not done *) .. coqtop:: all 3-4: apply 0. (* assigns values to ?x and ?m *) .. extracted from Gallina extensions chapter .. _explicit-display-existentials: Explicit display of existential instances for pretty-printing ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ .. flag:: Printing Existential Instances Activates the full display of how the context of an existential variable is instantiated at each of the occurrences of the existential variable. Off by default. .. coqtop:: all Check (fun x y => _) 0 1. Set Printing Existential Instances. Check (fun x y => _) 0 1. .. _tactics-in-terms: Solving existential variables using tactics ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Instead of letting the unification engine try to solve an existential variable by itself, one can also provide an explicit hole together with a tactic to solve it. Using the syntax ``ltac:(``\ `tacexpr`\ ``)``, the user can put a tactic anywhere a term is expected. The order of resolution is not specified and is implementation-dependent. The inner tactic may use any variable defined in its scope, including repeated alternations between variables introduced by term binding as well as those introduced by tactic binding. The expression `tacexpr` can be any tactic expression as described in :ref:`ltac`. .. coqtop:: all Definition foo (x : nat) : nat := ltac:(exact x). This construction is useful when one wants to define complicated terms using highly automated tactics without resorting to writing the proof-term by means of the interactive proof engine. coq-8.20.0/doc/sphinx/language/extensions/implicit-arguments.rst000066400000000000000000000530461466560755400250240ustar00rootroot00000000000000.. _ImplicitArguments: Implicit arguments ------------------ An :gdef:`implicit argument` of a function is an argument which can be inferred from contextual knowledge. There are different kinds of implicit arguments that can be considered implicit in different ways. There are also various commands to control the setting or the inference of implicit arguments. The different kinds of implicit arguments ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Implicit arguments inferable from the knowledge of other arguments of a function ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ The first kind of implicit arguments covers the arguments that are inferable from the knowledge of the type of other arguments of the function, or of the type of the surrounding context of the application. Especially, such implicit arguments correspond to parameters dependent in the type of the function. Typical implicit arguments are the type arguments in polymorphic functions. There are several kinds of such implicit arguments. **Strict Implicit Arguments** An implicit argument can be either strict or non-strict. An implicit argument is said to be *strict* if, whatever the other arguments of the function are, it is still inferable from the type of some other argument. Technically, an implicit argument is strict if it corresponds to a parameter which is not applied to a variable which itself is another parameter of the function (since this parameter may erase its arguments), not in the body of a match, and not itself applied or matched against patterns (since the original form of the argument can be lost by reduction). For instance, the first argument of :: cons: forall A:Set, A -> list A -> list A in module ``List.v`` is strict because :g:`list` is an inductive type and :g:`A` will always be inferable from the type :g:`list A` of the third argument of :g:`cons`. Also, the first argument of :g:`cons` is strict with respect to the second one, since the first argument is exactly the type of the second argument. On the contrary, the second argument of a term of type :: forall P:nat->Prop, forall n:nat, P n -> ex nat P is implicit but not strict, since it can only be inferred from the type :g:`P n` of the third argument and if :g:`P` is, e.g., :g:`fun _ => True`, it reduces to an expression where ``n`` does not occur any longer. The first argument :g:`P` is implicit but not strict either because it can only be inferred from :g:`P n` and :g:`P` is not canonically inferable from an arbitrary :g:`n` and the normal form of :g:`P n`. Consider, e.g., that :g:`n` is :math:`0` and the third argument has type :g:`True`, then any :g:`P` of the form :: fun n => match n with 0 => True | _ => anything end would be a solution of the inference problem. **Contextual Implicit Arguments** An implicit argument can be *contextual* or not. An implicit argument is said to be *contextual* if it can be inferred only from the knowledge of the type of the context of the current expression. For instance, the only argument of:: nil : forall A:Set, list A is contextual. Similarly, both arguments of a term of type:: forall P:nat->Prop, forall n:nat, P n \/ n = 0 are contextual (moreover, :g:`n` is strict and :g:`P` is not). **Reversible-Pattern Implicit Arguments** There is another class of implicit arguments that can be reinferred unambiguously if all the types of the remaining arguments are known. This is the class of implicit arguments occurring in the type of another argument in position of reversible pattern, which means it is at the head of an application but applied only to uninstantiated distinct variables. Such an implicit argument is called *reversible- pattern implicit argument*. A typical example is the argument :g:`P` of nat_rec in :: nat_rec : forall P : nat -> Set, P 0 -> (forall n : nat, P n -> P (S n)) -> forall x : nat, P x (:g:`P` is reinferable by abstracting over :g:`n` in the type :g:`P n`). See :ref:`controlling-rev-pattern-implicit-args` for the automatic declaration of reversible-pattern implicit arguments. Implicit arguments inferable by resolution ++++++++++++++++++++++++++++++++++++++++++ This corresponds to a class of non-dependent implicit arguments that are solved based on the structure of their type only. Maximal and non-maximal insertion of implicit arguments ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ When a function is partially applied and the next argument to apply is an implicit argument, the application can be interpreted in two ways. If the next argument is declared as *maximally inserted*, the partial 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 "{ }" and non-maximally inserted implicit arguments are written in square brackets "[ ]". .. seealso:: :flag:`Maximal Implicit Insertion` Trailing Implicit Arguments +++++++++++++++++++++++++++ An implicit argument is considered *trailing* when all following arguments are implicit. Trailing implicit arguments must be declared as maximally inserted; otherwise they would never be inserted. .. exn:: Argument @name is a trailing implicit, so it can't be declared non maximal. Please use %{ %} instead of [ ]. For instance: .. coqtop:: all fail Fail Definition double [n] := n + n. Casual use of implicit arguments ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ If an argument of a function application can be inferred from the type of the other arguments, the user can force inference of the argument by replacing it with `_`. .. exn:: Cannot infer a term for this placeholder. :name: Cannot infer a term for this placeholder. (Casual use of implicit arguments) Coq was not able to deduce an instantiation of a “_”. .. _declare-implicit-args: Declaration of implicit arguments ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Implicit arguments can be declared when a function is declared or afterwards, using the :cmd:`Arguments` command. Implicit Argument Binders +++++++++++++++++++++++++ .. insertprodn implicit_binders implicit_binders .. prodn:: implicit_binders ::= %{ {+ @name } {? : @type } %} | [ {+ @name } {? : @type } ] In the context of a function definition, these forms specify that :token:`name` is an implicit argument. The first form, with curly braces, makes :token:`name` a maximally inserted implicit argument. The second form, with square brackets, makes :token:`name` a non-maximally inserted implicit argument. For example: .. coqtop:: all Definition id {A : Type} (x : A) : A := x. declares the argument `A` of `id` as a maximally inserted implicit argument. `A` may be omitted in applications of `id` but may be specified if needed: .. coqtop:: all abort Definition compose {A B C} (g : B -> C) (f : A -> B) := fun x => g (f x). Goal forall A, compose id id = id (A:=A). For non-maximally inserted implicit arguments, use square brackets: .. coqtop:: all Fixpoint map [A B : Type] (f : A -> B) (l : list A) : list B := match l with | nil => nil | cons a t => cons (f a) (map f t) end. Print Implicit map. For (co)inductive datatype declarations, the semantics are the following: an inductive parameter declared as an implicit argument need not be repeated in the inductive definition and will become implicit for the inductive type and the constructors. For example: .. coqtop:: all Inductive list {A : Type} : Type := | nil : list | cons : A -> list -> list. Print list. One can always specify the parameter if it is not uniform using the usual implicit arguments disambiguation syntax. The syntax is also supported in internal binders. For instance, in the following kinds of expressions, the type of each declaration present in :n:`{* @binder }` can be bracketed to mark the declaration as implicit: * :n:`fun (@ident:forall {* @binder }, @type) => @term`, * :n:`forall (@ident:forall {* @binder }, @type), @type`, * :n:`let @ident {* @binder } := @term in @term`, * :n:`fix @ident {* @binder } := @term in @term` and * :n:`cofix @ident {* @binder } := @term in @term`. Here is an example: .. coqtop:: all Axiom Ax : forall (f:forall {A} (a:A), A * A), let g {A} (x y:A) := (x,y) in f 0 = g 0 0. .. warn:: Ignoring implicit binder declaration in unexpected position This is triggered when setting an argument implicit in an expression which does not correspond to the type of an assumption or to the :term:`body` of a definition. Here is an example: .. coqtop:: all warn Definition f := forall {y}, y = 0. .. warn:: Making shadowed name of implicit argument accessible by position This is triggered when two variables of same name are set implicit in the same block of binders, in which case the first occurrence is considered to be unnamed. Here is an example: .. coqtop:: all warn Check let g {x:nat} (H:x=x) {x} (H:x=x) := x in 0. Mode for automatic declaration of implicit arguments ++++++++++++++++++++++++++++++++++++++++++++++++++++ .. flag:: Implicit Arguments This :term:`flag` (off by default) allows to systematically declare implicit the arguments detectable as such. Auto-detection of implicit arguments is governed by flags controlling whether strict and contextual implicit arguments have to be considered or not. .. _controlling-strict-implicit-args: Controlling strict implicit arguments +++++++++++++++++++++++++++++++++++++ .. flag:: Strict Implicit When the mode for automatic declaration of implicit arguments is on, the default is to automatically set implicit only the strict implicit arguments plus, for historical reasons, a small subset of the non-strict implicit arguments. To relax this constraint and to set implicit all non-strict implicit arguments by default, you can turn this :term:`flag` off. .. flag:: Strongly Strict Implicit Use this :term:`flag` (off by default) to capture exactly the strict implicit arguments and no more than the strict implicit arguments. .. _controlling-contextual-implicit-args: Controlling contextual implicit arguments +++++++++++++++++++++++++++++++++++++++++ .. flag:: Contextual Implicit By default, Coq does not automatically set implicit the contextual implicit arguments. You can turn this :term:`flag` on to tell Coq to also infer contextual implicit argument. .. _controlling-rev-pattern-implicit-args: Controlling reversible-pattern implicit arguments +++++++++++++++++++++++++++++++++++++++++++++++++ .. flag:: Reversible Pattern Implicit By default, Coq does not automatically set implicit the reversible-pattern implicit arguments. You can turn this :term:`flag` on to tell Coq to also infer reversible-pattern implicit argument. .. _controlling-insertion-implicit-args: Controlling the insertion of implicit arguments not followed by explicit arguments ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ .. flag:: Maximal Implicit Insertion Assuming the implicit argument mode is on, this :term:`flag` (off by default) declares implicit arguments to be automatically inserted when a function is partially applied and the next argument of the function is an implicit one. Combining manual declaration and automatic declaration ++++++++++++++++++++++++++++++++++++++++++++++++++++++ When some arguments are manually specified implicit with binders in a definition and the automatic declaration mode in on, the manual implicit arguments are added to the automatically declared ones. In that case, and when the flag :flag:`Maximal Implicit Insertion` is set to off, some trailing implicit arguments can be inferred to be non-maximally inserted. In this case, they are converted to maximally inserted ones. .. example:: .. coqtop:: all Set Implicit Arguments. Axiom eq0_le0 : forall (n : nat) (x : n = 0), n <= 0. Print Implicit eq0_le0. Axiom eq0_le0' : forall (n : nat) {x : n = 0}, n <= 0. Print Implicit eq0_le0'. .. _explicit-applications: Explicit applications ~~~~~~~~~~~~~~~~~~~~~ In presence of non-strict or contextual arguments, or in presence of partial applications, the synthesis of implicit arguments may fail, so one may have to explicitly give certain implicit arguments of an application. To instantiate a dependent implicit argument, use the :n:`(@ident := @term)` form of :token:`arg`, where :token:`ident` is the name of the implicit argument and :token:`term` is its corresponding explicit term. To instantiate a non-dependent implicit argument, use the :n:`(@natural := @term)` form of :token:`arg`, where :token:`natural` is the index of the implicit argument among all non-dependent arguments of the function (implicit or not, and starting from 1) and :token:`term` is its corresponding explicit term. Alternatively, one can deactivate the hiding of implicit arguments for a single function application using the :n:`@@qualid_annotated {+ @term1 }` form of :token:`term_application`. .. example:: Syntax for explicitly giving implicit arguments (continued) .. coqtop:: all Parameter X : Type. Definition Relation := X -> X -> Prop. Definition Transitivity (R:Relation) := forall x y:X, R x y -> forall z:X, R y z -> R x z. Parameters (R : Relation) (p : Transitivity R). Arguments p : default implicits. Print Implicit p. Parameters (a b c : X) (r1 : R a b) (r2 : R b c). Check (p r1 (z:=c)). Check (p (x:=a) (y:=b) r1 (z:=c) r2). .. exn:: Wrong argument name :undocumented: .. exn:: Wrong argument position :undocumented: .. exn:: Argument at position @natural is mentioned more than once :undocumented: .. exn:: Arguments given by name or position not supported in explicit mode :undocumented: .. exn:: Not enough non implicit arguments to accept the argument bound to @ident :undocumented: .. exn:: Not enough non implicit arguments to accept the argument bound to @natural :undocumented: .. _displaying-implicit-args: Displaying implicit arguments ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ .. cmd:: Print Implicit @reference Displays the implicit arguments associated with an object, identifying which arguments are applied maximally or not. Displaying implicit arguments when pretty-printing ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ .. flag:: Printing Implicit By default, the basic pretty-printing rules hide the inferable implicit arguments of an application. Turn this :term:`flag` on to force printing all implicit arguments. .. flag:: Printing Implicit Defensive By default, the basic pretty-printing rules display implicit arguments that are not detected as strict implicit arguments. This “defensive” mode can quickly make the display cumbersome so this can be deactivated by turning this :term:`flag` off. .. seealso:: :flag:`Printing All`. Interaction with subtyping ~~~~~~~~~~~~~~~~~~~~~~~~~~ When an implicit argument can be inferred from the type of more than one of the other arguments, then only the type of the first of these arguments is taken into account, and not an upper type of all of them. As a consequence, the inference of the implicit argument of “=” fails in .. coqtop:: all Fail Check nat = Prop. but succeeds in .. coqtop:: all Check Prop = nat. .. _deactivation-of-implicit-arguments: Deactivation of implicit arguments for parsing ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ .. insertprodn term_explicit term_explicit .. prodn:: term_explicit ::= @ @qualid_annotated This syntax can be used to disable implicit arguments for a single function. .. example:: The function `id` has one implicit argument and one explicit argument. .. coqtop:: all reset Check (id 0). Definition id' := @id. The function `id'` has no implicit argument. .. coqtop:: all Check (id' nat 0). .. flag:: Parsing Explicit Turning this :term:`flag` on (it is off by default) deactivates the use of implicit arguments. In this case, all arguments of :term:`constants `, inductive types, constructors, etc, including the arguments declared as implicit, have to be given as if no arguments were implicit. By symmetry, this also affects printing. .. example:: We can reproduce the example above using the :flag:`Parsing Explicit` flag: .. coqtop:: all reset Set Parsing Explicit. Definition id' := id. Unset Parsing Explicit. Check (id 1). Check (id' nat 1). Implicit types of variables ~~~~~~~~~~~~~~~~~~~~~~~~~~~ It is possible to bind variable names to a given type (e.g. in a development using arithmetic, it may be convenient to bind the names :g:`n` or :g:`m` to the type :g:`nat` of natural numbers). .. cmd:: Implicit {| Type | Types } @reserv_list :name: Implicit Type; Implicit Types .. insertprodn reserv_list simple_reserv .. prodn:: reserv_list ::= {+ ( @simple_reserv ) } | @simple_reserv simple_reserv ::= {+ @ident } : @type Sets the type of bound variables starting with :token:`ident` (either :token:`ident` itself or :token:`ident` followed by one or more single quotes, underscore or digits) to :token:`type` (unless the bound variable is already declared with an explicit type, in which case, that type will be used). .. example:: .. coqtop:: all Require Import List. Implicit Types m n : nat. Lemma cons_inj_nat : forall m n l, n :: l = m :: l -> n = m. Proof. intros m n. Abort. Lemma cons_inj_bool : forall (m n:bool) l, n :: l = m :: l -> n = m. Abort. .. flag:: Printing Use Implicit Types By default, the type of bound variables is not printed when the variable name is associated with an implicit type which matches the actual type of the variable. This feature can be deactivated by turning this :term:`flag` off. .. _implicit-generalization: Implicit generalization ~~~~~~~~~~~~~~~~~~~~~~~ .. index:: `{ } .. index:: `[ ] .. index:: `( ) .. index:: `{! } .. index:: `[! ] .. index:: `(! ) .. insertprodn generalizing_binder term_generalizing .. prodn:: generalizing_binder ::= `( {+, @typeclass_constraint } ) | `%{ {+, @typeclass_constraint } %} | `[ {+, @typeclass_constraint } ] typeclass_constraint ::= {? ! } @term | %{ @name %} : {? ! } @term | @name : {? ! } @term term_generalizing ::= `%{ @term %} | `( @term ) Implicit generalization is an automatic elaboration of a statement with free variables into a closed statement where these variables are quantified explicitly. Use the :cmd:`Generalizable` command to designate which variables should be generalized. It is activated within a binder by prefixing it with \`, and for terms by surrounding it with \`{ }, or \`[ ] or \`( ). Terms surrounded by \`{ } introduce their free variables as maximally inserted implicit arguments, terms surrounded by \`[ ] introduce them as non-maximally inserted implicit arguments and terms surrounded by \`( ) introduce them as explicit arguments. Generalizing binders always introduce their free variables as maximally inserted implicit arguments. The binder itself introduces its argument as usual. In the following statement, ``A`` and ``y`` are automatically generalized, ``A`` is implicit and ``x``, ``y`` and the anonymous equality argument are explicit. .. coqtop:: all reset Generalizable All Variables. Definition sym `(x:A) : `(x = y -> y = x) := fun _ p => eq_sym p. Print sym. Dually to normal binders, the name is optional but the type is required: .. coqtop:: all Check (forall `{x = y :> A}, y = x). When generalizing a binder whose type is a typeclass, its own class arguments are omitted from the syntax and are generalized using automatic names, without instance search. Other arguments are also generalized unless provided. This produces a fully general statement. this behavior may be disabled by prefixing the type with a ``!`` or by forcing the typeclass name to be an explicit application using ``@`` (however the later ignores implicit argument information). .. coqtop:: all Class Op (A:Type) := op : A -> A -> A. Class Commutative (A:Type) `(Op A) := commutative : forall x y, op x y = op y x. Instance nat_op : Op nat := plus. Set Printing Implicit. Check (forall `{Commutative }, True). Check (forall `{Commutative nat}, True). Fail Check (forall `{Commutative nat _}, True). Fail Check (forall `{!Commutative nat}, True). Arguments Commutative _ {_}. Check (forall `{!Commutative nat}, True). Check (forall `{@Commutative nat plus}, True). Multiple binders can be merged using ``,`` as a separator: .. coqtop:: all Check (forall `{Commutative A, Hnat : !Commutative nat}, True). .. cmd:: Generalizable {| {| Variable | Variables } {+ @ident } | All Variables | No Variables } Controls the set of generalizable identifiers. By default, no variables are generalizable. This command supports the :attr:`global` attribute. The :n:`{| Variable | Variables } {+ @ident }` form allows generalization of only the given :n:`@ident`\s. Using this command multiple times adds to the allowed identifiers. The other forms clear the list of :n:`@ident`\s. The :n:`All Variables` form generalizes all free variables in the context that appear under a generalization delimiter. This may result in confusing errors in case of typos. In such cases, the context will probably contain some unexpected generalized variables. The :n:`No Variables` form disables implicit generalization entirely. This is the default behavior (before any :cmd:`Generalizable` command has been entered). coq-8.20.0/doc/sphinx/language/extensions/index.rst000066400000000000000000000015761466560755400223170ustar00rootroot00000000000000.. _extensions: =================== Language extensions =================== 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 notations, factorize branches when pattern-matching, etc. In this chapter, we present these language extensions and we give some explanations on how this language is translated down to the core language presented in the :ref:`previous chapter `. .. toctree:: :maxdepth: 1 evars implicit-arguments match ../../user-extensions/syntax-extensions arguments-command ../../addendum/implicit-coercions ../../addendum/type-classes canonical ../../addendum/program ../../proof-engine/vernacular-commands coq-8.20.0/doc/sphinx/language/extensions/match.rst000066400000000000000000000732201466560755400222770ustar00rootroot00000000000000.. _extendedpatternmatching: Extended pattern matching ========================= :Authors: Cristina Cornes and Hugo Herbelin This section describes the full form of pattern matching in Coq terms. .. |rhs| replace:: right hand sides .. extracted from Gallina extensions chapter Variants and extensions of :g:`match` ------------------------------------- .. _mult-match: Multiple and nested pattern matching ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ The basic version of :g:`match` allows pattern matching on simple patterns. As an extension, multiple nested patterns or disjunction of patterns are allowed, as in ML-like languages (cf. :ref:`multiple-patterns` and :ref:`nested-patterns`). The extension just acts as a macro that is expanded during parsing into a sequence of match on simple patterns. Especially, a construction defined using the extended match is generally printed under its expanded form (see :flag:`Printing Matching`). .. _if-then-else: Pattern-matching on boolean values: the if expression ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ .. insertprodn term_if term_if .. prodn:: term_if ::= if @term {? {? as @name } return @term100 } then @term else @term For inductive types with exactly two constructors and for pattern matching expressions that do not depend on the arguments of the constructors, it is possible to use a ``if … then … else`` notation. For instance, the definition .. coqtop:: all Definition not (b:bool) := match b with | true => false | false => true end. can be alternatively written .. coqtop:: reset all Definition not (b:bool) := if b then false else true. More generally, for an inductive type with constructors :n:`@ident__1` and :n:`@ident__2`, the following terms are equal: :n:`if @term__0 {? {? as @name } return @term } then @term__1 else @term__2` :n:`match @term__0 {? {? as @name } return @term } with | @ident__1 {* _ } => @term__1 | @ident__2 {* _ } => @term__2 end` .. example:: .. coqtop:: all Check (fun x (H:{x=0}+{x<>0}) => match H with | left _ => true | right _ => false end). Notice that the printing uses the :g:`if` syntax because :g:`sumbool` is declared as such (see :ref:`controlling-match-pp`). .. _irrefutable-patterns: Irrefutable patterns: the destructuring let variants ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Pattern-matching on terms inhabiting inductive type having only one constructor can be alternatively written using :g:`let … in …` constructions. There are two variants of them. .. insertprodn destructuring_let destructuring_let .. prodn:: destructuring_let ::= let ( {*, @name } ) {? {? as @name } return @term100 } := @term in @term | let ' @pattern := @term {? return @term100 } in @term | let ' @pattern in @pattern := @term return @term100 in @term First destructuring let syntax ++++++++++++++++++++++++++++++ .. todo explain that this applies to all of the "let" constructs (Gallina, Ltac1 and Ltac2) also add "irrefutable pattern" to the glossary note that in Ltac2 an upper case ident is a constructor, lower case is a variable The expression :n:`let ( {*, @ident__i } ) := @term__0 in @term__1` performs case analysis on :n:`@term__0` whose type must be an inductive type with exactly one constructor. The number of variables :n:`@ident__i` must correspond to the number of arguments of this constructor. Then, in :n:`@term__1`, these variables are bound to the arguments of the constructor in :n:`@term__0`. For instance, the definition .. coqtop:: reset all Definition fst (A B:Set) (H:A * B) := match H with | pair x y => x end. can be alternatively written .. coqtop:: reset all Definition fst (A B:Set) (p:A * B) := let (x, _) := p in x. Notice that reduction is different from regular :g:`let … in …` construction since it happens only if :n:`@term__0` is in constructor form. Otherwise, the reduction is blocked. The pretty-printing of a definition by matching on a irrefutable pattern can either be done using :g:`match` or the :g:`let` construction (see Section :ref:`controlling-match-pp`). If term inhabits an inductive type with one constructor `C`, we have an equivalence between :: let (ident₁, …, identₙ) [dep_ret_type] := term in term' and :: match term [dep_ret_type] with C ident₁ … identₙ => term' end Second destructuring let syntax +++++++++++++++++++++++++++++++ Another destructuring let syntax is available for inductive types with one constructor by giving an arbitrary pattern instead of just a tuple for all the arguments. For example, the preceding example can be written: .. coqtop:: reset all Definition fst (A B:Set) (p:A*B) := let 'pair x _ := p in x. This is useful to match deeper inside tuples and also to use notations for the pattern, as the syntax :g:`let ’p := t in b` allows arbitrary patterns to do the deconstruction. For example: .. coqtop:: all Definition deep_tuple (A:Set) (x:(A*A)*(A*A)) : A*A*A*A := let '((a,b), (c, d)) := x in (a,b,c,d). Notation " x 'With' p " := (exist _ x p) (at level 20). Definition proj1_sig' (A:Set) (P:A->Prop) (t:{ x:A | P x }) : A := let 'x With p := t in x. When printing definitions which are written using this construct it takes precedence over let printing directives for the datatype under consideration (see Section :ref:`controlling-match-pp`). .. _controlling-match-pp: Controlling pretty-printing of match expressions ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ The following commands give some control over the pretty-printing of :g:`match` expressions. Printing nested patterns +++++++++++++++++++++++++ .. flag:: Printing Matching The Calculus of Inductive Constructions knows pattern matching only over simple patterns. It is however convenient to re-factorize nested pattern matching into a single pattern matching over a nested pattern. When this :term:`flag` is on (default), Coq’s printer tries to do such limited re-factorization. Turning it off tells Coq to print only simple pattern matching problems in the same way as the Coq kernel handles them. Factorization of clauses with same right-hand side ++++++++++++++++++++++++++++++++++++++++++++++++++ .. flag:: Printing Factorizable Match Patterns When several patterns share the same right-hand side, it is additionally possible to share the clauses using disjunctive patterns. Assuming that the printing matching mode is on, this :term:`flag` (on by default) tells Coq's printer to try to do this kind of factorization. Use of a default clause +++++++++++++++++++++++ .. flag:: Printing Allow Match Default Clause When several patterns share the same right-hand side which do not depend on the arguments of the patterns, yet an extra factorization is possible: the disjunction of patterns can be replaced with a `_` default clause. Assuming that the printing matching mode and the factorization mode are on, this :term:`flag` (on by default) tells Coq's printer to use a default clause when relevant. Printing of wildcard patterns ++++++++++++++++++++++++++++++ .. flag:: Printing Wildcard Some variables in a pattern may not occur in the right-hand side of the pattern matching clause. When this :term:`flag` is on (default), the variables having no occurrences in the right-hand side of the pattern matching clause are just printed using the wildcard symbol “_”. Printing of the elimination predicate +++++++++++++++++++++++++++++++++++++ .. flag:: Printing Synth In most of the cases, the type of the result of a matched term is mechanically synthesizable. Especially, if the result type does not depend of the matched term. When this :term:`flag` is on (default), the result type is not printed when Coq knows that it can re- synthesize it. Printing of hidden subterms +++++++++++++++++++++++++++ .. flag:: Printing Match All Subterms In order to be able to cheaply reconstruct the types of the variables bound by `in` and `as`, `match` terms contain the polymorphic universe instance and the parameters of the inductive which is being matched. When this flag is on (it is off by default), this information is displayed as a :term:`volatile cast` around the match discriminee. When the match relies on :flag:`Definitional UIP`, the indices are also subterms of the `match` term and are displayed when this flag is on. Otherwise they are not subterms and are displayed as holes (`_`) when this flag is on. .. example:: .. coqtop:: in Polymorphic Inductive eqT@{u} {A:Type@{u}} (a:A) : A -> Type@{u} := reflT : eqT a a. Set Definitional UIP. Inductive seq {A} (a:A) : A -> SProp := srefl : seq a a. .. coqtop:: all Print eqT_rect. Print seq_rect. Set Printing Match All Subterms. Set Printing Universes. Print eqT_rect. Print seq_rect. Printing matching on irrefutable patterns ++++++++++++++++++++++++++++++++++++++++++ If an inductive type has just one constructor, pattern matching can be written using the first destructuring let syntax. .. table:: Printing Let @qualid This :term:`table` specifies a set of qualids for which pattern matching is displayed using a let expression. Note that this only applies to pattern matching instances entered with :g:`match`. It doesn't affect pattern matching explicitly entered with a destructuring :g:`let`. Use the :cmd:`Add` and :cmd:`Remove` commands to update this set. Printing matching on booleans +++++++++++++++++++++++++++++ If an inductive type is isomorphic to the boolean type, pattern matching can be written using ``if`` … ``then`` … ``else`` …. This table controls which types are written this way: .. table:: Printing If @qualid This :term:`table` specifies a set of qualids for which pattern matching is displayed using ``if`` … ``then`` … ``else`` …. Use the :cmd:`Add` and :cmd:`Remove` commands to update this set. This example emphasizes what the printing settings offer. .. example:: .. coqtop:: all Definition snd (A B:Set) (H:A * B) := match H with | pair x y => y end. Test Printing Let for prod. Print snd. Remove Printing Let prod. Unset Printing Synth. Unset Printing Wildcard. Print snd. Conventions about unused pattern-matching variables ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Pattern-matching variables that are not used on the right-hand side of ``=>`` are considered the sign of a potential error. For instance, it could result from an undetected misspelled constant constructor. By default, a warning is issued in such situations. .. warn:: Unused variable @ident might be a misspelled constructor. Use _ or _@ident to silence this warning. :name: Unused variable ‘ident’ might be a misspelled constructor. Use _ or _‘ident’ to silence this warning. This indicates that an unused pattern variable :token:`ident` occurs in a pattern-matching clause. The warning can be deactivated by using a variable name starting with ``_`` or by setting ``Set Warnings "-unused-pattern-matching-variable"``. Here is an example where the warning is activated. .. example:: .. coqtop:: all warn Definition is_zero (o : option nat) := match o with | Some _ => true | x => false end. Patterns -------- The full syntax of `match` is presented in :ref:`match_term`. Identifiers in patterns are either constructor names or variables. Any identifier that is not the constructor of an inductive or coinductive type is considered to be a variable. A variable name cannot occur more than once in a given pattern. It is recommended to start variable names by a lowercase letter. If a pattern has the form ``c x`` where ``c`` is a constructor symbol and x is a linear vector of (distinct) variables, it is called *simple*: it is the kind of pattern recognized by the basic version of match. On the opposite, if it is a variable ``x`` or has the form ``c p`` with ``p`` not only made of variables, the pattern is called *nested*. A variable pattern matches any value, and the identifier is bound to that value. The pattern “``_``” (called “don't care” or “wildcard” symbol) also matches any value, but does not bind anything. It may occur an arbitrary number of times in a pattern. Alias patterns written :n:`(@pattern as @ident)` are also accepted. This pattern matches the same values as :token:`pattern` does and :token:`ident` is bound to the matched value. A pattern of the form :n:`@pattern | @pattern` is called disjunctive. A list of patterns separated with commas is also considered as a pattern and is called *multiple pattern*. However multiple patterns can only occur at the root of pattern matching equations. Disjunctions of *multiple patterns* are allowed though. Since extended ``match`` expressions are compiled into the primitive ones, the expressiveness of the theory remains the same. Once parsing has finished only simple patterns remain. The original nesting of the ``match`` expressions is recovered at printing time. An easy way to see the result of the expansion is to toggle off the nesting performed at printing (use here :flag:`Printing Matching`), then by printing the term with :cmd:`Print` if the term is a :term:`constant`, or using the command :cmd:`Check`. The extended ``match`` still accepts an optional *elimination predicate* given after the keyword ``return``. Given a pattern matching expression, if all the right-hand-sides of ``=>`` have the same type, then this type can be sometimes synthesized, and so we can omit the return part. Otherwise the predicate after return has to be provided, like for the basicmatch. Let us illustrate through examples the different aspects of extended pattern matching. Consider for example the function that computes the maximum of two natural numbers. We can write it in primitive syntax by: .. coqtop:: in Fixpoint max (n m:nat) {struct m} : nat := match n with | O => m | S n' => match m with | O => S n' | S m' => S (max n' m') end end. .. _multiple-patterns: Multiple patterns ----------------- Using multiple patterns in the definition of ``max`` lets us write: .. coqtop:: in reset Fixpoint max (n m:nat) {struct m} : nat := match n, m with | O, _ => m | S n', O => S n' | S n', S m' => S (max n' m') end. which will be compiled into the previous form. The pattern matching compilation strategy examines patterns from left to right. A match expression is generated **only** when there is at least one constructor in the column of patterns. E.g. the following example does not build a match expression. .. coqtop:: all Check (fun x:nat => match x return nat with | y => y end). Aliasing subpatterns -------------------- We can also use :n:`as @ident` to associate a name to a sub-pattern: .. coqtop:: in reset Fixpoint max (n m:nat) {struct n} : nat := match n, m with | O, _ => m | S n' as p, O => p | S n', S m' => S (max n' m') end. .. _nested-patterns: Nested patterns --------------- Here is now an example of nested patterns: .. coqtop:: in Fixpoint even (n:nat) : bool := match n with | O => true | S O => false | S (S n') => even n' end. This is compiled into: .. coqtop:: all Unset Printing Matching. Print even. .. coqtop:: none Set Printing Matching. In the previous examples patterns do not conflict with, but sometimes it is comfortable to write patterns that admit a nontrivial superposition. Consider the boolean function :g:`lef` that given two natural numbers yields :g:`true` if the first one is less or equal than the second one and :g:`false` otherwise. We can write it as follows: .. coqtop:: in Fixpoint lef (n m:nat) {struct m} : bool := match n, m with | O, _ => true | _, O => false | S n, S m => lef n m end. Note that the first and the second multiple pattern overlap because the couple of values ``O O`` matches both. Thus, what is the result of the function on those values? To eliminate ambiguity we use the *textual priority rule:* we consider patterns to be ordered from top to bottom. A value is matched by the pattern at the ith row if and only if it is not matched by some pattern from a previous row. Thus in the example, ``O O`` is matched by the first pattern, and so :g:`(lef O O)` yields true. Another way to write this function is: .. coqtop:: in reset Fixpoint lef (n m:nat) {struct m} : bool := match n, m with | O, _ => true | S n, S m => lef n m | _, _ => false end. Here the last pattern superposes with the first two. Because of the priority rule, the last pattern will be used only for values that do not match neither the first nor the second one. Terms with useless patterns are not accepted by the system. Here is an example: .. coqtop:: all Fail Check (fun x:nat => match x with | O => true | S _ => false | x => true end). Disjunctive patterns -------------------- Multiple patterns that share the same right-hand-side can be factorized using the notation :n:`{+| {+, @pattern } }`. For instance, :g:`max` can be rewritten as follows: .. coqtop:: in reset Fixpoint max (n m:nat) {struct m} : nat := match n, m with | S n', S m' => S (max n' m') | 0, p | p, 0 => p end. Similarly, factorization of (not necessarily multiple) patterns that share the same variables is possible by using the notation :n:`{+| @pattern}`. Here is an example: .. coqtop:: in Definition filter_2_4 (n:nat) : nat := match n with | 2 as m | 4 as m => m | _ => 0 end. Nested disjunctive patterns are allowed, inside parentheses, with the notation :n:`({+| @pattern})`, as in: .. coqtop:: in Definition filter_some_square_corners (p:nat*nat) : nat*nat := match p with | ((2 as m | 4 as m), (3 as n | 5 as n)) => (m,n) | _ => (0,0) end. About patterns of parametric types ---------------------------------- Parameters in patterns ~~~~~~~~~~~~~~~~~~~~~~ When matching objects of a parametric type, parameters do not bind in patterns. They must be substituted by “``_``”. Consider for example the type of polymorphic lists: .. coqtop:: in Inductive List (A:Set) : Set := | nil : List A | cons : A -> List A -> List A. We can check the function *tail*: .. coqtop:: all Check (fun l:List nat => match l with | nil _ => nil nat | cons _ _ l' => l' end). When we use parameters in patterns there is an error message: .. coqtop:: all Fail Check (fun l:List nat => match l with | nil A => nil nat | cons A _ l' => l' end). .. flag:: Asymmetric Patterns This :term:`flag` (off by default) removes parameters from constructors in patterns: .. coqtop:: all Set Asymmetric Patterns. Check (fun l:List nat => match l with | nil => nil _ | cons _ l' => l' end). Unset Asymmetric Patterns. Implicit arguments in patterns ------------------------------ By default, implicit arguments are omitted in patterns. So we write: .. coqtop:: all Arguments nil {A}. Arguments cons [A] _ _. Check (fun l:List nat => match l with | nil => nil | cons _ l' => l' end). But the possibility to use all the arguments is given by “``@``” implicit explicitations (as for terms, see :ref:`explicit-applications`). .. coqtop:: all Check (fun l:List nat => match l with | @nil _ => @nil nat | @cons _ _ l' => l' end). .. _matching-dependent: Matching objects of dependent types ----------------------------------- The previous examples illustrate pattern matching on objects of non- dependent types, but we can also use the expansion strategy to destructure objects of dependent types. Consider the type :g:`listn` of lists of a certain length: .. coqtop:: in reset Inductive listn : nat -> Set := | niln : listn 0 | consn : forall n:nat, nat -> listn n -> listn (S n). Understanding dependencies in patterns -------------------------------------- We can define the function length over :g:`listn` by: .. coqdoc:: Definition length (n:nat) (l:listn n) := n. Just for illustrating pattern matching, we can define it by case analysis: .. coqtop:: in Definition length (n:nat) (l:listn n) := match l with | niln => 0 | consn n _ _ => S n end. We can understand the meaning of this definition using the same notions of usual pattern matching. When the elimination predicate must be provided ----------------------------------------------- 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 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 function :g:`concat` for :g:`listn` is an example where the branches have different types and we need to provide the elimination predicate: .. coqtop:: in Fixpoint concat (n:nat) (l:listn n) (m:nat) (l':listn m) {struct l} : listn (n + m) := match l in listn n return listn (n + m) with | niln => l' | consn n' a y => consn (n' + m) a (concat n' y m l') end. .. coqtop:: none Reset concat. The elimination predicate is :g:`fun (n:nat) (l:listn n) => listn (n+m)`. In general if :g:`m` has type :g:`(I q1 … qr t1 … ts)` where :g:`q1, …, qr` are parameters, the elimination predicate should be of the form :g:`fun y1 … ys x : (I q1 … qr y1 … ys ) => Q`. In the concrete syntax, it should be written : ``match m as x in (I _ … _ y1 … ys) return Q with … end``. The variables which appear in the ``in`` and ``as`` clause are new and bounded in the property :g:`Q` in the return clause. The parameters of the inductive definitions should not be mentioned and are replaced by ``_``. Multiple dependent pattern matching ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Recall that a list of patterns is also a pattern. So, when we destructure several terms at the same time and the branches have different types we need to provide the elimination predicate for this multiple pattern. It is done using the same scheme: each term may be associated with an ``as`` clause and an ``in`` clause in order to introduce a dependent product. For example, an equivalent definition for :g:`concat` (even though the matching on the second term is trivial) would have been: .. coqtop:: in Fixpoint concat (n:nat) (l:listn n) (m:nat) (l':listn m) {struct l} : listn (n + m) := match l in listn n, l' return listn (n + m) with | niln, x => x | consn n' a y, x => consn (n' + m) a (concat n' y m x) end. Even without real matching over the second term, this construction can be used to keep types linked. If :g:`a` and :g:`b` are two :g:`listn` of the same length, by writing .. coqtop:: in Check (fun n (a b: listn n) => match a, b with | niln, b0 => tt | consn n' a y, bS => tt end). we have a copy of :g:`b` in type :g:`listn 0` resp. :g:`listn (S n')`. .. _match-in-patterns: Patterns in ``in`` ~~~~~~~~~~~~~~~~~~ If the type of the matched term is more precise than an inductive applied to variables, arguments of the inductive in the ``in`` branch can be more complicated patterns than a variable. Moreover, constructors whose types do not follow the same pattern will become impossible branches. In an impossible branch, you can answer anything but False_rect unit has the advantage to be subterm of anything. To be concrete: the ``tail`` function can be written: .. coqtop:: in Definition tail n (v: listn (S n)) := match v in listn (S m) return listn m with | niln => False_rect unit | consn n' a y => y end. and :g:`tail n v` will be subterm of :g:`v`. Using pattern matching to write proofs -------------------------------------- In all the previous examples the elimination predicate does not depend on the object(s) matched. But it may depend and the typical case is when we write a proof by induction or a function that yields an object of a dependent type. An example of a proof written using ``match`` is given in the description of the tactic :tacn:`refine`. For example, we can write the function :g:`buildlist` that given a natural number :g:`n` builds a list of length :g:`n` containing zeros as follows: .. coqtop:: in Fixpoint buildlist (n:nat) : listn n := match n return listn n with | O => niln | S n => consn n 0 (buildlist n) end. We can also use multiple patterns. Consider the following definition of the predicate less-equal :g:`Le`: .. coqtop:: in Inductive LE : nat -> nat -> Prop := | LEO : forall n:nat, LE 0 n | LES : forall n m:nat, LE n m -> LE (S n) (S m). We can use multiple patterns to write the proof of the lemma :g:`forall (n m:nat), (LE n m) \/ (LE m n)`: .. coqtop:: in Fixpoint dec (n m:nat) {struct n} : LE n m \/ LE m n := match n, m return LE n m \/ LE m n with | O, x => or_introl (LE x 0) (LEO x) | x, O => or_intror (LE x 0) (LEO x) | S n as n', S m as m' => match dec n m with | or_introl h => or_introl (LE m' n') (LES n m h) | or_intror h => or_intror (LE n' m') (LES m n h) end end. In the example of :g:`dec`, the first match is dependent while the second is not. The user can also use match in combination with the tactic :tacn:`refine` to build incomplete proofs beginning with a :g:`match` construction. Pattern-matching on inductive objects involving local definitions ----------------------------------------------------------------- If local definitions (`let :=`) occur in the type of a constructor, then there are two ways to match on this constructor. Either the local definitions are skipped and matching is done only on the true arguments of the constructors, or the bindings for local definitions can also be caught in the matching. .. example:: .. coqtop:: in reset Inductive list : nat -> Set := | nil : list 0 | cons : forall n:nat, let m := (2 * n) in list m -> list (S (S m)). In the next example, the local definition is not caught. .. coqtop:: in Fixpoint length n (l:list n) {struct l} : nat := match l with | nil => 0 | cons n l0 => S (length (2 * n) l0) end. But in this example, it is. .. coqtop:: in Fixpoint length' n (l:list n) {struct l} : nat := match l with | nil => 0 | @cons _ m l0 => S (length' m l0) end. .. note:: For a given matching clause, either none of the local definitions or all of them can be caught. .. note:: You can only catch let bindings in mode where you bind all variables and so you have to use ``@`` syntax. .. note:: this feature is incoherent with the fact that parameters cannot be caught and consequently is somehow hidden. For example, there is no mention of it in error messages. Pattern-matching and coercions ------------------------------ If a mismatch occurs between the expected type of a pattern and its actual type, a coercion made from constructors is sought. If such a coercion can be found, it is automatically inserted around the pattern. .. example:: .. coqtop:: in Inductive I : Set := | C1 : nat -> I | C2 : I -> I. Coercion C1 : nat >-> I. .. coqtop:: all Check (fun x => match x with | C2 O => 0 | _ => 0 end). When does the expansion strategy fail? -------------------------------------- The strategy works very like in ML languages when treating patterns of non-dependent types. But there are new cases of failure that are due to the presence of dependencies. The error messages of the current implementation may be sometimes confusing. When the tactic fails because patterns are somehow incorrect then error messages refer to the initial expression. But the strategy may succeed to build an expression whose sub-expressions are well typed when the whole expression is not. In this situation the message makes reference to the expanded expression. We encourage users, when they have patterns with the same outer constructor in different equations, to name the variable patterns in the same positions with the same name. E.g. to write ``(cons n O x) => e1`` and ``(cons n _ x) => e2`` instead of ``(cons n O x) => e1`` and ``(cons n' _ x') => e2``. This helps to maintain certain name correspondence between the generated expression and the original. Here is a summary of the error messages corresponding to each situation: .. exn:: The constructor @ident expects @natural arguments. The variable ident is bound several times in pattern term Found a constructor of inductive type term while a constructor of term is expected Patterns are incorrect (because constructors are not applied to the correct number of arguments, because they are not linear or they are wrongly typed). .. exn:: Non exhaustive pattern matching. The pattern matching is not exhaustive. .. exn:: The elimination predicate term should be of arity @natural (for non \ dependent case) or @natural (for dependent case). The elimination predicate provided to match has not the expected arity. .. exn:: Unable to infer a match predicate Either there is a type incompatibility or the problem involves dependencies. There is a type mismatch between the different branches. The user should provide an elimination predicate. coq-8.20.0/doc/sphinx/language/gallina-extensions.rst000066400000000000000000000001361466560755400226040ustar00rootroot00000000000000:orphan: .. raw:: html coq-8.20.0/doc/sphinx/language/gallina-specification-language.rst000066400000000000000000000001301466560755400250000ustar00rootroot00000000000000:orphan: .. raw:: html coq-8.20.0/doc/sphinx/language/module-system.rst000066400000000000000000000001321466560755400216030ustar00rootroot00000000000000:orphan: .. raw:: html coq-8.20.0/doc/sphinx/license.rst000066400000000000000000000004701466560755400166400ustar00rootroot00000000000000.. note:: **License** This material (the Coq Reference Manual) may be distributed only subject to the terms and conditions set forth in the Open Publication License, v1.0 or later (the latest version is presently available at http://www.opencontent.org/openpub). Options A and B are not elected. coq-8.20.0/doc/sphinx/practical-tools/000077500000000000000000000000001466560755400175635ustar00rootroot00000000000000coq-8.20.0/doc/sphinx/practical-tools/coq-commands.rst000066400000000000000000000743241466560755400227100ustar00rootroot00000000000000.. _thecoqcommands: Coq commands ==================== There are several Coq commands: + ``coqide``: a graphical integrated development environment, described :ref:`here `. In addition, there are several other IDEs such as Proof General, vsCoq and Coqtail that are not included with the Coq installation. + ``coqtop``: a legacy terminal-oriented, non-graphical interfaces for Coq + ``coqc``: the Coq compiler (batch compilation) + ``coqchk``: the Coq checker (validation of compiled libraries) Many of the parameters to start these tools are shared and are described below. Passing the `-help` option on the command line will print a summary of the available command line parameters. There are also man pages for each of these, but they are probably less current than `-help` or this document). .. _interactive-use: Interactive use (coqtop) ------------------------ In the interactive mode, also known as the Coq toplevel, users can develop their 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 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 with the command ``Drop.``, and come back to the Coq toplevel with the command ``#go;;``. .. flag:: Coqtop Exit On Error This :term:`flag`, off by default, causes coqtop to exit with status code ``1`` if a command produces an error instead of recovering from it. Batch compilation (coqc) ------------------------ The ``coqc`` command compiles a Coq proof script file with a ".v" suffix to create a compiled file with a ".vo" suffix. (See :ref:`compiled-files`.) The last component of the filename must be a valid Coq identifier as described in :ref:`lexical-conventions`; it should contain only letters, digits or underscores (_) with a ".v" suffix on the final component. For example ``/bar/foo/toto.v`` is valid, but ``/bar/foo/to-to.v`` is not. We recommend specifying a :term:`logical path` (which is also the module name) with the `-R` or the `-Q` options. Generally we recommend using utilities such as `make` (using `coq_makefile` to generate the `Makefile`) or `dune` to build Coq projects. See :ref:`coq_makefile` and :ref:`building_dune`. .. example:: Compiling and loading a single file If `foo.v` is in Coq's current directory, you can use `coqc foo.v` to compile it and then `Require foo.` in your script. But this doesn't scale well for larger projects. Generally it's better to define a new module: To compile `foo.v` as part of a module `Mod1` that is rooted at `.` (i.e. the directory containing `foo.v`), run `coqc -Q . Mod1 foo.v`. To make the module available in `CoqIDE`, include the following line in the `_CoqProject` file (see :ref:`coq_makefile`) in the directory from which you start `CoqIDE` or give it as an argument to the ``coqide`` command. ** is the pathname of the directory containing the module, which can be an absolute path or relative to Coq's current directory. For now, you must close and reload a named script file for `CoqIDE` to pick up the change, or restart `CoqIDE`. The project file name is configurable in `Edit / Preferences / Project`. .. coqdoc:: -R Mod1 Customization at launch time --------------------------------- Command parameters ------------------ There are 3 mechanisms for passing parameters to Coq commands. In order of importance they are: - :ref:`command line options `, - :ref:`environment variables ` and - the `coqrc` start up script `coqrc` start up script ~~~~~~~~~~~~~~~~~~~~~~~ When Coq is launched, it can implicitly prepend a startup script to any document read by Coq, whether it is an interactive session or a file to compile. The startup script can come from a configuration directory or it can be specified on the command line. Coq uses the first file found in this list as the startup script: - ``$XDG_CONFIG_HOME/coqrc.`` - ``$XDG_CONFIG_HOME/coqrc`` - ``$HOME/.coqrc.`` - ``$HOME/.coqrc`` where ``$XDG_CONFIG_HOME`` is an environment variable. ``$HOME`` is the user's home directory. ```` is the version of Coq (as shown by `coqc --version`, for example). ``-init-file file`` on the command line uses the specified file instead of a startup script from a configuration directory. ``-q`` prevents the use of a startup script. .. _customization-by-environment-variables: Environment variables ~~~~~~~~~~~~~~~~~~~~~ ``$COQPATH`` can be used to specify the :term:`load path`. It is a list of directories separated by ``:`` (``;`` on Windows). Coq will also honor ``$XDG_DATA_HOME`` and ``$XDG_DATA_DIRS`` (see Section :ref:`logical-paths-load-path`). .. TODO PR: Correct ref above? Some Coq commands call other Coq commands. In this case, they look for the commands in directory specified by ``$COQBIN``. If this variable is not set, they look for the commands in the executable path. .. _COQ_COLORS: ``$COQ_COLORS`` can be used to specify the set of colors used by ``coqtop`` to highlight its output. It uses the same syntax as the ``$LS_COLORS`` variable from GNU’s ls, that is, a colon-separated list of assignments of the form :n:`name={*; attr}` where ``name`` is the name of the corresponding highlight tag and each ``attr`` is an ANSI escape code. The list of highlight tags can be retrieved with the ``-list-tags`` command-line option of ``coqtop``. The string uses ANSI escape codes to represent attributes. For example: ``export COQ_COLORS=”diff.added=4;48;2;0;0;240:diff.removed=41”`` sets the highlights for added text in diffs to underlined (the 4) with a background RGB color (0, 0, 240) and for removed text in diffs to a red background. Note that if you specify ``COQ_COLORS``, the predefined attributes are ignored. .. _OCAMLRUNPARAM: ``$OCAMLRUNPARAM``, described `here `_, can be used to specify certain runtime and memory usage parameters. In most cases, experimenting with these settings will likely not cause a significant performance difference and should be harmless. If the variable is not set, Coq uses the `default values `_, except that ``space_overhead`` is set to 120 and ``minor_heap_size`` is set to 32Mwords (256MB with 64-bit executables or 128MB with 32-bit executables). .. todo: Using the same text "here" for both of the links in the last 2 paragraphs generates an incorrect warning: coq-commands.rst:4: WARNING: Duplicate explicit target name: "here". The warning doesn't even have the right line number. :-( .. todo how about COQLIB, COQCORELIB, DOCDIR .. _COQ_PROFILE_COMPONENTS: Specifies which components produce events when using the :ref:`profiling` system. It is a comma separated list of component names. If the variable is not set, all components produce events. Component names are internally defined, but `command` which corresponds to the interpretation of one command is particularly notable. .. _command-line-options: Command line options ~~~~~~~~~~~~~~~~~~~~ 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, which is needed to load OCaml object code files (``.cmo`` or ``.cmxs``). Subdirectories are not included. See the command :cmd:`Declare ML Module`. Directories added with ``-I`` are searched after the current directory, in the order in which they were given on the command line .. TODO PR: is that right about Declare ML Module? it's not a directory like -I .. seealso:: The :cmd:`Declare ML Module` command. .. _-Q-option: :-Q *directory dirpath*: Makes the `.vo` files in a :term:`package` available for loading with the :cmd:`Require` command by adding new entries to the :term:`load path`. The entries map the :term:`logical path` *dirpath* to the physical path *directory*. Then Coq recursively adds load path entries for subdirectories. For example, `-Q . Lib` may add the logical path `Lib.SubDir.File`, which maps to the file `./SubDir/File.vo`. Only subdirectories and files that follow the lexical conventions for :n:`@ident`\s are included. Subdirectories named ``CVS`` or ``_darcs`` are excluded. Some operating systems or file systems are more restrictive. For example, Linux’s ext4 file system limits filenames to 255 bytes. The default on NTFS (Windows) and HFS+ (MacOS X) file systems is to disallow two files in the same directory with names that differ only in their case. Loading files from packages made available with `-Q` must include the :term:`logical name` of the package in `From` clause of the :cmd:`Require` command *or* provide a fully qualified name. :-R *directory dirpath*: Similar to ``-Q`` *directory dirpath*, but allows using :cmd:`Require` with a partially qualified name (i.e. without a `From` clause). :-top *dirpath*: Set the logical module name to :n:`@dirpath` for the `coqtop` interactive session. If no module name is specified, `coqtop` will default to ``Top``. `coqc` does not accept this option because the logical module name is inferred from the name of the input file and the corresponding `-R` / `-Q` options. :-exclude-dir *directory*: Exclude any subdirectory named *directory* while processing options such as -R and -Q. By default, only the conventional version control management directories named CVS and_darcs are excluded. :-nois, -noinit: Start from an empty state instead of loading the `Init.Prelude` module. :-init-file *file*: Load *file* as the resource file instead of loading the default resource file from the standard configuration directories. :-q: Do not to load the default resource file. :-l *file*, -load-vernac-source *file*: Load and execute the Coq script from *file.v*. :-lv *file*, -load-vernac-source-verbose *file*: Load and execute the Coq script from *file.v*. Write its contents to the standard output as it is executed. :-require *qualid*: Load Coq compiled library :n:`@qualid`. This is equivalent to running :cmd:`Require` :n:`@qualid` (note: the short form `-r *qualid*` is intentionally not provided to prevent the risk of collision with `-R`). .. _interleave-command-line: .. note:: Note that the relative order of this command-line option and its variants (`-ri`, `-re`, `-rfrom`, `-refrom`, `-rifrom`) and of the `-set` and `-unset` options matters since the various :cmd:`Require`, :cmd:`Require Import`, :cmd:`Require Export`, :cmd:`Set` and :cmd:`Unset` commands will be executed in the order specified on the command-line. :-ri *qualid*, -require-import *qualid*: Load Coq compiled library :n:`@qualid` and import it. This is equivalent to running :cmd:`Require Import` :n:`@qualid`. See the :ref:`note above ` regarding the order of command-line options. :-re *qualid*, -require-export *qualid*: Load Coq compiled library :n:`@qualid` and transitively import it. This is equivalent to running :cmd:`Require Export` :n:`@qualid`. See the :ref:`note above ` regarding the order of command-line options. :-rfrom *dirpath qualid*, -require-from *dirpath qualid*: Load Coq compiled library :n:`@qualid`. This is equivalent to running :cmd:`From ` :n:`@dirpath` :cmd:`Require ` :n:`@qualid`. See the :ref:`note above ` regarding the order of command-line options. :-rifrom *dirpath qualid*, -require-import-from *dirpath qualid*: Load Coq compiled library :n:`@qualid` and import it. This is equivalent to running :cmd:`From ` :n:`@dirpath` :cmd:`Require Import ` :n:`@qualid`. See the :ref:`note above ` regarding the order of command-line options. :-refrom *dirpath qualid*, -require-export-from *dirpath qualid*: Load Coq compiled library :n:`@qualid` and transitively import it. This is equivalent to running :cmd:`From ` :n:`@dirpath` :cmd:`Require Export ` :n:`@qualid`. See the :ref:`note above ` regarding the order of command-line options. :-load-vernac-object *qualid*: Obsolete synonym of :n:`-require qualid`. :-batch: Exit just after argument parsing. Available for ``coqtop`` only. :-verbose: Output the content of the input file as it is compiled. This option is available for ``coqc`` only. :-native-compiler (yes|no|ondemand): Enable the :tacn:`native_compute` reduction machine and precompilation to ``.cmxs`` files for future use by :tacn:`native_compute`. Setting ``yes`` enables :tacn:`native_compute`; it also causes Coq to precompile the native code for future use; all dependencies need to have been precompiled beforehand. Setting ``no`` disables :tacn:`native_compute` which defaults back to :tacn:`vm_compute`; no files are precompiled. Setting ``ondemand`` enables :tacn:`native_compute` but disables precompilation; all missing dependencies will be recompiled every time :tacn:`native_compute` is called. .. _native-compiler-options: .. deprecated:: 8.14 This flag has been deprecated in favor of the :ref:`coqnative` binary. The toolchain has been adapted to transparently rely on the latter, so if you use :ref:`coq_makefile` there is nothing to do. Otherwise you should substitute calls to `coqc -native-compiler yes` to calls to `coqc` followed by `coqnative` on the resulting `vo` file. .. versionchanged:: 8.13 The default value is set at configure time, ``-config`` can be used to retrieve it. All this can be summarized in the following table: .. list-table:: :header-rows: 1 * - ``configure`` - ``coqc`` - ``native_compute`` - outcome - requirements * - yes - yes (default) - native_compute - ``.cmxs`` - ``.cmxs`` of deps * - yes - no - vm_compute - none - none * - yes - ondemand - native_compute - none - none * - no - yes, no, ondemand - vm_compute - none - none * - ondemand - yes - native_compute - ``.cmxs`` - ``.cmxs`` of deps * - ondemand - no - vm_compute - none - none * - ondemand - ondemand (default) - native_compute - none - none :-native-output-dir *dir*: Set the directory in which to put the aforementioned ``.cmxs`` for :tacn:`native_compute`. Defaults to ``.coq-native``. :-output-directory *dir*, -output-dir *dir*: Sets the output directory for commands that write output to files, such as :ref:`extraction` commands, :cmd:`Redirect` and :cmd:`Print Universes`. :-vos: Indicate Coq to skip the processing of opaque proofs (i.e., proofs ending with :cmd:`Qed` or :cmd:`Admitted`), output a ``.vos`` files instead of a ``.vo`` file, and to load ``.vos`` files instead of ``.vo`` files when interpreting :cmd:`Require` commands. :-vok: Indicate Coq to check a file completely, to load ``.vos`` files instead of ``.vo`` files when interpreting :cmd:`Require` commands, and to output an empty ``.vok`` files upon success instead of writing a ``.vo`` file. :-w (all|none|w₁,…,wₙ): Configure the display of warnings. This option expects all, none or a comma-separated list of warning names or categories (see Section :ref:`controlling-display`). :-color (on|off|auto): *Coqtop only*. Enable or disable color output. Default is auto, meaning color is shown only if the output channel supports ANSI escape sequences. :-diffs (on|off|removed): *Coqtop only*. Controls highlighting of differences between proof steps. ``on`` highlights added tokens, ``removed`` highlights both added and removed tokens. Requires that ``-color`` is enabled. (see Section :ref:`showing_diffs`). :-beautify: Pretty-print each command to *file.beautified* when compiling *file.v*, in order to get old-fashioned syntax/definitions/notations. :-emacs, -ide-slave: Start a special toplevel to communicate with a specific IDE. :-impredicative-set: Change the logical theory of Coq by declaring the sort :g:`Set` impredicative. .. warning:: This is known to be inconsistent with some standard axioms of classical mathematics such as the functional axiom of choice or the principle of description. :-type-in-type: Collapse the universe hierarchy of Coq. .. warning:: This makes the logic inconsistent. :-mangle-names *ident*: *Experimental.* Do not depend on this option. Replace Coq's auto-generated name scheme with names of the form *ident0*, *ident1*, etc. 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 facilitate tracking down problems. :-set *string*: Enable flags and set options. *string* should be :n:`@setting_name=value`, the value is interpreted according to the 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. See the :ref:`note above ` regarding the order of command-line options. :-unset *string*: As ``-set`` but used to disable options and flags. *string* must be :n:`"@setting_name"`. See the :ref:`note above ` regarding the order of command-line options. :-compat *version*: Load a file that sets a few options to maintain partial backward-compatibility with a previous version. This is equivalent to :cmd:`Require Import` `Coq.Compat.CoqXXX` with `XXX` one of the last three released versions (including the current version). Note that the :ref:`explanations above ` regarding the order of command-line options apply, and this could be relevant if you are resetting some of the compatibility options. :-dump-glob *file*: Dump references for global names in file *file* (to be used by coqdoc, see :ref:`coqdoc`). By default, if *file.v* is being compiled, *file.glob* is used. :-no-glob: Disable the dumping of references for global names. :-image *file*: Set the binary image to be used by ``coqc`` to be *file* instead of the standard one. Not of general use. :-bindir *directory*: Set the directory containing Coq binaries to be used by ``coqc``. It is equivalent to doing export COQBIN= *directory* before launching ``coqc``. :-where: Print the location of Coq’s standard library and exit. :-config: Print the locations of Coq’s binaries, dependencies, and libraries, then exit. :-filteropts: Print the list of command line arguments that `coqtop` has recognized as options and exit. :-v: Print Coq’s version and exit. :-list-tags: Print the highlight tags known by Coq as well as their currently associated color and exit. :-h, --help: Print a short usage and exit. :-time: Output timing information for each command to standard output. :-time-file *file*: Output timing information for each command to the given file. :-profile *file*: Output :ref:`profiling` information to the given file. .. _profiling: Profiling --------- Use the `coqc` command line argument `-profile` or the environment variable `PROFILE` in `coq_makefile`, to generate profiling information in `Google trace format `. The output gives the duration and event counts for the execution of components of Coq (for instance `process` for the whole file, `command` for each command, `pretyping` for elaboration). Environment variable :ref:`COQ_PROFILE_COMPONENTS ` can be used to filter which components produce events. This may be needed to reduce the size of the generated file. The generated file can be visualized with (which can directly load the `.gz` compressed file produced by `coq_makefile`) or processed using any JSON-capable system. Events are annotated with additional information in the `args` field (either on the beginning `B` or end `E` event): - `major` and `minor` indicate how many major and minor words were allocated during the event. - `subtimes` indicates how much time was spent in sub-components and how many times each subcomponent was profiled during the event (including subcomponents which do not appear in `COQ_PROFILE_COMPONENTS`). - for the `command` event, `cmd` displays the precise location of the command and a compressed representation of it (like the `-time` header), and `line` is the start line of the command. .. _compiled-interfaces: Compiled interfaces (produced using ``-vos``) ---------------------------------------------- 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. .. warning:: Compiled interfaces should only be used for development purposes. At the end of the day, one still needs to proof check all files by producing standard ``.vo`` files. (Technically, when using ``-vos``, fewer universe constraints are collected.) Moreover, this feature is still experimental, it may be subject to change without prior notice. **Principle.** The compilation using ``coqc -vos foo.v`` produces a file called ``foo.vos``, which is similar to ``foo.vo`` except that all opaque proofs are skipped in the compilation process. The compilation using ``coqc -vok foo.v`` checks that the file ``foo.v`` correctly compiles, including all its opaque proofs. If the compilation succeeds, then the output is a file called ``foo.vok``, with empty contents. This file is only a placeholder indicating that ``foo.v`` has been successfully compiled. (This placeholder is useful for build systems such as ``make``.) When compiling a file ``bar.v`` that depends on ``foo.v`` (for example via a ``Require Foo.`` command), if the compilation command is ``coqc -vos bar.v`` or ``coqc -vok bar.v``, then the file ``foo.vos`` gets loaded (instead of ``foo.vo``). A special case is if file ``foo.vos`` exists and has empty contents, and ``foo.vo`` exists, then ``foo.vo`` is loaded. Appart from the aforementioned case where ``foo.vo`` can be loaded in place of ``foo.vos``, in general the ``.vos`` and ``.vok`` files live totally independently from the ``.vo`` files. **Dependencies generated by ``coq_makefile``.** The files ``foo.vos`` and ``foo.vok`` both depend on ``foo.v``. Furthermore, if a file ``foo.v`` requires ``bar.v``, then ``foo.vos`` and ``foo.vok`` also depend on ``bar.vos``. Note, however, that ``foo.vok`` does not depend on ``bar.vok``. Hence, as detailed further, parallel compilation of proofs is possible. In addition, ``coq_makefile`` generates for a file ``foo.v`` a target ``foo.required_vos`` which depends on the list of ``.vos`` files that ``foo.vos`` depends upon (excluding ``foo.vos`` itself). As explained next, the purpose of this target is to be able to request the minimal working state for editing interactively the file ``foo.v``. .. warning:: When writing a custom build system, be aware that ``coqdep`` only produces dependencies related to ``.vos`` and ``.vok`` if the ``-vos`` command line flag is passed. This is to maintain compatibility with dune (see `ocaml/dune#2642 on github `_). **Typical compilation of a set of file using a build system.** Assume a file ``foo.v`` that depends on two files ``f1.v`` and ``f2.v``. The command ``make foo.required_vos`` will compile ``f1.v`` and ``f2.v`` using the option ``-vos`` to skip the proofs, producing ``f1.vos`` and ``f2.vos``. At this point, one is ready to work interactively on the file ``foo.v``, even though it was never needed to compile the proofs involved in the files ``f1.v`` and ``f2.v``. Assume a set of files ``f1.v ... fn.v`` with linear dependencies. The command ``make vos`` enables compiling the statements (i.e. excluding the proofs) in all the files. Next, ``make -j vok`` enables compiling all the proofs in parallel. Thus, calling ``make -j vok`` directly enables taking advantage of a maximal amount of parallelism during the compilation of the set of files. Note that this comes at the cost of parsing and typechecking all definitions twice, once for the ``.vos`` file and once for the ``.vok`` file. However, if files contain nontrivial proofs, or if the files have many linear chains of dependencies, or if one has many cores available, compilation should be faster overall. **Need for Proof using** When a theorem is in a section, typechecking the statement of the theorem may be insufficient to deduce the type of the statement at the end of the section. For example, the proof of the theorem may make use of section variables or section hypotheses that are not mentioned in the statement of the theorem. For this reason, proofs in sections should begin with :cmd:`Proof using` instead of :cmd:`Proof`. The `using` clause should give the names of the section variables that are required for the proof that are not involved in the typechecking of the statement. See :flag:`Suggest Proof Using`. (Note it's fine to use ``Proof using.`` instead of ``Proof.`` for proofs that are not in a section.) When using ``-vos``, proofs in sections with :cmd:`Proof using` are skipped. Proofs in sections without :cmd:`Proof using` are fully processed (much slower). **Interaction with standard compilation** When compiling a file ``foo.v`` using ``coqc`` in the standard way (i.e., without ``-vos`` nor ``-vok``), an empty file ``foo.vos`` and an empty file ``foo.vok`` are created in addition to the regular output file ``foo.vo``. If ``coqc`` is subsequently invoked on some other file ``bar.v`` using option ``-vos`` or ``-vok``, and that ``bar.v`` requires ``foo.v``, if Coq finds an empty file ``foo.vos``, then it will load ``foo.vo`` instead of ``foo.vos``. The purpose of this feature is to allow users to benefit from the ``-vos`` option even if they depend on libraries that were compiled in the traditional manner (i.e., never compiled using the ``-vos`` option). .. _coqchk: Compiled libraries checker (coqchk) ---------------------------------------- The ``coqchk`` command takes a list of library paths as argument, described either by their logical name or by their physical filename, which must end in ``.vo``. The corresponding compiled libraries (``.vo`` files) are searched in the path, recursively processing the libraries they depend on. The content of all these libraries is then type checked. The effect of ``coqchk`` is only to return with normal exit code in case of success, and with positive exit code if an error has been found. Error messages are not deemed to help the user understand what is wrong. In the current version, it does not modify the compiled libraries to mark them as successfully checked. Note that non-logical information is not checked. By logical information, we mean the type and optional :term:`body` associated with names. It excludes for instance anything related to the concrete syntax of objects (customized syntax rules, association between short and long names), implicit arguments, etc. This tool can be used for several purposes. One is to check that a compiled library provided by a third-party has not been forged and that loading it cannot introduce inconsistencies [#]_. Another point is to get an even higher level of security. Since ``coqtop`` can be extended with custom tactics, possibly ill-typed code, it cannot be guaranteed that the produced compiled libraries are correct. ``coqchk`` is a standalone verifier, and thus it cannot be tainted by such malicious code. Command-line options ``-Q``, ``-R``, ``-where`` and ``-impredicative-set`` are supported by ``coqchk`` and have the same meaning as for ``coqtop``. As there is no notion of relative paths in object files ``-Q`` and ``-R`` have exactly the same meaning. :-norec *module*: Check *module* but do not check its dependencies. :-admit *module*: Do not check *module* and any of its dependencies, unless explicitly required. :-o: At exit, print a summary about the context. List the names of all assumptions and variables (constants without a :term:`body`). :-silent: Do not write progress information to the standard output. Environment variable ``$COQLIB`` can be set to override the location of the standard library. The algorithm for deciding which modules are checked or admitted is the following: assuming that ``coqchk`` is called with argument ``M``, option ``-norec N``, and ``-admit A``. Let us write :math:`\overline{S}` for the set of reflexive transitive dependencies of set :math:`S`. Then: + Modules :math:`C = \overline{M} \backslash \overline{A} \cup M \cup N` are loaded and type checked before being added to the context. + And :math:`M \cup N \backslash C` is the set of modules that are loaded and added to the context without type checking. Basic integrity checks (checksums) are nonetheless performed. As a rule of thumb, -admit can be used to tell Coq that some libraries have already been checked. So ``coqchk A B`` can be split in ``coqchk A`` && ``coqchk B -admit A`` without type checking any definition twice. Of course, the latter is slightly slower since it makes more disk access. It is also less secure since an attacker might have replaced the compiled library ``A`` after it has been read by the first command, but before it has been read by the second command. .. [#] Ill-formed non-logical information might for instance bind Coq.Init.Logic.True to short name False, so apparently False is inhabited, but using fully qualified names, Coq.Init.Logic.False will always refer to the absurd proposition, what we guarantee is that there is no proof of this latter constant. coq-8.20.0/doc/sphinx/practical-tools/coqide.rst000066400000000000000000000775161466560755400216010ustar00rootroot00000000000000.. |GtkSourceView| replace:: :smallcaps:`GtkSourceView` .. _coqintegrateddevelopmentenvironment: CoqIDE ====== .. todo: how to say that a number of things are broken? Maybe list them somewhere--doesn't have to be super detailed The Coq Integrated Development Environment (CoqIDE) is a user-friendly GUI for Coq. Its main purpose is to allow users to edit Coq scripts and step forward and backward through them. Stepping forward executes commands and tactics while stepping backward undoes previously executed commands and tactics, returning to a previous state. To run CoqIDE, enter `coqide` on the command line. If you include script file names (which end with `.v`) as arguments, each is opened in a separate tab. If you don't, CoqIDE opens a single unnamed buffer (titled `*scratch*`). `coqide` also accepts many of the options of `coqtop` (see :ref:`thecoqcommands`), while ignoring the ones that aren't meaningful for CoqIDE. Use `coqide --help` to see the list of command line options. .. _coqide_mainscreen: .. image:: ../_static/coqide.png :alt: CoqIDE main screen The screenshot shows CoqIDE as the user is stepping through the file `Fermat.v`. A menu bar and a tool bar appear at the top of the window. The left-hand panel shows the current *script buffer*. Each script buffer corresponds to a separate Coq process. The upper right panel is the *proof panel*, which shows the goals to be proven. The lower right panel has three tabs: the *Messages panel*, which shows messages produced by commands and tactics; the *Errors panel*, which shows errors detected when running in :ref:`async mode ` and the *Jobs panel,* which shows information on the worker processes used by async mode. The contents of the right-hand panels are specific to the currently-displayed script. Click the arrow icons to detach these panel into separate windows. The proof panel can be detached from the `Windows/Detach Proof` menu item. The *status bar* is a line of text that appears at the bottom of the window. Managing files and buffers, basic editing ----------------------------------------- The *File* menu lets you open files into buffers, create new buffers, save buffers to files, and print or export them in various formats. Text editing provides the basic operations such as copy, cut, paste, find and replace. Most editing operations are shown in the *Edit* menu. Keystroke equivalents (if defined) for menu items are shown on the right of each item. If you need more complex editor commands, you can launch an external text editor on the current buffer, using the *Edit/External Editor* menu. (Use `Edit/Preferences/Externals/External Editor` to specify the external text editor.) When you're done editing, you currently must reopen the file to see your changes. Also note these key bindings that are not shown in menus: - `Home` and `End` move the cursor to the beginning or end of the current line (`Cmd-Left` and `Cmd-Right` on macOS). - `Ctrl-Home` and `Ctrl-End` move the cursor to the beginning or end of the buffer (`Cmd-Up` and `Cmd-Down` on macOS). - `Ctrl-Left` and `Ctrl-Right` move the cursor to the next beginning or end of a word - `Ctrl-Delete` (`Alt-Backspace` on macOS) and `Ctrl-Backspace` delete characters from the cursor to the next beginning or end of a word. Commenting and uncommenting the current line or selected text is available in the *Tools* menu. If some text is selected, exactly that text is commented out; otherwise the line containing the cursor is commented out. To uncomment, position the cursor between `(*` and `*)` or select any text between them. Files are automatically saved periodically to a recovery file. For example, `foo.v` is saved to `#foo.v#` every 10 seconds by default. You can change the interval in the *Edit / Preferences / Files* dialog. In some cases when CoqIDE exits abruptly, it saves named buffers in ``.crashcoqide`` in the same directory as ````. Unnamed buffers are saved in ``Unnamed_coqscript_.crashcoqide`` in the directory that CoqIDE was started in. In the *View* menu, you can set several printing options that correspond to options that can appear in the script. For example, "Display notations" on the menu corresponds to the :flag:`Printing Notations` flag. You should use the menu instead of controlling these settings in your script. Running Coq scripts ------------------- Operations for running the script are available in the *Navigation* menu, from the toolbar and from the keyboard. These include: - Forward (`Alt-Down`) to run one command or tactic - Backward (`Alt-Up`) undo one command or tactic - Run to cursor (`Alt-Right`) to run commands up to the cursor - Run to end (`Alt-End`) to run commands to the end of the buffer - Reset Coq (`Alt-Home`) to restart the Coq process - Interrupt to stop processing commands after the current command completes. (Note: on Windows but not on WSL, Interrupt doesn't work if you start CoqIDE as a background process, e.g. `coqide &` in bash. See Coq issue `#16142 `_). On macOS, use `Cmd-Ctrl` instead of `Alt` for these operations. Tooltips identify the action associated with each toolbar icon. Commands may: - Complete successfully. In this case, the background of the command is marked with the "processed" color (green by default), except for :cmd:`Axiom`\s and :cmd:`Admitted`\s, which are marked in light orange to indicate they are unproven assumptions. - Complete with a warning. In this case, the warning appears in the messages panel in yellow. The background of the command is marked with the "processed" color and the text is shown in blue and underlined. The message text is available as a tooltip on the text of the command. - Fail with an error. If you're stepping through the proof line by line, the error message appears in the message panel in red and the command is shown in red and underlined with a pink background. If you're in async mode, described in more detail below, the message appears in the *errors panel*. Double click on an entry to jump to the point of the error. Execution of commands stops unless you're in async mode. In the previous figure :ref:`CoqIDE main screen `, the running buffer is `Fermat.v`. All commands until the ``Theorem`` have already been executed, then the user tried to go forward executing ``Induction n``. That command failed because no such tactic exists (names of standard tactics are written in lowercase). The failing command has been underlined. If you're not in async mode and you modify the processed part of the buffer, everything after that point is undone. Unlike in `coqtop`, you should not use :cmd:`Undo` to go backward. The other buttons on the toolbar do the following: - Save the current buffer (down arrow icon) - Close the current buffer ("X" icon) - Fully check the document (gears icon) - for async mode - Previous occurrence (left arrow icon) - find the previous occurrence of the current word (The current word is determined by the cursor position.) - Next occurrence (right arrow icon) - find the next occurrence of the current word The colored ribbon appearing across the bottom of the CoqIDE window just above the status bar represents the state of processing for the current script schematically. Blue means unprocessed, light green means successfully processed, red mean an error, light orange is used for :cmd:`Axiom` and :cmd:`Admitted` and gray for proofs awaiting their final check. Clicking on the bar moves the script cursor to the corresponding part of the script. (See the next screenshot, in the async mode section.) The left edge of the ribbon corresponds to the first command or tactic in the script and the right edge corresponds to the last command that has been passed to Coq. Currently, for very long scripts, it may take many seconds for CoqIDE to pass all the commands to the server, causing the display to jump around a lot. Perhaps this will be improved in a future release. The text at the far right hand side of the status bar (e.g. "0 / 1" gives the number of unprocessed proofs that have been sent to Coq and the number of proofs that have errors. .. _asyncmode: Asynchronous mode ----------------- Asynchronous mode uses multiple Coq processes to process proofs in parallel with proof-level granularity. This is described in detail in :ref:`asynchronousandparallelproofprocessing`. While synchronous mode stops processing at the first error it encounters, in async mode, errors only stop processing the proof the error appears in. Therefore async mode can report errors in multiple proofs without manual intervention. In addition, async mode lets the user edit failed proofs without invalidating successful proofs that appear after it in the script. The part of a failed proof between `Proof.` and `Qed.` can then be edited. Quirk: the light blue part after the error and before `Qed.` becomes editable only after you've changed the error-highlighted text or before it. .. image:: ../_static/async-mode.png :alt: Async mode In the screenshot, the proof of the failed theorem can be edited (between `Proof.` and `Qed.`) without invalidating the theorems that follow it. The modified proof can then be reprocessed using the usual navigation operations. The light blue highlight in the script indicates commands that haven't been processed. Async mode defers the final type checking step of proofs, leaving the `Qed.` marked in a slightly different shade of light blue to indicate this. To complete the final checking, click on the "gears" button on the toolbar ("Fully check the document"). Commands and templates ---------------------- The Templates menu allows using shortcuts to insert commands. This is a nice way to proceed if you're not sure of the syntax of the command you want. Moreover, from this menu you can automatically insert templates of complex commands like ``Fixpoint`` that you can conveniently fill in afterwards. Queries ------- .. image:: ../_static/coqide-queries.png :alt: CoqIDE queries A *query* is any command that does not change the current state, such as :cmd:`About`, :cmd:`Check`, :cmd:`Print`, :cmd:`Search`, etc. The *query pane* lets you run such commands interactively without modifying your script. The query pane is accessible from the *View* menu, or using the shortcut ``F2``. You can also do queries by selecting some text, then choosing an item from the *Queries* menu. The response will appear in the message panel. The image above shows the result after selecting ``Nat.mul`` in the bottom line of the script panel, then choosing ``Print`` from the ``Queries`` menu. .. todo: should names of menus be *Menu* or `Menu` or ?? not consistent Compilation ----------- The `Compile` menu offers direct commands to: + compile the current buffer + run a compilation using `make` + go to the next compilation error and + create a `Makefile` using `coq_makefile`. At the moment these are not working well. We recommend you compile from a terminal window for now. We expect to fix them soon. `Compile buffer` saves the current buffer and compiles it with `coqc` as specified in the `Externals` section of the `Edit/Preferences` dialog. Output appears in the `Messages` panel. It's mostly useful for single-file projects because it doesn't automatically recompile other files that it depends on that may have changed. `Make` and `Make makefile` run the `make` and `coqmakefile` commands shown in the `Externals` section of the `Edit/Preferences` dialog. Output appears in the `Messages` panel. If you use `_CoqProject` files, you may want to change the settings to `make -f CoqMakefile` and `coq_makefile -f _CoqProject -o CoqMakefile` as suggested in :ref:`here `. Alternatively, you may find it easier to do your `make` and `coq_makefile` commands from the command line. .. _coqide_make_note: Note that you must explicitly save changed buffers before you run `make`. `File/Save all` is helpful for this. Notice that modified and unmodified buffers show different icons next to the filename on the tab. You may find them helpful. To use the compiled files after compiling a project with the makefile, you must restart the Coq interpreter (using `Navigation/Start` in the menu or Ctrl-Home) for any buffer in which you're stepping through code that relies on the compiled files. To make changes to `_CoqProject` take effect, you must close and reopen buffers associated with files in the project. Note that each buffer is independently associated with a `_CoqProject`. The `Project` section of the Edit/Preferences` dialog specifies the name to use for the `_CoqProject` file. We recommend not changing this. Remember that these settings are done on a per-installation basis; they currently can't be set differently for each package you're developing. Customizations -------------- Preferences ~~~~~~~~~~~ You may customize your environment with the *Preferences* dialog, which is accessible from *Edit/Preferences* on the menu. There are several sections: The *Fonts* section is for selecting the text font used for scripts, goal and message panels. The *Colors* and *Tags* sections are for controlling colors and style of the three main buffers. A predefined Coq highlighting style as well 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 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 variable ``GTK_THEME`` (search the internet for the various possibilities). The *Editor* section is for customizing the editor. It includes in particular the ability to activate an Emacs mode named micro-Proof-General (use the Help menu to know more about the available bindings). The *Files* section is devoted to file management: you may configure automatic saving of files, by periodically saving the contents into files named `#f#` for each opened file `f`. You may also activate the *revert* feature: in case a opened file is modified on the disk by a third party, CoqIDE may read it again for you. Note that in the case you edited that same file, you will be prompted to choose to either discard your changes or not. The File charset encoding choice is described below in :ref:`character-encoding-saved-files`. *Project* *Appearance* The *Externals* section allows customizing the external commands for compilation, printing, web browsing. In the browser command, you may use `%s` to denote the URL to open, for example: `firefox -remote "OpenURL(%s)"`. .. _shortcuts: The *Shortcuts* section lets you change the modifiers (e.g. `Ctrl`, `Alt` and `Shift`) used in all the menu entry key bindings for the selected menu (for the View menu, only the checkbox items will be changed). Current key bindings are shown at the right side of each menu entry. If any of the new key bindings are already assigned, the existing binding will be removed. You can then rebind one of the menu entries as described in the next section. The top of the *Shortcuts* section lets you select the allowed modifiers that can be selected for the listed menus. (The changes won't appear until you close and reopen the Preferences dialog.) *Misc* .. _user-configuration-directory: Preferences and key bindings are saved in the user configuration directory, which is ``$XDG_CONFIG_HOME/coq`` if the environment variable ``$XDG_CONFIG_HOME`` is set. If the variable isn't set, the directory is ``~/.config/coq`` on Linux and `C:\\Users\\\\AppData\\Local\\coq` on Windows. Preferences are in the file "coqiderc" and key bindings are in the file "coqide.keys". .. _key_bindings: Key bindings ~~~~~~~~~~~~ Each menu item in the GUI shows its key binding, if one has been defined, on the right-hand side. Typing the key binding is equivalent to selecting the associated item from the menu. A GTK+ accelerator keymap is saved under the name ``coqide.keys`` in the :ref:`user configuration directory`. You can modify the key binding ("accelerator") for a menu entry by going to the corresponding menu item without releasing the mouse button, pressing the keys you want for the new binding and then releasing the mouse button. Alternatively, you can edit the file directly. Make sure there are no CoqIDE processes running while you edit the file. (CoqIDE creates or overwrites the file when it terminates, which may reorder the lines). The file contains lines such as: :: ; (gtk_accel_path "/Queries/About" "a") ; (gtk_accel_path "/Export/Export to" "") (gtk_accel_path "/Edit/Find Next" "F4") The first line corresponds to the menu item for the Queries/About menu item, which was bound by default to `Shift-Ctrl-A`. "" indicates `Cmd` on macOS and otherwise `Ctrl`. The second line is for a menu item that has no key binding. Lines that begin with semicolons are comments created by CoqIDE. CoqIDE uses the default binding for these items. To change a key binding, remove the semicolon and set the third item in the list as desired, such as in the third line. Avoid assigning the same binding to multiple items. If the same menu item name appears on multiple lines in the file, the value from the last line is used. This is convenient for copying a group of changes from elsewhere--just insert the changes at the end of the file. The next time CoqIDE terminates, it will resort the items. The end of `this file `_ gives the names of the keys. Modifiers (e.g. Alt, Ctrl) for some menus can be can be changed as a group from the Edit/Preferences/Shortcuts panel. See :ref:`Shortcuts`. .. todo: list common rebindings? .. todo: microPG mode? Using Unicode symbols --------------------- CoqIDE is based on GTK+ and inherits from it support for Unicode in its text panels. Consequently a large set of symbols is available for notations. Furthermore, CoqIDE conveniently provides a simple way to input Unicode characters. Displaying Unicode symbols ~~~~~~~~~~~~~~~~~~~~~~~~~~ You just need to define suitable notations as described in the chapter :ref:`syntax-extensions-and-notation-scopes`. For example, to use the mathematical symbols ∀ and ∃, you may define: .. coqtop:: in Notation "∀ x .. y , P" := (forall x, .. (forall y, P) ..) (at level 200, x binder, y binder, right associativity) : type_scope. Notation "∃ x .. y , P" := (exists x, .. (exists y, P) ..) (at level 200, x binder, y binder, right associativity) : type_scope. A small set of such notations are already defined in the Coq library which you can enable with ``Require Import Unicode.Utf8`` inside CoqIDE, or equivalently, by starting CoqIDE with ``coqide -l utf8``. However, there are some issues when using such Unicode symbols: you of course need to use a character font which supports them. In the Fonts section of the preferences, the Preview line displays some Unicode symbols, so you could figure out if the selected font is OK. Related to this, one thing you may need to do is choosing whether GTK+ should use antialiased fonts or not, by setting the environment variable `GDK_USE_XFT` to 1 or 0 respectively. .. _coqide-unicode: Bindings for input of Unicode 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`` then ``Shift+Space`` suffices to insert a ``π``. For several symbols, ASCII art is also recognized, e.g. ``\->`` for a right arrow, or ``\>=`` for a greater than or equal sign. A larger number of latex tokens are supported by default. The full list is available here: https://github.com/coq/coq/blob/master/ide/coqide/default_bindings_src.ml Custom bindings may be added, as explained further on. The mechanism is active by default, but can be turned off in the Editor section of the preferences. .. note:: It remains possible to input non-ASCII symbols using system-wide approaches independent of CoqIDE. Adding custom bindings ~~~~~~~~~~~~~~~~~~~~~~ To extend the default set of bindings, create a file named ``coqide.bindings`` in the :ref:`user configuration directory`. The file `coqide.bindings` should contain one binding per line, in the form ``\key value``, followed by an optional priority integer. (The key and value should not contain any space character.) .. example:: Here is an example configuration file: :: \par || \pi π 1 \le ≤ 1 \lambda λ 2 \lambdas λs Above, the priority number 1 on ``\pi`` indicates that the prefix ``\p`` should resolve to ``\pi``, and not to something else (e.g. ``\par``). Similarly, the above settings ensure than ``\l`` resolves to ``\le``, and that ``\la`` resolves to ``\lambda``. It can be useful to work with per-project binding files. For this purpose CoqIDE accepts a command line argument of the form ``-unicode-bindings file1,file2,...,fileN``. Each of the file tokens provided may consists of one of: - a path to a custom bindings file, - the token ``default``, which resolves to the default bindings file, - the token ``local``, which resolves to the `coqide.bindings` file stored in the :ref:`user configuration directory `. .. warning:: If a filename other than the first one includes a "~" to refer to the home directory, it won't be expanded properly. To work around that issue, one should not use comas but instead repeat the flag, in the form: ``-unicode-bindings file1 .. -unicode-bindings fileN``. .. note:: If two bindings for a same token both have the same priority value (or both have no priority value set), then the binding considered is the one from the file that comes first on the command line. .. _character-encoding-saved-files: Character encoding for saved files ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ In the Files section of the preferences, the encoding option is related to the way files are saved. If you have no need to exchange files with non-UTF-8 aware applications, it is better to choose the UTF-8 encoding, since it guarantees that your files will be read again without problems. (This is because when CoqIDE reads a file, it tries to automatically detect its character encoding.) If you choose something else than UTF-8, then missing characters will be written encoded by `\x{....}` or `\x{........}` where each dot is an hexadecimal digit: the number between braces is the hexadecimal Unicode index for the missing character. .. _coqide-debugger: Debugger -------- Version 8.15 introduces a visual debugger for |Ltac| tactics within CoqIDE. It supports setting breakpoints visually and automatically displaying the stopping point in the source code with "continue", "step over" "step in" and "step out" operations. The call stack and variable values for each stack frame are shown in a new panel. The debugger is based on the non-visual |Ltac| :ref:`debugger `. We'd like to eventually support other scripting facilities such as Ltac2. Since the visual debugger is new in 8.15, you may encounter bugs or usability issues. The behavior and user interface will evolve as the debugger is refined. There are notes on bugs and potential enhancements at the end of `this page `_. Feel free to suggest changes and improvements by opening an issue on `GitHub `_, or contact `@jfehrle` directly through email, Zulip or Discourse. Breakpoints ~~~~~~~~~~~ This screenshot shows the debugger stopped at a breakpoint in the |Ltac| tactic `my_tac`. Breakpoints are shown with a red background and the stopping point is shown with a dark blue background. `Set Ltac Debug.` enables stopping in the debugger. .. image:: ../_static/debugger.png :alt: CoqIDE Debugger .. created with: Set Ltac Debug. (* enable the debugger *) Ltac my_tac c := let con := constr:(forall a b : nat, (a + b) * c = a * c + b * c) in idtac "A"; idtac "B"; idtac "C". Goal True. my_tac 2. You can control the debugger with function and control keys. Some messages are shown in the Messages panel. You can type :ref:`debugger commands ` in that panel when it shows the debug prompt. The script is not editable while Coq is processing tactics or stopped in the debugger. When Coq is stopped in the debugger (e.g., at a breakpoint), the blue segment in the "in progress" slider at the bottom edge of the window will be stopped at the left hand edge of its range. The function keys are listed, for the moment, with one exception, in the `Debug` menu: Toggle breakpoint (F8) Position the cursor just before the first character of the tactic name in an Ltac construct, then press F8. Press again to remove the breakpoint. F8 is accepted only when all of the coqtop sessions are idle (i.e. at the debug prompt or not processing a tactic or command). Note that :term:`sentences ` containing a single built-in tactic are not Ltac constructs. A breakpoint on :n:`intros.`, for example, is ignored, while breakpoints on either tactic in :n:`intros; idtac.` work. A breakpoint on, say, :n:`my_ltac_tactic.` also works. Breakpoints on Ltac :n:`@value_tactic`\s, which compute values without changing the proof context, such as :tacn:`eval`, are ignored. You must set at least one breakpoint in order to enter the debugger. Continue (F9) Continue processing the proof. If you're not stopped in the debugger, this is equivalent to "Run to end" (Control End). Step over (Control ↓) When stopped in the debugger, execute the next tactic without stopping inside it. If the debugger reaches a breakpoint in the tactic, it will stop. This is the same key combination used for "Forward one command"—if you're stopped in the debugger then it does a "Step over" and otherwise it does a "Forward". Combining the two functions makes it easy to step through a script in a natural way when some breakpoints are set. Step in (F10) When stopped in the debugger, if next tactic is an |Ltac| tactic, stop at the first possible point in the tactic. Otherwise acts as a "step over". Step out (Shift F10) When stopped in the debugger, continue and then stop at the first possible point after exiting the current |Ltac| tactic. If the debugger reaches a breakpoint in the tactic, it will stop. Break (F11) Stops the debugger at the next possible stopping point, from which you can step or continue. (Not supported in Windows at this time.) Note that the debugger is disabled when CoqIDE is running multiple worker processes, i.e. running in async mode. Going "Forward" a single step at a time doesn't use async mode and will always enter the debugger as expected. In addition, the debugger doesn't work correctly in some cases involving editing failed proofs in asymc mode ( see `#16069 `_.) If you step through `idtac "A"; idtac "B"; idtac "C".`, you'll notice that the steps for `my_tac` are: | `idtac "A"; idtac "B"; idtac "C"` | `idtac "A"; idtac "B"` | `idtac "A"` | `idtac "B"` | `idtac "C"` which reflects the two-phase execution process for the :n:`@tactic ; @tactic` construct. Also keep in mind that |Ltac| backtracking may cause the call stack to revert to a previous state. This may cause confusion. Currently there's no special indication that this has happened. .. unfortunately not working: Note: This `Wiki page `_ describes a way to change CoqIDE key bindings. Call Stack and Variables ~~~~~~~~~~~~~~~~~~~~~~~~ The bottom panel shows the call stack and the variables defined for the selected stack frame. Stack frames normally show the name of tactic being executed, the line number and the last component of the filename without the :n:`.v` suffix. The directory part of the module name is shown when the frame is not in the toplevel script file. For example, :n:`make_rewriter:387, AllTactics (Rewriter.Rewriter)` refers to the file with the module name :n:`Rewriter.Rewriter.AllTactics`. Note: A few stack frames aren't yet displayed in this described format (e.g. those starting with :n:`???`) and may be extraneous. In some cases, the tactic name is not shown. Click on a stack frame or press the Up (↑) or Down (↓) keys to select a stack frame. Coq will jump to the associated code and display the variables for that stack frame. You can select text with the mouse and then copy it to the clipboard with Control-C. Control-A selects the entire stack. The variables panel uses a tree control to show variables defined in the selected stack frame. To see values that don't fit on a single line, click on the triangle. You can select one or more entries from the tree in the usual way by clicking, shift-clicking and control-clicking on an entry. Control-A selects all entries. Control-C copies the selected entries to the clipboard. Note: Some variable are not displayed in a useful form. For example, the value shown for :n:`tac` in a script containing :n:`let tac = ltac:(auto)` appears only as :n:``. We hope to address this soon. The :n:`DETACH` button moves the debugger panel into a separate window, which will make it easier to examine its contents. Supported use cases ~~~~~~~~~~~~~~~~~~~ There are two main use cases for the debugger. They're not very compatible. Instead of showing warning messages or forcing the user to explicitly pick one mode or another, for now it's up to the user to know the limitations and work within them. The *single file* case is running the debugger on a single *primary* script without ever stopping in other *secondary* scripts. In this case, you can edit the primary script while Coq is not running it nor stopped in the debugger. The position of breakpoints will be updated automatically as you edit the file. It's fine to run the debugger in multiple buffers--you will not be confused. The single-file case is preferable when you can use it. The *multi-file* case is when a primary script stops in a secondary script. In this case, breakpoints in the secondary script that move due to script editing may no longer match the locations in the compiled secondary script. The debugger won't stop at these breakpoints as you expect. Also, the code highlighted for stack frames in that script may be incorrect. You will need to re-compile the secondary script and then restart the primary script (Restart, `Ctrl-HOME`) to get back to a consistent state. For multi-file debugging, we suggest detaching the Messages, Proof Context and Debugger panels so they are in separate windows. To do so, click on the arrow icon next to "Messages", select "Windows / Detach Proof" from the menu and click on "DETACH" in the Debugger panel. Note that the Debugger panel is initially attached to the Script panel of the toplevel script. Also note that, for now, the "in progress" slider is accurate only when the associated toplevel script panel is visible. If a debugger instance is stopped in a secondary script, the debugger function keys are directed to the debugger instance associated with the primary script. The debugger doesn't attempt to support multiple instances stopped in the same secondary script. If you have a need to do this, run each debugger instance in a separate CoqIDE process/window. Note that if you set a breakpoint in a script that may be called by multiple debugger instances, you may inadvertently find you've gotten into unsupported territory. coq-8.20.0/doc/sphinx/practical-tools/utilities.rst000066400000000000000000001501711466560755400223350ustar00rootroot00000000000000.. _utilities: ---------------------- Building Coq Projects ---------------------- .. _configuration_basics: Coq configuration basics ------------------------ Describes the basics of Coq configuration that affect running and compiling Coq scripts. It recommends preferred ways to install Coq, manage installed packages and structure your project directories for ease of use. Installing Coq and Coq packages with opam ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ The easiest way to install Coq is with the `Coq Platform `_, which relies on the `opam package manager `_. The Coq platform installation process provides options to automatically install some of the most frequently used packages at the same time. While there's currently no guarantee that user-developed packages will compile on the current version of Coq, all packages that Coq platform installs should compile without difficulty--this is part of the Coq platform release process. Once you've installed Coq, you can search for additional user-developed packages from the `package list `_ or other opam repositories. These commands may be helpful: - `opam list "coq-*"` to see the list of available and installed packages - `opam list "coq-*" --installed` to see the list of installed packages - `opam install ` to install a package on your system. - `opam update` as needed to update the list of available packages For example, this command shows the installed packages with the package name, its version and short description:: $ opam list "coq-*" --installed coq-bignums 8.15.0 Bignums, the Coq library of arbitrary large numbers Note that packages marked `released` in the package list web page are more stable than those marked `extra-dev`. To install `extra-dev` packages, first add the `coq-extra-dev` opam repository to your local opam installation with this command:: opam repo add coq-extra-dev https://coq.inria.fr/opam/extra-dev While this is the easiest way to install packages, it is not the only way. You will then need to find the :term:`logical name` used to refer to the package in :cmd:`Require` commands. There are a couple ways to do this: - If you installed with opam, use :n:`opam show --list-files coq-bignums | head -n1` - the last component of the filename is the logical name (`Bignums`). - On Linux, :n:`ls $(coqtop -where)/user-contrib` shows the logical names of all installed user-contributed packages. You should be able to guess which one you need. - Use the :cmd:`Print LoadPath` command when running Coq, which shows the mapping from :term:`logical path`\s to directories. Again, you should be able to guess. The last two methods work even if you didn't install with opam. Perhaps in the future the package name to logical name mapping will be more readily available. Once you know the logical name of the package, use it to load compiled files from the package with the :cmd:`Require` command. A :gdef:`package` is a group of files in a top directory and its subdirectories that's installed as a unit. Packages are compiled from *projects*. These terms are virtually interchangeable. Setup for working on your own projects ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ The working and master copies of source code for your own projects should not be in the directory tree where Coq is installed. In particular, when you upgrade to a new version of Coq, any directories you created in the old version won't be copied or moved. We encourage you to use a source code control system for any non-trivial project because it makes it easy to track the history of your changes. `git `_ is the system most used by Coq projects. Typically, each project has its own git repository. For a project that has only a single file, you can create the file wherever you like and then step through it in one of the IDEs for Coq, such as :ref:`coqintegrateddevelopmentenvironment`, `ProofGeneral `_, `vsCoq `_ and `Coqtail `_. If your project has multiple files in a single directory that depend on each other through :cmd:`Require` commands, they must be compiled in an order that matches their dependencies. Scripts in `.v` files must be compiled to `.vo` files using `coqc` before they can be :cmd:`Require`\d in other files. Currently, the `.vo` file is created in the same directory as its `.v` file. For example, if B.v depends on A.v, then you should compile A.v before B.v. You can do this with :n:`coqc A.v` followed by :n:`coqc B.v`, but you may find it tedious to manage the dependencies, particularly as the number of files increases. If your project files are in multiple directories, you would also need to pass additional command-line -Q and -R parameters to your IDE. More details to manage and keep track of. Instead, by creating a `_CoqProject` file, you can automatically generate a makefile that applies the correct dependencies when it compiles your project. In addition, the IDEs find and interpret `_CoqProject` files, so project files spread over multiple directories will work seamlessly. If you're editing `dir/foo.v`, the IDEs apply settings from the `_CoqProject` file in `dir` or the closest ancestor directory. The `_CoqProject` file identifies the :term:`logical path` to associate with the directories containing your compiled files. The `_CoqProject` file is normally in the top directory of the project. Occasionally it may be useful to have additional `_CoqProject` files in subdirectories, for example in order to pass different startup parameters to Coq for particular scripts. .. _building_with_coqproject: Building a project with _CoqProject (overview) ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Note: building with `dune` is experimental. See :ref:`building_dune`. The `_CoqProject` file contains the information needed to generate a makefile for building your project. Your `_CoqProject` file should be in the top directory of your project's source tree. We recommend using the :term:`logical name` of the project as the name of the top directory. **Note:** Make sure that `_CoqProject` has no file extension. On Windows, some tools such as Notepad invisibly append `.txt` even when you ask to save the file as `_CoqProject`. Also, File Manager doesn't display file extensions. You may be better off using a command line interface and an editor such as `vi` that always show file extensions. For example, here is a minimal `_CoqProject` file for the `MyPackage` project (the logical name of the package), which includes all the ``.v`` files (and other file types) in the `theories` directory and its subdirectories:: -R theories MyPackage theories :n:`-R theories MyPackage` (see :ref:`here <-Q-option>`) declares that `theories` is a top directory of `MyPackage`. :n:`theories` on the second line declares that all `.v` files in `theories` and its subdirectories are indeed included in the project. In addition, you can list individual files, for example the two script files `theories/File1.v` and `theories/SubDir/File2.v` whose logical paths are `MyPackage.File1` and `MyPackage.SubDir.File2`:: -R theories MyPackage theories/File1.v theories/SubDir/File2.v The generated makefile only processes the specified files. You can list multiple directories if you wish. .. I think dotted names are not useful. For example, this doesn't produce usable .vo files because a.v and b.v are not in an `Abc` subdirectory:: -R . Michael.Abc a.v b.v We suggest choosing a logical name that's different from those used for commonly used packages, particularly if you plan to make your package available to others. Or you can easily do a global replace, if necessary, on the package name before it is (widely) used. After that, a name change may begin to impact a large number of users. Alas, there's currently no easy way to discover what :term:`logical name`\s have already been used. The :cmd:`Print LoadPath` command helps a bit; it shows the logical names defined in the Coq process. Then: - Generate a makefile from `_CoqProject` with :n:`coq_makefile -f _CoqProject -o CoqMakefile` and - Compile your project with :n:`make -f CoqMakefile` as needed. If you add more files to your project that are not in directories listed in `_CoqProject`, update `_CoqProject` and re-run `coq_makefile` and `make`. .. todo we should use a standard name for the makefile so IDEs can find it. Maybe you should be allowed to include "-o MAKEFILENAME" in the `_CoqProject`, maybe default to "makefile"; provide a name only if you want to use a wrapper Then mandate that the file be called simply "makefile" so IDEs can find it. We recommend checking `CoqMakefile` and `CoqMakefile.conf` into your source code control system. Also we recommend updating them with `coq_makefile` when you switch to a new version of Coq. In CoqIDE, you must explicitly save modified buffers before running `make` and restart the Coq interpreter in any buffers in which you're running code. More details :ref:`here `. See :ref:`coq_makefile` for a complete description of `coq_makefile` and the files it generates. .. todo: describe -vos option, a way to do quicker builds with some caveats .. _logical-paths-load-path: Logical paths and the load path ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Coq commands such as :cmd:`Require` identify files with :term:`logical paths` rather than file system paths so that scripts don't have to be modified to run on different computers. The :cmd:`Print LoadPath` command displays the :gdef:`load path`, which is a list of (logical path, :term:`physical path`) pairs for directories. For example, you may see:: Logical Path / Physical path: Bignums /home/jef/coq/lib/coq/user-contrib/Bignums Bignums.BigZ /home/jef/coq/lib/coq/user-contrib/Bignums/BigZ Ltac2 /home/jef/coq/lib/coq/user-contrib/Ltac2 Coq /home/jef/coq/lib/coq/theories Coq.Numbers /home/jef/coq/lib/coq/theories/Numbers Coq.Numbers.Natural /home/jef/coq/lib/coq/theories/Numbers/Natural Coq.Numbers.Natural.Binary /home/jef/coq/lib/coq/theories/Numbers/Natural/Binary Coq.Numbers.Integer /home/jef/coq/lib/coq/theories/Numbers/Integer Coq.Arith /home/jef/coq/lib/coq/theories/Arith <> /home/jef/myproj The components of each pair share suffixes, e.g. `Bignums.BigZ` and `Bignums/BigZ` or `Coq.Numbers.Natural` and `Numbers/Natural`. Physical pathnames should always use `/` rather than `\\`, even when running on Windows. Packages with a physical path containing `user-contrib` were installed with the Coq binaries (e.g. `Ltac2`), with the Coq Platform or with opam (e.g. `Bignums`) or perhaps by other means. Note that, for these entries, the entire logical path appears in the directory name. Packages that begin with `Coq` were installed with the Coq binaries. Note that the :term:`logical name` `Coq` doesn't appear in the physical path. The `<>` in the final entry represents an empty logical pathname, which permits loading files from the associated directory with just the basename of the script file, e.g. specify `Foo` to load `Foo.vo`. This entry corresponds to the current directory when Coq was started. Note that the :cmd:`Cd` command doesn't change the associated directory--you would need to restart CoqIDE. With some exceptions noted below, the :term:`load path` is generated from files loaded from the following directories and their subdirectories in the order shown. The associated logical path is determined from the filesystem path, relative to the directory, e.g. the file `Foo/Bar/script.vo` becomes `Foo.Bar.script`: - directories specified with :ref:`-R and -Q command line options <-Q-option>`, - the current directory where the Coq process was launched (without including subdirectories), - the directories listed in the `COQPATH` environment variable (separated with colons, or, on Windows, with semicolons) .. not working - the ``coq`` subdirectory for each directory listed in the ``XDG_DATA_DIRS`` environment variable (separated with colons, or, on Windows, with semicolons) - the ``${XDG_DATA_HOME}/coq/`` directory (see `XDG base directory specification `_). However, CoqIDE relies on the default setting; therefore we recommend not setting this variable. - installed packages from the `user-contrib` directory in the Coq installation, - the Coq standard library from the `theories` directory in the Coq installation (with `Coq` prepended to the logical path), .. todo: XDG* with example(s) and suggest best practices for their use .. todo: document loadpath for ml files Each directory may contain multiple `.v`/`.vo` files. For example, :n:`Require Import Coq.Numbers.Natural.Binary.NBinary` loads the file :n:`NBinary.vo` from the associated directory. Note that a short name is often sufficient in :cmd:`Require` instead of a fully qualified name. In :cmd:`Require` commands referring to the current package (if `_CoqProject` uses `-R`) or Coq's standard library can be referenced with a short name without a `From` clause provided that the logical path is unambiguous (as if they are available through `-R`). In contrast, :cmd:`Require` commands that load files from other locations such as `user-contrib` must either use an exact logical path or include a `From` clause (as if they are available through `-Q`). This is done to reduce the number of ambiguous logical paths. We encourage using `From` clauses. Note that if you use a `_CoqProject` file, the `COQPATH` environment variable is not helpful. If you use `COQPATH` without a `_CoqProject`, a file in `MyPackage/theories/SubDir/File.v` will be loaded with the logical name `MyPackage/theories/SubDir.File`, which may not be what you want. If you associate the same logical name with more than one directory, Coq looks for the `.vo` file in the most recently added path first (i.e., the one that appears earlier in the :cmd:`Print LoadPath` output). Modifying multiple interdependent projects at the same time ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ If you want to modify multiple interdependent projects simultaneously, good practice recommends that all of them should be uninstalled. Since the IDEs only apply a single `_CoqProject` file for each script, the best way to make them work properly is to temporarily edit the `_CoqProject` for each project so it includes the other uninstalled projects it depends on, then regenerate the makefile. This may make your `_CoqProject` system dependent. Such dependencies shouldn't be present in published packages. For example, if project `A` requires project `B`, add `-Q B` to the `_CoqProject` in `A`. This will override any installed version of `B` only when you're working on scripts in `A`. If you want to build all the related projects at once, you're on your own. There's currently no tooling to identify the internal dependencies between the projects (and thus the order in which to build them). .. todo I thought @herbelin added code to complain about ambiguous short names I made up some stuff below, need to check it: Installed and uninstalled packages ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ The directory structure of installed packages (i.e., in the `user-contrib` directory of the Coq installation) differs from that generally used for the project source tree. The installed directory structure omits the pathname given in the `-R` and `-Q` parameters that aren't part of the logical name of a script. For example, the `theories` pathname used in this `_CoqProject` file is omitted from the installed pathname:: -R theories MyPackage theories/File1.v theories/SubDir/File2.v `theories/File1.v` appears in the directory `user-contrib/MyPackage`and `theories/SubDir/File2.v` is in `user-contrib/MyPackage/SubDir` Use :n:`make -f CoqMakefile install` to install a project from a directory. If you try to step through scripts in installed packages (e.g. to understand the proofs therein), you may get unexpected failures for two reasons (which don't apply to scripts in the standard library, which have logical paths beginning with `Coq`): * `_CoqProject` files often have at least one `-R` parameter, while installed packages are loaded with the less-permissive `-Q` option described in the :cmd:`Require` command, which may cause a :cmd:`Require` to fail. One workaround is to create a `_CoqProject` file containing the line `-R . ` in `user-contrib/`. In this case, the `_CoqProject` doesn't need to list all the source files. * Sometimes, the `_CoqProject` file specifies options that affect the behavior of Coq, such as `-impredicative-set`. These can similarly be added in `_CoqProject` files in `user-contrib`. Another way to get around these problems is to download the source tree for the project in a new directory and compile it before stepping through its scripts. Upgrading to a new version of Coq ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ `.vo` files are specific to the version of Coq that compiled them. When you upgrade to a new version of Coq, you must recompile all the projects that you want to run in the new version. This is necessary to assure that your proofs still work in the new version. Once their projects build on the new version, most users no longer have a need to run on the old version. If, however, you want to overlap working on your project on both the old and new versions, you'll need to create separate source directories for your project for the different Coq versions. Currently the compiled `.vo` files are kept in the same directory as their corresponding `.v` file. .. todo: Making your packages available with opam .. _coq_makefile: Building a Coq project with coq_makefile (details) -------------------------------------------------- The ``coq_makefile`` tool is included with Coq and is based on generating a makefile. The majority of Coq projects are very similar: a collection of ``.v`` files and possibly some ``.ml`` ones (a Coq plugin). The main piece of metadata needed in order to build the project are the command line options to ``coqc`` (e.g. ``-R``, ``-Q``, ``-I``, see :ref:`command line options `). Collecting the list of files and options is the job of the ``_CoqProject`` file. A ``_CoqProject`` file may contain the following kinds of entries in any order, separated by whitespace: * Selected options of coqc, which are forwarded directly to it. Currently these are ``-Q``, ``-I``, ``-R`` and ``-native-compiler``. * ``-arg`` options for other options of coqc that don’t fall in the above set. * Options specific to ``coq_makefile``. Currently there are two options: ``-generate-meta-for-package`` (see below for details), and ``-docroot``. * Directory names, which include all appropriate files in the directory and its subdirectories. * Comments, started with an unquoted ``#`` and continuing to the end of the line. A simple example of a ``_CoqProject`` file follows: :: -R theories/ MyCode -arg "-w all" # include everything under "theories", e.g. foo.v and bar.v theories -I src/ # include everything under "src", e.g. baz.mlg bazaux.ml and qux_plugin.mlpack src -generate-meta-for-package my-package Lines in the form ``-arg foo`` pass the argument ``foo`` to ``coqc``: in the example, this passes the two-word option ``-w all`` (see :ref:`command line options `). You must specify a ``-R/-Q`` flag for your project so its modules are properly qualified. Omitting it will generate object files that are unusable except by experts. Projects that include plugins (i.e. `.ml` or `.mlg` OCaml source files) must have a ``META`` file, as per `findlib `_. If the project has only a single plugin, the ``META`` file can be generated automatically when the option ``-generate-meta-for-package my-package`` is given. The generated file makes the plugin available to the :cmd:`Declare ML Module` as ``my-package.plugin``. If the generated file doesn't suit your needs (for instance because it depends on some OCaml packages) or your project has multiple plugins, then create a file named ``META.my-package`` and list it in the ``_CoqProject`` file. You can use ``ocamlfind lint META.my-package`` to lint the hand written file. Typically ``my-package`` is the name of the ``OPAM`` package for your project (which conventionally starts with ``coq-``). If the project includes a ``.mlg`` file (to be pre-processed by ``coqpp``) that declares a plugin, then the given name must match the ``findlib`` plugin name, e.g. ``DECLARE PLUGIN "my-package.plugin"``. The ``-native-compiler`` option given in the ``_CoqProject`` file overrides the global one passed at configure time. CoqIDE, Proof General, VsCoq and Coqtail all understand ``_CoqProject`` files and can be used to invoke Coq with the desired options. The ``coq_makefile`` utility can be used to set up a build infrastructure for the Coq project based on makefiles. We recommend invoking ``coq_makefile`` this way: :: coq_makefile -f _CoqProject -o CoqMakefile This command generates the following files: CoqMakefile is a makefile for ``GNU Make`` with targets to build the project (e.g. generate .vo or .html files from .v or compile .ml* files) and install it in the ``user-contrib`` directory where the Coq library is installed. CoqMakefile.conf contains make variables assignments that reflect the contents of the ``_CoqProject`` file as well as the path relevant to Coq. Run ``coq_makefile --help`` for a description of command line options. The recommended approach is to invoke ``CoqMakefile`` from a standard ``Makefile`` in the following form: .. example:: :: # KNOWNTARGETS will not be passed along to CoqMakefile KNOWNTARGETS := CoqMakefile extra-stuff extra-stuff2 # KNOWNFILES will not get implicit targets from the final rule, and so # depending on them won't invoke the submake # Warning: These files get declared as PHONY, so any targets depending # on them always get rebuilt KNOWNFILES := Makefile _CoqProject .DEFAULT_GOAL := invoke-coqmakefile CoqMakefile: Makefile _CoqProject $(COQBIN)coq_makefile -f _CoqProject -o CoqMakefile invoke-coqmakefile: CoqMakefile $(MAKE) --no-print-directory -f CoqMakefile $(filter-out $(KNOWNTARGETS),$(MAKECMDGOALS)) .PHONY: invoke-coqmakefile $(KNOWNFILES) #################################################################### ## Your targets here ## #################################################################### # This should be the last rule, to handle any targets not declared above %: invoke-coqmakefile @true The advantage of a wrapper, compared to directly calling the generated ``Makefile``, is that it provides a target independent of the version of Coq to regenerate a ``Makefile`` specific to the current version of Coq. Additionally, the master ``Makefile`` can be extended with targets not specific to Coq. Including the generated makefile with an include directive is discouraged, since the contents of this file, including variable names and status of rules, may change in the future. Use the optional file ``CoqMakefile.local`` to extend ``CoqMakefile``. In particular, you can declare custom actions to run before or after the build process. Similarly you can customize the install target or even provide new targets. See :ref:`coqmakefilelocal` for extension-point documentation. Although you can use all variables defined in ``CoqMakefile`` in the *recipes* of rules that you write and in the definitions of any variables that you assign with ``=``, many variables are not available for use if you assign variable values with ``:=`` nor to define the *targets* of rules nor in top-level conditionals such as ``ifeq``. Additionally, you must use `secondary expansion `_ to make use of such variables in the prerequisites of rules. To access variables defined in ``CoqMakefile`` in rule target computation, top-level conditionals, and ``:=`` variable assignment, for example to add new dependencies to compiled outputs, use the optional file ``CoqMakefile.local-late``. See :ref:`coqmakefilelocallate` for a non-exhaustive list of variables. The extensions of files listed in ``_CoqProject`` determine how they are built. In particular: + Coq files must use the ``.v`` extension + OCaml files must use the ``.ml`` or ``.mli`` extension + OCaml files that require pre processing for syntax extensions (like ``VERNAC EXTEND``) must use the ``.mlg`` extension + In order to generate a plugin one has to list all OCaml modules (i.e. ``Baz`` for ``baz.ml``) in a ``.mlpack`` file (or ``.mllib`` file). The use of ``.mlpack`` files has to be preferred over ``.mllib`` files, since it results in a “packed” plugin: All auxiliary modules (as ``Baz`` and ``Bazaux``) are hidden inside the plugin’s "namespace" (``Qux_plugin``). This reduces the chances of begin unable to load two distinct plugins because of a clash in their auxiliary module names. .. todo: don't want "Comments" to appear in the TOC, but won't build with "+++++++" Comments ~~~~~~~~ ``#`` outside of double quotes starts a comment that continues to the end of the line. Comments are ignored. Quoting arguments to coqc +++++++++++++++++++++++++ Any string in a ``_CoqProject`` file may be enclosed in double quotes to include whitespace characters or ``#``. For example, use ``-arg "-w all"`` to pass the argument ``-w all`` to coqc. If the argument to coqc needs some quotes as well, use single-quotes inside the double-quotes. For example ``-arg "-set 'Default Goal Selector=!'"`` gets passed to coqc as ``-set 'Default Goal Selector=!'``. But note, that single-quotes in a ``_CoqProject`` file are only special characters if they appear in the string following ``-arg``. And on their own they don't quote spaces. For example ``-arg 'foo bar'`` in ``_CoqProject`` is equivalent to ``-arg foo "bar'"`` (in ``_CoqProject`` notation). ``-arg "'foo bar'"`` behaves differently and passes ``'foo bar'`` to coqc. Forbidden filenames +++++++++++++++++++ The paths of files given in a ``_CoqProject`` file may not contain any of the following characters: ``\n``, ``\t``, space, ``\``, ``'``, ``"``, ``#``, ``$``, ``%``. These characters have special meaning in Makefiles and ``coq_makefile`` doesn't support encoding them correctly. Warning: No common logical root +++++++++++++++++++++++++++++++ When a ``_CoqProject`` file contains something like ``-R theories Foo theories/Bar.v``, the ``install-doc`` target installs the documentation generated by ``coqdoc`` into ``user-contrib/Foo/``, in the folder where Coq was installed. But if the ``_CoqProject`` file contains something like: :: -R theories/Foo Foo -R theories/Bar Bar theories/Foo/Foo.v theories/Bar/Bar.v the Coq files of the project don’t have a :term:`logical path` in common and ``coq_makefile`` doesn’t know where to install the documentation. It will give a warning: "No common logical root" and generate a Makefile that installs the documentation in some folder beginning with "orphan", in the above example, it'd be ``user-contrib/orphan_Foo_Bar``. In this case, specify the ``-docroot`` option in _CoqProject to override the automatically selected logical root. .. _coqmakefilelocal: CoqMakefile.local +++++++++++++++++ The optional file ``CoqMakefile.local`` is included by the generated file ``CoqMakefile``. It can contain two kinds of directives. **Variable assignment** The variable must belong to the variables listed in the ``Parameters`` section of the generated makefile. These include: :CAMLPKGS: can be used to specify third party findlib packages, and is 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 compiler, like ``-bin-annot`` or ``-w``.... :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. :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`` :COQFLAGS: override the flags passed to ``coqc``. By default ``-q``. :COQEXTRAFLAGS: extend the flags passed to ``coqc`` :COQCHKFLAGS: override the flags passed to ``coqchk``. By default ``-silent -o``. :COQCHKEXTRAFLAGS: extend the flags passed to ``coqchk`` :COQDOCFLAGS: override the flags passed to ``coqdoc``. By default ``-interpolate -utf8``. :COQDOCEXTRAFLAGS: extend the flags passed to ``coqdoc`` :COQLIBINSTALL, COQPLUGININSTALL, COQDOCINSTALL: specify where the Coq libraries, plugins and documentation will be installed. By default a combination of ``$(DESTDIR)`` (if defined) with ``$(COQLIB)/user-contrib``, ``$(COQCORELIB)/..`` and ``$(DOCDIR)/coq/user-contrib``. Use :ref:`coqmakefilelocallate` instead to access more variables. **Rule extension** The following makefile rules can be extended. .. example:: :: pre-all:: echo "This line is print before making the all target" install-extra:: cp ThisExtraFile /there/it/goes ``pre-all::`` run before the ``all`` target. One can use this to configure the project, or initialize sub modules or check dependencies are met. ``post-all::`` run after the ``all`` target. One can use this to run a test suite, or compile extracted code. ``install-extra::`` run after ``install``. One can use this to install extra files. ``install-doc::`` One can use this to install extra doc. ``uninstall::`` \ ``uninstall-doc::`` \ ``clean::`` \ ``cleanall::`` \ ``archclean::`` \ ``merlin-hook::`` One can append lines to the generated ``.merlin`` file extending this target. .. _coqmakefilelocallate: CoqMakefile.local-late ++++++++++++++++++++++ The optional file ``CoqMakefile.local-late`` is included at the end of the generated file ``CoqMakefile``. The following is a partial list of accessible variables: :COQ_VERSION: the version of ``coqc`` being used, which can be used to provide different behavior depending on the Coq version :COQMAKEFILE_VERSION: the version of Coq used to generate the Makefile, which can be used to detect version mismatches :ALLDFILES: the list of generated dependency files, which can be used, for example, to cause ``make`` to recompute dependencies when files change by writing ``$(ALLDFILES): myfiles`` or to indicate that files must be generated before dependencies can be computed by writing ``$(ALLDFILES): | mygeneratedfiles`` :VOFILES, GLOBFILES, CMOFILES, CMXFILES, OFILES, CMAFILES, CMXAFILES, CMIFILES, CMXSFILES: lists of files that are generated by various invocations of the compilers In addition, the following variables may be useful for deciding what targets to present via ``$(shell ...)``; these variables are already accessible in recipes for rules added in ``CoqMakefile.local``, but are only accessible from top-level ``$(shell ...)`` invocations in ``CoqMakefile.local-late``: :COQC, COQDEP, COQDOC, CAMLC, CAMLOPTC: compiler binaries :COQFLAGS, CAMLFLAGS, COQLIBS, COQDEBUG, OCAMLLIBS: flags passed to the Coq or OCaml compilers Timing targets and performance testing ++++++++++++++++++++++++++++++++++++++ The generated ``Makefile`` supports the generation of three kinds of timing data: per-file build-times, per-line times for individual files, and profiling data in Google trace format for individual files. The following targets and Makefile variables allow collection of per- file timing data: + ``TIMED=1`` passing this variable will cause ``make`` to emit a line describing the user-space build-time and peak memory usage for each file built. .. note:: On ``Mac OS``, this works best if you’ve installed ``gnu-time``. .. example:: For example, the output of ``make TIMED=1`` may look like this: :: COQDEP Fast.v COQDEP Slow.v COQC Slow.v Slow.vo (user: 0.34 mem: 395448 ko) COQC Fast.v Fast.vo (user: 0.01 mem: 45184 ko) + ``pretty-timed`` this target stores the output of ``make TIMED=1`` into ``time-of-build.log``, and displays a table of the times and peak memory usages, sorted from slowest to fastest, which is also stored in ``time-of-build-pretty.log``. If you want to construct the ``log`` for targets other than the default one, you can pass them via the variable ``TGTS``, e.g., ``make pretty-timed TGTS="a.vo b.vo"``. .. note:: This target requires ``python`` to build the table. .. note:: This target will *append* to the timing log; if you want a fresh start, you must remove the file ``time-of-build.log`` or ``run make cleanall``. .. note:: By default the table displays user times. If the build log contains real times (which it does by default), passing ``TIMING_REAL=1`` to ``make pretty-timed`` will use real times rather than user times in the table. .. note:: Passing ``TIMING_INCLUDE_MEM=0`` to ``make`` will result in the tables not including peak memory usage information. Passing ``TIMING_SORT_BY_MEM=1`` to ``make`` will result in the tables be sorted by peak memory usage rather than by the time taken. .. example:: For example, the output of ``make pretty-timed`` may look like this: :: COQDEP VFILES COQC Slow.v Slow.vo (real: 0.52, user: 0.39, sys: 0.12, mem: 394648 ko) COQC Fast.v Fast.vo (real: 0.06, user: 0.02, sys: 0.03, mem: 56980 ko) Time | Peak Mem | File Name -------------------------------------------- 0m00.41s | 394648 ko | Total Time / Peak Mem -------------------------------------------- 0m00.39s | 394648 ko | Slow.vo 0m00.02s | 56980 ko | Fast.vo + ``print-pretty-timed-diff`` this target builds a table of timing changes between two compilations; run ``make make-pretty-timed-before`` to build the log of the “before” times, and run ``make make-pretty-timed-after`` to build the log of the “after” times. The table is printed on the command line, and stored in ``time-of-build-both.log``. This target is most useful for profiling the difference between two commits in a repository. .. note:: This target requires ``python`` to build the table. .. note:: The ``make-pretty-timed-before`` and ``make-pretty-timed-after`` targets will *append* to the timing log; if you want a fresh start, you must remove the files ``time-of-build-before.log`` and ``time-of-build-after.log`` or run ``make cleanall`` *before* building either the “before” or “after” targets. .. note:: The table will be sorted first by absolute time differences rounded towards zero to a whole-number of seconds, then by times in the “after” column, and finally lexicographically by file name. This will put the biggest changes in either direction first, and will prefer sorting by build-time over subsecond changes in build time (which are frequently noise); lexicographic sorting forces an order on files which take effectively no time to compile. If you prefer a different sorting order, you can pass ``TIMING_SORT_BY=absolute`` to sort by the total time taken, or ``TIMING_SORT_BY=diff`` to sort by the signed difference in time. .. note:: Just like ``pretty-timed``, this table defaults to using user times. Pass ``TIMING_REAL=1`` to ``make`` on the command line to show real times instead. .. note:: Just like ``pretty-timed``, passing ``TIMING_INCLUDE_MEM=0`` to ``make`` will result in the tables not including peak memory usage information. Passing ``TIMING_SORT_BY_MEM=1`` to ``make`` will result in the tables be sorted by peak memory usage rather than by the time taken. .. example:: For example, the output table from ``make print-pretty-timed-diff`` may look like this: :: After | Peak Mem | File Name | Before | Peak Mem || Change || Change (mem) | % Change | % Change (mem) ----------------------------------------------------------------------------------------------------------------------------- 0m00.43s | 394700 ko | Total Time / Peak Mem | 0m00.41s | 394648 ko || +0m00.01s || 52 ko | +4.87% | +0.01% ----------------------------------------------------------------------------------------------------------------------------- 0m00.39s | 394700 ko | Fast.vo | 0m00.02s | 56980 ko || +0m00.37s || 337720 ko | +1850.00% | +592.69% 0m00.04s | 56772 ko | Slow.vo | 0m00.39s | 394648 ko || -0m00.35s || -337876 ko | -89.74% | -85.61% The following targets and ``Makefile`` variables allow collection of per- line timing data: + ``TIMING=1`` passing this variable will cause ``make`` to use ``coqc -time-file`` to write to a ``.v.timing`` file for each ``.v`` file compiled, which contains line-by-line timing information. .. example:: For example, running ``make all TIMING=1`` may result in a file like this: :: Chars 0 - 26 [Require~Coq.ZArith.BinInt.] 0.157 secs (0.128u,0.028s) Chars 27 - 68 [Declare~Reduction~comp~:=~vm_c...] 0. secs (0.u,0.s) Chars 69 - 162 [Definition~foo0~:=~Eval~comp~i...] 0.153 secs (0.136u,0.019s) Chars 163 - 208 [Definition~foo1~:=~Eval~comp~i...] 0.239 secs (0.236u,0.s) + ``coqtimelog2html`` :: coqtimelog2html file.v file.v.time1 [file.v.time2 [file.v.time3]] > file.v.html this command produces a HTML file displaying the original `file.v` with highlights for each command indicating how much time the command used according to the given timing files. It supports between 1 and 3 timing files. There is currently no `coq_makefile` target that automatically invokes this tool. + ``print-pretty-single-time-diff`` :: print-pretty-single-time-diff AFTER=path/to/file.v.after-timing BEFORE=path/to/file.v.before-timing this target will make a sorted table of the per-line timing differences between the timing logs in the ``BEFORE`` and ``AFTER`` files, display it, and save it to the file specified by the ``TIME_OF_PRETTY_BUILD_FILE`` variable, which defaults to ``time-of-build-pretty.log``. To generate the ``.v.before-timing`` or ``.v.after-timing`` files, you should pass ``TIMING=before`` or ``TIMING=after`` rather than ``TIMING=1``. .. note:: The sorting used here is the same as in the ``print-pretty-timed-diff`` target. .. note:: This target requires python to build the table. .. note:: This target follows the same sorting order as the ``print-pretty-timed-diff`` target, and supports the same options for the ``TIMING_SORT_BY`` variable. .. note:: By default, two lines are only considered the same if the character offsets and initial code strings are identical. Passing ``TIMING_FUZZ=N`` relaxes this constraint by allowing the character locations to differ by up to ``N``, as long as the total number of characters and initial code strings continue to match. This is useful when there are small changes to a file, and you want to match later lines that have not changed even though the character offsets have changed. .. note:: By default the table picks up real times, under the assumption that when comparing line-by-line, the real time is a more accurate representation as it includes disk time and time spent in the native compiler. Passing ``TIMING_REAL=0`` to ``make`` will use user times rather than real times in the table. .. example:: For example, running ``print-pretty-single-time-diff`` might give a table like this: :: After | Code | Before || Change | % Change --------------------------------------------------------------------------------------------------- 0m00.50s | Total | 0m04.17s || -0m03.66s | -87.96% --------------------------------------------------------------------------------------------------- 0m00.145s | Chars 069 - 162 [Definition~foo0~:=~Eval~comp~i...] | 0m00.192s || -0m00.04s | -24.47% 0m00.126s | Chars 000 - 026 [Require~Coq.ZArith.BinInt.] | 0m00.143s || -0m00.01s | -11.88% N/A | Chars 027 - 068 [Declare~Reduction~comp~:=~nati...] | 0m00.s || +0m00.00s | N/A 0m00.s | Chars 027 - 068 [Declare~Reduction~comp~:=~vm_c...] | N/A || +0m00.00s | N/A 0m00.231s | Chars 163 - 208 [Definition~foo1~:=~Eval~comp~i...] | 0m03.836s || -0m03.60s | -93.97% + ``all.timing.diff``, ``path/to/file.v.timing.diff`` The ``path/to/file.v.timing.diff`` target will make a ``.v.timing.diff`` file for the corresponding ``.v`` file, with a table as would be generated by the ``print-pretty-single-time-diff`` target; it depends on having already made the corresponding ``.v.before-timing`` and ``.v.after-timing`` files, which can be made by passing ``TIMING=before`` and ``TIMING=after``. The ``all.timing.diff`` target will make such timing difference files for all of the ``.v`` files that the ``Makefile`` knows about. It will fail if some ``.v.before-timing`` or ``.v.after-timing`` files don’t exist. .. note:: This target requires python to build the table. + ``PROFILE=1`` passing this variable or setting it in the environment will cause ``make`` to use ``coqc -profile`` to write to a ``.v.prof.json`` file for each ``.v`` file compiled, which contains :ref:`profiling` information. The ``.v.prof.json`` is then compressed by ``gzip`` to a ``.v.prof.json.gz``. Building a subset of the targets with ``-j`` ++++++++++++++++++++++++++++++++++++++++++++ To build, say, two targets foo.vo and bar.vo in parallel one can use ``make only TGTS="foo.vo bar.vo" -j`` or ``make foo.vo bar.vo``. Precompiling for ``native_compute`` +++++++++++++++++++++++++++++++++++ To compile files for ``native_compute``, one can use the ``-native-compiler yes`` option of Coq, by putting it in the ``_CoqProject`` file. The generated installation target of ``CoqMakefile`` will then take care of installing the extra ``.coq-native`` directories. .. note:: As an alternative to modifying ``_CoqProject``, one can set an environment variable when calling ``make``: :: COQEXTRAFLAGS="-native-compiler yes" make This can be useful when files cannot be modified, for instance when installing via OPAM a package built with ``coq_makefile``: :: COQEXTRAFLAGS="-native-compiler yes" opam install coq-package .. note:: This requires all dependencies to be themselves compiled with ``-native-compiler yes``. The grammar of _CoqProject ++++++++++++++++++++++++++ A ``_CoqProject`` file encodes a list of strings using the following syntax: .. prodn:: CoqProject ::= {* {| @blank | @comment | @quoted_string | @unquoted_string } } blank ::= {| space | horizontal_tab | newline } comment ::= # {* comment_char } newline quoted_string ::= " {* quoted_char } " unquoted_string ::= string_start_char {* unquoted_char } where the following definitions apply: * :n:`space`, :n:`horizontal_tab` and :n:`newline` stand for the corresponding ASCII characters. * :n:`comment_char` is the set of all characters except :n:`newline`. * :n:`quoted_char` is the set of all characters except ``"``. * :n:`string_start_char` is the set of all characters except those that match :n:`@blank`, or are ``"`` or ``#``. * :n:`unquoted_char` is the set of all characters except those that match :n:`@blank` or are ``#``. The parser produces a list of strings in the same order as they were encountered in ``_CoqProject``. Blanks and comments are removed and the double quotes of :n:`@quoted_string` tokens are removed as well. The list is then treated as a list of command-line arguments of ``coq_makefile``. The semantics of ``-arg`` are as follows: the string given as argument is split on whitespace, but single quotes prevent splitting. The resulting list of strings is then passed to coqc. The current approach has a few limitations: Double quotes in a ``_CoqProject`` file are only special characters at the start of a string. For lack of an escaping mechanism, it is currently impossible to pass the following kinds of strings to ``coq_makefile`` using a ``_CoqProject`` file: * strings starting with ``"`` * strings starting with ``#`` and containing ``"`` * strings containing both whitespace and ``"`` In addition, it is impossible to pass strings containing ``'`` to coqc via ``-arg``. .. _building_dune: Building a Coq project with Dune -------------------------------- Dune, the standard OCaml build tool, has supported building Coq libraries since version 1.9. .. note:: Dune's Coq support is still experimental; we strongly recommend using Dune 3.2 or later. .. note:: The canonical documentation for the Coq Dune extension is maintained upstream; please refer to the `Dune manual `_ for up-to-date information. The documentation below is up to date for Dune 3.2 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.3" of the Coq Dune language, Coq library stanzas look like: .. code:: scheme (coq.theory (name ) (package ) (synopsis ) (modules ) (libraries ) (flags )) This stanza will build all `.v` files in the given directory, wrapping the library under ````. If you declare an ````, an ``.install`` file for the library will be generated; the optional ``(modules )`` field allows you to filter the list of modules, and ``(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 .. code:: scheme (include_subdirs qualified) to your ``dune`` file. Once your project is set up, `dune build` will generate the `pkg.install` files and all the files necessary for the installation of your project. Note that projects using Dune to build need to use the compatibility syntax for `Declare ML Module`, see example below: .. example:: A typical stanza for a Coq plugin is split into two parts. An OCaml build directive, which is standard Dune: .. code:: scheme (library (name equations_plugin) (public_name equations.plugin) (flags :standard -warn-error -3-9-27-32-33-50) (libraries coq.plugins.cc coq.plugins.extraction)) (coq.pp (modules g_equations)) And a Coq-specific part that depends on it via the ``libraries`` field: .. code:: scheme (coq.theory (name Equations) ; -R flag (package equations) (synopsis "Equations Plugin") (libraries coq.plugins.extraction equations.plugin) (modules :standard \ IdDec NoCycle)) ; exclude some modules that don't build (include_subdirs qualified) For now, each ``.v`` file that loads the plugin must use the following special syntax on its `Declare ML Module` command for compatibility with current Dune versions (as of Coq 8.16): .. code:: coq Declare ML Module "equations_plugin:equations.plugin". .. _coqdep: coqdep: Computing Module dependencies ------------------------------------- In order to compute module dependencies (to be used by ``make`` or ``dune``), Coq provides the ``coqdep`` tool. ``coqdep`` computes inter-module dependencies for Coq programs, and prints the dependencies on the standard output in a format readable by make. When a directory is given as argument, it is recursively looked at. Dependencies of Coq modules are computed by looking at :cmd:`Require` and :cmd:`Declare ML Module` commands. 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. .. _coqnative: Split compilation of native computation files --------------------------------------------- Coq features a :tacn:`native_compute` tactic to provide fast computation in the kernel. This process performs compilation of Coq terms to OCaml programs using the OCaml compiler, which may cause an important overhead. Hence native compilation is an opt-in configure flag. When native compilation is activated, Coq generates the compiled files upfront, i.e. during the ``coqc`` invocation on the corresponding ``.v`` file. This is impractical because it means one must chose in advance whether they will use a native-capable Coq installation. In particular, activating native compilation forces the recompilation of the whole Coq installation. See :ref:`command line options ` for more details. Starting from Coq 8.14, a new binary ``coqnative`` is available. It allows performing split native compilation by generating the native compute files out of the compiled ``.vo`` file rather than out of the source ``.v`` file. The ``coqnative`` command takes a name *file.vo* as argument and tries to perform native compilation on it. It assumes that the Coq libraries on which *file.vo* depends have been first compiled to their native files, and will fail otherwise. It accepts the ``-R``, ``-Q``, ``-I`` and ``-nI`` arguments with the same semantics as if the native compilation process had been performed through ``coqc``. In particular, it means that: + ``-R`` and ``-Q`` are equivalent + ``-I`` is a no-op that is accepted only for scripting convenience Using Coq as a library ------------------------ It is possible to build custom Coq executables - for example for better debugging or custom static linking. The preferred method is to use ``dune``: :: (executable (name my_toplevel) (libraries coq-core.toplevel)) in a directory with `my_toplevel.ml` containing the main loop entry point `Coqc.main()` or `Coqtop.(start_coq coqtop_toplevel)` (depending on if you want `coqc` or `coqtop` behaviour). For example, to statically link |Ltac|, you can do: :: (executable (name my_toplevel) (libraries coq-core.toplevel coq-core.plugins.ltac)) and similarly for other plugins. 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 with the corresponding answers of the system. We provide a mechanical way to process such Coq phrases embedded in |Latex| files: the ``coq-tex`` filter. This filter extracts Coq phrases embedded in |Latex| files, 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. 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 details. Man pages --------- There are man pages for the commands ``coqdep`` and ``coq-tex``. Man pages are installed at installation time (see installation instructions in file ``INSTALL``, step 6). coq-8.20.0/doc/sphinx/proof-engine/000077500000000000000000000000001466560755400170535ustar00rootroot00000000000000coq-8.20.0/doc/sphinx/proof-engine/ltac.rst000066400000000000000000002543031466560755400205370ustar00rootroot00000000000000.. _ltac: Ltac ==== .. note:: Writing automation using Ltac is discouraged. Many alternatives are available as part of the Coq standard library or the `Coq Platform `_, and some demonstration of their respective power is performed in the `metaprogramming Rosetta stone project `_. The official alternative to Ltac is :ref:`ltac2`. While Ltac is not going away anytime soon, we would like to strongly encourage users to use Ltac2 (or other alternatives) instead of Ltac for new projects and new automation code in existing projects. Reports about hindrances in using Ltac2 for writing automation are welcome as issues on the `Coq bug tracker `_ or as discussions on the `Ltac2 Zulip stream `_. 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 since the paper was written.) .. example:: Basic tactic macros Here are some examples of simple tactic macros you can create with |Ltac|: .. coqdoc:: Ltac reduce_and_try_to_solve := simpl; intros; auto. Ltac destruct_bool_and_rewrite b H1 H2 := destruct b; [ rewrite H1; eauto | rewrite H2; eauto ]. See Section :ref:`ltac-examples` for more advanced examples. .. _ltac_defects: Defects ------- 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 - lacks expressivity (data structures, combinators, types, ...) - is slow - is error-prone and fragile - has an intricate implementation Following the need of users who are developing huge projects relying critically on Ltac, we believe that we should offer a proper modern language that features at least the following: - at least informal, predictable semantics - a type system - standard programming facilities (e.g., datatypes) This new language, called Ltac2, is described in the :ref:`ltac2` chapter. We encourage users to start testing it, especially wherever an advanced tactic language is needed. .. _ltac-syntax: Syntax ------ The syntax of the tactic language is given below. The main entry of the grammar is :n:`@ltac_expr`, which is used in proof mode as well as to define new tactics with the :cmd:`Ltac` command. The grammar uses multiple :n:`ltac_expr*` nonterminals to express how subexpressions are grouped when they're not fully parenthesized. For example, in many programming languages, `a*b+c` is interpreted as `(a*b)+c` because `*` has higher precedence than `+`. Usually `a/b/c` is given the :gdef:`left associative` 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` 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 in turn have higher precedence than `;`, which is part of :token:`ltac_expr4`. (A *lower* number in the nonterminal name means *higher* precedence in this grammar.) The constructs in :token:`ltac_expr` are :term:`left associative`. .. insertprodn ltac_expr tactic_atom .. prodn:: ltac_expr ::= @ltac_expr4 ltac_expr4 ::= @ltac_expr3 ; @ltac_expr3 | @ltac_expr3 ; [ @for_each_goal ] | @ltac_expr3 ltac_expr3 ::= @l3_tactic | @ltac_expr2 ltac_expr2 ::= @ltac_expr1 + @ltac_expr2 | @ltac_expr1 %|| @ltac_expr2 | @l2_tactic | @ltac_expr1 ltac_expr1 ::= @tactic_value | @qualid {+ @tactic_arg } | @l1_tactic | @ltac_expr0 tactic_value ::= {| @value_tactic | @syn_value } tactic_arg ::= @tactic_value | @term | () ltac_expr0 ::= ( @ltac_expr ) | [> @for_each_goal ] | @tactic_atom tactic_atom ::= @integer | @qualid | () .. todo For the moment, I've left the language constructs like +, || and ; unchanged in the grammar. Not sure what to do with them. If we just make these indirections I think the grammar no longer gives you an overall idea of the concrete grammar without following the hyperlinks for many terms--not so easy (e.g. I have a construct and I want to figure out which productions generate it so I can read about them). We should think about eventually having a cheat sheet for the constructs, perhaps as part of the chapter introduction (use case: I know there's a construct but I can't remember its syntax). They do show up in the index but they're not so easy to find. I had thought a little about putting an ltac expression cheat sheet at the top of the tactics index. Unconventional, but people would see it and remember how to find it. OTOH, as you rightly note, they are not really tactics. Looking for better ideas that we are OK with. .. note:: Tactics described in other chapters of the documentation are :production:`simple_tactic`\s, which only modify the proof state. |Ltac| provides additional constructs that can generally be used wherever a :token:`simple_tactic` can appear, even though they don't modify the proof state and that syntactically they're at varying levels in :token:`ltac_expr`. For simplicity of presentation, the |Ltac| constructs are documented as tactics. Tactics are grouped as follows: - :production:`l3_tactic`\s include |Ltac| tactics: :tacn:`try`, :tacn:`do`, :tacn:`repeat`, :tacn:`timeout`, :tacn:`time`, :tacn:`progress`, :tacn:`once`, :tacn:`exactly_once`, :tacn:`only` and :tacn:`abstract` - :production:`l2_tactic`\s are: :tacn:`tryif` - :production:`l1_tactic`\s are: :tacn:`fun` and :tacn:`let`, the :token:`simple_tactic`\s, :tacn:`first`, :tacn:`solve`, :tacn:`idtac`, :tacn:`fail` and :tacn:`gfail` as well as :tacn:`match`, :tacn:`match goal` and their :n:`lazymatch` and :n:`multimatch` variants. - :production:`value_tactic`\s, which return values rather than change the proof state. They are: :tacn:`eval`, :tacn:`context`, :tacn:`numgoals`, :tacn:`fresh`, :tacn:`type of` and :tacn:`type_term`. The documentation for these |Ltac| constructs mentions which group they belong to. The difference is only relevant in some compound tactics where extra parentheses may be needed. For example, parentheses are required in :n:`idtac + (once idtac)` because :tacn:`once` is an :token:`l3_tactic`, which the production :n:`@ltac_expr2 ::= @ltac_expr1 + @ltac_expr2` doesn't accept after the `+`. .. note:: - The grammar reserves the token ``||``. .. todo For the compound tactics, review all the descriptions of evaluation vs application, backtracking, etc. to get the language consistent and simple (refactoring so the common elements are described in one place) Values ------ An |Ltac| value can be an integer, string, unit (written as "`()`" ), syntactic value or tactic. Syntactic values correspond to certain nonterminal symbols in the grammar, each of which is a distinct type of value. Most commonly, the value of an |Ltac| expression is a tactic that can be executed. While there are a number of constructs that let you combine multiple tactics into compound tactics, there are no operations for combining most other types of values. For example, there's no function to add two integers. Syntactic values are entered with the :token:`syn_value` construct. Values of all types can be assigned to toplevel symbols with the :cmd:`Ltac` command or to local symbols with the :tacn:`let` tactic. |Ltac| :tacn:`functions` can return values of any type. Syntactic values ~~~~~~~~~~~~~~~~ .. insertprodn syn_value syn_value .. prodn:: syn_value ::= @ident : ( @nonterminal ) Provides a way to use the syntax and semantics of a grammar nonterminal as a value in an :token:`ltac_expr`. The table below describes the most useful of these. You can see the others by running ":cmd:`Print Grammar` `tactic`" and examining the part at the end under "Entry tactic:tactic_value". :token:`ident` name of a grammar nonterminal listed in the table :production:`nonterminal` represents syntax described by :token:`nonterminal`. .. list-table:: :header-rows: 1 * - Specified :token:`ident` - Parsed as - Interpreted as - as in tactic * - ``ident`` - :token:`ident` - a user-specified name - :tacn:`intro` * - ``string`` - :token:`string` - a string - * - ``integer`` - :token:`integer` - an integer - * - ``reference`` - :token:`qualid` - a qualified identifier - * - ``uconstr`` - :token:`term` - an untyped term - :tacn:`refine` * - ``constr`` - :token:`term` - a term - :tacn:`exact` * - ``ltac`` - :token:`ltac_expr` - a tactic - :n:`ltac:(@ltac_expr)` can be used to indicate that the parenthesized item should be interpreted as a tactic and not as a term. The constructs can also be used to pass parameters to tactics written in OCaml. (While all of the :token:`syn_value`\s can appear at the beginning of an :token:`ltac_expr`, the others are not useful because they will not evaluate to tactics.) :n:`uconstr:(@term)` can be used to build untyped terms. Terms built in |Ltac| are well-typed by default. Building large terms in recursive |Ltac| functions may give very slow behavior because terms must be fully type checked at each step. In this case, using an untyped term may avoid most of the repetitive type checking for the term, improving performance. .. todo above: maybe elaborate on "well-typed by default" see https://github.com/coq/coq/pull/12103#discussion_r436317558 Untyped terms built using :n:`uconstr:(…)` can be used as arguments to the :tacn:`refine` tactic, for example. In that case the untyped term is type checked against the conclusion of the goal, and the holes which are not solved by the typing procedure are turned into new subgoals. Substitution ~~~~~~~~~~~~ .. todo next paragraph: we need a better discussion of substitution. Looks like that also applies to binder_tactics in some form. See https://github.com/coq/coq/pull/12103#discussion_r422105218 :token:`name`\s within |Ltac| expressions are used to represent both terms and |Ltac| variables. If the :token:`name` corresponds to an |Ltac| variable or tactic name, |Ltac| substitutes the value before applying the expression. Generally it's best to choose distinctive names for |Ltac| variables that won't clash with term names. You can use :n:`ltac:(@name)` or :n:`(@name)` to control whether a :token:`name` is interpreted as, respectively, an |Ltac| variable or a term. Note that values from toplevel symbols, unlike locally-defined symbols, are substituted only when they appear at the beginning of an :token:`ltac_expr` or as a :token:`tactic_arg`. Local symbols are also substituted into tactics: .. example:: Substitution of global and local symbols .. coqtop:: reset none Goal True. .. coqtop:: all Ltac n := 1. let n2 := n in idtac n2. Fail idtac n. Local definitions: let ~~~~~~~~~~~~~~~~~~~~~~ .. tacn:: let {? rec } @let_clause {* with @let_clause } in @ltac_expr .. insertprodn let_clause let_clause .. prodn:: let_clause ::= @name := @ltac_expr | @ident {+ @name } := @ltac_expr Binds symbols within :token:`ltac_expr`. :tacn:`let` evaluates each :n:`@let_clause`, substitutes the bound variables into :n:`@ltac_expr` and then evaluates :n:`@ltac_expr`. There are no dependencies between the :n:`@let_clause`\s. Use :tacn:`let` `rec` to create recursive or mutually recursive bindings, which causes the definitions to be evaluated lazily. :tacn:`let` is a :token:`l1_tactic`. Function construction and application ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ A parameterized tactic can be built anonymously (without resorting to local definitions) with: .. tacn:: fun {+ @name } => @ltac_expr Indeed, local definitions of functions are syntactic sugar for binding a :n:`fun` tactic to an identifier. :tacn:`fun` is a :token:`l1_tactic`. Functions can return values of any type. A function application is an expression of the form: .. tacn:: @qualid {+ @tactic_arg } :n:`@qualid` must be bound to a |Ltac| function with at least as many arguments as the provided :n:`@tactic_arg`\s. The :n:`@tactic_arg`\s are evaluated before the function is applied or partially applied. Functions may be defined with the :tacn:`fun` and :tacn:`let` tactics and with the :cmd:`Ltac` command. .. todo above: note "gobble" corner case https://github.com/coq/coq/pull/12103#discussion_r436414417 Tactics in terms ~~~~~~~~~~~~~~~~ .. insertprodn term_ltac term_ltac .. prodn:: term_ltac ::= ltac : ( @ltac_expr ) Allows including an :token:`ltac_expr` within a term. Semantically, it's the same as the :token:`syn_value` for `ltac`, but these are distinct in the grammar. .. _goal-selectors: Goal selectors -------------- .. todo: mention this applies to Print commands and the Info command By default, tactic expressions are applied only to the first goal. Goal selectors provide a way to apply a tactic expression to another goal or multiple goals. (The :opt:`Default Goal Selector` option can be used to change the default behavior.) .. tacn:: @toplevel_selector : @ltac_expr :name: … : … (goal selector) .. insertprodn toplevel_selector toplevel_selector .. prodn:: toplevel_selector ::= @goal_selector | all | ! | par Reorders the goals and applies :token:`ltac_expr` to the selected goals. It can only be used at the top level of a tactic expression; it cannot be used within a tactic expression. The selected goals are reordered so they appear after the lowest-numbered selected goal, ordered by goal number. :ref:`Example `. If the selector applies to a single goal or to all goals, the reordering will not be apparent. The order of the goals in the :token:`goal_selector` is irrelevant. (This may not be what you expect; see `#8481 `_.) .. todo why shouldn't "all" and "!" be accepted anywhere a @goal_selector is accepted? It would be simpler to explain. `all` Selects all focused goals. `!` If exactly one goal is in focus, apply :token:`ltac_expr` to it. Otherwise the tactic fails. `par` Applies :n:`@ltac_expr` to all focused goals in parallel. The number of workers can be controlled via the command line option :n:`-async-proofs-tac-j @natural` to specify the desired number of workers. In the special case where :n:`@natural` is 0, this completely prevents Coq from spawning any new process, and `par` blocks are treated as a variant of `all` that additionally checks that each subgoal is solved. Limitations: ``par:`` only works on goals that don't contain existential variables. :n:`@ltac_expr` must either solve the goal completely or do nothing (i.e. it cannot make some progress). Selectors can also be used nested within a tactic expression with the :tacn:`only` tactic: .. tacn:: only @goal_selector : @ltac_expr3 .. insertprodn goal_selector range_selector .. prodn:: goal_selector ::= {+, @range_selector } | [ @ident ] range_selector ::= @natural | @natural - @natural Applies :token:`ltac_expr3` to the selected goals. (At the beginning of a sentence, use the form :n:`@goal_selector: @tactic` rather than :n:`only @goal_selector: @tactic`. In the latter, the :opt:`Default Goal Selector` (by default set to :n:`1:`) is applied before :n:`only` is interpreted. This is probably not what you want.) :tacn:`only` is an :token:`l3_tactic`. :n:`{+, @range_selector }` The selected goals are the union of the specified :token:`range_selector`\s. :n:`[ @ident ]` Limits the application of :token:`ltac_expr3` to the goal previously named :token:`ident` by the user (see :ref:`existential-variables`). This works even when the goal is not in focus. :n:`@natural` Selects a single goal. :n:`@natural__1 - @natural__2` Selects the goals :n:`@natural__1` through :n:`@natural__2`, inclusive. .. exn:: No such goal. :name: No such goal. (Goal selector) :undocumented: .. _reordering_goals_ex: .. example:: Selector reordering goals .. coqtop:: reset in Goal 1=0 /\ 2=0 /\ 3=0. .. coqtop:: all repeat split. 1,3: idtac. .. TODO change error message index entry Processing multiple goals ------------------------- When presented with multiple focused goals, most |Ltac| constructs process each goal separately. They succeed only if there is a success for each goal. For example: .. example:: Multiple focused goals This tactic fails because there no match for the second goal (`False`). .. coqtop:: reset none fail Goal True /\ False. .. coqtop:: out split. .. coqtop:: all Fail all: let n := numgoals in idtac "numgoals =" n; match goal with | |- True => idtac end. .. _branching_and_backtracking: Branching and backtracking -------------------------- |Ltac| provides several :gdef:`branching` tactics that permit trying multiple alternative tactics for a proof step. For example, :tacn:`first`, which tries several alternatives and selects the first that succeeds, or :tacn:`tryif`, which tests whether a given tactic would succeed or fail if it was applied and then, depending on the result, applies one of two alternative tactics. There are also looping constructs :tacn:`do` and :tacn:`repeat`. The order in which the subparts of these tactics are evaluated is generally similar to structured programming constructs in many languages. The :tacn:`+<+ (backtracking branching)>`, :tacn:`multimatch` and :tacn:`multimatch goal` tactics provide more complex capability. Rather than applying a single successful tactic, these tactics generate a series of successful tactic alternatives that are tried sequentially when subsequent tactics outside these constructs fail. For example: .. example:: Backtracking .. coqtop:: all Fail multimatch True with | True => idtac "branch 1" | _ => idtac "branch 2" end ; idtac "branch A"; fail. These constructs are evaluated using :gdef:`backtracking`. Each creates a :gdef:`backtracking point`. When a subsequent tactic fails, evaluation continues from the nearest prior backtracking point with the next successful alternative and repeats the tactics after the backtracking point. When a backtracking point has no more successful alternatives, evaluation continues from the next prior backtracking point. If there are no more prior backtracking points, the overall tactic fails. Thus, backtracking tactics can have multiple successes. Non-backtracking constructs that appear after a backtracking point are reprocessed after backtracking, as in the example above, in which the :tacn:`;` construct is reprocessed after backtracking. When a backtracking construct is within a non-backtracking construct, the latter uses the :gdef:`first success`. Backtracking to a point within a non-backtracking construct won't change the branch that was selected by the non-backtracking construct. The :tacn:`once` tactic stops further backtracking to backtracking points within that tactic. Control flow ------------ Sequence: ; ~~~~~~~~~~~ A sequence is an expression of the following form: .. tacn:: @ltac_expr3__1 ; @ltac_expr3__2 :name: ltac-seq .. todo: can't use "… ; …" as the name because of the semicolon The expression :n:`@ltac_expr3__1` is evaluated to :n:`v__1`, which must be a tactic value. The tactic :n:`v__1` is applied to the current goals, possibly producing more goals. Then the right-hand side is evaluated to produce :n:`v__2`, which must be a tactic value. The tactic :n:`v__2` is applied to all the goals produced by the prior application. Sequence is associative. This construct uses backtracking: if :n:`@ltac_expr3__2` fails, Coq will try each alternative success (if any) for :n:`@ltac_expr3__1`, retrying :n:`@ltac_expr3__2` for each until both tactics succeed or all alternatives have failed. See :ref:`branching_and_backtracking`. .. todo I don't see the distinction between evaluating an ltac expression and applying it--how are they not the same thing? If different, the "Semantics" section above should explain it. See https://github.com/coq/coq/pull/12103#discussion_r422210482 .. note:: - If you want :n:`@tactic__2; @tactic__3` to be fully applied to the first subgoal generated by :n:`@tactic__1` before applying it to the other subgoals, then you should write: - :n:`@tactic__1; [> @tactic__2; @tactic__3 .. ]` rather than - :n:`@tactic__1; (@tactic__2; @tactic__3)`. Do loop ~~~~~~~ .. tacn:: do @nat_or_var @ltac_expr3 The do loop repeats a tactic :token:`nat_or_var` times: :n:`@ltac_expr` is evaluated to ``v``, which must be a tactic value. This tactic value ``v`` is applied :token:`nat_or_var` times. If :token:`nat_or_var` > 1, after the first application of ``v``, ``v`` is applied, at least once, to the generated subgoals and so on. It fails if the application of ``v`` fails before :token:`nat_or_var` applications have been completed. :tacn:`do` is an :token:`l3_tactic`. Repeat loop ~~~~~~~~~~~ .. tacn:: repeat @ltac_expr3 The repeat loop repeats a tactic until it fails or doesn't change the proof context. :n:`@ltac_expr` is evaluated to ``v``. If ``v`` denotes a tactic, this tactic is applied to each focused goal independently. If the application succeeds, the tactic is applied recursively to all the generated subgoals until it eventually fails. The recursion stops in a subgoal when the tactic has failed *to make progress*. The tactic :tacn:`repeat` :n:`@ltac_expr` itself never fails. :tacn:`repeat` is an :token:`l3_tactic`. Catching errors: try ~~~~~~~~~~~~~~~~~~~~ We can catch the tactic errors with: .. tacn:: try @ltac_expr3 :n:`@ltac_expr` is evaluated to ``v`` which must be a tactic value. The tactic value ``v`` is applied to each focused goal independently. If the application of ``v`` fails in a goal, it catches the error and leaves the goal unchanged. If the level of the exception is positive, then the exception is re-raised with its level decremented. :tacn:`try` is an :token:`l3_tactic`. Conditional branching: tryif ~~~~~~~~~~~~~~~~~~~~~~~~~~~~ .. tacn:: tryif @ltac_expr__test then @ltac_expr__then else @ltac_expr2__else For each focused goal, independently: Evaluate and apply :n:`@ltac_expr__test`. If :n:`@ltac_expr__test` succeeds at least once, evaluate and apply :n:`@ltac_expr__then` to all the subgoals generated by :n:`@ltac_expr__test`. Otherwise, evaluate and apply :n:`@ltac_expr2__else` to all the subgoals generated by :n:`@ltac_expr__test`. :tacn:`tryif` is an :token:`l2_tactic`. .. multigoal example - not sure it adds much Goal True /\ False. split; tryif match goal with | |- True => idtac "True" | |- False => idtac "False" end then idtac "then" else idtac "else". Alternatives ------------ Branching with backtracking: + ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ We can branch with backtracking with the following structure: .. tacn:: @ltac_expr1 + @ltac_expr2 :name: + (backtracking branching) Evaluates and applies :n:`@ltac_expr1` to each focused goal independently. If it fails (i.e. there is no initial success), then evaluates and applies the right-hand side. If the right-hand side fails, the construct fails. If :n:`ltac_expr1` has an initial success and a subsequent tactic (outside the `+` construct) fails, |Ltac| backtracks and selects the next success for :n:`ltac_expr1`. If there are no more successes, then `+` similarly evaluates and applies (and backtracks in) the right-hand side. To prevent evaluation of further alternatives after an initial success for a tactic, use :tacn:`first` instead. `+` is left-associative. In all cases, :n:`(@ltac_expr__1 + @ltac_expr__2); @ltac_expr__3` is equivalent to :n:`(@ltac_expr__1; @ltac_expr__3) + (@ltac_expr__2; @ltac_expr__3)`. Additionally, in most cases, :n:`(@ltac_expr__1 + @ltac_expr__2) + @ltac_expr__3` is equivalent to :n:`@ltac_expr__1 + (@ltac_expr__2 + @ltac_expr__3)`. Here's an example where the behavior differs slightly: .. coqtop:: reset none Goal True. .. coqtop:: all Fail (fail 2 + idtac) + idtac. Fail fail 2 + (idtac + idtac). .. example:: Backtracking branching with + In the first tactic, `idtac "2"` is not executed. In the second, the subsequent `fail` causes backtracking and the execution of `idtac "B"`. .. coqtop:: reset none Goal True. .. coqtop:: all idtac "1" + idtac "2". assert_fails ((idtac "A" + idtac "B"); fail). Local application of tactics: [> ... ] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ .. tacn:: [> @for_each_goal ] :name: [> … | … | … ] (dispatch) .. insertprodn for_each_goal goal_tactics .. prodn:: for_each_goal ::= @goal_tactics | {? @goal_tactics %| } {? @ltac_expr } .. {? %| @goal_tactics } goal_tactics ::= {*| {? @ltac_expr } } Applies a different :n:`{? @ltac_expr }` to each of the focused goals. In the first form of :token:`for_each_goal` (without `..`), the construct fails if the number of specified :n:`{? @ltac_expr }` is not the same as the number of focused goals. Omitting an :n:`@ltac_expr` leaves the corresponding goal unchanged. In the second form (with :n:`{? @ltac_expr } ..`), the left and right :token:`goal_tactics` are applied respectively to a prefix or suffix of the list of focused goals. The :n:`{? @ltac_expr }` before the `..` is applied to any focused goals in the middle (possibly none) that are not covered by the :token:`goal_tactics`. The number of :n:`{? @ltac_expr }` in the :token:`goal_tactics` must be no more than the number of focused goals. In particular: :n:`@goal_tactics | .. | @goal_tactics` The goals not covered by the two :token:`goal_tactics` are left unchanged. :n:`[> @ltac_expr .. ]` :n:`@ltac_expr` is applied independently to each of the goals, rather than globally. In particular, if there are no goals, the tactic is not run at all. A tactic which expects multiple goals, such as :tacn:`swap`, would act as if a single goal is focused. Note that :n:`@ltac_expr3 ; [ {*| @ltac_expr} ]` is a convenient idiom to process the goals generated by applying :n:`@ltac_expr3`. .. tacn:: @ltac_expr3 ; [ @for_each_goal ] :name: [ … | … | … ] (dispatch) :n:`@ltac_expr3 ; [ ... ]` is equivalent to :n:`[> @ltac_expr3 ; [> ... ] .. ]`. .. todo see discussion of [ ... ] in https://github.com/coq/coq/issues/12283 First tactic to succeed ~~~~~~~~~~~~~~~~~~~~~~~ In some cases backtracking may be too expensive. .. tacn:: first [ {*| @ltac_expr } ] first @ident :name: first; _ In the first form: for each focused goal, independently apply the first tactic (:token:`ltac_expr`) that succeeds. In the second form: :n:`@ident` represents a list of tactics passed to :n:`first` in a :cmd:`Tactic Notation` command (see example :ref:`here `). :tacn:`first` is an :token:`l1_tactic`. .. exn:: No applicable tactic. :undocumented: Failures in tactics won't cause backtracking. (To allow backtracking, use the :tacn:`+<+ (backtracking branching)>` construct above instead.) If the :tacn:`first` contains a tactic that can backtrack, "success" means the first success of that tactic. Consider the following: .. example:: Backtracking inside a non-backtracking construct .. coqtop:: reset none Goal True. The :tacn:`fail` doesn't trigger the second :tacn:`idtac`: .. coqtop:: all assert_fails (first [ idtac "1" | idtac "2" ]; fail). This backtracks within `(idtac "1A" + idtac "1B" + fail)` but :tacn:`first` won't consider the `idtac "2"` alternative: .. coqtop:: all assert_fails (first [ (idtac "1A" + idtac "1B" + fail) | idtac "2" ]; fail). .. _taclist_in_first: .. example:: Referring to a list of tactics in :cmd:`Tactic Notation` This works similarly for the :tacn:`solve` tactic. .. coqtop:: reset all Tactic Notation "myfirst" "[" tactic_list_sep(tacl,"|") "]" := first tacl. Goal True. myfirst [ auto | apply I ]. Solving ~~~~~~~ .. tacn:: solve [ {*| @ltac_expr__i } ] solve @ident :name: solve; _ In the first form: for each focused goal, independently apply the first tactic (:n:`@ltac_expr`) that solves the goal. In the second form: :n:`@ident` represents a list of tactics passed to :n:`solve` in a :cmd:`Tactic Notation` command (see example :ref:`here `). If any of the goals are not solved, then the overall :tacn:`solve` fails. :tacn:`solve` is an :token:`l1_tactic`. First tactic to make progress: || ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Yet another way of branching without backtracking is the following structure: .. tacn:: @ltac_expr1 %|| @ltac_expr2 :name: || (first tactic making progress) :n:`@ltac_expr1 || @ltac_expr2` is equivalent to :n:`first [ progress @ltac_expr1 | @ltac_expr2 ]`, except that if it fails, it fails like :n:`@ltac_expr2. `||` is left-associative. :n:`@ltac_expr`\s that don't evaluate to tactic values are ignored. See the note at :tacn:`solve`. Detecting progress ~~~~~~~~~~~~~~~~~~ We can check if a tactic made progress with: .. tacn:: progress @ltac_expr3 :n:`@ltac_expr` is evaluated to ``v`` which must be a tactic value. The tactic value ``v`` is applied to each focused subgoal independently. If the application of ``v`` to one of the focused subgoal produced subgoals equal to the initial goals (up to syntactical equality), then an error of level 0 is raised. :tacn:`progress` is an :token:`l3_tactic`. .. exn:: Failed to progress. :undocumented: Success and failure ------------------- Checking for success: assert_succeeds ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Coq defines an |Ltac| tactic in `Init.Tactics` to check that a tactic has *at least one* success: .. tacn:: assert_succeeds @ltac_expr3 If :n:`@ltac_expr3` has at least one success, the proof state is unchanged and no message is printed. If :n:`@ltac_expr3` fails, the tactic fails with the same error. Checking for failure: assert_fails ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Coq defines an |Ltac| tactic in `Init.Tactics` to check that a tactic *fails*: .. tacn:: assert_fails @ltac_expr3 If :n:`@ltac_expr3` fails, the proof state is unchanged and no message is printed. If :n:`@ltac_expr3` unexpectedly has at least one success, the tactic performs a :tacn:`gfail` :n:`0`, printing the following message: .. exn:: Tactic failure: succeeds. :undocumented: .. note:: :tacn:`assert_fails` and :tacn:`assert_succeeds` work as described when :token:`ltac_expr3` is a :token:`simple_tactic`. In some more complex expressions, they may report an error from within :token:`ltac_expr3` when they shouldn't. This is due to the order in which parts of the :token:`ltac_expr3` are evaluated and executed. For example: .. coqtop:: reset none Goal True. .. coqtop:: all fail assert_fails match True with _ => fail end. should not show any message. The issue is that :tacn:`assert_fails` is an |Ltac|-defined tactic. That makes it a function that's processed in the evaluation phase, causing the :tacn:`match` to find its first success earlier. One workaround is to prefix :token:`ltac_expr3` with "`idtac;`". .. coqtop:: all assert_fails (idtac; match True with _ => fail end). Alternatively, substituting the :tacn:`match` into the definition of :tacn:`assert_fails` works as expected: .. coqtop:: all tryif (once match True with _ => fail end) then gfail 0 (* tac *) "succeeds" else idtac. Failing ~~~~~~~ .. tacn:: {| fail | gfail } {? @nat_or_var } {* {| @ident | @string | @natural } } :name: fail; gfail :tacn:`fail` is the always-failing tactic: it does not solve any goal. It is useful for defining other tactics since it can be caught by :tacn:`try`, :tacn:`repeat`, :tacn:`match goal`, or the branching tacticals. :tacn:`gfail` fails even when used after :n:`;` and there are no goals left. Similarly, :tacn:`gfail` fails even when used after ``all:`` and there are no goals left. :tacn:`fail` and :tacn:`gfail` are :token:`l1_tactic`\s. See the example for a comparison of the two constructs. 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. :n:`@nat_or_var` The failure level. If no level is specified, it defaults to 0. The level is used by :tacn:`try`, :tacn:`repeat`, :tacn:`match goal` and the branching tacticals. If 0, it makes :tacn:`match goal` consider the next clause (backtracking). If nonzero, the current :tacn:`match goal` block, :tacn:`try`, :tacn:`repeat`, or branching command is aborted and the level is decremented. In the case of :n:`+`, a nonzero level skips the first backtrack point, even if the call to :tacn:`fail` :n:`@natural` is not enclosed in a :n:`+` construct, respecting the algebraic identity. :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. .. exn:: Tactic failure. :undocumented: .. exn:: Tactic failure (level @natural). :undocumented: .. exn:: No such goal. :name: No such goal. (fail) :undocumented: .. example:: .. 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 (e.g. gfail always fails; "tac; fail" succeeds but "fail." alone fails. .. coqtop:: reset all fail Goal True. Proof. fail. Abort. Goal True. Proof. trivial; fail. Qed. Goal True. Proof. trivial. fail. Abort. Goal True. Proof. trivial. all: fail. Qed. Goal True. Proof. gfail. Abort. Goal True. Proof. trivial; gfail. Abort. Goal True. Proof. trivial. gfail. Abort. Goal True. Proof. trivial. all: gfail. Abort. Soft cut: once ~~~~~~~~~~~~~~ .. todo Would like a different subsection title above. I have trouble distinguishing once and exactly_once. We need to explain backtracking somewhere. See https://github.com/coq/coq/pull/12103#discussion_r422360181 Another way of restricting backtracking is to restrict a tactic to a single success: .. tacn:: once @ltac_expr3 :n:`@ltac_expr3` is evaluated to ``v`` which must be a tactic value. The tactic value ``v`` is applied but only its first success is used. If ``v`` fails, :tacn:`once` :n:`@ltac_expr3` fails like ``v``. If ``v`` has at least one success, :tacn:`once` :n:`@ltac_expr3` succeeds once, but cannot produce more successes. :tacn:`once` is an :token:`l3_tactic`. Checking for a single success: exactly_once ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Coq provides an experimental way to check that a tactic has *exactly one* success: .. tacn:: exactly_once @ltac_expr3 :n:`@ltac_expr3` is evaluated to ``v`` which must be a tactic value. The tactic value ``v`` is applied if it has at most one success. If ``v`` fails, :tacn:`exactly_once` :n:`@ltac_expr3` fails like ``v``. If ``v`` has a exactly one success, :tacn:`exactly_once` :n:`@ltac_expr3` succeeds like ``v``. If ``v`` has two or more successes, :tacn:`exactly_once` :n:`@ltac_expr3` fails. :tacn:`exactly_once` is an :token:`l3_tactic`. .. warning:: The experimental status of this tactic pertains to the fact if ``v`` has side effects, they may occur in an unpredictable way. Indeed, normally ``v`` would only be executed up to the first success until backtracking is needed, however :tacn:`exactly_once` needs to look ahead to see whether a second success exists, and may run further effects immediately. .. exn:: This tactic has more than one success. :undocumented: Manipulating values ------------------- Pattern matching on terms: match ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ .. tacn:: @match_key @ltac_expr__term with {? %| } {+| @match_pattern => @ltac_expr } end :name: lazymatch; match; multimatch .. insertprodn match_key cpattern .. prodn:: match_key ::= lazymatch | match | multimatch match_pattern ::= @cpattern | context {? @ident } [ @cpattern ] cpattern ::= @term :tacn:`lazymatch`, :tacn:`match` and :tacn:`multimatch` are :token:`ltac_expr1`\s. Evaluates :n:`@ltac_expr__term`, which must yield a term, and matches it sequentially with the :token:`match_pattern`\s, which may have metavariables. When a match is found, metavariable values are substituted into :n:`@ltac_expr`, which is then applied. Matching may continue depending on whether `lazymatch`, `match` or `multimatch` is specified. In the :token:`match_pattern`\s, metavariables have the form :n:`?@ident`, whereas in the :n:`@ltac_expr`\s, the question mark is omitted. Choose your metavariable names with care to avoid name conflicts. For example, if you use the metavariable `S`, then the :token:`ltac_expr` can't use `S` to refer to the constructor of `nat` without qualifying the constructor as `Datatypes.S`. .. todo how does this differ from the 1-2 other unification routines elsewhere in Coq? Does it use constr_eq or eq_constr_nounivs? Matching is non-linear: if a metavariable occurs more than once, each occurrence must match the same expression. Expressions match if they are syntactically equal or are :term:`α-convertible `. Matching is first-order except on variables of the form :n:`@?@ident` that occur in the head position of an application. For these variables, matching is second-order and returns a functional term. .. todo 30 May 20: the `@?ident` form is in dangling_pattern_extension_rule, not included in the doc yet maybe belongs with "Applications" `lazymatch` Causes the match to commit to the first matching branch rather than trying a new match if :n:`@ltac_expr` fails. :ref:`Example`. `match` If :n:`@ltac_expr` fails, continue matching with the next branch. Failures in subsequent tactics (after the `match`) will not cause selection of a new branch. Examples :ref:`here` and :ref:`here`. `multimatch` If :n:`@ltac_expr` fails, continue matching with the next branch. When an :n:`@ltac_expr` succeeds for a branch, subsequent failures (after the `multimatch`) causing consumption of all the successes of :n:`@ltac_expr` trigger selection of a new matching branch. :ref:`Example`. :tacn:`match` :n:`…` is, in fact, shorthand for :tacn:`once` :tacn:`multimatch` `…`. :n:`@cpattern` The syntax of :token:`cpattern` is the same as that of :token:`term`\s, but it can contain pattern matching metavariables in the form :n:`?@ident`. :g:`_` can be used to match irrelevant terms. :ref:`Example`. .. todo Didn't understand the following 2 paragraphs well enough to revise see https://github.com/coq/coq/pull/12103#discussion_r436297754 for a possible example When a metavariable in the form :n:`?id` occurs under binders, say :n:`x__1, …, x__n` and the expression matches, the metavariable is instantiated by a term which can then be used in any context which also binds the variables :n:`x__1, …, x__n` with same types. This provides with a primitive form of matching under context which does not require manipulating a functional term. There is also a special notation for second-order pattern matching: in an applicative pattern of the form :n:`@?@ident @ident__1 … @ident__n`, the variable :token:`ident` matches any complex expression with (possible) dependencies in the variables :n:`@ident__i` and returns a functional term of the form :n:`fun @ident__1 … @ident__n => @term`. .. _match_term_context: :n:`context {? @ident } [ @cpattern ]` Matches any term with a subterm matching :token:`cpattern`. If there is a match and :n:`@ident` is present, it is assigned the "matched context", i.e. the initial term where the matched subterm is replaced by a hole. Note that `context` (with very similar syntax) appearing after the `=>` is the :tacn:`context` tactic. For :tacn:`match` and :tacn:`multimatch`, if the evaluation of the :token:`ltac_expr` fails, the next matching subterm is tried. If no further subterm matches, the next branch is tried. Matching subterms are considered from top to bottom and from left to right (with respect to the raw printing obtained by setting the :flag:`Printing All` flag). :ref:`Example`. .. todo There's a more realistic example from @JasonGross here: https://github.com/coq/coq/pull/12103#discussion_r432996954 :n:`@ltac_expr` The tactic to apply if the construct matches. Metavariable values from the pattern match are substituted into :n:`@ltac_expr` before it's applied. Note that metavariables are not prefixed with the question mark as they are in :token:`cpattern`. If :token:`ltac_expr` evaluates to a tactic, then it is applied. If the tactic succeeds, the result of the match expression is :tacn:`idtac`. If :token:`ltac_expr` does not evaluate to a tactic, that value is the result of the match expression. If :n:`@ltac_expr` is a tactic with backtracking points, then subsequent failures after a :tacn:`lazymatch` or :tacn:`multimatch` (but not :tacn:`match`) can cause backtracking into :n:`@ltac_expr` to select its next success. (:tacn:`match` :n:`…` is equivalent to :tacn:`once` :tacn:`multimatch` `…`. The :tacn:`once` prevents backtracking into the :tacn:`match` after it has succeeded.) .. note:: Each |Ltac| construct is processed in two phases: an evaluation phase and an execution phase. In most cases, tactics that may change the proof state are applied in the second phase. (Tactics that generate integer, string or syntactic values, such as :tacn:`fresh`, are processed during the evaluation phase.) Unlike other tactics, `*match*` tactics get their first success (applying tactics to do so) as part of the evaluation phase. Among other things, this can affect how early failures are processed in :tacn:`assert_fails`. Please see the note in :tacn:`assert_fails`. .. exn:: Expression does not evaluate to a tactic. :n:`@ltac_expr` must evaluate to a tactic. .. exn:: No matching clauses for match. For at least one of the focused goals, there is no branch that matches its pattern *and* gets at least one success for :n:`@ltac_expr`. .. exn:: Argument of match does not evaluate to a term. This happens when :n:`@ltac_expr__term` does not denote a term. .. _match_vs_lazymatch_ex: .. example:: Comparison of lazymatch and match In :tacn:`lazymatch`, if :token:`ltac_expr` fails, the :tacn:`lazymatch` fails; it doesn't look for further matches. In :tacn:`match`, if :token:`ltac_expr` fails in a matching branch, it will try to match on subsequent branches. .. coqtop:: reset none Goal True. .. coqtop:: all Fail lazymatch True with | True => idtac "branch 1"; fail | _ => idtac "branch 2" end. .. coqtop:: all match True with | True => idtac "branch 1"; fail | _ => idtac "branch 2" end. .. _match_vs_multimatch_ex: .. example:: Comparison of match and multimatch :tacn:`match` tactics are only evaluated once, whereas :tacn:`multimatch` tactics may be evaluated more than once if the following constructs trigger backtracking: .. coqtop:: all Fail match True with | True => idtac "branch 1" | _ => idtac "branch 2" end ; idtac "branch A"; fail. .. coqtop:: all Fail multimatch True with | True => idtac "branch 1" | _ => idtac "branch 2" end ; idtac "branch A"; fail. .. _match_with_holes_ex: .. example:: Matching a pattern with holes Notice the :tacn:`idtac` prints ``(z + 1)`` while the :tacn:`pose` substitutes ``(x + 1)``. .. coqtop:: in reset Goal True. .. coqtop:: all match constr:(fun x => (x + 1) * 3) with | fun z => ?y * 3 => idtac "y =" y; pose (fun z: nat => y * 5) end. .. _match_term_context_ex: .. example:: Multiple matches for a "context" pattern. Internally "x <> y" is represented as "(~ (x = y))", which produces the first match. .. coqtop:: in reset Ltac f t := match t with | context [ (~ ?t) ] => idtac "?t = " t; fail | _ => idtac end. Goal True. .. coqtop:: all f ((~ True) <> (~ False)). .. _ltac-match-goal: Pattern matching on goals and hypotheses: match goal ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ .. tacn:: @match_key {? reverse } goal with {? %| } {+| @goal_pattern => @ltac_expr } end :name: lazymatch goal; match goal; multimatch goal .. insertprodn goal_pattern match_hyp .. prodn:: goal_pattern ::= {*, @match_hyp } %|- @match_pattern | [ {*, @match_hyp } %|- @match_pattern ] | _ match_hyp ::= @name : @match_pattern | @name := @match_pattern | @name := [ @match_pattern ] : @match_pattern :tacn:`lazymatch goal`, :tacn:`match goal` and :tacn:`multimatch goal` are :token:`l1_tactic`\s. Use this form to match hypotheses and/or goals in the local context. These patterns have zero or more subpatterns to match hypotheses followed by a subpattern to match the conclusion. Except for the differences noted below, this works the same as the corresponding :n:`@match_key @ltac_expr` construct (see :tacn:`match`). Each current goal is processed independently. Matching is non-linear: if a metavariable occurs more than once, each occurrence must match the same expression. Within a single term, expressions match if they are syntactically equal or :term:`α-convertible `. When a metavariable is used across multiple hypotheses or across a hypothesis and the current goal, the expressions match if they are :term:`convertible`. :n:`{*, @match_hyp }` Patterns to match with hypotheses. Each pattern must match a distinct hypothesis in order for the branch to match. Hypotheses have the form :n:`@name {? := @term__binder } : @type`. Patterns bind each of these nonterminals separately: .. list-table:: :widths: 2 1 :header-rows: 1 * - Pattern syntax - Example pattern * - :n:`@name : @match_pattern__type` - `n : ?t` * - :n:`@name := @match_pattern__binder` - `n := ?b` * - :n:`@name := @term__binder : @type` - `n := ?b : ?t` * - :n:`@name := [ @match_pattern__binder ] : @match_pattern__type` - `n := [ ?b ] : ?t` .. :token:`name` can't have a `?`. Note that the last two forms are equivalent except that: - if the `:` in the third form has been bound to something else in a notation, you must use the fourth form. Note that cmd:`Require Import` `ssreflect` loads a notation that does this. - a :n:`@term__binder` such as `[ ?l ]` (e.g., denoting a singleton list after :cmd:`Import` `ListNotations`) must be parenthesized or, for the fourth form, use double brackets: `[ [ ?l ] ]`. :n:`@term__binder`\s in the form `[?x ; ?y]` for a list are not parsed correctly. The workaround is to add parentheses or to use the underlying term instead of the notation, i.e. `(cons ?x ?y)`. If there are multiple :token:`match_hyp`\s in a branch, there may be multiple ways to match them to hypotheses. For :tacn:`match goal` and :tacn:`multimatch goal`, if the evaluation of the :token:`ltac_expr` fails, matching will continue with the next hypothesis combination. When those are exhausted, the next alternative from any `context` constructs in the :token:`match_pattern`\s is tried and then, when the context alternatives are exhausted, the next branch is tried. :ref:`Example`. `reverse` Hypothesis matching for :token:`match_hyp`\s normally begins by matching them from left to right, to hypotheses, last to first. Specifying `reverse` begins matching in the reverse order, from first to last. :ref:`Normal` and :ref:`reverse` examples. :n:`|- @match_pattern` A pattern to match with the current goal :n:`@goal_pattern with [ ... ]` The square brackets don't affect the semantics. They are permitted for aesthetics. .. exn:: No matching clauses for match goal. No clause succeeds, i.e. all matching patterns, if any, fail at the application of the :token:`ltac_expr`. Examples: .. _match_goal_hyps_ex: .. example:: Matching hypotheses Hypotheses are matched from the last hypothesis (which is by default the newest hypothesis) to the first until the :tacn:`apply` succeeds. .. coqtop:: reset all Goal forall A B : Prop, A -> B -> (A->B). intros. match goal with | H : _ |- _ => idtac "apply " H; apply H end. .. _match_goal_hyps_rev_ex: .. example:: Matching hypotheses with reverse Hypotheses are matched from the first hypothesis to the last until the :tacn:`apply` succeeds. .. coqtop:: reset all Goal forall A B : Prop, A -> B -> (A->B). intros. match reverse goal with | H : _ |- _ => idtac "apply " H; apply H end. .. _match_goal_multiple_hyps_ex: .. example:: Multiple ways to match hypotheses Every possible match for the hypotheses is evaluated until the right-hand side succeeds. Note that `H1` and `H2` are never matched to the same hypothesis. Observe that the number of permutations can grow as the factorial of the number of hypotheses and hypothesis patterns. .. coqtop:: reset all Goal forall A B : Prop, A -> B -> (A->B). intros A B H. match goal with | H1 : _, H2 : _ |- _ => idtac "match " H1 H2; fail | _ => idtac end. .. todo need examples for: match_context_rule ::= [ {*, @match_hyp } |- @match_pattern ] => @ltac_expr match_hyp ::= | @name := {? [ @match_pattern ] : } @match_pattern .. 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 ~~~~~~~~~~~~~~~~~~~~~~ The following expression is not a tactic in the sense that it does not produce subgoals but generates a term to be used in tactic expressions: .. tacn:: context @ident [ @term ] Returns the term matched with the `context` pattern (described :ref:`here`) substituting :token:`term` for the hole created by the pattern. :tacn:`context` is a :token:`value_tactic`. .. exn:: Not a context variable. :undocumented: .. exn:: Unbound context identifier @ident. :undocumented: .. example:: Substituting a matched context .. coqtop:: reset all Goal True /\ True. match goal with | |- context G [True] => let x := context G [False] in idtac x end. Generating fresh hypothesis names ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Tactics sometimes need to generate new names for hypothesis. Letting Coq choose a name with the intro tactic is not so good since it is very awkward to retrieve that name. The following expression returns an identifier: .. tacn:: fresh {* {| @string | @qualid } } .. todo you can't have a :tacn: with the same name as a :gdef: for now, eg `fresh` can't be both Returns a fresh identifier name (i.e. one that is not already used in the local context and not previously returned by :tacn:`fresh` in the current :token:`ltac_expr`). The fresh identifier is formed by concatenating the final :token:`ident` of each :token:`qualid` (dropping any qualified components) and each specified :token:`string`. If the resulting name is already used, a number is appended to make it fresh. If no arguments are given, the name is a fresh derivative of the name ``H``. .. note:: We recommend generating the fresh identifier immediately before adding it to the local context. Using :tacn:`fresh` in a local function may not work as you expect: Successive calls to :tacn:`fresh` give distinct names even if the names haven't yet been added to the local context: .. coqtop:: reset none Goal True -> True. .. coqtop:: out intro x. .. coqtop:: all let a := fresh "x" in let b := fresh "x" in idtac a b. When applying :tacn:`fresh` in a function, the name is chosen based on the tactic context at the point where the function was defined: .. coqtop:: all let a := fresh "x" in let f := fun _ => fresh "x" in let c := f () in let d := f () in idtac a c d. :tacn:`fresh` is a :token:`value_tactic`. Computing in a term: eval ~~~~~~~~~~~~~~~~~~~~~~~~~ Evaluation of a term can be performed with: :n:`eval @red_expr in @term` See :tacn:`eval`. :tacn:`eval` is a :token:`value_tactic`. Getting the type of a term ~~~~~~~~~~~~~~~~~~~~~~~~~~ .. tacn:: type of @term This tactic returns the type of :token:`term`. :tacn:`type of` is a :token:`value_tactic`. Manipulating untyped terms: type_term ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ The :n:`uconstr : ( @term )` construct can be used to build an untyped term. See :token:`syn_value`. .. tacn:: type_term @one_term In |Ltac|, an untyped term can contain references to hypotheses or to |Ltac| variables containing typed or untyped terms. An untyped term can be type checked with :tacn:`type_term` whose argument is parsed as an untyped term and returns a well-typed term which can be used in tactics. :tacn:`type_term` is a :token:`value_tactic`. Counting goals: numgoals ~~~~~~~~~~~~~~~~~~~~~~~~ .. tacn:: numgoals The number of goals under focus can be recovered using the :n:`numgoals` function. Combined with the :tacn:`guard` tactic below, it can be used to branch over the number of goals produced by previous tactics. :tacn:`numgoals` is a :token:`value_tactic`. .. example:: .. coqtop:: reset in Ltac pr_numgoals := let n := numgoals in idtac "There are" n "goals". Goal True /\ True /\ True. split;[|split]. .. coqtop:: all abort all:pr_numgoals. Testing boolean expressions: guard ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ .. tacn:: guard @int_or_var @comparison @int_or_var .. insertprodn int_or_var comparison .. prodn:: int_or_var ::= {| @integer | @ident } comparison ::= = | < | <= | > | >= Tests a boolean expression. If the expression evaluates to true, it succeeds without affecting the proof. The tactic fails if the expression is false. The accepted tests are simple integer comparisons. .. todo why doesn't it support = and <> as well? .. example:: guard .. coqtop:: in Goal True /\ True /\ True. split;[|split]. .. coqtop:: all all:let n:= numgoals in guard n<4. Fail all:let n:= numgoals in guard n=2. .. exn:: Condition not satisfied. :undocumented: Checking properties of terms ~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Each of the following tactics acts as the identity if the check succeeds, and results in an error otherwise. .. tacn:: constr_eq_strict @one_term @one_term Succeeds if the arguments are equal modulo alpha conversion and ignoring casts. Universes are considered equal when they are equal in the universe graph. .. exn:: Not equal. :undocumented: .. exn:: Not equal (due to universes). :undocumented: .. tacn:: constr_eq @one_term @one_term Like :tacn:`constr_eq_strict`, but may add constraints to make universes equal. .. tacn:: constr_eq_nounivs @one_term @one_term Like :tacn:`constr_eq_strict`, but all universes are considered equal. .. tacn:: convert @one_term @one_term Succeeds if the arguments are convertible, potentially adding universe constraints, and fails otherwise. .. tacn:: unify @one_term @one_term {? with @ident } Succeeds if the arguments are unifiable, potentially instantiating existential variables, and fails otherwise. :n:`@ident`, if specified, is the name of the :ref:`hint database ` that specifies which definitions are transparent. Otherwise, all definitions are considered transparent. Unification only expands transparent definitions while matching the two :n:`@one_term`\s. .. tacn:: is_evar @one_term Succeeds if :n:`@one_term` is an existential variable and otherwise fails. Existential variables are uninstantiated variables generated by :tacn:`eapply` and some other tactics. .. exn:: Not an evar. :undocumented: .. tacn:: not_evar @one_term :undocumented: .. tacn:: has_evar @one_term Succeeds if :n:`@one_term` has an existential variable as a subterm and fails otherwise. Unlike context patterns combined with ``is_evar``, this tactic scans all subterms, including those under binders. .. exn:: No evars. :undocumented: .. tacn:: is_ground @one_term The negation of :n:`has_evar @one_term`. Succeeds if :n:`@one_term` does not have an existential variable as a subterm and fails otherwise. .. exn:: Not ground. :undocumented: .. tacn:: is_var @one_term Succeeds if :n:`@one_term` is a variable or hypothesis in the current local context and fails otherwise. .. exn:: Not a variable or hypothesis. :undocumented: .. tacn:: is_const @one_term Succeeds if :n:`@one_term` is a global constant that is neither a (co)inductive type nor a constructor and fails otherwise. .. exn:: not a constant. :undocumented: .. tacn:: is_fix @one_term Succeeds if :n:`@one_term` is a `fix` construct (see :n:`@term_fix`) and fails otherwise. Fails for `let fix` forms. .. exn:: not a fix definition. :undocumented: .. example:: is_fix .. coqtop:: reset in Goal True. is_fix (fix f (n : nat) := match n with S n => f n | O => O end). .. tacn:: is_cofix @one_term :undocumented: Succeeds if :n:`@one_term` is a `cofix` construct (see :n:`@term_cofix`) and fails otherwise. Fails for `let cofix` forms. .. exn:: not a cofix definition. :undocumented: .. example:: is_cofix .. coqtop:: reset in Require Import Coq.Lists.Streams. Goal True. let c := constr:(cofix f : Stream unit := Cons tt f) in is_cofix c. .. tacn:: is_constructor @one_term Succeeds if :n:`@one_term` is the constructor of a (co)inductive type and fails otherwise. .. exn:: not a constructor. :undocumented: .. tacn:: is_ind @one_term Succeeds if :n:`@one_term` is a (co)inductive type (family) and fails otherwise. Note that `is_ind (list nat)` fails even though `is_ind list` succeeds, because `list nat` is an application. .. exn:: not an (co)inductive datatype. :undocumented: .. tacn:: is_proj @one_term Succeeds if :n:`@one_term` is a primitive projection applied to a record argument and fails otherwise. .. exn:: not a primitive projection. :undocumented: .. example:: is_proj .. coqtop:: reset in Set Primitive Projections. Record Box {T : Type} := box { unbox : T }. Arguments box {_} _. Goal True. is_proj (unbox (box 0)). Timing ------ Timeout ~~~~~~~ We can force a tactic to stop if it has not finished after a certain amount of time: .. tacn:: timeout @nat_or_var @ltac_expr3 :n:`@ltac_expr3` is evaluated to ``v`` which must be a tactic value. The tactic value ``v`` is applied but only its first success is used (as with :tacn:`once`), and it is interrupted after :n:`@nat_or_var` seconds if it is still running. If it is interrupted the outcome is a failure. :tacn:`timeout` is an :token:`l3_tactic`. .. warning:: For the moment, timeout is based on elapsed time in seconds, which is very machine-dependent: a script that works on a quick machine may fail on a slow one. The converse is even possible if you combine a 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. Timing a tactic ~~~~~~~~~~~~~~~ A tactic execution can be timed: .. tacn:: time {? @string } @ltac_expr3 evaluates :n:`@ltac_expr3` and displays the running time of the tactic expression, whether it fails or succeeds. In case of several successes, the time for each successive run is displayed. Time is in seconds and is machine-dependent. The :n:`@string` argument is optional. When provided, it is used to identify this particular occurrence of :tacn:`time`. :tacn:`time` is an :token:`l3_tactic`. Timing a tactic that evaluates to a term: time_constr ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Tactic expressions that produce terms can be timed with the experimental tactic .. tacn:: time_constr @ltac_expr which evaluates :n:`@ltac_expr ()` and displays the time the tactic expression evaluated, assuming successful evaluation. Time is in seconds and is machine-dependent. This tactic currently does not support nesting, and will report times based on the innermost execution. This is due to the fact that it is implemented using the following internal tactics: .. tacn:: restart_timer {? @string } Reset a timer .. tacn:: finish_timing {? ( @string ) } {? @string } Display an optionally named timer. The parenthesized string argument is also optional, and determines the label associated with the timer for printing. By copying the definition of :tacn:`time_constr` from the standard library, users can achieve support for a fixed pattern of nesting by passing different :token:`string` parameters to :tacn:`restart_timer` and :tacn:`finish_timing` at each level of nesting. .. example:: .. coqtop:: all reset abort Ltac time_constr1 tac := let eval_early := match goal with _ => restart_timer "(depth 1)" end in let ret := tac () in let eval_early := match goal with _ => finish_timing ( "Tactic evaluation" ) "(depth 1)" end in ret. Goal True. let v := time_constr ltac:(fun _ => let x := time_constr1 ltac:(fun _ => constr:(10 * 10)) in let y := time_constr1 ltac:(fun _ => eval compute in x) in y) in pose v. Print/identity tactic: idtac ---------------------------- .. tacn:: idtac {* {| @ident | @string | @natural } } Leaves the proof unchanged and prints the given tokens. :token:`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. :tacn:`idtac` is an :token:`l1_tactic`. Tactic toplevel definitions --------------------------- Defining |Ltac| symbols ~~~~~~~~~~~~~~~~~~~~~~~ |Ltac| toplevel definitions are made as follows: .. index:: ::= .. cmd:: Ltac @tacdef_body {* with @tacdef_body } .. insertprodn tacdef_body tacdef_body .. prodn:: tacdef_body ::= @qualid {* @name } {| := | ::= } @ltac_expr Defines or redefines an |Ltac| symbol. If the :attr:`local` attribute is specified, definitions will not be exported outside the current module and redefinitions only apply for the current module. :token:`qualid` Name of the symbol being defined or redefined. For definitions, :token:`qualid` must be a simple :token:`ident`. :n:`{* @name }` If specified, the symbol defines a function with the given parameter names. If no names are specified, :token:`qualid` is assigned the value of :token:`ltac_expr`. `:=` Defines a user-defined symbol, but gives an error if the symbol has already been defined. .. todo apparent inconsistency: "Ltac intros := idtac" seems like it redefines/hides an existing tactic, but in fact it creates a tactic which can only be called by its qualified name. This is true in general of tactic notations. The only way to override most primitive tactics, and any user-defined tactic notation, is with another tactic notation. .. exn:: There is already an Ltac named @qualid :undocumented: `::=` Redefines an existing user-defined symbol, but gives an error if the symbol doesn't exist. Note that :cmd:`Tactic Notation`\s do not count as user-defined tactics for `::=`. If :attr:`local` is not specified, the redefinition applies across module boundaries. .. exn:: There is no Ltac named @qualid :undocumented: :n:`{* with @tacdef_body }` Permits definition of mutually recursive tactics. .. note:: The following definitions are equivalent: - :n:`Ltac @qualid {+ @name } := @ltac_expr` - :n:`Ltac @qualid := fun {+ @name } => @ltac_expr` Printing |Ltac| tactics ~~~~~~~~~~~~~~~~~~~~~~~ .. cmd:: Print Ltac @qualid Defined |Ltac| functions can be displayed using this command. .. cmd:: Print Ltac Signatures This command displays a list of all user-defined tactics, with their arguments. .. _ltac-examples: Examples of using |Ltac| ------------------------- Proof that the natural numbers have at least two elements ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ .. example:: Proof that the natural numbers have at least two elements The first example shows how to use pattern matching over the proof context to prove that natural numbers have at least two elements. This can be done as follows: .. coqtop:: reset all Lemma card_nat : ~ exists x y : nat, forall z:nat, x = z \/ y = z. Proof. intros (x & y & Hz). destruct (Hz 0), (Hz 1), (Hz 2). At this point, the :tacn:`congruence` tactic would finish the job: .. coqtop:: all abort all: congruence. But for the purpose of the example, let's craft our own custom tactic to solve this: .. coqtop:: none Lemma card_nat : ~ exists x y : nat, forall z:nat, x = z \/ y = z. Proof. intros (x & y & Hz). destruct (Hz 0), (Hz 1), (Hz 2). .. coqtop:: all abort all: match goal with | _ : ?a = ?b, _ : ?a = ?c |- _ => assert (b = c) by now transitivity a end. all: discriminate. Notice that all the (very similar) cases coming from the three eliminations (with three distinct natural numbers) are successfully solved by a ``match goal`` structure and, in particular, with only one pattern (use of non-linear matching). Proving that a list is a permutation of a second list ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ .. example:: Proving that a list is a permutation of a second list Let's first define the permutation predicate: .. coqtop:: in reset Section Sort. Variable A : Set. Inductive perm : list A -> list A -> Prop := | perm_refl : forall l, perm l l | perm_cons : forall a l0 l1, perm l0 l1 -> perm (a :: l0) (a :: l1) | perm_append : forall a l, perm (a :: l) (l ++ a :: nil) | perm_trans : forall l0 l1 l2, perm l0 l1 -> perm l1 l2 -> perm l0 l2. End Sort. .. coqtop:: none Require Import List. Next we define an auxiliary tactic :g:`perm_aux` which takes an argument used to control the recursion depth. This tactic works as follows: If the lists are identical (i.e. convertible), it completes the proof. Otherwise, if the lists have identical heads, it looks at their tails. Finally, if the lists have different heads, it rotates the first list by putting its head at the end. Every time we perform a rotation, we decrement :g:`n`. When :g:`n` drops down to :g:`1`, we stop performing rotations and we fail. The idea is to give the length of the list as the initial value of :g:`n`. This way of counting the number of rotations will avoid going back to a head that had been considered before. 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`. .. coqtop:: in Ltac perm_aux n := match goal with | |- (perm _ ?l ?l) => apply perm_refl | |- (perm _ (?a :: ?l1) (?a :: ?l2)) => let newn := eval compute in (length l1) in (apply perm_cons; perm_aux newn) | |- (perm ?A (?a :: ?l1) ?l2) => match eval compute in n with | 1 => fail | _ => let l1' := constr:(l1 ++ a :: nil) in (apply (perm_trans A (a :: l1) l1' l2); [ apply perm_append | compute; perm_aux (pred n) ]) end end. The main tactic is :g:`solve_perm`. It computes the lengths of the two lists and uses them as arguments to call :g:`perm_aux` if the lengths are equal. (If they aren't, the lists cannot be permutations of each other.) .. coqtop:: in Ltac solve_perm := match goal with | |- (perm _ ?l1 ?l2) => match eval compute in (length l1 = length l2) with | (?n = ?n) => perm_aux n end end. And now, here is how we can use the tactic :g:`solve_perm`: .. coqtop:: out Goal perm nat (1 :: 2 :: 3 :: nil) (3 :: 2 :: 1 :: nil). .. coqtop:: all abort solve_perm. .. coqtop:: out Goal perm nat (0 :: 1 :: 2 :: 3 :: 4 :: 5 :: 6 :: 7 :: 8 :: 9 :: nil) (0 :: 2 :: 4 :: 6 :: 8 :: 9 :: 7 :: 5 :: 3 :: 1 :: nil). .. coqtop:: all abort solve_perm. Deciding intuitionistic propositional logic ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Pattern matching on goals allows powerful backtracking when returning tactic values. An interesting application is the problem of deciding intuitionistic propositional logic. Considering the contraction-free sequent calculi LJT* of Roy Dyckhoff :cite:`Dyc92`, it is quite natural to code such a tactic using the tactic language as shown below. .. coqtop:: in reset Ltac basic := match goal with | |- True => trivial | _ : False |- _ => contradiction | _ : ?A |- ?A => assumption end. .. coqtop:: in Ltac simplify := repeat (intros; match goal with | H : ~ _ |- _ => red in H | H : _ /\ _ |- _ => elim H; do 2 intro; clear H | H : _ \/ _ |- _ => elim H; intro; clear H | H : ?A /\ ?B -> ?C |- _ => cut (A -> B -> C); [ intro | intros; apply H; split; assumption ] | H: ?A \/ ?B -> ?C |- _ => cut (B -> C); [ cut (A -> C); [ intros; clear H | intro; apply H; left; assumption ] | intro; apply H; right; assumption ] | H0 : ?A -> ?B, H1 : ?A |- _ => cut B; [ intro; clear H0 | apply H0; assumption ] | |- _ /\ _ => split | |- ~ _ => red end). .. coqtop:: in Ltac my_tauto := simplify; basic || match goal with | H : (?A -> ?B) -> ?C |- _ => cut (B -> C); [ intro; cut (A -> B); [ intro; cut C; [ intro; clear H | apply H; assumption ] | clear H ] | intro; apply H; intro; assumption ]; my_tauto | H : ~ ?A -> ?B |- _ => cut (False -> B); [ intro; cut (A -> False); [ intro; cut B; [ intro; clear H | apply H; assumption ] | clear H ] | intro; apply H; red; intro; assumption ]; my_tauto | |- _ \/ _ => (left; my_tauto) || (right; my_tauto) end. The tactic ``basic`` tries to reason using simple rules involving truth, falsity and available assumptions. The tactic ``simplify`` applies all the reversible rules of Dyckhoff’s system. Finally, the tactic ``my_tauto`` (the main tactic to be called) simplifies with ``simplify``, tries to conclude with ``basic`` and tries several paths using the backtracking rules (one of the four Dyckhoff’s rules for the left implication to get rid of the contraction and the right ``or``). Having defined ``my_tauto``, we can prove tautologies like these: .. coqtop:: in Lemma my_tauto_ex1 : forall A B : Prop, A /\ B -> A \/ B. Proof. my_tauto. Qed. .. coqtop:: in Lemma my_tauto_ex2 : forall A B : Prop, (~ ~ B -> B) -> (A -> B) -> ~ ~ A -> B. Proof. my_tauto. Qed. Deciding type isomorphisms ~~~~~~~~~~~~~~~~~~~~~~~~~~ A trickier problem is to decide equalities between types modulo isomorphisms. Here, we choose to use the isomorphisms of the simply typed λ-calculus with Cartesian product and unit type (see, for example, :cite:`RC95`). The axioms of this λ-calculus are given below. .. coqtop:: in reset Open Scope type_scope. .. coqtop:: in Section Iso_axioms. .. coqtop:: in Variables A B C : Set. .. coqtop:: in Axiom Com : A * B = B * A. Axiom Ass : A * (B * C) = A * B * C. Axiom Cur : (A * B -> C) = (A -> B -> C). Axiom Dis : (A -> B * C) = (A -> B) * (A -> C). Axiom P_unit : A * unit = A. Axiom AR_unit : (A -> unit) = unit. Axiom AL_unit : (unit -> A) = A. .. coqtop:: in Lemma Cons : B = C -> A * B = A * C. Proof. intro Heq; rewrite Heq; reflexivity. Qed. .. coqtop:: in End Iso_axioms. .. coqtop:: in Ltac simplify_type ty := match ty with | ?A * ?B * ?C => rewrite <- (Ass A B C); try simplify_type_eq | ?A * ?B -> ?C => rewrite (Cur A B C); try simplify_type_eq | ?A -> ?B * ?C => rewrite (Dis A B C); try simplify_type_eq | ?A * unit => rewrite (P_unit A); try simplify_type_eq | unit * ?B => rewrite (Com unit B); try simplify_type_eq | ?A -> unit => rewrite (AR_unit A); try simplify_type_eq | unit -> ?B => rewrite (AL_unit B); try simplify_type_eq | ?A * ?B => (simplify_type A; try simplify_type_eq) || (simplify_type B; try simplify_type_eq) | ?A -> ?B => (simplify_type A; try simplify_type_eq) || (simplify_type B; try simplify_type_eq) end with simplify_type_eq := match goal with | |- ?A = ?B => try simplify_type A; try simplify_type B end. .. coqtop:: in Ltac len trm := match trm with | _ * ?B => let succ := len B in constr:(S succ) | _ => constr:(1) end. .. coqtop:: in Ltac assoc := repeat rewrite <- Ass. .. coqtop:: in Ltac solve_type_eq n := match goal with | |- ?A = ?A => reflexivity | |- ?A * ?B = ?A * ?C => apply Cons; let newn := len B in solve_type_eq newn | |- ?A * ?B = ?C => match eval compute in n with | 1 => fail | _ => pattern (A * B) at 1; rewrite Com; assoc; solve_type_eq (pred n) end end. .. coqtop:: in Ltac compare_structure := match goal with | |- ?A = ?B => let l1 := len A with l2 := len B in match eval compute in (l1 = l2) with | ?n = ?n => solve_type_eq n end end. .. coqtop:: in Ltac solve_iso := simplify_type_eq; compare_structure. The tactic to judge equalities modulo this axiomatization is shown above. The algorithm is quite simple. First types are simplified using axioms that can be oriented (this is done by ``simplify_type`` and ``simplify_type_eq``). The normal forms are sequences of Cartesian products without a Cartesian product in the left component. These normal forms are then compared modulo permutation of the components by the tactic ``compare_structure``. If they have the same length, the tactic ``solve_type_eq`` attempts to prove that the types are equal. The main tactic that puts all these components together is ``solve_iso``. Here are examples of what can be solved by ``solve_iso``. .. coqtop:: in Lemma solve_iso_ex1 : forall A B : Set, A * unit * B = B * (unit * A). Proof. intros; solve_iso. Qed. .. coqtop:: in Lemma solve_iso_ex2 : forall A B C : Set, (A * unit -> B * (C * unit)) = (A * unit -> (C -> unit) * C) * (unit -> A -> B). Proof. intros; solve_iso. Qed. Debugging |Ltac| tactics ------------------------ Backtraces ~~~~~~~~~~ .. flag:: Ltac Backtrace Setting this :term:`flag` displays a backtrace on Ltac failures that can be useful to find out what went wrong. It is disabled by default for performance reasons. Tracing execution ~~~~~~~~~~~~~~~~~ .. cmd:: Info @natural @ltac_expr Applies :token:`ltac_expr` and prints a trace of the tactics that were successfully applied, discarding branches that failed. :tacn:`idtac` tactics appear in the trace as comments containing the output. This command is valid only in proof mode. It accepts :ref:`goal-selectors`. The number :n:`@natural` is the unfolding level of tactics in the trace. At level 0, the trace contains a sequence of tactics in the actual script, at level 1, the trace will be the concatenation of the traces of these tactics, etc… .. example:: .. coqtop:: in reset Ltac t x := exists x; reflexivity. Goal exists n, n=0. .. coqtop:: all Info 0 t 1||t 0. .. coqtop:: in Undo. .. coqtop:: all Info 1 t 1||t 0. The trace produced by :cmd:`Info` tries its best to be a reparsable |Ltac| script, but this goal is not achievable in all generality. So some of the output traces will contain oddities. As an additional help for debugging, the trace produced by :cmd:`Info` contains (in comments) the messages produced by the :tacn:`idtac` tactical at the right position in the script. In particular, the calls to idtac in branches which failed are not printed. .. opt:: Info Level @natural This :term:`option` is an alternative to the :cmd:`Info` command. This will automatically print the same trace as :n:`Info @natural` at each tactic call. The unfolding level can be overridden by a call to the :cmd:`Info` command. .. _interactive-debugger: Interactive debugger ~~~~~~~~~~~~~~~~~~~~ .. flag:: Ltac Debug This flag, when set, enables the step-by-step debugger in the |Ltac| interpreter. The debugger is supported in `coqtop` and Proof General by printing information on the console and accepting typed commands. In addition, CoqIDE now supports a :ref:`visual debugger ` with additional capabilities. When the debugger is activated in `coqtop`, it stops at every step of the evaluation of the current |Ltac| expression and prints information on what it is doing. The debugger stops, prompting for a command which can be one of the following: +-----------------+-----------------------------------------------+ | newline | go to the next step | +-----------------+-----------------------------------------------+ | h | get help | +-----------------+-----------------------------------------------+ | r n | advance n steps further | +-----------------+-----------------------------------------------+ | r string | advance up to the next call to “idtac string” | +-----------------+-----------------------------------------------+ | s | continue current evaluation without stopping | +-----------------+-----------------------------------------------+ | x | exit current evaluation | +-----------------+-----------------------------------------------+ .. exn:: Debug mode not available in the IDE :undocumented: A non-interactive mode for the debugger is available via the flag: .. flag:: Ltac Batch Debug This flag has the effect of presenting a newline at every prompt, when the debugger is on in `coqtop`. (It has no effect when running the CoqIDE debugger.) The debug log thus created, which does not require user input to generate when this flag is set, can then be run through external tools such as diff. .. todo: maybe drop Debug .. cmd:: Debug {| On | Off } Equivalent to :n:`Set Ltac Debug` or :n:`Unset Ltac Debug`. Profiling |Ltac| tactics ~~~~~~~~~~~~~~~~~~~~~~~~ It is possible to measure the time spent in invocations of primitive tactics as well as tactics defined in |Ltac| and their inner invocations. The primary use is the development of complex tactics, which can sometimes be so slow as to impede interactive usage. The reasons for the performance degradation can be intricate, like a slowly performing |Ltac| match or a sub-tactic whose performance only degrades in certain situations. The profiler generates a call tree and indicates the time spent in a tactic depending on its calling context. Thus it allows to locate the part of a tactic definition that contains the performance issue. .. flag:: Ltac Profiling This :term:`flag` enables and disables the profiler. .. cmd:: Show Ltac Profile {? {| CutOff @integer | @string } } Prints the profile. :n:`CutOff @integer` By default, tactics that account for less than 2% of the total time are not displayed. `CutOff` lets you specify a different percentage. :n:`@string` Limits the profile to all tactics that start with :n:`@string`. Append a period (.) to the string if you only want exactly that name. .. cmd:: Reset Ltac Profile Resets the profile, that is, deletes all accumulated information. .. warning:: Backtracking across a :cmd:`Reset Ltac Profile` will not restore the information. .. coqtop:: reset in Require Import Lia. Ltac mytauto := tauto. Ltac tac := intros; repeat split; lia || mytauto. Notation max x y := (x + (y - x)) (only parsing). Goal forall x y z A B C D E F G H I J K L M N O P Q R S T U V W X Y Z, max x (max y z) = max (max x y) z /\ max x (max y z) = max (max x y) z /\ (A /\ B /\ C /\ D /\ E /\ F /\ G /\ H /\ I /\ J /\ K /\ L /\ M /\ N /\ O /\ P /\ Q /\ R /\ S /\ T /\ U /\ V /\ W /\ X /\ Y /\ Z -> Z /\ Y /\ X /\ W /\ V /\ U /\ T /\ S /\ R /\ Q /\ P /\ O /\ N /\ M /\ L /\ K /\ J /\ I /\ H /\ G /\ F /\ E /\ D /\ C /\ B /\ A). Proof. .. coqtop:: all Set Ltac Profiling. tac. Show Ltac Profile. Show Ltac Profile "lia". .. coqtop:: in Abort. Unset Ltac Profiling. .. tacn:: start ltac profiling This tactic behaves like :tacn:`idtac` but enables the profiler. .. tacn:: stop ltac profiling Similarly to :tacn:`start ltac profiling`, this tactic behaves like :tacn:`idtac`. Together, they allow you to exclude parts of a proof script from profiling. .. tacn:: reset ltac profile Equivalent to the :cmd:`Reset Ltac Profile` command, which allows resetting the profile from tactic scripts for benchmarking purposes. .. tacn:: show ltac profile {? {| cutoff @integer | @string } } Equivalent to the :cmd:`Show Ltac Profile` command, which allows displaying the profile from tactic scripts for benchmarking purposes. .. warn:: Ltac Profiler encountered an invalid stack (no \ self node). This can happen if you reset the profile during \ tactic execution Currently, :tacn:`reset ltac profile` is not very well-supported, as it clears all profiling information about all tactics, including ones above the current tactic. As a result, the profiler has trouble understanding where it is in tactic execution. This mixes especially poorly with backtracking into multi-success tactics. In general, non-top-level calls to :tacn:`reset ltac profile` should be avoided. You can also pass the ``-profile-ltac`` command line option to ``coqc``, which turns the :flag:`Ltac Profiling` flag on at the beginning of each document, and performs a :cmd:`Show Ltac Profile` at the end. Run-time optimization tactic ~~~~~~~~~~~~~~~~~~~~~~~~~~~~ .. tacn:: optimize_heap This tactic behaves like :tacn:`idtac`, except that running it compacts the heap in the OCaml run-time system. It is analogous to the :cmd:`Optimize Heap` command. .. cmd:: infoH @ltac_expr Used internally by Proof General. See `#12423 `_ for some background. coq-8.20.0/doc/sphinx/proof-engine/ltac2.rst000066400000000000000000002113311466560755400206130ustar00rootroot00000000000000.. _ltac2: Ltac2 ===== .. _ltac2_design: General design -------------- There are various alternatives to Ltac1, such as Mtac or Rtac for instance. While those alternatives can be quite different from Ltac1, we designed Ltac2 to be as close as reasonably possible to Ltac1, while fixing its :ref:`defects `. In particular, Ltac2 is: - a member of the ML family of languages, i.e. * a call-by-value functional language * with effects * together with the Hindley-Milner type system - a language featuring meta-programming facilities for the manipulation of 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. ML component ------------ Overview ~~~~~~~~ Ltac2 is a member of the ML family of languages, in the sense that it is an effectful call-by-value functional language, with static typing à la Hindley-Milner (see :cite:`MilnerPrincipalTypeSchemes`). It is commonly accepted 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 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. 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 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 provided with an ill-typed term. The language is naturally effectful as it manipulates the global state of the proof engine. This allows to think of proof-modifying primitives as effects in a straightforward way. Semantically, proof manipulation lives in a monad, which allows to ensure that Ltac2 satisfies the same equations as a generic ML with unspecified effects would do, e.g. function reduction is substitution by a value. Use the following command to import Ltac2: .. coqtop:: in From Ltac2 Require Import Ltac2. 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. .. insertprodn ltac2_type ltac2_typevar .. prodn:: ltac2_type ::= @ltac2_type2 -> @ltac2_type | @ltac2_type2 ltac2_type2 ::= @ltac2_type1 * {+* @ltac2_type1 } | @ltac2_type1 ltac2_type1 ::= @ltac2_type0 @qualid | @ltac2_type0 ltac2_type0 ::= ( {+, @ltac2_type } ) {? @qualid } | @ltac2_typevar | _ | @qualid ltac2_typevar ::= ' @ident The set of base types can be extended thanks to the usual ML type declarations such as algebraic datatypes and records. Built-in types include: - ``int``, machine integers (size not specified, in practice inherited from OCaml) - ``string``, mutable strings - ``'a array``, mutable arrays - ``exn``, exceptions - ``constr``, kernel-side terms - ``pattern``, term patterns - ``ident``, well-formed identifiers Type declarations ~~~~~~~~~~~~~~~~~ One can define new types with the following commands. .. cmd:: Ltac2 Type {? rec } @tac2typ_def {* with @tac2typ_def } .. insertprodn tac2typ_def tac2rec_field .. prodn:: tac2typ_def ::= {? @tac2typ_prm } @qualid {? {| := | ::= } @tac2typ_knd } tac2typ_prm ::= @ltac2_typevar | ( {+, @ltac2_typevar } ) tac2typ_knd ::= @ltac2_type | [ {? {? %| } {+| @tac2alg_constructor } } ] | [ .. ] | %{ {? {+; @tac2rec_field } {? ; } } %} tac2alg_constructor ::= @ident | @ident ( {*, @ltac2_type } ) tac2rec_field ::= {? mutable } @ident : @ltac2_type :n:`:=` Defines a type with an explicit set of constructors :n:`::=` Extends an existing open variant type, a special kind of variant type whose constructors are not statically defined, but can instead be extended dynamically. A typical example is the standard `exn` type for exceptions. Pattern matching on open variants must always include a catch-all clause. They can be extended with this form, in which case :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 end users. :n:`with @tac2typ_def` Permits definition of mutually recursive type definitions. Each production of :token:`tac2typ_knd` defines one of four possible kinds of definitions, respectively: alias, variant, open variant and record types. Aliases are names for a given type expression and are transparently unfoldable to that expression. They cannot be recursive. .. The non-terminal :token:`uident` designates identifiers starting with an uppercase. Variants are sum types defined by constructors and eliminated by pattern-matching. They can be recursive, but the `rec` flag must be explicitly set. Pattern matching must be exhaustive. Open variants can be extended with additional constructors using the `::=` form. Records are product types with named fields and eliminated by projection. Likewise they can be recursive if the `rec` flag is set. .. attr:: abstract :name: abstract Types declared with this attribute are made abstract at the end of the current module. This makes it possible to enforce invariants. .. example:: .. coqtop:: in Module PositiveInt. #[abstract] Ltac2 Type t := int. Ltac2 make (x:int) : t := if Int.le 0 x then x else Control.throw (Invalid_argument None). Ltac2 get (x:t) : int := x. End PositiveInt. .. coqtop:: all Ltac2 Eval PositiveInt.get (PositiveInt.make 3). Fail Ltac2 Eval PositiveInt.get (PositiveInt.make -1). .. cmd:: Ltac2 @ external @ident : @ltac2_type := @string__plugin @string__function :name: Ltac2 external Declares functions defined in OCaml. :n:`@string__plugin` is the plugin name defining the function. :n:`@string__function` is the internal name of the function. This command supports the :attr:`deprecated` attribute. APIs ~~~~ Ltac2 provides over 150 API functions that provide various capabilities. These are declared with :cmd:`Ltac2 external` in :n:`lib/coq/user-contrib/Ltac2/*.v`. For example, `Message.print` defined in `Message.v` is used to print messages: .. coqtop:: none Goal True. .. coqtop:: all abort Message.print (Message.of_string "fully qualified calls"). From Ltac2 Require Import Message. print (of_string "unqualified calls"). Term Syntax ~~~~~~~~~~~ The syntax of the functional fragment is very close to that of Ltac1, except that it adds a true pattern-matching feature, as well as a few standard constructs from ML. In practice, there is some additional syntactic sugar that allows the user to bind a variable and match on it at the same time, in the usual ML style. There is dedicated syntax for list and array literals. .. insertprodn ltac2_expr ltac2_atom .. prodn:: ltac2_expr ::= @ltac2_expr5 ; @ltac2_expr | @ltac2_expr5 ltac2_expr5 ::= fun {+ @tac2pat0 } {? : @ltac2_type } => @ltac2_expr | let {? rec } @ltac2_let_clause {* with @ltac2_let_clause } in @ltac2_expr | @ltac2_expr3 ltac2_let_clause ::= {+ @tac2pat0 } {? : @ltac2_type } := @ltac2_expr ltac2_expr3 ::= {+, @ltac2_expr2 } ltac2_expr2 ::= @ltac2_expr1 :: @ltac2_expr2 | @ltac2_expr1 ltac2_expr1 ::= @ltac2_expr0 {+ @ltac2_expr0 } | @ltac2_expr0 .( @qualid ) | @ltac2_expr0 .( @qualid ) := @ltac2_expr5 | @ltac2_expr0 tac2rec_fieldexpr ::= @qualid {? := @ltac2_expr1 } ltac2_expr0 ::= ( @ltac2_expr ) | ( @ltac2_expr : @ltac2_type ) | () | [ %| {*; @ltac2_expr5 } %| ] | [ {*; @ltac2_expr5 } ] | %{ @ltac2_expr0 with {? {+; @tac2rec_fieldexpr } {? ; } } %} | %{ {? {+; @tac2rec_fieldexpr } {? ; } } %} | @ltac2_atom tac2rec_fieldpats ::= @tac2rec_fieldpat ; {? @tac2rec_fieldpats } | @tac2rec_fieldpat ; | @tac2rec_fieldpat tac2rec_fieldpat ::= @qualid {? := @tac2pat1 } ltac2_atom ::= @integer | @string | @qualid | @ @ident | & @ident | ' @term | @ltac2_quotations The non-terminal :production:`lident` designates identifiers starting with a lowercase letter. :n:`'@term` is equivalent to :n:`open_constr:(@term)`. Use :n:`@ltac2_expr0 .( @qualid )` to access record fields and :n:`@ltac2_expr0 .( @qualid ) := @ltac2_expr5` to modify mutable record fields. Record expressions and patterns support "punning": in :n:`@tac2rec_fieldexpr` and :n:`@tac2rec_fieldpat`, omitting the optional part is equivalent to using :n:`:= @ident` where the identifier is the identifier part of the field name (i.e. the :n:`@qualid`). A record value can be built from another by changing only a subset of its fields with the syntax :n:`%{ @ltac2_expr0 with {? {+; @qualid := @ltac2_expr1 } {? ; } } %}`. Fields that are not explicitly assigned a value take their value from :n:`@ltac2_expr0`. Ltac2 Definitions ~~~~~~~~~~~~~~~~~ .. cmd:: Ltac2 {? mutable } {? rec } @tac2def_body {* with @tac2def_body } .. insertprodn tac2def_body tac2def_body .. prodn:: tac2def_body ::= {| _ | @ident } {* @tac2pat0 } {? : @ltac2_type } := @ltac2_expr This command defines a new global Ltac2 value. If one or more :token:`tac2pat0` are specified, the new value is a function. This is a shortcut for one of the :token:`ltac2_expr5` productions. For example: :n:`Ltac2 foo a b := …` is equivalent to :n:`Ltac2 foo := fun a b => …`. The body of an Ltac2 definition is required to be a syntactical value that is, a function, a constant, a pure constructor recursively applied to values or a (non-recursive) let binding of a value in a value. If ``rec`` is set, the tactic is expanded into a recursive binding. If ``mutable`` is set, the definition can be redefined at a later stage (see below). This command supports the :attr:`deprecated` attribute. .. cmd:: Ltac2 Set @qualid {? as @ident } := @ltac2_expr This command redefines a previous ``mutable`` definition. Mutable definitions act like dynamic binding, i.e. at runtime, the last defined value for this entry is chosen. This is useful for global flags and the like. The previous value of the binding can be optionally accessed using the `as` binding syntax. The effect of this command is limited to the current section or module. When not in a section, importing the module containing this command applies the redefinition again. In other words it acts according to :attr:`local` in sections and :attr:`export` otherwise (but explicit locality is not supported). .. example:: Dynamic nature of mutable cells .. coqtop:: all Ltac2 mutable x := true. Ltac2 y () := x. Ltac2 Eval y (). Ltac2 Set x := false. Ltac2 Eval y (). .. example:: Interaction with recursive calls .. coqtop:: all Ltac2 mutable rec f b := if b then 0 else f true. Ltac2 Set f := fun b => if b then 1 else f true. Ltac2 Eval (f false). Ltac2 Set f as oldf := fun b => if b then 2 else oldf false. Ltac2 Eval (f false). In the definition, the `f` in the body is resolved statically because the definition is marked recursive. It is equivalent to `Ltac2 mutable f x := let rec g b := if b then 0 else g true in g x` (alpha renaming the internal `f` to `g` to make the behavior clearer). In the first re-definition, the `f` in the body is resolved dynamically. This is witnessed by the second re-definition. Printing Ltac2 tactics ~~~~~~~~~~~~~~~~~~~~~~ .. cmd:: Print Ltac2 @qualid :cmd:`Print` can print defined Ltac2 tactics and can avoid printing other objects by using `Print Ltac2`. .. cmd:: Print Ltac2 Type @qualid Prints the definitions of ltac2 types. .. cmd:: Ltac2 Globalize @ltac2_expr Prints the result of resolving notations in the given expression. .. cmd:: Ltac2 Check @ltac2_expr Typechecks the given expression and prints the result. .. cmd:: Print Ltac2 Signatures This command displays a list of all defined tactics in scope with their types. 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, if ever we implement native compilation. The expected equations are as follows:: (fun x => t) V ≡ t{x := V} (βv) let x := V in t ≡ t{x := V} (let) match C V₀ ... Vₙ with ... | C x₀ ... xₙ => t | ... end ≡ t {xᵢ := Vᵢ} (ι) (t any term, V values, C constructor) Note that call-by-value reduction is already a departure from Ltac1 which uses heuristics to decide when to evaluate an expression. For instance, the following expressions do not evaluate the same way in Ltac1. :n:`foo (idtac; let x := 0 in bar)` :n:`foo (let x := 0 in bar)` Instead of relying on the :n:`idtac` idiom, we would now require an explicit thunk to not compute the argument, and :n:`foo` would have e.g. type :n:`(unit -> unit) -> unit`. :n:`foo (fun () => let x := 0 in bar)` Typing ~~~~~~ Typing is strict and follows the Hindley-Milner system. Unlike Ltac1, there are no type casts at runtime, and one has to resort to conversion functions. See notations though to make things more palatable. In this setting, all the usual argument-free tactics have type :n:`unit -> unit`, but one can return a value of type :n:`t` thanks to terms of type :n:`unit -> t`, or take additional arguments. Effects ~~~~~~~ Effects in Ltac2 are straightforward, except that instead of using the standard IO monad as the ambient effectful world, Ltac2 has a tactic monad. Note that the order of evaluation of application is *not* specified and is 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. Intuitively a thunk of type :n:`unit -> 'a` can do the following: - It can perform non-backtracking IO like printing and setting mutable variables - It can fail in a non-recoverable way - It can use first-class backtracking. One way to think about this is that thunks are isomorphic to this type: :n:`(unit -> 'a) ~ (unit -> exn + ('a * (exn -> 'a)))` i.e. thunks can produce a lazy list of results where each tail is waiting for a continuation exception. - It can access a backtracking proof state, consisting among other things of the current evar assignment and the list of goals under focus. We now describe more thoroughly the various effects in Ltac2. Standard IO +++++++++++ The Ltac2 language features non-backtracking IO, notably mutable data and printing operations. Mutable fields of records and built-in types like `string` and `array` feature imperative assignment. See modules `String` and `Array` respectively. A few printing primitives are provided in the `Message` module for displaying information to the user. Fatal errors ++++++++++++ The Ltac2 language provides non-backtracking exceptions, also known as *panics*, through the following primitive in module `Control`:: val throw : exn -> 'a Unlike backtracking exceptions from the next section, this kind of error is never caught by backtracking primitives, that is, throwing an exception destroys the stack. This is codified by the following equation, where `E` is an evaluation context:: E[throw e] ≡ throw e (e value) There is currently no way to catch such an exception, which is a deliberate design choice. Eventually there might be a way to catch it and destroy all backtrack and return values. Backtracking ++++++++++++ In Ltac2, we have the following backtracking primitives, defined in the `Control` module:: Ltac2 Type 'a result := [ Val ('a) | Err (exn) ]. val zero : exn -> 'a val plus : (unit -> 'a) -> (exn -> 'a) -> 'a val case : (unit -> 'a) -> ('a * (exn -> 'a)) result If one views thunks as lazy lists, then `zero` is the empty list and `plus` is list concatenation, while `case` is pattern-matching. The backtracking is first-class, i.e. one can write :n:`plus (fun () => "x") (fun _ => "y") : string` producing a backtracking string. These operations are expected to satisfy a few equations, most notably that they form a monoid compatible with sequentialization.:: plus t zero ≡ t () plus (fun () => zero e) f ≡ f e plus (plus t f) g ≡ plus t (fun e => plus (f e) g) case (fun () => zero e) ≡ Err e case (fun () => plus (fun () => t) f) ≡ Val (t,f) let x := zero e in u ≡ zero e let x := plus t f in u ≡ plus (fun () => let x := t in u) (fun e => let x := f e in u) (t, u, f, g, e values) Goals +++++ A goal is given by the data of its conclusion and hypotheses, i.e. it can be represented as `[Γ ⊢ A]`. The tactic monad naturally operates over the whole proofview, which may represent several goals, including none. Thus, there is no such thing as *the current goal*. Goals are naturally ordered, though. It is natural to do the same in Ltac2, but we must provide a way to get access to a given goal. This is the role of the `enter` primitive, which applies a tactic to each currently focused goal in turn:: val enter : (unit -> unit) -> unit It is guaranteed that when evaluating `enter f`, `f` is called with exactly one goal under focus. Note that `f` may be called several times, or never, depending on the number of goals under focus before the call to `enter`. Accessing the goal data is then implicit in the Ltac2 primitives, and may panic if the invariants are not respected. The two essential functions for observing goals are given below.:: val hyp : ident -> constr val goal : unit -> constr The two above functions panic if there is not exactly one goal under focus. In addition, `hyp` may also fail if there is no hypothesis with the corresponding name. Meta-programming ---------------- Overview ~~~~~~~~ One of the major implementation issues of Ltac1 is the fact that it is never clear whether an object refers to the object world or the meta-world. This is an incredible source of slowness, as the interpretation must be 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 :g:`Datatypes.O`. The implicit parsing is confusing to users and often gives unexpected results. Ltac2 makes these explicit using quoting and unquoting notation, although there are notations to do it in a short and elegant way so as not to be too cumbersome to the user. Quotations ~~~~~~~~~~ .. _ltac2_built-in-quotations: Built-in quotations +++++++++++++++++++ .. insertprodn ltac2_quotations ltac1_expr_in_env .. prodn:: ltac2_quotations ::= ident : ( @ident ) | constr : ( @term ) | open_constr : ( @term ) | preterm : ( @term ) | pat : ( @cpattern ) | reference : ( {| & @ident | @qualid } ) | ltac1 : ( @ltac1_expr_in_env ) | ltac1val : ( @ltac1_expr_in_env ) ltac1_expr_in_env ::= @ltac_expr | {* @ident } %|- @ltac_expr 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 (type ``Init.constr``). - ``open_constr``, which parses Coq terms and produces a term potentially with holes at runtime (type ``Init.constr`` as well). - ``preterm``, which parses Coq terms and produces a value which must be typechecked with ``Constr.pretype`` (type ``Init.preterm``). - ``pat``, 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, while ``&id`` is turned into ``Std.VarRef id``. This produces at runtime a ``Std.reference``. - ``ltac1``, for calling Ltac1 code, described in :ref:`simple_api`. - ``ltac1val``, for manipulating Ltac1 values, described in :ref:`low_level_api`. The following syntactic sugar is provided for two common cases: - ``@id`` is the same as ``ident:(id)`` - :n:`'@term` is the same as :n:`open_constr:(@term)` Strict vs. non-strict mode ++++++++++++++++++++++++++ Depending on the context, quotation-producing terms (i.e. ``constr``, ``open_constr`` or ``preterm``) are not internalized in the same way. There are two possible modes, the *strict* and the *non-strict* mode. - In strict mode, all simple identifiers appearing in a term quotation are required to be resolvable statically. That is, they must be the short name of a declaration which is defined globally, excluding section variables and hypotheses. If this doesn't hold, internalization will fail. To work around this error, one has to specifically use the ``&`` notation. - In non-strict mode, any simple identifier appearing in a term quotation which is not bound in the global environment is turned into a dynamic reference to a hypothesis. That is to say, internalization will succeed, but the evaluation of the term at runtime will fail if there is no such variable in the dynamic context. Strict mode is enforced by default, such as for all Ltac2 definitions. Non-strict mode is only set when evaluating Ltac2 snippets in interactive proof mode. The rationale is that it is cumbersome to explicitly add ``&`` interactively, while it is expected that global tactics enforce more invariants on their code. .. _term-antiquotations: Term Antiquotations ~~~~~~~~~~~~~~~~~~~ Syntax ++++++ One can also insert Ltac2 code into Coq terms, similar to what is possible in Ltac1. .. prodn:: term += ltac2:( @ltac2_expr ) Antiquoted terms are expected to have type ``unit``, as they are only evaluated for their side-effects. Semantics +++++++++ 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 typing time. - 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 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 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. .. example:: The following term is valid (with type `unit -> constr`), but will fail at runtime: .. coqtop:: in Ltac2 myconstr () := constr:(nat -> 0). Term antiquotations are type checked in the enclosing Ltac2 typing context of the corresponding term expression. .. example:: The following will type check, with type `constr`. .. coqdoc:: 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. .. example:: The following Ltac2 expression will **not** type check:: `constr:(fun x : nat => ltac2:(exact $x))` `(* Error: Unbound variable 'x' *)` There is a simple reason for that, which is that the following expression would not make sense in general. `constr:(fun x : nat => ltac2:(clear @x; exact x))` Indeed, a hypothesis can suddenly disappear from the runtime context if some other tactic pulls the rug from under you. Rather, the tactic writer has to resort to the **dynamic** goal environment, and must write instead explicitly that she is accessing a hypothesis, typically as follows. `constr:(fun x : nat => ltac2:(exact (hyp @x)))` 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 `ltac2:(Control.refine (fun () => hyp @x))`. 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 current context using the `Ltac2.Constr.pretype` function. .. example:: The following notation is essentially the identity. .. coqtop:: in Notation "[ x ]" := ltac2:(let x := Ltac2.Constr.pretype x in exact $x) (only parsing). Dynamic semantics ***************** During evaluation, a quoted term is fully evaluated to a kernel term, and is in particular type checked in the current environment. Evaluation of a quoted term goes as follows. - The quoted term is first evaluated by the pretyper. - Antiquotations are then evaluated in a context where there is exactly one goal under focus, with the hypotheses coming from the current environment extended with the bound variables of the term, and the resulting term is fed into the quoted term. Relative orders of evaluation of antiquotations and quoted term are not specified. For instance, in the following example, `tac` will be evaluated in a context with exactly one goal under focus, whose last hypothesis is `H : nat`. The whole expression will thus evaluate to the term :g:`fun H : nat => H`. `let tac () := hyp @H in constr:(fun H : nat => ltac2:(tac ()))` Many standard tactics perform type checking of their argument before going further. It is your duty to ensure that terms are well-typed when calling such tactics. Failure to do so will result in non-recoverable exceptions. **Trivial Term Antiquotations** It is possible to refer to a variable of type `constr` in the Ltac2 environment through a specific syntax consistent with the antiquotations presented in the notation section. .. prodn:: term += $@lident or equivalently .. prodn:: term += $constr:@lident 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. Similarly variables of type `preterm` have an antiquotation .. prodn:: term += $preterm:@lident It is equivalent to pretyping the preterm with the appropriate typing constraint. Variables of type `pattern` have an antiquotation .. prodn:: term += $pattern:@lident Its use is only allowed when producing a pattern, i.e. `pattern:($pattern:x -> True)` is allowed but `constr:($pattern:x -> True)` is not allowed. Conversely `constr` and `preterm` antiquotations are not allowed when producing a pattern. Match over terms ~~~~~~~~~~~~~~~~ Ltac2 features a construction similar to Ltac1 :tacn:`match` over terms, although in a less hard-wired way. .. tacn:: @ltac2_match_key @ltac2_expr__term with @ltac2_match_list end :name: lazy_match!; match!; multi_match! .. insertprodn ltac2_match_key ltac2_match_pattern .. prodn:: ltac2_match_key ::= lazy_match! | match! | multi_match! ltac2_match_list ::= {? %| } {+| @ltac2_match_rule } ltac2_match_rule ::= @ltac2_match_pattern => @ltac2_expr ltac2_match_pattern ::= @cpattern | context {? @ident } [ @cpattern ] Evaluates :n:`@ltac2_expr__term`, which must yield a term, and matches it sequentially with the :token:`ltac2_match_pattern`\s, which may contain metavariables. When a match is found, metavariable values are substituted into :n:`@ltac2_expr`, which is then applied. Matching may continue depending on whether `lazy_match!`, `match!` or `multi_match!` is specified. In the :token:`ltac2_match_pattern`\s, metavariables have the form :n:`?@ident`, whereas in the :n:`@ltac2_expr`\s, the question mark is omitted. .. todo how does this differ from the 1-2 other unification routines elsewhere in Coq? Matching is non-linear: if a metavariable occurs more than once, each occurrence must match the same expression. Expressions match if they are syntactically equal or are :term:`α-convertible `. Matching is first-order except on variables of the form :n:`@?@ident` that occur in the head position of an application. For these variables, matching is second-order and returns a functional term. .. todo the `@?ident` form is in dangling_pattern_extension_rule, not included in the doc yet maybe belongs with "Applications" `lazy_match!` Causes the match to commit to the first matching branch rather than trying a new match if :n:`@ltac2_expr` fails. :ref:`Example`. `match!` If :n:`@ltac2_expr` fails, continue matching with the next branch. Failures in subsequent tactics (after the `match!`) will not cause selection of a new branch. Examples :ref:`here` and :ref:`here`. `multi_match!` If :n:`@ltac2_expr` fails, continue matching with the next branch. When a :n:`@ltac2_expr` succeeds for a branch, subsequent failures (after the `multi_match!`) causing consumption of all the successes of :n:`@ltac2_expr` trigger selection of a new matching branch. :ref:`Example`. :n:`@cpattern` The syntax of :token:`cpattern` is the same as that of :token:`term`\s, but it can contain pattern matching metavariables in the form :n:`?@ident` and :n:`@?@ident`. :g:`_` can be used to match irrelevant terms. .. todo more on @?@ident here: https://github.com/coq/coq/pull/12085#discussion_r467504046 .. todo Example is broken :ref:`Example`. .. todo Didn't understand the following 2 paragraphs well enough to revise see https://github.com/coq/coq/pull/12103#discussion_r436297754 for a possible example Unlike Ltac1, Ltac2 :n:`?id` metavariables only match closed terms. There is also a special notation for second-order pattern matching: in an applicative pattern of the form :n:`@?@ident @ident__1 … @ident__n`, the variable :token:`ident` matches any complex expression with (possible) dependencies in the variables :n:`@ident__i` and returns a functional term of the form :n:`fun @ident__1 … @ident__n => @term`. :n:`context {? @ident } [ @cpattern ]` Matches any term with a subterm matching :token:`cpattern`. If there is a match and :n:`@ident` is present, it is assigned the "matched context", i.e. the initial term where the matched subterm is replaced by a hole. This hole in the matched context can be filled with the expression :n:`Pattern.instantiate @ident @cpattern`. For :tacn:`match!` and :tacn:`multi_match!`, if the evaluation of the :token:`ltac2_expr` fails, the next matching subterm is tried. If no further subterm matches, the next branch is tried. Matching subterms are considered from top to bottom and from left to right (with respect to the raw printing obtained by setting the :flag:`Printing All` flag). :ref:`Example`. .. todo There's a more realistic example from @JasonGross here: https://github.com/coq/coq/pull/12103#discussion_r432996954 :n:`@ltac2_expr` The tactic to apply if the construct matches. Metavariable values from the pattern match are statically bound as Ltac2 variables in :n:`@ltac2_expr` before it is applied. If :n:`@ltac2_expr` is a tactic with backtracking points, then subsequent failures after a :tacn:`lazy_match!` or :tacn:`multi_match!` (but not :tacn:`match!`) can cause backtracking into :n:`@ltac2_expr` to select its next success. Variables from the :n:`@tac2pat1` are statically bound in the body of the branch. Variables from the :n:`@term` pattern have values of type `constr`. Variables from the :n:`@ident` in the `context` construct have values of type `Pattern.context` (defined in `Pattern.v`). Note that unlike Ltac1, only lowercase identifiers are valid as Ltac2 bindings. Ltac2 will report an error if one of the bound variables starts with an uppercase character. The semantics of this construction are otherwise the same as the corresponding one from Ltac1, except that it requires the goal to be focused. .. _ltac2_match_vs_lazymatch_ex: .. example:: Ltac2 Comparison of lazy_match! and match! (Equivalent to this :ref:`Ltac1 example`.) These lines define a `msg` tactic that's used in several examples as a more-succinct alternative to `print (to_string "...")`: .. coqtop:: in From Ltac2 Require Import Message. Ltac2 msg x := print (of_string x). .. coqtop:: none Goal True. In :tacn:`lazy_match!`, if :token:`ltac2_expr` fails, the :tacn:`lazy_match!` fails; it doesn't look for further matches. In :tacn:`match!`, if :token:`ltac2_expr` fails in a matching branch, it will try to match on subsequent branches. Note that :n:`'@term` below is equivalent to :n:`open_constr:(@term)`. .. coqtop:: all Fail lazy_match! 'True with | True => msg "branch 1"; fail | _ => msg "branch 2" end. match! 'True with | True => msg "branch 1"; fail | _ => msg "branch 2" end. .. _ltac2_match_vs_multimatch_ex: .. example:: Ltac2 Comparison of match! and multi_match! (Equivalent to this :ref:`Ltac1 example`.) :tacn:`match!` tactics are only evaluated once, whereas :tacn:`multi_match!` tactics may be evaluated more than once if the following constructs trigger backtracking: .. coqtop:: all Fail match! 'True with | True => msg "branch 1" | _ => msg "branch 2" end ; msg "branch A"; fail. .. coqtop:: all Fail multi_match! 'True with | True => msg "branch 1" | _ => msg "branch 2" end ; msg "branch A"; fail. .. _ltac2_match_with_holes_ex: .. todo EXAMPLE DOESN'T WORK: Ltac2 does not (yet?) handle pattern variables matching open terms. Matching a pattern with holes (Equivalent to this :ref:`Ltac1 example`.) Notice the :tacn:`idtac` prints ``(z + 1)`` while the :tacn:`pose` substitutes ``(x + 1)``. .. coqtop:: all match! constr:(fun x => (x + 1) * 3) with | fun z => ?y * 3 => print (of_constr y); pose (fun z: nat => $y * 5) end. .. _ltac2_match_term_context_ex: .. example:: Ltac2 Multiple matches for a "context" pattern. (Equivalent to this :ref:`Ltac1 example`.) Internally "x <> y" is represented as "(~ (x = y))", which produces the first match. .. coqtop:: in Ltac2 f2 t := match! t with | context [ (~ ?t) ] => print (of_constr t); fail | _ => () end. .. coqtop:: all abort f2 constr:((~ True) <> (~ False)). Match over goals ~~~~~~~~~~~~~~~~ .. tacn:: @ltac2_match_key {? reverse } goal with @goal_match_list end :name: lazy_match! goal; match! goal; multi_match! goal .. insertprodn goal_match_list gmatch_hyp_pattern .. prodn:: goal_match_list ::= {? %| } {+| @gmatch_rule } gmatch_rule ::= @gmatch_pattern => @ltac2_expr gmatch_pattern ::= [ {*, @gmatch_hyp_pattern } %|- @ltac2_match_pattern ] gmatch_hyp_pattern ::= @name : @ltac2_match_pattern | @name := [ @ltac2_match_pattern ] : @ltac2_match_pattern | @name := @ltac2_match_pattern Matches over goals, similar to Ltac1 :tacn:`match goal`. Use this form to match hypotheses and/or goals in the local context. These patterns have zero or more subpatterns to match hypotheses followed by a subpattern to match the conclusion. Except for the differences noted below, this works the same as the corresponding :n:`@ltac2_match_key @ltac2_expr` construct (see :tacn:`match!`). Each current goal is processed independently. Matching is non-linear: if a metavariable occurs more than once, each occurrence must match the same expression. Within a single term, expressions match if they are syntactically equal or :term:`α-convertible `. When a metavariable is used across multiple hypotheses or across a hypothesis and the current goal, the expressions match if they are :term:`convertible`. .. more detail here: https://github.com/coq/coq/pull/12085#discussion_r470406466 :n:`{*, @gmatch_pattern }` Patterns to match with hypotheses. Each pattern must match a distinct hypothesis in order for the branch to match. Hypotheses have the form :n:`@name {? := @term__binder } : @type`. If :n:`@term__binder` is not specified, the pattern matches hypotheses even if they have a body. .. currently only supports the first row :list-table:: :widths: 2 1 :header-rows: 1 * - Pattern syntax - Example pattern * - :n:`@name : @ltac2_match_pattern` - `n : ?t` * - :n:`@name := @match_pattern__binder` - `n := ?b` * - :n:`@name := @term__binder : @type` - `n := ?b : ?t` * - :n:`@name := [ @match_pattern__binder ] : @ltac2_match_pattern` - `n := [ ?b ] : ?t` :token:`name` can't have a `?`. Note that the last two forms are equivalent except that: - if the `:` in the third form has been bound to something else in a notation, you must use the fourth form. Note that cmd:`Require Import` `ssreflect` loads a notation that does this. - a :n:`@term__binder` such as `[ ?l ]` (e.g., denoting a singleton list after :cmd:`Import` `ListNotations`) must be parenthesized or, for the fourth form, use double brackets: `[ [ ?l ] ]`. If there are multiple :token:`gmatch_hyp_pattern`\s in a branch, there may be multiple ways to match them to hypotheses. For :tacn:`match! goal` and :tacn:`multi_match! goal`, if the evaluation of the :token:`ltac2_expr` fails, matching will continue with the next hypothesis combination. When those are exhausted, the next alternative from any `context` construct in the :token:`ltac2_match_pattern`\s is tried and then, when the context alternatives are exhausted, the next branch is tried. :ref:`Example`. `reverse` Hypothesis matching for :token:`gmatch_hyp_pattern`\s normally begins by matching them from left to right, to hypotheses, last to first. Specifying `reverse` begins matching in the reverse order, from first to last. :ref:`Normal` and :ref:`reverse` examples. :n:`|- @ltac2_match_pattern` A pattern to match with the current goal Note that unlike Ltac1, only lowercase identifiers are valid as Ltac2 bindings. Ltac2 will report an error if you try to use a bound variable that starts with an uppercase character. Variables from :n:`@gmatch_hyp_pattern` and :n:`@ltac2_match_pattern` are bound in the body of the branch. Their types are: - ``constr`` for pattern variables appearing in a :n:`@term` - ``Pattern.context`` for variables binding a context - ``ident`` for variables binding a hypothesis name. The same identifier caveat as in the case of matching over constr applies, and this feature has the same semantics as in Ltac1. .. _ltac2_match_goal_hyps_ex: .. example:: Ltac2 Matching hypotheses (Equivalent to this :ref:`Ltac1 example`.) Hypotheses are matched from the last hypothesis (which is by default the newest hypothesis) to the first until the :tacn:`apply` succeeds. .. coqtop:: all abort Goal forall A B : Prop, A -> B -> (A->B). intros. match! goal with | [ h : _ |- _ ] => let h := Control.hyp h in print (of_constr h); apply $h end. .. _ltac2_match_goal_hyps_rev_ex: .. example:: Matching hypotheses with reverse (Equivalent to this :ref:`Ltac1 example`.) Hypotheses are matched from the first hypothesis to the last until the :tacn:`apply` succeeds. .. coqtop:: all abort Goal forall A B : Prop, A -> B -> (A->B). intros. match! reverse goal with | [ h : _ |- _ ] => let h := Control.hyp h in print (of_constr h); apply $h end. .. _ltac2_match_goal_multiple_hyps_ex: .. example:: Multiple ways to match a hypotheses (Equivalent to this :ref:`Ltac1 example`.) Every possible match for the hypotheses is evaluated until the right-hand side succeeds. Note that `h1` and `h2` are never matched to the same hypothesis. Observe that the number of permutations can grow as the factorial of the number of hypotheses and hypothesis patterns. .. coqtop:: all abort Goal forall A B : Prop, A -> B -> (A->B). intros A B H. match! goal with | [ h1 : _, h2 : _ |- _ ] => print (concat (of_string "match ") (concat (of_constr (Control.hyp h1)) (concat (of_string " ") (of_constr (Control.hyp h2))))); fail | [ |- _ ] => () end. .. _ltac2_match_on_values: 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 as do the `*match*!` and `*match*! goal` constructs. .. insertprodn ltac2_branches atomic_tac2pat .. prodn:: ltac2_branches ::= {? %| } {+| {? @atomic_tac2pat } => @ltac2_expr } tac2pat1 ::= @qualid {+ @tac2pat0 } | @qualid | @tac2pat0 :: @tac2pat0 | @tac2pat0 %| {+| @tac2pat1 } | @tac2pat0 as @ident | @tac2pat0 tac2pat0 ::= _ | () | @integer | @string | @qualid | ( {? @atomic_tac2pat } ) | %{ {? @tac2rec_fieldpats } %} | [ {*; @tac2pat1 } ] atomic_tac2pat ::= @tac2pat1 : @ltac2_type | @tac2pat1 , {*, @tac2pat1 } | @tac2pat1 .. tacn:: if @ltac2_expr5__test then @ltac2_expr5__then else @ltac2_expr5__else :name: if-then-else (Ltac2) Equivalent to a :tacn:`match ` on a boolean value. If the :n:`@ltac2_expr5__test` evaluates to true, :n:`@ltac2_expr5__then` is evaluated. Otherwise :n:`@ltac2_expr5__else` is evaluated. .. _ltac2_notations: Notations --------- .. cmd:: Ltac2 Notation {+ @ltac2_scope } {? : @natural } := @ltac2_expr .. todo seems like name maybe should use lident rather than ident, considering: Ltac2 Notation "ex1" X(constr) := print (of_constr X). ex1 1. Unbound constructor X This works fine with lower-case "x" in place of "X" .. todo Ltac2 Notation := permits redefining same symbol (no warning) Also allows defining a symbol beginning with uppercase, which is prohibited in similar constructs. :cmd:`Ltac2 Notation` provides a way to extend the syntax of Ltac2 tactics. The left-hand side (before the `:=`) defines the syntax to recognize and gives formal parameter names for the syntactic values. :n:`@integer` is the level of the notation. When the notation is used, the values are substituted into the right-hand side. In the following example, `x` is the formal parameter name and `constr` is its :ref:`syntactic class`. `print` and `of_constr` are functions provided by Coq through `Message.v`. .. flag:: Ltac2 Typed Notations By default Ltac2 notations are typechecked at declaration time. This assigns an expected type to notation arguments. When a notation is declared with this flag unset, it is not typechecked at declaration time and its expansion is typechecked when it is used. This may allow slightly more flexible use of the notation arguments at the cost of worse error messages when incorrectly using the notation. It is not believed to be useful in practice, please report any real use cases you find. .. todo "print" doesn't seem to pay attention to "Set Printing All" .. example:: Printing a :n:`@term` .. coqtop:: none Goal True. .. coqtop:: all From Ltac2 Require Import Message. Ltac2 Notation "ex1" x(constr) := print (of_constr x). ex1 (1 + 2). You can also print terms with a regular Ltac2 definition, but then the :n:`@term` must be in the quotation `constr:( … )`: .. coqtop:: all Ltac2 ex2 x := print (of_constr x). ex2 constr:(1+2). There are also metasyntactic classes described :ref:`here` that combine other items. For example, `list1(constr, ",")` recognizes a comma-separated list of one or more :token:`term`\s. .. example:: Parsing a list of :n:`@term`\s .. coqtop:: abort all Ltac2 rec print_list x := match x with | a :: t => print (of_constr a); print_list t | [] => () end. Ltac2 Notation "ex2" x(list1(constr, ",")) := print_list x. ex2 1, 2, 3. An Ltac2 notation adds a parsing rule to the Ltac2 grammar, which is expanded to the provided body where every token from the notation is let-bound to the corresponding generated expression. .. example:: Assume we perform: .. coqdoc:: Ltac2 Notation "foo" c(thunk(constr)) ids(list0(ident)) := Bar.f c ids. Then the following expression `let y := @X in foo (nat -> nat) x $y` will expand at parsing time to `let y := @X in` `let c := fun () => constr:(nat -> nat) with ids := [@x; y] in Bar.f c ids` Beware that the order of evaluation of multiple let-bindings is not specified, so that you may have to resort to thunking to ensure that side-effects are performed at the right time. This command supports the :attr:`deprecated` attribute. .. exn:: Notation levels must range between 0 and 6. The level of a notation must be an integer between 0 and 6 inclusive. Abbreviations ~~~~~~~~~~~~~ .. cmd:: Ltac2 Notation {| @string | @ident } := @ltac2_expr :name: Ltac2 Notation (abbreviation) 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)`, 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. The abbreviation can then be manipulated just like a normal Ltac2 definition, except that it is expanded at internalization time into the given expression. Furthermore, in order to make this kind of construction useful in practice in an effectful language such as Ltac2, any syntactic argument to an abbreviation is thunked on-the-fly during its expansion. For instance, suppose that we define the following. :n:`Ltac2 Notation foo := fun x => x ().` Then we have the following expansion at internalization time. :n:`foo 0 ↦ (fun x => x ()) (fun _ => 0)` Note that abbreviations are not type checked at all, and may result in typing errors after expansion. This command supports the :attr:`deprecated` attribute. .. _defining_tactics: Defining 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`. Notations for many but not all built-in tactics are defined in `Notations.v`, which is automatically loaded with Ltac2. The Ltac2 syntax for these tactics is often identical or very similar to the tactic syntax described in other chapters of this documentation. These notations rely on tactic functions declared in `Std.v`. Functions corresponding to some built-in tactics may not yet be defined in the Coq executable or declared in `Std.v`. Adding them may require code changes to Coq or defining workarounds through Ltac1 (described below). Two examples of syntax differences: - There is no notation defined that's equivalent to :n:`intros until {| @ident | @natural }`. There is, however, already an ``intros_until`` tactic function defined ``Std.v``, so it may be possible for a user to add the necessary notation. - The built-in `simpl` tactic in Ltac1 supports the use of scope keys in delta flags, e.g. :n:`simpl ["+"%nat]` which is not accepted by Ltac2. This is because Ltac2 uses a different definition for :token:`delta_reductions`; compare it to :token:`ltac2_delta_reductions`. This also affects :tacn:`compute`. Ltac1 tactics are not automatically available in Ltac2. (Note that some of the tactics described in the documentation are defined with Ltac1.) You can make them accessible in Ltac2 with commands similar to the following: .. coqtop:: in From Coq Require Import Lia. Local Ltac2 lia_ltac1 () := ltac1:(lia). Ltac2 Notation "lia" := lia_ltac1 (). A similar approach can be used to access missing built-in tactics. See :ref:`simple_api` for an example that passes two parameters to a missing build-in tactic. .. _syntactic_classes: Syntactic classes ~~~~~~~~~~~~~~~~~ The simplest syntactic classes in Ltac2 notations represent individual nonterminals from the Coq grammar. Only a few selected nonterminals are available as syntactic classes. In addition, there are metasyntactic operations for describing more complex syntax, such as making an item optional or representing a list of items. When parsing, each syntactic class expression returns a value that's bound to a name in the notation definition. Syntactic classes are described with a form of S-expression: .. insertprodn ltac2_scope ltac2_scope .. prodn:: ltac2_scope ::= @string | @integer | @name | @name ( {+, @ltac2_scope } ) .. todo no syn class for ints or strings? parm names are not reserved (e.g the var can be named "list1") Metasyntactic operations that can be applied to other syntactic classes are: :n:`opt(@ltac2_scope)` Parses an optional :token:`ltac2_scope`. The associated value is either :n:`None` or enclosed in :n:`Some` :n:`list1(@ltac2_scope {? , @string })` Parses a list of one or more :token:`ltac2_scope`\s. If :token:`string` is specified, items must be separated by :token:`string`. :n:`list0(@ltac2_scope {? , @string })` Parses a list of zero or more :token:`ltac2_scope`\s. If :token:`string` is specified, items must be separated by :token:`string`. For zero items, the associated value is an empty list. :n:`seq({+, @ltac2_scope })` Parses the :token:`ltac2_scope`\s in order. The associated value is a tuple, omitting :token:`ltac2_scope`\s that are :token:`string`\s. `self` and `next` are not permitted within `seq`. The following classes represent nonterminals with some special handling. The table further down lists the classes that that are handled plainly. :n:`constr {? ( {+, @scope_key } ) }` Parses a :token:`term`. If specified, the :token:`scope_key`\s are used to interpret the term (as described in :ref:`LocalInterpretationRulesForNotations`). The last :token:`scope_key` is the top of the scope stack that's applied to the :token:`term`. :n:`open_constr {? ( {+, @scope_key } ) }` Parses an open :token:`term`. Like :n:`constr` above, this class accepts a list of notation scopes with the same effects. .. _preterm: :n:`preterm {? ( {+, @scope_key } ) }` Parses a non-typechecked :token:`term`. Like :n:`constr` above, this class accepts a list of notation scopes with the same effects. :n:`ident` Parses :token:`ident` or :n:`$@ident`. The first form returns :n:`ident:(@ident)`, while the latter form returns the variable :n:`@ident`. :n:`@string` Accepts the specified string that is not a keyword, returning a value of `()`. :n:`keyword(@string)` Accepts the specified string that is a keyword, returning a value of `()`. :n:`terminal(@string)` Accepts the specified string whether it's a keyword or not, returning a value of `()`. :n:`tactic {? (@integer) }` Parses an :token:`ltac2_expr`. If :token:`integer` is specified, the construct parses a :n:`ltac2_expr@integer`, for example `tactic(5)` parses :token:`ltac2_expr5`. `tactic(6)` parses :token:`ltac2_expr`. :token:`integer` must be in the range `0 .. 6`. You can also use `tactic` to accept an :token:`integer` or a :token:`string`, but there's no syntactic class that accepts *only* an :token:`integer` or a :token:`string`. .. todo this doesn't work as expected: "::" is in ltac2_expr1 Ltac2 Notation "ex4" x(tactic(0)) := x. ex4 auto :: [auto]. .. not sure "self" and "next" do anything special. I get the same error message for both from constructs like Ltac2 Notation "ex5" x(self) := auto. ex5 match. Syntax error: [tactic:tac2expr level 5] expected after 'match' (in [tactic:tac2expr]). :n:`self` parses an Ltac2 expression at the current level and returns it as is. :n:`next` parses an Ltac2 expression at the next level and returns it as is. :n:`thunk(@ltac2_scope)` Used for semantic effect only, parses the same as :token:`ltac2_scope`. If :n:`e` is the parsed expression for :token:`ltac2_scope`, `thunk` returns :n:`fun () => e`. :n:`pattern` parses a :token:`cpattern` A few syntactic classes contain antiquotation features. For the sake of uniformity, all antiquotations are introduced by the syntax :n:`$@lident`. A few other specific syntactic classes exist to handle Ltac1-like syntax, but their use is discouraged and they are thus not documented. For now there is no way to declare new syntactic classes from the Ltac2 side, but this is planned. Other nonterminals that have syntactic classes are listed here. .. list-table:: :header-rows: 1 * - Syntactic class name - Nonterminal - Similar non-Ltac2 syntax * - :n:`intropatterns` - :token:`ltac2_intropatterns` - :n:`{* @intropattern }` * - :n:`intropattern` - :token:`ltac2_simple_intropattern` - :token:`simple_intropattern` * - :n:`ident` - :token:`ident_or_anti` - :token:`ident` * - :n:`destruction_arg` - :token:`ltac2_destruction_arg` - :token:`induction_arg` * - :n:`with_bindings` - :token:`q_with_bindings` - :n:`{? with @bindings }` * - :n:`bindings` - :token:`ltac2_bindings` - :token:`bindings` * - :n:`reductions` - :token:`ltac2_reductions` - :token:`reductions` * - :n:`reference` - :token:`refglobal` - :token:`reference` * - :n:`clause` - :token:`ltac2_clause` - :token:`occurrences` * - :n:`occurrences` - :token:`q_occurrences` - :n:`{? at @occs_nums }` * - :n:`induction_clause` - :token:`ltac2_induction_clause` - :token:`induction_clause` * - :n:`conversion` - :token:`ltac2_conversion` - * - :n:`orient` - :token:`q_orient` - :n:`{? {| -> | <- } }` * - :n:`rewriting` - :token:`ltac2_oriented_rewriter` - :token:`oriented_rewriter` * - :n:`dispatch` - :token:`ltac2_for_each_goal` - :token:`for_each_goal` * - :n:`hintdb` - :token:`hintdb` - :token:`hintbases` * - :n:`move_location` - :token:`move_location` - :token:`where` * - :n:`pose` - :token:`pose` - :token:`alias_definition` * - :n:`assert` - :token:`assertion` - :n:`( @ident := @term )` * - :n:`constr_matching` - :token:`ltac2_match_list` - See :tacn:`match` * - :n:`goal_matching` - :token:`goal_match_list` - See :tacn:`match goal` Here is the syntax for the :n:`q_*` nonterminals: .. insertprodn ltac2_intropatterns nonsimple_intropattern .. prodn:: ltac2_intropatterns ::= {* @nonsimple_intropattern } nonsimple_intropattern ::= * | ** | @ltac2_simple_intropattern .. insertprodn ltac2_simple_intropattern ltac2_equality_intropattern .. prodn:: ltac2_simple_intropattern ::= @ltac2_simple_intropattern_closed {* % @term0 } ltac2_simple_intropattern_closed ::= @ltac2_or_and_intropattern | @ltac2_equality_intropattern | _ | @ltac2_naming_intropattern ltac2_naming_intropattern ::= ?@ident | ?$ @ident | ? | @ident_or_anti ltac2_or_and_intropattern ::= [ {+| @ltac2_intropatterns } ] | () | ( {+, @ltac2_simple_intropattern } ) | ( {+& @ltac2_simple_intropattern } ) ltac2_equality_intropattern ::= -> | <- | [= @ltac2_intropatterns ] .. insertprodn ident_or_anti ident_or_anti .. prodn:: ident_or_anti ::= @ident | $ @ident .. insertprodn ltac2_destruction_arg ltac2_constr_with_bindings .. prodn:: ltac2_destruction_arg ::= @natural | @ident | @ltac2_constr_with_bindings ltac2_constr_with_bindings ::= @term {? with @ltac2_bindings } .. insertprodn q_with_bindings qhyp .. prodn:: q_with_bindings ::= {? with @ltac2_bindings } ltac2_bindings ::= {+ @ltac2_simple_binding } | {+ @term } ltac2_simple_binding ::= ( @qhyp := @term ) qhyp ::= $ @ident | @natural | @ident .. insertprodn ltac2_reductions ltac2_delta_reductions .. prodn:: ltac2_reductions ::= {+ @ltac2_red_flag } | {? @ltac2_delta_reductions } ltac2_red_flag ::= beta | iota | match | fix | cofix | zeta | delta {? @ltac2_delta_reductions } | head ltac2_delta_reductions ::= {? - } [ {+ @refglobal } ] .. insertprodn refglobal refglobal .. prodn:: refglobal ::= & @ident | @qualid | $ @ident .. insertprodn ltac2_clause ltac2_in_clause .. prodn:: ltac2_clause ::= in @ltac2_in_clause | at @ltac2_occs_nums ltac2_in_clause ::= * {? @ltac2_occs } | * %|- {? @ltac2_concl_occ } | {*, @ltac2_hypident_occ } {? %|- {? @ltac2_concl_occ } } .. insertprodn q_occurrences ltac2_hypident .. prodn:: q_occurrences ::= {? @ltac2_occs } ltac2_occs ::= at @ltac2_occs_nums ltac2_occs_nums ::= {? - } {+ {| @natural | $ @ident } } ltac2_concl_occ ::= * {? @ltac2_occs } ltac2_hypident_occ ::= @ltac2_hypident {? @ltac2_occs } ltac2_hypident ::= @ident_or_anti | ( type of @ident_or_anti ) | ( value of @ident_or_anti ) .. insertprodn ltac2_induction_clause ltac2_eqn_ipat .. prodn:: ltac2_induction_clause ::= @ltac2_destruction_arg {? @ltac2_as_or_and_ipat } {? @ltac2_eqn_ipat } {? @ltac2_clause } ltac2_as_or_and_ipat ::= as @ltac2_or_and_intropattern ltac2_eqn_ipat ::= eqn : @ltac2_naming_intropattern .. insertprodn ltac2_conversion ltac2_conversion .. prodn:: ltac2_conversion ::= @term | @term with @term .. insertprodn q_rewriting ltac2_rewriter .. prodn:: q_rewriting ::= @ltac2_oriented_rewriter ltac2_oriented_rewriter ::= {? @q_orient } @ltac2_rewriter q_orient ::= {? {| -> | <- } } ltac2_rewriter ::= {? @natural } {? {| ? | ! } } @ltac2_constr_with_bindings .. insertprodn ltac2_for_each_goal ltac2_goal_tactics .. prodn:: ltac2_for_each_goal ::= @ltac2_goal_tactics | {? @ltac2_goal_tactics %| } {? @ltac2_expr } .. {? %| @ltac2_goal_tactics } ltac2_goal_tactics ::= {*| {? @ltac2_expr } } .. insertprodn hintdb hintdb .. prodn:: hintdb ::= * | {+ @ident_or_anti } .. insertprodn move_location move_location .. prodn:: move_location ::= at top | at bottom | after @ident_or_anti | before @ident_or_anti .. insertprodn pose ltac2_as_name .. prodn:: pose ::= ( @ident_or_anti := @term ) | @term {? @ltac2_as_name } ltac2_as_name ::= as @ident_or_anti .. insertprodn assertion ltac2_by_tactic .. prodn:: assertion ::= ( @ident_or_anti := @term ) | ( @ident_or_anti : @term ) {? @ltac2_by_tactic } | @term {? @ltac2_as_ipat } {? @ltac2_by_tactic } ltac2_as_ipat ::= as @ltac2_simple_intropattern ltac2_by_tactic ::= by @ltac2_expr5 Evaluation ---------- Ltac2 features a toplevel loop that can be used to evaluate expressions. .. cmd:: Ltac2 Eval @ltac2_expr This command evaluates the term in the current proof if there is one, or in the global environment otherwise, and displays the resulting value to the user together with its type. This command is pure in the sense that it does not modify the state of the proof, and in particular all side-effects are discarded. Debug ----- .. flag:: Ltac2 Backtrace When this :term:`flag` is set, toplevel failures will be printed with a backtrace. Profiling --------- .. flag:: Ltac2 In Ltac1 Profiling When this :term:`flag` and :flag:`Ltac Profiling` are set, profiling data is gathered for Ltac2 via the Ltac profiler. It is unset by default. Compatibility layer with Ltac1 ------------------------------ .. _ltac2in1: Ltac1 from Ltac2 ~~~~~~~~~~~~~~~~ .. _simple_api: Simple API ++++++++++ One can call Ltac1 code from Ltac2 by using the :n:`ltac1:(@ltac1_expr_in_env)` quotation. See :ref:`ltac2_built-in-quotations`. It parses a Ltac1 expression, and semantics of this quotation is the evaluation of the corresponding code for its side effects. In particular, it cannot return values, and the quotation has type :n:`unit`. Ltac1 **cannot** implicitly access variables from the Ltac2 scope, but this can be done with an explicit annotation on the :n:`ltac1:({* @ident } |- @ltac_expr)` quotation. See :ref:`ltac2_built-in-quotations`. For example: .. coqtop:: in Local Ltac2 replace_with (lhs: constr) (rhs: constr) := ltac1:(lhs rhs |- replace lhs with rhs) (Ltac1.of_constr lhs) (Ltac1.of_constr rhs). Ltac2 Notation "replace" lhs(constr) "with" rhs(constr) := replace_with lhs rhs. The return type of this expression is a function of the same arity as the number of identifiers, with arguments of type `Ltac2.Ltac1.t` (see below). This syntax will bind the variables in the quoted Ltac1 code as if they had been bound from Ltac1 itself. Similarly, the arguments applied to the quotation will be passed at runtime to the Ltac1 code. .. _low_level_api: Low-level API +++++++++++++ There exists a lower-level FFI into Ltac1 that is not recommended for daily use, which is available in the `Ltac2.Ltac1` module. This API allows to directly manipulate dynamically-typed Ltac1 values, either through the function calls, or using the `ltac1val` quotation. The latter parses the same as `ltac1`, but has type `Ltac2.Ltac1.t` instead of `unit`, and dynamically behaves as an Ltac1 thunk, i.e. `ltac1val:(foo)` corresponds to the tactic closure that Ltac1 would generate from `idtac; foo`. Due to intricate dynamic semantics, understanding when Ltac1 value quotations focus is very hard. This is why some functions return a continuation-passing style value, as it can dispatch dynamically between focused and unfocused behavior. The same mechanism for explicit binding of variables as described in the previous section applies. Ltac2 from Ltac1 ~~~~~~~~~~~~~~~~ Same as above by switching Ltac1 by Ltac2 and using the `ltac2` quotation instead. .. prodn:: ltac_expr += ltac2 : ( @ltac2_expr ) | ltac2 : ( {+ @ident } |- @ltac2_expr ) The typing rules are dual, that is, the optional identifiers are bound with type `Ltac2.Ltac1.t` in the Ltac2 expression, which is expected to have type unit. The value returned by this quotation is an Ltac1 function with the same arity as the number of bound variables. Note that when no variables are bound, the inner tactic expression is evaluated eagerly, if one wants to use it as an argument to a Ltac1 function, one has to resort to the good old :n:`idtac; ltac2:(foo)` trick. For instance, the code below will fail immediately and won't print anything. .. coqtop:: in From Ltac2 Require Import Ltac2. Set Default Proof Mode "Classic". .. coqtop:: all Ltac mytac tac := idtac "I am being evaluated"; tac. Goal True. Proof. (* Doesn't print anything *) Fail mytac ltac2:(fail). (* Prints and fails *) Fail mytac ltac:(idtac; ltac2:(fail)). Abort. In any case, the value returned by the fully applied quotation is an unspecified dummy Ltac1 closure and should not be further used. Use the `ltac2val` quotation to return values to Ltac1 from Ltac2. .. prodn:: ltac_expr += ltac2val : ( @ltac2_expr ) | ltac2val : ( {+ @ident } |- @ltac2_expr ) It has the same typing rules as `ltac2:()` except the expression must have type `Ltac2.Ltac1.t`. .. coqtop:: all Import Constr.Unsafe. Ltac add1 x := let f := ltac2val:(Ltac1.lambda (fun y => let y := Option.get (Ltac1.to_constr y) in let y := make (App constr:(S) [|y|]) in Ltac1.of_constr y)) in f x. Goal True. let z := constr:(0) in let v := add1 z in idtac v. Abort. Switching between Ltac languages ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ We recommend using the :opt:`Default Proof Mode` option or the :cmd:`Proof Mode` command to switch between tactic languages. The option has proof-level granularity while the command has :term:`sentence`-level granularity. This allows incrementally porting proof scripts. 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 will help you. We list the major changes and the transition strategies hereafter. Syntax changes ~~~~~~~~~~~~~~ Due to conflicts, a few syntactic rules have changed. - The dispatch tactical :n:`tac; [foo|bar]` is now written :n:`tac > [foo|bar]`. - Levels of a few operators have been revised. Some tacticals now parse as if they were normal functions. Parentheses are now required around complex arguments, such as abstractions. The tacticals affected are: :n:`try`, :n:`repeat`, :n:`do`, :n:`once`, :n:`progress`, :n:`time`, :n:`abstract`. - :n:`idtac` is no more. Either use :n:`()` if you expect nothing to happen, :n:`(fun () => ())` if you want a thunk (see next section), or use printing primitives from the :n:`Message` module if you want to display something. Tactic delay ~~~~~~~~~~~~ Tactics are not magically delayed anymore, neither as functions nor as arguments. It is your responsibility to thunk them beforehand and apply them at the call site. A typical example of a delayed function: :n:`Ltac foo := blah.` becomes :n:`Ltac2 foo () := blah.` All subsequent calls to `foo` must be applied to perform the same effect as before. Likewise, for arguments: :n:`Ltac bar tac := tac; tac; tac.` becomes :n:`Ltac2 bar tac := tac (); tac (); tac ().` We recommend the use of syntactic notations to ease the transition. For instance, the first example can alternatively be written as: :n:`Ltac2 foo0 () := blah.` :n:`Ltac2 Notation foo := foo0 ().` This allows to keep the subsequent calls to the tactic as-is, as the expression `foo` will be implicitly expanded everywhere into `foo0 ()`. Such a trick also works for arguments, as arguments of syntactic notations are implicitly thunked. The second example could thus be written as follows. :n:`Ltac2 bar0 tac := tac (); tac (); tac ().` :n:`Ltac2 Notation bar := bar0.` Variable binding ~~~~~~~~~~~~~~~~ Ltac1 relies on complex dynamic trickery to be able to tell apart bound variables from terms, hypotheses, etc. There is no such thing in Ltac2, as variables are recognized statically and other constructions do not live in the same syntactic world. Due to the abuse of quotations, it can sometimes be complicated to know what a mere identifier represents in a tactic expression. We recommend tracking the context and letting the compiler print typing errors to understand what is going on. We list below the typical changes one has to perform depending on the static errors produced by the typechecker. In Ltac expressions +++++++++++++++++++ .. exn:: Unbound {| value | constructor } X * if `X` is meant to be a term from the current static environment, replace the problematic use by `'X`. * if `X` is meant to be a hypothesis from the local context, replace the problematic use by `&X`. In quotations +++++++++++++ .. exn:: The reference X was not found in the current environment * if `X` is meant to be a tactic expression bound by a Ltac2 let or function, replace the problematic use by `$X`. * if `X` is meant to be a hypothesis from the local context, replace the problematic use by `&X`. Exception catching ~~~~~~~~~~~~~~~~~~ Ltac2 features a proper exception-catching mechanism. For this reason, the Ltac1 mechanism relying on `fail` taking integers, and tacticals decreasing it, has been removed. Now exceptions are preserved by all tacticals, and it is your duty to catch them and re-raise them as needed. coq-8.20.0/doc/sphinx/proof-engine/proof-handling.rst000066400000000000000000000001611466560755400225120ustar00rootroot00000000000000:orphan: .. raw:: html coq-8.20.0/doc/sphinx/proof-engine/ssreflect-proof-language.rst000066400000000000000000005503051466560755400245130ustar00rootroot00000000000000.. _thessreflectprooflanguage: ------------------------------ The |SSR| proof language ------------------------------ :Authors: Georges Gonthier, Assia Mahboubi, Enrico Tassi Introduction ------------ This chapter describes a set of tactics known as |SSR| originally designed to provide support for the so-called *small scale reflection* proof methodology. Despite the original purpose, this set of tactics is of general interest and is available in Coq starting from version 8.7. |SSR| was developed independently of the tactics described in Chapter :ref:`tactics`. Indeed the scope of the tactics part of |SSR| largely overlaps with the standard set of tactics. Eventually the overlap will be reduced in future releases of Coq. Proofs written in |SSR| typically look quite different from the ones written using only tactics as per Chapter :ref:`tactics`. We try to summarise here the most “visible” ones in order to help the reader already accustomed to the tactics described in Chapter :ref:`tactics` to read this chapter. The first difference between the tactics described in this chapter and the tactics described in Chapter :ref:`tactics` is the way hypotheses are managed (we call this *bookkeeping*). In Chapter :ref:`tactics` the most common approach is to avoid moving explicitly hypotheses back and forth between the context and the conclusion of the goal. On the contrary, in |SSR| all bookkeeping is performed on the conclusion of the goal, using for that purpose a couple of syntactic constructions behaving similar to tacticals (and often named as such in this chapter). The ``:`` tactical moves hypotheses from the context to the conclusion, while ``=>`` moves hypotheses from the conclusion to the context, and ``in`` moves back and forth a hypothesis from the context to the conclusion for the time of applying an action to it. While naming hypotheses is commonly done by means of an ``as`` clause in the basic model of Chapter :ref:`tactics`, it is here to ``=>`` that this task is devoted. Tactics frequently leave new assumptions in the conclusion, and are often followed by ``=>`` to explicitly name them. While generalizing the goal is normally not explicitly needed in Chapter :ref:`tactics`, it is an explicit operation performed by ``:``. .. seealso:: :ref:`bookkeeping_ssr` Besides the difference of bookkeeping model, this chapter includes specific tactics that have no explicit counterpart in Chapter :ref:`tactics` such as tactics to mix forward steps and generalizations as :tacn:`generally have` or :tacn:`without loss`. |SSR| adopts the point of view that rewriting, definition expansion and partial evaluation participate all to a same concept of rewriting a goal in a larger sense. As such, all these functionalities are provided by the :tacn:`rewrite ` tactic. |SSR| includes a little language of patterns to select subterms in tactics or tacticals where it matters. Its most notable application is in the :tacn:`rewrite ` tactic, where patterns are used to specify where the rewriting step has to take place. Finally, |SSR| supports so-called reflection steps, typically allowing to switch back and forth between the computational view and logical view of a concept. To conclude, it is worth mentioning that |SSR| tactics can be mixed with non-|SSR| tactics in the same proof, or in the same Ltac expression. The few exceptions to this statement are described in section :ref:`compatibility_issues_ssr`. Acknowledgments ~~~~~~~~~~~~~~~ The authors would like to thank Frédéric Blanqui, François Pottier and Laurence Rideau for their comments and suggestions. Usage ----- Getting started ~~~~~~~~~~~~~~~ To be available, the tactics presented in this manual need the following minimal set of libraries to be loaded: ``ssreflect.v``, ``ssrfun.v`` and ``ssrbool.v``. Moreover, these tactics come with a methodology specific to the authors of |SSR| and which requires a few options to be set in a different way than in their default way. All in all, this corresponds to working in the following context: .. coqtop:: in From Coq Require Import ssreflect ssrfun ssrbool. Set Implicit Arguments. Unset Strict Implicit. Unset Printing Implicit Defensive. .. seealso:: :flag:`Implicit Arguments`, :flag:`Strict Implicit`, :flag:`Printing Implicit Defensive` .. _compatibility_issues_ssr: Compatibility issues ~~~~~~~~~~~~~~~~~~~~ Requiring the above modules creates an environment that is mostly compatible with the rest of Coq, up to a few discrepancies. + New keywords (``is``) might clash with variable, constant, tactic or tactical names, or with quasi-keywords in tactic or notation commands. + New tactic(al)s names (:tacn:`last`, :tacn:`done`, :tacn:`have`, :tacn:`suffices`, :tacn:`suff`, :tacn:`without loss`, :tacn:`wlog`, :tacn:`congr`, :tacn:`unlock`) might clash with user tactic names. + Identifiers with both leading and trailing ``_``, such as ``_x_``, are reserved by |SSR| and cannot appear in scripts. + The extensions to the :tacn:`rewrite` tactic are partly incompatible with those available in current versions of Coq; in particular, ``rewrite .. in (type of k)`` or ``rewrite .. in *`` or any other variant of :tacn:`rewrite` will not work, and the |SSR| syntax and semantics for occurrence selection and rule chaining are different. Use an explicit rewrite direction (``rewrite <- …`` or ``rewrite -> …``) to access the Coq rewrite tactic. + New symbols (``//``, ``/=``, ``//=``) might clash with adjacent existing symbols. This can be avoided by inserting white spaces. + New constant and theorem names might clash with the user theory. This can be avoided by not importing all of |SSR|: .. coqtop:: in From Coq Require ssreflect. Import ssreflect.SsrSyntax. Note that the full syntax of |SSR|’s rewrite and reserved identifiers are enabled only if the ssreflect module has been required and if ``SsrSyntax`` has been imported. Thus a file that requires (without importing) ``ssreflect`` and imports ``SsrSyntax`` can be required and imported without automatically enabling |SSR|’s extended rewrite syntax and reserved identifiers. + Some user notations (in particular, defining an infix ``;``) might interfere with the "open term", parenthesis-free syntax of tactics such as :tacn:`have`, :tacn:`set (ssreflect)` and :tacn:`pose (ssreflect)`. + The generalization of ``if`` statements to non-Boolean conditions is turned off by |SSR|, because it is mostly subsumed by Coercion to ``bool`` of the ``sumXXX`` types (declared in ``ssrfun.v``) and the :n:`if @term is @pattern then @term else @term` construct (see :ref:`pattern_conditional_ssr`). To use the 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. .. flag:: SsrRewrite Controls whether the incompatible rewrite syntax is enabled (the default). Disabling the :term:`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. The default is on, which gives an error message when the user tries to create such identifiers. Disabling the :term:`flag` generates a warning instead, increasing compatibility with other parts of Coq. Gallina extensions -------------------- Small-scale reflection makes an extensive use of the programming subset of Gallina, Coq’s logical specification language. This subset is quite suited to the description of functions on representations, because it closely follows the well-established design of the ML programming language. The |SSR| extension provides three additions to Gallina, for pattern assignment, pattern testing, and polymorphism; these mitigate minor but annoying discrepancies between Gallina and ML. Pattern assignment ~~~~~~~~~~~~~~~~~~ The |SSR| extension provides the following construct for irrefutable pattern matching, that is, destructuring assignment: .. prodn:: term += let: @pattern := @term in @term Note the colon ``:`` after the ``let`` keyword, which avoids any ambiguity with a function definition or Coq’s basic destructuring let. The ``let:`` construct differs from the latter as follows. + The pattern can be nested (deep pattern matching); in particular, this allows expression of the form: .. coqdoc:: let: exist (x, y) p_xy := Hp in … . + The destructured constructor is explicitly given in the pattern, and is used for type inference. .. example:: .. coqtop:: reset none From Coq Require Import ssreflect. Set Implicit Arguments. Unset Strict Implicit. Unset Printing Implicit Defensive. .. coqtop:: all Definition f u := let: (m, n) := u in m + n. Check f. Using :g:`let:`, Coq infers a type for :g:`f`, whereas with a usual ``let`` the same term requires an extra type annotation in order to type check. .. coqtop:: reset all Fail Definition f u := let (m, n) := u in m + n. The ``let:`` construct is just (more legible) notation for the primitive Gallina expression :n:`match @term with @pattern => @term end`. The |SSR| destructuring assignment supports all the dependent match annotations; the full syntax is .. prodn:: term += let: @pattern {? as @ident} {? in @pattern} := @term {? return @term} in @term where the second :token:`pattern` and the second :token:`term` are *types*. When the ``as`` and ``return`` keywords are both present, then :token:`ident` is bound in both the second :token:`pattern` and the second :token:`term`; variables in the optional type :token:`pattern` are bound only in the second term, and other variables in the first :token:`pattern` are bound only in the third :token:`term`, however. .. _pattern_conditional_ssr: Pattern conditional ~~~~~~~~~~~~~~~~~~~ The following construct can be used for a refutable pattern matching, that is, pattern testing: .. prodn:: term += if @term is @pattern then @term else @term Although this construct is not strictly ML (it does exist in variants such as the pattern calculus or the ρ-calculus), it turns out to be very convenient for writing functions on representations, because most such functions manipulate simple data types such as Peano integers, options, lists, or binary trees, and the pattern conditional above is almost always the right construct for analyzing such simple types. For example, the null and all list function(al)s can be defined as follows: .. example:: .. coqtop:: reset none From Coq Require Import ssreflect. Set Implicit Arguments. Unset Strict Implicit. Unset Printing Implicit Defensive. Section Test. .. coqtop:: all Variable d: Set. Definition null (s : list d) := if s is nil then true else false. Variable a : d -> bool. Fixpoint all (s : list d) : bool := if s is cons x s' then a x && all s' else true. The pattern conditional also provides a notation for destructuring assignment with a refutable pattern, adapted to the pure functional setting of Gallina, which lacks a ``Match_Failure`` exception. Like ``let:`` above, the ``if…is`` construct is just (more legible) notation for the primitive Gallina expression :n:`match @term with @pattern => @term | _ => @term end`. Similarly, it will always be displayed as the expansion of this form in terms of primitive match expressions (where the default expression may be replicated). Explicit pattern testing also largely subsumes the generalization of the ``if`` construct to all binary data types; compare :n:`if @term is inl _ then @term else @term` and :n:`if @term then @term else @term`. The latter appears to be marginally shorter, but it is quite ambiguous, and indeed often requires an explicit annotation ``(term : {_} + {_})`` to type check, which evens the character count. Therefore, |SSR| restricts by default the condition of a plain ``if`` construct to the standard ``bool`` type; this avoids spurious type annotations. .. example:: .. coqtop:: all Definition orb b1 b2 := if b1 then true else b2. As pointed out in Section :ref:`compatibility_issues_ssr`, this restriction can be removed with the command: ``Close Scope boolean_if_scope.`` Like ``let:`` above, the ``if-is-then-else`` construct supports the dependent match annotations: .. prodn:: term += if @term is @pattern as @ident in @pattern return @term then @term else @term As in ``let:``, the variable :token:`ident` (and those in the type pattern) are bound in the second :token:`term`; :token:`ident` is also bound in the third :token:`term` (but not in the fourth :token:`term`), while the variables in the first :token:`pattern` are bound only in the third :token:`term`. Another variant allows to treat the ``else`` case first: .. prodn:: term += if @term isn't @pattern then @term else @term Note that :token:`pattern` eventually binds variables in the third :token:`term` and not in the second :token:`term`. .. _parametric_polymorphism_ssr: Parametric polymorphism ~~~~~~~~~~~~~~~~~~~~~~~ Unlike ML, polymorphism in core Gallina is explicit: the type parameters of polymorphic functions must be declared explicitly, and supplied at each point of use. However, Coq provides two features to suppress redundant parameters. + Sections are used to provide (possibly implicit) parameters for a set of definitions. + Implicit arguments declarations are used to tell Coq to use type inference to deduce some parameters from the context at each point of call. The combination of these features provides a fairly good emulation of ML-style polymorphism, but unfortunately this emulation breaks down for higher-order programming. Implicit arguments are indeed not inferred at all points of use, but only at points of call, leading to expressions such as .. example:: .. coqtop:: reset none From Coq Require Import ssreflect. Set Implicit Arguments. Unset Strict Implicit. Unset Printing Implicit Defensive. Section Test. Variable T : Type. Variable null : forall T : Type, T -> bool. Variable all : (T -> bool) -> list T -> bool. .. coqtop:: all Definition all_null (s : list T) := all (@null T) s. Unfortunately, such higher-order expressions are quite frequent in representation functions, especially those that use Coq's ``Structures`` to emulate Haskell typeclasses. Therefore, |SSR| provides a variant of Coq’s implicit argument declaration, which causes Coq to fill in some implicit parameters at each point of use; e.g., the above definition can be written: .. example:: .. coqtop:: reset none From Coq Require Import ssreflect. Set Implicit Arguments. Unset Strict Implicit. Unset Printing Implicit Defensive. Section Test. Variable T : Type. Variable null : forall T : Type, T -> bool. Variable all : (T -> bool) -> list T -> bool. .. coqtop:: all Prenex Implicits null. Definition all_null (s : list T) := all null s. Better yet, it can be omitted entirely, since :g:`all_null s` isn’t much of an improvement over :g:`all null s`. The syntax of the new declaration is .. cmd:: Prenex Implicits {+ @ident__i} This command checks that each :n:`@ident__i` is the name of a functional constant, whose implicit arguments are prenex, i.e., the first :math:`n_i > 0` arguments of :n:`@ident__i` are implicit; then it assigns ``Maximal Implicit`` status to these arguments. As these prenex implicit arguments are ubiquitous and have often large display strings, it is strongly recommended to change the default display settings of Coq so that they are not printed (except after a ``Set Printing All`` command). All |SSR| library files thus start with the incantation .. coqdoc:: Set Implicit Arguments. Unset Strict Implicit. Unset Printing Implicit Defensive. Anonymous arguments ~~~~~~~~~~~~~~~~~~~ When in a definition, the type of a certain argument is mandatory, but not its name, one usually uses “arrow” abstractions for prenex arguments, or the ``(_ : term)`` syntax for inner arguments. In |SSR|, the latter can be replaced by the open syntax ``of term`` or (equivalently) ``& term``, which are both syntactically equivalent to a ``(_ : term)`` expression. This feature almost behaves as the following extension of the binder syntax: .. prodn:: binder += {| & @term | of @term } Caveat: ``& T`` and ``of T`` abbreviations have to appear at the end of a binder list. For instance, the usual two-constructor polymorphic type list, i.e., the one of the standard ``List`` library, can be defined by the following declaration: .. example:: .. coqtop:: reset none From Coq Require Import ssreflect. Set Implicit Arguments. Unset Strict Implicit. Unset Printing Implicit Defensive. .. coqtop:: all Inductive list (A : Type) : Type := nil | cons of A & list A. Wildcards ~~~~~~~~~ The terms passed as arguments to |SSR| tactics can contain *holes*, materialized by wildcards ``_``. Since |SSR| allows a more powerful form of type inference for these arguments, it enhances the possibilities of using such wildcards. These holes are in particular used as a convenient shorthand for abstractions, especially in local definitions or type expressions. Wildcards may be interpreted as abstractions (see for example Sections :ref:`definitions_ssr` and :ref:`structure_ssr`), or their content can be inferred from the whole context of the goal (see for example Section :ref:`abbreviations_ssr`). .. _definitions_ssr: Definitions ~~~~~~~~~~~ .. tacn:: pose :name: pose (ssreflect) This tactic allows to add a defined constant to a proof context. |SSR| generalizes this tactic in several ways. In particular, the |SSR| :tacn:`pose (ssreflect)` tactic supports *open syntax*: the body of the definition does not need surrounding parentheses. For instance: .. coqdoc:: pose t := x + y. is a valid tactic expression. The :tacn:`pose (ssreflect)` tactic is also improved for the local definition of higher-order terms. Local definitions of functions can use the same syntax as global ones. For example, the tactic :tacn:`pose (ssreflect)` supports parameters: .. example:: .. coqtop:: reset none From Coq Require Import ssreflect. Set Implicit Arguments. Unset Strict Implicit. Unset Printing Implicit Defensive. .. coqtop:: all Lemma test : True. pose f x y := x + y. The |SSR| :tacn:`pose (ssreflect)` tactic also supports (co)fixpoints, by providing the local counterpart of the ``Fixpoint f := …`` and ``CoFixpoint f := …`` constructs. For instance, the following tactic: .. coqdoc:: pose fix f (x y : nat) {struct x} : nat := if x is S p then S (f p y) else 0. defines a local fixpoint ``f``, which mimics the standard plus operation on natural numbers. Similarly, local cofixpoints can be defined by a tactic of the form: .. coqdoc:: pose cofix f (arg : T) := … . The possibility to include wildcards in the body of the definitions offers a smooth way of defining local abstractions. The type of “holes” is guessed by type inference, and the holes are abstracted. For instance the tactic: .. coqdoc:: pose f := _ + 1. is shorthand for: .. coqdoc:: pose f n := n + 1. When the local definition of a function involves both arguments and holes, hole abstractions appear first. For instance, the tactic: .. coqdoc:: pose f x := x + _. is shorthand for: .. coqdoc:: pose f n x := x + n. The interaction of the :tacn:`pose (ssreflect)` tactic with the interpretation of implicit arguments results in a powerful and concise syntax for local definitions involving dependent types. For instance, the tactic: .. coqdoc:: pose f x y := (x, y). adds to the context the local definition: .. coqdoc:: pose f (Tx Ty : Type) (x : Tx) (y : Ty) := (x, y). The generalization of wildcards makes the use of the :tacn:`pose (ssreflect)` tactic resemble ML-like definitions of polymorphic functions. .. _abbreviations_ssr: Abbreviations ~~~~~~~~~~~~~ .. tacn:: set @ident {? : @term } := {? @occ_switch } @term :name: set (ssreflect) The |SSR| ``set`` tactic performs abbreviations; it introduces a defined constant for a subterm appearing in the goal and/or in the context. |SSR| extends the :tacn:`set` tactic by supplying: + an open syntax, similarly to the :tacn:`pose (ssreflect)` tactic; + a more aggressive matching algorithm; + an improved interpretation of wildcards, taking advantage of the matching algorithm; + an improved occurrence selection mechanism allowing to abstract only selected occurrences of a term. .. prodn:: occ_switch ::= { {? {| + | - } } {* @natural } } where: + :token:`ident` is a fresh identifier chosen by the user. + :token:`term` 1 is an optional type annotation. The type annotation :token:`term` 1 can be given in open syntax (no surrounding parentheses). If no :token:`occ_switch` (described hereafter) is present, it is also the case for the second :token:`term`. On the other hand, in the presence of :token:`occ_switch`, parentheses surrounding the second :token:`term` are mandatory. + In the occurrence switch :token:`occ_switch`, if the first element of the list is a natural, this element should be a number, and not an Ltac variable. The empty list ``{}`` is not interpreted as a valid occurrence switch; it is rather used as a flag to signal the intent of the user to clear the name following it (see :ref:`ssr_rewrite_occ_switch` and :ref:`introduction_ssr`). The tactic: .. example:: .. coqtop:: reset none From Coq Require Import ssreflect. Set Implicit Arguments. Unset Strict Implicit. Unset Printing Implicit Defensive. Axiom f : nat -> nat. .. coqtop:: all Lemma test x : f x + f x = f x. set t := f _. .. coqtop:: all restart set t := {2}(f _). The type annotation may contain wildcards, which will be filled with appropriate values by the matching process. The tactic first tries to find a subterm of the goal matching the second :token:`term` (and its type), and stops at the first subterm it finds. Then the occurrences of this subterm selected by the optional :token:`occ_switch` are replaced by :token:`ident` and a definition :n:`@ident := @term` is added to the context. If no :token:`occ_switch` is present, then all the occurrences are abstracted. Matching ```````` The matching algorithm compares a pattern :token:`term` with a subterm of the goal by comparing their heads and then pairwise unifying their arguments (modulo conversion). Head symbols match under the following conditions. + If the head of :token:`term` is a constant, then it should be syntactically equal to the head symbol of the subterm. + If this head is a projection of a canonical structure, then canonical structure equations are used for the matching. + If the head of :token:`term` is *not* a constant, the subterm should have the same structure (λ abstraction, ``let…in`` structure, etc.). + If the head of :token:`term` is a hole, the subterm should have at least as many arguments as :token:`term`. .. example:: .. coqtop:: reset none From Coq Require Import ssreflect. Set Implicit Arguments. Unset Strict Implicit. Unset Printing Implicit Defensive. .. coqtop:: all Lemma test (x y z : nat) : x + y = z. set t := _ x. + In the special case where :token:`term` is of the form ``(let f := t0 in f) t1 … tn`` , then the pattern :token:`term` is treated as ``(_ t1 … tn)``. For each subterm in the goal having the form ``(A u1 … um)`` with m ≥ n, the matching algorithm successively tries to find the largest partial application ``(A u1 … uj)`` convertible to the head ``t0`` of :token:`term`. .. example:: .. coqtop:: reset none From Coq Require Import ssreflect. Set Implicit Arguments. Unset Strict Implicit. Unset Printing Implicit Defensive. .. coqtop:: all Lemma test : (let f x y z := x + y + z in f 1) 2 3 = 6. set t := (let g y z := S y + z in g) 2. The notation ``unkeyed`` defined in ``ssreflect.v`` is a shorthand for the degenerate term ``let x := … in x``. Moreover: + Multiple holes in :token:`term` are treated as independent placeholders. .. example:: .. coqtop:: reset none From Coq Require Import ssreflect. Set Implicit Arguments. Unset Strict Implicit. Unset Printing Implicit Defensive. .. coqtop:: all Lemma test x y z : x + y = z. set t := _ + _. + The type of the subterm matched should fit the type (possibly casted by some type annotations) of the pattern :token:`term`. + The replacement of the subterm found by the instantiated pattern should not capture variables. In the example above, ``x`` is bound and should not be captured. .. example:: .. coqtop:: reset none From Coq Require Import ssreflect. Set Implicit Arguments. Unset Strict Implicit. Unset Printing Implicit Defensive. .. coqtop:: all Lemma test : forall x : nat, x + 1 = 0. Fail set t := _ + 1. + Typeclass inference should fill in any residual hole, but matching should never assign a value to a global existential variable. .. _occurrence_selection_ssr: Occurrence selection ```````````````````` |SSR| provides a generic syntax for the selection of occurrences by their position indexes. These *occurrence switches* are shared by all |SSR| tactics that require control on subterm selection like rewriting, generalization, … An *occurrence switch* can be: + A list of natural numbers ``{+ n1 … nm}`` of occurrences affected by the tactic. .. example:: .. coqtop:: reset none From Coq Require Import ssreflect. Set Implicit Arguments. Unset Strict Implicit. Unset Printing Implicit Defensive. Axiom f : nat -> nat. .. coqtop:: all Lemma test : f 2 + f 8 = f 2 + f 2. set x := {+1 3}(f 2). Notice that some occurrences of a given term may be hidden to the user, for example because of a notation. Setting the :flag:`Printing All` flag causes these hidden occurrences to be shown when the term is displayed. This setting should be used to find the correct coding of the occurrences to be selected [#1]_. .. example:: .. coqtop:: reset none From Coq Require Import ssreflect. Set Implicit Arguments. Unset Strict Implicit. Unset Printing Implicit Defensive. .. coqtop:: all Notation "a < b":= (le (S a) b). Lemma test x y : x < y -> S x < S y. set t := S x. + A list of natural numbers ``{n1 … nm}``. This is equivalent to the previous ``{+ n1 … nm}``, but the list should start with a number, and not with an Ltac variable. + A list ``{- n1 … nm}`` of occurrences *not* to be affected by the tactic. .. example:: .. coqtop:: reset none From Coq Require Import ssreflect. Set Implicit Arguments. Unset Strict Implicit. Unset Printing Implicit Defensive. Axiom f : nat -> nat. .. coqtop:: all Lemma test : f 2 + f 8 = f 2 + f 2. set x := {-2}(f 2). Note that, in this goal, it behaves like ``set x := {1 3}(f 2).`` + In particular, the switch ``{+}`` selects *all* the occurrences. This switch is useful to turn off the default behavior of a tactic that automatically clears some assumptions (see Section :ref:`discharge_ssr` for instance). + The switch ``{-}`` imposes that *no* occurrences of the term should be affected by the tactic. The tactic: ``set x := {-}(f 2).`` leaves the goal unchanged and adds the definition ``x := f 2`` to the context. This kind of tactic may be used to take advantage of the power of the matching algorithm in a local definition, instead of copying large terms by hand. It is important to remember that matching *precedes* occurrence selection. .. example:: .. coqtop:: reset none From Coq Require Import ssreflect. Set Implicit Arguments. Unset Strict Implicit. Unset Printing Implicit Defensive. .. coqtop:: all Lemma test x y z : x + y = x + y + z. set a := {2}(_ + _). Hence, in the following goal, the same tactic fails since there is only one occurrence of the selected term. .. example:: .. coqtop:: reset none From Coq Require Import ssreflect. Set Implicit Arguments. Unset Strict Implicit. Unset Printing Implicit Defensive. .. coqtop:: all Lemma test x y z : (x + y) + (z + z) = z + z. Fail set a := {2}(_ + _). .. _basic_localization_ssr: Basic localization ~~~~~~~~~~~~~~~~~~ It is possible to define an abbreviation for a term appearing in the context of a goal thanks to the ``in`` tactical. .. tacv:: set @ident := @term in {+ @ident} This variant of :tacn:`set ` introduces a defined constant called :token:`ident` in the context, and folds it in the context entries mentioned on the right hand side of ``in``. The body of :token:`ident` is the first subterm matching these context entries (taken in the given order). .. example:: .. coqtop:: reset none From Coq Require Import ssreflect. .. coqtop:: all Lemma test x t (Hx : x = 3) : x + t = 4. set z := 3 in Hx. .. tacv:: set @ident := @term in {+ @ident} * This variant matches :token:`term` and then folds :token:`ident` similarly in all the given context entries but also folds :token:`ident` in the goal. .. example:: .. coqtop:: reset none From Coq Require Import ssreflect. .. coqtop:: all Lemma test x t (Hx : x = 3) : x + t = 4. set z := 3 in Hx * . Indeed, remember that 4 is just a notation for (S 3). The use of the ``in`` tactical is not limited to the localization of abbreviations: for a complete description of the ``in`` tactical, see Section :ref:`bookkeeping_ssr` and :ref:`localization_ssr`. .. _basic_tactics_ssr: Basic tactics ------------- A sizable fraction of proof scripts consists of steps that do not "prove" anything new, but instead perform menial bookkeeping tasks such as selecting the names of constants and assumptions or splitting conjuncts. Although they are logically trivial, bookkeeping steps are extremely important because they define the structure of the data-flow of a proof script. This is especially true for reflection-based proofs, which often involve large numbers of constants and assumptions. Good bookkeeping consists in always explicitly declaring (i.e., naming) all new constants and assumptions in the script, and systematically pruning irrelevant constants and assumptions in the context. This is essential in the context of an interactive development environment (IDE), because it facilitates navigating the proof, allowing to instantly "jump back" to the point at which a questionable assumption was added, and to find relevant assumptions by browsing the pruned context. While novice or casual Coq users may find the automatic name selection feature convenient, the usage of such a feature severely undermines the readability and maintainability of proof scripts, much like automatic variable declaration in programming languages. The |SSR| tactics are therefore designed to support precise bookkeeping and to eliminate name generation heuristics. The bookkeeping features of |SSR| are implemented as tacticals (or pseudo-tacticals), shared across most |SSR| tactics, and thus form the foundation of the |SSR| proof language. .. _bookkeeping_ssr: Bookkeeping ~~~~~~~~~~~ During the course of a proof, Coq always presents the user with a *sequent* whose general form is:: ci : Ti … dj := ej : Tj … Fk : Pk … ================= forall (xl : Tl) …, let ym := bm in … in Pn -> … -> C The *goal* to be proved appears below the double line; above the line is the *context* of the sequent, a set of declarations of *constants* ``ci`` , *defined constants* ``dj`` , and *facts* ``Fk`` that can be used to prove the goal (usually, ``Ti`` , ``Tj : Type`` and ``Pk : Prop``). The various kinds of declarations can come in any order. The top part of the context consists of declarations produced by the Section commands ``Variable``, ``Let``, and ``Hypothesis``. This *section context* is never affected by the |SSR| tactics: they only operate on the lower part — the *proof context*. As in the figure above, the goal often decomposes into a series of (universally) quantified *variables* ``(xl : Tl)``, local *definitions* ``let ym := bm in``, and *assumptions* ``Pn ->``, and a *conclusion* ``C`` (as in the context, variables, definitions, and assumptions can appear in any order). The conclusion is what actually needs to be proved — the rest of the goal can be seen as a part of the proof context that happens to be “below the line”. However, although they are logically equivalent, there are fundamental differences between constants and facts, on the one hand, and variables and assumptions, on the other. Constants and facts are *unordered*, but *named* explicitly in the proof text; variables and assumptions are *ordered*, but *unnamed*: the display names of variables may change at any time because of α-conversion. Similarly, basic deductive steps such as ``apply`` can only operate on the goal because the Gallina terms that control their action (e.g., the type of the lemma used by ``apply``) only provide unnamed bound variables. [#2]_ Since the proof script can only refer directly to the context, it must constantly shift declarations from the goal to the context and conversely in between deductive steps. In |SSR|, these moves are performed by two *tacticals*, ``=>`` and ``:``, so that the bookkeeping required by a deductive step can be directly associated with that step, and that tactics in an |SSR| script correspond to actual logical steps in the proof rather than merely shuffle facts. Still, some isolated bookkeeping is unavoidable, such as naming variables and assumptions at the beginning of a proof. |SSR| provides a specific ``move`` tactic for this purpose. Now, ``move`` does essentially nothing: it is mostly a placeholder for ``=>`` and ``:``. The ``=>`` tactical moves variables, local definitions, and assumptions to the context, while the ``:`` tactical moves facts and constants to the goal. .. example:: For example, the proof of [#3]_ .. coqtop:: reset none From Coq Require Import ssreflect. Set Implicit Arguments. Unset Strict Implicit. Unset Printing Implicit Defensive. .. coqtop:: all Lemma subnK : forall m n, n <= m -> m - n + n = m. might start with .. coqtop:: all move=> m n le_n_m. where ``move`` does nothing, but ``=> m n le_m_n`` changes the variables and assumption of the goal in the constants ``m n : nat`` and the fact ``le_n_m : n <= m``, thus exposing the conclusion ``m - n + n = m``. The ``:`` tactical is the converse of ``=>``; indeed it removes facts and constants from the context by turning them into variables and assumptions. .. coqtop:: all move: m le_n_m. turns back ``m`` and ``le_m_n`` into a variable and an assumption, removing them from the proof context, and changing the goal to ``forall m, n <= m -> m - n + n = m``, which can be proved by induction on ``n`` using ``elim: n``. Because they are tacticals, ``:`` and ``=>`` can be combined, as in .. coqdoc:: move: m le_n_m => p le_n_p. which simultaneously renames ``m`` and ``le_m_n`` into ``p`` and ``le_n_p``, respectively, by first turning them into unnamed variables, then turning these variables back into constants and facts. Furthermore, |SSR| redefines the basic Coq tactics ``case``, ``elim``, and ``apply`` so that they can take better advantage of ``:`` and ``=>``. In these |SSR| variants, these tactics operate on the first variable or constant of the goal and they do not use or change the proof context. The ``:`` tactical is used to operate on an element in the context. .. example:: For instance, the proof of ``subnK`` could continue with ``elim: n``. Instead of ``elim n`` (note, no colon), this has the advantage of removing n from the context. Better yet, this ``elim`` can be combined with previous ``move`` and with the branching version of the ``=>`` tactical (described in :ref:`introduction_ssr`), to encapsulate the inductive step in a single command: .. coqtop:: reset none From Coq Require Import ssreflect. Set Implicit Arguments. Unset Strict Implicit. Unset Printing Implicit Defensive. .. coqtop:: all Lemma subnK : forall m n, n <= m -> m - n + n = m. move=> m n le_n_m. elim: n m le_n_m => [|n IHn] m => [_ | lt_n_m]. which breaks down the proof into two subgoals, the second one having in its context ``lt_n_m : S n <= m`` and ``IHn : forall m, n <= m -> m - n + n = m``. The ``:`` and ``=>`` tacticals can be explained very simply if one views the goal as a stack of variables and assumptions piled on a conclusion: + ``tactic : a b c`` pushes the context constants ``a``, ``b``, ``c`` as goal variables *before* performing the tactic; + ``tactic => a b c`` pops the top three goal variables as context constants ``a``, ``b``, ``c``, *after* the tactic has been performed. These pushes and pops do not need to balance out as in the examples above; so ``move: m le_n_m => p`` would rename ``m`` into ``p``, but leave an extra assumption ``n <= p`` in the goal. Basic tactics like ``apply`` and ``elim`` can also be used without the ’:’ tactical: for example, we can directly start a proof of ``subnK`` by induction on the top variable ``m`` with .. coqdoc:: elim=> [|m IHm] n le_n. The general form of the localization tactical ``in`` is also best explained in terms of the goal stack:: tactic in a H1 H2 *. is basically equivalent to .. coqdoc:: move: a H1 H2; tactic => a H1 H2. with two differences: the ``in`` tactical will preserve the body of ``a``, if ``a`` is a defined constant, and if the ``*`` is omitted, it will use a temporary abbreviation to hide the statement of the goal from ``tactic``. The general form of the ``in`` tactical can be used directly with the ``move``, ``case`` and ``elim`` tactics, so that one can write .. coqdoc:: elim: n => [|n IHn] in m le_n_m *. instead of .. coqdoc:: elim: n m le_n_m => [|n IHn] m le_n_m. This is quite useful for inductive proofs that involve many facts. See Section :ref:`localization_ssr` for the general syntax and presentation of the ``in`` tactical. .. _the_defective_tactics_ssr: The defective tactics ~~~~~~~~~~~~~~~~~~~~~ In this section, we briefly present the three basic tactics performing context manipulations and the main backward chaining tool. The move tactic. ```````````````` .. tacn:: move :name: move (ssreflect) This tactic, in its defective form, behaves like the :tacn:`hnf` tactic. .. example:: .. coqtop:: reset all Require Import ssreflect. Goal not False. move. More precisely, the :tacn:`move ` tactic inspects the goal and does nothing (:tacn:`idtac`) if an introduction step is possible, i.e., if the goal is a product or a ``let … in``, and performs :tacn:`hnf` otherwise. Of course this tactic is most often used in combination with the bookkeeping tacticals (see Sections :ref:`introduction_ssr` and :ref:`discharge_ssr`). These combinations mostly subsume the :tacn:`intros`, :tacn:`generalize`, :tacn:`revert`, :tacn:`rename`, :tacn:`clear` and :tacn:`pattern` tactics. .. _the_case_tactic_ssr: The case tactic ``````````````` .. tacn:: case :name: case (ssreflect) This tactic performs *primitive case analysis* on (co)inductive types; specifically, it destructs the top variable or assumption of the goal, exposing its constructor(s) and its arguments, as well as setting the value of its type family indices if it belongs to a type family (see Section :ref:`type_families_ssr`). The |SSR| ``case`` tactic has a special behavior on equalities. If the top assumption of the goal is an equality, the ``case`` tactic “destructs” it as a set of equalities between the constructor arguments of its left and right hand sides, as per the tactic injection. For example, ``case`` changes the goal:: (x, y) = (1, 2) -> G. into:: x = 1 -> y = 2 -> G. The :tacn:`case` can generate the following warning: .. warn:: SSReflect: cannot obtain new equations out of ... The tactic was run on an equation that cannot generate simpler equations, for example `x = 1`. The warning can be silenced or made fatal by using the :opt:`Warnings` option and the `spurious-ssr-injection` key. Finally, the :tacn:`case` tactic of |SSR| performs :g:`False` elimination, even if no branch is generated by this case operation. Hence the tactic :tacn:`case` on a goal of the form :g:`False -> G` will succeed and prove the goal. The elim tactic ``````````````` .. tacn:: elim :name: elim (ssreflect) This tactic performs inductive elimination on inductive types. In its defective form, the tactic performs inductive elimination on a goal whose top assumption has an inductive type. .. example:: .. coqtop:: reset none From Coq Require Import ssreflect. Set Implicit Arguments. Unset Strict Implicit. Unset Printing Implicit Defensive. .. coqtop:: all Lemma test m : forall n : nat, m <= n. elim. .. _apply_ssr: The apply tactic ```````````````` .. tacn:: apply {? @term } :name: apply (ssreflect) This is the main backward chaining tactic of the proof system. It takes as argument any :token:`term` and applies it to the goal. Assumptions in the type of :token:`term` that don’t directly match the goal may generate one or more subgoals. In its defective form, this tactic is a synonym for:: intro top; first [refine top | refine (top _) | refine (top _ _) | …]; clear top. where :g:`top` is a fresh name, and the sequence of :tacn:`refine` tactics tries to catch the appropriate number of wildcards to be inserted. Note that this use of the :tacn:`refine` tactic implies that the tactic tries to match the goal up to expansion of constants and evaluation of subterms. :tacn:`apply ` has a special behavior on goals containing existential metavariables of sort :g:`Prop`. .. example:: .. coqtop:: reset none From Coq Require Import ssreflect. Set Implicit Arguments. Unset Strict Implicit. Unset Printing Implicit Defensive. Axiom lt_trans : forall a b c, a < b -> b < c -> a < c. .. coqtop:: all Lemma test : forall y, 1 < y -> y < 2 -> exists x : { n | n < 3 }, 0 < proj1_sig x. move=> y y_gt1 y_lt2; apply: (ex_intro _ (exist _ y _)). by apply: lt_trans y_lt2 _. by move=> y_lt3; apply: lt_trans y_gt1. Note that the last ``_`` of the tactic ``apply: (ex_intro _ (exist _ y _))`` represents a proof that ``y < 3``. Instead of generating the goal:: 0 < proj1_sig (exist (fun n : nat => n < 3) y ?Goal). the system tries to prove ``y < 3`` calling the trivial tactic. If it succeeds, let’s say because the context contains ``H : y < 3``, then the system generates the following goal:: 0 < proj1_sig (exist (fun n => n < 3) y H). Otherwise the missing proof is considered to be irrelevant, and is thus discharged, generating the two goals shown above. Last, the user can replace the trivial tactic by defining an Ltac expression named ``ssrautoprop``. .. _discharge_ssr: Discharge ~~~~~~~~~ The general syntax of the discharging tactical ``:`` is: .. tacn:: @tactic {? @ident } : {+ @d_item } {? @clear_switch } :name: … : … (ssreflect) :undocumented: .. prodn:: d_item ::= {? {| @occ_switch | @clear_switch } } @term .. prodn:: clear_switch ::= { {+ @ident } } with the following requirements. + :token:`tactic` must be one of the four basic tactics described in :ref:`the_defective_tactics_ssr`, i.e., ``move``, ``case``, ``elim`` or ``apply``, the ``exact`` tactic (section :ref:`terminators_ssr`), the ``congr`` tactic (Section :ref:`congruence_ssr`), or the application of the *view* tactical ‘/’ (Section :ref:`interpreting_assumptions_ssr`) to one of ``move``, ``case``, or ``elim``. + The optional :token:`ident` specifies *equation generation* (Section :ref:`generation_of_equations_ssr`), and is only allowed if :token:`tactic` is ``move``, ``case`` or ``elim``, or the application of the view tactical ‘/’ (Section :ref:`interpreting_assumptions_ssr`) to ``case`` or ``elim``. + An :token:`occ_switch` selects occurrences of :token:`term`, as in :ref:`abbreviations_ssr`; :token:`occ_switch` is not allowed if :token:`tactic` is ``apply`` or ``exact``. + A clear item :token:`clear_switch` specifies facts and constants to be deleted from the proof context (as per the ``clear`` tactic). The ``:`` tactical first *discharges* all the :token:`d_item`, right to left, and then performs the tactic, i.e., for each :token:`d_item`, starting with the last one : #. The |SSR| matching algorithm described in Section :ref:`abbreviations_ssr` is used to find occurrences of :token:`term` in the goal, after filling any holes ‘_’ in the term; however if :token:`tactic` is ``apply`` or ``exact``, a different matching algorithm, described below, is used [#4]_. #. These occurrences are replaced by a new variable; in particular, if the term is a fact, this adds an assumption to the goal. #. If the term is *exactly* the name of a constant or fact in the proof context, it is deleted from the context, unless there is an :token:`occ_switch`. Finally, the tactic is performed just after the first :token:`d_item` has been generalized — that is, between steps 2 and 3. The names listed in the final :token:`clear_switch` (if it is present) are cleared first, before :token:`d_item` n is discharged. Switches affect the discharging of a :token:`d_item` as follows. + An :token:`occ_switch` restricts generalization (step 2) to a specific subset of the occurrences of the term, as per Section :ref:`abbreviations_ssr`, and prevents clearing (step 3). + All the names specified by a :token:`clear_switch` are deleted from the context in step 3, possibly in addition to the term. For example, the tactic: .. coqdoc:: move: n {2}n (refl_equal n). + first generalizes ``(refl_equal n : n = n)``; + then generalizes the second occurrence of ``n``. + finally generalizes all the other occurrences of ``n``, and clears ``n`` from the proof context (assuming ``n`` is a proof constant). Therefore, this tactic changes any goal ``G`` into .. coqdoc:: forall n n0 : nat, n = n0 -> G. where the name ``n0`` is picked by the Coq display function, and assuming ``n`` appeared only in ``G``. Finally, note that a discharge operation generalizes defined constants as variables, and not as local definitions. To override this behavior, prefix the name of the local definition with a ``@``, like in ``move: @n``. This is in contrast with the behavior of the ``in`` tactical (see Section :ref:`localization_ssr`), which preserves local definitions by default. Clear rules ``````````` The clear step will fail if the term is a proof constant that appears in other facts; in that case, either the facts should be cleared explicitly with a :token:`clear_switch`, or the clear step should be disabled. The latter can be done by adding an :token:`occ_switch` or simply by putting parentheses around term: both ``move: (n).`` and ``move: {+}n.`` generalize ``n`` without clearing ``n`` from the proof context. The clear step will also fail if the :token:`clear_switch` contains a :token:`ident` that is not in the *proof* context. Note that |SSR| never clears a section constant. If the tactic is ``move`` or ``case`` and an equation :token:`ident` is given, then clearing (step 3) for :token:`d_item` is suppressed (see Section :ref:`generation_of_equations_ssr`). Intro patterns (see Section :ref:`introduction_ssr`) and the ``rewrite`` tactic (see Section :ref:`rewriting_ssr`) let one place a :token:`clear_switch` in the middle of other items (namely identifiers, views and rewrite rules). This can trigger the addition of proof context items to the ones being explicitly cleared, and in turn this can result in ``clear`` errors (e.g., if the context item automatically added occurs in the goal). The relevant sections describe ways to avoid the unintended clearing of context items. Matching for apply and exact ```````````````````````````` The matching algorithm for :token:`d_item` of the |SSR| ``apply`` and ``exact`` tactics exploits the type of the first :token:`d_item` to interpret wildcards in the other :token:`d_item` and to determine which occurrences of these should be generalized. Therefore, occur switches are not needed for ``apply`` and ``exact``. Indeed, the |SSR| tactic ``apply: H x`` is equivalent to ``refine (@H _ … _ x); clear H x``, with an appropriate number of wildcards between ``H`` and ``x``. Note that this means that matching for ``apply`` and ``exact`` has much more context to interpret wildcards; in particular, it can accommodate the ``_`` :token:`d_item`, which would always be rejected after ``move:``. .. example:: .. coqtop:: reset none From Coq Require Import ssreflect. Set Implicit Arguments. Unset Strict Implicit. Unset Printing Implicit Defensive. Axiom f : nat -> nat. Axiom g : nat -> nat. .. coqtop:: all Lemma test (Hfg : forall x, f x = g x) a b : f a = g b. apply: trans_equal (Hfg _) _. This tactic is equivalent (see Section :ref:`bookkeeping_ssr`) to: ``refine (trans_equal (Hfg _) _).`` and this is a common idiom for applying transitivity on the left hand side of an equation. .. _abstract_ssr: The abstract tactic ``````````````````` .. tacn:: abstract: {+ @d_item} :name: abstract (ssreflect) This tactic assigns an abstract constant previously introduced with the :n:`[: @ident ]` intro pattern (see Section :ref:`introduction_ssr`). In a goal like the following:: m : nat abs : n : nat ============= m < 5 + n The tactic :g:`abstract: abs n` first generalizes the goal with respect to :g:`n` (that is not visible to the abstract constant ``abs``) and then assigns abs. The resulting goal is:: m : nat n : nat ============= m < 5 + n Once this subgoal is closed, all other goals having ``abs`` in their context see the type assigned to ``abs``. In this case:: m : nat abs : forall n, m < 5 + n ============= … For a more detailed example, the reader should refer to Section :ref:`structure_ssr`. .. _introduction_ssr: Introduction in the context ~~~~~~~~~~~~~~~~~~~~~~~~~~~ The application of a tactic to a given goal can generate (quantified) variables, assumptions, or definitions, which the user may want to *introduce* as new facts, constants or defined constants, respectively. If the tactic splits the goal into several subgoals, each of them may require the introduction of different constants and facts. Furthermore it is very common to immediately decompose or rewrite with an assumption instead of adding it to the context, as the goal can often be simplified and even proved after this. All these operations are performed by the introduction tactical ``=>``, whose general syntax is .. tacn:: @tactic => {+ @i_item } :name: => :undocumented: .. prodn:: i_item ::= {| @i_pattern | @s_item | @clear_switch | @i_view | @i_block } .. prodn:: s_item ::= {| /= | // | //= } .. prodn:: i_view ::= {? %{%} } {| /@term | /ltac:( @tactic ) } .. prodn:: i_pattern ::= {| @ident | > | _ | ? | * | + | {? @occ_switch } {| -> | <- } | [ {?| @i_item } ] | - | [: {+ @ident } ] } .. prodn:: i_block ::= {| [^ @ident ] | [^~ {| @ident | @natural } ] } The ``=>`` tactical first executes :token:`tactic`, then the :token:`i_item`\s, left to right. An :token:`s_item` specifies a simplification operation; a :token:`clear_switch` specifies context pruning as in :ref:`discharge_ssr`. The :token:`i_pattern`\s can be seen as a variant of *intro patterns* (see :tacn:`intros`); each performs an introduction operation, i.e., pops some variables or assumptions from the goal. Simplification items ````````````````````` An :token:`s_item` can simplify the set of subgoals or the subgoals themselves. + ``//`` removes all the “trivial” subgoals that can be resolved by the |SSR| tactic :tacn:`done` described in :ref:`terminators_ssr`, i.e., it executes ``try done``. + ``/=`` simplifies the goal by performing partial evaluation, as per the tactic :tacn:`simpl` [#5]_. + ``//=`` combines both kinds of simplification; it is equivalent to ``/= //``, i.e., ``simpl; try done``. When an :token:`s_item` immediately precedes a :token:`clear_switch`, then the :token:`clear_switch` is executed *after* the :token:`s_item`, e.g., ``{IHn}//`` will solve some subgoals, possibly using the fact ``IHn``, and will erase ``IHn`` from the context of the remaining subgoals. Views ````` The first entry in the :token:`i_view` grammar rule, :n:`/@term`, represents a view (see Section :ref:`views_and_reflection_ssr`). It interprets the top of the stack with the view :token:`term`. It is equivalent to :n:`move/@term`. A :token:`clear_switch` that immediately precedes an :token:`i_view` is complemented with the name of the view if an only if the :token:`i_view` is a simple proof context entry [#10]_. E.g., ``{}/v`` is equivalent to ``/v{v}``. This behavior can be avoided by separating the :token:`clear_switch` from the :token:`i_view` with the ``-`` intro pattern or by putting parentheses around the view. A :token:`clear_switch` that immediately precedes an :token:`i_view` is executed after the view application. If the next :token:`i_item` is a view, then the view is applied to the assumption in top position once all the previous :token:`i_item` have been performed. The second entry in the :token:`i_view` grammar rule, ``/ltac:(`` :token:`tactic` ``)``, executes :token:`tactic`. Notations can be used to name tactics, for example .. coqtop:: none Tactic Notation "my" "ltac" "code" := idtac. .. coqtop:: in warn Notation "'myop'" := (ltac:(my ltac code)) : ssripat_scope. lets one write just ``/myop`` in the intro pattern. Note the scope annotation: views are interpreted opening the ``ssripat`` scope. We provide the following ltac views: ``/[dup]`` to duplicate the top of the stack, ``/[swap]`` to swap the two first elements and ``/[apply]`` to apply the top of the stack to the next. Intro patterns `````````````` |SSR| supports the following :token:`i_pattern`\s. :token:`ident` pops the top variable, assumption, or local definition into a new constant, fact, or defined constant :token:`ident`, respectively. Note that defined constants cannot be introduced when δ-expansion is required to expose the top variable or assumption. A :token:`clear_switch` (even an empty one) immediately preceding an :token:`ident` is complemented with that :token:`ident` if and only if the identifier is a simple proof context entry [#10]_. As a consequence, by prefixing the :token:`ident` with ``{}`` one can *replace* a context entry. This behavior can be avoided by separating the :token:`clear_switch` from the :token:`ident` with the ``-`` intro pattern. Thus, trying to clear an :token:`ident` `H` with `{H}H` triggers the following warning: .. warn:: Duplicate clear of H. Use %{ %}H instead of %{ H %}H The warning can be silenced or made fatal with the :opt:`Warnings` option with the `duplicate-clear` key. ``>`` pops every variable occurring in the rest of the stack. Type class instances are popped even if they don't occur in the rest of the stack. The tactic ``move=> >`` is equivalent to ``move=> ? ?`` on a goal such as:: forall x y, x < y -> G A typical use if ``move=>> H`` to name ``H`` the first assumption, in the example above ``x < y``. ``?`` pops the top variable into an anonymous constant or fact, whose name is picked by the tactic interpreter. |SSR| only generates names that cannot appear later in the user script [#6]_. ``_`` pops the top variable into an anonymous constant that will be deleted from the proof context of all the subgoals produced by the ``=>`` tactical. They should thus never be displayed, except in an error message if the constant is still actually used in the goal or context after the last :token:`i_item` has been executed (:token:`s_item` can erase goals or terms where the constant appears). ``*`` pops all the remaining apparent variables/assumptions as anonymous constants/facts. Unlike ``?`` and ``move``, the ``*`` :token:`i_item` does not expand definitions in the goal to expose quantifiers, so it may be useful to repeat a ``move=> *`` tactic, e.g., on the goal:: forall a b : bool, a <> b a first ``move=> *`` adds only ``_a_ : bool`` and ``_b_ : bool`` to the context; it takes a second ``move=> *`` to add ``_Hyp_ : _a_ = _b_``. ``+`` temporarily introduces the top variable. It is discharged at the end of the intro pattern. For example ``move=> + y`` on a goal:: forall x y, P is equivalent to ``move=> _x_ y; move: _x_`` that results in the goal:: forall x, P :n:`{? occ_switch } ->` (resp. :token:`occ_switch` ``<-``) pops the top assumption (which should be a rewritable proposition) into an anonymous fact, rewrites (resp. rewrites right to left) the goal with this fact (using the |SSR| ``rewrite`` tactic described in Section :ref:`rewriting_ssr`, and honoring the optional occurrence selector), and finally deletes the anonymous fact from the context. ``[`` :token:`i_item` * ``| … |`` :token:`i_item` * ``]`` when it is the very *first* :token:`i_pattern` after tactic ``=>`` tactical *and* the tactic is not a move, is a *branching* :token:`i_pattern`. It executes the sequence :n:`@i_item__i` on the i-th subgoal produced by the tactic. The execution of the tactic should thus generate exactly m subgoals, unless the ``[…]`` :token:`i_pattern` comes after an initial ``//`` or ``//=`` :token:`s_item` that closes some of the goals produced by the tactic, in which case exactly m subgoals should remain after the :token:`s_item`, or we have the trivial branching :token:`i_pattern` [], which always does nothing, regardless of the number of remaining subgoals. ``[`` :token:`i_item` * ``| … |`` :token:`i_item` * ``]`` when it is *not* the first :token:`i_pattern` or when the tactic is a ``move``, is a *destructing* :token:`i_pattern`. It starts by destructing the top variable, using the |SSR| ``case`` tactic described in :ref:`the_defective_tactics_ssr`. It then behaves as the corresponding branching :token:`i_pattern`, executing the sequence :n:`@i_item__i` in the i-th subgoal generated by the case analysis; unless we have the trivial destructing :token:`i_pattern` ``[]``, the latter should generate exactly m subgoals, i.e., the top variable should have an inductive type with exactly m constructors [#7]_. While it is good style to use the :token:`i_item` i * to pop the variables and assumptions corresponding to each constructor, this is not enforced by |SSR|. ``-`` does nothing, but counts as an intro pattern. It can also be used to force the interpretation of ``[`` :token:`i_item` * ``| … |`` :token:`i_item` * ``]`` as a case analysis like in ``move=> -[H1 H2]``. It can also be used to indicate explicitly the link between a view and a name like in ``move=> /eqP-H1``. Last, it can serve as a separator between views. Section :ref:`views_and_reflection_ssr` [#9]_ explains in which respect the tactic ``move=> /v1/v2`` differs from the tactic ``move=> /v1-/v2``. ``[:`` :token:`ident` ``…]`` introduces in the context an abstract constant for each :token:`ident`. Its type has to be fixed later on by using the ``abstract`` tactic. Before then the type displayed is ````. Note that |SSR| does not support the syntax ``(ipat, …, ipat)`` for destructing intro patterns. Clear switch ```````````` Clears are deferred until the end of the intro pattern. .. example:: .. coqtop:: reset none From Coq Require Import ssreflect ssrbool. Set Implicit Arguments. Unset Strict Implicit. Unset Printing Implicit Defensive. .. coqtop:: all Lemma test x y : Nat.leb 0 x = true -> (Nat.leb 0 x) && (Nat.leb y 2) = true. move=> {x} ->. If the cleared names are reused in the same intro pattern, a renaming is performed behind the scenes. Facts mentioned in a clear switch must be valid names in the proof context (excluding the section context). Branching and destructuring ``````````````````````````` The rules for interpreting branching and destructing :token:`i_pattern` are motivated by the fact that it would be pointless to have a branching pattern if the tactic is a ``move``, and in most of the remaining cases the tactic is ``case`` or ``elim``, which implies destructuring. The rules above imply that: + ``move=> [a b].`` + ``case=> [a b].`` + ``case=> a b.`` are all equivalent, so which one to use is a matter of style; ``move`` should be used for casual decomposition, such as splitting a pair, and ``case`` should be used for actual decompositions, in particular for type families (see :ref:`type_families_ssr`) and proof by contradiction. The trivial branching :token:`i_pattern` can be used to force the branching interpretation, e.g.: + ``case=> [] [a b] c.`` + ``move=> [[a b] c].`` + ``case; case=> a b c.`` are all equivalent. Block introduction `````````````````` |SSR| supports the following :token:`i_block`\s. :n:`[^ @ident ]` *block destructing* :token:`i_pattern`. It performs a case analysis on the top variable and introduces, in one go, all the variables coming from the case analysis. The names of these variables are obtained by taking the names used in the inductive type declaration and prefixing them with :token:`ident`. If the intro pattern immediately follows a call to ``elim`` with a custom eliminator (see :ref:`custom_elim_ssr`), then the names are taken from the ones used in the type of the eliminator. .. example:: .. coqtop:: reset none From Coq Require Import ssreflect. Set Implicit Arguments. Unset Strict Implicit. Unset Printing Implicit Defensive. .. coqtop:: all Record r := { a : nat; b := (a, 3); _ : bool; }. Lemma test : r -> True. Proof. move => [^ x ]. :n:`[^~ @ident ]` *block destructing* using :token:`ident` as a suffix. :n:`[^~ @natural ]` *block destructing* using :token:`natural` as a suffix. Only a :token:`s_item` is allowed between the elimination tactic and the block destructing. .. _generation_of_equations_ssr: Generation of equations ~~~~~~~~~~~~~~~~~~~~~~~ The generation of named equations option stores the definition of a new constant as an equation. The tactic: .. coqdoc:: move En: (size l) => n. where ``l`` is a list, replaces ``size l`` by ``n`` in the goal and adds the fact ``En : size l = n`` to the context. This is quite different from: .. coqdoc:: pose n := (size l). which generates a definition ``n := (size l)``. It is not possible to generalize or rewrite such a definition; on the other hand, it is automatically expanded during computation, whereas expanding the equation ``En`` requires explicit rewriting. The use of this equation name generation option with a ``case`` or an ``elim`` tactic changes the status of the first :token:`i_item`, in order to deal with the possible parameters of the constants introduced. .. example:: .. coqtop:: reset none From Coq Require Import ssreflect. Set Implicit Arguments. Unset Strict Implicit. Unset Printing Implicit Defensive. .. coqtop:: all Lemma test (a b :nat) : a <> b. case E : a => [|n]. If the user does not provide a branching :token:`i_item` as first :token:`i_item`, or if the :token:`i_item` does not provide enough names for the arguments of a constructor, then the constants generated are introduced under fresh |SSR| names. .. example:: .. coqtop:: reset none From Coq Require Import ssreflect. Set Implicit Arguments. Unset Strict Implicit. Unset Printing Implicit Defensive. .. coqtop:: all Lemma test (a b :nat) : a <> b. case E : a => H. Show 2. Combining the generation of named equations mechanism with the :tacn:`case` tactic strengthens the power of a case analysis. On the other hand, when combined with the :tacn:`elim` tactic, this feature is mostly useful for debug purposes, to trace the values of decomposed parameters and pinpoint failing branches. .. _type_families_ssr: Type families ~~~~~~~~~~~~~ When the top assumption of a goal has an inductive type, two specific operations are possible: the case analysis performed by the :tacn:`case` tactic, and the application of an induction principle, performed by the :tacn:`elim` tactic. When this top assumption has an inductive type, which is moreover an instance of a type family, Coq may need help from the user to specify which occurrences of the parameters of the type should be substituted. .. tacv:: case: {+ @d_item } / {+ @d_item } elim: {+ @d_item } / {+ @d_item } A specific ``/`` switch indicates the type family parameters of the type of a :token:`d_item` immediately following this ``/`` switch. The :token:`d_item` on the right side of the ``/`` switch are discharged as described in Section :ref:`discharge_ssr`. The case analysis or elimination will be done on the type of the top assumption after these discharge operations. Every :token:`d_item` preceding the ``/`` is interpreted as an argument of this type, which should be an instance of an inductive type family. These terms are not actually generalized, but rather selected for substitution. Occurrence switches can be used to restrict the substitution. If a term is left completely implicit (e.g., writing just ``_``), then a pattern is inferred by looking at the type of the top assumption. This allows for the compact syntax: .. coqdoc:: case: {2}_ / eqP. where ``_`` is interpreted as ``(_ == _)``, since ``eqP T a b : reflect (a = b) (a == b)`` and ``reflect`` is a type family with one index. Moreover, if the :token:`d_item` list is too short, it is padded with an initial sequence of ``_`` of the right length. .. example:: Here is a small example on lists. We define first a function that adds an element at the end of a given list. .. coqtop:: reset none From Coq Require Import ssreflect. Set Implicit Arguments. Unset Strict Implicit. Unset Printing Implicit Defensive. .. coqtop:: all Require Import List. Section LastCases. Variable A : Type. Implicit Type l : list A. Fixpoint add_last a l : list A := match l with | nil => a :: nil | hd :: tl => hd :: (add_last a tl) end. Then we define an inductive predicate for case analysis on lists according to their last element: .. coqtop:: all Inductive last_spec : list A -> Type := | LastSeq0 : last_spec nil | LastAdd s x : last_spec (add_last x s). Theorem lastP : forall l : list A, last_spec l. Admitted. We are now ready to use ``lastP`` in conjunction with ``case``. .. coqtop:: all Lemma test l : (length l) * 2 = length (l ++ l). case: (lastP l). Applied to the same goal, the tactic ``case: l / (lastP l)`` generates the same subgoals, but ``l`` has been cleared from both contexts: .. coqtop:: all restart case: l / (lastP l). Again applied to the same goal: .. coqtop:: all restart abort case: {1 3}l / (lastP l). Note that the selected occurrences on the left of the ``/`` switch have been substituted with ``l`` instead of being affected by the case analysis. The equation name generation feature combined with a type family ``/`` switch generates an equation for the *first* dependent :token:`d_item` specified by the user. Again starting with the above goal, the command: .. example:: .. coqtop:: all Lemma test l : (length l) * 2 = length (l ++ l). case E: {1 3}l / (lastP l) => [|s x]. Show 2. There must be at least one :token:`d_item` to the left of the ``/`` switch; this prevents any confusion with the view feature. However, the :token:`d_item` to the right of the ``/`` are optional, and if they are omitted, the first assumption provides the instance of the type family. The equation always refers to the first :token:`d_item` in the actual tactic call, before any padding with initial ``_``. Thus, if an inductive type has two family parameters, it is possible to have |SSR| generate an equation for the second one by omitting the pattern for the first; note however that this will fail if the type of the second parameter depends on the value of the first parameter. Control flow ------------ .. _indentation_ssr: Indentation and bullets ~~~~~~~~~~~~~~~~~~~~~~~ A linear development of Coq scripts gives little information on the structure of the proof. In addition, replaying a proof after some changes in the statement to be proved will usually not display information to distinguish between the various branches of case analysis for instance. To help the user in this organization of the proof script at development time, |SSR| provides some bullets to highlight the structure of branching proofs. The available bullets are ``-``, ``+`` and ``*``. Combined with tabulation, this lets us highlight four nested levels of branching; the most we have ever needed is three. Indeed, the use of “simpl and closing” switches, of terminators (see Section :ref:`terminators_ssr`) and selectors (see Section :ref:`selectors_ssr`) is powerful enough to avoid most of the time more than two levels of indentation. Here is a fragment of such a structured script:: case E1: (abezoutn _ _) => [[| k1] [| k2]]. - rewrite !muln0 !gexpn0 mulg1 => H1. move/eqP: (sym_equal F0); rewrite -H1 orderg1 eqn_mul1. by case/andP; move/eqP. - rewrite muln0 gexpn0 mulg1 => H1. have F1: t %| t * S k2.+1 - 1. apply: (@dvdn_trans (orderg x)); first by rewrite F0; exact: dvdn_mull. rewrite orderg_dvd; apply/eqP; apply: (mulgI x). rewrite -{1}(gexpn1 x) mulg1 gexpn_add leq_add_sub //. by move: P1; case t. rewrite dvdn_subr in F1; last by exact: dvdn_mulr. + rewrite H1 F0 -{2}(muln1 (p ^ l)); congr (_ * _). by apply/eqP; rewrite -dvdn1. + by move: P1; case: (t) => [| [| s1]]. - rewrite muln0 gexpn0 mul1g => H1. ... .. _terminators_ssr: Terminators ~~~~~~~~~~~ To further structure scripts, |SSR| supplies *terminating* tacticals to explicitly close off tactics. When replaying scripts, we then have the nice property that an error immediately occurs when a closed tactic fails to prove its subgoal. It is hence recommended practice that the proof of any subgoal should end with a tactic that *fails if it does not solve the current goal*, like :tacn:`discriminate`, :tacn:`contradiction` or :tacn:`assumption`. In fact, |SSR| provides a generic tactical that turns any tactic into a closing one (similar to :tacn:`now`). Its general syntax is: .. tacn:: by @tactic :name: by :undocumented: The Ltac expression :n:`by [@tactic | @tactic | …]` is equivalent to :n:`do [done | by @tactic | by @tactic | …]`, which corresponds to the standard Ltac expression :n:`first [done | @tactic; done | @tactic; done | …]`. In the script provided as example in Section :ref:`indentation_ssr`, the paragraph corresponding to each sub-case ends with a tactic line prefixed with a ``by``, like in: .. coqdoc:: by apply/eqP; rewrite -dvdn1. .. tacn:: done :name: done The :tacn:`by` tactical is implemented using the user-defined, and extensible, :tacn:`done` tactic. This :tacn:`done` tactic tries to solve the current goal by some trivial means and fails if it doesn’t succeed. Indeed, the tactic expression :n:`by @tactic` is equivalent to :n:`@tactic; done`. Conversely, the tactic ``by [ ]`` is equivalent to :tacn:`done`. The default implementation of the :tacn:`done` tactic, in the ``ssreflect.v`` file, is: .. coqdoc:: Ltac done := trivial; hnf; intros; solve [ do ![solve [trivial | apply: sym_equal; trivial] | discriminate | contradiction | split] | case not_locked_false_eq_true; assumption | match goal with H : ~ _ |- _ => solve [case H; trivial] end ]. The lemma :g:`not_locked_false_eq_true` is needed to discriminate *locked* boolean predicates (see Section :ref:`locking_ssr`). The iterator tactical ``do`` is presented in Section :ref:`iteration_ssr`. This tactic can be customized by the user, for instance to include an :tacn:`auto` tactic. A natural and common way of closing a goal is to apply a lemma that is the exact one needed for the goal to be solved. The defective form of the tactic: .. coqdoc:: exact. is equivalent to: .. coqdoc:: do [done | by move=> top; apply top]. where ``top`` is a fresh name assigned to the top assumption of the goal. This applied form is supported by the ``:`` discharge tactical, and the tactic: .. coqdoc:: exact: MyLemma. is equivalent to: .. coqdoc:: by apply: MyLemma. (see Section :ref:`discharge_ssr` for the documentation of the apply: combination). .. warning:: The list of tactics (possibly chained by semicolons) that follows the ``by`` keyword is considered to be a parenthesized block applied to the current goal. Hence for example if the tactic: .. coqdoc:: by rewrite my_lemma1. succeeds, then the tactic: .. coqdoc:: by rewrite my_lemma1; apply my_lemma2. usually fails since it is equivalent to: .. coqdoc:: by (rewrite my_lemma1; apply my_lemma2). .. _selectors_ssr: Selectors ~~~~~~~~~ .. tacn:: last first :name: last; first (ssreflect) When composing tactics, the two tacticals ``first`` and ``last`` let the user restrict the application of a tactic to only one of the subgoals generated by the previous tactic. This covers the frequent cases where a tactic generates two subgoals one of which can be easily disposed of. This is another powerful way of linearization of scripts, since it happens very often that a trivial subgoal can be solved in a less than one line tactic. For instance, :n:`@tactic ; last by @tactic` tries to solve the last subgoal generated by the first tactic using the given second tactic, and fails if it does not succeed. Its analogue :n:`@tactic ; first by @tactic` tries to solve the first subgoal generated by the first tactic using the second given tactic, and fails if it does not succeed. |SSR| also offers an extension of this facility, by supplying tactics to *permute* the subgoals generated by a tactic. .. tacv:: last first first last :name: last first; first last These two equivalent tactics invert the order of the subgoals in focus. .. tacv:: last @natural first If :token:`natural`\'s value is :math:`k`, this tactic rotates the :math:`n` subgoals :math:`G_1` , …, :math:`G_n` in focus. Subgoal :math:`G_{n + 1 − k}` becomes the first, and the circular order of subgoals remains unchanged. .. tacn:: first @natural last :name: first (ssreflect) If :token:`natural`\'s value is :math:`k`, this tactic rotates the :math:`n` subgoals :math:`G_1` , …, :math:`G_n` in focus. Subgoal :math:`G_{k + 1 \bmod n}` becomes the first, and the circular order of subgoals remains unchanged. Finally, the tactics ``last`` and ``first`` combine with the branching syntax of Ltac: if the tactic generates n subgoals on a given goal, then the tactic .. coqdoc:: tactic ; last k [ tactic1 |…| tacticm ] || tacticn. applies ``tactic1`` to the :math:`n−k+1`\-th goal, … ``tacticm`` to the :math:`n−k+m`\-th goal and ``tacticn`` to the others. .. example:: Here is a small example on lists. We define first a function that adds an element at the end of a given list. .. coqtop:: reset none From Coq Require Import ssreflect. Set Implicit Arguments. Unset Strict Implicit. Unset Printing Implicit Defensive. .. coqtop:: all Inductive test : nat -> Prop := | C1 n of n = 1 : test n | C2 n of n = 2 : test n | C3 n of n = 3 : test n | C4 n of n = 4 : test n. Lemma example n (t : test n) : True. case: t; last 2 [move=> k| move=> l]; idtac. .. _iteration_ssr: Iteration ~~~~~~~~~ .. tacn:: do {? @mult } {| @tactic | [ {+| @tactic } ] } :name: do (ssreflect) This tactical offers an accurate control on the repetition of tactics. :token:`mult` is a *multiplier*. Brackets can only be omitted if a single tactic is given *and* a multiplier is present. A tactic of the form: .. coqdoc:: do [ tactic 1 | … | tactic n ]. is equivalent to the standard Ltac expression: .. coqdoc:: first [ tactic 1 | … | tactic n ]. The optional multiplier :token:`mult` specifies how many times the action of ``tactic`` should be repeated on the current subgoal. There are four kinds of multipliers: .. prodn:: mult ::= {| @natural ! | ! | @natural ? | ? } Their meaning is as follows. + With ``n!``, the step tactic is repeated exactly ``n`` times (where ``n`` is a positive integer argument). + With ``!``, the step tactic is repeated as many times as possible, and done at least once. + With ``?``, the step tactic is repeated as many times as possible, optionally. + Finally, with ``n?``, the step tactic is repeated up to ``n`` times, optionally. For instance, the tactic: .. coqdoc:: tactic; do 1? rewrite mult_comm. rewrites at most one time the lemma ``mult_comm`` in all the subgoals generated by tactic, whereas the tactic: .. coqdoc:: tactic; do 2! rewrite mult_comm. rewrites exactly two times the lemma ``mult_comm`` in all the subgoals generated by ``tactic``, and fails if this rewrite is not possible in some subgoal. Note that the combination of multipliers and rewrite is so often used that multipliers are in fact integrated to the syntax of the |SSR| rewrite tactic, see Section :ref:`rewriting_ssr`. .. _localization_ssr: Localization ~~~~~~~~~~~~ In Sections :ref:`basic_localization_ssr` and :ref:`bookkeeping_ssr`, we have already presented the *localization* tactical ``in``, whose general syntax is: .. tacn:: @tactic in {+ @ident} {? * } :name: in :undocumented: where :token:`ident` is a name in the context. On the left side of ``in``, :token:`tactic` can be ``move``, ``case``, ``elim``, ``rewrite``, ``set``, or any tactic formed with the general iteration tactical ``do`` (see Section :ref:`iteration_ssr`). The operation described by the tactic is performed in the facts listed after ``in`` and in the goal if a ``*`` ends the list of names. The ``in`` tactical successively: + generalizes the selected hypotheses, possibly “protecting” the goal if ``*`` is not present; + performs :token:`tactic`, on the obtained goal; + reintroduces the generalized facts, under the same names. This defective form of the ``do`` tactical is useful to avoid clashes between standard Ltac ``in`` and the |SSR| tactical in. .. example:: .. coqtop:: reset none From Coq Require Import ssreflect. Set Implicit Arguments. Unset Strict Implicit. Unset Printing Implicit Defensive. .. coqtop:: all Ltac mytac H := rewrite H. Lemma test x y (H1 : x = y) (H2 : y = 3) : x + y = 6. do [mytac H2] in H1 *. the last tactic rewrites the hypothesis ``H2 : y = 3`` both in ``H1 : x = y`` and in the goal ``x + y = 6``. By default, ``in`` keeps the body of local definitions. To erase the body of a local definition during the generalization phase, the name of the local definition must be written between parentheses, like in ``rewrite H in H1 (def_n) H2.`` .. tacv:: @tactic in {+ {| @clear_switch | {? @}@ident | ( @ident ) | ( {? @}@ident := @c_pattern ) } } {? * } This is the most general form of the ``in`` tactical. In its simplest form, the last option lets one rename hypotheses that can’t be cleared (like section variables). For example, ``(y := x)`` generalizes over ``x`` and reintroduces the generalized variable under the name ``y`` (and does not clear ``x``). For a more precise description of this form of localization, refer to :ref:`advanced_generalization_ssr`. .. _structure_ssr: Structure ~~~~~~~~~ Forward reasoning structures the script by explicitly specifying some assumptions to be added to the proof context. It is closely associated with the declarative style of proof, since an extensive use of these highlighted statements makes the script closer to a (very detailed) textbook proof. Forward chaining tactics allow to state an intermediate lemma and start a piece of script dedicated to the proof of this statement. The use of closing tactics (see Section :ref:`terminators_ssr`) and of indentation makes syntactically explicit the portion of the script building the proof of the intermediate statement. The have tactic. ```````````````` .. tacn:: have : @term :name: have This is the main |SSR| forward reasoning tactic. It can be used in two modes: one starts a new (sub)proof for an intermediate result in the main proof, and the other provides explicitly a proof term for this intermediate step. This tactic supports open syntax for :token:`term`. Applied to a goal ``G``, it generates a first subgoal requiring a proof of :token:`term` in the context of ``G``. The second generated subgoal is of the form :n:`term -> G`, where term becomes the new top assumption, instead of being introduced with a fresh name. At the proof-term level, the ``have`` tactic creates a β redex, and introduces the lemma under a fresh name, automatically chosen. Like in the case of the :n:`pose (ssreflect)` tactic (see Section :ref:`definitions_ssr`), the types of the holes are abstracted in term. .. example:: .. coqtop:: reset none From Coq Require Import ssreflect. Set Implicit Arguments. Unset Strict Implicit. Unset Printing Implicit Defensive. .. coqtop:: all Lemma test : True. have: _ * 0 = 0. The invocation of ``have`` is equivalent to: .. coqtop:: reset none From Coq Require Import ssreflect. Set Implicit Arguments. Unset Strict Implicit. Unset Printing Implicit Defensive. Lemma test : True. .. coqtop:: all have: forall n : nat, n * 0 = 0. The ``have`` tactic also enjoys the same abstraction mechanism as the :tacn:`pose (ssreflect)` tactic for the non-inferred implicit arguments. For instance, the tactic: .. example:: .. coqtop:: reset none From Coq Require Import ssreflect. Set Implicit Arguments. Unset Strict Implicit. Unset Printing Implicit Defensive. Lemma test : True. .. coqtop:: all have: forall x y, (x, y) = (x, y + 0). opens a new subgoal where the type of ``x`` is quantified. The behavior of the defective have tactic makes it possible to generalize it in the following general construction: .. tacn:: have {* @i_item } {? @i_pattern } {? {| @s_item | {+ @ssr_binder } } } {? : @term } {? {| := @term | by @tactic } } :undocumented: Open syntax is supported for both :token:`term`. For the description of :token:`i_item` and :token:`s_item`, see Section :ref:`introduction_ssr`. The first mode of the have tactic, which opens a sub-proof for an intermediate result, uses tactics of the form: .. tacv:: have @clear_switch @i_item : @term by @tactic :undocumented: which behaves like: .. coqdoc:: have: term ; first by tactic. move=> clear_switch i_item. Note that the :token:`clear_switch` *precedes* the :token:`i_item`, which allows to reuse a name of the context, possibly used by the proof of the assumption, to introduce the new assumption itself. The ``by`` feature is especially convenient when the proof script of the statement is very short, basically when it fits in one line like in: .. coqdoc:: have H23 : 3 + 2 = 2 + 3 by rewrite addnC. The possibility of using :token:`i_item` supplies a very concise syntax for the further use of the intermediate step. For instance, .. example:: .. coqtop:: reset none From Coq Require Import ssreflect. Set Implicit Arguments. Unset Strict Implicit. Unset Printing Implicit Defensive. .. coqtop:: all Lemma test a : 3 * a - 1 = a. have -> : forall x, x * a = a. Note how the second goal was rewritten using the stated equality. Also note that in this last subgoal, the intermediate result does not appear in the context. Thanks to the deferred execution of clears, the following idiom is also supported (assuming x occurs in the goal only): .. coqdoc:: have {x} -> : x = y. Another frequent use of the intro patterns combined with ``have`` is the destruction of existential assumptions like in the tactic: .. example:: .. coqtop:: reset none From Coq Require Import ssreflect. Set Implicit Arguments. Unset Strict Implicit. Unset Printing Implicit Defensive. .. coqtop:: all Lemma test : True. have [x Px]: exists x : nat, x > 0; last first. An alternative use of the ``have`` tactic is to provide the explicit proof term for the intermediate lemma, using tactics of the form: .. tacv:: have {? @ident } := @term This tactic creates a new assumption of type the type of :token:`term`. If the optional :token:`ident` is present, this assumption is introduced under the name :token:`ident`. Note that the body of the constant is lost for the user. Again, non-inferred implicit arguments and explicit holes are abstracted. .. example:: .. coqtop:: reset none From Coq Require Import ssreflect. Set Implicit Arguments. Unset Strict Implicit. Unset Printing Implicit Defensive. .. coqtop:: all Lemma test : True. have H := forall x, (x, x) = (x, x). adds to the context ``H : Type -> Prop.`` This is a schematic example, but the feature is specially useful when the proof term to give involves for instance a lemma with some hidden implicit arguments. After the :token:`i_pattern`, a list of binders is allowed. .. example:: .. coqtop:: reset none From Coq Require Import ssreflect. From Coq Require Import ZArith Lia. Set Implicit Arguments. Unset Strict Implicit. Unset Printing Implicit Defensive. .. coqtop:: all Lemma test : True. have H x (y : nat) : 2 * x + y = x + x + y by lia. A proof term provided after ``:=`` can mention these bound variables (that are automatically introduced with the given names). Since the :token:`i_pattern` can be omitted, to avoid ambiguity, bound variables can be surrounded with parentheses even if no type is specified: .. coqtop:: all restart have (x) : 2 * x = x + x by lia. The :token:`i_item` and :token:`s_item` can be used to interpret the asserted hypothesis with views (see Section :ref:`views_and_reflection_ssr`) or simplify the resulting goals. The :tacn:`have` tactic also supports a ``suff`` modifier that allows for asserting that a given statement implies the current goal without copying the goal itself. .. example:: .. coqtop:: all restart abort have suff H : 2 + 2 = 3; last first. Note that H is introduced in the second goal. The ``suff`` modifier is not compatible with the presence of a list of binders. .. _generating_let_ssr: Generating let in context entries with have ``````````````````````````````````````````` Since |SSR| 1.5, the :tacn:`have` tactic supports a “transparent” modifier to generate ``let in`` context entries: the ``@`` symbol in front of the context entry name. .. example:: .. coqtop:: none Set Printing Depth 15. .. coqtop:: all abort Inductive Ord n := Sub x of x < n. Notation "'I_ n" := (Ord n) (at level 8, n at level 2, format "''I_' n"). Arguments Sub {_} _ _. Lemma test n m (H : m + 1 < n) : True. have @i : 'I_n by apply: (Sub m); lia. Note that the subterm produced by :tacn:`lia` is in general huge and uninteresting, and hence one may want to hide it. For this purpose the ``[: name]`` intro pattern and the tactic ``abstract`` (see :ref:`abstract_ssr`) are provided. .. example:: .. coqtop:: all abort Lemma test n m (H : m + 1 < n) : True. have [:pm] @i : 'I_n by apply: (Sub m); abstract: pm; lia. The type of ``pm`` can be cleaned up by its annotation ``(*1*)`` by just simplifying it. The annotations are there for technical reasons only. When intro patterns for abstract constants are used in conjunction with`` have`` and an explicit term, they must be used as follows: .. example:: .. coqtop:: all abort Lemma test n m (H : m + 1 < n) : True. have [:pm] @i : 'I_n := Sub m pm. by lia. In this case, the abstract constant ``pm`` is assigned by using it in the term that follows ``:=`` and its corresponding goal is left to be solved. Goals corresponding to intro patterns for abstract constants are opened in the order in which the abstract constants are declared (not in the “order” in which they are used in the term). Note that abstract constants do respect scopes. Hence, if a variable is declared after their introduction, it has to be properly generalized (i.e., explicitly passed to the abstract constant when one makes use of it). .. example:: .. coqtop:: all abort Lemma test n m (H : m + 1 < n) : True. have [:pm] @i k : 'I_(n+k) by apply: (Sub m); abstract: pm k; lia. Last, notice that the use of intro patterns for abstract constants is orthogonal to the transparent flag ``@`` for ``have``. The have tactic and typeclass resolution ``````````````````````````````````````````` Since |SSR| 1.5, the ``have`` tactic behaves as follows with respect to typeclass inference. .. coqtop:: none Axiom ty : Type. Axiom t : ty. Goal True. .. coqtop:: all have foo : ty. Full inference for ``ty``. The first subgoal demands a proof of such instantiated statement. .. A strange bug prevents using the coqtop directive here .. coqdoc:: have foo : ty := . No inference for ``ty``. Unresolved instances are quantified in ``ty``. The first subgoal demands a proof of such quantified statement. Note that no proof term follows ``:=``; hence two subgoals are generated. .. coqtop:: all restart have foo : ty := t. No inference for ``ty`` and ``t``. .. coqtop:: all restart abort have foo := t. No inference for ``t``. Unresolved instances are quantified in the (inferred) type of ``t`` and abstracted in ``t``. .. flag:: SsrHave NoTCResolution This :term:`flag` restores the behavior of |SSR| 1.4 and below (never resolve typeclasses). Variants: the suff and wlog tactics ``````````````````````````````````` As is often the case in mathematical textbooks, forward reasoning may be used in slightly different variants. One of these variants is to show that the intermediate step L easily implies the initial goal G. By easily we mean here that the proof of L ⇒ G is shorter than the one of L itself. This kind of reasoning step usually starts with: “It suffices to show that …”. This is such a frequent way of reasoning that |SSR| has a variant of the ``have`` tactic called ``suffices`` (whose abridged name is ``suff``). The ``have`` and ``suff`` tactics are equivalent and have the same syntax but: + the order of the generated subgoals is inverted; + the optional clear item is still performed in the *second* branch, which means that the tactic: .. coqdoc:: suff {H} H : forall x : nat, x >= 0. fails if the context of the current goal indeed contains an assumption named ``H``. The rationale of this clearing policy is to make possible “trivial” refinements of an assumption, without changing its name in the main branch of the reasoning. The ``have`` modifier can follow the ``suff`` tactic. .. example:: .. coqtop:: none Axioms G P : Prop. .. coqtop:: all abort Lemma test : G. suff have H : P. Note that, in contrast with ``have suff``, the name H has been introduced in the first goal. Another useful construct is reduction, showing that a particular case is in fact general enough to prove a general property. This kind of reasoning step usually starts with: “Without loss of generality, we can suppose that …”. Formally, this corresponds to the proof of a goal ``G`` by introducing a cut: ``wlog_statement -> G``. Hence the user shall provide a proof for both ``(wlog_statement -> G) -> G`` and ``wlog_statement -> G``. However, such cuts are usually rather painful to perform by hand, because the statement ``wlog_statement`` is tedious to write by hand, and sometimes even to read. |SSR| implements this kind of reasoning step through the :tacn:`without loss` tactic, whose short name is :tacn:`wlog`. It offers support to describe the shape of the cut statements, by providing the simplifying hypothesis and by pointing at the elements of the initial goals that should be generalized. The general syntax of without loss is: .. tacn:: wlog {? suff } {? @clear_switch } {? @i_item } : {* @ident } / @term without loss {? suff } {? @clear_switch } {? @i_item } : {* @ident } / @term :name: wlog; without loss :undocumented: where each :token:`ident` is a constant in the context of the goal. Open syntax is supported for :token:`term`. In its defective form: .. tacv:: wlog: / @term without loss: / @term :undocumented: on a goal G, it creates two subgoals: a first one to prove the formula (term -> G) -> G and a second one to prove the formula term -> G. If the optional list of :token:`ident` is present on the left side of ``/``, these constants are generalized in the premise (term -> G) of the first subgoal. By default bodies of local definitions are erased. This behavior can be inhibited by prefixing the name of the local definition with the ``@`` character. In the second subgoal, the tactic: .. coqdoc:: move=> clear_switch i_item. is performed if at least one of these optional switches is present in the :tacn:`wlog` tactic. The :tacn:`wlog` tactic is specially useful when a symmetry argument simplifies a proof. Here is an example showing the beginning of the proof that quotient and reminder of natural number euclidean division are unique. .. example:: .. coqtop:: all Lemma quo_rem_unicity d q1 q2 r1 r2 : q1*d + r1 = q2*d + r2 -> r1 < d -> r2 < d -> (q1, r1) = (q2, r2). wlog: q1 q2 r1 r2 / q1 <= q2. by case (le_gt_dec q1 q2)=> H; last symmetry; eauto with arith. The ``wlog suff`` variant is simpler, since it cuts ``wlog_statement`` instead of ``wlog_statement -> G``. It thus opens the goals ``wlog_statement -> G`` and ``wlog_statement``. In its simplest form, the ``generally have : …`` tactic is equivalent to ``wlog suff : …`` followed by ``last first``. When the ``have`` tactic is used with the ``generally`` (or ``gen``) modifier, it accepts an extra identifier followed by a comma before the usual intro pattern. The identifier will name the new hypothesis in its more general form, while the intro pattern will be used to process its instance. .. example:: .. coqtop:: reset none From Coq Require Import ssreflect ssrfun ssrbool. Set Implicit Arguments. Unset Strict Implicit. Unset Printing Implicit Defensive. Axiom P : nat -> Prop. Axioms eqn leqn : nat -> nat -> bool. Declare Scope this_scope. Notation "a != b" := (eqn a b) (at level 70) : this_scope. Notation "a <= b" := (leqn a b) (at level 70) : this_scope. Open Scope this_scope. .. coqtop:: all Lemma simple n (ngt0 : 0 < n ) : P n. gen have ltnV, /andP[nge0 neq0] : n ngt0 / (0 <= n) && (n != 0); last first. .. _advanced_generalization_ssr: Advanced generalization +++++++++++++++++++++++ The complete syntax for the items on the left hand side of the ``/`` separator is the following one: .. tacv:: wlog … : {? {| @clear_switch | {? @}@ident | ( {? @}@ident := @c_pattern) } } / @term :undocumented: Clear operations are intertwined with generalization operations. This helps in particular avoiding dependency issues while generalizing some facts. If an :token:`ident` is prefixed with the ``@`` mark, then a let-in redex is created, which keeps track of its body (if any). The syntax :n:`(@ident := @c_pattern)` allows to generalize an arbitrary term using a given name. Note that its simplest form ``(x := y)`` is just a renaming of ``y`` into ``x``. In particular, this can be useful in order to simulate the generalization of a section variable, otherwise not allowed. Indeed, renaming does not require the original variable to be cleared. The syntax ``(@x := y)`` generates a let-in abstraction but with the following caveat: ``x`` will not bind ``y``, but its body, whenever ``y`` can be unfolded. This covers the case of both local and global definitions, as illustrated in the following example. .. example:: .. coqtop:: reset none From Coq Require Import ssreflect. Set Implicit Arguments. Unset Strict Implicit. Unset Printing Implicit Defensive. .. coqtop:: all Section Test. Variable x : nat. Definition addx z := z + x. Lemma test : x <= addx x. wlog H : (y := x) (@twoy := addx x) / twoy = 2 * y. To avoid unfolding the term captured by the pattern ``add x``, one can use the pattern ``id (addx x)``, which would produce the following first subgoal .. coqtop:: reset none From Coq Require Import ssreflect Lia. Set Implicit Arguments. Unset Strict Implicit. Unset Printing Implicit Defensive. Section Test. Variable x : nat. Definition addx z := z + x. Lemma test : x <= addx x. .. coqtop:: all wlog H : (y := x) (@twoy := id (addx x)) / twoy = 2 * y. .. _rewriting_ssr: Rewriting --------- The generalized use of reflection implies that most of the intermediate results handled are properties of effectively computable functions. The most efficient means of establishing such results are computation and simplification of expressions involving such functions, i.e., rewriting. |SSR| therefore includes an extended ``rewrite`` tactic that unifies and combines most of the rewriting functionalities. An extended rewrite tactic ~~~~~~~~~~~~~~~~~~~~~~~~~~ The main features of the rewrite tactic are: + it can perform an entire series of such operations in any subset of the goal and/or context; + it allows to perform rewriting, simplifications, folding/unfolding of definitions, closing of goals; + several rewriting operations can be chained in a single tactic; + control over the occurrence at which rewriting is to be performed is significantly enhanced. The general form of an |SSR| rewrite tactic is: .. tacn:: rewrite {+ @rstep } :name: rewrite (ssreflect) :undocumented: The combination of a rewrite tactic with the ``in`` tactical (see Section :ref:`localization_ssr`) performs rewriting in both the context and the goal. A rewrite step :token:`rstep` has the general form: .. prodn:: rstep ::= {? @r_prefix } @r_item .. prodn:: r_prefix ::= {? - } {? @mult } {? {| @occ_switch | @clear_switch } } {? [ @r_pattern ] } .. prodn:: r_pattern ::= {| @term | in {? @ident in } @term | {| @term in | @term as } @ident in @term } .. prodn:: r_item ::= {| {? / } @term | @s_item } An :token:`r_prefix` contains annotations to qualify where and how the rewrite operation should be performed. + The optional initial ``-`` indicates the direction of the rewriting of :token:`r_item`: if present, the direction is right-to-left and it is left-to-right otherwise. + The multiplier :token:`mult` (see Section :ref:`iteration_ssr`) specifies if and how the rewrite operation should be repeated. + A rewrite operation matches the occurrences of a *rewrite pattern*, and replaces these occurrences by another term, according to the given :token:`r_item`. The optional *redex switch* ``[r_pattern]``, which should always be surrounded by brackets, gives explicitly this rewrite pattern. In its simplest form, it is a regular term. If no explicit redex switch is present, the rewrite pattern to be matched is inferred from the :token:`r_item`. + This optional term, or the :token:`r_item`, may be preceded by an :token:`occ_switch` (see Section :ref:`selectors_ssr`) or a :token:`clear_switch` (see Section :ref:`discharge_ssr`), these two possibilities being exclusive. An occurrence switch selects the occurrences of the rewrite pattern that should be affected by the rewrite operation. A clear switch, even an empty one, is performed *after* the :token:`r_item` is actually processed and is complemented with the name of the rewrite rule if and only if it is a simple proof context entry [#10]_. As a consequence, one can write ``rewrite {}H`` to rewrite with ``H`` and dispose ``H`` immediately afterwards. This behavior can be avoided by putting parentheses around the rewrite rule. A :token:`r_item` can be one of the following. + A *simplification* :token:`r_item`, represented by a :token:`s_item` (see Section :ref:`introduction_ssr`). Simplification operations are intertwined with the possible other rewrite operations specified by the list of :token:`r_item`. + A *folding/unfolding* :token:`r_item`. The tactic ``rewrite /term`` unfolds the :term:`head constant` of ``term`` in every occurrence of the first matching of ``term`` in the goal. In particular, if ``my_def`` is a (local or global) defined constant, the tactic ``rewrite /my_def.`` is analogous to: ``unfold my_def``. Conversely, ``rewrite -/my_def.`` is equivalent to ``fold my_def``. When an unfold :token:`r_item` is combined with a redex pattern, a conversion operation is performed. A tactic of the form ``rewrite -[term1]/term2.`` is equivalent to ``change term1 with term2.`` If ``term2`` is a single constant and ``term1`` head symbol is not ``term2``, then the head symbol of ``term1`` is repeatedly unfolded until ``term2`` appears. + A :token:`term` can be: + a term whose type has the form: ``forall (x1 : A1 )…(xn : An ), eq term1 term2``, where ``eq`` is the Leibniz equality or a registered setoid equality; + a list of terms ``(t1 ,…,tn)``, each ``ti`` having a type as above, and the tactic ``rewrite r_prefix (t1 ,…,tn ).`` is equivalent to ``do [rewrite r_prefix t1 | … | rewrite r_prefix tn ].``; + an anonymous rewrite lemma ``(_ : term)``, where ``term`` has a type as above. .. example:: .. coqtop:: reset none From Coq Require Import ssreflect. Set Implicit Arguments. Unset Strict Implicit. Unset Printing Implicit Defensive. .. coqtop:: all abort Definition double x := x + x. Definition ddouble x := double (double x). Lemma test x : ddouble x = 4 * x. rewrite [ddouble _]/double. .. warning:: The |SSR| terms containing holes are *not* typed as abstractions in this context. Hence the following script fails. .. coqtop:: all Definition f := fun x y => x + y. Lemma test x y : x + y = f y x. .. coqtop:: all fail rewrite -[f y]/(y + _). but the following script succeeds .. coqtop:: all rewrite -[f y x]/(y + _). .. flag:: SsrOldRewriteGoalsOrder Controls the order in which generated subgoals (side conditions) are added to the proof context. The :term:`flag` is off by default, which puts subgoals generated by conditional rules first, followed by the main goal. When it is on, the main goal appears first. If your proofs are organized to complete proving the main goal before side conditions, turning the flag on will save you from having to add :tacn:`last first` tactics that would be needed to keep the main goal as the currently focused goal. Remarks and examples ~~~~~~~~~~~~~~~~~~~~ Rewrite redex selection ``````````````````````` The general strategy of |SSR| is to grasp as many redexes as possible and to let the user select the ones to be rewritten thanks to the improved syntax for the control of rewriting. This may be a source of incompatibilities between the two rewrite tactics. In a rewrite tactic of the form: .. coqdoc:: rewrite occ_switch [term1]term2. ``term1`` is the explicit rewrite redex and ``term2`` is the rewrite rule. This execution of this tactic unfolds as follows. + First ``term1`` and ``term2`` are βι normalized. Then ``term2`` is put in head normal form if the Leibniz equality constructor ``eq`` is not the head symbol. This may involve ζ reductions. + Then, the matching algorithm (see Section :ref:`abbreviations_ssr`) determines the first subterm of the goal matching the rewrite pattern. The rewrite pattern is given by ``term1``, if an explicit redex pattern switch is provided, or by the type of ``term2`` otherwise. However, matching skips over matches that would lead to trivial rewrites. All the occurrences of this subterm in the goal are candidates for rewriting. + Then only the occurrences coded by :token:`occ_switch` (see again Section :ref:`abbreviations_ssr`) are finally selected for rewriting. + The left-hand side of ``term2`` is unified with the subterm found by the matching algorithm, and if this succeeds, all the selected occurrences in the goal are replaced by the right-hand side of ``term2``. + Finally the goal is βι normalized. In the case ``term2`` is a list of terms, the first top-down (in the goal) left-to-right (in the list) matching rule gets selected. Chained rewrite steps ````````````````````` The possibility to chain rewrite operations in a single tactic makes scripts more compact and gathers in a single command line a bunch of surgical operations that would be described by a one sentence in a pen and paper proof. Performing rewrite and simplification operations in a single tactic enhances significantly the concision of scripts. For instance the tactic: .. coqdoc:: rewrite /my_def {2}[f _]/= my_eq //=. unfolds ``my_def`` in the goal, simplifies the second occurrence of the first subterm matching pattern ``[f _]``, rewrites ``my_eq``, simplifies the goals and closes trivial goals. Here are some concrete examples of chained rewrite operations, in the proof of basic results on natural numbers arithmetic. .. example:: .. coqtop:: reset none From Coq Require Import ssreflect. Set Implicit Arguments. Unset Strict Implicit. Unset Printing Implicit Defensive. .. coqtop:: all Axiom addn0 : forall m, m + 0 = m. Axiom addnS : forall m n, m + S n = S (m + n). Axiom addSnnS : forall m n, S m + n = m + S n. Lemma addnCA m n p : m + (n + p) = n + (m + p). by elim: m p => [ | m Hrec] p; rewrite ?addSnnS -?addnS. Qed. Lemma addnC n m : m + n = n + m. by rewrite -{1}[n]addn0 addnCA addn0. Qed. Note the use of the ``?`` switch for parallel rewrite operations in the proof of ``addnCA``. Explicit redex switches are matched first ````````````````````````````````````````` If an :token:`r_prefix` involves a *redex switch*, the first step is to find a subterm matching this redex pattern, independently from the left-hand side of the equality the user wants to rewrite. .. example:: .. coqtop:: reset none From Coq Require Import ssreflect. Set Implicit Arguments. Unset Strict Implicit. Unset Printing Implicit Defensive. .. coqtop:: all Lemma test (H : forall t u, t + u = u + t) x y : x + y = y + x. rewrite [y + _]H. Note that if this first pattern matching is not compatible with the :token:`r_item`, the rewrite fails, even if the goal contains a correct redex matching both the redex switch and the left-hand side of the equality. .. example:: .. coqtop:: reset none From Coq Require Import ssreflect. Set Implicit Arguments. Unset Strict Implicit. Unset Printing Implicit Defensive. .. coqtop:: all Lemma test (H : forall t u, t + u * 0 = t) x y : x + y * 4 + 2 * 0 = x + 2 * 0. Fail rewrite [x + _]H. Indeed, the left-hand side of ``H`` does not match the redex identified by the pattern ``x + y * 4``. .. _ssr_rewrite_occ_switch: Occurrence switches and redex switches `````````````````````````````````````` .. example:: .. coqtop:: reset none From Coq Require Import ssreflect. Set Implicit Arguments. Unset Strict Implicit. Unset Printing Implicit Defensive. .. coqtop:: all Lemma test x y : x + y + 0 = x + y + y + 0 + 0 + (x + y + 0). rewrite {2}[_ + y + 0](_: forall z, z + 0 = z). The second subgoal is generated by the use of an anonymous lemma in the rewrite tactic. The effect of the tactic on the initial goal is to rewrite this lemma at the second occurrence of the first matching ``x + y + 0`` of the explicit rewrite redex ``_ + y + 0``. Occurrence selection and repetition ``````````````````````````````````` Occurrence selection has priority over repetition switches. This means the repetition of a rewrite tactic specified by a multiplier will perform matching each time an elementary rewrite operation is performed. Repeated rewrite tactics apply to every subgoal generated by the previous tactic, including the previous instances of the repetition. .. example:: .. coqtop:: reset none From Coq Require Import ssreflect. Set Implicit Arguments. Unset Strict Implicit. Unset Printing Implicit Defensive. .. coqtop:: all Lemma test x y (z : nat) : x + 1 = x + y + 1. rewrite 2!(_ : _ + 1 = z). This last tactic generates *three* subgoals because the second rewrite operation specified with the ``2!`` multiplier applies to the two subgoals generated by the first rewrite. Multi-rule rewriting ```````````````````` The rewrite tactic can be provided a *tuple* of rewrite rules, or more generally a tree of such rules, since this tuple can feature arbitrary inner parentheses. We call *multirule* such a generalized rewrite rule. This feature is of special interest when it is combined with multiplier switches, which makes the rewrite tactic iterate the rewrite operations prescribed by the rules on the current goal. .. example:: .. coqtop:: reset none From Coq Require Import ssreflect. Set Implicit Arguments. Unset Strict Implicit. Unset Printing Implicit Defensive. Section Test. .. coqtop:: all abort Variables (a b c : nat). Hypothesis eqab : a = b. Hypothesis eqac : a = c. Lemma test : a = a. rewrite (eqab, eqac). Indeed, rule ``eqab`` is the first to apply among the ones gathered in the tuple passed to the rewrite tactic. This multirule ``(eqab, eqac)`` is actually a Coq term and we can name it with a definition: .. coqtop:: all Definition multi1 := (eqab, eqac). In this case, the tactic ``rewrite multi1`` is a synonym for ``rewrite (eqab, eqac)``. More precisely, a multirule rewrites the first subterm to which one of the rules applies in a left-to-right traversal of the goal, with the first rule from the multirule tree in left-to-right order. Matching is performed according to the algorithm described in Section :ref:`abbreviations_ssr`, but literal matches have priority. .. example:: .. coqtop:: all abort Definition d := a. Hypotheses eqd0 : d = 0. Definition multi2 := (eqab, eqd0). Lemma test : d = b. rewrite multi2. Indeed, rule ``eqd0`` applies without unfolding the definition of ``d``. For repeated rewrites, the selection process is repeated anew. .. example:: .. coqtop:: all abort Hypothesis eq_adda_b : forall x, x + a = b. Hypothesis eq_adda_c : forall x, x + a = c. Hypothesis eqb0 : b = 0. Definition multi3 := (eq_adda_b, eq_adda_c, eqb0). Lemma test : 1 + a = 12 + a. rewrite 2!multi3. It uses ``eq_adda_b`` then ``eqb0`` on the left-hand side only. Without the bound ``2``, one would obtain ``0 = 0``. The grouping of rules inside a multirule does not affect the selection strategy, but can make it easier to include one rule set in another or to (universally) quantify over the parameters of a subset of rules (as there is special code that will omit unnecessary quantifiers for rules that can be syntactically extracted). It is also possible to reverse the direction of a rule subset, using a special dedicated syntax: the tactic rewrite ``(=^~ multi1)`` is equivalent to ``rewrite multi1_rev``. .. example:: .. coqtop:: all Hypothesis eqba : b = a. Hypothesis eqca : c = a. Definition multi1_rev := (eqba, eqca). except that the constants ``eqba``, ``eqab`` and ``mult1_rev`` have not been created. Rewriting with multirules is useful to implement simplification or transformation procedures, to be applied on terms of small to medium size. For instance, the library `ssrnat` (Mathematical Components library) provides two implementations for arithmetic operations on natural numbers: an elementary one and a tail recursive version, less inefficient but also less convenient for reasoning purposes. The library also provides one lemma per such operation, stating that both versions return the same values when applied to the same arguments: .. coqdoc:: Lemma addE : add =2 addn. Lemma doubleE : double =1 doublen. Lemma add_mulE n m s : add_mul n m s = addn (muln n m) s. Lemma mulE : mul =2 muln. Lemma mul_expE m n p : mul_exp m n p = muln (expn m n) p. Lemma expE : exp =2 expn. Lemma oddE : odd =1 oddn. The operation on the left-hand side of each lemma is the efficient version, and the corresponding naive implementation is on the right-hand side. In order to reason conveniently on expressions involving the efficient operations, we gather all these rules in the definition ``trecE``: .. coqdoc:: Definition trecE := (addE, (doubleE, oddE), (mulE, add_mulE, (expE, mul_expE))). The tactic ``rewrite !trecE.`` restores the naive version of each operation in a goal involving the efficient ones, e.g., for the purpose of a correctness proof. Wildcards vs abstractions ````````````````````````` The rewrite tactic supports :token:`r_item`\s containing holes. For example, in the tactic ``rewrite (_ : _ * 0 = 0).``, the term ``_ * 0 = 0`` is interpreted as ``forall n : nat, n * 0 = 0.`` Anyway this tactic is *not* equivalent to ``rewrite (_ : forall x, x * 0 = 0).``. .. example:: .. coqtop:: reset none From Coq Require Import ssreflect. Set Implicit Arguments. Unset Strict Implicit. Unset Printing Implicit Defensive. Section Test. .. coqtop:: all Lemma test y z : y * 0 + y * (z * 0) = 0. rewrite (_ : _ * 0 = 0). while the other tactic results in .. coqtop:: all restart abort rewrite (_ : forall x, x * 0 = 0). The first tactic requires you to prove the instance of the (missing) lemma that was used, while the latter requires you prove the quantified form. When |SSR| rewrite fails on standard Coq licit rewrite ```````````````````````````````````````````````````````` In a few cases, the |SSR| rewrite tactic fails rewriting some redexes that standard Coq successfully rewrites. There are two main cases. + |SSR| never accepts to rewrite indeterminate patterns like: .. coqdoc:: Lemma foo (x : unit) : x = tt. |SSR| will however accept the ηζ expansion of this rule: .. coqdoc:: Lemma fubar (x : unit) : (let u := x in u) = tt. + The standard rewrite tactic provided by Coq uses a different algorithm to find instances of the rewrite rule. .. example:: .. coqtop:: reset none From Coq Require Import ssreflect. Set Implicit Arguments. Unset Strict Implicit. Unset Printing Implicit Defensive. Section Test. .. coqtop:: all Variable g : nat -> nat. Definition f := g. Axiom H : forall x, g x = 0. Lemma test : f 3 + f 3 = f 6. (* we call the standard rewrite tactic here *) rewrite -> H. This rewriting is not possible in |SSR|, because there is no occurrence of the head symbol ``f`` of the rewrite rule in the goal. .. coqtop:: all restart fail rewrite H. Rewriting with ``H`` first requires unfolding the occurrences of ``f`` where the substitution is to be performed (here there is a single such occurrence), using tactic ``rewrite /f`` (for a global replacement of ``f`` by ``g``) or ``rewrite pattern/f``, for a finer selection. .. coqtop:: all restart rewrite /f H. Alternatively, one can override the pattern inferred from ``H`` .. coqtop:: all restart rewrite [f _]H. Existential metavariables and rewriting ``````````````````````````````````````` The rewrite tactic will not instantiate existing existential metavariables when matching a redex pattern. If a rewrite rule generates a goal with new existential metavariables in the ``Prop`` sort, these will be generalized as for ``apply`` (see :ref:`apply_ssr`) and corresponding new goals will be generated. .. example:: .. coqtop:: reset none From Coq Require Import ssreflect ssrfun ssrbool. Set Implicit Arguments. Unset Strict Implicit. Unset Printing Implicit Defensive. Set Warnings "-notation-overridden". .. coqtop:: all abort Axiom leq : nat -> nat -> bool. Notation "m <= n" := (leq m n) : nat_scope. Notation "m < n" := (S m <= n) : nat_scope. Inductive Ord n := Sub x of x < n. Notation "'I_ n" := (Ord n) (at level 8, n at level 2, format "''I_' n"). Arguments Sub {_} _ _. Definition val n (i : 'I_n) := let: Sub a _ := i in a. Definition insub n x := if @idP (x < n) is ReflectT _ Px then Some (Sub x Px) else None. Axiom insubT : forall n x Px, insub n x = Some (Sub x Px). Lemma test (x : 'I_2) y : Some x = insub 2 y. rewrite insubT. Since the argument corresponding to ``Px`` is not supplied by the user, the resulting goal should be ``Some x = Some (Sub y ?Goal).`` Instead, |SSR| ``rewrite`` tactic hides the existential variable. As in :ref:`apply_ssr`, the ``ssrautoprop`` tactic is used to try to solve the existential variable. .. coqtop:: all abort Lemma test (x : 'I_2) y (H : y < 2) : Some x = insub 2 y. rewrite insubT. As a temporary limitation, this behavior is available only if the rewriting rule is stated using Leibniz equality (as opposed to setoid relations). It will be extended to other rewriting relations in the future. .. _under_ssr: Rewriting under binders ~~~~~~~~~~~~~~~~~~~~~~~ Goals involving objects defined with higher-order functions often require "rewriting under binders". While setoid rewriting is a possible approach in this case, it is common to use regular rewriting along with dedicated extensionality lemmas. This may cause some practical issues during the development of the corresponding scripts, notably as we might be forced to provide the rewrite tactic with complete terms, as shown by the simple example below. .. example:: .. coqtop:: reset none From Coq Require Import ssreflect. Set Implicit Arguments. Unset Strict Implicit. Unset Printing Implicit Defensive. .. coqtop:: in Axiom subnn : forall n : nat, n - n = 0. Parameter map : (nat -> nat) -> list nat -> list nat. Parameter sumlist : list nat -> nat. Axiom eq_map : forall F1 F2 : nat -> nat, (forall n : nat, F1 n = F2 n) -> forall l : list nat, map F1 l = map F2 l. .. coqtop:: all Lemma example_map l : sumlist (map (fun m => m - m) l) = 0. In this context, one cannot directly use ``eq_map``: .. coqtop:: all fail rewrite eq_map. as we need to explicitly provide the non-inferable argument ``F2``, which corresponds here to the term we want to obtain *after* the rewriting step. In order to perform the rewrite step, one has to provide the term by hand as follows: .. coqtop:: all abort rewrite (@eq_map _ (fun _ : nat => 0)). by move=> m; rewrite subnn. The :tacn:`under` tactic lets one perform the same operation in a more convenient way: .. coqtop:: all abort Lemma example_map l : sumlist (map (fun m => m - m) l) = 0. under eq_map => m do rewrite subnn. The under tactic ```````````````` The convenience :tacn:`under` tactic supports the following syntax: .. tacn:: under {? @r_prefix } @term {? => {+ @i_item}} {? do {| @tactic | [ {*| @tactic } ] } } :name: under It operates under the context proved to be extensional by lemma :token:`term`. .. exn:: Incorrect number of tactics (expected N tactics, was given M). This error can occur when using the version with a ``do`` clause. The multiplier part of :token:`r_prefix` is not supported. We distinguish two modes: :ref:`interactive mode `, without a ``do`` clause, and :ref:`one-liner mode `, with a ``do`` clause, which are explained in more detail below. .. _under_interactive: Interactive mode ```````````````` Let us redo the running example in interactive mode. .. example:: .. coqtop:: all abort Lemma example_map l : sumlist (map (fun m => m - m) l) = 0. under eq_map => m. rewrite subnn. over. The execution of the Ltac expression: :n:`under @term => [ @i_item__1 | … | @i_item__n ].` involves the following steps. 1. It performs a :n:`rewrite @term` without failing like in the first example with ``rewrite eq_map.``, but creating evars (see :tacn:`evar`). If :n:`term` is prefixed by a pattern or an occurrence selector, then the modifiers are honoured. 2. As an n-branch intro pattern is provided, :tacn:`under` checks that n+1 subgoals have been created. The last one is the main subgoal, while the other ones correspond to premises of the rewrite rule (such as ``forall n, F1 n = F2 n`` for ``eq_map``). 3. If so, :tacn:`under` puts these n goals in head normal form (using the defective form of the tactic :tacn:`move `), then executes the corresponding intro pattern :n:`@i_pattern__i` in each goal. 4. Then, :tacn:`under` checks that the first n subgoals are (quantified) Leibniz equalities, double implications or registered relations (w.r.t. Class ``RewriteRelation``) between a term and an evar, e.g., ``m - m = ?F2 m`` in the running example. (This support for setoid-like relations is enabled as soon as one does both ``Require Import ssreflect.`` and ``Require Setoid.``) 5. If so :tacn:`under` protects these n goals against an accidental instantiation of the evar. These protected goals are displayed using the ``'Under[ … ]`` notation (e.g. ``'Under[ m - m ]`` in the running example). 6. The expression inside the ``'Under[ … ]`` notation can be proved equivalent to the desired expression by using a regular :tacn:`rewrite` tactic. 7. Interactive editing of the first n goals has to be signalled by using the :tacn:`over` tactic or rewrite rule (see below), which requires that the underlying relation is reflexive. (The running example deals with Leibniz equality, but ``PreOrder`` relations are also supported, for example.) 8. Finally, a post-processing step is performed in the main goal to keep the name(s) for the bound variables chosen by the user in the intro pattern for the first branch. .. _over_ssr: The over tactic +++++++++++++++ Two equivalent facilities (a terminator and a lemma) are provided to close intermediate subgoals generated by :tacn:`under` (i.e., goals displayed as ``'Under[ … ]``): .. tacn:: over :name: over This terminator tactic allows one to close goals of the form ``'Under[ … ]``. .. tacv:: by rewrite over This is a variant of :tacn:`over` in order to close ``'Under[ … ]`` goals, relying on the ``over`` rewrite rule. Note that a rewrite rule ``UnderE`` is available as well, if one wants to "unprotect" the evar, without closing the goal automatically (e.g., to instantiate it manually with another rule than reflexivity). .. _under_one_liner: One-liner mode `````````````` The Ltac expression: :n:`under @term => [ @i_item__1 | … | @i_item__n ] do [ @tactic__1 | … | @tactic__n ].` can be seen as a shorter form for the following expression: :n:`(under @term) => [ @i_item__1 | … | @i_item__n | ]; [ @tactic__1; over | … | @tactic__n; over | cbv beta iota ].` Notes: + The ``beta-iota`` reduction here is useful to get rid of the beta redexes that could be introduced after the substitution of the evars by the :tacn:`under` tactic. + Note that the provided tactics can as well involve other :tacn:`under` tactics. See below for a typical example involving the `bigop` theory from the Mathematical Components library. + If there is only one tactic, the brackets can be omitted, e.g.: :n:`under @term => i do @tactic.` and that shorter form should be preferred. + If the ``do`` clause is provided and the intro pattern is omitted, then the default :token:`i_item` ``*`` is applied to each branch. E.g., the Ltac expression :n:`under @term do [ @tactic__1 | … | @tactic__n ]` is equivalent to :n:`under @term => [ * | … | * ] do [ @tactic__1 | … | @tactic__n ]` (and it can be noted here that the :tacn:`under` tactic performs a ``move.`` before processing the intro patterns ``=> [ * | … | * ]``). .. example:: .. coqtop:: reset none From Coq Require Import ssreflect. Set Implicit Arguments. Unset Strict Implicit. Unset Printing Implicit Defensive. Coercion is_true : bool >-> Sortclass. Reserved Notation "\big [ op / idx ]_ ( m <= i < n | P ) F" (at level 36, F at level 36, op, idx at level 10, m, i, n at level 50, format "'[' \big [ op / idx ]_ ( m <= i < n | P ) F ']'"). Variant bigbody (R I : Type) : Type := BigBody : forall (_ : I) (_ : forall (_ : R) (_ : R), R) (_ : bool) (_ : R), bigbody R I. Parameter bigop : forall (R I : Type) (_ : R) (_ : list I) (_ : forall _ : I, bigbody R I), R. Axiom eq_bigr_ : forall (R : Type) (idx : R) (op : forall (_ : R) (_ : R), R) (I : Type) (r : list I) (P : I -> bool) (F1 F2 : I -> R), (forall x : I, is_true (P x) -> F1 x = F2 x) -> bigop idx r (fun i : I => BigBody i op (P i) (F1 i)) = bigop idx r (fun i : I => BigBody i op (P i) (F2 i)). Axiom eq_big_ : forall (R : Type) (idx : R) (op : R -> R -> R) (I : Type) (r : list I) (P1 P2 : I -> bool) (F1 F2 : I -> R), (forall x : I, P1 x = P2 x) -> (forall i : I, is_true (P1 i) -> F1 i = F2 i) -> bigop idx r (fun i : I => BigBody i op (P1 i) (F1 i)) = bigop idx r (fun i : I => BigBody i op (P2 i) (F2 i)). Reserved Notation "\sum_ ( m <= i < n | P ) F" (at level 41, F at level 41, i, m, n at level 50, format "'[' \sum_ ( m <= i < n | P ) '/ ' F ']'"). Parameter index_iota : nat -> nat -> list nat. Notation "\big [ op / idx ]_ ( m <= i < n | P ) F" := (bigop idx (index_iota m n) (fun i : nat => BigBody i op P%bool F)). Notation "\sum_ ( m <= i < n | P ) F" := (\big[plus/O]_(m <= i < n | P%bool) F%nat). Notation eq_bigr := (fun n m => eq_bigr_ 0 plus (index_iota n m)). Notation eq_big := (fun n m => eq_big_ 0 plus (index_iota n m)). Parameter odd : nat -> bool. Parameter prime : nat -> bool. .. coqtop:: in Parameter addnC : forall m n : nat, m + n = n + m. Parameter muln1 : forall n : nat, n * 1 = n. .. coqtop:: all Check eq_bigr. Check eq_big. Lemma test_big_nested (m n : nat) : \sum_(0 <= a < m | prime a) \sum_(0 <= j < n | odd (j * 1)) (a + j) = \sum_(0 <= i < m | prime i) \sum_(0 <= j < n | odd j) (j + i). under eq_bigr => i prime_i do under eq_big => [ j | j odd_j ] do [ rewrite (muln1 j) | rewrite (addnC i j) ]. Remark how the final goal uses the name ``i`` (the name given in the intro pattern) rather than ``a`` in the binder of the first summation. .. _locking_ssr: Locking, unlocking ~~~~~~~~~~~~~~~~~~ As program proofs tend to generate large goals, it is important to be able to control the partial evaluation performed by the simplification operations that are performed by the tactics. These evaluations can, for example, come from a ``/=`` simplification switch, or from rewrite steps, which may expand large terms while performing conversion. We definitely want to avoid repeating large subterms of the goal in the proof script. We do this by “clamping down” selected function symbols in the goal, which prevents them from being considered in simplification or rewriting steps. This clamping is accomplished by using the occurrence switches (see Section :ref:`abbreviations_ssr`) together with “term tagging” operations. |SSR| provides two levels of tagging. The first one uses auxiliary definitions to introduce a provably equal copy of any term ``t``. However this copy is (on purpose) *not convertible* to ``t`` in the Coq system [#8]_. The job is done by the following construction: .. coqdoc:: Lemma master_key : unit. Proof. exact tt. Qed. Definition locked A := let: tt := master_key in fun x : A => x. Lemma lock : forall A x, x = locked x :> A. Note that the definition of *master_key* is explicitly opaque. The equation ``t = locked t`` given by the ``lock`` lemma can be used for selective rewriting, blocking on the fly the reduction in the term ``t``. .. example:: .. coqtop:: reset none From Coq Require Import ssreflect ssrfun ssrbool. From Coq Require Import List. Set Implicit Arguments. Unset Strict Implicit. Unset Printing Implicit Defensive. Section Test. .. coqtop:: all Variable A : Type. Fixpoint has (p : A -> bool) (l : list A) : bool := if l is cons x l then p x || (has p l) else false. Lemma test p x y l (H : p x = true) : has p ( x :: y :: l) = true. rewrite {2}[cons]lock /= -lock. It is sometimes desirable to globally prevent a definition from being expanded by simplification; this is done by adding ``locked`` in the definition. .. example:: .. coqtop:: reset none From Coq Require Import ssreflect. Set Implicit Arguments. Unset Strict Implicit. Unset Printing Implicit Defensive. Section Test. .. coqtop:: all Definition lid := locked (fun x : nat => x). Lemma test : lid 3 = 3. rewrite /=. unlock lid. .. tacn:: unlock {? @occ_switch } @ident :name: unlock This tactic unfolds such definitions while removing “locks”; i.e., it replaces the occurrence(s) of :token:`ident` coded by the :token:`occ_switch` with the corresponding body. We found that it was usually preferable to prevent the expansion of some functions by the partial evaluation switch ``/=``, unless this allowed the evaluation of a condition. This is possible thanks to another mechanism of term tagging, resting on the following *Notation*: .. coqdoc:: Notation "'nosimpl' t" := (let: tt := tt in t). The term ``(nosimpl t)`` simplifies to ``t`` *except* in a definition. More precisely, given: .. coqdoc:: Definition foo := (nosimpl bar). the term ``foo`` (or ``(foo t’)``) will *not* be expanded by the *simpl* tactic unless it is in a forcing context (e.g., in ``match foo t’ with … end``, ``foo t’`` will be reduced if this allows ``match`` to be reduced). Note that ``nosimpl bar`` is simply notation for a term that reduces to ``bar``; hence ``unfold foo`` will replace ``foo`` by ``bar``, and ``fold foo`` will replace ``bar`` by ``foo``. .. warning:: The ``nosimpl`` trick only works if no reduction is apparent in ``t``; in particular, the declaration: .. coqdoc:: Definition foo x := nosimpl (bar x). will usually not work. Anyway, the common practice is to tag only the function, and to use the following definition, which blocks the reduction as expected: .. coqdoc:: Definition foo x := nosimpl bar x. A standard example making this technique shine is the case of arithmetic operations. We define for instance: .. coqdoc:: Definition addn := nosimpl plus. The operation ``addn`` behaves exactly like ``plus``, except that ``(addn (S n) m)`` will not simplify spontaneously to ``(S (addn n m))`` (the two terms, however, are convertible). In addition, the unfolding step ``rewrite /addn`` will replace ``addn`` directly with ``plus``, so the ``nosimpl`` form is essentially invisible. .. _congruence_ssr: Congruence ~~~~~~~~~~ Because of the way matching interferes with parameters of type families, the tactic: .. coqdoc:: apply: my_congr_property. will generally fail to perform congruence simplification, even on rather simple cases. We therefore provide a more robust alternative in which the function is supplied: .. tacn:: congr {? @natural } @term :name: congr This tactic: + checks that the goal is a Leibniz equality; + matches both sides of this equality with “term applied to some arguments”, inferring the right number of arguments from the goal and the type of ``term`` (this may expand some definitions or fixpoints); + generates the subgoals corresponding to pairwise equalities of the arguments present in the goal. The goal can be a non-dependent product ``P -> Q``. In that case, the system asserts the equation ``P = Q``, uses it to solve the goal, and calls the ``congr`` tactic on the remaining goal ``P = Q``. This can be useful for instance to perform a transitivity step, like in the following situation. .. example:: .. coqtop:: reset none From Coq Require Import ssreflect. Set Implicit Arguments. Unset Strict Implicit. Unset Printing Implicit Defensive. Section Test. .. coqtop:: all Lemma test (x y z : nat) (H : x = y) : x = z. congr (_ = _) : H. Abort. Lemma test (x y z : nat) : x = y -> x = z. congr (_ = _). The optional :token:`natural` forces the number of arguments for which the tactic should generate equality proof obligations. This tactic supports equalities between applications with dependent arguments. Yet dependent arguments should have exactly the same parameters on both sides, and these parameters should appear as first arguments. .. example:: .. coqtop:: reset none From Coq Require Import ssreflect. Set Implicit Arguments. Unset Strict Implicit. Unset Printing Implicit Defensive. Section Test. .. coqtop:: all Definition f n := if n is 0 then plus else mult. Definition g (n m : nat) := plus. Lemma test x y : f 0 x y = g 1 1 x y. congr plus. This script shows that the ``congr`` tactic matches ``plus`` with ``f 0`` on the left hand side and ``g 1 1`` on the right hand side, and solves the goal. .. example:: .. coqtop:: reset none From Coq Require Import ssreflect. Set Implicit Arguments. Unset Strict Implicit. Unset Printing Implicit Defensive. Section Test. .. coqtop:: all Lemma test n m (Hnm : m <= n) : S m + (S n - S m) = S n. congr S; rewrite -/plus. The tactic ``rewrite -/plus`` folds back the expansion of ``plus``, which was necessary for matching both sides of the equality with an application of ``S``. Like most |SSR| arguments, :token:`term` can contain wildcards. .. example:: .. coqtop:: reset none From Coq Require Import ssreflect. Set Implicit Arguments. Unset Strict Implicit. Unset Printing Implicit Defensive. Section Test. .. coqtop:: all Lemma test x y : x + (y * (y + x - x)) = x * 1 + (y + 0) * y. congr ( _ + (_ * _)). .. _contextual_patterns_ssr: Contextual patterns ------------------- The simple form of patterns used so far, terms possibly containing wild cards, often requires an additional :token:`occ_switch` to be specified. While this may work pretty fine for small goals, the use of polymorphic functions and dependent types may lead to an invisible duplication of function arguments. These copies usually end up in types hidden by the implicit-arguments machinery or by user-defined notations. In these situations, computing the right occurrence numbers is very tedious, because they must be counted on the goal as printed after setting the :flag:`Printing All` flag. Moreover, the resulting script is not really informative for the reader, since it refers to occurrence numbers he cannot easily see. Contextual patterns mitigate these issues by allowing to specify occurrences according to the context they occur in. Syntax ~~~~~~ The following table summarizes the full syntax of :token:`c_pattern` and the corresponding subterm(s) identified by the pattern. In the third column, we use s.m.r. for “the subterms matching the redex” specified in the second column. .. list-table:: :header-rows: 1 * - :token:`c_pattern` - redex - subterms affected * - ``term`` - ``term`` - all occurrences of ``term`` * - ``ident in term`` - subterm of ``term`` selected by ``ident`` - all the subterms identified by ``ident`` in all the occurrences of ``term`` * - ``term1 in ident in term2`` - ``term1`` in all s.m.r. - in all the subterms identified by ``ident`` in all the occurrences of ``term2`` * - ``term1 as ident in term2`` - ``term1`` - in all the subterms identified by ``ident`` in all the occurrences of ``term2[term1 /ident]`` The rewrite tactic supports two more patterns obtained prefixing the first two with ``in``. The intended meaning is that the pattern identifies all subterms of the specified context. The ``rewrite`` tactic will infer a pattern for the redex looking at the rule used for rewriting. .. list-table:: :header-rows: 1 * - :token:`r_pattern` - redex - subterms affected * - ``in term`` - inferred from rule - in all s.m.r. in all occurrences of ``term`` * - ``in ident in term`` - inferred from rule - in all s.m.r. in all the subterms identified by ``ident`` in all the occurrences of ``term`` The first :token:`c_pattern` is the simplest form matching any context but selecting a specific redex and has been described in the previous sections. We have seen so far that the possibility of selecting a redex using a term with holes is already a powerful means of redex selection. Similarly, any terms provided by the user in the more complex forms of :token:`c_pattern`\s presented in the tables above can contain holes. For a quick glance at what can be expressed with the last :token:`r_pattern`, consider the goal ``a = b`` and the tactic .. coqdoc:: rewrite [in X in _ = X]rule. It rewrites all occurrences of the left hand side of ``rule`` inside ``b`` only (``a``, and the hidden type of the equality, are ignored). Note that the variant ``rewrite [X in _ = X]rule`` would have rewritten ``b`` exactly (i.e., it would only work if ``b`` and the left-hand side of rule can be unified). Matching contextual patterns ~~~~~~~~~~~~~~~~~~~~~~~~~~~~ The :token:`c_pattern` and :token:`r_pattern` involving terms with holes are matched against the goal in order to find a closed instantiation. This matching proceeds as follows: .. list-table:: :header-rows: 1 * - :token:`c_pattern` - instantiation order and place for ``term_i`` and redex * - ``term`` - ``term`` is matched against the goal, redex is unified with the instantiation of ``term`` * - ``ident in term`` - ``term`` is matched against the goal, redex is unified with the subterm of the instantiation of ``term`` identified by ``ident`` * - ``term1 in ident in term2`` - ``term2`` is matched against the goal, ``term1`` is matched against the subterm of the instantiation of ``term1`` identified by ``ident``, redex is unified with the instantiation of ``term1`` * - ``term1 as ident in term2`` - ``term2[term1/ident]`` is matched against the goal, redex is unified with the instantiation of ``term1`` In the following patterns, the redex is intended to be inferred from the rewrite rule. .. list-table:: :header-rows: 1 * - :token:`r_pattern` - instantiation order and place for ``term_i`` and redex * - ``in ident in term`` - ``term`` is matched against the goal, the redex is matched against the subterm of the instantiation of ``term`` identified by ``ident`` * - ``in term`` - ``term`` is matched against the goal, redex is matched against the instantiation of ``term`` Examples ~~~~~~~~ Contextual pattern in set and the : tactical ```````````````````````````````````````````` As already mentioned in Section :ref:`abbreviations_ssr`, the ``set`` tactic takes as an argument a term in open syntax. This term is interpreted as the simplest form of :token:`c_pattern`. To avoid confusion in the grammar, open syntax is supported only for the simplest form of patterns, while parentheses are required around more complex patterns. .. example:: .. coqtop:: reset none From Coq Require Import ssreflect. Set Implicit Arguments. Unset Strict Implicit. Unset Printing Implicit Defensive. Section Test. .. coqtop:: all Lemma test a b : a + b + 1 = b + (a + 1). set t := (X in _ = X). rewrite {}/t. set t := (a + _ in X in _ = X). Since the user may define an infix notation for ``in``, the result of the former tactic may be ambiguous. The disambiguation rule implemented is to prefer patterns over simple terms, but to interpret a pattern with double parentheses as a simple term. For example, the following tactic would capture any occurrence of the term ``a in A``. .. coqdoc:: set t := ((a in A)). Contextual patterns can also be used as arguments of the ``:`` tactical. For example: .. coqdoc:: elim: n (n in _ = n) (refl_equal n). Contextual patterns in rewrite `````````````````````````````` .. example:: .. coqtop:: reset none From Coq Require Import ssreflect. Set Implicit Arguments. Unset Strict Implicit. Unset Printing Implicit Defensive. Section Test. .. coqtop:: all Notation "n .+1" := (Datatypes.S n) (at level 2, left associativity, format "n .+1") : nat_scope. Axiom addSn : forall m n, m.+1 + n = (m + n).+1. Axiom addn0 : forall m, m + 0 = m. Axiom addnC : forall m n, m + n = n + m. Lemma test x y z f : (x.+1 + y) + f (x.+1 + y) (z + (x + y).+1) = 0. rewrite [in f _ _]addSn. Note: the simplification rule ``addSn`` is applied only under the ``f`` symbol. Then, we simplify also the first addition and expand ``0`` into ``0 + 0``. .. coqtop:: all rewrite addSn -[X in _ = X]addn0. Note that the right-hand side of ``addn0`` is undetermined, but the rewrite pattern specifies the redex explicitly. The right-hand side of ``addn0`` is unified with the term identified by ``X``, here ``0``. The following pattern does not specify a redex, since it identifies an entire region; hence the rewrite rule has to be instantiated explicitly. Thus the tactic: .. coqtop:: all rewrite -{2}[in X in _ = X](addn0 0). The following tactic is quite tricky: .. coqtop:: all rewrite [_.+1 in X in f _ X](addnC x.+1). The explicit redex ``_.+1`` is important, since its :term:`head constant` ``S`` differs from the head constant inferred from ``(addnC x.+1)`` (that is ``+``). Moreover, the pattern ``f _ X`` is important to rule out the first occurrence of ``(x + y).+1``. Last, only the subterms of ``f _ X`` identified by ``X`` are rewritten; thus the first argument of ``f`` is skipped too. Also note that the pattern ``_.+1`` is interpreted in the context identified by ``X``; thus it gets instantiated to ``(y + x).+1`` and not ``(x + y).+1``. The last rewrite pattern allows to specify exactly the shape of the term identified by X, which is thus unified with the left-hand side of the rewrite rule. .. coqtop:: all rewrite [x.+1 + y as X in f X _]addnC. Patterns for recurrent contexts ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ The user can define shortcuts for recurrent contexts corresponding to the ``ident in term`` part. The notation scope identified with ``%pattern`` provides a special notation ``(X in t)`` the user must adopt in order to define context shortcuts. The following example is taken from ``ssreflect.v``, where the ``LHS`` and ``RHS`` shortcuts are defined. .. coqdoc:: Notation RHS := (X in _ = X)%pattern. Notation LHS := (X in X = _)%pattern. Shortcuts defined this way can be freely used in place of the trailing ``ident in term`` part of any contextual pattern. Some examples follow: .. coqdoc:: set rhs := RHS. rewrite [in RHS]rule. case: (a + _ in RHS). .. _views_and_reflection_ssr: Views and reflection -------------------- The bookkeeping facilities presented in Section :ref:`basic_tactics_ssr` are crafted to ease simultaneous introductions and generalizations of facts and operations of casing, naming, etc. It is also a common practice to make a stack operation immediately followed by an *interpretation* of the fact being pushed, that is, to apply a lemma to this fact before passing it to a tactic for decomposition, application and so on. |SSR| provides a convenient, unified syntax to combine these interpretation operations with the proof stack operations. This *view mechanism* relies on the combination of the ``/`` view switch with bookkeeping tactics and tacticals. .. _custom_elim_ssr: Interpreting eliminations ~~~~~~~~~~~~~~~~~~~~~~~~~ The view syntax combined with the ``elim`` tactic specifies an elimination scheme to be used instead of the default, generated, one. Hence, the |SSR| tactic: .. coqdoc:: elim/V. is a synonym for: .. coqdoc:: intro top; elim top using V; clear top. where top is a fresh name and V any second-order lemma. Since an elimination view supports the two bookkeeping tacticals of discharge and introduction (see Section :ref:`basic_tactics_ssr`), the |SSR| tactic: .. coqdoc:: elim/V: x => y. is a synonym for: .. coqdoc:: elim x using V; clear x; intro y. where ``x`` is a variable in the context, ``y`` a fresh name and ``V`` any second order lemma; |SSR| relaxes the syntactic restrictions of the Coq ``elim``. The first pattern following ``:`` can be a ``_`` wildcard if the conclusion of the view ``V`` specifies a pattern for its last argument (e.g., if ``V`` is a functional induction lemma generated by the ``Function`` command). The elimination view mechanism is compatible with the equation-name generation (see Section :ref:`generation_of_equations_ssr`). .. example:: The following script illustrates a toy example of this feature. Let us define a function adding an element at the end of a list: .. coqtop:: reset none From Coq Require Import ssreflect List. Set Implicit Arguments. Unset Strict Implicit. Unset Printing Implicit Defensive. Section Test. .. coqtop:: all Variable d : Type. Fixpoint add_last (s : list d) (z : d) {struct s} : list d := if s is cons x s' then cons x (add_last s' z) else z :: nil. One can define an alternative, reversed, induction principle on inductively defined lists, by proving the following lemma: .. coqtop:: all Axiom last_ind_list : forall P : list d -> Prop, P nil -> (forall s (x : d), P s -> P (add_last s x)) -> forall s : list d, P s. Then, the combination of elimination views with equation names results in a concise syntax for reasoning inductively using the user-defined elimination scheme. .. coqtop:: all Lemma test (x : d) (l : list d): l = l. elim/last_ind_list E : l=> [| u v]; last first. User-provided eliminators (potentially generated with Coq’s ``Function`` command) can be combined with the type family switches described in Section :ref:`type_families_ssr`. Consider an eliminator ``foo_ind`` of type: .. coqdoc:: foo_ind : forall …, forall x : T, P p1 … pm. and consider the tactic: .. coqdoc:: elim/foo_ind: e1 … / en. The ``elim/`` tactic distinguishes two cases. :truncated eliminator: when ``x`` does not occur in ``P p1 … pm`` and the type of ``en`` unifies with ``T`` and ``en`` is not ``_``. In that case, ``en`` is passed to the eliminator as the last argument (``x`` in ``foo_ind``) and ``en−1 … e1`` are used as patterns to select in the goal the occurrences that will be bound by the predicate ``P``; thus it must be possible to unify the subterm of the goal matched by ``en−1`` with ``pm`` , the one matched by ``en−2`` with ``pm−1`` and so on. :regular eliminator: in all the other cases. Here it must be possible to unify the term matched by ``en`` with ``pm`` , the one matched by ``en−1`` with ``pm−1`` and so on. Note that standard eliminators have the shape ``…forall x, P … x``; thus ``en`` is the pattern identifying the eliminated term, as expected. As explained in Section :ref:`type_families_ssr`, the initial prefix of ``ei`` can be omitted. Here is an example of a regular, but nontrivial, eliminator. .. example:: Here is a toy example illustrating this feature. .. coqtop:: reset none From Coq Require Import ssreflect FunInd. Set Implicit Arguments. Unset Strict Implicit. Unset Printing Implicit Defensive. Section Test. .. coqtop:: all Function plus (m n : nat) {struct n} : nat := if n is S p then S (plus m p) else m. About plus_ind. Lemma test x y z : plus (plus x y) z = plus x (plus y z). The following tactics are all valid and perform the same elimination on this goal. .. coqdoc:: elim/plus_ind: z / (plus _ z). elim/plus_ind: {z}(plus _ z). elim/plus_ind: {z}_. elim/plus_ind: z / _. .. coqtop:: reset none From Coq Require Import ssreflect FunInd. Set Implicit Arguments. Unset Strict Implicit. Unset Printing Implicit Defensive. Section Test. Function plus (m n : nat) {struct n} : nat := if n is S p then S (plus m p) else m. About plus_ind. Lemma test x y z : plus (plus x y) z = plus x (plus y z). .. coqtop:: all elim/plus_ind: z / _. The two latter examples feature a wildcard pattern: in this case, the resulting pattern is inferred from the type of the eliminator. In both of these examples, it is ``(plus _ _)`` that matches the subterm ``plus (plus x y) z``, thus instantiating the last ``_`` with ``z``. Note that the tactic: .. coqtop:: reset none From Coq Require Import ssreflect FunInd. Set Implicit Arguments. Unset Strict Implicit. Unset Printing Implicit Defensive. Section Test. Function plus (m n : nat) {struct n} : nat := if n is S p then S (plus m p) else m. About plus_ind. Lemma test x y z : plus (plus x y) z = plus x (plus y z). .. coqtop:: all Fail elim/plus_ind: y / _. triggers an error: in the conclusion of the ``plus_ind`` eliminator, the first argument of the predicate ``P`` should be the same as the second argument of ``plus``, in the second argument of ``P``, but ``y`` and ``z`` do no unify. Here is an example of a truncated eliminator: .. example:: Consider the goal: .. coqtop:: reset none From Coq Require Import ssreflect FunInd. Set Implicit Arguments. Unset Strict Implicit. Unset Printing Implicit Defensive. Section Test. .. coqdoc:: Lemma test p n (n_gt0 : 0 < n) (pr_p : prime p) : p %| \prod_(i <- prime_decomp n | i \in prime_decomp n) i.1 ^ i.2 -> exists2 x : nat * nat, x \in prime_decomp n & p = x.1. Proof. elim/big_prop: _ => [| u v IHu IHv | [q e] /=]. where the type of the ``big_prop`` eliminator is .. coqdoc:: big_prop: forall (R : Type) (Pb : R -> Type) (idx : R) (op1 : R -> R -> R), Pb idx -> (forall x y : R, Pb x -> Pb y -> Pb (op1 x y)) -> forall (I : Type) (r : seq I) (P : pred I) (F : I -> R), (forall i : I, P i -> Pb (F i)) -> Pb (\big[op1/idx]_(i <- r | P i) F i). Since the pattern for the argument of Pb is not specified, the inferred one, ``big[_/_]_(i <- _ | _ i) _ i``, is used instead, and after the introductions, the following goals are generated: .. coqdoc:: subgoal 1 is: p %| 1 -> exists2 x : nat * nat, x \in prime_decomp n & p = x.1 subgoal 2 is: p %| u * v -> exists2 x : nat * nat, x \in prime_decomp n & p = x.1 subgoal 3 is: (q, e) \in prime_decomp n -> p %| q ^ e -> exists2 x : nat * nat, x \in prime_decomp n & p = x.1. Note that the pattern matching algorithm instantiated all the variables occurring in the pattern. .. _interpreting_assumptions_ssr: Interpreting assumptions ~~~~~~~~~~~~~~~~~~~~~~~~ Interpreting an assumption in the context of a proof consists in applying to it a lemma before generalizing and/or decomposing this assumption. For instance, with the extensive use of boolean reflection (see Section :ref:`views_and_reflection_ssr`), it is quite frequent to need to decompose the logical interpretation of (the boolean expression of) a fact, rather than the fact itself. This can be achieved by a combination of ``move : _ => _`` switches, like in the following example, where ``||`` is a notation for the boolean disjunction. .. example:: .. coqtop:: reset none From Coq Require Import ssreflect. Set Implicit Arguments. Unset Strict Implicit. Unset Printing Implicit Defensive. Section Test. .. coqtop:: all Variables P Q : bool -> Prop. Hypothesis P2Q : forall a b, P (a || b) -> Q a. Lemma test a : P (a || a) -> True. move=> HPa; move: {HPa}(P2Q HPa) => HQa. which transforms the hypothesis ``HPa : P a``, which has been introduced from the initial statement, into ``HQa : Q a``. This operation is so common that the tactic shell has specific syntax for it. The following scripts: .. coqtop:: reset none From Coq Require Import ssreflect. Set Implicit Arguments. Unset Strict Implicit. Unset Printing Implicit Defensive. Section Test. Variables P Q : bool -> Prop. Hypothesis P2Q : forall a b, P (a || b) -> Q a. Lemma test a : P (a || a) -> True. .. coqtop:: all move=> HPa; move/P2Q: HPa => HQa. or more directly: .. coqtop:: all restart move/P2Q=> HQa. are equivalent to the former one. The former script shows how to interpret a fact (already in the context), thanks to the discharge tactical (see Section :ref:`discharge_ssr`), and the latter, how to interpret the top assumption of a goal. Note that the number of wildcards to be inserted to find the correct application of the view lemma to the hypothesis has been automatically inferred. The view mechanism is compatible with the ``case`` tactic and with the equation-name generation mechanism (see Section :ref:`generation_of_equations_ssr`): .. example:: .. coqtop:: reset none From Coq Require Import ssreflect. Set Implicit Arguments. Unset Strict Implicit. Unset Printing Implicit Defensive. Section Test. .. coqtop:: all Variables P Q: bool -> Prop. Hypothesis Q2P : forall a b, Q (a || b) -> P a \/ P b. Lemma test a b : Q (a || b) -> True. case/Q2P=> [HPa | HPb]. This view tactic performs: .. coqdoc:: move=> HQ; case: {HQ}(Q2P HQ) => [HPa | HPb]. The term on the right of the ``/`` view switch is called a *view lemma*. Any |SSR| term coercing to a product type can be used as a view lemma. The examples we have given so far explicitly provide the direction of the translation to be performed. In fact, view lemmas need not to be oriented. The view mechanism is able to detect which application is relevant for the current goal. .. example:: .. coqtop:: reset none From Coq Require Import ssreflect. Set Implicit Arguments. Unset Strict Implicit. Unset Printing Implicit Defensive. Section Test. .. coqtop:: all Variables P Q: bool -> Prop. Hypothesis PQequiv : forall a b, P (a || b) <-> Q a. Lemma test a b : P (a || b) -> True. move/PQequiv=> HQab. has the same behavior as the first example above. The view mechanism can insert automatically a *view hint* to transform the double implication into the expected simple implication. The last script is in fact equivalent to: .. coqdoc:: Lemma test a b : P (a || b) -> True. move/(iffLR (PQequiv _ _)). where: .. coqdoc:: Lemma iffLR P Q : (P <-> Q) -> P -> Q. Specializing assumptions ```````````````````````` The special case when the *head symbol* of the view lemma is a wildcard is used to interpret an assumption by *specializing* it. The view mechanism hence offers the possibility to apply a higher-order assumption to some given arguments. .. example:: .. coqtop:: reset none From Coq Require Import ssreflect. Set Implicit Arguments. Unset Strict Implicit. Unset Printing Implicit Defensive. Section Test. .. coqtop:: all Lemma test z : (forall x y, x + y = z -> z = x) -> z = 0. move/(_ 0 z). Interpreting goals ~~~~~~~~~~~~~~~~~~ In a similar way, it is also often convenient to change a goal by turning it into an equivalent proposition. The view mechanism of |SSR| has a special syntax ``apply/`` for combining in a single tactic simultaneous goal interpretation operations and bookkeeping steps. .. example:: The following example use the ``~~`` prenex notation for boolean negation: .. coqtop:: reset none From Coq Require Import ssreflect ssrbool. Set Implicit Arguments. Unset Strict Implicit. Unset Printing Implicit Defensive. Section Test. .. coqtop:: all Variables P Q: bool -> Prop. Hypothesis PQequiv : forall a b, P (a || b) <-> Q a. Lemma test a : P ((~~ a) || a). apply/PQequiv. thus in this case, the tactic ``apply/PQequiv`` is equivalent to ``apply: (iffRL (PQequiv _ _))``, where ``iffRL`` is the analogue of ``iffLR`` for the converse implication. Any |SSR| term whose type coerces to a double implication can be used as a view for goal interpretation. Note that the goal interpretation view mechanism supports both ``apply`` and ``exact`` tactics. As expected, a goal interpretation view command ``exact``/term should solve the current goal or it will fail. .. warning:: Goal-interpretation view tactics are *not* compatible with the bookkeeping tactical ``=>``, since this would be redundant with the ``apply: term => _`` construction. Boolean reflection ~~~~~~~~~~~~~~~~~~ In the Calculus of Inductive Constructions, there is an obvious distinction between logical propositions and boolean values. On the one hand, logical propositions are objects of *sort* ``Prop``, which is the carrier of intuitionistic reasoning. Logical connectives in ``Prop`` are *types*, which give precise information on the structure of their proofs; this information is automatically exploited by Coq tactics. For example, Coq knows that a proof of ``A \/ B`` is either a proof of ``A`` or a proof of ``B``. The tactics ``left`` and ``right`` change the goal ``A \/ B`` to ``A`` and ``B``, respectively; dually, the tactic ``case`` reduces the goal ``A \/ B => G`` to two subgoals ``A => G`` and ``B => G``. On the other hand, bool is an inductive *datatype* with two constructors: ``true`` and ``false``. Logical connectives on bool are *computable functions*, defined by their truth tables, using case analysis: .. example:: .. coqtop:: reset none From Coq Require Import ssreflect. Set Implicit Arguments. Unset Strict Implicit. Unset Printing Implicit Defensive. Section Test. .. coqtop:: all Definition orb (b1 b2 : bool) := if b1 then true else b2. Properties of such connectives are also established using case analysis .. example:: .. coqtop:: reset none From Coq Require Import ssreflect ssrbool. Set Implicit Arguments. Unset Strict Implicit. Unset Printing Implicit Defensive. Section Test. .. coqtop:: all Lemma test b : b || ~~ b = true. by case: b. Once ``b`` is replaced by ``true`` in the first goal and by ``false`` in the second one, the goals reduce by computation to the trivial ``true = true``. Thus, ``Prop`` and ``bool`` are truly complementary: the former supports robust natural deduction; the latter allows brute-force evaluation. |SSR| supplies a generic mechanism to have the best of the two worlds and move freely from a propositional version of a decidable predicate to its boolean version. First, booleans are injected into propositions using the coercion mechanism: .. coqdoc:: Coercion is_true (b : bool) := b = true. This allows any boolean formula ``b`` to be used in a context where Coq would expect a proposition, e.g., after ``Lemma … :``. It is then interpreted as ``(is_true b)``, i.e., the proposition ``b = true``. Coercions are elided by the pretty-printer; so they are essentially transparent to the user. The reflect predicate ~~~~~~~~~~~~~~~~~~~~~ To get all the benefits of the boolean reflection, it is in fact convenient to introduce the following inductive predicate ``reflect`` to relate propositions and booleans: .. coqdoc:: Inductive reflect (P: Prop): bool -> Type := | Reflect_true : P -> reflect P true | Reflect_false : ~P -> reflect P false. The statement ``(reflect P b)`` asserts that ``(is_true b)`` and ``P`` are logically equivalent propositions. For instance, the following lemma: .. coqdoc:: Lemma andP: forall b1 b2, reflect (b1 /\ b2) (b1 && b2). relates the boolean conjunction to the logical one ``/\``. Note that in ``andP``, ``b1`` and ``b2`` are two boolean variables and the proposition ``b1 /\ b2`` hides two coercions. The conjunction of ``b1`` and ``b2`` can then be viewed as ``b1 /\ b2`` or as ``b1 && b2``. Expressing logical equivalences through this family of inductive types makes possible to take benefit from *rewritable equations* associated to the case analysis of Coq’s inductive types. Since the equivalence predicate is defined in Coq as: .. coqdoc:: Definition iff (A B:Prop) := (A -> B) /\ (B -> A). where ``/\`` is a notation for ``and``: .. coqdoc:: Inductive and (A B:Prop) : Prop := conj : A -> B -> and A B. This makes case analysis very different according to the way an equivalence property has been defined. .. coqdoc:: Lemma andE (b1 b2 : bool) : (b1 /\ b2) <-> (b1 && b2). Let us compare the respective behaviors of ``andE`` and ``andP``. .. example:: .. coqtop:: reset none From Coq Require Import ssreflect ssrbool. Set Implicit Arguments. Unset Strict Implicit. Unset Printing Implicit Defensive. Section Test. Axiom andE : forall (b1 b2 : bool), (b1 /\ b2) <-> (b1 && b2). .. coqtop:: all Lemma test (b1 b2 : bool) : if (b1 && b2) then b1 else ~~(b1||b2). .. coqtop:: all case: (@andE b1 b2). .. coqtop:: none Restart. .. coqtop:: all case: (@andP b1 b2). Expressing reflection relations through the ``reflect`` predicate is hence a very convenient way to deal with classical reasoning, by case analysis. Using the ``reflect`` predicate allows, moreover, to program rich specifications inside its two constructors, which will be automatically taken into account during destruction. This formalisation style gives far more efficient specifications than quantified (double) implications. A naming convention in |SSR| is to postfix the name of view lemmas with ``P``. For example, ``orP`` relates ``||`` and ``\/``; ``negP`` relates ``~~`` and ``~``. The view mechanism is compatible with reflect predicates. .. example:: .. coqtop:: reset none From Coq Require Import ssreflect ssrbool. Set Implicit Arguments. Unset Strict Implicit. Unset Printing Implicit Defensive. Section Test. .. coqtop:: all abort Lemma test (a b : bool) (Ha : a) (Hb : b) : a /\ b. apply/andP. Conversely .. coqtop:: all Lemma test (a b : bool) : a /\ b -> a. move/andP. The same tactics can also be used to perform the converse operation, changing a boolean conjunction into a logical one. The view mechanism guesses the direction of the transformation to be used, i.e., the constructor of the reflect predicate that should be chosen. General mechanism for interpreting goals and assumptions ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Specializing assumptions ```````````````````````` The |SSR| tactic: .. coqdoc:: move/(_ term1 … termn). is equivalent to the tactic: .. coqdoc:: intro top; generalize (top term1 … termn); clear top. where ``top`` is a fresh name for introducing the top assumption of the current goal. Interpreting assumptions ```````````````````````` The general form of an assumption view tactic is: .. tacv:: {| move | case } / @term :undocumented: The term, called the *view lemma*, can be: + a (term coercible to a) function; + a (possibly quantified) implication; + a (possibly quantified) double implication; + a (possibly quantified) instance of the reflect predicate (see Section :ref:`views_and_reflection_ssr`). Let ``top`` be the top assumption in the goal. There are three steps in the behavior of an assumption view tactic. + It first introduces ``top``. + If the type of :token:`term` is neither a double implication nor an instance of the reflect predicate, then the tactic automatically generalises a term of the form ``term term1 … termn``, where the terms ``term1 … termn`` instantiate the possible quantified variables of ``term`` , in order for ``(term term1 … termn top)`` to be well typed. + If the type of ``term`` is an equivalence, or an instance of the reflect predicate, it generalises a term of the form ``(termvh (term term1 … termn ))``, where the term ``termvh`` inserted is called an *assumption interpretation view hint*. + It finally clears top. For a ``case/term`` tactic, the generalisation step is replaced by a case analysis step. *View hints* are declared by the user (see Section :ref:`views_and_reflection_ssr`) and stored in the Hint View database. The proof engine automatically detects from the shape of the top assumption ``top`` and of the view lemma ``term`` provided to the tactic the appropriate view hint in the database to be inserted. If ``term`` is a double implication, then the view hint will be one of the defined view hints for implication. These hints are by default the ones present in the file ``ssreflect.v``: .. coqdoc:: Lemma iffLR : forall P Q, (P <-> Q) -> P -> Q. which transforms a double implication into the left-to-right one, or: .. coqdoc:: Lemma iffRL : forall P Q, (P <-> Q) -> Q -> P. which produces the converse implication. In both cases, the two first ``Prop`` arguments are implicit. If ``term`` is an instance of the ``reflect`` predicate, then ``A`` will be one of the defined view hints for the ``reflect`` predicate, which are by default the ones present in the file ``ssrbool.v``. These hints are not only used for choosing the appropriate direction of the translation, but they also allow complex transformation, involving negations. .. example:: .. coqtop:: reset none From Coq Require Import ssreflect ssrbool. Set Implicit Arguments. Unset Strict Implicit. Unset Printing Implicit Defensive. Section Test. .. coqtop:: all Check introN. .. coqtop:: all Lemma test (a b : bool) (Ha : a) (Hb : b) : ~~ (a && b). apply/andP. In fact, this last script does not exactly use the hint ``introN``, but the more general hint: .. coqtop:: all Check introNTF. The lemma ``introN`` is an instantiation of ``introNF`` using ``c := true``. Note that views, being part of :token:`i_pattern`, can be used to interpret assertions too. For example, the following script asserts ``a && b``, but actually uses its propositional interpretation. .. example:: .. coqtop:: reset none From Coq Require Import ssreflect ssrbool. Set Implicit Arguments. Unset Strict Implicit. Unset Printing Implicit Defensive. Section Test. .. coqtop:: all Lemma test (a b : bool) (pab : b && a) : b. have /andP [pa ->] : (a && b) by rewrite andbC. Interpreting goals `````````````````` A goal interpretation view tactic of the form: .. tacv:: apply/@term :undocumented: applied to a goal ``top`` is interpreted in the following way. + If the type of ``term`` is not an instance of the reflect predicate, nor an equivalence, then the term ``term`` is applied to the current goal ``top``, possibly inserting implicit arguments. + If the type of ``term`` is an instance of the reflect predicate or an equivalence, then a *goal interpretation view hint* can possibly be inserted, which corresponds to the application of a term ``(termvh (term _ … _))`` to the current goal, possibly inserting implicit arguments. Like assumption interpretation view hints, goal interpretation ones are user-defined lemmas stored (see Section :ref:`views_and_reflection_ssr`) in the ``Hint View`` database, bridging the possible gap between the type of ``term`` and the type of the goal. Interpreting equivalences ~~~~~~~~~~~~~~~~~~~~~~~~~ Equivalent boolean propositions are simply *equal* boolean terms. A special construction helps the user to prove boolean equalities by considering them as logical double implications (between their coerced versions), while performing at the same time logical operations on both sides. The syntax of double views is: .. tacv:: apply/@term/@term :undocumented: The first term is the view lemma applied to the left-hand side of the equality, while the second term is the one applied to the right-hand side. In this context, the identity view can be used when no view has to be applied: .. coqdoc:: Lemma idP : reflect b1 b1. .. example:: .. coqtop:: reset none From Coq Require Import ssreflect ssrbool. Set Implicit Arguments. Unset Strict Implicit. Unset Printing Implicit Defensive. Section Test. .. coqtop:: all Lemma test (b1 b2 b3 : bool) : ~~ (b1 || b2) = b3. apply/idP/idP. The same goal can be decomposed in several ways, and the user may choose the most convenient interpretation. .. coqtop:: reset none From Coq Require Import ssreflect ssrbool. Set Implicit Arguments. Unset Strict Implicit. Unset Printing Implicit Defensive. Section Test. .. coqtop:: all Lemma test (b1 b2 b3 : bool) : ~~ (b1 || b2) = b3. apply/norP/idP. .. _declaring_new_hints_ssr: Declaring new Hint Views ~~~~~~~~~~~~~~~~~~~~~~~~ .. cmd:: Hint View for move / @ident {? | @natural } Hint View for apply / @ident {? | @natural } This command can be used to extend the database of hints for the view mechanism. As library ``ssrbool.v`` already declares a corpus of hints, this feature is probably useful only for users who define their own logical connectives. The :token:`ident` is the name of the lemma to be declared as a hint. If ``move`` is used as tactic, the hint is declared for assumption interpretation tactics; ``apply`` declares hints for goal interpretations. Goal interpretation view hints are declared for both simple views and left-hand side views. The optional natural number is the number of implicit arguments to be considered for the declared hint view lemma. .. cmdv:: Hint View for apply//@ident {? | @natural } This variant with a double slash ``//`` declares hint views for right-hand sides of double views. See the files ``ssreflect.v`` and ``ssrbool.v`` for examples. Multiple views ~~~~~~~~~~~~~~ The hypotheses and the goal can be interpreted by applying multiple views in sequence. Both ``move`` and ``apply`` can be followed by an arbitrary number of ``/term``. The main difference between the following two tactics .. coqdoc:: apply/v1/v2/v3. apply/v1; apply/v2; apply/v3. is that the former applies all the views to the principal goal. Applying a view with hypotheses generates new goals, and the second line would apply the view ``v2`` to all the goals generated by ``apply/v1``. Note that the NO-OP intro pattern ``-`` can be used to separate two views, making the two following examples equivalent: .. coqdoc:: move=> /v1; move=> /v2. move=> /v1 - /v2. The tactic ``move`` can be used together with the ``in`` tactical to pass a given hypothesis to a lemma. .. example:: .. coqtop:: reset none From Coq Require Import ssreflect ssrbool. Set Implicit Arguments. Unset Strict Implicit. Unset Printing Implicit Defensive. Section Test. Variables P Q R : Prop. .. coqtop:: all Variable P2Q : P -> Q. Variable Q2R : Q -> R. Lemma test (p : P) : True. move/P2Q/Q2R in p. If the list of views is of length two, ``Hint Views`` for interpreting equivalences are indeed taken into account; otherwise only single ``Hint Views`` are used. Synopsis and Index ------------------ Parameters ~~~~~~~~~~ |SSR| tactics .. prodn:: d_tactic ::= {| elim | case | congr | apply | exact | move } Notation scope .. prodn:: key ::= @ident Module name .. prodn:: modname ::= @qualid Natural number .. prodn:: nat_or_ident ::= {| @natural | @ident } where :token:`ident` is an Ltac variable denoting a standard Coq number (should not be the name of a tactic that can be followed by a bracket ``[``, such as ``do``, ``have``,…) Items and switches ~~~~~~~~~~~~~~~~~~ .. prodn:: ssr_binder ::= {| @ident | ( @ident {? : @term } ) } binder (see :ref:`abbreviations_ssr`) .. prodn:: clear_switch ::= { {+ @ident } } clear switch (see :ref:`discharge_ssr`) .. prodn:: c_pattern ::= {? {| @term in | @term as } } @ident in @term context pattern (see :ref:`contextual_patterns_ssr`) .. prodn:: d_item ::= {? {| @occ_switch | @clear_switch } } {? {| @term | ( @c_pattern ) } } discharge item (see :ref:`discharge_ssr`) .. prodn:: gen_item ::= {| {? @ } @ident | ( @ident ) | ( {? @ } @ident := @c_pattern ) } generalization item (see :ref:`structure_ssr`) .. prodn:: i_pattern ::= {| @ident | > | _ | ? | * | + | {? @occ_switch } {| -> | <- } | [ {?| @i_item } ] | - | [: {+ @ident } ] } intro pattern (see :ref:`introduction_ssr`) .. prodn:: i_item ::= {| @clear_switch | @s_item | @i_pattern | @i_view | @i_block } view (see :ref:`introduction_ssr`) .. prodn:: i_view ::= {? %{%} } {| /@term | /ltac:( @tactic ) } intro block (see :ref:`introduction_ssr`) .. prodn:: i_block ::= {| [^ @ident ] | [^~ {| @ident | @natural } ] } intro item (see :ref:`introduction_ssr`) .. prodn:: int_mult ::= {? @natural } @mult_mark multiplier (see :ref:`iteration_ssr`) .. prodn:: occ_switch ::= { {? {| + | - } } {* @natural } } occur. switch (see :ref:`occurrence_selection_ssr`) .. prodn:: mult ::= {? @natural } @mult_mark multiplier (see :ref:`iteration_ssr`) .. prodn:: mult_mark ::= {| ? | ! } multiplier mark (see :ref:`iteration_ssr`) .. prodn:: r_item ::= {| {? / } @term | @s_item } rewrite item (see :ref:`rewriting_ssr`) .. prodn:: r_prefix ::= {? - } {? @int_mult } {? {| @occ_switch | @clear_switch } } {? [ @r_pattern ] } rewrite prefix (see :ref:`rewriting_ssr`) .. prodn:: r_pattern ::= {| @term | @c_pattern | in {? @ident in } @term } rewrite pattern (see :ref:`rewriting_ssr`) .. prodn:: r_step ::= {? @r_prefix } @r_item rewrite step (see :ref:`rewriting_ssr`) .. prodn:: s_item ::= {| /= | // | //= } simplify switch (see :ref:`introduction_ssr`) Tactics ~~~~~~~ *Note*: ``without loss`` and ``suffices`` are synonyms for ``wlog`` and ``suff``, respectively. .. tacn:: move :name: move (ssreflect) :tacn:`idtac` or :tacn:`hnf` (see :ref:`bookkeeping_ssr`) .. tacn:: apply exact :name: apply (ssreflect); exact (ssreflect) application (see :ref:`the_defective_tactics_ssr`) .. tacv:: abstract: {+ @d_item} (see :ref:`abstract_ssr` and :ref:`generating_let_ssr`) .. tacv:: elim induction (see :ref:`the_defective_tactics_ssr`) .. tacv:: case case analysis (see :ref:`the_defective_tactics_ssr`) .. tacv:: rewrite {+ @r_step } rewrite (see :ref:`rewriting_ssr`) .. tacn:: under {? @r_prefix } @term {? => {+ @i_item}} {? do {| @tactic | [ {*| @tactic } ] } } under (see :ref:`under_ssr`) .. tacn:: over over (see :ref:`over_ssr`) .. tacn:: have {* @i_item } {? @i_pattern } {? {| @s_item | {+ @ssr_binder } } } {? : @term } := @term have {* @i_item } {? @i_pattern } {? {| @s_item | {+ @ssr_binder } } } : @term {? by @tactic } have suff {? @clear_switch } {? @i_pattern } {? : @term } := @term have suff {? @clear_switch } {? @i_pattern } : @term {? by @tactic } gen have {? @ident , } {? @i_pattern } : {+ @gen_item } / @term {? by @tactic } generally have {? @ident , } {? @i_pattern } : {+ @gen_item } / @term {? by @tactic } :name: _; _; _; _; _; generally have forward chaining (see :ref:`structure_ssr`) .. tacn:: wlog {? suff } {? @i_item } : {* {| @gen_item | @clear_switch } } / @term specializing (see :ref:`structure_ssr`) .. tacn:: suff {* @i_item } {? @i_pattern } {+ @ssr_binder } : @term {? by @tactic } suffices {* @i_item } {? @i_pattern } {+ @ssr_binder } : @term {? by @tactic } suff {? have } {? @clear_switch } {? @i_pattern } : @term {? by @tactic } suffices {? have } {? @clear_switch } {? @i_pattern } : @term {? by @tactic } :name: suff; suffices; _; _ backchaining (see :ref:`structure_ssr`) .. tacv:: pose @ident := @term local definition (see :ref:`definitions_ssr`) .. tacv:: pose @ident {+ @ssr_binder } := @term local function definition .. tacv:: pose fix @fix_decl local fix definition .. tacv:: pose cofix @fix_decl local cofix definition .. tacn:: set @ident {? : @term } := {? @occ_switch } {| @term | ( @c_pattern) } :name: set (ssreflect) abbreviation (see :ref:`abbreviations_ssr`) .. tacn:: unlock {* {? @r_prefix } @ident } unlock (see :ref:`locking_ssr`) .. tacn:: congr {? @natural } @term congruence (see :ref:`congruence_ssr`) Tacticals ~~~~~~~~~ .. prodn:: tactic += @d_tactic {? @ident } : {+ @d_item } {? @clear_switch } discharge (see :ref:`discharge_ssr`) .. prodn:: tactic += @tactic => {+ @i_item } introduction (see :ref:`introduction_ssr`) .. prodn:: tactic += @tactic in {+ {| @gen_item | @clear_switch } } {? * } localization (see :ref:`localization_ssr`) .. prodn:: tactic += do {? @mult } {| @tactic | [ {+| @tactic } ] } iteration (see :ref:`iteration_ssr`) .. prodn:: tactic += @tactic ; {| first | last } {? @natural } {| @tactic | [ {+| @tactic } ] } selector (see :ref:`selectors_ssr`) .. prodn:: tactic += @tactic ; {| first | last } {? @natural } rotation (see :ref:`selectors_ssr`) .. prodn:: tactic += by {| @tactic | [ {*| @tactic } ] } closing (see :ref:`terminators_ssr`) Commands ~~~~~~~~ .. cmd:: Hint View for {| move | apply } / @ident {? | @natural } view hint declaration (see :ref:`declaring_new_hints_ssr`) .. cmd:: Hint View for apply // @ident {? @natural } right hand side double , view hint declaration (see :ref:`declaring_new_hints_ssr`) .. cmd:: Prenex Implicits {+ @ident } prenex implicits declaration (see :ref:`parametric_polymorphism_ssr`) Settings ~~~~~~~~ .. flag:: Debug Ssreflect *Developer only.* Print debug information on reflect. .. flag:: Debug SsrMatching *Developer only.* Print debug information on SSR matching. .. rubric:: Footnotes .. [#1] Unfortunately, even after a call to the ``Set Printing All`` command, some occurrences are still not displayed to the user, essentially the ones possibly hidden in the predicate of a dependent match structure. .. [#2] Thus scripts that depend on bound variable names, e.g., via intros or with, are inherently fragile. .. [#3] The name ``subnK`` reads as “right cancellation rule for ``nat`` subtraction”. .. [#4] Also, a slightly different variant may be used for the first :token:`d_item` of ``case`` and ``elim``; see Section :ref:`type_families_ssr`. .. [#5] Except that ``/=`` does not expand the local definitions created by the |SSR| ``in`` tactical. .. [#6] |SSR| reserves all identifiers of the form “_x_”, which is used for such generated names. .. [#7] More precisely, it should have a quantified inductive type with a assumptions and m − a constructors. .. [#8] This is an implementation feature: there is no such obstruction in the metatheory. .. [#9] The current state of the proof shall be displayed by the ``Show Proof`` command of Coq proof mode. .. [#10] A simple proof context entry is a naked identifier (i.e., not between parentheses) designating a context entry that is not a section variable. coq-8.20.0/doc/sphinx/proof-engine/tactics.rst000066400000000000000000002104051466560755400212410ustar00rootroot00000000000000.. _tactics: Tactics ======== Tactics specify how to transform the :term:`proof state` of an incomplete proof to eventually generate a complete proof. Proofs can be developed in two basic ways: In :gdef:`forward reasoning`, the proof begins by proving simple statements that are then combined to prove the theorem statement as the last step of the proof. With forward reasoning, for example, the proof of `A /\\ B` would begin with proofs of `A` and `B`, which are then used to prove `A /\\ B`. Forward reasoning is probably the most common approach in human-generated proofs. In :gdef:`backward reasoning`, the proof begins with the theorem statement as the goal, which is then gradually transformed until every subgoal generated along the way has been proven. In this case, the proof of `A /\\ B` begins with that formula as the goal. This can be transformed into two subgoals, `A` and `B`, followed by the proofs of `A` and `B`. Coq and its tactics primarily use backward reasoning. A tactic may fully prove a goal, in which case the goal is removed from the proof state. More commonly, a tactic replaces a goal with one or more :term:`subgoals `. (We say that a tactic reduces a goal to its subgoals.) Most tactics require specific elements or preconditions to reduce a goal; they display error messages if they can't be applied to the goal. A few tactics, such as :tacn:`auto`, don't fail even if the proof state is unchanged. Goals are identified by number. The current goal is number 1. Tactics are applied to the current goal by default. (The default can be changed with the :opt:`Default Goal Selector` option.) They can be applied to another goal or to multiple goals with a :ref:`goal selector ` such as :n:`2: @tactic`. This chapter describes many of the most common built-in tactics. Built-in tactics can be combined to form tactic expressions, which are described in the :ref:`Ltac` chapter. Since tactic expressions can be used anywhere that a built-in tactic can be used, "tactic" may refer to both built-in tactics and tactic expressions. Common elements of tactics -------------------------- Reserved keywords ~~~~~~~~~~~~~~~~~ The tactics described in this chapter reserve the following keywords:: by using Thus, these keywords cannot be used as identifiers. It also declares the following character sequences as tokens:: ** [= |- .. _invocation-of-tactics: Invocation of tactics ~~~~~~~~~~~~~~~~~~~~~ Tactics may be preceded by a goal selector (see Section :ref:`goal-selectors`). If no selector is specified, the default selector is used. .. _tactic_invocation_grammar: .. prodn:: tactic_invocation ::= {? @toplevel_selector : } @tactic. .. todo: fully describe selectors. At the moment, ltac has a fairly complete description .. todo: mention selectors can be applied to some commands, such as Check, Search, SearchPattern, SearchRewrite. .. opt:: Default Goal Selector "@toplevel_selector" :name: Default Goal Selector This :term:`option` controls the default selector, used when no selector is specified when applying a tactic. The initial value is 1, hence the tactics are, by default, applied to the first goal. Using value ``all`` will make it so that tactics are, by default, applied to every goal simultaneously. Then, to apply a tactic tac to the first goal only, you can write ``1:tac``. Using value ``!`` enforces that all tactics are used either on a single focused goal or with a local selector (’’strict focusing mode’’). Although other selectors are available, only ``all``, ``!`` or a single natural number are valid default goal selectors. .. _bindings: Bindings ~~~~~~~~ Tactics that take a term as an argument may also accept :token:`bindings` to specify the values to assign unbound variables in a term. Bindings can be given by position or name. Generally these appear in the form :n:`@one_term_with_bindings` or :n:`with @bindings`, depending on the tactic. .. insertprodn one_term_with_bindings bindings .. prodn:: one_term_with_bindings ::= @one_term {? with @bindings } bindings ::= {+ @one_term } | {+ ( {| @ident | @natural } := @term ) } * :n:`@one_term {? with @bindings }` — bindings for variables in :n:`@one_term` are typically determined by unifying :n:`@one_term` with a tactic-dependent part of the context, with any remaining unbound variables provided by the :n:`@bindings`. * :n:`{+ @one_term }` — binds free variables in the left-to-right order of their first appearance in the relevant term. For some tactics, bindings for all free variables must be provided, such as for :tacn:`induction`, :tacn:`destruct`, :tacn:`elim` and :tacn:`case`. Other tactics automatically generate some or all of the bindings from the conclusion or a hypothesis, such as :tacn:`apply` and :tacn:`constructor` and its variants. In this case, only instances for the :term:`dependent premises ` that are not bound in the conclusion of the relevant term are required (and permitted). * :n:`{+ ( {| @ident | @natural } := @term ) }` — binds variables by name (if :n:`@ident` is given), or by unifying with the ``n``-th :term:`premise` of the relevant term (if :n:`@natural` is given). .. exn:: No such binder. :n:`@natural` is 0 or more than the number of unbound variables. .. exn:: No such bound variable @ident (no bound variables at all in the expression). :undocumented: .. exn:: No such bound variable @ident__1 (possible names are: @ident__2 ...). The specified binder name :n:`@ident__1` is not used in the :n:`@one_term`. :n:`@ident__2 ...` lists all the valid binder names. .. exn:: Not the right number of missing arguments (expected @natural). Generated when the first form of :n:`@bindings` doesn't have the expected number of arguments. .. _intropatterns: Intro patterns ~~~~~~~~~~~~~~ Intro patterns let you specify the name to assign to variables and hypotheses introduced by tactics. They also let you split an introduced hypothesis into multiple hypotheses or subgoals. Common tactics that accept intro patterns include :tacn:`assert`, :tacn:`intros` and :tacn:`destruct`. .. insertprodn intropattern equality_intropattern .. prodn:: intropattern ::= * | ** | @simple_intropattern simple_intropattern ::= @simple_intropattern_closed {* % @term0 } simple_intropattern_closed ::= @naming_intropattern | _ | @or_and_intropattern | @equality_intropattern naming_intropattern ::= @ident | ? | ?@ident or_and_intropattern ::= [ {*| {* @intropattern } } ] | ( {*, @simple_intropattern } ) | ( {*& @simple_intropattern } ) equality_intropattern ::= -> | <- | [= {* @intropattern } ] Note that the intro pattern syntax varies between tactics. Most tactics use :n:`@simple_intropattern` in the grammar. :tacn:`destruct`, :tacn:`edestruct`, :tacn:`induction`, :tacn:`einduction`, :tacn:`case`, :tacn:`ecase` and the various :tacn:`inversion` tactics use :n:`@or_and_intropattern`, while :tacn:`intros` and :tacn:`eintros` use :n:`{* @intropattern }`. The :n:`eqn:` construct in various tactics uses :n:`@naming_intropattern`. **Naming patterns** Use these elementary patterns to specify a name: * :n:`@ident` — use the specified name * :n:`?` — let Coq generate a fresh 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 **Splitting patterns** The most common splitting patterns are: * split a hypothesis in the form :n:`A /\ B` into two hypotheses :g:`H1: A` and :g:`H2: B` using the pattern :g:`(H1 & H2)` or :g:`(H1, H2)` or :g:`[H1 H2]`. :ref:`Example `. This also works on :n:`A <-> B`, which is just a notation representing :n:`(A -> B) /\ (B -> A)`. * split a hypothesis in the form :g:`A \/ B` into two subgoals using the pattern :g:`[H1|H2]`. The first subgoal will have the hypothesis :g:`H1: A` and the second subgoal will have the hypothesis :g:`H2: B`. :ref:`Example ` * split a hypothesis in either of the forms :g:`A /\ B` or :g:`A \/ B` using the pattern :g:`[]`. Patterns can be nested: :n:`[[Ha|Hb] H]` can be used to split :n:`(A \/ B) /\ C`. Note that there is no equivalent to intro patterns for goals. For a goal :g:`A /\ B`, use the :tacn:`split` tactic to replace the current goal with subgoals :g:`A` and :g:`B`. For a goal :g:`A \/ B`, use :tacn:`left` to replace the current goal with :g:`A`, or :tacn:`right` to replace the current goal with :g:`B`. * :n:`( {+, @simple_intropattern}` ) — matches a product over an inductive type with a :ref:`single constructor `. If the number of patterns equals the number of constructor arguments, then it applies the patterns only to the arguments, and :n:`( {+, @simple_intropattern} )` is equivalent to :n:`[{+ @simple_intropattern}]`. If the number of patterns equals the number of constructor arguments plus the number of :n:`let-ins`, the patterns are applied to the arguments and :n:`let-in` variables. * :n:`( {+& @simple_intropattern} )` — matches a right-hand nested term that consists of one or more nested binary inductive types such as :g:`a1 OP1 a2 OP2 …` (where the :g:`OPn` are right-associative). (If the :g:`OPn` are left-associative, additional parentheses will be needed to make the term right-hand nested, such as :g:`a1 OP1 (a2 OP2 …)`.) The splitting pattern can have more than 2 names, for example :g:`(H1 & H2 & H3)` matches :g:`A /\ B /\ C`. The inductive types must have a :ref:`single constructor with two parameters `. :ref:`Example ` * :n:`[ {+| {* @intropattern } } ]` — splits an inductive type that has :ref:`multiple constructors ` such as :n:`A \/ B` into multiple subgoals. The number of :token:`intropattern`\s must be the same as the number of constructors for the matched part. * :n:`[ {+ @intropattern} ]` — splits an inductive type that has a :ref:`single constructor with multiple parameters ` such as :n:`A /\ B` into multiple hypotheses. Use :n:`[H1 [H2 H3]]` to match :g:`A /\ B /\ C`. * :n:`[]` — splits an inductive type: If the inductive type has multiple constructors, such as :n:`A \/ B`, create one subgoal for each constructor. If the inductive type has a single constructor with multiple parameters, such as :n:`A /\ B`, split it into multiple hypotheses. **Equality patterns** These patterns can be used when the hypothesis is an equality: * :n:`->` — replaces the right-hand side of the hypothesis with the left-hand side of the hypothesis in the conclusion of the goal; the hypothesis is cleared; if the left-hand side of the hypothesis is a variable, it is substituted everywhere in the context and the variable is removed. :ref:`Example ` * :n:`<-` — similar to :n:`->`, but replaces the left-hand side of the hypothesis with the right-hand side of the hypothesis. * :n:`[= {*, @intropattern} ]` — If the product is over an equality type, applies either :tacn:`injection` or :tacn:`discriminate`. If :tacn:`injection` is applicable, the intropattern is used on the hypotheses generated by :tacn:`injection`. If the number of patterns is smaller than the number of hypotheses generated, the pattern :n:`?` is used to complete the list. :ref:`Example ` **Other patterns** * :n:`*` — introduces one or more :term:`dependent premises ` from the result until there are no more. :ref:`Example ` * :n:`**` — introduces one or more :term:`dependent ` or :term:`non-dependent premises ` from the result until there are no more premises. :g:`intros **` is equivalent to :g:`intros`. :ref:`Example ` * :n:`@simple_intropattern_closed {* % @term}` — first applies each of the terms with the :tacn:`apply` tactic on the hypothesis to be introduced, then it uses :n:`@simple_intropattern_closed`. :ref:`Example ` .. _intropattern_cons_note: .. note:: :n:`A \/ B` and :n:`A /\ B` use infix notation to refer to the inductive types :n:`or` and :n:`and`. :n:`or` has multiple constructors (:n:`or_introl` and :n:`or_intror`), while :n:`and` has a single constructor (:n:`conj`) with multiple parameters (:n:`A` and :n:`B`). These are defined in ``theories/Init/Logic.v``. The "where" clauses define the infix notation for "or" and "and". .. coqdoc:: Inductive or (A B:Prop) : Prop := | or_introl : A -> A \/ B | or_intror : B -> A \/ B where "A \/ B" := (or A B) : type_scope. Inductive and (A B:Prop) : Prop := conj : A -> B -> A /\ B where "A /\ B" := (and A B) : type_scope. .. note:: :tacn:`intros` :n:`{+ p}` is not always equivalent to :n:`intros p; … ; intros p` if some of the :n:`p` are :g:`_`. In the first form, all erasures are done at once, while they're done sequentially for each tactic in the second form. If the second matched term depends on the first matched term and the pattern for both is :g:`_` (i.e., both will be erased), the first :n:`intros` in the second form will fail because the second matched term still has the dependency on the first. Examples: .. _intropattern_conj_ex: .. example:: intro pattern for /\\ .. coqtop:: reset none Goal forall (A: Prop) (B: Prop), (A /\ B) -> True. .. coqtop:: out intros. .. coqtop:: all destruct H as (HA & HB). .. _intropattern_disj_ex: .. example:: intro pattern for \\/ .. coqtop:: reset none Goal forall (A: Prop) (B: Prop), (A \/ B) -> True. .. coqtop:: out intros. .. coqtop:: all destruct H as [HA|HB]. all: swap 1 2. .. _intropattern_rarrow_ex: .. example:: -> intro pattern .. coqtop:: reset none Goal forall (x:nat) (y:nat) (z:nat), (x = y) -> (y = z) -> (x = z). .. coqtop:: out intros * H. .. coqtop:: all intros ->. .. _intropattern_inj_discr_ex: .. example:: [=] intro pattern The first :tacn:`intros` :n:`[=]` uses :tacn:`injection` to strip :n:`(S …)` from both sides of the matched equality. The second uses :tacn:`discriminate` on the contradiction :n:`1 = 2` (internally represented as :n:`(S O) = (S (S O))`) to complete the goal. .. coqtop:: reset none Goal forall (n m:nat), (S n) = (S m) -> (S O)=(S (S O)) -> False. .. coqtop:: out intros *. .. coqtop:: all intros [= H]. .. coqtop:: all intros [=]. .. _intropattern_ampersand_ex: .. example:: (A & B & …) intro pattern .. coqtop:: reset none Parameters (A : Prop) (B: nat -> Prop) (C: Prop). .. coqtop:: out Goal A /\ (exists x:nat, B x /\ C) -> True. .. coqtop:: all intros (a & x & b & c). .. _intropattern_star_ex: .. example:: * intro pattern .. coqtop:: reset out Goal forall (A: Prop) (B: Prop), A -> B. .. coqtop:: all intros *. .. _intropattern_2stars_ex: .. example:: ** pattern ("intros \**" is equivalent to "intros") .. coqtop:: reset out Goal forall (A: Prop) (B: Prop), A -> B. .. coqtop:: all intros **. .. example:: compound intro pattern .. coqtop:: reset out Goal forall A B C:Prop, A \/ B /\ C -> (A -> C) -> C. .. coqtop:: all intros * [a | (_,c)] f. all: swap 1 2. .. _intropattern_injection_ex: .. example:: combined intro pattern using [=] -> and % .. coqtop:: reset none Require Import Coq.Lists.List. Section IntroPatterns. Variables (A : Type) (xs ys : list A). .. coqtop:: out Example ThreeIntroPatternsCombined : S (length ys) = 1 -> xs ++ ys = xs. .. coqtop:: all intros [=->%length_zero_iff_nil]. * `intros` would add :g:`H : S (length ys) = 1` * `intros [=]` would additionally apply :tacn:`injection` to :g:`H` to yield :g:`H0 : length ys = 0` * `intros [=->%length_zero_iff_nil]` applies the theorem, making H the equality :g:`l=nil`, which is then applied as for :g:`->`. .. coqdoc:: Theorem length_zero_iff_nil (l : list A): length l = 0 <-> l=nil. The example is based on `Tej Chajed's coq-tricks `_ .. _occurrenceclauses: Occurrence clauses ~~~~~~~~~~~~~~~~~~ An :gdef:`occurrence` is a subterm of a goal or hypothesis that matches a pattern provided by a tactic. Occurrence clauses select a subset of the ocurrences in a goal and/or in one or more of its hypotheses. .. insertprodn occurrences concl_occs .. prodn:: occurrences ::= at @occs_nums | in @goal_occurrences simple_occurrences ::= @occurrences occs_nums ::= {? - } {+ @nat_or_var } nat_or_var ::= {| @natural | @ident } goal_occurrences ::= {+, @hyp_occs } {? %|- {? @concl_occs } } | * %|- {? @concl_occs } | %|- {? @concl_occs } | {? @concl_occs } hyp_occs ::= @hypident {? at @occs_nums } hypident ::= @ident | ( type of @ident ) | ( value of @ident ) concl_occs ::= * {? at @occs_nums } :n:`@occurrences` The first form of :token:`occurrences` selects occurrences in the conclusion of the goal. The second form can select occurrences in the goal conclusion and in one or more hypotheses. :n:`@simple_occurrences` A semantically restricted form of :n:`@occurrences` that doesn't allow the `at` clause anywhere within it. :n:`{? - } {+ @nat_or_var }` Selects the specified occurrences within a single goal or hypothesis. Occurrences are numbered starting with 1 following a depth-first traversal of the term's expression, including occurrences in :ref:`implicit arguments ` and :ref:`coercions ` that are not displayed by default. (Set the :flag:`Printing All` flag to show those in the printed term.) For example, when matching the pattern `_ + _` in the term `(a + b) + c`, occurrence 1 is `(…) + c` and occurrence 2 is `(a + b)`. When matching that pattern with term `a + (b + c)`, occurrence 1 is `a + (…)` and occurrence 2 is `b + c`. Specifying `-` includes all occurrences *except* the ones listed. :n:`{*, @hyp_occs } {? %|- {? @concl_occs } }` Selects occurrences in the specified hypotheses and the specified occurrences in the conclusion. :n:`* %|- {? @concl_occs }` Selects all occurrences in all hypotheses and the specified occurrences in the conclusion. :n:`%|- {? @concl_occs }` Selects the specified occurrences in the conclusion. :n:`@goal_occurrences ::= {? @concl_occs }` Selects all occurrences in all hypotheses and in the specified occurrences in the conclusion. :n:`@hypident {? at @occs_nums }` Omiting :token:`occs_nums` selects all occurrences within the hypothesis. :n:`@hypident ::= @ident` Selects the hypothesis named :token:`ident`. :n:`( type of @ident )` Selects the type part of the named hypothesis (e.g. `: nat`). :n:`( value of @ident )` Selects the value part of the named hypothesis (e.g. `:= 1`). :n:`@concl_occs ::= * {? at @occs_nums }` Selects occurrences in the conclusion. '*' by itself selects all occurrences. :n:`@occs_nums` selects the specified occurrences. Use `in *` to select all occurrences in all hypotheses and the conclusion, which is equivalent to `in * |- *`. Use `* |-` to select all occurrences in all hypotheses. When rewriting in multiple hypotheses, they must not appear in the term to rewrite. For instance `rewrite H in H,H'` is an error. If an hypothesis appears only through a hole, it will be removed from that hole's context. With `rewrite term in *`, hypotheses on which the dependency cannot be avoided are skipped, for instance `rewrite H in *` skips rewriting in `H`. This is the case even if only one hypothesis ends up rewritten. If multiple occurrences are given, such as in :tacn:`rewrite` `H at 1 2 3`, the tactic must match at least one occurrence in order to succeed. The tactic will fail if no occurrences match. Occurrence numbers that are out of range (e.g. `at 1 3` when there are only 2 occurrences in the hypothesis or conclusion) are ignored. .. todo: remove last sentence above and add "Invalid occurrence number @natural" exn for 8.14 per #13568. Tactics that use occurrence clauses include :tacn:`set`, :tacn:`remember`, :tacn:`induction` and :tacn:`destruct`. .. exn:: No such hypothesis: @ident. :undocumented: .. seealso:: :ref:`Managingthelocalcontext`, :ref:`caseanalysisandinduction`, :ref:`printing_constructions_full`. .. _applyingtheorems: Applying theorems --------------------- .. tacn:: exact @one_term Directly gives the exact proof term for the goal. ``exact p`` succeeds if and only if :n:`@one_term` and the type of ``p`` are unifiable (see :ref:`Conversion-rules`). .. exn:: Not an exact proof. :undocumented: .. tacn:: eexact @one_term Behaves like :tacn:`exact` but can handle terms and goals with existential variables. .. tacn:: assumption This tactic looks in the local context for a hypothesis whose type is convertible to the goal. If it is the case, the subgoal is proved. Otherwise, it fails. .. exn:: No such assumption. :undocumented: .. tacn:: eassumption Behaves like :tacn:`assumption` but is able to process goals and hypotheses with existential variables. It can also resolve existential variables, which :tacn:`assumption` will not. .. tacn:: {? simple } {? notypeclasses } refine @one_term :name: refine Behaves like :tacn:`exact` but allows holes (denoted by ``_`` or :n:`(_ : @type)`) in :n:`@one_term`. :tacn:`refine` generates as many subgoals as there are remaining holes in the elaborated term. Any subgoal that occurs in other subgoals is automatically shelved, as if calling :tacn:`shelve_unifiable`. `simple` If specified, don't shelve any subgoals or perform beta reduction. `notypeclasses` If specified, do checking without resolving typeclasses. The generated subgoals (shelved or not) are *not* candidates for typeclass resolution, even if they have a typeclass type as their conclusion. .. example:: .. coqtop:: reset all Inductive Option : Set := | Fail : Option | Ok : bool -> Option. Definition get : forall x:Option, x <> Fail -> bool. refine (fun x:Option => match x return x <> Fail -> bool with | Fail => _ | Ok b => fun _ => b end). intros; absurd (Fail = Fail); trivial. Defined. .. exn:: Cannot infer a term for this placeholder. :name: Cannot infer a term for this placeholder. (refine) There is a hole in the term you gave whose type cannot be inferred. Put a cast around it. Setting :opt:`Debug` ``"unification"`` enables printing traces of unification steps used during elaboration/typechecking and the :tacn:`refine` tactic. ``"ho-unification"`` prints information about higher order heuristics. .. tacn:: apply {+, @one_term_with_bindings } {? @in_hyp_as } .. insertprodn in_hyp_as as_ipat .. prodn:: in_hyp_as ::= in {+, @ident {? @as_ipat } } as_ipat ::= as @simple_intropattern Uses unification to match the type of each :n:`@one_term` (in :n:`@one_term_with_bindings`) with the goal (to do :term:`backward reasoning`) or with a hypothesis (to do :term:`forward reasoning`). Specifying multiple :n:`@one_term_with_bindings` is equivalent to giving each one serially, left to right, as separate `apply` tactics. The type of :n:`@one_term` contains zero or more :term:`premises ` followed by a :ref:`conclusion `, i.e. it typically has the form :n:`{? forall @open_binders , } {* @term__premise -> } @term__conclusion`. (The ``forall``\s may also be interleaved with the premises, but common usage is to equivalently gather them at the beginning of the :n:`@one_term`.) Backward reasoning with a :n:`@one_term` whose type is, for example, `A -> B` replaces an as-yet unproven goal `B` with `A`. Forward reasoning with the same :n:`@one_term` changes a hypothesis with type `A` to `B`. (Hypotheses are considered proven propositions within the context that contains them.) Unification creates a map from the variables in the type of :n:`@one_term` to matching subterms of the goal or hypothesis. The matching subterms are then substituted into the type of :n:`@one_term` when generating the updated goal or hypothesis. Unmatched premises become new subgoals with similar substitutions. If no match is found, the tactic fails. Setting :opt:`Debug` ``"tactic-unification"`` enables printing traces of unification steps in tactic unification. Tactic unification is used in tactics such as :tacn:`apply` and :tacn:`rewrite`. The goal and hypothesis cases are described separately for clarity. .. _unused1: .. the dummy ref name is needed to get correct formatting of the next line and "Without..." :n:`@one_term` (inside :n:`@one_term_with_bindings`) If :n:`@one_term` is an :n:`@ident`, it is the name of a theorem, lemma or hypothesis whose type is given in the theorem statement or shown in the context. Otherwise it is a proof term whose type can be displayed with :cmd:`Check` :n:`@one_term`. Without :n:`@in_hyp_as` (the goal case) If the goal matches all of the type of :n:`@one_term` (both premises and the conclusion), the tactic proves the goal. Otherwise, the tactic matches the goal against the conclusion of :n:`@one_term` and, if possible, one or more premises (from right to left). If the match succeeds, the tactic replaces the current goal with a subgoal for each unmatched premise of the type of :n:`@one_term`. This :ref:`example ` matches only the conclusion, while this :ref:`one ` also matches a premise. If the conclusion of the type of :token:`one_term` does not match the goal *and* the conclusion is an inductive type with a single constructor, then each premise in the constructor is recursively matched to the goal in right-to-left order and the first match is used. In this case, the tactic will not match premises that would result in applying a lemma of the form ``forall A, … -> A``. See example :ref:`here `. .. _apply_with_second_order_unification: The goal case uses first-order unification with dependent types unless the conclusion of the type of :token:`term` is of the form :n:`P t__1 … t__n` with :n:`P` to be instantiated. In the latter case, the behavior depends on the form of the target. If the target is of the form :n:`Q u__1 … u__n` and the :n:`t__i` and :n:`u__i` unify, then :n:`P` is instantiated into :n:`Q`. Otherwise, :tacn:`apply` tries to define :n:`P` by abstracting over :n:`t__1 … t__n` in the target. You can use :tacn:`pattern` to transform the target so that it gets the form :n:`(fun x__1 … x__n => Q) u__1 … u__n`. See the example :ref:`here `. :n:`@in_hyp_as` (the hypothesis case) Proceeding from *right to left*, find the first premise of the type of :n:`@one_term` that matches the specified hypothesis. If a match is found, the hypothesis is replaced with the conclusion of the type of :n:`@one_term` (substituting for the unified variables) and the tactic creates a new subgoal for each unmatched premise. See the example :ref:`here `. If specified, :n:`as @simple_intropattern` is applied to the conclusion of the type of :n:`@one_term`. In this case, the selected hypothesis is left unchanged if its name is not reused. If the type of :n:`@one_term` is an inductive type with a single constructor, then each premise in the constructor is recursively matched to the conclusion of the hypothesis in right-to-left order and the first match is used. See example :ref:`here `. For the hypothesis case, matching is done only with first-order unification. :n:`with @bindings` (in :n:`@one_term_with_bindings`) Gives explicit instantiations for variables used in the type of :n:`@one_term`. There are 3 cases: - Bindings for variables can be provided in a list of :n:`@one_term`\s in the left-to-right order of their first appearance in the type of :n:`@one_term`. For the goal case (:ref:`example `), the list should give bindings only for variables that aren't bound by unification. However, in the hypothesis case (:ref:`example `), the list must include bindings for *all* variables. - Bindings for unbound variables can be given by name with the :n:`(@ident := @term)` form. - The form :n:`(@natural := @term)` binds additional variables by unifying the Nth premise of the type of :n:`@one_term` with :n:`@term`. (Use `1` for the first premise.) .. exn:: Unable to unify @one_term with @one_term. The :tacn:`apply` tactic failed to match the conclusion of :token:`one_term`. You can help :tacn:`apply` by transforming your goal with the :tacn:`change` or :tacn:`pattern` tactics. .. exn:: Unable to apply lemma of type "..." on hypothesis of type "...". This happens if the conclusion of :token:`ident` does not match any of the premises of the type of :token:`one_term`. .. exn:: Unable to find an instance for the variables {+ @ident}. This occurs when some instantiations of the premises of :token:`one_term` are not deducible from the unification. This is the case, for instance, when you want to apply a transitivity property. To fix this, add bindings for the :n:`@ident`\s using to :n:`with @bindings` or use :tacn:`eapply`. .. todo: we should be listing things like "Debug tactic-unification" in in the options index. Maybe we should add ":debug:" as a new tag. .. _apply_backward: .. example:: Backward reasoning in the goal with `apply` .. coqtop:: reset none Goal forall A B C: Prop, (A -> B -> C) -> C. .. coqtop:: out intros A B C H. .. coqtop:: all apply H. (* replace goal with new goals for unmatched premises of H *) .. _apply_backward_w_premises: .. example:: Backward reasoning in the goal with `apply` including a premise .. coqtop:: reset none Goal forall A B C: Prop, (A -> B -> C) -> (B -> C). .. coqtop:: out intros A B C H. .. coqtop:: all apply H. (* match on "B -> C", replace goal with "A" *) .. _apply_forward: .. example:: Forward reasoning in hypotheses with `apply` .. coqtop:: reset none Goal forall A B C: Prop, B -> (A -> B -> C) -> True. .. coqtop:: out intros A B C H0 H1. .. coqtop:: all apply H1 in H0. (* change H0, create new goals for unmatched premises of H1 *) .. _apply_with_binding_goal: .. example:: Apply a theorem with a binding in a goal :tacn:`apply` unifies the conclusion `n <= p` of the theorem `le_trans : forall n m p, n <= m -> m <= p -> n <= p` with the goal, assigning `x * x` and `y * y` in the goal to, repectively, `n` and `p` in theorem (backward reasoning). The `with` clause provides the binding for `m`: .. coqtop:: reset in Require Import PeanoNat. .. coqtop:: none Goal forall (x y : nat), x <= y -> x * x <= y * y. .. coqtop:: out intros x y H0. .. coqtop:: all apply Nat.le_trans with (y * x). .. _apply_with_binding_hyp: .. example:: Apply a theorem with a binding in a hypothesis When applying a theorem in a hypothesis, :tacn:`apply` unifies the hypothesis with one of the premises of the theorem `le_trans : forall n m p, n <= m -> m <= p -> n <= p`. In this case, it unifies with the first premise (`n <= m`) and assigns `x * x` and `y * y` to, respectively, `n` and `m` in the theorem (forward reasoning). The `with` clause provides the binding for `p`. In addition, :tacn:`apply` in a hypothesis isn't as flexible as :tacn:`apply` in the goal: for hypotheses, the unbound variable can be bound by name (as shown) or values for all the variables can be given positionally, i.e. `apply Nat.le_trans with (x * x) (y * y) (y * x) in H.` .. coqtop:: reset in Require Import PeanoNat. .. coqtop:: none Goal forall (x y : nat), x * x <= y * y -> x <= y. .. coqtop:: out intros x y H. .. coqtop:: all apply Nat.le_trans with (p := y * x) in H. .. _apply_with_iff: .. example:: Applying theorems with `<->` .. Note: :n:`/\` and :n:`/\\` don't give the desired output. A bug. :n:`A <-> B` is defined as :n:`(A -> B) /\ (B -> A)`. `/\\` represents an inductive type with a single constructor: :n:`Inductive and (C D:Prop) : Prop := conj : C -> D -> D /\ C`. The premises of :n:`conj` are :n:`C` and :n:`D`. The tactic uses the first matching constructor premise in right-to-left order. Theorems that use :n:`<->` to state a logical equivalence behave consistently when applied to goals and hypotheses. .. coqtop:: reset none Goal forall (A B: Prop) (H1: A <-> B) (H: A), A. .. coqtop:: out intros A B H1 H. .. coqtop:: all apply H1. apply H1 in H. .. _example_apply_pattern: .. example:: Special case of second-order unification in apply Shows the use of the special case second-order unification described :ref:`here ` (after "unless"). Note that we usually use :tacn:`induction` rather than applying ``nat_ind`` directly. .. coqtop:: reset none Goal forall x y, x + y = y + x. .. coqtop:: out intros. .. coqtop:: all Check nat_ind. apply nat_ind. (* Notice the goals are unprovable. *) Show Proof. (* apply has instantiated P with (eq (x + y)) because the goal was (eq (x + y) (y + x)) and n could be unified with (y + x) *) (* However, we can use the pattern tactic to get the instantiation we want: *) Undo. pattern x. apply nat_ind. Show Proof. (* apply has instantiated P with (fun n : nat => n + y = y + n) and the goal can be proven *) .. tacn:: eapply {+, @one_term_with_bindings } {? @in_hyp_as } Behaves like :tacn:`apply`, but creates :ref:`existential variables ` when Coq is unable to deduce instantiations for variables, rather than failing. .. tacn:: rapply @one_term Behaves like :tacn:`eapply` but uses the proof engine of :tacn:`refine` to handle existential variables, holes and conversion problems. This may result in slightly different behavior regarding which conversion problems are solvable. However, :tacn:`rapply` fails if any holes remain in :n:`@one_term` itself after typechecking and typeclass resolution but before unification with the goal. Note that :tacn:`rapply` tries to instantiate as many hypotheses of :n:`@one_term` as possible. As a result, if it is possible to apply :n:`@one_term` to arbitrarily many arguments without getting a type error, :tacn:`rapply` will loop. .. tacn:: simple apply {+, @one_term_with_bindings } {? @in_hyp_as } Behaves like :tacn:`apply` but it reasons modulo conversion only on subterms that contain no variables to instantiate and does not traverse tuples. For instance, the following example fails because it would require converting ``id ?foo`` and :g:`O`. .. _simple_apply_ex: .. example:: .. coqtop:: reset all Definition id (x : nat) := x. Parameter H : forall x y, id x = y. Goal O = O. Fail simple apply H. Because it reasons modulo a limited amount of conversion, :tacn:`simple apply` fails faster than :tacn:`apply` and it is thus well-suited for use in user-defined tactics that backtrack often. .. tacn:: simple eapply {+, @one_term_with_bindings } {? @in_hyp_as } :undocumented: .. tacn:: lapply @one_term Splits a :n:`@one_term` in the goal reducible to the form `A -> B`, replacing it with two new subgoals `A` and `B -> G`. ``lapply H`` (where `H` is `A -> B` and `B` does not start with a product) is equivalent to :tacn:`cut` ``B. 2:apply H.``. .. exn:: lapply needs a non-dependent product. :undocumented: .. example:: Assume we have a transitive relation ``R`` on ``nat``: .. coqtop:: reset in Parameter R : nat -> nat -> Prop. Axiom Rtrans : forall x y z:nat, R x y -> R y z -> R x z. Parameters n m p : nat. Axiom Rnm : R n m. Axiom Rmp : R m p. Consider the goal ``(R n p)`` provable using the transitivity of ``R``: .. coqtop:: in Goal R n p. The direct application of ``Rtrans`` with ``apply`` fails because no value for ``y`` in ``Rtrans`` is found by ``apply``: .. coqtop:: all fail apply Rtrans. A solution is to ``apply (Rtrans n m p)`` or ``(Rtrans n m)``. .. coqtop:: all apply (Rtrans n m p). Note that ``n`` can be inferred from the goal, so the following would work too. .. coqtop:: in restart apply (Rtrans _ m). More elegantly, ``apply Rtrans with (y:=m)`` allows only mentioning the unknown m: .. coqtop:: in restart apply Rtrans with (y := m). Another solution is to mention the proof of ``(R x y)`` in ``Rtrans`` .. coqtop:: all restart apply Rtrans with (1 := Rnm). … or the proof of ``(R y z)``. .. coqtop:: all restart apply Rtrans with (2 := Rmp). On the opposite, one can use ``eapply`` which postpones the problem of finding ``m``. Then one can apply the hypotheses ``Rnm`` and ``Rmp``. This instantiates the existential variable and completes the proof. .. coqtop:: all restart abort eapply Rtrans. apply Rnm. apply Rmp. .. todo the following title isn't the greatest. Perhaps more like "trivial tactics" or "simple tactics"??? .. _managingthelocalcontext: Managing the local context ------------------------------ .. tacn:: intro {? @ident } {? @where } Applies the :tacn:`hnf` tactic until it finds an item that can be introduced in the context by removing certain constructs in the goal. If no item is found, the tactic fails. The name used is :n:`@ident` (if specified) or from the construct, except that if the name from the construct already exists in the :term:`local context`, Coq uses a fresh name instead. The constructs have these forms: (See examples :ref:`here `.) :n:`forall x : T, @term` `x : T` is a :term:`dependent premise`. Removes `forall x : T,` from the goal and adds `x : T` to the context. :n:`A -> …` `A` is a :term:`non-dependent premise`. Removes `A ->` from the goal and adds `H : A` to the context. :n:`let x := c, @term` Removes `let x := c,` from the goal and adds `x := c : T` to the context. .. _warn_should_give_name_in_intro: We recommend always specifying :n:`@ident` so that the names of hypotheses don't change as the proof is updated, making your proof easier to maintain. For example, if H exists in the context, Coq will consider using `H0`, `H1`, ... until it finds an unused name. Modifications to a proof can change automatically assigned names that subsequent tactics likely refer to, making the proofs harder to maintain. The :flag:`Mangle Names` flag gives some control over how fresh names are generated (see :ref:`proof-maintenance`). Note that :tacn:`intros` lets you introduce multiple items into the context with a single tactic. :n:`@ident` The name to give to the introduced item. If not given, Coq uses the variable name from the :n:`forall` or `H` for premises. If a name such as `H` is already in use, Coq will consider using `H0`, `H1`, ... until it finds a fresh name. .. note:: If a hypothesis name hides the base name of a global constant then the latter can still be referred to by a qualified name (see :ref:`Qualified-names`). :n:`@where` Indicates where to place the introduced hypothesis: at the top or bottom of the context or before or after another specified hypothesis. The default is `at bottom`. .. exn:: @ident is already used. The provided :n:`@ident` is already used in the :term:`local context`. .. exn:: No product even after head-reduction. There is nothing to introduce even after :tacn:`hnf` has been completely applied. .. _intro_examples: .. example:: `intro` and `intros` .. coqtop:: reset out Goal forall m n, m < n -> (let x := 0 in True). .. coqtop:: all intro m. intro n. intro H. intro x. This single `intros` tactic is equivalent to the 4 preceding `intro` tactics: .. coqtop:: reset out Goal forall m n, m < n -> (let x := 0 in True). .. coqtop:: all intros m n H x. .. tacn:: intros {* @intropattern } intros until {| @ident | @natural } The first form introduces zero or more items into the context from the constructs listed in :tacn:`intro`. If :n:`@intropattern` is not specified, the tactic introduces items until it reaches the :term:`head constant`; it never fails and may leave the context unchanged. If :n:`@intropattern` is specified, the :tacn:`hnf` tactic is applied until it finds an item that can be introduced into the context. The :n:`@intropattern` is often just a list of :n:`@ident`\s, but other forms can also be specified in order to, for example, introduce all :term:`dependent premises ` (`*`); introduce all dependent and :term:`non-dependent premises ` (`**`); split terms such as `A /\\ B` (`[]`) and pick a fresh name with a given prefix (`?X`). See :ref:`intropatterns`. The second form repeats :n:`intro` until it has introduced a :term:`dependent premise` with the name :n:`@ident` or has introduced :n:`@natural` :term:`premises ` (like ``A`` in ``A -> B``). We recommend explicitly naming items with :tacn:`intros` instead of using :n:`intros until @natural`. See the explanation :ref:`here `. .. example:: intros until .. coqtop:: reset out Goal forall x y : nat, x = y -> y = x. .. coqtop:: all intros until y. Or: .. coqtop:: reset out Goal forall x y : nat, x = y -> y = x. .. coqtop:: all intros until 1. .. exn:: No quantified hypothesis named @ident in current goal even after head-reduction. The :n:`@ident` in the ``until`` clause doesn't appear as a :term:`dependent premise`. .. exn:: No @natural-th non dependent hypothesis in current goal even after head-reduction. There are fewer than :n:`@natural` premises in the goal. .. tacn:: eintros {* @intropattern } Works just like :tacn:`intros` except that it creates existential variables for any unresolved variables rather than failing. Typically this happens when using a ``%`` intropattern (see :n:`@simple_intropattern`). .. tacn:: clear {? {? - } {+ @ident } } Erases *unneeded* hypotheses from the context of the current goal. "Unneeded" means that the unselected hypotheses and the goal don't depend directly or indirectly on the erased hypotheses. That means the hypotheses will no longer appear in the context and therefore can't be used in subsequent proof steps. Note that erasing an uneeded hypothesis may turn a goal that was provable into an unprovable goal. :n:`clear` All unneeded hypotheses are erased. This may leave the context unchanged; this form never fails. :n:`clear {+ @ident }` Erases the named hypotheses if they are unneeded and fails otherwise. .. exn:: @ident is used in the conclusion. :undocumented: .. exn:: @ident is used in the hypothesis @ident. :undocumented: :n:`clear - {+ @ident }` Selects all hypotheses that are not named by the :n:`@ident`\s, then erases those that are unneeded. This may leave the context unchanged; this form never fails as long as the :n:`@ident`\s name hypotheses in the context. .. tacn:: clearbody {+ @ident } This tactic expects :n:`{+ @ident}` to be :term:`local definitions ` and clears their respective bodies. In other words, it turns the given definitions into assumptions. .. exn:: @ident is not a local definition. :undocumented: .. tacn:: clear dependent @ident Clears the hypothesis :token:`ident` and all the hypotheses that depend on it. .. tacn:: revert {+ @ident } Moves the specified hypotheses and :term:`local definitions ` to the goal, if this respects dependencies. This is the inverse of :tacn:`intro`. .. tacn:: revert dependent @ident .. deprecated:: 8.18 An alias for :tacn:`generalize dependent`. .. tacn:: move @ident__from @where .. insertprodn where where .. prodn:: where ::= at top | at bottom | before @ident | after @ident Moves a hypothesis :n:`@ident__from` and hypotheses that directly or indirectly refer to :n:`@ident__from` that appear between :n:`@ident__from` and :n:`@ident`. `at top` and `at bottom` are equivalent to giving the name of the first or last hypotheses in the context. The dependent hypotheses will appear after :n:`@ident__from`, appearing in dependency order. This lets users show and group hypotheses in the order they prefer. It doesn't change the goal or the proof term. .. todo: "at top and at bottom are equivalent to giving the name of the first or last hypotheses in the context." Equivalent to "after first" and "after last"?? .. note:: Perhaps confusingly, "before" and "after" are interpeted with respect to the direction in which the hypotheses are moved rather than in the order of the resulting list of hypotheses. If :n:`@ident__from` is before :n:`@ident` in the context, these notions are the same: for hypotheses `A B C`, `move A after B` gives `B A C`, whereas if :n:`@ident__from` is after :n:`@ident` in the context, they are the opposite: `move C after A` gives `C A B` because the direction of movement is reversed. .. todo This is dreadful behavior .. exn:: Cannot move @ident__from after @ident: it occurs in the type of @ident. :undocumented: .. exn:: Cannot move @ident__from after @ident: it depends on @ident. :undocumented: .. example:: move .. coqtop:: reset none Goal forall x :nat, x = 0 -> forall y z:nat, y=y-> 0=x. .. coqtop:: out intros x Hx y z Hy. .. coqtop:: in (* x Hx y z Hy *) move y after z. (* x Hx z y Hy (z was left of y, intuitive case) *) Undo. move z after y. (* x Hx z y Hy (z was right of y, see Note above) *) Undo. move x after Hy. (* y z Hy x Hx (Hx depends on x, so moved) *) Undo. move x before Hy. (* y z x Hx Hy *) Undo. move Hy after Hx. (* x y Hy Hx z *) Undo. move Hy before Hx. (* x Hx y Hy z *) .. tacn:: rename {+, @ident__1 into @ident__2 } Renames hypothesis :n:`@ident__1` into :n:`@ident__2` for each pair of :n:`@ident`\s. Renaming is done simultaneously, which permits swapping the names of 2 hypotheses. (Note that the renaming is applied in the context and the existential variables, but the proof term doesn't change.) .. tacn:: set @alias_definition {? @occurrences } set @one_term {? @as_name } {? @occurrences } :name: set; _ .. insertprodn alias_definition as_name .. prodn:: alias_definition ::= ( @ident {* @simple_binder } := @term ) simple_binder ::= @name | ( {+ @name } : @term ) as_name ::= as @ident The first form adds a new local definition :n:`@ident := …`. If :n:`@simple_binder` is not specified, the definition body is :n:`@term` and otherwise :n:`fun {* @simple_binder } => @term`. Then the tactic replaces the body expression with the new variable :n:`@ident` in the goal or as specified by :n:`@occurrences`. The tactic may succeed and add the local definition even if no replacements are made. The second form is equivalent to :n:`set (@ident := @one_term) {? @occurrences }` using :n:`@ident`, if present, or an auto-generated name if not provided. If :token:`term` or :token:`one_term` has holes (i.e. subexpressions with the form “`_`”), the tactic first checks that all subterms matching the pattern are compatible before doing the replacement using the leftmost subterm matching the pattern. .. exn:: The variable @ident is already declared. :undocumented: .. example:: set with a :n:`@simple_binder` :n:`set` does a simple syntactic replacement in the goal: .. coqtop:: reset none Goal forall n, n = 0. .. coqtop:: out intros. .. coqtop:: all pattern n. (* without this, "set" won't replace anything in the goal *) set (f x := x = 0). .. tacn:: eset @alias_definition {? @occurrences } eset @one_term {? @as_name } {? @occurrences } :name: eset; _ Similar to :tacn:`set`, but instead of failing because of uninstantiated variables, generates existential variables for them. In practice, this is relevant only when :tacn:`eset` is used as a synonym of :tacn:`epose`, i.e. when the :token:`term` does not occur in the goal. .. tacn:: remember @one_term {? @as_name } {? eqn : @naming_intropattern } {? in @goal_occurrences } Similar to :n:`set (@ident := @one_term) in *` but creates a hypothesis using :term:`Leibniz equality` to remember the relation between the introduced variable and the term rather than creating a :term:`local definition `. If :n:`@as_name` is not specified a fresh name is used. Use :n:`@naming_intropattern` to name the new equation. .. tacn:: eremember @one_term {? @as_name } {? eqn : @naming_intropattern } {? in @goal_occurrences } Similar to :tacn:`remember`, but instead of failing because of uninstantiated variables, generates existential variables for them. .. tacn:: pose @alias_definition pose @one_term {? @as_name } :name: pose; _ Similar to :tacn:`set`. Adds a :term:`local definition ` to the context but without doing any replacement. .. tacn:: epose @alias_definition epose @one_term {? @as_name } :name: epose; _ Similar to :tacn:`pose`, but instead of failing because of uninstantiated variables, generates existential variables for them. .. todo: the following title seems inappropriate. How about something more like "Introducing new hypotheses", as in adding arbitrary terms rather than transformations of existing terms?? But then I think the tactics in the previous section (set, remember, pose, maybe decompose) should be moved into this section. But maybe hard to make the section seem like an crisp, intuitive grouping. I can do the moving that after we've reviewed all the text. WDYT? See https://github.com/coq/coq/pull/16498#discussion_r989928078 .. _controllingtheproofflow: Controlling the proof flow ------------------------------ .. tacn:: assert ( @ident : @type ) {? by @ltac_expr3 } assert ( @ident := @term ) assert @one_type {? @as_ipat } {? by @ltac_expr3 } :name: assert; _; _ Adds a new hypothesis to the current subgoal and a new subgoal before it to prove the hypothesis. Then, if :n:`@ltac_expr3` is specified, it applies that tactic to fully prove the new subgoal (and otherwise fails). The first form adds a new hypothesis named :n:`@ident` of type :n:`@type`. (This corresponds to the cut rule of sequent calculus.) The second form is equivalent to :n:`assert (@ident : @type) by exact (@term)` where :n:`@type` is the type of :n:`@term`. It is also equivalent to using :tacn:`pose proof`. If the head of :n:`@term` is :n:`@ident`, the tactic is equivalent to :tacn:`specialize`. In the third form, if :n:`@as_ipat` isn't specified, the tactic adds the hypothesis :n:`@one_type` with a fresh name. Otherwise, it transforms the hypothesis as specified by :n:`@as_ipat` and adds the resulting new hypotheses and goals. See :ref:`intropatterns`. .. exn:: The term "@type" has type "@type__1" which should be Set, Prop or Type. Occurs when the argument :n:`@type` (in the first form) or :n:`@one_type` (in the third form) is not of type :g:`Prop`, :g:`Set` nor :g:`Type`. .. exn:: Proof is not complete. :name: Proof is not complete. (assert) :n:`@ltac_expr3` was not able to prove the new hypothesis. .. tacn:: eassert ( @ident : @type ) {? by @ltac_expr3 } eassert ( @ident := @term ) eassert @one_type {? @as_ipat } {? by @ltac_expr3 } :name: eassert; _; _ Unlike :tacn:`assert`, the :n:`@type`, :n:`@term` or :n:`@one_type` in :tacn:`eassert` may contain :gdef:`holes `, denoted by :n:`_`, for which the tactic will create existential variables. This lets you avoid specifying the asserted statement completely before starting to prove it. .. tacn:: enough ( @ident : @type ) {? by @ltac_expr3 } enough @one_type {? @as_ipat } {? by @ltac_expr3 } :name: enough; _ Adds a new hypothesis to the current subgoal and a new subgoal after it to prove the hypothesis. The first form adds a new hypothesis :n:`@ident : @type` and :n:`@type` as the new subgoal. Then, if :n:`@ltac_expr3` is specified, it applies that tactic to prove the current subgoal with the added hypothesis (and otherwise fails). In the second form, if :n:`@as_ipat` isn't specified, the tactic adds a new hypothesis :n:`@one_type` with a name chosen by Coq. Otherwise, it transforms :n:`@one_type` as specified by :n:`@as_ipat` and adds the resulting new hypotheses. The :n:`@as_ipat` may also expand the current subgoal into multiple subgoals. Then, if :n:`@ltac_expr3` is specified, it is applied to and must succeed on all of them. .. tacn:: eenough ( @ident : @type ) {? by @ltac_expr3 } eenough @one_type {? @as_ipat } {? by @ltac_expr3 } :name: eenough; _ Unlike :tacn:`enough`, the :n:`@type` and :n:`@one_type` in :tacn:`eenough` may contain :term:`holes `, denoted by :n:`_`, for which the tactic will create existential variables. This lets you avoid specifying the asserted statement completely until you start to use the hypothesis or later start to prove the statement. .. tacn:: cut @one_type Implements the non-dependent case of the :ref:`App ` typing rule, the Modus Ponens inference rule. It is equivalent to :n:`enough (@ident: @one_type). revert @ident.` This tactic is generally considered obsolete but it is still widely used in old scripts. .. tacn:: pose proof @term {? @as_ipat } pose proof ( @ident := @term ) :name: pose proof; _ The first form behaves like :n:`assert @one_type {? @as_ipat } by exact @term` where :token:`one_type` is the type of :token:`term`. .. Théo notes it's odd that the first form uses @term instead of @one_term The second form is equivalent to :n:`assert (@ident := @term)`. .. tacn:: epose proof @term {? @as_ipat } epose proof ( @ident := @term ) :name: epose proof; _ While :tacn:`pose proof` expects that no existential variables are generated by the tactic, :tacn:`epose proof` removes this constraint. .. tacn:: specialize @one_term_with_bindings {? @as_ipat } Specializes a term (typically a hypothesis or a lemma) by applying arguments to it. *First*, the tactic generates a modified term: If the :term:`head constant` of :n:`@one_term` (in :n:`@one_term_with_bindings`) has the type `forall ...`, the tactic replaces one or more of the quantified variables in the type with arguments provided by :n:`@one_term_with_bindings`, either in the form of a :ref:`function application ` (which may be partial), such as `(H 1)`, or with named or numbered binders, such as `H with (n:=1)`. If the :term:`head constant` has a :term:`non-dependent product` type such as `A -> B -> C`, the tactic eliminates one or more of the premises (doing :term:`forward reasoning`). Uninstantiated arguments are inferred by unification, if possible, or otherwise left quantified in the resulting term. *Then*, If the :term:`head constant` is a hypothesis :n:`H`, the resulting term replaces that hypothesis. Specifying :n:`@as_ipat` will leave the original hypothesis unchanged and will introduce new hypotheses as specified by the :token:`simple_intropattern`. If :n:`H` appears in the conclusion or another hypothesis, you must use :n:`@as_ipat` to give a fresh hypothesis name. If the head constant is a lemma or theorem, the resulting term is added as a new premise of the goal so that the behavior is similar to that of :tacn:`generalize`. In this case, you can use :n:`@as_ipat` to immediately introduce the modified term as one or more hypotheses. .. exn:: Cannot change @ident, it is used in hypothesis @ident. :undocumented: .. exn:: Cannot change @ident, it is used in conclusion. :undocumented: .. example:: partial application in :tacn:`specialize` .. coqtop:: reset none Goal (forall n m: nat, n + m = m + n) -> True. .. coqtop:: out intros. .. coqtop:: all specialize (H 1). (* equivalent to: specialize H with (n := 1) *) .. example:: :tacn:`specialize` with a non-dependent product Compare this to a similar :ref:`example ` that uses :tacn:`apply`. :tacn:`specialize` won't introduce new goals as :tacn:`apply` can. .. coqtop:: reset none Goal forall A B C: Prop, B -> (A -> B -> C) -> True. Proof. .. coqtop:: out intros A B C H0 H1. .. coqtop:: all specialize H1 with (2:=H0). .. tacn:: specialize_eqs @ident :undocumented: .. tacn:: generalize {+ @one_term } generalize {+, @pattern_occs {? @as_name } } :name: generalize; _ For each :n:`@one_term` (which may be in the :n:`@pattern_occs`), replaces the goal `G` with `forall (x:T), G'`, where :n:`@one_term` is a subterm of `G` of type `T` and `G'` is obtained by replacing all occurrences of :n:`@one_term` with `x` within `G`. `x` is a fresh variable chosen based on `T`. Specifying multiple :n:`@one_term`\s is equivalent to :n:`generalize @one_term__n; … ; generalize @one_term__1`. (Note they are processed *right to left*.) :n:`@as_name` The name to use for `x` instead of a fresh name. .. example:: .. coqtop:: reset none Goal forall x y:nat, 0 <= x + y + y. Proof. intros *. .. coqtop:: out Show. .. coqtop:: all abort generalize (x + y + y). (* get a simpler goal that can be proven by induction *) .. tacn:: generalize dependent @one_term Generalizes :n:`@one_term` and all hypotheses that depend on :n:`@one_term`. It clears the generalized hypotheses. .. tacn:: dependent generalize_eqs @ident :undocumented: .. tacn:: dependent generalize_eqs_vars @ident :undocumented: .. tacn:: generalize_eqs @ident :undocumented: .. tacn:: generalize_eqs_vars @ident :undocumented: .. tacn:: evar ( @ident : @type ) evar @one_type :name: evar; _ The :n:`evar` tactic creates a new :term:`local definition ` named :n:`@ident` with type :n:`@type` or :n:`@one_type` in the context. The body of this binding is a fresh existential variable. If the second form is used, Coq chooses the name. .. tacn:: instantiate ( @ident := @term ) instantiate ( @natural := @term ) {? @hloc } :name: instantiate; _ .. insertprodn hloc hloc .. prodn:: hloc ::= in %|- * | in @ident | in ( type of @ident ) | in ( value of @ident ) The first form refines (see :tacn:`refine`) an existential variable :n:`@ident` with the term :n:`@term`. It is equivalent to :n:`only [@ident]: refine @term`. .. note:: To be able to refer to an existential variable by name, the user 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 name the variable in the current goal and in the context of the existential variable. This can lead to surprising behaviors. The second form refines an existential variable selected by its position. The :n:`@natural` argument is the position of the existential variable *from right to left* in the goal. (Use the :n:`@hloc` clause to select an existential variable in a hypothesis.) Counting starts at 1 and multiple occurrences of the same existential variable are counted multiple times. Using this form is discouraged because slight changes to the goal may change the needed index, causing a maintenance issue. Advanced users may want to define and use an Ltac tactic to get more consistent behavior, such as: .. coqdoc:: Ltac instantiate_ltac_variable ev term := let H := fresh in pose ev as H; instantiate (1 := term) in (value of H); clear H. :n:`in @ident` Selects the hypothesis :n:`@ident`. :n:`in %|- *` Selects the goal. This is the default behavior. :n:`in ( type of @ident )` Selects existential variables in the type of the :term:`local definition ` :n:`@ident`. (The body is not included.) :n:`in ( value of @ident )` Selects existential variables in the body of the :term:`local definition ` :n:`@ident`. (The type is not included.) .. tacn:: absurd @one_type :n:`@one_type` is any proposition :g:`P` of type :g:`Prop`. This tactic applies False elimination, that is it deduces the current goal from False, and generates as subgoals :g:`∼P` and :g:`P`. It is very useful in proofs by cases, where some cases are impossible. In most cases, :g:`P` or :g:`∼P` is one of the hypotheses of the local context. .. tacn:: contradiction {? @one_term_with_bindings } Tries to prove the current goal by finding a contradiction. If :n:`@one_term_with_bindings` is not provided (the most common use case), the tactic first does an :tacn:`intros`. The tactic then proves the goal if - the updated context has a pair of hypotheses where one is the negation of the other (e.g. :n:`P` and not :n:`~P`), or - there is a hypothesis with an empty inductive type (e.g. :n:`False`), or - there is a hypothesis :n:`~P` where `P` is a singleton inductive type (e.g. :n:`True` or :n:`x=x`) provable by `Goal P. constructor.` If :n:`@one_term_with_bindings` is provided, its type must be a negation, such as :n:`~P`, or an empty inductive type, such as :n:`False`. If the type is a negation and :n:`P` is a hypothesis in the context, the goal is proven. If the type is a negation and :n:`P` is not in the context, the goal is replaced with :n:`P`. If the type is :n:`False` or another empty inductive type, the goal is proven. Otherwise the tactic fails. (If there is a hypothesis `P` and you want to replace the goal with `~P`, use the :tacn:`contradict` tactic. If there are hypotheses `H1 : P` and `H2 : ~P`, use `contradiction` without arguments or `contradiction H2` since `contradiction H1` won't work.) Use the :tacn:`discriminate` tactic to prove the current goal when there is a hypothesis with an impossible structural equality such as :n:`0 = 1`. .. example:: :tacn:`contradiction` tactic Simple examples. To see more detail, add `intros` after each `Goal`. .. coqtop:: reset in Inductive F :=. (* Another empty inductive type *) Goal F -> False. contradiction. Qed. Goal forall (A : Prop), A -> ~A -> False. contradiction. Qed. Goal forall (A : Type) (x : A), ~(x = x) -> False. contradiction. Qed. Apply a fact from the standard library: .. coqtop:: in Require Import Arith. Goal forall (A : Prop), 0 < 0 -> A. .. coqtop:: all intros. contradiction (Nat.lt_irrefl 0). Qed. .. tacn:: contradict @ident Transforms the specified hypothesis :n:`@ident` and the goal in order to prove that the hypothesis is false. For :n:`contradict H`, the current goal and context are transformed as shown. (For brevity, `⊢` is used to separate hypotheses from the goal; it is equivalent to the dividing line shown in a context.): + `H: ~A ⊢ B` becomes `⊢ A` + `H: ~A ⊢ ~B` becomes `H: B ⊢ A` + `H: A ⊢ B` becomes `⊢ ~A` + `H: A ⊢ ~B` becomes `H: B ⊢ ~A` .. tacn:: exfalso Implements the “ex falso quodlibet” logical principle: an elimination of False is performed on the current goal, and the user is then required to prove that False is indeed provable in the current context. Classical tactics ----------------- In order to ease the proving process, when the ``Classical`` module is loaded, a few more tactics are available. Make sure to load the module using the :cmd:`Require Import` command. .. tacn:: classical_left classical_right These tactics are the analog of :tacn:`left` and :tacn:`right` but using classical logic. They can only be used for disjunctions. Use :tacn:`classical_left` to prove the left part of the disjunction with the assumption that the negation of right part holds. Use :tacn:`classical_right` to prove the right part of the disjunction with the assumption that the negation of left part holds. Performance-oriented tactic variants ------------------------------------ .. todo: move the following adjacent to the `exact` tactic? .. tacn:: exact_no_check @one_term For advanced usage. Similar to :tacn:`exact` :n:`@term`, but as an optimization, it skips checking that :n:`@term` has the goal's type, relying on the kernel check instead. See :tacn:`change_no_check` for more explanation. .. example:: .. coqtop:: all abort Goal False. exact_no_check I. Fail Qed. .. tacn:: vm_cast_no_check @one_term For advanced usage. Similar to :tacn:`exact_no_check` :n:`@term`, but additionally instructs the kernel to use :tacn:`vm_compute` to compare the goal's type with the :n:`@term`'s type. .. example:: .. coqtop:: all abort Goal False. vm_cast_no_check I. Fail Qed. .. tacn:: native_cast_no_check @one_term for advanced usage. similar to :tacn:`exact_no_check` :n:`@term`, but additionally instructs the kernel to use :tacn:`native_compute` to compare the goal's type with the :n:`@term`'s type. .. example:: .. coqtop:: all abort Goal False. native_cast_no_check I. Fail Qed. coq-8.20.0/doc/sphinx/proof-engine/vernacular-commands.rst000066400000000000000000001303321466560755400235500ustar00rootroot00000000000000.. _vernacularcommands: Commands ======== .. _displaying: Displaying ---------- .. _Print: .. cmd:: Print {? Term } @reference {? @univ_name_list } .. insertprodn univ_name_list univ_name_list .. prodn:: univ_name_list ::= @%{ {* @name } %} Displays definitions of terms, including opaque terms, for the object :n:`@reference`. * :n:`Term` - a syntactic marker to allow printing a term that is the same as one of the various :n:`Print` commands. For example, :cmd:`Print All` is a different command, while :n:`Print Term All` shows information on the object whose name is ":n:`All`". * :n:`@univ_name_list` - locally renames the polymorphic universes of :n:`@reference`. The name `_` means the usual name is printed. .. exn:: @qualid not a defined object. :undocumented: .. exn:: Universe instance length is @natural but should be @natural. :undocumented: .. exn:: This object does not support universe names. :undocumented: .. cmd:: Print All This command displays information about the current state of the environment, including sections and modules. .. cmd:: Inspect @natural This command displays the :n:`@natural` last objects of the current environment, including sections and modules. .. cmd:: Print Section @qualid Displays the objects defined since the beginning of the section named :n:`@qualid`. .. todo: "A.B" is permitted but unnecessary for modules/sections. should the command just take an @ident? Query commands -------------- Unlike other commands, :production:`query_command`\s may be prefixed with a goal selector (:n:`@natural:`) to specify which goals it applies to. If no selector is provided, the command applies to the current goal. If no proof is open, then the command only applies to accessible objects. (see Section :ref:`invocation-of-tactics`). :cmd:`Eval` and :cmd:`Compute` are also :token:`query_command`\s, which are described elsewhere .. cmd:: About @reference {? @univ_name_list } Displays information about the :n:`@reference` object, which, if a proof is open, may be a hypothesis of the selected goal, or an accessible theorem, axiom, etc.: its kind (module, constant, assumption, inductive, constructor, abbreviation, …), long name, type, implicit arguments and argument scopes (as set in the definition of :token:`reference` or subsequently with the :cmd:`Arguments` command). It does not print the body of definitions or proofs. .. cmd:: Check @term Displays the type of :n:`@term`. When called in proof mode, the term is checked in the local context of the selected goal (possibly by using :ref:`single numbered goal selectors`). This command tries to resolve existential variables as much as possible. .. cmd:: Type @term Displays the type of :n:`@term`, same as :cmd:`Check`, but will fail if any existential variables are unable to be resolved. .. cmd:: Search {+ @search_query } {? {| inside | in | outside } {+ @qualid } } This command can be used to filter the goal and the global context to retrieve objects whose name or type satisfies a number of conditions. Library files that were not loaded with :cmd:`Require` are not considered. The :table:`Search Blacklist` table can also be used to exclude some things from all calls to :cmd:`Search`. The output of the command is a list of qualified identifiers and their types. If the :flag:`Search Output Name Only` flag is on, the types are omitted. .. insertprodn search_query search_query .. prodn:: search_query ::= @search_item | - @search_query | [ {+| {+ @search_query } } ] Multiple :n:`@search_item`\s can be combined into a complex :n:`@search_query`: :n:`- @search_query` Excludes the objects that would be filtered by :n:`@search_query`. See :ref:`this example `. :n:`[ {+ @search_query } | ... | {+ @search_query } ]` This is a disjunction of conjunctions of queries. A simple conjunction can be expressed by having a single disjunctive branch. For a conjunction at top-level, the surrounding brackets are not required. .. insertprodn search_item search_item .. prodn:: search_item ::= {? {| head | hyp | concl | headhyp | headconcl } : } @string {? % @scope_key } | {? {| head | hyp | concl | headhyp | headconcl } : } @one_pattern | is : @logical_kind Searched objects can be filtered by patterns, by the constants they contain (identified by their name or a notation) and by their names. The location of the pattern or constant within a term :n:`@one_pattern` Search for objects whose type contains a subterm matching the pattern :n:`@one_pattern`. Holes of the pattern are indicated by `_` or :n:`?@ident`. If the same :n:`?@ident` occurs more than once in the pattern, all occurrences in the subterm must be identical. See :ref:`this example `. :n:`@string {? % @scope_key }` - If :n:`@string` is a substring of a valid identifier and no :n:`% @scope_key` is provided, search for objects whose name contains :n:`@string`. See :ref:`this example `. - Otherwise, search for objects whose type contains the reference that this string, interpreted as a notation, is attached to (as described in :n:`@reference`). See :ref:`this example `. .. note:: To refer to a string used in a notation that is a substring of a valid identifier, put it between single quotes or explicitly provide a scope. See :ref:`this example `. :n:`hyp:` The provided pattern or reference is matched against any subterm of an hypothesis of the type of the objects. See :ref:`this example `. :n:`headhyp:` The provided pattern or reference is matched against the subterms in head position (any partial applicative subterm) of the hypotheses of the type of the objects. See :ref:`the previous example `. :n:`concl:` The provided pattern or reference is matched against any subterm of the conclusion of the type of the objects. See :ref:`this example `. :n:`headconcl:` The provided pattern or reference is matched against the subterms in head position (any partial applicative subterm) of the conclusion of the type of the objects. See :ref:`the previous example `. :n:`head:` This is simply the union between `headconcl:` and `headhyp:`. :n:`is: @logical_kind` .. insertprodn logical_kind logical_kind .. prodn:: logical_kind ::= {| @thm_token | @assumption_token } | {| Definition | Example | Context | Primitive | Symbol } | {| Coercion | Instance | Scheme | Canonical | SubClass } | {| Fixpoint | CoFixpoint | Field | Method } Filters objects by the keyword that was used to define them (`Theorem`, `Lemma`, `Axiom`, `Variable`, `Context`, `Primitive`...) or its status (`Coercion`, `Instance`, `Scheme`, `Canonical`, `SubClass`, `Field` for record fields, `Method` for class fields). Note that `Coercion`\s, `Canonical Structure`\s, `Instance`\s and `Scheme`\s can be defined without using those keywords. See :ref:`this example `. Additional clauses: * :n:`{| inside | in } {+ @qualid }` - limit the search to the specified modules * :n:`outside {+ @qualid }` - exclude the specified modules from the search .. exn:: Module/section @qualid not found. There is no constant in the environment named :n:`@qualid`, where :n:`@qualid` is in an `inside` or `outside` clause. .. _search-pattern: .. example:: Searching for a pattern .. coqtop:: none reset Require Import PeanoNat. We can repeat meta-variables to narrow down the search. Here, we are looking for commutativity lemmas. .. coqtop:: all Search (_ ?n ?m = _ ?m ?n). .. _search-part-ident: .. example:: Searching for part of an identifier .. coqtop:: all reset Search "_assoc". .. _search-by-notation: .. example:: Searching for a reference by notation .. coqtop:: all reset Search "+". .. _search-disambiguate-notation: .. example:: Disambiguating between part of identifier and notation .. coqtop:: none reset Require Import PeanoNat. In this example, we show two ways of searching for all the objects whose type contains `Nat.modulo` but which do not contain the substring "mod". .. coqtop:: all Search "'mod'" -"mod". Search "mod"%nat -"mod". .. _search-hyp: .. example:: Search in hypotheses The following search shows the objects whose type contains `bool` in an hypothesis as a strict subterm only: .. coqtop:: none reset Add Search Blacklist "internal_". .. coqtop:: all Search hyp:bool -headhyp:bool. .. _search-concl: .. example:: Search in conclusion The following search shows the objects whose type contains `bool` in the conclusion as a strict subterm only: .. coqtop:: all Search concl:bool -headconcl:bool. .. _search-by-keyword: .. example:: Search by keyword or status The following search shows the definitions whose type is a `nat` or a function which returns a `nat` and the lemmas about `+`: .. coqtop:: all reset Search [ is:Definition headconcl:nat | is:Lemma (_ + _) ]. The following search shows the instances whose type includes the classes `Reflexive` or `Symmetric`: .. coqtop:: none reset Require Import Morphisms. .. coqtop:: all Search is:Instance [ Reflexive | Symmetric ]. The following search outputs operations on `nat` defined in the prelude either with the `Definition` or `Fixpoint` keyword: .. coqtop:: all reset Search (nat -> nat -> nat) -bool [ is:Definition | is:Fixpoint ]. .. cmd:: SearchPattern @one_pattern {? {| inside | in | outside } {+ @qualid } } Displays the name and type of all hypotheses of the selected goal (if any) and theorems of the current context ending with :n:`{? forall {* @binder }, } {* P__i -> } C` that match the pattern :n:`@one_pattern`. See :cmd:`Search` for an explanation of the `inside`/`in`/`outside` clauses. .. example:: :cmd:`SearchPattern` examples .. coqtop:: in Require Import Arith. .. coqtop:: all SearchPattern (_ + _ = _ + _). SearchPattern (nat -> bool). SearchPattern (forall l : list _, _ l l). .. coqtop:: all SearchPattern (?X1 + _ = _ + ?X1). .. cmd:: SearchRewrite @one_pattern {? {| inside | in | outside } {+ @qualid } } Displays the name and type of all hypotheses of the selected goal (if any) and theorems of the current context that have the form :n:`{? forall {* @binder }, } {* P__i -> } LHS = RHS` where :n:`@one_pattern` matches either `LHS` or `RHS`. See :cmd:`Search` for an explanation of the `inside`/`in`/`outside` clauses. .. example:: :cmd:`SearchRewrite` examples .. coqtop:: in Require Import Arith. .. coqtop:: all SearchRewrite (_ + _ + _). .. table:: Search Blacklist @string This :term:`table` specifies a set of strings used to exclude lemmas from the results of :cmd:`Search`, :cmd:`SearchPattern` and :cmd:`SearchRewrite` queries. A lemma whose fully qualified name contains any of the strings will be excluded from the search results. The default blacklisted substrings are ``_subterm``, ``_subproof`` and ``Private_``. Use the :cmd:`Add` and :cmd:`Remove` commands to update the set of blacklisted strings. .. flag:: Search Output Name Only This :term:`flag` restricts the output of search commands to identifier names; turning it on causes invocations of :cmd:`Search`, :cmd:`SearchPattern`, :cmd:`SearchRewrite` etc. to omit types from their output, printing only identifiers. .. _requests-to-the-environment: Requests to the environment ------------------------------- .. cmd:: Print Assumptions @reference Displays all the assumptions (axioms, parameters and variables) a theorem or definition depends on. The message "Closed under the global context" indicates that the theorem or definition has no dependencies. .. cmd:: Print Opaque Dependencies @reference Displays the assumptions and opaque constants that :n:`@reference` depends on. .. cmd:: Print Transparent Dependencies @reference Displays the assumptions and transparent constants that :n:`@reference` depends on. .. cmd:: Print All Dependencies @reference Displays all the assumptions and constants :n:`@reference` depends on. .. cmd:: Locate @reference .. insertprodn reference reference .. prodn:: reference ::= @qualid | @string {? % @scope_key } Displays the full name of objects from Coq's various qualified namespaces such as terms, modules and Ltac, thereby showing the module they are defined in. It also displays notation definitions. Note that objects are reported only when the module containing them has been loaded, such as through a :cmd:`Require` command. Notation definitions are reported only when the containing module has been imported (e.g. with :cmd:`Require Import` or :cmd:`Import`). Objects defined with commands such as :cmd:`Definition`, :cmd:`Parameter`, :cmd:`Record`, :cmd:`Theorem` and their numerous variants are shown as `Constant` in the output. :n:`@qualid` refers to object names that end with :n:`@qualid`. :n:`@string {? % @scope_key }` refers to definitions of notations. :n:`@string` can be a single token in the notation such as "`->`" or a pattern that matches the notation. See :ref:`locating-notations`. :n:`% @scope_key`, if present, limits the reference to the scope bound to the delimiting key :n:`@scope_key`, such as, for example, :n:`%nat`. (see Section :ref:`LocalInterpretationRulesForNotations`) .. todo somewhere we should list all the qualified namespaces .. cmd:: Locate Term @reference Like :cmd:`Locate`, but limits the search to terms .. cmd:: Locate Module @qualid Like :cmd:`Locate`, but limits the search to modules .. cmd:: Locate Ltac @qualid Like :cmd:`Locate`, but limits the search to Ltac tactics .. cmd:: Locate Ltac2 @qualid Like :cmd:`Locate`, but limits the search to Ltac2 tactics. .. cmd:: Locate Library @qualid Displays the full name, status and file system path of the module :n:`@qualid`, whether loaded or not. .. cmd:: Locate File @string Displays the file system path of the file ending with :n:`@string`. Typically, :n:`@string` has a suffix such as ``.cmo`` or ``.vo`` or ``.v`` file, such as :n:`Nat.v`. .. todo: also works for directory names such as "Data" (parent of Nat.v) also "Data/Nat.v" works, but not a substring match .. example:: Locate examples .. coqtop:: all Locate nat. Locate Datatypes.O. Locate Init.Datatypes.O. Locate Coq.Init.Datatypes.O. Locate I.Dont.Exist. .. _printing-flags: Printing flags ------------------------------- .. flag:: Fast Name Printing When this :term:`flag` is turned on, Coq uses an asymptotically faster algorithm for the generation of unambiguous names of bound variables while printing terms. While faster, it is also less clever and results in a typically less elegant display, e.g. it will generate more names rather than reusing certain names across subterms. This flag is not enabled by default, because as Ltac observes bound names, turning it on can break existing proof scripts. .. _loading-files: Loading files ----------------- Coq offers the possibility of loading different parts of a whole development stored in separate files. Their contents will be loaded as if they were entered from the keyboard. This means that the loaded files are text files containing sequences of commands for Coq’s toplevel. This kind of file is called a *script* for Coq. The standard (and default) extension of Coq’s script files is .v. .. cmd:: Load {? Verbose } {| @string | @ident } Loads a file. If :n:`@ident` is specified, the command loads a file named :n:`@ident.v`, searching successively in each of the directories specified in the :term:`load path`. (see Section :ref:`logical-paths-load-path`) If :n:`@string` is specified, it must specify a complete filename. `~` and .. abbreviations are allowed as well as shell variables. If no extension is specified, Coq will use the default extension ``.v``. Files loaded this way can't leave proofs open, nor can :cmd:`Load` be used inside a proof. We discourage the use of :cmd:`Load`; use :cmd:`Require` instead. :cmd:`Require` loads `.vo` files that were previously compiled from `.v` files. :n:`Verbose` displays the Coq output for each command and tactic in the loaded file, as if the commands and tactics were entered interactively. .. exn:: Can’t find file @ident on loadpath. :undocumented: .. exn:: Load is not supported inside proofs. :undocumented: .. exn:: Files processed by Load cannot leave open proofs. :undocumented: .. _compiled-files: Compiled files ------------------ This section describes the commands used to load compiled files (see Chapter :ref:`thecoqcommands` for documentation on how to compile a file). A compiled file is a particular case of a module called a *library file*. .. cmd:: {? From @dirpath } Require {? {| Import | Export } {? @import_categories } } {+ @filtered_import } :name: From … Require; Require; Require Import; Require Export .. insertprodn dirpath dirpath .. prodn:: dirpath ::= {* @ident . } @ident Loads compiled files into the Coq environment. For the first :n:`@qualid` in each :n:`@filtered_import`, the command looks in the :term:`load path` for a compiled file :n:`@ident.vo` whose :term:`logical name` has the form :n:`@dirpath.{* @ident__implicit. }@qualid` (if :n:`From @dirpath` is given) or :n:`{* @ident__implicit. }@qualid` (if the optional `From` clause is absent). :n:`{* @ident__implicit. }` represents the parts of the fully qualified name that are implicit. For example, `From Coq Require Nat` loads `Coq.Init.Nat` and `Init` is implicit. :n:`@ident` is the final component of the :n:`@qualid`. If a file is found, its logical name must be the same as the one used to compile the file. Then the file is loaded as well as all the files it depends on (recursively). All the files must have been compiled with the same version of Coq. * :n:`Import` - additionally does an :cmd:`Import` on the loaded module, making components defined in the module available by their short names * :n:`Export` - additionally does an :cmd:`Export` on the loaded module, making components defined in the module available by their short names *and* marking them to be exported by the current module If the required file has already been loaded, it is not reloaded. If :n:`Import` or :n:`Export` are present, the command also does the equivalent of the :cmd:`Import` or :cmd:`Export` commands. A single file can be loaded with several variations of the `Require` command. For example, the ``-Q path Lib`` command line parameter associates the file ``path/Foo/File.vo`` with the logical name ``Lib.Foo.File``. It allows this file to be loaded through :n:`Require Lib.Foo.File`, :n:`From Lib Require Foo.File`, :n:`From Lib Require File` or :n:`From Lib.Foo Require File`. The `-R path Lib` command line parameter allows loading the file with the additional alternatives :n:`Require Foo.File` and :n:`Require File` In particular, `From` is useful to ensure that the file comes from a particular package or subpackage. Use of `-Q` is better for avoiding ambiguous path names. Exact matches are preferred when looking for a file with the logical name :n:`@dirpath.{* @ident__implicit. }@qualid` or :n:`{* @ident__implicit. }@qualid` (that is, matches where the implicit part is empty). If the name exactly matches in multiple `-R` or `-Q` options, the file corresponding to the last `-R` or `-Q` specified is used. (In :cmd:`Print LoadPath`, that's the first match from the top.) If there is no exact match, the matches from the last `-R` or `-Q` are selected. If this results in a unique match, the corresponding file is selected. If this results in several matches, it is an error. The difference between the `-R` and the `-Q` option is that non-exact matches are allowed for `-Q` only if `From` is present. Matching is done when the script is compiled or processed rather than when its .vo file is loaded. .vo files use fully-qualified names. We recommend you use `-R` only to refer to files in the same package. Use `-Q` (if necessary) to refer to files in a different package. .. exn:: Cannot load @qualid: no physical path bound to @dirpath. :undocumented: .. exn:: Cannot find library foo in loadpath. The command did not find the file foo.vo. Either foo.v exists but is not compiled or foo.vo is in a directory which is not in your :term:`load path`. .. exn:: Required library @qualid matches several files in path (found file__1.vo, file__2.vo, ...). The file to load must be required with a more discriminating suffix, or, at worst, with its full logical name. .. exn:: Compiled library @ident.vo makes inconsistent assumptions over library @qualid. The command tried to load library file :n:`@ident`.vo that depends on some specific version of library :n:`@qualid` which is not the one already loaded in the current Coq session. Probably :n:`@ident.v` was not properly recompiled with the last version of the file containing module :token:`qualid`. .. exn:: Bad magic number. The file :n:`@ident.vo` was found but either it is not a Coq compiled module, or it was compiled with an incompatible version of Coq. .. exn:: The file @ident.vo contains library @qualid__1 and not library @qualid__2. The library :n:`@qualid__2` is indirectly required by a :cmd:`Require`. The :term:`load path` maps :n:`@qualid__2` to :n:`@ident.vo`, which was compiled using a load path that bound it to :n:`@qualid__1`. Usually the appropriate solution is to recompile :n:`@ident.v` using the correct :term:`load path`. .. warn:: Require inside a module is deprecated and strongly discouraged. You can Require a module at toplevel and optionally Import it inside another one. Note that the :cmd:`Import` and :cmd:`Export` commands can be used inside modules. .. seealso:: Chapter :ref:`thecoqcommands` .. cmd:: Print Libraries This command displays the list of library files loaded in the current Coq session. .. cmd:: Declare ML Module {+ @string } Loads an OCaml plugin and its dependencies dynamically. The :n:`@string` argument must be a valid `findlib `_ plugin name, for example ``coq-core.plugins.ltac``. As of Coq 8.16, the command also supports a legacy syntax compatible with the plugin loading system used in Coq 8.0-8.15, see below. The first component of the plugin name is a package name that has to be in scope of ``findlib``'s' search path. One can see the paths explored by ``findlib`` by running ``ocamlfind printconf`` and get the list of available libraries by running ``ocamlfind list | grep coq`` (Coq libraries are typically named ``coq-something``). This command is reserved for plugin developers, who should provide a ``.v`` file containing the command. Users of the plugin will usually require the resulting ``.vo`` file which will then transitively load the required plugin. If you are writing a plugin, you thus need to generate the right metadata so ``findlib`` can locate your plugin. This usually involves generating some kind of ``META`` file and placing it in a place where ``findlib`` can see it. Different build systems provide different helpers to do this: see :ref:`here for coq_makefile `, and :ref:`here for Dune `. Note that the plugin loading system for Coq changed in 8.16 to use findlib. Previous Coq versions loaded OCaml dynamic objects by first locating the object file from ``-I`` directives, then directly invoking ``Dynlink.loadfile``. For compatibility purposes, 8.16 still supports this legacy method, with the syntax being ``Declare ML Module "my_package_plugin:pkg.plugin.my-package".``, where ``my_package_plugin`` is the name of the OCaml object file. This is useful if you are still using a third party build system such as Dune or your own. This command supports the :attr:`local` attribute. If present, the listed files are not exported, even if they're outside a section. .. exn:: File not found on loadpath: @string. ``findlib`` is not able to find the plugin name. Possible reasons are: * The plugin does not exist or is misspelled. You can get the list of available libraries by running ``ocamlfind list | grep coq``. * The metadata for ``findlib`` has not been set properly (see above). .. exn:: Dynlink error: execution of module initializers in the shared library failed: Coq Error: @string is not a valid plugin name anymore. Plugins should be loaded using their public name according to findlib, for example package-name.foo and not foo_plugin. The plugin declaration in some ``.mlg`` file does not match the ``findlib`` plugin name. In the example of ``coq-core.plugins.ltac``, one has to write ``DECLARE PLUGIN "coq-core.plugins.ltac"``. .. cmd:: Print ML Modules Print the name of all findlib libraries loaded with :cmd:`Declare ML Module`. Load paths ---------- .. versionchanged:: 8.18 Commands to manage :term:`load paths ` within Coq have been removed. Load paths can be managed using Coq command line options or enviroment variables (see :ref:`logical-paths-load-path`). .. cmd:: Print LoadPath {? @dirpath } Displays the current Coq :term:`load path`. If :n:`@dirpath` is specified, displays only the paths that extend that prefix. In the output, the logical path `<>` represents an empty logical path. .. cmd:: Print ML Path Displays the current OCaml loadpath, as provided by the :ref:`command line option ` :n:`-I @string` (cf. :cmd:`Declare ML Module`). .. _extra_dependencies: Extra Dependencies ------------------ Dependencies on external files, i.e. non ``.v`` files, can be declared as follows: .. cmd:: From @dirpath Extra Dependency @string {? as @ident } :name: From … Dependency Adds an additional dependency of the current `.v` file on an external file. This information is included in the ``coqdep`` tool generated list of dependencies. The file name :n:`@string` must exist relative to one of the top directories associated with :n:`@dirpath`. :n:`@string` can include directory separators (``/``) to select a file in a subdirectory. Path elements in :n:`@string` must be valid Coq identifiers, e.g. they cannot contain characters such as ``-`` or ``,``. See :ref:`lexical-conventions`. When :n:`@ident` is provided, that name can be used by OCaml code, typically in a plugin, to access the full path of the external file via the API ``ComExtraDeps.query_extra_dep``. .. warn:: File ... found twice in ... The file is found in more than once in the top directories associated with the given :n:`@dirpath`. In this case the first occurrence is selected. .. _backtracking_subsection: Backtracking ------------ The backtracking commands described in this section can only be used interactively, they cannot be part of a Coq file loaded via ``Load`` or compiled by ``coqc``. .. cmd:: Reset @ident This command removes all the objects in the environment since :n:`@ident` was introduced, including :n:`@ident`. :n:`@ident` may be the name of a defined or declared object as well as the name of a section. One cannot reset over the name of a module or of an object inside a module. .. cmd:: Reset Initial Goes back to the initial state, just after the start of the interactive session. .. cmd:: Back {? @natural } Undoes all the effects of the last :n:`@natural @sentence`\s. If :n:`@natural` is not specified, the command undoes one sentence. Sentences read from a `.v` file via a :cmd:`Load` are considered a single sentence. While :cmd:`Back` can undo tactics and commands executed within proof mode, once you exit proof mode, such as with :cmd:`Qed`, all the statements executed within are thereafter considered a single sentence. :cmd:`Back` immediately following :cmd:`Qed` gets you back to the state just after the statement of the proof. .. exn:: Invalid backtrack. The user wants to undo more commands than available in the history. .. cmd:: BackTo @natural This command brings back the system to the state labeled :n:`@natural`, forgetting the effect of all commands executed after this state. The state label is an integer which grows after each successful command. It is displayed in the prompt when in -emacs mode. Just as :cmd:`Back` (see above), the :cmd:`BackTo` command now handles proof states. For that, it may have to undo some extra commands and end on a state :n:`@natural′ ≤ @natural` if necessary. .. _quitting-and-debugging: Quitting and debugging -------------------------- .. cmd:: Quit Causes Coq to exit. Valid only in coqtop. .. cmd:: Drop 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: :: #use "include";; adds the right loadpaths and loads some toplevel printers for all abstract types of Coq- section_path, identifiers, terms, judgments, …. You can also use the file base_include instead, that loads only the pretty-printers for section_paths and identifiers. You can return back to Coq with the command: :: go();; .. warning:: #. It only works with the bytecode version of Coq (i.e. `coqtop.byte`, see Section `interactive-use`). #. You must have compiled Coq from the source package and set the environment variable COQTOP to the root of your copy of the sources (see Section `customization-by-environment-variables`). .. cmd:: Time @sentence Executes :n:`@sentence` and displays the time needed to execute it. .. cmd:: Instructions @sentence Executes :n:`@sentence` and displays the number of CPU instructions needed to execute it. This command is currently only supported on Linux systems, but does not fail on unsupported sustems, where it instead prints an error message in the place of the instruction count. .. cmd:: Redirect @string @sentence Executes :n:`@sentence`, redirecting its output to the file ":n:`@string`.out". If :n:`@string` is a relative filename, it refers to the directory specified by the command line option `-output-directory`, if set (see :ref:`command-line-options`) and otherwise, the current directory. Use :cmd:`Pwd` to display the current directory. .. cmd:: Timeout @natural @sentence Executes :n:`@sentence`. If the operation has not terminated after :n:`@natural` seconds, then it is interrupted and an error message is displayed. .. opt:: Default Timeout @natural When this :term:`option` is set, each :n:`@sentence` is treated as if it was prefixed with :cmd:`Timeout` :n:`@natural`, except for :cmd:`Timeout` commands themselves. If unset, no timeout is applied. .. cmd:: Fail @sentence For debugging scripts, sometimes it is desirable to know whether a command or a tactic fails. If :n:`@sentence` fails, then :n:`Fail @sentence` succeeds (except for anomalies or for critical failures such as "stack overflow"), without changing the proof state. In interactive mode, the system prints a message confirming the failure. .. exn:: The command has not failed! If the given :n:`@command` succeeds, then :n:`Fail @sentence` fails with this error message. .. cmd:: Succeed @sentence If :n:`@sentence` succeeds, then :n:`Succeed @sentence` succeeds without changing the proof state. If :n:`@sentence` fails, then :n:`Succeed @sentence` fails showing the error message for :n:`@sentence`. In interactive mode, the system prints the message :n:`The command has succeeded and its effects have been reverted.` confirming the success. This command can be useful for writing tests. .. note:: :cmd:`Time`, :cmd:`Redirect`, :cmd:`Timeout`, :cmd:`Fail` and :cmd:`Succeed` are :production:`control_command`\s. For these commands, attributes and goal selectors, when specified, are part of the :n:`@sentence` argument, and thus come after the control command prefix and before the inner command or tactic. For example: `Time #[ local ] Definition foo := 0.` or `Fail Timeout 10 all: auto.` .. _controlling-display: Controlling display ----------------------- .. flag:: Silent This :term:`flag` controls the normal displaying. .. opt:: Warnings "{+, {? {| - | + } } @ident }" This :term:`option` configures the display of warnings. The :n:`@ident`\s are warning or category names. Adding `-` in front of a warning or category disables it, adding `+` makes it an error. Warning name and categories are printed between brackets when the warning is displayed (the warning name appears first). Warnings can belong to multiple categories. The special category `all` contains all warnings, and the special category `default` contains the warnings enabled by default. Coq defines a set of core warning categories, which may be extended by plugins, so this list is not exhaustive. The core categories are: `automation`, `bytecode-compiler`, `coercions`, `deprecated`, `extraction`, `filesystem`, `fixpoints`, `fragile`, `funind`, `implicits`, `ltac`, `ltac2`, `native-compiler`, `numbers`, `parsing`, `pedantic`, `records`, `ssr`, `syntax`, `tactics`, `user-warn`, `vernacular`. .. This list is from lib/cWarnings.ml The flags are interpreted from left to right, so in case of an overlap, the flags on the right have higher priority, meaning that `A,-A` is equivalent to `-A`. See also the :attr:`warnings` attribute, which can be used to configure the display of warnings for a single command. .. opt:: Debug "{+, {? - } @ident }" This :term:`option` configures the display of debug messages. Each :n:`@ident` enables debug messages for that component, while :n:`-@ident` disables messages for the component. ``all`` activates or deactivates all other components. ``backtrace`` controls printing of error backtraces. :cmd:`Test` `Debug` displays the list of components and their enabled/disabled state. .. opt:: Printing Width @natural This :term:`option` sets which left-aligned part of the width of the screen is used for display. At the time of writing this documentation, the default value is 78. .. opt:: Printing Depth @natural This :term:`option` controls the nesting depth of the formatter used for pretty- printing. Beyond this depth, display of subterms is replaced by dots. At the time of writing this documentation, the default value is 50. .. flag:: Printing Compact Contexts This :term:`flag` controls the compact display mode for goals contexts. When on, the printer tries to reduce the vertical size of goals contexts by putting several variables (even if of different types) on the same line provided it does not exceed the printing width (see :opt:`Printing Width`). At the time of writing this documentation, it is off by default. .. flag:: Printing Unfocused This :term:`flag` controls whether unfocused goals are displayed. Such goals are created by focusing other goals with :ref:`bullets ` or :ref:`curly braces `. It is off by default. .. flag:: Printing Dependent Evars Line This :term:`flag` controls the printing of the “(dependent evars: …)” information after each tactic. The information is used by the Prooftree tool in Proof General. (https://askra.de/software/prooftree) .. extracted from Gallina extensions chapter .. _printing_constructions_full: Printing constructions in full ------------------------------ .. flag:: Printing All Coercions, implicit arguments, the type of pattern matching, but also notations (see :ref:`syntax-extensions-and-notation-scopes`) can obfuscate the behavior of some tactics (typically the tactics applying to occurrences of subterms are sensitive to the implicit arguments). Turning this :term:`flag` on deactivates all high-level printing features such as coercions, implicit arguments, returned type of pattern matching, notations and various syntactic sugar for pattern matching or record projections. Otherwise said, :flag:`Printing All` includes the effects of the flags :flag:`Printing Implicit`, :flag:`Printing Coercions`, :flag:`Printing Synth`, :flag:`Printing Projections`, and :flag:`Printing Notations`. To reactivate the high-level printing features, use the command ``Unset Printing All``. .. note:: In some cases, setting :flag:`Printing All` may display terms that are so big they become very hard to read. One technique to work around this is use :cmd:`Undelimit Scope` and/or :cmd:`Close Scope` to turn off the printing of notations bound to particular scope(s). This can be useful when notations in a given scope are getting in the way of understanding a goal, but turning off all notations with :flag:`Printing All` would make the goal unreadable. .. see a contrived example here: https://github.com/coq/coq/pull/11718#discussion_r415481854 .. _controlling-typing-flags: Controlling Typing Flags ---------------------------- .. flag:: Guard Checking This :term:`flag` can be used to enable/disable the guard checking of fixpoints. Warning: this can break the consistency of the system, use at your own risk. Decreasing argument can still be specified: the decrease is not checked anymore but it still affects the reduction of the term. Unchecked fixpoints are printed by :cmd:`Print Assumptions`. .. attr:: bypass_check(guard{? = {| yes | no } }) :name: bypass_check(guard) This :term:`boolean attribute` is similar to the :flag:`Guard Checking` flag, but on a per-declaration basis. Disable guard checking locally with ``bypass_check(guard)``. .. flag:: Positivity Checking This :term:`flag` can be used to enable/disable the positivity checking of inductive types and the productivity checking of coinductive types. Warning: this can break the consistency of the system, use at your own risk. Unchecked (co)inductive types are printed by :cmd:`Print Assumptions`. .. attr:: bypass_check(positivity{? = {| yes | no } }) :name: bypass_check(positivity) This :term:`boolean attribute` is similar to the :flag:`Positivity Checking` flag, but on a per-declaration basis. Disable positivity checking locally with ``bypass_check(positivity)``. .. flag:: Universe Checking This :term:`flag` can be used to enable/disable the checking of universes, providing a form of "type in type". Warning: this breaks the consistency of the system, use at your own risk. Constants relying on "type in type" are printed by :cmd:`Print Assumptions`. It has the same effect as `-type-in-type` command line argument (see :ref:`command-line-options`). .. attr:: bypass_check(universes{? = {| yes | no } }) :name: bypass_check(universes) This :term:`boolean attribute` is similar to the :flag:`Universe Checking` flag, but on a per-declaration basis. Disable universe checking locally with ``bypass_check(universes)``. .. cmd:: Print Typing Flags Print the status of the three typing flags: guard checking, positivity checking and universe checking. .. example:: .. coqtop:: all reset Unset Guard Checking. Print Typing Flags. Fixpoint f (n : nat) : False := f n. Fixpoint ackermann (m n : nat) {struct m} : nat := match m with | 0 => S n | S m => match n with | 0 => ackermann m 1 | S n => ackermann m (ackermann (S m) n) end end. Print Assumptions ackermann. Note that the proper way to define the Ackermann function is to use an inner fixpoint: .. coqtop:: all reset Fixpoint ack m := fix ackm n := match m with | 0 => S n | S m' => match n with | 0 => ack m' 1 | S n' => ack m' (ackm n') end end. Typing flags may not be changed while inside sections. .. _internal-registration-commands: Internal registration commands -------------------------------- Due to their internal nature, the commands that are presented in this section are not for general use. They are meant to appear only in standard libraries and in support libraries of plug-ins. .. _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 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 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`, the constant is exposed to the kernel. For instance, the `PrimInt63` module features the following declaration: .. coqdoc:: Register bool as kernel.ind_bool. This makes the kernel aware of the `bool` type, which is used, for example, to define the return type of the :g:`#int63_eq` primitive. .. seealso:: :ref:`primitive-integers` .. cmd:: Print Registered List the currently registered constants. .. cmd:: Register Scheme @qualid__1 as @qualid__2 for @qualid__3 Make the constant :n:`@qualid__1` accessible to the "scheme" mechanism for scheme kind :n:`@qualid__2` and inductive :n:`@qualid__3`. .. cmd:: Print Registered Schemes List the currently registered schemes. This can be useful to find information about the (currently undocumented) scheme kinds. Inlining hints for the fast reduction machines `````````````````````````````````````````````` .. cmd:: Register Inline @qualid Gives a hint to the reduction machines (VM and native) that the body of the constant :n:`@qualid` should be inlined in the generated code. Registering primitive operations ```````````````````````````````` .. cmd:: Primitive @ident_decl {? : @term } := #@ident 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 error. For example, the standard library files `PrimInt63.v` and `PrimFloat.v` use :cmd:`Primitive` to support, respectively, the features described in :ref:`primitive-integers` and :ref:`primitive-floats`. The types associated with an operator must be declared to the kernel before declaring operations that use the type. Do this with :cmd:`Primitive` for primitive types and :cmd:`Register` with the :g:`kernel` prefix for other types. For example, in `PrimInt63.v`, `#int63_type` must be declared before the associated operations. .. exn:: The type @ident must be registered before this construction can be typechecked. :undocumented: The type must be defined with :cmd:`Primitive` command before this :cmd:`Primitive` command (declaring an operation using the type) will succeed. coq-8.20.0/doc/sphinx/proofs/000077500000000000000000000000001466560755400157735ustar00rootroot00000000000000coq-8.20.0/doc/sphinx/proofs/automatic-tactics/000077500000000000000000000000001466560755400214115ustar00rootroot00000000000000coq-8.20.0/doc/sphinx/proofs/automatic-tactics/auto.rst000066400000000000000000000664711466560755400231310ustar00rootroot00000000000000.. _automation: ========================= Programmable proof search ========================= Tactics ------- .. tacn:: auto {? @nat_or_var } {? @auto_using } {? @hintbases } .. insertprodn auto_using hintbases .. prodn:: auto_using ::= using {+, @one_term } hintbases ::= with * | with {+ @ident } Implements a Prolog-like resolution procedure to solve the current goal. It first tries to solve the goal using the :tacn:`assumption` tactic, then it reduces the goal to an atomic one using :tacn:`intros` and introduces the newly generated hypotheses as hints. Then it looks at the list of tactics associated with the head symbol of the goal and tries to apply one of them. Lower cost tactics are tried before higher-cost tactics. This process is recursively applied to the generated subgoals. :n:`@nat_or_var` Specifies the maximum search depth. The default is 5. :n:`using {+, @one_term }` Uses lemmas :n:`{+, @one_term }` in addition to hints. If :n:`@one_term` is an inductive type, the collection of its constructors are added as hints. Note that hints passed through the `using` clause are used in the same way as if they were passed through a hint database. Consequently, they use a weaker version of :tacn:`apply` and :n:`auto using @one_term` may fail where :n:`apply @one_term` succeeds. .. todo Given that this can be seen as counter-intuitive, it could be useful to have an option to use full-blown :tacn:`apply` for lemmas passed through the `using` clause. Contributions welcome! :n:`with *` Use all existing hint databases. Using this variant is highly discouraged in finished scripts since it is both slower and less robust than explicitly selecting the required databases. :n:`with {+ @ident }` Use the hint databases :n:`{+ @ident}` in addition to the database ``core``. Use the fake database `nocore` to omit `core`. If no `with` clause is given, :tacn:`auto` only uses the hypotheses of the current goal and the hints of the database named ``core``. :tacn:`auto` generally either completely solves the goal or leaves it unchanged. Use :tacn:`solve` `[ auto ]` if you want a failure when they don't solve the goal. :tacn:`auto` will fail if :tacn:`fail` or :tacn:`gfail` are invoked directly or indirectly, in which case setting the :flag:`Ltac Debug` may help you debug the failure. .. warning:: :tacn:`auto` uses a weaker version of :tacn:`apply` that is closer to :tacn:`simple apply` so it is expected that sometimes :tacn:`auto` will fail even if applying manually one of the hints would succeed. .. seealso:: :ref:`hintdatabases` for the list of pre-defined databases and the way to create or extend a database. .. tacn:: info_auto {? @nat_or_var } {? @auto_using } {? @hintbases } Behaves like :tacn:`auto` but shows the tactics it uses to solve the goal. This variant is very useful for getting a better understanding of automation, or to know what lemmas/assumptions were used. .. tacn:: debug auto {? @nat_or_var } {? @auto_using } {? @hintbases } Behaves like :tacn:`auto` but shows the tactics it tries to solve the goal, including failing paths. .. tacn:: trivial {? @auto_using } {? @hintbases } debug trivial {? @auto_using } {? @hintbases } info_trivial {? @auto_using } {? @hintbases } Like :tacn:`auto`, but is not recursive and only tries hints with zero cost. Typically used to solve goals for which a lemma is already available in the specified :n:`hintbases`. .. flag:: Info Auto Debug Auto Info Trivial Debug Trivial These :term:`flags ` enable printing of informative or debug information for the :tacn:`auto` and :tacn:`trivial` tactics. .. tacn:: eauto {? @nat_or_var } {? @auto_using } {? @hintbases } Generalizes :tacn:`auto`. While :tacn:`auto` does not try resolution hints which would leave existential variables in the goal, :tacn:`eauto` will try them. Also, :tacn:`eauto` internally uses :tacn:`eassumption` instead of :tacn:`assumption` and a tactic similar to :tacn:`simple eapply` instead of a tactic similar to :tacn:`simple apply`. As a consequence, :tacn:`eauto` can solve goals such as: .. example:: .. coqtop:: all Hint Resolve ex_intro : core. Goal forall P:nat -> Prop, P 0 -> exists n, P n. eauto. `ex_intro` is declared as a hint so the proof succeeds. .. seealso:: :ref:`hintdatabases` .. tacn:: info_eauto {? @nat_or_var } {? @auto_using } {? @hintbases } The various options for :tacn:`info_eauto` are the same as for :tacn:`info_auto`. :tacn:`eauto` uses the following flags: .. flag:: Info Eauto Debug Eauto :undocumented: .. tacn:: debug eauto {? @nat_or_var } {? @auto_using } {? @hintbases } Behaves like :tacn:`eauto` but shows the tactics it tries to solve the goal, including failing paths. .. tacn:: dfs eauto {? @nat_or_var } {? @auto_using } {? @hintbases } .. deprecated:: 8.16 An alias for :tacn:`eauto`. .. tacn:: autounfold {? @hintbases } {? @simple_occurrences } Unfolds constants that were declared through a :cmd:`Hint Unfold` in the given databases. :n:`@simple_occurrences` Performs the unfolding in the specified occurrences. .. tacn:: autounfold_one {? @hintbases } {? in @ident } :undocumented: .. tacn:: autorewrite {? * } with {+ @ident } {? @occurrences } {? using @ltac_expr } `*` If present, rewrite all occurrences whose side conditions are solved. .. todo: This may not always work as described, see #4976 #7672 and https://github.com/coq/coq/issues/1933#issuecomment-337497938 as mentioned here: https://github.com/coq/coq/pull/13343#discussion_r527801604 :n:`with {+ @ident }` Specifies the rewriting rule bases to use. :n:`@occurrences` Performs rewriting in the specified occurrences. Note: the `at` clause is currently not supported. .. exn:: The "at" syntax isn't available yet for the autorewrite tactic. Appears when there is an `at` clause on the conclusion. :n:`using @ltac_expr` :token:`ltac_expr` is applied to the main subgoal after each rewriting step. Applies rewritings according to the rewriting rule bases :n:`{+ @ident }`. For each rule base, applies each rewriting to the main subgoal until it fails. Once all the rules have been processed, if the main subgoal has changed then the rules of this base are processed again. If the main subgoal has not changed then the next base is processed. For the bases, the behavior is very similar to the processing of the rewriting rules. The rewriting rule bases are built with the :cmd:`Hint Rewrite` command. .. warning:: This tactic may loop if you build non-terminating rewriting systems. .. seealso:: :cmd:`Hint Rewrite` for feeding the database of lemmas used by :tacn:`autorewrite` and :tacn:`autorewrite` for examples showing the use of this tactic. Also see :ref:`strategies4rewriting`. Here are two examples of ``autorewrite`` use. The first one ( *Ackermann function*) shows actually a quite basic use where there is no conditional rewriting. The second one ( *Mac Carthy function*) involves conditional rewritings and shows how to deal with them using the optional tactic of the ``Hint Rewrite`` command. .. example:: Ackermann function .. coqtop:: in reset Require Import Arith. .. coqtop:: in Parameter Ack : nat -> nat -> nat. .. coqtop:: in Axiom Ack0 : forall m:nat, Ack 0 m = S m. Axiom Ack1 : forall n:nat, Ack (S n) 0 = Ack n 1. Axiom Ack2 : forall n m:nat, Ack (S n) (S m) = Ack n (Ack (S n) m). .. coqtop:: in Global Hint Rewrite Ack0 Ack1 Ack2 : base0. .. coqtop:: all Lemma ResAck0 : Ack 3 2 = 29. .. coqtop:: all autorewrite with base0 using try reflexivity. .. example:: MacCarthy function .. coqtop:: in reset Require Import Lia. .. coqtop:: in Parameter g : nat -> nat -> nat. .. coqtop:: in Axiom g0 : forall m:nat, g 0 m = m. Axiom g1 : forall n m:nat, (n > 0) -> (m > 100) -> g n m = g (pred n) (m - 10). Axiom g2 : forall n m:nat, (n > 0) -> (m <= 100) -> g n m = g (S n) (m + 11). .. coqtop:: in Global Hint Rewrite g0 g1 g2 using lia : base1. .. coqtop:: in Lemma Resg0 : g 1 110 = 100. .. coqtop:: out Show. .. coqtop:: all autorewrite with base1 using reflexivity || simpl. .. coqtop:: none Qed. .. coqtop:: all Lemma Resg1 : g 1 95 = 91. .. coqtop:: all autorewrite with base1 using reflexivity || simpl. .. coqtop:: none Qed. .. tacn:: easy This tactic tries to solve the current goal by a number of standard closing steps. In particular, it tries to close the current goal using the closing tactics :tacn:`trivial`, :tacn:`reflexivity`, :tacn:`symmetry`, :tacn:`contradiction` and :tacn:`inversion` of hypothesis. If this fails, it tries introducing variables and splitting and-hypotheses, using the closing tactics afterwards, and splitting the goal using :tacn:`split` and recursing. This tactic solves goals that belong to many common classes; in particular, many cases of unsatisfiable hypotheses, and simple equality goals are usually solved by this tactic. .. tacn:: now @ltac_expr Run :n:`@tactic` followed by :tacn:`easy`. This is a notation for :n:`@tactic; easy`. .. _hintdatabases: Hint databases -------------- Hints used by :tacn:`auto`, :tacn:`eauto` and other tactics are stored in hint databases. Each database maps head symbols to a list of hints. Use the :cmd:`Print Hint` command to view a database. Each hint has a cost that is a nonnegative integer and an optional pattern. Hints with lower costs are tried first. :tacn:`auto` tries a hint when the conclusion of the current goal matches its pattern or when the hint has no pattern. Creating hint databases ``````````````````````` Hint databases can be created with the :cmd:`Create HintDb` command or implicitly by adding a hint to an unknown database. We recommend you always use :cmd:`Create HintDb` and then imediately use :cmd:`Hint Constants` and :cmd:`Hint Variables` to make those settings explicit. Note that the default transparency settings differ between these two methods of creation. Databases created with :cmd:`Create HintDb` have the default setting `Transparent` for both `Variables` and `Constants`, while implicitly created databases have the `Opaque` setting. .. cmd:: Create HintDb @ident {? discriminated } Creates a new hint database named :n:`@ident`. The database is implemented by a Discrimination Tree (DT) that serves as a filter to select the lemmas that will be applied. When discriminated, the DT uses transparency information to decide if a constant should considered rigid for filtering, making the retrieval more efficient. By contrast, undiscriminated databases treat all constants as transparent, resulting in a larger number of selected lemmas to be applied, and thus putting more pressure on unification. By default, hint databases are undiscriminated. Hint databases defined in the Coq standard library `````````````````````````````````````````````````` Several hint databases are defined in the Coq standard library. The database contains all hints declared to belong to it in the currently loaded modules. In particular, requiring new modules may extend the database. At Coq startup, only the core database is nonempty and ready to be used immediately. :core: This special database is automatically used by ``auto``, except when pseudo-database ``nocore`` is given to ``auto``. The core database contains only basic lemmas about negation, conjunction, and so on. Most of the hints in this database come from the Init and Logic directories. :arith: all lemmas about Peano’s arithmetic proved in the directories Init and Arith. :zarith: lemmas about binary signed integers from the directories theories/ZArith. The database also contains high-cost hints that call :tacn:`lia` on equations and inequalities in ``nat`` or ``Z``. :bool: lemmas about booleans, mostly from directory theories/Bool. :datatypes: lemmas about lists, streams and so on that are mainly proved in the Lists subdirectory. :sets: lemmas about sets and relations from the directories Sets and Relations. :typeclass_instances: special database containing all typeclass instances declared in the environment, including those used for ``setoid_rewrite``, from the Classes directory. :fset: internal database for the implementation of the ``FSets`` library. :ordered_type: lemmas about ordered types (as defined in the legacy ``OrderedType`` module), mainly used in the ``FSets`` and ``FMaps`` libraries. You are advised not to put your own hints in the core database, but use one or more databases specific to your development. .. _creating_hints: Creating Hints -------------- The various `Hint` commands share these elements: :n:`{? : {+ @ident } }` specifies the hint database(s) to add to. *(Deprecated since version 8.10:* If no :token:`ident`\s are given, the hint is added to the `core` database.) Outside of sections, these commands support the :attr:`local`, :attr:`export` and :attr:`global` attributes. :attr:`export` is the default. Inside sections, some commands only support the :attr:`local` attribute. These are :cmd:`Hint Immediate`, :cmd:`Hint Resolve`, :cmd:`Hint Constructors`, :cmd:`Hint Unfold`, :cmd:`Hint Extern` and :cmd:`Hint Rewrite`. :attr:`local` is the default for all hint commands inside sections. + :attr:`local` hints are never visible from other modules, even if they :cmd:`Import` or :cmd:`Require` the current module. + :attr:`export` hints are visible from other modules when they :cmd:`Import` the current module, but not when they only :cmd:`Require` it. + :attr:`global` hints are visible from other modules when they :cmd:`Import` or :cmd:`Require` the current module. .. versionadded:: 8.14 The :cmd:`Hint Rewrite` now supports locality attributes like other `Hint` commands. .. versionchanged:: 8.18 The default value for hint locality outside sections is now :attr:`export`. It used to be :attr:`global`. The `Hint` commands are: .. cmd:: Hint Resolve {+ {| @qualid | @one_term } } {? @hint_info } {? : {+ @ident } } Hint Resolve {| -> | <- } {+ @qualid } {? @natural } {? : {+ @ident } } :name: Hint Resolve; _ .. insertprodn hint_info one_pattern .. prodn:: hint_info ::= %| {? @natural } {? @one_pattern } one_pattern ::= @one_term The first form adds each :n:`@qualid` as a hint with the head symbol of the type of :n:`@qualid` to the specified hint databases (:n:`@ident`\s). The cost of the hint is the number of subgoals generated by :tacn:`simple apply` :n:`@qualid` or, if specified, :n:`@natural`. The associated pattern is inferred from the conclusion of the type of :n:`@qualid` or, if specified, the given :n:`@one_pattern`. If the inferred type of :n:`@qualid` does not start with a product, :tacn:`exact` :n:`@qualid` is added to the hint list. If the type can be reduced to a type starting with a product, :tacn:`simple apply` :n:`@qualid` is also added to the hints list. If the inferred type of :n:`@qualid` contains a dependent quantification on a variable which occurs only in the premises of the type and not in its conclusion, no instance could be inferred for the variable by unification with the goal. In this case, the hint is only used by :tacn:`eauto` / :tacn:`typeclasses eauto`, but not by :tacn:`auto`. A typical hint that would only be used by :tacn:`eauto` is a transitivity lemma. :n:`{| -> | <- }` The second form adds the left-to-right (`->`) or right-ot-left implication (`<-`) of an equivalence as a hint (informally the hint will be used as, respectively, :tacn:`apply` :n:`-> @qualid` or :tacn:`apply` :n:`<- @qualid`, although as mentioned before, the tactic actually used is a restricted version of :tacn:`apply`). :n:`@one_term` Permits declaring a hint without declaring a new constant first. This is deprecated. .. warn:: Declaring arbitrary terms as hints is fragile and deprecated; it is recommended to declare a toplevel constant instead :undocumented: .. exn:: @qualid cannot be used as a hint The head symbol of the type of :n:`@qualid` is a bound variable such that this tactic cannot be associated with a constant. .. cmd:: Hint Immediate {+ {| @qualid | @one_term } } {? : {+ @ident } } For each specified :n:`@qualid`, adds the tactic :tacn:`simple apply` :n:`@qualid;` :tacn:`solve` :n:`[` :tacn:`trivial` :n:`]` to the hint list associated with the head symbol of the type of :n:`@qualid`. This tactic will fail if all the subgoals generated by :tacn:`simple apply` :n:`@qualid` are not solved immediately by the :tacn:`trivial` tactic (which only tries tactics with cost 0). This command is useful for theorems such as the symmetry of equality or :g:`n+1=m+1 -> n=m` that we may want to introduce with limited use in order to avoid useless proof search. The cost of this tactic (which never generates subgoals) is always 1, so that it is not used by :tacn:`trivial` itself. .. cmd:: Hint Constructors {+ @qualid } {? : {+ @ident } } For each :n:`@qualid` that is an inductive type, adds all its constructors as hints of type ``Resolve``. Then, when the conclusion of current goal has the form :n:`(@qualid ...)`, :tacn:`auto` will try to apply each constructor. .. exn:: @qualid is not an inductive type :undocumented: .. cmd:: Hint Unfold {+ @qualid } {? : {+ @ident } } For each :n:`@qualid`, adds the tactic :tacn:`unfold` :n:`@qualid` to the hint list that will only be used when the :term:`head constant` of the goal is :token:`qualid`. Its cost is 4. .. cmd:: Hint {| Transparent | Opaque } {+ @qualid } {? : {+ @ident } } :name: Hint Transparent; Hint Opaque Adds transparency hints to the database, making each :n:`@qualid` a transparent or opaque constant during resolution. This information is used during unification of the goal with any lemma in the database and inside the discrimination network to relax or constrain it in the case of discriminated databases. .. exn:: Cannot coerce @qualid to an evaluable reference. :undocumented: .. cmd:: Hint {| Constants | Projections | Variables } {| Transparent | Opaque } {? : {+ @ident } } :name: Hint Constants; Hint Projections; Hint Variables Sets the transparency flag for constants, projections or variables for the specified hint databases. These flags affect the unification of hints in the database. We advise using this just after a :cmd:`Create HintDb` command. .. cmd:: Hint Extern @natural {? @one_pattern } => @ltac_expr {? : {+ @ident } } Extends :tacn:`auto` with tactics other than :tacn:`apply` and :tacn:`unfold`. :n:`@natural` is the cost, :n:`@one_pattern` is the pattern to match and :n:`@ltac_expr` is the action to apply. .. note:: Use a :cmd:`Hint Extern` with no pattern to do pattern matching on hypotheses using ``match goal with`` inside the tactic. .. example:: .. coqtop:: in Hint Extern 4 (~(_ = _)) => discriminate : core. Now, when the head of the goal is a disequality, ``auto`` will try discriminate if it does not manage to solve the goal with hints with a cost less than 4. One can even use some sub-patterns of the pattern in the tactic script. A sub-pattern is a question mark followed by an identifier, like ``?X1`` or ``?X2``. Here is an example: .. example:: .. coqtop:: reset all Require Import List. Hint Extern 5 ({?X1 = ?X2} + {?X1 <> ?X2}) => generalize X1, X2; decide equality : eqdec. Goal forall a b:list (nat * nat), {a = b} + {a <> b}. info_auto. .. cmd:: Hint Cut [ @hints_regexp ] {? : {+ @ident } } .. DISABLED insertprodn hints_regexp hints_regexp .. prodn:: hints_regexp ::= {+ @qualid } (hint or instance identifier) | _ (any hint) | @hints_regexp | @hints_regexp (disjunction) | @hints_regexp @hints_regexp (sequence) | @hints_regexp * (Kleene star) | emp (empty) | eps (epsilon) | ( @hints_regexp ) Used to cut the proof search tree according to a regular expression that matches the paths to be cut. During proof search, the path of successive successful hints on a search branch is recorded as a list of identifiers for the hints (note that :cmd:`Hint Extern`\s do not have an associated identifier). For each hint :n:`@qualid` in the hint database, the current path `p` extended with :n:`@qualid` is matched against the current cut expression `c` associated with the hint database. If the match succeeds the hint is *not* applied. :n:`Hint Cut @hints_regexp` sets the cut expression to :n:`c | @hints_regexp`. The initial cut expression is `emp`. The output of :cmd:`Print HintDb` shows the cut expression. .. warning:: The regexp matches the entire path. Most hints will start with a leading `( _* )` to match the tail of the path. (Note that `(_*)` misparses since `*)` would end a comment.) .. warning:: There is no operator precedence during parsing, one can check with :cmd:`Print HintDb` to verify the current cut expression. .. warning:: These hints currently only apply to typeclass proof search and the :tacn:`typeclasses eauto` tactic. .. cmd:: Hint Mode @qualid {+ {| + | ! | - } } {? : {+ @ident } } Sets an optional mode of use for the identifier :n:`@qualid`. When proof search has a goal that ends in an application of :n:`@qualid` to arguments :n:`@arg ... @arg`, the mode tells if the hints associated with :n:`@qualid` can be applied or not. A mode specification is a list of ``+``, ``!`` or ``-`` items that specify if an argument of the identifier is to be treated as an input (``+``), if its head only is an input (``!``) or an output (``-``) of the identifier. Mode ``-`` matches any term, mode ``+`` matches a term if and only if it does not contain existential variables, while mode ``!`` matches a term if and only if the *head* of the term is not an existential variable. The head of a term is understood here as the applicative head, recursively, ignoring casts. :cmd:`Hint Mode` is especially useful for typeclasses, when one does not want to support default instances and wants to avoid ambiguity in general. Setting a parameter of a class as an input forces proof search to be driven by that index of the class, with ``!`` allowing existentials to appear in the index but not at its head. .. note:: + Multiple modes can be declared for a single identifier. In that case only one mode needs to match the arguments for the hints to be applied. + If you want to add hints such as :cmd:`Hint Transparent`, :cmd:`Hint Cut`, or :cmd:`Hint Mode`, for typeclass resolution, do not forget to put them in the ``typeclass_instances`` hint database. .. warn:: This hint is not local but depends on a section variable. It will disappear when the section is closed. A hint with a non-local attribute was added inside a section, but it refers to a local variable that will go out of scope when closing the section. As a result the hint will not survive either. .. cmd:: Hint Rewrite {? {| -> | <- } } {+ @one_term } {? using @ltac_expr } {? : {* @ident } } :n:`{? using @ltac_expr }` If specified, :n:`@ltac_expr` is applied to the generated subgoals, except for the main subgoal. :n:`{| -> | <- }` Arrows specify the orientation; left to right (:n:`->`) or right to left (:n:`<-`). If no arrow is given, the default orientation is left to right (:n:`->`). Adds the terms :n:`{+ @one_term }` (their types must be equalities) to the rewriting bases :n:`{* @ident }`. Note that the rewriting bases are distinct from the :tacn:`auto` hint bases and that :tacn:`auto` does not take them into account. .. cmd:: Print Rewrite HintDb @ident This command displays all rewrite hints contained in :n:`@ident`. .. cmd:: Remove Hints {+ @qualid } {? : {+ @ident } } Removes the hints associated with the :n:`{+ @qualid }` in databases :n:`{+ @ident}`. Note: hints created with :cmd:`Hint Extern` currently can't be removed. The best workaround for this is to make the hints non-global and carefully select which modules you import. .. cmd:: Print Hint {? {| * | @reference } } :n:`*` Display all declared hints. :n:`@reference` Display all hints associated with the head symbol :n:`@reference`. Displays tactics from the hints list. The default is to show hints that apply to the conclusion of the current goal. The other forms with :n:`*` and :n:`@reference` can be used even if no proof is open. Each hint has a cost that is a nonnegative integer and an optional pattern. The hints with lower cost are tried first. .. cmd:: Print HintDb @ident This command displays all hints from database :n:`@ident`. Hint locality ````````````` As explained at the beginning of :ref:`creating_hints`, hints outside sections have three possible localities: :attr:`local`, :attr:`export`, and :attr:`global`, with :attr:`export` now being the default. The default used to be :attr:`global`, so old code bases may still use it. The following option may be useful to help transition hints from the :attr:`global` to the :attr:`export` locality, as it can provide an over-approximation of where these hints are used: .. opt:: Loose Hint Behavior {| "Lax" | "Warn" | "Strict" } This :term:`option` accepts three values: - "Lax": no scope errors or warnings are generated for hints. This is the default. - "Warn": outputs a warning when a non-imported hint is used. Note that this is an over-approximation, because a hint may be triggered by a run that will eventually fail and backtrack, resulting in the hint not being actually useful for the proof. - "Strict": fails when a non-imported hint is used, with the same caveats as "Warn". .. _tactics-implicit-automation: Setting implicit automation tactics ----------------------------------- .. cmd:: Proof with @ltac_expr {? using @section_var_expr } Starts a proof in which :token:`ltac_expr` is applied to the active goals after each tactic that ends with `...` instead of the usual single period. ":n:`@tactic...`" is equivalent to ":n:`@tactic; @ltac_expr.`". .. seealso:: :cmd:`Proof` in :ref:`proof-editing-mode`. coq-8.20.0/doc/sphinx/proofs/automatic-tactics/index.rst000066400000000000000000000011271466560755400232530ustar00rootroot00000000000000.. _automatic-tactics: ===================================================== Automatic solvers and programmable tactics ===================================================== Some tactics are largely automated and are able to solve complex goals. This chapter presents both built-in solvers that can be used on specific categories of goals and programmable tactics that the user can instrument to handle complex goals in new domains. .. toctree:: :maxdepth: 1 logic ../../addendum/micromega ../../addendum/ring ../../addendum/nsatz auto ../../addendum/generalized-rewriting coq-8.20.0/doc/sphinx/proofs/automatic-tactics/logic.rst000066400000000000000000000234741466560755400232520ustar00rootroot00000000000000.. _decisionprocedures: ============================== Solvers for logic and equality ============================== .. tacn:: tauto This tactic implements a decision procedure for intuitionistic propositional calculus based on the contraction-free sequent calculi LJT* of Roy Dyckhoff :cite:`Dyc92`. Note that :tacn:`tauto` succeeds on any instance of an intuitionistic tautological proposition. :tacn:`tauto` unfolds negations and logical equivalence but does not unfold any other definition. .. example:: The following goal can be proved by :tacn:`tauto` whereas :tacn:`auto` would fail: .. coqtop:: reset all Goal forall (x:nat) (P:nat -> Prop), x = 0 \/ P x -> x <> 0 -> P x. intros. tauto. Moreover, if it has nothing else to do, :tacn:`tauto` performs introductions. Therefore, the use of :tacn:`intros` in the previous proof is unnecessary. :tacn:`tauto` can for instance for: .. example:: .. coqtop:: reset all Goal forall (A:Prop) (P:nat -> Prop), A \/ (forall x:nat, ~ A -> P x) -> forall x:nat, ~ A -> P x. tauto. .. note:: In contrast, :tacn:`tauto` cannot solve the following goal :g:`Goal forall (A:Prop) (P:nat -> Prop), A \/ (forall x:nat, ~ A -> P x) ->` :g:`forall x:nat, ~ ~ (A \/ P x).` because :g:`(forall x:nat, ~ A -> P x)` cannot be treated as atomic and an instantiation of `x` is necessary. .. tacn:: dtauto While :tacn:`tauto` recognizes inductively defined connectives isomorphic to the standard connectives ``and``, ``prod``, ``or``, ``sum``, ``False``, ``Empty_set``, ``unit`` and ``True``, :tacn:`dtauto` also recognizes all inductive types with one constructor and no indices, i.e. record-style connectives. .. todo would be nice to explain/discuss the various types of flags that define the differences between these tactics. See Tauto.v/tauto.ml. .. tacn:: intuition {? @ltac_expr } Uses the search tree built by the decision procedure for :tacn:`tauto` to generate a set of subgoals equivalent to the original one (but simpler than it) and applies :n:`@ltac_expr` to them :cite:`Mun94`. If :n:`@ltac_expr` is not specified, it defaults to ``Tauto.intuition_solver``. The initial value of ``intuition_solver`` is equivalent to :n:`auto with *` but prints warning ``intuition-auto-with-star`` when it solves a goal that :tacn:`auto` cannot solve. In a future version it will be changed to just :tacn:`auto`. Use ``intuition tac`` locally or ``Ltac Tauto.intuition_solver ::= tac`` globally to silence the warning in a forward compatible way with your choice of tactic ``tac`` (``auto``, ``auto with *``, ``auto with`` your prefered databases, or any other tactic). If :n:`@ltac_expr` fails on some goals then :tacn:`intuition` fails. In fact, :tacn:`tauto` is simply :g:`intuition fail`. :tacn:`intuition` recognizes inductively defined connectives isomorphic to the standard connectives ``and``, ``prod``, ``or``, ``sum``, ``False``, ``Empty_set``, ``unit`` and ``True``. .. example:: For instance, the tactic :g:`intuition auto` applied to the goal:: (forall (x:nat), P x) /\ B -> (forall (y:nat), P y) /\ P O \/ B /\ P O internally replaces it by the equivalent one:: (forall (x:nat), P x), B |- P O and then uses :tacn:`auto` which completes the proof. .. tacn:: dintuition {? @ltac_expr } In addition to the inductively defined connectives recognized by :tacn:`intuition`, :tacn:`dintuition` also recognizes all inductive types with one constructor and no indices, i.e. record-style connectives. .. flag:: Intuition Negation Unfolding This :term:`flag` controls whether :tacn:`intuition` unfolds inner negations which do not need to be unfolded. It is on by default. .. tacn:: rtauto Solves propositional tautologies similarly to :tacn:`tauto`, but the proof term is built using a reflection scheme applied to a sequent calculus proof of the goal. The search procedure is also implemented using a different technique. Users should be aware that this difference may result in faster proof search but slower proof checking, and :tacn:`rtauto` might not solve goals that :tacn:`tauto` would be able to solve (e.g. goals involving universal quantifiers). Note that this tactic is only available after a ``Require Import Rtauto``. .. tacn:: firstorder {? @ltac_expr } {? using {+, @qualid } } {? with {+ @ident } } An experimental extension of :tacn:`tauto` to first-order reasoning. It is not restricted to usual logical connectives but instead can reason about any first-order class inductive definition. :token:`ltac_expr` Tries to solve the goal with :token:`ltac_expr` when no logical rule applies. If unspecified, the tactic uses the default from the :opt:`Firstorder Solver` option. :n:`using {+, @qualid }` Adds the lemmas :n:`{+, @qualid }` to the proof search environment. If :n:`@qualid` refers to an inductive type, its constructors are added to the proof search environment. :n:`with {+ @ident }` Adds lemmas from :tacn:`auto` hint bases :n:`{+ @ident }` to the proof search environment. .. opt:: Firstorder Solver @ltac_expr The default tactic used by :tacn:`firstorder` when no rule applies in :g:`auto with core`. This command supports the same locality attributes as :cmd:`Obligation Tactic`. .. cmd:: Print Firstorder Solver Prints the default tactic used by :tacn:`firstorder` when no rule applies. .. opt:: Firstorder Depth @natural This :term:`option` controls the proof search depth bound. .. tacn:: gintuition {? @ltac_expr } .. deprecated:: 8.20 An extension of :tacn:`intuition` to first-order reasoning (similar to how :tacn:`firstorder` extends :tacn:`tauto`). .. tacn:: congruence {? @natural } {? with {+ @one_term } } :token:`natural` Specifies the maximum number of hypotheses stating quantified equalities that may be added to the problem in order to solve it. The default is 1000. :n:`{? with {+ @one_term } }` Adds :n:`{+ @one_term }` to the pool of terms used by :tacn:`congruence`. This helps in case you have partially applied constructors in your goal. Implements the standard Nelson and Oppen congruence closure algorithm, which is a decision procedure for ground equalities with uninterpreted symbols. It also includes constructor theory (see :tacn:`injection` and :tacn:`discriminate`). If the goal is a non-quantified equality, congruence tries to prove it with non-quantified equalities in the context. Otherwise it tries to infer a discriminable equality from those in the context. Alternatively, congruence tries to prove that a hypothesis is equal to the goal or to the negation of another hypothesis. :tacn:`congruence` is also able to take advantage of hypotheses stating quantified equalities, but you have to provide a bound for the number of extra equalities generated that way. Please note that one of the sides of the equality must contain all the quantified variables in order for congruence to match against it. Increasing the maximum number of hypotheses may solve problems that would have failed with a smaller value. It will make failures slower but it won't make successes found with the smaller value any slower. You may want to use :tacn:`assert` to add some lemmas as hypotheses so that :tacn:`congruence` can use them. .. tacn:: simple congruence {? @natural } {? with {+ @one_term } } Behaves like :tacn:`congruence`, but does not unfold definitions. .. example:: .. coqtop:: reset all Theorem T (A:Type) (f:A -> A) (g: A -> A -> A) a b: a=(f a) -> (g b (f a))=(f (f a)) -> (g a b)=(f (g b a)) -> (g a b)=a. intros. congruence. Qed. Theorem inj (A:Type) (f:A -> A * A) (a c d: A) : f = pair a -> Some (f c) = Some (f d) -> c=d. intros. congruence. Qed. .. 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 dependently-typed functions. .. exn:: Goal is solvable by congruence but some arguments are missing. Try congruence with {+ @term}, replacing metavariables by arbitrary terms. The decision procedure could solve the goal with the provision that additional arguments are supplied for some partially applied constructors. Any term of an appropriate type will allow the tactic to successfully solve the goal. Those additional arguments can be given to congruence by filling in the holes in the terms given in the error message, using the `with` clause. Setting :opt:`Debug` ``"congruence"`` makes :tacn:`congruence` print debug information. .. tacn:: btauto The tactic :tacn:`btauto` implements a reflexive solver for boolean tautologies. It solves goals of the form :g:`t = u` where `t` and `u` are constructed over the following grammar: .. prodn:: btauto_term ::= @ident | true | false | orb @btauto_term @btauto_term | andb @btauto_term @btauto_term | xorb @btauto_term @btauto_term | negb @btauto_term | if @btauto_term then @btauto_term else @btauto_term Whenever the formula supplied is not a tautology, it also provides a counter-example. Internally, it uses a system very similar to the one of the ring tactic. Note that this tactic is only available after a ``Require Import Btauto``. .. exn:: Cannot recognize a boolean equality. The goal is not of the form :g:`t = u`. Especially note that :tacn:`btauto` doesn't introduce variables into the context on its own. coq-8.20.0/doc/sphinx/proofs/creating-tactics/000077500000000000000000000000001466560755400212175ustar00rootroot00000000000000coq-8.20.0/doc/sphinx/proofs/creating-tactics/index.rst000066400000000000000000000032331466560755400230610ustar00rootroot00000000000000.. _writing-tactics: ==================== Creating new tactics ==================== The languages presented in this chapter allow one to build complex tactics by combining existing ones with constructs such as conditionals and looping. While :ref:`Ltac ` was initially thought of as a language for doing some basic combinations, it has been used successfully to build highly complex tactics as well, but this has also highlighted its limits and fragility. The language :ref:`Ltac2 ` is a typed and more principled variant which is more adapted to building complex tactics. There are other solutions beyond these two tactic languages to write new tactics: - `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. - `Coq-Elpi `_ is an external plugin which provides an extension language based on λProlog, a programming language well suited to write code which manipulates syntax trees with binders such as Coq terms. Elpi provides an extensive set of APIs to create commands (i.e. script the vernacular language) and 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 `_. .. toctree:: :maxdepth: 1 ../../proof-engine/ltac ../../proof-engine/ltac2 coq-8.20.0/doc/sphinx/proofs/writing-proofs/000077500000000000000000000000001466560755400207645ustar00rootroot00000000000000coq-8.20.0/doc/sphinx/proofs/writing-proofs/equality.rst000066400000000000000000001377241466560755400233710ustar00rootroot00000000000000========================= Reasoning with equalities ========================= There are multiple notions of :gdef:`equality` in Coq: - :gdef:`Leibniz equality` is the standard way to define equality in Coq and the Calculus of Inductive Constructions, which is in terms of a binary relation, i.e. a binary function that returns a `Prop`. The standard library defines `eq` similar to this: .. coqdoc:: Inductive eq {A : Type} (x : A) : A -> Prop := eq_refl : eq x x. The notation `x = y` represents the term `eq x y`. The notation `x = y :> A` gives the type of x and y explicitly. - :gdef:`Setoid equality ` defines equality in terms of an equivalence relation. A :gdef:`setoid` is a set that is equipped with an equivalence relation (see https://en.wikipedia.org/wiki/Setoid). These are needed to form a :gdef:`quotient set` or :gdef:`quotient` (see https://en.wikipedia.org/wiki/Equivalence_class). In Coq, users generally work with setoids rather than constructing quotients, for which there is no specific support. - :gdef:`Definitional equality ` is equality based on the :ref:`conversion rules `, which Coq can determine automatically. When two terms are definitionally equal, Coq knows it can replace one with the other, such as with :tacn:`change` `X with Y`, among many other advantages. ":term:`Convertible `" is another way of saying that two terms are definitionally equal. Tactics for dealing with equality of inductive types such as :tacn:`injection` and :tacn:`inversion` are described :ref:`here `. Tactics for simple equalities ----------------------------- .. tacn:: reflexivity For a goal with the form :n:`{? forall @open_binders , } t = u`, verifies that `t` and `u` are :term:`definitionally equal `, and if so, solves the goal (by applying `eq_refl`). If not, it fails. The tactic may also be applied to goals with the form :n:`{? forall @open_binders , } R @term__1 @term__2` where `R` is a reflexive relation registered with the `Equivalence` or `Reflexive` typeclasses. See :cmd:`Class` and :cmd:`Instance`. .. exn:: The relation @ident is not a declared reflexive relation. Maybe you need to require the Coq.Classes.RelationClasses library :undocumented: .. tacn:: symmetry {? @simple_occurrences } Changes a goal that has the form :n:`{? forall @open_binders , } t = u` into :n:`u = t`. :n:`@simple_occurrences` may be used to apply the change in the selected hypotheses and/or the conclusion. The tactic may also be applied to goals with the form :n:`{? forall @open_binders , } R @term__1 @term__2` where `R` is a symmetric relation registered with the `Equivalence` or `Symmetric` typeclasses. See :cmd:`Class` and :cmd:`Instance`. .. exn:: The relation @ident is not a declared symmetric relation. Maybe you need to require the Coq.Classes.RelationClasses library :undocumented: .. tacn:: transitivity @one_term Changes a goal that has the form :n:`{? forall @open_binders , } t = u` into the two subgoals :n:`t = @one_term` and :n:`@one_term = u`. The tactic may also be applied to goals with the form :n:`{? forall @open_binders , } R @term__1 @term__2` where `R` is a transitive relation registered with the `Equivalence` or `Transitivity` typeclasses. See :cmd:`Class` and :cmd:`Instance`. .. tacn:: etransitivity This tactic behaves like :tacn:`transitivity`, using a fresh evar instead of a concrete :token:`one_term`. .. exn:: The relation @ident is not a declared transitive relation. Maybe you need to require the Coq.Classes.RelationClasses library :undocumented: .. tacn:: f_equal For a goal with the form :n:`f a__1 ... a__n = g b__1 ... b__n`, creates subgoals :n:`f = g` and :n:`a__i = b__i` for the `n` arguments. Subgoals that can be proven by :tacn:`reflexivity` or :tacn:`congruence` are solved automatically. .. _rewritingexpressions: Rewriting with Leibniz and setoid equality ------------------------------------------ .. tacn:: rewrite {+, @oriented_rewriter } {? @occurrences } {? by @ltac_expr3 } .. insertprodn oriented_rewriter oriented_rewriter .. prodn:: oriented_rewriter ::= {? {| -> | <- } } {? @natural } {? {| ? | ! } } @one_term_with_bindings Replaces subterms with other subterms that have been proven to be equal. The type of :n:`@one_term` must have the form: :n:`{? forall @open_binders , } EQ @term__1 @term__2` where :g:`EQ` is the :term:`Leibniz equality` `eq` or a registered :term:`setoid equality`. Note that :n:`eq @term__1 @term__2` is typically written with the infix notation :n:`@term__1 = @term__2`. You must `Require Setoid` to use the tactic with a setoid equality or with :ref:`setoid rewriting `. :n:`rewrite @one_term` finds subterms matching :n:`@term__1` in the goal, and replaces them with :n:`@term__2` (or the reverse if `<-` is given). Some of the variables :g:`x`\ :sub:`i` are solved by unification, and some of the types :n:`A__1, …, A__n` may become new subgoals. :tacn:`rewrite` won't find occurrences inside `forall` that refer to variables bound by the `forall`; use the more advanced :tacn:`setoid_rewrite` if you want to find such occurrences. :n:`{+, @oriented_rewriter }` The :n:`@oriented_rewriter`\s are applied sequentially to the first goal generated by the previous :n:`@oriented_rewriter`. If any of them fail, the tactic fails. :n:`{? {| -> | <- } }` For `->` (the default), :n:`@term__1` is rewritten into :n:`@term__2`. For `<-`, :n:`@term__2` is rewritten into :n:`@term__1`. :n:`{? @natural } {? {| ? | ! } }` :n:`@natural` is the number of rewrites to perform. If `?` is given, :n:`@natural` is the maximum number of rewrites to perform; otherwise :n:`@natural` is the exact number of rewrites to perform. `?` (without :n:`@natural`) performs the rewrite as many times as possible (possibly zero times). This form never fails. `!` (without :n:`@natural`) performs the rewrite as many times as possible and at least once. The tactic fails if the requested number of rewrites can't be performed. :n:`@natural !` is equivalent to :n:`@natural`. :n:`@occurrences` If :n:`@occurrences` specifies multiple occurrences, the tactic succeeds if any of them can be rewritten. If not specified, only the first occurrence in the conclusion is replaced. .. note:: If :n:`at @occs_nums` is specified, rewriting is always done with :ref:`setoid rewriting `, even for Leibniz equality, which means that you must `Require Setoid` to use that form. However, note that :tacn:`rewrite` (even when using setoid rewriting) and :tacn:`setoid_rewrite` don't behave identically (as is noted above and below). :n:`by @ltac_expr3` If specified, is used to resolve all side conditions generated by the tactic. .. note:: For each selected hypothesis and/or the conclusion, :tacn:`rewrite` finds the first matching subterm in depth-first search order. Only subterms identical to that first matched subterm are rewritten. If the `at` clause is specified, only these subterms are considered when counting occurrences. To select a different set of matching subterms, you can specify how some or all of the free variables are bound by using a `with` clause (see :n:`@one_term_with_bindings`). For instance, if we want to rewrite the right-hand side in the following goal, this will not work: .. coqtop:: none Require Import Arith. .. coqtop:: out Lemma example x y : x + y = y + x. .. coqtop:: all fail rewrite Nat.add_comm at 2. One can explicitly specify how some variables are bound to match a different subterm: .. coqtop:: all abort rewrite Nat.add_comm with (m := x). Note that the more advanced :tacn:`setoid_rewrite` tactic behaves differently, and thus the number of occurrences available to rewrite may differ between the two tactics. .. exn:: Tactic failure: Setoid library not loaded. :undocumented: .. todo You can use Typeclasses Debug to tell whether rewrite used setoid rewriting. Example here: https://github.com/coq/coq/pull/13470#discussion_r539230973 .. exn:: Cannot find a relation to rewrite. :undocumented: .. exn:: Tactic generated a subgoal identical to the original goal. :undocumented: .. exn:: Found no subterm matching @term in @ident. Found no subterm matching @term in the current goal. This happens if :n:`@term` does not occur in, respectively, the named hypothesis or the goal. .. tacn:: erewrite {+, @oriented_rewriter } {? @occurrences } {? by @ltac_expr3 } Works like :tacn:`rewrite`, but turns unresolved bindings, if any, into existential variables instead of failing. It has the same parameters as :tacn:`rewrite`. .. flag:: Keyed Unification This :term:`flag` makes higher-order unification used by :tacn:`rewrite` rely on a set of keys to drive unification. The subterms, considered as rewriting candidates, must start with the same key as the left- or right-hand side of the lemma given to rewrite, and the arguments are then unified up to full reduction. .. cmd:: Declare Equivalent Keys @one_term @one_term :undocumented: .. cmd:: Print Equivalent Keys :undocumented: .. tacn:: rewrite * {? {| -> | <- } } @one_term {? in @ident } {? at @rewrite_occs } {? by @ltac_expr3 } rewrite * {? {| -> | <- } } @one_term at @rewrite_occs in @ident {? by @ltac_expr3 } :name: rewrite *; _ :undocumented: .. tacn:: replace {? {| -> | <- } } @one_term__from with @one_term__to {? @occurrences } {? by @ltac_expr3 } replace {? {| -> | <- } } @one_term__from {? @occurrences } :name: replace; _ The first form, when used with `<-` or no arrow, replaces all free occurrences of :n:`@one_term__from` in the current goal with :n:`@one_term__to` and generates an equality :n:`@one_term__to = @one_term__from` as a subgoal. Note that this equality is reversed with respect to the order of the two terms. When used with `->`, it generates instead an equality :n:`@one_term__from = @one_term__to`. When :n:`by @ltac_expr3` is not present, this equality is automatically solved if it occurs among the hypotheses, or if its symmetric form occurs. The second form, with `->` or no arrow, replaces :n:`@one_term__from` with :n:`@term__to` using the first hypothesis whose type has the form :n:`@one_term__from = @term__to`. If `<-` is given, the tactic uses the first hypothesis with the reverse form, i.e. :n:`@term__to = @one_term__from`. :n:`@occurrences` The `type of` and `value of` forms are not supported. Note you must `Require Setoid` to use the `at` clause in :n:`@occurrences`. :n:`by @ltac_expr3` Applies the :n:`@ltac_expr3` to solve the generated equality. .. exn:: Terms do not have convertible types. :undocumented: .. tacn:: substitute {? {| -> | <- } } @one_term_with_bindings :undocumented: .. tacn:: subst {* @ident } For each :n:`@ident`, in order, for which there is a hypothesis in the form :n:`@ident = @term` or :n:`@term = @ident`, replaces :n:`@ident` with :n:`@term` everywhere in the hypotheses and the conclusion and clears :n:`@ident` and the hypothesis from the context. If there are multiple hypotheses that match the :n:`@ident`, the first one is used. If no :n:`@ident` is given, replacement is done for all hypotheses in the appropriate form in top to bottom order. If :n:`@ident` is a :term:`local definition ` of the form :n:`@ident := @term`, it is also unfolded and cleared. If :n:`@ident` is a section variable it must have no indirect occurrences in the goal, i.e. no global declarations implicitly depending on the section variable may be present in the goal. .. note:: If the hypothesis is itself dependent in the goal, it is replaced by the proof of reflexivity of equality. .. flag:: Regular Subst Tactic This :term:`flag` controls the behavior of :tacn:`subst`. When it is activated (it is by default), :tacn:`subst` also deals with the following corner cases: + A context with ordered hypotheses :n:`@ident__1 = @ident__2` and :n:`@ident__1 = t`, or :n:`t′ = @ident__1` with `t′` not a variable, and no other hypotheses of the form :n:`@ident__2 = u` or :n:`u = @ident__2`; without the flag, a second call to subst would be necessary to replace :n:`@ident__2` by `t` or `t′` respectively. + The presence of a recursive equation which without the flag would be a cause of failure of :tacn:`subst`. + A context with cyclic dependencies as with hypotheses :n:`@ident__1 = f @ident__2` and :n:`@ident__2 = g @ident__1` which without the flag would be a cause of failure of :tacn:`subst`. Additionally, it prevents a :term:`local definition ` such as :n:`@ident := t` from being unfolded which otherwise would exceptionally unfold in configurations containing hypotheses of the form :n:`@ident = u`, or :n:`u′ = @ident` with `u′` not a variable. Finally, it preserves the initial order of hypotheses, which without the flag it may break. .. exn:: Cannot find any non-recursive equality over @ident. :undocumented: .. exn:: Section variable @ident occurs implicitly in global declaration @qualid present in hypothesis @ident. Section variable @ident occurs implicitly in global declaration @qualid present in the conclusion. Raised when the variable is a section variable with indirect dependencies in the goal. If :n:`@ident` is a section variable, it must not have any indirect occurrences in the goal, i.e. no global declarations implicitly depending on the section variable may be present in the goal. .. tacn:: simple subst :undocumented: .. tacn:: stepl @one_term {? by @ltac_expr } For chaining rewriting steps. It assumes a goal in the form :n:`R @term__1 @term__2` where ``R`` is a binary relation and relies on a database of lemmas of the form :g:`forall x y z, R x y -> eq x z -> R z y` where `eq` is typically a setoid equality. The application of :n:`stepl @one_term` then replaces the goal by :n:`R @one_term @term__2` and adds a new goal stating :n:`eq @one_term @term__1`. If :n:`@ltac_expr` is specified, it is applied to the side condition. .. cmd:: Declare Left Step @one_term Adds :n:`@one_term` to the database used by :tacn:`stepl`. This tactic is especially useful for parametric setoids which are not accepted as regular setoids for :tacn:`rewrite` and :tacn:`setoid_replace` (see :ref:`Generalizedrewriting`). .. tacn:: stepr @one_term {? by @ltac_expr } This behaves like :tacn:`stepl` but on the right hand side of the binary relation. Lemmas are expected to be in the form :g:`forall x y z, R x y -> eq y z -> R x z`. .. cmd:: Declare Right Step @one_term Adds :n:`@term` to the database used by :tacn:`stepr`. Rewriting with definitional equality ------------------------------------ .. tacn:: change {? @one_term__from {? at @occs_nums } with } @one_term__to {? @occurrences } Replaces terms with other :term:`convertible` terms. If :n:`@one_term__from` is not specified, then :n:`@one_term__to` replaces the conclusion and/or the specified hypotheses. If :n:`@one_term__from` is specified, the tactic replaces occurrences of :n:`@one_term__to` within the conclusion and/or the specified hypotheses. :n:`{? @one_term__from {? at @occs_nums } with }` Replaces the occurrences of :n:`@one_term__from` specified by :n:`@occs_nums` with :n:`@one_term__to`, provided that the two :n:`@one_term`\s are convertible. :n:`@one_term__from` may contain pattern variables such as `?x`, whose value which will substituted for `x` in :n:`@one_term__to`, such as in `change (f ?x ?y) with (g (x, y))` or `change (fun x => ?f x) with f`. The `at … with …` form is deprecated in 8.14; use `with … at …` instead. For `at … with … in H |-`, use `with … in H at … |-`. :n:`@occurrences` If `with` is not specified, :n:`@occurrences` must only specify entire hypotheses and/or the goal; it must not include any :n:`at @occs_nums` clauses. .. exn:: Not convertible. :undocumented: .. exn:: Found an "at" clause without "with" clause :undocumented: .. tacn:: now_show @one_type A synonym for :n:`change @one_type`. It can be used to make some proof steps explicit when refactoring a proof script to make it readable. .. seealso:: :ref:`applyingconversionrules` .. tacn:: change_no_check {? @one_term__from {? at @occs_nums } with } @one_term__to {? @occurrences } For advanced usage. Similar to :tacn:`change`, but as an optimization, it skips checking that :n:`@one_term__to` is convertible with the goal or :n:`@one_term__from`. Recall that the Coq kernel typechecks proofs again when they are concluded to ensure correctness. Hence, using :tacn:`change` checks convertibility twice overall, while :tacn:`change_no_check` can produce ill-typed terms, but checks convertibility only once. Hence, :tacn:`change_no_check` can be useful to speed up certain proof scripts, especially if one knows by construction that the argument is indeed convertible to the goal. In the following example, :tacn:`change_no_check` replaces :g:`False` with :g:`True`, but :cmd:`Qed` then rejects the proof, ensuring consistency. .. example:: .. coqtop:: all abort fail Goal False. change_no_check True. exact I. Qed. .. example:: .. coqtop:: all abort fail Goal True -> False. intro H. change_no_check False in H. exact H. Qed. .. _applyingconversionrules: Applying conversion rules ------------------------- These tactics apply reductions and expansions, replacing :term:`convertible` subterms with others that are equal by definition in |CiC|. They implement different specialized uses of the :tacn:`change` tactic. Other ways to apply these reductions are through the :cmd:`Eval` command, the `Eval` clause in the :cmd:`Definition`/:cmd:`Example` command and the :tacn:`eval` tactic. Tactics described in this section include: - :tacn:`lazy` and :tacn:`cbv`, which allow precise selection of which reduction rules to apply - :tacn:`simpl` and :tacn:`cbn`, which are "clever" tactics meant to give the most readable result - :tacn:`hnf` and :tacn:`red`, which apply reduction rules only to the head of the term - :tacn:`vm_compute` and :tacn:`native_compute`, which are performance-oriented. Conversion tactics, with two exceptions, only change the types and contexts of existential variables and leave the proof term unchanged. (The :tacn:`vm_compute` and :tacn:`native_compute` tactics change existential variables in a way similar to other conversions while also adding a single explicit cast to the proof term to tell the kernel which reduction engine to use. See :ref:`type-cast`.) For example: .. coqtop:: all Goal 3 + 4 = 7. Show Proof. Show Existentials. cbv. Show Proof. Show Existentials. .. coqtop:: none Abort. .. tacn:: lazy {? @reductions } @simple_occurrences cbv {? @reductions } @simple_occurrences .. insertprodn reductions delta_reductions .. prodn:: reductions ::= {+ @reduction } | {? head } @delta_reductions reduction ::= head | beta | delta {? @delta_reductions } | match | fix | cofix | iota | zeta delta_reductions ::= {? - } [ {+ @reference } ] Normalize the goal as specified by :n:`@reductions`. If no reductions are specified by name, all reductions are applied. If any reductions are specified by name, then only the named reductions are applied. The reductions include: `head` Do only head reduction, without going under binders. Supported by :tacn:`simpl`, :tacn:`cbv`, :tacn:`cbn` and :tacn:`lazy`. If this is the only specified reduction, all other reductions are applied. `beta` :term:`beta-reduction` of functional application :n:`delta {? @delta_reductions }` :term:`delta-reduction`: unfolding of transparent constants, see :ref:`controlling-the-reduction-strategies`. The form in :n:`@reductions` without the keyword `delta` includes `beta`, `iota` and `zeta` reductions in addition to `delta` using the given :n:`@delta_reductions`. :n:`{? - } [ {+ @reference } ]` without the `-`, limits delta unfolding to the listed constants. If the `-` is present, unfolding is applied to all constants that are not listed. Notice that the ``delta`` doesn't apply to variables bound by a let-in construction inside the term itself (use ``zeta`` to inline these). Opaque constants are never unfolded except by :tacn:`vm_compute` and :tacn:`native_compute` (see `#4476 `_ and :ref:`controlling-the-reduction-strategies`). `iota` :term:`iota-reduction` of pattern matching (`match`) over a constructed term and reduction of :g:`fix` and :g:`cofix` expressions. Shorthand for `match fix cofix`. `zeta` :term:`zeta-reduction`: reduction of :ref:`let-in definitions ` Normalization is done by first evaluating the head of the expression into :gdef:`weak-head normal form`, i.e. until the evaluation is blocked by a variable, an opaque constant, an axiom, such as in :n:`x u__1 … u__n`, :g:`match x with … end`, :g:`(fix f x {struct x} := …) x`, a constructed form (a :math:`\lambda`-expression, constructor, cofixpoint, inductive type, product type or sort) or a redex for which flags prevent reduction of the redex. Once a weak-head normal form is obtained, subterms are recursively reduced using the same strategy. There are two strategies for reduction to weak-head normal form: *lazy* (the :tacn:`lazy` tactic), or *call-by-value* (the :tacn:`cbv` tactic). The lazy strategy is a `call by need `_ strategy, with sharing of reductions: the arguments of a function call are weakly evaluated only when necessary, and if an argument is used several times then it is weakly computed only once. This reduction is efficient for reducing expressions with dead code. For instance, the proofs of a proposition :g:`exists x. P(x)` reduce to a pair of a witness :g:`t` and a proof that :g:`t` satisfies the predicate :g:`P`. Most of the time, :g:`t` may be computed without computing the proof of :g:`P(t)`, thanks to the lazy strategy. .. flag:: Kernel Term Sharing Turning this flag off disables the sharing of computations in :tacn:`lazy`, making it a call-by-name reduction. This also affects the reduction procedure used by the kernel when typechecking. By default sharing is activated. The call-by-value strategy is the one used in ML languages: the arguments of a function call are systematically weakly evaluated first. The lazy strategy is similar to how Haskell reduces terms. Although the lazy strategy always does fewer reductions than the call-by-value strategy, the latter is generally more efficient for evaluating purely computational expressions (i.e. with little dead code). .. tacn:: compute {? @delta_reductions } @simple_occurrences A variant form of :tacn:`cbv`. Setting :opt:`Debug` ``"Cbv"`` makes :tacn:`cbv` (and its derivative :tacn:`compute`) print information about the constants it encounters and the unfolding decisions it makes. .. tacn:: simpl {? head } {? @delta_reductions } {? {| @reference_occs | @pattern_occs } } @simple_occurrences .. insertprodn reference_occs pattern_occs .. prodn:: reference_occs ::= @reference {? at @occs_nums } pattern_occs ::= @one_term {? at @occs_nums } Reduces a term to something still readable instead of fully normalizing it. It performs a sort of strong normalization with two key differences: + It unfolds constants only if they lead to an ι-reduction, i.e. reducing a match or unfolding a fixpoint. + When reducing a constant unfolding to (co)fixpoints, the tactic uses the name of the constant the (co)fixpoint comes from instead of the (co)fixpoint definition in recursive calls. :n:`@occs_nums` Selects which occurrences of :n:`@one_term` to process (counting from left to right on the expression printed using the :flag:`Printing All` flag) :n:`@simple_occurrences` Permits selecting whether to reduce the conclusion and/or one or more hypotheses. While the `at` option of :n:`@occurrences` is not allowed here, :n:`@reference_occs` and :n:`@pattern_occs` have a somewhat less flexible `at` option for selecting specific occurrences. :tacn:`simpl` can unfold transparent constants whose name can be reused in recursive calls as well as those designated by :cmd:`Arguments` :n:`@reference … /` commands. For instance, a constant :g:`plus' := plus` may be unfolded and reused in recursive calls, but a constant such as :g:`succ := plus (S O)` is not unfolded unless it was specifically designated in an :cmd:`Arguments` command such as :n:`Arguments succ /.`. :n:`{| @reference_occs | @pattern_occs }` can limit the application of :tacn:`simpl` to: - applicative subterms whose :term:`head` is the constant :n:`@qualid` or is the constant used in the notation :n:`@string` (see :n:`@reference`) - subterms matching a pattern :n:`@one_term` .. tacn:: cbn {? @reductions } @simple_occurrences :tacn:`cbn` was intended to be a more principled, faster and more predictable replacement for :tacn:`simpl`. The main difference is that :tacn:`cbn` may unfold constants even when they cannot be reused in recursive calls: in the previous example, :g:`succ t` is reduced to :g:`S t`. Modifiers such as `simpl never` are also not treated the same, see :ref:`Args_effect_on_unfolding`. Setting :opt:`Debug` ``"RAKAM"`` makes :tacn:`cbn` print various debugging information. ``RAKAM`` is the Refolding Algebraic Krivine Abstract Machine. .. example:: Here are typical examples comparing :tacn:`cbn` and :tacn:`simpl`: .. coqtop:: all Definition add1 (n:nat) := n + 1. Eval simpl in add1 0. Eval cbn in add1 0. Definition pred_add n m := pred (n + m). Eval simpl in pred_add 0 0. Eval cbn in pred_add 0 0. Parameter n : nat. Eval simpl in pred_add 0 n. Eval cbn in pred_add 0 n. .. tacn:: hnf @simple_occurrences Replaces the current goal with its weak-head normal form according to the βδιζ-reduction rules, i.e. it reduces the :term:`head` of the goal until it becomes a product or an irreducible term. All inner βι-redexes are also reduced. While :tacn:`hnf` behaves similarly to :tacn:`simpl` and :tacn:`cbn`, unlike them, it does not recurse into subterms. The behavior of :tacn:`hnf` can be tuned using the :cmd:`Arguments` command. Example: The term :g:`fun n : nat => S n + S n` is not reduced by :n:`hnf`. .. note:: The δ rule only applies to transparent constants (see :ref:`controlling-the-reduction-strategies` on transparency and opacity). .. tacn:: red @simple_occurrences βιζ-reduces the :term:`head constant` of `T`, if possible, in the selected hypotheses and/or the goal which have the form: :n:`{? forall @open_binders , } T` (where `T` does not begin with a `forall`) to :n:`c t__1 … t__n` where :g:`c` is a constant. If :g:`c` is transparent then it replaces :g:`c` with its definition and reduces again until no further reduction is possible. In the term :n:`{? forall @open_binders , } t__1 ... t__n`, where :n:`t__1` is not a :n:`@term_application`, :n:`t__1` is the :gdef:`head` of the term. In a term with the form :n:`{? forall @open_binders , } c t__1 ... t__n`, where :n:`c` is a :term:`constant`, :n:`c` is the :gdef:`head constant`. .. exn:: No head constant to reduce. :undocumented: .. tacn:: unfold {+, @reference_occs } {? @occurrences } Applies :term:`delta-reduction` to the constants specified by each :n:`@reference_occs`. The selected hypotheses and/or goals are then reduced to βιζ-normal form. Use the general reduction tactics if you want to only apply the δ rule, for example :tacn:`cbv` :n:`delta [ @reference ]`. :n:`@reference_occs` If :n:`@reference` is a :n:`@qualid`, it must be a defined transparent constant or :term:`local definition ` (see :ref:`gallina-definitions` and :ref:`controlling-the-reduction-strategies`). If :n:`@reference` is a :n:`@string {? @scope_key}`, the :n:`@string` is the discriminating symbol of a notation (e.g. "+") or an expression defining a notation (e.g. `"_ + _"`) and the notation is an application whose head symbol is an unfoldable constant, then the tactic unfolds it. :n:`@occurrences` If :n:`@occurrences` is specified, the specified occurrences will be replaced in the selected hypotheses and/or goal. Otherwise every occurrence of the constants in the goal is replaced. If multiple :n:`@reference_occs` are given, any `at` clauses must be in the :n:`@reference_occs` rather than in :n:`@occurrences`. .. exn:: Cannot turn {| inductive | constructor } into an evaluable reference. Occurs when trying to unfold something that is defined as an inductive type (or constructor) and not as a definition. .. example:: .. coqtop:: abort all fail Goal 0 <= 1. unfold le. .. exn:: @ident is opaque. Raised if you are trying to unfold a definition that has been marked opaque. .. example:: .. coqtop:: abort all fail Opaque Nat.add. Goal 1 + 0 = 1. unfold Nat.add. .. exn:: Bad occurrence number of @qualid. :undocumented: .. exn:: @qualid does not occur. :undocumented: .. tacn:: fold {+ @one_term } @simple_occurrences First, this tactic reduces each :n:`@one_term` using the :tacn:`red` tactic. Then, every occurrence of the resulting terms in the selected hypotheses and/or goal will be replaced by its associated :n:`@one_term`. This tactic is particularly useful for reversing undesired unfoldings, which may make the goal very hard to read. The undesired unfoldings may be due to the limited capabilities of other reduction tactics. On the other hand, when an unfolded function applied to its argument has been reduced, the :tacn:`fold` tactic doesn't do anything. :tacn:`fold` :n:`@one_term__1 @one_term__2` is equivalent to :n:`fold @one_term__1; fold @one_term__2`. .. example:: :tacn:`fold` doesn't always undo :tacn:`unfold` .. coqtop:: all Goal ~0=0. unfold not. This :tacn:`fold` doesn't undo the preceeding :tacn:`unfold` (it makes no change): .. coqtop:: all fold not. However, this :tacn:`pattern` followed by :tacn:`fold` does: .. coqtop:: all abort pattern (0 = 0). fold not. .. example:: Use :tacn:`fold` to reverse unfolding of `fold_right` .. coqtop:: none Require Import Coq.Lists.List. Local Open Scope list_scope. .. coqtop:: all abort Goal forall x xs, fold_right and True (x::xs). red. fold (fold_right and True). .. tacn:: pattern {+, @pattern_occs } {? @occurrences } Performs beta-expansion (the inverse of :term:`beta-reduction`) for the selected hypotheses and/or goals. The :n:`@one_term`\s in :n:`@pattern_occs` must be free subterms in the selected items. The expansion is done for each selected item :g:`T` for a set of :n:`@one_term`\s in the :n:`@pattern_occs` by: + replacing all selected occurrences of the :n:`@one_term`\s in :g:`T` with fresh variables + abstracting these variables + applying the abstracted goal to the :n:`@one_term`\s For instance, if the current goal :g:`T` is expressible as :n:`φ(t__1 … t__n)` where the notation captures all the instances of the :n:`t__i` in φ, then :tacn:`pattern` :n:`t__1, …, t__n` generates the equivalent goal :n:`(fun (x__1:A__1 … (x__n:A__n) => φ(x__1 … x__n)) t__1 … t__n`. If :n:`t__i` occurs in one of the generated types :n:`A__j` (for `j > i`), occurrences will also be considered and possibly abstracted. This tactic can be used, for instance, when the tactic :tacn:`apply` fails on matching or to better control the behavior of :tacn:`rewrite`. See the example :ref:`here `. Fast reduction tactics: vm_compute and native_compute ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ :tacn:`vm_compute` is a brute-force but efficient tactic that first normalizes the terms before comparing them. It is based on a bytecode representation of terms similar to the bytecode representation used in the ZINC virtual machine :cite:`Leroy90`. It is especially useful for intensive computation of algebraic values, such as numbers, and for reflection-based tactics. :tacn:`native_compute` is based on on converting the Coq code to OCaml. Note that both these tactics ignore :cmd:`Opaque` markings (see issue `#4776 `_), nor do they apply unfolding strategies such as from :cmd:`Strategy`. :tacn:`native_compute` is typically two to five times faster than :tacn:`vm_compute` at applying conversion rules when Coq is running native code, but :tacn:`native_compute` requires considerably more overhead. We recommend using :tacn:`native_compute` when all of the following are true (otherwise use :tacn:`vm_compute`): - the running time in :tacn:`vm_compute` at least 5-10 seconds - the size of the input term is small (e.g. hand-generated code rather than automatically-generated code that may have nested destructs on inductives with dozens or hundreds of constructors) - the output is small (e.g. you're returning a boolean, a natural number or an integer rather than a large abstract syntax tree) These tactics change existential variables in a way similar to other conversions while also adding a single explicit cast (see :ref:`type-cast`) to the proof term to tell the kernel which reduction engine to use. .. tacn:: vm_compute {? {| @reference_occs | @pattern_occs } } {? @occurrences } Evaluates the goal using the optimized call-by-value evaluation bytecode-based virtual machine described in :cite:`CompiledStrongReduction`. This algorithm is dramatically more efficient than the algorithm used for the :tacn:`cbv` tactic, but it cannot be fine-tuned. It is especially useful for full evaluation of algebraic objects. This includes the case of reflection-based tactics. .. tacn:: native_compute {? {| @reference_occs | @pattern_occs } } {? @occurrences } Evaluates the goal by compilation to OCaml as described in :cite:`FullReduction`. Depending on the configuration, this tactic can either default to :tacn:`vm_compute`, recompile dependencies or fail due to some missing precompiled dependencies, see :ref:`the native-compiler option ` for details. .. flag:: NativeCompute Timing This :term:`flag` causes all calls to the native compiler to print timing information for the conversion to native code, compilation, execution, and reification phases of native compilation. Timing is printed in units of seconds of wall-clock time. .. flag:: NativeCompute Profiling On Linux, if you have the ``perf`` profiler installed, this :term:`flag` makes it possible to profile :tacn:`native_compute` evaluations. .. opt:: NativeCompute Profile Filename @string This :term:`option` specifies the profile output; the default is ``native_compute_profile.data``. The actual filename used will contain extra characters to avoid overwriting an existing file; that filename is reported to the user. That means you can individually profile multiple uses of :tacn:`native_compute` in a script. From the Linux command line, run ``perf report`` on the profile file to see the results. Consult the ``perf`` documentation for more details. Computing in a term: eval and Eval ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Evaluation of a term can be performed with: .. tacn:: eval @red_expr in @term .. insertprodn red_expr red_expr .. prodn:: red_expr ::= lazy {? @reductions } | cbv {? @reductions } | compute {? @delta_reductions } | vm_compute {? {| @reference_occs | @pattern_occs } } | native_compute {? {| @reference_occs | @pattern_occs } } | red | hnf | simpl {? head } {? @delta_reductions } {? {| @reference_occs | @pattern_occs } } | cbn {? @reductions } | unfold {+, @reference_occs } | fold {+ @one_term } | pattern {+, @pattern_occs } | @ident :tacn:`eval` is a :token:`value_tactic`. It returns the result of applying the conversion rules specified by :n:`@red_expr`. It does not change the proof state. The :n:`@red_expr` alternatives that begin with a keyword correspond to the tactic with the same name, though in several cases with simpler syntax than the tactic. :n:`@ident` is a named reduction expression created with :cmd:`Declare Reduction`. .. seealso:: Section :ref:`applyingconversionrules`. .. cmd:: Eval @red_expr in @term Performs the specified reduction on :n:`@term` and displays the resulting term with its type. If a proof is open, :n:`@term` may reference hypotheses of the selected goal. :cmd:`Eval` is a :token:`query_command`, so it may be prefixed with a goal selector. .. cmd:: Compute @term Evaluates :n:`@term` using the bytecode-based virtual machine. It is a shortcut for :cmd:`Eval` :n:`vm_compute in @term`. :cmd:`Compute` is a :token:`query_command`, so it may be prefixed with a goal selector. .. cmd:: Declare Reduction @ident := @red_expr Declares a short name for the reduction expression :n:`@red_expr`, for instance ``lazy beta delta [foo bar]``. This short name can then be used in :n:`Eval @ident in` or ``eval`` constructs. This command accepts the :attr:`local` attribute, which indicates that the reduction will be discarded at the end of the file or module. The name is not qualified. In particular declaring the same name in several modules or in several functor applications will be rejected if these declarations are not local. The name :n:`@ident` cannot be used directly as an Ltac tactic, but nothing prevents the user from also performing a :n:`Ltac @ident := @red_expr`. .. _controlling-the-reduction-strategies: Controlling reduction strategies and the conversion algorithm ------------------------------------------------------------- The commands to fine-tune the reduction strategies and the lazy conversion algorithm are described in this section. Also see :ref:`Args_effect_on_unfolding`, which supports additional fine-tuning. .. cmd:: Opaque {? ! } {+ @reference } Marks the specified constants as :term:`opaque` so tactics won't :term:`unfold` them with :term:`delta-reduction`. "Constants" are items defined by commands such as :cmd:`Definition`, :cmd:`Let` (with an explicit body), :cmd:`Fixpoint`, :cmd:`CoFixpoint` and :cmd:`Function`. This command accepts the :attr:`global` attribute. By default, the scope of :cmd:`Opaque` is limited to the current section or module. :cmd:`Opaque` also affects Coq's conversion algorithm, causing it to delay unfolding the specified constants as much as possible when it has to check that two distinct applied constants are convertible. See Section :ref:`conversion-rules`. In the particular case where the constants refer to primitive projections, a :token:`!` can be used to make the compatibility constants opaque, while by default the projection themselves are made opaque and the compatibility constants always remain transparent. This mechanism is only intended for debugging purposes. .. cmd:: Transparent {? ! } {+ @reference } The opposite of :cmd:`Opaque`, it marks the specified constants as :term:`transparent` so that tactics may unfold them. See :cmd:`Opaque` above. This command accepts the :attr:`global` attribute. By default, the scope of :cmd:`Transparent` is limited to the current section or module. Note that constants defined by proofs ending with :cmd:`Qed` are irreversibly opaque; :cmd:`Transparent` will not make them transparent. This is consistent with the usual mathematical practice of *proof irrelevance*: what matters in a mathematical development is the sequence of lemma statements, not their actual proofs. This distinguishes lemmas from the usual defined constants, whose actual values are of course relevant in general. In the particular case where the constants refer to primitive projections, a :token:`!` can be used to make the compatibility constants transparent (see :cmd:`Opaque` for more details). .. exn:: The reference @qualid was not found in the current environment. There is no constant named :n:`@qualid` in the environment. .. seealso:: :ref:`applyingconversionrules`, :cmd:`Qed` and :cmd:`Defined` .. _vernac-strategy: .. cmd:: Strategy {+ @strategy_level [ {+ @reference } ] } .. insertprodn strategy_level strategy_level .. prodn:: strategy_level ::= opaque | @integer | expand | transparent Generalizes the behavior of the :cmd:`Opaque` and :cmd:`Transparent` commands. It is used to fine-tune the strategy for unfolding constants, both at the tactic level and at the kernel level. This command associates a :n:`@strategy_level` with the qualified names in the :n:`@reference` sequence. Whenever two expressions with two distinct :term:`head constants ` are compared (for example, typechecking `f x` where `f : A -> B` and `x : C` will result in converting `A` and `C`), the one with lower level is expanded first. In case of a tie, the second one (appearing in the cast type) is expanded. This command accepts the :attr:`local` attribute, which limits its effect to the current section or module, in which case the section and module behavior is the same as :cmd:`Opaque` and :cmd:`Transparent` (without :attr:`global`). Levels can be one of the following (higher to lower): + ``opaque`` : level of opaque constants. They cannot be expanded by tactics (behaves like +∞, see next item). + :n:`@integer` : levels indexed by an integer. Level 0 corresponds to the default behavior, which corresponds to transparent constants. This level can also be referred to as ``transparent``. Negative levels correspond to constants to be expanded before normal transparent constants, while positive levels correspond to constants to be expanded after normal transparent constants. + ``expand`` : level of constants that should be expanded first (behaves like −∞) + ``transparent`` : Equivalent to level 0 .. cmd:: Print Strategy @reference This command prints the strategy currently associated with :n:`@reference`. It fails if :n:`@reference` is not an unfoldable reference, that is, neither a variable nor a constant. .. exn:: The reference is not unfoldable. :undocumented: .. cmd:: Print Strategies Print all the currently non-transparent strategies. .. tacn:: with_strategy @strategy_level_or_var [ {+ @reference } ] @ltac_expr3 .. insertprodn strategy_level_or_var strategy_level_or_var .. prodn:: strategy_level_or_var ::= @strategy_level | @ident Executes :token:`ltac_expr3`, applying the alternate unfolding behavior that the :cmd:`Strategy` command controls, but only for :token:`ltac_expr3`. This can be useful for guarding calls to reduction in tactic automation to ensure that certain constants are never unfolded by tactics like :tacn:`simpl` and :tacn:`cbn` or to ensure that unfolding does not fail. .. example:: .. coqtop:: all reset abort Opaque id. Goal id 10 = 10. Fail unfold id. with_strategy transparent [id] unfold id. .. warning:: Use this tactic with care, as effects do not persist past the end of the proof script. Notably, this fine-tuning of the conversion strategy is not in effect during :cmd:`Qed` nor :cmd:`Defined`, so this tactic is most useful either in combination with :tacn:`abstract`, which will check the proof early while the fine-tuning is still in effect, or to guard calls to conversion in tactic automation to ensure that, e.g., :tacn:`unfold` does not fail just because the user made a constant :cmd:`Opaque`. This can be illustrated with the following example involving the factorial function. .. coqtop:: in reset Fixpoint fact (n : nat) : nat := match n with | 0 => 1 | S n' => n * fact n' end. Suppose now that, for whatever reason, we want in general to unfold the :g:`id` function very late during conversion: .. coqtop:: in Strategy 1000 [id]. If we try to prove :g:`id (fact n) = fact n` by :tacn:`reflexivity`, it will now take time proportional to :math:`n!`, because Coq will keep unfolding :g:`fact` and :g:`*` and :g:`+` before it unfolds :g:`id`, resulting in a full computation of :g:`fact n` (in unary, because we are using :g:`nat`), which takes time :math:`n!`. We can see this cross the relevant threshold at around :math:`n = 9`: .. coqtop:: all abort Goal True. Time assert (id (fact 8) = fact 8) by reflexivity. Time assert (id (fact 9) = fact 9) by reflexivity. Note that behavior will be the same if you mark :g:`id` as :g:`Opaque` because while most reduction tactics refuse to unfold :g:`Opaque` constants, conversion treats :g:`Opaque` as merely a hint to unfold this constant last. We can get around this issue by using :tacn:`with_strategy`: .. coqtop:: all Goal True. Fail Timeout 1 assert (id (fact 100) = fact 100) by reflexivity. Time assert (id (fact 100) = fact 100) by with_strategy -1 [id] reflexivity. However, when we go to close the proof, we will run into trouble, because the reduction strategy changes are local to the tactic passed to :tacn:`with_strategy`. .. coqtop:: all abort fail exact I. Timeout 1 Defined. We can fix this issue by using :tacn:`abstract`: .. coqtop:: all Goal True. Time assert (id (fact 100) = fact 100) by with_strategy -1 [id] abstract reflexivity. exact I. Time Defined. On small examples this sort of behavior doesn't matter, but because Coq is a super-linear performance domain in so many places, unless great care is taken, tactic automation using :tacn:`with_strategy` may not be robustly performant when scaling the size of the input. .. warning:: In much the same way this tactic does not play well with :cmd:`Qed` and :cmd:`Defined` without using :tacn:`abstract` as an intermediary, this tactic does not play well with ``coqchk``, even when used with :tacn:`abstract`, due to the inability of tactics to persist information about conversion hints in the proof term. See `#12200 `_ for more details. coq-8.20.0/doc/sphinx/proofs/writing-proofs/index.rst000066400000000000000000000016351466560755400226320ustar00rootroot00000000000000.. _writing-proofs: =================== Basic proof writing =================== 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 theorem. The first section presents the proof mode (the core mechanism of the dialog between the user and the proof assistant). Then, several sections describe the available tactics. The last section covers the SSReflect proof language, which provides a consistent alternative set of tactics to the standard basic tactics. Additional tactics are documented in the next chapter :ref:`automatic-tactics`. .. toctree:: :maxdepth: 1 proof-mode ../../proof-engine/tactics equality reasoning-inductives ../../proof-engine/ssreflect-proof-language coq-8.20.0/doc/sphinx/proofs/writing-proofs/proof-mode.rst000066400000000000000000001352501466560755400235730ustar00rootroot00000000000000.. _proofhandling: ---------- Proof mode ---------- :gdef:`Proof mode ` is used to prove theorems. Coq enters proof mode when you begin a proof, such as with the :cmd:`Theorem` command. It exits proof mode when you complete a proof, such as with the :cmd:`Qed` command. Tactics, which are available only in proof mode, incrementally transform incomplete proofs to eventually generate a complete proof. When you run Coq interactively, such as through CoqIDE, Proof General or coqtop, Coq shows the current proof state (the incomplete proof) as you enter tactics. This information isn't shown when you run Coq in batch mode with `coqc`. Proof State ----------- The :gdef:`proof state` consists of one or more unproven goals. Each goal has a :gdef:`conclusion` (the statement that is to be proven) and a :gdef:`local context`, which contains named :term:`hypotheses ` (which are propositions), variables and local definitions that can be used in proving the conclusion. The proof may also use *constants* from the :term:`global environment` such as definitions and proven theorems. .. _conclusion_meaning_2: (Note that *conclusion* is also used to refer to the last part of an implication. For example, in `A -> B -> C`, `A` and `B` are :term:`premises ` and `C` is the conclusion.) The term ":gdef:`goal`" may refer to an entire goal or to the conclusion of a goal, depending on the context. The conclusion appears below a line and the local context appears above the line. The conclusion is a type. Each item in the local context begins with a name and ends, after a colon, with an associated type. :gdef:`Local definitions ` are shown in the form `n := 0 : nat`, for example, in which `nat` is the type of `0`. The local context of a goal contains items specific to the goal as well as section-local variables and hypotheses (see :ref:`gallina-assumptions`) defined in the current :ref:`section `. The latter are included in the initial proof state. Items in the local context are ordered; an item can only refer to items that appear before it. (A more mathematical description of the *local context* is :ref:`here `.) The :gdef:`global environment` has definitions and proven theorems that are global in scope. (A more mathematical description of the *global environment* is :ref:`here `.) When you begin proving a theorem, the proof state shows the statement of the theorem below the line and often nothing in the local context: .. coqtop:: none Parameter P: nat -> Prop. .. coqtop:: out Goal forall n m: nat, n > m -> P 1 /\ P 2. After applying the :tacn:`intros` :term:`tactic`, we see hypotheses above the line. The names of variables (`n` and `m`) and hypotheses (`H`) appear before a colon, followed by their type. The type doesn't have to be a provable statement. For example, `0 = 1` and `False` are both valid and useful types. .. coqtop:: all intros. Some tactics, such as :tacn:`split`, create new goals, which may be referred to as :gdef:`subgoals ` for clarity. Goals are numbered from 1 to N at each step of the proof to permit applying a tactic to specific goals. The local context is only shown for the first goal. .. coqtop:: all split. :gdef:`"Variables" ` may refer specifically to local context items introduced from :n:`forall` variables for which the type of their type is `Set` or `Type`. :gdef:`"Hypotheses" ` refers to items that are :term:`propositions `, for which the type of their type is `Prop` or `SProp`, but these terms are also used interchangeably. .. coqtop:: out let t_n := type of n in idtac "type of n :" t_n; let tt_n := type of t_n in idtac "type of" t_n ":" tt_n. let t_H := type of H in idtac "type of H :" t_H; let tt_H := type of t_H in idtac "type of" t_H ":" tt_H. A proof script, consisting of the tactics that are applied to prove a theorem, is often informally referred to as a "proof". The real proof, whether complete or incomplete, is the associated term, the :gdef:`proof term`, which users may occasionally want to examine. (This is based on the *Curry-Howard isomorphism* :cite:`How80,Bar81,Gir89,H89`, which is a correspondence between between proofs and terms and between :term:`propositions ` and types of λ-calculus. The isomorphism is also sometimes called the "propositions-as-types correspondence".) The :cmd:`Show Proof` command displays the incomplete proof term before you've completed the proof. For example, here's the proof term after using the :tacn:`split` tactic above: .. coqtop:: all Show Proof. The incomplete parts, the goals, are represented by :term:`existential variables ` with names that begin with `?Goal`. (Note that some existential variables are not goals.) The :cmd:`Show Existentials` command shows each existential with the hypotheses and conclusion for the associated goal. .. coqtop:: all Show Existentials. Users can control which goals are displayed in the context by :term:`focusing ` goals. Focusing lets the user (initially) pick a single goal to work on. Focusing operations can be nested. Tactics such as :tacn:`eapply` create existential variables as placeholders for undetermined variables that become :term:`shelved ` goals. Shelved goals are not shown in the context by default, but they can be unshelved to make them visible. Other tactics may automatically resolve these goals (whether shelved or not); the purpose of shelving is to hide goals that the user usually doesn't need to think about. See :ref:`existential-variables` and :ref:`this example `. Coq's kernel verifies the correctness of proof terms when it exits proof mode by checking that the proof term is :term:`well-typed` and that its type is the same as the theorem statement. After a proof is completed, :cmd:`Print` `` shows the proof term and its type. The type appears after the colon (`forall ...`), as for this theorem from Coq's standard library: .. coqtop:: all Print proj1. .. note:: Many tactics accept :n:`@term`\s as arguments and frequently refer to them with wording such as "the type of :token:`term`". When :n:`@term` is the name of a theorem or lemma, this wording refers to the type of the proof term, which is what's given in the :cmd:`Theorem` statement. When :n:`@term` is the name of a hypothesis, the wording refers to the type shown in the context for the hypothesis (i.e., after the colon). For terms that are more complex than just an :token:`ident`, you can use :cmd:`Check` :n:`@term` to display their type. .. _proof-editing-mode: Entering and exiting proof mode ------------------------------- Coq enters :term:`proof mode` when you begin a proof through commands such as :cmd:`Theorem` or :cmd:`Goal`. Coq user interfaces usually have a way to indicate that you're in proof mode. :term:`Tactics ` are available only in proof mode (currently they give syntax errors outside of proof mode). Most :term:`commands ` can be used both in and out of proof mode, but some commands only work in or outside of proof mode. When the proof is completed, you can exit proof mode with commands such as :cmd:`Qed`, :cmd:`Defined` and :cmd:`Save`. .. cmd:: Goal @type Asserts an unnamed proposition. This is intended for quick tests that a proposition is provable. If the proof is eventually completed and validated, you can assign a name with the :cmd:`Save` or :cmd:`Defined` commands. If no name is given, the name will be `Unnamed_thm` (or, if that name is already defined, a variant of that). .. cmd:: Qed Passes a completed :term:`proof term` to Coq's kernel to check that the proof term is :term:`well-typed` and to verify that its type matches the theorem statement. If it's verified, the proof term is added to the global environment as an :term:`opaque` constant using the declared name from the original goal. It's very rare for a proof term to fail verification. Generally this indicates a bug in a tactic you used or that you misused some unsafe tactics. .. exn:: Attempt to save an incomplete proof. :undocumented: .. exn:: No focused proof (No proof-editing in progress). You tried to use a proof mode command such as :cmd:`Qed` outside of proof mode. .. note:: Sometimes an error occurs when building the proof term, because tactics do not enforce completely the term construction constraints. The user should also be aware of the fact that since the proof term is completely rechecked at this point, one may have to wait a while when the proof is large. In some exceptional cases one may even incur a memory overflow. .. cmd:: Save @ident Similar to :cmd:`Qed`, except that the proof term is added to the global context 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 :term:`transparent`, which means that its content can be explicitly used for type checking and that it can be unfolded in conversion tactics (see :ref:`applyingconversionrules`, :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 proof mode to give up the current proof and declare the initial goal as an axiom. .. cmd:: Abort {? All } Aborts the current proof. If the current proof is a nested proof, the previous proof becomes current. If :n:`All` is given, all nested proofs are aborted. See :flag:`Nested Proofs Allowed`. :n:`All` Aborts all current proofs. .. cmd:: Proof @term :name: Proof `term` This command applies in proof mode. It is equivalent to :n:`exact @term. Qed.` That is, you have to give the full proof in one gulp, as a proof term (see Section :ref:`applyingtheorems`). .. warning:: Use of this command is discouraged. In particular, it doesn't work in Proof General because it must immediately follow the command that opened proof mode, but Proof General inserts :cmd:`Unset` :flag:`Silent` before it (see `Proof General issue #498 `_). .. cmd:: Proof Is a no-op which is useful to delimit the sequence of tactic commands which start a proof, after a :cmd:`Theorem` command. It is a good practice to use :cmd:`Proof` as an opening parenthesis, closed in the script with a closing :cmd:`Qed`. .. seealso:: :cmd:`Proof with` .. cmd:: Proof using @section_var_expr {? with @ltac_expr } .. insertprodn section_var_expr starred_ident_ref .. 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 mode, declaring the set of :ref:`section ` variables (see :ref:`gallina-assumptions`) used by the proof. These :ref:`proof annotations ` are useful to enable asynchronous processing of proofs. This :ref:`example ` shows how they work. The :cmd:`Qed` command verifies that the set of section variables used in the proof is a subset of the declared ones. The set of declared variables is closed under type dependency. For example, if ``T`` is a variable and ``a`` is a variable of type ``T``, then the commands ``Proof using a`` and ``Proof using T a`` are equivalent. The set of declared variables always includes the variables used by the statement. In other words ``Proof using e`` is equivalent to ``Proof using Type + e`` for any declaration expression ``e``. :n:`- @section_var_expr50` Use all section variables except those specified by :n:`@section_var_expr50` :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. :n:`@section_var_expr0 - @section_var_expr0` Use section variables which are in the first collection but not in the second one. :n:`{? * }` Use the transitive closure of the specified collection. :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``. :n:`All` Use all section variables. .. warn:: @ident is both name of a Collection and Variable, Collection @ident takes precedence over Variable. If a specified name is ambiguous (it could be either a :cmd:`Collection` or a :cmd:`Variable`), then it is assumed to be a :cmd:`Collection` name. .. warn:: Variable All is shadowed by Collection named All containing all variables. This is variant of the previous warning for the **All** collection. .. seealso:: :ref:`tactics-implicit-automation` .. attr:: using This :term:`attribute` can be applied to the :cmd:`Definition`, :cmd:`Example`, :cmd:`Fixpoint` and :cmd:`CoFixpoint` commands as well as to :cmd:`Lemma` and its variants. It takes a :n:`@section_var_expr`, in quotes, as its value. This is equivalent to specifying the same :n:`@section_var_expr` in :cmd:`Proof using`. .. example:: .. coqtop:: all reset Section Test. Variable n : nat. Hypothesis Hn : n <> 0. #[using="Hn"] Lemma example : 0 < n. .. coqtop:: in Abort. End Test. .. _example-print-using: .. example :: Declaring section variables When a :ref:`section ` is closed with :cmd:`End`, section variables declared with :cmd:`Proof using` are added to the theorem as additional variables. You can see the effect on the theorem's statement with commands such as :cmd:`Check`, :cmd:`Print` and :cmd:`About` after the section is closed. Currently there is no command that shows the section variables associated with a theorem before the section is closed. Adding the unnecessary section variable `radixNotZero` changes how `foo'` can be applied. .. coqtop :: in Require Import ZArith. Section bar. Variable radix : Z. Hypothesis radixNotZero : (0 < radix)%Z. Lemma foo : 0 = 0. Proof. reflexivity. Qed. Lemma foo' : 0 = 0. Proof using radixNotZero. reflexivity. Qed. (* radixNotZero is not needed *) .. coqtop :: all Print foo'. (* Doesn't show radixNotZero yet *) End bar. Print foo. (* Doesn't change after the End *) Print foo'. (* "End" added type radix (used by radixNotZero) and radixNotZero *) Goal 0 = 0. .. coqtop :: in Fail apply foo'. (* Fails because of the extra variable *) .. coqtop :: all apply (foo' 5). (* Can be used if the extra variable is provided explicitly *) .. coqtop:: abort none Proof using options ``````````````````` The following options modify the behavior of ``Proof using``. .. opt:: Default Proof Using "@section_var_expr" Set this :term:`option` to 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``. Note that :n:`@section_var_expr` isn't validated immediately. An invalid value will generate an error on a subsequent :cmd:`Proof` or :cmd:`Qed` command. .. flag:: Suggest Proof Using When this :term:`flag` is on, :cmd:`Qed` suggests a ``using`` annotation if the user did not provide one. .. _`nameaset`: Name a set of section hypotheses for ``Proof using`` ```````````````````````````````````````````````````` .. 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 compact. .. example:: Define the collection named ``Some`` containing ``x``, ``y`` and ``z``:: Collection Some := x y z. Define the collection named ``Fewer`` containing only ``x`` and ``y``:: Collection Fewer := Some - z Define the collection named ``Many`` containing the set union or set difference of ``Fewer`` and ``Some``:: Collection Many := Fewer + Some Collection Many := Fewer - Some Define the collection named ``Many`` containing the set difference of ``Fewer`` and the unnamed collection ``x y``:: Collection Many := Fewer - (x y) .. deprecated:: 8.15 Redefining a collection, defining a collection with the same name as a variable, and invoking the :cmd:`Proof using` command when collection and variable names overlap are deprecated. See the warnings below and in the :cmd:`Proof using` command. .. exn:: "All" is a predefined collection containing all variables. It can't be redefined. When issuing a :cmd:`Proof using` command, **All** used as a collection name always means "use all variables". .. warn:: New Collection definition of @ident shadows the previous one. Redefining a :cmd:`Collection` overwrites the previous definition. .. warn:: @ident was already a defined Variable, the name @ident will refer to Collection when executing "Proof using" command. The :cmd:`Proof using` command allows specifying both :cmd:`Collection` and :cmd:`Variable` names. In case of ambiguity, a name is assumed to be Collection name. Proof modes ----------- When entering proof mode through commands such as :cmd:`Goal` and :cmd:`Proof`, Coq picks by default the |Ltac| mode. Nonetheless, there exist other proof modes shipped in the standard Coq installation, and furthermore some plugins define 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 This :term:`option` selects the proof mode to use when starting a proof. Depending on the proof mode, various syntactic constructs are allowed when writing a proof. All proof modes support 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 ` Ltac2. :cmd:`Importing ` Ltac2 sets this mode. Some external plugins also define their own proof mode, which can be activated with this command. .. cmd:: Proof Mode @string Sets the proof mode within the current proof. Managing goals -------------- .. cmd:: Undo {? {? To } @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. .. cmd:: Restart Restores the proof to the original goal. .. exn:: No focused proof to restart. :undocumented: .. _focused_goals: Focusing goals `````````````` :gdef:`Focusing ` lets you limit the context display to (initially) a single goal. If a tactic creates additional goals from a focused goal, the subgoals are also focused. The two focusing constructs are :ref:`curly braces ` (`{` and `}`) and :ref:`bullets ` (e.g. `-`, `+` or `*`). These constructs can be nested. .. _curly-braces: Curly braces ~~~~~~~~~~~~ .. tacn:: {? {| @natural | [ @ident ] } : } %{ %} :name: {; } .. 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. Note that when a focused goal is proved a message is displayed together with a suggestion about the right bullet or ``}`` to unfocus it or focus the next goal. :n:`@natural:` Focuses on the :token:`natural`\-th goal to prove. .. _focus_shelved_goal: :n:`[ @ident ]: %{` Focuses on the goal named :token:`ident` even if the goal is not in focus. Goals are :term:`existential variables `, which don't have names by default. You can give a name to a goal by using :n:`refine ?[@ident]`. .. example:: Working with named goals .. coqtop:: in Ltac name_goal name := refine ?[name]. (* for convenience *) Set Printing Goal Names. (* show goal names, e.g. "(?base)" and "(?step)" *) .. coqtop:: all Goal forall n, n + 0 = n. Proof. induction n; [ name_goal base | name_goal step ]. (* focus on the goal named "base" *) [base]: { reflexivity. .. coqtop:: in } This can also be a way of focusing on a shelved goal, for instance: .. coqtop:: all reset Goal exists n : nat, n = n. eexists ?[x]. reflexivity. [x]: exact 0. Qed. .. exn:: This proof is focused, but cannot be unfocused this way. You are trying to use ``}`` but the current subproof has not been fully solved. .. exn:: No such goal (@natural). :undocumented: .. exn:: No such goal (@ident). :undocumented: .. exn:: Brackets do not support multi-goal selectors. 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 for bullets below. .. _bullets: Bullets ~~~~~~~ Alternatively, proofs can be structured with bullets instead of ``{`` and ``}``. The first use of a bullet ``b`` focuses on the first goal ``g``. The same bullet can't be used again until the proof of ``g`` is completed, then the next goal must be focused with another ``b``. Thus, all the goals present just before the first use of the bullet must be focused with the same bullet ``b``. See the example below. Different bullets can be used to nest levels. The scope of each bullet is limited to the enclosing ``{`` and ``}``, so bullets can be reused as further nesting levels provided they are delimited by curly braces. A :production:`bullet` is made from ``-``, ``+`` or ``*`` characters (with no spaces and no period afterward): .. tacn:: {| {+ - } | {+ + } | {+ * } } :undocumented: :name: bullet (- + *) When a focused goal is proved, Coq displays a message suggesting use of ``}`` or the correct matching bullet to unfocus the goal or focus the next subgoal. .. note:: In Proof General (``Emacs`` interface to Coq), you must use bullets with the priority ordering shown above to have correct indentation. For example ``-`` must be the outer bullet and ``+`` the inner one in the example below. .. example:: Use of bullets For the sake of brevity, the output for this example is summarized in comments. Note that the tactic following a bullet is frequently put on the same line with the bullet. Observe that this proof still works even if all the bullets in it are omitted. .. coqtop:: in Goal (1=1 /\ 2=2) /\ 3=3. Proof. split. (* 1 = 1 /\ 2 = 2 and 3 = 3 *) - (* 1 = 1 /\ 2 = 2 *) split. (* 1 = 1 and 2 = 2 *) + (* 1 = 1 *) trivial. (* subproof complete *) + (* 2 = 2 *) trivial. (* subproof complete *) - (* 3 = 3 *) trivial. (* No more subgoals *) Qed. .. exn:: Wrong bullet @bullet__1: Current bullet @bullet__2 is not finished. Before using bullet :n:`@bullet__1` again, you should first finish proving the current focused goal. Note that :n:`@bullet__1` and :n:`@bullet__2` may be the same. .. exn:: Wrong bullet @bullet__1: Bullet @bullet__2 is mandatory here. You must put :n:`@bullet__2` to focus on the next goal. No other bullet is allowed here. .. exn:: No such goal. Focus next goal with bullet @bullet. You tried to apply a tactic but no goals were under focus. Using :n:`@bullet` is mandatory here. .. exn:: No such goal. Try unfocusing with %}. You just finished a goal focused by ``{``, you must unfocus it with ``}``. .. note:: Use :opt:`Default Goal Selector` with the ``!`` selector to force the use of focusing mechanisms (bullets, braces) and goal selectors so that it is always explicit to which goal(s) a tactic is applied. .. opt:: Bullet Behavior {| "None" | "Strict Subproofs" } This :term:`option` controls the bullet behavior and can take two possible values: - "None": this makes bullets inactive. - "Strict Subproofs": this makes bullets active (this is the default behavior). Other focusing commands ~~~~~~~~~~~~~~~~~~~~~~~ .. cmd:: Unfocused Succeeds if there are no unfocused goals. Otherwise the command fails. .. cmd:: Focus {? @natural } Focuses the attention on the first goal to prove or, if :token:`natural` is specified, the :token:`natural`\-th. The printing of the other goals is suspended until the focused goal is solved or unfocused. .. deprecated:: 8.8 Prefer the use of bullets or focusing braces with a goal selector (see above). .. cmd:: Unfocus Restores to focus the goals that were suspended by the last :cmd:`Focus` command. .. deprecated:: 8.8 .. _shelved_goals: Shelving goals `````````````` Goals can be :gdef:`shelved` so they are no longer displayed in the proof state. Shelved goals can be unshelved with the :cmd:`Unshelve` command, which makes all shelved goals visible in the proof state. You can use the goal selector :n:`[ @ident ]: %{` to focus on a single shelved goal (see :ref:`here `). Currently there's no single command or tactic that unshelves goals by name. .. tacn:: shelve Moves the focused goals to the shelf. They will no longer be displayed in the context. The :cmd:`Show Existentials` command will still show these goals, which will be marked "(shelved)". .. tacn:: shelve_unifiable Shelves only the goals under focus that are mentioned in other goals. Goals that appear in the type of other goals can be solved by unification. .. example:: shelve_unifiable .. coqtop:: all abort Goal exists n, n=0. refine (ex_intro _ _ _). all: shelve_unifiable. reflexivity. .. cmd:: Unshelve This command moves all the goals on the shelf (see :tacn:`shelve`) from the shelf into focus, by appending them to the end of the current list of focused goals. .. tacn:: unshelve @ltac_expr1 Performs :n:`@tactic`, then unshelves existential variables added to the shelf by the execution of :n:`@tactic`, prepending them to the current goal. .. tacn:: admit give_up Allows skipping a subgoal to permit further progress on the rest of the proof. The selected goals are removed from the context. They are not solved and cannot be solved later in the proof. Since the goals are not solved, the proof cannot be closed with :cmd:`Qed` but only with :cmd:`Admitted`. Reordering goals ```````````````` .. tacn:: cycle @int_or_var Reorders the selected goals so that the first :n:`@integer` goals appear after the other selected goals. If :n:`@integer` is negative, it puts the last :n:`@integer` goals at the beginning of the list. The tactic is only useful with a goal selector, most commonly `all:`. Note that other selectors reorder goals; `1,3: cycle 1` is not equivalent to `all: cycle 1`. See :tacn:`… : … (goal selector)`. .. example:: cycle .. coqtop:: none reset Parameter P : nat -> Prop. .. coqtop:: in abort Goal P 1 /\ P 2 /\ P 3 /\ P 4 /\ P 5. repeat split. (* P 1, P 2, P 3, P 4, P 5 *) all: cycle 2. (* P 3, P 4, P 5, P 1, P 2 *) all: cycle -3. (* P 5, P 1, P 2, P 3, P 4 *) .. tacn:: swap @int_or_var @int_or_var Exchanges the position of the specified goals. Negative values for :n:`@integer` indicate counting goals backward from the end of the list of selected goals. Goals are indexed from 1. The tactic is only useful with a goal selector, most commonly `all:`. Note that other selectors reorder goals; `1,3: swap 1 3` is not equivalent to `all: swap 1 3`. See :tacn:`… : … (goal selector)`. .. example:: swap .. coqtop:: in abort Goal P 1 /\ P 2 /\ P 3 /\ P 4 /\ P 5. repeat split. (* P 1, P 2, P 3, P 4, P 5 *) all: swap 1 3. (* P 3, P 2, P 1, P 4, P 5 *) all: swap 1 -1. (* P 5, P 2, P 1, P 4, P 3 *) .. tacn:: revgoals Reverses the order of the selected goals. The tactic is only useful with a goal selector, most commonly `all :`. Note that other selectors reorder goals; `1,3: revgoals` is not equivalent to `all: revgoals`. See :tacn:`… : … (goal selector)`. .. example:: revgoals .. coqtop:: in abort Goal P 1 /\ P 2 /\ P 3 /\ P 4 /\ P 5. repeat split. (* P 1, P 2, P 3, P 4, P 5 *) all: revgoals. (* P 5, P 4, P 3, P 2, P 1 *) Proving a subgoal as a separate lemma: abstract ----------------------------------------------- .. tacn:: abstract @ltac_expr2 {? using @ident__name } Does a :tacn:`solve` :n:`[ @ltac_expr2 ]` and saves the subproof as an auxiliary lemma. if :n:`@ident__name` is specified, the lemma is saved with that name; otherwise the lemma is saved with the name :n:`@ident`\ `_subproof`\ :n:`{? @natural }` where :token:`ident` is the name of the current goal (e.g. the theorem name) and :token:`natural` is chosen to get a fresh name. If the proof is closed with :cmd:`Qed`, the auxiliary lemma is inlined in the final proof term. This is useful with tactics such as :tacn:`discriminate` that generate huge proof terms with many intermediate goals. It can significantly reduce peak memory use. In most cases it doesn't have a significant impact on run time. One case in which it can reduce run time is when a tactic `foo` is known to always pass type checking when it succeeds, such as in reflective proofs. In this case, the idiom ":tacn:`abstract` :tacn:`exact_no_check` `foo`" will save half the type checking type time compared to ":tacn:`exact` `foo`". :tacn:`abstract` is an :token:`l3_tactic`. .. warning:: The abstract tactic, while very useful, still has some known limitations. See `#9146 `_ for more details. We recommend caution when using it in some "non-standard" contexts. In particular, ``abstract`` doesn't work properly when used inside quotations ``ltac:(...)``. If used as part of typeclass resolution, it may produce incorrect terms when in polymorphic universe mode. .. warning:: Provide :n:`@ident__name` at your own risk; explicitly named and reused subterms don’t play well with asynchronous proofs. .. tacn:: transparent_abstract @ltac_expr3 {? using @ident } Like :tacn:`abstract`, but save the subproof in a transparent lemma with a name in the form :n:`@ident`\ :n:`_subterm`\ :n:`{? @natural }`. .. warning:: Use this feature at your own risk; building computationally relevant terms with tactics is fragile, and explicitly named and reused subterms don’t play well with asynchronous proofs. .. exn:: Proof is not complete. :name: Proof is not complete. (abstract) :undocumented: .. _requestinginformation: Requesting information ---------------------- .. cmd:: Show {? {| @ident | @natural } } Displays the current goals. :n:`@natural` Display only the :token:`natural`\-th goal. :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. .. example:: .. coqtop:: all abort Goal exists n, n = 0. eexists ?[n]. Show n. .. exn:: No focused proof. :undocumented: .. exn:: No such goal. :undocumented: .. 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. 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`. .. cmd:: Show Conjectures 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. .. cmd:: Show Intro 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. .. cmd:: Show Intros Similar to the previous command. Simulates the naming process of :tacn:`intros`. .. cmd:: Show Existentials Displays all open goals / existential variables in the current proof along with the context and type of each variable. .. cmd:: Show Match @qualid Displays a template of the Gallina :token:`match` construct with a branch for each constructor of the type :token:`qualid`. This is used internally by `company-coq `_. .. example:: .. coqtop:: all Show Match nat. .. exn:: Unknown inductive type. :undocumented: .. cmd:: Show Universes Displays the set of all universe constraints and its normalized form at the current stage of the proof, useful for debugging universe inconsistencies. .. cmd:: Show Goal @natural at @natural 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 Some tactics (e.g. :tacn:`refine`) allow to build proofs using fixpoint or cofixpoint constructions. Due to the incremental nature of proof construction, the check of the termination (or guardedness) of the recursive calls in the fixpoint or cofixpoint constructions is postponed to the time of the completion of the proof. The command :cmd:`Guarded` allows checking if the guard condition for fixpoint and cofixpoint is violated at some time of the construction of the proof without having to wait the completion of the proof. .. cmd:: Validate Proof Checks that the current partial proof is well-typed. It is useful for finding tactic bugs since without it, such errors will only be detected at :cmd:`Qed` time. It does not check the guard condition. Use :cmd:`Guarded` for that. .. _showing_diffs: Showing differences between proof steps --------------------------------------- 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 second time with the old text, with deletions marked in red. Also, since the hypotheses are new, no line of old text is shown for them. .. comment screenshot produced with: Inductive ev : nat -> Prop := | ev_0 : ev 0 | ev_SS : forall n : nat, ev n -> ev (S (S n)). Fixpoint double (n:nat) := match n with | O => O | S n' => S (S (double n')) end. Goal forall n, ev n -> exists k, n = double k. intros n E. .. .. image:: ../../_static/diffs-coqide-on.png :alt: CoqIDE with Set Diffs on .. .. image:: ../../_static/diffs-coqide-removed.png :alt: CoqIDE with Set Diffs removed .. .. image:: ../../_static/diffs-coqtop-on3.png :alt: coqtop with Set Diffs on This image shows an error message with diff highlighting in CoqIDE: .. .. image:: ../../_static/diffs-error-message.png :alt: CoqIDE error message with diffs How to enable diffs ``````````````````` .. opt:: Diffs {| "on" | "off" | "removed" } This :term:`option` is used to enable diffs. The “on” setting highlights added tokens in green, while the “removed” setting additionally reprints items with removed tokens in red. Unchanged tokens in modified items are shown with pale green or red. Diffs in error messages use red and green for the compared values; they appear regardless of the setting. (Colors are user-configurable.) 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 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 ``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. Proof General, VsCoq and Coqtail can also display Coq-generated proof diffs automatically. Please see the PG documentation section `"Showing Proof Diffs" `_ and Coqtail's `"Proof Diffs" `_ for details. How diffs are calculated ```````````````````````` Diffs are calculated as follows: 1. Select the old proof state to compare to, which is the proof state before the last tactic that changed the proof. Changes that only affect the view of the proof, such as ``all: swap 1 2``, are ignored. 2. For each goal in the new proof state, determine what old goal to compare it to—the one it is derived from or is the same as. Match the hypotheses by name (order is ignored), handling compacted items specially. 3. For each hypothesis and conclusion (the “items”) in each goal, pass them as strings to the lexer to break them into tokens. Then apply the Myers diff algorithm :cite:`Myers` on the tokens and add appropriate highlighting. Notes: * Aside from the highlights, output for the "on" option should be identical to the undiffed output. * Goals completed in the last proof step will not be shown even with the "removed" setting. .. comment The following screenshots show diffs working with multiple goals and with compacted hypotheses. In the first one, notice that the goal ``P 1`` is not highlighted at all after the split because it has not changed. .. todo: Use this script and remove the screenshots when COQ_COLORS works for coqtop in sphinx .. coqtop:: none Set Diffs "on". Parameter P : nat -> Prop. Goal P 1 /\ P 2 /\ P 3. .. coqtop:: out split. .. coqtop:: all abort 2: split. .. .. coqtop:: none Set Diffs "on". Goal forall n m : nat, n + m = m + n. Set Diffs "on". .. coqtop:: out intros n. .. coqtop:: all abort intros m. This screenshot shows the result of applying a :tacn:`split` tactic that replaces one goal with 2 goals. Notice that the goal ``P 1`` is not highlighted at all after the split because it has not changed. .. .. image:: ../../_static/diffs-coqide-multigoal.png :alt: coqide with Set Diffs on with multiple goals 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 Delaying solving unification constraints ---------------------------------------- .. tacn:: solve_constraints :undocumented: .. flag:: Solve Unification Constraints By default, after each tactic application, postponed typechecking unification problems are resolved using heuristics. Unsetting this :term:`flag` disables this behavior, allowing tactics to leave unification constraints unsolved. Use the :tacn:`solve_constraints` tactic at any point to solve the constraints. .. _proof-maintenance: 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 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 :flag:`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 references to automatically generated names. .. flag:: Mangle Names When this :term:`flag` is set (it is off by default), generated names use the prefix specified in the following option instead of the default prefix. .. opt:: Mangle Names Prefix @string This :term:`option` specifies the prefix to use when generating names. .. flag:: Mangle Names Light When this :term:`flag` is set (it is off by default), the names generated by :flag:`Mangle Names` only add the :opt:`Mangle Names Prefix` to the original name. Controlling proof mode ---------------------- .. opt:: Hyps Limit @natural This :term:`option` controls the maximum number of hypotheses displayed in goals after the application of a tactic. All the hypotheses remain usable in the proof development. When unset, it goes back to the default mode which is to print all available hypotheses. .. flag:: Nested Proofs Allowed When turned on (it is off by default), this :term:`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 *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 proof of the previous assertion. .. flag:: Printing Goal Names When this :term:`flag` is turned on, the name of the goal is printed in proof mode, which can be useful in cases of cross references between goals. .. flag:: Printing Goal Tags Internal flag used to implement Proof General's proof-tree mode. Controlling memory usage ------------------------ .. cmd:: Print Debug GC Prints heap usage statistics, which are values from the `stat` type of the `Gc` module described `here `_ 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. When experiencing high memory usage the following commands can be used to force Coq to optimize some of its internal data structures. .. cmd:: Optimize Proof Shrink the data structure used to represent the current proof. .. cmd:: Optimize Heap Perform a heap compaction. This is generally an expensive operation. See: `OCaml Gc.compact `_ There is also an analogous tactic :tacn:`optimize_heap`. Memory usage parameters can be set through the :ref:`OCAMLRUNPARAM ` environment variable. coq-8.20.0/doc/sphinx/proofs/writing-proofs/reasoning-inductives.rst000066400000000000000000001645031466560755400256670ustar00rootroot00000000000000============================== Reasoning with inductive types ============================== Applying constructors --------------------- The tactics presented here specialize :tacn:`apply` and :tacn:`eapply` to constructors of inductive types. .. tacn:: constructor {? @nat_or_var } {? with @bindings } First does :n:`repeat intro; hnf` on the goal. If the result is an inductive type :g:`I`, then apply the appropriate constructor(s), and otherwise fail. If :n:`@nat_or_var` is specified and has the value `i`, it uses :n:`apply c__i`, where :n:`c__i` is the i-th constructor of :g:`I`. If not specified, the tactic tries all the constructors, which can result in more than one success (e.g. for `\\/`) when using backtracking tactics such as `constructor; ...`. See :tacn:`ltac-seq`. :n:`{? with @bindings }` If specified, the :n:`apply` is done as :n:`apply … with @bindings`. .. warning:: 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). .. exn:: Not an inductive product. :undocumented: .. exn:: Not enough constructors. :undocumented: .. exn:: The type has no constructors. :undocumented: .. tacn:: split {? with @bindings } Equivalent to :n:`constructor 1 {? with @bindings }` when the conclusion is an inductive type with a single constructor. The :n:`@bindings` specify any parameters required for the constructor. It is typically used to split conjunctions in the conclusion such as `A /\\ B` into two new goals `A` and `B`. .. tacn:: exists {*, @bindings } Equivalent to :n:`constructor 1 with @bindings__i` for each set of bindings (or just :n:`constructor 1` if there are no :n:`@bindings`) when the conclusion is an inductive type with a single constructor. It is typically used on existential quantifications in the form `exists x, P x.` .. exn:: Not an inductive goal with 1 constructor. :undocumented: .. tacn:: left {? with @bindings } right {? with @bindings } These tactics apply only if :g:`I` has two constructors, for instance in the case of a disjunction `A \\/ B`. Then they are respectively equivalent to :n:`constructor 1 {? with @bindings }` and :n:`constructor 2 {? with @bindings }`. .. exn:: Not an inductive goal with 2 constructors. :undocumented: .. tacn:: econstructor {? @nat_or_var {? with @bindings } } eexists {*, @bindings } esplit {? with @bindings } eleft {? with @bindings } eright {? with @bindings } These tactics behave like :tacn:`constructor`, :tacn:`exists`, :tacn:`split`, :tacn:`left` and :tacn:`right`, but they introduce existential variables instead of failing when a variable can't be instantiated (cf. :tacn:`eapply` and :tacn:`apply`). .. example:: :tacn:`constructor`, :tacn:`left` and :tacn:`right` .. coqtop:: reset all Print or. (* or, represented by \/, has two constructors, or_introl and or_intror *) Goal forall P1 P2 : Prop, P1 -> P1 \/ P2. constructor 1. (* equivalent to "left" *) apply H. (* success *) In contrast, we won't be able to complete the proof if we select constructor 2: .. coqtop:: reset none Goal forall P1 P2 : Prop, P1 -> P1 \/ P2. .. coqtop:: all constructor 2. (* equivalent to "right" *) You can also apply a constructor by name: .. coqtop:: reset none Goal forall P1 P2 : Prop, P1 -> P1 \/ P2. .. coqtop:: all intros; apply or_introl. (* equivalent to "left" *) .. _CaseAnalysisAndInduction: Case analysis ------------- The tactics in this section implement case analysis on inductive or coinductive objects (see :ref:`variants`). .. comment Notes contrasting the various case analysis tactics: https://github.com/coq/coq/pull/14676#discussion_r697904963 .. tacn:: destruct {+, @induction_clause } {? @induction_principle } .. insertprodn induction_clause induction_arg .. prodn:: induction_clause ::= @induction_arg {? as @or_and_intropattern } {? eqn : @naming_intropattern } {? @occurrences } induction_arg ::= @one_term_with_bindings | @natural Performs case analysis by generating a subgoal for each constructor of the inductive or coinductive type selected by :n:`@induction_arg`. The selected subterm, after possibly doing an :tacn:`intros`, must have an inductive or coinductive type. Unlike :tacn:`induction`, :n:`destruct` generates no induction hypothesis. In each new subgoal, the tactic replaces the selected subterm with the associated constructor applied to its arguments, if any. :n:`{+, @induction_clause }` Giving multiple :n:`@induction_clause`\s is equivalent to applying :n:`destruct` serially on each :n:`@induction_clause`. :n:`@induction_arg` + If :n:`@one_term` (in :n:`@one_term_with_bindings`) is an identifier :n:`@ident`: + If :n:`@ident` denotes a :n:`forall` variable in the goal, then :n:`destruct @ident` behaves like :tacn:`intros` :n:`until @ident; destruct @ident`. + If :n:`@ident` is no longer dependent in the goal after application of :n:`destruct`, it is erased. To avoid erasure, use parentheses, as in :n:`destruct (@ident)`. + :n:`@one_term` may contain holes that are denoted by “_”. In this case, the tactic selects the first subterm that matches the pattern and performs case analysis using that subterm. + If :n:`@induction_arg` is a :n:`@natural`, then :n:`destruct @natural` behaves like :n:`intros until @natural` followed by :n:`destruct` applied to the last introduced hypothesis. :n:`as @or_and_intropattern` Provides names for (or applies further transformations to) the variables and hypotheses introduced in each new subgoal. The :token:`or_and_intropattern` must have one :n:`{* @intropattern }` for each constructor, given in the order in which the constructors are defined. If there are not enough names, Coq picks fresh names. Inner :n:`intropattern`\s can also split introduced hypotheses into multiple hypotheses or subgoals. :n:`eqn : @naming_intropattern` Generates a new hypothesis in each new subgoal that is an equality between the term being case-analyzed and the associated constructor (applied to its arguments). The name of the new item may be specified in the :n:`@naming_intropattern`. :n:`with @bindings` (in :n:`@one_term_with_bindings`) Provides explicit instances for the :term:`dependent premises ` of the type of :token:`one_term`. :n:`@occurrences` Selects specific subterms of the goal and/or hypotheses to apply the tactic to. See :ref:`Occurrence clauses `. If it occurs in the :n:`@induction_principle`, then there can only be one :n:`@induction_clause`, which can't have its own :n:`@occurrences` clause. :n:`@induction_principle` Makes the tactic equivalent to :tacn:`induction` :n:`{+, @induction_clause } @induction_principle`. .. _example_destruct_ind_concl: .. example:: Using :tacn:`destruct` on an argument with premises .. coqtop:: reset in Parameter A B C D : Prop. .. coqtop:: all Goal (A -> B \/ C) -> D. intros until 1. destruct H. Show 2. Show 3. The single tactic :n:`destruct 1` is equivalent to the :tacn:`intros` and :tacn:`destruct` used here. .. tacn:: edestruct {+, @induction_clause } {? @induction_principle } If the type of :n:`@one_term` (in :n:`@induction_arg`) has :term:`dependent premises ` whose values can't be inferred from the :n:`with @bindings` clause, :n:`edestruct` turns them into existential variables to be resolved later on. .. tacn:: case {+, @induction_clause } {? @induction_principle } An older, more basic tactic to perform case analysis without recursion. We recommend using :tacn:`destruct` instead where possible. `case` only modifies the goal; it does not modify the :term:`local context`. .. tacn:: ecase {+, @induction_clause } {? @induction_principle } If the type of :n:`@one_term` (in :n:`@induction_arg`) has :term:`dependent premises ` whose values can't be inferred from the :n:`with @bindings` clause, :n:`ecase` turns them into existential variables to be resolved later on. .. tacn:: case_eq @one_term A variant of the :n:`case` tactic that allows performing case analysis on a term without completely forgetting its original form. This is done by generating equalities between the original form of the term and the outcomes of the case analysis. We recommend using the :tacn:`destruct` tactic with an `eqn:` clause instead. .. tacn:: simple destruct {| @ident | @natural } Equivalent to :tacn:`intros` :n:`until {| @ident | @natural }; case @ident` where :n:`@ident` is a :n:`forall` variable in the goal and otherwise fails. .. tacn:: dependent destruction @ident {? generalizing {+ @ident } } {? using @one_term } :undocumented: There is a long example of :tacn:`dependent destruction` and an explanation of the underlying technique :ref:`here `. .. tacn:: decompose [ {+ @one_term } ] @one_term Recursively decomposes a complex proposition in order to obtain atomic ones. .. example:: .. coqtop:: reset all Goal forall A B C:Prop, A /\ B /\ C \/ B /\ C \/ C /\ A -> C. intros A B C H; decompose [and or] H. all: assumption. Qed. .. note:: :tacn:`decompose` does not work on right-hand sides of implications or products. .. tacn:: decompose sum @one_term This decomposes sum types (like :g:`or`). .. tacn:: decompose record @one_term This decomposes record types (inductive types with one constructor, like :g:`and` and :g:`exists` and those defined with the :cmd:`Record` command. .. tacn:: destauto {? in @ident } .. todo: keep or remove destauto? destauto added in https://github.com/coq/coq/commit/f3a53027589813ff19b3a7c46d84e5bd2fc65741 Reduces one :n:`match t with ...` by doing :n:`destruct t`. If :n:`t` is not a variable, the tactic does :n:`case_eq t;intros ... heq;rewrite heq in *|-`. :n:`heq` is preserved. Induction --------- .. tacn:: induction {+, @induction_clause } {? @induction_principle } .. insertprodn induction_principle induction_principle .. prodn:: induction_principle ::= using @one_term_with_bindings {? @occurrences } Applies an :term:`induction principle` to generate a subgoal for each constructor of an inductive type. If the argument is :term:`dependent ` in the conclusion or some hypotheses of the goal, the argument is replaced by the appropriate constructor in each of the resulting subgoals and induction hypotheses are added to the local context using names whose prefix is **IH**. The tactic is similar to :tacn:`destruct`, except that `destruct` doesn't generate induction hypotheses. :n:`induction` and :tacn:`destruct` are very similar. Aside from the following differences, please refer to the description of :tacn:`destruct` while mentally substituting :n:`induction` for :tacn:`destruct`. :n:`{+, @induction_clause }` If no :n:`@induction_principle` clause is provided, this is equivalent to doing :n:`induction` on the first :n:`@induction_clause` followed by :n:`destruct` on any subsequent clauses. :n:`@induction_principle` :n:`@one_term` specifies which :term:`induction principle` to use. The optional :n:`with @bindings` gives any values that must be substituted into the induction principle. The number of :n:`@bindings` must be the same as the number of parameters of the induction principle. If unspecified, the tactic applies the appropriate :term:`induction principle` that was automatically generated when the inductive type was declared based on the sort of the goal. .. exn:: Cannot recognize a statement based on @reference. The type of the :n:`@induction_arg` (in an :n:`@induction_clause`) must reduce to the :n:`@reference` which was inferred as the type the induction principle operates on. Note that it is not enough to be convertible, but you can work around that with :tacn:`change`: .. coqtop:: reset all Definition N := nat. Axiom strong : forall P, (forall n:N, (forall m:N, m < n -> P m) -> P n) -> forall n, P n. Axiom P : N -> Prop. Goal forall n:nat, P n. intros. Fail induction n using strong. change N in n. (* n is now of type N, matching the inferred type that strong operates on *) induction n using strong. .. exn:: Unable to find an instance for the variables @ident … @ident. Use the :n:`with @bindings` clause or the :tacn:`einduction` tactic instead. .. example:: .. coqtop:: reset all Lemma induction_test : forall n:nat, n = n -> n <= n. intros n H. induction n. exact (le_n 0). .. example:: :n:`induction` with :n:`@occurrences` .. coqtop:: reset all Lemma induction_test2 : forall n:nat, n = n -> n <= n. intros. induction n in H |-. Show 2. .. tacn:: einduction {+, @induction_clause } {? @induction_principle } Behaves like :tacn:`induction` except that it does not fail if some :term:`dependent premise` of the type of :n:`@one_term` can't be inferred. Instead, the unresolved premises are posed as existential variables to be inferred later, in the same way as :tacn:`eapply` does. .. tacn:: elim @one_term_with_bindings {? using @one_term_with_bindings } An older, more basic induction tactic. Unlike :tacn:`induction`, ``elim`` only modifies the goal; it does not modify the :term:`local context`. We recommend using :tacn:`induction` instead where possible. :n:`with @bindings` (in :n:`@one_term_with_bindings`) Explicitly gives instances to the premises of the type of :n:`@one_term` (see :ref:`bindings`). :n:`{? using @one_term_with_bindings }` Allows explicitly giving an induction principle :n:`@one_term` that is not the standard one for the underlying inductive type of :n:`@one_term`. The :n:`@bindings` clause allows instantiating premises of the type of :n:`@one_term`. .. tacn:: eelim @one_term_with_bindings {? using @one_term_with_bindings } If the type of :n:`@one_term` has dependent premises, this turns them into existential variables to be resolved later on. .. tacn:: simple induction {| @ident | @natural } Behaves like :n:`intros until {| @ident | @natural }; elim @ident` when :n:`@ident` is a :n:`forall` variable in the goal. .. tacn:: dependent induction @ident {? {| generalizing | in } {+ @ident } } {? using @one_term } The *experimental* tactic :tacn:`dependent induction` performs induction-inversion on an instantiated inductive predicate. One needs to first :cmd:`Require` the `Coq.Program.Equality` module to use this tactic. The tactic is based on the BasicElim tactic by Conor McBride :cite:`DBLP:conf/types/McBride00` and the work of Cristina Cornes around inversion :cite:`DBLP:conf/types/CornesT95`. From an instantiated inductive predicate and a goal, it generates an equivalent goal where the hypothesis has been generalized over its indexes which are then constrained by equalities to be the right instances. This permits to state lemmas without resorting to manually adding these equalities and still get enough information in the proofs. :n:`{| generalizing | in } {+ @ident }` First generalizes the goal by the given variables so that they are universally quantified in the goal. This is generally what one wants to do with variables that are inside constructors in the induction hypothesis. The other ones need not be further generalized. There is a long example of :tacn:`dependent induction` and an explanation of the underlying technique :ref:`here `. .. example:: .. coqtop:: reset all Lemma lt_1_r : forall n:nat, n < 1 -> n = 0. intros n H ; induction H. Here we did not get any information on the indexes to help fulfill this proof. The problem is that, when we use the ``induction`` tactic, we lose information on the hypothesis instance, notably that the second argument is 1 here. Dependent induction solves this problem by adding the corresponding equality to the context. .. coqtop:: reset all Require Import Coq.Program.Equality. Lemma lt_1_r : forall n:nat, n < 1 -> n = 0. intros n H ; dependent induction H. The subgoal is cleaned up as the tactic tries to automatically simplify the subgoals with respect to the generated equalities. In this enriched context, it becomes possible to solve this subgoal. .. coqtop:: all reflexivity. Now we are in a contradictory context and the proof can be solved. .. coqtop:: all abort inversion H. This technique works with any inductive predicate. In fact, the :tacn:`dependent induction` tactic is just a wrapper around the :tacn:`induction` tactic. One can make its own variant by just writing a new tactic based on the definition found in ``Coq.Program.Equality``. .. seealso:: :tacn:`functional induction` .. tacn:: fix @ident @natural {? with {+ ( @ident {* @simple_binder } {? %{ struct @name %} } : @type ) } } A primitive tactic that starts a proof by induction. Generally, higher-level tactics such as :tacn:`induction` or :tacn:`elim` are easier to use. The :n:`@ident`\s (including the first one before the `with` clause) are the names of the induction hypotheses. :n:`@natural` tells on which premise of the current goal the induction acts, starting from 1, counting both dependent and non-dependent products, but skipping local definitions. The current lemma must be composed of at least :n:`@natural` products. As in a fix expression, induction hypotheses must be used on structurally smaller arguments. The verification that inductive proof arguments are correct is done only when registering the lemma in the global environment. To know if the use of induction hypotheses is correct during the interactive development of a proof, use the command :cmd:`Guarded`. :n:`with {+ ( @ident {* @simple_binder } {? %{ struct @name %} } : @type ) }` Starts a proof by mutual induction. The statements to be proven are :n:`forall @simple_binder__i, @type__i`. The identifiers :n:`@ident` (including the first one before the `with` clause) are the names of the induction hypotheses. The identifiers :n:`@name` (in the `{ struct ... }` clauses) are the respective names of the premises on which the induction is performed in the statements to be proved (if not given, Coq guesses what they are). .. tacn:: cofix @ident {? with {+ ( @ident {* @simple_binder } : @type ) } } Starts a proof by coinduction. The :n:`@ident`\s (including the first one before the `with` clause) are the names of the coinduction hypotheses. As in a cofix expression, the use of induction hypotheses must be guarded by a constructor. The verification that the use of coinductive hypotheses is correct is done only at the time of registering the lemma in the global environment. To know if the use of coinduction hypotheses is correct at some time of the interactive development of a proof, use the command :cmd:`Guarded`. :n:`with {+ ( @ident {* @simple_binder } : @type ) }` Starts a proof by mutual coinduction. The statements to be proven are :n:`forall @simple_binder__i, @type__i`. The identifiers :n:`@ident` (including the first one before the `with` clause) are the names of the coinduction hypotheses. .. _equality-inductive_types: Equality of inductive types --------------------------- This section describes some special purpose tactics to work with :term:`Leibniz equality` of inductive sets or types. .. tacn:: discriminate {? @induction_arg } Proves any goal for which a hypothesis in the form :n:`@term__1 = @term__2` states an impossible structural equality for an inductive type. If :n:`@induction_arg` is not given, it checks all the hypotheses for impossible equalities. For example, :g:`(S (S O)) = (S O)` is impossible. If provided, :n:`@induction_arg` is a proof of an equality, typically specified as the name of a hypothesis. If no :n:`@induction_arg` is provided and the goal is in the form :n:`@term__1 <> @term__2`, then the tactic behaves like :n:`intro @ident; discriminate @ident`. The tactic traverses the normal forms of :n:`@term__1` and :n:`@term__2`, looking for subterms :g:`u` and :g:`w` placed in the same positions and whose head symbols are different constructors. If such subterms are present, the equality is impossible and the current goal is completed. Otherwise the tactic fails. Note that opaque constants are not expanded by δ reductions while computing the normal form. :n:`@ident` (in :n:`@induction_arg`) Checks the hypothesis :n:`@ident` for impossible equalities. If :n:`@ident` is not already in the context, this is equivalent to :n:`intros until @ident; discriminate @ident`. :n:`@natural` (in :n:`@induction_arg`) Equivalent to :tacn:`intros` :n:`until @natural; discriminate @ident`, where :n:`@ident` is the identifier for the last introduced hypothesis. :n:`@one_term with @bindings` (in :n:`@induction_arg`) Equivalent to :n:`discriminate @one_term` but uses the given bindings to instantiate parameters or hypotheses of :n:`@one_term`. :n:`@one_term` must be a proof of :n:`@term__1 = @term__2`. .. exn:: No primitive equality found. :undocumented: .. exn:: Not a discriminable equality. :undocumented: .. tacn:: ediscriminate {? @induction_arg } Works the same as :tacn:`discriminate` but if the type of :token:`one_term`, or the type of the hypothesis referred to by :token:`natural`, has uninstantiated parameters, these parameters are left as existential variables. .. tacn:: injection {? @induction_arg } {? as {* @simple_intropattern } } Exploits the property that constructors of inductive types are injective, i.e. that if :n:`c` is a constructor of an inductive type and :n:`c t__1 = c t__2` then :n:`t__1 = t__2` are equal too. If there is a hypothesis `H` in the form :n:`@term__1 = @term__2`, then :n:`injection H` applies the injectivity of constructors as deep as possible to derive the equality of subterms of :n:`@term__1` and :n:`@term__2` wherever the subterms start to differ. For example, from :g:`(S p, S n) = (q, S (S m))` we may derive :g:`S p = q` and :g:`n = S m`. The terms must have inductive types and the same head constructor, but must not be convertible. If so, the tactic derives the equalities and adds them to the current goal as :term:`premises ` (except if the :n:`as` clause is used). If no :n:`induction_arg` is provided and the current goal is of the form :n:`@term <> @term`, :tacn:`injection` is equivalent to :n:`intro @ident; injection @ident`. :n:`@ident` (in :n:`@induction_arg`) Derives equalities based on constructor injectivity for the hypothesis :n:`@ident`. If :n:`@ident` is not already in the context, this is equivalent to :n:`intros until @ident; injection @ident`. :n:`@natural` (in :n:`@induction_arg`) Equivalent to :tacn:`intros` :n:`until @natural` followed by :n:`injection @ident` where :n:`@ident` is the identifier for the last introduced hypothesis. :n:`@one_term with @bindings` (in :n:`@induction_arg`) Like :n:`injection @one_term` but uses the given bindings to instantiate parameters or hypotheses of :n:`@one_term`. :n:`as [= {* @intropattern } ]` Specifies names to apply after the injection so that all generated equalities become hypotheses, which (unlike :tacn:`intros`) may replace existing hypotheses with same name. The number of provided names must not exceed the number of newly generated equalities. If it is smaller, fresh names are generated for the unspecified items. The original equality is erased if it corresponds to a provided name or if the list of provided names is incomplete. Note that, as a convenience for users, specifying :n:`{+ @simple_intropattern }` is treated as if :n:`[= {+ @simple_intropattern } ]` was specified. .. example:: Consider the following goal: .. coqtop:: in Inductive list : Set := | nil : list | cons : nat -> list -> list. Parameter P : list -> Prop. Goal forall l n, P nil -> cons n l = cons 0 nil -> P l. .. coqtop:: all intros. injection H0. .. note:: Beware that injection yields an equality in a sigma type whenever the injected object has a dependent type :g:`P` with its two instances in different types :n:`(P t__1 … t__n)` and :n:`(P u__1 … u__n)`. If :n:`t__1` and :n:`u__1` are the same and have for type an inductive type for which a decidable equality has been declared using :cmd:`Scheme Equality`, the use of a sigma type is avoided. .. exn:: No information can be deduced from this equality and the injectivity of constructors. This may be because the terms are convertible, or due to pattern matching restrictions in the sort Prop. You can try to use option Set Keep Proof Equalities. :undocumented: .. exn:: Not a negated primitive equality When :n:`@induction_arg` is not provided, the goal must be in the form :n:`@term <> @term`. .. exn:: Nothing to inject. Generated when one side of the equality is not a constructor. .. tacn:: einjection {? @induction_arg } {? as {* @simple_intropattern } } Works the same as :n:`injection` but if the type of :n:`@one_term`, or the type of the hypothesis referred to by :n:`@natural` has uninstantiated parameters, these parameters are left as existential variables. .. tacn:: simple injection {? @induction_arg } Similar to :tacn:`injection`, but always adds the derived equalities as new :term:`premises ` in the current goal (instead of as new hypotheses) even if the :flag:`Structural Injection` flag is set. .. flag:: Structural Injection When this :term:`flag` is set, :n:`injection @term` erases the original hypothesis and adds the generated equalities as new hypotheses rather than adding them to the current goal as :term:`premises `, as if giving :n:`injection @term as` (with an empty list of names). This flag is off by default. .. flag:: Keep Proof Equalities By default, :tacn:`injection` only creates new equalities between :n:`@term`\s whose type is in sort :g:`Type` or :g:`Set`, thus implementing a special behavior for objects that are proofs of a statement in :g:`Prop`. This :term:`flag` controls this behavior. .. table:: Keep Equalities @qualid This :term:`table` specifies a set of inductive types for which proof equalities are always kept by :tacn:`injection`. This overrides the :flag:`Keep Proof Equalities` flag for those inductive types. Use the :cmd:`Add` and :cmd:`Remove` commands to update this set manually. .. tacn:: simplify_eq {? @induction_arg } Examines a hypothesis that has the form :n:`@term__1 = @term__2`. If the terms are structurally different, the tactic does a :tacn:`discriminate`. Otherwise, it does an :tacn:`injection` to simplify the equality, if possible. If :n:`induction_arg` is not provided, the tactic examines the goal, which must be in the form :n:`@term__1 <> @term__2`. See the description of :token:`induction_arg` in :tacn:`injection` for an explanation of the parameters. .. tacn:: esimplify_eq {? @induction_arg } Works the same as :tacn:`simplify_eq` but if the type of :n:`@one_term` or the type of the hypothesis referred to by :n:`@natural` has uninstantiated parameters, these parameters are left as existential variables. .. tacn:: inversion {| @ident | @natural } {? as @or_and_intropattern } {? in {+ @ident } } inversion {| @ident | @natural } using @one_term {? in {+ @ident } } :name: inversion; _ .. comment: the other inversion* tactics don't support the using clause, but they should be able to, if desired. It wouldn't make sense for inversion_sigma. See https://github.com/coq/coq/pull/14179#discussion_r642193096 For a hypothesis whose type is a (co)inductively defined proposition, the tactic introduces a goal for each constructor of the proposition that isn't self-contradictory. Each such goal includes the hypotheses needed to deduce the proposition. :gdef:`(Co)inductively defined propositions ` are those defined with the :cmd:`Inductive` or :cmd:`CoInductive` commands whose contructors yield a `Prop`, as in this :ref:`example `. :n:`@ident` The name of the hypothesis to invert. If :n:`@ident` does not denote a hypothesis in the local context but refers to a hypothesis quantified in the goal, then the latter is first introduced in the local context using :n:`intros until @ident`. :n:`@natural` Equivalent to :n:`intros until @natural; inversion @ident` where :n:`@ident` is the identifier for the last introduced hypothesis. :n:`{? in {+ @ident } }` When :n:`{+ @ident}` are identifiers in the local context, this does a :tacn:`generalize` :n:`{+ @ident}` as the initial step of `inversion`. :n:`as @or_and_intropattern` Provides names for the variables introduced in each new subgoal. The :token:`or_and_intropattern` must have one :n:`{* @intropattern }` for each constructor of the (co)inductive predicate, given in the order in which the constructors are defined. If there are not enough names, Coq picks fresh names. If an equation splits into several equations (because ``inversion`` applies ``injection`` on the equalities it generates), the corresponding :n:`@intropattern` should be in the form :n:`[ {* @intropattern } ]` (or the equivalent :n:`{*, ( @simple_intropattern ) }`), with the number of entries equal to the number of subequalities obtained from splitting the original equation. Example :ref:`here `. .. note:: The ``inversion … as`` variant of ``inversion`` generally behaves in a slightly more expected way than ``inversion`` (no artificial duplication of some hypotheses referring to other hypotheses). To take advantage of these improvements, it is enough to use ``inversion … as []``, letting Coq choose fresh names. .. note:: As ``inversion`` proofs may be large, we recommend creating and using lemmas whenever the same instance needs to be inverted several times. See :ref:`derive-inversion`. .. note:: Part of the behavior of the :tacn:`inversion` tactic is to generate equalities between expressions that appeared in the hypothesis that is being processed. By default, no equalities are generated if they relate two proofs (i.e. equalities between :token:`term`\s whose type is in sort :g:`Prop`). This behavior can be turned off by using the :flag:`Keep Proof Equalities` setting. .. _inversion-intropattern-ex: .. example:: :tacn:`inversion` with :n:`as @or_and_intropattern` .. coqtop:: reset all Inductive contains0 : list nat -> Prop := | in_hd : forall l, contains0 (0 :: l) | in_tl : forall l b, contains0 l -> contains0 (b :: l). .. coqtop:: in Goal forall l:list nat, contains0 (1 :: l) -> contains0 l. .. coqtop:: all intros l H. inversion H as [ | l' p Hl' [Heqp Heql'] ]. .. tacn:: inversion_clear {| @ident | @natural } {? as @or_and_intropattern } {? in {+ @ident } } Does an :tacn:`inversion` and then erases the hypothesis that was used for the inversion. .. tacn:: simple inversion {| @ident | @natural } {? as @or_and_intropattern } {? in {+ @ident } } A very simple inversion tactic that derives all the necessary equalities but does not simplify the constraints as :tacn:`inversion` does. .. tacn:: dependent inversion {| @ident | @natural } {? as @or_and_intropattern } {? with @one_term } For use when the inverted hypothesis appears in the current goal. Does an :tacn:`inversion` and then substitutes the name of the hypothesis where the corresponding term appears in the goal. .. tacn:: dependent inversion_clear {| @ident | @natural } {? as @or_and_intropattern } {? with @one_term } Does a :tacn:`dependent inversion` and then erases the hypothesis that was used for the dependent inversion. .. tacn:: dependent simple inversion {| @ident | @natural } {? as @or_and_intropattern } {? with @one_term } :undocumented: .. tacn:: inversion_sigma {? @ident {? as @simple_intropattern } } Turns equalities of dependent pairs (e.g., :g:`existT P x p = existT P y q`, frequently left over by :tacn:`inversion` on a dependent type family) into pairs of equalities (e.g., a hypothesis :g:`H : x = y` and a hypothesis of type :g:`rew H in p = q`); these hypotheses can subsequently be simplified using :tacn:`subst`, without ever invoking any kind of axiom asserting uniqueness of identity proofs. If you want to explicitly specify the hypothesis to be inverted, you can pass it as an argument to :tacn:`inversion_sigma`. This tactic also works for :g:`sig`, :g:`sigT2`, :g:`sig2`, :g:`ex`, and :g:`ex2` and there are similar :g:`eq_sig` :g:`***_rect` induction lemmas. .. exn:: Type of @ident is not an equality of recognized Σ types: expected one of sig sig2 sigT sigT2 sigT2 ex or ex2 but got @term When applied to a hypothesis, :tacn:`inversion_sigma` can only handle equalities of the listed sigma types. .. exn:: @ident is not an equality of Σ types When applied to a hypothesis, :tacn:`inversion_sigma` can only be called on hypotheses that are equalities using :g:`Coq.Logic.Init.eq`. .. example:: Non-dependent inversion Let us consider the relation :g:`Le` over natural numbers: .. coqtop:: reset in Inductive Le : nat -> nat -> Set := | LeO : forall n:nat, Le 0 n | LeS : forall n m:nat, Le n m -> Le (S n) (S m). Let us consider the following goal: .. coqtop:: none Section Section. Variable P : nat -> nat -> Prop. Variable Q : forall n m:nat, Le n m -> Prop. Goal forall n m, Le (S n) m -> P n m. .. coqtop:: out intros. To prove the goal, we may need to reason by cases on :g:`H` and to derive that :g:`m` is necessarily of the form :g:`(S m0)` for certain :g:`m0` and that :g:`(Le n m0)`. Deriving these conditions corresponds to proving that the only possible constructor of :g:`(Le (S n) m)` is :g:`LeS` and that we can invert the arrow in the type of :g:`LeS`. This inversion is possible because :g:`Le` is the smallest set closed by the constructors :g:`LeO` and :g:`LeS`. .. coqtop:: all inversion_clear H. Note that :g:`m` has been substituted in the goal for :g:`(S m0)` and that the hypothesis :g:`(Le n m0)` has been added to the context. Sometimes it is interesting to have the equality :g:`m = (S m0)` in the context to use it after. In that case we can use :tacn:`inversion` that does not clear the equalities: .. coqtop:: none restart intros. .. coqtop:: all inversion H. .. example:: Dependent inversion Let us consider the following goal: .. coqtop:: none Abort. Goal forall n m (H:Le (S n) m), Q (S n) m H. .. coqtop:: out intros. As :g:`H` occurs in the goal, we may want to reason by cases on its structure and so, we would like inversion tactics to substitute :g:`H` by the corresponding @term in constructor form. Neither :tacn:`inversion` nor :tacn:`inversion_clear` do such a substitution. To have such a behavior we use the dependent inversion tactics: .. coqtop:: all dependent inversion_clear H. Note that :g:`H` has been substituted by :g:`(LeS n m0 l)` and :g:`m` by :g:`(S m0)`. .. example:: Using :tacn:`inversion_sigma` Let us consider the following inductive type of length-indexed lists, and a lemma about inverting equality of cons: .. coqtop:: reset all Require Import Coq.Logic.Eqdep_dec. Inductive vec A : nat -> Type := | nil : vec A O | cons {n} (x : A) (xs : vec A n) : vec A (S n). Lemma invert_cons : forall A n x xs y ys, @cons A n x xs = @cons A n y ys -> xs = ys. Proof. intros A n x xs y ys H. After performing inversion, we are left with an equality of existTs: .. coqtop:: all inversion H. We can turn this equality into a usable form with inversion_sigma: .. coqtop:: all inversion_sigma. To finish cleaning up the proof, we will need to use the fact that that all proofs of n = n for n a nat are eq_refl: .. coqtop:: all let H := match goal with H : n = n |- _ => H end in pose proof (Eqdep_dec.UIP_refl_nat _ H); subst H. simpl in *. Finally, we can finish the proof: .. coqtop:: all assumption. Qed. .. seealso:: :tacn:`functional inversion` Helper tactics ~~~~~~~~~~~~~~ .. tacn:: decide @one_term__1 with @one_term__2 Replaces occurrences of :n:`@one_term__1` in the form :g:`{P}+{~P}` in the goal with :g:`(left _)` or :g:`(right _)`, depending on :n:`@one_term__2`. :n:`@one_term__2` must be of type either :g:`P` or :g:`~P`, and :g:`P` must be of type :g:`Prop`. .. example:: Using :tacn:`decide` to rewrite the goal .. coqtop:: in Goal forall (P Q : Prop) (Hp : {P} + {~P}) (Hq : {Q} + {~Q}), P -> ~Q -> (if Hp then true else false) = (if Hq then false else true). .. coqtop:: all intros P Q Hp Hq p nq. decide Hp with p. decide Hq with nq. .. coqtop:: in reflexivity. Qed. .. tacn:: decide equality Solves a goal of the form :n:`{? forall x y : R, } {x = y} + {~ x = y}` or :n:`{? forall x y : R, } (x = y) \/ (~ x = y)`, where :g:`R` is an inductive type whose constructors do not take proofs or functions as arguments, nor objects in dependent types. .. tacn:: compare @one_term__1 @one_term__2 Compares two :n:`@one_term`\s of an inductive datatype. If :g:`G` is the current goal, it leaves the sub-goals :n:`@one_term__1 = @one_term__2 -> G` and :n:`~ @one_term__1 = @one_term__2 -> G`. The type of the :n:`@one_term`\s must satisfy the same restrictions as in the tactic :tacn:`decide equality`. .. tacn:: dependent rewrite {? {| -> | <- } } @one_term {? in @ident } If :n:`@ident` has type :g:`(existT B a b)=(existT B a' b')` in the local context (i.e. each term of the equality has a sigma type :g:`{ a:A & (B a)}`) this tactic rewrites :g:`a` into :g:`a'` and :g:`b` into :g:`b'` in the current goal. This tactic works even if :g:`B` is also a sigma type. This kind of equalities between dependent pairs may be derived by the :tacn:`injection` and :tacn:`inversion` tactics. :n:`{? {| -> | <- } }` By default, the equality is applied from left to right. Specify `<-` to apply the equality from right to left. .. _proofschemes-induction-principles: Generation of induction principles with ``Scheme`` -------------------------------------------------------- .. cmd:: Scheme {? @ident := } @scheme_kind {* with {? @ident := } @scheme_kind } .. insertprodn scheme_kind sort_family scheme_type .. prodn:: scheme_kind ::= @scheme_type for @reference Sort @sort_family scheme_type ::= Induction | Minimality | Elimination | Case sort_family ::= Prop | SProp | Set | Type Generates :term:`induction principles ` with given :n:`scheme_type`\s and :n:`scheme_sort`\s for an inductive type. In the case where the inductive definition is a mutual inductive definition, the :n:`with` clause is used to generate a mutually recursive inductive scheme for each clause of the mutual inductive type. :n:`@ident` The name of the scheme. If not provided, the name will be determined automatically from the :n:`@scheme_type` and :n:`@sort_family`. The following :n:`@scheme_type`\s generate induction principles with given properties: =================== =========== =========== :n:`@scheme_type` Recursive Dependent =================== =========== =========== :n:`Induction` Yes Yes :n:`Minimality` Yes No :n:`Elimination` No Yes :n:`Case` No No =================== =========== =========== See examples of the :n:`@scheme_type`\s :ref:`here `. .. cmd:: Scheme {? Boolean } Equality for @reference :name: Scheme Equality; Scheme Boolean Equality Tries to generate a Boolean equality for :n:`@reference`. If :n:`Boolean` is not specified, the command also tries to generate a proof of the decidability of propositional equality over :n:`@reference`. If :token:`reference` involves independent constants or other inductive types, we recommend defining their equality first. .. example:: Induction scheme for tree and forest Currently the automatically-generated :term:`induction principles ` such as `odd_ind` are not useful for mutually-inductive types such as `odd` and `even`. You can define a mutual induction principle for tree and forest in sort ``Set`` with the :cmd:`Scheme` command: .. coqtop:: reset none Axiom A : Set. Axiom B : Set. .. coqtop:: in Inductive tree : Set := | node : A -> forest -> tree with forest : Set := | leaf : B -> forest | cons : tree -> forest -> forest. .. coqtop:: all Scheme tree_forest_rec := Induction for tree Sort Set with forest_tree_rec := Induction for forest Sort Set. You may now look at the type of tree_forest_rec: .. coqtop:: all Check tree_forest_rec. This principle involves two different predicates for trees and forests; it also has three premises each one corresponding to a constructor of one of the inductive definitions. The principle `forest_tree_rec` shares exactly the same premises, only the conclusion now refers to the property of forests. .. example:: Predicates odd and even on naturals Let odd and even be inductively defined as: .. coqtop:: in Inductive odd : nat -> Prop := | oddS : forall n : nat, even n -> odd (S n) with even : nat -> Prop := | evenO : even 0 | evenS : forall n : nat, odd n -> even (S n). The following command generates a powerful elimination principle: .. coqtop:: all Scheme odd_even := Minimality for odd Sort Prop with even_odd := Minimality for even Sort Prop. The type of odd_even for instance will be: .. coqtop:: all Check odd_even. The type of `even_odd` shares the same premises but the conclusion is `forall n : nat, even n -> P0 n`. .. _scheme_example: .. example:: `Scheme` commands with various :n:`@scheme_type`\s Let us demonstrate the difference between the Scheme commands. .. coqtop:: all Unset Elimination Schemes. Inductive Nat := | z : Nat | s : Nat -> Nat. (* dependent, recursive *) Scheme Induction for Nat Sort Set. About Nat_rec. (* non-dependent, recursive *) Scheme Minimality for Nat Sort Set. About Nat_rec_nodep. (* dependent, non-recursive *) Scheme Elimination for Nat Sort Set. About Nat_case. (* non-dependent, non-recursive *) Scheme Case for Nat Sort Set. About Nat_case_nodep. Automatic declaration of schemes ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ .. flag:: Elimination Schemes This :term:`flag` enables automatic declaration of induction principles when defining a new inductive type. Defaults to on. .. flag:: Nonrecursive Elimination Schemes This :term:`flag` enables automatic declaration of induction principles for types declared with the :cmd:`Variant` and :cmd:`Record` commands. Defaults to off. .. flag:: Case Analysis Schemes This :term:`flag` governs the generation of case analysis lemmas for inductive types, i.e. corresponding to the pattern matching term alone and without fixpoint. .. flag:: Boolean Equality Schemes Decidable Equality Schemes These :term:`flags ` control the automatic declaration of those Boolean equalities (see the second variant of ``Scheme``). .. warning:: 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 This :term:`flag` governs generation of equality-related schemes such as congruence. Combined Scheme ~~~~~~~~~~~~~~~ .. cmd:: Combined Scheme @ident__def from {+, @ident } Combines induction principles generated by the :cmd:`Scheme` command. 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__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 ``Prop``, the propositional conjunction ``and`` is used, otherwise the simple product ``prod`` is used instead. .. example:: We can define the induction principles for trees and forests using: .. coqtop:: all Scheme tree_forest_ind := Induction for tree Sort Prop with forest_tree_ind := Induction for forest Sort Prop. Then we can build the combined induction principle which gives the conjunction of the conclusions of each individual principle: .. coqtop:: all Combined Scheme tree_forest_mutind from tree_forest_ind,forest_tree_ind. The type of tree_forest_mutind will be: .. coqtop:: all Check tree_forest_mutind. .. example:: We can also combine schemes at sort ``Type``: .. coqtop:: all Scheme tree_forest_rect := Induction for tree Sort Type with forest_tree_rect := Induction for forest Sort Type. .. coqtop:: all Combined Scheme tree_forest_mutrect from tree_forest_rect, forest_tree_rect. .. coqtop:: all Check tree_forest_mutrect. .. seealso:: :ref:`functional-scheme` .. _derive-inversion: Generation of inversion principles with ``Derive`` ``Inversion`` ----------------------------------------------------------------- .. cmd:: Derive Inversion @ident with @one_term {? Sort @sort_family } Generates an inversion lemma for the :tacn:`inversion` 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. .. 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`. .. 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`. .. 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`. .. example:: Consider the relation `Le` over natural numbers and the following parameter ``P``: .. coqtop:: all Inductive Le : nat -> nat -> Set := | LeO : forall n:nat, Le 0 n | LeS : forall n m:nat, Le n m -> Le (S n) (S m). Parameter P : nat -> nat -> Prop. To generate the inversion lemma for the instance :g:`(Le (S n) m)` and the sort :g:`Prop`, we do: .. coqtop:: all Derive Inversion_clear leminv with (forall n m:nat, Le (S n) m) Sort Prop. Check leminv. Then we can use the proven inversion lemma: .. the original LaTeX did not have any Coq code to setup the goal .. coqtop:: none Goal forall (n m : nat) (H : Le (S n) m), P n m. intros. .. coqtop:: all Show. inversion H using leminv. .. _dependent-induction-examples: Examples of :tacn:`dependent destruction` / :tacn:`dependent induction` ----------------------------------------------------------------------- The tactics :tacn:`dependent induction` and :tacn:`dependent destruction` are another solution for inverting inductive predicate instances and potentially doing induction at the same time. It is based on the ``BasicElim`` tactic of Conor McBride which works by abstracting each argument of an inductive instance by a variable and constraining it by equalities afterwards. This way, the usual induction and destruct tactics can be applied to the abstracted instance and after simplification of the equalities we get the expected goals. The abstracting tactic is called generalize_eqs and it takes as argument a hypothesis to generalize. It uses the JMeq datatype defined in Coq.Logic.JMeq, hence we need to require it before. For example, revisiting the first example of the inversion documentation: .. coqtop:: in reset Require Import Coq.Logic.JMeq. Inductive Le : nat -> nat -> Set := | LeO : forall n:nat, Le 0 n | LeS : forall n m:nat, Le n m -> Le (S n) (S m). Parameter P : nat -> nat -> Prop. Goal forall n m:nat, Le (S n) m -> P n m. intros n m H. .. coqtop:: all generalize_eqs H. The index ``S n`` gets abstracted by a variable here, but a corresponding equality is added under the abstract instance so that no information is actually lost. The goal is now almost amenable to do induction or case analysis. One should indeed first move ``n`` into the goal to strengthen it before doing induction, or ``n`` will be fixed in the inductive hypotheses (this does not matter for case analysis). As a rule of thumb, all the variables that appear inside constructors in the indices of the hypothesis should be generalized. This is exactly what the ``generalize_eqs_vars`` variant does: .. coqtop:: all abort generalize_eqs_vars H. induction H. As the hypothesis itself did not appear in the goal, we did not need to use an heterogeneous equality to relate the new hypothesis to the old one (which just disappeared here). However, the tactic works just as well in this case, e.g.: .. coqtop:: none Require Import Coq.Program.Equality. .. coqtop:: in Parameter Q : forall (n m : nat), Le n m -> Prop. Goal forall n m (p : Le (S n) m), Q (S n) m p. .. coqtop:: all intros n m p. generalize_eqs_vars p. One drawback of this approach is that in the branches one will have to substitute the equalities back into the instance to get the right assumptions. Sometimes injection of constructors will also be needed to recover the needed equalities. Also, some subgoals should be directly solved because of inconsistent contexts arising from the constraints on indexes. The nice thing is that we can make a tactic based on discriminate, injection and variants of substitution to automatically do such simplifications (which may involve the axiom K). This is what the ``simplify_dep_elim`` tactic from ``Coq.Program.Equality`` does. For example, we might simplify the previous goals considerably: .. coqtop:: all abort induction p ; simplify_dep_elim. The higher-order tactic ``do_depind`` defined in ``Coq.Program.Equality`` takes a tactic and combines the building blocks we have seen with it: generalizing by equalities calling the given tactic with the generalized induction hypothesis as argument and cleaning the subgoals with respect to equalities. Its most important instantiations are :tacn:`dependent induction` and :tacn:`dependent destruction` that do induction or simply case analysis on the generalized hypothesis. For example we can redo what we've done manually with dependent destruction: .. coqtop:: in Lemma ex : forall n m:nat, Le (S n) m -> P n m. .. coqtop:: in intros n m H. .. coqtop:: all abort dependent destruction H. This gives essentially the same result as inversion. Now if the destructed hypothesis actually appeared in the goal, the tactic would still be able to invert it, contrary to dependent inversion. Consider the following example on vectors: .. coqtop:: in Set Implicit Arguments. .. coqtop:: in Parameter A : Set. .. coqtop:: in Inductive vector : nat -> Type := | vnil : vector 0 | vcons : A -> forall n, vector n -> vector (S n). .. coqtop:: in Goal forall n, forall v : vector (S n), exists v' : vector n, exists a : A, v = vcons a v'. .. coqtop:: in intros n v. .. coqtop:: all dependent destruction v. In this case, the ``v`` variable can be replaced in the goal by the generalized hypothesis only when it has a type of the form ``vector (S n)``, that is only in the second case of the destruct. The first one is dismissed because ``S n <> 0``. A larger example ~~~~~~~~~~~~~~~~ Let's see how the technique works with induction on inductive predicates on a real example. We will develop an example application to the theory of simply-typed lambda-calculus formalized in a dependently-typed style: .. coqtop:: in reset Inductive type : Type := | base : type | arrow : type -> type -> type. .. coqtop:: in Notation " t --> t' " := (arrow t t') (at level 20, t' at next level). .. coqtop:: in Inductive ctx : Type := | empty : ctx | snoc : ctx -> type -> ctx. .. coqtop:: in Notation " G , tau " := (snoc G tau) (at level 20, tau at next level). .. coqtop:: in Fixpoint conc (G D : ctx) : ctx := match D with | empty => G | snoc D' x => snoc (conc G D') x end. .. coqtop:: in Notation " G ; D " := (conc G D) (at level 20). .. coqtop:: in Inductive term : ctx -> type -> Type := | ax : forall G tau, term (G, tau) tau | weak : forall G tau, term G tau -> forall tau', term (G, tau') tau | abs : forall G tau tau', term (G , tau) tau' -> term G (tau --> tau') | app : forall G tau tau', term G (tau --> tau') -> term G tau -> term G tau'. We have defined types and contexts which are snoc-lists of types. We also have a ``conc`` operation that concatenates two contexts. The ``term`` datatype represents in fact the possible typing derivations of the calculus, which are isomorphic to the well-typed terms, hence the name. A term is either an application of: + the axiom rule to type a reference to the first variable in a context + the weakening rule to type an object in a larger context + the abstraction or lambda rule to type a function + the application to type an application of a function to an argument Once we have this datatype we want to do proofs on it, like weakening: .. coqtop:: in abort Lemma weakening : forall G D tau, term (G ; D) tau -> forall tau', term (G , tau' ; D) tau. The problem here is that we can't just use induction on the typing derivation because it will forget about the ``G ; D`` constraint appearing in the instance. A solution would be to rewrite the goal as: .. coqtop:: in abort Lemma weakening' : forall G' tau, term G' tau -> forall G D, (G ; D) = G' -> forall tau', term (G, tau' ; D) tau. With this proper separation of the index from the instance and the right induction loading (putting ``G`` and ``D`` after the inducted-on hypothesis), the proof will go through, but it is a very tedious process. One is also forced to make a wrapper lemma to get back the more natural statement. The :tacn:`dependent induction` tactic alleviates this trouble by doing all of this plumbing of generalizing and substituting back automatically. Indeed we can simply write: .. coqtop:: in Require Import Coq.Program.Tactics. Require Import Coq.Program.Equality. .. coqtop:: in Lemma weakening : forall G D tau, term (G ; D) tau -> forall tau', term (G , tau' ; D) tau. .. coqtop:: in Proof with simpl in * ; simpl_depind ; auto. .. coqtop:: in intros G D tau H. dependent induction H generalizing G D ; intros. This call to :tacn:`dependent induction` has an additional arguments which is a list of variables appearing in the instance that should be generalized in the goal, so that they can vary in the induction hypotheses. By default, all variables appearing inside constructors (except in a parameter position) of the instantiated hypothesis will be generalized automatically but one can always give the list explicitly. .. coqtop:: all Show. The ``simpl_depind`` tactic includes an automatic tactic that tries to simplify equalities appearing at the beginning of induction hypotheses, generally using trivial applications of ``reflexivity``. In cases where the equality is not between constructor forms though, one must help the automation by giving some arguments, using the ``specialize`` tactic for example. .. coqtop:: in destruct D... apply weak; apply ax. apply ax. .. coqtop:: in destruct D... .. coqtop:: all Show. .. coqtop:: all specialize (IHterm G0 empty eq_refl). Once the induction hypothesis has been narrowed to the right equality, it can be used directly. .. coqtop:: all apply weak, IHterm. Now concluding this subgoal is easy. .. coqtop:: in constructor; apply IHterm; reflexivity. coq-8.20.0/doc/sphinx/proofs/writing-proofs/rewriting.rst000066400000000000000000000001261466560755400235270ustar00rootroot00000000000000:orphan: .. raw:: html coq-8.20.0/doc/sphinx/refman-preamble.rst000066400000000000000000000022631466560755400202550ustar00rootroot00000000000000.. This file is automatically prepended to all other files using the ``rst_prolog`` option. .. only:: html .. This is included once per page in the HTML build, and a single time (in the document's preamble) in the LaTeX one. .. preamble:: /refman-preamble.sty .. Some handy replacements for common items .. role:: smallcaps .. |c_1| replace:: `c`\ :math:`_{1}` .. |c_i| replace:: `c`\ :math:`_{i}` .. |c_n| replace:: `c`\ :math:`_{n}` .. |Cic| replace:: CIC .. |eq_beta_delta_iota_zeta| replace:: `=`\ :math:`_{βδιζ}` .. |Latex| replace:: :smallcaps:`LaTeX` .. |Ltac| replace:: `L`:sub:`tac` .. |p_1| replace:: `p`\ :math:`_{1}` .. |p_i| replace:: `p`\ :math:`_{i}` .. |p_n| replace:: `p`\ :math:`_{n}` .. |Program| replace:: :strong:`Program` .. |Prop| replace:: :math:`\Prop` .. |SProp| replace:: :math:`\SProp` .. |Set| replace:: :math:`\Set` .. |SSR| replace:: :smallcaps:`SSReflect` .. |Type| replace:: :math:`\Type` .. |t_1| replace:: `t`\ :math:`_{1}` .. |t_i| replace:: `t`\ :math:`_{i}` .. |t_m| replace:: `t`\ :math:`_{m}` .. |t_n| replace:: `t`\ :math:`_{n}` .. |x_1| replace:: `x`\ :math:`_{1}` .. |x_i| replace:: `x`\ :math:`_{i}` .. |x_n| replace:: `x`\ :math:`_{n}` coq-8.20.0/doc/sphinx/refman-preamble.sty000066400000000000000000000052121466560755400202610ustar00rootroot00000000000000\newcommand{\as}{\kw{as}} \newcommand{\case}{\kw{case}} \newcommand{\cons}{\textsf{cons}} \newcommand{\consf}{\textsf{consf}} \newcommand{\emptyf}{\textsf{emptyf}} \newcommand{\End}{\kw{End}} \newcommand{\kwend}{\kw{end}} \newcommand{\even}{\textsf{even}} \newcommand{\evenO}{\textsf{even}_\textsf{O}} \newcommand{\evenS}{\textsf{even}_\textsf{S}} \newcommand{\Fix}{\kw{Fix}} \newcommand{\fix}{\kw{fix}} \newcommand{\for}{\textsf{for}} \newcommand{\forest}{\textsf{forest}} \newcommand{\Functor}{\kw{Functor}} \newcommand{\In}{\kw{in}} \newcommand{\ind}[3]{\kw{Ind}~[#1]\left(#2\mathrm{~:=~}#3\right)} \newcommand{\Indp}[4]{\kw{Ind}_{#4}[#1](#2:=#3)} \newcommand{\Indpstr}[5]{\kw{Ind}_{#4}[#1](#2:=#3)/{#5}} \newcommand{\injective}{\kw{injective}} \newcommand{\kw}[1]{\textsf{#1}} \newcommand{\length}{\textsf{length}} \newcommand{\letin}[3]{\kw{let}~#1:=#2~\kw{in}~#3} \newcommand{\List}{\textsf{list}} \newcommand{\lra}{\longrightarrow} \newcommand{\Match}{\kw{match}} \newcommand{\Mod}[3]{{\kw{Mod}}({#1}:{#2}\,\zeroone{:={#3}})} \newcommand{\ModImp}[3]{{\kw{Mod}}({#1}:{#2}:={#3})} \newcommand{\ModA}[2]{{\kw{ModA}}({#1}=={#2})} \newcommand{\ModS}[2]{{\kw{Mod}}({#1}:{#2})} \newcommand{\ModType}[2]{{\kw{ModType}}({#1}:={#2})} \newcommand{\mto}{.\;} \newcommand{\nat}{\textsf{nat}} \newcommand{\Nil}{\textsf{nil}} \newcommand{\nilhl}{\textsf{nil\_hl}} \newcommand{\nO}{\textsf{O}} \newcommand{\node}{\textsf{node}} \newcommand{\nS}{\textsf{S}} \newcommand{\odd}{\textsf{odd}} \newcommand{\oddS}{\textsf{odd}_\textsf{S}} \newcommand{\ovl}[1]{\overline{#1}} \newcommand{\Pair}{\textsf{pair}} \newcommand{\plus}{\mathsf{plus}} \newcommand{\SProp}{\textsf{SProp}} \newcommand{\Prop}{\textsf{Prop}} \newcommand{\return}{\kw{return}} \newcommand{\Set}{\textsf{Set}} \newcommand{\Sort}{\mathcal{S}} \newcommand{\Str}{\textsf{Stream}} \newcommand{\Struct}{\kw{Struct}} \newcommand{\subst}[3]{#1\{#2/#3\}} \newcommand{\tl}{\textsf{tl}} \newcommand{\tree}{\textsf{tree}} \newcommand{\trii}{\triangleright_\iota} \newcommand{\Type}{\textsf{Type}} \newcommand{\WEV}[3]{\mbox{$#1[] \vdash #2 \lra #3$}} \newcommand{\WEVT}[3]{\mbox{$#1[] \vdash #2 \lra$}\\ \mbox{$ #3$}} \newcommand{\WF}[2]{{\mathcal{W\!F}}(#1)[#2]} \newcommand{\WFE}[1]{\WF{E}{#1}} \newcommand{\WFT}[2]{#1[] \vdash {\mathcal{W\!F}}(#2)} \newcommand{\WFTWOLINES}[2]{{\mathcal{W\!F}}\begin{array}{l}(#1)\\\mbox{}[{#2}]\end{array}} \newcommand{\with}{\kw{with}} \newcommand{\WS}[3]{#1[] \vdash #2 <: #3} \newcommand{\WSE}[2]{\WS{E}{#1}{#2}} \newcommand{\WT}[4]{#1[#2] \vdash #3 : #4} \newcommand{\WTE}[3]{\WT{E}{#1}{#2}{#3}} \newcommand{\WTEG}[2]{\WTE{\Gamma}{#1}{#2}} \newcommand{\WTM}[3]{\WT{#1}{}{#2}{#3}} \newcommand{\zeroone}[1]{[{#1}]} coq-8.20.0/doc/sphinx/std-glossindex.rst000066400000000000000000000001511466560755400201610ustar00rootroot00000000000000:orphan: .. hack to get index in TOC .. _glossary_index: -------------- Glossary index -------------- coq-8.20.0/doc/sphinx/user-extensions/000077500000000000000000000000001466560755400176365ustar00rootroot00000000000000coq-8.20.0/doc/sphinx/user-extensions/proof-schemes.rst000066400000000000000000000001731466560755400231430ustar00rootroot00000000000000:orphan: .. raw:: html coq-8.20.0/doc/sphinx/user-extensions/syntax-extensions.rst000066400000000000000000003176311466560755400241260ustar00rootroot00000000000000.. _syntax-extensions-and-notation-scopes: Syntax extensions and notation scopes ===================================== 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. The main commands to provide custom symbolic notations for terms are :cmd:`Notation` and :cmd:`Infix`; they will be described in the :ref:`next section `. There is also a variant of :cmd:`Notation` which does not modify the parser; this provides a form of :ref:`abbreviation `. It is sometimes expected that the same symbolic notation has different meanings in different contexts; to achieve this form of overloading, Coq offers a notion of :ref:`notation scopes `. The main command to provide custom notations for tactics is :cmd:`Tactic Notation`. .. coqtop:: none Set Printing Depth 50. .. _Notations: Notations --------- .. _BasicNotations: Basic notations ~~~~~~~~~~~~~~~ .. cmd:: Notation @notation_declaration .. insertprodn notation_declaration notation_declaration .. prodn:: notation_declaration ::= @string := @one_term {? ( {+, @syntax_modifier } ) } {? : @scope_name } Defines a *notation*, an alternate syntax for entering or displaying a specific term or term pattern. This command supports the :attr:`local` attribute, which limits its effect to the current module. If the command is inside a section, its effect is limited to the section. Specifying :token:`scope_name` associates the notation with that scope. Otherwise it is a :gdef:`lonely notation`, that is, not associated with a scope. .. todo indentation of this chapter is not consistent with other chapters. Do we have a standard? For example, the following definition permits using the infix expression :g:`A /\ B` to represent :g:`(and A B)`: .. coqtop:: in Notation "A /\ B" := (and A B). :g:`"A /\ B"` is a *notation*, which tells how to represent the abbreviated term :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. 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*, which must appear literally when the notation is used. Identifiers enclosed in single quotes are treated as symbols and thus lose their role as parameters. For example: .. coqtop:: in Notation "'IF' c1 'then' c2 'else' c3" := (c1 /\ c2 \/ ~ c1 /\ c3) (at level 200, right associativity). Symbols that start with a single quote followed by at least 2 characters must be single quoted. For example, the symbol `'ab` is represented by `''ab'` in the notation string. Quoted strings can be used in notations: they must begin and end with two double quotes. Embedded spaces in these strings are part of the string and do not contribute to the separation between notation tokens. To embed double quotes in these strings, use four double quotes (e.g. the notation :g:`"A ""I'm an """"infix"""" string symbol"" B"` defines an infix notation whose infix symbol is the string :g:`"I'm an ""infix"" string symbol"`). Symbols may contain double quotes without being strings themselves (as e.g. in symbol :g:`|"|`) but notations with such symbols can be used only for printing (see :ref:`Use of notations for printing `). In this case, no spaces are allowed in the symbol. Also, if the symbol starts with a double quote, it must be surrounded with single quotes to prevent confusion with the beginning of a string symbol. A notation binds a syntactic expression to a term, called its :gdef:`interpretation`. Unless the parser 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. .. note:: The right-hand side of a notation is interpreted at the time the notation is given. Disambiguation of constants, :ref:`implicit arguments ` and other notations are resolved at the 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. .. exn:: Unterminated string in notation Occurs when the notation string contains an unterminated quoted string, as e.g. in :g:`Reserved Notation "A ""an unended string B"`, for which the user may instead mean :g:`Reserved Notation "A ""an ended string"" B`. .. exn:: End of quoted string not followed by a space in notation. Occurs when the notation string contains a quoted string which contains a double quote not ending the quoted string, as e.g. in :g:`Reserved Notation "A ""string""! B"` or `Reserved Notation "A ""string""!"" B"`, for which the user may instead mean :g:`Reserved Notation "A ""string"""" ! B`, :g:`Reserved Notation "A ""string""""!"" B`, or :g:`Reserved Notation "A '""string""!' B`. 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 precedence levels ranging from 0 to 100 (plus one extra level numbered 200) and associativity rules. Consider for example the new notation .. coqtop:: in 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 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 notation, knowing that a lower level binds more than a higher level. Hence the level for disjunction must be higher than the level for conjunction. Since connectives are not tight articulation points of a text, it is reasonable to choose levels not so far from the highest level which is 100, for example 85 for disjunction and 80 for conjunction [#and_or_levels]_. Similarly, an associativity is needed to decide whether :g:`True /\ False /\ False` defaults to :g:`True /\ (False /\ False)` (right associativity) or to :g:`(True /\ False) /\ False` (left associativity). We may even consider that the 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). 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: .. coqtop:: in Notation "A /\ B" := (and A B) (at level 80, right associativity). Notation "A \/ B" := (or A B) (at level 85, right associativity). By default, a notation is considered nonassociative, but the precedence level is mandatory (except for special cases whose level is canonical). The level is either a number or the phrase ``next level`` whose meaning is obvious. Some :ref:`associativities are predefined ` in the ``Notations`` module. .. TODO I don't find it obvious -- CPC Complex notations ~~~~~~~~~~~~~~~~~ Notations can be made from arbitrarily complex symbols. One can for instance define prefix notations. .. coqtop:: in Notation "~ x" := (not x) (at level 75, right associativity). One can also define notations for incomplete terms, with the hole expected to be inferred during type checking. .. coqtop:: in Notation "x = y" := (@eq _ x y) (at level 70, no associativity). One can define *closed* notations whose both sides are symbols. In this case, the default precedence level for the inner sub-expression is 200, and the default level for the notation itself is 0. .. coqtop:: in Notation "( x , y )" := (@pair _ _ x y). One can also define notations for binders. .. coqtop:: in Notation "{ x : A | P }" := (sig A (fun x => P)). In the last case though, there is a conflict with the notation for type casts. The notation for type casts, as shown by the command :cmd:`Print Grammar` `constr` is at level 100. To avoid ``x : A`` being parsed as a type cast, it is necessary to put ``x`` at a level below 100, typically 99. Hence, a correct definition is the following: .. coqtop:: reset all Notation "{ x : A | P }" := (sig A (fun x => P)) (x at level 99). More generally, it is required that notations are explicitly factorized on the left. See the next section for more about factorization. .. _NotationFactorization: Simple factorization rules ~~~~~~~~~~~~~~~~~~~~~~~~~~ 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. Indeed notations with a common prefix but different levels can interfere with one another, making some of them unusable. For instance, a notation ``x << y`` with ``x`` and ``y`` at level 69 would be broken by another rule that puts ``y`` at another level, like ``x << y << z`` with ``x`` at level 69 and ``y`` at level 200. To avoid such issues, you should left factorize rules, that is ensure that common prefixes use the samel levels. .. coqtop:: all Reserved Notation "x << y" (at level 70). Fail Reserved Notation "x << y << z" (at level 70, y at level 200). In order to factorize the left part of the rules, the subexpression referred to by ``y`` has to be at the same level in both rules. However the default behavior puts ``y`` at the next level below 70 in the first rule (``no associativity`` is the default). To fix this, we need to force the parsing level of ``y``, as follows. .. coqtop:: reset all Reserved Notation "x << y" (at level 70). Reserved Notation "x << y << z" (at level 70, y at next level). Or better yet, simply let the defaults ensure the best factorization. .. coqtop:: reset all Reserved Notation "x << y" (at level 70). Reserved Notation "x << y << z". Print Notation "_ << _ << _". 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`. .. warn:: Closed notations (i.e. starting and ending with a terminal symbol) should usually be at level 0 (default). :name: closed-notation-not-level-0 It is usually better to put closed notations, that is the ones starting and ending with a terminal symbol, at level 0. .. warn:: Postfix notations (i.e. starting with a nonterminal symbol and ending with a terminal symbol) should usually be at level 1 (default).") :name: postfix-notation-not-level-1 It is usually better to put postfix notations, that is the ones ending with a terminal symbol, at level 1. .. _UseOfNotationsForPrinting: Use of notations for printing ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ The command :cmd:`Notation` has an effect both on the Coq parser and on the Coq printer. For example: .. coqtop:: all Check (and True True). 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 formatting library, which provides indentation and automatic line breaks depending on page width by means of *formatting boxes*. The default printing of notations is rudimentary. For printing a notation, a formatting box is opened in such a way that if the notation and its arguments cannot fit on a single line, a line break is inserted before the symbols of the notation and the arguments on the next lines are aligned with the argument on the first line. A first, simple control that a user can have on the printing of a notation is the insertion of spaces at some places of the notation. This is performed by adding extra spaces between the symbols and parameters: each extra space (other than the single space needed to separate the components) is interpreted as a space to be inserted by the printer. Here is an example showing how to add spaces next to the curly braces. .. coqtop:: in Notation "{{ x : A | P }}" := (sig (fun x : A => P)) (at level 0, x at level 99). .. coqtop:: all Check (sig (fun x : nat => x=x)). The second, more powerful control on printing is by using :n:`@syntax_modifier`\s. Here is an example .. coqtop:: in Definition IF_then_else (P Q R:Prop) := P /\ Q \/ ~ P /\ R. .. coqtop:: all Notation "'If' c1 'then' c2 'else' c3" := (IF_then_else c1 c2 c3) (at level 200, right associativity, format "'[v ' 'If' c1 '/' '[' 'then' c2 ']' '/' '[' 'else' c3 ']' ']'"). .. coqtop:: all Check (IF_then_else (IF_then_else True False True) (IF_then_else True False True) (IF_then_else True False True)). A *format* tells how to control the indentation and line breaks when printing a notation. It is a string extending the notation with the possible following elements delimited by single quotes: - tokens of the form ``'/ '`` are translated into breaking points. If there is a line break, indents the number of spaces appearing after the “``/``” (no indentation in the example) - tokens of the form ``'//'`` force writing on a new line - well-bracketed pairs of tokens of the form ``'[ '`` and ``']'`` are translated into printing boxes; if there is a line break, an extra indentation of the number of spaces after the “``[``” is applied - well-bracketed pairs of tokens of the form ``'[hv '`` and ``']'`` are translated into horizontal-or-else-vertical printing boxes; if the content of the box does not fit on a single line, then every breaking point forces a new line and an extra indentation of the number of spaces after the “``[hv``” is applied at the beginning of each new line - well-bracketed pairs of tokens of the form ``'[v '`` and ``']'`` are translated into vertical printing boxes; every breaking point forces a new line, even if the line is large enough to display the whole content of the box, and an extra indentation of the number of spaces after the “``[v``” is applied at the beginning of each new line (3 spaces in the example) - extra spaces in other tokens are preserved in the output 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:: 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 overridden, 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. Notations used for parsing, that is notations not restricted with the ``only printing`` modifier, can have only a single interpretation per scope. On the other side, notations marked with ``only printing`` can have multiple associated interpretations, even in the same scope. .. note:: When several notations can be used to print a given term, the notations which capture the largest subterm of the term are used preferentially. Here is an example: .. coqtop:: in Notation "x < y" := (lt x y) (at level 70). Notation "x < y < z" := (lt x y /\ lt y z) (at level 70, y at next level). Check (0 < 1 /\ 1 < 2). When several notations match the same subterm, or incomparable subterms of the term to print, the notation declared most recently is selected. Moreover, reimporting a library or module declares the notations of this library or module again. If the notation is in a scope (see :ref:`Scopes`), either the scope has to be opened or a delimiter has to exist in the scope for the notation to be usable. The Infix command ~~~~~~~~~~~~~~~~~~ The :cmd:`Infix` command is a shortcut for declaring notations for infix symbols. .. cmd:: Infix @notation_declaration The command :n:`Infix @string := @one_term {? ( {+, @syntax_modifier } ) } {? : @scope_name }` is equivalent to :n:`Notation "x @string y" := (@one_term x y) {? ( {+, @syntax_modifier } ) } {? : @scope_name }` where ``x`` and ``y`` are fresh names and omitting the quotes around :n:`@string`. Here is an example: .. coqtop:: in Infix "/\" := and (at level 80, right associativity). .. _ReservingNotations: Reserving notations ~~~~~~~~~~~~~~~~~~~ .. cmd:: Reserved Notation @string {? ( {+, @syntax_modifier } ) } 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. .. coqtop:: in Reserved Notation "x = y" (at level 70, no associativity). Reserving a notation is also useful for simultaneously defining an inductive type or a recursive constant and a notation for it. .. note:: The notations mentioned in the module :ref:`init-notations` are reserved. Hence their precedence and associativity cannot be changed. .. cmd:: Reserved Infix @string {? ( {+, @syntax_modifier } ) } This command declares an infix parsing rule without giving its interpretation. When a format is attached to a reserved notation (with the `format` :token:`syntax_modifier`), it is used by default by all subsequent interpretations of the corresponding notation. Individual interpretations can override the format. .. warn:: Notations "a b" defined at level x and "a c" defined at level y have incompatible prefixes. One of them will likely not work. :name: notation-incompatible-prefix The two notations have a common prefix but different levels. The levels of one of the notations should be adjusted to match the other. See :ref:`factorization ` for details. Simultaneous definition of terms and notations ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Thanks to reserved notations, inductive and coinductive type declarations, recursive and corecursive definitions can use customized notations. To do this, insert a :token:`decl_notations` clause after the definition of the (co)inductive type or (co)recursive term (or after the definition of each of them in case of mutual definitions). Note that only syntax modifiers that do not require adding or changing a parsing rule are accepted. .. insertprodn decl_notations decl_notations .. prodn:: decl_notations ::= where @notation_declaration {* and @notation_declaration } Here are examples: .. coqtop:: in Reserved Notation "A & B" (at level 80). .. coqtop:: in Inductive and' (A B : Prop) : Prop := conj' : A -> B -> A & B where "A & B" := (and' A B). .. without this we get "not a truly recursive fixpoint" .. coqtop:: none Arguments S _ : clear scopes. .. coqtop:: in Fixpoint plus (n m : nat) {struct n} : nat := match n with | O => m | S p => S (p + m) end where "n + m" := (plus n m). Enabling and disabling notations ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ .. cmd:: {| Enable | Disable } Notation {? {| @string | @qualid {* @ident__parm } } } {? := @one_term } {? ( {+, @enable_notation_flag } ) } {? {| : @scope_name | : no scope } } :name: Enable Notation; Disable Notation .. insertprodn enable_notation_flag enable_notation_flag .. prodn:: enable_notation_flag ::= all | only parsing | only printing | in custom @ident | in constr Enables or disables notations previously defined with :cmd:`Notation` or :cmd:`Notation (abbreviation)`. Disabling a notation doesn't remove parsing rules or tokens defined by the notation. The command has no effect on notations reserved with :cmd:`Reserved Notation`. At least one of :token:`string`, :token:`qualid`, :token:`one_term` or :token:`scope_name` must be provided. When multiple clauses are provided, the notations enabled or disabled must satisfy all of their constraints. This command supports the :attr:`local` and :attr:`global` attributes. :n:`@string` Notations to enable or disable. :n:`@string` can be a single token in the notation such as "`->`" or a pattern that matches the notation. See :ref:`locating-notations`. If no :n:`{? := @one_term }` is given, the variables of the notation can be replaced by :n:`_`. :n:`@qualid {* @ident__parm }` Enable or disable :ref:`abbreviations ` whose absolute name has :n:`@qualid` as a suffix. The :n:`{* @ident__parm }` are the parameters of the abbreviation. :n:`{? := @one_term }` Enable or disable notations matching :token:`one_term`. :token:`one_term` can be written using notations or not, as well as :n:`_`, just like in the :cmd:`Notation` command. If no :n:`@string` nor :n:`@qualid {* @ident__parm }` is given, the variables of the notation can be replaced by :n:`_`. :n:`all` Enable or disable all notations meeting the given constraints, even if there are multiple ones. Otherwise, there must be a single notation meeting the constraints. :n:`only parsing` The notation is enabled or disabled only for parsing. :n:`only printing` The notation is enabled or disabled only for printing. :n:`in custom @ident` Enable or disable notations in the given :ref:`custom entry `. :n:`in constr` Enable or disable notations in the custom entry for :n:`constr`. See :ref:`custom entries `. :n:`{| : @scope_name | : no scope }` If given, only notations in scope :token:`scope_name` are affected (or :term:`lonely notations ` for :n:`no scope`). .. exn:: Unexpected only printing for an only parsing notation. Cannot enable or disable for printing a notation that was originally defined as only parsing. .. exn:: Unexpected only parsing for an only printing notation. Cannot enable or disable for parsing a notation that was originally defined as only printing. .. warn:: Found no matching notation to enable or disable. :name: Found no matching notation to enable or disable No previously defined notation satisfies the given constraints. .. exn:: More than one interpretation bound to this notation, confirm with the "all" modifier. Use :n:`all` to allow enabling or disabling multiple notations in a single command. .. exn:: Unknown custom entry. In :n:`in custom @ident`, :token:`ident` is not a valid custom entry name. .. exn:: No notation provided. At least one of :token:`string`, :token:`qualid`, :token:`one_term` or :token:`scope_name` must be provided. .. warn:: Activation of abbreviations does not expect mentioning a grammar entry. ``in custom`` and ``in constr`` are not compatible with :ref:`abbreviations `. .. warn:: Activation of abbreviations does not expect mentioning a scope. Scopes are not compatible with :ref:`abbreviations `. .. example:: Enabling and disabling notations .. coqtop:: all Disable Notation "+" (all). Enable Notation "_ + _" (all) : type_scope. Disable Notation "x + y" := (sum x y). Displaying information about notations ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ .. flag:: Printing Notations This :term:`flag` controls whether to use notations for printing terms wherever possible. Default is on. .. flag:: Printing Raw Literals This :term:`flag` controls whether to use string and number notations for printing terms wherever possible (see :ref:`string-notations`). Default is off. .. flag:: Printing Parentheses When this :term:`flag` is on, parentheses are printed even if implied by associativity and precedence. Default is off. .. seealso:: :flag:`Printing All` to disable other elements in addition to notations. .. cmd:: Print Notation @string {? in custom @ident } Displays information about the previously reserved notation string :token:`string`. :token:`ident`, if specified, is the name of the associated custom entry. See :cmd:`Declare Custom Entry`. .. coqtop:: all Reserved Notation "x # y" (at level 123, right associativity). Print Notation "_ # _". Variables can be indicated with either `"_"` or names, as long as these can not be confused with notation symbols. When confusion may arise, for example with notation symbols that are entirely made up of letters, use single quotes to delimit those symbols. Using `"_"` is preferred, as it avoids this confusion. Note that there must always be (at least) a space between notation symbols and arguments, even when the notation format does not include those spaces. .. example:: :cmd:`Print Notation` .. coqtop:: all Reserved Notation "x 'mod' y" (at level 40, no associativity). Print Notation "_ mod _". Print Notation "x 'mod' y". Reserved Notation "# x #" (at level 0, format "# x #"). Fail Print Notation "#x#". Print Notation "# x #". Reserved Notation "( x , y , .. , z )" (at level 0). Print Notation "( _ , _ , .. , _ )". Reserved Notation "x $ y" (at level 50, left associativity). Declare Custom Entry expr. Reserved Notation "x $ y" (in custom expr at level 30, x custom expr, y at level 80, no associativity). Print Notation "_ $ _". Print Notation "_ $ _" in custom expr. .. exn:: @string cannot be interpreted as a known notation. Make sure that symbols are surrounded by spaces and that holes are explicitly denoted by "_". Occurs when :cmd:`Print Notation` can't find a notation associated with :token:`string`. This can happen, for example, when the notation does not exist in the current context, :token:`string` is not specific enough, there are missing spaces between symbols, or some symbols need to be quoted with `"'"`. .. exn:: @string cannot be interpreted as a known notation in @ident entry. Make sure that symbols are surrounded by spaces and that holes are explicitly denoted by "_". :undocumented: .. seealso:: :cmd:`Locate` for information on the definitions and scopes associated with a notation. .. cmd:: Print Keywords Prints the current reserved :ref:`keywords ` and parser tokens, one per line. Keywords cannot be used as identifiers. .. cmd:: Print Grammar {* @ident } When no :token:`ident` is provided, shows the whole grammar. Otherwise shows the grammar for the nonterminal :token:`ident`\s, except for the following, which will include some related nonterminals: - `constr` - for :token:`term`\s - `tactic` - for currently-defined tactic notations, :token:`tactic`\s and tacticals (corresponding to :token:`ltac_expr` in the documentation). - `vernac` - for :token:`command`\s - `ltac2` - for Ltac2 notations (corresponding to :token:`ltac2_expr`) This command can display any nonterminal in the grammar reachable from `vernac_control`. Most of the grammar in the documentation was updated in 8.12 to make it accurate and readable. This was done using a new developer tool that extracts the grammar from the source code, edits it and inserts it into the documentation files. While the edited grammar is equivalent to the original, for readability some nonterminals have been renamed and others have been eliminated by substituting the nonterminal definition where the nonterminal was referenced. This command shows the original grammar, so it won't exactly match the documentation. The Coq parser is based on Camlp5. The documentation for `Extensible grammars `_ is the most relevant but it assumes considerable knowledge. Here are the essentials: Productions can contain the following elements: - nonterminal names - identifiers in the form `[a-zA-Z0-9_]*` - `"…"` - a literal string that becomes a keyword and cannot be used as an :token:`ident`. The string doesn't have to be a valid identifier; frequently the string will contain only punctuation characters. - `IDENT "…"` - a literal string that has the form of an :token:`ident` - `OPT element` - optionally include `element` (e.g. a nonterminal, IDENT "…" or "…") - `LIST1 element` - a list of one or more `element`\s - `LIST0 element` - an optional list of `element`\s - `LIST1 element SEP sep` - a list of `element`\s separated by `sep` - `LIST0 element SEP sep` - an optional list of `element`\s separated by `sep` - `[ elements1 | elements2 | … ]` - alternatives (either `elements1` or `elements2` or …) Nonterminals can have multiple **levels** to specify precedence and associativity of its productions. This feature of grammars makes it simple to parse input such as `1+2*3` in the usual way as `1+(2*3)`. However, most nonterminals have a single level. For example, this output from `Print Grammar tactic` shows the first 3 levels for `ltac_expr`, designated as "5", "4" and "3". Level 3 is right-associative, which applies to the productions within it, such as the `try` construct:: Entry ltac_expr is [ "5" RIGHTA [ ] | "4" LEFTA [ SELF; ";"; SELF | SELF; ";"; tactic_then_locality; for_each_goal; "]" ] | "3" RIGHTA [ IDENT "try"; SELF : The interpretation of `SELF` depends on its position in the production and the associativity of the level: - At the beginning of a production, `SELF` means the next level. In the fragment shown above, the next level for `try` is "2". (This is defined by the order of appearance in the grammar or output; the levels could just as well be named "foo" and "bar".) - In the middle of a production, `SELF` means the top level ("5" in the fragment) - At the end of a production, `SELF` means the next level within `LEFTA` levels and the current level within `RIGHTA` levels. `NEXT` always means the next level. `nonterminal LEVEL "…"` is a reference to the specified level for `nonterminal`. `Associativity `_ explains `SELF` and `NEXT` in somewhat more detail. The output for `Print Grammar constr` includes :cmd:`Notation` definitions, which are dynamically added to the grammar at run time. For example, in the definition for `term`, the production on the second line shown here is defined by a :cmd:`Reserved Notation` command in `Notations.v`:: | "50" LEFTA [ SELF; "||"; NEXT Similarly, `Print Grammar tactic` includes :cmd:`Tactic Notation`\s, such as :tacn:`dintuition`. The file `doc/tools/docgram/fullGrammar `_ in the source tree extracts the full grammar for Coq (not including notations and tactic notations defined in `*.v` files nor some optionally-loaded plugins) in a single file with minor changes to handle nonterminals using multiple levels (described in `doc/tools/docgram/README.md `_). This is complete and much easier to read than the grammar source files. `doc/tools/docgram/orderedGrammar `_ has the edited grammar that's used in the documentation. Developer documentation for parsing is in `dev/doc/parsing.md `_. .. _locating-notations: Locating notations ~~~~~~~~~~~~~~~~~~ To know to which notations a given symbol belongs to, use the :cmd:`Locate` command. You can call it on any (composite) symbol surrounded by double quotes. To locate a particular notation, use a string where the variables of the notation are replaced by “``_``” and where possible single quotes inserted around identifiers or tokens starting with a single quote are dropped. .. coqtop:: all Locate "exists". Locate "exists _ .. _ , _". Inheritance of the properties of arguments of constants bound to a notation ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ If the right-hand side of a notation is a partially applied constant, the notation inherits the implicit arguments (see :ref:`ImplicitArguments`) and notation scopes (see :ref:`Scopes`) of the constant. For instance: .. coqtop:: in reset Record R := {dom : Type; op : forall {A}, A -> dom}. Notation "# x" := (@op x) (at level 8). .. coqtop:: all Check fun x:R => # x 3. As an exception, if the right-hand side is just of the form :n:`@@qualid`, this conventionally stops the inheritance of implicit arguments (but not of notation scopes). .. _notations-and-binders: Notations and binders ~~~~~~~~~~~~~~~~~~~~~ Notations can include binders. This section lists different ways to deal with binders. For further examples, see also :ref:`RecursiveNotationsWithBinders`. Binders bound in the notation and parsed as identifiers +++++++++++++++++++++++++++++++++++++++++++++++++++++++ Here is the basic example of a notation using a binder: .. coqtop:: in Notation "'sigma' x : A , B" := (sigT (fun x : A => B)) (at level 200, x name, A at level 200, right associativity). The binding variables in the right-hand side that occur as a parameter of the notation (here :g:`x`) dynamically bind all the occurrences in their respective binding scope after instantiation of the parameters of the notation. This means that the term bound to :g:`B` can refer to the variable name bound to :g:`x` as shown in the following application of the notation: .. coqtop:: all Check sigma z : nat, z = 0. Note the :n:`@syntax_modifier x name` in the declaration of the notation. It tells to parse :g:`x` as a single identifier (or as the unnamed variable :g:`_`). Binders bound in the notation and parsed as patterns ++++++++++++++++++++++++++++++++++++++++++++++++++++ In the same way as patterns can be used as binders, as in :g:`fun '(x,y) => x+y` or :g:`fun '(existT _ x _) => x`, notations can be defined so that any :n:`@pattern` can be used in place of the binder. Here is an example: .. coqtop:: in reset Notation "'subset' ' p , P " := (sig (fun p => P)) (at level 200, p pattern, format "'subset' ' p , P"). .. coqtop:: all Check subset '(x,y), x+y=0. The :n:`@syntax_modifier p pattern` in the declaration of the notation tells to parse :g:`p` as a pattern. Note that a single variable is both an identifier and a pattern, so, e.g., the following also works: .. coqtop:: all Check subset 'x, x=0. If one wants to prevent such a notation to be used for printing when the pattern is reduced to a single identifier, one has to use instead the :n:`@syntax_modifier p strict pattern`. For parsing, however, a ``strict pattern`` will continue to include the case of a variable. Here is an example showing the difference: .. coqtop:: in Notation "'subset_bis' ' p , P" := (sig (fun p => P)) (at level 200, p strict pattern). Notation "'subset_bis' p , P " := (sig (fun p => P)) (at level 200, p name). .. coqtop:: all Check subset_bis 'x, x=0. The default level for a ``pattern`` is 0. One can use a different level by using ``pattern at level`` :math:`n` where the scale is the same as the one for terms (see :ref:`init-notations`). Binders bound in the notation and parsed as terms +++++++++++++++++++++++++++++++++++++++++++++++++ Sometimes, for the sake of factorization of rules, a binder has to be parsed as a term. This is typically the case for a notation such as the following: .. coqdoc:: Notation "{ x : A | P }" := (sig (fun x : A => P)) (at level 0, x at level 99 as name). This is so because the grammar also contains rules starting with :g:`{}` and followed by a term, such as the rule for the notation :g:`{ A } + { B }` for the constant :g:`sumbool` (see :ref:`specification`). Then, in the rule, ``x name`` is replaced by ``x at level 99 as name`` meaning that ``x`` is parsed as a term at level 99 (as done in the notation for :g:`sumbool`), but that this term has actually to be a name, i.e. an identifier or :g:`_`. The notation :g:`{ x | P }` is already defined in the standard library with the ``as name`` :n:`@syntax_modifier`. We cannot redefine it but one can define an alternative notation, say :g:`{ p such that P }`, using instead ``as pattern``. .. coqtop:: in Notation "{ p 'such' 'that' P }" := (sig (fun p => P)) (at level 0, p at level 99 as pattern). Then, the following works: .. coqtop:: all Check {(x,y) such that x+y=0}. To enforce that the pattern should not be used for printing when it is just a name, one could have said ``p at level 99 as strict pattern``. Note also that in the absence of a ``as name``, ``as strict pattern`` or ``as pattern`` :n:`@syntax_modifier`\s, the default is to consider sub-expressions occurring in binding position and parsed as terms to be ``as name``. Binders bound in the notation and parsed as general binders +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ It is also possible to rely on Coq's syntax of binders using the `binder` modifier as follows: .. coqtop:: in Notation "'myforall' p , [ P , Q ] " := (forall p, P -> Q) (at level 200, p binder). In this case, all of :n:`@ident`, :n:`{@ident}`, :n:`[@ident]`, :n:`@ident:@type`, :n:`{@ident:@type}`, :n:`[@ident:@type]`, :n:`'@pattern` can be used in place of the corresponding notation variable. In particular, the binder can declare implicit arguments: .. coqtop:: all Check fun (f : myforall {a}, [a=0, Prop]) => f eq_refl. Check myforall '((x,y):nat*nat), [ x = y, True ]. By using instead `closed binder`, the same list of binders is allowed except that :n:`@ident:@type` requires parentheses around. .. _NotationsWithBinders: Binders not bound in the notation +++++++++++++++++++++++++++++++++ We can also have binders in the right-hand side of a notation which are not themselves bound in the notation. In this case, the binders are considered up to renaming of the internal binder. E.g., for the notation .. coqtop:: in Notation "'exists_different' n" := (exists p:nat, p<>n) (at level 200). the next command fails because p does not bind in the instance of n. .. coqtop:: all Fail Check (exists_different p). .. coqtop:: in Notation "[> a , .. , b <]" := (cons a .. (cons b nil) .., cons b .. (cons a nil) ..). Notations with expressions used both as binder and term +++++++++++++++++++++++++++++++++++++++++++++++++++++++ It is possible to use parameters of the notation both in term and binding position. Here is an example: .. coqtop:: in Definition force n (P:nat -> Prop) := forall n', n' >= n -> P n'. Notation "▢_ n P" := (force n (fun n => P)) (at level 0, n name, P at level 9, format "▢_ n P"). .. coqtop:: all Check exists p, ▢_p (p >= 1). More generally, the parameter can be a pattern, as in the following variant: .. coqtop:: in reset Definition force2 q (P:nat*nat -> Prop) := (forall n', n' >= fst q -> forall p', p' >= snd q -> P q). Notation "▢_ p P" := (force2 p (fun p => P)) (at level 0, p pattern at level 0, P at level 9, format "▢_ p P"). .. coqtop:: all Check exists x y, ▢_(x,y) (x >= 1 /\ y >= 2). This support is experimental. For instance, the notation is used for printing only if the occurrence of the parameter in term position comes in the right-hand side before the occurrence in binding position. .. _RecursiveNotations: Notations with recursive patterns ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ A mechanism is provided for declaring elementary notations with recursive patterns. The basic example is: .. coqtop:: all 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 confused with the three-dots notation “``…``” used in this manual to denote a sequence of arbitrary size. On the left-hand side, the part “``x s .. s y``” of the notation parses any number of times (but at least once) a sequence of expressions separated by the sequence of tokens ``s`` (in the example, ``s`` is just “``;``”). The right-hand side must contain a subterm of the form either ``φ(x, .. φ(y,t) ..)`` or ``φ(y, .. φ(x,t) ..)`` where :math:`φ([~]_E , [~]_I)`, called the *iterator* of the recursive notation is an arbitrary expression with distinguished placeholders and where :math:`t` is called the *terminating expression* of the recursive notation. In the example, we choose the names :math:`x` and :math:`y` but in practice they can of course be chosen arbitrarily. Note that the placeholder :math:`[~]_I` has to occur only once but :math:`[~]_E` can occur several times. Parsing the notation produces a list of expressions which are used to fill the first placeholder of the iterating pattern which itself is repeatedly nested as many times as the length of the list, the second placeholder being the nesting point. In the innermost occurrence of the nested iterating pattern, the second placeholder is finally filled with the terminating expression. In the example above, the iterator :math:`φ([~]_E , [~]_I)` is :math:`cons [~]_E\, [~]_I` and the terminating expression is ``nil``. Here is another example with the pattern associating on the left: .. coqtop:: in Notation "( x , y , .. , z )" := (pair .. (pair x y) .. z) (at level 0). Here is an example with more involved recursive patterns: .. coqtop:: in Notation "[| t * ( x , y , .. , z ) ; ( a , b , .. , c ) * u |]" := (pair (pair .. (pair (pair t x) (pair t y)) .. (pair t z)) (pair .. (pair (pair a u) (pair b u)) .. (pair c u))) (t at level 39). To give a flavor of the extent and limits of the mechanism, here is an example showing a notation for a chain of equalities. It relies on an artificial expansion of the intended denotation so as to expose a ``φ(x, .. φ(y,t) ..)`` structure, with the drawback that if ever the beta-redexes are contracted, the notations stops to be used for printing. Support for notations defined in this way should be considered experimental. .. coqtop:: in Notation "x ⪯ y ⪯ .. ⪯ z ⪯ t" := ((fun b A a => a <= b /\ A b) y .. ((fun b A a => a <= b /\ A b) z (fun b => b <= t)) .. x) (at level 70, y at next level, z at next level, t at next level). Note finally that notations with recursive patterns can be reserved like standard notations, they can also be declared within :ref:`notation scopes `. .. _RecursiveNotationsWithBinders: Notations with recursive patterns involving binders ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Recursive notations can also be used with binders. The basic example is: .. coqtop:: in Notation "'exists' x .. y , p" := (ex (fun x => .. (ex (fun y => p)) ..)) (at level 200, x binder, y binder, right associativity). The principle is the same as in :ref:`RecursiveNotations` except that in the iterator :math:`φ([~]_E , [~]_I)`, the placeholder :math:`[~]_E` can also occur in position of the binding variable of a ``fun`` or a ``forall``. To specify that the part “``x .. y``” of the notation parses a sequence of binders, ``x`` and ``y`` must be marked as ``binder`` in the list of :n:`@syntax_modifier`\s of the notation. The binders of the parsed sequence are used to fill the occurrences of the first placeholder of the iterating pattern which is repeatedly nested as many times as the number of binders generated. If ever the generalization operator ``'`` (see :ref:`implicit-generalization`) is used in the binding list, the added binders are taken into account too. There are two flavors of binder parsing. If ``x`` and ``y`` are marked as binder, then a sequence such as :g:`a b c : T` will be accepted and interpreted as the sequence of binders :g:`(a:T) (b:T) (c:T)`. For instance, in the notation above, the syntax :g:`exists a b : nat, a = b` is valid. The variables ``x`` and ``y`` can also be marked as closed binder in which case only well-bracketed binders of the form :g:`(a b c:T)` or :g:`{a b c:T}` etc. are accepted. With closed binders, the recursive sequence in the left-hand side can be of the more general form ``x s .. s y`` where ``s`` is an arbitrary sequence of tokens. With open binders though, ``s`` has to be empty. Here is an example of recursive notation with closed binders: .. coqtop:: in Notation "'mylet' f x .. y := t 'in' u":= (let f := fun x => .. (fun y => t) .. in u) (at level 200, x closed binder, y closed binder, right associativity). A recursive pattern for binders can be used in position of a recursive pattern for terms. Here is an example: .. coqtop:: in Notation "'FUNAPP' x .. y , f" := (fun x => .. (fun y => (.. (f x) ..) y ) ..) (at level 200, x binder, y binder, right associativity). If an occurrence of the :math:`[~]_E` is not in position of a binding variable but of a term, it is the name used in the binding which is used. Here is an example: .. coqtop:: in Notation "'exists_non_null' x .. y , P" := (ex (fun x => x <> 0 /\ .. (ex (fun y => y <> 0 /\ P)) ..)) (at level 200, x binder). Predefined entries ~~~~~~~~~~~~~~~~~~ By default, sub-expressions are parsed as terms and the corresponding grammar entry is called ``constr``. However, one may sometimes want to restrict the syntax of terms in a notation. For instance, the following notation will accept to parse only global reference in position of :g:`x`: .. coqtop:: in Notation "'apply' f a1 .. an" := (.. (f a1) .. an) (at level 10, f global, a1, an at level 9). In addition to ``global``, one can restrict the syntax of a sub-expression by using the entry names ``ident``, ``name`` or ``pattern`` already seen in :ref:`NotationsWithBinders`, even when the corresponding expression is not used as a binder in the right-hand side. E.g.: .. coqtop:: in Notation "'apply_id' f a1 .. an" := (.. (f a1) .. an) (at level 10, f ident, a1, an at level 9). .. _custom-entries: Custom entries ~~~~~~~~~~~~~~ .. cmd:: Declare Custom Entry @ident Defines new grammar entries, called *custom entries*, that can later be referred to using the entry name :n:`custom @ident`. This command supports the :attr:`local` attribute, which limits the entry to the current module. Non-local custom entries survive module closing and are declared when a file is Required. .. example:: For instance, we may want to define an ad hoc parser for arithmetical operations and proceed as follows: .. coqtop:: reset all Inductive Expr := | One : Expr | Mul : Expr -> Expr -> Expr | Add : Expr -> Expr -> Expr. Declare Custom Entry expr. Notation "[ e ]" := e (e custom expr at level 2). Notation "1" := One (in custom expr at level 0). Notation "x y" := (Mul x y) (in custom expr at level 1, left associativity). Notation "x + y" := (Add x y) (in custom expr at level 2, left associativity). Notation "( x )" := x (in custom expr, x at level 2). Notation "{ x }" := x (in custom expr, x constr). Notation "x" := x (in custom expr at level 0, x ident). Axiom f : nat -> Expr. Check fun x y z => [1 + y z + {f x}]. Unset Printing Notations. Check fun x y z => [1 + y z + {f x}]. Set Printing Notations. Check fun e => match e with | [1 + 1] => [1] | [x y + z] => [x + y z] | y => [y + e] end. Custom entries have levels, like the main grammar of terms and grammar of patterns have. The lower level is 0 and this is the level used by default to put rules delimited with tokens on both ends. The level is left to be inferred by Coq when using :n:`in custom @ident`. The level is otherwise given explicitly by using the syntax :n:`in custom @ident at level @natural`, where :n:`@natural` refers to the level. Levels are cumulative: a notation at level ``n`` of which the left end is a term shall use rules at level less than ``n`` to parse this subterm. More precisely, it shall use rules at level strictly less than ``n`` if the rule is declared with ``right associativity`` and rules at level less or equal than ``n`` if the rule is declared with ``left associativity``. Similarly, a notation at level ``n`` of which the right end is a term shall use by default rules at level strictly less than ``n`` to parse this subterm if the rule is declared left associative and rules at level less or equal than ``n`` if the rule is declared right associative. This is what happens for instance in the rule .. coqtop:: in Notation "x + y" := (Add x y) (in custom expr at level 2, left associativity). where ``x`` is any expression parsed in entry ``expr`` at level less or equal than ``2`` (including, recursively, the given rule) and ``y`` is any expression parsed in entry ``expr`` at level strictly less than ``2``. Rules associated with an entry can refer different sub-entries. The grammar entry name ``constr`` can be used to refer to the main grammar of term as in the rule .. coqtop:: in Notation "{ x }" := x (in custom expr at level 0, x constr). which indicates that the subterm ``x`` should be parsed using the main grammar. If not indicated, the level is computed as for notations in ``constr``, e.g. using 200 as default level for inner sub-expressions. The level can otherwise be indicated explicitly by using ``constr at level n`` for some ``n``, or ``constr at next level``. Conversely, custom entries can be used to parse sub-expressions of the main grammar, or from another custom entry as is the case in .. coqtop:: in Notation "[ e ]" := e (e custom expr at level 2). to indicate that ``e`` has to be parsed at level ``2`` of the grammar associated with the custom entry ``expr``. The level can be omitted, as in .. coqdoc:: Notation "[ e ]" := e (e custom expr). 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 inferred to be the highest level used for the entry. In particular, this level depends on the highest level existing in the entry at the time of use of the notation. In the absence of an explicit entry for parsing or printing a sub-expression of a notation in a custom entry, the default is to consider that this sub-expression is parsed or printed in the same custom entry where the notation is defined. In particular, if ``x at level n`` is used for a sub-expression of a notation defined in custom entry ``foo``, it shall be understood the same as ``x custom foo at level n``. In general, rules are required to be *productive* on the right-hand side, i.e. that they are bound to an expression which is not reduced to a single variable. If the rule is not productive on the right-hand side, as it is the case above for .. coqtop:: in Notation "( x )" := x (in custom expr at level 0, x at level 2). and .. coqtop:: in Notation "{ x }" := x (in custom expr at level 0, x constr). it is used as a *grammar coercion* which means that it is used to parse or print an expression which is not available in the current grammar at the current level of parsing or printing for this grammar but which is available in another grammar or in another level of the current grammar. For instance, .. coqtop:: in Notation "( x )" := x (in custom expr at level 0, x at level 2). tells that parentheses can be inserted to parse or print an expression declared at level ``2`` of ``expr`` whenever this expression is expected to be used as a subterm at level 0 or 1. This allows for instance to parse and print :g:`Add x y` as a subterm of :g:`Mul (Add x y) z` using the syntax ``(x + y) z``. Similarly, .. coqtop:: in Notation "{ x }" := x (in custom expr at level 0, x constr). gives a way to let any arbitrary expression which is not handled by the custom entry ``expr`` be parsed or printed by the main grammar of term up to the insertion of a pair of curly brackets. Another special situation is when parsing global references or identifiers. To indicate that a custom entry should parse identifiers, use the following form: .. coqtop:: reset none Declare Custom Entry expr. .. coqtop:: in Notation "x" := x (in custom expr at level 0, x ident). Similarly, to indicate that a custom entry should parse global references (i.e. qualified or unqualified identifiers), use the following form: .. coqtop:: reset none Declare Custom Entry expr. .. coqtop:: in Notation "x" := x (in custom expr at level 0, x global). .. cmd:: Print Custom Grammar @ident This displays the state of the grammar for terms associated with the custom entry :token:`ident`. .. _NotationSyntax: Syntax ~~~~~~~ Here are the syntax elements used by the various notation commands. .. insertprodn syntax_modifier level .. prodn:: syntax_modifier ::= at level @natural | in custom @ident {? at level @natural } | {+, @ident } {| at @level | in scope @ident } | @ident at @level {? @binder_interp } | @ident @explicit_subentry | @ident @binder_interp | left associativity | right associativity | no associativity | only parsing | format @string | only printing explicit_subentry ::= ident | name | global | bigint | strict pattern {? at level @natural } | binder | closed binder | constr {? at @level } {? @binder_interp } | custom @ident {? at @level } {? @binder_interp } | pattern {? at level @natural } binder_interp ::= as ident | as name | as pattern | as strict pattern level ::= level @natural | next level Note that `_` by itself is a valid :n:`@name` but is not a valid :n:`@ident`. .. note:: No typing of the denoted expression is performed at definition time. Type checking is done only at the time of use of the notation. .. note:: Some examples of Notation may be found in the files composing the initial state of Coq (see directory :file:`$COQLIB/theories/Init`). .. note:: The notation ``"{ x }"`` has a special status in the main grammars of terms and patterns so that complex notations of the form ``"x + { y }"`` or ``"x * { y }"`` can be nested with correct precedences. Especially, every notation involving a pattern of the form ``"{ x }"`` is parsed as a notation where the pattern ``"{ x }"`` has been simply replaced by ``"x"`` and the curly braces are parsed separately. E.g. ``"y + { z }"`` is not parsed as a term of the given form but as a term of the form ``"y + z"`` where ``z`` has been parsed using the rule parsing ``"{ x }"``. Especially, level and precedences for a rule including patterns of the form ``"{ x }"`` are relative not to the textual notation but to the notation where the curly braces have been removed (e.g. the level and the associativity given to some notation, say ``"{ y } & { z }"`` in fact applies to the underlying ``"{ x }"``\-free rule which is ``"y & z"``). .. note:: Notations such as ``"( p | q )"`` (or starting with ``"( x | "``, more generally) are deprecated as they conflict with the syntax for nested disjunctive patterns (see :ref:`extendedpatternmatching`), and are not honored in pattern expressions. .. 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. It can be turned on with the ``-w disj-pattern-notation`` flag. .. exn:: Unknown custom entry: @ident. Occurs when :cmd:`Notation` or :cmd:`Print Notation` can't find the custom entry given by the user. .. _Scopes: Notation scopes --------------- A :gdef:`notation scope` is a set of notations for terms with their interpretations. Notation scopes provide a weak, purely syntactic form of notation overloading: a symbol may refer to different definitions depending on which notation scopes are currently open. For instance, the infix symbol ``+`` can be used to refer to distinct definitions of the addition operator, such as for natural numbers, integers or reals. Notation scopes can include an interpretation for numbers and strings with the :cmd:`Number Notation` and :cmd:`String Notation` commands. .. insertprodn scope scope_key .. prodn:: scope ::= @scope_name | @scope_key scope_name ::= @ident scope_key ::= @ident Each notation scope has a single :token:`scope_name`, which by convention ends with the suffix "_scope", as in "nat_scope". One or more :token:`scope_key`\s (delimiting keys) may be associated with a notation scope with the :cmd:`Delimit Scope` command. Most commands use :token:`scope_name`; :token:`scope_key`\s are used within :token:`term`\s. .. cmd:: Declare Scope @scope_name Declares a new notation scope. Note that the initial state of Coq declares the following notation scopes: ``bool_scope``, ``byte_scope``, ``core_scope``, ``dec_int_scope``, ``dec_uint_scope``, ``function_scope``, ``hex_int_scope``, ``hex_nat_scope``, ``hex_uint_scope``, ``list_scope``, ``nat_scope``, ``type_scope``. Use commands such as :cmd:`Notation` to add notations to the scope. .. exn:: Scope names should not start with an underscore. Scope names starting with an underscore would make the :g:`%_` syntax ambiguous. Global interpretation rules for notations ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ At any time, the interpretation of a notation for a term is done within a *stack* of notation scopes and :term:`lonely notations `. If a notation is defined in multiple scopes, Coq uses the interpretation from the most recently opened notation scope or declared lonely notation. Note that "stack" is a misleading name. Each scope or lonely notation can only appear in the stack once. New items are pushed onto the top of the stack, except that adding a item that's already in the stack moves it to the top of the stack instead. Scopes are removed by name (e.g. by :cmd:`Close Scope`) wherever they are in the stack, rather than through "pop" operations. Use the :cmd:`Print Visibility` command to display the current notation scope stack. The initial state of Coq has the following scopes opened: ``core_scope``, ``function_scope``, ``type_scope`` and ``nat_scope``, ``nat_scope`` being the top of the scopes stack. .. cmd:: Open Scope @scope Adds a scope to the notation scope stack. If the scope is already present, the command moves it to the top of the stack. If the command appears in a section: By default, the scope is only added within the section. Specifying :attr:`global` marks the scope for export as part of the current module. Specifying :attr:`local` behaves like the default. If the command does not appear in a section: By default, the scope marks the scope for export as part of the current module. Specifying :attr:`local` prevents exporting the scope. Specifying :attr:`global` behaves like the default. .. cmd:: Close Scope @scope Removes a scope from the notation scope stack. If the command appears in a section: By default, the scope is only removed within the section. Specifying :attr:`global` marks the scope removal for export as part of the current module. Specifying :attr:`local` behaves like the default. If the command does not appear in a section: By default, the scope marks the scope removal for export as part of the current module. Specifying :attr:`local` prevents exporting the removal. Specifying :attr:`global` behaves like the default. .. todo: Strange notion, exporting something that _removes_ a scope. See https://github.com/coq/coq/pull/11718#discussion_r413667817 .. _LocalInterpretationRulesForNotations: Local interpretation rules for notations ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ In addition to the global rules of interpretation of notations, some ways to change the interpretation of subterms are available. Opening a notation scope locally ++++++++++++++++++++++++++++++++ .. insertprodn term_scope term_scope .. prodn:: term_scope ::= @term0 % @scope_key | @term0 %_ @scope_key The notation scope stack can be locally extended within a :token:`term` with the syntax :n:`(@term)%@scope_key` (or simply :n:`@term0%@scope_key` for atomic terms). In this case, :n:`@term` is interpreted in the scope stack extended with the scope bound to :n:`@scope_key`. The term :n:`@term0%_@scope_key` is interpreted similarly to :n:`@term0%@scope_key` except that the scope stack is only temporarily extended for the head of :n:`@term0`, rather than all its subterms. .. cmd:: Delimit Scope @scope_name with @scope_key Binds the delimiting key :token:`scope_key` to a scope. .. cmd:: Undelimit Scope @scope_name Removes the delimiting keys associated with a scope. .. exn:: Scope delimiters should not start with an underscore. Scope delimiters starting with an underscore would make the :g:`%_` syntax ambiguous. The arguments of an :ref:`abbreviation ` can be interpreted in a scope stack locally extended with a given scope by using the modifier :n:`{+, @ident } in scope @scope_name`.s Binding types or coercion classes to notation scopes ++++++++++++++++++++++++++++++++++++++++++++++++++++ .. cmd:: Bind Scope @scope_name with {+ @coercion_class } Binds the notation scope :token:`scope_name` to the type or coercion class :token:`coercion_class`. When bound, arguments of that type for any function will be interpreted in that scope by default. This default can be overridden for individual functions with the :cmd:`Arguments` command. See :ref:`binding_to_scope` for details. The association may be convenient when a notation scope is naturally associated with a :token:`type` (e.g. `nat` and the natural numbers). Whether the argument of a function has some type ``type`` is determined statically. For instance, if ``f`` is a polymorphic function of type :g:`forall X:Type, X -> X` and type :g:`t` is bound to a scope ``scope``, then :g:`a` of type :g:`t` in :g:`f t a` is not recognized as an argument to be interpreted in scope ``scope``. In explicit :ref:`casts ` :n:`@term : @coercion_class`, the :n:`term` is interpreted in the :token:`scope_name` associated with :n:`@coercion_class`. This command supports the :attr:`local`, :attr:`global`, :attr:`add_top` and :attr:`add_bottom` attributes. .. attr:: add_top add_bottom These :ref:`attributes ` allow adding additional bindings at the top or bottom of the stack of already declared bindings. In absence of such attributes, any new binding clears the previous ones. This makes it possible to bind multiple scopes to the same :token:`coercion_class`. .. example:: Binding scopes to a type Let's declare two scopes with a notation in each and an arbitrary function on type ``bool``. .. coqtop:: in reset Declare Scope T_scope. Declare Scope F_scope. Notation "#" := true (only parsing) : T_scope. Notation "#" := false (only parsing) : F_scope. Parameter f : bool -> bool. By default, the argument of ``f`` is interpreted in the currently opened scopes. .. coqtop:: all Open Scope T_scope. Check f #. Open Scope F_scope. Check f #. This can be changed by binding scopes to the type ``bool``. .. coqtop:: all Bind Scope T_scope with bool. Check f #. When multiple scopes are attached to a type, notations are interpreted in the first scope containing them, from the top of the stack. .. coqtop:: all #[add_top] Bind Scope F_scope with bool. Check f #. Notation "##" := (negb false) (only parsing) : T_scope. Check f ##. Bindings for functions can be displayed with the :cmd:`About` command. .. coqtop:: all About f. Bindings are also used in casts. .. coqtop:: all Close Scope F_scope. Check #. Check # : bool. .. note:: Such stacks of scopes can be handy to share notations between multiple types. For instance, the scope ``T_scope`` above could contain many generic notations used for both the ``bool`` and ``nat`` types, while the scope ``F_scope`` could override some of these notations specifically for ``bool`` and another ``F'_scope`` could override them specifically for ``nat``, which could then be bound to ``%F'_scope%T_scope``. .. note:: When active, a bound scope has effect on all defined functions (even if they are defined after the :cmd:`Bind Scope` directive), except if argument scopes were assigned explicitly using the :cmd:`Arguments` command. .. note:: The scopes ``type_scope`` and ``function_scope`` also have a local effect on interpretation. See the next section. The ``type_scope`` notation scope ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ .. index:: type_scope The scope ``type_scope`` has a special status. It is a primitive interpretation scope which is temporarily activated each time a subterm of an expression is expected to be a type. It is delimited by the key ``type``, and bound to the coercion class ``Sortclass``. It is also used in certain situations where an expression is statically known to be a type, including the conclusion and the type of hypotheses within an Ltac goal match (see :ref:`ltac-match-goal`), the statement of a theorem, the type of a definition, the type of a binder, the domain and codomain of implication, the codomain of products, and more generally any type argument of a declared or defined constant. The ``function_scope`` notation scope ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ .. index:: function_scope The scope ``function_scope`` also has a special status. It is temporarily activated each time the argument of a global reference is recognized to be a ``Funclass`` instance, i.e., of type :g:`forall x:A, B` or :g:`A -> B`. .. _notation-scopes: Notation 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`. ``type_scope`` This scope includes infix * for product types and infix + for sum types. It is delimited by the key ``type``, and bound to the coercion class ``Sortclass``, as described above. ``function_scope`` This scope is delimited by the key ``function``, and bound to the coercion class ``Funclass``, as described above. ``nat_scope`` This scope includes the standard arithmetical operators and relations on type nat. Positive integer numbers in this scope are mapped to their canonical representent built from :g:`O` and :g:`S`. The scope is delimited by the key ``nat``, and bound to the type :g:`nat` (see above). ``N_scope`` This scope includes the standard arithmetical operators and relations on type :g:`N` (binary natural numbers). It is delimited by the key ``N`` and comes with an interpretation for numbers as closed terms of type :g:`N`. ``Z_scope`` This scope includes the standard arithmetical operators and relations on type :g:`Z` (binary integer numbers). It is delimited by the key ``Z`` and comes with an interpretation for numbers as closed terms of type :g:`Z`. ``positive_scope`` This scope includes the standard arithmetical operators and relations on type :g:`positive` (binary strictly positive numbers). It is delimited by key ``positive`` and comes with an interpretation for numbers as closed terms of type :g:`positive`. ``Q_scope`` This scope includes the standard arithmetical operators and relations on type :g:`Q` (rational numbers defined as fractions of an integer and a strictly positive integer modulo the equality of the numerator- denominator cross-product) and comes with an interpretation for numbers as closed terms of type :g:`Q`. ``Qc_scope`` This scope includes the standard arithmetical operators and relations on the type :g:`Qc` of rational numbers defined as the type of irreducible fractions of an integer and a strictly positive integer. ``R_scope`` This scope includes the standard arithmetical operators and relations on type :g:`R` (axiomatic real numbers). It is delimited by the key ``R`` and comes with an interpretation for numbers using the :g:`IZR` morphism from binary integer numbers to :g:`R` and :g:`Z.pow_pos` for potential exponent parts. ``bool_scope`` This scope includes notations for the boolean operators. It is delimited by the key ``bool``, and bound to the type :g:`bool` (see above). ``list_scope`` This scope includes notations for the list operators. It is delimited by the key ``list``, and bound to the type :g:`list` (see above). ``core_scope`` This scope includes the notation for pairs. It is delimited by the key ``core``. ``string_scope`` This scope includes notation for strings as elements of the type string. 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 of code 7). ``char_scope`` This scope includes interpretation for all strings of the form ``"c"`` where :g:`c` is an ASCII character, or of the form ``"nnn"`` where nnn is a three-digit number (possibly with leading 0s), or of the form ``""""``. Their respective denotations are the ASCII code of :g:`c`, the decimal ASCII code ``nnn``, or the ascii code of the character ``"`` (i.e. the ASCII code 34), all of them being represented in the type :g:`ascii`. Displaying information about scopes ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ .. cmd:: Print Visibility {? @scope_name } Displays the current notation scope stack. The top of the stack is displayed last. Notations in scopes whose interpretation is hidden by the same notation in a more recently opened scope are not displayed. Hence each notation is displayed only once. If :n:`@scope_name` is specified, displays the current notation scope stack as if the scope :n:`@scope_name` is pushed on top of the stack. This is useful to see how a subterm occurring locally in the scope is interpreted. .. cmd:: Print Scopes Displays, for each existing notation scope, all accessible notations (whether or not currently in the notation scope stack), the most-recently defined delimiting key and the class the notation scope is bound to. The display also includes :term:`lonely notations `. .. todo should the command report all delimiting keys? Use the :cmd:`Print Visibility` command to display the current notation scope stack. .. cmd:: Print Scope @scope_name Displays all notations defined in the notation scope :n:`@scope_name`. It also displays the delimiting key and the class to which the scope is bound, if any. .. _Abbreviations: Abbreviations -------------- .. cmd:: Notation @ident {* @ident__parm } := @one_term {? ( {+, @syntax_modifier } ) } :name: Notation (abbreviation) .. todo: for some reason, Sphinx doesn't complain about a duplicate name if :name: is omitted Defines an abbreviation :token:`ident` with the parameters :n:`@ident__parm`. This command supports the :attr:`local` attribute, which limits the notation to the current module. Unlike a :cmd:`Notation`, an abbreviation defined with the default locality is available (with a fully qualified name) outside the current module even when :cmd:`Import` (or one of its variants) has not been used on the current :cmd:`Module`. An *abbreviation* is a name, possibly applied to arguments, that denotes a (presumably) more complex expression. Here are examples: .. coqtop:: none Require Import List. Require Import Relations. Set Printing Notations. .. coqtop:: in Notation Nlist := (list nat). .. coqtop:: all Check 1 :: 2 :: 3 :: nil. .. coqtop:: in Notation reflexive R := (forall x, R x x). .. coqtop:: all Check forall A:Prop, A <-> A. Check reflexive iff. .. coqtop:: in Notation Plus1 B := (Nat.add B 1). .. coqtop:: all Compute (Plus1 3). 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 parsing)`` is given. An abbreviation is bound to an absolute name as an ordinary definition is and it also can be referred to by a qualified name. Abbreviations are syntactic in the sense that they are bound to expressions which are not typed at the time of the definition of the abbreviation but at the time they are used. Especially, abbreviations can be bound to terms with holes (i.e. with “``_``”). For example: .. coqtop:: none reset Set Strict Implicit. Set Printing Depth 50. .. coqtop:: in Definition explicit_id (A:Set) (a:A) := a. .. coqtop:: in Notation id := (explicit_id _). .. coqtop:: all Check (id 0). Abbreviations disappear when a section is closed. No typing of the denoted expression is performed at definition time. Type checking is done only at the time of use of the abbreviation. Like for notations, if the right-hand side of an abbreviation is a partially applied constant, the abbreviation inherits the implicit arguments and notation scopes of the constant. As an exception, if the right-hand side is just of the form :n:`@@qualid`, this conventionally stops the inheritance of implicit arguments. Like for notations, it is possible to bind binders in abbreviations. Here is an example: .. coqtop:: in reset Definition force2 q (P:nat*nat -> Prop) := (forall n', n' >= fst q -> forall p', p' >= snd q -> P q). Notation F p P := (force2 p (fun p => P)). Check exists x y, F (x,y) (x >= 1 /\ y >= 2). .. extracted from Gallina chapter Numbers and strings ------------------- .. insertprodn number_or_string number_or_string .. prodn:: number_or_string ::= @number | @string Numbers and strings have no predefined semantics in the calculus. They are merely notations that can be bound to objects through the notation mechanism. Initially, numbers are bound to :n:`nat`, Peano’s representation of natural numbers (see :ref:`datatypes`). .. note:: Negative integers are not at the same level as :n:`@natural`, for this would make precedence unnatural. .. _number-notations: Number notations ~~~~~~~~~~~~~~~~ .. cmd:: Number Notation @qualid__type @qualid__parse @qualid__print {? ( {+, @number_modifier } ) } : @scope_name .. insertprodn number_modifier number_string_via .. prodn:: number_modifier ::= warning after @bignat | abstract after @bignat | @number_string_via number_string_via ::= via @qualid mapping [ {+, {| @qualid => @qualid | [ @qualid ] => @qualid } } ] Customizes the way number literals are parsed and printed within the current :term:`notation scope`. :n:`@qualid__type` the name of an inductive type, while :n:`@qualid__parse` and :n:`@qualid__print` should be the names of the parsing and printing functions, respectively. The parsing function :n:`@qualid__parse` should have one of the following types: * :n:`Number.int -> @qualid__type` * :n:`Number.int -> option @qualid__type` * :n:`Number.uint -> @qualid__type` * :n:`Number.uint -> option @qualid__type` * :n:`Z -> @qualid__type` * :n:`Z -> option @qualid__type` * :n:`PrimInt63.pos_neg_int63 -> @qualid__type` * :n:`PrimInt63.pos_neg_int63 -> option @qualid__type` * :n:`PrimFloat.float -> @qualid__type` * :n:`PrimFloat.float -> option @qualid__type` * :n:`Number.number -> @qualid__type` * :n:`Number.number -> option @qualid__type` And the printing function :n:`@qualid__print` should have one of the following types: * :n:`@qualid__type -> Number.int` * :n:`@qualid__type -> option Number.int` * :n:`@qualid__type -> Number.uint` * :n:`@qualid__type -> option Number.uint` * :n:`@qualid__type -> Z` * :n:`@qualid__type -> option Z` * :n:`@qualid__type -> PrimInt63.pos_neg_int63` * :n:`@qualid__type -> option PrimInt63.pos_neg_int63` * :n:`@qualid__type -> PrimFloat.float` * :n:`@qualid__type -> option PrimFloat.float` * :n:`@qualid__type -> Number.number` * :n:`@qualid__type -> option Number.number` When parsing, the application of the parsing function :n:`@qualid__parse` to the number will be fully reduced, and universes of the resulting term will be refreshed. Note that only fully-reduced ground terms (terms containing only function application, constructors, inductive type families, sorts, primitive integers, primitive floats, primitive arrays and type constants for primitive types) will be considered for printing. .. note:: Instead of an inductive type, :n:`@qualid__type` can be :n:`PrimInt63.int` or :n:`PrimFloat.float`, in which case :n:`@qualid__print` takes :n:`PrimInt63.int_wrapper` or :n:`PrimFloat.float_wrapper` as input instead of :n:`PrimInt63.int` or :n:`PrimFloat.float`. See below for an :ref:`example `. .. note:: When :n:`PrimFloat.float` is used as input type of :n:`@qualid__parse`, only numerical values will be parsed this way, (no infinities nor NaN). Similarly, printers :n:`@qualid__print` with output type :n:`PrimFloat.float` or :n:`option PrimFloat.float` are ignored when they return non numerical values. .. _number-string-via: :n:`via @qualid__ind mapping [ {+, @qualid__constant => @qualid__constructor } ]` When using this option, :n:`@qualid__type` no longer needs to be an inductive type and is instead mapped to the inductive type :n:`@qualid__ind` according to the provided list of pairs, whose first component :n:`@qualid__constant` is a constant of type :n:`@qualid__type` (or a function of type :n:`{* _ -> } @qualid__type`) and the second a constructor of type :n:`@qualid__ind`. The type :n:`@qualid__type` is then replaced by :n:`@qualid__ind` in the above parser and printer types. When :n:`@qualid__constant` is surrounded by square brackets, all the implicit arguments of :n:`@qualid__constant` (whether maximally inserted or not) are ignored when translating to :n:`@qualid__constructor` (i.e., before applying :n:`@qualid__print`) and replaced with implicit argument holes :g:`_` when translating from :n:`@qualid__constructor` to :n:`@qualid__constant` (after :n:`@qualid__parse`). See below for an :ref:`example `. .. note:: The implicit status of the arguments is considered only at notation declaration time, any further modification of this status has no impact on the previously declared notations. .. note:: In case of multiple implicit options (for instance :g:`Arguments eq_refl {A}%_type_scope {x}, [_] _`), an argument is considered implicit when it is implicit in any of the options. .. note:: To use a :token:`sort` as the target type :n:`@qualid__type`, use an :ref:`abbreviation ` as in the :ref:`example below `. :n:`warning after @bignat` displays a warning message about a possible stack overflow when calling :n:`@qualid__parse` to parse a literal larger than :n:`@bignat`. .. warn:: Stack overflow or segmentation fault happens when working with large numbers in @type (threshold may vary depending on your system limits and on the command executed). When a :cmd:`Number Notation` is registered in the current scope with :n:`(warning after @bignat)`, this warning is emitted when parsing a number greater than or equal to :token:`bignat`. :n:`abstract after @bignat` returns :n:`(@qualid__parse m)` when parsing a literal :n:`m` that's greater than :n:`@bignat` rather than reducing it to a normal form. Here :g:`m` will be a :g:`Number.int`, :g:`Number.uint`, :g:`Z` or :g:`Number.number`, depending on the type of the parsing function :n:`@qualid__parse`. This allows for a more compact representation of literals in types such as :g:`nat`, and limits parse failures due to stack overflow. Note that a warning will be emitted when an integer larger than :token:`bignat` is parsed. Note that :n:`(abstract after @bignat)` has no effect when :n:`@qualid__parse` lands in an :g:`option` type. .. warn:: To avoid stack overflow, large numbers in @type are interpreted as applications of @qualid__parse. When a :cmd:`Number Notation` is registered in the current scope 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 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. As noted above, the :n:`(abstract after @natural)` directive has no effect when :n:`@qualid__parse` lands in an :g:`option` type. .. exn:: 'via' and 'abstract' cannot be used together. With the :n:`abstract after` option, the parser function :n:`@qualid__parse` does not reduce large numbers to a normal form, which prevents doing the translation given in the :n:`mapping` list. .. exn:: Cannot interpret this number as a value of type @type The number notation registered for :token:`type` does not support the given number. This error is given when the interpretation function returns :g:`None`, or if the interpretation is registered only for integers or non-negative integers, and the given number has a fractional or exponent part or is negative. .. exn:: overflow in int63 literal @bigint The constant's absolute value is too big to fit into a 63-bit integer :n:`PrimInt63.int`. .. exn:: @qualid__parse should go from Number.int to @type or (option @type). Instead of Number.int, the types Number.uint or Z or PrimInt63.pos_neg_int63 or PrimFloat.float or Number.number could be used (you may need to require BinNums or Number or PrimInt63 or PrimFloat first). The parsing function given to the :cmd:`Number Notation` command is not of the right type. .. exn:: @qualid__print should go from @type to Number.int or (option Number.int). Instead of Number.int, the types Number.uint or Z or PrimInt63.pos_neg_int63 or Number.number could be used (you may need to require BinNums or Number or PrimInt63 first). The printing function given to the :cmd:`Number Notation` command is not of the right type. .. exn:: Unexpected term @term while parsing a number notation. Parsing functions must always return ground terms, made up of function application, constructors, inductive type families, sorts and primitive integers. Parsing functions may not return terms containing axioms, bare (co)fixpoints, lambdas, etc. .. exn:: Unexpected non-option term @term while parsing a number notation. Parsing functions expected to return an :g:`option` must always return a concrete :g:`Some` or :g:`None` when applied to a concrete number expressed as a (hexa)decimal. They may not return opaque constants. .. exn:: Multiple 'via' options. At most one :g:`via` option can be given. .. exn:: Multiple 'warning after' or 'abstract after' options. At most one :g:`warning after` or :g:`abstract after` option can be given. .. _string-notations: String notations ~~~~~~~~~~~~~~~~ .. cmd:: String Notation @qualid__type @qualid__parse @qualid__print {? ( @number_string_via ) } : @scope_name Allows the user to customize how strings are parsed and printed. :n:`@qualid__type` the name of an inductive type, while :n:`@qualid__parse` and :n:`@qualid__print` should be the names of the parsing and printing functions, respectively. The parsing function :n:`@qualid__parse` should have one of the following types: * :n:`Byte.byte -> @qualid__type` * :n:`Byte.byte -> option @qualid__type` * :n:`list Byte.byte -> @qualid__type` * :n:`list Byte.byte -> option @qualid__type` * :n:`PrimString.string -> @qualid__type` * :n:`PrimString.string -> option @qualid__type` The printing function :n:`@qualid__print` should have one of the following types: * :n:`@qualid__type -> Byte.byte` * :n:`@qualid__type -> option Byte.byte` * :n:`@qualid__type -> list Byte.byte` * :n:`@qualid__type -> option (list Byte.byte)` * :n:`@qualid__type -> PrimString.string` * :n:`@qualid__type -> option PrimString.string` When parsing, the application of the parsing function :n:`@qualid__parse` to the string will be fully reduced, and universes of the resulting term will be refreshed. Note that only fully-reduced ground terms (terms containing only function application, constructors, inductive type families, sorts, primitive integers, primitive floats, primitive strings, primitive arrays and type constants for primitive types) will be considered for printing. :n:`via @qualid__ind mapping [ {+, @qualid__constant => @qualid__constructor } ]` works as for :ref:`number notations above `. .. exn:: Cannot interpret this string as a value of type @type The string notation registered for :token:`type` does not support the given string. This error is given when the interpretation function returns :g:`None`. .. exn:: @qualid__parse should go from Byte.byte, (list Byte.byte), or PrimString.string to @type or (option @type). The parsing function given to the :cmd:`String Notation` command is not of the right type. .. exn:: @qualid__print should go from @type to T or (option T), where T is either Byte.byte, (list Byte.byte), or PrimString.string. The printing function given to the :cmd:`String Notation` command is not of the right type. .. exn:: Unexpected term @term while parsing a string notation. Parsing functions must always return ground terms, made up of function application, constructors, inductive type families, sorts, primitive integers and primitive strings. Parsing functions may not return terms containing axioms, bare (co)fixpoints, lambdas, etc. .. exn:: Unexpected non-option term @term while parsing a string notation. Parsing functions expected to return an :g:`option` must always return a concrete :g:`Some` or :g:`None` when applied to a concrete string expressed as a decimal. They may not return opaque constants. .. note:: Number or string notations for parameterized inductive types can be added by declaring an :ref:`abbreviation ` for the inductive which instantiates all parameters. See :ref:`example below `. The following errors apply to both string and number notations: .. exn:: @type is not an inductive type. String and number notations can only be declared for inductive types. Declare string or numeral notations for non-inductive types using :n:`@number_string_via`. .. exn:: @qualid was already mapped to @qualid and cannot be remapped to @qualid Duplicates are not allowed in the :n:`mapping` list. .. exn:: Missing mapping for constructor @qualid A mapping should be provided for :n:`@qualid` in the :n:`mapping` list. .. warn:: @type was already mapped to @type, mapping it also to @type might yield ill typed terms when using the notation. Two pairs in the :n:`mapping` list associate types that might be incompatible. .. warn:: Type of @qualid seems incompatible with the type of @qualid. Expected type is: @type instead of @type. This might yield ill typed terms when using the notation. A mapping given in the :n:`mapping` list associates a constant with a seemingly incompatible constructor. .. exn:: Cannot interpret in @scope_name because @qualid could not be found in the current environment. The inductive type used to register the string or number notation is no longer available in the environment. Most likely, this is because the notation was declared inside a functor for an inductive type inside the functor. This use case is not currently supported. Alternatively, you might be trying to use a primitive token notation from a plugin which forgot to specify which module you must :g:`Require` for access to that notation. .. exn:: Syntax error: [prim:reference] expected after 'Notation' (in [vernac:command]). The type passed to :cmd:`String Notation` or :cmd:`Number Notation` must be a single qualified identifier. .. exn:: Syntax error: [prim:reference] expected after [prim:reference] (in [vernac:command]). Both functions passed to :cmd:`String Notation` or :cmd:`Number Notation` must be single qualified identifiers. .. todo: generally we don't document syntax errors. Is this a good execption? .. exn:: @qualid is bound to a notation that does not denote a reference. Identifiers passed to :cmd:`String Notation` or :cmd:`Number Notation` must be global references, or notations which evaluate to single qualified identifiers. .. todo note on "single qualified identifiers" https://github.com/coq/coq/pull/11718#discussion_r415076703 .. example:: Number Notation for radix 3 The following example parses and prints natural numbers whose digits are :g:`0`, :g:`1` or :g:`2` as terms of the following inductive type encoding radix 3 numbers. .. coqtop:: in reset Inductive radix3 : Set := | x0 : radix3 | x3 : radix3 -> radix3 | x3p1 : radix3 -> radix3 | x3p2 : radix3 -> radix3. We first define a parsing function .. coqtop:: in Definition of_uint_dec (u : Decimal.uint) : option radix3 := let fix f u := match u with | Decimal.Nil => Some x0 | Decimal.D0 u => match f u with Some u => Some (x3 u) | None => None end | Decimal.D1 u => match f u with Some u => Some (x3p1 u) | None => None end | Decimal.D2 u => match f u with Some u => Some (x3p2 u) | None => None end | _ => None end in f (Decimal.rev u). Definition of_uint (u : Number.uint) : option radix3 := match u with Number.UIntDecimal u => of_uint_dec u | Number.UIntHexadecimal _ => None end. and a printing function .. coqtop:: in Definition to_uint_dec (x : radix3) : Decimal.uint := let fix f x := match x with | x0 => Decimal.Nil | x3 x => Decimal.D0 (f x) | x3p1 x => Decimal.D1 (f x) | x3p2 x => Decimal.D2 (f x) end in Decimal.rev (f x). Definition to_uint (x : radix3) : Number.uint := Number.UIntDecimal (to_uint_dec x). before declaring the notation .. coqtop:: in Declare Scope radix3_scope. Open Scope radix3_scope. Number Notation radix3 of_uint to_uint : radix3_scope. We can check the printer .. coqtop:: all Check x3p2 (x3p1 x0). and the parser .. coqtop:: all Set Printing All. Check 120. Digits other than :g:`0`, :g:`1` and :g:`2` are rejected. .. coqtop:: all fail Check 3. .. _example-number-notation-primitive-int: .. example:: Number Notation for primitive integers This shows the use of the primitive integers :n:`PrimInt63.int` as :n:`@qualid__type`. It is the way parsing and printing of primitive integers are actually implemented in `PrimInt63.v`. .. coqtop:: in reset Require Import PrimInt63. Definition parser (x : pos_neg_int63) : option int := match x with Pos p => Some p | Neg _ => None end. Definition printer (x : int_wrapper) : pos_neg_int63 := Pos (int_wrap x). Number Notation int parser printer : uint63_scope. .. _example-number-notation-non-inductive: .. example:: Number Notation for a non-inductive type The following example encodes the terms in the form :g:`sum unit ( ... (sum unit unit) ... )` as the number of units in the term. For instance :g:`sum unit (sum unit unit)` is encoded as :g:`3` while :g:`unit` is :g:`1` and :g:`0` stands for :g:`Empty_set`. The inductive :g:`I` will be used as :n:`@qualid__ind`. .. coqtop:: in reset Inductive I := Iempty : I | Iunit : I | Isum : I -> I -> I. We then define :n:`@qualid__parse` and :n:`@qualid__print` .. coqtop:: in Definition of_uint (x : Number.uint) : I := let fix f n := match n with | O => Iempty | S O => Iunit | S n => Isum Iunit (f n) end in f (Nat.of_num_uint x). Definition to_uint (x : I) : Number.uint := let fix f i := match i with | Iempty => O | Iunit => 1 | Isum i1 i2 => f i1 + f i2 end in Nat.to_num_uint (f x). Inductive sum (A : Set) (B : Set) : Set := pair : A -> B -> sum A B. the number notation itself .. coqtop:: in Notation nSet := Set (only parsing). Number Notation nSet of_uint to_uint (via I mapping [Empty_set => Iempty, unit => Iunit, sum => Isum]) : type_scope. and check the printer .. coqtop:: all Local Open Scope type_scope. Check sum unit (sum unit unit). and the parser .. coqtop:: all Set Printing All. Check 3. .. _example-number-notation-implicit-args: .. example:: Number Notation with implicit arguments The following example parses and prints natural numbers between :g:`0` and :g:`n-1` as terms of type :g:`Fin.t n`. .. coqtop:: all reset warn Require Import Vector. Print Fin.t. Note the implicit arguments of :g:`Fin.F1` and :g:`Fin.FS`, which won't appear in the corresponding inductive type. .. coqtop:: in Inductive I := I1 : I | IS : I -> I. Definition of_uint (x : Number.uint) : I := let fix f n := match n with O => I1 | S n => IS (f n) end in f (Nat.of_num_uint x). Definition to_uint (x : I) : Number.uint := let fix f i := match i with I1 => O | IS n => S (f n) end in Nat.to_num_uint (f x). Declare Scope fin_scope. Delimit Scope fin_scope with fin. Local Open Scope fin_scope. Number Notation Fin.t of_uint to_uint (via I mapping [[Fin.F1] => I1, [Fin.FS] => IS]) : fin_scope. Now :g:`2` is parsed as :g:`Fin.FS (Fin.FS Fin.F1)`, that is :g:`@Fin.FS _ (@Fin.FS _ (@Fin.F1 _))`. .. coqtop:: all Check 2. which can be of type :g:`Fin.t 3` (numbers :g:`0`, :g:`1` and :g:`2`) .. coqtop:: all Check 2 : Fin.t 3. but cannot be of type :g:`Fin.t 2` (only :g:`0` and :g:`1`) .. coqtop:: all fail Check 2 : Fin.t 2. .. _example-string-notation-parameterized-inductive: .. example:: String Notation with a parameterized inductive type The parameter :g:`Byte.byte` for the parameterized inductive type :g:`list` is given through an :ref:`abbreviation `. .. coqtop:: in reset Notation string := (list Byte.byte) (only parsing). Definition id_string := @id string. String Notation string id_string id_string : list_scope. .. coqtop:: all Check "abc"%list. .. _TacticNotation: Tactic Notations ----------------- Tactic notations allow customizing the syntax of tactics. .. todo move to the Ltac chapter .. todo to discuss after moving to the ltac chapter: any words of wisdom on when to use tactic notation vs ltac? can you run into problems if you shadow another tactic or tactic notation? If so, how to avoid ambiguity? .. cmd:: Tactic Notation {? ( at level @natural ) } {+ @ltac_production_item } := @ltac_expr .. insertprodn ltac_production_item ltac_production_item .. prodn:: ltac_production_item ::= @string | @ident {? ( @ident {? , @string } ) } Defines a *tactic notation*, which extends the parsing and pretty-printing of tactics. This command supports the :attr:`local` attribute, which limits the notation to the current module. :token:`natural` The parsing precedence to assign to the notation. This information is particularly relevant for notations for tacticals. Levels can be in the range 0 .. 5 (default is 5). :n:`{+ @ltac_production_item }` The notation syntax. Notations for simple tactics should begin with a :token:`string`. Note that `Tactic Notation foo := idtac` is not valid; it should be `Tactic Notation "foo" := idtac`. .. todo: "Tactic Notation constr := idtac" gives a nice message, would be good to show that message for the "foo" example above. :token:`string` represents a literal value in the notation :n:`@ident` is the name of a grammar nonterminal listed in the table below. In a few cases, to maintain backward compatibility, the name differs from the nonterminal name used elsewhere in the documentation. :n:`( @ident__parm {? , @string__s } )` :n:`@ident__parm` is the parameter name associated with :n:`@ident`. The :n:`@string__s` is the separator string to use when :n:`@ident` specifies a list with separators (i.e. :n:`@ident` ends with `_list_sep`). :n:`@ltac_expr` The tactic expression to substitute for the notation. :n:`@ident__parm` tokens appearing in :n:`@ltac_expr` are substituted with the associated nonterminal value. For example, the following command defines a notation with a single parameter `x`. .. coqtop:: in Tactic Notation "destruct_with_eqn" constr(x) := destruct x eqn:?. For a complex example, examine the 16 `Tactic Notation "setoid_replace"`\s defined in :file:`$COQLIB/theories/Classes/SetoidTactics.v`, which are designed to accept any subset of 4 optional parameters. The nonterminals that can specified in the tactic notation are: .. Some missing entries: "ref", "string", "preident", "int" and "ssrpatternarg". (from reading .v files). Looks like any string passed to "make0" in the code is valid. But do we want to support all these? @JasonGross's opinion here: https://github.com/coq/coq/pull/11718#discussion_r415387421 .. list-table:: :header-rows: 1 * - Specified :token:`ident` - Parsed as - Interpreted as - as in tactic * - ``ident`` - :token:`ident` - a user-given name - :tacn:`intro` * - ``simple_intropattern`` - :token:`simple_intropattern` - an introduction pattern - :tacn:`assert` `as` * - ``hyp`` - :token:`ident` - a hypothesis defined in context - :tacn:`clear` * - ``reference`` - :token:`qualid` - a qualified identifier - name of an |Ltac|-defined tactic * - ``smart_global`` - :token:`reference` - a global reference of term - :tacn:`unfold`, :tacn:`with_strategy` * - ``constr`` - :token:`one_term` - a term - :tacn:`exact` * - ``open_constr`` - :token:`one_term` - a term where all `_` which are not resolved by unification become evars; typeclass resolution is not triggered - tacn:`epose`, tacn:`eapply` * - ``uconstr`` - :token:`one_term` - an untyped term - :tacn:`refine` * - ``integer`` - :token:`integer` - an integer - * - ``int_or_var`` - :token:`int_or_var` - an integer - :tacn:`do` * - ``strategy_level`` - :token:`strategy_level` - a strategy level - * - ``strategy_level_or_var`` - :token:`strategy_level_or_var` - a strategy level - :tacn:`with_strategy` * - ``tactic`` - :token:`ltac_expr` - a tactic - * - ``tactic``\ *n* (*n* in 0..5) - :token:`ltac_expr`\ *n* - a tactic at level *n* - * - *entry*\ ``_list`` - :n:`{* entry }` - a list of how *entry* is interpreted - * - ``ne_``\ *entry*\ ``_list`` - :n:`{+ entry }` - a list of how *entry* is interpreted - * - *entry*\ ``_list_sep`` - :n:`{*s entry }` - a list of how *entry* is interpreted - * - ``ne_``\ *entry*\ ``_list_sep`` - :n:`{+s entry }` - a list of how *entry* is interpreted - .. todo: notation doesn't support italics .. note:: In order to be bound in tactic definitions, each syntactic entry for argument type must include the case of a simple |Ltac| identifier as part of what it parses. This is naturally the case for ``ident``, ``simple_intropattern``, ``reference``, ``constr``, ... but not for ``integer`` nor for ``strategy_level``. This is the reason for introducing special entries ``int_or_var`` and ``strategy_level_or_var`` which evaluate to integers or strategy levels only, respectively, but which syntactically includes identifiers in order to be usable in tactic definitions. .. note:: The *entry*\ ``_list*`` and ``ne_``\ *entry*\ ``_list*`` entries can be used in primitive tactics or in other notations at places where a list of the underlying entry can be used: entry is either ``constr``, ``hyp``, ``integer``, ``reference``, ``strategy_level``, ``strategy_level_or_var``, or ``int_or_var``. .. rubric:: Footnotes .. [#and_or_levels] which are the levels effectively chosen in the current 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`` is in fact ``left associativity`` for the purposes of parsing coq-8.20.0/doc/sphinx/using/000077500000000000000000000000001466560755400156105ustar00rootroot00000000000000coq-8.20.0/doc/sphinx/using/libraries/000077500000000000000000000000001466560755400175645ustar00rootroot00000000000000coq-8.20.0/doc/sphinx/using/libraries/funind.rst000066400000000000000000000343551466560755400216130ustar00rootroot00000000000000Functional induction ==================== .. note:: The functional induction (FunInd) plugin is legacy functionality. For new code and new projects, we recommend `Equations `_, a more powerful plugin that provides most of FunInd's features. It can be installed through the `Coq Platform `_. Refer to the `Equations documentation `_ to learn more. FunInd is not deprecated and not planned for removal yet because porting code from FunInd to Equations can be difficult (due to differences in the generated induction principles). .. _advanced-recursive-functions: Advanced recursive functions ---------------------------- The following command is available when the ``FunInd`` library has been loaded via ``Require Import FunInd``: .. cmd:: Function @fix_definition {* with @fix_definition } This command is a generalization of :cmd:`Fixpoint`. It is a wrapper for several ways of defining a function *and* other useful related objects, namely: an induction principle that reflects the recursive structure of the function (see :tacn:`functional induction`) and its fixpoint equality. This defines a function similar to those defined by :cmd:`Fixpoint`. As in :cmd:`Fixpoint`, the decreasing argument must be given (unless the function is not recursive), but it might not necessarily be *structurally* decreasing. Use the :n:`@fixannot` clause to name the decreasing argument *and* to describe which kind of decreasing criteria to use to ensure termination of recursive calls. :cmd:`Function` also supports the :n:`with` clause to create mutually recursive definitions, however this feature is limited to structurally recursive functions (i.e. when :n:`@fixannot` is a :n:`struct` clause). See :tacn:`functional induction` and :cmd:`Functional Scheme` for how to use the induction principle to reason easily about the function. The form of the :n:`@fixannot` clause determines which definition mechanism :cmd:`Function` uses. (Note that references to :n:`ident` below refer to the name of the function being defined.): * If :n:`@fixannot` is not specified, :cmd:`Function` defines the nonrecursive function :token:`ident` as if it was declared with :cmd:`Definition`. In addition, the following are defined: + :token:`ident`\ ``_rect``, :token:`ident`\ ``_rec`` and :token:`ident`\ ``_ind``, which reflect the pattern matching structure of :token:`term` (see :cmd:`Inductive`); + The inductive :n:`R_@ident` corresponding to the graph of :token:`ident` (silently); + :token:`ident`\ ``_complete`` and :token:`ident`\ ``_correct`` which are inversion information linking the function and its graph. * If :n:`{ struct ... }` is specified, :cmd:`Function` defines the structural recursive function :token:`ident` as if it was declared with :cmd:`Fixpoint`. In addition, the following are defined: + The same objects as above; + The fixpoint equation of :token:`ident`: :n:`@ident`\ ``_equation``. * If :n:`{ measure ... }` or :n:`{ wf ... }` are specified, :cmd:`Function` defines a recursive function by well-founded recursion. The module ``Recdef`` of the standard library must be loaded for this feature. + :n:`{measure @one_term__1 {? @ident } {? @one_term__2 } }`\: where :n:`@ident` is the decreasing argument and :n:`@one_term__1` is a function from the type of :n:`@ident` to :g:`nat` for which the decreasing argument decreases (for the :g:`lt` order on :g:`nat`) for each recursive call of the function. The parameters of the function are bound in :n:`@one_term__1`. + :n:`{wf @one_term @ident }`\: where :n:`@ident` is the decreasing argument and :n:`@one_term` is an ordering relation on the type of :n:`@ident` (i.e. of type `T`\ :math:`_{\sf ident}` → `T`\ :math:`_{\sf ident}` → ``Prop``) for which the decreasing argument decreases for each recursive call of the function. The order must be well-founded. The parameters of the function are bound in :n:`@one_term`. If the clause is ``measure`` or ``wf``, the user is left with some proof obligations that will be used to define the function. These proofs are: proofs that each recursive call is actually decreasing with respect to the given criteria, and (if the criteria is `wf`) a proof that the ordering relation is well-founded. Once proof obligations are discharged, the following objects are defined: + The same objects as with the ``struct`` clause; + The lemma :n:`@ident`\ ``_tcc`` which collects all proof obligations in one property; + The lemmas :n:`@ident`\ ``_terminate`` and :n:`@ident`\ ``_F`` which will be inlined during extraction of :n:`@ident`. The way this recursive function is defined is the subject of several papers by Yves Bertot and Antonia Balaa on the one hand, and Gilles Barthe, Julien Forest, David Pichardie, and Vlad Rusu on the other hand. .. note:: To obtain the right principle, it is better to put rigid parameters of the function as first arguments. For example it is better to define plus like this: .. coqtop:: reset none Require Import FunInd. .. coqtop:: all Function plus (m n : nat) {struct n} : nat := match n with | 0 => m | S p => S (plus m p) end. than like this: .. coqtop:: reset none Require Import FunInd. .. coqtop:: all Function plus (n m : nat) {struct n} : nat := match n with | 0 => m | S p => S (plus p m) end. *Limitations* :token:`term` must be built as a *pure pattern matching tree* (:g:`match … with`) with applications only *at the end* of each branch. :cmd:`Function` does not support partial application of the function being defined. Thus, the following example cannot be accepted due to the presence of partial application of :g:`wrong` in the body of :g:`wrong`: .. coqtop:: none Require List. Import List.ListNotations. .. coqtop:: all fail Function wrong (C:nat) : nat := List.hd 0 (List.map wrong (C::nil)). For now, dependent cases are not treated for non-structurally terminating functions. .. exn:: The recursive argument must be specified. :undocumented: .. exn:: No argument name @ident. :undocumented: .. exn:: Cannot use mutual definition with well-founded recursion or measure. :undocumented: .. warn:: Cannot define graph for @ident. The generation of the graph relation (:n:`R_@ident`) used to compute the induction scheme of ident raised a typing error. Only :token:`ident` is defined; the induction scheme will not be generated. This error happens generally when: - the definition uses pattern matching on dependent types, which :cmd:`Function` cannot deal with yet. - the definition is not a *pattern matching tree* as explained above. .. warn:: Cannot define principle(s) for @ident. The generation of the graph relation (:n:`R_@ident`) succeeded but the induction principle could not be built. Only :token:`ident` is defined. Please report. .. warn:: Cannot build functional inversion principle. :tacn:`functional inversion` will not be available for the function. Tactics ------- .. tacn:: functional induction @term {? using @one_term_with_bindings } {? as @simple_intropattern } 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:: .. coqtop:: reset all Require Import FunInd. Functional Scheme minus_ind := Induction for minus Sort Prop. Check minus_ind. Lemma le_minus (n m:nat) : n - m <= n. functional induction (minus n m) using minus_ind; simpl; auto. Qed. .. 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` (by the :cmd:`Function` or :cmd:`Functional Scheme` command) corresponding to the sort of the goal. Therefore :tacn:`functional induction` may fail if the induction scheme :n:`@qualid` is not defined. .. note:: There is a difference between obtaining an induction scheme for a function by using :cmd:`Function` and by using :cmd:`Functional Scheme` after a normal definition using :cmd:`Fixpoint` or :cmd:`Definition`. .. exn:: Cannot find induction information on @qualid. :undocumented: .. exn:: Not the right number of induction arguments. :undocumented: .. tacn:: soft functional induction {+ @one_term } {? using @one_term_with_bindings } {? as @simple_intropattern } :undocumented: .. tacn:: functional inversion {| @ident | @natural } {? @qualid } 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: .. exn:: Cannot find inversion information for hypothesis @ident. This error may be raised when some inversion lemma failed to be generated by Function. .. _functional-scheme: Generation of induction principles with ``Functional`` ``Scheme`` ----------------------------------------------------------------- .. 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. Note the command must be made available via :cmd:`Require Import` ``FunInd``. .. warning:: There is a difference between induction schemes generated by the command :cmd:`Functional Scheme` and these generated by the :cmd:`Function`. Indeed, :cmd:`Function` generally produces smaller principles that are closer to how a user would implement them. See :ref:`advanced-recursive-functions` for details. .. example:: Induction scheme for div2. We define the function div2 as follows: .. coqtop:: all Require Import FunInd. Require Import Arith. Fixpoint div2 (n:nat) : nat := match n with | O => 0 | S O => 0 | S (S n') => S (div2 n') end. The definition of a principle of induction corresponding to the recursive structure of `div2` is defined by the command: .. coqtop:: all Functional Scheme div2_ind := Induction for div2 Sort Prop. You may now look at the type of div2_ind: .. coqtop:: all Check div2_ind. We can now prove the following lemma using this principle: .. coqtop:: all Lemma div2_le' : forall n:nat, div2 n <= n. intro n. pattern n, (div2 n). apply div2_ind; intros. auto with arith. auto with arith. simpl; auto with arith. Qed. We can use directly the functional induction (:tacn:`functional induction`) tactic instead of the pattern/apply trick: .. coqtop:: all Reset div2_le'. Lemma div2_le : forall n:nat, div2 n <= n. intro n. functional induction (div2 n). auto with arith. auto with arith. auto with arith. Qed. .. example:: Induction scheme for tree_size. We define trees by the following mutual inductive type: .. original LaTeX had "Variable" instead of "Axiom", which generates an ugly warning .. coqtop:: reset all Axiom A : Set. Inductive tree : Set := node : A -> forest -> tree with forest : Set := | empty : forest | cons : tree -> forest -> forest. We define the function tree_size that computes the size of a tree or a forest. Note that we use ``Function`` which generally produces better principles. .. coqtop:: all Require Import FunInd. Function tree_size (t:tree) : nat := match t with | node A f => S (forest_size f) end with forest_size (f:forest) : nat := match f with | empty => 0 | cons t f' => (tree_size t + forest_size f') end. Notice that the induction principles ``tree_size_ind`` and ``forest_size_ind`` generated by ``Function`` are not mutual. .. coqtop:: all Check tree_size_ind. Mutual induction principles following the recursive structure of ``tree_size`` and ``forest_size`` can be generated by the following command: .. coqtop:: all Functional Scheme tree_size_ind2 := Induction for tree_size Sort Prop with forest_size_ind2 := Induction for forest_size Sort Prop. You may now look at the type of `tree_size_ind2`: .. coqtop:: all Check tree_size_ind2. .. cmd:: Functional Case @func_scheme_def Generate graph for @qualid Internal debugging commands. coq-8.20.0/doc/sphinx/using/libraries/index.rst000066400000000000000000000041561466560755400214330ustar00rootroot00000000000000.. _libraries: ===================== Libraries and plugins ===================== Libraries and plugins contain compiled Coq scripts with useful definitions, theorems, notations and settings that can be loaded at runtime. In addition, plugins can add new tactics and commands written in OCaml. 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 plugins. These libraries and plugins can be browsed online through the `Coq Package Index `_ and installed with the `opam package manager `_. :gdef:`Libraries ` contain only compiled Coq scripts. :gdef:`Plugins ` can also include compiled OCaml code that can change the behavior of Coq. Both are :term:`packages `. While users configure and load them identically, there are a few differences to consider: - Nearly all plugins add functionality that could not be added otherwise and they likely add new top-level commands or tactics. - Compared to libraries, plugins can change Coq's behavior in many possibly unexpected ways. Therefore, using a plugin requires a higher degree of trust in its authors than is needed for libraries. If desired, you can mitigate trust issues by running :ref:`coqchk` on compiled files produced from Coq scripts that load plugins. (`coqchk` doesn't load plugins, so they won't be part of trusted code base.) - Plugins that aren't in Coq's `CI (continuous integration) system `_ are more likely to break across major versions due to source code changes to Coq. You may want to consider this before adopting a new plugin for your project. .. toctree:: :maxdepth: 1 ../../language/coq-library ../../addendum/extraction ../../addendum/miscellaneous-extensions funind writing coq-8.20.0/doc/sphinx/using/libraries/writing.rst000066400000000000000000000134531466560755400220070ustar00rootroot00000000000000Writing 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 `_. Deprecating library objects, tactics or library files ----------------------------------------------------- You may use the following :term:`attribute` to deprecate a notation, tactic, definition, axiom, theorem or file. When renaming a definition or theorem, you can introduce a deprecated compatibility alias using :cmd:`Notation (abbreviation)` (see :ref:`the example below `). .. attr:: deprecated ( {? since = @string , } {? note = @string } ) :name: deprecated At least one of :n:`since` or :n:`note` must be present. If both are present, either one may appear first and they must be separated by a comma. If they are present, they will be used in the warning message, and :n:`since` will also be used in the warning name and categories. Spaces inside :n:`since` are changed to hyphens. This attribute is supported by the following commands: :cmd:`Ltac`, :cmd:`Tactic Notation`, :cmd:`Notation`, :cmd:`Infix`, :cmd:`Ltac2`, :cmd:`Ltac2 Notation`, :cmd:`Ltac2 external`, :cmd:`Definition`, :cmd:`Theorem`, and similar commands. To attach it to a compiled library file, use :cmd:`Attributes`. It can trigger the following warnings: .. warn:: Library File @qualid is deprecated since @string__since. @string__note Library File (transitively required) @qualid is deprecated since @string__since. @string__note Ltac2 alias @qualid is deprecated since @string__since. @string__note Ltac2 definition @qualid is deprecated since @string__since. @string__note Ltac2 notation {+ @ltac2_scope } is deprecated since @string__since. @string__note Notation @string is deprecated since @string__since. @string__note Tactic @qualid is deprecated since @string__since. @string__note Tactic Notation @qualid is deprecated since @string__since. @string__note :n:`@qualid` or :n:`@string` is the notation, :n:`@string__since` is the version number, :n:`@string__note` is the note (usually explains the replacement). Explicitly :cmd:`Require`\ing a file that has been deprecated, using the :cmd:`Attributes` command, triggers a ``Library File`` deprecation warning. Requiring a deprecated file, even indirectly through a chain of :cmd:`Require`\s, will produce a ``Library File (transitively required)`` deprecation warning if the :opt:`Warnings` option "deprecated-transitive-library-file" is set (it is "-deprecated-transitive-library-file" by default, silencing the warning). .. note:: Coq and its standard library follow this deprecation policy: * it should always be possible for a project written in Coq to be compatible with two successive major versions, * features must be deprecated in one major version before removal, * Coq developers should provide an estimate of the required effort to fix a project with respect to a given change, * breaking changes should be clearly documented in the public release notes, along with recommendations on how to fix a project if it breaks. See :cite:`Zimmermann19`, Section 3.6.3, for more details. Triggering warning for library objects or library files ------------------------------------------------------- You may use the following :term:`attribute` to trigger a warning on a notation, definition, axiom, theorem or file. .. attr:: warn ( note = @string , {? cats = @string } ) :name: warn The :n:`note` field will be used as the warning message, and :n:`cats` is a comma separated list of categories to be used in the warning name and categories. Leading and trailing spaces in each category are trimmed, whereas internal spaces are changed to hyphens. If both :n:`note` and :n:`cats` are present, either one may appear first and they must be separated by a comma. This attribute is supported by the following commands: :cmd:`Notation`, :cmd:`Infix`, :cmd:`Definition`, :cmd:`Theorem`, and similar commands. To attach it to a compiled library file, use :cmd:`Attributes`. It can trigger the following warning: .. warn:: @string__note :n:`@string__note` is the note. It's common practice to start it with a capital and end it with a period. Explicitly :cmd:`Require`\ing a file that has a warn message set using the :cmd:`Attributes` command, triggers a ``warn-library-file`` warning. Requiring such a file, even indirectly through a chain of :cmd:`Require`\s, will produce a ``warn-transitive-library-file`` warning if the :opt:`Warnings` option "warn-transitive-library-file" is set (it is "-warn-transitive-library-file" by default, silencing the warning). .. example:: Deprecating a tactic. .. coqtop:: all abort warn #[deprecated(since="mylib 0.9", note="Use idtac instead.")] Ltac foo := idtac. Goal True. Proof. now foo. .. _compatibility-alias: .. example:: Introducing a compatibility alias Let's say your library initially contained: .. coqtop:: in Definition foo x := S x. and you want to rename `foo` into `bar`, but you want to avoid breaking your users' code without advanced notice. To do so, replace the previous code by the following: .. coqtop:: in reset Definition bar x := S x. #[deprecated(since="mylib 1.2", note="Use bar instead.")] Notation foo := bar (only parsing). Then, the following code still works, but emits a warning: .. coqtop:: all warn Check (foo 0). coq-8.20.0/doc/sphinx/using/tools/000077500000000000000000000000001466560755400167505ustar00rootroot00000000000000coq-8.20.0/doc/sphinx/using/tools/coqdoc.rst000066400000000000000000000363251466560755400207630ustar00rootroot00000000000000.. index:: coqdoc .. _coqdoc: Documenting Coq files with coqdoc ----------------------------------- coqdoc is a documentation tool for the proof assistant Coq, similar to ``javadoc`` or ``ocamldoc``. The task of coqdoc is #. to produce a nice |Latex| and/or HTML document from Coq source files, readable for a human and not only for the proof assistant; #. to help users navigate their own (or third-party) sources. Principles ~~~~~~~~~~ Documentation is inserted into Coq files as *special comments*. Thus your files will compile as usual, whether you use coqdoc or not. coqdoc presupposes that the given Coq files are well-formed (at least lexically). Documentation starts with ``(**``, followed by a space, and ends with ``*)``. The documentation format is inspired by Todd A. Coram’s *Almost Free Text (AFT)* tool: it is mainly ``ASCII`` text with some syntax-light controls, described below. coqdoc is robust: it shouldn’t fail, whatever the input is. But remember: “garbage in, garbage out”. Coq material inside documentation. ++++++++++++++++++++++++++++++++++++ Coq material is quoted between the delimiters ``[`` and ``]``. Square brackets may be nested, the inner ones being understood as being part of the quoted code (thus you can quote a term like ``let id := fun [T : Type] (x : t) => x in id 0`` by writing ``[let id := fun [T : Type] (x : t) => x in id 0]``). Inside quotations, the code is pretty-printed the same way as in code parts. Preformatted vernacular is enclosed by ``[[`` and ``]]``. The former must be followed by a newline and the latter must follow a newline. Pretty-printing. ++++++++++++++++ coqdoc uses different faces for identifiers and keywords. The pretty- printing of Coq tokens (identifiers or symbols) can be controlled using one of the following commands: :: (** printing *token* %...LATEX...% #...html...# *) or :: (** printing *token* $...LATEX math...$ #...html...# *) It gives the |Latex| and HTML texts to be produced for the given Coq token. Either the |Latex| or the HTML rule may be omitted, causing the default pretty-printing to be used for this token. The printing for one token can be removed with :: (** remove printing *token* *) Initially, the pretty-printing table contains the following mapping: ===== === ==== ===== === ==== ==== === `->` → `<-` ← `*` × `<=` ≤ `>=` ≥ `=>` ⇒ `<>` ≠ `<->` ↔ `|-` ⊢ `\\/` ∨ `/\\` ∧ `~` ¬ ===== === ==== ===== === ==== ==== === Any of these can be overwritten or suppressed using the printing commands. .. note:: The recognition of tokens is done by a (``ocaml``) lex automaton and thus applies the longest-match rule. For instance, `->~` is recognized as a single token, where Coq sees two tokens. It is the responsibility of the user to insert space between tokens *or* to give pretty-printing rules for the possible combinations, e.g. :: (** printing ->~ %\ensuremath{\rightarrow\lnot}% *) Sections ++++++++ Sections are introduced by 1 to 4 asterisks at the beginning of a line followed by a space and the title of the section. One asterisk is a section, two a subsection, etc. .. example:: :: (** * Well-founded relations In this section, we introduce... *) Lists. ++++++ List items are introduced by a leading dash. coqdoc uses whitespace to determine the depth of a new list item and which text belongs in which list items. A list ends when a line of text starts at or before the level of indenting of the list’s dash. A list item’s dash must always be the first non-space character on its line (so, in particular, a list can not begin on the first line of a comment - start it on the second line instead). .. example:: :: We go by induction on [n]: - If [n] is 0... - If [n] is [S n'] we require... two paragraphs of reasoning, and two subcases: - In the first case... - In the second case... So the theorem holds. Rules. ++++++ More than 4 leading dashes produce a horizontal rule. Emphasis. +++++++++ Text can be italicized by enclosing it in underscores. A non-identifier character must precede the leading underscore and follow the trailing underscore, so that uses of underscores in names aren’t mistaken for emphasis. Usually, these are spaces or punctuation. :: This sentence contains some _emphasized text_. Escaping to |Latex| and HTML. +++++++++++++++++++++++++++++++ Pure |Latex| or HTML material can be inserted using the following escape sequences: + ``$...LATEX stuff...$`` inserts some |Latex| material in math mode. Simply discarded in HTML output. + ``%...LATEX stuff...%`` inserts some |Latex| material. Simply discarded in HTML output. + ``#...HTML stuff...#`` inserts some HTML material. Simply discarded in |Latex| output. .. note:: to simply output the characters ``$``, ``%`` and ``#`` and escaping their escaping role, these characters must be doubled. Verbatim ++++++++ Verbatim material is introduced by a leading ``<<`` and closed by ``>>`` at the beginning of a line. .. example:: :: Here is the corresponding caml code: << let rec fact n = if n <= 1 then 1 else n * fact (n-1) >> Verbatim material on a single line is also possible (assuming that ``>>`` is not part of the text to be presented as verbatim). .. example:: :: Here is the corresponding caml expression: << fact (n-1) >> Hyperlinks ++++++++++ Hyperlinks can be inserted into the HTML output, so that any identifier is linked to the place of its definition. ``coqc file.v`` automatically dumps localization information in ``file.glob`` or appends it to a file specified using the option ``--dump-glob file``. Take care of erasing this global file, if any, when starting the whole compilation process. Then invoke coqdoc or ``coqdoc --glob-from file`` to tell coqdoc to look for name resolutions in the file ``file`` (it will look in ``file.glob`` by default). Identifiers from the Coq standard library are linked to the Coq website ``_. This behavior can be changed using command line options ``--no-externals`` and ``--coqlib_url``; see below. .. _coqdoc-hide-show: Hiding / Showing parts of the source ++++++++++++++++++++++++++++++++++++ Some parts of the source can be hidden using command line options ``-g`` and ``-l`` (see below), or using such comments: :: (* begin hide *) *some Coq material* (* end hide *) Conversely, some parts of the source which would be hidden can be shown using such comments: :: (* begin show *) *some Coq material* (* end show *) 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 hidden by default, but can be made visible with user interaction. :: (* begin details *) *some Coq material* (* end details *) There is also an alternative syntax available. :: (* begin details : Some summary describing the snippet *) *some Coq material* (* end details *) Usage ~~~~~ coqdoc is invoked on a shell command line as follows: ``coqdoc ``. Any command line argument which is not an option is considered to be a file (even if it starts with a ``-``). Coq files are identified by the suffixes ``.v`` and ``.g`` and |Latex| files by the suffix ``.tex``. :HTML output: This is the default output format. One HTML file is created for each Coq file given on the command line, together with a file ``index.html`` (unless ``option-no-index is passed``). The HTML pages use a style sheet named ``style.css``. Such a file is distributed with coqdoc. :|Latex| output: A single |Latex| file is created, on standard output. It can be redirected to a file using the option ``-o``. The order of files on the command line is kept in the final document. |Latex| files given on the command line are copied ‘as is’ in the final document . DVI and PostScript can be produced directly with the options ``-dvi`` and ``-ps`` respectively. :TEXmacs output: To translate the input files to TEXmacs format, to be used by the TEXmacs Coq interface. Command line options ++++++++++++++++++++ **Overall options** :--HTML: Select a HTML output. :--|Latex|: Select a |Latex| output. :--dvi: Select a DVI output. :--ps: Select a PostScript output. :--texmacs: Select a TEXmacs output. :--stdout: Write output to stdout. :-o file, --output file: Redirect the output into the file ‘file’ (meaningless with ``-html``). :-d dir, --directory dir: Output files into directory ‘dir’ instead of the current directory (option ``-d`` does not change the filename specified with the option ``-o``, if any). :--body-only: Suppress the header and trailer of the final document. Thus, you can insert the resulting document into a larger one. :-p string, --preamble string: Insert some material in the |Latex| preamble, right before ``\begin{document}`` (meaningless with ``-html``). :--vernac-file file,--tex-file file: Considers the file ‘file’ respectively as a ``.v`` (or ``.g``) file or a ``.tex`` file. :--files-from file: Read filenames to be processed from the file ‘file’ as if they were given on the command line. Useful for program sources split up into several directories. :-q, --quiet: Be quiet. Do not print anything except errors. :-h, --help: Give a short summary of the options and exit. :-v, --version: Print the version and exit. **Index options** The default behavior is to build an index, for the HTML output only, into ``index.html``. :--no-index: Do not output the index. :--binder-index: Include variable binders in the index. Not recommended with large source files, where binder information may dominate the index. :--multi-index: Generate one page for each category and each letter in the index, together with a top page ``index.html``. :--index string: Make the filename of the index string instead of “index”. Useful since “index.html” is special. **Table of contents option** :-toc, --table-of-contents: Insert a table of contents. For a |Latex| output, it inserts a ``\tableofcontents`` at the beginning of the document. For a HTML output, it builds a table of contents into ``toc.html``. :--toc-depth int: Only include headers up to depth ``int`` in the table of contents. **Hyperlink options** :--glob-from file: Make references using Coq globalizations from file 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 url: Set base URL for the Coq standard library (default is ``_). This is equivalent to ``--external url Coq``. :-R dir coqdir: Recursively map physical directory dir to Coq logical directory ``coqdir`` (similarly to Coq option ``-R``). :-Q dir coqdir: Map physical directory dir to Coq logical directory ``coqdir`` (similarly to Coq option ``-Q``). .. note:: options ``-R`` and ``-Q`` only have effect on the files *following* them on the command line, so you will probably need to put this option first. **Title options** :-s , --short: Do not insert titles for the files. The default behavior is to insert a title like “Library Foo” for each file. :--lib-name string: Print “string Foo” instead of “Library Foo” in titles. For example “Chapter” and “Module” are reasonable choices. :--no-lib-name: Print just “Foo” instead of “Library Foo” in titles. :--lib-subtitles: Look for library subtitles. When enabled, the first line of each file is checked for a comment of the form: :: (** * ModuleName : text *) where ``ModuleName`` must be the name of the file. If it is present, the text is used as a subtitle for the module in appropriate places. :-t string, --title string: Set the document title. **Contents options** :-g, --gallina: Do not print proofs. :-l, --light: Light mode. Suppress proofs (as with ``-g``) and the following commands: + [Recursive] Tactic Definition + Hint / Hints + Require + Transparent / Opaque + Implicit Argument / Implicits + Section / Variable / Hypothesis / End The behavior of options ``-g`` and ``-l`` can be locally overridden using the ``(* begin show *) … (* end show *)`` environment (see above). There are a few options that control the parsing of comments: :--parse-comments: Parse regular comments delimited by ``(*`` and ``*)`` as well. They are typeset inline. :--plain-comments: Do not interpret comments, simply copy them as plain-text. :--interpolate: Use the globalization information to typeset identifiers appearing in Coq escapings inside comments. **Language options** The default behavior is to assume ASCII 7 bit input files. :-latin1, --latin1: Select ISO-8859-1 input files. It is equivalent to --inputenc latin1 --charset iso-8859-1. :-utf8, --utf8: Set --inputenc utf8x for |Latex| output and--charset utf-8 for HTML output. Also use Unicode replacements for a couple of standard plain ASCII notations such as → for ``->`` and ∀ for ``forall``. |Latex| UTF-8 support can be found at ``_. For the interpretation of Unicode characters by |Latex|, extra packages which coqdoc does not provide by default might be required, such as textgreek for some Greek letters or ``stmaryrd`` for some mathematical symbols. If a Unicode character is missing an interpretation in the utf8x input encoding, add ``\DeclareUnicodeCharacter{code}{LATEX-interpretation}``. Packages and declarations can be added with option ``-p``. :--inputenc string: Give a |Latex| input encoding, as an option to |Latex| package ``inputenc``. :--charset string: Specify the HTML character set, to be inserted in the HTML header. The coqdoc |Latex| style file ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ In case you choose to produce a document without the default |Latex| preamble (by using option ``--no-preamble``), then you must insert into your own preamble the command :: \usepackage{coqdoc} The package optionally takes the argument ``[color]`` to typeset identifiers with colors (this requires the ``xcolor`` package). Then you may alter the rendering of the document by redefining some macros: :coqdockw, coqdocid, …: The one-argument macros for typesetting keywords and identifiers. Defaults are sans-serif for keywords and italic for identifiers.For example, if you would like a slanted font for keywords, you may insert :: \renewcommand{\coqdockw}[1]{\textsl{#1}} anywhere between ``\usepackage{coqdoc}`` and ``\begin{document}``. :coqdocmodule: One-argument macro for typesetting the title of a ``.v`` file. Default is :: \newcommand{\coqdocmodule}[1]{\section*{Module #1}} and you may redefine it using ``\renewcommand``. coq-8.20.0/doc/sphinx/using/tools/index.rst000066400000000000000000000013011466560755400206040ustar00rootroot00000000000000.. _tools: ================================ 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 graphical user interface and the documentation of the parallel proof processing feature that is supported by CoqIDE and several other GUIs. A list of available user interfaces to interact with Coq is available on the `Coq website `_. .. toctree:: :maxdepth: 1 ../../practical-tools/utilities ../../practical-tools/coq-commands coqdoc ../../practical-tools/coqide ../../addendum/parallel-proof-processing coq-8.20.0/doc/sphinx/zebibliography.html.rst000066400000000000000000000013311466560755400211700ustar00rootroot00000000000000.. There are multiple issues with sphinxcontrib-bibtex that we have to work around: - The list of cited entries is computed right after encountering `.. bibliography`, so the file containing that command has to come last alphabetically: https://sphinxcontrib-bibtex.readthedocs.io/en/latest/usage.html#unresolved-citations-across-documents - `.. bibliography::` puts the bibliography on its own page with its own title in LaTeX, but includes it inline without a title in HTML: https://sphinxcontrib-bibtex.readthedocs.io/en/latest/usage.html#mismatch-between-output-of-html-and-latex-backends .. _bibliography: ============== Bibliography ============== .. bibliography:: biblio.bib :cited: coq-8.20.0/doc/sphinx/zebibliography.latex.rst000066400000000000000000000001471466560755400213450ustar00rootroot00000000000000.. See zebibliography.html.rst for details .. _bibliography: .. bibliography:: biblio.bib :cited: coq-8.20.0/doc/stdlib/000077500000000000000000000000001466560755400144335ustar00rootroot00000000000000coq-8.20.0/doc/stdlib/Library.tex000066400000000000000000000043371466560755400165700ustar00rootroot00000000000000\documentclass[11pt]{report} \usepackage[mathletters]{ucs} \usepackage[utf8x]{inputenc} \usepackage[T1]{fontenc} \usepackage{fullpage} \usepackage{amsfonts} \usepackage{amssymb} \usepackage{url} \usepackage[color]{../../lib/coq-core/tools/coqdoc/coqdoc} \input{../common/version} \input{../common/title} \input{../common/macros} \begin{document} \coverpage{The standard library}% {\ } {This material is distributed under the terms of the GNU Lesser General Public License Version 2.1.} \tableofcontents \newpage % \section*{The \Coq\ standard library} This document is a short description of the \Coq\ standard library. This library comes with the system as a complement of the core library (the {\bf Init} library ; see the Reference Manual for a description of this library). It provides a set of modules directly available through the \verb!Require! command. The standard library is composed of the following subdirectories: \begin{description} \item[Logic] Classical logic and dependent equality \item[Bool] Booleans (basic functions and results) \item[Arith] Basic Peano arithmetic \item[ZArith] Basic integer arithmetic \item[Reals] Classical Real Numbers and Analysis \item[Lists] Monomorphic and polymorphic lists (basic functions and results), Streams (infinite sequences defined with co-inductive types) \item[Sets] Sets (classical, constructive, finite, infinite, power set, etc.) \item[Relations] Relations (definitions and basic results). \item[Sorting] Sorted list (basic definitions and heapsort correctness). \item[Wellfounded] Well-founded relations (basic results). \item[Program] Tactics to deal with dependently-typed programs and their proofs. \item[Classes] Standard type class instances on relations and Coq part of the setoid rewriting tactic. \end{description} Each of these subdirectories contains a set of modules, whose specifications (\gallina{} files) have been roughly, and automatically, pasted in the following pages. There is also a version of this document in HTML format on the WWW, which you can access from the \Coq\ home page at \texttt{http://coq.inria.fr/library}. \input{Library.coqdoc} \end{document} coq-8.20.0/doc/stdlib/dune000066400000000000000000000034131466560755400153120ustar00rootroot00000000000000; This is an ad-hoc rule to ease the migration, it should be handled ; natively by Dune in the future. (rule (targets index-list.html) (deps make-library-index index-list.html.template hidden-files (source_tree %{project_root}/theories) (source_tree %{project_root}/user-contrib)) (action (chdir %{project_root} ; On windows run will fail (bash "doc/stdlib/make-library-index doc/stdlib/index-list.html doc/stdlib/hidden-files")))) (rule (targets (dir html)) (alias stdlib-html) (package coq-doc) (deps ; This will be replaced soon by `theories/**/*.v` soon, thanks to rgrinberg (source_tree %{project_root}/theories) (source_tree %{project_root}/user-contrib) (:header %{project_root}/doc/common/styles/html/coqremote/header.html) (:footer %{project_root}/doc/common/styles/html/coqremote/footer.html) ; For .glob files, should be gone when Coq Dune is smarter. (package coq-core) (package coq-stdlib)) (action (progn (run mkdir -p html) (bash "%{bin:coqdoc} -q -d html --with-header %{header} --with-footer %{footer} --multi-index --html -g -coqlib %{project_root} -R %{project_root}/theories Coq -Q %{project_root}/user-contrib/Ltac2 Ltac2 $(find %{project_root}/theories %{project_root}/user-contrib -name *.v)") (run mv html/index.html html/genindex.html) (with-stdout-to _index.html (progn (cat %{header}) (cat index-list.html) (cat %{footer}))) (run cp _index.html html/index.html)))) ; Installable directories are not yet fully supported by Dune. See ; ocaml/dune#1868. Yet, this makes coq-doc.install a valid target to ; generate the whole Coq documentation. And the result under ; _build/install/default/doc/coq-doc looks just right! (install (dirs (html as html/stdlib)) (section doc) (package coq-doc)) coq-8.20.0/doc/stdlib/hidden-files000066400000000000000000000067511466560755400167220ustar00rootroot00000000000000theories/btauto/Algebra.v theories/btauto/Btauto.v theories/btauto/Reflect.v theories/derive/Derive.v theories/extraction/ExtrHaskellBasic.v theories/extraction/ExtrHaskellNatInt.v theories/extraction/ExtrHaskellNatInteger.v theories/extraction/ExtrHaskellNatNum.v theories/extraction/ExtrHaskellString.v theories/extraction/ExtrHaskellZInt.v theories/extraction/ExtrHaskellZInteger.v theories/extraction/ExtrHaskellZNum.v theories/extraction/ExtrOcamlBasic.v theories/extraction/ExtrOcamlChar.v theories/extraction/ExtrOCamlInt63.v theories/extraction/ExtrOCamlFloats.v theories/extraction/ExtrOCamlPArray.v theories/extraction/ExtrOcamlIntConv.v theories/extraction/ExtrOcamlNatBigInt.v theories/extraction/ExtrOcamlNatInt.v theories/extraction/ExtrOcamlString.v theories/extraction/ExtrOCamlPString.v theories/extraction/ExtrOcamlNativeString.v theories/extraction/ExtrOcamlZBigInt.v theories/extraction/ExtrOcamlZInt.v theories/extraction/Extraction.v theories/funind/FunInd.v theories/funind/Recdef.v theories/ltac/Ltac.v theories/micromega/Ztac.v theories/micromega/DeclConstant.v theories/micromega/Env.v theories/micromega/EnvRing.v theories/micromega/Fourier.v theories/micromega/Fourier_util.v theories/micromega/Lia.v theories/micromega/Lqa.v theories/micromega/Lra.v theories/micromega/MExtraction.v theories/micromega/OrderedRing.v theories/micromega/Psatz.v theories/micromega/QMicromega.v theories/micromega/RMicromega.v theories/micromega/Refl.v theories/micromega/RingMicromega.v theories/micromega/Tauto.v theories/micromega/VarMap.v theories/micromega/ZArith_hints.v theories/micromega/ZCoeff.v theories/micromega/ZMicromega.v theories/micromega/ZifyInst.v theories/micromega/ZifyBool.v theories/micromega/ZifyInt63.v theories/micromega/ZifyUint63.v theories/micromega/ZifySint63.v theories/micromega/ZifyNat.v theories/micromega/ZifyN.v theories/micromega/ZifyComparison.v theories/micromega/ZifyClasses.v theories/micromega/ZifyPow.v theories/micromega/Zify.v theories/nsatz/NsatzTactic.v theories/nsatz/Nsatz.v theories/omega/OmegaLemmas.v theories/omega/PreOmega.v theories/quote/Quote.v theories/romega/ROmega.v theories/romega/ReflOmegaCore.v theories/rtauto/Bintree.v theories/rtauto/Rtauto.v theories/setoid_ring/Algebra_syntax.v theories/setoid_ring/ArithRing.v theories/setoid_ring/BinList.v theories/setoid_ring/Cring.v theories/setoid_ring/Field.v theories/setoid_ring/Field_tac.v theories/setoid_ring/Field_theory.v theories/setoid_ring/InitialRing.v theories/setoid_ring/Integral_domain.v theories/setoid_ring/NArithRing.v theories/setoid_ring/Ncring.v theories/setoid_ring/Ncring_initial.v theories/setoid_ring/Ncring_polynom.v theories/setoid_ring/Ncring_tac.v theories/setoid_ring/RealField.v theories/setoid_ring/Ring.v theories/setoid_ring/Ring_base.v theories/setoid_ring/Ring_polynom.v theories/setoid_ring/Ring_tac.v theories/setoid_ring/Ring_theory.v theories/setoid_ring/Rings_Q.v theories/setoid_ring/Rings_R.v theories/setoid_ring/Rings_Z.v theories/setoid_ring/ZArithRing.v theories/ssr/ssrunder.v theories/ssr/ssrsetoid.v theories/Reals/Cauchy/ConstructiveExtra.v theories/Reals/Cauchy/PosExtra.v theories/Reals/Cauchy/QExtra.v theories/Numbers/Natural/Binary/NBinary.v theories/Numbers/Integer/Binary/ZBinary.v theories/Numbers/Integer/NatPairs/ZNatPairs.v theories/Numbers/NatInt/NZProperties.v theories/Numbers/NatInt/NZDomain.v theories/Numbers/Integer/Abstract/ZDivEucl.v theories/ZArith/Zeuclid.v theories/Arith/Bool_nat.v theories/Numbers/Natural/Abstract/NDefOps.v theories/Numbers/Natural/Abstract/NIso.v coq-8.20.0/doc/stdlib/index-list.html.template000066400000000000000000000506501466560755400212210ustar00rootroot00000000000000

The Coq Standard Library

Here is a short description of the Coq standard library, which is distributed with the system. It provides a set of modules directly available through the Require Import command.

The standard library is composed of the following subdirectories:

Init: The core library (automatically loaded when starting Coq)
theories/Init/Ltac.v theories/Init/Notations.v theories/Init/Datatypes.v theories/Init/Logic.v theories/Init/Byte.v theories/Init/Nat.v theories/Init/Decimal.v theories/Init/Hexadecimal.v theories/Init/Number.v theories/Init/Peano.v theories/Init/Specif.v theories/Init/Tactics.v theories/Init/Tauto.v theories/Init/Wf.v (theories/Init/Prelude.v)
Logic: Classical logic, dependent equality, extensionality, choice axioms
theories/Logic/SetIsType.v theories/Logic/StrictProp.v theories/Logic/Classical_Pred_Type.v theories/Logic/Classical_Prop.v (theories/Logic/Classical.v) theories/Logic/ClassicalFacts.v theories/Logic/Decidable.v theories/Logic/Eqdep_dec.v theories/Logic/EqdepFacts.v theories/Logic/Eqdep.v theories/Logic/JMeq.v theories/Logic/ChoiceFacts.v theories/Logic/RelationalChoice.v theories/Logic/ClassicalChoice.v theories/Logic/ClassicalDescription.v theories/Logic/ClassicalEpsilon.v theories/Logic/ClassicalUniqueChoice.v theories/Logic/SetoidChoice.v theories/Logic/Berardi.v theories/Logic/Diaconescu.v theories/Logic/Hurkens.v theories/Logic/ProofIrrelevance.v theories/Logic/ProofIrrelevanceFacts.v theories/Logic/ConstructiveEpsilon.v theories/Logic/Description.v theories/Logic/Epsilon.v theories/Logic/IndefiniteDescription.v theories/Logic/PropExtensionality.v theories/Logic/PropExtensionalityFacts.v theories/Logic/FunctionalExtensionality.v theories/Logic/ExtensionalFunctionRepresentative.v theories/Logic/ExtensionalityFacts.v theories/Logic/WeakFan.v theories/Logic/WKL.v theories/Logic/FinFun.v theories/Logic/PropFacts.v theories/Logic/HLevels.v theories/Logic/Adjointification.v
Structures: Algebraic structures (types with equality, with order, ...). DecidableType* and OrderedType* are there only for compatibility.
theories/Structures/Equalities.v theories/Structures/EqualitiesFacts.v theories/Structures/Orders.v theories/Structures/OrdersTac.v theories/Structures/OrdersAlt.v theories/Structures/OrdersEx.v theories/Structures/OrdersFacts.v theories/Structures/OrdersLists.v theories/Structures/GenericMinMax.v theories/Structures/DecidableType.v theories/Structures/DecidableTypeEx.v theories/Structures/OrderedType.v theories/Structures/OrderedTypeAlt.v theories/Structures/OrderedTypeEx.v
Bool: Booleans (basic functions and results)
theories/Bool/Bool.v theories/Bool/BoolEq.v theories/Bool/BoolOrder.v theories/Bool/DecBool.v theories/Bool/IfProp.v theories/Bool/Sumbool.v theories/Bool/Zerob.v theories/Bool/Bvector.v
Arith: Basic Peano arithmetic
theories/Arith/PeanoNat.v theories/Arith/Between.v theories/Arith/Peano_dec.v theories/Arith/Compare_dec.v (theories/Arith/Arith_base.v) (theories/Arith/Arith.v) theories/Arith/Compare.v theories/Arith/EqNat.v theories/Arith/Euclid.v theories/Arith/Factorial.v theories/Arith/Wf_nat.v theories/Arith/Cantor.v
PArith: Binary positive integers
theories/PArith/BinPosDef.v theories/PArith/BinPos.v theories/PArith/Pnat.v theories/PArith/POrderedType.v (theories/PArith/PArith.v)
NArith: Binary natural numbers
theories/NArith/BinNatDef.v theories/NArith/BinNat.v theories/NArith/Nnat.v theories/NArith/Ndec.v theories/NArith/Ndiv_def.v theories/NArith/Ngcd_def.v theories/NArith/Nsqrt_def.v (theories/NArith/NArith.v)
ZArith: Binary integers
theories/ZArith/BinIntDef.v theories/ZArith/BinInt.v theories/ZArith/Zorder.v theories/ZArith/Zcompare.v theories/ZArith/Znat.v theories/ZArith/Zmin.v theories/ZArith/Zmax.v theories/ZArith/Zminmax.v theories/ZArith/Zabs.v theories/ZArith/Zeven.v theories/ZArith/auxiliary.v theories/ZArith/ZArith_dec.v theories/ZArith/Zbool.v theories/ZArith/Zmisc.v theories/ZArith/Wf_Z.v theories/ZArith/Zhints.v (theories/ZArith/ZArith_base.v) theories/ZArith/Zcomplements.v theories/ZArith/Zpow_def.v theories/ZArith/Zpow_alt.v theories/ZArith/Zpower.v theories/ZArith/Zdiv.v theories/ZArith/Zquot.v (theories/ZArith/ZArith.v) theories/ZArith/Zgcd_alt.v theories/ZArith/Zwf.v theories/ZArith/Znumtheory.v theories/ZArith/Int.v theories/ZArith/Zpow_facts.v theories/ZArith/Zbitwise.v
QArith: Rational numbers
theories/QArith/QArith_base.v theories/QArith/Qabs.v theories/QArith/Qpower.v theories/QArith/Qreduction.v theories/QArith/Qring.v theories/QArith/Qfield.v (theories/QArith/QArith.v) theories/QArith/Qreals.v theories/QArith/Qcanon.v theories/QArith/Qcabs.v theories/QArith/Qround.v theories/QArith/QOrderedType.v theories/QArith/Qminmax.v
Numbers: An experimental modular architecture for arithmetic
  Prelude:
theories/Numbers/BinNums.v theories/Numbers/NumPrelude.v theories/Numbers/NaryFunctions.v theories/Numbers/AltBinNotations.v theories/Numbers/DecimalFacts.v theories/Numbers/DecimalNat.v theories/Numbers/DecimalPos.v theories/Numbers/DecimalN.v theories/Numbers/DecimalZ.v theories/Numbers/DecimalQ.v theories/Numbers/DecimalR.v theories/Numbers/DecimalString.v theories/Numbers/HexadecimalFacts.v theories/Numbers/HexadecimalNat.v theories/Numbers/HexadecimalPos.v theories/Numbers/HexadecimalN.v theories/Numbers/HexadecimalZ.v theories/Numbers/HexadecimalQ.v theories/Numbers/HexadecimalR.v theories/Numbers/HexadecimalString.v
  NatInt: Abstract mixed natural/integer/cyclic arithmetic
theories/Numbers/NatInt/NZAdd.v theories/Numbers/NatInt/NZAddOrder.v theories/Numbers/NatInt/NZAxioms.v theories/Numbers/NatInt/NZBase.v theories/Numbers/NatInt/NZMul.v theories/Numbers/NatInt/NZDiv.v theories/Numbers/NatInt/NZMulOrder.v theories/Numbers/NatInt/NZOrder.v theories/Numbers/NatInt/NZParity.v theories/Numbers/NatInt/NZPow.v theories/Numbers/NatInt/NZSqrt.v theories/Numbers/NatInt/NZLog.v theories/Numbers/NatInt/NZGcd.v theories/Numbers/NatInt/NZBits.v
  Cyclic: Abstract and 63-bits-based cyclic arithmetic
theories/Numbers/Cyclic/Abstract/CyclicAxioms.v theories/Numbers/Cyclic/Abstract/NZCyclic.v theories/Numbers/Cyclic/Abstract/CarryType.v theories/Numbers/Cyclic/Abstract/DoubleType.v theories/Numbers/Cyclic/Int63/Cyclic63.v theories/Numbers/Cyclic/Int63/PrimInt63.v theories/Numbers/Cyclic/Int63/Uint63.v theories/Numbers/Cyclic/Int63/Sint63.v theories/Numbers/Cyclic/Int63/Ring63.v
  Natural: Abstract and 63-bits-words-based natural arithmetic
theories/Numbers/Natural/Abstract/NAdd.v theories/Numbers/Natural/Abstract/NAddOrder.v theories/Numbers/Natural/Abstract/NAxioms.v theories/Numbers/Natural/Abstract/NBase.v theories/Numbers/Natural/Abstract/NMulOrder.v theories/Numbers/Natural/Abstract/NOrder.v theories/Numbers/Natural/Abstract/NStrongRec.v theories/Numbers/Natural/Abstract/NSub.v theories/Numbers/Natural/Abstract/NDiv.v theories/Numbers/Natural/Abstract/NDiv0.v theories/Numbers/Natural/Abstract/NMaxMin.v theories/Numbers/Natural/Abstract/NParity.v theories/Numbers/Natural/Abstract/NPow.v theories/Numbers/Natural/Abstract/NSqrt.v theories/Numbers/Natural/Abstract/NLog.v theories/Numbers/Natural/Abstract/NGcd.v theories/Numbers/Natural/Abstract/NLcm.v theories/Numbers/Natural/Abstract/NLcm0.v theories/Numbers/Natural/Abstract/NBits.v theories/Numbers/Natural/Abstract/NProperties.v
  Integer: Abstract and concrete (especially 63-bits-words-based) integer arithmetic
theories/Numbers/Integer/Abstract/ZAdd.v theories/Numbers/Integer/Abstract/ZAddOrder.v theories/Numbers/Integer/Abstract/ZAxioms.v theories/Numbers/Integer/Abstract/ZBase.v theories/Numbers/Integer/Abstract/ZLt.v theories/Numbers/Integer/Abstract/ZMul.v theories/Numbers/Integer/Abstract/ZMulOrder.v theories/Numbers/Integer/Abstract/ZSgnAbs.v theories/Numbers/Integer/Abstract/ZMaxMin.v theories/Numbers/Integer/Abstract/ZParity.v theories/Numbers/Integer/Abstract/ZPow.v theories/Numbers/Integer/Abstract/ZGcd.v theories/Numbers/Integer/Abstract/ZLcm.v theories/Numbers/Integer/Abstract/ZBits.v theories/Numbers/Integer/Abstract/ZProperties.v theories/Numbers/Integer/Abstract/ZDivFloor.v theories/Numbers/Integer/Abstract/ZDivTrunc.v
  Floats: Floating-point arithmetic
theories/Floats/FloatClass.v theories/Floats/PrimFloat.v theories/Floats/SpecFloat.v theories/Floats/FloatOps.v theories/Floats/FloatAxioms.v theories/Floats/FloatLemmas.v (theories/Floats/Floats.v)
Relations: Relations (definitions and basic results)
theories/Relations/Relation_Definitions.v theories/Relations/Relation_Operators.v theories/Relations/Relations.v theories/Relations/Operators_Properties.v
Sets: Sets (classical, constructive, finite, infinite, powerset, etc.)
theories/Sets/Classical_sets.v theories/Sets/Constructive_sets.v theories/Sets/Cpo.v theories/Sets/Ensembles.v theories/Sets/Finite_sets_facts.v theories/Sets/Finite_sets.v theories/Sets/Image.v theories/Sets/Infinite_sets.v theories/Sets/Integers.v theories/Sets/Multiset.v theories/Sets/Partial_Order.v theories/Sets/Permut.v theories/Sets/Powerset_Classical_facts.v theories/Sets/Powerset_facts.v theories/Sets/Powerset.v theories/Sets/Relations_1_facts.v theories/Sets/Relations_1.v theories/Sets/Relations_2_facts.v theories/Sets/Relations_2.v theories/Sets/Relations_3_facts.v theories/Sets/Relations_3.v theories/Sets/Uniset.v
Classes:
theories/Classes/Init.v theories/Classes/RelationClasses.v theories/Classes/Morphisms.v theories/Classes/Morphisms_Prop.v theories/Classes/Morphisms_Relations.v theories/Classes/Equivalence.v theories/Classes/CRelationClasses.v theories/Classes/CMorphisms.v theories/Classes/CEquivalence.v theories/Classes/EquivDec.v theories/Classes/SetoidTactics.v theories/Classes/SetoidClass.v theories/Classes/SetoidDec.v theories/Classes/RelationPairs.v theories/Classes/DecidableClass.v
Setoids:
theories/Setoids/Setoid.v
Lists: Polymorphic lists, Streams (infinite sequences)
theories/Lists/List.v theories/Lists/ListDec.v theories/Lists/ListSet.v theories/Lists/SetoidList.v theories/Lists/SetoidPermutation.v theories/Lists/Streams.v theories/Lists/StreamMemo.v theories/Lists/ListTactics.v
Vectors: Dependent datastructures storing their length
theories/Vectors/Fin.v theories/Vectors/VectorDef.v theories/Vectors/VectorSpec.v theories/Vectors/VectorEq.v (theories/Vectors/Vector.v)
Sorting: Axiomatizations of sorts
theories/Sorting/Heap.v theories/Sorting/Permutation.v theories/Sorting/Sorting.v theories/Sorting/PermutEq.v theories/Sorting/PermutSetoid.v theories/Sorting/Mergesort.v theories/Sorting/Sorted.v theories/Sorting/CPermutation.v
Wellfounded: Well-founded Relations
theories/Wellfounded/Disjoint_Union.v theories/Wellfounded/Inclusion.v theories/Wellfounded/Inverse_Image.v theories/Wellfounded/Lexicographic_Exponentiation.v theories/Wellfounded/Lexicographic_Product.v theories/Wellfounded/Transitive_Closure.v theories/Wellfounded/Union.v theories/Wellfounded/Wellfounded.v theories/Wellfounded/Well_Ordering.v
MSets: Modular implementation of finite sets using lists or efficient trees. This is a modernization of FSets.
theories/MSets/MSetInterface.v theories/MSets/MSetFacts.v theories/MSets/MSetDecide.v theories/MSets/MSetProperties.v theories/MSets/MSetEqProperties.v theories/MSets/MSetWeakList.v theories/MSets/MSetList.v theories/MSets/MSetGenTree.v theories/MSets/MSetAVL.v theories/MSets/MSetRBT.v theories/MSets/MSetPositive.v theories/MSets/MSetToFiniteSet.v (theories/MSets/MSets.v)
FSets: Modular implementation of finite sets/maps using lists or efficient trees. For sets, please consider the more modern MSets.
theories/FSets/FSetInterface.v theories/FSets/FSetBridge.v theories/FSets/FSetFacts.v theories/FSets/FSetDecide.v theories/FSets/FSetProperties.v theories/FSets/FSetEqProperties.v theories/FSets/FSetList.v theories/FSets/FSetWeakList.v theories/FSets/FSetCompat.v theories/FSets/FSetAVL.v theories/FSets/FSetPositive.v (theories/FSets/FSets.v) theories/FSets/FSetToFiniteSet.v theories/FSets/FMapInterface.v theories/FSets/FMapWeakList.v theories/FSets/FMapList.v theories/FSets/FMapPositive.v theories/FSets/FMapFacts.v (theories/FSets/FMaps.v) theories/FSets/FMapAVL.v theories/FSets/FMapFullAVL.v
Strings Implementation of string as list of ascii characters
theories/Strings/Byte.v theories/Strings/Ascii.v theories/Strings/String.v theories/Strings/BinaryString.v theories/Strings/HexString.v theories/Strings/OctalString.v
Reals: Formalization of real numbers
Classical Reals: Real numbers with excluded middle, total order and least upper bounds
theories/Reals/Rdefinitions.v theories/Reals/ClassicalDedekindReals.v theories/Reals/ClassicalConstructiveReals.v theories/Reals/Raxioms.v theories/Reals/RIneq.v theories/Reals/DiscrR.v theories/Reals/ROrderedType.v theories/Reals/Rminmax.v (theories/Reals/Rbase.v) theories/Reals/RList.v theories/Reals/Ranalysis.v theories/Reals/Rbasic_fun.v theories/Reals/Rderiv.v theories/Reals/Rfunctions.v theories/Reals/Rgeom.v theories/Reals/R_Ifp.v theories/Reals/Rlimit.v theories/Reals/Rseries.v theories/Reals/Rsigma.v theories/Reals/R_sqr.v theories/Reals/Rtrigo_fun.v theories/Reals/Rtrigo1.v theories/Reals/Rtrigo.v theories/Reals/Rtrigo_facts.v theories/Reals/Ratan.v theories/Reals/Machin.v theories/Reals/SplitAbsolu.v theories/Reals/SplitRmult.v theories/Reals/Alembert.v theories/Reals/AltSeries.v theories/Reals/ArithProp.v theories/Reals/Binomial.v theories/Reals/Cauchy_prod.v theories/Reals/Cos_plus.v theories/Reals/Cos_rel.v theories/Reals/Exp_prop.v theories/Reals/Integration.v theories/Reals/MVT.v theories/Reals/NewtonInt.v theories/Reals/PSeries_reg.v theories/Reals/PartSum.v theories/Reals/R_sqrt.v theories/Reals/Ranalysis1.v theories/Reals/Ranalysis2.v theories/Reals/Ranalysis3.v theories/Reals/Ranalysis4.v theories/Reals/Ranalysis5.v theories/Reals/Ranalysis_reg.v theories/Reals/Rcomplete.v theories/Reals/RiemannInt.v theories/Reals/RiemannInt_SF.v theories/Reals/Rpow_def.v theories/Reals/Rpower.v theories/Reals/Rprod.v theories/Reals/Rsqrt_def.v theories/Reals/Rtopology.v theories/Reals/Rtrigo_alt.v theories/Reals/Rtrigo_calc.v theories/Reals/Rtrigo_def.v theories/Reals/Rtrigo_reg.v theories/Reals/SeqProp.v theories/Reals/SeqSeries.v theories/Reals/Sqrt_reg.v theories/Reals/Rlogic.v theories/Reals/Rregisternames.v (theories/Reals/Reals.v) theories/Reals/Runcountable.v
Abstract Constructive Reals: Interface of constructive reals, proof of equivalence of all implementations. EXPERIMENTAL
theories/Reals/Abstract/ConstructiveReals.v theories/Reals/Abstract/ConstructiveRealsMorphisms.v theories/Reals/Abstract/ConstructiveLUB.v theories/Reals/Abstract/ConstructiveAbs.v theories/Reals/Abstract/ConstructiveLimits.v theories/Reals/Abstract/ConstructiveMinMax.v theories/Reals/Abstract/ConstructivePower.v theories/Reals/Abstract/ConstructiveSum.v
Constructive Cauchy Reals: Cauchy sequences of rational numbers, implementation of the interface. EXPERIMENTAL
theories/Reals/Cauchy/ConstructiveRcomplete.v theories/Reals/Cauchy/ConstructiveCauchyReals.v theories/Reals/Cauchy/ConstructiveCauchyRealsMult.v theories/Reals/Cauchy/ConstructiveCauchyAbs.v
Program: Support for dependently-typed programming
theories/Program/Basics.v theories/Program/Wf.v theories/Program/Subset.v theories/Program/Equality.v theories/Program/Tactics.v theories/Program/Utils.v theories/Program/Syntax.v theories/Program/Program.v theories/Program/Combinators.v
SSReflect: Base libraries for the SSReflect proof language and the small scale reflection formalization technique
theories/ssrmatching/ssrmatching.v theories/ssr/ssrclasses.v theories/ssr/ssreflect.v theories/ssr/ssrbool.v theories/ssr/ssrfun.v
Ltac2: The Ltac2 tactic programming language
user-contrib/Ltac2/Ltac2.v user-contrib/Ltac2/Array.v user-contrib/Ltac2/Bool.v user-contrib/Ltac2/Char.v user-contrib/Ltac2/Constant.v user-contrib/Ltac2/Constr.v user-contrib/Ltac2/Constructor.v user-contrib/Ltac2/Control.v user-contrib/Ltac2/Env.v user-contrib/Ltac2/Evar.v user-contrib/Ltac2/Float.v user-contrib/Ltac2/FMap.v user-contrib/Ltac2/FSet.v user-contrib/Ltac2/Fresh.v user-contrib/Ltac2/Ident.v user-contrib/Ltac2/Ind.v user-contrib/Ltac2/Init.v user-contrib/Ltac2/Int.v user-contrib/Ltac2/Lazy.v user-contrib/Ltac2/List.v user-contrib/Ltac2/Ltac1.v user-contrib/Ltac2/Message.v user-contrib/Ltac2/Meta.v user-contrib/Ltac2/Notations.v user-contrib/Ltac2/Option.v user-contrib/Ltac2/Pattern.v user-contrib/Ltac2/Printf.v user-contrib/Ltac2/Proj.v user-contrib/Ltac2/Pstring.v user-contrib/Ltac2/RedFlags.v user-contrib/Ltac2/Ref.v user-contrib/Ltac2/Std.v user-contrib/Ltac2/String.v user-contrib/Ltac2/TransparentState.v user-contrib/Ltac2/Uint63.v user-contrib/Ltac2/Unification.v
Unicode: Unicode-based notations
theories/Unicode/Utf8_core.v theories/Unicode/Utf8.v
Compat: Compatibility wrappers for previous versions of Coq
theories/Compat/AdmitAxiom.v theories/Compat/Coq818.v theories/Compat/Coq819.v theories/Compat/Coq820.v user-contrib/Ltac2/Compat/Coq818.v user-contrib/Ltac2/Compat/Coq819.v
Array: Persistent native arrays
theories/Array/PArray.v
Primitive strings Native string type
theories/Strings/PrimString.v theories/Strings/PrimStringAxioms.v theories/Strings/PString.v
coq-8.20.0/doc/stdlib/make-library-index000077500000000000000000000026711466560755400200530ustar00rootroot00000000000000#!/usr/bin/env bash # Instantiate links to library files in index template set -e FILE=$1 HIDDEN=$2 tmp=$(mktemp) tmp2=$(mktemp) cp -f "$FILE.template" "$tmp" echo -n "Building file index-list.prehtml... " LIBDIRS=$(find theories/* user-contrib/* -type d ! -name .coq-native) for k in $LIBDIRS; do if [[ $k =~ "user-contrib" ]]; then BASE_PREFIX="" else BASE_PREFIX="Coq." fi d=$(basename "$k") for j in "$k"/*.v; do if ! [ -e "$j" ]; then break; fi b=$(basename "$j" .v) a=0; grep -q "$k/$b.v" "$tmp" || a=$? h=0; grep -q "$k/$b.v" "$HIDDEN" || h=$? if [ $a = 0 ]; then if [ $h = 0 ]; then echo "Error: $FILE and $HIDDEN both mention $k/$b.v" >&2 exit 1 else p=$(echo "$k" | sed 's:^[^/]*/::' | sed 's:/:.:g') sed -e "s:$k/$b.v:$b:g" "$tmp" > "$tmp2" mv -f "$tmp2" "$tmp" fi else if [ $h = 0 ]; then # Skipping file from the index : else echo "Error: none of $FILE and $HIDDEN mention $k/$b.v" >&2 exit 1 fi fi done sed -e "s/#$d#//" "$tmp" > "$tmp2" mv -f "$tmp2" "$tmp" done if a=$(grep theories "$tmp"); then echo Error: extra files: >&2; echo "$a" >&2; exit 1; fi mv "$tmp" "$FILE" echo Done coq-8.20.0/doc/tools/000077500000000000000000000000001466560755400143125ustar00rootroot00000000000000coq-8.20.0/doc/tools/coqrst/000077500000000000000000000000001466560755400156255ustar00rootroot00000000000000coq-8.20.0/doc/tools/coqrst/__init__.py000066400000000000000000000013211466560755400177330ustar00rootroot00000000000000########################################################################## ## # The Coq Proof Assistant / The Coq Development Team ## ## v # Copyright INRIA, CNRS and contributors ## ## 0: deps = " ".join(missing_deps) eprint('Cannot find package(s) `%s` (needed to build documentation)' % deps) eprint('You can run `pip3 install %s` to install it/them.' % deps) sys.exit(1) try: import sphinx_rtd_theme except: missing_dep('sphinx_rtd_theme') try: import pexpect except: missing_dep('pexpect') try: import antlr4 except: missing_dep('antlr4-python3-runtime') try: import bs4 except: missing_dep('beautifulsoup4') try: import sphinxcontrib.bibtex except: missing_dep('sphinxcontrib-bibtex') report_missing_deps() coq-8.20.0/doc/tools/coqrst/coqdoc/000077500000000000000000000000001466560755400170755ustar00rootroot00000000000000coq-8.20.0/doc/tools/coqrst/coqdoc/__init__.py000066400000000000000000000012671466560755400212140ustar00rootroot00000000000000########################################################################## ## # The Coq Proof Assistant / The Coq Development Team ## ## v # Copyright INRIA, CNRS and contributors ## ## ", "<-", "<->", "=>", "<=", ">=", "<>", "~", "/\\", "\\/", "|-", "*", "forall", "exists"] COQDOC_HEADER = "".join("(** remove printing {} *)".format(s) for s in COQDOC_SYMBOLS) def coqdoc(coq_code, coqdoc_bin=None): """Get the output of coqdoc on coq_code.""" coqdoc_bin = coqdoc_bin or os.path.join(os.getenv("COQBIN", ""), "coqdoc") fd, filename = mkstemp(prefix="coqdoc_", suffix=".v") if platform.system().startswith("CYGWIN"): # coqdoc currently doesn't accept cygwin style paths in the form "/cygdrive/c/..." filename = check_output(["cygpath", "-w", filename]).decode("utf-8").strip() try: os.write(fd, COQDOC_HEADER.encode("utf-8")) os.write(fd, coq_code.encode("utf-8")) os.close(fd) return check_output([coqdoc_bin] + COQDOC_OPTIONS + [filename], timeout = 10).decode("utf-8") finally: os.remove(filename) def first_string_node(node): """Return the first string node, or None if does not exist""" while node.children: node = next(node.children) if isinstance(node, NavigableString): return node def lex(source): """Convert source into a stream of (css_classes, token_string).""" coqdoc_output = coqdoc(source) soup = BeautifulSoup(coqdoc_output, "html.parser") root = soup.find(class_='code') # strip the leading '\n' first = first_string_node(root) if first and first.string[0] == '\n': first.string.replace_with(first.string[1:]) for elem in root.children: if isinstance(elem, NavigableString): yield [], elem elif elem.name == "span": if elem.string: cls = "coqdoc-{}".format(elem.get("title", "comment")) yield [cls], elem.string else: # handle multi-line comments children = list(elem.children) mlc = children[0].startswith("(*") and children[-1].endswith ("*)") for elem2 in children: if isinstance(elem2, NavigableString): cls = ["coqdoc-comment"] if mlc else [] yield cls, elem2 elif elem2.name == 'br': pass elif elem.name == 'br': pass else: raise ValueError(elem) def main(): """Lex stdin (for testing purposes)""" import sys for classes, text in lex(sys.stdin.read()): print(repr(text) + "\t" ' '.join(classes)) if __name__ == '__main__': main() coq-8.20.0/doc/tools/coqrst/coqdomain.py000066400000000000000000001565471466560755400201730ustar00rootroot00000000000000########################################################################## ## # The Coq Proof Assistant / The Coq Development Team ## ## v # Copyright INRIA, CNRS and contributors ## ## = (4, 5): from sphinx.writers.latex import CR def visit_desc_signature(self, node): hyper = '' if node.parent['objtype'] != 'describe' and node['ids']: for id in node['ids']: hyper += self.hypertarget(id) self.body.append(hyper) if not self.in_desc_signature: self.in_desc_signature = True self.body.append(CR + r'\pysigstartsignatures') if not node.get('is_multiline'): self._visit_signature_line(node) else: self.body.append(CR + r'\pysigstartmultiline') else: def visit_desc_signature(self, node): hyper = '' if node.parent['objtype'] != 'describe' and node['ids']: for id in node['ids']: hyper += self.hypertarget(id) self.body.append(hyper) if not node.get('is_multiline'): self._visit_signature_line(node) else: self.body.append('%\n\\pysigstartmultiline\n') LaTeXTranslator.visit_desc_signature = visit_desc_signature PARSE_ERROR = """{}:{} Parse error in notation! Offending notation: {} Error message: {}""" def notation_to_sphinx(notation, source, line, rawtext=None): """Parse notation and wrap it in an inline node""" try: node = nodes.inline(rawtext or notation, '', *sphinxify(notation), classes=['notation']) node.source, node.line = source, line return node except ParseError as e: raise ExtensionError(PARSE_ERROR.format(os.path.basename(source), line, notation, e.msg)) from e def notation_to_string(notation): """Parse notation and format it as a string with ellipses.""" try: return stringify_with_ellipses(notation) except ParseError as e: # FIXME source and line aren't defined below — see cc93f419e0 raise ExtensionError(PARSE_ERROR.format(os.path.basename(source), line, notation, e.msg)) from e def highlight_using_coqdoc(sentence): """Lex sentence using coqdoc, and yield inline nodes for each token""" tokens = coqdoc.lex(utils.unescape(sentence, 1)) for classes, value in tokens: yield nodes.inline(value, value, classes=classes) def make_target(objtype, targetid): """Create a target to an object of type objtype and id targetid""" return "coq:{}.{}".format(objtype, targetid) def make_math_node(latex, docname, nowrap): node = nodes.math_block(latex, latex) node['label'] = None # Otherwise equations are numbered node['nowrap'] = nowrap node['docname'] = docname node['number'] = None return node # To support any character in tacn, ... names. # see https://github.com/coq/coq/pull/13564 def make_id(tag): return tag.replace(" ", "-") class CoqObject(ObjectDescription): """A generic Coq object for Sphinx; all Coq objects are subclasses of this. The fields and methods to override are listed at the top of this class' implementation. Each object supports the :name: option, which gives an explicit name to link to. See the comments and docstrings in CoqObject for more information. """ # The semantic domain in which this object lives (eg. “tac”, “cmd”, “chm”…). # It matches exactly one of the roles used for cross-referencing. subdomain = None # type: str # The suffix to use in indices for objects of this type (eg. “(tac)”) index_suffix = None # type: str # The annotation to add to headers of objects of this type # (eg. “Command”, “Theorem”) annotation = None # type: str def __init__(self, *args, **kwargs): super().__init__(*args, **kwargs) self._sig_names = None def _name_from_signature(self, signature): # pylint: disable=no-self-use, unused-argument """Convert a signature into a name to link to. ‘Signature’ is Sphinx parlance for an object's header (think “type signature”); for example, the signature of the simplest form of the ``exact`` tactic is ``exact @id``. Generates a name for the directive. Override this method to return None to avoid generating a name automatically. This is a convenient way to automatically generate names (link targets) without having to write explicit names everywhere. """ m = re.match(r"[a-zA-Z0-9_ ]+", signature) if m: return m.group(0).strip() def _render_signature(self, signature, signode): """Render a signature, placing resulting nodes into signode.""" raise NotImplementedError(self) option_spec = { # Explicit object naming 'name': directives.unchanged, # Silence warnings produced by report_undocumented_coq_objects 'undocumented': directives.flag, # noindex omits this object from its index 'noindex': directives.flag } def subdomain_data(self): if self.subdomain is None: raise ValueError() return self.env.domaindata['coq']['objects'][self.subdomain] def _render_annotation(self, signode): if self.annotation: annot_node = nodes.inline(self.annotation, self.annotation, classes=['sigannot']) signode += addnodes.desc_annotation(self.annotation, '', annot_node) signode += nodes.Text(' ') def handle_signature(self, signature, signode): """Prefix signature with the proper annotation, then render it using ``_render_signature`` (for example, add “Command” in front of commands). :returns: the names given to the resulting node. """ self._render_annotation(signode) self._render_signature(signature, signode) names = self._sig_names.get(signature) if names is None: name = self._name_from_signature(signature) # pylint: disable=assignment-from-none # remove trailing ‘.’ found in commands, but not ‘...’ (ellipsis) if name is not None and name.endswith(".") and not name.endswith("..."): name = name[:-1] names = [name] if name else None return names def _warn_if_duplicate_name(self, objects, name, signode): """Check that two objects in the same domain don't have the same name.""" if name in objects: MSG = 'Duplicate name {} (other is in {}) attached to {}' msg = MSG.format(name, self.env.doc2path(objects[name][0]), signode) self.state_machine.reporter.warning(msg, line=self.lineno) def _record_name(self, name, target_id, signode): """Record a `name` in the current subdomain, mapping it to `target_id`. Warns if another object of the same name already exists; `signode` is used in the warning. """ names_in_subdomain = self.subdomain_data() self._warn_if_duplicate_name(names_in_subdomain, name, signode) names_in_subdomain[name] = (self.env.docname, self.objtype, target_id) def _target_id(self, name): return make_target(self.objtype, make_id(name)) def _add_target(self, signode, name): """Register a link target ‘name’, pointing to signode.""" targetid = self._target_id(name) if targetid not in self.state.document.ids: signode['ids'].append(targetid) signode['names'].append(name) signode['first'] = (not self.names) self._record_name(name, targetid, signode) else: # We don't warn for duplicates in the SSReflect chapter, because # it's the style of this chapter to repeat all the defined # objects at the end. if self.env.docname != 'proof-engine/ssreflect-proof-language': self._warn_if_duplicate_name(self.subdomain_data(), name, signode) return targetid def _add_index_entry(self, name, target): """Add `name` (pointing to `target`) to the main index.""" assert isinstance(name, str) # remove trailing . , found in commands, but not ... (ellipsis) trim = name.endswith(".") and not name.endswith("...") index_text = name[:-1] if trim else name if self.index_suffix: index_text += " " + self.index_suffix self.indexnode['entries'].append(('single', index_text, target, '', None)) def add_target_and_index(self, names, _, signode): """Attach a link target to `signode` and index entries for `names`. This is only called (from ``ObjectDescription.run``) if ``:noindex:`` isn't specified.""" if names: for name in names: if isinstance(name, str) and name.startswith('_'): continue target = self._add_target(signode, name) self._add_index_entry(name, target) self.state.document.note_explicit_target(signode) def _prepare_names(self): """Construct ``self._sig_names``, a map from signatures to names. A node may have either one signature with no name, multiple signatures with one name per signatures, or one signature with multiple names. """ sigs = self.get_signatures() names = self.options.get("name") if names is None: self._sig_names = {} else: names = [n.strip() for n in names.split(";")] if len(names) != len(sigs): if len(sigs) != 1: #Multiple names for one signature ERR = ("Expected {} semicolon-separated names, got {}. " + "Please provide one name per signature line.") raise self.error(ERR.format(len(names), len(sigs))) self._sig_names = { sigs[0]: names } else: self._sig_names = { sig: [name] for (sig, name) in zip(sigs, names) } def run(self): self._prepare_names() return super().run() class DocumentableObject(CoqObject): def _warn_if_undocumented(self): document = self.state.document config = document.settings.env.config report = config.report_undocumented_coq_objects if report and not self.content and "undocumented" not in self.options: # This is annoyingly convoluted, but we don't want to raise warnings # or interrupt the generation of the current node. For more details # see https://github.com/sphinx-doc/sphinx/issues/4976. msg = 'No contents in directive {}'.format(self.name) node = document.reporter.info(msg, line=self.lineno) getLogger(__name__).info(node.astext()) if report == "warning": raise self.warning(msg) def run(self): self._warn_if_undocumented() return super().run() class PlainObject(DocumentableObject): """A base class for objects whose signatures should be rendered literally.""" def _render_signature(self, signature, signode): signode += addnodes.desc_name(signature, signature) class NotationObject(DocumentableObject): """A base class for objects whose signatures should be rendered as nested boxes. Objects that inherit from this class can use the notation grammar (“{+ …}”, “@…”, etc.) in their signature. """ def _render_signature(self, signature, signode): position = self.state_machine.get_source_and_line(self.lineno) tacn_node = notation_to_sphinx(signature, *position) signode += addnodes.desc_name(signature, '', tacn_node) class GallinaObject(PlainObject): r"""A theorem. Example:: .. thm:: Bound on the ceiling function Let :math:`p` be an integer and :math:`c` a rational constant. Then :math:`p \ge c \rightarrow p \ge \lceil{c}\rceil`. """ subdomain = "thm" index_suffix = "(theorem)" annotation = "Theorem" class VernacObject(NotationObject): """A Coq command. Example:: .. cmd:: Infix @string := @one_term {? ( {+, @syntax_modifier } ) } {? : @ident } This command is equivalent to :n:`…`. """ subdomain = "cmd" index_suffix = "(command)" annotation = "Command" def _name_from_signature(self, signature): m = re.match(r"[a-zA-Z0-9_ ]+", signature) return m.group(0).strip() if m else None class VernacVariantObject(VernacObject): """A variant of a Coq command. Example:: .. cmd:: Axiom @ident : @term. This command links :token:`term` to the name :token:`term` as its specification in the global environment. The fact asserted by :token:`term` is thus assumed as a postulate. .. cmdv:: Parameter @ident : @term. This is equivalent to :n:`Axiom @ident : @term`. """ index_suffix = "(command variant)" annotation = "Variant" def _name_from_signature(self, signature): return None class TacticObject(NotationObject): """A tactic, or a tactic notation. Example:: .. tacn:: do @natural @expr :token:`expr` is evaluated to ``v`` which must be a tactic value. … """ subdomain = "tacn" index_suffix = "(tactic)" annotation = "Tactic" class AttributeObject(NotationObject): """An attribute. Example:: .. attr:: local """ subdomain = "attr" index_suffix = "(attribute)" annotation = "Attribute" def _name_from_signature(self, signature): return notation_to_string(signature) class TacticVariantObject(TacticObject): """A variant of a tactic. Example:: .. tacn:: fail This is the always-failing tactic: it does not solve any goal. It is useful for defining other tacticals since it can be caught by :tacn:`try`, :tacn:`repeat`, :tacn:`match goal`, or the branching tacticals. … .. tacv:: fail @natural The number is the failure level. If no level is specified, it defaults to 0. … """ index_suffix = "(tactic variant)" annotation = "Variant" def _name_from_signature(self, signature): return None class OptionObject(NotationObject): """A Coq option (a setting with non-boolean value, e.g. a string or numeric value). Example:: .. opt:: Hyps Limit @natural :name Hyps Limit Controls the maximum number of hypotheses displayed in goals after application of a tactic. """ subdomain = "opt" index_suffix = "(option)" annotation = "Option" class FlagObject(NotationObject): """A Coq flag (i.e. a boolean setting). Example:: .. flag:: Nonrecursive Elimination Schemes Controls whether types declared with the keywords :cmd:`Variant` and :cmd:`Record` get an automatic declaration of induction principles. """ subdomain = "flag" index_suffix = "(flag)" annotation = "Flag" class TableObject(NotationObject): """A Coq table, i.e. a setting that is a set of values. Example:: .. table:: Search Blacklist @string :name: Search Blacklist Controls ... """ subdomain = "table" index_suffix = "(table)" annotation = "Table" class ProductionObject(CoqObject): r"""A grammar production. Use ``.. prodn`` to document grammar productions instead of Sphinx `production lists `_. prodn displays multiple productions together with alignment similar to ``.. productionlist``, however unlike ``.. productionlist``\ s, this directive accepts notation syntax. Example:: .. prodn:: occ_switch ::= { {? {| + | - } } {* @natural } } term += let: @pattern := @term in @term | second_production The first line defines "occ_switch", which must be unique in the document. The second references and expands the definition of "term", whose main definition is elsewhere in the document. The third form is for continuing the definition of a nonterminal when it has multiple productions. It leaves the first column in the output blank. """ subdomain = "prodn" #annotation = "Grammar production" # handle_signature is called for each line of input in the prodn:: # 'signatures' accumulates them in order to combine the lines into a single table: signatures = None # FIXME this should be in init, shouldn't it? def _render_signature(self, signature, signode): raise NotImplementedError(self) SIG_ERROR = ("{}: Invalid syntax in ``.. prodn::`` directive" + "\nExpected ``name ::= ...`` or ``name += ...``" + " (e.g. ``pattern += constr:(@ident)``)\n" + " in `{}`") def handle_signature(self, signature, signode): parts = signature.split(maxsplit=1) if parts[0].strip() == "|" and len(parts) == 2: lhs = "" op = "|" rhs = parts[1].strip() else: parts = signature.split(maxsplit=2) if len(parts) != 3: loc = os.path.basename(get_node_location(signode)) raise ExtensionError(ProductionObject.SIG_ERROR.format(loc, signature)) lhs, op, rhs = (part.strip() for part in parts) if op not in ["::=", "+="]: loc = os.path.basename(get_node_location(signode)) raise ExtensionError(ProductionObject.SIG_ERROR.format(loc, signature)) parts = rhs.split(" ", maxsplit=1) rhs = parts[0].strip() tag = parts[1].strip() if len(parts) == 2 else "" self.signatures.append((lhs, op, rhs, tag)) return [('token', lhs)] if op == '::=' else None def _add_index_entry(self, name, target): pass def _target_id(self, name): return make_id('grammar-token-{}'.format(name[1])) def _record_name(self, name, targetid, signode): env = self.state.document.settings.env objects = env.domaindata['std']['objects'] self._warn_if_duplicate_name(objects, name, signode) objects[name] = env.docname, targetid def run(self): self.signatures = [] indexnode = super().run()[0] # makes calls to handle_signature table = nodes.inline(classes=['prodn-table']) tgroup = nodes.inline(classes=['prodn-column-group']) for _ in range(4): tgroup += nodes.inline(classes=['prodn-column']) table += tgroup tbody = nodes.inline(classes=['prodn-row-group']) table += tbody # create rows for signature in self.signatures: lhs, op, rhs, tag = signature position = self.state_machine.get_source_and_line(self.lineno) row = nodes.inline(classes=['prodn-row']) entry = nodes.inline(classes=['prodn-cell-nonterminal']) if lhs != "": target_name = make_id('grammar-token-' + lhs) target = nodes.target('', '', ids=[target_name], names=[target_name]) # putting prodn-target on the target node won't appear in the tex file inline = nodes.inline(classes=['prodn-target']) inline += target entry += inline entry += notation_to_sphinx('@'+lhs, *position) else: entry += nodes.literal('', '') row += entry entry = nodes.inline(classes=['prodn-cell-op']) entry += nodes.literal(op, op) row += entry entry = nodes.inline(classes=['prodn-cell-production']) entry += notation_to_sphinx(rhs, *position) row += entry entry = nodes.inline(classes=['prodn-cell-tag']) entry += nodes.literal(tag, tag) row += entry tbody += row return [indexnode, table] # only this node goes into the doc class ExceptionObject(NotationObject): """An error raised by a Coq command or tactic. This commonly appears nested in the ``.. tacn::`` that raises the exception. Example:: .. tacv:: assert @form by @tactic This tactic applies :n:`@tactic` to solve the subgoals generated by ``assert``. .. exn:: Proof is not complete Raised if :n:`@tactic` does not fully solve the goal. """ subdomain = "exn" index_suffix = "(error)" annotation = "Error" # Uses “exn” since “err” already is a CSS class added by “writer_aux”. # Generate names automatically def _name_from_signature(self, signature): return notation_to_string(signature) class WarningObject(NotationObject): """An warning raised by a Coq command or tactic.. Do not mistake this for ``.. warning::``; this directive is for warning messages produced by Coq. Example:: .. warn:: Ambiguous path When the coercion :token:`qualid` is added to the inheritance graph, non valid coercion paths are ignored. """ subdomain = "warn" index_suffix = "(warning)" annotation = "Warning" # Generate names automatically def _name_from_signature(self, signature): return notation_to_string(signature) def NotationRole(role, rawtext, text, lineno, inliner, options={}, content=[]): #pylint: disable=unused-argument, dangerous-default-value """Any text using the notation syntax (``@id``, ``{+, …}``, etc.). Use this to explain tactic equivalences. For example, you might write this:: :n:`generalize @term as @ident` is just like :n:`generalize @term`, but it names the introduced hypothesis :token:`ident`. Note that this example also uses ``:token:``. That's because ``ident`` is defined in the Coq manual as a grammar production, and ``:token:`` creates a link to that. When referring to a placeholder that happens to be a grammar production, ``:token:`…``` is typically preferable to ``:n:`@…```. """ notation = utils.unescape(text, 1) position = inliner.reporter.get_source_and_line(lineno) return [nodes.literal(rawtext, '', notation_to_sphinx(notation, *position, rawtext=rawtext))], [] def coq_code_role(role, rawtext, text, lineno, inliner, options={}, content=[]): #pylint: disable=dangerous-default-value """Coq code. Use this for Gallina and Ltac snippets:: :g:`apply plus_comm; reflexivity` :g:`Set Printing All.` :g:`forall (x: t), P(x)` """ options['language'] = 'Coq' return code_role(role, rawtext, text, lineno, inliner, options, content) ## Too heavy: ## Forked from code_role to use our custom tokenizer; this doesn't work for ## snippets though: for example CoqDoc swallows the parentheses around this: ## “(a: A) (b: B)” # set_classes(options) # classes = ['code', 'coq'] # code = utils.unescape(text, 1) # node = nodes.literal(rawtext, '', *highlight_using_coqdoc(code), classes=classes) # return [node], [] CoqCodeRole = coq_code_role class CoqtopDirective(Directive): r"""A reST directive to describe interactions with Coqtop. Usage:: .. coqtop:: options… Coq code to send to coqtop Example:: .. coqtop:: in reset Print nat. Definition a := 1. The blank line after the directive is required. If you begin a proof, use the ``abort`` option to reset coqtop for the next example. Here is a list of permissible options: - Display options (choose exactly one) - ``all``: Display input and output - ``in``: Display only input - ``out``: Display only output - ``none``: Display neither (useful for setup commands) - Behavior options - ``reset``: Send a ``Reset Initial`` command before running this block - ``fail``: Don't die if a command fails, implies ``warn`` (so no need to put both) - ``warn``: Don't die if a command emits a warning - ``restart``: Send a ``Restart`` command before running this block (only works in proof mode) - ``abort``: Send an ``Abort All`` command after running this block (leaves all pending proofs if any) ``coqtop``\ 's state is preserved across consecutive ``.. coqtop::`` blocks of the same document (``coqrst`` creates a single ``coqtop`` process per reST source file). Use the ``reset`` option to reset Coq's state. """ has_content = True required_arguments = 1 optional_arguments = 0 final_argument_whitespace = True option_spec = { 'name': directives.unchanged } directive_name = "coqtop" def run(self): # Uses a ‘container’ instead of a ‘literal_block’ to disable # Pygments-based post-processing (we could also set rawsource to '') content = '\n'.join(self.content) args = self.arguments[0].split() node = nodes.container(content, coqtop_options = set(args), classes=['coqtop', 'literal-block']) self.add_name(node) return [node] class CoqdocDirective(Directive): """A reST directive to display Coqtop-formatted source code. Usage:: .. coqdoc:: Coq code to highlight Example:: .. coqdoc:: Definition test := 1. """ # TODO implement this as a Pygments highlighter? has_content = True required_arguments = 0 optional_arguments = 0 final_argument_whitespace = True option_spec = { 'name': directives.unchanged } directive_name = "coqdoc" def run(self): # Uses a ‘container’ instead of a ‘literal_block’ to disable # Pygments-based post-processing (we could also set rawsource to '') content = '\n'.join(self.content) node = nodes.inline(content, '', *highlight_using_coqdoc(content)) wrapper = nodes.container(content, node, classes=['coqdoc', 'literal-block']) self.add_name(wrapper) return [wrapper] class ExampleDirective(BaseAdmonition): """A reST directive for examples. This behaves like a generic admonition; see http://docutils.sourceforge.net/docs/ref/rst/directives.html#generic-admonition for more details. Optionally, any text immediately following the ``.. example::`` header is used as the example's title. Example:: .. example:: Adding a hint to a database The following adds ``plus_comm`` to the ``plu`` database: .. coqdoc:: Hint Resolve plus_comm : plu. """ node_class = nodes.admonition directive_name = "example" optional_arguments = 1 def run(self): # ‘BaseAdmonition’ checks whether ‘node_class’ is ‘nodes.admonition’, # and uses arguments[0] as the title in that case (in other cases, the # title is unset, and it is instead set in the HTML visitor). assert len(self.arguments) <= 1 self.arguments = [": ".join(['Example'] + self.arguments)] self.options['classes'] = ['admonition', 'note'] return super().run() class PreambleDirective(Directive): r"""A reST directive to include a TeX file. Mostly useful to let MathJax know about `\def`\s and `\newcommand`\s. The contents of the TeX file are wrapped in a math environment, as MathJax doesn't process LaTeX definitions otherwise. Usage:: .. preamble:: preamble.tex """ has_content = False required_arguments = 1 optional_arguments = 0 final_argument_whitespace = True option_spec = {} directive_name = "preamble" def run(self): document = self.state.document env = document.settings.env if not document.settings.file_insertion_enabled: msg = 'File insertion disabled' return [document.reporter.warning(msg, line=self.lineno)] rel_fname, abs_fname = env.relfn2path(self.arguments[0]) env.note_dependency(rel_fname) with open(abs_fname, encoding="utf-8") as ltx: latex = ltx.read() node = make_math_node(latex, env.docname, nowrap=False) node['classes'] = ["math-preamble"] set_source_info(self, node) return [node] class InferenceDirective(Directive): r"""A reST directive to format inference rules. This also serves as a small illustration of the way to create new Sphinx directives. Usage:: .. inference:: name newline-separated premises -------------------------- conclusion Example:: .. inference:: Prod-Pro \WTEG{T}{s} s \in \Sort \WTE{\Gamma::(x:T)}{U}{\Prop} ----------------------------- \WTEG{\forall~x:T,U}{\Prop} """ required_arguments = 1 optional_arguments = 0 has_content = True final_argument_whitespace = True directive_name = "inference" @staticmethod def prepare_latex_operand(op): # TODO: Could use a fancier inference class in LaTeX return '%\n\\hspace{3em}%\n'.join(op.strip().splitlines()) def prepare_latex(self, content): parts = re.split('^ *----+ *$', content, flags=re.MULTILINE) if len(parts) != 2: raise self.error('Expected two parts in ‘inference’ directive, separated by a rule (----).') top, bottom = tuple(InferenceDirective.prepare_latex_operand(p) for p in parts) return "%\n".join(("\\frac{", top, "}{", bottom, "}")) def run(self): self.assert_has_content() title = self.arguments[0] content = '\n'.join(self.content) latex = self.prepare_latex(content) docname = self.state.document.settings.env.docname math_node = make_math_node(latex, docname, nowrap=False) tid = make_id(title) target = nodes.target('', '', ids=['inference-' + tid]) self.state.document.note_explicit_target(target) term, desc = nodes.term('', title), nodes.description('', math_node) dli = nodes.definition_list_item('', term, desc) dl = nodes.definition_list(content, target, dli) set_source_info(self, dl) return [dl] class AnsiColorsParser(): """Parse ANSI-colored output from Coqtop into Sphinx nodes.""" # Coqtop's output crashes ansi.py, because it contains a bunch of extended codes # This class is a fork of the original ansi.py, released under a BSD license in sphinx-contribs COLOR_PATTERN = re.compile('\x1b\\[([^m]+)m') def __init__(self): self.new_nodes, self.pending_nodes = [], [] def _finalize_pending_nodes(self): self.new_nodes.extend(self.pending_nodes) self.pending_nodes = [] def _add_text(self, raw, beg, end): if beg < end: text = raw[beg:end] if self.pending_nodes: self.pending_nodes[-1].append(nodes.Text(text)) else: self.new_nodes.append(nodes.inline('', text)) def colorize_str(self, raw): """Parse raw (an ANSI-colored output string from Coqtop) into Sphinx nodes.""" last_end = 0 for match in AnsiColorsParser.COLOR_PATTERN.finditer(raw): self._add_text(raw, last_end, match.start()) last_end = match.end() classes = ansicolors.parse_ansi(match.group(1)) if 'ansi-reset' in classes: self._finalize_pending_nodes() else: node = nodes.inline() self.pending_nodes.append(node) node['classes'].extend(classes) self._add_text(raw, last_end, len(raw)) self._finalize_pending_nodes() return self.new_nodes class CoqtopBlocksTransform(Transform): """Filter handling the actual work for the coqtop directive Adds coqtop's responses, colorizes input and output, and merges consecutive coqtop directives for better visual rendition. """ default_priority = 10 @staticmethod def is_coqtop_block(node): return isinstance(node, nodes.Element) and 'coqtop_options' in node @staticmethod def is_coqtop_args_field(node): return isinstance(node, nodes.field) and node.children[0].rawsource == 'COQTOP_ARGS' @staticmethod def split_lines(source): r"""Split Coq input into chunks, which may include single- or multi-line comments. Nested comments are not supported. A chunk is a minimal sequence of consecutive lines of the input that ends with a '.' or '*)' >>> split_lines('A.\nB.''') ['A.', 'B.'] >>> split_lines('A.\n\nB.''') ['A.', '\nB.'] >>> split_lines('A.\n\nB.\n''') ['A.', '\nB.'] >>> split_lines("SearchPattern (_ + _ = _ + _).\n" ... "SearchPattern (nat -> bool).\n" ... "SearchPattern (forall l : list _, _ l l).") ... # doctest: +NORMALIZE_WHITESPACE ['SearchPattern (_ + _ = _ + _).', 'SearchPattern (nat -> bool).', 'SearchPattern (forall l : list _, _ l l).'] >>> split_lines('SearchHead le.\nSearchHead (@eq bool).') ['SearchHead le.', 'SearchHead (@eq bool).'] >>> split_lines("(* *) x. (* *)\ny.\n") ['(* *) x. (* *)', 'y.'] >>> split_lines("(* *) x (* \n *)\ny.\n") ['(* *) x (* \n *)', 'y.'] """ return re.split(r"(?:(?<=(?` to display "text" for the definition of "term", such as when "term" must be capitalized or plural for grammatical reasons. The term will also appear in the Glossary Index. Examples:: A :gdef:`prime` number is divisible only by itself and 1. :gdef:`Composite ` numbers are the non-prime numbers. """ #pylint: disable=dangerous-default-value, unused-argument env = inliner.document.settings.env std = env.domaindata['std']['objects'] m = ReferenceRole.explicit_title_re.match(text) if m: (text, term) = m.groups() text = text.strip() else: term = text key = ('term', term) if key in std: MSG = 'Duplicate object: {}; other is at {}' msg = MSG.format(term, env.doc2path(std[key][0])) inliner.document.reporter.warning(msg, line=lineno) targetid = make_id('term-{}'.format(term)) std[key] = (env.docname, targetid) target = nodes.target('', '', ids=[targetid], names=[term]) inliner.document.note_explicit_target(target) node = nodes.inline(rawtext, '', target, nodes.Text(text), classes=['term-defn']) set_role_source_info(inliner, lineno, node) return [node], [] GlossaryDefRole.role_name = "gdef" class CoqDomain(Domain): """A domain to document Coq code. Sphinx has a notion of “domains”, used to tailor it to a specific language. Domains mostly consist in descriptions of the objects that we wish to describe (for Coq, this includes tactics, tactic notations, options, exceptions, etc.), as well as domain-specific roles and directives. Each domain is responsible for tracking its objects, and resolving references to them. In the case of Coq, this leads us to define Coq “subdomains”, which classify objects into categories in which names must be unique. For example, a tactic and a theorem may share a name, but two tactics cannot be named the same. """ name = 'coq' label = 'Coq' object_types = { # ObjType (= directive type) → (Local name, *xref-roles) 'cmd': ObjType('cmd', 'cmd'), 'cmdv': ObjType('cmdv', 'cmd'), 'tacn': ObjType('tacn', 'tacn'), 'tacv': ObjType('tacv', 'tacn'), 'opt': ObjType('opt', 'opt'), 'flag': ObjType('flag', 'flag'), 'table': ObjType('table', 'table'), 'attr': ObjType('attr', 'attr'), 'thm': ObjType('thm', 'thm'), 'prodn': ObjType('prodn', 'prodn'), 'exn': ObjType('exn', 'exn'), 'warn': ObjType('warn', 'exn'), 'index': ObjType('index', 'index', searchprio=-1) } directives = { # Note that some directives live in the same semantic subdomain; ie # there's one directive per object type, but some object types map to # the same role. 'cmd': VernacObject, 'cmdv': VernacVariantObject, 'tacn': TacticObject, 'tacv': TacticVariantObject, 'opt': OptionObject, 'flag': FlagObject, 'table': TableObject, 'attr': AttributeObject, 'thm': GallinaObject, 'prodn' : ProductionObject, 'exn': ExceptionObject, 'warn': WarningObject, } roles = { # Each of these roles lives in a different semantic “subdomain” 'cmd': XRefRole(warn_dangling=True), 'tacn': XRefRole(warn_dangling=True), 'opt': XRefRole(warn_dangling=True), 'flag': XRefRole(warn_dangling=True), 'table': XRefRole(warn_dangling=True), 'attr': XRefRole(warn_dangling=True), 'thm': XRefRole(warn_dangling=True), 'prodn' : XRefRole(warn_dangling=True), 'exn': XRefRole(warn_dangling=True), 'warn': XRefRole(warn_dangling=True), # This one is special 'index': IndexXRefRole(), # These are used for highlighting 'n': NotationRole, 'g': CoqCodeRole } indices = [CoqVernacIndex, CoqTacticIndex, CoqOptionIndex, CoqGallinaIndex, CoqExceptionIndex, CoqAttributeIndex] data_version = 1 initial_data = { # Collect everything under a key that we control, since Sphinx adds # others, such as “version” 'objects' : { # subdomain → name → docname, objtype, targetid 'cmd': {}, 'tacn': {}, 'opt': {}, 'flag': {}, 'table': {}, 'attr': {}, 'thm': {}, 'prodn' : {}, 'exn': {}, 'warn': {}, } } @staticmethod def find_index_by_name(targetid): for index in CoqDomain.indices: if index.name == targetid: return index return None def get_objects(self): # Used for searching and object inventories (intersphinx) for _, objects in self.data['objects'].items(): for name, (docname, objtype, targetid) in objects.items(): yield (name, name, objtype, docname, targetid, self.object_types[objtype].attrs['searchprio']) for index in self.indices: yield (index.name, index.localname, 'index', "coq-" + index.name, '', -1) def merge_domaindata(self, docnames, otherdata): DUP = "Duplicate declaration: '{}' also defined in '{}'.\n" for subdomain, their_objects in otherdata['objects'].items(): our_objects = self.data['objects'][subdomain] for name, (docname, objtype, targetid) in their_objects.items(): if docname in docnames: if name in our_objects: self.env.warn(docname, DUP.format(name, our_objects[name][0])) our_objects[name] = (docname, objtype, targetid) def resolve_xref(self, env, fromdocname, builder, role, targetname, node, contnode): # ‘target’ is the name that was written in the document # ‘role’ is where this xref comes from; it's exactly one of our subdomains if role == 'index': index = CoqDomain.find_index_by_name(targetname) if index: return make_refnode(builder, fromdocname, "coq-" + index.name, '', contnode, index.localname) else: resolved = self.data['objects'][role].get(targetname) if resolved: (todocname, _, targetid) = resolved return make_refnode(builder, fromdocname, todocname, targetid, contnode, targetname) return None def clear_doc(self, docname_to_clear): for subdomain_objects in self.data['objects'].values(): for name, (docname, _, _) in list(subdomain_objects.items()): if docname == docname_to_clear: del subdomain_objects[name] def is_coqtop_or_coqdoc_block(node): return (isinstance(node, nodes.Element) and ('coqtop' in node['classes'] or 'coqdoc' in node['classes'])) def simplify_source_code_blocks_for_latex(app, doctree, fromdocname): # pylint: disable=unused-argument """Simplify coqdoc and coqtop blocks. In HTML mode, this does nothing; in other formats, such as LaTeX, it replaces coqdoc and coqtop blocks by plain text sources, which will use pygments if available. This prevents the LaTeX builder from getting confused. """ is_html = app.builder.tags.has("html") for node in doctree.traverse(is_coqtop_or_coqdoc_block): if is_html: node.rawsource = '' # Prevent pygments from kicking in elif 'coqtop-hidden' in node['classes']: node.parent.remove(node) else: node.replace_self(nodes.literal_block(node.rawsource, node.rawsource, language="Coq")) COQ_ADDITIONAL_DIRECTIVES = [CoqtopDirective, CoqdocDirective, ExampleDirective, InferenceDirective, PreambleDirective] COQ_ADDITIONAL_ROLES = [GrammarProductionRole, GlossaryDefRole] def setup(app): """Register the Coq domain""" # A few sanity checks: subdomains = set(obj.subdomain for obj in CoqDomain.directives.values()) found = set (obj for obj in chain(*(idx.subdomains for idx in CoqDomain.indices))) assert subdomains.issuperset(found), "Missing subdomains: {}".format(found.difference(subdomains)) assert subdomains.issubset(CoqDomain.roles.keys()), \ "Missing from CoqDomain.roles: {}".format(subdomains.difference(CoqDomain.roles.keys())) # Add domain, directives, and roles app.add_domain(CoqDomain) app.add_index_to_domain('std', StdGlossaryIndex) for role in COQ_ADDITIONAL_ROLES: app.add_role(role.role_name, role) for directive in COQ_ADDITIONAL_DIRECTIVES: app.add_directive(directive.directive_name, directive) app.add_transform(CoqtopBlocksTransform) app.connect('doctree-resolved', simplify_source_code_blocks_for_latex) app.connect('doctree-resolved', CoqtopBlocksTransform.merge_consecutive_coqtop_blocks) # Add extra styles app.add_css_file("ansi.css") app.add_css_file("coqdoc.css") app.add_js_file("notations.js") app.add_css_file("notations.css") app.add_css_file("pre-text.css") # Tell Sphinx about extra settings app.add_config_value("report_undocumented_coq_objects", None, 'env') # ``env_version`` is used by Sphinx to know when to invalidate # coqdomain-specific bits in its caches. It should be incremented when the # contents of ``env.domaindata['coq']`` change. See # `https://github.com/sphinx-doc/sphinx/issues/4460`. meta = { "version": "0.1", "env_version": 2, "parallel_read_safe": True } return meta coq-8.20.0/doc/tools/coqrst/notations/000077500000000000000000000000001466560755400176435ustar00rootroot00000000000000coq-8.20.0/doc/tools/coqrst/notations/CoqNotations.ttf000066400000000000000000001121441466560755400230060ustar00rootroot00000000000000 FFTMt˕HGDEF5*GPOS5N@GSUBD:ROS/2r`cmap{1jcvt :[)v \zfpgmvD#gaspglyfZ- :tzhead,6hhea/d$hmtx alocav maxp name5xpostP0NprepXû 8#̡p3_<O~>V~`/Ys2  P [DAMA [1> V W"^U.(~q/#0+)#.1&-v-((E 66??-6*-G.66('  .q1m,>,$!?$1?$??Y6$; C??.& 1Sh2-qll(qq;J2 2$- ^Uq/q1m??r622EOmJJJowwMMM`\]ZfkG~ - dH ~    !"#$%&'()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_`ardeixpkvjsgwl|cnm}byqz@?XUTSRQPONMLKJIHGFEDCBA@?>=<;:98765/.-,(&%$#" ,E#F` &`&#HH-,E#F#a &a&#HH-,E#F` a F`&#HH-,E#F#a ` &a a&#HH-,E#F`@a f`&#HH-,E#F#a@` &a@a&#HH-, <<-, E# D# ZQX# D#Y QX# MD#Y &QX# D#Y!!-, EhD ` EFvhE`D-, C#Ce -, C#C -,(#p(>(#p(E: -, E%EadPQXED!!Y-, EC`D-,CCe -, i@a ,b`+ d#da\XaY-,E+)#D)z-,Ee,#DE+#D-,KRXED!!Y-,%# `#-,%# a#-,%-, ` <<-, a <<-,CC -,!! d#d@b-,!QX d#d b@/+Y`-,!QX d#dUb/+Y`-, d#d@b`#!-,E#E`#E`#E`#vhb -,&&%%E#E &`bch &ae#DD-, ETX@D E@aD!!Y-,E0/E#Ea``iD-,KQX/#p#B!!Y-,KQX %EiSXD!!Y!!Y-,EC`c`iD-,/ED-,E# E`D-,E#E`D-,K#QX34 34YDD-,CX&EXdf`d `f X!@YaY#XeY)#D#)!!!!!Y-,CX%Ed `f X!@Ya#XeY)#D%% XY%% F%#B<%% F%`#B< XY%%)%%)%% XY%%CH%%`CH!Y!!!!!!!-,CX%Ed `f X!@Ya#XeY)#D%% XY%% F%#B<%%%% F%`#B< XY%%)) EeD%%)%% XY%%CH%%%%`CH!Y!!!!!!!-,% F%#B%%EH!!!!-,% %%CH!!!-,E# E P X#e#Y#h @PX!@Y#XeY`D-,KS#KQZX E`D!!Y-,KTX E`D!!Y-,KS#KQZX8!!Y-,KTX8!!Y-,CTXF+!!!!Y-,CTXG+!!!Y-,CTXH+!!!!Y-,CTXI+!!!Y-, #KSKQZX#8!!Y-, IQX@# 84!!Y-,F#F`#Fa#  Fab@@pE`h:-, #Id#SX<!Y-,KRX}zY-,KKTB-,B#Q@SZX TXBYY-,Eh#KQX# E d@PX|Yh`YD-,%%#>#> #eB #B#?#? #eB#B-@vn)uodtrdrC)qodpndoBnBia)gedeC)dBcadaBYQ)XBWUdUC)TBSQdRBQBLD)JHdHC)FDdDBCA/B?B* * U*U*U * U*U*U *U*UTSKRKP[%S@QZUZ[XYBKSXYKSXBY++++++++t+++s++++++++++++++++++++++++++++kk [[||f|P}fPkr{d}fk{}ofk{}fTkvfPP<<::dd_@~rU*W!Gxo{9jZ\.r+z4Y*CrrQY=****b "8>N6  h  J r  N  8pNN |l &< VplRLhFh""\  !>!b""<"#X###$$$%T%&J&`&&''8'p'( (),)**2*+$+:+^+|+++++,F,X,f,x,,,--"-0-B-j---. .Z..//\/00040P001V122223"3v34.445Z566T66727|78@89 9x9:P:;@;<<.<|<=M./<2<2/<2<233'3#rbbM-M6 @qo u ??10#.=3#"&54632Af 3 33 3$:44 44:$(,,(&,,Wm 6@n n@@ H ??/+]_q10#.=##.= H B G 0:><<><00:><<><00jMLO M LM LpM M@ M@M MгM L| L M M@  MML @e My  y!yy  r r??]22/223??22229]9]]]]]]]9]910++++]+++]+++++++]++++]++733733#3##7##7#537#537#fPf>RgzfPf753.#"#?M& V08,!08,!6'r.GO*0% &'B0%=.r' b %5'4,! a\g " !+:'5-!k='3' M" M M@ M MMM@BM""""|(|(((|` p  55...|44+@,H+}} p}%}1111??99//]]]]?]?+]]]99//]]]]10+++++]+++#34632#"&74&#"3264632#"&74&#"326[YY<45<<54<p<36<<63<  <k#LOOLLOOL*$$**""zLOOLLPPL*##**"";)5A¹?@ M%@ M"@ M M @ M9@ M. M. M-@ L9-  &C""y#C?<_<3267'.'326>54&#"m "H#-C-11.96*:>,f& <#*.f ">.>"0X H((<("6"0\ 24F8`&"F"|$B * "2x.<"d= =nR  @ H   H H ?++]q+_q10#.== H B:>>>>:B^B @ p ??107.5467m`9~9`q{8LKKL8UB @ p  ??210%4&'7'>&q`9~9`m|8LK犉KL8.6@Y@<@M<:.'4"'@M AB/-;4 ' ?9/2+9=/2+107'7>7*./7.=3>?"#'. ^ #$" %   t   $ "$# ^ "" B  n  $" "$  p D ""(  M@ M@M@M@ M M M@4 M@M@M R`@ P  U ?]]9/]]32]10++++++++++3533##5#(jj,d~Z[@z {??107>7.54632~%!&*3'*/1N8 4 '280#F<,q7?10!!q6xTS_M@He L H M HjM@Hez {?10]++]++++]++%#".54>32T6#  #6,. !! ./J-@v??/+}10#3~`#= #U@4d d%d$!!!@e e ??9/]]]/9/]]]]10%#"&546324&#"326'#"&54632niinpgino532662350joojkoou''((00/@@ M a  ee ??9310+7'>733!5H(882T{*Z f "&ff+7%&@c ' c&g! e ??210!!&654>54&#"'>32(2 " l%9A9%.#@=(i4&F6  <84 $$f 2TF>84&*"V*(,B)=0- M, M+ M M M @* M L)c&, c,,21g!))e! g ?2?9/9=/2]310+++++++".'732654&+532>54&#"'>323/( I3?3N<&.&)$#E,Y84M2*#05:ZI g 6(1'f"'Z%/@%%DN6+H500@ ae  ??9/932222231033##5!5>7&%" {CC{7!##".'732>A3^L <|z>\=2.% D3$/ +TKf Fh^+I6 f  .8->@&c`p/+cc @ H .e&g% g ??9+]107"32>54&'2#"&54>3>( # *$6K00J3hm5bT(L@/ $  5*$/3f 6H($J>'Z^0i!4' 10)a c@ H ee ??+10>7!5!$3<@9+<@|.f^pP&>+76@ M4 M2@ M0@ M/ M/ M. L, M , M@ M @ M M5 M/ L#M# M#"@ M"2#d M@& H95d9//d&dP82##),g)g ??9/9]/]++910]+]++++++++]++++++++#".5467.54>324.'326">54&*-9/3R2 *@&0R D&B4"X8(*,$$",8"$-9*@@%))c c@  ,&c 0@+e&g% g??9]]//10267>54.#"".54>32#'267*  # ,$6L01J2hn4aTP~' 4*&02f 6F*$J>&|Z^0jDH T#".54>32#".54>32T6#  #66#  #6,.    .,. "" .vT2##".54>32>7.54632T6#  #6%!&*3'*/1N8,. "" . 4 &280"F<,-!*@??9=/999910% %-""2lmml(e!@ UU?2210!!!!(\\f\f(!.@??9=/9999910%'-7##âlmmlE=01@22q'''1,u" g??]107&5467>54&#"'>32#".54>32*"(* <#"#^.9J*#(##3  (H*^.80*$$&&,  zz5EZ>M8@M!@M!8 M @ M M@M: M:@ M @ M @M@M@M MM@ M@ LLMML@rL@ M@ M@ M@ M M MP==@>>y 505`55GO6_66y+!G|+F@Py=@APAAy &> = = &}0 }&/]?99//999]]]]9/]]]22]10++++++++++++++++++]++++++++++%#".54>3254&#"3267#".54>323275.#"G&A0$9*0.!;+3U?/6 BrS0)FZ2)H6  8 1O9*J7 &5FuYFlI& W$Yol['6W>( " 0 D @' L L   H ????9/9910++'##6733.g,Z*,W)  y <,β$>>> >>>67#0T@'F Fp20D @ H   1#H$$,J J ??9/9=/^]+2]]10%#"&'>32%32>54&#'2654.#"&AY3)X+#T)FX2+$?- (90/0  8K- Y /:,DN)#-'f)$=:`  @H!F J JJJ ??+2]210"&54>32.#"3267(*Kg=!5( A*7+IS0?YIMxS+ b1R=jq a67!6@ F#D@ H" HH ??^]+}/]107232>54.#"#"&'>32 *9# 4)(+Li?!?$*J =eF') 8M.(L:#VyL#\ $Mw?0 Q@ 0  D 0 H@MM@ M H H??9/+++]2]10!#3#!?w<lfff?0 J@/@ M@ D@ M0 H H???9/]+2^]]+10!!3#?{<lff=#4@ %F$ D0  !JJ ????9//]10"326753#".54>32.8,<'FD  {]B:]B$*Hb8$9* @ 9O0oi)QyPOyR) b-0 ;@  D  D@ H  H@???9/]?+2210###335{{{0l60 .  D@ H H H?2?2+1053#5!#3673^ )27{{0+$ '29@9.<$PNBlDDBDLN$NX^,G0, HD@ HH??++10!3!{| <l0o M@ M0 M@[ M@ L?@ M? M M L @ M M @ M @ L @ L?  @M L M M@M@ M M L@ L@ M@ M M M? M@1 M@ M@ M/?@ M DD@Mo  ??9/9??9/9|]]+/9=/9999/10+]++]++]+++]++++++++++]++++++++]+]]+++]++>73###>7 f qLZIq 0BLN $PH@RPLB.0S@ @ M @ M?/ ?  DD@ H  ????99+2]210]+]+.'#33c*c9oc85-o54.#"4632#"&& '& &}vimrtjms-O:"";N--O:"";N-63?@ F`D @ H  HJ??99//?+2]102+#>"32654&vx,{-., ' 2;<;3anocck/96-j&/@F (F' J J  "J??32/9104632.'.732>54.#"vimrZU UJuw QW}& '& &G! XKF-N;"";N--O:"";N63$Y@D` p  &F`p&!DD@ H%H!!  J?????9/2+]]22102#.'##>4&#"3265V>!,3&$! =#@{+,(|<1 ?832M46X?EE54.'.54632.#"#"&'7) "*<1 qc9U$=(b'?5"qsM\$K  (;,Wb_G -C3W_!d0@DH???210###5ۣ|0ff'6/@ D`pD@ H J ??3+]10".5332>53X6}'5 !5'u6X>! 0@ MMH@ M$ M+M@0LG @ M   /  ???3??9]]910+]++]+]+]++.'3>7360& !  #-67( r f,0f r T8DN*4x|~@FL<~|x4 LJ> 0f MM M @'M    ??9??//99=//9910++++.'#>7373d7: '/4bg|4-" <4|><~4LX\,$*^ZL 0>@!D     ???9??9/]29=/210>73#5.'3  &*0|7S&8FNP 4`^\2`fH.0f@ M M@ H H @ H @ HHH???/+]++99+]10++!!5>7#5!+H>7 h2>I,Btj`0fH*`l~JfqJ/@_@_@ nrr??]]]]10!#3!q```1J*@v???/+}103#1~mJ/@n@@ Prr??]]]210!53#5!ꠠ``D)@r?29=/9910%''3o~~piz6660@ U??10!!0lsS}?10'՞-SoCT,.S@ $QS0, S@$ H/_oWP"`"""@W(@ M(W ?+?]9/]]+10]72675.#"2#".54>3254&#"'>& "$0:M.jB-I4 6F&0%,6#ATfl  2F,$<**8""0 d >[ [@ @ M @ M@ M@ MS` p  !QQ@ H UW W????+]10++++%4&#"3267#"&'7>32Y+,' 08}:T60d"{0.F/BF @L8\@"  "BZ,5@0@`p!S@ H W W ??+]10]74>32.#"3267#"., BeF*D#1&,;$IX?J2HgB2ZD& b $4BJ f &BZ[ `@@@@ M@ M@ MQSU W W????210+++]q]q]q73267.#"#"&5463257/4$,("b/nq_]0{>P F pt %\@7LS ?  '% Sp& @MO _  U@W0  W ?]?]9/]]+]2]10+74>32!3267#".%4.#"&>P*hlL<%C H-<_C$; "# >^> zv .6h >Zl"$$UV MP@) MP  Q`pOU W U ????]]22]10]+]+#5354>32.#"3#gg!8H&'R!E`pf:J.d&f!> 'G@'LQQ`  )S`"p""(W W% @W?]?9/]]10+32675.#"#"&'732>=#"&54632*-# lo{,Q%@0 * +\_nMZX:= sn h # tgtr?UB@Q@ ` p  QQ@ H W ??????}/+]107>32#54&#"?{*4F*{*! a 9O0B:$V L@. MQp?!! !`!T `pWUX ??/]]]]]10+#"&54632#".=#533267. -- .&C0A'$0$**$&**6L0f*(1OM@ MQ @! H!T @PpUX W??/]+]10+%#"&'73265#5!'#"&546321C'0R&&G"9. -- .9M/h%2Wf$**$%**?UQ@ @`0 Q@ H0p  ??9??/]3+22]]2107>73#.'#7%# .11:8/ ',-||/2/684CHH?=7$X6@!`p? Q P ` p   U W???]]]10#"&5#533267"1UN&%2D f`f0" '@^+@M@M/?_R@M/?OR_) 0@R(W" % W ?3??9/?]]]]+9/]++10_]]2#4.#"#54&#"#>32>W'2 d  dd'L).0J0 ".^l0&  ? - QQ@ H 0W ?]??+10>32#54&#"#?!a98J+{.{ 9O0B:&@S@ M!S W W??+10%#".54>3232654&#" :Q22Q; !;R01Q; -201-2018\B$$B\86\@$$@\8>NN>@LL?= 6@S` p  QQ@ HW  W???+]104&#"#3267#"'#>32X23 (,*}.F./2{"c0mtD>R FF6\@$l = !5@QQ`p#Sp  "UW W ???]]103267"&#"4>32#5#".+,% 33}9U630+{3.F/DBF R:6Z@$  "@\Y !Q @ H W ??+10.#"#>32 !" 2|1gE %*+d61L/@ MS &&@ H&3S .@ H.2!W+W ??99++]10+72654.'.54>32.#"#"&'7-0#8.1L5.OH-/!!:/3R<=V#Ol   0&4* h "2&4& h$0f@@ M 0@M@ Mo ` QP`pW U ?32?]22]^]]++]+10#53573#32>7#".5kk{ "O%+B.@fvf  j (J:; 2@ Q Q @ H   W???]+]10%#".533273"a9:J+{-|$ :P0@@pPM M M L@ L   ???910+++++7.'3>73-]*   }*f-Y&VWR""RWV&Y (@(ж M`('M'г M!@ M@MM M@ M@M M@ M M M M M @ M@MMMM L LM@> M(`$$  ) %`%%*@ M0)(%   ??9/9??]+]9///q33333]310+++++++++++++++++++++++]+%.'#.'3>73>73B   ] i  Y  i '415 324 ,kyDWX&A;77;A&.TSS-[)@     ????//91073#.'#>7'3`}.*" 60}'+/RAB<3P (L/=?>9"/@"Q$ #Q   ???/9]10#"&'73267.'3>7#&+%-7%3$, ,X$  9Byt7(:% g 0!X%TTQ##QST&CW H H@ H@Pp U U????/]/+99++]103!5>7#5!4==664]?NU$fK&PMFf?J$7@"n n%r rr ??9/9=/2107;#"&=4&+5326=46;#"6/ ]hZE66EZh] / D@q*&`NJ*+`+)JN`%+q@DJ9(@_ @??]]]2103#||?J(C@%(@ M@ Mn&n* )r !r r ??9/9=/210++%.=4&+532;#"+5326=46960 \g-=%77%=-g\ 0 D@q*&`&9%*+`+)%9&`%+q@DW@  ?]10%".#"'>3232>7Y/,) [!2#/,( ["18.60M5 #@q ou  ??_]1074>73#4632#"&f 3 33 3c$944 449$$'++''++.`![@2 M #QQS 0P"W" W??29/2]]]]10+746753.#"3267#5..Y`|-/$S@ES<2|0F-T|| h @<<@j ~ *7#5354>32.#"ꔔ MM4K/#?!$$f&&$fH|2f4BZ6b * )۵%@MMȳ M LM@ L@ M M @ L M@ L M@ M@ M M@ M L @/ L@ M@ M P$*+ '*!??9/]]10++++++++++++++++++++27'#"&''7&547'764&#"326,&BS@@TB''BS@@TB$v++++?Q>$,,$>R@  ?Q>"..">R@&((&&(( 0! @E MD# !!  "#D" ss ????9/93222?9=////////99333310+%##5#535#53.'36733#3|e)&! 3$G% #'^,hhT>T"LJH@H|FLL"T>J9$@ n???221073#3#||||`1h4D'@ M @ M=@L5@>LF.F5=/@?@@d((F#F8d0044E&5= =5& g1 g??9////]]]]9910++++732654&'.5467.54632.#"#"&'>54.R$$(!#%-#=. &d^(V#!=()* d[E` 5- 5  &2#$@$,EMb  0q&8-#KG)(S>  @ 0 ??]107"&546323"&54632))**))))$ $$ $$ $$ $1ED MC M?@G L: MO94 M7?(_(((G@AF O 0  <2-<# ??99//]]]]99//9910+]++++%#".54>32.#"3267%4>32#".2>54.#"G%++#  !  &?Q,+R?&&?R+,Q?&8-,98--8#-.$6( %:=\==\==[==[w.D,+C..C+,D.hG +l@ )@M @MM M@* M!`-) 0`p, }(%} ?/]9]]]210+++++%2635.#"2#"&54>3254&#"'> ( +:#N4FQ)6 %2 CF$2  2>*  N 2* [@ _y R_y@ H     ??99=//99=//+]]10'%'A^^?OB]]@(*(*-Y@ yr?10%#5!5!iZfq7!!q6x1ED MDC?@! L:@ M: M4 MK4`M@MM@tM@M@M@ M @M_  @H  ? O  7(?(_(((G@HAF<2-/?<# ?q?99//3+q2/23]]]]+q+2//2/10+++++++]++++]+7#5>32#./32654&#"4>32#".2>54.#"6"97(  9  $  &?Q,+R?&&?R+,Q?&8-,98--8M,*0/%2 J=\==\==[==[w.D,+C..C+,D.l&s?10!!l &Xlo@||  }}?102#"&5462654&#"5&&5BNP@ $4 4$HB@J(} M@ Mp    Rpp@& MpUp  @ L@ / ?  U?]]+]22]+?]]2]2]10++7!!3533##5#(\jjIffqD7@ | }t?9/]992103!5467>54&#"'>32y. /-,.H(F;B(4 R,F& D">qA*@ "@ M!@ M MM@ M@ M(M(M(M( M( M(@O L@L@M L@ L M@M ?,'+($}}, }t?9=////2/]10+]+++++++++++++++++72654+532654#"'>32#"&'7 ?%%'("C $1 $:*E*$IF%! -* O sS}?10%'7s-TCo;87@ Q  Q@ H W ????+22]1032673#"&'#  | ^30{8$, r:  &T|n>@) 0  R 0R r???9/]]107.54>32#.#LM#A\90e&e 0f\V0J4 NTS%#".54>32T6#  #6,. !! .gX@   ??10#"'73254/>73,!!,-# ")$P . ' ? $ H;@!@M @L  yys   ?9/9992210++7535'>733d%&FMRHQ  N&QJFd M M M M MM@M_@  tt?]]10+++++++%#".54>324&#"326.@''@..@''@.f%#"'&##%*B..B**D..D*+11+)002* 8@         ??9///99910%'7'7'7'7;A^^?B]]@*()()3  ӹMM M M ML MM@L M@ L  "@"! !!  !    ?2?2?????99//9]]22ԇ+}10++++++++++%3##5#5>7>73#53#$$P|- "2?Uf 3Ed=?''-+L/3 )k3(,o@A @M M*),+*+,)*)*). |.+-##$-%(-",+ )#" ??????9]Ї+}10++!#&4546?>54#"'>32>73#5%#)  ): '= $"2?Ud=? #&   5(*"  yk 7(5:>@U+ M(@M@M<>=>;<;<;@ |  @=?(? %  ?>= < ;6:,0/ 5). ??2?2????9=///9///932Ї+}10+++32654+532654&#"'>32#"&'3##5#5>73# '; ( 840 *"-3$$P|-  3Wd=z  :  6 ( , @&&.*L0@(j2q2@!0@ 0`p??]]10!'!22}2v$V #"&54632#".=#533267. -- .&C0A'$0$**$&**6L0f*(-T*e@ a,$@,,@ H  0Q@ H+*#   ???99//9??+]22/2/3+]10.'#3>73.7>7 $&rr  *3$:-"  E`$PNBlDDBDJP("RXX& "4,(2X0   U@ @L@L@M 0@@CM@ H!/?Oo`p/O_  ????99?]]]q+]+]q10+++.'#33'>54&'{WK  X  E`4^^b6xj&Z^`,j&.($(F& 1g?10#51OgP9 ?103#"&'52>5_=8# 80.< MQ ?10%#&67mB>,JR<*(/P?10#5/MP^B 7.5467m`9~9`q{8LKKL8UB %4&'7'>&q`9~9`m|8LK犉KL8q7!!q6x/J#3~`zz5E%#".54>3254&#"3267#".54>323275.#"G&A0$9*0.!;+3U?/6 BrS0)FZ2)H6  8 1O9*J7 &5FuYFlI& W$Yol['6W>( "qJ!#3!q```1J3#1~mJ!53#5!ꠠ``?J$7;#"&=4&+5326=46;#"6/ ]hZE66EZh] / D@q*&`NJ*+`+)JN`%+q@D?J(%.=4&+532;#"+5326=46960 \g-=%77%=-g\ 0 D@q*&`&9%*+`+)%9&`%+q@D#|%'7![ee0.rk%#".54>32#3 2##2 3#3((34((46(!!6w(\(!! (\#7'7ee[.0O5 74>73#4632#"&f 3 33 3c$944 449$$'++''++2* '%'A^^?OB]]@(*(*2* %'7'7'7'7;A^^?B]]@*()()E8 23267#".54>5'4632#".Q*"  * <#"#^.9J*#(##3 K (I  ^/7/'#"$',  OT@ ??10/'>l6zgl6zT,pD,p^V#+@$$ !?]10'7#".54>324&#"326R#    8  T8.L" "   mc >@%o0 JJPJJ ??]]]]]107#"&54632#"&54632%3#"!!"""""~Fnb @ J  J ?10%#"&54632'3#3""""~GJx|-@J  JJ J???]10'4632#"&'4632#"&k9x"!!""!!"|*Jx|7@!JJ JJ ???]]10'7#"&54632#"&54632tx8jr!!!!""""B*Js JM@"!H JJJJ ???]+10+7#"&54632#"&54632%77!!!!"""",UW-j4@@4rob> M@ M /?  ?]10++%#".#"'>323267'3#  1    (   \HiF?10%'7i>>Zw}F?10%''7}&\^&9669_w}F@ ??107'77&^\&`8668MW C@*JOOJ@  J J?]?]?]q]]10%4632#"&'4632#"&7'5"!!"""""V-^P5EMW K@2 J//?OOJ@JJ  ?]?]?]]]q107#"&54632#"&54632''7"!!"""""_]-U(E5PMW j@JJ  O _   O_J@P`JJ  ?]?]?]?]q]]]]107#"&54632#"&54632%77"!!"""""%1/'V:.##.N[,<@@&-F #@#`#p##>F7Fp=2W :J(W ??9/]]1074>7.54>3:63#"#".%4.'326 5+$)?,($! #R&  -!;F9Q12Q; :$#5**38:88*4$Z "&hH6Z> 32+3"32654&{CCCC*+)lwxn"Ȗ '300XXcHbVabWGc-+)"`F@  ??107".'732676*\""\*6!0##0 Ii?10'7IGW1Ke &6%'##6733.>7.546323#"&5473g,Z*,W)  y  $'B3N #8=_.в"@<>""><@ " ""(P", <.0e &6%'##6733..546323#"&5473g,Z*,W)  y 3B'$  #8=_.в"@<>""><@0"P("" " <.0e *:%'##6733.%'>7.546323#"&5473g,Z*,W)  y l; " ?0" #8=_.в"@<>""><@," ""(P", <.0e *:%'##6733.%'.546323#"&5473g,Z*,W)  y l;.0> " ! #8=_.в"@<>""><@, R("" " <.0e *:%'##6733.''7>7.546323#"&5473g,Z*,W)  y ~;l! "!@/ #8=_.в"@<>""><@v," ""(P", <.0e *:%'##6733.''7.546323#"&5473g,Z*,W)  y ;l0?!" !| #8=_.в"@<>""><@v, R("" " <.0\= ,>N'##6733.'.#"#>32>7.546323#"&5473g,Z*,W)  y    E'11'   ""] #8=_-ϲ#?=>!!>=?s%5##5%    !- ;.0]= ,>N'##6733.'.#"#>32.546323#"&5473g,Z*,W)  y    E'11'h#"   #8=_-ϲ#?=>!!>=?s%5##5%!     ;.0Ze +###335>7.546323#"&5473{{{ $'B3 #8=_zj" ""(P", <.0fe +###335.546323#"&5473{{{3B'$ & #8=_zj"P("" " <.0e /###335%'>7.546323#"&5473{{{Ll; " ?0r #8=_zj," ""(P", <.0e /###335%'.546323#"&5473{{{Kl;.0> " ! #8=_zj, R("" " <.0e /###335'7>7.546323#"&5473{{{~;l! "!@/R #8=_zj$," ""(P", <.0e /###335'7.546323#"&5473{{{;l0?!" ! #8=_zj$, R("" " <.0= !3C###335.#"#>32>7.546323#"&5473{{{}   E'11'   "" #8=_Rk(%5##5%    !- ;.0= !3C###335.#"#>32.546323#"&5473{{{}   E'11'h#"   c #8=_Rk(%5##5%!     ;.0keG>7.546323#"&54734>323#5>54.#"#53. $'B3 #8=_)BU-,UC)$*Q"5 + + 1&T*%" ""(P", <.0JjDDjJB~323#5>54.#"#53.D3B'$ E #8=_)BU-,UC)$*Q"5 + + 1&T*%"P("" " <.0JjDDjJB~7.546323#"&54734>323#5>54.#"#53.zl; " ?0 #8=_)BU-,UC)$*Q"5 + + 1&T*%," ""(P", <.0JjDDjJB~323#5>54.#"#53.zl;.0> " ! #8=_)BU-,UC)$*Q"5 + + 1&T*%, R("" " <.0JjDDjJB~7.546323#"&54734>323#5>54.#"#53."~;l! "!@/7 #8=_)BU-,UC)$*Q"5 + + 1&T*%V," ""(P", <.0JjDDjJB~323#5>54.#"#53.!;l0?!" ! #8=_)BU-,UC)$*Q"5 + + 1&T*%V, R("" " <.0JjDDjJB~32>7.546323#"&54734>323#5>54.#"#53..   E'11'   "" #8=_)BU-,UC)$*Q"5 + + 1&T*%*%5##5%    !- ;.0KjCCjKB~32.546323#"&54734>323#5>54.#"#53./   E'11'h#"   [ #8=_)BU-,UC)$*Q"5 + + 1&T*%*%5##5%!     ;.0KjCCjKB~""><@ <.0-o ###3353#"&5473{{{" #8=_jb <.0 h73#"&54734>323#5>54.#"#53.* #8=_)BU-,UC)$*Q"5 + + 1&T*%" :.0LjB BjLB~?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_`a      !"#$%&'()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNuni00A0uni00AD SF030000.001i.loclkgreenlandic.casenapostrophe.case caron.alt commaaccentrevcommaaccentcaron.alt.short Parenleft ParenrightHyphenSlashAt Bracketleft Backslash Bracketright Braceleft Braceright GuilsinglleftBulletEndashEmdashGuilsinglright Exclamdown GuillemotleftGuillemotright Questiondown double_grave ring_acutedieresis_macron dot_macrondieresis_gravedieresis_acutedieresis_breve tilde_macron acute.asccircumflex.asc caron.ascdieresis_grave.capdieresis_acute.capdieresis_breve.capafii10066.locltengeroublekratka tonos.cap uni1F88.alt uni1F89.alt uni1F8A.alt uni1F8B.alt uni1F8C.alt uni1F8D.alt uni1F8E.alt uni1F8F.alt uni1F98.alt uni1F99.alt uni1F9A.alt uni1F9B.alt uni1F9C.alt uni1F9D.alt uni1F9E.alt uni1F9F.alt uni1FA8.alt uni1FA9.alt uni1FAA.alt uni1FAB.alt uni1FAC.alt uni1FAD.alt uni1FAE.alt uni1FAF.alt uni1FBC.alt uni1FCC.alt uni1FFC.alt SF540000.001 SF530000.001 "}~ *cyrlgrek8latnJBGR MKD SRB "AZE 2CRT BMOL RROM RTRK ^afrc2case:loclBloclHloclNnumrTordnZss02` $,4<DLTHLPTblz6L6L6L {tu l|DR {tutu{  #>?@^`cm}D] <>cyrlgreklatn(!zOcoq-8.20.0/doc/tools/coqrst/notations/Makefile000066400000000000000000000022021466560755400212770ustar00rootroot00000000000000########################################################################## ## # The Coq Proof Assistant / The Coq Development Team ## ## v # Copyright INRIA, CNRS and contributors ## ## ../tests/antlr-notations.html coq-8.20.0/doc/tools/coqrst/notations/TacticNotations.g000066400000000000000000000037301466560755400231240ustar00rootroot00000000000000/************************************************************************/ /* * The Coq Proof Assistant / The Coq Development Team */ /* v * Copyright INRIA, CNRS and contributors */ /* ' | '%||' | '%|||' | '%||||'; // for SSR PIPE: '|'; ATOM: '@' | '_' | ~[@_{}| ]+; ID: '@' ('_'? [a-zA-Z0-9])+; SUB: '_' '_' [a-zA-Z0-9]+; WHITESPACE: ' '+; coq-8.20.0/doc/tools/coqrst/notations/TacticNotations.tokens000066400000000000000000000001541466560755400241760ustar00rootroot00000000000000LALT=1 LGROUP=2 LBRACE=3 RBRACE=4 ESCAPED=5 PIPE=6 ATOM=7 ID=8 SUB=9 WHITESPACE=10 '{|'=1 '{'=3 '}'=4 '|'=6 coq-8.20.0/doc/tools/coqrst/notations/TacticNotationsLexer.py000066400000000000000000000075711466560755400243350ustar00rootroot00000000000000# Generated from TacticNotations.g by ANTLR 4.7.2 from antlr4 import * from io import StringIO from typing.io import TextIO import sys def serializedATN(): with StringIO() as buf: buf.write("\3\u608b\ua72a\u8133\ub9ed\u417c\u3be7\u7786\u5964\2\f") buf.write("f\b\1\4\2\t\2\4\3\t\3\4\4\t\4\4\5\t\5\4\6\t\6\4\7\t\7") buf.write("\4\b\t\b\4\t\t\t\4\n\t\n\4\13\t\13\3\2\3\2\3\2\3\3\3\3") buf.write("\3\3\3\3\3\3\3\3\5\3!\n\3\3\4\3\4\3\5\3\5\3\6\3\6\3\6") buf.write("\3\6\3\6\3\6\3\6\3\6\3\6\3\6\3\6\3\6\3\6\3\6\3\6\3\6\3") buf.write("\6\3\6\3\6\3\6\3\6\3\6\3\6\3\6\3\6\3\6\3\6\3\6\3\6\3\6") buf.write("\3\6\5\6F\n\6\3\7\3\7\3\b\3\b\6\bL\n\b\r\b\16\bM\5\bP") buf.write("\n\b\3\t\3\t\5\tT\n\t\3\t\6\tW\n\t\r\t\16\tX\3\n\3\n\3") buf.write("\n\6\n^\n\n\r\n\16\n_\3\13\6\13c\n\13\r\13\16\13d\2\2") buf.write("\f\3\3\5\4\7\5\t\6\13\7\r\b\17\t\21\n\23\13\25\f\3\2\5") buf.write("\4\2BBaa\6\2\"\"BBaa}\177\5\2\62;C\\c|\2v\2\3\3\2\2\2") buf.write("\2\5\3\2\2\2\2\7\3\2\2\2\2\t\3\2\2\2\2\13\3\2\2\2\2\r") buf.write("\3\2\2\2\2\17\3\2\2\2\2\21\3\2\2\2\2\23\3\2\2\2\2\25\3") buf.write("\2\2\2\3\27\3\2\2\2\5 \3\2\2\2\7\"\3\2\2\2\t$\3\2\2\2") buf.write("\13E\3\2\2\2\rG\3\2\2\2\17O\3\2\2\2\21Q\3\2\2\2\23Z\3") buf.write("\2\2\2\25b\3\2\2\2\27\30\7}\2\2\30\31\7~\2\2\31\4\3\2") buf.write("\2\2\32\33\7}\2\2\33!\7-\2\2\34\35\7}\2\2\35!\7,\2\2\36") buf.write("\37\7}\2\2\37!\7A\2\2 \32\3\2\2\2 \34\3\2\2\2 \36\3\2") buf.write("\2\2!\6\3\2\2\2\"#\7}\2\2#\b\3\2\2\2$%\7\177\2\2%\n\3") buf.write("\2\2\2&\'\7\'\2\2\'F\7}\2\2()\7\'\2\2)F\7\177\2\2*+\7") buf.write("\'\2\2+F\7~\2\2,-\7b\2\2-.\7\'\2\2.F\7}\2\2/\60\7B\2\2") buf.write("\60\61\7\'\2\2\61F\7}\2\2\62\63\7\'\2\2\63\64\7~\2\2\64") buf.write("F\7/\2\2\65\66\7\'\2\2\66\67\7~\2\2\678\7/\2\28F\7@\2") buf.write("\29:\7\'\2\2:;\7~\2\2;F\7~\2\2<=\7\'\2\2=>\7~\2\2>?\7") buf.write("~\2\2?F\7~\2\2@A\7\'\2\2AB\7~\2\2BC\7~\2\2CD\7~\2\2DF") buf.write("\7~\2\2E&\3\2\2\2E(\3\2\2\2E*\3\2\2\2E,\3\2\2\2E/\3\2") buf.write("\2\2E\62\3\2\2\2E\65\3\2\2\2E9\3\2\2\2E<\3\2\2\2E@\3\2") buf.write("\2\2F\f\3\2\2\2GH\7~\2\2H\16\3\2\2\2IP\t\2\2\2JL\n\3\2") buf.write("\2KJ\3\2\2\2LM\3\2\2\2MK\3\2\2\2MN\3\2\2\2NP\3\2\2\2O") buf.write("I\3\2\2\2OK\3\2\2\2P\20\3\2\2\2QV\7B\2\2RT\7a\2\2SR\3") buf.write("\2\2\2ST\3\2\2\2TU\3\2\2\2UW\t\4\2\2VS\3\2\2\2WX\3\2\2") buf.write("\2XV\3\2\2\2XY\3\2\2\2Y\22\3\2\2\2Z[\7a\2\2[]\7a\2\2\\") buf.write("^\t\4\2\2]\\\3\2\2\2^_\3\2\2\2_]\3\2\2\2_`\3\2\2\2`\24") buf.write("\3\2\2\2ac\7\"\2\2ba\3\2\2\2cd\3\2\2\2db\3\2\2\2de\3\2") buf.write("\2\2e\26\3\2\2\2\13\2 EMOSX_d\2") return buf.getvalue() class TacticNotationsLexer(Lexer): atn = ATNDeserializer().deserialize(serializedATN()) decisionsToDFA = [ DFA(ds, i) for i, ds in enumerate(atn.decisionToState) ] LALT = 1 LGROUP = 2 LBRACE = 3 RBRACE = 4 ESCAPED = 5 PIPE = 6 ATOM = 7 ID = 8 SUB = 9 WHITESPACE = 10 channelNames = [ u"DEFAULT_TOKEN_CHANNEL", u"HIDDEN" ] modeNames = [ "DEFAULT_MODE" ] literalNames = [ "", "'{|'", "'{'", "'}'", "'|'" ] symbolicNames = [ "", "LALT", "LGROUP", "LBRACE", "RBRACE", "ESCAPED", "PIPE", "ATOM", "ID", "SUB", "WHITESPACE" ] ruleNames = [ "LALT", "LGROUP", "LBRACE", "RBRACE", "ESCAPED", "PIPE", "ATOM", "ID", "SUB", "WHITESPACE" ] grammarFileName = "TacticNotations.g" def __init__(self, input=None, output:TextIO = sys.stdout): super().__init__(input, output) self.checkVersion("4.7.2") self._interp = LexerATNSimulator(self, self.atn, self.decisionsToDFA, PredictionContextCache()) self._actions = None self._predicates = None coq-8.20.0/doc/tools/coqrst/notations/TacticNotationsLexer.tokens000066400000000000000000000001541466560755400251760ustar00rootroot00000000000000LALT=1 LGROUP=2 LBRACE=3 RBRACE=4 ESCAPED=5 PIPE=6 ATOM=7 ID=8 SUB=9 WHITESPACE=10 '{|'=1 '{'=3 '}'=4 '|'=6 coq-8.20.0/doc/tools/coqrst/notations/TacticNotationsParser.py000066400000000000000000001020201466560755400244730ustar00rootroot00000000000000# Generated from TacticNotations.g by ANTLR 4.7.2 # encoding: utf-8 from antlr4 import * from io import StringIO from typing.io import TextIO import sys def serializedATN(): with StringIO() as buf: buf.write("\3\u608b\ua72a\u8133\ub9ed\u417c\u3be7\u7786\u5964\3\f") buf.write("\u0081\4\2\t\2\4\3\t\3\4\4\t\4\4\5\t\5\4\6\t\6\4\7\t\7") buf.write("\4\b\t\b\4\t\t\t\4\n\t\n\4\13\t\13\4\f\t\f\4\r\t\r\4\16") buf.write("\t\16\4\17\t\17\4\20\t\20\3\2\3\2\3\2\3\3\3\3\5\3&\n\3") buf.write("\3\3\7\3)\n\3\f\3\16\3,\13\3\3\4\3\4\5\4\60\n\4\3\5\3") buf.write("\5\3\5\3\5\3\5\3\5\5\58\n\5\3\6\3\6\5\6<\n\6\3\6\3\6\5") buf.write("\6@\n\6\3\6\3\6\3\7\3\7\5\7F\n\7\3\7\3\7\5\7J\n\7\3\7") buf.write("\3\7\6\7N\n\7\r\7\16\7O\3\b\3\b\5\bT\n\b\3\b\7\bW\n\b") buf.write("\f\b\16\bZ\13\b\3\t\3\t\5\t^\n\t\3\t\3\t\3\t\5\tc\n\t") buf.write("\3\t\3\t\3\n\3\n\5\ni\n\n\3\n\3\n\5\nm\n\n\3\n\3\n\3\13") buf.write("\3\13\3\f\3\f\3\r\3\r\3\16\3\16\3\17\3\17\5\17{\n\17\3") buf.write("\20\3\20\5\20\177\n\20\3\20\2\2\21\2\4\6\b\n\f\16\20\22") buf.write("\24\26\30\32\34\36\2\3\3\2\b\t\2\u0086\2 \3\2\2\2\4#\3") buf.write("\2\2\2\6/\3\2\2\2\b\67\3\2\2\2\n9\3\2\2\2\fC\3\2\2\2\16") buf.write("Q\3\2\2\2\20[\3\2\2\2\22f\3\2\2\2\24p\3\2\2\2\26r\3\2") buf.write("\2\2\30t\3\2\2\2\32v\3\2\2\2\34x\3\2\2\2\36|\3\2\2\2 ") buf.write("!\5\4\3\2!\"\7\2\2\3\"\3\3\2\2\2#*\5\6\4\2$&\5\30\r\2") buf.write("%$\3\2\2\2%&\3\2\2\2&\'\3\2\2\2\')\5\6\4\2(%\3\2\2\2)") buf.write(",\3\2\2\2*(\3\2\2\2*+\3\2\2\2+\5\3\2\2\2,*\3\2\2\2-\60") buf.write("\5\24\13\2.\60\5\b\5\2/-\3\2\2\2/.\3\2\2\2\60\7\3\2\2") buf.write("\2\618\5\34\17\2\628\5\32\16\2\638\5\36\20\2\648\5\n\6") buf.write("\2\658\5\20\t\2\668\5\22\n\2\67\61\3\2\2\2\67\62\3\2\2") buf.write("\2\67\63\3\2\2\2\67\64\3\2\2\2\67\65\3\2\2\2\67\66\3\2") buf.write("\2\28\t\3\2\2\29;\7\3\2\2:<\7\f\2\2;:\3\2\2\2;<\3\2\2") buf.write("\2<=\3\2\2\2=?\5\f\7\2>@\7\f\2\2?>\3\2\2\2?@\3\2\2\2@") buf.write("A\3\2\2\2AB\7\6\2\2B\13\3\2\2\2CM\5\16\b\2DF\7\f\2\2E") buf.write("D\3\2\2\2EF\3\2\2\2FG\3\2\2\2GI\5\26\f\2HJ\7\f\2\2IH\3") buf.write("\2\2\2IJ\3\2\2\2JK\3\2\2\2KL\5\16\b\2LN\3\2\2\2ME\3\2") buf.write("\2\2NO\3\2\2\2OM\3\2\2\2OP\3\2\2\2P\r\3\2\2\2QX\5\b\5") buf.write("\2RT\5\30\r\2SR\3\2\2\2ST\3\2\2\2TU\3\2\2\2UW\5\b\5\2") buf.write("VS\3\2\2\2WZ\3\2\2\2XV\3\2\2\2XY\3\2\2\2Y\17\3\2\2\2Z") buf.write("X\3\2\2\2[]\7\4\2\2\\^\t\2\2\2]\\\3\2\2\2]^\3\2\2\2^_") buf.write("\3\2\2\2_`\7\f\2\2`b\5\4\3\2ac\7\f\2\2ba\3\2\2\2bc\3\2") buf.write("\2\2cd\3\2\2\2de\7\6\2\2e\21\3\2\2\2fh\7\5\2\2gi\5\30") buf.write("\r\2hg\3\2\2\2hi\3\2\2\2ij\3\2\2\2jl\5\4\3\2km\5\30\r") buf.write("\2lk\3\2\2\2lm\3\2\2\2mn\3\2\2\2no\7\6\2\2o\23\3\2\2\2") buf.write("pq\7\b\2\2q\25\3\2\2\2rs\7\b\2\2s\27\3\2\2\2tu\7\f\2\2") buf.write("u\31\3\2\2\2vw\7\7\2\2w\33\3\2\2\2xz\7\t\2\2y{\7\13\2") buf.write("\2zy\3\2\2\2z{\3\2\2\2{\35\3\2\2\2|~\7\n\2\2}\177\7\13") buf.write("\2\2~}\3\2\2\2~\177\3\2\2\2\177\37\3\2\2\2\23%*/\67;?") buf.write("EIOSX]bhlz~") return buf.getvalue() class TacticNotationsParser ( Parser ): grammarFileName = "TacticNotations.g" atn = ATNDeserializer().deserialize(serializedATN()) decisionsToDFA = [ DFA(ds, i) for i, ds in enumerate(atn.decisionToState) ] sharedContextCache = PredictionContextCache() literalNames = [ "", "'{|'", "", "'{'", "'}'", "", "'|'" ] symbolicNames = [ "", "LALT", "LGROUP", "LBRACE", "RBRACE", "ESCAPED", "PIPE", "ATOM", "ID", "SUB", "WHITESPACE" ] RULE_top = 0 RULE_blocks = 1 RULE_block = 2 RULE_nopipeblock = 3 RULE_alternative = 4 RULE_altblocks = 5 RULE_altblock = 6 RULE_repeat = 7 RULE_curlies = 8 RULE_pipe = 9 RULE_altsep = 10 RULE_whitespace = 11 RULE_escaped = 12 RULE_atomic = 13 RULE_hole = 14 ruleNames = [ "top", "blocks", "block", "nopipeblock", "alternative", "altblocks", "altblock", "repeat", "curlies", "pipe", "altsep", "whitespace", "escaped", "atomic", "hole" ] EOF = Token.EOF LALT=1 LGROUP=2 LBRACE=3 RBRACE=4 ESCAPED=5 PIPE=6 ATOM=7 ID=8 SUB=9 WHITESPACE=10 def __init__(self, input:TokenStream, output:TextIO = sys.stdout): super().__init__(input, output) self.checkVersion("4.7.2") self._interp = ParserATNSimulator(self, self.atn, self.decisionsToDFA, self.sharedContextCache) self._predicates = None class TopContext(ParserRuleContext): def __init__(self, parser, parent:ParserRuleContext=None, invokingState:int=-1): super().__init__(parent, invokingState) self.parser = parser def blocks(self): return self.getTypedRuleContext(TacticNotationsParser.BlocksContext,0) def EOF(self): return self.getToken(TacticNotationsParser.EOF, 0) def getRuleIndex(self): return TacticNotationsParser.RULE_top def accept(self, visitor:ParseTreeVisitor): if hasattr( visitor, "visitTop" ): return visitor.visitTop(self) else: return visitor.visitChildren(self) def top(self): localctx = TacticNotationsParser.TopContext(self, self._ctx, self.state) self.enterRule(localctx, 0, self.RULE_top) try: self.enterOuterAlt(localctx, 1) self.state = 30 self.blocks() self.state = 31 self.match(TacticNotationsParser.EOF) except RecognitionException as re: localctx.exception = re self._errHandler.reportError(self, re) self._errHandler.recover(self, re) finally: self.exitRule() return localctx class BlocksContext(ParserRuleContext): def __init__(self, parser, parent:ParserRuleContext=None, invokingState:int=-1): super().__init__(parent, invokingState) self.parser = parser def block(self, i:int=None): if i is None: return self.getTypedRuleContexts(TacticNotationsParser.BlockContext) else: return self.getTypedRuleContext(TacticNotationsParser.BlockContext,i) def whitespace(self, i:int=None): if i is None: return self.getTypedRuleContexts(TacticNotationsParser.WhitespaceContext) else: return self.getTypedRuleContext(TacticNotationsParser.WhitespaceContext,i) def getRuleIndex(self): return TacticNotationsParser.RULE_blocks def accept(self, visitor:ParseTreeVisitor): if hasattr( visitor, "visitBlocks" ): return visitor.visitBlocks(self) else: return visitor.visitChildren(self) def blocks(self): localctx = TacticNotationsParser.BlocksContext(self, self._ctx, self.state) self.enterRule(localctx, 2, self.RULE_blocks) self._la = 0 # Token type try: self.enterOuterAlt(localctx, 1) self.state = 33 self.block() self.state = 40 self._errHandler.sync(self) _alt = self._interp.adaptivePredict(self._input,1,self._ctx) while _alt!=2 and _alt!=ATN.INVALID_ALT_NUMBER: if _alt==1: self.state = 35 self._errHandler.sync(self) _la = self._input.LA(1) if _la==TacticNotationsParser.WHITESPACE: self.state = 34 self.whitespace() self.state = 37 self.block() self.state = 42 self._errHandler.sync(self) _alt = self._interp.adaptivePredict(self._input,1,self._ctx) except RecognitionException as re: localctx.exception = re self._errHandler.reportError(self, re) self._errHandler.recover(self, re) finally: self.exitRule() return localctx class BlockContext(ParserRuleContext): def __init__(self, parser, parent:ParserRuleContext=None, invokingState:int=-1): super().__init__(parent, invokingState) self.parser = parser def pipe(self): return self.getTypedRuleContext(TacticNotationsParser.PipeContext,0) def nopipeblock(self): return self.getTypedRuleContext(TacticNotationsParser.NopipeblockContext,0) def getRuleIndex(self): return TacticNotationsParser.RULE_block def accept(self, visitor:ParseTreeVisitor): if hasattr( visitor, "visitBlock" ): return visitor.visitBlock(self) else: return visitor.visitChildren(self) def block(self): localctx = TacticNotationsParser.BlockContext(self, self._ctx, self.state) self.enterRule(localctx, 4, self.RULE_block) try: self.state = 45 self._errHandler.sync(self) token = self._input.LA(1) if token in [TacticNotationsParser.PIPE]: self.enterOuterAlt(localctx, 1) self.state = 43 self.pipe() pass elif token in [TacticNotationsParser.LALT, TacticNotationsParser.LGROUP, TacticNotationsParser.LBRACE, TacticNotationsParser.ESCAPED, TacticNotationsParser.ATOM, TacticNotationsParser.ID]: self.enterOuterAlt(localctx, 2) self.state = 44 self.nopipeblock() pass else: raise NoViableAltException(self) except RecognitionException as re: localctx.exception = re self._errHandler.reportError(self, re) self._errHandler.recover(self, re) finally: self.exitRule() return localctx class NopipeblockContext(ParserRuleContext): def __init__(self, parser, parent:ParserRuleContext=None, invokingState:int=-1): super().__init__(parent, invokingState) self.parser = parser def atomic(self): return self.getTypedRuleContext(TacticNotationsParser.AtomicContext,0) def escaped(self): return self.getTypedRuleContext(TacticNotationsParser.EscapedContext,0) def hole(self): return self.getTypedRuleContext(TacticNotationsParser.HoleContext,0) def alternative(self): return self.getTypedRuleContext(TacticNotationsParser.AlternativeContext,0) def repeat(self): return self.getTypedRuleContext(TacticNotationsParser.RepeatContext,0) def curlies(self): return self.getTypedRuleContext(TacticNotationsParser.CurliesContext,0) def getRuleIndex(self): return TacticNotationsParser.RULE_nopipeblock def accept(self, visitor:ParseTreeVisitor): if hasattr( visitor, "visitNopipeblock" ): return visitor.visitNopipeblock(self) else: return visitor.visitChildren(self) def nopipeblock(self): localctx = TacticNotationsParser.NopipeblockContext(self, self._ctx, self.state) self.enterRule(localctx, 6, self.RULE_nopipeblock) try: self.state = 53 self._errHandler.sync(self) token = self._input.LA(1) if token in [TacticNotationsParser.ATOM]: self.enterOuterAlt(localctx, 1) self.state = 47 self.atomic() pass elif token in [TacticNotationsParser.ESCAPED]: self.enterOuterAlt(localctx, 2) self.state = 48 self.escaped() pass elif token in [TacticNotationsParser.ID]: self.enterOuterAlt(localctx, 3) self.state = 49 self.hole() pass elif token in [TacticNotationsParser.LALT]: self.enterOuterAlt(localctx, 4) self.state = 50 self.alternative() pass elif token in [TacticNotationsParser.LGROUP]: self.enterOuterAlt(localctx, 5) self.state = 51 self.repeat() pass elif token in [TacticNotationsParser.LBRACE]: self.enterOuterAlt(localctx, 6) self.state = 52 self.curlies() pass else: raise NoViableAltException(self) except RecognitionException as re: localctx.exception = re self._errHandler.reportError(self, re) self._errHandler.recover(self, re) finally: self.exitRule() return localctx class AlternativeContext(ParserRuleContext): def __init__(self, parser, parent:ParserRuleContext=None, invokingState:int=-1): super().__init__(parent, invokingState) self.parser = parser def LALT(self): return self.getToken(TacticNotationsParser.LALT, 0) def altblocks(self): return self.getTypedRuleContext(TacticNotationsParser.AltblocksContext,0) def RBRACE(self): return self.getToken(TacticNotationsParser.RBRACE, 0) def WHITESPACE(self, i:int=None): if i is None: return self.getTokens(TacticNotationsParser.WHITESPACE) else: return self.getToken(TacticNotationsParser.WHITESPACE, i) def getRuleIndex(self): return TacticNotationsParser.RULE_alternative def accept(self, visitor:ParseTreeVisitor): if hasattr( visitor, "visitAlternative" ): return visitor.visitAlternative(self) else: return visitor.visitChildren(self) def alternative(self): localctx = TacticNotationsParser.AlternativeContext(self, self._ctx, self.state) self.enterRule(localctx, 8, self.RULE_alternative) self._la = 0 # Token type try: self.enterOuterAlt(localctx, 1) self.state = 55 self.match(TacticNotationsParser.LALT) self.state = 57 self._errHandler.sync(self) _la = self._input.LA(1) if _la==TacticNotationsParser.WHITESPACE: self.state = 56 self.match(TacticNotationsParser.WHITESPACE) self.state = 59 self.altblocks() self.state = 61 self._errHandler.sync(self) _la = self._input.LA(1) if _la==TacticNotationsParser.WHITESPACE: self.state = 60 self.match(TacticNotationsParser.WHITESPACE) self.state = 63 self.match(TacticNotationsParser.RBRACE) except RecognitionException as re: localctx.exception = re self._errHandler.reportError(self, re) self._errHandler.recover(self, re) finally: self.exitRule() return localctx class AltblocksContext(ParserRuleContext): def __init__(self, parser, parent:ParserRuleContext=None, invokingState:int=-1): super().__init__(parent, invokingState) self.parser = parser def altblock(self, i:int=None): if i is None: return self.getTypedRuleContexts(TacticNotationsParser.AltblockContext) else: return self.getTypedRuleContext(TacticNotationsParser.AltblockContext,i) def altsep(self, i:int=None): if i is None: return self.getTypedRuleContexts(TacticNotationsParser.AltsepContext) else: return self.getTypedRuleContext(TacticNotationsParser.AltsepContext,i) def WHITESPACE(self, i:int=None): if i is None: return self.getTokens(TacticNotationsParser.WHITESPACE) else: return self.getToken(TacticNotationsParser.WHITESPACE, i) def getRuleIndex(self): return TacticNotationsParser.RULE_altblocks def accept(self, visitor:ParseTreeVisitor): if hasattr( visitor, "visitAltblocks" ): return visitor.visitAltblocks(self) else: return visitor.visitChildren(self) def altblocks(self): localctx = TacticNotationsParser.AltblocksContext(self, self._ctx, self.state) self.enterRule(localctx, 10, self.RULE_altblocks) self._la = 0 # Token type try: self.enterOuterAlt(localctx, 1) self.state = 65 self.altblock() self.state = 75 self._errHandler.sync(self) _alt = 1 while _alt!=2 and _alt!=ATN.INVALID_ALT_NUMBER: if _alt == 1: self.state = 67 self._errHandler.sync(self) _la = self._input.LA(1) if _la==TacticNotationsParser.WHITESPACE: self.state = 66 self.match(TacticNotationsParser.WHITESPACE) self.state = 69 self.altsep() self.state = 71 self._errHandler.sync(self) _la = self._input.LA(1) if _la==TacticNotationsParser.WHITESPACE: self.state = 70 self.match(TacticNotationsParser.WHITESPACE) self.state = 73 self.altblock() else: raise NoViableAltException(self) self.state = 77 self._errHandler.sync(self) _alt = self._interp.adaptivePredict(self._input,8,self._ctx) except RecognitionException as re: localctx.exception = re self._errHandler.reportError(self, re) self._errHandler.recover(self, re) finally: self.exitRule() return localctx class AltblockContext(ParserRuleContext): def __init__(self, parser, parent:ParserRuleContext=None, invokingState:int=-1): super().__init__(parent, invokingState) self.parser = parser def nopipeblock(self, i:int=None): if i is None: return self.getTypedRuleContexts(TacticNotationsParser.NopipeblockContext) else: return self.getTypedRuleContext(TacticNotationsParser.NopipeblockContext,i) def whitespace(self, i:int=None): if i is None: return self.getTypedRuleContexts(TacticNotationsParser.WhitespaceContext) else: return self.getTypedRuleContext(TacticNotationsParser.WhitespaceContext,i) def getRuleIndex(self): return TacticNotationsParser.RULE_altblock def accept(self, visitor:ParseTreeVisitor): if hasattr( visitor, "visitAltblock" ): return visitor.visitAltblock(self) else: return visitor.visitChildren(self) def altblock(self): localctx = TacticNotationsParser.AltblockContext(self, self._ctx, self.state) self.enterRule(localctx, 12, self.RULE_altblock) self._la = 0 # Token type try: self.enterOuterAlt(localctx, 1) self.state = 79 self.nopipeblock() self.state = 86 self._errHandler.sync(self) _alt = self._interp.adaptivePredict(self._input,10,self._ctx) while _alt!=2 and _alt!=ATN.INVALID_ALT_NUMBER: if _alt==1: self.state = 81 self._errHandler.sync(self) _la = self._input.LA(1) if _la==TacticNotationsParser.WHITESPACE: self.state = 80 self.whitespace() self.state = 83 self.nopipeblock() self.state = 88 self._errHandler.sync(self) _alt = self._interp.adaptivePredict(self._input,10,self._ctx) except RecognitionException as re: localctx.exception = re self._errHandler.reportError(self, re) self._errHandler.recover(self, re) finally: self.exitRule() return localctx class RepeatContext(ParserRuleContext): def __init__(self, parser, parent:ParserRuleContext=None, invokingState:int=-1): super().__init__(parent, invokingState) self.parser = parser def LGROUP(self): return self.getToken(TacticNotationsParser.LGROUP, 0) def WHITESPACE(self, i:int=None): if i is None: return self.getTokens(TacticNotationsParser.WHITESPACE) else: return self.getToken(TacticNotationsParser.WHITESPACE, i) def blocks(self): return self.getTypedRuleContext(TacticNotationsParser.BlocksContext,0) def RBRACE(self): return self.getToken(TacticNotationsParser.RBRACE, 0) def ATOM(self): return self.getToken(TacticNotationsParser.ATOM, 0) def PIPE(self): return self.getToken(TacticNotationsParser.PIPE, 0) def getRuleIndex(self): return TacticNotationsParser.RULE_repeat def accept(self, visitor:ParseTreeVisitor): if hasattr( visitor, "visitRepeat" ): return visitor.visitRepeat(self) else: return visitor.visitChildren(self) def repeat(self): localctx = TacticNotationsParser.RepeatContext(self, self._ctx, self.state) self.enterRule(localctx, 14, self.RULE_repeat) self._la = 0 # Token type try: self.enterOuterAlt(localctx, 1) self.state = 89 self.match(TacticNotationsParser.LGROUP) self.state = 91 self._errHandler.sync(self) _la = self._input.LA(1) if _la==TacticNotationsParser.PIPE or _la==TacticNotationsParser.ATOM: self.state = 90 _la = self._input.LA(1) if not(_la==TacticNotationsParser.PIPE or _la==TacticNotationsParser.ATOM): self._errHandler.recoverInline(self) else: self._errHandler.reportMatch(self) self.consume() self.state = 93 self.match(TacticNotationsParser.WHITESPACE) self.state = 94 self.blocks() self.state = 96 self._errHandler.sync(self) _la = self._input.LA(1) if _la==TacticNotationsParser.WHITESPACE: self.state = 95 self.match(TacticNotationsParser.WHITESPACE) self.state = 98 self.match(TacticNotationsParser.RBRACE) except RecognitionException as re: localctx.exception = re self._errHandler.reportError(self, re) self._errHandler.recover(self, re) finally: self.exitRule() return localctx class CurliesContext(ParserRuleContext): def __init__(self, parser, parent:ParserRuleContext=None, invokingState:int=-1): super().__init__(parent, invokingState) self.parser = parser def LBRACE(self): return self.getToken(TacticNotationsParser.LBRACE, 0) def blocks(self): return self.getTypedRuleContext(TacticNotationsParser.BlocksContext,0) def RBRACE(self): return self.getToken(TacticNotationsParser.RBRACE, 0) def whitespace(self, i:int=None): if i is None: return self.getTypedRuleContexts(TacticNotationsParser.WhitespaceContext) else: return self.getTypedRuleContext(TacticNotationsParser.WhitespaceContext,i) def getRuleIndex(self): return TacticNotationsParser.RULE_curlies def accept(self, visitor:ParseTreeVisitor): if hasattr( visitor, "visitCurlies" ): return visitor.visitCurlies(self) else: return visitor.visitChildren(self) def curlies(self): localctx = TacticNotationsParser.CurliesContext(self, self._ctx, self.state) self.enterRule(localctx, 16, self.RULE_curlies) self._la = 0 # Token type try: self.enterOuterAlt(localctx, 1) self.state = 100 self.match(TacticNotationsParser.LBRACE) self.state = 102 self._errHandler.sync(self) _la = self._input.LA(1) if _la==TacticNotationsParser.WHITESPACE: self.state = 101 self.whitespace() self.state = 104 self.blocks() self.state = 106 self._errHandler.sync(self) _la = self._input.LA(1) if _la==TacticNotationsParser.WHITESPACE: self.state = 105 self.whitespace() self.state = 108 self.match(TacticNotationsParser.RBRACE) except RecognitionException as re: localctx.exception = re self._errHandler.reportError(self, re) self._errHandler.recover(self, re) finally: self.exitRule() return localctx class PipeContext(ParserRuleContext): def __init__(self, parser, parent:ParserRuleContext=None, invokingState:int=-1): super().__init__(parent, invokingState) self.parser = parser def PIPE(self): return self.getToken(TacticNotationsParser.PIPE, 0) def getRuleIndex(self): return TacticNotationsParser.RULE_pipe def accept(self, visitor:ParseTreeVisitor): if hasattr( visitor, "visitPipe" ): return visitor.visitPipe(self) else: return visitor.visitChildren(self) def pipe(self): localctx = TacticNotationsParser.PipeContext(self, self._ctx, self.state) self.enterRule(localctx, 18, self.RULE_pipe) try: self.enterOuterAlt(localctx, 1) self.state = 110 self.match(TacticNotationsParser.PIPE) except RecognitionException as re: localctx.exception = re self._errHandler.reportError(self, re) self._errHandler.recover(self, re) finally: self.exitRule() return localctx class AltsepContext(ParserRuleContext): def __init__(self, parser, parent:ParserRuleContext=None, invokingState:int=-1): super().__init__(parent, invokingState) self.parser = parser def PIPE(self): return self.getToken(TacticNotationsParser.PIPE, 0) def getRuleIndex(self): return TacticNotationsParser.RULE_altsep def accept(self, visitor:ParseTreeVisitor): if hasattr( visitor, "visitAltsep" ): return visitor.visitAltsep(self) else: return visitor.visitChildren(self) def altsep(self): localctx = TacticNotationsParser.AltsepContext(self, self._ctx, self.state) self.enterRule(localctx, 20, self.RULE_altsep) try: self.enterOuterAlt(localctx, 1) self.state = 112 self.match(TacticNotationsParser.PIPE) except RecognitionException as re: localctx.exception = re self._errHandler.reportError(self, re) self._errHandler.recover(self, re) finally: self.exitRule() return localctx class WhitespaceContext(ParserRuleContext): def __init__(self, parser, parent:ParserRuleContext=None, invokingState:int=-1): super().__init__(parent, invokingState) self.parser = parser def WHITESPACE(self): return self.getToken(TacticNotationsParser.WHITESPACE, 0) def getRuleIndex(self): return TacticNotationsParser.RULE_whitespace def accept(self, visitor:ParseTreeVisitor): if hasattr( visitor, "visitWhitespace" ): return visitor.visitWhitespace(self) else: return visitor.visitChildren(self) def whitespace(self): localctx = TacticNotationsParser.WhitespaceContext(self, self._ctx, self.state) self.enterRule(localctx, 22, self.RULE_whitespace) try: self.enterOuterAlt(localctx, 1) self.state = 114 self.match(TacticNotationsParser.WHITESPACE) except RecognitionException as re: localctx.exception = re self._errHandler.reportError(self, re) self._errHandler.recover(self, re) finally: self.exitRule() return localctx class EscapedContext(ParserRuleContext): def __init__(self, parser, parent:ParserRuleContext=None, invokingState:int=-1): super().__init__(parent, invokingState) self.parser = parser def ESCAPED(self): return self.getToken(TacticNotationsParser.ESCAPED, 0) def getRuleIndex(self): return TacticNotationsParser.RULE_escaped def accept(self, visitor:ParseTreeVisitor): if hasattr( visitor, "visitEscaped" ): return visitor.visitEscaped(self) else: return visitor.visitChildren(self) def escaped(self): localctx = TacticNotationsParser.EscapedContext(self, self._ctx, self.state) self.enterRule(localctx, 24, self.RULE_escaped) try: self.enterOuterAlt(localctx, 1) self.state = 116 self.match(TacticNotationsParser.ESCAPED) except RecognitionException as re: localctx.exception = re self._errHandler.reportError(self, re) self._errHandler.recover(self, re) finally: self.exitRule() return localctx class AtomicContext(ParserRuleContext): def __init__(self, parser, parent:ParserRuleContext=None, invokingState:int=-1): super().__init__(parent, invokingState) self.parser = parser def ATOM(self): return self.getToken(TacticNotationsParser.ATOM, 0) def SUB(self): return self.getToken(TacticNotationsParser.SUB, 0) def getRuleIndex(self): return TacticNotationsParser.RULE_atomic def accept(self, visitor:ParseTreeVisitor): if hasattr( visitor, "visitAtomic" ): return visitor.visitAtomic(self) else: return visitor.visitChildren(self) def atomic(self): localctx = TacticNotationsParser.AtomicContext(self, self._ctx, self.state) self.enterRule(localctx, 26, self.RULE_atomic) self._la = 0 # Token type try: self.enterOuterAlt(localctx, 1) self.state = 118 self.match(TacticNotationsParser.ATOM) self.state = 120 self._errHandler.sync(self) _la = self._input.LA(1) if _la==TacticNotationsParser.SUB: self.state = 119 self.match(TacticNotationsParser.SUB) except RecognitionException as re: localctx.exception = re self._errHandler.reportError(self, re) self._errHandler.recover(self, re) finally: self.exitRule() return localctx class HoleContext(ParserRuleContext): def __init__(self, parser, parent:ParserRuleContext=None, invokingState:int=-1): super().__init__(parent, invokingState) self.parser = parser def ID(self): return self.getToken(TacticNotationsParser.ID, 0) def SUB(self): return self.getToken(TacticNotationsParser.SUB, 0) def getRuleIndex(self): return TacticNotationsParser.RULE_hole def accept(self, visitor:ParseTreeVisitor): if hasattr( visitor, "visitHole" ): return visitor.visitHole(self) else: return visitor.visitChildren(self) def hole(self): localctx = TacticNotationsParser.HoleContext(self, self._ctx, self.state) self.enterRule(localctx, 28, self.RULE_hole) self._la = 0 # Token type try: self.enterOuterAlt(localctx, 1) self.state = 122 self.match(TacticNotationsParser.ID) self.state = 124 self._errHandler.sync(self) _la = self._input.LA(1) if _la==TacticNotationsParser.SUB: self.state = 123 self.match(TacticNotationsParser.SUB) except RecognitionException as re: localctx.exception = re self._errHandler.reportError(self, re) self._errHandler.recover(self, re) finally: self.exitRule() return localctx coq-8.20.0/doc/tools/coqrst/notations/TacticNotationsVisitor.py000066400000000000000000000060341466560755400247060ustar00rootroot00000000000000# Generated from TacticNotations.g by ANTLR 4.7.2 from antlr4 import * if __name__ is not None and "." in __name__: from .TacticNotationsParser import TacticNotationsParser else: from TacticNotationsParser import TacticNotationsParser # This class defines a complete generic visitor for a parse tree produced by TacticNotationsParser. class TacticNotationsVisitor(ParseTreeVisitor): # Visit a parse tree produced by TacticNotationsParser#top. def visitTop(self, ctx:TacticNotationsParser.TopContext): return self.visitChildren(ctx) # Visit a parse tree produced by TacticNotationsParser#blocks. def visitBlocks(self, ctx:TacticNotationsParser.BlocksContext): return self.visitChildren(ctx) # Visit a parse tree produced by TacticNotationsParser#block. def visitBlock(self, ctx:TacticNotationsParser.BlockContext): return self.visitChildren(ctx) # Visit a parse tree produced by TacticNotationsParser#nopipeblock. def visitNopipeblock(self, ctx:TacticNotationsParser.NopipeblockContext): return self.visitChildren(ctx) # Visit a parse tree produced by TacticNotationsParser#alternative. def visitAlternative(self, ctx:TacticNotationsParser.AlternativeContext): return self.visitChildren(ctx) # Visit a parse tree produced by TacticNotationsParser#altblocks. def visitAltblocks(self, ctx:TacticNotationsParser.AltblocksContext): return self.visitChildren(ctx) # Visit a parse tree produced by TacticNotationsParser#altblock. def visitAltblock(self, ctx:TacticNotationsParser.AltblockContext): return self.visitChildren(ctx) # Visit a parse tree produced by TacticNotationsParser#repeat. def visitRepeat(self, ctx:TacticNotationsParser.RepeatContext): return self.visitChildren(ctx) # Visit a parse tree produced by TacticNotationsParser#curlies. def visitCurlies(self, ctx:TacticNotationsParser.CurliesContext): return self.visitChildren(ctx) # Visit a parse tree produced by TacticNotationsParser#pipe. def visitPipe(self, ctx:TacticNotationsParser.PipeContext): return self.visitChildren(ctx) # Visit a parse tree produced by TacticNotationsParser#altsep. def visitAltsep(self, ctx:TacticNotationsParser.AltsepContext): return self.visitChildren(ctx) # Visit a parse tree produced by TacticNotationsParser#whitespace. def visitWhitespace(self, ctx:TacticNotationsParser.WhitespaceContext): return self.visitChildren(ctx) # Visit a parse tree produced by TacticNotationsParser#escaped. def visitEscaped(self, ctx:TacticNotationsParser.EscapedContext): return self.visitChildren(ctx) # Visit a parse tree produced by TacticNotationsParser#atomic. def visitAtomic(self, ctx:TacticNotationsParser.AtomicContext): return self.visitChildren(ctx) # Visit a parse tree produced by TacticNotationsParser#hole. def visitHole(self, ctx:TacticNotationsParser.HoleContext): return self.visitChildren(ctx) del TacticNotationsParser coq-8.20.0/doc/tools/coqrst/notations/UbuntuMono-B.ttf000066400000000000000000005656501466560755400226750ustar00rootroot00000000000000DSIGyacx0GSUBZ<)V[[TUj/Y2  P [DAMA [1> V 2W"^U.(~q/#0+)#.1&-v-((E 66??-6*-G.66('  .q1m,>,$!?$1?$??Y6$; C??~ >:p ()r6Z6 .& 1Sh2-qll(qq;J2 E ????6666.<'''' 6,,,,,,,$$$$(?(;;;;? , , ,,,,,6 ?????!!!!-76$6$6$6$6$$7*1-?-?G$G$G$G$$.?.?.? .?6Y6#6Y(6(6(6$$$';';';';';'; .C.C.C(6$1pjiC   fYqbkjfqqYqbkj5    ( ( 1(,,fqqYqbkjfqqYqbkj^Uq/q1m??r622E6?(?  6-?;??6(6 $ $') ' .C(6-$5?\ -7 ,6$';';';';'; , , !!-71 !6.? ,  , ,<?6$6$,O6Y';';"K-7-.C ,? $$ '$C7< 6*1 iOmJJJowwMMM??$(66*.-.- 66$? ..---6 --"6*,(DY3???;??,&?+ "6Y'6$$1.???.?6?$Y$-? 3-?-;-;$$,&   -+-6? 6 -?-;-;-+6 , , ? 3.?.?*-+$Y""` 6$ ?.-6- . -6   (6@6?$?;5??-$3{jm6Z (@?$$$33&&((((((((6)wx@@@@@@k{????????Zf$$$$$$$$d`}`33333333rkG~((@@??$$33((((((((..????????Q]kG~((((((( g i^?????9B'1@Nn$$$$66%OHn33&&??33 7'W&&D3 \]ZfkG~ - .9[      !"#$%& ' (")"*$+%,%-&.'/(0)1)2*3+4+5-6.7.8/90:1;2<2=3>4?5@6A6B7C8D9E:F;G;H<I=J>K?L@MANAOBPCQDRDSFTFUGVHWIXIYJZK[L\M]N^N_O`PaQbRcSdSeTfUgVhWiXjXkYlZm[n\o\p^q^r_s`tauavbwdxeyezf{f|g}h~jjkklmnnppqrssuvvwxxyz{|}}|`b ~17HQS_aw67O_cuEMWY[]}    " & 0 : D p y !!!"!&!.!^""""""""+"H"`"e%%% %%%%%$%,%4%<%l%%%  28IRT`bx78br HPY[]_    & 0 9 D p t !!!"!&!.!S""""""""+"H"`"d%%% %%%%%$%,%4%<%P%%% YXAT&S;;z@:*߶$mtTxSߘߕߍߋ߈߅y]FC߼ߵ߯߂z# mykwzRSTUVWXi_abcduestnocpqeghrlx    !"#$%&'()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_`ag}~rv|df{mystpqnoznblxhcej iuabced_@?XUTSRQPONMLKJIHGFEDCBA@?>=<;:98765/.-,(&%$#" ,E#F` &`&#HH-,E#F#a &a&#HH-,E#F` a F`&#HH-,E#F#a ` &a a&#HH-,E#F`@a f`&#HH-,E#F#a@` &a@a&#HH-, <<-, E# D# ZQX# D#Y QX# MD#Y &QX# D#Y!!-, EhD ` EFvhE`D-, C#Ce -, C#C -,(#p(>(#p(E: -, E%EadPQXED!!Y-, EC`D-,CCe -, i@a ,b`+ d#da\XaY-,E+)#D)z-,Ee,#DE+#D-,KRXED!!Y-,%# `#-,%# a#-,%-, ` <<-, a <<-,CC -,!! d#d@b-,!QX d#d b@/+Y`-,!QX d#dUb/+Y`-, d#d@b`#!-,E#E`#E`#E`#vhb -,&&%%E#E &`bch &ae#DD-, ETX@D E@aD!!Y-,E0/E#Ea``iD-,KQX/#p#B!!Y-,KQX %EiSXD!!Y!!Y-,EC`c`iD-,/ED-,E# E`D-,E#E`D-,K#QX34 34YDD-,CX&EXdf`d `f X!@YaY#XeY)#D#)!!!!!Y-,CX%Ed `f X!@Ya#XeY)#D%% XY%% F%#B<%% F%`#B< XY%%)%%)%% XY%%CH%%`CH!Y!!!!!!!-,CX%Ed `f X!@Ya#XeY)#D%% XY%% F%#B<%%%% F%`#B< XY%%)) EeD%%)%% XY%%CH%%%%`CH!Y!!!!!!!-,% F%#B%%EH!!!!-,% %%CH!!!-,E# E P X#e#Y#h @PX!@Y#XeY`D-,KS#KQZX E`D!!Y-,KTX E`D!!Y-,KS#KQZX8!!Y-,KTX8!!Y-,CTXF+!!!!Y-,CTXG+!!!Y-,CTXH+!!!!Y-,CTXI+!!!Y-, #KSKQZX#8!!Y-, IQX@# 84!!Y-,F#F`#Fa#  Fab@@pE`h:-, #Id#SX<!Y-,KRX}zY-,KKTB-,B#Q@SZX TXBYY-,Eh#KQX# E d@PX|Yh`YD-,%%#>#> #eB #B#?#? #eB#B-@vn)uodtrdrC)qodpndoBnBia)gedeC)dBcadaBYQ)XBWUdUC)TBSQdRBQBLD)JHdHC)FDdDBCA/B?B* * U*U*U * U*U*U *U*UTSKRKP[%S@QZUZ[XYBKSXYKSXBY++++++++t+++s++++++++++++++++++++++++++++kk [[||f|P}fPkr{d}fk{}ofk{}fTkvfPP<<::dd_@~rU*W!Gxo{9jZ\.r+z4Y*CrrQY\\\\X  |$ 8 P |  \  ,Tx t|`(X(  !H""#4#$&l'$'(L(()<)))*+,,-.P//0H012334 45<567@78@9:t;;<@<=8=>??@XA AB4BDDEEFHFGLGHLHxHIJJK<L\LLMMNOPQR\RTUUUUWWX<XYZ[ [\\,\] ]^@_`abbcc0c\cdeffg g<gpgggh0hi iPi|iijjkkllHl|lm<nTn|nnno$oPpqqqr$rTrrrs t t4t`tttuuvvvw w<wdxxDxpxxxyzz{${P{x{{{| |P}}}}~~L~t~~$Lx@lHtp(@hPP\,XPp H|,T,TDpx Lt 4HtHx,\ H 4HTx`H<t`\Ĉ,Ȍ@D Ӏ`0հ֘הt0ٰ,ڼۤ|܌|݌ݜݬݼ ,@Th|ސޤ޸ hߤ 0@P`pT4(<P@Hh8LlLHp@Xld<0,P     | 8 t<L|Hd(THP H !l#l#$%%,%T&H'X'''()p*@*l***+,-. .8.`/4//01d1112202d22233P33344<4h4445$5X55566L6x678D8p99:;<=p>>H>p?D@@BBHCCDD(ELE|EEFGHIJKpLtMhMNPO\PPQ R8S8SHSUUVW@WXY0ZL[d\\l\]L]^8^_T```aa<abcLcxcdpde8eHeXeeflg<ggh hLhhiditijjklmhmmnn$n4nDnnnnop\plpqqrsstpuvvvwxy yyz{||0|}H~,~~(xt\@ hP(X4\ 0dtH(8d,x0lX$<h 4xp\d|T$Pdt@dx@ 08@<@P|h,x\DPt,<Lxl 8lÜìüDtĨx$XƈƼ@tǤ<l4hɘ xTάμ L\lԘՐ@8Hhp۰݌H߈(\0X@p$P4d,`4` <p Lx(X T|(T4h0X0\8h@lHx0\ <p8` 8d0X Hp P@Xp0` P(@l(X4`<h<h0\@h  | , X    ( `     l  t   4`@h<Lx$T|8h4h0d4h0d$HlX$L%%& &D&|&&''l'( (x)))*H*+ ++,`,-(-h.0./T/0<01L1223 3x34T45(56648<;?d?@l22@!0@ 0`p??]]103!'!222vMk @qo u ??10#.553#"&54632Af 3 33 3$954 549$',,'&,,W 6@n n@@ H ??/+]_q10#.55##.55 H B G 1;><<><01;><<><0kjMLO M LM LpM M@ M@M MгM L| L M M@  MML @e My  y!yy  r r??]22/223??22229]9]]]]]]]9]910++++]+++]+++++++]++++]++733733#3##7##7#537#537#fPf>RgzfPf753&&#"#?M& V08,!08,!6'r.GO*0% &'B0%=.r  b %5'4,! a\g " !+:'5-!ky'3' M" M M@ M MMM@BM""""|(|(((|` p  55...|44+@,H+}} p}%}1111??99//]]]]?]?+]]]99//]]]]10+++++]+++3#34632#"&74&#"3264632#"&74&#"326[YY<45<<54<p<36<<63<  k#LOOLLOOL*$$**""zLOOLLPPL*##**""y)5A¹?@ M%@ M"@ M M @ M9@ M. M. M-@ L9-  &C""y#C?<_<3267'&&'3266654&#"m "H#-C-11.96*:>,f& <#*.f "/>"0W!H'(=(#5#0[ 23F 8`'!F#}#B +"2w-;"|= =nR  @ H   H H ?++]q+_q10#.55= H B;>==>;B^V @ p ??10&&5467m`9~9`q {8LKKL8UV @ p  ??2104&'7'66&q`9~9`m |8LK犉KL8.k@Y@<@M<:.'4"'@M AB/-;4 ' ?9/2+9=/2+10'7>7""&&''7.553>77"#'. ^ #$" %   t   $ "$# ^ v "" C  m  !$"  "$!  o  D #!(&  M@ M@M@M@ M M M@4 M@M@M R`@ P  U ?]]9/]]32]10++++++++++3533##5#(jj9e~g[@z {??10>7&&54632~%!&*3'*/1N8I 4 '280#F<,q=?10!!q=yT_M@He L H M HjM@Hez {?10]++]++++]++%#".54>32T6#  #6O,. !! ./[-@v??/+}10#3~`#y #U@4d d%d$!!!@e e ??9/]]]/9/]]]]10#"&546324&#"326'#"&54632niinpgino5326623507joojkoou''((0k/@@ M a  ee ??9310+7'>733!5H(882T{fZ f "&ff+y%&@c ' c&g! e ??210!!&654>54&#"'6632(2 " l%9A9%.#@=(i4&F6  ;84 !#$f 2TG=84&)!V*(,C)y0- M, M+ M M M @* M L)c&, c,,21g!))e! g ?2?9/9=/2]310+++++++".'732654&##532>54&#"'66323/( I3?3N<&.&)$#E,Y84M2*#05:Z  g 6(1'f"'Z%/@%%DN6+H5k0@ ae  ??9/932222231033##5!5>7&%" {CC{A3^L <|z>\=2.% D3$/ +TKf Fh^+I6 f  .o->@&c`p/+cc @ H .e&g% g ??9+]10"32>54&'2#"&54>366( # *$6K00J3hm5bT(L@/ $&  5*$/3f 6H($J>'Z^0i!4' 1k)a c@ H ee ??+103>7!5!$3<@9+@}-f]pP&z+76@ M4 M2@ M0@ M/ M/ M. L, M , M@ M @ M M5 M/ L#M# M#"@ M"2#d M@& H95d9//d&dP82##),g)g ??9/9]/]++910]+]++++++++]++++++++#".5467&&54>324.'326"6654&*-9/3R1 +?'/S D&A4"X9()+$##,7##-{*@@%))c c@  ,&c 0@+e&g% g??9]]//102676654.#"".54>32#'667*  # ,$6L01J2hn4aTP~'I 3*&/2f6G)$K='}Z^1jCHT&/@ P O++4vgT6/-(*@??9=/999910%%-""9lmml(r!@ UU?2210!!!!(\\f]f('.@??9=/9999910%'%%7##ɢlmmlEy01@22q'''1,u" g??]107&54676654&#"'6632#".54>32*"(* <#"#^.9J*#(##3  (I+^.70*%$&',  yy5EZ>M8@M!@M!8 M @ M M@M: M:@ M @ M @M@M@M MM@ M@ LLMML@rL@ M@ M@ M@ M M MP==@>>y 505`55GO6_66y+!G|+F@Py=@APAAy &> = = &}0 }&/]?99//999]]]]9/]]]22]10++++++++++++++++++]++++++++++%#".54>3254&#"3267#".54>323275&&#"G&A0$9*0.!;+3U?/6 BrS0)FZ2)H6  7 1O9*J7 &5FuYFlI& W$Yol['6W>( " k D @' L L   H ????9/9910++!'##6733.g,Z*,W)  y -ϲ#?=>!!>=?6r#0T@'F Fp20D @ H   1#H$$,J J ??9/9=/^]+2]]10%#"&'6632%32>54&#'2654.#"&AY3)X+#T)FX2+$?- (90/0  8K- Y /:,DN)#-'f)$y:`  @H!F J JJJ ??+2]210"&54>32&&#"3267(*Kg=!5( A*7+IS0?Y MxS+ b1R=jq a6r!6@ F#D@ H" HH ??^]+}/]107232>54.#"#"&'6632 *9# 4)(+Li?!?$*J =eF'd 8M.(L:#VyL#\ $Mw?k Q@ 0  D 0 H@MM@ M H H??9/+++]2]103!#3#!?wkfff?k J@/@ M@ D@ M0 H H???9/]+2^]]+103!!3#?{kffy#4@ %F$ D0  !JJ ????9//]10"326753#".54>32&&8,<'FD  {]B:]B$*Hb8$9* @ 9O0oi)QyPOyR) b-k ;@  D  D@ H  H@???9/]?+2210###335{{{kk6k .  D@ H H H?2?2+10353#5!#36fffaf*k.@DH J ???^]]10%#"&'73265#5!5T73^ )27{{0+$ '29@9.#QMCkDDBEKN$NY],Gk, HD@ HH??++10!!3!{| kko M@ M0 M@[ M@ L?@ M? M M L @ M M @ M @ L @ L?  @M L M M@M@ M M L@ L@ M@ M M M? M@1 M@ M@ M/?@ M DD@Mo  ??9/9??9/9|]]+/9=/9999/10+]++]++]+++]++++++++++]++++++++]+]]+++]++>73###>7 f qLZIq kBLN!%OI@QPLA.kS@ @ M @ M?/ ?  DD@ H  ????99+2]210]+]+!&&'#33c*c9oc85-oggek,gf`$}y,@ F!F J J??]10]]32>54.#"4632#"&& '& &}vimrtjms6-O:"";N--O:"";N-6r?@ F`D @ H  HJ??99//?+2]102###>"32654&vx,{-., ' 2;<;ranocck/96-Vv&/@F (F' J J  "J??32/9104632&&'&&732>54.#"vimrZU UJuw QW}& '& &3! XKF-N;"";N--O:"";N6r$Y@D` p  &F`p&!DD@ H%H!!  J?????9/2+]]22102#&&'##>4&#"3265V>!,3&$! =#@{+,(|<1 ?8r2M46X?EE54.'.54632&&#"#"&'7) "*<1 qc9U$=(b'?5"qsM\$KZ  (;,Wb_G -C3W_!dk@DH???210###5ۣ|kff'k/@ D`pD@ H J ??3+]10".5332>53X6}'5 !5'u6X>! k@ MMH@ M$ M+M@0LG @ M   /  ???3??9]]910+]++]+]+]++3.'3>7360& !  #-6E104307( r f,0f r 8DN)4w|;LE?B??EK;~}w4 LJ> kf MM M @'M    ??9??//99=//9910++++!&&'#>7373d7: '/4bg|4-" 3|>;3LX]+$+^YM k>@!D     ???9??9/]29=/210>73#5&&'3  &*0|7S&8PFNP 3`^]1afH.kf@ M M@ H H @ H @ HHH???/+]++99+]10++!!5>7#5!+H>7 h2>I,Btia/fG+_l~Jfq[/@_@_@ nrr??]]]]10!#3!q```1[*@v???/+}103#1~m[/@n@@ Prr??]]]210!53#5!ꠠ``k)@r?29=/9910''3o~~pi5666[@ U??10!!:ks}?10'՞-oCT,.S@ $QS0, S@$ H/_oWP"`"""@W(@ M(W ?+?]9/]]+10]72675&&#"2#".54>3254&#"'66& "$0:M.jB-I4 6F&0%,6#ATXl  1G,%;+)8"#/ c > [@ @ M @ M@ M@ MS` p  !QQ@ H UW W????+]10++++%4&#"3267#"&'76632Y+,' 08}:T60d"{0.F/BF AK8[@#  #AZ,5@0@`p!S@ H W W ??+]10]74>32&&#"3267#"., BeF*D#1&,;$IX?J2HgB3ZC' c %4AJ e &BZ `@@@@ M@ M@ MQSU W W????210+++]q]q]q73267&&#"#"&5463257/4$,("b/nq_]0{?P F qs %\@7LS ?  '% Sp& @MO _  U@W0  W ?]?]9/]]+]2]10+74>32!3267#".%4.#"&>P*hlL<%C H-<_C$; "# >^? {v .5i =Zm#$$V MP@) MP  Q`pOU W U ????]]22]10]+]+3#5354>32&&#"3#gg!8H&'R!Epf9K-d%f!X 'G@'LQQ`  )S`"p""(W W% @W?]?9/]]10+732675&&#"#"&'732>55#"&54632*-# lo{,Q%@0 * +\_nMZ:= sn h # tgtr?B@Q@ ` p  QQ@ H W ??????}/+]10376632#54&#"?{*4F*{*!  9O0B:$ L@. MQp?!! !`!T `pWUX ??/]]]]]10+#"&54632#".55#533267. -- .&C0A'$0]$**$%** 5L1f*) 1VM@ MQ @! H!T @PpUX W??/]+]10+%#"&'73265#5!'#"&546321C'0R&&G"9. -- .9M/h%2Wf$**$%**?Q@ @`0 Q@ H0p  ??9??/]3+22]]210>73#.'#7%# .11:8/ ',-||/2/684CHH?=7$6@!`p? Q P ` p   U W???]]]10%#"&5#533267"1UN&%2 eaf0"'@^+@M@M/?_R@M/?OR_) 0@R(W" % W ?3??9/?]]]]+9/]++10_]]2#4.#"#54&#"#663266W'2 d  dd'L).0I1".^l0&  ?- QQ@ H 0W ?]??+106632#54&#"#?!a98J+{.{ 9O0B:&@S@ M!S W W??+10%#".54>3232654&#" :Q22Q; !;R01Q; -201-2018[B$$B[87[A##A[8?NN??MM?[ 6@S` p  QQ@ HW  W???+]10%4&#"3267#"'#6632X23 (,*}.F./2{"c0mt?Q GE6[A$l [ !5@QQ`p#Sp  "UW W ???]]1073267&&#"4>32#5#".+,% 33}9U630+{3.F/AG Q;6[@$  #@[Y!Q @ H W ??+10.#"#6632 !" 2|1gE %*+Y61L/@ MS &&@ H&3S .@ H.2!W+W ??99++]10+72654.'.54>32&&#"#"&'7-0#8.1L5.OH-/!!:/3R<=V#O]    1%5) h   !3%4& g$`f@@ M 0@M@ Mo ` QP`pW U ?32?]22]^]]++]+10#53573#32>7#".5kk{ "O%+B.pfvf  j (I;;2@ Q Q @ H   W???]+]10%#".533273"a9:J+{-|  ;P0A?qPM M M L@ L   ???910+++++3&&'3>73-]*   }*f-Y&VWR""RWV&Y (@(ж M`('M'г M!@ M@MM M@ M@M M@ M M M M M @ M@MMMM L LM@> M(`$$  ) %`%%*@ M0)(%   ??9/9??]+]9///q33333]310+++++++++++++++++++++++]+!.'#.'3>73>73B   ] i  Y  i '415 324 ,kyDWX&A;77;A&.TSS-[)@     ????//91073#&&'#>7'3`}.*" 60}'+/CAB<3P (L/=?>X"/@"Q$ #Q   ???/9]10#"&'73267&&'3>7#&+%-7%3$, ,X$  Byt7(:% g 0!X%TTQ##QST&CW H H@ H@Pp U U????/]/+99++]103!5>7#5!4==664]|?NU$fK&PMFf?[$7@"n n%r rr ??9/9=/21033#"&554&##5326554633#"6/ ]hZE66EZh] / D@q*&`NJ*+`+)JN`%+q@D[9(@_ @??]]]2103#||?[(C@%(@ M@ Mn&n* )r !r r ??9/9=/210++&&554&##53233#"##53265546960 \g-=%77%=-g\ 0 D@q*&`&9%*+`+)%9&`%+q@Dd@  ?]10%".#"'>3232>7Y/,) [!2#/,( ["1 7.7/w.v M M M@- M 0-)+ c(+/J# )s*-s. J?]2222?2222223210++++6632&&#"3#3#3267#".'#535#5d|Y@"/34  <%>K&*N?- A99gef 4-TT5/ c1O9T?T~g[@ z ?10>7&&54632~%!&*3'*/1N8I 4 '280#F<,V)3@(+&)QR*(U' W U??222210%#"&'73265#5354>32&&#"3#2C'""gg!8H&'R!E9M/f%2Wf9K-d%f p'"@"'('??10>7&&546327>7&&54632 %!!.'&.F.% " .'&.F.M +##3$@6&C +##3$@6&w #I@/ @MO  yO_yO!_!!y$t ???23]]]]]+10"&54632#"&54632#"&54632 )()))()))())>k:@ R @ P   U  ??9/9/]3210#&&55#535331 K mPH{BA|Hff:klMMM@,MR  0@Pr  r_o{??]2222]222222210++++%#&&'#535#53533#3.J nb=l:9m=gffgp@@"@ M M+r~?399=//999910]++''71YY39;EE;z y #'3?K>@M<@M8 M8XM6M6M"@M" @M  MM @M @M@MM$@KL ..(&'M::@F4%L+'&7!7=II7%$%% C71! ???99//999/99]]]10+]+]+]+]+]+]+]+]+++++++74632#"&74&#"32674632#"&%'%4&#"3264632#"&74&#"326O0.0000.0{ _0/0000/0F h0.0000.0{|CGGCCFFC$ $$ $CGGCCFF,-$ $$ CFFCDFFD$$%(>&6_@ /3+$P4O++4'|8M@ M ??9=/99910++%'7![ee0/q%n@K@ M@ MD/?D/?O_? O _  ' !!S&HHOH J J ???]?]]]]]10++!#"&546323#3#3%27&#" eikboXX|#"ffff6M00M6m@ z ?10#"&54>7m$!&*3'*/1N8 5 '280"G<,m @@ M@ Mz ?10++>7&&54632%!&*3'*/1N8 4 '280#F<,)'&@"(' ??]10#"&54>7#"&54>7$ !!.'&.F.% " .'&.F.n +#$4$@6&C +#$4$@6&'.@" 0(' ??]]10>7&&546327>7&&54632% " .'&.F.% " -'&/E. +#$4$@6%B +#$4$@6%r@   ?]10#".54>32#3 2##2 3#:3((34((469?10!!6w9\9?10!! 9\Z M M M L L M M L M @% M   0 ??]9////9910++++++++++#".#"'>323267";"y '  ek$@V $#$ %//#$$ ?2?]??9/9??]9/9/]qqrqqq]9=/]9999]10]##5#5'#>7373#4.'@:@4':6,/6:*k22t<9,2J<34?>*W$p99 W033W 0W ??]?9/]?9/////]10+++746326632#3267#"&'#"&732654&#"7"34.MB5.1$#-)60#IF^  X ~x! "6X@ %' a %%~yP@?QP@?C%& ,&<@)P!OO+++44[M #@q ou  ??_]104>73#4632#"&f 3 33 3$944 449$$'++''++.j![@2 M #QQS 0P"W" W??29/2]]]]10+46753&&#"3267#5..Y`|-/$S@ES<2|0F-U{{ h ?=<@j } *32&&'"ꔔ MM4K/#?!$$[e&'$fH{3e4CY6 b  *!V)۵%@MMȳ M LM@ L@ M M @ L M@ L M@ M@ M M@ M L @/ L@ M@ M P$*+ '*!??9/]]10++++++++++++++++++++27'#"&''7&547'764&#"326,&BS@@TB''BS@@TB$v++++?Q>$,,$>R@  ?Q>"..">R@&((&&(( k! @E MD# !!  "#D" ss ????9/93222?9=////////99333310+%##5#535#53.'36733#3|e)&! 3$G% #'^hhhT>T"KKG@H|GLK"T>[9$@ n???221073#3#||||`1z4D'@ M @ M=@L5@>LF.F5=/@?@@d((F#F8d0044E&5= =5& g1 g??9////]]]]9910++++732654&'.5467&&54632&&#"#"&'6654.R$$(!#%-#=. &d^(V#!=()* d[E` 5- 5(  &2#$@$,EMb  0q&8-#KG)(S  @ 0 ??]10"&546323"&54632))**))))# $$ ## $$ #1ED MC M?@G L: MO94 M7?(_(((G@AF O 0  <2-<# ??99//]]]]99//9910+]++++%#".54>32&&#"3267%4>32#".2>54.#"G%++#  !  &?Q,+R?&&?R+,Q?&8-,98--8x#-.$6( %:=\==\==[==[w.D,+C..C+,D.hx +l@ )@M @MM M@* M!`-) 0`p, }(%} ?/]9]]]210+++++2675&&#"2#"&54>3254&#"'66 ( +:#N4FQ)6 %2 C_E#3 3>)  O 2. [@ _y R_y@ H     ??99=//99=//+]]10'%'A^^?OB]]@(*(*-*k@ yr?10%#5!5!i*fq=1ED MDC?@! L:@ M: M4 MK4`M@MM@tM@M@M@ M @M_  @H  ? O  7(?(_(((G@HAF<2-/?<# ?q?99//3+q2/23]]]]+q+2//2/10+++++++]++++]+7#56632#&&''32654&#"4>32#".2>54.#"6"97(  9  $  &?Q,+R?&&?R+,Q?&8-,98--8M,*0/%2 J=\==\==[==[w.D,+C..C+,D.l0s?10!!l Wl@||  }}?102#"&5462654&#"5&&5BNP@ $4 3$IAAJ(.} M@ Mp    Rpp@& MpUp  @ L@ / ?  U?]]+]22]+?]]2]2]10++7!!3533##5#(\jjfffqy7@ | }t?9/]992103!54676654&#"'6632y. /-,.H(F; '5 Q,F& E!=qy*@ "@ M!@ M MM@ M@ M(M(M(M( M( M(@O L@L@M L@ L M@M ?,'+($}}, }t?9=////2/]10+]+++++++++++++++++2654##532654#"'6632#"&'7 ?%%'("C $1 $:*E*Z$IF%! -* O s}?10'7s-UTCo;[7@ Q  Q@ H W ????+22]1032673#"&'#  | ^30{#- q:  'S{[r>@) 0  R 0R r???9/]]107&&54>32#&&#LM#A\90e&e 0f[W0J3 OTaVg@   ??10#"'73254''6673,!!,-# ")$P  ' ? $ r;@!@M @L  yys   ?9/9992210++535'66733d%&FMRQ  N&QJyd M M M M MM@M_@  tt?]]10+++++++#".54>324&#"326.@''@..@''@.f%#"'&##%*B..B**D..D*+11+)002. 8@         ??9///99910%'7'7'7'7;A^^?B]]@.()()r  ӹMM M M ML MM@L M@ L  "@"! !!  !    ?2?2?????99//9]]22ԇ+}10++++++++++%3##5#56676673#53#$$P|- "2?Uf 3Ed=?''-+L/3 )kr(,o@A @M M*),+*+,)*)*). |.+-##$-%(-",+ )#" ??????9]Ї+}10++%#&4546776654#"'66326673#5%#)  ): '= $"2?Ud=?? #&   5(*"  yk y(5:>@U+ M(@M@M<>=>;<;<;@ |  @=?(? %  ?>= < ;6:,0/ 5). ??2?2????9=///9///932Ї+}10+++32654##532654&#"'6632#"&'3##5#56673# '; ( 840 *"-3$$P|-  3Wd=  9  6 ) + ?''-+L/@)kEV 2C@ H4)qP!`!p!!3 p@ H3.u$  g??+]+10%3267#".54>5'4632#".Q*"  * <#"#^.9J*#(##3  (I  ^/7/'#"$',   >&$C@  PO++4 >&$@  PO++4 >&$i@  PO++4 +&$u@ % P$O++4 ,&$@+ P#OO+++44 #/"8 M! M M4 MMM M LM M@1 M  0*$*$$*0 1 0H  ???9/32]9///9910++++++++]+++#'##67&&54>323.74&#"326c+V(+W)&+?j  y &ծ' (' 4#?=>!!>=? k@ L@ M L @I L @ M   HH H H ????9/?9/9/]9/////////99910+++++7##>7!#3#3#3[,,.oXX|"EjOfffESVy6M@,2 L2@ M$#3828,F7 72J36 $J#'J/J ????3210++#"'73254''667&&54>32&&#"3267,!!,-# ")$ag*Kg=!5( A*7+IS0?U7 ' ?  MxS+ b1R=jq a?>&(C@  PO++4?>&(@  P O++4?>&(i@  P O++4?,&(@  PO O+++446>&,C@  PO++46>&,@  P O++46>&,i@  P O++46,&,@ PO O+++44r)I@+/!?!!F+)D  *   &JJ ??9////]2]]10#"&'#53566323#232>54.#")Id< =#55*F :`C%LL &4 0%6VyL#f $Mwf 8M.(L:#.+&1u@ PO++4>&2C@ #!P"O++4>&2@ " P!O++4>&2i@ $ P!O++4+&2u@ . P-O++4,&2@"4P,O O+++44<F tM @ M MML@!M       ??99=//9999910]++++++''7'7{F}~G}}E}}E}G|}E~~D}}H}(@ M L@F LF_  @ H *)!"*!""!)*F)"!$J $J????9??9/////9999+]10+++46327#"''7&%4&'32>'&#"vi7'P"&8C@ PO++4'>&8@ PO++4'>&8i@ PO++4',&8@.P&OO+++44 >&<@ PO++46kD@(S Q 0 P  W W_o   ??99//]]22]102###362"32654&wy,{{  ' 2;<;fihjrkYk62036~@-!@ L @ L@ L@ L@ M@ M@ M@ M@' LS $SS 8@ M*Q-7'W2+W???]+10+++++++++#"&'732654&'&&54>54&#"#4>32"&"M^/73+"- &&{0J42E+!+1#"- MRf$; #,%*":3!/P: )5,&DC@ 20P1O++4,&D@ 1/P0O++4,&Di@ 3/P0O++4,&Du@  =/P32&&#"3267###"'73254''67., BeF*D#1&,;$IX?J2 !!,-# ")$ 1F-3ZC' c %4AJ e ' ?  ,>M&HC@ )'P(O++4&H @ (&P'O++4&Hi@ *&P'O++4&H@(:P2O&O+++44$& C@  P O++4$& @  P O++4$& i@  P O++4$& @ ( P O O+++44(#4_ L@. M2S###65*S 5$W'Ws!#/W??9/9932?]10++#".54>32&&''7&&'77&&#"32654& 0P<4M31K3,\D J=-m+ *) 0'3277&#"4&'326 :Q2 8&>)!;R0>2%?*01018[B$ 3/9 U37[A#3/9 R3 M? N;&XC@ P O++4;&X@ P O++4;&Xi@ P O++4;&X@'P O O+++44X&\@ %# P$O++4?[MSM@ H  Q  @ H W  W?????+]22++10%#"'#766324&#"326.F./2{{mt}23 (,*6[A$Fu?Q GX&\@%7 P/O#O+++44 &$@  PO++4,&D@ /0P1O++4 5&$a@ % PO++4,&Da@ 3=P/O++4 Vk ,@@$(!   .-% J  ?3???99?9103.'##6733267#"&54677  y d,Z*,W)  30* #?=>!!>=?0-ϲ : %6,V4CY@5 S)E9Q(E.EAS 0@PD@P`W<< OW# 45W ??99?]9/]]210#"&5467#".54>3254&#"'66323267'2675&&#"30*"-I4 6F&0%,6#AT-:M. & "$0 %5%;+)8"#/ c 1G, l  >&&$@ 1" P!O++4,&F@ !" P!O++4>&&i6@ 9$ P!O++4,&Fi-@ )$ P!O++4.&&b6@ 8"(P O++4,&Fb6@ 1"(P O++4>&&_6@ 9 $P%O++4,&F_6@ 2 $P%O++46>&'_@ "&P'O++4  Q@Q _ 0SH@ H  WW??????++]]107327&&#"#"&5463257#5!$ Y+_bPN(|P?P F qs r#@@#S%S $U!W0  W??]?32??22103##"&546325#53573267&&#"77#`0mo^[0{-3$*'gS qs IS:8?P F?&(@ PO++4&H@ &'P(O++4?5&(a@  P O++4&Ha@ *4P&O++4?.&(b@  P O++4&Hb@ (.P&O++4?Vk [@9  @P`@ M?" D !H@ H H??9/]?]22]+]]103!#3#!3267#"&5467?w  30*!kfff : %:V.9s. L!@>L/S" @;(;9Sp:O_oU///044W !@W +??]?]9/]]2]2]10++#"&5467#".54>32!326732674.#"30*<_C$&>P*hlL<%C  L "#  %3=Z<>^? {v .5g z#$?>&(_@  PO++4&H_@ &*P+O++4>&*i-@ 2($ P%O++4!X&Ji@ ,(! P$)O++45&*a-@ 1(2 P$O++4!X&Ja@ ,6! P$(O++4.&*b-@ 1&, P$O++4!X&Jb@ *0! P$(O++4Vy&* -& P+4!X&J$@ /*-! P$(O++4->&+i@  P O++47=H@LQ Q@ H W ?????+10+376632#54&#"''7?{*4F*{*! &\^&y 9O0B:9669_kc@= 0D @PD 0D  /   H H ????2222]q]222]222]3103##5###5353355#--|{--{kHc@cHHH]]@ M M M @ M @M M @ M @MM@;MHMQ/? Q W0 ???]??9////]2222]]10+++++++++++3#53573#6632#54&#"P77|&1A'{#S:OSB 9O0B:6+&,u@  PO++4$& u@ " P !O++46&,@  PO++4$& @  P O++465&,a@ P O++4$& a@ " P O++46Vk!Y L@- L#D 0@P" H H !????]2]10++#"&5467#53#5!#3#3267N30*!   %:fffaf $V 3R3 M2@& M355 5+Q(*T*42/U ")U+X ???]10++#"&546323267#".5467.55#533267. -- .  ',$-=$$0]$**$%**~ :35K/f+' e6=&,b@ P O++4$; M@ M @ Q  U W??]10++%#".55#533267&C0A'$0 5L1f*) $Lk?@ /?D`@H D J ????]+]]1033%#"&'732>53{M0?$#>$0!  |k>P.b*#7[+M@M&T  ?  -T  @ H ,Q?O_Q@ H,#X)WX ????]+]]+]]]_]10++3#37#"&54632"&'732653#"&54632{{0 // 0- 1 |Qb0 // 0և%))%&))e&#;^X%))%&))*>&-i6@ APO++41V&]i@ ,PO++4-Vk&. ޴$P+4?V&N ִ$P+4-*e@ a,$@,,@ H  0Q@ H+*#   ???99//9??+]22/2/3+]10!.'#3>73&&7>7 $&rr  *3$:-"  E#QMCkDDBDKP'"SXX% !4,)1Y/  ?'@Q   ????9210>73#.'#7%# .11:8/ ',-||/2/684CHH?=7G>&/@ PO++4$=9@ ?P S  P   W???]]]]10%#"&5#533267'7"1UN&%2c eadf-0"l>>ZGVk&/ P+4$V&O- + P+4Gm&/Y JP+4$&O  P+4Gk FT H@ HD 0@X H ??9/]+9/+10#"&54632!3!3 33 3{| h(**((**pk$8 N@0T@P @ P  !Q@ L/P X UW??9/]]+]9/]10#"&54632#"&5#53326783 33 3e"1UN&%2p(**((**| eaf0"k C@% D      H???99//9922]103!5'7377,c|l+$fZ26Z$>@%Q Q  UW???9]22]10%#"&55'75#5373267"1UN7(_@(h&%2 eapS/f R40".>&1@  PO++4?&Q@ PO++4.Vk&1 P+4?V&Q P+4.>&1_@ PO++4?&Q_@ PO++4 @ @L@L@M 0@@CM@ H!/?Oo`p/O_  ????99?]]]q+]+]q10+++!.'#33'6654&'{WK  X  E4_]b7wk'Z^_-k&.(%(G& &Q^6O+.YkF@M/ ?  DD@ HH  ???99?+]10+%&&'#33#"&'73265W(]5oc85-oGN $_`ek,gf`$}WXe" ?[5@ QQ@ HWW ???+]10%4&#"#6632#"&'7325>.{!a98J+IT )1B: 9O0VR_?&2@  !P"O++4&R@  ! P"O++45&2a@ $.P O++4&Ra@ $. P O++4>&2e$@&"$P%O!O+++44&Re$@&"$ P%O!O+++446>&5@ '% P&O++4Y&U@  P O++46Vr&5 ڴ.' P+4#V&U g P+46>&5_@ %) P*O++4Y&U_$@   P O++4(>&6@ 1/+$P0O++46&V@  42.%P3O++4(>&6i@ 3/+$P0O++46&Vi@ 62.%P3O++4(VyF~@L;@ M3@ M) M@ M"FB2H8F,@" H,G @PG36J/=J''/J ???9]+10+++++#"'73254''667&&'732>54.'.54632&&#"!!,-# ")$8E$K6) "*<1 qc9U$=(b'?5"ab ' ?  d  (;,Wb_G -C3Q]6VH@ 4 L3@LM@L2 S C@CPC`CCJ9S*@ H*I @0 HI33/33O66W/ @W%>// ??9/9999]]]]]++]10++++#"'73254''667&&'732654.'.54>32&&#"!!,-# ")$1G#O)-0#8.1L5.OH-/!!:/'?. ' ?  g    1%5) h   !3%/$Vk P@1@ LD!/  !H ??2?99]]]]]10+#"'73254''667##5!##!!,-# ")$ £ ' ?   ff$V`4i1@> M11@1`1116?##$$"%QP`5  50+W4%U" !????32?]]22]2]]10+#"'73254''667.55#53573#32>7W!!,-# ")$/ kk{ @  ' ?  *C2fvf  j >&7_@  P O++4$&W } P+4kc@ @ L @ L L@$ LD  H H ??9/32?222/2/210++++#3##5#535#5ۣ~~|}}kfccf$`%LML@M @ ` p  @ I  ' QP`p@$H&W O_oUO _ o  U ?2]22]2?+]333]+]10++++7#535#53573#3#32>7#".5kkkk{ "O%+B.TPfvfPT  j (I;'+&8u@ (P'O++4;&Xu@ !P O++4'&8@ PO++4;&X@ P O++4'5&8a@ (PO++4;&Xa@ !P O++4':)5`@$*o0@PD`70"/""D@ H6-''3 J ?????]+]]]]]10".5332>53#".54>324&#"326X6w'5 !5'n6X>!24 &' 43;&Xc P+44'>&8e$@&POO+++44;&Xe@P O O+++44'Vk,+@'D). .D-("J ????10%3267#"&5467".5332>53 30*W6}'5 !5'uDc;V'A@Q)!)`)QP`p@ H(  W ????+]]10#"&5467#".533273326730* :J+{-|  %5 ;P0A?q: >&:i@ -) P *O++4 &Zi@ -)%P*O++4 >&<i@ PO++4X&\i@ '# P$O++4.>&=@  PO++4C&]@  PO++4..&=b@ PO++4C&]b@ PO++4.>&=_@ PO++4C&]_@ PO++47  @ H Q@ H W??+_]+]1034>32&&#"!8H&'R!E9K- e%(Vy&6 ݴ81+$P+46V&V ߴ;4.%P+4Vk&7  P+4$V`&W$  ' P+41V%@DU W??]10%#"&'73265#5!1C'0R&&G"99M/h%2VfC ?10'6654&'C  W  .)&)D& p? M@ M M???9=/9910+++77p1YY3x;EE;zj,?10!!j [i@ } ?10".553326735'[Z'5%4!&&!4%A   ?10"&54632****% && %c+@M_ ?]q10+#".54>324&#"326c?+&&+?A\24 &' 43V\ @   ???10#"&546733267Z30*-$h  %C C&@????]10'7'7/y/znp1Fp1>&:C@ ,* P +O++4 &ZC@ ,*%P+O++4>&:@  +) P *O++4 &Z@  +)%P*O++4,&:@+= P 5O )O+++44 &Z@+=%P5O)O+++44 >&<C@ PO++4X&\C@ &$ P%O++4k@ yy??10#d]kkfy #2@  $}! %}?9/99]104632#"&74&#"326'#"&54632fMHGMMGHMY``YY``Y/::/0993Y }r V@ @ L@% L ?9/////9]22/210+]+3##5#56673T))T&M0%IrJMM@@e3c4 q|r@ M@ L@M M@7 M M 0@  }}E?299//]]]10+]+++++#"&'73254&#>73#|BS A&!:IGԉWC5C O $ 991Q  ;bss w@@M@L@LM@3L| `!| } !}?99//]]]q]10+++++"32654&'2#"&546366 8 C8!2"EGs?EPA=.-"OIcqP k}r ?@( @ M @ M M M L  s?29/10+++++667#5! 2($ X6VK=IT+jy)51M1 M/ȳM)@ M MM@$M L @ M6$*0 7@P@ @ M  67-3'!7??]9/]99////+]]99910+++++++++#".5467&&54>3232654&'74&#"66CN,8 !3"'4 !%^q/;# '$%#* )      y !LLM@@M M @M @M @M@ L #"p} }#}?99//]]]10+++++++++2676#"".54>32#'667 6 !/ !2"FFv~ECOC(+"QHbqO fmofqmqmY}fpq|fqbsgrk}fsjmtmu5!/4@%I 1 /0//R!!0}*??]2]21074>323267#".55'76654.#"(6&/ fT*-&!@+,<$; 9@  =Q.-6_F'?9 >-; *04yL 5+ 1a@@ M/(M@  3/?o/,,|2////_/o/////&??]]2]]]]10++7"32673#".54>32'4'&&#"3!25pD*,I ^6/Q<##?@A@@A>C|+&|p|18|C@B  !BA@ ? >%""%0 `  5));. ; ??9??]9///????]]/̇+}10+++++%467&&54>32#"&6673#54&'326'6654&#"# ''%6@3A"2?U#F  _d=E"   +0& V   |  kyBMZ^صH@M@L@"M@L=@ M$@L#@L!@M\^]^[\[\[`!|:)|6:6:6`_@M|HC||NU|`]_0B_^] \ [8830?`???#&,3QFFXK X ??9??]9=/????]+99//ԇ+}10++++++++%467&&54>32#"&32654##532654&#"'6632#"&'4&'326'6654&#"# ''%6@3A '< ' 840*"-3#F  hd=E"   +0&  9  6 )%+    |  kr;FSW>@:@L:@M9@L9@MM@M@LPM@M(M'M'M'LMMMMM@fLUWVWTUTUTY-|Y|A<||GN|YVX;9P88&XWV U T:92&#8*0#`###J??QD Q  ?q?9?]q?9/9?????]]]ԇ+}10+++++++++++++++++++%467&&54>32#"&#"&'732654.##>73#4&'326'6654&#"# ''%6@3A?-!,2*!`6#F  hd=E"   +0&0#!  =   " ?   |  kr%2AE@>@M> M>@ M> M:L@\M@M@LCEDEBCBCBG| ||&-|GDF8<:A3::_:o:::FED C B0A`AAA8;)@H) # 0  ?q?9/+??]????]]]ԇ+}10]++++++++%467&&54>32#"&74&'326'6654&#"%>7#53%# ''%6@3A#F   d ,d=E"   +0&)   |  "0)&?2)+4%kr +/MM@XLDT-/./,-,-,1)*|1.0+##o00/. - ," +)  0`??]9///??9????]]]ԇ+}10q+++6673#5#"&'732654.##>73##"2?Us?-!+2+!_?d=- 0$!  =   " ?ky >B2@M-@/M) M"@M!@M2 M2 M@L@L@L M M M H@SL@BAB?@?@?D-|99CD|DAC"#C o  3CBA @ ?/6!0"0"`"""   /??9?]q?????]]9/ԇ+}10+++++++++++++++%#"&'732654.##>73#'#&&546776654#"'6632%#?-!+2+!_)  ): '= $rd=0$!  =   " ?? #&   6(*" k y'HL4 L4@ M4$4 M M L M M L M M @XLLJIJKLKKLINF:|+N||NKMH@@o33M'MLK J I?((0HF70 0$`$$$??]99=//??9????]]ć+}10+++++++++q++32654##532654&#"'6632#"&'#"&'732654.##>73## '; ( 840*"-3|?-!+2+!_Qd=  9  6 )%+ 0$!  =   " ?kr -262@L0@M L @L  L @SM6434565563857%?""(221-*7 o  7|65 4 3"2(0&0&`&&&&!  ??9??]q2????/]/2]2ć+}10++++++%#"&'732654.##>73#3##5#56673%#?-!+2+!_$$P|-  3ed=0$!  =   " ??''-+L/@)kr(,@ @L( M@;L*,+,)*)*).|  .+-#$-|-,+ * )%((%!#@ M`###!  ??9/q??]+9///????]]և+}10+++%6632#"&546"326546673#5%#0= 51740=ka_ m"2?Ud= )'*449RP   ykr3>B@ =@L4@M!MLL@ M@4@jM$4B@?@ABAAB?D%|1D=| @ M  DAC30C7|CBA @ ?++31" 0@0`4 : ??9?]q?/????]]+Ƈ+}10q+qqq++++++%6632#"&546#"&'732654.##>73#"32654#0= 51740=ka?-!,2*!` ;d= )'*449RP0#!  =   " ?7  kr @^@M@ M@M@M@M M     0`??]9///??????]ć+}10++++++6673#5>7#53#"2?U8 d 1d=- "0)'>2)+4%kky,0@e M M @M @ M@M@M@M@M0.-./0//0-22/1|'!110/ . -$0` ???]?????ć+}10++++++++!>7#53#&&546776654#"'6632%#M d )  ): '= $nd="0)'>2)+4%? #&   6(*" k y'6:@3@M3 M/@M.@M M M @_M:8789:99:7<-1<|| 0<9;6(/;';:9 8 76 -/ 0$0$`$$$??]q99=//??????99//]qć+}10+++++++32654##532654&#"'6632#"&'>7#53# '; ( 840*"-3A d 3d=  9  6 )%+ "0)'>2)+4%kkr $ @L@nM @M M@M@M@M@M$"!"#$##$!& &#% %/%$# " ! 0` ?????]2????q/2]]3ć+}10++++++++!>7#533##5#56673%#M d $$P|-  3_d="0)'>2)+4%r?''-+L/@)kr /3@ ,@M, M M M @ M$ 4 ȳML@IM31012322305&*5|524/!(4  432 1 0/ )&( 00`/?]q????????ć+}10+++q+++++#"&'732654.##>73#>7#53#p?-!,2*!` d 3d= 0#!  =   " ?"0)'>2)+4%kk {"-1@$,@M@M M@M@M@M@M@NL1/./01001.33,| 302"2&|210 / . # )0 0 `  ?]q?9/???????]ć+}10++++++++6632#"&54633>7#53"32654%#1= 51640>e\ x d  :d=7 )'*449OP"0)'>2)+4%  kr'+ֹ&M@ LM MM@M M@M/M@MM+)()*+**+(- ||-*,,&|,+* ) (0`  # ??9/??]9///????]ć+}10++q++++++++%667#"54632#6673#527&&#"#0= e64(fg"2?Un_d=; P*4 )RM6  ky:>@ & M% M@ M.@MMMMM@MM><;<=>==>;@||`@=?/?|?)|5>= < ;+20`   ??9?]?????/]]ć+}10+++++++++%667#"54632#727&&#"#&&546776654#"'6632%#0= e64(fg`)  ): '= $id=; P*4 )RM %? #&   6(*" kr*/3߹M& M% M! MMM@M@MMM@MM31012322305||524" %/.*&4|432 1 0/"%`####+   ??9/??]22????ć+}10+++++++++++%667#"&54632#727&&#"3##5#56673%# 1< 5164'eg_$$P|-  3]d=; )'*4 )RM ?''-+L/@)kr3=A5M4M$M!"LLML @[MA?>?@A@@A>C%|1C6|C@B30B<|BA@ ? >*31"00`4  9 ??9/?]qq?9/????]ć+}10q+q+++++++%667#"54632##"&'732654.##>73#27&&#"#0= e64(fg?-!,2*!`id=; P*4 )RM)0#!  =   " ?] kr!+/@ @M M#M"MM@DM/-,-./../,1$|1.0!0*|0/. - ,0!`!!"  ' ??9/??]????Ƈ+}10++++++%667#"54632#>7#5327&&#"# 0= e64(fg d  bd=; P*4 )RM"0)&?2)+4% ky.9COSfBM/MM#M !LL#M !LL@@MN@MN@LN@L/NM@MM@LM@L/ML@ML@LL@L/L;@%M:!@MSQPQRSRRSPU<|+URTB|#T"M@FMo|///4|o|JD|TSR Q P: &. ?&G22 700`M ??]q9??9/????q]q++ć+}10+q+q+++q+++q+++++++++++++467&&54>32#"&667#"&54632#4&'32627&&#"6654&#"%#''%6@3A 1< 5164'eg#  {d=!   +0& )'*4 )RM      3k 0O@2@ M@ M@ M@ M.dd   2&d1t!!)tt??9/]10++++"'6632#".54>32&&"32>7&&-'<M`67[B'E38O1.N ( +# -6O _ ;a}B?fA6O39_C% HW*558$>T0 k@ M @M   H???9=/999910++36733&& ,Z*,W),(-ϲZpq(k(@ nn@ H??+]10###{{k4fk/@D `HH??9=/]10!!5667&&'5!!T,,+%O,`./\,**)CGFeGQ@BHDfA@> y'w!M!@H L@M@ L@M@ L) F0"""F$(%H#" HJ?????]]]]10++++++4>323#56654.#"#53&&)BU-,UC)$*Q"5 + + 1&T*%bKjCCjKB~326632#"&'&&#"32677/-3$.%%.$83$-&&-$7E  *P$#6%%5#)$#5%%6#)r 1[O M@M/? Q@ HW W??+]]]]10++46322#"#""&퀑[eF&[eF&ahk,$,ahm,$>6aka(=@%     r rO_?]2222?910373#3#'7#537#(@K)R1?K*U1w)Nf]fy)Pf],. G@) L0Pp @r ??]9=/999]10+%%!!-""]lddlf,- V@/L L 0Pp @r ??]9=/999]10++'%%7!!##]]&lddlf{ @ ppp M M @? Mf  M M Mi p ??9=//////9////]q9910]+++]+++]]]>7&&7&'66;764m>>m45n+./.+61VPJ$IabIHbS?I**F##F+Z@8 @ M T- Q 0@Q"!,W( U# "U X  ?????/??2]2]]+10!#37#"&54632&"#"3###5354>32rr+ ** + VVs55(A0և%))%&))A  fpf-J3 '|@7 @ M@ M  ) 0PQ@ M_@'' 0@Q@"H(W$U U  W??????+2]3]]]+]]10++.57&"#"3###5354>3209 r" VVs55(A0 *9"#)  fpf-J3frokykqykqrkYx}pkqr|qkbrsrkky}skjrtkxukfoqqY}pq|qbsrk}sjtu1?10#51OVP ?103#"&'52>5_=8# -0.; M ?10#&67mB>,JS=+( /?10#5/M^ +U +qq4/*#<q>*1?*m@*?^*?`*^| l7rr6cs*ct*^ x7Op|2d62d6Et 'i@B"@ M!@ M@ M@ MS)'Q!$% "(&%# W UW0 !0s ?]2?]????23310++++%4&#"326#6632#"&'#5357Y')$  -4-,D-8R4/a"77{BF ASI #AZ78[@# S:Or!.9G@%2J+J;9#R :8W#"9  9"&W ??9=/////92210"&'#"&54>3232>54&#'2654&#"#=% Z $A\9!~v"K,&::4("!*,K7gd .33&y0 F`@ H! JJ ??+]10"&'732654.#"'>32:X@0RJ,8)A +8 @eF& a qj=R1b (QyQ*MH#H#,F@H+$'J  J J J ???]+++10&#"3267#".54>326632&&#"8/?I$2 #2*I,9[@#(E\3!$<&!  li>T3a*SxNRzP' ,$^ ( +,)@%.S-%!W(W W ???1074>326632&&#"&&#"3267#".(!>Z9  1))    ./"BD9E*A\<3ZC'- Z1 %3@K g &C[rr*RMM@"M@M"F, 0D +H 'H?2?]10++++2#"&'#"&54>232>54.#"vr"=T33 Z 'C[<  &$ rXyK!  ("+6 !:O-%L>'k@@(@ L@ LQQS W WOH?]?]10++5!#"&54>3352>35#"Pn-P#|#A\:)=/8A@f dg7K,^'22/ 6@ @ M @ MQ S W W H???10++73267&&#"5!#"&546325/4$,(Nc"b/nq_]0?P Ff_ qs ~X*:[@<@L@M M LS5S @`<+S!;00 8W&W ??9///]10++++#"&'732>54.'&&54>32>54&#" 2'%-C+)L": / =D9P21R:!&!5**37871#3% a  %iH0L63I9*# $'(432?k R@@ M@ MD H @ H @H H H ???9/]++210++35!5#535#5!?wfffy'T'@ M$ M!@% M@ M'S@`)S ('H"W W??9/]210++++4.#"'>32#".546732>7c.=!<)*'EfC!zj:R4m;-)Y2E+ ` 1VuD1Qh6#aQR-;!y0&@L M M M%@@/H20@ M0,ccp1&)g"@00e" g ??99=//]]++]10++++#"3267#".5467&&54>32&&#"33~S4&!,,\!(*t<.VB(<)&$#:K)6g)*S'&747] "  f-H5:JK".A(_'#(Yk.@DHH J??]107#"&'7325!!3#%>- +2{.E/c?kff,@@%D.F((-J# J???9/]]_]1026632&&#"&#"326753#".54>!$<&! ! 8/'4 FD  {]B:]B$&D\y ,$^ :%44>1M44M1 k<@ M DHJ ??2]]10+3267#".5#5!$-0:47G*tw1( e  7H)Jff6kp@@ M Q0@PQ0@P  H H  H?2?9/322??]]2/2/2/10+3535#535#5!#3#36ZZZZfcffcf- xRD@ H! D@ H   ???9=///?+2=/+10!.'#37>32&#"] $08{{j!$ 6_Gm NNHk*  VB[?%^@! 0P`p' DP`p@ H&#W   ??9=///??+]]]10>73#.'#4632&&#"%# .11:8/ ',-|L[   1/2/684CHH?=7UP_>;H@ @Q  @ H  s  HW??22+223]10%#"&55#535#533#3267"1UN&$2 eaUfU0"*K@)*)( o,!"o+(sW%???22229=/9910#.'#>7&&''7&&#"'6632706-#  -03kb 0 1KmB-$QRN!$RRO@}th, &J# b (1'Jk& MM MM@ M@ L@AM$4R$DR 0R'(J! J????99//9///]]]_]]]10+++++++".533267&55332673#"&')4 d  d d-I+2 2H-F"%40'  YkV@6/?R@ HR   ????99//]]]+]]10!&&'#"&'732533c*c9 :- +1c85-oggw)C2c?k,gf`$}?[, QQ@ H  W????+106632#4&#"#?!a98J+{.{ 9O0RB:y !t@`p`p@/H"#/ ?  J H@ H 0J?]+]?]9//////+]]]]]]104632#"&2>7#"3.vimrtjms$  %#  $68->$%>-,=##=,-(@$Sd/S.J )J???1046326654&53##"&732>54.#"viM2i"'tjms}& '& &6((  *J P-O:"";N--O:"";N4 ,2@'SR @`.!S -*W$W ???]10%#".54>3266544'332654&#" :Q22Q; !;R0F2 f-201-2018[B$$B[87[A#"   *<I+?NN??MMy%9C@'HRy&0y:5J! J +J????]q+104>326632#4.#"#".74.#"32>"7&,,44`  $6$%6#   7`}H4Tk7(0 G`~II~`>T23S>?S33T[#7_@ R@ HRP3`3p3333 )0))R  @H 8 ??q??+q]]+]q]10%#".54>326632#4&#""'"32>54.H%;**9$%;*2 *2'`#     :[@""?\:7[@$ )G72=4:; 8-.9 9--9 r$M@L/"?""d& R @ Hd%H  H?2?9/+]10+2####"&54>""32654&;T6_`i Z 'C[a "+&r1O9oc ("+6 b,<66?[+1@F-&Q ,"W W)W ????10%#"'#4>32&#"62324&#"326.F./2{*9"!mt}23 (,*6[A$0A'`'4u?Q G6 &I@D (F("D@ H'#HJ???9/?+]102#.'##3624&#"3265V>!/74-% !*07{{ u<1 ?8r2M49Y*_^V"PYX%D1.1(y0I@' MF" 02,F@ P  1J'J J ??9]]10+%267#"&54>7>54#"'6632 6K$ "/='sq"4@'b(<$U9cq 2;*" )Zd _W3C- G_bW,;(  63o@ (M M M M@, LS'51S  4P`W,,"OW" @W?]?]9/]]10+++++%267#".54>7>54&#"'6632 (P"V=32&&#"3#32>7#".5gg3N7*B.8** "P,*D0pf-J3k-#f4( i.O;Yk;@"`  D WH??]]]]]10#5!#327#"&5£1+ OQffDfX^'"4@@MD$D@# t ????]10+".53326532654&'35F*s&%!3'f-=+G !>X6tN<>M   /= 6X>!)4 1@@ L QR "Q!W ????10+36654&'3#".5332679#f-;Y35C&r" %    /= }  ;P0A> l'<@#F?""`$$$)F 0($H#HJ ???]]]10#".5467#5332>54&'53#)BU-,UB)"+Q"4 + + 1&U+% KjCCjKA54.#"'66:J,ks>Q1|")"  "r*RzP!?Z8)8"7L-7R7k t| M M MM@. MD J???9///99//99]310+++++>32&&#"#5&&'3( )+7  ^{3M 0# X`\HKI X,k, L)@7 L M MLQ,,-) .))-."-, #&g ???9=////9910+++++6676632&&#"#"&'73267&&'89&  $/=)* 0;K"LSX)Oj"63 a0RMM*'?+ f*&ss.k@ @ L@ M L @f M@ L M` M@ M@ M@ L M@ M   H H@pH ?]???9////////////////10++++++++++++3#!!5667#537#5!;0j- h3 `ZZNb,R'fG,`8bfCӹ@M@ M@ M M@w MP        }OU  U ?2??]22?9/////////////////]]]]]]]]]]9]10+++++3#3!5667#53667#5!-Q&)?x"]|7"O3-fK?O-fk&Q@)M"S `(&'Js& &&  H???9///]10+>7!5!#".'732654&##++&  '.12D*y ;3) 'N17>54.#5>7#5!&&-*<$-# %C6 "! z "#"6%8R5d[ ,   E  f[ ! !/"'3#   %y(w@FM"@ L! M!@M! Mc  *)* c#)"g& @e e ?]??9////]10+++++3#!!&&445467#536654&#"'6632>,Bf8&I(/%)# ='h7#6632T2- '9'+Lg;{ [7#5332654.#"777->%5-*@-  r^~/"VU%z6^zHcIy*nxz6]LHqff=]tkCX5)?@+i "/5@0477767 @ HR@(P(((((#H#@% H#R0@P675231 " - % ??????q++]q+]9/]9]10#"&'66323#5>7#5332654.#"777->%5-*@-  g[~/!VU%z6^zHcIy HNP$]G0PHE%]tkCX5[)@A+j  !06@/@ M.@ M M155!87'H''@K H'R/7/ O  /.?._...R /O/Oo6342! " ,????????/]q]]q+_]+99//q10+++%#"&54>32573#5>7#53"327&7773JI+W  g[   }!VU%z t4Z@%HNP$]G0PHE%]S 1>0&)@A+jkR@9O _  R@ H 0 0RUJ ????/]]q+]103#332>53#W+#W(H;k# H2H/-V#o@.S  R_% `p0@PR@ H$S!!! J U?????]+]]q]]10!!3332653#"&'#"&546321W9& X);%+ ())(k-2C8J.%% %%7V+@ S H@Z H @ H -o+++++@H+%@H%@ H%##@#P#`##_o,%+@ H+S@ H ??+??+?]]]+++]+++qqq1032653#"&'#"&54632.57& X);%+ ())(:I*X +H-2C8J.%% %%,:" !( k R@4@H/?O  @ H     ???99//???]+]]+103.'#3372>53 WK^W"  W %D7:[Y^=wkkH"H1G/V +@ S&& @H@ HO@PH @M/ ? O  @H @ H @M/?O0@,#S)     ??99//?????]qq+++q++q++q103.'#3332653#"&'#"&54632 WK^W,& X);%+ ())(:[Y^=wkkH-2C8J.%% %%V'3@"'@M'@M@M@M.S (`((((@H(5@H@ H@H @H @ P `  @)H @H@ H@'4+S1$   ??????q+++]+++++]_q10++++6632#4.#"#32653#"&'#"&54632K-(7!W W& X);%+ ())( *D0&!(~H-2C8J.%% %% >&$_@  PO++4,&D_@ /3P4O++46>&,_@  PO++4$& _@  P O++4>&2_@  $P%O++4&R_@  $ P%O++4'>&8_@ PO++4;&X_@ P O++4'>%15x@OD 744556&, P ` O  6D6/444442/))# J ????]?]?]q]]]]]]]10".5332>53#"&54632#"&54632%3#X6c'5 !5'Z6X>!~G;&X@P -O !O O++++444'>%15k@G,,/,,&&&7D 7246  P  6D@P635/)# J ??????]]]]]10".5332>53#"&54632#"&54632''7X6w'5 !5'n6X>!(E5P;&X@#P %O O O++++444'>%171@M- M+ M'M%@M! M M@ M,&&&&9D 9628P  @$H 8D@P85743/)# J ???????]+]]]10++++++++".5332>53#"&54632#"&54632%77X6w'5 !5'n6X>!:.##.N;&X@P 0O !O O++++444'>%151 M-M+@M' M% M!M@DM M  7D 073556,&&&&&6D642)/# J ??????]q]]10++++++++".5332>534632#"&'4632#"&7'X6w'5 !5'n6X>!P5E;&X@#P +O O O++++444" M M M@@ M@ M@ M@ M@ M @ MO  "S @P$Sp#  W W??99//]]10]+++++++++%#"&547!4&#"'66323267&=P*il0K<%D H-<_C$ #/->^? {v.4h =Zm$;' >&26_5@M2M2@&L2. M. M.., M, M,,(M(@ M((&M&@&M&&" M" L" M M M@ M L@f L-'_'@''8    78567!!!P!`!p!O!!755330**$H ???99//?]?]?]]]]]]9////////9]]]10++]++]++]++]++]++]++]++]+++!'##>733.'#"&54632#"&54632%3#g-,,,++  y $"!!"""""{{[DDX#967!!769~G,&D@4;PIO=O1O++++444 >&*&M&@L" M" L M LM@AL    +,(*+!+))'$H ???99//?]]?]9////////910++++++++!'##>733.7#"&54632'3#g-,,,++  y 0""""{{[DDX#967!!769~G,&D@;<P=O1O+++44 &G@ IPO++4& @ PQ% PRO++4y)&@M L@ L @ L@L@M@M@L D&+F*s    !'J!J ??99//922]10+++++++"32675#53533##"&54>32&&('7#?<HH{--X=m'D]5"5'!9 9O0oi[ZBBZOyR) b!X/@)@M(@M(@ M@ M @?L)*&Q1 0  S 0)}((P#`#?##W((O..W @W?]?]99//]]32]]10+++++3##"&'732>55#"&5463232675#535&&#"55jw*L#=,' (WZ{iJU%( GG  b,Psn h # tgtr:= GPK>&*_$@ )$( P)O++4!X&J_ @ (,! P$-O++4->&._@ P O++47= \@4" ! Q!O@H   ?????9=///+]?]?]10>73#.'#75'77%# .11:8/ ',-||&^\&/2/684CHH?=7e+`8668Vy 49@!+F@`66!F 50J&J ???]10#"&5467&&54632326732>54.#"Z30*[_vimr1=  & '& & %3[lD, -O:"";N--O:"";NV&2?@&-S" "@"`"""4 4'S30W *W  ???]]103267#"&5467.54>32'32654&#"=  30*-I4!;R01Q; ,7-201-201  : %3'AV57[A##A[78K9.?NN??MMV&B@ 56 P7O++4V&C%P+44>&_@ '+P,O++4[&_@ &*P+O++41V&]_@ PO++4r"/`@;!"101( (( `p1/@H/@ H/ 0 !/ % ????++]q99//910#"&'663273#5>7#5332654.#"->%5-*@-  r^~/6^zHcIy*nxz6]LHqff=]tkCX5r"/~@ 01010 @ !  1(@3H(( `p1/@ H/ 0" / % ????+]q]+]]99//]10#"&'66323#5>7#5332654.#"->%5-*@-  g[~/6^zHcIy HNP$]G0PHE%]tkCX5 !0l@E . 0212 0 @  20''O'_'o''1! " ,??????]]q]99//]10%#"&54>32573#5>7#53"327&3JI+W  g[    t4Z@%HNP$]G0PHE%]S 1>0&>&* @ &$ P%O++4!X&J@ *(! P$)O++4k!s@/?@HR#@ HR   R  @H "    ???99//??+]]]+]]+]10".55##335332>553T-4RaaR`a 7 !>X61k}-<$%<-6X>!6[r :@$S` D 0 HJ??9]]10#66325>54&#"{#`9yp+NnC&?.92! usJy`Kt0AW<7C.>&1C@ PO++4?&QC@ PO++4 >'37%@ M M@1+@M@LM(`/?9 8"#9"##"89468. 8+#H?1157???9////]9=///99]]]10++]++!'##>7&54>323.74&#"3267'7g+(&!  &'*  y   6V~@!! !AT#967!!7699/K,>&D@  <3P+444 >&G@ RPO++4&@ RP% PQO++4>&  +) P+4&P+444 =&$@  POO+++44,&D@60P5O1O+++44 .&$@ % PO++4,&D@ =3P5O++4<=&(@  POO+++44&H@ -'P,O(O+++44?.&( @  PO++4&H@ 4*P,O++46=&,@  POO+++44$& @  P O O+++446.&,@ PO++4$& @ " P O++4=&2@ '!P&O"O+++44&R@ '! P&O"O+++44.&2@ .$P&O++4&R@ .$ P&O++4,=&5@ ,& P+O'O+++44O&U@  P O O+++446.&5@ 3) P+O++4Y&U@ " P O++4'=&8@ !P OO+++44;&X@ P O O+++44'.&8@ (P O++4;&X@ !P O++4"Zy0W#@. L"@ M "%cc@%%2-1 e@  " "*.g*g??99=//]]10++2>54&##532>54&#"'6632#"&'7w0R="ZL:. 8)B.#E*&T41T>$..<9;cH % /;$7'D9k (14a2L6.Pb8Id=kKZ&S @M M@ Mcc ($'eg#!g ??99=//10+++2'>54&##52654&#"'66.M9 )0388bL-UD)F3C>%&?4E'<*#BL3&+_@  PO++47=H@+Q  Q 0 W ???????]]]10376632#54&#"'77?{*4F*{*! &^\&e 9O0B:`8668-[y,@ QQ 0 W???]]106632#4.#"#-%i>=P/{$!({] #R@/39|@/R@0''d??! 0""W ?,,W }<6} ??]?]??]10%632#"&''7#".5463257"3267&&32654&#"p+!+'> S;d'';)PM/i &  $ v'2%8%/3Y8o#?V3s (3!7'  r#"" k-AZ @5M8S`++C/?S`##(C 0S B.SB/?J=3J ?]??]]]]10+"&5467.5467332654.'3'32>54.#"hw;/ u!!u /;w$$$$ c]@L !%%)=%!,88,!%=)%%! L@]c# ## #(4} M@M M @ M M,F@`6/?OF@ `  6 &0&@&&F 52F5#/?J/)J ??]?]]]]10++++2654&'3#".5467&&54732654&#""}#.84 :R33R:38."}"-38((7266P*#I&9Hh91Q9!:P/9hH9KG*P66?69??96?.Yk \M@/L""! HH ????9/////]]10++!#"&'73255!5>7#5!+H>7 #;, +32>I,Btia/W/D-V:G+_l~JfC[NM@" M    U U ?????99//10++3#"&'732655!5>7#5!4==ގ / 664]|?NU$zWK&PMFf .&$b@  PO++4,&Db@ 17P/O++4?Vk$i@C@ LO_"""?&D%  %"H@H H???9/]?]]]]]]10+#"'73254''667#!#3#!#+!!,-# ")$ w ' ?   kfffV/:O@-0S $@$$,<%:Sp; ;/:s%%5W +@((W ??]?9/?]]10#"'73254''667&&54>32!32674.#",!!,-# ")$]h&>P*hlL<%CB&) "#  ' ?  wg>^? {v .5i ##$>+7;$7M7@L3 M3 L1 M1 L-M-L+M+@L' M' L% M% L!M!M!M!@gL2_,o,,,,@,,= F`=o::8<  P&`&O&&<F<::95/////)#####J J???]]r?]]r?]]]]]]]]10++++++++++++++++++32>54.#"4632#"&#"&54632#"&54632%3#& '& &}vimrtjms"!!"""""")H55G))H55G)~G&R@%, P:O.O"O++++444>;?8` M1 M.@&M* L*@M) M)@M( L F@@:HA><@ .@F@/>>@H>==83.---;%%%J J???]q?]q?]+q+]10++++++++32>54.#"4632#"&#".#"'>323267'3#& '& &}vimrtjmsj  1  ")H55G))H55G):  '   [G&R@. P>O-O+++44.&2b@ "(P O++4&Rb@ "( P O++4>+/+M+@L' M' L% M% L!M!@ L F@, H1./0 P&&0F0..-)###J J???]]?]]+]10++++++++32>54.#"4632#"&#"&54632'3#& '& &}vimrtjms""""")H55G))H55G)~G&R@,- P.O"O+++44 &<@ PO++4X&\@ #$ P%O++4$[&H @' H `(&Q' ##H??9///]+107#536632#".'732654&#";k 1$UG)!I  \v5f $9'NLN "! [$00M.L M@ L 00@: Hy$$$$$2+++|2Oy1}... U (} ???9/////]]]+]10++++%632#"&''754&#"#663232654&#"p+!+'> S;u$# ' iY53B% v'2%8%03Z8B8 9O0#"" $[`*@`/$$$$$Q_ @_ @,*QP`pP`p+r''' ! ??3?9//////?3/222]]]]]]]10%6632#"&''7#53573#32654&#"  3(UG0HCDkkk{  {$9'NL0!H@vVfvf "!  .;[@;@$P$$=+/?y:3257632#"&72654.#""3267&&&8% .`.$8'(9    3 &C\54Z@%$AY45\D& URP2'-&2[!.:Z@;@4P44 32"327&2>54#"&'8$. `.%8&(9    3  &C[55Y@%$AX46[D& TRP2'&1 F@-   ! H????9/9329107##6737#'#'37&&&&'$,Z*{8&&I"}N46d $.<-T v NGC*S$/k M@8 M)(0@""@01%F 0(+J!J ????99//9]]]910++"&''7&&54>327&&'3267&#"(O?A*Kg=  Q$0?Y~ 7+ QV&jMxS+KJb c aF9V1R'#%.^@:  M)#/ *0/ `p_   0&S"/!W* W  ????]]]9/9910+74>337&&'3267#"&''7&&77' DhG H!U DM3#FG@}O#0 3ZC'A8 c   e HItK#7$0k 5@  QU U????]10!!#53533#3PP{bb  C@%@M Q    H?????9/9910+7#5'7#57#3D{^C::kP-R-f[$[DN@-=@M,5FS&FS P??E?418!@W+OW ?]?]99??]10+72654.'.54>32&&#"##3267#".'7-0#8.1L5.OH-/!!:/3R<&  7 #7-'(,#*+(]    1%5) h   !3%0"\!**(\ C[!=@"@ M"! # "U!  J???9/////10+327#".##5>7#5!8CD!4// 1 !4-*/9$ 664]|EW`( -+!d%+%K&PMFf7x#!@ F%Q$ g??10!#5467>54&#"'6632|4#& 7&*'" (,b05P6),$:G) b0>",S  '<%%@ S'n&W ??]10!#54>7>54&#"'>32|%*#M ' '28ch $q)! b JD'  r+8v س M @> M @ M/F(F`:8D D 9@,,H +    +4J#J ??9=//////]]]2]10+++%#"&'5#536632%3#32>54&#'2654.#"#>R0&S)>>!O&AR.+$?-BB  "0)&)   8K- O} /:,DN))O0#-'f)$k! M L@ L @ M @ M@ M@ M@ M@= L D #0  D   " r J ???9/3322]]]2qq]210+++++++++".55#53533533#'2655#6G*++{{..,I5& !>X6DbbD6X>!k=N;327#3267#"&''7&&77"&#"3&&'7&?P*G69 %BY3#D=; "   >^? E@nU  V l KFtvb$'KR =*k:@D @r H J ??9/3]2103##"&'732655#535#5!HH1N99M/5*3ww?xbG-P<# b3E@bf1V'w@'@M@M@M MMM@$MT"(DD(X%sH J??22?10+++++++%#"&'732655#535#5!3##"&546321C'0R&&G"9OO. -- .9M/h%2SUfS$**$%**Y y0*@'F2F1"J  J,J???1046323267#".55#"&732>54.#"ladj  " )4 .dj}  6-"d,?)-O:"";N--O:"";N[,*@'Q. S-#W J*W ???1074>32327#"&55#".73267&&#"7P4-b  ?B/,A-}&&" -.6[@$ B#gEQ #@[4AG Qr%N@. @ M D F`  '"D&H## J??9/32?]2210+2#&&'##5#53>4&#"326]q,3#" 4#{HH))'_-$ 0+rch6X?EE7#5!#".'73254&##&'$ z ")+!:*~p0/*P#pC@(+-*fK+25-<%ca a a5/i@    ?102#&&#"#54>5'Z['5%4!&&!4%O@ ??10'''>l6zgl6z+pC+pV>#+@$$ !?]10'7#".54>324&#"326R#    8  9/K! !! !m  >@%o0 JJPJJ ??]]]]]10#"&54632#"&54632%3#"!!"""""D~G n @ J  J ?10#"&54632'3#3""""D~GJ-@J  JJ J???]10'4632#"&'4632#"&k9x"!!""!!"*J7@!JJ JJ ???]]10'7#"&54632#"&54632tx8jr!!!!""""ى*J JM@"!H JJJJ ???]+10+#"&54632#"&54632%77!!!!"""",UW-Gk4AA4ro > M@ M /?  ?]10++#".#"'>323267'3#  1  b  '   [Gi=?10'7i>>Zw}=?10''7}&\^&9669_w}=@ ??10'77&^\&`8668M> C@*JOOJ@  J J?]?]?]q]]104632#"&'4632#"&7'5"!!"""""V-^P5EM> K@2 J//?OOJ@JJ  ?]?]?]]]q10#"&54632#"&54632''7"!!"""""_]-U(E5PM> j@JJ  O _   O_J@P`JJ  ?]?]?]?]q]]]]10#"&54632#"&54632%77"!!"""""%1/'V:.##.N?>&(C@  PO++4?,&(@  PO O+++44k#Z@9@ M@ M@ M0   F D!"$ JJ !OH?]?9/?]]]]10+++#632#"'7232654&#"##5-K6'@- #%9.  {Pkf1I0/J4d&/8+f$>&:@ ; P O++4y"3@ $FF#WJJ ??9/10"&54>32&&#"3#3267(*Kg=!5( A*2*MH0?Y MxS+ b$<,oPU a(y66k,6,&,@ PO O+++44*k-k+R@3@(P((- /?@Ho  ,}++ s #} ????9/]+q]]10%#"&'#'667>55332'32>54&#-54&#-&.@ PO++4.>&C@   PO++49&@ &.P!O++4-[k >@& D   D 0P P H??3??]]]10!#5#3332r{{k k$6kDF@ HD @ H J OHJ ??]9/++1032#"&'!2654&##.8[@#}v#\-_6=@A*"v0M8gf af^.36*6r%$k 5@D  @H HH??2+]107!#3!5}gffaff[k@ M M M@ M@M@M@M@M@DP@5 H 0 @  O/?OH H  H????2?]]]+]]10++++++++73>55!3#5##3$ F#rr f-u}z0<?LTOE?k( k-d@: $*-%.%%/.$** ?????9//////?9///9992221053>73#.'##>7&&'p  `  g>-)#g ` g#)*Ak&A;9954&##O<<23'$ ,'d39R5,'3;:cM0k-) ")/&2 9Gbs+&&# c0=*IT4"D6"c  *..k<@ M D   D@ H  ????99+]10+33>73#.o-58co9a,k#_hg,gl.8&@  PO++4-k.k)@ D 0  D   H????]107>7665!### F{Z1J6] !)Bǀ:zrgO2k0-k+y2-k4@D 0Dp@ HH???+]]10###{{kk6r3y&k7k E@'@M@M!"!" "@"`" !H ???]9=/9910++#"&'73267&&'3>7'#!-18!5$ ,Fp#=&kKudZ/;N. h,8uUFN,TJ> @  M MMM@9M M@P R@ P  s s?22?22]]2222]10++++++4753#5&74&'66``b!.-"!-,"LAAGF@][\=@Z^ k;-[k _@)@ L8 M@ M@ LD 0 @  D@ Ho  H??2??]+]]10++++%3#5!333#r{|fk-kF@  D 0Dp@ HJ@  ??9/]?+]]]31032673#5#".553 $ '{{,,I5{&0 -4YEk 9@!o  O_o H??3??]]q]10!!33333:aR`Rak[kY@:/?O   p  o 0   H??23??]q]]]qq]10%#5!33333`aGaG`fkk7@F@ `  DJJ H??9/]2]105332#"&'232654&#1P9 ";P."O&{+230f1L66P4 .67-"kj@, H/?R@ H@ P 1   R  @H  J J ??9/??+]]]]2+]+10%#"&'332'32654&##3L/@$="` a\&"--?``54&#Յt%T-{1*I8ij `f $9/*y$9@ F  &%J J ??99//]210"&'73267#53.#"'>32:S@0GN(/*A *7 =cG'%Gf a \Io0<# b )QyPJwT.y.e@ HR%@ HR  0R@H/*J H  J ????+]22+]+]10#".'##33>3232>54.#"#6#>aa?$2!%6#   6`}IAnTkLe;I}`>U44T>?T44Ur$:@ D&F D % H"J??9/?22]102#5##>7&&54>335&&#"'(,+{@#= !$%3+!>V88? 1<r9o<EE?X64M2-1.,D(.`@ M M M M M*S @ H 0 S/%W-W0Pp ?]??]+10+++++632#"&54>766732>54&#",[N732&B1!7K*td$FjE9! %'"G 9:9U832 ,&*KJH!& ) :21++123J/  h`5T[#/#0 &ASY(@ Q00U ??]]]10##!|fpz]@ M Q@) H /? /?OU  U  U ????2]]+10+73>5!3#5##3%1#rrf$\bc+솆EFC H+s@A@PR))$# #)  )#,-) +  + $  ??????99=//99999/////993]210>73#&&'#5#>7.'353+ g !#<g*!`"(g "" g `2443575A oNMn%CB=!74344130Q@/(SS2$1@W?%O%%%%s" "0O--W ?]?99=//]]]106632#"&'732654.##532654.#"@"N3'F5 "'&!7J)2_$S5,-jj&*K  4�7+(7"e ] ?<@ R 0Rp@ H   ????99+]]10336673#?n N8co)')@J* #BDK,?&@ PO++4?Z@ QQ@ H R0Q@ H   ??9=/99??+]+]106673#.'#3#I,//96- &,.||!*b)8:6AFF?=7!@ QS ???]10'667>55!# -C0#" 4{p+WRH7"f"?FG6*p L@E M@ M  0?  ???9/////?9=///]]9999]10+++>73##'#>7 f qKZJq uss=L:|{t1; 9@ QQ@ H U  ????+2]q310!#5##3353{{{{ֶR?B@Q0Q@ H0U ?]??+]]]]]10###|{*p?[S,F&+@ Q@PU  ???]]10###5!ϗ|ppfX\[ 't@/' "0"@""""R  ? O   0@R@H(I' I I I?????]+]]]]]1036654&'#5.54>757*%$+`$,,$`/C+*C1`&A00A'xO==LJEFH'=S0-N>(9T89T9 [?z 5@ Q Q 0P`p  U????]10%3#5!333#r{n|fp+,@ Q S0 W  ??9/?]10326753#5#".55! ||*''E4֕*'A2  S@_o p/?O_o@Mp   U????]+]]]]10!!335333LaI`Iap z @M L @I L / ? O o  _ p_o 0p  U U???]q]]]]q]]10+++!!3353333#a>a>a#`p K@1@ MS @`" Q!WO_oU @  W?]?]9/]10+%4&#"326'632#"&'#53Y+$   -|(!%@.4H(7V"P˘!l)=*/=$cf"#]@ 0@y@ H`p@%@H$ @W  !W ??9/]??+]]+]106632#"&';#'4&#"326/%-;$>!```   !/'>+0=$ *#~"6!?S@ H# Qp@ H"W! W??9/+]+10%2654.#"'6632#"&'3 &+$% N/'H8!lZ7#53&&#"'6632&C^80T0B#2+R3%6,R&9_D&<]?! e  #]2* d !?[*m@$ ;K/R@ `  @ H ,&&&@ H&RR+W!W  ????]+]+]_]]10]336632#"&'##%2>54.#"a;FK*:#%:*JE;a3  ֵ[f"?[:8[@$l[[ 9--9 8-.9 "@@$"Q$Sh  Qo#U"" W ???9/]22]]107#667&&54632#55&&#"33.9,!mh43/{ (6( E*P-:f#;)NU 8!&HC@ )'P(O++4&H@(:P2O&O+++44[)i@C@ L"Q@ M@ H+  (Q@ M_*)W%W  s?????2]+3/+]]+10+3#53573#6632#"&'7326554&#"P77|&1A'ZV 1%#S:OSB 9O0]Yg+$B:Y&@ PO++4' P@1 `"@"@S!@W_oU O  W ?]?9/]]]]]1074>32&&#"3#3267#".' DhG+F$3(HL QIDM3JiC 3ZC' c 2*]-1 e &BZ6V$L$& @ ( P O O+++441VM+P@1)@L_%%%,}"" U W)} ???9/]]]]10+6632#"&'#'>5534&#"326. ??*8:3<<Q  &TI,;$ yOb:a-C/#'&.%q@3O_/?Oo/?O @ H&}   #} ????9/+q]q]]q]106632#"&'5##33534&#"326. ??*8:QWWQXQ  &TI,;$ ֺ#'&?& @ PO++4?&C@ PO++4X&\@ (0 P#O++4?z H@ Q0   QOQ@ H  U????+]]]]10!#5#3332r{|p*,<@@&-F #@#`#p##>F7Fp=2W :J(W ??9/]]1074>7&&54>322667#"#".%4.'326 5+$)?,($! #R&  -!;F9Q12Q; :$#5**38:79)3%[ "'gH7Y>!;VA*# $((DCB Q@1S0@ Q !@W @ HU W??+9/]]]10%#"&'#53533#32232>54&#wi#Q,CC{+ !;-ij f99f_f $9/)P@S 0@$Q* @ M  W!!W  ????9/]+]]1053573#6632#"&'2654.#"C{($A2aR9c1! z\\K&?.SK l ly 4bL@4L%F@`60F5((-((- J  J??9////]]]]10++4632#"&"6632327.2>7#".#"vimrtjms$  %#     #6x.?%  &B0P)8!  #;*#4I@(M'S @`6-S 50$$0*W W??9////]10+%#".54>32"3267#".7267&&#"6632 :Q22Q; !;R01Q; ..(/t -,&0  8[B$$B[87[A##A[F6A6.  "3<2+   t#H@' M@ M   % $J ??9/?9///99910++#.'3>76632&#"  0+" <0-#5 3U^vUE1047^TP+R@G! 5@ M "!  ???99//999910+#&&'3>7>32&&#""Ah'Q%   -!+ S_BY&VWR""523 , a.W9*f @; M ,   +,&/?O 0P+%"??????]?]]299//]10+33>733'667#".'73267.o.69b$;54.#Յt%B.55|GGyz*"/hf b::bCa$' 'v@<Q @ `  )$Q/(@MoO!_!o!!J@ H @J?]?9/+]2]q+2]q]10#6632#"&'#53532654.#"N+%D5eW:e355|Q!% ! 4S1&?.SK RS55 l6r$[@7 %&"F`& 0D%J   OJ?]?99//999]]9102'###>"3263'7654&v# 9S<1,{-., ' 2 'R# ?ran8P_.gckC/<"7*?["M@-S@`$#!$ #$Q# W W???99/999]10#"&'#66324&#"3'7690{"c0mt##3S63 '*R(  l qCg W-J?Q J/F$ 0D @H H H??2+107353#3!5}rfvaffYD1@@PQU ???]]]10##353|spn$kB@"   Q @H H H?22?]22222331075#53!#3#3!5}YYg솆fbfbff /@Q s OH ??]222310#3##5#535!tt|GGfpzSS-Yk"L@/S  $!QO#@W"@PUH??]?9/]]2]103!!632#"&'7232654.#"-""6Z?#}  MM$5! kf DjIeOa4F*?Z"H@, 0W $"Q @ H#WOH! W???]9/+]]10#632#"&'732654&#"#!%$1M62O7 5.6= " {YpW 733#5#.'##>7&&'p  `  g>-8W ` g#)*Ak&A;99733#5#&&'#5#667.'353+ g8&"/W*!`"(g9'" g `2448f<#L' oNMn%>54&##532654&#"'6632!!,-# ")$-`*) ")/&2 9GbO<<23'$ ,'d39R5,'3;+J8 ' ? c  *.e+&&# c0=*IT4=3&3VFa@7*Q;>QAH H3&GF2O//J6$'>'>6@P`J??]]?99=//]?]10#"'73254''67&&'732654.##532654.#"'6632!!,-# ")$)KS5,-jj&*K"N3'F5 "'&*9! ' ?  e ] f  4�7+"2"-[kF@' Q  e???9??]99//10!.'#3>733#5L %-1{{*' $-5-O"+r#QMCkDDBDKN%+{B?zO@. @ L M  D   y????9?9/9910++!.'#366733#5? %%||;*,,B8r?=7ֺ*f*684V-k @ @ L@ L L L L @@ L@ M@ M !"?O O/ !  ????9]]33/]2910++++++++!.'#5##33536673t!D%rr%D=}%0(''0F>:$k6BGOR'!BMZ7 L L L L@4 M ` Q   ??9=/99??9///]9910+++++>73#&&'#5##3353 O*+% |<&E{{E/003p,@GH 73#.'##53U{22'"&/594* (/{::GV"9;A*#JKI"NW[*#KJEV"W@5" L  $ 0Q #   ! ????9?222]33]]10+3#>73#.'##5353CC+% ,38;9/ ',-|--|Ay120675BHG?=7A(k=@" DP H????9]229/910536673#.'##8C@2,# !${f@<9YPX\*#QMC@@# `Q H  ????929/]9910>73#.'##53 &+.40) #%{M23/684AKK?=7pf-[kJ@   Q Q 0@Q@ H U U?????+2]]10!##33533#5:{{|#rk;zj M M M @, M Q  Q 0p U   ????99//?]2]210++++!5##33533#54~{{~{$rֶ-k   M M M@ M  0  D / ?  D  @ H    H??/99//2???+]q2qq2210++++qq####335Y{f{{fkfk; N@? Q  Q@P@ H U ????99//+]q2210]##5##3353M|c{{cpֶ$[k&\@;P_@ H(@ H"#P&`&p&&'$""! /??99//?]+2+]]106632#"&'7232>54.#"###' JP'>.   aB`kAhI(\+G5:J*k$[&[@P?_(@ H"#&@H&'$!"" ??99//??++2]]106632#"&'7232>54.#"###' JP'>.   aB`ִlw5U32&&'.54>32&&#">54.#"" '<*&7$'<)9)Cf 4O6 CeE'!-.?&     6Ki160WA' 5E&)NC3 #eXC5Tn>BwY5 d#;N4!*0%*8|/< M@O M@M@M@M@M,/>00@8P88'>c=,:J"33"@M@MJ /J??+2+9///?2]9/10++++++&&'.54>32&&#"&54>32'>54#"P{#3N3=[<#<%'5 60<2&!1!;& *@8+@R/.XD) e(2f#/D-"3$70&  0(Vy,V[k 1@D   U U??]]310#3#5##5ۣDsMkfaf&z -@ D H ???22210#3#5##5!ϗXrbppf k<[:@Q  /???9///9/99993210#5&&'3>7&^/{.W%    ց^^~'YWP PWX( kMMMM @:MD D_o_o  ??9////]]9?9=/////]910+++++>733##5#53&&'3  %).x~||u4P%8PFNP 2][[/RR^bH[u@ @ M@ L@M@ L@. L   DD   }?????99=/////9910+++++3##5#53&&'3>7 M'Ml{oR&H    lURRVj'YWP PWX( [kK@)    ???9??99=//9910!&&'#>73733#5R51 $+0Td{">,r3|>;3LX]+$8w5zO@*    U????9?99=//99210!#&&'#>7'3733#g3*} $(+Z\}20`3P (K0=?>䓓 J$^rH@ DD@ HD 0  HH   r?2???]+]10#333#5!#5Er|#{FrnsnzH@. @ L @ L y yy r   ???2?]]10++#53#333#5!YGGj#iy]]p-[kFQ@ H Q @ H S r???9/?++210!#5#".55332733#g-!,G3{ !|#r4YE&0 -+zr@ @ L/@?MM M@ M/Q_Q0   S r ????9/]]]]210]++++]+!#5#".55332>7533#U-*D.{*|#r'A0"kG@)D 0  D J???9/]]]10%#5.553536673#5D)D1{ D  {{ `i5V?:7nr1-o@*@Q      0Q@ H WO     ???9///]+]]]q]]10%#5&&5535326753#5#ESX{0E ||!JKJZ/ KN*6k<@D 0@ D @ H J   ???9/+]10%4.#"#36632#U $ '{{,,I5{%1 k4YD?K y(/|.@( L*@M*` L/@ L)@ L)R(1@# HR0/R0@//H O,,J  J ???]9/]+]10+++++3267#".'&&54676632'4&#"3?0 ")4L3HBT UI3A% d$ dZ V -Ol? Q7 '}6Se.&`XLZJ %,@7) M'@ M0 M+&K&&&&S##[$D.,S  $  @H -,sM))W   "W??]_]9/+q]]]]10+++"&'&&54676632#32674&#"Q\fI7\X8QT#+1"$ lkI?   \^{v  ) ` #3580 y+2i@A@ M,@ M?,O,_,,S(4 2022S 3 R3 2U /0//W# W ????]9/]]+10+3267#5.'&&54676632'4&#"3?0 !`"2!HBT UI3A% d$ dZ V u 5J[3 Q7 '}6Se.&`XLZJ (/r@I/)?))S_o#@ H#1S/S 0'R0"W&@//U&O,_,o,,W   (??]]?9/]]+]]]10&&'&&54676632#3267#4&#" ;AI7\X8QT#+%a^"$fUI?   \^{v ) ` x35806k, 9&@ 3;%P.O++4&@ 19#P,O++4-Yk%T@0!F' &'DO&@P`J J??9///??]]9/9910"#36673#"&'7232654. {{2b'-9A"[krv  BC$5k:{97665!3'667##$##:55!3'667# -C0#" 4$>3J" %p+WRH7"f"?FG6K-.7p-[kR@0D Dp@ HH@ J???9/]?+]]]]310#"&'73265##335ZU 1#{{k]Yg' k;[L@ Q0Q@ HO U  W???9/?]]+]]10%#"&'732655##3353ZV 1#{{{]Yg' ֶ-Wkh@)@ L@ L @ L @ L D 0 D@ HH@   ???]??+]310++++3'667###335#:3J" %{{{mK-.7ֶ-[kK@-D 0 D 0  J ???99//?]]]10]]%5#".55332673##L,,I5{ $ '{Lsfi4YE&0 - +zP L @% L@H  Q Q0W   ???9/]+10++326753##535#".55! |brX*''E4֕*4'A2Wk#@^L L0Mo@ H% @ H %$%$% ####$ H$ ?????9///9+]q/9=/9999+/]+]10+++>733'667###>7 e $;733'667###>7 n %<4I# EY:q HSX((YSH`[L-.7L :|{t16k -@ Q0 H H??]10353#5!#36fffaf 9&$@ $ PO++4,&D@ 4<P/O++4 ,&$@+ P#OO+++44,&D@ 1CP;O/O+++44 k?9&(@  P O++4&H @  +3P&O++4y#M@0# S @%Sp$OWO#_#o##U  ?  W?]?9/]]]]10%#"&5467!4&#"'66323267&=P*il0K<%D H-<_C$ #/->^? {v  .4h =Zm$;',&@ *<P 4O (O+++44&i@ &8P0O$O+++44 ,&@0B%P:O.O+++44&@.@#P8O,O+++44,&@5G#P?O3O+++443&@3E P=O1O+++44k[.&@  PO++4?&@ PO++4.,&@$ POO+++44?&@$POO+++44,&2@"4P,O O+++44&R@"4 P,O O+++44y !5@F@`#F"HJ J??9/]104632#"&"3.2>7#vimrtjms$  $#  $6x-=$$>-P,=$$=,!A@(S @`#S  "sOW W??]9/]]10%#".54>32267#"3&& :Q22Q; !;R01Q; (/-,(/-8[B$$B[87[A##A[60065..5,&x@$6P.O"O+++44&y@$6 P.O"O+++44*,&@ '9P1O%O+++44&@%7P/O#O+++44&@ !"P#O++4X&\@ #$ P%O++4,&@#5P-O!O+++44X&\ @%7 P/O#O+++44?&e$@'#%P&O"O+++44X&\e$@*%' P(O$O+++44-,&@, P $O O+++44+&@ + P#OO+++44$zk J@/@M 0@_ ? Q  r r??2]]]]+107!#3#5#5}grffafYz -@Q /?O H H??]10%#5#!#-rbfff",&@ 2P *O O+++44"&@&8P0O$O+++44y %@6?| @`'  90 p  @[H |P ` p    /Oo@`&#/_ U  ????99?]??]q]]]q]q+qr^]^]]qr10^]3#3373#4632#"&74&#"326cRBcR03311330  ekGbPLOOLLPPL0%%01%%9?10!! 9\y5s#@@ L@L@LF_$$7/F- 6#@  J)s330s-33 $) J ??99//3232]]10+++654&#"'66323#3!3267#"&55#53667#5<7%#F$W9ag1h<9)%T " !-:%rj#M6 (  _bXY"Y ,%_ `W Y!Ykz @ M M @ M (M M M@'MD J   ??92]]2222]10+++++++7#5'75'75#5!#78P&v|I&oK$o£P%DE%Q8a"R3F#N4ffb%Mk w@S  O     ` / ?   0@ QP` U U  ????]]]q]]]]]]qqqq10###=!ۣ|fYfFffr%s@C#F`'D &O_oJ HO  J???99//]q323]2]2222232]10]7#5#535#535>32##3"32654&{CCCC*+)lwxn"Ȗ '300XXXcHbVabWGc-+)"`@  ??10".'732676*\""\*6!0##0  k$6r%$k k?k(.k=-k+y#>F @ H 0 F$J J??9/]]+103#'32654&#"4>32#".)0@?10@?1t 441*+(275#F3769??8Kf5648>;fQ;><k7 k< k;k@p@M M M @ M @ M@ M_/?OR`_o@ HPR_ @  R 0@R 0@ H ??]+q]]2/3/33/]]+]]]qq]10]++++++%2>553#5&&553353* `\U`U\` ` !=0փxx0=!  y'S%@ L @+ LF ``?)F#/!!(%H" HJ???]]]]]10++4>323#56654.#"#53&&)BU-,UC)$*Q"5 + + 1&T*%bKjCCjKB~3232>54&##532>54&#"#*D6#9H%,{5G)"A3"(% 24  ! # +J\<=R2 8Q4+@B'-@b!229[i M M @ M M@(M M M M  Q QQ ???9=/910++++++++.'36673 ,56"2#<"g< W6`IISi0I(*:P;0@* M@M+S0@!`!!<S5S;0 8W&W ??9]]10++]74>7&&54>32&&#"#".%4.'326 5+$*@+5H"?&  -!;F9Q12Q; :$#5**38:79)4'\  "'gH7Y>!;VA*# $((DCB@0@ * M MLL@6M00002 %S(S"1_o0U % %-OW- @W?]?]99=//]]]10+++++&&#"33#"3267#".5467&&54>32L*%ji.,4S%d2)J7!&'! 5F&3N"c ] e"7(+70#&4  6V$>S@ H&S@ H%U??++]10'6654&'.54>7#5!g88*B-/DLmYU=5=-@*%%@ %$ 0D/8j_OfQNas=43!+?[2@ Q QP@ H 0W ?]??+]106632#4&#"#?!a98J+{.{ 9O0RB: 5@S@`SUW W??9/]10#"&546322>7#"3&&tffuufft#  #0.,UV3G++G3iWWi$-@ @ Q  U W??]10%#".55#533267&C0A'$. 5L1f*'?K M@$ M` Q   ??9??2]10++>73#.'#3%# .11:8/ ',-||/2/684CHH?=7$2@Q&%&$Q%$ W???99103>7.#"'6632#.'-12  &@M81' @}uh,*4 c==B9$QQN!$QSN;[Y5V8g @ MS5 H5:$@ H:S+S @ H 9&U0 8# # 8W??99=//99+++10+6654&'&&5467&&54632&&#"33#":A6ZRC2.%ng6P:) &jd3((,C-" ^JBPK/O``    f(!#  ,"%@ R??[8S @ H Q@ HW W???++10"&'#4632'32654&#",{damd0H !+0%* . cws6ZA#y IHEC2;-V%K@#S 0@ 0  'P'S@ H & W ??99+]]]107.54>32&&#"'6654&+F2%Ed?+G"4!HR332>54&'#"4Q7/M7!=W5! )  p#O)+R?&#@Z7:Y=f#/+P(5/$$@ @ HQ@H WU ??++]10#5!#32>7#".5g)  "P,)C0pff4( i.O;3,@ QQ 0  W???]]10"&53326553h^|++}] hp >66>ph[$u@Q/?@HR`&$@P`R%& 0R%@  U$OU ???]2?]2]]9/]3]2]+]1032>54&'#5.54632#, `,$`/C+qmsr+D0x@G)6"#9)FC(?Q/szzs/Q?([[]@?/?R! 0R @PR  W  ????2?]2]2]]]10%2>553#5.55333) `-B*`*B-a `R !=0B^>  >^B0=! 0s@7 0@R00000P0'00R/// &0&@&&&R"@H1#" +W0W ????+]]]]]]q]]10%32654&'7#"&'#".5467326553+#S! 3&!-1&2 -,R# `78>169%CHJ"+N<#$##$#N]## "" ## ""5(&@ '2 P 6O++4(&@ )6 P 'O++4(&@+( P :O )O+++44(&@ -( P +O )O+++44(&@+' P :O (O+++44(&@-' P +O (O+++44(7&@ 2< P NO 'O+++44(7&@ 2< P =O 'O+++44&$5 5" P+4&$  & P+4&$ P+44&$ȴ P+446&$ P+44)&$ P+44w&$  ", P+44x&$  ", P+44@&@  1>,)#P+44&MM.)#P+44&}},(#P+44&uu.(#P+44&3=#P+44&3=#P+44(&@ *( P )O++4(&@ )' P (O++4@&@  42!P,3O++4@&@  31!P,2O++4?[&@ PO++4?[&@ PO++4$&@  P O++4$&@  P O++4&R@ #! P"O++4&R@ " P!O++43&@ PO++43&@ PO++4&@ 42P 3O++4&@ 31P 2O++4(V&&B< P+44(V&&B< P+44(V&&@ +( P+444(V&&-( P+444(V&&@ +' P+444(V&&@ -' P+444(V7&&2< P+444(V7&&2< P+444777777.7.7?V&&ϴ/P+44?V&&ϴ/#P+44?V&&@  3P+444?V&&3P+444?V&&@ 3P+444?V&&@  3P+444?V7&&G)P+444?V7&&G)P+444Q7]77G7U7Y7S7r7rV&& 1FP+44V&& 3FP+44V&&@ 52P+444V&&72P+444V&&@ 51P+444V&&@ 71P+444V7&&685#3P+44&ME:5#3P+44&}t84#3P+44&um:4#3P+44&?I#3P+44&?I#3P+44(&a@ +5 P 'O++4(&@ '( P )O++4(V&& *( P+44(V& 2, P+4(V&& )' P+44(&@ 5+ P -O++4(V&& 5+ P+44 5&$a@ % PO++4 &$@  PO++4gk&$C ۴ P+4k&$  P+4 k I@,  @ HR W s ????9/9??+9107##673#.53%3ee65i(2 `L&-ϲ *8#: #"IVP  ?103#"&5473 #8=_4 ;.0I  ?10667&&54632 $'B3.!!#!(P"i@   ??102#&&#"#54>5'Z['5$5!&&!5$^7 -K@--"#. ."""(  ?]]?]]?]]210#"&54632#"&54632'.#"#>32$""$"##"T  E'11'M!! !! A%5##5%?V&&#P+44?V& P+4?V&&#P+44?[&@ "PO++4?V&&3P+449k&(C  P+4Bk&(  P+4'k&+C  P+41k&+  P+4k q@ R@ HR  @ HR W  U ????9/??+]2q2+]q]10###335.539af``f(2 `kk*8#: #@!@  ?/10'667&&54632Hl; " ?0+!!#!)O"N!@  ?10'7667&&54632~;l! "!@/+!!#!)O"n7'6@'""  '  /]/]]210.#"#>32667&&54632A   E'11'   ""%5##5%    !$&a@ " P O++4$&@  P O++4&!@ P .O "O O++++444&!@ P -O "O O++++444$&@ " P O++4$7&@ P "O O++4+44465&,a@ P O++46&,@  PO++4%k&,C  P+4k&,  P+4O@   ~~??10'&&546329l;.0> " !+ R(!#!!H@   ~~??10'7&&54632;l0?!" !+ R(!#!!n7'+@'$!  ( ?]10.#"#>32.54632A   E'11'h#"   %5##5%!    3&a@  PO++43&@ PO++4&&@P,O OO++++444&&@P+O OO++++444?[&@ ) P-O++4?[&@ - PO++43&@  PO++437&@P OO++4+444 5&<a@ #PO++4 &<@ PO++47k&<C P+4'k&< P+4W&3 ) P+4& )@ ~ ???10#"&54632#"&54632''(''(#(''(N>a]## "" ## ""]&o~?10'.uG`V&&DBP+44V& <6P+4V&&$ #CAP+44&@ ?5P 7O++4V&&OEP+44y&2C| #!P+4Dy&2 " P+4y&Cb n+)#P+43y& *(#P+4 y'373 L%M%@ L$@M$@ L @M M M M @ M @MM M M@ M3333 3333/H/@f H/R4- ----@M@ MO_R @0 P  /  !!! !!%R%$4/ 3W( %U" U W?????]]]]]]]]++]_]]++]]q10+++++++++++++++46323#5>54.#"#53&&.53TIHT"@  B!(2 `bB=]W5DO+&E45F'*OB4W]=*8#: #o~?10'7o.e`GuI ~?10&&54632 3B'$ "P(!#!!V&$', P+44V&$', P+44V&$''0 P+444V&$'60 P+444V&$'I0 P+444V&$'C0 P+444\V&$'j"D P+444]V&$'j"D P+444ZV&+'$m !P+44fV&+'$s!P+44V&+'P$%P+444V&+'^$%P+444V&+'b$%P+444V&+'V$%P+444V&+'$;9P+444V&+'$;9P+444kV&'$v(=#P+44GV&'$d*=#P+44~V&'>$,A#P+444V&'M$.A#P+444V&'}$&,A#P+444V&'u$.A#P+444V&'$@3U#P+444V&'$?3U#P+444 Vk&$ " P+4-Vk&+$ $P+4 Vy&$ $3-#P+4.k#@ @ L@ L L M@1 M%$% %# S!#$"@ H"U #OoU?]22+2??229/9910+++++&&##5!#3##.'53267#5 :.nsE:hJ84.444?@D'YY !XDD =?<?;6Z#X94+;Nam)@ no32"32654&766'&&'467'7&&727&&''&&5&#"6"'3274676667'7676&'&5F((F44F((F5    $  $K+%  %+  (F44F((F55F  u  V )  ( _(%    %(  [ #'+/37@3 M2 M+ M* M' M& M# M"@ M! M  M@ M M M&6Ff= &6Ff= &f&f=  >  A&%"!  x I i i6f 6 f  9  9=11i1y111@ H 11/4;H/((^(n(M(>((@N(+H((i(y(((@ H( I($4;H$$^$n$M$.$>$ $$$$$i$y$$$@ H $$6@ 4;H6652@ H2'2722+@-1H1+ +++++@ H+ +0++'-1H'@(,H'@ H' '0''   "/ ;^[Ly  ; ? o =O   { L   9 i   /_ ;{L8 f3`=PSDv 0`=ArD@>f7  0 = !   T   F   9@ 4EH",585@;1;Ha5@5P5!5155555555555c5s5T5C555@H355 555"@H"""""X33,,@@ &HK,[,<,,@H,,,,HZ,I,,@ H,2EH11&40;H4,/H4@3#+H|44k4\4K44HZ44@ H4#+#;##H#W))+-$'H-#H-H-@H-@ H--'- -@2EH$$& @P`;`!Arc$DfG6  <wC i3/?<O `@*IL\l )i AL\  /O_o;Oo.Ll| +Ii8) >xK f  3  `=AScDe@9' APA`p ?r2_]_q_qqrrrr^]2^]]qqqqrr^]?^]]2^]]qqrrr^]2^]]]]]]qqqrrrr^]9/]3^]]]qqqrr^]3^]]]]qq+rrrr^]]^]]2^]]qqrrr^]]2^]]]]]qqqqqqrrrr^]]]?^]2+2^]+++++?]2+q2+]+qqqq+++9/3+3+]]+]+qq+q]2]]+2_]]_]+_]_qqqqqqqrrrrr+22+22r22]]]]qqqrr^]2^]]]]qqqrr^]2^]]]qqqqr^]^]]2^]]qqqrrr^]]2^]]]qqqqrr^]2^]2^]]]qqqqrr^]]_^]22]+++2]+_qrrr+2]+]+2]+]]qrrrrr+2++]]+rrrr2+2]+]]10^]]]]]]+^]]]]]^]]^]]^]]^]^]^]^]+++++++++++++335!5!35!3335!5!35!3|444555k**yhk**L**yhk**)@( M(@M'@M L MM@M@ M@ MMM MسMMMس M M@1 L'!'! !'+*D$ $0$$ ??99//99]]999/////99910++++++++++++++++++7774>54.#"6322654&#" #,!   .   i y'oj&t"">@ EI?1033!Pr">@ EI?1033!P>4PVr@ EI?10!##"PrP4V">E??10#3"PP"rI?105!"PPV">@ EI??310##533"PPPVr2@@P `p EI??]2]q10###5PrP4P">1@@` EI?2]]q105333P"P4PV>(@EI?]?]]31033##PP>4P4V> @@(@ 0p  E0  I?2]2?]22]q10#5333##PP"P4P4V>V@7  ` p   `p E E II?]2]2?]q]q105333###5PPrP|PPP|PV>J@.E ?  E0 I I????]]3]2]10##53;3##PPPPPP4P4V"r@ EI?10!##"PrV"> \@>_oE _oE @M_I_  0  P`I?]]]q?]]q+qq1033!!##P"P|4P4|V> 8@ E E II??]]]]10!33##!PP"r> @@)  @ P  ` p  0E II?2]]q105333!5P rP|PPPP"> <@%@ MPp E II?]]qq+1033!!!P"|4PP> 8@!p p_0E II?]qq]q10!33!!P"rPV @@)  @ P  ` p   0E I I?]]q10###=!P"P|PPPPV" 4@Pp? E II?]]]q10!##5!!"P""4|PV 8@"Pp p0E II?]q]q10%##!%!!P""̠PVr>@EE????10#;#PPPPPV> v@N0Ep   E0Ep   EI I II????]]q]]]q]1033###35#333##PPP P|4P4|Vr> E@)  E@MEE I I????]]+]103#33#3##"PPނPP>l|4P4|V> c@@  E  E  @ME@M0 II ????]]]+]+]]]]10#3#33##3PP"PPҪ4> ?@$ E?E0 I II??]]10!5533#!#33 PP"PP|4r> :@" E? E I IP??]]?]]1033#!3!P"P|4P> @@'?  E0 E I IP??]]?]]]10#33!3!PP"rlV c@AE?   E0@MI I I?]?]]]+]]]]105!##3!3##P PrPP4|Vr r@ @ME @#M  E0 @MI @M  I_0?]]?]+]+]]]+]+103##5!#!PrP"4|V d@FpE  0E?   IpI0?]?]]]]]]]]]10%##35!#!PPrPl@ II ?1055!%5! PPPPVr> '@ E E I????210##533#3PPPPPV> '@ E E I????21033##3#"PPPP>4P4"> E@- @H E@HE0`p I?]33?]++10!53333 PPPrPP44"r> ;@%E E I??]]??]]]1033#3#P"PPr"> ;@%EE I?]]??]?]]10#33#3PPP"4PVr @@'E E0   I?23??]]]]105!####PPP"PP44Vrr C@*E?  E I?]???]]]_]]103##%3#P"PPrPVr C@*E$  E0 I??]??]_]]]]10##3#3PPP"4V>??/10! >.n> #'+/37;?CGKOSW[_cgkosw{3#3#73#3#3#3#73#3#3#3#73#3#3#3#73#3#3#3#73#3#3#3#73#3#3#73#3#3#73#3#3#73#3#3#73#3#3#73#3#3#73#3#3#73#3#73#''N''N''N''''N''N''N''''N''N''N''''N''N''N''''N''N''N''''N''N''N''''''''N''N ''N''N ''N''N ''N''N ''N''N ''N''N '' >'''u'''''''u'''''''u'''('''u'''''''u'''''''u''''''''''u'u'''u'u'''u'v'''u'u'''u'u'''u'u'''Un> #'+/37;?CGKOSW[_cgkosw{ #'+/37;?CGKOS3#73#3#73#73#73#3#73#73#73#3#73#3#73#73#73#73#73#3#73#73#73#73#73#3#73#73#73#73#73#3#73#73#73#73#73#3#73#73#73#73#73#3#3#73#73#73#73#73#73#3#73#73#73#73#73#73#3#73#73#73#73#73#73#3#73#73#73#73#73#73#3#73#73#73#73#73#73#3#73#73#73#73#73#73#''N'''''N'''''N'''''N'''''N'''''N''z''N''N''N''N''N''z''N''N''N''N''N''z''N''N''N''N''N''z''N''N''N''N''N''z''N''N''N''N''N''' ,''N''N''N''N''N''N ,''N''N''N''N''N''N ,''N''N''N''N''N''N ,''N''N''N''N''N''N ,''N''N''N''N''N''N ,''N''N''N''N''N''N >'''''''u'''''''u'''''''u'''''''''''u'''''''''''v'''''''''''u'''''''''''u''''''''''''u'''''''''''''u'''''''''''''v'''''''''''''u'''''''''''''u'''''''''''''u'''''''''''''IV> #'+/37;?CGKOSW[_cgkosw{ ;35#35#35#35#735#35#35#35#735#35#35#35#35#35#35#35#735#35#35#35#735#35#35#35#35#35#35#35#735#35#35#35#735#35#35#35#35#35#35#35#735#35#35#35#735#35#35#35#35#35#35#35#735#35#35#35#735#35#35#35#35#35#35#35#735#35#35#35#735#35#35#35##5##5##5##5##5##5##'''N''N''N''N''N''N''N''N''N''N''N''z''N''N''N''N''N''N''N''N''N''N''N''z''N''N''N''N''N''N''N''N''N''N''N''z''N''N''N''N''N''N''N''N''N''N''N''z''N''N''N''N''N''N''N''N''N''N''N''z''N''N''N''N''N''N''N''N''N''N''N''G '''''''''''''''u'''''''u'''''''u'''u'''u'''''''u'''''''u'''u'''v(((''''v(((''''v(((v'''u'''''''u'''''''u'''u'''u'''''''u'''''''u'''u'''u'''''''u'''''''u'''V>W@6E?E 0   I ???22]22?]2]2]2]2103#####53333rPPPPPPrP44P4V>1@E I I ??2222223310###535#5333#PP"P|PPP|PPnI ITXu @    ITu     :    + I   4 4    Copyright 2011 Canonical Ltd. Licensed under the Ubuntu Font Licence 1.0Ubuntu MonoBoldUbuntu Mono Bold Version 0.80Ubuntu Mono BoldVersion 0.80UbuntuMono-BoldUbuntu and Canonical are registered trademarks of Canonical Ltd.Dalton Maag Ltdhttp://www.daltonmaag.com/Copyright 2011 Canonical Ltd. Licensed under the Ubuntu Font Licence 1.0Ubuntu MonoBoldUbuntu Mono Bold Version 0.80Ubuntu Mono BoldVersion 0.80UbuntuMono-BoldUbuntu and Canonical are registered trademarks of Canonical Ltd.Dalton Maag Ltdhttp://www.daltonmaag.com/  !"#$%&'()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_`abcdefghjikmlnoqprsutvwxzy{}|~      !"#$%&'()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_`abcdefghijklmnopqrstuvwxyz{|}~      !"#$%&'()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_`abcdefghijklmnopqrstuvwxyz{|}~      !"#$%&'()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_`abcdefghijklmnopqrstuvwxyz{|}~      !"#$%&'()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_`abcdefghijklmnopqrstuvwxyz{|}~ !"#     .nullEurouni00A0uni00ADmacronperiodcenteredAmacronamacronAbreveabreveAogonekaogonek Ccircumflex ccircumflex Cdotaccent cdotaccentDcarondcaronDcroatdcroatEmacronemacronEbreveebreve Edotaccent edotaccentEogonekeogonekEcaronecaron Gcircumflex gcircumflex Gdotaccent gdotaccent Gcommaaccent gcommaaccent Hcircumflex hcircumflexHbarhbarItildeitildeImacronimacronIbreveibreveIogonekiogonek Idotaccenti.loclIJij Jcircumflex jcircumflex Kcommaaccent kcommaaccentkgreenlandic.case kgreenlandicLacutelacute Lcommaaccent lcommaaccentLcaronlcaronLdotldotNacutenacute Ncommaaccent ncommaaccentNcaronncaronnapostrophe.case napostropheEngengOmacronomacronObreveobreve Ohungarumlaut ohungarumlautRacuteracute Rcommaaccent rcommaaccentRcaronrcaronSacutesacute Scircumflex scircumflexuni0162uni0163TcarontcaronTbartbarUtildeutildeUmacronumacronUbreveubreveUringuring Uhungarumlaut uhungarumlautUogonekuogonek Wcircumflex wcircumflex Ycircumflex ycircumflexZacutezacute Zdotaccent zdotaccentlongs Scommaaccent scommaaccentuni021Auni021Bdotlessj apostropheuni02C9WgravewgraveWacutewacute Wdieresis wdieresisYgraveygrave zerosuperior foursuperior fivesuperior sixsuperior sevensuperior eightsuperior ninesuperior zeroinferior oneinferior twoinferior threeinferior fourinferior fiveinferior sixinferior seveninferior eightinferior nineinferior afii61289 estimatedonethird twothirds oneeighth threeeighths fiveeighths seveneighthsonefifth twofifths threefifths fourfifthsonesixth fivesixths oneseventh twosevenths threesevenths foursevenths fivesevenths sixseventhsoneninth twoninths fourninths fiveninths sevenninths eightninthsDeltauni2126uni2215uni2219f_if_l zero.supsone.supstwo.sups three.sups four.sups five.supssix.sups seven.sups eight.sups nine.sups zero.sinfone.sinftwo.sinf three.sinf four.sinf five.sinfsix.sinf seven.sinf eight.sinf nine.sinf caron.alt commaaccentrevcommaaccentcaron.alt.short Parenleft ParenrightHyphenSlashAt Bracketleft Backslash Bracketright Braceleft Braceright GuilsinglleftBulletEndashEmdashGuilsinglright Exclamdown GuillemotleftGuillemotright Questiondownuni0180uni0181uni0182uni0183uni0184uni0185uni0186uni0187uni0188uni0189uni018Auni018Buni018Cuni018Duni018Euni018Funi0190uni0191uni0193uni0194uni0195uni0196uni0197uni0198uni0199uni019Auni019Buni019Cuni019Duni019Euni019FOhornohornuni01A2uni01A3uni01A4uni01A5uni01A6uni01A7uni01A8uni01A9uni01AAuni01ABuni01ACuni01ADuni01AEUhornuhornuni01B1uni01B2uni01B3uni01B4uni01B5uni01B6uni01B7uni01B8uni01B9uni01BAuni01BBuni01BCuni01BDuni01BEuni01BFuni01C0uni01C1uni01C2uni01C3uni01C4uni01C5uni01C6uni01C7uni01C8uni01C9uni01CAuni01CBuni01CCuni01CDuni01CEuni01CFuni01D0uni01D1uni01D2uni01D3uni01D4uni01D5uni01D6uni01D7uni01D8uni01D9uni01DAuni01DBuni01DCuni01DDuni01DEuni01DFuni01E0uni01E1uni01E2uni01E3uni01E4uni01E5Gcarongcaronuni01E8uni01E9uni01EAuni01EBuni01ECuni01EDuni01EEuni01EFuni01F0uni01F1uni01F2uni01F3uni01F4uni01F5uni01F6uni01F7uni01F8uni01F9 Aringacute aringacuteAEacuteaeacute Oslashacute oslashacuteuni0200uni0201uni0202uni0203uni0204uni0205uni0206uni0207uni0208uni0209uni020Auni020Buni020Cuni020Duni020Euni020Funi0210uni0211uni0212uni0213uni0214uni0215uni0216uni0217uni021Cuni021Duni021Euni021Funi0220uni0221uni0222uni0223uni0224uni0225uni0226uni0227uni0228uni0229uni022Auni022Buni022Cuni022Duni022Euni022Funi0230uni0231uni0232uni0233uni0234uni0235uni0236uni0238uni0239uni023Auni023Buni023Cuni023Duni023Euni023Funi0240uni0241uni0242uni0243uni0244uni0245uni0246uni0247uni0248uni0249uni024Auni024Buni024Cuni024Duni024Euni024Funi0292breve_inverted double_grave ring_acutedieresis_macron dot_macrondieresis_gravedieresis_acutedieresis_breve tilde_macron acute.asccircumflex.asc caron.ascdieresis_grave.capdieresis_acute.capdieresis_breve.capuni0400 afii10023 afii10051 afii10052 afii10053 afii10054 afii10055 afii10056 afii10057 afii10058 afii10059 afii10060 afii10061uni040D afii10062 afii10145 afii10017 afii10018 afii10019 afii10020 afii10021 afii10022 afii10024 afii10025 afii10026 afii10027 afii10028 afii10029 afii10030 afii10031 afii10032 afii10033 afii10034 afii10035 afii10036 afii10037 afii10038 afii10039 afii10040 afii10041 afii10042 afii10043 afii10044 afii10045 afii10046 afii10047 afii10048 afii10049 afii10065 afii10066 afii10067 afii10068 afii10069 afii10070 afii10072 afii10073 afii10074 afii10075 afii10076 afii10077 afii10078 afii10079 afii10080 afii10081 afii10082 afii10083 afii10084 afii10085 afii10086 afii10087 afii10088 afii10089 afii10090 afii10091 afii10092 afii10093 afii10094 afii10095 afii10096 afii10097uni0450 afii10071 afii10099 afii10100 afii10101 afii10102 afii10103 afii10104 afii10105 afii10106 afii10107 afii10108 afii10109uni045D afii10110 afii10193afii10066.locluni0462uni0463uni0472uni0473uni0474uni0475uni048Auni048Buni048Cuni048Duni048Euni048F afii10050 afii10098uni0492uni0493uni0494uni0495uni0496uni0497uni0498uni0499uni049Auni049Buni049Cuni049Duni049Euni049Funi04A0uni04A1uni04A2uni04A3uni04A4uni04A5uni04A6uni04A7uni04A8uni04A9uni04AAuni04ABuni04ACuni04ADuni04AEuni04AFuni04B0uni04B1uni04B2uni04B3uni04B4uni04B5uni04B6uni04B7uni04B8uni04B9uni04BAuni04BBuni04BCuni04BDuni04BEuni04BFuni04C0uni04C1uni04C2uni04C3uni04C4uni04C5uni04C6uni04C7uni04C8uni04C9uni04CAuni04CBuni04CCuni04CDuni04CEuni04CFuni04D0uni04D1uni04D2uni04D3uni04D4uni04D5uni04D6uni04D7uni04D8uni04D9uni04DAuni04DBuni04DCuni04DDuni04DEuni04DFuni04E0uni04E1uni04E2uni04E3uni04E4uni04E5uni04E6uni04E7uni04E8uni04E9uni04EAuni04EBuni04ECuni04EDuni04EEuni04EFuni04F0uni04F1uni04F2uni04F3uni04F4uni04F5uni04F6uni04F7uni04F8uni04F9 afii61352 afii00208uni20B4uni20AEtengeroublekratkaAlphaBetaGammauni0394EpsilonZetaEtaThetaIotaKappaLambdaMuNuXiOmicronPiRhoSigmaTauUpsilonPhiChiPsialphabetagammadeltaepsilonzetaetathetaiotakappalambdauni03BCnuxiomicronrhosigma1sigmatauupsilonphichipsiomega Alphatonos EpsilontonosEtatonos Iotatonos Iotadieresis Omicrontonos UpsilontonosUpsilondieresis Omegatonos alphatonos epsilontonosetatonos iotatonos iotadieresisiotadieresistonos omicrontonosupsilondieresis upsilontonosupsilondieresistonos omegatonostonos tonos.cap dieresistonosuni1F00uni1F01uni1F02uni1F03uni1F04uni1F05uni1F06uni1F07uni1F08uni1F09uni1F0Auni1F0Buni1F0Cuni1F0Duni1F0Euni1F0Funi1F10uni1F11uni1F12uni1F13uni1F14uni1F15uni1F18uni1F19uni1F1Auni1F1Buni1F1Cuni1F1Duni1F20uni1F21uni1F22uni1F23uni1F24uni1F25uni1F26uni1F27uni1F28uni1F29uni1F2Auni1F2Buni1F2Cuni1F2Duni1F2Euni1F2Funi1F30uni1F31uni1F32uni1F33uni1F34uni1F35uni1F36uni1F37uni1F38uni1F39uni1F3Auni1F3Buni1F3Cuni1F3Duni1F3Euni1F3Funi1F40uni1F41uni1F42uni1F43uni1F44uni1F45uni1F48uni1F49uni1F4Auni1F4Buni1F4Cuni1F4Duni1F50uni1F51uni1F52uni1F53uni1F54uni1F55uni1F56uni1F57uni1F59uni1F5Buni1F5Duni1F5Funi1F60uni1F61uni1F62uni1F63uni1F64uni1F65uni1F66uni1F67uni1F68uni1F69uni1F6Auni1F6Buni1F6Cuni1F6Duni1F6Euni1F6Funi1F70uni1F71uni1F72uni1F73uni1F74uni1F75uni1F76uni1F77uni1F78uni1F79uni1F7Auni1F7Buni1F7Cuni1F7Duni1F80uni1F81uni1F82uni1F83uni1F84uni1F85uni1F86uni1F87uni1F88uni1F89uni1F8Auni1F8Buni1F8Cuni1F8Duni1F8Euni1F8Funi1F90uni1F91uni1F92uni1F93uni1F94uni1F95uni1F96uni1F97uni1F98uni1F99uni1F9Auni1F9Buni1F9Cuni1F9Duni1F9Euni1F9Funi1FA0uni1FA1uni1FA2uni1FA3uni1FA4uni1FA5uni1FA6uni1FA7uni1FA8uni1FA9uni1FAAuni1FABuni1FACuni1FADuni1FAEuni1FAFuni1FB0uni1FB1uni1FB2uni1FB3uni1FB4uni1FB6uni1FB7uni1FB8uni1FB9uni1FBAuni1FBBuni1FBCuni1FBDuni1FBEuni1FBFuni1FC0uni1FC1uni1FC2uni1FC3uni1FC4uni1FC6uni1FC7uni1FC8uni1FC9uni1FCAuni1FCBuni1FCCuni1FCDuni1FCEuni1FCFuni1FD0uni1FD1uni1FD2uni1FD3uni1FD6uni1FD7uni1FD8uni1FD9uni1FDAuni1FDBuni1FDDuni1FDEuni1FDFuni1FE0uni1FE1uni1FE2uni1FE3uni1FE4uni1FE5uni1FE6uni1FE7uni1FE8uni1FE9uni1FEAuni1FEBuni1FECuni1FEDuni1FEEuni1FEFuni1FF2uni1FF3uni1FF4uni1FF6uni1FF7uni1FF8uni1FF9uni1FFAuni1FFBuni1FFCuni1FFDuni1FFE uni1F88.alt uni1F89.alt uni1F8A.alt uni1F8B.alt uni1F8C.alt uni1F8D.alt uni1F8E.alt uni1F8F.alt uni1F98.alt uni1F99.alt uni1F9A.alt uni1F9B.alt uni1F9C.alt uni1F9D.alt uni1F9E.alt uni1F9F.alt uni1FA8.alt uni1FA9.alt uni1FAA.alt uni1FAB.alt uni1FAC.alt uni1FAD.alt uni1FAE.alt uni1FAF.alt uni1FBC.alt uni1FCC.alt uni1FFC.altuni20B9uniE0FFuniF000uniFFFDuniEFFD SF040000.001 SF020000.001 SF010000.001 SF110000.001 SF100000.001 SF090000.001 SF060000.001 SF070000.001 SF080000.001 SF050000.001 SF540000.001 SF530000.001 SF030000.001SF190000SF360000SF450000SF280000SF500000SF470000SF220000SF510000SF240000SF440000SF230000SF420000SF400000SF260000SF380000SF410000SF250000SF390000SF430000SF200000SF370000SF460000SF270000SF490000SF480000SF210000SF520000blockltshadeshadedkshadeSF530000SF540000SF040000SF020000SF010000SF110000SF100000SF090000SF060000SF070000SF080000SF050000SF030000 tcyrlgreklatnBGR .MKD HSRB b 0>KVa   *1?LWb  !+2@MXc ",3ANYd #4<BIOZe"AZE @CRT ZMOL tROM TRK $5;=CJP[f %-6DQ\g &.7ER]h'8FS^i (9GT_j )/:HU`klafrcafrcafrcafrcafrcafrcafrcafrcafrcafrcafrccasecasecasecasecasecase case(case0case8dnom@dnomFdnomLdnomRdnomXdnom^dnomddnomjdnompdnomvdnom|fracfracfracfracfracfracfracfracfracfracfracloclloclloclloclloclloclnumrnumrnumr numrnumrnumrnumr"numr(numr.numr4numr:ordn@saltFsaltPsinfZsinf`sinffsinflsinfrsinfxsinf~sinfsinfsinfsinfss01ss01ss02ss02ss02ss02ss02ss02ss02ss02ss02ss02 ss02subssubs$subs*subs0subs6subsFNV^nnntnun~nnnnn $,nnunnn*2:BJRZbjrznnnnnnqnsnunyn{n}nnnnnnnnn*2:BJRZbjrznnnnnpnqnsntnzn{n}n~nnnnnnnn(RZbjrz "*2:BJRZbjrznnnnnnnnnnnpnqnrnsntnunxnynzn{n|n}n~nnnnnnnnnnnnnnnnn (08@HPX`hpxnnnnqnsnun{n}nnnnnnn*2:BJRZbjrznnnnnrnsntnun|n}n~nnnnnnnnn $,nnsn}nn &.6>FNV^nnntnun~nnnnn $,nnunnn(RZbjrz "*2:BJRZbjrznnnnnnnnnnnpnqnrnsntnunxnynzn{n|n}n~nnnnnnnnnnnnnnnnn*2:BJRZbjrznnnnnnqnsnunyn{n}nnnnnnnnn*2:BJRZbjrznnnnnpnqnsntnzn{n}n~nnnnnnnn (08@HPX`hpxnnnnqnsnun{n}nnnnnnn*2:BJRZbjrznnnnnrnsntnun|n}n~nnnnnnnnn $,nnsn}nn &.6>FNV^nnntnun~nnnnn $,nnunnn(RZbjrz "*2:BJRZbjrznnnnnnnnnnnpnqnrnsntnunxnynzn{n|n}n~nnnnnnnnnnnnnnnnn*2:BJRZbjrznnnnnnqnsnunyn{n}nnnnnnnnn*2:BJRZbjrznnnnnpnqnsntnzn{n}n~nnnnnnnn (08@HPX`hpxnnnnqnsnun{n}nnnnnnn*2:BJRZbjrznnnnnrnsntnun|n}n~nnnnnnnnn $,nnsn}nn &.6>FNV^nnntnun~nnnnn $,nnunnn(RZbjrz "*2:BJRZbjrznnnnnnnnnnnpnqnrnsntnunxnynzn{n|n}n~nnnnnnnnnnnnnnnnn*2:BJRZbjrznnnnnnqnsnunyn{n}nnnnnnnnn*2:BJRZbjrznnnnnpnqnsntnzn{n}n~nnnnnnnn (08@HPX`hpxnnnnqnsnun{n}nnnnnnn*2:BJRZbjrznnnnnrnsntnun|n}n~nnnnnnnnn $,nnsn}nn &.6>FNV^nnntnun~nnnnn $,nnunnnnn (opqrstuopqrstuopqrstuopqrstun~6-$%&'()*+,-./0123456789:;<=kmz   "$&(*,.02468:<>@BDFHJLNPRTVY[fhjl~ v n  xywvz{|}~Lv DR ou  o  o  pt w~ nnvou #>?@^`lrstx|X]DEFGHIJKLMNOPQRSTUVWXYZ[\]wy  !#%')+-/13579;=?ACEGIKMOQSUWZ\gikmSZcjsz0 *H 01 0 +0a +7S0Q0, +7<<<Obsolete>>>0!0 +;h,w5BR"0V0> 0  *H 01 0 UUS10UArizona10U Scottsdale1%0#U Starfield Technologies, Inc.1:08U 1http://certificates.starfieldtech.com/repository/1604U-Starfield Services Root Certificate Authority0 110503070000Z 160503070000Z01 0 UUS10UArizona10U Scottsdale1%0#U Starfield Technologies, Inc.1301U *http://certs.starfieldtech.com/repository/1/0-U&Starfield Services Timestamp Authority0"0  *H 0 򳑥I }-`Zc0xC;#(2&_2%蕅 >O ^>Q.;V A)+5yi]rE%Ĵ֬ea- vcLy< tfYP _Y$9ӉpUH {( ]P( */ӿJ^=zu_^̧@ցU]E'€t?>3 He27m UUO"/+0tC,K "@xQF0B0 U00U0U% 0 +0U# kro> را0U#0C̛u]/KQ0:+.0,0*+0http://ocsp.starfieldtech.com/09U2000.,*(http://crl.starfieldtech.com/sfsroot.crl0SU L0J0H `Hn0907++https://certs.starfieldtech.com/repository/0  *H S~tz+xY<%_B7[<a4jh"!ZHUMΫ4ƭ yڧW900Р*\%S-Lm{rRU>:EKd`5T%L[76J ioW"AcdǾwX6f8dR^/`ro6D"@AT3#l{X4~hTx RMKGlSL>3ĊsI"Ȝ|c000  *H 0c1 0 UUS1!0U The Go Daddy Group, Inc.110/U (Go Daddy Class 2 Certification Authority0 040629170620Z 340629170620Z0c1 0 UUS1!0U The Go Daddy Group, Inc.110/U (Go Daddy Class 2 Certification Authority0 0  *H  0ޝWI[_HgehWq^wIp=Vco?T"Tزu=Kw>x k/j+ň~ĻE'o7X&-r6N?e*n] :-؎_=\e8E``tArbbo_BQe#jxMZ@^s wyg ݠXD{ >b(_ASX~8tit00UİґLqa=ݨj0U#0İґLqa=ݨjge0c1 0 UUS1!0U The Go Daddy Group, Inc.110/U (Go Daddy Class 2 Certification Authority0 U00  *H 2K>ơw3\= ni04cr8(1zT1Xb۔EsE$Ղ#yiML3#An 剞;p~& T%ns! l l a+r9 ͗nN&s+L&qatJWuH.Qia@LĬC Օb ψ2 +E (*ZW7۽00Ơ0  *H 0c1 0 UUS1!0U The Go Daddy Group, Inc.110/U (Go Daddy Class 2 Certification Authority0 061116015437Z 261116015437Z01 0 UUS10UArizona10U Scottsdale10U GoDaddy.com, Inc.1301U *http://certificates.godaddy.com/repository100.U'Go Daddy Secure Certification Authority10U079692870"0  *H 0 -&L25_YZaY;pc=*3y:<0#0=Tߙ %!e)~5T29&UXמ* BΧ?Rifھ],fkQJ/Hǘuع)fm x|z%.enjDSp0Ü+X+=tJQL'Xk5ŝ1 6:%IgE96~7qt0? O20.0Ua2lE_vh0U#0İґLqa=ݨj0U003+'0%0#+0http://ocsp.godaddy.com0FU?0=0;975http://certificates.godaddy.com/repository/gdroot.crl0KU D0B0@U 0806+*http://certificates.godaddy.com/repository0U0  *H ҆gf :PrJtS7DIk3ٖV0<2!{ $F%#go]{z̟X*Ğ!ZFc/))r,)7'Oh! SY ;$IHE:6oEEADN>tvբU,ƇuLn=qQ@"(IK4Zц6d5oownP^S#c͹c:h5S0>0& i{0  *H 01 0 UUS10UArizona10U Scottsdale10U GoDaddy.com, Inc.1301U *http://certificates.godaddy.com/repository100.U'Go Daddy Secure Certification Authority10U079692870 090924134423Z 120924134423Z0k1 0 UGB10 ULondon10 ULondon10U Dalton Maag Limited10UDalton Maag Limited0"0  *H 0 _ҡ~4rخS5F+  +Fnb执 AkUr]X3u-`>T>슑6zU=k'F __~/BbQF0q{̌3v൙ wx1http://certificates.godaddy.com/repository/gd_intermediate.crt0U#0a2lE_vh0Uhf0gU7u30  *H V> }EHTԒDqi07Ghٳ% 6 ;Qt^;$9àLRBfZuhI:-#k^C/ >=nZt?.K0msÞoG$`d\cݩP4e(IZzF*فe {>U0ϯ#kEܑ7 f_U`4>ja@0ĥ[`mO4~ 1SxЃĪb2"#N.|\#10001 0 UUS10UArizona10U Scottsdale10U GoDaddy.com, Inc.1301U *http://certificates.godaddy.com/repository100.U'Go Daddy Secure Certification Authority10U07969287 i{0 +0 +7 100 +7(10 *H  1  +70 +7 10  +70# *H  1Vae 0  *H 0L#K-[U{ E-&Nę0suݛ739$ߊZFH:ea_wHW7UW'9$=/x`¨o$@NC?{H3ׯ+]2&݆~(2v*ؙ`[.$Jn=`raj;]@=M>Q .[dCQNF 2&I#̈lӇǔQ~B5xT^wx. xՂϴefСt0p *H  1a0]001 0 UUS10UArizona10U Scottsdale1%0#U Starfield Technologies, Inc.1:08U 1http://certificates.starfieldtech.com/repository/1604U-Starfield Services Root Certificate Authority 0  *H ]0 *H  1  *H 0 *H  1 110922154442Z0# *H  1?}!Q knA4 FZN0  *H I3x ț|@Gd)~8U+dw',q.P?PbDqsef<{ \AiLFw j8ȞjU!pkJdS;|pW~fs/mn RiAh)hO.xI}\`ʕPa'V1=ϽF~g$A+KqDYuqXqln acfƬi" 7`N˳Zcoq-8.20.0/doc/tools/coqrst/notations/__init__.py000066400000000000000000000000001466560755400217420ustar00rootroot00000000000000coq-8.20.0/doc/tools/coqrst/notations/fontsupport.py000077500000000000000000000057751466560755400226410ustar00rootroot00000000000000#!/usr/bin/env python2 # -*- coding: utf-8 -*- ########################################################################## ## # The Coq Proof Assistant / The Coq Development Team ## ## v # Copyright INRIA, CNRS and contributors ## ## = 191: fnt.removeGlyph(g) return fnt def center_glyphs(src_font_path, dst_font_path, dst_name): fnt = trim_font(fontforge.open(src_font_path)) size = max(g.width for g in fnt.glyphs()) fnt.ascent, fnt.descent = size, 0 for glyph in fnt.glyphs(): scale_single_glyph(glyph, size, size) fnt.sfnt_names = [] fnt.fontname = fnt.familyname = fnt.fullname = dst_name fnt.generate(dst_font_path) if __name__ == '__main__': from os.path import dirname, join, abspath curdir = dirname(abspath(__file__)) ubuntumono_path = join(curdir, "UbuntuMono-B.ttf") ubuntumono_mod_path = join(curdir, "CoqNotations.ttf") center_glyphs(ubuntumono_path, ubuntumono_mod_path, "CoqNotations") coq-8.20.0/doc/tools/coqrst/notations/html.py000066400000000000000000000063211466560755400211630ustar00rootroot00000000000000########################################################################## ## # The Coq Proof Assistant / The Coq Development Team ## ## v # Copyright INRIA, CNRS and contributors ## ## str: """Configure a coqtop instance (but don't start it yet). :param coqtop_bin: The path to coqtop; uses $COQBIN by default, falling back to "coqtop" :param color: When True, tell coqtop to produce ANSI color codes (see the ansicolors module) :param args: Additional arguments to coqtop. """ self.coqtop_bin = coqtop_bin or os.path.join(os.getenv('COQBIN', ""), "coqtop") if not pexpect.utils.which(self.coqtop_bin): raise ValueError("coqtop binary not found: '{}'".format(self.coqtop_bin)) self.args = (args or []) + ["-q"] + ["-color", "on"] * color self.coqtop = None self.debugfile = None def __enter__(self): if self.coqtop: raise ValueError("This module isn't re-entrant") self.coqtop = pexpect.spawn(self.coqtop_bin, args=self.args, echo=False, encoding="utf-8") # Disable delays (http://pexpect.readthedocs.io/en/stable/commonissues.html?highlight=delaybeforesend) self.coqtop.delaybeforesend = 0 if os.getenv ("COQ_DEBUG_REFMAN"): self.debugfile = tempfile.NamedTemporaryFile(mode="w+", prefix="coqdomain", suffix=".v", delete=False, dir="/tmp/") self.next_prompt() return self def __exit__(self, type, value, traceback): if self.debugfile: self.debugfile.close() self.debugfile = None self.coqtop.kill(9) def next_prompt(self): """Wait for the next coqtop prompt, and return the output preceding it.""" self.coqtop.expect(CoqTop.COQTOP_PROMPT, timeout = 10) return self.coqtop.before def sendone(self, sentence): """Send a single sentence to coqtop. :sentence: One Coq sentence (otherwise, Coqtop will produce multiple prompts and we'll get confused) """ # Suppress newlines, but not spaces: they are significant in notations sentence = re.sub(r"[\r\n]+", " ", sentence).strip() try: if self.debugfile: self.debugfile.write(sentence+"\n") self.coqtop.sendline(sentence) output = self.next_prompt() except Exception as err: raise CoqTopError(err, sentence, self.coqtop.before) return output def send_initial_options(self): """Options to send when starting the toplevel and after a Reset Initial.""" self.sendone('Set Coqtop Exit On Error.') self.sendone('Set Warnings "+default".') def sendmany(*sentences): """A small demo: send each sentence in sentences and print the output""" with CoqTop() as coqtop: for sentence in sentences: print("=====================================") print(sentence) print("-------------------------------------") response = coqtop.sendone(sentence) print(response) def main(): """Run a simple performance test and demo `sendmany`""" with CoqTop() as coqtop: for _ in range(200): print(repr(coqtop.sendone("Check nat."))) sendmany("Goal False -> True.", "Proof.", "intros H.", "Check H.", "Chchc.", "apply I.", "Qed.") if __name__ == '__main__': main() coq-8.20.0/doc/tools/docgram/000077500000000000000000000000001466560755400157265ustar00rootroot00000000000000coq-8.20.0/doc/tools/docgram/README.md000066400000000000000000000313001466560755400172020ustar00rootroot00000000000000# Grammar extraction tool for documentation `doc_grammar` extracts Coq's grammar from `.mlg` files, edits it and inserts it into `.rst` files. The tool inserts `prodn` directives for grammar productions. It also updates `tacn` and `cmd` directives when they can be unambiguously matched to productions of the grammar (in practice, that's probably almost always). `tacv` and `cmdv` directives are not updated because matching them appears to require human judgement. `doc_grammar` generates a few files that may be useful to developers and documentors. The mlg grammars present several challenges to generating an accurate grammar for documentation purposes: * The 30+ mlg files don't define an overall order in which nonterminals should appear in a complete grammar. * Even within a single mlg file, nonterminals and productions are often given in an order that's much different from what a reader of the documentation would expect. In a small number of cases, changing the order in the mlg would change how some inputs are parsed, in particular when the order determines how to distinguish otherwise ambiguous inputs. Strictly speaking, that means our grammar is not a context free grammar even though we gloss over that distinction in the documentation. * For a few nonterminals, some productions are only available if certain plugins are activated (e.g. SSR). Readers should be informed about these. * Some limited parts of the grammar are defined in OCaml, including lookahead symbols like `test_bracket_ident` and references to nonterminals in other files using qualified names such as `Prim.ident`. A few symbols are defined multiple times, such as `scope` and `orient`. ## What the tool does 1. The tool reads all the `mlg` files and generates `fullGrammar`, which includes all the grammar without the actions for each production or the OCaml code. This file is provided as a convenience to make it easier to examine the (mostly) unprocessed grammar of the mlg files with less clutter. This step includes two transformations that rename some nonterminal symbols: First, nonterminals that use levels (`"5" RIGHTA` below) are modified, for example: ``` ltac_expr: [ "5" RIGHTA [ ... ] [ "4" ... ``` becomes ``` tactic_expr5: [ | ... | tactic_expr4 ] ``` Second, nonterminals that are local to an .mlg will be renamed, if necessary, to make them unique. For example, `strategy_level` is defined as a local nonterminal in both `g_prim.mlg` and in `extraargs.mlg`. The nonterminal defined in the former remains `strategy_level` because it happens to be processed before the latter, in which the nonterminal is renamed to `EXTRAARGS_strategy_level` to make the local symbol unique. Nonterminals listed after `GLOBAL:` are global; otherwise they are local. References to renamed symbols are updated with the modified names. Note: the 4 SSR mlgs and ssreflect-proof-language.rst are currently excluded from processing (hard coded). 2. The tool applies grammar editing operations specified by `common.edit_mlg` to generate `editedGrammar`. 3. `orderedGrammar` gives the desired order for nonterminals and individual productions in the documented grammar. Developers should edit this file only to reorder lines. `doc_grammar` updates `orderedGrammar` so it has the same set of nonterminals and productions as `editedGrammar` while retaining the previous ordering. Since the position of new or renamed nonterminals is unspecified, they tend to show up in the wrong place in `orderedGrammar`, therefore users should review the output and make appropriate adjustments to the order. The update process removes manually-added comments from `orderedGrammar` while automatically-generated comments will be regenerated. 4. The tool updates the `.rst` files. Comments in the form `.. insertprodn ` indicate inserting the productions for a range of nonterminals (in `orderedGrammar` order). `.. cmd::` and `.. tacn::` directives are updated using prefixes in the form `[a-zA-Z0-9_ ]+` from the directive and the grammar. If there is unique match in the grammar, the directive is updated, if needed. Multiple matches or no match gives an error message. 5. For reference, the tool generates `prodnGrammar`, which has the entire grammar in the form of `prodns`. 6. If requested by command-line arguments `-check-cmds` or `-check-tacs`, the tool generates `prodnCommands` (for commands) and `prodnTactics` (for tactics). The former lists all commands that are under `command` in `orderedGrammar` and compares it to the `:cmd:` and `:cmdv:` given in the rst files. The latter lists all tactics that are under `simple_tactic` in the grammar and compares it to the `:tacn:` and `:tacv:`. The tags at the beginning of each line mean: - (no tag) - the grammar and the rst match exactly and uniquely - `-` - a grammar production that can't be matched to an rst file entry - `+` - an rst entry that doesn't match a grammar production - `v` - the rst entry is a `:cmdv:` or `:tacv:` - `?` - the match between the grammar and the rst files is not unique These command line arguments also generate error messages for commands and tactics that are in the grammar but not the documentation and vice versa. ## How to use the tool * `make doc_gram` updates `fullGrammar`. * `make doc_gram_verify` verifies that `fullGrammar`, `orderedGrammar` and `*.rst` are consistent with the `.mlg` files. This is for use by CI. * `make doc_gram_rsts` updates the `*Grammar` and `.rst` files. * `make doc_gram_rsts DOCGRAMWARN=1` will additionally print warnings. Changes to `fullGrammar`, `orderedGrammar` and `*.rst` should be checked in to git. The `prodn*` and other `*Grammar` files should not. ### Command line arguments The executable takes a list of `.mlg` and `.rst` files as arguments. The tool inserts the grammar into the `*.rst` as specified by comments in those files. The order of the `.mlg` files affects the order of nonterminals and productions in `fullGrammar`. The order doesn't matter for the `.rst` files. Specifying the `-verify` command line argument avoids updating any of the files, but verifies that the current files are consistent. This setting is meant for use in CI; it will be up to each developer to include the changes to `*Grammar` and the `.rst` files in their PRs when they've changed the grammar. Other command line arguments: * `-check-tacs` causes generation of `prodnTactics` * `-check-cmds` causes generation of `prodnCommands` * `-no-warn` suppresses printing of some warning messages * `-no-update` puts updates to `fullGrammar` and `orderedGrammar` into new files named `*.new`, leaving the originals unmodified. For use in Dune. * `-short` limits processing to updating/verifying only the `fullGrammar` file * `-verbose` prints more messages about the grammar * `-verify` described above ### Grammar editing scripts The grammar editing script `common.edit_mlg` is similar in format to `.mlg` files but stripped of all OCaml features. This is an easy way to include productions to match or add without writing another parser. The `DOC_GRAMMAR` token at the beginning of each file signals the use of the streamlined syntax. The edit file has a series of items in the form of productions. Items are applied in the order they appear. There are two types of editing operations: * Global edits - edit rules that apply to the entire grammar in a single operation. These are identified by using specific reserved names as the non-terminal name. * Local edits - edit rules that apply to the productions of a single non-terminal. The rule is a local edit if the non-terminal name isn't reserved. Individual productions within a local edit that begin with a different set of reserved names edit existing productions. For example `binders: [ | DELETE Pcoq.Constr.binders ]` deletes the production `binders: [ | Pcoq.Constr.binders]` Productions that don't begin with a reserved name are added to the grammar, such as `empty: [ | ]`, which adds a new non-terminal `empty` with an empty production on the right-hand side. Another example: `LEFTQMARK: [ | "?" ]` is a local edit that treats `LEFTQMARK` as the name of a non-terminal and adds a production for it. (We know that LEFTQMARK is a token but doc_grammar does not.) `SPLICE: [ | LEFTQMARK ]` requests replacing all uses of `LEFTQMARK` anywhere in the grammar with its productions and removing the non-terminal. The combined effect of these two is to replace all uses of `LEFTQMARK` with `"?"`. Here are the current operations: ### Global edits `DELETE` - deletes the specified non-terminals anywhere in the grammar. Each should appear as a separate production. Useful for removing non-terminals that only do lookahead that shouldn't be in the documentation. `RENAME` - each production specifies an (old name, new name) pair of non-terminals to rename. `SPLICE` - requests replacing all uses of the nonterminals anywhere in the grammar with its productions and removing the non-terminal. Each should appear as a separate production. (Doesn't work recursively; splicing for both `A: [ | B ]` and `B: [ | C ]` must be done in separate SPLICE operations.) `OPTINREF` - applies the local `OPTINREF` edit to every nonterminal `REACHABLE` - suppresses the "Unreachable symbol" warning for the listed nonterminals and any symbols reachable from them. `NOTINRSTS` - suppresses the "Nonterminal not included in .rst files" messages for the listed nonterminals. ### Local edits `DELETE ` - removes the specified production from the grammar `EDIT ` - modifies the specified production using the following tags that appear in the specified production: * `USE_NT ` LIST* - extracts LIST* as a new nonterminal with the specified new non-terminal name * `ADD_OPT ` - looks for a production that matches the specified production **without** ``. If found, both productions are replaced with single production with `OPT ` The current version handles a single USE_NT or ADD_OPT per EDIT. These symbols may appear in the middle of the production given in the EDIT. `APPENDALL ` - inserts at the end of every production in . `INSERTALL ` - inserts at the beginning of every production in . `REPLACE` - (2 sequential productions) - removes `` and inserts `` in its place. ``` | REPLACE | WITH ``` `COPYALL ` - creates a new nonterminal `` and copies all the productions in the nonterminal to ``. `MOVETO ` - moves the production to `` and, if needed, creates a new production -> \. `MOVEALLBUT ` - moves all the productions in the nonterminal to `` *except* for the productions following the `MOVEALLBUT` production in the edit script (terminated only by the closing `]`). `OPTINREF` - verifies that has an empty production. If so, it removes the empty production and replaces all references to throughout the grammar with `OPT ` `PRINT` - prints the nonterminal definition at that point in applying the edits. Most useful when the edits get a bit complicated to follow. `(any other nonterminal name)` - adds a new production (and possibly a new nonterminal) to the grammar. ### `.rst` file updates `doc_grammar` updates `.rst` files where it sees the following 3 lines ``` .. insertprodn .. prodn:: ``` The end of the existing `prodn` is recognized by a blank line. ### Tagging productions `doc_grammar` tags the origin of productions from plugins that aren't automatically loaded. In grammar files, they appear as `(* XXX plugin *)`. In rsts, productions generated by `.. insertprodn` will include where relevant three spaces as (a delimiter) and a tag name after each production, which Sphinx will show on the far right-hand side of the production. The origin of a production can be specified explicitly in `common.edit_mlg` with the `TAG name` appearing at the end of a production. `name` must be in quotes if it contains whitespace characters. Some edit operations preserve the tags, but others, such as `REPLACE ... WITH ...` do not. A mapping from filenames to tags (e.g. "g_ltac2.mlg" is "Ltac2") is hard-coded as is filtering to avoid showing tags for, say, Ltac2 productions from appearing on every production in that chapter. If desired, this mechanism could be extended to tag certain productions as deprecated, perhaps in conjunction with a coqpp change. coq-8.20.0/doc/tools/docgram/common.edit_mlg000066400000000000000000002171571466560755400207410ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* " LIST1 global OPT natural | WITH "Resolve" [ "->" | "<-" ] LIST1 global OPT natural | DELETE "Resolve" "<-" LIST1 global OPT natural | REPLACE "Variables" "Transparent" | WITH [ "Constants" | "Projections" | "Variables" ] [ "Transparent" | "Opaque" ] | DELETE "Variables" "Opaque" | DELETE "Constants" "Transparent" | DELETE "Constants" "Opaque" | DELETE "Projections" "Transparent" | DELETE "Projections" "Opaque" | REPLACE "Transparent" LIST1 global | WITH [ "Transparent" | "Opaque" ] LIST1 global | DELETE "Opaque" LIST1 global | REPLACE "Extern" natural OPT Constr.constr_pattern "=>" Pltac.tactic | WITH "Extern" natural OPT constr_pattern "=>" tactic | INSERTALL "Hint" | APPENDALL opt_hintbases ] (* todo: does ARGUMENT EXTEND make the symbol global? It is in both extraargs and extratactics *) strategy_level_or_var: [ | DELETE EXTRAARGS_strategy_level | strategy_level ] EXTRAARGS_natural: [ | DELETENT ] EXTRAARGS_lconstr: [ | DELETENT ] EXTRAARGS_strategy_level: [ | DELETENT ] binders: [ | DELETE Pcoq.Constr.binders ] G_TACTIC_in_clause: [ | in_clause | MOVEALLBUT in_clause | in_clause ] SPLICE: [ | G_TACTIC_in_clause ] RENAME: [ | G_LTAC2_delta_flag ltac2_delta_reductions | G_LTAC2_strategy_flag ltac2_reductions | G_LTAC2_binder ltac2_binder | G_LTAC2_branches ltac2_branches | G_LTAC2_let_clause ltac2_let_clause | G_LTAC2_rewriter ltac2_rewriter | G_LTAC2_constr_with_bindings ltac2_constr_with_bindings | G_LTAC2_match_rule ltac2_match_rule | G_LTAC2_match_pattern ltac2_match_pattern | G_LTAC2_intropatterns ltac2_intropatterns | G_LTAC2_simple_intropattern ltac2_simple_intropattern | G_LTAC2_simple_intropattern_closed ltac2_simple_intropattern_closed | G_LTAC2_or_and_intropattern ltac2_or_and_intropattern | G_LTAC2_equality_intropattern ltac2_equality_intropattern | G_LTAC2_naming_intropattern ltac2_naming_intropattern | G_LTAC2_destruction_arg ltac2_destruction_arg | G_LTAC2_with_bindings ltac2_with_bindings | G_LTAC2_bindings ltac2_bindings | G_LTAC2_simple_binding ltac2_simple_binding | G_LTAC2_in_clause ltac2_in_clause | G_LTAC2_occs ltac2_occs | G_LTAC2_occs_nums ltac2_occs_nums | G_LTAC2_concl_occ ltac2_concl_occ | G_LTAC2_hypident_occ ltac2_hypident_occ | G_LTAC2_hypident ltac2_hypident | G_LTAC2_induction_clause ltac2_induction_clause | G_LTAC2_as_or_and_ipat ltac2_as_or_and_ipat | G_LTAC2_eqn_ipat ltac2_eqn_ipat | G_LTAC2_conversion ltac2_conversion | G_LTAC2_oriented_rewriter ltac2_oriented_rewriter | G_LTAC2_for_each_goal ltac2_for_each_goal | G_LTAC2_tactic_then_last ltac2_tactic_then_last | G_LTAC2_as_name ltac2_as_name | G_LTAC2_as_ipat ltac2_as_ipat | G_LTAC2_by_tactic ltac2_by_tactic | G_LTAC2_match_list ltac2_match_list ] (* Renames to eliminate qualified names. Put other renames at the end *) RENAME: [ (* map missing names for rhs *) | Constr.constr term | Constr.term0 term0 | Constr.global global | Constr.lconstr lconstr | Constr.cpattern cpattern | G_vernac.section_subset_expr section_var_expr | Prim.ident ident | Prim.reference reference | Prim.string string | Prim.integer integer | Prim.qualid qualid | Prim.natural natural | Pvernac.Vernac_.main_entry vernac_control | Tactic.tactic tactic | Pltac.ltac_expr ltac_expr5 (* | G_vernac.def_body def_body | Prim.by_notation by_notation | Prim.natural natural *) | Vernac.fix_definition fix_definition (* todo: hmm, rename adds 1 prodn to closed_binder?? *) | Constr.closed_binder closed_binder ] (* written in OCaml *) impl_ident_head: [ | "{" ident ] lpar_id_coloneq: [ | "(" ident; ":=" ] (* lookahead symbols *) DELETE: [ | check_for_coloneq | local_test_lpar_id_colon | lookup_at_as_comma | test_only_starredidentrefs | test_bracket_ident | test_hash_ident | test_id_colon | test_lpar_id_colon | test_lpar_id_coloneq (* todo: grammar seems incorrect, repeats the "(" IDENT ":=" *) | test_lpar_nat_coloneq | test_lpar_id_rpar | test_lpar_idnum_coloneq | test_show_goal | test_name_colon | test_pipe_closedcurly | ensure_fixannot | test_array_opening | test_array_closing | test_variance_ident | test_qualid_with_or_lpar_or_rbrac | test_leftsquarebracket_equal | test_sort_qvar (* unused *) | constr_comma_sequence' | auto_using' | constr_may_eval ] (* additional nts to be spliced *) tactic_then_last: [ | REPLACE "|" LIST0 ( OPT ltac_expr5 ) SEP "|" | WITH LIST0 ( "|" ( OPT ltac_expr5 ) ) ] goal_tactics: [ | LIST0 ( OPT ltac_expr5 ) SEP "|" ] for_each_goal: [ | DELETENT ] for_each_goal: [ | goal_tactics | OPT ( goal_tactics "|" ) OPT ltac_expr5 ".." OPT ( "|" goal_tactics ) ] ltac2_tactic_then_last: [ | REPLACE "|" LIST0 ( OPT ltac2_expr6 ) SEP "|" (* Ltac2 plugin *) | WITH LIST0 ( "|" OPT ltac2_expr6 ) TAG Ltac2 ] ltac2_goal_tactics: [ | LIST0 ( OPT ltac2_expr6 ) SEP "|" TAG Ltac2 ] ltac2_for_each_goal: [ | DELETENT ] ltac2_for_each_goal: [ | ltac2_goal_tactics TAG Ltac2 | OPT ( ltac2_goal_tactics "|" ) OPT ltac2_expr6 ".." OPT ( "|" ltac2_goal_tactics ) TAG Ltac2 ] reference: [ | DELETENT ] reference: [ | qualid ] fullyqualid: [ | DELETENT ] fullyqualid: [ | qualid ] qualid: [ | DELETENT ] qualid: [ | ident LIST0 ("." ident) ] field: [ | DELETENT ] fields: [ | DELETENT ] dirpath: [ | REPLACE ident LIST0 field | WITH LIST0 ( ident "." ) ident ] let_type_cstr: [ | DELETE OPT [ ":" lconstr ] | type_cstr ] case_item: [ | REPLACE term100 OPT [ "as" name ] OPT [ "in" pattern200 ] | WITH term100 OPT ("as" name) OPT [ "in" pattern200 ] ] type: [ | term200 ] one_type: [ | constr ] term_forall_or_fun: [ | "forall" open_binders "," type ] binder_constr: [ | DELETE "forall" open_binders "," term200 | MOVETO term_forall_or_fun "fun" open_binders "=>" term200 | MOVETO term_let "let" name binders let_type_cstr ":=" term200 "in" term200 | MOVETO term_if "if" term200 as_return_type "then" term200 "else" term200 | MOVETO term_fix "let" "fix" fix_decl "in" term200 | MOVETO term_cofix "let" "cofix" cofix_body "in" term200 | MOVETO term_let "let" [ "(" LIST0 name SEP "," ")" | "()" ] as_return_type ":=" term200 "in" term200 | MOVETO term_let "let" "'" pattern200 ":=" term200 "in" term200 | MOVETO term_let "let" "'" pattern200 ":=" term200 case_type "in" term200 | MOVETO term_let "let" "'" pattern200 "in" pattern200 ":=" term200 case_type "in" term200 | MOVETO term_fix "fix" fix_decls | MOVETO term_cofix "cofix" cofix_decls ] term_let: [ | REPLACE "let" name binders let_type_cstr ":=" term200 "in" term200 | WITH "let" name let_type_cstr ":=" term200 "in" term200 | "let" name LIST1 binder let_type_cstr ":=" term200 "in" term200 (* Don't need to document that "( )" is equivalent to "()" *) | REPLACE "let" [ "(" LIST0 name SEP "," ")" | "()" ] as_return_type ":=" term200 "in" term200 | WITH "let" "(" LIST0 name SEP "," ")" as_return_type ":=" term200 "in" term200 | MOVETO destructuring_let "let" "(" LIST0 name SEP "," ")" as_return_type ":=" term200 "in" term200 | REPLACE "let" "'" pattern200 ":=" term200 "in" term200 | WITH "let" "'" pattern200 ":=" term200 OPT case_type "in" term200 | DELETE "let" "'" pattern200 ":=" term200 case_type "in" term200 | MOVETO destructuring_let "let" "'" pattern200 ":=" term200 OPT case_type "in" term200 | MOVETO destructuring_let "let" "'" pattern200 "in" pattern200 ":=" term200 case_type "in" term200 ] qualid_annotated: [ | global univ_annot ] atomic_constr: [ | qualid_annotated | MOVETO term_evar "_" | REPLACE "?" "[" identref "]" | WITH "?[" identref "]" | MOVETO term_evar "?[" identref "]" | REPLACE "?" "[" pattern_ident "]" | WITH "?[" pattern_ident "]" | MOVETO term_evar "?[" pattern_ident "]" | MOVETO term_evar pattern_ident evar_instance ] ltac_expr0: [ | REPLACE "[" ">" for_each_goal "]" | WITH "[>" for_each_goal "]" ] (* lexer token *) IDENT: [ | ident ] scope_key: [ | IDENT ] scope_name: [ | IDENT ] scope: [ | scope_name | scope_key ] scope_delimiter: [ | REPLACE "%" IDENT | WITH "%" scope | REPLACE "%_" IDENT | WITH "%_" scope ] sort: [ | REPLACE "Type" "@{" reference "|" universe "}" | WITH "Type" "@{" OPT [ qualid "|" ] universe "}" | DELETE "Type" "@{" universe "}" ] term100: [ | REPLACE term99 "<:" term200 | WITH term99 "<:" type | MOVETO term_cast term99 "<:" type | REPLACE term99 "<<:" term200 | WITH term99 "<<:" type | MOVETO term_cast term99 "<<:" type | REPLACE term99 ":>" term200 | WITH term99 ":>" type | MOVETO term_cast term99 ":>" type | REPLACE term99 ":" term200 | WITH term99 ":" type | MOVETO term_cast term99 ":" type ] constr: [ | REPLACE "@" global univ_annot | WITH "@" qualid_annotated | MOVETO term_explicit "@" qualid_annotated ] term10: [ (* Separate this LIST0 in the nonempty and the empty case *) (* The empty case is covered by constr *) | REPLACE "@" global univ_annot LIST0 term9 | WITH "@" qualid_annotated LIST1 term9 | REPLACE term9 | WITH constr | MOVETO term_application term9 LIST1 arg | MOVETO term_application "@" qualid_annotated LIST1 term9 (* fixme: add in as a prodn somewhere *) | MOVETO dangling_pattern_extension_rule "@" pattern_ident LIST1 identref | DELETE dangling_pattern_extension_rule ] term9: [ (* @Zimmi48: Special token .. is for use in the Notation command. (see bug_3304.v) *) | DELETE ".." term0 ".." ] term1: [ | REPLACE term0 ".(" global univ_annot LIST0 arg ")" | WITH term0 ".(" global univ_annot LIST0 arg ")" (* huh? *) | REPLACE term0 "%" IDENT | WITH term0 "%" scope_key | MOVETO term_scope term0 "%" scope_key | REPLACE term0 "%_" IDENT | WITH term0 "%_" scope_key | MOVETO term_scope term0 "%_" scope_key | MOVETO term_projection term0 ".(" global univ_annot LIST0 arg ")" | MOVETO term_projection term0 ".(" "@" global univ_annot LIST0 ( term9 ) ")" ] term0: [ | DELETE ident univ_annot | DELETE ident Prim.fields univ_annot | REPLACE "{|" record_declaration bar_cbrace | WITH "{|" LIST0 field_def SEP ";" OPT ";" bar_cbrace | MOVETO number_or_string NUMBER | MOVETO number_or_string string | MOVETO term_record "{|" LIST0 field_def SEP ";" OPT ";" bar_cbrace | MOVETO term_generalizing "`{" term200 "}" | MOVETO term_generalizing "`(" term200 ")" | MOVETO term_ltac "ltac" ":" "(" ltac_expr5 ")" | REPLACE "[" "|" array_elems "|" lconstr type_cstr "|" "]" univ_annot | WITH "[|" array_elems "|" lconstr type_cstr "|]" univ_annot ] fix_decls: [ | DELETE fix_decl | REPLACE fix_decl "with" LIST1 fix_decl SEP "with" "for" identref | WITH fix_decl OPT ( LIST1 ("with" fix_decl) "for" identref ) ] cofix_decls: [ | DELETE cofix_body | REPLACE cofix_body "with" LIST1 cofix_body SEP "with" "for" identref | WITH cofix_body OPT ( LIST1 ( "with" cofix_body ) "for" identref ) ] fields_def: [ | REPLACE field_def ";" fields_def | WITH LIST1 field_def SEP ";" | DELETE field_def ] binders_fixannot: [ | DELETE binder binders_fixannot | DELETE fixannot | DELETE (* empty *) | LIST0 binder OPT fixannot ] binder: [ | DELETE name ] open_binders: [ | REPLACE name LIST0 name ":" lconstr | WITH LIST1 name ":" type (* @Zimmi48: Special token .. is for use in the Notation command. (see bug_3304.v) *) | DELETE name ".." name | REPLACE name LIST0 name binders | WITH LIST1 binder | DELETE closed_binder binders ] closed_binder: [ | name | REPLACE "(" name LIST1 name ":" lconstr ")" | WITH "(" LIST1 name ":" type ")" | DELETE "(" name ":" lconstr ")" | DELETE "(" name ":=" lconstr ")" | REPLACE "(" name ":" lconstr ":=" lconstr ")" | WITH "(" name type_cstr ":=" lconstr ")" | DELETE "{" name "}" | DELETE "{" name LIST1 name "}" | REPLACE "{" name LIST1 name ":" lconstr "}" | WITH "{" LIST1 name type_cstr "}" | DELETE "{" name ":" lconstr "}" | MOVETO implicit_binders "{" LIST1 name type_cstr "}" | DELETE "[" name "]" | DELETE "[" name LIST1 name "]" | REPLACE "[" name LIST1 name ":" lconstr "]" | WITH "[" LIST1 name type_cstr "]" | DELETE "[" name ":" lconstr "]" | MOVETO implicit_binders "[" LIST1 name type_cstr "]" | REPLACE "(" Prim.name ":" lconstr "|" lconstr ")" | WITH "(" Prim.name ":" type "|" lconstr ")" | MOVETO generalizing_binder "`(" LIST1 typeclass_constraint SEP "," ")" | MOVETO generalizing_binder "`{" LIST1 typeclass_constraint SEP "," "}" | MOVETO generalizing_binder "`[" LIST1 typeclass_constraint SEP "," "]" ] (* next two used internally for declaring notations *) one_closed_binder: [ | DELETENT ] one_open_binder: [ | DELETENT ] name_colon: [ | name ":" ] typeclass_constraint: [ | EDIT ADD_OPT "!" term200 | REPLACE "{" name "}" ":" [ "!" | ] term200 | WITH "{" name "}" ":" OPT "!" term200 | REPLACE name ":" [ "!" | ] term200 | WITH name ":" OPT "!" term200 ] (* ?? From the grammar, Prim.name seems to be only "_" but ident is also accepted "*) Prim.name: [ | REPLACE "_" | WITH name ] oriented_rewriter: [ | REPLACE orient_rw rewriter | WITH orient rewriter ] DELETE: [ | orient_rw ] pattern10: [ | REPLACE pattern1 LIST1 pattern1 | WITH pattern1 LIST0 pattern1 | DELETE pattern1 ] pattern1: [ | REPLACE pattern0 "%" IDENT | WITH pattern0 "%" scope_key | REPLACE pattern0 "%_" IDENT | WITH pattern0 "%_" scope_key ] pattern0: [ | REPLACE "(" pattern200 ")" | WITH "(" LIST1 pattern200 SEP "|" ")" | DELETE "(" pattern200 "|" LIST1 pattern200 SEP "|" ")" | REPLACE "{|" record_patterns bar_cbrace | WITH "{|" LIST0 record_pattern bar_cbrace ] DELETE: [ | record_patterns ] eqn: [ | REPLACE LIST1 mult_pattern SEP "|" "=>" lconstr | WITH LIST1 [ LIST1 pattern100 SEP "," ] SEP "|" "=>" lconstr ] (* No constructor syntax, OPT [ "|" binders ] is not supported for Record *) record_definition: [ | opt_coercion ident_decl binders OPT [ ":" sort ] OPT ( ":=" OPT [ identref ] "{" record_fields "}" OPT [ "as" identref ] ) ] (* No mixed inductive-record definitions, opt_coercion is meaningless for Inductive *) inductive_definition: [ | cumul_ident_decl binders OPT [ "|" binders ] OPT [ ":" type ] ":=" OPT "|" LIST1 constructor SEP "|" decl_notations ] (* No mutual recursion, no inductive classes, type must be a sort *) (* constructor is optional but "Class record_definition" covers that case *) singleton_class_definition: [ | ident_decl binders OPT [ ":" sort ] ":=" constructor ] (* No record syntax, opt_coercion not supported for Variant, := ... required *) variant_definition: [ | ident_decl binders OPT [ "|" binders ] OPT [ ":" type ] ":=" OPT "|" LIST1 constructor SEP "|" decl_notations ] gallina: [ | REPLACE thm_token ident_decl binders ":" lconstr LIST0 [ "with" ident_decl binders ":" lconstr ] | WITH thm_token ident_decl binders ":" type LIST0 [ "with" ident_decl binders ":" type ] | DELETE assumptions_token inline assum_list | DELETE "Symbols" assum_list | REPLACE "Symbol" assum_list | WITH [ "Symbol" | "Symbols" ] assum_list | REPLACE inductive_token LIST1 inductive_or_record_definition SEP "with" | WITH "Inductive" inductive_definition LIST0 ( "with" inductive_definition ) | "Inductive" record_definition LIST0 ( "with" record_definition ) | "CoInductive" inductive_definition LIST0 ( "with" inductive_definition ) | "CoInductive" record_definition LIST0 ( "with" record_definition ) | REPLACE finite_token inductive_or_record_definition | WITH "Variant" variant_definition | [ "Record" | "Structure" ] record_definition | "Class" record_definition | "Class" singleton_class_definition | REPLACE "Fixpoint" LIST1 fix_definition SEP "with" | WITH "Fixpoint" fix_definition LIST0 ( "with" fix_definition ) | REPLACE "Let" "Fixpoint" LIST1 fix_definition SEP "with" | WITH "Let" "Fixpoint" fix_definition LIST0 ( "with" fix_definition ) | REPLACE "CoFixpoint" LIST1 cofix_definition SEP "with" | WITH "CoFixpoint" cofix_definition LIST0 ( "with" cofix_definition ) | REPLACE "Let" "CoFixpoint" LIST1 cofix_definition SEP "with" | WITH "Let" "CoFixpoint" cofix_definition LIST0 ( "with" cofix_definition ) | REPLACE "Scheme" LIST1 scheme SEP "with" | WITH "Scheme" scheme LIST0 ( "with" scheme ) | DELETE "Scheme" "Boolean" "Equality" "for" smart_global | DELETE "Scheme" "Equality" "for" smart_global | "Scheme" OPT "Boolean" "Equality" "for" smart_global | DELETE "Rewrite" "Rules" identref ":=" OPT "|" LIST1 rewrite_rule SEP "|" | REPLACE "Rewrite" "Rule" identref ":=" OPT "|" LIST1 rewrite_rule SEP "|" | WITH "Rewrite" [ "Rule" | "Rules" ] identref ":=" OPT "|" LIST1 rewrite_rule SEP "|" ] SPLICE: [ | variant_definition ] finite_token: [ | DELETENT ] inductive_token: [ | DELETENT ] inductive_or_record_definition: [ | DELETENT ] constructors_or_record: [ | DELETENT ] (* decl_notations not allowed for Record, Structure or Class *) record_field: [ | REPLACE quoted_attributes record_binder OPT [ "|" natural ] decl_notations | WITH quoted_attributes record_binder OPT [ "|" natural ] ] record_fields: [ | REPLACE record_field ";" record_fields | WITH LIST0 record_field SEP ";" OPT ";" | DELETE record_field | DELETE (* empty *) ] assumptions_token: [ | DELETENT ] inline: [ | REPLACE "Inline" "(" natural ")" | WITH "Inline" OPT ( "(" natural ")" ) | DELETE "Inline" ] univ_decl: [ | REPLACE "@{" test_univ_decl LIST0 identref "|" LIST0 identref [ "+" | ] univ_decl_constraints | WITH "@{" OPT [ LIST0 identref "|" ] LIST0 identref OPT "+" OPT [ "|" LIST0 univ_constraint SEP "," OPT "+" ] "}" | DELETE "@{" LIST0 identref [ "+" | ] univ_decl_constraints ] cumul_univ_decl: [ | REPLACE "@{" test_cumul_univ_decl LIST0 identref "|" LIST0 variance_identref [ "+" | ] univ_decl_constraints | WITH "@{" OPT [ LIST0 identref "|" ] LIST0 variance_identref OPT "+" OPT [ "|" LIST0 univ_constraint SEP "," OPT "+" ] "}" | DELETE "@{" LIST0 variance_identref [ "+" | ] univ_decl_constraints ] of_type: [ | DELETENT ] of_type: [ | [ ":" | ":>" ] type ] of_type_inst: [ | DELETENT ] of_type_inst: [ | [ ":" | ":>" | "::" | "::>" ] type ] def_body: [ | DELETE binders ":=" reduce lconstr | REPLACE binders ":" lconstr ":=" reduce lconstr | WITH LIST0 binder OPT (":" type) ":=" reduce lconstr | REPLACE binders ":" lconstr | WITH LIST0 binder ":" type ] delta_flag: [ | REPLACE "-" "[" LIST1 smart_global "]" | WITH OPT "-" "[" LIST1 smart_global "]" | DELETE "[" LIST1 smart_global "]" | OPTINREF ] ltac2_delta_reductions: [ | EDIT ADD_OPT "-" "[" refglobals "]" (* Ltac2 plugin *) ] ltac2_branches: [ | EDIT ADD_OPT "|" LIST1 branch SEP "|" (* Ltac2 plugin *) ] strategy_flag: [ | REPLACE OPT "head" OPT delta_flag | WITH OPT "head" delta_flag (*| REPLACE LIST1 red_flags | WITH LIST1 red_flag*) | (* empty *) ] filtered_import: [ | REPLACE global "(" LIST1 one_import_filter_name SEP "," ")" | WITH global OPT [ "(" LIST1 one_import_filter_name SEP "," ")" ] | DELETE global ] is_module_expr: [ | REPLACE ":=" module_expr_inl LIST0 ext_module_expr | WITH ":=" LIST1 module_expr_inl SEP "<+" ] is_module_type: [ | REPLACE ":=" module_type_inl LIST0 ext_module_type | WITH ":=" LIST1 module_type_inl SEP "<+" ] gallina_ext: [ | REPLACE "Arguments" smart_global LIST0 arg_specs OPT [ "," LIST1 [ LIST0 implicits_alt ] SEP "," ] OPT [ ":" LIST1 args_modifier SEP "," ] | WITH "Arguments" smart_global LIST0 arg_specs LIST0 [ "," LIST0 implicits_alt ] OPT [ ":" LIST1 args_modifier SEP "," ] | REPLACE "Implicit" "Type" reserv_list | WITH "Implicit" [ "Type" | "Types" ] reserv_list | DELETE "Implicit" "Types" reserv_list (* Per @Zimmi48, the global (qualid) must be a simple identifier if def_body is present Note that smart_global is "qualid | by_notation" and that ident_decl is "ident OPT univ_decl"; move *) | REPLACE "Canonical" OPT "Structure" global OPT [ OPT univ_decl def_body ] | WITH "Canonical" OPT "Structure" ident_decl def_body | REPLACE "Canonical" OPT "Structure" by_notation | WITH "Canonical" OPT "Structure" smart_global | DELETE "Coercion" global ":" coercion_class ">->" coercion_class | REPLACE "Coercion" by_notation ":" coercion_class ">->" coercion_class | WITH "Coercion" smart_global OPT [ ":" coercion_class ">->" coercion_class ] (* semantically restricted per https://github.com/coq/coq/pull/12936#discussion_r492705820 *) (* global OPT univ_decl is just ident_decl, the first OPT is moved to the rule above *) | REPLACE "Coercion" global OPT [ OPT univ_decl def_body ] | WITH "Coercion" ident_decl def_body | REPLACE "Include" "Type" module_type_inl LIST0 ext_module_type | WITH "Include" "Type" LIST1 module_type_inl SEP "<+" | REPLACE "Generalizable" [ "All" "Variables" | "No" "Variables" | [ "Variable" | "Variables" ] LIST1 identref ] | WITH "Generalizable" [ [ "Variable" | "Variables" ] LIST1 identref | "All" "Variables" | "No" "Variables" ] (* don't show Export for Set, Unset *) | DELETE "Export" "Set" setting_name option_setting | REPLACE "Export" "Unset" setting_name | WITH "Unset" setting_name | REPLACE "Instance" instance_name ":" term200 hint_info [ ":=" "{" record_declaration "}" | ":=" lconstr | ] | WITH "Instance" instance_name ":" type hint_info OPT [ ":=" "{" record_declaration "}" | ":=" lconstr ] | DELETE "Require" export_token LIST1 filtered_import | REPLACE "From" global "Require" export_token LIST1 filtered_import | WITH OPT [ "From" dirpath ] "Require" export_token LIST1 filtered_import | REPLACE "From" global "Extra" "Dependency" ne_string OPT [ "as" IDENT ] | WITH "From" dirpath "Extra" "Dependency" ne_string OPT [ "as" IDENT ] ] export_token: [ | REPLACE "Import" OPT import_categories | WITH [ "Import" | "Export" ] OPT import_categories | DELETE "Export" OPT import_categories ] (* lexer stuff *) LEFTQMARK: [ | "?" ] digit: [ | "0" ".." "9" ] decnat: [ | digit LIST0 [ digit | "_" ] ] hexdigit: [ | [ "0" ".." "9" | "a" ".." "f" | "A" ".." "F" ] ] hexnat: [ | [ "0x" | "0X" ] hexdigit LIST0 [ hexdigit | "_" ] ] bignat: [ | REPLACE NUMBER | WITH [ decnat | hexnat ] ] number: [ | OPT "-" decnat OPT ( "." LIST1 [ digit | "_" ] ) OPT ( [ "e" | "E" ] OPT [ "+" | "-" ] decnat ) | OPT "-" hexnat OPT ( "." LIST1 [ hexdigit | "_" ] ) OPT ( [ "p" | "P" ] OPT [ "+" | "-" ] decnat ) ] bigint: [ | DELETE bignat | REPLACE test_minus_nat "-" bignat | WITH OPT "-" bignat ] first_letter: [ | [ "a" ".." "z" | "A" ".." "Z" | "_" | unicode_letter ] ] subsequent_letter: [ | [ first_letter | digit | "'" | unicode_id_part ] ] ident: [ | DELETE IDENT | first_letter LIST0 subsequent_letter ] NUMBER: [ | number ] (* todo: QUOTATION only used in a test suite .mlg files, is it documented/useful? *) string: [ | DELETENT ] STRING: [ | string ] (* todo: is "bigint" useful?? *) (* todo: "check_int" in g_prim.mlg should be "check_num" *) (* added productions *) command_entry: [ | noedit_mode ] DELETE: [ | tactic_then_locality ] ltac_constructs: [ (* repeated in main ltac grammar - need to create a COPY edit *) | ltac_expr3 ";" [ ltac_expr3 ] | ltac_expr3 ";" "[" for_each_goal "]" | ltac_expr1 "+" [ ltac_expr2 ] | ltac_expr1 "||" [ ltac_expr2 ] (* | qualid LIST0 tactic_value add later due renaming tactic_value *) | "[>" for_each_goal "]" | toplevel_selector ltac_expr5 ] ltac_expr4: [ | REPLACE ltac_expr3 ";" for_each_goal "]" | WITH ltac_expr3 ";" "[" for_each_goal "]" ] l3_tactic: [ ] ltac_expr3: [ | DELETE "abstract" ltac_expr2 | REPLACE "abstract" ltac_expr2 "using" ident | WITH "abstract" ltac_expr2 OPT ( "using" ident ) | l3_tactic | MOVEALLBUT ltac_builtins | l3_tactic | ltac_expr2 ] l2_tactic: [ ] ltac_expr2: [ | MOVETO ltac_builtins "tryif" ltac_expr5 "then" ltac_expr5 "else" ltac_expr2 | l2_tactic | DELETE ltac_builtins ] l1_tactic: [ ] ltac_expr1: [ | REPLACE "let" [ "rec" | ] LIST1 let_clause SEP "with" "in" ltac_expr5 | WITH "let" OPT "rec" let_clause LIST0 ( "with" let_clause ) "in" ltac_expr5 | EDIT match_key ADD_OPT "reverse" "goal" "with" match_context_list "end" | MOVETO simple_tactic match_key OPT "reverse" "goal" "with" match_context_list "end" | MOVETO simple_tactic match_key ltac_expr5 "with" match_list "end" | REPLACE failkw [ nat_or_var | ] LIST0 message_token | WITH failkw OPT nat_or_var LIST0 message_token | REPLACE reference LIST0 tactic_arg | WITH reference LIST1 tactic_arg | l1_tactic | DELETE simple_tactic | MOVEALLBUT ltac_builtins | l1_tactic | tactic_value | reference LIST1 tactic_arg | ltac_expr0 ] (* split match_context_rule *) goal_pattern: [ | LIST0 match_hyp SEP "," "|-" match_pattern | "[" LIST0 match_hyp SEP "," "|-" match_pattern "]" | "_" ] match_context_rule: [ | DELETE LIST0 match_hyp SEP "," "|-" match_pattern "=>" ltac_expr5 | DELETE "[" LIST0 match_hyp SEP "," "|-" match_pattern "]" "=>" ltac_expr5 | DELETE "_" "=>" ltac_expr5 | goal_pattern "=>" ltac_expr5 ] match_context_list: [ | EDIT ADD_OPT "|" LIST1 match_context_rule SEP "|" ] match_list: [ | EDIT ADD_OPT "|" LIST1 match_rule SEP "|" ] match_rule: [ (* redundant; match_pattern -> term -> _ *) | DELETE "_" "=>" ltac_expr5 ] goal_selector: [ | REPLACE range_selector_or_nth (* depends on whether range_selector_or_nth is deleted first *) | WITH LIST1 range_selector SEP "," ] range_selector_or_nth: [ | DELETENT ] firstorder_rhs: [ | firstorder_using | "with" LIST1 preident | firstorder_using "with" LIST1 preident ] where: [ | "at" "top" | "at" "bottom" | "after" ident | "before" ident ] simple_occurrences: [ (* placeholder (yuck) *) ] simple_tactic: [ | REPLACE "assert" "(" identref ":" lconstr ")" by_tactic | WITH "assert" "(" identref ":" type ")" by_tactic | REPLACE "assert" constr as_ipat by_tactic | WITH "assert" one_type as_ipat by_tactic | REPLACE "eassert" "(" identref ":" lconstr ")" by_tactic | WITH "eassert" "(" identref ":" type ")" by_tactic | REPLACE "eassert" constr as_ipat by_tactic | WITH "eassert" one_type as_ipat by_tactic | REPLACE "cut" constr | WITH "cut" one_type | REPLACE "evar" constr | WITH "evar" one_type | REPLACE "absurd" constr | WITH "absurd" one_type | REPLACE "enough" "(" identref ":" lconstr ")" by_tactic | WITH "enough" "(" identref ":" type ")" by_tactic | REPLACE "enough" constr as_ipat by_tactic | WITH "enough" one_type as_ipat by_tactic | REPLACE "eenough" "(" identref ":" lconstr ")" by_tactic | WITH "eenough" "(" identref ":" type ")" by_tactic | REPLACE "eenough" constr as_ipat by_tactic | WITH "eenough" one_type as_ipat by_tactic | DELETE "autorewrite" "with" LIST1 preident clause | DELETE "autorewrite" "with" LIST1 preident clause "using" tactic | DELETE "autorewrite" "*" "with" LIST1 preident clause | REPLACE "autorewrite" "*" "with" LIST1 preident clause "using" tactic | WITH "autorewrite" OPT "*" "with" LIST1 preident clause OPT ( "using" tactic ) | REPLACE "autounfold" hintbases clause_dft_concl | WITH "autounfold" hintbases OPT simple_occurrences | REPLACE "red" clause_dft_concl | WITH "red" simple_occurrences | REPLACE "simpl" OPT "head" OPT delta_flag OPT ref_or_pattern_occ clause_dft_concl | WITH "simpl" OPT "head" OPT delta_flag OPT ref_or_pattern_occ simple_occurrences | REPLACE "hnf" clause_dft_concl | WITH "hnf" simple_occurrences | REPLACE "cbv" strategy_flag clause_dft_concl | WITH "cbv" strategy_flag simple_occurrences | REPLACE "compute" OPT delta_flag clause_dft_concl | WITH "compute" OPT delta_flag simple_occurrences | REPLACE "lazy" strategy_flag clause_dft_concl | WITH "lazy" strategy_flag simple_occurrences | REPLACE "cbn" strategy_flag clause_dft_concl | WITH "cbn" strategy_flag simple_occurrences | REPLACE "fold" LIST1 constr clause_dft_concl | WITH "fold" LIST1 constr simple_occurrences | DELETE "clear" LIST0 hyp | REPLACE "clear" "-" LIST1 hyp | WITH "clear" OPT ( OPT "-" LIST1 hyp ) | DELETE "cofix" ident | REPLACE "cofix" ident "with" LIST1 cofixdecl | WITH "cofix" ident OPT ( "with" LIST1 cofixdecl ) | DELETE "constructor" | DELETE "constructor" nat_or_var | REPLACE "constructor" nat_or_var "with" bindings | WITH "constructor" OPT nat_or_var OPT ( "with" bindings ) | DELETE "econstructor" | DELETE "econstructor" nat_or_var | REPLACE "econstructor" nat_or_var "with" bindings | WITH "econstructor" OPT ( nat_or_var OPT ( "with" bindings ) ) | DELETE "dependent" [ "simple" "inversion" | "inversion" | "inversion_clear" ] quantified_hypothesis as_or_and_ipat OPT [ "with" constr ] | "dependent" "inversion" quantified_hypothesis as_or_and_ipat OPT [ "with" constr ] | "dependent" "simple" "inversion" quantified_hypothesis as_or_and_ipat OPT [ "with" constr ] | "dependent" "inversion_clear" quantified_hypothesis as_or_and_ipat OPT [ "with" constr ] | DELETE "dependent" "rewrite" orient constr | REPLACE "dependent" "rewrite" orient constr "in" hyp | WITH "dependent" "rewrite" orient constr OPT ( "in" hyp ) | "firstorder" OPT tactic firstorder_rhs | DELETE "firstorder" OPT tactic firstorder_using | DELETE "firstorder" OPT tactic "with" LIST1 preident | DELETE "firstorder" OPT tactic firstorder_using "with" LIST1 preident | DELETE "fix" ident natural | REPLACE "fix" ident natural "with" LIST1 fixdecl | WITH "fix" ident natural OPT ( "with" LIST1 fixdecl ) | DELETE "generalize" constr | REPLACE "generalize" constr LIST1 constr | WITH "generalize" LIST1 constr | REPLACE "generalize" constr occs as_name LIST0 [ "," pattern_occ as_name ] | WITH "generalize" LIST1 [ pattern_occ as_name ] SEP "," | REPLACE "evar" "(" ident ":" lconstr ")" | WITH "evar" "(" ident ":" type ")" | EDIT "simplify_eq" ADD_OPT destruction_arg | EDIT "esimplify_eq" ADD_OPT destruction_arg | EDIT "discriminate" ADD_OPT destruction_arg | EDIT "ediscriminate" ADD_OPT destruction_arg | DELETE "injection" | DELETE "injection" destruction_arg | DELETE "injection" "as" LIST0 simple_intropattern | REPLACE "injection" destruction_arg "as" LIST0 simple_intropattern | WITH "injection" OPT destruction_arg OPT ( "as" LIST0 simple_intropattern ) | DELETE "einjection" | DELETE "einjection" destruction_arg | DELETE "einjection" "as" LIST0 simple_intropattern | REPLACE "einjection" destruction_arg "as" LIST0 simple_intropattern | WITH "einjection" OPT destruction_arg OPT ( "as" LIST0 simple_intropattern ) | EDIT "simple" "injection" ADD_OPT destruction_arg | DELETE "intro" (* todo: change the mlg to simplify! *) | DELETE "intro" ident | DELETE "intro" ident "at" "top" | DELETE "intro" ident "at" "bottom" | DELETE "intro" ident "after" hyp | DELETE "intro" ident "before" hyp | DELETE "intro" "at" "top" | DELETE "intro" "at" "bottom" | DELETE "intro" "after" hyp | DELETE "intro" "before" hyp | "intro" OPT ident OPT where | DELETE "intros" | REPLACE "intros" ne_intropatterns | WITH "intros" intropatterns | DELETE "eintros" | REPLACE "eintros" ne_intropatterns | WITH "eintros" intropatterns | DELETE "move" hyp "at" "top" | DELETE "move" hyp "at" "bottom" | DELETE "move" hyp "after" hyp | DELETE "move" hyp "before" hyp | "move" ident where | REPLACE "refine" uconstr | WITH OPT "simple" OPT "notypeclasses" "refine" uconstr | DELETE "simple" "refine" uconstr | DELETE "notypeclasses" "refine" uconstr | DELETE "simple" "notypeclasses" "refine" uconstr | DELETE "replace" "->" uconstr clause | DELETE "replace" "<-" uconstr clause | DELETE "replace" uconstr clause | "replace" orient uconstr clause | REPLACE "replace" uconstr "with" constr clause by_arg_tac | WITH "replace" orient constr "with" constr clause OPT ( "by" ltac_expr3 ) | DELETE "replace" "->" uconstr "with" constr clause by_arg_tac | DELETE "replace" "<-" uconstr "with" constr clause by_arg_tac | REPLACE "rewrite" "*" orient uconstr "in" hyp "at" occurrences by_arg_tac | WITH "rewrite" "*" orient uconstr OPT ( "in" hyp ) OPT ( "at" occurrences ) by_arg_tac | DELETE "rewrite" "*" orient uconstr "in" hyp by_arg_tac | DELETE "rewrite" "*" orient uconstr "at" occurrences by_arg_tac | DELETE "rewrite" "*" orient uconstr by_arg_tac | DELETE "setoid_rewrite" orient glob_constr_with_bindings | DELETE "setoid_rewrite" orient glob_constr_with_bindings "in" hyp | DELETE "setoid_rewrite" orient glob_constr_with_bindings "at" occurrences | REPLACE "setoid_rewrite" orient glob_constr_with_bindings "at" occurrences "in" hyp | WITH "setoid_rewrite" orient glob_constr_with_bindings OPT ( "at" occurrences ) OPT ( "in" hyp ) | REPLACE "stepl" constr "by" tactic | WITH "stepl" constr OPT ( "by" tactic ) | DELETE "stepl" constr | REPLACE "stepr" constr "by" tactic | WITH "stepr" constr OPT ( "by" tactic ) | DELETE "stepr" constr | DELETE "unify" constr constr | REPLACE "unify" constr constr "with" preident | WITH "unify" constr constr OPT ( "with" preident ) | DELETE "destauto" | REPLACE "destauto" "in" hyp | WITH "destauto" OPT ( "in" hyp ) | REPLACE "autounfold_one" hintbases "in" hyp | WITH "autounfold_one" hintbases OPT ( "in" hyp ) | DELETE "autounfold_one" hintbases | REPLACE "rewrite_db" preident "in" hyp | WITH "rewrite_db" preident OPT ( "in" hyp ) | DELETE "rewrite_db" preident | DELETE "setoid_symmetry" | REPLACE "setoid_symmetry" "in" hyp | WITH "setoid_symmetry" OPT ( "in" hyp ) | REPLACE "rewrite_strat" rewstrategy "in" hyp | WITH "rewrite_strat" rewstrategy OPT ( "in" hyp ) | DELETE "rewrite_strat" rewstrategy | REPLACE "protect_fv" string "in" ident | WITH "protect_fv" string OPT ( "in" ident ) | DELETE "protect_fv" string | DELETE "symmetry" | REPLACE "symmetry" "in" in_clause | WITH "symmetry" OPT simple_occurrences | DELETE "split" | REPLACE "split" "with" bindings | WITH "split" OPT ( "with" bindings ) | DELETE "esplit" | REPLACE "esplit" "with" bindings | WITH "esplit" OPT ( "with" bindings ) | DELETE "specialize" constr_with_bindings | REPLACE "specialize" constr_with_bindings "as" simple_intropattern | WITH "specialize" constr_with_bindings as_ipat | DELETE "exists" | REPLACE "exists" LIST1 bindings SEP "," | WITH "exists" LIST0 bindings SEP "," | DELETE "eexists" | REPLACE "eexists" LIST1 bindings SEP "," | WITH "eexists" LIST0 bindings SEP "," | DELETE "left" | REPLACE "left" "with" bindings | WITH "left" OPT ( "with" bindings ) | DELETE "eleft" | REPLACE "eleft" "with" bindings | WITH "eleft" OPT ( "with" bindings ) | DELETE "right" | REPLACE "right" "with" bindings | WITH "right" OPT ( "with" bindings ) | DELETE "eright" | REPLACE "eright" "with" bindings | WITH "eright" OPT ( "with" bindings ) | DELETE "finish_timing" OPT string | REPLACE "finish_timing" "(" string ")" OPT string | WITH "finish_timing" OPT ( "(" string ")" ) OPT string | REPLACE "subst" LIST1 hyp | WITH "subst" LIST0 hyp | DELETE "subst" | DELETE "congruence" OPT natural | REPLACE "congruence" OPT natural "with" LIST1 constr | WITH "congruence" OPT natural OPT ( "with" LIST1 constr ) | DELETE "simple" "congruence" OPT natural | REPLACE "simple" "congruence" OPT natural "with" LIST1 constr | WITH "simple" "congruence" OPT natural OPT ( "with" LIST1 constr ) | DELETE "show" "ltac" "profile" | REPLACE "show" "ltac" "profile" "cutoff" integer | WITH "show" "ltac" "profile" OPT [ "cutoff" integer | string ] | DELETE "show" "ltac" "profile" string (* perversely, the mlg uses "tactic3" instead of "ltac_expr3" *) | DELETE "transparent_abstract" tactic3 | REPLACE "transparent_abstract" tactic3 "using" ident | WITH "transparent_abstract" ltac_expr3 OPT ( "using" ident ) | "typeclasses" "eauto" OPT [ "bfs" | "dfs" | "best_effort" ] OPT nat_or_var OPT ( "with" LIST1 preident ) | DELETE "typeclasses" "eauto" "dfs" OPT nat_or_var "with" LIST1 preident | DELETE "typeclasses" "eauto" "dfs" OPT nat_or_var | DELETE "typeclasses" "eauto" "bfs" OPT nat_or_var "with" LIST1 preident | DELETE "typeclasses" "eauto" "bfs" OPT nat_or_var | DELETE "typeclasses" "eauto" "best_effort" OPT nat_or_var "with" LIST1 preident | DELETE "typeclasses" "eauto" "best_effort" OPT nat_or_var | DELETE "typeclasses" "eauto" OPT nat_or_var "with" LIST1 preident | DELETE "typeclasses" "eauto" OPT nat_or_var (* first/solve variants defined with register_list_tactical in coretactics.mlg *) | "first" ident | "solve" ident (* in Tactic Notation: *) | "setoid_replace" constr "with" constr OPT ( "using" "relation" constr ) OPT ( "in" hyp ) OPT ( "at" LIST1 int_or_var ) OPT ( "by" ltac_expr3 ) ] (* todo: don't use DELETENT for this *) ne_intropatterns: [ | DELETENT ] or_and_intropattern: [ | REPLACE "[" LIST1 intropatterns SEP "|" "]" | WITH "[" LIST0 (LIST0 intropattern) SEP "|" "]" | DELETE "()" | DELETE "(" simple_intropattern ")" | REPLACE "(" simple_intropattern "," LIST1 simple_intropattern SEP "," ")" | WITH "(" LIST0 simple_intropattern SEP "," ")" (* makes the grammar a little ambiguous for "()" and "( simple_intropattern )" but semantically doesn't matter *) | REPLACE "(" simple_intropattern "&" LIST1 simple_intropattern SEP "&" ")" | WITH "(" LIST0 simple_intropattern SEP "&" ")" ] equality_intropattern: [ | REPLACE "[" "=" intropatterns "]" | WITH "[=" intropatterns "]" ] bar_cbrace: [ | REPLACE "|" "}" | WITH "|}" ] printable: [ | REPLACE "Scope" IDENT | WITH "Scope" scope_name | REPLACE "Visibility" OPT IDENT | WITH "Visibility" OPT scope_name | REPLACE [ "Sorted" | ] "Universes" OPT printunivs_subgraph OPT ne_string | WITH OPT "Sorted" "Universes" OPT printunivs_subgraph OPT ne_string | DELETE "Term" smart_global OPT univ_name_list (* readded in commands *) | REPLACE "Hint" | WITH "Hint" OPT [ "*" | smart_global ] | DELETE "Hint" smart_global | DELETE "Hint" "*" | DELETE "Notation" string | REPLACE "Notation" string "in" "custom" IDENT | WITH "Notation" string OPT [ "in" "custom" IDENT ] | 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 ] command: [ | REPLACE "Print" printable | WITH printable | REPLACE "Hint" hint opt_hintbases | WITH hint | "SubClass" ident_decl def_body | REPLACE "Ltac" LIST1 ltac_tacdef_body SEP "with" | WITH "Ltac" ltac_tacdef_body LIST0 ( "with" ltac_tacdef_body ) | REPLACE "Function" LIST1 function_fix_definition SEP "with" (* funind plugin *) | WITH "Function" function_fix_definition LIST0 ( "with" function_fix_definition ) (* funind plugin *) | REPLACE "Functional" "Scheme" LIST1 fun_scheme_arg SEP "with" (* funind plugin *) | WITH "Functional" "Scheme" fun_scheme_arg LIST0 ( "with" fun_scheme_arg ) (* funind plugin *) | DELETE "Cd" | REPLACE "Cd" ne_string | WITH "Cd" OPT ne_string | DELETE "Back" | REPLACE "Back" natural | WITH "Back" OPT natural | REPLACE "Load" [ "Verbose" | ] [ ne_string | IDENT ] | WITH "Load" OPT "Verbose" [ ne_string | IDENT ] | DELETE "Unset" setting_name | REPLACE "Test" setting_name "for" LIST1 table_value | WITH "Test" setting_name OPT ( "for" LIST1 table_value ) | DELETE "Test" setting_name (* hide the fact that table names are limited to 2 IDENTs *) | REPLACE "Add" IDENT IDENT LIST1 table_value | WITH "Add" setting_name LIST1 table_value | DELETE "Add" IDENT LIST1 table_value | DELETE "Add" "Parametric" "Relation" binders ":" constr constr "reflexivity" "proved" "by" constr "symmetry" "proved" "by" constr "as" identref | DELETE "Add" "Parametric" "Relation" binders ":" constr constr "reflexivity" "proved" "by" constr "as" identref | DELETE "Add" "Parametric" "Relation" binders ":" constr constr "reflexivity" "proved" "by" constr "transitivity" "proved" "by" constr "as" identref | DELETE "Add" "Parametric" "Relation" binders ":" constr constr "reflexivity" "proved" "by" constr "symmetry" "proved" "by" constr "transitivity" "proved" "by" constr "as" identref | DELETE "Add" "Parametric" "Relation" binders ":" constr constr "symmetry" "proved" "by" constr "as" identref | DELETE "Add" "Parametric" "Relation" binders ":" constr constr "symmetry" "proved" "by" constr "transitivity" "proved" "by" constr "as" identref | DELETE "Add" "Parametric" "Relation" binders ":" constr constr "transitivity" "proved" "by" constr "as" identref | DELETE "Add" "Parametric" "Relation" binders ":" constr constr "as" identref | "Add" "Parametric" "Relation" binders ":" constr constr OPT ( "reflexivity" "proved" "by" constr ) OPT ( "symmetry" "proved" "by" constr ) OPT ("transitivity" "proved" "by" constr ) "as" identref | DELETE "Add" "Relation" constr constr "reflexivity" "proved" "by" constr "symmetry" "proved" "by" constr "as" identref | DELETE "Add" "Relation" constr constr "reflexivity" "proved" "by" constr "as" identref | DELETE "Add" "Relation" constr constr "as" identref | DELETE "Add" "Relation" constr constr "symmetry" "proved" "by" constr "as" identref | DELETE "Add" "Relation" constr constr "symmetry" "proved" "by" constr "transitivity" "proved" "by" constr "as" identref | DELETE "Add" "Relation" constr constr "reflexivity" "proved" "by" constr "transitivity" "proved" "by" constr "as" identref | DELETE "Add" "Relation" constr constr "reflexivity" "proved" "by" constr "symmetry" "proved" "by" constr "transitivity" "proved" "by" constr "as" identref | DELETE "Add" "Relation" constr constr "transitivity" "proved" "by" constr "as" identref | "Add" "Relation" constr constr OPT ( "reflexivity" "proved" "by" constr ) OPT ( "symmetry" "proved" "by" constr ) OPT ( "transitivity" "proved" "by" constr ) "as" identref | REPLACE "Admit" "Obligations" "of" identref | WITH "Admit" "Obligations" OPT ( "of" identref ) | DELETE "Admit" "Obligations" | REPLACE "Create" "HintDb" IDENT; [ "discriminated" | ] | WITH "Create" "HintDb" IDENT; OPT "discriminated" | DELETE "Debug" "On" | REPLACE "Debug" "Off" | WITH "Debug" [ "On" | "Off" ] | EDIT "Defined" ADD_OPT identref | REPLACE "Derive" "Inversion" ident "with" constr "Sort" sort_family | WITH "Derive" "Inversion" ident "with" constr OPT ( "Sort" sort_family ) | DELETE "Derive" "Inversion" ident "with" constr | REPLACE "Derive" "Inversion_clear" ident "with" constr "Sort" sort_family | WITH "Derive" "Inversion_clear" ident "with" constr OPT ( "Sort" sort_family ) | DELETE "Derive" "Inversion_clear" ident "with" constr | EDIT "Focus" ADD_OPT natural | DELETE "Hint" "Rewrite" orient LIST1 constr ":" LIST0 preident | REPLACE "Hint" "Rewrite" orient LIST1 constr "using" tactic ":" LIST0 preident | WITH "Hint" "Rewrite" orient LIST1 constr OPT ( "using" tactic ) OPT ( ":" LIST0 preident ) | DELETE "Hint" "Rewrite" orient LIST1 constr | DELETE "Hint" "Rewrite" orient LIST1 constr "using" tactic | REPLACE "Next" "Obligation" "of" identref withtac | WITH "Next" "Obligation" OPT ( "of" identref ) withtac | DELETE "Next" "Obligation" withtac | REPLACE "Final" "Obligation" "of" identref withtac | WITH "Final" "Obligation" OPT ( "of" identref ) withtac | DELETE "Final" "Obligation" withtac | REPLACE "Obligation" natural "of" identref ":" lglob withtac | WITH "Obligation" natural OPT ( "of" identref ) OPT ( ":" type withtac ) | DELETE "Obligation" natural "of" identref withtac | DELETE "Obligation" natural ":" lglob withtac | DELETE "Obligation" natural withtac | REPLACE "Obligations" "of" identref | WITH "Obligations" OPT ( "of" identref ) | DELETE "Obligations" | REPLACE "Preterm" "of" identref | WITH "Preterm" OPT ( "of" identref ) | DELETE "Preterm" | REPLACE "Proof" "using" section_var_expr "with" Pltac.tactic | WITH "Proof" "using" section_subset_expr OPT [ "with" ltac_expr5 ] | DELETE "Proof" "using" section_var_expr (* hide the fact that table names are limited to 2 IDENTs *) | REPLACE "Remove" IDENT IDENT LIST1 table_value | WITH "Remove" setting_name LIST1 table_value | DELETE "Remove" IDENT LIST1 table_value (* hide special case command that looks like a "Set" command *) | DELETE "Set" "Firstorder" "Solver" tactic | DELETE "Show" | DELETE "Show" natural | DELETE "Show" ident | "Show" OPT [ ident | natural ] | DELETE "Show" "Ltac" "Profile" | REPLACE "Show" "Ltac" "Profile" "CutOff" integer | WITH "Show" "Ltac" "Profile" OPT [ "CutOff" integer | string ] | DELETE "Show" "Ltac" "Profile" string | DELETE "Show" "Proof" (* combined with Show Proof Diffs in vernac_toplevel *) | REPLACE "Solve" "All" "Obligations" "with" tactic | WITH "Solve" "All" "Obligations" OPT ( "with" tactic ) | DELETE "Solve" "All" "Obligations" | DELETE "Solve" "Obligations" "of" identref "with" tactic | DELETE "Solve" "Obligations" "of" identref | DELETE "Solve" "Obligations" "with" tactic | DELETE "Solve" "Obligations" | "Solve" "Obligations" OPT ( "of" identref ) OPT ( "with" tactic ) | DELETE "Undo" | DELETE "Undo" natural | REPLACE "Undo" "To" natural | WITH "Undo" OPT ( OPT "To" natural ) | DELETE "Abort" "All" | REPLACE "Abort" | WITH "Abort" OPT [ "All" ] (* show the locate options as separate commands *) | DELETE "Locate" locatable | locatable | REPLACE "Print" smart_global OPT univ_name_list | WITH "Print" OPT "Term" smart_global OPT univ_name_list | REPLACE "Declare" "Scope" IDENT | WITH "Declare" "Scope" scope_name (* odd that these are in command while other notation-related ones are in syntax *) | REPLACE "Number" "Notation" reference reference reference OPT number_options ":" preident | WITH "Number" "Notation" reference reference reference OPT number_options ":" scope_name | REPLACE "String" "Notation" reference reference reference OPT string_option ":" preident | WITH "String" "Notation" reference reference reference OPT string_option ":" scope_name | DELETE "Ltac2" ltac2_entry (* was split up *) | DELETE "Add" "Zify" "InjTyp" reference (* micromega plugin *) | DELETE "Add" "Zify" "BinOp" reference (* micromega plugin *) | DELETE "Add" "Zify" "UnOp" reference (* micromega plugin *) | DELETE "Add" "Zify" "CstOp" reference (* micromega plugin *) | DELETE "Add" "Zify" "BinRel" reference (* micromega plugin *) | DELETE "Add" "Zify" "PropOp" reference (* micromega plugin *) | DELETE "Add" "Zify" "PropBinOp" reference (* micromega plugin *) | DELETE "Add" "Zify" "PropUOp" reference (* micromega plugin *) | DELETE "Add" "Zify" "BinOpSpec" reference (* micromega plugin *) | DELETE "Add" "Zify" "UnOpSpec" reference (* micromega plugin *) | DELETE "Add" "Zify" "Saturate" reference (* micromega plugin *) | "Add" "Zify" add_zify reference 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 ] syntax: [ | REPLACE "Open" "Scope" IDENT | WITH "Open" "Scope" scope | REPLACE "Close" "Scope" IDENT | WITH "Close" "Scope" scope | REPLACE "Delimit" "Scope" IDENT; "with" IDENT | WITH "Delimit" "Scope" scope_name; "with" scope_key | REPLACE "Undelimit" "Scope" IDENT | WITH "Undelimit" "Scope" scope_name | REPLACE "Bind" "Scope" IDENT; "with" LIST1 coercion_class | WITH "Bind" "Scope" scope_name; "with" LIST1 coercion_class ] opt_scope: [ | REPLACE ":" IDENT | WITH ":" scope_name ] syntax_modifier: [ | DELETE "in" "custom" IDENT | REPLACE "in" "custom" IDENT; "at" "level" natural | WITH "in" "custom" IDENT OPT ( "at" "level" natural ) | DELETE IDENT; "in" "scope" IDENT | REPLACE IDENT; "," LIST1 IDENT SEP "," [ "at" level | "in" "scope" IDENT ] | WITH LIST1 IDENT SEP "," [ "at" level | "in" "scope" IDENT ] ] explicit_subentry: [ | REPLACE "strict" "pattern" "at" "level" natural | WITH "strict" "pattern" OPT ( "at" "level" natural ) | DELETE "strict" "pattern" | DELETE "pattern" | REPLACE "pattern" "at" "level" natural | WITH "pattern" OPT ( "at" "level" natural ) | DELETE "constr" (* covered by another prod *) ] field_body: [ | REPLACE binders of_type_inst lconstr | WITH binders of_type_inst | REPLACE binders of_type_inst lconstr ":=" lconstr | WITH binders of_type_inst ":=" lconstr ] assum_list: [ | DELETE LIST1 assum_coe | LIST1 assum_coe ] assumpt: [ | REPLACE LIST1 ident_decl of_type lconstr | WITH LIST1 ident_decl of_type ] constructor_type: [ | REPLACE binders [ of_type_inst lconstr | ] | WITH binders OPT of_type_inst ] (* todo: is this really correct? Search for "Pvernac.register_proof_mode" *) (* consider tactic_command vs tac2mode *) vernac_aux: [ | tactic_mode "." ] def_token: [ | DELETE "SubClass" (* document separately from Definition and Example *) ] assumption_token: [ | REPLACE "Axiom" | WITH [ "Axiom" | "Axioms" ] | REPLACE "Conjecture" | WITH [ "Conjecture" | "Conjectures" ] | REPLACE "Hypothesis" | WITH [ "Hypothesis" | "Hypotheses" ] | REPLACE "Parameter" | WITH [ "Parameter" | "Parameters" ] | REPLACE "Variable" | WITH [ "Variable" | "Variables" ] ] attributes: [ | LIST0 ( "#[" LIST0 attribute SEP "," "]" ) LIST0 legacy_attr ] legacy_attr: [ | REPLACE "Local" | WITH [ "Local" | "Global" ] | DELETE "Global" | REPLACE "Polymorphic" | WITH [ "Polymorphic" | "Monomorphic" ] | DELETE "Monomorphic" | REPLACE "Cumulative" | WITH [ "Cumulative" | "NonCumulative" ] | DELETE "NonCumulative" ] sentence: [ ] (* productions defined below *) fix_definition: [ | REPLACE ident_decl binders_fixannot type_cstr OPT [ ":=" lconstr ] decl_notations | WITH ident_decl binders_fixannot type_cstr OPT [ ":=" lconstr ] decl_notations ] cofix_definition: [ | REPLACE ident_decl binders type_cstr OPT [ ":=" lconstr ] decl_notations | WITH ident_decl binders type_cstr OPT [ ":=" lconstr ] decl_notations ] type_cstr: [ | REPLACE ":" lconstr | WITH ":" type ] record_binder: [ | REPLACE name field_body | WITH name OPT field_body | DELETE name ] query_command: [ | REPLACE "Eval" red_expr "in" lconstr "." | WITH "Eval" red_expr "in" lconstr | REPLACE "Compute" lconstr "." | WITH "Compute" lconstr | REPLACE "Check" lconstr "." | WITH "Check" lconstr | REPLACE "About" smart_global OPT univ_name_list "." | WITH "About" smart_global OPT univ_name_list | REPLACE "SearchPattern" constr_pattern in_or_out_modules "." | WITH "SearchPattern" constr_pattern in_or_out_modules | REPLACE "SearchRewrite" constr_pattern in_or_out_modules "." | WITH "SearchRewrite" constr_pattern in_or_out_modules | REPLACE "Search" search_query search_queries "." | WITH "Search" search_queries ] vernac_toplevel: [ (* note these commands can't be referenced by vernac_control commands *) | REPLACE "Drop" "." | WITH "Drop" | REPLACE "Quit" "." | WITH "Quit" | REPLACE "BackTo" natural "." | WITH "BackTo" natural | REPLACE "Show" "Goal" natural "at" natural "." | WITH "Show" "Goal" natural "at" natural | REPLACE "Show" "Proof" "Diffs" OPT "removed" "." | WITH "Show" "Proof" OPT ( "Diffs" OPT "removed" ) | DELETE vernac_control ] vernac_control: [ (* replacing vernac_control with command is cheating a little; they can't refer to the vernac_toplevel commands. cover this the descriptions of these commands *) | REPLACE "Time" vernac_control | WITH "Time" sentence | REPLACE "Instructions" vernac_control | WITH "Instructions" sentence | REPLACE "Redirect" ne_string vernac_control | WITH "Redirect" ne_string sentence | REPLACE "Timeout" natural vernac_control | WITH "Timeout" natural sentence | REPLACE "Fail" vernac_control | WITH "Fail" sentence | REPLACE "Succeed" vernac_control | WITH "Succeed" sentence | DELETE decorated_vernac ] of_module_type: [ | (* empty *) ] rewriter: [ | DELETE "!" constr_with_bindings_arg | DELETE [ "?" | LEFTQMARK ] constr_with_bindings_arg | DELETE natural "!" constr_with_bindings_arg | DELETE natural [ "?" | LEFTQMARK ] constr_with_bindings_arg | DELETE natural constr_with_bindings_arg | DELETE constr_with_bindings_arg | OPT natural OPT [ "?" | "!" ] constr_with_bindings_arg ] ltac2_rewriter: [ | DELETE "!" ltac2_constr_with_bindings (* Ltac2 plugin *) | DELETE [ "?" | LEFTQMARK ] ltac2_constr_with_bindings | DELETE lnatural "!" ltac2_constr_with_bindings (* Ltac2 plugin *) | DELETE lnatural [ "?" | LEFTQMARK ] ltac2_constr_with_bindings | DELETE lnatural ltac2_constr_with_bindings (* Ltac2 plugin *) | DELETE ltac2_constr_with_bindings (* Ltac2 plugin *) | OPT natural OPT [ "?" | "!" ] ltac2_constr_with_bindings ] ltac2_expr0: [ | DELETE "(" ")" ] tac2type_body: [ | REPLACE ":=" tac2typ_knd (* Ltac2 plugin *) | WITH [ ":=" | "::=" ] tac2typ_knd TAG Ltac2 | DELETE "::=" tac2typ_knd (* Ltac2 plugin *) ] record_declaration: [ | DELETE fields_def | LIST0 field_def ] fields_def: [ | DELETENT ] constr_body: [ | DELETE ":=" lconstr | REPLACE ":" lconstr ":=" lconstr | WITH OPT ( ":" type ) ":=" lconstr ] scheme: [ | DELETE scheme_kind | REPLACE identref ":=" scheme_kind | WITH OPT ( identref ":=" ) scheme_kind ] simple_reserv: [ | REPLACE LIST1 identref ":" lconstr | WITH LIST1 identref ":" type ] in_clause: [ | DELETE in_clause' | REPLACE LIST1 hypident_occ SEP "," "|-" concl_occ | WITH LIST1 hypident_occ SEP "," OPT ( "|-" concl_occ ) | DELETE LIST1 hypident_occ SEP "," | REPLACE "*" occs | WITH concl_occ (* todo: perhaps concl_occ should be "*" | "at" occs_nums *) ] ltac2_in_clause: [ | REPLACE LIST0 ltac2_hypident_occ SEP "," "|-" ltac2_concl_occ (* Ltac2 plugin *) | WITH LIST0 ltac2_hypident_occ SEP "," OPT ( "|-" ltac2_concl_occ ) TAG Ltac2 | DELETE LIST0 ltac2_hypident_occ SEP "," (* Ltac2 plugin *) ] decl_notations: [ | REPLACE "where" LIST1 notation_declaration SEP decl_sep | WITH "where" notation_declaration LIST0 (decl_sep notation_declaration ) ] module_expr: [ | REPLACE module_expr_atom | WITH LIST1 module_expr_atom | DELETE module_expr module_expr_atom ] locatable: [ | INSERTALL "Locate" ] ne_in_or_out_modules: [ | REPLACE "inside" LIST1 global | WITH [ "inside" | "in" | "outside" ] LIST1 global | DELETE "in" LIST1 global | DELETE "outside" LIST1 global ] search_queries: [ | DELETE ne_in_or_out_modules | REPLACE search_query search_queries | WITH LIST1 ( search_query ) OPT ne_in_or_out_modules | DELETE (* empty *) ] positive_search_mark: [ | OPTINREF ] SPLICE: [ | positive_search_mark ] search_query: [ | REPLACE OPT "-" search_item | WITH search_item | "-" search_query | REPLACE OPT "-" "[" LIST1 ( LIST1 search_query ) SEP "|" "]" | WITH "[" LIST1 ( LIST1 search_query ) SEP "|" "]" ] search_item: [ | REPLACE search_where ":" ne_string OPT scope_delimiter | WITH OPT ( search_where ":" ) ne_string OPT ( "%" scope_key ) | DELETE ne_string OPT scope_delimiter | REPLACE search_where ":" constr_pattern | WITH OPT ( search_where ":" ) constr_pattern | DELETE constr_pattern ] by_notation: [ | REPLACE ne_string OPT [ "%" IDENT ] | WITH ne_string OPT [ "%" scope_key ] ] notation_declaration: [ | REPLACE lstring ":=" constr syntax_modifiers OPT [ ":" IDENT ] | WITH lstring ":=" constr syntax_modifiers OPT [ ":" scope_name ] ] ltac_production_item: [ | REPLACE ident "(" ident OPT ltac_production_sep ")" | WITH ident OPT ( "(" ident OPT ltac_production_sep ")" ) | DELETE ident ] input_fun: [ | DELETE ident | DELETE "_" | name ] let_clause: [ | DELETE identref ":=" ltac_expr5 | REPLACE "_" ":=" ltac_expr5 | WITH name ":=" ltac_expr5 ] subprf_with_selector: [ | DELETE query_command ] SPLICE: [ | subprf_with_selector ] tactic_mode: [ (* todo: make sure to document this production! *) (* deleting to allow splicing query_command into command *) | DELETE OPT ltac_selector OPT ltac_info tactic ltac_use_default | DELETE "par" ":" OPT ltac_info tactic ltac_use_default (* Ignore attributes (none apply) and "...". *) | ltac_info tactic | MOVETO command ltac_info tactic | MOVETO simple_tactic subprf | REPLACE OPT toplevel_selector "{" (* semantically restricted *) | WITH OPT ( [ natural | "[" ident "]" ] ":" ) "{" | MOVETO simple_tactic OPT ( [ natural | "[" ident "]" ] ":" ) "{" | DELETE command | DELETENT ] SPLICE: [ | subprf ] ltac2_scope: [ | REPLACE syn_node (* Ltac2 plugin *) | WITH name TAG Ltac2 | REPLACE syn_node "(" LIST1 ltac2_scope SEP "," ")" (* Ltac2 plugin *) | WITH name "(" LIST1 ltac2_scope SEP "," ")" TAG Ltac2 ] tac2mode: [ | DELETENT ] (* not sure how this is used *) tac2expr_in_env: [ | DELETENT ] syn_node: [ | DELETENT ] RENAME: [ | toplevel_selector toplevel_selector_temp ] toplevel_selector: [ | goal_selector | "all" | "!" (* par is accepted even though it's not in the .mlg *) | "par" ] toplevel_selector_temp: [ | DELETE goal_selector ":" | DELETE "all" ":" | DELETE "!" ":" | toplevel_selector ":" ] (* not included in insertprodn; defined in rst with :production: *) control_command: [ ] (* move all commands under "command" *) DELETE: [ | vernac ] vernac_aux: [ | DELETE gallina "." | DELETE gallina_ext "." | DELETE syntax "." | DELETE command_entry | DELETENT ] command: [ | gallina | gallina_ext | syntax | query_command | vernac_control | vernac_toplevel ] SPLICE: [ | query_command ] query_command: [ ] (* re-add as a placeholder *) sentence: [ | OPT attributes command "." | OPT attributes OPT ( natural ":" ) query_command "." | OPT attributes OPT ( toplevel_selector ":" ) ltac_expr5 [ "." | "..." ] | control_command ] document: [ | LIST0 sentence ] (* add in ltac and Tactic Notation tactics that appear in the doc: *) ltac_defined_tactics: [ | "case_eq" constr (* | "case_eq" induction_clause_list ??? *) | "classical_left" | "classical_right" | "contradict" ident | "discrR" | "easy" | "inversion_sigma" OPT ( ident OPT ( "as" simple_intropattern ) ) | "lia" | "lra" | "nia" | "now_show" one_type | "nra" | "rapply" constr | "split_Rabs" | "split_Rmult" | "tauto" | "time_constr" ltac_expr5 | "zify" ] (* todo: need careful review; assume that "[" ... "]" are literals *) tactic_notation_tactics: [ | "assert_fails" ltac_expr3 | "clear" "dependent" hyp | "decide" constr "with" constr | "dependent" "destruction" ident OPT ( "generalizing" LIST1 hyp ) OPT ( "using" constr ) | "dependent" "induction" ident OPT ( [ "generalizing" | "in" ] LIST1 hyp ) OPT ( "using" constr ) | "dintuition" OPT ltac_expr5 | "dtauto" | "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 ltac_expr5 (* todo: Not too keen on things like "with_power_flags" in tauto.ml, not easy to follow *) | "now" ltac_expr5 | "nsatz" OPT ( "with" "radicalmax" ":=" constr "strategy" ":=" constr "parameters" ":=" constr "variables" ":=" constr ) | "psatz" constr OPT nat_or_var | "revert" "dependent" hyp | "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 *) tactic_value: [ | MOVEALLBUT simple_tactic ] nonterminal: [ ] value_tactic: [ ] syn_value: [ | IDENT; ":" "(" nonterminal ")" ] tactic_value: [ | [ value_tactic | syn_value ] ] (* defined in Ltac2/Notations.v *) ltac2_match_key: [ | "lazy_match!" | "match!" | "multi_match!" ] ltac2_constructs: [ | ltac2_match_key ltac2_expr6 "with" ltac2_match_list "end" | ltac2_match_key OPT "reverse" "goal" "with" goal_match_list "end" ] simple_tactic: [ | ltac_builtins | ltac_constructs | ltac2_constructs | ltac_defined_tactics | tactic_notation_tactics ] tacdef_body: [ | REPLACE global LIST1 input_fun ltac_def_kind ltac_expr5 | WITH global LIST0 input_fun ltac_def_kind ltac_expr5 | DELETE global ltac_def_kind ltac_expr5 ] tac2def_typ: [ | REPLACE "Type" rec_flag LIST1 tac2typ_def SEP "with" (* Ltac2 plugin *) | WITH "Type" rec_flag tac2typ_def LIST0 ( "with" tac2typ_def ) TAG Ltac2 ] tac2def_val: [ | REPLACE mut_flag rec_flag LIST1 tac2def_body SEP "with" (* Ltac2 plugin *) | WITH mut_flag rec_flag tac2def_body LIST0 ( "with" tac2def_body ) TAG Ltac1 ] tac2alg_constructors: [ | REPLACE "|" LIST1 tac2alg_constructor SEP "|" (* Ltac2 plugin *) | WITH OPT "|" LIST1 tac2alg_constructor SEP "|" TAG Ltac2 | DELETE LIST0 tac2alg_constructor SEP "|" (* Ltac2 plugin *) | (* empty *) | OPTINREF ] SPLICE: [ | def_token | extended_def_token ] logical_kind: [ | DELETE thm_token | DELETE assumption_token | [ thm_token | assumption_token ] | DELETE "Definition" | DELETE "Example" | DELETE "Context" | DELETE "Primitive" | DELETE "Symbol" (* SubClass was deleted from def_token *) | [ "Definition" | "Example" | "Context" | "Primitive" | "Symbol" ] | DELETE "Coercion" | DELETE "Instance" | DELETE "Scheme" | DELETE "Canonical" | [ "Coercion" | "Instance" | "Scheme" | "Canonical" | "SubClass" ] | DELETE "Fixpoint" | DELETE "CoFixpoint" | DELETE "Field" | DELETE "Method" | [ "Fixpoint" | "CoFixpoint" | "Field" | "Method" ] ] (* ltac2 *) DELETE: [ | test_ltac1_env ] rec_flag: [ | OPTINREF ] q_orient: [ | DELETE "<-" | REPLACE "->" | WITH OPT ["->" | "<-"] ] (* todo: should | tac2pat1 "," LIST0 tac2pat1 SEP "," use LIST1? *) SPLICE: [ | ltac2_expr4 ] ltac2_expr3: [ | REPLACE ltac2_expr2 "," LIST1 ltac2_expr2 SEP "," (* Ltac2 plugin *) | WITH LIST1 ltac2_expr2 SEP "," TAG Ltac2 | DELETE ltac2_expr2 (* Ltac2 plugin *) ] tac2rec_fieldexprs: [ | DELETE tac2rec_fieldexpr ";" tac2rec_fieldexprs | DELETE tac2rec_fieldexpr ";" | DELETE tac2rec_fieldexpr | LIST1 tac2rec_fieldexpr SEP ";" OPT ";" ] tac2rec_fields: [ | DELETE tac2rec_field ";" tac2rec_fields | DELETE tac2rec_field ";" | DELETE tac2rec_field | LIST1 tac2rec_field SEP ";" OPT ";" TAG Ltac2 ] int_or_var: [ | REPLACE integer | WITH [ integer | identref ] | DELETE identref ] nat_or_var: [ | REPLACE natural | WITH [ natural | identref ] | DELETE identref ] ltac2_occs_nums: [ | DELETE LIST1 nat_or_anti (* Ltac2 plugin *) | REPLACE "-" nat_or_anti LIST0 nat_or_anti (* Ltac2 plugin *) | WITH OPT "-" LIST1 nat_or_anti TAG Ltac2 ] ltac2_entry: [ | REPLACE tac2def_typ (* Ltac2 plugin *) | WITH "Ltac2" tac2def_typ | REPLACE tac2def_mut (* Ltac2 plugin *) | WITH "Ltac2" tac2def_mut | REPLACE tac2def_val (* Ltac2 plugin *) | WITH "Ltac2" tac2def_val | REPLACE tac2def_ext (* Ltac2 plugin *) | WITH "Ltac2" tac2def_ext | "Ltac2" "Notation" [ string | ident ] ":=" ltac2_expr6 TAG Ltac2 (* variant *) | MOVEALLBUT command (* todo: MOVEALLBUT should ignore tag on "but" prodns *) ] ltac2_match_list: [ | EDIT ADD_OPT "|" LIST1 ltac2_match_rule SEP "|" (* Ltac2 plugin *) ] ltac2_or_and_intropattern: [ | DELETE "(" ltac2_simple_intropattern ")" (* Ltac2 plugin *) | REPLACE "(" ltac2_simple_intropattern "," LIST1 ltac2_simple_intropattern SEP "," ")" (* Ltac2 plugin *) | WITH "(" LIST1 ltac2_simple_intropattern SEP "," ")" TAG Ltac2 | REPLACE "(" ltac2_simple_intropattern "&" LIST1 ltac2_simple_intropattern SEP "&" ")" (* Ltac2 plugin *) | WITH "(" LIST1 ltac2_simple_intropattern SEP "&" ")" TAG Ltac2 ] ltac2_equality_intropattern: [ | REPLACE "[" "=" ltac2_intropatterns "]" | WITH "[=" ltac2_intropatterns "]" ] SPLICE: [ | tac2def_val | tac2def_typ | tac2def_ext | tac2def_syn | ltac2def_syn | tac2def_mut | rec_flag | tac2alg_constructors | ltac2_binder | branch | anti | array_literal | list_literal ] ltac2_expr5: [ | REPLACE "let" OPT "rec" LIST1 ltac2_let_clause SEP "with" "in" ltac2_expr6 (* Ltac2 plugin *) | WITH "let" OPT "rec" ltac2_let_clause LIST0 ( "with" ltac2_let_clause ) "in" ltac2_expr6 TAG Ltac2 | MOVETO simple_tactic "match" ltac2_expr5 "with" ltac2_branches "end" (* Ltac2 plugin *) | MOVETO simple_tactic "if" ltac2_expr5 "then" ltac2_expr5 "else" ltac2_expr5 (* Ltac2 plugin *) | DELETE simple_tactic ] goal_match_list: [ | EDIT ADD_OPT "|" LIST1 gmatch_rule SEP "|" (* Ltac2 plugin *) ] ltac2_quotations: [ ] ltac2_atom: [ | MOVETO ltac2_quotations "constr" ":" "(" lconstr ")" (* Ltac2 plugin *) | MOVETO ltac2_quotations "open_constr" ":" "(" lconstr ")" (* Ltac2 plugin *) | MOVETO ltac2_quotations "preterm" ":" "(" lconstr ")" (* Ltac2 plugin *) | MOVETO ltac2_quotations "ident" ":" "(" identref ")" (* Ltac2 plugin *) | MOVETO ltac2_quotations "pat" ":" "(" cpattern ")" (* Ltac2 plugin *) | MOVETO ltac2_quotations "reference" ":" "(" globref ")" (* Ltac2 plugin *) | MOVETO ltac2_quotations "ltac1" ":" "(" ltac1_expr_in_env ")" (* Ltac2 plugin *) | MOVETO ltac2_quotations "ltac1val" ":" "(" ltac1_expr_in_env ")" (* Ltac2 plugin *) ] (* non-Ltac2 "clause" is really clause_dft_concl + there is an ltac2 "clause" *) ltac2_clause: [ ] clause: [ | MOVEALLBUT ltac2_clause ] clause: [ | clause_dft_concl ] q_clause: [ | REPLACE clause | WITH ltac2_clause TAG Ltac2 ] ltac2_induction_clause: [ | REPLACE ltac2_destruction_arg ltac2_as_or_and_ipat ltac2_eqn_ipat OPT clause (* Ltac2 plugin *) | WITH ltac2_destruction_arg ltac2_as_or_and_ipat 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 "(" identref ":=" lconstr ")" | WITH "(" [ ident | natural ] ":=" lconstr ")" | DELETE "(" natural ":=" lconstr ")" ] ltac2_expr: [ | DELETE _ltac2_expr ] opt_clause: [ | DELETE "in" in_clause | DELETE "at" occs_nums | DELETE | clause_dft_concl ] fixdecl: [ | REPLACE "(" ident LIST0 simple_binder struct_annot ":" lconstr ")" | WITH "(" ident LIST0 simple_binder struct_annot ":" type ")" ] cofixdecl: [ | REPLACE "(" ident LIST0 simple_binder ":" lconstr ")" | WITH "(" ident LIST0 simple_binder ":" type ")" ] OPTINREF: [ ] destruction_arg: [ | DELETE constr_with_bindings ] firstorder_rhs: [ | DELETE OPT firstorder_using | DELETE "with" LIST1 preident | REPLACE OPT firstorder_using "with" LIST1 preident | WITH OPT firstorder_using OPT ( "with" LIST1 preident ) ] attribute: [ | DELETE "using" OPT attr_value ] ref_or_pattern_occ: [ | DELETE smart_global OPT occs | DELETE constr OPT occs | unfold_occ | pattern_occ ] clause_dft_concl: [ (* omit an OPT since clause_dft_concl is always OPT *) | REPLACE OPT occs | WITH occs ] simple_occurrences: [ | clause_dft_concl (* semantically restricted: no "at" clause *) ] occs_nums: [ | EDIT ADD_OPT "-" LIST1 nat_or_var ] variance_identref: [ | EDIT ADD_OPT variance identref ] conversion: [ | DELETE constr | DELETE constr "with" constr | REPLACE constr "at" occs_nums "with" constr | WITH OPT ( constr OPT ( "at" occs_nums ) "with" ) constr ] induction_principle: [ | eliminator opt_clause ] induction_clause: [ | REPLACE destruction_arg OPT as_or_and_ipat OPT eqn_ipat opt_clause | WITH destruction_arg OPT as_or_and_ipat OPT eqn_ipat opt_clause ] induction_clause_list: [ | DELETE LIST1 induction_clause SEP "," OPT eliminator opt_clause | LIST1 induction_clause SEP "," OPT induction_principle ] (* see https://github.com/coq/coq/pull/14179#discussion_r654000296 *) as_or_and_ipat: [ | DELETE "as" or_and_intropattern_loc | DELETE "as" equality_intropattern | "as" or_and_intropattern ] ne_rewstrategy1_list_sep_semicolon: [ | DELETE rewstrategy1 | REPLACE ne_rewstrategy1_list_sep_semicolon ";" rewstrategy1 | WITH LIST1 rewstrategy1 SEP ";" ] SPLICE: [ | ne_rewstrategy1_list_sep_semicolon | clause | noedit_mode | match_list | match_context_list | IDENT | LEFTQMARK | NUMBER | STRING | hyp | identref | pattern_ident | constr_eval (* splices as multiple prods *) | tactic_then_last (* todo: dependency on c.edit_mlg edit?? really useful? *) | ltac2_tactic_then_last | Prim.name | ltac_selector | Constr.ident | attribute_list | term99 | term90 | term9 | term8 | pattern200 | pattern99 | pattern90 | ne_lstring | ne_string | lstring | fullyqualid | global | reference | bar_cbrace | lconstr | preident | lpar_id_coloneq | binders | check_module_types | decl_sep | function_fix_definition (* loses funind annotation *) | glob | glob_constr_with_bindings | id_or_meta | lglob | ltac_tacdef_body | mode | mult_pattern | open_constr | record_declaration | tactic | uconstr | impl_ident_head | branches | check_module_type | decorated_vernac | ext_module_expr | ext_module_type | test | binder_constr | atomic_constr | let_type_cstr | name_colon | closed_binder | binders_fixannot | as_return_type | case_type | universe_increment | type_cstr | record_pattern | evar_instance | fix_decls | cofix_decls | assum_list | assum_coe | inline | occs | ltac_info | field_mods | ltac_production_sep | ltac_tactic_level | printunivs_subgraph | ring_mods | eliminator (* todo: splice or not? *) | quoted_attributes (* todo: splice or not? *) | printable | hint | record_fields | constructor_type | record_binder | at_level_opt | table_value | in_or_out_modules | option_setting | orient | with_bindings | by_arg_tac | by_tactic | quantified_hypothesis | in_hyp_list | rename | export_token | reserv_tuple | inst | default_inhabitant_ident | opt_coercion | opt_constructors_or_fields | is_module_type | is_module_expr | module_expr | mlname | withtac | debug | eauto_search_strategy | constr_body | reference_or_constr | opt_hintbases | opthints | scheme | fresh_id | ltac_def_kind | intropatterns | instance_name | failkw | ne_in_or_out_modules | search_queries | locatable | scope_delimiter | one_import_filter_name | search_where | message_token | input_fun | ltac_use_default | toplevel_selector_temp | comment | register_token | match_context_rule | match_rule | by_notation | lnatural | nat_or_anti | globref | let_binder | refglobals (* Ltac2 *) | syntax_modifiers | array_elems | G_LTAC2_input_fun | ltac2_with_bindings | int_or_id | fun_ind_using | with_names | eauto_search_strategy_name | simple_binding | ssexpr35 (* strange in mlg, ssexpr50 is after this *) | number_string_mapping | number_options | string_option | tac2type_body | tac2rec_fields | mut_flag | tac2rec_fieldexprs | syn_level | firstorder_rhs | firstorder_using | ref_or_pattern_occ | cumul_ident_decl | variance | variance_identref | rewriter | clause_dft_all | or_and_intropattern_loc | eqn_ipat | conversion | type_cast | opt_clause | struct_annot | fixdecl | cofixdecl | induction_clause_list | as_or_and_ipat | singleton_class_definition | constr_with_bindings_arg | enable_enable_disable | enable_notation_rule | enable_notation_interpretation | enable_notation_flags | opt_scope ] (* end SPLICE *) RENAME: [ | occurrences rewrite_occs ] RENAME: [ | tactic3 ltac_expr3 (* todo: can't figure out how this gets mapped by coqpp *) | tactic1 ltac_expr1 (* todo: can't figure out how this gets mapped by coqpp *) | tactic0 ltac_expr0 (* todo: can't figure out how this gets mapped by coqpp *) | ltac_expr5 ltac_expr (* | nonsimple_intropattern intropattern (* ltac2 *) *) | term200 term | pattern100 pattern (*| impl_ident_tail impl_ident*) | ssexpr50 section_var_expr50 | ssexpr0 section_var_expr0 | section_subset_expr section_var_expr | fun_scheme_arg func_scheme_def | BULLET bullet | constr one_term (* many, many, many *) | smart_global reference (* many, many *) (* | searchabout_query search_item *) | Pltac.tactic ltac_expr (* many uses in EXTENDs *) | ltac2_type5 ltac2_type | ltac2_expr6 ltac2_expr | starredidentref starred_ident_ref | constr_pattern one_pattern | hints_path hints_regexp | clause_dft_concl occurrences | in_clause goal_occurrences | unfold_occ reference_occs | pattern_occ pattern_occs | hypident_occ hyp_occs | concl_occ concl_occs | constr_with_bindings one_term_with_bindings | red_flag reduction | strategy_flag reductions | delta_flag delta_reductions | q_strategy_flag q_reductions | destruction_arg induction_arg | field_body field_spec | field_def field_val | bindings_with_parameters alias_definition ] bullet: [ | [ LIST1 "-" | LIST1 "+" | LIST1 "*" ] ] simple_tactic: [ (* due to renaming of tactic_value; Use LIST1 for function application *) | qualid LIST1 tactic_arg ] SPLICE: [ | gallina | gallina_ext | syntax | vernac_control | vernac_toplevel | command_entry | ltac_builtins | ltac_constructs | ltac2_constructs | ltac_defined_tactics | tactic_notation_tactics | bullet ] REACHABLE: [ | command | simple_tactic ] NOTINRSTS: [ | command | control_command | simple_tactic | hints_regexp (* manually inserted *) | REACHABLE | NOTINRSTS | l1_tactic | l2_tactic | l3_tactic | value_tactic | ltac2_entry (* ltac2 syntactic classes *) | q_intropatterns | q_intropattern | q_ident | q_destruction_arg | q_with_bindings | q_bindings | q_reductions | q_reference | q_clause | q_occurrences | q_induction_clause | q_conversion | q_rewriting | q_dispatch | q_hintdb | q_move_location | q_pose | q_assert | q_constr_matching | q_goal_matching ] REACHABLE: [ | NOTINRSTS ] coq-8.20.0/doc/tools/docgram/doc_grammar.ml000066400000000000000000002035111466560755400205350ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* if plist then sprintf "%s" s else sprintf "\"%s\"" s | Snterm s -> if plist then sprintf "`%s`" s else sprintf "%s%s" s (if s = "IDENT" && need_semi then ";" else "") | Slist1 sym -> sprintf "LIST1 %s" (prod_to_str ~plist [sym]) | Slist1sep (sym, sep) -> sprintf "LIST1 %s SEP %s" (prod_to_str ~plist [sym]) (prod_to_str ~plist [sep]) | Slist0 sym -> sprintf "LIST0 %s" (prod_to_str ~plist [sym]) | Slist0sep (sym, sep) -> sprintf "LIST0 %s SEP %s" (prod_to_str ~plist [sym]) (prod_to_str ~plist [sep]) | Sopt sym -> sprintf "OPT %s" (prod_to_str ~plist [sym]) | Sparen sym_list -> sprintf "( %s )" (prod_to_str sym_list) | Sprod sym_list_list -> sprintf "[ %s ]" (String.concat " " (List.mapi (fun i r -> let prod = (prod_to_str r) in let sep = if i = 0 then "" else if prod <> "" then "| " else "|" in sprintf "%s%s" sep prod) sym_list_list)) | Sedit s -> sprintf "%s" s (* todo: make TAG info output conditional on the set of prods? *) | Sedit2 ("TAG", plugin) -> if plist then sprintf " (%s plugin)" plugin else sprintf " (* %s plugin *)" plugin | Sedit2 ("FILE", file) -> let file_suffix_regex = Str.regexp ".*/\\([a-zA-Z0-9_\\.]+\\)" in let suffix = if Str.string_match file_suffix_regex file 0 then Str.matched_group 1 file else file in if plist then sprintf " (%s)" suffix else sprintf " (* %s *)" suffix | Sedit2 (s, s2) -> sprintf "%s \"%s\"" s s2 and prod_to_str_r plist prod = match prod with | Sterm s :: Snterm "ident" :: tl when omit_space s && plist -> (sprintf "%s`ident`" s) :: (prod_to_str_r plist tl) | p :: tl -> let need_semi = match prod with | Snterm "IDENT" :: Sterm _ :: _ | Snterm "IDENT" :: Sprod _ :: _ -> true | _ -> false in (output_prod plist need_semi p) :: (prod_to_str_r plist tl) | [] -> [] and prod_to_str ?(plist=false) prod = String.concat " " (prod_to_str_r plist prod) (* Determine if 2 productions are equal ignoring Sedit and Sedit2 *) let ematch prod edit = let rec ematchr prod edit = (*Printf.printf "%s and\n %s\n\n" (prod_to_str prod) (prod_to_str edit);*) match (prod, edit) with | (_, Sedit _ :: tl) | (_, Sedit2 _ :: tl) -> ematchr prod tl | (Sedit _ :: tl, _) | (Sedit2 _ :: tl, _) -> ematchr tl edit | (phd :: ptl, hd :: tl) -> let m = match (phd, hd) with | (Slist1 psym, Slist1 sym) | (Slist0 psym, Slist0 sym) | (Sopt psym, Sopt sym) -> ematchr [psym] [sym] | (Slist1sep (psym, psep), Slist1sep (sym, sep)) | (Slist0sep (psym, psep), Slist0sep (sym, sep)) -> ematchr [psym] [sym] && ematchr [psep] [sep] | (Sparen psyml, Sparen syml) -> ematchr psyml syml | (Sprod psymll, Sprod symll) -> if List.compare_lengths psymll symll != 0 then false else List.fold_left (&&) true (List.map2 ematchr psymll symll) | _, _ -> phd = hd in m && ematchr ptl tl | ([], hd :: tl) -> false | (phd :: ptl, []) -> false | ([], []) -> true in (*Printf.printf "\n";*) let rv = ematchr prod edit in (*Printf.printf "%b\n" rv;*) rv let get_first m_prod prods = let rec find_first_r prods i = match prods with | [] -> raise Not_found | prod :: tl -> if ematch prod m_prod then i else find_first_r tl (i+1) in find_first_r prods 0 let find_first edit prods nt = try get_first edit prods with Not_found -> error "Can't find '%s' in edit for '%s'\n" (prod_to_str edit) nt; raise Not_found module DocGram = struct (* these guarantee that order and map have a 1-1 relationship on the nt name. They don't guarantee that nts on rhs of a production are defined, nor do they prohibit duplicate productions *) exception Duplicate exception Invalid let g_empty () = ref { map = NTMap.empty; order = [] } (* add an nt at the end (if not already present) then set its prods *) let g_maybe_add g nt prods = if not (NTMap.mem nt !g.map) then g := { !g with order = !g.order @ [nt] }; g := { !g with map = NTMap.add nt prods !g.map } (* add an nt at the beginning (if not already present) then set its prods *) let g_maybe_add_begin g nt prods = if not (NTMap.mem nt !g.map) then g := { !g with order = nt :: !g.order }; g := { !g with map = NTMap.add nt prods !g.map } (* reverse the order of the grammar *) let g_reverse g = g := { !g with order = List.rev !g.order } (* update the productions of an existing nt *) let g_update_prods g nt prods = ignore (NTMap.find nt !g.map); (* don't add the nt if it's not present *) g := { !g with map = NTMap.add nt prods !g.map } (* remove a non-terminal *) let g_remove g nt = g := { map = NTMap.remove nt !g.map; order = List.filter (fun elt -> elt <> nt) !g.order } (* rename an nt and update its prods, keeping its original position. If the new name already exists, include its prods *) let g_rename_merge g nt nt' nprods = let oprods = try let oprods = NTMap.find nt' !g.map in g := { !g with order = List.filter (fun elt -> elt <> nt') !g.order }; oprods with Not_found -> g := { !g with map = NTMap.add nt' [] !g.map }; [] in g := { map = NTMap.remove nt !g.map; order = List.map (fun n -> if n = nt then nt' else n) !g.order }; g_update_prods g nt' (oprods @ nprods) (* add a new nonterminal after "ins_after" None means insert at the beginning *) let g_add_after g ?(update=true) ins_after nt prods = if (not update) && NTMap.mem nt !g.map then raise Duplicate; (* don't update the nt if it's already present *) let rec insert_nt order res = match ins_after, order with | None, _ -> nt :: order | Some _, [] -> raise Not_found | Some ins_after_nt, hd :: tl -> if hd = ins_after_nt then (List.rev res) @ (hd :: nt :: tl) else insert_nt tl (hd :: res) in g := { order = insert_nt !g.order []; map = NTMap.add nt prods !g.map } let g_add_prod_after g ins_after nt prod = let prods = try NTMap.find nt !g.map with Not_found -> [] in if prods <> [] then g_update_prods g nt (prods @ [prod]) else g_add_after g ~update:true ins_after nt [prod] (* replace the map and order *) let g_reorder g map order = let order_nts = StringSet.of_list order in let map_nts = List.fold_left (fun res b -> let (nt, _) = b in StringSet.add nt res) StringSet.empty (NTMap.bindings map) in if List.length order <> NTMap.cardinal map || not (StringSet.equal order_nts map_nts) then raise Invalid; g := { order = order; map = map } end open DocGram let remove_Sedit2 p = List.filter (fun sym -> match sym with | Sedit2 _ -> false | _ -> true) p let rec output_prodn = function | Sterm s -> let s = match s with | "|}" -> "%|%}" | "{|" -> "%{%|" | "`{" -> "`%{" | "@{" -> "@%{" | "|-" -> "%|-" | "|->" -> "%|->" | "||" -> "%||" | "|||" -> "%|||" | "||||" -> "%||||" | "{" | "}" | "|" -> "%" ^ s | _ -> s in sprintf "%s" s | Snterm s -> sprintf "@%s" s | Slist1 sym -> sprintf "{+ %s }" (output_prodn sym) | Slist1sep (sym, sep) -> sprintf "{+%s %s }" (output_sep sep) (output_prodn sym) | Slist0 sym -> sprintf "{* %s }" (output_prodn sym) | Slist0sep (sym, sep) -> sprintf "{*%s %s }" (output_sep sep) (output_prodn sym) | Sopt sym -> sprintf "{? %s }" (output_prodn sym) | Sparen sym_list -> sprintf "%s" (prod_to_prodn sym_list) | Sprod sym_list -> let lcurly, rcurly = if List.length sym_list = 1 then "", "" else "{| ", " }" in sprintf "%s%s%s" lcurly (String.concat " " (List.mapi (fun i r -> let prod = (prod_to_prodn r) in let sep = if i = 0 then "" else if prod <> "" then "| " else "|" in sprintf "%s%s" sep prod) sym_list)) rcurly | Sedit s -> sprintf "%s" s | Sedit2 ("TAG", s2) -> "" | Sedit2 (s, s2) -> sprintf "%s \"%s\"" s s2 and output_sep sep = match sep with | Sterm s -> sprintf "%s" s (* avoid escaping separator *) | _ -> output_prodn sep and prod_to_prodn_r prod = match prod with | Sterm s :: Snterm "ident" :: tl when omit_space s -> (sprintf "%s@ident" s) :: (prod_to_prodn_r tl) | p :: tl -> (output_prodn p) :: (prod_to_prodn_r tl) | [] -> [] and prod_to_prodn prod = String.concat " " (prod_to_prodn_r (remove_Sedit2 prod)) let get_tag file prod = List.fold_left (fun rv sym -> match sym with (* todo: only Ltac2 and SSR for now, outside of their main chapters *) | Sedit2 ("TAG", "Ltac2") when file <> "doc/sphinx/proof-engine/ltac2.rst" -> " Ltac2" | Sedit2 ("TAG", "SSR") when file <> "doc/sphinx/proof-engine/ssreflect-proof-language.rst" -> " SSR" | _ -> rv ) "" prod let pr_prods nt prods = (* duplicative *) Printf.printf "%s: [\n" nt; List.iter (fun prod -> let str = prod_to_str ~plist:false prod in let pfx = if str = "" then "|" else "| " in Printf.printf "%s%s\n" pfx str) prods; Printf.printf "]\n\n" (* print a subset of the grammar with nts in the specified order *) let print_in_order out g fmt nt_order hide = List.iter (fun nt -> if not (StringSet.mem nt hide) then try let prods = NTMap.find nt !g.map in match fmt with | `MLG -> fprintf out "%s: [\n" nt; List.iter (fun prod -> let str = prod_to_str ~plist:false prod in let pfx = if str = "" then "|" else "| " in fprintf out "%s%s\n" pfx str) prods; fprintf out "]\n\n" | `PRODLIST -> fprintf out "%s :" nt; List.iteri (fun i prod -> if i > 0 then fprintf out "%s :" (String.make (String.length nt) ' '); let str = prod_to_str ~plist:true prod in let pfx = if str = "" then "" else " " in fprintf out "%s%s\n" pfx str) prods; | `PRODN -> fprintf out "\n%s:\n%s " nt nt; List.iteri (fun i prod -> let str = prod_to_prodn prod in let op = if i = 0 then "::=" else "+=" in fprintf out "%s %s\n" op str) prods; with Not_found -> error "Missing nt '%s' in print_in_order\n" nt) nt_order (*** Read grammar routines ***) let cvt_ext prod = let rec to_doc_sym = function | Ulist1 sym -> Slist1 (to_doc_sym sym) | Ulist1sep (sym, s) -> Slist1sep ((to_doc_sym sym), Sterm s) | Ulist0 sym -> Slist0 (to_doc_sym sym) | Ulist0sep (sym, s) -> Slist0sep ((to_doc_sym sym), Sterm s) | Uopt sym -> Sopt (to_doc_sym sym) | Uentry s -> Snterm s | Uentryl (s, i) -> Snterm (s ^ (string_of_int i)) in let from_ext = function | ExtTerminal s -> Sterm s | ExtNonTerminal (s, _) -> to_doc_sym s in List.map from_ext prod let keywords = ref StringSet.empty let rec cvt_gram_sym = function | GSymbString s -> Sterm s | GSymbQualid (s, level) -> Snterm (match level with | Some str -> s ^ str | None -> s) | GSymbParen l -> Sparen (cvt_gram_sym_list l) | GSymbProd ll -> let cvt = List.map cvt_gram_prod ll in (match cvt with | (Snterm x :: []) :: [] -> Snterm x | (Sterm x :: []) :: [] -> Sterm x | _ -> Sprod cvt) and cvt_gram_sym_list l = let get_sym = function | GSymbQualid (s, level) -> s | _ -> "" in match l with | GSymbQualid ("LIST0", _) :: s :: GSymbQualid ("SEP", _) :: sep :: tl -> Slist0sep (cvt_gram_sym s, cvt_gram_sym sep) :: cvt_gram_sym_list tl | GSymbQualid ("LIST1", _) :: s :: GSymbQualid ("SEP", _) :: sep :: tl -> Slist1sep (cvt_gram_sym s, cvt_gram_sym sep) :: cvt_gram_sym_list tl | GSymbQualid ("LIST0", _) :: s :: tl -> Slist0 (cvt_gram_sym s) :: cvt_gram_sym_list tl | GSymbQualid ("LIST1", _) :: s :: tl -> Slist1 (cvt_gram_sym s) :: cvt_gram_sym_list tl | GSymbQualid ("OPT", _) :: s :: tl -> Sopt (cvt_gram_sym s) :: cvt_gram_sym_list tl | GSymbQualid ("IDENT", _) :: s2 :: tl when get_sym s2 = "" -> cvt_gram_sym s2 :: cvt_gram_sym_list tl | GSymbQualid ("ADD_OPT", _) :: tl -> (Sedit "ADD_OPT") :: cvt_gram_sym_list tl | GSymbQualid ("NOTE", _) :: GSymbQualid (s2, l) :: tl -> (Sedit2 ("NOTE", s2)) :: cvt_gram_sym_list tl | GSymbQualid ("USE_NT", _) :: GSymbQualid (s2, l) :: tl -> (Sedit2 ("USE_NT", s2)) :: cvt_gram_sym_list tl | GSymbQualid ("TAG", _) :: GSymbQualid (s2, l) :: tl -> (Sedit2 ("TAG", s2)) :: cvt_gram_sym_list tl | GSymbQualid ("TAG", _) :: GSymbString (s2) :: tl -> (Sedit2 ("TAG", s2)) :: cvt_gram_sym_list tl | GSymbString s :: tl -> (* todo: not seeing "(bfs)" here for some reason *) keywords := StringSet.add s !keywords; cvt_gram_sym (GSymbString s) :: cvt_gram_sym_list tl | hd :: tl -> cvt_gram_sym hd :: cvt_gram_sym_list tl | [] -> [] and cvt_gram_prod p = List.concat (List.map (fun x -> let _, gs = x in cvt_gram_sym_list gs) p.gprod_symbs) let add_symdef nt file symdef_map = let ent = try StringMap.find nt !symdef_map with Not_found -> [] in symdef_map := StringMap.add nt (Filename.basename file::ent) !symdef_map let rec edit_SELF nt cur_level next_level right_assoc inner prod = let subedit sym = List.hd (edit_SELF nt cur_level next_level right_assoc true [sym]) in let len = List.length prod in List.mapi (fun i sym -> match sym with | Sterm _ -> sym | Snterm s when s = nt || s = "SELF"-> if inner then Snterm nt (* first level *) else if i = 0 then Snterm next_level else if i + 1 = len then (if right_assoc then Snterm cur_level else Snterm next_level) else Snterm nt | Snterm "NEXT" -> Snterm next_level | Snterm _ -> sym | Slist1 sym -> Slist1 (subedit sym) | Slist0 sym -> Slist0 (subedit sym) | Slist1sep (sym, sep) -> Slist1sep ((subedit sym), (subedit sep)) | Slist0sep (sym, sep) -> Slist0sep ((subedit sym), (subedit sep)) | Sopt sym -> Sopt (subedit sym) | Sparen syms -> Sparen (List.map (fun sym -> subedit sym) syms) | Sprod prods -> Sprod (List.map (fun prod -> edit_SELF nt cur_level next_level right_assoc true prod) prods) | Sedit _ -> sym | Sedit2 _ -> sym) prod let autoloaded_mlgs = [ (* productions from other mlgs are marked with TAGs *) "parsing/g_constr.mlg"; "parsing/g_prim.mlg"; "plugins/btauto/g_btauto.mlg"; "plugins/cc/g_congruence.mlg"; "plugins/firstorder/g_ground.mlg"; "plugins/ltac/coretactics.mlg"; "plugins/ltac/extraargs.mlg"; "plugins/ltac/extratactics.mlg"; "plugins/ltac/g_auto.mlg"; "plugins/ltac/g_class.mlg"; "plugins/ltac/g_eqdecide.mlg"; "plugins/ltac/g_ltac.mlg"; "plugins/ltac/g_obligations.mlg"; "plugins/ltac/g_rewrite.mlg"; "plugins/ltac/g_tactic.mlg"; "plugins/ltac/profile_ltac_tactics.mlg"; "plugins/rtauto/g_rtauto.mlg"; "plugins/syntax/g_number_string.mlg"; "toplevel/g_toplevel.mlg"; "vernac/g_proofs.mlg"; "vernac/g_vernac.mlg"; ] let has_match p prods = List.exists (fun p2 -> ematch p p2) prods let plugin_regex = Str.regexp "^plugins/\\([a-zA-Z0-9_]+\\)/" let level_regex = Str.regexp "[a-zA-Z0-9_]*$" let get_plugin_name file = if Str.string_match plugin_regex file 0 then let s = Str.matched_group 1 file in if List.mem s ["ssr"; "ssrmatching"] then "SSR" else s else "" let read_mlg g is_edit ast file level_renames symdef_map = let res = ref [] in let locals = ref StringSet.empty in let dup_renames = ref StringMap.empty in let add_prods nt prods gramext_globals = if not is_edit then if NTMap.mem nt !g.map && not (List.mem nt gramext_globals) && nt <> "command" && nt <> "simple_tactic" then begin let new_name = String.uppercase_ascii (Filename.remove_extension (Filename.basename file)) ^ "_" ^ nt in dup_renames := StringMap.add nt new_name !dup_renames; if false then Printf.printf "** dup local sym %s -> %s in %s\n" nt new_name file end; add_symdef nt file symdef_map; let plugin = get_plugin_name file in let prods = if not is_edit && not (List.mem file autoloaded_mlgs) && plugin <> "" then List.map (fun p -> p @ [Sedit2 ("TAG", plugin)]) prods else prods in (* todo: doesn't yet work perfectly with SPLICE *) (* let prods = if not is_edit then List.map (fun p -> p @ [Sedit2 ("FILE", file)]) prods else prods in*) res := (nt, prods) :: !res in let prod_loop = function | GramExt grammar_ext -> let get_label = function | Some s -> s | None -> "" in let gramext_globals = ref grammar_ext.gramext_globals in List.iter (fun ent -> let pos, rules = match ent.gentry_rules with | GDataFresh (pos, r) -> (pos, r) | GDataReuse (lbl, r) -> let r = { grule_label = lbl; grule_assoc = None; grule_prods = r; } in (None, [r]) in let len = List.length rules in List.iteri (fun i rule -> let nt = ent.gentry_name in if not (List.mem nt !gramext_globals) then locals := StringSet.add nt !locals; let level = (get_label rule.grule_label) in let level = if level <> "" then level else match pos with | Some (Before lev) | Some (After lev) -> lev (* Looks like FIRST/LAST can be ignored for documenting the current grammar *) | _ -> "" in if len > 1 && level = "" then error "Missing level string for '%s'\n" nt else if not (Str.string_match level_regex level 0) then error "Invalid level string '%s' for '%s'\n" level nt; let cur_level = nt ^ level in let next_level = nt ^ if i+1 < len then (get_label (List.nth rules (i+1)).grule_label) else "" in let right_assoc = (rule.grule_assoc = Some RightA) in if i = 0 && cur_level <> nt && not (StringMap.mem nt !level_renames) then begin level_renames := StringMap.add nt cur_level !level_renames; end; let cvted = List.map cvt_gram_prod rule.grule_prods in (* edit names for levels *) (* See https://camlp5.github.io/doc/html/grammars.html#b:Associativity *) let edited = List.map (edit_SELF nt cur_level next_level right_assoc false) cvted in let prods_to_add = if cur_level <> nt && i+1 < len then edited @ [[Snterm next_level]] else edited in if cur_level <> nt && List.mem nt !gramext_globals then gramext_globals := cur_level :: !gramext_globals; add_prods cur_level prods_to_add !gramext_globals) rules ) grammar_ext.gramext_entries | VernacExt vernac_ext -> let node = match vernac_ext.vernacext_entry with | None -> "command" | Some c -> String.trim c.code in add_prods node (List.map (fun r -> cvt_ext r.vernac_toks) vernac_ext.vernacext_rules) [] | VernacArgumentExt vernac_argument_ext -> add_prods vernac_argument_ext.vernacargext_name (List.map (fun r -> cvt_ext r.tac_toks) vernac_argument_ext.vernacargext_rules) [] | TacticExt tactic_ext -> add_prods "simple_tactic" (List.map (fun r -> cvt_ext r.tac_toks) tactic_ext.tacext_rules) [] | ArgumentExt argument_ext -> add_prods argument_ext.argext_name (List.map (fun r -> cvt_ext r.tac_toks) argument_ext.argext_rules) [] | _ -> () in List.iter prod_loop ast; List.rev !res, !locals, !dup_renames let dir s = "doc/tools/docgram/" ^ s let read_mlg_edit file = let fdir = dir file in let level_renames = ref StringMap.empty in (* ignored *) let symdef_map = ref StringMap.empty in (* ignored *) let prods, _, _ = read_mlg (g_empty ()) true (parse_file fdir) fdir level_renames symdef_map in prods let add_rule g nt prods file = let ent = try NTMap.find nt !g.map with Not_found -> [] in let nodups = List.concat (List.map (fun prod -> if has_match prod ent then begin if !show_warn then warn "%s: Duplicate production '%s -> %s'\n" file nt (prod_to_str prod); [] end else [prod]) prods) in g_maybe_add_begin g nt (ent @ nodups) let remove_Sedit2 p = List.filter (fun sym -> match sym with | Sedit2 _ -> false | _ -> true) p let check_for_duplicates cause rule oldrule nt = let prods = List.map (fun p -> prod_to_str p) rule in let sorted = List.sort String.compare prods in let rec aux prev = function | hd :: tl -> if hd = prev then begin if (List.length (List.filter (fun p -> (prod_to_str p) = hd) rule)) <> (List.length (List.filter (fun p -> (prod_to_str p) = hd) oldrule)) then error "Duplicate production '%s -> %s' %s\n%!" nt hd cause end; aux hd tl | [] -> () in aux " x " sorted (* edit a production: rename nonterminals, drop nonterminals, substitute nonterminals *) let rec edit_prod g top edit_map prod = let edit_nt edit_map sym0 nt = try let binding = StringMap.find nt edit_map in match binding with | "DELETE" -> [] | "SPLICE" -> begin try let splice_prods = NTMap.find nt !g.map in match splice_prods with | [] -> error "Empty splice for '%s'\n" nt; [] | [p] -> List.rev (remove_Sedit2 p) | _ -> [Sprod (List.map remove_Sedit2 splice_prods)] (* todo? check if we create a dup *) with Not_found -> error "Missing nt '%s' for splice\n" nt; [Snterm nt] end | _ -> [Snterm binding] with Not_found -> [sym0] in let maybe_wrap syms = match syms with | s :: [] -> List.hd syms | s -> Sparen (List.rev syms) in let rec edit_symbol sym0 = match sym0 with | Sterm s -> [sym0] | Snterm s -> edit_nt edit_map sym0 s | Slist1 sym -> [Slist1 (maybe_wrap (edit_symbol sym))] (* you'll get a run-time failure deleting a SEP symbol *) | Slist1sep (sym, sep) -> [Slist1sep (maybe_wrap (edit_symbol sym), (List.hd (edit_symbol sep)))] | Slist0 sym -> [Slist0 (maybe_wrap (edit_symbol sym))] | Slist0sep (sym, sep) -> [Slist0sep (maybe_wrap (edit_symbol sym), (List.hd (edit_symbol sep)))] | Sopt sym -> [Sopt (maybe_wrap (edit_symbol sym))] | Sparen slist -> [Sparen (List.hd (edit_prod g false edit_map slist))] | Sprod slistlist -> let (_, prods) = edit_rule g edit_map "" slistlist in [Sprod prods] | Sedit _ | Sedit2 _ -> [sym0] (* these constructors not used here *) in let is_splice nt = try StringMap.find nt edit_map = "SPLICE" with Not_found -> false in let get_splice_prods nt = try NTMap.find nt !g.map with Not_found -> (error "Missing nt '%s' for splice\n" nt; []) in (* special case splice creating multiple new productions *) let splice_prods = match prod with | Snterm nt :: [] when is_splice nt -> get_splice_prods nt | Snterm nt :: Sedit2 ("TAG", _) :: [] when is_splice nt -> get_splice_prods nt | _ -> [] in if top && splice_prods <> [] then splice_prods else [List.rev (List.concat (List.rev (List.map (fun sym -> edit_symbol sym) prod)))] and edit_rule g edit_map nt rule = let nt = try let new_name = StringMap.find nt edit_map in match new_name with | "SPLICE" -> nt | "DELETE" -> "" | _ -> new_name with Not_found -> nt in (nt, (List.concat (List.map (edit_prod g true edit_map) rule))) let read_mlg_files g args symdef_map = let level_renames = ref StringMap.empty in let last_autoloaded = List.hd (List.rev autoloaded_mlgs) in List.iter (fun file -> (* todo: ??? does nt renaming, deletion and splicing *) let rules, locals, dup_renames = read_mlg g false (parse_file file) file level_renames symdef_map in let numprods = List.fold_left (fun num rule -> let nt, prods = rule in (* rename local duplicates *) let prods = List.map (fun prod -> List.hd (edit_prod g true dup_renames prod)) prods in let nt = try StringMap.find nt dup_renames with Not_found -> nt in (* if NTMap.mem nt !g.map && (StringSet.mem nt locals) &&*) (* StringSet.cardinal (StringSet.of_list (StringMap.find nt !symdef_map)) > 1 then*) (* warn "%s: local nonterminal '%s' already defined\n" file nt; (* todo: goes away *)*) add_rule g nt prods file; num + List.length prods) 0 rules in if args.verbose then begin Printf.eprintf "%s: %d nts, %d prods\n" file (List.length rules) numprods; if file = last_autoloaded then Printf.eprintf " Optionally loaded plugins:\n" end ) args.mlg_files; g_reverse g; !level_renames (* get the nt's in the production, preserving order, don't worry about dups *) let nts_in_prod prod = let rec traverse = function | Sterm s -> [] | Snterm s -> if List.mem s tokens then [] else [s] | Slist1 sym | Slist0 sym | Sopt sym -> traverse sym | Slist1sep (sym, sep) | Slist0sep (sym, sep) -> traverse sym @ (traverse sep) | Sparen sym_list -> List.concat (List.map traverse sym_list) | Sprod sym_list_list -> List.concat (List.map (fun l -> List.concat (List.map traverse l)) sym_list_list) | Sedit _ | Sedit2 _ -> [] in List.rev (List.concat (List.map traverse prod)) let get_refdef_nts g = let rec get_nts_r refd defd bindings = match bindings with | [] -> refd, defd | (nt, prods) :: tl -> get_nts_r (List.fold_left (fun res prod -> StringSet.union res (StringSet.of_list (nts_in_prod prod))) refd prods) (StringSet.add nt defd) tl in let toks = StringSet.of_list tokens in get_nts_r toks toks (NTMap.bindings !g.map) (*** global editing ops ***) let create_edit_map g op edits = let rec aux edits map = match edits with | [] -> map | edit :: tl -> let (key, binding) = edit in let all_nts_ref, all_nts_def = get_refdef_nts g in (match op with (* todo: messages should tell you which edit file causes the error *) | "SPLICE" -> if not (StringSet.mem key all_nts_def) then error "Undefined nt '%s' in SPLICE\n" key | "DELETE" -> if not (StringSet.mem key all_nts_ref || (StringSet.mem key all_nts_def)) then error "Unused/undefined nt '%s' in DELETE\n" key; | "RENAME" -> if not (StringSet.mem key all_nts_ref || (StringSet.mem key all_nts_def)) then error "Unused/undefined nt '%s' in RENAME\n" key; | _ -> ()); aux tl (StringMap.add key binding map) in aux edits StringMap.empty (* don't deal with Sedit, Sedit2 yet (ever?) *) let rec pmatch fullprod fullpat repl = let map_prod prod = List.concat (List.map (fun s -> pmatch [s] fullpat repl) prod) in let pmatch_wrap sym = let r = pmatch [sym] fullpat repl in match r with | a :: b :: tl -> Sparen r | [a] -> a | x -> error "pmatch: should not happen"; Sterm "??" in let symmatch_r s = let res = match s with | Slist1 sym -> Slist1 (pmatch_wrap sym) | Slist1sep (sym, sep) -> Slist1sep (pmatch_wrap sym, sep) | Slist0 sym -> Slist0 (pmatch_wrap sym) | Slist0sep (sym, sep) -> Slist0sep (pmatch_wrap sym, sep) | Sopt sym -> Sopt (pmatch_wrap sym) | Sparen prod -> Sparen (map_prod prod) | Sprod prods -> Sprod (List.map map_prod prods) | sym -> sym in (* Printf.printf "symmatch of %s gives %s\n" (prod_to_str [s]) (prod_to_str [res]);*) res in let rec pmatch_r prod pat match_start start_res res = (* Printf.printf "pmatch_r: prod = %s; pat = %s; res = %s\n" (prod_to_str prod) (prod_to_str pat) (prod_to_str res);*) match prod, pat with | _, [] -> let new_res = (List.rev repl) @ res in pmatch_r prod fullpat prod new_res new_res (* subst and continue *) | [], _ -> (List.rev ((List.rev match_start) @ res)) (* leftover partial match *) | hdprod :: tlprod, hdpat :: tlpat -> if hdprod = hdpat then pmatch_r tlprod tlpat match_start start_res res else (* match from the next starting position *) match match_start with | hd :: tl -> let new_res = (symmatch_r hd) :: start_res in pmatch_r tl fullpat tl new_res new_res | [] -> List.rev res (* done *) in pmatch_r fullprod fullpat fullprod [] [] (* global replace of production substrings, rhs only *) let global_repl g pat repl = List.iter (fun nt -> g_update_prods g nt (List.map (fun prod -> pmatch prod pat repl) (NTMap.find nt !g.map)) ) !g.order (*** splice: replace a reference to a nonterminal with its definition ***) (* todo: create a better splice routine *) (* todo: remove extraneous "(* ltac2 plugin *)" in Ltac2 Notation cmd *) let apply_splice g edit_map = List.iter (fun b -> let (nt0, prods0) = b in let rec splice_loop nt prods cnt = 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') (NTMap.bindings !g.map); List.iter (fun b -> let (nt, op) = b in match op with | "DELETE" | "SPLICE" -> g_remove g nt; | _ -> ()) (StringMap.bindings edit_map) let remove_prod edit prods nt = let res, got_first = List.fold_left (fun args prod -> let res, got_first = args in if not got_first && ematch prod edit then res, true else prod :: res, got_first) ([], false) prods in if not got_first then error "Can't find '%s' to DELETE for '%s'\n" (prod_to_str edit) nt; List.rev res let insert_after posn insert prods = List.concat (List.mapi (fun i prod -> if i = posn then prod :: insert else [prod]) prods) (*** replace LIST*, OPT with new nonterminals ***) (* generate a non-terminal name for a replacement *) let nt_regex = Str.regexp "^[a-zA-Z_][a-zA-Z0-9_\\.]*$" let good_name name = if Str.string_match nt_regex name 0 then name else "" let map_name s = let s = match s with | "|" -> "or" | "!" -> "exclam" | ">" -> "gt" | "<" -> "lt" | "+" -> "plus" | "?" -> "qmark" | "}" -> "rbrace" | "," -> "comma" | ";" -> "semi" | _ -> s in good_name s (* create a new nt for LIST* or OPT with the specified name *) let maybe_add_nt g insert_after name sym queue = let empty = [Snterm "empty"] in let maybe_unwrap ?(multi=false) sym = match sym with | Sprod slist when List.length slist = 1 || multi -> slist | Sparen slist -> [ slist ] | _ -> [ [sym] ] in let unw sym = List.hd (maybe_unwrap sym) in let get_prods nt = match sym with | Slist1 sym -> let sym' = unw sym in [ [Snterm nt] @ sym'; sym' ] | Slist1sep (sym, sep) | Slist0sep (sym, sep) -> let sym' = unw sym in [ [Snterm nt; sep] @ sym'; sym' ] | Slist0 sym -> [ [Snterm nt] @ (unw sym); empty ] | Sopt sym -> (maybe_unwrap ~multi:true sym) @ [ empty ] | Sprod slistlist -> slistlist | _ -> [] in let is_slist0sep sym = match sym with | Slist0sep _ -> true | _ -> false in (* find an existing nt with an identical definition, or generate an unused nt name *) let rec find_name nt i = let trial_name = sprintf "%s%s" nt (if i = 1 then "" else string_of_int i) in try if NTMap.find trial_name !g.map = get_prods trial_name then trial_name else find_name nt (succ i) with Not_found -> trial_name in let list_name sep = match sep with | Sterm s -> let name = map_name s in if name = s then "_list" else "_list_" ^ name | _ -> "_list" in let nt = name ^ match sym with | Slist1 sym -> "_list" | Slist1sep (sym, sep) -> list_name sep | Slist0 sym -> "_list_opt" | Slist0sep (sym, sep) -> list_name sep (* special handling *) | Sopt sym -> "_opt" | Sprod slistlist -> "_alt" | _ -> (error "Invalid symbol for USE_NT for nt '%s'\n" name; "ERROR") in let base_nt = find_name nt 1 in let new_nt = if is_slist0sep sym then base_nt ^ "_opt" else base_nt in if not (NTMap.mem new_nt !g.map) then begin let prods = if is_slist0sep sym then [ [Snterm base_nt]; empty ] else get_prods base_nt in g_add_after g (Some !insert_after) new_nt prods; insert_after := new_nt; Queue.add new_nt queue end; if is_slist0sep sym && not (NTMap.mem base_nt !g.map) then begin match sym with | Slist0sep (sym, sep) -> let prods = get_prods base_nt in g_add_after g (Some !insert_after) base_nt prods; insert_after := base_nt; Queue.add base_nt queue | _ -> () end; new_nt let apply_rename_delete g edit_map = List.iter (fun b -> let (nt, _) = b in let prods = try NTMap.find nt !g.map with Not_found -> [] in let (nt', prods') = edit_rule g edit_map nt prods in if nt' = "" then g_remove g nt else if nt <> nt' then g_rename_merge g nt nt' prods' else g_update_prods g nt prods') (NTMap.bindings !g.map) let edit_all_prods g op eprods = let g_old_map = !g.map in let do_it op eprods num = let rec aux eprods res = match eprods with | [] -> res | [Snterm old_nt; Snterm new_nt] :: tl when num = 2 -> aux tl ((old_nt, new_nt) :: res) | [Snterm old_nt] :: tl when num = 1 -> aux tl ((old_nt, op) :: res) | eprod :: tl -> error "Production '%s: %s' must have only %d nonterminal(s)\n" op (prod_to_str eprod) num; aux tl res in let edit_map = create_edit_map g op (aux eprods []) in match op with | "SPLICE" -> let rv = apply_splice g edit_map in let cause = Printf.sprintf "from SPLICE of '%s'" (prod_to_str (List.hd eprods)) in NTMap.iter (fun nt rule -> check_for_duplicates cause rule (NTMap.find nt g_old_map) nt) !g.map; rv | "RENAME" | "DELETE" -> apply_rename_delete g edit_map | _ -> () in match op with | "RENAME" -> do_it op eprods 2; true | "DELETE" -> do_it op eprods 1; true | "SPLICE" -> (* iterate to give precise error messages *) List.iter (fun prod -> do_it op [ prod ] 1) eprods; true | "OPTINREF" -> List.iter (fun nt -> let prods = NTMap.find nt !g.map in if has_match [] prods then begin let prods' = remove_prod [] prods nt in g_update_prods g nt prods'; global_repl g [(Snterm nt)] [(Sopt (Snterm nt))] end) !g.order; true | _ -> false let edit_single_prod g edit0 prods nt = let rec edit_single_prod_r edit prods nt seen = match edit with | [] -> prods | Sedit "ADD_OPT" :: sym :: tl -> let prods' = (try let pfx = List.rev seen in let posn = find_first edit0 prods nt in let prods = insert_after posn [pfx @ (Sopt sym :: tl)] prods in let prods = remove_prod (pfx @ (sym :: tl)) prods nt in remove_prod (pfx @ tl) prods nt with Not_found -> prods) in edit_single_prod_r tl prods' nt seen | Sedit "ADD_OPT" :: [] -> error "Bad position for ADD_OPT\n"; prods | Sedit2 ("USE_NT", name) :: sym :: tl -> let prods' = (try let nt = maybe_add_nt g (ref nt) name sym (Queue.create ()) in let pfx = List.rev seen in let posn = find_first edit0 prods nt in let prods = insert_after posn [pfx @ (Snterm nt :: tl)] prods in remove_prod (pfx @ (sym :: tl)) prods nt with Not_found -> prods) in edit_single_prod_r tl prods' nt seen | Sedit2 ("USE_NT", _) :: [] -> error "Bad position for USE_NT\n"; prods | sym :: tl -> edit_single_prod_r tl prods nt (sym :: seen) in edit_single_prod_r edit0 prods nt [] let report_undef_nts g prod rec_nt = let nts = nts_in_prod prod in List.iter (fun nt -> if not (NTMap.mem nt !g.map) && not (List.mem nt tokens) && nt <> rec_nt then error "Undefined nonterminal '%s' in edit: %s\n" nt (prod_to_str prod)) nts let apply_edit_file g edits = let moveto src_nt dest_nt oprod prods = g_add_prod_after g (Some src_nt) dest_nt oprod; remove_prod oprod prods src_nt (* remove orig prod *) in List.iter (fun b -> let (nt, eprod) = b in if not (edit_all_prods g nt eprod) then begin let rec aux eprod prods add_nt = let g_old_map = !g.map in let rv = match eprod with | [] -> prods, add_nt | (Snterm "DELETE" :: oprod) :: tl -> aux tl (remove_prod oprod prods nt) add_nt | (Snterm "DELETENT" :: _) :: tl -> (* note this doesn't remove references *) if not (NTMap.mem nt !g.map) then error "DELETENT for undefined nonterminal '%s'\n" nt; g_remove g nt; aux tl prods false | (Snterm "MOVETO" :: Snterm dest_nt :: oprod) :: tl -> let prods = try (* add "nt -> dest_nt" production *) let posn = find_first oprod prods nt in if List.mem [Snterm dest_nt] prods then prods else insert_after posn [[Snterm dest_nt]] prods (* insert new prod *) with Not_found -> prods in let prods' = moveto nt dest_nt oprod prods in aux tl prods' add_nt | [Snterm "COPYALL"; Snterm dest_nt] :: tl -> if NTMap.mem dest_nt !g.map then error "COPYALL target nonterminal '%s' already exists\n" dest_nt; g_maybe_add g dest_nt prods; aux tl prods add_nt | [Snterm "MOVEALLBUT"; Snterm dest_nt] :: tl -> List.iter (fun tlprod -> if not (List.mem tlprod prods) then error "MOVEALLBUT for %s can't find '%s'\n" nt (prod_to_str tlprod)) tl; let prods' = List.fold_left (fun prods oprod -> if not (List.mem oprod tl) then begin moveto nt dest_nt oprod prods end else prods) prods prods in prods', add_nt | (Snterm "OPTINREF" :: _) :: tl -> if not (has_match [] prods) then error "OPTINREF but no empty production for %s\n" nt; global_repl g [(Snterm nt)] [(Sopt (Snterm nt))]; aux tl (remove_prod [] prods nt) add_nt | (Snterm "INSERTALL" :: syms) :: tl -> aux tl (List.map (fun p -> syms @ p) prods) add_nt | (Snterm "APPENDALL" :: syms) :: tl -> aux tl (List.map (fun p -> p @ syms) prods) add_nt | (Snterm "PRINT" :: _) :: tl -> pr_prods nt prods; aux tl prods add_nt | (Snterm "EDIT" :: oprod) :: tl -> aux tl (edit_single_prod g oprod prods nt) add_nt | (Snterm "REPLACE" :: oprod) :: (Snterm "WITH" :: rprod) :: tl -> report_undef_nts g rprod ""; (* todo: check result not already present *) let prods' = (try let posn = find_first oprod prods nt in let prods = insert_after posn [rprod] prods in (* insert new prod *) remove_prod oprod prods nt (* remove orig prod *) with Not_found -> prods) in aux tl prods' add_nt | (Snterm "REPLACE" :: _ as eprod) :: tl -> error "Missing WITH after '%s' in '%s'\n" (prod_to_str eprod) nt; aux tl prods add_nt (* todo: check for unmatched editing keywords here *) | prod :: tl -> (* add a production *) if has_match prod prods then error "Duplicate production '%s -> %s'\n" nt (prod_to_str prod); report_undef_nts g prod nt; aux tl (prods @ [prod]) add_nt in if eprod <> [] then begin let cause = Printf.sprintf "from '%s'" (prod_to_str (List.hd eprod)) in NTMap.iter (fun nt rule -> let old_rule = try NTMap.find nt g_old_map with Not_found -> [] in check_for_duplicates cause rule old_rule nt) !g.map; end; rv in let prods, add_nt = aux eprod (try NTMap.find nt !g.map with Not_found -> []) true in if add_nt then g_maybe_add g nt prods end) edits (*** main routines ***) (* get the special tokens in the grammar *) let print_special_tokens g = let rec traverse set = function | Sterm s -> let c = s.[0] in if (c >= 'a' && c <= 'z') || (c >= 'A' && c <= 'Z') then set else StringSet.add s set | Snterm s -> set | Slist1 sym | Slist0 sym | Sopt sym -> traverse set sym | Slist1sep (sym, sep) | Slist0sep (sym, sep) -> traverse (traverse set sym) sep | Sparen sym_list -> traverse_prod set sym_list | Sprod sym_list_list -> traverse_prods set sym_list_list | Sedit _ | Sedit2 _ -> set and traverse_prod set prod = List.fold_left traverse set prod and traverse_prods set prods = List.fold_left traverse_prod set prods in let spec_toks = List.fold_left (fun set b -> let nt, prods = b in traverse_prods set prods) StringSet.empty (NTMap.bindings !g.map) in Printf.printf "Special tokens:"; StringSet.iter (fun t -> Printf.printf " %s" t) spec_toks; Printf.printf "\n\n" (* get the transitive closure of a non-terminal excluding "stops" symbols. Preserve ordering to the extent possible *) (* todo: at the moment, the code doesn't use the ordering; consider switching to using sets instead of lists *) let nt_closure g start stops = let stop_set = StringSet.of_list stops in let rec nt_closure_r res todo = match todo with | [] -> res | nt :: tl -> if List.mem nt res || StringSet.mem nt stop_set then nt_closure_r res tl else begin let more_to_do = try let prods = NTMap.find nt !g.map in tl @ (List.concat (List.map nts_in_prod prods)) with Not_found -> tl in nt_closure_r (nt :: res) more_to_do end in List.rev (nt_closure_r [] [start]) let index_of str list = let rec index_of_r str list index = match list with | [] -> None | hd :: list -> if hd = str then Some index else index_of_r str list (index+1) in index_of_r str list 0 (* todo: raise exception for bad n? *) let rec nthcdr n list = if n <= 0 then list else nthcdr (n-1) (List.tl list) let report_bad_nts g file = let all_nts_ref, all_nts_def = get_refdef_nts g in let undef = StringSet.diff all_nts_ref all_nts_def in if !show_warn then List.iter (fun nt -> warn "%s: Undefined symbol '%s'\n" file nt) (StringSet.elements undef); let reachable = List.fold_left (fun res sym -> StringSet.union res (StringSet.of_list (nt_closure g sym []))) StringSet.empty start_symbols in let unreachable = List.filter (fun nt -> not (StringSet.mem nt reachable)) !g.order in if !show_warn then List.iter (fun nt -> warn "%s: Unreachable symbol '%s'\n" file nt) unreachable let reorder_grammar eg reordered_rules file = let og = g_empty () in List.iter (fun rule -> let nt, prods = rule in try (* only keep nts and prods in common with editedGrammar *) let eg_prods = NTMap.find nt !eg.map in let prods = List.filter (fun prod -> (has_match prod eg_prods)) prods in if NTMap.mem nt !og.map && !show_warn then warn "%s: Duplicate nonterminal '%s'\n" file nt; add_rule og nt prods file with Not_found -> ()) reordered_rules; g_reverse og; (* insert a prod in a list after prev_prod (None=at the beginning) *) let rec insert_prod prev_prod prod prods res = match prev_prod, prods with | None, _ -> prod :: prods | Some _, [] -> raise Not_found | Some ins_after_prod, hd :: tl -> if ematch hd ins_after_prod then (List.rev res) @ (hd :: prod :: tl) else insert_prod prev_prod prod tl (hd :: res) in (* insert prods that are not already in og_prods *) let rec upd_prods prev_prod eg_prods og_prods = match eg_prods with | [] -> og_prods | prod :: tl -> let og_prods = if has_match prod og_prods then List.map (fun p -> if ematch p prod then prod else p) og_prods else insert_prod prev_prod prod og_prods [] in upd_prods (Some prod) tl og_prods in (* add nts and prods not present in orderedGrammar *) let _ = List.fold_left (fun prev_nt nt -> let e_prods = NTMap.find nt !eg.map in if not (NTMap.mem nt !og.map) then g_add_after og prev_nt nt e_prods else g_update_prods og nt (upd_prods None e_prods (NTMap.find nt !og.map)); Some nt) None !eg.order in g_reorder eg !og.map !og.order let finish_with_file old_file args = let files_eq f1 f2 = let chunksize = 8192 in (try let ofile = open_in_bin f1 in let nfile = open_in_bin f2 in let rv = if (in_channel_length ofile) <> (in_channel_length nfile) then false else begin let obuf = Bytes.create chunksize in Bytes.fill obuf 0 chunksize '\x00'; let nbuf = Bytes.create chunksize in Bytes.fill nbuf 0 chunksize '\x00'; let rec read () = let olen = input ofile obuf 0 chunksize in let _ = input nfile nbuf 0 chunksize in if obuf <> nbuf then false else if olen = 0 then true else read () in read () end in close_in ofile; close_in nfile; rv with Sys_error _ -> false) in let temp_file = (old_file ^ ".new") in if !exit_code <> 0 then Sys.remove temp_file else if args.verify then begin if not (files_eq old_file temp_file) then begin error "%s is not current\n" old_file; ignore (CUnix.sys_command "diff" [ old_file ; old_file ^ ".new"]) end; Sys.remove temp_file end else if args.update then Sys.rename temp_file old_file let open_temp_bin file = open_out_bin (sprintf "%s.new" 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 let prods = StringSet.fold (fun a lst -> a :: lst) prods [] in (* todo: wasteful! *) let common_prefix_len s1 s2 = let limit = min (String.length s1) (String.length s2) in let rec aux off = if off = limit then off else if s1.[off] = s2.[off] then aux (succ off) else off in aux 0 in let slen = String.length str in let str_pfx = get_pfx str in let no_subscrs = remove_subscrs str in let has_subscrs = no_subscrs <> str in let rec longest best multi best_len prods = match prods with | [] -> best, multi, best_len | prod :: tl -> let pstr = String.trim prod in (* todo: should be pretrimmed *) let clen = common_prefix_len str pstr in if has_subscrs && no_subscrs = pstr then str, false, clen (* exact match ignoring subscripts *) else if pstr = str then pstr, false, clen (* exact match of full line *) else if str_pfx = "" || str_pfx <> get_pfx pstr then longest best multi best_len tl (* prefixes don't match *) else if clen = slen && slen = String.length pstr then pstr, false, clen (* exact match on prefix *) else if clen > best_len then longest pstr false clen tl (* better match *) else if clen = best_len then longest best true best_len tl (* 2nd match with same length *) else longest best multi best_len tl (* worse match *) in let mtch, multi, _ = longest "" false 0 prods in if has_subscrs && mtch <> str then "", multi, mtch (* no match for subscripted entry *) else mtch, multi, "" type seen = { nts: (string * int) NTMap.t; tacs: (string * int) NTMap.t; tacvs: (string * int) NTMap.t; cmds: (string * int) NTMap.t; cmdvs: (string * int) NTMap.t; } (* Sphinx notations can't handle empty productions *) let has_empty_prod rhs = let rec has_empty_prod_r rhs = match rhs with | [] -> false | Sterm _ :: tl | Snterm _ :: tl | Sedit _ :: tl | Sedit2 (_, _) :: tl -> has_empty_prod_r tl | Slist1 sym :: tl | Slist0 sym :: tl | Slist1sep (sym, _) :: tl | Slist0sep (sym, _) :: tl | Sopt sym :: tl -> has_empty_prod_r [ sym ] || has_empty_prod_r tl | Sparen prod :: tl -> List.length prod = 0 || has_empty_prod_r tl | Sprod prods :: tl -> List.fold_left (fun rv prod -> List.length prod = 0 || has_empty_prod_r tl || rv) false prods in List.length rhs = 0 || has_empty_prod_r rhs let process_rst g file args seen tac_prods cmd_prods = let old_rst = open_in file in let new_rst = open_temp_bin file in let linenum = ref 0 in let dir_regex = Str.regexp "^\\([ \t]*\\)\\.\\.[ \t]*\\([a-zA-Z0-9:]* *\\)\\(.*\\)" in let contin_regex = Str.regexp "^\\([ \t]*\\)\\(.*\\)" in let ip_args_regex = Str.regexp "^[ \t]*\\([a-zA-Z0-9_\\.]+\\)[ \t]+\\([a-zA-Z0-9_\\.]+\\)" in let blank_regex = Str.regexp "^[ \t]*$" in let end_prodlist_regex = Str.regexp "^[ \t]*$" in let getline () = let line = input_line old_rst in incr linenum; line in (* todo: maybe pass end_index? *) let output_insertprodn start_index end_ indent = let rec copy_prods list = match list with | [] -> () | nt :: tl -> (try let (prev_file, prev_linenum) = NTMap.find nt !seen.nts in if !show_warn then warn "%s line %d: '%s' already included at %s line %d\n" file !linenum nt prev_file prev_linenum; with Not_found -> seen := { !seen with nts = (NTMap.add nt (file, !linenum) !seen.nts)} ); let prods = NTMap.find nt !g.map in List.iteri (fun i prod -> let rhs = String.trim (prod_to_prodn prod) in let tag = get_tag file prod in let sep = if i = 0 then " ::=" else "|" in if has_empty_prod prod then error "%s line %d: Empty (sub-)production for %s, edit to remove: '%s %s'\n" file !linenum nt sep rhs; fprintf new_rst "%s %s%s %s%s\n" indent (if i = 0 then nt else "") sep rhs tag) prods; if nt <> end_ then copy_prods tl in copy_prods (nthcdr start_index !g.order) in let process_insertprodn line rhs = if not (Str.string_match ip_args_regex rhs 0) then error "%s line %d: bad arguments '%s' for 'insertprodn'\n" file !linenum rhs else begin let start = Str.matched_group 1 rhs in let end_ = Str.matched_group 2 rhs in let start_index = index_of start !g.order in let end_index = index_of end_ !g.order in if start_index = None then error "%s line %d: '%s' is undefined in insertprodn\n" file !linenum start; if end_index = None then error "%s line %d: '%s' is undefined in insertprodn\n" file !linenum end_; (* if start_index <> None && end_index <> None then*) (* check_range_consistency g start end_;*) match start_index, end_index with | Some start_index, Some end_index -> if start_index > end_index then error "%s line %d: '%s' must appear before '%s' in orderedGrammar\n" file !linenum start end_ else begin try let line2 = getline() in if not (Str.string_match blank_regex line2 0) then error "%s line %d: expecting a blank line after 'insertprodn'\n" file !linenum else begin let line3 = getline() in if not (Str.string_match dir_regex line3 0) || (String.trim (Str.matched_group 2 line3)) <> "prodn::" then error "%s line %d: expecting '.. prodn::' after 'insertprodn'\n" file !linenum else begin let indent = Str.matched_group 1 line3 in let rec skip_to_end () = let endline = getline() in if Str.string_match end_prodlist_regex endline 0 then begin fprintf new_rst "%s\n\n%s\n" line line3; output_insertprodn start_index end_ indent; fprintf new_rst "%s\n" endline end else skip_to_end () in skip_to_end () end end with End_of_file -> error "%s line %d: unexpected end of file\n" file !linenum; end | _ -> () end in let save_n_get_more direc pfx first_rhs seen_map prods = let replace rhs prods = if StringSet.is_empty prods then rhs (* no change *) else let mtch, multi, best = find_longest_match prods rhs in (* Printf.printf "mtch = '%s' rhs = '%s'\n" mtch rhs;*) if mtch = rhs then rhs (* no change *) else if mtch = "" then begin 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 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 *) in let map = ref seen_map in if NTMap.mem first_rhs !map && !show_warn then warn "%s line %d: Repeated %s: '%s'\n" file !linenum direc first_rhs; (* if not (StringSet.mem rhs seen_map) then*) (* warn "%s line %d: Unknown tactic: '%s'\n" file !linenum rhs;*) fprintf new_rst "%s%s\n" pfx (replace first_rhs prods); map := NTMap.add (remove_subscrs first_rhs) (file, !linenum) !map; while try let nextline = getline() in ignore (Str.string_match contin_regex nextline 0); let indent = Str.matched_group 1 nextline in let rhs = Str.matched_group 2 nextline in let replaceable = rhs <> "" && rhs.[0] <> ':' in let upd_rhs = if replaceable then (replace rhs prods) else rhs in fprintf new_rst "%s%s\n" indent upd_rhs; if replaceable then begin map := NTMap.add (remove_subscrs rhs) (file, !linenum) !map end; rhs <> "" with End_of_file -> false do () done; !map in try while true do let line = getline() in if Str.string_match dir_regex line 0 then begin let dir = String.trim (Str.matched_group 2 line) in let rhs = Str.matched_group 3 line in let pfx = String.sub line 0 (Str.group_end 2) in match dir with | "prodn::" -> if rhs = "coq" && !show_warn then warn "%s line %d: Missing 'insertprodn' before 'prodn:: coq'\n" file !linenum; fprintf new_rst "%s\n" line; | "tacn::" -> seen := { !seen with tacs = save_n_get_more "tacn" pfx rhs !seen.tacs tac_prods } | "tacv::" -> seen := { !seen with tacvs = save_n_get_more "tacv" pfx rhs !seen.tacvs StringSet.empty } | "cmd::" -> seen := { !seen with cmds = save_n_get_more "cmd" pfx rhs !seen.cmds cmd_prods } | "cmdv::" -> seen := { !seen with cmdvs = save_n_get_more "cmdv" pfx rhs !seen.cmdvs StringSet.empty } | "insertprodn" -> process_insertprodn line rhs | _ -> fprintf new_rst "%s\n" line end else fprintf new_rst "%s\n" line; done with End_of_file -> (); close_in old_rst; close_out new_rst; finish_with_file file args let report_omitted_prods g seen label split = if !show_warn then begin let included = try List.map (fun prod -> match prod with | Snterm nt :: tl -> nt | _ -> "") (NTMap.find "NOTINRSTS" !g.map) with Not_found -> [] in Printf.printf "\n\n"; let missing = NTMap.filter (fun nt _ -> not (NTMap.mem nt seen || (List.mem nt included))) !g.map in NTMap.iter (fun nt _ -> warn "%s %s not included in .rst files\n" "Nonterminal" nt) missing; let total = NTMap.cardinal missing in if total <> 0 then Printf.eprintf "TOTAL %ss not included = %d\n" label total end let process_grammar args = let symdef_map = ref StringMap.empty in let g = g_empty () in let level_renames = read_mlg_files g args symdef_map in if args.verbose then begin Printf.printf "Keywords:\n"; StringSet.iter (fun kw -> Printf.printf "%s " kw) !keywords; Printf.printf "\n\n"; end; (* rename nts with levels *) List.iter (fun b -> let (nt, prod) = b in let (_, prod) = edit_rule g level_renames nt prod in g_update_prods g nt prod) (NTMap.bindings !g.map); (* print the full grammar with minimal editing *) let out = open_temp_bin (dir "fullGrammar") in fprintf out "%s\n%s\n\n" "(* Coq grammar generated from .mlg files. Do not edit by hand. Not compiled into Coq *)" "DOC_GRAMMAR"; print_in_order out g `MLG !g.order StringSet.empty; close_out out; finish_with_file (dir "fullGrammar") args; if args.verbose then print_special_tokens g; if not args.fullGrammar then begin (* do shared edits *) if !exit_code = 0 then begin let common_edits = read_mlg_edit "common.edit_mlg" in apply_edit_file g common_edits end; let prodn_gram = ref { map = !g.map; order = !g.order } in (* todo: should just be 'g', right? *) if !exit_code = 0 && not args.verify then begin let out = open_temp_bin (dir "editedGrammar") in fprintf out "%s\n%s\n\n" "(* Edited Coq grammar generated from .mlg files. Do not edit by hand. Not compiled into Coq *)" "DOC_GRAMMAR"; print_in_order out g `MLG !g.order StringSet.empty; close_out out; finish_with_file (dir "editedGrammar") args; report_bad_nts g "editedGrammar" end; if !exit_code = 0 then begin let ordered_grammar = read_mlg_edit "orderedGrammar" in let out = open_temp_bin (dir "orderedGrammar") in fprintf out "%s\n%s\n\n" ("(* Defines the order to apply to editedGrammar to get the final grammar for the doc.\n" ^ "doc_grammar will modify this file to add/remove nonterminals and productions\n" ^ "to match editedGrammar, which will remove comments. Not compiled into Coq *)") "DOC_GRAMMAR"; reorder_grammar g ordered_grammar "orderedGrammar"; print_in_order out g `MLG !g.order StringSet.empty; close_out out; finish_with_file (dir "orderedGrammar") args; (* check_singletons g*) let seen = ref { nts=NTMap.empty; tacs=NTMap.empty; tacvs=NTMap.empty; cmds=NTMap.empty; cmdvs=NTMap.empty } in let plist nt = let list = (List.map (fun t -> String.trim (prod_to_prodn t)) (NTMap.find nt !g.map)) in list, StringSet.of_list list in let tac_list, tac_prods = plist "simple_tactic" in let cmd_list, cmd_prods = plist "command" in List.iter (fun file -> process_rst g file args seen tac_prods cmd_prods) args.rst_files; report_omitted_prods g !seen.nts "Nonterminal" ""; let out = open_out (dir "updated_rsts") in close_out out; (* generate report on cmds or tacs *) let cmdReport outfile cmdStr itemName cmd_nts cmds cmdvs = let rstCmds = StringSet.of_list (List.map (fun b -> let c, _ = b in c) (NTMap.bindings cmds)) in let rstCmdvs = StringSet.of_list (List.map (fun b -> let c, _ = b in c) (NTMap.bindings cmdvs)) in let gramCmds = List.fold_left (fun set nt -> 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_out_bin (dir outfile) in StringSet.iter (fun c -> let rsts = StringSet.mem c rstCmds in let gram = StringSet.mem c gramCmds in let pfx = match rsts, gram with | true, false -> error "%s not in grammar: %s\n" itemName c; "+" | false, true -> error "%s not in doc: %s\n" itemName c; "-" | false, false -> "?" | _, _ -> " " in let var = if StringSet.mem c rstCmdvs then "v" else " " in fprintf out "%s%s %s\n" pfx var c) allCmds; close_out out; Printf.printf "# %s in rsts, gram, total = %d %d %d\n" cmdStr (StringSet.cardinal gramCmds) (StringSet.cardinal rstCmds) (StringSet.cardinal allCmds); in let cmd_nts = ["command"] in (* TODO: need to handle tactic_mode (overlaps with query_command) and subprf *) if args.check_cmds then cmdReport "prodnCommands" "cmds" "Command" cmd_nts !seen.cmds !seen.cmdvs; let tac_nts = ["simple_tactic"] in if args.check_tacs then cmdReport "prodnTactics" "tacs" "Tactic" tac_nts !seen.tacs !seen.tacvs; (* 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 let args = List.fold_left (fun args arg -> match arg with | "-check-cmds" -> { args with check_cmds = true } | "-check-tacs" -> { args with check_tacs = true } | "-no-warn" -> show_warn := false; { args with show_warn = false } | "-no-update" -> { args with update = false } | "-short" -> { args with fullGrammar = true } | "-verbose" -> { args with verbose = true } | "-verify" -> { args with verify = true } | arg when Str.string_match suffix_regex arg 0 -> (match Str.matched_group 1 arg with | "mlg" -> { args with mlg_files = (arg :: args.mlg_files) } | "rst" -> { args with rst_files = (arg :: args.rst_files) } | _ -> error "Unknown command line argument '%s'\n" arg; args) | arg -> error "Unknown command line argument '%s'\n" arg; args) default_args (List.tl (Array.to_list Sys.argv)) in { args with mlg_files = (List.rev args.mlg_files); rst_files = (List.rev args.rst_files)} let () = (*try*) Printexc.record_backtrace true; let args = parse_args () in if !exit_code = 0 then begin process_grammar args end; if !error_count > 0 then Printf.eprintf "%d error(s)\n" !error_count; exit !exit_code (*with _ -> Printexc.print_backtrace stdout; exit 1*) coq-8.20.0/doc/tools/docgram/doc_grammar.mli000066400000000000000000000000001466560755400206720ustar00rootroot00000000000000coq-8.20.0/doc/tools/docgram/dune000066400000000000000000000041241466560755400166050ustar00rootroot00000000000000(executable (name doc_grammar) (libraries coq-core.clib coqpp)) (env (_ (binaries doc_grammar.exe))) (rule (alias check-gram) (deps (:input ; Main grammar (glob_files %{project_root}/parsing/*.mlg) (glob_files %{project_root}/toplevel/*.mlg) (glob_files %{project_root}/vernac/*.mlg) (glob_files %{project_root}/plugins/btauto/*.mlg) (glob_files %{project_root}/plugins/cc/*.mlg) (glob_files %{project_root}/plugins/derive/*.mlg) (glob_files %{project_root}/plugins/extraction/*.mlg) (glob_files %{project_root}/plugins/firstorder/*.mlg) (glob_files %{project_root}/plugins/funind/*.mlg) (glob_files %{project_root}/plugins/ltac/*.mlg) (glob_files %{project_root}/plugins/micromega/*.mlg) (glob_files %{project_root}/plugins/nsatz/*.mlg) (glob_files %{project_root}/plugins/ring/*.mlg) (glob_files %{project_root}/plugins/rtauto/*.mlg) (glob_files %{project_root}/plugins/ssr/*.mlg) (glob_files %{project_root}/plugins/ssrmatching/*.mlg) (glob_files %{project_root}/plugins/syntax/*.mlg) (glob_files %{project_root}/plugins/ltac2/*.mlg) ; Sphinx files (glob_files %{project_root}/doc/sphinx/language/*.rst) (glob_files %{project_root}/doc/sphinx/proof-engine/*.rst) (glob_files %{project_root}/doc/sphinx/user-extensions/*.rst) (glob_files %{project_root}/doc/sphinx/practical-tools/*.rst) (glob_files %{project_root}/doc/sphinx/addendum/*.rst) (glob_files %{project_root}/doc/sphinx/language/core/*.rst) (glob_files %{project_root}/doc/sphinx/language/extensions/*.rst) (glob_files %{project_root}/doc/sphinx/proofs/writing-proofs/*.rst) (glob_files %{project_root}/doc/sphinx/proofs/automatic-tactics/*.rst) (glob_files %{project_root}/doc/sphinx/proofs/creating-tactics/*.rst) (glob_files %{project_root}/doc/sphinx/using/libraries/*.rst) (glob_files %{project_root}/doc/sphinx/using/tools/*.rst)) common.edit_mlg orderedGrammar) (action (progn (chdir %{project_root} (run doc_grammar -no-warn -check-cmds -no-update %{input})) (diff? fullGrammar fullGrammar.new) (diff? orderedGrammar orderedGrammar.new)))) coq-8.20.0/doc/tools/docgram/fullGrammar000066400000000000000000002170251466560755400201310ustar00rootroot00000000000000(* Coq grammar generated from .mlg files. Do not edit by hand. Not compiled into Coq *) DOC_GRAMMAR Constr.ident: [ | Prim.ident ] Prim.name: [ | "_" ] global: [ | Prim.reference ] constr_pattern: [ | constr ] cpattern: [ | lconstr ] sort: [ | "Set" | "Prop" | "SProp" | "Type" | "Type" "@{" "_" "}" | "Type" "@{" test_sort_qvar reference "|" universe "}" | "Type" "@{" universe "}" ] sort_family: [ | "Set" | "Prop" | "SProp" | "Type" ] universe_increment: [ | "+" natural | ] universe_name: [ | global | "Set" | "Prop" ] universe_expr: [ | universe_name universe_increment ] universe: [ | "max" "(" LIST1 universe_expr SEP "," ")" | "_" | universe_expr ] lconstr: [ | term200 ] constr: [ | term8 | "@" global univ_annot ] term200: [ | term100 ] term100: [ | term99 "<:" term200 | term99 "<<:" term200 | term99 ":>" term200 | term99 ":" term200 | term99 ] term99: [ | term90 ] term90: [ | term10 ] term10: [ | term9 LIST1 arg | "@" global univ_annot LIST0 term9 | "@" pattern_ident LIST1 identref | binder_constr | term9 ] term9: [ | ".." term0 ".." | term8 ] term8: [ | term1 ] term1: [ | term0 ".(" global univ_annot LIST0 arg ")" | term0 ".(" "@" global univ_annot LIST0 ( term9 ) ")" | term0 "%" IDENT | term0 "%_" IDENT | term0 ] term0: [ | atomic_constr | term_match | ident Prim.fields univ_annot | ident univ_annot | NUMBER | string | "(" term200 ")" | "{|" record_declaration bar_cbrace | "`{" term200 "}" | test_array_opening "[" "|" array_elems "|" lconstr type_cstr test_array_closing "|" "]" univ_annot | "`(" term200 ")" | "ltac" ":" "(" Pltac.ltac_expr ")" ] array_elems: [ | LIST0 lconstr SEP ";" ] record_declaration: [ | fields_def ] fields_def: [ | field_def ";" fields_def | field_def | ] field_def: [ | global binders ":=" lconstr ] binder_constr: [ | "forall" open_binders "," term200 | "fun" open_binders "=>" term200 | "let" name binders let_type_cstr ":=" term200 "in" term200 | "let" "fix" fix_decl "in" term200 | "let" "cofix" cofix_body "in" term200 | "let" [ "(" LIST0 name SEP "," ")" | "()" ] as_return_type ":=" term200 "in" term200 | "let" "'" pattern200 ":=" term200 "in" term200 | "let" "'" pattern200 ":=" term200 case_type "in" term200 | "let" "'" pattern200 "in" pattern200 ":=" term200 case_type "in" term200 | "if" term200 as_return_type "then" term200 "else" term200 | "fix" fix_decls | "cofix" cofix_decls ] arg: [ | test_lpar_id_coloneq "(" identref ":=" lconstr ")" | test_lpar_nat_coloneq "(" natural ":=" lconstr ")" | term9 ] atomic_constr: [ | sort | "_" | "?" "[" identref "]" | "?" "[" pattern_ident "]" | pattern_ident evar_instance ] inst: [ | identref ":=" lconstr ] evar_instance: [ | "@{" LIST1 inst SEP ";" "}" | ] univ_annot: [ | "@{" LIST0 univ_level_or_quality OPT [ "|" LIST0 univ_level_or_quality ] "}" | ] univ_level_or_quality: [ | "Set" | "SProp" | "Prop" | "Type" | "_" | global ] fix_decls: [ | fix_decl | fix_decl "with" LIST1 fix_decl SEP "with" "for" identref ] cofix_decls: [ | cofix_body | cofix_body "with" LIST1 cofix_body SEP "with" "for" identref ] fix_decl: [ | identref binders_fixannot type_cstr ":=" term200 ] cofix_body: [ | identref binders type_cstr ":=" term200 ] term_match: [ | "match" LIST1 case_item SEP "," OPT case_type "with" branches "end" ] case_item: [ | term100 OPT [ "as" name ] OPT [ "in" pattern200 ] ] case_type: [ | "return" term100 ] as_return_type: [ | OPT [ OPT [ "as" name ] case_type ] ] branches: [ | OPT "|" LIST0 eqn SEP "|" ] mult_pattern: [ | LIST1 pattern200 SEP "," ] eqn: [ | LIST1 mult_pattern SEP "|" "=>" lconstr ] record_pattern: [ | global ":=" pattern200 ] record_patterns: [ | record_pattern ";" record_patterns | record_pattern | ] pattern200: [ | pattern100 ] pattern100: [ | pattern99 ":" term200 | pattern99 ] pattern99: [ | pattern90 ] pattern90: [ | pattern10 ] pattern10: [ | pattern1 "as" name | pattern1 LIST1 pattern1 | "@" Prim.reference LIST0 pattern1 | pattern1 ] pattern1: [ | pattern0 "%" IDENT | pattern0 "%_" IDENT | pattern0 ] pattern0: [ | Prim.reference | "{|" record_patterns bar_cbrace | "_" | "(" pattern200 ")" | "(" pattern200 "|" LIST1 pattern200 SEP "|" ")" | NUMBER | string ] fixannot: [ | "{" "struct" identref "}" | "{" "wf" constr identref "}" | "{" "measure" constr OPT identref OPT constr "}" ] binders_fixannot: [ | ensure_fixannot fixannot | binder binders_fixannot | ] open_binders: [ | name LIST0 name ":" lconstr | name LIST0 name binders | name ".." name | closed_binder binders ] binders: [ | LIST0 binder | Pcoq.Constr.binders ] binder: [ | name | closed_binder ] closed_binder: [ | "(" name LIST1 name ":" lconstr ")" | "(" name ":" lconstr ")" | "(" name ":=" lconstr ")" | "(" name ":" lconstr ":=" lconstr ")" | "{" name "}" | "{" name LIST1 name ":" lconstr "}" | "{" name ":" lconstr "}" | "{" name LIST1 name "}" | "[" name "]" | "[" name LIST1 name ":" lconstr "]" | "[" name ":" lconstr "]" | "[" name LIST1 name "]" | "`(" LIST1 typeclass_constraint SEP "," ")" | "`{" LIST1 typeclass_constraint SEP "," "}" | "`[" LIST1 typeclass_constraint SEP "," "]" | "'" pattern0 ] one_open_binder: [ | name | name ":" lconstr | one_closed_binder ] one_closed_binder: [ | "(" name ":" lconstr ")" | "{" name "}" | "{" name ":" lconstr "}" | "[" name "]" | "[" name ":" lconstr "]" | "'" pattern0 ] typeclass_constraint: [ | "!" term200 | "{" name "}" ":" [ "!" | ] term200 | test_name_colon name ":" [ "!" | ] term200 | term200 ] type_cstr: [ | ":" lconstr | ] let_type_cstr: [ | OPT [ ":" lconstr ] ] preident: [ | IDENT ] ident: [ | IDENT ] pattern_ident: [ | LEFTQMARK ident ] identref: [ | ident ] hyp: [ | identref ] field: [ | FIELD ] fields: [ | field fields | field ] fullyqualid: [ | ident fields | ident ] name: [ | "_" | ident ] reference: [ | ident fields | ident ] qualid: [ | reference ] by_notation: [ | ne_string OPT [ "%" IDENT ] ] smart_global: [ | reference | by_notation ] ne_string: [ | STRING ] ne_lstring: [ | ne_string ] dirpath: [ | ident LIST0 field ] string: [ | STRING ] lstring: [ | string ] integer: [ | bigint ] natural: [ | bignat ] bigint: [ | bignat | test_minus_nat "-" bignat ] bignat: [ | NUMBER ] bar_cbrace: [ | test_pipe_closedcurly "|" "}" ] strategy_level: [ | "expand" | "opaque" | integer | "transparent" ] vernac_toplevel: [ | "Drop" "." | "Quit" "." | "BackTo" natural "." | test_show_goal "Show" "Goal" natural "at" natural "." | "Show" "Proof" "Diffs" OPT "removed" "." | Pvernac.Vernac_.main_entry ] opt_hintbases: [ | | ":" LIST1 IDENT ] command: [ | "Goal" lconstr | "Proof" | "Proof" "using" G_vernac.section_subset_expr | "Proof" "Mode" string | "Proof" lconstr | "Abort" | "Abort" "All" | "Admitted" | "Qed" | "Save" identref | "Defined" | "Defined" identref | "Restart" | "Undo" | "Undo" natural | "Undo" "To" natural | "Focus" | "Focus" natural | "Unfocus" | "Unfocused" | "Show" | "Show" natural | "Show" ident | "Show" "Existentials" | "Show" "Universes" | "Show" "Conjectures" | "Show" "Proof" | "Show" "Intro" | "Show" "Intros" | "Show" "Match" reference | "Guarded" | "Validate" "Proof" | "Create" "HintDb" IDENT; [ "discriminated" | ] | "Remove" "Hints" LIST1 global opt_hintbases | "Hint" hint opt_hintbases | "Comments" LIST0 comment | "Attributes" attribute_list | "Declare" "Instance" ident_decl binders ":" term200 hint_info | "Declare" "Scope" IDENT | "Pwd" | "Cd" | "Cd" ne_string | "Load" [ "Verbose" | ] [ ne_string | IDENT ] | "Declare" "ML" "Module" LIST1 ne_string | "Locate" locatable | "Type" lconstr | "Print" printable | "Print" smart_global OPT univ_name_list | "Print" "Module" "Type" global | "Print" "Module" global | "Print" "Namespace" dirpath | "Inspect" natural | "Set" setting_name option_setting | "Unset" setting_name | "Print" "Table" setting_name | "Add" IDENT IDENT LIST1 table_value | "Add" IDENT LIST1 table_value | "Test" setting_name "for" LIST1 table_value | "Test" setting_name | "Remove" IDENT IDENT LIST1 table_value | "Remove" IDENT LIST1 table_value | "Reset" "Initial" | "Reset" identref | "Back" | "Back" natural | "Debug" "On" | "Debug" "Off" | "Declare" "Reduction" IDENT; ":=" red_expr | "Declare" "Custom" "Entry" IDENT | "Derive" identref "SuchThat" constr "As" identref (* derive plugin *) | "Extraction" global (* extraction plugin *) | "Recursive" "Extraction" LIST1 global (* extraction plugin *) | "Extraction" string LIST1 global (* extraction plugin *) | "Extraction" "TestCompile" LIST1 global (* extraction plugin *) | "Separate" "Extraction" LIST1 global (* extraction plugin *) | "Extraction" "Library" identref (* extraction plugin *) | "Recursive" "Extraction" "Library" identref (* extraction plugin *) | "Extraction" "Language" language (* extraction plugin *) | "Extraction" "Inline" LIST1 global (* extraction plugin *) | "Extraction" "NoInline" LIST1 global (* extraction plugin *) | "Print" "Extraction" "Inline" (* extraction plugin *) | "Reset" "Extraction" "Inline" (* extraction plugin *) | "Extraction" "Implicit" global "[" LIST0 int_or_id "]" (* extraction plugin *) | "Extraction" "Blacklist" LIST1 preident (* extraction plugin *) | "Print" "Extraction" "Blacklist" (* extraction plugin *) | "Reset" "Extraction" "Blacklist" (* extraction plugin *) | "Extract" "Callback" OPT string global (* extraction plugin *) | "Print" "Extraction" "Callback" (* extraction plugin *) | "Reset" "Extraction" "Callback" (* extraction plugin *) | "Print" "Extraction" "Foreign" (* extraction plugin *) | "Extract" "Constant" global LIST0 string "=>" mlname (* extraction plugin *) | "Extract" "Foreign" "Constant" global "=>" string (* extraction plugin *) | "Extract" "Inlined" "Constant" global "=>" mlname (* extraction plugin *) | "Extract" "Inductive" global "=>" mlname "[" LIST0 mlname "]" OPT string (* extraction plugin *) | "Show" "Extraction" (* extraction plugin *) | "Set" "Firstorder" "Solver" tactic | "Print" "Firstorder" "Solver" | "Function" LIST1 function_fix_definition SEP "with" (* funind plugin *) | "Functional" "Scheme" LIST1 fun_scheme_arg SEP "with" (* funind plugin *) | "Functional" "Case" fun_scheme_arg (* funind plugin *) | "Generate" "graph" "for" reference (* funind plugin *) | "Hint" "Rewrite" orient LIST1 constr ":" LIST0 preident | "Hint" "Rewrite" orient LIST1 constr "using" tactic ":" LIST0 preident | "Hint" "Rewrite" orient LIST1 constr | "Hint" "Rewrite" orient LIST1 constr "using" tactic | "Derive" "Inversion_clear" ident "with" constr "Sort" sort_family | "Derive" "Inversion_clear" ident "with" constr | "Derive" "Inversion" ident "with" constr "Sort" sort_family | "Derive" "Inversion" ident "with" constr | "Derive" "Dependent" "Inversion" ident "with" constr "Sort" sort_family | "Derive" "Dependent" "Inversion_clear" ident "with" constr "Sort" sort_family | "Declare" "Left" "Step" constr | "Declare" "Right" "Step" constr | "Unshelve" | "Declare" "Equivalent" "Keys" constr constr | "Print" "Equivalent" "Keys" | "Optimize" "Proof" | "Optimize" "Heap" | "infoH" tactic | "Hint" "Cut" "[" hints_path "]" opthints | "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 "with" Pltac.tactic | "Tactic" "Notation" OPT ltac_tactic_level LIST1 ltac_production_item ":=" tactic | "Print" "Ltac" reference | "Locate" "Ltac" reference | "Ltac" LIST1 ltac_tacdef_body SEP "with" | "Print" "Ltac" "Signatures" | "Obligation" natural "of" identref ":" lglob withtac | "Obligation" natural "of" identref withtac | "Obligation" natural ":" lglob withtac | "Obligation" natural withtac | "Next" "Obligation" "of" identref withtac | "Next" "Obligation" withtac | "Final" "Obligation" "of" identref withtac | "Final" "Obligation" withtac | "Solve" "Obligations" "of" identref "with" tactic | "Solve" "Obligations" "of" identref | "Solve" "Obligations" "with" tactic | "Solve" "Obligations" | "Solve" "All" "Obligations" "with" tactic | "Solve" "All" "Obligations" | "Admit" "Obligations" "of" identref | "Admit" "Obligations" | "Obligation" "Tactic" ":=" tactic | "Show" "Obligation" "Tactic" | "Obligations" "of" identref | "Obligations" | "Preterm" "of" identref | "Preterm" | "Add" "Relation" constr constr "reflexivity" "proved" "by" constr "symmetry" "proved" "by" constr "as" identref | "Add" "Relation" constr constr "reflexivity" "proved" "by" constr "as" identref | "Add" "Relation" constr constr "as" identref | "Add" "Relation" constr constr "symmetry" "proved" "by" constr "as" identref | "Add" "Relation" constr constr "symmetry" "proved" "by" constr "transitivity" "proved" "by" constr "as" identref | "Add" "Relation" constr constr "reflexivity" "proved" "by" constr "transitivity" "proved" "by" constr "as" identref | "Add" "Relation" constr constr "reflexivity" "proved" "by" constr "symmetry" "proved" "by" constr "transitivity" "proved" "by" constr "as" identref | "Add" "Relation" constr constr "transitivity" "proved" "by" constr "as" identref | "Add" "Parametric" "Relation" binders ":" constr constr "reflexivity" "proved" "by" constr "symmetry" "proved" "by" constr "as" identref | "Add" "Parametric" "Relation" binders ":" constr constr "reflexivity" "proved" "by" constr "as" identref | "Add" "Parametric" "Relation" binders ":" constr constr "as" identref | "Add" "Parametric" "Relation" binders ":" constr constr "symmetry" "proved" "by" constr "as" identref | "Add" "Parametric" "Relation" binders ":" constr constr "symmetry" "proved" "by" constr "transitivity" "proved" "by" constr "as" identref | "Add" "Parametric" "Relation" binders ":" constr constr "reflexivity" "proved" "by" constr "transitivity" "proved" "by" constr "as" identref | "Add" "Parametric" "Relation" binders ":" constr constr "reflexivity" "proved" "by" constr "symmetry" "proved" "by" constr "transitivity" "proved" "by" constr "as" identref | "Add" "Parametric" "Relation" binders ":" constr constr "transitivity" "proved" "by" constr "as" identref | "Add" "Setoid" constr constr constr "as" identref | "Add" "Parametric" "Setoid" binders ":" constr constr constr "as" identref | "Add" "Morphism" constr ":" identref | "Declare" "Morphism" constr ":" identref | "Add" "Morphism" constr "with" "signature" lconstr "as" identref | "Add" "Parametric" "Morphism" binders ":" constr "with" "signature" lconstr "as" identref | "Print" "Rewrite" "HintDb" preident | "Reset" "Ltac" "Profile" | "Show" "Ltac" "Profile" | "Show" "Ltac" "Profile" "CutOff" integer | "Show" "Ltac" "Profile" string | "Show" "Lia" "Profile" (* micromega plugin *) | "Add" "Zify" "InjTyp" reference (* micromega plugin *) | "Add" "Zify" "BinOp" reference (* micromega plugin *) | "Add" "Zify" "UnOp" reference (* micromega plugin *) | "Add" "Zify" "CstOp" reference (* micromega plugin *) | "Add" "Zify" "BinRel" reference (* micromega plugin *) | "Add" "Zify" "PropOp" reference (* micromega plugin *) | "Add" "Zify" "PropBinOp" reference (* micromega plugin *) | "Add" "Zify" "PropUOp" reference (* micromega plugin *) | "Add" "Zify" "BinOpSpec" reference (* micromega plugin *) | "Add" "Zify" "UnOpSpec" reference (* micromega plugin *) | "Add" "Zify" "Saturate" reference (* 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 *) | "Add" "Ring" identref ":" constr OPT ring_mods (* ring plugin *) | "Print" "Rings" (* ring plugin *) | "Add" "Field" identref ":" constr OPT field_mods (* ring plugin *) | "Print" "Fields" (* ring plugin *) | "Number" "Notation" reference reference reference OPT number_options ":" preident | "String" "Notation" reference reference reference OPT string_option ":" preident | "Ltac2" ltac2_entry (* ltac2 plugin *) | "Ltac2" "Notation" ltac2def_syn (* ltac2 plugin *) | "Ltac2" "Eval" ltac2_expr6 (* ltac2 plugin *) | "Print" "Ltac2" reference (* ltac2 plugin *) | "Print" "Ltac2" "Type" reference (* ltac2 plugin *) | "Locate" "Ltac2" reference (* ltac2 plugin *) | "Print" "Ltac2" "Signatures" (* ltac2 plugin *) | "Ltac2" "Check" ltac2_expr6 (* ltac2 plugin *) | "Ltac2" "Globalize" ltac2_expr6 (* ltac2 plugin *) ] reference_or_constr: [ | global | constr ] hint: [ | "Resolve" LIST1 reference_or_constr hint_info | "Resolve" "->" LIST1 global OPT natural | "Resolve" "<-" LIST1 global OPT natural | "Immediate" LIST1 reference_or_constr | "Variables" "Transparent" | "Variables" "Opaque" | "Constants" "Transparent" | "Constants" "Opaque" | "Projections" "Transparent" | "Projections" "Opaque" | "Transparent" LIST1 global | "Opaque" LIST1 global | "Mode" global mode | "Unfold" LIST1 global | "Constructors" LIST1 global | "Extern" natural OPT Constr.constr_pattern "=>" Pltac.tactic ] constr_body: [ | ":=" lconstr | ":" lconstr ":=" lconstr ] mode: [ | LIST1 [ "+" | "!" | "-" ] ] int_or_var: [ | integer | identref ] nat_or_var: [ | natural | identref ] occs_nums: [ | LIST1 nat_or_var | "-" LIST1 nat_or_var ] occs: [ | "at" occs_nums | ] pattern_occ: [ | constr occs ] ref_or_pattern_occ: [ | smart_global occs | constr occs ] unfold_occ: [ | smart_global occs ] red_flag: [ | "beta" | "iota" | "match" | "fix" | "cofix" | "zeta" | "delta" delta_flag | "head" ] delta_flag: [ | "-" "[" LIST1 smart_global "]" | "[" LIST1 smart_global "]" | ] strategy_flag: [ | LIST1 red_flag | OPT "head" delta_flag ] red_expr: [ | "red" | "hnf" | "simpl" OPT "head" delta_flag OPT ref_or_pattern_occ | "cbv" strategy_flag | "cbn" strategy_flag | "lazy" strategy_flag | "compute" delta_flag | "vm_compute" OPT ref_or_pattern_occ | "native_compute" OPT ref_or_pattern_occ | "unfold" LIST1 unfold_occ SEP "," | "fold" LIST1 constr | "pattern" LIST1 pattern_occ SEP "," | IDENT ] vernac_control: [ | "Time" vernac_control | "Instructions" vernac_control | "Redirect" ne_string vernac_control | "Timeout" natural vernac_control | "Fail" vernac_control | "Succeed" vernac_control | decorated_vernac ] decorated_vernac: [ | quoted_attributes vernac ] quoted_attributes: [ | LIST0 [ "#[" attribute_list "]" ] ] attribute_list: [ | LIST1 attribute SEP "," ] attribute: [ | ident attr_value | "using" attr_value ] attr_value: [ | "=" string | "=" IDENT | "(" attribute_list ")" | ] legacy_attr: [ | "Local" | "Global" | "Polymorphic" | "Monomorphic" | "Cumulative" | "NonCumulative" | "Private" | "Program" ] vernac: [ | LIST0 legacy_attr vernac_aux ] vernac_aux: [ | gallina "." | gallina_ext "." | command "." | syntax "." | command_entry ] noedit_mode: [ | query_command ] subprf: [ | BULLET | "}" ] subprf_with_selector: [ | "{" | query_command ] gallina: [ | thm_token ident_decl binders ":" lconstr LIST0 [ "with" ident_decl binders ":" lconstr ] | assumption_token inline assum_list | assumptions_token inline assum_list | def_token ident_decl def_body | "Symbol" assum_list | "Symbols" assum_list | "Let" ident_decl def_body | finite_token inductive_or_record_definition | inductive_token LIST1 inductive_or_record_definition SEP "with" | "Fixpoint" LIST1 fix_definition SEP "with" | "Let" "Fixpoint" LIST1 fix_definition SEP "with" | "CoFixpoint" LIST1 cofix_definition SEP "with" | "Let" "CoFixpoint" LIST1 cofix_definition SEP "with" | "Scheme" LIST1 scheme SEP "with" | "Scheme" "Equality" "for" smart_global | "Scheme" "Boolean" "Equality" "for" smart_global | "Combined" "Scheme" identref "from" LIST1 identref SEP "," | "Register" global "as" qualid | "Register" "Scheme" global "as" qualid "for" global | "Register" "Inline" global | "Primitive" ident_decl OPT [ ":" lconstr ] ":=" register_token | "Universe" LIST1 identref | "Universes" LIST1 identref | "Constraint" LIST1 univ_constraint SEP "," | "Rewrite" "Rule" identref ":=" OPT "|" LIST1 rewrite_rule SEP "|" | "Rewrite" "Rules" identref ":=" OPT "|" LIST1 rewrite_rule SEP "|" ] register_token: [ | test_hash_ident "#" IDENT ] thm_token: [ | "Theorem" | "Lemma" | "Fact" | "Remark" | "Corollary" | "Proposition" | "Property" ] def_token: [ | "Definition" | "Example" | "SubClass" ] assumption_token: [ | "Hypothesis" | "Variable" | "Axiom" | "Parameter" | "Conjecture" ] assumptions_token: [ | "Hypotheses" | "Variables" | "Axioms" | "Parameters" | "Conjectures" ] inline: [ | "Inline" "(" natural ")" | "Inline" | ] univ_constraint: [ | universe_name [ "<" | "=" | "<=" ] universe_name ] univ_decl_constraints: [ | "|" LIST0 univ_constraint SEP "," [ "+" | ] "}" | [ "}" | bar_cbrace ] ] univ_decl: [ | "@{" test_univ_decl LIST0 identref "|" LIST0 identref [ "+" | ] univ_decl_constraints | "@{" LIST0 identref [ "+" | ] univ_decl_constraints ] variance: [ | "+" | "=" | "*" ] variance_identref: [ | identref | test_variance_ident variance identref ] cumul_univ_decl: [ | "@{" test_cumul_univ_decl LIST0 identref "|" LIST0 variance_identref [ "+" | ] univ_decl_constraints | "@{" LIST0 variance_identref [ "+" | ] univ_decl_constraints ] ident_decl: [ | identref OPT univ_decl ] cumul_ident_decl: [ | identref OPT cumul_univ_decl ] inductive_token: [ | "Inductive" | "CoInductive" ] finite_token: [ | "Variant" | "Record" | "Structure" | "Class" ] def_body: [ | binders ":=" reduce lconstr | binders ":" lconstr ":=" reduce lconstr | binders ":" lconstr ] reduce: [ | "Eval" red_expr "in" | ] notation_declaration: [ | lstring ":=" constr syntax_modifiers OPT [ ":" IDENT ] ] decl_sep: [ | "and" ] decl_notations: [ | "where" LIST1 notation_declaration SEP decl_sep | ] opt_constructors_or_fields: [ | ":=" constructors_or_record | ":=" | ] inductive_or_record_definition: [ | opt_coercion cumul_ident_decl binders OPT [ "|" binders ] OPT [ ":" lconstr ] opt_constructors_or_fields decl_notations ] constructors_or_record: [ | "|" LIST1 constructor SEP "|" | quoted_attributes identref constructor_type "|" LIST1 constructor SEP "|" | quoted_attributes identref constructor_type | quoted_attributes identref "{" record_fields "}" default_inhabitant_ident | "{" record_fields "}" default_inhabitant_ident ] default_inhabitant_ident: [ | "as" identref | ] opt_coercion: [ | ">" | ] fix_definition: [ | ident_decl binders_fixannot type_cstr OPT [ ":=" lconstr ] decl_notations ] cofix_definition: [ | ident_decl binders type_cstr OPT [ ":=" lconstr ] decl_notations ] rw_pattern: [ | lconstr ] rewrite_rule: [ | OPT [ univ_decl "|-" ] rw_pattern "=>" lconstr ] scheme: [ | scheme_kind | identref ":=" scheme_kind ] scheme_kind: [ | scheme_type "for" smart_global "Sort" sort_family ] scheme_type: [ | "Induction" | "Minimality" | "Elimination" | "Case" ] record_field: [ | quoted_attributes record_binder OPT [ "|" natural ] decl_notations ] record_fields: [ | record_field ";" record_fields | record_field | ] field_body: [ | binders of_type_inst lconstr | binders of_type_inst lconstr ":=" lconstr | binders ":=" lconstr ] record_binder: [ | name | name field_body ] assum_list: [ | LIST1 assum_coe | assumpt ] assum_coe: [ | "(" assumpt ")" ] assumpt: [ | LIST1 ident_decl of_type lconstr ] constructor_type: [ | binders [ of_type_inst lconstr | ] ] constructor: [ | quoted_attributes identref constructor_type ] of_type: [ | ":>" | ":" ">" | ":" ] of_type_inst: [ | ":>" | ":" ">" | "::" | "::>" | ":" ] gallina_ext: [ | "Module" export_token identref LIST0 module_binder of_module_type is_module_expr | "Module" "Type" identref LIST0 module_binder check_module_types is_module_type | "Declare" "Module" export_token identref LIST0 module_binder ":" module_type_inl | "Section" identref | "End" identref | "Collection" identref ":=" section_subset_expr | "From" global "Extra" "Dependency" ne_string OPT [ "as" IDENT ] | "Require" export_token LIST1 filtered_import | "From" global "Require" export_token LIST1 filtered_import | "Import" OPT import_categories LIST1 filtered_import | "Export" OPT import_categories LIST1 filtered_import | "Include" module_type_inl LIST0 ext_module_type | "Include" "Type" module_type_inl LIST0 ext_module_type | "Transparent" OPT "!" LIST1 smart_global | "Opaque" OPT "!" LIST1 smart_global | "Strategy" LIST1 [ strategy_level "[" LIST1 smart_global "]" ] | "Canonical" OPT "Structure" global OPT [ OPT univ_decl def_body ] | "Canonical" OPT "Structure" by_notation | "Coercion" global OPT [ OPT univ_decl def_body ] | "Identity" "Coercion" identref ":" coercion_class ">->" coercion_class | "Coercion" global ":" coercion_class ">->" coercion_class | "Coercion" by_notation ":" coercion_class ">->" coercion_class | "Context" LIST1 binder | "Instance" instance_name ":" term200 hint_info [ ":=" "{" record_declaration "}" | ":=" lconstr | ] | "Existing" "Instance" global hint_info | "Existing" "Instances" LIST1 global OPT [ "|" natural ] | "Existing" "Class" global | "Arguments" smart_global LIST0 arg_specs OPT [ "," LIST1 [ LIST0 implicits_alt ] SEP "," ] OPT [ ":" LIST1 args_modifier SEP "," ] | "Implicit" "Type" reserv_list | "Implicit" "Types" reserv_list | "Generalizable" [ "All" "Variables" | "No" "Variables" | [ "Variable" | "Variables" ] LIST1 identref ] | "Export" "Set" setting_name option_setting | "Export" "Unset" setting_name ] import_categories: [ | OPT "-" "(" LIST1 qualid SEP "," ")" ] filtered_import: [ | global | global "(" LIST1 one_import_filter_name SEP "," ")" ] one_import_filter_name: [ | global OPT [ "(" ".." ")" ] ] export_token: [ | "Import" OPT import_categories | "Export" OPT import_categories | ] ext_module_type: [ | "<+" module_type_inl ] ext_module_expr: [ | "<+" module_expr_inl ] check_module_type: [ | "<:" module_type_inl ] check_module_types: [ | LIST0 check_module_type ] of_module_type: [ | ":" module_type_inl | check_module_types ] is_module_type: [ | ":=" module_type_inl LIST0 ext_module_type | ] is_module_expr: [ | ":=" module_expr_inl LIST0 ext_module_expr | ] functor_app_annot: [ | "[" "inline" "at" "level" natural "]" | "[" "no" "inline" "]" | ] module_expr_inl: [ | "!" module_expr | module_expr functor_app_annot ] module_type_inl: [ | "!" module_type | module_type functor_app_annot ] module_binder: [ | "(" export_token LIST1 identref ":" module_type_inl ")" ] module_expr: [ | module_expr_atom | module_expr module_expr_atom ] module_expr_atom: [ | qualid | "(" module_expr_atom ")" ] with_declaration: [ | "Definition" fullyqualid OPT univ_decl ":=" Constr.lconstr | "Module" fullyqualid ":=" qualid ] module_type: [ | qualid | "(" module_type ")" | module_type module_expr_atom | module_type "with" with_declaration ] section_subset_expr: [ | test_only_starredidentrefs LIST0 starredidentref | ssexpr35 ] starredidentref: [ | identref | identref "*" | "Type" | "Type" "*" ] ssexpr35: [ | "-" ssexpr50 | ssexpr50 ] ssexpr50: [ | ssexpr0 "-" ssexpr0 | ssexpr0 "+" ssexpr0 | ssexpr0 ] ssexpr0: [ | starredidentref | "()" | "(" test_only_starredidentrefs LIST0 starredidentref ")" | "(" test_only_starredidentrefs LIST0 starredidentref ")" "*" | "(" ssexpr35 ")" | "(" ssexpr35 ")" "*" ] args_modifier: [ | "simpl" "nomatch" | "simpl" "never" | "default" "implicits" | "clear" "implicits" | "clear" "scopes" | "clear" "bidirectionality" "hint" | "rename" | "assert" | "extra" "scopes" | "clear" "scopes" "and" "implicits" | "clear" "implicits" "and" "scopes" ] scope_delimiter: [ | "%" IDENT | "%_" IDENT ] argument_spec: [ | OPT "!" name LIST0 scope_delimiter ] arg_specs: [ | argument_spec | "/" | "&" | "(" LIST1 argument_spec ")" LIST0 scope_delimiter | "[" LIST1 argument_spec "]" LIST0 scope_delimiter | "{" LIST1 argument_spec "}" LIST0 scope_delimiter ] implicits_alt: [ | name | "[" LIST1 name "]" | "{" LIST1 name "}" ] instance_name: [ | ident_decl binders | ] hint_info: [ | "|" OPT natural OPT constr_pattern | ] reserv_list: [ | LIST1 reserv_tuple | simple_reserv ] reserv_tuple: [ | "(" simple_reserv ")" ] simple_reserv: [ | LIST1 identref ":" lconstr ] range_selector: [ | natural "-" natural | natural ] range_selector_or_nth: [ | natural "-" natural OPT [ "," LIST1 range_selector SEP "," ] | natural OPT [ "," LIST1 range_selector SEP "," ] ] goal_selector: [ | range_selector_or_nth | test_bracket_ident "[" ident "]" ] toplevel_selector: [ | goal_selector ":" | "!" ":" | "all" ":" ] query_command: [ | "Eval" red_expr "in" lconstr "." | "Compute" lconstr "." | "Check" lconstr "." | "About" smart_global OPT univ_name_list "." | "SearchPattern" constr_pattern in_or_out_modules "." | "SearchRewrite" constr_pattern in_or_out_modules "." | "Search" search_query search_queries "." ] printable: [ | "Term" smart_global OPT univ_name_list | "All" | "Section" global | "Grammar" LIST0 IDENT | "Custom" "Grammar" IDENT | "Keywords" | "LoadPath" OPT dirpath | "Libraries" | "Notation" string | "Notation" string "in" "custom" IDENT | "ML" "Path" | "ML" "Modules" | "Debug" "GC" | "Graph" | "Classes" | "Typeclasses" | "Instances" smart_global | "Coercions" | "Coercion" "Paths" coercion_class coercion_class | "Canonical" "Projections" LIST0 smart_global | "Typing" "Flags" | "Tables" | "Options" | "Hint" | "Hint" smart_global | "Hint" "*" | "HintDb" IDENT | "Scopes" | "Scope" IDENT | "Visibility" OPT IDENT | "Implicit" smart_global | [ "Sorted" | ] "Universes" OPT printunivs_subgraph OPT ne_string | "Assumptions" smart_global | "Opaque" "Dependencies" smart_global | "Transparent" "Dependencies" smart_global | "All" "Dependencies" smart_global | "Strategy" smart_global | "Strategies" | "Registered" | "Registered" "Schemes" ] printunivs_subgraph: [ | "Subgraph" "(" LIST0 reference ")" ] coercion_class: [ | "Funclass" | "Sortclass" | smart_global ] locatable: [ | smart_global | "Term" smart_global | "File" ne_string | "Library" global | "Module" global ] option_setting: [ | | integer | STRING ] table_value: [ | global | STRING ] setting_name: [ | LIST1 IDENT ] ne_in_or_out_modules: [ | "inside" LIST1 global | "in" LIST1 global | "outside" LIST1 global ] in_or_out_modules: [ | ne_in_or_out_modules | ] comment: [ | constr | STRING | natural ] positive_search_mark: [ | "-" | ] search_query: [ | positive_search_mark search_item | positive_search_mark "[" LIST1 ( LIST1 search_query ) SEP "|" "]" ] search_item: [ | test_id_colon search_where ":" ne_string OPT scope_delimiter | "is" ":" logical_kind | ne_string OPT scope_delimiter | test_id_colon search_where ":" constr_pattern | constr_pattern ] logical_kind: [ | thm_token | assumption_token | "Context" | extended_def_token | "Primitive" | "Symbol" ] extended_def_token: [ | def_token | "Coercion" | "Fixpoint" | "CoFixpoint" | "Instance" | "Scheme" | "Canonical" | "Field" | "Method" ] search_where: [ | "head" | "hyp" | "concl" | "headhyp" | "headconcl" ] search_queries: [ | ne_in_or_out_modules | search_query search_queries | ] univ_name_list: [ | "@{" LIST0 name "}" ] syntax: [ | "Open" "Scope" IDENT | "Close" "Scope" IDENT | "Delimit" "Scope" IDENT; "with" IDENT | "Undelimit" "Scope" IDENT | "Bind" "Scope" IDENT; "with" LIST1 coercion_class | "Infix" notation_declaration | "Notation" identref LIST0 ident ":=" constr syntax_modifiers | "Notation" notation_declaration | "Reserved" "Infix" ne_lstring syntax_modifiers | "Reserved" "Notation" ne_lstring syntax_modifiers | enable_enable_disable "Notation" enable_notation_rule enable_notation_interpretation enable_notation_flags opt_scope ] enable_enable_disable: [ | "Enable" | "Disable" ] enable_notation_rule: [ | ne_string | global LIST0 ident | ] enable_notation_interpretation: [ | ":=" constr | ] enable_notation_flags: [ | "(" LIST1 enable_notation_flag SEP "," ")" | ] enable_notation_flag: [ | "all" | "only" "parsing" | "only" "printing" | "in" "custom" identref | "in" "constr" ] opt_scope: [ | ":" IDENT | ":" "no" "scope" | ] level: [ | "level" natural | "next" "level" ] syntax_modifier: [ | "at" "level" natural | "in" "custom" IDENT | "in" "custom" IDENT; "at" "level" natural | "left" "associativity" | "right" "associativity" | "no" "associativity" | "only" "printing" | "only" "parsing" | "format" lstring | IDENT; "," LIST1 IDENT SEP "," [ "at" level | "in" "scope" IDENT ] | IDENT; "at" level OPT binder_interp | IDENT; "in" "scope" IDENT | IDENT binder_interp | IDENT explicit_subentry ] syntax_modifiers: [ | "(" LIST1 syntax_modifier SEP "," ")" | ] explicit_subentry: [ | "ident" | "name" | "global" | "bigint" | "binder" | "constr" | "constr" at_level_opt OPT binder_interp | "pattern" | "pattern" "at" "level" natural | "strict" "pattern" | "strict" "pattern" "at" "level" natural | "closed" "binder" | "custom" IDENT at_level_opt OPT binder_interp ] at_level_opt: [ | "at" level | ] binder_interp: [ | "as" "ident" | "as" "name" | "as" "pattern" | "as" "strict" "pattern" ] simple_tactic: [ | "btauto" | "congruence" OPT natural | "congruence" OPT natural "with" LIST1 constr | "simple" "congruence" OPT natural | "simple" "congruence" OPT natural "with" LIST1 constr | "f_equal" | "firstorder" OPT tactic firstorder_using | "firstorder" OPT tactic "with" LIST1 preident | "firstorder" OPT tactic firstorder_using "with" LIST1 preident | "gintuition" OPT tactic | "functional" "inversion" quantified_hypothesis OPT reference (* funind plugin *) | "functional" "induction" lconstr fun_ind_using with_names (* funind plugin *) | "soft" "functional" "induction" LIST1 constr fun_ind_using with_names (* funind plugin *) | "reflexivity" | "exact" uconstr | "assumption" | "etransitivity" | "cut" constr | "exact_no_check" constr | "vm_cast_no_check" constr | "native_cast_no_check" constr | "exfalso" | "lapply" constr | "transitivity" constr | "left" | "eleft" | "left" "with" bindings | "eleft" "with" bindings | "right" | "eright" | "right" "with" bindings | "eright" "with" bindings | "constructor" | "constructor" nat_or_var | "constructor" nat_or_var "with" bindings | "econstructor" | "econstructor" nat_or_var | "econstructor" nat_or_var "with" bindings | "specialize" constr_with_bindings | "specialize" constr_with_bindings "as" simple_intropattern | "symmetry" | "symmetry" "in" in_clause | "split" | "esplit" | "split" "with" bindings | "esplit" "with" bindings | "exists" | "exists" LIST1 bindings SEP "," | "eexists" | "eexists" LIST1 bindings SEP "," | "intros" "until" quantified_hypothesis | "intro" | "intro" ident | "intro" ident "at" "top" | "intro" ident "at" "bottom" | "intro" ident "after" hyp | "intro" ident "before" hyp | "intro" "at" "top" | "intro" "at" "bottom" | "intro" "after" hyp | "intro" "before" hyp | "move" hyp "at" "top" | "move" hyp "at" "bottom" | "move" hyp "after" hyp | "move" hyp "before" hyp | "rename" LIST1 rename SEP "," | "revert" LIST1 hyp | "simple" "induction" quantified_hypothesis | "simple" "destruct" quantified_hypothesis | "admit" | "fix" ident natural | "cofix" ident | "clear" LIST0 hyp | "clear" "-" LIST1 hyp | "clearbody" LIST1 hyp | "generalize" "dependent" constr | "assert_succeeds" tactic3 | "replace" uconstr "with" constr clause by_arg_tac | "replace" "->" uconstr clause | "replace" "->" uconstr "with" constr clause by_arg_tac | "replace" "<-" uconstr clause | "replace" "<-" uconstr "with" constr clause by_arg_tac | "replace" uconstr clause | "simplify_eq" | "simplify_eq" destruction_arg | "esimplify_eq" | "esimplify_eq" destruction_arg | "discriminate" | "discriminate" destruction_arg | "ediscriminate" | "ediscriminate" destruction_arg | "injection" | "injection" destruction_arg | "einjection" | "einjection" destruction_arg | "injection" "as" LIST0 simple_intropattern | "injection" destruction_arg "as" LIST0 simple_intropattern | "einjection" "as" LIST0 simple_intropattern | "einjection" destruction_arg "as" LIST0 simple_intropattern | "simple" "injection" | "simple" "injection" destruction_arg | "dependent" "rewrite" orient constr | "dependent" "rewrite" orient constr "in" hyp | "decompose" "sum" constr | "decompose" "record" constr | "absurd" constr | "contradiction" OPT constr_with_bindings | "autorewrite" "with" LIST1 preident clause | "autorewrite" "with" LIST1 preident clause "using" tactic | "autorewrite" "*" "with" LIST1 preident clause | "autorewrite" "*" "with" LIST1 preident clause "using" tactic | "rewrite" "*" orient uconstr "in" hyp "at" occurrences by_arg_tac | "rewrite" "*" orient uconstr "at" occurrences "in" hyp by_arg_tac | "rewrite" "*" orient uconstr "in" hyp by_arg_tac | "rewrite" "*" orient uconstr "at" occurrences by_arg_tac | "rewrite" "*" orient uconstr by_arg_tac | "refine" uconstr | "simple" "refine" uconstr | "notypeclasses" "refine" uconstr | "simple" "notypeclasses" "refine" uconstr | "solve_constraints" | "subst" LIST1 hyp | "subst" | "simple" "subst" | "evar" test_lpar_id_colon "(" ident ":" lconstr ")" | "evar" constr | "instantiate" "(" ident ":=" lglob ")" | "instantiate" "(" natural ":=" lglob ")" hloc | "stepl" constr "by" tactic | "stepl" constr | "stepr" constr "by" tactic | "stepr" constr | "generalize_eqs" hyp | "dependent" "generalize_eqs" hyp | "generalize_eqs_vars" hyp | "dependent" "generalize_eqs_vars" hyp | "specialize_eqs" hyp | "destauto" | "destauto" "in" hyp | "transparent_abstract" tactic3 | "transparent_abstract" tactic3 "using" ident | "constr_eq" constr constr | "constr_eq_strict" constr constr | "constr_eq_nounivs" constr constr | "is_evar" constr | "has_evar" constr | "is_var" constr | "is_fix" constr | "is_cofix" constr | "is_ind" constr | "is_constructor" constr | "is_proj" constr | "is_const" constr | "shelve" | "shelve_unifiable" | "unshelve" tactic1 | "give_up" | "cycle" int_or_var | "swap" int_or_var int_or_var | "revgoals" | "guard" test | "decompose" "[" LIST1 constr "]" constr | "optimize_heap" | "with_strategy" strategy_level_or_var "[" LIST1 smart_global "]" tactic3 | "eassumption" | "eexact" constr | "trivial" auto_using hintbases | "info_trivial" auto_using hintbases | "debug" "trivial" auto_using hintbases | "auto" OPT nat_or_var auto_using hintbases | "info_auto" OPT nat_or_var auto_using hintbases | "debug" "auto" OPT nat_or_var auto_using hintbases | "eauto" OPT nat_or_var auto_using hintbases | "debug" "eauto" OPT nat_or_var auto_using hintbases | "info_eauto" OPT nat_or_var auto_using hintbases | "dfs" "eauto" OPT nat_or_var auto_using hintbases | "autounfold" hintbases clause_dft_concl | "autounfold_one" hintbases "in" hyp | "autounfold_one" hintbases | "unify" constr constr | "unify" constr constr "with" preident | "convert" constr constr | "typeclasses" "eauto" "dfs" OPT nat_or_var "with" LIST1 preident | "typeclasses" "eauto" "bfs" OPT nat_or_var "with" LIST1 preident | "typeclasses" "eauto" "best_effort" OPT nat_or_var "with" LIST1 preident | "typeclasses" "eauto" OPT nat_or_var "with" LIST1 preident | "typeclasses" "eauto" "bfs" OPT nat_or_var | "typeclasses" "eauto" "dfs" OPT nat_or_var | "typeclasses" "eauto" "best_effort" OPT nat_or_var | "typeclasses" "eauto" OPT nat_or_var | "head_of_constr" ident constr | "not_evar" constr | "is_ground" constr | "autoapply" constr "with" preident | "decide" "equality" | "compare" constr constr | "rewrite_strat" rewstrategy "in" hyp | "rewrite_strat" rewstrategy | "rewrite_db" preident "in" hyp | "rewrite_db" preident | "substitute" orient glob_constr_with_bindings | "setoid_rewrite" orient glob_constr_with_bindings | "setoid_rewrite" orient glob_constr_with_bindings "in" hyp | "setoid_rewrite" orient glob_constr_with_bindings "at" occurrences | "setoid_rewrite" orient glob_constr_with_bindings "at" occurrences "in" hyp | "setoid_rewrite" orient glob_constr_with_bindings "in" hyp "at" occurrences | "setoid_symmetry" | "setoid_symmetry" "in" hyp | "setoid_reflexivity" | "setoid_transitivity" constr | "setoid_etransitivity" | "intros" ne_intropatterns | "intros" | "eintros" ne_intropatterns | "eintros" | "apply" LIST1 constr_with_bindings_arg SEP "," in_hyp_as | "eapply" LIST1 constr_with_bindings_arg SEP "," in_hyp_as | "simple" "apply" LIST1 constr_with_bindings_arg SEP "," in_hyp_as | "simple" "eapply" LIST1 constr_with_bindings_arg SEP "," in_hyp_as | "elim" constr_with_bindings_arg OPT eliminator | "eelim" constr_with_bindings_arg OPT eliminator | "case" induction_clause_list | "ecase" induction_clause_list | "fix" ident natural "with" LIST1 fixdecl | "cofix" ident "with" LIST1 cofixdecl | "pose" bindings_with_parameters | "pose" constr as_name | "epose" bindings_with_parameters | "epose" constr as_name | "set" bindings_with_parameters clause_dft_concl | "set" constr as_name clause_dft_concl | "eset" bindings_with_parameters clause_dft_concl | "eset" constr as_name clause_dft_concl | "remember" constr as_name eqn_ipat clause_dft_all | "eremember" constr as_name eqn_ipat clause_dft_all | "assert" test_lpar_id_coloneq "(" identref ":=" lconstr ")" | "eassert" test_lpar_id_coloneq "(" identref ":=" lconstr ")" | "assert" test_lpar_id_colon "(" identref ":" lconstr ")" by_tactic | "eassert" test_lpar_id_colon "(" identref ":" lconstr ")" by_tactic | "enough" test_lpar_id_colon "(" identref ":" lconstr ")" by_tactic | "eenough" test_lpar_id_colon "(" identref ":" lconstr ")" by_tactic | "assert" constr as_ipat by_tactic | "eassert" constr as_ipat by_tactic | "pose" "proof" test_lpar_id_coloneq "(" identref ":=" lconstr ")" | "epose" "proof" test_lpar_id_coloneq "(" identref ":=" lconstr ")" | "pose" "proof" lconstr as_ipat | "epose" "proof" lconstr as_ipat | "enough" constr as_ipat by_tactic | "eenough" constr as_ipat by_tactic | "generalize" constr | "generalize" constr LIST1 constr | "generalize" constr lookup_at_as_comma occs as_name LIST0 [ "," pattern_occ as_name ] | "induction" induction_clause_list | "einduction" induction_clause_list | "destruct" induction_clause_list | "edestruct" induction_clause_list | "rewrite" LIST1 oriented_rewriter SEP "," clause_dft_concl by_tactic | "erewrite" LIST1 oriented_rewriter SEP "," clause_dft_concl by_tactic | "dependent" [ "simple" "inversion" | "inversion" | "inversion_clear" ] quantified_hypothesis as_or_and_ipat OPT [ "with" constr ] | "simple" "inversion" quantified_hypothesis as_or_and_ipat in_hyp_list | "inversion" quantified_hypothesis as_or_and_ipat in_hyp_list | "inversion_clear" quantified_hypothesis as_or_and_ipat in_hyp_list | "inversion" quantified_hypothesis "using" constr in_hyp_list | "red" clause_dft_concl | "hnf" clause_dft_concl | "simpl" OPT "head" delta_flag OPT ref_or_pattern_occ clause_dft_concl | "cbv" strategy_flag clause_dft_concl | "cbn" strategy_flag clause_dft_concl | "lazy" strategy_flag clause_dft_concl | "compute" delta_flag clause_dft_concl | "vm_compute" OPT ref_or_pattern_occ clause_dft_concl | "native_compute" OPT ref_or_pattern_occ clause_dft_concl | "unfold" LIST1 unfold_occ SEP "," clause_dft_concl | "fold" LIST1 constr clause_dft_concl | "pattern" LIST1 pattern_occ SEP "," clause_dft_concl | "change" conversion clause_dft_concl | "change_no_check" conversion clause_dft_concl | "start" "ltac" "profiling" | "stop" "ltac" "profiling" | "reset" "ltac" "profile" | "show" "ltac" "profile" | "show" "ltac" "profile" "cutoff" integer | "show" "ltac" "profile" string | "restart_timer" OPT string | "finish_timing" OPT string | "finish_timing" "(" string ")" OPT string | "xlra_Q" tactic (* micromega plugin *) | "wlra_Q" ident constr (* micromega plugin *) | "xlra_R" tactic (* micromega plugin *) | "xlia" tactic (* micromega plugin *) | "wlia" ident constr (* micromega plugin *) | "xnra_Q" tactic (* micromega plugin *) | "wnra_Q" ident constr (* micromega plugin *) | "xnra_R" tactic (* micromega plugin *) | "xnia" tactic (* micromega plugin *) | "wnia" ident constr (* micromega plugin *) | "xsos_Z" tactic (* micromega plugin *) | "wsos_Z" ident constr (* micromega plugin *) | "xsos_Q" tactic (* micromega plugin *) | "wsos_Q" ident constr (* micromega plugin *) | "xsos_R" tactic (* micromega plugin *) | "xpsatz_Z" nat_or_var tactic (* micromega plugin *) | "wpsatz_Z" nat_or_var ident constr (* micromega plugin *) | "xpsatz_Q" nat_or_var tactic (* micromega plugin *) | "wpsatz_Q" nat_or_var ident constr (* micromega plugin *) | "xpsatz_R" nat_or_var tactic (* micromega plugin *) | "zify_iter_specs" (* micromega plugin *) | "zify_op" (* micromega plugin *) | "zify_saturate" (* micromega plugin *) | "zify_iter_let" tactic (* micromega plugin *) | "zify_elim_let" (* micromega plugin *) | "nsatz_compute" constr (* nsatz 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" ] mlname: [ | preident (* extraction plugin *) | string (* extraction plugin *) ] int_or_id: [ | preident (* extraction plugin *) | integer (* extraction plugin *) ] language: [ | "OCaml" (* extraction plugin *) | "Haskell" (* extraction plugin *) | "Scheme" (* extraction plugin *) | "JSON" (* extraction plugin *) ] firstorder_using: [ | "using" LIST1 reference SEP "," | ] fun_ind_using: [ | "using" constr_with_bindings (* funind plugin *) | (* funind plugin *) ] with_names: [ | "as" simple_intropattern (* funind plugin *) | (* funind plugin *) ] constr_comma_sequence': [ | constr "," constr_comma_sequence' (* funind plugin *) | constr (* funind plugin *) ] auto_using': [ | "using" constr_comma_sequence' (* funind plugin *) | (* funind plugin *) ] function_fix_definition: [ | Vernac.fix_definition (* funind plugin *) ] fun_scheme_arg: [ | identref ":=" "Induction" "for" reference "Sort" sort_family (* funind plugin *) ] orient: [ | "->" | "<-" | ] EXTRAARGS_natural: [ | _natural ] occurrences: [ | LIST1 integer | hyp ] glob: [ | constr ] EXTRAARGS_lconstr: [ | l_constr ] lglob: [ | EXTRAARGS_lconstr ] hloc: [ | | "in" "|-" "*" | "in" ident | "in" "(" "type" "of" ident ")" | "in" "(" "value" "of" ident ")" ] rename: [ | ident "into" ident ] by_arg_tac: [ | "by" tactic3 | ] in_clause: [ | in_clause' | "*" occs | "*" "|-" concl_occ | "|-" concl_occ | LIST1 hypident_occ SEP "," "|-" concl_occ | LIST1 hypident_occ SEP "," ] test_lpar_id_colon: [ | local_test_lpar_id_colon ] EXTRAARGS_strategy_level: [ | strategy_level0 ] strategy_level_or_var: [ | EXTRAARGS_strategy_level | identref ] comparison: [ | "=" | "<" | "<=" | ">" | ">=" ] test: [ | int_or_var comparison int_or_var ] hintbases: [ | "with" "*" | "with" LIST1 preident | ] auto_using: [ | "using" LIST1 uconstr SEP "," | ] hints_path: [ | "(" hints_path ")" | hints_path "*" | "emp" | "eps" | hints_path "|" hints_path | LIST1 global | "_" | hints_path hints_path ] opthints: [ | ":" LIST1 preident | ] debug: [ | "debug" | ] eauto_search_strategy_name: [ | "bfs" | "dfs" ] eauto_search_strategy: [ | "(" eauto_search_strategy_name ")" | ] tactic_then_last: [ | "|" LIST0 ( OPT ltac_expr5 ) SEP "|" | ] for_each_goal: [ | ltac_expr5 "|" for_each_goal | ltac_expr5 ".." tactic_then_last | ".." tactic_then_last | ltac_expr5 | "|" for_each_goal | ] tactic_then_locality: [ | "[" OPT ">" ] ltac_expr5: [ | ltac_expr4 ] ltac_expr4: [ | ltac_expr3 ";" ltac_expr3 | ltac_expr3 ";" tactic_then_locality for_each_goal "]" | ltac_expr3 ] ltac_expr3: [ | "try" ltac_expr3 | "do" nat_or_var ltac_expr3 | "timeout" nat_or_var ltac_expr3 | "time" OPT string ltac_expr3 | "repeat" ltac_expr3 | "progress" ltac_expr3 | "once" ltac_expr3 | "exactly_once" ltac_expr3 | "abstract" ltac_expr2 | "abstract" ltac_expr2 "using" ident | "only" goal_selector ":" ltac_expr3 | ltac_expr2 ] ltac_expr2: [ | ltac_expr1 "+" ltac_expr2 | "tryif" ltac_expr5 "then" ltac_expr5 "else" ltac_expr2 | ltac_expr1 "||" ltac_expr2 | ltac_expr1 ] ltac_expr1: [ | "fun" LIST1 input_fun "=>" ltac_expr5 | "let" [ "rec" | ] LIST1 let_clause SEP "with" "in" ltac_expr5 | match_key "goal" "with" match_context_list "end" | match_key "reverse" "goal" "with" match_context_list "end" | match_key ltac_expr5 "with" match_list "end" | "first" "[" LIST0 ltac_expr5 SEP "|" "]" | "solve" "[" LIST0 ltac_expr5 SEP "|" "]" | "idtac" LIST0 message_token | failkw [ nat_or_var | ] LIST0 message_token | simple_tactic | tactic_value | reference LIST0 tactic_arg | ltac_expr0 ] ltac_expr0: [ | "(" ltac_expr5 ")" | "[" ">" for_each_goal "]" | tactic_atom ] failkw: [ | "fail" | "gfail" ] tactic_arg: [ | tactic_value | Constr.constr | "()" ] tactic_value: [ | constr_eval | "fresh" LIST0 fresh_id | "type_term" uconstr | "numgoals" ] fresh_id: [ | STRING | qualid ] constr_eval: [ | "eval" red_expr "in" Constr.constr | "context" identref "[" Constr.lconstr "]" | "type" "of" Constr.constr ] constr_may_eval: [ | constr_eval | Constr.constr ] tactic_atom: [ | integer | reference | "()" ] match_key: [ | "match" | "lazymatch" | "multimatch" ] input_fun: [ | "_" | ident ] let_clause: [ | identref ":=" ltac_expr5 | "_" ":=" ltac_expr5 | identref LIST1 input_fun ":=" ltac_expr5 ] match_pattern: [ | "context" OPT Constr.ident "[" Constr.cpattern "]" | Constr.cpattern ] match_hyp: [ | name ":" match_pattern | name ":=" "[" match_pattern "]" ":" match_pattern | name ":=" match_pattern ] match_context_rule: [ | LIST0 match_hyp SEP "," "|-" match_pattern "=>" ltac_expr5 | "[" LIST0 match_hyp SEP "," "|-" match_pattern "]" "=>" ltac_expr5 | "_" "=>" ltac_expr5 ] match_context_list: [ | LIST1 match_context_rule SEP "|" | "|" LIST1 match_context_rule SEP "|" ] match_rule: [ | match_pattern "=>" ltac_expr5 | "_" "=>" ltac_expr5 ] match_list: [ | LIST1 match_rule SEP "|" | "|" LIST1 match_rule SEP "|" ] message_token: [ | identref | STRING | natural ] ltac_def_kind: [ | ":=" | "::=" ] tacdef_body: [ | Constr.global LIST1 input_fun ltac_def_kind ltac_expr5 | Constr.global ltac_def_kind ltac_expr5 ] tactic: [ | ltac_expr5 ] tactic_mode: [ | subprf | OPT toplevel_selector subprf_with_selector | OPT ltac_selector OPT ltac_info tactic ltac_use_default | "par" ":" OPT ltac_info tactic ltac_use_default ] ltac_selector: [ | toplevel_selector ] ltac_info: [ | "Info" natural ] ltac_use_default: [ | "." | "..." ] ltac_tactic_level: [ | "(" "at" "level" natural ")" ] ltac_production_sep: [ | "," string ] ltac_production_item: [ | string | ident "(" ident OPT ltac_production_sep ")" | ident ] ltac_tacdef_body: [ | tacdef_body ] withtac: [ | "with" Tactic.tactic | ] Constr.closed_binder: [ | "(" Prim.name ":" Constr.lconstr "|" Constr.lconstr ")" ] glob_constr_with_bindings: [ | constr_with_bindings ] rewstrategy: [ | "fix" identref ":=" rewstrategy1 | ne_rewstrategy1_list_sep_semicolon ] ne_rewstrategy1_list_sep_semicolon: [ | ne_rewstrategy1_list_sep_semicolon ";" rewstrategy1 | rewstrategy1 ] rewstrategy1: [ | "<-" constr | "subterms" rewstrategy1 | "subterm" rewstrategy1 | "innermost" rewstrategy1 | "outermost" rewstrategy1 | "bottomup" rewstrategy1 | "topdown" rewstrategy1 | "progress" rewstrategy1 | "try" rewstrategy1 | "any" rewstrategy1 | "repeat" rewstrategy1 | "choice" LIST1 rewstrategy0 | "old_hints" preident | "hints" preident | "terms" LIST0 constr | "eval" red_expr | "fold" constr | rewstrategy0 ] rewstrategy0: [ | constr | "id" | "fail" | "refl" | "(" rewstrategy ")" ] id_or_meta: [ | identref ] open_constr: [ | constr ] uconstr: [ | constr ] destruction_arg: [ | natural | test_lpar_id_rpar constr_with_bindings | constr_with_bindings_arg ] constr_with_bindings_arg: [ | constr_with_bindings ] quantified_hypothesis: [ | ident | natural ] conversion: [ | constr | constr "with" constr | constr "at" occs_nums "with" constr ] intropatterns: [ | LIST0 intropattern ] ne_intropatterns: [ | LIST1 intropattern ] or_and_intropattern: [ | "[" LIST1 intropatterns SEP "|" "]" | "()" | "(" simple_intropattern ")" | "(" simple_intropattern "," LIST1 simple_intropattern SEP "," ")" | "(" simple_intropattern "&" LIST1 simple_intropattern SEP "&" ")" ] equality_intropattern: [ | "->" | "<-" | test_leftsquarebracket_equal "[" "=" intropatterns "]" ] naming_intropattern: [ | pattern_ident | "?" | ident ] intropattern: [ | simple_intropattern | "*" | "**" ] simple_intropattern: [ | simple_intropattern_closed LIST0 [ "%" term0 ] ] simple_intropattern_closed: [ | equality_intropattern | or_and_intropattern | "_" | naming_intropattern ] simple_binding: [ | "(" identref ":=" lconstr ")" | "(" natural ":=" lconstr ")" ] bindings: [ | test_lpar_idnum_coloneq LIST1 simple_binding | LIST1 constr ] constr_with_bindings: [ | constr with_bindings ] with_bindings: [ | "with" bindings | ] hypident: [ | id_or_meta | "(" "type" "of" id_or_meta ")" | "(" "value" "of" id_or_meta ")" ] hypident_occ: [ | hypident occs ] clause_dft_concl: [ | "in" in_clause | occs | ] clause_dft_all: [ | "in" in_clause | ] opt_clause: [ | "in" in_clause | "at" occs_nums | ] concl_occ: [ | "*" occs | ] in_hyp_list: [ | "in" LIST1 id_or_meta | ] in_hyp_as: [ | "in" LIST1 [ id_or_meta as_ipat ] SEP "," | ] orient_rw: [ | "->" | "<-" | ] simple_binder: [ | name | "(" LIST1 name ":" lconstr ")" ] fixdecl: [ | "(" ident LIST0 simple_binder struct_annot ":" lconstr ")" ] struct_annot: [ | "{" "struct" name "}" | ] cofixdecl: [ | "(" ident LIST0 simple_binder ":" lconstr ")" ] bindings_with_parameters: [ | check_for_coloneq "(" ident LIST0 simple_binder ":=" lconstr ")" ] eliminator: [ | "using" constr_with_bindings ] as_ipat: [ | "as" simple_intropattern | ] or_and_intropattern_loc: [ | or_and_intropattern | identref ] as_or_and_ipat: [ | "as" equality_intropattern | "as" or_and_intropattern_loc | ] eqn_ipat: [ | "eqn" ":" naming_intropattern | ] as_name: [ | "as" ident | ] by_tactic: [ | "by" ltac_expr3 | ] rewriter: [ | "!" constr_with_bindings_arg | [ "?" | LEFTQMARK ] constr_with_bindings_arg | natural "!" constr_with_bindings_arg | natural [ "?" | LEFTQMARK ] constr_with_bindings_arg | natural constr_with_bindings_arg | constr_with_bindings_arg ] oriented_rewriter: [ | orient_rw rewriter ] induction_clause: [ | destruction_arg as_or_and_ipat eqn_ipat opt_clause ] induction_clause_list: [ | LIST1 induction_clause SEP "," OPT eliminator opt_clause ] ring_mod: [ | "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 "," ")" (* ring plugin *) ] field_mod: [ | ring_mod (* ring plugin *) | "completeness" constr (* ring plugin *) ] field_mods: [ | "(" LIST1 field_mod SEP "," ")" (* ring plugin *) ] number_string_mapping: [ | reference "=>" reference | "[" reference "]" "=>" reference ] number_string_via: [ | "via" reference "mapping" "[" LIST1 number_string_mapping SEP "," "]" ] number_modifier: [ | "warning" "after" bignat | "abstract" "after" bignat | number_string_via ] number_options: [ | "(" LIST1 number_modifier SEP "," ")" ] string_option: [ | "(" number_string_via ")" ] tac2pat1: [ | Prim.qualid LIST1 tac2pat0 (* ltac2 plugin *) | Prim.qualid (* ltac2 plugin *) | tac2pat0 "::" tac2pat0 (* ltac2 plugin *) | tac2pat0 "|" LIST1 tac2pat1 SEP "|" (* ltac2 plugin *) | tac2pat0 "as" identref (* ltac2 plugin *) | tac2pat0 (* ltac2 plugin *) ] tac2pat0: [ | "_" (* ltac2 plugin *) | "()" (* ltac2 plugin *) | Prim.integer (* ltac2 plugin *) | Prim.string (* ltac2 plugin *) | Prim.qualid (* ltac2 plugin *) | "(" atomic_tac2pat ")" (* ltac2 plugin *) | "{" tac2rec_fieldpats "}" (* ltac2 plugin *) | "[" LIST0 tac2pat1 SEP ";" "]" (* ltac2 plugin *) ] atomic_tac2pat: [ | (* ltac2 plugin *) | tac2pat1 ":" ltac2_type5 (* ltac2 plugin *) | tac2pat1 "," LIST0 tac2pat1 SEP "," (* ltac2 plugin *) | tac2pat1 (* ltac2 plugin *) ] ltac2_expr6: [ | ltac2_expr5 ";" ltac2_expr6 (* ltac2 plugin *) | ltac2_expr5 (* ltac2 plugin *) ] ltac2_expr5: [ | "fun" LIST1 G_LTAC2_input_fun type_cast "=>" ltac2_expr6 (* ltac2 plugin *) | "let" rec_flag LIST1 G_LTAC2_let_clause SEP "with" "in" ltac2_expr6 (* ltac2 plugin *) | "match" ltac2_expr5 "with" G_LTAC2_branches "end" (* ltac2 plugin *) | "if" ltac2_expr5 "then" ltac2_expr5 "else" ltac2_expr5 (* ltac2 plugin *) | ltac2_expr4 (* ltac2 plugin *) ] ltac2_expr4: [ | ltac2_expr3 (* ltac2 plugin *) ] ltac2_expr3: [ | ltac2_expr2 "," LIST1 ltac2_expr2 SEP "," (* ltac2 plugin *) | ltac2_expr2 (* ltac2 plugin *) ] ltac2_expr2: [ | ltac2_expr1 "::" ltac2_expr2 (* ltac2 plugin *) | ltac2_expr1 (* ltac2 plugin *) ] ltac2_expr1: [ | ltac2_expr0 LIST1 ltac2_expr0 (* ltac2 plugin *) | ltac2_expr0 ".(" Prim.qualid ")" (* ltac2 plugin *) | ltac2_expr0 ".(" Prim.qualid ")" ":=" ltac2_expr5 (* ltac2 plugin *) | ltac2_expr0 (* ltac2 plugin *) ] ltac2_expr0: [ | "(" ltac2_expr6 ")" (* ltac2 plugin *) | "(" ltac2_expr6 ":" ltac2_type5 ")" (* ltac2 plugin *) | "()" (* ltac2 plugin *) | "(" ")" (* ltac2 plugin *) | array_literal (* ltac2 plugin *) | list_literal (* ltac2 plugin *) | "{" test_qualid_with_or_lpar_or_rbrac ltac2_expr0 "with" tac2rec_fieldexprs "}" (* ltac2 plugin *) | "{" tac2rec_fieldexprs "}" (* ltac2 plugin *) | ltac2_atom (* ltac2 plugin *) ] array_literal: [ | test_array_opening "[" "|" LIST0 ltac2_expr5 SEP ";" test_array_closing "|" "]" (* ltac2 plugin *) ] list_literal: [ | "[" LIST0 ltac2_expr5 SEP ";" "]" (* ltac2 plugin *) ] G_LTAC2_branches: [ | (* ltac2 plugin *) | "|" LIST1 branch SEP "|" (* ltac2 plugin *) | LIST1 branch SEP "|" (* ltac2 plugin *) ] branch: [ | atomic_tac2pat "=>" ltac2_expr6 (* ltac2 plugin *) ] rec_flag: [ | "rec" (* ltac2 plugin *) | (* ltac2 plugin *) ] mut_flag: [ | "mutable" (* ltac2 plugin *) | (* ltac2 plugin *) ] ltac2_typevar: [ | "'" Prim.ident (* ltac2 plugin *) ] ltac2_atom: [ | Prim.integer (* ltac2 plugin *) | Prim.string (* ltac2 plugin *) | Prim.qualid (* ltac2 plugin *) | "@" Prim.ident (* ltac2 plugin *) | "&" identref (* ltac2 plugin *) | "'" Constr.constr (* ltac2 plugin *) | "constr" ":" "(" Constr.lconstr ")" (* ltac2 plugin *) | "open_constr" ":" "(" Constr.lconstr ")" (* ltac2 plugin *) | "preterm" ":" "(" Constr.lconstr ")" (* ltac2 plugin *) | "ident" ":" "(" identref ")" (* ltac2 plugin *) | "pat" ":" "(" Constr.cpattern ")" (* ltac2 plugin *) | "reference" ":" "(" globref ")" (* ltac2 plugin *) | "ltac1" ":" "(" ltac1_expr_in_env ")" (* ltac2_ltac1 plugin *) | "ltac1val" ":" "(" ltac1_expr_in_env ")" (* ltac2_ltac1 plugin *) ] tac2expr_in_env: [ | test_ltac1_env LIST0 identref "|-" ltac2_expr6 (* ltac2 plugin *) | ltac2_expr6 (* ltac2 plugin *) ] type_cast: [ | (* ltac2 plugin *) | ":" ltac2_type5 (* ltac2 plugin *) ] G_LTAC2_let_clause: [ | let_binder type_cast ":=" ltac2_expr6 (* ltac2 plugin *) ] let_binder: [ | LIST1 G_LTAC2_input_fun (* ltac2 plugin *) ] ltac2_type5: [ | ltac2_type2 "->" ltac2_type5 (* ltac2 plugin *) | ltac2_type2 (* ltac2 plugin *) ] ltac2_type2: [ | ltac2_type1 "*" LIST1 ltac2_type1 SEP "*" (* ltac2 plugin *) | ltac2_type1 (* ltac2 plugin *) ] ltac2_type1: [ | ltac2_type0 Prim.qualid (* ltac2 plugin *) | ltac2_type0 (* ltac2 plugin *) ] ltac2_type0: [ | "(" LIST1 ltac2_type5 SEP "," ")" OPT Prim.qualid (* ltac2 plugin *) | ltac2_typevar (* ltac2 plugin *) | "_" (* ltac2 plugin *) | Prim.qualid (* ltac2 plugin *) ] G_LTAC2_binder: [ | "_" (* ltac2 plugin *) | Prim.ident (* ltac2 plugin *) ] G_LTAC2_input_fun: [ | tac2pat0 (* ltac2 plugin *) ] tac2def_body: [ | G_LTAC2_binder LIST0 G_LTAC2_input_fun type_cast ":=" ltac2_expr6 (* ltac2 plugin *) ] tac2def_val: [ | mut_flag rec_flag LIST1 tac2def_body SEP "with" (* ltac2 plugin *) ] tac2def_mut: [ | "Set" Prim.qualid OPT [ "as" identref ] ":=" ltac2_expr6 (* ltac2 plugin *) ] tac2typ_knd: [ | ltac2_type5 (* ltac2 plugin *) | "[" ".." "]" (* ltac2 plugin *) | "[" tac2alg_constructors "]" (* ltac2 plugin *) | "{" tac2rec_fields "}" (* ltac2 plugin *) ] tac2alg_constructors: [ | "|" LIST1 tac2alg_constructor SEP "|" (* ltac2 plugin *) | LIST0 tac2alg_constructor SEP "|" (* ltac2 plugin *) ] tac2alg_constructor: [ | Prim.ident (* ltac2 plugin *) | Prim.ident "(" LIST0 ltac2_type5 SEP "," ")" (* ltac2 plugin *) ] tac2rec_fields: [ | tac2rec_field ";" tac2rec_fields (* ltac2 plugin *) | tac2rec_field ";" (* ltac2 plugin *) | tac2rec_field (* ltac2 plugin *) | (* ltac2 plugin *) ] tac2rec_field: [ | mut_flag Prim.ident ":" ltac2_type5 (* ltac2 plugin *) ] tac2rec_fieldexprs: [ | tac2rec_fieldexpr ";" tac2rec_fieldexprs (* ltac2 plugin *) | tac2rec_fieldexpr ";" (* ltac2 plugin *) | tac2rec_fieldexpr (* ltac2 plugin *) | (* ltac2 plugin *) ] tac2rec_fieldexpr: [ | Prim.qualid OPT [ ":=" ltac2_expr1 ] (* ltac2 plugin *) ] tac2rec_fieldpats: [ | tac2rec_fieldpat ";" tac2rec_fieldpats (* ltac2 plugin *) | tac2rec_fieldpat ";" (* ltac2 plugin *) | tac2rec_fieldpat (* ltac2 plugin *) | (* ltac2 plugin *) ] tac2rec_fieldpat: [ | Prim.qualid OPT [ ":=" tac2pat1 ] (* ltac2 plugin *) ] tac2typ_prm: [ | (* ltac2 plugin *) | ltac2_typevar (* ltac2 plugin *) | "(" LIST1 ltac2_typevar SEP "," ")" (* ltac2 plugin *) ] tac2typ_def: [ | tac2typ_prm Prim.qualid tac2type_body (* ltac2 plugin *) ] tac2type_body: [ | (* ltac2 plugin *) | ":=" tac2typ_knd (* ltac2 plugin *) | "::=" tac2typ_knd (* ltac2 plugin *) ] tac2def_typ: [ | "Type" rec_flag LIST1 tac2typ_def SEP "with" (* ltac2 plugin *) ] tac2def_ext: [ | "@" "external" identref ":" ltac2_type5 ":=" Prim.string Prim.string (* ltac2 plugin *) ] syn_node: [ | "_" (* ltac2 plugin *) | Prim.ident (* ltac2 plugin *) ] ltac2_scope: [ | Prim.string (* ltac2 plugin *) | Prim.integer (* ltac2 plugin *) | syn_node (* ltac2 plugin *) | syn_node "(" LIST1 ltac2_scope SEP "," ")" (* ltac2 plugin *) ] syn_level: [ | (* ltac2 plugin *) | ":" Prim.natural (* ltac2 plugin *) ] tac2def_syn: [ | LIST1 ltac2_scope syn_level ":=" ltac2_expr6 (* ltac2 plugin *) ] globref: [ | "&" Prim.ident (* ltac2 plugin *) | Prim.qualid (* ltac2 plugin *) ] anti: [ | "$" Prim.ident (* ltac2 plugin *) ] ident_or_anti: [ | identref (* ltac2 plugin *) | "$" Prim.ident (* ltac2 plugin *) ] lnatural: [ | Prim.natural (* ltac2 plugin *) ] q_ident: [ | ident_or_anti (* ltac2 plugin *) ] qhyp: [ | anti (* ltac2 plugin *) | lnatural (* ltac2 plugin *) | identref (* ltac2 plugin *) ] G_LTAC2_simple_binding: [ | "(" qhyp ":=" Constr.lconstr ")" (* ltac2 plugin *) ] G_LTAC2_bindings: [ | test_lpar_idnum_coloneq LIST1 G_LTAC2_simple_binding (* ltac2 plugin *) | LIST1 Constr.constr (* ltac2 plugin *) ] q_bindings: [ | G_LTAC2_bindings (* ltac2 plugin *) ] q_with_bindings: [ | G_LTAC2_with_bindings (* ltac2 plugin *) ] G_LTAC2_intropatterns: [ | LIST0 nonsimple_intropattern (* ltac2 plugin *) ] G_LTAC2_or_and_intropattern: [ | "[" LIST1 G_LTAC2_intropatterns SEP "|" "]" (* ltac2 plugin *) | "()" (* ltac2 plugin *) | "(" G_LTAC2_simple_intropattern ")" (* ltac2 plugin *) | "(" G_LTAC2_simple_intropattern "," LIST1 G_LTAC2_simple_intropattern SEP "," ")" (* ltac2 plugin *) | "(" G_LTAC2_simple_intropattern "&" LIST1 G_LTAC2_simple_intropattern SEP "&" ")" (* ltac2 plugin *) ] G_LTAC2_equality_intropattern: [ | "->" (* ltac2 plugin *) | "<-" (* ltac2 plugin *) | test_leftsquarebracket_equal "[" "=" G_LTAC2_intropatterns "]" (* ltac2 plugin *) ] G_LTAC2_naming_intropattern: [ | LEFTQMARK identref (* ltac2 plugin *) | "?$" identref (* ltac2 plugin *) | "?" (* ltac2 plugin *) | ident_or_anti (* ltac2 plugin *) ] nonsimple_intropattern: [ | G_LTAC2_simple_intropattern (* ltac2 plugin *) | "*" (* ltac2 plugin *) | "**" (* ltac2 plugin *) ] G_LTAC2_simple_intropattern: [ | G_LTAC2_simple_intropattern_closed LIST0 [ "%" Constr.term0 ] (* ltac2 plugin *) ] G_LTAC2_simple_intropattern_closed: [ | G_LTAC2_or_and_intropattern (* ltac2 plugin *) | G_LTAC2_equality_intropattern (* ltac2 plugin *) | "_" (* ltac2 plugin *) | G_LTAC2_naming_intropattern (* ltac2 plugin *) ] q_intropatterns: [ | G_LTAC2_intropatterns (* ltac2 plugin *) ] q_intropattern: [ | G_LTAC2_simple_intropattern (* ltac2 plugin *) ] nat_or_anti: [ | lnatural (* ltac2 plugin *) | "$" Prim.ident (* ltac2 plugin *) ] G_LTAC2_eqn_ipat: [ | "eqn" ":" G_LTAC2_naming_intropattern (* ltac2 plugin *) | (* ltac2 plugin *) ] G_LTAC2_with_bindings: [ | "with" G_LTAC2_bindings (* ltac2 plugin *) | (* ltac2 plugin *) ] G_LTAC2_constr_with_bindings: [ | Constr.constr G_LTAC2_with_bindings (* ltac2 plugin *) ] G_LTAC2_destruction_arg: [ | lnatural (* ltac2 plugin *) | identref (* ltac2 plugin *) | G_LTAC2_constr_with_bindings (* ltac2 plugin *) ] q_destruction_arg: [ | G_LTAC2_destruction_arg (* ltac2 plugin *) ] G_LTAC2_as_or_and_ipat: [ | "as" G_LTAC2_or_and_intropattern (* ltac2 plugin *) | (* ltac2 plugin *) ] G_LTAC2_occs_nums: [ | LIST1 nat_or_anti (* ltac2 plugin *) | "-" nat_or_anti LIST0 nat_or_anti (* ltac2 plugin *) ] G_LTAC2_occs: [ | "at" G_LTAC2_occs_nums (* ltac2 plugin *) | (* ltac2 plugin *) ] G_LTAC2_hypident: [ | ident_or_anti (* ltac2 plugin *) | "(" "type" "of" ident_or_anti ")" (* ltac2 plugin *) | "(" "value" "of" ident_or_anti ")" (* ltac2 plugin *) ] G_LTAC2_hypident_occ: [ | G_LTAC2_hypident G_LTAC2_occs (* ltac2 plugin *) ] G_LTAC2_in_clause: [ | "*" G_LTAC2_occs (* ltac2 plugin *) | "*" "|-" G_LTAC2_concl_occ (* ltac2 plugin *) | LIST0 G_LTAC2_hypident_occ SEP "," "|-" G_LTAC2_concl_occ (* ltac2 plugin *) | LIST0 G_LTAC2_hypident_occ SEP "," (* ltac2 plugin *) ] clause: [ | "in" G_LTAC2_in_clause (* ltac2 plugin *) | "at" G_LTAC2_occs_nums (* ltac2 plugin *) ] q_clause: [ | clause (* ltac2 plugin *) ] G_LTAC2_concl_occ: [ | "*" G_LTAC2_occs (* ltac2 plugin *) | (* ltac2 plugin *) ] G_LTAC2_induction_clause: [ | G_LTAC2_destruction_arg G_LTAC2_as_or_and_ipat G_LTAC2_eqn_ipat OPT clause (* ltac2 plugin *) ] q_induction_clause: [ | G_LTAC2_induction_clause (* ltac2 plugin *) ] G_LTAC2_conversion: [ | Constr.constr (* ltac2 plugin *) | Constr.constr "with" Constr.constr (* ltac2 plugin *) ] q_conversion: [ | G_LTAC2_conversion (* ltac2 plugin *) ] q_orient: [ | "->" (* ltac2 plugin *) | "<-" (* ltac2 plugin *) | (* ltac2 plugin *) ] G_LTAC2_rewriter: [ | "!" G_LTAC2_constr_with_bindings (* ltac2 plugin *) | [ "?" | LEFTQMARK ] G_LTAC2_constr_with_bindings (* ltac2 plugin *) | lnatural "!" G_LTAC2_constr_with_bindings (* ltac2 plugin *) | lnatural [ "?" | LEFTQMARK ] G_LTAC2_constr_with_bindings (* ltac2 plugin *) | lnatural G_LTAC2_constr_with_bindings (* ltac2 plugin *) | G_LTAC2_constr_with_bindings (* ltac2 plugin *) ] G_LTAC2_oriented_rewriter: [ | q_orient G_LTAC2_rewriter (* ltac2 plugin *) ] q_rewriting: [ | G_LTAC2_oriented_rewriter (* ltac2 plugin *) ] G_LTAC2_tactic_then_last: [ | "|" LIST0 ( OPT ltac2_expr6 ) SEP "|" (* ltac2 plugin *) | (* ltac2 plugin *) ] G_LTAC2_for_each_goal: [ | ltac2_expr6 "|" G_LTAC2_for_each_goal (* ltac2 plugin *) | ltac2_expr6 ".." G_LTAC2_tactic_then_last (* ltac2 plugin *) | ".." G_LTAC2_tactic_then_last (* ltac2 plugin *) | ltac2_expr6 (* ltac2 plugin *) | "|" G_LTAC2_for_each_goal (* ltac2 plugin *) | (* ltac2 plugin *) ] q_dispatch: [ | G_LTAC2_for_each_goal (* ltac2 plugin *) ] q_occurrences: [ | G_LTAC2_occs (* ltac2 plugin *) ] ltac2_red_flag: [ | "beta" (* ltac2 plugin *) | "iota" (* ltac2 plugin *) | "match" (* ltac2 plugin *) | "fix" (* ltac2 plugin *) | "cofix" (* ltac2 plugin *) | "zeta" (* ltac2 plugin *) | "delta" G_LTAC2_delta_flag (* ltac2 plugin *) | "head" (* ltac2 plugin *) ] refglobal: [ | "&" Prim.ident (* ltac2 plugin *) | Prim.qualid (* ltac2 plugin *) | "$" Prim.ident (* ltac2 plugin *) ] q_reference: [ | refglobal (* ltac2 plugin *) ] refglobals: [ | LIST1 refglobal (* ltac2 plugin *) ] G_LTAC2_delta_flag: [ | "-" "[" refglobals "]" (* ltac2 plugin *) | "[" refglobals "]" (* ltac2 plugin *) | (* ltac2 plugin *) ] G_LTAC2_strategy_flag: [ | LIST1 ltac2_red_flag (* ltac2 plugin *) | G_LTAC2_delta_flag (* ltac2 plugin *) ] q_strategy_flag: [ | G_LTAC2_strategy_flag (* ltac2 plugin *) ] hintdb: [ | "*" (* ltac2 plugin *) | LIST1 ident_or_anti (* ltac2 plugin *) ] q_hintdb: [ | hintdb (* ltac2 plugin *) ] G_LTAC2_match_pattern: [ | "context" OPT Prim.ident "[" Constr.cpattern "]" (* ltac2 plugin *) | Constr.cpattern (* ltac2 plugin *) ] G_LTAC2_match_rule: [ | G_LTAC2_match_pattern "=>" ltac2_expr6 (* ltac2 plugin *) ] G_LTAC2_match_list: [ | LIST1 G_LTAC2_match_rule SEP "|" (* ltac2 plugin *) | "|" LIST1 G_LTAC2_match_rule SEP "|" (* ltac2 plugin *) ] q_constr_matching: [ | G_LTAC2_match_list (* ltac2 plugin *) ] gmatch_hyp_pattern: [ | Prim.name ":" G_LTAC2_match_pattern (* ltac2 plugin *) | Prim.name ":=" "[" G_LTAC2_match_pattern "]" ":" G_LTAC2_match_pattern (* ltac2 plugin *) | Prim.name ":=" G_LTAC2_match_pattern (* ltac2 plugin *) ] gmatch_pattern: [ | "[" LIST0 gmatch_hyp_pattern SEP "," "|-" G_LTAC2_match_pattern "]" (* ltac2 plugin *) ] gmatch_rule: [ | gmatch_pattern "=>" ltac2_expr6 (* ltac2 plugin *) ] goal_match_list: [ | LIST1 gmatch_rule SEP "|" (* ltac2 plugin *) | "|" LIST1 gmatch_rule SEP "|" (* ltac2 plugin *) ] q_goal_matching: [ | goal_match_list (* ltac2 plugin *) ] move_location: [ | "at" "top" (* ltac2 plugin *) | "at" "bottom" (* ltac2 plugin *) | "after" ident_or_anti (* ltac2 plugin *) | "before" ident_or_anti (* ltac2 plugin *) ] q_move_location: [ | move_location (* ltac2 plugin *) ] G_LTAC2_as_name: [ | (* ltac2 plugin *) | "as" ident_or_anti (* ltac2 plugin *) ] pose: [ | test_lpar_id_coloneq "(" ident_or_anti ":=" Constr.lconstr ")" (* ltac2 plugin *) | Constr.constr G_LTAC2_as_name (* ltac2 plugin *) ] q_pose: [ | pose (* ltac2 plugin *) ] G_LTAC2_as_ipat: [ | "as" G_LTAC2_simple_intropattern (* ltac2 plugin *) | (* ltac2 plugin *) ] G_LTAC2_by_tactic: [ | "by" ltac2_expr5 (* ltac2 plugin *) | (* ltac2 plugin *) ] assertion: [ | test_lpar_id_coloneq "(" ident_or_anti ":=" Constr.lconstr ")" (* ltac2 plugin *) | test_lpar_id_colon "(" ident_or_anti ":" Constr.lconstr ")" G_LTAC2_by_tactic (* ltac2 plugin *) | Constr.constr G_LTAC2_as_ipat G_LTAC2_by_tactic (* ltac2 plugin *) ] q_assert: [ | assertion (* ltac2 plugin *) ] ltac2_entry: [ | tac2def_val (* ltac2 plugin *) | tac2def_typ (* ltac2 plugin *) | tac2def_ext (* ltac2 plugin *) | tac2def_mut (* ltac2 plugin *) ] ltac2def_syn: [ | tac2def_syn (* ltac2 plugin *) ] ltac2_expr: [ | _ltac2_expr (* ltac2 plugin *) ] ltac2_selector: [ | toplevel_selector (* ltac2 plugin *) ] ltac2_use_default: [ | "." (* ltac2 plugin *) | "..." (* ltac2 plugin *) ] tac2mode: [ | OPT ltac2_selector ltac2_expr6 ltac2_use_default (* ltac2 plugin *) | "par" ":" ltac2_expr6 ltac2_use_default (* ltac2 plugin *) | subprf (* ltac2 plugin *) | OPT toplevel_selector subprf_with_selector (* ltac2 plugin *) ] ltac1_expr_in_env: [ | test_ltac1_env LIST0 identref "|-" ltac_expr5 (* ltac2_ltac1 plugin *) | ltac_expr5 (* ltac2_ltac1 plugin *) ] coq-8.20.0/doc/tools/docgram/orderedGrammar000066400000000000000000001656751466560755400206300ustar00rootroot00000000000000(* Defines the order to apply to editedGrammar to get the final grammar for the doc. 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 term: [ | term100 ] term100: [ | term_cast | term10 ] term10: [ | term_application | term_forall_or_fun | term_let | term_fix | term_cofix | term_if | one_term ] one_term: [ | term_explicit | term1 ] term1: [ | term_projection | term_scope | term0 ] term0: [ | qualid_annotated | sort | number_or_string | term_evar | term_match | term_record | term_generalizing | "[|" LIST0 term SEP ";" "|" term OPT ( ":" type ) "|]" OPT univ_annot | term_ltac | "(" term ")" ] qualid_annotated: [ | qualid OPT univ_annot ] term_ltac: [ | "ltac" ":" "(" ltac_expr ")" ] term_projection: [ | term0 ".(" qualid OPT univ_annot LIST0 arg ")" | term0 ".(" "@" qualid OPT univ_annot LIST0 ( term1 ) ")" ] term_scope: [ | term0 "%" scope_key | term0 "%_" scope_key ] term_evar: [ | "_" | "?[" ident "]" | "?[" "?" ident "]" | "?" ident OPT ( "@{" LIST1 ( ident ":=" term ) SEP ";" "}" ) ] dangling_pattern_extension_rule: [ | "@" "?" ident LIST1 ident ] term_application: [ | term1 LIST1 arg | "@" qualid_annotated LIST1 term1 ] arg: [ | "(" ident ":=" term ")" | "(" natural ":=" term ")" | term1 ] term_explicit: [ | "@" qualid_annotated ] number_or_string: [ | number | string ] assumption_token: [ | [ "Axiom" | "Axioms" ] | [ "Conjecture" | "Conjectures" ] | [ "Parameter" | "Parameters" ] | [ "Hypothesis" | "Hypotheses" ] | [ "Variable" | "Variables" ] ] assumpt: [ | LIST1 ident_decl of_type ] ident_decl: [ | ident OPT univ_decl ] of_type: [ | [ ":" | ":>" ] type ] qualid: [ | ident LIST0 ( "." ident ) ] type: [ | term ] one_type: [ | one_term ] number: [ | OPT "-" decnat OPT ( "." LIST1 [ digit | "_" ] ) OPT ( [ "e" | "E" ] OPT [ "+" | "-" ] decnat ) | OPT "-" hexnat OPT ( "." LIST1 [ hexdigit | "_" ] ) OPT ( [ "p" | "P" ] OPT [ "+" | "-" ] decnat ) ] integer: [ | bigint ] bigint: [ | OPT "-" bignat ] natural: [ | bignat ] bignat: [ | [ decnat | hexnat ] ] decnat: [ | digit LIST0 [ digit | "_" ] ] digit: [ | "0" ".." "9" ] hexnat: [ | [ "0x" | "0X" ] hexdigit LIST0 [ hexdigit | "_" ] ] hexdigit: [ | [ "0" ".." "9" | "a" ".." "f" | "A" ".." "F" ] ] ident: [ | first_letter LIST0 subsequent_letter ] first_letter: [ | [ "a" ".." "z" | "A" ".." "Z" | "_" | unicode_letter ] ] subsequent_letter: [ | [ first_letter | digit | "'" | unicode_id_part ] ] where: [ | "at" "top" | "at" "bottom" | "before" ident | "after" 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 | NOTINRSTS ] NOTINRSTS: [ | command | control_command | simple_tactic | hints_regexp | REACHABLE | NOTINRSTS | l1_tactic | l3_tactic | l2_tactic | value_tactic | ltac2_entry | q_intropatterns | q_intropattern | q_ident | q_destruction_arg | q_with_bindings | q_bindings | q_reductions | q_reference | q_clause | q_occurrences | q_induction_clause | q_conversion | q_rewriting | q_dispatch | q_hintdb | q_move_location | q_pose | q_assert | q_constr_matching | q_goal_matching ] document: [ | LIST0 sentence ] nonterminal: [ ] sentence: [ | OPT attributes command "." | OPT attributes OPT ( natural ":" ) query_command "." | OPT attributes OPT ( toplevel_selector ":" ) ltac_expr [ "." | "..." ] | control_command ] control_command: [ ] query_command: [ ] attributes: [ | LIST0 ( "#[" LIST0 attribute SEP "," "]" ) LIST0 legacy_attr ] attribute: [ | ident OPT attr_value ] attr_value: [ | "=" string | "=" ident | "(" LIST1 attribute SEP "," ")" ] legacy_attr: [ | [ "Local" | "Global" ] | [ "Polymorphic" | "Monomorphic" ] | [ "Cumulative" | "NonCumulative" ] | "Private" | "Program" ] sort: [ | "Set" | "Prop" | "SProp" | "Type" | "Type" "@{" "_" "}" | "Type" "@{" OPT [ qualid "|" ] universe "}" ] universe: [ | "max" "(" LIST1 universe_expr SEP "," ")" | "_" | universe_expr ] universe_expr: [ | universe_name OPT ( "+" natural ) ] universe_name: [ | qualid | "Set" | "Prop" ] univ_annot: [ | "@{" LIST0 univ_level_or_quality OPT [ "|" LIST0 univ_level_or_quality ] "}" ] univ_level_or_quality: [ | "Set" | "SProp" | "Prop" | "Type" | "_" | qualid ] univ_decl: [ | "@{" OPT [ LIST0 ident "|" ] LIST0 ident OPT "+" OPT [ "|" LIST0 univ_constraint SEP "," OPT "+" ] "}" ] cumul_univ_decl: [ | "@{" OPT [ LIST0 ident "|" ] LIST0 ( OPT [ "+" | "=" | "*" ] ident ) OPT "+" OPT [ "|" LIST0 univ_constraint SEP "," OPT "+" ] "}" ] univ_constraint: [ | universe_name [ "<" | "=" | "<=" ] universe_name ] univ_decl_constraints: [ | "|" LIST0 univ_constraint SEP "," [ "+" | ] "}" | [ "}" | "|}" ] ] term_fix: [ | "let" "fix" fix_decl "in" term | "fix" fix_decl OPT ( LIST1 ( "with" fix_decl ) "for" ident ) ] fix_decl: [ | ident LIST0 binder OPT fixannot OPT ( ":" type ) ":=" term ] fixannot: [ | "{" "struct" ident "}" | "{" "wf" one_term ident "}" | "{" "measure" one_term OPT ident OPT one_term "}" ] term_cofix: [ | "let" "cofix" cofix_body "in" term | "cofix" cofix_body OPT ( LIST1 ( "with" cofix_body ) "for" ident ) ] cofix_body: [ | ident LIST0 binder OPT ( ":" type ) ":=" term ] term_if: [ | "if" term OPT [ OPT [ "as" name ] "return" term100 ] "then" term "else" term ] term_let: [ | "let" name OPT ( ":" type ) ":=" term "in" term | "let" name LIST1 binder OPT ( ":" type ) ":=" term "in" term | destructuring_let ] destructuring_let: [ | "let" "(" LIST0 name SEP "," ")" OPT [ OPT [ "as" name ] "return" term100 ] ":=" term "in" term | "let" "'" pattern ":=" term OPT ( "return" term100 ) "in" term | "let" "'" pattern "in" pattern ":=" term "return" term100 "in" term ] term_forall_or_fun: [ | "forall" open_binders "," type | "fun" open_binders "=>" term ] open_binders: [ | LIST1 name ":" type | LIST1 binder ] name: [ | "_" | ident ] binder: [ | name | "(" LIST1 name ":" type ")" | "(" name OPT ( ":" type ) ":=" term ")" | implicit_binders | generalizing_binder | "(" name ":" type "|" term ")" | "'" pattern0 ] implicit_binders: [ | "{" LIST1 name OPT ( ":" type ) "}" | "[" LIST1 name OPT ( ":" type ) "]" ] generalizing_binder: [ | "`(" LIST1 typeclass_constraint SEP "," ")" | "`{" LIST1 typeclass_constraint SEP "," "}" | "`[" LIST1 typeclass_constraint SEP "," "]" ] typeclass_constraint: [ | OPT "!" term | "{" name "}" ":" OPT "!" term | name ":" OPT "!" term ] term_generalizing: [ | "`{" term "}" | "`(" term ")" ] term_cast: [ | term10 ":" type | term10 "<:" type | term10 "<<:" type | term10 ":>" type ] term_match: [ | "match" LIST1 case_item SEP "," OPT ( "return" term100 ) "with" OPT "|" LIST0 eqn SEP "|" "end" ] case_item: [ | term100 OPT ( "as" name ) OPT [ "in" pattern ] ] eqn: [ | LIST1 [ LIST1 pattern SEP "," ] SEP "|" "=>" term ] pattern: [ | pattern10 ":" term | pattern10 ] pattern10: [ | pattern1 "as" name | pattern1 LIST0 pattern1 | "@" qualid LIST0 pattern1 ] pattern1: [ | pattern0 "%" scope_key | pattern0 "%_" scope_key | pattern0 ] pattern0: [ | qualid | "{|" LIST0 ( qualid ":=" pattern ) "|}" | "_" | "(" LIST1 pattern SEP "|" ")" | number | string ] fix_definition: [ | ident_decl LIST0 binder OPT fixannot OPT ( ":" type ) OPT [ ":=" term ] OPT decl_notations ] thm_token: [ | "Theorem" | "Lemma" | "Fact" | "Remark" | "Corollary" | "Proposition" | "Property" ] def_body: [ | LIST0 binder OPT ( ":" type ) ":=" OPT reduce term | LIST0 binder ":" type ] reduce: [ | "Eval" red_expr "in" ] red_expr: [ | "lazy" OPT reductions | "cbv" OPT reductions | "compute" OPT delta_reductions | "vm_compute" OPT [ reference_occs | pattern_occs ] | "native_compute" OPT [ reference_occs | pattern_occs ] | "red" | "hnf" | "simpl" OPT "head" OPT delta_reductions OPT [ reference_occs | pattern_occs ] | "cbn" OPT reductions | "unfold" LIST1 reference_occs SEP "," | "fold" LIST1 one_term | "pattern" LIST1 pattern_occs SEP "," | ident ] reductions: [ | LIST1 reduction | OPT "head" delta_reductions ] reduction: [ | "head" | "beta" | "delta" OPT delta_reductions | "match" | "fix" | "cofix" | "iota" | "zeta" ] delta_reductions: [ | OPT "-" "[" LIST1 reference "]" ] reference_occs: [ | reference OPT ( "at" occs_nums ) ] pattern_occs: [ | one_term OPT ( "at" occs_nums ) ] record_definition: [ | OPT ">" ident_decl LIST0 binder OPT [ ":" sort ] OPT ( ":=" OPT ident "{" LIST0 record_field SEP ";" OPT ";" "}" OPT [ "as" ident ] ) ] record_field: [ | LIST0 [ "#[" LIST1 attribute SEP "," "]" ] name OPT field_spec OPT [ "|" natural ] ] field_spec: [ | LIST0 binder of_type_inst | LIST0 binder ":=" term | LIST0 binder of_type_inst ":=" term ] of_type_inst: [ | [ ":" | ":>" | "::" | "::>" ] type ] term_record: [ | "{|" LIST0 field_val SEP ";" OPT ";" "|}" ] field_val: [ | qualid LIST0 binder ":=" term ] inductive_definition: [ | ident OPT cumul_univ_decl LIST0 binder OPT [ "|" LIST0 binder ] OPT [ ":" type ] ":=" OPT "|" LIST1 constructor SEP "|" OPT decl_notations ] constructor: [ | LIST0 [ "#[" LIST1 attribute SEP "," "]" ] ident LIST0 binder OPT of_type_inst ] import_categories: [ | OPT "-" "(" LIST1 qualid SEP "," ")" ] filtered_import: [ | qualid OPT [ "(" LIST1 ( qualid OPT [ "(" ".." ")" ] ) SEP "," ")" ] ] cofix_definition: [ | ident_decl LIST0 binder OPT ( ":" type ) OPT [ ":=" term ] OPT decl_notations ] rw_pattern: [ | term ] rewrite_rule: [ | OPT [ univ_decl "|-" ] rw_pattern "=>" term ] scheme_kind: [ | scheme_type "for" reference "Sort" sort_family ] scheme_type: [ | "Induction" | "Minimality" | "Elimination" | "Case" ] sort_family: [ | "Prop" | "SProp" | "Set" | "Type" ] hint_info: [ | "|" OPT natural OPT one_pattern ] one_pattern: [ | one_term ] module_binder: [ | "(" OPT ( [ "Import" | "Export" ] OPT import_categories ) LIST1 ident ":" module_type_inl ")" ] module_type_inl: [ | "!" module_type | module_type OPT functor_app_annot ] functor_app_annot: [ | "[" "inline" "at" "level" natural "]" | "[" "no" "inline" "]" ] module_type: [ | qualid | "(" module_type ")" | module_type module_expr_atom | module_type "with" with_declaration ] with_declaration: [ | "Definition" qualid OPT univ_decl ":=" term | "Module" qualid ":=" qualid ] module_expr_atom: [ | qualid | "(" module_expr_atom ")" ] of_module_type: [ | ":" module_type_inl | LIST0 ( "<:" module_type_inl ) ] module_expr_inl: [ | "!" LIST1 module_expr_atom | LIST1 module_expr_atom OPT functor_app_annot ] reference: [ | qualid | string OPT [ "%" scope_key ] ] arg_specs: [ | argument_spec | "/" | "&" | "(" LIST1 argument_spec ")" LIST0 [ "%" scope | "%_" scope ] | "[" LIST1 argument_spec "]" LIST0 [ "%" scope | "%_" scope ] | "{" LIST1 argument_spec "}" LIST0 [ "%" scope | "%_" scope ] ] argument_spec: [ | OPT "!" name LIST0 [ "%" scope | "%_" scope ] ] implicits_alt: [ | name | "[" LIST1 name "]" | "{" LIST1 name "}" ] args_modifier: [ | "simpl" "nomatch" | "simpl" "never" | "default" "implicits" | "clear" "implicits" | "clear" "scopes" | "clear" "bidirectionality" "hint" | "rename" | "assert" | "extra" "scopes" | "clear" "scopes" "and" "implicits" | "clear" "implicits" "and" "scopes" ] scope: [ | scope_name | scope_key ] scope_name: [ | ident ] scope_key: [ | ident ] strategy_level: [ | "opaque" | integer | "expand" | "transparent" ] strategy_level_or_var: [ | strategy_level | ident ] reserv_list: [ | LIST1 ( "(" simple_reserv ")" ) | simple_reserv ] simple_reserv: [ | LIST1 ident ":" type ] command: [ | "Goal" type | "Pwd" | "Cd" OPT string | "Load" OPT "Verbose" [ string | ident ] | "Declare" "ML" "Module" LIST1 string | "Locate" reference | "Locate" "Term" reference | "Locate" "Module" qualid | "Info" natural ltac_expr | "Add" "Zify" add_zify qualid (* Micromega plugin *) | "Show" "Zify" show_zify (* Micromega plugin *) | "Locate" "Ltac" qualid | "Locate" "Library" qualid | "Locate" "File" string | "Type" term | "Print" "All" | "Print" "Section" qualid | "Print" "Grammar" LIST0 ident | "Print" "Custom" "Grammar" ident | "Print" "Keywords" | "Print" "LoadPath" OPT dirpath | "Print" "Libraries" | "Print" "ML" "Path" | "Print" "ML" "Modules" | "Print" "Debug" "GC" | "Print" "Graph" | "Print" "Classes" | "Print" "Typeclasses" | "Print" "Instances" reference | "Print" "Coercions" | "Print" "Notation" string OPT [ "in" "custom" ident ] | "Print" "Coercion" "Paths" coercion_class coercion_class | "Print" "Canonical" "Projections" LIST0 reference | "Print" "Typing" "Flags" | "Print" "Tables" | "Print" "Options" | "Print" "Hint" OPT [ "*" | reference ] | "Print" "HintDb" ident | "Print" "Scopes" | "Print" "Scope" scope_name | "Print" "Visibility" OPT scope_name | "Print" "Implicit" reference | "Print" OPT "Sorted" "Universes" OPT ( "Subgraph" "(" LIST0 qualid ")" ) OPT string | "Print" "Assumptions" reference | "Print" "Opaque" "Dependencies" reference | "Print" "Transparent" "Dependencies" reference | "Print" "All" "Dependencies" reference | "Print" "Strategy" reference | "Print" "Strategies" | "Print" "Registered" | "Print" "Registered" "Schemes" | "Print" OPT "Term" reference OPT univ_name_list | "Print" "Module" "Type" qualid | "Print" "Module" qualid | "Print" "Namespace" dirpath | "Inspect" natural | "Print" "Table" setting_name | "Add" setting_name LIST1 [ qualid | string ] | "Test" setting_name OPT ( "for" LIST1 [ qualid | string ] ) | "Remove" setting_name LIST1 [ qualid | string ] | "Reset" "Initial" | "Reset" ident | "Back" OPT natural | "Debug" [ "On" | "Off" ] | "Declare" "Reduction" ident ":=" red_expr | "Declare" "Custom" "Entry" ident | "Derive" ident "SuchThat" one_term "As" ident (* derive plugin *) | "Extraction" qualid (* extraction plugin *) | "Recursive" "Extraction" LIST1 qualid (* extraction plugin *) | "Extraction" string LIST1 qualid (* extraction plugin *) | "Extraction" "TestCompile" LIST1 qualid (* extraction plugin *) | "Separate" "Extraction" LIST1 qualid (* extraction plugin *) | "Extraction" "Library" ident (* extraction plugin *) | "Recursive" "Extraction" "Library" ident (* extraction plugin *) | "Extraction" "Language" language (* extraction plugin *) | "Extraction" "Inline" LIST1 qualid (* extraction plugin *) | "Extraction" "NoInline" LIST1 qualid (* extraction plugin *) | "Print" "Extraction" "Inline" (* extraction plugin *) | "Reset" "Extraction" "Inline" (* 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 *) | "Extract" "Callback" OPT string qualid (* extraction plugin *) | "Print" "Extraction" "Callback" (* extraction plugin *) | "Reset" "Extraction" "Callback" (* extraction plugin *) | "Print" "Extraction" "Foreign" (* extraction plugin *) | "Extract" "Constant" qualid LIST0 string "=>" [ ident | string ] (* extraction plugin *) | "Extract" "Foreign" "Constant" qualid "=>" string (* extraction plugin *) | "Extract" "Inlined" "Constant" qualid "=>" [ ident | string ] (* extraction plugin *) | "Extract" "Inductive" qualid "=>" [ ident | string ] "[" LIST0 [ ident | string ] "]" OPT string (* extraction plugin *) | "Show" "Extraction" (* extraction plugin *) | "Proof" | "Proof" "Mode" string | "Proof" term | "Abort" OPT "All" | "Admitted" | "Qed" | "Save" ident | "Defined" OPT ident | "Restart" | "Undo" OPT ( OPT "To" natural ) | "Focus" OPT natural | "Unfocus" | "Unfocused" | "Show" OPT [ ident | natural ] | "Show" "Existentials" | "Show" "Universes" | "Show" "Conjectures" | "Show" "Proof" OPT ( "Diffs" OPT "removed" ) | "Show" "Intro" | "Show" "Intros" | "Show" "Match" qualid | "Guarded" | "Validate" "Proof" | "Create" "HintDb" ident OPT "discriminated" | "Remove" "Hints" LIST1 qualid OPT ( ":" LIST1 ident ) | "Comments" LIST0 [ one_term | string | natural ] | "Attributes" LIST1 attribute SEP "," | "Declare" "Instance" ident_decl LIST0 binder ":" term OPT hint_info | "Declare" "Scope" scope_name | "Obligation" natural OPT ( "of" ident ) OPT ( ":" type OPT ( "with" ltac_expr ) ) | "Next" "Obligation" OPT ( "of" ident ) OPT ( "with" ltac_expr ) | "Final" "Obligation" OPT ( "of" ident ) OPT ( "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 | "Show" "Obligation" "Tactic" | "Obligations" OPT ( "of" ident ) | "Preterm" OPT ( "of" ident ) | "Add" "Relation" one_term one_term OPT ( "reflexivity" "proved" "by" one_term ) OPT ( "symmetry" "proved" "by" one_term ) OPT ( "transitivity" "proved" "by" one_term ) "as" ident | "Add" "Parametric" "Relation" LIST0 binder ":" one_term one_term OPT ( "reflexivity" "proved" "by" one_term ) OPT ( "symmetry" "proved" "by" one_term ) OPT ( "transitivity" "proved" "by" one_term ) "as" ident | "Add" "Setoid" one_term one_term one_term "as" ident | "Add" "Parametric" "Setoid" LIST0 binder ":" one_term one_term one_term "as" ident | "Add" "Morphism" one_term ":" ident | "Declare" "Morphism" one_term ":" ident | "Add" "Morphism" one_term "with" "signature" term "as" ident | "Add" "Parametric" "Morphism" LIST0 binder ":" one_term "with" "signature" term "as" ident | "Unshelve" | "Declare" "Equivalent" "Keys" one_term one_term | "Print" "Equivalent" "Keys" | "Optimize" "Proof" | "Optimize" "Heap" | "infoH" ltac_expr | "Reset" "Ltac" "Profile" | "Show" "Ltac" "Profile" OPT [ "CutOff" integer | string ] | "Show" "Lia" "Profile" (* micromega plugin *) | "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 *) | "Hint" "Cut" "[" hints_regexp "]" OPT ( ":" LIST1 ident ) | "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 | "Ltac" tacdef_body LIST0 ( "with" tacdef_body ) | "Print" "Ltac" "Signatures" | "Print" "Firstorder" "Solver" | "Function" fix_definition LIST0 ( "with" fix_definition ) | "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 ) | "Derive" "Inversion" ident "with" one_term OPT ( "Sort" sort_family ) | "Derive" "Dependent" "Inversion" ident "with" one_term "Sort" sort_family | "Derive" "Dependent" "Inversion_clear" ident "with" one_term "Sort" sort_family | "Declare" "Left" "Step" one_term | "Declare" "Right" "Step" one_term | "Number" "Notation" qualid qualid qualid OPT ( "(" LIST1 number_modifier SEP "," ")" ) ":" scope_name | "String" "Notation" qualid qualid qualid OPT ( "(" number_string_via ")" ) ":" scope_name | "SubClass" ident_decl def_body | thm_token ident_decl LIST0 binder ":" type LIST0 [ "with" ident_decl LIST0 binder ":" type ] | assumption_token OPT ( "Inline" OPT ( "(" natural ")" ) ) [ assumpt | LIST1 ( "(" assumpt ")" ) ] | [ "Definition" | "Example" ] ident_decl def_body | [ "Symbol" | "Symbols" ] [ assumpt | LIST1 ( "(" assumpt ")" ) ] | "Let" ident_decl def_body | "Inductive" inductive_definition LIST0 ( "with" inductive_definition ) | "Inductive" record_definition LIST0 ( "with" record_definition ) | "Fixpoint" fix_definition LIST0 ( "with" fix_definition ) | "Let" "Fixpoint" fix_definition LIST0 ( "with" fix_definition ) | "CoFixpoint" cofix_definition LIST0 ( "with" cofix_definition ) | "Let" "CoFixpoint" cofix_definition LIST0 ( "with" cofix_definition ) | "Scheme" OPT ( ident ":=" ) scheme_kind LIST0 ( "with" OPT ( ident ":=" ) scheme_kind ) | "Scheme" OPT "Boolean" "Equality" "for" reference | "Combined" "Scheme" ident "from" LIST1 ident SEP "," | "Register" qualid "as" qualid | "Register" "Scheme" qualid "as" qualid "for" qualid | "Register" "Inline" qualid | "Primitive" ident_decl OPT [ ":" term ] ":=" "#" ident | "Universe" LIST1 ident | "Universes" LIST1 ident | "Constraint" LIST1 univ_constraint SEP "," | "Rewrite" [ "Rule" | "Rules" ] ident ":=" OPT "|" LIST1 rewrite_rule SEP "|" | "CoInductive" inductive_definition LIST0 ( "with" inductive_definition ) | "CoInductive" record_definition LIST0 ( "with" record_definition ) | "Variant" ident_decl LIST0 binder OPT [ "|" LIST0 binder ] OPT [ ":" type ] ":=" OPT "|" LIST1 constructor SEP "|" OPT decl_notations | [ "Record" | "Structure" ] record_definition | "Class" record_definition | "Class" ident_decl LIST0 binder OPT [ ":" sort ] ":=" constructor | "Module" OPT ( [ "Import" | "Export" ] OPT import_categories ) 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" ] OPT import_categories ) ident LIST0 module_binder ":" module_type_inl | "Section" ident | "End" ident | "Collection" ident ":=" section_var_expr | "From" dirpath "Extra" "Dependency" string OPT [ "as" ident ] | OPT [ "From" dirpath ] "Require" OPT ( [ "Import" | "Export" ] OPT import_categories ) LIST1 filtered_import | "Import" OPT import_categories LIST1 filtered_import | "Export" OPT import_categories LIST1 filtered_import | "Include" module_type_inl LIST0 ( "<+" module_type_inl ) | "Include" "Type" LIST1 module_type_inl SEP "<+" | "Transparent" OPT "!" LIST1 reference | "Opaque" OPT "!" LIST1 reference | "Strategy" LIST1 [ strategy_level "[" LIST1 reference "]" ] | "Canonical" OPT "Structure" ident_decl def_body | "Canonical" OPT "Structure" reference | "Coercion" ident_decl def_body | "Identity" "Coercion" ident ":" coercion_class ">->" coercion_class | "Coercion" reference OPT [ ":" coercion_class ">->" coercion_class ] | "Context" LIST1 binder | "Instance" OPT ( ident_decl LIST0 binder ) ":" type OPT hint_info OPT [ ":=" "{" LIST0 field_val "}" | ":=" term ] | "Existing" "Instance" qualid OPT hint_info | "Existing" "Instances" LIST1 qualid OPT [ "|" natural ] | "Existing" "Class" qualid | "Arguments" reference LIST0 arg_specs LIST0 [ "," LIST0 implicits_alt ] OPT [ ":" LIST1 args_modifier SEP "," ] | "Implicit" [ "Type" | "Types" ] reserv_list | "Generalizable" [ [ "Variable" | "Variables" ] LIST1 ident | "All" "Variables" | "No" "Variables" ] | "Set" setting_name OPT [ integer | string ] | "Unset" setting_name | "Open" "Scope" scope | "Close" "Scope" scope | "Delimit" "Scope" scope_name "with" scope_key | "Undelimit" "Scope" scope_name | "Bind" "Scope" scope_name "with" LIST1 coercion_class | "Infix" notation_declaration | "Notation" ident LIST0 ident ":=" one_term OPT ( "(" LIST1 syntax_modifier SEP "," ")" ) | "Notation" notation_declaration | "Reserved" "Infix" string OPT ( "(" LIST1 syntax_modifier SEP "," ")" ) | "Reserved" "Notation" string OPT ( "(" LIST1 syntax_modifier SEP "," ")" ) | [ "Enable" | "Disable" ] "Notation" OPT [ string | qualid LIST0 ident ] OPT ( ":=" one_term ) OPT ( "(" LIST1 enable_notation_flag SEP "," ")" ) OPT [ ":" scope_name | ":" "no" "scope" ] | "Eval" red_expr "in" term | "Compute" term | "Check" term | "About" reference OPT univ_name_list | "SearchPattern" one_pattern OPT ( [ "inside" | "in" | "outside" ] LIST1 qualid ) | "SearchRewrite" one_pattern OPT ( [ "inside" | "in" | "outside" ] LIST1 qualid ) | "Search" LIST1 ( search_query ) OPT ( [ "inside" | "in" | "outside" ] LIST1 qualid ) | "Ltac2" OPT "mutable" OPT "rec" tac2def_body LIST0 ( "with" tac2def_body ) | "Ltac2" "Type" OPT "rec" tac2typ_def LIST0 ( "with" tac2typ_def ) | "Ltac2" "@" "external" ident ":" ltac2_type ":=" string string | "Ltac2" "Notation" LIST1 ltac2_scope OPT ( ":" natural ) ":=" ltac2_expr (* ltac2 plugin *) | "Ltac2" "Set" qualid OPT [ "as" ident ] ":=" ltac2_expr | "Ltac2" "Notation" [ string | ident ] ":=" ltac2_expr (* Ltac2 plugin *) | "Ltac2" "Eval" ltac2_expr (* ltac2 plugin *) | "Print" "Ltac2" qualid (* ltac2 plugin *) | "Print" "Ltac2" "Type" qualid (* ltac2 plugin *) | "Locate" "Ltac2" qualid (* ltac2 plugin *) | "Print" "Ltac2" "Signatures" (* ltac2 plugin *) | "Ltac2" "Check" ltac2_expr (* ltac2 plugin *) | "Ltac2" "Globalize" ltac2_expr (* ltac2 plugin *) | "Hint" "Resolve" LIST1 [ qualid | one_term ] OPT hint_info OPT ( ":" LIST1 ident ) | "Hint" "Resolve" [ "->" | "<-" ] LIST1 qualid OPT natural OPT ( ":" LIST1 ident ) | "Hint" "Immediate" LIST1 [ qualid | one_term ] OPT ( ":" LIST1 ident ) | "Hint" [ "Constants" | "Projections" | "Variables" ] [ "Transparent" | "Opaque" ] OPT ( ":" LIST1 ident ) | "Hint" [ "Transparent" | "Opaque" ] LIST1 qualid OPT ( ":" LIST1 ident ) | "Hint" "Mode" qualid LIST1 [ "+" | "!" | "-" ] OPT ( ":" LIST1 ident ) | "Hint" "Unfold" LIST1 qualid OPT ( ":" LIST1 ident ) | "Hint" "Constructors" LIST1 qualid OPT ( ":" LIST1 ident ) | "Hint" "Extern" natural OPT one_pattern "=>" ltac_expr OPT ( ":" LIST1 ident ) | "Time" sentence | "Instructions" sentence | "Redirect" string sentence | "Timeout" natural sentence | "Fail" sentence | "Succeed" sentence | "Drop" | "Quit" | "BackTo" natural | "Show" "Goal" natural "at" natural ] section_var_expr: [ | LIST0 starred_ident_ref | OPT "-" 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 ")" OPT "*" ] starred_ident_ref: [ | ident OPT "*" | "Type" OPT "*" | "All" ] dirpath: [ | LIST0 ( ident "." ) ident ] setting_name: [ | LIST1 ident ] search_query: [ | search_item | "-" search_query | "[" LIST1 ( LIST1 search_query ) SEP "|" "]" ] search_item: [ | OPT ( [ "head" | "hyp" | "concl" | "headhyp" | "headconcl" ] ":" ) string OPT ( "%" scope_key ) | OPT ( [ "head" | "hyp" | "concl" | "headhyp" | "headconcl" ] ":" ) one_pattern | "is" ":" logical_kind ] logical_kind: [ | [ thm_token | assumption_token ] | [ "Definition" | "Example" | "Context" | "Primitive" | "Symbol" ] | [ "Coercion" | "Instance" | "Scheme" | "Canonical" | "SubClass" ] | [ "Fixpoint" | "CoFixpoint" | "Field" | "Method" ] ] univ_name_list: [ | "@{" LIST0 name "}" ] enable_notation_flag: [ | "all" | "only" "parsing" | "only" "printing" | "in" "custom" ident | "in" "constr" ] tacdef_body: [ | qualid LIST0 name [ ":=" | "::=" ] ltac_expr ] ltac_production_item: [ | string | ident OPT ( "(" ident OPT ( "," string ) ")" ) ] ltac2_type: [ | ltac2_type2 "->" ltac2_type (* ltac2 plugin *) | ltac2_type2 (* ltac2 plugin *) ] ltac2_type2: [ | ltac2_type1 "*" LIST1 ltac2_type1 SEP "*" (* ltac2 plugin *) | ltac2_type1 (* ltac2 plugin *) ] ltac2_type1: [ | ltac2_type0 qualid (* ltac2 plugin *) | ltac2_type0 (* ltac2 plugin *) ] ltac2_type0: [ | "(" LIST1 ltac2_type SEP "," ")" OPT qualid (* ltac2 plugin *) | ltac2_typevar (* ltac2 plugin *) | "_" (* ltac2 plugin *) | qualid (* ltac2 plugin *) ] ltac2_typevar: [ | "'" ident (* ltac2 plugin *) ] occurrences: [ | "at" occs_nums | "in" goal_occurrences ] simple_occurrences: [ | occurrences ] occs_nums: [ | OPT "-" LIST1 nat_or_var ] nat_or_var: [ | [ natural | ident ] ] goal_occurrences: [ | LIST1 hyp_occs SEP "," OPT ( "|-" OPT concl_occs ) | "*" "|-" OPT concl_occs | "|-" OPT concl_occs | OPT concl_occs ] hyp_occs: [ | hypident OPT ( "at" occs_nums ) ] hypident: [ | ident | "(" "type" "of" ident ")" | "(" "value" "of" ident ")" ] concl_occs: [ | "*" OPT ( "at" occs_nums ) ] q_intropatterns: [ | ltac2_intropatterns (* ltac2 plugin *) ] ltac2_intropatterns: [ | LIST0 nonsimple_intropattern (* ltac2 plugin *) ] nonsimple_intropattern: [ | "*" (* ltac2 plugin *) | "**" (* ltac2 plugin *) | ltac2_simple_intropattern (* ltac2 plugin *) ] q_intropattern: [ | ltac2_simple_intropattern (* ltac2 plugin *) ] ltac2_simple_intropattern: [ | ltac2_simple_intropattern_closed LIST0 [ "%" term0 ] (* ltac2 plugin *) ] ltac2_simple_intropattern_closed: [ | ltac2_or_and_intropattern (* ltac2 plugin *) | ltac2_equality_intropattern (* ltac2 plugin *) | "_" (* ltac2 plugin *) | ltac2_naming_intropattern (* ltac2 plugin *) ] ltac2_naming_intropattern: [ | "?" ident (* ltac2 plugin *) | "?$" ident (* ltac2 plugin *) | "?" (* ltac2 plugin *) | ident_or_anti (* ltac2 plugin *) ] ltac2_or_and_intropattern: [ | "[" LIST1 ltac2_intropatterns SEP "|" "]" (* ltac2 plugin *) | "()" (* ltac2 plugin *) | "(" LIST1 ltac2_simple_intropattern SEP "," ")" (* Ltac2 plugin *) | "(" LIST1 ltac2_simple_intropattern SEP "&" ")" (* Ltac2 plugin *) ] ltac2_equality_intropattern: [ | "->" (* ltac2 plugin *) | "<-" (* ltac2 plugin *) | "[=" ltac2_intropatterns "]" ] q_ident: [ | ident_or_anti (* ltac2 plugin *) ] ident_or_anti: [ | ident | "$" ident (* ltac2 plugin *) ] q_destruction_arg: [ | ltac2_destruction_arg (* ltac2 plugin *) ] ltac2_destruction_arg: [ | natural (* ltac2 plugin *) | ident | ltac2_constr_with_bindings (* ltac2 plugin *) ] ltac2_constr_with_bindings: [ | term OPT ( "with" ltac2_bindings ) (* ltac2 plugin *) ] q_bindings: [ | ltac2_bindings (* ltac2 plugin *) ] q_with_bindings: [ | OPT ( "with" ltac2_bindings ) (* ltac2 plugin *) ] ltac2_bindings: [ | LIST1 ltac2_simple_binding (* ltac2 plugin *) | LIST1 term (* ltac2 plugin *) ] ltac2_simple_binding: [ | "(" qhyp ":=" term ")" (* ltac2 plugin *) ] qhyp: [ | "$" ident (* ltac2 plugin *) | natural (* ltac2 plugin *) | ident ] language: [ | "OCaml" (* extraction plugin *) | "Haskell" (* extraction plugin *) | "Scheme" (* extraction plugin *) | "JSON" (* extraction plugin *) ] ring_mod: [ | "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 (* ring plugin *) | "completeness" one_term (* ring plugin *) ] number_modifier: [ | "warning" "after" bignat | "abstract" "after" bignat | number_string_via ] number_string_via: [ | "via" qualid "mapping" "[" LIST1 [ qualid "=>" qualid | "[" qualid "]" "=>" qualid ] SEP "," "]" ] hints_regexp: [ | LIST1 qualid | "_" | hints_regexp "|" hints_regexp | hints_regexp hints_regexp | hints_regexp "*" | "emp" | "eps" | "(" hints_regexp ")" ] coercion_class: [ | "Funclass" | "Sortclass" | reference ] syntax_modifier: [ | "at" "level" natural | "in" "custom" ident OPT ( "at" "level" natural ) | LIST1 ident SEP "," [ "at" level | "in" "scope" ident ] | ident "at" level OPT binder_interp | ident explicit_subentry | ident binder_interp | "left" "associativity" | "right" "associativity" | "no" "associativity" | "only" "parsing" | "format" string | "only" "printing" ] explicit_subentry: [ | "ident" | "name" | "global" | "bigint" | "strict" "pattern" OPT ( "at" "level" natural ) | "binder" | "closed" "binder" | "constr" OPT ( "at" level ) OPT binder_interp | "custom" ident OPT ( "at" level ) OPT binder_interp | "pattern" OPT ( "at" "level" natural ) ] binder_interp: [ | "as" "ident" | "as" "name" | "as" "pattern" | "as" "strict" "pattern" ] level: [ | "level" natural | "next" "level" ] decl_notations: [ | "where" notation_declaration LIST0 ( "and" notation_declaration ) ] notation_declaration: [ | string ":=" one_term OPT ( "(" LIST1 syntax_modifier SEP "," ")" ) OPT [ ":" scope_name ] ] simple_tactic: [ | "reflexivity" | "exact" one_term | "assumption" | "etransitivity" | "cut" one_type | "exact_no_check" one_term | "vm_cast_no_check" one_term | "native_cast_no_check" one_term | "lapply" one_term | "transitivity" one_term | "left" OPT ( "with" bindings ) | "eleft" OPT ( "with" bindings ) | "right" OPT ( "with" bindings ) | "eright" OPT ( "with" bindings ) | "constructor" OPT nat_or_var OPT ( "with" bindings ) | "econstructor" OPT ( nat_or_var OPT ( "with" bindings ) ) | "specialize" one_term_with_bindings OPT as_ipat | "symmetry" OPT simple_occurrences | "split" OPT ( "with" bindings ) | "esplit" OPT ( "with" bindings ) | "exists" LIST0 bindings SEP "," | "eexists" LIST0 bindings SEP "," | "intros" "until" [ ident | natural ] | "intro" OPT ident OPT where | "move" ident where | "rename" LIST1 ( ident "into" ident ) SEP "," | "revert" LIST1 ident | "simple" "induction" [ ident | natural ] | "simple" "destruct" [ ident | natural ] | "admit" | "clear" OPT ( OPT "-" LIST1 ident ) | "clearbody" LIST1 ident | "simplify_eq" OPT induction_arg | "esimplify_eq" OPT induction_arg | "discriminate" OPT induction_arg | "ediscriminate" OPT induction_arg | "injection" OPT induction_arg OPT ( "as" LIST0 simple_intropattern ) | "einjection" OPT induction_arg OPT ( "as" LIST0 simple_intropattern ) | "simple" "injection" OPT induction_arg | "replace" OPT [ "->" | "<-" ] one_term OPT occurrences | "replace" OPT [ "->" | "<-" ] one_term "with" one_term OPT occurrences OPT ( "by" ltac_expr3 ) | "typeclasses" "eauto" OPT [ "bfs" | "dfs" | "best_effort" ] OPT nat_or_var OPT ( "with" LIST1 ident ) | "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 "]" ] ":" ) "{" | [ LIST1 "-" | LIST1 "+" | LIST1 "*" ] | "}" | "try" ltac_expr3 | "do" nat_or_var ltac_expr3 | "timeout" nat_or_var ltac_expr3 | "time" OPT string ltac_expr3 | "repeat" ltac_expr3 | "progress" ltac_expr3 | "once" ltac_expr3 | "exactly_once" ltac_expr3 | "abstract" ltac_expr2 OPT ( "using" ident ) | "only" goal_selector ":" ltac_expr3 | "tryif" ltac_expr "then" ltac_expr "else" ltac_expr2 | "first" "[" LIST0 ltac_expr SEP "|" "]" | "first" ident | "solve" "[" LIST0 ltac_expr SEP "|" "]" | "solve" ident | "idtac" LIST0 [ ident | string | natural ] | [ "fail" | "gfail" ] OPT nat_or_var LIST0 [ ident | string | natural ] | "eval" red_expr "in" term | "context" ident "[" term "]" | "type" "of" term | "fresh" LIST0 [ string | qualid ] | "type_term" one_term | "numgoals" | "fun" LIST1 name "=>" ltac_expr | "let" OPT "rec" let_clause LIST0 ( "with" let_clause ) "in" ltac_expr | ltac_expr3 ";" ltac_expr3 | ltac_expr3 ";" "[" for_each_goal "]" | ltac_expr1 "+" ltac_expr2 | ltac_expr1 "||" ltac_expr2 | "[>" for_each_goal "]" | toplevel_selector ":" ltac_expr | ltac2_match_key ltac2_expr "with" ltac2_match_list "end" | ltac2_match_key OPT "reverse" "goal" "with" goal_match_list "end" | "case_eq" one_term | "dependent" "rewrite" OPT [ "->" | "<-" ] one_term OPT ( "in" ident ) | "decompose" "sum" one_term | "decompose" "record" one_term | "absurd" one_type | "contradiction" OPT one_term_with_bindings | "autorewrite" OPT "*" "with" LIST1 ident OPT occurrences OPT ( "using" ltac_expr ) | "rewrite" "*" OPT [ "->" | "<-" ] one_term OPT ( "in" ident ) OPT ( "at" rewrite_occs ) OPT ( "by" ltac_expr3 ) | "rewrite" "*" OPT [ "->" | "<-" ] one_term "at" rewrite_occs "in" ident OPT ( "by" ltac_expr3 ) | OPT "simple" OPT "notypeclasses" "refine" one_term | "solve_constraints" | "subst" LIST0 ident | "simple" "subst" | "evar" "(" ident ":" type ")" | "evar" one_type | "instantiate" "(" ident ":=" term ")" | "instantiate" "(" natural ":=" term ")" OPT hloc | "stepl" one_term OPT ( "by" ltac_expr ) | "stepr" one_term OPT ( "by" ltac_expr ) | "generalize_eqs" ident | "dependent" "generalize_eqs" ident | "generalize_eqs_vars" ident | "dependent" "generalize_eqs_vars" ident | "specialize_eqs" ident | "destauto" OPT ( "in" ident ) | "transparent_abstract" ltac_expr3 OPT ( "using" ident ) | "constr_eq" one_term one_term | "constr_eq_strict" one_term one_term | "constr_eq_nounivs" one_term one_term | "is_evar" one_term | "has_evar" one_term | "is_var" one_term | "is_fix" one_term | "is_cofix" one_term | "is_ind" one_term | "is_constructor" one_term | "is_proj" one_term | "is_const" one_term | "shelve" | "shelve_unifiable" | "unshelve" ltac_expr1 | "give_up" | "cycle" int_or_var | "swap" int_or_var int_or_var | "revgoals" | "guard" int_or_var comparison int_or_var | "decompose" "[" LIST1 one_term "]" one_term | "optimize_heap" | "with_strategy" strategy_level_or_var "[" LIST1 reference "]" ltac_expr3 | "start" "ltac" "profiling" | "stop" "ltac" "profiling" | "reset" "ltac" "profile" | "show" "ltac" "profile" OPT [ "cutoff" integer | string ] | "restart_timer" OPT string | "finish_timing" OPT ( "(" string ")" ) OPT string | "eassumption" | "eexact" one_term | "trivial" OPT auto_using OPT hintbases | "info_trivial" OPT auto_using OPT hintbases | "debug" "trivial" OPT auto_using OPT hintbases | "auto" OPT nat_or_var OPT auto_using OPT hintbases | "info_auto" OPT nat_or_var OPT auto_using OPT hintbases | "debug" "auto" OPT nat_or_var OPT auto_using OPT hintbases | "eauto" OPT nat_or_var OPT auto_using OPT hintbases | "debug" "eauto" OPT nat_or_var OPT auto_using OPT hintbases | "info_eauto" OPT nat_or_var OPT auto_using OPT hintbases | "dfs" "eauto" OPT nat_or_var OPT auto_using OPT hintbases | "autounfold" OPT hintbases OPT simple_occurrences | "autounfold_one" OPT hintbases OPT ( "in" ident ) | "unify" one_term one_term OPT ( "with" ident ) | "convert" one_term one_term | "head_of_constr" ident one_term | "not_evar" one_term | "is_ground" one_term | "autoapply" one_term "with" ident | "rewrite_strat" rewstrategy OPT ( "in" ident ) | "rewrite_db" ident OPT ( "in" ident ) | "substitute" OPT [ "->" | "<-" ] one_term_with_bindings | "setoid_rewrite" OPT [ "->" | "<-" ] one_term_with_bindings OPT ( "at" rewrite_occs ) OPT ( "in" ident ) | "setoid_rewrite" OPT [ "->" | "<-" ] one_term_with_bindings "in" ident "at" rewrite_occs | "setoid_symmetry" OPT ( "in" ident ) | "setoid_reflexivity" | "setoid_transitivity" one_term | "setoid_etransitivity" | "intros" LIST0 intropattern | "eintros" LIST0 intropattern | "decide" "equality" | "compare" one_term one_term | "apply" LIST1 one_term_with_bindings SEP "," OPT in_hyp_as | "eapply" LIST1 one_term_with_bindings SEP "," OPT in_hyp_as | "simple" "apply" LIST1 one_term_with_bindings SEP "," OPT in_hyp_as | "simple" "eapply" LIST1 one_term_with_bindings SEP "," OPT in_hyp_as | "elim" one_term_with_bindings OPT ( "using" one_term_with_bindings ) | "eelim" one_term_with_bindings OPT ( "using" one_term_with_bindings ) | "case" LIST1 induction_clause SEP "," OPT induction_principle | "ecase" LIST1 induction_clause SEP "," OPT induction_principle | "fix" ident natural OPT ( "with" LIST1 ( "(" ident LIST0 simple_binder OPT ( "{" "struct" name "}" ) ":" type ")" ) ) | "cofix" ident OPT ( "with" LIST1 ( "(" ident LIST0 simple_binder ":" type ")" ) ) | "pose" alias_definition | "pose" one_term OPT as_name | "epose" alias_definition | "epose" one_term OPT as_name | "pose" "proof" "(" ident ":=" term ")" | "pose" "proof" term OPT as_ipat | "epose" "proof" "(" ident ":=" term ")" | "epose" "proof" term OPT as_ipat | "set" alias_definition OPT occurrences | "set" one_term OPT as_name OPT occurrences | "eset" alias_definition OPT occurrences | "eset" one_term OPT as_name OPT occurrences | "remember" one_term OPT as_name OPT ( "eqn" ":" naming_intropattern ) OPT ( "in" goal_occurrences ) | "eremember" one_term OPT as_name OPT ( "eqn" ":" naming_intropattern ) OPT ( "in" goal_occurrences ) | "assert" "(" ident ":" type ")" OPT ( "by" ltac_expr3 ) | "assert" "(" ident ":=" term ")" | "assert" one_type OPT as_ipat OPT ( "by" ltac_expr3 ) | "eassert" "(" ident ":" type ")" OPT ( "by" ltac_expr3 ) | "eassert" "(" ident ":=" term ")" | "eassert" one_type OPT as_ipat OPT ( "by" ltac_expr3 ) | "enough" "(" ident ":" type ")" OPT ( "by" ltac_expr3 ) | "eenough" "(" ident ":" type ")" OPT ( "by" ltac_expr3 ) | "enough" one_type OPT as_ipat OPT ( "by" ltac_expr3 ) | "eenough" one_type OPT as_ipat OPT ( "by" ltac_expr3 ) | "generalize" "dependent" one_term | "generalize" LIST1 one_term | "generalize" LIST1 [ pattern_occs OPT as_name ] SEP "," | "induction" LIST1 induction_clause SEP "," OPT induction_principle | "einduction" LIST1 induction_clause SEP "," OPT induction_principle | "destruct" LIST1 induction_clause SEP "," OPT induction_principle | "edestruct" LIST1 induction_clause SEP "," OPT induction_principle | "rewrite" LIST1 oriented_rewriter SEP "," OPT occurrences OPT ( "by" ltac_expr3 ) | "erewrite" LIST1 oriented_rewriter SEP "," OPT occurrences OPT ( "by" ltac_expr3 ) | "simple" "inversion" [ ident | natural ] OPT ( "as" or_and_intropattern ) OPT ( "in" LIST1 ident ) | "inversion" [ ident | natural ] OPT ( "as" or_and_intropattern ) OPT ( "in" LIST1 ident ) | "inversion_clear" [ ident | natural ] OPT ( "as" or_and_intropattern ) OPT ( "in" LIST1 ident ) | "inversion" [ ident | natural ] "using" one_term OPT ( "in" LIST1 ident ) | "red" simple_occurrences | "hnf" simple_occurrences | "simpl" OPT "head" OPT delta_reductions OPT [ reference_occs | pattern_occs ] simple_occurrences | "cbv" OPT reductions simple_occurrences | "cbn" OPT reductions simple_occurrences | "lazy" OPT reductions simple_occurrences | "compute" OPT delta_reductions simple_occurrences | "vm_compute" OPT [ reference_occs | pattern_occs ] OPT occurrences | "native_compute" OPT [ reference_occs | pattern_occs ] OPT occurrences | "unfold" LIST1 reference_occs SEP "," OPT occurrences | "fold" LIST1 one_term simple_occurrences | "pattern" LIST1 pattern_occs SEP "," OPT occurrences | "change" OPT ( one_term OPT ( "at" occs_nums ) "with" ) one_term OPT occurrences | "change_no_check" OPT ( one_term OPT ( "at" occs_nums ) "with" ) one_term OPT occurrences | "btauto" | "rtauto" | "congruence" OPT natural OPT ( "with" LIST1 one_term ) | "simple" "congruence" OPT natural OPT ( "with" LIST1 one_term ) | "f_equal" | "firstorder" OPT ltac_expr OPT ( "using" LIST1 qualid SEP "," ) OPT ( "with" LIST1 ident ) | "gintuition" OPT ltac_expr | "functional" "inversion" [ ident | natural ] OPT qualid (* funind plugin *) | "functional" "induction" term OPT ( "using" one_term_with_bindings ) OPT ( "as" simple_intropattern ) (* funind plugin *) | "soft" "functional" "induction" LIST1 one_term OPT ( "using" one_term_with_bindings ) OPT ( "as" simple_intropattern ) (* funind plugin *) | "xlra_Q" ltac_expr (* micromega plugin *) | "wlra_Q" ident one_term (* micromega plugin *) | "xlra_R" ltac_expr (* micromega plugin *) | "xlia" ltac_expr (* micromega plugin *) | "wlia" ident one_term (* micromega plugin *) | "xnra_Q" ltac_expr (* micromega plugin *) | "wnra_Q" ident one_term (* micromega plugin *) | "xnra_R" ltac_expr (* micromega plugin *) | "xnia" ltac_expr (* micromega plugin *) | "wnia" ident one_term (* micromega plugin *) | "xsos_Z" ltac_expr (* micromega plugin *) | "wsos_Z" ident one_term (* micromega plugin *) | "xsos_Q" ltac_expr (* micromega plugin *) | "wsos_Q" ident one_term (* micromega plugin *) | "xsos_R" ltac_expr (* micromega plugin *) | "xpsatz_Z" nat_or_var ltac_expr (* micromega plugin *) | "wpsatz_Z" nat_or_var ident one_term (* micromega plugin *) | "xpsatz_Q" nat_or_var ltac_expr (* micromega plugin *) | "wpsatz_Q" nat_or_var ident one_term (* micromega plugin *) | "xpsatz_R" nat_or_var ltac_expr (* micromega plugin *) | "zify_iter_specs" (* micromega plugin *) | "zify_op" (* micromega plugin *) | "zify_saturate" (* micromega plugin *) | "zify_iter_let" ltac_expr (* micromega plugin *) | "zify_elim_let" (* micromega plugin *) | "nsatz_compute" one_term (* nsatz plugin *) | "protect_fv" string OPT ( "in" ident ) | "ring_lookup" ltac_expr0 "[" LIST0 one_term "]" LIST1 one_term (* ring plugin *) | "field_lookup" ltac_expr "[" LIST0 one_term "]" LIST1 one_term (* 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" | "dependent" "inversion" [ ident | natural ] OPT ( "as" or_and_intropattern ) OPT [ "with" one_term ] | "dependent" "simple" "inversion" [ ident | natural ] OPT ( "as" or_and_intropattern ) OPT [ "with" one_term ] | "dependent" "inversion_clear" [ ident | natural ] OPT ( "as" or_and_intropattern ) OPT [ "with" one_term ] | "classical_left" | "classical_right" | "contradict" ident | "dintuition" OPT ltac_expr | "discrR" | "dtauto" | "easy" | "exfalso" | "inversion_sigma" OPT ( ident OPT ( "as" simple_intropattern ) ) | "lia" | "lra" | "nia" | "now_show" one_type | "nra" | "rapply" one_term | "split_Rabs" | "split_Rmult" | "tauto" | "time_constr" ltac_expr | "zify" | "assert_fails" ltac_expr3 | "assert_succeeds" ltac_expr3 | "clear" "dependent" ident | "decide" one_term "with" one_term | "dependent" "destruction" ident OPT ( "generalizing" LIST1 ident ) OPT ( "using" one_term ) | "dependent" "induction" ident OPT ( [ "generalizing" | "in" ] LIST1 ident ) OPT ( "using" one_term ) | "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 | "now" ltac_expr | "nsatz" OPT ( "with" "radicalmax" ":=" one_term "strategy" ":=" one_term "parameters" ":=" one_term "variables" ":=" one_term ) | "psatz" one_term OPT nat_or_var | "revert" "dependent" ident | "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" | "if" ltac2_expr5 "then" ltac2_expr5 "else" ltac2_expr5 | qualid LIST1 tactic_arg ] hloc: [ | "in" "|-" "*" | "in" ident | "in" "(" "type" "of" ident ")" | "in" "(" "value" "of" ident ")" ] in_hyp_as: [ | "in" LIST1 [ ident OPT as_ipat ] SEP "," ] as_ipat: [ | "as" simple_intropattern ] oriented_rewriter: [ | OPT [ "->" | "<-" ] OPT natural OPT [ "?" | "!" ] one_term_with_bindings ] induction_clause: [ | induction_arg OPT ( "as" or_and_intropattern ) OPT ( "eqn" ":" naming_intropattern ) OPT occurrences ] induction_arg: [ | one_term_with_bindings | natural ] induction_principle: [ | "using" one_term_with_bindings OPT occurrences ] auto_using: [ | "using" LIST1 one_term SEP "," ] hintbases: [ | "with" "*" | "with" LIST1 ident ] intropattern: [ | "*" | "**" | simple_intropattern ] simple_intropattern: [ | simple_intropattern_closed LIST0 [ "%" term0 ] ] simple_intropattern_closed: [ | naming_intropattern | "_" | or_and_intropattern | equality_intropattern ] naming_intropattern: [ | ident | "?" | "?" ident ] or_and_intropattern: [ | "[" LIST0 ( LIST0 intropattern ) SEP "|" "]" | "(" LIST0 simple_intropattern SEP "," ")" | "(" LIST0 simple_intropattern SEP "&" ")" ] equality_intropattern: [ | "->" | "<-" | "[=" LIST0 intropattern "]" ] one_term_with_bindings: [ | one_term OPT ( "with" bindings ) ] bindings: [ | LIST1 one_term | LIST1 ( "(" [ ident | natural ] ":=" term ")" ) ] int_or_var: [ | [ integer | ident ] ] comparison: [ | "=" | "<" | "<=" | ">" | ">=" ] alias_definition: [ | "(" ident LIST0 simple_binder ":=" term ")" ] simple_binder: [ | name | "(" LIST1 name ":" term ")" ] as_name: [ | "as" ident ] q_clause: [ | ltac2_clause (* Ltac2 plugin *) ] ltac2_clause: [ | "in" ltac2_in_clause (* ltac2 plugin *) | "at" ltac2_occs_nums (* ltac2 plugin *) ] ltac2_in_clause: [ | "*" OPT ltac2_occs (* ltac2 plugin *) | "*" "|-" OPT ltac2_concl_occ (* ltac2 plugin *) | LIST0 ltac2_hypident_occ SEP "," OPT ( "|-" OPT ltac2_concl_occ ) (* Ltac2 plugin *) ] q_occurrences: [ | OPT ltac2_occs (* ltac2 plugin *) ] ltac2_occs: [ | "at" ltac2_occs_nums (* ltac2 plugin *) ] ltac2_occs_nums: [ | OPT "-" LIST1 [ natural | "$" ident ] (* Ltac2 plugin *) ] ltac2_concl_occ: [ | "*" OPT ltac2_occs (* ltac2 plugin *) ] ltac2_hypident_occ: [ | ltac2_hypident OPT ltac2_occs (* ltac2 plugin *) ] ltac2_hypident: [ | ident_or_anti (* ltac2 plugin *) | "(" "type" "of" ident_or_anti ")" (* ltac2 plugin *) | "(" "value" "of" ident_or_anti ")" (* ltac2 plugin *) ] q_induction_clause: [ | ltac2_induction_clause (* ltac2 plugin *) ] ltac2_induction_clause: [ | ltac2_destruction_arg OPT ltac2_as_or_and_ipat OPT ltac2_eqn_ipat OPT ltac2_clause (* Ltac2 plugin *) ] ltac2_as_or_and_ipat: [ | "as" ltac2_or_and_intropattern (* ltac2 plugin *) ] ltac2_eqn_ipat: [ | "eqn" ":" ltac2_naming_intropattern (* ltac2 plugin *) ] q_conversion: [ | ltac2_conversion (* ltac2 plugin *) ] ltac2_conversion: [ | term (* ltac2 plugin *) | term "with" term (* ltac2 plugin *) ] q_rewriting: [ | ltac2_oriented_rewriter (* ltac2 plugin *) ] ltac2_oriented_rewriter: [ | OPT q_orient ltac2_rewriter (* ltac2 plugin *) ] q_orient: [ | OPT [ "->" | "<-" ] ] ltac2_rewriter: [ | OPT natural OPT [ "?" | "!" ] ltac2_constr_with_bindings ] q_dispatch: [ | ltac2_for_each_goal (* ltac2 plugin *) ] ltac2_for_each_goal: [ | ltac2_goal_tactics (* Ltac2 plugin *) | OPT ( ltac2_goal_tactics "|" ) OPT ltac2_expr ".." OPT ( "|" ltac2_goal_tactics ) (* Ltac2 plugin *) ] ltac2_goal_tactics: [ | LIST0 ( OPT ltac2_expr ) SEP "|" (* Ltac2 plugin *) ] q_reductions: [ | ltac2_reductions (* ltac2 plugin *) ] ltac2_reductions: [ | LIST1 ltac2_red_flag (* ltac2 plugin *) | OPT ltac2_delta_reductions (* ltac2 plugin *) ] ltac2_red_flag: [ | "beta" (* ltac2 plugin *) | "iota" (* ltac2 plugin *) | "match" (* ltac2 plugin *) | "fix" (* ltac2 plugin *) | "cofix" (* ltac2 plugin *) | "zeta" (* ltac2 plugin *) | "delta" OPT ltac2_delta_reductions (* ltac2 plugin *) | "head" (* ltac2 plugin *) ] ltac2_delta_reductions: [ | OPT "-" "[" LIST1 refglobal "]" ] q_reference: [ | refglobal (* ltac2 plugin *) ] refglobal: [ | "&" ident (* ltac2 plugin *) | qualid (* ltac2 plugin *) | "$" ident (* ltac2 plugin *) ] q_hintdb: [ | hintdb (* ltac2 plugin *) ] hintdb: [ | "*" (* ltac2 plugin *) | LIST1 ident_or_anti (* ltac2 plugin *) ] q_constr_matching: [ | ltac2_match_list (* ltac2 plugin *) ] ltac2_match_key: [ | "lazy_match!" | "match!" | "multi_match!" ] ltac2_match_list: [ | OPT "|" LIST1 ltac2_match_rule SEP "|" ] ltac2_match_rule: [ | ltac2_match_pattern "=>" ltac2_expr (* ltac2 plugin *) ] ltac2_match_pattern: [ | cpattern (* ltac2 plugin *) | "context" OPT ident "[" cpattern "]" (* ltac2 plugin *) ] q_goal_matching: [ | goal_match_list (* ltac2 plugin *) ] goal_match_list: [ | OPT "|" LIST1 gmatch_rule SEP "|" ] gmatch_rule: [ | gmatch_pattern "=>" ltac2_expr (* ltac2 plugin *) ] gmatch_pattern: [ | "[" LIST0 gmatch_hyp_pattern SEP "," "|-" ltac2_match_pattern "]" (* ltac2 plugin *) ] gmatch_hyp_pattern: [ | name ":" ltac2_match_pattern (* ltac2 plugin *) | name ":=" "[" ltac2_match_pattern "]" ":" ltac2_match_pattern (* ltac2 plugin *) | name ":=" ltac2_match_pattern (* ltac2 plugin *) ] q_move_location: [ | move_location (* ltac2 plugin *) ] move_location: [ | "at" "top" (* ltac2 plugin *) | "at" "bottom" (* ltac2 plugin *) | "after" ident_or_anti (* ltac2 plugin *) | "before" ident_or_anti (* ltac2 plugin *) ] q_pose: [ | pose (* ltac2 plugin *) ] pose: [ | "(" ident_or_anti ":=" term ")" (* ltac2 plugin *) | term OPT ltac2_as_name (* ltac2 plugin *) ] ltac2_as_name: [ | "as" ident_or_anti (* ltac2 plugin *) ] q_assert: [ | assertion (* ltac2 plugin *) ] assertion: [ | "(" ident_or_anti ":=" term ")" (* ltac2 plugin *) | "(" ident_or_anti ":" term ")" OPT ltac2_by_tactic (* ltac2 plugin *) | term OPT ltac2_as_ipat OPT ltac2_by_tactic (* ltac2 plugin *) ] ltac2_as_ipat: [ | "as" ltac2_simple_intropattern (* ltac2 plugin *) ] ltac2_by_tactic: [ | "by" ltac2_expr5 (* ltac2 plugin *) ] ltac2_entry: [ ] ltac2_selector: [ | toplevel_selector ":" ] ltac2_use_default: [ | "." (* ltac2 plugin *) | "..." (* ltac2 plugin *) ] tac2def_body: [ | [ "_" | ident ] LIST0 tac2pat0 OPT ( ":" ltac2_type ) ":=" ltac2_expr (* ltac2 plugin *) ] tac2typ_def: [ | OPT tac2typ_prm qualid OPT ( [ ":=" | "::=" ] tac2typ_knd ) (* ltac2 plugin *) ] tac2typ_prm: [ | ltac2_typevar (* ltac2 plugin *) | "(" LIST1 ltac2_typevar SEP "," ")" (* ltac2 plugin *) ] tac2typ_knd: [ | ltac2_type (* ltac2 plugin *) | "[" OPT ( OPT "|" LIST1 tac2alg_constructor SEP "|" ) "]" (* ltac2 plugin *) | "[" ".." "]" (* ltac2 plugin *) | "{" OPT ( LIST1 tac2rec_field SEP ";" OPT ";" ) "}" (* ltac2 plugin *) ] tac2alg_constructor: [ | ident (* ltac2 plugin *) | ident "(" LIST0 ltac2_type SEP "," ")" (* ltac2 plugin *) ] tac2rec_field: [ | OPT "mutable" ident ":" ltac2_type (* ltac2 plugin *) ] ltac2_scope: [ | string (* ltac2 plugin *) | integer (* ltac2 plugin *) | name (* Ltac2 plugin *) | name "(" LIST1 ltac2_scope SEP "," ")" (* Ltac2 plugin *) ] ltac2_expr: [ | ltac2_expr5 ";" ltac2_expr (* ltac2 plugin *) | ltac2_expr5 (* ltac2 plugin *) ] ltac2_expr5: [ | "fun" LIST1 tac2pat0 OPT ( ":" ltac2_type ) "=>" ltac2_expr (* ltac2 plugin *) | "let" OPT "rec" ltac2_let_clause LIST0 ( "with" ltac2_let_clause ) "in" ltac2_expr (* Ltac2 plugin *) | ltac2_expr3 (* ltac2 plugin *) ] ltac2_let_clause: [ | LIST1 tac2pat0 OPT ( ":" ltac2_type ) ":=" ltac2_expr (* ltac2 plugin *) ] ltac2_expr3: [ | LIST1 ltac2_expr2 SEP "," (* Ltac2 plugin *) ] ltac2_expr2: [ | ltac2_expr1 "::" ltac2_expr2 (* ltac2 plugin *) | ltac2_expr1 (* ltac2 plugin *) ] ltac2_expr1: [ | ltac2_expr0 LIST1 ltac2_expr0 (* ltac2 plugin *) | ltac2_expr0 ".(" qualid ")" (* ltac2 plugin *) | ltac2_expr0 ".(" qualid ")" ":=" ltac2_expr5 (* ltac2 plugin *) | ltac2_expr0 (* ltac2 plugin *) ] tac2rec_fieldexpr: [ | qualid OPT [ ":=" ltac2_expr1 ] (* ltac2 plugin *) ] ltac2_expr0: [ | "(" ltac2_expr ")" (* ltac2 plugin *) | "(" ltac2_expr ":" ltac2_type ")" (* ltac2 plugin *) | "()" (* ltac2 plugin *) | "[" "|" LIST0 ltac2_expr5 SEP ";" "|" "]" (* ltac2 plugin *) | "[" LIST0 ltac2_expr5 SEP ";" "]" (* ltac2 plugin *) | "{" ltac2_expr0 "with" OPT ( LIST1 tac2rec_fieldexpr SEP ";" OPT ";" ) "}" (* ltac2 plugin *) | "{" OPT ( LIST1 tac2rec_fieldexpr SEP ";" OPT ";" ) "}" (* ltac2 plugin *) | ltac2_atom (* ltac2 plugin *) ] tac2rec_fieldpats: [ | tac2rec_fieldpat ";" OPT tac2rec_fieldpats (* ltac2 plugin *) | tac2rec_fieldpat ";" (* ltac2 plugin *) | tac2rec_fieldpat (* ltac2 plugin *) ] tac2rec_fieldpat: [ | qualid OPT [ ":=" tac2pat1 ] (* ltac2 plugin *) ] ltac2_atom: [ | integer (* ltac2 plugin *) | string (* ltac2 plugin *) | qualid (* ltac2 plugin *) | "@" ident (* ltac2 plugin *) | "&" ident (* ltac2 plugin *) | "'" term (* ltac2 plugin *) | ltac2_quotations ] ltac2_quotations: [ | "ident" ":" "(" ident ")" | "constr" ":" "(" term ")" | "open_constr" ":" "(" term ")" | "preterm" ":" "(" term ")" | "pat" ":" "(" cpattern ")" | "reference" ":" "(" [ "&" ident | qualid ] ")" | "ltac1" ":" "(" ltac1_expr_in_env ")" | "ltac1val" ":" "(" ltac1_expr_in_env ")" ] ltac1_expr_in_env: [ | ltac_expr (* ltac2_ltac1 plugin *) | LIST0 ident "|-" ltac_expr (* ltac2_ltac1 plugin *) ] ltac2_branches: [ | OPT "|" LIST1 ( OPT atomic_tac2pat "=>" ltac2_expr ) SEP "|" ] tac2pat1: [ | qualid LIST1 tac2pat0 (* ltac2 plugin *) | qualid (* ltac2 plugin *) | tac2pat0 "::" tac2pat0 (* ltac2 plugin *) | tac2pat0 "|" LIST1 tac2pat1 SEP "|" (* ltac2 plugin *) | tac2pat0 "as" ident (* ltac2 plugin *) | tac2pat0 (* ltac2 plugin *) ] tac2pat0: [ | "_" (* ltac2 plugin *) | "()" (* ltac2 plugin *) | integer (* ltac2 plugin *) | string (* ltac2 plugin *) | qualid (* ltac2 plugin *) | "(" OPT atomic_tac2pat ")" (* ltac2 plugin *) | "{" OPT tac2rec_fieldpats "}" (* ltac2 plugin *) | "[" LIST0 tac2pat1 SEP ";" "]" (* ltac2 plugin *) ] atomic_tac2pat: [ | tac2pat1 ":" ltac2_type (* ltac2 plugin *) | tac2pat1 "," LIST0 tac2pat1 SEP "," (* ltac2 plugin *) | tac2pat1 (* ltac2 plugin *) ] func_scheme_def: [ | ident ":=" "Induction" "for" qualid "Sort" sort_family (* funind plugin *) ] rewrite_occs: [ | LIST1 integer | ident ] rewstrategy: [ | "fix" ident ":=" rewstrategy1 | LIST1 rewstrategy1 SEP ";" ] rewstrategy1: [ | "<-" one_term | "progress" rewstrategy1 | "try" rewstrategy1 | "choice" LIST1 rewstrategy0 | "repeat" rewstrategy1 | "any" rewstrategy1 | "subterm" rewstrategy1 | "subterms" rewstrategy1 | "innermost" rewstrategy1 | "outermost" rewstrategy1 | "bottomup" rewstrategy1 | "topdown" rewstrategy1 | "hints" ident | "terms" LIST0 one_term | "eval" red_expr | "fold" one_term | rewstrategy0 | "old_hints" ident ] rewstrategy0: [ | one_term | "fail" | "id" | "refl" | "(" rewstrategy ")" ] l3_tactic: [ ] l2_tactic: [ ] l1_tactic: [ ] value_tactic: [ ] syn_value: [ | ident ":" "(" nonterminal ")" ] ltac_expr: [ | ltac_expr4 ] ltac_expr4: [ | ltac_expr3 ";" ltac_expr3 | ltac_expr3 ";" "[" for_each_goal "]" | ltac_expr3 ] ltac_expr3: [ | l3_tactic | ltac_expr2 ] ltac_expr2: [ | ltac_expr1 "+" ltac_expr2 | ltac_expr1 "||" ltac_expr2 | l2_tactic | ltac_expr1 ] ltac_expr1: [ | tactic_value | qualid LIST1 tactic_arg | l1_tactic | ltac_expr0 ] tactic_value: [ | [ value_tactic | syn_value ] ] tactic_arg: [ | tactic_value | term | "()" ] ltac_expr0: [ | "(" ltac_expr ")" | "[>" for_each_goal "]" | tactic_atom ] tactic_atom: [ | integer | qualid | "()" ] let_clause: [ | name ":=" ltac_expr | ident LIST1 name ":=" ltac_expr ] for_each_goal: [ | goal_tactics | OPT ( goal_tactics "|" ) OPT ltac_expr ".." OPT ( "|" goal_tactics ) ] goal_tactics: [ | LIST0 ( OPT ltac_expr ) SEP "|" ] toplevel_selector: [ | goal_selector | "all" | "!" | "par" ] goal_selector: [ | LIST1 range_selector SEP "," | "[" ident "]" ] range_selector: [ | natural | natural "-" natural ] match_key: [ | "lazymatch" | "match" | "multimatch" ] match_pattern: [ | cpattern | "context" OPT ident "[" cpattern "]" ] cpattern: [ | term ] goal_pattern: [ | LIST0 match_hyp SEP "," "|-" match_pattern | "[" LIST0 match_hyp SEP "," "|-" match_pattern "]" | "_" ] match_hyp: [ | name ":" match_pattern | name ":=" match_pattern | name ":=" "[" match_pattern "]" ":" match_pattern ] coq-8.20.0/doc/tools/latex_filter000077500000000000000000000015201466560755400167200ustar00rootroot00000000000000#!/bin/sh # First argument is the number of lines to treat # Second argument is optional and, if it is "no", overfull are not displayed i=$1 nooverfull=$2 error=0 verbose=0 chapter="" file="" while : ; do read -r line; case $line in "! "*) echo $line $file; error=1 verbose=1 ;; "LaTeX Font Info"*|"LaTeX Info"*|"Underfull "*) verbose=0 ;; "Overfull "*) verbose=0 if [ "$nooverfull" != "no" ]; then echo $line $file; fi ;; "LaTeX "*) verbose=0 echo $line $chapter ;; "["*|"Chapter "*) verbose=0 ;; "(./"*) file="(file `echo $line | cut -b 4- | cut -d' ' -f 1`)" verbose=0 ;; *) if [ $verbose = 1 ]; then echo $line; fi esac; if [ "$i" = "0" ]; then break; else i=`expr $i - 1`; fi; done exit $error coq-8.20.0/doc/tools/show_latex_messages000077500000000000000000000002751466560755400203100ustar00rootroot00000000000000#!/bin/sh tooldir=$(dirname $0) if [ "$1" = "-no-overfull" ]; then cat $2 | "$tooldir"/latex_filter `cat $2 | wc -l` no else cat $1 | "$tooldir"/latex_filter `cat $1 | wc -l` yes fi coq-8.20.0/dune000066400000000000000000000035121466560755400132640ustar00rootroot00000000000000; Default flags for all Coq libraries. (env (dev (flags :standard -w -9-27@60-69@70 \ -short-paths) (coq (flags :standard -w +default))) (release (flags :standard) (ocamlopt_flags :standard -O3 -unbox-closures)) (ireport (flags :standard -w -9-27+60-70) (ocamlopt_flags :standard -O3 -unbox-closures -inlining-report))) ; Information about flags for release mode: ; ; In #9665 we tried to add (c_flags -O3) to the release setup, ; unfortunately the resulting VM seems to be slower [5% slower on ; fourcolor, thus we keep the default C flags for now, which seem to ; be -O2. ; The _ profile could help factoring the above, however it doesn't ; seem to work like we'd expect/like: ; ; (_ (flags :standard))) (alias (name default) (deps coq-core.install coq-stdlib.install coqide-server.install coqide.install)) (install (section lib) (package coq-core) (files revision)) (rule (targets revision) (mode fallback) (deps (:rev-script dev/tools/make_git_revision.sh)) (action (with-stdout-to revision (bash %{rev-script})))) ; bootstrap for theories/dune (rule (targets theories_dune) (deps (source_tree theories) (source_tree plugins)) (action (with-stdout-to %{targets} (run tools/dune_rule_gen/gen_rules.exe Coq theories %{env:COQ_DUNE_EXTRA_OPT=})))) (rule (targets ltac2_dune) (deps (source_tree theories) (source_tree plugins) (source_tree user-contrib/Ltac2)) (action (with-stdout-to %{targets} (run tools/dune_rule_gen/gen_rules.exe Ltac2 user-contrib/Ltac2 %{env:COQ_DUNE_EXTRA_OPT=})))) ; Use summary.log as the target (alias (name runtest) (package coq) (deps test-suite/summary.log)) ; For make compat (alias (name all-src) (deps (source_tree user-contrib) (source_tree theories) (source_tree plugins))) ; (dirs (:standard _build_ci)) (documentation (package coq)) coq-8.20.0/dune-project000066400000000000000000000123631466560755400147340ustar00rootroot00000000000000(lang dune 3.6) (name coq) ; We use directory targets in documentation (using directory-targets 0.1) ; We need this due to `(coq.pp )` declarations (using coq 0.6) (formatting (enabled_for ocaml)) (generate_opam_files true) (license LGPL-2.1-only) (maintainers "The Coq development team ") (authors "The Coq development team, INRIA, CNRS, and contributors") ; This generates bug-reports and dev-repo (source (github coq/coq)) (homepage https://coq.inria.fr/) (documentation "https://coq.github.io/doc/") (version dev) ; Note that we use coq.opam.template to have dune add the correct opam ; prefix for configure; also note that we manually add the dune >= 3.6.1 ; dependency due a dune bug preventing Coq to build in ; 3.6.0. Dune adds `dune >= 3.6` automatically, based on `(lang dune 3.6)` ; above, but that's not enough. (package (name coq-core) (depends (dune (>= 3.6.1)) (ocaml (>= 4.09.0)) (ocamlfind (>= 1.8.1)) (zarith (>= 1.11)) (conf-linux-libc-dev (= :os "linux"))) (depopts coq-native memprof-limits memtrace) (synopsis "The Coq Proof Assistant -- Core Binaries and Tools") (description "Coq is a formal proof management system. It provides a formal language to write mathematical definitions, executable algorithms and theorems together with an environment for semi-interactive development of machine-checked proofs. Typical applications include the certification of properties of programming languages (e.g. the CompCert compiler certification project, or the Bedrock verified low-level programming library), the formalization of mathematics (e.g. the full formalization of the Feit-Thompson theorem or homotopy type theory) and teaching. This package includes the Coq core binaries, plugins, and tools, but not the vernacular standard library. Note that in this setup, Coq needs to be started with the -boot and -noinit options, as will otherwise fail to find the regular Coq prelude, now living in the coq-stdlib package.")) (package (name coq-stdlib) (depends (coq-core (= :version))) (depopts coq-native) (synopsis "The Coq Proof Assistant -- Standard Library") (description "Coq is a formal proof management system. It provides a formal language to write mathematical definitions, executable algorithms and theorems together with an environment for semi-interactive development of machine-checked proofs. Typical applications include the certification of properties of programming languages (e.g. the CompCert compiler certification project, or the Bedrock verified low-level programming library), the formalization of mathematics (e.g. the full formalization of the Feit-Thompson theorem or homotopy type theory) and teaching. This package includes the Coq Standard Library, that is to say, the set of modules usually bound to the Coq.* namespace.")) (package (name coqide-server) (depends (coq-core (= :version))) (synopsis "The Coq Proof Assistant, XML protocol server") (description "Coq is a formal proof management system. It provides a formal language to write mathematical definitions, executable algorithms and theorems together with an environment for semi-interactive development of machine-checked proofs. This package provides the `coqidetop` language server, an implementation of Coq's [XML protocol](https://github.com/coq/coq/blob/master/dev/doc/xml-protocol.md) which allows clients, such as CoqIDE, to interact with Coq in a structured way.")) (package (name coqide) (depends (ocamlfind :build) (conf-findutils :build) conf-adwaita-icon-theme (coqide-server (= :version)) (cairo2 (>= 0.6.4)) (lablgtk3-sourceview3 (and (>= 3.1.2) (or (>= 3.1.5) (<> :os "windows"))))) (synopsis "The Coq Proof Assistant --- GTK3 IDE") (description "Coq is a formal proof management system. It provides a formal language to write mathematical definitions, executable algorithms and theorems together with an environment for semi-interactive development of machine-checked proofs. This package provides the CoqIDE, a graphical user interface for the development of interactive proofs.")) (package (name coq-doc) (license "OPUBL-1.0") (depends (conf-python-3 :build) (coq (and :build (= :version)))) (synopsis "The Coq Proof Assistant --- Reference Manual") (description "Coq is a formal proof management system. It provides a formal language to write mathematical definitions, executable algorithms and theorems together with an environment for semi-interactive development of machine-checked proofs. This package provides the Coq Reference Manual.")) (package (name coq) (depends (coq-core (= :version)) (coq-stdlib (= :version)) (coqide-server (= :version)) (ounit2 :with-test) (conf-python-3 :with-test) (conf-time :with-test)) (synopsis "The Coq Proof Assistant") (description "Coq is a formal proof management system. It provides a formal language to write mathematical definitions, executable algorithms and theorems together with an environment for semi-interactive development of machine-checked proofs. Typical applications include the certification of properties of programming languages (e.g. the CompCert compiler certification project, or the Bedrock verified low-level programming library), the formalization of mathematics (e.g. the full formalization of the Feit-Thompson theorem or homotopy type theory) and teaching.")) coq-8.20.0/engine/000077500000000000000000000000001466560755400136525ustar00rootroot00000000000000coq-8.20.0/engine/dune000066400000000000000000000002761466560755400145350ustar00rootroot00000000000000(library (name engine) (synopsis "Coq's Tactic Engine") (public_name coq-core.engine) (wrapped false) ; until ocaml/dune#4892 fixed ; (private_modules univSubst) (libraries library)) coq-8.20.0/engine/eConstr.ml000066400000000000000000001265231466560755400156320ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* Id.equal id id' | _ -> false let isRelN sigma n c = match kind sigma c with Rel n' -> Int.equal n n' | _ -> false let isRef sigma c = match kind sigma c with | Const _ | Ind _ | Construct _ | Var _ -> true | _ -> false let isRefX env sigma x c = let open GlobRef in match x, kind sigma c with | ConstRef c, Const (c', _) -> Environ.QConstant.equal env c c' | IndRef i, Ind (i', _) -> Environ.QInd.equal env i i' | ConstructRef i, Construct (i', _) -> Environ.QConstruct.equal env i i' | VarRef id, Var id' -> Id.equal id id' | _ -> false let is_lib_ref env sigma x c = match Coqlib.lib_ref_opt x with | Some x -> isRefX env sigma x c | None -> false let destRel sigma c = match kind sigma c with | Rel p -> p | _ -> raise DestKO let destVar sigma c = match kind sigma c with | Var p -> p | _ -> raise DestKO let destInd sigma c = match kind sigma c with | Ind p -> p | _ -> raise DestKO let destEvar sigma c = match kind sigma c with | Evar p -> p | _ -> raise DestKO let destMeta sigma c = match kind sigma c with | Meta p -> p | _ -> raise DestKO let destSort sigma c = match kind sigma c with | Sort p -> p | _ -> raise DestKO let destCast sigma c = match kind sigma c with | Cast (c, k, t) -> (c, k, t) | _ -> raise DestKO let destApp sigma c = match kind sigma c with | App (f, a) -> (f, a) | _ -> raise DestKO let destLambda sigma c = match kind sigma c with | Lambda (na, t, c) -> (na, t, c) | _ -> raise DestKO let destLetIn sigma c = match kind sigma c with | LetIn (na, b, t, c) -> (na, b, t, c) | _ -> raise DestKO let destProd sigma c = match kind sigma c with | Prod (na, t, c) -> (na, t, c) | _ -> raise DestKO let destConst sigma c = match kind sigma c with | Const p -> p | _ -> raise DestKO let destConstruct sigma c = match kind sigma c with | Construct p -> p | _ -> raise DestKO let destFix sigma c = match kind sigma c with | Fix p -> p | _ -> raise DestKO let destCoFix sigma c = match kind sigma c with | CoFix p -> p | _ -> raise DestKO let destCase sigma c = match kind sigma c with | Case (ci, u, pms, t, iv, c, p) -> (ci, u, pms, t, iv, c, p) | _ -> raise DestKO let destProj sigma c = match kind sigma c with | Proj (p, r, c) -> (p, r, c) | _ -> raise DestKO let destRef sigma c = let open GlobRef in match kind sigma c with | Var x -> VarRef x, EInstance.empty | Const (c,u) -> ConstRef c, u | Ind (ind,u) -> IndRef ind, u | Construct (c,u) -> ConstructRef c, u | _ -> raise DestKO let decompose_app sigma c = match kind sigma c with | App (f,cl) -> (f, cl) | _ -> (c,[||]) let decompose_app_list sigma c = match kind sigma c with | App (f,cl) -> (f, Array.to_list cl) | _ -> (c,[]) let decompose_lambda sigma c = let rec lamdec_rec l c = match kind sigma c with | Lambda (x,t,c) -> lamdec_rec ((x,t)::l) c | Cast (c,_,_) -> lamdec_rec l c | _ -> l,c in lamdec_rec [] c let decompose_lambda_decls sigma c = let open Rel.Declaration in let rec lamdec_rec l c = match kind sigma c with | Lambda (x,t,c) -> lamdec_rec (Context.Rel.add (LocalAssum (x,t)) l) c | LetIn (x,b,t,c) -> lamdec_rec (Context.Rel.add (LocalDef (x,b,t)) l) c | Cast (c,_,_) -> lamdec_rec l c | _ -> l,c in lamdec_rec Context.Rel.empty c let decompose_lambda_n sigma n = if n < 0 then anomaly Pp.(str "decompose_lambda_n: integer parameter must be positive"); let rec lamdec_rec l n c = if Int.equal n 0 then (l, c) else match kind sigma c with | Lambda (x, t, c) -> lamdec_rec ((x, t) :: l) (n - 1) c | Cast (c, _, _) -> lamdec_rec l n c | _ -> anomaly Pp.(str "decompose_lambda_n: not enough abstractions") in lamdec_rec [] n let decompose_lambda_n_assum sigma n c = let open Rel.Declaration in if n < 0 then anomaly Pp.(str "decompose_lambda_n_assum: integer parameter must be positive."); let rec lamdec_rec l n c = if Int.equal n 0 then l,c else match kind sigma c with | Lambda (x,t,c) -> lamdec_rec (Context.Rel.add (LocalAssum (x,t)) l) (n-1) c | LetIn (x,b,t,c) -> lamdec_rec (Context.Rel.add (LocalDef (x,b,t)) l) n c | Cast (c,_,_) -> lamdec_rec l n c | c -> anomaly Pp.(str "decompose_lambda_n_assum: not enough abstractions.") in lamdec_rec Context.Rel.empty n c let decompose_lambda_n_decls sigma n = let open Rel.Declaration in if n < 0 then anomaly Pp.(str "decompose_lambda_n_decls: integer parameter must be positive."); let rec lamdec_rec l n c = if Int.equal n 0 then l,c else match kind sigma c with | Lambda (x,t,c) -> lamdec_rec (Context.Rel.add (LocalAssum (x,t)) l) (n-1) c | LetIn (x,b,t,c) -> lamdec_rec (Context.Rel.add (LocalDef (x,b,t)) l) (n-1) c | Cast (c,_,_) -> lamdec_rec l n c | c -> anomaly Pp.(str "decompose_lambda_n_decls: not enough abstractions.") in lamdec_rec Context.Rel.empty n let rec to_lambda sigma n prod = if Int.equal n 0 then prod else match kind sigma prod with | Prod (na,ty,bd) -> mkLambda (na,ty,to_lambda sigma (n-1) bd) | Cast (c,_,_) -> to_lambda sigma n c | _ -> anomaly Pp.(str "Not enough products.") let decompose_prod sigma c = let rec proddec_rec l c = match kind sigma c with | Prod (x,t,c) -> proddec_rec ((x,t)::l) c | Cast (c,_,_) -> proddec_rec l c | _ -> l,c in proddec_rec [] c let decompose_prod_n sigma n = if n < 0 then anomaly Pp.(str "decompose_prod_n: integer parameter must be positive"); let rec proddec_rec l n c = if Int.equal n 0 then (l, c) else match kind sigma c with | Prod (x, t, c) -> proddec_rec ((x, t) :: l) (n - 1) c | Cast (c, _, _) -> proddec_rec l n c | _ -> anomaly Pp.(str "decompose_prod_n: not enough products") in proddec_rec [] n let decompose_prod_decls sigma c = let open Rel.Declaration in let rec proddec_rec l c = match kind sigma c with | Prod (x,t,c) -> proddec_rec (Context.Rel.add (LocalAssum (x,t)) l) c | LetIn (x,b,t,c) -> proddec_rec (Context.Rel.add (LocalDef (x,b,t)) l) c | Cast (c,_,_) -> proddec_rec l c | _ -> l,c in proddec_rec Context.Rel.empty c let decompose_prod_n_decls sigma n c = let open Rel.Declaration in if n < 0 then anomaly Pp.(str "decompose_prod_n_decls: integer parameter must be positive."); let rec prodec_rec l n c = if Int.equal n 0 then l,c else match kind sigma c with | Prod (x,t,c) -> prodec_rec (Context.Rel.add (LocalAssum (x,t)) l) (n-1) c | LetIn (x,b,t,c) -> prodec_rec (Context.Rel.add (LocalDef (x,b,t)) l) (n-1) c | Cast (c,_,_) -> prodec_rec l n c | c -> anomaly Pp.(str "decompose_prod_n_decls: not enough assumptions.") in prodec_rec Context.Rel.empty n c let prod_decls sigma t = fst (decompose_prod_decls sigma t) let existential_type = Evd.existential_type let lift n c = of_constr (Vars.lift n (unsafe_to_constr c)) let of_branches : Constr.case_branch array -> case_branch array = match Evd.MiniEConstr.(unsafe_eq, unsafe_relevance_eq) with | Refl, Refl -> fun x -> x let unsafe_to_branches : case_branch array -> Constr.case_branch array = match Evd.MiniEConstr.(unsafe_eq, unsafe_relevance_eq) with | Refl, Refl -> fun x -> x let of_return : Constr.case_return -> case_return = match Evd.MiniEConstr.(unsafe_eq, unsafe_relevance_eq) with | Refl, Refl -> fun x -> x let unsafe_to_return : case_return -> Constr.case_return = match Evd.MiniEConstr.(unsafe_eq, unsafe_relevance_eq) with | Refl, Refl -> fun x -> x let of_binder_annot : 'a Constr.binder_annot -> 'a binder_annot = match Evd.MiniEConstr.unsafe_relevance_eq with | Refl -> fun x -> x let to_binder_annot sigma x = Context.map_annot_relevance (ERelevance.kind sigma) x let to_rel_decl sigma d = Context.Rel.Declaration.map_constr_het (ERelevance.kind sigma) (to_constr sigma) d let to_rel_context sigma ctx = List.map (to_rel_decl sigma) ctx let to_named_decl sigma d = Context.Named.Declaration.map_constr_het (ERelevance.kind sigma) (to_constr sigma) d let to_named_context sigma ctx = List.map (to_named_decl sigma) ctx let map_branches f br = let f c = unsafe_to_constr (f (of_constr c)) in of_branches (Constr.map_branches f (unsafe_to_branches br)) let map_return_predicate f p = let f c = unsafe_to_constr (f (of_constr c)) in of_return (Constr.map_return_predicate f (unsafe_to_return p)) let map_instance sigma f evk args = let rec map ctx args = match ctx, SList.view args with | [], None -> SList.empty | decl :: ctx, Some (Some c, rem) -> let c' = f c in let rem' = map ctx rem in if c' == c && rem' == rem then args else if Constr.isVarId (NamedDecl.get_id decl) c' then SList.default rem' else SList.cons c' rem' | decl :: ctx, Some (None, rem) -> let c = Constr.mkVar (NamedDecl.get_id decl) in let c' = f c in let rem' = map ctx rem in if c' == c && rem' == rem then args else SList.cons c' rem' | [], Some _ | _ :: _, None -> assert false in let EvarInfo evi = Evd.find sigma evk in let ctx = Evd.evar_filtered_context evi in map ctx args let map sigma f c = let f c = unsafe_to_constr (f (of_constr c)) in let c = unsafe_to_constr @@ whd_evar sigma c in match Constr.kind c with | Evar (evk, args) -> let args' = map_instance sigma f evk args in if args' == args then of_constr c else of_constr @@ Constr.mkEvar (evk, args') | _ -> of_constr (Constr.map f c) let map_with_binders sigma g f l c = let f l c = unsafe_to_constr (f l (of_constr c)) in let c = unsafe_to_constr @@ whd_evar sigma c in match Constr.kind c with | Evar (evk, args) -> let args' = map_instance sigma (fun c -> f l c) evk args in if args' == args then of_constr c else of_constr @@ Constr.mkEvar (evk, args') | _ -> of_constr (Constr.map_with_binders g f l c) let map_existential sigma f ((evk, args) as ev : existential) = let f c = unsafe_to_constr (f (of_constr c)) in let args : Constr.t SList.t = match Evd.MiniEConstr.unsafe_eq with Refl -> args in let args' = map_instance sigma f evk args in if args' == args then ev else let args' : t SList.t = match Evd.MiniEConstr.unsafe_eq with Refl -> args' in (evk, args') let iter sigma f c = let f c = f (of_constr c) in let c = unsafe_to_constr @@ whd_evar sigma c in match Constr.kind c with | Evar ((evk, _) as ev) -> let args = Evd.expand_existential0 sigma ev in List.iter (fun c -> f c) args | _ -> Constr.iter f c let expand_case env _sigma (ci, u, pms, p, iv, c, bl) = let u = EInstance.unsafe_to_instance u in let pms = unsafe_to_constr_array pms in let p = unsafe_to_return p in let iv = unsafe_to_case_invert iv in let c = unsafe_to_constr c in let bl = unsafe_to_branches bl in let (ci, (p,r), iv, c, bl) = Inductive.expand_case env (ci, u, pms, p, iv, c, bl) in let p = of_constr p in let r = ERelevance.make r in let c = of_constr c in let iv = of_case_invert iv in let bl = of_constr_array bl in (ci, (p,r), iv, c, bl) let annotate_case env sigma (ci, u, pms, p, iv, c, bl as case) = let (_, (p,r), _, _, bl) = expand_case env sigma case in let p = (* Too bad we need to fetch this data in the environment, should be in the case_info instead. *) let (_, mip) = Inductive.lookup_mind_specif env ci.ci_ind in decompose_lambda_n_decls sigma (mip.Declarations.mind_nrealdecls + 1) p in let mk_br c n = decompose_lambda_n_decls sigma n c in let bl = Array.map2 mk_br bl ci.ci_cstr_ndecls in (ci, u, pms, (p,r), iv, c, bl) let expand_branch env _sigma u pms (ind, i) (nas, _br) = let open Declarations in let u = EInstance.unsafe_to_instance u in let pms = unsafe_to_constr_array pms in let (mib, mip) = Inductive.lookup_mind_specif env ind in let paramdecl = Vars.subst_instance_context u mib.mind_params_ctxt in let paramsubst = Vars.subst_of_rel_context_instance paramdecl pms in let (ctx, _) = mip.mind_nf_lc.(i - 1) in let (ctx, _) = List.chop mip.mind_consnrealdecls.(i - 1) ctx in let nas = let gen : type a b. (a,b) eq -> (_,a) Context.pbinder_annot array -> (_,b) Context.pbinder_annot array = fun Refl x -> x in gen unsafe_relevance_eq nas in let ans = Inductive.instantiate_context u paramsubst nas ctx in let ans : rel_context = match Evd.MiniEConstr.(unsafe_eq, unsafe_relevance_eq) with | Refl, Refl -> ans in ans let contract_case env _sigma (ci, (p,r), iv, c, bl) = let p = unsafe_to_constr p in let r = ERelevance.unsafe_to_relevance r in let iv = unsafe_to_case_invert iv in let c = unsafe_to_constr c in let bl = unsafe_to_constr_array bl in let (ci, u, pms, p, iv, c, bl) = Inductive.contract_case env (ci, (p,r), iv, c, bl) in let u = EInstance.make u in let pms = of_constr_array pms in let p = of_return p in let iv = of_case_invert iv in let c = of_constr c in let bl = of_branches bl in (ci, u, pms, p, iv, c, bl) let iter_with_full_binders env sigma g f n c = let open Context.Rel.Declaration in match kind sigma c with | (Rel _ | Meta _ | Var _ | Sort _ | Const _ | Ind _ | Construct _ | Int _ | Float _ | String _) -> () | Cast (c,_,t) -> f n c; f n t | Prod (na,t,c) -> f n t; f (g (LocalAssum (na, t)) n) c | Lambda (na,t,c) -> f n t; f (g (LocalAssum (na, t)) n) c | LetIn (na,b,t,c) -> f n b; f n t; f (g (LocalDef (na, b, t)) n) c | App (c,l) -> f n c; Array.Fun1.iter f n l | Evar ((_,l) as ev) -> let l = Evd.expand_existential sigma ev in List.iter (fun c -> f n c) l | Case (ci,u,pms,p,iv,c,bl) -> let (ci, _, pms, (p,_), iv, c, bl) = annotate_case env sigma (ci, u, pms, p, iv, c, bl) in let f_ctx (ctx, c) = f (List.fold_right g ctx n) c in Array.Fun1.iter f n pms; f_ctx p; iter_invert (f n) iv; f n c; Array.iter f_ctx bl | Proj (_,_,c) -> f n c | Fix (_,(lna,tl,bl)) -> Array.iter (f n) tl; let n' = Array.fold_left2_i (fun i n na t -> g (LocalAssum (na, lift i t)) n) n lna tl in Array.iter (f n') bl | CoFix (_,(lna,tl,bl)) -> Array.iter (f n) tl; let n' = Array.fold_left2_i (fun i n na t -> g (LocalAssum (na,lift i t)) n) n lna tl in Array.iter (f n') bl | Array (_u,t,def,ty) -> Array.Fun1.iter f n t; f n def; f n ty let iter_with_binders sigma g f n c = let f l c = f l (of_constr c) in let c = unsafe_to_constr @@ whd_evar sigma c in match Constr.kind c with | Evar ((evk, _) as ev) -> let args = Evd.expand_existential0 sigma ev in List.iter (fun c -> f n c) args | _ -> Constr.iter_with_binders g f n c let fold sigma f acc c = let f acc c = f acc (of_constr c) in let c = unsafe_to_constr @@ whd_evar sigma c in match Constr.kind c with | Evar ((evk, _) as ev) -> let args = Evd.expand_existential0 sigma ev in List.fold_left f acc args | _ -> Constr.fold f acc c let fold_with_binders sigma g f e acc c = let f e acc c = f e acc (of_constr c) in let c = unsafe_to_constr @@ whd_evar sigma c in match Constr.kind c with | Evar ((evk, _) as ev) -> let args = Evd.expand_existential0 sigma ev in List.fold_left (fun acc c -> f e acc c) acc args | _ -> Constr.fold_constr_with_binders g f e acc c let compare_gen k eq_inst eq_sort eq_constr eq_evars nargs c1 c2 = (c1 == c2) || Constr.compare_head_gen_with k k eq_inst eq_sort eq_constr eq_evars nargs c1 c2 let eq_existential sigma eq (evk1, args1) (evk2, args2) = if Evar.equal evk1 evk2 then let args1 = Evd.expand_existential sigma (evk1, args1) in let args2 = Evd.expand_existential sigma (evk2, args2) in List.equal eq args1 args2 else false let eq_constr sigma c1 c2 = let kind c = kind sigma c in let eq_inst _ i1 i2 = EInstance.equal sigma i1 i2 in let eq_sorts s1 s2 = ESorts.equal sigma s1 s2 in let eq_existential eq e1 e2 = eq_existential sigma (eq 0) e1 e2 in let rec eq_constr nargs c1 c2 = compare_gen kind eq_inst eq_sorts (eq_existential eq_constr) eq_constr nargs c1 c2 in eq_constr 0 c1 c2 let eq_constr_nounivs sigma c1 c2 = let kind c = kind sigma c in let eq_existential eq e1 e2 = eq_existential sigma (eq 0) e1 e2 in let rec eq_constr nargs c1 c2 = compare_gen kind (fun _ _ _ -> true) (fun _ _ -> true) (eq_existential eq_constr) eq_constr nargs c1 c2 in eq_constr 0 c1 c2 let compare_constr sigma cmp c1 c2 = let kind c = kind sigma c in let eq_inst _ i1 i2 = EInstance.equal sigma i1 i2 in let eq_sorts s1 s2 = ESorts.equal sigma s1 s2 in let eq_existential eq e1 e2 = eq_existential sigma (eq 0) e1 e2 in let cmp nargs c1 c2 = cmp c1 c2 in compare_gen kind eq_inst eq_sorts (eq_existential cmp) cmp 0 c1 c2 let cmp_inductives cv_pb (mind,ind as spec) nargs u1 u2 cstrs = let open UnivProblem in match mind.Declarations.mind_variance with | None -> enforce_eq_instances_univs false u1 u2 cstrs | Some variances -> let num_param_arity = Conversion.inductive_cumulativity_arguments spec in if not (Int.equal num_param_arity nargs) then enforce_eq_instances_univs false u1 u2 cstrs else compare_cumulative_instances cv_pb variances u1 u2 cstrs let cmp_constructors (mind, ind, cns as spec) nargs u1 u2 cstrs = let open UnivProblem in match mind.Declarations.mind_variance with | None -> enforce_eq_instances_univs false u1 u2 cstrs | Some _ -> let num_cnstr_args = Conversion.constructor_cumulativity_arguments spec in if not (Int.equal num_cnstr_args nargs) then enforce_eq_instances_univs false u1 u2 cstrs else let qs1, us1 = UVars.Instance.to_array u1 and qs2, us2 = UVars.Instance.to_array u2 in let cstrs = enforce_eq_qualities qs1 qs2 cstrs in Array.fold_left2 (fun cstrs u1 u2 -> UnivProblem.(Set.add (UWeak (u1,u2)) cstrs)) cstrs us1 us2 let eq_universes env sigma cstrs cv_pb refargs l l' = if EInstance.is_empty l then (assert (EInstance.is_empty l'); true) else let l = EInstance.kind sigma l and l' = EInstance.kind sigma l' in let open GlobRef in let open UnivProblem in match refargs with | Some (ConstRef c, 1) when Environ.is_array_type env c -> cstrs := compare_cumulative_instances cv_pb [|UVars.Variance.Irrelevant|] l l' !cstrs; true | None | Some (ConstRef _, _) -> cstrs := enforce_eq_instances_univs true l l' !cstrs; true | Some (VarRef _, _) -> assert false (* variables don't have instances *) | Some (IndRef ind, nargs) -> let mind = Environ.lookup_mind (fst ind) env in cstrs := cmp_inductives cv_pb (mind,snd ind) nargs l l' !cstrs; true | Some (ConstructRef ((mi,ind),ctor), nargs) -> let mind = Environ.lookup_mind mi env in cstrs := cmp_constructors (mind,ind,ctor) nargs l l' !cstrs; true let test_constr_universes env sigma leq ?(nargs=0) m n = let open UnivProblem in let kind c = kind sigma c in if m == n then Some Set.empty else let cstrs = ref Set.empty in let cv_pb = if leq then Conversion.CUMUL else Conversion.CONV in let eq_universes refargs l l' = eq_universes env sigma cstrs Conversion.CONV refargs l l' and leq_universes refargs l l' = eq_universes env sigma cstrs cv_pb refargs l l' in let eq_sorts s1 s2 = let s1 = ESorts.kind sigma s1 in let s2 = ESorts.kind sigma s2 in if Sorts.equal s1 s2 then true else (cstrs := Set.add (UEq (s1, s2)) !cstrs; true) in let leq_sorts s1 s2 = let s1 = ESorts.kind sigma s1 in let s2 = ESorts.kind sigma s2 in if Sorts.equal s1 s2 then true else (cstrs := Set.add (ULe (s1, s2)) !cstrs; true) in let eq_existential eq e1 e2 = eq_existential sigma (eq 0) e1 e2 in let rec eq_constr' nargs m n = compare_gen kind eq_universes eq_sorts (eq_existential eq_constr') eq_constr' nargs m n in let res = if leq then let rec compare_leq nargs m n = Constr.compare_head_gen_leq_with kind kind leq_universes leq_sorts (eq_existential eq_constr') eq_constr' leq_constr' nargs m n and leq_constr' nargs m n = m == n || compare_leq nargs m n in compare_leq nargs m n else Constr.compare_head_gen_with kind kind eq_universes eq_sorts (eq_existential eq_constr') eq_constr' nargs m n in if res then Some !cstrs else None let eq_constr_universes env sigma ?nargs m n = test_constr_universes env sigma false ?nargs m n let leq_constr_universes env sigma ?nargs m n = test_constr_universes env sigma true ?nargs m n let compare_head_gen_proj env sigma equ eqs eqev eqc' nargs m n = let kind c = kind sigma c in match kind m, kind n with | Proj (p, _, c), App (f, args) | App (f, args), Proj (p, _, c) -> (match kind f with | Const (p', u) when Environ.QConstant.equal env (Projection.constant p) p' -> let npars = Projection.npars p in if Array.length args == npars + 1 then eqc' 0 c args.(npars) else false | _ -> false) | _ -> Constr.compare_head_gen_with kind kind equ eqs eqev eqc' nargs m n let eq_constr_universes_proj env sigma m n = let open UnivProblem in if m == n then Some Set.empty else let cstrs = ref Set.empty in let eq_universes ref l l' = eq_universes env sigma cstrs Conversion.CONV ref l l' in let eq_sorts s1 s2 = let s1 = ESorts.kind sigma s1 in let s2 = ESorts.kind sigma s2 in if Sorts.equal s1 s2 then true else (cstrs := Set.add (UEq (s1, s2)) !cstrs; true) in let eq_existential eq e1 e2 = eq_existential sigma (eq 0) e1 e2 in let rec eq_constr' nargs m n = m == n || compare_head_gen_proj env sigma eq_universes eq_sorts (eq_existential eq_constr') eq_constr' nargs m n in let res = eq_constr' 0 m n in if res then Some !cstrs else None let add_universes_of_instance sigma (qs,us) u = let u = EInstance.kind sigma u in let qs', us' = UVars.Instance.levels u in let qs = Sorts.Quality.(Set.fold (fun q qs -> match q with | QVar q -> Sorts.QVar.Set.add q qs | QConstant _ -> qs) qs' qs) in qs, Univ.Level.Set.union us us' let fold_annot_relevance f acc na = f acc na.Context.binder_relevance let fold_case_under_context_relevance f acc (nas,_) = Array.fold_left (fold_annot_relevance f) acc nas let fold_rec_declaration_relevance f acc (nas,_,_) = Array.fold_left (fold_annot_relevance f) acc nas let fold_constr_relevance sigma f acc c = match kind sigma c with | Rel _ | Var _ | Meta _ | Evar _ | Sort _ | Cast _ | App _ | Const _ | Ind _ | Construct _ | Proj _ | Int _ | Float _ | String _ | Array _ -> acc | Prod (na,_,_) | Lambda (na,_,_) | LetIn (na,_,_,_) -> fold_annot_relevance f acc na | Case (_,_u,_params,(ret,r),_iv,_v,brs) -> let acc = f acc r in let acc = fold_case_under_context_relevance f acc ret in let acc = CArray.fold_left (fold_case_under_context_relevance f) acc brs in acc | Fix (_,data) | CoFix (_,data) -> fold_rec_declaration_relevance f acc data let add_relevance sigma (qs,us as v) r = let open Sorts in (* NB this normalizes above_prop to Relevant which makes it disappear *) match ERelevance.kind sigma r with | Irrelevant | Relevant -> v | RelevanceVar q -> QVar.Set.add q qs, us let universes_of_constr sigma c = let open Univ in let rec aux s c = let s = fold_constr_relevance sigma (add_relevance sigma) s c in match kind sigma c with | Const (_, u) | Ind (_, u) | Construct (_,u) -> add_universes_of_instance sigma s u | Sort u -> begin match ESorts.kind sigma u with | Type u -> Util.on_snd (Level.Set.fold Level.Set.add (Universe.levels u)) s | QSort (q, u) -> let qs, us = s in Sorts.QVar.Set.add q qs, Level.Set.union us (Universe.levels u) | SProp | Prop | Set -> s end | Evar (k, args) -> let concl = Evd.evar_concl (Evd.find_undefined sigma k) in fold sigma aux (aux s concl) c | Array (u,_,_,_) -> let s = add_universes_of_instance sigma s u in fold sigma aux s c | Case (_,u,_,_,_,_,_) -> let s = add_universes_of_instance sigma s u in fold sigma aux s c | _ -> fold sigma aux s c in aux (Sorts.QVar.Set.empty,Level.Set.empty) c open Context open Environ let cast_list : type a b. (a,b) eq -> a list -> b list = fun Refl x -> x let cast_vect : type a b. (a,b) eq -> a array -> b array = fun Refl x -> x let cast_rel_decl : type a b c d. (a,b) eq -> (c,d) eq -> (a, a, c) Rel.Declaration.pt -> (b, b, d) Rel.Declaration.pt = fun Refl Refl x -> x let cast_rel_context : type a b c d. (a,b) eq -> (c,d) eq -> (a, a, c) Rel.pt -> (b, b, d) Rel.pt = fun Refl Refl x -> x let cast_rec_decl : type a b c d. (a,b) eq -> (c,d) eq -> (a, a, c) Constr.prec_declaration -> (b, b, d) Constr.prec_declaration = fun Refl Refl x -> x let cast_named_decl : type a b c d. (a,b) eq -> (c,d) eq -> (a, a, c) Named.Declaration.pt -> (b, b, d) Named.Declaration.pt = fun Refl Refl x -> x let cast_named_context : type a b c d. (a,b) eq -> (c,d) eq -> (a, a, c) Named.pt -> (b, b, d) Named.pt = fun Refl Refl x -> x module Vars = struct exception LocalOccur let to_constr = unsafe_to_constr let to_rel_decl = unsafe_to_rel_decl type instance = t array type instance_list = t list type substl = t list (** Operations that commute with evar-normalization *) let lift = lift let liftn n m c = of_constr (Vars.liftn n m (to_constr c)) let substnl subst n c = of_constr (Vars.substnl (cast_list unsafe_eq subst) n (to_constr c)) let substl subst c = of_constr (Vars.substl (cast_list unsafe_eq subst) (to_constr c)) let subst1 c r = of_constr (Vars.subst1 (to_constr c) (to_constr r)) let substnl_decl subst n d = of_rel_decl (Vars.substnl_decl (cast_list unsafe_eq subst) n (to_rel_decl d)) let substl_decl subst d = of_rel_decl (Vars.substl_decl (cast_list unsafe_eq subst) (to_rel_decl d)) let subst1_decl c d = of_rel_decl (Vars.subst1_decl (to_constr c) (to_rel_decl d)) type substituend = Vars.substituend let make_substituend c = Vars.make_substituend (unsafe_to_constr c) let lift_substituend n s = of_constr (Vars.lift_substituend n s) let replace_vars = replace_vars (* (subst_var str t) substitute (Var str) by (Rel 1) in t *) let subst_var sigma str t = replace_vars sigma [(str, mkRel 1)] t (* (subst_vars [id1;...;idn] t) substitute (Var idj) by (Rel j) in t *) let substn_vars sigma p vars c = let _,subst = List.fold_left (fun (n,l) var -> ((n+1),(var, mkRel n)::l)) (p,[]) vars in replace_vars sigma (List.rev subst) c let subst_vars sigma subst c = substn_vars sigma 1 subst c let subst_univs_level_constr subst c = of_constr (Vars.subst_univs_level_constr subst (to_constr c)) let subst_instance_context subst ctx = let subst = EInstance.unsafe_to_instance subst in cast_rel_context (sym unsafe_eq) (sym unsafe_relevance_eq) (Vars.subst_instance_context subst (cast_rel_context unsafe_eq unsafe_relevance_eq ctx)) let subst_instance_constr subst c = let subst = EInstance.unsafe_to_instance subst in of_constr (Vars.subst_instance_constr subst (to_constr c)) let subst_instance_relevance subst r = let subst = EInstance.unsafe_to_instance subst in let r = ERelevance.unsafe_to_relevance r in let r = UVars.subst_instance_relevance subst r in ERelevance.make r (** Operations that dot NOT commute with evar-normalization *) let noccurn sigma n term = let rec occur_rec n c = match kind sigma c with | Rel m -> if Int.equal m n then raise LocalOccur | Evar (_, l) -> SList.Skip.iter (fun c -> occur_rec n c) l | _ -> iter_with_binders sigma succ occur_rec n c in try occur_rec n term; true with LocalOccur -> false let noccur_between sigma n m term = let rec occur_rec n c = match kind sigma c with | Rel p -> if n<=p && p SList.Skip.iter (fun c -> occur_rec n c) l | _ -> iter_with_binders sigma succ occur_rec n c in try occur_rec n term; true with LocalOccur -> false let closedn sigma n c = let rec closed_rec n c = match kind sigma c with | Rel m -> if m>n then raise LocalOccur | Evar (_, l) -> SList.Skip.iter (fun c -> closed_rec n c) l | _ -> iter_with_binders sigma succ closed_rec n c in try closed_rec n c; true with LocalOccur -> false let closed0 sigma c = closedn sigma 0 c let subst_of_rel_context_instance ctx subst = cast_list (sym unsafe_eq) (Vars.subst_of_rel_context_instance (cast_rel_context unsafe_eq unsafe_relevance_eq ctx) (cast_vect unsafe_eq subst)) let subst_of_rel_context_instance_list ctx subst = cast_list (sym unsafe_eq) (Vars.subst_of_rel_context_instance_list (cast_rel_context unsafe_eq unsafe_relevance_eq ctx) (cast_list unsafe_eq subst)) let liftn_rel_context n k ctx = cast_rel_context (sym unsafe_eq) (sym unsafe_relevance_eq) (Vars.liftn_rel_context n k (cast_rel_context unsafe_eq unsafe_relevance_eq ctx)) let lift_rel_context n ctx = cast_rel_context (sym unsafe_eq) (sym unsafe_relevance_eq) (Vars.lift_rel_context n (cast_rel_context unsafe_eq unsafe_relevance_eq ctx)) let substnl_rel_context subst n ctx = cast_rel_context (sym unsafe_eq) (sym unsafe_relevance_eq) (Vars.substnl_rel_context (cast_list unsafe_eq subst) n (cast_rel_context unsafe_eq unsafe_relevance_eq ctx)) let substl_rel_context subst ctx = cast_rel_context (sym unsafe_eq) (sym unsafe_relevance_eq) (Vars.substl_rel_context (cast_list unsafe_eq subst) (cast_rel_context unsafe_eq unsafe_relevance_eq ctx)) let smash_rel_context ctx = cast_rel_context (sym unsafe_eq) (sym unsafe_relevance_eq) (Vars.smash_rel_context (cast_rel_context unsafe_eq unsafe_relevance_eq ctx)) let esubst : (int -> 'a -> t) -> 'a Esubst.subs -> t -> t = match unsafe_eq with | Refl -> Vars.esubst end (* Constructs either [forall x:t, c] or [let x:=b:t in c] *) let mkProd_or_LetIn decl c = let open Context.Rel.Declaration in match decl with | LocalAssum (na,t) -> mkProd (na, t, c) | LocalDef (na,b,t) -> mkLetIn (na, b, t, c) (* Constructs either [forall x:t, c] or [c] in which [x] is replaced by [b] *) let mkProd_wo_LetIn decl c = let open Context.Rel.Declaration in match decl with | LocalAssum (na,t) -> mkProd (na, t, c) | LocalDef (_,b,_) -> Vars.subst1 b c let mkLambda_or_LetIn decl c = let open Context.Rel.Declaration in match decl with | LocalAssum (na,t) -> mkLambda (na, t, c) | LocalDef (na,b,t) -> mkLetIn (na, b, t, c) let mkLambda_wo_LetIn decl c = let open Context.Rel.Declaration in match decl with | LocalAssum (na,t) -> mkLambda (na, t, c) | LocalDef (_,b,_) -> Vars.subst1 b c let mkNamedProd sigma id typ c = mkProd (map_annot Name.mk_name id, typ, Vars.subst_var sigma id.binder_name c) let mkNamedLambda sigma id typ c = mkLambda (map_annot Name.mk_name id, typ, Vars.subst_var sigma id.binder_name c) let mkNamedLetIn sigma id c1 t c2 = mkLetIn (map_annot Name.mk_name id, c1, t, Vars.subst_var sigma id.binder_name c2) let mkNamedProd_or_LetIn sigma decl c = let open Context.Named.Declaration in match decl with | LocalAssum (id,t) -> mkNamedProd sigma id t c | LocalDef (id,b,t) -> mkNamedLetIn sigma id b t c let mkNamedLambda_or_LetIn sigma decl c = let open Context.Named.Declaration in match decl with | LocalAssum (id,t) -> mkNamedLambda sigma id t c | LocalDef (id,b,t) -> mkNamedLetIn sigma id b t c let mkNamedProd_wo_LetIn sigma decl c = let open Context.Named.Declaration in match decl with | LocalAssum (id,t) -> mkNamedProd sigma id t c | LocalDef (id,b,t) -> Vars.subst1 b c let it_mkProd init = List.fold_left (fun c (n,t) -> mkProd (n, t, c)) init let it_mkLambda init = List.fold_left (fun c (n,t) -> mkLambda (n, t, c)) init let compose_lam l b = it_mkLambda b l let it_mkProd_or_LetIn t ctx = List.fold_left (fun c d -> mkProd_or_LetIn d c) t ctx let it_mkLambda_or_LetIn t ctx = List.fold_left (fun c d -> mkLambda_or_LetIn d c) t ctx let it_mkProd_wo_LetIn t ctx = List.fold_left (fun c d -> mkProd_wo_LetIn d c) t ctx let it_mkLambda_wo_LetIn t ctx = List.fold_left (fun c d -> mkLambda_wo_LetIn d c) t ctx let it_mkNamedProd_or_LetIn sigma t ctx = List.fold_left (fun c d -> mkNamedProd_or_LetIn sigma d c) t ctx let it_mkNamedLambda_or_LetIn sigma t ctx = List.fold_left (fun c d -> mkNamedLambda_or_LetIn sigma d c) t ctx let it_mkNamedProd_wo_LetIn sigma t ctx = List.fold_left (fun c d -> mkNamedProd_wo_LetIn sigma d c) t ctx let rec isArity sigma c = match kind sigma c with | Prod (_,_,c) -> isArity sigma c | LetIn (_,_,_,c) -> isArity sigma c | Cast (c,_,_) -> isArity sigma c | Sort _ -> true | _ -> false type arity = rel_context * ESorts.t let mkArity (ctx, s) = it_mkProd_or_LetIn (mkSort s) ctx let destArity sigma = let open Context.Rel.Declaration in let rec prodec_rec l c = match kind sigma c with | Prod (x,t,c) -> prodec_rec (LocalAssum (x,t) :: l) c | LetIn (x,b,t,c) -> prodec_rec (LocalDef (x,b,t) :: l) c | Cast (c,_,_) -> prodec_rec l c | Sort s -> l,s | _ -> anomaly ~label:"destArity" (Pp.str "not an arity.") in prodec_rec [] let push_rel d e = push_rel (cast_rel_decl unsafe_eq unsafe_relevance_eq d) e let push_rel_context d e = push_rel_context (cast_rel_context unsafe_eq unsafe_relevance_eq d) e let push_rec_types d e = push_rec_types (cast_rec_decl unsafe_eq unsafe_relevance_eq d) e let push_named d e = push_named (cast_named_decl unsafe_eq unsafe_relevance_eq d) e let push_named_context d e = push_named_context (cast_named_context unsafe_eq unsafe_relevance_eq d) e let push_named_context_val d e = push_named_context_val (cast_named_decl unsafe_eq unsafe_relevance_eq d) e let rel_context e = cast_rel_context (sym unsafe_eq) (sym unsafe_relevance_eq) (rel_context e) let named_context e = cast_named_context (sym unsafe_eq) (sym unsafe_relevance_eq) (named_context e) let val_of_named_context e = val_of_named_context (cast_named_context unsafe_eq unsafe_relevance_eq e) let named_context_of_val e = cast_named_context (sym unsafe_eq) (sym unsafe_relevance_eq) (named_context_of_val e) let of_existential : Constr.existential -> existential = let gen : type a b. (a,b) eq -> 'c * b SList.t -> 'c * a SList.t = fun Refl x -> x in gen unsafe_eq let lookup_rel i e = cast_rel_decl (sym unsafe_eq) (sym unsafe_relevance_eq) (lookup_rel i e) let lookup_named n e = cast_named_decl (sym unsafe_eq) (sym unsafe_relevance_eq) (lookup_named n e) let lookup_named_val n e = cast_named_decl (sym unsafe_eq) (sym unsafe_relevance_eq) (lookup_named_ctxt n e) let map_rel_context_in_env f env sign = let rec aux env acc = function | d::sign -> aux (push_rel d env) (Context.Rel.Declaration.map_constr (f env) d :: acc) sign | [] -> acc in aux env [] (List.rev sign) let match_named_context_val : named_context_val -> (named_declaration * named_context_val) option = match unsafe_eq, unsafe_relevance_eq with | Refl, Refl -> match_named_context_val let identity_subst_val : named_context_val -> t SList.t = fun ctx -> SList.defaultn (List.length ctx.Environ.env_named_ctx) SList.empty let fresh_global ?loc ?rigid ?names env sigma reference = let (evd,t) = Evd.fresh_global ?loc ?rigid ?names env sigma reference in evd, t let is_global = isRefX (** Kind of type *) type kind_of_type = | SortType of ESorts.t | CastType of types * t | ProdType of Name.t binder_annot * t * t | LetInType of Name.t binder_annot * t * t * t | AtomicType of t * t array let kind_of_type sigma t = match kind sigma t with | Sort s -> SortType s | Cast (c,_,t) -> CastType (c, t) | Prod (na,t,c) -> ProdType (na, t, c) | LetIn (na,b,t,c) -> LetInType (na, b, t, c) | App (c,l) -> AtomicType (c, l) | (Rel _ | Meta _ | Var _ | Evar _ | Const _ | Proj _ | Case _ | Fix _ | CoFix _ | Ind _) -> AtomicType (t,[||]) | (Lambda _ | Construct _ | Int _ | Float _ | String _ | Array _) -> failwith "Not a type" module Unsafe = struct let to_relevance = ERelevance.unsafe_to_relevance let to_sorts = ESorts.unsafe_to_sorts let to_instance = EInstance.unsafe_to_instance let to_constr = unsafe_to_constr let to_constr_array = unsafe_to_constr_array let to_binder_annot : 'a binder_annot -> 'a Constr.binder_annot = match unsafe_relevance_eq with Refl -> fun x -> x let to_rel_decl = unsafe_to_rel_decl let to_named_decl = unsafe_to_named_decl let to_named_context = let gen : type a b c d. (a, b) eq -> (c,d) eq -> (a,a,c) Context.Named.pt -> (b,b,d) Context.Named.pt = fun Refl Refl x -> x in gen unsafe_eq unsafe_relevance_eq let to_rel_context = let gen : type a b c d. (a, b) eq -> (c,d) eq -> (a,a,c) Context.Rel.pt -> (b,b,d) Context.Rel.pt = fun Refl Refl x -> x in gen unsafe_eq unsafe_relevance_eq let to_case_invert = unsafe_to_case_invert let eq = unsafe_eq let relevance_eq = unsafe_relevance_eq end module UnsafeMonomorphic = struct let mkConst c = of_kind (Const (in_punivs c)) let mkInd i = of_kind (Ind (in_punivs i)) let mkConstruct c = of_kind (Construct (in_punivs c)) end (* deprecated *) let decompose_lambda_assum = decompose_lambda_decls let decompose_prod_assum = decompose_prod_decls let decompose_prod_n_assum = decompose_prod_n_decls let prod_assum = prod_decls let decompose_lam = decompose_lambda let decompose_lam_n_assum = decompose_lambda_n_assum let decompose_lam_n_decls = decompose_lambda_n_decls let decompose_lam_assum = decompose_lambda_assum include UnsafeMonomorphic coq-8.20.0/engine/eConstr.mli000066400000000000000000000515411466560755400160000ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* t val kind : Evd.evar_map -> t -> Sorts.relevance val equal : Evd.evar_map -> t -> t -> bool val relevant : t val irrelevant : t val is_irrelevant : Evd.evar_map -> t -> bool end module ESorts : sig type t = Evd.esorts (** Type of sorts up-to universe unification. Essentially a wrapper around Sorts.t so that normalization is ensured statically. *) val make : Sorts.t -> t (** Turn a sort into an up-to sort. *) val kind : Evd.evar_map -> t -> Sorts.t (** Returns the view into the current sort. Note that the kind of a variable may change if the unification state of the evar map changes. *) val equal : Evd.evar_map -> t -> t -> bool val is_small : Evd.evar_map -> t -> bool val is_prop : Evd.evar_map -> t -> bool val is_sprop : Evd.evar_map -> t -> bool val is_set : Evd.evar_map -> t -> bool val prop : t val sprop : t val set : t val type1 : t val super : Evd.evar_map -> t -> t val relevance_of_sort : t -> ERelevance.t val family : Evd.evar_map -> t -> Sorts.family val quality : Evd.evar_map -> t -> Sorts.Quality.t end module EInstance : sig type t (** Type of universe instances up-to universe unification. Similar to [ESorts.t] for [UVars.Instance.t]. *) val make : UVars.Instance.t -> t val kind : Evd.evar_map -> t -> UVars.Instance.t val empty : t val is_empty : t -> bool end type types = t type constr = t type existential = t pexistential type case_return = (t,ERelevance.t) pcase_return type case_branch = (t,ERelevance.t) pcase_branch type rec_declaration = (t, t, ERelevance.t) prec_declaration type fixpoint = (t, t, ERelevance.t) pfixpoint type cofixpoint = (t, t, ERelevance.t) pcofixpoint type unsafe_judgment = (constr, types) Environ.punsafe_judgment type unsafe_type_judgment = (types, Evd.esorts) Environ.punsafe_type_judgment type named_declaration = (constr, types, ERelevance.t) Context.Named.Declaration.pt type rel_declaration = (constr, types, ERelevance.t) Context.Rel.Declaration.pt type compacted_declaration = (constr, types, ERelevance.t) Context.Compacted.Declaration.pt type named_context = (constr, types, ERelevance.t) Context.Named.pt type compacted_context = compacted_declaration list type rel_context = (constr, types, ERelevance.t) Context.Rel.pt type 'a binder_annot = ('a,ERelevance.t) Context.pbinder_annot val annotR : 'a -> 'a binder_annot val nameR : Id.t -> Name.t binder_annot val anonR : Name.t binder_annot type case_invert = t pcase_invert type case = (t, t, EInstance.t, ERelevance.t) pcase type 'a puniverses = 'a * EInstance.t (** {5 Destructors} *) val kind : Evd.evar_map -> t -> (t, t, ESorts.t, EInstance.t, ERelevance.t) Constr.kind_of_term (** Same as {!Constr.kind} except that it expands evars and normalizes universes on the fly. *) val kind_upto : Evd.evar_map -> Constr.t -> (Constr.t, Constr.t, Sorts.t, UVars.Instance.t, Sorts.relevance) Constr.kind_of_term val to_constr : ?abort_on_undefined_evars:bool -> Evd.evar_map -> t -> Constr.t (** Returns the evar-normal form of the argument. Note that this function is supposed to be called when the original term has not more free-evars anymore. If you need compatibility with the old semantics, set [abort_on_undefined_evars] to [false]. For getting the evar-normal form of a term with evars see {!Evarutil.nf_evar}. *) val to_constr_opt : Evd.evar_map -> t -> Constr.t option (** Same as [to_constr], but returns [None] if some unresolved evars remain *) type kind_of_type = | SortType of ESorts.t | CastType of types * t | ProdType of Name.t binder_annot * t * t | LetInType of Name.t binder_annot * t * t * t | AtomicType of t * t array val kind_of_type : Evd.evar_map -> t -> kind_of_type (** {5 Constructors} *) val of_kind : (t, t, ESorts.t, EInstance.t, ERelevance.t) Constr.kind_of_term -> t (** Construct a term from a view. *) val of_constr : Constr.t -> t (** Translate a kernel term into an incomplete term in O(1). *) (** {5 Insensitive primitives} Evar-insensitive versions of the corresponding functions. See the {!Constr} module for more information. *) (** {6 Constructors} *) val mkRel : int -> t val mkVar : Id.t -> t val mkMeta : metavariable -> t val mkEvar : t pexistential -> t val mkSort : ESorts.t -> t val mkSProp : t val mkProp : t val mkSet : t val mkType : Univ.Universe.t -> t val mkCast : t * cast_kind * t -> t val mkProd : Name.t binder_annot * t * t -> t val mkLambda : Name.t binder_annot * t * t -> t val mkLetIn : Name.t binder_annot * t * t * t -> t val mkApp : t * t array -> t val mkConstU : Constant.t * EInstance.t -> t val mkProj : (Projection.t * ERelevance.t * t) -> t val mkIndU : inductive * EInstance.t -> t val mkConstructU : constructor * EInstance.t -> t val mkConstructUi : (inductive * EInstance.t) * int -> t val mkCase : case -> t val mkFix : (t, t, ERelevance.t) pfixpoint -> t val mkCoFix : (t, t, ERelevance.t) pcofixpoint -> t val mkArrow : t -> ERelevance.t -> t -> t val mkArrowR : t -> t -> t val mkInt : Uint63.t -> t val mkFloat : Float64.t -> t val mkString : Pstring.t -> t val mkArray : EInstance.t * t array * t * t -> t module UnsafeMonomorphic : sig val mkConst : Constant.t -> t val mkInd : inductive -> t val mkConstruct : constructor -> t end val mkConst : Constant.t -> t [@@deprecated "Use [mkConstU] or if truly needed [UnsafeMonomorphic.mkConst]"] val mkInd : inductive -> t [@@deprecated "Use [mkIndU] or if truly needed [UnsafeMonomorphic.mkInd]"] val mkConstruct : constructor -> t [@@deprecated "Use [mkConstructU] or if truly needed [UnsafeMonomorphic.mkConstruct]"] val mkRef : GlobRef.t * EInstance.t -> t val type1 : t val applist : t * t list -> t val applistc : t -> t list -> t (** { Abstracting/generalizing over binders } *) (** it = iterated or_LetIn = turn a local definition into a LetIn wo_LetIn = inlines local definitions (i.e. substitute them in the body) Named = binding is by name and the combinators turn it into a binding by index (complexity is nb(binders) * size(term)) *) val it_mkProd : t -> (Name.t binder_annot * t) list -> t val it_mkLambda : t -> (Name.t binder_annot * t) list -> t val mkProd_or_LetIn : rel_declaration -> t -> t val mkLambda_or_LetIn : rel_declaration -> t -> t val it_mkProd_or_LetIn : t -> rel_context -> t val it_mkLambda_or_LetIn : t -> rel_context -> t val mkProd_wo_LetIn : rel_declaration -> t -> t val mkLambda_wo_LetIn : rel_declaration -> t -> t val it_mkProd_wo_LetIn : t -> rel_context -> t val it_mkLambda_wo_LetIn : t -> rel_context -> t val mkNamedProd : Evd.evar_map -> Id.t binder_annot -> types -> types -> types val mkNamedLambda : Evd.evar_map -> Id.t binder_annot -> types -> constr -> constr val mkNamedLetIn : Evd.evar_map -> Id.t binder_annot -> constr -> types -> constr -> constr val mkNamedProd_or_LetIn : Evd.evar_map -> named_declaration -> types -> types val mkNamedLambda_or_LetIn : Evd.evar_map -> named_declaration -> types -> types val it_mkNamedProd_or_LetIn : Evd.evar_map -> t -> named_context -> t val it_mkNamedLambda_or_LetIn : Evd.evar_map -> t -> named_context -> t val mkNamedProd_wo_LetIn : Evd.evar_map -> named_declaration -> t -> t val it_mkNamedProd_wo_LetIn : Evd.evar_map -> t -> named_context -> t val mkLEvar : Evd.evar_map -> Evar.t * t list -> t (** Variant of {!mkEvar} that removes identity variable instances from its argument. *) (** {6 Simple case analysis} *) val isRel : Evd.evar_map -> t -> bool val isVar : Evd.evar_map -> t -> bool val isInd : Evd.evar_map -> t -> bool val isRef : Evd.evar_map -> t -> bool val isEvar : Evd.evar_map -> t -> bool val isMeta : Evd.evar_map -> t -> bool val isSort : Evd.evar_map -> t -> bool val isCast : Evd.evar_map -> t -> bool val isApp : Evd.evar_map -> t -> bool val isLambda : Evd.evar_map -> t -> bool val isLetIn : Evd.evar_map -> t -> bool val isProd : Evd.evar_map -> t -> bool val isConst : Evd.evar_map -> t -> bool val isConstruct : Evd.evar_map -> t -> bool val isFix : Evd.evar_map -> t -> bool val isCoFix : Evd.evar_map -> t -> bool val isCase : Evd.evar_map -> t -> bool val isProj : Evd.evar_map -> t -> bool val isType : Evd.evar_map -> constr -> bool type arity = rel_context * ESorts.t val mkArity : arity -> types val destArity : Evd.evar_map -> types -> arity val isArity : Evd.evar_map -> t -> bool val isVarId : Evd.evar_map -> Id.t -> t -> bool val isRelN : Evd.evar_map -> int -> t -> bool val isRefX : Environ.env -> Evd.evar_map -> GlobRef.t -> t -> bool (** The string is interpreted by [Coqlib.lib_ref]. If it is not registered, return [false]. *) val is_lib_ref : Environ.env -> Evd.evar_map -> string -> t -> bool val destRel : Evd.evar_map -> t -> int val destMeta : Evd.evar_map -> t -> metavariable val destVar : Evd.evar_map -> t -> Id.t val destSort : Evd.evar_map -> t -> ESorts.t val destCast : Evd.evar_map -> t -> t * cast_kind * t val destProd : Evd.evar_map -> t -> Name.t binder_annot * types * types val destLambda : Evd.evar_map -> t -> Name.t binder_annot * types * t val destLetIn : Evd.evar_map -> t -> Name.t binder_annot * t * types * t val destApp : Evd.evar_map -> t -> t * t array val destConst : Evd.evar_map -> t -> Constant.t * EInstance.t val destEvar : Evd.evar_map -> t -> t pexistential val destInd : Evd.evar_map -> t -> inductive * EInstance.t val destConstruct : Evd.evar_map -> t -> constructor * EInstance.t val destCase : Evd.evar_map -> t -> case val destProj : Evd.evar_map -> t -> Projection.t * ERelevance.t * t val destFix : Evd.evar_map -> t -> (t, t, ERelevance.t) pfixpoint val destCoFix : Evd.evar_map -> t -> (t, t, ERelevance.t) pcofixpoint val destRef : Evd.evar_map -> t -> GlobRef.t * EInstance.t val decompose_app : Evd.evar_map -> t -> t * t array val decompose_app_list : Evd.evar_map -> t -> t * t list (** Pops lambda abstractions until there are no more, skipping casts. *) val decompose_lambda : Evd.evar_map -> t -> (Name.t binder_annot * t) list * t (** Pops lambda abstractions and letins until there are no more, skipping casts. *) val decompose_lambda_decls : Evd.evar_map -> t -> rel_context * t (** Pops [n] lambda abstractions, skipping casts. @raise UserError if the term doesn't have enough lambdas. *) val decompose_lambda_n : Evd.evar_map -> int -> t -> (Name.t binder_annot * t) list * t (** Pops [n] lambda abstractions, and pop letins only if needed to expose enough lambdas, skipping casts. @raise UserError if the term doesn't have enough lambdas. *) val decompose_lambda_n_assum : Evd.evar_map -> int -> t -> rel_context * t (** Pops [n] lambda abstractions and letins, skipping casts. @raise UserError if the term doesn't have enough lambdas/letins. *) val decompose_lambda_n_decls : Evd.evar_map -> int -> t -> rel_context * t val prod_decls : Evd.evar_map -> t -> rel_context val compose_lam : (Name.t binder_annot * t) list -> t -> t [@@ocaml.deprecated "Use [it_mkLambda] instead."] val to_lambda : Evd.evar_map -> int -> t -> t val decompose_prod : Evd.evar_map -> t -> (Name.t binder_annot * t) list * t val decompose_prod_n : Evd.evar_map -> int -> t -> (Name.t binder_annot * t) list * t val decompose_prod_decls : Evd.evar_map -> t -> rel_context * t val decompose_prod_n_decls : Evd.evar_map -> int -> t -> rel_context * t val existential_type : Evd.evar_map -> existential -> types val whd_evar : Evd.evar_map -> constr -> constr (** {6 Equality} *) val eq_constr : Evd.evar_map -> t -> t -> bool val eq_constr_nounivs : Evd.evar_map -> t -> t -> bool val eq_constr_universes : Environ.env -> Evd.evar_map -> ?nargs:int -> t -> t -> UnivProblem.Set.t option val leq_constr_universes : Environ.env -> Evd.evar_map -> ?nargs:int -> t -> t -> UnivProblem.Set.t option val eq_existential : Evd.evar_map -> (t -> t -> bool) -> existential -> existential -> bool (** [eq_constr_universes_proj] can equate projections and their eta-expanded constant form. *) val eq_constr_universes_proj : Environ.env -> Evd.evar_map -> t -> t -> UnivProblem.Set.t option val compare_constr : Evd.evar_map -> (t -> t -> bool) -> t -> t -> bool (** {6 Iterators} *) val map : Evd.evar_map -> (t -> t) -> t -> t val map_with_binders : Evd.evar_map -> ('a -> 'a) -> ('a -> t -> t) -> 'a -> t -> t val map_branches : (t -> t) -> case_branch array -> case_branch array val map_return_predicate : (t -> t) -> case_return -> case_return val map_existential : Evd.evar_map -> (t -> t) -> existential -> existential val iter : Evd.evar_map -> (t -> unit) -> t -> unit val iter_with_binders : Evd.evar_map -> ('a -> 'a) -> ('a -> t -> unit) -> 'a -> t -> unit val iter_with_full_binders : Environ.env -> Evd.evar_map -> (rel_declaration -> 'a -> 'a) -> ('a -> t -> unit) -> 'a -> t -> unit val fold : Evd.evar_map -> ('a -> t -> 'a) -> 'a -> t -> 'a val fold_with_binders : Evd.evar_map -> ('a -> 'a) -> ('a -> 'b -> t -> 'b) -> 'a -> 'b -> t -> 'b (** Gather the universes transitively used in the term, including in the type of evars appearing in it. *) val universes_of_constr : Evd.evar_map -> t -> Sorts.QVar.Set.t * Univ.Level.Set.t (** {6 Substitutions} *) module Vars : sig (** See vars.mli for the documentation of the functions below *) type instance = t array type instance_list = t list type substl = t list val lift : int -> t -> t val liftn : int -> int -> t -> t val substnl : substl -> int -> t -> t val substl : substl -> t -> t val subst1 : t -> t -> t val substnl_decl : substl -> int -> rel_declaration -> rel_declaration val substl_decl : substl -> rel_declaration -> rel_declaration val subst1_decl : t -> rel_declaration -> rel_declaration val replace_vars : Evd.evar_map -> (Id.t * t) list -> t -> t val substn_vars : Evd.evar_map -> int -> Id.t list -> t -> t val subst_vars : Evd.evar_map -> Id.t list -> t -> t val subst_var : Evd.evar_map -> Id.t -> t -> t val noccurn : Evd.evar_map -> int -> t -> bool val noccur_between : Evd.evar_map -> int -> int -> t -> bool val closedn : Evd.evar_map -> int -> t -> bool val closed0 : Evd.evar_map -> t -> bool val subst_univs_level_constr : UVars.sort_level_subst -> t -> t val subst_instance_context : EInstance.t -> rel_context -> rel_context val subst_instance_constr : EInstance.t -> t -> t val subst_instance_relevance : EInstance.t -> ERelevance.t -> ERelevance.t val subst_of_rel_context_instance : rel_context -> instance -> substl val subst_of_rel_context_instance_list : rel_context -> instance_list -> substl val liftn_rel_context : int -> int -> rel_context -> rel_context val lift_rel_context : int -> rel_context -> rel_context val substnl_rel_context : substl -> int -> rel_context -> rel_context val substl_rel_context : substl -> rel_context -> rel_context val smash_rel_context : rel_context -> rel_context val esubst : (int -> 'a -> t) -> 'a Esubst.subs -> t -> t type substituend val make_substituend : t -> substituend val lift_substituend : int -> substituend -> t end (** {5 Environment handling} *) val push_rel : rel_declaration -> env -> env val push_rel_context : rel_context -> env -> env val push_rec_types : rec_declaration -> env -> env val push_named : named_declaration -> env -> env val push_named_context : named_context -> env -> env val push_named_context_val : named_declaration -> named_context_val -> named_context_val val rel_context : env -> rel_context val named_context : env -> named_context val val_of_named_context : named_context -> named_context_val val named_context_of_val : named_context_val -> named_context val lookup_rel : int -> env -> rel_declaration val lookup_named : variable -> env -> named_declaration val lookup_named_val : variable -> named_context_val -> named_declaration val map_rel_context_in_env : (env -> constr -> constr) -> env -> rel_context -> rel_context val match_named_context_val : named_context_val -> (named_declaration * named_context_val) option val identity_subst_val : named_context_val -> t SList.t (* XXX Missing Sigma proxy *) val fresh_global : ?loc:Loc.t -> ?rigid:Evd.rigid -> ?names:UVars.Instance.t -> Environ.env -> Evd.evar_map -> GlobRef.t -> Evd.evar_map * t val is_global : Environ.env -> Evd.evar_map -> GlobRef.t -> t -> bool [@@ocaml.deprecated "Use [EConstr.isRefX] instead."] val expand_case : Environ.env -> Evd.evar_map -> case -> (t,t,ERelevance.t) Inductive.pexpanded_case val annotate_case : Environ.env -> Evd.evar_map -> case -> case_info * EInstance.t * t array * ((rel_context * t) * ERelevance.t) * case_invert * t * (rel_context * t) array (** Same as above, but doesn't turn contexts into binders *) val expand_branch : Environ.env -> Evd.evar_map -> EInstance.t -> t array -> constructor -> case_branch -> rel_context (** Given a universe instance and parameters for the inductive type, constructs the typed context in which the branch lives. *) val contract_case : Environ.env -> Evd.evar_map -> (t,t,ERelevance.t) Inductive.pexpanded_case -> case (** {5 Extra} *) val of_existential : Constr.existential -> existential val of_named_decl : Constr.named_declaration -> named_declaration val of_rel_decl : Constr.rel_declaration -> rel_declaration val to_rel_decl : Evd.evar_map -> rel_declaration -> Constr.rel_declaration val to_named_decl : Evd.evar_map -> named_declaration -> Constr.named_declaration val of_named_context : Constr.named_context -> named_context val of_rel_context : Constr.rel_context -> rel_context val to_named_context : Evd.evar_map -> named_context -> Constr.named_context val to_rel_context : Evd.evar_map -> rel_context -> Constr.rel_context val of_case_invert : Constr.case_invert -> case_invert val of_constr_array : Constr.t array -> t array val of_binder_annot : 'a Constr.binder_annot -> 'a binder_annot val to_binder_annot : Evd.evar_map -> 'a binder_annot -> 'a Constr.binder_annot (** {5 Unsafe operations} *) module Unsafe : sig val to_constr : t -> Constr.t (** Physical identity. Does not care for defined evars. *) val to_constr_array : t array -> Constr.t array (** Physical identity. Does not care for defined evars. *) val to_binder_annot : 'a binder_annot -> 'a Constr.binder_annot val to_rel_decl : (t, types, ERelevance.t) Context.Rel.Declaration.pt -> (Constr.t, Constr.types, Sorts.relevance) Context.Rel.Declaration.pt (** Physical identity. Does not care for defined evars. *) val to_named_decl : (t, types, ERelevance.t) Context.Named.Declaration.pt -> (Constr.t, Constr.types, Sorts.relevance) Context.Named.Declaration.pt (** Physical identity. Does not care for defined evars. *) val to_named_context : (t, types, ERelevance.t) Context.Named.pt -> Constr.named_context val to_rel_context : (t, types, ERelevance.t) Context.Rel.pt -> Constr.rel_context val to_relevance : ERelevance.t -> Sorts.relevance val to_sorts : ESorts.t -> Sorts.t (** Physical identity. Does not care for normalization. *) val to_instance : EInstance.t -> UVars.Instance.t (** Physical identity. Does not care for normalization. *) val to_case_invert : case_invert -> Constr.case_invert val eq : (t, Constr.t) eq (** Use for transparent cast between types. *) val relevance_eq : (ERelevance.t, Sorts.relevance) eq end (** Deprecated *) val decompose_lambda_assum : Evd.evar_map -> t -> rel_context * t [@@ocaml.deprecated "Use [decompose_lambda_decls] instead."] val decompose_prod_assum : Evd.evar_map -> t -> rel_context * t [@@ocaml.deprecated "Use [decompose_prod_decls] instead."] val decompose_prod_n_assum : Evd.evar_map -> int -> t -> rel_context * t [@@ocaml.deprecated "Use [decompose_prod_n_decls] instead."] val prod_assum : Evd.evar_map -> t -> rel_context [@@ocaml.deprecated "Use [prod_decls] instead."] val decompose_lam : Evd.evar_map -> t -> (Name.t binder_annot * t) list * t [@@ocaml.deprecated "Use [decompose_lambda] instead."] val decompose_lam_n_assum : Evd.evar_map -> int -> t -> rel_context * t [@@ocaml.deprecated "Use [decompose_lambda_n_assum] instead."] val decompose_lam_n_decls : Evd.evar_map -> int -> t -> rel_context * t [@@ocaml.deprecated "Use [decompose_lambda_n_decls] instead."] val decompose_lam_assum : Evd.evar_map -> t -> rel_context * t [@@ocaml.deprecated "Use [decompose_lambda_assum] instead."] coq-8.20.0/engine/evar_kinds.ml000066400000000000000000000043151466560755400163340ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* (match existential_opt_value0 sigma ev with | None -> raise (Uninstantiated_evar evk) | Some c -> flush_and_check_evars sigma c) | _ -> Constr.map (flush_and_check_evars sigma) c let flush_and_check_evars sigma c = flush_and_check_evars sigma (EConstr.Unsafe.to_constr c) (** Term exploration up to instantiation. *) let kind_of_term_upto = EConstr.kind_upto let nf_evars_universes sigma t = EConstr.to_constr ~abort_on_undefined_evars:false sigma (EConstr.of_constr t) let whd_evar = EConstr.whd_evar let nf_evar = Evd.MiniEConstr.nf_evar let j_nf_evar sigma j = { uj_val = nf_evar sigma j.uj_val; uj_type = nf_evar sigma j.uj_type } let jl_nf_evar sigma jl = List.map (j_nf_evar sigma) jl let jv_nf_evar sigma = Array.map (j_nf_evar sigma) let tj_nf_evar sigma {utj_val=v;utj_type=t} = {utj_val=nf_evar sigma v;utj_type=t} let nf_relevance sigma r = UState.nf_relevance (Evd.evar_universe_context sigma) r let nf_named_context_evar sigma ctx = Context.Named.map_with_relevance (nf_relevance sigma) (nf_evars_universes sigma) ctx let nf_rel_context_evar sigma ctx = let nf_relevance r = ERelevance.make (ERelevance.kind sigma r) in Context.Rel.map_with_relevance nf_relevance (nf_evar sigma) ctx let nf_env_evar sigma env = let nc' = nf_named_context_evar sigma (Environ.named_context env) in let rel' = nf_rel_context_evar sigma (EConstr.rel_context env) in EConstr.push_rel_context rel' (reset_with_named_context (val_of_named_context nc') env) let nf_evar_info evc info = map_evar_info (nf_evar evc) info let nf_evar_map evm = Evd.raw_map { map = fun _ evi -> nf_evar_info evm evi } evm let nf_evar_map_undefined evm = Evd.raw_map_undefined (fun _ evi -> nf_evar_info evm evi) evm (*-------------------*) (* Auxiliary functions for the conversion algorithms modulo evars *) let has_undefined_evars evd t = let rec has_ev t = match EConstr.kind evd t with | Evar _ -> raise NotInstantiatedEvar | _ -> EConstr.iter evd has_ev t in try let _ = has_ev t in false with (Not_found | NotInstantiatedEvar) -> true let is_ground_term evd t = not (has_undefined_evars evd t) let is_ground_env evd env = let is_ground_rel_decl = function | RelDecl.LocalDef (_,b,_) -> is_ground_term evd (EConstr.of_constr b) | _ -> true in let is_ground_named_decl = function | NamedDecl.LocalDef (_,b,_) -> is_ground_term evd (EConstr.of_constr b) | _ -> true in List.for_all is_ground_rel_decl (rel_context env) && List.for_all is_ground_named_decl (named_context env) (* Return the head evar if any *) exception NoHeadEvar let head_evar sigma c = (* FIXME: this breaks if using evar-insensitive code *) let c = EConstr.Unsafe.to_constr c in let rec hrec c = match kind c with | Evar (evk,_) -> evk | Case (_, _, _, _, _, c, _) -> hrec c | App (c,_) -> hrec c | Cast (c,_,_) -> hrec c | Proj (_, _, c) -> hrec c | _ -> raise NoHeadEvar in hrec c (* Expand head evar if any (currently consider only applications but I guess it should consider Case too) *) let whd_head_evar_stack sigma c = let rec whrec (c, l) = match EConstr.kind sigma c with | Cast (c,_,_) -> whrec (c, l) | App (f,args) -> whrec (f, args :: l) | c -> (EConstr.of_kind c, l) in whrec (c, []) let whd_head_evar sigma c = let open EConstr in let (f, args) = whd_head_evar_stack sigma c in match args with | [arg] -> mkApp (f, arg) | _ -> mkApp (f, Array.concat args) (**********************) (* Creating new metas *) (**********************) let meta_counter_summary_name = "meta counter" (* Generator of metavariables *) let meta_ctr, meta_counter_summary_tag = Summary.ref_tag 0 ~name:meta_counter_summary_name let new_meta () = incr meta_ctr; !meta_ctr (* The list of non-instantiated existential declarations (order is important) *) (*------------------------------------* * functional operations on evar sets * *------------------------------------*) (* [push_rel_context_to_named_context] builds the defining context and the * initial instance of an evar. If the evar is to be used in context * * Gamma = a1 ... an xp ... x1 * \- named part -/ \- de Bruijn part -/ * * then the x1...xp are turned into variables so that the evar is declared in * context * * a1 ... an xp ... x1 * \----------- named part ------------/ * * but used applied to the initial instance "a1 ... an Rel(p) ... Rel(1)" * so that ev[a1:=a1 ... an:=an xp:=Rel(p) ... x1:=Rel(1)] is correctly typed * in context Gamma. * * Remark 1: The instance is reverted in practice (i.e. Rel(1) comes first) * Remark 2: If some of the ai or xj are definitions, we keep them in the * instance. This is necessary so that no unfolding of local definitions * happens when inferring implicit arguments (consider e.g. the problem * "x:nat; x':=x; f:forall y, y=y -> Prop |- f _ (refl_equal x')" which * produces the equation "?y[x,x']=?y[x,x']" =? "x'=x'": we want * the hole to be instantiated by x', not by x (which would have been * the case in [invert_definition] if x' had disappeared from the instance). * Note that at any time, if, in some context env, the instance of * declaration x:A is t and the instance of definition x':=phi(x) is u, then * we have the property that u and phi(t) are convertible in env. *) let next_ident_away id avoid = let avoid id = Id.Set.mem id avoid in next_ident_away_from id avoid type subst_val = | SRel of int | SVar of Id.t type csubst = { csubst_len : int; (** Cardinal of [csubst_rel] *) csubst_var : Constr.t Id.Map.t; (** A mapping of variables to variables. We use the more general [Constr.t] to share allocations, but all values are of shape [Var _]. *) csubst_rel : Constr.t Int.Map.t; (** A contiguous mapping of integers to variables. Same remark for values. *) csubst_rev : subst_val Id.Map.t; (** Reverse mapping of the substitution *) } (** This type represents a name substitution for the named and De Bruijn parts of an environment. For efficiency we also store the reverse substitution. Invariant: all identifiers in the codomain of [csubst_var] and [csubst_rel] must be pairwise distinct. *) let empty_csubst = { csubst_len = 0; csubst_rel = Int.Map.empty; csubst_var = Id.Map.empty; csubst_rev = Id.Map.empty; } let csubst_subst sigma { csubst_len = k; csubst_var = v; csubst_rel = s } c = (* Safe because this is a substitution *) let c = EConstr.Unsafe.to_constr c in let rec subst n c = match Constr.kind c with | Rel m -> if m <= n then c else if m - n <= k then Int.Map.find (k - m + n) s else mkRel (m - k) | Var id -> begin try Id.Map.find id v with Not_found -> c end | Evar (evk, args) -> let EvarInfo evi = Evd.find sigma evk in let args' = subst_instance n (evar_filtered_context evi) args in if args' == args then c else Constr.mkEvar (evk, args') (* FIXME: preserve sharing *) | _ -> Constr.map_with_binders succ subst n c and subst_instance n ctx args = match ctx, SList.view args with | [], None -> SList.empty | decl :: ctx, Some (c, args) -> let c' = match c with | None -> begin try Some (Id.Map.find (NamedDecl.get_id decl) v) with Not_found -> c end | Some c -> let c' = subst n c in if isVarId (NamedDecl.get_id decl) c' then None else Some c' in SList.cons_opt c' (subst_instance n ctx args) | _ :: _, None | [], Some _ -> assert false in let c = if k = 0 && Id.Map.is_empty v then c else subst 0 c in EConstr.of_constr c type ext_named_context = csubst * Id.Set.t * named_context_val let push_var id { csubst_len = n; csubst_var = v; csubst_rel = s; csubst_rev = r } = let s = Int.Map.add n (Constr.mkVar id) s in let r = Id.Map.add id (SRel n) r in { csubst_len = succ n; csubst_var = v; csubst_rel = s; csubst_rev = r } (** Post-compose the substitution with the generator [src ↦ tgt] *) let update_var src tgt subst = let cur = try Some (Id.Map.find src subst.csubst_rev) with Not_found -> None in match cur with | None -> (* Missing keys stand for identity substitution [src ↦ src] *) let csubst_var = Id.Map.add src (Constr.mkVar tgt) subst.csubst_var in let csubst_rev = Id.Map.add tgt (SVar src) subst.csubst_rev in { subst with csubst_var; csubst_rev } | Some bnd -> let csubst_rev = Id.Map.add tgt bnd (Id.Map.remove src subst.csubst_rev) in match bnd with | SRel m -> let csubst_rel = Int.Map.add m (Constr.mkVar tgt) subst.csubst_rel in { subst with csubst_rel; csubst_rev } | SVar id -> let csubst_var = Id.Map.add id (Constr.mkVar tgt) subst.csubst_var in { subst with csubst_var; csubst_rev } module VarSet = struct type t = Id.t -> bool let empty _ = false let full _ = true let variables env id = is_section_variable env id end type naming_mode = | RenameExistingBut of VarSet.t | FailIfConflict | ProgramNaming of VarSet.t let push_rel_decl_to_named_context ~hypnaming sigma decl ((subst, avoid, nc) : ext_named_context) = let open EConstr in let open Vars in let map_decl f d = NamedDecl.map_constr f d in let rec replace_var_named_declaration id0 id nc = match match_named_context_val nc with | None -> empty_named_context_val | Some (decl, nc) -> if Id.equal id0 (NamedDecl.get_id decl) then (* Stop here, the variable cannot occur before its definition *) push_named_context_val (NamedDecl.set_id id decl) nc else let nc = replace_var_named_declaration id0 id nc in let vsubst = [id0 , mkVar id] in push_named_context_val (map_decl (fun c -> replace_vars sigma vsubst c) decl) nc in let extract_if_neq id = function | Anonymous -> None | Name id' when Id.compare id id' = 0 -> None | Name id' -> Some id' in let na = RelDecl.get_name decl in let id = (* id_of_name_using_hdchar only depends on the rel context which is empty here *) next_ident_away (id_of_name_using_hdchar empty_env sigma (RelDecl.get_type decl) na) avoid in match extract_if_neq id na with | Some id0 -> begin match hypnaming with | RenameExistingBut f | ProgramNaming f -> if f id0 then (* spiwack: if [id0] is a section variable renaming it is incorrect. We revert to a less robust behaviour where the new binder has name [id]. Which amounts to the same behaviour than when [id=id0]. *) let d = decl |> NamedDecl.of_rel_decl (fun _ -> id) |> map_decl (csubst_subst sigma subst) in (push_var id subst, Id.Set.add id avoid, push_named_context_val d nc) else (* spiwack: if [id<>id0], rather than introducing a new binding named [id], we will keep [id0] (the name given by the user) and rename [id0] into [id] in the named context. Unless [id] is a section variable. *) let subst = update_var id0 id subst in let d = decl |> NamedDecl.of_rel_decl (fun _ -> id0) |> map_decl (csubst_subst sigma subst) in let nc = replace_var_named_declaration id0 id nc in let avoid = Id.Set.add id (Id.Set.add id0 avoid) in (push_var id0 subst, avoid, push_named_context_val d nc) | FailIfConflict -> user_err Pp.(Id.print id0 ++ str " is already used.") end | None -> let d = decl |> NamedDecl.of_rel_decl (fun _ -> id) |> map_decl (csubst_subst sigma subst) in (push_var id subst, Id.Set.add id avoid, push_named_context_val d nc) let csubst_instance subst ctx = let fold decl accu = match Id.Map.find (NamedDecl.get_id decl) subst.csubst_rev with | SRel n -> SList.cons (EConstr.mkRel (subst.csubst_len - n)) accu | SVar id -> SList.cons (EConstr.mkVar id) accu | exception Not_found -> SList.default accu in List.fold_right fold ctx SList.empty let default_ext_instance (subst, _, ctx) = csubst_instance subst (named_context_of_val ctx) let push_rel_context_to_named_context ~hypnaming env sigma typ = (* compute the instances relative to the named context and rel_context *) let open EConstr in let ctx = named_context_val env in if List.is_empty (Environ.rel_context env) then let inst = SList.defaultn (List.length @@ named_context_of_val ctx) SList.empty in (ctx, typ, inst, empty_csubst) else let avoid = Environ.ids_of_named_context_val (named_context_val env) in (* move the rel context to a named context and extend the named instance *) (* with vars of the rel context *) (* We do keep the instances corresponding to local definition (see above) *) let (subst, _, env) as ext = Context.Rel.fold_outside (fun d acc -> push_rel_decl_to_named_context ~hypnaming sigma d acc) (rel_context env) ~init:(empty_csubst, avoid, ctx) in let inst = default_ext_instance ext in (env, csubst_subst sigma subst typ, inst, subst) (*------------------------------------* * Entry points to define new evars * *------------------------------------*) let new_pure_evar = Evd.new_pure_evar let next_evar_name sigma naming = match naming with | IntroAnonymous -> None | IntroIdentifier id -> Some id | IntroFresh id -> let id = Nameops.Fresh.next id (Evd.evar_names sigma) in Some id (* [new_evar] declares a new existential in an env env with type typ *) (* Converting the env into the sign of the evar to define *) let new_evar ?src ?filter ?relevance ?abstract_arguments ?candidates ?(naming = IntroAnonymous) ?typeclass_candidate ?principal ?hypnaming env evd typ = let name = next_evar_name evd naming in let hypnaming = match hypnaming with | Some n -> n | None -> RenameExistingBut (VarSet.variables (Global.env ())) in let sign,typ',instance,subst = push_rel_context_to_named_context ~hypnaming env evd typ in let map c = csubst_subst evd subst c in let candidates = Option.map (fun l -> List.map map l) candidates in let instance = match filter with | None -> instance | Some filter -> Filter.filter_slist filter instance in let relevance = match relevance with | Some r -> r | None -> ERelevance.relevant (* FIXME: relevant_of_type not defined yet *) in let (evd, evk) = new_pure_evar sign evd typ' ?src ?filter ~relevance ?abstract_arguments ?candidates ?name ?typeclass_candidate ?principal in (evd, EConstr.mkEvar (evk, instance)) let new_type_evar ?src ?filter ?naming ?principal ?hypnaming env evd rigid = let (evd', s) = new_sort_variable rigid evd in let relevance = EConstr.ESorts.relevance_of_sort s in let (evd', e) = new_evar env evd' ?src ?filter ~relevance ?naming ~typeclass_candidate:false ?principal ?hypnaming (EConstr.mkSort s) in evd', (e, s) let new_Type ?(rigid=Evd.univ_flexible) evd = let open EConstr in let (evd, s) = new_sort_variable rigid evd in (evd, mkSort s) (* Safe interface to unification problems *) type unification_pb = conv_pb * env * EConstr.constr * EConstr.constr let eq_unification_pb evd (pbty,env,t1,t2) (pbty',env',t1',t2') = pbty == pbty' && env == env' && EConstr.eq_constr evd t1 t1' && EConstr.eq_constr evd t2 t2' let add_unification_pb ?(tail=false) pb evd = let conv_pbs = Evd.conv_pbs evd in if not (List.exists (eq_unification_pb evd pb) conv_pbs) then let (pbty,env,t1,t2) = pb in Evd.add_conv_pb ~tail (pbty,env,t1,t2) evd else evd (* This assumes an evar with identity instance and generalizes it over only the de Bruijn part of the context *) let generalize_evar_over_rels sigma (ev,args) = let open EConstr in let evi = Evd.find_undefined sigma ev in let args = Evd.expand_existential sigma (ev, args) in let sign = named_context_of_val (Evd.evar_hyps evi) in List.fold_left2 (fun (c,inst as x) a d -> if isRel sigma a then (mkNamedProd_or_LetIn sigma d c,a::inst) else x) (Evd.evar_concl evi,[]) args sign (************************************) (* Removing a dependency in an evar *) (************************************) type clear_dependency_error = | OccurHypInSimpleClause of Id.t option | EvarTypingBreak of existential | NoCandidatesLeft of Evar.t exception ClearDependencyError of Id.t * clear_dependency_error * GlobRef.t option exception Depends of Id.t let set_of_evctx l = List.fold_left (fun s decl -> Id.Set.add (NamedDecl.get_id decl) s) Id.Set.empty l let filter_effective_candidates evd evi filter candidates = let ids = set_of_evctx (Filter.filter_list filter (evar_context evi)) in List.filter (fun a -> Id.Set.subset (collect_vars evd a) ids) candidates let restrict_evar evd evk filter candidates = let evar_info = Evd.find_undefined evd evk in let candidates = Option.map (filter_effective_candidates evd evar_info filter) candidates in match candidates with | Some [] -> raise (ClearDependencyError (*FIXME*)(Id.of_string "blah", (NoCandidatesLeft evk), None)) | _ -> Evd.restrict evk filter ?candidates evd let rec check_and_clear_in_constr ~is_section_variable env evdref err ids ~global c = (* returns a new constr where all the evars have been 'cleaned' (ie the hypotheses ids have been removed from the contexts of evars). [global] should be true iff there is some variable of [ids] which is a section variable *) match kind c with | Var id' -> if Id.Set.mem id' ids then raise (ClearDependencyError (id', err, None)) else c | ( Const _ | Ind _ | Construct _ ) -> let () = if global then let check id' = if Id.Set.mem id' ids then raise (ClearDependencyError (id',err,Some (fst @@ destRef c))) in Id.Set.iter check (Environ.vars_of_global env (fst @@ destRef c)) in c | Evar (evk,l as ev) -> if Evd.is_defined !evdref evk then (* If evk is already defined we replace it by its definition *) let nc = Evd.existential_value !evdref (EConstr.of_existential ev) in let nc = EConstr.Unsafe.to_constr nc in check_and_clear_in_constr ~is_section_variable env evdref err ids ~global nc else (* We check for dependencies to elements of ids in the evar_info corresponding to e and in the instance of arguments. Concurrently, we build a new evar corresponding to e where hypotheses of ids have been removed *) let evi = Evd.find_undefined !evdref evk in let ctxt = Evd.evar_filtered_context evi in let rec fold accu ctxt args = match ctxt, SList.view args with | [], Some _ | _ :: _, None -> assert false | [], None -> accu | h :: ctxt, Some (a, args) -> let (ri, filter) = fold accu ctxt args in try (* Check if some id to clear occurs in the instance a of rid in ev and remember the dependency *) let check id = if Id.Set.mem id ids then raise (Depends id) in let a = match a with | None -> Id.Set.singleton (NamedDecl.get_id h) | Some a -> collect_vars !evdref (EConstr.of_constr a) in let () = Id.Set.iter check a in (* Check if some rid to clear in the context of ev has dependencies in another hyp of the context of ev and transitively remember the dependency *) let check id _ = if occur_var_in_decl env !evdref id h then raise (Depends id) in let () = Id.Map.iter check ri in (* No dependency at all, we can keep this ev's context hyp *) (ri, true::filter) with Depends id -> (Id.Map.add (NamedDecl.get_id h) id ri, false::filter) in let (rids, filter) = fold (Id.Map.empty, []) ctxt l in (* Check if some rid to clear in the context of ev has dependencies in the type of ev and adjust the source of the dependency *) let _nconcl : Constr.t = try let nids = Id.Map.domain rids in let global = Id.Set.exists is_section_variable nids in let concl = EConstr.Unsafe.to_constr (evar_concl evi) in check_and_clear_in_constr ~is_section_variable env evdref (EvarTypingBreak ev) nids ~global concl with ClearDependencyError (rid,err,where) -> raise (ClearDependencyError (Id.Map.find rid rids,err,where)) in if Id.Map.is_empty rids then c else let origfilter = Evd.evar_filter evi in let filter = Evd.Filter.apply_subfilter origfilter filter in let evd = !evdref in let candidates = Evd.evar_candidates evi in let (evd,_) = restrict_evar evd evk filter candidates in evdref := evd; Evd.existential_value0 !evdref ev | _ -> Constr.map (check_and_clear_in_constr ~is_section_variable env evdref err ids ~global) c let clear_hyps_in_evi_main env sigma hyps terms ids = (* clear_hyps_in_evi erases hypotheses ids in hyps, checking if some hypothesis does not depend on a element of ids, and erases ids in the contexts of the evars occurring in evi *) let evdref = ref sigma in let terms = List.map EConstr.Unsafe.to_constr terms in let is_section_variable id = is_section_variable (Global.env ()) id in let global = Id.Set.exists is_section_variable ids in let terms = List.map (check_and_clear_in_constr ~is_section_variable env evdref (OccurHypInSimpleClause None) ids ~global) terms in let nhyps = let check_context decl = let err = OccurHypInSimpleClause (Some (NamedDecl.get_id decl)) in NamedDecl.map_constr (check_and_clear_in_constr ~is_section_variable env evdref err ids ~global) decl in remove_hyps ids check_context hyps in (!evdref, nhyps,List.map EConstr.of_constr terms) let check_and_clear_in_constr env evd err ids c = let evdref = ref evd in let c = EConstr.Unsafe.to_constr c in let _ : constr = check_and_clear_in_constr ~is_section_variable:(fun _ -> true) ~global:true env evdref err ids c in !evdref let clear_hyps_in_evi env sigma hyps concl ids = match clear_hyps_in_evi_main env sigma hyps [concl] ids with | (sigma,nhyps,[nconcl]) -> (sigma,nhyps,nconcl) | _ -> assert false let clear_hyps2_in_evi env sigma hyps t concl ids = match clear_hyps_in_evi_main env sigma hyps [t;concl] ids with | (sigma,nhyps,[t;nconcl]) -> (sigma,nhyps,t,nconcl) | _ -> assert false (** [advance sigma g] returns [Some g'] if [g'] is undefined and is the current avatar of [g] (for instance [g] was changed by [clear] into [g']). It returns [None] if [g] has been (partially) solved. *) (* spiwack: [advance] is probably performance critical, and the good behaviour of its definition may depend sensitively to the actual definition of [Evd.find]. Currently, [Evd.find] starts looking for a value in the heap of undefined variable, which is small. Hence in the most common case, where [advance] is applied to an unsolved goal ([advance] is used to figure if a side effect has modified the goal) it terminates quickly. *) let rec advance sigma evk = match Evd.find_defined sigma evk with | None -> Some evk | Some evi -> match Evd.evar_body evi with | Evar_defined v -> match is_aliased_evar sigma evk with | Some evk -> advance sigma evk | None -> None let reachable_from_evars sigma evars = let aliased = Evd.get_aliased_evars sigma in let rec search evk visited = if Evar.Set.mem evk visited then visited else let visited = Evar.Set.add evk visited in match Evar.Map.find evk aliased with | evk' -> search evk' visited | exception Not_found -> visited in Evar.Set.fold (fun evk visited -> search evk visited) evars Evar.Set.empty (** The following functions return the set of undefined evars contained in the object, the defined evars being traversed. This is roughly a combination of the previous functions and [nf_evar]. *) let undefined_evars_of_term evd t = let rec evrec acc c = match EConstr.kind evd c with | Evar (n, l) -> let acc = Evar.Set.add n acc in SList.Skip.fold evrec acc l | _ -> EConstr.fold evd evrec acc c in evrec Evar.Set.empty t let undefined_evars_of_named_context evd nc = Context.Named.fold_outside (NamedDecl.fold_constr (fun c s -> Evar.Set.union s (undefined_evars_of_term evd (EConstr.of_constr c)))) nc ~init:Evar.Set.empty type undefined_evars_cache = { mutable cache : (EConstr.named_declaration * Evar.Set.t) ref Id.Map.t; } let create_undefined_evars_cache () = { cache = Id.Map.empty; } let cached_evar_of_hyp cache sigma decl accu = match cache with | None -> let fold c acc = let evs = undefined_evars_of_term sigma c in Evar.Set.union evs acc in NamedDecl.fold_constr fold decl accu | Some cache -> let id = NamedDecl.get_annot decl in let r = try Id.Map.find id.binder_name cache.cache with Not_found -> (* Dummy value *) let r = ref (NamedDecl.LocalAssum (id, EConstr.mkProp), Evar.Set.empty) in let () = cache.cache <- Id.Map.add id.binder_name r cache.cache in r in let (decl', evs) = !r in let evs = if NamedDecl.equal (==) (==) decl decl' then snd !r else let fold c acc = let evs = undefined_evars_of_term sigma c in Evar.Set.union evs acc in let evs = NamedDecl.fold_constr fold decl Evar.Set.empty in let () = r := (decl, evs) in evs in Evar.Set.fold Evar.Set.add evs accu let filtered_undefined_evars_of_evar_info (type a) ?cache sigma (evi : a evar_info) = let evars_of_named_context cache accu nc = let fold decl accu = cached_evar_of_hyp cache sigma (EConstr.of_named_decl decl) accu in Context.Named.fold_outside fold nc ~init:accu in let accu = match Evd.evar_body evi with | Evar_empty -> undefined_evars_of_term sigma (Evd.evar_concl evi) | Evar_defined b -> evars_of_term sigma b in let ctxt = EConstr.Unsafe.to_named_context (evar_filtered_context evi) in evars_of_named_context cache accu ctxt (* spiwack: this is a more complete version of {!Termops.occur_evar}. The latter does not look recursively into an [evar_map]. If unification only need to check superficially, tactics do not have this luxury, and need the more complete version. *) let occur_evar_upto sigma n c = let c = EConstr.Unsafe.to_constr c in let rec occur_rec c = match kind c with | Evar (sp,_) when Evar.equal sp n -> raise Occur | Evar e -> Option.iter occur_rec (existential_opt_value0 sigma e) | _ -> Constr.iter occur_rec c in try occur_rec c; false with Occur -> true (* We don't try to guess in which sort the type should be defined, since any type has type Type. May cause some trouble, but not so far... *) let judge_of_new_Type evd = let open EConstr in let (evd', s) = new_sort_variable univ_rigid evd in (evd', { uj_val = mkSort s; uj_type = mkSort (ESorts.super evd s) }) let subterm_source evk ?where (loc,k) = let evk = match k with | Evar_kinds.SubEvar (None,evk) when where = None -> evk | _ -> evk in (loc,Evar_kinds.SubEvar (where,evk)) (* Add equality constraints for covariant/invariant positions. For irrelevant positions, unify universes when flexible. *) let compare_cumulative_instances cv_pb variances u u' sigma = let open UnivProblem in let cstrs = Univ.Constraints.empty in let soft = Set.empty in let qs, us = UVars.Instance.to_array u and qs', us' = UVars.Instance.to_array u' in let qcstrs = enforce_eq_qualities qs qs' Set.empty in match Evd.add_universe_constraints sigma qcstrs with | exception UGraph.UniverseInconsistency p -> Inr p | sigma -> let cstrs, soft = Array.fold_left3 (fun (cstrs, soft) v u u' -> let open UVars.Variance in match v with | Irrelevant -> cstrs, Set.add (UWeak (u,u')) soft | Covariant when cv_pb == Conversion.CUMUL -> Univ.Constraints.add (u,Univ.Le,u') cstrs, soft | Covariant | Invariant -> Univ.Constraints.add (u,Univ.Eq,u') cstrs, soft) (cstrs,soft) variances us us' in match Evd.add_constraints sigma cstrs with | sigma -> Inl (Evd.add_universe_constraints sigma soft) | exception UGraph.UniverseInconsistency p -> Inr p let compare_constructor_instances evd u u' = let open UnivProblem in let qs, us = UVars.Instance.to_array u and qs', us' = UVars.Instance.to_array u' in let qcstrs = enforce_eq_qualities qs qs' Set.empty in match Evd.add_universe_constraints evd qcstrs with | exception UGraph.UniverseInconsistency p -> Inr p | evd -> let soft = Array.fold_left2 (fun cs u u' -> Set.add (UWeak (u,u')) cs) Set.empty us us' in Inl (Evd.add_universe_constraints evd soft) (** [eq_constr_univs_test ~evd ~extended_evd t u] tests equality of [t] and [u] up to existential variable instantiation and equalisable universes. The term [t] is interpreted in [evd] while [u] is interpreted in [extended_evd]. The universe constraints in [extended_evd] are assumed to be an extension of those in [evd]. *) let eq_constr_univs_test ~evd ~extended_evd t u = (* spiwack: mild code duplication with {!Evd.eq_constr_univs}. *) let open Evd in let t = EConstr.Unsafe.to_constr t and u = EConstr.Unsafe.to_constr u in let sigma = ref extended_evd in let eq_universes _ u1 u2 = let u1 = normalize_universe_instance !sigma u1 in let u2 = normalize_universe_instance !sigma u2 in UGraph.check_eq_instances (universes !sigma) u1 u2 in let eq_sorts s1 s2 = if Sorts.equal s1 s2 then true else try sigma := add_universe_constraints !sigma UnivProblem.(Set.singleton (UEq (s1, s2))); true with UGraph.UniverseInconsistency _ | UniversesDiffer -> false in let eq_existential eq e1 e2 = let eq c1 c2 = eq 0 (EConstr.Unsafe.to_constr c1) (EConstr.Unsafe.to_constr c2) in EConstr.eq_existential evd eq (EConstr.of_existential e1) (EConstr.of_existential e2) in let kind1 = kind_of_term_upto evd in let kind2 = kind_of_term_upto extended_evd in let rec eq_constr' nargs m n = Constr.compare_head_gen_with kind1 kind2 eq_universes eq_sorts (eq_existential eq_constr') eq_constr' nargs m n in Constr.compare_head_gen_with kind1 kind2 eq_universes eq_sorts (eq_existential eq_constr') eq_constr' 0 t u coq-8.20.0/engine/evarutil.mli000066400000000000000000000234211466560755400162120ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* metavariable (** {6 Creating a fresh evar given their type and context} *) val next_evar_name : evar_map -> intro_pattern_naming_expr -> Id.t option module VarSet : sig type t val empty : t val full : t val variables : Environ.env -> t end type naming_mode = | RenameExistingBut of VarSet.t | FailIfConflict | ProgramNaming of VarSet.t val new_evar : ?src:Evar_kinds.t Loc.located -> ?filter:Filter.t -> ?relevance:ERelevance.t -> ?abstract_arguments:Abstraction.t -> ?candidates:constr list -> ?naming:intro_pattern_naming_expr -> ?typeclass_candidate:bool -> ?principal:bool -> ?hypnaming:naming_mode -> env -> evar_map -> types -> evar_map * EConstr.t (** Alias of {!Evd.new_pure_evar} *) val new_pure_evar : ?src:Evar_kinds.t Loc.located -> ?filter:Filter.t -> ?relevance:ERelevance.t -> ?abstract_arguments:Abstraction.t -> ?candidates:constr list -> ?name:Id.t -> ?typeclass_candidate:bool -> ?principal:bool -> named_context_val -> evar_map -> types -> evar_map * Evar.t (** Create a new Type existential variable, as we keep track of them during type-checking and unification. *) val new_type_evar : ?src:Evar_kinds.t Loc.located -> ?filter:Filter.t -> ?naming:intro_pattern_naming_expr -> ?principal:bool -> ?hypnaming:naming_mode -> env -> evar_map -> rigid -> evar_map * (constr * ESorts.t) val new_Type : ?rigid:rigid -> evar_map -> evar_map * constr (** {6 Unification utils} *) (** [head_evar c] returns the head evar of [c] if any *) exception NoHeadEvar val head_evar : evar_map -> constr -> Evar.t (** may raise NoHeadEvar *) (* Expand head evar if any *) val whd_head_evar : evar_map -> constr -> constr (* An over-approximation of [has_undefined (nf_evars evd c)] *) val has_undefined_evars : evar_map -> constr -> bool val is_ground_term : evar_map -> constr -> bool val is_ground_env : evar_map -> env -> bool (** [advance sigma g] returns [Some g'] if [g'] is undefined and is the current avatar of [g] (for instance [g] was changed by [clear] into [g']). It returns [None] if [g] has been (partially) solved. *) val advance : evar_map -> Evar.t -> Evar.t option (** [reachable_from_evars sigma seeds] computes the descendents of evars in [seeds] by restriction or evar-evar unifications in [sigma]. *) val reachable_from_evars : evar_map -> Evar.Set.t -> Evar.Set.t (** The following functions return the set of undefined evars contained in the object, the defined evars being traversed. This is roughly a combination of the previous functions and [nf_evar]. *) val undefined_evars_of_term : evar_map -> constr -> Evar.Set.t val undefined_evars_of_named_context : evar_map -> Constr.named_context -> Evar.Set.t type undefined_evars_cache val create_undefined_evars_cache : unit -> undefined_evars_cache val filtered_undefined_evars_of_evar_info : ?cache:undefined_evars_cache -> evar_map -> 'a evar_info -> Evar.Set.t (** [occur_evar_upto sigma k c] returns [true] if [k] appears in [c]. It looks up recursively in [sigma] for the value of existential variables. *) val occur_evar_upto : evar_map -> Evar.t -> constr -> bool (** {6 Value/Type constraints} *) val judge_of_new_Type : evar_map -> evar_map * unsafe_judgment (***********************************************************) val create_clos_infos : env -> evar_map -> RedFlags.reds -> CClosure.clos_infos (** [flush_and_check_evars] raise [Uninstantiated_evar] if an evar remains uninstantiated; [nf_evar] leaves uninstantiated evars as is *) val whd_evar : evar_map -> constr -> constr val nf_evar : evar_map -> constr -> constr val j_nf_evar : evar_map -> unsafe_judgment -> unsafe_judgment val jl_nf_evar : evar_map -> unsafe_judgment list -> unsafe_judgment list val jv_nf_evar : evar_map -> unsafe_judgment array -> unsafe_judgment array val tj_nf_evar : evar_map -> unsafe_type_judgment -> unsafe_type_judgment val nf_named_context_evar : evar_map -> Constr.named_context -> Constr.named_context val nf_rel_context_evar : evar_map -> rel_context -> rel_context val nf_env_evar : evar_map -> env -> env val nf_evar_info : evar_map -> 'a evar_info -> 'a evar_info val nf_evar_map : evar_map -> evar_map val nf_evar_map_undefined : evar_map -> evar_map val nf_relevance : evar_map -> Sorts.relevance -> Sorts.relevance (** Presenting terms without solved evars *) val nf_evars_universes : evar_map -> Constr.constr -> Constr.constr (** Replacing all evars, possibly raising [Uninstantiated_evar] *) exception Uninstantiated_evar of Evar.t val flush_and_check_evars : evar_map -> constr -> Constr.constr (** [finalize env sigma f] combines universe minimisation, evar-and-universe normalisation and universe restriction. It minimizes universes in [sigma], calls [f] a normalisation function with respect to the updated [sigma] and restricts the local universes of [sigma] to those encountered while running [f]. Note that the normalizer passed to [f] holds some imperative state in its closure. *) val finalize : ?abort_on_undefined_evars:bool -> evar_map -> ((EConstr.t -> Constr.t) -> 'a) -> evar_map * 'a (** {6 Term manipulation up to instantiation} *) (** Like {!Constr.kind} except that [kind_of_term sigma t] exposes [t] as an evar [e] only if [e] is uninstantiated in [sigma]. Otherwise the value of [e] in [sigma] is (recursively) used. *) val kind_of_term_upto : evar_map -> Constr.constr -> (Constr.constr, Constr.types, Sorts.t, UVars.Instance.t, Sorts.relevance) kind_of_term (** [eq_constr_univs_test ~evd ~extended_evd t u] tests equality of [t] and [u] up to existential variable instantiation and equalisable universes. The term [t] is interpreted in [evd] while [u] is interpreted in [extended_evd]. The universe constraints in [extended_evd] are assumed to be an extension of those in [evd]. *) val eq_constr_univs_test : evd:Evd.evar_map -> extended_evd:Evd.evar_map -> constr -> constr -> bool (** [compare_cumulative_instances cv_pb variance u1 u2 sigma] Returns [Inl sigma'] where [sigma'] is [sigma] augmented with universe constraints such that [u1 cv_pb? u2] according to [variance]. Additionally flexible universes in irrelevant positions are unified if possible. Returns [Inr p] when the former is impossible. *) val compare_cumulative_instances : Conversion.conv_pb -> UVars.Variance.t array -> UVars.Instance.t -> UVars.Instance.t -> evar_map -> (evar_map, UGraph.univ_inconsistency) Util.union (** We should only compare constructors at convertible types, so this is only an opportunity to unify universes. But what about qualities? *) val compare_constructor_instances : evar_map -> UVars.Instance.t -> UVars.Instance.t -> (evar_map, UGraph.univ_inconsistency) Util.union (** {6 Unification problems} *) type unification_pb = conv_pb * env * constr * constr (** [add_unification_pb ?tail pb sigma] Add a unification problem [pb] to [sigma], if not already present. Put it at the end of the list if [tail] is true, by default it is false. *) val add_unification_pb : ?tail:bool -> unification_pb -> evar_map -> evar_map (** {6 Removing hyps in evars'context} raise OccurHypInSimpleClause if the removal breaks dependencies *) type clear_dependency_error = | OccurHypInSimpleClause of Id.t option | EvarTypingBreak of Constr.existential | NoCandidatesLeft of Evar.t exception ClearDependencyError of Id.t * clear_dependency_error * GlobRef.t option (** Restrict an undefined evar according to a (sub)filter and candidates. The evar will be defined if there is only one candidate left, @raise ClearDependencyError NoCandidatesLeft if the filter turns the candidates into an empty list. *) val restrict_evar : evar_map -> Evar.t -> Filter.t -> constr list option -> evar_map * Evar.t val clear_hyps_in_evi : env -> evar_map -> named_context_val -> types -> Id.Set.t -> evar_map * named_context_val * types val clear_hyps2_in_evi : env -> evar_map -> named_context_val -> types -> types -> Id.Set.t -> evar_map * named_context_val * types * types val check_and_clear_in_constr : Environ.env -> Evd.evar_map -> clear_dependency_error -> Names.Id.Set.t -> EConstr.constr -> Evd.evar_map type csubst val empty_csubst : csubst val csubst_subst : Evd.evar_map -> csubst -> constr -> constr type ext_named_context = csubst * Id.Set.t * named_context_val val default_ext_instance : ext_named_context -> constr SList.t val push_rel_decl_to_named_context : hypnaming:naming_mode -> evar_map -> rel_declaration -> ext_named_context -> ext_named_context val push_rel_context_to_named_context : hypnaming:naming_mode -> Environ.env -> evar_map -> types -> named_context_val * types * constr SList.t * csubst val generalize_evar_over_rels : evar_map -> existential -> types * constr list val subterm_source : Evar.t -> ?where:Evar_kinds.subevar_kind -> Evar_kinds.t Loc.located -> Evar_kinds.t Loc.located val meta_counter_summary_tag : int Summary.Dyn.tag coq-8.20.0/engine/evd.ml000066400000000000000000001770331466560755400147750ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* t -> bool val identity : t val filter_list : t -> 'a list -> 'a list val filter_array : t -> 'a array -> 'a array val filter_slist : t -> 'a SList.t -> 'a SList.t val extend : int -> t -> t val compose : t -> t -> t val apply_subfilter : t -> bool list -> t val restrict_upon : t -> int -> (int -> bool) -> t option val map_along : (bool -> 'a -> bool) -> t -> 'a list -> t val make : bool list -> t val repr : t -> bool list option type compact = | Empty | TCons of int * compact | FCons of int * compact val unfold : t -> compact option end = struct type compact = | Empty | TCons of int * compact | FCons of int * compact let rec compact l = match l with | [] -> Empty | true :: l -> begin match compact l with | TCons (n, c) -> TCons (n + 1, c) | (Empty | FCons _ as c) -> TCons (1, c) end | false :: l -> begin match compact l with | FCons (n, c) -> FCons (n + 1, c) | (Empty | TCons _ as c) -> FCons (1, c) end type t = { data : bool list option; compact : compact; } (** We guarantee through the interface that if a filter is [Some _] then it contains at least one [false] somewhere. *) let identity = { data = None; compact = Empty } let rec equal l1 l2 = match l1, l2 with | [], [] -> true | h1 :: l1, h2 :: l2 -> (if h1 then h2 else not h2) && equal l1 l2 | _ -> false let equal l1 l2 = match l1.data, l2.data with | None, None -> true | Some _, None | None, Some _ -> false | Some l1, Some l2 -> equal l1 l2 let rec is_identity = function | [] -> true | true :: l -> is_identity l | false :: _ -> false let normalize f = if is_identity f then identity else { data = Some f; compact = compact f } let filter_list f l = match f.data with | None -> l | Some f -> CList.filter_with f l let filter_array f v = match f.data with | None -> v | Some f -> CArray.filter_with f v let filter_slist f l = match f.data with | None -> l | Some f -> let rec filter f l = match f, SList.view l with | [], None -> SList.empty | true :: f, Some (o, l) -> SList.cons_opt o (filter f l) | false :: f, Some (_, l) -> filter f l | _ :: _, None | [], Some _ -> invalid_arg "List.filter_with" in filter f l let rec extend n l = if n = 0 then l else extend (pred n) (true :: l) let extend n f = match f.data with | None -> identity | Some f0 -> let compact = match f.compact with | Empty -> assert false | TCons (m, c) -> TCons (n + m, c) | c -> TCons (n, c) in { data = Some (extend n f0); compact } let compose f1 f2 = match f1.data with | None -> f2 | Some f1 -> match f2.data with | None -> identity | Some f2 -> normalize (CList.filter_with f1 f2) let apply_subfilter_array filter subfilter = (* In both cases we statically know that the argument will contain at least one [false] *) match filter.data with | None -> let l = Array.to_list subfilter in { data = Some l; compact = compact l } | Some f -> let len = Array.length subfilter in let fold b (i, ans) = if b then let () = assert (0 <= i) in (pred i, Array.unsafe_get subfilter i :: ans) else (i, false :: ans) in let data = snd (List.fold_right fold f (pred len, [])) in { data = Some data; compact = compact data } let apply_subfilter filter subfilter = apply_subfilter_array filter (Array.of_list subfilter) let restrict_upon f len p = let newfilter = Array.init len p in if Array.for_all (fun id -> id) newfilter then None else Some (apply_subfilter_array f newfilter) let map_along f flt l = let ans = match flt.data with | None -> List.map (fun x -> f true x) l | Some flt -> List.map2 f flt l in normalize ans let make l = normalize l let repr f = f.data let unfold f = match f.data with | None -> None | Some _ -> Some f.compact end module Abstraction = struct type abstraction = | Abstract | Imitate type t = abstraction list let identity = [] let abstract_last l = Abstract :: l end (* The kinds of existential variables are now defined in [Evar_kinds] *) (* The type of mappings for existential variables *) module Store = Store.Make () let string_of_existential evk = "?X" ^ string_of_int (Evar.repr evk) type defined = [ `defined ] type undefined = [ `undefined ] type _ evar_body = | Evar_empty : undefined evar_body | Evar_defined : econstr -> defined evar_body type (_, 'a) when_undefined = | Defined : (defined, 'a) when_undefined | Undefined : 'a -> (undefined, 'a) when_undefined type 'a evar_info = { evar_concl : ('a, constr) when_undefined; evar_hyps : named_context_val; evar_body : 'a evar_body; evar_filter : Filter.t; evar_abstract_arguments : ('a, Abstraction.t) when_undefined; evar_source : Evar_kinds.t Loc.located; evar_candidates : ('a, constr list option) when_undefined; (* if not None, list of allowed instances *) evar_relevance: Sorts.relevance; } type any_evar_info = EvarInfo : 'a evar_info -> any_evar_info let instance_mismatch () = anomaly (Pp.str "Signature and its instance do not match.") let evar_concl evi = match evi.evar_concl with | Undefined c -> c let evar_filter evi = evi.evar_filter let evar_body evi = evi.evar_body let evar_context evi = named_context_of_val evi.evar_hyps let evar_filtered_context evi = Filter.filter_list (evar_filter evi) (evar_context evi) let evar_candidates evi = match evi.evar_candidates with | Undefined c -> c let evar_abstract_arguments evi = match evi.evar_abstract_arguments with | Undefined c -> c let evar_relevance evi = evi.evar_relevance let evar_hyps evi = evi.evar_hyps let evar_filtered_hyps evi = match Filter.repr (evar_filter evi) with | None -> evar_hyps evi | Some filter -> let rec make_hyps filter ctxt = match filter, ctxt with | [], [] -> empty_named_context_val | false :: filter, _ :: ctxt -> make_hyps filter ctxt | true :: filter, decl :: ctxt -> let hyps = make_hyps filter ctxt in push_named_context_val decl hyps | _ -> instance_mismatch () in make_hyps filter (evar_context evi) let evar_env env evi = Environ.reset_with_named_context evi.evar_hyps env let evar_filtered_env env evi = Environ.reset_with_named_context (evar_filtered_hyps evi) env let evar_identity_subst evi = let len = match Filter.repr evi.evar_filter with | None -> List.length @@ Environ.named_context_of_val evi.evar_hyps | Some f -> List.count (fun b -> b) f in SList.defaultn len SList.empty let map_evar_body (type a) f : a evar_body -> a evar_body = function | Evar_empty -> Evar_empty | Evar_defined d -> Evar_defined (f d) let map_when_undefined (type a b) f : (a, b) when_undefined -> (a, b) when_undefined = function | Defined -> Defined | Undefined x -> Undefined (f x) let map_evar_info f evi = {evi with evar_body = map_evar_body f evi.evar_body; evar_hyps = map_named_val (fun d -> NamedDecl.map_constr f d) evi.evar_hyps; evar_concl = map_when_undefined f evi.evar_concl; evar_candidates = map_when_undefined (fun c -> Option.map (List.map f) c) evi.evar_candidates } (* This exception is raised by *.existential_value *) exception NotInstantiatedEvar (* Note: let-in contributes to the instance *) let evar_instance_array empty push info args = let rec instrec pos filter args = match filter with | Filter.Empty -> if SList.is_empty args then empty else instance_mismatch () | Filter.TCons (n, filter) -> instpush pos n filter args | Filter.FCons (n, filter) -> instrec (pos + n) filter args and instpush pos n filter args = if n <= 0 then instrec pos filter args else match args with | SList.Nil -> assert false | SList.Cons (c, args) -> let d = Range.get info.evar_hyps.env_named_idx pos in let id = NamedDecl.get_id d in push id c (instpush (pos + 1) (n - 1) filter args) | SList.Default (m, args) -> if m <= n then instpush (pos + m) (n - m) filter args else instrec (pos + n) filter (SList.defaultn (m - n) args) in match Filter.unfold (evar_filter info) with | None -> let rec instance pos args = match args with | SList.Nil -> empty | SList.Cons (c, args) -> let d = Range.get info.evar_hyps.env_named_idx pos in let id = NamedDecl.get_id d in push id c (instance (pos + 1) args) | SList.Default (n, args) -> instance (pos + n) args in instance 0 args | Some filter -> instrec 0 filter args let make_evar_instance_array info args = if SList.is_default args then [] else let push id c l = if isVarId id c then l else (id, c) :: l in evar_instance_array [] push info args type 'a in_evar_universe_context = 'a * UState.t (*******************************************************************) (* Metamaps *) (*******************************************************************) (* Constraints for existential variables *) (*******************************************************************) type 'a freelisted = { rebus : 'a; freemetas : Int.Set.t } (* Collects all metavars appearing in a constr *) let metavars_of c = let rec collrec acc c = match kind c with | Meta mv -> Int.Set.add mv acc | _ -> Constr.fold collrec acc c in collrec Int.Set.empty c let mk_freelisted c = { rebus = c; freemetas = metavars_of c } let map_fl f cfl = { cfl with rebus=f cfl.rebus } (* Status of an instance found by unification wrt to the meta it solves: - a supertype of the meta (e.g. the solution to ?X <= T is a supertype of ?X) - a subtype of the meta (e.g. the solution to T <= ?X is a supertype of ?X) - a term that can be eta-expanded n times while still being a solution (e.g. the solution [P] to [?X u v = P u v] can be eta-expanded twice) *) type instance_constraint = IsSuperType | IsSubType | Conv let eq_instance_constraint c1 c2 = c1 == c2 (* Status of the unification of the type of an instance against the type of the meta it instantiates: - CoerceToType means that the unification of types has not been done and that a coercion can still be inserted: the meta should not be substituted freely (this happens for instance given via the "with" binding clause). - TypeProcessed means that the information obtainable from the unification of types has been extracted. - TypeNotProcessed means that the unification of types has not been done but it is known that no coercion may be inserted: the meta can be substituted freely. *) type instance_typing_status = CoerceToType | TypeNotProcessed | TypeProcessed (* Status of an instance together with the status of its type unification *) type instance_status = instance_constraint * instance_typing_status (* Clausal environments *) type clbinding = | Cltyp of Name.t * constr freelisted | Clval of Name.t * (constr freelisted * instance_status) * constr freelisted let map_clb f = function | Cltyp (na,cfl) -> Cltyp (na,map_fl f cfl) | Clval (na,(cfl1,pb),cfl2) -> Clval (na,(map_fl f cfl1,pb),map_fl f cfl2) (* name of defined is erased (but it is pretty-printed) *) let clb_name = function Cltyp(na,_) -> (na,false) | Clval (na,_,_) -> (na,true) (***********************) module Metaset = Int.Set module Metamap = Int.Map (*************************) (* Unification state *) type conv_pb = Conversion.conv_pb type evar_constraint = conv_pb * Environ.env * constr * constr module EvMap = Evar.Map module EvNames : sig type t val empty : t val add_name_undefined : Id.t option -> Evar.t -> 'a evar_info -> t -> t val remove_name_defined : Evar.t -> t -> t val rename : Evar.t -> Id.t -> t -> t val reassign_name_defined : Evar.t -> Evar.t -> t -> t val ident : Evar.t -> t -> Id.t option val key : Id.t -> t -> Evar.t val state : t -> Fresh.t end = struct type t = { fwd_map : Id.t EvMap.t; rev_map : Evar.t Id.Map.t; fsh_map : Fresh.t; } let empty = { fwd_map = EvMap.empty; rev_map = Id.Map.empty; fsh_map = Fresh.empty; } let add_name_newly_undefined id evk evi names = match id with | None -> names | Some id -> if Id.Map.mem id names.rev_map then user_err (str "Already an existential evar of name " ++ Id.print id); { fwd_map = EvMap.add evk id names.fwd_map; rev_map = Id.Map.add id evk names.rev_map; fsh_map = Fresh.add id names.fsh_map; } let add_name_undefined naming evk evi evar_names = if EvMap.mem evk evar_names.fwd_map then evar_names else add_name_newly_undefined naming evk evi evar_names let remove_name_defined evk names = let id = try Some (EvMap.find evk names.fwd_map) with Not_found -> None in match id with | None -> names | Some id -> { fwd_map = EvMap.remove evk names.fwd_map; rev_map = Id.Map.remove id names.rev_map; fsh_map = Fresh.remove id names.fsh_map } let rename evk id names = let id' = try Some (EvMap.find evk names.fwd_map) with Not_found -> None in match id' with | None -> { fwd_map = EvMap.add evk id names.fwd_map; rev_map = Id.Map.add id evk names.rev_map; fsh_map = Fresh.add id names.fsh_map } | Some id' -> if Id.Map.mem id names.rev_map then anomaly (str "Evar name already in use."); { fwd_map = EvMap.set evk id names.fwd_map; (* overwrite old name *) rev_map = Id.Map.add id evk (Id.Map.remove id' names.rev_map); fsh_map = Fresh.add id (Fresh.remove id' names.fsh_map) } let reassign_name_defined evk evk' names = let id = try Some (EvMap.find evk names.fwd_map) with Not_found -> None in match id with | None -> names (* evk' must not be defined *) | Some id -> { fwd_map = EvMap.add evk' id (EvMap.remove evk names.fwd_map); rev_map = Id.Map.add id evk' (Id.Map.remove id names.rev_map); fsh_map = names.fsh_map; } let ident evk names = try Some (EvMap.find evk names.fwd_map) with Not_found -> None let key id names = Id.Map.find id names.rev_map let state names = names.fsh_map end type evar_flags = { obligation_evars : Evar.Set.t; aliased_evars : Evar.t Evar.Map.t; typeclass_evars : Evar.Set.t; impossible_case_evars : Evar.Set.t; } type side_effect_role = | Schema of inductive * string type side_effects = { seff_private : Safe_typing.private_constants; seff_roles : side_effect_role Cmap.t; } module FutureGoals : sig type t val comb : t -> Evar.t list val principal : t -> Evar.t option val map_filter : (Evar.t -> Evar.t option) -> t -> t (** Applies a function on the future goals *) val filter : (Evar.t -> bool) -> t -> t (** Applies a filter on the future goals *) type stack val empty_stack : stack val push : stack -> stack val pop : stack -> t * stack val add : principal:bool -> Evar.t -> stack -> stack val remove : Evar.t -> stack -> stack val fold : ('a -> Evar.t -> 'a) -> 'a -> stack -> 'a val pr_stack : stack -> Pp.t end = struct type t = { uid : int; comb : Evar.t Int.Map.t; revmap : int Evar.Map.t; principal : Evar.t option; (** if [Some e], [e] must be contained in [comb]. The evar [e] will inherit properties (now: the name) of the evar which will be instantiated with a term containing [e]. *) } let comb g = (* Keys are reversed, highest number is last introduced *) Int.Map.fold (fun _ evk accu -> evk :: accu) g.comb [] let principal g = g.principal type stack = t list let set f = function | [] -> anomaly Pp.(str"future_goals stack should not be empty") | hd :: tl -> f hd :: tl let add ~principal evk stack = let add fgl = let comb = Int.Map.add fgl.uid evk fgl.comb in let revmap = Evar.Map.add evk fgl.uid fgl.revmap in let principal = if principal then match fgl.principal with | Some _ -> CErrors.user_err Pp.(str "Only one main goal per instantiation.") | None -> Some evk else fgl.principal in let uid = fgl.uid + 1 in let () = assert (0 <= uid) in { comb; revmap; principal; uid } in set add stack let remove e stack = let remove fgl = let filter e' = not (Evar.equal e e') in let principal = Option.filter filter fgl.principal in let comb, revmap = match Evar.Map.find e fgl.revmap with | index -> (Int.Map.remove index fgl.comb, Evar.Map.remove e fgl.revmap) | exception Not_found -> fgl.comb, fgl.revmap in { principal; comb; revmap; uid = fgl.uid } in List.map remove stack let empty = { uid = 0; principal = None; comb = Int.Map.empty; revmap = Evar.Map.empty; } let empty_stack = [empty] let push stack = empty :: stack let pop stack = match stack with | [] -> anomaly Pp.(str"future_goals stack should not be empty") | hd :: tl -> hd, tl let fold f acc stack = let future_goals = List.hd stack in List.fold_left f acc (comb future_goals) let filter f fgl = let fold index evk (comb, revmap) = if f evk then (comb, revmap) else (Int.Map.remove index comb, Evar.Map.remove evk revmap) in let (comb, revmap) = Int.Map.fold fold fgl.comb (fgl.comb, fgl.revmap) in let principal = Option.filter f fgl.principal in { comb; principal; revmap; uid = fgl.uid } let map_filter f fgl = let fold index evk (comb, revmap) = match f evk with | None -> (comb, revmap) | Some evk' -> (Int.Map.add index evk' comb, Evar.Map.add evk' index revmap) in let (comb, revmap) = Int.Map.fold fold fgl.comb (Int.Map.empty, Evar.Map.empty) in let principal = Option.bind fgl.principal f in { comb; revmap; principal; uid = fgl.uid } let pr_stack stack = let open Pp in let pr_future_goals fgl = let comb = comb fgl in prlist_with_sep spc Evar.print comb ++ pr_opt (fun ev -> str"(principal: " ++ Evar.print ev ++ str")") fgl.principal in if List.is_empty stack then str"(empty stack)" else prlist_with_sep (fun () -> str"||") pr_future_goals stack end type evar_map = { (* Existential variables *) defn_evars : defined evar_info EvMap.t; undf_evars : undefined evar_info EvMap.t; evar_names : EvNames.t; candidate_evars : Evar.Set.t; (* The subset of undefined evars with a non-empty candidate list. *) (** Universes *) universes : UState.t; (** Conversion problems *) conv_pbs : evar_constraint list; last_mods : Evar.Set.t; (** Metas *) metas : clbinding Metamap.t; evar_flags : evar_flags; (** Interactive proofs *) effects : side_effects; future_goals : FutureGoals.stack; (** list of newly created evars, to be eventually turned into goals if not solved.*) given_up : Evar.Set.t; shelf : Evar.t list list; extras : Store.t; } let find d e = try EvarInfo (EvMap.find e d.undf_evars) with Not_found -> EvarInfo (EvMap.find e d.defn_evars) let rec thin_val = function | [] -> [] | (id, c) :: tl -> match Constr.kind c with | Constr.Var v -> if Id.equal id v then thin_val tl else (id, make_substituend c) :: (thin_val tl) | _ -> (id, make_substituend c) :: (thin_val tl) let rec find_var id = function | [] -> raise_notrace Not_found | (idc, c) :: subst -> if Id.equal id idc then c else find_var id subst let replace_vars sigma var_alist x = let var_alist = thin_val var_alist in match var_alist with | [] -> x | _ -> let rec substrec n c = match Constr.kind c with | Constr.Var id -> begin match find_var id var_alist with | var -> (lift_substituend n var) | exception Not_found -> c end | Constr.Evar (evk, args) -> let EvarInfo evi = find sigma evk in let args' = substrec_instance n (evar_filtered_context evi) args in if args' == args then c else Constr.mkEvar (evk, args') | _ -> Constr.map_with_binders succ substrec n c and substrec_instance n ctx args = match ctx, SList.view args with | [], None -> SList.empty | decl :: ctx, Some (c, args) -> let c' = match c with | None -> begin match find_var (NamedDecl.get_id decl) var_alist with | var -> Some (lift_substituend n var) | exception Not_found -> None end | Some c -> let c' = substrec n c in if isVarId (NamedDecl.get_id decl) c' then None else Some c' in SList.cons_opt c' (substrec_instance n ctx args) | _ :: _, None | [], Some _ -> instance_mismatch () in substrec 0 x let instantiate_evar_array sigma info c args = let inst = make_evar_instance_array info args in match inst with | [] -> c | _ -> replace_vars sigma inst c let expand_existential sigma (evk, args) = let EvarInfo evi = find sigma evk in let rec expand ctx args = match ctx, SList.view args with | [], None -> [] | _ :: ctx, Some (Some c, args) -> c :: expand ctx args | decl :: ctx, Some (None, args) -> mkVar (NamedDecl.get_id decl) :: expand ctx args | [], Some _ | _ :: _, None -> instance_mismatch () in expand (evar_filtered_context evi) args let expand_existential0 = expand_existential let get_is_maybe_typeclass, (is_maybe_typeclass_hook : (evar_map -> constr -> bool) Hook.t) = Hook.make () let is_maybe_typeclass sigma c = Hook.get get_is_maybe_typeclass sigma c (*** Lifting primitive from Evar.Map. ***) let rename evk id evd = { evd with evar_names = EvNames.rename evk id evd.evar_names } let add_with_name (type a) ?name ?(typeclass_candidate = true) d e (i : a evar_info) = match i.evar_body with | Evar_empty -> let evar_names = EvNames.add_name_undefined name e i d.evar_names in let evar_flags = if typeclass_candidate && is_maybe_typeclass d (evar_concl i) then let flags = d.evar_flags in { flags with typeclass_evars = Evar.Set.add e flags.typeclass_evars } else d.evar_flags in let evar_flags = match i.evar_source with | _, ImpossibleCase -> { evar_flags with impossible_case_evars = Evar.Set.add e evar_flags.impossible_case_evars } | _ -> evar_flags in let candidate_evars = match i.evar_candidates with | Undefined None -> Evar.Set.remove e d.candidate_evars | Undefined (Some _) -> Evar.Set.add e d.candidate_evars in { d with undf_evars = EvMap.add e i d.undf_evars; evar_names; evar_flags; candidate_evars } | Evar_defined _ -> let evar_names = EvNames.remove_name_defined e d.evar_names in { d with defn_evars = EvMap.add e i d.defn_evars; evar_names } (** Evd.add is a low-level function mainly used to update the evar_info associated to an evar, so we prevent registering its typeclass status. *) let add d e i = add_with_name ~typeclass_candidate:false d e i (*** Evar flags: typeclasses, aliased or obligation flag *) let get_typeclass_evars evd = evd.evar_flags.typeclass_evars let set_typeclass_evars evd tcs = let flags = evd.evar_flags in { evd with evar_flags = { flags with typeclass_evars = tcs } } let is_typeclass_evar evd evk = let flags = evd.evar_flags in Evar.Set.mem evk flags.typeclass_evars let get_obligation_evars evd = evd.evar_flags.obligation_evars let set_obligation_evar evd evk = let flags = evd.evar_flags in let evar_flags = { flags with obligation_evars = Evar.Set.add evk flags.obligation_evars } in { evd with evar_flags } let is_obligation_evar evd evk = let flags = evd.evar_flags in Evar.Set.mem evk flags.obligation_evars let get_impossible_case_evars evd = evd.evar_flags.impossible_case_evars (** Inheritance of flags: for evar-evar and restriction cases *) let inherit_evar_flags evar_flags evk evk' = let evk_typeclass = Evar.Set.mem evk evar_flags.typeclass_evars in let evk_obligation = Evar.Set.mem evk evar_flags.obligation_evars in let evk_impossible = Evar.Set.mem evk evar_flags.impossible_case_evars in let aliased_evars = Evar.Map.add evk evk' evar_flags.aliased_evars in let typeclass_evars = if evk_typeclass then let typeclass_evars = Evar.Set.remove evk evar_flags.typeclass_evars in Evar.Set.add evk' typeclass_evars else evar_flags.typeclass_evars in let obligation_evars = if evk_obligation then let obligation_evars = Evar.Set.remove evk evar_flags.obligation_evars in Evar.Set.add evk' obligation_evars else evar_flags.obligation_evars in let impossible_case_evars = if evk_impossible then let impossible_case_evars = Evar.Set.remove evk evar_flags.impossible_case_evars in Evar.Set.add evk' impossible_case_evars else evar_flags.impossible_case_evars in { obligation_evars; aliased_evars; typeclass_evars; impossible_case_evars; } (** Removal: in all other cases of definition *) let remove_evar_flags evk evar_flags = { typeclass_evars = Evar.Set.remove evk evar_flags.typeclass_evars; obligation_evars = Evar.Set.remove evk evar_flags.obligation_evars; impossible_case_evars = Evar.Set.remove evk evar_flags.impossible_case_evars; (* Aliasing information is kept. *) aliased_evars = evar_flags.aliased_evars; } (** New evars *) let evar_counter_summary_name = "evar counter" (* Generator of existential names *) let evar_ctr, evar_counter_summary_tag = Summary.ref_tag 0 ~name:evar_counter_summary_name let new_untyped_evar () = incr evar_ctr; Evar.unsafe_of_int !evar_ctr let default_source = Loc.tag @@ Evar_kinds.InternalHole let remove d e = let undf_evars = EvMap.remove e d.undf_evars in let defn_evars = EvMap.remove e d.defn_evars in let future_goals = FutureGoals.remove e d.future_goals in let evar_flags = remove_evar_flags e d.evar_flags in let candidate_evars = Evar.Set.remove e d.candidate_evars in { d with undf_evars; defn_evars; future_goals; evar_flags; candidate_evars } let undefine sigma e concl = let EvarInfo evi = find sigma e in let evi = { evi with evar_body = Evar_empty; evar_concl = Undefined concl; evar_candidates = Undefined None; evar_abstract_arguments = Undefined Abstraction.identity; } in add (remove sigma e) e evi let find_defined d e = EvMap.find_opt e d.defn_evars let find_undefined d e = EvMap.find e d.undf_evars let mem d e = EvMap.mem e d.undf_evars || EvMap.mem e d.defn_evars let undefined_map d = d.undf_evars let defined_map d = d.defn_evars let drop_all_defined d = { d with defn_evars = EvMap.empty } (* spiwack: not clear what folding over an evar_map, for now we shall simply fold over the inner evar_map. *) let fold f d a = let f evk evi accu = f evk (EvarInfo evi) accu in EvMap.fold f d.defn_evars (EvMap.fold f d.undf_evars a) let fold_undefined f d a = EvMap.fold f d.undf_evars a type map = { map : 'r. Evar.t -> 'r evar_info -> 'r evar_info } let raw_map f d = let defn_evars = EvMap.Smart.mapi f.map d.defn_evars in let undf_evars = EvMap.Smart.mapi f.map d.undf_evars in { d with defn_evars; undf_evars; } let raw_map_undefined f d = { d with undf_evars = EvMap.Smart.mapi f d.undf_evars; } let is_evar = mem let is_defined d e = EvMap.mem e d.defn_evars let is_undefined d e = EvMap.mem e d.undf_evars let existential_opt_value d (n, args) = match EvMap.find_opt n d.defn_evars with | None -> None | Some info -> let Evar_defined c = evar_body info in Some (instantiate_evar_array d info c args) let existential_value d ev = match existential_opt_value d ev with | None -> raise NotInstantiatedEvar | Some v -> v let existential_value0 = existential_value let existential_opt_value0 = existential_opt_value let existential_expand_value0 sigma (evk, args) = match existential_opt_value sigma (evk, args) with | None -> let args = expand_existential sigma (evk, args) in CClosure.EvarUndefined (evk, args) | Some c -> CClosure.EvarDefined c let mkLEvar sigma (evk, args) = let EvarInfo evi = find sigma evk in let fold decl arg accu = if isVarId (NamedDecl.get_id decl) arg then SList.default accu else SList.cons arg accu in let args = List.fold_right2 fold (evar_filtered_context evi) args SList.empty in mkEvar (evk, args) let is_relevance_irrelevant sigma r = match UState.nf_relevance sigma.universes r with | Irrelevant -> true | Relevant | RelevanceVar _ -> false let evar_handler sigma = let evar_expand ev = existential_expand_value0 sigma ev in let qvar_irrelevant q = is_relevance_irrelevant sigma (Sorts.RelevanceVar q) in let evar_irrelevant (evk, _) = match find sigma evk with | EvarInfo evi -> is_relevance_irrelevant sigma evi.evar_relevance | exception Not_found -> false (* Should be an anomaly *) in let evar_repack ev = mkLEvar sigma ev in { CClosure.evar_expand; evar_irrelevant; evar_repack; qvar_irrelevant } let existential_type_opt d (n, args) = match find_undefined d n with | exception Not_found -> None | info -> Some (instantiate_evar_array d info (evar_concl info) args) let existential_type d n = match existential_type_opt d n with | Some t -> t | None -> anomaly (str "Evar " ++ str (string_of_existential (fst n)) ++ str " was not declared.") let existential_type0 = existential_type let add_constraints d c = { d with universes = UState.add_constraints d.universes c } let add_quconstraints d c = { d with universes = UState.add_quconstraints d.universes c } let add_universe_constraints d c = { d with universes = UState.add_universe_constraints d.universes c } (*** /Lifting... ***) (* evar_map are considered empty disregarding histories *) let is_empty d = EvMap.is_empty d.defn_evars && EvMap.is_empty d.undf_evars && List.is_empty d.conv_pbs && Metamap.is_empty d.metas let cmap f evd = { evd with metas = Metamap.map (map_clb f) evd.metas; defn_evars = EvMap.map (map_evar_info f) evd.defn_evars; undf_evars = EvMap.map (map_evar_info f) evd.undf_evars } (* spiwack: deprecated *) let create_evar_defs sigma = { sigma with conv_pbs=[]; last_mods=Evar.Set.empty; metas=Metamap.empty } let empty_evar_flags = { obligation_evars = Evar.Set.empty; aliased_evars = Evar.Map.empty; typeclass_evars = Evar.Set.empty; impossible_case_evars = Evar.Set.empty; } let empty_side_effects = { seff_private = Safe_typing.empty_private_constants; seff_roles = Cmap.empty; } let empty = { defn_evars = EvMap.empty; undf_evars = EvMap.empty; universes = UState.empty; conv_pbs = []; last_mods = Evar.Set.empty; evar_flags = empty_evar_flags; candidate_evars = Evar.Set.empty; metas = Metamap.empty; effects = empty_side_effects; evar_names = EvNames.empty; (* id<->key for undefined evars *) future_goals = FutureGoals.empty_stack; given_up = Evar.Set.empty; shelf = [[]]; extras = Store.empty; } let from_env ?binders e = { empty with universes = UState.from_env ?binders e } let from_ctx uctx = { empty with universes = uctx } let has_undefined evd = not (EvMap.is_empty evd.undf_evars) let has_given_up evd = not (Evar.Set.is_empty evd.given_up) let has_shelved evd = not (List.for_all List.is_empty evd.shelf) let merge_universe_context evd uctx' = { evd with universes = UState.union evd.universes uctx' } let set_universe_context evd uctx' = { evd with universes = uctx' } (* TODO: make unique *) let add_conv_pb ?(tail=false) pb d = if tail then {d with conv_pbs = d.conv_pbs @ [pb]} else {d with conv_pbs = pb::d.conv_pbs} let conv_pbs d = d.conv_pbs let evar_source evi = evi.evar_source let evar_names evd = EvNames.state evd.evar_names let evar_ident evk evd = EvNames.ident evk evd.evar_names let evar_key id evd = EvNames.key id evd.evar_names let get_aliased_evars evd = evd.evar_flags.aliased_evars let max_undefined_with_candidates evd = try Some (Evar.Set.max_elt evd.candidate_evars) with Not_found -> None let is_aliased_evar evd evk = try Some (Evar.Map.find evk evd.evar_flags.aliased_evars) with Not_found -> None let downcast evk ccl evd = let evar_info = EvMap.find evk evd.undf_evars in let evar_info' = { evar_info with evar_concl = Undefined ccl } in { evd with undf_evars = EvMap.add evk evar_info' evd.undf_evars } (* extracts conversion problems that satisfy predicate p *) (* Note: conv_pbs not satisying p are stored back in reverse order *) let extract_conv_pbs evd p = let (pbs,pbs1) = List.fold_left (fun (pbs,pbs1) pb -> if p pb then (pb::pbs,pbs1) else (pbs,pb::pbs1)) ([],[]) evd.conv_pbs in {evd with conv_pbs = pbs1; last_mods = Evar.Set.empty}, pbs let extract_changed_conv_pbs evd p = extract_conv_pbs evd (fun pb -> p evd.last_mods pb) let extract_all_conv_pbs evd = extract_conv_pbs evd (fun _ -> true) let loc_of_conv_pb evd (pbty,env,t1,t2) = match kind (fst (decompose_app t1)) with | Evar (evk1,_) -> let EvarInfo evi = find evd evk1 in fst (evar_source evi) | _ -> match kind (fst (decompose_app t2)) with | Evar (evk2,_) -> let EvarInfo evi = find evd evk2 in fst (evar_source evi) | _ -> None (**********************************************************) (* Sort variables *) type rigid = UState.rigid = | UnivRigid | UnivFlexible of bool (** Is substitution by an algebraic ok? *) let univ_rigid = UnivRigid let univ_flexible = UnivFlexible false let univ_flexible_alg = UnivFlexible true let evar_universe_context d = d.universes let universe_context_set d = UState.context_set d.universes let sort_context_set d = UState.sort_context_set d.universes let to_universe_context evd = UState.context evd.universes let univ_entry ~poly evd = UState.univ_entry ~poly evd.universes let check_univ_decl ~poly evd decl = UState.check_univ_decl ~poly evd.universes decl let restrict_universe_context ?lbound evd vars = { evd with universes = UState.restrict ?lbound evd.universes vars } let universe_subst evd = UState.subst evd.universes let merge_context_set ?loc ?(sideff=false) rigid evd uctx' = {evd with universes = UState.merge ?loc ~sideff rigid evd.universes uctx'} let merge_sort_context_set ?loc ?(sideff=false) rigid evd ctx' = {evd with universes = UState.merge_sort_context ?loc ~sideff rigid evd.universes ctx'} let merge_sort_variables ?loc ?(sideff=false) evd qs = { evd with universes = UState.merge_sort_variables ?loc ~sideff evd.universes qs } let with_context_set ?loc rigid evd (a, uctx) = (merge_context_set ?loc rigid evd uctx, a) let with_sort_context_set ?loc rigid d (a, ctx) = (merge_sort_context_set ?loc rigid d ctx, a) let new_univ_level_variable ?loc ?name rigid evd = let uctx', u = UState.new_univ_variable ?loc rigid name evd.universes in ({evd with universes = uctx'}, u) let new_univ_variable ?loc ?name rigid evd = let uctx', u = UState.new_univ_variable ?loc rigid name evd.universes in ({evd with universes = uctx'}, Univ.Universe.make u) let new_quality_variable ?loc ?name evd = let uctx, q = UState.new_sort_variable ?loc ?name evd.universes in {evd with universes = uctx}, q let new_sort_variable ?loc rigid sigma = let (sigma, u) = new_univ_variable ?loc rigid sigma in let uctx, q = UState.new_sort_variable sigma.universes in ({ sigma with universes = uctx }, Sorts.qsort q u) let add_global_univ d u = { d with universes = UState.add_global_univ d.universes u } let make_nonalgebraic_variable evd u = { evd with universes = UState.make_nonalgebraic_variable evd.universes u } (****************************************) (* Operations on constants *) (****************************************) let fresh_sort_in_family ?loc ?(rigid=univ_flexible) evd s = with_sort_context_set ?loc rigid evd (UnivGen.fresh_sort_in_family s) let fresh_constant_instance ?loc ?(rigid=univ_flexible) env evd c = with_sort_context_set ?loc rigid evd (UnivGen.fresh_constant_instance env c) let fresh_inductive_instance ?loc ?(rigid=univ_flexible) env evd i = with_sort_context_set ?loc rigid evd (UnivGen.fresh_inductive_instance env i) let fresh_constructor_instance ?loc ?(rigid=univ_flexible) env evd c = with_sort_context_set ?loc rigid evd (UnivGen.fresh_constructor_instance env c) let fresh_array_instance ?loc ?(rigid=univ_flexible) env evd = with_sort_context_set ?loc rigid evd (UnivGen.fresh_array_instance env) let fresh_global ?loc ?(rigid=univ_flexible) ?names env evd gr = with_sort_context_set ?loc rigid evd (UnivGen.fresh_global_instance ?loc ?names env gr) let is_flexible_level evd l = let uctx = evd.universes in UnivFlex.mem l (UState.subst uctx) let is_eq_sort s1 s2 = if Sorts.equal s1 s2 then None else Some (s1, s2) (* Precondition: l is not defined in the substitution *) let universe_rigidity evd l = let uctx = evd.universes in (* XXX why are we considering all locals to be flexible here? *) if Univ.Level.Set.mem l (Univ.ContextSet.levels (UState.context_set uctx)) then UnivFlexible (UState.is_algebraic l uctx) else UnivRigid let normalize_universe_instance evd l = UState.nf_instance evd.universes l let normalize_sort evars s = UState.nf_sort evars.universes s (* FIXME inefficient *) let set_eq_sort env d s1 s2 = let s1 = normalize_sort d s1 and s2 = normalize_sort d s2 in match is_eq_sort s1 s2 with | None -> d | Some (u1, u2) -> if not (type_in_type env) then add_universe_constraints d (UnivProblem.Set.singleton (UnivProblem.UEq (u1,u2))) else d let set_eq_level d u1 u2 = add_constraints d (Univ.enforce_eq_level u1 u2 Univ.Constraints.empty) let set_leq_level d u1 u2 = add_constraints d (Univ.enforce_leq_level u1 u2 Univ.Constraints.empty) let set_eq_instances ?(flex=false) d u1 u2 = add_universe_constraints d (UnivProblem.enforce_eq_instances_univs flex u1 u2 UnivProblem.Set.empty) let set_leq_sort env evd s1 s2 = let s1 = normalize_sort evd s1 and s2 = normalize_sort evd s2 in match is_eq_sort s1 s2 with | None -> evd | Some (u1, u2) -> if not (type_in_type env) then add_universe_constraints evd (UnivProblem.Set.singleton (UnivProblem.ULe (u1,u2))) else evd let check_eq evd s s' = let ustate = evd.universes in UGraph.check_eq_sort (UState.ugraph ustate) (UState.nf_sort ustate s) (UState.nf_sort ustate s') let check_leq evd s s' = let ustate = evd.universes in UGraph.check_leq_sort (UState.ugraph ustate) (UState.nf_sort ustate s) (UState.nf_sort ustate s') let check_constraints evd csts = UGraph.check_constraints csts (UState.ugraph evd.universes) let check_qconstraints evd csts = UState.check_qconstraints evd.universes csts let check_quconstraints evd (qcsts,ucsts) = check_qconstraints evd qcsts && check_constraints evd ucsts let fix_undefined_variables evd = { evd with universes = UState.fix_undefined_variables evd.universes } let nf_univ_variables evd = let uctx = UState.normalize_variables evd.universes in {evd with universes = uctx} let collapse_sort_variables evd = let universes = UState.collapse_sort_variables evd.universes in { evd with universes } let minimize_universes ?lbound evd = let uctx' = UState.collapse_sort_variables evd.universes in let uctx' = UState.normalize_variables uctx' in let uctx' = UState.minimize ?lbound uctx' in {evd with universes = uctx'} let universe_of_name evd s = UState.universe_of_name evd.universes s let quality_of_name evd s = UState.quality_of_name evd.universes s let universe_binders evd = UState.universe_binders evd.universes let universes evd = UState.ugraph evd.universes let update_sigma_univs ugraph evd = { evd with universes = UState.update_sigma_univs evd.universes ugraph } exception UniversesDiffer = UState.UniversesDiffer (**********************************************************) (* Side effects *) let concat_side_effects eff eff' = { seff_private = Safe_typing.concat_private eff.seff_private eff'.seff_private; seff_roles = Cmap.fold Cmap.add eff.seff_roles eff'.seff_roles; } let emit_side_effects eff evd = let effects = concat_side_effects eff evd.effects in { evd with effects; universes = UState.emit_side_effects eff.seff_private evd.universes } let drop_side_effects evd = { evd with effects = empty_side_effects; } let eval_side_effects evd = evd.effects (* Future goals *) let declare_future_goal evk evd = let future_goals = FutureGoals.add ~principal:false evk evd.future_goals in { evd with future_goals } let declare_principal_goal evk evd = let future_goals = FutureGoals.add ~principal:true evk evd.future_goals in { evd with future_goals } let push_future_goals evd = { evd with future_goals = FutureGoals.push evd.future_goals } let pop_future_goals evd = let hd, future_goals = FutureGoals.pop evd.future_goals in hd, { evd with future_goals } let fold_future_goals f sigma = FutureGoals.fold f sigma sigma.future_goals let remove_future_goal evd evk = { evd with future_goals = FutureGoals.remove evk evd.future_goals } let pr_future_goals_stack evd = FutureGoals.pr_stack evd.future_goals let give_up ev evd = { evd with given_up = Evar.Set.add ev evd.given_up } let push_shelf evd = { evd with shelf = [] :: evd.shelf } let pop_shelf evd = match evd.shelf with | [] -> anomaly Pp.(str"shelf stack should not be empty") | hd :: tl -> hd, { evd with shelf = tl } let filter_shelf f evd = { evd with shelf = List.map (List.filter f) evd.shelf } let shelve evd l = match evd.shelf with | [] -> anomaly Pp.(str"shelf stack should not be empty") | hd :: tl -> { evd with shelf = (hd@l) :: tl } let unshelve evd l = { evd with shelf = List.map (List.filter (fun ev -> not (CList.mem_f Evar.equal ev l))) evd.shelf } let given_up evd = evd.given_up let shelf evd = List.flatten evd.shelf let pr_shelf evd = let open Pp in if List.is_empty evd.shelf then str"(empty stack)" else prlist_with_sep (fun () -> str"||") (prlist_with_sep spc Evar.print) evd.shelf let new_pure_evar ?(src=default_source) ?(filter = Filter.identity) ?(relevance = Sorts.Relevant) ?(abstract_arguments = Abstraction.identity) ?candidates ?name ?typeclass_candidate ?(principal=false) sign evd typ = let evi = { evar_hyps = sign; evar_concl = Undefined typ; evar_body = Evar_empty; evar_filter = filter; evar_abstract_arguments = Undefined abstract_arguments; evar_source = src; evar_candidates = Undefined candidates; evar_relevance = relevance; } in let typeclass_candidate = if principal then Some false else typeclass_candidate in let newevk = new_untyped_evar () in let evd = add_with_name evd ?name ?typeclass_candidate newevk evi in let evd = if principal then declare_principal_goal newevk evd else declare_future_goal newevk evd in (evd, newevk) let define_aux def undef evk body = let oldinfo = try EvMap.find evk undef with Not_found -> if EvMap.mem evk def then anomaly ~label:"Evd.define" (Pp.str "cannot define an evar twice.") else anomaly ~label:"Evd.define" (Pp.str "cannot define undeclared evar.") in let () = assert (oldinfo.evar_body == Evar_empty) in let newinfo = { oldinfo with evar_body = Evar_defined body; evar_concl = Defined; evar_candidates = Defined; evar_abstract_arguments = Defined; } in EvMap.add evk newinfo def, EvMap.remove evk undef (* define the existential of section path sp as the constr body *) let define_gen evk body evd evar_flags = let future_goals = FutureGoals.remove evk evd.future_goals in let evd = { evd with future_goals } in let (defn_evars, undf_evars) = define_aux evd.defn_evars evd.undf_evars evk body in let last_mods = match evd.conv_pbs with | [] -> evd.last_mods | _ -> Evar.Set.add evk evd.last_mods in let evar_names = EvNames.remove_name_defined evk evd.evar_names in let candidate_evars = Evar.Set.remove evk evd.candidate_evars in { evd with defn_evars; undf_evars; last_mods; evar_names; evar_flags; candidate_evars } (** By default, the obligation and evar tag of the evar is removed *) let define evk body evd = let evar_flags = remove_evar_flags evk evd.evar_flags in define_gen evk body evd evar_flags (** In case of an evar-evar solution, the flags are inherited *) let define_with_evar evk body evd = let evk' = fst (destEvar body) in let evar_flags = inherit_evar_flags evd.evar_flags evk evk' in let evd = unshelve evd [evk] in define_gen evk body evd evar_flags (* In case of restriction, we declare the aliasing and inherit the obligation and typeclass flags. *) let restrict evk filter ?candidates ?src evd = let evk' = new_untyped_evar () in let evar_info = EvMap.find evk evd.undf_evars in let len = Range.length evar_info.evar_hyps.env_named_idx in let id_inst = Filter.filter_slist filter (SList.defaultn len SList.empty) in let evar_info' = { evar_info with evar_filter = filter; evar_candidates = Undefined candidates; evar_source = (match src with None -> evar_info.evar_source | Some src -> src); } in let last_mods = match evd.conv_pbs with | [] -> evd.last_mods | _ -> Evar.Set.add evk evd.last_mods in let evar_names = EvNames.reassign_name_defined evk evk' evd.evar_names in let body = mkEvar(evk',id_inst) in let (defn_evars, undf_evars) = define_aux evd.defn_evars evd.undf_evars evk body in let evar_flags = inherit_evar_flags evd.evar_flags evk evk' in let evar_flags = match src with | Some (_,Evar_kinds.ImpossibleCase) -> { evar_flags with impossible_case_evars = Evar.Set.add evk' evar_flags.impossible_case_evars } | _ -> evar_flags in let candidate_evars = Evar.Set.remove evk evd.candidate_evars in let candidate_evars = match candidates with | None -> candidate_evars | Some _ -> Evar.Set.add evk' candidate_evars in let evd = { evd with undf_evars = EvMap.add evk' evar_info' undf_evars; defn_evars; last_mods; evar_names; evar_flags; candidate_evars } in (* Mark new evar as future goal, removing previous one, circumventing Proofview.advance but making Proof.run_tactic catch these. *) let evd = unshelve evd [evk] in let evd = remove_future_goal evd evk in let evd = declare_future_goal evk' evd in (evd, evk') let update_source evd evk src = let modify _ info = { info with evar_source = src } in { evd with undf_evars = EvMap.modify evk modify evd.undf_evars } (**********************************************************) (* Accessing metas *) (** We use this function to overcome OCaml compiler limitations and to prevent the use of costly in-place modifications. *) let set_metas evd metas = { defn_evars = evd.defn_evars; undf_evars = evd.undf_evars; universes = evd.universes; conv_pbs = evd.conv_pbs; last_mods = evd.last_mods; evar_flags = evd.evar_flags; candidate_evars = evd.candidate_evars; metas; effects = evd.effects; evar_names = evd.evar_names; future_goals = evd.future_goals; given_up = evd.given_up; shelf = evd.shelf; extras = evd.extras; } let meta_list evd = evd.metas let map_metas_fvalue f evd = let map = function | Clval(id,(c,s),typ) -> Clval(id,(mk_freelisted (f c.rebus),s),typ) | x -> x in set_metas evd (Metamap.Smart.map map evd.metas) let map_metas f evd = let map cl = map_clb f cl in set_metas evd (Metamap.Smart.map map evd.metas) let meta_opt_fvalue evd mv = match Metamap.find mv evd.metas with | Clval(_,b,_) -> Some b | Cltyp _ -> None let meta_value evd mv = match meta_opt_fvalue evd mv with | Some (body, _) -> body.rebus | None -> raise Not_found let meta_ftype evd mv = match Metamap.find mv evd.metas with | Cltyp (_,b) -> b | Clval(_,_,b) -> b let meta_declare mv v ?(name=Anonymous) evd = let metas = Metamap.add mv (Cltyp(name,mk_freelisted v)) evd.metas in set_metas evd metas (* If the meta is defined then forget its name *) let meta_name evd mv = try fst (clb_name (Metamap.find mv evd.metas)) with Not_found -> Anonymous let evar_source_of_meta mv evd = match meta_name evd mv with | Anonymous -> Loc.tag Evar_kinds.GoalEvar | Name id -> Loc.tag @@ Evar_kinds.VarInstance id let use_meta_source evd mv v = match Constr.kind v with | Evar (evk,_) -> let f = function | None -> None | Some evi as x -> match evi.evar_source with | None, Evar_kinds.GoalEvar -> Some { evi with evar_source = evar_source_of_meta mv evd } | _ -> x in { evd with undf_evars = EvMap.update evk f evd.undf_evars } | _ -> evd let meta_assign mv (v, pb) evd = let modify _ = function | Cltyp (na, ty) -> Clval (na, (mk_freelisted v, pb), ty) | _ -> anomaly ~label:"meta_assign" (Pp.str "already defined.") in let metas = Metamap.modify mv modify evd.metas in let evd = use_meta_source evd mv v in set_metas evd metas let meta_reassign mv (v, pb) evd = let modify _ = function | Clval(na, _, ty) -> Clval (na, (mk_freelisted v, pb), ty) | _ -> anomaly ~label:"meta_reassign" (Pp.str "not yet defined.") in let metas = Metamap.modify mv modify evd.metas in set_metas evd metas let clear_metas evd = {evd with metas = Metamap.empty} let meta_merge metas sigma = let metas = Metamap.fold Metamap.add metas sigma.metas in { sigma with metas } type metabinding = metavariable * constr * instance_status let retract_coercible_metas evd = let mc = ref [] in let map n v = match v with | Clval (na, (b, (Conv, CoerceToType as s)), typ) -> let () = mc := (n, b.rebus, s) :: !mc in Cltyp (na, typ) | v -> v in let metas = Metamap.Smart.mapi map evd.metas in !mc, set_metas evd metas let dependent_evar_ident ev evd = let EvarInfo evi = find evd ev in match evi.evar_source with | (_,Evar_kinds.VarInstance id) -> id | _ -> anomaly (str "Not an evar resulting of a dependent binding.") (**********************************************************) (* Extra data *) let get_extra_data evd = evd.extras let set_extra_data extras evd = { evd with extras } (*******************************************************************) type open_constr = evar_map * constr (*******************************************************************) (* The state monad with state an evar map. *) module MonadR = Monad.Make (struct type +'a t = evar_map -> evar_map * 'a let return a = fun s -> (s,a) let (>>=) x f = fun s -> let (s',a) = x s in f a s' let (>>) x y = fun s -> let (s',()) = x s in y s' let map f x = fun s -> on_snd f (x s) end) module Monad = Monad.Make (struct type +'a t = evar_map -> 'a * evar_map let return a = fun s -> (a,s) let (>>=) x f = fun s -> let (a,s') = x s in f a s' let (>>) x y = fun s -> let ((),s') = x s in y s' let map f x = fun s -> on_fst f (x s) end) (**********************************************************) (* Failure explanation *) type unsolvability_explanation = SeveralInstancesFound of int module Expand : sig type handle val empty_handle : handle (* val liftn_handle : int -> handle -> handle *) val kind : evar_map -> handle -> constr -> handle * (constr, constr, Sorts.t, UVars.Instance.t, Sorts.relevance) kind_of_term val expand : evar_map -> handle -> constr -> constr end = struct type clos = { evc_map : (int * clos * Constr.t) Id.Map.t; (* Map each bound ident to its value and the depth it was introduced at *) evc_lift : int; (* number of binders crossed since last evar *) evc_stack : int list; (* stack of binders crossed at each evar *) evc_depth : int; (* length of evc_stack *) evc_cache : int Int.Map.t ref option; (* Cache get_lift on evc_stack *) } let empty_clos = { evc_lift = 0; evc_depth = 0; evc_stack = []; evc_map = Id.Map.empty; evc_cache = None; } let push_clos info clos args = let push id c map = Id.Map.add id (clos.evc_depth, clos, c) map in let nmap = evar_instance_array clos.evc_map push info args in { evc_lift = 0; evc_map = nmap; evc_depth = clos.evc_depth + 1; evc_stack = clos.evc_lift :: clos.evc_stack; evc_cache = Some (ref Int.Map.empty); } let find_clos clos id = match Id.Map.find_opt id clos.evc_map with | None -> None | Some (depth, nclos, v) -> let pos = clos.evc_depth - depth - 1 in let rec get_lift accu n lft = if Int.equal n 0 then accu else match lft with | [] -> assert false | k :: lft -> get_lift (accu + k) (n - 1) lft in let ans = match clos.evc_cache with | None -> assert false | Some cache -> match Int.Map.find_opt pos !cache with | None -> let ans = get_lift 0 pos clos.evc_stack in let () = cache := Int.Map.add pos ans !cache in ans | Some ans -> ans in let k = clos.evc_lift + ans in Some (k, nclos, v) type handle = { h_clos : clos; h_lift : Esubst.lift; } let empty_handle = { h_clos = empty_clos; h_lift = Esubst.el_id; } let liftn_clos n s = { s with evc_lift = s.evc_lift + n } let liftn_handle n h = { h_clos = liftn_clos n h.h_clos; h_lift = Esubst.el_liftn n h.h_lift; } let rec kind sigma h c = match Constr.kind c with | Rel n -> h, Rel (Esubst.reloc_rel n h.h_lift) | Var id as c0 -> begin match find_clos h.h_clos id with | None -> (h, c0) | Some (k, clos, v) -> let h = { h_clos = clos; h_lift = Esubst.el_shft k h.h_lift } in kind sigma h v end | Evar (evk, args) as c0 -> begin match EvMap.find_opt evk sigma.defn_evars with | None -> (h, c0) | Some info -> let Evar_defined c = evar_body info in let nclos = push_clos info h.h_clos args in kind sigma { h_lift = h.h_lift; h_clos = nclos } c end | Meta _ | Sort _ | Cast _ | Prod _ | Lambda _ | LetIn _ | App _ | Const _ | Ind _ | Construct _ | Case _ | Fix _ | CoFix _ | Proj _ | Int _ | Float _ | String _ | Array _ as c0 -> (h, c0) let expand0 sigma h c = let lift h = liftn_handle 1 h in let rec aux h c = match Constr.kind c with | Rel n -> let n' = Esubst.reloc_rel n h.h_lift in if Int.equal n n' then c else mkRel n' | Var id -> begin match find_clos h.h_clos id with | None -> c | Some (k, clos, v) -> let h = { h_clos = clos; h_lift = Esubst.el_shft k h.h_lift } in aux h v end | Evar (evk, args) -> (* for efficiency do not expand evars, just their instance *) let EvarInfo evi = find sigma evk in let push decl c args = if isVarId (NamedDecl.get_id decl) c then SList.default args else SList.cons c args in let rec expand ctx args = match ctx, SList.view args with | [], None -> SList.empty | decl :: ctx, Some (Some c, args) -> let c = aux h c in push decl c (expand ctx args) | decl :: ctx, Some (None, args) -> let c = aux h (mkVar (NamedDecl.get_id decl)) in push decl c (expand ctx args) | [], Some _ | _ :: _, None -> instance_mismatch () in let args = expand (evar_filtered_context evi) args in mkEvar (evk, args) | _ -> Constr.map_with_binders lift aux h c in aux h c let expand sigma h c = if Esubst.is_lift_id h.h_lift && Id.Map.is_empty h.h_clos.evc_map then c else expand0 sigma h c end module MiniEConstr = struct module ERelevance = struct type t = Sorts.relevance let make r = r let unsafe_to_relevance r = r let kind sigma r = UState.nf_relevance sigma.universes r end module ESorts = struct type t = Sorts.t let make s = s let kind = normalize_sort let unsafe_to_sorts s = s end module EInstance = struct type t = UVars.Instance.t let make i = i let kind sigma i = if UVars.Instance.is_empty i then i else normalize_universe_instance sigma i let empty = UVars.Instance.empty let is_empty = UVars.Instance.is_empty let unsafe_to_instance t = t end type t = econstr let rec whd_evar sigma c = match Constr.kind c with | Evar ev -> let (h, knd) = Expand.kind sigma Expand.empty_handle c in if Constr.kind c == knd then c else whd_kind sigma h knd | App (f, args) when isEvar f -> (* Enforce smart constructor invariant on applications *) let (h, knd) = Expand.kind sigma Expand.empty_handle f in if Constr.kind f == knd then c else mkApp (whd_kind sigma h knd, args) | Cast (c0, k, t) when isEvar c0 -> (* Enforce smart constructor invariant on casts. *) let (h, knd) = Expand.kind sigma Expand.empty_handle c0 in if Constr.kind c0 == knd then c else mkCast (whd_kind sigma h knd, k, t) | _ -> c and whd_kind sigma h knd = (* we need to force the head as Expand.expand does not expand evar subterms *) whd_evar sigma (Expand.expand sigma h (Constr.of_kind knd)) let mkLEvar = mkLEvar let replace_vars = replace_vars let kind sigma c = Constr.kind (whd_evar sigma c) let kind_upto = kind let of_kind = Constr.of_kind let of_constr c = c let of_constr_array v = v let unsafe_to_constr c = c let unsafe_to_constr_array v = v let unsafe_eq = Refl let unsafe_relevance_eq = Refl type evclos = { evc_map : (int * Vars.substituend Lazy.t) Id.Map.t; (* Map each bound ident to its value and the depth it was introduced at *) evc_lift : int; (* number of binders crossed since last evar *) evc_stack : int list; (* stack of binders crossed at each evar *) evc_depth : int; (* length of evc_stack *) evc_cache : int Int.Map.t ref; (* Cache get_lift on evc_stack *) } let to_constr_gen ~expand ~ignore_missing sigma c = let saw_evar = ref false in let lsubst = universe_subst sigma in let univ_value l = UnivFlex.normalize_univ_variable lsubst l in let qvar_value q = UState.nf_qvar sigma.universes q in let next s = { s with evc_lift = s.evc_lift + 1 } in let find clos id = match Id.Map.find_opt id clos.evc_map with | None -> None | Some (depth, lazy v) -> let pos = clos.evc_depth - depth - 1 in let rec get_lift accu n lft = if Int.equal n 0 then accu else match lft with | [] -> assert false | k :: lft -> get_lift (accu + k) (n - 1) lft in let ans = match Int.Map.find_opt pos clos.evc_cache.contents with | None -> let ans = get_lift 0 pos clos.evc_stack in let () = clos.evc_cache := Int.Map.add pos ans clos.evc_cache.contents in ans | Some ans -> ans in let k = clos.evc_lift + ans in Some (lift_substituend k v) in let rec self clos c = match Constr.kind c with | Var id -> begin match find clos id with | None -> c | Some v -> v end | Evar (evk, args) -> begin match EvMap.find_opt evk sigma.defn_evars with | None -> let () = saw_evar := true in begin match EvMap.find_opt evk sigma.undf_evars with | None -> if ignore_missing then let map c = self clos c in let args' = SList.Smart.map map args in if args' == args then c else mkEvar (evk, args') else raise Not_found | Some evi -> let rec inst ctx args = match ctx, SList.view args with | [], None -> SList.empty | decl :: ctx, Some (c, args) -> let c = match c with | None -> let c = find clos (NamedDecl.get_id decl) in if expand then match c with | None -> Some (mkVar (NamedDecl.get_id decl)) | Some _ -> c else c | Some c -> Some (self clos c) in SList.cons_opt c (inst ctx args) | _ :: _, None | [], Some _ -> instance_mismatch () in let args' = inst (evar_filtered_context evi) args in if args == args' then c else mkEvar (evk, args') end | Some info -> let Evar_defined c = evar_body info in let push id c map = Id.Map.add id (clos.evc_depth, lazy (make_substituend (self clos c))) map in let nmap = evar_instance_array clos.evc_map push info args in let nclos = { evc_lift = 0; evc_map = nmap; evc_depth = clos.evc_depth + 1; evc_stack = clos.evc_lift :: clos.evc_stack; evc_cache = ref Int.Map.empty; } in self nclos c end | _ -> UnivSubst.map_universes_opt_subst_with_binders next self qvar_value univ_value clos c in let clos = { evc_lift = 0; evc_depth = 0; evc_stack = []; evc_map = Id.Map.empty; evc_cache = ref Int.Map.empty; } in let c = self clos c in !saw_evar, c let check_evar c = let exception SawEvar in let rec iter c = match Constr.kind c with | Evar _ -> raise SawEvar | _ -> Constr.iter iter c in try iter c; false with SawEvar -> true let to_constr ?(abort_on_undefined_evars=true) sigma c = let saw_evar, c = to_constr_gen ~expand:true ~ignore_missing:false sigma c in if abort_on_undefined_evars && saw_evar && check_evar c then anomaly ~label:"econstr" Pp.(str "grounding a non evar-free term") else c let to_constr_opt sigma c = let saw_evar, c = to_constr_gen ~expand:false ~ignore_missing:false sigma c in if saw_evar && check_evar c then None else Some c let nf_evar sigma c = let _, c = to_constr_gen ~expand:false ~ignore_missing:true sigma c in c let of_named_decl d = d let unsafe_to_named_decl d = d let of_rel_decl d = d let unsafe_to_rel_decl d = d let of_named_context d = d let of_rel_context d = d let unsafe_to_case_invert x = x let of_case_invert x = x end (** The following functions return the set of evars immediately contained in the object *) (* excluding defined evars *) let evars_of_term evd c = let rec evrec acc c = let c = MiniEConstr.whd_evar evd c in match kind c with | Evar (n, l) -> Evar.Set.add n (SList.Skip.fold evrec acc l) | _ -> Constr.fold evrec acc c in evrec Evar.Set.empty c let evars_of_named_context evd nc = Context.Named.fold_outside (NamedDecl.fold_constr (fun constr s -> Evar.Set.union s (evars_of_term evd constr))) nc ~init:Evar.Set.empty let evars_of_filtered_evar_info (type a) evd (evi : a evar_info) = let concl = match evi.evar_concl with | Undefined c -> evars_of_term evd c | Defined -> Evar.Set.empty in Evar.Set.union concl (Evar.Set.union (match evi.evar_body with | Evar_empty -> Evar.Set.empty | Evar_defined b -> evars_of_term evd b) (evars_of_named_context evd (evar_filtered_context evi))) let drop_new_defined ~original sigma = let to_keep, to_drop = Evar.Map.partition (fun ev _ -> Evar.Map.mem ev original.defn_evars || Evar.Map.mem ev original.undf_evars) sigma.defn_evars in let dummy = { empty with defn_evars = to_drop } in let nfc c = snd @@ MiniEConstr.to_constr_gen ~expand:true ~ignore_missing:false dummy c in (* FIXME: do we really need to expand? *) assert (Metamap.is_empty sigma.metas); assert (List.is_empty sigma.conv_pbs); let normalize_changed _ev orig evi = match orig, evi with | _, None -> None | None, Some evi -> Some (map_evar_info nfc evi) | Some orig, Some evi -> if orig == evi then None else Some (map_evar_info nfc evi) in let normalize_against original current = let normalized = EvMap.merge normalize_changed original current in EvMap.union (fun _ _ x -> Some x) current normalized in let to_keep = normalize_against original.defn_evars to_keep in let undf_evars = normalize_against original.undf_evars sigma.undf_evars in { sigma with defn_evars = to_keep; undf_evars } coq-8.20.0/engine/evd.mli000066400000000000000000000727731466560755400151530ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* t -> bool (** Equality over filters *) val identity : t (** The identity filter. *) val filter_list : t -> 'a list -> 'a list (** Filter a list. Sizes must coincide. *) val filter_array : t -> 'a array -> 'a array (** Filter an array. Sizes must coincide. *) val filter_slist : t -> 'a SList.t -> 'a SList.t (** Filter a sparse list. Sizes must coincide. *) val extend : int -> t -> t (** [extend n f] extends [f] on the left with [n]-th times [true]. *) val compose : t -> t -> t (** Horizontal composition : [compose f1 f2] only keeps parts of [f2] where [f1] is set. In particular, [f1] and [f2] must have the same length. *) val apply_subfilter : t -> bool list -> t (** [apply_subfilter f1 f2] applies filter [f2] where [f1] is [true]. In particular, the length of [f2] is the number of times [f1] is [true] *) val restrict_upon : t -> int -> (int -> bool) -> t option (** Ad-hoc primitive. *) val map_along : (bool -> 'a -> bool) -> t -> 'a list -> t (** Apply the function on the filter and the list. Sizes must coincide. *) val make : bool list -> t (** Create out of a list *) val repr : t -> bool list option (** Observe as a bool list. *) end module Abstraction : sig type abstraction = | Abstract | Imitate type t = abstraction list val identity : t val abstract_last : t -> t end (** {6 Evar infos} *) type defined = [ `defined ] type undefined = [ `undefined ] type _ evar_body = | Evar_empty : undefined evar_body | Evar_defined : econstr -> defined evar_body type 'a evar_info type any_evar_info = EvarInfo : 'a evar_info -> any_evar_info (** {6 Projections from evar infos} *) val evar_concl : undefined evar_info -> econstr (** Type of the evar. *) val evar_context : 'a evar_info -> (econstr, etypes, erelevance) Context.Named.pt (** Context of the evar. *) val evar_hyps : 'a evar_info -> named_context_val (** Context of the evar. *) val evar_body : 'a evar_info -> 'a evar_body (** Optional content of the evar. *) val evar_candidates : undefined evar_info -> econstr list option (** List of possible solutions when known that it is a finite list *) val evar_source : 'a evar_info -> Evar_kinds.t located val evar_filter : 'a evar_info -> Filter.t (** Boolean mask over {!evar_hyps}. Should have the same length. When filtered out, the corresponding variable is not allowed to occur in the solution *) val evar_abstract_arguments : undefined evar_info -> Abstraction.t (** Boolean information over {!evar_hyps}, telling if an hypothesis instance can be imitated or should stay abstract in HO unification problems and inversion (see [second_order_matching_with_args] for its use). *) val evar_relevance : 'a evar_info -> erelevance (** Relevance of the conclusion of the evar. *) (** {6 Derived projections} *) val evar_filtered_context : 'a evar_info -> (econstr, etypes, erelevance) Context.Named.pt val evar_filtered_hyps : 'a evar_info -> named_context_val val evar_env : env -> 'a evar_info -> env val evar_filtered_env : env -> 'a evar_info -> env val evar_identity_subst : 'a evar_info -> econstr SList.t val map_evar_body : (econstr -> econstr) -> 'a evar_body -> 'a evar_body val map_evar_info : (econstr -> econstr) -> 'a evar_info -> 'a evar_info (** {6 Unification state} **) type evar_map (** Type of unification state. Essentially a bunch of state-passing data needed to handle incremental term construction. *) val empty : evar_map (** The empty evar map. *) val from_env : ?binders:lident list -> env -> evar_map (** The empty evar map with given universe context, taking its initial universes from env, possibly with initial universe binders. This is the main entry point at the beginning of the process of interpreting a declaration (e.g. before entering the interpretation of a Theorem statement). *) val from_ctx : UState.t -> evar_map (** The empty evar map with given universe context. This is the main entry point when resuming from a already interpreted declaration (e.g. after having interpreted a Theorem statement and preparing to open a goal). *) val is_empty : evar_map -> bool (** Whether an evarmap is empty. *) val has_undefined : evar_map -> bool (** [has_undefined sigma] is [true] if and only if there are uninstantiated evars in [sigma]. *) val has_given_up : evar_map -> bool (** [has_given_up sigma] is [true] if and only if there are given up evars in [sigma]. *) val has_shelved : evar_map -> bool (** [has_shelved sigma] is [true] if and only if there are shelved evars in [sigma]. *) val new_pure_evar : ?src:Evar_kinds.t Loc.located -> ?filter:Filter.t -> ?relevance:erelevance -> ?abstract_arguments:Abstraction.t -> ?candidates:econstr list -> ?name:Id.t -> ?typeclass_candidate:bool -> ?principal:bool -> named_context_val -> evar_map -> etypes -> evar_map * Evar.t (** Low-level interface to create an evar. @param src User-facing source for the evar @param filter See {!Evd.Filter}, must be the same length as [named_context_val] @param name A name for the evar @param principal Whether the evar is the principal goal @param named_context_val The context of the evar @param types The type of conclusion of the evar *) val add : evar_map -> Evar.t -> 'a evar_info -> evar_map (** [add sigma ev info] adds [ev] with evar info [info] in sigma. Precondition: ev must not preexist in [sigma]. *) val find_defined : evar_map -> Evar.t -> defined evar_info option val find : evar_map -> Evar.t -> any_evar_info (** Recover the data associated to an evar. *) val find_undefined : evar_map -> Evar.t -> undefined evar_info (** Same as {!find} but restricted to undefined evars. For efficiency reasons. *) val remove : evar_map -> Evar.t -> evar_map (** Remove an evar from an evar map. Use with caution. *) val undefine : evar_map -> Evar.t -> etypes -> evar_map [@@ocaml.deprecated] (** Remove the body of an evar. Only there for backward compat, do not use. *) val mem : evar_map -> Evar.t -> bool (** Whether an evar is present in an evarmap. *) val fold : (Evar.t -> any_evar_info -> 'a -> 'a) -> evar_map -> 'a -> 'a (** Apply a function to all evars and their associated info in an evarmap. *) val fold_undefined : (Evar.t -> undefined evar_info -> 'a -> 'a) -> evar_map -> 'a -> 'a (** Same as {!fold}, but restricted to undefined evars. For efficiency reasons. *) type map = { map : 'r. Evar.t -> 'r evar_info -> 'r evar_info } val raw_map : map -> evar_map -> evar_map (** Apply the given function to all evars in the map. Beware: this function expects the argument function to preserve the kind of [evar_body], i.e. it must send [Evar_empty] to [Evar_empty] and [Evar_defined c] to some [Evar_defined c']. *) val raw_map_undefined : (Evar.t -> undefined evar_info -> undefined evar_info) -> evar_map -> evar_map (** Same as {!raw_map}, but restricted to undefined evars. For efficiency reasons. *) val define : Evar.t -> econstr -> evar_map -> evar_map (** Set the body of an evar to the given constr. It is expected that: {ul {- The evar is already present in the evarmap.} {- The evar is not defined in the evarmap yet.} {- All the evars present in the constr should be present in the evar map.} } *) val define_with_evar : Evar.t -> econstr -> evar_map -> evar_map (** Same as [define ev body evd], except the body must be an existential variable [ev']. This additionally makes [ev'] inherit the [obligation] and [typeclass] flags of [ev]. *) val cmap : (econstr -> econstr) -> evar_map -> evar_map (** Map the function on all terms in the evar map. *) val is_evar : evar_map -> Evar.t-> bool (** Alias for {!mem}. *) val is_defined : evar_map -> Evar.t-> bool (** Whether an evar is defined in an evarmap. *) val is_undefined : evar_map -> Evar.t-> bool (** Whether an evar is not defined in an evarmap. *) val add_constraints : evar_map -> Univ.Constraints.t -> evar_map (** Add universe constraints in an evar map. *) val add_quconstraints : evar_map -> Sorts.QUConstraints.t -> evar_map val undefined_map : evar_map -> undefined evar_info Evar.Map.t (** Access the undefined evar mapping directly. *) val defined_map : evar_map -> defined evar_info Evar.Map.t (** Access the defined evar mapping directly. *) val drop_all_defined : evar_map -> evar_map val drop_new_defined : original:evar_map -> evar_map -> evar_map (** Drop the defined evars in the second evar map which did not exist in the first. *) val is_maybe_typeclass_hook : (evar_map -> constr -> bool) Hook.t (** {6 Instantiating partial terms} *) exception NotInstantiatedEvar val existential_value : evar_map -> econstr pexistential -> econstr (** [existential_value sigma ev] raises [NotInstantiatedEvar] if [ev] has no body and [Not_found] if it does not exist in [sigma] *) val existential_value0 : evar_map -> existential -> constr val existential_type_opt : evar_map -> econstr pexistential -> etypes option val existential_type : evar_map -> econstr pexistential -> etypes val existential_type0 : evar_map -> existential -> types val existential_opt_value : evar_map -> econstr pexistential -> econstr option (** Same as {!existential_value} but returns an option instead of raising an exception. *) val existential_opt_value0 : evar_map -> existential -> constr option val evar_handler : evar_map -> CClosure.evar_handler val existential_expand_value0 : evar_map -> existential -> constr CClosure.evar_expansion val expand_existential : evar_map -> econstr pexistential -> econstr list (** Returns the full evar instance with implicit default variables turned into explicit [Var] nodes. *) val expand_existential0 : evar_map -> constr pexistential -> constr list val instantiate_evar_array : evar_map -> 'a evar_info -> econstr -> econstr SList.t -> econstr (** {6 Misc} *) val restrict : Evar.t-> Filter.t -> ?candidates:econstr list -> ?src:Evar_kinds.t located -> evar_map -> evar_map * Evar.t (** Restrict an undefined evar into a new evar by filtering context and possibly limiting the instances to a set of candidates (candidates are filtered according to the filter) *) val update_source : evar_map -> Evar.t -> Evar_kinds.t located -> evar_map (** To update the source a posteriori, e.g. when an evar type of another evar has to refer to this other evar, with a mutual dependency *) val get_aliased_evars : evar_map -> Evar.t Evar.Map.t (** The map of aliased evars *) val is_aliased_evar : evar_map -> Evar.t -> Evar.t option (** Tell if an evar has been aliased to another evar, and if yes, which *) val max_undefined_with_candidates : evar_map -> Evar.t option (** If any, the evar with highest id with a non-empty list of candidates. *) val set_typeclass_evars : evar_map -> Evar.Set.t -> evar_map (** Mark the given set of evars as available for resolution. Precondition: they should indeed refer to undefined typeclass evars. *) val get_typeclass_evars : evar_map -> Evar.Set.t (** The set of undefined typeclass evars *) val is_typeclass_evar : evar_map -> Evar.t -> bool (** Is the evar declared resolvable for typeclass resolution *) val get_obligation_evars : evar_map -> Evar.Set.t (** The set of obligation evars *) val set_obligation_evar : evar_map -> Evar.t -> evar_map (** Declare an evar as an obligation *) val is_obligation_evar : evar_map -> Evar.t -> bool (** Is the evar declared as an obligation *) val get_impossible_case_evars : evar_map -> Evar.Set.t (** Set of undefined evars with ImpossibleCase evar source. *) val downcast : Evar.t-> etypes -> evar_map -> evar_map (** Change the type of an undefined evar to a new type assumed to be a subtype of its current type; subtyping must be ensured by caller *) val evar_ident : Evar.t -> evar_map -> Id.t option val rename : Evar.t -> Id.t -> evar_map -> evar_map val evar_key : Id.t -> evar_map -> Evar.t val evar_names : evar_map -> Nameops.Fresh.t val evar_source_of_meta : metavariable -> evar_map -> Evar_kinds.t located val dependent_evar_ident : Evar.t -> evar_map -> Id.t (** {5 Side-effects} *) type side_effect_role = | Schema of inductive * string type side_effects = { seff_private : Safe_typing.private_constants; seff_roles : side_effect_role Cmap.t; } val empty_side_effects : side_effects val concat_side_effects : side_effects -> side_effects -> side_effects val emit_side_effects : side_effects -> evar_map -> evar_map (** Push a side-effect into the evar map. *) val eval_side_effects : evar_map -> side_effects (** Return the effects contained in the evar map. *) val drop_side_effects : evar_map -> evar_map (** This should not be used. For hacking purposes. *) (** {5 Future goals} *) val declare_future_goal : Evar.t -> evar_map -> evar_map (** Adds an existential variable to the list of future goals. For internal uses only. *) val declare_principal_goal : Evar.t -> evar_map -> evar_map (** Adds an existential variable to the list of future goals and make it principal. Only one existential variable can be made principal, an error is raised otherwise. For internal uses only. *) module FutureGoals : sig type t val comb : t -> Evar.t list val principal : t -> Evar.t option (** if [Some e], [e] must be contained in [future_comb]. The evar [e] will inherit properties (now: the name) of the evar which will be instantiated with a term containing [e]. *) val map_filter : (Evar.t -> Evar.t option) -> t -> t (** Applies a function on the future goals *) val filter : (Evar.t -> bool) -> t -> t (** Applies a filter on the future goals *) end val push_future_goals : evar_map -> evar_map val pop_future_goals : evar_map -> FutureGoals.t * evar_map val fold_future_goals : (evar_map -> Evar.t -> evar_map) -> evar_map -> evar_map val remove_future_goal : evar_map -> Evar.t -> evar_map val pr_future_goals_stack : evar_map -> Pp.t val push_shelf : evar_map -> evar_map val pop_shelf : evar_map -> Evar.t list * evar_map val filter_shelf : (Evar.t -> bool) -> evar_map -> evar_map val give_up : Evar.t -> evar_map -> evar_map val shelve : evar_map -> Evar.t list -> evar_map val unshelve : evar_map -> Evar.t list -> evar_map val given_up : evar_map -> Evar.Set.t val shelf : evar_map -> Evar.t list val pr_shelf : evar_map -> Pp.t (** {5 Sort variables} Evar maps also keep track of the universe constraints defined at a given point. This section defines the relevant manipulation functions. *) exception UniversesDiffer val add_universe_constraints : evar_map -> UnivProblem.Set.t -> evar_map (** Add the given universe unification constraints to the evar map. @raise UniversesDiffer in case a first-order unification fails. @raise UniverseInconsistency . *) (** {5 Extra data} Evar maps can contain arbitrary data, allowing to use an extensible state. As evar maps are theoretically used in a strict state-passing style, such additional data should be passed along transparently. Some old and bug-prone code tends to drop them nonetheless, so you should keep cautious. *) module Store : Store.S (** Datatype used to store additional information in evar maps. *) val get_extra_data : evar_map -> Store.t val set_extra_data : Store.t -> evar_map -> evar_map (** {5 The state monad with state an evar map} *) module MonadR : Monad.S with type +'a t = evar_map -> evar_map * 'a module Monad : Monad.S with type +'a t = evar_map -> 'a * evar_map (** {5 Meta machinery} These functions are almost deprecated. They were used before the introduction of the full-fledged evar calculus. In an ideal world, they should be removed. Alas, some parts of the code still use them. Do not use in newly-written code. *) module Metaset : Set.S with type elt = metavariable module Metamap : Map.ExtS with type key = metavariable and module Set := Metaset type 'a freelisted = { rebus : 'a; freemetas : Metaset.t } val metavars_of : econstr -> Metaset.t val mk_freelisted : econstr -> econstr freelisted val map_fl : ('a -> 'b) -> 'a freelisted -> 'b freelisted (** Status of an instance found by unification wrt to the meta it solves: - a supertype of the meta (e.g. the solution to ?X <= T is a supertype of ?X) - a subtype of the meta (e.g. the solution to T <= ?X is a supertype of ?X) - a term that can be eta-expanded n times while still being a solution (e.g. the solution [P] to [?X u v = P u v] can be eta-expanded twice) *) type instance_constraint = IsSuperType | IsSubType | Conv val eq_instance_constraint : instance_constraint -> instance_constraint -> bool (** Status of the unification of the type of an instance against the type of the meta it instantiates: - CoerceToType means that the unification of types has not been done and that a coercion can still be inserted: the meta should not be substituted freely (this happens for instance given via the "with" binding clause). - TypeProcessed means that the information obtainable from the unification of types has been extracted. - TypeNotProcessed means that the unification of types has not been done but it is known that no coercion may be inserted: the meta can be substituted freely. *) type instance_typing_status = CoerceToType | TypeNotProcessed | TypeProcessed (** Status of an instance together with the status of its type unification *) type instance_status = instance_constraint * instance_typing_status (** Clausal environments *) type clbinding = | Cltyp of Name.t * econstr freelisted | Clval of Name.t * (econstr freelisted * instance_status) * econstr freelisted (** Unification constraints *) type conv_pb = Conversion.conv_pb type evar_constraint = conv_pb * env * econstr * econstr (** The following two functions are for internal use only, see [Evarutil.add_unification_pb] for a safe interface. *) val add_conv_pb : ?tail:bool -> evar_constraint -> evar_map -> evar_map val conv_pbs : evar_map -> evar_constraint list val extract_conv_pbs : evar_map -> (evar_constraint -> bool) -> evar_map * evar_constraint list val extract_changed_conv_pbs : evar_map -> (Evar.Set.t -> evar_constraint -> bool) -> evar_map * evar_constraint list val extract_all_conv_pbs : evar_map -> evar_map * evar_constraint list val loc_of_conv_pb : evar_map -> evar_constraint -> Loc.t option (** The following functions return the set of undefined evars contained in the object. *) val evars_of_term : evar_map -> econstr -> Evar.Set.t (** including evars in instances of evars *) val evars_of_named_context : evar_map -> (econstr, etypes, erelevance) Context.Named.pt -> Evar.Set.t val evars_of_filtered_evar_info : evar_map -> 'a evar_info -> Evar.Set.t (** Metas *) val meta_list : evar_map -> clbinding Metamap.t val meta_value : evar_map -> metavariable -> econstr (** [meta_fvalue] raises [Not_found] if meta not in map or [Anomaly] if meta has no value *) val meta_opt_fvalue : evar_map -> metavariable -> (econstr freelisted * instance_status) option val meta_ftype : evar_map -> metavariable -> etypes freelisted val meta_name : evar_map -> metavariable -> Name.t val meta_declare : metavariable -> etypes -> ?name:Name.t -> evar_map -> evar_map val meta_assign : metavariable -> econstr * instance_status -> evar_map -> evar_map val meta_reassign : metavariable -> econstr * instance_status -> evar_map -> evar_map val clear_metas : evar_map -> evar_map (** [meta_merge evd1 evd2] returns [evd2] extended with the metas of [evd1] *) val meta_merge : clbinding Metamap.t -> evar_map -> evar_map val map_metas_fvalue : (econstr -> econstr) -> evar_map -> evar_map val map_metas : (econstr -> econstr) -> evar_map -> evar_map type metabinding = metavariable * econstr * instance_status val retract_coercible_metas : evar_map -> metabinding list * evar_map (** {5 FIXME: Nothing to do here} *) (********************************************************* Sort/universe variables *) (** Rigid or flexible universe variables. [UnivRigid] variables are user-provided or come from an explicit [Type] in the source, we do not minimize them or unify them eagerly. [UnivFlexible alg] variables are fresh universe variables of polymorphic constants or generated during refinement, sometimes in algebraic position (i.e. not appearing in the term at the moment of creation). They are the candidates for minimization (if alg, to an algebraic universe) and unified eagerly in the first-order unification heurstic. *) type rigid = UState.rigid = | UnivRigid | UnivFlexible of bool (** Is substitution by an algebraic ok? *) val univ_rigid : rigid val univ_flexible : rigid val univ_flexible_alg : rigid type 'a in_evar_universe_context = 'a * UState.t val restrict_universe_context : ?lbound:UGraph.Bound.t -> evar_map -> Univ.Level.Set.t -> evar_map (** Raises Not_found if not a name for a universe in this map. *) val universe_of_name : evar_map -> Id.t -> Univ.Level.t val quality_of_name : evar_map -> Id.t -> Sorts.QVar.t val is_relevance_irrelevant : evar_map -> erelevance -> bool (** Whether the relevance is irrelevant modulo qstate *) (* XXX move to ERelevance *) val universe_binders : evar_map -> UnivNames.universe_binders val new_univ_level_variable : ?loc:Loc.t -> ?name:Id.t -> rigid -> evar_map -> evar_map * Univ.Level.t val new_quality_variable : ?loc:Loc.t -> ?name:Id.t -> evar_map -> evar_map * Sorts.QVar.t val new_sort_variable : ?loc:Loc.t -> rigid -> evar_map -> evar_map * esorts val add_global_univ : evar_map -> Univ.Level.t -> evar_map val universe_rigidity : evar_map -> Univ.Level.t -> rigid val make_nonalgebraic_variable : evar_map -> Univ.Level.t -> evar_map (** See [UState.make_nonalgebraic_variable]. *) val is_flexible_level : evar_map -> Univ.Level.t -> bool val normalize_universe_instance : evar_map -> UVars.Instance.t -> UVars.Instance.t val set_leq_sort : env -> evar_map -> esorts -> esorts -> evar_map val set_eq_sort : env -> evar_map -> esorts -> esorts -> evar_map val set_eq_level : evar_map -> Univ.Level.t -> Univ.Level.t -> evar_map val set_leq_level : evar_map -> Univ.Level.t -> Univ.Level.t -> evar_map val set_eq_instances : ?flex:bool -> evar_map -> UVars.Instance.t -> UVars.Instance.t -> evar_map val check_eq : evar_map -> esorts -> esorts -> bool val check_leq : evar_map -> esorts -> esorts -> bool val check_constraints : evar_map -> Univ.Constraints.t -> bool val check_qconstraints : evar_map -> Sorts.QConstraints.t -> bool val check_quconstraints : evar_map -> Sorts.QUConstraints.t -> bool val evar_universe_context : evar_map -> UState.t val universe_context_set : evar_map -> Univ.ContextSet.t val sort_context_set : evar_map -> UnivGen.sort_context_set val universe_subst : evar_map -> UnivFlex.t val universes : evar_map -> UGraph.t (** [to_universe_context evm] extracts the local universes and constraints of [evm] and orders the universes the same as [Univ.ContextSet.to_context]. *) val to_universe_context : evar_map -> UVars.UContext.t val univ_entry : poly:bool -> evar_map -> UState.named_universes_entry val check_univ_decl : poly:bool -> evar_map -> UState.universe_decl -> UState.named_universes_entry val merge_universe_context : evar_map -> UState.t -> evar_map val set_universe_context : evar_map -> UState.t -> evar_map val merge_context_set : ?loc:Loc.t -> ?sideff:bool -> rigid -> evar_map -> Univ.ContextSet.t -> evar_map val merge_sort_context_set : ?loc:Loc.t -> ?sideff:bool -> rigid -> evar_map -> UnivGen.sort_context_set -> evar_map val merge_sort_variables : ?loc:Loc.t -> ?sideff:bool -> evar_map -> Sorts.QVar.Set.t -> evar_map val with_context_set : ?loc:Loc.t -> rigid -> evar_map -> 'a Univ.in_universe_context_set -> evar_map * 'a val with_sort_context_set : ?loc:Loc.t -> rigid -> evar_map -> 'a UnivGen.in_sort_context_set -> evar_map * 'a val nf_univ_variables : evar_map -> evar_map val collapse_sort_variables : evar_map -> evar_map val fix_undefined_variables : evar_map -> evar_map (** Universe minimization *) val minimize_universes : ?lbound:UGraph.Bound.t -> evar_map -> evar_map (** Lift [UState.update_sigma_univs] *) val update_sigma_univs : UGraph.t -> evar_map -> evar_map (** Polymorphic universes *) val fresh_sort_in_family : ?loc:Loc.t -> ?rigid:rigid -> evar_map -> Sorts.family -> evar_map * esorts val fresh_constant_instance : ?loc:Loc.t -> ?rigid:rigid -> env -> evar_map -> Constant.t -> evar_map * pconstant val fresh_inductive_instance : ?loc:Loc.t -> ?rigid:rigid -> env -> evar_map -> inductive -> evar_map * pinductive val fresh_constructor_instance : ?loc:Loc.t -> ?rigid:rigid -> env -> evar_map -> constructor -> evar_map * pconstructor val fresh_array_instance : ?loc:Loc.t -> ?rigid:rigid -> env -> evar_map -> evar_map * UVars.Instance.t val fresh_global : ?loc:Loc.t -> ?rigid:rigid -> ?names:UVars.Instance.t -> env -> evar_map -> GlobRef.t -> evar_map * econstr (********************************************************************) (* constr with holes and pending resolution of classes, conversion *) (* problems, candidates, etc. *) type open_constr = evar_map * econstr (* Special case when before is empty *) (** Partially constructed constrs. *) type unsolvability_explanation = SeveralInstancesFound of int (** Failure explanation. *) (** {5 Summary names} *) (* This stuff is internal and should not be used. Currently a hack in the STM relies on it. *) val evar_counter_summary_tag : int Summary.Dyn.tag (** {5 Deprecated functions} *) val create_evar_defs : evar_map -> evar_map (* XXX: This is supposed to be deprecated by used by ssrmatching, what should the replacement be? *) (** Create an [evar_map] with empty meta map: *) (** Use this module only to bootstrap EConstr *) module MiniEConstr : sig module ERelevance : sig type t = erelevance val make : Sorts.relevance -> t val kind : evar_map -> t -> Sorts.relevance val unsafe_to_relevance : t -> Sorts.relevance end module ESorts : sig type t = esorts val make : Sorts.t -> t val kind : evar_map -> t -> Sorts.t val unsafe_to_sorts : t -> Sorts.t end module EInstance : sig type t val make : UVars.Instance.t -> t val kind : evar_map -> t -> UVars.Instance.t val empty : t val is_empty : t -> bool val unsafe_to_instance : t -> UVars.Instance.t end type t = econstr val kind : evar_map -> t -> (t, t, ESorts.t, EInstance.t, ERelevance.t) Constr.kind_of_term val kind_upto : evar_map -> constr -> (constr, types, Sorts.t, UVars.Instance.t, Sorts.relevance) Constr.kind_of_term val whd_evar : evar_map -> t -> t val mkLEvar : evar_map -> Evar.t * t list -> t val replace_vars : evar_map -> (Id.t * t) list -> t -> t val of_kind : (t, t, ESorts.t, EInstance.t, ERelevance.t) Constr.kind_of_term -> t val of_constr : Constr.t -> t val of_constr_array : Constr.t array -> t array val to_constr : ?abort_on_undefined_evars:bool -> evar_map -> t -> Constr.t val to_constr_opt : evar_map -> t -> Constr.t option val nf_evar : evar_map -> t -> t val unsafe_to_constr : t -> Constr.t val unsafe_to_constr_array : t array -> Constr.t array val unsafe_eq : (t, Constr.t) eq val unsafe_relevance_eq : (ERelevance.t, Sorts.relevance) eq val of_named_decl : (Constr.t, Constr.types, Sorts.relevance) Context.Named.Declaration.pt -> (t, t, ERelevance.t) Context.Named.Declaration.pt val unsafe_to_named_decl : (t, t, ERelevance.t) Context.Named.Declaration.pt -> (Constr.t, Constr.types, Sorts.relevance) Context.Named.Declaration.pt val unsafe_to_rel_decl : (t, t, ERelevance.t) Context.Rel.Declaration.pt -> (Constr.t, Constr.types, Sorts.relevance) Context.Rel.Declaration.pt val of_case_invert : constr pcase_invert -> econstr pcase_invert val unsafe_to_case_invert : econstr pcase_invert -> constr pcase_invert val of_rel_decl : (Constr.t, Constr.types, Sorts.relevance) Context.Rel.Declaration.pt -> (t, t, ERelevance.t) Context.Rel.Declaration.pt val of_named_context : (Constr.t, Constr.types, Sorts.relevance) Context.Named.pt -> (t, t, ERelevance.t) Context.Named.pt val of_rel_context : (Constr.t, Constr.types, Sorts.relevance) Context.Rel.pt -> (t, t, ERelevance.t) Context.Rel.pt end coq-8.20.0/engine/ftactic.ml000066400000000000000000000070141466560755400156230ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* b t) : b t = m >>= function | Uniform x -> f x | Depends l -> let f arg = f arg >>= function | Uniform x -> (* We dispatch the uniform result on each goal under focus, as we know that the [m] argument was actually dependent. *) Proofview.Goal.goals >>= fun goals -> let ans = List.map (fun g -> (g,x)) goals in Proofview.tclUNIT ans | Depends l -> Proofview.Goal.goals >>= fun goals -> Proofview.tclUNIT (List.combine goals l) in (* After the tactic has run, some goals which were previously produced may have been solved by side effects. The values attached to such goals must be discarded, otherwise the list of result would not have the same length as the list of focused goals, which is an invariant of the [Ftactic] module. It is the reason why a goal is attached to each result above. *) let filter (g,x) = g >>= fun g -> Proofview.Goal.unsolved g >>= function | true -> Proofview.tclUNIT (Some x) | false -> Proofview.tclUNIT None in Proofview.tclDISPATCHL (List.map f l) >>= fun l -> Proofview.Monad.List.map_filter filter (List.concat l) >>= fun filtered -> Proofview.tclUNIT (Depends filtered) let goals = Proofview.Goal.goals >>= fun l -> Proofview.tclUNIT (Depends l) let enter f = bind goals (fun gl -> gl >>= fun gl -> Proofview.wrap_exceptions (fun () -> f gl)) let with_env t = t >>= function | Uniform a -> Proofview.tclENV >>= fun env -> Proofview.tclUNIT (Uniform (env,a)) | Depends l -> Proofview.Goal.goals >>= fun gs -> Proofview.Monad.(List.map (map Proofview.Goal.env) gs) >>= fun envs -> Proofview.tclUNIT (Depends (List.combine envs l)) let lift (type a) (t:a Proofview.tactic) : a t = Proofview.tclBIND t (fun x -> Proofview.tclUNIT (Uniform x)) (** If the tactic returns unit, we can focus on the goals if necessary. *) let run m k = m >>= function | Uniform v -> k v | Depends l -> let tacs = List.map k l in Proofview.tclDISPATCH tacs let (>>=) = bind let (<*>) = fun m n -> bind m (fun () -> n) module Self = struct type 'a t = 'a focus Proofview.tactic let return = return let (>>=) = bind let (>>) = (<*>) let map f x = x >>= fun a -> return (f a) end module Ftac = Monad.Make(Self) module List = Ftac.List module Notations = struct let (>>=) = bind let (<*>) = fun m n -> bind m (fun () -> n) end coq-8.20.0/engine/ftactic.mli000066400000000000000000000051271466560755400157770ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* 'a t (** The unit of the monad. *) val bind : 'a t -> ('a -> 'b t) -> 'b t (** The bind of the monad. *) (** {5 Operations} *) val lift : 'a Proofview.tactic -> 'a t (** Transform a tactic into a focussing tactic. The resulting tactic is not focused. *) val run : 'a t -> ('a -> unit Proofview.tactic) -> unit Proofview.tactic (** Given a continuation producing a tactic, evaluates the focussing tactic. If the tactic has not focused, then the continuation is evaluated once. Otherwise it is called in each of the currently focused goals. *) (** {5 Focussing} *) (** Enter a goal. The resulting tactic is focused. *) val enter : (Proofview.Goal.t -> 'a t) -> 'a t (** Enter a goal, without evar normalization. The resulting tactic is focused. *) val with_env : 'a t -> (Environ.env*'a) t (** [with_env t] returns, in addition to the return type of [t], an environment, which is the global environment if [t] does not focus on goals, or the local goal environment if [t] focuses on goals. *) (** {5 Notations} *) val (>>=) : 'a t -> ('a -> 'b t) -> 'b t (** Notation for {!bind}. *) val (<*>) : unit t -> 'a t -> 'a t (** Sequence. *) (** {5 List operations} *) module List : Monad.ListS with type 'a t := 'a t (** {5 Notations} *) module Notations : sig val (>>=) : 'a t -> ('a -> 'b t) -> 'b t val (<*>) : unit t -> 'a t -> 'a t end coq-8.20.0/engine/logic_monad.ml000066400000000000000000000275621466560755400164730ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* Some (CErrors.print e) | TacticFailure e -> Some (CErrors.print e) | _ -> None end (** {6 Non-logical layer} *) (** The non-logical monad is a simple [unit -> 'a] (i/o) monad. The operations are simple wrappers around corresponding usual operations and require little documentation. *) module NonLogical = struct (* The functions in this module follow the pattern that they are defined with the form [(); fun ()->...]. This is an optimisation which signals to the compiler that the function is usually partially applied up to the [();]. Without this annotation, partial applications can be significantly slower. Documentation of this behaviour can be found at: https://blog.janestreet.com/the-dangers-of-being-too-partial/ *) include Monad.Make(struct type 'a t = unit -> 'a let return a = (); fun () -> a let (>>=) a k = (); fun () -> k (a ()) () let (>>) a k = (); fun () -> a (); k () let map f a = (); fun () -> f (a ()) end) type 'a ref = 'a Stdlib.ref let ignore a = (); fun () -> ignore (a ()) let ref a = (); fun () -> ref a (** [Pervasives.(:=)] *) let (:=) r a = (); fun () -> r := a (** [Pervasives.(!)] *) let (!) = fun r -> (); fun () -> ! r (** [Pervasives.raise]. Except that exceptions are wrapped with {!Exception}. *) let raise (e, info) () = Exninfo.iraise (Exception e, info) (** [try ... with ...] but restricted to {!Exception}. *) let catch = fun s h -> (); fun () -> try s () with Exception e as src -> let (src, info) = Exninfo.capture src in h (e, info) () let read_line = fun () -> try read_line () with e -> let (e, info) = Exninfo.capture e in raise (e,info) () let print_char = fun c -> (); fun () -> print_char c let timeout = fun n t -> (); fun () -> Control.timeout n t () let make f = (); fun () -> try f () with e when CErrors.noncritical e -> let (e, info) = Exninfo.capture e in Exninfo.iraise (Exception e, info) (** Use the current logger. The buffer is also flushed. *) let print_debug s = make (fun _ -> Feedback.msg_debug s) let print_info s = make (fun _ -> Feedback.msg_info s) let print_warning s = make (fun _ -> Feedback.msg_warning s) let print_notice s = make (fun _ -> Feedback.msg_notice s) let run = fun x -> try x () with Exception e as src -> let (src, info) = Exninfo.capture src in Exninfo.iraise (e, info) end (** {6 Logical layer} *) (** The logical monad is a backtracking monad on top of which is layered a state monad (which is used to implement all of read/write, read only, and write only effects). The state monad being layered on top of the backtracking monad makes it so that the state is backtracked on failure. Backtracking differs from regular exception in that, writing (+) for exception catching and (>>=) for bind, we require the following extra distributivity laws: x+(y+z) = (x+y)+z zero+x = x x+zero = x (x+y)>>=k = (x>>=k)+(y>>=k) *) (** A view type for the logical monad, which is a form of list, hence we can decompose it with as a list. *) type ('a, 'b, 'e) list_view_ = | Nil of 'e | Cons of 'a * 'b type ('a, 'b, 'e) list_view = ('a, 'e -> 'b, 'e) list_view_ module BackState = struct (** Double-continuation backtracking monads are reasonable folklore for "search" implementations (including the Tac interactive prover's tactics). Yet it's quite hard to wrap your head around these. I recommend reading a few times the "Backtracking, Interleaving, and Terminating Monad Transformers" paper by O. Kiselyov, C. Shan, D. Friedman, and A. Sabry. The peculiar shape of the monadic type is reminiscent of that of the continuation monad transformer. The paper also contains the rationale for the [split] abstraction. An explanation of how to derive such a monad from mathematical principles can be found in "Kan Extensions for Program Optimisation" by Ralf Hinze. A somewhat concrete view is that the type ['a iolist] is, in fact the impredicative encoding of the following stream type: [type 'a _iolist' = Nil of exn | Cons of 'a*'a iolist' and 'a iolist = 'a _iolist NonLogical.t] Using impredicative encoding avoids intermediate allocation and is, empirically, very efficient in Ocaml. It also has the practical benefit that the monadic operation are independent of the underlying monad, which simplifies the code and side-steps the limited inlining of Ocaml. In that vision, [bind] is simply [concat_map] (though the cps version is significantly simpler), [plus] is concatenation, and [split] is pattern-matching. *) type ('a, 'i, 'o, 'e) t = { iolist : 'r. 'i -> ('e -> 'r NonLogical.t) -> ('a -> 'o -> ('e -> 'r NonLogical.t) -> 'r NonLogical.t) -> 'r NonLogical.t } let return x = { iolist = fun s nil cons -> cons x s nil } let (>>=) m f = { iolist = fun s nil cons -> m.iolist s nil (fun x s next -> (f x).iolist s next cons) } let (>>) m f = { iolist = fun s nil cons -> m.iolist s nil (fun () s next -> f.iolist s next cons) } let map f m = { iolist = fun s nil cons -> m.iolist s nil (fun x s next -> cons (f x) s next) } let zero e = { iolist = fun _ nil cons -> nil e } let plus m1 m2 = { iolist = fun s nil cons -> m1.iolist s (fun e -> (m2 e).iolist s nil cons) cons } let ignore m = { iolist = fun s nil cons -> m.iolist s nil (fun _ s next -> cons () s next) } let lift m = { iolist = fun s nil cons -> NonLogical.(m >>= fun x -> cons x s nil) } (** State related *) let get = { iolist = fun s nil cons -> cons s s nil } let set s = { iolist = fun _ nil cons -> cons () s nil } let modify f = { iolist = fun s nil cons -> cons () (f s) nil } (** Exception manipulation *) let interleave src dst m = { iolist = fun s nil cons -> m.iolist s (fun e1 -> nil (src e1)) (fun x s next -> cons x s (fun e2 -> next (dst e2))) } (** List observation *) let once m = { iolist = fun s nil cons -> m.iolist s nil (fun x s _ -> cons x s nil) } let break f m = { iolist = fun s nil cons -> m.iolist s nil (fun x s next -> cons x s (fun e -> match f e with None -> next e | Some e -> nil e)) } (** For [reflect] and [split] see the "Backtracking, Interleaving, and Terminating Monad Transformers" paper. *) type ('a, 'e) reified = ('a, ('a, 'e) reified_, 'e) list_view_ NonLogical.t and ('a, 'e) reified_ = {r : 'e -> ('a, 'e) reified} [@@unboxed] let rec reflect (m : ('a * 'o, 'e) reified) = { iolist = fun s0 nil cons -> let next = function | Nil e -> nil e | Cons ((x, s), {r=l}) -> cons x s (fun e -> (reflect (l e)).iolist s0 nil cons) in NonLogical.(m >>= next) } let split m : (_ list_view, _, _, _) t = let rnil e = NonLogical.return (Nil e) in let rcons p s l = NonLogical.return (Cons ((p, s), {r=l})) in { iolist = fun s nil cons -> let open NonLogical in m.iolist s rnil rcons >>= begin function | Nil e -> cons (Nil e) s nil | Cons ((x, s), {r=l}) -> let l e = reflect (l e) in cons (Cons (x, l)) s nil end } let run m s = let rnil e = NonLogical.return (Nil e) in let rcons x s l = let p = (x, s) in NonLogical.return (Cons (p, {r=l})) in m.iolist s rnil rcons let repr x = x end module type Param = sig (** Read only *) type e (** Write only *) type w (** [w] must be a monoid *) val wunit : w val wprod : w -> w -> w (** Read-write *) type s (** Update-only. Essentially a writer on [u->u]. *) type u (** [u] must be pointed. *) val uunit : u end module Logical (P:Param) = struct module Unsafe = struct (** All three of environment, writer and state are coded as a single state-passing-style monad.*) type state = { rstate : P.e; ustate : P.u; wstate : P.w; sstate : P.s; } let make m = m let repr m = m end open Unsafe type state = Unsafe.state type iexn = Exninfo.iexn type 'a reified = ('a, iexn) BackState.reified type 'a reified_ = ('a, iexn) BackState.reified_ (** Inherited from Backstate *) open BackState include Monad.Make(struct type 'a t = ('a, state, state, iexn) BackState.t let return = BackState.return let (>>=) = BackState.(>>=) let (>>) = BackState.(>>) let map = BackState.map end) let zero = BackState.zero let plus = BackState.plus let ignore = BackState.ignore let lift = BackState.lift let once = BackState.once let break = BackState.break let split = BackState.split let repr = BackState.repr (** State related. We specialize them here to ensure soundness (for reader and writer) and efficiency. *) let get = { iolist = fun s nil cons -> cons s.sstate s nil } let set (sstate : P.s) = { iolist = fun s nil cons -> cons () { s with sstate } nil } let modify (f : P.s -> P.s) = { iolist = fun s nil cons -> cons () { s with sstate = f s.sstate } nil } let current = { iolist = fun s nil cons -> cons s.rstate s nil } let local e m = { iolist = fun s nil cons -> m.iolist { s with rstate = e } nil (fun x s' next -> cons x {s' with rstate = s.rstate} next) } let put w = { iolist = fun s nil cons -> cons () { s with wstate = P.wprod s.wstate w } nil } let update (f : P.u -> P.u) = { iolist = fun s nil cons -> cons () { s with ustate = f s.ustate } nil } (** Monadic run is specialized to handle reader / writer *) let run m r s = let s = { wstate = P.wunit; ustate = P.uunit; rstate = r; sstate = s } in let rnil e = NonLogical.return (Nil e) in let rcons x s l = let p = (x, s.sstate, s.wstate, s.ustate) in NonLogical.return (Cons (p, {r=l})) in m.iolist s rnil rcons end coq-8.20.0/engine/logic_monad.mli000066400000000000000000000155051466560755400166360ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* 'a] (i/o) monad. The operations are simple wrappers around corresponding usual operations and require little documentation. *) module NonLogical : sig include Monad.S val ignore : 'a t -> unit t type 'a ref val ref : 'a -> 'a ref t (** [Pervasives.(:=)] *) val (:=) : 'a ref -> 'a -> unit t (** [Pervasives.(!)] *) val (!) : 'a ref -> 'a t val read_line : string t val print_char : char -> unit t (** Loggers. The buffer is also flushed. *) val print_debug : Pp.t -> unit t val print_warning : Pp.t -> unit t val print_notice : Pp.t -> unit t val print_info : Pp.t -> unit t (** [Pervasives.raise]. Except that exceptions are wrapped with {!Exception}. *) val raise : Exninfo.iexn -> 'a t (** [try ... with ...] but restricted to {!Exception}. *) val catch : 'a t -> (Exninfo.iexn -> 'a t) -> 'a t val timeout : float -> 'a t -> 'a option t (** Construct a monadified side-effect. Exceptions raised by the argument are wrapped with {!Exception}. *) val make : (unit -> 'a) -> 'a t (** [run] performs effects. *) val run : 'a t -> 'a end (** {6 Logical layer} *) (** The logical monad is a backtracking monad on top of which is layered a state monad (which is used to implement all of read/write, read only, and write only effects). The state monad being layered on top of the backtracking monad makes it so that the state is backtracked on failure. Backtracking differs from regular exception in that, writing (+) for exception catching and (>>=) for bind, we require the following extra distributivity laws: x+(y+z) = (x+y)+z zero+x = x x+zero = x (x+y)>>=k = (x>>=k)+(y>>=k) *) (** A view type for the logical monad, which is a form of list, hence we can decompose it with as a list. *) type ('a, 'b, 'e) list_view_ = | Nil of 'e | Cons of 'a * 'b type ('a, 'b, 'e) list_view = ('a, 'e -> 'b, 'e) list_view_ module BackState : sig type (+'a, -'i, +'o, 'e) t val return : 'a -> ('a, 's, 's, 'e) t val (>>=) : ('a, 'i, 'm, 'e) t -> ('a -> ('b, 'm, 'o, 'e) t) -> ('b, 'i, 'o, 'e) t val (>>) : (unit, 'i, 'm, 'e) t -> ('b, 'm, 'o, 'e) t -> ('b, 'i, 'o, 'e) t val map : ('a -> 'b) -> ('a, 'i, 'o, 'e) t -> ('b, 'i, 'o, 'e) t val ignore : ('a, 'i, 'o, 'e) t -> (unit, 'i, 'o, 'e) t val set : 'o -> (unit, 'i, 'o, 'e) t val get : ('s, 's, 's, 'e) t val modify : ('i -> 'o) -> (unit, 'i, 'o, 'e) t val interleave : ('e1 -> 'e2) -> ('e2 -> 'e1) -> ('a, 'i, 'o, 'e1) t -> ('a, 'i, 'o, 'e2) t (** [interleave src dst m] adapts the exceptional content of the monad according to the functions [src] and [dst]. To ensure a meaningful result, those functions must form a retraction, i.e. [dst (src e1) = e1] for all [e1]. This is typically the case when the type ['e1] is [unit]. *) val zero : 'e -> ('a, 'i, 'o, 'e) t val plus : ('a, 'i, 'o, 'e) t -> ('e -> ('a, 'i, 'o, 'e) t) -> ('a, 'i, 'o, 'e) t val split : ('a, 's, 's, 'e) t -> (('a, ('a, 'i, 's, 'e) t, 'e) list_view, 's, 's, 'e) t val once : ('a, 'i, 'o, 'e) t -> ('a, 'i, 'o, 'e) t val break : ('e -> 'e option) -> ('a, 'i, 'o, 'e) t -> ('a, 'i, 'o, 'e) t val lift : 'a NonLogical.t -> ('a, 's, 's, 'e) t type ('a, 'e) reified type ('a, 'e) reified_ val repr : ('a, 'e) reified -> ('a, ('a, 'e) reified_, 'e) list_view_ NonLogical.t val run : ('a, 'i, 'o, 'e) t -> 'i -> ('a * 'o, 'e) reified end (** The monad is parametrised in the types of state, environment and writer. *) module type Param = sig (** Read only *) type e (** Write only *) type w (** [w] must be a monoid *) val wunit : w val wprod : w -> w -> w (** Read-write *) type s (** Update-only. Essentially a writer on [u->u]. *) type u (** [u] must be pointed. *) val uunit : u end module Logical (P:Param) : sig include Monad.S val ignore : 'a t -> unit t val set : P.s -> unit t val get : P.s t val modify : (P.s -> P.s) -> unit t val put : P.w -> unit t val current : P.e t val local : P.e -> 'a t -> 'a t val update : (P.u -> P.u) -> unit t val zero : Exninfo.iexn -> 'a t val plus : 'a t -> (Exninfo.iexn -> 'a t) -> 'a t val split : 'a t -> ('a, 'a t, Exninfo.iexn) list_view t val once : 'a t -> 'a t val break : (Exninfo.iexn -> Exninfo.iexn option) -> 'a t -> 'a t val lift : 'a NonLogical.t -> 'a t type 'a reified = ('a, Exninfo.iexn) BackState.reified type 'a reified_ = ('a, Exninfo.iexn) BackState.reified_ val repr : 'a reified -> ('a, 'a reified_, Exninfo.iexn) list_view_ NonLogical.t val run : 'a t -> P.e -> P.s -> ('a * P.s * P.w * P.u) reified module Unsafe : sig type state = { rstate : P.e; ustate : P.u; wstate : P.w; sstate : P.s; } val make : ('a, state, state, Exninfo.iexn) BackState.t -> 'a t val repr : 'a t -> ('a, state, state, Exninfo.iexn) BackState.t end end coq-8.20.0/engine/namegen.ml000066400000000000000000000431231466560755400156210ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* true | IntroIdentifier id1, IntroIdentifier id2 -> Names.Id.equal id1 id2 | IntroFresh id1, IntroFresh id2 -> Names.Id.equal id1 id2 | _ -> false (**********************************************************************) (* Conventional names *) let default_prop_string = "H" let default_prop_ident = Id.of_string default_prop_string let default_small_string = "H" let default_small_ident = Id.of_string default_small_string let default_type_string = "X" let default_type_ident = Id.of_string default_type_string let default_non_dependent_string = "H" let default_non_dependent_ident = Id.of_string default_non_dependent_string let default_dependent_ident = Id.of_string "x" let default_generated_non_letter_string = "x" (**********************************************************************) (* Globality of identifiers *) let is_imported_modpath = function | MPfile dp -> let rec find_prefix = function |MPfile dp1 -> not (DirPath.equal dp1 dp) |MPdot(mp,_) -> find_prefix mp |MPbound(_) -> false in find_prefix (Lib.current_mp ()) | _ -> false let is_imported_ref = let open GlobRef in function | VarRef _ -> false | IndRef (kn,_) | ConstructRef ((kn,_),_) -> let mp = MutInd.modpath kn in is_imported_modpath mp | ConstRef kn -> let mp = Constant.modpath kn in is_imported_modpath mp let locate id = match Nametab.locate_extended_nowarn (qualid_of_ident id) with | TrueGlobal r -> r | Abbrev _ -> raise Not_found let is_global id = try let ref = locate id in not (is_imported_ref ref) with Not_found -> false let is_constructor id = try match locate id with | GlobRef.ConstructRef _ -> true | _ -> false with Not_found -> false let is_section_variable env id = try let _ = Environ.lookup_named id env in true with Not_found -> false (**********************************************************************) (* Generating "intuitive" names from its type *) let global_of_constr = let open GlobRef in function | Const (c, _) -> ConstRef c | Ind (i, _) -> IndRef i | Construct (c, _) -> ConstructRef c | Var id -> VarRef id | _ -> assert false let head_name sigma c = (* Find the head constant of a constr if any *) let rec hdrec c = match EConstr.kind sigma c with | Prod (_,_,c) | Lambda (_,_,c) | LetIn (_,_,_,c) | Cast (c,_,_) | App (c,_) -> hdrec c | Proj (kn,_,_) -> Some (Label.to_id (Constant.label (Projection.constant kn))) | Const _ | Ind _ | Construct _ | Var _ as c -> Some (Nametab.basename_of_global (global_of_constr c)) | Fix ((_,i),(lna,_,_)) | CoFix (i,(lna,_,_)) -> Some (match lna.(i).binder_name with Name id -> id | _ -> assert false) | Sort _ | Rel _ | Meta _ | Evar _ | Case _ | Int _ | Float _ | String _ | Array _ -> None in hdrec c let lowercase_first_char id = (* First character of a constr *) let s = Id.to_string id in match Unicode.split_at_first_letter s with | None -> (* General case: nat -> n *) Unicode.lowercase_first_char s | Some (s,s') -> if String.length s' = 0 then (* No letter, e.g. __, or __'_, etc. *) default_generated_non_letter_string else s ^ Unicode.lowercase_first_char s' let sort_hdchar = function | SProp -> "P" | Prop -> "P" | Set -> "S" | Type _ | QSort _ -> "T" let hdchar env sigma c = let rec hdrec k c = match EConstr.kind sigma c with | Prod (_,_,c) | Lambda (_,_,c) | LetIn (_,_,_,c) -> hdrec (k+1) c | Cast (c,_,_) | App (c,_) -> hdrec k c | Proj (kn,_,_) -> lowercase_first_char (Label.to_id (Constant.label (Projection.constant kn))) | Const (kn,_) -> lowercase_first_char (Label.to_id (Constant.label kn)) | Ind (x,_) -> (try lowercase_first_char (Nametab.basename_of_global (GlobRef.IndRef x)) with Not_found when !Flags.in_debugger -> "zz") | Construct (x,_) -> (try lowercase_first_char (Nametab.basename_of_global (GlobRef.ConstructRef x)) with Not_found when !Flags.in_debugger -> "zz") | Var id -> lowercase_first_char id | Sort s -> sort_hdchar (ESorts.kind sigma s) | Rel n -> (if n<=k then "p" (* the initial term is flexible product/function *) else try match let d = lookup_rel (n-k) env in get_name d, get_type d with | Name id, _ -> lowercase_first_char id | Anonymous, t -> hdrec 0 (lift (n-k) t) with Not_found -> "y") | Fix ((_,i),(lna,_,_)) | CoFix (i,(lna,_,_)) -> let id = match lna.(i).binder_name with Name id -> id | _ -> assert false in lowercase_first_char id | Evar _ (* We could do better... *) | Meta _ | Case _ -> "y" | Int _ -> "i" | Float _ -> "f" | String _ -> "s" | Array _ -> "a" in hdrec 0 c let id_of_name_using_hdchar env sigma a = function | Anonymous -> Id.of_string (hdchar env sigma a) | Name id -> id let named_hd env sigma a = function | Anonymous -> Name (Id.of_string (hdchar env sigma a)) | x -> x let mkProd_name env sigma (n,a,b) = mkProd (map_annot (named_hd env sigma a) n, a, b) let mkLambda_name env sigma (n,a,b) = mkLambda (map_annot (named_hd env sigma a) n, a, b) let lambda_name = mkLambda_name let prod_name = mkProd_name let prod_create env sigma (r,a,b) = mkProd (make_annot (named_hd env sigma a Anonymous) r, a, b) let lambda_create env sigma (r,a,b) = mkLambda (make_annot (named_hd env sigma a Anonymous) r, a, b) let name_assumption env sigma = function | LocalAssum (na,t) -> LocalAssum (map_annot (named_hd env sigma t) na, t) | LocalDef (na,c,t) -> LocalDef (map_annot (named_hd env sigma c) na, c, t) let name_context env sigma hyps = snd (List.fold_left (fun (env,hyps) d -> let d' = name_assumption env sigma d in (push_rel d' env, d' :: hyps)) (env,[]) (List.rev hyps)) let mkProd_or_LetIn_name env sigma b d = mkProd_or_LetIn (name_assumption env sigma d) b let mkLambda_or_LetIn_name env sigma b d = mkLambda_or_LetIn (name_assumption env sigma d) b let it_mkProd_or_LetIn_name env sigma b hyps = it_mkProd_or_LetIn b (name_context env sigma hyps) let it_mkLambda_or_LetIn_name env sigma b hyps = it_mkLambda_or_LetIn b (name_context env sigma hyps) (**********************************************************************) (* Fresh names *) (* Introduce a mode where auto-generated names are mangled to test dependence of scripts on auto-generated names. We also supply a version which only adds a prefix. *) let { Goptions.get = get_mangle_names } = Goptions.declare_bool_option_and_ref ~key:["Mangle";"Names"] ~value:false () let { Goptions.get = get_mangle_names_light } = Goptions.declare_bool_option_and_ref ~key:["Mangle";"Names";"Light"] ~value:false () let { Goptions.get = mangle_names_prefix } = Goptions.declare_interpreted_string_option_and_ref ~key:["Mangle";"Names";"Prefix"] ~value:("_") (fun x -> Id.to_string (try Id.of_string x with | CErrors.UserError _ -> CErrors.user_err Pp.(str ("Not a valid identifier: \"" ^ x ^ "\".")) ) ) (fun x -> x) () (** The name "foo" becomes "_0" if we get_mangle_names and "_foo" if get_mangle_names_light is also set. Otherwise it is left alone. *) let mangle_id id = let prfx = mangle_names_prefix () in if get_mangle_names () then if get_mangle_names_light () then Id.of_string (prfx ^ Id.to_string id) else Id.of_string (prfx ^ "0") else id (* Looks for next "good" name by lifting subscript *) let next_ident_away_from_post_mangling id bad = let rec name_rec id = if bad id then name_rec (increment_subscript id) else id in name_rec id let next_ident_away_from id bad = let id = mangle_id id in next_ident_away_from_post_mangling id bad (* Restart subscript from x0 if name starts with xN, or x00 if name starts with x0N, etc *) let restart_subscript id = if not (has_subscript id) then id else (* It would probably be better with something in the spirit of *** make_ident id (Some 0) *** but compatibility would be lost... *) forget_subscript id let visible_ids sigma (nenv, c) = let accu = ref (GlobRef.Set_env.empty, Int.Set.empty, Id.Set.empty) in let rec visible_ids n c = match EConstr.kind sigma c with | Const _ | Ind _ | Construct _ | Var _ as c -> let (gseen, vseen, ids) = !accu in let g = global_of_constr c in if not (GlobRef.Set_env.mem g gseen) then let gseen = GlobRef.Set_env.add g gseen in let ids = match Nametab.shortest_qualid_of_global Id.Set.empty g with | short -> let dir, id = repr_qualid short in if DirPath.is_empty dir then Id.Set.add id ids else ids | exception Not_found -> (* This may happen if given pathological terms or when manipulating open modules *) ids in accu := (gseen, vseen, ids) | Rel p -> let (gseen, vseen, ids) = !accu in if p > n && not (Int.Set.mem (p - n) vseen) then let vseen = Int.Set.add (p - n) vseen in let name = try Some (List.nth nenv (p - n - 1)) with Invalid_argument _ | Failure _ -> (* Unbound index: may happen in debug and actually also while computing temporary implicit arguments of an inductive type *) None in let ids = match name with | Some (Name id) -> Id.Set.add id ids | _ -> ids in accu := (gseen, vseen, ids) | Evar (_,args as ev) -> (* Useful for at least debugger: do the same as in iter_with_binders *) (* except that Not_found is not fatal *) begin match Evd.expand_existential sigma ev with | args -> List.iter (visible_ids n) args | exception Not_found when !Flags.in_debugger -> SList.Skip.iter (visible_ids n) args end | _ -> EConstr.iter_with_binders sigma succ visible_ids n c in let () = visible_ids 1 c in (* n = 1 to count the binder to rename *) let (_, _, ids) = !accu in ids (* Now, there are different renaming strategies... *) (* 1- Looks for a fresh name for printing in cases pattern *) let next_name_away_in_cases_pattern sigma env_t na avoid = let id = match na with Name id -> id | Anonymous -> default_dependent_ident in let visible = visible_ids sigma env_t in let bad id = Id.Set.mem id avoid || is_constructor id || Id.Set.mem id visible in next_ident_away_from id bad (* 2- Looks for a fresh name for introduction in goal *) (* The legacy strategy for renaming introduction variables is not very uniform: - if the name to use is fresh in the context but used as a global name, then a fresh name is taken by finding a free subscript starting from the current subscript; - but if the name to use is not fresh in the current context, the fresh name is taken by finding a free subscript starting from 0 *) let next_ident_away_in_goal env id avoid = let id = if Id.Set.mem id avoid then restart_subscript id else id in let bad id = Id.Set.mem id avoid || (is_global id && not (is_section_variable env id)) in next_ident_away_from id bad let next_name_away_in_goal env na avoid = let id = match na with | Name id -> id | Anonymous -> default_non_dependent_ident in next_ident_away_in_goal env id avoid (* 3- Looks for next fresh name outside a list that is moreover valid as a global identifier; the legacy algorithm is that if the name is already used in the list, one looks for a name of same base with lower available subscript; if the name is not in the list but is used globally, one looks for a name of same base with lower subscript beyond the current subscript *) let next_global_ident_away id avoid = let id = if Id.Set.mem id avoid then restart_subscript id else id in let bad id = Id.Set.mem id avoid || Global.exists_objlabel (Label.of_id id) in next_ident_away_from id bad (* 4- Looks for next fresh name outside a list; if name already used, looks for same name with lower available subscript *) let next_ident_away id avoid = let id = mangle_id id in if Id.Set.mem id avoid then next_ident_away_from_post_mangling (restart_subscript id) (fun id -> Id.Set.mem id avoid) else id let next_name_away_with_default default na avoid = let id = match na with Name id -> id | Anonymous -> Id.of_string default in next_ident_away id avoid let reserved_type_name = ref (fun t -> Anonymous) let set_reserved_typed_name f = reserved_type_name := f let next_name_away_with_default_using_types default na avoid t = let id = match na with | Name id -> id | Anonymous -> match !reserved_type_name t with | Name id -> id | Anonymous -> Id.of_string default in next_ident_away id avoid let next_name_away = next_name_away_with_default default_non_dependent_string let make_all_rel_context_name_different env sigma ctx = let avoid = ref (Id.Set.union (Context.Rel.to_vars (Environ.rel_context env)) (ids_of_named_context_val (named_context_val env))) in Context.Rel.fold_outside (fun decl (newenv,ctx) -> let na = named_hd newenv sigma (RelDecl.get_type decl) (RelDecl.get_name decl) in let id = next_name_away na !avoid in avoid := Id.Set.add id !avoid; let decl = RelDecl.set_name (Name id) decl in push_rel decl newenv, decl :: ctx) ctx ~init:(env,[]) let make_all_name_different env sigma = (* FIXME: this is inefficient, but only used in printing *) let sign = named_context_val env in let rels = rel_context env in let env0 = reset_with_named_context sign env in let env,_ = make_all_rel_context_name_different env0 sigma rels in env (* 5- Looks for next fresh name outside a list; avoids also to use names that would clash with short name of global references; if name is already used, looks for name of same base with lower available subscript beyond current subscript *) let next_ident_away_for_default_printing sigma env_t id avoid = let visible = visible_ids sigma env_t in let bad id = Id.Set.mem id avoid || Id.Set.mem id visible in next_ident_away_from id bad let next_name_away_for_default_printing sigma env_t na avoid = let id = match na with | Name id -> id | Anonymous -> (* In principle, an anonymous name is not dependent and will not be *) (* taken into account by the function compute_displayed_name_in; *) (* just in case, invent a valid name *) default_non_dependent_ident in next_ident_away_for_default_printing sigma env_t id avoid (**********************************************************************) (* Displaying terms avoiding bound variables clashes *) (* Renaming strategy introduced in December 1998: - Rule number 1: all names, even if unbound and not displayed, contribute to the list of names to avoid - Rule number 2: only the dependency status is used for deciding if a name is displayed or not Example: bool_ind: "forall (P:bool->Prop)(f:(P true))(f:(P false))(b:bool), P b" is displayed "forall P:bool->Prop, P true -> P false -> forall b:bool, P b" but f and f0 contribute to the list of variables to avoid (knowing that f and f0 are how the f's would be named if introduced, assuming no other f and f0 are already used). *) type renaming_flags = (* The term is the body of a binder and the environment excludes this binder *) (* so, there is a missing binder in the environment *) | RenamingForCasesPattern of (Name.t list * constr) | RenamingForGoal | RenamingElsewhereFor of (Name.t list * constr) let next_name_for_display env sigma flags = match flags with | RenamingForCasesPattern env_t -> next_name_away_in_cases_pattern sigma env_t | RenamingForGoal -> next_name_away_in_goal env | RenamingElsewhereFor env_t -> next_name_away_for_default_printing sigma env_t (* Remark: Anonymous var may be dependent in Evar's contexts *) let compute_displayed_name_in_gen_poly noccurn_fun env sigma flags avoid na c = if noccurn_fun sigma 1 c then Anonymous, avoid else let fresh_id = next_name_for_display env sigma flags na avoid in Name fresh_id, Id.Set.add fresh_id avoid let compute_displayed_name_in = compute_displayed_name_in_gen_poly noccurn let compute_displayed_name_in_gen f env sigma = (* only flag which does not need a constr, maybe to be refined *) let flag = RenamingForGoal in compute_displayed_name_in_gen_poly f env sigma flag let compute_displayed_let_name_in env sigma flags avoid na = let fresh_id = next_name_for_display env sigma flags na avoid in (Name fresh_id, Id.Set.add fresh_id avoid) coq-8.20.0/engine/namegen.mli000066400000000000000000000130261466560755400157710ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* intro_pattern_naming_expr -> bool (********************************************************************* Conventional default names *) val default_prop_ident : Id.t (* "H" *) val default_small_ident : Id.t (* "H" *) val default_type_ident : Id.t (* "X" *) val default_non_dependent_ident : Id.t (* "H" *) val default_dependent_ident : Id.t (* "x" *) (********************************************************************* Generating "intuitive" names from their type *) val lowercase_first_char : Id.t -> string val sort_hdchar : Sorts.t -> string val hdchar : env -> evar_map -> types -> string val id_of_name_using_hdchar : env -> evar_map -> types -> Name.t -> Id.t val named_hd : env -> evar_map -> types -> Name.t -> Name.t val head_name : evar_map -> types -> Id.t option val mkProd_name : env -> evar_map -> Name.t EConstr.binder_annot * types * types -> types val mkLambda_name : env -> evar_map -> Name.t EConstr.binder_annot * types * constr -> constr (** Deprecated synonyms of [mkProd_name] and [mkLambda_name] *) val prod_name : env -> evar_map -> Name.t EConstr.binder_annot * types * types -> types val lambda_name : env -> evar_map -> Name.t EConstr.binder_annot * types * constr -> constr val prod_create : env -> evar_map -> ERelevance.t * types * types -> constr val lambda_create : env -> evar_map -> ERelevance.t * types * constr -> constr val name_assumption : env -> evar_map -> rel_declaration -> rel_declaration val name_context : env -> evar_map -> rel_context -> rel_context val mkProd_or_LetIn_name : env -> evar_map -> types -> rel_declaration -> types val mkLambda_or_LetIn_name : env -> evar_map -> constr -> rel_declaration -> constr val it_mkProd_or_LetIn_name : env -> evar_map -> types -> rel_context -> types val it_mkLambda_or_LetIn_name : env -> evar_map -> constr -> rel_context -> constr (********************************************************************* Fresh names *) (** Avoid clashing with a name satisfying some predicate *) val next_ident_away_from : Id.t -> (Id.t -> bool) -> Id.t (** [next_ident_away original_id unwanted_ids] returns a new identifier as close as possible to the [original_id] while avoiding all [unwanted_ids]. In particular: {ul {- if [original_id] does not appear in the list of [unwanted_ids], then [original_id] is returned.} {- if [original_id] appears in the list of [unwanted_ids], then this function returns a new id that: {ul {- has the same {i root} as the [original_id],} {- does not occur in the list of [unwanted_ids],} {- has the smallest possible {i subscript}.}}}} where by {i subscript} of some identifier we mean last part of it that is composed only from (decimal) digits and by {i root} of some identifier we mean the whole identifier except for the {i subscript}. E.g. if we take [foo42], then [42] is the {i subscript}, and [foo] is the root. *) val next_ident_away : Id.t -> Id.Set.t -> Id.t (** Avoid clashing with a name already used in current module *) val next_ident_away_in_goal : Environ.env -> Id.t -> Id.Set.t -> Id.t (** Avoid clashing with a name already used in current module but tolerate overwriting section variables, as in goals *) val next_global_ident_away : Id.t -> Id.Set.t -> Id.t (** Default is [default_non_dependent_ident] *) val next_name_away : Name.t -> Id.Set.t -> Id.t val next_name_away_with_default : string -> Name.t -> Id.Set.t -> Id.t val next_name_away_with_default_using_types : string -> Name.t -> Id.Set.t -> types -> Id.t val set_reserved_typed_name : (types -> Name.t) -> unit (********************************************************************* Making name distinct for displaying *) type renaming_flags = | RenamingForCasesPattern of (Name.t list * constr) (** avoid only global constructors *) | RenamingForGoal (** avoid all globals (as in intro) *) | RenamingElsewhereFor of (Name.t list * constr) val make_all_rel_context_name_different : env -> evar_map -> rel_context -> env * rel_context val make_all_name_different : env -> evar_map -> env val compute_displayed_name_in : Environ.env -> evar_map -> renaming_flags -> Id.Set.t -> Name.t -> constr -> Name.t * Id.Set.t val compute_displayed_let_name_in : Environ.env -> evar_map -> renaming_flags -> Id.Set.t -> Name.t -> Name.t * Id.Set.t (* Generic function expecting a "not occurn" function *) val compute_displayed_name_in_gen : (evar_map -> int -> 'a -> bool) -> Environ.env -> evar_map -> Id.Set.t -> Name.t -> 'a -> Name.t * Id.Set.t coq-8.20.0/engine/nameops.ml000066400000000000000000000414371466560755400156570ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* [0] *) { ss_zero = 1; ss_subs = 0 } else (* [0...00] -> [0..01] *) { ss_zero = s.ss_zero - 1; ss_subs = 1 } else if overflow s.ss_subs then if Int.equal s.ss_zero 0 then (* [9...9] -> [10...0] *) { ss_zero = 0; ss_subs = 1 + s.ss_subs } else (* [0...009...9] -> [0...010...0] *) { ss_zero = s.ss_zero - 1; ss_subs = 1 + s.ss_subs } else (* [0...0n] -> [0...0{n+1}] *) { ss_zero = s.ss_zero; ss_subs = s.ss_subs + 1 } let equal s1 s2 = Int.equal s1.ss_zero s2.ss_zero && Int.equal s1.ss_subs s2.ss_subs let compare s1 s2 = (* Lexicographic order is reversed in order to ensure that [succ] is strictly increasing. *) let c = Int.compare s1.ss_subs s2.ss_subs in if Int.equal c 0 then Int.compare s1.ss_zero s2.ss_zero else c end let code_of_0 = Char.code '0' let code_of_9 = Char.code '9' let cut_ident skip_quote s = let s = Id.to_string s in let slen = String.length s in (* [n'] is the position of the first non nullary digit *) let rec numpart n n' = if Int.equal n 0 then (* ident made of _ and digits only [and ' if skip_quote]: don't cut it *) slen else let c = Char.code (String.get s (n-1)) in if Int.equal c code_of_0 && not (Int.equal n slen) then numpart (n-1) n' else if code_of_0 <= c && c <= code_of_9 then numpart (n-1) (n-1) else if skip_quote && (Int.equal c (Char.code '\'') || Int.equal c (Char.code '_')) then numpart (n-1) (n-1) else n' in numpart slen slen let repr_ident s = let numstart = cut_ident false s in let s = Id.to_string s in let slen = String.length s in if Int.equal numstart slen then (s, None) else (String.sub s 0 numstart, Some (int_of_string (String.sub s numstart (slen - numstart)))) let make_ident sa = function | Some n -> let c = Char.code (String.get sa (String.length sa -1)) in let s = if c < code_of_0 || c > code_of_9 then sa ^ (string_of_int n) else sa ^ "_" ^ (string_of_int n) in Id.of_string s | None -> Id.of_string sa let root_of_id id = let suffixstart = cut_ident true id in Id.of_string (String.sub (Id.to_string id) 0 suffixstart) (* Return the same identifier as the original one but whose {i subscript} is incremented. If the original identifier does not have a suffix, [0] is appended to it. Example mappings: [bar] ↦ [bar0] [bar0] ↦ [bar1] [bar00] ↦ [bar01] [bar1] ↦ [bar2] [bar01] ↦ [bar02] [bar9] ↦ [bar10] [bar09] ↦ [bar10] [bar99] ↦ [bar100] *) let increment_subscript id = let id = Id.to_string id in let len = String.length id in let rec add carrypos = let c = id.[carrypos] in if is_digit c then if Int.equal (Char.code c) (Char.code '9') then begin assert (carrypos>0); add (carrypos-1) end else begin let newid = Bytes.of_string id in Bytes.fill newid (carrypos+1) (len-1-carrypos) '0'; Bytes.set newid carrypos (Char.chr (Char.code c + 1)); newid end else begin let newid = Bytes.of_string (id^"0") in if carrypos < len-1 then begin Bytes.fill newid (carrypos+1) (len-1-carrypos) '0'; Bytes.set newid (carrypos+1) '1' end; newid end in Id.of_bytes (add (len-1)) let has_subscript id = let id = Id.to_string id in is_digit (id.[String.length id - 1]) let get_subscript id = let id0 = id in let id = Id.to_string id in let len = String.length id in let rec get_suf accu pos = if pos < 0 then (pos, accu) else let c = id.[pos] in if is_digit c then get_suf (Char.code c - Char.code '0' :: accu) (pos - 1) else (pos, accu) in let (pos, suf) = get_suf [] (len - 1) in if Int.equal pos (len - 1) then (id0, Subscript.zero) else let id = String.sub id 0 (pos + 1) in let rec compute_zeros accu = function | [] -> (accu, []) | 0 :: l -> compute_zeros (succ accu) l | _ :: _ as l -> (accu, l) in let (ss_zero, suf) = compute_zeros 0 suf in let rec compute_suf accu = function | [] -> accu | n :: l -> compute_suf (10 * accu + n) l in let ss_subs = compute_suf 0 suf in (Id.of_string id, { Subscript.ss_subs; ss_zero; }) let add_subscript id ss = if Subscript.equal Subscript.zero ss then id else if Int.equal ss.Subscript.ss_subs 0 then let id = Id.to_string id in let pad = String.make ss.Subscript.ss_zero '0' in Id.of_string (Printf.sprintf "%s%s" id pad) else let id = Id.to_string id in let pad = String.make ss.Subscript.ss_zero '0' in let suf = ss.Subscript.ss_subs in Id.of_string (Printf.sprintf "%s%s%i" id pad suf) let forget_subscript id = let numstart = cut_ident false id in let newid = Bytes.make (numstart+1) '0' in String.blit (Id.to_string id) 0 newid 0 numstart; (Id.of_bytes newid) let add_suffix id s = Id.of_string (Id.to_string id ^ s) let add_prefix s id = Id.of_string (s ^ Id.to_string id) let atompart_of_id id = fst (repr_ident id) (** Segment trees: efficient lookup of the next free integer *) module SegTree : sig type t val empty : t val mem : int -> t -> bool val add : int -> t -> t val remove : int -> t -> t val next : int -> t -> int (** [next n s] returns the smallest integer [k] not in [s] s.t. [n <= k] *) val fresh : int -> t -> int * t (** Efficient composition of [next] and [add] *) end = struct module Segment = struct type t = int * int (* segment [p, q[, in particular p < q *) let compare (p, _) (q, _) = Int.compare p q end module SegSet = Set.Make(Segment) type t = SegSet.t (* Invariants: forall [p1, q1[, [p2, q2[ in such a set, either: - p1 = p2 and q1 = q2 - p1 < q1 < p2 < q2 - p2 < q2 < p1 < q1 *) let empty = SegSet.empty let mem n s = let find (_p, q) = n < q in match SegSet.find_first_opt find s with | None -> false | Some (p, _q) -> p <= n let add n s = let find_min (_p, q) = n < q in let find_max (_p, q) = q <= n in match SegSet.find_first_opt find_min s with | None -> (* n larger than all elements *) begin match SegSet.max_elt_opt s with | None -> SegSet.add (n, n + 1) s | Some (pl, ql) -> if Int.equal n ql then SegSet.add (pl, n + 1) (SegSet.remove (pl, ql) s) else SegSet.add (n, n + 1) s end | Some (pr, qr) -> if pr <= n then s (* already present *) else match SegSet.find_last_opt find_max s with | None -> (* n smaller than all elements *) if Int.equal pr (n + 1) then SegSet.add (n, qr) (SegSet.remove (pr, qr) s) else SegSet.add (n, n + 1) s | Some (pl, ql) -> (* pl < ql <= n < pr < qr *) if Int.equal ql n && Int.equal pr (n + 1) then SegSet.add (pl, qr) (SegSet.remove (pl, ql) (SegSet.remove (pr, qr) s)) else if Int.equal ql n then SegSet.add (pl, n + 1) (SegSet.remove (pl, ql) s) else if Int.equal pr (n + 1) then SegSet.add (n, qr) (SegSet.remove (pr, qr) s) else SegSet.add (n, n + 1) s let remove n s = let find_min (_p, q) = n < q in match SegSet.find_first_opt find_min s with | None -> s | Some (pr, qr) -> if pr <= n then let s = SegSet.remove (pr, qr) s in if Int.equal (pr + 1) qr then s else if Int.equal pr n then SegSet.add (n + 1, qr) s else if Int.equal (n + 1) qr then SegSet.add (pr, n) s else SegSet.add (pr, n) (SegSet.add (n + 1, qr) s) else s let next n s = let find (_p, q) = n < q in match SegSet.find_first_opt find s with | None -> n | Some (p, q) -> if p <= n then q else n let fresh n s = let find_min (_p, q) = n < q in let find_max (_p, q) = q <= n in match SegSet.find_first_opt find_min s with | None -> let s = match SegSet.max_elt_opt s with | None -> SegSet.add (n, n + 1) s | Some (pl, ql) -> if Int.equal n ql then SegSet.add (pl, n + 1) (SegSet.remove (pl, ql) s) else SegSet.add (n, n + 1) s in n, s | Some (pr, qr) -> if pr <= n then (* equivalent to adding qr *) let next = SegSet.find_first_opt (fun (p, _q) -> qr < p) s in let s = match next with | None -> SegSet.add (pr, qr + 1) (SegSet.remove (pr, qr) s) | Some (pk, qk) -> if Int.equal (qr + 1) pk then SegSet.add (pr, qk) (SegSet.remove (pk, qk) (SegSet.remove (pr, qr) s)) else SegSet.add (pr, qr + 1) (SegSet.remove (pr, qr) s) in qr, s else let s = match SegSet.find_last_opt find_max s with | None -> if Int.equal pr (n + 1) then SegSet.add (n, qr) (SegSet.remove (pr, qr) s) else SegSet.add (n, n + 1) s | Some (pl, ql) -> if Int.equal ql n && Int.equal pr (n + 1) then SegSet.add (pl, qr) (SegSet.remove (pl, ql) (SegSet.remove (pr, qr) s)) else if Int.equal ql n then SegSet.add (pl, n + 1) (SegSet.remove (pl, ql) s) else if Int.equal pr (n + 1) then SegSet.add (n, qr) (SegSet.remove (pr, qr) s) else SegSet.add (n, n + 1) s in n, s end module SubSet = struct type t = { num : SegTree.t; pre : SegTree.t list; (* lists are OK because we are already logarithmic *) } (* We represent sets of subscripts by case-splitting on ss_zero. If it is zero, we store the number in the [num] set. Otherwise, we know the set of possible values is finite. At position k, [pre] contains a set of maximum size 10^k representing k-digit numbers with at least one leading zero. *) let empty = { num = SegTree.empty; pre = []; } let rec pow10 k accu = if k <= 0 then accu else pow10 (k - 1) (10 * accu) let rec log10 n accu = if n <= 0 then accu else log10 (n / 10) (accu + 1) let max_subscript ss = let exp = log10 ss.Subscript.ss_subs 0 + ss.Subscript.ss_zero - 1 in pow10 exp 1 let add ss s = let open Subscript in if Int.equal ss.ss_zero 0 then { s with num = SegTree.add ss.ss_subs s.num } else let pre = let len = List.length s.pre in if len < ss.ss_zero then s.pre @ List.make (ss.ss_zero - len) SegTree.empty else s.pre in let set = match List.nth_opt pre (ss.ss_zero - 1) with | None -> assert false | Some m -> SegTree.add ss.ss_subs m in { s with pre = List.assign pre (ss.ss_zero - 1) set } let remove ss s = let open Subscript in if Int.equal ss.ss_zero 0 then { s with num = SegTree.remove ss.ss_subs s.num } else match List.nth_opt s.pre (ss.ss_zero - 1) with | None -> s | Some m -> let m = SegTree.remove ss.ss_subs m in { s with pre = List.assign s.pre (ss.ss_zero - 1) m } let mem ss s = let open Subscript in if Int.equal ss.ss_zero 0 then SegTree.mem ss.ss_subs s.num else match List.nth_opt s.pre (ss.ss_zero - 1) with | None -> false | Some m -> SegTree.mem ss.ss_subs m let ss_O = { Subscript.ss_zero = 1; ss_subs = 0 } (* [0] *) let next ss s = let open Subscript in if ss.ss_zero > 0 then match List.nth_opt s.pre (ss.ss_zero - 1) with | None -> ss | Some m -> let next = SegTree.next ss.ss_subs m in let max = max_subscript ss in if max <= next then (* overflow *) { ss_zero = 0; ss_subs = SegTree.next max s.num } else { ss_zero = ss.ss_zero; ss_subs = next } else if Int.equal ss.ss_subs 0 then (* Handle specially [] *) if not @@ SegTree.mem 0 s.num then Subscript.zero else match s.pre with | [] -> ss_O | m :: _ -> if SegTree.mem 0 m then { ss_zero = 0; ss_subs = SegTree.next 1 s.num } else ss_O else { ss_zero = 0; ss_subs = SegTree.next ss.ss_subs s.num } let fresh ss s = let open Subscript in if ss.ss_zero > 0 then match List.nth_opt s.pre (ss.ss_zero - 1) with | None -> ss, add ss s | Some m -> let subs, m = SegTree.fresh ss.ss_subs m in let max = max_subscript ss in if max <= subs then let subs, num = SegTree.fresh max s.num in { ss_zero = 0; ss_subs = subs }, { s with num } else let s = { s with pre = List.assign s.pre (ss.ss_zero - 1) m } in { ss_zero = ss.ss_zero; ss_subs = subs }, s else if Int.equal ss.ss_subs 0 then if not @@ SegTree.mem 0 s.num then Subscript.zero, { num = SegTree.add 0 s.num; pre = s.pre } else match s.pre with | [] -> ss_O, { num = s.num; pre = [SegTree.add 0 SegTree.empty] } | m :: rem -> if SegTree.mem 0 m then let subs, num = SegTree.fresh 1 s.num in { ss_zero = 0; ss_subs = subs }, { num; pre = s.pre } else ss_O, { num = s.num; pre = SegTree.add 0 SegTree.empty :: rem } else let subs, num = SegTree.fresh ss.ss_subs s.num in { ss_zero = 0; ss_subs = subs }, { s with num } end module Fresh = struct type t = SubSet.t Id.Map.t let empty = Id.Map.empty let add id m = let (id, s) = get_subscript id in let old = try Id.Map.find id m with Not_found -> SubSet.empty in Id.Map.add id (SubSet.add s old) m let remove id m = let (id, s) = get_subscript id in match Id.Map.find id m with | old -> Id.Map.add id (SubSet.remove s old) m | exception Not_found -> m let mem id m = let (id, s) = get_subscript id in try SubSet.mem s (Id.Map.find id m) with Not_found -> false let next id0 m = let (id, s) = get_subscript id0 in match Id.Map.find_opt id m with | None -> id0 | Some old -> let ss = SubSet.next s old in add_subscript id ss let fresh id0 m = let (id, s) = get_subscript id0 in match Id.Map.find_opt id m with | None -> id0, Id.Map.add id (SubSet.add s SubSet.empty) m | Some old -> let ss, n = SubSet.fresh s old in add_subscript id ss, Id.Map.add id n m let of_list l = List.fold_left (fun accu id -> add id accu) empty l let of_set s = Id.Set.fold add s empty let of_named_context_val s = of_set @@ Environ.ids_of_named_context_val s end (* Names *) module type ExtName = sig include module type of struct include Names.Name end exception IsAnonymous val fold_left : ('a -> Id.t -> 'a) -> 'a -> t -> 'a val fold_right : (Id.t -> 'a -> 'a) -> t -> 'a -> 'a val iter : (Id.t -> unit) -> t -> unit val map : (Id.t -> Id.t) -> t -> t val fold_left_map : ('a -> Id.t -> 'a * Id.t) -> 'a -> t -> 'a * t val fold_right_map : (Id.t -> 'a -> Id.t * 'a) -> Name.t -> 'a -> Name.t * 'a val get_id : t -> Id.t val pick : t -> t -> t val pick_annot : (t,'r) Context.pbinder_annot -> (t,'r) Context.pbinder_annot -> (t,'r) Context.pbinder_annot val cons : t -> Id.t list -> Id.t list val to_option : Name.t -> Id.t option end module Name : ExtName = struct include Names.Name exception IsAnonymous let fold_left f a = function | Name id -> f a id | Anonymous -> a let fold_right f na a = match na with | Name id -> f id a | Anonymous -> a let iter f na = fold_right (fun x () -> f x) na () let map f = function | Name id -> Name (f id) | Anonymous -> Anonymous let fold_left_map f a = function | Name id -> let (a, id) = f a id in (a, Name id) | Anonymous -> a, Anonymous let fold_right_map f na a = match na with | Name id -> let (id, a) = f id a in (Name id, a) | Anonymous -> Anonymous, a let get_id = function | Name id -> id | Anonymous -> raise IsAnonymous let pick na1 na2 = match na1 with | Name _ -> na1 | Anonymous -> na2 let pick_annot na1 na2 = let open Context in match na1.binder_name with | Name _ -> na1 | Anonymous -> na2 let cons na l = match na with | Anonymous -> l | Name id -> id::l let to_option = function | Anonymous -> None | Name id -> Some id end (* Metavariables *) let pr_meta = Pp.int let string_of_meta = string_of_int coq-8.20.0/engine/nameops.mli000066400000000000000000000107701466560755400160240ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* int option -> Id.t val repr_ident : Id.t -> string * int option val atompart_of_id : Id.t -> string (** remove trailing digits *) val root_of_id : Id.t -> Id.t (** remove trailing digits, ' and _ *) val add_suffix : Id.t -> string -> Id.t val add_prefix : string -> Id.t -> Id.t (** Below, by {i subscript} we mean a suffix composed solely from (decimal) digits. *) module Subscript : sig type t (** Abstract datatype of subscripts. Isomorphic to a string of digits. *) val zero : t (** Empty subscript *) val succ : t -> t (** Guarantees that [x < succ x], but [succ x] might not be the smallest element strictly above [x], generally it does not exist. Example mappings: "" ↦ "0" "0" ↦ "1" "00" ↦ "01" "1" ↦ "2" "01" ↦ "02" "9" ↦ "10" "09" ↦ "10" "99" ↦ "100" *) val compare : t -> t -> int (** Well-founded order. *) val equal : t -> t -> bool end module Fresh : sig type t val empty : t val add : Id.t -> t -> t val remove : Id.t -> t -> t val mem : Id.t -> t -> bool val next : Id.t -> t -> Id.t val fresh : Id.t -> t -> Id.t * t val of_list : Id.t list -> t val of_set : Id.Set.t -> t val of_named_context_val : Environ.named_context_val -> t end val has_subscript : Id.t -> bool val get_subscript : Id.t -> Id.t * Subscript.t (** Split an identifier into a base name and a subscript. *) val add_subscript : Id.t -> Subscript.t -> Id.t (** Append the subscript to the identifier. *) val increment_subscript : Id.t -> Id.t (** Return the same identifier as the original one but whose {i subscript} is incremented. If the original identifier does not have a suffix, [0] is appended to it. Example mappings: [bar] ↦ [bar0] [bar0] ↦ [bar1] [bar00] ↦ [bar01] [bar1] ↦ [bar2] [bar01] ↦ [bar01] [bar9] ↦ [bar10] [bar09] ↦ [bar10] [bar99] ↦ [bar100] *) val forget_subscript : Id.t -> Id.t module Name : sig include module type of struct include Names.Name end exception IsAnonymous val fold_left : ('a -> Id.t -> 'a) -> 'a -> Name.t -> 'a (** [fold_left f na a] is [f id a] if [na] is [Name id], and [a] otherwise. *) val fold_right : (Id.t -> 'a -> 'a) -> Name.t -> 'a -> 'a (** [fold_right f a na] is [f a id] if [na] is [Name id], and [a] otherwise. *) val iter : (Id.t -> unit) -> Name.t -> unit (** [iter f na] does [f id] if [na] equals [Name id], nothing otherwise. *) val map : (Id.t -> Id.t) -> Name.t -> t (** [map f na] is [Anonymous] if [na] is [Anonymous] and [Name (f id)] if [na] is [Name id]. *) val fold_left_map : ('a -> Id.t -> 'a * Id.t) -> 'a -> Name.t -> 'a * Name.t (** [fold_left_map f a na] is [a',Name id'] when [na] is [Name id] and [f a id] is [(a',id')]. It is [a,Anonymous] otherwise. *) val fold_right_map : (Id.t -> 'a -> Id.t * 'a) -> Name.t -> 'a -> Name.t * 'a (** [fold_right_map f na a] is [Name id',a'] when [na] is [Name id] and [f id a] is [(id',a')]. It is [Anonymous,a] otherwise. *) val get_id : Name.t -> Id.t (** [get_id] associates [id] to [Name id]. @raise IsAnonymous otherwise. *) val pick : Name.t -> Name.t -> Name.t (** [pick na na'] returns [Anonymous] if both names are [Anonymous]. Pick one of [na] or [na'] otherwise. *) val pick_annot : (Name.t,'r) Context.pbinder_annot -> (Name.t,'r) Context.pbinder_annot -> (Name.t,'r) Context.pbinder_annot val cons : Name.t -> Id.t list -> Id.t list (** [cons na l] returns [id::l] if [na] is [Name id] and [l] otherwise. *) val to_option : Name.t -> Id.t option (** [to_option Anonymous] is [None] and [to_option (Name id)] is [Some id] *) end (** Metavariables *) val pr_meta : Constr.metavariable -> Pp.t val string_of_meta : Constr.metavariable -> string coq-8.20.0/engine/profile_tactic.ml000066400000000000000000000410531466560755400171760ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* strbrk "Ltac Profiler encountered an invalid stack (no self \ node). This can happen if you reset the profile during \ tactic execution.") let encounter_invalid_stack_no_self () = if not !encountered_invalid_stack_no_self then begin encountered_invalid_stack_no_self := true; warn_invalid_stack_no_self () end (* *************** tree data structure for profiling ****************** *) type treenode = { name : string; total : float; local : float; ncalls : int; max_total : float; children : treenode M.t } let empty_treenode name = { name; total = 0.0; local = 0.0; ncalls = 0; max_total = 0.0; children = M.empty; } let root = "root" let stack = Summary.ref ~name:"LtacProf-stack" ~local:true [empty_treenode root] let reset_profile_tmp () = stack := [empty_treenode root] (* ************** XML Serialization ********************* *) let rec of_ltacprof_tactic (name, t) = assert (String.equal name t.name); let open Xml_datatype in let total = string_of_float t.total in let local = string_of_float t.local in let ncalls = string_of_int t.ncalls in let max_total = string_of_float t.max_total in let children = List.map of_ltacprof_tactic (M.bindings t.children) in Element ("ltacprof_tactic", [ ("name", name); ("total",total); ("local",local); ("ncalls",ncalls); ("max_total",max_total)], children) let of_ltacprof_results t = let open Xml_datatype in assert(String.equal t.name root); let children = List.map of_ltacprof_tactic (M.bindings t.children) in Element ("ltacprof", [("total_time", string_of_float t.total)], children) let rec to_ltacprof_tactic m xml = let open Xml_datatype in match xml with | Element ("ltacprof_tactic", [("name", name); ("total",total); ("local",local); ("ncalls",ncalls); ("max_total",max_total)], xs) -> let node = { name; total = float_of_string total; local = float_of_string local; ncalls = int_of_string ncalls; max_total = float_of_string max_total; children = List.fold_left to_ltacprof_tactic M.empty xs; } in M.add name node m | _ -> CErrors.anomaly Pp.(str "Malformed ltacprof_tactic XML.") let to_ltacprof_results xml = let open Xml_datatype in match xml with | Element ("ltacprof", [("total_time", t)], xs) -> { name = root; total = float_of_string t; ncalls = 0; max_total = 0.0; local = 0.0; children = List.fold_left to_ltacprof_tactic M.empty xs } | _ -> CErrors.anomaly Pp.(str "Malformed ltacprof XML.") let feedback_results results = Feedback.(feedback (Custom (None, "ltacprof_results", of_ltacprof_results results))) (* ************** pretty printing ************************************* *) let format_sec x = (Printf.sprintf "%.3fs" x) let format_ratio x = (Printf.sprintf "%.1f%%" (100. *. x)) let padl n s = ws (max 0 (n - utf8_length s)) ++ str s let padr_with c n s = let ulength = utf8_length s in if Int.equal n ulength then str s else if n < ulength then str (utf8_sub s 0 n) else str s ++ str (String.make (n - ulength) c) let rec list_map_is_last f = function | [] -> [] | [x] -> [f true x] | x :: xs -> f false x :: list_map_is_last f xs let repeat_str n s = if String.is_empty s then s else let len = String.length s in String.init (n * len) (fun i -> s.[i mod len]) let header_name = " tactic" let header_name_width = utf8_length header_name let header_rest = "┴──────┴──────┴───────┴─────────┘" let header_rest_width = utf8_length header_rest let header name_width = str " tactic" ++ str (String.make (name_width - header_name_width) ' ') ++ str " local total calls max" ++ fnl () ++ str (repeat_str name_width "─") ++ str header_rest ++ fnl () module Line = struct type t = { prefix : string; tac_name : string; local : float; total : float; calls : int; maxtime : float; } let pr ~name_width l = h ( padr_with '-' name_width (l.prefix ^ l.tac_name ^ " ") ++ padl 7 (format_ratio l.local) ++ padl 7 (format_ratio l.total) ++ padl 8 (string_of_int l.calls) ++ padl 10 (format_sec l.maxtime)) end let rec linearize_node ~filter all_total indent prefix (s, e) = { Line.prefix; tac_name=s; local = (e.local /. all_total); total = (e.total /. all_total); calls = e.ncalls; maxtime = e.max_total; } :: linearize_table ~filter all_total indent false e.children and linearize_table ~filter all_total indent first_level table = let fold _ n l = let s, total = n.name, n.total in if filter s total then (s, n) :: l else l in let ls = M.fold fold table [] in match ls with | [s, n] when not first_level -> linearize_node ~filter all_total indent (indent ^ "└") (s, n) | _ -> let ls = List.sort (fun (_, { total = s1 }) (_, { total = s2}) -> compare s2 s1) ls in let iter is_last = let sep0 = if first_level then "" else if is_last then " " else " │" in let sep1 = if first_level then "─" else if is_last then " └─" else " ├─" in linearize_node ~filter all_total (indent ^ sep0) (indent ^ sep1) in List.concat (list_map_is_last iter ls) let get_printing_width = ref (fun () -> Format.pp_get_margin Format.std_formatter ()) let set_get_printing_width f = get_printing_width := f let get_printing_width () = !get_printing_width () let print_table ~filter all_total table = let lines = linearize_table ~filter all_total "" true table in let name_width = List.fold_left (fun acc (l:Line.t) -> max acc (utf8_length (l.prefix ^ l.tac_name))) 0 lines in let name_width = name_width + 1 (* +1 for a space at the end *) in (* respect Printing Width unless it's so short that we can't print the header correctly *) let name_width = min (get_printing_width() - header_rest_width) name_width in let name_width = max header_name_width name_width in header name_width ++ prlist_with_sep fnl (Line.pr ~name_width) lines let to_string ~filter ~cutoff node = let tree = node.children in let all_total = M.fold (fun _ { total } a -> total +. a) node.children 0.0 in let flat_tree = let global = ref M.empty in let find_tactic tname l = try M.find tname !global with Not_found -> let e = empty_treenode tname in global := M.add tname e !global; e in let add_tactic tname stats = global := M.add tname stats !global in let sum_stats add_total { name; total = t1; local = l1; ncalls = n1; max_total = m1 } { total = t2; local = l2; ncalls = n2; max_total = m2 } = { name; total = if add_total then t1 +. t2 else t1; local = l1 +. l2; ncalls = n1 + n2; max_total = if add_total then max m1 m2 else m1; children = M.empty; } in let rec cumulate table = let iter _ ({ name; children } as statistics) = if filter name then begin let stats' = find_tactic name global in add_tactic name (sum_stats true stats' statistics); end; cumulate children in M.iter iter table in cumulate tree; !global in let filter s n = filter s && (all_total <= 0.0 || n /. all_total >= cutoff /. 100.0) in let msg = h (str "total time: " ++ padl 11 (format_sec (all_total))) ++ fnl () ++ fnl () ++ print_table ~filter all_total flat_tree ++ fnl () ++ fnl () ++ print_table ~filter all_total tree in msg (* ******************** profiling code ************************************** *) let get_child name node = try M.find name node.children with Not_found -> empty_treenode name let time () = let times = Unix.times () in times.Unix.tms_utime +. times.Unix.tms_stime let string_of_call ck = let s = string_of_ppcmds ck in let s = String.map (fun c -> if c = '\n' then ' ' else c) s in let s = try String.sub s 0 (CString.string_index_from s 0 "(*") with Not_found -> s in String.trim s let rec merge_sub_tree name tree acc = try let t = M.find name acc in let t = { name; total = t.total +. tree.total; ncalls = t.ncalls + tree.ncalls; local = t.local +. tree.local; max_total = max t.max_total tree.max_total; children = M.fold merge_sub_tree tree.children t.children; } in M.add name t acc with Not_found -> M.add name tree acc let merge_roots ?(disjoint=true) t1 t2 = assert(String.equal t1.name t2.name); { name = t1.name; ncalls = t1.ncalls + t2.ncalls; local = if disjoint then t1.local +. t2.local else t1.local; total = if disjoint then t1.total +. t2.total else t1.total; max_total = if disjoint then max t1.max_total t2.max_total else t1.max_total; children = M.fold merge_sub_tree t2.children t1.children } let rec find_in_stack what acc = function | [] -> None | { name } as x :: rest when String.equal name what -> Some(acc, x, rest) | { name } as x :: rest -> find_in_stack what (x :: acc) rest let exit_tactic ~count_call start_time name = let diff = time () -. start_time in match !stack with | [] | [_] -> (* oops, our stack is invalid *) encounter_invalid_stack_no_self (); reset_profile_tmp () | node :: (parent :: rest as full_stack) -> if not (String.equal name node.name) then (* oops, our stack is invalid *) CErrors.anomaly (Pp.strbrk "Ltac Profiler encountered an invalid stack (wrong self node) \ likely due to backtracking into multi-success tactics."); let node = { node with total = node.total +. diff; local = node.local +. diff; ncalls = node.ncalls + (if count_call then 1 else 0); max_total = max node.max_total diff; } in (* updating the stack *) let parent = match find_in_stack node.name [] full_stack with | None -> (* no rec-call, we graft the subtree *) let parent = { parent with local = parent.local -. diff; children = M.add node.name node parent.children } in stack := parent :: rest; parent | Some(to_update, self, rest) -> (* we coalesce the rec-call and update the lower stack *) let self = merge_roots ~disjoint:false self node in let updated_stack = List.fold_left (fun s x -> (try M.find x.name (List.hd s).children with Not_found -> x) :: s) (self :: rest) to_update in stack := updated_stack; List.hd !stack in (* Calls are over, we reset the stack and send back data *) if rest == [] && get_profiling () then begin assert(String.equal root parent.name); encountered_invalid_stack_no_self := false; reset_profile_tmp (); feedback_results parent end (** [tclWRAPFINALLY before tac finally] runs [before] before each entry-point of [tac] and passes the result of [before] to [finally], which is then run at each exit-point of [tac], regardless of whether it succeeds or fails. Said another way, if [tac] succeeds, then it behaves as [before >>= fun v -> tac >>= fun ret -> finally v <*> tclUNIT ret]; otherwise, if [tac] fails with [e], it behaves as [before >>= fun v -> finally v <*> tclZERO e]. *) let rec tclWRAPFINALLY before tac finally = let open Proofview in let open Proofview.Notations in before >>= fun v -> tclCASE tac >>= function | Fail (e, info) -> finally v >>= fun () -> tclZERO ~info e | Next (ret, tac') -> tclOR (finally v >>= fun () -> tclUNIT ret) (fun e -> tclWRAPFINALLY before (tac' e) finally) let do_profile_gen pp_call call_trace ?(count_call=true) tac = let open Proofview.Notations in (* We do an early check to [is_profiling] so that we save the overhead of [tclWRAPFINALLY] when profiling is not set *) Proofview.tclLIFT (Proofview.NonLogical.make (fun () -> !is_profiling)) >>= function | false -> tac | true -> tclWRAPFINALLY (Proofview.tclLIFT (Proofview.NonLogical.make (fun () -> match pp_call call_trace, !stack with | Some c, parent :: rest -> let name = string_of_call c in let node = get_child name parent in stack := node :: parent :: rest; Some (name, time ()) | Some _, [] -> assert false | _ -> None ))) tac (function | Some (name, start_time) -> (Proofview.tclLIFT (Proofview.NonLogical.make (fun () -> exit_tactic ~count_call start_time name))) | None -> Proofview.tclUNIT ()) (* ************** Accumulation of data from workers ************************* *) let get_local_profiling_results () = List.hd !stack (* We maintain our own cache of document data, given that the semantics of the STM implies that synchronized state for opaque proofs will be lost on QED. This provides some complications later on as we will have to simulate going back on the document on our own. *) module DData = struct type t = Feedback.doc_id * Stateid.t let compare x y = compare x y end module SM = Map.Make(DData) let data = ref SM.empty let _ = Feedback.(add_feeder (function | { doc_id = d; span_id = s; contents = Custom (_, "ltacprof_results", xml) } -> let results = to_ltacprof_results xml in let other_results = (* Multi success can cause this *) try SM.find (d,s) !data with Not_found -> empty_treenode root in data := SM.add (d,s) (merge_roots results other_results) !data | _ -> ())) let reset_profile () = encountered_invalid_stack_no_self := false; reset_profile_tmp (); data := SM.empty (* ****************************** Named timers ****************************** *) let timer_data = ref M.empty let timer_name = function | Some v -> v | None -> "" let restart_timer name = timer_data := M.add (timer_name name) (System.get_time ()) !timer_data let get_timer name = try M.find (timer_name name) !timer_data with Not_found -> System.get_time () let finish_timing ~prefix name = let tend = System.get_time () in let tstart = get_timer name in Feedback.msg_notice(str prefix ++ pr_opt str name ++ str " ran for " ++ System.fmt_time_difference tstart tend) (* ******************** *) let print_results_filter ~cutoff ~filter = data := SM.filter (fun (doc,id) _ -> Stateid.is_valid ~doc id) !data; let results = SM.fold (fun _ -> merge_roots ~disjoint:true) !data (empty_treenode root) in let results = merge_roots results (CList.last !stack) in Feedback.msg_notice (to_string ~cutoff ~filter results) ;; let print_results ~cutoff = print_results_filter ~cutoff ~filter:(fun _ -> true) let print_results_tactic tactic = print_results_filter ~cutoff:!Flags.profile_ltac_cutoff ~filter:(fun s -> String.(equal tactic (sub (s ^ ".") 0 (min (1+length s) (length tactic))))) let do_print_results_at_close () = if get_profiling () then print_results ~cutoff:!Flags.profile_ltac_cutoff let () = let open Goptions in declare_bool_option { optstage = Summary.Stage.Interp; optdepr = None; optkey = ["Ltac"; "Profiling"]; optread = get_profiling; optwrite = set_profiling } coq-8.20.0/engine/profile_tactic.mli000066400000000000000000000100211466560755400173360ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* Pp.t option) -> 'a -> ?count_call:bool -> 'b Proofview.tactic -> 'b Proofview.tactic val set_profiling : bool -> unit (* Cut off results < than specified cutoff *) val print_results : cutoff:float -> unit val print_results_tactic : string -> unit val reset_profile : unit -> unit val restart_timer : string option -> unit val finish_timing : prefix:string -> string option -> unit val do_print_results_at_close : unit -> unit (* The collected statistics for a tactic. The timing data is collected over all * instances of a given tactic from its parent. E.g. if tactic 'aaa' calls * 'foo' twice, then 'aaa' will contain just one entry for 'foo' with the * statistics of the two invocations combined, and also combined over all * invocations of 'aaa'. * total: time spent running this tactic and its subtactics (seconds) * local: time spent running this tactic, minus its subtactics (seconds) * ncalls: the number of invocations of this tactic that have been made * max_total: the greatest running time of a single invocation (seconds) *) type treenode = { name : string; total : float; local : float; ncalls : int; max_total : float; children : treenode CString.Map.t } (* Returns the profiling results known by the current process *) val get_local_profiling_results : unit -> treenode val feedback_results : treenode -> unit val set_get_printing_width : (unit -> int) -> unit (** Internal hook *) coq-8.20.0/engine/proofview.ml000066400000000000000000001235731466560755400162370ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* map_constr nf0 d) hyps in let size = Evd.fold (fun _ _ i -> i+1) solution 0 in let new_el = List.map (fun (hyps,t,ty) -> nf_hyps hyps, nf t, nf ty) el in let pruned_solution = Evd.drop_all_defined solution in let apply_subst_einfo _ ei = Evd.map_evar_info nf ei in let new_solution = Evd.raw_map_undefined apply_subst_einfo pruned_solution in let new_size = Evd.fold (fun _ _ i -> i+1) new_solution 0 in Feedback.msg_info (Pp.str (Printf.sprintf "Evars: %d -> %d\n" size new_size)); new_el, { pv with solution = new_solution; } (** {6 Starting and querying a proof view} *) type telescope = | TNil of Evd.evar_map | TCons of Environ.env * Evd.evar_map * EConstr.types * (Evd.evar_map -> EConstr.constr -> telescope) let map_telescope_evd f = function | TNil sigma -> TNil (f sigma) | TCons (env,sigma,ty,g) -> TCons(env,(f sigma),ty,g) let dependent_init = (* Goals don't have a source location. *) let src = Loc.tag @@ Evar_kinds.GoalEvar in (* Main routine *) let rec aux = function | TNil sigma -> [], { solution = sigma; comb = [] } | TCons (env, sigma, typ, t) -> let (sigma, econstr) = Evarutil.new_evar env sigma ~src ~typeclass_candidate:false typ in let (gl, _) = EConstr.destEvar sigma econstr in let ret, { solution = sol; comb = comb } = aux (t sigma econstr) in let entry = (Environ.named_context_val env, econstr, typ) :: ret in entry, { solution = sol; comb = with_empty_state gl :: comb } in fun t -> let t = map_telescope_evd Evd.push_future_goals t in let entry, v = aux t in (* The created goal are not to be shelved. *) let _goals, solution = Evd.pop_future_goals v.solution in entry, { v with solution } let init = let rec aux sigma = function | [] -> TNil sigma | (env,g)::l -> TCons (env,sigma,g,(fun sigma _ -> aux sigma l)) in fun sigma l -> dependent_init (aux sigma l) let initial_goals initial = initial let finished = function | {comb = []} -> true | _ -> false let return { solution=defs } = defs let return_constr { solution = defs } c = Evarutil.nf_evar defs c let partial_proof entry pv = CList.map (return_constr pv) (CList.map pi2 entry) (** {6 Focusing commands} *) (** A [focus_context] represents the part of the proof view which has been removed by a focusing action, it can be used to unfocus later on. *) (* First component is a reverse list of the goals which come before and second component is the list of the goals which go after (in the expected order). *) type focus_context = goal_with_state list * goal_with_state list (** Returns a stylised view of a focus_context for use by, for instance, ide-s. *) (* spiwack: the type of [focus_context] will change as we push more refined functions to ide-s. This would be better than spawning a new nearly identical function every time. Hence the generic name. *) (* In this version: the goals in the context, as a "zipper" (the first list is in reversed order). *) let focus_context (left,right) = (List.map drop_state left, List.map drop_state right) (** This (internal) function extracts a sublist between two indices, and returns this sublist together with its context: if it returns [(a,(b,c))] then [a] is the sublist and [(rev b) @ a @ c] is the original list. The focused list has length [j-i-1] and contains the goals from number [i] to number [j] (both included) the first goal of the list being numbered [1]. [focus_sublist i j l] raises [IndexOutOfRange] if [i > length l], or [j > length l] or [j < i]. *) let focus_sublist i j l = let (left,sub_right) = CList.goto (i-1) l in let (sub, right) = try CList.chop (j-i+1) sub_right with Failure _ -> raise CList.IndexOutOfRange in (sub, (left,right)) (** Inverse operation to the previous one. *) let unfocus_sublist (left,right) s = CList.rev_append left (s@right) (** [focus i j] focuses a proofview on the goals from index [i] to index [j] (inclusive, goals are indexed from [1]). I.e. goals number [i] to [j] become the only focused goals of the returned proofview. It returns the focused proofview, and a context for the focus stack. *) let focus i j sp = let (new_comb, (left, right)) = focus_sublist i j sp.comb in ( { sp with comb = new_comb } , (left, right) ) let cleared_alias evd g = let evk = drop_state g in let state = get_state g in Option.map (fun g -> goal_with_state g state) (Evarutil.advance evd evk) (** [undefined defs l] is the list of goals in [l] which are still unsolved (after advancing cleared goals). Note that order matters. *) let undefined_evars defs l = let fold evk (seen, ans as accu) = match Evarutil.advance defs evk with | None -> accu | Some evk -> if Evar.Set.mem evk seen then accu else (Evar.Set.add evk seen, evk :: ans) in snd @@ List.fold_right fold l (Evar.Set.empty, []) let undefined defs l = let fold gl (seen, ans as accu) = match cleared_alias defs gl with | None -> accu | Some gl -> let evk = drop_state gl in if Evar.Set.mem evk seen then accu else (Evar.Set.add evk seen, gl :: ans) in snd @@ List.fold_right fold l (Evar.Set.empty, []) (** Unfocuses a proofview with respect to a context. *) let unfocus (left, right) sp = { sp with comb = undefined sp.solution (unfocus_sublist (left, right) sp.comb) } let with_empty_state = Proofview_monad.with_empty_state let drop_state = Proofview_monad.drop_state let goal_with_state = Proofview_monad.goal_with_state (** {6 The tactic monad} *) (** - Tactics are objects which apply a transformation to all the subgoals of the current view at the same time. By opposition to the old vision of applying it to a single goal. It allows tactics such as [shelve_unifiable], tactics to reorder the focused goals, or global automation tactic for dependent subgoals (instantiating an evar has influences on the other goals of the proof in progress, not being able to take that into account causes the current eauto tactic to fail on some instances where it could succeed). Another benefit is that it is possible to write tactics that can be executed even if there are no focused goals. - Tactics form a monad ['a tactic], in a sense a tactic can be seen as a function (without argument) which returns a value of type 'a and modifies the environment (in our case: the view). Tactics of course have arguments, but these are given at the meta-level as OCaml functions. Most tactics in the sense we are used to return [()], that is no really interesting values. But some might pass information around. The tactics seen in Coq's Ltac are (for now at least) only [unit tactic], the return values are kept for the OCaml toolkit. The operation or the monad are [Proofview.tclUNIT] (which is the "return" of the tactic monad) [Proofview.tclBIND] (which is the "bind") and [Proofview.tclTHEN] (which is a specialized bind on unit-returning tactics). - Tactics have support for full-backtracking. Tactics can be seen having multiple success: if after returning the first success a failure is encountered, the tactic can backtrack and use a second success if available. The state is backtracked to its previous value, except the non-logical state defined in the {!NonLogical} module below. *) (* spiwack: as far as I'm aware this doesn't really relate to F. Kirchner and C. Muñoz. *) module Proof = Logical (** type of tactics: tactics can - access the environment, - report unsafe status, shelved goals and given up goals - access and change the current [proofview] - backtrack on previous changes of the proofview *) type +'a tactic = 'a Proof.t (** Applies a tactic to the current proofview. *) let apply ~name ~poly env t sp = let open Logic_monad in let ans = Proof.repr (Proof.run t P.{trace=false; name; poly} (sp,env)) in let ans = Logic_monad.NonLogical.run ans in match ans with | Nil (e, info) -> Exninfo.iraise (TacticFailure e, info) | Cons ((r, (state, _), status, info), _) -> r, state, status, Trace.to_tree info (** {7 Monadic primitives} *) (** Unit of the tactic monad. *) let tclUNIT = Proof.return (** Bind operation of the tactic monad. *) let tclBIND = Proof.(>>=) (** Interprets the ";" (semicolon) of Ltac. As a monadic operation, it's a specialized "bind". *) let tclTHEN = Proof.(>>) (** [tclIGNORE t] has the same operational content as [t], but drops the returned value. *) let tclIGNORE = Proof.ignore module Monad = Proof (** {7 Failure and backtracking} *) (** [tclZERO e] fails with exception [e]. It has no success. *) let tclZERO ?(info=Exninfo.null) e = if not (CErrors.noncritical e) then CErrors.anomaly (Pp.str "tclZERO receiving critical error: " ++ CErrors.print e); Proof.zero (e, info) (** [tclOR t1 t2] behaves like [t1] as long as [t1] succeeds. Whenever the successes of [t1] have been depleted and it failed with [e], then it behaves as [t2 e]. In other words, [tclOR] inserts a backtracking point. *) let tclOR = Proof.plus (** [tclORELSE t1 t2] is equal to [t1] if [t1] has at least one success or [t2 e] if [t1] fails with [e]. It is analogous to [try/with] handler of exception in that it is not a backtracking point. *) let tclORELSE t1 t2 = let open Logic_monad in let open Proof in split t1 >>= function | Nil e -> t2 e | Cons (a,t1') -> plus (return a) t1' (** [tclIFCATCH a s f] is a generalisation of {!tclORELSE}: if [a] succeeds at least once then it behaves as [tclBIND a s] otherwise, if [a] fails with [e], then it behaves as [f e]. *) let tclIFCATCH a s f = let open Logic_monad in let open Proof in split a >>= function | Nil e -> f e | Cons (x,a') -> plus (s x) (fun e -> (a' e) >>= fun x' -> (s x')) (** [tclONCE t] behave like [t] except it has at most one success: [tclONCE t] stops after the first success of [t]. If [t] fails with [e], [tclONCE t] also fails with [e]. *) let tclONCE = Proof.once exception MoreThanOneSuccess let _ = CErrors.register_handler begin function | MoreThanOneSuccess -> Some (Pp.str "This tactic has more than one success.") | _ -> None end (** [tclEXACTLY_ONCE e t] succeeds as [t] if [t] has exactly one success. Otherwise it fails. The tactic [t] is run until its first success, then a failure with exception [e] is simulated. It [t] yields another success, then [tclEXACTLY_ONCE e t] fails with [MoreThanOneSuccess] (it is a user error). Otherwise, [tclEXACTLY_ONCE e t] succeeds with the first success of [t]. Notice that the choice of [e] is relevant, as the presence of further successes may depend on [e] (see {!tclOR}). *) let tclEXACTLY_ONCE e t = let open Logic_monad in let open Proof in split t >>= function | Nil (e, info) -> tclZERO ~info e | Cons (x,k) -> let info = Exninfo.null in Proof.split (k (e, Exninfo.null)) >>= function | Nil _ -> tclUNIT x | _ -> tclZERO ~info MoreThanOneSuccess (** [tclCASE t] wraps the {!Proofview_monad.Logical.split} primitive. *) type 'a case = | Fail of Exninfo.iexn | Next of 'a * (Exninfo.iexn -> 'a tactic) let tclCASE t = let open Logic_monad in let map = function | Nil e -> Fail e | Cons (x, t) -> Next (x, t) in Proof.map map (Proof.split t) let tclBREAK = Proof.break (** {7 Focusing tactics} *) exception NoSuchGoals of int let _ = CErrors.register_handler begin function | NoSuchGoals n -> Some (str "No such " ++ str (String.plural n "goal") ++ str ".") | _ -> None end (** [tclFOCUS ?nosuchgoal i j t] applies [t] in a context where only the goals numbered [i] to [j] are focused (the rest of the goals is restored at the end of the tactic). If the range [i]-[j] is not valid, then it [tclFOCUS_gen nosuchgoal i j t] is [nosuchgoal]. *) let tclFOCUS ?nosuchgoal i j t = let nosuchgoal ~info = Option.default (tclZERO ~info (NoSuchGoals (j+1-i))) nosuchgoal in let open Proof in Pv.get >>= fun initial -> try let (focused,context) = focus i j initial in Pv.set focused >> t >>= fun result -> Pv.modify (fun next -> unfocus context next) >> return result with CList.IndexOutOfRange as exn -> let _, info = Exninfo.capture exn in nosuchgoal ~info let tclTRYFOCUS i j t = tclFOCUS ~nosuchgoal:(tclUNIT ()) i j t let tclFOCUSLIST ?(nosuchgoal=tclZERO (NoSuchGoals 0)) l t = let open Proof in Comb.get >>= fun comb -> let n = CList.length comb in let ok (i, j) = 1 <= i && i <= j && j <= n in if not (CList.for_all ok l) then nosuchgoal else match l with | [] -> nosuchgoal | (mi, _) :: _ -> (* Get the left-most goal to focus. This goal won't move, and we will then place all the other goals to focus to the right. *) let mi = CList.fold_left (fun m (i, _) -> min m i) mi l in (* [CList.goto] returns a zipper, so that [(rev left) @ sub_right = comb]. *) let left, sub_right = CList.goto (mi-1) comb in let p x _ = CList.exists (fun (i, j) -> i <= x + mi && x + mi <= j) l in let sub, right = CList.partitioni p sub_right in let mj = mi - 1 + CList.length sub in Comb.set (CList.rev_append left (sub @ right)) >> tclFOCUS mi mj t (** Like {!tclFOCUS} but selects a single goal by name. *) let tclFOCUSID ?(nosuchgoal=tclZERO (NoSuchGoals 1)) id t = let open Proof in Pv.get >>= fun initial -> try let ev = Evd.evar_key id initial.solution in try let comb = CList.map drop_state initial.comb in let n = CList.index Evar.equal ev comb in (* goal is already under focus *) let (focused,context) = focus n n initial in Pv.set focused >> t >>= fun result -> Pv.modify (fun next -> unfocus context next) >> return result with Not_found -> (* otherwise, save current focus and work purely on the shelve *) Comb.set [with_empty_state ev] >> t >>= fun result -> Comb.get >>= fun gls' -> Comb.set initial.comb >> let gls' = CList.filter_map (fun ev' -> let ev' = drop_state ev' in (* if ev' is still undefined, leave it on its original shelf *) if (Evar.equal ev ev') then None else Some ev') gls' in Pv.modify (fun pv -> { pv with solution = Evd.shelve pv.solution (undefined_evars pv.solution gls') }) >> return result with Not_found -> nosuchgoal (** {7 Dispatching on goals} *) exception SizeMismatch of int*int let _ = CErrors.register_handler begin function | SizeMismatch (i,j) -> let open Pp in Some ( str"Incorrect number of goals" ++ spc() ++ str"(expected "++int i++str(String.plural i " tactic") ++ str", was given "++ int j++str").") | _ -> None end (** A variant of [Monad.List.iter] where we iter over the focused list of goals. The argument tactic is executed in a focus comprising only of the current goal, a goal which has been solved by side effect is skipped. The generated subgoals are concatenated in order. *) let iter_goal i = let open Proof in Comb.get >>= fun initial -> Proof.List.fold_left begin fun (subgoals as cur) goal -> Solution.get >>= fun step -> match cleared_alias step goal with | None -> return cur | Some goal -> Comb.set [goal] >> i goal >> Proof.map (fun comb -> comb :: subgoals) Comb.get end [] initial >>= fun subgoals -> Solution.get >>= fun evd -> Comb.set CList.(undefined evd (flatten (rev subgoals))) (** List iter but allocates a list of results *) let map_goal i = let rev = List.rev in (* hem... Proof masks List... *) let open Proof in Comb.get >>= fun initial -> Proof.List.fold_left begin fun (acc, subgoals as cur) goal -> Solution.get >>= fun step -> match cleared_alias step goal with | None -> return cur | Some goal -> Comb.set [goal] >> i goal >>= fun res -> Proof.map (fun comb -> comb :: subgoals) Comb.get >>= fun x -> return (res :: acc, x) end ([],[]) initial >>= fun (results_rev, subgoals) -> Solution.get >>= fun evd -> Comb.set CList.(undefined evd (flatten (rev subgoals))) >> return (rev results_rev) (** A variant of [Monad.List.fold_left2] where the first list is the list of focused goals. The argument tactic is executed in a focus comprising only of the current goal, a goal which has been solved by side effect is skipped. The generated subgoals are concatenated in order. *) let fold_left2_goal i s l = let open Proof in Pv.get >>= fun initial -> let err = return () >>= fun () -> (* Delay the computation of list lengths. *) tclZERO (SizeMismatch (CList.length initial.comb,CList.length l)) in Proof.List.fold_left2 err begin fun ((r,subgoals) as cur) goal a -> Solution.get >>= fun step -> match cleared_alias step goal with | None -> return cur | Some goal -> Comb.set [goal] >> i goal a r >>= fun r -> Proof.map (fun comb -> (r, comb :: subgoals)) Comb.get end (s,[]) initial.comb l >>= fun (r,subgoals) -> Solution.get >>= fun evd -> Comb.set CList.(undefined evd (flatten (rev subgoals))) >> return r (** Dispatch tacticals are used to apply a different tactic to each goal under focus. They come in two flavours: [tclDISPATCH] takes a list of [unit tactic]-s and build a [unit tactic]. [tclDISPATCHL] takes a list of ['a tactic] and returns an ['a list tactic]. They both work by applying each of the tactic in a focus restricted to the corresponding goal (starting with the first goal). In the case of [tclDISPATCHL], the tactic returns a list of the same size as the argument list (of tactics), each element being the result of the tactic executed in the corresponding goal. When the length of the tactic list is not the number of goal, raises [SizeMismatch (g,t)] where [g] is the number of available goals, and [t] the number of tactics passed. [tclDISPATCHGEN join tacs] generalises both functions as the successive results of [tacs] are stored in reverse order in a list, and [join] is used to convert the result into the expected form. *) let tclDISPATCHGEN0 join tacs = match tacs with | [] -> begin let open Proof in Comb.get >>= function | [] -> tclUNIT (join []) | comb -> tclZERO (SizeMismatch (CList.length comb,0)) end | [tac] -> begin let open Proof in Pv.get >>= function | { comb=[goal] ; solution } -> begin match cleared_alias solution goal with | None -> tclUNIT (join []) | Some _ -> Proof.map (fun res -> join [res]) tac end | {comb} -> tclZERO (SizeMismatch(CList.length comb,1)) end | _ -> let iter _ t cur = Proof.map (fun y -> y :: cur) t in let ans = fold_left2_goal iter [] tacs in Proof.map join ans let tclDISPATCHGEN join tacs = let branch t = InfoL.tag (Info.DBranch) t in let tacs = CList.map branch tacs in InfoL.tag (Info.Dispatch) (tclDISPATCHGEN0 join tacs) let tclDISPATCH tacs = tclDISPATCHGEN ignore tacs let tclDISPATCHL tacs = tclDISPATCHGEN CList.rev tacs (** [extend_to_list startxs rx endxs l] builds a list [startxs @ [rx,...,rx] @ endxs] of the same length as [l]. Raises [SizeMismatch] if [startxs @ endxs] is already longer than [l]. *) let extend_to_list startxs rx endxs l = (* spiwack: I use [l] essentially as a natural number *) let rec duplicate acc = function | [] -> acc | _::rest -> duplicate (rx::acc) rest in let rec tail to_match rest = match rest, to_match with | [] , _::_ -> raise (SizeMismatch(0,0)) (* placeholder *) | _::rest , _::to_match -> tail to_match rest | _ , [] -> duplicate endxs rest in let rec copy pref rest = match rest,pref with | [] , _::_ -> raise (SizeMismatch(0,0)) (* placeholder *) | _::rest, a::pref -> a::(copy pref rest) | _ , [] -> tail endxs rest in copy startxs l (** [tclEXTEND b r e] is a variant of {!tclDISPATCH}, where the [r] tactic is "repeated" enough time such that every goal has a tactic assigned to it ([b] is the list of tactics applied to the first goals, [e] to the last goals, and [r] is applied to every goal in between). *) let tclEXTEND tacs1 rtac tacs2 = let open Proof in Comb.get >>= fun comb -> try let tacs = extend_to_list tacs1 rtac tacs2 comb in tclDISPATCH tacs with SizeMismatch _ -> tclZERO (SizeMismatch( CList.length comb, (CList.length tacs1)+(CList.length tacs2))) (* spiwack: failure occurs only when the number of goals is too small. Hence we can assume that [rtac] is replicated 0 times for any error message. *) (** [tclEXTEND [] tac []]. *) let tclINDEPENDENT tac = let open Proof in Pv.get >>= fun initial -> match initial.comb with | [] -> tclUNIT () | [_] -> tac | _ -> let tac = InfoL.tag (Info.DBranch) tac in InfoL.tag (Info.Dispatch) (iter_goal (fun _ -> tac)) let tclINDEPENDENTL tac = let open Proof in Pv.get >>= fun initial -> match initial.comb with | [] -> tclUNIT [] | [_] -> tac >>= fun x -> return [x] | _ -> let tac = InfoL.tag (Info.DBranch) tac in InfoL.tag (Info.Dispatch) (map_goal (fun _ -> tac)) (** {7 Goal manipulation} *) (** Shelves all the goals under focus. *) let shelve = let open Proof in Comb.get >>= fun initial -> Comb.set [] >> InfoL.leaf (Info.Tactic (fun () -> Pp.str"shelve")) >> let initial = CList.map drop_state initial in Pv.modify (fun pv -> { pv with solution = Evd.shelve pv.solution initial }) let shelve_goals l = let open Proof in Comb.get >>= fun initial -> let comb = CList.filter (fun g -> not (CList.mem (drop_state g) l)) initial in Comb.set comb >> InfoL.leaf (Info.Tactic (fun () -> Pp.str"shelve_goals")) >> Pv.modify (fun pv -> { pv with solution = Evd.shelve pv.solution l }) (** [depends_on sigma src tgt] checks whether the goal [src] appears as an existential variable in the definition of the goal [tgt] in [sigma]. *) let depends_on sigma src tgt = let evi = Evd.find_undefined sigma tgt in Evar.Set.mem src (Evd.evars_of_filtered_evar_info sigma (Evarutil.nf_evar_info sigma evi)) let unifiable_delayed g l = CList.exists (fun (tgt, lazy evs) -> not (Evar.equal g tgt) && Evar.Set.mem g evs) l let free_evars sigma l = let cache = Evarutil.create_undefined_evars_cache () in let map ev = (* Computes the set of evars appearing in the hypotheses, the conclusion or the body of the evar_info [evi]. Note: since we want to use it on goals, the body is actually supposed to be empty. *) let EvarInfo evi = Evd.find sigma ev in let fevs = lazy (Evarutil.filtered_undefined_evars_of_evar_info ~cache sigma evi) in (ev, fevs) in List.map map l let free_evars_with_state sigma l = let cache = Evarutil.create_undefined_evars_cache () in let map ev = (* Computes the set of evars appearing in the hypotheses, the conclusion or the body of the evar_info [evi]. Note: since we want to use it on goals, the body is actually supposed to be empty. *) let ev = drop_state ev in let EvarInfo evi = Evd.find sigma ev in let fevs = lazy (Evarutil.filtered_undefined_evars_of_evar_info ~cache sigma evi) in (ev, fevs) in List.map map l (** [unifiable sigma g l] checks whether [g] appears in another subgoal of [l]. The list [l] may contain [g], but it does not affect the result. *) let unifiable_delayed_with_state sigma g l = let g = drop_state g in unifiable_delayed g l let unifiable sigma g l = let l = free_evars sigma l in unifiable_delayed g l (** [partition_unifiable sigma l] partitions [l] into a pair [(u,n)] where [u] is composed of the unifiable goals, i.e. the goals on whose definition other goals of [l] depend, and [n] are the non-unifiable goals. *) let partition_unifiable sigma l = let fevs = free_evars_with_state sigma l in CList.partition (fun g -> unifiable_delayed_with_state sigma g fevs) l (** Shelves the unifiable goals under focus, i.e. the goals which appear in other goals under focus (the unfocused goals are not considered). *) let shelve_unifiable_informative = let open Proof in Pv.get >>= fun initial -> let (u,n) = partition_unifiable initial.solution initial.comb in Comb.set n >> InfoL.leaf (Info.Tactic (fun () -> Pp.str"shelve_unifiable")) >> let u = CList.map drop_state u in Pv.modify (fun pv -> { pv with solution = Evd.shelve pv.solution u }) >> tclUNIT u let shelve_unifiable = let open Proof in shelve_unifiable_informative >>= fun _ -> tclUNIT () (** [guard_no_unifiable] returns the list of unifiable goals if some goals are unifiable (see {!shelve_unifiable}) in the current focus. *) let guard_no_unifiable = let open Proof in Pv.get >>= fun initial -> let (u,n) = partition_unifiable initial.solution initial.comb in match u with | [] -> tclUNIT None | gls -> let l = CList.map (fun g -> Evd.dependent_evar_ident (drop_state g) initial.solution) gls in let l = CList.map (fun id -> Names.Name id) l in tclUNIT (Some l) (** [unshelve l p] moves all the goals in [l] from the shelf and put them at the end of the focused goals of p, if they are still undefined after [advance] *) let unshelve l p = let solution = Evd.unshelve p.solution l in let l = List.map with_empty_state l in (* advance the goals in case of clear *) let l = undefined p.solution l in { comb = p.comb@l; solution } let filter_shelf f pv = { pv with solution = Evd.filter_shelf f pv.solution } let mark_in_evm ~goal evd evars = let evd = if goal then let mark evd content = let EvarInfo info = Evd.find evd content in let source = match Evd.evar_source info with (* Two kinds for goal evars: - GoalEvar (morally not dependent) - VarInstance (morally dependent of some name). This is a heuristic for naming these evars. *) | loc, (Evar_kinds.QuestionMark { Evar_kinds.qm_name=Names.Name id} | Evar_kinds.ImplicitArg (_,(_,Some id),_)) -> loc, Evar_kinds.VarInstance id | _, (Evar_kinds.VarInstance _ | Evar_kinds.GoalEvar) as x -> x | loc,_ -> loc,Evar_kinds.GoalEvar in Evd.update_source evd content source in CList.fold_left mark evd evars else evd in let tcs = Evd.get_typeclass_evars evd in let evset = Evar.Set.of_list evars in Evd.set_typeclass_evars evd (Evar.Set.diff tcs evset) let with_shelf tac = let open Proof in Pv.get >>= fun pv -> let { solution } = pv in Pv.set { pv with solution = Evd.push_shelf @@ Evd.push_future_goals solution } >> tac >>= fun ans -> Pv.get >>= fun npv -> let { solution = sigma } = npv in let gls, sigma = Evd.pop_shelf sigma in (* The pending future goals are necessarily coming from legacy tactics *) (* and thus considered as to shelve, as in Proof.run_tactic *) (* TODO: is it still relevant since the removal of the compat layer? *) let fgl, sigma = Evd.pop_future_goals sigma in (* Ensure we mark and return only unsolved goals *) let gls' = CList.rev_append (Evd.FutureGoals.comb fgl) gls in let gls' = undefined_evars sigma gls' in let sigma = mark_in_evm ~goal:false sigma gls' in let npv = { npv with solution = sigma } in Pv.set npv >> tclUNIT (gls', ans) (** [goodmod p m] computes the representative of [p] modulo [m] in the interval [[0,m-1]].*) let goodmod p m = if m = 0 then 0 else let p' = p mod m in (* if [n] is negative [n mod l] is negative of absolute value less than [l], so [(n mod l)+l] is the representative of [n] in the interval [[0,l-1]].*) if p' < 0 then p'+m else p' let cycle n = let open Proof in InfoL.leaf (Info.Tactic (fun () -> Pp.(str"cycle "++int n))) >> Comb.modify begin fun initial -> let l = CList.length initial in let n' = goodmod n l in let (front,rear) = CList.chop n' initial in rear@front end let swap i j = let open Proof in InfoL.leaf (Info.Tactic (fun () -> Pp.(hov 2 (str"swap"++spc()++int i++spc()++int j)))) >> Comb.modify begin fun initial -> let l = CList.length initial in let i = if i>0 then i-1 else i and j = if j>0 then j-1 else j in let i = goodmod i l and j = goodmod j l in CList.map_i begin fun k x -> match k with | k when Int.equal k i -> CList.nth initial j | k when Int.equal k j -> CList.nth initial i | _ -> x end 0 initial end let revgoals = let open Proof in InfoL.leaf (Info.Tactic (fun () -> Pp.str"revgoals")) >> Comb.modify CList.rev let numgoals = let open Proof in Comb.get >>= fun comb -> return (CList.length comb) (** {7 Access primitives} *) let tclEVARMAP = Solution.get let tclENV = Env.get (** {7 Put-like primitives} *) let emit_side_effects eff x = { x with solution = Evd.emit_side_effects eff x.solution } let tclEFFECTS eff = let open Proof in return () >>= fun () -> (* The Global.env should be taken at exec time *) Env.set (Global.env ()) >> Pv.modify (fun initial -> emit_side_effects eff initial) let mark_as_unsafe = Status.put false (** Gives up on the goal under focus. Reports an unsafe status. Proofs with given up goals cannot be closed. *) let give_up evs pv = let solution = List.fold_left (fun sigma ev -> Evd.give_up (drop_state ev) sigma) pv.solution evs in { pv with solution } let give_up = let open Proof in Comb.get >>= fun initial -> Comb.set [] >> mark_as_unsafe >> InfoL.leaf (Info.Tactic (fun () -> Pp.str"give_up")) >> Pv.modify (give_up initial) (** {7 Control primitives} *) module Progress = struct let eq_constr evd extended_evd = Evarutil.eq_constr_univs_test ~evd ~extended_evd (** equality function on hypothesis contexts *) let eq_named_context_val sigma1 sigma2 ctx1 ctx2 = let r_eq _ _ = true (* ignore relevances *) in let c1 = EConstr.named_context_of_val ctx1 and c2 = EConstr.named_context_of_val ctx2 in let eq_named_declaration d1 d2 = match d1, d2 with | LocalAssum (i1,t1), LocalAssum (i2,t2) -> Context.eq_annot Names.Id.equal r_eq i1 i2 && eq_constr sigma1 sigma2 t1 t2 | LocalDef (i1,c1,t1), LocalDef (i2,c2,t2) -> Context.eq_annot Names.Id.equal r_eq i1 i2 && eq_constr sigma1 sigma2 c1 c2 && eq_constr sigma1 sigma2 t1 t2 | _ -> false in (* NB: can't use List.equal because it shortcuts on physical equality *) List.for_all2eq eq_named_declaration c1 c2 let eq_evar_body (type a1 a2) sigma1 sigma2 (b1 : a1 Evd.evar_body) (b2 : a2 Evd.evar_body) = let open Evd in match b1, b2 with | Evar_empty, Evar_empty -> true | Evar_defined t1, Evar_defined t2 -> eq_constr sigma1 sigma2 t1 t2 | _ -> false let eq_evar_concl (type a1 a2) sigma1 sigma2 (e1 : a1 Evd.evar_info) (e2 : a2 Evd.evar_info) = let open Evd in match Evd.evar_body e1, Evd.evar_body e2 with | Evar_empty, Evar_empty -> eq_constr sigma1 sigma2 (Evd.evar_concl e1) (Evd.evar_concl e2) | Evar_defined _, Evar_defined _ -> true | _ -> false let eq_evar_info sigma1 sigma2 ei1 ei2 = eq_evar_concl sigma1 sigma2 ei1 ei2 && eq_named_context_val sigma1 sigma2 (Evd.evar_hyps ei1) (Evd.evar_hyps ei2) && eq_evar_body sigma1 sigma2 (Evd.evar_body ei1) (Evd.evar_body ei2) let fast_eq_evar_body (type a1 a2) (e1 : a1 Evd.evar_info) (e2 : a2 Evd.evar_info) = let open Evd in match Evd.evar_body e1, Evd.evar_body e2 with | Evar_empty, Evar_empty -> true | Evar_defined _, Evar_defined _ -> true | _ -> false let fast_eq_named_context_val ctx1 ctx2 = let r_eq _ _ = true (* ignore relevances *) in let c1 = EConstr.named_context_of_val ctx1 in let c2 = EConstr.named_context_of_val ctx2 in let eq_named_declaration d1 d2 = match d1, d2 with | LocalAssum (i1, _), LocalAssum (i2, _) -> Context.eq_annot Names.Id.equal r_eq i1 i2 | LocalDef (i1, _, _), LocalDef (i2, _, _) -> Context.eq_annot Names.Id.equal r_eq i1 i2 | _ -> false in List.for_all2eq eq_named_declaration c1 c2 let fast_eq_evar_info ei1 ei2 = fast_eq_evar_body ei1 ei2 && fast_eq_named_context_val (Evd.evar_hyps ei1) (Evd.evar_hyps ei2) (** Equality function on goals *) let goal_equal ~evd ~extended_evd evar extended_evar = let EvarInfo evi = Evd.find evd evar in let EvarInfo extended_evi = Evd.find extended_evd extended_evar in if fast_eq_evar_info evi extended_evi then eq_evar_info evd extended_evd evi extended_evi else false end let tclPROGRESS t = let open Proof in Pv.get >>= fun initial -> t >>= fun res -> Pv.get >>= fun final -> (* [*_test] test absence of progress. [quick_test] is approximate whereas [exhaustive_test] is complete. *) let quick_test = initial.solution == final.solution && initial.comb == final.comb in let test = quick_test || (CList.same_length initial.comb final.comb && Util.List.for_all2eq begin fun i f -> Progress.goal_equal ~evd:initial.solution ~extended_evd:final.solution (drop_state i) (drop_state f) end initial.comb final.comb) in if not test then tclUNIT res else let info = Exninfo.reify () in tclZERO ~info (CErrors.UserError Pp.(str "Failed to progress.")) let _ = CErrors.register_handler begin function | Logic_monad.Tac_Timeout -> Some (Pp.str "[Proofview.tclTIMEOUT] Tactic timeout!") | _ -> None end let tclTIMEOUTF n t = let open Proof in (* spiwack: as one of the monad is a continuation passing monad, it doesn't force the computation to be threaded inside the underlying (IO) monad. Hence I force it myself by asking for the evaluation of a dummy value first, lest [timeout] be called when everything has already been computed. *) let t = Proof.lift (Logic_monad.NonLogical.return ()) >> t in Proof.get >>= fun initial -> Proof.current >>= fun envvar -> Proof.lift begin let open Logic_monad.NonLogical in timeout n (Proof.repr (Proof.run t envvar initial)) >>= fun r -> match r with | None -> return (Util.Inr (Logic_monad.Tac_Timeout, Exninfo.null)) | Some (Logic_monad.Nil e) -> return (Util.Inr e) | Some (Logic_monad.Cons (r, _)) -> return (Util.Inl r) end >>= function | Util.Inl (res,s,m,i) -> Proof.set s >> Proof.put m >> Proof.update (fun _ -> i) >> return res | Util.Inr (e, info) -> tclZERO ~info e let tclTIMEOUT n t = tclTIMEOUTF (float_of_int n) t let tclTIME s t = let pr_time t1 t2 n msg = let msg = if n = 0 then str msg else str (msg ^ " after ") ++ int n ++ str (String.plural n " backtracking") in Feedback.msg_info(str "Tactic call" ++ pr_opt str s ++ str " ran for " ++ System.fmt_time_difference t1 t2 ++ str " " ++ surround msg) in let rec aux n t = let open Proof in tclUNIT () >>= fun () -> let tstart = System.get_time() in Proof.split t >>= let open Logic_monad in function | Nil (e, info) -> begin let tend = System.get_time() in pr_time tstart tend n "failure"; tclZERO ~info e end | Cons (x,k) -> let tend = System.get_time() in pr_time tstart tend n "success"; tclOR (tclUNIT x) (fun e -> aux (n+1) (k e)) in aux 0 t let tclProofInfo = let open Proof in Logical.current >>= fun P.{name; poly} -> tclUNIT (name, poly) (** {7 Unsafe primitives} *) module Unsafe = struct let (>>=) = tclBIND let tclEVARS evd = Pv.modify (fun ps -> { ps with solution = evd }) let tclNEWGOALS ?(before = false) gls = Pv.modify begin fun step -> let gls = undefined step.solution gls in let comb = if before then gls @ step.comb else step.comb @ gls in { step with comb } end let tclNEWSHELVED gls = Pv.modify begin fun step -> let gls = undefined_evars step.solution gls in { step with solution = Evd.shelve step.solution gls } end let tclGETSHELF = tclEVARMAP >>= fun sigma -> tclUNIT @@ Evd.shelf sigma let tclSETENV = Env.set let tclGETGOALS = Comb.get let tclSETGOALS = Comb.set let tclEVARSADVANCE evd = Pv.modify (fun ps -> { solution = evd; comb = undefined evd ps.comb }) let tclEVARUNIVCONTEXT ctx = Pv.modify (fun ps -> { ps with solution = Evd.set_universe_context ps.solution ctx }) let push_future_goals p = { p with solution = Evd.push_future_goals p.solution } let mark_as_goals evd content = mark_in_evm ~goal:true evd content let advance = Evarutil.advance let undefined = undefined let mark_unresolvables evm evs = mark_in_evm ~goal:false evm evs let mark_as_unresolvables p evs = { p with solution = mark_in_evm ~goal:false p.solution evs } let update_sigma_univs ugraph pv = { pv with solution = Evd.update_sigma_univs ugraph pv.solution } end module UnsafeRepr = Proof.Unsafe let (>>=) = tclBIND (** {6 Goal-dependent tactics} *) let catchable_exception = function | Logic_monad.Exception _ -> false | e -> CErrors.noncritical e module Goal = struct type t = { env : Environ.env; sigma : Evd.evar_map; concl : EConstr.constr ; state : StateStore.t; self : Evar.t ; (* for compatibility with old-style definitions *) } let state { state=state } = state let env {env} = env let sigma {sigma} = sigma let hyps {env} = EConstr.named_context env let concl {concl} = concl let gmake_with info env sigma goal state = { env = Environ.reset_with_named_context (Evd.evar_filtered_hyps info) env ; sigma = sigma ; concl = Evd.evar_concl info; state = state ; self = goal } let gmake env sigma goal = let state = get_state goal in let goal = drop_state goal in let info = Evd.find_undefined sigma goal in gmake_with info env sigma goal state let enter f = let f gl = InfoL.tag (Info.DBranch) (f gl) in InfoL.tag (Info.Dispatch) begin iter_goal begin fun goal -> Env.get >>= fun env -> tclEVARMAP >>= fun sigma -> try f (gmake env sigma goal) with e when catchable_exception e -> let (e, info) = Exninfo.capture e in tclZERO ~info e end end let enter_one ?(__LOC__=__LOC__) f = let open Proof in Comb.get >>= function | [goal] -> begin Env.get >>= fun env -> tclEVARMAP >>= fun sigma -> try f (gmake env sigma goal) with e when catchable_exception e -> let (e, info) = Exninfo.capture e in tclZERO ~info e end | _ -> CErrors.anomaly Pp.(str __LOC__ ++ str " enter_one") let goals = Pv.get >>= fun step -> let sigma = step.solution in let map goal = match cleared_alias sigma goal with | None -> None (* ppedrot: Is this check really necessary? *) | Some goal -> let oinfo = Evd.find_undefined sigma (drop_state goal) in let gl = Env.get >>= fun env -> tclEVARMAP >>= fun sigma -> let state = get_state goal in let goal = drop_state goal in let EvarInfo info = Evd.find sigma goal in let goal = { env = Environ.reset_with_named_context (Evd.evar_filtered_hyps info) env ; sigma = sigma ; concl = Evd.evar_concl oinfo; state = state; self = goal; } in tclUNIT goal in Some gl in tclUNIT (CList.map_filter map step.comb) let unsolved { self=self } = tclEVARMAP >>= fun sigma -> tclUNIT (not (Option.is_empty (Evarutil.advance sigma self))) (* compatibility *) let goal { self=self } = self end (** {6 Trace} *) module Trace = struct let record_info_trace = InfoL.record_trace let log m = InfoL.leaf (Info.Msg m) let name_tactic m t = InfoL.tag (Info.Tactic m) t let pr_info env sigma ?(lvl=0) info = assert (lvl >= 0); Info.(print env sigma (collapse lvl info)) end (** {6 Non-logical state} *) module NonLogical = Logic_monad.NonLogical let tclLIFT = Proof.lift let tclCHECKINTERRUPT = tclLIFT (NonLogical.make Control.check_for_interrupt) let wrap_exceptions f = try f () with e when catchable_exception e -> let (e, info) = Exninfo.capture e in tclZERO ~info e (** {7 Notations} *) module Notations = struct let (>>=) = tclBIND let (<*>) = tclTHEN let (<+>) t1 t2 = tclOR t1 (fun _ -> t2) end coq-8.20.0/engine/proofview.mli000066400000000000000000000603711466560755400164040ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* Evar.t list * Evd.evar_map (** {6 Starting and querying a proof view} *) (** Abstract representation of the initial goals of a proof. *) type entry (** Optimize memory consumption *) val compact : entry -> proofview -> entry * proofview (** Initialises a proofview, the main argument is a list of environments (including a [named_context] which are used as hypotheses) pair with conclusion types, creating accordingly many initial goals. Because a proof does not necessarily starts in an empty [evar_map] (indeed a proof can be triggered by an incomplete pretyping), [init] takes an additional argument to represent the initial [evar_map]. *) val init : Evd.evar_map -> (Environ.env * types) list -> entry * proofview (** A [telescope] is a list of environment and conclusion like in {!init}, except that each element may depend on the previous goals. The telescope passes the goals in the form of a [Term.constr] which represents the goal as an [evar]. The [evar_map] is threaded in state passing style. *) type telescope = | TNil of Evd.evar_map | TCons of Environ.env * Evd.evar_map * types * (Evd.evar_map -> constr -> telescope) (** Like {!init}, but goals are allowed to be dependent on one another. Dependencies between goals is represented with the type [telescope] instead of [list]. Note that the first [evar_map] of the telescope plays the role of the [evar_map] argument in [init]. *) val dependent_init : telescope -> entry * proofview (** [finished pv] is [true] if and only if [pv] is complete. That is, if it has an empty list of focused goals. There could still be unsolved subgoals, but they would then be out of focus. *) val finished : proofview -> bool (** Returns the current [evar] state. *) val return : proofview -> Evd.evar_map val partial_proof : entry -> proofview -> constr list val initial_goals : entry -> (Environ.named_context_val * constr * types) list (** goal <-> goal_with_state *) val with_empty_state : Proofview_monad.goal -> Proofview_monad.goal_with_state val drop_state : Proofview_monad.goal_with_state -> Proofview_monad.goal val goal_with_state : Proofview_monad.goal -> Proofview_monad.StateStore.t -> Proofview_monad.goal_with_state (** {6 Focusing commands} *) (** A [focus_context] represents the part of the proof view which has been removed by a focusing action, it can be used to unfocus later on. *) type focus_context (** Returns a stylised view of a focus_context for use by, for instance, ide-s. *) (* spiwack: the type of [focus_context] will change as we push more refined functions to ide-s. This would be better than spawning a new nearly identical function every time. Hence the generic name. *) (* In this version: the goals in the context, as a "zipper" (the first list is in reversed order). *) val focus_context : focus_context -> Evar.t list * Evar.t list (** [focus i j] focuses a proofview on the goals from index [i] to index [j] (inclusive, goals are indexed from [1]). I.e. goals number [i] to [j] become the only focused goals of the returned proofview. It returns the focused proofview, and a context for the focus stack. *) val focus : int -> int -> proofview -> proofview * focus_context (** Unfocuses a proofview with respect to a context. *) val unfocus : focus_context -> proofview -> proofview (** {6 The tactic monad} *) (** - Tactics are objects which apply a transformation to all the subgoals of the current view at the same time. By opposition to the old vision of applying it to a single goal. It allows tactics such as [shelve_unifiable], tactics to reorder the focused goals, or global automation tactic for dependent subgoals (instantiating an evar has influences on the other goals of the proof in progress, not being able to take that into account causes the current eauto tactic to fail on some instances where it could succeed). Another benefit is that it is possible to write tactics that can be executed even if there are no focused goals. - Tactics form a monad ['a tactic], in a sense a tactic can be seen as a function (without argument) which returns a value of type 'a and modifies the environment (in our case: the view). Tactics of course have arguments, but these are given at the meta-level as OCaml functions. Most tactics in the sense we are used to return [()], that is no really interesting values. But some might pass information around. The tactics seen in Coq's Ltac are (for now at least) only [unit tactic], the return values are kept for the OCaml toolkit. The operation or the monad are [Proofview.tclUNIT] (which is the "return" of the tactic monad) [Proofview.tclBIND] (which is the "bind") and [Proofview.tclTHEN] (which is a specialized bind on unit-returning tactics). - Tactics have support for full-backtracking. Tactics can be seen having multiple success: if after returning the first success a failure is encountered, the tactic can backtrack and use a second success if available. The state is backtracked to its previous value, except the non-logical state defined in the {!NonLogical} module below. *) (** The abstract type of tactics *) type +'a tactic (** Applies a tactic to the current proofview. Returns a tuple [a,pv,(b,sh,gu)] where [a] is the return value of the tactic, [pv] is the updated proofview, [b] a boolean which is [true] if the tactic has not done any action considered unsafe (such as admitting a lemma), [sh] is the list of goals which have been shelved by the tactic, and [gu] the list of goals on which the tactic has given up. In case of multiple success the first one is selected. If there is no success, fails with {!Logic_monad.TacticFailure}*) val apply : name:Names.Id.t -> poly:bool -> Environ.env -> 'a tactic -> proofview -> 'a * proofview * bool * Proofview_monad.Info.tree (** {7 Monadic primitives} *) (** Unit of the tactic monad. *) val tclUNIT : 'a -> 'a tactic (** Bind operation of the tactic monad. *) val tclBIND : 'a tactic -> ('a -> 'b tactic) -> 'b tactic (** Interprets the ";" (semicolon) of Ltac. As a monadic operation, it's a specialized "bind". *) val tclTHEN : unit tactic -> 'a tactic -> 'a tactic (** [tclIGNORE t] has the same operational content as [t], but drops the returned value. *) val tclIGNORE : 'a tactic -> unit tactic (** Generic monadic combinators for tactics. *) module Monad : Monad.S with type +'a t = 'a tactic (** {7 Failure and backtracking} *) (** [tclZERO e] fails with exception [e]. It has no success. Exception is supposed to be non critical *) val tclZERO : ?info:Exninfo.info -> exn -> 'a tactic (** [tclOR t1 t2] behaves like [t1] as long as [t1] succeeds. Whenever the successes of [t1] have been depleted and it failed with [e], then it behaves as [t2 e]. In other words, [tclOR] inserts a backtracking point. In [t2], exception can be assumed non critical. *) val tclOR : 'a tactic -> (Exninfo.iexn -> 'a tactic) -> 'a tactic (** [tclORELSE t1 t2] is equal to [t1] if [t1] has at least one success or [t2 e] if [t1] fails with [e]. It is analogous to [try/with] handler of exception in that it is not a backtracking point. In [t2], exception can be assumed non critical. *) val tclORELSE : 'a tactic -> (Exninfo.iexn -> 'a tactic) -> 'a tactic (** [tclIFCATCH a s f] is a generalisation of {!tclORELSE}: if [a] succeeds at least once then it behaves as [tclBIND a s] otherwise, if [a] fails with [e], then it behaves as [f e]. In [f] exception can be assumed non critical. *) val tclIFCATCH : 'a tactic -> ('a -> 'b tactic) -> (Exninfo.iexn -> 'b tactic) -> 'b tactic (** [tclONCE t] behave like [t] except it has at most one success: [tclONCE t] stops after the first success of [t]. If [t] fails with [e], [tclONCE t] also fails with [e]. *) val tclONCE : 'a tactic -> 'a tactic (** [tclEXACTLY_ONCE e t] succeeds as [t] if [t] has exactly one success. Otherwise it fails. The tactic [t] is run until its first success, then a failure with exception [e] is simulated ([e] has to be non critical). If [t] yields another success, then [tclEXACTLY_ONCE e t] fails with [MoreThanOneSuccess] (it is a user error). Otherwise, [tclEXACTLY_ONCE e t] succeeds with the first success of [t]. Notice that the choice of [e] is relevant, as the presence of further successes may depend on [e] (see {!tclOR}). *) exception MoreThanOneSuccess val tclEXACTLY_ONCE : exn -> 'a tactic -> 'a tactic (** [tclCASE t] splits [t] into its first success and a continuation. It is the most general primitive to control backtracking. *) type 'a case = | Fail of Exninfo.iexn | Next of 'a * (Exninfo.iexn -> 'a tactic) val tclCASE : 'a tactic -> 'a case tactic (** [tclBREAK p t] is a generalization of [tclONCE t]. Instead of stopping after the first success, it succeeds like [t] until a failure with an exception [e] such that [p e = Some e'] is raised. At which point it drops the remaining successes, failing with [e']. [tclONCE t] is equivalent to [tclBREAK (fun e -> Some e) t]. *) val tclBREAK : (Exninfo.iexn -> Exninfo.iexn option) -> 'a tactic -> 'a tactic (** {7 Focusing tactics} *) (** [tclFOCUS i j t] applies [t] after focusing on the goals number [i] to [j] (see {!focus}). The rest of the goals is restored after the tactic action. If the specified range doesn't correspond to existing goals, fails with the [nosuchgoal] argument, by default raising [NoSuchGoals] (a user error). This exception is caught at toplevel with a default message. *) exception NoSuchGoals of int val tclFOCUS : ?nosuchgoal:'a tactic -> int -> int -> 'a tactic -> 'a tactic (** [tclFOCUSLIST li t] applies [t] on the list of focused goals described by [li]. Each element of [li] is a pair [(i, j)] denoting the goals numbered from [i] to [j] (inclusive, starting from 1). It will try to apply [t] to all the valid goals in any of these intervals. If the set of such goals is not a single range, then it will move goals such that it is a single range. (So, for instance, [[1, 3-5]; idtac.] is not the identity.) If the set of such goals is empty, it will fail with [nosuchgoal], by default raising [NoSuchGoals 0]. *) val tclFOCUSLIST : ?nosuchgoal:'a tactic -> (int * int) list -> 'a tactic -> 'a tactic (** [tclFOCUSID x t] applies [t] on a (single) focused goal like {!tclFOCUS}. The goal is found by its name rather than its number. Fails with [nosuchgoal], by default raising [NoSuchGoals 1]. *) val tclFOCUSID : ?nosuchgoal:'a tactic -> Names.Id.t -> 'a tactic -> 'a tactic (** [tclTRYFOCUS i j t] behaves like {!tclFOCUS}, except that if the specified range doesn't correspond to existing goals, behaves like [tclUNIT ()] instead of failing. *) val tclTRYFOCUS : int -> int -> unit tactic -> unit tactic (** {7 Dispatching on goals} *) (** Dispatch tacticals are used to apply a different tactic to each goal under focus. They come in two flavours: [tclDISPATCH] takes a list of [unit tactic]-s and build a [unit tactic]. [tclDISPATCHL] takes a list of ['a tactic] and returns an ['a list tactic]. They both work by applying each of the tactic in a focus restricted to the corresponding goal (starting with the first goal). In the case of [tclDISPATCHL], the tactic returns a list of the same size as the argument list (of tactics), each element being the result of the tactic executed in the corresponding goal. When the length of the tactic list is not the number of goal, raises [SizeMismatch (g,t)] where [g] is the number of available goals, and [t] the number of tactics passed. *) exception SizeMismatch of int*int val tclDISPATCH : unit tactic list -> unit tactic val tclDISPATCHL : 'a tactic list -> 'a list tactic (** [tclEXTEND b r e] is a variant of {!tclDISPATCH}, where the [r] tactic is "repeated" enough time such that every goal has a tactic assigned to it ([b] is the list of tactics applied to the first goals, [e] to the last goals, and [r] is applied to every goal in between). *) val tclEXTEND : unit tactic list -> unit tactic -> unit tactic list -> unit tactic (** [tclINDEPENDENT tac] runs [tac] on each goal successively, from the first one to the last one. Backtracking in one goal is independent of backtracking in another. It is equivalent to [tclEXTEND [] tac []]. *) val tclINDEPENDENT : unit tactic -> unit tactic val tclINDEPENDENTL: 'a tactic -> 'a list tactic (** {7 Goal manipulation} *) (** Shelves all the goals under focus. The goals are placed on the shelf for later use (or being solved by side-effects). *) val shelve : unit tactic (** Shelves the given list of goals, which might include some that are under focus and some that aren't. All the goals are placed on the shelf for later use (or being solved by side-effects). *) val shelve_goals : Evar.t list -> unit tactic (** [unifiable sigma g l] checks whether [g] appears in another subgoal of [l]. The list [l] may contain [g], but it does not affect the result. Used by [shelve_unifiable]. *) val unifiable : Evd.evar_map -> Evar.t -> Evar.t list -> bool (** Shelves the unifiable goals under focus, i.e. the goals which appear in other goals under focus (the unfocused goals are not considered). *) val shelve_unifiable : unit tactic (** [guard_no_unifiable] returns the list of unifiable goals if some goals are unifiable (see {!shelve_unifiable}) in the current focus. *) val guard_no_unifiable : Names.Name.t list option tactic (** [unshelve l p] moves all the goals in [l] from the shelf and put them at the end of the focused goals of p, if they are still undefined after [advance] *) val unshelve : Evar.t list -> proofview -> proofview val filter_shelf : (Evar.t -> bool) -> proofview -> proofview (** [depends_on g1 g2 sigma] checks if g1 occurs in the type/ctx of g2 *) val depends_on : Evd.evar_map -> Evar.t -> Evar.t -> bool (** [with_shelf tac] executes [tac] and returns its result together with the set of goals shelved by [tac]. The current shelf is unchanged and the returned list contains only unsolved goals. *) val with_shelf : 'a tactic -> (Evar.t list * 'a) tactic (** If [n] is positive, [cycle n] puts the [n] first goal last. If [n] is negative, then it puts the [n] last goals first.*) val cycle : int -> unit tactic (** [swap i j] swaps the position of goals number [i] and [j] (negative numbers can be used to address goals from the end. Goals are indexed from [1]. For simplicity index [0] corresponds to goal [1] as well, rather than raising an error. *) val swap : int -> int -> unit tactic (** [revgoals] reverses the list of focused goals. *) val revgoals : unit tactic (** [numgoals] returns the number of goals under focus. *) val numgoals : int tactic (** {7 Access primitives} *) (** [tclEVARMAP] doesn't affect the proof, it returns the current [evar_map]. *) val tclEVARMAP : Evd.evar_map tactic (** [tclENV] doesn't affect the proof, it returns the current environment. It is not the environment of a particular goal, rather the "global" environment of the proof. The goal-wise environment is obtained via {!Proofview.Goal.env}. *) val tclENV : Environ.env tactic (** {7 Put-like primitives} *) (** [tclEFFECTS eff] add the effects [eff] to the current state. *) val tclEFFECTS : Evd.side_effects -> unit tactic (** [mark_as_unsafe] declares the current tactic is unsafe. *) val mark_as_unsafe : unit tactic (** Gives up on the goal under focus. Reports an unsafe status. Proofs with given up goals cannot be closed. *) val give_up : unit tactic (** {7 Control primitives} *) (** [tclPROGRESS t] checks the state of the proof after [t]. It it is identical to the state before, then [tclPROGRESS t] fails, otherwise it succeeds like [t]. *) val tclPROGRESS : 'a tactic -> 'a tactic module Progress : sig (** [goal_equal ~evd ~extended_evd evar extended_evar] tests whether the [evar_info] from [evd] corresponding to [evar] is equal to that from [extended_evd] corresponding to [extended_evar], up to existential variable instantiation and equalisable universes. The universe constraints in [extended_evd] are assumed to be an extension of the universe constraints in [evd]. *) val goal_equal : evd:Evd.evar_map -> extended_evd:Evd.evar_map -> Evar.t -> Evar.t -> bool end (** Checks for interrupts *) val tclCHECKINTERRUPT : unit tactic (** [tclTIMEOUT n t] can have only one success. In case of timeout it fails with [tclZERO Tac_Timeout]. *) val tclTIMEOUTF : float -> 'a tactic -> 'a tactic val tclTIMEOUT : int -> 'a tactic -> 'a tactic (** [tclTIME s t] displays time for each atomic call to t, using s as an identifying annotation if present *) val tclTIME : string option -> 'a tactic -> 'a tactic (** Internal, don't use. *) val tclProofInfo : (Names.Id.t * bool) tactic [@@ocaml.deprecated "internal, don't use"] (** {7 Unsafe primitives} *) (** The primitives in the [Unsafe] module should be avoided as much as possible, since they can make the proof state inconsistent. They are nevertheless helpful, in particular when interfacing the pretyping and the proof engine. *) module Unsafe : sig (** [tclEVARS sigma] replaces the current [evar_map] by [sigma]. If [sigma] has new unresolved [evar]-s they will not appear as goal. If goals have been solved in [sigma] they will still appear as unsolved goals. *) val tclEVARS : Evd.evar_map -> unit tactic (** Like {!tclEVARS} but also checks whether goals have been solved. *) val tclEVARSADVANCE : Evd.evar_map -> unit tactic (** Set the global environment of the tactic *) val tclSETENV : Environ.env -> unit tactic (** [tclNEWGOALS ~before gls] adds the goals [gls] to the ones currently being proved. If [before] is true, it prepends them to the list of focused goals, otherwise it appends them (default). If a goal is already solved, it is not added. *) val tclNEWGOALS : ?before:bool -> Proofview_monad.goal_with_state list -> unit tactic (** [tclNEWSHELVED gls] adds the goals [gls] to the shelf. If a goal is already solved, it is not added. *) val tclNEWSHELVED : Evar.t list -> unit tactic (** [tclSETGOALS gls] sets goals [gls] as the goals being under focus. If a goal is already solved, it is not set. *) val tclSETGOALS : Proofview_monad.goal_with_state list -> unit tactic (** [tclGETGOALS] returns the list of goals under focus. *) val tclGETGOALS : Proofview_monad.goal_with_state list tactic (** [tclGETSHELF] returns the list of goals on the shelf. *) val tclGETSHELF : Evar.t list tactic (** Sets the evar universe context. *) val tclEVARUNIVCONTEXT : UState.t -> unit tactic (** Clears the future goals store in the proof view. *) val push_future_goals : proofview -> proofview (** Give the evars the status of a goal (changes their source location and makes them unresolvable for type classes. *) val mark_as_goals : Evd.evar_map -> Evar.t list -> Evd.evar_map (** Make some evars unresolvable for type classes. We need two functions as some functions use the proofview and others directly manipulate the undelying evar_map. *) val mark_unresolvables : Evd.evar_map -> Evar.t list -> Evd.evar_map val mark_as_unresolvables : proofview -> Evar.t list -> proofview (** [advance sigma g] returns [Some g'] if [g'] is undefined and is the current avatar of [g] (for instance [g] was changed by [clear] into [g']). It returns [None] if [g] has been (partially) solved. *) val advance : Evd.evar_map -> Evar.t -> Evar.t option (** [undefined sigma l] applies [advance] to the goals of [l], then returns the subset of resulting goals which have not yet been defined *) val undefined : Evd.evar_map -> Proofview_monad.goal_with_state list -> Proofview_monad.goal_with_state list (** [update_sigma_univs] lifts [UState.update_sigma_univs] to the proofview *) val update_sigma_univs : UGraph.t -> proofview -> proofview end (** This module gives access to the innards of the monad. Its use is restricted to very specific cases. *) module UnsafeRepr : sig type state = Proofview_monad.Logical.Unsafe.state val repr : 'a tactic -> ('a, state, state, Exninfo.iexn) Logic_monad.BackState.t val make : ('a, state, state, Exninfo.iexn) Logic_monad.BackState.t -> 'a tactic end (** {6 Goal-dependent tactics} *) module Goal : sig (** Type of goals. *) type t (** [concl], [hyps], [env] and [sigma] given a goal [gl] return respectively the conclusion of [gl], the hypotheses of [gl], the environment of [gl] (i.e. the global environment and the hypotheses) and the current evar map. *) val concl : t -> constr val hyps : t -> named_context val env : t -> Environ.env val sigma : t -> Evd.evar_map val state : t -> Proofview_monad.StateStore.t (** [enter t] applies the goal-dependent tactic [t] in each goal independently, in the manner of {!tclINDEPENDENT} except that the current goal is also given as an argument to [t]. *) val enter : (t -> unit tactic) -> unit tactic (** Like {!enter}, but assumes exactly one goal under focus, raising a fatal error otherwise. *) val enter_one : ?__LOC__:string -> (t -> 'a tactic) -> 'a tactic (** Recover the list of current goals under focus, without evar-normalization. FIXME: encapsulate the level in an existential type. *) val goals : t tactic list tactic (** [unsolved g] is [true] if [g] is still unsolved in the current proof state. *) val unsolved : t -> bool tactic (** Compatibility: avoid if possible *) val goal : t -> Evar.t end (** {6 Trace} *) module Trace : sig (** [record_info_trace t] behaves like [t] except the [info] trace is stored. *) val record_info_trace : 'a tactic -> 'a tactic val log : Proofview_monad.lazy_msg -> unit tactic val name_tactic : Proofview_monad.lazy_msg -> 'a tactic -> 'a tactic val pr_info : Environ.env -> Evd.evar_map -> ?lvl:int -> Proofview_monad.Info.tree -> Pp.t end (** {6 Non-logical state} *) (** The [NonLogical] module allows the execution of effects (including I/O) in tactics (non-logical side-effects are not discarded at failures). *) module NonLogical : module type of Logic_monad.NonLogical (** [tclLIFT c] is a tactic which behaves exactly as [c]. *) val tclLIFT : 'a NonLogical.t -> 'a tactic (* transforms every Ocaml (catchable) exception into a failure in the monad. *) val wrap_exceptions : (unit -> 'a tactic) -> 'a tactic (** {7 Notations} *) module Notations : sig (** {!tclBIND} *) val (>>=) : 'a tactic -> ('a -> 'b tactic) -> 'b tactic (** {!tclTHEN} *) val (<*>) : unit tactic -> 'a tactic -> 'a tactic (** {!tclOR}: [t1+t2] = [tclOR t1 (fun _ -> t2)]. *) val (<+>) : 'a tactic -> 'a tactic -> 'a tactic end coq-8.20.0/engine/proofview_monad.ml000066400000000000000000000206131466560755400174040ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* { head = a::head ; opened=[] } | a::Seq(b,f)::opened -> { head ; opened=Seq(b,a::f)::opened } | [] -> assert false let leaf a s = close (opn a s) (** Returning a forest. It is the responsibility of the library builder to close all the tags. *) (* spiwack: I may want to close the tags instead, to deal with interruptions. *) let rec mirror f = List.rev_map mirror_tree f and mirror_tree (Seq(a,f)) = Seq(a,mirror f) let to_tree = function | { head ; opened=[] } -> mirror head | { head ; opened=_::_} -> assert false end (** {6 State types} *) (** We typically label nodes of [Trace.tree] with messages to print. But we don't want to compute the result. *) type lazy_msg = unit -> Pp.t (** Info trace. *) module Info = struct (** The type of the tags for [info]. *) type tag = | Msg of lazy_msg (** A simple message *) | Tactic of lazy_msg (** A tactic call *) | Dispatch (** A call to [tclDISPATCH]/[tclEXTEND] *) | DBranch (** A special marker to delimit individual branch of a dispatch. *) type state = tag Trace.incr type tree = tag Trace.forest let pr_in_comments m = Pp.(str"(* "++ m () ++str" *)") let unbranch = function | Trace.Seq (DBranch,brs) -> brs | _ -> assert false let is_empty_branch = let open Trace in function | Seq(DBranch,[]) -> true | _ -> false (** Dispatch with empty branches are (supposed to be) equivalent to [idtac] which need not appear, so they are removed from the trace. *) let dispatch brs = let open Trace in if CList.for_all is_empty_branch brs then None else Some (Seq(Dispatch,brs)) let constr = let open Trace in function | Dispatch -> dispatch | t -> fun br -> Some (Seq(t,br)) let rec compress_tree = let open Trace in function | Seq(t,f) -> constr t (compress f) and compress f = CList.map_filter compress_tree f (** [with_sep] is [true] when [Tactic m] must be printed with a trailing semi-colon. *) let rec pr_tree with_sep = let open Trace in function | Seq (Msg m,[]) -> pr_in_comments m | Seq (Tactic m,_) -> let tail = if with_sep then Pp.str";" else Pp.mt () in Pp.(m () ++ tail) | Seq (Dispatch,brs) -> let tail = if with_sep then Pp.str";" else Pp.mt () in Pp.(pr_dispatch brs++tail) | Seq (Msg _,_::_) | Seq (DBranch,_) -> assert false and pr_dispatch brs = let open Pp in let brs = List.map unbranch brs in match brs with | [br] -> pr_forest br | _ -> let sep () = spc()++str"|"++spc() in let branches = prlist_with_sep sep pr_forest brs in str"[>"++spc()++branches++spc()++str"]" and pr_forest = function | [] -> Pp.mt () | [tr] -> pr_tree false tr | tr::l -> Pp.(pr_tree true tr ++ pr_forest l) let print _env _sigma f = pr_forest (compress f) let rec collapse_tree n t = let open Trace in match n , t with | 0 , t -> [t] | _ , (Seq(Tactic _,[]) as t) -> [t] | n , Seq(Tactic _,f) -> collapse (pred n) f | n , Seq(Dispatch,brs) -> [Seq(Dispatch, (collapse n brs))] | n , Seq(DBranch,br) -> [Seq(DBranch, (collapse n br))] | _ , (Seq(Msg _,_) as t) -> [t] and collapse n f = CList.map_append (collapse_tree n) f end module StateStore = Store.Make() (* let (set_state, get_state) = StateDyn.Easy.make_dyn "goal_state" *) type goal = Evar.t type goal_with_state = Evar.t * StateStore.t let drop_state = fst let get_state = snd let goal_with_state g s = (g, s) let with_empty_state g = (g, StateStore.empty) let map_goal_with_state f (g, s) = (f g, s) (** Type of proof views: current [evar_map] together with the list of focused goals. *) type proofview = { solution : Evd.evar_map; comb : goal_with_state list; } (** {6 Instantiation of the logic monad} *) (** Parameters of the logic monads *) module P = struct type s = proofview * Environ.env (** Recording info trace (true) or not. *) type e = { trace: bool; name : Names.Id.t; poly : bool } (** Status (safe/unsafe) * shelved goals * given up *) type w = bool let wunit = true let wprod b1 b2 = b1 && b2 type u = Info.state let uunit = Trace.empty_incr end module Logical = Logic_monad.Logical(P) (** {6 Lenses to access to components of the states} *) module type State = sig type t val get : t Logical.t val set : t -> unit Logical.t val modify : (t->t) -> unit Logical.t end module type Reader = sig type t val get : t Logical.t end module type Writer = sig type t val put : t -> unit Logical.t end module Pv : State with type t := proofview = struct let get = Logical.(map fst get) let set p = Logical.modify (fun (_,e) -> (p,e)) let modify f= Logical.modify (fun (p,e) -> (f p,e)) end module Solution : State with type t := Evd.evar_map = struct let get = Logical.map (fun {solution} -> solution) Pv.get let set s = Pv.modify (fun pv -> { pv with solution = s }) let modify f = Pv.modify (fun pv -> { pv with solution = f pv.solution }) end module Comb : State with type t = goal_with_state list = struct (* spiwack: I don't know why I cannot substitute ([:=]) [t] with a type expression. *) type t = goal_with_state list let get = Logical.map (fun {comb} -> comb) Pv.get let set c = Pv.modify (fun pv -> { pv with comb = c }) let modify f = Pv.modify (fun pv -> { pv with comb = f pv.comb }) end module Env : State with type t := Environ.env = struct let get = Logical.(map snd get) let set e = Logical.modify (fun (p,_) -> (p,e)) let modify f = Logical.modify (fun (p,e) -> (p,f e)) end module Status : Writer with type t := bool = struct let put s = Logical.put s end (** Lens and utilities pertaining to the info trace *) module InfoL = struct let recording = Logical.(map (fun {P.trace} -> trace) current) let if_recording t = let open Logical in recording >>= fun r -> if r then t else return () let record_trace t = Logical.( current >>= fun s -> local {s with P.trace = true} t) let raw_update = Logical.update let update f = if_recording (raw_update f) let opn a = update (Trace.opn a) let close = update Trace.close let leaf a = update (Trace.leaf a) let tag a t = let open Logical in recording >>= fun r -> if r then begin raw_update (Trace.opn a) >> t >>= fun a -> raw_update Trace.close >> return a end else t end coq-8.20.0/engine/proofview_monad.mli000066400000000000000000000114521466560755400175560ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* 'a forest (** [open a] opens a tag with name [a]. *) val opn : 'a -> 'a incr -> 'a incr (** [close] closes the last open tag. It is the responsibility of the user to close all the tags. *) val close : 'a incr -> 'a incr (** [leaf] creates an empty tag with name [a]. *) val leaf : 'a -> 'a incr -> 'a incr end (** {6 State types} *) (** We typically label nodes of [Trace.tree] with messages to print. But we don't want to compute the result. *) type lazy_msg = unit -> Pp.t (** Info trace. *) module Info : sig (** The type of the tags for [info]. *) type tag = | Msg of lazy_msg (** A simple message *) | Tactic of lazy_msg (** A tactic call *) | Dispatch (** A call to [tclDISPATCH]/[tclEXTEND] *) | DBranch (** A special marker to delimit individual branch of a dispatch. *) type state = tag Trace.incr type tree = tag Trace.forest val print : Environ.env -> Evd.evar_map -> tree -> Pp.t (** [collapse n t] flattens the first [n] levels of [Tactic] in an info trace, effectively forgetting about the [n] top level of names (if there are fewer, the last name is kept). *) val collapse : int -> tree -> tree end module StateStore : Store.S type goal = Evar.t type goal_with_state val drop_state : goal_with_state -> goal val get_state : goal_with_state -> StateStore.t val goal_with_state : goal -> StateStore.t -> goal_with_state val with_empty_state : goal -> goal_with_state val map_goal_with_state : (goal -> goal) -> goal_with_state -> goal_with_state (** Type of proof views: current [evar_map] together with the list of focused goals, locally shelved goals and globally shelved goals. *) type proofview = { solution : Evd.evar_map; comb : goal_with_state list; } (** {6 Instantiation of the logic monad} *) module P : sig type s = proofview * Environ.env (** Status (safe/unsafe) * given up *) type w = bool val wunit : w val wprod : w -> w -> w (** Recording info trace (true) or not. *) type e = { trace: bool; name : Names.Id.t; poly : bool } type u = Info.state val uunit : u end module Logical : module type of Logic_monad.Logical(P) (** {6 Lenses to access to components of the states} *) module type State = sig type t val get : t Logical.t val set : t -> unit Logical.t val modify : (t->t) -> unit Logical.t end module type Reader = sig type t val get : t Logical.t end module type Writer = sig type t val put : t -> unit Logical.t end (** Lens to the [proofview]. *) module Pv : State with type t := proofview (** Lens to the [evar_map] of the proofview. *) module Solution : State with type t := Evd.evar_map (** Lens to the list of focused goals. *) module Comb : State with type t = goal_with_state list (** Lens to the global environment. *) module Env : State with type t := Environ.env (** Lens to the tactic status ([true] if safe, [false] if unsafe) *) module Status : Writer with type t := bool (** Lens and utilities pertaining to the info trace *) module InfoL : sig (** [record_trace t] behaves like [t] and compute its [info] trace. *) val record_trace : 'a Logical.t -> 'a Logical.t val update : (Info.state -> Info.state) -> unit Logical.t val opn : Info.tag -> unit Logical.t val close : unit Logical.t val leaf : Info.tag -> unit Logical.t (** [tag a t] opens tag [a] runs [t] then closes the tag. *) val tag : Info.tag -> 'a Logical.t -> 'a Logical.t end coq-8.20.0/engine/termops.ml000066400000000000000000001375751466560755400157170ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* mt () | LocalDef (_,c,_) -> (* Force evaluation *) let c = EConstr.of_constr c in let pb = print_constr_env env sigma c in (str" := " ++ pb ++ cut () ) in let pt = print_constr_env env sigma (EConstr.of_constr (get_type decl)) in let ptyp = (str" : " ++ pt) in (Id.print (get_id decl) ++ hov 0 (pbody ++ ptyp)) let pr_rel_decl env sigma decl = let open RelDecl in let pbody = match decl with | LocalAssum _ -> mt () | LocalDef (_,c,_) -> (* Force evaluation *) let c = EConstr.of_constr c in let pb = print_constr_env env sigma c in (str":=" ++ spc () ++ pb ++ spc ()) in let ptyp = print_constr_env env sigma (EConstr.of_constr (get_type decl)) in match get_name decl with | Anonymous -> hov 0 (str"<>" ++ spc () ++ pbody ++ str":" ++ spc () ++ ptyp) | Name id -> hov 0 (Id.print id ++ spc () ++ pbody ++ str":" ++ spc () ++ ptyp) let print_named_context env sigma = hv 0 (fold_named_context (fun env d pps -> pps ++ ws 2 ++ pr_var_decl env sigma d) env ~init:(mt ())) let print_rel_context env sigma = hv 0 (fold_rel_context (fun env d pps -> pps ++ ws 2 ++ pr_rel_decl env sigma d) env ~init:(mt ())) let print_env env sigma = let sign_env = fold_named_context (fun env d pps -> let pidt = pr_var_decl env sigma d in (pps ++ fnl () ++ pidt)) env ~init:(mt ()) in let db_env = fold_rel_context (fun env d pps -> let pnat = pr_rel_decl env sigma d in (pps ++ fnl () ++ pnat)) env ~init:(mt ()) in (sign_env ++ db_env) let protect f x = try f x with e -> str "EXCEPTION: " ++ str (Printexc.to_string e) let print_kconstr env sigma a = protect (fun c -> print_constr_env env sigma c) a end let vars_of_env env = let s = Environ.ids_of_named_context_val (Environ.named_context_val env) in Context.Rel.fold_outside (fun decl s -> match RelDecl.get_name decl with Name id -> Id.Set.add id s | _ -> s) (rel_context env) ~init:s let pr_global_env env g = Nametab.pr_global_env (vars_of_env env) g let evar_suggested_name env sigma evk = let open Evd in let base_id evk' evi = match evar_ident evk' sigma with | Some id -> id | None -> match Evd.evar_source evi with | _,Evar_kinds.ImplicitArg (c,(n,Some id),b) -> id | _,Evar_kinds.VarInstance id -> id | _,Evar_kinds.QuestionMark {Evar_kinds.qm_name = Name id} -> id | _,Evar_kinds.GoalEvar -> Id.of_string "Goal" | _ -> let env = reset_with_named_context (Evd.evar_hyps evi) env in Namegen.id_of_name_using_hdchar env sigma (Evd.evar_concl evi) Anonymous in let names = Evar.Map.mapi base_id (undefined_map sigma) in let id = Evar.Map.find evk names in let fold evk' id' (seen, n) = if seen then (seen, n) else if Evar.equal evk evk' then (true, n) else if Id.equal id id' then (seen, succ n) else (seen, n) in let (_, n) = Evar.Map.fold fold names (false, 0) in if n = 0 then id else Nameops.add_suffix id (string_of_int (pred n)) let pr_existential_key env sigma evk = let open Evd in match evar_ident evk sigma with | None -> str "?" ++ Id.print (evar_suggested_name env sigma evk) | Some id -> str "?" ++ Id.print id let pr_instance_status (sc,typ) = let open Evd in begin match sc with | IsSubType -> str " [or a subtype of it]" | IsSuperType -> str " [or a supertype of it]" | Conv -> mt () end ++ begin match typ with | CoerceToType -> str " [up to coercion]" | TypeNotProcessed -> mt () | TypeProcessed -> str " [type is checked]" end let pr_meta_map env sigma = let open Evd in let print_constr = Internal.print_kconstr in let pr_name = function Name id -> str"[" ++ Id.print id ++ str"]" | _ -> mt() in let pr_meta_binding = function | (mv,Cltyp (na,b)) -> hov 0 (pr_meta mv ++ pr_name na ++ str " : " ++ print_constr env sigma b.rebus ++ fnl ()) | (mv,Clval(na,(b,s),t)) -> hov 0 (pr_meta mv ++ pr_name na ++ str " := " ++ print_constr env sigma b.rebus ++ str " : " ++ print_constr env sigma t.rebus ++ spc () ++ pr_instance_status s ++ fnl ()) in prlist pr_meta_binding (Evd.Metamap.bindings (meta_list sigma)) let pr_decl env sigma (decl,ok) = let open NamedDecl in let print_constr = Internal.print_kconstr in match decl with | LocalAssum ({binder_name=id},_) -> if ok then Id.print id else (str "{" ++ Id.print id ++ str "}") | LocalDef ({binder_name=id},c,_) -> str (if ok then "(" else "{") ++ Id.print id ++ str ":=" ++ print_constr env sigma c ++ str (if ok then ")" else "}") let pr_evar_source env sigma = function | Evar_kinds.NamedHole id -> Id.print id | Evar_kinds.QuestionMark _ -> str "underscore" | Evar_kinds.CasesType false -> str "pattern-matching return predicate" | Evar_kinds.CasesType true -> str "subterm of pattern-matching return predicate" | Evar_kinds.BinderType (Name id) -> str "type of " ++ Id.print id | Evar_kinds.BinderType Anonymous -> str "type of anonymous binder" | Evar_kinds.EvarType (ido,evk) -> let pp = match ido with | Some id -> str "?" ++ Id.print id | None -> try pr_existential_key env sigma evk with (* defined *) Not_found -> str "an internal placeholder" in str "type of " ++ pp | Evar_kinds.ImplicitArg (c,(n,ido),b) -> let id = Option.get ido in str "parameter " ++ Id.print id ++ spc () ++ str "of" ++ spc () ++ pr_global_env env c | Evar_kinds.InternalHole -> str "internal placeholder" | Evar_kinds.TomatchTypeParameter (ind,n) -> pr_nth n ++ str " argument of type " ++ pr_global_env env (IndRef ind) | Evar_kinds.GoalEvar -> str "goal evar" | Evar_kinds.ImpossibleCase -> str "type of impossible pattern-matching clause" | Evar_kinds.MatchingVar _ -> str "matching variable" | Evar_kinds.VarInstance id -> str "instance of " ++ Id.print id | Evar_kinds.SubEvar (where,evk) -> (match where with | None -> str "subterm of " | Some Evar_kinds.Body -> str "body of " | Some Evar_kinds.Domain -> str "domain of " | Some Evar_kinds.Codomain -> str "codomain of ") ++ Evar.print evk let pr_evar_info (type a) env sigma (evi : a Evd.evar_info) = let open Evd in let print_constr = Internal.print_kconstr in let phyps = try let decls = match Filter.repr (evar_filter evi) with | None -> List.map (fun c -> (c, true)) (evar_context evi) | Some filter -> List.combine (evar_context evi) filter in prlist_with_sep spc (pr_decl env sigma) (List.rev decls) with Invalid_argument _ -> str "Ill-formed filtered context" in let pb = match Evd.evar_body evi with | Evar_empty -> print_constr env sigma (Evd.evar_concl evi) | Evar_defined c -> str"=> " ++ print_constr env sigma c in let candidates = match Evd.evar_body evi with | Evar_empty -> begin match evar_candidates evi with | None -> mt () | Some l -> spc () ++ str "{" ++ prlist_with_sep (fun () -> str "|") (print_constr env sigma) l ++ str "}" end | _ -> mt () in let src = str "(" ++ pr_evar_source env sigma (snd (Evd.evar_source evi)) ++ str ")" in hov 2 (str"[" ++ phyps ++ spc () ++ str"|-" ++ spc() ++ pb ++ str"]" ++ candidates ++ spc() ++ src) let compute_evar_dependency_graph sigma = let open Evd in (* Compute the map binding ev to the evars whose body depends on ev *) let fold evk (EvarInfo evi) acc = let fold_ev evk' acc = let tab = try Evar.Map.find evk' acc with Not_found -> Evar.Set.empty in Evar.Map.add evk' (Evar.Set.add evk tab) acc in match evar_body evi with | Evar_empty -> acc | Evar_defined c -> Evar.Set.fold fold_ev (evars_of_term sigma c) acc in Evd.fold fold sigma Evar.Map.empty let evar_dependency_closure n sigma = let open Evd in (* Create the DAG of depth [n] representing the recursive dependencies of undefined evars. *) let graph = compute_evar_dependency_graph sigma in let rec aux n curr accu = if Int.equal n 0 then Evar.Set.union curr accu else let fold evk accu = try let deps = Evar.Map.find evk graph in Evar.Set.union deps accu with Not_found -> accu in (* Consider only the newly added evars *) let ncurr = Evar.Set.fold fold curr Evar.Set.empty in (* Merge the others *) let accu = Evar.Set.union curr accu in aux (n - 1) ncurr accu in let undef = Evar.Map.domain (undefined_map sigma) in aux n undef Evar.Set.empty let evar_dependency_closure n sigma = let open Evd in let deps = evar_dependency_closure n sigma in let map = Evar.Map.bind (fun ev -> find sigma ev) deps in Evar.Map.bindings map let has_no_evar sigma = try let () = Evd.fold (fun _ _ () -> raise_notrace Exit) sigma () in true with Exit -> false let pr_evd_level sigma = UState.pr_uctx_level (Evd.evar_universe_context sigma) let pr_evd_qvar sigma = UState.pr_uctx_qvar (Evd.evar_universe_context sigma) let reference_of_level sigma l = UState.qualid_of_level (Evd.evar_universe_context sigma) l let pr_evar_universe_context ctx = let open UState in let prl = pr_uctx_level ctx in if UState.is_empty ctx then mt () else v 0 (str"UNIVERSES:"++brk(0,1)++ h (Univ.pr_universe_context_set prl (UState.context_set ctx)) ++ fnl () ++ UnivFlex.pr prl (UState.subst ctx) ++ fnl() ++ str"SORTS:"++brk(0,1)++ h (UState.pr_sort_opt_subst ctx) ++ fnl() ++ str "WEAK CONSTRAINTS:"++brk(0,1)++ h (UState.pr_weak prl ctx) ++ fnl ()) let print_env_short env sigma = let print_constr = Internal.print_kconstr in let pr_rel_decl = function | RelDecl.LocalAssum (n,_) -> Name.print n.binder_name | RelDecl.LocalDef (n,b,_) -> str "(" ++ Name.print n.binder_name ++ str " := " ++ print_constr env sigma (EConstr.of_constr b) ++ str ")" in let pr_named_decl = NamedDecl.to_rel_decl %> pr_rel_decl in let nc = List.rev (named_context env) in let rc = List.rev (rel_context env) in str "[" ++ pr_sequence pr_named_decl nc ++ str "]" ++ spc () ++ str "[" ++ pr_sequence pr_rel_decl rc ++ str "]" let pr_evar_constraints sigma pbs = let pr_evconstr (pbty, env, t1, t2) = let env = (* We currently allow evar instances to refer to anonymous de Bruijn indices, so we protect the error printing code in this case by giving names to every de Bruijn variable in the rel_context of the conversion problem. MS: we should rather stop depending on anonymous variables, they can be used to indicate independency. Also, this depends on a strategy for naming/renaming. *) Namegen.make_all_name_different env sigma in hov 2 (hov 2 (print_env_short env sigma) ++ spc () ++ str "|-" ++ spc () ++ Internal.print_kconstr env sigma t1 ++ spc () ++ str (match pbty with | Conversion.CONV -> "==" | Conversion.CUMUL -> "<=") ++ spc () ++ Internal.print_kconstr env sigma t2) in prlist_with_sep fnl pr_evconstr pbs let pr_evar_map_gen with_univs pr_evars env sigma = let uvs = Evd.evar_universe_context sigma in let (_, conv_pbs) = Evd.extract_all_conv_pbs sigma in let evs = if has_no_evar sigma then mt () else pr_evars sigma ++ fnl () and svs = if with_univs then pr_evar_universe_context uvs else mt () and cstrs = if List.is_empty conv_pbs then mt () else str "CONSTRAINTS:" ++ brk (0, 1) ++ pr_evar_constraints sigma conv_pbs ++ fnl () and typeclasses = let evars = Evd.get_typeclass_evars sigma in if Evar.Set.is_empty evars then mt () else str "TYPECLASSES:" ++ brk (0, 1) ++ prlist_with_sep spc Evar.print (Evar.Set.elements evars) ++ fnl () and obligations = let evars = Evd.get_obligation_evars sigma in if Evar.Set.is_empty evars then mt () else str "OBLIGATIONS:" ++ brk (0, 1) ++ prlist_with_sep spc Evar.print (Evar.Set.elements evars) ++ fnl () and metas = if Evd.Metamap.is_empty (Evd.meta_list sigma) then mt () else str "METAS:" ++ brk (0, 1) ++ pr_meta_map env sigma and shelf = str "SHELF:" ++ brk (0, 1) ++ Evd.pr_shelf sigma ++ fnl () and future_goals = str "FUTURE GOALS STACK:" ++ brk (0, 1) ++ Evd.pr_future_goals_stack sigma ++ fnl () in evs ++ svs ++ cstrs ++ typeclasses ++ obligations ++ metas ++ shelf ++ future_goals let pr_evar_list env sigma l = let open Evd in let pr_alias ev = match is_aliased_evar sigma ev with | None -> mt () | Some ev' -> str " (aliased to " ++ Evar.print ev' ++ str ")" in let pr (ev, EvarInfo evi) = h (Evar.print ev ++ str "==" ++ pr_evar_info env sigma evi ++ pr_alias ev ++ begin match Evd.evar_body evi with | Evar_empty -> str " {" ++ pr_existential_key env sigma ev ++ str "}" | Evar_defined _ -> mt () end) in hv 0 (prlist_with_sep fnl pr l) let to_list d = let open Evd in (* Workaround for change in Map.fold behavior in ocaml 3.08.4 *) let l = ref [] in let fold_def evk (EvarInfo evi) () = match Evd.evar_body evi with | Evar_defined _ -> l := (evk, EvarInfo evi) :: !l | Evar_empty -> () in let fold_undef evk (EvarInfo evi) () = match Evd.evar_body evi with | Evar_empty -> l := (evk, EvarInfo evi) :: !l | Evar_defined _ -> () in Evd.fold fold_def d (); Evd.fold fold_undef d (); !l let pr_evar_by_depth depth env sigma = match depth with | None -> (* Print all evars *) str"EVARS:" ++ brk(0,1) ++ pr_evar_list env sigma (to_list sigma) ++ fnl() | Some n -> (* Print closure of undefined evars *) str"UNDEFINED EVARS:"++ (if Int.equal n 0 then mt() else str" (+level "++int n++str" closure):")++ brk(0,1)++ pr_evar_list env sigma (evar_dependency_closure n sigma) ++ fnl() let pr_evar_by_filter filter env sigma = let open Evd in let elts = Evd.fold (fun evk evi accu -> (evk, evi) :: accu) sigma [] in let elts = List.rev elts in let is_def (_, EvarInfo evi) = match Evd.evar_body evi with | Evar_defined _ -> true | Evar_empty -> false in let (defined, undefined) = List.partition is_def elts in let filter (evk, evi) = filter evk evi in let defined = List.filter filter defined in let undefined = List.filter filter undefined in let prdef = if List.is_empty defined then mt () else str "DEFINED EVARS:" ++ brk (0, 1) ++ pr_evar_list env sigma defined in let prundef = if List.is_empty undefined then mt () else str "UNDEFINED EVARS:" ++ brk (0, 1) ++ pr_evar_list env sigma undefined in prdef ++ prundef let pr_evar_map ?(with_univs=true) depth env sigma = pr_evar_map_gen with_univs (fun sigma -> pr_evar_by_depth depth env sigma) env sigma let pr_evar_map_filter ?(with_univs=true) filter env sigma = pr_evar_map_gen with_univs (fun sigma -> pr_evar_by_filter filter env sigma) env sigma let pr_metaset metas = str "[" ++ pr_sequence pr_meta (Evd.Metaset.elements metas) ++ str "]" (* [Rel (n+m);...;Rel(n+1)] *) let rel_vect n m = Array.init m (fun i -> mkRel(n+m-i)) let rel_list n m = let open EConstr in let rec reln l p = if p>m then l else reln (mkRel(n+p)::l) (p+1) in reln [] 1 let push_rel_assum (x,t) env = let open RelDecl in let open EConstr in push_rel (LocalAssum (x,t)) env let push_rels_assum assums = let open RelDecl in push_rel_context (List.map (fun (x,t) -> LocalAssum (x,t)) assums) let push_named_rec_types (lna,typarray,_) env = let open NamedDecl in let ctxt = Array.map2_i (fun i na t -> let id = map_annot (function | Name id -> id | Anonymous -> anomaly (Pp.str "Fix declarations must be named.")) na in LocalAssum (id, lift i t)) lna typarray in Array.fold_left (fun e assum -> push_named assum e) env ctxt let lookup_rel_id id sign = let open RelDecl in let rec lookrec n = function | [] -> raise Not_found | decl :: l -> if Names.Name.equal (Name id) (get_name decl) then (n, get_value decl, get_type decl) else lookrec (n+1) l in lookrec 1 sign let mkProd_or_LetIn = EConstr.mkProd_or_LetIn let mkProd_wo_LetIn = EConstr.mkProd_wo_LetIn let it_mkProd = EConstr.it_mkProd let it_mkLambda = EConstr.it_mkLambda let it_mkProd_or_LetIn = EConstr.it_mkProd_or_LetIn let it_mkProd_wo_LetIn = EConstr.it_mkProd_wo_LetIn let it_mkLambda_or_LetIn = Term.it_mkLambda_or_LetIn let it_mkNamedProd_or_LetIn = EConstr.it_mkNamedProd_or_LetIn let it_mkNamedLambda_or_LetIn = EConstr.it_mkNamedLambda_or_LetIn (* On Constr *) let it_named_context_quantifier f ~init = List.fold_left (fun c d -> f d c) init let it_mkNamedProd_wo_LetIn init = it_named_context_quantifier mkNamedProd_wo_LetIn ~init let it_mkLambda_or_LetIn_from_no_LetIn c decls = let open RelDecl in let rec aux k decls c = match decls with | [] -> c | LocalDef (na,b,t) :: decls -> mkLetIn (na,b,t,aux (k-1) decls (liftn 1 k c)) | LocalAssum (na,t) :: decls -> mkLambda (na,t,aux (k-1) decls c) in aux (List.length decls) (List.rev decls) c (* *) (* strips head casts and flattens head applications *) let rec strip_head_cast sigma c = match EConstr.kind sigma c with | App (f,cl) -> let rec collapse_rec f cl2 = match EConstr.kind sigma f with | App (g,cl1) -> collapse_rec g (Array.append cl1 cl2) | Cast (c,_,_) -> collapse_rec c cl2 | _ -> if Int.equal (Array.length cl2) 0 then f else EConstr.mkApp (f,cl2) in collapse_rec f cl | Cast (c,_,_) -> strip_head_cast sigma c | _ -> c let rec drop_extra_implicit_args sigma c = match EConstr.kind sigma c with (* Removed trailing extra implicit arguments, what improves compatibility for constants with recently added maximal implicit arguments *) | App (f,args) when EConstr.isEvar sigma (Array.last args) -> let open EConstr in drop_extra_implicit_args sigma (mkApp (f,fst (Array.chop (Array.length args - 1) args))) | _ -> c (* Get the last arg of an application *) let last_arg sigma c = match EConstr.kind sigma c with | App (f,cl) -> Array.last cl | _ -> anomaly (Pp.str "last_arg.") (* Get the last arg of an application *) let adjust_app_list_size f1 l1 f2 l2 = let open EConstr in let len1 = List.length l1 and len2 = List.length l2 in if Int.equal len1 len2 then (f1,l1,f2,l2) else if len1 < len2 then let extras,restl2 = List.chop (len2-len1) l2 in (f1, l1, applist (f2,extras), restl2) else let extras,restl1 = List.chop (len1-len2) l1 in (applist (f1,extras), restl1, f2, l2) let adjust_app_array_size f1 l1 f2 l2 = let open EConstr in let len1 = Array.length l1 and len2 = Array.length l2 in if Int.equal len1 len2 then (f1,l1,f2,l2) else if len1 < len2 then let extras,restl2 = Array.chop (len2-len1) l2 in (f1, l1, mkApp (f2,extras), restl2) else let extras,restl1 = Array.chop (len1-len2) l1 in (mkApp (f1,extras), restl1, f2, l2) (* [map_constr_with_binders_left_to_right g f n c] maps [f n] on the immediate subterms of [c]; it carries an extra data [n] (typically a lift index) which is processed by [g] (which typically add 1 to [n]) at each binder traversal; the subterms are processed from left to right according to the usual representation of the constructions (this may matter if [f] does a side-effect); it is not recursive; in fact, the usual representation of the constructions is at the time being almost those of the ML representation (except for (co-)fixpoint) *) let fold_rec_types g (lna,typarray,_) e = let open EConstr in let open Vars in let ctxt = Array.map2_i (fun i na t -> RelDecl.LocalAssum (na, lift i t)) lna typarray in Array.fold_left (fun e assum -> g assum e) e ctxt let map_left2 f a g b = let l = Array.length a in if Int.equal l 0 then [||], [||] else begin let r = Array.make l (f a.(0)) in let s = Array.make l (g b.(0)) in for i = 1 to l - 1 do r.(i) <- f a.(i); s.(i) <- g b.(i) done; r, s end let map_constr_with_binders_left_to_right env sigma g f l c = let open RelDecl in let open EConstr in match EConstr.kind sigma c with | (Rel _ | Meta _ | Var _ | Sort _ | Const _ | Ind _ | Construct _ | Int _ | Float _ | String _) -> c | Cast (b,k,t) -> let b' = f l b in let t' = f l t in if b' == b && t' == t then c else mkCast (b',k,t') | Prod (na,t,b) -> let t' = f l t in let b' = f (g (LocalAssum (na,t)) l) b in if t' == t && b' == b then c else mkProd (na, t', b') | Lambda (na,t,b) -> let t' = f l t in let b' = f (g (LocalAssum (na,t)) l) b in if t' == t && b' == b then c else mkLambda (na, t', b') | LetIn (na,bo,t,b) -> let bo' = f l bo in let t' = f l t in let b' = f (g (LocalDef (na,bo,t)) l) b in if bo' == bo && t' == t && b' == b then c else mkLetIn (na, bo', t', b') | App (c,[||]) -> assert false | App (t,al) -> (*Special treatment to be able to recognize partially applied subterms*) let a = al.(Array.length al - 1) in let app = (mkApp (t, Array.sub al 0 (Array.length al - 1))) in let app' = f l app in let a' = f l a in if app' == app && a' == a then c else mkApp (app', [| a' |]) | Proj (p,r,b) -> let b' = f l b in if b' == b then c else mkProj (p, r, b') | Evar ev -> let ev' = EConstr.map_existential sigma (fun c -> f l c) ev in if ev' == ev then c else mkEvar ev' | Case (ci,u,pms,(p,r),iv,b,bl) -> let (ci, _, pms, (p0,_), _, b, bl0) = annotate_case env sigma (ci, u, pms, (p,r), iv, b, bl) in let f_ctx (nas, _ as r) (ctx, c) = let c' = f (List.fold_right g ctx l) c in if c' == c then r else (nas, c') in (* In v8 concrete syntax, predicate is after the term to match! *) let b' = f l b in let pms' = Array.map_left (f l) pms in let p' = f_ctx p p0 in let iv' = map_invert (f l) iv in let bl' = Array.map_left (fun (c, c0) -> f_ctx c c0) (Array.map2 (fun x y -> (x, y)) bl bl0) in if b' == b && pms' == pms && p' == p && iv' == iv && bl' == bl then c else mkCase (ci, u, pms', (p',r), iv', b', bl') | Fix (ln,(lna,tl,bl as fx)) -> let l' = fold_rec_types g fx l in let (tl', bl') = map_left2 (f l) tl (f l') bl in if Array.for_all2 (==) tl tl' && Array.for_all2 (==) bl bl' then c else mkFix (ln,(lna,tl',bl')) | CoFix(ln,(lna,tl,bl as fx)) -> let l' = fold_rec_types g fx l in let (tl', bl') = map_left2 (f l) tl (f l') bl in if Array.for_all2 (==) tl tl' && Array.for_all2 (==) bl bl' then c else mkCoFix (ln,(lna,tl',bl')) | Array(u,t,def,ty) -> let t' = Array.map_left (f l) t in let def' = f l def in let ty' = f l ty in if def' == def && t' == t && ty' == ty then c else mkArray(u,t',def',ty') (* strong *) let map_constr_with_full_binders env sigma g f l cstr = let open EConstr in match EConstr.kind sigma cstr with | (Rel _ | Meta _ | Var _ | Sort _ | Const _ | Ind _ | Construct _ | Int _ | Float _ | String _) -> cstr | Cast (c,k, t) -> let c' = f l c in let t' = f l t in if c==c' && t==t' then cstr else mkCast (c', k, t') | Prod (na,t,c) -> let t' = f l t in let c' = f (g (RelDecl.LocalAssum (na, t)) l) c in if t==t' && c==c' then cstr else mkProd (na, t', c') | Lambda (na,t,c) -> let t' = f l t in let c' = f (g (RelDecl.LocalAssum (na, t)) l) c in if t==t' && c==c' then cstr else mkLambda (na, t', c') | LetIn (na,b,t,c) -> let b' = f l b in let t' = f l t in let c' = f (g (RelDecl.LocalDef (na, b, t)) l) c in if b==b' && t==t' && c==c' then cstr else mkLetIn (na, b', t', c') | App (c,al) -> let c' = f l c in let al' = Array.map (f l) al in if c==c' && Array.for_all2 (==) al al' then cstr else mkApp (c', al') | Proj (p,r,c) -> let c' = f l c in if c' == c then cstr else mkProj (p, r, c') | Evar ev -> let ev' = EConstr.map_existential sigma (fun c -> f l c) ev in if ev' == ev then cstr else mkEvar ev' | Case (ci, u, pms, (p,r), iv, c, bl) -> let (ci, _, pms, (p0,_), _, c, bl0) = annotate_case env sigma (ci, u, pms, (p,r), iv, c, bl) in let f_ctx (nas, _ as r) (ctx, c) = let c' = f (List.fold_right g ctx l) c in if c' == c then r else (nas, c') in let pms' = Array.Smart.map (f l) pms in let p' = f_ctx p p0 in let iv' = map_invert (f l) iv in let c' = f l c in let bl' = Array.map2 f_ctx bl bl0 in if pms==pms' && p==p' && iv'==iv && c==c' && Array.for_all2 (==) bl bl' then cstr else mkCase (ci, u, pms', (p',r), iv', c', bl') | Fix (ln,(lna,tl,bl as fx)) -> let tl' = Array.map (f l) tl in let l' = fold_rec_types g fx l in let bl' = Array.map (f l') bl in if Array.for_all2 (==) tl tl' && Array.for_all2 (==) bl bl' then cstr else mkFix (ln,(lna,tl',bl')) | CoFix(ln,(lna,tl,bl as fx)) -> let tl' = Array.map (f l) tl in let l' = fold_rec_types g fx l in let bl' = Array.map (f l') bl in if Array.for_all2 (==) tl tl' && Array.for_all2 (==) bl bl' then cstr else mkCoFix (ln,(lna,tl',bl')) | Array(u,t,def,ty) -> let t' = Array.Smart.map (f l) t in let def' = f l def in let ty' = f l ty in if def==def' && t == t' && ty==ty' then cstr else mkArray (u,t', def',ty') (* [fold_constr_with_binders g f n acc c] folds [f n] on the immediate subterms of [c] starting from [acc] and proceeding from left to right according to the usual representation of the constructions as [fold_constr] but it carries an extra data [n] (typically a lift index) which is processed by [g] (which typically add 1 to [n]) at each binder traversal; it is not recursive *) let fold_constr_with_full_binders env sigma g f n acc c = let open EConstr.Vars in let open Context.Rel.Declaration in match EConstr.kind sigma c with | Rel _ | Meta _ | Var _ | Sort _ | Const _ | Ind _ | Construct _ | Int _ | Float _ | String _ -> acc | Cast (c,_, t) -> f n (f n acc c) t | Prod (na,t,c) -> f (g (LocalAssum (na,t)) n) (f n acc t) c | Lambda (na,t,c) -> f (g (LocalAssum (na,t)) n) (f n acc t) c | LetIn (na,b,t,c) -> f (g (LocalDef (na,b,t)) n) (f n (f n acc b) t) c | App (c,l) -> Array.fold_left (f n) (f n acc c) l | Proj (_,_,c) -> f n acc c | Evar ev -> let args = Evd.expand_existential sigma ev in List.fold_left (fun c -> f n c) acc args | Case (ci, u, pms, p, iv, c, bl) -> let (ci, _, pms, (p,_), _, c, bl) = EConstr.annotate_case env sigma (ci, u, pms, p, iv, c, bl) in let f_ctx acc (ctx, c) = f (List.fold_right g ctx n) acc c in Array.fold_left f_ctx (f n (fold_invert (f n) (f_ctx (Array.fold_left (f n) acc pms) p) iv) c) bl | Fix (_,(lna,tl,bl)) -> let n' = CArray.fold_left2_i (fun i c n t -> g (LocalAssum (n,lift i t)) c) n lna tl in let fd = Array.map2 (fun t b -> (t,b)) tl bl in Array.fold_left (fun acc (t,b) -> f n' (f n acc t) b) acc fd | CoFix (_,(lna,tl,bl)) -> let n' = CArray.fold_left2_i (fun i c n t -> g (LocalAssum (n,lift i t)) c) n lna tl in let fd = Array.map2 (fun t b -> (t,b)) tl bl in Array.fold_left (fun acc (t,b) -> f n' (f n acc t) b) acc fd | Array(_u,t,def,ty) -> f n (f n (Array.fold_left (f n) acc t) def) ty (***************************) (* occurs check functions *) (***************************) exception Occur let occur_meta sigma c = let rec occrec c = match EConstr.kind sigma c with | Meta _ -> raise Occur | Evar (_, args) -> SList.Skip.iter occrec args | _ -> EConstr.iter sigma occrec c in try occrec c; false with Occur -> true let occur_existential sigma c = let rec occrec c = match EConstr.kind sigma c with | Evar _ -> raise Occur | _ -> EConstr.iter sigma occrec c in try occrec c; false with Occur -> true let occur_meta_or_existential sigma c = let rec occrec c = match EConstr.kind sigma c with | Evar _ -> raise Occur | Meta _ -> raise Occur | _ -> EConstr.iter sigma occrec c in try occrec c; false with Occur -> true let occur_metavariable sigma m c = let rec occrec c = match EConstr.kind sigma c with | Meta m' -> if Int.equal m m' then raise Occur | Evar (_, args) -> SList.Skip.iter occrec args | _ -> EConstr.iter sigma occrec c in try occrec c; false with Occur -> true let occur_evar sigma n c = let rec occur_rec c = match EConstr.kind sigma c with | Evar (sp, args) -> if Evar.equal sp n then raise Occur else SList.Skip.iter occur_rec args | _ -> EConstr.iter sigma occur_rec c in try occur_rec c; false with Occur -> true let occur_in_global env id constr = let vars = vars_of_global env constr in Id.Set.mem id vars let occur_var env sigma id c = let rec occur_rec c = match EConstr.destRef sigma c with | gr, _ -> if occur_in_global env id gr then raise Occur | exception DestKO -> EConstr.iter sigma occur_rec c in try occur_rec c; false with Occur -> true let occur_vars env sigma ids c = let rec occur_rec c = match EConstr.destRef sigma c with | gr, _ -> let vars = vars_of_global env gr in if not (Id.Set.is_empty (Id.Set.inter ids vars)) then raise Occur | exception DestKO -> EConstr.iter sigma occur_rec c in try occur_rec c; false with Occur -> true exception OccurInGlobal of GlobRef.t let occur_var_indirectly env sigma id c = let var = GlobRef.VarRef id in let rec occur_rec c = match EConstr.destRef sigma c with | gr, _ -> if not (QGlobRef.equal env gr var) && occur_in_global env id gr then raise (OccurInGlobal gr) | exception DestKO -> EConstr.iter sigma occur_rec c in try occur_rec c; None with OccurInGlobal gr -> Some gr let occur_var_in_decl env sigma hyp decl = NamedDecl.exists (occur_var env sigma hyp) decl let occur_vars_in_decl env sigma hyps decl = NamedDecl.exists (occur_vars env sigma hyps) decl let local_occur_var sigma id c = let rec occur c = match EConstr.kind sigma c with | Var id' -> if Id.equal id id' then raise Occur | _ -> EConstr.iter sigma occur c in try occur c; false with Occur -> true let local_occur_var_in_decl sigma hyp decl = NamedDecl.exists (local_occur_var sigma hyp) decl (* returns the list of free debruijn indices in a term *) let free_rels sigma m = let rec frec depth acc c = match EConstr.kind sigma c with | Rel n -> if n >= depth then Int.Set.add (n-depth+1) acc else acc | Evar (_, args) -> SList.Skip.fold (fun acc c -> frec depth acc c) acc args | _ -> EConstr.fold_with_binders sigma succ frec depth acc c in frec 1 Int.Set.empty m let free_rels_and_unqualified_refs sigma t = let rec aux k (gseen, vseen, ids as accu) t = match EConstr.kind sigma t with | Const _ | Ind _ | Construct _ | Var _ -> let g, _ = EConstr.destRef sigma t in if not (GlobRef.Set_env.mem g gseen) then begin try let gseen = GlobRef.Set_env.add g gseen in let short = Nametab.shortest_qualid_of_global Id.Set.empty g in let dir, id = Libnames.repr_qualid short in let ids = if DirPath.is_empty dir then Id.Set.add id ids else ids in (gseen, vseen, ids) with Not_found when !Flags.in_debugger || !Flags.in_ml_toplevel -> accu end else accu | Rel p -> if p > k && not (Int.Set.mem (p - k) vseen) then let vseen = Int.Set.add (p - k) vseen in (gseen, vseen, ids) else accu | _ -> EConstr.fold_with_binders sigma succ aux k accu t in let accu = (GlobRef.Set_env.empty, Int.Set.empty, Id.Set.empty) in let (_, rels, ids) = aux 0 accu t in rels, ids (* collects all metavar occurrences, in left-to-right order, preserving * repetitions and all. *) let collect_metas sigma c = let rec collrec acc c = match EConstr.kind sigma c with | Meta mv -> List.add_set Int.equal mv acc | Evar (_, args) -> SList.Skip.fold collrec acc args | _ -> EConstr.fold sigma collrec acc c in List.rev (collrec [] c) (* collects all vars; warning: this is only visible vars, not dependencies in all section variables; for the latter, use global_vars_set *) let collect_vars sigma c = let rec aux vars c = match EConstr.kind sigma c with | Var id -> Id.Set.add id vars | _ -> EConstr.fold sigma aux vars c in aux Id.Set.empty c (* Tests whether [m] is a subterm of [t]: [m] is appropriately lifted through abstractions of [t] *) let dependent_main noevar sigma m t = let open EConstr in let eqc x y = eq_constr_nounivs sigma x y in let rec deprec m t = if eqc m t then raise Occur else match EConstr.kind sigma m, EConstr.kind sigma t with | App (fm,lm), App (ft,lt) when Array.length lm < Array.length lt -> deprec m (mkApp (ft,Array.sub lt 0 (Array.length lm))); Array.Fun1.iter deprec m (Array.sub lt (Array.length lm) ((Array.length lt) - (Array.length lm))) | _, Cast (c,_,_) when noevar && isMeta sigma c -> () | _, Evar _ when noevar -> () | _ -> EConstr.iter_with_binders sigma (fun c -> Vars.lift 1 c) deprec m t in try deprec m t; false with Occur -> true let dependent sigma c t = dependent_main false sigma c t let dependent_no_evar sigma c t = dependent_main true sigma c t let dependent_in_decl sigma a decl = let open NamedDecl in match decl with | LocalAssum (_,t) -> dependent sigma a t | LocalDef (_, body, t) -> dependent sigma a body || dependent sigma a t let count_occurrences sigma m t = let open EConstr in let n = ref 0 in let rec countrec m t = if EConstr.eq_constr sigma m t then incr n else match EConstr.kind sigma m, EConstr.kind sigma t with | App (fm,lm), App (ft,lt) when Array.length lm < Array.length lt -> countrec m (mkApp (ft,Array.sub lt 0 (Array.length lm))); Array.iter (countrec m) (Array.sub lt (Array.length lm) ((Array.length lt) - (Array.length lm))) | _, Cast (c,_,_) when isMeta sigma c -> () | _, Evar _ -> () | _ -> EConstr.iter_with_binders sigma (Vars.lift 1) countrec m t in countrec m t; !n let pop t = EConstr.Vars.lift (-1) t (***************************) (* bindings functions *) (***************************) type meta_type_map = (metavariable * types) list type meta_value_map = (metavariable * constr) list let isMetaOf sigma mv c = match EConstr.kind sigma c with Meta mv' -> Int.equal mv mv' | _ -> false let rec subst_meta bl c = match kind c with | Meta i -> (try Int.List.assoc i bl with Not_found -> c) | _ -> Constr.map (subst_meta bl) c let rec strip_outer_cast sigma c = match EConstr.kind sigma c with | Cast (c,_,_) -> strip_outer_cast sigma c | _ -> c (* First utilities for avoiding telescope computation for subst_term *) let prefix_application sigma eq_fun k l1 t = let open EConstr in if 0 < l1 then match EConstr.kind sigma t with | App (f2,cl2) -> let l2 = Array.length cl2 in if l1 <= l2 && eq_fun sigma k (mkApp (f2, Array.sub cl2 0 l1)) then Some (Array.sub cl2 l1 (l2 - l1)) else None | _ -> None else None let eq_upto_lift cache c sigma k t = let c = try Int.Map.find k !cache with Not_found -> let c = EConstr.Vars.lift k c in let () = cache := Int.Map.add k c !cache in c in EConstr.eq_constr sigma c t (* Recognizing occurrences of a given subterm in a term : [replace_term c1 c2 t] substitutes [c2] for all occurrences of term [c1] in a term [t]; works if [c1] and [c2] have rels *) let replace_term_gen sigma eq_fun ar by_c in_t = let rec substrec k t = match prefix_application sigma eq_fun k ar t with | Some args -> EConstr.mkApp (EConstr.Vars.lift k by_c, args) | None -> (if eq_fun sigma k t then (EConstr.Vars.lift k by_c) else EConstr.map_with_binders sigma succ substrec k t) in substrec 0 in_t let replace_term sigma c byc t = let cache = ref Int.Map.empty in let ar = Array.length (snd (EConstr.decompose_app sigma c)) in let eq sigma k t = eq_upto_lift cache c sigma k t in replace_term_gen sigma eq ar byc t let subst_term sigma c t = replace_term sigma c (EConstr.mkRel 1) t let add_vname vars = function Name id -> Id.Set.add id vars | _ -> vars (*************************) (* Names environments *) (*************************) type names_context = Name.t list let add_name n nl = n::nl let lookup_name_of_rel p names = try List.nth names (p-1) with Invalid_argument _ | Failure _ -> raise Not_found let lookup_rel_of_name id names = let rec lookrec n = function | Anonymous :: l -> lookrec (n+1) l | (Name id') :: l -> if Id.equal id' id then n else lookrec (n+1) l | [] -> raise Not_found in lookrec 1 names let empty_names_context = [] let ids_of_rel_context sign = Context.Rel.fold_outside (fun decl l -> match RelDecl.get_name decl with Name id -> id::l | Anonymous -> l) sign ~init:[] let ids_of_named_context sign = Context.Named.fold_outside (fun decl idl -> NamedDecl.get_id decl :: idl) sign ~init:[] let ids_of_context env = (ids_of_rel_context (rel_context env)) @ (ids_of_named_context (named_context env)) let names_of_rel_context env = List.map RelDecl.get_name (rel_context env) let is_section_variable env id = try let _ = Environ.lookup_named id env in true with Not_found -> false let global_of_constr sigma c = let open GlobRef in match EConstr.kind sigma c with | Const (c, u) -> ConstRef c, u | Ind (i, u) -> IndRef i, u | Construct (c, u) -> ConstructRef c, u | Var id -> VarRef id, EConstr.EInstance.empty | _ -> raise Not_found let is_global = EConstr.isRefX let isGlobalRef = EConstr.isRef let is_template_polymorphic_ind env sigma f = match EConstr.kind sigma f with | Ind (ind, u) -> if not (EConstr.EInstance.is_empty u) then false else Environ.template_polymorphic_ind ind env | _ -> false let base_sort_cmp pb s0 s1 = match (s0,s1) with | SProp, SProp | Prop, Prop | Set, Set | Type _, Type _ -> true | QSort (q1, _), QSort (q2, _) -> Sorts.QVar.equal q1 q2 | QSort _, _ | _, QSort _ -> false | SProp, _ | _, SProp -> false | Prop, Set | Prop, Type _ | Set, Type _ -> pb == Conversion.CUMUL | Set, Prop | Type _, Prop | Type _, Set -> false let rec is_Prop sigma c = match EConstr.kind sigma c with | Sort u -> begin match EConstr.ESorts.kind sigma u with | Prop -> true | _ -> false end | Cast (c,_,_) -> is_Prop sigma c | _ -> false let rec is_Set sigma c = match EConstr.kind sigma c with | Sort u -> begin match EConstr.ESorts.kind sigma u with | Set -> true | _ -> false end | Cast (c,_,_) -> is_Set sigma c | _ -> false let rec is_Type sigma c = match EConstr.kind sigma c with | Sort u -> begin match EConstr.ESorts.kind sigma u with | Type _ -> true | _ -> false end | Cast (c,_,_) -> is_Type sigma c | _ -> false (* eq_constr extended with universe erasure *) let compare_constr_univ env sigma f cv_pb t1 t2 = let open EConstr in match EConstr.kind sigma t1, EConstr.kind sigma t2 with Sort s1, Sort s2 -> base_sort_cmp cv_pb (ESorts.kind sigma s1) (ESorts.kind sigma s2) | Prod (_,t1,c1), Prod (_,t2,c2) -> f Conversion.CONV t1 t2 && f cv_pb c1 c2 | Const (c, u), Const (c', u') -> QConstant.equal env c c' | Ind (i, _), Ind (i', _) -> QInd.equal env i i' | Construct (i, _), Construct (i', _) -> QConstruct.equal env i i' | _ -> EConstr.compare_constr sigma (fun t1 t2 -> f Conversion.CONV t1 t2) t1 t2 let constr_cmp env sigma cv_pb t1 t2 = let rec compare cv_pb t1 t2 = compare_constr_univ env sigma compare cv_pb t1 t2 in compare cv_pb t1 t2 let eq_constr env sigma t1 t2 = constr_cmp env sigma Conversion.CONV t1 t2 (* (nb_lam [na1:T1]...[nan:Tan]c) where c is not an abstraction * gives n (casts are ignored) *) let nb_lam sigma c = let rec nbrec n c = match EConstr.kind sigma c with | Lambda (_,_,c) -> nbrec (n+1) c | Cast (c,_,_) -> nbrec n c | _ -> n in nbrec 0 c (* similar to nb_lam, but gives the number of products instead *) let nb_prod sigma c = let rec nbrec n c = match EConstr.kind sigma c with | Prod (_,_,c) -> nbrec (n+1) c | Cast (c,_,_) -> nbrec n c | _ -> n in nbrec 0 c let nb_prod_modulo_zeta sigma x = let rec count n c = match EConstr.kind sigma c with Prod(_,_,t) -> count (n+1) t | LetIn(_,a,_,t) -> count n (EConstr.Vars.subst1 a t) | Cast(c,_,_) -> count n c | _ -> n in count 0 x (* We reduce a series of head eta-redex or nothing at all *) (* [x1:c1;...;xn:cn]@(f;a1...an;x1;...;xn) --> @(f;a1...an) *) (* Remplace 2 earlier buggish versions *) let rec eta_reduce_head sigma c = let open EConstr in let open Vars in match EConstr.kind sigma c with | Lambda (_,c1,c') -> (match EConstr.kind sigma (eta_reduce_head sigma c') with | App (f,cl) -> let lastn = (Array.length cl) - 1 in if lastn < 0 then anomaly (Pp.str "application without arguments.") else (match EConstr.kind sigma cl.(lastn) with | Rel 1 -> let c' = if Int.equal lastn 0 then f else mkApp (f, Array.sub cl 0 lastn) in if noccurn sigma 1 c' then lift (-1) c' else c | _ -> c) | _ -> c) | _ -> c (* iterator on rel context *) let process_rel_context f env = let sign = named_context_val env in let rels = EConstr.rel_context env in let env0 = reset_with_named_context sign env in Context.Rel.fold_outside f rels ~init:env0 let assums_of_rel_context sign = Context.Rel.fold_outside (fun decl l -> match decl with | RelDecl.LocalDef _ -> l | RelDecl.LocalAssum (na,t) -> (na, t)::l) sign ~init:[] let map_rel_context_in_env f env sign = let rec aux env acc = function | d::sign -> aux (push_rel d env) (RelDecl.map_constr (f env) d :: acc) sign | [] -> acc in aux env [] (List.rev sign) let map_rel_context_with_binders = Context.Rel.map_with_binders let substl_rel_context = Vars.substl_rel_context let lift_rel_context = Vars.lift_rel_context let smash_rel_context = Vars.smash_rel_context let fold_named_context_both_sides f l ~init = List.fold_right_and_left f l init let mem_named_context_val id ctxt = try ignore(Environ.lookup_named_ctxt id ctxt); true with Not_found -> false let map_rel_decl = RelDecl.map_constr_het let map_named_decl = NamedDecl.map_constr_het let compact_named_context sigma sign = let compact l decl = match decl, l with | NamedDecl.LocalAssum (i,t), [] -> [CompactedDecl.LocalAssum ([i],t)] | NamedDecl.LocalDef (i,c,t), [] -> [CompactedDecl.LocalDef ([i],c,t)] | NamedDecl.LocalAssum (i1,t1), CompactedDecl.LocalAssum (li,t2) :: q -> if EConstr.eq_constr sigma t1 t2 then CompactedDecl.LocalAssum (i1::li, t2) :: q else CompactedDecl.LocalAssum ([i1],t1) :: CompactedDecl.LocalAssum (li,t2) :: q | NamedDecl.LocalDef (i1,c1,t1), CompactedDecl.LocalDef (li,c2,t2) :: q -> if EConstr.eq_constr sigma c1 c2 && EConstr.eq_constr sigma t1 t2 then CompactedDecl.LocalDef (i1::li, c2, t2) :: q else CompactedDecl.LocalDef ([i1],c1,t1) :: CompactedDecl.LocalDef (li,c2,t2) :: q | NamedDecl.LocalAssum (i,t), q -> CompactedDecl.LocalAssum ([i],t) :: q | NamedDecl.LocalDef (i,c,t), q -> CompactedDecl.LocalDef ([i],c,t) :: q in sign |> Context.Named.fold_inside compact ~init:[] |> List.rev let clear_named_body id env = let open NamedDecl in let aux _ = function | LocalDef (id',c,t) when Id.equal id id'.binder_name -> push_named (LocalAssum (id',t)) | d -> push_named d in fold_named_context aux env ~init:(reset_context env) let global_vars_set env sigma constr = let rec filtrec acc c = match EConstr.destRef sigma c with | gr, _ -> Id.Set.union (vars_of_global env gr) acc | exception DestKO -> EConstr.fold sigma filtrec acc c in filtrec Id.Set.empty constr let global_vars_set_of_decl env sigma = function | NamedDecl.LocalAssum (_,t) -> global_vars_set env sigma t | NamedDecl.LocalDef (_,c,t) -> Id.Set.union (global_vars_set env sigma t) (global_vars_set env sigma c) let dependency_closure env sigma sign hyps = if Id.Set.is_empty hyps then [] else let (_,lh) = Context.Named.fold_inside (fun (hs,hl) d -> let x = NamedDecl.get_id d in if Id.Set.mem x hs then (Id.Set.union (global_vars_set_of_decl env sigma d) (Id.Set.remove x hs), x::hl) else (hs,hl)) ~init:(hyps,[]) sign in List.rev lh let global_app_of_constr sigma c = let open GlobRef in match EConstr.kind sigma c with | Const (c, u) -> (ConstRef c, u), None | Ind (i, u) -> (IndRef i, u), None | Construct (c, u) -> (ConstructRef c, u), None | Var id -> (VarRef id, EConstr.EInstance.empty), None | Proj (p, _, c) -> (ConstRef (Projection.constant p), EConstr.EInstance.empty), Some c | _ -> raise Not_found let prod_applist sigma c l = let open EConstr in let rec app subst c l = match EConstr.kind sigma c, l with | Prod(_,_,c), arg::l -> app (arg::subst) c l | _, [] -> Vars.substl subst c | _ -> anomaly (Pp.str "Not enough prod's.") in app [] c l let prod_applist_decls sigma n c l = let open EConstr in let rec app n subst c l = if Int.equal n 0 then if l == [] then Vars.substl subst c else anomaly (Pp.str "Not enough arguments.") else match EConstr.kind sigma c, l with | Prod(_,_,c), arg::l -> app (n-1) (arg::subst) c l | LetIn(_,b,_,c), _ -> app (n-1) (Vars.substl subst b::subst) c l | _ -> anomaly (Pp.str "Not enough prod/let's.") in app n [] c l (* Cut a context ctx in 2 parts (ctx1,ctx2) with ctx1 containing k non let-in variables skips let-in's; let-in's in the middle are put in ctx2 *) let context_chop k ctx = let rec chop_aux acc = function | (0, l2) -> (List.rev acc, l2) | (n, (RelDecl.LocalDef _ as h)::t) -> chop_aux (h::acc) (n, t) | (n, (h::t)) -> chop_aux (h::acc) (pred n, t) | (_, []) -> anomaly (Pp.str "context_chop.") in chop_aux [] (k,ctx) (* Do not skip let-in's *) let env_rel_context_chop k env = let open EConstr in let rels = rel_context env in let ctx1,ctx2 = List.chop k rels in push_rel_context ctx2 (reset_with_named_context (named_context_val env) env), ctx1 coq-8.20.0/engine/termops.mli000066400000000000000000000342201466560755400160470ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* env -> env val push_rels_assum : (Name.t Constr.binder_annot * Constr.types) list -> env -> env val push_named_rec_types : Name.t Constr.binder_annot array * Constr.types array * 'a -> env -> env val lookup_rel_id : Id.t -> ('c, 't, 'r) Context.Rel.pt -> int * 'c option * 't (** Associates the contents of an identifier in a [rel_context]. Raise [Not_found] if there is no such identifier. *) (** Functions that build argument lists matching a block of binders or a context. [rel_vect n m] builds [|Rel (n+m);...;Rel(n+1)|] *) val rel_vect : int -> int -> Constr.constr array val rel_list : int -> int -> constr list (** Prod/Lambda/LetIn destructors on econstr *) val mkProd_or_LetIn : rel_declaration -> types -> types [@@ocaml.deprecated "Use synonymous [EConstr.mkProd_or_LetIn]."] val mkProd_wo_LetIn : rel_declaration -> types -> types [@@ocaml.deprecated "Use synonymous [EConstr.mkProd_wo_LetIn]."] val it_mkProd : types -> (Name.t EConstr.binder_annot * types) list -> types [@@ocaml.deprecated "Use synonymous [EConstr.it_mkProd]."] val it_mkLambda : constr -> (Name.t EConstr.binder_annot * types) list -> constr [@@ocaml.deprecated "Use synonymous [EConstr.it_mkLambda]."] val it_mkProd_or_LetIn : types -> rel_context -> types [@@ocaml.deprecated "Use synonymous [EConstr.it_mkProd_or_LetIn]."] val it_mkProd_wo_LetIn : types -> rel_context -> types [@@ocaml.deprecated "Use synonymous [EConstr.it_mkProd_wo_LetIn]."] val it_mkLambda_or_LetIn : Constr.constr -> Constr.rel_context -> Constr.constr [@@ocaml.deprecated "Use synonymous [Term.it_mkLambda_or_LetIn]."] val it_mkNamedProd_or_LetIn : Evd.evar_map -> types -> named_context -> types [@@ocaml.deprecated "Use synonymous [EConstr.it_mkNamedProd_or_LetIn]."] val it_mkNamedLambda_or_LetIn : Evd.evar_map -> constr -> named_context -> constr [@@ocaml.deprecated "Use synonymous [EConstr.it_mkNamedLambda_or_LetIn]."] (** Prod/Lambda/LetIn destructors on constr *) val it_mkNamedProd_wo_LetIn : Constr.types -> Constr.named_context -> Constr.types (* Ad hoc version reinserting letin, assuming the body is defined in the context where the letins are expanded *) val it_mkLambda_or_LetIn_from_no_LetIn : Constr.constr -> Constr.rel_context -> Constr.constr (** {6 Generic iterators on constr} *) val map_constr_with_binders_left_to_right : Environ.env -> Evd.evar_map -> (rel_declaration -> 'a -> 'a) -> ('a -> constr -> constr) -> 'a -> constr -> constr val map_constr_with_full_binders : Environ.env -> Evd.evar_map -> (rel_declaration -> 'a -> 'a) -> ('a -> constr -> constr) -> 'a -> constr -> constr val fold_constr_with_full_binders : Environ.env -> Evd.evar_map -> (rel_declaration -> 'a -> 'a) -> ('a -> 'b -> constr -> 'b) -> 'a -> 'b -> constr -> 'b (**********************************************************************) val strip_head_cast : Evd.evar_map -> constr -> constr val drop_extra_implicit_args : Evd.evar_map -> constr -> constr (** occur checks *) exception Occur val occur_meta : Evd.evar_map -> constr -> bool val occur_existential : Evd.evar_map -> constr -> bool val occur_meta_or_existential : Evd.evar_map -> constr -> bool val occur_metavariable : Evd.evar_map -> metavariable -> constr -> bool val occur_evar : Evd.evar_map -> Evar.t -> constr -> bool val occur_var : env -> Evd.evar_map -> Id.t -> constr -> bool val occur_var_indirectly : env -> Evd.evar_map -> Id.t -> constr -> GlobRef.t option val occur_var_in_decl : env -> Evd.evar_map -> Id.t -> named_declaration -> bool val occur_vars : env -> Evd.evar_map -> Id.Set.t -> constr -> bool val occur_vars_in_decl : env -> Evd.evar_map -> Id.Set.t -> named_declaration -> bool (** As {!occur_var} but assume the identifier not to be a section variable *) val local_occur_var : Evd.evar_map -> Id.t -> constr -> bool val local_occur_var_in_decl : Evd.evar_map -> Id.t -> named_declaration -> bool val free_rels : Evd.evar_map -> constr -> Int.Set.t (* Return the list of unbound rels and unqualified reference (same strategy as in Namegen) *) val free_rels_and_unqualified_refs : Evd.evar_map -> constr -> Int.Set.t * Id.Set.t (** [dependent m t] tests whether [m] is a subterm of [t] *) val dependent : Evd.evar_map -> constr -> constr -> bool val dependent_no_evar : Evd.evar_map -> constr -> constr -> bool val dependent_in_decl : Evd.evar_map -> constr -> named_declaration -> bool val count_occurrences : Evd.evar_map -> constr -> constr -> int val collect_metas : Evd.evar_map -> constr -> int list val collect_vars : Evd.evar_map -> constr -> Id.Set.t (** for visible vars only *) (* Substitution of metavariables *) type meta_value_map = (metavariable * Constr.constr) list val subst_meta : meta_value_map -> Constr.constr -> Constr.constr val isMetaOf : Evd.evar_map -> metavariable -> constr -> bool (** Type assignment for metavariables *) type meta_type_map = (metavariable * Constr.types) list (** [pop c] lifts by -1 the positive indexes in [c] *) val pop : constr -> constr (** {6 ... } *) (** Substitution of an arbitrary large term. Uses equality modulo reduction of let *) (** [replace_term_gen eq arity e c] replaces matching subterms according to [eq] by [e] in [c]. If [arity] is non-zero applications of larger length are handled atomically. *) val replace_term_gen : Evd.evar_map -> (Evd.evar_map -> int -> constr -> bool) -> int -> constr -> constr -> constr (** [subst_term d c] replaces [d] by [Rel 1] in [c] *) val subst_term : Evd.evar_map -> constr -> constr -> constr (** [replace_term d e c] replaces [d] by [e] in [c] *) val replace_term : Evd.evar_map -> constr -> constr -> constr -> constr (** Alternative term equalities *) val base_sort_cmp : Conversion.conv_pb -> Sorts.t -> Sorts.t -> bool val compare_constr_univ : Environ.env -> Evd.evar_map -> (Conversion.conv_pb -> constr -> constr -> bool) -> Conversion.conv_pb -> constr -> constr -> bool val constr_cmp : Environ.env -> Evd.evar_map -> Conversion.conv_pb -> constr -> constr -> bool val eq_constr : Environ.env -> Evd.evar_map -> constr -> constr -> bool (* FIXME rename: erases universes*) val eta_reduce_head : Evd.evar_map -> constr -> constr (** [prod_applist] [forall (x1:B1;...;xn:Bn), B] [a1...an] @return [B[a1...an]] *) val prod_applist : Evd.evar_map -> constr -> constr list -> constr (** In [prod_applist_decls n c args], [c] is supposed to have the form [∀Γ.c] with [Γ] of length [m] and possibly with let-ins; it returns [c] with the assumptions of [Γ] instantiated by [args] and the local definitions of [Γ] expanded. Note that [n] counts both let-ins and prods, while the length of [args] only counts prods. In other words, varying [n] changes how many trailing let-ins are expanded. *) val prod_applist_decls : Evd.evar_map -> int -> constr -> constr list -> constr (** Remove recursively the casts around a term i.e. [strip_outer_cast (Cast (Cast ... (Cast c, t) ... ))] is [c]. *) val strip_outer_cast : Evd.evar_map -> constr -> constr (** [nb_lam] {% $ %}[x_1:T_1]...[x_n:T_n]c{% $ %} where {% $ %}c{% $ %} is not an abstraction gives {% $ %}n{% $ %} (casts are ignored) *) val nb_lam : Evd.evar_map -> constr -> int (** Similar to [nb_lam], but gives the number of products instead *) val nb_prod : Evd.evar_map -> constr -> int (** Similar to [nb_prod], but zeta-contracts let-in on the way *) val nb_prod_modulo_zeta : Evd.evar_map -> constr -> int (** Get the last arg of a constr intended to be an application *) val last_arg : Evd.evar_map -> constr -> constr val adjust_app_list_size : constr -> constr list -> constr -> constr list -> (constr * constr list * constr * constr list) val adjust_app_array_size : constr -> constr array -> constr -> constr array -> (constr * constr array * constr * constr array) (** name contexts *) type names_context = Name.t list val add_name : Name.t -> names_context -> names_context val lookup_name_of_rel : int -> names_context -> Name.t val lookup_rel_of_name : Id.t -> names_context -> int val empty_names_context : names_context val ids_of_rel_context : ('c, 't, 'r) Context.Rel.pt -> Id.t list val ids_of_named_context : ('c, 't, 'r) Context.Named.pt -> Id.t list val ids_of_context : env -> Id.t list val names_of_rel_context : env -> names_context (* [context_chop n Γ] returns (Γ₁,Γ₂) such that [Γ]=[Γ₂Γ₁], [Γ₁] has [n] hypotheses, excluding local definitions, and [Γ₁], if not empty, starts with an hypothesis (i.e. [Γ₁] has the form empty or [x:A;Γ₁'] *) val context_chop : int -> Constr.rel_context -> Constr.rel_context * Constr.rel_context [@@ocaml.deprecated "Use synonymous [Context.Rel.chop_nhyps]."] (* [env_rel_context_chop n env] extracts out the [n] top declarations of the rel_context part of [env], counting both local definitions and hypotheses *) val env_rel_context_chop : int -> env -> env * rel_context (** Set of local names *) val vars_of_env: env -> Id.Set.t val add_vname : Id.Set.t -> Name.t -> Id.Set.t (** other signature iterators *) val process_rel_context : (rel_declaration -> env -> env) -> env -> env val assums_of_rel_context : ('c, 't, 'r) Context.Rel.pt -> ((Name.t,'r) Context.pbinder_annot * 't) list val lift_rel_context : int -> Constr.rel_context -> Constr.rel_context [@@ocaml.deprecated "Use synonymous [Vars.lift_rel_context]."] val substl_rel_context : Constr.constr list -> Constr.rel_context -> Constr.rel_context [@@ocaml.deprecated "Use synonymous [Vars.substl_rel_context]."] val smash_rel_context : Constr.rel_context -> Constr.rel_context [@@ocaml.deprecated "Use synonymous [Vars.smash_rel_context]."] val map_rel_context_with_binders : (int -> 'c -> 'c) -> ('c, 'c, 'r) Context.Rel.pt -> ('c, 'c, 'r) Context.Rel.pt [@@ocaml.deprecated "Use synonymous [Context.Rel.map_with_binders]."] val map_rel_context_in_env : (env -> Constr.constr -> Constr.constr) -> env -> Constr.rel_context -> Constr.rel_context val fold_named_context_both_sides : ('a -> Constr.named_declaration -> Constr.named_declaration list -> 'a) -> Constr.named_context -> init:'a -> 'a val mem_named_context_val : Id.t -> named_context_val -> bool val compact_named_context : Evd.evar_map -> EConstr.named_context -> EConstr.compacted_context val map_rel_decl : ('r1 -> 'r2 ) -> ('a -> 'b) -> ('a, 'a, 'r1) Context.Rel.Declaration.pt -> ('b, 'b, 'r2) Context.Rel.Declaration.pt [@@deprecated "Use [Context.Rel.Declaration.map_constr_het]"] val map_named_decl : ('r1 -> 'r2 ) -> ('a -> 'b) -> ('a, 'a, 'r1) Context.Named.Declaration.pt -> ('b, 'b, 'r2) Context.Named.Declaration.pt [@@deprecated "Use [Context.Named.Declaration.map_constr_het]"] val clear_named_body : Id.t -> env -> env val global_vars_set : env -> Evd.evar_map -> constr -> Id.Set.t val global_vars_set_of_decl : env -> Evd.evar_map -> named_declaration -> Id.Set.t val global_app_of_constr : Evd.evar_map -> constr -> (GlobRef.t * EInstance.t) * constr option (** Gives an ordered list of hypotheses, closed by dependencies, containing a given set *) val dependency_closure : env -> Evd.evar_map -> named_context -> Id.Set.t -> Id.t list (** Test if an identifier is the basename of a global reference *) val is_section_variable : env -> Id.t -> bool val global_of_constr : Evd.evar_map -> constr -> GlobRef.t * EInstance.t [@@ocaml.deprecated "Use [EConstr.destRef] instead (throws DestKO instead of Not_found)."] val is_global : Environ.env -> Evd.evar_map -> GlobRef.t -> constr -> bool [@@ocaml.deprecated "Use [EConstr.isRefX] instead."] val isGlobalRef : Evd.evar_map -> constr -> bool [@@ocaml.deprecated "Use [EConstr.isRef] instead."] val is_template_polymorphic_ind : env -> Evd.evar_map -> constr -> bool val is_Prop : Evd.evar_map -> constr -> bool val is_Set : Evd.evar_map -> constr -> bool val is_Type : Evd.evar_map -> constr -> bool val reference_of_level : Evd.evar_map -> Univ.Level.t -> Libnames.qualid option (** {5 Debug pretty-printers} *) open Evd val pr_global_env : env -> GlobRef.t -> Pp.t val pr_existential_key : env -> evar_map -> Evar.t -> Pp.t val evar_suggested_name : env -> evar_map -> Evar.t -> Id.t val pr_evar_info : env -> evar_map -> 'a evar_info -> Pp.t val pr_evar_constraints : evar_map -> evar_constraint list -> Pp.t val pr_evar_map : ?with_univs:bool -> int option -> env -> evar_map -> Pp.t val pr_evar_map_filter : ?with_univs:bool -> (Evar.t -> any_evar_info -> bool) -> env -> evar_map -> Pp.t val pr_metaset : Metaset.t -> Pp.t val pr_evar_universe_context : UState.t -> Pp.t val pr_evd_level : evar_map -> Univ.Level.t -> Pp.t val pr_evd_qvar : evar_map -> Sorts.QVar.t -> Pp.t module Internal : sig (** NOTE: to print terms you always want to use functions in Printer, not these ones which are for very special cases. *) (** debug printers: print raw form for terms with evar-substitution. *) val debug_print_constr : evar_map -> constr -> Pp.t (** Pretty-printer hook: [print_constr_env env sigma c] will pretty print c if the pretty printing layer has been linked into the Coq binary. *) val print_constr_env : env -> Evd.evar_map -> constr -> Pp.t (** [set_print_constr f] sets f to be the pretty printer *) val set_print_constr : (env -> Evd.evar_map -> constr -> Pp.t) -> unit (** Printers for contexts *) val print_named_context : env -> Evd.evar_map -> Pp.t val pr_rel_decl : env -> Evd.evar_map -> Constr.rel_declaration -> Pp.t val print_rel_context : env -> Evd.evar_map -> Pp.t val print_env : env -> Evd.evar_map -> Pp.t end coq-8.20.0/engine/uState.ml000066400000000000000000001312361466560755400154570ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* UGraph.Other p) explain in raise (UGraph.UniverseInconsistency (None, (cst, l, r, explain))) module QState : sig type t type elt = QVar.t val empty : t val union : fail:(t -> Quality.t -> Quality.t -> t) -> t -> t -> t val add : check_fresh:bool -> named:bool -> elt -> t -> t val repr : elt -> t -> Quality.t val unify_quality : fail:(unit -> t) -> Conversion.conv_pb -> Quality.t -> Quality.t -> t -> t val is_above_prop : elt -> t -> bool val undefined : t -> QVar.Set.t val collapse : t -> t val pr : (QVar.t -> Pp.t) -> t -> Pp.t val of_set : QVar.Set.t -> t end = struct module QSet = QVar.Set module QMap = QVar.Map type t = { named : QSet.t; (** Named variables, may not be set to another *) qmap : Quality.t option QMap.t; (* TODO: use a persistent union-find structure *) above : QSet.t; (** Set of quality variables known to be either in Prop or Type. If q ∈ above then it must map to None in qmap. *) } type elt = QVar.t let empty = { named = QSet.empty; qmap = QMap.empty; above = QSet.empty } let rec repr q m = match QMap.find q m.qmap with | None -> QVar q | Some (QVar q) -> repr q m | Some (QConstant _ as q) -> q | exception Not_found -> (* let () = assert !Flags.in_debugger in *) (* FIXME *) QVar q let is_above_prop q m = QSet.mem q m.above let set q qv m = let q = repr q m in let q = match q with QVar q -> q | QConstant _ -> assert false in let qv = match qv with QVar qv -> repr qv m | (QConstant _ as qv) -> qv in match q, qv with | q, QVar qv -> if QVar.equal q qv then Some m else if QSet.mem q m.named then None else let above = if QSet.mem q m.above then QSet.add qv (QSet.remove q m.above) else m.above in Some { named = m.named; qmap = QMap.add q (Some (QVar qv)) m.qmap; above } | q, (QConstant qc as qv) -> if qc == QSProp && QSet.mem q m.above then None else if QSet.mem q m.named then None else Some { named = m.named; qmap = QMap.add q (Some qv) m.qmap; above = QSet.remove q m.above } let set_above_prop q m = let q = repr q m in let q = match q with QVar q -> q | QConstant _ -> assert false in if QSet.mem q m.named then None else Some { named = m.named; qmap = m.qmap; above = QSet.add q m.above } let unify_quality ~fail c q1 q2 local = match q1, q2 with | QConstant QType, QConstant QType | QConstant QProp, QConstant QProp | QConstant QSProp, QConstant QSProp -> local | QConstant QProp, QVar q when c == Conversion.CUMUL -> begin match set_above_prop q local with | Some local -> local | None -> fail () end | QVar qv1, QVar qv2 -> begin match set qv1 q2 local with | Some local -> local | None -> match set qv2 q1 local with | Some local -> local | None -> fail () end | QVar q, (QConstant (QType | QProp | QSProp) as qv) | (QConstant (QType | QProp | QSProp) as qv), QVar q -> begin match set q qv local with | Some local -> local | None -> fail () end | (QConstant QType, QConstant (QProp | QSProp)) -> fail () | (QConstant QProp, QConstant QType) -> begin match c with | CONV -> fail () | CUMUL -> local end | (QConstant QSProp, QConstant (QType | QProp)) -> fail () | (QConstant QProp, QConstant QSProp) -> fail () let nf_quality m = function | QConstant _ as q -> q | QVar q -> repr q m let union ~fail s1 s2 = let extra = ref [] in let qmap = QMap.union (fun qk q1 q2 -> match q1, q2 with | Some q, None | None, Some q -> Some (Some q) | None, None -> Some None | Some q1, Some q2 -> let () = if not (Quality.equal q1 q2) then extra := (q1,q2) :: !extra in Some (Some q1)) s1.qmap s2.qmap in let extra = !extra in let filter q = match QMap.find q qmap with | None -> true | Some _ -> false | exception Not_found -> false in let above = QSet.filter filter @@ QSet.union s1.above s2.above in let s = { named = QSet.union s1.named s2.named; qmap; above } in List.fold_left (fun s (q1,q2) -> let q1 = nf_quality s q1 and q2 = nf_quality s q2 in unify_quality ~fail:(fun () -> fail s q1 q2) CONV q1 q2 s) s extra let add ~check_fresh ~named q m = if check_fresh then assert (not (QMap.mem q m.qmap)); { named = if named then QSet.add q m.named else m.named; qmap = QMap.add q None m.qmap; above = m.above } let of_set qs = { named = QSet.empty; qmap = QMap.bind (fun _ -> None) qs; above = QSet.empty } (* XXX what about [above]? *) let undefined m = let m = QMap.filter (fun _ v -> Option.is_empty v) m.qmap in QMap.domain m let collapse m = let map q v = match v with | None -> if QSet.mem q m.named then None else Some (QConstant QType) | Some _ -> v in { named = m.named; qmap = QMap.mapi map m.qmap; above = QSet.empty } let pr prqvar { qmap; above; named } = let open Pp in let prbody u = function | None -> if QSet.mem u above then str " >= Prop" else if QSet.mem u named then str " (internal name " ++ QVar.raw_pr u ++ str ")" else mt () | Some q -> let q = Quality.pr prqvar q in str " := " ++ q in h (prlist_with_sep fnl (fun (u, v) -> prqvar u ++ prbody u v) (QMap.bindings qmap)) end module UPairSet = UnivMinim.UPairSet type univ_names = UnivNames.universe_binders * (uinfo QVar.Map.t * uinfo Level.Map.t) (* 2nd part used to check consistency on the fly. *) type t = { names : univ_names; (** Printing/location information *) local : ContextSet.t; (** The local graph of universes (variables and constraints) *) seff_univs : Level.Set.t; (** Local universes used through private constants *) univ_variables : UnivFlex.t; (** The local universes that are unification variables *) sort_variables : QState.t; (** Local quality variables. *) universes : UGraph.t; (** The current graph extended with the local constraints *) initial_universes : UGraph.t; (** The graph at the creation of the evar_map *) minim_extra : UnivMinim.extra; } let empty = { names = UnivNames.empty_binders, (QVar.Map.empty, Level.Map.empty); local = ContextSet.empty; seff_univs = Level.Set.empty; univ_variables = UnivFlex.empty; sort_variables = QState.empty; universes = UGraph.initial_universes; initial_universes = UGraph.initial_universes; minim_extra = UnivMinim.empty_extra; } let make ~lbound univs = { empty with universes = univs; initial_universes = univs } let is_empty uctx = ContextSet.is_empty uctx.local && UnivFlex.is_empty uctx.univ_variables let id_of_level uctx l = try (Level.Map.find l (snd (snd uctx.names))).uname with Not_found -> None let id_of_qvar uctx l = try (QVar.Map.find l (fst (snd uctx.names))).uname with Not_found -> None let qualid_of_qvar_names (bind, (qrev,_)) l = try Some (Libnames.qualid_of_ident (Option.get (QVar.Map.find l qrev).uname)) with Not_found | Option.IsNone -> None (* no global qvars *) let qualid_of_level_names (bind, (_,urev)) l = try Some (Libnames.qualid_of_ident (Option.get (Level.Map.find l urev).uname)) with Not_found | Option.IsNone -> UnivNames.qualid_of_level bind l let qualid_of_level uctx l = qualid_of_level_names uctx.names l let pr_uctx_qvar_names names l = match qualid_of_qvar_names names l with | Some qid -> Libnames.pr_qualid qid | None -> QVar.raw_pr l let pr_uctx_level_names names l = match qualid_of_level_names names l with | Some qid -> Libnames.pr_qualid qid | None -> Level.raw_pr l let pr_uctx_level uctx l = pr_uctx_level_names uctx.names l let pr_uctx_qvar uctx l = pr_uctx_qvar_names uctx.names l let merge_constraints uctx cstrs g = try UGraph.merge_constraints cstrs g with UGraph.UniverseInconsistency (_, i) -> let printers = (pr_uctx_qvar uctx, pr_uctx_level uctx) in raise (UGraph.UniverseInconsistency (Some printers, i)) let uname_union s t = if s == t then s else UNameMap.merge (fun k l r -> match l, r with | Some _, _ -> l | _, _ -> r) s t let names_union ((qbind,ubind),(qrev,urev)) ((qbind',ubind'),(qrev',urev')) = let qbind = uname_union qbind qbind' and ubind = uname_union ubind ubind' and qrev = QVar.Map.union (fun _ l _ -> Some l) qrev qrev' and urev = Level.Map.lunion urev urev' in ((qbind,ubind),(qrev,urev)) let union uctx uctx' = if uctx == uctx' then uctx else if is_empty uctx' then uctx else let local = ContextSet.union uctx.local uctx'.local in let seff = Level.Set.union uctx.seff_univs uctx'.seff_univs in let names = names_union uctx.names uctx'.names in let newus = Level.Set.diff (ContextSet.levels uctx'.local) (ContextSet.levels uctx.local) in let newus = Level.Set.diff newus (UnivFlex.domain uctx.univ_variables) in let extra = UnivMinim.extra_union uctx.minim_extra uctx'.minim_extra in let declarenew g = Level.Set.fold (fun u g -> UGraph.add_universe u ~lbound:UGraph.Bound.Set ~strict:false g) newus g in let fail_union s q1 q2 = if UGraph.type_in_type uctx.universes then s else CErrors.user_err Pp.(str "Could not merge universe contexts: could not unify" ++ spc() ++ Quality.raw_pr q1 ++ strbrk " and " ++ Quality.raw_pr q2 ++ str ".") in { names; local = local; seff_univs = seff; univ_variables = UnivFlex.biased_union uctx.univ_variables uctx'.univ_variables; sort_variables = QState.union ~fail:fail_union uctx.sort_variables uctx'.sort_variables; initial_universes = declarenew uctx.initial_universes; universes = (if local == uctx.local then uctx.universes else let cstrsr = ContextSet.constraints uctx'.local in merge_constraints uctx cstrsr (declarenew uctx.universes)); minim_extra = extra} let context_set uctx = uctx.local let sort_context_set uctx = let us, csts = uctx.local in (QState.undefined uctx.sort_variables, us), csts let constraints uctx = snd uctx.local let compute_instance_binders (qrev,urev) inst = let qinst, uinst = Instance.to_array inst in let qmap = function | QVar q -> begin try Name (Option.get (QVar.Map.find q qrev).uname) with Option.IsNone | Not_found -> Anonymous end | QConstant _ -> assert false in let umap lvl = try Name (Option.get (Level.Map.find lvl urev).uname) with Option.IsNone | Not_found -> Anonymous in Array.map qmap qinst, Array.map umap uinst let context uctx = let qvars = QState.undefined uctx.sort_variables in UContext.of_context_set (compute_instance_binders (snd uctx.names)) qvars uctx.local type named_universes_entry = universes_entry * UnivNames.universe_binders let univ_entry ~poly uctx = let (binders, _) = uctx.names in let entry = if poly then Polymorphic_entry (context uctx) else Monomorphic_entry (context_set uctx) in entry, binders let of_context_set ((qs,us),csts) = let sort_variables = QState.of_set qs in { empty with local = (us,csts); sort_variables;} type universe_opt_subst = UnivFlex.t let subst uctx = uctx.univ_variables let ugraph uctx = uctx.universes let initial_graph uctx = uctx.initial_universes let is_algebraic l uctx = UnivFlex.is_algebraic l uctx.univ_variables let of_names (ubind,(revqbind,revubind)) = let revqbind = QVar.Map.map (fun id -> { uname = Some id; uloc = None }) revqbind in let revubind = Level.Map.map (fun id -> { uname = Some id; uloc = None }) revubind in {empty with names = (ubind,(revqbind,revubind))} let universe_of_name uctx s = UNameMap.find s (snd (fst uctx.names)) let quality_of_name uctx s = Id.Map.find s (fst (fst uctx.names)) let name_level level id uctx = let ((qbind,ubind),(qrev,urev)) = uctx.names in assert(not(Id.Map.mem id ubind)); let ubind = Id.Map.add id level ubind in let urev = Level.Map.add level { uname = Some id; uloc = None } urev in { uctx with names = ((qbind,ubind),(qrev,urev)) } let universe_binders uctx = let named, _ = uctx.names in named let nf_qvar uctx q = QState.repr q uctx.sort_variables let instantiate_variable l (b : Universe.t) v = v := UnivFlex.define l b !v exception UniversesDiffer let { Goptions.get = weak_constraints } = Goptions.declare_bool_option_and_ref ~key:["Cumulativity";"Weak";"Constraints"] ~value:true () let level_inconsistency cst l r = let mk u = Sorts.sort_of_univ @@ Universe.make u in raise (UGraph.UniverseInconsistency (None, (cst, mk l, mk r, None))) let nf_universe uctx u = UnivSubst.(subst_univs_universe (UnivFlex.normalize_univ_variable uctx.univ_variables)) u let nf_level uctx u = UnivSubst.(level_subst_of (UnivFlex.normalize_univ_variable uctx.univ_variables)) u let nf_instance uctx u = Instance.subst_fn (nf_qvar uctx, nf_level uctx) u let nf_quality uctx q = Quality.subst (nf_qvar uctx) q let nf_sort uctx s = let normalize u = nf_universe uctx u in let qnormalize q = QState.repr q uctx.sort_variables in Sorts.subst_fn (qnormalize, normalize) s let nf_relevance uctx r = match r with | Relevant | Irrelevant -> r | RelevanceVar q -> match nf_qvar uctx q with | QConstant QSProp -> Sorts.Irrelevant | QConstant QProp | QConstant QType -> Sorts.Relevant | QVar q' -> (* XXX currently not used in nf_evars_and_universes_opt_subst does it matter? *) if QState.is_above_prop q' uctx.sort_variables then Relevant else if QVar.equal q q' then r else Sorts.RelevanceVar q' let nf_universes uctx c = let lsubst = uctx.univ_variables in let nf_univ u = UnivFlex.normalize_univ_variable lsubst u in let rec self () c = match Constr.kind c with | Evar (evk, args) -> let args' = SList.Smart.map (self ()) args in if args == args' then c else Constr.mkEvar (evk, args') | _ -> UnivSubst.map_universes_opt_subst_with_binders ignore self (nf_qvar uctx) nf_univ () c in self () c type small_universe = USet | UProp | USProp let is_uset = function USet -> true | UProp | USProp -> false type sort_classification = | USmall of small_universe (* Set, Prop or SProp *) | ULevel of Level.t (* Var or Global *) | UMax of Universe.t * Level.Set.t (* Max of Set, Var, Global without increments *) | UAlgebraic of Universe.t (* Arbitrary algebraic expression *) let classify s = match s with | Prop -> USmall UProp | SProp -> USmall USProp | Set -> USmall USet | Type u | QSort (_, u) -> if Universe.is_levels u then match Universe.level u with | None -> UMax (u, Universe.levels u) | Some u -> ULevel u else UAlgebraic u type local = { local_cst : Constraints.t; local_above_prop : Level.Set.t; local_weak : UPairSet.t; local_sorts : QState.t; } let add_local cst local = { local with local_cst = Constraints.add cst local.local_cst } (* Constraint with algebraic on the left and a single level on the right *) let enforce_leq_up u v local = { local with local_cst = UnivSubst.enforce_leq u (Universe.make v) local.local_cst } let get_constraint = function | Conversion.CONV -> Eq | Conversion.CUMUL -> Le let unify_quality univs c s1 s2 l = let fail () = if UGraph.type_in_type univs then l.local_sorts else sort_inconsistency (get_constraint c) s1 s2 in { l with local_sorts = QState.unify_quality ~fail c (Sorts.quality s1) (Sorts.quality s2) l.local_sorts; } let process_universe_constraints uctx cstrs = let open UnivSubst in let open UnivProblem in let univs = uctx.universes in let vars = ref uctx.univ_variables in let normalize u = UnivFlex.normalize_univ_variable !vars u in let qnormalize sorts q = QState.repr q sorts in let normalize_sort sorts s = Sorts.subst_fn ((qnormalize sorts), subst_univs_universe normalize) s in let nf_constraint sorts = function | QLeq (a, b) -> QLeq (Quality.subst (qnormalize sorts) a, Quality.subst (qnormalize sorts) b) | QEq (a, b) -> QEq (Quality.subst (qnormalize sorts) a, Quality.subst (qnormalize sorts) b) | ULub (u, v) -> ULub (level_subst_of normalize u, level_subst_of normalize v) | UWeak (u, v) -> UWeak (level_subst_of normalize u, level_subst_of normalize v) | UEq (u, v) -> UEq (normalize_sort sorts u, normalize_sort sorts v) | ULe (u, v) -> ULe (normalize_sort sorts u, normalize_sort sorts v) in let is_local l = UnivFlex.mem l !vars in let equalize_small l s local = let ls = match l with | USProp -> sprop | UProp -> prop | USet -> set in if UGraph.check_eq_sort univs ls s then local else if is_uset l then match classify s with | USmall _ -> sort_inconsistency Eq set s | ULevel r -> if is_local r then let () = instantiate_variable r Universe.type0 vars in add_local (Level.set, Eq, r) local else sort_inconsistency Eq set s | UMax (u, _)| UAlgebraic u -> if univ_level_mem Level.set u then let inst = univ_level_rem Level.set u u in enforce_leq_up inst Level.set local else sort_inconsistency Eq ls s else sort_inconsistency Eq ls s in let equalize_variables fo l' r' local = if Level.equal l' r' then local else let () = if is_local l' then instantiate_variable l' (Universe.make r') vars else if is_local r' then instantiate_variable r' (Universe.make l') vars else if not (UnivProblem.check_eq_level univs l' r') then (* Two rigid/global levels, none of them being local, one of them being Prop/Set, disallow *) if Level.is_set l' || Level.is_set r' then level_inconsistency Eq l' r' else if fo then raise UniversesDiffer in add_local (l', Eq, r') local in let equalize_algebraic l ru local = let alg = UnivFlex.is_algebraic l uctx.univ_variables in let inst = univ_level_rem l ru ru in if alg && not (Level.Set.mem l (Universe.levels inst)) then let () = instantiate_variable l inst vars in local else if univ_level_mem l ru then enforce_leq_up inst l local else sort_inconsistency Eq (sort_of_univ (Universe.make l)) (sort_of_univ ru) in let equalize_universes l r local = match classify l, classify r with | USmall l', (USmall _ | ULevel _ | UMax _ | UAlgebraic _) -> equalize_small l' r local | (ULevel _ | UMax _ | UAlgebraic _), USmall r' -> equalize_small r' l local | ULevel l', ULevel r' -> equalize_variables false l' r' local | ULevel l', (UAlgebraic r | UMax (r, _)) | (UAlgebraic r | UMax (r, _)), ULevel l' -> equalize_algebraic l' r local | (UAlgebraic _ | UMax _), (UAlgebraic _ | UMax _) -> (* both are algebraic *) if UGraph.check_eq_sort univs l r then local else sort_inconsistency Eq l r in let unify_universes cst local = let cst = nf_constraint local.local_sorts cst in if UnivProblem.is_trivial cst then local else match cst with | QEq (a, b) -> (* TODO sort_inconsistency should be able to handle raw qualities instead of having to make a dummy sort *) let mk q = Sorts.make q Universe.type0 in unify_quality univs CONV (mk a) (mk b) local | QLeq (a, b) -> (* TODO sort_inconsistency should be able to handle raw qualities instead of having to make a dummy sort *) let mk q = Sorts.make q Universe.type0 in unify_quality univs CUMUL (mk a) (mk b) local | ULe (l, r) -> let local = unify_quality univs CUMUL l r local in let l = normalize_sort local.local_sorts l in let r = normalize_sort local.local_sorts r in begin match classify r with | UAlgebraic _ | UMax _ -> if UGraph.check_leq_sort univs l r then local else sort_inconsistency Le l r ~explain:(Pp.str "(cannot handle algebraic on the right)") | USmall r' -> (* Invariant: there are no universes u <= Set in the graph. Except for template levels, Set <= u anyways. Otherwise, for template levels, any constraint u <= Set is turned into u := Set. *) if UGraph.type_in_type univs then local else begin match classify l with | UAlgebraic _ -> (* l contains a +1 and r=r' small so l <= r impossible *) sort_inconsistency Le l r | USmall l' -> if UGraph.check_leq_sort univs l r then local else sort_inconsistency Le l r | ULevel l' -> if is_uset r' && is_local l' then (* Unbounded universe constrained from above, we equalize it *) let () = instantiate_variable l' Universe.type0 vars in add_local (l', Eq, Level.set) local else sort_inconsistency Le l r | UMax (_, levels) -> if is_uset r' then let fold l' local = let l = sort_of_univ @@ Universe.make l' in if Level.is_set l' || is_local l' then equalize_variables false l' Level.set local else sort_inconsistency Le l r in Level.Set.fold fold levels local else sort_inconsistency Le l r end | ULevel r' -> (* We insert the constraint in the graph even if the graph already contains it. Indeed, checking the existence of the constraint is costly when the constraint does not already exist directly as a single edge in the graph, but adding an edge in the graph which is implied by others is cheap. Hence, by doing this, we avoid a costly check here, and make further checks of this constraint easier since it will exist directly in the graph. *) match classify l with | USmall UProp -> { local with local_above_prop = Level.Set.add r' local.local_above_prop } | USmall USProp -> if UGraph.type_in_type univs then local else sort_inconsistency Le l r | USmall USet -> add_local (Level.set, Le, r') local | ULevel l' -> add_local (l', Le, r') local | UAlgebraic l -> enforce_leq_up l r' local | UMax (_, l) -> Univ.Level.Set.fold (fun l' accu -> add_local (l', Le, r') accu) l local end | ULub (l, r) -> equalize_variables true l r local | UWeak (l, r) -> if weak_constraints () then { local with local_weak = UPairSet.add (l, r) local.local_weak } else local | UEq (l, r) -> let local = unify_quality univs CONV l r local in let l = normalize_sort local.local_sorts l in let r = normalize_sort local.local_sorts r in 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 UGraph.UniverseInconsistency _ -> local in let local = { local_cst = Constraints.empty; local_weak = uctx.minim_extra.UnivMinim.weak_constraints; local_above_prop = uctx.minim_extra.UnivMinim.above_prop; local_sorts = uctx.sort_variables; } in let local = UnivProblem.Set.fold unify_universes cstrs local in let extra = { UnivMinim.above_prop = local.local_above_prop; UnivMinim.weak_constraints = local.local_weak } in !vars, extra, local.local_cst, local.local_sorts let add_universe_constraints uctx cstrs = let univs, local = uctx.local in let vars, extra, local', sorts = process_universe_constraints uctx cstrs in { uctx with local = (univs, Constraints.union local local'); univ_variables = vars; universes = merge_constraints uctx local' uctx.universes; sort_variables = sorts; minim_extra = extra; } let problem_of_constraints cstrs = Constraints.fold (fun (l,d,r) acc -> let l = Universe.make l and r = sort_of_univ @@ Universe.make r in let cstr' = let open UnivProblem in match d with | Lt -> ULe (sort_of_univ @@ Universe.super l, r) | Le -> ULe (sort_of_univ l, r) | Eq -> UEq (sort_of_univ l, r) in UnivProblem.Set.add cstr' acc) cstrs UnivProblem.Set.empty let add_constraints uctx cstrs = let cstrs = problem_of_constraints cstrs in add_universe_constraints uctx cstrs let add_quconstraints uctx (qcstrs,ucstrs) = let cstrs = problem_of_constraints ucstrs in let cstrs = QConstraints.fold (fun (l,d,r) cstrs -> match d with | Equal -> UnivProblem.Set.add (QEq (l,r)) cstrs | Leq -> UnivProblem.Set.add (QLeq (l,r)) cstrs) qcstrs cstrs in add_universe_constraints uctx cstrs let check_qconstraints uctx csts = Sorts.QConstraints.for_all (fun (l,k,r) -> let l = nf_quality uctx l in let r = nf_quality uctx r in if Quality.equal l r then true else match l,k,r with | _, Equal, _ -> false | QConstant QProp, Leq, QConstant QType -> true | QConstant QProp, Leq, QVar q -> QState.is_above_prop q uctx.sort_variables | _, Leq, _ -> false) csts let check_universe_constraint uctx (c:UnivProblem.t) = match c with | QEq (a,b) -> let a = nf_quality uctx a in let b = nf_quality uctx b in Quality.equal a b | QLeq (a,b) -> let a = nf_quality uctx a in let b = nf_quality uctx b in if Quality.equal a b then true else begin match a, b with | QConstant QProp, QConstant QType -> true | QConstant QProp, QVar q -> QState.is_above_prop q uctx.sort_variables | _ -> false end | ULe (u,v) -> UGraph.check_leq_sort uctx.universes u v | UEq (u,v) -> UGraph.check_eq_sort uctx.universes u v | ULub (u,v) -> UGraph.check_eq_level uctx.universes u v | UWeak _ -> true let check_universe_constraints uctx csts = UnivProblem.Set.for_all (check_universe_constraint uctx) csts let constrain_variables diff uctx = let local, vars = UnivFlex.constrain_variables diff uctx.univ_variables uctx.local in { uctx with local; univ_variables = vars } type ('a, 'b, 'c) gen_universe_decl = { univdecl_qualities : 'a; univdecl_extensible_qualities : bool; univdecl_instance : 'b; (* Declared universes *) univdecl_extensible_instance : bool; (* Can new universes be added *) univdecl_constraints : 'c; (* Declared constraints *) univdecl_extensible_constraints : bool (* Can new constraints be added *) } type universe_decl = (QVar.t list, Level.t list, Constraints.t) gen_universe_decl let default_univ_decl = { univdecl_qualities = []; (* in practice non named qualities will get collapsed for toplevel definitions, but side effects see named qualities from the surrounding definitions while using default_univ_decl *) univdecl_extensible_qualities = true; univdecl_instance = []; univdecl_extensible_instance = true; univdecl_constraints = Constraints.empty; univdecl_extensible_constraints = true } let pr_error_unbound_universes quals univs names = let open Pp in let nqs = QVar.Set.cardinal quals in let prqvar q = let info = QVar.Map.find_opt q (fst (snd names)) in h (pr_uctx_qvar_names names q ++ (match info with | None | Some {uloc=None} -> mt () | Some {uloc=Some loc} -> spc() ++ str"(" ++ Loc.pr loc ++ str")")) in let nus = Level.Set.cardinal univs in let prlev u = let info = Level.Map.find_opt u (snd (snd names)) in h (pr_uctx_level_names names u ++ (match info with | None | Some {uloc=None} -> mt () | Some {uloc=Some loc} -> spc() ++ str"(" ++ Loc.pr loc ++ str")")) in let ppqs = if nqs > 0 then str (if nqs = 1 then "Quality" else "Qualities") ++ spc () ++ prlist_with_sep spc prqvar (QVar.Set.elements quals) else mt() in let ppus = if nus > 0 then let universe_s = CString.plural nus "universe" in let universe_s = if nqs = 0 then CString.capitalize_ascii universe_s else universe_s in str universe_s ++ spc () ++ prlist_with_sep spc prlev (Level.Set.elements univs) else mt() in (hv 0 (ppqs ++ (if nqs > 0 && nus > 0 then strbrk " and " else mt()) ++ ppus ++ spc () ++ str (CString.conjugate_verb_to_be (nus + nqs)) ++ str" unbound.")) exception UnboundUnivs of QVar.Set.t * Level.Set.t * univ_names (* Deliberately using no location as the location of the univs doesn't correspond to the failing command. *) let error_unbound_universes qs us uctx = raise (UnboundUnivs (qs,us,uctx)) let _ = CErrors.register_handler (function | UnboundUnivs (qs,us,uctx) -> Some (pr_error_unbound_universes qs us uctx) | _ -> None) let universe_context_inst decl qvars levels names = let leftqs = List.fold_left (fun acc l -> QVar.Set.remove l acc) qvars decl.univdecl_qualities in let leftus = List.fold_left (fun acc l -> Level.Set.remove l acc) levels decl.univdecl_instance in let () = let unboundqs = if decl.univdecl_extensible_qualities then QVar.Set.empty else leftqs in let unboundus = if decl.univdecl_extensible_instance then Level.Set.empty else leftus in if not (QVar.Set.is_empty unboundqs && Level.Set.is_empty unboundus) then error_unbound_universes unboundqs unboundus names in let leftqs = UContext.sort_qualities (Array.map_of_list (fun q -> Quality.QVar q) (QVar.Set.elements leftqs)) in let leftus = UContext.sort_levels (Array.of_list (Level.Set.elements leftus)) in let instq = Array.append (Array.map_of_list (fun q -> Quality.QVar q) decl.univdecl_qualities) leftqs in let instu = Array.append (Array.of_list decl.univdecl_instance) leftus in let inst = Instance.of_array (instq,instu) in inst let check_universe_context_set ~prefix levels names = let left = List.fold_left (fun left l -> Level.Set.remove l left) levels prefix in if not (Level.Set.is_empty left) then error_unbound_universes QVar.Set.empty left names let check_implication uctx cstrs cstrs' = let gr = initial_graph uctx in let grext = merge_constraints uctx cstrs gr in let cstrs' = Constraints.filter (fun c -> not (UGraph.check_constraint grext c)) cstrs' in if Constraints.is_empty cstrs' then () else CErrors.user_err Pp.(str "Universe constraints are not implied by the ones declared: " ++ Constraints.pr (pr_uctx_level uctx) cstrs') let check_mono_univ_decl uctx decl = (* Note: if [decl] is [default_univ_decl], behave like [uctx.local] *) let () = if not (List.is_empty decl.univdecl_qualities) || not (QVar.Set.is_empty (QState.undefined uctx.sort_variables)) then CErrors.user_err Pp.(str "Monomorphic declarations may not have sort variables.") in let levels, csts = uctx.local in let () = let prefix = decl.univdecl_instance in if not decl.univdecl_extensible_instance then check_universe_context_set ~prefix levels uctx.names in if decl.univdecl_extensible_constraints then uctx.local else begin check_implication uctx decl.univdecl_constraints csts; levels, decl.univdecl_constraints end let check_poly_univ_decl uctx decl = (* Note: if [decl] is [default_univ_decl], behave like [context uctx] *) let levels, csts = uctx.local in let qvars = QState.undefined uctx.sort_variables in let inst = universe_context_inst decl qvars levels uctx.names in let nas = compute_instance_binders (snd uctx.names) inst in let csts = if decl.univdecl_extensible_constraints then csts else begin check_implication uctx decl.univdecl_constraints csts; decl.univdecl_constraints end in let uctx = UContext.make nas (inst, csts) in uctx let check_univ_decl ~poly uctx decl = let (binders, _) = uctx.names in let entry = if poly then Polymorphic_entry (check_poly_univ_decl uctx decl) else Monomorphic_entry (check_mono_univ_decl uctx decl) in entry, binders let is_bound l lbound = match lbound with | UGraph.Bound.Prop -> false | UGraph.Bound.Set -> Level.is_set l let restrict_universe_context ?(lbound = UGraph.Bound.Set) (univs, csts) keep = let removed = Level.Set.diff univs keep in if Level.Set.is_empty removed then univs, csts else let allunivs = Constraints.fold (fun (u,_,v) all -> Level.Set.add u (Level.Set.add v all)) csts univs in let g = UGraph.initial_universes in let g = Level.Set.fold (fun v g -> if Level.is_set v then g else UGraph.add_universe v ~lbound ~strict:false g) allunivs g in let g = UGraph.merge_constraints csts g in let allkept = Level.Set.union (UGraph.domain UGraph.initial_universes) (Level.Set.diff allunivs removed) in let csts = UGraph.constraints_for ~kept:allkept g in let csts = Constraints.filter (fun (l,d,r) -> not (is_bound l lbound && d == Le)) csts in (Level.Set.inter univs keep, csts) let restrict ?lbound uctx vars = let vars = Level.Set.union vars uctx.seff_univs in let vars = Id.Map.fold (fun na l vars -> Level.Set.add l vars) (snd (fst uctx.names)) vars in let uctx' = restrict_universe_context ?lbound uctx.local vars in { uctx with local = uctx' } let restrict_even_binders ?lbound uctx vars = let vars = Level.Set.union vars uctx.seff_univs in let uctx' = restrict_universe_context ?lbound uctx.local vars in { uctx with local = uctx' } let restrict_constraints uctx csts = let levels, _ = uctx.local in let uctx' = { uctx with local = ContextSet.of_set levels; universes = uctx.initial_universes } in add_constraints uctx' csts type rigid = | UnivRigid | UnivFlexible of bool (** Is substitution by an algebraic ok? *) let univ_rigid = UnivRigid let univ_flexible = UnivFlexible false let univ_flexible_alg = UnivFlexible true (** ~sideff indicates that it is ok to redeclare a universe. Also merges the universe context in the local constraint structures and not only in the graph. *) let merge ?loc ~sideff rigid uctx uctx' = let levels = ContextSet.levels uctx' in let local = ContextSet.append uctx' uctx.local in let declare g = Level.Set.fold (fun u g -> try UGraph.add_universe ~lbound:UGraph.Bound.Set ~strict:false u g with UGraph.AlreadyDeclared when sideff -> g) levels g in let names = let fold u accu = let update = function | None -> Some { uname = None; uloc = loc } | Some info -> match info.uloc with | None -> Some { info with uloc = loc } | Some _ -> Some info in Level.Map.update u update accu in (fst uctx.names, (fst (snd uctx.names), Level.Set.fold fold levels (snd (snd uctx.names)))) in let initial = declare uctx.initial_universes in let univs = declare uctx.universes in let universes = merge_constraints uctx (ContextSet.constraints uctx') univs in let uctx = match rigid with | UnivRigid -> uctx | UnivFlexible b -> assert (not sideff); let uvars' = UnivFlex.add_levels levels ~algebraic:b uctx.univ_variables in { uctx with univ_variables = uvars' } in { uctx with names; local; universes; initial_universes = initial } let merge_sort_variables ?loc ~sideff uctx qvars = let sort_variables = QVar.Set.fold (fun qv qstate -> QState.add ~check_fresh:(not sideff) ~named:false qv qstate) qvars uctx.sort_variables in let names = let fold u accu = let update = function | None -> Some { uname = None; uloc = loc } | Some info -> match info.uloc with | None -> Some { info with uloc = loc } | Some _ -> Some info in QVar.Map.update u update accu in let qrev = QVar.Set.fold fold qvars (fst (snd uctx.names)) in (fst uctx.names, (qrev, snd (snd uctx.names))) in { uctx with sort_variables; names } let merge_sort_context ?loc ~sideff rigid uctx ((qvars,levels),csts) = let uctx = merge_sort_variables ?loc ~sideff uctx qvars in merge ?loc ~sideff rigid uctx (levels,csts) (* Check bug_4363 and bug_6323 when changing this code *) let demote_seff_univs univs uctx = let seff = Level.Set.union uctx.seff_univs univs in { uctx with seff_univs = seff } let demote_global_univs env uctx = let env_ugraph = Environ.universes env in let mem_univ u ugraph = match UGraph.check_declared_universes ugraph (Level.Set.singleton u) with | () -> true | exception (UGraph.UndeclaredLevel _) -> false in let mem_constraints (u, _, v as cst) ugraph = mem_univ u ugraph && mem_univ v ugraph && UGraph.check_constraint ugraph cst in let filter_univs u = not (mem_univ u env_ugraph) in let filter_constraints cst = not (mem_constraints cst env_ugraph) in let (local_univs, local_constraints) = uctx.local in (* local_univs minus univs(env_ugraph) *) let new_univs = Level.Set.filter filter_univs local_univs in (* local_constraints minus constraints(env_ugraph) *) let new_constraints = Constraints.filter filter_constraints local_constraints in { uctx with local = (new_univs, new_constraints) } let merge_seff uctx uctx' = let levels = ContextSet.levels uctx' in let declare g = Level.Set.fold (fun u g -> try UGraph.add_universe ~lbound:UGraph.Bound.Set ~strict:false u g with UGraph.AlreadyDeclared -> g) levels g in let initial_universes = declare uctx.initial_universes in let univs = declare uctx.universes in let universes = merge_constraints uctx (ContextSet.constraints uctx') univs in { uctx with universes; initial_universes } let emit_side_effects eff u = let uctx = Safe_typing.universes_of_private eff in let u = demote_seff_univs (fst uctx) u in merge_seff u uctx let update_sigma_univs uctx univs = let eunivs = { uctx with initial_universes = univs; universes = univs } in merge_seff eunivs eunivs.local let add_qnames ?loc s l ((qnames,unames), (qnames_rev,unames_rev)) = if Id.Map.mem s qnames then user_err ?loc Pp.(str "Quality " ++ Id.print s ++ str" already bound."); ((Id.Map.add s l qnames, unames), (QVar.Map.add l { uname = Some s; uloc = loc } qnames_rev, unames_rev)) let add_names ?loc s l ((qnames,unames), (qnames_rev,unames_rev)) = if UNameMap.mem s unames then user_err ?loc Pp.(str "Universe " ++ Id.print s ++ str" already bound."); ((qnames,UNameMap.add s l unames), (qnames_rev, Level.Map.add l { uname = Some s; uloc = loc } unames_rev)) let add_qloc l loc (names, (qnames_rev,unames_rev) as orig) = match loc with | None -> orig | Some _ -> (names, (QVar.Map.add l { uname = None; uloc = loc } qnames_rev, unames_rev)) let add_loc l loc (names, (qnames_rev,unames_rev) as orig) = match loc with | None -> orig | Some _ -> (names, (qnames_rev, Level.Map.add l { uname = None; uloc = loc } unames_rev)) let add_universe ?loc name strict uctx u = let lbound = UGraph.Bound.Set in let initial_universes = UGraph.add_universe ~lbound ~strict u uctx.initial_universes in let universes = UGraph.add_universe ~lbound ~strict u uctx.universes in let local = ContextSet.add_universe u uctx.local in let names = match name with | Some n -> add_names ?loc n u uctx.names | None -> add_loc u loc uctx.names in { uctx with names; local; initial_universes; universes } let new_sort_variable ?loc ?name uctx = let q = UnivGen.new_sort_global () in (* don't need to check_fresh as it's guaranteed new *) let sort_variables = QState.add ~check_fresh:false ~named:(Option.has_some name) q uctx.sort_variables in let names = match name with | Some n -> add_qnames ?loc n q uctx.names | None -> add_qloc q loc uctx.names in { uctx with sort_variables; names }, q let new_univ_variable ?loc rigid name uctx = let u = UnivGen.fresh_level () in let uctx = match rigid with | UnivRigid -> uctx | UnivFlexible algebraic -> let univ_variables = UnivFlex.add u ~algebraic uctx.univ_variables in { uctx with univ_variables } in let uctx = add_universe ?loc name false uctx u in uctx, u let add_global_univ uctx u = add_universe None true uctx u let make_with_initial_binders ~lbound univs binders = let uctx = make ~lbound univs in List.fold_left (fun uctx { CAst.loc; v = id } -> fst (new_univ_variable ?loc univ_rigid (Some id) uctx)) uctx binders let from_env ?(binders=[]) env = make_with_initial_binders ~lbound:UGraph.Bound.Set (Environ.universes env) binders let make_nonalgebraic_variable uctx u = { uctx with univ_variables = UnivFlex.make_nonalgebraic_variable uctx.univ_variables u } let make_flexible_nonalgebraic uctx = { uctx with univ_variables = UnivFlex.make_all_undefined_nonalgebraic uctx.univ_variables } let subst_univs_context_with_def def usubst (uctx, cst) = (Level.Set.diff uctx def, UnivSubst.subst_univs_constraints usubst cst) let normalize_variables uctx = let normalized_variables, def, subst = UnivFlex.normalize_univ_variables uctx.univ_variables in let uctx_local = subst_univs_context_with_def def subst uctx.local in let univs = UGraph.merge_constraints (snd uctx_local) uctx.initial_universes in { uctx with local = uctx_local; univ_variables = normalized_variables; universes = univs } let fix_undefined_variables uctx = { uctx with univ_variables = UnivFlex.fix_undefined_variables uctx.univ_variables } let collapse_sort_variables uctx = { uctx with sort_variables = QState.collapse uctx.sort_variables } let minimize ?(lbound = UGraph.Bound.Set) uctx = let open UnivMinim in let (vars', us') = normalize_context_set ~lbound uctx.universes uctx.local uctx.univ_variables uctx.minim_extra in if ContextSet.equal us' uctx.local then uctx else let universes = UGraph.merge_constraints (snd us') uctx.initial_universes in { names = uctx.names; local = us'; seff_univs = uctx.seff_univs; (* not sure about this *) univ_variables = vars'; sort_variables = uctx.sort_variables; universes = universes; initial_universes = uctx.initial_universes; minim_extra = UnivMinim.empty_extra; (* weak constraints are consumed *) } let universe_context_inst_decl decl qvars levels names = let leftqs = List.fold_left (fun acc l -> QVar.Set.remove l acc) qvars decl.univdecl_qualities in let leftus = List.fold_left (fun acc l -> Level.Set.remove l acc) levels decl.univdecl_instance in let () = let unboundqs = if decl.univdecl_extensible_qualities then QVar.Set.empty else leftqs in let unboundus = if decl.univdecl_extensible_instance then Level.Set.empty else leftus in if not (QVar.Set.is_empty unboundqs && Level.Set.is_empty unboundus) then error_unbound_universes unboundqs unboundus names in let instq = Array.map_of_list (fun q -> Quality.QVar q) decl.univdecl_qualities in let instu = Array.of_list decl.univdecl_instance in let inst = Instance.of_array (instq,instu) in inst let check_univ_decl_rev uctx decl = let levels, csts = uctx.local in let qvars = QState.undefined uctx.sort_variables in let inst = universe_context_inst_decl decl qvars levels uctx.names in let nas = compute_instance_binders (snd uctx.names) inst in let () = check_implication uctx csts decl.univdecl_constraints in let uctx = fix_undefined_variables uctx in let uctx, csts = if decl.univdecl_extensible_constraints then uctx, csts else restrict_constraints uctx decl.univdecl_constraints, decl.univdecl_constraints in let uctx' = UContext.make nas (inst, csts) in uctx, uctx' let check_uctx_impl ~fail uctx uctx' = let levels, csts = uctx'.local in let qvars_diff = QVar.Set.diff (QState.undefined uctx'.sort_variables) (QState.undefined uctx.sort_variables) in let levels_diff = Level.Set.diff levels (fst uctx.local) in let () = if not @@ (QVar.Set.is_empty qvars_diff && Level.Set.is_empty levels_diff) then error_unbound_universes qvars_diff levels_diff uctx'.names in let () = let grext = ugraph uctx in let cstrs' = Constraints.filter (fun c -> not (UGraph.check_constraint grext c)) csts in if Constraints.is_empty cstrs' then () else fail (Constraints.pr (pr_uctx_level uctx) cstrs') in () (* XXX print above_prop too *) let pr_weak prl {minim_extra={UnivMinim.weak_constraints=weak}} = let open Pp in prlist_with_sep fnl (fun (u,v) -> prl u ++ str " ~ " ++ prl v) (UPairSet.elements weak) let pr_sort_opt_subst uctx = QState.pr (pr_uctx_qvar uctx) uctx.sort_variables module Internal = struct let reboot env uctx = let uctx_global = from_env env in { uctx_global with univ_variables = uctx.univ_variables; sort_variables = uctx.sort_variables } end coq-8.20.0/engine/uState.mli000066400000000000000000000221751466560755400156310ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* UGraph.t -> t [@@ocaml.deprecated "Use from_env"] val make_with_initial_binders : lbound:UGraph.Bound.t -> UGraph.t -> lident list -> t [@@ocaml.deprecated "Use from_env"] val from_env : ?binders:lident list -> Environ.env -> t (** Main entry point at the beginning of a declaration declaring the binding names as rigid universes. *) val of_names : (UnivNames.universe_binders * UnivNames.rev_binders) -> t (** Main entry point when only names matter, e.g. for printing. *) val of_context_set : UnivGen.sort_context_set -> t (** Main entry point when starting from the instance of a global reference, e.g. when building a scheme. *) (** Misc *) val is_empty : t -> bool val union : t -> t -> t (** {5 Projections and other destructors} *) val context_set : t -> Univ.ContextSet.t (** The local context of the state, i.e. a set of bound variables together with their associated constraints. *) val sort_context_set : t -> UnivGen.sort_context_set type universe_opt_subst = UnivFlex.t (* Reexport because UnivSubst is private *) val subst : t -> UnivFlex.t (** The local universes that are unification variables *) val nf_universes : t -> Constr.t -> Constr.t (** Apply the local substitution [subst] *) val ugraph : t -> UGraph.t (** The current graph extended with the local constraints *) val initial_graph : t -> UGraph.t (** The initial graph with just the declarations of new universes. *) val is_algebraic : Level.t -> t -> bool (** Can this universe be instantiated with an algebraic universe (ie it appears in inferred types only). *) val constraints : t -> Univ.Constraints.t (** Shorthand for {!context_set} composed with {!ContextSet.constraints}. *) val context : t -> UVars.UContext.t (** Shorthand for {!context_set} with {!Context_set.to_context}. *) type named_universes_entry = universes_entry * UnivNames.universe_binders val univ_entry : poly:bool -> t -> named_universes_entry (** Pick from {!context} or {!context_set} based on [poly]. *) val universe_binders : t -> UnivNames.universe_binders (** Return local names of universes. *) val nf_qvar : t -> QVar.t -> Quality.t (** Returns the normal form of the sort variable. *) val nf_quality : t -> Quality.t -> Quality.t val nf_instance : t -> UVars.Instance.t -> UVars.Instance.t val nf_level : t -> Level.t -> Level.t (** Must not be allowed to be algebraic *) val nf_universe : t -> Universe.t -> Universe.t val nf_sort : t -> Sorts.t -> Sorts.t (** Returns the normal form of the sort. *) val nf_relevance : t -> relevance -> relevance (** Returns the normal form of the relevance. *) (** {5 Constraints handling} *) val add_constraints : t -> Univ.Constraints.t -> t (** @raise UniversesDiffer when universes differ *) val add_universe_constraints : t -> UnivProblem.Set.t -> t (** @raise UniversesDiffer when universes differ *) val check_qconstraints : t -> QConstraints.t -> bool val check_universe_constraints : t -> UnivProblem.Set.t -> bool val add_quconstraints : t -> QUConstraints.t -> t (** {5 Names} *) val quality_of_name : t -> Id.t -> Sorts.QVar.t val universe_of_name : t -> Id.t -> Univ.Level.t (** Retrieve the universe associated to the name. *) val name_level : Univ.Level.t -> Id.t -> t -> t (** Gives a name to the level (making it a binder). Asserts the name is not already used by a level *) (** {5 Unification} *) (** [restrict_universe_context lbound (univs,csts) keep] restricts [univs] to the universes in [keep]. The constraints [csts] are adjusted so that transitive constraints between remaining universes (those in [keep] and those not in [univs]) are preserved. *) val restrict_universe_context : ?lbound:UGraph.Bound.t -> ContextSet.t -> Level.Set.t -> ContextSet.t (** [restrict uctx ctx] restricts the local universes of [uctx] to [ctx] extended by local named universes and side effect universes (from [demote_seff_univs]). Transitive constraints between retained universes are preserved. *) val restrict : ?lbound:UGraph.Bound.t -> t -> Univ.Level.Set.t -> t (** [restrict_even_binders uctx ctx] restricts the local universes of [uctx] to [ctx] extended by side effect universes (from [demote_seff_univs]). Transitive constraints between retained universes are preserved. *) val restrict_even_binders : ?lbound:UGraph.Bound.t -> t -> Univ.Level.Set.t -> t type rigid = | UnivRigid | UnivFlexible of bool (** Is substitution by an algebraic ok? *) val univ_rigid : rigid val univ_flexible : rigid val univ_flexible_alg : rigid val merge : ?loc:Loc.t -> sideff:bool -> rigid -> t -> Univ.ContextSet.t -> t val merge_sort_variables : ?loc:Loc.t -> sideff:bool -> t -> QVar.Set.t -> t val merge_sort_context : ?loc:Loc.t -> sideff:bool -> rigid -> t -> UnivGen.sort_context_set -> t val emit_side_effects : Safe_typing.private_constants -> t -> t val demote_global_univs : Environ.env -> t -> t (** Removes from the uctx_local part of the UState the universes and constraints that are present in the universe graph in the input env (supposedly the global ones) *) val demote_seff_univs : Univ.Level.Set.t -> t -> t (** Mark the universes as not local any more, because they have been globally declared by some side effect. You should be using emit_side_effects instead. *) val new_sort_variable : ?loc:Loc.t -> ?name:Id.t -> t -> t * QVar.t (** Declare a new local sort. *) val new_univ_variable : ?loc:Loc.t -> rigid -> Id.t option -> t -> t * Univ.Level.t (** Declare a new local universe; use rigid if a global or bound universe; use flexible for a universe existential variable; use univ_flexible_alg for a universe existential variable allowed to be instantiated with an algebraic universe *) val add_global_univ : t -> Univ.Level.t -> t val make_nonalgebraic_variable : t -> Univ.Level.t -> t (** cf UnivFlex *) val make_flexible_nonalgebraic : t -> t (** cf UnivFlex *) val normalize_variables : t -> t val constrain_variables : Univ.Level.Set.t -> t -> t val fix_undefined_variables : t -> t (** cf UnivFlex *) (** Universe minimization *) val minimize : ?lbound:UGraph.Bound.t -> t -> t val collapse_sort_variables : t -> t type ('a, 'b, 'c) gen_universe_decl = { univdecl_qualities : 'a; univdecl_extensible_qualities : bool; univdecl_instance : 'b; (* Declared universes *) univdecl_extensible_instance : bool; (* Can new universes be added *) univdecl_constraints : 'c; (* Declared constraints *) univdecl_extensible_constraints : bool (* Can new constraints be added *) } type universe_decl = (QVar.t list, Level.t list, Univ.Constraints.t) gen_universe_decl val default_univ_decl : universe_decl (** [check_univ_decl ctx decl] If non extensible in [decl], check that the local universes (resp. universe constraints) in [ctx] are implied by [decl]. Return a [universes_entry] containing the local universes of [ctx] and their constraints. When polymorphic, the universes corresponding to [decl.univdecl_instance] come first in the order defined by that list. *) val check_univ_decl : poly:bool -> t -> universe_decl -> named_universes_entry val check_univ_decl_rev : t -> universe_decl -> t * UVars.UContext.t val check_uctx_impl : fail:(Pp.t -> unit) -> t -> t -> unit val check_mono_univ_decl : t -> universe_decl -> Univ.ContextSet.t (** {5 TODO: Document me} *) val update_sigma_univs : t -> UGraph.t -> t (** {5 Pretty-printing} *) val pr_uctx_level : t -> Univ.Level.t -> Pp.t val pr_uctx_qvar : t -> Sorts.QVar.t -> Pp.t val qualid_of_level : t -> Univ.Level.t -> Libnames.qualid option (** Only looks in the local names, not in the nametab. *) val id_of_level : t -> Univ.Level.t -> Id.t option val id_of_qvar : t -> Sorts.QVar.t -> Id.t option val pr_weak : (Univ.Level.t -> Pp.t) -> t -> Pp.t val pr_sort_opt_subst : t -> Pp.t module Internal : sig val reboot : Environ.env -> t -> t (** Madness-inducing hack dedicated to the handling of universes of Program. DO NOT USE OUTSIDE OF DEDICATED AREA. *) end coq-8.20.0/engine/univFlex.ml000066400000000000000000000102641466560755400160070ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* f l ~is_defined:(Option.has_some v) acc) subst acc let is_algebraic l {algs} = Level.Set.mem l algs let make_nonalgebraic_variable {subst;algs} l = { subst; algs = Level.Set.remove l algs } let make_all_undefined_nonalgebraic {subst;algs=_} = { subst; algs = Level.Set.empty } let fix_undefined_variables us = Level.Map.fold (fun u v ({subst; algs} as acc) -> match v with | None -> { subst = Level.Map.remove u subst; algs = Level.Set.remove u algs } | Some _ -> acc) us.subst us let add l ~algebraic {subst; algs} = let subst = Level.Map.update l (function | None -> Some None | Some _ -> assert false) subst in let algs = if algebraic then Level.Set.add l algs else algs in { subst; algs } let add_levels levels ~algebraic subst = Level.Set.fold (fun l subst -> add l ~algebraic subst) levels subst let define l v {subst;algs} = (* XXX update algs? *) let subst = try Level.Map.modify l (fun _ old -> assert (Option.is_empty old); Some v) subst with Not_found -> assert false in { subst; algs } let constrain_variables diff us ctx = (* XXX update algs? *) Level.Set.fold (fun l ((univs,cstrs),{subst;algs} as acc) -> match Level.Map.find_opt l subst with | None | Some None -> acc | Some (Some u) -> match Universe.level u with | None -> acc | Some u -> ((Level.Set.add l univs, Constraints.add (l, Eq, u) cstrs), {subst = Level.Map.remove l subst; algs})) diff (ctx,us) let biased_union {subst=lsubst;algs=lalgs} {subst=rsubst; algs=ralgs} = let subst = Level.Map.union (fun _k l r -> match l, r with | Some _, _ -> Some l | None, None -> Some l | _, _ -> Some r) lsubst rsubst in { subst; algs = Level.Set.union lalgs ralgs } let normalize_univ_variable ~find = let rec aux cur = find cur |> Option.map (fun b -> let b' = UnivSubst.subst_univs_universe aux b in if Universe.equal b' b then b else b') in aux let normalize_univ_variable ectx = let find l = Option.flatten (Univ.Level.Map.find_opt l ectx.subst) in normalize_univ_variable ~find let normalize_universe subst = let normlevel = normalize_univ_variable subst in UnivSubst.subst_univs_universe normlevel let normalize ctx = let normalize = normalize_universe ctx in let subst = Univ.Level.Map.mapi (fun u -> function | None -> None | Some v -> Some (normalize v)) ctx.subst in {subst; algs = ctx.algs} let normalize_univ_variables ctx = let ctx = normalize ctx in let def, subst = Univ.Level.Map.fold (fun u v (def, subst) -> match v with | None -> (def, subst) | Some b -> (Univ.Level.Set.add u def, Univ.Level.Map.add u b subst)) ctx.subst (Univ.Level.Set.empty, Univ.Level.Map.empty) in let subst l = Level.Map.find_opt l subst in ctx, def, subst let pr prl {subst; algs} = let open Pp in let ppsubst = Level.Map.pr prl (function | None -> mt() | Some x -> str " := " ++ Universe.pr prl x) subst in str"ALGEBRAIC UNIVERSES:"++brk(0,1)++ h (Level.Set.pr prl algs) ++ fnl() ++ str"FLEXIBLE UNIVERSES:"++brk(0,1)++ h ppsubst coq-8.20.0/engine/univFlex.mli000066400000000000000000000065141466560755400161630ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* bool val domain : t -> Level.Set.t (** Contains both defined and undefined flexible levels. *) val fold : (Level.t -> is_defined:bool -> 'a -> 'a) -> t -> 'a -> 'a (** For universe minimization. *) val mem : Level.t -> t -> bool (** Returns [true] for both defined and undefined flexible levels. *) val is_algebraic : Level.t -> t -> bool (** Is the level allowed to be defined by an algebraic universe? *) val make_nonalgebraic_variable : t -> Level.t -> t (** Make the level non algebraic. Undefined behaviour on already-defined algebraics. *) val make_all_undefined_nonalgebraic : t -> t (** Turn all undefined flexible algebraic variables into simply flexible ones. Can be used in case the variables might appear in universe instances (typically for polymorphic program obligations). *) val fix_undefined_variables : t -> t (** Make all undefined flexible levels into rigid levels, ie remove them. *) val add : Level.t -> algebraic:bool -> t -> t (** MAkes a level flexible with no definition. It must not already be flexible. *) val add_levels : Level.Set.t -> algebraic:bool -> t -> t (** Make the levels flexible with no definitions. They must not already be flexible. *) val define : Level.t -> Universe.t -> t -> t (** Define the level to the given universe. The level must already be flexible and must be undefined. *) val constrain_variables : Level.Set.t -> t -> ContextSet.t -> ContextSet.t * t (** [constrain_variables diff subst ctx] removes bindings [l := l'] from the substitution where [l] is in [diff] and [l'] is a level, and adds [l, l = l'] to [ctx]. *) val biased_union : t -> t -> t (** [biased_union x y] favors the bindings of the first map that are defined, otherwise takes the second's bindings. *) val normalize : t -> t (** Return an optimized representation of the input *) val normalize_univ_variables : t -> t * Level.Set.t * UnivSubst.universe_subst_fn (** As [normalize] and also returns the set of defined variables and a function which is equivalent to calling [normalize_univ_variable] on the substitution but may be faster. *) val normalize_univ_variable : t -> UnivSubst.universe_subst_fn (** Apply the substitution to a variable. *) val normalize_universe : t -> Universe.t -> Universe.t (** Apply the substitution to an algebraic universe. *) val pr : (Level.t -> Pp.t) -> t -> Pp.t (** "Show Universes"-style printing. *) coq-8.20.0/engine/univGen.ml000066400000000000000000000140661466560755400156260ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* let ppreal, ppexpected = if aq = 0 && eq = 0 then Pp.(int au, int eu) else Pp.(str "(" ++ int aq ++ str " | " ++ int au ++ str ")" , str "(" ++ int eq ++ str " | " ++ int eu ++ str ")") in Some Pp.(str "Universe instance length is " ++ ppreal ++ str " but should be " ++ ppexpected ++ str".") | _ -> None) (* Generator of levels *) let new_univ_id = let cnt = ref 0 in fun () -> incr cnt; !cnt let new_univ_global () = let s = if Flags.async_proofs_is_worker() then !Flags.async_proofs_worker_id else "" in Univ.UGlobal.make (Global.current_dirpath ()) s (new_univ_id ()) let fresh_level () = Univ.Level.make (new_univ_global ()) let new_sort_id = let cnt = ref 0 in fun () -> incr cnt; !cnt let new_sort_global () = let s = if Flags.async_proofs_is_worker() then !Flags.async_proofs_worker_id else "" in Sorts.QVar.make_unif s (new_sort_id ()) let fresh_instance auctx : _ in_sort_context_set = let qlen, ulen = AbstractContext.size auctx in let qinst = Array.init qlen (fun _ -> Sorts.Quality.QVar (new_sort_global())) in let uinst = Array.init ulen (fun _ -> fresh_level()) in let qctx = Array.fold_left (fun qctx q -> match q with | Sorts.Quality.QVar q -> Sorts.QVar.Set.add q qctx | _ -> assert false) Sorts.QVar.Set.empty qinst in let uctx = Array.fold_right Level.Set.add uinst Level.Set.empty in let inst = Instance.of_array (qinst,uinst) in inst, ((qctx,uctx), AbstractContext.instantiate inst auctx) let existing_instance ?loc auctx inst = let () = let actual = Instance.length inst and expect = AbstractContext.size auctx in if not (UVars.eq_sizes actual expect) then Loc.raise ?loc (UniverseLengthMismatch { actual; expect }) else () in inst, ((Sorts.QVar.Set.empty,Level.Set.empty), AbstractContext.instantiate inst auctx) let fresh_instance_from ?loc ctx = function | Some inst -> existing_instance ?loc ctx inst | None -> fresh_instance ctx (** Fresh universe polymorphic construction *) let fresh_global_instance ?loc ?names env gr = let auctx = Environ.universes_of_global env gr in let u, ctx = fresh_instance_from ?loc auctx names in u, ctx let fresh_constant_instance env c = let u, ctx = fresh_global_instance env (GlobRef.ConstRef c) in (c, u), ctx let fresh_inductive_instance env ind = let u, ctx = fresh_global_instance env (GlobRef.IndRef ind) in (ind, u), ctx let fresh_constructor_instance env c = let u, ctx = fresh_global_instance env (GlobRef.ConstructRef c) in (c, u), ctx let fresh_array_instance env = let auctx = CPrimitives.typ_univs CPrimitives.PT_array in let u, ctx = fresh_instance_from auctx None in u, ctx let fresh_global_instance ?loc ?names env gr = let u, ctx = fresh_global_instance ?loc ?names env gr in mkRef (gr, u), ctx let constr_of_monomorphic_global env gr = if not (Environ.is_polymorphic env gr) then fst (fresh_global_instance env gr) else CErrors.user_err Pp.(str "globalization of polymorphic reference " ++ Nametab.pr_global_env Id.Set.empty gr ++ str " would forget universes.") let fresh_sort_in_family = function | InSProp -> Sorts.sprop, empty_sort_context | InProp -> Sorts.prop, empty_sort_context | InSet -> Sorts.set, empty_sort_context | InType | InQSort (* Treat as Type *) -> let u = fresh_level () in sort_of_univ (Univ.Universe.make u), ((QVar.Set.empty,Level.Set.singleton u),Constraints.empty) let new_global_univ () = let u = fresh_level () in (Univ.Universe.make u, ContextSet.singleton u) let fresh_universe_context_set_instance ctx = if ContextSet.is_empty ctx then Level.Map.empty, ctx else let (univs, cst) = ContextSet.levels ctx, ContextSet.constraints ctx in let univs',subst = Level.Set.fold (fun u (univs',subst) -> let u' = fresh_level () in (Level.Set.add u' univs', Level.Map.add u u' subst)) univs (Level.Set.empty, Level.Map.empty) in let cst' = subst_univs_level_constraints subst cst in subst, (univs', cst') let fresh_sort_context_instance ((qs,us),csts) = let usubst, (us, csts) = fresh_universe_context_set_instance (us,csts) in let qsubst, qs = QVar.Set.fold (fun q (qsubst,qs) -> let q' = new_sort_global () in QVar.Map.add q (Sorts.Quality.QVar q') qsubst, QVar.Set.add q' qs) qs (QVar.Map.empty, QVar.Set.empty) in (qsubst, usubst), ((qs, us), csts) coq-8.20.0/engine/univGen.mli000066400000000000000000000062461466560755400160000ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* UGlobal.t val new_sort_global : unit -> Sorts.QVar.t val fresh_level : unit -> Level.t val new_global_univ : unit -> Universe.t in_universe_context_set (** Build a fresh instance for a given context, its associated substitution and the instantiated constraints. *) type sort_context_set = (Sorts.QVar.Set.t * Univ.Level.Set.t) * Univ.Constraints.t type 'a in_sort_context_set = 'a * sort_context_set val sort_context_union : sort_context_set -> sort_context_set -> sort_context_set val empty_sort_context : sort_context_set val is_empty_sort_context : sort_context_set -> bool val diff_sort_context : sort_context_set -> sort_context_set -> sort_context_set val fresh_instance : AbstractContext.t -> Instance.t in_sort_context_set val fresh_instance_from : ?loc:Loc.t -> AbstractContext.t -> Instance.t option -> Instance.t in_sort_context_set val fresh_sort_in_family : Sorts.family -> Sorts.t in_sort_context_set (** NB: InQSort is treated as InType *) val fresh_constant_instance : env -> Constant.t -> pconstant in_sort_context_set val fresh_inductive_instance : env -> inductive -> pinductive in_sort_context_set val fresh_constructor_instance : env -> constructor -> pconstructor in_sort_context_set val fresh_array_instance : env -> Instance.t in_sort_context_set val fresh_global_instance : ?loc:Loc.t -> ?names:UVars.Instance.t -> env -> GlobRef.t -> constr in_sort_context_set (** Get fresh variables for the universe context. Useful to make tactics that manipulate constrs in universe contexts polymorphic. *) val fresh_universe_context_set_instance : ContextSet.t -> universe_level_subst * ContextSet.t val fresh_sort_context_instance : sort_context_set -> sort_level_subst * sort_context_set (** Create a fresh global in the environment argument, without side effects. BEWARE: this raises an error on polymorphic constants/inductives: the constraints should be properly added to an evd. See Evd.fresh_global, Evarutil.new_global, and pf_constr_of_global for the proper way to get a fresh copy of a polymorphic global reference. *) val constr_of_monomorphic_global : env -> GlobRef.t -> constr coq-8.20.0/engine/univMinim.ml000066400000000000000000000406141466560755400161640ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* Level.Map.add u [t] map (** Precondition: flexible <= ctx *) let choose_canonical ctx flexible algebraic s = let global = Level.Set.diff s ctx in let flexible, rigid = Level.Set.partition flexible (Level.Set.inter s ctx) in (* If there is a global universe in the set, choose it *) if not (Level.Set.is_empty global) then let canon = Level.Set.choose global in canon, (Level.Set.remove canon global, rigid, flexible) else (* No global in the equivalence class, choose a rigid one *) if not (Level.Set.is_empty rigid) then let canon = Level.Set.choose rigid in canon, (global, Level.Set.remove canon rigid, flexible) else (* There are only flexible universes in the equivalence class, choose a non-algebraic. *) let algs, nonalgs = Level.Set.partition algebraic flexible in if not (Level.Set.is_empty nonalgs) then let canon = Level.Set.choose nonalgs in canon, (global, rigid, Level.Set.remove canon flexible) else let canon = Level.Set.choose algs in canon, (global, rigid, Level.Set.remove canon flexible) (* Eq < Le < Lt *) let compare_constraint_type d d' = match d, d' with | Eq, Eq -> 0 | Eq, _ -> -1 | _, Eq -> 1 | Le, Le -> 0 | Le, _ -> -1 | _, Le -> 1 | Lt, Lt -> 0 type lowermap = constraint_type Level.Map.t let lower_union = let merge k a b = match a, b with | Some _, None -> a | None, Some _ -> b | None, None -> None | Some l, Some r -> if compare_constraint_type l r >= 0 then a else b in Level.Map.merge merge let lower_add l c m = try let c' = Level.Map.find l m in if compare_constraint_type c c' > 0 then Level.Map.add l c m else m with Not_found -> Level.Map.add l c m let lower_of_list l = List.fold_left (fun acc (d,l) -> Level.Map.add l d acc) Level.Map.empty l type lbound = { enforce : bool; alg : bool; lbound: Universe.t; lower : lowermap } module LBMap : sig type t = private { lbmap : lbound Level.Map.t; lbrev : (Level.t * lowermap) Universe.Map.t } val empty : t val add : Level.t -> lbound -> t -> t end = struct type t = { lbmap : lbound Level.Map.t; lbrev : (Level.t * lowermap) Universe.Map.t } (* lbrev is uniquely given from lbmap as a partial reverse mapping *) let empty = { lbmap = Level.Map.empty; lbrev = Universe.Map.empty } let add u bnd m = let lbmap = Level.Map.add u bnd m.lbmap in let lbrev = if not bnd.alg && bnd.enforce then match Universe.Map.find bnd.lbound m.lbrev with | (v, _) -> if Level.compare u v <= 0 then Universe.Map.add bnd.lbound (u, bnd.lower) m.lbrev else m.lbrev | exception Not_found -> Universe.Map.add bnd.lbound (u, bnd.lower) m.lbrev else m.lbrev in { lbmap; lbrev } end let find_inst insts v = Universe.Map.find v insts.LBMap.lbrev let compute_lbound left = (* The universe variable was not fixed yet. Compute its level using its lower bound. *) let sup l lbound = match lbound with | None -> Some l | Some l' -> Some (Universe.sup l l') in List.fold_left (fun lbound (d, l) -> if d == Le (* l <= ?u *) then sup l lbound else (* l < ?u *) (assert (d == Lt); if not (Universe.level l == None) then sup (Universe.super l) lbound else None)) None left let instantiate_with_lbound u lbound lower ~alg ~enforce (ctx, us, insts, cstrs) = if enforce then let inst = Universe.make u in let cstrs' = enforce_leq lbound inst cstrs in (ctx, UnivFlex.make_nonalgebraic_variable us u, LBMap.add u {enforce;alg;lbound;lower} insts, cstrs'), {enforce; alg; lbound=inst; lower} else (* Actually instantiate *) (Level.Set.remove u ctx, UnivFlex.define u lbound us, LBMap.add u {enforce;alg;lbound;lower} insts, cstrs), {enforce; alg; lbound; lower} type constraints_map = (constraint_type * Level.Map.key) list Level.Map.t let _pr_constraints_map (cmap:constraints_map) = let open Pp in Level.Map.fold (fun l cstrs acc -> Level.raw_pr l ++ str " => " ++ prlist_with_sep spc (fun (d,r) -> pr_constraint_type d ++ Level.raw_pr r) cstrs ++ fnl () ++ acc) cmap (mt ()) let remove_alg l (ctx, us, insts, cstrs) = (ctx, UnivFlex.make_nonalgebraic_variable us l, insts, cstrs) let not_lower lower (d,l) = (* We're checking if (d,l) is already implied by the lower constraints on some level u. If it represents l < u (d is Lt or d is Le and i > 0, the i < 0 case is impossible due to invariants of Univ), and the lower constraints only have l <= u then it is not implied. *) Universe.exists (fun (l,i) -> let d = if i == 0 then d else match d with | Le -> Lt | d -> d in try let d' = Level.Map.find l lower in (* If d is stronger than the already implied lower * constraints we must keep it. *) compare_constraint_type d d' > 0 with Not_found -> (* No constraint existing on l *) true) l exception UpperBoundedAlg (** [enforce_uppers upper lbound cstrs] interprets [upper] as upper constraints to [lbound], adding them to [cstrs]. @raise UpperBoundedAlg if any [upper] constraints are strict and [lbound] algebraic. *) let enforce_uppers upper lbound cstrs = List.fold_left (fun cstrs (d, r) -> if d == Le then enforce_leq lbound (Universe.make r) cstrs else match Universe.level lbound with | Some lev -> Constraints.add (lev, d, r) cstrs | None -> raise UpperBoundedAlg) cstrs upper let minimize_univ_variables ctx us left right cstrs = let left, lbounds = Level.Map.fold (fun r lower (left, lbounds as acc) -> if UnivFlex.mem r us || not (Level.Set.mem r ctx) then acc else (* Fixed universe, just compute its glb for sharing *) let lbounds = match compute_lbound (List.map (fun (d,l) -> d, Universe.make l) lower) with | None -> lbounds | Some lbound -> LBMap.add r {enforce=true; alg=false; lbound; lower=lower_of_list lower} lbounds in (Level.Map.remove r left, lbounds)) left (left, LBMap.empty) in let rec instance (ctx, us, insts, cstrs as acc) u = let acc, left, lower = match Level.Map.find u left with | exception Not_found -> acc, [], Level.Map.empty | l -> let acc, left, newlow, lower = List.fold_left (fun (acc, left, newlow, lower') (d, l) -> let acc', {enforce=enf;alg;lbound=l';lower} = aux acc l in let l' = if enf then Universe.make l else l' in acc', (d, l') :: left, lower_add l d newlow, lower_union lower lower') (acc, [], Level.Map.empty, Level.Map.empty) l in let left = CList.uniquize (List.filter (not_lower lower) left) in (acc, left, Level.Map.lunion newlow lower) in let instantiate_lbound lbound = let alg = UnivFlex.is_algebraic u us in if Universe.is_type0 lbound && not (get_set_minimization()) then (* Minim to Set disabled, do not instantiate with Set *) instantiate_with_lbound u lbound lower ~alg ~enforce:true acc else if alg then (* u is algebraic: we instantiate it with its lower bound, if any, or enforce the constraints if it is bounded from the top. *) let lower = Level.Set.fold Level.Map.remove (Universe.levels lbound) lower in instantiate_with_lbound u lbound lower ~alg:true ~enforce:false acc else (* u is non algebraic *) match Universe.level lbound with | Some l -> (* The lowerbound is directly a level *) (* u is not algebraic but has no upper bounds, we instantiate it with its lower bound if it is a different level, otherwise we keep it. *) let lower = Level.Map.remove l lower in if not (Level.equal l u) then (* Should check that u does not have upper constraints that are not already in right *) let acc = remove_alg l acc in instantiate_with_lbound u lbound lower ~alg:false ~enforce:false acc else acc, {enforce=true; alg=false; lbound; lower} | None -> begin match find_inst insts lbound with | can, lower -> (* Another universe represents the same lower bound, we can share them with no harm. *) let lower = Level.Map.remove can lower in instantiate_with_lbound u (Universe.make can) lower ~alg:false ~enforce:false acc | exception Not_found -> (* We set u as the canonical universe representing lbound *) instantiate_with_lbound u lbound lower ~alg:false ~enforce:true acc end in let enforce_uppers ((ctx,us,insts,cstrs), b as acc) = match Level.Map.find u right with | exception Not_found -> acc | upper -> let upper = List.filter (fun (d, r) -> not (UnivFlex.mem r us)) upper in let cstrs = enforce_uppers upper b.lbound cstrs in (ctx, us, insts, cstrs), b in if not (Level.Set.mem u ctx) then enforce_uppers (acc, {enforce=true; alg=false; lbound=Universe.make u; lower}) else let lbound = compute_lbound left in match lbound with | None -> (* Nothing to do *) enforce_uppers (acc, {enforce=true;alg=false;lbound=Universe.make u; lower}) | Some lbound -> try enforce_uppers (instantiate_lbound lbound) with UpperBoundedAlg -> enforce_uppers (acc, {enforce=true; alg=false; lbound=Universe.make u; lower}) and aux (ctx, us, seen, cstrs as acc) u = try acc, Level.Map.find u seen.LBMap.lbmap with Not_found -> instance acc u in UnivFlex.fold (fun u ~is_defined (ctx, us, seen, cstrs as acc) -> if not is_defined then fst (aux acc u) else Level.Set.remove u ctx, UnivFlex.make_nonalgebraic_variable us u, seen, cstrs) us (ctx, us, lbounds, cstrs) module UPairs = OrderedType.UnorderedPair(Level) module UPairSet = Set.Make (UPairs) type extra = { weak_constraints : UPairSet.t; above_prop : Level.Set.t; } let empty_extra = { weak_constraints = UPairSet.empty; above_prop = Level.Set.empty; } let extra_union a b = { weak_constraints = UPairSet.union a.weak_constraints b.weak_constraints; above_prop = Level.Set.union a.above_prop b.above_prop; } let normalize_context_set ~lbound g ctx (us:UnivFlex.t) {weak_constraints=weak;above_prop} = let (ctx, csts) = ContextSet.levels ctx, ContextSet.constraints ctx in (* Keep the Set <= i constraints separate *) let smallles, csts = Constraints.partition (fun (l,d,r) -> d == Le && Level.is_set l) csts in (* Process weak constraints: when one side is flexible and the 2 universes are unrelated unify them. *) let smallles, csts, g = UPairSet.fold (fun (u,v) (smallles, csts, g as acc) -> let norm = level_subst_of (UnivFlex.normalize_univ_variable us) in let u = norm u and v = norm v in if (Level.is_set u || Level.is_set v) then begin if get_set_minimization() then begin if Level.is_set u then (Constraints.add (u,Le,v) smallles,csts,g) else (Constraints.add (v,Le,u) smallles,csts,g) end else acc end else let set_to a b = (smallles, Constraints.add (a,Eq,b) csts, UGraph.enforce_constraint (a,Eq,b) g) in let check_le a b = UGraph.check_constraint g (a,Le,b) in if check_le u v || check_le v u then acc else if UnivFlex.mem u us then set_to u v else if UnivFlex.mem v us then set_to v u else acc) weak (smallles, csts, g) in let smallles = match (lbound : UGraph.Bound.t) with | Prop -> smallles | Set when get_set_minimization () -> Constraints.filter (fun (l,d,r) -> UnivFlex.mem r us) smallles | Set -> Constraints.empty (* constraints Set <= u may be dropped *) in let smallles = if get_set_minimization() then let fold u accu = if UnivFlex.mem u us then Constraints.add (Level.set, Le, u) accu else accu in Level.Set.fold fold above_prop smallles else 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 (* use lbound:Set to collapse [u <= v <= Set] into [u = v = Set] *) let g = Level.Set.fold (fun v g -> UGraph.add_universe ~lbound:Set ~strict:false v g) ctx g in let add_soft u g = if not (Level.is_set u || Level.Set.mem u ctx) then try UGraph.add_universe ~lbound:Set ~strict:false u g with UGraph.AlreadyDeclared -> g else g in let g = Constraints.fold (fun (l, d, r) g -> add_soft r (add_soft l g)) csts g in let g = UGraph.merge_constraints csts g in UGraph.constraints_of_universes g in (* Ignore constraints from lbound:Set *) let noneqs = Constraints.filter (fun (l,d,r) -> not (d == Le && Level.is_set l)) csts in (* Put back constraints [Set <= u] from type inference *) let noneqs = Constraints.union noneqs smallles in let flex x = UnivFlex.mem x us in let algebraic x = UnivFlex.is_algebraic x us in let ctx, us, eqs = List.fold_left (fun (ctx, us, cstrs) s -> let canon, (global, rigid, flexible) = choose_canonical ctx flex algebraic s in (* Add equalities for globals which can't be merged anymore. *) let cstrs = Level.Set.fold (fun g cst -> Constraints.add (canon, Eq, g) cst) global cstrs in (* Also add equalities for rigid variables *) let cstrs = Level.Set.fold (fun g cst -> Constraints.add (canon, Eq, g) cst) rigid cstrs in let canonu = Universe.make canon in let us = Level.Set.fold (fun f -> UnivFlex.define f canonu) flexible us in (Level.Set.diff ctx flexible, us, cstrs)) (ctx, us, Constraints.empty) partition in (* Noneqs is now in canonical form w.r.t. equality constraints, and contains only inequality constraints. *) let noneqs = let norm = level_subst_of (UnivFlex.normalize_univ_variable us) in let fold (u,d,v) noneqs = let u = norm u and v = norm v in if d != Lt && Level.equal u v then noneqs else Constraints.add (u,d,v) noneqs in Constraints.fold fold noneqs Constraints.empty in (* Compute the left and right set of flexible variables, constraints mentioning other variables remain in noneqs. *) let noneqs, ucstrsl, ucstrsr = Constraints.fold (fun (l,d,r as cstr) (noneq, ucstrsl, ucstrsr) -> let lus = UnivFlex.mem l us and rus = UnivFlex.mem r us in let ucstrsl' = if lus then add_list_map l (d, r) ucstrsl else ucstrsl and ucstrsr' = add_list_map r (d, l) ucstrsr in let noneqs = if lus || rus then noneq else Constraints.add cstr noneq in (noneqs, ucstrsl', ucstrsr')) noneqs (Constraints.empty, Level.Map.empty, Level.Map.empty) in (* Now we construct the instantiation of each variable. *) let ctx', us, inst, noneqs = minimize_univ_variables ctx us ucstrsr ucstrsl noneqs in let us = UnivFlex.normalize us in us, (ctx', Constraints.union noneqs eqs) coq-8.20.0/engine/univMinim.mli000066400000000000000000000031061466560755400163300ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* extra -> extra (** Simplification and pruning of constraints: [normalize_context_set ctx us] - Instantiate the variables in [us] with their most precise universe levels respecting the constraints. - Normalizes the context [ctx] w.r.t. equality constraints, choosing a canonical universe in each equivalence class (a global one if there is one) and transitively saturate the constraints w.r.t to the equalities. *) val normalize_context_set : lbound:UGraph.Bound.t -> UGraph.t -> ContextSet.t -> UnivFlex.t (* The defined and undefined variables *) -> extra -> UnivFlex.t in_universe_context_set coq-8.20.0/engine/univNames.ml000066400000000000000000000025301466560755400161510ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* (try Some (Nametab.shortest_qualid_of_universe ctx qid) with Not_found -> None) | None -> None let pr_level_with_global_universes ?(binders=empty_binders) l = match qualid_of_level binders l with | Some qid -> Libnames.pr_qualid qid | None -> Level.raw_pr l coq-8.20.0/engine/univNames.mli000066400000000000000000000022461466560755400163260ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* level mapping *) type universe_binders = QVar.t Id.Map.t * Level.t Id.Map.t type rev_binders = Id.t QVar.Map.t * Id.t Level.Map.t val empty_binders : universe_binders val empty_rev_binders : rev_binders type univ_name_list = Names.lname list type full_name_list = lname list * lname list val pr_level_with_global_universes : ?binders:universe_binders -> Level.t -> Pp.t val qualid_of_level : universe_binders -> Level.t -> Libnames.qualid option coq-8.20.0/engine/univProblem.ml000066400000000000000000000116301466560755400165070ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* true | QLeq (a,b) | QEq (a, b) -> Sorts.Quality.equal a b | ULe (u, v) | UEq (u, v) -> Sorts.equal u v | ULub (u, v) | UWeak (u, v) -> Level.equal u v let force = function | QEq _ | QLeq _ | ULe _ | UEq _ | UWeak _ as cst -> cst | ULub (u,v) -> UEq (Sorts.sort_of_univ @@ Universe.make u, Sorts.sort_of_univ @@ Universe.make v) let check_eq_level g u v = UGraph.check_eq_level g u v module Set = struct module S = Set.Make( struct type nonrec t = t let compare x y = match x, y with | QEq (a, b), QEq (a', b') -> let i = Sorts.Quality.compare a a' in if i <> 0 then i else Sorts.Quality.compare b b' | QLeq (a, b), QLeq (a', b') -> let i = Sorts.Quality.compare a a' in if i <> 0 then i else Sorts.Quality.compare b b' | ULe (u, v), ULe (u', v') -> let i = Sorts.compare u u' in if Int.equal i 0 then Sorts.compare v v' else i | UEq (u, v), UEq (u', v') -> let i = Sorts.compare u u' in if Int.equal i 0 then Sorts.compare v v' else if Sorts.equal u v' && Sorts.equal v u' then 0 else i | ULub (u, v), ULub (u', v') | UWeak (u, v), UWeak (u', v') -> let i = Level.compare u u' in if Int.equal i 0 then Level.compare v v' else if Level.equal u v' && Level.equal v u' then 0 else i | QEq _, _ -> -1 | _, QEq _ -> 1 | QLeq _, _ -> -1 | _, QLeq _ -> 1 | ULe _, _ -> -1 | _, ULe _ -> 1 | UEq _, _ -> -1 | _, UEq _ -> 1 | ULub _, _ -> -1 | _, ULub _ -> 1 end) include S let add cst s = if is_trivial cst then s else add cst s let pr_one = let open Pp in function | QEq (a, b) -> Sorts.Quality.raw_pr a ++ str " = " ++ Sorts.Quality.raw_pr b | QLeq (a, b) -> Sorts.Quality.raw_pr a ++ str " <= " ++ Sorts.Quality.raw_pr b | ULe (u, v) -> Sorts.debug_print u ++ str " <= " ++ Sorts.debug_print v | UEq (u, v) -> Sorts.debug_print u ++ str " = " ++ Sorts.debug_print v | ULub (u, v) -> Level.raw_pr u ++ str " /\\ " ++ Level.raw_pr v | UWeak (u, v) -> Level.raw_pr u ++ str " ~ " ++ Level.raw_pr v let pr c = let open Pp in fold (fun cst pp_std -> pp_std ++ pr_one cst ++ fnl ()) c (str "") let equal x y = x == y || equal x y let force s = map force s end type 'a constraint_function = 'a -> 'a -> Set.t -> Set.t let enforce_eq_instances_univs strict x y c = let mkU u = Sorts.sort_of_univ @@ Universe.make u in let mk u v = if strict then ULub (u, v) else UEq (mkU u, mkU v) in if not (UVars.eq_sizes (UVars.Instance.length x) (UVars.Instance.length y)) then CErrors.anomaly Pp.(str "Invalid argument: enforce_eq_instances_univs called with" ++ str " instances of different lengths."); let xq, xu = UVars.Instance.to_array x and yq, yu = UVars.Instance.to_array y in let c = CArray.fold_left2 (* TODO strict? *) (fun c x y -> if Sorts.Quality.equal x y then c else Set.add (QEq (x,y)) c) c xq yq in let c = CArray.fold_left2 (fun c x y -> Set.add (mk x y) c) c xu yu in c let enforce_eq_qualities qs qs' cstrs = CArray.fold_left2 (fun c a b -> if Sorts.Quality.equal a b then c else Set.add (QEq (a, b)) c) cstrs qs qs' let compare_cumulative_instances cv_pb variances u u' cstrs = let make u = Sorts.sort_of_univ @@ Univ.Universe.make u in let qs, us = UVars.Instance.to_array u and qs', us' = UVars.Instance.to_array u' in let cstrs = enforce_eq_qualities qs qs' cstrs in CArray.fold_left3 (fun cstrs v u u' -> let open UVars.Variance in match v with | Irrelevant -> Set.add (UWeak (u,u')) cstrs | Covariant -> (match cv_pb with | Conversion.CONV -> Set.add (UEq (make u, make u')) cstrs | Conversion.CUMUL -> Set.add (ULe (make u, make u')) cstrs) | Invariant -> Set.add (UEq (make u, make u')) cstrs) cstrs variances us us' coq-8.20.0/engine/univProblem.mli000066400000000000000000000034741466560755400166670ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* bool (** Wrapper around the UGraph function to handle Prop *) val check_eq_level : UGraph.t -> Level.t -> Level.t -> bool module Set : sig include Set.S with type elt = t val pr : t -> Pp.t (** Replace ULub constraints by UEq *) val force : t -> t end type 'a constraint_function = 'a -> 'a -> Set.t -> Set.t val enforce_eq_instances_univs : bool -> Instance.t constraint_function val enforce_eq_qualities : Sorts.Quality.t array constraint_function val compare_cumulative_instances : Conversion.conv_pb -> Variance.t array -> Instance.t constraint_function coq-8.20.0/engine/univSubst.ml000066400000000000000000000232731466560755400162150ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* let a' = addn n u' in (a' :: subst, nosubst) | None -> (subst, (u, n) :: nosubst)) (Universe.repr ul) ([], []) in match subst with | [] -> ul | u :: ul -> let substs = List.fold_left Universe.sup u subst in List.fold_left (fun acc (u, n) -> Universe.sup acc (addn n (Universe.make u))) substs nosubst let enforce_eq u v c = if Universe.equal u v then c else match Universe.level u, Universe.level v with | Some u, Some v -> enforce_eq_level u v c | _ -> CErrors.anomaly (Pp.str "A universe comparison can only happen between variables.") let constraint_add_leq v u c = let eq (x, n) (y, m) = Int.equal m n && Level.equal x y in (* We just discard trivial constraints like u<=u *) if eq v u then c else match v, u with | (x,n), (y,m) -> let j = m - n in if j = -1 (* n = m+1, v+1 <= u <-> v < u *) then Constraints.add (x,Lt,y) c 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 *) Constraints.add (x,Lt,x) c else CErrors.anomaly (Pp.str"Unable to handle arbitrary u+k <= v constraints.") else if j = 0 then Constraints.add (x,Le,y) c else (* j >= 1 *) (* m = n + k, u <= v+k *) if Level.equal x y then c (* u <= u+k, trivial *) else if Level.is_set x then c (* Prop,Set <= u+S k, trivial *) else Constraints.add (x,Le,y) c (* u <= v implies u <= v+k *) let check_univ_leq_one u v = let leq (u,n) (v,n') = let cmp = Level.compare u v in if Int.equal cmp 0 then n <= n' else false in Universe.exists (leq u) v let check_univ_leq u v = Universe.for_all (fun u -> check_univ_leq_one u v) u let enforce_leq u v c = List.fold_left (fun c v -> (List.fold_left (fun c u -> constraint_add_leq u v c) c u)) c v let enforce_leq u v c = if check_univ_leq u v then c else enforce_leq (Universe.repr u) (Universe.repr v) c let get_algebraic = function | Prop | SProp | QSort _ -> assert false | Set -> Universe.type0 | Type u -> u let enforce_eq_sort s1 s2 cst = match s1, s2 with | (SProp, SProp) | (Prop, Prop) | (Set, Set) -> cst | (((Prop | Set | Type _ | QSort _) as s1), (Prop | SProp as s2)) | ((Prop | SProp as s1), ((Prop | Set | Type _ | QSort _) as s2)) -> raise (UGraph.UniverseInconsistency (None, (Eq, s1, s2, None))) | (Set | Type _), (Set | Type _) -> enforce_eq (get_algebraic s1) (get_algebraic s2) cst | QSort (q1, u1), QSort (q2, u2) -> if QVar.equal q1 q2 then enforce_eq u1 u2 cst else raise (UGraph.UniverseInconsistency (None, (Eq, s1, s2, None))) | (QSort _, (Set | Type _)) | ((Set | Type _), QSort _) -> raise (UGraph.UniverseInconsistency (None, (Eq, s1, s2, None))) let enforce_leq_sort s1 s2 cst = match s1, s2 with | (SProp, SProp) | (Prop, Prop) | (Set, Set) -> cst | (Prop, (Set | Type _)) -> cst | (((Prop | Set | Type _ | QSort _) as s1), (Prop | SProp as s2)) | ((SProp as s1), ((Prop | Set | Type _ | QSort _) as s2)) -> raise (UGraph.UniverseInconsistency (None, (Le, s1, s2, None))) | (Set | Type _), (Set | Type _) -> enforce_leq (get_algebraic s1) (get_algebraic s2) cst | QSort (q1, u1), QSort (q2, u2) -> if QVar.equal q1 q2 then enforce_leq u1 u2 cst else raise (UGraph.UniverseInconsistency (None, (Eq, s1, s2, None))) | (QSort _, (Set | Type _)) | ((Prop | Set | Type _), QSort _) -> raise (UGraph.UniverseInconsistency (None, (Eq, s1, s2, None))) let enforce_leq_alg_sort s1 s2 g = match s1, s2 with | (SProp, SProp) | (Prop, Prop) | (Set, Set) -> Constraints.empty, g | (Prop, (Set | Type _)) -> Constraints.empty, g | (((Prop | Set | Type _ | QSort _) as s1), (Prop | SProp as s2)) | ((SProp as s1), ((Prop | Set | Type _ | QSort _) as s2)) -> raise (UGraph.UniverseInconsistency (None, (Le, s1, s2, None))) | (Set | Type _), (Set | Type _) -> UGraph.enforce_leq_alg (get_algebraic s1) (get_algebraic s2) g | QSort (q1, u1), QSort (q2, u2) -> if QVar.equal q1 q2 then UGraph.enforce_leq_alg u1 u2 g else raise (UGraph.UniverseInconsistency (None, (Eq, s1, s2, None))) | (QSort _, (Set | Type _)) | ((Prop | Set | Type _), QSort _) -> raise (UGraph.UniverseInconsistency (None, (Eq, s1, s2, None))) let enforce_univ_constraint (u,d,v) = match d with | Eq -> enforce_eq u v | Le -> enforce_leq u v | Lt -> enforce_leq (Universe.super u) v let subst_univs_constraint fn (u,d,v as c) cstrs = let u' = fn u in let v' = fn v in match u', v' with | None, None -> Constraints.add c cstrs | Some u, None -> enforce_univ_constraint (u,d,Universe.make v) cstrs | None, Some v -> enforce_univ_constraint (Universe.make u,d,v) cstrs | Some u, Some v -> enforce_univ_constraint (u,d,v) cstrs let subst_univs_constraints subst csts = Constraints.fold (fun c cstrs -> subst_univs_constraint subst c cstrs) csts Constraints.empty let level_subst_of f = fun l -> match f l with | None -> l | Some u -> match Universe.level u with | None -> assert false | Some l -> l let subst_univs_fn_puniverses f (c, u as cu) = let u' = Instance.subst_fn f u in if u' == u then cu else (c, u') let map_universes_opt_subst_with_binders next aux fqual funiv k c = let frel = Sorts.relevance_subst_fn fqual in let flevel = fqual, level_subst_of funiv in let aux_rec ((nas, tys, bds) as rc) = let nas' = Array.Smart.map (Context.map_annot_relevance frel) nas in let tys' = Array.Fun1.Smart.map aux k tys in let k' = iterate next (Array.length tys') k in let bds' = Array.Fun1.Smart.map aux k' bds in if nas' == nas && tys' == tys && bds' == bds then rc else (nas', tys', bds') in let aux_ctx ((nas, c) as p) = let nas' = Array.Smart.map (Context.map_annot_relevance frel) nas in let k' = iterate next (Array.length nas) k in let c' = aux k' c in if nas' == nas && c' == c then p else (nas', c') in match kind c with | Const pu -> let pu' = subst_univs_fn_puniverses flevel pu in if pu' == pu then c else mkConstU pu' | Ind pu -> let pu' = subst_univs_fn_puniverses flevel pu in if pu' == pu then c else mkIndU pu' | Construct pu -> let pu' = subst_univs_fn_puniverses flevel pu in if pu' == pu then c else mkConstructU pu' | Sort s -> let s' = Sorts.subst_fn (fqual, subst_univs_universe funiv) s in if s' == s then c else mkSort s' | Case (ci,u,pms,(p,rel),iv,t,br) -> let u' = Instance.subst_fn flevel u in let rel' = frel rel in let pms' = Array.Fun1.Smart.map aux k pms in let p' = aux_ctx p in let iv' = map_invert (aux k) iv in let t' = aux k t in let br' = Array.Smart.map aux_ctx br in if rel' == rel && u' == u && pms' == pms && p' == p && iv' == iv && t' == t && br' == br then c else mkCase (ci, u', pms', (p',rel'), iv', t', br') | Array (u,elems,def,ty) -> let u' = Instance.subst_fn flevel u in let elems' = CArray.Fun1.Smart.map aux k elems in let def' = aux k def in let ty' = aux k ty in if u == u' && elems == elems' && def == def' && ty == ty' then c else mkArray (u',elems',def',ty') | Prod (na, t, u) -> let na' = Context.map_annot_relevance frel na in let t' = aux k t in let u' = aux (next k) u in if na' == na && t' == t && u' == u then c else mkProd (na', t', u') | Lambda (na, t, u) -> let na' = Context.map_annot_relevance frel na in let t' = aux k t in let u' = aux (next k) u in if na' == na && t' == t && u' == u then c else mkLambda (na', t', u') | LetIn (na, b, t, u) -> let na' = Context.map_annot_relevance frel na in let b' = aux k b in let t' = aux k t in let u' = aux (next k) u in if na' == na && b' == b && t' == t && u' == u then c else mkLetIn (na', b', t', u') | Fix (i, rc) -> let rc' = aux_rec rc in if rc' == rc then c else mkFix (i, rc') | CoFix (i, rc) -> let rc' = aux_rec rc in if rc' == rc then c else mkCoFix (i, rc') | Proj (p, r, v) -> let r' = frel r in let v' = aux k v in if r' == r && v' == v then c else mkProj (p, r', v') | _ -> Constr.map_with_binders next aux k c let nf_evars_and_universes_opt_subst fevar fqual funiv c = let rec self () c = match Constr.kind c with | Evar (evk, args) -> let args' = SList.Smart.map (self ()) args in begin match try fevar (evk, args') with Not_found -> None with | None -> if args == args' then c else mkEvar (evk, args') | Some c -> self () c end | _ -> map_universes_opt_subst_with_binders ignore self fqual funiv () c in self () c let pr_universe_subst prl = let open Pp in Level.Map.pr prl (fun u -> str" := " ++ Universe.pr prl u ++ spc ()) coq-8.20.0/engine/univSubst.mli000066400000000000000000000042761466560755400163700ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* 'a) -> ('a -> constr -> constr) -> quality_subst_fn -> universe_subst_fn -> 'a -> constr -> constr val nf_evars_and_universes_opt_subst : (existential -> constr option) -> quality_subst_fn -> universe_subst_fn -> constr -> constr [@@ocaml.deprecated "Use [UnivSubst.map_universes_opt_subst_with_binders]"] val subst_univs_universe : universe_subst_fn -> Universe.t -> Universe.t val pr_universe_subst : (Level.t -> Pp.t) -> universe_subst -> Pp.t val enforce_eq : Universe.t constraint_function val enforce_leq : Universe.t constraint_function val enforce_eq_sort : Sorts.t -> Sorts.t -> Univ.Constraints.t -> Univ.Constraints.t val enforce_leq_sort : Sorts.t -> Sorts.t -> Univ.Constraints.t -> Univ.Constraints.t (** Picks an arbitrary set of constraints sufficient to ensure [u <= v]. *) val enforce_leq_alg_sort : Sorts.t -> Sorts.t -> UGraph.t -> Univ.Constraints.t * UGraph.t coq-8.20.0/flake.lock000066400000000000000000000026361466560755400143500ustar00rootroot00000000000000{ "nodes": { "flake-utils": { "inputs": { "systems": "systems" }, "locked": { "lastModified": 1681202837, "narHash": "sha256-H+Rh19JDwRtpVPAWp64F+rlEtxUWBAQW28eAi3SRSzg=", "owner": "numtide", "repo": "flake-utils", "rev": "cfacdce06f30d2b68473a46042957675eebb3401", "type": "github" }, "original": { "owner": "numtide", "repo": "flake-utils", "type": "github" } }, "nixpkgs": { "locked": { "lastModified": 1684973047, "narHash": "sha256-ZLnSr35L6C49pCZS9fZCCqkIKNAeQzykov2QfosNG9w=", "owner": "NixOS", "repo": "nixpkgs", "rev": "21eb6c6ba74dcbe3ea5926ee46287300fb066630", "type": "github" }, "original": { "id": "nixpkgs", "type": "indirect" } }, "root": { "inputs": { "flake-utils": "flake-utils", "nixpkgs": "nixpkgs" } }, "systems": { "locked": { "lastModified": 1681028828, "narHash": "sha256-Vy1rq5AaRuLzOxct8nz4T6wlgyUR7zLU309k9mBC768=", "owner": "nix-systems", "repo": "default", "rev": "da67096a3b9bf56a91d16901293e51ba5b49a27e", "type": "github" }, "original": { "owner": "nix-systems", "repo": "default", "type": "github" } } }, "root": "root", "version": 7 } coq-8.20.0/flake.nix000066400000000000000000000005231466560755400142070ustar00rootroot00000000000000{ inputs.flake-utils.url = "github:numtide/flake-utils"; outputs = { self, nixpkgs, flake-utils }: flake-utils.lib.eachDefaultSystem (system: { packages = with import nixpkgs { inherit system; }; coq.override { version = ./.; }; defaultPackage = self.packages.${system}; } ); } coq-8.20.0/gramlib/000077500000000000000000000000001466560755400140225ustar00rootroot00000000000000coq-8.20.0/gramlib/LICENSE000066400000000000000000000032511466560755400150300ustar00rootroot00000000000000gramlib was derived from Daniel de Rauglaudre's camlp5 (https://github.com/camlp5/camlp5) whose licence follows: * Copyright (c) 2007-2017, INRIA (Institut National de Recherches en * Informatique et Automatique). All rights reserved. * Redistribution and use in source and binary forms, with or without * modification, are permitted provided that the following conditions are met: * * * Redistributions of source code must retain the above copyright * notice, this list of conditions and the following disclaimer. * * Redistributions in binary form must reproduce the above copyright * notice, this list of conditions and the following disclaimer in the * documentation and/or other materials provided with the distribution. * * Neither the name of INRIA, nor the names of its contributors may be * used to endorse or promote products derived from this software without * specific prior written permission. * * THIS SOFTWARE IS PROVIDED BY INRIA AND CONTRIBUTORS ``AS IS'' AND * ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, * THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A * PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL INRIA AND * CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, * SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT * LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF * USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND * ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, * OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT * OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF * SUCH DAMAGE. coq-8.20.0/gramlib/dune000066400000000000000000000001761466560755400147040ustar00rootroot00000000000000(library (name gramlib) (public_name coq-core.gramlib) (modules_without_implementation plexing) (libraries coq-core.lib)) coq-8.20.0/gramlib/gramext.ml000066400000000000000000000005131466560755400160220ustar00rootroot00000000000000(* camlp5r *) (* gramext.ml,v *) (* Copyright (c) INRIA 2007-2017 *) type position = | First | Last | Before of string | After of string type g_assoc = NonA | RightA | LeftA let pr_assoc = function | LeftA -> Pp.str "left associativity" | RightA -> Pp.str "right associativity" | NonA -> Pp.str "no associativity" coq-8.20.0/gramlib/gramext.mli000066400000000000000000000003721466560755400161760ustar00rootroot00000000000000(* camlp5r *) (* gramext.mli,v *) (* Copyright (c) INRIA 2007-2017 *) type position = | First | Last | Before of string | After of string type g_assoc = NonA | RightA | LeftA val pr_assoc : g_assoc -> Pp.t (** Prints a [g_assoc] value. *) coq-8.20.0/gramlib/grammar.ml000066400000000000000000002214401466560755400160050ustar00rootroot00000000000000(* camlp5r *) (* grammar.ml,v *) (* Copyright (c) INRIA 2007-2017 *) open Gramext open Format open Util exception Error of string (** Raised by parsers when the first component of a stream pattern is accepted, but one of the following components is rejected. *) (* Functorial interface *) type norec type mayrec module type S = sig type keyword_state type te type 'c pattern type ty_pattern = TPattern : 'a pattern -> ty_pattern (** Type combinators to factor the module type between explicit state passing in Grammar and global state in Pcoq *) type 'a with_gstate (** Reader of grammar state *) type 'a with_kwstate (** Read keyword state *) type 'a with_estate (** Read entry state *) type 'a mod_estate (** Read/write entry state *) module Parsable : sig type t (** [Parsable.t] Stream tokenizers with Coq-specific funcitonality *) val make : ?loc:Loc.t -> (unit,char) Stream.t -> t (** [make ?loc strm] Build a parsable from stream [strm], resuming at position [?loc] *) val comments : t -> ((int * int) * string) list val loc : t -> Loc.t (** [loc pa] Return parsing position for [pa] *) val consume : t -> int -> unit with_kwstate (** [consume pa n] Discard [n] tokens from [pa], updating the parsing position *) end module Entry : sig type 'a t val make : string -> 'a t mod_estate val parse : 'a t -> Parsable.t -> 'a with_gstate val name : 'a t -> string type 'a parser_fun = { parser_fun : keyword_state -> (keyword_state,te) LStream.t -> 'a } val of_parser : string -> 'a parser_fun -> 'a t mod_estate val parse_token_stream : 'a t -> (keyword_state,te) LStream.t -> 'a with_gstate val print : Format.formatter -> 'a t -> unit with_estate val is_empty : 'a t -> bool with_estate type any_t = Any : 'a t -> any_t val accumulate_in : any_t list -> any_t list CString.Map.t with_estate end module rec Symbol : sig type ('self, 'trec, 'a) t val nterm : 'a Entry.t -> ('self, norec, 'a) t val nterml : 'a Entry.t -> string -> ('self, norec, 'a) t val list0 : ('self, 'trec, 'a) t -> ('self, 'trec, 'a list) t val list0sep : ('self, 'trec, 'a) t -> ('self, norec, unit) t -> bool -> ('self, 'trec, 'a list) t val list1 : ('self, 'trec, 'a) t -> ('self, 'trec, 'a list) t val list1sep : ('self, 'trec, 'a) t -> ('self, norec, unit) t -> bool -> ('self, 'trec, 'a list) t val opt : ('self, 'trec, 'a) t -> ('self, 'trec, 'a option) t val self : ('self, mayrec, 'self) t val next : ('self, mayrec, 'self) t val token : 'c pattern -> ('self, norec, 'c) t val tokens : ty_pattern list -> ('self, norec, unit) t val rules : 'a Rules.t list -> ('self, norec, 'a) t end and Rule : sig type ('self, 'trec, 'f, 'r) t val stop : ('self, norec, 'r, 'r) t val next : ('self, _, 'a, 'r) t -> ('self, _, 'b) Symbol.t -> ('self, mayrec, 'b -> 'a, 'r) t val next_norec : ('self, norec, 'a, 'r) Rule.t -> ('self, norec, 'b) Symbol.t -> ('self, norec, 'b -> 'a, 'r) t end and Rules : sig type 'a t val make : (_, norec, 'f, Loc.t -> 'a) Rule.t -> 'f -> 'a t end module Production : sig type 'a t val make : ('a, _, 'f, Loc.t -> 'a) Rule.t -> 'f -> 'a t end type 'a single_extend_statement = string option * Gramext.g_assoc option * 'a Production.t list type 'a extend_statement = | Reuse of string option * 'a Production.t list | Fresh of Gramext.position * 'a single_extend_statement list val generalize_symbol : ('a, 'tr, 'c) Symbol.t -> ('b, norec, 'c) Symbol.t option (* Used in custom entries, should tweak? *) val level_of_nonterm : ('a, norec, 'c) Symbol.t -> string option end module type ExtS = sig type keyword_state module EState : sig type t val empty : t end module GState : sig type t = { estate : EState.t; kwstate : keyword_state; } end include S with type keyword_state := keyword_state and type 'a with_gstate := GState.t -> 'a and type 'a with_kwstate := keyword_state -> 'a and type 'a with_estate := EState.t -> 'a and type 'a mod_estate := EState.t -> EState.t * 'a type 's add_kw = { add_kw : 'c. 's -> 'c pattern -> 's } val safe_extend : 's add_kw -> EState.t -> 's -> 'a Entry.t -> 'a extend_statement -> EState.t * 's val safe_delete_rule : EState.t -> 'a Entry.t -> 'a Production.t -> EState.t module Unsafe : sig val clear_entry : EState.t -> 'a Entry.t -> EState.t end end (* Implementation *) module GMake (L : Plexing.S) : ExtS with type keyword_state := L.keyword_state and type te := L.te and type 'c pattern := 'c L.pattern = struct type te = L.te type 'c pattern = 'c L.pattern type ty_pattern = TPattern : 'a pattern -> ty_pattern type 'a parser_t = (L.keyword_state,L.te) LStream.t -> 'a (** Used to propagate possible presence of SELF/NEXT in a rule (binary and) *) type ('a, 'b, 'c) ty_and_rec = | NoRec2 : (norec, norec, norec) ty_and_rec | MayRec2 : ('a, 'b, mayrec) ty_and_rec (** Used to propagate possible presence of SELF/NEXT in a tree (ternary and) *) type ('a, 'b, 'c, 'd) ty_and_rec3 = | NoRec3 : (norec, norec, norec, norec) ty_and_rec3 | MayRec3 : ('a, 'b, 'c, mayrec) ty_and_rec3 type _ tag = .. module DMap = PolyMap.Make (struct type nonrec 'a tag = 'a tag = .. end) type 'a ty_entry = { ename : string; etag : 'a DMap.onetag; } and 'a ty_desc = | Dlevels of 'a ty_level list | Dparser of (L.keyword_state -> 'a parser_t) and 'a ty_level = Level : (_, _, 'a) ty_rec_level -> 'a ty_level and ('trecs, 'trecp, 'a) ty_rec_level = { assoc : g_assoc; lname : string option; lsuffix : ('a, 'trecs, 'a -> Loc.t -> 'a) ty_tree; lprefix : ('a, 'trecp, Loc.t -> 'a) ty_tree; } and ('self, 'trec, 'a) ty_symbol = | Stoken : 'c pattern -> ('self, norec, 'c) ty_symbol | Stokens : ty_pattern list -> ('self, norec, unit) ty_symbol | Slist1 : ('self, 'trec, 'a) ty_symbol -> ('self, 'trec, 'a list) ty_symbol | Slist1sep : ('self, 'trec, 'a) ty_symbol * ('self, norec, unit) ty_symbol * bool -> ('self, 'trec, 'a list) ty_symbol | Slist0 : ('self, 'trec, 'a) ty_symbol -> ('self, 'trec, 'a list) ty_symbol | Slist0sep : ('self, 'trec, 'a) ty_symbol * ('self, norec, unit) ty_symbol * bool -> ('self, 'trec, 'a list) ty_symbol | Sopt : ('self, 'trec, 'a) ty_symbol -> ('self, 'trec, 'a option) ty_symbol | Sself : ('self, mayrec, 'self) ty_symbol | Snext : ('self, mayrec, 'self) ty_symbol | Snterm : 'a ty_entry -> ('self, norec, 'a) ty_symbol (* norec but the entry can nevertheless introduce a loop with the current entry*) | Snterml : 'a ty_entry * string -> ('self, norec, 'a) ty_symbol | Stree : ('self, 'trec, Loc.t -> 'a) ty_tree -> ('self, 'trec, 'a) ty_symbol and ('self, _, _, 'r) ty_rule = | TStop : ('self, norec, 'r, 'r) ty_rule | TNext : ('trr, 'trs, 'tr) ty_and_rec * ('self, 'trr, 'a, 'r) ty_rule * ('self, 'trs, 'b) ty_symbol -> ('self, 'tr, 'b -> 'a, 'r) ty_rule and ('self, 'trec, 'a) ty_tree = | Node : ('trn, 'trs, 'trb, 'tr) ty_and_rec3 * ('self, 'trn, 'trs, 'trb, 'b, 'a) ty_node -> ('self, 'tr, 'a) ty_tree | LocAct : 'k * 'k list -> ('self, norec, 'k) ty_tree | DeadEnd : ('self, norec, 'k) ty_tree and ('self, 'trec, 'trecs, 'trecb, 'a, 'r) ty_node = { node : ('self, 'trec, 'a) ty_symbol; son : ('self, 'trecs, 'a -> 'r) ty_tree; brother : ('self, 'trecb, 'r) ty_tree; } (** The closures are built by partially applying the parsing functions to [edesc] but without depending on the state (so when we update an entry we don't need to update closures in unrelated entries). This is an important optimisation, see eg https://gitlab.com/coq/coq/-/jobs/3585529623 (+40% on mathcomp-ssreflect, +15% on stdlib without this, significant slowdowns on most developments) *) type ('t,'a) entry_data = { edesc : 'a ty_desc; estart : 't -> int -> 'a parser_t; econtinue : 't -> int -> int -> 'a -> 'a parser_t; } module rec EState : DMap.MapS with type 'a value := (GState.t, 'a) entry_data = DMap.Map(struct type 'a t = (GState.t, 'a) entry_data end) and GState : sig type t = { estate : EState.t; kwstate : L.keyword_state; } end = struct type t = { estate : EState.t; kwstate : L.keyword_state; } end open GState let get_entry estate e = try EState.find (DMap.tag_of_onetag e.etag) estate with Not_found -> assert false type 'a ty_rules = | TRules : (_, norec, 'act, Loc.t -> 'a) ty_rule * 'act -> 'a ty_rules type 'a ty_production = | TProd : ('a, _, 'act, Loc.t -> 'a) ty_rule * 'act -> 'a ty_production let rec derive_eps : type s r a. (s, r, a) ty_symbol -> bool = function Slist0 _ -> true | Slist0sep (_, _, _) -> true | Sopt _ -> true | Stree t -> tree_derive_eps t | Slist1 _ -> false | Slist1sep (_, _, _) -> false | Snterm _ -> false | Snterml (_, _) -> false | Snext -> false | Sself -> false | Stoken _ -> false | Stokens _ -> false and tree_derive_eps : type s tr a. (s, tr, a) ty_tree -> bool = function LocAct (_, _) -> true | Node (_, {node = s; brother = bro; son = son}) -> derive_eps s && tree_derive_eps son || tree_derive_eps bro | DeadEnd -> false let eq_entry : type a1 a2. a1 ty_entry -> a2 ty_entry -> (a1, a2) eq option = fun e1 e2 -> DMap.eq_onetag e1.etag (DMap.tag_of_onetag e2.etag) let tok_pattern_eq_list pl1 pl2 = let f (TPattern p1) (TPattern p2) = Option.has_some (L.tok_pattern_eq p1 p2) in if List.for_all2eq f pl1 pl2 then Some Refl else None let rec eq_symbol : type s r1 r2 a1 a2. (s, r1, a1) ty_symbol -> (s, r2, a2) ty_symbol -> (a1, a2) eq option = fun s1 s2 -> match s1, s2 with Snterm e1, Snterm e2 -> eq_entry e1 e2 | Snterml (e1, l1), Snterml (e2, l2) -> if String.equal l1 l2 then eq_entry e1 e2 else None | Slist0 s1, Slist0 s2 -> begin match eq_symbol s1 s2 with None -> None | Some Refl -> Some Refl end | Slist0sep (s1, sep1, b1), Slist0sep (s2, sep2, b2) -> if b1 = b2 then match eq_symbol s1 s2 with | None -> None | Some Refl -> match eq_symbol sep1 sep2 with | None -> None | Some Refl -> Some Refl else None | Slist1 s1, Slist1 s2 -> begin match eq_symbol s1 s2 with None -> None | Some Refl -> Some Refl end | Slist1sep (s1, sep1, b1), Slist1sep (s2, sep2, b2) -> if b1 = b2 then match eq_symbol s1 s2 with | None -> None | Some Refl -> match eq_symbol sep1 sep2 with | None -> None | Some Refl -> Some Refl else None | Sopt s1, Sopt s2 -> begin match eq_symbol s1 s2 with None -> None | Some Refl -> Some Refl end | Stree _, Stree _ -> None | Sself, Sself -> Some Refl | Snext, Snext -> Some Refl | Stoken p1, Stoken p2 -> L.tok_pattern_eq p1 p2 | Stokens pl1, Stokens pl2 -> tok_pattern_eq_list pl1 pl2 | _ -> None let is_before : type s1 s2 r1 r2 a1 a2. (s1, r1, a1) ty_symbol -> (s2, r2, a2) ty_symbol -> bool = fun s1 s2 -> match s1, s2 with | Stoken p1, Stoken p2 -> snd (L.tok_pattern_strings p1) <> None && snd (L.tok_pattern_strings p2) = None | Stoken _, _ -> true | _ -> false (** Ancillary datatypes *) type 'a ty_rec = MayRec : mayrec ty_rec | NoRec : norec ty_rec type ('a, 'b, 'c) ty_and_ex = | NR00 : (mayrec, mayrec, mayrec) ty_and_ex | NR01 : (mayrec, norec, mayrec) ty_and_ex | NR10 : (norec, mayrec, mayrec) ty_and_ex | NR11 : (norec, norec, norec) ty_and_ex type ('a, 'b) ty_mayrec_and_ex = | MayRecNR : ('a, 'b, _) ty_and_ex -> ('a, 'b) ty_mayrec_and_ex type ('s, 'a) ty_mayrec_symbol = | MayRecSymbol : ('s, _, 'a) ty_symbol -> ('s, 'a) ty_mayrec_symbol type ('s, 'a) ty_mayrec_tree = | MayRecTree : ('s, 'tr, 'a) ty_tree -> ('s, 'a) ty_mayrec_tree type ('s, 'a, 'r) ty_mayrec_rule = | MayRecRule : ('s, _, 'a, 'r) ty_rule -> ('s, 'a, 'r) ty_mayrec_rule type ('self, 'trec, _) ty_symbols = | TNil : ('self, norec, unit) ty_symbols | TCns : ('trh, 'trt, 'tr) ty_and_rec * ('self, 'trh, 'a) ty_symbol * ('self, 'trt, 'b) ty_symbols -> ('self, 'tr, 'a * 'b) ty_symbols (** ('i, 'p, 'f, 'r) rel_prod0 ~ ∃ α₁ ... αₙ. p ≡ αₙ * ... α₁ * 'i ∧ f ≡ α₁ -> ... -> αₙ -> 'r *) type ('i, _, 'f, _) rel_prod0 = | Rel0 : ('i, 'i, 'f, 'f) rel_prod0 | RelS : ('i, 'p, 'f, 'a -> 'r) rel_prod0 -> ('i, 'a * 'p, 'f, 'r) rel_prod0 type ('p, 'k, 'r) rel_prod = (unit, 'p, 'k, 'r) rel_prod0 type ('s, 'tr, 'i, 'k, 'r) any_symbols = | AnyS : ('s, 'tr, 'p) ty_symbols * ('i, 'p, 'k, 'r) rel_prod0 -> ('s, 'tr, 'i, 'k, 'r) any_symbols type ('s, 'tr, 'k, 'r) ty_belast_rule = | Belast : ('trr, 'trs, 'tr) ty_and_rec * ('s, 'trr, 'k, 'a -> 'r) ty_rule * ('s, 'trs, 'a) ty_symbol -> ('s, 'tr, 'k, 'r) ty_belast_rule (* unfortunately, this is quadratic, but ty_rules aren't too long * (99% of the time of length less or equal 10 and maximum is 22 * when compiling Coq and its standard library) *) let rec get_symbols : type s trec k r. (s, trec, k, r) ty_rule -> (s, trec, unit, k, r) any_symbols = let rec belast_rule : type s trr trs tr a k r. (trr, trs, tr) ty_and_rec -> (s, trr, k, r) ty_rule -> (s, trs, a) ty_symbol -> (s, tr, a -> k, r) ty_belast_rule = fun ar r s -> match ar, r with | NoRec2, TStop -> Belast (NoRec2, TStop, s) | MayRec2, TStop -> Belast (MayRec2, TStop, s) | NoRec2, TNext (NoRec2, r, s') -> let Belast (NoRec2, r, s') = belast_rule NoRec2 r s' in Belast (NoRec2, TNext (NoRec2, r, s), s') | MayRec2, TNext (_, r, s') -> let Belast (_, r, s') = belast_rule MayRec2 r s' in Belast (MayRec2, TNext (MayRec2, r, s), s') in function | TStop -> AnyS (TNil, Rel0) | TNext (MayRec2, r, s) -> let Belast (MayRec2, r, s) = belast_rule MayRec2 r s in let AnyS (r, pf) = get_symbols r in AnyS (TCns (MayRec2, s, r), RelS pf) | TNext (NoRec2, r, s) -> let Belast (NoRec2, r, s) = belast_rule NoRec2 r s in let AnyS (r, pf) = get_symbols r in AnyS (TCns (NoRec2, s, r), RelS pf) let get_rec_symbols (type s tr p) (s : (s, tr, p) ty_symbols) : tr ty_rec = match s with TCns (MayRec2, _, _) -> MayRec | TCns (NoRec2, _, _) -> NoRec | TNil -> NoRec let get_rec_tree (type s tr f) (s : (s, tr, f) ty_tree) : tr ty_rec = match s with Node (MayRec3, _) -> MayRec | Node (NoRec3, _) -> NoRec | LocAct _ -> NoRec | DeadEnd -> NoRec let and_symbols_tree (type s trs trt p f) (s : (s, trs, p) ty_symbols) (t : (s, trt, f) ty_tree) : (trs, trt) ty_mayrec_and_ex = match get_rec_symbols s, get_rec_tree t with | MayRec, MayRec -> MayRecNR NR00 | MayRec, NoRec -> MayRecNR NR01 | NoRec, MayRec -> MayRecNR NR10 | NoRec, NoRec -> MayRecNR NR11 let and_and_tree (type s tr' trt tr trn trs trb f) (ar : (tr', trt, tr) ty_and_rec) (arn : (trn, trs, trb, trt) ty_and_rec3) (t : (s, trb, f) ty_tree) : (tr', trb, tr) ty_and_rec = match ar, arn, get_rec_tree t with | MayRec2, _, MayRec -> MayRec2 | MayRec2, _, NoRec -> MayRec2 | NoRec2, NoRec3, NoRec -> NoRec2 let insert_tree (type s trs trt tr p k a) entry_name (ar : (trs, trt, tr) ty_and_ex) (gsymbols : (s, trs, p) ty_symbols) (pf : (p, k, a) rel_prod) (action : k) (tree : (s, trt, a) ty_tree) : (s, tr, a) ty_tree = let rec insert : type trs trt tr p f k. (trs, trt, tr) ty_and_ex -> (s, trs, p) ty_symbols -> (p, k, f) rel_prod -> (s, trt, f) ty_tree -> k -> (s, tr, f) ty_tree = fun ar symbols pf tree action -> match symbols, pf with TCns (ars, s, sl), RelS pf -> (* descent in tree at symbol [s] *) insert_in_tree ar ars s sl pf tree action | TNil, Rel0 -> (* insert the action *) let node (type tb) ({node = s; son = son; brother = bro} : (_, _, _, tb, _, _) ty_node) = let ar : (norec, tb, tb) ty_and_ex = match get_rec_tree bro with MayRec -> NR10 | NoRec -> NR11 in {node = s; son = son; brother = insert ar TNil Rel0 bro action} in match ar, tree with | NR10, Node (_, n) -> Node (MayRec3, node n) | NR11, Node (NoRec3, n) -> Node (NoRec3, node n) | NR11, LocAct (old_action, action_list) -> (* What to do about this warning? For now it is disabled *) if false then begin let msg = " Grammar extension: " ^ (if entry_name = "" then "" else "in ["^entry_name^"%s], ") ^ "some rule has been masked" in Feedback.msg_warning (Pp.str msg) end; LocAct (action, old_action :: action_list) | NR11, DeadEnd -> LocAct (action, []) and insert_in_tree : type trs trs' trs'' trt tr a p f k. (trs'', trt, tr) ty_and_ex -> (trs, trs', trs'') ty_and_rec -> (s, trs, a) ty_symbol -> (s, trs', p) ty_symbols -> (p, k, a -> f) rel_prod -> (s, trt, f) ty_tree -> k -> (s, tr, f) ty_tree = fun ar ars s sl pf tree action -> let ar : (trs'', trt, tr) ty_and_rec = match ar with NR11 -> NoRec2 | NR00 -> MayRec2 | NR01 -> MayRec2 | NR10 -> MayRec2 in match try_insert ar ars s sl pf tree action with Some t -> t | None -> let node ar = {node = s; son = insert ar sl pf DeadEnd action; brother = tree} in match ar, ars, get_rec_symbols sl with | MayRec2, MayRec2, MayRec -> Node (MayRec3, node NR01) | MayRec2, _, NoRec -> Node (MayRec3, node NR11) | NoRec2, NoRec2, NoRec -> Node (NoRec3, node NR11) and try_insert : type trs trs' trs'' trt tr a p f k. (trs'', trt, tr) ty_and_rec -> (trs, trs', trs'') ty_and_rec -> (s, trs, a) ty_symbol -> (s, trs', p) ty_symbols -> (p, k, a -> f) rel_prod -> (s, trt, f) ty_tree -> k -> (s, tr, f) ty_tree option = fun ar ars symb symbl pf tree action -> match tree with Node (arn, {node = symb1; son = son; brother = bro}) -> (* merging rule [symb; symbl -> action] in tree [symb1; son | bro] *) begin match eq_symbol symb symb1 with | Some Refl -> (* reducing merge of [symb; symbl -> action] with [symb1; son] to merge of [symbl -> action] with [son] *) let MayRecNR arss = and_symbols_tree symbl son in let son = insert arss symbl pf son action in let node = {node = symb1; son = son; brother = bro} in (* propagate presence of SELF/NEXT *) begin match ar, ars, arn, arss with | MayRec2, _, _, _ -> Some (Node (MayRec3, node)) | NoRec2, NoRec2, NoRec3, NR11 -> Some (Node (NoRec3, node)) end | None -> let ar' = and_and_tree ar arn bro in if is_before symb1 symb || derive_eps symb && not (derive_eps symb1) then (* inserting new rule after current rule, i.e. in [bro] *) let bro = match try_insert ar' ars symb symbl pf bro action with Some bro -> (* could insert in [bro] *) bro | None -> (* not ok to insert in [bro] or after; we insert now *) let MayRecNR arss = and_symbols_tree symbl DeadEnd in let son = insert arss symbl pf DeadEnd action in let node = {node = symb; son = son; brother = bro} in (* propagate presence of SELF/NEXT *) match ar, ars, arn, arss with | MayRec2, _, _, _ -> Node (MayRec3, node) | NoRec2, NoRec2, NoRec3, NR11 -> Node (NoRec3, node) in let node = {node = symb1; son = son; brother = bro} in (* propagate presence of SELF/NEXT *) match ar, arn with | MayRec2, _ -> Some (Node (MayRec3, node)) | NoRec2, NoRec3 -> Some (Node (NoRec3, node)) else (* should insert in [bro] or before the tree [symb1; son | bro] *) match try_insert ar' ars symb symbl pf bro action with Some bro -> (* could insert in [bro] *) let node = {node = symb1; son = son; brother = bro} in begin match ar, arn with | MayRec2, _ -> Some (Node (MayRec3, node)) | NoRec2, NoRec3 -> Some (Node (NoRec3, node)) end | None -> (* should insert before [symb1; son | bro] *) None end | LocAct (_, _) -> None | DeadEnd -> None in insert ar gsymbols pf tree action let insert_tree_norec (type s p k a) entry_name (gsymbols : (s, norec, p) ty_symbols) (pf : (p, k, a) rel_prod) (action : k) (tree : (s, norec, a) ty_tree) : (s, norec, a) ty_tree = insert_tree entry_name NR11 gsymbols pf action tree let insert_tree (type s trs trt p k a) entry_name (gsymbols : (s, trs, p) ty_symbols) (pf : (p, k, a) rel_prod) (action : k) (tree : (s, trt, a) ty_tree) : (s, a) ty_mayrec_tree = let MayRecNR ar = and_symbols_tree gsymbols tree in MayRecTree (insert_tree entry_name ar gsymbols pf action tree) let srules (type self a) (rl : a ty_rules list) : (self, norec, a) ty_symbol = let rec retype_tree : type s a. (s, norec, a) ty_tree -> (self, norec, a) ty_tree = function | Node (NoRec3, {node = s; son = son; brother = bro}) -> Node (NoRec3, {node = retype_symbol s; son = retype_tree son; brother = retype_tree bro}) | LocAct (k, kl) -> LocAct (k, kl) | DeadEnd -> DeadEnd and retype_symbol : type s a. (s, norec, a) ty_symbol -> (self, norec, a) ty_symbol = function | Stoken p -> Stoken p | Stokens l -> Stokens l | Slist1 s -> Slist1 (retype_symbol s) | Slist1sep (s, sep, b) -> Slist1sep (retype_symbol s, retype_symbol sep, b) | Slist0 s -> Slist0 (retype_symbol s) | Slist0sep (s, sep, b) -> Slist0sep (retype_symbol s, retype_symbol sep, b) | Sopt s -> Sopt (retype_symbol s) | Snterm e -> Snterm e | Snterml (e, l) -> Snterml (e, l) | Stree t -> Stree (retype_tree t) in let rec retype_rule : type s k r. (s, norec, k, r) ty_rule -> (self, norec, k, r) ty_rule = function | TStop -> TStop | TNext (NoRec2, r, s) -> TNext (NoRec2, retype_rule r, retype_symbol s) in let t = List.fold_left (fun tree (TRules (symbols, action)) -> let symbols = retype_rule symbols in let AnyS (symbols, pf) = get_symbols symbols in insert_tree_norec "" symbols pf action tree) DeadEnd rl in Stree t let is_level_labelled n (Level lev) = match lev.lname with Some n1 -> n = n1 | None -> false let insert_level (type s tr p k) entry_name (symbols : (s, tr, p) ty_symbols) (pf : (p, k, Loc.t -> s) rel_prod) (action : k) (slev : s ty_level) : s ty_level = match symbols with | TCns (_, Sself, symbols) -> (* Insert a rule of the form "SELF; ...." *) let Level slev = slev in let RelS pf = pf in let MayRecTree lsuffix = insert_tree entry_name symbols pf action slev.lsuffix in Level {assoc = slev.assoc; lname = slev.lname; lsuffix = lsuffix; lprefix = slev.lprefix} | _ -> (* Insert a rule not starting with SELF *) let Level slev = slev in let MayRecTree lprefix = insert_tree entry_name symbols pf action slev.lprefix in Level {assoc = slev.assoc; lname = slev.lname; lsuffix = slev.lsuffix; lprefix = lprefix} let empty_lev lname assoc = let assoc = match assoc with Some a -> a | None -> LeftA in Level {assoc = assoc; lname = lname; lsuffix = DeadEnd; lprefix = DeadEnd} let err_no_level lev e = let msg = sprintf "Grammar.extend: No level labelled \"%s\" in entry \"%s\"" lev e in failwith msg let get_position entry position levs = match position with First -> [], levs | Last -> levs, [] | Before n -> let rec get = function [] -> err_no_level n entry.ename | lev :: levs -> if is_level_labelled n lev then [], lev :: levs else let (levs1, levs2) = get levs in lev :: levs1, levs2 in get levs | After n -> let rec get = function [] -> err_no_level n entry.ename | lev :: levs -> if is_level_labelled n lev then [lev], levs else let (levs1, levs2) = get levs in lev :: levs1, levs2 in get levs let get_level entry name levs = match name with | Some n -> let rec get = function [] -> err_no_level n entry.ename | lev :: levs -> if is_level_labelled n lev then [], lev, levs else let (levs1, rlev, levs2) = get levs in lev :: levs1, rlev, levs2 in get levs | None -> begin match levs with lev :: levs -> [], lev, levs | [] -> let msg = sprintf "Grammar.extend: No top level in entry \"%s\"" entry.ename in failwith msg end let change_to_self0 (type s) (type trec) (type a) (entry : s ty_entry) : (s, trec, a) ty_symbol -> (s, a) ty_mayrec_symbol = function | Snterm e -> begin match eq_entry e entry with | None -> MayRecSymbol (Snterm e) | Some Refl -> MayRecSymbol (Sself) end | x -> MayRecSymbol x let rec change_to_self : type s trec a r. s ty_entry -> (s, trec, a, r) ty_rule -> (s, a, r) ty_mayrec_rule = fun e r -> match r with | TStop -> MayRecRule TStop | TNext (_, r, t) -> let MayRecRule r = change_to_self e r in let MayRecSymbol t = change_to_self0 e t in MayRecRule (TNext (MayRec2, r, t)) type 's add_kw = { add_kw : 'c. 's -> 'c pattern -> 's } let insert_tokens {add_kw} lstate symbols = let rec insert : type s trec a. _ -> (s, trec, a) ty_symbol -> _ = fun lstate -> function | Slist0 s -> insert lstate s | Slist1 s -> insert lstate s | Slist0sep (s, t, _) -> let lstate = insert lstate s in insert lstate t | Slist1sep (s, t, _) -> let lstate = insert lstate s in insert lstate t | Sopt s -> insert lstate s | Stree t -> tinsert lstate t | Stoken tok -> add_kw lstate tok | Stokens (TPattern tok::_) -> (* Only the first token is liable to trigger a keyword effect *) add_kw lstate tok | Stokens [] -> assert false | Snterm _ | Snterml _ | Snext | Sself -> lstate and tinsert : type s tr a. _ -> (s, tr, a) ty_tree -> _ = fun lstate -> function Node (_, {node = s; brother = bro; son = son}) -> let lstate = insert lstate s in let lstate = tinsert lstate bro in tinsert lstate son | LocAct _ | DeadEnd -> lstate and linsert : type s tr p. _ -> (s, tr, p) ty_symbols -> _ = fun lstate -> function | TNil -> lstate | TCns (_, s, r) -> let lstate = insert lstate s in linsert lstate r in linsert lstate symbols type 'a single_extend_statement = string option * Gramext.g_assoc option * 'a ty_production list type 'a extend_statement = | Reuse of string option * 'a ty_production list | Fresh of Gramext.position * 'a single_extend_statement list let add_prod add_kw entry (lstate, lev) (TProd (symbols, action)) = let MayRecRule symbols = change_to_self entry symbols in let AnyS (symbols, pf) = get_symbols symbols in let lstate = insert_tokens add_kw lstate symbols in lstate, insert_level entry.ename symbols pf action lev let levels_of_rules add_kw lstate entry edata st = let elev = match edata.edesc with Dlevels elev -> elev | Dparser _ -> let msg = sprintf "Grammar.extend: entry not extensible: \"%s\"" entry.ename in failwith msg in match st with | Reuse (name, []) -> lstate, elev | Reuse (name, prods) -> let (levs1, lev, levs2) = get_level entry name elev in let lstate, lev = List.fold_left (fun lev prod -> add_prod add_kw entry lev prod) (lstate, lev) prods in lstate, levs1 @ [lev] @ levs2 | Fresh (position, rules) -> let (levs1, levs2) = get_position entry position elev in let fold (lstate, levs) (lname, assoc, prods) = let lev = empty_lev lname assoc in let lstate, lev = List.fold_left (fun lev prod -> add_prod add_kw entry lev prod) (lstate, lev) prods in lstate, lev :: levs in let lstate, levs = List.fold_left fold (lstate, []) rules in lstate, levs1 @ List.rev levs @ levs2 let logically_eq_symbols entry = let rec eq_symbols : type s1 s2 trec1 trec2 a1 a2. (s1, trec1, a1) ty_symbol -> (s2, trec2, a2) ty_symbol -> bool = fun s1 s2 -> match s1, s2 with Snterm e1, Snterm e2 -> e1.ename = e2.ename | Snterm e1, Sself -> e1.ename = entry.ename | Sself, Snterm e2 -> entry.ename = e2.ename | Snterml (e1, l1), Snterml (e2, l2) -> e1.ename = e2.ename && l1 = l2 | Slist0 s1, Slist0 s2 -> eq_symbols s1 s2 | Slist0sep (s1, sep1, b1), Slist0sep (s2, sep2, b2) -> eq_symbols s1 s2 && eq_symbols sep1 sep2 && b1 = b2 | Slist1 s1, Slist1 s2 -> eq_symbols s1 s2 | Slist1sep (s1, sep1, b1), Slist1sep (s2, sep2, b2) -> eq_symbols s1 s2 && eq_symbols sep1 sep2 && b1 = b2 | Sopt s1, Sopt s2 -> eq_symbols s1 s2 | Stree t1, Stree t2 -> eq_trees t1 t2 | Stoken p1, Stoken p2 -> L.tok_pattern_eq p1 p2 <> None | Stokens pl1, Stokens pl2 -> tok_pattern_eq_list pl1 pl2 <> None | Sself, Sself -> true | Snext, Snext -> true | _ -> false and eq_trees : type s1 s2 tr1 tr2 a1 a2. (s1, tr1, a1) ty_tree -> (s2, tr2, a2) ty_tree -> bool = fun t1 t2 -> match t1, t2 with Node (_, n1), Node (_, n2) -> eq_symbols n1.node n2.node && eq_trees n1.son n2.son && eq_trees n1.brother n2.brother | LocAct _, LocAct _ -> true | LocAct _, DeadEnd -> true | DeadEnd, LocAct _ -> true | DeadEnd, DeadEnd -> true | _ -> false in eq_symbols (* [delete_rule_in_tree] returns [Some (dsl, t)] if success [dsl] = Some (list of deleted nodes) if branch deleted None if action replaced by previous version of action [t] = remaining tree [None] if failure *) type 's ex_symbols = | ExS : ('s, 'tr, 'p) ty_symbols -> 's ex_symbols let delete_rule_in_tree entry = let rec delete_in_tree : type s tr tr' p r. (s, tr, p) ty_symbols -> (s, tr', r) ty_tree -> (s ex_symbols option * (s, r) ty_mayrec_tree) option = fun symbols tree -> match symbols, tree with | TCns (_, s, sl), Node (_, n) -> if logically_eq_symbols entry s n.node then delete_son sl n else begin match delete_in_tree symbols n.brother with Some (dsl, MayRecTree t) -> Some (dsl, MayRecTree (Node (MayRec3, {node = n.node; son = n.son; brother = t}))) | None -> None end | TCns (_, s, sl), _ -> None | TNil, Node (_, n) -> begin match delete_in_tree TNil n.brother with Some (dsl, MayRecTree t) -> Some (dsl, MayRecTree (Node (MayRec3, {node = n.node; son = n.son; brother = t}))) | None -> None end | TNil, DeadEnd -> None | TNil, LocAct (_, []) -> Some (Some (ExS TNil), MayRecTree DeadEnd) | TNil, LocAct (_, action :: list) -> Some (None, MayRecTree (LocAct (action, list))) and delete_son : type s p tr trn trs trb a r. (s, tr, p) ty_symbols -> (s, trn, trs, trb, a, r) ty_node -> (s ex_symbols option * (s, r) ty_mayrec_tree) option = fun sl n -> match delete_in_tree sl n.son with Some (Some (ExS dsl), MayRecTree DeadEnd) -> Some (Some (ExS (TCns (MayRec2, n.node, dsl))), MayRecTree n.brother) | Some (Some (ExS dsl), MayRecTree t) -> let t = Node (MayRec3, {node = n.node; son = t; brother = n.brother}) in Some (Some (ExS (TCns (MayRec2, n.node, dsl))), MayRecTree t) | Some (None, MayRecTree t) -> let t = Node (MayRec3, {node = n.node; son = t; brother = n.brother}) in Some (None, MayRecTree t) | None -> None in delete_in_tree let rec delete_rule_in_suffix entry symbols = function Level lev :: levs -> begin match delete_rule_in_tree entry symbols lev.lsuffix with Some (dsl, MayRecTree t) -> begin match t, lev.lprefix with DeadEnd, DeadEnd -> levs | _ -> let lev = {assoc = lev.assoc; lname = lev.lname; lsuffix = t; lprefix = lev.lprefix} in Level lev :: levs end | None -> let levs = delete_rule_in_suffix entry symbols levs in Level lev :: levs end | [] -> raise Not_found let rec delete_rule_in_prefix entry symbols = function Level lev :: levs -> begin match delete_rule_in_tree entry symbols lev.lprefix with Some (dsl, MayRecTree t) -> begin match t, lev.lsuffix with DeadEnd, DeadEnd -> levs | _ -> let lev = {assoc = lev.assoc; lname = lev.lname; lsuffix = lev.lsuffix; lprefix = t} in Level lev :: levs end | None -> let levs = delete_rule_in_prefix entry symbols levs in Level lev :: levs end | [] -> raise Not_found let delete_rule_in_level_list (type s tr p) (entry : s ty_entry) (symbols : (s, tr, p) ty_symbols) levs = match symbols with TCns (_, Sself, symbols) -> delete_rule_in_suffix entry symbols levs | TCns (_, Snterm e, symbols') -> begin match eq_entry e entry with | None -> delete_rule_in_prefix entry symbols levs | Some Refl -> delete_rule_in_suffix entry symbols' levs end | _ -> delete_rule_in_prefix entry symbols levs let rec flatten_tree : type s tr a. (s, tr, a) ty_tree -> s ex_symbols list = function DeadEnd -> [] | LocAct (_, _) -> [ExS TNil] | Node (_, {node = n; brother = b; son = s}) -> List.map (fun (ExS l) -> ExS (TCns (MayRec2, n, l))) (flatten_tree s) @ flatten_tree b let utf8_string_escaped s = let b = Buffer.create (String.length s) in let rec loop i = if i = String.length s then Buffer.contents b else begin begin match s.[i] with '"' -> Buffer.add_string b "\\\"" | '\\' -> Buffer.add_string b "\\\\" | '\n' -> Buffer.add_string b "\\n" | '\t' -> Buffer.add_string b "\\t" | '\r' -> Buffer.add_string b "\\r" | '\b' -> Buffer.add_string b "\\b" | c -> Buffer.add_char b c end; loop (i + 1) end in loop 0 let string_escaped s = utf8_string_escaped s let print_str ppf s = fprintf ppf "\"%s\"" (string_escaped s) let print_token b ppf p = match L.tok_pattern_strings p with | "", Some s -> print_str ppf s | con, Some prm -> if b then fprintf ppf "%s@ %a" con print_str prm else fprintf ppf "(%s@ %a)" con print_str prm | con, None -> fprintf ppf "%s" con let print_tokens ppf = function | [] -> assert false | TPattern p :: pl -> fprintf ppf "[%a%a]" (print_token true) p (fun ppf -> List.iter (function TPattern p -> fprintf ppf ";@ "; print_token true ppf p)) pl let rec print_symbol : type s tr r. formatter -> (s, tr, r) ty_symbol -> unit = fun ppf -> function | Slist0 s -> fprintf ppf "LIST0 %a" print_symbol1 s | Slist0sep (s, t, osep) -> fprintf ppf "LIST0 %a SEP %a%s" print_symbol1 s print_symbol1 t (if osep then " OPT_SEP" else "") | Slist1 s -> fprintf ppf "LIST1 %a" print_symbol1 s | Slist1sep (s, t, osep) -> fprintf ppf "LIST1 %a SEP %a%s" print_symbol1 s print_symbol1 t (if osep then " OPT_SEP" else "") | Sopt s -> fprintf ppf "OPT %a" print_symbol1 s | Stoken p -> print_token true ppf p | Stokens [TPattern p] -> print_token true ppf p | Stokens pl -> print_tokens ppf pl | Snterml (e, l) -> fprintf ppf "%s%s@ LEVEL@ %a" e.ename "" print_str l | s -> print_symbol1 ppf s and print_symbol1 : type s tr r. formatter -> (s, tr, r) ty_symbol -> unit = fun ppf -> function | Snterm e -> fprintf ppf "%s%s" e.ename "" | Sself -> pp_print_string ppf "SELF" | Snext -> pp_print_string ppf "NEXT" | Stoken p -> print_token false ppf p | Stokens [TPattern p] -> print_token false ppf p | Stokens pl -> print_tokens ppf pl | Stree t -> print_level ppf pp_print_space (flatten_tree t) | s -> fprintf ppf "(%a)" print_symbol s and print_rule : type s tr p. formatter -> (s, tr, p) ty_symbols -> unit = fun ppf symbols -> fprintf ppf "@["; let rec fold : type s tr p. _ -> (s, tr, p) ty_symbols -> unit = fun sep symbols -> match symbols with | TNil -> () | TCns (_, symbol, symbols) -> fprintf ppf "%t%a" sep print_symbol symbol; fold (fun ppf -> fprintf ppf ";@ ") symbols in let () = fold (fun ppf -> ()) symbols in fprintf ppf "@]" and print_level : type s. _ -> _ -> s ex_symbols list -> _ = fun ppf pp_print_space rules -> fprintf ppf "@[[ "; let () = Format.pp_print_list ~pp_sep:(fun ppf () -> fprintf ppf "%a| " pp_print_space ()) (fun ppf (ExS rule) -> print_rule ppf rule) ppf rules in fprintf ppf " ]@]" let print_levels ppf elev = Format.pp_print_list ~pp_sep:(fun ppf () -> fprintf ppf "@,| ") (fun ppf (Level lev) -> let rules = List.map (fun (ExS t) -> ExS (TCns (MayRec2, Sself, t))) (flatten_tree lev.lsuffix) @ flatten_tree lev.lprefix in fprintf ppf "@["; begin match lev.lname with Some n -> fprintf ppf "%a@;<1 2>" print_str n | None -> () end; begin match lev.assoc with LeftA -> fprintf ppf "LEFTA" | RightA -> fprintf ppf "RIGHTA" | NonA -> fprintf ppf "NONA" end; fprintf ppf "@]@;<1 2>"; print_level ppf pp_force_newline rules) ppf elev let print_entry estate ppf e = fprintf ppf "@[[ "; begin match (get_entry estate e).edesc with Dlevels elev -> print_levels ppf elev | Dparser _ -> fprintf ppf "" end; fprintf ppf " ]@]" let name_of_symbol : type s tr a. s ty_entry -> (s, tr, a) ty_symbol -> string = fun entry -> function Snterm e -> "[" ^ e.ename ^ "]" | Snterml (e, l) -> "[" ^ e.ename ^ " level " ^ l ^ "]" | Sself -> "[" ^ entry.ename ^ "]" | Snext -> "[" ^ entry.ename ^ "]" | Stoken tok -> L.tok_text tok | Stokens tokl -> String.concat " " (List.map (function TPattern tok -> L.tok_text tok) tokl) | Slist0 _ -> assert false | Slist1sep _ -> assert false | Slist1 _ -> assert false | Slist0sep _ -> assert false | Sopt _ -> assert false | Stree _ -> assert false type ('r, 'f) tok_list = | TokNil : ('f, 'f) tok_list | TokCns : 'a pattern * ('r, 'f) tok_list -> ('a -> 'r, 'f) tok_list type ('s, 'f) tok_tree = TokTree : 'a pattern * ('s, _, 'a -> 'r) ty_tree * ('r, 'f) tok_list -> ('s, 'f) tok_tree let rec get_token_list : type s tr a r f. s ty_entry -> a pattern -> (r, f) tok_list -> (s, tr, a -> r) ty_tree -> (s, f) tok_tree option = fun entry last_tok rev_tokl tree -> match tree with Node (_, {node = Stoken tok; son = son; brother = DeadEnd}) -> get_token_list entry tok (TokCns (last_tok, rev_tokl)) son | _ -> match rev_tokl with | TokNil -> None | _ -> Some (TokTree (last_tok, tree, rev_tokl)) let rec name_of_symbol_failed : type s tr a. s ty_entry -> (s, tr, a) ty_symbol -> _ = fun entry -> function | Slist0 s -> name_of_symbol_failed entry s | Slist0sep (s, _, _) -> name_of_symbol_failed entry s | Slist1 s -> name_of_symbol_failed entry s | Slist1sep (s, _, _) -> name_of_symbol_failed entry s | Sopt s -> name_of_symbol_failed entry s | Stree t -> name_of_tree_failed entry t | s -> name_of_symbol entry s and name_of_tree_failed : type s tr a. s ty_entry -> (s, tr, a) ty_tree -> _ = fun entry -> function Node (_, {node = s; son = son; brother = bro}) -> let tokl = match s with Stoken tok -> get_token_list entry tok TokNil son | _ -> None in let txt = match tokl with | None -> let txt = name_of_symbol_failed entry s in let txt = match s, son with Sopt _, Node _ -> txt ^ " or " ^ name_of_tree_failed entry son | _ -> txt in txt | Some (TokTree (last_tok, _, rev_tokl)) -> let rec build_str : type a b. string -> (a, b) tok_list -> string = fun s -> function | TokNil -> s | TokCns (tok, t) -> build_str (L.tok_text tok ^ " " ^ s) t in build_str (L.tok_text last_tok) rev_tokl in begin match bro with | DeadEnd -> txt | LocAct (_, _) -> "nothing else" | Node _ -> txt ^ " or " ^ name_of_tree_failed entry bro end | DeadEnd -> "???" | LocAct (_, _) -> "nothing else" let tree_failed (type s tr a) (entry : s ty_entry) (prev_symb_result : a) (prev_symb : (s, tr, a) ty_symbol) tree = let txt = name_of_tree_failed entry tree in let txt = match prev_symb with Slist0 s -> let txt1 = name_of_symbol_failed entry s in txt1 ^ " or " ^ txt ^ " expected" | Slist1 s -> let txt1 = name_of_symbol_failed entry s in txt1 ^ " or " ^ txt ^ " expected" | Slist0sep (s, sep, _) -> begin match prev_symb_result with [] -> let txt1 = name_of_symbol_failed entry s in txt1 ^ " or " ^ txt ^ " expected" | _ -> let txt1 = name_of_symbol_failed entry sep in txt1 ^ " or " ^ txt ^ " expected" end | Slist1sep (s, sep, _) -> begin match prev_symb_result with [] -> let txt1 = name_of_symbol_failed entry s in txt1 ^ " or " ^ txt ^ " expected" | _ -> let txt1 = name_of_symbol_failed entry sep in txt1 ^ " or " ^ txt ^ " expected" end | Sopt _ -> txt ^ " expected" | Stree _ -> txt ^ " expected" | Snterm _ | Snterml _ | Sself | Snext | Stoken _ | Stokens _ -> txt ^ " expected after " ^ name_of_symbol_failed entry prev_symb in txt ^ " (in [" ^ entry.ename ^ "])" let symb_failed entry prev_symb_result prev_symb symb = let tree = Node (MayRec3, {node = symb; brother = DeadEnd; son = DeadEnd}) in tree_failed entry prev_symb_result prev_symb tree exception TokenListFailed : 's ty_entry * 'a * ('s, 'tr, 'a) ty_symbol * ('s, 'b, 'c) ty_tree -> exn let level_number entry lab = let rec lookup levn = function [] -> failwith ("unknown level " ^ lab) | lev :: levs -> if is_level_labelled lab lev then levn else lookup (succ levn) levs in match entry.edesc with Dlevels elev -> lookup 0 elev | Dparser _ -> raise Not_found let rec top_symb : type s tr a. s ty_entry -> (s, tr, a) ty_symbol -> (s, norec, a) ty_symbol = fun entry -> function Sself -> Snterm entry | Snext -> Snterm entry | Snterml (e, _) -> Snterm e | Slist1sep (s, sep, b) -> Slist1sep (top_symb entry s, sep, b) | _ -> raise Stream.Failure let entry_of_symb : type s tr a. s ty_entry -> (s, tr, a) ty_symbol -> a ty_entry = fun entry -> function Sself -> entry | Snext -> entry | Snterm e -> e | Snterml (e, _) -> e | _ -> raise Stream.Failure let top_tree : type s tr a. s ty_entry -> (s, tr, a) ty_tree -> (s, tr, a) ty_tree = fun entry -> function Node (MayRec3, {node = s; brother = bro; son = son}) -> Node (MayRec3, {node = top_symb entry s; brother = bro; son = son}) | Node (NoRec3, {node = s; brother = bro; son = son}) -> Node (NoRec3, {node = top_symb entry s; brother = bro; son = son}) | LocAct (_, _) -> raise Stream.Failure | DeadEnd -> raise Stream.Failure let skip_if_empty bp p strm = if LStream.count strm == bp then fun a -> p strm else raise Stream.Failure let token_ematch tok = let tematch = L.tok_match tok in fun tok -> tematch tok let empty_entry ename levn strm = raise (Error ("entry [" ^ ename ^ "] is empty")) let start_parser_of_entry gstate entry levn (strm:_ LStream.t) = (get_entry gstate.estate entry).estart gstate levn strm let continue_parser_of_entry gstate entry levn bp a (strm:_ LStream.t) = (get_entry gstate.estate entry).econtinue gstate levn bp a strm (** nlevn: level for Snext alevn: level for recursive calls on the right-hand side of the rule (depending on associativity) *) let rec parser_of_tree : type s tr r. s ty_entry -> int -> int -> (s, tr, r) ty_tree -> GState.t -> r parser_t = fun entry nlevn alevn -> function DeadEnd -> (fun _ (strm__ : _ LStream.t) -> raise Stream.Failure) | LocAct (act, _) -> (fun _ (strm__ : _ LStream.t) -> act) | Node (_, {node = Sself; son = LocAct (act, _); brother = DeadEnd}) -> (* SELF on the right-hand side of the last rule *) (fun gstate (strm__ : _ LStream.t) -> let a = start_parser_of_entry gstate entry alevn strm__ in act a) | Node (_, {node = Sself; son = LocAct (act, _); brother = bro}) -> (* SELF on the right-hand side of a rule *) let p2 = parser_of_tree entry nlevn alevn bro in (fun gstate (strm__ : _ LStream.t) -> match try Some (start_parser_of_entry gstate entry alevn strm__) with Stream.Failure -> None with Some a -> act a | _ -> p2 gstate strm__) | Node (_, {node = Stoken tok; son = son; brother = DeadEnd}) -> parser_of_token_list entry nlevn alevn tok son | Node (_, {node = Stoken tok; son = son; brother = bro}) -> let p2 = parser_of_tree entry nlevn alevn bro in let p1 = parser_of_token_list entry nlevn alevn tok son in (fun gstate (strm__ : _ LStream.t) -> try p1 gstate strm__ with Stream.Failure -> p2 gstate strm__) | Node (_, {node = s; son = son; brother = DeadEnd}) -> let ps = parser_of_symbol entry nlevn s in let p1 = parser_of_tree entry nlevn alevn son in let p1 = parser_cont p1 entry nlevn alevn s son in (fun gstate (strm__ : _ LStream.t) -> let bp = LStream.count strm__ in let a = ps gstate strm__ in let act = try p1 gstate bp a strm__ with Stream.Failure -> raise (Error (tree_failed entry a s son)) in act a) | Node (_, {node = s; son = son; brother = bro}) -> let ps = parser_of_symbol entry nlevn s in let p1 = parser_of_tree entry nlevn alevn son in let p1 = parser_cont p1 entry nlevn alevn s son in let p2 = parser_of_tree entry nlevn alevn bro in (fun gstate (strm : _ LStream.t) -> let bp = LStream.count strm in match try Some (ps gstate strm) with Stream.Failure -> None with Some a -> begin match (try Some (p1 gstate bp a strm) with Stream.Failure -> None) with Some act -> act a | None -> raise (Error (tree_failed entry a s son)) end | None -> p2 gstate strm) and parser_cont : type s tr tr' a r. (GState.t -> (a -> r) parser_t) -> s ty_entry -> int -> int -> (s, tr, a) ty_symbol -> (s, tr', a -> r) ty_tree -> GState.t -> int -> a -> (a -> r) parser_t = fun p1 entry nlevn alevn s son gstate bp a (strm__ : _ LStream.t) -> try p1 gstate strm__ with Stream.Failure -> (* Recover from a success on [s] with result [a] followed by a failure on [son] in a rule of the form [a = s; son] *) try (* Try to replay the son with the top occurrence of NEXT (by default at level nlevn) and trailing SELF (by default at alevn) replaced with self at top level; This allows for instance to recover from a failure on the second SELF of « SELF; "\/"; SELF » by doing as if it were « SELF; "\/"; same-entry-at-top-level » with application e.g. to accept "A \/ forall x, x = x" w/o requiring the expected parentheses as in "A \/ (forall x, x = x)". *) parser_of_tree entry nlevn alevn (top_tree entry son) gstate strm__ with Stream.Failure -> try (* Discard the rule if what has been consumed before failing is the empty sequence (due to some OPT or LIST0); example: « OPT "!"; ident » fails to see an ident and the OPT was resolved into the empty sequence, with application e.g. to being able to safely write « LIST1 [ OPT "!"; id = ident -> id] ». *) skip_if_empty bp (fun (strm__ : _ LStream.t) -> raise Stream.Failure) strm__ with Stream.Failure -> (* In case of success on just SELF, NEXT or an explicit call to a subentry followed by a failure on the rest (son), retry parsing as if this entry had been called at its toplevel; example: « "{"; entry-at-some-level; "}" » fails on "}" and is retried with « "{"; same-entry-at-top-level; "}" », allowing e.g. to parse « {1 + 1} » while « {(1 + 1)} » would have been expected according to the level. *) let p1 = parser_of_tree entry nlevn alevn son in let a = continue_parser_of_entry gstate (entry_of_symb entry s) 0 bp a strm__ in let act = try p1 gstate strm__ with Stream.Failure -> raise (Error (tree_failed entry a s son)) in fun _ -> act a (** [parser_of_token_list] attempts to look-ahead an arbitrary-long finite sequence of tokens. E.g., in [ [ "foo"; "bar1"; "bar3"; ... -> action1 | "foo"; "bar2"; ... -> action2 | other-rules ] ] compiled as: [ [ "foo"; ["bar1"; "bar3"; ... -> action1 |"bar2"; ... -> action2] | other-rules ] ] this is able to look ahead "foo"; "bar1"; "bar3" and if not found "foo"; "bar1", then, if still not found, "foo"; "bar2" _without_ consuming the tokens until it is sure that a longest chain of tokens (before finding non-terminals or the end of the production) is found (and backtracking to [other-rules] if no such longest chain can be found). *) and parser_of_token_list : type s tr lt r. s ty_entry -> int -> int -> lt pattern -> (s, tr, lt -> r) ty_tree -> GState.t -> r parser_t = fun entry nlevn alevn tok tree -> let rec loop : type tr lt r. int -> lt pattern -> (s, tr, r) ty_tree -> GState.t -> lt -> r parser_t = fun n last_tok tree -> match tree with | Node (_, {node = Stoken tok; son = son; brother = bro}) -> let tematch = token_ematch tok in let p2 = loop n last_tok bro in let p1 = loop (n+1) tok son in fun gstate last_a strm -> (match (try Some (tematch (LStream.peek_nth gstate.kwstate n strm)) with Stream.Failure -> None) with | Some a -> (match try Some (p1 gstate a strm) with Stream.Failure -> None with | Some act -> act a | None -> (try p2 gstate last_a strm with TokenListFailed _ -> raise (TokenListFailed (entry, a, Stoken tok, son)))) | None -> (try p2 gstate last_a strm with TokenListFailed _ -> raise (TokenListFailed (entry, last_a, Stoken last_tok, tree)))) | DeadEnd -> fun gstate last_a strm -> raise Stream.Failure | _ -> let ps = parser_of_tree entry nlevn alevn tree in fun gstate last_a strm -> for _i = 1 to n do LStream.junk gstate.kwstate strm done; match try Some (ps gstate strm) with Stream.Failure -> (* Tolerance: retry w/o granting the level constraint (see recover) *) try Some (parser_of_tree entry nlevn alevn (top_tree entry tree) gstate strm) with Stream.Failure -> None with | Some act -> act | None -> raise (TokenListFailed (entry, last_a, (Stoken last_tok), tree)) in let ps = loop 1 tok tree in let tematch = token_ematch tok in fun gstate strm -> match LStream.peek gstate.kwstate strm with | Some tok' -> let a = tematch tok' in begin try let act = ps gstate a strm in act a with | TokenListFailed (entry, a, tok, tree) -> raise (Error (tree_failed entry a tok tree)) end | None -> raise Stream.Failure and parser_of_symbol : type s tr a. s ty_entry -> int -> (s, tr, a) ty_symbol -> GState.t -> a parser_t = fun entry nlevn -> function | Slist0 s -> let ps = parser_of_symbol entry nlevn s in let rec loop gstate al (strm__ : _ LStream.t) = match try Some (ps gstate strm__ :: al) with Stream.Failure -> None with Some al -> loop gstate al strm__ | _ -> al in (fun gstate (strm__ : _ LStream.t) -> let a = loop gstate [] strm__ in List.rev a) | Slist0sep (symb, sep, false) -> let ps = parser_of_symbol entry nlevn symb in let pt = parser_of_symbol entry nlevn sep in let rec kont gstate al (strm__ : _ LStream.t) = match try Some (pt gstate strm__) with Stream.Failure -> None with Some v -> let al = try ps gstate strm__ :: al with Stream.Failure -> raise (Error (symb_failed entry v sep symb)) in kont gstate al strm__ | _ -> al in (fun gstate (strm__ : _ LStream.t) -> match try Some (ps gstate strm__ :: []) with Stream.Failure -> None with Some al -> let a = kont gstate al strm__ in List.rev a | _ -> []) | Slist0sep (symb, sep, true) -> let ps = parser_of_symbol entry nlevn symb in let pt = parser_of_symbol entry nlevn sep in let rec kont gstate al (strm__ : _ LStream.t) = match try Some (pt gstate strm__) with Stream.Failure -> None with Some v -> begin match (try Some (ps gstate strm__ :: al) with Stream.Failure -> None) with Some al -> kont gstate al strm__ | _ -> al end | _ -> al in (fun gstate (strm__ : _ LStream.t) -> match try Some (ps gstate strm__ :: []) with Stream.Failure -> None with Some al -> let a = kont gstate al strm__ in List.rev a | _ -> []) | Slist1 s -> let ps = parser_of_symbol entry nlevn s in let rec loop gstate al (strm__ : _ LStream.t) = match try Some (ps gstate strm__ :: al) with Stream.Failure -> None with Some al -> loop gstate al strm__ | _ -> al in (fun gstate (strm__ : _ LStream.t) -> let al = ps gstate strm__ :: [] in let a = loop gstate al strm__ in List.rev a) | Slist1sep (symb, sep, false) -> let ps = parser_of_symbol entry nlevn symb in let pt = parser_of_symbol entry nlevn sep in let rec kont gstate al (strm__ : _ LStream.t) = match try Some (pt gstate strm__) with Stream.Failure -> None with Some v -> let al = try ps gstate strm__ :: al with Stream.Failure -> let a = try parse_top_symb entry symb gstate strm__ with Stream.Failure -> raise (Error (symb_failed entry v sep symb)) in a :: al in kont gstate al strm__ | _ -> al in (fun gstate (strm__ : _ LStream.t) -> let al = ps gstate strm__ :: [] in let a = kont gstate al strm__ in List.rev a) | Slist1sep (symb, sep, true) -> let ps = parser_of_symbol entry nlevn symb in let pt = parser_of_symbol entry nlevn sep in let rec kont gstate al (strm__ : _ LStream.t) = match try Some (pt gstate strm__) with Stream.Failure -> None with Some v -> begin match (try Some (ps gstate strm__ :: al) with Stream.Failure -> None) with Some al -> kont gstate al strm__ | _ -> match try Some (parse_top_symb entry symb gstate strm__) with Stream.Failure -> None with Some a -> kont gstate (a :: al) strm__ | _ -> al end | _ -> al in (fun gstate (strm__ : _ LStream.t) -> let al = ps gstate strm__ :: [] in let a = kont gstate al strm__ in List.rev a) | Sopt s -> let ps = parser_of_symbol entry nlevn s in (fun gstate (strm__ : _ LStream.t) -> match try Some (ps gstate strm__) with Stream.Failure -> None with Some a -> Some a | _ -> None) | Stree t -> let pt = parser_of_tree entry 1 0 t in (fun gstate (strm__ : _ LStream.t) -> let bp = LStream.count strm__ in let a = pt gstate strm__ in let ep = LStream.count strm__ in let loc = LStream.interval_loc bp ep strm__ in a loc) | Snterm e -> (fun gstate (strm__ : _ LStream.t) -> start_parser_of_entry gstate e 0 strm__) | Snterml (e, l) -> (fun gstate (strm__ : _ LStream.t) -> start_parser_of_entry gstate e (level_number (get_entry gstate.estate e) l) strm__) | Sself -> (fun gstate (strm__ : _ LStream.t) -> start_parser_of_entry gstate entry 0 strm__) | Snext -> (fun gstate (strm__ : _ LStream.t) -> start_parser_of_entry gstate entry nlevn strm__) | Stoken tok -> let p = parser_of_token entry tok in (fun gstate strm -> p gstate.kwstate strm) | Stokens tokl -> let p = parser_of_tokens entry tokl in (fun gstate strm -> p gstate.kwstate strm) and parser_of_token : type s a. s ty_entry -> a pattern -> L.keyword_state -> a parser_t = fun entry tok -> let f = L.tok_match tok in fun kwstate strm -> match LStream.peek kwstate strm with Some tok -> let r = f tok in LStream.junk kwstate strm; r | None -> raise Stream.Failure and parser_of_tokens : type s. s ty_entry -> ty_pattern list -> L.keyword_state -> unit parser_t = fun entry tokl -> let rec loop n = function | [] -> fun kwstate strm -> for _i = 1 to n do LStream.junk kwstate strm done; () | TPattern tok :: tokl -> let tematch = token_ematch tok in fun kwstate strm -> ignore (tematch (LStream.peek_nth kwstate n strm)); loop (n+1) tokl kwstate strm in loop 0 tokl and parse_top_symb : type s tr a. s ty_entry -> (s, tr, a) ty_symbol -> GState.t -> a parser_t = fun entry symb -> parser_of_symbol entry 0 (top_symb entry symb) (** [start_parser_of_levels entry clevn levels levn strm] goes top-down from level [clevn] to the last level, ignoring rules between [levn] and [clevn], as if starting from [max(clevn,levn)]. On each rule of the form [prefix] (where [prefix] is a rule not starting with [SELF]), it tries to consume the stream [strm]. The interesting case is [entry.estart] which is [start_parser_of_levels entry 0 entry.edesc], thus practically going from [levn] to the end. More schematically, assuming each level has the normalized form level n: [ a = SELF; b = suffix_tree_n -> action_n(a,b) | a = prefix_tree_n -> action'_n(a) ] then the main loop does the following: estart n = if prefix_tree_n matches the stream as a then econtinue n (action'_n(a)) else start (n+1) econtinue n a = if suffix_tree_n matches the stream as b then econtinue n (action_n(a,b)) else if n=0 then a else econtinue (n-1) a *) let rec start_parser_of_levels entry clevn = function [] -> (fun _gstate levn (strm__ : _ LStream.t) -> raise Stream.Failure) | Level lev :: levs -> let p1 = start_parser_of_levels entry (succ clevn) levs in match lev.lprefix with DeadEnd -> p1 | tree -> let alevn = match lev.assoc with LeftA | NonA -> succ clevn | RightA -> clevn in let p2 = parser_of_tree entry (succ clevn) alevn tree in match levs with [] -> (fun gstate levn strm -> (* this code should be there but is commented to preserve compatibility with previous versions... with this code, the grammar entry e: [[ "x"; a = e | "y" ]] should fail because it should be: e: [RIGHTA[ "x"; a = e | "y" ]]... if levn > clevn then match strm with parser [] else *) let (strm__ : _ LStream.t) = strm in let bp = LStream.count strm__ in let act = p2 gstate strm__ in let ep = LStream.count strm__ in let a = act (LStream.interval_loc bp ep strm__) in continue_parser_of_entry gstate entry levn bp a strm) | _ -> fun gstate levn strm -> if levn > clevn then (* Skip rules before [levn] *) p1 gstate levn strm else let (strm__ : _ LStream.t) = strm in let bp = LStream.count strm__ in match try Some (p2 gstate strm__) with Stream.Failure -> None with Some act -> let ep = LStream.count strm__ in let a = act (LStream.interval_loc bp ep strm__) in continue_parser_of_entry gstate entry levn bp a strm | _ -> p1 gstate levn strm__ (** [continue_parser_of_levels entry clevn levels levn bp a strm] goes bottom-up from the last level to level [clevn], ignoring rules between [levn] and [clevn], as if stopping at [max(clevn,levn)]. It tries to consume the stream [strm] on the suffix of rules of the form [SELF; suffix] knowing that [a] is what consumed [SELF] at level [levn] (or [levn+1] depending on associativity). The interesting case is [entry.econtinue levn bp a] which is [try continue_parser_of_levels entry 0 entry.edesc levn bp a with Failure -> a], thus practically going from the end to [levn]. *) let rec continue_parser_of_levels entry clevn = function [] -> (fun _gstate levn bp a (strm__ : _ LStream.t) -> raise Stream.Failure) | Level lev :: levs -> let p1 = continue_parser_of_levels entry (succ clevn) levs in match lev.lsuffix with DeadEnd -> p1 | tree -> let alevn = match lev.assoc with LeftA | NonA -> succ clevn | RightA -> clevn in let p2 = parser_of_tree entry (succ clevn) alevn tree in fun gstate levn bp a strm -> if levn > clevn then (* Skip rules before [levn] *) p1 gstate levn bp a strm else let (strm__ : _ LStream.t) = strm in try p1 gstate levn bp a strm__ with Stream.Failure -> let act = p2 gstate strm__ in let ep = LStream.count strm__ in let a = act a (LStream.interval_loc bp ep strm__) in continue_parser_of_entry gstate entry levn bp a strm let make_continue_parser_of_entry entry desc = match desc with | Dlevels [] -> (fun _ _ _ _ (_ : _ LStream.t) -> raise Stream.Failure) | Dlevels elev -> let p = lazy (continue_parser_of_levels entry 0 elev) in (fun gstate levn bp a (strm__ : _ LStream.t) -> try Lazy.force p gstate levn bp a strm__ with Stream.Failure -> a) | Dparser p -> fun gstate levn bp a (strm__ : _ LStream.t) -> raise Stream.Failure let make_start_parser_of_entry entry desc = match desc with | Dlevels [] -> empty_entry entry.ename | Dlevels elev -> let p = lazy (start_parser_of_levels entry 0 elev) in (fun gstate levn (strm:_ LStream.t) -> Lazy.force p gstate levn strm) | Dparser p -> fun gstate levn strm -> p gstate.kwstate strm let make_entry_data entry desc = { edesc = desc; estart = make_start_parser_of_entry entry desc; econtinue = make_continue_parser_of_entry entry desc; } (* Extend syntax *) let modify_entry estate e f = try EState.modify (DMap.tag_of_onetag e.etag) f estate with Not_found -> assert false let add_entry otag estate e v = assert (not (EState.mem (DMap.tag_of_onetag e.etag) estate)); EState.add otag v estate let extend_entry add_kw estate kwstate entry statement = let kwstate = ref kwstate in let estate = modify_entry estate entry (fun edata -> let kwstate', elev = levels_of_rules add_kw !kwstate entry edata statement in kwstate := kwstate'; make_entry_data entry (Dlevels elev)) in estate, !kwstate (* Deleting a rule *) let delete_rule estate entry sl = modify_entry estate entry (fun edata -> match edata.edesc with | Dlevels levs -> let levs = delete_rule_in_level_list entry sl levs in make_entry_data entry (Dlevels levs) | Dparser _ -> edata) (* Normal interface *) module Parsable = struct type t = { pa_tok_strm : (L.keyword_state,L.te) LStream.t ; lexer_state : L.State.t ref } let parse_parsable gstate entry p = let efun = start_parser_of_entry gstate entry 0 in let ts = p.pa_tok_strm in let get_parsing_loc () = (* Build the loc spanning from just after what is consumed (count) up to the further token known to have been read (max_peek). Being a parsing error, there needs to be a next token that caused the failure, except when the rule is empty (e.g. an empty custom entry); thus, we need to ensure that the token at location cnt has been peeked (which in turn ensures that the max peek is at least the current position) *) let _ = LStream.peek gstate.kwstate ts in let loc' = LStream.max_peek_loc ts in let loc = LStream.get_loc (LStream.count ts) ts in Loc.merge loc loc' in try efun ts with | Stream.Failure as exn -> let exn, info = Exninfo.capture exn in let loc = get_parsing_loc () in let info = Loc.add_loc info loc in let exn = Error ("illegal begin of " ^ entry.ename) in Exninfo.iraise (exn, info) | Error _ as exn -> let exn, info = Exninfo.capture exn in let loc = get_parsing_loc () in let info = Loc.add_loc info loc in Exninfo.iraise (exn, info) | exc -> (* An error produced by the evaluation of the right-hand side *) (* of a rule, or a signal such as Sys.Break; we leave to the *) (* error the responsibility of locating itself *) let exc,info = Exninfo.capture exc in Exninfo.iraise (exc,info) let parse_parsable gstate e p = L.State.set !(p.lexer_state); try let c = parse_parsable gstate e p in p.lexer_state := L.State.get (); c with exn -> let exn,info = Exninfo.capture exn in L.State.drop (); Exninfo.iraise (exn,info) let make ?loc cs = let lexer_state = ref (L.State.init ()) in L.State.set !lexer_state; let ts = L.tok_func ?loc cs in lexer_state := L.State.get (); {pa_tok_strm = ts; lexer_state} let comments p = L.State.get_comments !(p.lexer_state) let loc t = LStream.current_loc t.pa_tok_strm let consume { pa_tok_strm } len kwstate = LStream.njunk kwstate len pa_tok_strm end module Entry = struct type 'a t = 'a ty_entry let fresh n = let etag = DMap.make () in { ename = n; etag }, etag let make n estate = let e, otag = fresh n in let estate = add_entry otag estate e { edesc = Dlevels []; estart = empty_entry n; econtinue = (fun _ _ _ _ (strm__ : _ LStream.t) -> raise Stream.Failure); } in estate, e let parse (e : 'a t) p gstate : 'a = Parsable.parse_parsable gstate e p let parse_token_stream (e : 'a t) ts gstate : 'a = start_parser_of_entry gstate e 0 ts let name e = e.ename type 'a parser_fun = { parser_fun : L.keyword_state -> (L.keyword_state,te) LStream.t -> 'a } let of_parser n { parser_fun = p } estate = let e, otag = fresh n in let estate = add_entry otag estate e { estart = (fun gstate _ (strm:_ LStream.t) -> p gstate.kwstate strm); econtinue = (fun _ _ _ _ (strm__ : _ LStream.t) -> raise Stream.Failure); edesc = Dparser p; } in estate, e let print ppf e estate = fprintf ppf "%a@." (print_entry estate) e let is_empty e estate = match (get_entry estate e).edesc with | Dparser _ -> failwith "Arbitrary parser entry" | Dlevels elev -> List.is_empty elev type any_t = Any : 'a t -> any_t let rec iter_in_symbols : type s tr p. _ -> (s, tr, p) ty_symbols -> unit = fun f symbols -> match symbols with | TNil -> () | TCns (_, symbol, symbols) -> iter_in_symbol f symbol; iter_in_symbols f symbols and iter_in_symbol : type s tr r. _ -> (s, tr, r) ty_symbol -> unit = fun f -> function | Snterml (e, _) | Snterm e -> f (Any e) | Slist0 s -> iter_in_symbol f s | Slist0sep (s, t, _) -> iter_in_symbol f s; iter_in_symbol f t | Slist1 s -> iter_in_symbol f s | Slist1sep (s, t, _) -> iter_in_symbol f s; iter_in_symbol f t | Sopt s -> iter_in_symbol f s | Stoken _ | Stokens _ -> () | Sself | Snext -> () | Stree t -> List.iter (fun (ExS rule) -> iter_in_symbols f rule) (flatten_tree t) let iter_in estate f e = match (get_entry estate e).edesc with | Dparser _ -> () | Dlevels elev -> List.iter (fun (Level lev) -> let rules = List.map (fun (ExS t) -> ExS (TCns (MayRec2, Sself, t))) (flatten_tree lev.lsuffix) @ flatten_tree lev.lprefix in List.iter (fun (ExS rule) -> iter_in_symbols f rule) rules) elev let same_entry (Any e) (Any e') = Option.has_some (eq_entry e e') let accumulate_in initial estate = let add_visited visited (Any e as any) = String.Map.update e.ename (function | None -> Some [any] | Some vl as v -> if List.mem_f same_entry any vl then v else Some (any :: vl)) visited in let todo = ref initial in let visited = List.fold_left add_visited String.Map.empty initial in let visited = ref visited in while not (List.is_empty !todo) do let Any e = List.hd !todo in todo := List.tl !todo; iter_in estate (fun (Any e as any) -> let visited' = add_visited !visited any in if not (!visited == visited') then begin visited := visited'; todo := any :: !todo end) e done; !visited end module rec Symbol : sig type ('self, 'trec, 'a) t = ('self, 'trec, 'a) ty_symbol val nterm : 'a Entry.t -> ('self, norec, 'a) t val nterml : 'a Entry.t -> string -> ('self, norec, 'a) t val list0 : ('self, 'trec, 'a) t -> ('self, 'trec, 'a list) t val list0sep : ('self, 'trec, 'a) t -> ('self, norec, unit) t -> bool -> ('self, 'trec, 'a list) t val list1 : ('self, 'trec, 'a) t -> ('self, 'trec, 'a list) t val list1sep : ('self, 'trec, 'a) t -> ('self, norec, unit) t -> bool -> ('self, 'trec, 'a list) t val opt : ('self, 'trec, 'a) t -> ('self, 'trec, 'a option) t val self : ('self, mayrec, 'self) t val next : ('self, mayrec, 'self) t val token : 'c pattern -> ('self, norec, 'c) t val tokens : ty_pattern list -> ('self, norec, unit) t val rules : 'a Rules.t list -> ('self, norec, 'a) t end = struct type ('self, 'trec, 'a) t = ('self, 'trec, 'a) ty_symbol let nterm e = Snterm e let nterml e l = Snterml (e, l) let list0 s = Slist0 s let list0sep s sep b = Slist0sep (s, sep, b) let list1 s = Slist1 s let list1sep s sep b = Slist1sep (s, sep, b) let opt s = Sopt s let self = Sself let next = Snext let token tok = Stoken tok let tokens tokl = Stokens tokl let rules (t : 'a Rules.t list) = srules t end and Rule : sig type ('self, 'trec, 'f, 'r) t = ('self, 'trec, 'f, 'r) ty_rule val stop : ('self, norec, 'r, 'r) t val next : ('self, _, 'a, 'r) t -> ('self, _, 'b) Symbol.t -> ('self, mayrec, 'b -> 'a, 'r) t val next_norec : ('self, norec, 'a, 'r) Rule.t -> ('self, norec, 'b) Symbol.t -> ('self, norec, 'b -> 'a, 'r) t end = struct type ('self, 'trec, 'f, 'r) t = ('self, 'trec, 'f, 'r) ty_rule let stop = TStop let next r s = TNext (MayRec2, r, s) let next_norec r s = TNext (NoRec2, r, s) end and Rules : sig type 'a t = 'a ty_rules val make : (_, norec, 'f, Loc.t -> 'a) Rule.t -> 'f -> 'a t end = struct type 'a t = 'a ty_rules let make p act = TRules (p, act) end module Production = struct type 'a t = 'a ty_production let make p act = TProd (p, act) end module Unsafe = struct let clear_entry estate e = modify_entry estate e (fun data -> { estart = (fun _ _ (strm__ : _ LStream.t) -> raise Stream.Failure); econtinue = (fun _ _ _ _ (strm__ : _ LStream.t) -> raise Stream.Failure); edesc = match data.edesc with | Dlevels _ -> Dlevels [] | Dparser _ -> data.edesc; }) end let safe_extend = extend_entry let safe_delete_rule estate e (TProd (r,_act)) = let AnyS (symbols, _) = get_symbols r in delete_rule estate e symbols let level_of_nonterm sym = match sym with | Snterml (_,l) -> Some l | _ -> None exception SelfSymbol let rec generalize_symbol : type a tr s u. (s, tr, a) Symbol.t -> (u, norec, a) ty_symbol = function | Stoken tok -> Stoken tok | Stokens tokl -> Stokens tokl | Slist1 e -> Slist1 (generalize_symbol e) | Slist1sep (e, sep, b) -> let e = generalize_symbol e in let sep = generalize_symbol sep in Slist1sep (e, sep, b) | Slist0 e -> Slist0 (generalize_symbol e) | Slist0sep (e, sep, b) -> let e = generalize_symbol e in let sep = generalize_symbol sep in Slist0sep (e, sep, b) | Sopt e -> Sopt (generalize_symbol e) | Sself -> raise SelfSymbol | Snext -> raise SelfSymbol | Snterm e -> Snterm e | Snterml (e, l) -> Snterml (e, l) | Stree r -> Stree (generalize_tree r) and generalize_tree : type a tr s u. (s, tr, a) ty_tree -> (u, norec, a) ty_tree = fun r -> match r with | Node (fi, n) -> let fi = match fi with | NoRec3 -> NoRec3 | MayRec3 -> raise SelfSymbol in let n = match n with | { node; son; brother } -> let node = generalize_symbol node in let son = generalize_tree son in let brother = generalize_tree brother in { node; son; brother } in Node (fi, n) | LocAct _ as r -> r | DeadEnd as r -> r let generalize_symbol s = try Some (generalize_symbol s) with SelfSymbol -> None end coq-8.20.0/gramlib/grammar.mli000066400000000000000000000131071466560755400161550ustar00rootroot00000000000000(* camlp5r *) (* grammar.mli,v *) (* Copyright (c) INRIA 2007-2017 *) (** Extensible grammars. This module implements the Camlp5 extensible grammars system. Grammars entries can be extended using the [EXTEND] statement, added by loading the Camlp5 [pa_extend.cmo] file. *) exception Error of string (** Raised by parsers when the first component of a stream pattern is accepted, but one of the following components is rejected. *) (** {6 Functorial interface} *) (** Alternative for grammars use. Grammars are no more Ocaml values: there is no type for them. Modules generated preserve the rule "an entry cannot call an entry of another grammar" by normal OCaml typing. *) (** The input signature for the functor [Grammar.GMake]: [te] is the type of the tokens. *) type norec type mayrec module type S = sig type keyword_state type te type 'c pattern type ty_pattern = TPattern : 'a pattern -> ty_pattern (** Type combinators to factor the module type between explicit state passing in Grammar and global state in Pcoq *) type 'a with_gstate (** Reader of grammar state *) type 'a with_kwstate (** Read keyword state *) type 'a with_estate (** Read entry state *) type 'a mod_estate (** Read/write entry state *) module Parsable : sig type t val make : ?loc:Loc.t -> (unit,char) Stream.t -> t val comments : t -> ((int * int) * string) list val loc : t -> Loc.t val consume : t -> int -> unit with_kwstate end module Entry : sig type 'a t val make : string -> 'a t mod_estate val parse : 'a t -> Parsable.t -> 'a with_gstate val name : 'a t -> string type 'a parser_fun = { parser_fun : keyword_state -> (keyword_state,te) LStream.t -> 'a } val of_parser : string -> 'a parser_fun -> 'a t mod_estate val parse_token_stream : 'a t -> (keyword_state,te) LStream.t -> 'a with_gstate val print : Format.formatter -> 'a t -> unit with_estate val is_empty : 'a t -> bool with_estate type any_t = Any : 'a t -> any_t val accumulate_in : any_t list -> any_t list CString.Map.t with_estate end module rec Symbol : sig type ('self, 'trec, 'a) t val nterm : 'a Entry.t -> ('self, norec, 'a) t val nterml : 'a Entry.t -> string -> ('self, norec, 'a) t val list0 : ('self, 'trec, 'a) t -> ('self, 'trec, 'a list) t val list0sep : ('self, 'trec, 'a) t -> ('self, norec, unit) t -> bool -> ('self, 'trec, 'a list) t val list1 : ('self, 'trec, 'a) t -> ('self, 'trec, 'a list) t val list1sep : ('self, 'trec, 'a) t -> ('self, norec, unit) t -> bool -> ('self, 'trec, 'a list) t val opt : ('self, 'trec, 'a) t -> ('self, 'trec, 'a option) t val self : ('self, mayrec, 'self) t val next : ('self, mayrec, 'self) t val token : 'c pattern -> ('self, norec, 'c) t val tokens : ty_pattern list -> ('self, norec, unit) t val rules : 'a Rules.t list -> ('self, norec, 'a) t end and Rule : sig type ('self, 'trec, 'f, 'r) t val stop : ('self, norec, 'r, 'r) t val next : ('self, _, 'a, 'r) t -> ('self, _, 'b) Symbol.t -> ('self, mayrec, 'b -> 'a, 'r) t val next_norec : ('self, norec, 'a, 'r) Rule.t -> ('self, norec, 'b) Symbol.t -> ('self, norec, 'b -> 'a, 'r) t end and Rules : sig type 'a t val make : (_, norec, 'f, Loc.t -> 'a) Rule.t -> 'f -> 'a t end module Production : sig type 'a t val make : ('a, _, 'f, Loc.t -> 'a) Rule.t -> 'f -> 'a t end type 'a single_extend_statement = string option * Gramext.g_assoc option * 'a Production.t list type 'a extend_statement = | Reuse of string option * 'a Production.t list (** Extend an existing level by its optional given name. If None, picks the topmost level. *) | Fresh of Gramext.position * 'a single_extend_statement list (** Create a level at the given position. *) val generalize_symbol : ('a, 'tr, 'c) Symbol.t -> ('b, norec, 'c) Symbol.t option (* Used in custom entries, should tweak? *) val level_of_nonterm : ('a, norec, 'c) Symbol.t -> string option end (* Interface private to clients *) module type ExtS = sig type keyword_state module EState : sig type t val empty : t end module GState : sig type t = { estate : EState.t; kwstate : keyword_state; } end include S with type keyword_state := keyword_state and type 'a with_gstate := GState.t -> 'a and type 'a with_kwstate := keyword_state -> 'a and type 'a with_estate := EState.t -> 'a and type 'a mod_estate := EState.t -> EState.t * 'a type 's add_kw = { add_kw : 'c. 's -> 'c pattern -> 's } val safe_extend : 's add_kw -> EState.t -> 's -> 'a Entry.t -> 'a extend_statement -> EState.t * 's val safe_delete_rule : EState.t -> 'a Entry.t -> 'a Production.t -> EState.t module Unsafe : sig val clear_entry : EState.t -> 'a Entry.t -> EState.t end end (** Signature type of the functor [Grammar.GMake]. The types and functions are almost the same than in generic interface, but: - Grammars are not values. Functions holding a grammar as parameter do not have this parameter yet. - The type [parsable] is used in function [parse] instead of the char stream, avoiding the possible loss of tokens. - The type of tokens (expressions and patterns) can be any type (instead of (string * string)); the module parameter must specify a way to show them as (string * string) *) module GMake (L : Plexing.S) : ExtS with type keyword_state := L.keyword_state and type te := L.te and type 'c pattern := 'c L.pattern coq-8.20.0/gramlib/lStream.ml000066400000000000000000000051751466560755400157730ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* Loc.t; (* Remember max token peeked *) mutable max_peek : int; } let from ?(loc=Loc.(initial ToplevelInput)) f = let loct = Hashtbl.create 207 in let loct_func loct i = Hashtbl.find loct i in let loct_add loct i loc = Hashtbl.add loct i loc in let strm = let i = ref 0 in Stream.from (fun e -> match f e with | None -> None | Some (a,loc) -> loct_add loct !i loc; incr i; Some a) in let fun_loc i = if i = 0 then loc else loct_func loct (i - 1) in { strm; max_peek = 0; fun_loc } let count strm = Stream.count strm.strm let current_loc strm = strm.fun_loc (Stream.count strm.strm) let max_peek_loc strm = strm.fun_loc strm.max_peek let interval_loc bp ep strm = assert (bp <= ep); if ep > strm.max_peek then failwith "Not peeked position"; if bp == ep then Loc.after (strm.fun_loc bp) 0 0 else let loc1 = strm.fun_loc (bp + 1) in let loc2 = strm.fun_loc ep in Loc.merge loc1 loc2 let get_loc n strm = strm.fun_loc (n + 1) let peek e strm = let a = Stream.peek e strm.strm in if Option.has_some a then strm.max_peek <- max (Stream.count strm.strm + 1) strm.max_peek; a let npeek e n strm = let l = Stream.npeek e n strm.strm in strm.max_peek <- max (Stream.count strm.strm + List.length l) strm.max_peek; l let peek_nth e n strm = let list = Stream.npeek e (n + 1) strm.strm in let rec loop list p = match list, p with x :: _, 0 -> strm.max_peek <- Stream.count strm.strm + n + 1; x | _ :: l, p -> loop l (p - 1) | [], p -> strm.max_peek <- Stream.count strm.strm + (n - p); raise Stream.Failure in loop list n let junk e strm = Stream.junk e strm.strm let njunk e len strm = Stream.njunk e len strm.strm let next e strm = Stream.next e strm.strm coq-8.20.0/gramlib/lStream.mli000066400000000000000000000045661466560755400161470ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* ('e -> ('a * Loc.t) option) -> ('e,'a) t (** Returning the loc of the last consumed element or the initial loc if no element is consumed *) val current_loc : ('e,'a) t -> Loc.t (** Returning the loc of the max visited element or the initial loc if no element is consumed *) val max_peek_loc : ('e,'a) t -> Loc.t (** [interval_loc bp ep strm] returns the loc starting after element [bp] (counting from 0) and spanning up to already peeked element at position [ep], under the assumption that [bp] <= [ep]; returns an empty interval if [bp] = [ep]; returns the empty initial interval if additionally [bp] = 0; fails if the elements have not been peeked yet *) val interval_loc : int -> int -> ('e,'a) t -> Loc.t (** Return location of an already peeked element at some position counting from 0; fails if the element has not been peeked yet *) val get_loc : int -> ('e,'a) t -> Loc.t (** Lifted usual function on streams *) val count : ('e,'a) t -> int val peek : 'e -> ('e,'a) t -> 'a option val npeek : 'e -> int -> ('e,'a) t -> 'a list val junk : 'e -> ('e,'a) t -> unit (** consumes the next element if there is one *) val njunk : 'e -> int -> ('e,'a) t -> unit (** [njunk e n strm] consumes [n] elements from [strm] *) val next : 'e -> ('e,'a) t -> 'a (** [next e strm] returns and consumes the next element; raise [Stream.Failure] if the stream is empty *) (** Other functions *) val peek_nth : 'e -> int -> ('e,'a) t -> 'a (** [peek_nth e n strm] returns the nth element counting from 0 without consuming the stream; raises [Stream.Failure] if not enough elements *) coq-8.20.0/gramlib/plexing.mli000066400000000000000000000017551466560755400162030ustar00rootroot00000000000000(* camlp5r *) (* plexing.mli,v *) (* Copyright (c) INRIA 2007-2017 *) (** Lexing for Camlp5 grammars. This module defines the Camlp5 lexer type to be used in extensible grammars (see module [Grammar]). It also provides some useful functions to create lexers. *) (** Lexer type *) module type S = sig type keyword_state type te type 'c pattern val tok_pattern_eq : 'a pattern -> 'b pattern -> ('a, 'b) Util.eq option val tok_pattern_strings : 'c pattern -> string * string option (** Returning a stream equipped with a location function *) val tok_func : ?loc:Loc.t -> (unit,char) Stream.t -> (keyword_state,te) LStream.t val tok_match : 'c pattern -> te -> 'c val tok_text : 'c pattern -> string (* State for the comments, at some point we should make it functional *) module State : sig type t val init : unit -> t val set : t -> unit val get : unit -> t val drop : unit -> unit val get_comments : t -> ((int * int) * string) list end end coq-8.20.0/gramlib/stream.ml000066400000000000000000000070551466560755400156560ustar00rootroot00000000000000(**************************************************************************) (* *) (* OCaml *) (* *) (* Daniel de Rauglaudre, projet Cristal, INRIA Rocquencourt *) (* *) (* Copyright 1997 Institut National de Recherche en Informatique et *) (* en Automatique. *) (* *) (* All rights reserved. This file is distributed under the terms of *) (* the GNU Lesser General Public License version 2.1, with the *) (* special exception on linking described in the file LICENSE. *) (* *) (**************************************************************************) type ('e,'a) t = { mutable count : int; mutable data : ('e,'a) data } and ('e,'a) data = Sempty | Scons of 'a * ('e,'a) data | Sgen of ('e,'a) gen | Sbuffio : buffio -> (unit,char) data and ('e,'a) gen = { mutable curr : 'a option option; func : 'e -> 'a option } and buffio = { ic : in_channel; buff : bytes; mutable len : int; mutable ind : int } exception Failure let count { count } = count let fill_buff b = b.len <- input b.ic b.buff 0 (Bytes.length b.buff); b.ind <- 0 let peek : type e v. e -> (e,v) t -> v option = fun e s -> (* consult the first item of s *) match s.data with Sempty -> None | Scons (a, _) -> Some a | Sgen {curr = Some a} -> a | Sgen g -> let x = g.func e in g.curr <- Some x; x | Sbuffio b -> if b.ind >= b.len then fill_buff b; if b.len == 0 then begin s.data <- Sempty; None end else Some (Bytes.unsafe_get b.buff b.ind) let rec junk : type e v. e -> (e,v) t -> unit = fun e s -> match s.data with Scons (_, d) -> s.count <- (succ s.count); s.data <- d | Sgen ({curr = Some _} as g) -> s.count <- (succ s.count); g.curr <- None | Sbuffio b -> if b.ind >= b.len then fill_buff b; if b.len == 0 then s.data <- Sempty else (s.count <- (succ s.count); b.ind <- succ b.ind) | Sempty -> () | Sgen { curr = None } -> match peek e s with None -> () | Some _ -> junk e s let rec nget e n s = if n <= 0 then [], s.data, 0 else match peek e s with Some a -> junk e s; let (al, d, k) = nget e (pred n) s in a :: al, Scons (a, d), succ k | None -> [], s.data, 0 let npeek e n s = let (al, d, len) = nget e n s in s.count <- (s.count - len); s.data <- d; al let nth e n st = try List.nth (npeek e (n+1) st) n with Stdlib.Failure _ -> raise Failure let rec njunk e n st = if n <> 0 then (junk e st; njunk e (n-1) st) let next e s = match peek e s with Some a -> junk e s; a | None -> raise Failure let is_empty e s = match peek e s with | Some _ -> false | None -> true (* Stream building functions *) let from ?(offset=0) f = {count = offset; data = Sgen {curr = None; func = f}} (* NB we need the thunk for value restriction *) let empty () = {count = 0; data = Sempty} let of_string ?(offset=0) s = let count = ref 0 in from ~offset (fun () -> let c = !count in if c < String.length s then (incr count; Some s.[c]) else None) let of_channel ic = {count = 0; data = Sbuffio {ic = ic; buff = Bytes.create 4096; len = 0; ind = 0}} coq-8.20.0/gramlib/stream.mli000066400000000000000000000062321466560755400160230ustar00rootroot00000000000000(**************************************************************************) (* *) (* OCaml *) (* *) (* Daniel de Rauglaudre, projet Cristal, INRIA Rocquencourt *) (* *) (* Copyright 1997 Institut National de Recherche en Informatique et *) (* en Automatique. *) (* *) (* All rights reserved. This file is distributed under the terms of *) (* the GNU Lesser General Public License version 2.1, with the *) (* special exception on linking described in the file LICENSE. *) (* *) (**************************************************************************) (** Streams and parsers. *) type ('e,'a) t (** The type of streams holding values of type ['a]. Producing a new value needs an environment ['e]. *) exception Failure (** Raised by streams when trying to access beyond their end. *) (** {1 Stream builders} *) val from : ?offset:int -> ('e -> 'a option) -> ('e,'a) t (** [Stream.from f] returns a stream built from the function [f]. To create a new stream element, the function [f] is called. The user function [f] must return either [Some ] for a value or [None] to specify the end of the stream. [offset] will initialize the stream [count] to start with [offset] consumed items, which is useful for some uses cases such as parsing resumption. *) val empty : unit -> ('e,'a) t (** Return the stream holding the elements of the list in the same order. *) val of_string : ?offset:int -> string -> (unit,char) t (** Return the stream of the characters of the string parameter. If set. [offset] parameter is similar to [from]. *) val of_channel : in_channel -> (unit,char) t (** Return the stream of the characters read from the input channel. *) (** {1 Predefined parsers} *) val next : 'e -> ('e,'a) t -> 'a (** Return the first element of the stream and remove it from the stream. @raise Stream.Failure if the stream is empty. *) val is_empty : 'e -> ('e,'a) t -> bool (** Return [true] if the stream is empty, else [false]. *) (** {1 Useful functions} *) val peek : 'e -> ('e,'a) t -> 'a option (** Return [Some] of "the first element" of the stream, or [None] if the stream is empty. *) val junk : 'e -> ('e,'a) t -> unit (** Remove the first element of the stream, possibly unfreezing it before. *) val count : ('e,'a) t -> int (** Return the current count of the stream elements, i.e. the number of the stream elements discarded. *) val npeek : 'e -> int -> ('e,'a) t -> 'a list (** [npeek e n] returns the list of the [n] first elements of the stream, or all its remaining elements if less than [n] elements are available. *) val nth : 'e -> int -> ('e,'a) t -> 'a val njunk : 'e -> int -> ('e,'a) t -> unit (**/**) coq-8.20.0/ide/000077500000000000000000000000001466560755400131465ustar00rootroot00000000000000coq-8.20.0/ide/coqide/000077500000000000000000000000001466560755400144125ustar00rootroot00000000000000coq-8.20.0/ide/coqide/FAQ000066400000000000000000000047221466560755400147510ustar00rootroot00000000000000 CoqIDE FAQ Q0) What is CoqIDE? R0: A powerful graphical interface for Coq. See http://coq.inria.fr. for more informations. Q1) How to enable Emacs keybindings? R1: Insert gtk-key-theme-name = "Emacs" in your gtkrc file. The location of this file is system-dependent. If you're running Gnome, you may use the graphical configuration tools. Q2) How to enable antialiased fonts? R2) Set the GDK_USE_XFT variable to 1. This is by default with Gtk >= 2.2. If some of your fonts are not available, set GDK_USE_XFT to 0. Q4) How to use those Forall and Exists pretty symbols? R4) Thanks to the Notation features in Coq, you just need to insert these lines in your Coq Buffer : ====================================================================== Notation "∀ x : t, P" := (forall x:t, P) (at level 200, x ident). Notation "∃ x : t, P" := (exists x:t, P) (at level 200, x ident). ====================================================================== Copy/Paste of these lines from this file will not work outside of CoqIDE. You need to load a file containing these lines or to enter the "∀" using an input method (see Q5). To try it just use "Require utf8" from inside CoqIDE. To enable these notations automatically start coqide with coqide -l utf8 In the ide subdir of Coq library, you will find a sample utf8.v with some pretty simple notations. Q5) How to define an input method for non ASCII symbols? R5)-First solution : type "2200" to enter a forall in the script widow. 2200 is the hexadecimal code for forall in unicode charts and is encoded as "∀" in UTF-8. 2203 is for exists. See http://www.unicode.org for more codes. -Second solution : Use an input method editor, such as SCIM or iBus. The latter offers a module for LaTeX-like inputting. Q6) How to customize the shortcuts for menus? R6) Two solutions are offered: - Edit $XDG_CONFIG_HOME/coq/coqide.keys by hand or - If your system allows it, from CoqIDE, you may select a menu entry and press the desired shortcut. Q7) What encoding should I use? What is this \x{iiii} in my file? R7) The encoding option is related to the way files are saved. Keep it as UTF-8 until it becomes important for you to exchange files with non UTF-8 aware applications. If you choose something else than UTF-8, then missing characters will be encoded by \x{....} or \x{........} where each dot is an hex. digit. The number between braces is the hexadecimal UNICODE index for the missing character. coq-8.20.0/ide/coqide/MacOS/000077500000000000000000000000001466560755400153545ustar00rootroot00000000000000coq-8.20.0/ide/coqide/MacOS/coqfile.icns000066400000000000000000007121471466560755400176700ustar00rootroot00000000000000icnsgTOC His32s8mkil32 Ol8mkit32rt8mk@ic08~ic09his32ߵԳǙδʽsо˧гϿsݶ]kɾbm~v|twڐuǧҵs⻰Ө߹sɠ\̣j辳alNBQ>eBaT|芆ו~~~ޔ|s|\rxkᬢals8mkי}D &ncgfgghjhheaPirmnmqܦ 9nnpqrpoprrqpqqprj~7Aj?`?ᣌf?zwe@xvf?|~~uf@uvf?𝎫|jg@Өg@ѥɱg?֣g@ܳh?ܲi@A̯i?ڰg@ʰe@󿫴ăd?Ҧ{_@׶}\?¯Һ@󽮱}@赳@w@ۭ |@಻ =Ԑv D &mafgffgfghggdaPirmnnonmnqܦ 9noprronpsrqpqqprj~7Aj?`?܀]UZf?`FQORAye@DZNSQWMf?JUONMQJf@>SPh^VMf?]}OSg@}~sg@̗z󭄁g@vӽuzg@Ѓ}ėh?Ё;wh@pi?φtg@ﰃЁrrwj D &mafegeegeeb`P irmononononql8mk4S`\_^^^^^^^^^^^^^^^^^/^G^S^W^R_I\@a86#it32rviml kmiz(7" }Kԍ ; q!lyp ?woo  o o Bo/ oQpj o I݁ۀ݀.߁ o ɀ  o̻o Ǿ oȾ¼ o&ѽo%aa oT ˾ oվr oؾy o ſ y o  o  woS[qob龿q o㿾vl oż hk o ܻdze} oĻ il ^ oۼ"ԡTxcoHÝ̼$ϴf_so*qؾ̂(c{Yxo ̆&dSm o'Ѩ̇#__Xu o  ƿ̄%^vvUn oɅd}mv oò̄&οa| o@\ǩʂξaξʁʀoǡ|ĺοaɀ̃ˀo ڼ́οàʄ o Ͻ̓dʎʲ oǃ_xʏи ó]tʒ˄ہ o ́ hʑӡ ot ̆ɜ`^o  ̙̈зXu o ʥ ՙQ~ n  ̓ˁ̌wX n ʔ̊[g n ʔ̈ ԞOvn{nʔ Яd|̈tXn E~ ʔ ?Qpʈ ѶPd n ʖ ӢQu̅ ԄHp mʚpʉZam ̙ԙ}ʅ ~Orm ̘ ϻx̃חKel̘ý֣M_wlic ٻ̕g̀֟L\p l O ̩̑.ԠUՒL_rj ơ̑fWuG\mi ̴̎ՋBgңWG`oր e   ʍԥEwӲsLZpR3 ڼΌ#ҲL˪vQRjy .U  ԰ʉ ϼPðiPUh{ϵ Y] ºΉ5]V{waT`vжO .\տʇ2gKfuu{̭҃ ?̅6֊Ia}ĸ̹§ԛ-Ͽ5νMZkͼƱµߤ U υ4֎Fi÷+ ̃4rXſʄbdЀԪMZʁ^nθ jʃ2^wѿ  ʆ/]p# ̅njθ) ʅ/ՅbȺȵ+ ހȈ-Ѱaȶ+ ɺ ʇ+Ә+C[ʊ(̐(z̋(Ѷ%+ʋ&}ʯ# ʋe{ƛ  ʋ$cyɯ ʌ"]gн#̎ ^fľ =_ˌ kr Ɋjm Ё҆nlѽ  mm͹ DǗh^[^[X[]ZXVVY`\UXU_sɾ% Eծۼx*CµĹr*::gπʴn+ fA (NB /B o E ?ymsqrqpomleC d    0EHݳ viml kmiz(7"}K΍ ; q!ly p ?wo pp oPoP opj0϶ o H݀߁ ۯ~~ oȓ o ~ |o딁o(򗂌 o'~o%aaЃ oTꟂt o#Ȃxwo~v o# oo ooҁo{oS[̀nuobׂmu o܇gp o嘁 }an o s |c| o픁~hcta oς)~]hgoHY~$j{`roUq۪}gg^wo+ٳ~%ewVl o*զ'`x}ZZv o ɮ$]uiYn o apt oò &_o*@\ͧaϽ׺ o+¡~n`෪o*ܽ`Ыo*ν°cɪ o+ڸ]yԫ oն ]wڭ߁ oӃ fŮ otʬ]`o䱲Xt oԭS}n) oZ o ɯ Zgn'ӴQun&{n⼬ _tmY n$ E~Դ uBSm Qe n ۰ Tt yLp݁ m Ȭmƈ Xa m󶰛 ~ٺuQq mɫ wĭ Ldl uíM_vlic۱f M[p l O ΧW M^qj ȤaX mI]ni ηFhVK`qڀe ¢1HrlN[oR3ٽMnQTiz .UԲ!PeRWhzϵ Y] ů5[WwvbVauжO -\2aMfwu{̭҃ ?.ݿ5}K`}÷̸¨ԛ#ӷ5MZlνµDzöߢ Uѵ4JjŹ+ƭ4kZſԬ1_dЧMZά\o˵ j񷰲2]wμ0î/[q#/׭ikη(-ڳ.{eɼɶ+,Ჰ-bʸ+ɺ Ǯ++BZ Ҫ&(z뱲(%+ͫ zڀɮ#+Ŭc{ś+ǫ$`yȮ+ì"Ygн Zgſ +=_Ŭgs Ůfm  ūimѽ ,ʴin̹ IȘj_\_\Y\_[XWWZa]VYV_sɽ%Vԭٻv*UµĹr*;g%р˵m+ fANB/Bo E?ymtqrrqosrqpoommeC d    0EHݳ viml kmiz(7" }Kύ ; q!ly p ?wo p p o @oP oPpjÜ{eZTRTYf} o I1ܜhQJNSVWWVUQLKTto$eNTZ[YVTSRRSTWXUNR o JU\XSQPOOQTVFvo  iN_WSRRQ RRQPOXLonO^RTSRQORQo&L]QURQRO`o%aaQ[SURQPz oT zOYSSQRO` oPZTSQPV| oM\RSQRs o eUWRRQ PfoTZSRQRPaoN[RRQRP]oS[ L[QRQP[yobOZQRQPQP\x oWVRQPPQRSSQP[t orOUPQPPRSPNMNQ[r oJYORQ PRRNNV`hbRQRb| olPTORQPQRNPauc[SPQPUe o$PUQPQQPSPNa|sfdNSPQQPZjo7HYLUQPQSMUv|nsPUQSaqoXqߚMQSQMbiuQUQQPVauo,ۨVMOm'erSURRSXj o*٦js#`oTUSPV\v oˎ"\u\QR_]n o 󙂈]sSqs oò"]عo@\wu&`Ѽ•~o Ǻp_Ґ} o)_~ o+;дa| oޞ]{} oژ \yՂz oҋ b| otYc oԅ~Xt o rW|n  ߞc] o讂 Xgn'~sTtn{nߜzXg b\ n E} ̌dHWh }Re n ڇ uXq gPq m iUa m 󑆛 vܚeSo m | xީ pOcl쟃pҪuO]vlicܠd tO[p l OФuXnP]qjʪ+[Z`M\oi ѻ.jLivSN`se åvMi|`P[nR3׿|PnxbSWhy .U Ӷ!Qo~p^TYgyϵ Y] ɞ3WXqtdZctжO /\Ɨ1XPezuz~̭҃ ?/ܿ5hN^~˸¨ԛ# ث4M[mϾ»öɴķߢ U Ԑ3lOjȼ+4`\ľ1ZfѧMZ~Zo˵ j0[wν 0󩁊.Wr#/ɀ`mͷ( ԉ.ii˽˸* 䎅-{fͻ+ɺ *y+B[ }'(z 冉'%,~ xڀɮ#+_|ś+#[zȭ "UiҾ  Vk +=_`t _o {`oѽ ,}{}|}|}bo̹Wʚk`^`^Z^`]ZYX[b^WZX_sɽ% GҬٻw* EŸ²ƻr*2;g؁Ԁϸ©m+eANB/B o E ?ymtqrqrqpoommeC d    0EHݳ t8mk@     ra  $ %&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&& & &l&=&&2&@&E! &I" &Q#&[#&d%&k'&q(&v)&x+&y+&y,&v,&q+&m*&h)&a(&\'&U&&P%&L%&G%&D% &A$ &># &;# &8" &5!&1%w,R& l[0 #-//////////////////////////////////////////////////////.*#  ic08~PNG  IHDR\rf$iCCPICC Profile8UoT>oR? XGůUS[IJ*$:7鶪O{7@Hkk?<kktq݋m6nƶد-mR;`zv x#=\% oYRڱ#&?>ҹЪn_;j;$}*}+(}'}/LtY"$].9｟%{_a݊]hk5'SN{<_ t jM{-4%TńtY۟R6#v\喊x:'HO3^&0::m,L%3:qVE t]~Iv6Wٯ) |ʸ2]G4(6w‹$"AEv m[D;Vh[}چN|3HS:KtxU'D;77;_"e?Yqxl+@IDATxilU/oT$$F1bX360L#|kc6l>٘ faֈa`  TBKKhA*_ܷ̘̈=7o/xU7~ݏ?[Vw 51,IO0p0p"Noa p'N0x WIO0%HRm(0"i䎛r*իWoo>OI I t#ނPo;;5^Tк333G~GrO?tT*˿ORUh.'Q$ &\ťFo[ %VWaggkPsMԑx1H(D sAWVêG?e~=W諲 ,~a+G"]p C >OO_PGA`ɝwx"wb[~ @_յkY 4MEUs=,U' ƍXEMGsDR0| -""ԍSВ.zTc);`@-;WN<6>>^?>2 *]r677Wc@P?Ov`<{$ȸ~!_ac\.v3ڧ8[֖Knd-mZQAGumD%km|<਎5r@6Oa L/_UE9uaڂ'| YχjCN]d/P$ď2s|_Z5%6"Cr5qJeQJ0{}xˤJd!xYzl{W.^I4/IʆCC;nxf?G"#Wp…?''ʩV n).!F܁qpmǦ2 (pP؃`pvwBF'F+C߾I^R^p~Iء!@~ ˆWe (Ο?6"͑Fpaa;WUp9N-^-RqWݣ}w1]!/v%q<}w |/pat ,֟n4>l2݀;0Gu\?+:u*w}6.}71|I75]%7KRj}KZ;{'־USBj#b.,~wȉ_rOiC|]h'y5\ݑ0}o wK\uw0O3BIoҰ2q=c|9]|ׇ>v8{WQwI6*.mAny}?v 7&_X>`x衇ˆFP³ bhkA@Z1y,kW 񛝥1`wR?w៹aqNq-M'$'݈`X,ekx'40:)p:y'ON޹*$,9Wƒ %>ԡCXgGuhavoĜx[!-h /DqBbRV-JuVQ-)e˅uyCp[Z, ,(<f;(?4SVڴ2̰-p2#pa9LȻ.)?h 8ß#>#=Sm7Z V+6uVq) ev %d#]&_ m nQUJ>&0?hhhU`.cUDc!0J gCi n՗%P*-DJ jfzĄǖ~\T ea}MQMyT^a|_6R֢V*boI >KP o˜mTqqIY`P* '03sIy.*]!`(Ԕ1! cSw"+m` 4)g~cc&Dbp?8 fM47hKWcO(ceG4NktQQu.\45bǟ:K7m1Wd `41hK JBX[/>1&ç}8Ae,lٵYBQ 兴me0 D\}R8 c ~ j/}8W{^p #@Uݝ7$&/nv8*3w̟wgqh f@-!23Z,Uض(j)~u5`KZWQDmkڕYdFRfVbD -.SwǓ#n=.a930KbV%ߜ_AJܺ/Ű:s%\ U1.BaxR74.<'/ -iUTl/6ս>%pMļ10>o+3R>7p4BA/./YXeo03-C3 kXd&Ay#43W71BaP8Ÿ!oAӅgr')N&@|jzӛ~OwքIẠVSµm w=taR* c40W{ غ ~/Qc)?jLD5VL- AuݔM_~@i|u[ZfTJW*NdQحJ^7)fÒnC ]$+'Ti PBXtX|_ 噫jWD'[`Z?Mʄ_|ψъ#SoT0v;C0rCjX BycWȗn]ĐT,m e f$$M@Kn!媠V~@p,}WpE- J41!t2hH' ᡤҚTV45u]~+<Ft1dW(9+ݺ.-};vVŋ~BD/r8{׃f9!DkŏյJA bl3c ?0qS^-)F3ݴ QZ-+j0PjI@mloHuWJpx4^_[rӯ-q+:7lqBbx'Z`;l?\MP[֯<!?ywvuQ1ҩ0|CZڃO{{{V`lOIچh1l0SzuFeD0 e3N/[a[yEo\].Xη}S׀s+U Vd\n[z,hXꢴ3\ ."$q$Y -`u\ΜtAi$xEt;G?.1 ьJ@.OhZ~_~TºR|5,/;fkADjߐ`#]Pqr>r =p| v9$hU$dׯ_z*_jKLGSL٦Cb'IRā}tI V +!|9l wgGl%·ɉ1|D!7>`p02W)ə< &FAڌF }8a%q bJw@Zv[rlkLw9 撻W\b?}h# mDٖJŀՇͷ _W_{-p"K{ C#QkfcMUq6QpkVekȑn,\#fj/g72;mӮasu!|ӟU>/EQ`ZѪ _I jZuffY*7H!mdKr}: }OH~ژ/2V&_0SrsQFL\fe-B|7*PN7g|K]8"Szzϻ_pڵ: pYj1¡?]R b&``:% w}y/`-EJlkXpKʳWC¨ekq#}o w˗#39BZz˞rfX_JzF&JSa.CHli[^"xʁpxZx˷ke6D[dxm(erAn)1=H˝ b+ۦ :%W^x5}2dղ 2P GK_^RW>f>4vEsFúZWe566eFڶITglZםghL3vHGJj7e~.l߆q Ȩ'8j5&T.4`iDa=ų])%LB9Ⱥ 0,(?^$n&Nl =+w@f9& YҨq">:~#@lfWDս2 ΏQ %U82^Zxo)c_~hM YKOŐa^y8;AMNLiX}h& Um Oi1mP%#$ږ^~W3^I^%g(E4daRc^w^Gus T3nNB7 .nwow/s$#_'¥_j ,`Fob~Hym"X§Qm5!E<,,_ +/}:x4:!KT3m!BF0ѧ5ଉњ"{dT.`ggSe x]'uigqwn}.m7=AuahZ=;"xTV2le:@WZ6•/?S9qϘ_{I6LvЧ| " //Æs<243]R#.nz{Z^o<fp $E\4/^.'n‹8GzRX,nnGz;$ہYUej ]Կ=1>E0pj?0zZ~J3UI2n憤`1"nyǘQ8`I<Ú ÿc‚2x§%~,3-EIqQP 6^o*<2Lu18$Zz*1[ fP2*]fzg 0TbJDvlġRU Ht^dQ׬ᵿ5yO3d\iy>w`;5)9ʴi-7 npBXԢ%cFf2cgPR_Á[ʄP/ȌJu:I.[@uCh`gAIJ9ucuB.]]H.j\?KfxlӅ #FT.*Ai mV^:-X6,?°ĕ4 `Z@pp`XqLCȪ_Ѱ?Xg%i&4f1oIQp卯+y[n{|݁Յ9ͺX<yh _2+N N.ptpX5']iq'Bqup. 7\%lxo@g 0ۈ_O~@xᇍ . kOPLZyg5"cZ.KOYz"xXA,B eDś(ʼn8Ƿ~pfO,`WbXX cX98LцMF8sڻ53J9|QXφ# x>C :B X($$!(MMAPWb8GxKS v@uq)qO;Oַ//[ |yf| PP9Ѿx&A`,aΈM1Lм| z)q0\:] FtŦ*!L`6>n+8K[S.,]~Aŷο]n[ ~3}z34'Gܜ$+&+A#BS'8y䁵L 14SP09ι 0Ɩ?x2 , 1P/ 7q-TT?6c/I]'3F7c{[ W^Aw5jT/F$eB>stß=hY3[Wk=_/*N6R\iWC\Z>8j+H :19}MnJUg$ԙܺYG]ŨDZ` -cju߳t1=M_|$LfJmz~LxθӂFk8Z!h$0Xq0UQ7vhkp'ֶ$.P~`O'uf([@CPP9W{Ͻ{.vb%*h΋׿QnoJRx0VE RٸcͶT|uok+񇈫&h];Kx !` _G-vcrXx4 _T]Sl#,'"^XFNGy`yd+bV8_ 3pzÊ}‚C(DZxHBhTy a FRuG!\Wx`4Mq[yF^iVW= VPW.R3#χW}B~[iʷ_fTR@ï]S#\\YȪ,tRtS^LC+@?uϫ?PwϦ⚩4KgBO5KKfCev?߹[62youo&VKe&-t8w|_(J—&vEI`U+MPcWYٔV?2K@\^^f]~2.U%̵ctTvF䥡MK)J:" ZڏYY gky^vy4UjdKym!;\Ҍ01>b#-5y ,JxxdB1VJ?:=X!bPÇ`HZ .qiQx,om@Y-%o@#" *:Vc{Y[7|6Dj|$}IcJ!/j* \:̇&+;S5'`(íu3.-Q](hc+ۃE&*TbD ՚Uc9jeufljmrW Du,,:j#^cz9@Sم g9CQܒLjmYsb80~T1^3.BxzlQAuȟ6f.3g~@s40X~ޅZr[{jAE"ЈCէ cJ{ׁϒH {6A(D]vI8 ?'8# xp6԰QAWWpm&ӷ8G4p[ڞ{vݮj9m"tg55'>" ph]4.dDjw :.`K#3k{oaR[MUVAxj5]RV}T۸# s IH~K-& *f+f-{ۊkCm*MIY>D/L pK_ =?>ѐACV@xJ*oS[1iݦwB3وzf"d >ᯜQ_[K7OÂ˷}Qb&^~D4IV^j8Q+G%:1 o?l VW e4OcpڏO%E0d.pgb| e#\ўtږK H2 ;GGS}n-h&_UUkڒ]|VL G06.2)ڞ{XRv\Ա%tb0ELjΞMWABqYI#g٣t ⵈ ]u6vM29wPhF;tzs [nY@|A;o=F?q{-0?٬'yYA"iuP8%2>v0v+b8Wtk"x+-19ڭW{} rxcu |غ44,vAn@7+ڀqD@88\SY(N[ͧEwTrBƪn&M6]m\N{uUnaגTZJ#*p9ͷv!Ve-=08Cvyj+!- AX*_ѡP0w@ȳŖIlҁ#9rrus+?5o\[aL}si",UŸu@ ݍ+y;֞ttۯ$oƇⷉ+k]e.yڽp9 Fǀ45_ݬ{p ֝Ų${PZC,x6Nެɧ|QJ[T [Ce m3i{4*YtbT⹻Ca a*DrOOG%?g%pv" \X&:`.)l<2ç8 2| ,@u!2j:5 f48a8;:MSX' IN;8qx5ƍ wA-kpLE`$$Ԏ a@c E €i>@l@8[oV"3D\,Z@=O*ā \/ycĬ3za't΀6Aш[i#mfMICIAJ[P<1V|g3i+Ro1(KaH.C@MWFSg3?.cPF87!<G.3Pg}4N@ֿD+x^|K; 1rqN8]`ofmC-^g}O*TwӲ#^p2%#aB߰{0>Np-8aA͐u4-H`[9xM.o܊z8:-'!.pIY~Ф gqxBaL8njN\p%YC?Y[~rل y]8qw?T|g~g"zOA8#Y͙H6UitXy[%` Tw ȇ,.c+aܻ~Fb4|SBJc̹0;uH4ʲ?bĆu,W|[Qiɋ Bs!0 o,46`AxlZk.( F0% 04»`7(.`" LN#0ր1#-i!$kQFu_wZy{FpRATOOXeP*"S%B{6 [|ꤷNQvsOXv:ܓgr76N3- 9rSq'CCQX(hd:rꗯZRzާQ2"%R AV"o~ My*$Mn__ RDc" R A8 jӂ` g,A 8IOɅDžs s؃hffVnȀ gX $3dZYIݝ*XzNPA VtĜ񗺄sjgiԹAbMWpGGuWE.C@E$՗]ZڇwETb^ !Vr#Ua1X^υL(0DP3vud%𲼼baX3[FK|/ffM03%+ܔ AsM8Q?%z$6WC03v[U(bDi!HI^i(3= b+@Þ*d{*"KxQgzցq0&tV4xvκֻc_U]q%^,.3h G?M _|X^?5rj1zLSyöcZA30`Q6휆 kQhTފfjsb> v)jݥ L`/[/^T^)iF"?n&tŧ:{- D8}% 4K#] u5} oB: ېHHx~l?:(m aaYg͋ h劗Cq^WKUqID֚ŨV¬7­VgvK[Us},p^E+P}L2Fag,$̆ZU{Eسp~bA2B2Y谘pO6+aa*.hzJ6UrZ(^eu%TeǢ.RY˩pkV64h/7N 4ׯ%8h̞ +lM*̄Օ0*FW+,{iݥX|Zؕr^!b(kqʹ GWdqq)r m7箝0A9wJC~0=)RU% Uil;݃u2 @?[ҷ=iEc"ej)ojyi!T9OCǵ|qnLjZs }XZ ӧN2p>{ W S`G~OJ#DG ̩ISAӘ3ӯKLMpҰmhOMBO ^˕eTU8)`{I7VSiޚ߅(~5N<}%{H#D8*!ٖLl :$F.S;cԝGML[9I>~ FtTܹ0W5um`H ݷ.͝JH}Pp KիSɰ% Q_[+6FCRi9Ϩ\5,;!:,XiS$ʅOwP.p؎ ?mQ k@IDATٔF830Ij0bLw<|S6͸3r3p!{N;S%ݒ˰OS]QEBPJ0hv} 6ûaQ=q z*χﶩ0K/>ڍD 4V'F% 2?7a}eVD:"UWCƭ ̬/ͅwW 꺖3퀌̺ &a:gQ%1aca#sSkbm|#Ih%! an\FU<(ߺA# ,lEn XR'U)χ[a32^{GBiʤhb|gwz c=#Sok/(ymP}a= i/\^܆M`ќyeaWo#MQ!o13I֝~[0iVo8Ryл+l*>LViؿ΄'ku)'{;?6 %H ]њk^С-2ݸ&װ*іZuŕ[ D;b#Њ<7qo877g7o0Xn!/|?.I) :W/眑MH[0sVy35j09κ]n o5!sJwR HnTZ3ٞT| #Sx~QIkDeD#;kcl] ^V֝o8B<+e^|ym5}gf56&XvyQ{:.:(pa##jcLLR啵06/ԝi#l+?&$TbVU_kMi9'~F2 K_{)^B؞ ؙU%4D7޺FM1)̲]Vڊ5ۊ@̈́c TڢXBϳ 3Yu%C˼:zK]ž! oUj< =j͚o;"憌 S t3Y:"oqͳE\x_\U[CٜgObv'4 0/fHZ/K{Am@ǟ,.%p^d5!觇6oi&1 $UgYPݢAc݋6~F*gc050VJL HT(:f׳TAkI j1jUeknM[}߰^[Jk?m"][ sִMY$5MZ:Ef)&̈́ܲ l ŭ0I,bWL2c%Y e /;tC,j&2_59={XX^z!,e3wqY:`,fuL/ES7f1&@HuMMmeHnsCYll zT$y>٢+8)Hc߽q'2 *޳oqi.qvd\hDP\10jt4 \obaJ'$'}۶$&~}eU# g,Z4J ns̾r`JfE>x^ϲ+F@jC-ϠnPOKz`Y>l@='`*e&{U;J,2(1IآYKD'WE|2cι_O3P|9Z4ym>r_ܭ/+`Ĕb9!jv5* ƹS胵;-_뾺7^N s5 %F_Ѝ!pSpaFFݴ>PoTRMKMj%]A{C p q.'?Ic>dK7@Xw 5L5Y⇤'@C!:(sDZZUXOgDu '<K- .Wd:T+-c^Mְ\ۯP>xc(So0 FJ>p/Hh1lXδ=sk.BZ yMO].R= p1*SYkk|DQurQgÀhYBZ  m֣9nO- A̦ŨAVWfi6+h.F(#*lԎIq]7_6)kO t;#[7_[+2jg#!݊Lx;pbh8ҥKc7CM?Bh@!4œ ]m#l{0(!?qm][kA(d;u&rZ"' hF"4x¾շ^s]g 2ʉ.0>SS>KwX S0 w:V6qtYw^84\dvgxw4! ~c^?6p{N D1jB n| {F8™w8<&Xx@ZgMX7>0u8QHMWC Tcc'_wW^uQ磆#2er0y=kcž@P~#ݧU>`v(k;X.1D;M@- =p"}я~4\|vUDB 7?|ѻ =]{r3#o`䔦߾n w7Gq ga(ihi` 8w[xVɖ+WÏa1&Ѫv1B@4B>4yӼpS^֙;Cbm)n24Xr3vh2Î5qgp%0+0Z4F.ålȇ 3 d5psKx.#`vҸc%@[|U8 {q4Q=98Xlib(sZ Q[z{q(C )9 ox_ǕN4 c/%i 4x)QM{Z405?pW T{#f;_{ =$xG`Ɇ̂QN_T_@^Y@1=xA<-ЮA{t&=f(PVczGg3ajsm)]I@LJz3`P&_ :MM4zz7'5Zxh5N؉hV?3b?%5ՅE݂,<UgRyMT@xՔ"A0~ǝo64#nH]fuHz'đ~4Vz2a ؄ xx9Af-ζʀ6TW[kbԎ;J3VKZ.*"4EU[ӀL?@Eiq'U`PxU QFlrnDKtW=!uFp`rNCƪU^9B1~1$"YS6Ffj p?h@G&miV vH P0@Qk^fRj20GUa[;JuoNMG0-{- 8ʋ>ОXMi+I; 2tvq-t*7 *Q%(:"6AKnQQ-+0P.nv/ rT,{"3"ЦavlxԴYfi6TraIgNllPߧ8"Qnؗ!RiX~R뗽Eg8lUi=ƨ`ݠΝe F8s>j=8rvDt" lj! .@..Hf@~_-wdUQt^LS#CZݶC2Ԣa,J(`e ;CL5t!wK׿ Z'< y_V;5C<&.j-d?۬mWa|3~l pE_Sy1AfN Z~.:i^,]ȪiF:?K:\Do/ɂA6ٴ}FĨ6 g'pBX!G1x;彩=zP•EQg¸Lg&GPhNNA.Zi1~ &?υ{'< [&u*UܴbNqMްOsoQۄ}Vd 95i?Y1 wdl/kިd|>2Ц`oB8/3Xj&1 7iԑ;4'=# 2Ϟ=,@PcmY.j~Iӟ"c]$&ORٷ79j tq|~S?VrJ&崕2k兰3hf9Rc^u`FS IdA|NY~`OC=Ξ;'`T-JZh0x 82J[ 歽?"4nw !ImGԏY6݁(/ްbyK񿈅"+;1u^xoZ*4jNel1zF82ـlYu8cϪOYL'-~؍;l3)l`TF#DZlmݫ+7x@?>RF6$L-Ycfi1N{%F= lTQ[mPn]ZQy%ev.~ _1Qח EjB*zDUQlvc`(f -^! p2JEYۀ7 wlS#}ifĩ4| 2  uA&fSn-4bؽ6x -|1blHh>6WV#+pqNNO؎0*M(nЇN{N*f^ T^Q,9$yCO3 >P4Kkpg^S~= ߿)3^ [jjh N -Z`kM4EЖ ~{#1e_~<'A>Y??v'{Nd :ӶG2ԭ #H x4 H1eZUϝQw4KNτ!,+o3YrI?!]gYhy u}GmYh-K@#. @ZʷjeC{(@y+9KQ`8W?ꃺN/oV \j?/bb 1=8ї#8 S-p: Lʦ$6 ;oQ*}9<,g!Ql$[U1ʊvJGlW`e,g :l_~I;|up@:T+xE;FF".=;5dԊ8/,h 0IHw+}mHs/hi(6d%& Z 0EcL3k*Ri/0>Lm*ugfSL?sap҆aZ?(, gqt9]oELV`̍*zi:cn/Q K h*A'??&p|N!?^ne+ b_9,E 3?B:걎LN s1zPGWS0F]|T :K UǪ arj L)|ߪGmЁ`BNfN`T35 1fmgm@PQh$ ̿&Rq)gfL>rxPW@ZNljDʋGL̢Lni K &ٚڃʁ;pD_f8eW`Vle\[ ǹbVS#LNeƛlth\Њ% M: #ВG+[[ek:ʄ3677ofb|ŽB߽~J 6ԪfUAjmplPªEͯ6^s0' 81~@E-vN>-xYnjsj.k9l<|nc#-4V 12Ui:~~]Ιv3<m8lD{o>\x'5|i1kRB[]պ~_aF1NA#Xܸi0Η/X Ipfjj~aA旤k| ˦ޯXMvelEW9⵫4MW0 @o~1T4ߗQpک=@|ZE1tcv-Lϫe- 74$veڄA<(Tբo$'Eh'zFd /`J%Mg`RTDٽLRU`{PUldX>(K~ aXtLօҤgtD$Ggbh)9o>"=Zxۮn0wa h_>iA$ ErH0/⦘H>}*Ww(iqm"Ҋ6y ; ٳ9@ w;<33s@.la)4s#6"CCS«+}'kG ߒaYl<)aDXՎ7~ة0?[G>*Hxt렺CX8=5. SSu V~Ch8A^ץs/=#Pp?ٰV|L+Rz~eYQ]]:9ޕso1ύPԲokK]|JxKײ_m.NK*k}' }{!+Ӛz09.]KA(+@ ,wL2dk=s=#3 =䓚2oF1&رՉ‚.ZRÄwjΘBuq5}|ļMmdA\}{5gkᵯx(uהR^L}aE'4vbe0uhnYԗȻusDSI3fڦ(`~)f}G%Ct?@@>0)DŽ$gk&\}k?%pIRnCoVWC-vk%WdMHg Bgh27iut6>1*ƇAmڬ1uԍJ<]џ" $H68!%}~`ȶg+ڍ61,&ekr~0ۑHkKNX Zo\K@hw5T&f#}g>c F$!Ą|,nSnON˷-Z۟M6akfmի6]4 _bN?]z!s-YFāK QQu2|&P&hHOWBy&YcZ!ZYj-7]BXx멙Qej mi7BIkcDIȚ.psFjX}=2RLa*̲&UrbX*$ۈ/:UsZC$WZ{Ahc:TטkT14]=CMoAD`ԹL uagEިkI904:yj&'@g j%Ydv4j2Ur^ԁ:he]v蹡gWCZ3_tlvo,;r_*3k˪RUI" 1asYSB [ޥ-=XdPf FNpnk+2q6`12VWl 0FE0Q C ~wko*]_ 64雲I7LȞԕY -|XU*7A ]=7ufXPӑk6mg&{'"So^;̩5GMH0Υ{icXԗJN 7b1+JEHE-E Hm n؏X,b}rs:y=УiAW`CS_RtGN&.Vީ_~jR~"kbdS78<'wDD]/dWΞq06zuZ ʘqo޼ara11hıG=8 ]-bܱmKkG/.ڶ3O0xm!V?l˹E(8fH>/3\uL` IE2t_yE 2@fܧ)8t! C{lшk08cO CnjSvǂa .]6TѶeKVd 5sMKHk^Җk4,m@?⟫8ڈ_EZqARa&[`c92DW 5/){jJ\?uP$6S[ %W\<W}P˯ѡDz*OϞR#6;=㊍ٷFBrM5Nifwgsǎ/J̫7<}c,I !s~Æ b;d3A2合 j Ny %(.a9VRyEyS.k+>p{%"SUv~CGӀG֪ ¡Qj,wO#셇= G_ɀKgHrVMۺɜ&"sֻ瑵rBy.ˏ.Y̡nCrDے3d;mI%[ )T}Ynٵ!OqƽHp>蚧 a@:El_;0;}U!%k_IikԊnjZyd*k;BZ7o3D/gDc?Ɛ>ob ݠMĎM692!k&dI⏑%{H?|~ ~T&C[URӴ BeR0iiyoX/'_Kx; ^nippJL{yK;;ᝳM(:.-'~y[{׽? @.$bmU/e9qC%)AL10XDlox??}id&p9b dJ'[uBb]MֺLy{V%"Y9ozYE@N=٧? w')A'rC_4p͜ TЛu\Z8K.T J{ʱNz-ņc"pS2@s$|Cw* a&v rKzTa@ٴA;BZ(z8˝irZe+gPܗTa ;W{+ECe75t!o* `%ıUe9d}dfͮ|bBZ#̥B8Ǒhsr8+ ;N7f89n6񫐄> [1ĥeJ.ҼԈ^".9TUJY/Zn@VH?#?@xS; z# *Wp60sN c|t.ܝ=z}l٬MY3ijGN, "<(A Ȱ5!MG" ɟ"0 `;Œn:q!6"i_ ~Hē#_>)ˊ>4ʹkurXFZ.`ks%+2\wz?x-W"H^$I+퍺*Ȱ:7psl7;xt ҊaL ~B%9ky2dthvDkmy4ǰ<;[~/}(W _Znmڸ1p3K2}j*qUVi"Ǭ)~2^f^j@u`Γ\9DŽ9b "4E|*RB)ة"Dn!)r{:w({lh4=m:eT<[O\^ SKimȪTƥ~6,G7(#+x?jф=>yĿ{TGfP=PݦG @bKќh!ּ'˴k}JDޗ;xfZL7Rr(ap^e ¿ XN@@3`yu=WJ/EZ0!D; s3 d}g7.USW4iv5s927, ax3#nttb뫧྾}C s߭l# ~[6oɶ0+E:eU~KxL ҧSj,~iD^<5e8Rʿ\X0Vd{sp6b&A` +h.-IS+9>C3>;$%|1A0 o3#Ͼxv펦+q&y38ȰikHO*.p>~_`s7ݰBu)%q;/WӍOˁRsPZ5|&ӂHh 5ॆlW x9U!wJ(Ⱦe&?^ܳQH($b|$kֻmI3KNĤ5B^xjR67dK( Hl5͠AK4v`<*oEg-=,0]p{' lXd,2]lh}<>:_wWzlFFlS7,P3&ӽ Y gxڧ |nڻ;{0ŶY>1Q>GYܷ?Cב?6sHDS2q'\JOGRVC"q2MN & [ O<_Pw `%l v܍_/.FJcq<8*wRD}5BDZZzvkFzrei`6׆QNǯp4^e33/d[Ae"O i~;㾾:펹xcs{vսُ߀ N@+,u.
4"{z;Xcwc[x3O|c}M0pݿi? L+"}X{Z r@%.XX5`Ϝy"R+(qVz~Z7l^VSyH}wVf;s$=i$@|[E٪0qtwnFF|W!aۨڱ:09K~L?+㩒9R&@IDATw|~OuS]#9{bwXļ,] \v$\?ulωQQJ$4  ]xXUy|Kg/*6\s&QDUbXWv|`4~to@Q%=,?XsDdglMu ͮ.߄y< foх}LnUy`ĴV~=wϿgH&>ɾk Є[`: V?\}u}{c:OH)[^S|3Vǽ/3鞭Eٸo߾CSgG*u_r+kڔ$kaG^ LP 8\5w1=32hӶ=TЁ:[TclU9 ނcJP}cԿ5{^$tC\rBDp.~džX:8 adŶf|2킰yo_~ ڜh͓>]iR^DP4}!>LY>Teysl5X^jS$\?u\Hlx<i#~-@OB5Pf r2O&(':Mx2 ̠쪞1hJպ$Qu;v8Ӟƫ^%g -tl% ީ%;:;"h OD |t%&Ú|'02 )|g機U,V_SzO~8ll+=U-Nʙ%>5UrCk,9>Cg~g=y0i1;wP+@NH[v""W)X$V;o`W=Ժ}Io`qo=8?re;0y-ޠ/2x̡<h2XG_ J0o\N{!3'Se8[/y3]{^ \Fj?ԭ]v5u]}%v&(ۡ~>sѶџav|#0D .lËw/%r5ek:882G;̐}t4M1}RHer{>J@"}U_[vd1يOТKL\gCKob0{ggcsdv~1k[81Tgg8j4UŕQttvNkC/F},9c(/,Gg}">N}VNKyZF!TWxW.]7!LvmO|w%~7+Wggn RZa6 _B>Y UNOxe'aN.ij,-SہӫǍaS0| {-wDJwW"NȫiNR"b˹夓i:<֒ WmMAvŚ֚#w>y~jįʳmb![c(-ʍ2(4B$Q[S;]dBhHW-`=})Y`z ak0L,?U/{R(= ň\#ԧ߼!Ƽ_ge7~E:U~>t}}2afv,"p$*-e-B08ȯw:MY" p3NsT5djnL>z&:F~ۭNfAė%fEp^yDN3M3~S{ǣ.c0ubDu`k/ PDz}t[X ׻a} e^eż^'o{T"(߷_~2 1=7}۶mW~`~YA^W+Ͻ/l[򖿧݋ p cUK_(W8u s~;D= faW3Jw~̽%NULF\JjdFc,μ2lL|/1H扺3:NNN"%Fc=D*~ZA]Y#Y;:ڌOSG@?% YHYi;qt2AOa޵kw0Ȫ8gϕO:ᓟ 1Dt[S[нn'a /0Y~x3Wkw-ܝZzh@&;~߁AQyŽG^MӭϼtMqҺqP; /lw?xk_pk~j[K2mZP7 曣 0'HJ/a#P ^wʿ[\"#xG0ǪuIHتi( 2Y.@j"[jIɺr-1:mқbԾ e@ny?~7e}٣Ƴ]7my"D֜u^E%QlK(p*"l;#>!uĩ.oƚOwǎ >q@8 W̾!Y'i2!QdgJu,6ڇ~X@qAF1iP%xl<`#Uo~Gqyx} .:Mp q1B0X@1N L=hh!bs!-ET-܎`"HBx{;_QO~[}n;Q P#%֘9&}O.xN+@-D|MS̨F.0Z=l}X:ǷYNm|S~CU86ҵ9^*FُXTq|<ESbO7۶mφ8yY^~HGGGC~7p2(T`JK/zыo0?[1è _<6w(GEl5]\; G;O3L(Ñs0a=UywH40o_.3F:;QZEǓ-?I 2e:o-밨DOYk ;Zokoxx S(ϜK}뭷Oɼ.%6ޟryc0ViA݅4?;'192CFO\$ Tfف3ٝ fn] #v75{9#ظ'bNX`.D658 ytt2;p=Xf8:R;6q.2uܶ**Qd VCH*Cp8vv H%W<*͝6 d۶oM=qA ub.К lo$F¾ט]Lfv>*svt`,wr_;v(#9dX`C!8g)Lk ر`X#HQ}/7kb$2569Wyr!?F]S+i`[l<]Σ~v蕿+m`pCR8Nݧ)ׅW/j_+MXm;:%  ݝ GSfZ<9 usO*ӷA`ܰ9]D)gCһ)"q*!Z<#561g!!:ud>V%Amk Oq$wwP[6vFpKmW%mv/U\]e\q ~cǃ||Z{oHfޓ;;z"zԈVBLL_ZF|,aPKhkNd}Q0 LW$2'N )i􉡊VAu]iZ7K,`_u׽Y?/m.KHOUwTtu ).Fk '4lz7j241(w)̧͗[ȵ|b7r-T"ͪa.N +nϝ.;PHMb:pIG,If;/ۚݻN߽*__ozGILg5GDYٟYW~W. GuN)m eg -\VP+u^06f<]0ߙ}2?D% cQ,ΊWFuzf.Y/%U3ZcirJe ȻxF>*!KfJ Fn^?F <@9{f%7oߑ)87OҷSqA̧®[;w'v]\Doo|竌S,tJSg &9O[aK2n&G0||F] νd']QC -B'Q}3H: 5Y{hޑM˟d >'oX% 1YNqPwqGCWN ~w;KK.V_Wg|;,ۥպc;fB)3SׄkbHE.`WVIjP@D ӮrFb($z«D]&dq d!++o@SEXjΦcE*#(A5o#Fdq#?Ŀ^//ez׻TIk՞{uZ0ȯL( ?Xb^!\] OiL.%ks1i2b* [zb#3 /E&,5Dl#]џ`t\RYwR5W)^6:(< KyTw}>uyo2I;:~D ~la/^?uwW]uUls(pKauZTv0 \%tjϩC?c##߼_??'&H;U-?ZJį!5*R\FH~s~^vF%Zilbր&'>rY2,?#ߎZi`:[4`{XKI,_z.K)QSk*'Yy*1=t45VաG;/Fr)$eDԣua `ۇL%]Mݩ2I%}蘿sg<~MΦ[LOs#?+sY/o'h ~cS#~ڪmpzu0+Ϳ .1qg;"b#n>7kAY 'мq&ܚ?͍>^>*ʞ#Q%*tJL85pQJĉ&8 { }6i =_~E[ /=O|'d|~ R~O72ʡǸEx7H3z_瘆|cַ1`soa9%u]r/e|o' 0C܊b3`8lZWI҃)Q;R\v666h̽yUtEd7.ϲw0twѹ Z~DW$,L)#e2{ c#_1/\Y`TRϽ[7K$|sG~F[s(᚟zc 姰4 SoW&`H}XPciWG?w|ۿ;!apӑ#XoXW29~~(h= Nu7bAt Ha&",.֚1QQ1 So[k=}}Q(aMڪpFTtfȝXem^?U4@kdZ*7Z}(,[9R 9X{@TEY=Eo鉄 V<  xVpH4˷,!=:Ǡ5a {0$ٌۿkw?|88܆LٖIJdjjB7}uHnHi`A=&.C8$w䟗UaxU߅?'NX #kк ̢T8*+'5lU\EqLlI YabC濝)LP-unfkTHfbb,6Z9jouβL:(k||RNN$iJ(d'l&m5XO](/avr^GfzIJ$Ģ> [9== gX4m)mQHUdJY\5]'؄>d$yR0xtį3>11͟gs˯ 2w[Ar~0_EJ¨.%+&)BƖ|d| * njct2ؘ#,vRmp!jnYG#,ONNgߡ{~~,C058 Q_)}aCx1ْǏ"m946Y(d66iF*:ruik raoW? {_{gC!cv47SďT?øKz?1mqa].OqYeVt({FFHF?#ݽA;Hn@8jyClHaO]:rHX|G؏GϙXBBd&3,.D u"yrEzCsG6rۈeHE _KdF|+G87xh?H1=,N:jG2Z:UƮ+hK>/sFv`׃7dц{KvpPxхiP `_LW{D|O|k!Oَaӟ_W㯔D!~aWw w8)n!|wgvǷhȾ]"o(M8djZLf2$k1jY'꺙zG '?lp)ߺcG]]],8C@j'ӸBwHitWd2csR&OOD !^S5[ +ۏqUejzzkn~M77P5^qڑF񲮂xuY~I]aA&FU?Ã6J&-F}Q4RpUmbd,ۨonʞs!{ge-.u쏤X.LtS& yO&`?{̃B毾y{-{GynYOD~u#؉G U g7zh+)rۻw/3I 21REϱ˲bA\x+6DUdMїm /+?zkz/ڏJs%~v毹i~ QWhG5 qt9A5bI F kED1ǟc"LtȖFa8P+ iQ~nQ&F&# h|sVK?iTޘ-da*<9ӑT῏m,^KR>1Q`%~~x^]7EIHp=aϸRFOPEy k7T8kZo}o}v ֙?xpG](T}Wn[Z7S2Dw A ϥ"L N/bЙW~mD3o M]Zi$֛/}O"yEp RSgAf!48SFz^R!ȓG8odD#"󮝻1FNDS 甆ਫ਼W)'j/=W &Sgݻ7xGa|?N DAǂE!~߀¾ `ZZTd@AD,e:z r\$Xy W:QE9"̳A W( S߽}sG&Q,7ywͯʫ{ @L.ž}'UrBd/1Xgr_A+EUu!fOz/#mth6=_>B2CVInkP&|*ӱjĿT9TͰYͯz~vT;FypM4XA2'؟2[S:8Nuɫv}`h9jk6cBm|o`DaD\ME_IMX (b~.rڬe[y̍N-P'%$u0orj_066OLۻ8 &7߳"weE%f0"R}ߌґ~ڑ#T-U/Pmh_~__~aڟ9~#į!>>YCIێVd: ": oQ1j CFj *fg kd\vlfD^p,͢:3EVf1zw8Lobn2kLJ0㥎 ll|!{| Y( HMex >熲VqR?Zˤz cF6R1N ޜMȎ)NQWbl _G}F> ܵcGB߼9u`#))]0}?t [B_$޼i'CРJ~YB|^w9F~~5D4Kƫo)=C0 `:~1vd7<1Z5Z89kfE )!Qd\nR.b64v s<,62R.,dZrb׆بQ"G!;z4zz ⛐ D&C |ίc[, *V k*tl莹3WWw%t} 6\ mϺ5 v0Mo9Rq!S^b|Za]aIseK_;!_|nFW0i8߯|%#x?d[2GeWh 2*Z;ӖM2v^Yx`~HQ&Ho!E%#*ș7aV]Kz[uj!K8FGdu\t>묑GGY 1߻^yD"ZPAw*507uۊXآ wj b|9rkkm^˘VOOSYg'yK7 \t\88ԅ T5B9rWұЋ8b4$:ȯ/A[܂t+O@@џ{KSoGJ>R ~^ݻwoTf HԶۃ =s" H }D| 3^2NSi^Y(^O-X'wJ#xQS2ݸI[=}zn(4c_gmʂ>"dR/p!'~ T*,7-A?y$ӂ$8N G?ѪgF-*#?ubDB*?S?=o_lUn8!) p vmşT}˲SgDس7yT?zn/8/N{u/||2_i// EY^N_B@en+855p7Wp/{3}g;yNE. ~FC0߳o!׾6;B-ႌ5h7OiP1h Š2 .pEjG%)˯0*{~_̟OHyA|EYN2V#L*(9˨[? x/o  >KaH+2.JЋ{'Å e//33ӇAOc .d@S2hԤƜgE,r'<Ѩ)8/FEcW)8q/@bx XN1)^U)z&%taFV?v{8n>{^WNmkk^ru:J>uDtZ qz50+Yn5hl2DJv赝m-شfiHd{/ر#L5y&"o8Ijqt0w se;P{=b)g^,Y3Z$BMc=l Tf,mi&F<Kz4xe,fЫy J)(rExW%t ;% }ei/ e 4yL@a#xZ nzRϲCfm< 1NOT@knz[X^sog?_K|Th:XV!-BL,l Atn"/" 8hP\pdrd`U9DOH;H5nLk#8pQI╰uS}Y?X*[U(]A|]̶n غʏ$qx4X7u]m(Bq:6l!)y%( 4UISY;G1?6pH+*2 `j:ituB9wGyaq^gaco\ tcRM,ݳ'GI!1,'5nen#;zhL泮~^~Չ mnp^Q]eϽ﫭u?N*i]^yO!kQec b]wWI4Qu ч߰kW>I!Ch:,s*.!X!> 3QV\6ؾ[{5$r% %`Y¨!jhĭi҆Ӌ6 GGƭҍe m||B0e𑙪)lB'v2#a& Ncvn̆9:a01rdUwquo{?z.cdl=p=)^}g0"bo?g$0Hr e*9#WJ arj#e 2y QfO:H~/5gw\ГHc}U`^a s Ǚ;Dc{(·"wx`P%je)oGJ)c&=n%)DhIDAT(Bع2 ]*a຅;N)}ľ5vHblpPG{@"2W$cr{i'~?LXLsQf2̂aէ=w73/;LnF~o`!P7 @2 ]}q߽E>9 H# @O6`!Q9l5Lzm)D)z ,E^WU9n@,F߈A@QpE;婀߆ |>w P._bbn/l1L2E m?(KyFB;v#lQuqfN"t}a[t׏1+Ux%w}Ȭ_2[S]Pzr^/-uyDc۔(`۷f e-" J͂u% v1UހM)c??(ߧ9v(։_<} QDP_8[n ``jje`ր D['UHs>L ǐ&ؚ@bA s9ީN@ QO.=)lӧA*G%F|7Lʷr]CcPGlӋxb}G~ѣh:(/e9Αx64:ygW6˂tֲaK6:5lcHQ=RBkwvo8$m{9\vŏhhֺa+ #G'~\mZ(WUTGM1o`]+fʝ4 ԃj&]fMW+Dt06MgLJYէ{qx 0go2顉l]W:[g]yhjiONH//lۅEl0k~;7ꧯu9oNCRHvY  !bGKy],De G8|K/ &DFi)~-D*r9\)$]}i1]ayǝH!wO`,-d#Mwn' O1z46/=e}YEe"G⤱W,Pe>=MF dWNcCĒ O|(=X& x ^b7]Fo}G?KMУܘ߷oo}?s'| sZWpE=vlM| ttQs%Isb=dT|ezїNvзO.NW 5:fV%\s쩻0F.7.34Y#~8{{S<(x/0޵mC8]z_i0kj0f`\YA =k`K77r`~Fr9GsCE> _'^bX˭ a2N!~!_g~ێ8%{nV &-ܣ_u-qumeNi\?3 zHWv ^xf!1<:S S^.@5yx<:K8Dp! uZ}{__04hh)0k;is}\$ˡ|'sPNLn]E=JA|KuN%K0[0_[¡ Ur!S\trtfƂ9 vVAUvxurNk=U%qo.)ObL>j')ܰNK1[+|%!yVߛiهJmi/8/Y_\R`2_G }\}zjДe'֙z}Y1z!?[:8+pg^ ?oR? XGůUS[IJ*$:7鶪O{7@Hkk?<kktq݋m6nƶد-mR;`zv x#=\% oYRڱ#&?>ҹЪn_;j;$}*}+(}'}/LtY"$].9｟%{_a݊]hk5'SN{<_ t jM{-4%TńtY۟R6#v\喊x:'HO3^&0::m,L%3:qVE t]~Iv6Wٯ) |ʸ2]G4(6w‹$"AEv m[D;Vh[}چN|3HS:KtxU'D;77;_"e?Yqxl+@IDATxk-UYUvmc6e,#K#ԃ hB|/|m|%AB`3i0@ʸlrʮ[[qޯ=\c̝ws='}"2kXb~q@ǁ:/̝v8q@ǁ@trq@ǁ!:z:t89 t8q@ǁsȁ8u@ǁ:t@':t8qrsw]8q@ǁ@ǁ:t8s8];t8q@t2q@ǁ!:z:t89 t8q@ǁsȁ8u@ǁ:t@':t8qrsw]8q@ǁ  9+t:t8pp5Κ8\d;a%;t8ps ϳqmc(758q@ǁǁ8DX x/εFcxxhyϏK:t8(ZYf̹tA#7o|3aii)s .\_W>i\βt}8qiw&2_̡]_ڜ'9> 4oo._^ySOa~:t8q~ҥ/~wG>p5+g@L8ˎr ?3ST?O?`\XEoww8p~9ȏɟ] sO gÃsee%loo?? ``/@N_m^^XY,<]@ǁN5E[#EvvvB888wSw._3O|{>lG(0=9 n-6O``/t:t8@gݿ=0v?@ oo,Yp.1 ~~ lŤe&!N{^w8q=*3H:}>¸= g`\ Z?/pX+7_8]w8q8y]gG41F4'x@ggɳs™u0?/~1[=n~s?;pތe!PBg]q@ǁÁpF0a=~6scncNOw'L: dnݺc w#x?Oe'8*b07 |N}"[DPpe`Ctɳ\%G7 :t8 H`1nLsM۷oۿ0y-bU5ϙs| 1A]A^s7kDJϭBOĕKXѐQ7}LV9 QS+-wk\ć|xQֶ~n.:_.Dkib: m/{t]COӕ>ZɆ: x$ dڝķL\*k)'H1؂+W]]@~u:qⱲ@W9wO!D Ld!MP#G^#699 PqH`N NV RJiG1uҚIf8DK#pnؽǖ? hGx'CYQ=q:_u>T|M\75osDUªSqOY֭k(8icdi:<8UL-U  vC|ev @I| 8FVjWw V xql) 73CJ֎-M[pFCKp(Rt"H2Du} ꎫ+89NZ?ptְ Q^AӲ_QGF/c3+"'Kip:ϗAq ѾtY`;ԯ|.ĕB+x3:_;˺հ;[#i[TDu<V mѴ?ƚx\tL.cN|SUPu,0&, z<3tu^h0ɋ 3޷}x$i~nK70.h7zG.md As1舱SlI}<.nήg1 9Embz5~+td4N!G{tv5u΋R6f1FU?0|&%EqB ̣KZfTa`Oj k` rbRL`O]v 3VU}Ϗ)qbKD?sy=B1Ғ༘7`\\; ϋhf`8 ^`ƝG 767ɟ/|+:<|gxptR$dS!-L%fp0YN|bKqOV q9b"?.+I8%tu(ӫH.N)~ϱ`1+r&]N14d' \LV@{lmXJs=G? _zx]xT`>9بJ5}j",rb8E .kzaͣ 89Ct{?yz*ϳ3;Mgc:UkoB]cxV>oܸ1lƿLFa֨rQ}y] LT; eJHGDcpy=lxro…_SO>qU*x#K"^xᅠWVao_ t Q7$sRKMr!㶮{!VccCxj92q% dEsh~`*833nirܲ3_nz&i}b:'2gnCҔ'=y/kv1@fN.fǜD(`6s$>QrsesY7:/e鿩 7vZ=.ѕ(ʻl<;2Bzpَ8ݵ9_g*q3`;Ca~\-쿶?s>kO|v08;۲5&Uxw+}HlIOS$5zל)Lآ&5+q]g{B}dE;!\krw߸32#0_Ԟ "髀?}0-V x衇$@-s\*]}l3%b 5J+L* ~̖WB1ҙ,u@<qzFDZ qם84+0]A.wV#垾wa!o?#pU[sOX[] [[K&C pegR`fF~פs&SW=c_x&ňk)nҥO c7f,LݩC lodfAS/ʡ^Z<<:Ubd-;BH"?-xIL hKow<8*oLyKw N :6q s\IHzKzB8Zcgd $]h,]u@]U4OS6NCЄm f|hbLo[6iFn;<Ɲ`1vل a qϿ'}*+*U0CQ$y୉ Lh*Cv*^5DmQ'/-3k2mcr޴7RG`8c%9F:d''UqM SFpM 8 56 5L+>M`h{;⪲!nvt6T n}q9׮evh.~^Ct[U')# wq f$|fr.jZ`* 4nEs CB/|R'ӿmCEY1L թ &VUΗў7z>_>pnd@P0[c̼/s 8sS4E>o]V҄&e:hx bY2͸z12(Owh$\k"@NK`(&S,i8+hoͰ׆;zŮ^Tlp>e -=V'qΏTc22F>uQ'͵i4 pg` tg?}|Gs fFB:$yY|I}48iHJS j_8iWI\fBp-\28.{8{sQfS0Q |A1muÕ"uiKoZ*'4+D`+vڱuU[߫ph6)yls@t3g 8^rH?nmԵ)9W֡.n'39ly8e(l~~>a3(MpZa߼c.pfA0 k2{xk` #qY gR:V7i7ivy]ps`So@GoBhax pb|Q4;1퓦yu1A4*ҡ[_ga3,qYzh.F4H/DJl` V 4Jˍ(JE9MZWd^ÇtolR ,K1^aCh8W^4f(@JCV·|  Y‚Q8)3E*bͥl-5Bأ L&P#m;2лM Ѐqz5}P@9c`'UXupK[tpQ[ړO]V7t!બ':ݹa m E]#6V[t~N t1:\ J#{8*\Oߠ Z\~c4.HrkÙKC.]ty, BaR JʰC?gڙc9MIAqŠJ)8!Z# v-A>?8QeeIoe$P\PQU*zCy3@=eqA)ɔG^o#@˵2 &pmm@=lj|ɖݫ-+4LY?)P=6`Z|l ~ h &Rx=q<9#Ƌ`Gq>F:s!޸n(Pi!0 h'DžQ6|Gxb!Jyㅣ1}sGR9'LAkww> :.w5<%9xG>eH0,~3 =QlN(@tƏfa~ sw$e0&+F`5C,06e(Zlţ'v#('7ϕ8)h2#FH{`kp)8Ǟ"l2UKy e X}vP24+P<`PJLR?-ٶѡ(mcq z Em/Jr oOC=1i vfO+Mu:ot-յxhS;x+:yCb?(+16h̸SVlIm#FL>:gIƙ>S1) zwGǯ dPbԆClh$z3N\k&'W ڛ# -J ߒ}M P#8D}c؃&_K!1wO~J{t9ך3p88Fm}+t|r1^{ / +G ׮]H0-%~UÐj4ӧL`h2+(3ڊw~ڠ{N!F`S'Nmhq'8ƍ~FFpC7O_FXV}~}޽96ZYn|'lG[7Ý/Woޖwc?}8 PJh4> hLY]aKha5,]z {4^} 9c꾽/tC+,üag;m׀XMOkV_=V7;m X88v~X|pf|_^?ɀy~dE1P҂gA}Uq3!.7Chpfxg n0-#))>?O n4E7-ЇʈU|2Ec[W'pL_(dM<\e8\1i-gUjc)EFmkT10$`~'[TEѳ7|Ae/Zm.ů%=5dta헾^{1l wN0q Sؚj5y;yC2y+KImk 'BX(&AP0d1'ct ۓ1@QHɴe#jN:+|ʩR8ΓuشI[FQL>?˜P*fʄ9I/O-{V_w=ᖌky>|%w N# , t.4\JkѐqcDml[>i[r@^zx(:v%]|0a5ap.l!ݴs S85rxQaQ:WƑ;IGr!+Kb.|}] !rH8F;|sƃ`gdNs XZ,3wD+twQ]qJ[>1%\~dtq& uMps0?[{},ܯ˗m˘mcbgy&$R,Y0\)+V($W?MrsW9@q"] p [28w l1Cg1lԷjd?Nu-J!7hx Ef޲&(EwLHdnn|7%l\8Ps^\ g/}4L%q %(+AN! O?nOnibp_ _Vp᰿zM&pqa|!x&?8RGsrdGn'3>u~lSj"^ce1 Pd3t/'|=n|=|=xQFU>tb2TSwbnw@)$_U|cʲmښsִ1wEʝ>k?vW W/I(OB2aowBlh,U$f^74 _IFLdiA(VP HO dX|пhؿۇ!ټ%E|ѭFa艍Lu{zaW:>uOWow?t6 G=|K4Vy H vVDCYՔ&hc5ϞvxH$%o[afp `ghTeKvL#&*K[p[Rpr‚Oⶠ^czĀ xWe&OIvQjP"䰻b 1V?~?N5Wõ+kN3lY<29XM)G%d:DGAIQC,Osih|;_6+FmSyv;pT~=C}{7L'oJɈ z^[ iHۊD%HfL&NC\,!Mۚ^΁H|)lEBNk/iŇc ~nc F >0&/Z=lsCcl't`ocH[j]ٟiLc;.?ǘb7èP !` #0V9k1u%qt+]I-t@̕ӝ0>[o{׾53l@?: -;̔;ٴO#fteՀ%q`Hvy8R|L☚z-ynaj6p<~{.yon^u^nkh7@OueyAnBٟ!>Fij29PFqW<5Y9*瓷y9|;/sa-s}myJ^6|l7A\ʓ)ke h =!*8jspN?a'_s h *XYV$,oP2MtS Ec*QUc4P +kBIOFh,agC=|`IDeb ޣ +3%\0s{YfEN`>C0 c+%ULd8 ;sȍb`]ֽu~og"\2/- BpR7P0ؤ 0EuFUigx0Dd|?Jx֫a[/<V z^FdN@zS΀ *,쒐1DƱ"' kc(jZWFqY>@"BLÙLLd2 >50^P 4DPrӔƮ~ƁX1pAd)~0~N_Lo<öD=6a2s)U d\h$`Owi*jZXy,OA0+y%/8OFlasÜ.|W.ןV_0ÿqj_T\ōu&F4Qƕ{唲288`QGngn Kz@XpԭꇱwAvQȉ=I o\hLM{ᱠDaT%Ɋ+STG@"g{Mu^Vv)L:pyqݑt.n#jeʼn_ V 99e '7w֭o~z h>dqX_~IJn#(8q3+ pe΢KpZj50:wKG᎞ycp( J<|5z*:M*u`crY1/Rzzzl?z>|GX侴ވ#qz4O(歏}A*Ĵx(;?Ih^'~ܾNŲ:E좂i$uL:1:΋뎤 pI3b~։e$7 w# gbp>[cozS;(VWQ(7\suV[z,#(+PT{(oSB^*,~4 _XvRƈ<3ǫxiG.8dz,ʷ눾ؠ.ˋ@'M/ea[] W=vu#|mXҎmPOH퐚Nh7 Șxp cWXcXծ29*tW JAtԤ!n -acqDŽ}qt nh(5m3Gx onˌO##LKv4^ҏ7Ч# 3r: Ӥ+`v'n[R{{Rھ/~?=χ~Wk)<;*:W^UF8empe92euFFx} @Z8_9<}2N;':ţ|x؜9vX:Oc]"cبň8 qUi9SƷ4)˳2`gxq,T򺴭A95%!n+7 5(γ(pO]f@S۴h38#ȥc^{Gx7^_heF^73)qu8iS:z9֯}|l A 9/Y^dؖ߿q;Nvxqji.{^.Fwx[toFΤѡ1sh,3t?#qjLO 9(L+~L)T2 WQ'ݿOC)D+tyK K*NrYcʟ-}V[=l~['9ٸL*nStM^(qq8!ë¸ym 4͓e(_z^s{/?9֩nt},30"傘o ,]ӛ? wof^noF= #lqp1ee|Y0ƍ~)>hE, KOۏo&蕵b'zu*hܭ^ԇvSsiquG:f 5S)=#(?㾂L=k=;Х\(kGz})aL`rx絒] uqD 0$a>ſ 3dO 0%pԍ%E<y#ŧ:vGqQ/`m륰}pڻEpwaqFL8]Dr &޺_yKuWcj18]ӫtDilƟG0ONOYzoH-ni|xǼw7f-Wo}%l_/>.ѻf9es8 8⼜X{2TvVZa_3) 3Wݻ.s&q0 (\5hNNZ )KU]y]AZah/>q_ Cyni|kY2Iz򎀉#C ޛ_Mu|#@IDATnˠ}sTb]i,C F.[r~Rh/_oq1JsʕG@g vpLZ&bx5M8:uNo)ZuFώJG2%OIߝ#N8χpH(pFVt|[ [&Pf'0+W"C\^SRgqiMo{6|㓿}PA`e1-̡61s&'^4>+t>XήǮd$dD8Ohc}}=q"zy?Q2?hioW_й>R0^}NNX4ecU@J985\SFzY~<'?6^~.,վkɯvY hNÊHCpCG 7v.ʓs&Õy-y9q3&CD1.P[=3|P˘h*O^||=i/SC={%2>h':%>np8g:Q<NM2:X~L0(+Bltm6#RdFީK 8X?mINIbXĴrҔ9sIr򺤝>:zq=lR')SvYem_߅<){OʘXER,3Jj&-ctIo+bznvm}@d@ɀ NcFQ---%?m"`cncbjC@Y$ibArHl+sm2 t,k,NauM%c+~Y8mɟUc()Dfj%Dxf26i?:ƨ>Șn<K! `|MS3†LWa"/L١tP~zA3;iJXQGM(8WMqSȏt끌᝗+O_] NU !1@:8,O\א]'P#uT丼VQ/#veuMU\6K*u+@m_ .qĈT% .NⲆf Z!+m:j\#3-;u8K~( 6wd|B[ܳ>=6aD{F0ppov=/7E<s6&B%Tx%*?|N;xsH 2l Fɸq+R.#(bɞ9ƃ h@Pl@ǝE)YJ3gEutui*Vj6J Z{GSn))xTG{w p +k/\ bG!P3Wv?Fe#4WwkH< :~.e;Et pIWG6wn6yUdJ/^ +2$,m(|ƍb# +bTosOyF08̝I") #q QgkI DhK_ײꀇ>8,pĒ.fK ' fj%D.@ !_P0f(QHnY lJ_gK_RyfxG~}ҥKh*nZ`IE)Wkx/K%f䤐PVOFڍ? mXDX0(7&%JrQܑKՓ|>8~b;*6yOڥ/O}_= `)CAMڃ:_BN*Ƙ8ick2+v`A ,h]yټI۳k̪V*KeOs1 4rm+>|9sƈJHʃI7>я|3 K/W? TqQ2 xv:liBRN|]F`Qv/4 9CPNnɄFѱzqdːW~v<ܠ.4lZu\+x갋p$+gN'6S_ѵySt(=m]*JY<48/NW\,@^ 1og"*IDZmv> rs4M_y6+M :W)J{ mOZv@RVgbgEzPP2Lr i̊OX_~=9  EB|3z;zG2Y,Ô`]Ya|\ :V7I:&Yn@L OԎ]EÀUPla?۵S}+NGCht|vbOSNC' X(k$8Nc5v^f=˛!13F ӘJ9-8cLK+pѡ01; 81hU\ftNG)N!t9ni9cF X)zA^S=lxm T5mSAޮ ג*4"P|\x\{HU. .Ha4Q(~pTXYx6_ףeO0'>t".4;t6 l;J62\5ZÏ'9'h|o;U;Sf$휏w΍0sA!u2b ?h@<%=3DX; .ЛغG6n \C>q 8ѶBO2q)+6̂.Y0$ɡ dLA/uKeGHr}ػ37ؗeQLS0E~>?౿oK?HN|"X&Skq:@섵yށ~28nELwCsI0yHe Vbp(9|EJ^*8K 4Sڲ|bshJ43 gDs~kVVW?kIK qJ&+Jr;]V8]5N)" eׅVRp ה-pBBr9 RQOZ8% Wt{TQ^Hi{{G'ZA!zӳןp}^cq=wIuhr`+ad*)5,&PFUq}l6g_gW.sf~ PmvVVtHr'!=Ɗq1JI) 9|P2F[ ~p_S) ztYrroohPqXXLɃVq`qCbX8הyzQ2mx0Yؑ|@>|l#ϙL;4^ r7ч~GS(Tqs,Gai^ ]s qnn؞M^`/.1ϑ22/ 4Xxg-pX6a6= :`XX|gyo~)>K}V*YUقވgh5cvJ&"Jݔf2SRn@Q8lG#bXВ z!D!'+;GޡWG8ٖ՛Ҁ"Cm;^^ =\TX' ;0$Z"RIH2 QnݢzEyɦpkg]򸞗%er4,갟v^ :غ1+Ao^xVs:C"T6!Vrc~c#9kc^?t9DvwvÅ9T2}nsLy#6/I-[2p65onq%yZl&t07oIfSDfp"SY8R^x B|59B{r}JcjPXI ||#<_]] ?`X^oI cD=pPH|M +ewEQ* фuᘒd)GxX@Yd!**QFN&Gʾ(PgPO|ד?E32rKT'OYC|K'cFt..euKF 3ow(xUúG\>-el՗!t,{L\Hǻ''H'7sk_r!îz=`%s!Q-`~;zNT]2Hm}On; ~]ȗc" @W~O !a`-g3rKa%cn4eڝ0S?=ی??m/P +Wk׮Yٍ[Ld1Y-R`v U/8hNk-a)/ħwv{}kj m m5NH U 9U1!z[JuNQf~a]s]#]^V=m3NB 2wu qM0Y[: / sև 5tejR1dN'p%yT40[LLMdYO Bq0ܢǁ!SBpY[+ njvt iV2ր`wsGv y ܶY EJ00`fݭτy= mqPޫ4=b+LVo%dVӂ8ǧuHP9 V0'`!}Iryw<,a2[lI#_zYu/^P'J* R8*(@C^4iYևT4VOK 2]WTps1+5<@LYZeZqDWp0ؔ]+ꚲ4DڬPŞ54qyZ<˒83}}CWH&4;ޞqڮIA>Npt"uun?>X2Ɯ??;J*eN1>NwP(Gqp@)[OnQNR:&8q4DHfG():|}}A׺v~=1m#QF4l_O L&Su0*H{'=FqiUU*Y U)eA/<~6W shNF@7 4=@ߥN[[/:<N'SGgl z%h.qOX?uqmK5+өWCE (D\:q:[ +#"N2>u9t]2L ˫yKUBZ2&M0*/G|`gC߽< ?upµE}Z=Yv?Ƕ}@Oxky_F幼PI946ƴiےZ c!ǖH]՛"Bk3|y9ͼy㸢_yX-~wyz 5w1yZ@2[?y?yNPnH/5886NĽA~pz]:o1[?⚺*jQC[c)g`,ohVb.J:YGX]ʹi6TVq n_~^_۾sv[**߭L :XmeDɰb[+@Z`<Vǵ<19-@МRhΪCX]bsVYLQ!tˬ窜}疰D:CE`}!yKaoV/{ekD|N+Y}hY/E@8 N=Ro7Y`gd|S_Z+:NM#5tթ-8ZX֟ akTk"WpԘ@&EEr5rRwLdpc|<ܺ:I0vG@+r@ doۮտpGwv 󆲞)4_^$hQk0;.[[8:JX~ڏ !%M-V@GO荊8MKU;obie+>WsH\H.X8〬أJ߶O߇s9\jt̗AQ;'LN4R{uD(3135`n@V 荊8};^ _KbyUŪhuy.>0 3ͷOv@>4rj@ȿH 6ڔ pQ;'K݉mֱPwQS1=W^ճ|s/+AWò(qj?}ԣX8bcCbU&@7A@3tsćOV|[a@E2T]$nlIo0otʌϣ3W)@)+ō&@0`4[u+6PU%=K[ןO|mLF Xg]svrCoN%Á/968czߘ̉"@ڋjk Ss`SفL3?;k +Fyv_ꎕ?*4_+ SŨp+0{u{/O}@'>dg9s[?5#<ĹNcz5n[uLfsBېSn8?5=%>_o4b-xJޝNԟGKg3u@=Dy3`d;I_`:ŹUأCbvkn$v${Y҂IDdNZOR}^&{J|6^pbcWi۷o|+፛7õWã>\l5%՘p6tɬdXӤXEt8xj5 U>zX,=ݥN+28a'v|: ' fNZ116O2&ji )\N_K}>sj}_ݶ| {ڷ|re4@)2޷gSçf8ܓ4oL%8 CץOlLeuqPBˌӃjߝ7 0#a,0 akwC{Cbp)p Z=n' &}ns6wm}󯯯~?o<@X^Z oF?OO~73\Ֆ?%p…ps/o~msNN ʣW"^z`gE)ʢKQyb#}, |t.c,+=c&0Rn;U3Y& ljw \qje'`1;qF>h)'?ɰ[_t)x9+ď`v+\nc@Q<{>LׇpPwpM-vÞQMLȲN\V! t;c$ oV !`kfbӖR7))]fS!9}c̻8]R`f8X3E? 9Myu'V'q'$p2.Sۻ O1Ar?86yX֦ S% 1 Ao~ILwIt]8`x|t'c^X8E[6'Пg̷0gӞn!Nmo3+z"hgt/躞MA}qNJ1MiBמ?wf DŽgՈ3(^| {v#~1tr1M^ܔ1%-uIVyhZ]Slyh@8Gϣ{q8\i91}pǓg<59%#|;OOXm?FO?lko'˥K{o?׌H,!g>][h 8N{z;(b 78/uf3; U0OI,Nz\gѧ6`vgpŃ>ꩧlUV;ZJ_Рan BmZ'ʲ.,_y@[嵄s:8#;:""GfW͌1 sr49]٦=fs#xwAㅐr_w]o}9< ?)KxM:tH8 yY*k8wfWLɭ{}셅+aa p^ ̷p8pgF%\,CB8v~x:ǀ63ED̨JNV ޞ']1=^񁋭;'-V\PHqNb\ҝ[ԷʵG_ 棖;:H 9Hb6{L#^+6WOoy[OX#WŲՐFP܏ŸǎDpF]!h4T],c〉Zꍰ+7+*M$L4XxMYھIAlvuSԉ)}Zع]J\(J@ )^xm ֘˩=s(]=#H^?7VVQŅGO+rԖ\w\zsx'CVcXu@1":Ҷ?JO0%Isg;ܸZ1HAG_?MSK+"`E钎RC?ҷa~q5.!0ItH?"풥?0Iv>ҧy]}؞pi o\ s: қ GÞ6vxq@sI/ZЎdxtB@I2H&mg'muA:S{YՋ̋f[90E7p6H5W{sP RYDr7#sTEk$i).|?<Go^gCY Ռ?'esQ' YMx`b6%vi%\E9ŋz/ZY] :7ŋzM/IL Xw6xgv0|eY40PϩY@St&aF;suyv[B9cޤ kvֹZ$2r0IunE@UaxJT~KrԺdDU s+w;3a^o?Ɗ[cZXFi˧Z',$ˌTX|2OIzҶ^1V,-)}Tk}%\\_-尦C8n[[8QCZZb4xqE~nusLczk=m-o״5ǧsDKQV2YZ;5< '`w;\W&ع8/F>|M!ƀ_2ve7Pˤ(> V$O/MhvڨKB4%BsbGr @=vT14}88mUBx]jw1~tДFn'v^1C@`ByZS N'ʔOJS` ]~ެN<#%XTA}j+B8}5pMǧ jwh( YZWps*e›Ip ަu&\L)hf ]AV$ߔCZ׬e0h5s8Ҍ:?yORu/y;`[fP U8vGmM.,ͅ#m'=ΏSÑ"j/b|{ܷO`11ַЛ<ץHF2TiL(3Ma1e؞ GqM^͛ypRNοp)!t |ݑk' EY*ڣMoJ[ÅG7z3any]O0`OR"[ r=[ax&?h댄VD^(AS9O\(3u4zBWQ4_]oh]^y ],0rZzhv!vnB_&M0ʐfPc$D d'Hx̠3-yzy0dvѮ1.}W N7Г' =OIޔ$s_^SυK?PXh=[mT\&}L;A?#ODJsk *o_G/%G(;#uRD`ŮVgVe 0Cm& O5S(*f]wq3aOkf"56yHssI8-h'þz KˡG%<=e;=}`EP$B YSPon]7\sM(BZ¾os{򼽣?#e `+s2Mk k %`eJxSc˕|޿_5`_{M+o x6[;b-R-iBXF_C@G ~l'#PC< qf={r7q>DTG8;d wAAjggW^ > O?txτ .Q?&}8r{\XOanxX_ [+b~̙,4 #b_A=τ׻0q BN6-sbZ}|`#܊ԧuɨ&tQNE`[:MPv=X x{篶߅5x MF?ygc3`D0s1۷ aee%? 7ë~73ܺuk%@ ]&=DaL/<תaGP^ ׅ %i^f) Pd(]}ʶ=z O0Tr)\~vG: Xm8(]eMYwjPfa2b/wwN'nONqӘ6IQn;rH@X&S>S9|`9Sd^_җ[ƍ͛wy'|_ CqװEqR1H3nvaQadr OXS*- doµAcWs7޵қ$T^䂏& + |\+q1ÿX1G0 p/kw(Bgɖ4{?_ᇛŸ΀8N^"oGTr{L@-05GtI^^<$P OÀьKw#nN̏'MQ/lCU-x;Sxa"*f}`+IpϠ.gI0{Tab).Re9, 4w 9k}'/I/侲rm ~`cP0 P|Y28 ?78#n@IDAT^ǡcy'o%Ɋۖ$7A`S:iۧzL+n`d'iixY;4ycy,txA ay>  ᫩PE&ue)Gq<vt5PTދ7א^{˯Q=xJ-Kx'gL HsJ؃I7 ]sez&=Gtqx(vtIFz-Rqb%@O|meMl_׃vǻJ#qdm{udj--ީO#tN4P&,~7~x6̖hۂf=.'_rXzW[&5- &(Dy:$ j&S-|Z+oI{OS)Uz#Q۫](ODaH_ 64L~?kCBXZ(&y\! | ˜4}Vq']Núp<=~5;4J+ß h/`x7=`ȇp/EO7 (qpt&?|'Q ?X"<*%"fŢݻᩧ4L ~Op=XٓUMc]{"o` ~B8 aJ0+F|%i~:,ap' ~0/aZ0V` /0m1FzDcZu(<|#;@7!ÕM1{MCD-Zӂb~}* z& * ]XY^wnP#nowl mp8`T # Q8o1<@C?4E{w2qH:p] q#MhIX= q',(6p'^A`']=o`G\~ 'm8KKZ{ccwf2 L%*j4/~//{^]v$5gG<[j75gȗ2L0 g90 gx0Lqa<,n0P M!i $u xAW|WC󵯄%G1]KQ׊ʅ|,Rg+l<-98p;iuv EPz{[sz/XhGSF)ꑴ{?pi JrX_&G(;i\XS6ȗüBaş40CzV0y&%h(ey7SF +WL e\tz ѐ9Hx-c83@1p;`Nq'eoO8Ƿ?0yp?NvӃz<;ە/Rث Kf_C  kqp|e9,]gcX)")rGYͰXҌ,1WYvi! ?ncwOR6t(xުo|tkD9@.]#~Lhwlhp.:DiEHa\; ]ݍk. lE<ʅ=w~{A!-/qwNY<= tOIdQ82`DhP4j?ϚLwMt$x0޿ 0gt0a8ά(L2R6¤*߄v<< i۞P=o1 (,,R3|://,4wMCGߐ'yQ@bRT6Y֭}+>)*te|~P@,FZHn_]oBF45} lwN Sm~ibm]c>q#4֕ttäm7BMN=}QfPήt` tZOu9\^FF,xe2e?` S ƝM$ Fŷhg o"^TL*?p0Hk`(0(8SxuyR7 fFI䏻3MW a!ַ1,6;䉚g*/VG^5 K~b3:1ʟ)c t17s ߺ_ BtC!|+ԕ 1x|PK1O:6<8izȧnI6Ĕ Oxtex1hӛ'<6nCWzQ#aI'mʛ?;9Ǎ3pw42`DmAިݦQ6oMd#<%280 33qMXd@!0$mz;=y"0⊄?b`l񃙦 <ʹ<ܻl~7VeSIp.Y|y} Urz߷:"=z@ T&,[*5 $6.ԩ+]P@Q0#waSzE8iEc*Ok _R)*LNW`Sfyx2ZHX6)k ~U Oᶷ ,Mҥl إRTpUQM&lL##{(q( ;;l+Jh >kBڂܠQKXp]'6JĨx?١l#_ \3M\׵˥VSzrHAX8()p@`$M-Ȓ:8 ~2szᚆf""]saUhc&m 76DtEdN[:X2A70bqdx` .d=t\Q{p ?1Ǵ;0;\9q&Lxn ;i=ƲViԢY)Zkw'BIgwYԒ՚t"ii:_ x ]%3-??ju }VVD:+%C Kńf[;, -qۣVG r#N^MYYY`l`&}兀SҹGctt u tִ^hIOKlh´)lZ gt&y, ?5~ ~JLf!e΍#ʏ׉aI;JC1fh[az=IAWe o${ }pL4Bfn>&V$91>'}aCsT%ꭚ,+)+Q2(b==c_y ͈ݴc2@v}oW q;T( 7z&vH.Gg<@Emsd}eIxBh憍0F(pz*z/k] Hz =Ӄ3z g3mO2oGn6/qڒI6BFa6ߠwi;`kŏT^C|S )臾&0c(GB;G< Y^bμ=(r>12`bQ,JP-~$Ǣ5lӑpAؾ&PHQ3y#A 6b)Q$jhk>waaeH姞 H-p,{dޤeױ;yJ',0U\ 0ψ 8jzR/:AsZ(D1,^8hZ7M-[i*E  BR*m)EzٳjOE 0BFaysGH`Ir:q8 1g;GT5rkNޓG6OcE ]6!2`F0(O8,ID/b2-K N'D}{` |rw$p$ɋ$W4UհygGzÓ~|YtHWwg\{8B0.hMY)VE> Ku`61a~Oq&HG:A`21#"zG"Aqd_\#-}qzُdG\S S0!pDTz=Gp?ƧOqw){;>28æ)a:ujVihVLztW/a0;my;isVJaὗgAJf*B@d0zo|/GBF'x(#@/E?wۤ"!ּ! 7>ZOl뜅itJkJ(.w{Z?[sS)*d*Z &zGKqZCP0T7fmS¡=:ʄTl!)'elKnB_J,|QCQ P eU{uL =Y(#@硫whO /We2`:a"ap믇˗/zʶ=r0*Cϸbp[{T"? To}9ԶBiɘ; lv< ]tO9Y cqD^~ !v#DZHFK5qG `?ߕz{Gx#yia۲݇R6L{%[| Zlń%=D'.twGԉ4Q IS /D(.) 9";3 JZ@~*uSo7>6R0!V"_j?p=_~=|# k>1_8heK̙(t;c@9^y50Czqy w^UWla;kxw1cL!'{eđPXτ1epKK%Lu^~d=Cză] p7_OXLc™p#PuP۾g SN#TAhS.xlN?0\ ?Է%}S ԌN$n#2r@)BeU[UurhJfj g{8㩀2`Cļx{T˾N00>.`?? kOŸڅ!h xckmJ [  `aޛw_bE!0<@퓗ܳCh&@vtN?&¿as"Df C߇>_O'tWңo0?œ>C 6?x-44gѠ:^)rfLsTwNs2c/%;yu6P&O`niY:\I%"eјZq OLN=x0ڝ2{饗"p4d |#g13v\RUjكX}y"/ᥞV(Ep:4)י]YEH[pw}O5ç>_ҭyR+Op+`MyfևS$0zо#о+ q<4 }-EC:qPG?|~[/h$ 'Q%Wd~QBR ADM]X<~cWlڃ7D:yj\z6+4]#3χ4nywE_Yi?iǺ>W-Psjd T3w #lzD\ S|O?=0~9ݒjutʀ=سɫ7x念Eͳj[$c0H%nE},{۹pgesafEN-o? _١4fFcU)]QE:~.J\^[/]0I]zgok}?O';GqG7PxF$}]q.>c PXGi)o7? Dž?6(PN@Gt#^l׽Bz4_"e2 ˡu߻|ٱ ksus`SwZORIC!) 4B ~Kǧ~{~ivճ'ϻoG~RiS^PnPW@%m鼆BtPk)aDS8wA3^ϴkG ; d *^xotz Go #,Xң,uy0gcv f٪Fumwk^u?hhTܶKaG5ϝ{ZxՖ{u]0?ipGӭv Z {+]^ΘMO6ƅ=|zvFC=¹?nC.\xǸm4懯+>='it{4^|QS(riD7PP M<:yaAGa'9}hKܥ; 0h,0__7:|z|ŋF @@glyIk<3Fgpp 1!.f,?v8忠!'tO,-pӒRTWڧ];Mij_C6{]A}BzC0|9[Зz9=WUw<ZO+ i;x.Ha_kq?hWǿz \|$)<)-x Zhn=Զ6%@]T\׌zW/5zqW{0QӁYODt(<(7nܰ)|>Mj'Dlp0Lj4< =큅n52aߔbDeQFʀz[f!WO J)^hh'I]hklh=.ā ,b( qv:/K$tw}_oNc9OsvYDЈD8~+Oڳzٔ3)>BC[WOi&x@C %Mȳ%7u}Sv8"chT珛^C10;޼pglVCSrB"MOV0x~) $7e %TΣAqƤ)268v1z/?wzHǧXx߸aΎk_L? /VdX,tzʢy^SSWNݹU{cg uMcɟO|BΚV#Ax|}$A7Eҕjo >Bh(ސjԤA~q=]C 6y7`D{p|Ð4C8Kx`l,Sf ٖ@ 7#g|spcWՖ:_S ;΃`$WxMmLJ+㸥LxF@ԓ.PSTӗdo}Ak8bZ! @$)V_=+?v)d-@Q7mid8 L&loop{'-&i9( [U6 'mC$_1`@~W;s 퓆ćye$O4& !~aI&yyN&FaxˋiVT<B#uL!\KuKA\ uc4|t|KFhOP˺H[glW;ީì>\e@0ji0δx#bCFq y94jY aak`N$CXaHoEq9wkچ } MψeH-섥fc=@ovyx[ o|SE9GOڜ40L7utYKp.,ˆiLC!La;y!]䝲Ə3r=='-# icyp]n. Gziy#C؄Ơ|H0D偓<7у^tQa+ MlJhd)k 4A~ީp3JB-ɰۛa5 پr=̞$H@>\*m0BXo^I;H.0a2>P(Ԅ"?g6 T4q q{7`<#dpslAkLw`4afG6Cl+e7@T;^ <z0[;W|~8-m| QGivwÝЮrz 4N:ҧ^œ)`녰w:-8x;<ُ2Z߬oxrג"(WLq̞[:CNgd,PtxI7BELX y{鸽oyHʀ0r%<ӂ .b8:o}![oۺe ֙3~+M7J wǫ SX= pY7{?gi;*}X.޶Z Bi N{}ccm#yd0p5?2:GqewQ\"ж1p4(C z̀xE=K-Q<~"4]9 *j?? pwc~< UNjw@cOGZa6O^~2'Fs'a^]iww4CGl?v9Q {w}02`FhGfaP?ø{x,ў[3s]n\~hmkQ]05zҀypwzEV[0H@`V%4vw&]paI@q0qΙi), #yK,D Isd\D;B/Hh2@JeE#"fu!-ŰoxaU/\]fBZIфp_d8IhR~NCiS8ZRXAPp_A+7_η~(~7!t^ΡLլW| 3 E{ ~3[i$-ďFj0z 2Cƨ63n~PlMv;=M q#ɋCHpzAʐ/w %tP&Jajb>`!0@5G@f⢆'!)~(" ~RvД`+}5D)“?)aih wAKAZ\`("Eڶ qresW\ vgDOF? eNCdЅXQwF?8Р rwC=so e%6[~#?{2=#o^ {SE68uMj2~S'E)`" X;w 9?=-F _/ [ͦm>ĠFpVJ@ jޒtP zy~-FA`џ#`Ky =,_P]ay["7w^3e#Åu('*a A)_l(&ojkSp#7;Rop}͢ų5Y;U \RCiWmkrma!Td[oVڢWKUS`qD8^ GJ GY#,x)XUŽؐ?gS' )bAiyp4-IաA(nRaQ; *h: %fghKvr:k0lo&hT6 y(y(KN5[8 Qa~ %1x+BLN5 2i;;B{<)9 Hć5F%iR$G!&y;S^hÝ,jBɿw$taSfGF( YRP$L1>a`Jq(JgqAN E`HaaÔOp-[Q9P&7T/4А"͑rY"?"2 gMn?.K;`H^qpnM8h(p),zXعu7n*b:枿V -TŒ~ߨ WiŽxP<( JcgG\ƦzYGmzB C'Ѭ~4)z qB|u%ܺ~/fY= ?)Ȥ!swFXl{R.8zs7ztuvޫ5m {^%zj%ygXnA[E]-_ZͶ -A6XǴH+*e1)#psN|z"s\_pƍCLwD]ofb~$po09FcGh\IGjնuiPX01 }\cmA>s"ϰ+iG3ÖOT²WA4%BElÙ<,C%nϣW hiaIӍnbDx?(0 @@?#y\ e>N0g< DN0ρ*|=6 A+`nΛgUV#s c$K (kW=-^GwJ IkN㢤^ ;߉kD`e=jڦJIO!ܿ H @z`pNy@60`0k׮G3w៶Q?dw;,,1aW聵0R[[T@c=j +2O zMM0<o{d%E7.Wwk>ﶏ8ݤi^:ȠF}S^?%\tZ$jwਠEnoeK?FVX7?|=l+;X:W/pI-5밹+g (+Qatu)#*f_]'?I ^z3Z\b #-@Fd֭tS6? xQx8&wyiMw&NRyxe?-^euTTf<2n cYaD"]Y+5Mieawtt<@ gh/~_VtFx|I d${ԙܴ p3S@[yH-pE{WT;5"<qvN1އSD8 ޿/Cgg W Ւ /ua?iz:sa{{{&;Kڟ #ѐi(1GjNmbdn n'q32>0:\;#DL/D9McнnIecUN1غ.Z't\a TwǦr GG|Ѝ?qk1bG Ϛ*ޱhQn;hn~c` ft.0*fN[+?tJl0EˬK_h1G?u]ow@#Ȅ!tǏ+x)Ԃ ޿ ~yGiLL#A)1*ՙ?Jf{{F ~FP 0S 祋psK9"xp~yrw.%c/];4 Q` w-{zWNeH8o{3wBD.D4"qmYWDF?\;PH  ؆L z 2c$u4IñkbLGe.sÀ+IzB\R,/)q=H%"zt6ͼ$ ¤8gFvn|O跥#/,l- #-޾+ظNS}1)}2ܑF `|:$M-wp@EUu k^S6%@1-[Ѹ̙!'n{L+!i:u_cm^~l%zϾCh\ʇKZ76iw8KSv h`&8a$ȒjYȧp@:d7G3/g|NB7.-JHVR Tӫ.åe}4n{hC:Fظ܂?BI&<^fc D}lWNOt1؁̻BUl,#󮕑w`+zɣwd@ X[6 7LA}y7zHY!1MdjC -S*X$=I N.<h`_ݾwV \IpOYG0)GPr0k*_O$!Kv إ8HU婙8O @. oE2(8WSw?r9={ ą,]yipG@i̜o d Y?qރb4nNN r @hF1:t'LeRIGuf;}#qB.8a-`\%غJ u̻%}A8\`5x>;gX<H` 3JQߡ=ep0O~O˼ ߪ+~x=nP.fA"'0Y (@vZr4x@z;(IjΔ6O 2g'1> *޼a| <гma0FxSAqbK ~NIUYՁ@F, t п];-n0)LW Ս;yk8}^> v@e'~hq٣RcJN0EJiDa n᠒ba6( 'l@4ٌI2B(u|b6&K$4}{_: .zu7Ϯ7XYNG2 CC9? tc6\e B4Jئ<ȒkحN &?3mf'!՗Nz3*r u;^rtFV/OhOwU Ʋ)uQchE>!QP!%^0v> d xuf> "-aqqMi OIv?ԋF{b Q3kGZ |}rhnؕ? y1hT".F;JPo۳%nYH~m孽$.W*RJ !_ ߶O,Ȕv5ݰ  TvnvUfJr(:hPet007^ZHxd/'L0B4\ ӱ|ppSh{+ؐO'CQz*= {mQع}  FM'w5 Ƹ0!:28.389o?4BqʓS|%-󼅽TV lS+}s6/9SJbRÎ2.쯇Ž WX[?SE93 Pӵ,d#D/<jrY*8JqbSXy ɡZO^gL&¿ B׿(ܽ{zW^ ?+O~E#~ [:~( r  UtŒع\fiX}U X]tؤzT%;;U\>\k-bX\Z++amu-].յ"PY\PZxp, 2}L,ډa@*eM\.Jl#CKͪhFt@7+(!\-E C\;(R[Gxtx_f ?;;ҥKb4o/=>/Q$s7 ಪL˔{_cǯY3O$1]g9vA=v+^P%lhǡ>3H](k`Y{tTY ł _+ER9bKZP} 2cueYb:.s B7%=ME L+hgyQǦ7шNO@!a Sډ?XիfJCx7=`8fa, g2O׸In7uسa,]XFalf$\-FD}ߪk58ʕGF*cqYt:@[\DIccŽ. r Gسʅ?OTVl`P4#4h{V/)oacr.sFMWٻU)N*˫ #{>p =,fO$B!r:q~#_`|q9 f /`~YC<|(mHG{`r$D0cx@c;dLOۥPx9Thdc't3:_E}*|f $4J_4fKiQb SF/??oϢ?#ypG ;@ѣSңݟG3OfbS2NF5*s] Y"SG{$u@hTH鸓VB3izq"cgb Sԝ pjg?~~B? ͞JjծwAG3!q޶%L8J\ĝWpb?iTץT~6p7캊#A->G೬gl $(үjWWõk/l+G`X0荦_4#+􊘯6 n9!7P'l_`~Iw2rpnZ$3~<Ϳu'IjSŀxQGJIKʹ57,1q /bڲ^(j..Y>ja.GS*޶hREAZ:u n<:@ J!1PEǎHIdʈ|~7@ Mlj;k M{rFN(N!< @N]hȼY ݇j *譆m+c(}"KnugoնBkoS"1 O q,`QjHЌGu d 5sG(Q)%@+UbMbT8ߓˆ9|)ԴQ<3\^ E%~TK|O+Ჾϗ7{)P2PĈ CD[U=E^M~ngc SH6u`e/4B#@E_!E 9Wn|Z%/yG̳8+b%ӽ~I|E%  `RvN{Bqu67nNYI1)bla-n郝tQ'%Ak?lv3 88Q>BOoKݺCףM߿Ǹ/nw,V( g+K%ɝ|hÍ+KʅAM.:z+.*,mG iG': L7#q揁LQtFΛ6Ɨc @M+8L.H F WMsR$̨"+P GhUw\9cp!D8 7k\8zC&T7weiwE'/VFaYǚTL@`G1Z#˫{D[9pp#y7q(+0)p ]/94=ϯ y?;µ(%EPp;rey&`kGk|"*>HipY?ihie)sȄH\^%}DTMc 0aci`Y 5oQ $rg0(0 3*;w%O3#w KyyA(0$m+H#mg]Bʘ)bhߖ4A3B)pFzL^|~z^SnI X n\5(7KeP,lBk7/)Zf =^NA}2lBxmP&ON>]bM\u.Ip S$ÃV2+AGCǝFR@uf%z9$@r%Bڙ u”? p? yM0 )o£P*|!P`P(+8D%x+)(2( oJF7_pQ4zR^ wBt )9ihC31k•Bx n1c܈M v2@{ Ko[FUItiAR@Hd6f 6llxa^0afČ#$h(iH%JH222+#w;7޸k,ݏYowr :Ù:֏"D)FޜޡhΨad0V&H9Jd2xyK*#e"1d}C pC/n˔  Npw,ѐM^)cA/ı) z!L#a AXA(b[9UnkeiyFUV=bcޘVpHWÚ*ܢj>󪐗h!`EAt aAA cY ߙXذ;#@;NLz9n#憥z䌑 a`,+̚FEOzBG@@5^0Qƒ0൩ )Lw@bAY_P]`G}ƙ?%0ambeb#0}|i ߙ\#CAiAaH'M"?9l78 P&s! -nLgw;c#Ŭ3g X)p:NT|f̃̆B>%HO<=# a IW4iF(#\,0#FeDI@Cz߅E"MHu3Ǧ~yJCun]55k'uO~b;r$Ӥc8/іCjB}yI[BL-QtxpBN"uwk?F31@s0{F9Ǽ8f]V.jXVbϕ~S2<)#g qaǯ/I9wQ,F މ!<8J|#y״UMB5"=qnCڤ@6<)W֡9ݣaڙ0qIjєM}*G{'9/B .,1=Z ]4_|A _CpU$Ni7'Ez}6 〹,#=SᡇO`Ȃ* ZO業b6WzlC1gks1AQ W J[8?:.8$$"ʡI& K @o Mhi1n e8Sh&| -ϟ puؤѮ| \ jG::/| GQ&̑gۨ=P@/HaE?*[fDž9 g#߸lsépߟw$y Yb:gF-h:59eDœbׂ` DH˅MOOOiL>j_pL50 `# $qNS 0hFFDz:3ii:8A@b~ (}7֨ӷsB r_ kAxᠴ%xA Ѣ;riiyF .h:@55(ܽP ;L O}k3FCA BHT3y[Y\tkZ%ѨP.mrO}QڅEUzt{4 F{+N&e#7K/,HSХ9;IWZ3f$i~lz" Li!!ӱ=-9ұJ4,V'@$.o]EѣB@vDp3=8*g0|_a"?^am5\_o:y! m aEfΌ񂮉5wfZӪr1MWxvJ7b@q)PRkPF>.N#5פH92XPPthP&BGzDtA8Vb+eD ]@`I(cZ^Ē󖙘>tDpIM(nߊN+IhX :@mD΄[FPiY'q0 sj36r0δ\kGMbMp9YS&h/Dto1`a2'Z-u̿;@.ؘ1yσgd#0 ~#{@zkטF-GaEjQ(Ii5 ؠΝ"x'q; [l\HU?}p+n7ڴ~¹km}bnI{WGǣ}p3鳡aݻ靣625Owqg@M:h2_KQl325@.4L -9AanG02ą7uBkZlVEazY =Qf4'O{:icC_`X\ ͦ 8?I) .ȿ_S_f3 foP뇆s M;#yЄBBW7K x(r-{'h#PG47)46@.4Nm{l7L 9rؐ`I'E  Eu sRM0С usL? 3f:.es!X gƵ_'qi]#@v_Wniz.w"b$1ǿcF,/g8y@K;ci&J"L.Z+^Y?ᥗ^o'O4)?X(B@Vʂ E[eq褶nr3d~JY 0KY ̽aUǷz;MCUƏO[/Cw/MΠ[X]Q.![ lIق`7ĕ OtWs j]'kz jc&w6Ln@;.oo5#~nw}N0hl?ߠ$ofY7/ F͕0wߩaݭQ44YXɧOT;\Ŀ;gTn`,H h^j.yGoovh0B,ܭg*8@zmK#w:eN $|0ofx-y1{491*$i~ŻOLϖwIHk\ $m^jm  uT_#1—B3\|o߰+W1~C`A@tsi&a66Á!]z%h Hݰ=LJxMQ`a,D lT m%p:;>OV^9U4+AF0A!k8GKvw% !@U7"&;‹gM8pd2Cg0U @xH1JJn@.jtt,d]\Bn#Al;y^R&fVtB;Yjw[bX~Gߙ`pniSB`x ˯00ne `ʬ-$6 B/r})ʈצk<ٻjo& St!-t_WN?% _-3!uvZ@sk&@@fO`;O5/?J+5 euXʕ *o3^Qv\\XGp,x:Xj0i;,qBL0b5a&"]Pm ZaqXvpCWO퇶ck%/صG֜וbI{Zu M8FIPu s2NsS@.T@K։V֝F+/à&PN(@gWkjo>nb҂G~0~8Q2\:i4 JwGvvOE0.>LFNk}m!2_Gvu P_pFpq>8*wG:zuL1\>z9nG>e?~]<Pو2Mpg.- -=Hp6eX(cGV5![L+#ڂ_7-RQj}L?8&nK6M-EQݿb͓!eN Co c.`;сgv1pJυ .w:n@[:P;n*DԠR(OG#8rB]^  z=6_\3sEk.q߼\X*ΈF)G16A #+g z/Fةߘ?~w Y:hj2}Oo4`~oiwZ gGnhcb3b̺l 4-b-$ qI@:cAA륷.7`a YS=Etpsaaب_ 0ra0]3hr) Ѐfn<+M9MVJPܴ@.Qt9Fj!ɜCۇ _a1/ya ;/;\\c&amUR#8y=Ů2rْԕڿ?3~%8a<a%C= -GqT [t9(ĝ>trY;:L4tF̭nVD@?SPs'FLy}EZ7I<|䥜|c | *S ]lw(_GCPe_T6x0K*i&N ;~V, _\<˦ʇ-n]|ζuiuO;ƥ=PͨBFR % HQ'nsh^p Ĥton:~oUxh`n:@5( L灩 A ̺|*" (-mnKu,yìGFGA[(3}y 9~sw'effƮ9>@!`L#e[0B055F٦2ŴkEizyl_G =aaKa^>'"ހM·f;dsn6F,  ;?Z=ԧa #05mKyu~m*Wn:@./tDFptC#Ӈ@1ǖÄTϛ#oa 掠#˳86wʉ6NJ\xoa|#T̾N'h|CDJƍ͛رcȀ?2/섺@<5*9ԗ |Z&@څAu"! %@|(1 XХA#|_yb\Cf^$uC¹Zv}|6<ʕpƴFTWFݿ:nLjlڀoN!קoM8 "ۨ_{4VY +xGF<40b tgCAe2o;4r.h_b=>x`8tS={6_EC?C)-H`T&A`0ҒFӼT%}>-PA&$ Q>S#`E=sRףU%+)MkmɇrLɏz0 g\ [:Ű<{VrW9@ڄ+%_v+hV@_O7Ó_#LLq~L, :Ȧο3^0>'Gt I7ܭ p9MCҠRД`p|7^" sC`rZvv[kR_rA{{gΝ 'l@IDATb 7тQ-C`d/|0{mD VD #m / jʂ{ʜTӜa=]' kM/# `,-3,V%-FpXZTP]XF@L]f,.m|K4wXeko~Vm;MXD:_Nr{>_x=<~YM0eߧ8$ ťycM0?o_x8n;Sn T_IEI::@I`̋?C =ul!`D{/_lihtԖB`:2ѭ;|&Lya̩ QCa }7C4#S'(;V.DbHaχ >LmŷD!ttiވLqZx(Ϸ_0qu;Gs//ߞ|KRsϾv4}ZORRCR.Ѩ>94ا^ ֌|aNTÞTJ+o@4+ZL?j_6ʨ_8wTG@E inF,t(k@b$o aԏp7 Y[6ҴPI͍V;2FE) LD9#ϐ14I ~o.>6{]˚E! @X*?a] LOMr&'KjSɿQVkź^e8Z.u4x|6hx?|aDO΋`u΄[Qj@vA VI))8φV4еfOeB ttqHFu#ÀuI?6ag rph(Yw{ O6U;v8)l8|&)20+vzGjٴqPU)n5˜yऋw=<ϺU/2$(!1У%ϙ=7m]#:u|$L8c` 9nd&-2t_ n tvMj1ήW=0 ¯I`;@Mc鴨@:U0- u4_} YwY=r>Ego]N=EdoE"%{!w>~x0XG-a$YOs0?uSy>)y{4e#ƀ) s9[}#zF*4Hظ 52a:pO VcW-B? V6h ggTòhshBg6k]2HZ_7uޤ`tL -ѹ`TP6K }U̴]pSCȡA>ݏJ.). m]`0tpI j#'rm}BT`2@LЄkٙp,? j[ԅGgfƶc*`>~NZ)L.l74dظ > h;iFR g4!=~ߚCY>Ѧ4i39 f1;}S[\ 3Ez (TI0to_%"AH n ?g0NŮ6/e4 wNS5[RB0EfbD#7^.-hyb\_/@~<:[?rH8qx@ _!nL"&ǘB@ >5՘j; ೨Ã7og^˹zm71rMUJѽQgߑg)k L0FZl nYŭЀ{<}' ry\ۧ ̒41Zeڌ46Xzza?7`Q< 7  }ܶw=F̱Epj@[s_k3`P40&M[ i~ڟ ߄T<8̿bzGxƄb)Ӟ;/yꤞ;Ձ@.ʺ;6DۘH_G*1V^EWd`A=.*U%EPs ~U fpp;€i`4?jv0_猠 3o;w&P1_QY OטҀŴ c&YԤ$_yMiDYKNN,tRS0ׅ;r ӡ(0t0 ve|@Czzh$<sgLL`+-Bn TkJgЎ}% D#}s7^$3ID3WVgLll3G]hF)3nixÐ؄q=Ȩ6*w$:YM:qӘ0$!D䙔Xp!]c[rճ]Ny-v@'A[\50|4Ż |uF7$KàD\6'ML<F&?BA [O#3u(LaTPa1iNⴓ^ [ѲmvJnjR Cv~:Os0t Ҏ9fFf0vc0 GG0{c6"{rO@ c$;6nȮ6 Ž *y{1r|?'q}9%n׭E.]2ftq*Y=fû]/hN+_DJyr9:i''0 D,S6k%.\Y*c0|T6[<Vwtѿ?OBMđ?Xd8̘Q6/JLi!@܀-ko#a?0!`U FXk]3qƭm*ҰmGې>Ыnد߹`-R3n&ӊAB&["a@0n:cSa6w0<2 ڭEZ  õL8XB[ɩ,믞 Wn̈́>)y-}qL~G#~I&"@W D͘k--rrû࠙pحL3§P _5a-BJQ@kiT?W#uZ$zQ nDM8c q4ٍD^sMЁQpk\ 6%i3*o_nr73Pz&ykroֳ~ˇˆWFGhD~ gס۞w=OPvPyvw/slnA StxF\*wubRY#ɳ4fC)*`4ъFB@#lhQW˘=V4?#aN@`I݊ kLϨ/\X}:NHCv.h-UÁ!ݦic?y3Q?P-BJ6tώv:v3[7цכĿe,!4UOʛV0RG1P7μF~zx衇=  MgT)+i-xc;իJ3o +:bhXz^Ht+ݞn? FY*x1&:$mK 4kLh"ڹc}^8~B?odm*dkF0|7]/~>B_-MdS\3~2N. 㟕Y^ko'P)Gm;Z4 H_KG1:pM0%+ܿ76W7Y:=!We4`lăn!b!GᢚW #@k4-4i|W!`[m5p᭫bq-8ŀqgn\R8߹]ofeQ'G|o0sg/!K 5G#`lo5Gs@%0-h숺h(%rnvn0{?6RѨIoVf4 ɑ;; OqK 7/Oiߜ8 iI7;5eV33ϠkT7:.l`)jieNm̴;ʯIfԖRݴ$rEXAZhb ܭݞ6=$}e3}K̢N5Np*$pZɦhԃ3.K2 mrxhA. a_.Ԗ\0VOWߖЭLK$ '椑~Y+ s<{Y8MQ.7ΙҧfL8jy??ȡ3! p9lFnADjfJ"MOidM_sU 1{ #GL`9kEZBA@L9fyxMo] ;b0g âsc_Fb6?L9^M̟ g|7;V^aP0Lf!vj'\R=Ӟ߆+laa!OTx饗t#Y18qСC@KpDkݴpj̣˟hPfAxT.Āځ #ЄjK..]*(ivn!5.- pA$@n_0J۹#Jg?G&îE+swiv?}FD)iQ@o^Oot1;`Ù/~;_Ytz| فl8LIµ:®tgABK0[w^^/KKNE|UGbn}ۯ\ OKUosxwu .JI8i`~N<:qNχ񩅸_g9gSabÃ0~K1' 28eÏU1:q~z1j[t4VC}K_R/n;y(>E[Mp@Eb£>~~+|5u?~:1dHpXZ\m;>HɆc"çp" V*^.'##^"T;8q\0 _)7]pA +'Q1|+gO?92>TCRq+fW8X˓aY?ꕚf.d_rso[C=6bl3ojTp(&#{5<ݤV /t^/ !XiKW X.pUY{v0>'L E:= m4*b*)'~'l*H0'N pm$YĈ:Huu~eB:cov4G=)Z6d5%}`^ݓOK6*FurǴN|BE3)psߵߞ> -cd/tA9cWXt0`E>!"[ -A Á>/q`IPO@ȭ[pCP? 6 }8v(_qy1xyã*1&&ҌFifVK`@~^NaJ?  y 1AccCw>u@Ź I9EZT/;^MS5A7EW8bUjR[XԽ30s&^=VX :64.ʽV1PDV2B4̕ZB .* r #i ]E#h.Ou1wi렒7**H+` '!@gZFo_6x/p.ڞ6F)}Lxe\&&ſ_"gML?>VxugFtwaT1l=4Fv}ӟGq!U/FfpwYŏ[ǭ߬^4ߙV{LqvffN^L 00fس!qi'`8q/ . ^6b "&;BI^\|Vv_;)wrX@X(29ba EL讅l1E 34} הxc #>[K=g*ӸH)Ϊ ts$#if{7{Q+s٬g('ާ;7NN๹ jv|i- 9gx Kxl_L?~`׾MXgB=y2)ԁ-$O\`xw?B dYӐϜ0vwlwZw?h,]?LP Q1 V dw&[U4Mb6H~['̰Aɽn'rv$iDn H%@ok4xA XӫmSC0Uj}ǖã'iHPB@QHI׍AWχ@inJ/ⷲHcȳn iQ/?1m|h-^=?9M=ÚB`2%MՏYa򵌟&OI&}e d>-hOnE+f^\wsߵn~1*2`Y{)LT:W¬fr`qγ >V ]G?% YB'[Xsx{|A7.W'GLC^+ ؋Y3㢿/pFㇵrX k#@8ub(NJ/ڬ6& b_:OB^g^|?fD~¡9*;OEa3wc?upOk6\VN,Uy)T𭗯QA1~ lw Lܙ0"gυͨG!};2ު nd¯Q9(C;5 KWv78x%9,$7rRKE?LЌt1&&>6@284U iyw n 5,*YޚX~9-l',vkG}ȊY0g/کi71?~x8G?"aaE:Wf_]Ș>cm fN_U/~F6 &~AeɃǝ2}w?k;'i.y`wͷ~Ƚ_8)cβŭ2?X=.6UPUv~ )5ͼ 3nH8 g SHE@rRA‰6Dl+B@JhmJ@c6w5%w dtR=yD|_mCMm狣?¨Ş)w‰Ki06SЮ_/ܙ*j;𽳷t ~TaL u?>Lޅg.GS|;~z}F'ڍ_-m'f5ww<]=~M/Ѕӧ(`*@na +&%at>8`놸 `h^ @ sڅ4i];<Nz"D97 @ׁ39o_ hO a?SG?t1df˙>hrq,3k`j"Gߢ?S#Z_; lxw-an侞8ejGIB{o'.f~~~E(uݸq3g.˩[i٨k9i@+'?I+톡]v-G724|3FIbP/UN^@'| m+~tU-.χOO8u{nĻug>?1U; Y)zkd38Ca#̿u.CIN2Lz^1tw& cӖ?j]ALpt{9?cĵV?9w;|~~y~N=oMSE9iTFS/ljAtk=}/Vו'Ov} _x}ll"ƾ(/zSih 70@\򠼻@q#:[ΐt}FX.:}N .?  6DضfJX>9Nߜ \\Рà 9#i.W΄Y.aޜ~C?|pa-df 5dQqpI`АMQ[SəRz{6ysH@T m;_+o3}g}ȃ6iߦ]s#N#f~K=CZiz鷻^fƦ鷿g8_z~V,dq So{_E1mG'`0}:ȋ$|nS<:=P/LfŏpYW*^o'nTޝ;0Ty "Sؑ ֯\pHWp^ 7yUpР ô<ehj8ChA<%LO•[s)ٳ7MWkLC]70|Kgߤ&O߁j BC>O;榞~7bI˖^z_=7㶻aяZUc@sÆу4Gl# Ǐ67m{C֝GB6?R\N T cӎ{JyiJgg{;ᑃaOݙGc 3sAv'P=njwNtI<}wvF7<,!, bZFCS`Er^=\pH4 3- ~m;rVI?3?}Q븵H mUOqοߨܵrFnme-PsO-D'ظ {JyGE+s =tOxdvՑ\jozFpZ9).g Wgu4:Bǎf?ѲUfY%\,m܊n,i_ w֟Y}+@Kܡ~@1bG{C_p&k<<4=?*G^ncǹZz깓^eoO56njv7011Oj|3,Xw/,,vw*Oe/~UPbrEKկ~5n  w i~>|HtΖ )M#I ī+N 㦄g+:2uފtӺteI,V DVw뙗ߥBxpSJK#\`ޟ:?A y1o̿2ΌIHx]|p(< A@לּ0 @ǽL?/m|q%꼆9]55vȠ hYLi4Ȯ|YOxwf7 Ǚ )wsۍy=RύLҨ?u#-jKp|;qc, ؗۿ/8weq TקX};O>=E&!JA -Z4^FÃ>h:<ޡ۴.MH0X\mL/e"μ=^jnqҴOQcwk#K;t6{iQ ͻ{xq=upW?LMN/;%-gAO}|;7 @gS[&@, !HxԖh5h3Z)#<B033S!pN0N0t:i#4C㛇w N_y cẦo齦~[Þ~Vij䖎QO)3V$L9~o8St=4ȝ]hZoRN X-4}}P4zF/ ~7ƿY?^NSFnxlTkS0#wLº?6ån^k&7 ;qݝ4=]ўS[Ÿ -s=߸qI"ܟJ+̟#I!0tD^[WwŒ:2F܀qbxPQ^ B9A& d#bJIxn!Ic{9Hpi K8#x<O7LNy7Sv:y|@a$ |Py Yp2ܑjh-1'ɴC%K;vYrle60̃f3%𦝀;y؞~M+/.)ol$\wƄiGNsӭQ` Dޑ6ui(n7=ef OG!wuy5Qtƶ; }mA?wDH Q&оXCxީ'7?5">wt Q!,pHx)L pa@6¡p>i:IZ[ )/e-a: /&G^v%!N9&^o@U;CN=/(ճxf(sUwǸ1B_w)f; |i;Ak# NxcMIO<}yXOSFi[O:{/Q>pw yu O_&n% ģtxK|MzҤbfVVo||#C>VGiX` %e\LyH‚W{x2Pp?/ K ߊ+SN-}C{o.^UTE3k+__ݓ=fL' /TΔ`bh0hҮ ' %!1}s @%/ Nl(6"I8D ? A0щ A ,b7qDxBMsp"|SZB4 V]kpoEQ CuNdd8Qo1\q( H 0AA֖͑hwЀp/[ s7ñƿ> 9lyhHp/ڒv}0;qy!σ7}>>Sgģ#_'(}:7#c(}ä9[Iy8_;xEoCY=]$tyȇ4a)Gunġ:e}M)7aq# ڈ2GԐmok>[GYyܳώo0Z bsQTH##?ACzǥc.\w攌8džCmu2_NӀN 4a#,8@ a0@ w`DX 8&HF~0Z!^N|H?!qS씏psNXyx'#+Bho0teѡFCao8JznQ՘w=wFoeן+>8,G# ̀nE?{60p޽/;HvqKX}hgڐoϗ~F\nۖoڟz",S{:IxOp|Mnl(3PRvps"ŝ{Ό;CCM‚ ,/y0\^灅1v?wæ7n!fpQ?zy7ڗyxۧ/ݎ6nwٙ66wx'0>>ѧ;p'<@Z`lq'-’mH]䇁uaN>.8X쇼x0ԇr8<>܏p4$_ww6e>. S/򧞄'xٰݐ?e#=S^NؐGj'a=ݨyQ|#em^9/kvܹ*5p0y?2 d\?ߋfoj[NH'O}*hnTrA<SqSF i[Z& ȍyѝPxTǑw¸swO"A`tAN wt1|c(S[6sܢ%?sXF R#efE{_?]#wޙ)-x1ZxLt}2<~HQ4d} ;9pXp1mMa4qa~ġO!vjۙ3x;t f77#eKϸQ! x?>#MXq~S=*xAx<n$?r;^wa{ڤ ˴ q)y:oFCp~c ._xO~*Y(36__??kMS&o &Z4# Ng Q\?~tH#Sd[F4Κ@94ML -Ƒ}= D 7 14Jta,`{#$XWC&iy] jqk$.~- ﯳߺ:; wt^!cna2~3q#XCavp'L~à #mD ?/}ot#-9aCHܼumA:FFz뗸 Gk 43OD \:p^/-Oï C ?;ߨH(%HAx ߵÅ<\Kqx;t7 6,Kpw ^fOpࡰRfԖԇ+z-Ԃ?/`ц3 8̘>x00t?K_?mT #SO%}ɔ//?u=)3&hF:"yT.[K]v :xF$Y5姃ӱ!tnHeōlj&Q TNlb^oǵf̛ 5Ĝ _  >F0>^.'8η,BPnq3Q|#S^LKΗ `nT׼ _~ڛcvߐNc鈴mDl`F[;F\?h|ڂktҡ?i`[33K%k~_,ƭnT]P ]H ,Rn)YZ7ʵcmQ}F؀34J9duCwVU^6 @,// vѮilbUW74 [HHtQHLPX` ,Q,$!4!/_>wG9I/߻'ƹ}gV/sʒx\.`{\

^R܃aSͥx9TՑcC5ĝEHӒʸM8T<'@thF%tW9'OhN T]vݢ_6r\=J{ I#w*.ʞӯJ~1%.x(3܁3 |o~ZC C[Y 7.aZ-Q/OF0JxGMYA:xƬ^M㤎iO^r4QiaHzĶn%ˇMbqa˃[ "E|I+i)- e}"Pʇ>E?$5<?0Ŷ;Z%4 8ʳ @w=x:p?8 Ǟ~1sL7'?ϪpVr@K#-^B2MIوi5(څSM0J[˓֍B:87m"\}:SL*醹0@H :^ؚ #\FIQg~ꔶr8d90uQ!Jt6>1R:9xwCw73"dvּ24bӇpP: )D\fw h~)wALC%D Jx|s b͈'fǏi_420_D&?a@7!888v1gꜶ<3v {MRO}:?x0L3P0:ǦN%Y?} LNLJQ%F2e[)䁼LLu TF6@hSJS DXS%cU-.oڝB$}rBB#9 4;nkX̨IV]Q+X RQ׵ᠫt!-FdޠTV\Ͻ5Tv jCkq--i\-0!!仮ի她dxFג!UurHǨ.,HLk:YP:۾!Z\T|zvFHa+_VfB0!Jt:^iLɹ%1m;VPPbl$e;` Kک+ֲRGaUưLJHm.yd]O' dv,K[Q>>F tJɂ>)i z JҜZ#$sɏI[SVɬ6CVIxh(\БAV$0(a:iN\ᗪJNg<9jPrNUwڤ[ gB_r4qt|JH]J+/QpaILf+7$l,KN1\s,L"aWjj:C" }EQ /O(~1}S­TZ`y;~z&/hB9M:<}>b\I>2Y@k{5ک<]N4С/AC*pZe]V?!MYE V$ۣ4 Y:co5ﻯ^,ß_}SjڟLP|٪hD<[C]0= ~mExY3;YIHi0jWɒtrͻKb 舺D!lY#/ Ku4i \*h8A0gb+ID^fġ}"_n?V_H+d^$4YM*@@ku~],1#08ꨤyJ}TĠ5jxf5QH80E7CIYO$ h&Q@4RAy(!dn@rd4e(j7Gi4*T[րJ+BQ_rAbQIlTA?JQdX2ZgQ~Cb0چUA{:ݾ(t4+ axL{GBr[`oQBڥDcBJW6(/I_>]YD&1n(#.!8(}J OAiTC X tE1I# !ʆ>N~+&v(CJS]X7ȴb%1̚ͽ s<2hh0яM0"VyIw:h4Յ^š [phq.7nJ315 CLkguigN.-80Yp=q│{zr'FƇu#OXg:!0,Q_ThDPCkOYMNvQ:}\*r- Lb*6J l?ۧ ^8["C+Bnf_˘t4-6._i L`mHn0ȄYg2m2=sFH߿G-I0šLM3XzȧيC6G˻+*˷K'äg @mjiY)⿓~ꧬ]h*y' O?T/{ޏhMSjYGߍS<Ĩ ̟)]w)Vfh ۍ\&Z\C(B f8`Rl:2^Wd88eac <|݁ ~0" |ꪒ}S:Ek ᝐE#\QVBF\Py<\2:\? Xѷ8<iN&L'e楙{C`"qڦ?&mF2:i̳bw! pr bn᎙[+dIx ٵ 0 4iC1f)4p=scyZ(J}.°F}ZG0qY:q[aI|I #z[ՔN('> v/(4>&2 S/,k?\}U| &'yV#%G oUiH`rT0}ߙ?GC_]t_ek(0,\ٔQBP(մ&Myݛ–رEL<,KdXq DD3:UX8 #i|FrJu(}-P`v8b]laXuc/* 8E06sxyo~b@?C8q|´{Mvx\XX3uށ xZDb<˩>ထ͢6>>1[1/ÆC>#͂%?Ny?iaOp/i#89ud^h輁ҷ{;XIZ&1!1Wͦ/˜ŲOear @Gqlyǭ#d,eV_o}vT!$,&:JzO1g"UVVĴ'U'_QCK?3k~~r\DROLPB\yP3mKF xo'-)KXGq&SM 1@ j _  !|`q8?|w~w axWA_owW/@|qw{'6i0[x(Ce!6>%=\s5UW]eibҏσ?y0pqx iapw~4?ǰC`9Ҝ> y,iI^Tf??, Eq&[[v :Ѱݛ{Gv],6gwb:G#;Ϣ?@x=E }*ё}1wl[ìk;KYgJBf~zusc]#ϸ]6JѦw-I~ϣ䷒ hE*kV՝m0\ys:xTǭlb9cBrҐ4aݹ'λ@ Tt:#Zqg g\{y7ͽ[6lfob;#߁qwǑ.v'^oOlp2' Cx=v??=kH2g+*~Ffg*("p4'drA IZQ 뼂o{+i9?"Q?͒4_U똵5E#Mw<#l^Ou 7l2wqx'\sM)Lg{1__"[9uר55_E )A,!4|%`QUʪ.IH97#L=fcAgln{n;nv& !t[6J9^nؽFoKq:ͨ^77p/?G2-` 0[ҵ?s>G5#u0>;x)wҶWUIC__'wyg?'cN5@Oh3́]2ZzX7oճb3dYI">R d B3 ļǂR~Zbx`b8wwm(,l,X~;,lnw懛?ziix7;1s'>at@/-/~_C4ϵ~_ߙMf._g\Xth]Q%7ShtX@jV4_xnܳ.[}^H+✛ "U˺ZxzgwQ=YJӋ=&bkۯ}&~o{mqx[^2{'v˾{\{yˎ:LHQ&d|JUa^:я}?16>lkz?2>%EgCֽ0y0Lo {C!@wob;p86Yj?V,%?NK2Zr]i6k`؟ ?6mwq7ono1L7,!nҍl[Y腻aۙwK^(T/OǠoQ?ɵG=z?7 G =Bjgn ܰ=Db7aM:i7±p l=P?04ć[ԁm*ke\~'ӷݸ\&n'v2yڽ3@vs\? ݩk1旆)8\wx&/ l-9}7!@(~b&<PR?g/0_9ݏqp/r߫Ut,kW~sW4߾}ǝ6dE]DdӐ e; D'!h!0F]_CHV,;`R=eg707Ǚ=.7`\ݙ'nYӻ ݿw~{q߳a0RwsK ^ytxiNoH0j;ѵq2WY0~4$GZs?{י?IaMX]N6xы^*#jZbߙkK:̆¸N,Z٠Яۭ cv"SyaьN8[_!]Z+'g3Nngr`i .ϩob7guPq{\|nݍci{7O<8: 6awǁ_n6~8nx ;~s#i6 `FҗsMB~>j\ l4 ϯe!63~-%k _T=y[; spřxuvOާQdkttfacH+bN,&?!.!8g#A eJ4<p˓_6n'1vw pKbCZ ?(X‚UpaůT*%'ij؋l臦86CTF:,죭 [޽(c eD;q4 ^_|u@'ehG]l ph>ܨ?C~nx ;~s_eAzWGsٯ~ɑ#k_ncʫ_C5ڤ- 뭷6gʞ4fDFQۉA²44t=% /c: 0%N1D4b|1#q' BP1,~tbIx( NlҁnAiv<<j0!qs,L8|(Hri#-L T$Hb'՞/_$:yb6:(YYź̈mL)ʛAP.2Mb?u76ʚd8+vO]FG@{x|!>δ;}叼mGz'}^x#~wÎ},~Fcv/ k?V^z`>wDRhx-q믿% v -7K zq9x#tbX& T  ^,  s@pBH(!Z݅`sFN6\D >%=^v0j1Nx!N-B=ptolp4@;~q? i$͔xRYr2:RJ<{oF E}{t LdDڞai}T2<]>(Cʅrxw֦ig ,8/ uBǍ6D|MAapaIu 'Nٳg 7p& Ҧ׻aL?C3v rݥߚ.cb{ƕ'&KYzi7QFؔ1ze\<.7mڠǍ?x܀Y0' ^wcD+ '{N.# цhab_? aǏ>vdυ?'Y2?2Z/,=߼Ye>:(OY#u?b?Ҥ @[91dU}UΩ"w)m<s)M+M%uܩ+;e[\ʴ .:㦾+48pw=oGVyCsw!@D{ %2^@tg77w{ aǏ>IIݷk?[GhӑHAu@遇|7[\绨<9q??M9#K#ٍ:yK ^V;ISqUkG1A = t,5D 6X!^:~Np# NpOpi:i# v;vʁ'kPnN\}K S<ꔜ_%\244xy]g|6p}0x~te߉ݰl$%uVyZo/=7~fiES 'ڟJ;_siKf!ɡveQ1B@adب$!Rh19QpnĻVpNL;QҏJt# `Cx']в8Czq?ϋ7FqhuB59%'WJ z"?<wGOiɩ\a^_R/lM `wpu Q/ L_pC qwoO||cbw15Wُ/}e}{ě:}JM ՛?t0Kmk Qw+絥*\U2ϔ;޲G#yw%-3u8򨿫/ߗi zelR'{}oTl㝧„ǫ@5?O?4x< av3\6/u7ч]#U?gοa̿M8~q̟ڿ+Wy_&v2w5J`v 09SUaPA3eLSM X #9p`[ZEpga6IZ҉\*.C\I/b7Nmf~< 8=qU##aG\2˪xe-9ߟw@>)lr 0xG:030u*9gZ]0S@jesߵh  兊 8?F.#$W|0g5N}OBɤb8}ؾ. [ g9I75_{'N61P~twv6(eS!ܯwp Yp3jmR(w=J&D>D FgT 3@ոM !"3ʅ42cp LY=$?4m2F9+ *|C%@T*V.NȢǡdӹsɹA>(b ~T̪\6ʙd驯'ˋ:o/rw5@R%?t2b0eeLP0l? |zIG*mQAȇ!& jYÇbL[U:C-~\.ÂFFjFh􍹹ɓFZf&'&Ό@x~6!h'L'o x1,i:WG7rIwS?Q9a >.=QN)fʩ')_\6F4ho!p.H̀}釤|L@4tHJEjk: [Lb0GSi4k %ity͜*& i1TQ|Z-I3W9MMkg Hz",+jCY]:q㿴"Jb0vEjJʴsI8U~ւ=;tXfKgqMRYQ6C~ZWYRJZ]Y2Q h)8?Ԓ wW&9C0N ^hfW0MgQG+_16Fg7P/s?+# IMV1\XyuEg8ӆ؀GxhUFJLeV(po2jQZ^g7 Lo1\W Fz #_ƅZ#0a1&ZC8y_\U1(ÊV4<,-k_r'~@Zt6<'!!":, &QFᇼ/HhpZHŘ`G2U\JIC *BftEq1'{IE3珰ye{P'礮Z64$ZV&'uSI\SY%5ȚK0#TꫨwvbR$c-ؒ˪"$+uH*{Kh_O蔿E1aRZGI FUy%mExnhgڗGE@ObT x ;~He'u[ 8qplM+0#$B>>=q~? T#,GS|nr`eJä\ső襜I9C0tN:PKDtl`jή~88zp=㌺pqQB=ns:^ZB%g3fW%K Sa_ve`.A YZ/S'g/$hZ ?sErznE i4oit Q*M1mWS.A5O;nGsP9SֱY] lR!0 g2w m+|#@40Cora1c=R+ ߁}:Q@ heCrzzbwÎ"'f}?##7*m^QbH< h33`r` Z$;&f&PQ fB1t~Ac4 ~B@8m$*E!7w6a?v8 pLmq\#dߞ  0i F6!|!"f @1QLj85~~|I_;!v'KɃzY0H*Qˆ4{{SZ8vPWLIJ=hEi<2u0GlcdF֠خI*0k "(IB A໸=,& bGڰSVjtpyp089 vsw/mq?zv6pYnf8?$C{ Y$ ّwS+ ߜgk>e@QO bub v10d>}~XaMj^1)ҫ̷}f,MpP-uFqT0 }bw'LJĢNj{QE%1%-{&saЏ$-6@)2)& M -6'>rpQxs c [DtB[症] ;~o5.hku>xu{:T?>gc`?g==s;Hqs%$}sĪ pN k_9Vٷ_R毕EQrG߰`p1W&?>,j|iDϦ>"a`8a雝]lynHO֬#=#,T$[}ҝ5qEn-}{;C0>rt?׿] _-̎ssO&TH!aEwߝ_+r ~D=뒟ٟ5Gcӵ ]  ÅgDP t\?*0 !S[+uY?s wg51}4a-@)ogˉ8NB}y=y!{UWDÉŘ}ַeGf篓k uV5Y;̿DTVeq+;oH{/6 jڛNoєU)e9vHi4=6@.@e Nvx˺gc8,0}w Is~N L+lݰnSG̟uo'ft=<׼b.#9o攬OA8쳟l=j*SF8Zx HL6d毓 h :9"ȿ;K@e gS_6#+%';#s_i`W\=\ud8Ԭ:ׅC|[Bab<񻵕(L GaHiepolwÎ"Hݷڡufm4.=׾ss4q濨t!?\y=Sq0F,i~KɃOXi;<7i83c6&<p K K7EjN ,y,97@.ynOq3`=?o,v?[? [.$M={@ቧ3o0b_qݙœb5!IۖӺ'c +?y!)ZVjW^Yҗݬɂƙ?W|::wo.B:$\{vs>#ltAƆ/7)TVU֎'H}:&sǤ 6 n5 1oQ}yLt}B? Tn9WۘvSߩü/4w]\gaJ_8-RETg D9ЦK@kzPno|69Ľv AdՆՍ}XEE'SC~M}QgƏ+LH`TC'0NT֋ZQ{Mҳ^:6I[+ [r^A?Tr6-Œnkԋ"0\WמSd,/%#úY[iyNl1 Ii+!ڨ bzձ1H'}m1x¹aVO.k!3~awq¥q}a㗹`EmBK+}bxۆGtsC̟ws柭 }jIQ6/}i9scO;5!$ D+,i+`}eB{0bEG6ҏJ7;el{xʙ3)sV eAyɇm_m5'~[?m+S(Og'g* @(/9rBK"<1Vf .,F8RgbDw jh"µ2B[.M0Ԕqns2jHj:[l_naLU_xr" CEMm#b-a(E;~f+Ml?[jqJ'L )Ia!Z>Im2O+ XP;ȇ7ڐ0~ -!=~Zqe62X2/5/$=[o훿%DHhb?#(OrW`  Ƴ;30ؚ a<캶+`.u^B' SW'\-Q"H6;1$I'cVGjtR?[t/s0q;-X,2Q?S#j0N;X65ds_߶ikeDÚ~S7?@ TYSr: C~<>KHS̿46 1dLт[n;>**WYǨWR-o>*jrOe-ڹՙZd zaNn^6^y`%#?73cK~cdtĶ\Nh/o/.VA#ɲ|1T)A VÇ >l U9€VY(/$jӰz}ʟ:pA k:6K5ƚ)CSwܾLpufOC!#Tbh3Z@{D>5u =m͚;Bp?>KoU{~Jq5wİYLAjjpϿ|;>s?x'e.?(M6?WQx@JrWU*n,dM75~ȟ1h^y#o`퓶1*°( !A`o*hwvn^a&Qs[Fũ&T `llFEۣ:A+0BJ=mFNڀCW=)&xaքMn9/XEP5% LXن 7S2oy3(oo}#ԧ?L ȟ<6}67rٮ0&Gd ZF>&;0@FJC#0Q2b!59LQ8dxqR=Ax1cJ̜v:$+Ý@,#&/V@yGc Dy8ۼFu0|yZH~1  FBp0M:.fQn\Uho`ޮUB48}jK03 ZGg!vH~Dq uÇ1P0'hlm[!08v%W}J7xb6x[aڮ16U{E47?O+KJ/G;CCoir< +A09Yvb!vq@.}h8A Q<<8 ؄G-w- 2/KPzlgD^Lz}ėnLDY@m qӁ-7Ý1'6fMnoh4c*Baz H>L`;8J+ "m6pn pe$O{2#&@I1S0hB I7 =ۗavo҃Pm4W´p[eajISwU}a赯}6eg&mSR`.|]3f@ﾴ_8)@rnHΌjDYT'3FQЈl By'h0T0{lqZxB#X#%~M6!ΌPߢ%G c& s180 L|C8Ch 3K\^+Y⒣4i\å33 !SYiUu# i%h; m+w-%=aeFGN /G -ÌCX >÷5+ښ,-32_imԏ3M|+a>g sa~?Yf:3P8o^(9ڍ 239X2d&%PFR- &6AaDkLCute4z2 U57OlBma\0wYjU;jVTGG?EGNoAB/]V*Owࢁ1yȦa!4P0x`ZC0'^m6[}ć8L`#7ӞF GD fhՎݴ4bī05+Mi=$ıru׿/H#v_7Oާ\3 .K{ b18Q^< ˨gͨX@p 4WUWjl[mA`abuQ@k4 f@: ~T|Yb>Fj%!V*[EOKpڎNaʮmI6Z".bmA𦡒?Τ2mpΖࠪ|N*DC}-ûP.q9mV6 7- lk04 ҢԮ{իn{.הg.ė|?%U3 ܎txNr"BCb:9*As.iw5(NtD=p(,8 SEJ͘M0Ylx܌CjoJH@<3;c '&'e `,?"-b8{DuA:[;ʒi[g4UܨKbDaL qc'GmpW:|hy:][#E-f*nr}*7WaZ(=LL_it?Ҋ- +^g̟9̟MG XÐBQ?wE|IأYJ/":*YC"8=qB4'ZۤpԶBh8pxj/ d1V.}ݐyi c΄ڟ?[P Ȩ;Fj!8=]ؘ;~_`&jgn \O0@F-vIaےάF- (}zzZ-ጉɩ=ɼ3gm}[ %m!:g<+iSADďP; m6Oz'&&Mxh(oK9&yM;) kvJK MHF ſrСv3H>dsNӒ}eG>ӸڟmA#sF/ȗ\D221柆CFIT'Խ # A35P9팕"Fi1jz<QxLhaڨYFg#a!nvu.<,7DQc$855i mlearq8{IKItxè-NY7N9mR`\$6n`0/`.*BDЦH0dO;F>F&!J*3Qro5dK %T0e{RX 1;̕& @7b5K71SH*t+)G)EE\wCD8Ҳ4r`: H#.``hdž\MĹ<_AqLyP+KЗ h'](?}W 4 )Y:۽xWuO"1wi-Fh qn&QЃQD|k:}55 \w wibs/2CW1\$P )-ڗsz-"UTޅ41 ̡ul)k!־$Y ,uUL.BGh6m._1HZLꎂE=x`꽩6Yfz2\na\J ;h7 &ޜB?1ѣGKַ~_9shQM4.*|?NCBmnem5W@.F }j^$mBj Ԟpa?VOc}㊁;=_79#n\mkX\>zb_KęjvP&4 1ckQ]1BXKo |>ipJAceFޙ2@(=ɡ v daB)=2ʧ &_ꪫ<_4t3Xv#$?%dNyGP<9Wa\&|1ɇ>|S2Ɖ0+%ins*0>x[tEo&XRA8\\6x@2B5g1$ aZSG0<=Hsv Pn4]Fnƚ> Xe{CO% h@}OE# b>.|`/W w>}nZ&K`6SڰV1܄IݙvNd?F2ԥe'?}nM 7GGVO%C9_ڰȎvJǏOs:Ѵ>{(`n@Ƶo..h1(Y 8sϿ!HCy&ʳ7M-P g=B;E7kg"=MuRa33c2#i!Z^{ ~0I;қ7@mpiR)ڿ>_k'Z< %(qTkiz,loOt\S0p:7uf&l1mLdRaOxh휅aKQu6`o0ca"ɔPX Qvsbowڤ7Hv&|LVZX780J( L^~[̿+IF^p'o|- Lv}[Z+3 W Z_Rɭ~-oym0 W1G=b6ɝwi1SNK /U3g%1|: B: 3ן7Fdk7e=w;EZ&%FW}!soճ^LPi671{Ǧmoΐ-NcW7+zw<؞XKbVh [ZC`aIv?u1δќ5m_s<|?0'_'㎦. w41^֖/\b.0=}CjF@ |E" fAO-gCv$Jڭ5i٭&ӫ-{Re|>?l-(>kCƶ1 bAl=qá Ϲw=_~׻X;bnsV c["&v&!hJsE3JǠ/ja  L hNB<Km7J@_*rvPM(űbx=M¨Ym\̨s6㌱<~[:F&[Q@9XN64i 5ooEw]{Kj;/`ڟ̟A ̟}aL0mI^>xrs@S8|;p !kma4E߃ ~F8 iy>ޤqi}(3_w7&u+.L􊽑:#n:?N@~^)q7>qϢ`ܖM3I:%P501Ծ\(5m~2,aΟh#|_ZM~%LC'9 pBLDx<+#*FP#ZU}k Af58XQ+ QQ\knR31j~Թ{+@kB uІo!>^`!ɏ85 ?~Czf<5=0d^;mv5woXG#YtAq\.򕯼}ߙ?jW;gԏ4mVlq5IDATWs毒͆J 6T\;6d^{%&ZKv(2ZFP3v=MOO[bmjK@g%hu@1c`\j/6C Θ+t˂a*8hRnr\rZ֍\[T0EfL_~nۂ9 {Y@V>=C0…JE[yl%.cwpf  g Ёt?Bv. #Ctӧg[xW%̞S{b?V3.W%EML4ψnj^}նi!dn%@.D:%F#S9I=cX=[.Z5q+BBl2Ri?;觎.ڽc]FTdQ>}!a6gIc aȻd[MZ\' 0Jj96RJN&kaFZ0Z3goS"Z+ۥ>9?7h P"v0B1F:9ƈ d|@e; V~Yos|txn\VDvKVS3 ʇhdTUI5;q8U-ٓ.yFJ)j2;7<|2+7-+ZE#E ` PGꔚ;Ɏ*߬z~4Жw7 o| 56ǃd  >=`f5c4FȌ5BFrzrsɊʬʪvuWylj7q(Т~]2X84e'?+YtΣE*Riݷ.mPz{Ќ>rS^TPuFi#KjqElvYGpx{}8%5zL/)q(ˆ"xi)cFf^ #uW=}%)e/r߫r*_K-tYW ـ E<(>ԝzku@Є)WK49 PU8 !X>} [ڊd r,]ah8m-Oy sSAASƞ]3e#]698eJ-nַӇ*VeՄxAI5>MMOeS5y<t6)r^*Z:uwVn 1#*NT(ϼF#' Cff=]h>%Ep0&G ]XZ`zاpx7+/R` 6-DZK1q)A<=Epx-1e϶u&-Cy~#A"?Y;Lg(}(!-q!}?F^Wh/#RR ±௿7i_m-'9s計WoH[>-5s`QBOHyWHd;$yHنD23ٞ2mZaŊïȐ$yS2PmIBȁۡMOtKaHzf(]lBX`!)dsN+쿀PfUx02˶<>C܂"=p,x\O@OpӧK(J.8"BXE2ܹ[WEaX.AB1d>Ad:5pFJIleV$4,:7hh fGe ܡVܼ</̴~S®~ȏOg*C| 2`! uf vrkEcXn rΝs _A)8{5mmـ<ʧ(tΊsvrMUfHXX͖(Gq ox3#/XFݡ/9((Ng`i4:}ڼ.r+/wФЂ'Xh&߯MF_3~*og=?#L=& ;<:=±q+\a`I9^u 1+ivȊD;(e,>'`߶M r@e `E|2E"0K/,I o);yz\?ZgAGIcJ½^]. PFGS?Q~ő7fg$oC@+xPMYc;E2k_A H-V3.k 1ϼ-gLY'8&BhQh [-Z]@@/{@x;Z }6Gغ @XUU d,V>u1|:H{OYPH W Z-Rgp=Np!e-s,ܣP~ 3k+V@ J}\$EZ^F# 0NHSN#4r0AG:`qgV9)k3y@:X3 |i4E~B~ۀS&,rL^̵$PGvs*CsوH.sO)n8 *XAK( ]V%LX4m8БYBroX.uNa9H@3#8X sN&LKt>];' c-:ʀ> ,DӖ6Z!jEeHfhX[bKHucNɗc?7H^p<$eɇzB@"-u΀>vI>ř}W@0`T5 8ټ<|.e(OrO)ZIa hC{Pӷ{'-t_[`%?墼s[{mݬ}Qֺu]gϜ:ų{|u>r'羣硪gcX嶝 7ɁP 2 E2g*@ A@4^[l<9#@ ضfў(#I< +!P! Yk^u%Av@k$7+emx5h@QXcƃ᳁@9A\ޒ͂x(!~nӭ zPUP ˮE\aDPgځʞHKhWg6/Zs O ݴ3Yvw>+?>v!2`pЮ(L϶>8_{?-J7( |_}?,1#r aG1^Ezg~kf ?}#;x)Uvm1!]K#`J`Vٳ pYnHCBs[8¼^Xxo* Dg0%=2 Frբs&3KP{VoИH-V Ȣ?رmG^^🼰N:m{rv "3P>/QJNHعS{+(+PĜ_ Sy>T\\^W6@Fsh喷 PrԔh,xV2T˼NwŅ;rPNLzhExɯQNNjL|#e+Esc4%&hPwxEaZqMHOy[6a?\E{R0ge(y:rA{ڢPF)tF |D!eqv[](#6Gݯ?p6*8w_o?V?_T-JQf࿠4*Mm٥́PZp|m} _N8-Cp` >SY]\.Z6aU `ʠ.;mudY\,2-ؔ 4;1=X־`jnZYK;5!X9k(+Ŝ7FXJ,Akrnh:cw<(Cњ{_n [e~(ĬVW{s##`sF}yn\v>ƢJYY%\HOV41]-E+;=4)|bM^LB&A)93gG- 7!pҎ2ۭzg#ssjr6xcN)G QR &s *J:h~*[UN-rњ K3vN<4¹QmpnFufzo>o53uei)vCꥶRV$kWŴ]'gmtԎ<\&xok'Kθ灍Ebϻ18-)buSTNx)ҙ,-[]W9fԋk,A- S!el 3_#iU)WO8oYG]@)^է$M~b_ p 6،`)4WZ\Y+:$w*:J=; %@\VDX_X$ֲځDؽaБPT^SW$bzЦq ME|{.)r4Ux|,ay8ELx @KGmBX^9ۿvq`X6 ɵ|ݲ 8YF($jb#(V$YhSKZO{~\[ލa'?W ?E4X:;Qһy-x鷿/g-0,,~R*m=/(RN@(-X ًmgo^-Eo$$Ox\kaR%0@ ѥ~r4ާ K]U!IGT ǰes0C]6VN!VJyuO셾;3(uRӇyG7Fa߮0k+J<8g,cǎZ (na+^+gEk7gzB~G>_5h S??JM++ v\PneKfHdz͸HROPiz`4p%b-IcϮxx (.q_]~ŁT|Lws]8ϑPx5(e-2C΋>:t?|)lscMEx|Rt H@XX!TQqA3~7lRT@]nޭ譔W^;f%M?/˟f N˯}mGO|SOԦB,2ϰ?šp5Bhy !8c~vzZj8kuW$H,,U>%g=`\ozeZBFVƟuKܧ y{1HڊFuw_ާ]-G4}0}? @7H/Yf!8c\#qV@ol_:!y՝h[]H]. .=5{g}oJ?tG㈇Gzv/˾KR麷rw}{QiI7OWa{@(lBx,I`YV~Sm%"@T/A(+1.j̟ZDBh i |PSU>Sշ-Ǿ_/xOWǜҨqyp ŦN\S/z25YyW[1Qv&!Ɂ֫K1^z^U&}έ"槮dׅ/VnOiv|s]~Ōpr:=Q/$Pذ/"r ?CAE뚔mm'qTFI<g-?,\uUڡG_;~HsCn]* @ iEj|fs.l"sҐ+5dtWJ T…2a7zEm?MT^1yn:Qo:kS(s=?.?r0р  (B?sXRK[EȥF\\??XcH?ԇH]jm)yיgltܳYR%˦뮋r~O)̲z<' >WyϼviK/4}O(4 wB?/s>䟂?2*B> w)q`(&.9[;910$R7ǵ;us\U"E `M@K{@Yi\W/Oφ:.*,{h;vޞ}Lo?}gCCvS_e}yV/js?Ge75~.%lz@M{ id1ãW%T8pEÅh*%տ!"ZPB4 R+ïG?ǎ},U:XُVr,@6o6UPGyl+lJ@UqeͧRe O}{^!Qg( t~9\+a^oΧ m7h[T]h_>yȐ00Ct!uʤ< * U8CuA-7 \FْY?J#GT??D;~15ܥǁM`-KZ6΍us=l@GOq*lquZ8~}Jes;'|@׀Q ~|}Syp Y,#']r,g~='?ICyCQvma_?g?@_@4̽^Ka`ngmGL>9\wMQ2]|']ǚ #\ \t#!ibGu-FЃܳ`? SO)mlnYǽ@FgWxgog(xS ~d LpKN&`trg:? wPaD#* V吏9לCȬ>b)qڜش :&pB@b@ށ(u}A`4=(&ʄ!}0z"⾾>P xl5)Kc_jO:ՇmsN8[O\ ֏)C: } 􄥊ɻ7ymÁwgoF[ Lؔ#htVx{cm?66| ޫ.(|0fo:g¼q쵾,z*ha~?D?, Y9Gh4z?g>S!>-]GR58ίqA`׀=N> EXw}w:s، F'f*o.?\ PǮz"@2n~\7:8t45`/68޹ovue󚟏~/8MɁMtl4cǎeЇJǏ;w X#'ʀ7z3po/S5?_y]χ :tA˟^fD5.7Ҍ:89;siSп[{믿J2 @ڨ)pΝ=P'^|4z6U,@?8tMonv?hԳ3#qpʁ-ChSOe]v)7J|xٳg3}=4s|׮]M+(}wQ⫿Yv7fw6w:X8}/X?Ty*R#oxx8{gM(5ъcXG߻wow˧C}h>vEVUqC xVvVi?8h΁AC~6סÅpzlyٱaA98h΁(iuΉ8s &|i&LD328s`5}\בrr l .зD3G%7lpD@p 8و#@p 86l#@p 8l4B@p 8`Y@p`9 F@ @(28́P6"@p 8lBG@p 8h-@p`8 0= Fs}&WIENDB`icnV coq-8.20.0/ide/coqide/MacOS/coqide.icns000066400000000000000000011757501466560755400175160ustar00rootroot00000000000000icnsTOC `ic08pzic10Jic13pzic09ic07>xil32l8mkic11is32s8mkic14ic08pzPNG  IHDR\rf AiCCPICC ProfileH wTSϽ7" %z ;HQIP&vDF)VdTG"cE b PQDE݌k 5ޚYg}׺PtX4X\XffGD=HƳ.d,P&s"7C$ E6<~&S2)212 "įl+ɘ&Y4Pޚ%ᣌ\%g|eTI(L0_&l2E9r9hxgIbטifSb1+MxL 0oE%YmhYh~S=zU&ϞAYl/$ZUm@O ޜl^ ' lsk.+7oʿ9V;?#I3eE妧KD d9i,UQ h A1vjpԁzN6p\W p G@ K0ށiABZyCAP8C@&*CP=#t] 4}a ٰ;GDxJ>,_“@FXDBX$!k"EHqaYbVabJ0՘cVL6f3bձX'?v 6-V``[a;p~\2n5׌ &x*sb|! ߏƿ' Zk! $l$T4QOt"y\b)AI&NI$R$)TIj"]&=&!:dGrY@^O$ _%?P(&OJEBN9J@y@yCR nXZOD}J}/G3ɭk{%Oחw_.'_!JQ@SVF=IEbbbb5Q%O@%!BӥyҸM:e0G7ӓ e%e[(R0`3R46i^)*n*|"fLUo՝mO0j&jajj.ϧwϝ_4갺zj=U45nɚ4ǴhZ ZZ^0Tf%9->ݫ=cXgN].[7A\SwBOK/X/_Q>QG[ `Aaac#*Z;8cq>[&IIMST`ϴ kh&45ǢYYF֠9<|y+ =X_,,S-,Y)YXmĚk]c}džjcΦ浭-v};]N"&1=xtv(}'{'IߝY) Σ -rqr.d._xpUەZM׍vm=+KGǔ ^WWbj>:>>>v}/avO8 FV> 2 u/_$\BCv< 5 ]s.,4&yUx~xw-bEDCĻHGKwFGEGME{EEKX,YFZ ={$vrK .3\rϮ_Yq*©L_wד+]eD]cIIIOAu_䩔)3ѩiB%a+]3='/40CiU@ёL(sYfLH$%Y jgGeQn~5f5wugv5k֮\۹Nw]m mHFˍenQQ`hBBQ-[lllfjۗ"^bO%ܒY}WwvwXbY^Ю]WVa[q`id2JjGէ{׿m>PkAma꺿g_DHGGu;776ƱqoC{P38!9 ҝˁ^r۽Ug9];}}_~imp㭎}]/}.{^=}^?z8hc' O*?f`ϳgC/Oϩ+FFGGόzˌㅿ)ѫ~wgbk?Jި9mdwi獵ޫ?cǑOO?w| x&mf2:Y~ pHYs  @IDATx}\U;wiF`ChX]}>|Q}>*vEA4;!=n6lz3mnd72{Nrܹss~_;0t-pߑdz9: s@?% K^,-;u#MF}Mܸqz]evm0JxgL<Ooݺ53Ϥq2XS`8)@ %طmC߰aw…n>ыd뮻EMc&R@@84w'q>zOaQ艹VS]U VTVܖpe;xq{cKݞj[{<|F(8XS2o$_h` q>+W9):2^W?vv]mI2 o&Rɔ+IWSF"f]T{Cm/msx͆lۆboj|?PyT3c3pY8I_}V=Zuft\=cY)ɮnk=̺u"HF@S!@ Yf)8hTh&'sOJ>Ӧ D2$y:v]vC>.( Mc3HߟN2P`6qA` nl^ڝnD!QDmڀf h b  Yjg<l:Ҋx"wRۄUoy, #Τ?>~;AO G=-t2I 0+zC۟}q_6vD(Ed{vf h R;;7O^>R kݻKw=ئ`ڎ1c ')z>"%~<$=`bSWPSUI6nEf&gEo}t7}n3PH/hB݆@b Њ@<>N/tYF.X<pM t dG dZNa `pR$P-~ h7aF9N ApZb6XS"Wwߛu_lzvpSҰ71=_~_c, iNyО; ը̸*j+T۵k(Tw`S&//~ݧOM>`"RGǻGO!^Bh&)F54:@h1#Ab}f'90O>=kڱj+Pv8:?p|')RX$#gלK].UHi ЌD( j Y98ȧqV:ۍ4jWOV@ Ddw\pIcN@W%hB248NmWrA c^N306́{?m~b?4.[h26}o:6aT H@h&"S WW?yiIى`>, PAiTq0M1Lx͜7TRj\ȊClOwL РX}X2X z1N;W6(|ݗ  ǒu= \/~}N R9<nG岼F:!(AO(V_rh +U͞4@S @v"z D\E1=&ue`4 ͨ4ar|@k$TrCs= ڵ>o cb-a7p_?dF?|lAY/F?}5詸,}dʡGyOc,-օ@Ih$?PA3\ӹCnQnF[2,_p]?5Fs"qqqe!|X؜^@/ipLVGP@3"7O.JYSID`ᰔ#ER5AL.K_F%9D/X0v @,/lsT37o*!$W&%n:85ؾxQfT,P;Jd"x>ǨgFs1dE\|% ( @_phKt<,erղXS85|Aَzg9w@z25wU{ , }?%(( [ y7S^pC!QQ (ȵT>z |a nq2't,Ӛ8jaݪ6En bOunYq-$S$Eٖg R5I;M/ U {9ˣ|̋S4&Gؙzs;5c{=hPb18#}X:A"A8<>6(5Gu$Աf.۵N[dv*O؊:"5pTkl;pxOpL47#v-h3E"ZdE]Df=mM>J%369PDrm,¡cP,duGa;G?/;_Ux|>緼^3m( |0UQkxjƻ*L۾ɴMFPl,}*EIp=VG$޲p+NH_g zN`Hcw6,.O0/؇11GHp<;臔Ȕt4:zg%%Պ,?b6Ft&J:\G{'xKΛ=q1Y㧇Ʉ:)*4j!0Mw$_V=(sHSS * ;6h.qM'o:wb ;Nn06KX_GvƎ,\fIᩝlxM1r67Yƥ82AF "G )P J!:xK^sdkL=51X=tAR/9KW!Vy8 6)/(--$1K׌S*_rGkGw2|/ln0#i2P`>+`_i8. I; 0 bfVԃ]|~孙733EJ}2.#H`2 @ tkk+Ju3p9 _]z~pD,Yv9pHǻ4Xd̟LEDZ!74hy6fkg[tOAe[)A'ɂ H}y5L[70Az! |Ҙ"y7W7MT*mC/zZ yx%oasen;O3H&"z RMVܿtwӯ7G`/W"a+KB3M6ñd[ /32ob;tοeloC^" |KHN\)lds[D2 $=nvJf@8o`<lqd>[p|1&׍/Í(p,lqPc.dI7EdMz^X>D3ϛ}6sMW8ѷm]j=md){Sg!0!+Ǐ(o "R Lĩf8N/Ҵ0w\SC Op3 9FC3+jxGl0Aa3v"ץ?/\h|F%Sfʱ@ `^Qhop<Ӆ|BT P˿=Рa2b=V qJ/929qaRs}m\P"yN4[-pC_l?8cb_UzsDsy_K$ac ϶{51n~}sbzjEm\.Psc$".₞`K-.G ~H-~5h(~tda B1WKąD6p~SӲ+Oz`qME<ˆPvn6X6,fRV(PWp zg!Э( cX}>4sD^o.RsҟP C0)@)H@ƎX䑯II̲$ng=cua@ŞH8&3pX,~2.^ 3nwS/>j] p~o>3EPJ^1(D'͏xG˿Җ &V~S)Ps3]w(mgOD sR <ҌکDei0/桵a?f ?/_|}:84XD# dm~LwFc>\~=hs|~,'RڋӶ#wX}d*Q7k[0t~y0O;%VuPbTΤҰ P-&(H]7\O^wc?<5L2QzͶ >?}_=tg 629N˴_yi"ቃ* B>u/w( q'ceO4jb>OJGa$L Ё~㗞{*ʉ+HEKr髿|DsϜ~2嗌त+A0:E熆ƍս8Ǵ繾=d,*wZmSB?ƿs͇ۢ%! y\C4eG Q%LTP4vn[? %hr/#ĹQSݧVCN{xt8 8oaOFG4=DqUDsa>=>%V p=%z44 ޔs[O)L& |w<}Λ eWnW~Ϻ)j2Ո>DҟҞd:鯤0H@@^{-&]_=(cyؑJFyumzS^^nv"Maxgd'i2Aާ!R2 I'b `SMl\cﾠ7-G:⡀OKhJ`nf˴Jn4asԑ ,cZe˶g;|F4ɸN R3𘀡9?$>SRxժUc+&@b,X7={qg3wkgL2 #JB%Тd hdʹhpnFv1ƹ3p{cGGMn}MwyŬS[# }&=u14@5u2 .DC_³-o']I̧NIϛ y3;Jxk0OSwH&M;RJrҔd 0, N$$ sƶm|fJ,/SVs'm0u^K)JE8V)<k̜2A jFVh<ݸЦ;Xvʧ-_եl2ΒdH -0QDE6𶶶w/x)X4J]ni@ڴ'n JfL?1q9gЩ8mdr0oW͎7wM4qe‘+D,Ip.SAoT Ma,hB'&)J@@eL ,hJIuٺk疼ݏ?%҄8[RwQJHk.h UkH[x":7v`o*AAZfr 66n;{J_oЌȨo>6f |3tY^P} ?={v-?ҺgϼenK@FdP9(4 }$Kb%6D#?!{ i S,'``M3_x^Ç>wXz?\lSFR~ 68a <A3~T#%YfѢEhݭ5o|+5յh"r\miÖݛްV߲fbY$OEhYI3qǴ~e|1 <cjlL]dgA3-0fvg)mYMXpࡖ~:gKlXlQ,rHj1Uu+2U)a ;ae ޶/\uƝOGskaj>ԀXo;[?HE .b0vo_:sV&c{Z;6mٳw?D &@-4%jj_sKGg8,/)C3<\l`CR6l=d<{&GrM/{KUXj,:,0 2]]Q,n3o?=~ϢFH& ΌIIp",Cv)QҳLD=46L6CvsN Og[/#(LRe-̔0N'[ﮪu|vVwWgO&@'yO:4y#6+ap~AE%`#iiؕIӍ{G ;m(W6MWHI`!#`à$}y @ ,{q˒H;lrԕ{$& #r,i9C?~8e|'bv:bC+]Aj jjn7|(Mľ~%Ujm/|2w F3EWk'_Ip /3ؿ\0A؆{W~qcgTt Ώ.9ۏ5m'qߕ b3?QΞc.,- &>7}]^ÞjbP;(jM+)҃ iֻ vU0Y=`HBcK|SO\p4v3A\Q}!53eY13*LGaJFL%ťZ= P~jHmFjyz~oUUh؄8b3긒ʬo Qpk'~Co{ʌ! n:z8(;|Cd&fP_{^|80vH]՟k0VT|+7l`?+nyJa Ԑѕ_RЍqnlfuoxܓqj2dMN # i (g$k^{˷^ՕX<ÄAg'p ܹsy:`I;k4Ri;0zw8Kή4okPqK #XZ3+n<#3ȏr)5O~Wxie;& `J2Uxsr|L _1WCw[^ᄉ1S/iF2\z]VLB1ktΧ-Nv `pGS'y&|+MWl@g 746o<{ vbC'|߹RdrS'50W 9эtfNyYI ,FQ i;;W_ӗ`ovqeS 879]o/ͲG) nʍT2 6cƷI<.5sA ,`RNPfبIgcQ{ <+XDžO$J p?6/.G; \Uٷz9L TSUqF8c%| I <*L Ä3t\4X8F [q۟-+ yƛK dwbdqwm\jb(y傂>C휘dF"ם7kZ/CȴZrL>͟yj3OBFZ !A5E)gۺʲ)D2RK$RP [}ac KS4&@@|!hݴ#n㘾2>\<@+ SRy>=*M9a,?#ώҔPaS?CB%4B-h/P(ߝlPTLꢪ lvȅ[rp<߼cUk&+i,g`Mh[y \,힪.-wzD|=L @2[j\ h|;&$R0:;i *iz`0? ;h`q=?H6H_l{C>3QE&5%gX4 0Z \1,94`Ll8?͔QP }3cO'zBHY&NyF'-'B< jaZf`cVǞS $GPs]BcRh9/nu1f&ِ<:;#Q߉JYj+@2WádֻTeo<5Xo$+$U6^끆&O/&P EfmdV!? N@t[!(wP~Zftȧ@mMbh~mL?:3]\JDnO| Hʊr2+'EuuFpz}e0|hHOҐF 3H(R jJ9o]3eSS;3j*Έcb ,C:YH>2U 80ct? /:iڪ-}%A]~y6\5l놟+? Y(4J[| @2(T3sU暧3!#J+d$ P]b caAv\VuIQβRk= @LI'׸ pTO@S*+MYiQRFEY W|i̘ ٞ4zڤڳíƪ?'qC6:)te*ײwfg75*86mZ› )>PMbKʊ? 8ڏߴ>팪ʲYX0ɱ'aդDa fRb#;Wc(1W Cb*F@?΅υr"Q cEܱ\%4(69Le)T8/i%%~M ` iLME9c֔׳_Y(KGGG\ D{n@qg{_tƏ =ӦL4 OUVOx6r{_.̱B j jT|%~3m01ǭf ,6i3'Wb0\1 [cWVfΩ*Ê78ӘyC \ +)x; #p R'T۴ӱ3mBWSl?I02ٖ;}\r&^}'N)e4)WĶm{pOP4N@aqF(`̯,Hc Jn@8UM̨EȌ @L߹g^gX\KR %{'W_5g5r uO ]5:723J~7bdnBuٓ+6nb6'yrKWj<~ɬS$r[ `"g#qnƊSǽ s;*Y;dH @mjasWϛ0 p:oxuؘ1hGFAKtpww1F%`wl `UM4]!{.jaq AZ%Cuh<;0tGco`f ʌ[$ 8aM0n1aj1W\8;LwǓ\ם0]6Cs>ڃҨ%ŢDkk;MJT!SV)) ?BFmrq-̨3SP}Y_ݩ{㲒 >؟o൓5S?qni9p[N0I HW鐳=_() wG{8% fP\LPW_~f[w#L}}~ت-I'tH8-MCQp֕_~\AIhc@)cMO^3)) I& غac`qKkw| 0P[0 58<.xpf>~P . ˽mזDP!DR](4Q[܂۱+ zvJ-zq s@M ?4zo wDɘrq kPTOcj+/)'D=+)zRrg NxyVe;s2WfZ g0QOO02 /;? q}SJf#]w @)wwf1SC  _e:z۶eemw0׎'*Y?|%o:!Rpb@sgcsGXN@/j @'l~p6,\ЍܫW ΊF M{sȎp 8MƎM$fny|Qh|kbLT7~tO|tlݽpO#EΔbZJtJ}8kK;YVQDugzqT t'y,&뗱f\=Yk`Ge\۶m͚5nEթ7N=~8Ҝsd P߃S//kM8Eʋw2a  C+ FhƆ  iyof<|w2ᒲz;nZ./Ƒ)ȆO?VUN@sҕ"2m\ ҟK0o'*`h]zЯOF[K{_XM GDgWW(5H葼Ʋ @ŗXTI|gZA3V@Lgџug׼&IݩH>yƴ*hѯ=&cϜ93p];{&x2ĽJL87aD`h/ƅܶvVt*J߁ʛvuEn8CMlgȠv2byYXˌƣVD7Q$85m ZMpF~zmWZ782E`R&%\n'K5J*؆:ha`Y3W+}9mr4Ǯ\F%p Kojܼؐ}74cx LHP4Ak}Tgώo^/>e|9X'r/2Z%"D ߾[}r񋻠MA*xG9?2N C?TDzgۆšl9ϑz(pvIOo_gM˗Nv,L9ݬh,$! i0LS̒KRʋMG|ey߳3"b 8w2/5X53vK#Jy\T~a($y@͝;7{}?5o9PZiEѴx!p%V%IDAT׼/61fEim^Vŭ44FMJV)6u=xPpddJP'nV?H{?գG3\ UK?+qc񳖯,IA؃[A.hb`"{%T2r8O}!uȅ.fYj'1,?Lp0#*_u.YHi%~{P_CA̿آ#v#XfҟN?'y@ꪯ@U#.3їIY#$RRjpa@"5<qb0SJK"xږZCHs:5N +iv*žߌBx0/wJoBㅃ< ᥺no`yF&9^VxÉ)@q$ 3o~3+e=a#M)A7-eY1l4'BE}0zMHWwnoQsJcvT=y) GG\X"5ebm\0_ H8s7nnnn NbPC&D2x}罋VP;1?U?SwY\a3J5?YSk[te+.ptq5')-( A7.kO:z"-$( ft8.n^YZj-_yu7޹՟ TO%P>!gX 1DیFxj/yjbp #W/ܦ`@bLìSΜ=y2 #~22'i<40}?ޕ`޻P'jR৤'ùH@Л<@A ȸ8Ǿx^qh ]T=cGĠivniYi;iSPf@)MF+Ê (\pO`?l󸺺#/~tD082ghxX龯^{5Ȼ|6Ǎx8K a*I%P>"2R+ug̐ŬXts:쫮o $ZO)/4_g Z8ZgH҃ܽn ;Kƫۘ̒NU EBOW};&bJ X=;kjKVmQsOOK Q Q5JM OT<6JtUv*l<*bӦ`ڪ0tYȆ8Lz[z̃:۞m Ymr= >NOہR}n`O57=M`'n@9( f[OO)̀cea'wGU^~1-^?yA)Rx.H=xm~?dx8 Ґy]!!"TYgWp7^~J'7,[i^tne۟Sd ~;~2Y$? :3eGaƑFvVlXSKנS'ԍĹ|0USZ'-ݎ_¸J>sq7< K?sZP& ~v]mud$@ơL'SQ^b._iGDO gh~PSU|a8,~?BfBS_0i6b]׿^sΌ)SKC^1A2s} P0.];9gڱ `OO9e.%>Gi^XKR ߌ?c϶bFZ' h֗H~͟/'1H5 j0Jdp26*N8+/y~KjKO1ih,ypsF"h17YYV|o` D~?qhZ7WfO=6v?҂!.H H>W 7}Vmp 8J節Ȱ"_~s8]a4!I"&d65͑B0a+>yEϼX(s2S$<>ahů  1'UY^~ٕ[>_>՜׆$t;/+ Vk.?GȪ` ܷ%kރ͸[3bXovpAHP3/v?SF{h" ;#)F@)0WZFP FM1ݕ^$^mc4mH" %X3-5럄]nBwH|KSrx"ñ^lq%H{7M<ѽ:t=rK^k누|^;>ϋ/-MK z4~P}Ќhd*sޅ 0-ygN{}Lq b n(@GU%]X_=[vN:v)߻Ο7 #ѽYAϿKg]0t6F&J sn=ԲȺ}[P/*yRͧO &EK*R3!`Jciddb3 +8¯}⍗4`G`Ht #s7r`_ #(7ҘS[\O {9_ ],h:rb>|;Vp쥕g@0sqv;yrӮ}~z<{><7\T޾;oOn*>=MTޕ&Cv0 ZKQ @eZ~`G:ٸ'mn9F;R_xH}G;U~~D w|~SG@@5'jz3Sjï~wɳ]cO2hDduEY~/{9;oΔ?m oz# (7FGZXca'F:v=/߰wɊuqD/ *;%S[KtםRϏI}L{I) t8W zB>|58+lc݂c Ì$fYwox$b_y{v<8p\xT?|irs羦6h^y[u$(scwH{^&@F 3߼.#pLJ}Р'HC9B_'#G!O)wr̜tf8r'dzC믪(q?hՖ/|O`VU3929mԬt<`%dkkWHxKA*)PӁ1x@uF?A/Q{|^|I_icӇLfOsA9ƕFNs}}~KMk9(u~7\"gtgId/R_)AM H|gc F: ?Q2q[]xM^\ #R8-mݟOlm9d1wWp*-A@?\FV1"Lӡ \8ߞ:#70ax%%46 o1p@s^_sG4F{Puա&߻5wOU@#XndT.h8)A@XiH%_@M Н)yuj @f+``JaO ^} ӧ>{p$j{lؙ!W)CK3P 개d\L2pv~ZL!yx~>/g Ʉ.Ọ?S0r Փ}r,9LvKS=ּm?!9F$?G@M>_& ~#|!3 BSD :fq(5g.3;e%ƅ{1'8o~L| v>bùbS Vj?~N@@yx3}d4Iu8>}}h) )37~_l!GTi#Ioġ]j`jHkgxɪx@%6N&-Rw1a(PQ%( skV8ܺɏ5+_A )h?;{lt<7K.*CS@3o ,Pl3k~"Ķ[٭ .r\Xjq4$:%?1j8)C¥\PȘ0af 2Pe_U~҉df%?>PAkZs~hA'PpZ2ic 츃0EgJ\ΓF$ _iZ(КWXDW]uUť*ctu_l $㡀ȠGasr h `I<G'#8F?N<; 6F0g~'E ƃ~,щ!MDK<֡(506fժU]t]WDzXay0;P` 8򕖄0 1;SVPd@Uϟ~饗B~-`NM,5ss|ܽrMW|1" 9'QS/a/f2n M!| Yu㐸8#~PR rvzÆ )SD>o''-m8ҍC2(Vġ3'`??g[aʱ0J̈́0 `(:<72 .tϝ;7simK)vqG<@'y+.@2c1;3uRMgLh(t;c#MFrN?y흖78%L%0&ߝ8{tC7?/ϘpB e$#c4#mv2o2؅X#w*&`S_L7ἆ@"!,ȵbCPPGPNc>_Q G Vf `knW$HM_J7o?e'9W9BF/mt5XC/`)`X%  (!q1L-88Z@o8g@)T ~:fϞoo;yZLڎ[JLI;.- ۟y?{p?SndlK= 0B`~-H'0&(YGLwL Ӏ3lbvGbvS몃=f z&8KQ#t(G3}\{G~v$T(dm=3T}v z9љ|^|7bM$G62EJE"fk1('N@,N?9;_|}~dʏNDτ ]fxe/wǸ^ %>5:sb BA9t8p %0oݻꇖ-A sLW,H(fupDm D)+ijҟɩiWxוx׹QWT|?{xx甇Y1M2"MJ BDۜypg-Ofڂ%P0_A3x"=u6$@oZ0~r)XnT;dB[ 0c L#XIkkQn?((AJ fih"z `jhjpݳ=j{/#E@!W41W: v!yL@h3@Ѯph0luS޴m%%eF<>p [NEY-#,P~ $0*ՇyVHvWb9D٣a,ɽ̙0v$T%y ~Ѓf\C^;*Fy=j" &sX0aE݆!40z9,, 䤠hLy^"fTI{ޓ%>c4~0AQ@3aŁxwaH%v)GQ GEBێ>?E7>%G +v4 @UWOn$yoyF@RDl3c^[-( H%TFsa0nThXLG5{FsշI%U`@uZTNHaH@.j\ rc91ż*J[nΏXADD>(6`Um.rÑ\ =>5:!w.V}XH `jc{2†{mİ۝$3\{u¹9H0PcIc0;J(zdR@3aY_\U%F<CA`yu z~aOY4j.Z`oX, GN~fC\P(vnivףhp[%D2T"ef$++5#RFƇQ@qP#Nyhf@x(U4 U" CF,GȠ<Ân#" ADpC!P@k_ 겝^J@֫j$ `E3Q r@2\v ҠQ 9h0CpP2< m+)kC-P5aT A (M-fzL<ε M'` ~~C v au=QB.z݌Di]߮J:"AsXi.bƴx6s_B@سx(";YCs`d L Oh=і1NH}+<+=F `1? E.oy~ŵ&ψp߭߿!bHžU΄y䯌1_{5isf^ H@$  H@$  H@$  H@'haIENDB`ic10JPNG  IHDR+ AiCCPICC ProfileH wTSϽ7" %z ;HQIP&vDF)VdTG"cE b PQDE݌k 5ޚYg}׺PtX4X\XffGD=HƳ.d,P&s"7C$ E6<~&S2)212 "įl+ɘ&Y4Pޚ%ᣌ\%g|eTI(L0_&l2E9r9hxgIbטifSb1+MxL 0oE%YmhYh~S=zU&ϞAYl/$ZUm@O ޜl^ ' lsk.+7oʿ9V;?#I3eE妧KD d9i,UQ h A1vjpԁzN6p\W p G@ K0ށiABZyCAP8C@&*CP=#t] 4}a ٰ;GDxJ>,_“@FXDBX$!k"EHqaYbVabJ0՘cVL6f3bձX'?v 6-V``[a;p~\2n5׌ &x*sb|! ߏƿ' Zk! $l$T4QOt"y\b)AI&NI$R$)TIj"]&=&!:dGrY@^O$ _%?P(&OJEBN9J@y@yCR nXZOD}J}/G3ɭk{%Oחw_.'_!JQ@SVF=IEbbbb5Q%O@%!BӥyҸM:e0G7ӓ e%e[(R0`3R46i^)*n*|"fLUo՝mO0j&jajj.ϧwϝ_4갺zj=U45nɚ4ǴhZ ZZ^0Tf%9->ݫ=cXgN].[7A\SwBOK/X/_Q>QG[ `Aaac#*Z;8cq>[&IIMST`ϴ kh&45ǢYYF֠9<|y+ =X_,,S-,Y)YXmĚk]c}džjcΦ浭-v};]N"&1=xtv(}'{'IߝY) Σ -rqr.d._xpUەZM׍vm=+KGǔ ^WWbj>:>>>v}/avO8 FV> 2 u/_$\BCv< 5 ]s.,4&yUx~xw-bEDCĻHGKwFGEGME{EEKX,YFZ ={$vrK .3\rϮ_Yq*©L_wד+]eD]cIIIOAu_䩔)3ѩiB%a+]3='/40CiU@ёL(sYfLH$%Y jgGeQn~5f5wugv5k֮\۹Nw]m mHFˍenQQ`hBBQ-[lllfjۗ"^bO%ܒY}WwvwXbY^Ю]WVa[q`id2JjGէ{׿m>PkAma꺿g_DHGGu;776ƱqoC{P38!9 ҝˁ^r۽Ug9];}}_~imp㭎}]/}.{^=}^?z8hc' O*?f`ϳgC/Oϩ+FFGGόzˌㅿ)ѫ~wgbk?Jި9mdwi獵ޫ?cǑOO?w| x&mf2:Y~ pHYs%%IR$@IDATxeu?e [إHv1nbbOF?S j]hb1jlEA H/²?g=s˯+W Zwn`g_^lW[%B/TUr f*}ιiWM/mTyVv[TZ^j(P @CClJ@ [M:W>\*UNp}f>lW܎JnBe*/W\`~ہ]zϏ>INvTyȞ&7S7YƲJ0` @` !dL @vZ.+&/ r ''x5G|c6e~aknu_|Kw/$e=^C0 ar#?\>B)tmf9Y4~r\`joȅ[MetwZa|MD  ЗfaR#vi?yǗNJϬ,T](Fw$=`}z]?>W:媫TWيͶ]/P@L@v/?BŮ rʆF Gڜ{쟾{ʟ[v)W=IpQuBe&$m¥7[ګ:$ @=#@g@uKҋܨ)~~ {݀qU&}S_?_x+>ە2PTC(k`@   @';BȎ@+yNQCgwl^u'v;7_yWp|N@ۆd&c4km|=M^%u8@F@P3 l y'>Ϯ:r?[{Tzp;'fͯ _񞩙tO]:Q /e\mid$iƼk@@   @+t3@Ȏ˃샞[(^7@;΋9GOTr{~mE,;TqkVj(P @%@x@v|c&^7ʑٍS7;gξs3;9Yo ~ݝ \q%U))*oTO#m_${1 dL@@@|B{Γ?n,朹m `oK9-ɒlm@@ 2 h-!dJ:W}k77DVQgGX^|l`l6 PYzxOz6zHZb&PH@@Ύ2!qn ο:IRVuBڬP^lD  Ԩ@ g>ʦwSFsN[Fslu=ȉ8٦QCm}zw:VzZ&H~@HK@ZRԃ u/;'o*?A.zg;bN?Zӳs_|=O~&uUC`6ӥP@ HDD@P{8rBk&kšKN+slM`@ѽS__wg/!G@tyڴNM@:KRVz(/j"$ hP@m_qk+ޜ+_\bz7;`D<`5FUiRP9i0`a;sӹy7iY:ej.RU2NZ"PC@ Ă@{7LZpbvWi5`wov>q eweY  h `5}Mo;Qyu\V P^!)6IҮ!h@ P#@@6^=~Ÿ ?]yKN9!Y'{;)՞k}ջ_333s:".N6^Vq @@ @_zٯ~xtcNh:J`O}:053w9շ;6: AIVn.Z"PC@ @N[*-=2~cj?=͌2/_)A OUlW󟘙{6.` ykӼJHIQrt\UI@qF!/=\~P*#quR9v[]_۴jK{*< ͳ>A75uCRvnK>jWJ%ID @QFtól@}}g[?{y/)ϲc9';?Ҏ)smu]o7vNJ*තw~񳎯:qRs-WJ_dFZ&RkH` $@`7:K' >Blv{lAvNW VTmr]rzĂRo\力۟|չO+Q!)+9ROJ_VCYˠ@F,h8'qZ=-lQv^L6Ǫʗc,@vUf@W%׸?muC8j9Sͦ.jrE $#Y4 q_j֭8Γ ǿSsok7vhw:H8=)KW޾uN X]ˣ8Pξ%i^ڬuWA% Q"@`6k& g//>̣k)9M8KＧ.Oӧ&u6v{$9J$) G]5uW)vk^VrERGի6 @D(mm 4E@+>%bCdSuǒ1e?|X"MG.>PUP y U{w?:e2q.RjS=$]5@  m?WǞ?lH缚X?9nofIl]욚hDfH H*g}W}ܬ_|_zW]}ѭ=rf@X7\ >] 82dOcZf8iIn@wC6]_{ߝa׏u:QR~)WݗIR닅nG*A!,he8IccϸV7ײvW:欿l" iGʣs8l.i'n Y>׼u.CAqW)6L5_4YjsBM+#!@B0, a! _3^~?wL^^!.qkmۗ-C,v6>?^=M/ԓZr=U\*i_rb_򹖼/gRU|h! 0`X,R8m/;zӚu^kS7Ʃ֦q'N6n 4K~Ҽ:59z!>Α3s.xӍwd??lzߖ(gEZ]z9sm :WRVMnmi 0  Vd @|x?;q qeeD;"-:x`@;]p|'?m^7Nի @o 0`H7,˂ |^~x3tp% Њ%0kSl:\a+läJmӺOy Knm. rMtI ,ܮ H pɇظfMK'9׶qΘ_;\DI3E{'f~~V/qa[9x&.*խ~utsoj9Ań a#@`ض( |=iXpc*q8_vg㜯3\[Ku#7 ?t[]@,[ʯSuV偀ITgߗr"6++~guG  %'I 027_1%wr;N;Hb;[~yu5߬3퐃O@}ڠO~6WNm~~tG(t׼[K7%\̙w00P!@`hMB $|[V,}9+'%Ս*LTS/#k>1:V6ٶI@?iV_c]7Yv'5K()O?# H 0L d-@$K?|+ƿNY) Y&jp<GsqBl 6~F>{ӎ{ճG-tu%8`QG 8s5YZ  C)Y EB+19.N]zR.P^s?OsB'9D}e_*ʉq, -K@ُ̃l] @a+@ ;㈱1 :D;=Fgeqs_bZ'oGJ@>CGɸUG絿VT_T/uEUy.ҟiJW}1q+@B$@CInˊQ99ܶ(_dzDȷC )jxұ<8h7Wg_[)}ԇ^|)2t@ 0CqyK*svWQ?0pI;'owf5.kuuL!?dSn:TBH@hz1y@ 1W˕=5<ޮ5y_oiZg_q֗[?JJH !@N@o!"p5owg垓W)Qi|ք'y+j&/?֑g%mA'\..u)Tׯ8uC }e_x)S߲ѭw|(8uGt[wuߴvŨeI5( 0 Fb@QV,b4:9Asp֜`,y ྴB!_iY@ud+AqH}J%\@ hc1U@`ݓ -V]pb w?7eF9ir#uEڗ8~\s @`?> #ϯ;>q6B t]OxCB sğw˔c6u쵭[wJ[*vnPb17vmQg6ͳaʔA` 3S~-SWHiR'_^ )sAB@?$@C`>o>_섓vچ ճ[F 69W/GIiN-@ >%@O7 ӂ \Og;L~cI%ǷX, :$S/T!8 )rW=l X]۫R4n:_H@@~$@}O;8}m!f'r>Byuqc$!vXwCN|R TyIA?8 [C*Ŗ** @O  ô zƊpCzz?xO9nQ:jr5P:'&e$@@x$@}M7W4;ɤ!?8F < G>{r$?rޭZ_ǽBAuE˩dU5( o @N(KpTsMr:Bz2!?uVzjUGznuנomDW+QuծREjkC #AMf&rmD  ỏU3/yut[nۋ/yu 'Bs#A kܗҟ63~s;u! h)BrY~9αyKY;Rd苴/)kHЀ S#A kV~}1I(h t|։GczLUJ}IV1TZ@t$9!@}@@ %x|>LWgE;%/?6qqνJk-O#eN?W #A9p$ҫPk(P 0hd>'mXB7܋T]Xo#y?\::$@@ ?8 9.WI$ouCAiXH! q꜇-6okE$@@_ ЗIA`rV\J$?78Mvԃ:C@S|]vۼοNi^,oHЀ t##A+~wr ο7'lm]t@ {G~ɫRyT]QU늴I%\@!gF 3b |o1Fo BGmcc㆗c}ӭzs#2F G }'Cj{ο0Y͕~ <ÏsY](ӯmmVMVJ$9nX; pgT@+sLP]߹oBhl@Wrc@d.۲4}hޗZ5UGB$A:K>t|Y ;oO;gߤ(:J`AN:bZ7:"! O۟ڬ5M ` . % N*\3g{Y.{|% Џ~姏G\vթOjH]I*sCz@@3$F^rP8#+!g7~*St٤uΓ4ڗHoVuJ^mw@@ ?3 xB7洃6K Nw(``UЯmQ~&;ྣ/-MWn%\żs@  @ct -C!r[*_* ْ(g=ԗIG/՟cp':ꨋ/|м@P]$we v$@]#pg>9OԀ g齳IЯ !!So[{-IJNub#AzN@7h(s/|Eԯk?8J &pf;ߚξl^8 @}I@_n&$|.Z]N͋~!ذf5+'h.;֦J)2ZfR#&#Ie,G@ tɱ~/nRQg9E ;@!U\v['^m/~] @=% H:Ntϝv AOjfNr@" O@#ʹ<ImM@_x7.M$Y{͋ SJkּR&Pb M@ t\w+?ē;˗!0%iߋ9!@="@GH~h6Quy?g-mt]:VJͷ۾tL+o @';B`8 *OqN|f+q{b`8*@IWԮV'?ʮIRzb$vMVW(@h@fmτ % MXU^lƄ@8hr TG]'veTQcj}$ @kt 5A`rV;n: ʉ1y` uun۫.R]-.B A@h +ڭwMK@`,2uUƗڇo}XW=RU( @@ hDG4mh,R|d3.,Tiu-KkVyZ!@]%@ G,U>N޿:A>!0߸^N:!)}-B6y@@d!0*ѷsŅ4I&'=2KM~ޖCF@P3 [h% bF@Nu,&LNn:V.I-x t@bK@`3y`Ok@ONrC6XڗJڥLS]ˑ  Qt":~%w[k5(ݷr]*ꚷ6efjHI~٢unkz3V m) L|*l ڼi >s @͹v.RlVZ{.CeK溱!!@#@chOZ[Xyܙz. +@ [lul5Rh^/!@AX0BȗJml}> |1% q%MB:ZR뫌K @t9B`8  s3Y{ dA> 0sWbej7-We~>ɮH@@d!0+@j0A#! x`aW]ַebӼSe.e   'W3GJEB!x:Ui_ZO%/IZڪx @?^ϋ!>'`(Sݵϧ %P,xGtuڥL면M۩M__QG tCt [?}jfꦟ5!Q ~@o\2[)յJNmVjWu h !Ksmiշhm 0:;֚W0RݾQ{ZYÿ*mԃ QDb ,ڗe_- 7M͚ԜkcUQk]׮|[]#!@]%@ M`ap@'V܍ :1ozC`)smQymԮRT; 9#C4F0&gߌoooK=?m}{(۴ʤr dF@f(@7=&Ռוt}~lZ?< 2-! /r]Pp@& F`[cK\풷[*lt@@Z:s#j  {um\m"]t}e%>T  :N!0~jnrpAF`fxGr:~/~}  q !Pnj]8w,}B`LηrOFT~!@]#@kO`-ÿJV `%9~ofB:N@3F']nSiVY4KP@IDAT\ nőrI}R@9=LCs~PH&mƂk)B5 ʹ. @eZFGC@ DRc w?j6 @='@盀 @`TrõIY  =q֛ C 6aFhs<p pxpõ"V@hعk+\0A!'{=B@ Ї)A` YZT ; 0<~Qó9Y  I@is7 tm[CRf ^ + $P=X\~%iⴧ%E=@ ]>}Nm˭.ڬ]tlC2#@ 3t&y:3#1X< r $$cqRˤ?FV.ɯhm|}7b d@@h P;ɕm 8 < ^B ŗItW_unEQ; 9#C_;=ӗ힙[ϖ׿~i4r/ry||lܽ\*KPpuJU=M։:~\ @ )N:r]' @a||l<ϝx_}@H]!gع;KB2k]kS]$  s\z>M&#TQj-sBrsVk9Y~ >ydXɝ'-pT A0[4Q]lZ6JZm\< U`(HSrtcge\߅<ˏM U ίw|YK}n>71P<+]u߿jDydyC֮=f˚M_q\%z |m69)WJml^tIֶhY~:Zo  %a 0W~/fombaG'?匿Կ(g*c~l2WX菍/9Gova\/~O_s_7Uɝr䦵O=a˦Xk7m9a'/o\{քլ.eUeڏlޯeVjkC t`S@ @@r߻ٽfco:N<˧ :d K$,wO^3_<;/Goݩr7޵Qy9ۭUYzr)<7i]d=g{"ztηJͬ} Nټ۬lt@@K-'AhߞUJї^q+|=H}i h[5\:lOF8ǿ||NKO+VUdmIܵwK^}h('Trt [ֽ9'8qxyB|;~g.ʵV"1U]}n&rv)/2 إ~8tn|]37YҪx Ȏ%=A`d ̋ԗ =~ ]_mz2~D^_uU\q՚{{˯4qlHV˥«^7~ 㞐|;`_䮘?{K~nr| T?nߵ5_?=[d}#["'bm"}=ΦeFF٤LzV!@= _GM=@G JLʟ~{wh+3h*VHgƝ/v}G3r 7) q /{&+Mnؽ[=nZ~Ayn+HIvE  . % a&=*֖U_qS<_y?nXhTΕoMcNtopg9e Oǟt7Me{#{}| KG,O4/֌q"%iwok  m) Kv ҃^1W󣻧yѷKyQmU6EN.Orunr>>WpX.?6/?x']~k]s@9像nk }R\ux/kjCB:N AYgvjϽlqW$ #3P /Ib))QˍyrnsŕkZ14}SN>-&cF@j毿g}sozk<E FRڨފcj{Ӗ.uH  q $u0¶j躻ޡ%UxzY\QX\ȻKJK':%7v1ĊW.A?| 0q/l5UnKoj[}T>w~|{)DvW(/6M:  5 &qjԁn[?u5F Wd֑{Ɵ!M8$#2ǯ^5Y> kS} W]~.pJqڗFy]z`羥Eqեky+P]ޮTjGBzB@O3(FdmU͟eηhq0'Zw6yy{]..K҆-wo<].0W{hVLO+_pr`Av}bɶ|/W_MFd6R]qkԺԮReu"-S]y+Kǖr @t7A+ =\o_sa^ZoY\)^FG(~ٗ !.O/ʛM\F-=gO}[s(@wO p5Pm \7MEjid6hku͋$JR[z@@+bZ6ZVFZ_wݳѿ+I~}Yr9!Jq?7r6o\?n]<ٚS*tP)N3ЏIU< y] UfI}MVjWir#!@ݣQ! @@UJuKqMp>*6ۏAb=wM\=/΀@Ch?븘e> n_XCzɍZ3As=ehD,goIz3;Ƿ tf $=Vi!-x~s? Iq}SVv=WC)?>s?7~O~֏TO4  W fλw{+,}]&jK#8ҷeu @='@盀 @`x$-NYvNۥ48(\h:* 7 18|c9`!m8qǭX}@tɪ:70wǃfzΩaӂ>7ݳνSSRdu͇؊dYj8ZW&浾EBB@W03 D@z})zp\+{篺{w_SMX$*$'Yw.mZF7?x3k̫I?~^*~pr{5:K'A.6Y2զBy|iPz\Yh,I^SdU#!@HJ@VߕصL<=_> оeXX,;?./o:=?|arohJF_MϿ3XGk$AzRްi:ڿ+oꆴufk+j+e:|ͯC #@@ $  6WxyVC?/׾yvC:X}_pէxncs^ölشbr<1|rҌ]O|;oXb͋d!w5/R[]mVV2@ b30  =`{lAN~k7iajpLbz.9\r;>s?6W\^_\4RPg<&bb}A*^'v:0nߝKLA LM7$]oY]Ydk Xk6$ @+t3@K쁯=bz@?qCWrZ3I4}džr܃/8KroԈ#𴧜x)fk?JWվ?RS{ 9\e\{-U)IWKpGBZ&Pr74 PO @VYe?n'ovڽ iWg8rA%y_* +s9)7\T+#: ؎s/}B,<۸=j>i*OEԭMuk/ξk!Y)ciB6y@@d zRyCv0~۶>qEC_~K9g'$@ʖQټ]pשOH]_T}S{Ns6 >|۱g,AYQ^ZG{-WiۇlR.[@G }0? 0&ЃeY*WνlpJg$rEЯ K%KK2ɣ+Y?DLMѽ|wl[rFETV~qtm52jlKMQ#!@#@chHA?(YwP<q~۲^;}c@3i;NT;mzwNt]"zۇ.Q"mpT]]2 V h TzR6vz`۽o"iTK;4"e9y_y{&C]ʖ듮M^Mfe-L+m߫؞>u ֥LDZVղ(-Gɨv\k  S 8Yԃq^{̞ ߾ofTWO;kۺg.w{'<=o_|a0ct?}#wzz:vQCݶ+Wv́yׁM+fjeQRdF `gP&eIYtvSo653wS5y@ɲPfSQgszW,gȍqb,sֿgpk 4y|B6[^Vt_A?n~%QmloOS6 +5ݯL %YҤ/@UC/=rrVpᇷO3&BSx7-8N_ߛs\iݦQ$?4Ќf 28L`W+vٗ.jw_PRn!]C~y[mT  3z!0ZgYJ@ϫ]o_w#+pzv.iJ)ݠ_,)xnrMGs|Gmn'&7mX7w4~FD9rIAXl!{`}cڵojǿ/MHפҟmUbm +K}O+e>~>&v @8:r"ȁM@q=h<]37V;lPgTEw{ڍ)Š}#7Un|7/t+v~|܂~.R!Kmk֦ ,T2 @t9B`t @`6o.m_~˶G_ x׾+Muz;@&RqkZ=OcÏύ\n){Z7{6uEڗLEtZY5X >L4un#{v7MV8ݖ6׾dKźr2 , Ȓ&}Ah80vl="5o w>޼coV'5A]_߿f}nܝ/ =hJ> - ;2Kk73y @k&i۝{MW-Jinu{~o۶j\mI$-[@1= Q#8%65/uTWiE @U:7wl] Q{/п\;ܭ ::6GM ثRzm}שc>Q:yûԅ735|Hv#)/}}qdפe6Ն t`f@ 8zz.ezP lnx#O 48'Ph.]_,.pO_8\qZ>%pȆS:Cqdm^ @?٬֍W,,4:T~/X]#~6K-Zf Dke( N Hqp:k+m@W ܧ:ySuc]\e{x~G˗-5n_b׼֩]gۺ`=vݛ:wߦy~*C6-ֵ2u  ]ތ,YAtT^إWg^𥋮\ӝwc3~jťn<s2CYy?ID`bb\~P7HeWWg Xtj@w\=ӿU$~?H='%:Q), v@@fd ؃x)o/_9i>ظDnȓrŃeR`kW|[V?iu޷~pu7]}R-]!jkEj?"ekI`ACA2%@ St4C p$ۼ"6o[*^ɯ_]>2SP(I~|qǜ+MDΝ'0VrOm\L䋔eB,}Cfy}{˯5}ޘk-~/ i"͇to  f`! ϒu[k NWp[>y>0hyV:D Y:Dg=oc[ |}+A: qmҼH֙k+ "k~>BVR e"6~9y@@p5 街=}ʺ+n;>w=tPa1PZ>YYra'Vl_kV|UEj?0=;;=rg/]8'u?TiC/EJz茿|h\ir7Ȅｆ @Y IZ&8үۃkUU{_wwxϻݏM;{_\ ༻;_.չqɕ2=8I @WN~_2m\n@|ۖW^ӑ߾&@*y$@@ 7@9Ȗdjq]ӿTWt T_o߾_MS:[Or'KBP(ߒ?\>8)i Z1Y_{M_S{b;ulvjEs w?dsQv}_fG ICI*CuAF@P3 G pnE{W?J}7g 9p r:};{^_(=.Wp>dVo'_R٪u2`iǮ};.o}QeG('?e2mI -:S =3G@ ;z`-=&碫v~vKY7ݳ+|A<nAUm5ʿKߴwjq:fK?rgܣs՟\< ەe]zM߿cC>kM}Y];djծͫR]vL%m1WNF|!@$2;I!$$z$>t6۷[w8 AKGkkJS-{{i57~w1ߟoqRk)\]*~CM(ݖW@%@3@^lz@ XiWܽ};?(8{] +u" ' G+\wG~Dk@~uTwl۹]R_w;=r߇&ӮÖn:m󺟫*WJ;T.ծr  cz&zpRKER})΀WV Gm/_XvZ 8/6GWg=$3== $ "qM(.((@] XpɈ,q`"99 afرxBWu|>={o>[U-x?5)ٱ-Ɏl})H {iԹ!@ٲa`hph_k4r0?طି\G2^@8B6 @W& >=@]dS"ԭwυ? Mع ѿk\p_b͆)SheN5 plIC@/|`K+?wuUBJOk~aŘи&%G?Z8_􏲳J m+%H#QGD@D@L@U>^D @Sv1M: zӆ`Mf{zS=[&3ioҒ헼Yk6; ,kYf˵;7?/ͼ<_C,J1o-۶osMQ$" " 5M@+К>= qG}#swӖ y?x}]?L@޾&ɶ6uݔD]P#OPg|u%} k|ק?D^igޗ뗯YH`po}?ϾaQ%ʘP$" " 5I@5yZ4("p"y.?B~Qϑto9?|톁GmmLMZĔ,b1%S~mA/{y qr]Ηezu 3_*_|R2G]d]_r S%WPظ,D@D@DP jSD" XLcdxG{<V2臍z<=gNj9kRI!084kd|,}UcF+?W߿G_>Gkš(m|u($_ԙWa}YvJqIJJ" " "Ps570 HD@B ޕ Q2,5&/~}odqZJ-}yuHݽ"+qв{O_|ߣn xIkcPO2-=2;!1 1udJ&E@N bamԭ\@N+Ɨ?wܯ\[#Α>6Eԟ~q3?:G /.o_y|'~;۱fqs&)@M@M ND l0Tp`|T'jܲ%00+n9˥OoFk_:dᕗ$ucS(8 A/㷉|X|9&)" " 5K@5{j40|* = "#gl*8g ofIo $λ\e{񭗡u}+]\s 2d$pC?$}QrؙPMlmT( ]S J $w4>`)'su@hjձ@ ,"CG(P_>Q_dmGlP?l?>JN=q^g voB3N@Xoy;8sHNE@D@DhN("P8 l` n訃̚kg+9H+|6ltk㺮.h[| -ך َm}_DbvOJ<`K?tڴ}ji 6/b:k"L;Wr+ḳk 6wKz(ӷlP$" " uG@uw4`B`)kmԭnLpϕ'pΟړIJ&~RQ|rqK,/Qzo_#~P i,@?l34v:lq (" " $ jW" "`ԭj;:ڿ_%nC;섋 Qype7>r1vk R g^HUmpSҙ36!aS}u*DM@ hHՠ@-yg.[Y|AҜ4!k]xeNwC9Q3^/<xG/ ϳ q/9J:LBy0cj,$w6>>O_D hϟF/"P,БF=+hk;.PO&7ahnMs7 )q~3

u "ԧ_"P&ݗwnMs]&6aNU{kWt58=6 :|ksnQ,%ȶT "P>@cuگrM/9U ;lju%뮿hOw[B?\}3<5Z3+&~ ⊲e0@Xm=׵q/ؐ:\QvБr&J9e_uiS&LL%&ۙtG*hwLt:N\>ᮮ3ђt;FdK:sKt!Ht!?H;=v?1Hg%X948j`(oU֮[qu7n)g~u\65(ΘN}(闕uPuvbRD@@^Drhd矿}wlyjnG`I,]t>]w9 W_S9o/se 3m is$:H(cpHmqyt`߶~͗Yz `/;=g-ן`J۵f{+J&g`~&twGebkj;xǶky2O؟m Mlڲm&JWWW/  -zve+^_7={KZJֱ~Q!m#m~,C>_9dF:NF@,qj*!םr:64!3/< q pA ~xWyHSf <K@IDATon2ηeh8GE,qY 8@Y:l9S69-;VW μg"[ŗ,lLV)0=8_-o{_zvW#K j%W  ?6>m_O^v՟_xϘk4{|0c`;/r&4m4TE@ KN9$LULǟZg٥G,q XA p6nv[lI~y?;Q)%УW70 /r׿ۿ꫸lg>VG|R}c˲z.""C@98htX(/[;RݮF?5<=~_Uȸ 0hfuM|מ ?-eXlcҭ=+sd-'O6r/X 7z{-w*)72!q ui\:ט1.B!ؐF,: W&hjhӯɋ@EӦwgoq-sOqc X2eˠA>J2l}9L|37 _c(mq6Z>1"dKtu`%w"=$kZGo_vO>_:'uWi lzk5 OYhzW pᇷ~߼7)o3^ۓD', ZdMm+mc3zH$>`eܘYu!m60(Foy ݟ3䊲ukϢ;._QwgⓉD'݈?{:iOHS;۾iSZ}^nupyRb!yC:іM Cy_ў#yj# 2"P3P3B$,Hc܊ d%:-beQMיG]vq&Sۯr攘?tHG&%, HI0e'OJK*"F ;}|]?Υ%?ww=sx= LJ|(#…GQIڭ&)L@|5wh"]/M4eM iĢ?h˙g926?>_ߟ~~n7MPl$m3gH#k'm钓ߓJhIl]K6 Dk*sO;6?.<+ox}%7q/^ xmҏ:e>g_lhx=k# 2"P vu*"0ᷛ& 'O% SrH(bJڱB6?2Է#&C}1pdþO%YXɾ|iA 9A %+Nd2yo3\J6Dejg{g:f3}Ϫk/ƥ|2J6^d}_} 6};}2Z # {f}^AgRSHv1mʮ=W_[y/xY׶V@q0菒-$-/XZ7CR~Ϻ,MDN;4h9֧\Ľ΍xdo>:] \tMv"πCGd>c? t.qAgpoAf}Qm85l97;O(2ݟly :3j# 0wL&[f?"C nٰoKG??{{oݿy[iuTfYڠ#ٲP>dTg.B@r5OhB_.7Z}/?n;Xr}1"bRoL2i+1 /"eozn?7X:Au )q=R%- Aq@PeQm d¿;;:N8b W[=3.uuϣyڈeȏID(+}8՘@x [fSS'ܭ_{gSn| ! yV0|pdW.[E #GuF| `3ȷ=s! [6MD"omKSTViwlqGx:iu;V {)l6ﲙH;.9nvOOw{AHf_;_}c=SqLAe:|SO: Y[DN34m4IE&qsodhǟv|]?*.qկl67R$upyS3k>6vc;쇒<`ru}^w˽w}wG }æ΅lcF^xU S} bgzquCec]1z :aԣC2AgV~3m`ͻl&O;HIuQ3:{~7ױ2f2@ HL}?>/8[x/q__Q6[nu hc>jk:%d*zv"E6jJ"޲Ap 7kl - >x$nymhh𩁡ٰ֬'?X􄫏@6ǂypٜ]<% +rKdva[zA{ԭu'mxu+Q"7 xY>H,}:+, Y`Ab=0llFC)"P-Sz쾟~ߙ}'^qݯtQ::K~iׯdIH<%" uB 7qGMۚl7LlH'z-}apxo`Uo{ǜtS&dԁ |lQb:%1ˎѨlJuHYny_ΣT6?\;̵H_OhǶ|d}3~|6+gS)f'5vhlgRD #,CM5:CuJkneR_lWRJ" "0 ko]0acͼGJ.ˬut(lIkm^omWgd$@* CAqHJ2i<[k0|6HC1ӎ}6+gSkM6xzJ"ZS;0.9vgs.Knb%|Z=TNlؘg9% |4'Xx!+@ ̙:%9J/zör$7 )+h CV*1pAX}3uje!hS/VuvHgmvnhv83fΛl2nwv)'SUM==7 n|J>2#l69 2" 9SF% 'He M6 h VZ$Pw_q `ئ`ck:ĵ9haJC??<5mK%osm3CDʞmw^~Y:v'ua_μSA?̖C&V)" Yx*@ȷNμгm7gJnv"E@wWn~ᣗ?=My_i^A_G{lB={#VT@a)"P삳@Ihaaۣn:q1D;J|Ծ{J_6k+a$>Mf7O^_p leV,D`Yf1$Dr.DG?ӵ? oul=:fmOqSDq: yy^NI{MmR`Jy$Groؙ/O]y]{#W6v"E=}7-3y_"/<Б 냬hh9CFYh@P2bE :}6K' }:z ~#ٟm6H(2g3F63knw]S=a@Utvoy?q_o + `M)̗:_,IxM#&$ &<隲4  M;ڭ6ij5r9DuikڬzϷ[|ciLAO]OS]U<ά$"P ޞ~wwOyͱq`#꾴M #DŒQYR@YWͅNhp6T`2 P2ЇPO}䩏_w۽dpǖz?(kݗe6>#$g#ǻ7qx{Ͱ楊AsS}Io{iJn0Cڀ6-ﭔ=f@@hMSD(6luJ6V2Џ ]݁ koxTzHӪhyݢkLh%m^l}a+guQ3fo>j~ƥD`O=['7mQgr3=0V[+@S@SvMZD<?O;$!+S" `sS&9@=3Sr<̗CIi^H]={t@&M#>iD?ލ2$/-1T^CmXD@j vx3 >td6^Hgtuꐀ{Jry][?<۴ҖEhۖ8}ޚ՝t"LԹՉG|wvkMȨw `M)]}o< QG6$k" |01A:%?g ?(|fN9w6зRp0#{o^ﶌ6[ڊٮC$֖#G1bŧޚU;J"  0kч}\6:7D:ЁiԁYfKim3I$!gXgB:$~ʨ?wʜ@~6yOn݆ǜRpXyDi ?t?ܷLM%p9(#"PvS{'`0~ }i7'P&%tp0D Z]|E@D V<$[ acOɠ2'w3=/@"}W}a>Qz gm?]vR)" %0ӹ{o|un?MI5gQs(?f L#o%7߷ewg/$6W\[JuD|h# *hu_Hu`=|+g"EK)wT.!wtq? aý2uEJ"PSPSC{^lw)m c`۠7 }f˧:JD:?":.w߷de.w:#rp{]wjk[opv`̀B7lQY=sT X؛:=3 <|,}C镜dp?PK LP !1K/ګ-٪p՞Im?RT v:FCg> iX#`hΩf$MK &xA|l!n0dneT0ߖ׷y1_x30! p̂Fn_e c^k[RXT" &0kz|5Ā?}i~6:6K}x=Y@hhgTB>mC?kCϼ3?m~AYǷ/[9t/pz-'(Yj 8X|dd=?ȷJe,ޫfk?S\;6؏ұ ?$mo| )1-#$ G@ wJ5!^nm@AH<}'%XrdmHuдAW~+Nظ5ؿ~ꯚ'C}@@G{[rEv#Nw!`>k&a),/) B@ r"5  ? )M!>)i/T2glv_fpYW444"c}.orsc%C2্yn0gp SwLBɗ#VH:' :?@. k<2Y@;k`_+0!#>0xG%':JUb&"P%sfOf쾅A~1~F/q[yH&g5ٌSa3okl:rJ$ I;&韝x}CEJ+F-#]HVڿbsdXw͢S~$l-"}裮i?O2nyCq Oݗ(`W$ yZ5)@'Qa 1gJn}nX㡍c~eWK׏RHotC*uYj0 zR]KkME@E`7ollou)9u}2%E hϚ,"03x'T'$SQYF 9V^gW!IR% ǯKhL8= ^~|j/G?'3=l'Bo hӬI@sx 0 3triWyVz([`~^XXm??/%O]2@ݿd62w͞S&uuaGn8?}??$Ae U=?uJ@uz4lq@awdlu2 vYh7nݺ}mj@#I"܍J{X|?S$~OIDtvO>概>e(ٸZ654;[)MC@Ms5QhN1Ok&ȇt| MqҶA?f3c|u  IKV ,?_8)LB%!=~73 Ϸ /@je:# :;a@@ t[ M][lQmpQ~Y-wuO;PIzFz﹦g솿mT*"PofLm J3g?mFeyJ"00R#P&d4F>6_>QK߼.``pC=^Dڈ++buŻ\ˮ+ۓZr3 uloux2ܓt,>a>Dȳ z@vD͏Wמz~Wtxxx9XI,HRj'jfB'nL%ONՑmxs\ mo7=K$bЁ{=\6'2ؙ I6m4lE `) Bl;ʗ!:(Do8Iop:&ӂL(v,J $`Dν*rOn6u~~2kcp!r_OPVPgGc<4l!mxt&|Y?Qcm/1:pү-~8+M,Fˑ(DVjs{Ўՙ@UÛwdɮsЏWq/laW' ?@2? `At(඾~{6ퟺoueԹ0|v}ǡMicѦIrfTM3iMT@kk/͟ z6اΠ6: (CmPE@*CE@TYDWAW;V[BƖ8\[`+K,T} `QXx%7:N@%&!;w##^a0_d]Ȩ^'{YDbW%Pf@}=Љ?Xg-뿺_;+ЏL"ކŬR =w~$EE"  H{g]wnD P2#,mD@M/u\'f=χ>-f'f?~_YNۈjÕ| muձsRѕ;jYD |ûՍ Q~l#$@8ƦJ&N@+"8>\} +Vqgw``Ř>TT&Xb }3O $"vf:ݣRn Cf!֣NɠmQg)$uA@`Kq#rkxWrpZ P뢫 r_❴,]]]}f݈3Xdu)m_e6};̓_<z!hhQۢl*{7JTDl7m3cZOT(``K_!y;l+@ME$" "P#QRgGoLl~#ݗދƔOQQx 7I&Z'(" "6}h;ڠ:zJءX/$2p1(#5F@`1>rǞCQg1_"s3G>_x_^zZR,l/ϗrIY# XVUy%GNN%? Թ@My 7Ht?:>'A"CŮ$" "P x q:+g7c[n=u@ )zNܚ:9@§ߗcS !a@?! &{$mS$ <-~B ?xօK-lTt.v BWןpR*83++" cm} >!qvؔD.𨋉i" "Lb #vn M'qٓO߰a ,6 Mڦ+[xִW]xWID@b L3}wn?9 =*;ri'}zXQ{\^'9Ů$" "И[ )#Onwo6 1Mܬ:p)|u'ОH%3Ԁ@{w&vfeFC;l:%Bgo GRN@<`g6DOf/;~(W*@k6B#E(t7 ^6x[wvx }|mveJ"Pp+4.6<}_2菒̀u/9q0(1_;ʋ8wd%q4" MH`Mfo榎v?g)zK=J7'c98!@D<J`nا2 6 Y<`+Y@BsQjL%Yr"ϻeV.]D@hMZ?7s~6=Qz&m:=8e(W$ <-N b 2gK?JNehkmb)S2~SN\7=ޱI`ۍK$ <-@`?u 9OK=[mRcDveYn}*>c+։hh;lnnDh>m!g ^A"\J" " A16GC7J~ܣ\$RrZMBv62J%SW,"fNVo 0X}*.o˨  lFJGC:m"PuD@D@@)6O=Jë׮{'ok 8?߇ ָ:VtqP |*69l-&٧-.5I@(b a7y!0k?ڠ*>Ύ":B3T%,_lm1Xԃ/|E@޾[ܟ(|:6>ʋ@Uh*թLM C s|16&Y6U\,϶]Qk춓%۬ } 졔{BxdmT`zhr6?g5՟R=@.6lXY RD@E{mk+{qeh=cļg}@@͜ DD@*G )sm?g6= Xdlʅ*X=/ݼ-9i+:AD@ $wu {adPo%}iCS'1Z)d} ' ]ID@D ?h6J:[ } n!2J:e +_̻(V$MO`6A}?3y_G|6D9{o֮EZbWhEn'! Xק !@~_PWűiL" K`3hZ8P6?Џ˳/]`eHVDEWh"$3ط2) HNxsI=q1J;v*+qlZr[(" $toy_%,yu-J$E V AM%\Cx R?lO(_jP[-vrbPF'"@! [}Ϸ5lL6HPcj$" "d"`yGsXd=]{53UDCEdD|~5Sοk.wl4Ԁl/yP yRZ;}Bgb9\J" " MHMP@ύG㸧G =E tEXE)m:e'ƲqɥrKOUݝ;nYs=1$&(-OM`S(/F@(r 'wؐ| ```hYc,yS _\z'RuQ$ηmp;B<} Qdd>S0Z6Fd5hէMA>-~N<)_Em4dV,+ )XfO$(E@DD;lg5{߳:~+Q<-vs#@ E$" " -MPoIegLoЧ',I]q\Lk~𷺭e>]vwCj@D@bӹu83KS}؎JQU%DhΉF$" Dn`\9Ah>c_z"Ӥθ ƅ%n/g?UY" "PFsfNuB$7|YH]; 3Y6ȬP[(]*I@E@D__l){>#x4FҸ-66oAL0Y3N1]f1 yJ}r_6YH3?b_mT z#=`~yW0d hoo{V.t/YD@DBzz'uwuLWdO:)m;y$ʑ<"P5D@D@DTc6҉KmE</"ChuJߟvJ[[n}9hw;Ytjp7v[ 8޿l>SБLYt00HD@@:ݲ9fZYڒɜqC.,Cz)oPbl9m{SY" "P)orc=Bn2>ۇDʹ7"QT(?GW" " D {0͑Hn9Wz.{C!v(,6qe)N| 5(ffO؆R$ գ}cYV(LmLdu!" M@| y§M(.@C\xR歎r?ec[-,9e;WkAT9ӱ`k<Зm+@M@M FD@~Y3 6Ooηy?dnBh&"PsfNGpqP/D3W}0&?oˤ#W" "zSި b֗:%FǍ߄}?D@&齡'x/D_m1ؼt00HD@@hJ;<ճfd7lJ>|~/:v#-k"" U&0cd~ eQ/lVgy,7 E(( E@D@H |ӦD=rh%utk}>|3FNID@D`" ttwl4{Z3{>.X?sA/#ѿ"T6*WM@ [gFBj6jS}L(mL(nu&" A}?c!@GG[G[[ɖg vY"e{GC**Ձ'oAk:ڳy}I?c6cLJ]l{5#" "hIo)E_˛͊z q̅%%˙%ۢ_H<o'I# {n;ng6ֱ-jh@" "PNY36d\t2OI?_r%C}d^|DQejGxF8iˠ#ψ@ h€ռ4܏ok9}}YVm[~V+ic3 " "PK:{s>Yf%t%*mT:#0<_(ΚQߴ]eE-ڬo[Sf@ loO|묎QimԭAGK_Z " nD@D d> ЯtNmRe}XFVg9e\Y-6gIUgڟ |SV@d@Y0,aJE:%ge<[~mɬ6$E@D` ̜:O>f8gЏHD2@@Ү.m._f%|hədRRE@ji`io}IyF֏:%}! 94d*o/TN qYLkKQ_fAdR. )@L<_2 aS$ <-/tKbjz#4E'$R(?R26~mNXr/6wnN2ޞ'xĐ~|To,db[=gI00HD@@eZ̴λ/$ѿoc֗vlg|Ot&͏{1~:`=$elRIJ@UůE@Do%֎6GF|#o{ֽ:AD@jNnFuu}lYdu<$E"B"Q$v)4DR!.63@vQytǼ1'R^tZ'Y^fkaӗ>f}[.U# W" "Р@gv1h_@ڼխS_C[N_~}W0" "Pܗ1{գ:c=|\yT?@hjձ4&X>PhT>e-YVˬ?|3N˯2aRיӢҶ6궮oeY]duVr@H +aƴ)]RlP=e&Hș oC;mN:[S^*FWFzW" " G@_X99;](BgV6VRW'S>oP⩝1,CKC*ng$ZiGKE@(7: Z X2HlK@Ush,/aƚpg3{Ӥ]lsV}2yX[;e%"LF [T}y_MI)ӡ@}hzxp)SpeQ2Ev=_197}]~Q—:%SϳLmLfu"" Amfs̴21u}vbV򴅤oc%Ljd$E@ꆀ ǹ яڨ[ GT=k.U'  @D@@{m~fg2{rwWf |hD!yI.רf3/)" B_Nӿg,/K@Ush,[lMl`fˍCŧE*YF=ּysARD@ꉀ{D_ƶ>Cd # CD@D $R-} S;Qʼm6tw"ʈGUCZeq!l"P2mNE@D@|lY [eԹDꔡv~z@]H@%t6ꔨou=EhN$" uL _ǣh7[ݖ2+i uhKׇl?ۄ" "PO/:{֧P[T[_T6]@8k_×mx3͞95#b!lGM>~y!-}@$mDQ@u9 ]?æο59} |=d9%}!r|&uu;slƗlַ#omO럯=DRtRyuO) H:[ (,#ڴJ" uI`C`=1cfuOg=|*@Y0V pL24U>@u[:-6[~/qn!ayĕ*T6 XNK@{5s(/t(ټw).umAZ>!'v{AID@c6OZBc:P "`UD@D @eRA`mpKÕUJ(OI;L $"P֮[?`s3v~S59M[WI@EQh> |̌| r!()1PVGR@}pG1'2_ﯼT6*V @f't7x#lD%.$ni1CT2 D@D^ ^[ 3-9CRLn{)T'L`9GÙ QpclQd{v=QE@D^^t7T.T6*X@H&)N3eVס],ZcAvb=ZJ" uM`'K2z"C@98([hnUt׷ne-’frZ-] I%jroʂB'J@[@cp_nf`P&=fe|>R橨9p+VUm`E(|E@D@c7uc d7o>n0mZuHTwf ,EA(k4hX)&hD OXK&Q,DDD**"M:lgvù|>wr={/y΢=sֲM;6 Y%6,uh"mzg2 sѻVFfYb lq@(Z--K@^AM+ h+o(.ʛ HK1<}<}ZM{H55 EM^6 /t^w^A?ྂ XJ@W@WU" "Pƫbǔ2 bY;l5Ic{u-s)vzhTD@` .ˉ6jk" "eX,w AЫGmIgPu,v_*+1)+" L`+ڙGxYaU-' _@D@7m&/«WU2)iy3:ŕ@g\(cX~?m͇pg>rg.h9d jkeE@D ̝@:1!Bg>eE h .&!" A_CV.YnـUUǢ vu!z=*" %A`@WHc2%~^x-[D@:C` L:73555|q5itWЁ f}KKf!t.c m̥DD@D [*bLKoZm|HVSڜc>QUD@DT,X@hiXG:s^&};ޞ+_:D`W:[E@D@ʂ?ކ=Nr ^,]`^ Њ~)"PO*" "PJ>]hOXꙃ>1˱MPr"3j $" Omy_=r_@:яqS78Zjh!0wޢt`M'm}Za}Ps"S)n &" K`slfDg[m[ۭ?M,CMnN'? @D@&0{|~`]v9Ӯ=ڛh}D hk(nun%Ž}5.9kUPG /z~ݻmR$4{9lG'y f PYOl/A@q4 (| }.Gv[b70sG/~"@_f B݊xm:yQ1a3/+9! ` " "P<{~n;*Jc555;n6l._7ގABT.YIcLi'Jm䃺"!ǫ.))4wqmqA[Zd|ؗx_@)ŋa]·1s>E /TD@goH}l.ُ87mз hd6ҍrưG0ϘYVWJ*!Y" ,T7" "Pb3Jqm|_wn=Vǰ1pɹ_?^ڬ֫5@:SޙޯPX[Nq?!9"U[YT.hhV)U ۯ9s-;Ѳk*co=xݪ{檵*H%{fbݫ^+❾q"|kuV#gjt mt Vu*" M{Z) hYV*" _hnn<Yg=-z9-ۅ,ۆЯd: гۏJ/h" " Lyktu}`$gX^m+_N@YGE@D n&^Y^f/" "P.fϝ/\Wh>-Vm|9m'N5Y4CGRQ>QQ~Buȩ@@\ MDD@O{ د?@D@D@2#0@ }ѧg{ֲ-ϳ6<ӵm@N h 5>ڞf٧g@EEcSsӴg/[LۭTt䆀6rY@}[7s ~Xxɒ&s8'*fG{cvַWJ@h K Ս3̿[յTZ4w"0E}@( ׅLsQyKT[EhЪc(.SF {}tbqZ(w.@bcGBab?lgBc>Ei@D@!Cb%Z@xo>`qPm=][1XN@y>ʁfg~gE@D@Dޜ(aQh}?Q=?TǮx_:U@/& " %нzFO;p/y*żm[3gчe;ȩ@ h 5̖X˜f!" " #sGa8b+鳝.1Ephpf"" 9#?nM/!gj 2g&]j칬#m+,@@(6=*~[xi/ml}F:Z;xnmXǾmL_V6";~^YX3lD@D@D s /[:oz PYgoYo- mv)I"K%m%" y&?ۿŮT4tγ0gVl[6yYd<˶"7z ," '0!n^]#@Lè/ â0>sX<[!gKT޶/Y' #U" "Pm',jV" " "9'c?`OlO\'WM1g_\"7z ," #?uПU*Q5t Ʀ1Zw+}1oOcriC9maUD` h`/&&" !?١*NED@D@K`74Y@bct[yZh moq~FE0#LjDu!" Lͧn^Uͱ穹@ޛ?6 |Ȣm(I-oL46ˊ@@#" "?㟸GMMa77 ," " %0/@Q~#0"I@yY4)<᧝VYs㿸ߣ('B8G}Xgn]v" "Fnݻ[{*b-_(WߞS|[K\6oCmC߾o %@ 9" 0" ")<▝++kt/\R$Ӣ>B L|n ض3jLۆWNN@uPD@֝ԑ\OSgƦ/O q+}9!U)1ۇb['_rF@j $" (|k*Z5" " "P>f͙u fް¼mg}~s#gmaQ|ۚ-2"y% " H“V[G:&JLOqMaMf6mC/& 0>rUN6(RۭǀKn~SD@D@E鑧_0Gs>>Q"a[ӇU% 4@|z=2SD@D@ +?GVziQg}1X|ˊ@A@A\MBDX POx]RrpEB!SgXQͩQ#v6nϧз>cñ66W/L0ҏ<@kh%@?7J,i" " "PJcfyv">-:{^G| (1"7z ,"P(G RύWƆulPkќE@D@D ̚9/`nP)~.*}ۘ>4mD@ ?3;ٹ;4(cޘY -V36vOo?slâЦ C 6 jh." IҳlQU]s r>, _`S t?s> mkylI_OL$ |" M\cM{_&ܽ'ɉ@xޢEߝ%@TwϺP͇bPNE 6 hB" &@yL}~7bS||K㋀@x};5DtTa=E>y{y@Q@Q\&MRD W(|jnr5;'ccq)۳q}~{m6"P0P0B' ğU?ϋE@D@ʊϖ-3~)Qe6Z+ sCmk1|[&Q$!o" y%@oN4!_n;˦7NcbZ_u<=q4q_B9b m(~p54r'pc/P< ck}1+c>T P<""EE@Eu4YlH YlT" " "it[3zQhâmC }<׏[g::Y(H(ˢItaήo=~^_Ʃԯ@fF2# lH3cNmaL~%ۆE SD g]]M`OBE_𾫠Pmy[K1OO6~]<>Ø> mͥDE@օ+^۫owץ/#" " "}Ï/zЦe5㐵B߯u&cPl$ ,@6POyUحW}d3g_c~O뷷ml|1}XoS 6 bh*" !@?vq{ Ջ@6 կY3f>CY!!gxfA)ECA@\MAD { ;2^q{<^ID@D@D OyoUuMO+S|cH~b_3S>YgsW$ lOqݫ* mǞ{mFČȦOgo-el}#ocL-~=6|;mh" %7lS/eۭ}|%dO'nfZL( w"~sR>CA@\MCD`@Oz/Wܻ֭%" " "kns34wJ~֧ȧE!zkڃ9X(:SXEw4a=^Fy{UE" " "P\xu+[AϘml}?i}E%TZ"P 8@gص[M?--ۇ[)+" Kyڻ?|msf]ٟ,oܕY5xPnc7`/+hf"[I3>sZA:),D>lǶQ ,A_'B# B"@ZSv^,^qk=mcU@XxْgGއF;-_Y8w"c;&m5xOaȏrAB'0mO;皧7#E1} uZ \1} _B9b(@\ MDD'0?o\[._XD@ >5$4|+^B!4%V8蔋܌R[kߝ߹;gοmϾlDp[@~&}0f%eMPoŸcc.lCy( (ˤI@>/ CU<[uYV*"Pj{dkck+\4{}_1"P?Ϧw{пo֏\T=fȱX?2ڱ䝀>.K ]-whc|ߗb$p񲥯O|2PЧ Z3o߫GO?X!*Q#0Y: y?v3=PI;}د/%B` COWNpˑ/ke@90nETL6pÓ|v0"PHܯD};@>`qsc"EI@Ey4i(-SGXnUʴr%0ᒕ[@ۃB%S4{_{fc+%y%O<6b܈I{ -<|{mgb.9 }G W hN"P.oɭx9dSD<ԭiG k;(fƏowAz۶{GM@y5/O܌6)q9Ϩ癃@<9,%OE }./Kًׯ7|6AQ6?Y/',](05D gg}4sxGڳ9mu,EL~=c#Z#" m@IDAT*^cAl'<(Tw>yenv<++9%g~<q#?YG?|zZ?}X[PB" p*k" HୗmSU=3)k" " -cQ$XK4Ky+CӇm|W;/;_EJߏ7勉qg(PPb}dEh.&,K`a;4VUB3 l:pJ+r 6|Ac)p&Ke+V-`.j"]B-~FtNj l|6ȱ1e[>}B~+#I@y4k(:okۊxlx&," $ɀ _8#*@wݴ"?/]>Os\@<3jAZ1s"Gۘmy sOHqA@A_MNJClV34VU@z}{tO*Yk#V[x##rUD 444g jy i?gcyưslc٩":ƭY"% "p 92^b)" %{>zX!ΧA?F@φ {`"9#.Z|֟= Oc _p%meӤE8xA/n^3,E@D {⎛N,!!&@B`KW>GFrBއ_ӍhC[пPΞzlG߶ |I)-$@@_ MOg٠1/+֋ytNnY<|+6|+.v#Gm }he+gt9䥱Sw4s~l8_C߷-UDd$J%"-DD*5&]!LFs|٣{_} ),l5V5ώ\2zd}g(&PX8j9ĨW% t.i{<S3D@D 7N=#Fb#ʷ"NJ }>hW bNJ@V,Xl{qV3GP:7X>lbB#B$ B*1F;}Ր"^." Y#lA^(!\Go7w^>07|24^ Q2ce9o[r"PPM$0yݛcxa[ iV" 9&P]UUS ,!Co-?raO毸WZ=ˊ@6 63tϣyu!\[ 4+O@/ i"PƏiFE1aMRD@rDʊ Gŷ2v~Rz446666*"uϽ8~ꪺzܓuY{ϧC?rȱX(mtEP t_Vq4/Aow7G:BB9k)brU|1ѸIKim`[=:bهߧ<}9UD h/ '0}_h" "Ps!`LK=VSDk8)qg0iiVJoL{{ނELlj-h"%C@%s)檫7," MK{lzWE2J O!6!Cߞ5#-"!3)m'Q4}~F>-нe6GyR>CA@]0MW /ݹK,VqfKB"Э[M~q%29?!]~<ռDTD&M}*(6ON˜yn(珇[3)%J@%za,榖XO㈀@8}v6s@>Ei"LPOqC93 ;_Nl;϶;?8{9/([ԟMFRT|P|L3!0;t_wTLH&0xP?pS@5 s6(MO?߬_0OF p>aT>>s{uQgUD` ȨIm'EL߷oO|dyڂzH?E h//"јk+b-k|+" H`z6_/!AL?xjKDR ,X$xϦwQuֆ `X,2( @Xh72CD@@<{q{3WPI'`XGd(4G+WՏ Gg75P3ރhC?dS?ߞg{?4bZ39"PrPrT 'f$"" E`wڹҬ*ίa/|(`dnYȔu׳ﶵǽB}=v[o}[blvQB[w[g@_C@rN`+jܠ'|` (" %@';~vґMte E sF'6\dLc'7h'({u?igβXcl}\uW$ Zt-ߍЧkGQ" "P8h=uQ̄,PRD=?f2Pu"` m9g(?݇[l%@ɦ@h\0;~a֯W,EM )i" ]O mh(]uַ޾ms"PPQhED@J~}t~-+g=-?궿<w| cZ~Z0JO~n͚ql,+>Οu?pN\+m/HlXGnD"' "@n@? @.k,%_v&j)Vb +WJY׬w>__!{Z{Om'm1mق:H?Eh.#" " "P<*?ѻxf"ŵ9: nc/Nwd"ձS|+}!a6~?f?1yڂ6(~@ CBED@%{.15lg'5z {u>(Q;.lljnJYŋ~1$|?A3xc5M<,TD@DCV7iCXD@q_<>EΉʥRESctTW>446\zϯXUA ʄ/1(iQrLsÀsp~Zhz"PRPhni{O " " Ax} v_>9۾9 ,?f@fR[~`L9wSp((1xH@ ,\>wRcO " " A2@YN1}+c{cm*+^+DYxs/P'!!Y)AS[˼o'2Q VA[H?E ࡠ"" &piw;uD " "$w^}?\+DYXnyg u|ֱs@o]UJA= mk"PPH`u.9YmE@D@ V[ZsN6Þg^Rr ҫy,7ű)r<|Qn㐸G=>mLl1.so]X%<'o}] L~&lQ|[Ԭ?؊<~:U|&/0+Xf™~:KQLD>E?-y~93Guɢ'Q)a(ያ@.kWXUK_ CD x~۸ER}LDƞo}DBZ[>M8Q1WfV>E0GYO?}v>$@@]r-XO`.]E@Df 6?R@;Tʀ9CO5KPfO񜉵ž"g~;a3 DZF%F@rD _<Ƿ656ݛ5 67ЭVc JlUZ*ПJ.r瘈eROR>#((k@ o?O[Sp_' @8K;mO%m}=σb6H%˗uM,_YgӴQӉ}z3s 1 r(~@@]l-UrA`{sW>i (EoY?.w tk ~g\~E,ނ*%HnMϮ9,Xmg#nqHȧۗ1% %t?IȖ ^.WZϖ_CZED@D׳G[ss+ޭzXlcİ-@2uk\rO432cQla7(۳XlR[Nk_q䎈F p |B1Cc ϱ`97[% ({?<,TD@D3=@u^u׌/K wf`+" J=Nqo-tQ&p{=+ʶ*z:-)9B"9(q1uåyƲ" m[AD MWc'\S.14' r&pn(`o/C\u]BA D'?6ߴాpcLEǎ [7l B(OϽ4rKԩA"" !Б}8o\vӣƟL@mE@D [X6}kzΏQ~=jwRVխِa迶#" "PM/l5?跖~>uݪw*gżv^>W^Ȭ^LKq|V (7X٨u2/+eO&]%)!❢"1څ|c?V S _s$DjY( x@g6mͿ_wo9qw665̤t+Io͜6wl:Asmm!/c>ʮ\bU|.|^S[x_39lØ%bCm m&>'t.Oxߏ~q3g{^NED@ʆcv8Q'oǽlR~Xdqnjk-HѷcZR\PW_k2Ng~rut#gr꥿WX/9w?;wŪ0T Y"~]ڥg5Gp&0|㜫:3S+|[?q!GK>QGNk/ц9zs>ϟ;mO: ""D@@;xcƴ|/Oxͭ~iM@}l)+" %A7gn[HH\7~<-ac]2![Fo݈+ Yg1|,[go<"?d\b9o]U ,~ 2mDk aK<,>io_o\z͚v_5经;>XD@/mo:ҡÞsm['{h1瞁x|䘧O簵1F ~?tp:BF$+,䉀t}HgF.opڌ#k S&0kΧpy;<[~mm[y$麡>g7 +z9io-|աba= /Pk~Y+c1y=-7x~FVD@ 1ߪP9ݶao|-Wwmm͗~Ο/n~g//R#$YOqβm97Ώs-rqx@*mP$" C?Eg=?bֲs |g=Wl]k{J8!"$ %E@:AЋQwgd{/XB}g g^鎛N?<7xy o0k̹S˸ң{D'g/~72b<{Qo6}_žyƴ̳ƨ9 ȵfbsű !mEגE  nm0h-:χQ]^*sJnMuY>cX9k)oE;}ko99ru|>b ĴQ%5Xk>c|Q8PGGYG=a@_p}@[d>k 8+|aeW?ִ|.>拻ls%V?-\p19OA`W`<{1)\e[kcLX-gAߝu)EP  H4HGZoc{Azx\}FʼnsS>vot7\st"" &pϿyMG XgmE 6u/ˆ%ة/WWC $Kз~η"Z_gl183u· kuFH 䈀%OţJt 4>lԁwQ)zڋَ6yݾqAmz>UD@D 'f}}(^o| -Z+wο5<+~?pJ 4466S/3i@?Bbڿwc}Kb=eޗxvN;bkz\Up'Ȉ62¤F" Q2ho#Hg;s}^Ru'~ʱaGWy_uףό7уbŏEV4Yae?rV[?0ŵ*y"`%]s&LR6tbڿo)쑧Oʡykۃ@>Zɥ6)E)8@."5HG V1|{qFM:eϓ>V٧{3mGMVX@Їύ?}a5U\'oN{:zN,VY/W{{ȷeP./r};y(ȧ D ##ЁM|@[ @[ !ioϲ?.+~ީ{}YwPUS bZκb9 (X(X0ZmuWnw/*y }n75c#Ƹ71, {{_޿&'ǴswS^rɢw(@ ht@@`(Oc+C[?)]pg v6m;ߏws;sգ{_L^ED@:J~% DK-+ `b{rk<vTrLs?CGxAח~"?a-G{g-X vL;fv(K))8@ ht@,mP?()ioOz{=Y[6N;ȃ:gmX(/" !?+|Ķ: )ZHo.0?uϕcTy9 >by}cAن1Zkyr\o]DYI;m;;)" >b+έobD8'Ez[=c+w4f?7ӳ/AaݻrZZ[Ͼ_7}Q[%E)؂EA~=zwmUrD'_w^g;?oc@L+)C>s'd9bghM:)QBO@֙6NHG"?BxZ)虃e.dm>36Sqrh?Hx~q_H&>9!QDD1 8? ^jg/볧Sn;o//z emȷN1ֿGxXk}l>x>bͼ.b9֨ ")>,"@'757 |ԵwX1 x[Qߠw?֑Uq}9.9> "Z8 h)X wm]J3a Є}3o-#tOޠb>,amYId6R=DXMFe!)imbqGyk|zI{m3O8yЀ v}_ysO/UlkBmw7ӻ[/=g&6"N>;j˯Ǹ;8٘y^{`} pļ7B/~;ż'4vwSHamR "5Ju$"@6 1D6QӲ6갢mYr7Qw'|R=a*" O`+o`Bȱ֊#CL !FK1FbPogSb /[zMZ@ ַźo:[>=h-ci\B?A?DKhKSM4>sϜ܌Sbv14~Svvp_E=X$bɵ7m+b0B  -037 ly;ӟY`WB~]r -C9o돜ް>>rW觳q97Z \n)F6)E?:md:HG"6Ϙ~`G=Ll&m}nIC.1{Ax""P:pOoĬBZ+ STRKٹϟ.?g={tק,':p6Yk?> X@.3o\v9Ƿsk}7\ (hR$Sp(.! .NE@&gqBp3O1|(Ǻ ~ھߥzҶ[nk""P"1wӿ'PX$*(( xKس}6q'zfUuu|nǓ47$ %,E:^w1 C L--|˹r !5[' gD@2(!KzưڡmH^i'99k Q(^oN{w" $![ !d _7z͏:`v2. /{i̔Cni^O q舺qGD?~}ǹp|v5ٜk(z$dE hk42 tu6(QO?I+C.'WkjzA*%`N:G,]/c B֊$_T+Emf\uw hn+O/Emq8ӷ>,s!KmEzȷbo9~h>v޾NIY3Qh}ҩ" 9! ` " d .`tV𣝍}=( Yk}瘏>W{nզ{a1*" A~MC/ S_bfLac-|lO9d xwj׬gƐE+Wխ_O1#3Ƶo{OЧO'9[Ӓko#CrK@D@"Q>?ٞyk!C1<Ў>-Ż<}X㜨cv7:Wڍ9*" Nۇ?L>cW֧آK3 ÃO4"[-o&"40NgQ h6NzhKA-G}Ik7ӫ~cڪ GxwFc-|{Pp!G!Fik?ul0K>p޼o1wŌue™=d)M ok}T:{Ǯ\.ӇeA۔"C䔀6r[dB &Ng >sQu!KRУ x_?+{mZwﻥWED7kܯu MMVзWR|~.;tIВKf*W^#uo[hc>bh6tݑõ}VgXQA׆ydI$(@^h /5@&lPسӇ>2B>3o6:+/>Zׯ@ ,[ri9/3SVL+){OYrWխ{1oiWADpӷ^kkk8yݝ8$m3cX C%?IȊ@h 5@ll (>a<}Xg.d}16yGswf>W_Ӷ ]?*" y"|w>:(`>sBܨv[ 'd5O|x%@6S?~NSj{UD@I3;74#A(X[Y|al|OqB{mT:O߹n؃ޝ #;1tu{m.{1:hGQ?*oϥ>xi9_kCkuKrD= '*I @G maL:xg{3Og;!ksi=vj.Y@*AV s~޵OCyM[w.cI֣t ~A{P u&_v߾1Mzb_N9ζdLܦ|G&XO2="lRH[p`@`0T@+%14DRJm[F{Y$c¯h[~q>7t |Hj t˭[ˮЗ%e T#њX ׾ywy`G;G_L䭗%OƓ/'\\㵪hfӶen@B`x 0熙A+ 0'Tnn7b2nVL[fyR(@IDAT{ᝎ8[uDo9_z}Tb=MbR53ޯ}3};t7Dwl?|}¥|gSQ˥'֊nd\u'VjS ־(5ʸN*Y2e7 ɿI !0 oD)ɽc%Km׽_ߝY!JA`d =_qm$I.Q:yR3GL< {U>ٳNmWρ|9ݾ(l簈ܡɟ&eqcَRט"l񺕲Tu ! }л*~$@ԝ[:m=J'/'+:E;޼צH`x;Ͻcg^;I|o8;?뗎}&^~8 }g]Qܛωl9s8ۖNmkYOo1InGx+~1TOؖTQK#o@@5P,!U m9}J]o]2s&K}!oo{sݏ|xQO:xO䋒0'@9)_8^wO{A?_vN9QuEۺTOjۖJS>'9;ֵշG-5,Ben>D`2B%P'e2&q|sd9gdL^1v^Qw?}QJ5z\WN/ru[   T9ULX+C] Rzpr:N7yă{=6_C|KobpIUb}Y25=55<_yXq< ګ?o|_?twz> +fnύlwJjm'hMlܘyQk_>XgQT#M(&6yޘ5 `#@I}F{'7_M-蟼}-| z  P?5Il1jr!s6Ly붭_ڷy}f->dIowغ.T _pw޽o}{8K>yQ?%특+&/;K_&@޺-_L|>ζe귝'sFѤQ~ToT$66}= \ܡ~QJO'[/e%{ /xv#8 F7|q_y \RDJa >1>dtj8]<|}'~?ٺVyP((g;TCIh)w}\']sa;]mIXX#M(6qY t#ɿn;Om']*<ۛ5$NWX?[ݶϟn p$( Չ⃏oht˶[څθK._Z5yTo$Zu֝Ll'莉tQڟקXvnzUh-=  Ԃ8,賞EmK%n@^ <?1> @o߱^z'7Dz  o{s~a3jA`oַ/S};G߼vZ1sR距J%Y2Me;yw].Td8t>lKض'YH(P P;l @` b#7u'NUo=}1/&dY=?91Ϳ ԙss/z{>}ʙ_:ɓ\֣l$>ndU}r9_~?[^'>;T bL:W>ݮ}sVu,B%Uu I zWV6!J%9їm=Jo>e#_=6op/ןϽN<o_^~>I2͓ݗ>|W˯Vߧ(Ev%]mdj:19NUouez+ף5.GwM z`A} F@NݡD^QJ/;d_qs[_{ީ@VSw|qvS#tӟȇ'F,>ڿ\qzw?~YWܼv%;flEk6g$z~:ɘ[2eɻ|n;'}b;v2[T% O cV@6|oS7Qu8ُ}Yy~9p !B`>|9NrRs''OOMR{n~pEe~\[,:I.Dی]o;T,oi_.p"zN1YOe۲hd`='SQew!Z`֧A Ǎ47ᲭG)=JXl;ٗm='п IGTr󒷝,"&Eja˾{O-OҶ6ͷlካ茳ϻnZvĿ7[JM1̞S%,N];yjsLz=ϭɾTx*u}$"hoV @7|S-xm;JߴGD_v?;'N~K{#(Q*Jo}O|Lr|-C&'ܨ|ٵkk~|܋/~kn/^Xs{¶uvsz*c:Q#Mm*տۤznl]uֽVlGY7XITvY]eHp@`d02B"VMvyOe[o?a +|;XzLZ{o{too}Λzp ~pƗyݮy ҿsd[Th-֣4_Gi֮eI|%$=c2ٮұX-(B1%U%5$  6F`@`Pa#7Q&>'zN66(2w/á;(g7޴uW+&G%S=9߼Ɖ_||퐻Cp? r?j vvnz7ݲkW\/?߾?Y imq֣CbhU9ήw]o;'}ng;J'E;gve,W.;= Wg='SQeIlig p# T7ݮR7zIƛ~&^{1{;_CA2d,@rs_+Nowɑu'\$.Ή`Syđxmز^{ocMs ( 3{L95=aa~z;v-ؽ{n;w۱k]w(+v;n[/u~Kڹ߾innN\wmIV߶}`v6Ow#۝ y}?ю2=Ƨc؎eQM]>TF_n& <6F 0(=lnRzC7}cb`oj}w;@2n۾s?|%fJ.뒩.[I\*I:1RzΎ6#Υ誥z|.縟9z'=)ՕTu-g:f#zNsu.r|sN讅_ΖOE}-+$ː``/@$&oG$A>'&N]g[2nLz>?x_{UQ 0Tw_N߫9Iɘ9y/&wQWRк[19U~i#}~W㡉V\?눶tjilKFuvSsdG:Mc|S(;f(k& @ ` @ 0(kqߨkuso]vzӟ& Ngݲew;r/ߴi w(b)ig;>dBJTr2MȔ.N%uc_鸞[ѴQ~Nyv?L.Φ}[M\_j:b_N77ǖ[\ٖ\r/&˧6v?"BRlD! 7te7woˤ~[S}{ ͚M_g/'󈉒/XR l'ztv6S,K[~ʧ(gԋ.+K(.-ZJNFLTo='O-igvq<9}QYOEd  N@ ` @ ^z7֣}:1aHu'[ gm='1jSO}f!o@: ֙oJ6tq*7!ۭPS|z(F>%il|;uc^Ro# Onu_t:$NN}Nd?q_Q}[Xm[F,źeݔ$M(@ @ 0H%B1o='Q`TWot+5+;kE=!P$Ac;#}~y2(S=MD2&ir\z~xsTjS_sj\K+sNzMe2]휌T;4nΗ(S]vC,]o='/e7   lM  @ݸb;'O%d!N0𧲱e损~޺מ{#N "ϜIW¥N$Z42=m5|>z^lTz(Ǣ9X2nފz؟cJscenwdIWQl!b @ ` @`ДtC}ïT _N $ OL=Q>ڻ''',Q 7\x~d'O9L2&Q:/K߱SO%N(T'=&Nwo?O_W'ƭ?ǿǯm)v ,Y%NR96NJ9K?{n+UR?,kzd~n_.kY蓮K )* ``h@`= i7϶ Q7G̀~+w/ ֔n5t(e[L: |;ɗl}7T?-~u5>ܿuɲ9*&q-t?FƘvz:svŹZW{QF>*꧴X6V֓@WI' pĉ77g ~߱iӆ{jp ւ_O~߸6)N>I*iOy'QF=&y,96e=?I?WtPKse.;s}d.y9}]wgֈkn 6>CӷD\'Q66?NMNn;/Nq2e;R;tR/v|2).Ͻ(s3D_'S3}uI3֣ߺelgd{GmEh˚m=vzZ'YH(P >`pt ?TɿuےND'0W+8~.P *_|l҉5\L(`Z:i-݉uےp}u/I,\e|IO(5lE1ϺdN5w]J:ٱ6"㸜nb]._j;nĿ6!  @IrYte3_:#{[yDaS "n~o+>r57lĤʺdP$PIu'1X؇dzs*h)s.&~Ͻ4i_URm}4Cy{NXXuضru8\imK-_$SC  e&ntHZ},ZrY+׿zXn ;Iړ1!n[RIeLEmؗt WK*vC j>Ur2J[Uz.QOX2e|r2Wz=N(hKWz72Hwq[>81  _ l 0hMO!&sRx8шRk[{c ?]ƛo~_ѭnS$+'ńP'QJ|䷳c[WI|\ QϹ<>R_VmTlKX.Z96Ө׫,b^inضT֗|I룟w[h`@M/=Ƈ >hnot5xCmIMzI=qMS Љ$n~u^:j'=pqƵ^L.ڎRv;}E)==v^%/=ڽܜUm2鹏(u[6Bd8n \֝_XS o@3&im"K}Yg][z[_6†@Jg|g}N/ٝZw)3ԯptϭPusRumu+(S=g5DuE6+e}9>ndI-_onӁ@`!:L@ d6<Q"NF$ @~鍯L}^=7mDB %o{nۮEJNR2=bru'ejռb[-/?RTj-/)ztեյڥhtƏc @`X a=3 @蝩M:agcb(q;Ǵ;wOy>k۶SY+'￿R{"pێIu'eNm;OU*O?zǤ_vW>ۗ8'9}һNsqi?޺eO/7&:7Q@ '*p" ~(Bۖ#q'_oxÖ}~>M[O~kNIV$,J tNʝ;q%G]up{{\8?Ͻp?䴞/J.lo=ʨ?>\}SXk'suh^i1$M(@腄@#H5ws.:9|Ntne5io*~K?(F@ss|XTt}D)סuX{ۧzSucL+cq/깍2QWN<d;.f:eHѬ=ɣv$nL@ @%N mnbͭuk2-Mouw}sW\uݏ?ПkU |}K.%ן]-CI_s'M$cюmrz^vqQjNTө>F]tϭ]kt|tv2^^ ݼ^8vldK-*F 0 @` q7&7 '~BniלLYדv2^wQoeV'ٮu}>|Uy:&ګwO/{].;7lw 辙s]C:oqb@0~'CX+-M{*KoksYS?]{]۝Iw旎}|nߐm6F[0 T?X3|!@&F (C%!8 |K?;==u"2'7S#ʛɞ 鶭K:No%9At/#~z*D[7!]ϣTZUbߢܶ?J-v,z'\蓮v.ƱMIDԘn( dpD(Cɐmjkˮ|kfL\#D??sCWL>_Sxzݼ]RYo2uYv:wǸ޶ƲnW#^zc'FNWBmvſx!!ԙemVA]FQJ? ? [CKSb4(oG<w1$SҘp:At+/tۖ׸q~EU39.CYru/Nji+.ڝNTVc.z2%H\EO|@kF9\[R'gdH]uՏw\u ]Q|S_>'$גdK1aO4w}׮KzNezumQWϿ[qb[r}Iw},(uMɻM(``O>K Љ 6eA1Yxӻ? :͉z/>siX(}55;$sm/S<Ŷ=NVǮDvGC:X5zѶލ,|*'Hҟ ilg:q@7*m{|OӡvIu^+7XgXzs'}  @-nxî$c2ﻊ%Z p˭m;?sIX;KUk&U*^Ks|KvdؿZ~O:Ǵ2c|bnUI[y`A(#' +7QwbLbNm }]k&x Iu[t>SHi[kޫXi8~Z׋ɍmekmWJ:Ƣ7Hҟ @ltD5 lIE9}OGD3֧OҺԶ)lwJ;QԗlY&5yNeYqLs͡۸ضݸ1.*,vE'o@glF@ێIEKRw'2覯t;'=7^&_ 5%3@C&nU,|R;EX6O|ҒP-LQ$vi,mk4{Wnۋ̍S>G¿ @}%@_9 $@%J' Vbee:kg(R?W^v5-L^2LKp?no;'5=/\Oo_7Rm:nIc:MFLl"v ;6zgF @X" \`_.5Ev{?E>_QO2{[w2Tw-9]sUQh7xȍ3(_ˇ X3*Nd &:)yi$\:x~B`>˖ܾ6,u$G]>'>ۦ~%Nj<]-%U^|*8@eYIMM'9al&Z_{;nݶS\cW^wM7oە)>lڐ[wq9TRkis}M9'ARrshд֐k 2% )ѵ.L?w]rɺ|~z>JǸ^|.Qo,&MgFq3S@5#@N(ˁ 0b2H'|en~!^SWqϧؓ}F:'tBJ߾2lj|mmfqt@L g8@u&' S Ezsoqj D.]vq7ˬ/էv.u'S b8n}QR%t@z``=3& b@IT[o:ƸFji?5޶}o'Ȗ)5dJ6I\q!Ikoqǎ]Jci9K/iR.#Pq\ܣݢw[b1 @"H3 %IL*J7?xޛ5?pul^-W\y]8^_?G_;}"XZT,o(<@CvB :h %鶭7@/~x6MWR]|Q:y/;+!݇*źeß ;60@ACb(鶭/r˭lTRWh^1[m}>c_o]ĭKX.Z5"Q!@C Ψ D*&TNzC^y νt ]L:h5d~RM{t=W\ >@``N  P_wHc%/z۶o߾J׸h:ٖ~jǺ2=mc;J>4 Qʿde18 @M >@"ɖl;Ȼkb>xNyFԗ%_}ent]bh@6*p" :NiLbb6v7~}XZ~p?ɬWUv}*^1NXo=WK.wXk@Xol`|@pbeq2660@J?.l&%sɿ};];b]T]K!o@CN !?AL@ tHY AC<꾦a8ǺGuwX.Q @6*q$ pRe,_e+~7z@S92y)% }c:G|i 6 @` p'5ԧA/l CW]74Ltn}F=,sR;c*[`A֙|$#DV@q~n+m7wio[2գ/WS\~Xi @` 0'A;^A}¯s[(m~9'۹;vLΎuNc¯zcv:5?}tl˵l@XgS<>C$]/M\ yt2o8oXlX  @x'@%]235@p;oy[jgK-">|cYzޟ>:nw  E j/f @vJfOMN::nָεwdL[SQK8  @idjK=zbbQ]em]%KkQ6ѾL:Ttǩ)F%.zx Ԅ59,@8k.=хOӁRwMϩ휔χi[2&ߩ.Ug[2-kO @jl arF@IRL~g4Hov@lXhǸ{';V]۠C*E J.& @`591룷zxJU:%1&n'mKo Xڟ=,~$ @eqOw:*6V%?(X|RY@vl b~F$5PlV[2۱]}8۹/cC*I J6& @`4|o8b|bzro8vOmݍ6nc;J*Q\x T>yL@ lٲk:뼾7~ЉuQٝY}D䋥c!@'@O!  POi||\j|lGPRz7G#u]o[*B ( @`μXnݸaOp8TIEc.&[t#!@!@mN%  P7eb|볢] pRd۲0mJ1.%ۇ Ԋ:,@=lcKtq=\U>=/J۶neҸhC*M J>&@~;ĻO=~+m0SD]`G_&wD;oۏ Ԋ:,@ LNXdW D`vLO dI{jcۺeꏶbT="C|r Q!0^";QY(s&%eHommXAB*I J6& @~6M~+t@L.pюz_҇c}QJ@F#sY( $w2bG ,J l) eLɻu+qjsd@ 6*s( 8so_wMf7dV2ȗ+c_죝k| T:]L@?I3S(VVkZf{YncRݦCc : @eq=9ۃp%6iDW^rI}̧Fruk 0S!ԓ?xu=WȪD`|b|GG4bu7_O}ڷuH@@-P" T/{]3^{-𜯛mm5 'П"&@~;EulVNJRGHCe+%Ymڥq9\,>@@e PS!T>/q5W{%p[XI6Z{* Z`֧A>_bf7;f.1/+c @=6jY  !w4ẘ[o{( @ 6 ֎ O?OZ^ ;h˾U's ԝu?ìPSz7 t€ yyͰ%uep #@;:A87n>lӚtH'"P=gI$wK CR @-lfN#O~=H6ph};dx,ڥq9\,>@@e PS! ?}>zˋϖ]|6rvTmm5 'П"&@wIY|[0$pġv KWSs P l4@GϞtɉ+f.38pR'[vi|4+k 0 TY>iߩ ߞ\^k'B{&َ1-5T}qe@56j}zY Џiw8x߻4?';U˴2n@:l )aBK@|c f/8d wNڧ9=bEmv P;l @C@yos ~Իæ'{ yڎRzjO v/#B GMMguкfggq5/ mg[Gs|*]k@lʙfHϾq~C|tD'NcR2_IDAT.>t;R{Y>`$ @c~o&]`:La wN%}V)&Gu׻X@l̩f֞ϳG}XGGz!sX[Y2uBҘh+uQ>!@%@eO .8' 3 ɉ_{)%/J:c P+lt@#Pd_7"#ՅÎ;&kIv]}FBjE ZN@`07T7m̈R'{=5KL}NʻC2/R,EC T:YL08fkNJ1 a#0;;3=f ֻmS>il@@ PS  G͞06v`GeG<谦[LT{[F|EG@@ P! 11q~pأ +sRn*'Q:G>\ J`ҧC 81܈Tw=?S1&^|顺ԷZ;E;-80 @IcMϟxNzlƫ/nܲ3 ȫ8}eR2,źcGBjM Z^@`01ͫ S3S~c[N`=J'k!Dzu `r C/Sg6}H6Qix6-ٹd]>'i1߶,zl@@%@hw-[6@`ظa[^yoL(vRem_;]}gk9-O Ћ! 0Ͽyc O֓]<䎯3V!M£d^R~QO}n6dAq* Ћ F{1q ,H/=w),W}Zm[}"˷)eHp@ !Fg _ô"? yD |KX/߱_.ێq:6""t@fz1@5bG0>6nƿްafr4mg_j˯";<@J@/|@Q.e9_-&1qW^dgEFvoوS9T @`0lg@ NC[퀆c?<;h{%^$9J&@)* @`H0$'i@$>&'WW&XZl>ѠC0``s g{0t}|yΓXt^+ɏl6e)(uUZE#:  Q @`{|toMS;M/ `u PilT1y@]"wa$0559?4S/&d_҇bOcrhGjci@D@@@/p@9o,?dy#B`>z &N[:ƶT"}q &ޒ)&@@M@/n@1x'&^]%$z/D=&sbG1ѷ.֣?J@P jJ _x;Mt,k A컱@ImI,1e>cH^XZl>ѠCz jJ`݇  @`(Ō@$Ų6ri, K&'^'za&n ^f@?4o@D@A ΘL!ݎ} y  mY/LZ; &4  Ԉk$N<ɻ4Om ET*>'9zR>-` ^BF عa%rђX :8zO^u'jg] |8ǖ?VC֓I!1 OAEYnCOȸIx@1Q'뒽l؇t'Q/'Ku*Fc @ 腌@5!01RrXz"E4׽Nv[IJ-Gj& @z@@ ,p|  "ϡpQvn}Ŷ9ݛsjt~ A@4xQ @&'X,%@`؇>rz/MoĤߺu@``O z}ăƞ&p{b1iw&^~'@bm٨+~ Ŏ !@ p  TW<2w^[fv]쉍Po}~I:뒎_)q-݇⤧E~  @` ŋ@&pG>230^S]\t{J}ض?'ctN;Oexcq@}$0  T?b@ p_!t^G.wL˵u%C7JKo' 0h|`5 PiGzJH?/ۇ⬧qN݇|cɾ^ ~I  @`E 8f'NiC/9h?o>;;vۧ2&ֵ.'}Y#BVBOm  5b*|Hn ˮImIӯߺ_>NsRc-+,@Xcz@@ (i%H7v,@BO 3@_St 0;tCIvz˞Ks[Kxh(5}@Ћ*Hl!:S@_ LLN uI%:[6-=FN͛n)DO z@@(Y簃/MPstO`rb<&z8aOeS]jc}hq%U,G,c: @o @1 (2#;CP"Zv}^G:Q/snj2@@'E  T@6S@ L+q.GL5ʧ[ 0 l 4@X+‘k'@N?܆bPsvB+;-9_ @XSz@@ LOXi3e@\B=JS_^Sg=J(@Q @qS?+Jcn]|u9&J-Tv,i}{Z 5$.  T@L ]?BF%ɷl;U}NjF~ XG @`5jѶ_P"^.~'JVKCBJ f0@kJO)N: 2R;ɏt]vcu$|b : @`-ŋ@$0>W*xژNOL:؜ش/ξT-I  Q @@S @̉y1~e-5(sQ @}'@3 >X}"K5 aCZYL;m[tToI\ Ћ*@ npa 7>fvM(MsvY46uQ @CE :L@@13˾ Nޣn_;f@wG쬰\@Xol`|@+%0WVv'0aF?Nv.}Iw}'[rj|ڧM$U /! \B0`JW|IbϺϕ菺bm[  6#@O*_dž }KG?\}ha1c$cD]1юzZC }JJD_ʘ+N/GZYNob߮1H@``]3( ( H5%Pq:%iE)۸fY PE~qܙ3 &0H_,-1$_uSnbb<: @`f(@8y 7Td7ZEϫg_*#Qq `@L Zj/pIZ7ۖ[xKFBCq ,,cň,YMrޮmZ';} @JqX˼ @`x3@ K`jtXgR|: @` f &Ju!05q@K%IZX쳌u' 5*! >0\ b͌D\vܮ>b : @+^: ? |p@N|2;' Gc@G`|lanFgd 7#D_ԇ "Hn ԉ_d-kM`jbW: >MSSCCwJ . ^20~Nn +F#@OO9`K`zz*wM2c[r nr/6 #ݳ"rLNL ɾezt@ qb@@@`|||~!tJ;kSnW$ @``j X[V#@ُsc) PWl̲.@&Yf+%091=z˕K;@Pq >0jgB`r n^́5@#N X> P]|gt+PN P/^ZV@FN@٦AWFw X͋G% <X5C:/+e?E}u8vu1 jl!@Xo#냞Q+@,[Q?v}+#~@@0\g &ݩ֥vF_mn  $@  jX7uƘ LMMW:M݉ex!@B uΠVOzP_Ei^\lE]CviP@,v/ A@O@O-=|[0$ݒ"C{j &a?8ÐF` " P!s`NS0_f/7g| .!  ~px36+ @L;鱾c\۵ l+B?y>ʌPU41On0|E  @/ V: |V tiiEY D .@%0?c'099'zI{cCօ낝A!zP_ovsMI}]_ *MJ/C+I @]O-Z]l9. @# ,x@>`H,'055Qb&穽=kW @@ű˦Az'nE&>>YRff٩N}]B#@w 0tfgnRLCD`vfLhG+\  %60)@ 1:@h" 0z6l9$Ic PK񅱖 dQJ`~bXד˺քt}^Yi^! e/}N!@`L7֎&=ՑT_XibE=ř֥v @ 6N!$U&aC'-+Mm[m&-~@@_t @v+&0355%$N: Q"0QZ! @f6FH/T1g@^!]|fg{7U_. t$@GD@N <1jhLOMŏ/ &LD`j'Z ٙaω5!2 @ᅱ7 u%{v~`];ܻ^&kC֔k  |`p ԧ>٩f Rlp avO`fN-51ㄣ/1&k Wl/Cvwz@ 81XǶ `2Bh%0}Њ -;N-#=OvKD=mӮ.ņ }GCI6C^B`vfZ9JCKy]gʟvm$ @`nlҺpd>B}Fv\}H@P``N = @ASSz$W]!`َj71S@XsSk#B@\wns5?00? sssszav+&U{nsKvC/bTxz^m&_>Ɗq 5|.KRe`bq@-vq5󒫋nաYyا۴ wQ @#0^Ѓt֕G]dqXjWB3%~S|K}q4^dYT7)X x3c]2=)x?icwaUcg__q\+`(ոI  Q @T(թ8!}H'1JK㢾=7KEݱHJ@ח(l[.꩝֩އƱnid7E( ``@_(H4Ɉun4!!z/JzV[QRz<o[znui_@֕늟!@Lb4Xt'A{t![*NKCBW\o]򷻶c]4u蓮:  @`(0I@Xs#9i$sIzK/}ɟcbu#!+xmu}1>u]*5_ީ~@``P u!B%&v]L<ɘA3PcYT},S Zݏ:5-/'֣DZSl  @`  @X%9Cz-Ӥ_K:}ǹ ^ נzԵl;^ӄ9>I/X>b=: @oZ: wJb2%9T#=(1/,GP1*&@sy@|u_,umȧ\g=i/@ l i`քPR&7Nr$oKMZ(w,P7"e)X ].֣u}:@`]/"U[x  0L@ kX't2D&c⯾ݿsd߇cPT5ںEZ5}#W;6@@ w @` (YItu1 Q}+qQnLdrI].wүx*nsη؊GtO@cZ|mN׸}z^Rh29:ےX  @oZ: nD:& QL7^ u,@` T2^e|LmDZG 6 =CX3J*T[c'9Hd?)Qn6w.U׬t]~@m8c[+) u%gp@kF@ɇnKw&%89WDF>q#0[ګeɿUI増G-]*QJO_;^R}Xq wȯ[ gl0C3%N=X']ŧ(64o8FNubX@`tm׫֣t.q ;>J-;Q'I  6;B|'JtTҤI~5o%@6XJQG`gMf=Mg+x2۳t, *`+ 5RKu=M8fd%%瞯o_M[gLtݺcx@-]N ̸ |yk].9%sfh}  @#\)Yج+ @i.Fkc*0yd$ʵyIY $k-ПYLgg>W( @` $@CH4oݾ4I\7;zo:gWuR[wwgH_^/Zg˜o׆7 `NH2bzӾ1綝z-=g&@OpT^ @y.I2tߛlt~֬۾8})2=s5V{sQܾkܾ{|sl'?Ht @\<Ֆ8Q IQR&%8)mg^Ug]q 3=1ۍg}-^f{ϱįE_ 5<[?t}  @^(n_ghRt[vXGl7VϱKq>_ǮůWo I&h @5k֗;& ϱ}_s^׮dz @ dG @$$Mcu{Q;}v ة,K{{{Hy p O$B}ZBYI 8k\ 5TڎNpp*  @ @9) @ @.w6 @$`c @ @.w6 @$`c @ @.w6 @$`c @ @.w6 @$`c @ @.w6 @$`c @ @.w6 @$`c @ @.w6 @$`c @ @.w6 @$`c @ @.w6 @$`c @ @.w6 @$`c @ @.w6 @$`c @ @.w6 @$`c @ @.w6 @$`c @ @nZP5P.IENDB`ic13pzPNG  IHDR\rf AiCCPICC ProfileH wTSϽ7" %z ;HQIP&vDF)VdTG"cE b PQDE݌k 5ޚYg}׺PtX4X\XffGD=HƳ.d,P&s"7C$ E6<~&S2)212 "įl+ɘ&Y4Pޚ%ᣌ\%g|eTI(L0_&l2E9r9hxgIbטifSb1+MxL 0oE%YmhYh~S=zU&ϞAYl/$ZUm@O ޜl^ ' lsk.+7oʿ9V;?#I3eE妧KD d9i,UQ h A1vjpԁzN6p\W p G@ K0ށiABZyCAP8C@&*CP=#t] 4}a ٰ;GDxJ>,_“@FXDBX$!k"EHqaYbVabJ0՘cVL6f3bձX'?v 6-V``[a;p~\2n5׌ &x*sb|! ߏƿ' Zk! $l$T4QOt"y\b)AI&NI$R$)TIj"]&=&!:dGrY@^O$ _%?P(&OJEBN9J@y@yCR nXZOD}J}/G3ɭk{%Oחw_.'_!JQ@SVF=IEbbbb5Q%O@%!BӥyҸM:e0G7ӓ e%e[(R0`3R46i^)*n*|"fLUo՝mO0j&jajj.ϧwϝ_4갺zj=U45nɚ4ǴhZ ZZ^0Tf%9->ݫ=cXgN].[7A\SwBOK/X/_Q>QG[ `Aaac#*Z;8cq>[&IIMST`ϴ kh&45ǢYYF֠9<|y+ =X_,,S-,Y)YXmĚk]c}džjcΦ浭-v};]N"&1=xtv(}'{'IߝY) Σ -rqr.d._xpUەZM׍vm=+KGǔ ^WWbj>:>>>v}/avO8 FV> 2 u/_$\BCv< 5 ]s.,4&yUx~xw-bEDCĻHGKwFGEGME{EEKX,YFZ ={$vrK .3\rϮ_Yq*©L_wד+]eD]cIIIOAu_䩔)3ѩiB%a+]3='/40CiU@ёL(sYfLH$%Y jgGeQn~5f5wugv5k֮\۹Nw]m mHFˍenQQ`hBBQ-[lllfjۗ"^bO%ܒY}WwvwXbY^Ю]WVa[q`id2JjGէ{׿m>PkAma꺿g_DHGGu;776ƱqoC{P38!9 ҝˁ^r۽Ug9];}}_~imp㭎}]/}.{^=}^?z8hc' O*?f`ϳgC/Oϩ+FFGGόzˌㅿ)ѫ~wgbk?Jި9mdwi獵ޫ?cǑOO?w| x&mf2:Y~ pHYs%%IR$@IDATx}\U;wiF`ChX]}>|Q}>*vEA4;!=n6lz3mnd72{Nrܹss~_;0t-pߑdz9: s@?% K^,-;u#MF}Mܸqz]evm0JxgL<Ooݺ53Ϥq2XS`8)@ %طmC߰aw…n>ыd뮻EMc&R@@84w'q>zOaQ艹VS]U VTVܖpe;xq{cKݞj[{<|F(8XS2o$_h` q>+W9):2^W?vv]mI2 o&Rɔ+IWSF"f]T{Cm/msx͆lۆboj|?PyT3c3pY8I_}V=Zuft\=cY)ɮnk=̺u"HF@S!@ Yf)8hTh&'sOJ>Ӧ D2$y:v]vC>.( Mc3HߟN2P`6qA` nl^ڝnD!QDmڀf h b  Yjg<l:Ҋx"wRۄUoy, #Τ?>~;AO G=-t2I 0+zC۟}q_6vD(Ed{vf h R;;7O^>R kݻKw=ئ`ڎ1c ')z>"%~<$=`bSWPSUI6nEf&gEo}t7}n3PH/hB݆@b Њ@<>N/tYF.X<pM t dG dZNa `pR$P-~ h7aF9N ApZb6XS"Wwߛu_lzvpSҰ71=_~_c, iNyО; ը̸*j+T۵k(Tw`S&//~ݧOM>`"RGǻGO!^Bh&)F54:@h1#Ab}f'90O>=kڱj+Pv8:?p|')RX$#gלK].UHi ЌD( j Y98ȧqV:ۍ4jWOV@ Ddw\pIcN@W%hB248NmWrA c^N306́{?m~b?4.[h26}o:6aT H@h&"S WW?yiIى`>, PAiTq0M1Lx͜7TRj\ȊClOwL РX}X2X z1N;W6(|ݗ  ǒu= \/~}N R9<nG岼F:!(AO(V_rh +U͞4@S @v"z D\E1=&ue`4 ͨ4ar|@k$TrCs= ڵ>o cb-a7p_?dF?|lAY/F?}5詸,}dʡGyOc,-օ@Ih$?PA3\ӹCnQnF[2,_p]?5Fs"qqqe!|X؜^@/ipLVGP@3"7O.JYSID`ᰔ#ER5AL.K_F%9D/X0v @,/lsT37o*!$W&%n:85ؾxQfT,P;Jd"x>ǨgFs1dE\|% ( @_phKt<,erղXS85|Aَzg9w@z25wU{ , }?%(( [ y7S^pC!QQ (ȵT>z |a nq2't,Ӛ8jaݪ6En bOunYq-$S$Eٖg R5I;M/ U {9ˣ|̋S4&Gؙzs;5c{=hPb18#}X:A"A8<>6(5Gu$Աf.۵N[dv*O؊:"5pTkl;pxOpL47#v-h3E"ZdE]Df=mM>J%369PDrm,¡cP,duGa;G?/;_Ux|>緼^3m( |0UQkxjƻ*L۾ɴMFPl,}*EIp=VG$޲p+NH_g zN`Hcw6,.O0/؇11GHp<;臔Ȕt4:zg%%Պ,?b6Ft&J:\G{'xKΛ=q1Y㧇Ʉ:)*4j!0Mw$_V=(sHSS * ;6h.qM'o:wb ;Nn06KX_GvƎ,\fIᩝlxM1r67Yƥ82AF "G )P J!:xK^sdkL=51X=tAR/9KW!Vy8 6)/(--$1K׌S*_rGkGw2|/ln0#i2P`>+`_i8. I; 0 bfVԃ]|~孙733EJ}2.#H`2 @ tkk+Ju3p9 _]z~pD,Yv9pHǻ4Xd̟LEDZ!74hy6fkg[tOAe[)A'ɂ H}y5L[70Az! |Ҙ"y7W7MT*mC/zZ yx%oasen;O3H&"z RMVܿtwӯ7G`/W"a+KB3M6ñd[ /32ob;tοeloC^" |KHN\)lds[D2 $=nvJf@8o`<lqd>[p|1&׍/Í(p,lqPc.dI7EdMz^X>D3ϛ}6sMW8ѷm]j=md){Sg!0!+Ǐ(o "R Lĩf8N/Ҵ0w\SC Op3 9FC3+jxGl0Aa3v"ץ?/\h|F%Sfʱ@ `^Qhop<Ӆ|BT P˿=Рa2b=V qJ/929qaRs}m\P"yN4[-pC_l?8cb_UzsDsy_K$ac ϶{51n~}sbzjEm\.Psc$".₞`K-.G ~H-~5h(~tda B1WKąD6p~SӲ+Oz`qME<ˆPvn6X6,fRV(PWp zg!Э( cX}>4sD^o.RsҟP C0)@)H@ƎX䑯II̲$ng=cua@ŞH8&3pX,~2.^ 3nwS/>j] p~o>3EPJ^1(D'͏xG˿Җ &V~S)Ps3]w(mgOD sR <ҌکDei0/桵a?f ?/_|}:84XD# dm~LwFc>\~=hs|~,'RڋӶ#wX}d*Q7k[0t~y0O;%VuPbTΤҰ P-&(H]7\O^wc?<5L2QzͶ >?}_=tg 629N˴_yi"ቃ* B>u/w( q'ceO4jb>OJGa$L Ё~㗞{*ʉ+HEKr髿|DsϜ~2嗌त+A0:E熆ƍս8Ǵ繾=d,*wZmSB?ƿs͇ۢ%! y\C4eG Q%LTP4vn[? %hr/#ĹQSݧVCN{xt8 8oaOFG4=DqUDsa>=>%V p=%z44 ޔs[O)L& |w<}Λ eWnW~Ϻ)j2Ո>DҟҞd:鯤0H@@^{-&]_=(cyؑJFyumzS^^nv"Maxgd'i2Aާ!R2 I'b `SMl\cﾠ7-G:⡀OKhJ`nf˴Jn4asԑ ,cZe˶g;|F4ɸN R3𘀡9?$>SRxժUc+&@b,X7={qg3wkgL2 #JB%Тd hdʹhpnFv1ƹ3p{cGGMn}MwyŬS[# }&=u14@5u2 .DC_³-o']I̧NIϛ y3;Jxk0OSwH&M;RJrҔd 0, N$$ sƶm|fJ,/SVs'm0u^K)JE8V)<k̜2A jFVh<ݸЦ;Xvʧ-_եl2ΒdH -0QDE6𶶶w/x)X4J]ni@ڴ'n JfL?1q9gЩ8mdr0oW͎7wM4qe‘+D,Ip.SAoT Ma,hB'&)J@@eL ,hJIuٺk疼ݏ?%҄8[RwQJHk.h UkH[x":7v`o*AAZfr 66n;{J_oЌȨo>6f |3tY^P} ?={v-?ҺgϼenK@FdP9(4 }$Kb%6D#?!{ i S,'``M3_x^Ç>wXz?\lSFR~ 68a <A3~T#%YfѢEhݭ5o|+5յh"r\miÖݛްV߲fbY$OEhYI3qǴ~e|1 <cjlL]dgA3-0fvg)mYMXpࡖ~:gKlXlQ,rHj1Uu+2U)a ;ae ޶/\uƝOGskaj>ԀXo;[?HE .b0vo_:sV&c{Z;6mٳw?D &@-4%jj_sKGg8,/)C3<\l`CR6l=d<{&GrM/{KUXj,:,0 2]]Q,n3o?=~ϢFH& ΌIIp",Cv)QҳLD=46L6CvsN Og[/#(LRe-̔0N'[ﮪu|vVwWgO&@'yO:4y#6+ap~AE%`#iiؕIӍ{G ;m(W6MWHI`!#`à$}y @ ,{q˒H;lrԕ{$& #r,i9C?~8e|'bv:bC+]Aj jjn7|(Mľ~%Ujm/|2w F3EWk'_Ip /3ؿ\0A؆{W~qcgTt Ώ.9ۏ5m'qߕ b3?QΞc.,- &>7}]^ÞjbP;(jM+)҃ iֻ vU0Y=`HBcK|SO\p4v3A\Q}!53eY13*LGaJFL%ťZ= P~jHmFjyz~oUUh؄8b3긒ʬo Qpk'~Co{ʌ! n:z8(;|Cd&fP_{^|80vH]՟k0VT|+7l`?+nyJa Ԑѕ_RЍqnlfuoxܓqj2dMN # i (g$k^{˷^ՕX<ÄAg'p ܹsy:`I;k4Ri;0zw8Kή4okPqK #XZ3+n<#3ȏr)5O~Wxie;& `J2Uxsr|L _1WCw[^ᄉ1S/iF2\z]VLB1ktΧ-Nv `pGS'y&|+MWl@g 746o<{ vbC'|߹RdrS'50W 9эtfNyYI ,FQ i;;W_ӗ`ovqeS 879]o/ͲG) nʍT2 6cƷI<.5sA ,`RNPfبIgcQ{ <+XDžO$J p?6/.G; \Uٷz9L TSUqF8c%| I <*L Ä3t\4X8F [q۟-+ yƛK dwbdqwm\jb(y傂>C휘dF"ם7kZ/CȴZrL>͟yj3OBFZ !A5E)gۺʲ)D2RK$RP [}ac KS4&@@|!hݴ#n㘾2>\<@+ SRy>=*M9a,?#ώҔPaS?CB%4B-h/P(ߝlPTLꢪ lvȅ[rp<߼cUk&+i,g`Mh[y \,힪.-wzD|=L @2[j\ h|;&$R0:;i *iz`0? ;h`q=?H6H_l{C>3QE&5%gX4 0Z \1,94`Ll8?͔QP }3cO'zBHY&NyF'-'B< jaZf`cVǞS $GPs]BcRh9/nu1f&ِ<:;#Q߉JYj+@2WádֻTeo<5Xo$+$U6^끆&O/&P EfmdV!? N@t[!(wP~Zftȧ@mMbh~mL?:3]\JDnO| Hʊr2+'EuuFpz}e0|hHOҐF 3H(R jJ9o]3eSS;3j*Έcb ,C:YH>2U 80ct? /:iڪ-}%A]~y6\5l놟+? Y(4J[| @2(T3sU暧3!#J+d$ P]b caAv\VuIQβRk= @LI'׸ pTO@S*+MYiQRFEY W|i̘ ٞ4zڤڳíƪ?'qC6:)te*ײwfg75*86mZ› )>PMbKʊ? 8ڏߴ>팪ʲYX0ɱ'aդDa fRb#;Wc(1W Cb*F@?΅υr"Q cEܱ\%4(69Le)T8/i%%~M ` iLME9c֔׳_Y(KGGG\ D{n@qg{_tƏ =ӦL4 OUVOx6r{_.̱B j jT|%~3m01ǭf ,6i3'Wb0\1 [cWVfΩ*Ê78ӘyC \ +)x; #p R'T۴ӱ3mBWSl?I02ٖ;}\r&^}'N)e4)WĶm{pOP4N@aqF(`̯,Hc Jn@8UM̨EȌ @L߹g^gX\KR %{'W_5g5r uO ]5:723J~7bdnBuٓ+6nb6'yrKWj<~ɬS$r[ `"g#qnƊSǽ s;*Y;dH @mjasWϛ0 p:oxuؘ1hGFAKtpww1F%`wl `UM4]!{.jaq AZ%Cuh<;0tGco`f ʌ[$ 8aM0n1aj1W\8;LwǓ\ם0]6Cs>ڃҨ%ŢDkk;MJT!SV)) ?BFmrq-̨3SP}Y_ݩ{㲒 >؟o൓5S?qni9p[N0I HW鐳=_() wG{8% fP\LPW_~f[w#L}}~ت-I'tH8-MCQp֕_~\AIhc@)cMO^3)) I& غac`qKkw| 0P[0 58<.xpf>~P . ˽mזDP!DR](4Q[܂۱+ zvJ-zq s@M ?4zo wDɘrq kPTOcj+/)'D=+)zRrg NxyVe;s2WfZ g0QOO02 /;? q}SJf#]w @)wwf1SC  _e:z۶eemw0׎'*Y?|%o:!Rpb@sgcsGXN@/j @'l~p6,\ЍܫW ΊF M{sȎp 8MƎM$fny|Qh|kbLT7~tO|tlݽpO#EΔbZJtJ}8kK;YVQDugzqT t'y,&뗱f\=Yk`Ge\۶m͚5nEթ7N=~8Ҝsd P߃S//kM8Eʋw2a  C+ FhƆ  iyof<|w2ᒲz;nZ./Ƒ)ȆO?VUN@sҕ"2m\ ҟK0o'*`h]zЯOF[K{_XM GDgWW(5H葼Ʋ @ŗXTI|gZA3V@Lgџug׼&IݩH>yƴ*hѯ=&cϜ93p];{&x2ĽJL87aD`h/ƅܶvVt*J߁ʛvuEn8CMlgȠv2byYXˌƣVD7Q$85m ZMpF~zmWZ782E`R&%\n'K5J*؆:ha`Y3W+}9mr4Ǯ\F%p Kojܼؐ}74cx LHP4Ak}Tgώo^/>e|9X'r/2Z%"D ߾[}r񋻠MA*xG9?2N C?TDzgۆšl9ϑz(pvIOo_gM˗Nv,L9ݬh,$! i0LS̒KRʋMG|ey߳3"b 8w2/5X53vK#Jy\T~a($y@͝;7{}?5o9PZiEѴx!p%V%IDAT׼/61fEim^Vŭ44FMJV)6u=xPpddJP'nV?H{?գG3\ UK?+qc񳖯,IA؃[A.hb`"{%T2r8O}!uȅ.fYj'1,?Lp0#*_u.YHi%~{P_CA̿آ#v#XfҟN?'y@ꪯ@U#.3їIY#$RRjpa@"5<qb0SJK"xږZCHs:5N +iv*žߌBx0/wJoBㅃ< ᥺no`yF&9^VxÉ)@q$ 3o~3+e=a#M)A7-eY1l4'BE}0zMHWwnoQsJcvT=y) GG\X"5ebm\0_ H8s7nnnn NbPC&D2x}罋VP;1?U?SwY\a3J5?YSk[te+.ptq5')-( A7.kO:z"-$( ft8.n^YZj-_yu7޹՟ TO%P>!gX 1DیFxj/yjbp #W/ܦ`@bLìSΜ=y2 #~22'i<40}?ޕ`޻P'jR৤'ùH@Л<@A ȸ8Ǿx^qh ]T=cGĠivniYi;iSPf@)MF+Ê (\pO`?l󸺺#/~tD082ghxX龯^{5Ȼ|6Ǎx8K a*I%P>"2R+ug̐ŬXts:쫮o $ZO)/4_g Z8ZgH҃ܽn ;Kƫۘ̒NU EBOW};&bJ X=;kjKVmQsOOK Q Q5JM OT<6JtUv*l<*bӦ`ڪ0tYȆ8Lz[z̃:۞m Ymr= >NOہR}n`O57=M`'n@9( f[OO)̀cea'wGU^~1-^?yA)Rx.H=xm~?dx8 Ґy]!!"TYgWp7^~J'7,[i^tne۟Sd ~;~2Y$? :3eGaƑFvVlXSKנS'ԍĹ|0USZ'-ݎ_¸J>sq7< K?sZP& ~v]mud$@ơL'SQ^b._iGDO gh~PSU|a8,~?BfBS_0i6b]׿^sΌ)SKC^1A2s} P0.];9gڱ `OO9e.%>Gi^XKR ߌ?c϶bFZ' h֗H~͟/'1H5 j0Jdp26*N8+/y~KjKO1ih,ypsF"h17YYV|o` D~?qhZ7WfO=6v?҂!.H H>W 7}Vmp 8J節Ȱ"_~s8]a4!I"&d65͑B0a+>yEϼX(s2S$<>ahů  1'UY^~ٕ[>_>՜׆$t;/+ Vk.?GȪ` ܷ%kރ͸[3bXovpAHP3/v?SF{h" ;#)F@)0WZFP FM1ݕ^$^mc4mH" %X3-5럄]nBwH|KSrx"ñ^lq%H{7M<ѽ:t=rK^k누|^;>ϋ/-MK z4~P}Ќhd*sޅ 0-ygN{}Lq b n(@GU%]X_=[vN:v)߻Ο7 #ѽYAϿKg]0t6F&J sn=ԲȺ}[P/*yRͧO &EK*R3!`Jciddb3 +8¯}⍗4`G`Ht #s7r`_ #(7ҘS[\O {9_ ],h:rb>|;Vp쥕g@0sqv;yrӮ}~z<{><7\T޾;oOn*>=MTޕ&Cv0 ZKQ @eZ~`G:ٸ'mn9F;R_xH}G;U~~D w|~SG@@5'jz3Sjï~wɳ]cO2hDduEY~/{9;oΔ?m oz# (7FGZXca'F:v=/߰wɊuqD/ *;%S[KtםRϏI}L{I) t8W zB>|58+lc݂c Ì$fYwox$b_y{v<8p\xT?|irs羦6h^y[u$(scwH{^&@F 3߼.#pLJ}Р'HC9B_'#G!O)wr̜tf8r'dzC믪(q?hՖ/|O`VU3929mԬt<`%dkkWHxKA*)PӁ1x@uF?A/Q{|^|I_icӇLfOsA9ƕFNs}}~KMk9(u~7\"gtgId/R_)AM H|gc F: ?Q2q[]xM^\ #R8-mݟOlm9d1wWp*-A@?\FV1"Lӡ \8ߞ:#70ax%%46 o1p@s^_sG4F{Puա&߻5wOU@#XndT.h8)A@XiH%_@M Н)yuj @f+``JaO ^} ӧ>{p$j{lؙ!W)CK3P 개d\L2pv~ZL!yx~>/g Ʉ.Ọ?S0r Փ}r,9LvKS=ּm?!9F$?G@M>_& ~#|!3 BSD :fq(5g.3;e%ƅ{1'8o~L| v>bùbS Vj?~N@@yx3}d4Iu8>}}h) )37~_l!GTi#Ioġ]j`jHkgxɪx@%6N&-Rw1a(PQ%( skV8ܺɏ5+_A )h?;{lt<7K.*CS@3o ,Pl3k~"Ķ[٭ .r\Xjq4$:%?1j8)C¥\PȘ0af 2Pe_U~҉df%?>PAkZs~hA'PpZ2ic 츃0EgJ\ΓF$ _iZ(КWXDW]uUť*ctu_l $㡀ȠGasr h `I<G'#8F?N<; 6F0g~'E ƃ~,щ!MDK<֡(506fժU]t]WDzXay0;P` 8򕖄0 1;SVPd@Uϟ~饗B~-`NM,5ss|ܽrMW|1" 9'QS/a/f2n M!| Yu㐸8#~PR rvzÆ )SD>o''-m8ҍC2(Vġ3'`??g[aʱ0J̈́0 `(:<72 .tϝ;7simK)vqG<@'y+.@2c1;3uRMgLh(t;c#MFrN?y흖78%L%0&ߝ8{tC7?/ϘpB e$#c4#mv2o2؅X#w*&`S_L7ἆ@"!,ȵbCPPGPNc>_Q G Vf `knW$HM_J7o?e'9W9BF/mt5XC/`)`X%  (!q1L-88Z@o8g@)T ~:fϞoo;yZLڎ[JLI;.- ۟y?{p?SndlK= 0B`~-H'0&(YGLwL Ӏ3lbvGbvS몃=f z&8KQ#t(G3}\{G~v$T(dm=3T}v z9љ|^|7bM$G62EJE"fk1('N@,N?9;_|}~dʏNDτ ]fxe/wǸ^ %>5:sb BA9t8p %0oݻꇖ-A sLW,H(fupDm D)+ijҟɩiWxוx׹QWT|?{xx甇Y1M2"MJ BDۜypg-Ofڂ%P0_A3x"=u6$@oZ0~r)XnT;dB[ 0c L#XIkkQn?((AJ fih"z `jhjpݳ=j{/#E@!W41W: v!yL@h3@Ѯph0luS޴m%%eF<>p [NEY-#,P~ $0*ՇyVHvWb9D٣a,ɽ̙0v$T%y ~Ѓf\C^;*Fy=j" &sX0aE݆!40z9,, 䤠hLy^"fTI{ޓ%>c4~0AQ@3aŁxwaH%v)GQ GEBێ>?E7>%G +v4 @UWOn$yoyF@RDl3c^[-( H%TFsa0nThXLG5{FsշI%U`@uZTNHaH@.j\ rc91ż*J[nΏXADD>(6`Um.rÑ\ =>5:!w.V}XH `jc{2†{mİ۝$3\{u¹9H0PcIc0;J(zdR@3aY_\U%F<CA`yu z~aOY4j.Z`oX, GN~fC\P(vnivףhp[%D2T"ef$++5#RFƇQ@qP#Nyhf@x(U4 U" CF,GȠ<Ân#" ADpC!P@k_ 겝^J@֫j$ `E3Q r@2\v ҠQ 9h0CpP2< m+)kC-P5aT A (M-fzL<ε M'` ~~C v au=QB.z݌Di]߮J:"AsXi.bƴx6s_B@سx(";YCs`d L Oh=і1NH}+<+=F `1? E.oy~ŵ&ψp߭߿!bHžU΄y䯌1_{5isf^ H@$  H@$  H@$  H@'haIENDB`ic09PNG  IHDRx AiCCPICC ProfileH wTSϽ7" %z ;HQIP&vDF)VdTG"cE b PQDE݌k 5ޚYg}׺PtX4X\XffGD=HƳ.d,P&s"7C$ E6<~&S2)212 "įl+ɘ&Y4Pޚ%ᣌ\%g|eTI(L0_&l2E9r9hxgIbטifSb1+MxL 0oE%YmhYh~S=zU&ϞAYl/$ZUm@O ޜl^ ' lsk.+7oʿ9V;?#I3eE妧KD d9i,UQ h A1vjpԁzN6p\W p G@ K0ށiABZyCAP8C@&*CP=#t] 4}a ٰ;GDxJ>,_“@FXDBX$!k"EHqaYbVabJ0՘cVL6f3bձX'?v 6-V``[a;p~\2n5׌ &x*sb|! ߏƿ' Zk! $l$T4QOt"y\b)AI&NI$R$)TIj"]&=&!:dGrY@^O$ _%?P(&OJEBN9J@y@yCR nXZOD}J}/G3ɭk{%Oחw_.'_!JQ@SVF=IEbbbb5Q%O@%!BӥyҸM:e0G7ӓ e%e[(R0`3R46i^)*n*|"fLUo՝mO0j&jajj.ϧwϝ_4갺zj=U45nɚ4ǴhZ ZZ^0Tf%9->ݫ=cXgN].[7A\SwBOK/X/_Q>QG[ `Aaac#*Z;8cq>[&IIMST`ϴ kh&45ǢYYF֠9<|y+ =X_,,S-,Y)YXmĚk]c}džjcΦ浭-v};]N"&1=xtv(}'{'IߝY) Σ -rqr.d._xpUەZM׍vm=+KGǔ ^WWbj>:>>>v}/avO8 FV> 2 u/_$\BCv< 5 ]s.,4&yUx~xw-bEDCĻHGKwFGEGME{EEKX,YFZ ={$vrK .3\rϮ_Yq*©L_wד+]eD]cIIIOAu_䩔)3ѩiB%a+]3='/40CiU@ёL(sYfLH$%Y jgGeQn~5f5wugv5k֮\۹Nw]m mHFˍenQQ`hBBQ-[lllfjۗ"^bO%ܒY}WwvwXbY^Ю]WVa[q`id2JjGէ{׿m>PkAma꺿g_DHGGu;776ƱqoC{P38!9 ҝˁ^r۽Ug9];}}_~imp㭎}]/}.{^=}^?z8hc' O*?f`ϳgC/Oϩ+FFGGόzˌㅿ)ѫ~wgbk?Jި9mdwi獵ޫ?cǑOO?w| x&mf2:Y~ pHYs  @IDATx} ]E=]{;BY DqqysDgQm͌q\gQ uDA@& @@N}ݷ;SNwέﯿ@@"("("("("("("("("("("("("("("("("("("("("("("("("("("("("("("("("("("("("("("("0>gVA ϗ~Sep[7O׊"Al E@@Bb4!x9gUxS @fV|<חeKy?ޣbʑ>önljjomFcpo|egΘ|y4^v)9k&~03, Ȃ"{l6@yҏ[}!">,P p! Xs{-[{z;k[նylk.L,i2a91` j\' qDG:Y6<Á@I(7P| P!EEԒ(Eo;4v%W<$gyܽ{7|sjժU+ۖ\oZ0kU`~qwc[tDO0 ڄ Zw,=F6DW{y^YrKB4/׀@x(S1cY?d2<`lÎ|Ѷ{^\=g.ĤPpY%iEҙ$,Oc+_E@s0^:BN|hٕ+WrM^777.]45n&p~o'Oe=k'IC Ȼao?5ND? )CQ2A|Ȥ\ A-F0À0yQ3Y僑Svizf˞ouo7y )z``Y' ĄY)E{(@ilGK9Rc~k]\s d/~ v_ģ]=); 4r9t`AM~+X<C"2t,l_\&OaB`(dFAU>ݏ>q@+2Cb֋Xx嚮U(c1T-CĆof#7/_NZ$.z׽X"H׶vtr]'@yr=PݳMfb XJ2a 3p0,) ) FCn}$ og㮟h͓wiO`@ ˥!z(3#Z]E@0J_2$g5cpފ+xu]pO}_H%TݵL8qv19<3R?$/ƅ@E rdOFʥsfBA@{W|/>[G C8yBM˒Px6C -*(A@Q"#`?7|8[.3B_vѲ79npvs[{"tB:a-~4S8A~d;c@er"(OBۑňGmm,vY?'4FzX?WH~DA4H+( 0ja$-p Ug/zg| {g 64ul<B$} `? fHe'(;),)pâp4H[خ}7Љ8GCl# PA Q*9bbÞu]]מyFſMmnkmj4?p+ǤDȕH0C"Wc$ L p7 ) hS[|7~psw$H4D;R-q0((@6eU0(o^?ٛg\<X9w`$?e₣VW"顒~|/?2 8kjŁFzV)/xB*H46FC;>խ \6s/xb- ~?(iD`Оi,>z"@FUtYCزԍ~͟G.U)+XH,\6C6`W>l}823/s#ksg%\ҋps"`907EDY2+ R( o{tε0kLo2}.., `g>VNO`@"&${!\aQ#r=~:J(eE;e`- 5{t?oDA pLK i=aۧ(IEԇi@玾*KnxI`Z|PfT aK,bu;qV|`2)+E LFJ2i5!s'An/LC!S@'.nxFPN!:p GG˖-! []xW_{Ɍ[j(d'Φ ɟ=J~QyOM4{/|/#ogK:q72T)y-[1-JC/,p īSv-=oj?a8޿.KN:7>CN0.u3! z䢢o=~+dz^piJhͥV YCLohoBjdAj8/@F6(E@8p,O"pJx/K4?;Lɱr`~tI!̍8E/Q뇰 qKfʓqY >Oa@'ޘA+՞T˻B w3p=ck?nU4f"*Sڵ+|禞ׯ?isl0{Ѳt͞<?R[//zh" P- + sASٮ37,\>'1P5ߗٖrᦫQP#`hO8 hѢSݸ"DO{" Gi dTRstW'Qekh[*c+؛J';{ƅ_l۽p!DțP=4kE!P{(_յv>ٓwCK$SO~xʨ%炒ܙ``| x9Kݰ㱮d|"D?ʑ?$j",*,[9Oxu =Nf@=B"e!u5E^?' FxL'lPA2Q8sLÆ;AG/Ghޥ P0E`P`"`eR+;v=> @ t8ʩː Uq={D8_wٿ +1+z0W~*7?t{`AۓL=g^%΢kϹ"W02IQ 'ԉ%xSsYg8Z?F;rtǀ˪w=d/%ghb?(3ꟼ˗\|Z P>%bL(' '&5k\{7|1KboHo8d ?dD:d޴sd s. A~E0_!q]"(*(K?'oM% 7f?~տx0]>8+]k &C@QJ^WZe{mY7سk?ԛƃX"߬__/ãj+pc.d;TK\rٹ3T42I+E ?E@&* 8MV@@&=a|zg"g2=`i٭dfӻeT_c?oAf!5-OB K_\!K&k c񭍒2Ŀ7;o(~t{l'ږ$#XVqֿI޿ܓ~oAA-Yfd&}KԺSsKE ` &6/x$wmE@AIG8o^ÜzO \*͉3c,P_  PL.] ^KP<g^+EgeE`P`H٠B@>MzŹzBYiH_6tяV`"袳g.D9 @r7Bt+ *5""8zޒMw_n9ܫ7ᒱyǧD3G?|aY D*?kʬSӊW_\go=*F EAѴl/(zimS/u޿I0(u_.?ғꢍ-5Ay48$|I&@_\$U(' 'JFqq?&g6͗S] 8nf!`׿=Wʛ_K73tɼ(7k!M+FP En"+n<_4Lq1_ؿ@U_$>U lc%Cs2 \+ـ gOrž@%-@9!@*>J" DLF_ɽ8kzl˵0g ?WKC91oua]ә䜩uΟ7yFcH_0L~opi}S 1bk/bhy?s, wg| +GxCh%gΘ X~Cl{銟/V_\S?Q pPig-kQR۴:;Zgnouy]le5m.*Hfr- ً>jE`0D&bts?߷2qao.lā?~`%e濗GRw\"yW.ϙR?0I"#}8bE(pP`Mt>y=\kT7B ^N)\{>d%? ffNk7$}޾? (E@"7W[U2w^:I ;l '1p'`:L69n?4<HPN LC#nJ*J"PQߋ9b| 3B73(@K!3/US}_@&jᘄn fly:%F( =!<3V?i^& 81#N@kiH&ˏjJ}M IBf:\Q"p8o享/Y\sg,:l^L S1ɜJ3KzjE`0 &bD"ųܱh鮞͉[g2xm,9& ?4^ҿ"P5*T D۫x4%A_%V`"6(~3X8cO" 0~>3kMp5"P*TD"5kvyo^0ߩ(4FT-  VZ'46),;`߄Or=+OLŭ.U ~U!Zݥer+t`UNHhVɤ疘_X%_B" £7K_=` MKl& h|$Hrk" dB8AXT&|2T lj ּ Am;ocIBܗ|鯦(GP|D/+"5?p7@͏m0`f'BEp [б4wi*> [-g0E@ ldلs6GwnJ37<ܝ *6x8)7xB%XEe/(HT{(|1" =HsȆC]-iZ] Exǽ f%L`W&7h P8 е\S$0W@_n1-!;,)Lv-b U[2 Z"T UQ<Dܾ~O"h*k}ag)k r!">rb|<=mt) H(ZI<12GL]ps4}4]΃MBx۬iy0MS)܌~E`#P(~ؠ[oxa綽nR|c薖>"ѫA k&%Kx.gqZA'H(In>p^6\.Cx) x3G|G!%&M]ZoiqXS^ӈ[ҿ"P5*T Մo`럽t傤J'NK;C>Av$}y= ~hmi53\&sTp5"h(V F'2t =tbQӱ7)NnEcчbtUרzQ 5@U-jV?ΝZD:݂m4? -4'p|UOcHv?yU4`zAr">\p"рp?QA7 ϴ?{;^pԹ/\0gƂٓ-:cH&LS(q9|6 Ÿr=}3S[J>3VWP@ E`0hKƖc.y跭po)8y(_ɏc@AwCߓs"[79NMNp'M 85u QC<1&W\/}gwܸD:=~jC7JSp(Zqzy,w{]݆ǻ:>O-'r LZ_H~q"$FEjb3ɚ MϿʥs1d vw#z+2^/ E1s̡IA`P ]?EB=#qj 4@p@pҔ<8JM a!l[t*5WpW&BG{;rpϝ9!f/>cڜ v 0k@AY޲_v<̙16e?nt$R׶#%޷hk{[XxNA \4 ٰ'v9&% !q%W"^5"P-*T3Y -=GN^h#:9g@BN8@'q-'O+>iIHU£   17݋޴0 Ъ];@Ξ+Λw'p! #fŀ-xѣn|KdO޿Bt"HɉE@Ix!^6u7W{E4.= k֋}Px ynPԌ)ƮmzH xja>2c<qd:;6O=qT Ķk;!x<} `}>Wx }>)^PQp0PSO֢PS D0>NIIt#F\"0B=ݓƧ"( waeitHwg:3'V=}Z^`5)l|N_Y z} xlgb#zL\+/{NL̯{zN z+iNTMQ, NdkmhDT<gL)JKQ"ptaaO-r箞ԳE/j_Lp&GaE+ki^6fYao;^?V[_~5?o?8%_rf0o'SKϙ31aݿ'=x8frЀmߑ:ŽĞ+| {oD@#_؅dQ{5[t&~IwLǫ\(#ݾXiY{/G9O`zjA9g$ok` 8G8,wÁ sNmq'5Xn8V"N2e f)ueڛZXEXXV!0n:Gw i䛡k~!rc<ëFP5P0`iI뜀V?>mɵ^b ރCfOtzC {<~$Gm)=uptG0((˧Cx g/ QںziPn1#N@8#4ꁅ9l>쾝-t'922v 8t%Q! E`<[[дk.[#A7R\P{:I%f:k1B0/V1~,1~Oqo<v>wљ^l!Dvxi `$9BOW_!>dlG\M\&o+%aajE``M$1h^7Ioݳa'G'%ҹ^sȸ`$ahN\"s'?kÁsoqI|3YG!G3tQLrL`z!ZTaz8wI 5,Dx<0? Bg, pRu՝z7]/D;o PN|Q ;=#1$?=@߆IB&ߒO!FP CL4B"A ^; ۿ;Sٔ[SәfX*hd Pq4}}z;•sgMk@M7TD0Ɨ*u˽߄}7GH>>Qa"0dKlҀKν9}WǤh]!céu( BN>1 qg1NIu4 O`e\PMPd[!f×!$.߄.V3/R" +4`K^'v@rHlXKF]NscXl퍷?/ى3kR\'ilNq{܆I^?؊8zE*Dle"᳆Đ]2|+h iߖa}6CVH?e`xBtI~p~Jz%EAjEDDiJcn !ڧn|]nêQ*0f]yw:ڒ_w=~ޖi8i ;,n9 Fx=@IDAT(' '/ЈO[N26$y)÷~zAd0(o]&#E%h@8}Sĵ@]T0bly)?";!Ih7Ә1OZ1_U!"CF@kiĥaƞI"$Hm@_5_}18y熃6⎑/oyI[ zrbD8f<p_ K0ٺih8e ˻$~!ޣe>{V('L:,4"P6B%`FҷbL&eM9嵶1jPX#V?h~݃Ml7fMp]{MD !v:≮U?^ 3 PW!m!r)H̓3Z]E@&&p*ZrqMR5qO0}x>7.\ 0#y5Yh2qǚZ{` ؘ)?{G[0z=v#D]}J__ޫer+(P`i*0nM' :t`?ͭI$. Teg4x5r ]t΃ͻ!ETbuf#90n<{G0Q!P'€g/߃ PN@"  &f#oܥ'8p~O\޷fU{gW*|wC(xJ@/zji?g0[v80{ObsH;Տz1hIB滓z9WIKWzBUB@Oię~J0N  鷽Z;HCV"'OS>޸=!2d?.A)t636Rӻl#z5\m/B~' 5Bf 7dFPF F IͧO>GMW3-X4dgU͓YLS郈şxӓ;>Ø}8$@qIƚpw=}~qɟ؛d-/n^?Ӊ B@!]{Wa B"p*0ri|C_ Yq?7v$jb0Gɟ(a &9H~%2ս-R\{IIT.m ?qkY!1IVD..I~?`zڌ%"bQOe{:[.E`P`ԜG 6x$l}+.LSK[67/NZg<5  õɉ,qjnlso)[Xll!. b¼Uoo7O lǠ! I/y|m3HDϴ'Kdnk G%dfY7/wͼ(U!@U0i?6`$_ʋnlniKF#8j|3[p0],fAMo{Oo r ͼ#~٨ƿ}˫GǚS5}/9dܲd^+3\Oe;iݻ=h:2#~ ,ɞC2ai ŕp%2.)~o<ǻ^j=yի3LMziF[ɞOK? w!DL~41@Nec8[B,ϼo_s- p.]f5>FPӥ}",p&68|gk{z`IȰLbbz!lʽr>c$}%#^୷j=9\,utέkhtº^dJζ&9qviIJ02s]pZ&168!ggiu;̴g[wux `G-Eh=o"}+qy|Rl@p /Su+.ީpy[?tpWȟKG/#X2,4~?-D&nZmk}]OT8 NU4@"Q0/5JiiqUmM12޽7a~9 7 TygMq|i?wl63lH~6=q{a8x"#fPH003n@sE/ 72Hx~+]?f0gZ=1OXR^}Dmغsڻ۸ᅍ[,zQ+ZwfLbl!Vc P6ڬ@~˖-!oͭ7 ֦@6𔫚p7112'rgI8XGWwoGGgʔ4!'xr0?'Z3_hHbE dMHl H .-xO  -gZaZ\za?k֛ODsF W^+r³^=NgJ`u hDKTz.?֢)y$$޳n}χ|vKBA;dBBk9nMM{fGmݼmϚ;>߿Y${ ??]Xދ˹ WB F8ud״[Pz#B)J$/tV0Keђ#( 9ڨFG>c {f ǚ;R,O)H 8&L&֎CnmM |6{Ǟ;P*>-;=sK_OveN~^q ٯ[j͆~$f!gMB{&ayI3tItf-atp\+BFLc% 7$z(ĥH e/k4?h.4ᐏ_#/? 5HD}K-|'Y|C[ @w.|o {,'$xх }ҠKzݯ|ƒLo->e[;:DqiV]߁' sƛ<8O._Ԋ%i2. cD\nb o^ׇo'>~ҶSZ[!+pbd852HSSdj1zG vy&<0g$h.庺)3MoÕ[}C9oµ `fo9K} r[jF*72]2e9MװE L.ͥSCl{aMo޲c=[:=)`>p'7[ktmiGظ6w `^FOxMKe84$|iMܗBV" jm݆+W\ΙsޡMYbXPq>_/`A.LШa-St'kGcEk덯~_w| (_q3w!ׅP;*sTF 1"M= Ιof9fg3)\+zv G|bLiй#dwSH2 Qb f#Æ샺`Am09\^"fK\.+'O 3<]ܓg!3 ^3~?3?dѼwDZnѣ}X!Y恰 g:zUǔ`!\&4w&7]|W}| ɷ ~1%~zqzP?aNM̎;>PqarQ4 (s%TI#G:;j7ƕ~rYOe-Vv/EߞIzI'kt? #Zs7m??_?e}3LX555!LQq$T>E*C7D4X &H17}cG$ $ ɻM?9QN:%Og\6d7Ggo>su5ͯur.zh8dc}oރɀ{6δ2_gNؓĬތ[.Lҳ ޻K#ׅµ=e'7ZU߾ҋӛ%L, +pGȊd'#B2,r]3W?}+^O;tw'.狟= W4"F8d$cZY G${Zid.F#zHjȱd7μ`9!ICҏ@JrF y ɋ@\7 8F|\E]va|J?[ɏ_|;֜ĆNf%?uO bI^*!nNOpw__]xD7,t@n P7+[#^e<5Nl ؃7d9`I$!ro8;흽MG^n"`'~0O'Oi0͉n;B(:Sk5~aA}^9p G B*tI8Bf_ )ıRz޸4f@u0nt~w"(,x]ȿ35]a%C҇=l qnor_nhm!}vP= ./tX4|=qEK^˛ByuD\ !~NjqKͩB@S>g0$ /c~9B${wVsx׊ot'ӘcuE4˟m|՗ hhaPH8 xT`]c'~ $Oל<(>B@Ç߷>ߟ\_Mtn  ..t-i5zZڻ\*6:^'?.Vxony K^`h LA)p`a~E5# #7TL!@~A3N|Omy~u} &% {>&̯ g?YIgTd0t:F,3˫fx{k[Tx;*`P~0rX~mSeT8UHsLHk$mqIݓ|k~~B@ cN27TWΫ'_:k]P8STO|Ƌɂ@ x"pɅ瞿| Po)B T oT\$W3 2h^1Z/0IJG!c'‘ ΛϤ٘lH P_ʪ xuvv`$V@i+zGwaL> -+_mO@\d 'a0H֦Dޕ…+3> n=8.i80B@_K0`")(;P*qit n'΁n;_b{y 7rv:lqwHjQ:nt\'H삋Μ<+ E `M!@"˼ԜT8 jCF$ib^9߼/f:qs;63}}*m9KP`C[p-j͈֍>ng_w̏Θ>cE<On0վ1794T23cjct?|"K@hdߒXf͌'_Gg݅50?L 7nqHOfRY ̴_(@9$a<>sKK[g %;FxZGF` $y 5/jFTP) _]py|?4Իd2u2h HJ*i5mt4k_n* ,l&;!ӎr-~H_=w),7`570`ojqVn TvW V t㩂ዿXEbl.O 1%HiQe|;uuЗ8EXA1G8'%al.85s@VU/wJ՟* f)EW "+J%5k6w^Hͬ /x A56;f%9؊rP' \?iӦ11Nvİ/]8d9w:rEJSP߯B_qXD@M^- sn\_r/SKc]4mTdTL@K(K*ӝQ1Pɔsӳ]$[_~96"&O;pFçzS)J ʦc8즶#4 y0"K7@J@z\>k ٽSse# EJzx.8t;8- 8u[eU@{0M%Mן,~9yl* GU nk0 ㏜w00ˋ_="~]J%ˡ^ SFDJ*S^ұkvWh%3gLOAưT/)E@O?X.̌$ڌ!0J)P@ÏVlC" gn/1~VnwӪwORqW X^Fe%%UةSWWWN'$(M"p&pfD{dM[:6c@&Wqnbvp`QBC/UM.]==y)-'؛M pvO9!l5m3'QTI,jK%釗[VU>fUpb@" "dNhʼn47oy!ʹW'$2jmlr*(/0gCva^|+D] 䰾}CԢØIg7Ϛ1y<ܶFDOYOwӥ,Gfn$rD`uY3_J}_0J*{ȯ]h{'/^:c7gі"ph@7SqȜIpEP.WnS yYe~ϭc=$OB+pңqŪŃFKgd82^Mn "Ν569_n8@ZYBe iQ <ܚG^rd977Kz.>ajS]X"Peњϫ?ݏ=r&Ml9Qe{_Y؃vsl iQU=n_vo#OZZȊbد.0mJ[YiL .`_W\rXSKUG#K 40 l` -sfNnD@l  H e8. A _kwg,Xi8/C )@J{akD@3r/RQ<23TC;+..Yt: hW$Q+z.?rK>S o=}i= zp8qXEKYfDvs/"{ k0^> k0.Mc/L+nʀRx}erǵ}}X([ gvC`L,g.-~N?Tv%+ ،!` T:݀i|!Dgj\ŭ4kOq/C2gƂ$vu㤮b_L!P\ Vr%- -#{Rʀ\e ` hQ ~hH,fUz$TI;;pC\&ܶ-/jd0fs~z,rIaYɋ)r+0( Sy[ԅ;` \U>PHPbu1)*)c|θ<o?7 n\z)&+NBOhj2i|=!4oi@ʱnzf @|+K#*=lYa"BcM;IJT ú3;/3ޣAE Jf Wer\.iT /|uT3!0 |# b6؄fNdJͭ0 C7}RSkmm>&BJpfsJV0)ς-Rr̖?a.mj`]b9Sّ?7k1s^w)L."Uc33@ə5}r3Q]KI#YCB!f"P+%l'HSC[ [1N)|I<_?f'dz]>XFѕS?W2Ps2!HrOF#cԣyXSn*wW^.+=yfΚzto_:3*1@S}KѰ".KO"g 0``ױ@i{g 6Uǰ倭ٲq+JʀF_sd."](`u`}a B E 7J^fFSFLfÃJig*E\H;p\ŧPʗ!T~0^-wJM~70`YWlEUʑI]nsIgۗD(nV 4@")Q&IIu!"|Jipw%f6cA,e*MIJw/xNmv&KgrB:LO*9@a"` 0chML*Ҵ4& @-,ʓa7vQl+WxXXPqx[JW>Er/QeS +'ﻞPW:wVV~NϞpb .V܊Hdb7WlZ/'ONI#YCB!f"`p\$J{*zrHJY:(?`{z1lJUD H#ncer U Fe% F W(/ܖj'<]p+*TfX S:0n ?013H@ߕf?w*\zuor7p!"Poak{'ȝQ{;0ddthgo_{x.c߶%2f.j,rEW=)AuǣдeŊXhnjkMVVYyݵ{&j"-*Ncn{]G0I* C0|`9&#hif1}m?W ̫8tzUL*R|ƺ ?cFn&Sp$4ShBi,L~>+9S; \{/&2Dp4Ͼ)܄fLQ2G#!qп})ԭ h-nVo#A߻;SDVG{ ؟F 5#E7 1a@M!B2s^I9ygT8KPr&4αK t4kC>tZ1_H"=C9}ҡd:hg yk{boL\4/0*6f \wݳ^W@,+ gG@ ϛ3c?/ $O;xHtʵIPon.E_])) 6pBǮM~S^aS`Y@IDAT>0_YBLQ#7Μ2e@e @|lVu*7Z] Ľ]Qplu``as/Su۝ )zʀbNcΌ;RY *i߈F%`YOmpI Y;xӓ Do_oEB$՞T;8C7g"}ngM o q?j?lo8]=} Xpq =!]}uI b֠YpV}<^<+#?Z@H)@o__j{{Q?{"y]nnt~)ɼ>g &2yguش"%$Ҋ4J8ܗL8dCL >] A4e5uiǿM}8 08Q[ڛ>"`;ڴ= gX)"q^nG!"` `5v w.q&a*__wVH [o?C,<Hf\4J@&N=m№)I%B׭`Ō!0 Xb 8ڻzR8*Y@*=00`Z@-_LwC^ĢDWo<0|8S?wƔ4zЋQ_ALldٙSM~Nd:G_%rTB(Iu3f̵WRF6-Thz$'>o=hJ13cpW5R+ sVpj.v'.8/ʥ><8 /|#SZONvN1 nyȝg [8OM#?2stۻ0G~1ܯ z=й|?Gd)o<N3퍽؟Ar|NL@PſnrMSv=}Lk9m~h,.;]U+[vZPo2UXpty=Ը8 a86 #ՙH*S(~; 0,Hm oua3KcJΞX(h8Z$t}ЗC`\ +)m{W-{1曰(=gB.;!"` `ՏE,X9#݋BisJTdbC7[igyê67ܸu{');\IOQ`v3CD!g駟=ȉ:szzzRqoK]):nKv#UB`6N)g^d$ỗ\? CIg4;; l`2O[!ԏ~t3m큺x"Rrn1F``ي5VwgW8qn/D)`G@ݫqYl&¦8pbb1c +p@WO2r:1%Kɏ_!eE <V?[\?p uteqak$Xdi,fTx4yg_98mrS~2}9/_A `C˼V?Q?W\qGLNo3Ԗ}'L,lJXqˎL&A<\Mnf 4 Rϔ_S}dR*{vVNՙIK!PI'`u[$]—K'YIڴP>HlԱoY羳=5qˊE-Dm~ C`ۃ\|ʭxg4"rI{/_*:60t,d _jUw󏳦_ӓIĢҬUPU+K!Pp)?pFŗ6#蝵K刟ncϏ+i73LXs,'GΘEW_ "aZ+a@&iuҦNS59O"{sɟ+! `CC͂T"ŋIfs vԛ S~Xab0Fg &.'}H -0[ ! /A_lIe3;H-ob@ e۲bT/[%q)d˟tJnf 0^LKֿD:i;2hȿ? p[ H8՛}8G]E"=IG\XiQ[@p f'_o mq8ZSk_ھ@Rd*$U ʅAG?K>ƽ@|O*t!՞O-JCC1|Mx]ߝ] m^Wn&  0^Y"a-.e0o|=䖻ĄT/kW׳~BK9/#w}憑nf3@U"@'#d.͆>Ʃ_ѓb_C6*?%1wt'wt.C\++\ H  of  -[~X %KLwk[|ڴ'lں5^TD-@!b}S]嫶2 ]@vG~E= G9G60ʀ놎yI<Ї/O>5n%e83!?Y.Pe6?yZ"~>soO4GXiQк@5?Nwu]}檋sOϘqMqlh3·X ~oHPSlGPt,*jы$/w0"Iv3@z{f?… èlҏ}S?qQӸoܴ)P [daȦDh-;X'F' 9P$lzKҏ.SdG03Ez'k?`W>}y'_oyL$*444JokG K Cz4xrً2\_4$k]n^d?WxI{3CD!g. /}KY篺'qߜ9k։mm;mu F&l֖FƆh>#,*C`Orh"s7vtvF K.vWQ]q(>J3DahK}qYwf{?] 0anυ4/vgG'ciГ`! C`Xi="lW)]—}.^vf)ς/xI?~}An۾#etcC][Xwᶐ^AGo\" oc6EalGi])KQXbw0`Ġ}gw%g𓗜.M׮$`}C7q8@6?(!OgsDWoZi{vN`DK ߽/J2E@.~ܻ?|p;mt_* C$?xm @w |C*z$)rw ++ŗagk!h"ߧ/}'p欙ڶ=Ncf?/38@6?#}\~[uyuH&zk ےw"~A?"k GYBh b^qAľ~?U܇Zƍ 2:"PF{x=EdtrN̽׏CKz~Ͷo?O-GteJI^dl1G+p=GK7>7}=]|]e[{ Igoe}F=$~p8ïJ<]&\m y/q7;-zKrT_2n3#)#E+$"Þyo|}㙷677ݸi#CTw @6 2_81Zd!bF`_wg$o%O|IE26e,6L*O#ci f_K$ڶ-EBw0s5Ʀ&vL2sx]L^P< |_v6ʣ=ʍ>6tiG2{чϝ9mή|KHސ/Z$v u7*D(ERHH[!` 9w"S ^um7ံm:6ѐ7K.=/ڸ{zz=xB䔉-Ms?-:QH,! ^BO)]QHo2W.~|㏚7mt J@4!}RihbuЯG\$p8@R]|&0V5< f恭}46Կ/ h,rf(+)6;&1 9tG8Ν' ygá0xwoxy͞6; 4C) vtC_næ=)9Hv^zJ%eK@eߴԄ`1b敳gF,jV 3o VJW,-<_qt8Xo_`t򅲆qfsx`ϯJ^L<:)*HH(}u5L6kUqBux.)gG,g_w%]]M;^j%~:^̌c$+VgϞ|[>l[T6Ÿ ~ADzw(Vݴ {Њ/P|uwlsm( 8 'BT:[y_%0RƵ00`sOܹsoOzV%kdFX֮VÎBW!d!㒄Rc -}aݺ|j/zQ"*LhOZ҆/A) ooffo!` B6 \2?1p(+su0X>}ehט@X \7WΡ' [> ?!Lg2š Gfw㩜mya -[.?LRʂ"` YQq ~_ é!%s`[{s_a- HK"I ɅJgsvwA_K5$Qhъ2 `vg8~ ߼;\ w(?Ǎc$|xɒ%䋷1Puؔ?1espǝ`̚>utH0$^ T'oñ1ڇzϾA+GcHZgpKMj9yȄ,}e˓"Q`zgxC>{p*2*g#7R¢i'E"~J]%@•"}Iץx EދV{ԥ.{ح_(C硭ߋg .O?C` Nlz)/G:$zכu_^?c)a.h/aV 1ǖ~U~\\O"'Q)# gDF)p\oܗBh%PZ+:'jrtsZ[ڄ$OvI%W `@,&ѧە."}*cSJP8~?­){*&(;7?Xa\IGߺK QBKЊCla$  ȅDCq{Н+ܵ/{-\(ot=K$d^OYqùIu>B0B@J4[.\F?m/-=}G |t} {R#9pqG4=)vO#.JuoR u3D"k@^6!8\`zۡs C/$u`W=(0⅓){ݪ1c%ھ&.UVe,Ջ7 M]؍.t?.@THU.E"8EFH7D{+Ll}lv\<'pӝ?JKc,)+wlc?7`WtΝL]@]o3*7Y`iM{0/8#͙5y6IC P/2/2QREIR;WD^ ϮX[@r%0MNTH$uں~]+Dぐ;I{u`EųcҥKm'`Сh>^h՝xpYZ Z'Խm; 9ؽ)M!rHܹ[L!ecBV&W<;~vnWOxX]e@~$^񹒟^F p5Fay_5E;8bm<[ @Q}BC! pR`kŝRkƤ@ ]A,̷4GzloǠ`}$.^NpP>3!Eg=dKs@:dj~}5/ޒ@oҸ)\ƒ@PiD{>Qa|8v\bպu@6B)X<jwW 9Cx՚S)]wdxCIww#` ^z_Pe&h_/tL6lʋK9߸ÑUL2:Kq (Nr^K^ے}3,^ftG-IFNK=_.of0`W54oZ-NG6J%?*Zt{U,X[| oŽb `P Ne[pT7u7qn= x4'yɕW/^L8 'VT x./'/җDT; ̌_~9E-q͟clkb?j5Npz_*:yBO;~{XXEǶtlݝl ckn1ERJ~_vxvXjqBCK*"}NE7WA]qP] g3)v -+<oE#-Xe@/!\@~ GEO='쑿Nzͫ"aK$hgy^K7s%@.ShkѨNgs uЕ?;y%o4I{O/EnJ@-B[5y2j>ը&?ğn{x l@7]aޕ7 L Ob/#+?&?Ϋ2gɭreTO'bg6z (f1&Qb__*ooyW/\JK~wI~޻=W/KR*\V4f ?al_y|&Ot${cpxh1c p[ &CK;{Dhdt{Xy=5$dvbKSx߷Z$tK.K!(GR*ژ@徟?P)u+.~8ybK}w_*Մ ~ȕ k>e,~l 8# p&!AtߋIKU +t330`WXFcJ@X$`@~ZI6UY'G~H,H"z%] yݫ.5dDAq|ScdS+6~=&+"rR0Cʄ_ (X{B?v7Ƿ1_0Lg25S){˞{ :D%~{陫 8kƸ?!3/l|_=e*{"uI`=K=_#ƴ@WkOkK~͹=}-McHqXҏ\qwWP/JMll6z=[ p̟-O d.CgEƔ"k>S .KꙟDXU1ҾHGSƊJyo}W|ݏƆ?. )h!PlуI `y:~ү=zgLsY?V<.[4~q_O)җtW=J>@}zq`аnG>k>҄&lRK[U.*X]ϯ^ifu/}9I犁4&Ό3@g84U0\1+ֿ}8?V?e/t"@%@䯸?}) TE1"A'{_xt# 1= &PTl\Xaj޾#7ŎUd{IyؼY ϣ'x1,#;9eoܒe ֥ȟd߽_ yI*If!C2SRWˡ [ D< Yi:P*2i`A˜ksx4[W%mr*w_v CW++L ]a I÷ݽd~&P1M_MI2w%W ?ŘCFP.gP[6ׇ}n՚OTbPO2'PF :1vĎ?BC]mYNP/T=(1E( !C rHf.ɱlM$EKE"8; 7tʛN?} xdx* lީ~8P_g_vKOpI"~_ϰ˜1~/w!` >*^V~_ = B C-yV/u&{g3$!Kr$*V4Ws?S';4B-0p[> ͡¥W]s'Zx{$R6H"fIO.[R*^G{y0LRaQ(J=_>+<% <iу]=f͘:uƔ -a69M/_?ϱ"/=6EfّDN";VcW(;97\ۛ G1mKJR|sS}hoŸhףcySxx ]§]S_*nJϽpLQɣ߽_7TR^e E.-sx=;0?`i'6qLXʣ5EE"6O/۲ ̓V?Éd`O2T:]-CW .x?X [~s߻e,-D"rЏE~җ_/)w_!hd0v@s.G?v+V2 V.-w?ח" Ԩa.M6ɂ!D$C/$vVrg% 8VXlwܷ$0s~PQy@n(ʐ+23r{L*oj ? BKDEI0F=o;z2 t4+* 0LɟD1;Z{dž-ۻ#e~$f΄H8П.H\җO~@Ի)e\LVTȇdd] Ut\ץ$zS}=t-w>,9uڔ xJ[2E‘ *=tuʫ]>R3vm%W^5v%ғk>/<2s?Xb Z-8ɯm{gϗ׋??bs`Wߘ0/ oc @~ N_\R̼+rݭV:^@gO_=?{1˖3k~ǵ%6:sWA{$*ݥQbõ-ʶ45w=.F2MeJG L&̓ϿKTA Ԋ+7+ 6:X1ۘ%+?voYy0pM}I?%[ #eR k)e\LVW+ KNyTn\I;'QINS]E+ilpss̚4o<{/G:pݚ"P-90`78]fS[wR ˅Dz$.X1gpi'̟/tҀ=*h={ |R-q0,VA1~OV?_N HRD.{y9UDNjx ^tv3 C`(_.*&>snñJ(ޮ;-Y˦Mimsԩg6b \%λ?U׷ K&]|xqͦNaC17C}M OB0FrB*.@ 0Т\~p?A?tֺȻ?/.3)%dO͘Pm_;-2J[i[NF ZsTbk7ldպMk1e&O-,$)NR(0 TVaJjҙ\Sc};??=tr ch˿|8S?@I̟1І-ۺk`GGo~b@ JU#{Q p/H(^}Jj41_C-CS*7, P]hLav 7%;{Ƣ!TZ`#R M?v3}<=$81)"{k}Y{{?{/?ŀ,|.[hjjacܟm=Kya_MI|H|NRN] Ԃa2c NH(]~e 0 tϞoʸ;=cOkCݽ\ |! VE.q.khL^z?՛؂'E?e0}:xގ,}ӯq~Nx!64 EÏ/[\Wm`?0[%w)="jy/%*Jƫ轔hjUU`KhE#')K H众tkC& O DEuU ^}Ew̛3}VWw/ OeEf w0ZA _yʗ6{%ޤds~_]o?i\gOo6x"]T2T>zu[:_-g wp!G7`'8SR%=ys5p͟(Fs갎G h*wΛ=mܗ/~9'9ݹ0A GgYb1~YL@?0?ض==~sSɯRw? FdS| R."7Q||?J$<{3U**φ%B/Uh2@wo5?" ~p'̩K5X/T̾D~{̗^XjMs W$Z}8W_n\s}={{8S~ !x7*H(س8kE;::ӷ.|t斧Vkۆ5+~K"eZ$qE."~e80=+w%{nfjj#VAr&+iŊv_'ʀgn$wQ l&Ϻ~3%Hl8xl~'^|vg c\5s/~={)GӛsH, qGxLXR4: X5OloL/|੕?MX :/b.'1:E$l)nv]!K KT1;b,#[dw%HO7ow8z Ѧo\s wrY n}M)!?5㐟Ǟ^]y3[ԜQV? G}Y'r);-?*~Es8 xRA5ںz~sߖZ 1{"~YįVK.v׿_ vIvfNKifjU5B!;]I;/ hX@R GWg3^ Ukh:lzmѯm~o6 or_쿜v?,8&`׼L!IuPxHHHɌY; g"{aݶko{.xa~ €yv Z/IvLR(yI{hgVhgC`/\j )H#/{w%J_Pop͚K8cnGwO.# n5?ZTxnr.>I#RAOievֱG<}GggBBws>qezy %捇X/Uxpë'ccP'Y/dDjE֒n+^-}]e8A/$4JNlk#7jD_uJySغ;%_ҝ@;7X'N?H%nu$1oZgKqVe?z7c~9ͯ;/zיq :d_H9i4DcT,_Xyv-yշȊ:9QcPXH$Y']1Dʒ 뒷9\y3qMCWnWu Is ~w{GaϑЂ-"mYLC#]eh>2kݓiH aÅ`GCmN=_\އ~>zc[G10a[ edt..I$p)"sI_aV)n/3t73Fha٬eSK=Jo4/g 4a~?C\ANAn=k 4,OGq}ח>?Mǵma|t|r:?uH'={î$|=5v,{nzj>iÖ%PP{T /=Eؒ"rR"~W J+h$vmTv.-wՌꞲ՟ E@C@F3&샗b~Y3zaf˰ff}Iō~ֿ1|n[tחNC#W_ Nܶ#YCl~xx')J`x/`\O>`A$(`le[GǺMmۖ=Қ?K\;{bx_ާqP%ֶ1K~ߍO҈Fa,bX+br_L7K*>UƮTH G v`v-<{W`my zS[fVx73XȽ8. S3~(ͧ4ٷ mk6l/1-+_ؾykG7QXEFE"mE[/4,?99Sysvy9ɯ`RYg;PdOZ C QF Pyhe'qѯcy*~9C  ?w ߽I\4"*Yrٳ5?xG6g&55bţq@oMM&cEB6׳ K !BAԤw"!@GJ bDg^XG X\")ｸ ojJԅD1, 2Bo~.Iuty>q_ڽ^}qro- NR2"r/yK#y׍t*z+4N#{D*k)nݕ$} *"% OtڕTþUabfOp<z7;1O[vb/ᒗZ$>(= zN!:%/Nsơ*yH#Bƹ@k#˯+4"U:].9+/L'/e?WXW=>N㗮mX+U++Y?%>O;S{.Eo٤ soYrpd7]JD JW/Z^$I#{cN` =9$z]}nՏ{K +ߥ%q6/Χ%DiޓT8W*~STfW");f O5 ZA@V2r4=1?USضfJP-#^?ZWwū0/yIWF;J$I&]qZ7JZ| Ra~I]} μSz%/GyT:nIx݅͌!` DU\Y{ +;y=z0eXO*c4/-?ŵYo&Ś&<~o^|/ݫH.Z*UZ$N6iˮ{W*=;(^GRvʻ_"]pC`.-;.$[j%'F2qܵW1[H32{*`_4b+K3㥖?QHx"@,p;j/\(U`2nI7JB|Rݰ.+`Its}fvCC?3@-# ~wƭ(UJ2ótuu8s12-DaiwZV녞{a|[c)P-^jK)j%337ݔR@$IUL\)73>RGiSZ)~X !` Ճ$ˮ ahxu+Z'6^CN|T,fT7II~xۻu%Sދ+$gIIºӸS|z+dSʯޯ+?O=ɓTz<>sOשׁ޸?L.k|w=B4}čظFO(>3Iv{^Tv'?`I_%uo0 *XC쎨U^ [8c[ű1=.NIqL*on3/\_=8 %B GDִER (Q~CJ+FGM, 'J,{0`АYAOتhw=ae^jͦ3N}zz40:fWp"X㷣˾{{W_6,1'P&sɘX+=Jq%3{S.{e#*]R Iw)Ǟ]_w뛛dϰs-֜Z!Ǧ ևz `DH,Dn"=K.ѳկuѺ'TJ*޽'wҟ?)'uO(~)|(e\;g2 : XC x/9Kr]Sj~~2l.՛>$haDIrEwIӟ.#w)%OE~)Y ` pг`V?8ɭd00{LL,,6M1V fZE|N`O$J.tZi)'?w%?r=g߻nQ 0P%@-[nԋgK&3¦\ WF "TZxS+{͍K~H%b*[u%.~{D{=c87-GqJҝv^~Rq{/(v3cQ{l X[ѓx߃w7ܳh5w55&X@UٹBp{; ILgVUVuu$FWƖ1Hcad F:%`vKedր$KeiddJH[]2k7^79UUݙYN5&Ll՟~uN;| O9ޢ.Aey6vi ĹYTAc3/gK_O~~D1I MC[[Ns|Ϗ2Y_3n}X6r NcY3/zm7~œ-4Q~(ĐCv\!}{o#_CǼr(Pp ?sA8ڋ}[KNà4m! `[ /l'_}G|n$]T"6v'_hT>KWwğ-/b<[ǰcL֟=s20(dE` ./s aŶ>N]>Vj؜{N^؍wբ>p[\`)v }8,e}]{qecOTP.U@VlpJW/yOrl?{ eUKOyU)tEB> C@G04 ,P(T _ 0 c. mrcѨWN|uϞֺ5_O9t [aELAD`br&F3J- Cٍ/N{ "O3iF$F(aB<ؓ&y6Lb?WGSgW_8~rђ`8͍BKq{`뢵$i(ŗӴ>* rږmU0As =hת_E֯})0enCwuWZ埾=o]m|d w3 R >EyHʫ4 # ?|QOTڟ6{QY=" [&ϺYAD`vso&aٽkKg[szݍ T"ss 8q!$-$-S@_4'~'OsNIуv@Ȋ8ϼI+% `sis]nl[J5bX dŜkYG" S$ `0UlkfW~߿~/uwXhr4` m^qg7e:eE@l1p lŽ[{Zmk!ߍK`In`w aݝ:5xy$>b2L+77m᫮KKQT+kJ;`s{sA8Es>,K(."0%rRՔOgV;Z1կSk{Paw;Aݎ&BЅ1 L"F@׉FC6o2>|?^Unb?WJ?:Nge<ؾ@r%@q[ҕ=ܓΛyuسg ++Mn17-Ro:pEĀ~'K `6Y YAM Z.4EZj+_w/ٳœN$zx <}Z YDn)TMo y/;pWJ̔P-pu\qپoz5hOG(YS 6m8N)&`>oT"8餿D@Vo*=L$Dq|tu"P2rJ֡j `M'GO]Z\1kgϠh`o~5ejy}4`Ahl?9Iz}pho0Ej\+aE@{ PgS};" I@fU݅"W!qKGjn] n0 b [jyK>xSa!7}mqM$&BU@ @p{Ç׏eRt]܉[fqw# m+Zj̓,&}ݕzx ?a> l " [A@VP9rMqfOATÞ?z#=ȗ >;oGX(D?y_#+"0]0*[=ztn߾}g{CIg?ʊ [267ЦGpy_-./~ODDʀ[g>6<6,aD@6MjOe~o摇嗎I>Ʊk źw_uOOsgeE@B@Q@o_=tP 3_~/=g=ncS/Zz1~1\YmW]q| \,56>*sfwtUw (@ر/_㟯գ:Vd6ܑN6xՏ}?ۣZXo}b۪m8޲a]AD`4Q*_8E/^:n|ѮTt&^$@뵪Bb~7`߲ 1A#.B^ٮfQAfc}>_Q$ݹ@_H%sLbV -7^.6?g?_k'uڸ#+"q8CPu]ʷ/~wjnwڏDN(th6;߼$`RF lܧ?W(}6JP GF*/ׇ8tlB q0)j_gWz'~INN[՜8s0`MlF6JP ACsd'?&mjf+B/bA{4(:sf1s׏{')}A#7h$` W*D@H@sHB ][ol=?rGQicsXXM7Oǖ|%ij|h`"l*T${ｷ|Sǿ?{_2|VKӪoG FpӁy8 @;h4}3YVQ /QuMkVZwlv_4[b{5pEj`poIw@xG;| Gݡ:i @iV #<]uͭc_N+vI$In¿ +sfݹh];?6 PSr؟Θߐm-M})#$T0 [R{ꥧ~-}/kK!ژ׋(ajT]Zm_rs`Df(nL di0 #wp:lL:}?ލwt@{,@t H)@Z6sh(٬xG},I} "0 9PS\x_F ʟR׿t`=_v^;7,Gp.F l}nUչ.˟z={Ȥ?z?9tJ>䢽Y1c#Q  `UG`cwW9[SM(jTuNv6v\~]v)P;HqPED@&%oIɩ\. [M6#E?eJxQuI;?h^aM؏qOG#<:pD@& `h*6/+wRRy[U+L; TC :w>λo= եUfh JdѮ' Pt<~-HgwqPDkfdܡF n!Պ=BO'6σ|Y)7 "0)|Dl DGflegJ_C)Xqo Pay(ÎuP>L "PYAOmڵkOj~z qʿAhk0}#, 9E ?HgSi1:t 9r$ݍuq:[!([!]Fj5 9"ȇ4_OlQ4 V !`&9%ШqgS:BD3ՔsTnqXb3; @:E?k9:>\ "Pه6'giaRG{'`X<[ "  `T4zVVVwm`MEgj5|x1A'cC@:tª?7=P'CVD`Br&b!`{7ޒ_fRG9JHT(@.ī 1){$IE@̖eNGl1osGe}" c0&0e/0rC 9i|H a@1$FSQ-} DQ>^ˊL@@T8lz䨻l!A9^qai9j.EG`Їx0XH!7jՁ>?1ƙ" 04)a& GU2,=O" c0,e-0:y q_+=Oѵ@ (t'I3ںQ%3taG;(D@F 08BQeH=S/l@z:8qf`_AD`U@s99F/LNqϩ"PHr mQ $-QQmIjGi>Ƿ:urfgE2 zvלM3LME D 5m.[!=n7'Т^M3d0MVD` L/$$)}7W,LpMY`*TDD+.&z 07FjDeg2)̃4gAɸTah!\tU{GA>žE,0K=mM7Lу>g4oS*-:joZ8b{ o{@h)_'U $悄 )a0y{ՖZB@8qz5XKFۍcL<-ip@5!PXsڄT !6qzl1v{pF=A@xnvS{O{5qOo һTk7isY|\1P VGQՂf~D VGCu"P0r aܑ m.1ӎOsla&.zAJl6/ ivjqRI) 6;8@::#O_Tŕe[   i "  ~m@^ [n:Օj ۑ|I+3qZHx݉'X7烤;gsIm(ƑL*v آF\yeea̓ { 8m2 +-%G:m۶ Q :vHAD`}q #@B FۜyG:3odql??vHa7dpcc',?ac9CA&%GS8Wm!ySh;Lb,Zq3I☿qTϺW Xa@< 5Dq/:t Й1$!(ڴ`ɍ} CZg9E@0FbMQ , 8zqN᧵l C5-y7gt'ũW Ha@( eR(%@@^ҹY4 <e/$=BO _?:Q L IBAbO|~0F Xp?: `cVYE@0HA @h  :8;Ae/{!D}Gd: 6XD@# `<^]\ X >Ñ?G ^}.$~ `|;_ " c0,e-Cƾw q>(Q`~;0/X<>?u㒔UfYl5"BxG 9h~%oÂ=6/<, "0!9SB`@D *>8sx,ş֒F @~#s<-3/2ED`P VSl(a>/h[/ZC<+MD@0KB^t>ĆQ:%{Z/g7E} " c0&0e/[4@ ѧ̏}Ai<&#>p6Q𑞍iA@_\kѡsq}eJf1G𢞍Ȧr, "0~QDYE: iqXOS|S{4$c>6}kHRqo}{<>㰃(l " #З؈4ܧEC+>/,EzdE@F / )K Ϧe=|&l/"0}IYJK`H{IkF,3C@uD?}+%|aBIENDB`ic07>xPNG  IHDR>a AiCCPICC ProfileH wTSϽ7" %z ;HQIP&vDF)VdTG"cE b PQDE݌k 5ޚYg}׺PtX4X\XffGD=HƳ.d,P&s"7C$ E6<~&S2)212 "įl+ɘ&Y4Pޚ%ᣌ\%g|eTI(L0_&l2E9r9hxgIbטifSb1+MxL 0oE%YmhYh~S=zU&ϞAYl/$ZUm@O ޜl^ ' lsk.+7oʿ9V;?#I3eE妧KD d9i,UQ h A1vjpԁzN6p\W p G@ K0ށiABZyCAP8C@&*CP=#t] 4}a ٰ;GDxJ>,_“@FXDBX$!k"EHqaYbVabJ0՘cVL6f3bձX'?v 6-V``[a;p~\2n5׌ &x*sb|! ߏƿ' Zk! $l$T4QOt"y\b)AI&NI$R$)TIj"]&=&!:dGrY@^O$ _%?P(&OJEBN9J@y@yCR nXZOD}J}/G3ɭk{%Oחw_.'_!JQ@SVF=IEbbbb5Q%O@%!BӥyҸM:e0G7ӓ e%e[(R0`3R46i^)*n*|"fLUo՝mO0j&jajj.ϧwϝ_4갺zj=U45nɚ4ǴhZ ZZ^0Tf%9->ݫ=cXgN].[7A\SwBOK/X/_Q>QG[ `Aaac#*Z;8cq>[&IIMST`ϴ kh&45ǢYYF֠9<|y+ =X_,,S-,Y)YXmĚk]c}džjcΦ浭-v};]N"&1=xtv(}'{'IߝY) Σ -rqr.d._xpUەZM׍vm=+KGǔ ^WWbj>:>>>v}/avO8 FV> 2 u/_$\BCv< 5 ]s.,4&yUx~xw-bEDCĻHGKwFGEGME{EEKX,YFZ ={$vrK .3\rϮ_Yq*©L_wד+]eD]cIIIOAu_䩔)3ѩiB%a+]3='/40CiU@ёL(sYfLH$%Y jgGeQn~5f5wugv5k֮\۹Nw]m mHFˍenQQ`hBBQ-[lllfjۗ"^bO%ܒY}WwvwXbY^Ю]WVa[q`id2JjGէ{׿m>PkAma꺿g_DHGGu;776ƱqoC{P38!9 ҝˁ^r۽Ug9];}}_~imp㭎}]/}.{^=}^?z8hc' O*?f`ϳgC/Oϩ+FFGGόzˌㅿ)ѫ~wgbk?Jި9mdwi獵ޫ?cǑOO?w| x&mf2:Y~ pHYs  3IDATx]`\ŵ}m%q6šǐC/? OB @HHB %S 6`K-[J޾ϙ' mْ,wyf{Ν;ɶmKJ=M+eY>@mYT!E?!z{k=< @mYJ\_aJiHiI{R[ ȯ(Dz3!@dǗ iR2K*rUPXˏH u‰&0(l!`>LJlT DOH$MFo.KR<G^I3j4vڄqc'cƍ7< Ļi2U3sS+(aFRV#+Zͺ6iʯ(8!R7.QUݎ&DSg#V_ݞzP۶U1mO>{J#F J  @- ۶<% [?H]ߏn-[{72 Q H>eR]PutD^to>4Mt\570Fm2)IQe%o=yY5_)sr}. ;1IlNϭnMfMUo?oa@.Ln;E0@MCWRnسY9n]x0*H.UQ4|듞"P&F(wK^{pqtU6d2'O.\(qHx8iI ?󇵮 yqݴR zzF ؛Ds Ia%pUYǖ{kWbX/u !Wϟqm1"2:h۴@_?B8& >]1 ˗WRݶ-bMQիW۳f͂8j}rX䒧YzGb豐j.LRۖVd/ Hڂ`M=m銇L?3oHaI:tuui7t,t8]wf BM?\c\| y\BٔaQ-AtÃi !I+si>%'O`ܳL[ aYzݫVR>DBR`1TaΝRt d٘,]TpCP5W<nl՚'0aLC* `¬ D u᪑ A+`?Xڰtqtٖkd0ga@0`Y~M9"g,0 d:H XB&W3^Z@r2h̓UVvC1<|M( C}0:1 TU岲2Q %1;XoJz);áШ`qǏ6-Ӭ<27/pǣKsaj%%%";W 3= H`r<[+ZrMXwhP"ڨ,pStUlA_Ce:l2bAt2rmw~wCpJ!<ܼI2TGs]qБYRgz]Qο~#wÁ><"@"^Z^g& q/ DqeM0 _vRN8Dp,=ʆ{K͛0|CH|(bH^;6[M.H\rPvsNtsߪ;ژ601]Tnxp/=}tQOS]2 h|NϘaٓ;۷vIs vD aRd-k8wQs艒iI^p{g[:c6fڮpI!p ,aei2$~</kΜ9,@_C3v%_teq/x%% (QT]ɪ 6se/HH8O[obIe'Uwv?XȲ-zO}Nr>nz x\߾Q;m(u cp"'':ssg }"8FIg==J0 9ҝ%}TD;|ͫxZVm݆iW\“"۝pCupLCϬھ՛!jŨЎQ0 Q/H+\5L$t;pb08ff''۱Xe8%`C0,c*;2{93ΰx7*z%g|mڼ'艄EMz=Cb&A,vwֵcm!;T~M/uh> ڐ mı_ 7zIb!-MSqW2.R3#>b!Lls.. װFSywW,qւ5[`{E.pKPa0X;ŵ+o3W7W|-(ip86y5wDd o&@2MK7n7ojk:aj0@5&Sƍ-͘q{ʔ &Zi/caf 'Zɡ Hzܢ ]Ow{?>׍ˊ]Y֡V(pKYA+MH ωlqčW>x55zEpa"GQGe'?ߏ ;^\R,}cˋOl#1~ryLȧM;#-֝e뷮xgIiҴib4%=go ><3eE.f T jnb]|e 7lT|! ]w|#G;i(8XIUAK^X~agؾ|uJ*ng?jJGW]*Ӥ8Ufш'?ǭ&tc~17n'F $v]?RrCc7.n(0/05ʲ2$PHt<oY=,N %] /_S[b8?G, 3 '!^ޒ$(eW'pp4 ,bU/=48H)^X{JLX%s}nx~ _O|QA|sm_?nLIv ˁq<|ZSNM1pjElEbz+ޥ.\pWO;a⻟{mͣ o}|7'|ᔜꗞ ɖ!ODk涮N}q{="tJ -e;?7@s90waj=_>`_uTϬ{|Y_@yz:)}Wqjhj ._|ޏb܋/V>lacA $3Ortd)^~_1`@8}ASJaaa/|˖{u+gl}}Y0%,S'Vvv>GqϏ!ŦPXpxa|宪m~+]{B;Cx Xv \RSd0 6 [,H'|2X:(4⎀߈~eO-gD^pw@~%DI)&g+_{5EN;زyK_-Pp)TO /'!5XwI7|鬯 ~<&$#"z)_Sd >P Vp//~ ̙ۑHi hfh, SKo)QC'O%hmjKKT_wt(n Ir u9GH$FLFQ0%nj?Ϝg}$ؙA NH#֮^d_x衇آ\n}ܹ\ #/ڲ&aA$p-%(w+A'j+J pX4DG{(v?U(jjW$f͜:v#()n0=cb$?[SN\4 o HxI jW]y|ꩧ+{K$<7T. @͜붽ߣ#bjO=aH|5+v?n <'zzÀ B[d`G4RsAƌiguH>6EZhD_]#3HvzՅ)œM)k&C:~x^.#rUVVʘj)al(?8Ra_|v}Ejh۠q[ǸeN84C7UmH0ARxpe0Ŭ&)M?+ !-€;='e·gGQ0^l}.ۚ x#M, @x92P0: a`U5e~Ro(q8=.!8?'7jDEճeC G<@ MW}@D\?~|qUhp0Е@=Dn1E5#lN%$|`S-8Ey#,h-jغu1`3$; ~b Ϙ9Kvӆyu~8H&s聿(ZS\V1?J fFٍ҃suuurUUYj gJo-fOi ~L1o\.Xύz @#ΙtNR7Nu!e~Q=rLvfhBY2A~e<R,Z;(|GHP) vv(")̺t4jn ! gJ]g_yr† wY %!*z$%ƪls;jمyYi@*h Ub_LSt@@zq1%DGbyGf?eqdC3*WE9F8z9/!Li3~J1~L&x,H pC k40s?9}ҷt@bbrlrc#S?~|e,GM3 {fNV)WUCY g$15z:r`Q=/ 1d.zi^a@G@gc`:r1G"qEb$Tے:( #˺q#*)9)\Wl \mS`.fLs@P> _`EMن٭wKTҍ:"1b0Y'W\OJIIXv<ӰGH c( Y12p&`7o^p)s΂k^rA 6)7wa vN0f REj5Q~KnnH4k&v\H,]q &~̉);PsUTHmlcsʂT5l8# S cƌUճ%}_H<vl]c`wOW?C92 6EsKPT.hdߧ*7*EĶ UԷq {^Pt#ir72Ag|eHx'ۮK֞иiQJ*ҧa2LQie='#jPX38pwi @ƍaU#V/" \ t[׭ߣlQ\Ax&%-T|6>^շ!|%[ͷ YW;叜.$1I`rk-IKh\[- d݉'xh1A8i"Zmz]k*^wLV#WVtT#:q,5HX<]#6u`ٜCҡ\]Zvke3^ANfgg[{pS 0j|QkXFhnD| ~ʟ_t`R.& ЯTpELK+heo_h,S|ؾKJ~lT~VaX,A.WfILM[O.i\庅@7s#J_ޝ+KP/YB_tشsD'CMA {nNT{˞ b܃ 2 ~}9ssG8i^גp$9Ht{[7T6BO OQ\ j1>Wnx5ؖqp EKb=t,Si>᫏#&x'>TV͔ZX"w3SY;[Uhư;wu1PQ~i(&w kbf2Qc zJp'~a`#CXRnGb7WV@4D,CK[^ .(Z_,Ŀ x^%Dxl5n7 ~2XWQ/m >~:2`q&aוp5sqG D8(*+nXWXfeX\r?kh h6gLl*mR+|!|ә):D;sL)??/eB+֖t7짿y-awD6G(p 8$_$^q{ @a\vԈѱ*Ny #! mPvV5u\_?e(ү\{jAA3J2_T_]c((Sjii8 Gte3Xxt#Zۻ!} ݥ-zu'4v($Vo?\.wozwr@I`s6Ƞӯz//G(-#w:@ b ?^U!(v;V:i"85V@/yg^0|# !3K! #{? KM+|࿯G!<}{yղl bxrϥ:(m7 ` Bf>rO6`C ޭpOeCGYU8!n2~tFZۿ~ѵϙ<Bj(Y@rofR*P*'^<_hnD9(bz=ח]r#(s;v_P07^}U3C#=aV p<]֬Y#RK.C>' "8 E7c:8禛\pAWw qpG1RX&v:x\ʺ⊆oyْu.=Q5iD_5&X.mxW@ ɟ"alPQ=z/ڰwfA:AyyhOSA7R>l 90i NsŢm@V)M1.D8|;//>U 8wvGeęRsKgbÖZHn;@`\o4`FQXCu^?B qip F Zt= mѺ&ٹs&O]U.*Un:)CLj|{Pۮh~@q`ш @<Hgmhy+<J+0úDλsȀϕց΀ >X%rݍ.gt7PS2 T|uWKFi߿؞1sS; r ǻ$>3;$A }S\XX\Z ſ njvj`BV s}'2t}{zyy|}{~wR{|||yw-d|{pv2QWXmxc)aa:{WV⨝]}3]«3=BX׬^j i#> zA$1٪EڱsqǤ 6Mǩ a̷{([t8­Fz̥J1 GlgL JIZæ2oIͪ2"쭶b ߜ@ܰƾź,<B T]YY]Z eI<7-W XOLKZoJOJOPPIUUPKNPMJQJZ0CXNJRaHHX5L,RdB@Mb"uJ9*\BXӉ{meR2wH| @9wA ~bG| lyQ A ~]14 ~|G͈s뢀d}Xw );F^Is:h5];1 3SPx9 INA~i2i~8}$$ㄋJ u~zBه ?  B V_[[_[l8mk RlXF _  7ڲ+wJ<UġG%:]:xKԍ ^Pf<_LgR 3q+1$ 1$g 3aRcic11PNG  IHDR szz AiCCPICC ProfileH wTSϽ7" %z ;HQIP&vDF)VdTG"cE b PQDE݌k 5ޚYg}׺PtX4X\XffGD=HƳ.d,P&s"7C$ E6<~&S2)212 "įl+ɘ&Y4Pޚ%ᣌ\%g|eTI(L0_&l2E9r9hxgIbטifSb1+MxL 0oE%YmhYh~S=zU&ϞAYl/$ZUm@O ޜl^ ' lsk.+7oʿ9V;?#I3eE妧KD d9i,UQ h A1vjpԁzN6p\W p G@ K0ށiABZyCAP8C@&*CP=#t] 4}a ٰ;GDxJ>,_“@FXDBX$!k"EHqaYbVabJ0՘cVL6f3bձX'?v 6-V``[a;p~\2n5׌ &x*sb|! ߏƿ' Zk! $l$T4QOt"y\b)AI&NI$R$)TIj"]&=&!:dGrY@^O$ _%?P(&OJEBN9J@y@yCR nXZOD}J}/G3ɭk{%Oחw_.'_!JQ@SVF=IEbbbb5Q%O@%!BӥyҸM:e0G7ӓ e%e[(R0`3R46i^)*n*|"fLUo՝mO0j&jajj.ϧwϝ_4갺zj=U45nɚ4ǴhZ ZZ^0Tf%9->ݫ=cXgN].[7A\SwBOK/X/_Q>QG[ `Aaac#*Z;8cq>[&IIMST`ϴ kh&45ǢYYF֠9<|y+ =X_,,S-,Y)YXmĚk]c}džjcΦ浭-v};]N"&1=xtv(}'{'IߝY) Σ -rqr.d._xpUەZM׍vm=+KGǔ ^WWbj>:>>>v}/avO8 FV> 2 u/_$\BCv< 5 ]s.,4&yUx~xw-bEDCĻHGKwFGEGME{EEKX,YFZ ={$vrK .3\rϮ_Yq*©L_wד+]eD]cIIIOAu_䩔)3ѩiB%a+]3='/40CiU@ёL(sYfLH$%Y jgGeQn~5f5wugv5k֮\۹Nw]m mHFˍenQQ`hBBQ-[lllfjۗ"^bO%ܒY}WwvwXbY^Ю]WVa[q`id2JjGէ{׿m>PkAma꺿g_DHGGu;776ƱqoC{P38!9 ҝˁ^r۽Ug9];}}_~imp㭎}]/}.{^=}^?z8hc' O*?f`ϳgC/Oϩ+FFGGόzˌㅿ)ѫ~wgbk?Jި9mdwi獵ޫ?cǑOO?w| x&mf2:Y~ pHYs%%IR$OIDATX W l8sƐG0` 4AJTD))Q !/TTB6ԡJpiQK$FU0!566׾iwnfof)L9RQtwDẌɲDDI9"DfZn:;3sge1PJ pǑ2ks1f'1 S7ϖn=>bF >DI*{ǁ9SUG?r;k2m&Sjm TR,pmt3E&>- +7cCP"s:ßR af "^.7jX ,Hg@bc\D͙y?joTU_k$ɣG,3rKut=F{͚e9@(A!riq6!"y΂]XIS-l"p;īyވdC%̻ ֶvuYiL[#i>)Cumƿ$ckާ_^j^Opl&{GIϣ {3UF=2zBkf?Tڎܕ&_tIBE{,1ݿ0ASI3}lA֧;nRE$[^{w㝽1\Xc ⒒W~OneFex o\zWfIK A3:f{vmɧs0 e8 ui ҬY%mَM_B ͙X{eYm(P $G #<+S|TuK|$REm<3agLO5MLI`n62P?qֵk=w~ ! LM!} K64&]vU{Q)FF 0aDP'}*e2?<o,Gut\`B(i}`5۹n8 Ve*O_?^(LK4IHI)''@{TEl{BFât2xE|dx* <ם**mq1%/ B!H}Q` ^[m3$p۝_=rڵDDa#Du *j 'GJOWH埧Q _@>K?bk]V4MD/X5gu20E٫q%gCn8ܗNU34O"s<ײrsr*wz A1vjpԁzN6p\W p G@ K0ށiABZyCAP8C@&*CP=#t] 4}a ٰ;GDxJ>,_“@FXDBX$!k"EHqaYbVabJ0՘cVL6f3bձX'?v 6-V``[a;p~\2n5׌ &x*sb|! ߏƿ' Zk! $l$T4QOt"y\b)AI&NI$R$)TIj"]&=&!:dGrY@^O$ _%?P(&OJEBN9J@y@yCR nXZOD}J}/G3ɭk{%Oחw_.'_!JQ@SVF=IEbbbb5Q%O@%!BӥyҸM:e0G7ӓ e%e[(R0`3R46i^)*n*|"fLUo՝mO0j&jajj.ϧwϝ_4갺zj=U45nɚ4ǴhZ ZZ^0Tf%9->ݫ=cXgN].[7A\SwBOK/X/_Q>QG[ `Aaac#*Z;8cq>[&IIMST`ϴ kh&45ǢYYF֠9<|y+ =X_,,S-,Y)YXmĚk]c}džjcΦ浭-v};]N"&1=xtv(}'{'IߝY) Σ -rqr.d._xpUەZM׍vm=+KGǔ ^WWbj>:>>>v}/avO8 FV> 2 u/_$\BCv< 5 ]s.,4&yUx~xw-bEDCĻHGKwFGEGME{EEKX,YFZ ={$vrK .3\rϮ_Yq*©L_wד+]eD]cIIIOAu_䩔)3ѩiB%a+]3='/40CiU@ёL(sYfLH$%Y jgGeQn~5f5wugv5k֮\۹Nw]m mHFˍenQQ`hBBQ-[lllfjۗ"^bO%ܒY}WwvwXbY^Ю]WVa[q`id2JjGէ{׿m>PkAma꺿g_DHGGu;776ƱqoC{P38!9 ҝˁ^r۽Ug9];}}_~imp㭎}]/}.{^=}^?z8hc' O*?f`ϳgC/Oϩ+FFGGόzˌㅿ)ѫ~wgbk?Jި9mdwi獵ޫ?cǑOO?w| x&mf2:Y~ pHYs%%IR$@IDATx} ]E=]{;BY DqqysDgQm͌q\gQ uDA@& @@N}ݷ;SNwέﯿ@@"("("("("("("("("("("("("("("("("("("("("("("("("("("("("("("("("("("("("("("("0>gVA ϗ~Sep[7O׊"Al E@@Bb4!x9gUxS @fV|<חeKy?ޣbʑ>önljjomFcpo|egΘ|y4^v)9k&~03, Ȃ"{l6@yҏ[}!">,P p! Xs{-[{z;k[նylk.L,i2a91` j\' qDG:Y6<Á@I(7P| P!EEԒ(Eo;4v%W<$gyܽ{7|sjժU+ۖ\oZ0kU`~qwc[tDO0 ڄ Zw,=F6DW{y^YrKB4/׀@x(S1cY?d2<`lÎ|Ѷ{^\=g.ĤPpY%iEҙ$,Oc+_E@s0^:BN|hٕ+WrM^777.]45n&p~o'Oe=k'IC Ȼao?5ND? )CQ2A|Ȥ\ A-F0À0yQ3Y僑Svizf˞ouo7y )z``Y' ĄY)E{(@ilGK9Rc~k]\s d/~ v_ģ]=); 4r9t`AM~+X<C"2t,l_\&OaB`(dFAU>ݏ>q@+2Cb֋Xx嚮U(c1T-CĆof#7/_NZ$.z׽X"H׶vtr]'@yr=PݳMfb XJ2a 3p0,) ) FCn}$ og㮟h͓wiO`@ ˥!z(3#Z]E@0J_2$g5cpފ+xu]pO}_H%TݵL8qv19<3R?$/ƅ@E rdOFʥsfBA@{W|/>[G C8yBM˒Px6C -*(A@Q"#`?7|8[.3B_vѲ79npvs[{"tB:a-~4S8A~d;c@er"(OBۑňGmm,vY?'4FzX?WH~DA4H+( 0ja$-p Ug/zg| {g 64ul<B$} `? fHe'(;),)pâp4H[خ}7Љ8GCl# PA Q*9bbÞu]]מyFſMmnkmj4?p+ǤDȕH0C"Wc$ L p7 ) hS[|7~psw$H4D;R-q0((@6eU0(o^?ٛg\<X9w`$?e₣VW"顒~|/?2 8kjŁFzV)/xB*H46FC;>խ \6s/xb- ~?(iD`Оi,>z"@FUtYCزԍ~͟G.U)+XH,\6C6`W>l}823/s#ksg%\ҋps"`907EDY2+ R( o{tε0kLo2}.., `g>VNO`@"&${!\aQ#r=~:J(eE;e`- 5{t?oDA pLK i=aۧ(IEԇi@玾*KnxI`Z|PfT aK,bu;qV|`2)+E LFJ2i5!s'An/LC!S@'.nxFPN!:p GG˖-! []xW_{Ɍ[j(d'Φ ɟ=J~QyOM4{/|/#ogK:q72T)y-[1-JC/,p īSv-=oj?a8޿.KN:7>CN0.u3! z䢢o=~+dz^piJhͥV YCLohoBjdAj8/@F6(E@8p,O"pJx/K4?;Lɱr`~tI!̍8E/Q뇰 qKfʓqY >Oa@'ޘA+՞T˻B w3p=ck?nU4f"*Sڵ+|禞ׯ?isl0{Ѳt͞<?R[//zh" P- + sASٮ37,\>'1P5ߗٖrᦫQP#`hO8 hѢSݸ"DO{" Gi dTRstW'Qekh[*c+؛J';{ƅ_l۽p!DțP=4kE!P{(_յv>ٓwCK$SO~xʨ%炒ܙ``| x9Kݰ㱮d|"D?ʑ?$j",*,[9Oxu =Nf@=B"e!u5E^?' FxL'lPA2Q8sLÆ;AG/Ghޥ P0E`P`"`eR+;v=> @ t8ʩː Uq={D8_wٿ +1+z0W~*7?t{`AۓL=g^%΢kϹ"W02IQ 'ԉ%xSsYg8Z?F;rtǀ˪w=d/%ghb?(3ꟼ˗\|Z P>%bL(' '&5k\{7|1KboHo8d ?dD:d޴sd s. A~E0_!q]"(*(K?'oM% 7f?~տx0]>8+]k &C@QJ^WZe{mY7سk?ԛƃX"߬__/ãj+pc.d;TK\rٹ3T42I+E ?E@&* 8MV@@&=a|zg"g2=`i٭dfӻeT_c?oAf!5-OB K_\!K&k c񭍒2Ŀ7;o(~t{l'ږ$#XVqֿI޿ܓ~oAA-Yfd&}KԺSsKE ` &6/x$wmE@AIG8o^ÜzO \*͉3c,P_  PL.] ^KP<g^+EgeE`P`H٠B@>MzŹzBYiH_6tяV`"袳g.D9 @r7Bt+ *5""8zޒMw_n9ܫ7ᒱyǧD3G?|aY D*?kʬSӊW_\go=*F EAѴl/(zimS/u޿I0(u_.?ғꢍ-5Ay48$|I&@_\$U(' 'JFqq?&g6͗S] 8nf!`׿=Wʛ_K73tɼ(7k!M+FP En"+n<_4Lq1_ؿ@U_$>U lc%Cs2 \+ـ gOrž@%-@9!@*>J" DLF_ɽ8kzl˵0g ?WKC91oua]ә䜩uΟ7yFcH_0L~opi}S 1bk/bhy?s, wg| +GxCh%gΘ X~Cl{銟/V_\S?Q pPig-kQR۴:;Zgnouy]le5m.*Hfr- ً>jE`0D&bts?߷2qao.lā?~`%e濗GRw\"yW.ϙR?0I"#}8bE(pP`Mt>y=\kT7B ^N)\{>d%? ffNk7$}޾? (E@"7W[U2w^:I ;l '1p'`:L69n?4<HPN LC#nJ*J"PQߋ9b| 3B73(@K!3/US}_@&jᘄn fly:%F( =!<3V?i^& 81#N@kiH&ˏjJ}M IBf:\Q"p8o享/Y\sg,:l^L S1ɜJ3KzjE`0 &bD"ųܱh鮞͉[g2xm,9& ?4^ҿ"P5*T D۫x4%A_%V`"6(~3X8cO" 0~>3kMp5"P*TD"5kvyo^0ߩ(4FT-  VZ'46),;`߄Or=+OLŭ.U ~U!Zݥer+t`UNHhVɤ疘_X%_B" £7K_=` MKl& h|$Hrk" dB8AXT&|2T lj ּ Am;ocIBܗ|鯦(GP|D/+"5?p7@͏m0`f'BEp [б4wi*> [-g0E@ ldلs6GwnJ37<ܝ *6x8)7xB%XEe/(HT{(|1" =HsȆC]-iZ] Exǽ f%L`W&7h P8 е\S$0W@_n1-!;,)Lv-b U[2 Z"T UQ<Dܾ~O"h*k}ag)k r!">rb|<=mt) H(ZI<12GL]ps4}4]΃MBx۬iy0MS)܌~E`#P(~ؠ[oxa綽nR|c薖>"ѫA k&%Kx.gqZA'H(In>p^6\.Cx) x3G|G!%&M]ZoiqXS^ӈ[ҿ"P5*T Մo`럽t傤J'NK;C>Av$}y= ~hmi53\&sTp5"h(V F'2t =tbQӱ7)NnEcчbtUרzQ 5@U-jV?ΝZD:݂m4? -4'p|UOcHv?yU4`zAr">\p"рp?QA7 ϴ?{;^pԹ/\0gƂٓ-:cH&LS(q9|6 Ÿr=}3S[J>3VWP@ E`0hKƖc.y跭po)8y(_ɏc@AwCߓs"[79NMNp'M 85u QC<1&W\/}gwܸD:=~jC7JSp(Zqzy,w{]݆ǻ:>O-'r LZ_H~q"$FEjb3ɚ MϿʥs1d vw#z+2^/ E1s̡IA`P ]?EB=#qj 4@p@pҔ<8JM a!l[t*5WpW&BG{;rpϝ9!f/>cڜ v 0k@AY޲_v<̙16e?nt$R׶#%޷hk{[XxNA \4 ٰ'v9&% !q%W"^5"P-*T3Y -=GN^h#:9g@BN8@'q-'O+>iIHU£   17݋޴0 Ъ];@Ξ+Λw'p! #fŀ-xѣn|KdO޿Bt"HɉE@Ix!^6u7W{E4.= k֋}Px ynPԌ)ƮmzH xja>2c<qd:;6O=qT Ķk;!x<} `}>Wx }>)^PQp0PSO֢PS D0>NIIt#F\"0B=ݓƧ"( waeitHwg:3'V=}Z^`5)l|N_Y z} xlgb#zL\+/{NL̯{zN z+iNTMQ, NdkmhDT<gL)JKQ"ptaaO-r箞ԳE/j_Lp&GaE+ki^6fYao;^?V[_~5?o?8%_rf0o'SKϙ31aݿ'=x8frЀmߑ:ŽĞ+| {oD@#_؅dQ{5[t&~IwLǫ\(#ݾXiY{/G9O`zjA9g$ok` 8G8,wÁ sNmq'5Xn8V"N2e f)ueڛZXEXXV!0n:Gw i䛡k~!rc<ëFP5P0`iI뜀V?>mɵ^b ރCfOtzC {<~$Gm)=uptG0((˧Cx g/ QںziPn1#N@8#4ꁅ9l>쾝-t'922v 8t%Q! E`<[[дk.[#A7R\P{:I%f:k1B0/V1~,1~Oqo<v>wљ^l!Dvxi `$9BOW_!>dlG\M\&o+%aajE``M$1h^7Ioݳa'G'%ҹ^sȸ`$ahN\"s'?kÁsoqI|3YG!G3tQLrL`z!ZTaz8wI 5,Dx<0? Bg, pRu՝z7]/D;o PN|Q ;=#1$?=@߆IB&ߒO!FP CL4B"A ^; ۿ;Sٔ[SәfX*hd Pq4}}z;•sgMk@M7TD0Ɨ*u˽߄}7GH>>Qa"0dKlҀKν9}WǤh]!céu( BN>1 qg1NIu4 O`e\PMPd[!f×!$.߄.V3/R" +4`K^'v@rHlXKF]NscXl퍷?/ى3kR\'ilNq{܆I^?؊8zE*Dle"᳆Đ]2|+h iߖa}6CVH?e`xBtI~p~Jz%EAjEDDiJcn !ڧn|]nêQ*0f]yw:ڒ_w=~ޖi8i ;,n9 Fx=@IDAT(' '/ЈO[N26$y)÷~zAd0(o]&#E%h@8}Sĵ@]T0bly)?";!Ih7Ә1OZ1_U!"CF@kiĥaƞI"$Hm@_5_}18y熃6⎑/oyI[ zrbD8f<p_ K0ٺih8e ˻$~!ޣe>{V('L:,4"P6B%`FҷbL&eM9嵶1jPX#V?h~݃Ml7fMp]{MD !v:≮U?^ 3 PW!m!r)H̓3Z]E@&&p*ZrqMR5qO0}x>7.\ 0#y5Yh2qǚZ{` ؘ)?{G[0z=v#D]}J__ޫer+(P`i*0nM' :t`?ͭI$. Teg4x5r ]t΃ͻ!ETbuf#90n<{G0Q!P'€g/߃ PN@"  &f#oܥ'8p~O\޷fU{gW*|wC(xJ@/zji?g0[v80{ObsH;Տz1hIB滓z9WIKWzBUB@Oię~J0N  鷽Z;HCV"'OS>޸=!2d?.A)t636Rӻl#z5\m/B~' 5Bf 7dFPF F IͧO>GMW3-X4dgU͓YLS郈şxӓ;>Ø}8$@qIƚpw=}~qɟ؛d-/n^?Ӊ B@!]{Wa B"p*0ri|C_ Yq?7v$jb0Gɟ(a &9H~%2ս-R\{IIT.m ?qkY!1IVD..I~?`zڌ%"bQOe{:[.E`P`ԜG 6x$l}+.LSK[67/NZg<5  õɉ,qjnlso)[Xll!. b¼Uoo7O lǠ! I/y|m3HDϴ'Kdnk G%dfY7/wͼ(U!@U0i?6`$_ʋnlniKF#8j|3[p0],fAMo{Oo r ͼ#~٨ƿ}˫GǚS5}/9dܲd^+3\Oe;iݻ=h:2#~ ,ɞC2ai ŕp%2.)~o<ǻ^j=yի3LMziF[ɞOK? w!DL~41@Nec8[B,ϼo_s- p.]f5>FPӥ}",p&68|gk{z`IȰLbbz!lʽr>c$}%#^୷j=9\,utέkhtº^dJζ&9qviIJ02s]pZ&168!ggiu;̴g[wux `G-Eh=o"}+qy|Rl@p /Su+.ީpy[?tpWȟKG/#X2,4~?-D&nZmk}]OT8 NU4@"Q0/5JiiqUmM12޽7a~9 7 TygMq|i?wl63lH~6=q{a8x"#fPH003n@sE/ 72Hx~+]?f0gZ=1OXR^}Dmغsڻ۸ᅍ[,zQ+ZwfLbl!Vc P6ڬ@~˖-!oͭ7 ֦@6𔫚p7112'rgI8XGWwoGGgʔ4!'xr0?'Z3_hHbE dMHl H .-xO  -gZaZ\za?k֛ODsF W^+r³^=NgJ`u hDKTz.?֢)y$$޳n}χ|vKBA;dBBk9nMM{fGmݼmϚ;>߿Y${ ??]Xދ˹ WB F8ud״[Pz#B)J$/tV0Keђ#( 9ڨFG>c {f ǚ;R,O)H 8&L&֎CnmM |6{Ǟ;P*>-;=sK_OveN~^q ٯ[j͆~$f!gMB{&ayI3tItf-atp\+BFLc% 7$z(ĥH e/k4?h.4ᐏ_#/? 5HD}K-|'Y|C[ @w.|o {,'$xх }ҠKzݯ|ƒLo->e[;:DqiV]߁' sƛ<8O._Ԋ%i2. cD\nb o^ׇo'>~ҶSZ[!+pbd852HSSdj1zG vy&<0g$h.庺)3MoÕ[}C9oµ `fo9K} r[jF*72]2e9MװE L.ͥSCl{aMo޲c=[:=)`>p'7[ktmiGظ6w `^FOxMKe84$|iMܗBV" jm݆+W\ΙsޡMYbXPq>_/`A.LШa-St'kGcEk덯~_w| (_q3w!ׅP;*sTF 1"M= Ιof9fg3)\+zv G|bLiй#dwSH2 Qb f#Æ샺`Am09\^"fK\.+'O 3<]ܓg!3 ^3~?3?dѼwDZnѣ}X!Y恰 g:zUǔ`!\&4w&7]|W}| ɷ ~1%~zqzP?aNM̎;>PqarQ4 (s%TI#G:;j7ƕ~rYOe-Vv/EߞIzI'kt? #Zs7m??_?e}3LX555!LQq$T>E*C7D4X &H17}cG$ $ ɻM?9QN:%Og\6d7Ggo>su5ͯur.zh8dc}oރɀ{6δ2_gNؓĬތ[.Lҳ ޻K#ׅµ=e'7ZU߾ҋӛ%L, +pGȊd'#B2,r]3W?}+^O;tw'.狟= W4"F8d$cZY G${Zid.F#zHjȱd7μ`9!ICҏ@JrF y ɋ@\7 8F|\E]va|J?[ɏ_|;֜ĆNf%?uO bI^*!nNOpw__]xD7,t@n P7+[#^e<5Nl ؃7d9`I$!ro8;흽MG^n"`'~0O'Oi0͉n;B(:Sk5~aA}^9p G B*tI8Bf_ )ıRz޸4f@u0nt~w"(,x]ȿ35]a%C҇=l qnor_nhm!}vP= ./tX4|=qEK^˛ByuD\ !~NjqKͩB@S>g0$ /c~9B${wVsx׊ot'ӘcuE4˟m|՗ hhaPH8 xT`]c'~ $Oל<(>B@Ç߷>ߟ\_Mtn  ..t-i5zZڻ\*6:^'?.Vxony K^`h LA)p`a~E5# #7TL!@~A3N|Omy~u} &% {>&̯ g?YIgTd0t:F,3˫fx{k[Tx;*`P~0rX~mSeT8UHsLHk$mqIݓ|k~~B@ cN27TWΫ'_:k]P8STO|Ƌɂ@ x"pɅ瞿| Po)B T oT\$W3 2h^1Z/0IJG!c'‘ ΛϤ٘lH P_ʪ xuvv`$V@i+zGwaL> -+_mO@\d 'a0H֦Dޕ…+3> n=8.i80B@_K0`")(;P*qit n'΁n;_b{y 7rv:lqwHjQ:nt\'H삋Μ<+ E `M!@"˼ԜT8 jCF$ib^9߼/f:qs;63}}*m9KP`C[p-j͈֍>ng_w̏Θ>cE<On0վ1794T23cjct?|"K@hdߒXf͌'_Gg݅50?L 7nqHOfRY ̴_(@9$a<>sKK[g %;FxZGF` $y 5/jFTP) _]py|?4Իd2u2h HJ*i5mt4k_n* ,l&;!ӎr-~H_=w),7`570`ojqVn TvW V t㩂ዿXEbl.O 1%HiQe|;uuЗ8EXA1G8'%al.85s@VU/wJ՟* f)EW "+J%5k6w^Hͬ /x A56;f%9؊rP' \?iӦ11Nvİ/]8d9w:rEJSP߯B_qXD@M^- sn\_r/SKc]4mTdTL@K(K*ӝQ1Pɔsӳ]$[_~96"&O;pFçzS)J ʦc8즶#4 y0"K7@J@z\>k ٽSse# EJzx.8t;8- 8u[eU@{0M%Mן,~9yl* GU nk0 ㏜w00ˋ_="~]J%ˡ^ SFDJ*S^ұkvWh%3gLOAưT/)E@O?X.̌$ڌ!0J)P@ÏVlC" gn/1~VnwӪwORqW X^Fe%%UةSWWWN'$(M"p&pfD{dM[:6c@&Wqnbvp`QBC/UM.]==y)-'؛M pvO9!l5m3'QTI,jK%釗[VU>fUpb@" "dNhʼn47oy!ʹW'$2jmlr*(/0gCva^|+D] 䰾}CԢØIg7Ϛ1y<ܶFDOYOwӥ,Gfn$rD`uY3_J}_0J*{ȯ]h{'/^:c7gі"ph@7SqȜIpEP.WnS yYe~ϭc=$OB+pңqŪŃFKgd82^Mn "Ν569_n8@ZYBe iQ <ܚG^rd977Kz.>ajS]X"Peњϫ?ݏ=r&Ml9Qe{_Y؃vsl iQU=n_vo#OZZȊbد.0mJ[YiL .`_W\rXSKUG#K 40 l` -sfNnD@l  H e8. A _kwg,Xi8/C )@J{akD@3r/RQ<23TC;+..Yt: hW$Q+z.?rK>S o=}i= zp8qXEKYfDvs/"{ k0^> k0.Mc/L+nʀRx}erǵ}}X([ gvC`L,g.-~N?Tv%+ ،!` T:݀i|!Dgj\ŭ4kOq/C2gƂ$vu㤮b_L!P\ Vr%- -#{Rʀ\e ` hQ ~hH,fUz$TI;;pC\&ܶ-/jd0fs~z,rIaYɋ)r+0( Sy[ԅ;` \U>PHPbu1)*)c|θ<o?7 n\z)&+NBOhj2i|=!4oi@ʱnzf @|+K#*=lYa"BcM;IJT ú3;/3ޣAE Jf Wer\.iT /|uT3!0 |# b6؄fNdJͭ0 C7}RSkmm>&BJpfsJV0)ς-Rr̖?a.mj`]b9Sّ?7k1s^w)L."Uc33@ə5}r3Q]KI#YCB!f"P+%l'HSC[ [1N)|I<_?f'dz]>XFѕS?W2Ps2!HrOF#cԣyXSn*wW^.+=yfΚzto_:3*1@S}KѰ".KO"g 0``ױ@i{g 6Uǰ倭ٲq+JʀF_sd."](`u`}a B E 7J^fFSFLfÃJig*E\H;p\ŧPʗ!T~0^-wJM~70`YWlEUʑI]nsIgۗD(nV 4@")Q&IIu!"|Jipw%f6cA,e*MIJw/xNmv&KgrB:LO*9@a"` 0chML*Ҵ4& @-,ʓa7vQl+WxXXPqx[JW>Er/QeS +'ﻞPW:wVV~NϞpb .V܊Hdb7WlZ/'ONI#YCB!f"`p\$J{*zrHJY:(?`{z1lJUD H#ncer U Fe% F W(/ܖj'<]p+*TfX S:0n ?013H@ߕf?w*\zuor7p!"Poak{'ȝQ{;0ddthgo_{x.c߶%2f.j,rEW=)AuǣдeŊXhnjkMVVYyݵ{&j"-*Ncn{]G0I* C0|`9&#hif1}m?W ̫8tzUL*R|ƺ ?cFn&Sp$4ShBi,L~>+9S; \{/&2Dp4Ͼ)܄fLQ2G#!qп})ԭ h-nVo#A߻;SDVG{ ؟F 5#E7 1a@M!B2s^I9ygT8KPr&4αK t4kC>tZ1_H"=C9}ҡd:hg yk{boL\4/0*6f \wݳ^W@,+ gG@ ϛ3c?/ $O;xHtʵIPon.E_])) 6pBǮM~S^aS`Y@IDAT>0_YBLQ#7Μ2e@e @|lVu*7Z] Ľ]Qplu``as/Su۝ )zʀbNcΌ;RY *i߈F%`YOmpI Y;xӓ Do_oEB$՞T;8C7g"}ngM o q?j?lo8]=} Xpq =!]}uI b֠YpV}<^<+#?Z@H)@o__j{{Q?{"y]nnt~)ɼ>g &2yguش"%$Ҋ4J8ܗL8dCL >] A4e5uiǿM}8 08Q[ڛ>"`;ڴ= gX)"q^nG!"` `5v w.q&a*__wVH [o?C,<Hf\4J@&N=m№)I%B׭`Ō!0 Xb 8ڻzR8*Y@*=00`Z@-_LwC^ĢDWo<0|8S?wƔ4zЋQ_ALldٙSM~Nd:G_%rTB(Iu3f̵WRF6-Thz$'>o=hJ13cpW5R+ sVpj.v'.8/ʥ><8 /|#SZONvN1 nyȝg [8OM#?2stۻ0G~1ܯ z=й|?Gd)o<N3퍽؟Ar|NL@PſnrMSv=}Lk9m~h,.;]U+[vZPo2UXpty=Ը8 a86 #ՙH*S(~; 0,Hm oua3KcJΞX(h8Z$t}ЗC`\ +)m{W-{1曰(=gB.;!"` `ՏE,X9#݋BisJTdbC7[igyê67ܸu{');\IOQ`v3CD!g駟=ȉ:szzzRqoK]):nKv#UB`6N)g^d$ỗ\? CIg4;; l`2O[!ԏ~t3m큺x"Rrn1F``ي5VwgW8qn/D)`G@ݫqYl&¦8pbb1c +p@WO2r:1%Kɏ_!eE <V?[\?p uteqak$Xdi,fTx4yg_98mrS~2}9/_A `C˼V?Q?W\qGLNo3Ԗ}'L,lJXqˎL&A<\Mnf 4 Rϔ_S}dR*{vVNՙIK!PI'`u[$]—K'YIڴP>HlԱoY羳=5qˊE-Dm~ C`ۃ\|ʭxg4"rI{/_*:60t,d _jUw󏳦_ӓIĢҬUPU+K!Pp)?pFŗ6#蝵K刟ncϏ+i73LXs,'GΘEW_ "aZ+a@&iuҦNS59O"{sɟ+! `CC͂T"ŋIfs vԛ S~Xab0Fg &.'}H -0[ ! /A_lIe3;H-ob@ e۲bT/[%q)d˟tJnf 0^LKֿD:i;2hȿ? p[ H8՛}8G]E"=IG\XiQ[@p f'_o mq8ZSk_ھ@Rd*$U ʅAG?K>ƽ@|O*t!՞O-JCC1|Mx]ߝ] m^Wn&  0^Y"a-.e0o|=䖻ĄT/kW׳~BK9/#w}憑nf3@U"@'#d.͆>Ʃ_ѓb_C6*?%1wt'wt.C\++\ H  of  -[~X %KLwk[|ڴ'lں5^TD-@!b}S]嫶2 ]@vG~E= G9G60ʀ놎yI<Ї/O>5n%e83!?Y.Pe6?yZ"~>soO4GXiQк@5?Nwu]}檋sOϘqMqlh3·X ~oHPSlGPt,*jы$/w0"Iv3@z{f?… èlҏ}S?qQӸoܴ)P [daȦDh-;X'F' 9P$lzKҏ.SdG03Ez'k?`W>}y'_oyL$*444JokG K Cz4xrً2\_4$k]n^d?WxI{3CD!g. /}KY篺'qߜ9k։mm;mu F&l֖FƆh>#,*C`Orh"s7vtvF K.vWQ]q(>J3DahK}qYwf{?] 0anυ4/vgG'ciГ`! C`Xi="lW)]—}.^vf)ς/xI?~}An۾#etcC][Xwᶐ^AGo\" oc6EalGi])KQXbw0`Ġ}gw%g𓗜.M׮$`}C7q8@6?(!OgsDWoZi{vN`DK ߽/J2E@.~ܻ?|p;mt_* C$?xm @w |C*z$)rw ++ŗagk!h"ߧ/}'p欙ڶ=Ncf?/38@6?#}\~[uyuH&zk ےw"~A?"k GYBh b^qAľ~?U܇Zƍ 2:"PF{x=EdtrN̽׏CKz~Ͷo?O-GteJI^dl1G+p=GK7>7}=]|]e[{ Igoe}F=$~p8ïJ<]&\m y/q7;-zKrT_2n3#)#E+$"Þyo|}㙷677ݸi#CTw @6 2_81Zd!bF`_wg$o%O|IE26e,6L*O#ci f_K$ڶ-EBw0s5Ʀ&vL2sx]L^P< |_v6ʣ=ʍ>6tiG2{чϝ9mή|KHސ/Z$v u7*D(ERHH[!` 9w"S ^um7ံm:6ѐ7K.=/ڸ{zz=xB䔉-Ms?-:QH,! ^BO)]QHo2W.~|㏚7mt J@4!}RihbuЯG\$p8@R]|&0V5< f恭}46Կ/ h,rf(+)6;&1 9tG8Ν' ygá0xwoxy͞6; 4C) vtC_næ=)9Hv^zJ%eK@eߴԄ`1b敳gF,jV 3o VJW,-<_qt8Xo_`t򅲆qfsx`ϯJ^L<:)*HH(}u5L6kUqBux.)gG,g_w%]]M;^j%~:^̌c$+VgϞ|[>l[T6Ÿ ~ADzw(Vݴ {Њ/P|uwlsm( 8 'BT:[y_%0RƵ00`sOܹsoOzV%kdFX֮VÎBW!d!㒄Rc -}aݺ|j/zQ"*LhOZ҆/A) ooffo!` B6 \2?1p(+su0X>}ehט@X \7WΡ' [> ?!Lg2š Gfw㩜mya -[.?LRʂ"` YQq ~_ é!%s`[{s_a- HK"I ɅJgsvwA_K5$Qhъ2 `vg8~ ߼;\ w(?Ǎc$|xɒ%䋷1Puؔ?1espǝ`̚>utH0$^ T'oñ1ڇzϾA+GcHZgpKMj9yȄ,}e˓"Q`zgxC>{p*2*g#7R¢i'E"~J]%@•"}Iץx EދV{ԥ.{ح_(C硭ߋg .O?C` Nlz)/G:$zכu_^?c)a.h/aV 1ǖ~U~\\O"'Q)# gDF)p\oܗBh%PZ+:'jrtsZ[ڄ$OvI%W `@,&ѧە."}*cSJP8~?­){*&(;7?Xa\IGߺK QBKЊCla$  ȅDCq{Н+ܵ/{-\(ot=K$d^OYqùIu>B0B@J4[.\F?m/-=}G |t} {R#9pqG4=)vO#.JuoR u3D"k@^6!8\`zۡs C/$u`W=(0⅓){ݪ1c%ھ&.UVe,Ջ7 M]؍.t?.@THU.E"8EFH7D{+Ll}lv\<'pӝ?JKc,)+wlc?7`WtΝL]@]o3*7Y`iM{0/8#͙5y6IC P/2/2QREIR;WD^ ϮX[@r%0MNTH$uں~]+Dぐ;I{u`EųcҥKm'`Сh>^h՝xpYZ Z'Խm; 9ؽ)M!rHܹ[L!ecBV&W<;~vnWOxX]e@~$^񹒟^F p5Fay_5E;8bm<[ @Q}BC! pR`kŝRkƤ@ ]A,̷4GzloǠ`}$.^NpP>3!Eg=dKs@:dj~}5/ޒ@oҸ)\ƒ@PiD{>Qa|8v\bպu@6B)X<jwW 9Cx՚S)]wdxCIww#` ^z_Pe&h_/tL6lʋK9߸ÑUL2:Kq (Nr^K^ے}3,^ftG-IFNK=_.of0`W54oZ-NG6J%?*Zt{U,X[| oŽb `P Ne[pT7u7qn= x4'yɕW/^L8 'VT x./'/җDT; ̌_~9E-q͟clkb?j5Npz_*:yBO;~{XXEǶtlݝl ckn1ERJ~_vxvXjqBCK*"}NE7WA]qP] g3)v -+<oE#-Xe@/!\@~ GEO='쑿Nzͫ"aK$hgy^K7s%@.ShkѨNgs uЕ?;y%o4I{O/EnJ@-B[5y2j>ը&?ğn{x l@7]aޕ7 L Ob/#+?&?Ϋ2gɭreTO'bg6z (f1&Qb__*ooyW/\JK~wI~޻=W/KR*\V4f ?al_y|&Ot${cpxh1c p[ &CK;{Dhdt{Xy=5$dvbKSx߷Z$tK.K!(GR*ژ@徟?P)u+.~8ybK}w_*Մ ~ȕ k>e,~l 8# p&!AtߋIKU +t330`WXFcJ@X$`@~ZI6UY'G~H,H"z%] yݫ.5dDAq|ScdS+6~=&+"rR0Cʄ_ (X{B?v7Ƿ1_0Lg25S){˞{ :D%~{陫 8kƸ?!3/l|_=e*{"uI`=K=_#ƴ@WkOkK~͹=}-McHqXҏ\qwWP/JMll6z=[ p̟-O d.CgEƔ"k>S .KꙟDXU1ҾHGSƊJyo}W|ݏƆ?. )h!PlуI `y:~ү=zgLsY?V<.[4~q_O)җtW=J>@}zq`аnG>k>҄&lRK[U.*X]ϯ^ifu/}9I犁4&Ό3@g84U0\1+ֿ}8?V?e/t"@%@䯸?}) TE1"A'{_xt# 1= &PTl\Xaj޾#7ŎUd{IyؼY ϣ'x1,#;9eoܒe ֥ȟd߽_ yI*If!C2SRWˡ [ D< Yi:P*2i`A˜ksx4[W%mr*w_v CW++L ]a I÷ݽd~&P1M_MI2w%W ?ŘCFP.gP[6ׇ}n՚OTbPO2'PF :1vĎ?BC]mYNP/T=(1E( !C rHf.ɱlM$EKE"8; 7tʛN?} xdx* lީ~8P_g_vKOpI"~_ϰ˜1~/w!` >*^V~_ = B C-yV/u&{g3$!Kr$*V4Ws?S';4B-0p[> ͡¥W]s'Zx{$R6H"fIO.[R*^G{y0LRaQ(J=_>+<% <iу]=f͘:uƔ -a69M/_?ϱ"/=6EfّDN";VcW(;97\ۛ G1mKJR|sS}hoŸhףcySxx ]§]S_*nJϽpLQɣ߽_7TR^e E.-sx=;0?`i'6qLXʣ5EE"6O/۲ ̓V?Éd`O2T:]-CW .x?X [~s߻e,-D"rЏE~җ_/)w_!hd0v@s.G?v+V2 V.-w?ח" Ԩa.M6ɂ!D$C/$vVrg% 8VXlwܷ$0s~PQy@n(ʐ+23r{L*oj ? BKDEI0F=o;z2 t4+* 0LɟD1;Z{dž-ۻ#e~$f΄H8П.H\җO~@Ի)e\LVTȇdd] Ut\ץ$zS}=t-w>,9uڔ xJ[2E‘ *=tuʫ]>R3vm%W^5v%ғk>/<2s?Xb Z-8ɯm{gϗ׋??bs`Wߘ0/ oc @~ N_\R̼+rݭV:^@gO_=?{1˖3k~ǵ%6:sWA{$*ݥQbõ-ʶ45w=.F2MeJG L&̓ϿKTA Ԋ+7+ 6:X1ۘ%+?voYy0pM}I?%[ #eR k)e\LVW+ KNyTn\I;'QINS]E+ilpss̚4o<{/G:pݚ"P-90`78]fS[wR ˅Dz$.X1gpi'̟/tҀ=*h={ |R-q0,VA1~OV?_N HRD.{y9UDNjx ^tv3 C`(_.*&>snñJ(ޮ;-Y˦Mimsԩg6b \%λ?U׷ K&]|xqͦNaC17C}M OB0FrB*.@ 0Т\~p?A?tֺȻ?/.3)%dO͘Pm_;-2J[i[NF ZsTbk7ldպMk1e&O-,$)NR(0 TVaJjҙ\Sc};??=tr ch˿|8S?@I̟1І-ۺk`GGo~b@ JU#{Q p/H(^}Jj41_C-CS*7, P]hLav 7%;{Ƣ!TZ`#R M?v3}<=$81)"{k}Y{{?{/?ŀ,|.[hjjacܟm=Kya_MI|H|NRN] Ԃa2c NH(]~e 0 tϞoʸ;=cOkCݽ\ |! VE.q.khL^z?՛؂'E?e0}:xގ,}ӯq~Nx!64 EÏ/[\Wm`?0[%w)="jy/%*Jƫ轔hjUU`KhE#')K H众tkC& O DEuU ^}Ew̛3}VWw/ OeEf w0ZA _yʗ6{%ޤds~_]o?i\gOo6x"]T2T>zu[:_-g wp!G7`'8SR%=ys5p͟(Fs갎G h*wΛ=mܗ/~9'9ݹ0A GgYb1~YL@?0?ض==~sSɯRw? FdS| R."7Q||?J$<{3U**φ%B/Uh2@wo5?" ~p'̩K5X/T̾D~{̗^XjMs W$Z}8W_n\s}={{8S~ !x7*H(س8kE;::ӷ.|t斧Vkۆ5+~K"eZ$qE."~e80=+w%{nfjj#VAr&+iŊv_'ʀgn$wQ l&Ϻ~3%Hl8xl~'^|vg c\5s/~={)GӛsH, qGxLXR4: X5OloL/|੕?MX :/b.'1:E$l)nv]!K KT1;b,#[dw%HO7ow8z Ѧo\s wrY n}M)!?5㐟Ǟ^]y3[ԜQV? G}Y'r);-?*~Es8 xRA5ںz~sߖZ 1{"~YįVK.v׿_ vIvfNKifjU5B!;]I;/ hX@R GWg3^ Ukh:lzmѯm~o6 or_쿜v?,8&`׼L!IuPxHHHɌY; g"{aݶko{.xa~ €yv Z/IvLR(yI{hgVhgC`/\j )H#/{w%J_Pop͚K8cnGwO.# n5?ZTxnr.>I#RAOievֱG<}GggBBws>qezy %捇X/Uxpë'ccP'Y/dDjE֒n+^-}]e8A/$4JNlk#7jD_uJySغ;%_ҝ@;7X'N?H%nu$1oZgKqVe?z7c~9ͯ;/zיq :d_H9i4DcT,_Xyv-yշȊ:9QcPXH$Y']1Dʒ 뒷9\y3qMCWnWu Is ~w{GaϑЂ-"mYLC#]eh>2kݓiH aÅ`GCmN=_\އ~>zc[G10a[ edt..I$p)"sI_aV)n/3t73Fha٬eSK=Jo4/g 4a~?C\ANAn=k 4,OGq}ח>?Mǵma|t|r:?uH'={î$|=5v,{nzj>iÖ%PP{T /=Eؒ"rR"~W J+h$vmTv.-wՌꞲ՟ E@C@F3&샗b~Y3zaf˰ff}Iō~ֿ1|n[tחNC#W_ Nܶ#YCl~xx')J`x/`\O>`A$(`le[GǺMmۖ=Қ?K\;{bx_ާqP%ֶ1K~ߍO҈Fa,bX+br_L7K*>UƮTH G v`v-<{W`my zS[fVx73XȽ8. S3~(ͧ4ٷ mk6l/1-+_ؾykG7QXEFE"mE[/4,?99Sysvy9ɯ`RYg;PdOZ C QF Pyhe'qѯcy*~9C  ?w ߽I\4"*Yrٳ5?xG6g&55bţq@oMM&cEB6׳ K !BAԤw"!@GJ bDg^XG X\")ｸ ojJԅD1, 2Bo~.Iuty>q_ڽ^}qro- NR2"r/yK#y׍t*z+4N#{D*k)nݕ$} *"% OtڕTþUabfOp<z7;1O[vb/ᒗZ$>(= zN!:%/Nsơ*yH#Bƹ@k#˯+4"U:].9+/L'/e?WXW=>N㗮mX+U++Y?%>O;S{.Eo٤ soYrpd7]JD JW/Z^$I#{cN` =9$z]}nՏ{K +ߥ%q6/Χ%DiޓT8W*~STfW");f O5 ZA@V2r4=1?USضfJP-#^?ZWwū0/yIWF;J$I&]qZ7JZ| Ra~I]} μSz%/GyT:nIx݅͌!` DU\Y{ +;y=z0eXO*c4/-?ŵYo&Ś&<~o^|/ݫH.Z*UZ$N6iˮ{W*=;(^GRvʻ_"]pC`.-;.$[j%'F2qܵW1[H32{*`_4b+K3㥖?QHx"@,p;j/\(U`2nI7JB|Rݰ.+`Its}fvCC?3@-# ~wƭ(UJ2ótuu8s12-DaiwZV녞{a|[c)P-^jK)j%337ݔR@$IUL\)73>RGiSZ)~X !` Ճ$ˮ ahxu+Z'6^CN|T,fT7II~xۻu%Sދ+$gIIºӸS|z+dSʯޯ+?O=ɓTz<>sOשׁ޸?L.k|w=B4}čظFO(>3Iv{^Tv'?`I_%uo0 *XC쎨U^ [8c[ű1=.NIqL*on3/\_=8 %B GDִER (Q~CJ+FGM, 'J,{0`АYAOتhw=ae^jͦ3N}zz40:fWp"X㷣˾{{W_6,1'P&sɘX+=Jq%3{S.{e#*]R Iw)Ǟ]_w뛛dϰs-֜Z!Ǧ ևz `DH,Dn"=K.ѳկuѺ'TJ*޽'wҟ?)'uO(~)|(e\;g2 : XC x/9Kr]Sj~~2l.՛>$haDIrEwIӟ.#w)%OE~)Y ` pг`V?8ɭd00{LL,,6M1V fZE|N`O$J.tZi)'?w%?r=g߻nQ 0P%@-[nԋgK&3¦\ WF "TZxS+{͍K~H%b*[u%.~{D{=c87-GqJҝv^~Rq{/(v3cQ{l X[ѓx߃w7ܳh5w55&X@UٹBp{; ILgVUVuu$FWƖ1Hcad F:%`vKedր$KeiddJH[]2k7^79UUݙYN5&Ll՟~uN;| O9ޢ.Aey6vi ĹYTAc3/gK_O~~D1I MC[[Ns|Ϗ2Y_3n}X6r NcY3/zm7~œ-4Q~(ĐCv\!}{o#_CǼr(Pp ?sA8ڋ}[KNà4m! `[ /l'_}G|n$]T"6v'_hT>KWwğ-/b<[ǰcL֟=s20(dE` ./s aŶ>N]>Vj؜{N^؍wբ>p[\`)v }8,e}]{qecOTP.U@VlpJW/yOrl?{ eUKOyU)tEB> C@G04 ,P(T _ 0 c. mrcѨWN|uϞֺ5_O9t [aELAD`br&F3J- Cٍ/N{ "O3iF$F(aB<ؓ&y6Lb?WGSgW_8~rђ`8͍BKq{`뢵$i(ŗӴ>* rږmU0As =hת_E֯})0enCwuWZ埾=o]m|d w3 R >EyHʫ4 # ?|QOTڟ6{QY=" [&ϺYAD`vso&aٽkKg[szݍ T"ss 8q!$-$-S@_4'~'OsNIуv@Ȋ8ϼI+% `sis]nl[J5bX dŜkYG" S$ `0UlkfW~߿~/uwXhr4` m^qg7e:eE@l1p lŽ[{Zmk!ߍK`In`w aݝ:5xy$>b2L+77m᫮KKQT+kJ;`s{sA8Es>,K(."0%rRՔOgV;Z1կSk{Paw;Aݎ&BЅ1 L"F@׉FC6o2>|?^Unb?WJ?:Nge<ؾ@r%@q[ҕ=ܓΛyuسg ++Mn17-Ro:pEĀ~'K `6Y YAM Z.4EZj+_w/ٳœN$zx <}Z YDn)TMo y/;pWJ̔P-pu\qپoz5hOG(YS 6m8N)&`>oT"8餿D@Vo*=L$Dq|tu"P2rJ֡j `M'GO]Z\1kgϠh`o~5ejy}4`Ahl?9Iz}pho0Ej\+aE@{ PgS};" I@fU݅"W!qKGjn] n0 b [jyK>xSa!7}mqM$&BU@ @p{Ç׏eRt]܉[fqw# m+Zj̓,&}ݕzx ?a> l " [A@VP9rMqfOATÞ?z#=ȗ >;oGX(D?y_#+"0]0*[=ztn߾}g{CIg?ʊ [267ЦGpy_-./~ODDʀ[g>6<6,aD@6MjOe~o摇嗎I>Ʊk źw_uOOsgeE@B@Q@o_=tP 3_~/=g=ncS/Zz1~1\YmW]q| \,56>*sfwtUw (@ر/_㟯գ:Vd6ܑN6xՏ}?ۣZXo}b۪m8޲a]AD`4Q*_8E/^:n|ѮTt&^$@뵪Bb~7`߲ 1A#.B^ٮfQAfc}>_Q$ݹ@_H%sLbV -7^.6?g?_k'uڸ#+"q8CPu]ʷ/~wjnwڏDN(th6;߼$`RF lܧ?W(}6JP GF*/ׇ8tlB q0)j_gWz'~INN[՜8s0`MlF6JP ACsd'?&mjf+B/bA{4(:sf1s׏{')}A#7h$` W*D@H@sHB ][ol=?rGQicsXXM7Oǖ|%ij|h`"l*T${ｷ|Sǿ?{_2|VKӪoG FpӁy8 @;h4}3YVQ /QuMkVZwlv_4[b{5pEj`poIw@xG;| Gݡ:i @iV #<]uͭc_N+vI$In¿ +sfݹh];?6 PSr؟Θߐm-M})#$T0 [R{ꥧ~-}/kK!ژ׋(ajT]Zm_rs`Df(nL di0 #wp:lL:}?ލwt@{,@t H)@Z6sh(٬xG},I} "0 9PS\x_F ʟR׿t`=_v^;7,Gp.F l}nUչ.˟z={Ȥ?z?9tJ>䢽Y1c#Q  `UG`cwW9[SM(jTuNv6v\~]v)P;HqPED@&%oIɩ\. [M6#E?eJxQuI;?h^aM؏qOG#<:pD@& `h*6/+wRRy[U+L; TC :w>λo= եUfh JdѮ' Pt<~-HgwqPDkfdܡF n!Պ=BO'6σ|Y)7 "0)|Dl DGflegJ_C)Xqo Pay(ÎuP>L "PYAOmڵkOj~z qʿAhk0}#, 9E ?HgSi1:t 9r$ݍuq:[!([!]Fj5 9"ȇ4_OlQ4 V !`&9%ШqgS:BD3ՔsTnqXb3; @:E?k9:>\ "Pه6'giaRG{'`X<[ "  `T4zVVVwm`MEgj5|x1A'cC@:tª?7=P'CVD`Br&b!`{7ޒ_fRG9JHT(@.ī 1){$IE@̖eNGl1osGe}" c0&0e/0rC 9i|H a@1$FSQ-} DQ>^ˊL@@T8lz䨻l!A9^qai9j.EG`Їx0XH!7jՁ>?1ƙ" 04)a& GU2,=O" c0,e-0:y q_+=Oѵ@ (t'I3ںQ%3taG;(D@F 08BQeH=S/l@z:8qf`_AD`U@s99F/LNqϩ"PHr mQ $-QQmIjGi>Ƿ:urfgE2 zvלM3LME D 5m.[!=n7'Т^M3d0MVD` L/$$)}7W,LpMY`*TDD+.&z 07FjDeg2)̃4gAɸTah!\tU{GA>žE,0K=mM7Lу>g4oS*-:joZ8b{ o{@h)_'U $悄 )a0y{ՖZB@8qz5XKFۍcL<-ip@5!PXsڄT !6qzl1v{pF=A@xnvS{O{5qOo һTk7isY|\1P VGQՂf~D VGCu"P0r aܑ m.1ӎOsla&.zAJl6/ ivjqRI) 6;8@::#O_Tŕe[   i "  ~m@^ [n:Օj ۑ|I+3qZHx݉'X7烤;gsIm(ƑL*v آF\yeea̓ { 8m2 +-%G:m۶ Q :vHAD`}q #@B FۜyG:3odql??vHa7dpcc',?ac9CA&%GS8Wm!ySh;Lb,Zq3I☿qTϺW Xa@< 5Dq/:t Й1$!(ڴ`ɍ} CZg9E@0FbMQ , 8zqN᧵l C5-y7gt'ũW Ha@( eR(%@@^ҹY4 <e/$=BO _?:Q L IBAbO|~0F Xp?: `cVYE@0HA @h  :8;Ae/{!D}Gd: 6XD@# `<^]\ X >Ñ?G ^}.$~ `|;_ " c0,e-Cƾw q>(Q`~;0/X<>?u㒔UfYl5"BxG 9h~%oÂ=6/<, "0!9SB`@D *>8sx,ş֒F @~#s<-3/2ED`P VSl(a>/h[/ZC<+MD@0KB^t>ĆQ:%{Z/g7E} " c0&0e/[4@ ѧ̏}Ai<&#>p6Q𑞍iA@_\kѡsq}eJf1G𢞍Ȧr, "0~QDYE: iqXOS|S{4$c>6}kHRqo}{<>㰃(l " #З؈4ܧEC+>/,EzdE@F / )K Ϧe=|&l/"0}IYJK`H{IkF,3C@uD?}+%|aBIENDB`coq-8.20.0/ide/coqide/Make000066400000000000000000000001131466560755400152050ustar00rootroot00000000000000interface.mli xmlprotocol.mli xmlprotocol.ml ide_slave.ml coqidetop.mllib coq-8.20.0/ide/coqide/config.mli000066400000000000000000000013211466560755400163570ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* string list Util.String.Map.t -> unit val load_file : string -> string list Util.String.Map.t coq-8.20.0/ide/coqide/config_lexer.mll000066400000000000000000000042011466560755400175610ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* s))::l) lexbuf } |ignore+ { List.rev l} and string = parse | '"' { Buffer.add_char string_buffer '"' } | '\\' '"' | _ { Buffer.add_string string_buffer (lexeme lexbuf); string lexbuf } | eof { eprintf "coqiderc: unterminated string\n@." } { let load_file f = let c = open_in f in let lb = from_channel c in let m = prefs Util.String.Map.empty lb in close_in c; m let print_file f m = let c = open_out f in let fmt = formatter_of_out_channel c in let rec print_list fmt = function | [] -> () | s :: sl -> fprintf fmt "%S@ %a" s print_list sl in Util.String.Map.iter (fun k s -> fprintf fmt "@[%s = %a@]@\n" k print_list s) m; fprintf fmt "@."; close_out c } coq-8.20.0/ide/coqide/configwin.ml000066400000000000000000000054141466560755400167330ustar00rootroot00000000000000(*********************************************************************************) (* Cameleon *) (* *) (* Copyright (C) 2005 Institut National de Recherche en Informatique et *) (* en Automatique. All rights reserved. *) (* *) (* This program is free software; you can redistribute it and/or modify *) (* it under the terms of the GNU Library General Public License as *) (* published by the Free Software Foundation; either version 2 of the *) (* License, or any later version. *) (* *) (* This program is distributed in the hope that it will be useful, *) (* but WITHOUT ANY WARRANTY; without even the implied warranty of *) (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the *) (* GNU Library General Public License for more details. *) (* *) (* You should have received a copy of the GNU Library General Public *) (* License along with this program; if not, write to the Free Software *) (* Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA *) (* 02111-1307 USA *) (* *) (* Contact: Maxence.Guesdon@inria.fr *) (* *) (*********************************************************************************) type parameter_kind = Configwin_types.parameter_kind type configuration_structure = Configwin_types.configuration_structure = Section of string * GtkStock.id option * parameter_kind list | Section_list of string * GtkStock.id option * configuration_structure list type return_button = Configwin_types.return_button = Return_apply | Return_ok | Return_cancel let string = Configwin_ihm.string (* let strings = Configwin_ihm.strings let list = Configwin_ihm.list *) let bool = Configwin_ihm.bool let combo = Configwin_ihm.combo let custom = Configwin_ihm.custom let modifiers = Configwin_ihm.modifiers let edit ?(apply=(fun () -> ())) title ?parent ?width ?height conf_struct_list = Configwin_ihm.edit ~with_apply: true ~apply title ?parent ?width ?height conf_struct_list coq-8.20.0/ide/coqide/configwin.mli000066400000000000000000000200651466560755400171030ustar00rootroot00000000000000(*********************************************************************************) (* Cameleon *) (* *) (* Copyright (C) 2005 Institut National de Recherche en Informatique et *) (* en Automatique. All rights reserved. *) (* *) (* This program is free software; you can redistribute it and/or modify *) (* it under the terms of the GNU Library General Public License as *) (* published by the Free Software Foundation; either version 2 of the *) (* License, or any later version. *) (* *) (* This program is distributed in the hope that it will be useful, *) (* but WITHOUT ANY WARRANTY; without even the implied warranty of *) (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the *) (* GNU Library General Public License for more details. *) (* *) (* You should have received a copy of the GNU Library General Public *) (* License along with this program; if not, write to the Free Software *) (* Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA *) (* 02111-1307 USA *) (* *) (* Contact: Maxence.Guesdon@inria.fr *) (* *) (*********************************************************************************) (** This module is the interface of the Configwin library. *) (** {2 Types} *) (** This type represents the different kinds of parameters. *) type parameter_kind;; (** This type represents the structure of the configuration window. *) type configuration_structure = | Section of string * GtkStock.id option * parameter_kind list (** label of the section, icon, parameters *) | Section_list of string * GtkStock.id option * configuration_structure list (** label of the section, icon, list of the sub sections *) ;; (** To indicate what button pushed the user when the window is closed. *) type return_button = Return_apply (** The user clicked on Apply at least once before closing the window with Cancel or the window manager. *) | Return_ok (** The user closed the window with the ok button. *) | Return_cancel (** The user closed the window with the cancel button or the window manager but never clicked on the apply button.*) (** {2 Functions to create parameters} *) (** [string label value] creates a string parameter. @param editable indicate if the value is editable (default is [true]). @param expand indicate if the entry widget must expand or not (default is [true]). @param help an optional help message. @param f the function called to apply the value (default function does nothing). *) val string : ?editable: bool -> ?expand: bool -> ?help: string -> ?f: (string -> unit) -> string -> string -> parameter_kind (** [bool label value] creates a boolean parameter. @param editable indicate if the value is editable (default is [true]). @param help an optional help message. @param f the function called to apply the value (default function does nothing). *) val bool : ?editable: bool -> ?help: string -> ?f: (bool -> unit) -> string -> bool -> parameter_kind (* (** [strings label value] creates a string list parameter. @param editable indicate if the value is editable (default is [true]). @param help an optional help message. @param f the function called to apply the value (default function does nothing). @param add the function returning a list of strings when the user wants to add strings (default returns an empty list). @param eq the comparison function, used not to have doubles in list. Default is [Pervasives.(=)]. If you want to allow doubles in the list, give a function always returning false. *) val strings : ?editable: bool -> ?help: string -> ?f: (string list -> unit) -> ?eq: (string -> string -> bool) -> ?add: (unit -> string list) -> string -> string list -> parameter_kind (** [list label f_strings value] creates a list parameter. [f_strings] is a function taking a value and returning a list of strings to display it. The list length should be the same for any value, and the same as the titles list length. The [value] is the initial list. @param editable indicate if the value is editable (default is [true]). @param help an optional help message. @param f the function called to apply the value (default function does nothing). @param eq the comparison function, used not to have doubles in list. Default is [Pervasives.(=)]. If you want to allow doubles in the list, give a function always returning false. @param edit an optional function to use to edit an element of the list. The function returns an element, no matter if element was changed or not. When this function is given, a "Edit" button appears next to the list. @param add the function returning a list of values when the user wants to add values (default returns an empty list). @param titles an optional list of titles for the list. If the [f_strings] function returns a list with more than one element, then you must give a list of titles. @param color an optional function returning the optional color for a given element. This color is used to display the element in the list. The default function returns no color for any element. *) val list : ?editable: bool -> ?help: string -> ?f: ('a list -> unit) -> ?eq: ('a -> 'a -> bool) -> ?edit: ('a -> 'a) -> ?add: (unit -> 'a list) -> ?titles: string list -> ?color: ('a -> string option) -> string -> ('a -> string list) -> 'a list -> parameter_kind *) (** [combo label choices value] creates a combo parameter. @param editable indicate if the value is editable (default is [true]). @param expand indicate if the entry widget must expand or not (default is [true]). @param help an optional help message. @param f the function called to apply the value (default function does nothing). @param new_allowed indicate if a entry not in the list of choices is accepted (default is [false]). @param blank_allowed indicate if the empty selection [""] is accepted (default is [false]). *) val combo : ?editable: bool -> ?expand: bool -> ?help: string -> ?f: (string -> unit) -> ?new_allowed: bool -> ?blank_allowed: bool -> string -> string list -> string -> parameter_kind val modifiers : ?editable: bool -> ?expand: bool -> ?help: string -> ?allow:(Gdk.Tags.modifier list) -> ?f: (Gdk.Tags.modifier list -> unit) -> string -> Gdk.Tags.modifier list -> parameter_kind (** [custom box f expand] creates a custom parameter, with the given [box], the [f] function is called when the user wants to apply his changes, and [expand] indicates if the box must expand in its father. @param label if a value is specified, a the box is packed into a frame. *) val custom : ?label: string -> GPack.box -> (unit -> unit) -> bool -> parameter_kind (** {2 Functions creating configuration windows and boxes} *) (** This function takes a configuration structure and creates a window to configure the various parameters. @param apply this function is called when the apply button is clicked, after giving new values to parameters. *) val edit : ?apply: (unit -> unit) -> string -> ?parent:GWindow.window -> ?width:int -> ?height:int -> configuration_structure list -> return_button coq-8.20.0/ide/coqide/configwin_ihm.ml000066400000000000000000000644621466560755400176000ustar00rootroot00000000000000(*********************************************************************************) (* Cameleon *) (* *) (* Copyright (C) 2005 Institut National de Recherche en Informatique et *) (* en Automatique. All rights reserved. *) (* *) (* This program is free software; you can redistribute it and/or modify *) (* it under the terms of the GNU Library General Public License as *) (* published by the Free Software Foundation; either version 2 of the *) (* License, or any later version. *) (* *) (* This program is distributed in the hope that it will be useful, *) (* but WITHOUT ANY WARRANTY; without even the implied warranty of *) (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the *) (* GNU Library General Public License for more details. *) (* *) (* You should have received a copy of the GNU Library General Public *) (* License along with this program; if not, write to the Free Software *) (* Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA *) (* 02111-1307 USA *) (* *) (* Contact: Maxence.Guesdon@inria.fr *) (* *) (*********************************************************************************) (** This module contains the gui functions of Configwin.*) open Configwin_types let set_help_tip wev = function | None -> () | Some help -> GtkBase.Widget.Tooltip.set_text wev#as_widget help let select_arch m m_osx = if Coq_config.arch = "Darwin" then m_osx else m (* How the modifiers are named in the preference box *) let modifiers_to_string m = let rec iter m s = match m with [] -> s | c :: m -> iter m (( match c with `CONTROL -> "" | `SHIFT -> "" | `LOCK -> "" | `META -> select_arch "" "" | `MOD1 -> "" | `MOD2 -> "" | `MOD3 -> "" | `MOD4 -> "" | `MOD5 -> "" | _ -> raise Not_found ) ^ s) in iter m "" class type widget = object method box : GObj.widget method apply : unit -> unit end let debug = false let dbg s = if debug then Minilib.log s else () (* (** This class builds a frame with a clist and two buttons : one to add items and one to remove the selected items. The class takes in parameter a function used to add items and a string list ref which is used to store the content of the clist. At last, a title for the frame is also in parameter, so that each instance of the class creates a frame. *) class ['a] list_selection_box (listref : 'a list ref) titles_opt help_opt f_edit_opt f_strings f_color (eq : 'a -> 'a -> bool) add_function title editable = let _ = dbg "list_selection_box" in let wev = GBin.event_box () in let wf = GBin.frame ~label: title ~packing: wev#add () in let hbox = GPack.hbox ~packing: wf#add () in (* the scroll window and the clist *) let wscroll = GBin.scrolled_window ~vpolicy: `AUTOMATIC ~hpolicy: `AUTOMATIC ~packing: (hbox#pack ~expand: true) () in let wlist = match titles_opt with None -> GList.clist ~selection_mode: `MULTIPLE ~titles_show: false ~packing: wscroll#add () | Some l -> GList.clist ~selection_mode: `MULTIPLE ~titles: l ~titles_show: true ~packing: wscroll#add () in let _ = set_help_tip wev help_opt in (* the vbox for the buttons *) let vbox_buttons = GPack.vbox () in let _ = if editable then let _ = hbox#pack ~expand: false vbox_buttons#coerce in () else () in let _ = dbg "list_selection_box: wb_add" in let wb_add = GButton.button ~label: Configwin_messages.mAdd ~packing: (vbox_buttons#pack ~expand:false ~padding:2) () in let wb_edit = GButton.button ~label: Configwin_messages.mEdit () in let _ = match f_edit_opt with None -> () | Some _ -> vbox_buttons#pack ~expand:false ~padding:2 wb_edit#coerce in let wb_up = GButton.button ~label: Configwin_messages.mUp ~packing: (vbox_buttons#pack ~expand:false ~padding:2) () in let wb_remove = GButton.button ~label: Configwin_messages.mRemove ~packing: (vbox_buttons#pack ~expand:false ~padding:2) () in let _ = dbg "list_selection_box: object(self)" in object (self) (** the list of selected rows *) val mutable list_select = [] (** This method returns the frame created. *) method box = wev method update l = (* set the new list in the provided listref *) listref := l; (* insert the elements in the clist *) wlist#freeze (); wlist#clear (); List.iter (fun ele -> ignore (wlist#append (f_strings ele)); match f_color ele with None -> () | Some c -> try wlist#set_row ~foreground: (`NAME c) (wlist#rows - 1) with _ -> () ) !listref; (match titles_opt with None -> wlist#columns_autosize () | Some _ -> GToolbox.autosize_clist wlist); wlist#thaw (); (* the list of selectd elements is now empty *) list_select <- [] (** Move up the selected rows. *) method up_selected = let rec iter n selrows l = match selrows with [] -> (l, []) | m :: qrows -> match l with [] -> ([],[]) | [_] -> (l,[]) | e1 :: e2 :: q when m = n + 1 -> let newl, newrows = iter (n+1) qrows (e1 :: q) in (e2 :: newl, n :: newrows) | e1 :: q -> let newl, newrows = iter (n+1) selrows q in (e1 :: newl, newrows) in let sorted_select = List.sort compare list_select in let new_list, new_rows = iter 0 sorted_select !listref in self#update new_list; List.iter (fun n -> wlist#select n 0) new_rows (** Make the user edit the first selected row. *) method edit_selected f_edit = let sorted_select = List.sort compare list_select in match sorted_select with [] -> () | n :: _ -> try let ele = List.nth !listref n in let ele2 = f_edit ele in let rec iter m = function [] -> [] | e :: q -> if n = m then ele2 :: q else e :: (iter (m+1) q) in self#update (iter 0 !listref); wlist#select n 0 with Not_found -> () initializer (* create the functions called when the buttons are clicked *) let f_add () = (* get the files to add with the function provided *) let l = add_function () in (* remove from the list the ones which are already in the listref, using the eq predicate *) let l2 = List.fold_left (fun acc -> fun ele -> if List.exists (eq ele) acc then acc else acc @ [ele]) !listref l in self#update l2 in let f_remove () = (* remove the selected items from the listref and the clist *) let rec iter n = function [] -> [] | h :: q -> if List.mem n list_select then iter (n+1) q else h :: (iter (n+1) q) in let new_list = iter 0 !listref in self#update new_list in let _ = dbg "list_selection_box: connecting wb_add" in (* connect the functions to the buttons *) ignore (wb_add#connect#clicked ~callback:f_add); let _ = dbg "list_selection_box: connecting wb_remove" in ignore (wb_remove#connect#clicked ~callback:f_remove); let _ = dbg "list_selection_box: connecting wb_up" in ignore (wb_up#connect#clicked ~callback:(fun () -> self#up_selected)); ( match f_edit_opt with None -> () | Some f -> let _ = dbg "list_selection_box: connecting wb_edit" in ignore (wb_edit#connect#clicked ~callback:(fun () -> self#edit_selected f)) ); (* connect the selection and deselection of items in the clist *) let f_select ~row ~column ~event = try list_select <- row :: list_select with Failure _ -> () in let f_unselect ~row ~column ~event = try let new_list_select = List.filter (fun n -> n <> row) list_select in list_select <- new_list_select with Failure _ -> () in (* connect the select and deselect events *) let _ = dbg "list_selection_box: connecting select_row" in ignore(wlist#connect#select_row ~callback:f_select); let _ = dbg "list_selection_box: connecting unselect_row" in ignore(wlist#connect#unselect_row ~callback:f_unselect); (* initialize the clist with the listref *) self#update !listref end;; *) (** This class is used to build a box for a string parameter.*) class string_param_box param = let _ = dbg "string_param_box" in let hbox = GPack.hbox () in let wev = GBin.event_box ~packing: (hbox#pack ~expand: false ~padding: 2) () in let _wl = GMisc.label ~text: param.string_label ~packing: wev#add () in let we = GEdit.entry ~editable: param.string_editable ~packing: (hbox#pack ~expand: param.string_expand ~padding: 2) () in let _ = set_help_tip wev param.string_help in let _ = we#set_text (param.string_to_string param.string_value) in object (self) (** This method returns the main box ready to be packed. *) method box = hbox#coerce (** This method applies the new value of the parameter. *) method apply = let new_value = param.string_of_string we#text in if new_value <> param.string_value then let _ = param.string_f_apply new_value in param.string_value <- new_value else () end ;; (** This class is used to build a box for a combo parameter.*) class combo_param_box param = let _ = dbg "combo_param_box" in let hbox = GPack.hbox () in let wev = GBin.event_box ~packing: (hbox#pack ~expand: false ~padding: 2) () in let _wl = GMisc.label ~text: param.combo_label ~packing: wev#add () in let _ = set_help_tip wev param.combo_help in let get_value = if not param.combo_new_allowed then let wc = GEdit.combo_box_text ~strings: param.combo_choices ?active:(let rec aux i = function |[] -> None |h::_ when h = param.combo_value -> Some i |_::t -> aux (succ i) t in aux 0 param.combo_choices) ~packing: (hbox#pack ~expand: param.combo_expand ~padding: 2) () in fun () -> match GEdit.text_combo_get_active wc with |None -> "" |Some s -> s else let (wc,_) = GEdit.combo_box_entry_text ~strings: param.combo_choices ~packing: (hbox#pack ~expand: param.combo_expand ~padding: 2) () in let _ = wc#entry#set_editable param.combo_editable in let _ = wc#entry#set_text param.combo_value in fun () -> wc#entry#text in object (self) (** This method returns the main box ready to be packed. *) method box = hbox#coerce (** This method applies the new value of the parameter. *) method apply = let new_value = get_value () in if new_value <> param.combo_value then let _ = param.combo_f_apply new_value in param.combo_value <- new_value else () end ;; (** Class used to pack a custom box. *) class custom_param_box param = let _ = dbg "custom_param_box" in let top = match param.custom_framed with None -> param.custom_box#coerce | Some l -> let wf = GBin.frame ~label: l () in wf#add param.custom_box#coerce; wf#coerce in object (self) method box = top method apply = param.custom_f_apply () end (** This class is used to build a box for a text parameter.*) class text_param_box param = let _ = dbg "text_param_box" in let wf = GBin.frame ~label: param.string_label ~height: 100 () in let wev = GBin.event_box ~packing: wf#add () in let wscroll = GBin.scrolled_window ~vpolicy: `AUTOMATIC ~hpolicy: `AUTOMATIC ~packing: wev#add () in let wview = GText.view ~editable: param.string_editable ~packing: wscroll#add () in let _ = set_help_tip wev param.string_help in let _ = dbg "text_param_box: buffer creation" in let buffer = GText.buffer () in let _ = wview#set_buffer buffer in let _ = buffer#insert (param.string_to_string param.string_value) in let _ = dbg "text_param_box: object(self)" in object (self) val wview = wview (** This method returns the main box ready to be packed. *) method box = wf#coerce (** This method applies the new value of the parameter. *) method apply = let v = param.string_of_string (buffer#get_text ()) in if v <> param.string_value then ( dbg "apply new value!"; let _ = param.string_f_apply v in param.string_value <- v ) else () end ;; (** This class is used to build a box for a boolean parameter.*) class bool_param_box param = let _ = dbg "bool_param_box" in let wchk = GButton.check_button ~label: param.bool_label () in let _ = set_help_tip wchk param.bool_help in let _ = wchk#set_active param.bool_value in let _ = wchk#misc#set_sensitive param.bool_editable in object (self) (** This method returns the check button ready to be packed. *) method box = wchk#coerce (** This method applies the new value of the parameter. *) method apply = let new_value = wchk#active in if new_value <> param.bool_value then let _ = param.bool_f_apply new_value in param.bool_value <- new_value else () end ;; class modifiers_param_box param = let hbox = GPack.hbox () in let wev = GBin.event_box ~packing: (hbox#pack ~expand:true ~fill:true ~padding: 2) () in let _wl = GMisc.label ~text: param.md_label ~packing: wev#add () in let value = ref param.md_value in let _ = List.map (fun modifier -> let but = GButton.toggle_button ~label:(modifiers_to_string [modifier]) ~active:(List.mem modifier param.md_value) ~packing:(hbox#pack ~expand:false) () in ignore (but#connect#toggled ~callback:(fun _ -> if but#active then value := modifier::!value else value := List.filter ((<>) modifier) !value))) param.md_allow in let _ = set_help_tip wev param.md_help in object (self) (** This method returns the main box ready to be packed. *) method box = hbox#coerce (** This method applies the new value of the parameter. *) method apply = let new_value = !value in if new_value <> param.md_value then let _ = param.md_f_apply new_value in param.md_value <- new_value else () end ;; (* (** This class is used to build a box for a parameter whose values are a list.*) class ['a] list_param_box (param : 'a list_param) = let _ = dbg "list_param_box" in let listref = ref param.list_value in let frame_selection = new list_selection_box listref param.list_titles param.list_help param.list_f_edit param.list_strings param.list_color param.list_eq param.list_f_add param.list_label param.list_editable tt in object (self) (** This method returns the main box ready to be packed. *) method box = frame_selection#box#coerce (** This method applies the new value of the parameter. *) method apply = param.list_f_apply !listref ; param.list_value <- !listref end ;; *) (** This class creates a configuration box from a configuration structure *) class configuration_box conf_struct = let main_box = GPack.hbox () in let columns = new GTree.column_list in let icon_col = columns#add GtkStock.conv in let label_col = columns#add Gobject.Data.string in let box_col = columns#add Gobject.Data.caml in let () = columns#lock () in let pane = GPack.paned `HORIZONTAL ~packing:main_box#add () in (* Tree view part *) let scroll = GBin.scrolled_window ~hpolicy:`NEVER ~packing:pane#pack1 () in let tree = GTree.tree_store columns in let view = GTree.view ~model:tree ~headers_visible:false ~packing:scroll#add_with_viewport () in let selection = view#selection in let _ = selection#set_mode `SINGLE in let menu_box = GPack.vbox ~packing:pane#pack2 () in let renderer = (GTree.cell_renderer_pixbuf [], ["stock-id", icon_col]) in let col = GTree.view_column ~renderer () in let _ = view#append_column col in let renderer = (GTree.cell_renderer_text [], ["text", label_col]) in let col = GTree.view_column ~renderer () in let _ = view#append_column col in let make_param (main_box : #GPack.box) = function | String_param p -> let box = new string_param_box p in let _ = main_box#pack ~expand: false ~padding: 2 box#box in box | Combo_param p -> let box = new combo_param_box p in let _ = main_box#pack ~expand: false ~padding: 2 box#box in box | Text_param p -> let box = new text_param_box p in let _ = main_box#pack ~expand: p.string_expand ~padding: 2 box#box in box | Bool_param p -> let box = new bool_param_box p in let _ = main_box#pack ~expand: false ~padding: 2 box#box in box | List_param f -> let box = f () in let _ = main_box#pack ~expand: true ~padding: 2 box#box in box | Custom_param p -> let box = new custom_param_box p in let _ = main_box#pack ~expand: p.custom_expand ~padding: 2 box#box in box | Modifiers_param p -> let box = new modifiers_param_box p in let _ = main_box#pack ~expand: false ~padding: 2 box#box in box in let set_icon iter = function | None -> () | Some icon -> tree#set ~row:iter ~column:icon_col icon in (* Populate the tree *) let rec make_tree iter conf_struct = (* box is not shown at first *) let box = GPack.vbox ~packing:(menu_box#pack ~expand:true) ~show:false () in let new_iter = match iter with | None -> tree#append () | Some parent -> tree#append ~parent () in match conf_struct with | Section (label, icon, param_list) -> let params = List.map (make_param box) param_list in let widget = object method box = box#coerce method apply () = List.iter (fun param -> param#apply) params end in let () = tree#set ~row:new_iter ~column:label_col label in let () = set_icon new_iter icon in let () = tree#set ~row:new_iter ~column:box_col widget in () | Section_list (label, icon, struct_list) -> let widget = object (* Section_list does not contain any effect widget, so we do not have to apply anything. *) method apply () = () method box = box#coerce end in let () = tree#set ~row:new_iter ~column:label_col label in let () = set_icon new_iter icon in let () = tree#set ~row:new_iter ~column:box_col widget in List.iter (make_tree (Some new_iter)) struct_list in let () = List.iter (make_tree None) conf_struct in (* Dealing with signals *) let current_prop : widget option ref = ref None in let select_iter iter = let () = match !current_prop with | None -> () | Some box -> box#box#misc#hide () in let box = tree#get ~row:iter ~column:box_col in let () = box#box#misc#show () in current_prop := Some box in let when_selected () = let rows = selection#get_selected_rows in match rows with | [] -> () | row :: _ -> let iter = tree#get_iter row in select_iter iter in (* Focus on a box when selected *) let _ = selection#connect#changed ~callback:when_selected in let _ = match tree#get_iter_first with | None -> () | Some iter -> select_iter iter in object method box = main_box method apply = let foreach _ iter = let widget = tree#get ~row:iter ~column:box_col in widget#apply(); false in tree#foreach foreach end (** This function takes a configuration structure list and creates a window to configure the various parameters. *) let edit ?(with_apply=true) ?(apply=(fun () -> ())) title ?parent ?width ?height conf_struct = let dialog = GWindow.dialog ~position:`CENTER ~modal: true ~title: title ~type_hint:`DIALOG ?parent ?height ?width () in let config_box = new configuration_box conf_struct in let _ = dialog#vbox#pack ~expand:true config_box#box#coerce in if with_apply then dialog#add_button Configwin_messages.mApply `APPLY; dialog#add_button Configwin_messages.mOk `OK; dialog#add_button Configwin_messages.mCancel `CANCEL; let destroy () = dialog#destroy (); in let rec iter rep = try match dialog#run () with | `APPLY -> config_box#apply; iter Return_apply | `OK -> config_box#apply; destroy (); Return_ok | _ -> destroy (); rep with Failure s -> GToolbox.message_box ~title:"Error" s; iter rep | e -> GToolbox.message_box ~title:"Error" (Printexc.to_string e); iter rep in iter Return_cancel (* let edit_string l s = match GToolbox.input_string ~title: l ~text: s Configwin_messages.mValue with None -> s | Some s2 -> s2 *) (** Create a string param. *) let string ?(editable=true) ?(expand=true) ?help ?(f=(fun _ -> ())) label v = String_param { string_label = label ; string_help = help ; string_value = v ; string_editable = editable ; string_f_apply = f ; string_expand = expand ; string_to_string = (fun x -> x) ; string_of_string = (fun x -> x) ; } (** Create a bool param. *) let bool ?(editable=true) ?help ?(f=(fun _ -> ())) label v = Bool_param { bool_label = label ; bool_help = help ; bool_value = v ; bool_editable = editable ; bool_f_apply = f ; } (* (** Create a list param. *) let list ?(editable=true) ?help ?(f=(fun (_:'a list) -> ())) ?(eq=Pervasives.(=)) ?(edit:('a -> 'a) option) ?(add=(fun () -> ([] : 'a list))) ?titles ?(color=(fun (_:'a) -> (None : string option))) label (f_strings : 'a -> string list) v = List_param (fun () -> new list_param_box { list_label = label ; list_help = help ; list_value = v ; list_editable = editable ; list_titles = titles; list_eq = eq ; list_strings = f_strings ; list_color = color ; list_f_edit = edit ; list_f_add = add ; list_f_apply = f ; } ) (** Create a strings param. *) let strings ?(editable=true) ?help ?(f=(fun _ -> ())) ?(eq=Pervasives.(=)) ?(add=(fun () -> [])) label v = list ~editable ?help ~f ~eq ~edit: (edit_string label) ~add label (fun s -> [s]) v *) (** Create a combo param. *) let combo ?(editable=true) ?(expand=true) ?help ?(f=(fun _ -> ())) ?(new_allowed=false) ?(blank_allowed=false) label choices v = Combo_param { combo_label = label ; combo_help = help ; combo_value = v ; combo_editable = editable ; combo_choices = choices ; combo_new_allowed = new_allowed ; combo_blank_allowed = blank_allowed ; combo_f_apply = f ; combo_expand = expand ; } let modifiers ?(editable=true) ?(expand=true) ?help ?(allow=[`CONTROL;`SHIFT;`LOCK;`META;`MOD1;`MOD2;`MOD3;`MOD4;`MOD5]) ?(f=(fun _ -> ())) label v = Modifiers_param { md_label = label ; md_help = help ; md_value = v ; md_editable = editable ; md_f_apply = f ; md_expand = expand ; md_allow = allow ; } (** Create a custom param.*) let custom ?label box f expand = Custom_param { custom_box = box ; custom_f_apply = f ; custom_expand = expand ; custom_framed = label ; } (* Copying lablgtk question_box + forbidding hiding *) let question_box ~title ~buttons ?(default=1) ?icon ?parent message = let button_nb = ref 0 in let window = GWindow.dialog ~position:`CENTER ~modal:true ?parent ~type_hint:`DIALOG ~title () in let hbox = GPack.hbox ~border_width:10 ~packing:window#vbox#add () in let bbox = window#action_area in begin match icon with None -> () | Some i -> hbox#pack i#coerce ~padding:4 end; ignore (GMisc.label ~text: message ~packing: hbox#add ()); (* the function called to create each button by iterating *) let rec iter_buttons n = function [] -> () | button_label :: q -> let b = GButton.button ~label: button_label ~packing:(bbox#pack ~expand:true ~padding:4) () in ignore (b#connect#clicked ~callback: (fun () -> button_nb := n; window#destroy ())); (* If it's the first button then give it the focus *) if n = default then b#grab_default () else (); iter_buttons (n+1) q in iter_buttons 1 buttons; ignore (window#connect#destroy ~callback: GMain.Main.quit); window#set_position `CENTER; window#show (); GMain.Main.main (); !button_nb let message_box ~title ?icon ?parent ?(ok="Ok") message = ignore (question_box ?icon ?parent ~title message ~buttons:[ ok ]) coq-8.20.0/ide/coqide/configwin_ihm.mli000066400000000000000000000073071466560755400177440ustar00rootroot00000000000000(*********************************************************************************) (* Cameleon *) (* *) (* Copyright (C) 2005 Institut National de Recherche en Informatique et *) (* en Automatique. All rights reserved. *) (* *) (* This program is free software; you can redistribute it and/or modify *) (* it under the terms of the GNU Library General Public License as *) (* published by the Free Software Foundation; either version 2 of the *) (* License, or any later version. *) (* *) (* This program is distributed in the hope that it will be useful, *) (* but WITHOUT ANY WARRANTY; without even the implied warranty of *) (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the *) (* GNU Library General Public License for more details. *) (* *) (* You should have received a copy of the GNU Library General Public *) (* License along with this program; if not, write to the Free Software *) (* Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA *) (* 02111-1307 USA *) (* *) (* Contact: Maxence.Guesdon@inria.fr *) (* *) (*********************************************************************************) open Configwin_types val string : ?editable: bool -> ?expand: bool -> ?help: string -> ?f: (string -> unit) -> string -> string -> parameter_kind val bool : ?editable: bool -> ?help: string -> ?f: (bool -> unit) -> string -> bool -> parameter_kind (* val strings : ?editable: bool -> ?help: string -> ?f: (string list -> unit) -> ?eq: (string -> string -> bool) -> ?add: (unit -> string list) -> string -> string list -> parameter_kind val list : ?editable: bool -> ?help: string -> ?f: ('a list -> unit) -> ?eq: ('a -> 'a -> bool) -> ?edit: ('a -> 'a) -> ?add: (unit -> 'a list) -> ?titles: string list -> ?color: ('a -> string option) -> string -> ('a -> string list) -> 'a list -> parameter_kind *) val combo : ?editable: bool -> ?expand: bool -> ?help: string -> ?f: (string -> unit) -> ?new_allowed: bool -> ?blank_allowed: bool -> string -> string list -> string -> parameter_kind val modifiers : ?editable: bool -> ?expand: bool -> ?help: string -> ?allow:(Gdk.Tags.modifier list) -> ?f: (Gdk.Tags.modifier list -> unit) -> string -> Gdk.Tags.modifier list -> parameter_kind val custom : ?label: string -> GPack.box -> (unit -> unit) -> bool -> parameter_kind val edit : ?with_apply:bool -> ?apply:(unit -> unit) -> string -> ?parent:GWindow.window -> ?width:int -> ?height:int -> configuration_structure list -> return_button val question_box : title:string -> buttons:string list -> ?default:int -> ?icon:#GObj.widget -> ?parent:GWindow.window -> string -> int val message_box : title:string -> ?icon:#GObj.widget -> ?parent:GWindow.window -> ?ok:string -> string -> unit coq-8.20.0/ide/coqide/configwin_messages.ml000066400000000000000000000042751466560755400206260ustar00rootroot00000000000000(*********************************************************************************) (* Cameleon *) (* *) (* Copyright (C) 2005 Institut National de Recherche en Informatique et *) (* en Automatique. All rights reserved. *) (* *) (* This program is free software; you can redistribute it and/or modify *) (* it under the terms of the GNU Library General Public License as *) (* published by the Free Software Foundation; either version 2 of the *) (* License, or any later version. *) (* *) (* This program is distributed in the hope that it will be useful, *) (* but WITHOUT ANY WARRANTY; without even the implied warranty of *) (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the *) (* GNU Library General Public License for more details. *) (* *) (* You should have received a copy of the GNU Library General Public *) (* License along with this program; if not, write to the Free Software *) (* Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA *) (* 02111-1307 USA *) (* *) (* Contact: Maxence.Guesdon@inria.fr *) (* *) (*********************************************************************************) (** Module containing the messages of Configwin.*) let mAdd = "Add";; let mRemove = "Remove";; let mUp = "Up";; let mEdit = "Edit";; let mOk = "Ok";; let mCancel = "Cancel";; let mApply = "Apply";; let mValue = "Value" coq-8.20.0/ide/coqide/configwin_messages.mli000066400000000000000000000002311466560755400207630ustar00rootroot00000000000000val mAdd : string val mRemove : string val mUp : string val mEdit : string val mOk : string val mCancel : string val mApply : string val mValue : string coq-8.20.0/ide/coqide/configwin_types.mli000066400000000000000000000145601466560755400203320ustar00rootroot00000000000000(*********************************************************************************) (* Cameleon *) (* *) (* Copyright (C) 2005 Institut National de Recherche en Informatique et *) (* en Automatique. All rights reserved. *) (* *) (* This program is free software; you can redistribute it and/or modify *) (* it under the terms of the GNU Library General Public License as *) (* published by the Free Software Foundation; either version 2 of the *) (* License, or any later version. *) (* *) (* This program is distributed in the hope that it will be useful, *) (* but WITHOUT ANY WARRANTY; without even the implied warranty of *) (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the *) (* GNU Library General Public License for more details. *) (* *) (* You should have received a copy of the GNU Library General Public *) (* License along with this program; if not, write to the Free Software *) (* Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA *) (* 02111-1307 USA *) (* *) (* Contact: Maxence.Guesdon@inria.fr *) (* *) (*********************************************************************************) (** This module contains the types used in Configwin. *) (** This type represents a string or filename parameter, or any other type, depending on the given conversion functions. *) type 'a string_param = { string_label : string; (** the label of the parameter *) mutable string_value : 'a; (** the current value of the parameter *) string_editable : bool ; (** indicates if the value can be changed *) string_f_apply : ('a -> unit) ; (** the function to call to apply the new value of the parameter *) string_help : string option ; (** optional help string *) string_expand : bool ; (** expand or not *) string_to_string : 'a -> string ; string_of_string : string -> 'a ; } ;; (** This type represents a boolean parameter. *) type bool_param = { bool_label : string; (** the label of the parameter *) mutable bool_value : bool; (** the current value of the parameter *) bool_editable : bool ; (** indicates if the value can be changed *) bool_f_apply : (bool -> unit) ; (** the function to call to apply the new value of the parameter *) bool_help : string option ; (** optional help string *) } ;; (** This type represents a parameter whose value is a list of ['a]. *) type 'a list_param = { list_label : string; (** the label of the parameter *) mutable list_value : 'a list; (** the current value of the parameter *) list_titles : string list option; (** the titles of columns, if they must be displayed *) list_f_edit : ('a -> 'a) option; (** optional edition function *) list_eq : ('a -> 'a -> bool) ; (** the comparison function used to get list without doubles *) list_strings : ('a -> string list); (** the function to get a string list from a ['a]. *) list_color : ('a -> string option) ; (** a function to get the optional color of an element *) list_editable : bool ; (** indicates if the value can be changed *) list_f_add : unit -> 'a list ; (** the function to call to add list *) list_f_apply : ('a list -> unit) ; (** the function to call to apply the new value of the parameter *) list_help : string option ; (** optional help string *) } ;; type combo_param = { combo_label : string ; mutable combo_value : string ; combo_choices : string list ; combo_editable : bool ; combo_blank_allowed : bool ; combo_new_allowed : bool ; combo_f_apply : (string -> unit); combo_help : string option ; (** optional help string *) combo_expand : bool ; (** expand the entry widget or not *) } ;; type custom_param = { custom_box : GPack.box ; custom_f_apply : (unit -> unit) ; custom_expand : bool ; custom_framed : string option ; (** optional label for an optional frame *) } ;; type modifiers_param = { md_label : string ; (** the label of the parameter *) mutable md_value : Gdk.Tags.modifier list ; (** The value, as a list of modifiers and a key code *) md_editable : bool ; (** indicates if the value can be changed *) md_f_apply : Gdk.Tags.modifier list -> unit ; (** the function to call to apply the new value of the parameter *) md_help : string option ; (** optional help string *) md_expand : bool ; (** expand or not *) md_allow : Gdk.Tags.modifier list } (** This type represents the different kinds of parameters. *) type parameter_kind = String_param of string string_param | List_param of (unit -> ) | Bool_param of bool_param | Text_param of string string_param | Combo_param of combo_param | Custom_param of custom_param | Modifiers_param of modifiers_param ;; (** This type represents the structure of the configuration window. *) type configuration_structure = | Section of string * GtkStock.id option * parameter_kind list (** label of the section, icon, parameters *) | Section_list of string * GtkStock.id option * configuration_structure list (** label of the section, list of the sub sections *) ;; (** To indicate what button was pushed by the user when the window is closed. *) type return_button = Return_apply (** The user clicked on Apply at least once before closing the window with Cancel or the window manager. *) | Return_ok (** The user closed the window with the ok button. *) | Return_cancel (** The user closed the window with the cancel button or the window manager but never clicked on the apply button.*) coq-8.20.0/ide/coqide/coq-ssreflect.lang000066400000000000000000000230461466560755400200340ustar00rootroot00000000000000 *.v \(\* \*\)

Timings for foo.v

  1. foo.v.time1
  2. foo.v.time2
(* some comment *)

(* other comment

multiline *)




Definition a := 1.


Definition b :=
  2.


Definition c := 3.

 (* hello *)

 Definition d := 4.


(* end of file comment *)
coq-8.20.0/test-suite/misc/bench-render/stderr1v3000066400000000000000000000001131466560755400215550ustar00rootroot00000000000000Mismatch between foo.v.time1 and foo.v.time3: different measurement counts coq-8.20.0/test-suite/misc/bench-render/stderr1v4000066400000000000000000000000751466560755400215650ustar00rootroot00000000000000Mismatch between foo.v.time1 and foo.v.time4 (measurement 1) coq-8.20.0/test-suite/misc/bug_14550.sh000077500000000000000000000001531466560755400173170ustar00rootroot00000000000000#!/usr/bin/env bash $coqc misc/bug_14550/bug_14550.v R=$? if [ $R == 0 ]; then exit 1 else exit 0 fi coq-8.20.0/test-suite/misc/bug_14550/000077500000000000000000000000001466560755400167615ustar00rootroot00000000000000coq-8.20.0/test-suite/misc/bug_14550/bug_14550.v000066400000000000000000000001231466560755400204570ustar00rootroot00000000000000Require Import Coq.Program.Tactics. Program Definition bar : exists n, n = 0 := _. coq-8.20.0/test-suite/misc/bug_7393.v000066400000000000000000000001711466560755400170760ustar00rootroot00000000000000Goal forall x, x -> x. Proof. intros. match goal with | [ |- _ ] => idtac (* . From *) end. assumption. Qed. coq-8.20.0/test-suite/misc/changelog.sh000077500000000000000000000012531466560755400177350ustar00rootroot00000000000000#!/usr/bin/env bash found= for config in ../config/coq_config.py ../_build/default/config/coq_config.py; do if [ -f "$config" ]; then found=1; break; fi done if ! [[ "$found" ]]; then echo "Could not find coq_config.py" exit 1 fi if grep -q -F "is_a_released_version = False" "$config"; then echo "This is not a released version: nothing to test." exit 0 fi for d in ../doc/changelog/*; do if [ -d "$d" ]; then files=("$d"/*.rst) if [ "${#files[@]}" != 1 ]; then echo "Fatal: unreleased changelog entries remain in ${d#../}/" echo "Include them in doc/sphinx/changes.rst and remove them from doc/changelog/" exit 1 fi fi done coq-8.20.0/test-suite/misc/comment-lexing.sh000077500000000000000000000004401466560755400207310ustar00rootroot00000000000000#!/bin/sh set -ex export COQBIN=$BIN export PATH="$COQBIN:$PATH" cd misc/comment-lexing/ rm -rf _test mkdir _test cp test.v _test cd _test coqc -d comment-lexing -beautify test.v > test.out.real 2>&1 diff -u ../test.out test.out.real diff -u ../test.v.beautified test.v.beautified coq-8.20.0/test-suite/misc/comment-lexing/000077500000000000000000000000001466560755400203745ustar00rootroot00000000000000coq-8.20.0/test-suite/misc/comment-lexing/test.out000066400000000000000000000011631466560755400221050ustar00rootroot00000000000000Debug: [comment-lexing] comment at chars 333-587: (** Pour démontrer [c0 = Rouge -> coul_suiv c0 = Vert], on suppose [c0 = Rouge] et on doit alors prouver [coul_suiv c0 = Vert] sous cette hypothèse supplémentaire ; lorsque l'on introduit une hypothèse, on lui donne un nom. *) Debug: [comment-lexing] comment at chars 603-639: (* /!\ CRASH ON THIS LINE /!\ *) Debug: [comment-lexing] comment at chars 642-814: (** Le raisonnement sous-jacent est : soit c0rou une preuve arbitraire (inconnue) de [c0 = Rouge], on peut s'en servir pour démontrer coul_suiv [c0 = Vert]. *) coq-8.20.0/test-suite/misc/comment-lexing/test.v000066400000000000000000000015431466560755400215450ustar00rootroot00000000000000Inductive coulfeu : Set := | Vert : coulfeu | Orange : coulfeu | Rouge : coulfeu . Definition coul_suiv : coulfeu -> coulfeu := fun c => match c with | Vert => Orange | Orange => Rouge | Rouge => Vert end. Theorem th_crou_gen : forall c : coulfeu, c = Rouge -> coul_suiv c = Vert. Proof. intro c0. (** Pour démontrer [c0 = Rouge -> coul_suiv c0 = Vert], on suppose [c0 = Rouge] et on doit alors prouver [coul_suiv c0 = Vert] sous cette hypothèse supplémentaire ; lorsque l'on introduit une hypothèse, on lui donne un nom. *) intro c0rou. (* /!\ CRASH ON THIS LINE /!\ *) (** Le raisonnement sous-jacent est : soit c0rou une preuve arbitraire (inconnue) de [c0 = Rouge], on peut s'en servir pour démontrer coul_suiv [c0 = Vert]. *) rewrite c0rou. cbn [coul_suiv]. reflexivity. Qed. coq-8.20.0/test-suite/misc/comment-lexing/test.v.beautified000066400000000000000000000015161466560755400236450ustar00rootroot00000000000000Inductive coulfeu : Set := | Vert : coulfeu | Orange : coulfeu | Rouge : coulfeu. Definition coul_suiv : coulfeu -> coulfeu := fun c => match c with | Vert => Orange | Orange => Rouge | Rouge => Vert end. Theorem th_crou_gen : forall c : coulfeu, c = Rouge -> coul_suiv c = Vert. Proof. intro c0. (** Pour démontrer [c0 = Rouge -> coul_suiv c0 = Vert], on suppose [c0 = Rouge] et on doit alors prouver [coul_suiv c0 = Vert] sous cette hypothèse supplémentaire ; lorsque l'on introduit une hypothèse, on lui donne un nom. *) intro c0rou. (* /!\ CRASH ON THIS LINE /!\ *) (** Le raisonnement sous-jacent est : soit c0rou une preuve arbitraire (inconnue) de [c0 = Rouge], on peut s'en servir pour démontrer coul_suiv [c0 = Vert]. *) (rewrite c0rou). (cbn[coul_suiv]). reflexivity. Qed. coq-8.20.0/test-suite/misc/coq_environment.sh000077500000000000000000000026151466560755400212170ustar00rootroot00000000000000#!/usr/bin/env bash export COQBIN=$BIN export PATH=$COQBIN:$PATH TMP=`mktemp -d` cd $TMP mkdir -p overridden/theories/Init/ mkdir overridden/plugins touch overridden/theories/Init/Prelude.vo cat > coq_environment.txt < /dev/null N=`grep COQMF_OCAMLFIND CoqMakefile.conf | grep /overridden | wc -l` if [ $N -ne 1 ]; then echo COQMF_OCAMLFIND not overridden by coq_environment cat CoqMakefile.conf exit 1 fi mkdir -p overridden2/theories/Init/ mkdir overridden2/plugins touch overridden2/theories/Init/Prelude.vo export COQLIB="$PWD/overridden2" N=`./coqc -config | grep COQLIB | grep overridden2 | wc -l` if [ $N -ne 1 ]; then echo COQLIB not overridden by COQLIB when coq_environment present coqc -config exit 1 fi rm -rf $TMP exit 0 coq-8.20.0/test-suite/misc/coq_makefile_destination_of.sh000077500000000000000000000010321466560755400235050ustar00rootroot00000000000000#!/usr/bin/env bash export COQBIN=$BIN export PATH=$COQBIN:$PATH TMP=`mktemp -d` cd $TMP function assert_eq() { if [ "$1" != "$2" ]; then echo "coq_makefile generates destination" $1 "!=" $2 cd / rm -rf $TMP exit 1 fi } assert_eq `coq_makefile -destination-of src/Y/Z/Test.v -Q src X` "X//Y/Z" mkdir src assert_eq `coq_makefile -destination-of src/Y/Z/Test.v -Q src X` "X//Y/Z" mkdir -p src/Y/Z touch src/Y/Z/Test.v assert_eq `coq_makefile -destination-of src/Y/Z/Test.v -Q src X` "X//Y/Z" cd / rm -rf $TMP exit 0 coq-8.20.0/test-suite/misc/coqc_cmdline.v000066400000000000000000000000251466560755400202520ustar00rootroot00000000000000Definition x := nat. coq-8.20.0/test-suite/misc/coqc_dash_o.sh000077500000000000000000000003641466560755400202520ustar00rootroot00000000000000#!/usr/bin/env bash DOUT=misc/tmp_coqc_cmdline/ OUT=${DOUT}coqc_cmdline.vo mkdir -p "${DOUT}" rm -f "${OUT}" $coqc misc/coqc_cmdline.v -o "${OUT}" if [ ! -f "${OUT}" ]; then printf "coqc -o not working" exit 1 fi rm -fr "${DOUT}" exit 0 coq-8.20.0/test-suite/misc/coqc_dash_vok.sh000077500000000000000000000010251466560755400206060ustar00rootroot00000000000000#!/usr/bin/env bash IN_V=misc/coqc_cmdline.v OUT_VO=misc/coqc_cmdline.vo OUT_VOS=misc/coqc_cmdline.vos OUT_VOK=misc/coqc_cmdline.vok OUT_GLOB=misc/coqc_cmdline.glob OUT="${OUT_VO} ${OUT_VOS} ${OUT_VOK} ${OUT_GLOB}" rm -f ${OUT} set -x $coqc ${IN_V} -vos $coqc ${IN_V} -vok if [ ! -f ${OUT_VOK} ]; then echo "coqc -vok not working in -vos mode" rm -f ${OUT} exit 1 fi rm -f ${OUT} $coqc ${IN_V} -o ${OUT_VO} if [ ! -f ${OUT_VOK} ]; then echo "vok not produced in -o mode" rm -f ${OUT} exit 1 fi rm -f ${OUT} exit 0 coq-8.20.0/test-suite/misc/coqdep-require-filter-categories.sh000077500000000000000000000002421466560755400243360ustar00rootroot00000000000000#!/usr/bin/env bash set -e cd misc/coqdep-require-filter-categories $coqdep -R . 'Bla' ./*.v > stdout 2> stderr diff stdout.ref stdout diff stderr.ref stderr coq-8.20.0/test-suite/misc/coqdep-require-filter-categories/000077500000000000000000000000001466560755400240015ustar00rootroot00000000000000coq-8.20.0/test-suite/misc/coqdep-require-filter-categories/fA.v000066400000000000000000000000631466560755400245150ustar00rootroot00000000000000Require Import Prelude(something(..)) nonexistent. coq-8.20.0/test-suite/misc/coqdep-require-filter-categories/fB.v000066400000000000000000000000351466560755400245150ustar00rootroot00000000000000Require Import(bla) fA(bli). coq-8.20.0/test-suite/misc/coqdep-require-filter-categories/fC.v000066400000000000000000000000431466560755400245150ustar00rootroot00000000000000Require Export (blo) fB (blu.blu). coq-8.20.0/test-suite/misc/coqdep-require-filter-categories/fD.v000066400000000000000000000000371466560755400245210ustar00rootroot00000000000000Require Import -(bla) fA(bli). coq-8.20.0/test-suite/misc/coqdep-require-filter-categories/fE.v000066400000000000000000000000361466560755400245210ustar00rootroot00000000000000Require Import-(bla) fA(bli). coq-8.20.0/test-suite/misc/coqdep-require-filter-categories/fF.v000066400000000000000000000000401466560755400245150ustar00rootroot00000000000000Require Import - (bla) fA(bli). coq-8.20.0/test-suite/misc/coqdep-require-filter-categories/fG.v000066400000000000000000000000371466560755400245240ustar00rootroot00000000000000Require Import- (bla) fA(bli). coq-8.20.0/test-suite/misc/coqdep-require-filter-categories/stderr.ref000066400000000000000000000002271466560755400260030ustar00rootroot00000000000000Warning: in file fA.v, library nonexistent is required and has not been found in the loadpath! [module-not-found,filesystem,default] coq-8.20.0/test-suite/misc/coqdep-require-filter-categories/stdout.ref000066400000000000000000000006121466560755400260200ustar00rootroot00000000000000fA.vo fA.glob fA.v.beautified fA.required_vo: fA.v fB.vo fB.glob fB.v.beautified fB.required_vo: fB.v fA.vo fC.vo fC.glob fC.v.beautified fC.required_vo: fC.v fB.vo fD.vo fD.glob fD.v.beautified fD.required_vo: fD.v fA.vo fE.vo fE.glob fE.v.beautified fE.required_vo: fE.v fA.vo fF.vo fF.glob fF.v.beautified fF.required_vo: fF.v fA.vo fG.vo fG.glob fG.v.beautified fG.required_vo: fG.v fA.vo coq-8.20.0/test-suite/misc/coqdoc-options.sh000077500000000000000000000003451466560755400207500ustar00rootroot00000000000000#!/usr/bin/env bash set -e export COQBIN=$BIN export PATH=$COQBIN:$PATH cd misc/coqdoc-options/ coq_makefile -f _CoqProject -o Makefile make clean make html diff -u --strip-trailing-cr html/Coqdoc.test.html 15933.html.out coq-8.20.0/test-suite/misc/coqdoc-options/000077500000000000000000000000001466560755400204075ustar00rootroot00000000000000coq-8.20.0/test-suite/misc/coqdoc-options/15933.html.out000066400000000000000000000245031466560755400225730ustar00rootroot00000000000000 Coqdoc.test

Library Coqdoc.test

Class C := {}.

Global Declare Instance I0 : C.
Local Declare Instance I1 : C.
Global Polymorphic Declare Instance I3 : C.
Polymorphic Global Declare Instance I4 : C.
Local Polymorphic Declare Instance I5 : C.
Polymorphic Local Declare Instance I6 : C.

Global Program Instance I7 : C := {}.
Local Program Instance I8 : C := {}.
Program Global Instance I9 : C := {}.
Program Local Instance I10 : C := {}.

Polymorphic Program Global Instance I11 : C := {}.
Polymorphic Program Local Instance I12 : C := {}.
Program Global Polymorphic Instance I13 : C := {}.
Program Local Polymorphic Instance I14 : C := {}.
Global Program Polymorphic Instance I15 : C := {}.
Local Program Polymorphic Instance I16 : C := {}.

Global Notation x0 := 0.
Local Notation x1 := 0.

Global Definition x2 := 0.
Local Definition x3 := 0.
Polymorphic Definition x4 := 0.
Polymorphic Global Definition x5 := 0.
Polymorphic Local Definition x6 := 0.
Global Polymorphic Definition x7 := 0.
Local Polymorphic Definition x8 := 0.

Polymorphic Inductive y0 := z0.
Polymorphic Variant y1 := z1.

Local Obligation Tactic := auto.
Global Obligation Tactic := auto.

Global Typeclasses Opaque I7.
Local Typeclasses Opaque I8.

Global Hint Extern 10 (_ ≤ _) ⇒ auto : arith.
Local Hint Extern 10 (_ ≤ _) ⇒ auto : arith.

Global Ltac lt0 := auto.
Local Ltac lt1 := auto.

Require Coq.Program.Tactics.

Global Program Definition x9 := 0.
Local Program Definition x10 := 0.
Program Global Definition x11 := 0.
Program Local Definition x12 := 0.

Polymorphic Program Global Definition x13 := 0.
Polymorphic Program Local Definition x14 := 0.
Program Global Polymorphic Definition x15 := 0.
Program Local Polymorphic Definition x16 := 0.
Global Program Polymorphic Definition x17 := 0.
Local Program Polymorphic Definition x18 := 0.
coq-8.20.0/test-suite/misc/coqdoc-options/_CoqProject000066400000000000000000000001701466560755400225400ustar00rootroot00000000000000-R theories Coqdoc COQDOCFLAGS = "--index indexpage -g -coqlib_url http://coq.inria.fr/stdlib --utf8" theories/test.v coq-8.20.0/test-suite/misc/coqdoc-options/theories/000077500000000000000000000000001466560755400222315ustar00rootroot00000000000000coq-8.20.0/test-suite/misc/coqdoc-options/theories/test.v000066400000000000000000000034021466560755400233760ustar00rootroot00000000000000Class C := {}. Global Declare Instance I0 : C. Local Declare Instance I1 : C. Global Polymorphic Declare Instance I3 : C. Polymorphic Global Declare Instance I4 : C. Local Polymorphic Declare Instance I5 : C. Polymorphic Local Declare Instance I6 : C. Global Program Instance I7 : C := {}. Local Program Instance I8 : C := {}. Program Global Instance I9 : C := {}. Program Local Instance I10 : C := {}. Polymorphic Program Global Instance I11 : C := {}. Polymorphic Program Local Instance I12 : C := {}. Program Global Polymorphic Instance I13 : C := {}. Program Local Polymorphic Instance I14 : C := {}. Global Program Polymorphic Instance I15 : C := {}. Local Program Polymorphic Instance I16 : C := {}. Global Notation x0 := 0. Local Notation x1 := 0. Global Definition x2 := 0. Local Definition x3 := 0. Polymorphic Definition x4 := 0. Polymorphic Global Definition x5 := 0. Polymorphic Local Definition x6 := 0. Global Polymorphic Definition x7 := 0. Local Polymorphic Definition x8 := 0. Polymorphic Inductive y0 := z0. Polymorphic Variant y1 := z1. Local Obligation Tactic := auto. Global Obligation Tactic := auto. Global Typeclasses Opaque I7. Local Typeclasses Opaque I8. Global Hint Extern 10 (_ <= _) => auto : arith. Local Hint Extern 10 (_ <= _) => auto : arith. Global Ltac lt0 := auto. Local Ltac lt1 := auto. Require Coq.Program.Tactics. Global Program Definition x9 := 0. Local Program Definition x10 := 0. Program Global Definition x11 := 0. Program Local Definition x12 := 0. Polymorphic Program Global Definition x13 := 0. Polymorphic Program Local Definition x14 := 0. Program Global Polymorphic Definition x15 := 0. Program Local Polymorphic Definition x16 := 0. Global Program Polymorphic Definition x17 := 0. Local Program Polymorphic Definition x18 := 0. coq-8.20.0/test-suite/misc/coqtop_print-mod-uid.sh000077500000000000000000000002461466560755400220640ustar00rootroot00000000000000#!/usr/bin/env bash export COQBIN=$BIN export PATH=$COQBIN:$PATH [ "$(coqtop -print-mod-uid prerequisite/admit.vo)" = "prerequisite/.coq-native/NTestSuite_admit" ] coq-8.20.0/test-suite/misc/deps-checksum.sh000077500000000000000000000003441466560755400205410ustar00rootroot00000000000000#!/bin/sh rm -f misc/deps/A/*.vo misc/deps/B/*.vo $coqc -R misc/deps/A A misc/deps/A/A.v $coqc -R misc/deps/B A misc/deps/B/A.v $coqc -R misc/deps/B A misc/deps/B/B.v $coqc -R misc/deps/B A -R misc/deps/A A misc/deps/checksum.v coq-8.20.0/test-suite/misc/deps-order-distinct-root.sh000077500000000000000000000015261466560755400226550ustar00rootroot00000000000000#!/bin/sh # Check that both coqdep and coqtop/coqc support -R # Check that both coqdep and coqtop/coqc take the latter -R # See also bugs #2242, #2337, #2339 rm -f misc/deps/DistinctRoot/*.vo misc/deps/DistinctRoot/*.vo/{A,B}/*.vo output=misc/deps/DistinctRootDeps.real (cd misc/deps; $coqdep -f _CoqDistinctRoot) > "$output" 2>&1 diff -u --strip-trailing-cr misc/deps/DistinctRootDeps.out "$output" R=$? times $coqc -R misc/deps/DistinctRoot/A A -R misc/deps/DistinctRoot/B B misc/deps/DistinctRoot/A/File1.v $coqc -R misc/deps/DistinctRoot/A A -R misc/deps/DistinctRoot/B B misc/deps/DistinctRoot/B/File1.v $coqc -R misc/deps/DistinctRoot/A A -R misc/deps/DistinctRoot/B B misc/deps/DistinctRoot/File2.v S=$? if [ $R = 0 ] && [ $S = 0 ]; then printf "coqdep and coqc agree.\n" exit 0 else printf "coqdep and coqc disagree.\n" exit 1 fi coq-8.20.0/test-suite/misc/deps-order-from.sh000077500000000000000000000015001466560755400210060ustar00rootroot00000000000000#!/bin/sh # Check that both coqdep and coqtop/coqc support -R # Check that both coqdep and coqtop/coqc take the latter -R # See bugs #11631, #14539 rm -f misc/deps/test-from/A/C.vo misc/deps/test-from/B/C.vo misc/deps/test-from/D.vo misc/deps/test-from/E.vo output=misc/deps/deps-from.real $coqdep -R misc/deps/test-from T misc/deps/test-from/D.v misc/deps/test-from/E.v > "$output" 2>&1 diff -u --strip-trailing-cr misc/deps/deps-from.out "$output" R=$? times $coqc -R misc/deps/test-from T misc/deps/test-from/A/C.v $coqc -R misc/deps/test-from T misc/deps/test-from/B/C.v $coqc -R misc/deps/test-from T misc/deps/test-from/D.v $coqc -R misc/deps/test-from T misc/deps/test-from/E.v S=$? if [ $R = 0 ] && [ $S = 0 ]; then printf "coqdep and coqc agree\n" exit 0 else printf "coqdep and coqc disagree.\n" exit 1 fi coq-8.20.0/test-suite/misc/deps-order-subdir1-file.sh000077500000000000000000000021661466560755400223420ustar00rootroot00000000000000#!/bin/sh # Check that both coqdep and coqtop/coqc takes a file matching exactly # the logical path (if any) rm -f misc/deps/Theory1/*.vo misc/deps/Theory1/Subtheory?/*.vo misc/deps/Theory1/Subtheory?/Subsubtheory?/*.vo output=misc/deps/Theory1Deps.real (cd misc/deps; $coqdep -f _CoqTheory1Project) > "$output" 2>&1 diff -u --strip-trailing-cr misc/deps/Theory1Deps.out "$output" R=$? times $coqc -Q misc/deps/Theory1 Theory misc/deps/Theory1/File1.v $coqc -Q misc/deps/Theory1 Theory misc/deps/Theory1/Subtheory1/File1.v $coqc -Q misc/deps/Theory1 Theory misc/deps/Theory1/Subtheory1/Subsubtheory1/File1.v $coqc -Q misc/deps/Theory1 Theory misc/deps/Theory1/Subtheory1/Subsubtheory2/File1.v $coqc -Q misc/deps/Theory1 Theory misc/deps/Theory1/Subtheory2/File1.v $coqc -Q misc/deps/Theory1 Theory misc/deps/Theory1/Subtheory2/Subsubtheory1/File1.v $coqc -Q misc/deps/Theory1 Theory misc/deps/Theory1/Subtheory2/Subsubtheory2/File1.v $coqc -Q misc/deps/Theory1 Theory misc/deps/Theory1/File2.v S=$? if [ $R = 0 ] && [ $S = 0 ]; then printf "coqdep and coqc agree.\n" exit 0 else printf "coqdep and coqc disagree.\n" exit 1 fi coq-8.20.0/test-suite/misc/deps-order-subdir2-file.sh000077500000000000000000000024411466560755400223370ustar00rootroot00000000000000#!/bin/sh # Check that coqtop/coqc and coqdep behave the same in the presence of ambiguity # over child and sibling directories # Same test as deps-order-subdir1-file.sh but without Theory1/File1.v # This test is platform-dependent, we renounce to it dotest=true if [ $dotest = false ]; then exit 0; fi rm -f misc/deps/Theory2/*.vo misc/deps/Theory2/Subtheory?/*.vo misc/deps/Theory2/Subtheory?/Subsubtheory?/*.vo output=misc/deps/Theory2Deps.real (cd misc/deps; $coqdep -f _CoqTheory2Project) > "$output" 2>&1 diff -u --strip-trailing-cr misc/deps/Theory2Deps.out $output R=$? if [ $R != 0 ]; then printf "Unexpected coqdep result.\n" exit 1 fi times $coqc -Q misc/deps/Theory2 Theory misc/deps/Theory2/Subtheory1/File1.v $coqc -Q misc/deps/Theory2 Theory misc/deps/Theory2/Subtheory1/Subsubtheory2/File1.v $coqc -Q misc/deps/Theory2 Theory misc/deps/Theory2/Subtheory1/Subsubtheory2/File1.v $coqc -Q misc/deps/Theory2 Theory misc/deps/Theory2/Subtheory2/File1.v $coqc -Q misc/deps/Theory2 Theory misc/deps/Theory2/Subtheory2/Subsubtheory2/File1.v $coqc -Q misc/deps/Theory2 Theory misc/deps/Theory2/Subtheory2/Subsubtheory2/File1.v $coqc -Q misc/deps/Theory2 Theory misc/deps/Theory2/File2.v S=$? if [ $S = 0 ]; then printf "Unexpected coqc success.\n" exit 1 fi printf "coqdep and coqc ok.\n" coq-8.20.0/test-suite/misc/deps-order-subdir3-file.sh000077500000000000000000000023231466560755400223370ustar00rootroot00000000000000#!/bin/sh # Check that coqtop/coqc and coqdep behave the same in the presence of ambiguity # over child and sibling directories # Same test as deps-order-subdir2-file.sh but without Subtheory2/Subsubtheory? # so that it checks what comes first between siblings and (non immediate) children # This test is platform-dependent, we renounce to it dotest=true if [ $dotest = false ]; then exit 0; fi rm -f misc/deps/Theory3/*.vo misc/deps/Theory3/Subtheory?/*.vo misc/deps/Theory3/Subtheory?/Subsubtheory?/*.vo output=misc/deps/Theory3Deps.real (cd misc/deps; $coqdep -f _CoqTheory3Project) > "$output" 2>&1 diff -u --strip-trailing-cr misc/deps/Theory3Deps.out $output R=$? if [ $R != 0 ]; then printf "Unexpected coqdep result.\n" exit 1 fi times $coqc -Q misc/deps/Theory3 Theory misc/deps/Theory3/Subtheory1/File1.v $coqc -Q misc/deps/Theory3 Theory misc/deps/Theory3/Subtheory1/Subsubtheory2/File1.v $coqc -Q misc/deps/Theory3 Theory misc/deps/Theory3/Subtheory1/Subsubtheory2/File1.v $coqc -Q misc/deps/Theory3 Theory misc/deps/Theory3/Subtheory2/File1.v $coqc -Q misc/deps/Theory3 Theory misc/deps/Theory3/File2.v S=$? if [ $S = 0 ]; then printf "Unexpected coqc success.\n" exit 1 fi printf "coqdep and coqc ok.\n" coq-8.20.0/test-suite/misc/deps-order.sh000077500000000000000000000014001466560755400200440ustar00rootroot00000000000000#!/bin/sh # Check that both coqdep and coqtop/coqc supports -R # Check that both coqdep and coqtop/coqc takes the later -R # See bugs 2242, 2337, 2339 rm -f misc/deps/lib/*.vo misc/deps/client/*.vo output=misc/deps/deps.real $coqdep -R misc/deps/lib lib -R misc/deps/client client misc/deps/client/bar.v 2>&1 | head -n 1 > "$output" diff -u --strip-trailing-cr misc/deps/deps.out "$output" 2>&1 R=$? times $coqc -R misc/deps/lib lib misc/deps/lib/foo.v 2>&1 $coqc -R misc/deps/lib lib -R misc/deps/client client misc/deps/client/foo.v 2>&1 $coqc -R misc/deps/lib lib -R misc/deps/client client misc/deps/client/bar.v 2>&1 S=$? if [ $R = 0 ] && [ $S = 0 ]; then printf "coqdep and coqc agree\n" exit 0 else printf "coqdep and coqc disagree\n" exit 1 fi coq-8.20.0/test-suite/misc/deps-utf8.sh000077500000000000000000000006571466560755400176340ustar00rootroot00000000000000#!/bin/sh # Check reading directories matching non pure ascii idents # See bug #5715 (utf-8 working on macos X and linux) # Windows is still not compliant a=$(uname) if [ "$a" = "Darwin" ] || [ "$a" = "Linux" ]; then rm -f misc/deps/théorèmes/*.v $coqc -R misc/deps AlphaBêta misc/deps/αβ/γδ.v R=$? $coqc -R misc/deps AlphaBêta misc/deps/αβ/εζ.v S=$? if [ $R = 0 ] && [ $S = 0 ]; then exit 0 else exit 1 fi fi coq-8.20.0/test-suite/misc/deps/000077500000000000000000000000001466560755400164015ustar00rootroot00000000000000coq-8.20.0/test-suite/misc/deps/A/000077500000000000000000000000001466560755400165615ustar00rootroot00000000000000coq-8.20.0/test-suite/misc/deps/A/A.v000066400000000000000000000000261466560755400171260ustar00rootroot00000000000000Definition b := true. coq-8.20.0/test-suite/misc/deps/B/000077500000000000000000000000001466560755400165625ustar00rootroot00000000000000coq-8.20.0/test-suite/misc/deps/B/A.v000066400000000000000000000000271466560755400171300ustar00rootroot00000000000000Definition b := false. coq-8.20.0/test-suite/misc/deps/B/B.v000066400000000000000000000001211466560755400171240ustar00rootroot00000000000000Require A. Definition c := A.b. Lemma foo : c = false. Proof. reflexivity. Qed. coq-8.20.0/test-suite/misc/deps/DistinctRoot/000077500000000000000000000000001466560755400210265ustar00rootroot00000000000000coq-8.20.0/test-suite/misc/deps/DistinctRoot/A/000077500000000000000000000000001466560755400212065ustar00rootroot00000000000000coq-8.20.0/test-suite/misc/deps/DistinctRoot/A/File1.v000066400000000000000000000000001466560755400223230ustar00rootroot00000000000000coq-8.20.0/test-suite/misc/deps/DistinctRoot/B/000077500000000000000000000000001466560755400212075ustar00rootroot00000000000000coq-8.20.0/test-suite/misc/deps/DistinctRoot/B/File1.v000066400000000000000000000000001466560755400223240ustar00rootroot00000000000000coq-8.20.0/test-suite/misc/deps/DistinctRoot/File2.v000066400000000000000000000000171466560755400221540ustar00rootroot00000000000000Require File1. coq-8.20.0/test-suite/misc/deps/DistinctRootDeps.out000066400000000000000000000006671466560755400224040ustar00rootroot00000000000000DistinctRoot/A/File1.vo DistinctRoot/A/File1.glob DistinctRoot/A/File1.v.beautified DistinctRoot/A/File1.required_vo: DistinctRoot/A/File1.v DistinctRoot/B/File1.vo DistinctRoot/B/File1.glob DistinctRoot/B/File1.v.beautified DistinctRoot/B/File1.required_vo: DistinctRoot/B/File1.v DistinctRoot/File2.vo DistinctRoot/File2.glob DistinctRoot/File2.v.beautified DistinctRoot/File2.required_vo: DistinctRoot/File2.v DistinctRoot/B/File1.vo coq-8.20.0/test-suite/misc/deps/Theory1/000077500000000000000000000000001466560755400177345ustar00rootroot00000000000000coq-8.20.0/test-suite/misc/deps/Theory1/File1.v000066400000000000000000000000231466560755400210560ustar00rootroot00000000000000Definition a := 0. coq-8.20.0/test-suite/misc/deps/Theory1/File2.v000066400000000000000000000000701466560755400210610ustar00rootroot00000000000000From Theory Require File1. Check eq_refl : File1.a = 0. coq-8.20.0/test-suite/misc/deps/Theory1/Subtheory1/000077500000000000000000000000001466560755400220015ustar00rootroot00000000000000coq-8.20.0/test-suite/misc/deps/Theory1/Subtheory1/File1.v000066400000000000000000000000231466560755400231230ustar00rootroot00000000000000Definition a := 1. coq-8.20.0/test-suite/misc/deps/Theory1/Subtheory1/Subsubtheory1/000077500000000000000000000000001466560755400245605ustar00rootroot00000000000000coq-8.20.0/test-suite/misc/deps/Theory1/Subtheory1/Subsubtheory1/File1.v000066400000000000000000000000241466560755400257030ustar00rootroot00000000000000Definition a := 11. coq-8.20.0/test-suite/misc/deps/Theory1/Subtheory1/Subsubtheory2/000077500000000000000000000000001466560755400245615ustar00rootroot00000000000000coq-8.20.0/test-suite/misc/deps/Theory1/Subtheory1/Subsubtheory2/File1.v000066400000000000000000000000241466560755400257040ustar00rootroot00000000000000Definition a := 12. coq-8.20.0/test-suite/misc/deps/Theory1/Subtheory2/000077500000000000000000000000001466560755400220025ustar00rootroot00000000000000coq-8.20.0/test-suite/misc/deps/Theory1/Subtheory2/File1.v000066400000000000000000000000231466560755400231240ustar00rootroot00000000000000Definition a := 2. coq-8.20.0/test-suite/misc/deps/Theory1/Subtheory2/Subsubtheory1/000077500000000000000000000000001466560755400245615ustar00rootroot00000000000000coq-8.20.0/test-suite/misc/deps/Theory1/Subtheory2/Subsubtheory1/File1.v000066400000000000000000000000241466560755400257040ustar00rootroot00000000000000Definition a := 21. coq-8.20.0/test-suite/misc/deps/Theory1/Subtheory2/Subsubtheory2/000077500000000000000000000000001466560755400245625ustar00rootroot00000000000000coq-8.20.0/test-suite/misc/deps/Theory1/Subtheory2/Subsubtheory2/File1.v000066400000000000000000000000241466560755400257050ustar00rootroot00000000000000Definition a := 22. coq-8.20.0/test-suite/misc/deps/Theory1Deps.out000066400000000000000000000027121466560755400213030ustar00rootroot00000000000000Theory1/File1.vo Theory1/File1.glob Theory1/File1.v.beautified Theory1/File1.required_vo: Theory1/File1.v Theory1/File2.vo Theory1/File2.glob Theory1/File2.v.beautified Theory1/File2.required_vo: Theory1/File2.v Theory1/File1.vo Theory1/Subtheory1/File1.vo Theory1/Subtheory1/File1.glob Theory1/Subtheory1/File1.v.beautified Theory1/Subtheory1/File1.required_vo: Theory1/Subtheory1/File1.v Theory1/Subtheory1/Subsubtheory1/File1.vo Theory1/Subtheory1/Subsubtheory1/File1.glob Theory1/Subtheory1/Subsubtheory1/File1.v.beautified Theory1/Subtheory1/Subsubtheory1/File1.required_vo: Theory1/Subtheory1/Subsubtheory1/File1.v Theory1/Subtheory1/Subsubtheory2/File1.vo Theory1/Subtheory1/Subsubtheory2/File1.glob Theory1/Subtheory1/Subsubtheory2/File1.v.beautified Theory1/Subtheory1/Subsubtheory2/File1.required_vo: Theory1/Subtheory1/Subsubtheory2/File1.v Theory1/Subtheory2/File1.vo Theory1/Subtheory2/File1.glob Theory1/Subtheory2/File1.v.beautified Theory1/Subtheory2/File1.required_vo: Theory1/Subtheory2/File1.v Theory1/Subtheory2/Subsubtheory1/File1.vo Theory1/Subtheory2/Subsubtheory1/File1.glob Theory1/Subtheory2/Subsubtheory1/File1.v.beautified Theory1/Subtheory2/Subsubtheory1/File1.required_vo: Theory1/Subtheory2/Subsubtheory1/File1.v Theory1/Subtheory2/Subsubtheory2/File1.vo Theory1/Subtheory2/Subsubtheory2/File1.glob Theory1/Subtheory2/Subsubtheory2/File1.v.beautified Theory1/Subtheory2/Subsubtheory2/File1.required_vo: Theory1/Subtheory2/Subsubtheory2/File1.v coq-8.20.0/test-suite/misc/deps/Theory2/000077500000000000000000000000001466560755400177355ustar00rootroot00000000000000coq-8.20.0/test-suite/misc/deps/Theory2/File2.v000066400000000000000000000000701466560755400210620ustar00rootroot00000000000000From Theory Require File1. Check eq_refl : File1.a = 1. coq-8.20.0/test-suite/misc/deps/Theory2/Subtheory1/000077500000000000000000000000001466560755400220025ustar00rootroot00000000000000coq-8.20.0/test-suite/misc/deps/Theory2/Subtheory1/File1.v000066400000000000000000000000231466560755400231240ustar00rootroot00000000000000Definition a := 1. coq-8.20.0/test-suite/misc/deps/Theory2/Subtheory1/Subsubtheory1/000077500000000000000000000000001466560755400245615ustar00rootroot00000000000000coq-8.20.0/test-suite/misc/deps/Theory2/Subtheory1/Subsubtheory1/File1.v000066400000000000000000000000241466560755400257040ustar00rootroot00000000000000Definition a := 11. coq-8.20.0/test-suite/misc/deps/Theory2/Subtheory1/Subsubtheory2/000077500000000000000000000000001466560755400245625ustar00rootroot00000000000000coq-8.20.0/test-suite/misc/deps/Theory2/Subtheory1/Subsubtheory2/File1.v000066400000000000000000000000241466560755400257050ustar00rootroot00000000000000Definition a := 12. coq-8.20.0/test-suite/misc/deps/Theory2/Subtheory2/000077500000000000000000000000001466560755400220035ustar00rootroot00000000000000coq-8.20.0/test-suite/misc/deps/Theory2/Subtheory2/File1.v000066400000000000000000000000231466560755400231250ustar00rootroot00000000000000Definition a := 2. coq-8.20.0/test-suite/misc/deps/Theory2/Subtheory2/Subsubtheory1/000077500000000000000000000000001466560755400245625ustar00rootroot00000000000000coq-8.20.0/test-suite/misc/deps/Theory2/Subtheory2/Subsubtheory1/File1.v000066400000000000000000000000241466560755400257050ustar00rootroot00000000000000Definition a := 21. coq-8.20.0/test-suite/misc/deps/Theory2/Subtheory2/Subsubtheory2/000077500000000000000000000000001466560755400245635ustar00rootroot00000000000000coq-8.20.0/test-suite/misc/deps/Theory2/Subtheory2/Subsubtheory2/File1.v000066400000000000000000000000241466560755400257060ustar00rootroot00000000000000Definition a := 22. coq-8.20.0/test-suite/misc/deps/Theory2Deps.out000066400000000000000000000035531466560755400213100ustar00rootroot00000000000000Theory2/File2.vo Theory2/File2.glob Theory2/File2.v.beautified Theory2/File2.required_vo: Theory2/File2.v Theory2/Subtheory1/File1.vo Theory2/Subtheory1/Subsubtheory1/File1.vo Theory2/Subtheory1/Subsubtheory2/File1.vo Theory2/Subtheory2/File1.vo Theory2/Subtheory2/Subsubtheory1/File1.vo Theory2/Subtheory2/Subsubtheory2/File1.vo Theory2/Subtheory1/File1.vo Theory2/Subtheory1/File1.glob Theory2/Subtheory1/File1.v.beautified Theory2/Subtheory1/File1.required_vo: Theory2/Subtheory1/File1.v Theory2/Subtheory1/Subsubtheory1/File1.vo Theory2/Subtheory1/Subsubtheory1/File1.glob Theory2/Subtheory1/Subsubtheory1/File1.v.beautified Theory2/Subtheory1/Subsubtheory1/File1.required_vo: Theory2/Subtheory1/Subsubtheory1/File1.v Theory2/Subtheory1/Subsubtheory2/File1.vo Theory2/Subtheory1/Subsubtheory2/File1.glob Theory2/Subtheory1/Subsubtheory2/File1.v.beautified Theory2/Subtheory1/Subsubtheory2/File1.required_vo: Theory2/Subtheory1/Subsubtheory2/File1.v Theory2/Subtheory2/File1.vo Theory2/Subtheory2/File1.glob Theory2/Subtheory2/File1.v.beautified Theory2/Subtheory2/File1.required_vo: Theory2/Subtheory2/File1.v Theory2/Subtheory2/Subsubtheory1/File1.vo Theory2/Subtheory2/Subsubtheory1/File1.glob Theory2/Subtheory2/Subsubtheory1/File1.v.beautified Theory2/Subtheory2/Subsubtheory1/File1.required_vo: Theory2/Subtheory2/Subsubtheory1/File1.v Theory2/Subtheory2/Subsubtheory2/File1.vo Theory2/Subtheory2/Subsubtheory2/File1.glob Theory2/Subtheory2/Subsubtheory2/File1.v.beautified Theory2/Subtheory2/Subsubtheory2/File1.required_vo: Theory2/Subtheory2/Subsubtheory2/File1.v *** Warning: in file Theory2/File2.v, required library File1 matches several files in path (found File1.v in Theory2/Subtheory2/Subsubtheory2, Theory2/Subtheory2/Subsubtheory1, Theory2/Subtheory2, Theory2/Subtheory1/Subsubtheory2, Theory2/Subtheory1/Subsubtheory1 and Theory2/Subtheory1; Require will fail). coq-8.20.0/test-suite/misc/deps/Theory3/000077500000000000000000000000001466560755400177365ustar00rootroot00000000000000coq-8.20.0/test-suite/misc/deps/Theory3/File2.v000066400000000000000000000000701466560755400210630ustar00rootroot00000000000000From Theory Require File1. Check eq_refl : File1.a = 1. coq-8.20.0/test-suite/misc/deps/Theory3/Subtheory1/000077500000000000000000000000001466560755400220035ustar00rootroot00000000000000coq-8.20.0/test-suite/misc/deps/Theory3/Subtheory1/File1.v000066400000000000000000000000231466560755400231250ustar00rootroot00000000000000Definition a := 1. coq-8.20.0/test-suite/misc/deps/Theory3/Subtheory1/Subsubtheory1/000077500000000000000000000000001466560755400245625ustar00rootroot00000000000000coq-8.20.0/test-suite/misc/deps/Theory3/Subtheory1/Subsubtheory1/File1.v000066400000000000000000000000241466560755400257050ustar00rootroot00000000000000Definition a := 11. coq-8.20.0/test-suite/misc/deps/Theory3/Subtheory1/Subsubtheory2/000077500000000000000000000000001466560755400245635ustar00rootroot00000000000000coq-8.20.0/test-suite/misc/deps/Theory3/Subtheory1/Subsubtheory2/File1.v000066400000000000000000000000241466560755400257060ustar00rootroot00000000000000Definition a := 12. coq-8.20.0/test-suite/misc/deps/Theory3/Subtheory2/000077500000000000000000000000001466560755400220045ustar00rootroot00000000000000coq-8.20.0/test-suite/misc/deps/Theory3/Subtheory2/File1.v000066400000000000000000000000231466560755400231260ustar00rootroot00000000000000Definition a := 2. coq-8.20.0/test-suite/misc/deps/Theory3Deps.out000066400000000000000000000024031466560755400213020ustar00rootroot00000000000000Theory3/File2.vo Theory3/File2.glob Theory3/File2.v.beautified Theory3/File2.required_vo: Theory3/File2.v Theory3/Subtheory1/File1.vo Theory3/Subtheory1/Subsubtheory1/File1.vo Theory3/Subtheory1/Subsubtheory2/File1.vo Theory3/Subtheory2/File1.vo Theory3/Subtheory1/File1.vo Theory3/Subtheory1/File1.glob Theory3/Subtheory1/File1.v.beautified Theory3/Subtheory1/File1.required_vo: Theory3/Subtheory1/File1.v Theory3/Subtheory1/Subsubtheory1/File1.vo Theory3/Subtheory1/Subsubtheory1/File1.glob Theory3/Subtheory1/Subsubtheory1/File1.v.beautified Theory3/Subtheory1/Subsubtheory1/File1.required_vo: Theory3/Subtheory1/Subsubtheory1/File1.v Theory3/Subtheory1/Subsubtheory2/File1.vo Theory3/Subtheory1/Subsubtheory2/File1.glob Theory3/Subtheory1/Subsubtheory2/File1.v.beautified Theory3/Subtheory1/Subsubtheory2/File1.required_vo: Theory3/Subtheory1/Subsubtheory2/File1.v Theory3/Subtheory2/File1.vo Theory3/Subtheory2/File1.glob Theory3/Subtheory2/File1.v.beautified Theory3/Subtheory2/File1.required_vo: Theory3/Subtheory2/File1.v *** Warning: in file Theory3/File2.v, required library File1 matches several files in path (found File1.v in Theory3/Subtheory2, Theory3/Subtheory1/Subsubtheory2, Theory3/Subtheory1/Subsubtheory1 and Theory3/Subtheory1; Require will fail). coq-8.20.0/test-suite/misc/deps/_CoqDistinctRoot000066400000000000000000000001531466560755400215520ustar00rootroot00000000000000-R DistinctRoot/A A -R DistinctRoot/B B DistinctRoot/A/File1.v DistinctRoot/B/File1.v DistinctRoot/File2.v coq-8.20.0/test-suite/misc/deps/_CoqTheory1Project000066400000000000000000000004151466560755400220100ustar00rootroot00000000000000-Q Theory1/ Theory Theory1/File1.v Theory1/File2.v Theory1/Subtheory1/File1.v Theory1/Subtheory1/Subsubtheory1/File1.v Theory1/Subtheory1/Subsubtheory2/File1.v Theory1/Subtheory2/File1.v Theory1/Subtheory2/Subsubtheory1/File1.v Theory1/Subtheory2/Subsubtheory2/File1.v coq-8.20.0/test-suite/misc/deps/_CoqTheory2Project000066400000000000000000000003751466560755400220160ustar00rootroot00000000000000-Q Theory2/ Theory Theory2/File2.v Theory2/Subtheory1/File1.v Theory2/Subtheory1/Subsubtheory1/File1.v Theory2/Subtheory1/Subsubtheory2/File1.v Theory2/Subtheory2/File1.v Theory2/Subtheory2/Subsubtheory1/File1.v Theory2/Subtheory2/Subsubtheory2/File1.v coq-8.20.0/test-suite/misc/deps/_CoqTheory3Project000066400000000000000000000002531466560755400220120ustar00rootroot00000000000000-Q Theory3/ Theory Theory3/File2.v Theory3/Subtheory1/File1.v Theory3/Subtheory1/Subsubtheory1/File1.v Theory3/Subtheory1/Subsubtheory2/File1.v Theory3/Subtheory2/File1.v coq-8.20.0/test-suite/misc/deps/checksum.v000066400000000000000000000000511466560755400203660ustar00rootroot00000000000000Require Import A. Fail Require Import B. coq-8.20.0/test-suite/misc/deps/client/000077500000000000000000000000001466560755400176575ustar00rootroot00000000000000coq-8.20.0/test-suite/misc/deps/client/bar.v000066400000000000000000000003641466560755400206150ustar00rootroot00000000000000(* We assume the file compiled with -R ../lib lib -R . client *) (* foo alone should refer to client.foo because -R . client comes last *) Require Import foo. Goal a = 1. reflexivity. Qed. Require Import lib.foo. Goal a = 0. reflexivity. Qed. coq-8.20.0/test-suite/misc/deps/client/foo.v000066400000000000000000000000231466560755400206240ustar00rootroot00000000000000Definition a := 1. coq-8.20.0/test-suite/misc/deps/deps-from.out000066400000000000000000000005321466560755400210260ustar00rootroot00000000000000misc/deps/test-from/D.vo misc/deps/test-from/D.glob misc/deps/test-from/D.v.beautified misc/deps/test-from/D.required_vo: misc/deps/test-from/D.v misc/deps/test-from/A/C.vo misc/deps/test-from/E.vo misc/deps/test-from/E.glob misc/deps/test-from/E.v.beautified misc/deps/test-from/E.required_vo: misc/deps/test-from/E.v misc/deps/test-from/B/C.vo coq-8.20.0/test-suite/misc/deps/deps.out000066400000000000000000000002721466560755400200660ustar00rootroot00000000000000misc/deps/client/bar.vo misc/deps/client/bar.glob misc/deps/client/bar.v.beautified misc/deps/client/bar.required_vo: misc/deps/client/bar.v misc/deps/client/foo.vo misc/deps/lib/foo.vo coq-8.20.0/test-suite/misc/deps/lib/000077500000000000000000000000001466560755400171475ustar00rootroot00000000000000coq-8.20.0/test-suite/misc/deps/lib/foo.v000066400000000000000000000000231466560755400201140ustar00rootroot00000000000000Definition a := 0. coq-8.20.0/test-suite/misc/deps/test-from/000077500000000000000000000000001466560755400203215ustar00rootroot00000000000000coq-8.20.0/test-suite/misc/deps/test-from/A/000077500000000000000000000000001466560755400205015ustar00rootroot00000000000000coq-8.20.0/test-suite/misc/deps/test-from/A/C.v000066400000000000000000000000261466560755400210500ustar00rootroot00000000000000Definition c := true. coq-8.20.0/test-suite/misc/deps/test-from/B/000077500000000000000000000000001466560755400205025ustar00rootroot00000000000000coq-8.20.0/test-suite/misc/deps/test-from/B/C.v000066400000000000000000000000271466560755400210520ustar00rootroot00000000000000Definition c := false. coq-8.20.0/test-suite/misc/deps/test-from/D.v000066400000000000000000000002121466560755400206660ustar00rootroot00000000000000(* Assumed to be compiled with -R test-from T *) From T.A Require C. Definition c := C.c. Lemma foo : c = true. Proof. reflexivity. Qed. coq-8.20.0/test-suite/misc/deps/test-from/E.v000066400000000000000000000002131466560755400206700ustar00rootroot00000000000000(* Assumed to be compiled with -R test-from T *) From T.B Require C. Definition c := C.c. Lemma foo : c = false. Proof. reflexivity. Qed. coq-8.20.0/test-suite/misc/deps/αβ/000077500000000000000000000000001466560755400200575ustar00rootroot00000000000000coq-8.20.0/test-suite/misc/deps/αβ/γδ.v000066400000000000000000000000651466560755400217310ustar00rootroot00000000000000Theorem simple : forall A, A -> A. Proof. auto. Qed. coq-8.20.0/test-suite/misc/deps/αβ/εζ.v000066400000000000000000000000251466560755400217310ustar00rootroot00000000000000Require Import γδ. coq-8.20.0/test-suite/misc/exitstatus.sh000077500000000000000000000002221466560755400202160ustar00rootroot00000000000000#!/bin/sh $coqc misc/exitstatus/illtyped.v P=$? printf "On ill-typed input, coqc returned %s.\n" "$P" if [ $P = 1 ]; then exit 0; else exit 1; fi coq-8.20.0/test-suite/misc/exitstatus/000077500000000000000000000000001466560755400176635ustar00rootroot00000000000000coq-8.20.0/test-suite/misc/exitstatus/illtyped.v000066400000000000000000000000131466560755400216720ustar00rootroot00000000000000Check S S. coq-8.20.0/test-suite/misc/external-deps.sh000077500000000000000000000024451466560755400205650ustar00rootroot00000000000000#!/bin/sh set -e # Set Extra Dependency syntax output=misc/external-deps/file1.found.real $coqdep -Q misc/external-deps/deps foo.bar misc/external-deps/file1.v > $output 2>&1 diff -u --strip-trailing-cr misc/external-deps/file1.found.deps $output output=misc/external-deps/file1.ambiguous.real $coqdep -Q misc/external-deps/deps foo.bar -Q misc/external-deps/more foo.bar misc/external-deps/file1.v > $output 2>&1 diff -u --strip-trailing-cr misc/external-deps/file1.ambiguous.deps $output output=misc/external-deps/file1.notfound.real $coqdep misc/external-deps/file1.v > $output 2>&1 diff -u --strip-trailing-cr misc/external-deps/file1.notfound.deps $output # From bla Extra Dependency syntax output=misc/external-deps/file2.found.real $coqdep -Q misc/external-deps/deps foo.bar misc/external-deps/file2.v > $output 2>&1 diff -u --strip-trailing-cr misc/external-deps/file2.found.deps $output output=misc/external-deps/file2.ambiguous.real $coqdep -Q misc/external-deps/deps foo.bar -Q misc/external-deps/more foo.bar misc/external-deps/file2.v > $output 2>&1 diff -u --strip-trailing-cr misc/external-deps/file2.ambiguous.deps $output output=misc/external-deps/file2.notfound.real $coqdep misc/external-deps/file2.v > $output 2>&1 diff -u --strip-trailing-cr misc/external-deps/file2.notfound.deps $output coq-8.20.0/test-suite/misc/external-deps/000077500000000000000000000000001466560755400202215ustar00rootroot00000000000000coq-8.20.0/test-suite/misc/external-deps/deps/000077500000000000000000000000001466560755400211545ustar00rootroot00000000000000coq-8.20.0/test-suite/misc/external-deps/deps/d1000066400000000000000000000000001466560755400213710ustar00rootroot00000000000000coq-8.20.0/test-suite/misc/external-deps/file1.ambiguous.deps000066400000000000000000000006121466560755400240670ustar00rootroot00000000000000misc/external-deps/file1.vo misc/external-deps/file1.glob misc/external-deps/file1.v.beautified misc/external-deps/file1.required_vo: misc/external-deps/file1.v misc/external-deps/more/d1 *** Warning: in file misc/external-deps/file1.v, required external file d1 exactly matches several files in path (found d1 in misc/external-deps/deps and misc/external-deps/more; used the latter). coq-8.20.0/test-suite/misc/external-deps/file1.found.deps000066400000000000000000000002741466560755400232130ustar00rootroot00000000000000misc/external-deps/file1.vo misc/external-deps/file1.glob misc/external-deps/file1.v.beautified misc/external-deps/file1.required_vo: misc/external-deps/file1.v misc/external-deps/deps/d1 coq-8.20.0/test-suite/misc/external-deps/file1.notfound.deps000066400000000000000000000005361466560755400237350ustar00rootroot00000000000000Warning: in file misc/external-deps/file1.v, external file d1 is required from root foo.bar and has not been found in the loadpath! [module-not-found,filesystem,default] misc/external-deps/file1.vo misc/external-deps/file1.glob misc/external-deps/file1.v.beautified misc/external-deps/file1.required_vo: misc/external-deps/file1.v coq-8.20.0/test-suite/misc/external-deps/file1.v000066400000000000000000000000551466560755400214100ustar00rootroot00000000000000Comments From foo.bar Extra Dependency "d1". coq-8.20.0/test-suite/misc/external-deps/file2.ambiguous.deps000066400000000000000000000006121466560755400240700ustar00rootroot00000000000000misc/external-deps/file2.vo misc/external-deps/file2.glob misc/external-deps/file2.v.beautified misc/external-deps/file2.required_vo: misc/external-deps/file2.v misc/external-deps/more/d1 *** Warning: in file misc/external-deps/file2.v, required external file d1 exactly matches several files in path (found d1 in misc/external-deps/deps and misc/external-deps/more; used the latter). coq-8.20.0/test-suite/misc/external-deps/file2.found.deps000066400000000000000000000002741466560755400232140ustar00rootroot00000000000000misc/external-deps/file2.vo misc/external-deps/file2.glob misc/external-deps/file2.v.beautified misc/external-deps/file2.required_vo: misc/external-deps/file2.v misc/external-deps/deps/d1 coq-8.20.0/test-suite/misc/external-deps/file2.notfound.deps000066400000000000000000000005361466560755400237360ustar00rootroot00000000000000Warning: in file misc/external-deps/file2.v, external file d1 is required from root foo.bar and has not been found in the loadpath! [module-not-found,filesystem,default] misc/external-deps/file2.vo misc/external-deps/file2.glob misc/external-deps/file2.v.beautified misc/external-deps/file2.required_vo: misc/external-deps/file2.v coq-8.20.0/test-suite/misc/external-deps/file2.v000066400000000000000000000000441466560755400214070ustar00rootroot00000000000000From foo.bar Extra Dependency "d1". coq-8.20.0/test-suite/misc/external-deps/more/000077500000000000000000000000001466560755400211635ustar00rootroot00000000000000coq-8.20.0/test-suite/misc/external-deps/more/d1000066400000000000000000000000001466560755400214000ustar00rootroot00000000000000coq-8.20.0/test-suite/misc/non-marshalable-state.sh000077500000000000000000000013571466560755400221740ustar00rootroot00000000000000#!/usr/bin/env bash set -ex export COQBIN=$BIN export PATH=$COQBIN:$PATH cd misc/non-marshalable-state/ if which cygpath >/dev/null 2>&1; then OCAMLFINDSEP=\;; else OCAMLFINDSEP=:; fi export OCAMLPATH=$PWD$OCAMLFINDSEP$OCAMLPATH coq_makefile -f _CoqProject -o Makefile make clean make src/evil_plugin.cmxs make src/good_plugin.cmxs if coqc -async-proofs on -I src -Q theories Marshal theories/evil.v 2> log1 1>&2; then >&2 echo "evil.v should have failed with async proofs on" exit 1 fi if ! grep -q 'Marshalling error' log1; then >&2 echo "Missing expected error message in evil.v output" exit 1 fi coqc -async-proofs off -I src -Q theories Marshal theories/evil.v coqc -async-proofs on -I src -Q theories Marshal theories/good.v coq-8.20.0/test-suite/misc/non-marshalable-state/000077500000000000000000000000001466560755400216275ustar00rootroot00000000000000coq-8.20.0/test-suite/misc/non-marshalable-state/META.coq-test-suite000066400000000000000000000011371466560755400251670ustar00rootroot00000000000000package "evil" ( directory = "src" version = "dev" description = "An evil test plugin" requires = "coq-core.plugins.ltac" archive(byte) = "evil_plugin.cma" archive(native) = "evil_plugin.cmxa" plugin(byte) = "evil_plugin.cma" plugin(native) = "evil_plugin.cmxs" ) package "good" ( directory = "src" version = "dev" description = "A good test plugin" requires = "coq-core.plugins.ltac" archive(byte) = "good_plugin.cma" archive(native) = "good_plugin.cmxa" plugin(byte) = "good_plugin.cma" plugin(native) = "good_plugin.cmxs" ) directory = "." coq-8.20.0/test-suite/misc/non-marshalable-state/_CoqProject000066400000000000000000000002301466560755400237550ustar00rootroot00000000000000META.coq-test-suite -Q theories Marshal -I src src/evil.mlg src/good.mlg src/evil_plugin.mlpack src/good_plugin.mlpack theories/evil.v theories/good.v coq-8.20.0/test-suite/misc/non-marshalable-state/src/000077500000000000000000000000001466560755400224165ustar00rootroot00000000000000coq-8.20.0/test-suite/misc/non-marshalable-state/src/evil.mlg000066400000000000000000000003251466560755400240560ustar00rootroot00000000000000DECLARE PLUGIN "coq-test-suite.evil" { let state = Summary.ref ~name:"elpi-compiler-cache" None } VERNAC COMMAND EXTEND magic CLASSIFIED AS SIDEFF | [ "magic" ] -> { state := Some (fun () -> ()) } END coq-8.20.0/test-suite/misc/non-marshalable-state/src/evil_plugin.mlpack000066400000000000000000000000051466560755400261170ustar00rootroot00000000000000Evil coq-8.20.0/test-suite/misc/non-marshalable-state/src/good.mlg000066400000000000000000000003411466560755400240450ustar00rootroot00000000000000DECLARE PLUGIN "coq-test-suite.good" { let state = Summary.ref ~local:true ~name:"elpi-compiler-cache" None } VERNAC COMMAND EXTEND magic CLASSIFIED AS SIDEFF | [ "magic" ] -> { state := Some (fun () -> ()) } END coq-8.20.0/test-suite/misc/non-marshalable-state/src/good_plugin.mlpack000066400000000000000000000000051466560755400261100ustar00rootroot00000000000000Good coq-8.20.0/test-suite/misc/non-marshalable-state/theories/000077500000000000000000000000001466560755400234515ustar00rootroot00000000000000coq-8.20.0/test-suite/misc/non-marshalable-state/theories/evil.v000066400000000000000000000001271466560755400245770ustar00rootroot00000000000000Declare ML Module "coq-test-suite.evil". magic. Lemma x : True. Proof. trivial. Qed. coq-8.20.0/test-suite/misc/non-marshalable-state/theories/good.v000066400000000000000000000001271466560755400245700ustar00rootroot00000000000000Declare ML Module "coq-test-suite.good". magic. Lemma x : True. Proof. trivial. Qed. coq-8.20.0/test-suite/misc/poly-capture-global-univs.sh000077500000000000000000000003751466560755400230360ustar00rootroot00000000000000#!/usr/bin/env bash set -e export COQBIN=$BIN export PATH=$COQBIN:$PATH cd misc/poly-capture-global-univs/ coq_makefile -f _CoqProject -o Makefile make clean make src/evil_plugin.cma if make; then >&2 echo 'Should have failed!' exit 1 fi coq-8.20.0/test-suite/misc/poly-capture-global-univs/000077500000000000000000000000001466560755400224725ustar00rootroot00000000000000coq-8.20.0/test-suite/misc/poly-capture-global-univs/_CoqProject000066400000000000000000000002031466560755400246200ustar00rootroot00000000000000META.coq-test-suite -Q theories Evil -I src src/evil.mlg src/evilImpl.ml src/evilImpl.mli src/evil_plugin.mlpack theories/evil.v coq-8.20.0/test-suite/misc/poly-capture-global-univs/src/000077500000000000000000000000001466560755400232615ustar00rootroot00000000000000coq-8.20.0/test-suite/misc/poly-capture-global-univs/src/evil.mlg000066400000000000000000000002601466560755400247170ustar00rootroot00000000000000{ open Stdarg open EvilImpl } DECLARE PLUGIN "coq-core.plugins.evil" VERNAC COMMAND EXTEND VernacEvil CLASSIFIED AS SIDEFF | [ "Evil" ident(x) ident(y) ] -> { evil x y } END coq-8.20.0/test-suite/misc/poly-capture-global-univs/src/evilImpl.ml000066400000000000000000000015151466560755400253760ustar00rootroot00000000000000open Names let evil name name_f = let open Univ in let open UVars in let open Constr in let kind = Decls.(IsDefinition Definition) in let u = Level.var 0 in let tu = mkType (Universe.make u) in let te = Declare.definition_entry ~univs:(UState.Monomorphic_entry (ContextSet.singleton u), UnivNames.empty_binders) tu in let tc = Declare.declare_constant ~name ~kind (Declare.DefinitionEntry te) in let tc = mkConst tc in let fe = Declare.definition_entry ~univs:(UState.Polymorphic_entry (UContext.make ([||],[|Anonymous|]) (Instance.of_array ([||],[|u|]),Constraints.empty)), UnivNames.empty_binders) ~types:(Term.mkArrowR tc tu) (mkLambda (Context.nameR (Id.of_string "x"), tc, mkRel 1)) in let _ : Constant.t = Declare.declare_constant ~name:name_f ~kind (Declare.DefinitionEntry fe) in () coq-8.20.0/test-suite/misc/poly-capture-global-univs/src/evilImpl.mli000066400000000000000000000000551466560755400255450ustar00rootroot00000000000000 val evil : Names.Id.t -> Names.Id.t -> unit coq-8.20.0/test-suite/misc/poly-capture-global-univs/src/evil_plugin.mlpack000066400000000000000000000000161466560755400267640ustar00rootroot00000000000000EvilImpl Evil coq-8.20.0/test-suite/misc/poly-capture-global-univs/theories/000077500000000000000000000000001466560755400243145ustar00rootroot00000000000000coq-8.20.0/test-suite/misc/poly-capture-global-univs/theories/evil.v000066400000000000000000000004011466560755400254350ustar00rootroot00000000000000 Declare ML Module "coq-test-suite.evil". Evil T f. (* <- if this doesn't fail then the rest goes through *) Definition g : Type -> Set := f. Require Import Hurkens. Lemma absurd : False. Proof. exact (TypeNeqSmallType.paradox (g Type) eq_refl). Qed. coq-8.20.0/test-suite/misc/print-assumptions-vok.sh000077500000000000000000000005761466560755400223310ustar00rootroot00000000000000#!/bin/sh set -e # Use coqc instead of $coqc to work in async mode export PATH="$BIN:$PATH" coqc -R misc/print-assumptions-vok/ PrintAssumptionsVOK -vos misc/print-assumptions-vok/file1.v coqc -R misc/print-assumptions-vok/ PrintAssumptionsVOK -vos misc/print-assumptions-vok/file2.v coqc -R misc/print-assumptions-vok/ PrintAssumptionsVOK -vok misc/print-assumptions-vok/file2.v coq-8.20.0/test-suite/misc/print-assumptions-vok/000077500000000000000000000000001466560755400217625ustar00rootroot00000000000000coq-8.20.0/test-suite/misc/print-assumptions-vok/file1.v000066400000000000000000000001251466560755400231470ustar00rootroot00000000000000Lemma hidden : False. Proof. Admitted. Lemma aux : False. Proof. apply hidden. Qed. coq-8.20.0/test-suite/misc/print-assumptions-vok/file2.v000066400000000000000000000002041466560755400231460ustar00rootroot00000000000000From PrintAssumptionsVOK Require file1. Lemma main : False. Proof. apply file1.aux. Qed. Print Assumptions main. (* this fails *) coq-8.20.0/test-suite/misc/printers.sh000077500000000000000000000006551466560755400176610ustar00rootroot00000000000000#!/bin/sh command -v "${BIN}coqtop.byte" || { echo "Missing coqtop.byte"; exit 1; } f=$(mktemp) { printf 'Drop.\n#go;;\nQuit.\n' | "${BIN}coqtop.byte" -q } 2>&1 | tee "$f" # if there's an issue in `include_utilities`, `#go;;` won't be mentioned # if there's an issue in `include_printers`, it will be an undefined printer if ! grep -q -F '#go;;' "$f" || grep -q -E -i 'Error|Unbound|Anomaly' "$f"; then exit 1; fi coq-8.20.0/test-suite/misc/qed-time.sh000077500000000000000000000013461466560755400175160ustar00rootroot00000000000000#!/usr/bin/env bash set -ex export COQBIN=$BIN export PATH=$COQBIN:$PATH cd misc/qed-time/ # This test checks that the Qed time includes the time of the replayed command # The version of this test in output-modulo-time checks that each # command gets 1 time line, but because output-modulo-time normalizes # times to 0 it can't check that the replayed command is not ignored coqc -time file.v > out last=$(tail -n 1 out) last=${last#"Chars 98 - 102 [Qed.] "} last=${last%" secs"*} # sanity check: regex produces a float [[ $last =~ [0-9]+"."[0-9]* ]] test() { printf 'if %s <= 0.9:\n\texit (1)\n' "$1" | python3 } # sanity checks: python works on the code we produce if test 0.9; then exit 1; fi test 1. test 1.1 test "$last" coq-8.20.0/test-suite/misc/qed-time/000077500000000000000000000000001466560755400171535ustar00rootroot00000000000000coq-8.20.0/test-suite/misc/qed-time/file.v000066400000000000000000000001471466560755400202630ustar00rootroot00000000000000Lemma foo : True. Proof. Axiom X : ltac:(try timeout 1 repeat pose True; exact nat). exact I. Qed. coq-8.20.0/test-suite/misc/quotation_token.sh000077500000000000000000000010541466560755400212300ustar00rootroot00000000000000#!/usr/bin/env bash set -e export COQBIN=$BIN export PATH=$COQBIN:$PATH cd misc/quotation_token/ if which cygpath >/dev/null 2>&1; then OCAMLFINDSEP=\;; else OCAMLFINDSEP=:; fi export OCAMLPATH=$PWD$OCAMLFINDSEP$OCAMLPATH coq_makefile -f _CoqProject -o Makefile make clean make src/quotation_plugin.cma TMP=`mktemp` if make > $TMP 2>&1; then echo "should fail" rm $TMP exit 1 fi if grep "File.*quotation.v., line 12, characters 6-30" $TMP; then rm $TMP exit 0 else echo "wong loc: `grep File.*quotation.v $TMP`" rm $TMP exit 1 fi coq-8.20.0/test-suite/misc/quotation_token/000077500000000000000000000000001466560755400206715ustar00rootroot00000000000000coq-8.20.0/test-suite/misc/quotation_token/META.coq-test-suite000066400000000000000000000005261466560755400242320ustar00rootroot00000000000000package "quotation" ( directory = "src" version = "dev" description = "An quotation test plugin" requires = "coq-core.plugins.ltac" archive(byte) = "quotation_plugin.cma" archive(native) = "quotation_plugin.cmxa" plugin(byte) = "quotation_plugin.cma" plugin(native) = "quotation_plugin.cmxs" ) directory = "." coq-8.20.0/test-suite/misc/quotation_token/_CoqProject000066400000000000000000000001651466560755400230260ustar00rootroot00000000000000META.coq-test-suite -Q theories Quotation -I src src/quotation.mlg src/quotation_plugin.mlpack theories/quotation.v coq-8.20.0/test-suite/misc/quotation_token/src/000077500000000000000000000000001466560755400214605ustar00rootroot00000000000000coq-8.20.0/test-suite/misc/quotation_token/src/quotation.mlg000066400000000000000000000003741466560755400242100ustar00rootroot00000000000000DECLARE PLUGIN "coq-test-suite.quotation" { open Pcoq.Constr } GRAMMAR EXTEND Gram GLOBAL: term; term: LEVEL "0" [ [ s = QUOTATION "foobar:" -> { CAst.make ~loc Constrexpr.(CSort Constrexpr_ops.expr_Prop_sort) } ] ] ; END coq-8.20.0/test-suite/misc/quotation_token/src/quotation_plugin.mlpack000066400000000000000000000000121466560755400262430ustar00rootroot00000000000000Quotation coq-8.20.0/test-suite/misc/quotation_token/theories/000077500000000000000000000000001466560755400225135ustar00rootroot00000000000000coq-8.20.0/test-suite/misc/quotation_token/theories/quotation.v000066400000000000000000000002701466560755400247240ustar00rootroot00000000000000 Declare ML Module "coq-test-suite.quotation". Definition x := foobar:{{ hello there }}. Definition y := foobar:{{ another multi line thing }}. Check foobar:{{ oops ips }} y. coq-8.20.0/test-suite/misc/redirect_printing.out000066400000000000000000000001461466560755400217130ustar00rootroot00000000000000nat_ind : forall P : nat -> Prop, P 0 -> (forall n : nat, P n -> P (S n)) -> forall n : nat, P n coq-8.20.0/test-suite/misc/redirect_printing.sh000077500000000000000000000001511466560755400215150ustar00rootroot00000000000000#!/usr/bin/env bash $coqc misc/redirect_printing.v diff -u redirect_test.out misc/redirect_printing.out coq-8.20.0/test-suite/misc/redirect_printing.v000066400000000000000000000001031466560755400213420ustar00rootroot00000000000000Set Printing Width 999999. Redirect "redirect_test" Check nat_ind. coq-8.20.0/test-suite/misc/side-eff-leak-univs.sh000077500000000000000000000003671466560755400215510ustar00rootroot00000000000000#!/usr/bin/env bash set -e export COQBIN=$BIN export PATH=$COQBIN:$PATH cd misc/side-eff-leak-univs/ coq_makefile -f _CoqProject -o Makefile make clean make src/evil_plugin.cma if make; then >&2 echo 'Should have failed!' exit 1 fi coq-8.20.0/test-suite/misc/side-eff-leak-univs/000077500000000000000000000000001466560755400212045ustar00rootroot00000000000000coq-8.20.0/test-suite/misc/side-eff-leak-univs/_CoqProject000066400000000000000000000001411466560755400233330ustar00rootroot00000000000000META.coq-test-suite -Q theories Evil -I src src/evil.mlg src/evil_plugin.mlpack theories/evil.v coq-8.20.0/test-suite/misc/side-eff-leak-univs/src/000077500000000000000000000000001466560755400217735ustar00rootroot00000000000000coq-8.20.0/test-suite/misc/side-eff-leak-univs/src/evil.mlg000066400000000000000000000004621466560755400234350ustar00rootroot00000000000000DECLARE PLUGIN "coq-core.plugins.evil" { open Ltac_plugin open Stdarg } TACTIC EXTEND magic | [ "magic" ident(i) ident(j) ] -> { let open Constrexpr in DeclareUniv.do_constraint ~poly:false [ CType (Libnames.qualid_of_ident i), Univ.Lt, CType (Libnames.qualid_of_ident j)]; Proofview.tclUNIT() } END coq-8.20.0/test-suite/misc/side-eff-leak-univs/src/evil_plugin.mlpack000066400000000000000000000000051466560755400254740ustar00rootroot00000000000000Evil coq-8.20.0/test-suite/misc/side-eff-leak-univs/theories/000077500000000000000000000000001466560755400230265ustar00rootroot00000000000000coq-8.20.0/test-suite/misc/side-eff-leak-univs/theories/evil.v000066400000000000000000000003061466560755400241530ustar00rootroot00000000000000Declare ML Module "coq-test-suite.evil". Universes i j. Lemma foo@{} : Type@{j}. Proof. magic i j; transparent_abstract exact_no_check Type@{i}. Defined. Definition bar : Type@{i} := Type@{j}. coq-8.20.0/test-suite/misc/tc_declaration_observer.sh000077500000000000000000000003271466560755400226710ustar00rootroot00000000000000#!/usr/bin/env bash set -e export COQBIN="$BIN" export PATH="$BIN:$PATH" cd misc/tc_declaration_observer coq_makefile -f _CoqProject -o Makefile make clean rm -f main.out make diff -u main.out main.out.reference coq-8.20.0/test-suite/misc/tc_declaration_observer/000077500000000000000000000000001466560755400223305ustar00rootroot00000000000000coq-8.20.0/test-suite/misc/tc_declaration_observer/_CoqProject000066400000000000000000000001421466560755400244600ustar00rootroot00000000000000 -R . observer -I . observer_plugin.mlpack observer.ml -generate-meta-for-package observer main.v coq-8.20.0/test-suite/misc/tc_declaration_observer/main.out.reference000066400000000000000000000001351466560755400257410ustar00rootroot00000000000000NewClass Def NewInstance def_nat NewInstance def_bool 33 NewInstance def_bool2 21 local coq-8.20.0/test-suite/misc/tc_declaration_observer/main.v000066400000000000000000000004231466560755400234420ustar00rootroot00000000000000Declare ML Module "observer.plugin". Class Def (A : Type) := { default : A }. Instance def_nat : Def nat := {| default := 0 |}. Instance def_bool : Def bool | 33 := {| default := false |}. Section X. Instance def_bool2 : Def bool | 21 := {| default := false |}. End X. coq-8.20.0/test-suite/misc/tc_declaration_observer/observer.ml000066400000000000000000000012021466560755400245040ustar00rootroot00000000000000 let o = open_out "main.out" let observe x = let open Classes in let open Event in let open Typeclasses in let open Hints in let p = Pp.string_of_ppcmds in match x with | NewClass { cl_impl } -> Printf.fprintf o "NewClass %s\n" (p (Printer.pr_global cl_impl)) | NewInstance { instance ; info = { hint_priority }; locality } -> Printf.fprintf o "NewInstance %s %s %s\n" (p (Printer.pr_global instance)) (p (Pp.pr_opt Pp.int hint_priority)) (if locality = Local then "local" else "") let obs = Classes.register_observer ~name:"test observer" observe let () = Classes.activate_observer obs coq-8.20.0/test-suite/misc/tc_declaration_observer/observer_plugin.mlpack000066400000000000000000000000111466560755400267160ustar00rootroot00000000000000Observer coq-8.20.0/test-suite/misc/universes.sh000077500000000000000000000007111466560755400200270ustar00rootroot00000000000000#!/bin/sh # Sort universes for the whole standard library EXPECTED_UNIVERSES=4 # Prop is not counted $coqc -R misc/universes Universes misc/universes/all_stdlib 2>&1 $coqc -R misc/universes Universes misc/universes/universes 2>&1 mv universes.txt misc/universes N=$(awk '{print $3}' misc/universes/universes.txt | sort -u | wc -l) printf "Found %s/%s universes\n" "$N" "$EXPECTED_UNIVERSES" if [ "$N" -eq $EXPECTED_UNIVERSES ]; then exit 0; else exit 1; fi coq-8.20.0/test-suite/misc/universes/000077500000000000000000000000001466560755400174715ustar00rootroot00000000000000coq-8.20.0/test-suite/misc/universes/build_all_stdlib.sh000077500000000000000000000003101466560755400233120ustar00rootroot00000000000000#!/usr/bin/env bash echo "Require $(find ../../../theories ../../../plugins -type f -name "*.v" | \ sed 's/^.*\/theories\///' | sed 's/^.*\/plugins\///' | sed 's/\.v$//' | sed 's/\//./g') ." coq-8.20.0/test-suite/misc/universes/dune000066400000000000000000000003421466560755400203460ustar00rootroot00000000000000(rule (targets all_stdlib.v) (mode fallback) (deps build_all_stdlib.sh (source_tree ../../../theories) (source_tree ../../../plugins)) (action (with-stdout-to all_stdlib.v (bash "./build_all_stdlib.sh")))) coq-8.20.0/test-suite/misc/universes/universes.v000066400000000000000000000000741466560755400217040ustar00rootroot00000000000000Require all_stdlib. Print Sorted Universes "universes.txt". coq-8.20.0/test-suite/misc/votour.sh000077500000000000000000000001761466560755400173470ustar00rootroot00000000000000command -v "${BIN}votour" || { echo "Missing votour"; exit 1; } "${BIN}votour" prerequisite/ssr_mini_mathcomp.vo < /dev/null coq-8.20.0/test-suite/modules/000077500000000000000000000000001466560755400161635ustar00rootroot00000000000000coq-8.20.0/test-suite/modules/Demo.v000066400000000000000000000011501466560755400172330ustar00rootroot00000000000000Module M. Definition t := nat. Definition x := 0. End M. Print M.t. Module Type SIG. Parameter t : Set. Parameter x : t. End SIG. Module F (X: SIG). Definition t := X.t -> X.t. Definition x : t. intro. exact X.x. Defined. Definition y := X.x. End F. Module N := F M. Print N.t. Eval compute in N.t. Module N' : SIG := N. Print N'.t. Eval compute in N'.t. Module N'' <: SIG := F N. Print N''.t. Eval compute in N''.t. Eval compute in N''.x. Module N''' : SIG with Definition t := nat -> nat := N. Print N'''.t. Eval compute in N'''.t. Print N'''.x. Import N'''. Print t. coq-8.20.0/test-suite/modules/Nat.v000066400000000000000000000005171466560755400170770ustar00rootroot00000000000000Definition T := nat. Definition le := le. #[global] Hint Unfold le : core. Lemma le_refl : forall n : nat, le n n. auto. Qed. Require Import Arith. Lemma le_trans : forall n m k : nat, le n m -> le m k -> le n k. eauto with arith. Qed. Lemma le_antis : forall n m : nat, le n m -> le m n -> n = m. eauto with arith. Qed. coq-8.20.0/test-suite/modules/PO.v000066400000000000000000000021601466560755400166670ustar00rootroot00000000000000Set Implicit Arguments. Unset Strict Implicit. Arguments fst : default implicits. Arguments snd : default implicits. Module Type PO. Parameter T : Set. Parameter le : T -> T -> Prop. Axiom le_refl : forall x : T, le x x. Axiom le_trans : forall x y z : T, le x y -> le y z -> le x z. Axiom le_antis : forall x y : T, le x y -> le y x -> x = y. #[global] Hint Resolve le_refl le_trans le_antis. End PO. Module Pair (X: PO) (Y: PO) <: PO. Definition T := (X.T * Y.T)%type. Definition le p1 p2 := X.le (fst p1) (fst p2) /\ Y.le (snd p1) (snd p2). #[global] Hint Unfold le. Lemma le_refl : forall p : T, le p p. auto. Qed. Lemma le_trans : forall p1 p2 p3 : T, le p1 p2 -> le p2 p3 -> le p1 p3. unfold le; intuition; eauto. Qed. Lemma le_antis : forall p1 p2 : T, le p1 p2 -> le p2 p1 -> p1 = p2. destruct p1. destruct p2. unfold le. intuition. enough (t = t1) as ->. enough (t0 = t2) as ->. reflexivity. auto. auto. Qed. End Pair. Require Nat. Module NN := Pair Nat Nat. Lemma zz_min : forall p : NN.T, NN.le (0, 0) p. auto with arith. Qed. coq-8.20.0/test-suite/modules/Przyklad.v000066400000000000000000000073511466560755400201600ustar00rootroot00000000000000Definition ifte (T : Set) (A B : Prop) (s : {A} + {B}) (th el : T) := if s then th else el. Arguments ifte : default implicits. Lemma Reflexivity_provable : forall (A : Set) (a : A) (s : {a = a} + {a <> a}), exists x : _, s = left _ x. intros. elim s. intro x. split with x; reflexivity. intro. absurd (a = a); auto. Qed. Lemma Disequality_provable : forall (A : Set) (a b : A), a <> b -> forall s : {a = b} + {a <> b}, exists x : _, s = right _ x. intros. elim s. intro. absurd (a = a); auto. intro. split with b0; reflexivity. Qed. Module Type ELEM. Parameter T : Set. Parameter eq_dec : forall a a' : T, {a = a'} + {a <> a'}. End ELEM. Module Type SET (Elt: ELEM). Parameter T : Set. Parameter empty : T. Parameter add : Elt.T -> T -> T. Parameter find : Elt.T -> T -> bool. (* Axioms *) Axiom find_empty_false : forall e : Elt.T, find e empty = false. Axiom find_add_true : forall (s : T) (e : Elt.T), find e (add e s) = true. Axiom find_add_false : forall (s : T) (e e' : Elt.T), e <> e' -> find e (add e' s) = find e s. End SET. Module FuncDict (E: ELEM). Definition T := E.T -> bool. Definition empty (e' : E.T) := false. Definition find (e' : E.T) (s : T) := s e'. Definition add (e : E.T) (s : T) (e' : E.T) := ifte (E.eq_dec e e') true (find e' s). Lemma find_empty_false : forall e : E.T, find e empty = false. auto. Qed. Lemma find_add_true : forall (s : T) (e : E.T), find e (add e s) = true. intros. unfold find, add. elim (Reflexivity_provable _ _ (E.eq_dec e e)). intros. rewrite H. auto. Qed. Lemma find_add_false : forall (s : T) (e e' : E.T), e <> e' -> find e (add e' s) = find e s. intros. unfold add, find. cut (exists x : _, E.eq_dec e' e = right _ x). intros. elim H0. intros. rewrite H1. unfold ifte. reflexivity. apply Disequality_provable. auto. Qed. End FuncDict. Module F : SET := FuncDict. Module Nat. Definition T := nat. Lemma eq_dec : forall a a' : T, {a = a'} + {a <> a'}. decide equality. Qed. End Nat. Module SetNat := F Nat. Lemma no_zero_in_empty : SetNat.find 0 SetNat.empty = false. apply SetNat.find_empty_false. Qed. (***************************************************************************) Module Lemmas (G: SET) (E: ELEM). Module ESet := G E. Lemma commute : forall (S : ESet.T) (a1 a2 : E.T), let S1 := ESet.add a1 (ESet.add a2 S) in let S2 := ESet.add a2 (ESet.add a1 S) in forall a : E.T, ESet.find a S1 = ESet.find a S2. intros. unfold S1, S2. elim (E.eq_dec a a1); elim (E.eq_dec a a2); intros H1 H2; try rewrite <- H1; try rewrite <- H2; repeat (try ( rewrite ESet.find_add_true; auto); try ( rewrite ESet.find_add_false; auto); auto). Qed. End Lemmas. Inductive list (A : Set) : Set := | nil : list A | cons : A -> list A -> list A. Module ListDict (E: ELEM). Definition T := list E.T. Definition elt := E.T. Definition empty := nil elt. Definition add (e : elt) (s : T) := cons elt e s. Fixpoint find (e : elt) (s : T) {struct s} : bool := match s with | nil _ => false | cons _ e' s' => ifte (E.eq_dec e e') true (find e s') end. Definition find_empty_false (e : elt) := refl_equal false. Lemma find_add_true : forall (s : T) (e : E.T), find e (add e s) = true. intros. simpl. elim (Reflexivity_provable _ _ (E.eq_dec e e)). intros. rewrite H. auto. Qed. Lemma find_add_false : forall (s : T) (e e' : E.T), e <> e' -> find e (add e' s) = find e s. intros. simpl. elim (Disequality_provable _ _ _ H (E.eq_dec e e')). intros. rewrite H0. simpl. reflexivity. Qed. End ListDict. Module L : SET := ListDict. coq-8.20.0/test-suite/modules/SeveralWith.v000066400000000000000000000003351466560755400206100ustar00rootroot00000000000000Module Type S. Parameter A : Type. End S. Module Type ES. Parameter A : Type. Parameter eq : A -> A -> Type. End ES. Module Make (AX : S) (X : ES with Definition A := AX.A with Definition eq := @eq AX.A). End Make. coq-8.20.0/test-suite/modules/Tescik.v000066400000000000000000000010701466560755400175720ustar00rootroot00000000000000 Module Type ELEM. Parameter A : Set. Parameter x : A. End ELEM. Module Nat. Definition A := nat. Definition x := 0. End Nat. Module List (X: ELEM). Inductive list : Set := | nil : list | cons : X.A -> list -> list. Definition head (l : list) := match l with | nil => X.x | cons x _ => x end. Definition singl (x : X.A) := cons x nil. Lemma head_singl : forall x : X.A, head (singl x) = x. auto. Qed. End List. Module N := List Nat. coq-8.20.0/test-suite/modules/WithDefUBinders.v000066400000000000000000000007141466560755400213420ustar00rootroot00000000000000 Set Universe Polymorphism. Module Type T. Axiom foo@{u v|u < v} : Type@{v}. End T. Module M : T with Definition foo@{u v} := Type@{u} : Type@{v}. Definition foo@{u v} := Type@{u} : Type@{v}. End M. Fail Module M' : T with Definition foo := Type. (* Without the binder expression we have to do trickery to get the universes in the right order. *) Module M' : T with Definition foo := let t := Type in t. Definition foo := let t := Type in t. End M'. coq-8.20.0/test-suite/modules/cumpoly.v000066400000000000000000000011461466560755400200440ustar00rootroot00000000000000Set Universe Polymorphism. (** Check that variance subtyping is respected. The signature T is asking for invariance, while M provide an irrelevant implementation, which is deemed legit. There is currently no way to go the other way around, so it's not possible to generate a counter-example that should fail with the wrong subtyping. *) Module Type T. Parameter t@{i|Set <= i} : Type@{i}. Cumulative Inductive I@{i|Set <= i} : Type@{i} := C : t@{i} -> I. End T. Module M : T. Definition t@{i|Set <= i} : Type@{i} := nat. Cumulative Inductive I@{i|Set <= i} : Type@{i} := C : t@{i} -> I. End M. coq-8.20.0/test-suite/modules/errors.v000066400000000000000000000064471466560755400177010ustar00rootroot00000000000000(* coq-prog-args: ("-impredicative-set") *) (* Inductive mismatches *) Module Type SA. Inductive TA : nat -> Prop := CA : nat -> TA 0. End SA. Module MA : SA. Inductive TA : Prop := CA : bool -> TA. Fail End MA. Reset Initial. Module Type SA0. Inductive TA0 := CA0 : nat -> TA0. End SA0. Module MA0 : SA0. Inductive TA0 := CA0 : bool -> TA0. Fail End MA0. Reset Initial. Module Type SA1. Inductive TA1 := CA1 : nat -> TA1. End SA1. Module MA1 : SA1. Inductive TA1 := CA1 : bool -> nat -> TA1. Fail End MA1. Reset Initial. Module Type SA2. Inductive TA2 := CA2 : nat -> TA2. End SA2. Module MA2 : SA2. Inductive TA2 := CA2 : nat -> TA2 | DA2 : TA2. Fail End MA2. Reset Initial. Module Type SA3. Inductive TA3 := CA3 : nat -> TA3. End SA3. Module MA3 : SA3. Inductive TA3 := CA3 : nat -> TA3 with UA3 := DA3. Fail End MA3. Reset Initial. Module Type SA4. Inductive TA4 := CA4 : nat -> TA4 with UA4 := DA4. End SA4. Module MA4 : SA4. Inductive TA4 := CA4 : nat -> TA4 with VA4 := DA4. Fail End MA4. Reset Initial. Module Type SA5. Inductive TA5 := CA5 : nat -> TA5 with UA5 := DA5. End SA5. Module MA5 : SA5. Inductive TA5 := CA5 : nat -> TA5 with UA5 := EA5. Fail End MA5. Reset Initial. Module Type SA6. Inductive TA6 (A:Type) := CA6 : A -> TA6 A. End SA6. Module MA6 : SA6. Inductive TA6 (A B:Type):= CA6 : A -> TA6 A B. Fail End MA6. Reset Initial. Module Type SA7. Inductive TA7 (A:Type) := CA7 : A -> TA7 A. End SA7. Module MA7 : SA7. CoInductive TA7 (A:Type):= CA7 : A -> TA7 A. Fail End MA7. Reset Initial. Module Type SA8. CoInductive TA8 (A:Type) := CA8 : A -> TA8 A. End SA8. Module MA8 : SA8. Inductive TA8 (A:Type):= CA8 : A -> TA8 A. Fail End MA8. Reset Initial. Module Type SA9. Record TA9 (A:Type) := { CA9 : A }. End SA9. Module MA9 : SA9. Inductive TA9 (A:Type):= CA9 : A -> TA9 A. Fail End MA9. Reset Initial. Module Type SA10. Inductive TA10 (A:Type) := CA10 : A -> TA10 A. End SA10. Module MA10 : SA10. Record TA10 (A:Type):= { CA10 : A }. Fail End MA10. Reset Initial. Module Type SA11. Record TA11 (A:Type):= { CA11 : A }. End SA11. Module MA11 : SA11. Record TA11 (A:Type):= { DA11 : A }. Fail End MA11. Reset Initial. (* Basic mismatches *) Module Type SB. Inductive TB := CB : nat -> TB. End SB. Module MB : SB. Module Type TB. End TB. Fail End MB. Inductive TB := CB : nat -> TB. End MB. Module Type SC. Module Type TC. End TC. End SC. Module MC : SC. Inductive TC := CC : nat -> TC. Fail End MC. Reset Initial. Module Type SD. Module TD. End TD. End SD. Module MD : SD. Inductive TD := DD : nat -> TD. Fail End MD. Reset Initial. Module Type SE. Definition DE := nat. End SE. Module ME : SE. Definition DE := bool. Fail End ME. Reset Initial. Module Type SF. Parameter DF : nat. End SF. Module MF : SF. Definition DF := bool. Fail End MF. Reset Initial. (* Needs a type constraint in module type *) Module Type SG. Definition DG := Type. End SG. Module MG : SG. Definition DG := Type : Type. Fail End MG. Reset Initial. (* Should work *) Module Type SA70. Inductive TA70 (A:Type) := CA70 : A -> TA70 A. End SA70. Module MA70 : SA70. Inductive TA70 (B:Type):= CA70 : B -> TA70 B. End MA70. Module Type SA12. Record TA12 (B:Type):= { CA12 : B }. End SA12. Module MA12 : SA12. Record TA12 (A:Type):= { CA12 : A }. End MA12. Module Type SH. Parameter DH : Type. End SH. Module MH : SH. Definition DH := Type : Type. End MH. coq-8.20.0/test-suite/modules/fun_objects.v000066400000000000000000000007341466560755400206570ustar00rootroot00000000000000(* coq-prog-args: ("-impredicative-set") *) Set Implicit Arguments. Unset Strict Implicit. Module Type SIG. Parameter id : forall A : Set, A -> A. End SIG. Module M (X: SIG). Definition idid := X.id X.id. Definition id := idid X.id. End M. Module N := M. Module Nat. Definition T := nat. Definition x := 0. Definition id (A : Set) (x : A) := x. End Nat. Module Z := N Nat. Check (Z.idid 0). Module P (Y: SIG) := N. Module Y := P Nat Z. Check (Y.id 0). coq-8.20.0/test-suite/modules/grammar.v000066400000000000000000000003571466560755400200050ustar00rootroot00000000000000Module N. Definition f := plus. (* : Syntax is discontinued *) Check (f 0 0). End N. Check (N.f 0 0). Import N. Check (f 0 0). Check (f 0 0). Module M := N. Check (f 0 0). Check (f 0 0). Import M. Check (f 0 0). Check (N.f 0 0). coq-8.20.0/test-suite/modules/include_module_type.v000066400000000000000000000004151466560755400224030ustar00rootroot00000000000000Module Type type1. Parameter A : Prop. End type1. Module Type type2. Parameter B : Prop. End type2. Module Type type3 := type1 <+ type2 with Definition B := True. Print type3. Module Type type3''. Include type1 <+ type2 with Definition B := True. End type3''. coq-8.20.0/test-suite/modules/ind.v000066400000000000000000000024521466560755400171270ustar00rootroot00000000000000Module Type SIG. Inductive w : Set := A : w. Parameter f : w -> w. End SIG. Module M : SIG. Inductive w : Set := A : w. Definition f x := match x with | A => A end. End M. Module N := M. Check (N.f M.A). (* Check use of equivalence on inductive types (bug #1242) *) Module Type ASIG. Inductive t : Set := a | b : t. Definition f := fun x => match x with a => true | b => false end. End ASIG. Module Type BSIG. Declare Module A : ASIG. Definition f := fun x => match x with A.a => true | A.b => false end. End BSIG. Module C (A : ASIG) (B : BSIG with Module A:=A). (* Check equivalence is considered in "case_info" *) Lemma test : forall x, A.f x = B.f x. intro x. unfold B.f, A.f. destruct x; reflexivity. Qed. (* Check equivalence is considered in pattern-matching *) Definition f (x : A.t) := match x with B.A.a => true | B.A.b => false end. End C. (* Check subtyping of the context of parameters of the inductive types *) (* Only the number of expected uniform parameters and the convertibility *) (* of the inductive arities and constructors types are checked *) Module Type S. Inductive I (x:=0) (y:nat): Set := c: x=y -> I y. End S. Module P : S. Inductive I (y':nat) (z:=y'): Set := c : 0=y' -> I y'. End P. coq-8.20.0/test-suite/modules/injection_discriminate_inversion.v000066400000000000000000000011431466560755400251620ustar00rootroot00000000000000Module M. Inductive I : Set := C : nat -> I. End M. Module M1 := M. Goal forall x, M.C x = M1.C 0 -> x = 0 . intros x H. (* injection sur deux constructeurs egaux mais appeles par des modules differents *) injection H. tauto. Qed. Goal M.C 0 <> M1.C 1. (* Discriminate sur deux constructeurs egaux mais appeles par des modules differents *) intro H;discriminate H. Qed. Goal forall x, M.C x = M1.C 0 -> x = 0. intros x H. (* inversion sur deux constructeurs egaux mais appeles par des modules differents *) inversion H. reflexivity. Qed. coq-8.20.0/test-suite/modules/inlining.v000066400000000000000000000051571466560755400201710ustar00rootroot00000000000000Module Type T. Parameter Inline(50) t : Type. End T. Module Type F (X : T). Parameter p : X.t. End F. Module M. Definition t := nat. End M. Set Inline Level 49. Module G (X : F M [inline at level 49]) (Y : F M [inline at level 50]) (Z : F M) : F M [inline at level 50]. (* M.t should not be inlined in the type of X.p, because 49 < 50 *) Goal X.p = X.p. match goal with |- _ = _ :> M.t => idtac | _ => fail end. Fail match goal with |- _ = _ :> nat => idtac | _ => fail end. Abort. (* M.t should be inlined in the type of Y.p, because 50 >= 50 *) Goal Y.p = Y.p. Fail match goal with |- _ = _ :> M.t => idtac | _ => fail end. match goal with |- _ = _ :> nat => idtac | _ => fail end. Abort. (* M.t should not be inlined in the type of Z.p, because default level < 50 *) Goal Z.p = Z.p. match goal with |- _ = _ :> M.t => idtac | _ => fail end. Fail match goal with |- _ = _ :> nat => idtac | _ => fail end. Abort. Definition p := X.p. End G. Module N. Definition p := 0. End N. Module P := G N N N. (* M.t should be inlined in the type of P.p, because 50 >= 50 *) Goal P.p = P.p. Fail match goal with |- _ = _ :> M.t => idtac | _ => fail end. match goal with |- _ = _ :> nat => idtac | _ => fail end. Abort. Set Inline Level 50. Module G' (X : F M [inline at level 49]) (Y : F M [inline at level 50]) (Z : F M) : F M [inline at level 49]. (* M.t should be inlined in the type of Z.p, because default level >= 50 *) Goal Z.p = Z.p. Fail match goal with |- _ = _ :> M.t => idtac | _ => fail end. match goal with |- _ = _ :> nat => idtac | _ => fail end. Abort. Definition p := X.p. End G'. Module P' := G' N N N. (* M.t should not be inlined in the type of P'.p, because 49 < 50 *) Goal P'.p = P'.p. match goal with |- _ = _ :> M.t => idtac | _ => fail end. Fail match goal with |- _ = _ :> nat => idtac | _ => fail end. Abort. Set Inline Level 50. Module G'' (X : F M [inline at level 49]) (Y : F M [inline at level 50]) (Z : F M) : F M. Definition p := X.p. End G''. Module P'' := G'' N N N. (* M.t should not be inlined in the type of P''.p, because default level >= 50 *) Goal P''.p = P''.p. Fail match goal with |- _ = _ :> M.t => idtac | _ => fail end. match goal with |- _ = _ :> nat => idtac | _ => fail end. Abort. Set Inline Level 49. Module G''' (X : F M [inline at level 49]) (Y : F M [inline at level 50]) (Z : F M) : F M. Definition p := X.p. End G'''. Module P''' := G''' N N N. (* M.t should not be inlined in the type of P'.p, because default level < 50 *) Goal P'''.p = P'''.p. match goal with |- _ = _ :> M.t => idtac | _ => fail end. Fail match goal with |- _ = _ :> nat => idtac | _ => fail end. Abort. coq-8.20.0/test-suite/modules/mod_decl.v000066400000000000000000000010371466560755400201210ustar00rootroot00000000000000Module Type SIG. Axiom A : Set. End SIG. Module M0. Definition A : Set. exact nat. Qed. End M0. Module M1 : SIG. Definition A := nat. End M1. Module M2 <: SIG. Definition A := nat. End M2. Module M3 := M0. Module M4 : SIG := M0. Module M5 <: SIG := M0. Module F (X: SIG) := X. Module Type T. Module M0. Axiom A : Set. End M0. Declare Module M1: SIG. Module M2 <: SIG. Definition A := nat. End M2. Module M3 := M0. Module M4 : SIG := M0. Module M5 <: SIG := M0. Module M6 := F M0. End T. coq-8.20.0/test-suite/modules/modeq.v000066400000000000000000000005541466560755400174630ustar00rootroot00000000000000(* coq-prog-args: ("-top" "modeq") *) Module M. Definition T := nat. Definition x : T := 0. End M. Module Type SIG. Module M := modeq.M. Module Type SIG. Parameter T : Set. End SIG. Declare Module N: SIG. End SIG. Module Z. Module M := modeq.M. Module Type SIG. Parameter T : Set. End SIG. Module N := M. End Z. Module A : SIG := Z. coq-8.20.0/test-suite/modules/modul.v000066400000000000000000000006741466560755400175010ustar00rootroot00000000000000(* coq-prog-args: ("-top" "modul") *) Module M. Parameter rel : nat -> nat -> Prop. Axiom w : forall n : nat, rel 0 (S n). #[export] Hint Resolve w. (* : Grammar is replaced by Notation *) Print Hint *. Lemma w1 : rel 0 1. auto. Qed. End M. Locate Module M. (*Lemma w1 : (M.rel O (S O)). Auto. *) Import M. Lemma w1 : rel 0 1. auto. Qed. Check (rel 0 0). Locate rel. Locate Module M. Module N := modul.M. coq-8.20.0/test-suite/modules/nested_mod_types.v000066400000000000000000000006561466560755400217260ustar00rootroot00000000000000Module Type T. Module Type U. Module Type V. #[local] Parameter b : nat. End V. #[local] Parameter a : nat. End U. Declare Module u : U. Declare Module v : u.V. End T. Module F (t:T). End F. Module M:T. Module Type U. Module Type V. #[local] Parameter b : nat. End V. #[local] Parameter a : nat. End U. Declare Module u : U. Declare Module v : u.V. End M. Module FM := F M. coq-8.20.0/test-suite/modules/obj.v000066400000000000000000000006021466560755400171220ustar00rootroot00000000000000Set Implicit Arguments. Unset Strict Implicit. Module M. Definition a (s : Set) := s. Print a. End M. Print M.a. Module K. Definition app (A B : Set) (f : A -> B) (x : A) := f x. Module N. Definition apap (A B : Set) := app (app (A:=A) (B:=B)). Print app. Print apap. End N. Print N.apap. End K. Print K.app. Print K.N.apap. Module W := K.N. Print W.apap. coq-8.20.0/test-suite/modules/objects.v000066400000000000000000000006221466560755400200030ustar00rootroot00000000000000Module Type SET. Axiom T : Set. Axiom x : T. End SET. Set Implicit Arguments. Unset Strict Implicit. Module M (X: SET). Definition T := nat. Definition x := 0. Definition f (A : Set) (x : A) := X.x. End M. Module N := M. Module Nat. Definition T := nat. Definition x := 0. End Nat. Module Z := N Nat. Check (Z.f 0). Module P (Y: SET) := N. Module Y := P Z Nat. Check (Y.f 0). coq-8.20.0/test-suite/modules/objects2.v000066400000000000000000000006001466560755400200610ustar00rootroot00000000000000(* Check that non logical object loading is done after registration of the logical objects in the environment *) (* BZ#1118 (simplified version), submitted by Evelyne Contejean (used to failed in pre-V8.1 trunk because of a call to lookup_mind for structure objects) *) Module Type S. Record t : Set := { a : nat; b : nat }. End S. Module Make (X:S). Module Y:=X. End Make. coq-8.20.0/test-suite/modules/pliczek.v000066400000000000000000000000731466560755400200130ustar00rootroot00000000000000Require Export plik. Definition tutu (X : Set) := toto X. coq-8.20.0/test-suite/modules/plik.v000066400000000000000000000001231466560755400173050ustar00rootroot00000000000000Definition toto (x : Set) := x. (* : Grammar is replaced by Notation *) coq-8.20.0/test-suite/modules/polymorphism.v000066400000000000000000000020431466560755400211130ustar00rootroot00000000000000Set Universe Polymorphism. (** Tests for module subtyping of polymorphic terms *) Module Type S. Section Foo. Universes i j. Constraint i <= j. Parameter foo : Type@{i} -> Type@{j}. End Foo. End S. (** Same constraints *) Module OK_1. Definition foo@{i j} (A : Type@{i}) : Type@{j} := A. End OK_1. Module OK_1_Test : S := OK_1. (** More general constraints *) Module OK_2. Inductive X@{i} : Type@{i} :=. Definition foo@{i j} (A : Type@{i}) : Type@{j} := X@{j}. End OK_2. Module OK_2_Test : S := OK_2. (** Wrong instance length *) Module KO_1. Definition foo@{i} (A : Type@{i}) : Type@{i} := A. End KO_1. Fail Module KO_Test_1 : S := KO_1. (** Less general constraints *) Module KO_2. Section Foo. Universe i j. Constraint i < j. Definition foo (A : Type@{i}) : Type@{j} := A. End Foo. End KO_2. Fail Module KO_Test_2 : S := KO_2. (** Less general constraints *) Module KO_3. Section Foo. Universe i j. Constraint i = j. Definition foo (A : Type@{i}) : Type@{j} := A. End Foo. End KO_3. Fail Module KO_Test_3 : S := KO_3. coq-8.20.0/test-suite/modules/polymorphism2.v000066400000000000000000000020321466560755400211730ustar00rootroot00000000000000Set Universe Polymorphism. (** Tests for module subtyping of polymorphic terms *) Module Type S. Section Foo. Universes i j. Constraint i <= j. Inductive foo : Type@{i} -> Type@{j} :=. End Foo. End S. (** Same constraints *) Module OK_1. Section Foo. Universes i j. Constraint i <= j. Inductive foo : Type@{i} -> Type@{j} :=. End Foo. End OK_1. Module OK_1_Test : S := OK_1. (** More general constraints *) Module OK_2. Inductive foo@{i j} : Type@{i} -> Type@{j} :=. End OK_2. Module OK_2_Test : S := OK_2. (** Wrong instance length *) Module KO_1. Inductive foo@{i} : Type@{i} -> Type@{i} :=. End KO_1. Fail Module KO_Test_1 : S := KO_1. (** Less general constraints *) Module KO_2. Section Foo. Universe i j. Constraint i < j. Inductive foo : Type@{i} -> Type@{j} :=. End Foo. End KO_2. Fail Module KO_Test_2 : S := KO_2. (** Less general constraints *) Module KO_3. Section Foo. Universe i j. Constraint i = j. Inductive foo : Type@{i} -> Type@{j} :=. End Foo. End KO_3. Fail Module KO_Test_3 : S := KO_3. coq-8.20.0/test-suite/modules/pseudo_circular_with.v000066400000000000000000000002341466560755400225670ustar00rootroot00000000000000Module Type S. End S. Module Type T. Declare Module M:S. End T. Module N:S. End N. Module NN:T. Module M:=N. End NN. Module Type U := T with Module M:=NN. coq-8.20.0/test-suite/modules/resolver.v000066400000000000000000000007221466560755400202140ustar00rootroot00000000000000Module Type TA. Parameter t : Set. End TA. Module Type TB. Declare Module A: TA. End TB. Module Type TC. Declare Module B : TB. End TC. Module Type TD. Declare Module B: TB . Declare Module C: TC with Module B := B . End TD. Module Type TE. Declare Module D : TD. End TE. Module Type TF. Declare Module E: TE. End TF. Module G (D: TD). Module B' := D.C.B. End G. Module H (F: TF). Module I := G(F.E.D). End H. Declare Module F: TF. Module K := H(F). coq-8.20.0/test-suite/modules/sig.v000066400000000000000000000006571466560755400171440ustar00rootroot00000000000000Module M. Module Type SIG. Parameter T : Set. Parameter x : T. End SIG. Module N : SIG. Definition T := nat. Definition x := 0. End N. End M. Module N := M. Module Type SPRYT. Module N. Definition T := M.N.T. Parameter x : T. End N. End SPRYT. Module K : SPRYT := N. Module K' : SPRYT := M. Module Type SIG. Definition T : Set := M.N.T. Parameter x : T. End SIG. Module J : SIG := M.N. coq-8.20.0/test-suite/modules/sub_objects.v000066400000000000000000000011301466560755400206470ustar00rootroot00000000000000Set Implicit Arguments. Unset Strict Implicit. Module M. Definition id (A : Set) (x : A) := x. Module Type SIG. Parameter idid : forall A : Set, A -> A. End SIG. Module N. Definition idid (A : Set) (x : A) := id x. (* : Grammar is replaced by Notation *) Notation inc := (plus 1). End N. Definition zero := N.idid 0. End M. Definition zero := M.N.idid 0. Definition jeden := M.N.inc 0. Module Goly := M.N. Definition Gole_zero := Goly.idid 0. Definition Goly_jeden := Goly.inc 0. Module Ubrany : M.SIG := M.N. Definition Ubrane_zero := Ubrany.idid 0. coq-8.20.0/test-suite/modules/subtyping.v000066400000000000000000000025351466560755400204030ustar00rootroot00000000000000(* Non regression for bug #1302 *) (* With universe polymorphism for inductive types, subtyping of inductive types needs a special treatment: the standard conversion algorithm does not work as it only knows to deal with constraints of the form alpha = beta or max(alphas, alphas+1) <= beta, while subtyping of inductive types in Type generates constraints of the form max(alphas, alphas+1) <= max(betas, betas+1). These constraints are anyway valid by monotonicity of subtyping but we have to detect it early enough to avoid breaking the standard algorithm for constraints on algebraic universes. *) Module Type T. Parameter A : Type (* Top.1 *) . Inductive L : Type (* max(Top.1,1) *) := | L0 | L1 : (A -> Prop) -> L. End T. Axiom Tp : Type (* Top.5 *) . Module TT : T. Definition A : Type (* Top.6 *) := Tp. (* generates Top.5 <= Top.6 *) Inductive L : Type (* max(Top.6,1) *) := | L0 | L1 : (A -> Prop) -> L. End TT. (* Generates Top.6 <= Top.1 (+ auxiliary constraints for L_rect) *) (* Note: Top.6 <= Top.1 is generated by subtyping on A; subtyping of L follows and has not to be checked *) (* The same bug as #1302 but for Definition *) (* Check that inferred algebraic universes in interfaces are considered *) Module Type U. Definition A := Type -> Type. End U. Module M:U. Definition A := Type -> Type. End M. coq-8.20.0/test-suite/ocaml_pwd.ml000066400000000000000000000012211466560755400170060ustar00rootroot00000000000000open Arg let quoted = ref false let trailing_slash = ref false let arguments = [ "-quoted",Set quoted, "Quote path"; "-trailing-slash",Set trailing_slash, "End the path with a /"; ] let subject = ref None let set_subject x = if !subject <> None then failwith "only one path"; subject := Some x let () = Arg.parse arguments set_subject "Usage:"; let subject = match !subject with | None -> failwith "no path given"; | Some x -> x in Sys.chdir subject; let dir = Sys.getcwd () in let dir = if !trailing_slash then dir ^ "/" else dir in let dir = if !quoted then Filename.quote dir else dir in Format.printf "%s%!" dir coq-8.20.0/test-suite/output-coqchk/000077500000000000000000000000001466560755400173215ustar00rootroot00000000000000coq-8.20.0/test-suite/output-coqchk/bug_12845.out000066400000000000000000000004611466560755400213730ustar00rootroot00000000000000 CONTEXT SUMMARY =============== * Theory: Set is predicative * Theory: Rewrite rules are not allowed * Axioms: * Constants/Inductives relying on type-in-type: * Constants/Inductives relying on unsafe (co)fixpoints: * Inductives whose positivity is assumed: coq-8.20.0/test-suite/output-coqchk/bug_12845.v000066400000000000000000000002271466560755400210310ustar00rootroot00000000000000Module Type A. Module B. Axiom t : Set. End B. End A. Module a : A. Module B. Definition t : Set := unit. End B. End a. Check a.B.t. coq-8.20.0/test-suite/output-coqchk/bug_5030.out000066400000000000000000000004611466560755400212770ustar00rootroot00000000000000 CONTEXT SUMMARY =============== * Theory: Set is predicative * Theory: Rewrite rules are not allowed * Axioms: * Constants/Inductives relying on type-in-type: * Constants/Inductives relying on unsafe (co)fixpoints: * Inductives whose positivity is assumed: coq-8.20.0/test-suite/output-coqchk/bug_5030.v000066400000000000000000000002411466560755400207310ustar00rootroot00000000000000Module Type testt. Parameter proof : True. End testt. Module Export test : testt. Definition proof := I. End test. Lemma true : True. Proof. apply proof. Qed. coq-8.20.0/test-suite/output-coqtop/000077500000000000000000000000001466560755400173565ustar00rootroot00000000000000coq-8.20.0/test-suite/output-coqtop/DependentEvars.out000066400000000000000000000027161466560755400230240ustar00rootroot00000000000000 Coq < Coq < Coq < 1 goal ============================ forall P Q R : Prop, (Q -> R) -> (P -> Q) -> (P -> Q) -> P -> R (dependent evars: ; in current goal:) strange_imp_trans < strange_imp_trans < No more goals. (dependent evars: ; in current goal:) strange_imp_trans < Coq < Coq < 1 goal ============================ forall P Q : Prop, (P -> Q) /\ P -> Q (dependent evars: ; in current goal:) modpon < modpon < No more goals. (dependent evars: ; in current goal:) modpon < Coq < Coq < Coq < P1 is declared P2 is declared P3 is declared P4 is declared Coq < p12 is declared Coq < p123 is declared Coq < p34 is declared Coq < Coq < 1 goal P1, P2, P3, P4 : Prop p12 : P1 -> P2 p123 : (P1 -> P2) -> P3 p34 : P3 -> P4 ============================ P4 (dependent evars: ; in current goal:) p14 < p14 < 4 focused goals (shelved: 2) P1, P2, P3, P4 : Prop p12 : P1 -> P2 p123 : (P1 -> P2) -> P3 p34 : P3 -> P4 ============================ ?Q -> P4 goal 2 is: ?P -> ?Q goal 3 is: ?P -> ?Q goal 4 is: ?P (dependent evars: ?X4:?P, ?X5:?Q; in current goal: ?X5) p14 < 3 focused goals (shelved: 2) P1, P2, P3, P4 : Prop p12 : P1 -> P2 p123 : (P1 -> P2) -> P3 p34 : P3 -> P4 ============================ ?P -> (?P0 -> P4) /\ ?P0 goal 2 is: ?P -> (?P0 -> P4) /\ ?P0 goal 3 is: ?P (dependent evars: ?X4:?P, ?X5 using ?X10 ?X11, ?X10 using ?X11, ?X11:?P0; in current goal: ?X4 ?X5 ?X10 ?X11) p14 < Coq < Coq < coq-8.20.0/test-suite/output-coqtop/DependentEvars.v000066400000000000000000000007221466560755400224550ustar00rootroot00000000000000Set Printing Dependent Evars Line. Lemma strange_imp_trans : forall P Q R : Prop, (Q -> R) -> (P -> Q) -> (P -> Q) -> P -> R. Proof. auto. Qed. Lemma modpon : forall P Q : Prop, (P -> Q) /\ P -> Q. Proof. tauto. Qed. Section eex. Variables P1 P2 P3 P4 : Prop. Hypothesis p12 : P1 -> P2. Hypothesis p123 : (P1 -> P2) -> P3. Hypothesis p34 : P3 -> P4. Lemma p14 : P4. Proof. eapply strange_imp_trans. apply modpon. Abort. End eex. coq-8.20.0/test-suite/output-coqtop/DependentEvars2.out000066400000000000000000000037541466560755400231110ustar00rootroot00000000000000 Coq < Coq < Coq < 1 goal ============================ forall P Q R : Prop, (Q -> R) -> (P -> Q) -> (P -> Q) -> P -> R (dependent evars: ; in current goal:) strange_imp_trans < strange_imp_trans < No more goals. (dependent evars: ; in current goal:) strange_imp_trans < Coq < Coq < 1 goal ============================ forall P Q : Prop, (P -> Q) /\ P -> Q (dependent evars: ; in current goal:) modpon < modpon < No more goals. (dependent evars: ; in current goal:) modpon < Coq < Coq < Coq < P1 is declared P2 is declared P3 is declared P4 is declared Coq < p12 is declared Coq < p123 is declared Coq < p34 is declared Coq < Coq < 1 goal P1, P2, P3, P4 : Prop p12 : P1 -> P2 p123 : (P1 -> P2) -> P3 p34 : P3 -> P4 ============================ P4 (dependent evars: ; in current goal:) p14 < p14 < Second proof: p14 < 4 focused goals (shelved: 2) P1, P2, P3, P4 : Prop p12 : P1 -> P2 p123 : (P1 -> P2) -> P3 p34 : P3 -> P4 ============================ ?Q -> P4 goal 2 is: ?P -> ?Q goal 3 is: ?P -> ?Q goal 4 is: ?P (dependent evars: ?X4:?P, ?X5:?Q; in current goal: ?X5) p14 < 1 focused goal (shelved: 2) P1, P2, P3, P4 : Prop p12 : P1 -> P2 p123 : (P1 -> P2) -> P3 p34 : P3 -> P4 ============================ ?Q -> P4 (dependent evars: ?X4:?P, ?X5:?Q; in current goal: ?X5) p14 < This subproof is complete, but there are some unfocused goals. Try unfocusing with "}". 3 goals (shelved: 2) goal 1 is: ?P -> (?P0 -> P4) /\ ?P0 goal 2 is: ?P -> (?P0 -> P4) /\ ?P0 goal 3 is: ?P (dependent evars: ?X4:?P, ?X5 using ?X10 ?X11, ?X10 using ?X11, ?X11:?P0; in current goal:) p14 < 3 focused goals (shelved: 2) P1, P2, P3, P4 : Prop p12 : P1 -> P2 p123 : (P1 -> P2) -> P3 p34 : P3 -> P4 ============================ ?P -> (?P0 -> P4) /\ ?P0 goal 2 is: ?P -> (?P0 -> P4) /\ ?P0 goal 3 is: ?P (dependent evars: ?X4:?P, ?X5 using ?X10 ?X11, ?X10 using ?X11, ?X11:?P0; in current goal: ?X4 ?X5 ?X10 ?X11) p14 < Coq < Coq < coq-8.20.0/test-suite/output-coqtop/DependentEvars2.v000066400000000000000000000010071466560755400225340ustar00rootroot00000000000000Set Printing Dependent Evars Line. Lemma strange_imp_trans : forall P Q R : Prop, (Q -> R) -> (P -> Q) -> (P -> Q) -> P -> R. Proof. auto. Qed. Lemma modpon : forall P Q : Prop, (P -> Q) /\ P -> Q. Proof. tauto. Qed. Section eex. Variables P1 P2 P3 P4 : Prop. Hypothesis p12 : P1 -> P2. Hypothesis p123 : (P1 -> P2) -> P3. Hypothesis p34 : P3 -> P4. Lemma p14 : P4. Proof. idtac "Second proof:". eapply strange_imp_trans. { apply modpon. } Abort. End eex. coq-8.20.0/test-suite/output-coqtop/DependentEvars3.out000066400000000000000000000012461466560755400231040ustar00rootroot00000000000000 Coq < Coq < 1 goal ============================ (exists n : nat, n = 5 \/ True) /\ (exists m : nat, m = 6 \/ True) (dependent evars: ; in current goal:) x < x < 2 goals ============================ exists n : nat, n = 5 \/ True goal 2 is: exists m : nat, m = 6 \/ True (dependent evars: ; in current goal:) x < 2 focused goals (shelved: 1) ============================ ?n = 5 \/ True goal 2 is: exists m : nat, m = 6 \/ True (dependent evars: ?X10:?n; in current goal: ?X10) x < 2 focused goals (shelved: 1) ============================ True goal 2 is: exists m : nat, m = 6 \/ True (dependent evars: ?X10:?n; in current goal:) x < coq-8.20.0/test-suite/output-coqtop/DependentEvars3.v000066400000000000000000000002411466560755400225340ustar00rootroot00000000000000Set Printing Dependent Evars Line. Lemma x : (exists(n : nat), n = 5 \/ True) /\ (exists(m : nat), m = 6 \/ True). Proof using. split. eexists. right. coq-8.20.0/test-suite/output-coqtop/LookaheadErrors.out000066400000000000000000000006341466560755400231760ustar00rootroot00000000000000 Coq < Coq < Coq < Toplevel input, characters 9-11: > Check ## []. > ^^ Error: Syntax error: '##' or [term] expected after '##' (in [term]). Coq < Coq < Setting x constr at next level to match previous notation with longest common prefix: "## _". Coq < Coq < Toplevel input, characters 9-11: > Check ## []. > ^^ Error: Syntax error: '##' or [term] expected after '##' (in [term]). Coq < coq-8.20.0/test-suite/output-coqtop/LookaheadErrors.v000066400000000000000000000002641466560755400226330ustar00rootroot00000000000000Notation "## x" := (S x) (at level 0). Notation "## ##" := 0 (at level 0). Check ## []. Notation "## x" := (S x) (at level 0). Notation "## ## ##" := 0 (at level 0). Check ## []. coq-8.20.0/test-suite/output-coqtop/ShowGoal.out000066400000000000000000000020051466560755400216270ustar00rootroot00000000000000 Coq < 1 goal ============================ forall i : nat, exists j k : nat, i = j /\ j = k /\ i = k x < x < 1 focused goal (shelved: 1) i : nat ============================ exists k : nat, i = ?j /\ ?j = k /\ i = k x < 1 focused goal (shelved: 2) i : nat ============================ i = ?j /\ ?j = ?k /\ i = ?k x < 2 focused goals (shelved: 2) i : nat ============================ i = ?j goal 2 is: ?j = ?k /\ i = ?k x < 1 focused goal (shelved: 1) i : nat ============================ i = ?k /\ i = ?k x < 2 focused goals (shelved: 1) i : nat ============================ i = ?k goal 2 is: i = ?k x < 1 goal i : nat ============================ i = i x < goal ID 13 at state 5 i : nat ============================ i = ?j /\ ?j = ?k /\ i = ?k x < goal ID 13 at state 7 i : nat ============================ i = i /\ i = ?k /\ i = ?k x < goal ID 13 at state 9 i : nat ============================ i = i /\ i = i /\ i = i x < coq-8.20.0/test-suite/output-coqtop/ShowGoal.v000066400000000000000000000003161466560755400212700ustar00rootroot00000000000000Lemma x: forall(i : nat), exists(j k : nat), i = j /\ j = k /\ i = k. Proof using. eexists. eexists. split. trivial. split. trivial. Show Goal 13 at 5. Show Goal 13 at 7. Show Goal 13 at 9. coq-8.20.0/test-suite/output-coqtop/ShowProofDiffs.out000066400000000000000000000045701466560755400230170ustar00rootroot00000000000000 Coq < Coq < 1 goal ============================ forall i : nat, exists j k : nat, i = j /\ j = k /\ i = k x < x < 1 focused goal (shelved: 1) i : nat ============================ exists k : nat, i = ?j /\ ?j = k /\ i = k (fun i : nat => ex_intro (fun j : nat => exists k : nat, i = j /\ j = k /\ i = k) ?j ?Goal) x < 1 focused goal (shelved: 2) i : nat ============================ i = ?j /\ ?j = ?k /\ i = ?k (fun i : nat => ex_intro (fun j : nat => exists k : nat, i = j /\ j = k /\ i = k)  ?j (ex_intro (fun k : nat => i = ?j /\ ?j = k /\ i = k) ?k ?Goal)) x < 2 focused goals (shelved: 2) i : nat ============================ i = ?j goal 2 is: ?j = ?k /\ i = ?k (fun i : nat => ex_intro (fun j : nat => exists k : nat, i = j /\ j = k /\ i = k)  ?j (ex_intro (fun k : nat => i = ?j /\ ?j = k /\ i = k)  ?k (conj ?Goal ?Goal0))) x < coq-8.20.0/test-suite/output-coqtop/ShowProofDiffs.v000066400000000000000000000003361466560755400224510ustar00rootroot00000000000000(* coq-prog-args: ("-color" "on" "-diffs" "on") *) Lemma x: forall(i : nat), exists(j k : nat), i = j /\ j = k /\ i = k. Proof using. eexists. Show Proof Diffs. eexists. Show Proof Diffs. split. Show Proof Diffs. coq-8.20.0/test-suite/output-coqtop/attributes.out000066400000000000000000000023501466560755400222750ustar00rootroot00000000000000 Coq < Toplevel input, characters 17-29: > #[canonical=yes, canonical=no] Definition a := 3. > ^^^^^^^^^^^^ Error: Attribute for canonical specified twice. Coq < Coq < Toplevel input, characters 29-43: > #[universes(polymorphic=yes,polymorphic=no)] Definition a := 3. > ^^^^^^^^^^^^^^ Error: key 'polymorphic' has been already set. Coq < Coq < Toplevel input, characters 13-28: > #[universes(polymorphic=foo)] Definition a := 3. > ^^^^^^^^^^^^^^^ Error: Invalid value 'foo' for key polymorphic use one of {yes, no} Coq < Coq < Toplevel input, characters 13-29: > #[universes(polymorphic(foo))] Definition a := 3. > ^^^^^^^^^^^^^^^^ Error: Invalid syntax polymorphic(foo), try polymorphic={yes, no} instead. Coq < Coq < Toplevel input, characters 13-33: > #[universes(polymorphic(foo,bar))] Definition a := 3. > ^^^^^^^^^^^^^^^^^^^^ Error: Invalid syntax polymorphic(foo, bar), try polymorphic={yes, no} instead. Coq < Coq < Toplevel input, characters 30-37: > #[universes(polymorphic=yes, bla=bla)] Definition a := 3. > ^^^^^^^ Error: This command does not support this attribute: universes. [unsupported-attributes,parsing,default] Coq < coq-8.20.0/test-suite/output-coqtop/attributes.v000066400000000000000000000005121466560755400217310ustar00rootroot00000000000000#[canonical=yes, canonical=no] Definition a := 3. #[universes(polymorphic=yes,polymorphic=no)] Definition a := 3. #[universes(polymorphic=foo)] Definition a := 3. #[universes(polymorphic(foo))] Definition a := 3. #[universes(polymorphic(foo,bar))] Definition a := 3. #[universes(polymorphic=yes, bla=bla)] Definition a := 3. coq-8.20.0/test-suite/output-coqtop/backto.out000066400000000000000000000000511466560755400213460ustar00rootroot00000000000000 Coq < Error: Unknown state 404. Coq < coq-8.20.0/test-suite/output-coqtop/backto.v000066400000000000000000000000141466560755400210030ustar00rootroot00000000000000BackTo 404. coq-8.20.0/test-suite/output-coqtop/bug_12138.out000066400000000000000000000003721466560755400214240ustar00rootroot00000000000000 Coq < Coq < Coq < Toplevel input, characters 0-1: > { > ^ Error: Syntax error: illegal begin of toplevel:vernac_toplevel. Coq < Coq < Coq < Toplevel input, characters 58-59: > } > ^ Error: Syntax error: illegal begin of toplevel:vernac_toplevel. coq-8.20.0/test-suite/output-coqtop/bug_12138.v000066400000000000000000000000771466560755400210640ustar00rootroot00000000000000{ Comments. (* coqtop parsing recovery skips to the dot *) } coq-8.20.0/test-suite/output-coqtop/bug_16462.out000066400000000000000000000011721466560755400214270ustar00rootroot00000000000000 Coq < foo is defined Coq < bar is defined Coq < Coq < Coq < Coq < Coq < Coq < Coq < baz is defined Coq < Coq < 1 goal ============================ True Unnamed_thm < Unnamed_thm_subproof Unnamed_thm_subproof Toplevel input, characters 2-7: > baz I. > ^^^^^ Error: Tactic failure (level 1). In nested Ltac calls to "baz", "f" (bound to fun f x y => idtac v; f x), "f" (bound to fun _ => let v' := v in constr:((fun _ => ltac:((idtac v'; fail 1))))) and "(fun _ => ltac:((idtac v'; fail 1)))" (with x:=I, v':=Unnamed_thm_subproof, v:=Unnamed_thm_subproof, H:=H), last term evaluation failed. Unnamed_thm < coq-8.20.0/test-suite/output-coqtop/bug_16462.v000066400000000000000000000007131466560755400210650ustar00rootroot00000000000000Ltac foo x y := idtac; fail 1. Ltac bar x f := idtac; f foo x I. Ltac baz x := let H := fresh in simple refine (let H : True := _ in _); [ abstract exact I | let v := (eval cbv in H) in let F := ltac:(fun _ => let v' := v in constr:(fun _ => ltac:(idtac v'; fail 1))) in let f := ltac:(fun f x y => idtac v; f x) in f F () () ]. Set Ltac Backtrace. Goal True. baz I. coq-8.20.0/test-suite/output-coqtop/bug_16745.out000066400000000000000000000006401466560755400214320ustar00rootroot00000000000000 Coq < Coq < 1 goal ============================ True Unnamed_thm < Unnamed_thm < Unnamed_thm < Unnamed_thm < Toplevel input, characters 111-112: > | match goal with x := ?v |- _ => exact v end]. > ^ Error: In environment x := Unnamed_thm_subproof : nat The term "Unnamed_thm_subproof" has type "nat" while it is expected to have type "True". Unnamed_thm < coq-8.20.0/test-suite/output-coqtop/bug_16745.v000066400000000000000000000002121466560755400210630ustar00rootroot00000000000000 Goal True. Proof. unshelve refine (let x := _ : nat in _);[ abstract exact 0 | match goal with x := ?v |- _ => exact v end]. coq-8.20.0/test-suite/output-coqtop/ltac2_var_quot.out000066400000000000000000000025511466560755400230370ustar00rootroot00000000000000 Coq < Coq < Toplevel input, characters 7-9: > Check $x. > ^^ Error: Unbound value x Coq < Coq < Toplevel input, characters 16-17: > Check $preterm:x. > ^ Error: Unbound value x Coq < Coq < Toplevel input, characters 7-8: > Check $ x. > ^ Error: Syntax error: [lconstr] expected after 'Check' (in [query_command]). Coq < Coq < Toplevel input, characters 7-8: > Check $ preterm:x. > ^ Error: Syntax error: [lconstr] expected after 'Check' (in [query_command]). Coq < Coq < Toplevel input, characters 7-8: > Check $ preterm : x. > ^ Error: Syntax error: [lconstr] expected after 'Check' (in [query_command]). Coq < Coq < Toplevel input, characters 18-19: > Check $preterm : x. > ^ Error: The reference x was not found in the current environment. Coq < Coq < Toplevel input, characters 16-24: > Check fun x => $preterm : x. > ^^^^^^^^ Error: Unbound value preterm Coq < Coq < Toplevel input, characters 17-18: > Check $preterm: x. > ^ Error: The reference x was not found in the current environment. Coq < Coq < Toplevel input, characters 16-24: > Check fun x => $preterm: x. > ^^^^^^^^ Error: Unbound value preterm Coq < Coq < Toplevel input, characters 7-8: > Check $ preterm :x. > ^ Error: Syntax error: [lconstr] expected after 'Check' (in [query_command]). Coq < coq-8.20.0/test-suite/output-coqtop/ltac2_var_quot.v000066400000000000000000000003511466560755400224710ustar00rootroot00000000000000Require Import Ltac2.Ltac2. Check $x. Check $preterm:x. Check $ x. Check $ preterm:x. Check $ preterm : x. Check $preterm : x. Check fun x => $preterm : x. Check $preterm: x. Check fun x => $preterm: x. Check $ preterm :x. coq-8.20.0/test-suite/output-modulo-time/000077500000000000000000000000001466560755400203045ustar00rootroot00000000000000coq-8.20.0/test-suite/output-modulo-time/abort.out000066400000000000000000000001261466560755400221430ustar00rootroot00000000000000Chars 40 - 50 [Goal~True.] 0. secs (0.u,0.s) Chars 51 - 57 [Abort.] 0. secs (0.u,0.s) coq-8.20.0/test-suite/output-modulo-time/abort.v000066400000000000000000000001071466560755400216000ustar00rootroot00000000000000(* -*- coq-prog-args: ("-time") -*- *) Goal True. Abort. (* #15666 *) coq-8.20.0/test-suite/output-modulo-time/ltacprof.out000066400000000000000000000013341466560755400226500ustar00rootroot00000000000000total time: 0.942s tactic local total calls max ─────────────┴──────┴──────┴───────┴─────────┘ ─sleep' ----- 100.0% 100.0% 1 0.942s ─constructor 0.0% 0.0% 1 0.000s ─sleep ------ 0.0% 0.0% 0 0.000s tactic local total calls max ─────────────┴──────┴──────┴───────┴─────────┘ ─sleep' ----- 100.0% 100.0% 1 0.942s ─constructor 0.0% 0.0% 1 0.000s ─sleep ------ 0.0% 0.0% 0 0.000s └sleep' ----- 0.0% 0.0% 0 0.000s coq-8.20.0/test-suite/output-modulo-time/ltacprof.v000066400000000000000000000003101466560755400222770ustar00rootroot00000000000000(* -*- coq-prog-args: ("-profile-ltac-cutoff" "0.0") -*- *) Ltac sleep' := do 100 (do 100 (do 100 idtac)). Ltac sleep := sleep'. Theorem x : True. Proof. idtac. idtac. sleep. constructor. Defined. coq-8.20.0/test-suite/output-modulo-time/ltacprof_abstract.out000066400000000000000000000021641466560755400245350ustar00rootroot00000000000000total time: 0.986s tactic local total calls max ───────────────────────────────┴──────┴──────┴───────┴─────────┘ ─abstract (sleep; constructor) 0.0% 100.0% 1 0.986s ─sleep' ----------------------- 100.0% 100.0% 1 0.986s ─constructor ------------------ 0.0% 0.0% 1 0.000s ─sleep ------------------------ 0.0% 0.0% 0 0.000s tactic local total calls max ───────────────────────────────┴──────┴──────┴───────┴─────────┘ ─abstract (sleep; constructor) 0.0% 100.0% 1 0.986s ├─sleep' --------------------- 100.0% 100.0% 1 0.986s ├─constructor ---------------- 0.0% 0.0% 1 0.000s └─sleep ---------------------- 0.0% 0.0% 0 0.000s └sleep' --------------------- 0.0% 0.0% 0 0.000s coq-8.20.0/test-suite/output-modulo-time/ltacprof_abstract.v000066400000000000000000000003231466560755400241660ustar00rootroot00000000000000(* -*- coq-prog-args: ("-profile-ltac-cutoff" "0.0") -*- *) Ltac sleep' := do 100 (do 100 (do 100 idtac)). Ltac sleep := sleep'. Theorem x : True. Proof. idtac. idtac. abstract (sleep; constructor). Defined. coq-8.20.0/test-suite/output-modulo-time/qed_time.out000066400000000000000000000003421466560755400226230ustar00rootroot00000000000000Chars 40 - 57 [Lemma~foo~:~True.] 0. secs (0.u,0.s) Chars 58 - 64 [Proof.] 0. secs (0.u,0.s) Chars 67 - 81 [Axiom~(X~:~nat).] 0. secs (0.u,0.s) Chars 84 - 92 [exact~I.] 0. secs (0.u,0.s) Chars 93 - 97 [Qed.] 0. secs (0.u,0.s) coq-8.20.0/test-suite/output-modulo-time/qed_time.v000066400000000000000000000001421466560755400222570ustar00rootroot00000000000000(* -*- coq-prog-args: ("-time") -*- *) Lemma foo : True. Proof. Axiom X : nat. exact I. Qed. coq-8.20.0/test-suite/output/000077500000000000000000000000001466560755400160535ustar00rootroot00000000000000coq-8.20.0/test-suite/output/Arguments.out000066400000000000000000000107241466560755400205550ustar00rootroot00000000000000Nat.sub : nat -> nat -> nat Nat.sub is not universe polymorphic Arguments Nat.sub (n m)%nat_scope : simpl nomatch The reduction tactics unfold Nat.sub but avoid exposing match constructs Nat.sub is transparent Expands to: Constant Coq.Init.Nat.sub Nat.sub : nat -> nat -> nat Nat.sub is not universe polymorphic Arguments Nat.sub n%nat_scope / m%nat_scope : simpl nomatch The reduction tactics unfold Nat.sub when applied to 1 argument but avoid exposing match constructs Nat.sub is transparent Expands to: Constant Coq.Init.Nat.sub Nat.sub : nat -> nat -> nat Nat.sub is not universe polymorphic Arguments Nat.sub !n%nat_scope / m%nat_scope : simpl nomatch The reduction tactics unfold Nat.sub when the 1st argument evaluates to a constructor and when applied to 1 argument but avoid exposing match constructs Nat.sub is transparent Expands to: Constant Coq.Init.Nat.sub Nat.sub : nat -> nat -> nat Nat.sub is not universe polymorphic Arguments Nat.sub (!n !m)%nat_scope / The reduction tactics unfold Nat.sub when the 1st and 2nd arguments evaluate to a constructor and when applied to 2 arguments Nat.sub is transparent Expands to: Constant Coq.Init.Nat.sub Nat.sub : nat -> nat -> nat Nat.sub is not universe polymorphic Arguments Nat.sub (!n !m)%nat_scope The reduction tactics unfold Nat.sub when the 1st and 2nd arguments evaluate to a constructor Nat.sub is transparent Expands to: Constant Coq.Init.Nat.sub pf : forall {D1 C1 : Type}, (D1 -> C1) -> forall [D2 C2 : Type], (D2 -> C2) -> D1 * D2 -> C1 * C2 pf is not universe polymorphic Arguments pf {D1}%foo_scope {C1}%type_scope f [D2 C2] g x : simpl never The reduction tactics never unfold pf pf is transparent Expands to: Constant Arguments.pf fcomp : forall {A B C : Type}, (B -> C) -> (A -> B) -> A -> C fcomp is not universe polymorphic Arguments fcomp {A B C}%type_scope f g x / The reduction tactics unfold fcomp when applied to 6 arguments fcomp is transparent Expands to: Constant Arguments.fcomp volatile : nat -> nat volatile is not universe polymorphic Arguments volatile / x%nat_scope The reduction tactics always unfold volatile volatile is transparent Expands to: Constant Arguments.volatile f : T1 -> T2 -> nat -> unit -> nat -> nat f is not universe polymorphic Arguments f x y n%nat_scope v m%nat_scope f uses section variables T1 T2. f is transparent Expands to: Constant Arguments.S1.S2.f f : T1 -> T2 -> nat -> unit -> nat -> nat f is not universe polymorphic Arguments f x y !n%nat_scope !v !m%nat_scope f uses section variables T1 T2. The reduction tactics unfold f when the 3rd, 4th and 5th arguments evaluate to a constructor f is transparent Expands to: Constant Arguments.S1.S2.f f : forall [T2 : Type], T1 -> T2 -> nat -> unit -> nat -> nat f is not universe polymorphic Arguments f [T2]%type_scope x y !n%nat_scope !v !m%nat_scope f uses section variable T1. The reduction tactics unfold f when the 4th, 5th and 6th arguments evaluate to a constructor f is transparent Expands to: Constant Arguments.S1.f f : forall [T1 T2 : Type], T1 -> T2 -> nat -> unit -> nat -> nat f is not universe polymorphic Arguments f [T1 T2]%type_scope x y !n%nat_scope !v !m%nat_scope The reduction tactics unfold f when the 5th, 6th and 7th arguments evaluate to a constructor f is transparent Expands to: Constant Arguments.f = forall v : unit, f 0 0 5 v 3 = 2 : Prop = 2 = 2 : Prop f : forall T1 T2 : Type, T1 -> T2 -> nat -> unit -> nat -> nat f is not universe polymorphic Arguments f T1 T2 x y !n !v !m The reduction tactics unfold f when the 5th, 6th and 7th arguments evaluate to a constructor f is transparent Expands to: Constant Arguments.f forall w : r, w 3 true = tt : Prop File "./output/Arguments.v", line 52, characters 28-29: The command has indeed failed with message: Unknown interpretation for notation "$". w 3 true = tt : Prop File "./output/Arguments.v", line 56, characters 0-28: The command has indeed failed with message: Extra arguments: _, _. volatilematch : nat -> nat volatilematch is not universe polymorphic Arguments volatilematch / n%nat_scope : simpl nomatch The reduction tactics always unfold volatilematch but avoid exposing match constructs volatilematch is transparent Expands to: Constant Arguments.volatilematch = fun n : nat => volatilematch n : nat -> nat *** [ f : A -> forall xxxxxxxxxxxxxx' xxxxxxxxxxxxxx'' : nat, nat -> xxxxxxxxxxxxxx' + xxxxxxxxxxxxxx' + xxxxxxxxxxxxxx'' = 0 ] Arguments f xxxxxxxxxxxxxx (xxxxxxxxxxxxxx' xxxxxxxxxxxxxx'' xxxxxxxxxxxxxx''')%nat_scope coq-8.20.0/test-suite/output/Arguments.v000066400000000000000000000037251466560755400202160ustar00rootroot00000000000000(* coq-prog-args: ("-top" "Arguments") *) Arguments Nat.sub n m : simpl nomatch. About Nat.sub. Arguments Nat.sub n / m : simpl nomatch. About Nat.sub. Arguments Nat.sub !n / m : simpl nomatch. About Nat.sub. Arguments Nat.sub !n !m /. About Nat.sub. Arguments Nat.sub !n !m. About Nat.sub. Definition pf (D1 C1 : Type) (f : D1 -> C1) (D2 C2 : Type) (g : D2 -> C2) := fun x => (f (fst x), g (snd x)). Declare Scope foo_scope. Declare Scope bar_scope. Delimit Scope foo_scope with F. Arguments pf {D1%_F C1%_type} f [D2 C2] g x : simpl never. About pf. Definition fcomp A B C f (g : A -> B) (x : A) : C := f (g x). Arguments fcomp {_ _ _}%_type_scope f g x /. About fcomp. Definition volatile := fun x : nat => x. Arguments volatile / _. About volatile. Set Implicit Arguments. Section S1. Variable T1 : Type. Section S2. Variable T2 : Type. Fixpoint f (x : T1) (y : T2) n (v : unit) m {struct n} : nat := match n, m with | 0,_ => 0 | S _, 0 => n | S n', S m' => f x y n' v m' end. About f. Global Arguments f x y !n !v !m. About f. End S2. About f. End S1. About f. Eval cbn in forall v, f 0 0 5 v 3 = 2. Eval cbn in f 0 0 5 tt 3 = 2. Arguments f : clear implicits and scopes. About f. Record r := { pi :> nat -> bool -> unit }. Notation "$" := 3 (only parsing) : foo_scope. Notation "$" := true (only parsing) : bar_scope. Delimit Scope bar_scope with B. Arguments pi _ _%_F _%_B. Check (forall w : r, pi w $ $ = tt). Fail Check (forall w : r, w $ $ = tt). Axiom w : r. Arguments w x%_F y%_B : extra scopes. Check (w $ $ = tt). Fail Arguments w _%_F _%_B. Definition volatilematch (n : nat) := match n with | O => O | S p => p end. Arguments volatilematch / n : simpl nomatch. About volatilematch. Eval simpl in fun n => volatilematch n. Module Formatting. Parameter A : Type. Parameter f : forall (xxxxxxxxxxxxxx : A) (xxxxxxxxxxxxxx' : nat) (xxxxxxxxxxxxxx'' : nat) (xxxxxxxxxxxxxx''' : nat), xxxxxxxxxxxxxx' + xxxxxxxxxxxxxx' + xxxxxxxxxxxxxx'' = 0. Print f. End Formatting. coq-8.20.0/test-suite/output/ArgumentsScope.out000066400000000000000000000055241466560755400215510ustar00rootroot00000000000000a : bool -> bool a is not universe polymorphic Arguments a _%bool_scope Expands to: Variable a b : bool -> bool b is not universe polymorphic Arguments b _%bool_scope Expands to: Variable b negb'' : bool -> bool negb'' is not universe polymorphic Arguments negb'' b%bool_scope negb'' is transparent Expands to: Constant ArgumentsScope.A.B.negb'' negb' : bool -> bool negb' is not universe polymorphic Arguments negb' b%bool_scope negb' is transparent Expands to: Constant ArgumentsScope.A.negb' negb : bool -> bool negb is not universe polymorphic Arguments negb b%bool_scope negb is transparent Expands to: Constant Coq.Init.Datatypes.negb a : bool -> bool a is not universe polymorphic Expands to: Variable a b : bool -> bool b is not universe polymorphic Expands to: Variable b negb : bool -> bool negb is not universe polymorphic Arguments negb b negb is transparent Expands to: Constant Coq.Init.Datatypes.negb negb' : bool -> bool negb' is not universe polymorphic Arguments negb' b negb' is transparent Expands to: Constant ArgumentsScope.A.negb' negb'' : bool -> bool negb'' is not universe polymorphic Arguments negb'' b negb'' is transparent Expands to: Constant ArgumentsScope.A.B.negb'' a : bool -> bool a is not universe polymorphic Expands to: Variable a negb : bool -> bool negb is not universe polymorphic Arguments negb b negb is transparent Expands to: Constant Coq.Init.Datatypes.negb negb' : bool -> bool negb' is not universe polymorphic Arguments negb' b negb' is transparent Expands to: Constant ArgumentsScope.negb' negb'' : bool -> bool negb'' is not universe polymorphic Arguments negb'' b negb'' is transparent Expands to: Constant ArgumentsScope.negb'' f : bool -> bool f is not universe polymorphic Arguments f x%A_scope%B_scope f is transparent Expands to: Constant ArgumentsScope.f f tt : bool f true : bool f : bool -> bool f is not universe polymorphic Arguments f x%B_scope%A_scope f is transparent Expands to: Constant ArgumentsScope.f f tt : bool f false : bool g : bool -> bool g is not universe polymorphic Arguments g x%A_scope%B_scope g is transparent Expands to: Constant ArgumentsScope.g g' : nat -> nat g' is not universe polymorphic Arguments g' x%B_scope%A_scope g' is transparent Expands to: Constant ArgumentsScope.g' g'' : unit -> unit g'' is not universe polymorphic Arguments g'' x%B_scope g'' is transparent Expands to: Constant ArgumentsScope.g'' f : A -> B -> A f is not universe polymorphic Arguments f _%X _%Y f is transparent Expands to: Constant ArgumentsScope.SectionTest1.S.f f : A -> B -> A f is not universe polymorphic f is transparent Expands to: Constant ArgumentsScope.SectionTest1.f N.f : A -> A N.f is not universe polymorphic Arguments N.f _%X Expands to: Constant ArgumentsScope.SectionTest2.N.f g : A -> A g is not universe polymorphic Expands to: Constant ArgumentsScope.SectionTest2.g coq-8.20.0/test-suite/output/ArgumentsScope.v000066400000000000000000000045141466560755400212050ustar00rootroot00000000000000(* coq-prog-args: ("-top" "ArgumentsScope") *) (* A few tests to check Global Argument Scope command *) Section A. Variable a : bool -> bool. Definition negb' := negb. Section B. Variable b : bool -> bool. Definition negb'' := negb. About a. About b. About negb''. About negb'. About negb. Global Arguments negb'' _ : clear scopes. Global Arguments negb' _ : clear scopes. Global Arguments negb _ : clear scopes. Global Arguments a _ : clear scopes. Global Arguments b _ : clear scopes. About a. About b. About negb. About negb'. About negb''. End B. About a. End A. About negb. About negb'. About negb''. (* Check multiple scopes *) Declare Scope A_scope. Delimit Scope A_scope with A. Declare Scope B_scope. Delimit Scope B_scope with B. Notation "'tt'" := true : A_scope. Notation "'tt'" := false : B_scope. Definition f (x : bool) := x. Arguments f x%_A%_B. About f. Check f tt. Set Printing All. Check f tt. Unset Printing All. Arguments f x%_B%_A. About f. Check f tt. Set Printing All. Check f tt. Unset Printing All. (* Check binding scope inside/outside *) Bind Scope A_scope with bool. #[add_bottom] Bind Scope B_scope with bool. Definition g (x : bool) := x. About g. Bind Scope A_scope with nat. #[add_top] Bind Scope B_scope with nat. Definition g' (x : nat) := x. About g'. Bind Scope A_scope with unit. Bind Scope B_scope with unit. (* default: reset *) Definition g'' (x : unit) := x. About g''. Module SectionTest1. Inductive A :=. Inductive B :=. Declare Scope X. Section S. Declare Scope Y. Bind Scope X with A. Bind Scope Y with B. Definition f : A -> B -> A := fun x _ => x. About f. End S. (* In section, Bind Scope do not survive the section nor have a persistent effect: outside the section, f does not know any more about X and Y, even thoug X exists outside the section *) About f. End SectionTest1. Module SectionTest2. Inductive A :=. Module M. Declare Scope X. Bind Scope X with A. End M. Module N. Import M. Section S. Axiom f : A -> A. End S. End N. (* In modules, Bind Scope has a persistent effect even if not imported: f knows about X even if M not imported *) About N.f. Axiom g : A -> A. (* Without the Import, Bind Scope has however no effect on declarations not already aware of this binding *) About g. End SectionTest2. coq-8.20.0/test-suite/output/Arguments_renaming.out000066400000000000000000000110341466560755400224300ustar00rootroot00000000000000File "./output/Arguments_renaming.v", line 2, characters 0-36: The command has indeed failed with message: Flag "rename" expected to rename A into B. File "./output/Arguments_renaming.v", line 3, characters 0-19: Warning: This command is just asserting the names of arguments of eq. If this is what you want, add ': assert' to silence the warning. If you want to clear implicit arguments, add ': clear implicits'. If you want to clear notation scopes, add ': clear scopes' [arguments-assert,vernacular,default] @eq_refl : forall (B : Type) (y : B), y = y eq_refl : ?y = ?y where ?y : [ |- nat] Inductive eq (A : Type) (x : A) : A -> Prop := eq_refl : x = x. Arguments eq {A}%type_scope x _ Arguments eq_refl {B}%type_scope {y}, [_] _ (where some original arguments have been renamed) eq_refl : forall {B : Type} {y : B}, y = y eq_refl is not universe polymorphic Arguments eq_refl {B}%type_scope {y}, [_] _ (where some original arguments have been renamed) Expands to: Constructor Coq.Init.Logic.eq_refl Inductive myEq (B : Type) (x : A) : A -> Prop := myrefl : B -> myEq B x x. Arguments myEq B%type_scope x _ Arguments myrefl {C}%type_scope x _ (where some original arguments have been renamed) myrefl : forall {C : Type} (x : A), C -> myEq C x x myrefl is not universe polymorphic Arguments myrefl {C}%type_scope x _ (where some original arguments have been renamed) myrefl uses section variable A. Expands to: Constructor Arguments_renaming.Test1.myrefl myplus = fix myplus (T : Type) (t : T) (n m : nat) {struct n} : nat := match n with | 0 => m | S n' => S (myplus T t n' m) end : forall {T : Type}, T -> nat -> nat -> nat Arguments myplus {Z}%type_scope !t (!n m)%nat_scope (where some original arguments have been renamed) myplus : forall {Z : Type}, Z -> nat -> nat -> nat myplus is not universe polymorphic Arguments myplus {Z}%type_scope !t (!n m)%nat_scope (where some original arguments have been renamed) The reduction tactics unfold myplus when the 2nd and 3rd arguments evaluate to a constructor myplus is transparent Expands to: Constant Arguments_renaming.Test1.myplus @myplus : forall Z : Type, Z -> nat -> nat -> nat Inductive myEq (A B : Type) (x : A) : A -> Prop := myrefl : B -> myEq A B x x. Arguments myEq (A B)%type_scope x _ Arguments myrefl A%type_scope {C}%type_scope x _ (where some original arguments have been renamed) myrefl : forall (A : Type) {C : Type} (x : A), C -> myEq A C x x myrefl is not universe polymorphic Arguments myrefl A%type_scope {C}%type_scope x _ (where some original arguments have been renamed) Expands to: Constructor Arguments_renaming.myrefl myrefl : forall (A C : Type) (x : A), C -> myEq A C x x myplus = fix myplus (T : Type) (t : T) (n m : nat) {struct n} : nat := match n with | 0 => m | S n' => S (myplus T t n' m) end : forall {T : Type}, T -> nat -> nat -> nat Arguments myplus {Z}%type_scope !t (!n m)%nat_scope (where some original arguments have been renamed) myplus : forall {Z : Type}, Z -> nat -> nat -> nat myplus is not universe polymorphic Arguments myplus {Z}%type_scope !t (!n m)%nat_scope (where some original arguments have been renamed) The reduction tactics unfold myplus when the 2nd and 3rd arguments evaluate to a constructor myplus is transparent Expands to: Constant Arguments_renaming.myplus @myplus : forall Z : Type, Z -> nat -> nat -> nat File "./output/Arguments_renaming.v", line 49, characters 0-36: The command has indeed failed with message: Argument lists should agree on the names they provide. File "./output/Arguments_renaming.v", line 50, characters 0-41: The command has indeed failed with message: Sequences of implicit arguments must be of different lengths. File "./output/Arguments_renaming.v", line 51, characters 0-37: The command has indeed failed with message: Argument number 3 is a trailing implicit, so it can't be declared non maximal. Please use { } instead of [ ]. File "./output/Arguments_renaming.v", line 52, characters 0-37: The command has indeed failed with message: Argument z is a trailing implicit, so it can't be declared non maximal. Please use { } instead of [ ]. File "./output/Arguments_renaming.v", line 53, characters 0-28: The command has indeed failed with message: Extra arguments: y. File "./output/Arguments_renaming.v", line 54, characters 0-26: The command has indeed failed with message: Flag "rename" expected to rename A into R. File "./output/Arguments_renaming.v", line 58, characters 2-36: The command has indeed failed with message: Arguments of section variables such as allTrue may not be renamed. coq-8.20.0/test-suite/output/Arguments_renaming.v000066400000000000000000000022541466560755400220720ustar00rootroot00000000000000(* coq-prog-args: ("-top" "Arguments_renaming") *) Fail Arguments eq_refl {B y}, [B] y. Arguments eq A _ _. Arguments eq_refl A x : assert. Arguments eq_refl {B y}, [B] y : rename. Check @eq_refl. Check (eq_refl (B := nat)). Print eq_refl. About eq_refl. Goal 3 = 3. Succeed apply @eq_refl with (B := nat). Succeed apply @eq_refl with (y := 3). pose (y := nat). apply (@eq_refl y) with (y := 3). Qed. Section Test1. Variable A : Type. Inductive myEq B (x : A) : A -> Prop := myrefl : B -> myEq B x x. Global Arguments myrefl {C} x _ : rename. Print myrefl. About myrefl. Fixpoint myplus T (t : T) (n m : nat) {struct n} := match n with O => m | S n' => S (myplus T t n' m) end. Global Arguments myplus {Z} !t !n m : rename. Print myplus. About myplus. Check @myplus. End Test1. Print myrefl. About myrefl. Check myrefl. Print myplus. About myplus. Check @myplus. Fail Arguments eq_refl {F g}, [H] k. Fail Arguments eq_refl {F}, [F] : rename. Fail Arguments eq {A} x [_] : rename. Fail Arguments eq {A} x [z] : rename. Fail Arguments eq {F} x z y. Fail Arguments eq {R} s t. Section RenameVar. Variable allTrue : forall P, P. Fail Arguments allTrue Q : rename. End RenameVar. coq-8.20.0/test-suite/output/BadOptionValueType.out000066400000000000000000000021071466560755400223220ustar00rootroot00000000000000File "./output/BadOptionValueType.v", line 1, characters 0-29: The command has indeed failed with message: Bad type of value for this option: expected int, got string. File "./output/BadOptionValueType.v", line 2, characters 0-25: The command has indeed failed with message: This is an option. A value must be provided. File "./output/BadOptionValueType.v", line 3, characters 0-27: The command has indeed failed with message: Bad type of value for this option: expected string, got int. File "./output/BadOptionValueType.v", line 4, characters 0-25: The command has indeed failed with message: This is an option. A value must be provided. File "./output/BadOptionValueType.v", line 5, characters 0-27: The command has indeed failed with message: This is a flag. It does not take a value. File "./output/BadOptionValueType.v", line 6, characters 0-23: The command has indeed failed with message: This is a flag. It does not take a value. File "./output/BadOptionValueType.v", line 7, characters 0-20: The command has indeed failed with message: This option does not support the "Unset" command. coq-8.20.0/test-suite/output/BadOptionValueType.v000066400000000000000000000002671466560755400217650ustar00rootroot00000000000000Fail Set Default Timeout "2". Fail Set Default Timeout. Fail Set Bullet Behavior 2. Fail Set Bullet Behavior. Fail Set Debug Eauto "yes". Fail Set Debug Eauto 1. Fail Unset Warnings. coq-8.20.0/test-suite/output/BinaryPrintingNotations.out000066400000000000000000000006001466560755400234360ustar00rootroot00000000000000  !"#$%&'()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_`abcdefghijklmnopqrstuvwxyz{|}~€‚ƒ„…†‡ˆ‰Š‹ŒŽ‘’“”•–—˜™š›œžŸ ¡¢£¤¥¦§¨©ª«¬­®¯°±²³´µ¶·¸¹º»¼½¾¿ÀÁÂÃÄÅÆÇÈÉÊËÌÍÎÏÐÑÒÓÔÕÖ×ØÙÚÛÜÝÞßàáâãäåæçèéêëìíîïðñòóôõö÷øùúûüýþÿ coq-8.20.0/test-suite/output/BinaryPrintingNotations.v000066400000000000000000000440051466560755400231030ustar00rootroot00000000000000Require Import Coq.ZArith.BinInt Coq.Lists.List. Require Coq.Init.Byte Coq.Strings.Byte. (* Use a different scope for byte lists and bytes, otherwise nil and Byte.x20 have to share the same printing rule. *) Declare Scope bytedump_scope. Declare Scope bytedumpchar_scope. Delimit Scope bytedumpchar_scope with bytedumpchar. Delimit Scope bytedump_scope with bytedump. Notation "a b" := (@cons Byte.byte a%bytedumpchar b%bytedump) (only printing, right associativity, at level 3, format "a b") : bytedump_scope. Notation "" := (@nil _) (only printing, format "") : bytedump_scope. Undelimit Scope bytedumpchar_scope. Undelimit Scope bytedump_scope. Set Warnings "-notation-incompatible-prefix". Notation "''" := (Byte.x00) (only printing) : bytedumpchar_scope. Notation "''" := (Byte.x01) (only printing) : bytedumpchar_scope. Notation "''" := (Byte.x02) (only printing) : bytedumpchar_scope. Notation "''" := (Byte.x03) (only printing) : bytedumpchar_scope. Notation "''" := (Byte.x04) (only printing) : bytedumpchar_scope. Notation "''" := (Byte.x05) (only printing) : bytedumpchar_scope. Notation "''" := (Byte.x06) (only printing) : bytedumpchar_scope. Notation "''" := (Byte.x07) (only printing) : bytedumpchar_scope. Notation "''" := (Byte.x08) (only printing) : bytedumpchar_scope. Notation "' '" := (Byte.x09) (only printing) : bytedumpchar_scope. Notation "' '" := (Byte.x0a) (only printing) : bytedumpchar_scope. Notation "' '" := (Byte.x0b) (only printing) : bytedumpchar_scope. Notation "' '" := (Byte.x0c) (only printing) : bytedumpchar_scope. Notation "' '" := (Byte.x0d) (only printing) : bytedumpchar_scope. Notation "''" := (Byte.x0e) (only printing) : bytedumpchar_scope. Notation "''" := (Byte.x0f) (only printing) : bytedumpchar_scope. Notation "''" := (Byte.x10) (only printing) : bytedumpchar_scope. Notation "''" := (Byte.x11) (only printing) : bytedumpchar_scope. Notation "''" := (Byte.x12) (only printing) : bytedumpchar_scope. Notation "''" := (Byte.x13) (only printing) : bytedumpchar_scope. Notation "''" := (Byte.x14) (only printing) : bytedumpchar_scope. Notation "''" := (Byte.x15) (only printing) : bytedumpchar_scope. Notation "''" := (Byte.x16) (only printing) : bytedumpchar_scope. Notation "''" := (Byte.x17) (only printing) : bytedumpchar_scope. Notation "''" := (Byte.x18) (only printing) : bytedumpchar_scope. Notation "''" := (Byte.x19) (only printing) : bytedumpchar_scope. (* Notation for 0x1a removed to appease Microsoft Windows *) Notation "''" := (Byte.x1b) (only printing) : bytedumpchar_scope. Notation "''" := (Byte.x1c) (only printing) : bytedumpchar_scope. Notation "''" := (Byte.x1d) (only printing) : bytedumpchar_scope. Notation "''" := (Byte.x1e) (only printing) : bytedumpchar_scope. Notation "''" := (Byte.x1f) (only printing) : bytedumpchar_scope. Notation " " := (Byte.x20) (only printing, format " ") : bytedumpchar_scope. Notation "'!'" := (Byte.x21) (only printing) : bytedumpchar_scope. Notation "'""'" := (Byte.x22) (only printing) : bytedumpchar_scope. Notation "'#'" := (Byte.x23) (only printing) : bytedumpchar_scope. Notation "'$'" := (Byte.x24) (only printing) : bytedumpchar_scope. Notation "'%'" := (Byte.x25) (only printing) : bytedumpchar_scope. Notation "'&'" := (Byte.x26) (only printing) : bytedumpchar_scope. Notation "'''" := (Byte.x27) (only printing) : bytedumpchar_scope. Notation "'('" := (Byte.x28) (only printing) : bytedumpchar_scope. Notation "')'" := (Byte.x29) (only printing) : bytedumpchar_scope. Notation "'*'" := (Byte.x2a) (only printing) : bytedumpchar_scope. Notation "'+'" := (Byte.x2b) (only printing) : bytedumpchar_scope. Notation "','" := (Byte.x2c) (only printing) : bytedumpchar_scope. Notation "'-'" := (Byte.x2d) (only printing, at level 0) : bytedumpchar_scope. Notation "'.'" := (Byte.x2e) (only printing) : bytedumpchar_scope. Notation "'/'" := (Byte.x2f) (only printing, at level 0) : bytedumpchar_scope. Notation "'0'" := (Byte.x30) (only printing) : bytedumpchar_scope. Notation "'1'" := (Byte.x31) (only printing) : bytedumpchar_scope. Notation "'2'" := (Byte.x32) (only printing) : bytedumpchar_scope. Notation "'3'" := (Byte.x33) (only printing) : bytedumpchar_scope. Notation "'4'" := (Byte.x34) (only printing) : bytedumpchar_scope. Notation "'5'" := (Byte.x35) (only printing) : bytedumpchar_scope. Notation "'6'" := (Byte.x36) (only printing) : bytedumpchar_scope. Notation "'7'" := (Byte.x37) (only printing) : bytedumpchar_scope. Notation "'8'" := (Byte.x38) (only printing) : bytedumpchar_scope. Notation "'9'" := (Byte.x39) (only printing) : bytedumpchar_scope. Notation "':'" := (Byte.x3a) (only printing) : bytedumpchar_scope. Notation "';'" := (Byte.x3b) (only printing) : bytedumpchar_scope. Notation "'<'" := (Byte.x3c) (only printing) : bytedumpchar_scope. Notation "'='" := (Byte.x3d) (only printing) : bytedumpchar_scope. Notation "'>'" := (Byte.x3e) (only printing) : bytedumpchar_scope. Notation "'?'" := (Byte.x3f) (only printing) : bytedumpchar_scope. Notation "'@'" := (Byte.x40) (only printing) : bytedumpchar_scope. Notation "'A'" := (Byte.x41) (only printing) : bytedumpchar_scope. Notation "'B'" := (Byte.x42) (only printing) : bytedumpchar_scope. Notation "'C'" := (Byte.x43) (only printing) : bytedumpchar_scope. Notation "'D'" := (Byte.x44) (only printing) : bytedumpchar_scope. Notation "'E'" := (Byte.x45) (only printing) : bytedumpchar_scope. Notation "'F'" := (Byte.x46) (only printing) : bytedumpchar_scope. Notation "'G'" := (Byte.x47) (only printing) : bytedumpchar_scope. Notation "'H'" := (Byte.x48) (only printing) : bytedumpchar_scope. Notation "'I'" := (Byte.x49) (only printing) : bytedumpchar_scope. Notation "'J'" := (Byte.x4a) (only printing) : bytedumpchar_scope. Notation "'K'" := (Byte.x4b) (only printing) : bytedumpchar_scope. Notation "'L'" := (Byte.x4c) (only printing) : bytedumpchar_scope. Notation "'M'" := (Byte.x4d) (only printing) : bytedumpchar_scope. Notation "'N'" := (Byte.x4e) (only printing) : bytedumpchar_scope. Notation "'O'" := (Byte.x4f) (only printing) : bytedumpchar_scope. Notation "'P'" := (Byte.x50) (only printing) : bytedumpchar_scope. Notation "'Q'" := (Byte.x51) (only printing) : bytedumpchar_scope. Notation "'R'" := (Byte.x52) (only printing) : bytedumpchar_scope. Notation "'S'" := (Byte.x53) (only printing) : bytedumpchar_scope. Notation "'T'" := (Byte.x54) (only printing) : bytedumpchar_scope. Notation "'U'" := (Byte.x55) (only printing) : bytedumpchar_scope. Notation "'V'" := (Byte.x56) (only printing) : bytedumpchar_scope. Notation "'W'" := (Byte.x57) (only printing) : bytedumpchar_scope. Notation "'X'" := (Byte.x58) (only printing) : bytedumpchar_scope. Notation "'Y'" := (Byte.x59) (only printing) : bytedumpchar_scope. Notation "'Z'" := (Byte.x5a) (only printing) : bytedumpchar_scope. Notation "'['" := (Byte.x5b) (only printing) : bytedumpchar_scope. Notation "'\'" := (Byte.x5c) (only printing) : bytedumpchar_scope. Notation "']'" := (Byte.x5d) (only printing) : bytedumpchar_scope. Notation "'^'" := (Byte.x5e) (only printing) : bytedumpchar_scope. Notation "'_'" := (Byte.x5f) (only printing) : bytedumpchar_scope. Notation "'`'" := (Byte.x60) (only printing) : bytedumpchar_scope. Notation "'a'" := (Byte.x61) (only printing) : bytedumpchar_scope. Notation "'b'" := (Byte.x62) (only printing) : bytedumpchar_scope. Notation "'c'" := (Byte.x63) (only printing) : bytedumpchar_scope. Notation "'d'" := (Byte.x64) (only printing) : bytedumpchar_scope. Notation "'e'" := (Byte.x65) (only printing) : bytedumpchar_scope. Notation "'f'" := (Byte.x66) (only printing) : bytedumpchar_scope. Notation "'g'" := (Byte.x67) (only printing) : bytedumpchar_scope. Notation "'h'" := (Byte.x68) (only printing) : bytedumpchar_scope. Notation "'i'" := (Byte.x69) (only printing) : bytedumpchar_scope. Notation "'j'" := (Byte.x6a) (only printing) : bytedumpchar_scope. Notation "'k'" := (Byte.x6b) (only printing) : bytedumpchar_scope. Notation "'l'" := (Byte.x6c) (only printing) : bytedumpchar_scope. Notation "'m'" := (Byte.x6d) (only printing) : bytedumpchar_scope. Notation "'n'" := (Byte.x6e) (only printing) : bytedumpchar_scope. Notation "'o'" := (Byte.x6f) (only printing) : bytedumpchar_scope. Notation "'p'" := (Byte.x70) (only printing) : bytedumpchar_scope. Notation "'q'" := (Byte.x71) (only printing) : bytedumpchar_scope. Notation "'r'" := (Byte.x72) (only printing) : bytedumpchar_scope. Notation "'s'" := (Byte.x73) (only printing) : bytedumpchar_scope. Notation "'t'" := (Byte.x74) (only printing) : bytedumpchar_scope. Notation "'u'" := (Byte.x75) (only printing) : bytedumpchar_scope. Notation "'v'" := (Byte.x76) (only printing) : bytedumpchar_scope. Notation "'w'" := (Byte.x77) (only printing) : bytedumpchar_scope. Notation "'x'" := (Byte.x78) (only printing) : bytedumpchar_scope. Notation "'y'" := (Byte.x79) (only printing) : bytedumpchar_scope. Notation "'z'" := (Byte.x7a) (only printing) : bytedumpchar_scope. Notation "'{'" := (Byte.x7b) (only printing) : bytedumpchar_scope. Notation "'|'" := (Byte.x7c) (only printing) : bytedumpchar_scope. Notation "'}'" := (Byte.x7d) (only printing) : bytedumpchar_scope. Notation "'~'" := (Byte.x7e) (only printing, at level 0) : bytedumpchar_scope. Notation "''" := (Byte.x7f) (only printing) : bytedumpchar_scope. Notation "'€'" := (Byte.x80) (only printing) : bytedumpchar_scope. Notation "''" := (Byte.x81) (only printing) : bytedumpchar_scope. Notation "'‚'" := (Byte.x82) (only printing) : bytedumpchar_scope. Notation "'ƒ'" := (Byte.x83) (only printing) : bytedumpchar_scope. Notation "'„'" := (Byte.x84) (only printing) : bytedumpchar_scope. Notation "'…'" := (Byte.x85) (only printing) : bytedumpchar_scope. Notation "'†'" := (Byte.x86) (only printing) : bytedumpchar_scope. Notation "'‡'" := (Byte.x87) (only printing) : bytedumpchar_scope. Notation "'ˆ'" := (Byte.x88) (only printing) : bytedumpchar_scope. Notation "'‰'" := (Byte.x89) (only printing) : bytedumpchar_scope. Notation "'Š'" := (Byte.x8a) (only printing) : bytedumpchar_scope. Notation "'‹'" := (Byte.x8b) (only printing) : bytedumpchar_scope. Notation "'Œ'" := (Byte.x8c) (only printing) : bytedumpchar_scope. Notation "''" := (Byte.x8d) (only printing) : bytedumpchar_scope. Notation "'Ž'" := (Byte.x8e) (only printing) : bytedumpchar_scope. Notation "''" := (Byte.x8f) (only printing) : bytedumpchar_scope. Notation "''" := (Byte.x90) (only printing) : bytedumpchar_scope. Notation "'‘'" := (Byte.x91) (only printing) : bytedumpchar_scope. Notation "'’'" := (Byte.x92) (only printing) : bytedumpchar_scope. Notation "'“'" := (Byte.x93) (only printing) : bytedumpchar_scope. Notation "'”'" := (Byte.x94) (only printing) : bytedumpchar_scope. Notation "'•'" := (Byte.x95) (only printing) : bytedumpchar_scope. Notation "'–'" := (Byte.x96) (only printing) : bytedumpchar_scope. Notation "'—'" := (Byte.x97) (only printing) : bytedumpchar_scope. Notation "'˜'" := (Byte.x98) (only printing) : bytedumpchar_scope. Notation "'™'" := (Byte.x99) (only printing) : bytedumpchar_scope. Notation "'š'" := (Byte.x9a) (only printing) : bytedumpchar_scope. Notation "'›'" := (Byte.x9b) (only printing) : bytedumpchar_scope. Notation "'œ'" := (Byte.x9c) (only printing) : bytedumpchar_scope. Notation "''" := (Byte.x9d) (only printing) : bytedumpchar_scope. Notation "'ž'" := (Byte.x9e) (only printing) : bytedumpchar_scope. Notation "'Ÿ'" := (Byte.x9f) (only printing) : bytedumpchar_scope. Notation "' '" := (Byte.xa0) (only printing) : bytedumpchar_scope. Notation "'¡'" := (Byte.xa1) (only printing) : bytedumpchar_scope. Notation "'¢'" := (Byte.xa2) (only printing) : bytedumpchar_scope. Notation "'£'" := (Byte.xa3) (only printing) : bytedumpchar_scope. Notation "'¤'" := (Byte.xa4) (only printing) : bytedumpchar_scope. Notation "'¥'" := (Byte.xa5) (only printing) : bytedumpchar_scope. Notation "'¦'" := (Byte.xa6) (only printing) : bytedumpchar_scope. Notation "'§'" := (Byte.xa7) (only printing) : bytedumpchar_scope. Notation "'¨'" := (Byte.xa8) (only printing) : bytedumpchar_scope. Notation "'©'" := (Byte.xa9) (only printing) : bytedumpchar_scope. Notation "'ª'" := (Byte.xaa) (only printing) : bytedumpchar_scope. Notation "'«'" := (Byte.xab) (only printing) : bytedumpchar_scope. Notation "'¬'" := (Byte.xac) (only printing) : bytedumpchar_scope. Notation "'­'" := (Byte.xad) (only printing) : bytedumpchar_scope. Notation "'®'" := (Byte.xae) (only printing) : bytedumpchar_scope. Notation "'¯'" := (Byte.xaf) (only printing) : bytedumpchar_scope. Notation "'°'" := (Byte.xb0) (only printing) : bytedumpchar_scope. Notation "'±'" := (Byte.xb1) (only printing) : bytedumpchar_scope. Notation "'²'" := (Byte.xb2) (only printing) : bytedumpchar_scope. Notation "'³'" := (Byte.xb3) (only printing) : bytedumpchar_scope. Notation "'´'" := (Byte.xb4) (only printing) : bytedumpchar_scope. Notation "'µ'" := (Byte.xb5) (only printing) : bytedumpchar_scope. Notation "'¶'" := (Byte.xb6) (only printing) : bytedumpchar_scope. Notation "'·'" := (Byte.xb7) (only printing) : bytedumpchar_scope. Notation "'¸'" := (Byte.xb8) (only printing) : bytedumpchar_scope. Notation "'¹'" := (Byte.xb9) (only printing) : bytedumpchar_scope. Notation "'º'" := (Byte.xba) (only printing) : bytedumpchar_scope. Notation "'»'" := (Byte.xbb) (only printing) : bytedumpchar_scope. Notation "'¼'" := (Byte.xbc) (only printing) : bytedumpchar_scope. Notation "'½'" := (Byte.xbd) (only printing) : bytedumpchar_scope. Notation "'¾'" := (Byte.xbe) (only printing) : bytedumpchar_scope. Notation "'¿'" := (Byte.xbf) (only printing) : bytedumpchar_scope. Notation "'À'" := (Byte.xc0) (only printing) : bytedumpchar_scope. Notation "'Á'" := (Byte.xc1) (only printing) : bytedumpchar_scope. Notation "'Â'" := (Byte.xc2) (only printing) : bytedumpchar_scope. Notation "'Ã'" := (Byte.xc3) (only printing) : bytedumpchar_scope. Notation "'Ä'" := (Byte.xc4) (only printing) : bytedumpchar_scope. Notation "'Å'" := (Byte.xc5) (only printing) : bytedumpchar_scope. Notation "'Æ'" := (Byte.xc6) (only printing) : bytedumpchar_scope. Notation "'Ç'" := (Byte.xc7) (only printing) : bytedumpchar_scope. Notation "'È'" := (Byte.xc8) (only printing) : bytedumpchar_scope. Notation "'É'" := (Byte.xc9) (only printing) : bytedumpchar_scope. Notation "'Ê'" := (Byte.xca) (only printing) : bytedumpchar_scope. Notation "'Ë'" := (Byte.xcb) (only printing) : bytedumpchar_scope. Notation "'Ì'" := (Byte.xcc) (only printing) : bytedumpchar_scope. Notation "'Í'" := (Byte.xcd) (only printing) : bytedumpchar_scope. Notation "'Î'" := (Byte.xce) (only printing) : bytedumpchar_scope. Notation "'Ï'" := (Byte.xcf) (only printing) : bytedumpchar_scope. Notation "'Ð'" := (Byte.xd0) (only printing) : bytedumpchar_scope. Notation "'Ñ'" := (Byte.xd1) (only printing) : bytedumpchar_scope. Notation "'Ò'" := (Byte.xd2) (only printing) : bytedumpchar_scope. Notation "'Ó'" := (Byte.xd3) (only printing) : bytedumpchar_scope. Notation "'Ô'" := (Byte.xd4) (only printing) : bytedumpchar_scope. Notation "'Õ'" := (Byte.xd5) (only printing) : bytedumpchar_scope. Notation "'Ö'" := (Byte.xd6) (only printing) : bytedumpchar_scope. Notation "'×'" := (Byte.xd7) (only printing) : bytedumpchar_scope. Notation "'Ø'" := (Byte.xd8) (only printing) : bytedumpchar_scope. Notation "'Ù'" := (Byte.xd9) (only printing) : bytedumpchar_scope. Notation "'Ú'" := (Byte.xda) (only printing) : bytedumpchar_scope. Notation "'Û'" := (Byte.xdb) (only printing) : bytedumpchar_scope. Notation "'Ü'" := (Byte.xdc) (only printing) : bytedumpchar_scope. Notation "'Ý'" := (Byte.xdd) (only printing) : bytedumpchar_scope. Notation "'Þ'" := (Byte.xde) (only printing) : bytedumpchar_scope. Notation "'ß'" := (Byte.xdf) (only printing) : bytedumpchar_scope. Notation "'à'" := (Byte.xe0) (only printing) : bytedumpchar_scope. Notation "'á'" := (Byte.xe1) (only printing) : bytedumpchar_scope. Notation "'â'" := (Byte.xe2) (only printing) : bytedumpchar_scope. Notation "'ã'" := (Byte.xe3) (only printing) : bytedumpchar_scope. Notation "'ä'" := (Byte.xe4) (only printing) : bytedumpchar_scope. Notation "'å'" := (Byte.xe5) (only printing) : bytedumpchar_scope. Notation "'æ'" := (Byte.xe6) (only printing) : bytedumpchar_scope. Notation "'ç'" := (Byte.xe7) (only printing) : bytedumpchar_scope. Notation "'è'" := (Byte.xe8) (only printing) : bytedumpchar_scope. Notation "'é'" := (Byte.xe9) (only printing) : bytedumpchar_scope. Notation "'ê'" := (Byte.xea) (only printing) : bytedumpchar_scope. Notation "'ë'" := (Byte.xeb) (only printing) : bytedumpchar_scope. Notation "'ì'" := (Byte.xec) (only printing) : bytedumpchar_scope. Notation "'í'" := (Byte.xed) (only printing) : bytedumpchar_scope. Notation "'î'" := (Byte.xee) (only printing) : bytedumpchar_scope. Notation "'ï'" := (Byte.xef) (only printing) : bytedumpchar_scope. Notation "'ð'" := (Byte.xf0) (only printing) : bytedumpchar_scope. Notation "'ñ'" := (Byte.xf1) (only printing) : bytedumpchar_scope. Notation "'ò'" := (Byte.xf2) (only printing) : bytedumpchar_scope. Notation "'ó'" := (Byte.xf3) (only printing) : bytedumpchar_scope. Notation "'ô'" := (Byte.xf4) (only printing) : bytedumpchar_scope. Notation "'õ'" := (Byte.xf5) (only printing) : bytedumpchar_scope. Notation "'ö'" := (Byte.xf6) (only printing) : bytedumpchar_scope. Notation "'÷'" := (Byte.xf7) (only printing) : bytedumpchar_scope. Notation "'ø'" := (Byte.xf8) (only printing) : bytedumpchar_scope. Notation "'ù'" := (Byte.xf9) (only printing) : bytedumpchar_scope. Notation "'ú'" := (Byte.xfa) (only printing) : bytedumpchar_scope. Notation "'û'" := (Byte.xfb) (only printing) : bytedumpchar_scope. Notation "'ü'" := (Byte.xfc) (only printing) : bytedumpchar_scope. Notation "'ý'" := (Byte.xfd) (only printing) : bytedumpchar_scope. Notation "'þ'" := (Byte.xfe) (only printing) : bytedumpchar_scope. Notation "'ÿ'" := (Byte.xff) (only printing) : bytedumpchar_scope. Definition supportedBytes : list Byte.byte := map (fun nn => match Byte.of_N (BinNat.N.of_nat nn) with | Some b => b | None => Byte.x00 (* won't happen *) end) (filter (fun n => negb (Nat.eqb n 0x1a)) (seq 0 256)). Local Open Scope bytedump_scope. Local Set Printing Width 1000. Goal True. let bs := eval cbv in supportedBytes in idtac bs. Abort. coq-8.20.0/test-suite/output/Binder.out000066400000000000000000000003161466560755400200070ustar00rootroot00000000000000foo = fun '(x, y) => x + y : nat * nat -> nat Arguments foo pat forall '(a, b), a /\ b : Prop foo = λ '(x, y), x + y : nat * nat → nat Arguments foo pat ∀ '(a, b), a ∧ b : Prop coq-8.20.0/test-suite/output/Binder.v000066400000000000000000000002061466560755400174430ustar00rootroot00000000000000Definition foo '(x,y) := x + y. Print foo. Check forall '(a,b), a /\ b. Require Import Utf8. Print foo. Check forall '(a,b), a /\ b. coq-8.20.0/test-suite/output/CantApplyBadType.out000066400000000000000000000016031466560755400217500ustar00rootroot00000000000000File "./output/CantApplyBadType.v", line 8, characters 16-24: The command has indeed failed with message: The term "Type" has type "Type@{u+1}" while it is expected to have type "Type@{u1}" (universe inconsistency: Cannot enforce u < u1 because u1 <= u). File "./output/CantApplyBadType.v", line 15, characters 0-58: The command has indeed failed with message: Illegal application: The term "idu1" of type "Type -> Type" cannot be applied to the term "Type" : "Type" This term has type "Type@{u+1}" which should be a subtype of "Type@{u1}". File "./output/CantApplyBadType.v", line 27, characters 2-108: The command has indeed failed with message: Illegal application: The term "idu1" of type "Type -> Type" cannot be applied to the term "Type" : "Type" This term has type "Type@{u+1}" which should be a subtype of "Type@{u1}". (universe inconsistency: Cannot enforce u < u1 because u1 <= u) coq-8.20.0/test-suite/output/CantApplyBadType.v000066400000000000000000000015131466560755400214060ustar00rootroot00000000000000Universes u0 u1. Constraint u1 <= u0. Axiom idu1 : Type@{u1} -> Type@{u1}. Universe u. Constraint u = u0. (* pretyping error *) Fail Check idu1 Type@{u}. (* The command has indeed failed with message: The term "Type" has type "Type@{u+1}" while it is expected to have type "Type@{u1}" (universe inconsistency: Cannot enforce u < u1 because u1 <= u0 = u). *) (* kernel error *) Fail Type ltac:(refine (idu1 _); exact_no_check Type@{u}). (* The command has indeed failed with message: Illegal application: The term "idu1" of type "Type -> Type" cannot be applied to the term "Type" : "Type" This term has type "Type@{u+1}" which should be coercible to "Type@{u1}". *) (* typing.ml error *) Goal True. Fail let c := constr:(ltac:(refine (idu1 _); exact_no_check Type@{u})) in let _ := type of c in idtac. (* same as kernel *) Abort. coq-8.20.0/test-suite/output/Cases.out000066400000000000000000000213551466560755400176500ustar00rootroot00000000000000t_rect = fun (P : t -> Type) (f : let x := t in forall x0 : x, P x0 -> P (k x0)) => fix F (t : t) : P t := match t as t0 return (P t0) with | k _ x0 => f x0 (F x0) end : forall P : t -> Type, (let x := t in forall x0 : x, P x0 -> P (k x0)) -> forall t : t, P t Arguments t_rect (P f)%function_scope t = fun d : TT => match d with | {| f3 := b |} => b end : TT -> 0 = 0 = fun d : TT => match d with | {| f3 := b |} => b end : TT -> 0 = 0 proj = fun (x y : nat) (P : nat -> Type) (def : P x) (prf : P y) => match Nat.eq_dec x y with | left eqprf => match eqprf in (_ = z) return (P z) with | eq_refl => def end | right _ => prf end : forall (x y : nat) (P : nat -> Type), P x -> P y -> P y Arguments proj (x y)%nat_scope P%function_scope def prf foo = fix foo (A : Type) (l : list A) {struct l} : option A := match l with | nil => None | x0 :: nil => Some x0 | x0 :: (_ :: _) as l0 => foo A l0 end : forall A : Type, list A -> option A Arguments foo A%type_scope l%list_scope uncast = fun (A : Type) (x : I A) => match x with | x0 <: _ => x0 end : forall A : Type, I A -> A Arguments uncast A%type_scope x foo' = if A 0 then true else false : bool f = fun H : B => match H with | AC x => (fun x0 : P b => let b0 := b in (if b0 as b return (P b -> True) then fun _ : P true => Logic.I else fun _ : P false => Logic.I) x0) x end : B -> True File "./output/Cases.v", line 91, characters 0-98: The command has indeed failed with message: Non exhaustive pattern-matching: no clause found for pattern gadtTy _ _ File "./output/Cases.v", line 108, characters 17-18: The command has indeed failed with message: In environment texpDenote : forall t : type, texp t -> typeDenote t t : type e : texp t n : nat The term "n" has type "nat" while it is expected to have type "typeDenote ?t@{t1:=Nat}". fun '{{n, m, _}} => n + m : J -> nat fun '{{n, m, p}} => n + m + p : J -> nat fun '(D n m p q) => n + m + p + q : J -> nat File "./output/Cases.v", line 126, characters 29-42: The command has indeed failed with message: Once notations are expanded, the resulting constructor D (in type J) is expected to be applied to no arguments while it is actually applied to 1 argument. lem1 = fun dd : nat * nat => let (bb, cc) as aa return (aa = aa) := dd in eq_refl : forall k : nat * nat, k = k Arguments lem1 k lem2 = fun dd : bool => if dd as aa return (aa = aa) then eq_refl else eq_refl : forall k : bool, k = k Arguments lem2 k%bool_scope lem3 = fun dd : nat * nat => let (bb, cc) as aa return (aa = aa) := dd in eq_refl : forall k : nat * nat, k = k Arguments lem3 k 1 goal x : nat n, n0 := match x + 0 with | 0 | S _ => 0 end : nat e, e0 := match x + 0 as y return (y = y) with | 0 => eq_refl | S n => eq_refl end : x + 0 = x + 0 n1, n2 := match x with | 0 | S _ => 0 end : nat e1, e2 := match x return (x = x) with | 0 => eq_refl | S n => eq_refl end : x = x ============================ x + 0 = 0 1 goal p : nat a, a0 := match eq_refl as y in (_ = e) return (y = y /\ e = e) with | eq_refl => conj eq_refl eq_refl end : eq_refl = eq_refl /\ p = p a1, a2 := match eq_refl in (_ = e) return (p = p /\ e = e) with | eq_refl => conj eq_refl eq_refl end : p = p /\ p = p ============================ eq_refl = eq_refl fun x : comparison => match x with | Eq => 1 | _ => 0 end : comparison -> nat fun x : comparison => match x with | Eq => 1 | Lt => 0 | Gt => 0 end : comparison -> nat fun x : comparison => match x with | Eq => 1 | Lt | Gt => 0 end : comparison -> nat fun x : comparison => match x return nat with | Eq => S O | Lt => O | Gt => O end : forall _ : comparison, nat fun x : K => match x with | a3 | a4 => 3 | _ => 2 end : K -> nat fun x : K => match x with | a1 | a2 => 4 | a3 => 3 | _ => 2 end : K -> nat fun x : K => match x with | a1 | a2 => 4 | a4 => 3 | _ => 2 end : K -> nat fun x : K => match x with | a1 | a3 | a4 => 3 | _ => 2 end : K -> nat File "./output/Cases.v", line 224, characters 38-86: The command has indeed failed with message: Pattern "S _, _" is redundant in this clause. stray = fun N : Tree => match N with | App (App Node (Node as strayvariable)) _ | App (App Node (App Node _ as strayvariable)) _ | App (App Node (App (App Node Node) (App _ _) as strayvariable)) _ | App (App Node (App (App Node (App _ _)) _ as strayvariable)) _ | App (App Node (App (App (App _ _) _) _ as strayvariable)) _ => strayvariable | _ => Node end : Tree -> Tree Arguments stray N File "./output/Cases.v", line 253, characters 4-5: Warning: Unused variable B might be a misspelled constructor. Use _ or _B to silence this warning. [unused-pattern-matching-variable,default] File "./output/Cases.v", line 266, characters 33-40: The command has indeed failed with message: Application of arguments to a recursive notation not supported in patterns. File "./output/Cases.v", line 267, characters 33-43: The command has indeed failed with message: The constructor cons (in type list) is expected to be applied to 2 arguments while it is actually applied to 3 arguments. File "./output/Cases.v", line 268, characters 33-39: The command has indeed failed with message: The constructor cons (in type list) is expected to be applied to 2 arguments while it is actually applied to 1 argument. File "./output/Cases.v", line 271, characters 33-45: The command has indeed failed with message: The constructor D' (in type J') is expected to be applied to 4 arguments (or 6 arguments when including variables for local definitions) while it is actually applied to 5 arguments. fun x : J' bool (true, true) => match x with | D' _ _ _ m _ e => existT (fun x0 : nat => x0 = x0) m e end : J' bool (true, true) -> {x : nat & x = x} fun x : J' bool (true, true) => match x with | @D' _ _ _ _ n _ p _ => n + p end : J' bool (true, true) -> nat File "./output/Cases.v", line 277, characters 33-40: The command has indeed failed with message: Application of arguments to a recursive notation not supported in patterns. File "./output/Cases.v", line 278, characters 33-43: The command has indeed failed with message: The constructor cons (in type list) is expected to be applied to 2 arguments while it is actually applied to 3 arguments. File "./output/Cases.v", line 279, characters 33-39: The command has indeed failed with message: The constructor cons (in type list) is expected to be applied to 2 arguments while it is actually applied to 1 argument. File "./output/Cases.v", line 281, characters 33-39: The command has indeed failed with message: The constructor D' (in type J') is expected to be applied to 3 arguments (or 4 arguments when including variables for local definitions) while it is actually applied to 2 arguments. File "./output/Cases.v", line 282, characters 33-45: The command has indeed failed with message: The constructor D' (in type J') is expected to be applied to 3 arguments (or 4 arguments when including variables for local definitions) while it is actually applied to 5 arguments. fun x : J' bool (true, true) => match x with | @D' _ _ _ _ _ m _ e => existT (fun x0 : nat => x0 = x0) m e end : J' bool (true, true) -> {x : nat & x = x} fun x : J' bool (true, true) => match x with | @D' _ _ _ _ n _ p _ => (n, p) end : J' bool (true, true) -> nat * nat File "./output/Cases.v", line 313, characters 3-4: Warning: Unused variable x might be a misspelled constructor. Use _ or _x to silence this warning. [unused-pattern-matching-variable,default] File "./output/Cases.v", line 314, characters 6-7: Warning: Unused variable y might be a misspelled constructor. Use _ or _y to silence this warning. [unused-pattern-matching-variable,default] File "./output/Cases.v", line 314, characters 3-4: Warning: Unused variable x might be a misspelled constructor. Use _ or _x to silence this warning. [unused-pattern-matching-variable,default] File "./output/Cases.v", line 325, characters 4-12: The command has indeed failed with message: Once notations are expanded, the resulting constructor true (in type bool) is expected to be applied to no arguments while it is actually applied to 2 arguments. coq-8.20.0/test-suite/output/Cases.v000066400000000000000000000215641466560755400173100ustar00rootroot00000000000000(* Cases with let-in in constructors types *) Unset Printing Allow Match Default Clause. Inductive t : Set := k : let x := t in x -> x. Print t_rect. Record TT : Type := CTT { f1 := 0 : nat; f2: nat; f3 : f1=f1 }. Eval cbv in fun d:TT => match d return 0 = 0 with CTT a _ b => b end. Eval lazy in fun d:TT => match d return 0 = 0 with CTT a _ b => b end. (* Do not contract nested patterns with dependent return type *) (* see bug #1699 *) Require Import Arith. Definition proj (x y:nat) (P:nat -> Type) (def:P x) (prf:P y) : P y := match eq_nat_dec x y return P y with | left eqprf => match eqprf in (_ = z) return (P z) with | refl_equal => def end | _ => prf end. Print proj. (* Use notations even below aliases *) Require Import List. Fixpoint foo (A:Type) (l:list A) : option A := match l with | nil => None | x0 :: nil => Some x0 | x0 :: (x1 :: xs) as l0 => foo A l0 end. Print foo. (* Accept and use notation with binded parameters *) #[universes(template)] Inductive I (A: Type) : Type := C : A -> I A. Notation "x <: T" := (C T x) (at level 38). Definition uncast A (x : I A) := match x with | x <: _ => x end. Print uncast. (* Do not duplicate the matched term *) Axiom A : nat -> bool. Definition foo' := match A 0 with | true => true | x => x end. Print foo'. (* Was bug #3293 (eta-expansion at "match" printing time was failing because of let-in's interpreted as being part of the expansion) *) Axiom b : bool. Axiom P : bool -> Prop. Inductive B : Prop := AC : P b -> B. Definition f : B -> True. Proof. intros [x]. destruct b as [|] ; exact Logic.I. Defined. Print f. (* Was enhancement request #5142 (error message reported on the most general return clause heuristic) *) Inductive gadt : Type -> Type := | gadtNat : nat -> gadt nat | gadtTy : forall T, T -> gadt T. Fail Definition gadt_id T (x: gadt T) : gadt T := match x with | gadtNat n => gadtNat n end. (* A variant of #5142 (see Satrajit Roy's example on coq-club (Oct 17, 2016)) *) Inductive type:Set:=Nat. Inductive tbinop:type->type->type->Set:= TPlus : tbinop Nat Nat Nat. Inductive texp:type->Set:= |TNConst:nat->texp Nat |TBinop:forall t1 t2 t, tbinop t1 t2 t->texp t1->texp t2->texp t. Definition typeDenote(t:type):Set:= match t with Nat => nat end. (* We expect a failure on TBinop *) Fail Fixpoint texpDenote t (e:texp t):typeDenote t:= match e with | TNConst n => n | TBinop t1 t2 _ b e1 e2 => O end. (* Test notations with local definitions in constructors *) Inductive J := D : forall n m, let p := n+m in nat -> J. Notation "{{ n , m , q }}" := (D n m q). Check fun x : J => let '{{n, m, _}} := x in n + m. Check fun x : J => let '{{n, m, p}} := x in n + m + p. (* Cannot use the notation because of the dependency in p *) Check fun x => let '(D n m p q) := x in n+m+p+q. (* This used to succeed, being interpreted as "let '{{n, m, p}} := ..." *) Fail Check fun x : J => let '{{n, m, _}} p := x in n + m + p. (* Test use of idents bound to ltac names in a "match" *) Lemma lem1 : forall k, k=k :>nat * nat. let x := fresh "aa" in let y := fresh "bb" in let z := fresh "cc" in let k := fresh "dd" in refine (fun k : nat * nat => match k as x return x = x with (y,z) => eq_refl end). Qed. Print lem1. Lemma lem2 : forall k, k=k :> bool. let x := fresh "aa" in let y := fresh "bb" in let z := fresh "cc" in let k := fresh "dd" in refine (fun k => if k as x return x = x then eq_refl else eq_refl). Qed. Print lem2. Lemma lem3 : forall k, k=k :>nat * nat. let x := fresh "aa" in let y := fresh "bb" in let z := fresh "cc" in let k := fresh "dd" in refine (fun k : nat * nat => let (y,z) as x return x = x := k in eq_refl). Qed. Print lem3. Lemma lem4 x : x+0=0. match goal with |- ?y = _ => pose (match y with 0 => 0 | S n => 0 end) end. match goal with |- ?y = _ => pose (match y as y with 0 => 0 | S n => 0 end) end. match goal with |- ?y = _ => pose (match y as y return y=y with 0 => eq_refl | S n => eq_refl end) end. match goal with |- ?y = _ => pose (match y return y=y with 0 => eq_refl | S n => eq_refl end) end. match goal with |- ?y + _ = _ => pose (match y with 0 => 0 | S n => 0 end) end. match goal with |- ?y + _ = _ => pose (match y as y with 0 => 0 | S n => 0 end) end. match goal with |- ?y + _ = _ => pose (match y as y return y=y with 0 => eq_refl | S n => eq_refl end) end. match goal with |- ?y + _ = _ => pose (match y return y=y with 0 => eq_refl | S n => eq_refl end) end. Show. Abort. Lemma lem5 (p:nat) : eq_refl p = eq_refl p. let y := fresh "n" in (* Checking that y is hidden *) let z := fresh "e" in (* Checking that z is hidden *) match goal with |- ?y = _ => pose (match y as y in _ = z return y=y /\ z=z with eq_refl => conj eq_refl eq_refl end) end. let y := fresh "n" in let z := fresh "e" in match goal with |- ?y = _ => pose (match y in _ = z return y=y /\ z=z with eq_refl => conj eq_refl eq_refl end) end. let y := fresh "n" in let z := fresh "e" in match goal with |- eq_refl ?y = _ => pose (match eq_refl y in _ = z return y=y /\ z=z with eq_refl => conj eq_refl eq_refl end) end. let p := fresh "p" in let z := fresh "e" in match goal with |- eq_refl ?p = _ => pose (match eq_refl p in _ = z return p=p /\ z=z with eq_refl => conj eq_refl eq_refl end) end. Show. Abort. Set Printing Allow Match Default Clause. (***************************************************) (* Testing strategy for factorizing cases branches *) (* Factorization + default clause *) Check fun x => match x with Eq => 1 | _ => 0 end. (* No factorization *) Unset Printing Factorizable Match Patterns. Check fun x => match x with Eq => 1 | _ => 0 end. Set Printing Factorizable Match Patterns. (* Factorization but no default clause *) Unset Printing Allow Match Default Clause. Check fun x => match x with Eq => 1 | _ => 0 end. Set Printing Allow Match Default Clause. (* No factorization in printing all mode *) Set Printing All. Check fun x => match x with Eq => 1 | _ => 0 end. Unset Printing All. (* Several clauses *) Inductive K := a1|a2|a3|a4|a5|a6. Check fun x => match x with a3 | a4 => 3 | _ => 2 end. Check fun x => match x with a3 => 3 | a2 | a1 => 4 | _ => 2 end. Check fun x => match x with a4 => 3 | a2 | a1 => 4 | _ => 2 end. Check fun x => match x with a3 | a4 | a1 => 3 | _ => 2 end. (* Test redundant clause within a disjunctive pattern *) Fail Check fun n m => match n, m with 0, 0 | _, S _ | S 0, _ | S (S _ | _), _ => false end. Module Bug11231. (* Missing dependency in computing if a clause is a default clause *) Inductive Tree: Set := | Node : Tree | App : Tree -> Tree -> Tree . Definition stray N := match N with | App (App Node (App (App Node Node) Node)) _ => Node | App (App Node strayvariable) _ => strayvariable | _ => Node end. Print stray. End Bug11231. Module Wish12762. Inductive foo := a | b | c. Definition bar (f : foo) := match f with | a => 0 | B => 1 end. End Wish12762. Module ConstructorArgumentsNumber. Arguments cons {A} _ _. Inductive J' A {B} (C:=(A*B)%type) (c:C) := D' : forall n {m}, let p := n+m in m=m -> J' A c. Unset Asymmetric Patterns. Fail Check fun x => match x with (y,z) w => y+z+w end. Fail Check fun x => match x with cons y z w => 0 | nil => 0 end. Fail Check fun x => match x with cons y => 0 | nil => 0 end. (* Missing a let-in to be in let-in mode *) Fail Check fun x => match x with D' _ _ n p e => 0 end. Check fun x : J' bool (true,true) => match x with D' _ _ n e => existT (fun x => eq x x) _ e end. Check fun x : J' bool (true,true) => match x with D' _ _ _ n p e => n+p end. Set Asymmetric Patterns. Fail Check fun x => match x with (y,z) w => y+z+w end. Fail Check fun x => match x with cons y z w => 0 | nil => 0 end. Fail Check fun x => match x with cons y => 0 | nil => 0 end. Fail Check fun x => match x with D' n _ => 0 end. Fail Check fun x => match x with D' n m p e _ => 0 end. Check fun x : J' bool (true,true) => match x with D' n m e => existT (fun x => eq x x) m e end. Check fun x : J' bool (true,true) => match x with D' n m p e => (n,p) end. End ConstructorArgumentsNumber. Module Bug14207. Inductive type {base_type : Type} := base (t : base_type) | arrow (s d : type). Global Arguments type : clear implicits. Fixpoint interp {base_type} (base_interp : base_type -> Type) (t : type base_type) : Type := match t with | base t => base_interp t | arrow s d => @interp _ base_interp s -> @interp _ base_interp d end. Axiom admit : forall {T}, T. Section with_base. Context {base_type : Type} {base_interp : base_type -> Type}. Local Notation type := (@type base_type). Fixpoint default {t} : interp base_interp t := match t with | base x => admit | arrow s d => fun _ => @default d end. End with_base. Definition c := match 0, 0 with | S (S x), y => 0 | x, S (S y) => 1 | x, y => 2 end. End Bug14207. Module Bug17071. Notation "x :||: l" := (true x l) (at level 51). Fail Check match true with | x :||: l => 0 end. End Bug17071. coq-8.20.0/test-suite/output/ClassMissingInstance.out000066400000000000000000000003211466560755400226640ustar00rootroot00000000000000File "./output/ClassMissingInstance.v", line 7, characters 0-28: The command has indeed failed with message: Could not find an instance for the following existential variables: ?arg_2 : Foo 1 ?arg_20 : Foo 2 coq-8.20.0/test-suite/output/ClassMissingInstance.v000066400000000000000000000002051466560755400223230ustar00rootroot00000000000000 Class Foo (n:nat) := {}. Axiom thing : forall n {_:Foo n}, nat. (* both missing args are reported *) Fail Goal thing 1 = thing 2. coq-8.20.0/test-suite/output/CoercionOnHole.out000066400000000000000000000004341466560755400214530ustar00rootroot00000000000000File "./output/CoercionOnHole.v", line 23, characters 17-20: The command has indeed failed with message: In environment e1, e2, v1 : expr IH1 : eval e1 v1 IHe2 : exists v : expr, eval e2 v The term "IH1" has type "eval e1 v1" while it is expected to have type "eval e1 (Const ?v1)". coq-8.20.0/test-suite/output/CoercionOnHole.v000066400000000000000000000007421466560755400211130ustar00rootroot00000000000000 Inductive expr := | Const: nat -> expr | Add: expr -> expr -> expr. Inductive eval: expr -> expr -> Prop := | EConst: forall n, eval (Const n) (Const n) | EAdd: forall e1 v1 e2 v2, eval e1 (Const v1) -> eval e2 (Const v2) -> eval (Add e1 e2) (Const (v1 + v2)). Coercion Const: nat >-> expr. Lemma eval_total: forall e, exists v, eval e v. Proof. induction e. - admit. - destruct IHe1 as [v1 IH1]. eexists. eapply EAdd. + Fail exact IH1. Abort. coq-8.20.0/test-suite/output/Coercions.out000066400000000000000000000001541466560755400205300ustar00rootroot00000000000000P x : Prop R x x : Prop fun (x : foo) (n : nat) => x n : foo -> nat -> nat "1" 0 : PAIR coq-8.20.0/test-suite/output/Coercions.v000066400000000000000000000012131466560755400201630ustar00rootroot00000000000000(* Submitted by Randy Pollack *) Record pred (S : Set) : Type := {sp_pred :> S -> Prop}. Record rel (S : Set) : Type := {sr_rel :> S -> S -> Prop}. Section testSection. Variables (S : Set) (P : pred S) (R : rel S) (x : S). Check (P x). Check (R x x). End testSection. (* Check the removal of coercions with target Funclass *) Record foo : Type := {D :> nat -> nat}. Check (fun (x : foo) (n : nat) => x n). (* Check both removal of coercions with target Funclass and mixing string and numeral scopes *) Require Import String. Open Scope string_scope. Inductive PAIR := P (s:string) (n:nat). Coercion P : string >-> Funclass. Check ("1" 0). coq-8.20.0/test-suite/output/CompactContexts.out000066400000000000000000000002131466560755400217160ustar00rootroot000000000000001 goal hP1 : True a : nat b : list nat h : forall x : nat, {y : nat | y > x} h2 : True ============================ False coq-8.20.0/test-suite/output/CompactContexts.v000066400000000000000000000002151466560755400213560ustar00rootroot00000000000000Set Printing Compact Contexts. Lemma f (hP1:True) (a:nat) (b:list nat) (h:forall (x:nat) , { y:nat | y > x}) (h2:True): False. Show. Abort. coq-8.20.0/test-suite/output/DebugFlags.out000066400000000000000000000003171466560755400206100ustar00rootroot00000000000000File "./output/DebugFlags.v", line 1, characters 0-33: Warning: There is no debug flag "ThisFlagDoesNotExist". [unknown-debug-flag,default] Debug: [Cbv] Unfolding Coq.Init.Datatypes.id = tt : unit coq-8.20.0/test-suite/output/DebugFlags.v000066400000000000000000000001101466560755400202350ustar00rootroot00000000000000Set Debug "ThisFlagDoesNotExist". Set Debug "Cbv". Eval cbv in id tt. coq-8.20.0/test-suite/output/DebugRelevances.out000066400000000000000000000024201466560755400216400ustar00rootroot00000000000000foo@{u} = fun (A : (* Relevant *) Type) (a : (* Relevant *) A) => a : forall A : (* Relevant *) Type, A -> A Arguments foo A%type_scope a foo'@{} = fun (A : (* Relevant *) Prop) (a : (* Relevant *) A) => a : forall A : (* Relevant *) Prop, A -> A Arguments foo' A%type_scope a bar@{} = fun (A : (* Relevant *) SProp) (a : (* Irrelevant *) A) => a : forall A : (* Relevant *) SProp, A -> A Arguments bar A%type_scope a baz@{s | u} = fun (A : (* Relevant *) Type) (a : (* s *) A) => a : forall A : (* Relevant *) Type, A -> A Arguments baz A%type_scope a boz@{s s' | u} = fun (A B : (* Relevant *) Type) (a : (* s *) hide) (_ : (* s' *) hide) => a : forall A B : (* Relevant *) Type, hide -> hide -> hide Arguments boz (A B)%type_scope a b 1 goal f := fun (A : (* Relevant *) Type) (_ : (* α8 *) A) => A : forall (A : (* Relevant *) Type) (_ : (* α8 *) A), Type ============================ True 1 goal f := fun (A : (* Relevant *) Type) (_ : (* Relevant *) A) => A : forall (A : (* Relevant *) Type) (_ : (* Relevant *) A), Type ============================ True let x := 0 in x : nat fix f (n : (* Relevant *) nat) : nat := 0 : nat -> nat match 0 with | 0 | _ => 0 end : nat fun v : (* Relevant *) R => p v : R -> nat coq-8.20.0/test-suite/output/DebugRelevances.v000066400000000000000000000022371466560755400213040ustar00rootroot00000000000000 Set Universe Polymorphism. Set Printing Relevance Marks. Definition foo (A:Type) (a:A) := a. Definition foo' (A:Prop) (a:A) := a. Definition bar (A:SProp) (a:A) := a. Definition baz@{s|u|} (A:Type@{s|u}) (a:A) := a. Definition hide@{s|u|} {A:Type@{s|u}} := A. Definition boz@{s s'|u|} (A:Type@{s|u}) (B:Type@{s'|u}) (a:@hide A) (b:@hide B) := a. Print foo. Print foo'. Print bar. Print baz. (* arguments a and b are printed separately because they have different relevances even though the types are printed the same (difference hidden by implicit arguments) *) Print boz. Inductive sFalse : SProp := . Goal True. Unset Printing Notations. (* arrow notation has no binder so relevance isn't printed *) pose (f:=fun A (a:A) => A). Show. let _ := constr:(f nat) in idtac. Show. Abort. Set Printing Notations. (* TODO print relevance of letin *) Check let x := 0 in x. (* TODO print relevance of fixpoints (should be fix f (* Relevant *) ...) *) Check fix f (n:nat) := 0. (* TODO print case relevance *) Check match 0 with 0 | _ => 0 end. (* TODO print primitive projection relevance *) Set Primitive Projections. Record R := { p : nat }. Check fun v => v.(p). coq-8.20.0/test-suite/output/DependentInductionErrors.out000066400000000000000000000006301466560755400235630ustar00rootroot00000000000000File "./output/DependentInductionErrors.v", line 3, characters 7-30: The command has indeed failed with message: Tactic failure: To use dependent destruction, first [Require Import Coq.Program.Equality.]. File "./output/DependentInductionErrors.v", line 4, characters 7-28: The command has indeed failed with message: Tactic failure: To use dependent induction, first [Require Import Coq.Program.Equality.]. coq-8.20.0/test-suite/output/DependentInductionErrors.v000066400000000000000000000005731466560755400232270ustar00rootroot00000000000000Theorem 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. coq-8.20.0/test-suite/output/Deprecation.out000066400000000000000000000012501466560755400210370ustar00rootroot00000000000000File "./output/Deprecation.v", line 5, characters 0-3: Warning: Tactic foo is deprecated since X.Y. Use idtac instead. [deprecated-tactic-since-X.Y,deprecated-since-X.Y,deprecated-tactic,deprecated,default] File "./output/Deprecation.v", line 17, characters 5-8: The command has indeed failed with message: Tactic foo is deprecated since X.Y. Use idtac instead. [deprecated-tactic-since-X.Y,deprecated-since-X.Y,deprecated-tactic,deprecated,default] File "./output/Deprecation.v", line 24, characters 0-3: Warning: Tactic bar is deprecated since library X.Y. Use baz instead. [deprecated-tactic-since-library-X.Y,deprecated-since-library-X.Y,deprecated-tactic,deprecated,default] coq-8.20.0/test-suite/output/Deprecation.v000066400000000000000000000005261466560755400205020ustar00rootroot00000000000000#[deprecated(since = "X.Y", note = "Use idtac instead.")] Ltac foo := idtac. Goal True. foo. Abort. Set Warnings "-deprecated-since-X.Y". Goal True. foo. Abort. Set Warnings "+deprecated-since-X.Y". Goal True. Fail foo. Abort. #[deprecated(since = "library X.Y", note = "Use baz instead.")] Ltac bar := idtac. Goal True. bar. Abort. coq-8.20.0/test-suite/output/Emacs_and_diffs.out000066400000000000000000000000001466560755400216170ustar00rootroot00000000000000coq-8.20.0/test-suite/output/Emacs_and_diffs.v000066400000000000000000000001441466560755400212660ustar00rootroot00000000000000(* coq-prog-args: ("-emacs") *) Set Diffs "on". (* verify this does not produce an error message *) coq-8.20.0/test-suite/output/EmptyExtraction.out000066400000000000000000000012101466560755400217350ustar00rootroot00000000000000 type empty_set = | Extracted code successfully compiled type empty_set = | type 'x not = 'x -> empty_set Extracted code successfully compiled type empty_set = | type 'x not = 'x -> empty_set (** val foo : 'a1 not not not -> 'a1 not **) let foo p q = p (fun r -> r q) Extracted code successfully compiled type empty = | Extracted code successfully compiled type empty = | (** val empty_rect : empty -> 'a1 **) let empty_rect _ = assert false (* absurd case *) Extracted code successfully compiled type empty = | (** val bar : empty -> 'a1 **) let bar _ = assert false (* absurd case *) Extracted code successfully compiled coq-8.20.0/test-suite/output/EmptyExtraction.v000066400000000000000000000017701466560755400214060ustar00rootroot00000000000000From Coq Require Extraction. (** Testing extraction of stdlib Empty_set *) Recursive Extraction Empty_set. Extraction TestCompile Empty_set. (** Testing extraction of a type level not *) Definition not : Type -> Type := fun X => X -> Empty_set. Recursive Extraction not. Extraction TestCompile not. (** Testing extraction of a simple proof using not but no elimination. *) Definition foo : forall X, not (not (not X)) -> not X. Proof. intros X. intros p q. apply p. intros r. apply r. exact q. Defined. Recursive Extraction foo. Extraction TestCompile foo. (** Testing extraction of a user defined Empty *) Inductive Empty : Set := . Recursive Extraction Empty. Extraction TestCompile Empty. (** Testing extraction of Empty eliminator *) Recursive Extraction Empty_rect. Extraction TestCompile Empty_rect. (** Testing extraction of an slightly different eliminator *) Definition bar : Empty -> forall A, A := fun x => Empty_rect _ x. Recursive Extraction bar. Extraction TestCompile bar. coq-8.20.0/test-suite/output/EqNotation.out000066400000000000000000000002471466560755400206700ustar00rootroot00000000000000File "./output/EqNotation.v", line 2, characters 21-26: The command has indeed failed with message: Cannot infer the implicit parameter A of eq whose type is "Type". coq-8.20.0/test-suite/output/EqNotation.v000066400000000000000000000001231466560755400203170ustar00rootroot00000000000000(* should mention "the implicit parameter A of eq" *) Fail Type (forall x, x = x). coq-8.20.0/test-suite/output/ErrorInCanonicalStructures.out000066400000000000000000000006361466560755400241050ustar00rootroot00000000000000File "./output/ErrorInCanonicalStructures.v", line 5, characters 0-29: The command has indeed failed with message: Could not declare a canonical structure Foo. Expected an instance of a record or structure. File "./output/ErrorInCanonicalStructures.v", line 7, characters 0-29: The command has indeed failed with message: Could not declare a canonical structure bar. Expected an instance of a record or structure. coq-8.20.0/test-suite/output/ErrorInCanonicalStructures.v000066400000000000000000000002201466560755400235300ustar00rootroot00000000000000Record Foo := MkFoo { field1 : nat; field2 : nat -> nat }. Definition bar := 99. Fail Canonical Structure Foo. Fail Canonical Structure bar. coq-8.20.0/test-suite/output/ErrorInModule.out000066400000000000000000000002531466560755400213320ustar00rootroot00000000000000File "./output/ErrorInModule.v", line 3, characters 25-36: The command has indeed failed with message: The reference nonexistent was not found in the current environment. coq-8.20.0/test-suite/output/ErrorInModule.v000066400000000000000000000001501466560755400207640ustar00rootroot00000000000000(* -*- mode: coq; coq-prog-args: ("-vos") -*- *) Module M. Fail Definition foo := nonexistent. End M. coq-8.20.0/test-suite/output/ErrorInSection.out000066400000000000000000000002541466560755400215120ustar00rootroot00000000000000File "./output/ErrorInSection.v", line 3, characters 25-36: The command has indeed failed with message: The reference nonexistent was not found in the current environment. coq-8.20.0/test-suite/output/ErrorInSection.v000066400000000000000000000001511466560755400211440ustar00rootroot00000000000000(* -*- mode: coq; coq-prog-args: ("-vos") -*- *) Section S. Fail Definition foo := nonexistent. End S. coq-8.20.0/test-suite/output/ErrorLocation_12152.out000066400000000000000000000004441466560755400221220ustar00rootroot00000000000000File "./output/ErrorLocation_12152.v", line 3, characters 5-12: The command has indeed failed with message: No product even after head-reduction. File "./output/ErrorLocation_12152.v", line 4, characters 5-13: The command has indeed failed with message: No product even after head-reduction. coq-8.20.0/test-suite/output/ErrorLocation_12152.v000066400000000000000000000001241466560755400215530ustar00rootroot00000000000000(* Reported in #12152 *) Goal True. Fail intro H; auto. Fail intros H; auto. Abort. coq-8.20.0/test-suite/output/ErrorLocation_12255.out000066400000000000000000000003201466560755400221170ustar00rootroot00000000000000File "./output/ErrorLocation_12255.v", line 4, characters 5-21: The command has indeed failed with message: Ltac variable x is bound to i > 0 of type constr which cannot be coerced to an evaluable reference. coq-8.20.0/test-suite/output/ErrorLocation_12255.v000066400000000000000000000001751466560755400215650ustar00rootroot00000000000000Ltac can_unfold x := let b := eval cbv delta [x] in x in idtac. Definition i := O. Goal False. Fail can_unfold (i>0). Abort. coq-8.20.0/test-suite/output/ErrorLocation_12774.out000066400000000000000000000007671466560755400221440ustar00rootroot00000000000000File "./output/ErrorLocation_12774.v", line 5, characters 18-19: The command has indeed failed with message: The term "0" has type "nat" while it is expected to have type "Type". File "./output/ErrorLocation_12774.v", line 6, characters 14-15: The command has indeed failed with message: The term "0" has type "nat" while it is expected to have type "Type". File "./output/ErrorLocation_12774.v", line 7, characters 5-6: The command has indeed failed with message: No product even after head-reduction. coq-8.20.0/test-suite/output/ErrorLocation_12774.v000066400000000000000000000001511466560755400215650ustar00rootroot00000000000000Ltac f := simpl. Ltac g := auto; intro. Goal Type. Fail simpl; exact 0. Fail f; exact 0. Fail g. Abort. coq-8.20.0/test-suite/output/ErrorLocation_13241.out000066400000000000000000000004431466560755400221210ustar00rootroot00000000000000File "./output/ErrorLocation_13241.v", line 5, characters 5-6: The command has indeed failed with message: No product even after head-reduction. File "./output/ErrorLocation_13241.v", line 13, characters 5-6: The command has indeed failed with message: No product even after head-reduction. coq-8.20.0/test-suite/output/ErrorLocation_13241.v000066400000000000000000000002561466560755400215610ustar00rootroot00000000000000Module Direct. Ltac a := intro. Ltac b := a. Goal True. Fail b. Abort. End Direct. Module Thunked. Ltac a _ := intro. Ltac b := a (). Goal True. Fail b. Abort. End Thunked. coq-8.20.0/test-suite/output/ErrorLocation_ltac.out000066400000000000000000000010321466560755400223650ustar00rootroot00000000000000File "./output/ErrorLocation_ltac.v", line 5, characters 12-16: The command has indeed failed with message: Tactic failure: Cannot solve this goal. File "./output/ErrorLocation_ltac.v", line 6, characters 12-13: The command has indeed failed with message: Tactic failure. File "./output/ErrorLocation_ltac.v", line 7, characters 12-15: The command has indeed failed with message: Not a negated primitive equality. File "./output/ErrorLocation_ltac.v", line 8, characters 27-28: The command has indeed failed with message: Tactic failure. coq-8.20.0/test-suite/output/ErrorLocation_ltac.v000066400000000000000000000002131466560755400220230ustar00rootroot00000000000000Ltac f := fail. Ltac inj := injection. Goal False. Fail idtac; easy. Fail idtac; f. Fail idtac; inj. Fail let x := fail in x || x. Abort. coq-8.20.0/test-suite/output/ErrorLocation_tac_in_term.out000066400000000000000000000021311466560755400237270ustar00rootroot00000000000000File "./output/ErrorLocation_tac_in_term.v", line 3, characters 11-14: The command has indeed failed with message: Illegal application (Non-functional construction): The expression "I" of type "True" cannot be applied to the term "I" : "True" File "./output/ErrorLocation_tac_in_term.v", line 8, characters 0-15: The command has indeed failed with message: Illegal application (Non-functional construction): The expression "I" of type "True" cannot be applied to the term "I" : "True" File "./output/ErrorLocation_tac_in_term.v", line 12, characters 16-19: The command has indeed failed with message: Illegal application (Non-functional construction): The expression "I" of type "True" cannot be applied to the term "I" : "True" File "./output/ErrorLocation_tac_in_term.v", line 17, characters 26-30: The command has indeed failed with message: The term "true" has type "bool" while it is expected to have type "nat". File "./output/ErrorLocation_tac_in_term.v", line 18, characters 17-25: The command has indeed failed with message: The term "true" has type "bool" while it is expected to have type "nat". coq-8.20.0/test-suite/output/ErrorLocation_tac_in_term.v000066400000000000000000000005401466560755400233670ustar00rootroot00000000000000Notation foo := (I I). Fail Check foo. Notation bar := (ltac:(exact (I I))) (only parsing). (* whole command: it would be nice to be more precise *) Fail Check bar. Notation baz x := (ltac:(exact x)) (only parsing). Fail Check baz (I I). Ltac f x y := apply (x y). Goal True. Fail apply ltac:(apply (S true)). Fail apply ltac:(f S true). Abort. coq-8.20.0/test-suite/output/ErrorModuleWith.out000066400000000000000000000012631466560755400217010ustar00rootroot00000000000000File "./output/ErrorModuleWith.v", line 5, characters 0-53: The command has indeed failed with message: No field named V in module A.B of M. File "./output/ErrorModuleWith.v", line 6, characters 0-53: The command has indeed failed with message: No field named C in module A of M. File "./output/ErrorModuleWith.v", line 7, characters 0-49: The command has indeed failed with message: No field named V in M. File "./output/ErrorModuleWith.v", line 8, characters 0-53: The command has indeed failed with message: Module A' of M not expected to be a functor. File "./output/ErrorModuleWith.v", line 13, characters 0-38: The command has indeed failed with message: Module M2 is not equal to M1. coq-8.20.0/test-suite/output/ErrorModuleWith.v000066400000000000000000000010571466560755400213400ustar00rootroot00000000000000Module Type T. Axiom U : Type. End T. Module Type S. Declare Module B : T. End S. Module Type S' (X : T). Axiom U' : Type. End S'. Module Type M. Declare Module A : S. Declare Module A' : S'. End M. Fail Module Type N := M with Definition A.B.V := nat. Fail Module Type N := M with Definition A.C.U := nat. Fail Module Type N := M with Definition V := nat. Fail Module Type N := M with Definition A'.U' := nat. Module M1. Axiom T : Type. End M1. Module M2. Axiom T : Type. End M2. Module Type V. Module N := M1. End V. Fail Module Q : V with Module N := M2. coq-8.20.0/test-suite/output/Error_msg_diffs.out000066400000000000000000000012511466560755400217150ustar00rootroot00000000000000File "./output/Error_msg_diffs.v", line 32, characters 5-16: The command has indeed failed with message: In environment T : Type p : T -> bool a : T t1, t2 : btree T IH1 : count p (rev_tree t1) = count p t1 IH2 : count p (rev_tree t2) = count p t2 Unable to unify "(if p a then 1 else 0) + (count p t1 + count p t2)" with "(if p a then 1 else 0) + (count p t2 + count p t1)". coq-8.20.0/test-suite/output/Error_msg_diffs.v000066400000000000000000000016151466560755400213570ustar00rootroot00000000000000(* coq-prog-args: ("-color" "on" "-diffs" "on" "-async-proofs" "off") *) (* Re: -async-proofs off, see https://github.com/coq/coq/issues/9671 *) (* Shows diffs in an error message for an "Unable to unify" error *) Require Import Arith List Bool. Inductive btree (T : Type) : Type := Leaf | Node (val : T) (t1 t2 : btree T). Arguments Leaf {T}. Arguments Node {T}. Fixpoint rev_tree {T : Type} (t : btree T) : btree T := match t with | Leaf => Leaf | Node x t1 t2 => Node x (rev_tree t2) (rev_tree t1) end. Fixpoint count {T : Type} (p : T -> bool) (t : btree T) : nat := match t with | Leaf => 0 | Node x t1 t2 => (if p x then 1 else 0) + (count p t1 + count p t2) end. Lemma count_rev_tree {T} (p : T -> bool) t : count p (rev_tree t) = count p t. Proof. induction t as [ | a t1 IH1 t2 IH2]. easy. simpl. rewrite IH1. rewrite IH2. Fail reflexivity. rewrite (Nat.add_comm (count p t2)). easy. Qed. coq-8.20.0/test-suite/output/Errors.out000066400000000000000000000035041466560755400200620ustar00rootroot00000000000000File "./output/Errors.v", line 12, characters 0-11: The command has indeed failed with message: The field t is missing in Errors.M. File "./output/Errors.v", line 19, characters 18-19: The command has indeed failed with message: Unable to unify "nat" with "True". File "./output/Errors.v", line 20, characters 12-15: The command has indeed failed with message: Unable to unify "nat" with "True". In nested Ltac calls to "f" and "apply x", last call failed. File "./output/Errors.v", line 29, characters 21-30: The command has indeed failed with message: Instance is not well-typed in the environment of ?x. Ltac call to "instantiate ( (ident) := (lglob) )" failed. File "./output/Errors.v", line 34, characters 19-20: The command has indeed failed with message: Cannot infer ?T in the partial instance "?T -> nat" found for the type of f. File "./output/Errors.v", line 35, characters 22-24: The command has indeed failed with message: Cannot infer ?T in the partial instance "?T -> nat" found for the implicit parameter A of id whose type is "Type". File "./output/Errors.v", line 36, characters 17-18: The command has indeed failed with message: Cannot infer ?T in the partial instance "forall x : nat, ?T" found for the type of f in environment: x : nat File "./output/Errors.v", line 44, characters 5-23: The command has indeed failed with message: The first term has type "nat" while the second term has incompatible type "bool". File "./output/Errors.v", line 49, characters 7-24: The command has indeed failed with message: Replacement would lead to an ill-typed term: Illegal application: The term "@eq" of type "forall A : Type, A -> A -> Prop" cannot be applied to the terms "Set" : "Type" "n" : "Type" "n" : "Type" The 2nd term has type "Type" which should be a subtype of "Set". (universe inconsistency: Cannot enforce Errors.27 <= Set) coq-8.20.0/test-suite/output/Errors.v000066400000000000000000000017411466560755400175210ustar00rootroot00000000000000(* coq-prog-args: ("-top" "Errors") *) (* Test error messages *) Set Ltac Backtrace. (* Test non-regression of bug fixed in r13486 (bad printer for module names) *) Module Type S. Parameter t:Type. End S. Module M : S. Fail End M. (* A simple check of how Ltac trace are used or not *) (* Unfortunately, cannot test error location... *) Ltac f x := apply x. Goal True. Fail simpl; apply 0. Fail simpl; f 0. Abort. (* Test instantiate error messages *) Goal forall T1 (P1 : T1 -> Type), sigT P1 -> sigT P1. intros T1 P1 H1. eexists ?[x]. destruct H1 as [x1 H1]. Fail instantiate (x:=projT1 x1). Abort. (* Test some messages for non solvable evars *) Fail Goal forall a f, f a = 0. Fail Goal forall f x, id f x = 0. Fail Goal forall f P, P (f 0). Definition t := unit. End M. Module Change. Goal 0 = 0. Fail change 0 with true. Abort. Goal nat = nat. pose (nat : Type) as n. Fail change nat with n. (* Error: Replacement would lead to an ill-typed term. *) Abort. End Change. coq-8.20.0/test-suite/output/Existentials.out000066400000000000000000000003651466560755400212640ustar00rootroot00000000000000Existential 1 = ?Goal : [p : nat q := S p : nat n : nat m : nat |- ?y = m] Existential 2 = ?y : [p : nat q := S p : nat n : nat m : nat |- nat] (p, q cannot be used) (shelved) Existential 3 = ?Goal0 : [q : nat n : nat m : nat |- n = ?y] coq-8.20.0/test-suite/output/Existentials.v000066400000000000000000000003621466560755400207170ustar00rootroot00000000000000(* Test propagation of clear/clearbody in existential variables *) Section Test. Variable p:nat. Let q := S p. Goal forall n m:nat, n = m. intros. eapply eq_trans. clearbody q. clear p. (* Error ... *) Show Existentials. Abort. End Test. coq-8.20.0/test-suite/output/ExistingInstance.out000066400000000000000000000000731466560755400220630ustar00rootroot00000000000000Debug: [vernacinterp] interpreting: Existing Instances x y coq-8.20.0/test-suite/output/ExistingInstance.v000066400000000000000000000001361466560755400215210ustar00rootroot00000000000000Class A := {}. Axioms x y : A. Set Debug "vernacinterp". #[ local ] Existing Instances x y. coq-8.20.0/test-suite/output/ExtractionString.out000066400000000000000000000051161466560755400221160ustar00rootroot00000000000000(** val str : string **) let str = String ((Ascii (False, False, True, False, True, False, True, False)), (String ((Ascii (False, False, False, True, False, True, True, False)), (String ((Ascii (True, False, False, True, False, True, True, False)), (String ((Ascii (True, True, False, False, True, True, True, False)), (String ((Ascii (False, False, False, False, False, True, False, False)), (String ((Ascii (True, False, False, True, False, True, True, False)), (String ((Ascii (True, True, False, False, True, True, True, False)), (String ((Ascii (False, False, False, False, False, True, False, False)), (String ((Ascii (True, False, False, False, False, True, True, False)), (String ((Ascii (False, False, False, False, False, True, False, False)), (String ((Ascii (True, True, False, False, True, True, True, False)), (String ((Ascii (False, False, True, False, True, True, True, False)), (String ((Ascii (False, True, False, False, True, True, True, False)), (String ((Ascii (True, False, False, True, False, True, True, False)), (String ((Ascii (False, True, True, True, False, True, True, False)), (String ((Ascii (True, True, True, False, False, True, True, False)), EmptyString))))))))))))))))))))))))))))))) str :: String str = String0 (Ascii False False True False True False True False) (String0 (Ascii False False False True False True True False) (String0 (Ascii True False False True False True True False) (String0 (Ascii True True False False True True True False) (String0 (Ascii False False False False False True False False) (String0 (Ascii True False False True False True True False) (String0 (Ascii True True False False True True True False) (String0 (Ascii False False False False False True False False) (String0 (Ascii True False False False False True True False) (String0 (Ascii False False False False False True False False) (String0 (Ascii True True False False True True True False) (String0 (Ascii False False True False True True True False) (String0 (Ascii False True False False True True True False) (String0 (Ascii True False False True False True True False) (String0 (Ascii False True True True False True True False) (String0 (Ascii True True True False False True True False) EmptyString))))))))))))))) (** val str : char list **) let str = 'T'::('h'::('i'::('s'::(' '::('i'::('s'::(' '::('a'::(' '::('s'::('t'::('r'::('i'::('n'::('g'::[]))))))))))))))) (** val str : string **) let str = "This is a string" str :: Prelude.String str = "This is a string" coq-8.20.0/test-suite/output/ExtractionString.v000066400000000000000000000011271466560755400215520ustar00rootroot00000000000000Require Import String Extraction. Definition str := "This is a string"%string. (* Raw extraction of strings, in OCaml *) Extraction Language OCaml. Extraction str. (* Raw extraction of strings, in Haskell *) Extraction Language Haskell. Extraction str. (* Extraction to char list, in OCaml *) Require Import ExtrOcamlString. Extraction Language OCaml. Extraction str. (* Extraction to native strings, in OCaml *) Require Import ExtrOcamlNativeString. Extraction str. (* Extraction to native strings, in Haskell *) Require Import ExtrHaskellString. Extraction Language Haskell. Extraction str. coq-8.20.0/test-suite/output/Extraction_Haskell_String_12258.out000066400000000000000000000034171466560755400244630ustar00rootroot00000000000000{-# OPTIONS_GHC -cpp -XMagicHash #-} {- For Hugs, use the option -F"cpp -P -traditional" -} {- IMPORTANT: If you change this file, make sure that running [cp Extraction_Haskell_String_12258.out Extraction_Haskell_String_12258.hs && ghc -o test Extraction_Haskell_String_12258.hs] succeeds -} module Main where import qualified Prelude #ifdef __GLASGOW_HASKELL__ import qualified GHC.Base #if __GLASGOW_HASKELL__ >= 900 import qualified GHC.Exts #endif #else -- HUGS import qualified IOExts #endif #ifdef __GLASGOW_HASKELL__ unsafeCoerce :: a -> b #if __GLASGOW_HASKELL__ >= 900 unsafeCoerce = GHC.Exts.unsafeCoerce# #else unsafeCoerce = GHC.Base.unsafeCoerce# #endif #else -- HUGS unsafeCoerce :: a -> b unsafeCoerce = IOExts.unsafeCoerce #endif #ifdef __GLASGOW_HASKELL__ type Any = GHC.Base.Any #else -- HUGS type Any = () #endif data Output_type_code = Ascii_dec | Ascii_eqb | String_dec | String_eqb | Byte_eqb | Byte_eq_dec type Output_type = Any output :: Output_type_code -> Output_type output c = case c of { Ascii_dec -> unsafeCoerce ((Prelude.==) :: Prelude.Char -> Prelude.Char -> Prelude.Bool); Ascii_eqb -> unsafeCoerce ((Prelude.==) :: Prelude.Char -> Prelude.Char -> Prelude.Bool); String_dec -> unsafeCoerce ((Prelude.==) :: Prelude.String -> Prelude.String -> Prelude.Bool); String_eqb -> unsafeCoerce ((Prelude.==) :: Prelude.String -> Prelude.String -> Prelude.Bool); Byte_eqb -> unsafeCoerce ((Prelude.==) :: Prelude.Char -> Prelude.Char -> Prelude.Bool); Byte_eq_dec -> unsafeCoerce ((Prelude.==) :: Prelude.Char -> Prelude.Char -> Prelude.Bool)} type Coq__IO a = GHC.Base.IO a main :: GHC.Base.IO () main = ((Prelude.>>=) (GHC.Base.return output) (\_ -> GHC.Base.return ())) coq-8.20.0/test-suite/output/Extraction_Haskell_String_12258.v000066400000000000000000000034761466560755400241260ustar00rootroot00000000000000Require Import Coq.extraction.Extraction. Require Import Coq.extraction.ExtrHaskellString. Extraction Language Haskell. Set Extraction File Comment "IMPORTANT: If you change this file, make sure that running [cp Extraction_Haskell_String_12258.out Extraction_Haskell_String_12258.hs && ghc -o test Extraction_Haskell_String_12258.hs] succeeds". Inductive output_type_code := | ascii_dec | ascii_eqb | string_dec | string_eqb | byte_eqb | byte_eq_dec . Definition output_type_sig (c : output_type_code) : { T : Type & T } := existT (fun T => T) _ match c return match c with ascii_dec => _ | _ => _ end with | ascii_dec => Ascii.ascii_dec | ascii_eqb => Ascii.eqb | string_dec => String.string_dec | string_eqb => String.eqb | byte_eqb => Byte.eqb | byte_eq_dec => Byte.byte_eq_dec end. Definition output_type (c : output_type_code) := Eval cbv [output_type_sig projT1 projT2] in projT1 (output_type_sig c). Definition output (c : output_type_code) : output_type c := Eval cbv [output_type_sig projT1 projT2] in match c return output_type c with | ascii_dec as c | _ as c => projT2 (output_type_sig c) end. Axiom IO_unit : Set. Axiom _IO : Set -> Set. Axiom _IO_bind : forall {A B}, _IO A -> (A -> _IO B) -> _IO B. Axiom _IO_return : forall {A : Set}, A -> _IO A. Axiom cast_io : _IO unit -> IO_unit. Extract Constant _IO "a" => "GHC.Base.IO a". Extract Inlined Constant _IO_bind => "(Prelude.>>=)". Extract Inlined Constant _IO_return => "GHC.Base.return". Extract Inlined Constant IO_unit => "GHC.Base.IO ()". Extract Inlined Constant cast_io => "". Definition main : IO_unit := cast_io (_IO_bind (_IO_return output) (fun _ => _IO_return tt)). Recursive Extraction main. coq-8.20.0/test-suite/output/Extraction_ffi.out000066400000000000000000000014541466560755400215540ustar00rootroot00000000000000File "./output/Extraction_ffi.v", line 15, characters 0-18: Warning: The following axiom must be realized in the extracted code: ax_fun. [extraction-axiom-to-realize,extraction,default] (** val ax_fun : nat -> nat **) let ax_fun = failwith "AXIOM TO BE REALIZED (Extraction_ffi.ax_fun)" (** User defined extraction *) (** val ax_fun : nat -> nat **) external ax_fun: nat -> nat = "my_c_fun" (** val exact_fun : nat -> nat **) let exact_fun a = add (ax_fun a) (S O) (** User defined extraction *) (** val exact_fun : nat -> nat **) external exact_fun: nat -> nat = "my_exact_c_fun" (** val exact_fun2 : nat -> nat **) let exact_fun2 a = add (ax_fun a) (S O) let () = Stdlib.Callback.register "call_exact_fun" exact_fun2 (** val exact_fun2 : nat -> nat **) let exact_fun2 a = add (ax_fun a) (S O) coq-8.20.0/test-suite/output/Extraction_ffi.v000066400000000000000000000017441466560755400212140ustar00rootroot00000000000000(* @eladrion's example for issue #18212 *) From Coq Require Extraction. (* Define an axiomatic function. *) Axiom ax_fun : nat -> nat. (* Define a fully specified function*) Definition exact_fun (a : nat) := (ax_fun a) + 1. (* Define duplicate of the fully specified function*) Definition exact_fun2 (a : nat) := (ax_fun a) + 1. (* before we give the directive axioms produce failwith "axiom to be realized" *) Extraction ax_fun. (* ax_fun shall be a FFI call to the C function my_c_fun *) Extract Foreign Constant ax_fun => "my_c_fun". Extraction ax_fun. (* Extract exact_fun *) Extraction exact_fun. (* exact_fun shall now be a FFI call to the C function my_c_fun *) Extract Foreign Constant exact_fun => "my_exact_c_fun". Extraction exact_fun. (* Now, exact_fun is an entry point exposed to C *) Extract Callback "call_exact_fun" exact_fun2. Extraction exact_fun2. (* Now we make sure that a callback registration can be reverted *) Reset Extraction Callback. Extraction exact_fun2. coq-8.20.0/test-suite/output/Extraction_infix.out000066400000000000000000000004271466560755400221240ustar00rootroot00000000000000(** val test : foo **) let test = (fun (b, p) -> bar) (True, False) (** val test : foo **) let test = True@@?False (** val test : foo **) let test = True#^^False (** val test : foo **) let test = True@?:::False (** val test : foo **) let test = True @?::: False coq-8.20.0/test-suite/output/Extraction_infix.v000066400000000000000000000011571466560755400215630ustar00rootroot00000000000000(* @herbelin's example for issue #6212 *) Require Import Extraction. Inductive I := C : bool -> bool -> I. Definition test := C true false. (* the parentheses around the function wrong signalled an infix operator *) Extract Inductive I => "foo" [ "(fun (b, p) -> bar)" ]. Extraction test. (* some bonafide infix operators *) Extract Inductive I => "foo" [ "(@@?)" ]. Extraction test. Extract Inductive I => "foo" [ "(#^^)" ]. Extraction test. Extract Inductive I => "foo" [ "(@?:::)" ]. Extraction test. (* allow whitespace around infix operator *) Extract Inductive I => "foo" [ "( @?::: )" ]. Extraction test. coq-8.20.0/test-suite/output/Extraction_matchs_2413.out000066400000000000000000000020421466560755400227320ustar00rootroot00000000000000(** val test1 : bool -> bool **) let test1 b = b (** val test2 : bool -> bool **) let test2 _ = False (** val wrong_id : 'a1 hole -> 'a2 hole **) let wrong_id = function | Hole -> Hole | Hole2 -> Hole2 (** val test3 : 'a1 option -> 'a1 option **) let test3 o = o (** val test4 : indu -> indu **) let test4 = function | A m -> A (S m) | x -> x (** val test5 : indu -> indu **) let test5 = function | A m -> A (S m) | _ -> B (** val test6 : indu' -> indu' **) let test6 = function | A' m -> A' (S m) | E' -> B' | F' -> B' | _ -> C' (** val test7 : indu -> nat option **) let test7 = function | A m -> Some m | _ -> None (** val decode_cond_mode : (word -> opcode option) -> (word -> 'a1 decoder_result) -> word -> ('a1 -> opcode -> 'a2) -> 'a2 decoder_result **) let decode_cond_mode condition f w g = match condition w with | Some oc -> (match f w with | DecUndefined -> DecUndefined | DecUnpredictable -> DecUnpredictable | DecInst i -> DecInst (g i oc) | DecError m -> DecError m) | None -> DecUndefined coq-8.20.0/test-suite/output/Extraction_matchs_2413.v000066400000000000000000000053321466560755400223750ustar00rootroot00000000000000(** Extraction : tests of optimizations of pattern matching *) Require Coq.extraction.Extraction. (** First, a few basic tests *) Definition test1 b := match b with | true => true | false => false end. Extraction test1. (** should be seen as the identity *) Definition test2 b := match b with | true => false | false => false end. Extraction test2. (** should be seen a the always-false constant function *) Inductive hole (A:Set) : Set := Hole | Hole2. Definition wrong_id (A B : Set) (x:hole A) : hole B := match x with | Hole _ => @Hole _ | Hole2 _ => @Hole2 _ end. Extraction wrong_id. (** should _not_ be optimized as an identity *) Definition test3 (A:Type)(o : option A) := match o with | Some x => Some x | None => None end. Extraction test3. (** Even with type parameters, should be seen as identity *) Inductive indu : Type := A : nat -> indu | B | C. Definition test4 n := match n with | A m => A (S m) | B => B | C => C end. Extraction test4. (** should merge branchs B C into a x->x *) Definition test5 n := match n with | A m => A (S m) | B => B | C => B end. Extraction test5. (** should merge branches B C into _->B *) Inductive indu' : Type := A' : nat -> indu' | B' | C' | D' | E' | F'. Definition test6 n := match n with | A' m => A' (S m) | B' => C' | C' => C' | D' => C' | E' => B' | F' => B' end. Extraction test6. (** should merge some branches into a _->C' *) (** NB : In Coq, "| a => a" corresponds to n, hence some "| _ -> n" are extracted *) Definition test7 n := match n with | A m => Some m | B => None | C => None end. Extraction test7. (** should merge branches B,C into a _->None *) (** Script from bug #2413 *) Set Implicit Arguments. Section S. Definition message := nat. Definition word := nat. Definition mode := nat. Definition opcode := nat. Variable condition : word -> option opcode. Section decoder_result. Variable inst : Type. Inductive decoder_result : Type := | DecUndefined : decoder_result | DecUnpredictable : decoder_result | DecInst : inst -> decoder_result | DecError : message -> decoder_result. End decoder_result. Definition decode_cond_mode (mode : Type) (f : word -> decoder_result mode) (w : word) (inst : Type) (g : mode -> opcode -> inst) : decoder_result inst := match condition w with | Some oc => match f w with | DecInst i => DecInst (g i oc) | DecError _ m => @DecError inst m | DecUndefined _ => @DecUndefined inst | DecUnpredictable _ => @DecUnpredictable inst end | None => @DecUndefined inst end. End S. Extraction decode_cond_mode. (** inner match should not be factorized with a partial x->x (different type) *) coq-8.20.0/test-suite/output/Fixpoint.out000066400000000000000000000031121466560755400204010ustar00rootroot00000000000000fix F (A B : Set) (f : A -> B) (l : list A) {struct l} : list B := match l with | nil => nil | a :: l0 => f a :: F A B f l0 end : forall A B : Set, (A -> B) -> list A -> list B let fix f (m : nat) : nat := match m with | 0 => 0 | S m' => f m' end in f 0 : nat Ltac f id1 id2 := fix id1 2 with (id2 (n:_) (H:odd n) {struct H} : n >= 1) = cofix inf : Inf := {| projS := inf |} : Inf File "./output/Fixpoint.v", line 57, characters 0-51: Warning: Not a truly recursive fixpoint. [non-recursive,fixpoints,default] File "./output/Fixpoint.v", line 60, characters 0-103: Warning: Not a fully mutually defined fixpoint (k1 depends on k2 but not conversely). Well-foundedness check may fail unexpectedly. [non-full-mutual,fixpoints,default] File "./output/Fixpoint.v", line 62, characters 0-106: Warning: Not a fully mutually defined fixpoint (l2 and l1 are not mutually dependent). Well-foundedness check may fail unexpectedly. [non-full-mutual,fixpoints,default] File "./output/Fixpoint.v", line 64, characters 0-103: Warning: Not a fully mutually defined fixpoint (m2 and m1 are not mutually dependent). Well-foundedness check may fail unexpectedly. [non-full-mutual,fixpoints,default] File "./output/Fixpoint.v", line 72, characters 0-25: Warning: Not a truly recursive cofixpoint. [non-recursive,fixpoints,default] File "./output/Fixpoint.v", line 75, characters 0-48: Warning: Not a fully mutually defined cofixpoint (a2 and a1 are not mutually dependent). [non-full-mutual,fixpoints,default] coq-8.20.0/test-suite/output/Fixpoint.v000066400000000000000000000041521466560755400200440ustar00rootroot00000000000000Require Import List. Check (fix F (A B : Set) (f : A -> B) (l : list A) {struct l} : list B := match l with | nil => nil | a :: l => f a :: F _ _ f l end). (* V8 printing of this term used to failed in V8.0 and V8.0pl1 (cf BZ#860) *) Check let fix f (m : nat) : nat := match m with | O => 0 | S m' => f m' end in f 0. Require Import ZArith_base Lia. Open Scope Z_scope. Inductive even: Z -> Prop := | even_base: even 0 | even_succ: forall n, odd (n - 1) -> even n with odd: Z -> Prop := | odd_succ: forall n, even (n - 1) -> odd n. (* Check printing of fix *) Ltac f id1 id2 := fix id1 2 with (id2 n (H:odd n) {struct H} : n >= 1). Print Ltac f. (* Incidentally check use of fix in proofs *) Lemma even_pos_odd_pos: forall n, even n -> n >= 0. Proof. fix even_pos_odd_pos 2 with (odd_pos_even_pos n (H:odd n) {struct H} : n >= 1). intros. destruct H. lia. apply odd_pos_even_pos in H. lia. intros. destruct H. apply even_pos_odd_pos in H. lia. Qed. CoInductive Inf := IS { projS : Inf }. Definition expand_Inf (x : Inf) := IS (projS x). CoFixpoint inf := IS inf. Eval compute in inf. Module Recursivity. Open Scope nat_scope. Fixpoint f n := match n with 0 => 0 | S n => f n end. Fixpoint g n := match n with 0 => 0 | S n => n end. Fixpoint h1 n := match n with 0 => 0 | S n => h2 n end with h2 n := match n with 0 => 0 | S n => h1 n end. Fixpoint k1 n := match n with 0 => 0 | S n => k2 n end with k2 n := match n with 0 => 0 | S n => n end. Fixpoint l1 n := match n with 0 => 0 | S n => l1 n end with l2 n := match n with 0 => 0 | S n => l2 n end. Fixpoint m1 n := match n with 0 => 0 | S n => m1 n end with m2 n := match n with 0 => 0 | S n => n end. (* Why not to allow this definition ? Fixpoint h1' n := match n with 0 => 0 | S n => h2' n end with h2' n := h1' n. *) CoInductive S := cons : nat -> S -> S. CoFixpoint c := cons 0 c. CoFixpoint d := cons 0 c. CoFixpoint e1 := cons 0 e2 with e2 := cons 1 e1. CoFixpoint a1 := cons 0 a1 with a2 := cons 1 a2. (* Why not to allow this definition ? CoFixpoint b1 := cons 0 b2 with b2 := b1. *) End Recursivity. coq-8.20.0/test-suite/output/FloatExtraction.out000066400000000000000000000047761466560755400217300ustar00rootroot00000000000000File "./output/FloatExtraction.v", line 25, characters 8-12: Warning: The constant 0.01 is not a binary64 floating-point value. A closest value 0x1.47ae147ae147bp-7 will be used and unambiguously printed 0.01. [inexact-float,parsing,default] File "./output/FloatExtraction.v", line 25, characters 20-25: Warning: The constant -0.01 is not a binary64 floating-point value. A closest value -0x1.47ae147ae147bp-7 will be used and unambiguously printed -0.01. [inexact-float,parsing,default] File "./output/FloatExtraction.v", line 25, characters 27-35: Warning: The constant 1.7e+308 is not a binary64 floating-point value. A closest value 0x1.e42d130773b76p+1023 will be used and unambiguously printed 1.6999999999999999e+308. [inexact-float,parsing,default] File "./output/FloatExtraction.v", line 25, characters 37-46: Warning: The constant -1.7e-308 is not a binary64 floating-point value. A closest value -0x0.c396c98f8d899p-1022 will be used and unambiguously printed -1.7000000000000002e-308. [inexact-float,parsing,default] (** val infinity : Float64.t **) let infinity = (Float64.of_float (infinity)) (** val neg_infinity : Float64.t **) let neg_infinity = (Float64.of_float (neg_infinity)) (** val nan : Float64.t **) let nan = (Float64.of_float (nan)) (** val one : Float64.t **) let one = (Float64.of_float (0x1p+0)) (** val zero : Float64.t **) let zero = (Float64.of_float (0x0p+0)) (** val two : Float64.t **) let two = (Float64.of_float (0x1p+1)) (** val list_floats : Float64.t list **) let list_floats = nan :: (infinity :: (neg_infinity :: (zero :: (one :: (two :: ((Float64.of_float (0x1p-1)) :: ((Float64.of_float (0x1.47ae147ae147bp-7)) :: ((Float64.of_float (-0x1p-1)) :: ((Float64.of_float (-0x1.47ae147ae147bp-7)) :: ((Float64.of_float (0x1.e42d130773b76p+1023)) :: ((Float64.of_float (-0x0.c396c98f8d899p-1022)) :: []))))))))))) (** val sqrt : Float64.t -> Float64.t **) let sqrt = Float64.sqrt (** val opp : Float64.t -> Float64.t **) let opp = Float64.opp (** val mul : Float64.t -> Float64.t -> Float64.t **) let mul = Float64.mul (** val sub : Float64.t -> Float64.t -> Float64.t **) let sub = Float64.sub (** val div : Float64.t -> Float64.t -> Float64.t **) let div = Float64.div (** val discr : Float64.t -> Float64.t -> Float64.t -> Float64.t **) let discr a b c = sub (mul b b) (mul (mul (Float64.of_float (0x1p+2)) a) c) (** val x1 : Float64.t -> Float64.t -> Float64.t -> Float64.t **) let x1 a b c = div (sub (opp b) (sqrt (discr a b c))) (mul (Float64.of_float (0x1p+1)) a) coq-8.20.0/test-suite/output/FloatExtraction.v000066400000000000000000000025231466560755400213520ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* list [ "[]" "( :: )" ]. Local Open Scope float_scope. (* Avoid exponents with less than three digits as they are usually displayed with two digits (1e7 is displayed 1e+07) except on Windows where three digits are used (1e+007). *) Definition list_floats := [nan; infinity; neg_infinity; zero; one; two; 0.5; 0.01; -0.5; -0.01; 1.7e+308; -1.7e-308]. Recursive Extraction list_floats. Definition discr a b c := b * b - 4.0 * a * c. Definition x1 a b c := (- b - sqrt (discr a b c)) / (2.0 * a). Recursive Extraction x1. coq-8.20.0/test-suite/output/FloatNumberSyntax.out000066400000000000000000000053721466560755400222400ustar00rootroot000000000000002%float : float 2.5%float : float (-2.5)%float : float File "./output/FloatNumberSyntax.v", line 9, characters 6-13: Warning: The constant 2.5e123 is not a binary64 floating-point value. A closest value 0x1.e412f0f768fadp+409 will be used and unambiguously printed 2.4999999999999999e+123. [inexact-float,parsing,default] 2.4999999999999999e+123%float : float File "./output/FloatNumberSyntax.v", line 10, characters 7-16: Warning: The constant -2.5e-123 is not a binary64 floating-point value. A closest value -0x1.a71368f0f3047p-408 will be used and unambiguously printed -2.5000000000000001e-123. [inexact-float,parsing,default] (-2.5000000000000001e-123)%float : float (2 + 2)%float : float (2.5 + 2.5)%float : float 2 : float 2.5 : float -2.5 : float File "./output/FloatNumberSyntax.v", line 19, characters 6-13: Warning: The constant 2.5e123 is not a binary64 floating-point value. A closest value 0x1.e412f0f768fadp+409 will be used and unambiguously printed 2.4999999999999999e+123. [inexact-float,parsing,default] 2.4999999999999999e+123 : float File "./output/FloatNumberSyntax.v", line 20, characters 7-16: Warning: The constant -2.5e-123 is not a binary64 floating-point value. A closest value -0x1.a71368f0f3047p-408 will be used and unambiguously printed -2.5000000000000001e-123. [inexact-float,parsing,default] -2.5000000000000001e-123 : float 2 + 2 : float 2.5 + 2.5 : float -26 : float 11.171875 : float -6882 : float 44.6875 : float 2860 : float -2.79296875 : float File "./output/FloatNumberSyntax.v", line 30, characters 6-11: Warning: The constant 1e309 is not a binary64 floating-point value. A closest value infinity will be used and unambiguously printed infinity. [inexact-float,parsing,default] infinity : float File "./output/FloatNumberSyntax.v", line 31, characters 6-12: Warning: The constant -1e309 is not a binary64 floating-point value. A closest value neg_infinity will be used and unambiguously printed neg_infinity. [inexact-float,parsing,default] neg_infinity : float 0x1p-1 : float 0.5 : float 0x1p-1 : float 0.5 : float 2 : nat 2%float : float File "./output/FloatNumberSyntax.v", line 47, characters 0-35: Warning: Overwriting previous delimiting key float in scope float_scope [overwriting-delimiting-key,parsing,default] t = 2%flt : float File "./output/FloatNumberSyntax.v", line 50, characters 0-35: Warning: Overwriting previous delimiting key nat in scope nat_scope [overwriting-delimiting-key,parsing,default] File "./output/FloatNumberSyntax.v", line 50, characters 0-35: Warning: Hiding binding of key float to float_scope [hiding-delimiting-key,parsing,default] t = 2%flt : float 2 : nat 2 : float coq-8.20.0/test-suite/output/FloatNumberSyntax.v000066400000000000000000000016721466560755400216750ustar00rootroot00000000000000Require Import Floats. Check 2%float. Check 2.5%float. Check (-2.5)%float. (* Avoid exponents with less than three digits as they are usually displayed with two digits (1e7 is displayed 1e+07) except on Windows where three digits are used (1e+007). *) Check 2.5e123%float. Check (-2.5e-123)%float. Check (2 + 2)%float. Check (2.5 + 2.5)%float. Open Scope float_scope. Check 2. Check 2.5. Check (-2.5). Check 2.5e123. Check (-2.5e-123). Check (2 + 2). Check (2.5 + 2.5). Check -0x1a. Check 0xb.2c. Check -0x1ae2. Check 0xb.2cp2. Check 0xb.2cp8. Check -0xb.2cp-2. Check 1e309. Check -1e309. Set Printing All. Check 0.5. Unset Printing All. Check 0.5. Unset Printing Float. Check 0.5. Set Printing Float. Check 0.5. Open Scope nat_scope. Check 2. Check 2%float. Delimit Scope float_scope with flt. Definition t := 2%float. Print t. Delimit Scope nat_scope with float. Print t. Check 2. Close Scope nat_scope. Check 2. Close Scope float_scope. coq-8.20.0/test-suite/output/FunExt.out000066400000000000000000000015161466560755400200200ustar00rootroot00000000000000File "./output/FunExt.v", line 15, characters 5-24: The command has indeed failed with message: Tactic failure: Not an extensional equality. File "./output/FunExt.v", line 17, characters 5-24: The command has indeed failed with message: Tactic failure: Not an extensional equality. File "./output/FunExt.v", line 18, characters 5-26: The command has indeed failed with message: Tactic failure: Not an extensional equality. File "./output/FunExt.v", line 93, characters 9-28: The command has indeed failed with message: Tactic failure: Not an extensional equality. File "./output/FunExt.v", line 149, characters 9-28: The command has indeed failed with message: Tactic failure: Already an intensional equality. File "./output/FunExt.v", line 162, characters 9-29: The command has indeed failed with message: Hypothesis e depends on the body of H' coq-8.20.0/test-suite/output/FunExt.v000066400000000000000000000113231466560755400174530ustar00rootroot00000000000000(* -*- coq-prog-args: ("-async-proofs" "no") -*- *) Require Import FunctionalExtensionality. (* Basic example *) Goal (forall x y z, x+y+z = z+y+x) -> (fun x y z => z+y+x) = (fun x y z => x+y+z). intro H. extensionality in H. symmetry in H. assumption. Qed. (* Test rejection of non-equality *) Goal forall H:(forall A:Prop, A), H=H -> forall H'':True, H''=H''. intros H H' H''. Fail extensionality in H. clear H'. Fail extensionality in H. Fail extensionality in H''. Abort. (* Test success on dependent equality *) Goal forall (p : forall x, S x = x + 1), p = p -> S = fun x => x + 1. intros p H. extensionality in p. assumption. Qed. (* Test dependent functional extensionality *) Goal forall (P:nat->Type) (Q:forall a, P a -> Type) (f g:forall a (b:P a), Q a b), (forall x y, f x y = g x y) -> f = g. intros * H. extensionality in H. assumption. Qed. (* Other tests, courtesy of Jason Gross *) Goal forall A B C (D : forall a : A, C a -> Type) (f g : forall a : A, B -> forall c : C a, D a c), (forall a b c, f a b c = g a b c) -> f = g. Proof. intros A B C D f g H. extensionality in H. match type of H with f = g => idtac end. exact H. Qed. Section test_section. Context A B C (D : forall a : A, C a -> Type) (f g : forall a : A, B -> forall c : C a, D a c) (H : forall a b c, f a b c = g a b c). Goal f = g. Proof. extensionality in H. match type of H with f = g => idtac end. exact H. Qed. End test_section. Section test2. Context A B C (D : forall a : A, C a -> Type) (f g : forall a : A, B -> forall c : C a, D a c) (H : forall b a c, f a b c = g a b c). Goal (fun b a c => f a b c) = (fun b a c => g a b c). Proof. extensionality in H. match type of H with (fun b a => f a b) = (fun b' a' => g a' b') => idtac end. exact H. Qed. End test2. Section test3. Context A B C (D : forall a : A, C a -> Type) (f g : forall a : A, B -> forall c : C a, D a c) (H : forall a c, (fun b => f a b c) = (fun b => g a b c)). Goal (fun a c b => f a b c) = (fun a c b => g a b c). Proof. extensionality in H. match type of H with (fun a c b => f a b c) = (fun a' c' b' => g a' b' c') => idtac end. exact H. Qed. End test3. Section test4. Context A B C (D : forall a : A, C a -> Type) (f g : forall a : A, B -> forall c : C a, D a c -> Type) (H : forall b, (forall a c d, f a b c d) = (forall a c d, g a b c d)). Goal (fun b => forall a c d, f a b c d) = (fun b => forall a c d, g a b c d). Proof. extensionality in H. exact H. Qed. End test4. Section test5. Goal nat -> True. Proof. intro n. Fail extensionality in n. constructor. Qed. End test5. Section test6. Goal let f := fun A (x : A) => x in let pf := fun A x => @eq_refl _ (f A x) in f = f. Proof. intros f pf. extensionality in pf. match type of pf with f = f => idtac end. exact pf. Qed. End test6. Section test7. Context A B C (D : forall a : A, C a -> Type) (f g : forall a : A, B -> forall c : C a, D a c) (H : forall a b c, True -> f a b c = g a b c). Goal True. Proof. extensionality in H. match type of H with (fun a b c (_ : True) => f a b c) = (fun a' b' c' (_ : True) => g a' b' c') => idtac end. constructor. Qed. End test7. Section test8. Context A B C (D : forall a : A, C a -> Type) (f g : forall a : A, B -> forall c : C a, D a c) (H : True -> forall a b c, f a b c = g a b c). Goal True. Proof. extensionality in H. match type of H with (fun (_ : True) => f) = (fun (_ : True) => g) => idtac end. constructor. Qed. End test8. Section test9. Context A B C (D : forall a : A, C a -> Type) (f g : forall a : A, B -> forall c : C a, D a c) (H : forall b a c, f a b c = g a b c). Goal (fun b a c => f a b c) = (fun b a c => g a b c). Proof. pose H as H'. extensionality in H. extensionality in H'. let T := type of H in let T' := type of H' in constr_eq T T'. match type of H with (fun b a => f a b) = (fun b' a' => g a' b') => idtac end. exact H'. Qed. End test9. Section test10. Context A B C (D : forall a : A, C a -> Type) (f g : forall a : A, B -> forall c : C a, D a c) (H : f = g). Goal True. Proof. Fail extensionality in H. constructor. Qed. End test10. Section test11. Context A B C (D : forall a : A, C a -> Type) (f g : forall a : A, B -> forall c : C a, D a c) (H : forall a b c, f a b c = f a b c). Goal True. Proof. pose H as H'. pose (eq_refl : H = H') as e. extensionality in H. Fail extensionality in H'. clear e. extensionality in H'. let T := type of H in let T' := type of H' in constr_eq T T'. lazymatch type of H with f = f => idtac end. constructor. Qed. End test11. coq-8.20.0/test-suite/output/Function.out000066400000000000000000000003031466560755400203650ustar00rootroot00000000000000File "./output/Function.v", line 28, characters 4-5: Warning: Unused variable n might be a misspelled constructor. Use _ or _n to silence this warning. [unused-pattern-matching-variable,default] coq-8.20.0/test-suite/output/Function.v000066400000000000000000000020561466560755400200320ustar00rootroot00000000000000Require Import FunInd List. (* Explanations: This kind of pattern matching displays a legitimate unused variable warning in v8.13. Fixpoint f (l:list nat) : nat := match l with | nil => O | S n :: nil => 1 | x :: l' => f l' end. *) (* In v8.13 the same code with "Function" generates a lot more warnings about variables created automatically by Function. These are not legitimate. PR #13776 (post v8.13) removes all warnings about pattern matching variables (and non truly recursive fixpoint) for "Function". So this should not generate any warning. Note that this PR removes also the legitimate warnings. It would be better if this test generate the same warning as the Fixpoint above. This test would then need to be updated. *) (* Ensuring the warning is a warning. *) Fixpoint f (l:list nat) : nat := match l with | nil => O | S n :: nil => 1 | n :: l' => f l' end. (* But no warning generated here. *) Function g (l:list nat) : nat := match l with | nil => O | S n :: nil => 1 | n :: l' => g l' end. coq-8.20.0/test-suite/output/HintLocality.out000066400000000000000000000066301466560755400212140ustar00rootroot00000000000000Non-discriminated database Unfoldable variable definitions: all Unfoldable constant definitions: all except: id Unfoldable projection definitions: all Cut: _ For any goal -> For nat -> For S (modes !) -> Non-discriminated database Unfoldable variable definitions: all Unfoldable constant definitions: all except: id Unfoldable projection definitions: all Cut: _ For any goal -> For nat -> For S (modes !) -> Non-discriminated database Unfoldable variable definitions: all Unfoldable constant definitions: all except: id Unfoldable projection definitions: all Cut: _ For any goal -> For nat -> For S (modes !) -> Non-discriminated database Unfoldable variable definitions: all Unfoldable constant definitions: all except: id Unfoldable projection definitions: all Cut: _ For any goal -> For nat -> For S (modes !) -> Non-discriminated database Unfoldable variable definitions: all Unfoldable constant definitions: all Unfoldable projection definitions: all Cut: emp For any goal -> For nat -> simple apply 0 ; trivial(level 1, pattern nat, id 0) Non-discriminated database Unfoldable variable definitions: all Unfoldable constant definitions: all Unfoldable projection definitions: all Cut: emp For any goal -> For nat -> simple apply 0 ; trivial(level 1, pattern nat, id 0) Non-discriminated database Unfoldable variable definitions: all Unfoldable constant definitions: all except: id Unfoldable projection definitions: all Cut: _ For any goal -> For nat -> For S (modes !) -> Non-discriminated database Unfoldable variable definitions: all Unfoldable constant definitions: all Unfoldable projection definitions: all Cut: emp For any goal -> For nat -> simple apply 0 ; trivial(level 1, pattern nat, id 0) Non-discriminated database Unfoldable variable definitions: all Unfoldable constant definitions: all except: id Unfoldable projection definitions: all Cut: _ For any goal -> For nat -> For S (modes !) -> File "./output/HintLocality.v", line 61, characters 0-38: The command has indeed failed with message: This command does not support the global attribute in sections. Non-discriminated database Unfoldable variable definitions: all Unfoldable constant definitions: all except: id Unfoldable projection definitions: all Cut: _ For any goal -> For nat -> For S (modes !) -> Non-discriminated database Unfoldable variable definitions: all Unfoldable constant definitions: all except: id Unfoldable projection definitions: all Cut: _ For any goal -> For nat -> simple apply 0 ; trivial(level 1, pattern nat, id 0) For S (modes !) -> File "./output/HintLocality.v", line 92, characters 0-39: Warning: This hint is not local but depends on a section variable. It will disappear when the section is closed. [non-local-section-hint,automation,default] File "./output/HintLocality.v", line 94, characters 0-40: Warning: This hint is not local but depends on a section variable. It will disappear when the section is closed. [non-local-section-hint,automation,default] File "./output/HintLocality.v", line 98, characters 0-39: Warning: This hint is not local but depends on a section variable. It will disappear when the section is closed. [non-local-section-hint,automation,default] Non-discriminated database Unfoldable variable definitions: all Unfoldable constant definitions: all Unfoldable projection definitions: all Cut: emp For any goal -> For refl (modes - !) -> coq-8.20.0/test-suite/output/HintLocality.v000066400000000000000000000037721466560755400206560ustar00rootroot00000000000000(** Test hint command locality w.r.t. modules *) Create HintDb foodb. Create HintDb bardb. Create HintDb quxdb. #[global] Hint Immediate O : foodb. #[global] Hint Immediate O : bardb. #[global] Hint Immediate O : quxdb. Module Test. #[global] Hint Cut [ _ ] : foodb. #[global] Hint Mode S ! : foodb. #[global] Hint Opaque id : foodb. #[global] Remove Hints O : foodb. #[local] Hint Cut [ _ ] : bardb. #[local] Hint Mode S ! : bardb. #[local] Hint Opaque id : bardb. #[local] Remove Hints O : bardb. #[export] Hint Cut [ _ ] : quxdb. #[export] Hint Mode S ! : quxdb. #[export] Hint Opaque id : quxdb. #[export] Remove Hints O : quxdb. (** All three agree here *) Print HintDb foodb. Print HintDb bardb. Print HintDb quxdb. End Test. (** bardb and quxdb agree here *) Print HintDb foodb. Print HintDb bardb. Print HintDb quxdb. Import Test. (** foodb and quxdb agree here *) Print HintDb foodb. Print HintDb bardb. Print HintDb quxdb. (** Test hint command locality w.r.t. sections *) Create HintDb secdb. #[global] Hint Immediate O : secdb. Section Sec. #[global] Hint Cut [ _ ] : secdb. #[global] Hint Mode S ! : secdb. #[global] Hint Opaque id : secdb. Fail #[global] Remove Hints O : secdb. #[local] Hint Cut [ _ ] : secdb. #[local] Hint Mode S ! : secdb. #[local] Hint Opaque id : secdb. #[local] Remove Hints O : secdb. Print HintDb secdb. End Sec. Print HintDb secdb. (** Variant of the above test - modes are correctly generalized at section closure - non-local section-specific hints trigger a warning *) Create HintDb seclocaldb. Set Warnings "non-local-section-hint". Section SecLocal. Variable A : Type. Definition refl (n : A) : n = n := eq_refl. Variable prf : forall n : nat, n = 0. #[export] Hint Mode refl ! : seclocaldb. #[export] Hint Mode prf ! : seclocaldb. #[export] Hint Cut [ prf ] : seclocaldb. #[export] Hint Variables Transparent : seclocaldb. #[export] Hint Constants Transparent : seclocaldb. #[export] Hint Opaque prf : seclocaldb. End SecLocal. Print HintDb seclocaldb. coq-8.20.0/test-suite/output/Implicit.out000066400000000000000000000012521466560755400203560ustar00rootroot00000000000000compose S : (nat -> nat) -> nat -> nat ex_intro (P:=fun _ : nat => True) (x:=0) I : ex (fun _ : nat => True) d2 = fun x : nat => d1 (y:=x) : forall [x x0 : nat], x0 = x -> x0 = x Arguments d2 [x x]%nat_scope h map id (1 :: nil) : list nat map id' (1 :: nil) : list nat map (id'' (A:=nat)) (1 :: nil) : list nat fix f (x : nat) : option nat := match x with | 0 => None | S _ => x end : nat -> option nat fun x : False => let y := False_rect (A:=bool) x in y : False -> bool fun x : False => let y : True := False_rect x in y : False -> True coq-8.20.0/test-suite/output/Implicit.v000066400000000000000000000034741466560755400200240ustar00rootroot00000000000000Set Implicit Arguments. Unset Strict Implicit. (* Suggested by Pierre Casteran (BZ#169) *) (* Argument 3 is needed to typecheck and should be printed *) Definition compose (A B C : Set) (f : A -> B) (g : B -> C) (x : A) := g (f x). Check (compose (C:=nat) S). (* Better to explicitly display the arguments inferable from a position that could disappear after reduction *) Inductive ex (A : Set) (P : A -> Prop) : Prop := ex_intro : forall x : A, P x -> ex P. Check (ex_intro (P:=fun _ => True) (x:=0) I). (* Test for V8 printing of implicit by names *) Definition d1 y x (h : x = y :>nat) := h. Definition d2 x := d1 (y:=x). Print d2. Set Strict Implicit. Unset Implicit Arguments. (* Check maximal insertion of implicit *) Require Import List. Open Scope list_scope. Set Implicit Arguments. Set Maximal Implicit Insertion. Definition id (A:Type) (x:A) := x. Check map id (1::nil). Definition id' (A:Type) (x:A) := x. Arguments id' {A} x. Check map id' (1::nil). Unset Maximal Implicit Insertion. Unset Implicit Arguments. (* Check explicit insertion of last non-maximal trailing implicit to ensure *) (* correct arity of partiol applications *) Set Implicit Arguments. Definition id'' (A:Type) (x:A) := x. Check map (@id'' nat) (1::nil). Module MatchBranchesInContext. Set Implicit Arguments. Set Contextual Implicit. Inductive option A := None | Some (a:A). Coercion some_nat := @Some nat. Check fix f x := match x with 0 => None | n => some_nat n end. End MatchBranchesInContext. Module LetInContext. Set Implicit Arguments. Set Contextual Implicit. Axiom False_rect : forall A:Type, False -> A. Check fun x:False => let y:= False_rect (A:=bool) x in y. (* will not be in context: explicitation *) Check fun x:False => let y:= False_rect (A:=True) x in y. (* will be in context: no explicitation *) End LetInContext. coq-8.20.0/test-suite/output/ImplicitTypes.out000066400000000000000000000011471466560755400214060ustar00rootroot00000000000000forall b, b = b : Prop forall b : nat, b = b : Prop forall b : bool, @eq bool b b : Prop forall b : bool, b = b : Prop forall b c : bool, b = c : Prop forall c b : bool, b = c : Prop forall b1 b2, b1 = b2 : Prop fun b => b = b : bool -> Prop fun b c : bool => b = c : bool -> bool -> Prop fun c b : bool => b = c : bool -> bool -> Prop fun b1 b2 => b1 = b2 : bool -> bool -> Prop fix f b (n : nat) {struct n} : bool := match n with | 0 => b | S p => f b p end : bool -> nat -> bool ∀ b c : bool, b = c : Prop ∀ b1 b2, b1 = b2 : Prop coq-8.20.0/test-suite/output/ImplicitTypes.v000066400000000000000000000020431466560755400210400ustar00rootroot00000000000000Implicit Types b : bool. Check forall b, b = b. (* Check the type is not used if not the reserved one *) Check forall b:nat, b = b. (* Check full printing *) Set Printing All. Check forall b, b = b. Unset Printing All. (* Check printing of type *) Unset Printing Use Implicit Types. Check forall b, b = b. Set Printing Use Implicit Types. (* Check factorization: we give priority on factorization over implicit type *) Check forall b c, b = c. Check forall c b, b = c. (* Check factorization of implicit types *) Check forall b1 b2, b1 = b2. (* Check in "fun" *) Check fun b => b = b. Check fun b c => b = c. Check fun c b => b = c. Check fun b1 b2 => b1 = b2. (* Check in binders *) Check fix f b n := match n with 0 => b | S p => f b p end. (* Check in notations *) Module Notation. Notation "∀ x .. y , P" := (forall x, .. (forall y, P) ..) (at level 200, x binder, y binder, right associativity, format "'[ ' '[ ' ∀ x .. y ']' , '/' P ']'") : type_scope. Check forall b c, b = c. Check forall b1 b2, b1 = b2. End Notation. coq-8.20.0/test-suite/output/Inductive.out000066400000000000000000000022171466560755400205400ustar00rootroot00000000000000File "./output/Inductive.v", line 1, characters 0-93: The command has indeed failed with message: In environment list' : Set -> Set A : Set a : A l : list' A Unable to unify "list' (A * A)%type" with "list' A". Inductive foo (A : Type) (x : A) (y : A := x) : Prop := Foo : foo A x. Arguments foo A%type_scope x Arguments Foo A%type_scope x myprod unit bool : Set option : Type -> Type option is template universe polymorphic Arguments option A%type_scope Expands to: Inductive Coq.Init.Datatypes.option option : Type@{option.u0} -> Type@{max(Set,option.u0)} option is template universe polymorphic on option.u0 Arguments option A%type_scope Expands to: Inductive Coq.Init.Datatypes.option File "./output/Inductive.v", line 27, characters 4-13: The command has indeed failed with message: Parameters should be syntactically the same for each inductive type. Type "B" has no parameters but type "Inductive" has parameters "A". File "./output/Inductive.v", line 30, characters 6-15: The command has indeed failed with message: Parameters should be syntactically the same for each record type. Type "B" has no parameters but type "Inductive" has parameters "A". coq-8.20.0/test-suite/output/Inductive.v000066400000000000000000000012741466560755400202000ustar00rootroot00000000000000Fail Inductive list' (A:Set) : Set := | nil' : list' A | cons' : A -> list' A -> list' (A*A). (* Check printing of let-ins *) Inductive foo (A : Type) (x : A) (y := x) := Foo. Print foo. (* Check where clause *) Reserved Notation "x ** y" (at level 40, left associativity). Inductive myprod A B := mypair : A -> B -> A ** B where "A ** B" := (myprod A B) (only parsing). Check unit ** bool. (* "option is template" *) About option. Set Printing Universes. About option. (* "option is template on xxx" *) Module DiffParams. Fail Inductive B: Type := | F: A -> B with Inductive A: Type := mkA. Fail Inductive B := { x : nat } with Inductive A := { y : nat }. End DiffParams. coq-8.20.0/test-suite/output/InductiveMainName.out000066400000000000000000000012421466560755400221430ustar00rootroot00000000000000bar : foo -> nat bar is not universe polymorphic bar is a projection of foo Arguments bar id bar is transparent Expands to: Constant InductiveMainName.bar bar' : foo' -> nat bar' is not universe polymorphic bar' is a projection of foo' Arguments bar' {id'} bar' is transparent Expands to: Constant InductiveMainName.bar' bar'' : foo'' -> foo'' bar'' is not universe polymorphic bar'' is a projection of foo'' Arguments bar'' id'' bar'' is transparent Expands to: Constant InductiveMainName.bar'' Record foo''' : Set := Build_foo''' { bar''' : nat } as id. foo''' has primitive projections with eta conversion. Arguments Build_foo''' bar'''%nat_scope Arguments bar''' id coq-8.20.0/test-suite/output/InductiveMainName.v000066400000000000000000000003561466560755400216060ustar00rootroot00000000000000Record foo := { bar : nat } as id. About bar. Class foo' := { bar' : nat } as id'. About bar'. CoInductive foo'' := { bar'' : foo'' } as id''. About bar''. Set Primitive Projections. Record foo''' := { bar''' : nat } as id. Print bar'''. coq-8.20.0/test-suite/output/InitSyntax.out000066400000000000000000000004701466560755400207170ustar00rootroot00000000000000Inductive sig2 (A : Type) (P Q : A -> Prop) : Type := exist2 : forall x : A, P x -> Q x -> {x : A | P x & Q x}. Arguments sig2 [A]%type_scope (P Q)%type_scope Arguments exist2 [A]%type_scope (P Q)%function_scope x _ _ exists x : nat, x = x : Prop fun b : bool => if b then b else b : bool -> bool coq-8.20.0/test-suite/output/InitSyntax.v000066400000000000000000000001571466560755400203570ustar00rootroot00000000000000(* Soumis par Pierre *) Print sig2. Check (exists x : nat, x = x). Check (fun b : bool => if b then b else b). coq-8.20.0/test-suite/output/Int63NumberSyntax.out000066400000000000000000000053141466560755400220720ustar00rootroot000000000000002%uint63 : int 2 : int 9223372036854775807 : int 427 : int 427 : int 427 : int 427 : int 427 : int File "./output/Int63NumberSyntax.v", line 12, characters 11-17: The command has indeed failed with message: Cannot interpret this number as a value of type int File "./output/Int63NumberSyntax.v", line 13, characters 11-17: The command has indeed failed with message: Cannot interpret this number as a value of type int 0 : int 0 : int File "./output/Int63NumberSyntax.v", line 16, characters 12-14: The command has indeed failed with message: The reference xg was not found in the current environment. File "./output/Int63NumberSyntax.v", line 17, characters 12-14: The command has indeed failed with message: The reference xG was not found in the current environment. File "./output/Int63NumberSyntax.v", line 18, characters 13-15: The command has indeed failed with message: The reference x1 was not found in the current environment. File "./output/Int63NumberSyntax.v", line 19, characters 12-13: The command has indeed failed with message: The reference x was not found in the current environment. add 2 2 : int File "./output/Int63NumberSyntax.v", line 21, characters 11-13: The command has indeed failed with message: Cannot interpret this number as a value of type int File "./output/Int63NumberSyntax.v", line 22, characters 11-30: The command has indeed failed with message: Overflow in int63 literal: 9223372036854775808. 0x1 : int 2 : nat 2%uint63 : int File "./output/Int63NumberSyntax.v", line 31, characters 0-37: Warning: Overwriting previous delimiting key uint63 in scope uint63_scope [overwriting-delimiting-key,parsing,default] t = 2%ui63 : int File "./output/Int63NumberSyntax.v", line 34, characters 0-36: Warning: Overwriting previous delimiting key nat in scope nat_scope [overwriting-delimiting-key,parsing,default] File "./output/Int63NumberSyntax.v", line 34, characters 0-36: Warning: Hiding binding of key uint63 to uint63_scope [hiding-delimiting-key,parsing,default] t = 2%ui63 : int 2 : nat 2 : int File "./output/Int63NumberSyntax.v", line 41, characters 0-22: Warning: Overwriting previous delimiting key ui63 in scope uint63_scope [overwriting-delimiting-key,parsing,default] File "./output/Int63NumberSyntax.v", line 41, characters 0-22: Warning: Hiding binding of key uint63 to nat_scope [hiding-delimiting-key,parsing,default] (2 + 2)%uint63 : int 2 + 2 : int = 4 : int = 37151199385380486 : int = 4 : int = 4 : int = 4 : int = add : int -> int -> int = 12 : int = 12 : int = 12 : int = 3 + x : int = 1 + 2 + x : int coq-8.20.0/test-suite/output/Int63NumberSyntax.v000066400000000000000000000021661466560755400215320ustar00rootroot00000000000000Require Import PrimInt63. Check 2%uint63. Open Scope uint63_scope. Check 2. Check 9223372036854775807. Check 0x1ab. Check 0X1ab. Check 0x1Ab. Check 0x1aB. Check 0x1AB. Fail Check 0x1ap5. (* exponents not implemented (yet?) *) Fail Check 0x1aP5. Check 0x0. Check 0x000. Fail Check 0xg. Fail Check 0xG. Fail Check 00x1. Fail Check 0x. Check (PrimInt63.add 2 2). Fail Check -1. Fail Check 9223372036854775808. Set Printing All. Check 1%uint63. Unset Printing All. Open Scope nat_scope. Check 2. (* : nat *) Check 2%uint63. Delimit Scope uint63_scope with ui63. Definition t := 2%uint63. Print t. Delimit Scope nat_scope with uint63. Print t. Check 2. Close Scope nat_scope. Check 2. Close Scope uint63_scope. Require Import Uint63. Check (2 + 2)%uint63. Open Scope uint63_scope. Check (2+2). Eval vm_compute in 2+2. Eval vm_compute in 65675757 * 565675998. Eval simpl in 2+2. Eval hnf in 2+2. Eval cbn in 2+2. Eval hnf in PrimInt63.add. Eval simpl in (2 * 3) + (2 * 3). Eval hnf in (2 * 3) + (2 * 3). Eval cbn in (2 * 3) + (2 * 3). Section TestNoSimpl. Variable x : int. Eval simpl in 1 + 2 + x. Eval hnf in 1 + 2 + x. End TestNoSimpl. coq-8.20.0/test-suite/output/Intuition.out000066400000000000000000000001221466560755400205610ustar00rootroot000000000000001 goal m, n : Z H : (m >= n)%Z ============================ (m >= m)%Z coq-8.20.0/test-suite/output/Intuition.v000066400000000000000000000001711466560755400202230ustar00rootroot00000000000000Require Import ZArith_base. Goal forall m n : Z, (m >= n)%Z -> (m >= m)%Z /\ (m >= n)%Z. intros; intuition. Show. Abort. coq-8.20.0/test-suite/output/InvalidDisjunctiveIntro.out000066400000000000000000000023611466560755400234200ustar00rootroot00000000000000File "./output/InvalidDisjunctiveIntro.v", line 2, characters 31-32: The command has indeed failed with message: Cannot coerce to a disjunctive/conjunctive pattern. File "./output/InvalidDisjunctiveIntro.v", line 4, characters 2-32: The command has indeed failed with message: Disjunctive/conjunctive introduction pattern expected. File "./output/InvalidDisjunctiveIntro.v", line 6, characters 48-49: The command has indeed failed with message: Cannot coerce to a disjunctive/conjunctive pattern. File "./output/InvalidDisjunctiveIntro.v", line 8, characters 49-50: The command has indeed failed with message: Cannot coerce to a disjunctive/conjunctive pattern. File "./output/InvalidDisjunctiveIntro.v", line 10, characters 32-33: The command has indeed failed with message: Ltac variable H is bound to idtac of type tacvalue which cannot be coerced to an introduction pattern. File "./output/InvalidDisjunctiveIntro.v", line 13, characters 2-52: The command has indeed failed with message: Disjunctive/conjunctive introduction pattern expected. File "./output/InvalidDisjunctiveIntro.v", line 15, characters 50-52: The command has indeed failed with message: Ltac variable H' is bound to idtac of type tacvalue which cannot be coerced to an introduction pattern. coq-8.20.0/test-suite/output/InvalidDisjunctiveIntro.v000066400000000000000000000015701466560755400230570ustar00rootroot00000000000000Theorem test (A:Prop) : A \/ A -> A. Fail intros H; destruct H as H. (* Cannot coerce to a disjunctive/conjunctive pattern. *) Fail intro H; destruct H as H. (* Disjunctive/conjunctive introduction pattern expected. *) Fail let H := fresh in intro H; destruct H as H. (* Cannot coerce to a disjunctive/conjunctive pattern. *) Fail let H := fresh in intros H; destruct H as H. (* Cannot coerce to a disjunctive/conjunctive pattern. *) Fail let H := idtac in intros H; destruct H as H. (* Ltac variable H is bound to which cannot be coerced to an introduction pattern. *) Fail let H := idtac in intros H; destruct H as H'. (* Disjunctive/conjunctive introduction pattern expected. *) Fail let H' := idtac in intros H; destruct H as H'. (* Ltac variable H' is bound to which cannot be coerced to an introduction pattern. *) Abort. coq-8.20.0/test-suite/output/Load.out000066400000000000000000000002621466560755400174630ustar00rootroot00000000000000f = 2 : nat u = I : True File "./output/Load.v", line 7, characters 0-41: The command has indeed failed with message: Files processed by Load cannot leave open proofs. coq-8.20.0/test-suite/output/Load.v000066400000000000000000000002021466560755400171130ustar00rootroot00000000000000Load "output/load/Load_noproof.v". Print f. Load "output/load/Load_proof.v". Print u. Fail Load "output/load/Load_openproof.v". coq-8.20.0/test-suite/output/MExtraction.v000066400000000000000000000054371466560755400205100ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* "( * )" [ "(,)" ]. Extract Inductive list => list [ "[]" "(::)" ]. Extract Inductive bool => bool [ true false ]. Extract Inductive sumbool => bool [ true false ]. Extract Inductive option => option [ Some None ]. Extract Inductive sumor => option [ Some None ]. (** Then, in a ternary alternative { }+{ }+{ }, - leftmost choice (Inleft Left) is (Some true), - middle choice (Inleft Right) is (Some false), - rightmost choice (Inright) is (None) *) (** To preserve its laziness, andb is normally expanded. Let's rather use the ocaml && *) Extract Inlined Constant andb => "(&&)". Import Reals.Rdefinitions. Extract Constant R => "int". Extract Constant R0 => "0". Extract Constant R1 => "1". Extract Constant Rplus => "( + )". Extract Constant Rmult => "( * )". Extract Constant Ropp => "fun x -> - x". Extract Constant Rinv => "fun x -> 1 / x". (** In order to avoid annoying build dependencies the actual extraction is only performed as a test in the test suite. *) Recursive Extraction Tauto.mapX Tauto.foldA Tauto.collect_annot Tauto.ids_of_formula Tauto.map_bformula Tauto.abst_form ZMicromega.cnfZ ZMicromega.Zeval_const QMicromega.cnfQ List.map simpl_cone (*map_cone indexes*) denorm QArith_base.Qpower vm_add normZ normQ normQ n_of_Z N.of_nat ZTautoChecker ZWeakChecker QTautoChecker RTautoChecker find. (* Local Variables: *) (* coding: utf-8 *) (* End: *) coq-8.20.0/test-suite/output/Match_subterm.out000066400000000000000000000000441466560755400213770ustar00rootroot00000000000000(0 = 1) (eq 0) eq @eq nat 0 1 S 0 2 coq-8.20.0/test-suite/output/Match_subterm.v000066400000000000000000000001351466560755400210360ustar00rootroot00000000000000Goal 0 = 1. match goal with | |- context [?v] => idtac v ; fail | _ => idtac 2 end. Abort. coq-8.20.0/test-suite/output/ModuleSubtyping.out000066400000000000000000000020011466560755400217270ustar00rootroot00000000000000File "./output/ModuleSubtyping.v", line 8, characters 2-41: The command has indeed failed with message: Signature components for field x do not match: the body of definitions differs. File "./output/ModuleSubtyping.v", line 14, characters 2-30: The command has indeed failed with message: Signature components for field B.C.x do not match: the body of definitions differs. File "./output/ModuleSubtyping.v", line 20, characters 2-31: The command has indeed failed with message: Signature components for field B.C.x in the 1st functor argument do not match: the body of definitions differs. File "./output/ModuleSubtyping.v", line 30, characters 2-34: The command has indeed failed with message: Signature components for field B.C.x in the 1st functor argument of F do not match: the body of definitions differs. File "./output/ModuleSubtyping.v", line 46, characters 2-38: The command has indeed failed with message: Signature components for field v do not match: expected type "A1.t -> A1.t" but found type "A1.t -> Prop". coq-8.20.0/test-suite/output/ModuleSubtyping.v000066400000000000000000000023251466560755400213760ustar00rootroot00000000000000 Module Qualification. (* test that field mismatch errors print the qualified fields *) Module Type EasyT. Definition x := O. End EasyT. Module EasyM. Definition x := S O. End EasyM. Fail Module Easytest <: EasyT := EasyM. Module Type A. Module B. Module C. Definition x := O. End C. End B. End A. Module Type A'. Module B. Module C. Definition x := S O. End C. End B. End A'. Module Av. Include A'. End Av. Fail Module test <: A := Av. (* was Error: Signature components for field C do not match: the body of definitions differs. *) Module Type FT (X:A). End FT. Module F (X:A'). End F. Fail Module Ftest <: FT := F. Module Type FXT. Module F (X:A). End F. End FXT. Module FX. Module F (X:A'). End F. End FX. Fail Module FXtest <: FXT := FX. End Qualification. Module PrintBound. (* printing an inductive from a bound module in an error from the command where the bound module is introduced *) Module Type E. End E. Module Type T. Inductive t : Prop := . Parameter v : t -> t. End T. Module Type FE(A:E). Inductive t : Prop :=. Parameter v : t -> Prop. End FE. Module Type FT(A:T). End FT. Module VE. End VE. Fail Module F (A1:FE VE) (A2:FT A1). End PrintBound. coq-8.20.0/test-suite/output/NNumberSyntax.out000066400000000000000000000016301466560755400213610ustar00rootroot0000000000000032%N : N eq_refl : 42%N = 42%N : 42%N = 42%N fun f : nat -> N => (f 0%nat + 0)%N : (nat -> N) -> N fun x : positive => N.pos x~0 : positive -> N fun x : positive => (N.pos x + 1)%N : positive -> N fun x : positive => N.pos x : positive -> N fun x : positive => N.pos x~1 : positive -> N fun x : positive => (N.pos x~0 + 0)%N : positive -> N (N.of_nat 0 + 1)%N : N (0 + N.of_nat (0 + 0))%N : N N.of_nat 0 = 0%N : Prop 0%N : N 1%N : N 2%N : N 255%N : N 255%N : N 0%N : N 1%N : N 2%N : N 255%N : N 255%N : N 0x2a : N 0x0 : N 0x2a : N 0x0 : N 0x0 : N 0x1 : N 0x2 : N 0xff : N 0xff : N 0x0 : N 0x0 : N 0x1 : N 0x2 : N 0xff : N 0xff : N 0x0 : N 0x0 : N 0x1 : N 0x2 : N 0xff : N 0xff : N (0 + N.of_nat 11)%N : N coq-8.20.0/test-suite/output/NNumberSyntax.v000066400000000000000000000017041466560755400210210ustar00rootroot00000000000000Require Import NArith. Check 32%N. Check (eq_refl : 0x2a%N = 42%N). Check (fun f : nat -> N => (f 0%nat + 0)%N). Check (fun x : positive => Npos (xO x)). Check (fun x : positive => (Npos x + 1)%N). Check (fun x : positive => Npos x). Check (fun x : positive => Npos (xI x)). Check (fun x : positive => (Npos (xO x) + 0)%N). Check (N.of_nat 0 + 1)%N. Check (0 + N.of_nat (0 + 0))%N. Check (N.of_nat 0 = 0%N). Check 0x00%N. Check 0x01%N. Check 0x02%N. Check 0xff%N. Check 0xFF%N. Check 0x00%xN. Check 0x01%xN. Check 0x02%xN. Check 0xff%xN. Check 0xFF%xN. (* Check hexadecimal printing *) Open Scope hex_N_scope. Check 42%N. Check 0%N. Check 42%xN. Check 0%xN. Check 0x00%N. Check 0x01%N. Check 0x02%N. Check 0xff%N. Check 0xFF%N. Check 0x0%xN. Check 0x00%xN. Check 0x01%xN. Check 0x02%xN. Check 0xff%xN. Check 0xFF%xN. Check 0x0. Check 0x00. Check 0x01. Check 0x02. Check 0xff. Check 0xFF. Close Scope hex_N_scope. Require Import Arith. Check (0 + N.of_nat 11)%N. coq-8.20.0/test-suite/output/Nametab.out000066400000000000000000000034551466560755400201620ustar00rootroot00000000000000Constant Nametab.Q.N.K.foo (shorter name to refer to it in current context is Q.N.K.foo) Constant Nametab.Q.N.K.foo (shorter name to refer to it in current context is Q.N.K.foo) Constant Nametab.Q.N.K.foo (shorter name to refer to it in current context is Q.N.K.foo) Constant Nametab.Q.N.K.foo Constant Nametab.Q.N.K.foo (shorter name to refer to it in current context is Q.N.K.foo) Module Nametab.Q.N.K (shorter name to refer to it in current context is Q.N.K) Module Nametab.Q.N.K (shorter name to refer to it in current context is Q.N.K) Module Nametab.Q.N.K Module Nametab.Q.N.K (shorter name to refer to it in current context is Q.N.K) Module Nametab.Q.N (shorter name to refer to it in current context is Q.N) Module Nametab.Q.N Module Nametab.Q.N (shorter name to refer to it in current context is Q.N) Module Nametab.Q Module Nametab.Q (shorter name to refer to it in current context is Q) Constant Nametab.Q.N.K.foo (shorter name to refer to it in current context is K.foo) Constant Nametab.Q.N.K.foo Constant Nametab.Q.N.K.foo (shorter name to refer to it in current context is K.foo) Constant Nametab.Q.N.K.foo (shorter name to refer to it in current context is K.foo) Constant Nametab.Q.N.K.foo (shorter name to refer to it in current context is K.foo) Module Nametab.Q.N.K Module Nametab.Q.N.K (shorter name to refer to it in current context is K) Module Nametab.Q.N.K (shorter name to refer to it in current context is K) Module Nametab.Q.N.K (shorter name to refer to it in current context is K) Module Nametab.Q.N (shorter name to refer to it in current context is Q.N) Module Nametab.Q.N Module Nametab.Q.N (shorter name to refer to it in current context is Q.N) Module Nametab.Q Module Nametab.Q (shorter name to refer to it in current context is Q) No object of basename T Open Section Nametab.T coq-8.20.0/test-suite/output/Nametab.v000066400000000000000000000020461466560755400176130ustar00rootroot00000000000000(* coq-prog-args: ("-top" "Nametab") *) Module Q. Module N. Module K. Definition foo := Set. End K. End N. End Q. (* Bad *) Locate foo. (* Bad *) Locate K.foo. (* Bad *) Locate N.K.foo. (* OK *) Locate Q.N.K.foo. (* OK *) Locate Nametab.Q.N.K.foo. (* Bad *) Locate Module K. (* Bad *) Locate Module N.K. (* OK *) Locate Module Q.N.K. (* OK *) Locate Module Nametab.Q.N.K. (* Bad *) Locate Module N. (* OK *) Locate Module Q.N. (* OK *) Locate Module Nametab.Q.N. (* OK *) Locate Module Q. (* OK *) Locate Module Nametab.Q. Import Q.N. (* Bad *) Locate foo. (* OK *) Locate K.foo. (* Bad *) Locate N.K.foo. (* OK *) Locate Q.N.K.foo. (* OK *) Locate Nametab.Q.N.K.foo. (* OK *) Locate Module K. (* Bad *) Locate Module N.K. (* OK *) Locate Module Q.N.K. (* OK *) Locate Module Nametab.Q.N.K. (* Bad *) Locate Module N. (* OK *) Locate Module Q.N. (* OK *) Locate Module Nametab.Q.N. (* OK *) Locate Module Q. (* OK *) Locate Module Nametab.Q. (* A slightly different request *) Section T. Locate T. About T. End T. coq-8.20.0/test-suite/output/Naming.out000066400000000000000000000046601466560755400200230ustar00rootroot000000000000001 goal x3 : nat ============================ forall x x1 x4 x0 : nat, (forall x2 x5 : nat, x2 + x1 = x4 + x5) -> x + x1 = x4 + x0 1 goal x3, x, x1, x4, x0 : nat H : forall x x3 : nat, x + x1 = x4 + x3 ============================ x + x1 = x4 + x0 1 goal x3 : nat ============================ forall x x1 x4 x0 : nat, (forall x2 x5 : nat, x2 + x1 = x4 + x5 -> foo (S x2 + x1)) -> x + x1 = x4 + x0 -> foo (S x) 1 goal x3 : nat ============================ forall x x1 x4 x0 : nat, (forall x2 x5 : nat, x2 + x1 = x4 + x5 -> forall x6 x7 x8 S0 : nat, x6 + S0 = x7 + x8 + (S x2 + x1)) -> x + x1 = x4 + x0 -> forall x5 x6 x7 S : nat, x5 + S = x6 + x7 + Datatypes.S x 1 goal x3, x, x1, x4, x0 : nat ============================ (forall x2 x5 : nat, x2 + x1 = x4 + x5 -> forall x6 x7 x8 S0 : nat, x6 + S0 = x7 + x8 + (S x2 + x1)) -> x + x1 = x4 + x0 -> forall x5 x6 x7 S : nat, x5 + S = x6 + x7 + Datatypes.S x 1 goal x3, x, x1, x4, x0 : nat H : forall x x3 : nat, x + x1 = x4 + x3 -> forall x0 x4 x5 S0 : nat, x0 + S0 = x4 + x5 + (S x + x1) H0 : x + x1 = x4 + x0 ============================ forall x5 x6 x7 S : nat, x5 + S = x6 + x7 + Datatypes.S x 1 goal x3, x, x1, x4, x0 : nat H : forall x x3 : nat, x + x1 = x4 + x3 -> forall x0 x4 x5 S0 : nat, x0 + S0 = x4 + x5 + (Datatypes.S x + x1) H0 : x + x1 = x4 + x0 x5, x6, x7, S : nat ============================ x5 + S = x6 + x7 + Datatypes.S x 1 goal x3, a : nat H : a = 0 -> forall a : nat, a = 0 ============================ a = 0 File "./output/Naming.v", line 101, characters 47-48: Warning: Ignoring implicit binder declaration in unexpected position. [unexpected-implicit-declaration,syntax,default] File "./output/Naming.v", line 105, characters 36-37: Warning: Ignoring implicit binder declaration in unexpected position. [unexpected-implicit-declaration,syntax,default] File "./output/Naming.v", line 106, characters 34-35: Warning: Ignoring implicit binder declaration in unexpected position. [unexpected-implicit-declaration,syntax,default] File "./output/Naming.v", line 112, characters 22-23: Warning: Ignoring implicit binder declaration in unexpected position. [unexpected-implicit-declaration,syntax,default] File "./output/Naming.v", line 112, characters 30-31: Warning: Ignoring implicit binder declaration in unexpected position. [unexpected-implicit-declaration,syntax,default] coq-8.20.0/test-suite/output/Naming.v000066400000000000000000000052001466560755400174500ustar00rootroot00000000000000(* This file checks the compatibility of naming strategy *) (* This does not mean that the given naming strategy is good *) Parameter x2:nat. Definition foo y := forall x x3 x4 S, x + S = x3 + x4 + y. Section A. Variable x3:nat. Goal forall x x1 x2 x3:nat, (forall x x3:nat, x+x1 = x2+x3) -> x+x1 = x2+x3. Show. intros. Show. (* Remark: in V8.2, this used to be printed x3 : nat ============================ forall x x1 x4 x5 : nat, (forall x0 x6 : nat, x0 + x1 = x4 + x6) -> x + x1 = x4 + x5 before intro and x3 : nat x : nat x1 : nat x4 : nat x0 : nat H : forall x x3 : nat, x + x1 = x4 + x3 ============================ x + x1 = x4 + x0 after. From V8.3, the quantified hypotheses are printed the sames as they would be intro. However the hypothesis H remains printed differently to avoid using the same name in autonomous but nested subterms *) Abort. Goal forall x x1 x2 x3:nat, (forall x x3:nat, x+x1 = x2+x3 -> foo (S x + x1)) -> x+x1 = x2+x3 -> foo (S x). Show. unfold foo. Show. do 4 intro. (* --> x, x1, x4, x0, ... *) Show. do 2 intro. Show. do 4 intro. Show. (* Remark: in V8.2, this used to be printed x3 : nat ============================ forall x x1 x4 x5 : nat, (forall x0 x6 : nat, x0 + x1 = x4 + x6 -> forall x7 x8 x9 S0 : nat, x7 + S0 = x8 + x9 + (S x0 + x1)) -> x + x1 = x4 + x5 -> forall x0 x6 x7 S0 : nat, x0 + S0 = x6 + x7 + S x before the intros and x3 : nat x : nat x1 : nat x4 : nat x0 : nat H : forall x x3 : nat, x + x1 = x4 + x3 -> forall x0 x4 x5 S0 : nat, x0 + S0 = x4 + x5 + (S x + x1) H0 : x + x1 = x4 + x0 x5 : nat x6 : nat x7 : nat S : nat ============================ x5 + S = x6 + x7 + Datatypes.S x after (note the x5/x0 and the S0/S) *) Abort. (* Check naming in hypotheses *) Goal forall a, (a = 0 -> forall a, a = 0) -> a = 0. intros. Show. apply H with (a:=a). (* test compliance with printing *) Abort. End A. Module B. (* Check valid/invalid implicit arguments *) Definition f1 {x} (y:forall {x}, x=0) := x+0. Definition f2 := (((fun x => 0):forall {x:nat}, nat), 0). Definition f3 := fun {x} (y:forall {x}, x=0) => x+0. Definition g1 {x} := match x with true => fun {x:bool} => x | false => fun x:bool => x end. (* TODO: do not ignore the implicit here *) Definition g2 '(x,y) {z} := x+y+z. Definition h1 := fun x:nat => (fun {x} => x) 0. Definition h2 := let g := forall {y}, y=0 in g. Notation "∀ x .. y , P" := (forall x, .. (forall y, P) ..) (at level 200, x binder, y binder, right associativity, format "'[ ' '[ ' ∀ x .. y ']' , '/' P ']'") : type_scope. Definition l1 := ∀ {x:nat} {y:nat}, x=0. End B. coq-8.20.0/test-suite/output/NatSyntax.out000066400000000000000000000021071466560755400205350ustar00rootroot0000000000000042 : nat 0 : nat 0 : nat 427 : nat 427 : nat 427 : nat 427 : nat 427 : nat File "./output/NatSyntax.v", line 9, characters 11-17: The command has indeed failed with message: Cannot interpret this number as a value of type nat File "./output/NatSyntax.v", line 10, characters 11-17: The command has indeed failed with message: Cannot interpret this number as a value of type nat 0 : nat 0 : nat File "./output/NatSyntax.v", line 13, characters 12-14: The command has indeed failed with message: The reference xg was not found in the current environment. File "./output/NatSyntax.v", line 14, characters 12-14: The command has indeed failed with message: The reference xG was not found in the current environment. File "./output/NatSyntax.v", line 15, characters 13-15: The command has indeed failed with message: The reference x1 was not found in the current environment. File "./output/NatSyntax.v", line 16, characters 12-13: The command has indeed failed with message: The reference x was not found in the current environment. 0x2a : nat coq-8.20.0/test-suite/output/NatSyntax.v000066400000000000000000000004501466560755400201720ustar00rootroot00000000000000Check 42. Check 0. Check 00. Check 0x1ab. Check 0X1ab. Check 0x1Ab. Check 0x1aB. Check 0x1AB. Fail Check 0x1ap1. (* exponents not implemented (yet?) *) Fail Check 0x1aP1. Check 0x0. Check 0x000. Fail Check 0xg. Fail Check 0xG. Fail Check 00x1. Fail Check 0x. Open Scope hex_nat_scope. Check 42. coq-8.20.0/test-suite/output/NoAxiomFromR.out000066400000000000000000000000401466560755400211160ustar00rootroot00000000000000Closed under the global context coq-8.20.0/test-suite/output/NoAxiomFromR.v000066400000000000000000000002721466560755400205630ustar00rootroot00000000000000Require Import Psatz. Inductive TT : Set := | C : nat -> TT. Lemma lem4 : forall (n m : nat), S m <= m -> C (S m) <> C n -> False. Proof. firstorder lia. Qed. Print Assumptions lem4. coq-8.20.0/test-suite/output/NotationSyntax.out000066400000000000000000000031021466560755400216020ustar00rootroot00000000000000File "./output/NotationSyntax.v", line 2, characters 38-50: The command has indeed failed with message: "only parsing" is given more than once. File "./output/NotationSyntax.v", line 3, characters 38-51: The command has indeed failed with message: A notation cannot be both "only printing" and "only parsing". File "./output/NotationSyntax.v", line 4, characters 39-52: The command has indeed failed with message: "only printing" is given more than once. File "./output/NotationSyntax.v", line 5, characters 33-43: Warning: The format modifier is irrelevant for only-parsing rules. [irrelevant-format-only-parsing,parsing,default] File "./output/NotationSyntax.v", line 8, characters 20-30: Warning: Notations for numbers or strings are primitive; skipping this modifier. [primitive-token-modifier,parsing,default] 1%nat : nat File "./output/NotationSyntax.v", line 10, characters 23-26: The command has indeed failed with message: Notations for numbers or strings are primitive and need not be reserved. File "./output/NotationSyntax.v", line 12, characters 25-35: Warning: Notations for numbers or strings are primitive; skipping this modifier. [primitive-token-modifier,parsing,default] "tt" : unit "tt"%string : string File "./output/NotationSyntax.v", line 16, characters 23-31: The command has indeed failed with message: Notations for numbers or strings are primitive and need not be reserved. "t""t" : unit # "|" true : option bool "|"%string : string 2 "|" 4 : nat * nat "I'm true" : bool "" : bool symbolwith"doublequote : bool " : bool coq-8.20.0/test-suite/output/NotationSyntax.v000066400000000000000000000021451466560755400212460ustar00rootroot00000000000000(* Various meaningless notations *) Fail Notation "#" := 0 (only parsing, only parsing). Fail Notation "#" := 0 (only parsing, only printing). Fail Notation "#" := 0 (only printing, only printing). Notation "#" := 0 (only parsing, format "#"). (* Alerting about primitive syntax *) Notation "1" := tt (at level 3). Check 1%nat. Fail Reserved Notation "1". Notation """tt""" := tt (at level 2). Check "tt". Require Import String. Check "tt"%string. Fail Reserved Notation """tt""". (* Test string literals themselves with double quotes *) Notation """t""""t""" := tt. Check "t""t". Module A. (* Not forced to be a keyword *) Notation "# ""|"" a" := (Some a) (at level 0, a at level 0). Check # "|" true. Check "|"%string. (* Now forced to be a keyword *) Notation "a ""|"" b" := (a, b) (at level 50). Check 2 "|" 4. End A. Module B. Notation " ""I'm true"" " := true. Check "I'm true". Notation """""" := false. (* Empty string *) Check "". End B. Module C. Notation "symbolwith""doublequote" := true (only printing). Check true. Notation "'""'" := false (only printing). (* double quote *) Check false. End C. coq-8.20.0/test-suite/output/Notations.out000066400000000000000000000146241466560755400205710ustar00rootroot00000000000000true ? 0; 1 : nat if true as x return (x ? nat; bool) then 0 else true : nat fun e : nat * nat => proj1 e : nat * nat -> nat decomp (true, true) as t, u in (t, u) : bool * bool ! (0 = 0) : Prop forall n : nat, n = 0 : Prop ! (0 = 0) : Prop forall n : nat, # (n = n) : Prop forall n n0 : nat, ## (n = n0) : Prop forall n n0 : nat, ### (n = n0) : Prop 3 + 3 : Z 3 + 3 : znat [1; 2; 4] : list nat (1; 2, 4) : nat * nat * nat ifzero 3 : bool pred 3 : nat fun n : nat => pred n : nat -> nat fun n : nat => pred n : nat -> nat fun x : nat => ifn x is succ n then n else 0 : nat -> nat 1 - : bool -4 : Z File "./output/Notations.v", line 139, characters 46-62: The command has indeed failed with message: Cannot find where the recursive pattern starts. File "./output/Notations.v", line 142, characters 0-58: The command has indeed failed with message: in the right-hand side, y and z should appear in term position as part of a recursive pattern. File "./output/Notations.v", line 145, characters 57-58: The command has indeed failed with message: The reference w was not found in the current environment. File "./output/Notations.v", line 151, characters 0-78: The command has indeed failed with message: in the right-hand side, y and z should appear in term position as part of a recursive pattern. File "./output/Notations.v", line 152, characters 56-57: The command has indeed failed with message: z is expected to occur in binding position in the right-hand side. File "./output/Notations.v", line 156, characters 0-102: The command has indeed failed with message: as y is a non-closed binder, no such "," is allowed to occur. File "./output/Notations.v", line 160, characters 46-69: The command has indeed failed with message: Cannot find where the recursive pattern starts. File "./output/Notations.v", line 161, characters 46-62: The command has indeed failed with message: Cannot find where the recursive pattern starts. File "./output/Notations.v", line 162, characters 49-63: The command has indeed failed with message: Cannot find where the recursive pattern starts. File "./output/Notations.v", line 163, characters 50-64: The command has indeed failed with message: Cannot find where the recursive pattern starts. File "./output/Notations.v", line 166, characters 0-73: The command has indeed failed with message: Both ends of the recursive pattern are the same. SUM (nat * nat) nat : Set FST (0; 1) : Z Nil : forall A : Type, list A NIL : list nat : list nat (false && I 3)%bool /\ I 6 : Prop [|1, 2, 3; 4, 5, 6|] : Z * Z * Z * (Z * Z * Z) File "./output/Notations.v", line 211, characters 0-210: Warning: Notations "[| _ , _ , .. , _ ; _ , _ , .. , _ |]" defined at level 0 with arguments constr and "[| _ * ( _ , _ , .. , _ ) ; ( _ , _ , .. , _ ) * _ |]" defined at level 0 with arguments constr at level 39 have incompatible prefixes. One of them will likely not work. [notation-incompatible-prefix,parsing,default] [|0 * (1, 2, 3); (4, 5, 6) * false|] : Z * Z * (Z * Z) * (Z * Z) * (Z * bool * (Z * bool) * (Z * bool)) fun f : Z -> Z -> Z -> Z => {|f; 0; 1; 2|} : Z : (Z -> Z -> Z -> Z) -> Z {|fun x : Z => x + x; 0|} : Z {|op; 0; 1|} : Z false = 0 : Prop Init.Nat.add : nat -> nat -> nat S : nat -> nat Init.Nat.mul : nat -> nat -> nat le : nat -> nat -> Prop plus : nat -> nat -> nat succ : nat -> nat Init.Nat.mul : nat -> nat -> nat le : nat -> nat -> Prop fun x : option Z => match x with | SOME x0 => x0 | NONE => 0 end : option Z -> Z fun x : option Z => match x with | SOME2 x0 => x0 | NONE2 => 0 end : option Z -> Z fun x : option Z => match x with | SOME3 _ x0 => x0 | NONE3 _ => 0 end : option Z -> Z fun x : list ?T => match x with | NIL => NONE3 (list ?T) | (_ :') t => SOME3 (list ?T) t end : list ?T -> option (list ?T) where ?T : [x : list ?T x1 : list ?T x0 := x1 : list ?T |- Type] (x, x1, x0 cannot be used) s : s 10 : nat fun _ : nat => 9 : nat -> nat fun (x : nat) (p : x = x) => match p in (_ = n) return (n = n) with | ONE => ONE end = p : forall x : nat, x = x -> Prop fun (x : nat) (p : x = x) => match p in (_ = n) return (n = n) with | 1 => 1 end = p : forall x : nat, x = x -> Prop bar 0 : nat let k := rew [P] p in v in k : P y let k := rew [P] p in v in k : P y let k := rew <- [P] p in v' in k : P x let k := rew [P] p in v in k : P y let k := rew [P] p in v in k : P y let k := rew <- [P] p in v' in k : P x let k := rew [fun y : A => P y] p in v in k : P y let k := rew [fun y : A => P y] p in v in k : P y let k := rew <- [fun y : A => P y] p in v' in k : P x let k := rew [fun y : A => P y] p in v in k : P y let k := rew [fun y : A => P y] p in v in k : P y let k := rew <- [fun y : A => P y] p in v' in k : P x let k := rew dependent [P] p in v in k : P y p let k := rew dependent [P] p in v in k : P y p let k := rew dependent <- [P'] p in v' in k : P' x (eq_sym p) let k := rew dependent [P] p in v in k : P y p let k := rew dependent [P] p in v in k : P y p let k := rew dependent <- [P'] p in v' in k : P' x (eq_sym p) let k := rew dependent [P] p in v in k : P y p let k := rew dependent [P] p in v in k : P y p let k := rew dependent <- [P'] p in v' in k : P' x (eq_sym p) let k := rew dependent [fun y p => id (P y p)] p in v in k : P y p let k := rew dependent [fun y p => id (P y p)] p in v in k : P y p let k := rew dependent <- [fun y0 p => id (P' y0 p)] p in v' in k : P' x (eq_sym p) let k := rew dependent [P] p in v in k : P y p let k := rew dependent [P] p in v in k : P y p let k := rew dependent <- [P'] p in v' in k : P' x (eq_sym p) let k := rew dependent [fun y p0 => id (P y p0)] p in v in k : P y p let k := rew dependent [fun y p0 => id (P y p0)] p in v in k : P y p let k := rew dependent <- [fun y0 p0 => id (P' y0 p0)] p in v' in k : P' x (eq_sym p) rew dependent [P] p in v : P y p rew dependent <- [P'] p in v' : P' x (eq_sym p) rew dependent [fun a x => id (P a x)] p in v : id (P y p) rew dependent <- [fun a p' => id (P' a p')] p in v' : id (P' x (eq_sym p)) coq-8.20.0/test-suite/output/Notations.v000066400000000000000000000271711466560755400202300ustar00rootroot00000000000000(* Bug 5568, don't warn for notations in repeated module import *) Module foo. Notation compose := (fun g f => g f). Notation "g & f" := (compose g f) (at level 10). End foo. Import foo. Import foo. Import foo. (**********************************************************************) (* Notations for if and let (submitted by Roland Zumkeller) *) Notation "a ? b ; c" := (if a then b else c) (at level 10). Check (true ? 0 ; 1). Check if true as x return (if x then nat else bool) then 0 else true. Notation "'proj1' t" := (let (a,_) := t in a) (at level 1). Check (fun e : nat * nat => proj1 e). Notation "'decomp' a 'as' x , y 'in' b" := (let (x,y) := a in b) (at level 1). Check (decomp (true,true) as t, u in (t,u)). (**********************************************************************) (* Behaviour wrt to binding variables (submitted by Roland Zumkeller) *) Section A. Notation "! A" := (forall _:nat, A) (at level 60). Check ! (0=0). Check forall n, n=0. Check forall n:nat, 0=0. End A. (**********************************************************************) (* Behaviour wrt to binding variables (cf bug report #1186) *) Section B. Notation "# A" := (forall n:nat, n=n->A) (at level 60). Check forall n:nat, # (n=n). Notation "## A" := (forall n n0:nat, n=n0->A) (at level 60). Check forall n n0:nat, ## (n=n0). Notation "### A" := (forall n n0:nat, match n with O => True | S n => n=n0 end ->A) (at level 60). Check forall n n0:nat, ### (n=n0). End B. (**********************************************************************) (* Conflict between notation and notation below coercions *) (* Case of a printer conflict *) Require Import BinInt. Coercion Zpos : positive >-> Z. Open Scope Z_scope. (* Check that (Zpos 3) is better printed by the printer for Z than by the printer for positive *) Check (3 + Zpos 3). (* Case of a num printer only below coercion (submitted by Georges Gonthier) *) Open Scope nat_scope. Inductive znat : Set := Zpos (n : nat) | Zneg (m : nat). Coercion Zpos: nat >-> znat. Declare Scope znat_scope. Delimit Scope znat_scope with znat. Open Scope znat_scope. Parameter addz : znat -> znat -> znat. Notation "z1 + z2" := (addz z1 z2) : znat_scope. (* Check that "3+3", where 3 is in nat and the coercion to znat is implicit, is printed the same way, and not "S 2 + S 2" as if numeral printing was only tested with coercion still present *) Check (3+3). (**********************************************************************) (* Check recursive notations *) Require Import List. Notation "[ x ; .. ; y ]" := (cons x .. (cons y nil) ..). Check [1;2;4]. Reserved Notation "( x ; y , .. , z )" (at level 0). Notation "( x ; y , .. , z )" := (pair .. (pair x y) .. z). Check (1;2,4). (* Check basic notations involving "match" *) Section C. Notation "'ifzero' n" := (match n with 0 => true | S _ => false end) (at level 0, n at level 0). Check (ifzero 3). Notation "'pred' n" := (match n with 0 => 0 | S n' => n' end) (at level 0, n at level 0). Check (pred 3). Check (fun n => match n with 0 => 0 | S n => n end). Check (fun n => match n with S p as x => p | _ => 0 end). Notation "'ifn' x 'is' 'succ' n 'then' t 'else' u" := (match x with O => u | S n => t end) (at level 0, u at level 0). Check fun x => ifn x is succ n then n else 0. End C. (* Check correction of bug #1179 *) Notation "1 -" := true (at level 0). Check 1-. (* This is another aspect of bug #1179 (raises anomaly in 8.1) *) Require Import ZArith. Open Scope Z_scope. Notation "- 4" := (-2 + -2). Check -4. (**********************************************************************) (* Check ill-formed recursive notations *) (* Recursive variables not part of a recursive pattern *) Fail Notation "( x , y , .. , z )" := (pair x .. (pair y z) ..). (* No recursive notation *) Fail Notation "( x , y , .. , z )" := (pair x (pair y z)). (* Left-unbound variable *) Fail Notation "( x , y , .. , z )" := (pair x .. (pair y w) ..). (* Right-unbound variable *) Notation "( x , y , .. , z )" := (pair y .. (pair z 0) ..) (only parsing). (* Not the right kind of recursive pattern *) Fail Notation "( x , y , .. , z )" := (ex (fun z => .. (ex (fun y => x)) ..)). Fail Notation "( x -- y , .. , z )" := (pair y .. (pair z 0) ..) (y closed binder, z closed binder). (* No separator allowed with open binders *) Fail Notation "( x -- y , .. , z )" := (ex (fun z => .. (ex (fun y => x)) ..)) (y binder, z binder). (* Ends of pattern do not match *) Fail Notation "( x , y , .. , z )" := (pair y .. (pair (plus z) 0) ..). Fail Notation "( x , y , .. , z )" := (pair y .. (plus z 0) ..). Fail Notation "( x1 , x2 , y , .. , z )" := (y y .. (x2 z 0) ..). Fail Notation "( x1 , x2 , y , .. , z )" := (x1 y .. (x2 z 0) ..). (* Ends of pattern are the same *) Fail Notation "( x , y , .. , z )" := (pair .. (pair (pair y z) x) .. x). (**********************************************************************) (* Check preservation of scopes at printing time *) Notation SUM := sum. Check SUM (nat*nat) nat. (**********************************************************************) (* Check preservation of implicit arguments at printing time *) Notation FST := fst. Check FST (0;1). (**********************************************************************) (* Check notations for references with activated or deactivated *) (* implicit arguments *) Notation Nil := @nil. Check Nil. Notation NIL := nil. Check NIL : list nat. (**********************************************************************) (* Test printing of notation with coercions in scope of a coercion *) Open Scope nat_scope. Coercion is_true := fun b => b=true. Coercion of_nat n := match n with 0 => true | _ => false end. Notation "'I' x" := (of_nat (S x) || true)%bool (at level 10). Check (false && I 3)%bool /\ I 6. (**********************************************************************) (* Check notations with several recursive patterns *) Open Scope Z_scope. Notation "[| x , y , .. , z ; a , b , .. , c |]" := (pair (pair .. (pair x y) .. z) (pair .. (pair a b) .. c)). Check [|1,2,3;4,5,6|]. Notation "[| t * ( x , y , .. , z ) ; ( a , b , .. , c ) * u |]" := (pair (pair .. (pair (pair t x) (pair t y)) .. (pair t z)) (pair .. (pair (pair a u) (pair b u)) .. (pair c u))) (t at level 39). Check [|0*(1,2,3);(4,5,6)*false|]. (**********************************************************************) (* Test recursive notations involving applications *) Module Application. Notation "{| f ; x ; .. ; y |}" := ( .. (f x) .. y). (* Application to a variable *) Check fun f => {| f; 0; 1; 2 |} : Z. (* Application to a fun *) Check {| (fun x => x+x); 0 |}. (* Application to a reference *) Axiom op : Z -> Z -> Z. Check {| op; 0; 1 |}. (* Interaction with coercion *) Axiom c : Z -> bool. Coercion c : Z >-> bool. Check false = {| c; 0 |}. End Application. (**********************************************************************) (* Check printing of notations from other modules *) (* 1- Non imported case *) Require make_notation. Check plus. Check S. Check mult. Check le. (* 2- Imported case *) Import make_notation. Check plus. Check S. Check mult. Check le. (* Check notations in cases patterns *) Notation SOME := Some. Notation NONE := None. Check (fun x => match x with SOME x => x | NONE => 0 end). Notation NONE2 := (@None _). Notation SOME2 := (@Some _). Check (fun x => match x with SOME2 x => x | NONE2 => 0 end). Notation NONE3 := @None. Notation SOME3 := @Some. Check (fun x => match x with SOME3 _ x => x | NONE3 _ => 0 end). Notation "a :'" := (cons a) (at level 12). Check (fun x => match x with | nil => NONE | h :' t => SOME3 _ t end). (* Check correct matching of "Type" in notations. Of course the notation denotes a term that will be reinterpreted with a different universe than the actual one; but it would be the same anyway without a notation *) Notation s := Type. Check s. (* Test bug #2835: notations were not uniformly managed under prod and lambda *) Open Scope nat_scope. Notation "'foo' n" := (S n) (at level 50): nat_scope. Check (foo 9). Check (fun _ : nat => 9). (* Checking parsing and printing of numerical and non-numerical notations for eq_refl *) (* This notation was not correctly printed until Pierre B.'s improvements to the interpretation of patterns *) Notation "'ONE'" := eq_refl. Check fun (x:nat) (p : x=x) => match p with ONE => ONE end = p. (* This one used to failed at parsing until now *) Notation "1" := eq_refl. Check fun (x:nat) (p : x=x) => match p with 1 => 1 end = p. (* Check bug 5693 *) Module M. Definition A := 0. Definition bar (a b : nat) := plus a b. Notation "" := A (format "", only printing). Check (bar A 0). End M. (* Check eq notations *) Module EqNotationsCheck. Import EqNotations. Section nd. Context (A : Type) (x : A) (P : A -> Type) (y : A) (p : x = y) (v : P x) (v' : P y). Check let k : P y := rew p in v in k. Check let k : P y := rew -> p in v in k. Check let k : P x := rew <- p in v' in k. Check let k : P y := rew [P] p in v in k. Check let k : P y := rew -> [P] p in v in k. Check let k : P x := rew <- [P] p in v' in k. Check let k : P y := rew [fun y => P y] p in v in k. Check let k : P y := rew -> [fun y => P y] p in v in k. Check let k : P x := rew <- [fun y => P y] p in v' in k. Check let k : P y := rew [fun (y : A) => P y] p in v in k. Check let k : P y := rew -> [fun (y : A) => P y] p in v in k. Check let k : P x := rew <- [fun (y : A) => P y] p in v' in k. End nd. Section dep. Context (A : Type) (x : A) (P : forall y, x = y -> Type) (y : A) (p : x = y) (P' : forall x, y = x -> Type) (v : P x eq_refl) (v' : P' y eq_refl). Check let k : P y p := rew dependent p in v in k. Check let k : P y p := rew dependent -> p in v in k. Check let k : P' x (eq_sym p) := rew dependent <- p in v' in k. Check let k : P y p := rew dependent [P] p in v in k. Check let k : P y p := rew dependent -> [P] p in v in k. Check let k : P' x (eq_sym p) := rew dependent <- [P'] p in v' in k. Check let k : P y p := rew dependent [fun y p => P y p] p in v in k. Check let k : P y p := rew dependent -> [fun y p => P y p] p in v in k. Check let k : P' x (eq_sym p) := rew dependent <- [fun y p => P' y p] p in v' in k. Check let k : P y p := rew dependent [fun y p => id (P y p)] p in v in k. Check let k : P y p := rew dependent -> [fun y p => id (P y p)] p in v in k. Check let k : P' x (eq_sym p) := rew dependent <- [fun y p => id (P' y p)] p in v' in k. Check let k : P y p := rew dependent [(fun (y : A) (p : x = y) => P y p)] p in v in k. Check let k : P y p := rew dependent -> [(fun (y : A) (p : x = y) => P y p)] p in v in k. Check let k : P' x (eq_sym p) := rew dependent <- [(fun (x : A) (p : y = x) => P' x p)] p in v' in k. Check let k : P y p := rew dependent [(fun (y : A) (p : x = y) => id (P y p))] p in v in k. Check let k : P y p := rew dependent -> [(fun (y : A) (p : x = y) => id (P y p))] p in v in k. Check let k : P' x (eq_sym p) := rew dependent <- [(fun (x : A) (p : y = x) => id (P' x p))] p in v' in k. Check match p as x in _ = a return P a x with | eq_refl => v end. Check match eq_sym p as p' in _ = a return P' a p' with | eq_refl => v' end. Check match p as x in _ = a return id (P a x) with | eq_refl => v end. Check match eq_sym p as p' in _ = a return id (P' a p') with | eq_refl => v' end. End dep. End EqNotationsCheck. coq-8.20.0/test-suite/output/Notations2.out000066400000000000000000000037111466560755400206460ustar00rootroot000000000000002 3 : PAIR 2 [+] 3 : nat forall (A : Set) (le : A -> A -> Prop) (x y : A), le x y \/ le y x : Prop match (0, 0, 0) with | (x, y, z) => x + y + z end : nat let '(a, _, _) := (2, 3, 4) in a : nat exists myx y : bool, myx = y : Prop fun (P : nat -> nat -> Prop) (x : nat) => exists y, P x y : (nat -> nat -> Prop) -> nat -> Prop ∃ n p : nat, n + p = 0 : Prop let a := 0 in ∃ (x y : nat) (b := 1) (c := b) (d := 2) (z : nat), let e := 3 in let f := 4 in x + y = z + d : Prop ∀ n p : nat, n + p = 0 : Prop λ n p : nat, n + p = 0 : nat -> nat -> Prop λ (A : Type) (n p : A), n = p : ∀ A : Type, A -> A -> Prop λ A : Type, ∃ n p : A, n = p : Type -> Prop λ A : Type, ∀ n p : A, n = p : Type -> Prop let' f (x y : nat) (a := 0) (z : nat) (_ : bool) := x + y + z + 1 in f 0 1 2 : bool -> nat λ (f : nat -> nat) (x : nat), f(x) + S(x) : (nat -> nat) -> nat -> nat Notation plus2 n := (S(S(n))) λ n : list(nat), match n with | list1 => 0 | _ => 2 end : list(nat) -> nat λ n : list(nat), match n with | list1 => 0 | nil | 0 :: _ | 1 :: _ :: _ | plus2 _ :: _ => 2 end : list(nat) -> nat λ n : list(nat), match n with | nil => 2 | 0 :: _ => 2 | list1 => 0 | 1 :: _ :: _ => 2 | plus2 _ :: _ => 2 end : list(nat) -> nat # x : nat => x : nat -> nat # _ : nat => 2 : nat -> nat # x : nat => # H : x <= 0 => exist (le x) 0 H : ∀ x : nat, x <= 0 -> {x0 : nat | x <= x0} exist (Q x) y conj : {x0 : A | Q x x0} % i : nat -> nat % j : nat -> nat {1, 2} : nat -> Prop a# : Set a# : Set a≡ : Set a≡ : Set .≡ : Set .≡ : Set .a# : Set .a# : Set .a≡ : Set .a≡ : Set .α : Set .α : Set # a : .α => # b : .α => let res := 0 in for i from 0 to a updating (res) {{for j from 0 to b updating (res) {{S res}};; res}};; res : .α -> .α -> .α coq-8.20.0/test-suite/output/Notations2.v000066400000000000000000000114731466560755400203100ustar00rootroot00000000000000(**********************************************************************) (* Test call to primitive printers in presence of coercion to *) (* functions (cf bug #2044) *) Inductive PAIR := P (n1:nat) (n2:nat). Coercion P : nat >-> Funclass. Check (2 3). (* Check that notations with coercions to functions inserted still work *) (* (were not working from revision 11886 to 12951) *) Record Binop := { binop :> nat -> nat -> nat }. Class Plusop := { plusop : Binop; zero : nat }. Infix "[+]" := plusop (at level 40). #[global] Instance Plus : Plusop := {| plusop := {| binop := plus |} ; zero := 0 |}. Check 2[+]3. (* Test bug #2091 (variable le was printed using <= !) *) Check forall (A: Set) (le: A -> A -> Prop) (x y: A), le x y \/ le y x. (* Test recursive notations in cases pattern *) Remove Printing Let prod. Check match (0,0,0) with (x,y,z) => x+y+z end. Check let '(a,b,c) := ((2,3),4) in a. (* Check printing of notations with mixed reserved binders (see bug #2571) *) Implicit Type myx : bool. Check exists myx y, myx = y. (* Test notation for anonymous functions up to eta-expansion *) Check fun P:nat->nat->Prop => fun x:nat => ex (P x). (* Test notations with binders *) Notation "∃ x .. y , P":= (ex (fun x => .. (ex (fun y => P)) ..)) (x binder, y binder, at level 200, right associativity, format "'[ ' ∃ x .. y ']' , P"). Check (∃ n p, n+p=0). Check ∃ (a:=0) (x:nat) y (b:=1) (c:=b) (d:=2) z (e:=3) (f:=4), x+y = z+d. Notation "∀ x .. y , P":= (forall x, .. (forall y, P) ..) (x binder, at level 200, right associativity). Check (∀ n p, n+p=0). Notation "'λ' x .. y , P":= (fun x => .. (fun y => P) ..) (y binder, at level 200, right associativity). Check (λ n p, n+p=0). Generalizable Variable A. Check `(λ n p : A, n=p). Check `(∃ n p : A, n=p). Check `(∀ n p : A, n=p). Notation "'let'' f x .. y := t 'in' u":= (let f := fun x => .. (fun y => t) .. in u) (f name, x closed binder, y closed binder, at level 200, right associativity). Check let' f x y (a:=0) z (b:bool) := x+y+z+1 in f 0 1 2. (* In practice, only the printing rule is used here *) (* Note: does not work for pattern *) Module A. Notation "f ( x )" := (f x) (at level 10, format "f ( x )"). Check fun f x => f x + S x. Open Scope list_scope. Notation list1 := (1::nil)%list. Notation plus2 n := (S (S n)). (* plus2 was not correctly printed in the two following tests in 8.3pl1 *) Print plus2. Check fun n => match n with list1 => 0 | _ => 2 end. Unset Printing Allow Match Default Clause. Check fun n => match n with list1 => 0 | _ => 2 end. Unset Printing Factorizable Match Patterns. Check fun n => match n with list1 => 0 | _ => 2 end. Set Printing Allow Match Default Clause. Set Printing Factorizable Match Patterns. End A. (* This one is not fully satisfactory because binders in the same type are re-factorized and parentheses are needed even for atomic binder Notation "'mylet' f [ x ; .. ; y ] := t 'in' u":= (let f := fun x => .. (fun y => t) .. in u) (f name, x closed binder, y closed binder, at level 200, right associativity). Check mylet f [x;y;z;(a:bool)] := x+y+z+1 in f 0 1 2. *) (* Check notations for functional terms which do not necessarily depend on their parameter *) (* Old request mentioned again on coq-club 20/1/2012 *) Notation "# x : T => t" := (fun x : T => t) (at level 0, t at level 200, x name). Check # x : nat => x. Check # _ : nat => 2. (* Check bug 4677 *) Check fun x (H:le x 0) => exist (le x) 0 H. Parameters (A : Set) (x y : A) (Q : A -> A -> Prop) (conj : Q x y). Check (exist (Q x) y conj). (* Check bug #4854 *) Notation "% i" := (fun i : nat => i) (at level 0, i name). Check %i. Check %j. (* Check bug raised on coq-club on Sep 12, 2016 *) Notation "{ x , y , .. , v }" := (fun a => (or .. (or (a = x) (a = y)) .. (a = v))). Check ({1, 2}). (**********************************************************************) (* Check notations of the form ".a", ".a≡", "a≡" *) (* Only "a#", "a≡" and ".≡" were working properly for parsing. The *) (* other ones were working only for printing. *) Notation "a#" := nat. Check nat. Check a#. Notation "a≡" := nat. Check nat. Check a≡. Notation ".≡" := nat. Check nat. Check .≡. Notation ".a#" := nat. Check nat. Check .a#. Notation ".a≡" := nat. Check nat. Check .a≡. Notation ".α" := nat. Check nat. Check .α. (* A test for #6304 *) Module M6304. Notation "'for' m 'from' 0 'to' N 'updating' ( s1 ) {{ b }} ;; rest" := (let s1 := (fix rec(n: nat) := match n with | 0 => s1 | S m => let s1 := rec m in b end) N in rest) (at level 20). Check fun (a b : nat) => let res := 0 in for i from 0 to a updating (res) {{ for j from 0 to b updating (res) {{ S res }};; res }};; res. End M6304. coq-8.20.0/test-suite/output/Notations3.out000066400000000000000000000211621466560755400206470ustar00rootroot00000000000000{x : nat | x = 0} + {True /\ False} + {forall x : nat, x = 0} : Set [<0, 2 >] : nat * nat * (nat * nat) [<0, 2 >] : nat * nat * (nat * nat) (0, 2, (2, 2)) : nat * nat * (nat * nat) pair (pair 0 2) (pair 2 0) : prod (prod nat nat) (prod nat nat) << 0, 2, 4 >> : nat * nat * nat * (nat * (nat * nat)) << 0, 2, 4 >> : nat * nat * nat * (nat * (nat * nat)) (0, 2, 4, (2, (2, 0))) : nat * nat * nat * (nat * (nat * nat)) (0, 2, 4, (0, (2, 4))) : nat * nat * nat * (nat * (nat * nat)) pair (pair (pair 0 2) 4) (pair 4 (pair 2 0)) : prod (prod (prod nat nat) nat) (prod nat (prod nat nat)) ETA x y : nat, Nat.add : nat -> nat -> nat ETA x y : nat, Nat.add : nat -> nat -> nat ETA x y : nat, Nat.add : nat -> nat -> nat fun x y : nat => Nat.add x y : forall (_ : nat) (_ : nat), nat ETA x y : nat, le_S : forall x y : nat, x <= y -> x <= S y fun f : forall x : nat * (bool * unit), ?T => CURRY (x : nat) (y : bool), f : (forall x : nat * (bool * unit), ?T) -> forall (x : nat) (y : bool), ?T@{x:=(x, (y, tt))} where ?T : [x : nat * (bool * unit) |- Type] fun f : forall x : bool * (nat * unit), ?T => CURRYINV (x : nat) (y : bool), f : (forall x : bool * (nat * unit), ?T) -> forall (x : nat) (y : bool), ?T@{x:=(y, (x, tt))} where ?T : [x : bool * (nat * unit) |- Type] fun f : forall x : unit * nat * bool, ?T => CURRYLEFT (x : nat) (y : bool), f : (forall x : unit * nat * bool, ?T) -> forall (x : nat) (y : bool), ?T@{x:=(tt, x, y)} where ?T : [x : unit * nat * bool |- Type] fun f : forall x : unit * bool * nat, ?T => CURRYINVLEFT (x : nat) (y : bool), f : (forall x : unit * bool * nat, ?T) -> forall (x : nat) (y : bool), ?T@{x:=(tt, y, x)} where ?T : [x : unit * bool * nat |- Type] forall n : nat, {#n | 1 > n} : Prop forall x : nat, {|x | x > 0|} : Prop exists2 x : nat, x = 1 & x = 2 : Prop fun n : nat => foo2 n (fun x y z : nat => (fun _ _ _ : nat => x + y + z = 0) z y x) : nat -> Prop fun n : nat => foo2 n (fun a b c : nat => (fun _ _ _ : nat => a + b + c = 0) c b a) : nat -> Prop fun n : nat => foo2 n (fun n0 y z : nat => (fun _ _ _ : nat => n0 + y + z = 0) z y n0) : nat -> Prop fun n : nat => foo2 n (fun x n0 z : nat => (fun _ _ _ : nat => x + n0 + z = 0) z n0 x) : nat -> Prop fun n : nat => foo2 n (fun x y n0 : nat => (fun _ _ _ : nat => x + y + n0 = 0) n0 y x) : nat -> Prop fun n : nat => {|n, y | fun _ _ _ : nat => n + y = 0 |}_2 : nat -> Prop fun n : nat => {|n, y | fun _ _ _ : nat => n + y = 0 |}_2 : nat -> Prop fun n : nat => {|n, n0 | fun _ _ _ : nat => n + n0 = 0 |}_2 : nat -> Prop fun n : nat => foo2 n (fun x y z : nat => (fun _ _ _ : nat => x + y + n = 0) z y x) : nat -> Prop fun n : nat => foo2 n (fun x y z : nat => (fun _ _ _ : nat => x + y + n = 0) z y x) : nat -> Prop fun n : nat => {|n, fun _ : nat => 0 = 0 |}_3 : nat -> Prop fun n : nat => {|n, fun _ : nat => n = 0 |}_3 : nat -> Prop fun n : nat => foo3 n (fun x _ : nat => ETA z : nat, (fun _ : nat => x = 0)) : nat -> Prop fun n : nat => {|n, fun _ : nat => 0 = 0 |}_4 : nat -> Prop fun n : nat => {|n, fun _ : nat => n = 0 |}_4 : nat -> Prop fun n : nat => foo4 n (fun _ _ : nat => ETA z : nat, (fun _ : nat => z = 0)) : nat -> Prop fun n : nat => foo4 n (fun _ y : nat => ETA z : nat, (fun _ : nat => y = 0)) : nat -> Prop tele (t : Type) '(y, z) (x : t0) := tt : forall t : Type, nat * nat -> t -> fpack [fun x : nat => x + 0;; fun x : nat => x + 1;; fun x : nat => x + 2] : (nat -> nat) * ((nat -> nat) * ((nat -> nat) * ((nat -> nat) * ((nat -> nat) * ((nat -> nat) * (nat -> nat)))))) foo5 x nat x : nat -> nat fun x : ?A => x === x : forall x : ?A, x = x where ?A : [x : ?A |- Type] (x cannot be used) {{0, 1}} : nat * nat {{0, 1, 2}} : nat * (nat * nat) {{0, 1, 2, 3}} : nat * (nat * (nat * nat)) File "./output/Notations3.v", line 178, characters 0-174: Warning: Closed notations (i.e. starting and ending with a terminal symbol) should usually be at level 0 (default). [closed-notation-not-level-0,parsing,default] letpair x [1] = {0}; return (1, 2, 3, 4) : nat * nat * nat * nat ((*1).2).3 : nat *(1.2) : nat {{ 1 | 1 // 1 }} : nat !!! _ _ : nat, True : (nat -> Prop) * ((nat -> Prop) * Prop) ! '{{x, y}}, x.y = 0 : Prop exists_mixed (x y : nat) '{{u, t}}, x.y = 0 /\ u.t = 0 : Prop exists_mixed (x y : nat) '{{z, t}}, x.y = 0 /\ z.t = 0 : Prop exists_true '{{x, y}} (u := 0) '{{z, t}}, x.y = 0 /\ z.t = 0 : Prop exists_true (A : Type) (R : A -> A -> Prop) (_ : Reflexive R), (forall x : A, R x x) : Prop exists_true (x : nat) (A : Type) (R : A -> A -> Prop) (_ : Reflexive R) (y : nat), x.y = 0 -> forall z : A, R z z : Prop !! _ _ : nat # True # : Prop * Prop * Prop {{D 1, 2}} : nat * nat * (nat * nat * (nat * nat)) File "./output/Notations3.v", line 235, characters 0-104: Warning: Notations "! _ .. _ , _" defined at level 200 with arguments binder, constr at next level and "! _ .. _ # _ #" defined at level 200 with arguments binder, constr have incompatible prefixes. One of them will likely not work. [notation-incompatible-prefix,parsing,default] ! a b : nat # True # : Prop * (Prop * Prop) !!!! a b : nat # True # : Prop * Prop * (Prop * Prop * Prop) @@ a b : nat # a = b # b = a # : Prop * Prop exists_non_null x y z t : nat , x = y /\ z = t : Prop forall_non_null x y z t : nat , x = y /\ z = t : Prop {{RL 1, 2}} : nat * (nat * nat) {{RR 1, 2}} : nat * nat * nat @pair nat (prod nat nat) (S (S O)) (@pair nat nat (S O) O) : prod nat (prod nat nat) @pair (prod nat nat) nat (@pair nat nat O (S (S O))) (S O) : prod (prod nat nat) nat {{RLRR 1, 2}} : nat * (nat * nat) * (nat * nat * nat) * (nat * (nat * nat)) * (nat * nat * nat) pair (pair (pair (pair 2 (pair 1 0)) (pair (pair 0 2) 1)) (pair 1 (pair 2 0))) (pair (pair 0 1) 2) : prod (prod (prod (prod nat (prod nat nat)) (prod (prod nat nat) nat)) (prod nat (prod nat nat))) (prod (prod nat nat) nat) fun x : nat => if x is n .+ 1 then n else 1 : nat -> nat {'{{x, y}} : nat * nat | x.y = 0} : Set exists2' {{x, y}}, x = 0 & y = 0 : Prop myexists2 x : nat * nat, let '{{y, z}} := x in y > z & let '{{y, z}} := x in z > y : Prop fun '({{x, y}} as z) => x.y = 0 /\ z = z : nat * nat -> Prop myexists ({{x, y}} as z), x.y = 0 /\ z = z : Prop exists '({{x, y}} as z), x.y = 0 /\ z = z : Prop ∀ '({{x, y}} as z), x.y = 0 /\ z = z : Prop fun '({{{{x, y}}, true}} | {{{{x, y}}, false}}) => x.y : nat * nat * bool -> nat myexists ({{{{x, y}}, true}} | {{{{x, y}}, false}}), x > y : Prop exists '({{{{x, y}}, true}} | {{{{x, y}}, false}}), x > y : Prop ∀ '({{{{x, y}}, true}} | {{{{x, y}}, false}}), x > y : Prop fun p : nat => if p is S n then n else 0 : nat -> nat fun p : comparison => if p is Lt then 1 else 0 : comparison -> nat fun S : nat => [S | S.S] : nat -> nat * (nat -> nat) fun N : nat => [N | N.0] : nat -> nat * (nat -> nat) fun S : nat => [[S | S.S]] : nat -> nat * (nat -> nat) {I : nat | I = I} : Set {'I : True | I = I} : Prop {'{{x, y}} : nat * nat | x.y = 0} : Set exists2 '{{y, z}} : nat * nat, y > z & z > y : Prop foo = fun l : list nat => match l with | _ :: (_ :: _) as l1 => l1 | _ => l end : list nat -> list nat Arguments foo l%list_scope 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 goal ============================ ##@% ^^^ myfoo01 tt : nat myfoo01 tt : nat myfoo01 tt : nat 1 ⪯ 2 ⪯ 3 ⪯ 4 : Prop 1 goal x : nat ============================ |-_0 x 1 goal xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx : nat ============================ |-_0 xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx * xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx FORALL [[a, b]], a - b = 0 : Prop ∀ (A : TypTerm) (B : ◻ A -> TypTerm), (∀ a : ◻ A, ◻ {B a}) -> ◻ (∀' {a : ◻ A}, {B a}) : Type FORALL [[a, b]], a - b = 0 : Prop ∀ a b : nat, a - b = 0 : Prop fun x : option unit => match x with | # tt & => # tt & | None => None end : option unit -> option unit coq-8.20.0/test-suite/output/Notations3.v000066400000000000000000000434141466560755400203110ustar00rootroot00000000000000(**********************************************************************) (* Check precedence, spacing, etc. in printing with curly brackets *) Check {x|x=0}+{True/\False}+{forall x, x=0}. (**********************************************************************) (* Check printing of notations with several instances of a recursive pattern *) (* Was wrong but I could not trigger a problem due to the collision between *) (* different instances of ".." *) Notation "[< x , y , .. , z >]" := (pair (.. (pair x y) ..) z,pair y ( .. (pair z x) ..)). Check [<0,2>]. Check ((0,2),(2,0)). Check ((0,2),(2,2)). Unset Printing Notations. Check [<0,2>]. Set Printing Notations. Notation "<< x , y , .. , z >>" := ((.. (x,y) .., z),(z, .. (y,x) ..)). Check <<0,2,4>>. Check (((0,2),4),(4,(2,0))). Check (((0,2),4),(2,(2,0))). Check (((0,2),4),(0,(2,4))). Unset Printing Notations. Check <<0,2,4>>. Set Printing Notations. (**********************************************************************) (* Check notations with recursive notations both in binders and terms *) Notation "'ETA' x .. y , f" := (fun x => .. (fun y => (.. (f x) ..) y ) ..) (at level 200, x binder, y binder). Check ETA (x:nat) (y:nat), Nat.add. Check ETA (x y:nat), Nat.add. Check ETA x y, Nat.add. Unset Printing Notations. Check ETA (x:nat) (y:nat), Nat.add. Set Printing Notations. Check ETA x y, le_S. Notation "'CURRY' x .. y , f" := (fun x => .. (fun y => f (x, .. (y,tt) ..)) ..) (at level 200, x binder, y binder). Check fun f => CURRY (x:nat) (y:bool), f. Notation "'CURRYINV' x .. y , f" := (fun x => .. (fun y => f (y, .. (x,tt) ..)) ..) (at level 200, x binder, y binder). Check fun f => CURRYINV (x:nat) (y:bool), f. Notation "'CURRYLEFT' x .. y , f" := (fun x => .. (fun y => f (.. (tt,x) .., y)) ..) (at level 200, x binder, y binder). Check fun f => CURRYLEFT (x:nat) (y:bool), f. Notation "'CURRYINVLEFT' x .. y , f" := (fun x => .. (fun y => f (.. (tt,y) .., x)) ..) (at level 200, x binder, y binder). Check fun f => CURRYINVLEFT (x:nat) (y:bool), f. (**********************************************************************) (* Notations with variables bound both as a term and as a binder *) (* This is #4592 *) Notation "{# x | P }" := (ex2 (fun y => x = y) (fun x => P)). Check forall n:nat, {# n | 1 > n}. Parameter foo : forall {T}(x : T)(P : T -> Prop), Prop. Notation "{| x | P |}" := (foo x (fun x => P)). Check forall x:nat, {| x | x > 0 |}. Check ex2 (fun x => x=1) (fun x0 => x0=2). (* Other tests about alpha-conversions: the following notation contains all three kinds of bindings: - x is bound in the lhs as a term and a binder: its name is forced by its position as a term; it can bind variables in P - y is bound in the lhs as a binder only: its name is given by its name as a binder in the term to display; it can bind variables in P - z is a binder local to the rhs; it cannot bind a variable in P *) Parameter foo2 : forall {T}(x : T)(P : T -> T -> T -> Prop), Prop. Notation "{| x , y | P |}_2" := (foo2 x (fun x y z => P z y x)). (* Not printable: z (resp c, n) occurs in P *) Check fun n => foo2 n (fun x y z => (fun _ _ _ => x+y+z=0) z y x). Check fun n => foo2 n (fun a b c => (fun _ _ _ => a+b+c=0) c b a). Check fun n => foo2 n (fun n y z => (fun _ _ _ => n+y+z=0) z y n). Check fun n => foo2 n (fun x n z => (fun _ _ _ => x+n+z=0) z n x). Check fun n => foo2 n (fun x y n => (fun _ _ _ => x+y+n=0) n y x). (* Printable *) Check fun n => foo2 n (fun x y z => (fun _ _ _ => x+y=0) z y x). Check fun n => foo2 n (fun n y z => (fun _ _ _ => n+y=0) z y n). Check fun n => foo2 n (fun x n z => (fun _ _ _ => x+n=0) z n x). (* Not printable: renaming x into n would bind the 2nd occurrence of n *) Check fun n => foo2 n (fun x y z => (fun _ _ _ => x+y+n=0) z y x). Check fun n => foo2 n (fun x y z => (fun _ _ _ => x+y+n=0) z y x). (* Other tests *) Parameter foo3 : forall {T}(x : T)(P : T -> T -> T -> Prop), Prop. Notation "{| x , P |}_3" := (foo3 x (fun x x x => P x)). (* Printable *) Check fun n : nat => foo3 n (fun x y z => (fun _ => 0=0) z). Check fun n => foo3 n (fun x y z => (fun _ => z=0) z). (* Not printable: renaming z in n would hide the renaming of x into n *) Check fun n => foo3 n (fun x y z => (fun _ => x=0) z). (* Other tests *) Parameter foo4 : forall {T}(x : T)(P : T -> T -> T -> Prop), Prop. Notation "{| x , P |}_4" := (foo4 x (fun x _ z => P z)). (* Printable *) Check fun n : nat => foo4 n (fun x y z => (fun _ => 0=0) z). Check fun n => foo4 n (fun x y z => (fun _ => x=0) z). (* Not printable: y, z not allowed to occur in P *) Check fun n => foo4 n (fun x y z => (fun _ => z=0) z). Check fun n => foo4 n (fun x y z => (fun _ => y=0) z). (**********************************************************************) (* Test printing of #4932 *) Inductive ftele : Type := | fb {T:Type} : T -> ftele | fr {T} : (T -> ftele) -> ftele. Fixpoint args ftele : Type := match ftele with | fb _ => unit | fr f => sigT (fun t => args (f t)) end. Definition fpack := sigT args. Definition pack fp fa : fpack := existT _ fp fa. Notation "'tele' x .. z := b" := (fun x => .. (fun z => pack (fr (fun x => .. ( fr (fun z => fb b) ) .. ) ) (existT _ x .. (existT _ z tt) .. ) ) ..) (at level 85, x binder, z binder). Check tele (t:Type) '((y,z):nat*nat) (x:t) := tt. (* Checking that "fun" in a notation does not mixed up with the detection of a recursive binder *) Notation "[ x ;; .. ;; y ]" := ((x,((fun u => S u), .. (y,(fun u => S u,fun v:nat => v)) ..))). Check [ fun x => x+0 ;; fun x => x+1 ;; fun x => x+2 ]. (* Cyprien's part of bug #4765 *) Section Bug4765. Notation foo5 x T y := (fun x : T => y). Check foo5 x nat x. End Bug4765. (**********************************************************************) (* Test printing of #5526 *) Notation "x === x" := (eq_refl x) (only printing, at level 10). Check (fun x => eq_refl x). (* Test recursive notations with the recursive pattern repeated on the right *) Notation "{{ x , .. , y , z }}" := (pair x .. (pair y z) ..). Check {{0,1}}. Check {{0,1,2}}. Check {{0,1,2,3}}. (* Test printing of #5608 *) Reserved Notation "'letpair' x [1] = { A } ; 'return' ( b0 , b1 , .. , b2 )" (at level 200, format "'letpair' x [1] = { A } ; '//' 'return' ( b0 , b1 , .. , b2 )"). Notation "'letpair' x [1] = { a } ; 'return' ( b0 , b1 , .. , b2 )" := (let x:=a in ( .. (b0,b1) .., b2)). Check letpair x [1] = {0}; return (1,2,3,4). (* Allow level for leftmost nonterminal when printing-only, BZ#5739 *) Notation "* x" := (id x) (only printing, at level 15, format "* x"). Notation "x . y" := (x + y) (only printing, at level 20, x at level 14, left associativity, format "x . y"). Check (((id 1) + 2) + 3). Check (id (1 + 2)). (* Test spacing in #5569 *) Notation "{ { xL | xR // xcut } }" := (xL+xR+xcut) (at level 0, xR at level 39, format "{ { xL | xR // xcut } }"). Check 1+1+1. (* Test presence of notation variables in the recursive parts (introduced in dfdaf4de) *) Notation "!!! x .. y , b" := ((fun x => b), .. ((fun y => b), True) ..) (at level 200, x binder). Check !!! (x y:nat), True. (* Test contraction of "forall x, let 'pat := x in ..." into "forall 'pat, ..." *) (* for isolated "forall" (was not working already in 8.6) *) Notation "! x .. y , A" := (id (forall x, .. (id (forall y, A)) .. )) (at level 200, x binder). Check ! '(x,y), x+y=0. (* Check that the terminator of a recursive pattern is interpreted in the correct environment of bindings *) Notation "'exists_mixed' x .. y , P" := (ex (fun x => forall z:nat, .. (ex (fun y => forall z:nat, z=0 /\ P)) ..)) (at level 200, x binder). Check exists_mixed x y '(u,t), x+y=0/\u+t=0. Check exists_mixed x y '(z,t), x+y=0/\z+t=0. (* Check that intermediary let-in are inserted in between instances of the repeated pattern *) Notation "'exists_true' x .. y , P" := (exists x, True /\ .. (exists y, True /\ P) ..) (at level 200, x binder). Check exists_true '(x,y) (u:=0) '(z,t), x+y=0/\z+t=0. (* Check that generalized binders are correctly interpreted *) Module G. Generalizable Variables A R. Class Reflexive {A:Type} (R : A->A->Prop) := reflexivity : forall x : A, R x x. Check exists_true `(Reflexive A R), forall x, R x x. Check exists_true x `(Reflexive A R) y, x+y=0 -> forall z, R z z. End G. (* Allows recursive patterns for binders to be associative on the left *) Notation "!! x .. y # A #" := (.. (A,(forall x, True)) ..,(forall y, True)) (at level 200, x binder). Check !! a b : nat # True #. (* Examples where the recursive pattern refer several times to the recursive variable *) Notation "{{D x , .. , y }}" := ((x,x), .. ((y,y),(0,0)) ..). Check {{D 1, 2 }}. Notation "! x .. y # A #" := ((forall x, x=x), .. ((forall y, y=y), A) ..) (at level 200, x binder). Check ! a b : nat # True #. Notation "!!!! x .. y # A #" := (((forall x, x=x),(forall x, x=0)), .. (((forall y, y=y),(forall y, y=0)), A) ..) (at level 200, x binder). Check !!!! a b : nat # True #. Notation "@@ x .. y # A # B #" := ((forall x, .. (forall y, A) ..), (forall x, .. (forall y, B) ..)) (at level 200, x binder). Check @@ a b : nat # a=b # b=a #. Notation "'exists_non_null' x .. y , P" := (ex (fun x => x <> 0 /\ .. (ex (fun y => y <> 0 /\ P)) ..)) (at level 200, x binder). Check exists_non_null x y z t , x=y/\z=t. Notation "'forall_non_null' x .. y , P" := (forall x, x <> 0 -> .. (forall y, y <> 0 -> P) ..) (at level 200, x binder). Check forall_non_null x y z t , x=y/\z=t. (* Examples where the recursive pattern is in reverse order *) Notation "{{RL c , .. , d }}" := (pair d .. (pair c 0) ..). Check {{RL 1 , 2}}. Notation "{{RR c , .. , d }}" := (pair .. (pair 0 d) .. c). Check {{RR 1 , 2}}. Set Printing All. Check {{RL 1 , 2}}. Check {{RR 1 , 2}}. Unset Printing All. Notation "{{RLRR c , .. , d }}" := (pair d .. (pair c 0) .., pair .. (pair 0 d) .. c, pair c .. (pair d 0) .., pair .. (pair 0 c) .. d). Check {{RLRR 1 , 2}}. Unset Printing Notations. Check {{RLRR 1 , 2}}. Set Printing Notations. (* Check insensitivity of "match" clauses to order *) Module IfPat. Notation "'if' t 'is' n .+ 1 'then' p 'else' q" := (match t with S n => p | 0 => q end) (at level 200). Check fun x => if x is n.+1 then n else 1. End IfPat. (* Examples with binding patterns *) Check {'(x,y)|x+y=0}. Module D. Notation "'exists2'' x , p & q" := (ex2 (fun x => p) (fun x => q)) (at level 200, x pattern, p at level 200, right associativity, format "'[' 'exists2'' '/ ' x , '/ ' '[' p & '/' q ']' ']'") : type_scope. Check exists2' (x,y), x=0 & y=0. End D. (* Ensuring for reparsability that printer of notations does not use a pattern where only an ident could be reparsed *) Module E. Inductive myex2 {A:Type} (P Q:A -> Prop) : Prop := myex_intro2 : forall x:A, P x -> Q x -> myex2 P Q. Notation "'myexists2' x : A , p & q" := (myex2 (A:=A) (fun x => p) (fun x => q)) (at level 200, x name, A at level 200, p at level 200, right associativity, format "'[' 'myexists2' '/ ' x : A , '/ ' '[' p & '/' q ']' ']'") : type_scope. Check myex2 (fun x => let '(y,z) := x in y>z) (fun x => let '(y,z) := x in z>y). End E. (* A canonical example of a notation with a non-recursive binder *) Parameter myex : forall {A}, (A -> Prop) -> Prop. Notation "'myexists' x , p" := (myex (fun x => p)) (at level 200, x pattern, p at level 200, right associativity). (* A canonical example of a notation with recursive binders *) Notation "∀ x .. y , P" := (forall x, .. (forall y, P) ..) (at level 200, x binder, y binder, right associativity) : type_scope. (* Check that printing 'pat uses an "as" when the variable bound to the pattern is dependent. We check it for the three kinds of notations involving bindings of patterns *) Check fun '((x,y) as z) => x+y=0/\z=z. (* Primitive fun/forall *) Check myexists ((x,y) as z), x+y=0/\z=z. (* Isolated binding pattern *) Check exists '((x,y) as z), x+y=0/\z=z. (* Applicative recursive binder *) Check ∀ '((x,y) as z), x+y=0/\z=z. (* Other example of recursive binder, now treated as the exists case *) (* Check parsability and printability of irrefutable disjunctive patterns *) Check fun '(((x,y),true)|((x,y),false)) => x+y. Check myexists (((x,y),true)|((x,y),false)), x>y. Check exists '(((x,y),true)|((x,y),false)), x>y. Check ∀ '(((x,y),true)|((x,y),false)), x>y. (* Check Georges' printability of a "if is then else" notation *) Module IfPat2. Notation "'if' c 'is' p 'then' u 'else' v" := (match c with p => u | _ => v end) (at level 200, p pattern at level 100). Check fun p => if p is S n then n else 0. Check fun p => if p is Lt then 1 else 0. End IfPat2. (* Check that mixed binders and terms defaults to ident and not pattern *) Module F. (* First without an indirection *) Notation "[ n | t ]" := (n, (fun n : nat => t)). Check fun S : nat => [ S | S+S ]. Check fun N : nat => (N, (fun n => n+0)). (* another test in passing *) (* Then with an indirection *) Notation "[[ n | p | t ]]" := (n, (fun p : nat => t)). Notation "[[ n | t ]]" := [[ n | n | t ]]. Check fun S : nat => [[ S | S+S ]]. End F. (* Check parsability/printability of {x|P} and variants *) Check {I:nat|I=I}. Check {'I:True|I=I}. Check {'(x,y)|x+y=0}. (* Check exists2 with a pattern *) Check ex2 (fun x => let '(y,z) := x in y>z) (fun x => let '(y,z) := x in z>y). Module Issue7110. Open Scope list_scope. Notation "[ :: x1 , x2 , .. , xn & s ]" := (x1 :: x2 :: .. (xn :: s) ..) (at level 0). Definition foo (l : list nat) := match l with | a :: (b :: l) as l1 => l1 | _ => l end. Print foo. End Issue7110. Module LocateNotations. Locate "exists". Locate "( _ , _ , .. , _ )". End LocateNotations. Module Issue7731. Axiom (P : nat -> Prop). Parameter (X : nat). Notation "## @ E ^^^" := (P E) (at level 20, E at level 1, format "'[ ' ## '/' @ E '/' ^^^ ']'"). Notation "%" := X. Set Printing Width 7. Goal ## @ % ^^^. Show. Abort. End Issue7731. Module Issue8126. Definition myfoo (x : nat) (y : nat) (z : unit) := y. Notation myfoo0 := (@myfoo 0). Notation myfoo01 := (@myfoo0 1). Check myfoo 0 1 tt. (* was printing [myfoo0 1 HI], but should print [myfoo01 HI] *) Check myfoo0 1 tt. (* was printing [myfoo0 1 HI], but should print [myfoo01 HI] *) Check myfoo01 tt. (* was printing [myfoo0 1 HI], but should print [myfoo01 HI] *) End Issue8126. Module RecursiveNotationPartialApp. (* Discussed on Coq Club, 28 July 2020 *) Notation "x ⪯ y ⪯ .. ⪯ z ⪯ t" := ((fun b A a => a <= b /\ A b) y .. ((fun b A a => a <= b /\ A b) z (fun b => b <= t)) .. x) (at level 70, y at next level, z at next level, t at next level). Check 1 ⪯ 2 ⪯ 3 ⪯ 4. End RecursiveNotationPartialApp. Module GoalConclBox. (* The conclusion was sometimes printed vertically (see https://coq.zulipchat.com/#narrow/stream/237977-Coq-users/topic/Strange.20newline.20in.20printing) *) Notation "|-_0 x" := (x = 0) (at level 70, format "|-_0 '/' x"). Lemma test x : |-_0 x. Show. Abort. Lemma test xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx : |-_0 xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx * xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx. Show. Abort. End GoalConclBox. Module PartOfIssue17094. Notation "'FORALL' x .. y , P" := (forall x , .. (forall y , P) .. ) (at level 200, x constr at level 8 as pattern, right associativity, format "'[ ' '[ ' 'FORALL' x .. y ']' , '/' P ']'") : type_scope. Notation "[[ x , y ]]" := (x, y). Check FORALL [[a , b]], a - b = 0. End PartOfIssue17094. Module PartOfIssue17094PrintingAssumption. Declare Custom Entry quoted. Notation "( x )" := x (in custom quoted at level 0, x at level 200). Notation "x" := x (in custom quoted at level 0, x global). Notation "{ A }" := A (in custom quoted at level 0, A constr at level 200). Axiom TypTerm : Type. Axiom qType : Type -> TypTerm. Axiom ValTerm : TypTerm -> Type. Notation "◻ A" := (ValTerm A) (at level 9, right associativity, A custom quoted at level 9). Notation "◻ A" := (qType (ValTerm A)) (in custom quoted at level 9, right associativity, A custom quoted at level 9). Declare Custom Entry quoted_binder. Notation "{ x }" := x (in custom quoted_binder at level 0, x constr). Axiom FORALL : forall {A : TypTerm} (B : ValTerm A -> TypTerm), TypTerm. Notation "∀' x .. y , P" := (FORALL (fun x => .. (FORALL (fun y => P)) .. )) (in custom quoted at level 200, x custom quoted_binder as pattern, right associativity, format "'[ ' '[ ' ∀' x .. y ']' , '/' P ']'") : type_scope. Check ∀ A (B : ValTerm A -> TypTerm), (∀ (a : ◻A), ◻{B a}) -> ◻(∀' {a}, {B a}). End PartOfIssue17094PrintingAssumption. Module PartOfIssue17094Pattern. (* The same but referring this time to a pattern *) Notation "'FORALL' x .. y , P" := (forall x , .. (forall y , P) .. ) (at level 200, x constr at level 8 as pattern, right associativity, format "'[ ' '[ ' 'FORALL' x .. y ']' , '/' P ']'") : type_scope. Notation "[[ x , y ]]" := (x,y) (x pattern, y pattern). Check FORALL [[a , b]], a - b = 0. End PartOfIssue17094Pattern. Module PartOfIssue17094Ident. (* A variant with custom entries and referring this time to a ident *) Declare Custom Entry quoted_binder'. Notation "x" := x (in custom quoted_binder' at level 0, x ident). Notation "'FORALL' x .. y , P" := (forall x , .. (forall y , P) .. ) (at level 200, x custom quoted_binder' as pattern, right associativity, format "'[ ' '[ ' 'FORALL' x .. y ']' , '/' P ']'") : type_scope. (* Note: notation not used for printing because no rule to print "a:nat" and "b:nat" *) Check FORALL a b, a - b = 0. End PartOfIssue17094Ident. Module BetterFix13078. (* We now support referring to ident and pattern in notations for pattern *) Notation "# x &" := (Some x) (at level 0, x pattern). Check fun (x : option unit) => match x with | None => None | # tt & => # tt & end. End BetterFix13078. coq-8.20.0/test-suite/output/Notations4.out000066400000000000000000000215071466560755400206530ustar00rootroot00000000000000[< 0 > + < 1 > * < 2 >] : nat Entry custom:myconstr is [ "6" RIGHTA [ ] | "5" RIGHTA [ SELF; "+"; NEXT ] | "4" RIGHTA [ SELF; "*"; NEXT ] | "3" RIGHTA [ "<"; term LEVEL "10"; ">" ] ] [< b > + < b > * < 2 >] : nat [<< # 0 >>] : option nat [b + c] : nat fun a : nat => [a + a] : nat -> nat File "./output/Notations4.v", line 38, characters 0-88: Warning: This notation will not be used for printing as it is bound to a single variable. [notation-bound-to-variable,parsing,default] [1 {f 1}] : Expr fun (x : nat) (y z : Expr) => [1 + y z + {f x}] : nat -> Expr -> Expr -> Expr fun e : Expr => match e with | [x y + z] => [x + y z] | [1 + 1] => [1] | _ => [e + e] end : Expr -> Expr [(1 + 1)] : Expr myAnd1 True True : Prop r 2 3 : Prop let v := 0%test17 in v : myint63 : myint63 fun y : nat => # (x, z) |-> y & y : forall y : nat, (?T1 * ?T2 -> ?T1 * ?T2 * nat) * (?T * ?T0 -> ?T * ?T0 * nat) where ?T : [y : nat pat : ?T * ?T0 p0 : ?T * ?T0 p := p0 : ?T * ?T0 |- Type] (pat, p0, p cannot be used) ?T0 : [y : nat pat : ?T * ?T0 p0 : ?T * ?T0 p := p0 : ?T * ?T0 |- Type] (pat, p0, p cannot be used) ?T1 : [y : nat pat : ?T1 * ?T2 p0 : ?T1 * ?T2 p := p0 : ?T1 * ?T2 |- Type] (pat, p0, p cannot be used) ?T2 : [y : nat pat : ?T1 * ?T2 p0 : ?T1 * ?T2 p := p0 : ?T1 * ?T2 |- Type] (pat, p0, p cannot be used) fun y : nat => # (x, z) |-> (x + y) & (y + z) : forall y : nat, (nat * ?T -> nat * ?T * nat) * (?T0 * nat -> ?T0 * nat * nat) where ?T : [y : nat pat : nat * ?T p0 : nat * ?T p := p0 : nat * ?T |- Type] (pat, p0, p cannot be used) ?T0 : [y : nat pat : ?T0 * nat p0 : ?T0 * nat p := p0 : ?T0 * nat |- Type] (pat, p0, p cannot be used) fun '{| |} => true : R -> bool File "./output/Notations4.v", line 149, characters 82-85: The command has indeed failed with message: The format is not the same on the right- and left-hand sides of the special token "..". File "./output/Notations4.v", line 153, characters 76-78: The command has indeed failed with message: The format is not the same on the right- and left-hand sides of the special token "..". File "./output/Notations4.v", line 157, characters 78-81: The command has indeed failed with message: The format is not the same on the right- and left-hand sides of the special token "..". File "./output/Notations4.v", line 161, characters 52-55: The command has indeed failed with message: The format is not the same on the right- and left-hand sides of the special token "..". Entry custom:expr is [ "201" RIGHTA [ "{"; term LEVEL "200"; "}" ] | "1" RIGHTA [ ] ] fun x : nat => [ x ] : nat -> nat fun x : nat => [x] : nat -> nat ∀ x : nat, x = x : Prop File "./output/Notations4.v", line 195, characters 0-160: Warning: Notation "∀ _ .. _ , _" was already defined with a different format in scope type_scope. [notation-incompatible-format,parsing,default] ∀x : nat,x = x : Prop File "./output/Notations4.v", line 208, characters 0-60: Warning: Notation "_ %%% _" was already defined with a different format. [notation-incompatible-format,parsing,default] File "./output/Notations4.v", line 212, characters 0-64: Warning: Notation "_ %%% _" was already defined with a different format. [notation-incompatible-format,parsing,default] File "./output/Notations4.v", line 217, characters 0-62: Warning: Lonely notation "_ %%%% _" was already defined with a different format. [notation-incompatible-format,parsing,default] 3 %% 4 : nat 3 %% 4 : nat 3 %% 4 : nat File "./output/Notations4.v", line 245, characters 47-59: Warning: The format modifier is irrelevant for only-parsing rules. [irrelevant-format-only-parsing,parsing,default] File "./output/Notations4.v", line 249, characters 36-48: Warning: The only parsing modifier has no effect in Reserved Notation. [irrelevant-reserved-notation-only-parsing,parsing,default] fun x : nat => U (S x) : nat -> nat V tt : unit * (unit -> unit) fun x : nat => V x : forall x : nat, nat * (?T -> ?T) where ?T : [x : nat x0 : ?T |- Type] (x0 cannot be used) File "./output/Notations4.v", line 266, characters 0-30: Warning: Notation "_ :=: _" was already used. [notation-overridden,parsing,default] 0 :=: 0 : Prop fun x : nat => <{ x; (S x) }> : nat -> nat Set : Type fun x : nat => S x : nat -> nat True : Prop exists p : nat, ▢_p (p >= 1) : Prop ▢_n (n >= 1) : Prop File "./output/Notations4.v", line 336, characters 17-20: The command has indeed failed with message: Found an inductive type while a variable name was expected. File "./output/Notations4.v", line 337, characters 17-18: The command has indeed failed with message: Found a constructor while a variable name was expected. File "./output/Notations4.v", line 339, characters 17-18: The command has indeed failed with message: Found a constant while a variable name was expected. exists x y : nat, ▢_(x, y) (x >= 1 /\ y >= 2) : Prop ▢_n (n >= 1) : Prop File "./output/Notations4.v", line 352, characters 17-20: The command has indeed failed with message: Found an inductive type while a pattern was expected. ▢_tt (tt = tt) : Prop File "./output/Notations4.v", line 355, characters 17-18: The command has indeed failed with message: Found a constant while a pattern was expected. exists x y : nat, ▢_(x, y) (x >= 1 /\ y >= 2) : Prop pseudo_force n (fun n : nat => n >= 1) : Prop File "./output/Notations4.v", line 368, characters 17-20: The command has indeed failed with message: Found an inductive type while a pattern was expected. ▢_tt (tt = tt) : Prop File "./output/Notations4.v", line 371, characters 17-18: The command has indeed failed with message: Found a constant while a pattern was expected. exists x y : nat, myforce (x, y) (x >= 1 /\ y >= 2) : Prop myforce n (n >= 1) : Prop File "./output/Notations4.v", line 383, characters 21-24: The command has indeed failed with message: Found an inductive type while a pattern was expected. myforce tt (tt = tt) : Prop File "./output/Notations4.v", line 386, characters 21-22: The command has indeed failed with message: Found a constant while a pattern was expected. id nat : Set fun a : bool => id a : bool -> bool fun nat : bool => id nat : bool -> bool File "./output/Notations4.v", line 398, characters 17-20: The command has indeed failed with message: Found an inductive type while a pattern was expected. !! nat, nat = true : Prop !!! nat, nat = true : Prop !!!! (nat, id), nat = true /\ id = false : Prop ∀ x : nat, x = 0 : Prop ∀₁ x, x = 0 : Prop ∀₁ x, x = 0 : Prop ∀₂ x y, x + y = 0 : Prop ((1, 2)) : nat * nat %% [x == 1] : Prop %%% [1] : Prop [[2]] : nat * nat %%% : Type ## (x, _) (x = 0) : Prop File "./output/Notations4.v", line 494, characters 21-30: The command has indeed failed with message: Unexpected type constraint in notation already providing a type constraint. ## '(x, y) (x + y = 0) : Prop ## x (x = 0) : Prop ## '(x, y) (x = 0) : Prop fun f : ## a (a = 0) => f 1 eq_refl : ## a (a = 0) -> 1 = 0 [MyNotation 0] : nat fun MyNone : nat => MyNone : nat -> nat MyNone+ : option ?A where ?A : [ |- Type] Some MyNone+ : option (option ?A) where ?A : [ |- Type] 0+ : option ?A where ?A : [ |- Type] 0+ : option ?A where ?A : [ |- Type] 0 : nat File "./output/Notations4.v", line 544, characters 0-78: The command has indeed failed with message: Notation "func _ .. _ , _" is already defined at level 200 with arguments binder, constr at next level while it is now required to be at level 200 with arguments constr, constr at next level. File "./output/Notations4.v", line 549, characters 0-57: The command has indeed failed with message: Notation "[[ _ ]]" is already defined at level 0 with arguments custom foo while it is now required to be at level 0 with arguments custom bar. lambda x y : nat, x + y = 0 : nat -> nat -> Prop ((!!nat) + bool)%type : Set fun z : nat => (z, 1, z, 2) : nat -> nat * nat * nat * nat fun z : nat => [(!!z) + z] : nat -> nat * nat * nat * nat * nat uncurryλ a b c => a + b + c : unit * nat * nat * nat -> nat fun x : unit * nat * (nat * nat) => match x with | (x0, y) => match y with | (a, b) => let d := 1 in match x0 with | (x1, c) => let 'tt := x1 in a + b + c + d end end end : unit * nat * (nat * nat) -> nat fun x : unit * nat * (nat * nat) => match x with | (x0, (a, b)) => let d := 1 in match x0 with | (tt, c) => a + b + c + d end end : unit * nat * (nat * nat) -> nat uncurryλ '(a, b) => a + b : unit * (nat * nat) -> nat lets a b c := 0 in a + b + c : nat let '(a, b) := (0, 0) in lets d := 1 in let '(c, e) := (0, 0) in a + b + c + d + e : nat coq-8.20.0/test-suite/output/Notations4.v000066400000000000000000000417031466560755400203110ustar00rootroot00000000000000(* An example with constr subentries *) Module A. Declare Custom Entry myconstr. Notation "[ x ]" := x (x custom myconstr at level 6). Notation "x + y" := (Nat.add x y) (in custom myconstr at level 5). Notation "x * y" := (Nat.mul x y) (in custom myconstr at level 4). Notation "< x >" := x (in custom myconstr at level 3, x constr at level 10). Check [ < 0 > + < 1 > * < 2 >]. Print Custom Grammar myconstr. Axiom a : nat. Notation b := a. Check [ < b > + < a > * < 2 >]. Declare Custom Entry anotherconstr. Notation "[ x ]" := x (x custom myconstr at level 6). Notation "<< x >>" := x (in custom myconstr at level 3, x custom anotherconstr at level 10). Notation "# x" := (Some x) (in custom anotherconstr at level 8, x constr at level 9). Check [ << # 0 >> ]. (* Now check with global *) Axiom c : nat. Notation "x" := x (in custom myconstr at level 0, x global). Check [ b + c ]. Check fun a => [ a + a ]. Module NonCoercions. (* Should we forbid extra coercions in constr (knowing the "( x )" is hard-wiree)? *) Notation "[[ x ]]" := x (at level 0, x at level 42). (* Check invalid coercions (thus not used for printing) *) Notation "[[[ x ]]]" := x (in custom myconstr at level 5, x custom myconstr at level 5). End NonCoercions. End A. Module B. Inductive Expr := | Mul : Expr -> Expr -> Expr | Add : Expr -> Expr -> Expr | One : Expr. Declare Custom Entry expr. Notation "[ expr ]" := expr (expr custom expr at level 2). Notation "1" := One (in custom expr at level 0). Notation "x y" := (Mul x y) (in custom expr at level 1, left associativity). Notation "x + y" := (Add x y) (in custom expr at level 2, left associativity). Notation "( x )" := x (in custom expr at level 0, x at level 2). Notation "{ x }" := x (in custom expr at level 0, x constr). Notation "x" := x (in custom expr at level 0, x ident). Axiom f : nat -> Expr. Check [1 {f 1}]. Check fun x y z => [1 + y z + {f x}]. Check fun e => match e with | [x y + z] => [x + y z] | [1 + 1] => [1] | y => [y + e] end. End B. Module C. Inductive Expr := | Add : Expr -> Expr -> Expr | One : Expr. Notation "[ expr ]" := expr (expr custom expr at level 1). Notation "1" := One (in custom expr at level 0). Notation "x + y" := (Add x y) (in custom expr at level 2, left associativity). Notation "( x )" := x (in custom expr at level 0, x at level 2). (* Check the use of a two-steps coercion from constr to expr 1 then from expr 0 to expr 2 (note that camlp5 parsing is more tolerant and does not require parentheses to parse from level 2 while at level 1) *) Check [1 + 1]. End C. (* Fixing overparenthesizing reported by G. Gonthier in #9207 (PR #9214, in 8.10)*) Module I. Definition myAnd A B := A /\ B. Notation myAnd1 A := (myAnd A). Check myAnd1 True True. Set Warnings "-auto-template". Record Pnat := {inPnat :> nat -> Prop}. Axiom r : nat -> Pnat. Check r 2 3. End I. Require Import Coq.Numbers.Cyclic.Int63.Uint63. Module NumberNotations. Module Test17. (** Test uint63 *) Declare Scope test17_scope. Delimit Scope test17_scope with test17. Local Set Primitive Projections. Record myint63 := of_int { to_int : int }. Definition parse x := match x with Pos x => Some (of_int x) | Neg _ => None end. Definition print x := Pos (to_int x). Number Notation myint63 parse print : test17_scope. Check let v := 0%test17 in v : myint63. End Test17. End NumberNotations. Module K. Notation "# x |-> t & u" := ((fun x => (x,t)),(fun x => (x,u))) (at level 0, x pattern, t, u at level 39). Check fun y : nat => # (x,z) |-> y & y. Check fun y : nat => # (x,z) |-> (x + y) & (y + z). End K. Module EmptyRecordSyntax. Record R := { n : nat }. Check fun '{|n:=x|} => true. End EmptyRecordSyntax. Module M. (* Accept boxes around the end variables of a recursive notation (if equal boxes) *) Notation " {@ T1 ; T2 ; .. ; Tn } " := (and T1 (and T2 .. (and Tn True)..)) (format "'[v' {@ '[' T1 ']' ; '//' '[' T2 ']' ; '//' .. ; '//' '[' Tn ']' } ']'"). Fail Notation " {@ T1 ; T2 ; .. ; Tn } " := (and T1 (and T2 .. (and Tn True)..)) (format "'[v' {@ '[' T1 ']' ; '//' '[' T2 ']' ; '//' .. ; '//' '[' Tn ']' } ']'"). Fail Notation " {@ T1 ; T2 ; .. ; Tn } " := (and T1 (and T2 .. (and Tn True)..)) (format "'[v' {@ '[' T1 ']' ; '//' '[' T2 ']' ; '//' .. ; '//' '[v' Tn ']' } ']'"). Fail Notation " {@ T1 ; T2 ; .. ; Tn } " := (and T1 (and T2 .. (and Tn True)..)) (format "'[v' {@ '[' T1 ']' ; '//' '[' T2 ']' ; '//' .. ; '//' '[' Tn ']' } ']'"). Fail Notation " {@ T1 ; T2 ; .. ; Tn } " := (and T1 (and T2 .. (and Tn True)..)) (format "'[v' {@ '[' T1 ']' ; '//' '[' T2 ']' ; '//' .. ; '//' '[' Tn ']' } ']'"). End M. Module Bug11331. Notation "{ p }" := (p) (in custom expr at level 201, p constr). Print Custom Grammar expr. End Bug11331. Module Bug_6082. Declare Scope foo. Notation "[ x ]" := (S x) (format "[ x ]") : foo. Open Scope foo. Check fun x => S x. Declare Scope bar. Notation "[ x ]" := (S x) (format "[ x ]") : bar. Open Scope bar. Check fun x => S x. End Bug_6082. Module Bug_7766. Notation "∀ x .. y , P" := (forall x, .. (forall y, P) ..) (at level 200, x binder, y binder, right associativity, format "'[ ' ∀ x .. y ']' , P") : type_scope. Check forall (x : nat), x = x. Notation "∀ x .. y , P" := (forall x, .. (forall y, P) ..) (at level 200, x binder, y binder, right associativity, format "∀ x .. y , P") : type_scope. Check forall (x : nat), x = x. End Bug_7766. Module N. (* Other tests about generic and specific formats *) Reserved Notation "x %%% y" (format "x %%% y", at level 35). Reserved Notation "x %%% y" (format "x %%% y", at level 35). (* Not using the reserved format, we warn *) Notation "x %%% y" := (x+y) (format "x %%% y", at level 35). (* Same scope (here lonely): we warn *) Notation "x %%%% y" := (x+y) (format "x %%%% y", at level 35). Notation "x %%%% y" := (x+y) (format "x %%%% y", at level 35). (* Test if the format for a specific notation becomes the default generic format or if the generic format, in the absence of a Reserved Notation, is the one canonically obtained from the notation *) Declare Scope foo_scope. Declare Scope bar_scope. Declare Scope bar'_scope. Notation "x %% y" := (x+y) (at level 47, format "x %% y") : foo_scope. Open Scope foo_scope. Check 3 %% 4. (* No scope, we inherit the initial format *) Notation "x %% y" := (x*y) : bar_scope. (* Inherit the format *) Open Scope bar_scope. Check 3 %% 4. (* Different scope and no reserved notation, we don't warn *) Notation "x %% y" := (x*y) (at level 47, format "x %% y") : bar'_scope. Open Scope bar'_scope. Check 3 %% 4. (* Warn for combination of "only parsing" and "format" *) Notation "###" := 0 (at level 0, only parsing, format "###"). (* In reserved notation, warn only for the "only parsing" *) Reserved Notation "##" (at level 0, only parsing, format "##"). End N. Module O. Notation U t := (match t with 0 => 0 | S t => t | _ => 0 end). Check fun x => U (S x). Notation V t := (t,fun t => t). Check V tt. Check fun x : nat => V x. End O. Module Bug12691. Notation "x :=: y" := True (at level 70, no associativity, only parsing). Notation "x :=: y" := (x = y). Check (0 :=: 0). End Bug12691. Module CoercionEntryTransitivity. Declare Custom Entry com. Declare Custom Entry com_top. Notation "<{ e }>" := e (at level 0, e custom com_top at level 99). Notation "x ; y" := (x + y) (in custom com_top at level 90, x custom com at level 90, right associativity). Notation "x" := x (in custom com at level 0, x constr at level 0). Notation "x" := x (in custom com_top at level 90, x custom com at level 90). Check fun x => <{ x ; (S x) }>. End CoercionEntryTransitivity. Module CoercionEntryOnlyParsing. (* bug #15335 *) Declare Custom Entry ent. Notation "ent:( x )" := x (x custom ent, only parsing). Notation "!" := Set (in custom ent at level 0). Check ent:( ! ). End CoercionEntryOnlyParsing. Module CustomIdentOnlyParsing. Declare Custom Entry ent2. Notation "ent:( x )" := x (x custom ent2, format "ent:( x )"). Notation "# x" := (S x) (in custom ent2 at level 0, x at level 0). Notation "x" := x (in custom ent2 at level 0, x ident, only parsing). Check fun x : nat => ent:(# x). End CustomIdentOnlyParsing. Module CustomGlobalOnlyParsing. Declare Custom Entry ent3. Notation "ent:( x )" := x (x custom ent3, format "ent:( x )"). Notation "# x" := (S x) (in custom ent3 at level 0, x at level 0). Notation "x" := x (in custom ent3 at level 0, x global, only parsing). Check ent:(True). End CustomGlobalOnlyParsing. (* Some corner cases *) Module P. (* Basic rules: - a section variable be used for itself and as a binding variable - a global name cannot be used for itself and as a binding variable *) Definition pseudo_force {A} (n:A) (P:A -> Prop) := forall n', n' = n -> P n'. Module NotationMixedTermBinderAsIdent. Notation "▢_ n P" := (pseudo_force n (fun n => P)) (at level 0, n ident, P at level 9, format "▢_ n P"). Check exists p, ▢_p (p >= 1). Section S. Variable n:nat. Check ▢_n (n >= 1). End S. Fail Check ▢_nat (nat = bool). Fail Check ▢_O (O >= 1). Axiom n:nat. Fail Check ▢_n (n >= 1). End NotationMixedTermBinderAsIdent. Module NotationMixedTermBinderAsPattern. Notation "▢_ n P" := (pseudo_force n (fun n => P)) (at level 0, n pattern, P at level 9, format "▢_ n P"). Check exists x y, ▢_(x,y) (x >= 1 /\ y >= 2). Section S. Variable n:nat. Check ▢_n (n >= 1). End S. Fail Check ▢_nat (nat = bool). Check ▢_tt (tt = tt). Axiom n:nat. Fail Check ▢_n (n >= 1). End NotationMixedTermBinderAsPattern. Module NotationMixedTermBinderAsStrictPattern. Notation "▢_ n P" := (pseudo_force n (fun n => P)) (at level 0, n strict pattern, P at level 9, format "▢_ n P"). Check exists x y, ▢_(x,y) (x >= 1 /\ y >= 2). Section S. Variable n:nat. Check ▢_n (n >= 1). End S. Fail Check ▢_nat (nat = bool). Check ▢_tt (tt = tt). Axiom n:nat. Fail Check ▢_n (n >= 1). End NotationMixedTermBinderAsStrictPattern. Module AbbreviationMixedTermBinderAsStrictPattern. Notation myforce n P := (pseudo_force n (fun n => P)). Check exists x y, myforce (x,y) (x >= 1 /\ y >= 2). Section S. Variable n:nat. Check myforce n (n >= 1). (* strict hence not used for printing *) End S. Fail Check myforce nat (nat = bool). Check myforce tt (tt = tt). Axiom n:nat. Fail Check myforce n (n >= 1). End AbbreviationMixedTermBinderAsStrictPattern. Module Bug4765Part. Notation id x := ((fun y => y) x). Check id nat. Notation id' x := ((fun x => x) x). Check fun a : bool => id' a. Check fun nat : bool => id' nat. Fail Check id' nat. End Bug4765Part. Module NotationBinderNotMixedWithTerms. Notation "!! x , P" := (forall x, P) (at level 200, x pattern). Check !! nat, nat = true. Notation "!!! x , P" := (forall x, P) (at level 200). Check !!! nat, nat = true. Notation "!!!! x , P" := (forall x, P) (at level 200, x strict pattern). Check !!!! (nat,id), nat = true /\ id = false. End NotationBinderNotMixedWithTerms. End P. Module MorePrecise1. (* A notation with limited iteration is strictly more precise than a notation with unlimited iteration *) Notation "∀ x .. y , P" := (forall x, .. (forall y, P) ..) (at level 200, x binder, y binder, right associativity, format "'[ ' '[ ' ∀ x .. y ']' , '/' P ']'") : type_scope. Check forall x, x = 0. Notation "∀₁ z , P" := (forall z, P) (at level 200, right associativity) : type_scope. Check forall x, x = 0. Notation "∀₂ y x , P" := (forall y x, P) (at level 200, right associativity) : type_scope. Check forall x, x = 0. Check forall x y, x + y = 0. Notation "(( x , y ))" := (x,y) : core_scope. Check ((1,2)). End MorePrecise1. Module MorePrecise2. (* Case of a bound binder *) Notation "%% [ x == y ]" := (forall x, S x = y) (at level 0, x pattern, y at level 60). (* Case of an internal binder *) Notation "%%% [ y ]" := (forall x : nat, x = y) (at level 0). (* Check that the two previous notations are indeed finer *) Notation "∀ x .. y , P" := (forall x, .. (forall y, P) ..) (at level 200, x binder, y binder, right associativity, format "'[ ' '[ ' ∀ x .. y ']' , '/' P ']'"). Notation "∀' x .. y , P" := (forall y, .. (forall x, P) ..) (at level 200, x binder, y binder, right associativity, format "'[ ' '[ ' ∀' x .. y ']' , '/' P ']'"). Check %% [x == 1]. Check %%% [1]. Notation "[[ x ]]" := (pair 1 x). Notation "( x ; y ; .. ; z )" := (pair .. (pair x y) .. z). Notation "[ x ; y ; .. ; z ]" := (pair .. (pair x z) .. y). (* Check which is finer *) Check [[ 2 ]]. End MorePrecise2. Module MorePrecise3. (* This is about a binder not bound in a notation being strictly more precise than a binder bound in the notation (since the notation applies - a priori - stricly less often) *) Notation "%%%" := (forall x, x) (at level 0). Notation "∀ x .. y , P" := (forall x, .. (forall y, P) ..) (at level 200, x binder, y binder, right associativity, format "'[ ' '[ ' ∀ x .. y ']' , '/' P ']'"). Check %%%. End MorePrecise3. Module TypedPattern. Notation "## x P" := (forall x:nat*nat, P) (x pattern, at level 1). Check ## (x,y) (x=0). Fail Check ## ((x,y):bool*bool) (x=y). End TypedPattern. Module SingleBinder. Notation "## x P" := (forall x, x = x -> P) (x binder, at level 1). Check ## '(x,y) (x+y=0). Check ## (x:nat) (x=0). Check ## '((x,y):nat*nat) (x=0). Check fun (f : ## {a} (a=0)) => f (a:=1) eq_refl. End SingleBinder. Module GenericFormatPrecedence. (* Check that if a generic format exists, we use it preferably to no explicit generic format *) Notation "[ 'MyNotation' G ]" := (S G) (at level 0, format "[ 'MyNotation' G ]") : nat_scope. Notation "[ 'MyNotation' G ]" := (G+0) (at level 0, only parsing) : bool_scope. Notation "[ 'MyNotation' G ]" := (G*0). Check 0*0. End GenericFormatPrecedence. Module LeadingIdent. Notation "'MyNone' +" := None (format "'MyNone' +"). Check fun MyNone : nat => MyNone. Check MyNone+. Check Some MyNone+. End LeadingIdent. Module SymbolsStartingWithNumbers. Notation "0+" := None. Check 0+. End SymbolsStartingWithNumbers. Module LeadingNumber. Notation "0 +" := None (format "0 +"). Check 0+. Check 0. End LeadingNumber. Module Incompatibility. Notation "'func' x .. y , P" := (fun x => .. (fun y => P) ..) (x binder, y binder, at level 200). Fail Notation "'func' x .. y , P" := (pair x .. (pair y P) ..) (at level 200). Declare Custom Entry foo. Declare Custom Entry bar. Notation "[[ x ]]" := x (x custom foo) : nat_scope. Fail Notation "[[ x ]]" := x (x custom bar) : type_scope. End Incompatibility. Module RecursivePatternsArgumentsInRecursiveNotations. Notation "'λ' x .. y , t" := (fun x => .. (fun y => t) ..) (at level 200, x binder, y binder, right associativity, format "'[ ' '[ ' 'λ' x .. y ']' , '/' t ']'"). Notation "'lambda' x .. y , t" := (λ x .. y, t) (at level 200, x binder, y binder). Check lambda x y, x+y=0. End RecursivePatternsArgumentsInRecursiveNotations. Module CyclicNotations. Notation "! x" := (list x) (at level 0, x at level 50, right associativity, format "! x"). Check ((!!nat) + bool)%type. End CyclicNotations. Module CustomCyclicNotations. Declare Custom Entry myconstr2. Notation "[ x ]" := x (x custom myconstr2 at level 6). Notation "! x" := (x,1) (in custom myconstr2 at level 0, x at level 2, format "! x"). Notation "x + y" := (x,y,2) (in custom myconstr2 at level 2, left associativity). Notation "x" := x (in custom myconstr2 at level 0, x ident). (* Check that the custom notation is not used, because parentheses are missing in the entry *) Check fun z:nat => ((z,1),z,2). Notation "( x )" := x (in custom myconstr2 at level 0, x at level 2). (* Check that parentheses are preserved when an entry refers on the right on a higher level than where it is *) Check fun z:nat => [(!! z) + z]. End CustomCyclicNotations. Module RecursivePatternsInMatch. Remove Printing Let prod. Unset Printing Matching. Notation "'uncurryλ' x1 .. xn => body" := (fun x => match x with (pair x x1) => .. (match x with (pair x xn) => let 'tt := x in body end) .. end) (at level 200, x1 binder, xn binder, right associativity). Check uncurryλ a b c => a + b + c. (* Check other forms of binders, but too complex interaction with pattern-matching compaction for printing *) Check uncurryλ '(a,b) (d:=1) c => a + b + c + d. Set Printing Matching. Check uncurryλ '(a,b) (d:=1) c => a + b + c + d. (* This is a case where printing is easy though, relying on pattern-matching compaction *) Check uncurryλ '(a,b) => a + b. Notation "'lets' x1 .. xn := c 'in' body" := (let x1 := c in .. (let xn := c in body) ..) (at level 200, x1 binder, xn binder, right associativity). Check lets a b c := 0 in a + b + c. (* Check other forms of binders, but too complex interaction with pattern-matching factorization for printing *) Check lets '(a,b) (d:=1) '(c,e) := (0,0) in a + b + c + d + e. End RecursivePatternsInMatch. coq-8.20.0/test-suite/output/Notations5.out000066400000000000000000000203661466560755400206560ustar00rootroot00000000000000p 0 0 true : 0 = 0 /\ true = true p 0 0 : forall b : ?B, 0 = 0 /\ b = b where ?B : [ |- Type] p 0 : forall (a2 : nat) (B : Type) (b : B), 0 = a2 /\ b = b p 0 0 : forall b : bool, 0 = 0 /\ b = b p 0 0 : forall b : bool, 0 = 0 /\ b = b p : forall (a1 a2 : nat) (B : Type) (b : B), a1 = a2 /\ b = b p : forall (a1 a2 : nat) (B : Type) (b : B), a1 = a2 /\ b = b @p nat 0 0 : forall (B : Type) (b : B), 0 = 0 /\ b = b @p : forall (A : Type) (a1 a2 : A) (B : Type) (b : B), a1 = a2 /\ b = b p 0 0 : forall b : bool, 0 = 0 /\ b = b p : forall (a1 a2 : nat) (B : Type) (b : B), a1 = a2 /\ b = b p 0 0 true : 0 = 0 /\ true = true p 0 0 : forall b : ?B, 0 = 0 /\ b = b where ?B : [ |- Type] p 0 : forall (a2 : nat) (B : Type) (b : B), 0 = a2 /\ b = b p 0 0 : forall b : bool, 0 = 0 /\ b = b p 0 0 : forall b : bool, 0 = 0 /\ b = b p : forall (a1 a2 : nat) (B : Type) (b : B), a1 = a2 /\ b = b p : forall (a1 a2 : nat) (B : Type) (b : B), a1 = a2 /\ b = b @p nat 0 0 : forall (B : Type) (b : B), 0 = 0 /\ b = b @p : forall (A : Type) (a1 a2 : A) (B : Type) (b : B), a1 = a2 /\ b = b f x true : 0 = 0 /\ true = true f x : forall b : bool, 0 = 0 /\ b = b f x : forall b : bool, 0 = 0 /\ b = b @f nat : forall a1 a2 : nat, T a1 a2 -> forall (B : Type) (b : B), a1 = a2 /\ b = b f : T 0 0 -> forall (B : Type) (b : B), 0 = 0 /\ b = b f : T 0 0 -> forall (B : Type) (b : B), 0 = 0 /\ b = b @f : forall (A : Type) (a1 a2 : A), T a1 a2 -> forall (B : Type) (b : B), a1 = a2 /\ b = b f : T 0 0 -> forall (B : Type) (b : B), 0 = 0 /\ b = b x.(f) true : 0 = 0 /\ true = true x.(f) : forall b : bool, 0 = 0 /\ b = b x.(f) : forall b : bool, 0 = 0 /\ b = b @f nat : forall a1 a2 : nat, T a1 a2 -> forall (B : Type) (b : B), a1 = a2 /\ b = b f : T 0 0 -> forall (B : Type) (b : B), 0 = 0 /\ b = b f : T 0 0 -> forall (B : Type) (b : B), 0 = 0 /\ b = b @f : forall (A : Type) (a1 a2 : A), T a1 a2 -> forall (B : Type) (b : B), a1 = a2 /\ b = b f : T 0 0 -> forall (B : Type) (b : B), 0 = 0 /\ b = b u ?A : forall (a1 a2 : ?A) (B : Type) (b : B), a1 = a2 /\ b = b where ?A : [ |- Type] u ?A : forall (a1 a2 : ?A) (B : Type) (b : B), a1 = a2 /\ b = b where ?A : [ |- Type] u : forall (A : Type) (a1 a2 : A) (B : Type) (b : B), a1 = a2 /\ b = b u : forall (A : Type) (a1 a2 : A) (B : Type) (b : B), a1 = a2 /\ b = b u nat 0 0 ?B : forall b : ?B, 0 = 0 /\ b = b where ?B : [ |- Type] u nat 0 0 bool : forall b : bool, 0 = 0 /\ b = b u nat 0 0 : forall (B : Type) (b : B), 0 = 0 /\ b = b u nat 0 0 : forall (B : Type) (b : B), 0 = 0 /\ b = b u : forall (a1 a2 : ?A) (B : Type) (b : B), a1 = a2 /\ b = b where ?A : [ |- Type] @u : forall (A : Type) (a1 a2 : A) (B : Type) (b : B), a1 = a2 /\ b = b @u : forall (A : Type) (a1 a2 : A) (B : Type) (b : B), a1 = a2 /\ b = b u : forall (a1 a2 : ?A) (B : Type) (b : B), a1 = a2 /\ b = b where ?A : [ |- Type] u 0 0 : forall b : ?B, 0 = 0 /\ b = b where ?B : [ |- Type] u 0 0 : forall b : ?B, 0 = 0 /\ b = b where ?B : [ |- Type] @u nat 0 0 : forall (B : Type) (b : B), 0 = 0 /\ b = b @u nat 0 0 : forall (B : Type) (b : B), 0 = 0 /\ b = b u 0 0 true : 0 = 0 /\ true = true u 0 0 true : 0 = 0 /\ true = true v : forall (a2 : nat) (B : Type) (b : B), 0 = a2 /\ b = b v 0 : forall b : ?B, 0 = 0 /\ b = b where ?B : [ |- Type] v 0 : forall b : ?B, 0 = 0 /\ b = b where ?B : [ |- Type] v 0 true : 0 = 0 /\ true = true v : forall (a2 : nat) (B : Type) (b : B), 0 = a2 /\ b = b @v 0 : forall (B : Type) (b : B), 0 = 0 /\ b = b @v 0 : forall (B : Type) (b : B), 0 = 0 /\ b = b v 0 : forall b : bool, 0 = 0 /\ b = b = ?n@{x:=v 0 (B:=bool)} : nat where ?n : [x : forall b : bool, 0 = 0 /\ b = b |- nat] v : forall (a2 : nat) (B : Type) (b : B), 0 = a2 /\ b = b v 0 : forall b : ?B, 0 = 0 /\ b = b where ?B : [ |- Type] v 0 : forall b : ?B, 0 = 0 /\ b = b where ?B : [ |- Type] v 0 true : 0 = 0 /\ true = true v : forall (a2 : nat) (B : Type) (b : B), 0 = a2 /\ b = b @v 0 : forall (B : Type) (b : B), 0 = 0 /\ b = b @v 0 : forall (B : Type) (b : B), 0 = 0 /\ b = b v 0 : forall b : bool, 0 = 0 /\ b = b = ?n@{x:=v 0 (B:=bool)} : nat where ?n : [x : forall b : bool, 0 = 0 /\ b = b |- nat] ## : forall (a1 a2 : ?A) (B : Type) (b : B), a1 = a2 /\ b = b where ?A : [ |- Type] ## : forall (a1 a2 : ?A) (B : Type) (b : B), a1 = a2 /\ b = b where ?A : [ |- Type] ## 0 : forall (a2 : nat) (B : Type) (b : B), 0 = a2 /\ b = b ## 0 : forall (a2 : nat) (B : Type) (b : B), 0 = a2 /\ b = b ## 0 0 : forall b : ?B, 0 = 0 /\ b = b where ?B : [ |- Type] ## 0 0 : forall b : ?B, 0 = 0 /\ b = b where ?B : [ |- Type] ## 0 0 true : 0 = 0 /\ true = true ## 0 0 true : 0 = 0 /\ true = true ## 0 0 : forall b : bool, 0 = 0 /\ b = b ## 0 0 : forall b : bool, 0 = 0 /\ b = b = ?n@{x:=## 0 0 (B:=bool)} : nat where ?n : [x : forall b : bool, 0 = 0 /\ b = b |- nat] ## ?A : forall (a1 a2 : ?A) (B : Type) (b : B), a1 = a2 /\ b = b where ?A : [ |- Type] ## : forall (A : Type) (a1 a2 : A) (B : Type) (b : B), a1 = a2 /\ b = b ## : forall (A : Type) (a1 a2 : A) (B : Type) (b : B), a1 = a2 /\ b = b ## nat 0 : forall (a2 : nat) (B : Type) (b : B), 0 = a2 /\ b = b ## nat 0 : forall (a2 : nat) (B : Type) (b : B), 0 = a2 /\ b = b ## nat 0 0 : forall (B : Type) (b : B), 0 = 0 /\ b = b ## nat 0 0 ?B : forall b : ?B, 0 = 0 /\ b = b where ?B : [ |- Type] ## nat 0 0 ?B : forall b : ?B, 0 = 0 /\ b = b where ?B : [ |- Type] ## nat 0 0 bool : forall b : bool, 0 = 0 /\ b = b ## nat 0 0 bool true : 0 = 0 /\ true = true ## 0 : forall (a2 : nat) (B : Type) (b : B), 0 = a2 /\ b = b ## 0 : forall (a2 : nat) (B : Type) (b : B), 0 = a2 /\ b = b ## 0 0 : forall b : ?B, 0 = 0 /\ b = b where ?B : [ |- Type] ## 0 0 : forall b : bool, 0 = 0 /\ b = b ## 0 0 : forall b : bool, 0 = 0 /\ b = b = ?n@{x:=## 0 0 (B:=bool)} : nat where ?n : [x : forall b : bool, 0 = 0 /\ b = b |- nat] ## 0 0 true : 0 = 0 /\ true = true ## 0 0 true : 0 = 0 /\ true = true ## 0 : forall (a2 : nat) (B : Type) (b : B), 0 = a2 /\ b = b ## 0 : forall (a2 : nat) (B : Type) (b : B), 0 = a2 /\ b = b ## 0 0 : forall b : ?B, 0 = 0 /\ b = b where ?B : [ |- Type] ## 0 0 : forall b : bool, 0 = 0 /\ b = b ## 0 0 : forall b : bool, 0 = 0 /\ b = b = ?n@{x:=## 0 0 (B:=bool)} : nat where ?n : [x : forall b : bool, 0 = 0 /\ b = b |- nat] ## 0 0 true : 0 = 0 /\ true = true ## 0 0 true : 0 = 0 /\ true = true # 0 0 bool 0%bool : T fun a : T => match a with | # 0 0 _ _ => 1 | _ => 2 end : T -> nat #' 0 0 0%bool : T fun a : T => match a with | #' 0 0 _ => 1 | _ => 2 end : T -> nat ## 0 0 0%bool : T fun a : T => match a with | ## 0 0 _ => 1 | _ => 2 end : T -> nat ##' 0 0 0%bool : T fun a : T => match a with | ##' 0 0 _ => 1 | _ => 2 end : T -> nat P 0 0 bool 0%bool : T fun a : T => match a with | P 0 0 _ _ => 1 | _ => 2 end : T -> nat P' 0 0 0%bool : T fun a : T => match a with | P' 0 0 _ => 1 | _ => 2 end : T -> nat Q 0 0 0%bool : T fun a : T => match a with | Q 0 0 _ => 1 | _ => 2 end : T -> nat Q' 0 0 0%bool : T fun a : T => match a with | Q' 0 0 _ => 1 | _ => 2 end : T -> nat Nat.add 0 0 : nat File "./output/Notations5.v", line 414, characters 11-12: The command has indeed failed with message: The term "0" has type "nat" while it is expected to have type "Type". File "./output/Notations5.v", line 417, characters 11-16: The command has indeed failed with message: Unknown interpretation for notation "_ + _". Some 0 : option nat File "./output/Notations5.v", line 424, characters 11-12: The command has indeed failed with message: The reference f was not found in the current environment. coq-8.20.0/test-suite/output/Notations5.v000066400000000000000000000200541466560755400203060ustar00rootroot00000000000000Module AppliedTermsPrinting. (* Test different printing paths for applied terms *) Module InferredGivenImplicit. Set Implicit Arguments. Set Maximal Implicit Insertion. Axiom p : forall A (a1 a2:A) B (b:B), a1 = a2 /\ b = b. Check p 0 0 true. (* p 0 0 true *) Check p 0 0. (* p 0 0 *) Check p 0. (* p 0 *) Check @p _ 0 0 bool. (* p 0 0 (B:=bool) *) Check p 0 0 (B:=bool). (* p 0 0 (B:=bool) *) Check @p nat. (* p (A:=nat) *) Check p (A:=nat). (* p (A:=nat) *) Check @p _ 0 0. (* @p nat 0 0 *) Check @p. (* @p *) Unset Printing Implicit Defensive. Check @p _ 0 0 bool. (* p 0 0 *) Check @p nat. (* p *) Set Printing Implicit Defensive. End InferredGivenImplicit. Module ManuallyGivenImplicit. Axiom p : forall {A} (a1 a2:A) {B} (b:B), a1 = a2 /\ b = b. Check p 0 0 true. (* p 0 0 true *) Check p 0 0. (* p 0 0 *) Check p 0. (* p 0 *) Check @p _ 0 0 bool. (* p 0 0 *) Check p 0 0 (B:=bool). (* p 0 0 *) Check @p nat. (* p *) Check p (A:=nat). (* p *) Check @p _ 0 0. (* @p nat 0 0 *) Check @p. (* @p *) End ManuallyGivenImplicit. Module ProjectionWithImplicits. Set Implicit Arguments. Set Maximal Implicit Insertion. Record T {A} (a1 a2:A) := { f : forall B (b:B), a1 = a2 /\ b = b }. Parameter x : T 0 0. Check f x true. (* f x true *) Check @f _ _ _ x bool. (* f x (B:=bool) *) Check f x (B:=bool). (* f x (B:=bool) *) Check @f nat. (* @f nat *) Check @f _ 0 0. (* f (a1:=0) (a2:=0) *) Check f (a1:=0) (a2:=0). (* f (a1:=0) (a2:=0) *) Check @f. (* @f *) Unset Printing Implicit Defensive. Check f (a1:=0) (a2:=0). (* f *) Set Printing Implicit Defensive. Set Printing Projections. Check x.(f) true. (* x.(f) true *) Check x.(@f _ _ _) bool. (* x.(f) (B:=bool) *) Check x.(f) (B:=bool). (* x.(f) (B:=bool) *) Check @f nat. (* @f nat *) Check @f _ 0 0. (* f (a1:=0) (a2:=0) *) Check f (a1:=0) (a2:=0). (* f (a1:=0) (a2:=0) *) Check @f. (* @f *) Unset Printing Implicit Defensive. Check f (a1:=0) (a2:=0). (* f *) End ProjectionWithImplicits. Module AtAbbreviationForApplicationHead. Axiom p : forall {A} (a1 a2:A) {B} (b:B), a1 = a2 /\ b = b. Notation u := @p. Check u _. (* u ?A *) Check p. (* u ?A *) Check @p. (* u *) Check u. (* u *) Check p 0 0. (* u nat 0 0 ?B *) Check u nat 0 0 bool. (* u nat 0 0 bool *) Check u nat 0 0. (* u nat 0 0 *) Check @p nat 0 0. (* u nat 0 0 *) End AtAbbreviationForApplicationHead. Module AbbreviationForApplicationHead. Set Implicit Arguments. Set Maximal Implicit Insertion. Axiom p : forall A (a1 a2:A) B (b:B), a1 = a2 /\ b = b. Notation u := p. Check p. (* u *) Check @p. (* @u *) Check @u. (* @u *) Check u. (* u *) Check p 0 0. (* u 0 0 *) Check u 0 0. (* u 0 0 *) Check @p nat 0 0. (* @u nat 0 0 *) Check @u nat 0 0. (* @u nat 0 0 *) Check p 0 0 true. (* u 0 0 true *) Check u 0 0 true. (* u 0 0 true *) End AbbreviationForApplicationHead. Module AtAbbreviationForPartialApplication. Set Implicit Arguments. Set Maximal Implicit Insertion. Axiom p : forall A (a1 a2:A) B (b:B), a1 = a2 /\ b = b. Notation v := (@p _ 0). Check v. (* v *) Check p 0 0. (* v 0 *) Check v 0. (* v 0 *) Check v 0 true. (* v 0 true *) Check @p nat 0. (* v *) Check @p nat 0 0. (* @v 0 *) Check @v 0. (* @v 0 *) Check @p nat 0 0 bool. (* v 0 *) Eval simpl in (fun x => _:nat) (@p nat 0 0 bool). (* ?n@{x:=v 0 (B:=bool)} *) End AtAbbreviationForPartialApplication. Module AbbreviationForPartialApplication. Set Implicit Arguments. Set Maximal Implicit Insertion. Axiom p : forall A (a1 a2:A) B (b:B), a1 = a2 /\ b = b. Notation v := (p 0). Check v. (* v *) Check p 0 0. (* v 0 *) Check v 0. (* v 0 *) Check v 0 true. (* v 0 true *) Check @p nat 0. (* v *) Check @p nat 0 0. (* @v 0 *) Check @v 0. (* @v 0 *) Check @p nat 0 0 bool. (* v 0 *) Eval simpl in (fun x => _:nat) (@p nat 0 0 bool). (* ?n@{x:=v 0 (B:=bool)} *) End AbbreviationForPartialApplication. Module NotationForHeadApplication. Set Implicit Arguments. Set Maximal Implicit Insertion. Axiom p : forall A (a1 a2:A) B (b:B), a1 = a2 /\ b = b. Notation "##" := p (at level 0). Check p. (* ## *) Check ##. (* ## *) Check p 0. (* ## 0 *) Check ## 0. (* ## 0 *) Check p 0 0. (* ## 0 0 *) Check ## 0 0. (* ## 0 0 *) Check p 0 0 true. (* ## 0 0 true *) Check ## 0 0 true. (* ## 0 0 true *) Check p 0 0 (B:=bool). (* ## 0 0 *) Check ## 0 0 (B:=bool). (* ## 0 0 *) Eval simpl in (fun x => _:nat) (@p nat 0 0 bool). (* ?n@{x:=## 0 0 (B:=bool)} *) End NotationForHeadApplication. Module AtNotationForHeadApplication. Set Implicit Arguments. Set Maximal Implicit Insertion. Axiom p : forall A (a1 a2:A) B (b:B), a1 = a2 /\ b = b. Notation "##" := @p (at level 0). Check p. (* ## ?A *) Check @p. (* ## *) Check ##. (* ## *) Check p 0. (* ## nat 0 *) Check ## nat 0. (* ## nat 0 *) Check ## nat 0 0. (* ## nat 0 0 *) Check p 0 0. (* ## nat 0 0 ?B *) Check ## nat 0 0 _. (* ## nat 0 0 ?B *) Check ## nat 0 0 bool. (* ## nat 0 0 bool *) Check ## nat 0 0 bool true. (* ## nat 0 0 bool true *) End AtNotationForHeadApplication. Module NotationForPartialApplication. Set Implicit Arguments. Set Maximal Implicit Insertion. Axiom p : forall A (a1 a2:A) B (b:B), a1 = a2 /\ b = b. Notation "## q" := (p q) (at level 0, q at level 0). Check p 0. (* ## 0 *) Check ## 0. (* ## 0 *) Check ## 0 0. (* ## 0 0 *) Check p 0 0 (B:=bool). (* ## 0 0 *) Check ## 0 0 (B:=bool). (* ## 0 0 *) Eval simpl in (fun x => _:nat) (## 0 0 (B:=bool)). (* ?n@{## 0 0 (B:=bool)} *) Check p 0 0 true. (* ## 0 0 true *) Check ## 0 0 true. (* ## 0 0 true *) End NotationForPartialApplication. Module AtNotationForPartialApplication. Set Implicit Arguments. Set Maximal Implicit Insertion. Axiom p : forall A (a1 a2:A) B (b:B), a1 = a2 /\ b = b. Notation "## q" := (@p _ q) (at level 0, q at level 0). Check p 0. (* ## 0 *) Check ## 0. (* ## 0 *) Check ## 0 0. (* ## 0 0 *) Check p 0 0 (B:=bool). (* ## 0 0 *) Check ## 0 0 (B:=bool). (* ## 0 0 *) Eval simpl in (fun x => _:nat) (## 0 0 (B:=bool)). (* ?n@{## 0 0 (B:=bool)} *) Check p 0 0 true. (* ## 0 0 true *) Check ## 0 0 true. (* ## 0 0 true *) End AtNotationForPartialApplication. End AppliedTermsPrinting. Module AppliedPatternsPrinting. (* Other tests testing inheritance of scope and implicit in term and pattern for parsing and printing *) Inductive T := p (a:nat) (b:bool) {B} (b:B) : T. Notation "0" := true : bool_scope. Module A. Notation "#" := @p (at level 0). Check # 0 0 _ true. Check fun a => match a with # 0 0 _ _ => 1 | _ => 2 end. (* !! *) End A. Module B. Notation "#'" := p (at level 0). Check #' 0 0 true. Check fun a => match a with #' 0 0 _ => 1 | _ => 2 end. End B. Module C. Notation "## q" := (@p q) (at level 0, q at level 0). Check ## 0 0 true. Check fun a => match a with ## 0 0 _ => 1 | _ => 2 end. End C. Module D. Notation "##' q" := (p q) (at level 0, q at level 0). Check ##' 0 0 true. Check fun a => match a with ##' 0 0 _ => 1 | _ => 2 end. End D. Module E. Notation P := @ p. Check P 0 0 _ true. Check fun a => match a with P 0 0 _ _ => 1 | _ => 2 end. End E. Module F. Notation P' := p. Check P' 0 0 true. Check fun a => match a with P' 0 0 _ => 1 | _ => 2 end. End F. Module G. Notation Q q := (@p q). Check Q 0 0 true. Check fun a => match a with Q 0 0 _ => 1 | _ => 2 end. End G. Module H. Notation Q' q := (p q). Check Q' 0 0 true. Check fun a => match a with Q' 0 0 _ => 1 | _ => 2 end. End H. End AppliedPatternsPrinting. Module Activation. Disable Notation "_ + _" : nat_scope. Check Nat.add 0 0. Fail Check 0 + 0. Disable Notation "_ + _" : type_scope. Fail Check 0 + 0. Notation f x := (Some x). Disable Notation f. Check Some 0. Fail Check f 0. End Activation. coq-8.20.0/test-suite/output/NotationsCoercions.out000066400000000000000000000004021466560755400224230ustar00rootroot00000000000000Let "x" e1 e2 : expr Let "x" e1 e2 : expr Let "x" e1 e2 : list string : list string b = a : Prop foo : (_ BitVec 32) #[ r ] 0 : nat ##[ r ] : nat ##[ r ] : nat #[ r ] 0 : nat ##[ r ] : nat ##[ r ] : nat coq-8.20.0/test-suite/output/NotationsCoercions.v000066400000000000000000000040201466560755400220610ustar00rootroot00000000000000(* Tests about skipping a coercion vs using a notation involving a coercion *) Require Import String. (* Skipping a coercion vs using a notation for the application of the coercion (from Robbert Krebbers, see PR #8890) *) Module A. Inductive expr := | Var : string -> expr | Lam : string -> expr -> expr | App : expr -> expr -> expr. Notation Let x e1 e2 := (App (Lam x e2) e1). Parameter e1 e2 : expr. Check (Let "x" e1 e2). (* always printed the same *) Coercion App : expr >-> Funclass. Check (Let "x" e1 e2). (* printed the same from #8890, in 8.10 *) Axiom free_vars :> expr -> list string. Check (Let "x" e1 e2) : list string. (* printed the same from #11172, in 8.12 *) End A. (* Skipping a coercion vs using a notation for the coercion itself (regression #11053 in 8.10 after PR #8890, addressed by PR #11090) *) Module B. Section Test. Variables (A B : Type) (a : A) (b : B). Variable c : A -> B. Coercion c : A >-> B. Notation COERCION := (c). Check b = a. (* printed the same except in 8.10 *) End Test. End B. Module C. Record word := { rep: Type }. Coercion rep : word >-> Sortclass. Axiom myword: word. Axiom foo: myword. Notation "'(_' 'BitVec' '32)'" := (rep myword). Check foo. (* printed with Bitvec from #8890 in 8.10 and 8.11, regression due to #11172 in 8.12 *) End C. (* Examples involving coercions to funclass *) Module D. Record R := { f :> nat -> nat }. Axiom r : R. Notation "#[ x ]" := (f x). Check #[ r ] 0. (* printed the same from 8.10 (due to #8890), but not 8.11 and 8.12 (due to #11090) *) Notation "##[ x ]" := (f x 0). Check ##[ r ]. (* printed the same from 8.10 *) Check #[ r ] 0. (* printed ##[ r ] from 8.10 *) End D. (* Same examples with a parameter *) Module E. Record R A := { f :> A -> A }. Axiom r : R nat. Notation "#[ x ]" := (f nat x). Check #[ r ] 0. (* printed the same from 8.10 (due to #8890), but not 8.11 and 8.12 (due to #11090) *) Notation "##[ x ]" := (f nat x 0). Check ##[ r ]. (* printed the same from 8.10 *) Check #[ r ] 0. (* printed ##[ r ] from 8.10 *) End E. coq-8.20.0/test-suite/output/NotationsScope.out000066400000000000000000000001051466560755400215500ustar00rootroot00000000000000f1 (f1 T T) T : t f2 (f2 T T) T : t f2 (f1 T T) T : t coq-8.20.0/test-suite/output/NotationsScope.v000066400000000000000000000006061466560755400212140ustar00rootroot00000000000000(* Check notations scopes for terms % and %_ *) Declare Scope A_scope. Declare Scope B_scope. Delimit Scope B_scope with B. Variant t := T. Definition f1 (x y : t) := x. Definition f2 (x y : t) := y. Notation "x * y" := (f1 x y) : A_scope. Notation "x * y" := (f2 x y) : B_scope. Set Printing All. Local Open Scope A_scope. Check T * T * T. Check (T * T * T)%B. Check (T * T * T)%_B. coq-8.20.0/test-suite/output/NotationsSigma.out000066400000000000000000000014371466560755400215500ustar00rootroot00000000000000{0 = 0} + {0 < 1} : Set (0 = 0) + {0 < 1} : Set {x : nat | x = 1} : Set {x : nat | x = 1 & 0 < x} : Set {x : nat | x = 1} : Set {x : nat | x = 1 & 0 < x} : Set {x : nat & x = 1} : Set {x : nat & x = 1 & 0 < x} : Set {x : nat & x = 1} : Set {x : nat & x = 1 & 0 < x} : Set {'(x, _) : nat * ?T | x = 1} : Type where ?T : [pat : nat * ?T |- Type] (pat cannot be used) {'(x, y) : nat * nat | x = 1 & y = 0} : Set {'(x, _) : nat * nat | x = 1} : Set {'(x, y) : nat * nat | x = 1 & y = 0} : Set {'(x, _) : nat * ?T & x = 1} : Type where ?T : [pat : nat * ?T |- Type] (pat cannot be used) {'(x, y) : nat * nat & x = 1 & y = 0} : Type {'(x, _) : nat * nat & x = 1} : Type {'(x, y) : nat * nat & x = 1 & y = 0} : Type coq-8.20.0/test-suite/output/NotationsSigma.v000066400000000000000000000011311466560755400211750ustar00rootroot00000000000000(* Check notations for sigma types *) Check { 0 = 0 } + { 0 < 1 }. Check (0 = 0) + { 0 < 1 }. Check { x | x = 1 }. Check { x | x = 1 & 0 < x }. Check { x : nat | x = 1 }. Check { x : nat | x = 1 & 0 < x }. Check { x & x = 1 }. Check { x & x = 1 & 0 < x }. Check { x : nat & x = 1 }. Check { x : nat & x = 1 & 0 < x }. Check {'(x,y) | x = 1 }. Check {'(x,y) | x = 1 & y = 0 }. Check {'(x,y) : nat * nat | x = 1 }. Check {'(x,y) : nat * nat | x = 1 & y = 0 }. Check {'(x,y) & x = 1 }. Check {'(x,y) & x = 1 & y = 0 }. Check {'(x,y) : nat * nat & x = 1 }. Check {'(x,y) : nat * nat & x = 1 & y = 0 }. coq-8.20.0/test-suite/output/NumberNotations.out000066400000000000000000000367521466560755400217500ustar00rootroot00000000000000File "./output/NumberNotations.v", line 11, characters 13-14: The command has indeed failed with message: Unexpected term (nat -> nat) while parsing a number notation. File "./output/NumberNotations.v", line 21, characters 13-14: The command has indeed failed with message: Unexpected non-option term opaque4 while parsing a number notation. File "./output/NumberNotations.v", line 32, characters 13-14: The command has indeed failed with message: Unexpected term (fun (A : Type) (x : A) => x) while parsing a number notation. let v := 0%ppp in v : punit : punit let v := 0%ppp in v : punit : punit let v := 0%ppp in v : punit : punit let v := 0%ppp in v : punit : punit let v := 0%uto in v : unit : unit File "./output/NumberNotations.v", line 72, characters 13-14: The command has indeed failed with message: Cannot interpret this number as a value of type unit File "./output/NumberNotations.v", line 73, characters 14-16: The command has indeed failed with message: Cannot interpret this number as a value of type unit let v := 0%upp in v : unit : unit let v := 0%upp in v : unit : unit let v := 0%upp in v : unit : unit let v := 0%ppps in v : punit : punit File "./output/NumberNotations.v", line 91, characters 2-46: Warning: To avoid stack overflow, large numbers in punit are interpreted as applications of pto_punits. [abstract-large-number,numbers,default] File "./output/NumberNotations.v", line 91, characters 32-33: The command has indeed failed with message: In environment v := pto_punits (Number.UIntDecimal (Decimal.D1 Decimal.Nil)) : punit The term "v" has type "punit@{Set}" while it is expected to have type "punit@{u}" (universe inconsistency: Cannot enforce Set = u). S : nat -> nat S (ack 4 4) : nat let v := 0%wnat in v : wnat : wnat 0%wnat : wnat {| unwrap := ack 4 4 |} : wnat {| Test6.unwrap := 0 |} : Test6.wnat let v := 0%wnat in v : Test6.wnat : Test6.wnat let v := 0%wuint in v : wuint : wuint let v := 1%wuint in v : wuint : wuint let v := 0%wuint8 in v : wuint : wuint let v := 0 in v : nat : nat File "./output/NumberNotations.v", line 164, characters 34-35: The command has indeed failed with message: In environment v := 0 : nat The term "v" has type "nat" while it is expected to have type "wuint". = {| unwrap := Number.UIntDecimal (Decimal.D0 Decimal.Nil) |} : wuint let v := 0%wuint8' in v : wuint : wuint let v := 0%wuint9 in v : wuint : wuint let v := 0%wuint9' in v : wuint : wuint let v := 0 in v : nat : nat File "./output/NumberNotations.v", line 191, characters 34-35: The command has indeed failed with message: In environment v := 0 : nat The term "v" has type "nat" while it is expected to have type "wuint". File "./output/NumberNotations.v", line 203, characters 2-71: Warning: The 'abstract after' directive has no effect when the parsing function (of_uint) targets an option type. [abstract-large-number-no-op,numbers,default] File "./output/NumberNotations.v", line 206, characters 2-77: The command has indeed failed with message: The 'abstract after' directive has no effect when the parsing function (of_uint) targets an option type. [abstract-large-number-no-op,numbers,default] let v := of_uint (Number.UIntDecimal (Decimal.D1 Decimal.Nil)) in v : unit : unit let v := 0%test13 in v : unit : unit File "./output/NumberNotations.v", line 238, characters 36-44: The command has indeed failed with message: to_uint' is bound to a notation that does not denote a reference. File "./output/NumberNotations.v", line 239, characters 35-36: The command has indeed failed with message: In environment v := 0 : nat The term "v" has type "nat" while it is expected to have type "unit". File "./output/NumberNotations.v", line 240, characters 36-45: The command has indeed failed with message: to_uint'' is bound to a notation that does not denote a reference. File "./output/NumberNotations.v", line 241, characters 36-37: The command has indeed failed with message: In environment v := 0 : nat The term "v" has type "nat" while it is expected to have type "unit". let v := 0%test14' in v : unit : unit let v := 0%test14' in v : unit : unit File "./output/NumberNotations.v", line 264, characters 34-35: The command has indeed failed with message: In environment v := 0 : nat The term "v" has type "nat" while it is expected to have type "unit". File "./output/NumberNotations.v", line 265, characters 35-36: The command has indeed failed with message: In environment v := 0 : nat The term "v" has type "nat" while it is expected to have type "unit". File "./output/NumberNotations.v", line 267, characters 34-35: The command has indeed failed with message: In environment v := 0 : nat The term "v" has type "nat" while it is expected to have type "unit". let v := 0%test14' in v : unit : unit File "./output/NumberNotations.v", line 273, characters 4-71: The command has indeed failed with message: This command does not support the Global option in sections. let v := 0%test14'' in v : unit : unit File "./output/NumberNotations.v", line 275, characters 39-40: The command has indeed failed with message: In environment v := 0 : nat The term "v" has type "nat" while it is expected to have type "unit". File "./output/NumberNotations.v", line 277, characters 36-37: The command has indeed failed with message: In environment v := 0 : nat The term "v" has type "nat" while it is expected to have type "unit". File "./output/NumberNotations.v", line 278, characters 37-38: The command has indeed failed with message: In environment v := 0 : nat The term "v" has type "nat" while it is expected to have type "unit". let v := 0%test15 in v : unit : unit let v := 0%test15 in v : unit : unit let v := 0%test15 in v : unit : unit let v := foo a.t in v : Foo : Foo File "./output/NumberNotations.v", line 320, characters 22-23: The command has indeed failed with message: Cannot interpret in test16_scope because NumberNotations.Test16.F.Foo could not be found in the current environment. let v := 0%test17 in v : myint63 : myint63 let v := 0%Q in v : Q : Q let v := 1%Q in v : Q : Q let v := 2%Q in v : Q : Q let v := 3%Q in v : Q : Q let v := 4%Q in v : Q : Q = (0, 1) : nat * nat = (1, 1) : nat * nat = (2, 1) : nat * nat = (3, 1) : nat * nat = (4, 1) : nat * nat let v := (-1)%Zlike in v : Zlike : Zlike let v := 0%Zlike in v : Zlike : Zlike let v := 1%Zlike in v : Zlike : Zlike let v := 2%Zlike in v : Zlike : Zlike let v := 3%Zlike in v : Zlike : Zlike let v := 4%Zlike in v : Zlike : Zlike 2%Zlike : Zlike 0%Zlike : Zlike let v := 0%kt in v : ty : ty let v := 1%kt in v : ty : ty let v := 2%kt in v : ty : ty let v := 3%kt in v : ty : ty let v := 4%kt in v : ty : ty let v := 5%kt in v : ty : ty File "./output/NumberNotations.v", line 451, characters 22-23: The command has indeed failed with message: Cannot interpret this number as a value of type ty = 0%kt : ty = 1%kt : ty = 2%kt : ty = 3%kt : ty = 4%kt : ty = 5%kt : ty let v : ty := Build_ty Empty_set zero in v : ty : ty let v : ty := Build_ty unit one in v : ty : ty let v : ty := Build_ty bool two in v : ty : ty let v : ty := Build_ty Prop prop in v : ty : ty let v : ty := Build_ty Set set in v : ty : ty let v : ty := Build_ty Type type in v : ty : ty 1 : nat (-1000)%Z : Z 0 : Prop +0 : bool -0 : bool 00 : nat * nat 1000 : Prop 1_000 : list nat 0 : Set 1 : Set 2 : Set 3 : Set Empty_set : Set unit : Set sum unit unit : Set sum unit (sum unit unit) : Set File "./output/NumberNotations.v", line 546, characters 0-112: The command has indeed failed with message: Missing mapping for constructor Isum. File "./output/NumberNotations.v", line 552, characters 68-73: The command has indeed failed with message: Iunit was already mapped to unit and cannot be remapped to unit. File "./output/NumberNotations.v", line 556, characters 47-50: The command has indeed failed with message: add is not an inductive type. File "./output/NumberNotations.v", line 562, characters 40-43: The command has indeed failed with message: add is not a constructor of an inductive type. File "./output/NumberNotations.v", line 566, characters 0-103: The command has indeed failed with message: Missing mapping for constructor Iempty. File "./output/NumberNotations.v", line 580, characters 56-61: Warning: Type of I'sum seems incompatible with the type of sum. Expected type is: (I' -> I' -> I') instead of (I -> I' -> I'). This might yield ill typed terms when using the notation. [via-type-mismatch,numbers,default] File "./output/NumberNotations.v", line 585, characters 32-33: Warning: I was already mapped to Set, mapping it also to nat might yield ill typed terms when using the notation. [via-type-remapping,numbers,default] File "./output/NumberNotations.v", line 585, characters 37-42: Warning: Type of Iunit seems incompatible with the type of O. Expected type is: I instead of I. This might yield ill typed terms when using the notation. [via-type-mismatch,numbers,default] File "./output/NumberNotations.v", line 589, characters 0-146: The command has indeed failed with message: 'via' and 'abstract' cannot be used together. File "./output/NumberNotations.v", line 636, characters 0-15: Warning: Using Vector.t is known to be technically difficult, see . [warn-library-file-stdlib-vector,stdlib-vector,warn-library-file,user-warn,default] File "./output/NumberNotations.v", line 665, characters 21-23: Warning: Type of I1 seems incompatible with the type of Fin.F1. Expected type is: (nat -> I) instead of I. This might yield ill typed terms when using the notation. [via-type-mismatch,numbers,default] File "./output/NumberNotations.v", line 665, characters 35-37: Warning: Type of IS seems incompatible with the type of Fin.FS. Expected type is: (nat -> I -> I) instead of (I -> I). This might yield ill typed terms when using the notation. [via-type-mismatch,numbers,default] File "./output/NumberNotations.v", line 668, characters 11-12: The command has indeed failed with message: The term "0" has type "forall n : nat, Fin.t (S n)" while it is expected to have type "nat". 0 : Fin.t (S ?n) where ?n : [ |- nat] 1 : Fin.t (S (S ?n)) where ?n : [ |- nat] 2 : Fin.t (S (S (S ?n))) where ?n : [ |- nat] 3 : Fin.t (S (S (S (S ?n)))) where ?n : [ |- nat] 0 : Fin.t 3 : Fin.t 3 1 : Fin.t 3 : Fin.t 3 2 : Fin.t 3 : Fin.t 3 File "./output/NumberNotations.v", line 681, characters 11-42: The command has indeed failed with message: The term "3" has type "Fin.t (S (S (S (S ?n))))" while it is expected to have type "Fin.t 3". @Fin.F1 ?n : Fin.t (S ?n) where ?n : [ |- nat] @Fin.FS (S ?n) (@Fin.F1 ?n) : Fin.t (S (S ?n)) where ?n : [ |- nat] @Fin.FS (S (S ?n)) (@Fin.FS (S ?n) (@Fin.F1 ?n)) : Fin.t (S (S (S ?n))) where ?n : [ |- nat] @Fin.FS (S (S (S ?n))) (@Fin.FS (S (S ?n)) (@Fin.FS (S ?n) (@Fin.F1 ?n))) : Fin.t (S (S (S (S ?n)))) where ?n : [ |- nat] @Fin.F1 (S (S O)) : Fin.t (S (S (S O))) : Fin.t (S (S (S O))) @Fin.FS (S (S O)) (@Fin.F1 (S O)) : Fin.t (S (S (S O))) : Fin.t (S (S (S O))) @Fin.FS (S (S O)) (@Fin.FS (S O) (@Fin.F1 O)) : Fin.t (S (S (S O))) : Fin.t (S (S (S O))) File "./output/NumberNotations.v", line 690, characters 11-12: The command has indeed failed with message: The term "@Fin.FS (S (S (S ?n))) (@Fin.FS (S (S ?n)) (@Fin.FS (S ?n) (@Fin.F1 ?n)))" has type "Fin.t (S (S (S (S ?n))))" while it is expected to have type "Fin.t (S (S (S O)))". 0 : list unit 1 : list unit 2 : list unit 2 : list unit 0 :: 0 :: nil : list nat 0 : Ip nat bool 1 : Ip nat bool 2 : Ip nat bool 3 : Ip nat bool 1 : Ip nat bool 1 : Ip nat bool 1 : Ip nat bool 1 : Ip nat bool Ip0 nat nat 1 : Ip nat nat Ip0 bool bool 1 : Ip bool bool Ip1 nat nat 1 : Ip nat nat Ip3 1 nat nat : Ip nat nat Ip0 nat bool O : Ip nat bool Ip1 bool nat (S O) : Ip nat bool Ip2 nat (S (S O)) bool : Ip nat bool Ip3 (S (S (S O))) nat bool : Ip nat bool 0 : 0 = 0 eq_refl : 1 = 1 0 : 0 = 0 eq_refl : id 0 = id 0 eq_refl : 1 = 1 0 : 0 = 0 eq_refl : id 0 = id 0 2 : extra_list_unit cons O unit tt (cons O unit tt (nil O unit)) : extra_list unit 0 : Set 1 : Set 2 : Set 3 : Set Empty_set : Set unit : Set sum unit unit : Set sum unit (sum unit unit) : Set 0 : Fin.t (S ?n) where ?n : [ |- nat] 1 : Fin.t (S (S ?n)) where ?n : [ |- nat] 2 : Fin.t (S (S (S ?n))) where ?n : [ |- nat] 3 : Fin.t (S (S (S (S ?n)))) where ?n : [ |- nat] 0 : Fin.t 3 : Fin.t 3 1 : Fin.t 3 : Fin.t 3 2 : Fin.t 3 : Fin.t 3 File "./output/NumberNotations.v", line 918, characters 11-42: The command has indeed failed with message: The term "3" has type "Fin.t (S (S (S (S ?n))))" while it is expected to have type "Fin.t 3". @Fin.F1 ?n : Fin.t (S ?n) where ?n : [ |- nat] @Fin.FS (S ?n) (@Fin.F1 ?n) : Fin.t (S (S ?n)) where ?n : [ |- nat] @Fin.FS (S (S ?n)) (@Fin.FS (S ?n) (@Fin.F1 ?n)) : Fin.t (S (S (S ?n))) where ?n : [ |- nat] @Fin.FS (S (S (S ?n))) (@Fin.FS (S (S ?n)) (@Fin.FS (S ?n) (@Fin.F1 ?n))) : Fin.t (S (S (S (S ?n)))) where ?n : [ |- nat] @Fin.F1 (S (S O)) : Fin.t (S (S (S O))) : Fin.t (S (S (S O))) @Fin.FS (S (S O)) (@Fin.F1 (S O)) : Fin.t (S (S (S O))) : Fin.t (S (S (S O))) @Fin.FS (S (S O)) (@Fin.FS (S O) (@Fin.F1 O)) : Fin.t (S (S (S O))) : Fin.t (S (S (S O))) File "./output/NumberNotations.v", line 927, characters 11-12: The command has indeed failed with message: The term "@Fin.FS (S (S (S ?n))) (@Fin.FS (S (S ?n)) (@Fin.FS (S ?n) (@Fin.F1 ?n)))" has type "Fin.t (S (S (S (S ?n))))" while it is expected to have type "Fin.t (S (S (S O)))". 0 : Fin.t (S ?n) where ?n : [ |- nat : Set] 1 : Fin.t (S (S ?n)) where ?n : [ |- nat : Set] 2 : Fin.t (S (S (S ?n))) where ?n : [ |- nat : Set] 3 : Fin.t (S (S (S (S ?n)))) where ?n : [ |- nat : Set] 0 : Fin.t 3 : Fin.t 3 1 : Fin.t 3 : Fin.t 3 2 : Fin.t 3 : Fin.t 3 File "./output/NumberNotations.v", line 972, characters 11-42: The command has indeed failed with message: The term "3" has type "Fin.t (S (S (S (S ?n))))" while it is expected to have type "Fin.t 3". @Fin.F1 ?n : Fin.t (S ?n) where ?n : [ |- nat : Set] @Fin.FS (S ?n) (@Fin.F1 ?n) : Fin.t (S (S ?n)) where ?n : [ |- nat : Set] @Fin.FS (S (S ?n)) (@Fin.FS (S ?n) (@Fin.F1 ?n)) : Fin.t (S (S (S ?n))) where ?n : [ |- nat : Set] @Fin.FS (S (S (S ?n))) (@Fin.FS (S (S ?n)) (@Fin.FS (S ?n) (@Fin.F1 ?n))) : Fin.t (S (S (S (S ?n)))) where ?n : [ |- nat : Set] @Fin.F1 (S (S O)) : Fin.t (S (S (S O))) : Fin.t (S (S (S O))) @Fin.FS (S (S O)) (@Fin.F1 (S O)) : Fin.t (S (S (S O))) : Fin.t (S (S (S O))) @Fin.FS (S (S O)) (@Fin.FS (S O) (@Fin.F1 O)) : Fin.t (S (S (S O))) : Fin.t (S (S (S O))) File "./output/NumberNotations.v", line 981, characters 11-12: The command has indeed failed with message: The term "@Fin.FS (S (S (S ?n))) (@Fin.FS (S (S ?n)) (@Fin.FS (S ?n) (@Fin.F1 ?n)))" has type "Fin.t (S (S (S (S ?n))))" while it is expected to have type "Fin.t (S (S (S O)))". 0%float : float 1%float : float infinity : float neg_infinity : float nan : float 2 : nunit2 2 : nunit2 NUnit 3 : nunit 3 NUnit 0 : nunit 0 NUnit (1 + 1) : nunit (1 + 1) coq-8.20.0/test-suite/output/NumberNotations.v000066400000000000000000000740441466560755400214020ustar00rootroot00000000000000(* Test that we fail, rather than raising anomalies, on opaque terms during interpretation *) Declare Scope opaque_scope. (* https://github.com/coq/coq/pull/8064#discussion_r202497516 *) Module Test1. Axiom hold : forall {A B C}, A -> B -> C. Definition opaque3 (x : Number.int) : Number.int := hold x (fix f (x : nat) : nat := match x with O => O | S n => S (f n) end). Number Notation Number.int opaque3 opaque3 : opaque_scope. Delimit Scope opaque_scope with opaque. Fail Check 1%opaque. End Test1. (* https://github.com/coq/coq/pull/8064#discussion_r202497990 *) Module Test2. Axiom opaque4 : option Number.int. Definition opaque6 (x : Number.int) : option Number.int := opaque4. Number Notation Number.int opaque6 opaque6 : opaque_scope. Delimit Scope opaque_scope with opaque. Open Scope opaque_scope. Fail Check 1%opaque. End Test2. Declare Scope silly_scope. Module Test3. Inductive silly := SILLY (v : Number.uint) (f : forall A, A -> A). Definition to_silly (v : Number.uint) := SILLY v (fun _ x => x). Definition of_silly (v : silly) := match v with SILLY v _ => v end. Number Notation silly to_silly of_silly : silly_scope. Delimit Scope silly_scope with silly. Fail Check 1%silly. End Test3. Module Test4. Declare Scope opaque_scope. Declare Scope silly_scope. Declare Scope pto. Declare Scope ppo. Declare Scope ptp. Declare Scope ppp. Declare Scope uto. Declare Scope upo. Declare Scope utp. Declare Scope upp. Declare Scope ppps. Polymorphic NonCumulative Inductive punit := ptt. Polymorphic Definition pto_punit (v : Number.uint) : option punit := match Nat.of_num_uint v with O => Some ptt | _ => None end. Polymorphic Definition pto_punit_all (v : Number.uint) : punit := ptt. Polymorphic Definition pof_punit (v : punit) : Number.uint := Nat.to_num_uint 0. Definition to_punit (v : Number.uint) : option punit := match Nat.of_num_uint v with O => Some ptt | _ => None end. Definition of_punit (v : punit) : Number.uint := Nat.to_num_uint 0. Polymorphic Definition pto_unit (v : Number.uint) : option unit := match Nat.of_num_uint v with O => Some tt | _ => None end. Polymorphic Definition pof_unit (v : unit) : Number.uint := Nat.to_num_uint 0. Definition to_unit (v : Number.uint) : option unit := match Nat.of_num_uint v with O => Some tt | _ => None end. Definition of_unit (v : unit) : Number.uint := Nat.to_num_uint 0. Number Notation punit to_punit of_punit : pto. Number Notation punit pto_punit of_punit : ppo. Number Notation punit to_punit pof_punit : ptp. Number Notation punit pto_punit pof_punit : ppp. Number Notation unit to_unit of_unit : uto. Delimit Scope pto with pto. Delimit Scope ppo with ppo. Delimit Scope ptp with ptp. Delimit Scope ppp with ppp. Delimit Scope uto with uto. Check let v := 0%pto in v : punit. Check let v := 0%ppo in v : punit. Check let v := 0%ptp in v : punit. Check let v := 0%ppp in v : punit. Check let v := 0%uto in v : unit. Fail Check 1%uto. Fail Check (-1)%uto. Number Notation unit pto_unit of_unit : upo. Number Notation unit to_unit pof_unit : utp. Number Notation unit pto_unit pof_unit : upp. Delimit Scope upo with upo. Delimit Scope utp with utp. Delimit Scope upp with upp. Check let v := 0%upo in v : unit. Check let v := 0%utp in v : unit. Check let v := 0%upp in v : unit. Polymorphic Definition pto_punits := pto_punit_all@{Set}. Polymorphic Definition pof_punits := pof_punit@{Set}. Number Notation punit pto_punits pof_punits (abstract after 0) : ppps. Delimit Scope ppps with ppps. Universe u. Constraint Set < u. Check let v := 0%ppps in v : punit@{u}. (* Check that universes are refreshed *) Fail Check let v := 1%ppps in v : punit@{u}. (* Note that universes are not refreshed here *) End Test4. Module Test5. Check S. (* At one point gave Error: Anomaly "Uncaught exception Pretype_errors.PretypeError(_, _, _)." Please report at http://coq.inria.fr/bugs/. *) End Test5. Module Test6. (* Check that number notations on enormous terms don't take forever to print/parse *) (* Ackerman definition from https://stackoverflow.com/a/10303475/377022 *) Fixpoint ack (n m : nat) : nat := match n with | O => S m | S p => let fix ackn (m : nat) := match m with | O => ack p 1 | S q => ack p (ackn q) end in ackn m end. Timeout 1 Check (S (ack 4 4)). (* should be instantaneous *) Local Set Primitive Projections. Record > wnat := wrap { unwrap :> nat }. Definition to_uint (x : wnat) : Number.uint := Nat.to_num_uint x. Definition of_uint (x : Number.uint) : wnat := Nat.of_num_uint x. Module Export Scopes. Declare Scope wnat_scope. Delimit Scope wnat_scope with wnat. End Scopes. Module Export Notations. Export Scopes. Number Notation wnat of_uint to_uint (abstract after 4999) : wnat_scope. End Notations. Set Printing Coercions. Check let v := 0%wnat in v : wnat. Check wrap O. Timeout 1 Check wrap (ack 4 4). (* should be instantaneous *) End Test6. Module Test6_2. Import Test6.Scopes. Check Test6.wrap 0. Import Test6.Notations. Check let v := 0%wnat in v : Test6.wnat. End Test6_2. Module Test7. Local Set Primitive Projections. Record wuint := wrap { unwrap : Number.uint }. Declare Scope wuint_scope. Delimit Scope wuint_scope with wuint. Number Notation wuint wrap unwrap : wuint_scope. Check let v := 0%wuint in v : wuint. Check let v := 1%wuint in v : wuint. End Test7. Module Test8. Local Set Primitive Projections. Record wuint := wrap { unwrap : Number.uint }. Declare Scope wuint8_scope. Declare Scope wuint8'_scope. Delimit Scope wuint8_scope with wuint8. Delimit Scope wuint8'_scope with wuint8'. Section with_var. Context (dummy : unit). Definition wrap' := let __ := dummy in wrap. Definition unwrap' := let __ := dummy in unwrap. Number Notation wuint wrap' unwrap' : wuint8_scope. Check let v := 0%wuint8 in v : wuint. End with_var. Check let v := 0%wuint8 in v : nat. Fail Check let v := 0%wuint8 in v : wuint. Compute wrap (Nat.to_num_uint 0). Notation wrap'' := wrap. Notation unwrap'' := unwrap. Number Notation wuint wrap'' unwrap'' : wuint8'_scope. Check let v := 0%wuint8' in v : wuint. End Test8. Module Test9. Declare Scope wuint9_scope. Declare Scope wuint9'_scope. Delimit Scope wuint9_scope with wuint9. Delimit Scope wuint9'_scope with wuint9'. Section with_let. Local Set Primitive Projections. Record wuint := wrap { unwrap : Number.uint }. Let wrap' := wrap. Let unwrap' := unwrap. Local Notation wrap'' := wrap. Local Notation unwrap'' := unwrap. Number Notation wuint wrap' unwrap' : wuint9_scope. Check let v := 0%wuint9 in v : wuint. Number Notation wuint wrap'' unwrap'' : wuint9'_scope. Check let v := 0%wuint9' in v : wuint. End with_let. Check let v := 0%wuint9 in v : nat. Fail Check let v := 0%wuint9 in v : wuint. End Test9. Module Test10. (* Test that it is only a warning to add abstract after to an optional parsing function *) Definition to_uint (v : unit) := Nat.to_num_uint 0. Definition of_uint (v : Number.uint) := match Nat.of_num_uint v with O => Some tt | _ => None end. Definition of_any_uint (v : Number.uint) := tt. Declare Scope unit_scope. Declare Scope unit2_scope. Delimit Scope unit_scope with unit. Delimit Scope unit2_scope with unit2. Number Notation unit of_uint to_uint (abstract after 0) : unit_scope. Local Set Warnings Append "+abstract-large-number-no-op". (* Check that there is actually a warning here *) Fail Number Notation unit of_uint to_uint (abstract after 0) : unit2_scope. (* Check that there is no warning here *) Number Notation unit of_any_uint to_uint (abstract after 0) : unit2_scope. End Test10. Module Test12. (* Test for number notations on context variables *) Declare Scope test12_scope. Delimit Scope test12_scope with test12. Section test12. Context (to_uint : unit -> Number.uint) (of_uint : Number.uint -> unit). Number Notation unit of_uint to_uint : test12_scope. Check let v := 1%test12 in v : unit. End test12. End Test12. Module Test13. (* Test for number notations on notations which do not denote references *) Declare Scope test13_scope. Declare Scope test13'_scope. Declare Scope test13''_scope. Delimit Scope test13_scope with test13. Delimit Scope test13'_scope with test13'. Delimit Scope test13''_scope with test13''. Definition to_uint (x y : unit) : Number.uint := Nat.to_num_uint O. Definition of_uint (x : Number.uint) : unit := tt. Definition to_uint_good := to_uint tt. Notation to_uint' := (to_uint tt). Notation to_uint'' := (to_uint _). Number Notation unit of_uint to_uint_good : test13_scope. Check let v := 0%test13 in v : unit. Fail Number Notation unit of_uint to_uint' : test13'_scope. Fail Check let v := 0%test13' in v : unit. Fail Number Notation unit of_uint to_uint'' : test13''_scope. Fail Check let v := 0%test13'' in v : unit. End Test13. Module Test14. (* Test that number notations follow [Import], not [Require], and also test that [Local Number Notation]s do not escape modules nor sections. *) Declare Scope test14_scope. Declare Scope test14'_scope. Declare Scope test14''_scope. Declare Scope test14'''_scope. Delimit Scope test14_scope with test14. Delimit Scope test14'_scope with test14'. Delimit Scope test14''_scope with test14''. Delimit Scope test14'''_scope with test14'''. Module Inner. Definition to_uint (x : unit) : Number.uint := Nat.to_num_uint O. Definition of_uint (x : Number.uint) : unit := tt. Local Number Notation unit of_uint to_uint : test14_scope. Global Number Notation unit of_uint to_uint : test14'_scope. Check let v := 0%test14 in v : unit. Check let v := 0%test14' in v : unit. End Inner. Fail Check let v := 0%test14 in v : unit. Fail Check let v := 0%test14' in v : unit. Import Inner. Fail Check let v := 0%test14 in v : unit. Check let v := 0%test14' in v : unit. Section InnerSection. Definition to_uint (x : unit) : Number.uint := Nat.to_num_uint O. Definition of_uint (x : Number.uint) : unit := tt. Local Number Notation unit of_uint to_uint : test14''_scope. Fail Global Number Notation unit of_uint to_uint : test14'''_scope. Check let v := 0%test14'' in v : unit. Fail Check let v := 0%test14''' in v : unit. End InnerSection. Fail Check let v := 0%test14'' in v : unit. Fail Check let v := 0%test14''' in v : unit. End Test14. Module Test15. (** Test module include *) Declare Scope test15_scope. Delimit Scope test15_scope with test15. Module Inner. Definition to_uint (x : unit) : Number.uint := Nat.to_num_uint O. Definition of_uint (x : Number.uint) : unit := tt. Number Notation unit of_uint to_uint : test15_scope. Check let v := 0%test15 in v : unit. End Inner. Module Inner2. Include Inner. Check let v := 0%test15 in v : unit. End Inner2. Import Inner Inner2. Check let v := 0%test15 in v : unit. End Test15. Module Test16. (** Test functors *) Declare Scope test16_scope. Delimit Scope test16_scope with test16. Module Type A. Axiom T : Set. Axiom t : T. End A. Module F (a : A). Inductive Foo := foo (_ : a.T). Definition to_uint (x : Foo) : Number.uint := Nat.to_num_uint O. Definition of_uint (x : Number.uint) : Foo := foo a.t. Global Number Notation Foo of_uint to_uint : test16_scope. Check let v := 0%test16 in v : Foo. End F. Module a <: A. Definition T : Set := unit. Definition t : T := tt. End a. Module Import f := F a. (** Ideally this should work, but it should definitely not anomaly *) Fail Check let v := 0%test16 in v : Foo. End Test16. Require Import Coq.Numbers.Cyclic.Int63.Uint63. Module Test17. (** Test uint63 *) Declare Scope test17_scope. Declare Scope test17_scope. Delimit Scope test17_scope with test17. Local Set Primitive Projections. Record myint63 := of_int { to_int : int }. Definition parse x := match x with Pos x => Some (of_int x) | Neg _ => None end. Definition print x := Pos (to_int x). Number Notation myint63 parse print : test17_scope. Check let v := 0%test17 in v : myint63. End Test17. Module Test18. (** Test https://github.com/coq/coq/issues/9840 *) Record Q := { num : nat ; den : nat ; reduced : Nat.gcd num den = 1 }. Declare Scope Q_scope. Delimit Scope Q_scope with Q. Definition nat_eq_dec (x y : nat) : {x = y} + {x <> y}. Proof. decide equality. Defined. Definition transparentify {A} (D : {A} + {not A}) (H : A) : A := match D with | left pf => pf | right npf => match npf H with end end. Axiom gcd_good : forall x, Nat.gcd x 1 = 1. Definition Q_of_nat (x : nat) : Q := {| num := x ; den := 1 ; reduced := transparentify (nat_eq_dec _ _) (gcd_good _) |}. Definition nat_of_Q (x : Q) : option nat := if Nat.eqb x.(den) 1 then Some (x.(num)) else None. Definition Q_of_uint (x : Number.uint) : Q := Q_of_nat (Nat.of_num_uint x). Definition uint_of_Q (x : Q) : option Number.uint := option_map Nat.to_num_uint (nat_of_Q x). Number Notation Q Q_of_uint uint_of_Q : Q_scope. Check let v := 0%Q in v : Q. Check let v := 1%Q in v : Q. Check let v := 2%Q in v : Q. Check let v := 3%Q in v : Q. Check let v := 4%Q in v : Q. Compute let v := 0%Q in (num v, den v). Compute let v := 1%Q in (num v, den v). Compute let v := 2%Q in (num v, den v). Compute let v := 3%Q in (num v, den v). Compute let v := 4%Q in (num v, den v). End Test18. Require Import Coq.Lists.List. Require Import Coq.ZArith.ZArith. Module Test19. (** Test another thing related to https://github.com/coq/coq/issues/9840 *) Record Zlike := { summands : list Z }. Declare Scope Zlike_scope. Delimit Scope Zlike_scope with Zlike. Definition Z_of_Zlike (x : Zlike) := List.fold_right Z.add 0%Z (summands x). Definition Zlike_of_Z (x : Z) := {| summands := cons x nil |}. Number Notation Zlike Zlike_of_Z Z_of_Zlike : Zlike_scope. Check let v := (-1)%Zlike in v : Zlike. Check let v := 0%Zlike in v : Zlike. Check let v := 1%Zlike in v : Zlike. Check let v := 2%Zlike in v : Zlike. Check let v := 3%Zlike in v : Zlike. Check let v := 4%Zlike in v : Zlike. Check {| summands := (cons 1 (cons 2 (cons (-1) nil)))%Z |}. Check {| summands := nil |}. End Test19. Module Test20. (** Test Sorts *) Local Set Universe Polymorphism. Inductive known_type : Type -> Type := | prop : known_type Prop | set : known_type Set | type : known_type Type | zero : known_type Empty_set | one : known_type unit | two : known_type bool. Existing Class known_type. #[global] Existing Instances zero one two prop. #[global] Existing Instance set | 2. #[global] Existing Instance type | 4. Record > ty := { t : Type ; kt : known_type t }. Definition ty_of_uint (x : Number.uint) : option ty := match Nat.of_num_uint x with | 0 => @Some ty zero | 1 => @Some ty one | 2 => @Some ty two | 3 => @Some ty prop | 4 => @Some ty set | 5 => @Some ty type | _ => None end. Definition uint_of_ty (x : ty) : Number.uint := Nat.to_num_uint match kt x with | prop => 3 | set => 4 | type => 5 | zero => 0 | one => 1 | two => 2 end. Declare Scope kt_scope. Delimit Scope kt_scope with kt. Number Notation ty ty_of_uint uint_of_ty : kt_scope. Check let v := 0%kt in v : ty. Check let v := 1%kt in v : ty. Check let v := 2%kt in v : ty. Check let v := 3%kt in v : ty. Check let v := 4%kt in v : ty. Check let v := 5%kt in v : ty. Fail Check let v := 6%kt in v : ty. Eval cbv in (_ : known_type Empty_set) : ty. Eval cbv in (_ : known_type unit) : ty. Eval cbv in (_ : known_type bool) : ty. Eval cbv in (_ : known_type Prop) : ty. Eval cbv in (_ : known_type Set) : ty. Eval cbv in (_ : known_type Type) : ty. Local Set Printing All. Check let v := 0%kt in v : ty. Check let v := 1%kt in v : ty. Check let v := 2%kt in v : ty. Check let v := 3%kt in v : ty. Check let v := 4%kt in v : ty. Check let v := 5%kt in v : ty. End Test20. Module Test21. Check 00001. Check (-1_000)%Z. End Test21. Module Test22. Notation "0" := False. Notation "+0" := true. Notation "-0" := false. Notation "00" := (0%nat, 0%nat). Check 0. Check +0. Check -0. Check 00. Notation "1000" := True. Notation "1_000" := (cons 1 nil). Check 1000. Check 1_000. (* To do: preserve parsing of -0: Require Import ZArith. Check (-0)%Z. *) End Test22. (* Test the via ... mapping ... option *) Module Test23. Inductive sum (A : Set) (B : Set) : Set := pair : A -> B -> sum A B. Inductive I := | Iempty : I | Iunit : I | Isum : I -> I -> I. Definition of_uint (x : Number.uint) : I := let fix f n := match n with | O => Iempty | S O => Iunit | S n => Isum Iunit (f n) end in f (Nat.of_num_uint x). Definition to_uint (x : I) : Number.uint := let fix f i := match i with | Iempty => O | Iunit => 1 | Isum i1 i2 => f i1 + f i2 end in Nat.to_num_uint (f x). Notation nSet := (Set) (only parsing). (* needed as a reference is expected in Number Notation and Set is syntactically not a reference *) Number Notation nSet of_uint to_uint (via I mapping [Empty_set => Iempty, unit => Iunit, sum => Isum]) : type_scope. Local Open Scope type_scope. Check Empty_set. Check unit. Check sum unit unit. Check sum unit (sum unit unit). Set Printing All. Check 0. Check 1. Check 2. Check 3. Unset Printing All. (* Test error messages *) (* missing constructor *) Fail Number Notation nSet of_uint to_uint (via I mapping [Empty_set => Iempty, unit => Iunit]) : type_scope. (* duplicate constructor *) Fail Number Notation nSet of_uint to_uint (via I mapping [Empty_set => Iempty, unit => Iunit, sum => Isum, unit => Iunit]) : type_scope. (* not an inductive *) Fail Number Notation nSet of_uint to_uint (via add mapping [Empty_set => Iempty, unit => Iunit, sum => Isum]) : type_scope. (* not a constructor *) Fail Number Notation nSet of_uint to_uint (via I mapping [Empty_set => Iempty, unit => add, sum => Isum]) : type_scope. (* put constructors of the wrong inductive ~~> missing constructors *) Fail Number Notation nSet of_uint to_uint (via I mapping [Empty_set => O, unit => S]) : type_scope. (* Test warnings *) (* wrong type *) Inductive I' := | I'empty : I' | I'unit : I' | I'sum : I -> I' -> I'. Definition of_uint' (x : Number.uint) : I' := I'empty. Definition to_uint' (x : I') : Number.uint := Number.UIntDecimal Decimal.Nil. Number Notation nSet of_uint' to_uint' (via I' mapping [Empty_set => I'empty, unit => I'unit, sum => I'sum]) : type_scope. (* wrong type mapping *) Number Notation nSet of_uint to_uint (via I mapping [Empty_set => Iempty, O => Iunit, sum => Isum]) : type_scope. (* incompatibility with abstract (but warning is fine) *) Fail Number Notation nSet of_uint to_uint (via I mapping [Empty_set => Iempty, unit => Iunit, sum => Isum], abstract after 11) : type_scope. Number Notation nSet of_uint to_uint (via I mapping [Empty_set => Iempty, unit => Iunit, sum => Isum], warning after 12) : type_scope. (* Test reduction of types when building the notation *) Inductive foo := bar : match (true <: bool) with true => nat -> foo | false => True end. Definition foo_of_uint (x : Number.uint) : foo := bar (Nat.of_num_uint x). Definition foo_to_uint (x : foo) : Number.uint := match x with | bar x => Nat.to_num_uint x end. Number Notation foo foo_of_uint foo_to_uint (via foo mapping [bar => bar]) : type_scope. Inductive foo' := bar' : let n := nat in n -> foo'. Definition foo'_of_uint (x : Number.uint) : foo' := bar' (Nat.of_num_uint x). Definition foo'_to_uint (x : foo') : Number.uint := match x with | bar' x => Nat.to_num_uint x end. Number Notation foo' foo'_of_uint foo'_to_uint (via foo' mapping [bar' => bar']) : type_scope. Inductive foo'' := bar'' : (nat <: Type) -> (foo'' <: Type). Definition foo''_of_uint (x : Number.uint) : foo'' := bar'' (Nat.of_num_uint x). Definition foo''_to_uint (x : foo'') : Number.uint := match x with | bar'' x => Nat.to_num_uint x end. Number Notation foo'' foo''_of_uint foo''_to_uint (via foo'' mapping [bar'' => bar'']) : type_scope. End Test23. (* Test the via ... mapping ... option with implicit arguments *) Require Vector. Module Test24. Import Vector. Inductive I := | I1 : I | IS : I -> I. Definition of_uint (x : Number.uint) : I := let fix f n := match n with | O => I1 | S n => IS (f n) end in f (Nat.of_num_uint x). Definition to_uint (x : I) : Number.uint := let fix f i := match i with | I1 => O | IS n => S (f n) end in Nat.to_num_uint (f x). Local Open Scope type_scope. (* ignoring implicit arguments doesn't work *) Number Notation Fin.t of_uint to_uint (via I mapping [Fin.F1 => I1, Fin.FS => IS]) : type_scope. Fail Check 1. Number Notation Fin.t of_uint to_uint (via I mapping [[Fin.F1] => I1, [Fin.FS] => IS]) : type_scope. Check Fin.F1. Check Fin.FS Fin.F1. Check Fin.FS (Fin.FS Fin.F1). Check Fin.FS (Fin.FS (Fin.FS Fin.F1)). Check Fin.F1 : Fin.t 3. Check Fin.FS Fin.F1 : Fin.t 3. Check Fin.FS (Fin.FS Fin.F1) : Fin.t 3. Fail Check Fin.FS (Fin.FS (Fin.FS Fin.F1)) : Fin.t 3. Set Printing All. Check 0. Check 1. Check 2. Check 3. Check 0 : Fin.t 3. Check 1 : Fin.t 3. Check 2 : Fin.t 3. Fail Check 3 : Fin.t 3. Unset Printing All. End Test24. (* Test number notations for parameterized inductives *) Module Test25. Definition of_uint (u : Number.uint) : list unit := let fix f n := match n with | O => nil | S n => cons tt (f n) end in f (Nat.of_num_uint u). Definition to_uint (l : list unit) : Number.uint := let fix f n := match n with | nil => O | cons tt l => S (f l) end in Nat.to_num_uint (f l). Notation listunit := (list unit) (only parsing). Number Notation listunit of_uint to_uint : nat_scope. Check 0. Check 1. Check 2. Check cons tt (cons tt nil). Check cons O (cons O nil). (* printer not called on list nat *) (* inductive with multiple parameters that are not the first parameters and not in the same order for each constructor *) Inductive Ip : Type -> Type -> Type := | Ip0 : forall T T', nat -> Ip T T' | Ip1 : forall T' T, nat -> Ip T T' | Ip2 : forall T, nat -> forall T', Ip T T' | Ip3 : nat -> forall T T', Ip T T'. Definition Ip_of_uint (u : Number.uint) : option (Ip nat bool) := let f n := match n with | O => Some (Ip0 nat bool O) | S O => Some (Ip1 bool nat (S O)) | S (S O) => Some (Ip2 nat (S (S O)) bool) | S (S (S O)) => Some (Ip3 (S (S (S O))) nat bool) | _ => None end in f (Nat.of_num_uint u). Definition Ip_to_uint (l : Ip nat bool) : Number.uint := let f n := match n with | Ip0 _ _ n => n | Ip1 _ _ n => n | Ip2 _ n _ => n | Ip3 n _ _ => n end in Nat.to_num_uint (f l). Notation Ip_nat_bool := (Ip nat bool) (only parsing). Number Notation Ip_nat_bool Ip_of_uint Ip_to_uint : nat_scope. Check 0. Check 1. Check 2. Check 3. Check Ip0 nat bool (S O). Check Ip1 bool nat (S O). Check Ip2 nat (S O) bool. Check Ip3 (S O) nat bool. Check Ip0 nat nat (S O). (* not printed *) Check Ip0 bool bool (S O). (* not printed *) Check Ip1 nat nat (S O). (* not printed *) Check Ip3 (S O) nat nat. (* not printed *) Set Printing All. Check 0. Check 1. Check 2. Check 3. Unset Printing All. Notation eqO := (eq _ O) (only parsing). Definition eqO_of_uint (x : Number.uint) : eqO := eq_refl O. Definition eqO_to_uint (x : O = O) : Number.uint := match x with | eq_refl _ => Nat.to_num_uint O end. Number Notation eqO eqO_of_uint eqO_to_uint : nat_scope. Check 42. Check eq_refl (S O). (* doesn't match eq _ O, printer not called *) Check eq_refl O. (* matches eq _ O, printer called *) Check eq_refl (id O). (* doesn't match eq _ O, printer not called *) Notation eq_ := (eq _ _) (only parsing). Number Notation eq_ eqO_of_uint eqO_to_uint : nat_scope. Check eq_refl (S O). (* matches eq _ _, printer called, but type incorrect *) Check eq_refl O. (* matches eq _ _, printer called *) Check eq_refl (id O). (* matches eq _ _, but contains a global constant, printer not called *) Inductive extra_list : Type -> Type := | nil (n : nat) (v : Type) : extra_list v | cons (n : nat) (t : Type) (x : t) : extra_list t -> extra_list t. Definition extra_list_unit_of_uint (x : Number.uint) : extra_list unit := let fix f n := match n with | O => nil O unit | S n => cons O unit tt (f n) end in f (Nat.of_num_uint x). Definition extra_list_unit_to_uint (x : extra_list unit) : Number.uint := let fix f T (x : extra_list T) := match x with | nil _ _ => O | cons _ T _ x => S (f T x) end in Nat.to_num_uint (f unit x). Notation extra_list_unit := (extra_list unit). Number Notation extra_list_unit extra_list_unit_of_uint extra_list_unit_to_uint : nat_scope. Check 2. Set Printing All. Check 2. Unset Printing All. End Test25. (* Test the via ... mapping ... option with let-binders, beta-redexes, delta-redexes, etc *) Module Test26. Inductive sum (A : Set) (B : Set) : Set := pair : A -> B -> sum A B. Inductive I (dummy:=O) := | Iempty : let v := I in id v | Iunit : (fun x => x) I | Isum : let v := I in (fun A B => A -> B) (let v' := v in v') (forall x : match O with O => I | _ => Empty_set end, let dummy2 := x in I). Definition of_uint (x : (fun x => let v := I in x) Number.uint) : (fun x => let v := I in x) I := let fix f n := match n with | O => Iempty | S O => Iunit | S n => Isum Iunit (f n) end in f (Nat.of_num_uint x). Definition to_uint (x : (fun x => let v := x in v) I) : match O with O => Number.uint | _ => Empty_set end := let fix f i := match i with | Iempty => O | Iunit => 1 | Isum i1 i2 => f i1 + f i2 end in Nat.to_num_uint (f x). Notation nSet := (Set) (only parsing). (* needed as a reference is expected in Number Notation and Set is syntactically not a reference *) Number Notation nSet of_uint to_uint (via I mapping [Empty_set => Iempty, unit => Iunit, sum => Isum]) : type_scope. Local Open Scope type_scope. Check Empty_set. Check unit. Check sum unit unit. Check sum unit (sum unit unit). Set Printing All. Check 0. Check 1. Check 2. Check 3. Unset Printing All. End Test26. (* Test the via ... mapping ... option with implicit arguments with let binders, etc *) Module Test27. Module Fin. Inductive t0 (x:=O) := with t (x:=O) : forall y : nat, let z := y in Set := | F1 (y:=O) {n} : match y with O => t (S n) | _ => Empty_set end | FS (y:=x) {n} (v:=n+y) (m:=n) : id (match y with O => id (t n) | _ => Empty_set end -> (fun x => x) t (S m)) with t' (x:=O) := . End Fin. Inductive I (dummy:=O) := | I1 : I | IS : let x := I in id x -> I. Definition of_uint (x : Number.uint) : I := let fix f n := match n with | O => I1 | S n => IS (f n) end in f (Nat.of_num_uint x). Definition to_uint (x : I) : Number.uint := let fix f i := match i with | I1 => O | IS n => S (f n) end in Nat.to_num_uint (f x). Local Open Scope type_scope. Number Notation Fin.t of_uint to_uint (via I mapping [[Fin.F1] => I1, [Fin.FS] => IS]) : type_scope. Check Fin.F1. Check Fin.FS Fin.F1. Check Fin.FS (Fin.FS Fin.F1). Check Fin.FS (Fin.FS (Fin.FS Fin.F1)). Check Fin.F1 : Fin.t 3. Check Fin.FS Fin.F1 : Fin.t 3. Check Fin.FS (Fin.FS Fin.F1) : Fin.t 3. Fail Check Fin.FS (Fin.FS (Fin.FS Fin.F1)) : Fin.t 3. Set Printing All. Check 0. Check 1. Check 2. Check 3. Check 0 : Fin.t 3. Check 1 : Fin.t 3. Check 2 : Fin.t 3. Fail Check 3 : Fin.t 3. Unset Printing All. End Test27. Module Test28. Module Fin. Inductive t : nat -> Set := | F1 {n : (nat : Set)} : (t (S n) : Set) | FS {n : (nat : Set)} : (t n : Set) -> (t (S n) : Set). End Fin. Inductive I := | I1 : I | IS : I -> I. Definition of_uint (x : Number.uint) : I := let fix f n := match n with | O => I1 | S n => IS (f n) end in f (Nat.of_num_uint x). Definition to_uint (x : I) : Number.uint := let fix f i := match i with | I1 => O | IS n => S (f n) end in Nat.to_num_uint (f x). Local Open Scope type_scope. Number Notation Fin.t of_uint to_uint (via I mapping [[Fin.F1] => I1, [Fin.FS] => IS]) : type_scope. Check Fin.F1. Check Fin.FS Fin.F1. Check Fin.FS (Fin.FS Fin.F1). Check Fin.FS (Fin.FS (Fin.FS Fin.F1)). Check Fin.F1 : Fin.t 3. Check Fin.FS Fin.F1 : Fin.t 3. Check Fin.FS (Fin.FS Fin.F1) : Fin.t 3. Fail Check Fin.FS (Fin.FS (Fin.FS Fin.F1)) : Fin.t 3. Set Printing All. Check 0. Check 1. Check 2. Check 3. Check 0 : Fin.t 3. Check 1 : Fin.t 3. Check 2 : Fin.t 3. Fail Check 3 : Fin.t 3. Unset Printing All. End Test28. Require Import Floats. Module Test29. Definition printer (x : float_wrapper) : Number.uint := if get_sign (float_wrap x) then Number.UIntDecimal (Decimal.D1 Decimal.Nil) else Number.UIntDecimal (Decimal.D0 Decimal.Nil). Definition parser (x : float) : float := x. Number Notation float parser printer : float_scope. Check 12%float. Check (-12)%float. Check infinity. Check neg_infinity. Check nan. End Test29. Module Test30. Inductive nunit : nat -> Type := NUnit n : nunit n. Definition printer2 (x : nunit 2) : Number.uint := Number.UIntDecimal (Decimal.D2 Decimal.Nil). Definition parser2 (_ : Number.uint) : nunit 2 := NUnit 2. Notation nunit2 := (nunit 2). Number Notation nunit2 parser2 printer2 : nat_scope. Check 2. Check NUnit (S (S O)). Check NUnit (S (S (S O))). Check NUnit O. Check NUnit (S O + S O). (* doesn't print as 2, because (S O + S O) is not syntactically equal to (S (S O)), we could want to use a convertibility test rather than a syntactic equality, but this could be more costly *) End Test30. Module Bug10878. Definition Zto_pos_opt (v : Z) : option positive := match v with | Zpos v => Some v | _ => None end. Declare Scope mypos_scope. Declare Scope mypos_scope2. Number Notation positive Zto_pos_opt Zpos : mypos_scope. (* success *) Arguments option {_}. Number Notation positive Zto_pos_opt Zpos : mypos_scope2. (* was failing *) End Bug10878. coq-8.20.0/test-suite/output/NumberNotationsUnivPoly.out000066400000000000000000000004631466560755400234440ustar00rootroot000000000000000 : B ?a where ?a : [ |- A] 1 : B ?a where ?a : [ |- A] 2 : B ?a where ?a : [ |- A] foo@{v v'} = fun (v : A@{v}) (v' : A@{v'}) => (0 : B@{v} v, 1 : B@{v'} v') : forall (v : A@{v}) (v' : A@{v'}), B@{v} v * B@{v'} v' (* v v' |= v <= prod.u0 v' <= prod.u1 *) Arguments foo v v' coq-8.20.0/test-suite/output/NumberNotationsUnivPoly.v000066400000000000000000000006561466560755400231060ustar00rootroot00000000000000Set Universe Polymorphism. Axiom A : Type. Inductive B : A -> Type := | x {a} : B a | y {a} : B a -> B a . Number Notation B Nat.of_num_uint Nat.to_num_uint (via nat mapping [[x] => O, [y] => S]) : nat_scope. Check 0. Check 1. Check 2. (* check it generates independent univs *) Definition foo@{v v' | v <= prod.u0, v' <= prod.u1} := fun (v:A@{v}) (v':A@{v'}) => (x : B v, y x : B v'). Set Printing Universes. Print foo. coq-8.20.0/test-suite/output/Partac.out000066400000000000000000000005501466560755400200160ustar00rootroot00000000000000File "./output/Partac.v", line 4, characters 2-24: The command has indeed failed with message: The term "false" has type "bool" while it is expected to have type "nat". (for goal 1) File "./output/Partac.v", line 5, characters 2-20: The command has indeed failed with message: The term "0" has type "nat" while it is expected to have type "bool". (for goal 2) coq-8.20.0/test-suite/output/Partac.v000066400000000000000000000001261466560755400174530ustar00rootroot00000000000000Goal nat * bool. Proof. split. Fail par: exact false. Fail par: exact 0. Abort. coq-8.20.0/test-suite/output/PatternsInBinders.out000066400000000000000000000025431466560755400222060ustar00rootroot00000000000000swap = fun '(x, y) => (y, x) : A * B -> B * A Arguments swap pat fun '(x, y) => (y, x) : A * B -> B * A forall '(x, y), swap (x, y) = (y, x) : Prop proj_informative = fun '(exist _ x _) => x : {x : A | P x} -> A Arguments proj_informative pat foo = fun '(Bar n b tt p) => if b then n + p else n - p : Foo -> nat Arguments foo pat baz = fun '(Bar n1 _ tt p1) '(Bar _ _ tt _) => n1 + p1 : Foo -> Foo -> nat Arguments baz pat pat swap = fun (A B : Type) '(x, y) => (y, x) : forall {A B : Type}, A * B -> B * A Arguments swap {A B}%type_scope pat fun (A B : Type) '(x, y) => swap (x, y) = (y, x) : forall A B : Type, A * B -> Prop forall (A B : Type) '(x, y), swap (x, y) = (y, x) : Prop exists '(x, y), swap (x, y) = (y, x) : Prop exists '(x, y) '(z, w), swap (x, y) = (z, w) : Prop λ '(x, y), (y, x) : A * B → B * A ∀ '(x, y), swap (x, y) = (y, x) : Prop both_z = fun pat : nat * nat => let '(n, p) as x := pat return (F x) in (Z n, Z p) : forall pat : nat * nat, F pat Arguments both_z pat fun '(x, y) '(z, t) => swap (x, y) = (z, t) : A * B -> B * A -> Prop forall '(x, y) '(z, t), swap (x, y) = (z, t) : Prop fun (pat : nat) '(x, y) => x + y = pat : nat -> nat * nat -> Prop f = fun x : nat => x + x : nat -> nat Arguments f x%nat_scope fun x : nat => x + x : nat -> nat coq-8.20.0/test-suite/output/PatternsInBinders.v000066400000000000000000000034031466560755400216400ustar00rootroot00000000000000Require Coq.Unicode.Utf8. (** The purpose of this file is to test printing of the destructive patterns used in binders ([fun] and [forall]). *) Parameters (A B : Type) (P:A->Prop). Definition swap '((x,y) : A*B) := (y,x). Print swap. Check fun '((x,y) : A*B) => (y,x). Check forall '(x,y), swap (x,y) = (y,x). Definition proj_informative '(exist _ x _ : { x:A | P x }) : A := x. Print proj_informative. Inductive Foo := Bar : nat -> bool -> unit -> nat -> Foo. Definition foo '(Bar n b tt p) := if b then n+p else n-p. Print foo. Definition baz '(Bar n1 b1 tt p1) '(Bar n2 b2 tt p2) := n1+p1. Print baz. Module WithParameters. Definition swap {A B} '((x,y) : A*B) := (y,x). Print swap. Check fun (A B:Type) '((x,y) : A*B) => swap (x,y) = (y,x). Check forall (A B:Type) '((x,y) : A*B), swap (x,y) = (y,x). Check exists '((x,y):A*A), swap (x,y) = (y,x). Check exists '((x,y):A*A) '(z,w), swap (x,y) = (z,w). End WithParameters. (** Some test involving unicode notations. *) Module WithUnicode. Import Coq.Unicode.Utf8. Check λ '((x,y) : A*B), (y,x). Check ∀ '(x,y), swap (x,y) = (y,x). End WithUnicode. (** * Suboptimal printing *) Module Suboptimal. (** This test shows an example which exposes the [let] introduced by the pattern notation in binders. *) Inductive Fin (n:nat) := Z : Fin n. Definition F '(n,p) : Type := (Fin n * Fin p)%type. Definition both_z '(n,p) : F (n,p) := (Z _,Z _). Print both_z. (** Test factorization of binders *) Check fun '((x,y) : A*B) '(z,t) => swap (x,y) = (z,t). Check forall '(x,y) '((z,t) : B*A), swap (x,y) = (z,t). End Suboptimal. (** Test risk of collision for internal name *) Check fun pat => fun '(x,y) => x+y = pat. (** Test name in degenerate case *) Definition f 'x := x+x. Print f. Check fun 'x => x+x. coq-8.20.0/test-suite/output/PosSyntax.out000066400000000000000000000050411466560755400205540ustar00rootroot0000000000000032%positive : positive eq_refl : 42%positive = 42%positive : 42%positive = 42%positive fun f : nat -> positive => (f 0%nat + 1)%positive : (nat -> positive) -> positive fun x : positive => (x~0)%positive : positive -> positive fun x : positive => (x + 1)%positive : positive -> positive fun x : positive => x : positive -> positive fun x : positive => (x~1)%positive : positive -> positive fun x : positive => (x~0 + 1)%positive : positive -> positive (Pos.of_nat 0 + 1)%positive : positive (1 + Pos.of_nat (0 + 0))%positive : positive Pos.of_nat 1 = 1%positive : Prop File "./output/PosSyntax.v", line 13, characters 11-12: The command has indeed failed with message: Cannot interpret this number as a value of type positive File "./output/PosSyntax.v", line 14, characters 11-14: The command has indeed failed with message: Cannot interpret this number as a value of type positive File "./output/PosSyntax.v", line 15, characters 11-15: The command has indeed failed with message: Cannot interpret this number as a value of type positive 1%positive : positive 2%positive : positive 255%positive : positive 255%positive : positive 1%positive : positive 2%positive : positive 255%positive : positive 255%positive : positive 0x2a : positive 0x1 : positive File "./output/PosSyntax.v", line 29, characters 11-14: The command has indeed failed with message: Cannot interpret this number as a value of type positive File "./output/PosSyntax.v", line 30, characters 11-15: The command has indeed failed with message: Cannot interpret this number as a value of type positive 0x1 : positive 0x2 : positive 0xff : positive 0xff : positive File "./output/PosSyntax.v", line 35, characters 11-14: The command has indeed failed with message: Cannot interpret this number as a value of type positive File "./output/PosSyntax.v", line 36, characters 11-15: The command has indeed failed with message: Cannot interpret this number as a value of type positive 0x1 : positive 0x2 : positive 0xff : positive 0xff : positive File "./output/PosSyntax.v", line 41, characters 11-14: The command has indeed failed with message: Cannot interpret this number as a value of type positive File "./output/PosSyntax.v", line 42, characters 11-15: The command has indeed failed with message: Cannot interpret this number as a value of type positive 0x1 : positive 0x2 : positive 0xff : positive 0xff : positive (1 + Pos.of_nat 11)%positive : positive coq-8.20.0/test-suite/output/PosSyntax.v000066400000000000000000000023411466560755400202120ustar00rootroot00000000000000Require Import PArith. Check 32%positive. Check (eq_refl : 0x2a%positive = 42%positive). Check (fun f : nat -> positive => (f 0%nat + 1)%positive). Check (fun x : positive => xO x). Check (fun x : positive => (x + 1)%positive). Check (fun x : positive => x). Check (fun x : positive => xI x). Check (fun x : positive => (xO x + 1)%positive). Check (Pos.of_nat 0 + 1)%positive. Check (1 + Pos.of_nat (0 + 0))%positive. Check (Pos.of_nat 1 = 1%positive). Fail Check 0%positive. Fail Check 0x0%positive. Fail Check 0x00%positive. Check 0x01%positive. Check 0x02%positive. Check 0xff%positive. Check 0xFF%positive. Check 0x01%xpositive. Check 0x02%xpositive. Check 0xff%xpositive. Check 0xFF%xpositive. (* Check hexadecimal printing *) Open Scope hex_positive_scope. Check 42%positive. Check 1%positive. Fail Check 0x0%positive. Fail Check 0x00%positive. Check 0x01%positive. Check 0x02%positive. Check 0xff%positive. Check 0xFF%positive. Fail Check 0x0. Fail Check 0x00. Check 0x01. Check 0x02. Check 0xff. Check 0xFF. Fail Check 0x0%xpositive. Fail Check 0x00%xpositive. Check 0x01%xpositive. Check 0x02%xpositive. Check 0xff%xpositive. Check 0xFF%xpositive. Close Scope hex_positive_scope. Require Import Arith. Check (1 + Pos.of_nat 11)%positive. coq-8.20.0/test-suite/output/PrimStringSyntax.out000066400000000000000000000002751466560755400221150ustar00rootroot00000000000000"hello"%pstring : string ""%pstring : string "a"%char63 : char63_wrapper "a" : char63 : char63 0%uint63 : int 0%uint63 : char63 : char63 "hello" : string coq-8.20.0/test-suite/output/PrimStringSyntax.v000066400000000000000000000003341466560755400215470ustar00rootroot00000000000000Require Import Uint63. Require Import PrimString. Check "hello"%pstring. Check ""%pstring. Check "a"%char63. Check ("a"%char63 : char63). Check 0%uint63. Check (0%uint63 : char63). Open Scope pstring. Check "hello". coq-8.20.0/test-suite/output/PrimitiveProjectionsAttribute.out000066400000000000000000000020741466560755400246630ustar00rootroot00000000000000Foo0 : Type Foo0 is not universe polymorphic Expands to: Inductive PrimitiveProjectionsAttribute.Foo0 Foo1 : Type Foo1 is not universe polymorphic Foo1 has primitive projections with eta conversion. Expands to: Inductive PrimitiveProjectionsAttribute.Foo1 Foo2 : Type Foo2 is not universe polymorphic Foo2 has primitive projections with eta conversion. Expands to: Inductive PrimitiveProjectionsAttribute.Foo2 Foo3 : Type Foo3 is not universe polymorphic Expands to: Inductive PrimitiveProjectionsAttribute.Foo3 Foo4 : Type Foo4 is not universe polymorphic Foo4 has primitive projections with eta conversion. Expands to: Inductive PrimitiveProjectionsAttribute.Foo4 Foo5 : Type Foo5 is not universe polymorphic Foo5 has primitive projections with eta conversion. Expands to: Inductive PrimitiveProjectionsAttribute.Foo5 Foo6 : Type Foo6 is not universe polymorphic Foo6 has primitive projections with eta conversion. Expands to: Inductive PrimitiveProjectionsAttribute.Foo6 Foo7 : Type Foo7 is not universe polymorphic Expands to: Inductive PrimitiveProjectionsAttribute.Foo7 coq-8.20.0/test-suite/output/PrimitiveProjectionsAttribute.v000066400000000000000000000011631466560755400243170ustar00rootroot00000000000000Unset Primitive Projections. Record Foo0 := { bar0 : Type ; }. About Foo0. #[projections(primitive)] Record Foo1 := { bar1 : Type ; }. About Foo1. #[projections(primitive=yes)] Record Foo2 := { bar2 : Type ; }. About Foo2. #[projections(primitive=no)] Record Foo3 := { bar3 : Type ; }. About Foo3. Set Primitive Projections. Record Foo4 := { bar4 : Type ; }. About Foo4. #[projections(primitive)] Record Foo5 := { bar5 : Type ; }. About Foo5. #[projections(primitive=yes)] Record Foo6 := { bar6 : Type ; }. About Foo6. #[projections(primitive=no)] Record Foo7 := { bar7 : Type ; }. About Foo7. coq-8.20.0/test-suite/output/PrimitiveProjectionsAttribute_Records.out000066400000000000000000000010111466560755400263320ustar00rootroot00000000000000B : Set B is not universe polymorphic B has primitive projections with eta conversion. Expands to: Inductive PrimitiveProjectionsAttribute_Records.B C : Set C is not universe polymorphic C has primitive projections with eta conversion. Expands to: Inductive PrimitiveProjectionsAttribute_Records.C G : Prop G is not universe polymorphic G is in Prop but its eliminators are declared dependent by default G has primitive projections without eta conversion. Expands to: Inductive PrimitiveProjectionsAttribute_Records.G coq-8.20.0/test-suite/output/PrimitiveProjectionsAttribute_Records.v000066400000000000000000000006061466560755400260010ustar00rootroot00000000000000Unset Primitive Projections. (* Classes *do* support primitive projections. *) #[projections(primitive)] Class B := { b : nat ; }. About B. (* Structures *do* support primitive projections. *) #[projections(primitive)] Structure C := { c : nat ; }. About C. (* (negative) CoInductives *do* support primitive projections. *) #[projections(primitive)] CoInductive G := { g : G }. About G. coq-8.20.0/test-suite/output/PrintAssumptions.out000066400000000000000000000013201466560755400221420ustar00rootroot00000000000000Axioms: foo : nat Axioms: foo : nat Axioms: bli : Type Axioms: bli : Type Axioms: seq relies on definitional UIP. Axioms: extensionality : forall (P Q : Type) (f g : P -> Q), (forall x : P, f x = g x) -> f = g Axioms: extensionality : forall (P Q : Type) (f g : P -> Q), (forall x : P, f x = g x) -> f = g Axioms: extensionality : forall (P Q : Type) (f g : P -> Q), (forall x : P, f x = g x) -> f = g Axioms: extensionality : forall (P Q : Type) (f g : P -> Q), (forall x : P, f x = g x) -> f = g Closed under the global context Closed under the global context Axioms: M.foo : False Closed under the global context Closed under the global context Closed under the global context Closed under the global context coq-8.20.0/test-suite/output/PrintAssumptions.v000066400000000000000000000106011466560755400216020ustar00rootroot00000000000000 (** Print Assumption and opaque modules : Print Assumption used to consider as axioms the modular fields unexported by their signature, cf bug report #2186. This should now be fixed, let's test this here. *) (* First, a minimal test-case *) Axiom foo : nat. Module Type T. Parameter bar : nat. End T. Module M : T. Module Hide. (* An entire sub-module could be hidden *) Definition x := foo. End Hide. Definition bar := Hide.x. End M. Module N (X:T) : T. Definition y := X.bar. (* A non-exported field *) Definition bar := y. End N. Module P := N M. Print Assumptions M.bar. (* Should answer: foo *) Print Assumptions P.bar. (* Should answer: foo *) (* Print Assumptions used empty instances on polymorphic inductives *) Module Poly. Set Universe Polymorphism. Axiom bli : Type. Definition bla := bli -> bli. Inductive blo : bli -> Type := . Print Assumptions bla. Print Assumptions blo. End Poly. Module UIP. Set Definitional UIP. Inductive seq {A} (a:A) : A -> SProp := srefl : seq a a. Arguments srefl {_ _}. Definition eq_to_seq {A x y} (e:x = y :> A) : seq x y := match e with eq_refl => srefl end. Definition seq_to_eq {A x y} (e:seq x y) : x = y :> A := match e with srefl => eq_refl end. Definition norm {A x y} (e:x = y :> A) : x = y := seq_to_eq (eq_to_seq e). Definition norm_id {A x y} (e:x = y :> A) : norm e = e := match e with eq_refl => eq_refl end. Theorem UIP {A x y} (e e':x = y :> A) : e = e'. Proof. rewrite <-(norm_id e), <-(norm_id e'). reflexivity. Defined. Print Assumptions UIP. End UIP. (* The original test-case of the bug-report *) Require Import Arith. Axiom extensionality : forall P Q (f g:P -> Q), (forall x, f x = g x) -> f = g. Module Type ADD_COMM_EXT. Axiom add_comm_ext : forall n, (fun x => x + n) = (fun x => n + x). End ADD_COMM_EXT. Module AddCommExt_Opaque : ADD_COMM_EXT. Lemma add_comm_ext : forall n, (fun x => x + n) = (fun x => n + x). Proof. intro n; apply extensionality; auto with arith. Qed. End AddCommExt_Opaque. Module AddCommExt_Transparent <: ADD_COMM_EXT. Lemma add_comm_ext : forall n, (fun x => x + n) = (fun x => n + x). Proof. intro n; apply extensionality; auto with arith. Qed. End AddCommExt_Transparent. Print Assumptions AddCommExt_Opaque.add_comm_ext. (* Should answer: extensionality *) Print Assumptions AddCommExt_Transparent.add_comm_ext. (* Should answer: extensionality *) Lemma add1_comm_ext_opaque : (fun x => x + 1) = (fun x => 1 + x). Proof (AddCommExt_Opaque.add_comm_ext 1). Lemma add1_comm_ext_transparent : (fun x => x + 1) = (fun x => 1 + x). Proof (AddCommExt_Transparent.add_comm_ext 1). Print Assumptions add1_comm_ext_opaque. (* Should answer: extensionality *) Print Assumptions add1_comm_ext_transparent. (* Should answer: extensionality *) Module Type FALSE_POSITIVE. Axiom add_comm : forall n x, x + n = n + x. End FALSE_POSITIVE. Module false_positive : FALSE_POSITIVE. Lemma add_comm : forall n x, x + n = n + x. Proof. auto with arith. Qed. Print Assumptions add_comm. (* Should answer : Closed under the global context *) End false_positive. Lemma comm_plus5 : forall x, x + 5 = 5 + x. Proof (false_positive.add_comm 5). Print Assumptions comm_plus5. (* Should answer : Closed under the global context *) (** Print Assumption and Include *) Module INCLUDE. Module M. Axiom foo : False. End M. Module N. Include M. End N. Print Assumptions N.foo. End INCLUDE. (* Print Assumptions did not enter implementation of submodules (#7192) *) Module SUBMODULES. Definition a := True. Module Type B. Axiom f : Prop. End B. Module Type C. Declare Module D : B. End C. Module E: C. Module D <: B. Definition f := a. End D. End E. Print Assumptions E.D.f. (* Idem in the scope of a functor *) Module Type T. End T. Module F (X : T). Definition a := True. Module Type B. Axiom f : Prop. End B. Module Type C. Declare Module D : B. End C. Module E: C. Module D <: B. Definition f := a. End D. End E. Print Assumptions E.D.f. End F. End SUBMODULES. (* Testing a variant of #7192 across files *) (* This was missing in the original fix to #7192 *) Require Import module_bug7192. Print Assumptions M7192.D.f. (* Testing reporting assumptions from modules in files *) (* A regression introduced in the original fix to #7192 was missing implementations *) Require Import module_bug8416. Print Assumptions M8416.f. coq-8.20.0/test-suite/output/PrintCanonicalProjections.out000066400000000000000000000010601466560755400237250ustar00rootroot00000000000000bool <- sort_eq ( bool_eqType ) bool <- sort_TYPE ( bool_TYPE ) nat <- sort_eq ( nat_eqType ) nat <- sort_TYPE ( nat_TYPE ) prod <- sort_eq ( prod_eqType ) prod <- sort_TYPE ( prod_TYPE ) sum <- sort_eq ( sum_eqType ) sum <- sort_TYPE ( sum_TYPE ) sum <- sort_TYPE ( sum_TYPE ) prod <- sort_TYPE ( prod_TYPE ) nat <- sort_TYPE ( nat_TYPE ) bool <- sort_TYPE ( bool_TYPE ) sum <- sort_eq ( sum_eqType ) prod <- sort_eq ( prod_eqType ) nat <- sort_eq ( nat_eqType ) bool <- sort_eq ( bool_eqType ) bool <- sort_TYPE ( bool_TYPE ) bool <- sort_eq ( bool_eqType ) coq-8.20.0/test-suite/output/PrintCanonicalProjections.v000066400000000000000000000025231466560755400233700ustar00rootroot00000000000000Record TYPE := Pack_TYPE { sort_TYPE :> Type }. Record eqType := Pack_eq { sort_eq :> Type; _ : sort_eq -> sort_eq -> bool }. Definition eq_op (T : eqType) : T -> T -> bool := match T with Pack_eq _ op => op end. Definition bool_eqb b1 b2 := match b1, b2 with | false, false => true | true, true => true | _, _ => false end. Canonical bool_TYPE := Pack_TYPE bool. Canonical bool_eqType := Pack_eq bool bool_eqb. Canonical nat_TYPE := Pack_TYPE nat. Canonical nat_eqType := Pack_eq nat Nat.eqb. Definition prod_eqb (T U : eqType) (x y : T * U) := match x, y with | (x1, x2), (y1, y2) => andb (eq_op _ x1 y1) (eq_op _ x2 y2) end. Canonical prod_TYPE (T U : TYPE) := Pack_TYPE (T * U). Canonical prod_eqType (T U : eqType) := Pack_eq (T * U) (prod_eqb T U). Definition sum_eqb (T U : eqType) (x y : T + U) := match x, y with | inl x, inl y => eq_op _ x y | inr x, inr y => eq_op _ x y | _, _ => false end. Canonical sum_TYPE (T U : TYPE) := Pack_TYPE (T + U). Canonical sum_eqType (T U : eqType) := Pack_eq (T + U) (sum_eqb T U). Print Canonical Projections bool. Print Canonical Projections nat. Print Canonical Projections prod. Print Canonical Projections sum. Print Canonical Projections sort_TYPE. Print Canonical Projections sort_eq. Print Canonical Projections sort_TYPE bool. Print Canonical Projections bool_eqType. coq-8.20.0/test-suite/output/PrintGenarg.out000066400000000000000000000003621466560755400210250ustar00rootroot00000000000000Ltac foo := let x := open_constr:(ltac:(exact 0)) in idtac x Ltac2 bar : unit -> unit bar := fun _ => let _ := open_constr:(ltac2:(let c := preterm:(0) in exact1 false c)) in () coq-8.20.0/test-suite/output/PrintGenarg.v000066400000000000000000000002721466560755400204630ustar00rootroot00000000000000Ltac foo := let x := open_constr:(ltac:(exact 0)) in idtac x. Print foo. Require Import Ltac2.Ltac2. Ltac2 bar () := let _ := open_constr:(ltac2:(exact 0)) in (). Print bar. coq-8.20.0/test-suite/output/PrintGrammar.out000066400000000000000000000120721466560755400212110ustar00rootroot00000000000000Entry binder_constr is [ LEFTA [ "exists2"; "'"; pattern LEVEL "0"; ":"; term LEVEL "200"; ","; term LEVEL "200"; "&"; term LEVEL "200" | "exists2"; "'"; pattern LEVEL "0"; ","; term LEVEL "200"; "&"; term LEVEL "200" | "exists2"; name; ":"; term LEVEL "200"; ","; term LEVEL "200"; "&"; term LEVEL "200" | "exists2"; name; ","; term LEVEL "200"; "&"; term LEVEL "200" | "exists"; "!"; open_binders; ","; term LEVEL "200" | "exists"; open_binders; ","; term LEVEL "200" | "forall"; open_binders; ","; term LEVEL "200" | "fun"; open_binders; "=>"; term LEVEL "200" | "let"; "fix"; fix_decl; "in"; term LEVEL "200" | "let"; "cofix"; cofix_body; "in"; term LEVEL "200" | "let"; "'"; pattern LEVEL "200"; ":="; term LEVEL "200"; "in"; term LEVEL "200" | "let"; "'"; pattern LEVEL "200"; ":="; term LEVEL "200"; case_type; "in"; term LEVEL "200" | "let"; "'"; pattern LEVEL "200"; "in"; pattern LEVEL "200"; ":="; term LEVEL "200"; case_type; "in"; term LEVEL "200" | "let"; name; binders; let_type_cstr; ":="; term LEVEL "200"; "in"; term LEVEL "200" | "let"; [ "("; LIST0 name SEP ","; ")" | "()" ]; as_return_type; ":="; term LEVEL "200"; "in"; term LEVEL "200" | "if"; term LEVEL "200"; as_return_type; "then"; term LEVEL "200"; "else"; term LEVEL "200" | "fix"; fix_decls | "cofix"; cofix_decls ] ] Entry constr is [ LEFTA [ "@"; global; univ_annot | term LEVEL "8" ] ] Entry lconstr is [ LEFTA [ term LEVEL "200" ] ] Entry term is [ "200" RIGHTA [ ] | "100" RIGHTA [ SELF; "<:"; term LEVEL "200" | SELF; "<<:"; term LEVEL "200" | SELF; ":>"; term LEVEL "200" | SELF; ":"; term LEVEL "200" ] | "99" RIGHTA [ SELF; "->"; term LEVEL "200" ] | "95" RIGHTA [ SELF; "<->"; NEXT ] | "90" RIGHTA [ ] | "85" RIGHTA [ SELF; "\\/"; term LEVEL "85" ] | "80" RIGHTA [ SELF; "/\\"; term LEVEL "80" ] | "75" RIGHTA [ "~"; term LEVEL "75" ] | "70" RIGHTA [ SELF; ">"; NEXT | SELF; ">="; NEXT | SELF; "<"; NEXT; "<="; NEXT | SELF; "<"; NEXT; "<"; NEXT | SELF; "<"; NEXT | SELF; "<="; NEXT; "<"; NEXT | SELF; "<="; NEXT; "<="; NEXT | SELF; "<="; NEXT | SELF; "<>"; NEXT; ":>"; NEXT | SELF; "<>"; NEXT | SELF; "="; NEXT; "="; NEXT | SELF; "="; NEXT; ":>"; NEXT | SELF; "="; NEXT ] | "60" RIGHTA [ SELF; "++"; term LEVEL "60" | SELF; "::"; term LEVEL "60" ] | "50" LEFTA [ SELF; "||"; NEXT | SELF; "-"; NEXT | SELF; "+"; NEXT ] | "40" LEFTA [ SELF; "&&"; NEXT | SELF; "/"; NEXT | SELF; "*"; NEXT ] | "35" RIGHTA [ "/"; term LEVEL "35" | "-"; term LEVEL "35" ] | "30" RIGHTA [ SELF; "^"; term LEVEL "30" ] | "10" LEFTA [ SELF; LIST1 arg | "@"; global; univ_annot; LIST0 NEXT | "@"; pattern_ident; LIST1 identref | binder_constr ] | "9" LEFTA [ ".."; term LEVEL "0"; ".." ] | "8" LEFTA [ ] | "1" LEFTA [ SELF; ".2" | SELF; ".1" | SELF; ".("; "@"; global; univ_annot; LIST0 (term LEVEL "9"); ")" | SELF; ".("; global; univ_annot; LIST0 arg; ")" | SELF; "%"; IDENT | SELF; "%_"; IDENT ] | "0" LEFTA [ "{"; "'"; pattern LEVEL "0"; "&"; term LEVEL "200"; "&"; term LEVEL "200"; "}" | "{"; "'"; pattern LEVEL "0"; "&"; term LEVEL "200"; "}" | "{"; "'"; pattern LEVEL "0"; ":"; term LEVEL "200"; "&"; term LEVEL "200"; "&"; term LEVEL "200"; "}" | "{"; "'"; pattern LEVEL "0"; ":"; term LEVEL "200"; "&"; term LEVEL "200"; "}" | "{"; "'"; pattern LEVEL "0"; ":"; term LEVEL "200"; "|"; term LEVEL "200"; "&"; term LEVEL "200"; "}" | "{"; "'"; pattern LEVEL "0"; ":"; term LEVEL "200"; "|"; term LEVEL "200"; "}" | "{"; "'"; pattern LEVEL "0"; "|"; term LEVEL "200"; "&"; term LEVEL "200"; "}" | "{"; "'"; pattern LEVEL "0"; "|"; term LEVEL "200"; "}" | "{"; term LEVEL "99"; "&"; term LEVEL "200"; "&"; term LEVEL "200"; "}" | "{"; term LEVEL "99"; "&"; term LEVEL "200"; "}" | "{"; term LEVEL "99"; ":"; term LEVEL "200"; "&"; term LEVEL "200"; "&"; term LEVEL "200"; "}" | "{"; term LEVEL "99"; ":"; term LEVEL "200"; "&"; term LEVEL "200"; "}" | "{"; term LEVEL "99"; ":"; term LEVEL "200"; "|"; term LEVEL "200"; "&"; term LEVEL "200"; "}" | "{"; term LEVEL "99"; ":"; term LEVEL "200"; "|"; term LEVEL "200"; "}" | "{"; term LEVEL "99"; "|"; term LEVEL "200"; "&"; term LEVEL "200"; "}" | "{"; term LEVEL "99"; "|"; term LEVEL "200"; "}" | "{"; term LEVEL "99"; "}" | IDENT "ltac"; ":"; "("; ltac_expr; ")" | "("; term LEVEL "200"; ","; term LEVEL "200"; ","; LIST1 (term LEVEL "200") SEP ","; ")" | "("; term LEVEL "200"; ","; term LEVEL "200"; ")" | "("; term LEVEL "200"; ")" | "{|"; record_declaration; '|}' | "`{"; term LEVEL "200"; "}" | "`("; term LEVEL "200"; ")" | NUMBER | atomic_constr | term_match | ident; fields; univ_annot | ident; univ_annot | string | test_array_opening; "["; "|"; array_elems; "|"; lconstr; type_cstr; test_array_closing; "|"; "]"; univ_annot ] ] Entry univ_annot is [ LEFTA [ "@{"; LIST0 univ_level_or_quality; OPT [ "|"; LIST0 univ_level_or_quality ]; "}" | ] ] Entry fix_decls is [ LEFTA [ fix_decl; "with"; LIST1 fix_decl SEP "with"; "for"; identref | fix_decl ] ] coq-8.20.0/test-suite/output/PrintGrammar.v000066400000000000000000000000741466560755400206460ustar00rootroot00000000000000 Print Grammar constr univ_annot. Print Grammar fix_decls. coq-8.20.0/test-suite/output/PrintGrammarConstr.out000066400000000000000000000042011466560755400223750ustar00rootroot00000000000000Entry binder_constr is [ LEFTA [ "forall"; open_binders; ","; term LEVEL "200" | "fun"; open_binders; "=>"; term LEVEL "200" | "let"; "fix"; fix_decl; "in"; term LEVEL "200" | "let"; "cofix"; cofix_body; "in"; term LEVEL "200" | "let"; "'"; pattern LEVEL "200"; ":="; term LEVEL "200"; "in"; term LEVEL "200" | "let"; "'"; pattern LEVEL "200"; ":="; term LEVEL "200"; case_type; "in"; term LEVEL "200" | "let"; "'"; pattern LEVEL "200"; "in"; pattern LEVEL "200"; ":="; term LEVEL "200"; case_type; "in"; term LEVEL "200" | "let"; name; binders; let_type_cstr; ":="; term LEVEL "200"; "in"; term LEVEL "200" | "let"; [ "("; LIST0 name SEP ","; ")" | "()" ]; as_return_type; ":="; term LEVEL "200"; "in"; term LEVEL "200" | "if"; term LEVEL "200"; as_return_type; "then"; term LEVEL "200"; "else"; term LEVEL "200" | "fix"; fix_decls | "cofix"; cofix_decls ] ] Entry constr is [ LEFTA [ "@"; global; univ_annot | term LEVEL "8" ] ] Entry lconstr is [ LEFTA [ term LEVEL "200" ] ] Entry term is [ "200" RIGHTA [ ] | "100" RIGHTA [ SELF; "<:"; term LEVEL "200" | SELF; "<<:"; term LEVEL "200" | SELF; ":>"; term LEVEL "200" | SELF; ":"; term LEVEL "200" ] | "99" RIGHTA [ ] | "90" RIGHTA [ ] | "10" LEFTA [ SELF; LIST1 arg | "@"; global; univ_annot; LIST0 NEXT | "@"; pattern_ident; LIST1 identref | binder_constr ] | "9" LEFTA [ ".."; term LEVEL "0"; ".." ] | "8" LEFTA [ ] | "1" LEFTA [ SELF; ".("; "@"; global; univ_annot; LIST0 (term LEVEL "9"); ")" | SELF; ".("; global; univ_annot; LIST0 arg; ")" | SELF; "%"; IDENT | SELF; "%_"; IDENT ] | "0" LEFTA [ "["; term LEVEL "10"; "+"; "+"; "*"; LIST1 (term LEVEL "10") SEP ["+"; "+"; "*"]; "|"; term LEVEL "200"; "]" | "["; term LEVEL "10"; "|"; term LEVEL "200"; "]" | "("; term LEVEL "200"; ")" | "{|"; record_declaration; '|}' | "`{"; term LEVEL "200"; "}" | "`("; term LEVEL "200"; ")" | NUMBER | atomic_constr | term_match | ident; fields; univ_annot | ident; univ_annot | string | test_array_opening; "["; "|"; array_elems; "|"; lconstr; type_cstr; test_array_closing; "|"; "]"; univ_annot ] ] coq-8.20.0/test-suite/output/PrintGrammarConstr.v000066400000000000000000000002301466560755400220310ustar00rootroot00000000000000(* coq-prog-args: ("-nois") *) Notation "[ a + + * .. + + * c | d ]" := (forall _ : a, .. (forall _ : c, d) ..) (a at level 10). Print Grammar constr. coq-8.20.0/test-suite/output/PrintInfos.out000066400000000000000000000077151466560755400207110ustar00rootroot00000000000000existT : forall [A : Type] (P : A -> Type) (x : A), P x -> {x : A & P x} existT is template universe polymorphic Arguments existT [A]%type_scope P%function_scope x _ Expands to: Constructor Coq.Init.Specif.existT Inductive sigT (A : Type) (P : A -> Type) : Type := existT : forall x : A, P x -> {x : A & P x}. Arguments sigT [A]%type_scope P%type_scope Arguments existT [A]%type_scope P%function_scope x _ existT : forall [A : Type] (P : A -> Type) (x : A), P x -> {x : A & P x} Argument A is implicit Inductive eq (A : Type) (x : A) : A -> Prop := eq_refl : x = x. Arguments eq {A}%type_scope x _ Arguments eq_refl {A}%type_scope {x}, [_] _ eq_refl : forall {A : Type} {x : A}, x = x eq_refl is not universe polymorphic Arguments eq_refl {A}%type_scope {x}, [_] _ Expands to: Constructor Coq.Init.Logic.eq_refl eq_refl : forall {A : Type} {x : A}, x = x When applied to no arguments: Arguments A, x are implicit and maximally inserted When applied to 1 argument: Argument A is implicit Nat.add = fix add (n m : nat) {struct n} : nat := match n with | 0 => m | S p => S (add p m) end : nat -> nat -> nat Arguments Nat.add (n m)%nat_scope Nat.add : nat -> nat -> nat Nat.add is not universe polymorphic Arguments Nat.add (n m)%nat_scope Nat.add is transparent Expands to: Constant Coq.Init.Nat.add Nat.add : nat -> nat -> nat plus_n_O : forall n : nat, n = n + 0 plus_n_O is not universe polymorphic Arguments plus_n_O n%nat_scope plus_n_O is opaque Expands to: Constant Coq.Init.Peano.plus_n_O Inductive le (n : nat) : nat -> Prop := le_n : n <= n | le_S : forall m : nat, n <= m -> n <= S m. Arguments le (n _)%nat_scope Arguments le_n n%nat_scope Arguments le_S {n}%nat_scope [m]%nat_scope _ comparison : Set comparison is not universe polymorphic Expands to: Inductive Coq.Init.Datatypes.comparison Inductive comparison : Set := Eq : comparison | Lt : comparison | Gt : comparison. bar : foo bar is not universe polymorphic Expanded type for implicit arguments bar : forall {x : nat}, x = 0 Arguments bar {x} Expands to: Constant PrintInfos.bar *** [ bar : foo ] Expanded type for implicit arguments bar : forall {x : nat}, x = 0 Arguments bar {x} Module Coq.Init.Peano Notation sym_eq := eq_sym Expands to: Notation Coq.Init.Logic.sym_eq eq_sym : forall [A : Type] [x y : A], x = y -> y = x eq_sym is not universe polymorphic Arguments eq_sym [A]%type_scope [x y] _ eq_sym is transparent Expands to: Constant Coq.Init.Logic.eq_sym Inductive eq (A : Type) (x : A) : A -> Prop := eq_refl : x = x. Arguments eq {A}%type_scope x _ Arguments eq_refl {A}%type_scope {x}, {_} _ n:nat Hypothesis of the goal context. h:(n <> newdef n) Hypothesis of the goal context. g:(nat -> nat) Constant (let in) of the goal context. h:(n <> newdef n) Hypothesis of the goal context. Alias.eq : forall {A : Type}, A -> A -> Prop Alias.eq is not universe polymorphic Arguments Alias.eq {A}%type_scope x _ Expands to: Inductive PrintInfos.Alias.eq (syntactically equal to Coq.Init.Logic.eq) Alias.eq_refl : forall {A : Type} {x : A}, x = x Alias.eq_refl is not universe polymorphic Arguments Alias.eq_refl {A}%type_scope {x}, [_] _ Expands to: Constructor PrintInfos.Alias.eq_refl (syntactically equal to Coq.Init.Logic.eq_refl) Alias.eq_ind : forall [A : Type] (x : A) (P : A -> Prop), P x -> forall y : A, x = y -> P y Alias.eq_ind is not universe polymorphic Arguments Alias.eq_ind [A]%type_scope x P%function_scope f y e (where some original arguments have been renamed) Alias.eq_ind is transparent Expands to: Constant PrintInfos.Alias.eq_ind (syntactically equal to Coq.Init.Logic.eq_ind) fst : forall A B : Type, prod A B -> A fst is not universe polymorphic fst is a projection of prod Arguments fst (A B)%type_scope p fst is transparent Expands to: Constant PrintInfos.AboutProj.fst fst : forall A B : Type, prod A B -> A fst is not universe polymorphic fst is a primitive projection of prod Arguments fst (A B)%type_scope p fst is transparent Expands to: Constant PrintInfos.AboutPrimProj.fst coq-8.20.0/test-suite/output/PrintInfos.v000066400000000000000000000023671466560755400203450ustar00rootroot00000000000000(* coq-prog-args: ("-top" "PrintInfos") *) About existT. Print existT. Print Implicit existT. Print eq_refl. About eq_refl. Print Implicit eq_refl. Print Nat.add. About Nat.add. Print Implicit Nat.add. About plus_n_O. Arguments le_S {n} [m] _. Print le_S. About comparison. Print comparison. Definition foo := forall x, x = 0. Parameter bar : foo. Arguments bar {x}. About bar. Print bar. About Peano. (* Module *) About sym_eq. (* Notation *) Arguments eq_refl {A} {x}, {A} x. Print eq_refl. Definition newdef := fun x:nat => x. Goal forall n:nat, n <> newdef n -> newdef n <> n -> False. intros n h h'. About n. (* search hypothesis *) About h. (* search hypothesis *) Abort. Goal forall n:nat, let g := newdef in n <> newdef n -> newdef n <> n -> False. intros n g h h'. About g. (* search hypothesis *) About h. (* search hypothesis *) Abort. Module Alias := Logic. About Alias.eq. About Alias.eq_refl. About Alias.eq_ind. Module AboutProj. Record prod A B := { fst:A ; snd:B }. About fst. End AboutProj. Module AboutPrimProj. Set Primitive Projections. Record prod A B := { fst:A ; snd:B }. About fst. End AboutPrimProj. coq-8.20.0/test-suite/output/PrintKeywords.out000066400000000000000000000005601466560755400214310ustar00rootroot00000000000000! # #[ % %_ & && ' ( () ) * ** + ++ , - -> . .( .. ... .1 .2 / /\ : :: ::= ::> := :> ; < <+ <- <-> <: <<: <= <> = => > >-> >= ? @ @{ Axiom CoFixpoint Definition Fixpoint Hypothesis Parameter Prop SProp Set Theorem Type Variable [ \/ ] ^ _ `( `[ `{ as at by cofix else end exists exists2 fix for forall fun if in let match return then using where with { {| | |- || } ~ coq-8.20.0/test-suite/output/PrintKeywords.v000066400000000000000000000000201466560755400210560ustar00rootroot00000000000000Print Keywords. coq-8.20.0/test-suite/output/PrintMatch.out000066400000000000000000000030761466560755400206630ustar00rootroot00000000000000eqT_rect@{u u0} = fun (A : Type@{u}) (a : A) (P : forall a0 : A, eqT@{u} a a0 -> Type@{u0}) (f : P a (reflT@{u} a)) (a0 : A) (e : eqT@{u} a a0) => match e :> eqT@{u} a _ as e0 in (eqT _ a1) return (P a1 e0) with | reflT _ => f end : forall (A : Type@{u}) (a : A) (P : forall a0 : A, eqT@{u} a a0 -> Type@{u0}), P a (reflT@{u} a) -> forall (a0 : A) (e : eqT@{u} a a0), P a0 e (* u u0 |= *) Arguments eqT_rect A%type_scope a P%function_scope f a0 e seq_rect = fun (A : Type@{seq.u0}) (a : A) (P : forall a0 : A, seq a a0 -> Type@{PrintMatch.10}) (f : P a (srefl a)) (a0 : A) (s : seq a a0) => match s :> seq a a0 as s0 in (seq _ a1) return (P a1 s0) with | srefl _ => f end : forall (A : Type@{seq.u0}) (a : A) (P : forall a0 : A, seq a a0 -> Type@{PrintMatch.10}), P a (srefl a) -> forall (a0 : A) (s : seq a a0), P a0 s Arguments seq_rect A%type_scope a P%function_scope f a0 s eq_sym = fun (A : Type) (x y : A) (H : @eq A x y) => match H in (@eq _ _ a) return (@eq A a x) with | @eq_refl _ _ => @eq_refl A x end : forall [A : Type] [x y : A] (_ : @eq A x y), @eq A y x Arguments eq_sym [A]%type_scope [x y] _ eq_sym = fun (A : Type) (x y : A) (H : x = y) => match H in (_ = a) return (a = x) with | @eq_refl _ _ => @eq_refl A x end : forall [A : Type] [x y : A], x = y -> y = x Arguments eq_sym [A]%type_scope [x y] _ eq_sym = fun (A : Type) (x y : A) (H : x = y) => match H in (_ = a) return (a = x) with | @eq_refl _ _ => @eq_refl A x end : forall [A : Type] [x y : A], x = y -> y = x Arguments eq_sym [A]%type_scope [x y] _ coq-8.20.0/test-suite/output/PrintMatch.v000066400000000000000000000010631466560755400203130ustar00rootroot00000000000000(* NB feel free to add other tests about printing match, not just about Match All Subterms *) Module MatchAllSubterms. Set Printing Match All Subterms. Set Printing Universes. Polymorphic Inductive eqT@{u} {A:Type@{u}} (a:A) : A -> Type@{u} := reflT : eqT a a. Print eqT_rect. Set Definitional UIP. Inductive seq {A} (a:A) : A -> SProp := srefl : seq a a. Print seq_rect. End MatchAllSubterms. Module Bug18163. Set Printing All. Print eq_sym. Unset Printing All. Set Printing Implicit. Print eq_sym. Set Asymmetric Patterns. Print eq_sym. End Bug18163. coq-8.20.0/test-suite/output/PrintModule.out000066400000000000000000000005371466560755400210530ustar00rootroot00000000000000Module N : S with Definition T := nat := M Module N : S with Definition T := M Module N : S with Module T := K := M Module N : S with Module T := M Module Type Func = Funsig (T0:Test) Sig Parameter x : T0.t. End Module A := Struct Variant I : Set := C : nat -> I. Record R : Set := Build_R { n : nat }. Definition n : R -> nat. End coq-8.20.0/test-suite/output/PrintModule.v000066400000000000000000000015021466560755400205020ustar00rootroot00000000000000(* Bug #2169 *) Module FOO. Module M. Definition T := nat. End M. Module Type S. Parameter T : Set. End S. Module N : S with Definition T := nat := M. Print Module N. Set Short Module Printing. Print Module N. Unset Short Module Printing. End FOO. Module BAR. Module K. End K. Module Type KS. End KS. Module M. Module T := K. End M. Module Type S. Declare Module T : KS. End S. Module N : S with Module T := K := M. Print Module N. Set Short Module Printing. Print Module N. Unset Short Module Printing. End BAR. (* Bug #4661 *) Module QUX. Module Type Test. Parameter t : Type. End Test. Module Type Func (T:Test). Parameter x : T.t. End Func. Module Shortest_path (T : Test). Print Func. End Shortest_path. End QUX. Module A. Variant I := C : nat -> I. Record R := { n : nat }. End A. Print Module A. coq-8.20.0/test-suite/output/PrintNotation.out000066400000000000000000000374211466560755400214230ustar00rootroot00000000000000Notation "_ $ _" at level 123 with arguments constr at next level, constr at next level, no associativity. bar (bar ?f ?f0) ?f1 : foo where ?f : [ |- foo] ?f0 : [ |- foo] ?f1 : [ |- foo] Notation "_ $ _" at level 123 with arguments constr at next level, constr at next level, no associativity. bar (bar ?f ?f0) ?f1 : foo where ?f : [ |- foo] ?f0 : [ |- foo] ?f1 : [ |- foo] Notation "_ $ _" at level 123 with arguments constr at level 123, constr at next level, left associativity. bar (bar ?f ?f0) ?f1 : foo where ?f : [ |- foo] ?f0 : [ |- foo] ?f1 : [ |- foo] Notation "_ $ _" at level 123 with arguments constr at next level, constr at level 123, right associativity. bar ?f (bar ?f0 ?f1) : foo where ?f : [ |- foo] ?f0 : [ |- foo] ?f1 : [ |- foo] File "./output/PrintNotation.v", line 36, characters 2-30: The command has indeed failed with message: "_ $ x" cannot be interpreted as a known notation. Make sure that symbols are surrounded by spaces and that holes are explicitly denoted by "_". File "./output/PrintNotation.v", line 37, characters 2-28: The command has indeed failed with message: "_ $" cannot be interpreted as a known notation. Make sure that symbols are surrounded by spaces and that holes are explicitly denoted by "_". File "./output/PrintNotation.v", line 38, characters 2-28: The command has indeed failed with message: "$ x" cannot be interpreted as a known notation. Make sure that symbols are surrounded by spaces and that holes are explicitly denoted by "_". File "./output/PrintNotation.v", line 39, characters 2-28: The command has indeed failed with message: "x$y" cannot be interpreted as a known notation. Make sure that symbols are surrounded by spaces and that holes are explicitly denoted by "_". File "./output/PrintNotation.v", line 40, characters 2-28: The command has indeed failed with message: "_$_" cannot be interpreted as a known notation. Make sure that symbols are surrounded by spaces and that holes are explicitly denoted by "_". Notation "_ $ _" at level 123 with arguments constr at next level, constr at level 123, right associativity. Notation "_ $ _" at level 123 with arguments constr at next level, constr at level 123, right associativity. Notation "_ -> _" at level 99 with arguments constr at next level, constr at level 200, no associativity. Notation "_ <-> _" at level 95 with arguments constr at next level, constr at next level, no associativity. Notation "_ /\ _" at level 80 with arguments constr at next level, constr at level 80, right associativity. Notation "_ \/ _" at level 85 with arguments constr at next level, constr at level 85, right associativity. Notation "~ _" at level 75 with arguments constr at level 75, right associativity. Notation "_ = _ :> _" at level 70 with arguments constr at next level, constr at next level, constr at next level, no associativity. Notation "_ = _" at level 70 with arguments constr at next level, constr at next level, no associativity. Notation "_ = _ = _" at level 70 with arguments constr at next level, constr at next level, constr at next level, no associativity. Notation "_ <> _ :> _" at level 70 with arguments constr at next level, constr at next level, constr at next level, no associativity. Notation "_ <> _" at level 70 with arguments constr at next level, constr at next level, no associativity. Notation "_ <= _" at level 70 with arguments constr at next level, constr at next level, no associativity. Notation "_ < _" at level 70 with arguments constr at next level, constr at next level, no associativity. Notation "_ >= _" at level 70 with arguments constr at next level, constr at next level, no associativity. Notation "_ > _" at level 70 with arguments constr at next level, constr at next level, no associativity. Notation "_ <= _ <= _" at level 70 with arguments constr at next level, constr at next level, constr at next level, no associativity. Notation "_ <= _ < _" at level 70 with arguments constr at next level, constr at next level, constr at next level, no associativity. Notation "_ < _ < _" at level 70 with arguments constr at next level, constr at next level, constr at next level, no associativity. Notation "_ < _ <= _" at level 70 with arguments constr at next level, constr at next level, constr at next level, no associativity. Notation "_ + _" at level 50 with arguments constr at level 50, constr at next level, left associativity. Notation "_ - _" at level 50 with arguments constr at level 50, constr at next level, left associativity. Notation "_ * _" at level 40 with arguments constr at level 40, constr at next level, left associativity. Notation "_ / _" at level 40 with arguments constr at level 40, constr at next level, left associativity. Notation "- _" at level 35 with arguments constr at level 35, right associativity. Notation "/ _" at level 35 with arguments constr at level 35, right associativity. Notation "_ ^ _" at level 30 with arguments constr at next level, constr at level 30, right associativity. Notation "_ || _" at level 50 with arguments constr at level 50, constr at next level, left associativity. Notation "_ && _" at level 40 with arguments constr at level 40, constr at next level, left associativity. Notation "( _ , _ , .. , _ )" at level 0 with arguments constr, constr, no associativity. Notation "{ _ }" at level 0 with arguments constr at level 99, no associativity. Notation "{ _ } + { _ }" at level 50 with arguments constr, constr, left associativity. Notation "_ + { _ }" at level 50 with arguments constr at level 50, constr, left associativity. Notation "{ _ | _ }" at level 0 with arguments constr at level 99, constr, no associativity. Notation "{ _ | _ & _ }" at level 0 with arguments constr at level 99, constr, constr, no associativity. Notation "{ _ : _ | _ }" at level 0 with arguments constr at level 99, constr, constr, no associativity. Notation "{ _ : _ | _ & _ }" at level 0 with arguments constr at level 99, constr, constr, constr, no associativity. Notation "{ _ & _ }" at level 0 with arguments constr at level 99, constr, no associativity. Notation "{ _ & _ & _ }" at level 0 with arguments constr at level 99, constr, constr, no associativity. Notation "{ _ : _ & _ }" at level 0 with arguments constr at level 99, constr, constr, no associativity. Notation "{ _ : _ & _ & _ }" at level 0 with arguments constr at level 99, constr, constr, constr, no associativity. Notation "{ ' _ | _ }" at level 0 with arguments strict pattern at level 0, constr, no associativity. Notation "{ ' _ | _ & _ }" at level 0 with arguments strict pattern at level 0, constr, constr, no associativity. Notation "{ ' _ : _ | _ }" at level 0 with arguments strict pattern at level 0, constr, constr, no associativity. Notation "{ ' _ : _ | _ & _ }" at level 0 with arguments strict pattern at level 0, constr, constr, constr, no associativity. Notation "{ ' _ & _ }" at level 0 with arguments strict pattern at level 0, constr, no associativity. Notation "{ ' _ & _ & _ }" at level 0 with arguments strict pattern at level 0, constr, constr, no associativity. Notation "{ ' _ : _ & _ }" at level 0 with arguments strict pattern at level 0, constr, constr, no associativity. Notation "{ ' _ : _ & _ & _ }" at level 0 with arguments strict pattern at level 0, constr, constr, constr, no associativity. Notation "if _ is _ then _ else _" at level 200 with arguments constr, pattern at level 100 at level 100, constr, constr at next level, no associativity. Notation "_ -> _" at level 99 with arguments constr at next level, constr at level 200, no associativity. Notation "_ <-> _" at level 95 with arguments constr at next level, constr at next level, no associativity. Notation "_ /\ _" at level 80 with arguments constr at next level, constr at level 80, right associativity. Notation "_ \/ _" at level 85 with arguments constr at next level, constr at level 85, right associativity. Notation "~ _" at level 75 with arguments constr at level 75, right associativity. Notation "_ = _ :> _" at level 70 with arguments constr at next level, constr at next level, constr at next level, no associativity. Notation "_ = _" at level 70 with arguments constr at next level, constr at next level, no associativity. Notation "_ = _ = _" at level 70 with arguments constr at next level, constr at next level, constr at next level, no associativity. Notation "_ <> _ :> _" at level 70 with arguments constr at next level, constr at next level, constr at next level, no associativity. Notation "_ <> _" at level 70 with arguments constr at next level, constr at next level, no associativity. Notation "_ <= _" at level 70 with arguments constr at next level, constr at next level, no associativity. Notation "_ < _" at level 70 with arguments constr at next level, constr at next level, no associativity. Notation "_ >= _" at level 70 with arguments constr at next level, constr at next level, no associativity. Notation "_ > _" at level 70 with arguments constr at next level, constr at next level, no associativity. Notation "_ <= _ <= _" at level 70 with arguments constr at next level, constr at next level, constr at next level, no associativity. Notation "_ <= _ < _" at level 70 with arguments constr at next level, constr at next level, constr at next level, no associativity. Notation "_ < _ < _" at level 70 with arguments constr at next level, constr at next level, constr at next level, no associativity. Notation "_ < _ <= _" at level 70 with arguments constr at next level, constr at next level, constr at next level, no associativity. Notation "_ + _" at level 50 with arguments constr at level 50, constr at next level, left associativity. Notation "_ - _" at level 50 with arguments constr at level 50, constr at next level, left associativity. Notation "_ * _" at level 40 with arguments constr at level 40, constr at next level, left associativity. Notation "_ / _" at level 40 with arguments constr at level 40, constr at next level, left associativity. Notation "- _" at level 35 with arguments constr at level 35, right associativity. Notation "/ _" at level 35 with arguments constr at level 35, right associativity. Notation "_ ^ _" at level 30 with arguments constr at next level, constr at level 30, right associativity. Notation "_ || _" at level 50 with arguments constr at level 50, constr at next level, left associativity. Notation "_ && _" at level 40 with arguments constr at level 40, constr at next level, left associativity. Notation "( _ , _ , .. , _ )" at level 0 with arguments constr, constr, no associativity. Notation "{ _ }" at level 0 with arguments constr at level 99, no associativity. Notation "{ _ } + { _ }" at level 50 with arguments constr, constr, left associativity. Notation "_ + { _ }" at level 50 with arguments constr at level 50, constr, left associativity. Notation "{ _ | _ }" at level 0 with arguments constr at level 99, constr, no associativity. Notation "{ _ | _ & _ }" at level 0 with arguments constr at level 99, constr, constr, no associativity. Notation "{ _ : _ | _ }" at level 0 with arguments constr at level 99, constr, constr, no associativity. Notation "{ _ : _ | _ & _ }" at level 0 with arguments constr at level 99, constr, constr, constr, no associativity. Notation "{ _ & _ }" at level 0 with arguments constr at level 99, constr, no associativity. Notation "{ _ & _ & _ }" at level 0 with arguments constr at level 99, constr, constr, no associativity. Notation "{ _ : _ & _ }" at level 0 with arguments constr at level 99, constr, constr, no associativity. Notation "{ _ : _ & _ & _ }" at level 0 with arguments constr at level 99, constr, constr, constr, no associativity. Notation "{ ' _ | _ }" at level 0 with arguments strict pattern at level 0, constr, no associativity. Notation "{ ' _ | _ & _ }" at level 0 with arguments strict pattern at level 0, constr, constr, no associativity. Notation "{ ' _ : _ | _ }" at level 0 with arguments strict pattern at level 0, constr, constr, no associativity. Notation "{ ' _ : _ | _ & _ }" at level 0 with arguments strict pattern at level 0, constr, constr, constr, no associativity. Notation "{ ' _ & _ }" at level 0 with arguments strict pattern at level 0, constr, no associativity. Notation "{ ' _ & _ & _ }" at level 0 with arguments strict pattern at level 0, constr, constr, no associativity. Notation "{ ' _ : _ & _ }" at level 0 with arguments strict pattern at level 0, constr, constr, no associativity. Notation "{ ' _ : _ & _ & _ }" at level 0 with arguments strict pattern at level 0, constr, constr, constr, no associativity. Notation "if _ is _ then _ else _" at level 200 with arguments constr, pattern at level 100 at level 100, constr, constr at next level, no associativity. Notation "{{ _ }}" in Foo at level 0 with arguments custom Foo, no associativity. Notation "{{ _ }}" in Foo at level 0 with arguments custom Foo, no associativity. File "./output/PrintNotation.v", line 156, characters 2-46: The command has indeed failed with message: Unknown custom entry: Bar. File "./output/PrintNotation.v", line 157, characters 2-46: The command has indeed failed with message: Unknown custom entry: Bar. File "./output/PrintNotation.v", line 158, characters 2-46: The command has indeed failed with message: "[[ x ]]" cannot be interpreted as a known notation in Foo entry. Make sure that symbols are surrounded by spaces and that holes are explicitly denoted by "_". File "./output/PrintNotation.v", line 159, characters 2-46: The command has indeed failed with message: "[[ _ ]]" cannot be interpreted as a known notation in Foo entry. Make sure that symbols are surrounded by spaces and that holes are explicitly denoted by "_". File "./output/PrintNotation.v", line 164, characters 2-32: The command has indeed failed with message: "x mod y" cannot be interpreted as a known notation. Make sure that symbols are surrounded by spaces and that holes are explicitly denoted by "_". Notation "_ mod _" at level 40 with arguments constr at next level, constr at next level, no associativity. Notation "_ mod _" at level 40 with arguments constr at next level, constr at next level, no associativity. Notation "_ mod _" at level 40 with arguments constr at next level, constr at next level, no associativity. bar (bar ?f ?f0) ?f1 : foo where ?f : [ |- foo] ?f0 : [ |- foo] ?f1 : [ |- foo] File "./output/PrintNotation.v", line 176, characters 2-34: The command has indeed failed with message: "x 'mod' y" cannot be interpreted as a known notation. Make sure that symbols are surrounded by spaces and that holes are explicitly denoted by "_". Notation "_ 'mod' _" at level 40 with arguments constr at next level, constr at next level, no associativity. File "./output/PrintNotation.v", line 178, characters 2-34: The command has indeed failed with message: "_ 'mod' _" cannot be interpreted as a known notation. Make sure that symbols are surrounded by spaces and that holes are explicitly denoted by "_". Notation "_ 'mod' _" at level 40 with arguments constr at next level, constr at next level, no associativity. bar (bar ?f ?f0) ?f1 : foo where ?f : [ |- foo] ?f0 : [ |- foo] ?f1 : [ |- foo] File "./output/PrintNotation.v", line 190, characters 2-42: The command has indeed failed with message: "exists x .. y , p" cannot be interpreted as a known notation. Make sure that symbols are surrounded by spaces and that holes are explicitly denoted by "_". Notation "exists _ .. _ , _" at level 200 with arguments binder, constr at level 200, right associativity. Notation "exists _ .. _ , _" at level 200 with arguments binder, constr at level 200, right associativity. File "./output/PrintNotation.v", line 193, characters 2-37: The command has indeed failed with message: "exists _ , _" cannot be interpreted as a known notation. Make sure that symbols are surrounded by spaces and that holes are explicitly denoted by "_". File "./output/PrintNotation.v", line 194, characters 2-39: The command has indeed failed with message: "exists _ _ , _" cannot be interpreted as a known notation. Make sure that symbols are surrounded by spaces and that holes are explicitly denoted by "_". coq-8.20.0/test-suite/output/PrintNotation.v000066400000000000000000000135721466560755400210620ustar00rootroot00000000000000Set Printing All. Module NoDefinedAssoc. Reserved Notation "x $ y" (at level 123). Print Notation "x $ x". Axiom foo : Type. Axiom bar : forall _ : foo, forall _ : foo, foo. Notation "x $ y" := (bar x y) (only parsing). Check (_ $ _ $ _). End NoDefinedAssoc. Module NoAssoc. Reserved Notation "x $ y" (at level 123, no associativity). Print Notation "x $ x". Axiom foo : Type. Axiom bar : forall _ : foo, forall _ : foo, foo. Notation "x $ y" := (bar x y) (only parsing). Check (_ $ _ $ _). End NoAssoc. Module LeftAssoc. Reserved Notation "x $ y" (at level 123, left associativity). Print Notation "x $ x". Axiom foo : Type. Axiom bar : forall _ : foo, forall _ : foo, foo. Notation "x $ y" := (bar x y) (only parsing). Check (_ $ _ $ _). End LeftAssoc. Module RightAssoc. Reserved Notation "x $ y" (at level 123, right associativity). Print Notation "x $ x". Axiom foo : Type. Axiom bar : forall _ : foo, forall _ : foo, foo. Notation "x $ y" := (bar x y) (only parsing). Check (_ $ _ $ _). Fail Print Notation "_ $ x". Fail Print Notation "_ $". Fail Print Notation "$ x". Fail Print Notation "x$y". Fail Print Notation "_$_". Print Notation "y $ x". Print Notation "_ $ _". End RightAssoc. (** Stdlib notations *) Module StdlibNotations. Import IfNotations. Print Notation "x -> y". Print Notation "x <-> y". Print Notation "x /\ y". Print Notation "x \/ y". Print Notation "~ x". Print Notation "x = y :> T". Print Notation "x = y". Print Notation "x = y = z". Print Notation "x <> y :> T". Print Notation "x <> y". Print Notation "x <= y". Print Notation "x < y". Print Notation "x >= y". Print Notation "x > y". Print Notation "x <= y <= z". Print Notation "x <= y < z". Print Notation "x < y < z". Print Notation "x < y <= z". Print Notation "x + y". Print Notation "x - y". Print Notation "x * y". Print Notation "x / y". Print Notation "- x". Print Notation "/ x". Print Notation "x ^ y". Print Notation "x || y". Print Notation "x && y". Print Notation "( x , y , .. , z )". Print Notation "{ x }". Print Notation "{ A } + { B }". Print Notation "A + { B }". Print Notation "{ x | P }". Print Notation "{ x | P & Q }". Print Notation "{ x : A | P }". Print Notation "{ x : A | P & Q }". Print Notation "{ x & P }". Print Notation "{ x & P & Q }". Print Notation "{ x : A & P }". Print Notation "{ x : A & P & Q }". Print Notation "{ ' pat | P }". Print Notation "{ ' pat | P & Q }". Print Notation "{ ' pat : A | P }". Print Notation "{ ' pat : A | P & Q }". Print Notation "{ ' pat & P }". Print Notation "{ ' pat & P & Q }". Print Notation "{ ' pat : A & P }". Print Notation "{ ' pat : A & P & Q }". Print Notation "'if' c 'is' p 'then' u 'else' v". End StdlibNotations. Module StdlibNotationsUnderscored. Import IfNotations. Print Notation "_ -> _". Print Notation "_ <-> _". Print Notation "_ /\ _". Print Notation "_ \/ _". Print Notation "~ _". Print Notation "_ = _ :> _". Print Notation "_ = _". Print Notation "_ = _ = _". Print Notation "_ <> _ :> _". Print Notation "_ <> _". Print Notation "_ <= _". Print Notation "_ < _". Print Notation "_ >= _". Print Notation "_ > _". Print Notation "_ <= _ <= _". Print Notation "_ <= _ < _". Print Notation "_ < _ < _". Print Notation "_ < _ <= _". Print Notation "_ + _". Print Notation "_ - _". Print Notation "_ * _". Print Notation "_ / _". Print Notation "- _". Print Notation "/ _". Print Notation "_ ^ _". Print Notation "_ || _". Print Notation "_ && _". Print Notation "( _ , _ , .. , _ )". Print Notation "{ _ }". Print Notation "{ _ } + { _ }". Print Notation "_ + { _ }". Print Notation "{ _ | _ }". Print Notation "{ _ | _ & _ }". Print Notation "{ _ : _ | _ }". Print Notation "{ _ : _ | _ & _ }". Print Notation "{ _ & _ }". Print Notation "{ _ & _ & _ }". Print Notation "{ _ : _ & _ }". Print Notation "{ _ : _ & _ & _ }". Print Notation "{ ' _ | _ }". Print Notation "{ ' _ | _ & _ }". Print Notation "{ ' _ : _ | _ }". Print Notation "{ ' _ : _ | _ & _ }". Print Notation "{ ' _ & _ }". Print Notation "{ ' _ & _ & _ }". Print Notation "{ ' _ : _ & _ }". Print Notation "{ ' _ : _ & _ & _ }". Print Notation "if _ is _ then _ else _". End StdlibNotationsUnderscored. (* Print Notatation doesn't work with custom notations *) Module Custom. Declare Custom Entry Foo. Reserved Notation "{{ x }}" (in custom Foo at level 0). Print Notation "{{ x }}" in custom Foo. Print Notation "{{ _ }}" in custom Foo. Fail Print Notation "{{ x }}" in custom Bar. Fail Print Notation "{{ _ }}" in custom Bar. Fail Print Notation "[[ x ]]" in custom Foo. Fail Print Notation "[[ _ ]]" in custom Foo. End Custom. Module OnlyLetters. Reserved Infix "mod" (at level 40, no associativity). Fail Print Notation "x mod y". Print Notation "x 'mod' y". Print Notation "_ mod _". Print Notation "_ 'mod' _". Axiom foo : Type. Axiom bar : forall _ : foo, forall _ : foo, foo. Infix "mod" := bar (only parsing). Check (_ mod _ mod _). End OnlyLetters. Module SingleQuotes. Reserved Infix "'mod'" (at level 40, no associativity). Fail Print Notation "x 'mod' y". Print Notation "x ''mod'' y". Fail Print Notation "_ 'mod' _". (* FIXME I expected this to work *) Print Notation "_ ''mod'' _". Axiom foo : Type. Axiom bar : forall _ : foo, forall _ : foo, foo. Infix "'mod'" := bar (only parsing). Check (_ 'mod' _ 'mod' _). End SingleQuotes. Module Recursive. Reserved Notation "'exists' x .. y , p" (at level 200, x binder, right associativity, format "'[' 'exists' '/ ' x .. y , '/ ' p ']'"). Fail Print Notation "exists x .. y , p". Print Notation "'exists' x .. y , p". Print Notation "exists _ .. _ , _". Fail Print Notation "exists _ , _". Fail Print Notation "exists _ _ , _". End Recursive. coq-8.20.0/test-suite/output/PrintPrimProj.out000066400000000000000000000006371466560755400213710ustar00rootroot00000000000000(trip (unbox nat n) (unbox _ n) (unbox _ n)) (trip (unbox nat n) (unbox _ n) (let '{| unbox := unbox |} := n in unbox)) (trip n.(unbox nat) n.(unbox _) (let '{| unbox := unbox |} := n in unbox)) (trip n.(unbox nat) n.(unbox _) n.(unbox _)) (trip n.(unbox) n.(unbox) n.(unbox)) (trip n.(unbox) n.(unbox) (let '{| unbox := unbox |} := n in unbox)) (trip (unbox n) (unbox n) (let '{| unbox := unbox |} := n in unbox)) coq-8.20.0/test-suite/output/PrintPrimProj.v000066400000000000000000000013411466560755400210200ustar00rootroot00000000000000Set Primitive Projections. Record Box (A:Type) := box { unbox : A }. Definition ubox := @unbox. Axiom trip : nat -> nat -> nat -> Prop. Ltac show_goal := match goal with |- ?g => idtac g end. Lemma foo (n:Box nat) : (* constant, folded, unfolded *) trip (ubox _ n) (unbox _ n) (match n with box _ n => n end). Proof. simpl. (* remove extra letins introduced by match compilation *) cbv delta [ubox]. show_goal. Set Printing Unfolded Projection As Match. show_goal. Set Printing Projections. show_goal. Unset Printing Unfolded Projection As Match. show_goal. Arguments unbox {_}. show_goal. Set Printing Unfolded Projection As Match. show_goal. Unset Printing Projections. show_goal. Abort. coq-8.20.0/test-suite/output/PrintSecDeps.out000066400000000000000000000007511466560755400211520ustar00rootroot00000000000000bla : Prop bla is not universe polymorphic bla uses section variables A x. bla is transparent Expands to: Constant PrintSecDeps.S.bla bli : nat bli is not universe polymorphic bli is transparent Expands to: Constant PrintSecDeps.S.bli bla : forall A : Type, A -> Prop bla is not universe polymorphic Arguments bla A%type_scope x bla is transparent Expands to: Constant PrintSecDeps.bla bli : nat bli is not universe polymorphic bli is transparent Expands to: Constant PrintSecDeps.bli coq-8.20.0/test-suite/output/PrintSecDeps.v000066400000000000000000000002711466560755400206050ustar00rootroot00000000000000 Section S. Variables (A:Type) (x:A) (y:A). Let z := x. Definition bla := x = z. About bla. Let zz := 0. Definition bli := zz. About bli. End S. About bla. About bli. coq-8.20.0/test-suite/output/PrintUnivsSubgraph.out000066400000000000000000000000271466560755400224200ustar00rootroot00000000000000Set < i < j i < j coq-8.20.0/test-suite/output/PrintUnivsSubgraph.v000066400000000000000000000003101466560755400220510ustar00rootroot00000000000000 Universes i j k l. Definition foo : Type@{j} := Type@{i}. Definition baz : Type@{k} := Type@{l}. Print Universes Subgraph(i j). (* should print [i < j], not [l < k] (and not prelude universes) *) coq-8.20.0/test-suite/output/PrintingParentheses.out000066400000000000000000000030221466560755400225750ustar00rootroot00000000000000((1 + (2 * 3), 4), 5) : (nat * nat) * nat mult_n_Sm = fun n m : nat => nat_ind (fun n0 : nat => ((n0 * m) + n0) = (n0 * (S m))) (eq_refl : ((0 * m) + 0) = (0 * (S m))) (fun (p : nat) (H : ((p * m) + p) = (p * (S m))) => (let n0 := p * (S m) in match H in (_ = n1) return (((m + (p * m)) + (S p)) = (S (m + n1))) with | eq_refl => eq_ind (S ((m + (p * m)) + p)) (fun n1 : nat => n1 = (S (m + ((p * m) + p)))) (eq_S ((m + (p * m)) + p) (m + ((p * m) + p)) (nat_ind (fun n1 : nat => ((n1 + (p * m)) + p) = (n1 + ((p * m) + p))) (eq_refl : ((0 + (p * m)) + p) = (0 + ((p * m) + p))) ((fun (n1 : nat) (H0 : ((n1 + (p * m)) + p) = (n1 + ((p * m) + p))) => f_equal_nat nat S ((n1 + (p * m)) + p) (n1 + ((p * m) + p)) H0) : forall n1 : nat, (((n1 + (p * m)) + p) = (n1 + ((p * m) + p))) -> ((((S n1) + (p * m)) + p) = ((S n1) + ((p * m) + p)))) m : ((m + (p * m)) + p) = (m + ((p * m) + p)))) ((m + (p * m)) + (S p)) (plus_n_Sm (m + (p * m)) p) end) : (((S p) * m) + (S p)) = ((S p) * (S m))) n : forall n m : nat, ((n * m) + n) = (n * (S m)) Arguments mult_n_Sm (n m)%nat_scope 1 :: (2 :: [3; 4]) : list nat {0 = 1} + {2 <= (4 + 5)} : Set forall x y z : nat, [(x + y) + z] = [x + y + z] : Prop forall x y z : nat, [(x + y) + z] = [x + (y + z)] : Prop coq-8.20.0/test-suite/output/PrintingParentheses.v000066400000000000000000000014011466560755400222320ustar00rootroot00000000000000Module Test1. Set Printing Parentheses. Check (1+2*3,4,5). Print mult_n_Sm. End Test1. Require Import List. Module Test2. Set Printing Parentheses. Import ListNotations. Check [1;2;3;4]. Check {0=1}+{2<=4+5}. End Test2. (* A test with custom entries *) Module CustomEntry. Declare Custom Entry myconstr. Notation "[ x ]" := x (x custom myconstr at level 6). Notation "x + y" := (Nat.add x y) (in custom myconstr at level 5, right associativity). Notation "( x )" := x (in custom myconstr at level 0). Notation "x" := x (in custom myconstr at level 0, x ident). Unset Printing Parentheses. Check forall x y z : nat, [ (x + y) + z ] = [ x + (y + z) ]. Set Printing Parentheses. Check forall x y z : nat, [ (x + y) + z ] = [ x + (y + z) ]. End CustomEntry. coq-8.20.0/test-suite/output/Projections.out000066400000000000000000000012041466560755400211000ustar00rootroot00000000000000fun S : store => S.(store_funcs) : store -> host_func a = fun A : Type => let B := A in fun (C : Type) (u : U A C) => (A, B, C, c _ _ u) : forall A : Type, let B := A in forall C : Type, U A C -> Type * Type * Type * (B * A * C) a is a projection of U Arguments a (A C)%type_scope u Record U (A : Type) (B : Type := A) (C : Type) : Type := Build_U { c : (B * A * C)%type; a := (A, B, C, c); b : a = a }. U has primitive projections with eta conversion. Arguments U (A C)%type_scope Arguments Build_U (A C)%type_scope c b Arguments c (A C)%type_scope u Arguments a (A C)%type_scope u Arguments b (A C)%type_scope u coq-8.20.0/test-suite/output/Projections.v000066400000000000000000000006131466560755400205410ustar00rootroot00000000000000 Set Printing Projections. Set Primitive Projections. Class HostFunction := host_func : Type. Section store. Context `{HostFunction}. Record store := { store_funcs : host_func }. End store. Check (fun (S:@store nat) => S.(store_funcs)). Module LocalDefUnfolding. Unset Printing Projections. Record U A (B:=A) C := {c:B*A*C;a:=(A,B,C,c);b:a=a}. Print a. Print b. End LocalDefUnfolding. coq-8.20.0/test-suite/output/ProofUsingClashWarning.out000066400000000000000000000023541466560755400232040ustar00rootroot00000000000000File "./output/ProofUsingClashWarning.v", line 3, characters 2-39: Warning: clashing_name was already a defined Variable, the name clashing_name will refer to Collection when executing "Proof using" command. [variable-shadowing,deprecated-since-8.15,deprecated,default] File "./output/ProofUsingClashWarning.v", line 6, characters 2-39: Warning: New Collection definition of redefined_col shadows the previous one. [collection-redefinition,deprecated-since-8.15,deprecated,default] File "./output/ProofUsingClashWarning.v", line 8, characters 2-34: The command has indeed failed with message: "All" is a predefined collection containing all variables. It can't be redefined. File "./output/ProofUsingClashWarning.v", line 11, characters 2-28: Warning: clashing_name is both name of a Collection and Variable, Collection clashing_name takes precedence over Variable. [collection-precedence,deprecated-since-8.15,deprecated,default] File "./output/ProofUsingClashWarning.v", line 16, characters 2-18: Warning: Variable All is shadowed by Collection named All containing all variables. [all-collection-precedence,deprecated-since-8.15,deprecated,default] foo : bool -> True : bool -> True bar : bool -> nat -> unit -> True : bool -> nat -> unit -> True coq-8.20.0/test-suite/output/ProofUsingClashWarning.v000066400000000000000000000006761466560755400226470ustar00rootroot00000000000000Section Test. Variables (bool_var : bool) (clashing_name : nat) (All : unit). Collection clashing_name := bool_var. Collection redefined_col := bool_var. Collection redefined_col := bool_var. Fail Collection All := bool_var. Lemma foo : True. Proof using clashing_name. trivial. Qed. Lemma bar : True. Proof using All. trivial. Qed. End Test. Check foo : bool -> True. Check bar : bool -> nat -> unit -> True. coq-8.20.0/test-suite/output/QArithSyntax.out000066400000000000000000000014661466560755400212120ustar00rootroot00000000000000eq_refl : 1.02 = 1.02 : 1.02 = 1.02 1.02e1 : Q 10.2 : Q 1.02e3 : Q 1020 : Q 1.02e2 : Q 102 : Q eq_refl : 10.2e-1 = 1.02 : 10.2e-1 = 1.02 eq_refl : -0.0001 = -0.0001 : -0.0001 = -0.0001 eq_refl : -0.50 = -0.50 : -0.50 = -0.50 0 : Q 0 : Q 42 : Q 42 : Q 1.23 : Q 0x1.23%xQ : Q 0.0012 : Q 42e3 : Q 42e-3 : Q eq_refl : -0x1a = -0x1a : -0x1a = -0x1a eq_refl : 0xb.2c = 0xb.2c : 0xb.2c = 0xb.2c eq_refl : -0x1ae2 = -0x1ae2 : -0x1ae2 = -0x1ae2 0xb.2cp2 : Q 2860 # 64 : Q 0xb.2cp8 : Q 0xb2c : Q eq_refl : -0xb.2cp-2 = -2860 # 1024 : -0xb.2cp-2 = -2860 # 1024 0x0 : Q 0x0 : Q 0x2a : Q 0x2a : Q 1.23%Q : Q 0x1.23 : Q 0x0.0012 : Q 0x2ap3 : Q 0x2ap-3 : Q coq-8.20.0/test-suite/output/QArithSyntax.v000066400000000000000000000013471466560755400206460ustar00rootroot00000000000000Require Import QArith. Open Scope Q_scope. Check (eq_refl : 1.02 = 102 # 100). Check 1.02e1. Check 102 # 10. Check 1.02e+03. Check 1020. Check 1.02e+02. Check 102 # 1. Check (eq_refl : 10.2e-1 = 1.02). Check (eq_refl : -0.0001 = -1 # 10000). Check (eq_refl : -0.50 = - 50 # 100). Check 0. Check 000. Check 42. Check 0x2a. Check 1.23. Check 0x1.23. Check 0.0012. Check 42e3. Check 42e-3. Open Scope hex_Q_scope. Check (eq_refl : -0x1a = - 26 # 1). Check (eq_refl : 0xb.2c = 2860 # 256). Check (eq_refl : -0x1ae2 = -6882). Check 0xb.2cp2. Check 2860 # 64. Check 0xb.2cp8. Check 2860. Check (eq_refl : -0xb.2cp-2 = -2860 # 1024). Check 0x0. Check 0x00. Check 42. Check 0x2a. Check 1.23. Check 0x1.23. Check 0x0.0012. Check 0x2ap3. Check 0x2ap-3. coq-8.20.0/test-suite/output/RealNumberSyntax.out000066400000000000000000000015351466560755400220530ustar00rootroot0000000000000032%R : R (-31)%R : R 1.5%R : R 1.5e1%R : R eq_refl : 1.02 = 102e-2 : 1.02 = 102e-2 1.02e1 : R 102e-1 : R 1.02e3 : R 102e1 : R 1.02e2 : R 102 : R 10.2e-1 : R 1.02 : R eq_refl : -0.0001 = -1e-4 : -0.0001 = -1e-4 eq_refl : -0.50 = -50e-2 : -0.50 = -50e-2 eq_refl : -26 = -26 : -26 = -26 eq_refl : 0xb.2c%xR = 0xb2cp-8%xR : 0xb.2c%xR = 0xb2cp-8%xR eq_refl : -6882 = -6882 : -6882 = -6882 0xb.2cp2%xR : R 0xb2cp-6%xR : R 0xb.2cp8%xR : R 2860 : R (-0xb.2cp-2)%xR : R - 0xb2cp-10%xR : R 0 : R 0 : R 42 : R 42 : R 1.23 : R 0x1.23%xR : R 0.0012 : R 42e3 : R 42e-3 : R 0x0 : R 0x0 : R 0x2a : R 0x2a : R 1.23%R : R 0x1.23 : R 0x0.0012 : R 0x2ap3 : R 0x2ap-3 : R coq-8.20.0/test-suite/output/RealNumberSyntax.v000066400000000000000000000021511466560755400215040ustar00rootroot00000000000000Require Import Reals.Rdefinitions. Check 32%R. Check (-31)%R. Check 1.5_%R. Check 1_.5_e1_%R. Open Scope R_scope. Check (eq_refl : 1.02 = IZR 102 / IZR (Z.pow_pos 10 2)). Check 1.02e1. Check IZR 102 / IZR (Z.pow_pos 10 1). Check 1.02e+03. Check IZR 102 * IZR (Z.pow_pos 10 1). Check 1.02e+02. Check IZR 102. Check 10.2e-1. Check 1.02. Check (eq_refl : -0.0001 = IZR (-1) / IZR (Z.pow_pos 10 4)). Check (eq_refl : -0.50 = IZR (-50) / IZR (Z.pow_pos 10 2)). Check (eq_refl : -0x1a = - 26). Check (eq_refl : 0xb.2c = IZR 2860 / IZR (Z.pow_pos 2 8)). Check (eq_refl : -0x1ae2 = -6882). Check 0xb.2cp2. Check IZR 2860 / IZR (Z.pow_pos 2 6). Check 0xb.2cp8. Check 2860. Check -0xb.2cp-2. Check - (IZR 2860 / IZR (Z.pow_pos 2 10)). Check 0. Check 000. Check 42. Check 0x2a. Check 1.23. Check 0x1.23. Check 0.0012. Check 42e3. Check 42e-3. Open Scope hex_R_scope. Check 0x0. Check 0x000. Check 42. Check 0x2a. Check 1.23. Check 0x1.23. Check 0x0.0012. Check 0x2ap3. Check 0x2ap-3. Close Scope hex_R_scope. Require Import Reals. Goal 254e3 = 2540 * 10 ^ 2. ring. Qed. Require Import Psatz. Goal 254e3 = 2540 * 10 ^ 2. lra. Qed. coq-8.20.0/test-suite/output/RecognizePluginWarning.out000066400000000000000000000000001466560755400232240ustar00rootroot00000000000000coq-8.20.0/test-suite/output/RecognizePluginWarning.v000066400000000000000000000004301466560755400226710ustar00rootroot00000000000000(* -*- mode: coq; coq-prog-args: ("-w" "extraction-logical-axiom") -*- *) (* Test that mentioning a warning defined in plugins works. The failure mode here is that these result in a warning about unknown warnings, since the plugins are not known at command line parsing time. *) coq-8.20.0/test-suite/output/Record.out000066400000000000000000000036241466560755400200270ustar00rootroot00000000000000{| field := 5 |} : test {| field := 5 |} : test {| field_r := 5 |} : test_r build_c 5 : test_c build 5 : test build 5 : test {| field_r := 5 |} : test_r build_c 5 : test_c fun '(C _ p) => p : N -> True fun '{| T := T |} => T : N -> Type fun '(C T p) => (T, p) : N -> Type * True fun '{| q := p |} => p : M -> True fun '{| U := T |} => T : M -> Type fun '{| U := T; q := p |} => (T, p) : M -> Type * True 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 fun x : R => 0 +++ x.(field) 0 : R -> nat File "./output/Record.v", line 85, characters 23-24: The command has indeed failed with message: Projection f expected 1 explicit parameter. coq-8.20.0/test-suite/output/Record.v000066400000000000000000000043171466560755400174650ustar00rootroot00000000000000Record test := build { field : nat }. Record test_r := build_r { field_r : nat }. Record test_c := build_c { field_c : nat }. Add Printing Constructor test_c. Add Printing Record test_r. Set Printing Records. Check build 5. Check {| field := 5 |}. Check build_r 5. Check build_c 5. Unset Printing Records. Check build 5. Check {| field := 5 |}. Check build_r 5. Check build_c 5. Set Printing Records. Record N := C { T : Type; _ : True }. Check fun x:N => let 'C _ p := x in p. Check fun x:N => let 'C T _ := x in T. Check fun x:N => let 'C T p := x in (T,p). Record M := D { U : Type; a := 0; q : True }. Check fun x:M => let 'D T _ p := x in p. 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. Module ProjectionPrinting. Notation "a +++ b" := (a * b) (at level 40, format "'[v' a '/' +++ '/' b ']'"). Record R := { field : nat -> nat }. Set Printing Projections. Check fun x => 0 +++ x.(field) 0. End ProjectionPrinting. Module RecordImplicitParameters. (* Check that implicit parameters are treated independently of extra implicit arguments (at some time they did not and it was failing at typing time) *) Record R A := { f : A -> A }. Fail Check fun x => x.(f). End RecordImplicitParameters. coq-8.20.0/test-suite/output/RecordFieldErrors.out000066400000000000000000000017451466560755400221720ustar00rootroot00000000000000File "./output/RecordFieldErrors.v", line 10, characters 14-18: The command has indeed failed with message: unit: Not a projection. File "./output/RecordFieldErrors.v", line 13, characters 14-18: The command has indeed failed with message: unit: Not a projection. File "./output/RecordFieldErrors.v", line 17, characters 14-48: The command has indeed failed with message: This record contains fields of both t and t'. File "./output/RecordFieldErrors.v", line 21, characters 14-18: The command has indeed failed with message: unit: Not a projection. File "./output/RecordFieldErrors.v", line 25, characters 14-48: The command has indeed failed with message: This record defines several times the field foo. File "./output/RecordFieldErrors.v", line 29, characters 14-75: The command has indeed failed with message: This record defines several times the field unit. File "./output/RecordFieldErrors.v", line 37, characters 14-18: The command has indeed failed with message: unit: Not a projection. coq-8.20.0/test-suite/output/RecordFieldErrors.v000066400000000000000000000016651466560755400216310ustar00rootroot00000000000000(** Check that various errors in record fields are reported with the correct underlying issue. *) Record t := { foo: unit }. Record t' := { bar: unit }. Fail Check {| unit := tt |}. (* unit: Not a projection. *) Fail Check {| unit := tt; foo := tt |}. (* unit: Not a projection. *) Fail Check {| foo := tt; bar := tt |}. (* This record contains fields of both t and t'. *) Fail Check {| unit := tt; unit := tt |}. (* unit: Not a projection. *) Fail Check {| foo := tt; foo := tt |}. (* This record defines several times the field foo. *) Fail Check {| foo := tt; unit := tt; unit := tt |}. (* This is slightly wrong (would prefer "unit: Not a projection."), but it's acceptable and seems an unlikely mistake. *) (* This record defines several times the field unit. *) Fail Check {| foo := tt; unit := tt |}. (* unit: Not a projection. *) coq-8.20.0/test-suite/output/RecordMissingField.out000066400000000000000000000013631466560755400223230ustar00rootroot00000000000000File "./output/RecordMissingField.v", line 6, characters 0-80: The command has indeed failed with message: The following term contains unresolved implicit arguments: (fun p : point2d => {| x2p := x2p p + 1; y2p := ?y2p |}) More precisely: - ?y2p: Cannot infer field y2p of record point2d in environment: p : point2d File "./output/RecordMissingField.v", line 11, characters 0-93: The command has indeed failed with message: The following term contains unresolved implicit arguments: (fun p : point2d => {| x2p := x2p p + (fun n : nat => ?n) 1; y2p := ?y2p |}) More precisely: - ?n: Cannot infer this placeholder of type "nat" in environment: p : point2d n : nat - ?y2p: Cannot infer field y2p of record point2d in environment: p : point2d coq-8.20.0/test-suite/output/RecordMissingField.v000066400000000000000000000007261466560755400217630ustar00rootroot00000000000000(** Check for error message when missing a record field. Error message should contain missing field, and the inferred type of the record **) Record point2d := mkPoint { x2p: nat; y2p: nat }. Fail Definition increment_x (p: point2d) : point2d := {| x2p := x2p p + 1; |}. (* Here there is also an unresolved implicit, which should give an understadable error as well *) Fail Definition increment_x (p: point2d) : point2d := {| x2p := x2p p + (fun n => _) 1; |}. coq-8.20.0/test-suite/output/RecordProjParameter.out000066400000000000000000000020541466560755400225170ustar00rootroot00000000000000t1 : Atype -> forall a : Type, a t1 is not universe polymorphic t1 is a projection of Atype Arguments t1 a0 a%type_scope t1 is transparent Expands to: Constant RecordProjParameter.t1 t3 : forall a0 : Atype, t2 a0 t3 is not universe polymorphic t3 is a projection of Atype Arguments t3 a0 t3 is transparent Expands to: Constant RecordProjParameter.t3 u1 : Btype -> forall b b0 : Type, b * b0 u1 is not universe polymorphic u1 is a projection of Btype Arguments u1 b1 (b b0)%type_scope u1 is transparent Expands to: Constant RecordProjParameter.u1 u3 : forall b1 : Btype, u2 b1 u3 is not universe polymorphic u3 is a projection of Btype Arguments u3 b1 u3 is transparent Expands to: Constant RecordProjParameter.u3 v1 : Ctype -> forall c0 : Type, c0 v1 is not universe polymorphic v1 is a projection of Ctype Arguments v1 c c0%type_scope v1 is transparent Expands to: Constant RecordProjParameter.v1 v3 : forall c : Ctype, v2 c v3 is not universe polymorphic v3 is a projection of Ctype Arguments v3 c v3 is transparent Expands to: Constant RecordProjParameter.v3 coq-8.20.0/test-suite/output/RecordProjParameter.v000066400000000000000000000005111466560755400221510ustar00rootroot00000000000000Record Atype : Type := { t1 : forall (a : Type), a ; t2 : Type ; t3 : t2 }. About t1. About t3. Record Btype : Type := { u1 : forall (b : Type) (b0 : Type), b * b0 ; u2 : Type ; u3 : u2 }. About u1. About u3. Record Ctype : Type := { v1 : forall (c0 : Type), c0 ; v2 : Type ; v3 : v2 }. About v1. About v3. coq-8.20.0/test-suite/output/SchemeNames.out000066400000000000000000000512431466560755400210010ustar00rootroot00000000000000File "./output/SchemeNames.v", line 14, characters 2-47: The command has indeed failed with message: Incorrect elimination in the inductive type "fooSProp": the return type has sort "Prop" while it should be SProp. Elimination of an inductive object of sort SProp is not allowed on a predicate in sort "Prop" because strict proofs can be eliminated only to build strict proofs. File "./output/SchemeNames.v", line 15, characters 2-46: The command has indeed failed with message: Incorrect elimination in the inductive type "fooSProp": the return type has sort "Set" while it should be SProp. Elimination of an inductive object of sort SProp is not allowed on a predicate in sort "Set" because strict proofs can be eliminated only to build strict proofs. File "./output/SchemeNames.v", line 16, characters 2-47: The command has indeed failed with message: Incorrect elimination in the inductive type "fooSProp": the return type has sort "Type" while it should be SProp. Elimination of an inductive object of sort SProp is not allowed on a predicate in sort "Type" because strict proofs can be eliminated only to build strict proofs. fooSProp_inds : forall P : fooSProp -> SProp, P aSP -> P bSP -> forall f1 : fooSProp, P f1 fooSProp_inds is not universe polymorphic Arguments fooSProp_inds P%function_scope f f0 f1 fooSProp_inds is transparent Expands to: Constant SchemeNames.fooSProp_inds File "./output/SchemeNames.v", line 23, characters 2-48: The command has indeed failed with message: Incorrect elimination in the inductive type "fooSProp": the return type has sort "Prop" while it should be SProp. Elimination of an inductive object of sort SProp is not allowed on a predicate in sort "Prop" because strict proofs can be eliminated only to build strict proofs. File "./output/SchemeNames.v", line 24, characters 2-47: The command has indeed failed with message: Incorrect elimination in the inductive type "fooSProp": the return type has sort "Set" while it should be SProp. Elimination of an inductive object of sort SProp is not allowed on a predicate in sort "Set" because strict proofs can be eliminated only to build strict proofs. File "./output/SchemeNames.v", line 25, characters 2-48: The command has indeed failed with message: Incorrect elimination in the inductive type "fooSProp": the return type has sort "Type" while it should be SProp. Elimination of an inductive object of sort SProp is not allowed on a predicate in sort "Type" because strict proofs can be eliminated only to build strict proofs. fooSProp_inds_nodep : forall P : SProp, P -> P -> fooSProp -> P fooSProp_inds_nodep is not universe polymorphic Arguments fooSProp_inds_nodep P%type_scope f f0 f1 fooSProp_inds_nodep is transparent Expands to: Constant SchemeNames.fooSProp_inds_nodep File "./output/SchemeNames.v", line 32, characters 2-49: The command has indeed failed with message: Incorrect elimination in the inductive type "fooSProp": the return type has sort "Prop" while it should be SProp. Elimination of an inductive object of sort SProp is not allowed on a predicate in sort "Prop" because strict proofs can be eliminated only to build strict proofs. File "./output/SchemeNames.v", line 33, characters 2-48: The command has indeed failed with message: Incorrect elimination in the inductive type "fooSProp": the return type has sort "Set" while it should be SProp. Elimination of an inductive object of sort SProp is not allowed on a predicate in sort "Set" because strict proofs can be eliminated only to build strict proofs. File "./output/SchemeNames.v", line 34, characters 2-49: The command has indeed failed with message: Incorrect elimination in the inductive type "fooSProp": the return type has sort "Type" while it should be SProp. Elimination of an inductive object of sort SProp is not allowed on a predicate in sort "Type" because strict proofs can be eliminated only to build strict proofs. fooSProp_cases : forall P : fooSProp -> SProp, P aSP -> P bSP -> forall f1 : fooSProp, P f1 fooSProp_cases is not universe polymorphic Arguments fooSProp_cases P%function_scope f f0 f1 fooSProp_cases is transparent Expands to: Constant SchemeNames.fooSProp_cases File "./output/SchemeNames.v", line 41, characters 2-42: The command has indeed failed with message: Incorrect elimination in the inductive type "fooSProp": the return type has sort "Prop" while it should be SProp. Elimination of an inductive object of sort SProp is not allowed on a predicate in sort "Prop" because strict proofs can be eliminated only to build strict proofs. File "./output/SchemeNames.v", line 42, characters 2-41: The command has indeed failed with message: Incorrect elimination in the inductive type "fooSProp": the return type has sort "Set" while it should be SProp. Elimination of an inductive object of sort SProp is not allowed on a predicate in sort "Set" because strict proofs can be eliminated only to build strict proofs. File "./output/SchemeNames.v", line 43, characters 2-42: The command has indeed failed with message: Incorrect elimination in the inductive type "fooSProp": the return type has sort "Type" while it should be SProp. Elimination of an inductive object of sort SProp is not allowed on a predicate in sort "Type" because strict proofs can be eliminated only to build strict proofs. fooSProp_cases_nodep : forall P : SProp, P -> P -> fooSProp -> P fooSProp_cases_nodep is not universe polymorphic Arguments fooSProp_cases_nodep P%type_scope f f0 f1 fooSProp_cases_nodep is transparent Expands to: Constant SchemeNames.fooSProp_cases_nodep File "./output/SchemeNames.v", line 49, characters 2-36: The command has indeed failed with message: Cannot extract computational content from proposition "fooSProp". File "./output/SchemeNames.v", line 61, characters 2-45: The command has indeed failed with message: Incorrect elimination in the inductive type "fooProp": the return type has sort "Set" while it should be SProp or Prop. Elimination of an inductive object of sort Prop is not allowed on a predicate in sort "Set" because proofs can be eliminated only to build proofs. File "./output/SchemeNames.v", line 62, characters 2-46: The command has indeed failed with message: Incorrect elimination in the inductive type "fooProp": the return type has sort "Type" while it should be SProp or Prop. Elimination of an inductive object of sort Prop is not allowed on a predicate in sort "Type" because proofs can be eliminated only to build proofs. fooProp_inds_dep : forall P : fooProp -> SProp, P aP -> P bP -> forall f1 : fooProp, P f1 fooProp_inds_dep is not universe polymorphic Arguments fooProp_inds_dep P%function_scope f f0 f1 fooProp_inds_dep is transparent Expands to: Constant SchemeNames.fooProp_inds_dep fooProp_ind_dep : forall P : fooProp -> Prop, P aP -> P bP -> forall f1 : fooProp, P f1 fooProp_ind_dep is not universe polymorphic Arguments fooProp_ind_dep P%function_scope f f0 f1 fooProp_ind_dep is transparent Expands to: Constant SchemeNames.fooProp_ind_dep File "./output/SchemeNames.v", line 71, characters 2-46: The command has indeed failed with message: Incorrect elimination in the inductive type "fooProp": the return type has sort "Set" while it should be SProp or Prop. Elimination of an inductive object of sort Prop is not allowed on a predicate in sort "Set" because proofs can be eliminated only to build proofs. File "./output/SchemeNames.v", line 72, characters 2-47: The command has indeed failed with message: Incorrect elimination in the inductive type "fooProp": the return type has sort "Type" while it should be SProp or Prop. Elimination of an inductive object of sort Prop is not allowed on a predicate in sort "Type" because proofs can be eliminated only to build proofs. fooProp_inds : forall P : SProp, P -> P -> fooProp -> P fooProp_inds is not universe polymorphic Arguments fooProp_inds P%type_scope f f0 f1 fooProp_inds is transparent Expands to: Constant SchemeNames.fooProp_inds fooProp_ind : forall P : Prop, P -> P -> fooProp -> P fooProp_ind is not universe polymorphic Arguments fooProp_ind P%type_scope f f0 f1 fooProp_ind is transparent Expands to: Constant SchemeNames.fooProp_ind File "./output/SchemeNames.v", line 81, characters 2-47: The command has indeed failed with message: Incorrect elimination in the inductive type "fooProp": the return type has sort "Set" while it should be SProp or Prop. Elimination of an inductive object of sort Prop is not allowed on a predicate in sort "Set" because proofs can be eliminated only to build proofs. File "./output/SchemeNames.v", line 82, characters 2-48: The command has indeed failed with message: Incorrect elimination in the inductive type "fooProp": the return type has sort "Type" while it should be SProp or Prop. Elimination of an inductive object of sort Prop is not allowed on a predicate in sort "Type" because proofs can be eliminated only to build proofs. fooProp_cases_dep : forall P : fooProp -> SProp, P aP -> P bP -> forall f1 : fooProp, P f1 fooProp_cases_dep is not universe polymorphic Arguments fooProp_cases_dep P%function_scope f f0 f1 fooProp_cases_dep is transparent Expands to: Constant SchemeNames.fooProp_cases_dep fooProp_case_dep : forall P : fooProp -> Prop, P aP -> P bP -> forall f1 : fooProp, P f1 fooProp_case_dep is not universe polymorphic Arguments fooProp_case_dep P%function_scope f f0 f1 fooProp_case_dep is transparent Expands to: Constant SchemeNames.fooProp_case_dep File "./output/SchemeNames.v", line 91, characters 2-40: The command has indeed failed with message: Incorrect elimination in the inductive type "fooProp": the return type has sort "Set" while it should be SProp or Prop. Elimination of an inductive object of sort Prop is not allowed on a predicate in sort "Set" because proofs can be eliminated only to build proofs. File "./output/SchemeNames.v", line 92, characters 2-41: The command has indeed failed with message: Incorrect elimination in the inductive type "fooProp": the return type has sort "Type" while it should be SProp or Prop. Elimination of an inductive object of sort Prop is not allowed on a predicate in sort "Type" because proofs can be eliminated only to build proofs. fooProp_cases : forall P : SProp, P -> P -> fooProp -> P fooProp_cases is not universe polymorphic Arguments fooProp_cases P%type_scope f f0 f1 fooProp_cases is transparent Expands to: Constant SchemeNames.fooProp_cases fooProp_case : forall P : Prop, P -> P -> fooProp -> P fooProp_case is not universe polymorphic Arguments fooProp_case P%type_scope f f0 f1 fooProp_case is transparent Expands to: Constant SchemeNames.fooProp_case File "./output/SchemeNames.v", line 99, characters 2-35: The command has indeed failed with message: Cannot extract computational content from proposition "fooProp". fooSet_inds : forall P : fooSet -> SProp, P aS -> P bS -> forall f1 : fooSet, P f1 fooSet_inds is not universe polymorphic Arguments fooSet_inds P%function_scope f f0 f1 fooSet_inds is transparent Expands to: Constant SchemeNames.fooSet_inds fooSet_ind : forall P : fooSet -> Prop, P aS -> P bS -> forall f1 : fooSet, P f1 fooSet_ind is not universe polymorphic Arguments fooSet_ind P%function_scope f f0 f1 fooSet_ind is transparent Expands to: Constant SchemeNames.fooSet_ind fooSet_rec : forall P : fooSet -> Set, P aS -> P bS -> forall f1 : fooSet, P f1 fooSet_rec is not universe polymorphic Arguments fooSet_rec P%function_scope f f0 f1 fooSet_rec is transparent Expands to: Constant SchemeNames.fooSet_rec fooSet_rect : forall P : fooSet -> Type, P aS -> P bS -> forall f1 : fooSet, P f1 fooSet_rect is not universe polymorphic Arguments fooSet_rect P%function_scope f f0 f1 fooSet_rect is transparent Expands to: Constant SchemeNames.fooSet_rect fooSet_inds_nodep : forall P : SProp, P -> P -> fooSet -> P fooSet_inds_nodep is not universe polymorphic Arguments fooSet_inds_nodep P%type_scope f f0 f1 fooSet_inds_nodep is transparent Expands to: Constant SchemeNames.fooSet_inds_nodep fooSet_ind_nodep : forall P : Prop, P -> P -> fooSet -> P fooSet_ind_nodep is not universe polymorphic Arguments fooSet_ind_nodep P%type_scope f f0 f1 fooSet_ind_nodep is transparent Expands to: Constant SchemeNames.fooSet_ind_nodep fooSet_rec_nodep : forall P : Set, P -> P -> fooSet -> P fooSet_rec_nodep is not universe polymorphic Arguments fooSet_rec_nodep P%type_scope f f0 f1 fooSet_rec_nodep is transparent Expands to: Constant SchemeNames.fooSet_rec_nodep fooSet_rect_nodep : forall P : Type, P -> P -> fooSet -> P fooSet_rect_nodep is not universe polymorphic Arguments fooSet_rect_nodep P%type_scope f f0 f1 fooSet_rect_nodep is transparent Expands to: Constant SchemeNames.fooSet_rect_nodep fooSet_cases : forall P : fooSet -> SProp, P aS -> P bS -> forall f1 : fooSet, P f1 fooSet_cases is not universe polymorphic Arguments fooSet_cases P%function_scope f f0 f1 fooSet_cases is transparent Expands to: Constant SchemeNames.fooSet_cases fooSet_case : forall P : fooSet -> Prop, P aS -> P bS -> forall f1 : fooSet, P f1 fooSet_case is not universe polymorphic Arguments fooSet_case P%function_scope f f0 f1 fooSet_case is transparent Expands to: Constant SchemeNames.fooSet_case fooSet'_case : forall P : fooSet' -> Set, P aS' -> P bS' -> forall f1 : fooSet', P f1 fooSet'_case is not universe polymorphic Arguments fooSet'_case P%function_scope f f0 f1 fooSet'_case is transparent Expands to: Constant SchemeNames.fooSet'_case fooSet'_caset : forall P : fooSet' -> Type, P aS' -> P bS' -> forall f1 : fooSet', P f1 fooSet'_caset is not universe polymorphic Arguments fooSet'_caset P%function_scope f f0 f1 fooSet'_caset is transparent Expands to: Constant SchemeNames.fooSet'_caset fooSet_cases_nodep : forall P : SProp, P -> P -> fooSet -> P fooSet_cases_nodep is not universe polymorphic Arguments fooSet_cases_nodep P%type_scope f f0 f1 fooSet_cases_nodep is transparent Expands to: Constant SchemeNames.fooSet_cases_nodep fooSet_case_nodep : forall P : Prop, P -> P -> fooSet -> P fooSet_case_nodep is not universe polymorphic Arguments fooSet_case_nodep P%type_scope f f0 f1 fooSet_case_nodep is transparent Expands to: Constant SchemeNames.fooSet_case_nodep fooSet'_case_nodep : forall P : Set, P -> P -> fooSet' -> P fooSet'_case_nodep is not universe polymorphic Arguments fooSet'_case_nodep P%type_scope f f0 f1 fooSet'_case_nodep is transparent Expands to: Constant SchemeNames.fooSet'_case_nodep fooSet'_caset_nodep : forall P : Type, P -> P -> fooSet' -> P fooSet'_caset_nodep is not universe polymorphic Arguments fooSet'_caset_nodep P%type_scope f f0 f1 fooSet'_caset_nodep is transparent Expands to: Constant SchemeNames.fooSet'_caset_nodep fooSet_beq : fooSet -> fooSet -> bool fooSet_beq is not universe polymorphic Arguments fooSet_beq X Y fooSet_beq is transparent Expands to: Constant SchemeNames.fooSet_beq fooSet_eq_dec : forall x y : fooSet, {x = y} + {x <> y} fooSet_eq_dec is not universe polymorphic Arguments fooSet_eq_dec x y fooSet_eq_dec is transparent Expands to: Constant SchemeNames.fooSet_eq_dec internal_fooSet_dec_bl : forall x : fooSet, (fun x0 : fooSet => forall y : fooSet, fooSet_beq x0 y = true -> x0 = y) x internal_fooSet_dec_bl is not universe polymorphic Arguments internal_fooSet_dec_bl x y _ internal_fooSet_dec_bl is transparent Expands to: Constant SchemeNames.internal_fooSet_dec_bl internal_fooSet_dec_lb : forall x : fooSet, (fun x0 : fooSet => forall y : fooSet, x0 = y -> fooSet_beq x0 y = true) x internal_fooSet_dec_lb is not universe polymorphic Arguments internal_fooSet_dec_lb x y _ internal_fooSet_dec_lb is transparent Expands to: Constant SchemeNames.internal_fooSet_dec_lb fooType_inds : forall P : fooType -> SProp, P aT -> P bT -> forall f1 : fooType, P f1 fooType_inds is not universe polymorphic Arguments fooType_inds P%function_scope f f0 f1 fooType_inds is transparent Expands to: Constant SchemeNames.fooType_inds fooType_ind : forall P : fooType -> Prop, P aT -> P bT -> forall f1 : fooType, P f1 fooType_ind is not universe polymorphic Arguments fooType_ind P%function_scope f f0 f1 fooType_ind is transparent Expands to: Constant SchemeNames.fooType_ind fooType_rec : forall P : fooType -> Set, P aT -> P bT -> forall f1 : fooType, P f1 fooType_rec is not universe polymorphic Arguments fooType_rec P%function_scope f f0 f1 fooType_rec is transparent Expands to: Constant SchemeNames.fooType_rec fooType_rect : forall P : fooType -> Type, P aT -> P bT -> forall f1 : fooType, P f1 fooType_rect is not universe polymorphic Arguments fooType_rect P%function_scope f f0 f1 fooType_rect is transparent Expands to: Constant SchemeNames.fooType_rect fooType_inds_nodep : forall P : SProp, P -> P -> fooType -> P fooType_inds_nodep is not universe polymorphic Arguments fooType_inds_nodep P%type_scope f f0 f1 fooType_inds_nodep is transparent Expands to: Constant SchemeNames.fooType_inds_nodep fooType_ind_nodep : forall P : Prop, P -> P -> fooType -> P fooType_ind_nodep is not universe polymorphic Arguments fooType_ind_nodep P%type_scope f f0 f1 fooType_ind_nodep is transparent Expands to: Constant SchemeNames.fooType_ind_nodep fooType_rec_nodep : forall P : Set, P -> P -> fooType -> P fooType_rec_nodep is not universe polymorphic Arguments fooType_rec_nodep P%type_scope f f0 f1 fooType_rec_nodep is transparent Expands to: Constant SchemeNames.fooType_rec_nodep fooType_rect_nodep : forall P : Type, P -> P -> fooType -> P fooType_rect_nodep is not universe polymorphic Arguments fooType_rect_nodep P%type_scope f f0 f1 fooType_rect_nodep is transparent Expands to: Constant SchemeNames.fooType_rect_nodep fooType_cases : forall P : fooType -> SProp, P aT -> P bT -> forall f1 : fooType, P f1 fooType_cases is not universe polymorphic Arguments fooType_cases P%function_scope f f0 f1 fooType_cases is transparent Expands to: Constant SchemeNames.fooType_cases fooType_case : forall P : fooType -> Prop, P aT -> P bT -> forall f1 : fooType, P f1 fooType_case is not universe polymorphic Arguments fooType_case P%function_scope f f0 f1 fooType_case is transparent Expands to: Constant SchemeNames.fooType_case fooType'_case : forall P : fooType' -> Set, P aT' -> P bT' -> forall f1 : fooType', P f1 fooType'_case is not universe polymorphic Arguments fooType'_case P%function_scope f f0 f1 fooType'_case is transparent Expands to: Constant SchemeNames.fooType'_case fooType'_caset : forall P : fooType' -> Type, P aT' -> P bT' -> forall f1 : fooType', P f1 fooType'_caset is not universe polymorphic Arguments fooType'_caset P%function_scope f f0 f1 fooType'_caset is transparent Expands to: Constant SchemeNames.fooType'_caset fooType_cases_nodep : forall P : SProp, P -> P -> fooType -> P fooType_cases_nodep is not universe polymorphic Arguments fooType_cases_nodep P%type_scope f f0 f1 fooType_cases_nodep is transparent Expands to: Constant SchemeNames.fooType_cases_nodep fooType_case_nodep : forall P : Prop, P -> P -> fooType -> P fooType_case_nodep is not universe polymorphic Arguments fooType_case_nodep P%type_scope f f0 f1 fooType_case_nodep is transparent Expands to: Constant SchemeNames.fooType_case_nodep fooType'_case_nodep : forall P : Set, P -> P -> fooType' -> P fooType'_case_nodep is not universe polymorphic Arguments fooType'_case_nodep P%type_scope f f0 f1 fooType'_case_nodep is transparent Expands to: Constant SchemeNames.fooType'_case_nodep fooType'_caset_nodep : forall P : Type, P -> P -> fooType' -> P fooType'_caset_nodep is not universe polymorphic Arguments fooType'_caset_nodep P%type_scope f f0 f1 fooType'_caset_nodep is transparent Expands to: Constant SchemeNames.fooType'_caset_nodep fooType_beq : fooType -> fooType -> bool fooType_beq is not universe polymorphic Arguments fooType_beq X Y fooType_beq is transparent Expands to: Constant SchemeNames.fooType_beq fooType_eq_dec : forall x y : fooType, {x = y} + {x <> y} fooType_eq_dec is not universe polymorphic Arguments fooType_eq_dec x y fooType_eq_dec is transparent Expands to: Constant SchemeNames.fooType_eq_dec internal_fooType_dec_bl : forall x : fooType, (fun x0 : fooType => forall y : fooType, fooType_beq x0 y = true -> x0 = y) x internal_fooType_dec_bl is not universe polymorphic Arguments internal_fooType_dec_bl x y _ internal_fooType_dec_bl is transparent Expands to: Constant SchemeNames.internal_fooType_dec_bl internal_fooType_dec_lb : forall x : fooType, (fun x0 : fooType => forall y : fooType, x0 = y -> fooType_beq x0 y = true) x internal_fooType_dec_lb is not universe polymorphic Arguments internal_fooType_dec_lb x y _ internal_fooType_dec_lb is transparent Expands to: Constant SchemeNames.internal_fooType_dec_lb F_rect : forall (f : Type) (P : F f -> Type), (forall f0 : f, P (C f f0)) -> forall f1 : F f, P f1 F_rect is not universe polymorphic Arguments F_rect f%type_scope (P f0)%function_scope f1 F_rect is transparent Expands to: Constant SchemeNames.F_rect PP_rect : forall (P : Type) (P0 : PP P -> Type), (forall p : P, P0 (D P p)) -> forall p : PP P, P0 p PP_rect is not universe polymorphic Arguments PP_rect P%type_scope (P0 f)%function_scope p PP_rect is transparent Expands to: Constant SchemeNames.PP_rect coq-8.20.0/test-suite/output/SchemeNames.v000066400000000000000000000155671466560755400204500ustar00rootroot00000000000000Unset Elimination Schemes. (** In this file we test the generation and naming of elimination schemes. *) (** * Schemes for inductive SProp *) (** Here is an inductive SProp. *) Inductive fooSProp : SProp := aSP | bSP. (** ** Try Induction into all Sorts *) Scheme Induction for fooSProp Sort SProp. (* fooSProp_inds *) Fail Scheme Induction for fooSProp Sort Prop. Fail Scheme Induction for fooSProp Sort Set. Fail Scheme Induction for fooSProp Sort Type. About fooSProp_inds. (** ** Try Minimality into all Sorts *) Scheme Minimality for fooSProp Sort SProp. (* fooSProp_inds_nodep *) Fail Scheme Minimality for fooSProp Sort Prop. Fail Scheme Minimality for fooSProp Sort Set. Fail Scheme Minimality for fooSProp Sort Type. About fooSProp_inds_nodep. (** ** Try Elimination into all Sorts *) Scheme Elimination for fooSProp Sort SProp. (* fooSProp_cases *) Fail Scheme Elimination for fooSProp Sort Prop. Fail Scheme Elimination for fooSProp Sort Set. Fail Scheme Elimination for fooSProp Sort Type. About fooSProp_cases. (** ** Try Case into all Sorts *) Scheme Case for fooSProp Sort SProp. (* fooSProp_cases_nodep *) Fail Scheme Case for fooSProp Sort Prop. Fail Scheme Case for fooSProp Sort Set. Fail Scheme Case for fooSProp Sort Type. About fooSProp_cases_nodep. (** ** Scheme Equality *) Fail Scheme Equality for fooSProp. (** * Schemes for inductive Prop *) (** Here is an inductive Prop. *) Inductive fooProp : Prop := aP | bP. (** ** Try Induction into all Sorts *) Scheme Induction for fooProp Sort SProp. (* fooProp_inds_dep *) Scheme Induction for fooProp Sort Prop. (* fooProp_ind_dep *) Fail Scheme Induction for fooProp Sort Set. Fail Scheme Induction for fooProp Sort Type. About fooProp_inds_dep. About fooProp_ind_dep. (** ** Try Minimality into all Sorts *) Scheme Minimality for fooProp Sort SProp. (* fooProp_inds *) Scheme Minimality for fooProp Sort Prop. (* fooProp_ind *) Fail Scheme Minimality for fooProp Sort Set. Fail Scheme Minimality for fooProp Sort Type. About fooProp_inds. About fooProp_ind. (** ** Try Elimination into all Sorts *) Scheme Elimination for fooProp Sort SProp. (* fooProp_cases_dep *) Scheme Elimination for fooProp Sort Prop. (* fooProp_case_dep *) Fail Scheme Elimination for fooProp Sort Set. Fail Scheme Elimination for fooProp Sort Type. About fooProp_cases_dep. About fooProp_case_dep. (** ** Try Case into all Sorts *) Scheme Case for fooProp Sort SProp. (* fooProp_cases *) Scheme Case for fooProp Sort Prop. (* fooProp_case *) Fail Scheme Case for fooProp Sort Set. Fail Scheme Case for fooProp Sort Type. About fooProp_cases. About fooProp_case. (** ** Scheme Equality *) Fail Scheme Equality for fooProp. (** * Schemes for inductive Set *) (** Here is an inductive Set. *) Inductive fooSet : Set := aS | bS. (** ** Try Induction into all Sorts *) Scheme Induction for fooSet Sort SProp. (* fooSet_inds *) Scheme Induction for fooSet Sort Prop. (* fooSet_ind *) Scheme Induction for fooSet Sort Set. (* fooSet_rec *) Scheme Induction for fooSet Sort Type. (* fooSet_rect *) About fooSet_inds. About fooSet_ind. About fooSet_rec. About fooSet_rect. (** ** Try Minimality into all Sorts *) Scheme Minimality for fooSet Sort SProp. (* fooSet_inds_nodep *) Scheme Minimality for fooSet Sort Prop. (* fooSet_ind_nodep *) Scheme Minimality for fooSet Sort Set. (* fooSet_rec_nodep *) Scheme Minimality for fooSet Sort Type. (* fooSet_rect_nodep *) About fooSet_inds_nodep. About fooSet_ind_nodep. About fooSet_rec_nodep. About fooSet_rect_nodep. (** ** Try Elimination into all Sorts *) (** Unforunately there is some overlap with names so we need to create a fresh inductive. *) Inductive fooSet' : Set := aS' | bS'. Scheme Elimination for fooSet Sort SProp. (* fooSet_cases *) Scheme Elimination for fooSet Sort Prop. (* fooSet_case *) Scheme Elimination for fooSet' Sort Set. (* fooSet'_case *) Scheme Elimination for fooSet' Sort Type. (* fooSet'_caset *) About fooSet_cases. About fooSet_case. About fooSet'_case. About fooSet'_caset. (** ** Try Case into all Sorts *) Scheme Case for fooSet Sort SProp. (* fooSet_cases_nodep *) Scheme Case for fooSet Sort Prop. (* fooSet_case_nodep *) Scheme Case for fooSet' Sort Set. (* fooSet'_case_nodep *) Scheme Case for fooSet' Sort Type. (* fooSet'_caset_nodep *) About fooSet_cases_nodep. About fooSet_case_nodep. About fooSet'_case_nodep. About fooSet'_caset_nodep. (** ** Scheme Equality *) Scheme Equality for fooSet. About fooSet_beq. About fooSet_eq_dec. About internal_fooSet_dec_bl. About internal_fooSet_dec_lb. (** * Schemes for inductive Type *) (** Here is an inductive Type. *) Inductive fooType : Type := aT | bT. (** ** Try Induction into all Sorts *) Scheme Induction for fooType Sort SProp. (* fooType_inds *) Scheme Induction for fooType Sort Prop. (* fooType_ind *) Scheme Induction for fooType Sort Set. (* fooType_rec *) Scheme Induction for fooType Sort Type. (* fooType_rect *) About fooType_inds. About fooType_ind. About fooType_rec. About fooType_rect. (** ** Try Minimality into all Sorts *) Scheme Minimality for fooType Sort SProp. (* fooType_inds_nodep *) Scheme Minimality for fooType Sort Prop. (* fooType_ind_nodep *) Scheme Minimality for fooType Sort Set. (* fooType_rec_nodep *) Scheme Minimality for fooType Sort Type. (* fooType_rect_nodep *) About fooType_inds_nodep. About fooType_ind_nodep. About fooType_rec_nodep. About fooType_rect_nodep. (** ** Try Elimination into all Sorts *) (** Unforunately there is some overlap with names so we need to create a fresh inductive. *) Inductive fooType' : Type := aT' | bT'. Scheme Elimination for fooType Sort SProp. (* fooType_cases *) Scheme Elimination for fooType Sort Prop. (* fooType_case *) Scheme Elimination for fooType' Sort Set. (* fooType'_case *) Scheme Elimination for fooType' Sort Type. (* fooType'_caset *) About fooType_cases. About fooType_case. About fooType'_case. About fooType'_caset. (** ** Try Case into all Sorts *) Scheme Case for fooType Sort SProp. (* fooType_cases_nodep *) Scheme Case for fooType Sort Prop. (* fooType_case_nodep *) Scheme Case for fooType' Sort Set. (* fooType'_case_nodep *) Scheme Case for fooType' Sort Type. (* fooType'_caset_nodep *) About fooType_cases_nodep. About fooType_case_nodep. About fooType'_case_nodep. About fooType'_caset_nodep. (** ** Scheme Equality *) Scheme Equality for fooType. About fooType_beq. About fooType_eq_dec. About internal_fooType_dec_bl. About internal_fooType_dec_lb. Set Elimination Schemes. Inductive F f := C : f -> F f. About F_rect. Inductive PP P := D : P -> PP P. About PP_rect. coq-8.20.0/test-suite/output/Search.out000066400000000000000000000306471466560755400200230ustar00rootroot00000000000000le_n: forall n : nat, n <= n le_0_n: forall n : nat, 0 <= n le_S: forall n m : nat, n <= m -> n <= S m le_S_n: forall n m : nat, S n <= S m -> n <= m le_pred: forall n m : nat, n <= m -> Nat.pred n <= Nat.pred m le_n_S: forall n m : nat, n <= m -> S n <= S m max_l: forall n m : nat, m <= n -> Nat.max n m = n max_r: forall n m : nat, n <= m -> Nat.max n m = m min_r: forall n m : nat, m <= n -> Nat.min n m = m min_l: forall n m : nat, n <= m -> Nat.min n m = n le_ind: forall (n : nat) (P : nat -> Prop), P n -> (forall m : nat, n <= m -> P m -> P (S m)) -> forall n0 : nat, n <= n0 -> P n0 le_sind: forall (n : nat) (P : nat -> SProp), P n -> (forall m : nat, n <= m -> P m -> P (S m)) -> forall n0 : nat, n <= n0 -> P n0 false: bool true: bool is_true: bool -> Prop eq_true: bool -> Prop negb: bool -> bool xorb: bool -> bool -> bool andb: bool -> bool -> bool orb: bool -> bool -> bool implb: bool -> bool -> bool Nat.odd: nat -> bool Nat.even: nat -> bool BoolSpec: Prop -> Prop -> bool -> Prop Number.number_beq: Number.number -> Number.number -> bool Nat.eqb: nat -> nat -> bool Nat.testbit: nat -> nat -> bool Decimal.decimal_beq: Decimal.decimal -> Decimal.decimal -> bool Number.uint_beq: Number.uint -> Number.uint -> bool Decimal.uint_beq: Decimal.uint -> Decimal.uint -> bool Hexadecimal.hexadecimal_beq: Hexadecimal.hexadecimal -> Hexadecimal.hexadecimal -> bool Number.signed_int_beq: Number.signed_int -> Number.signed_int -> bool Hexadecimal.uint_beq: Hexadecimal.uint -> Hexadecimal.uint -> bool Nat.ltb: nat -> nat -> bool Nat.leb: nat -> nat -> bool Hexadecimal.signed_int_beq: Hexadecimal.signed_int -> Hexadecimal.signed_int -> bool Decimal.signed_int_beq: Decimal.signed_int -> Decimal.signed_int -> bool Nat.bitwise: (bool -> bool -> bool) -> nat -> nat -> nat -> nat eq_true_rec_r: forall (P : bool -> Set) [b : bool], P b -> eq_true b -> P true eq_true_ind: forall P : bool -> Prop, P true -> forall [b : bool], eq_true b -> P b bool_rec: forall P : bool -> Set, P true -> P false -> forall b : bool, P b eq_true_rect_r: forall (P : bool -> Type) [b : bool], P b -> eq_true b -> P true bool_rect: forall P : bool -> Type, P true -> P false -> forall b : bool, P b eq_true_ind_r: forall (P : bool -> Prop) [b : bool], P b -> eq_true b -> P true eq_true_rect: forall P : bool -> Type, P true -> forall [b : bool], eq_true b -> P b bool_sind: forall P : bool -> SProp, P true -> P false -> forall b : bool, P b eq_true_rec: forall P : bool -> Set, P true -> forall [b : bool], eq_true b -> P b bool_ind: forall P : bool -> Prop, P true -> P false -> forall b : bool, P b eq_true_sind: forall P : bool -> SProp, P true -> forall [b : bool], eq_true b -> P b Number.internal_uint_dec_bl1: forall x y : Number.uint, Number.uint_beq x y = true -> x = y Hexadecimal.internal_hexadecimal_dec_lb: forall x y : Hexadecimal.hexadecimal, x = y -> Hexadecimal.hexadecimal_beq x y = true Hexadecimal.internal_signed_int_dec_lb0: forall x y : Hexadecimal.signed_int, x = y -> Hexadecimal.signed_int_beq x y = true Number.internal_number_dec_lb: forall x y : Number.number, x = y -> Number.number_beq x y = true Decimal.internal_decimal_dec_lb: forall x y : Decimal.decimal, x = y -> Decimal.decimal_beq x y = true Hexadecimal.internal_signed_int_dec_bl0: forall x y : Hexadecimal.signed_int, Hexadecimal.signed_int_beq x y = true -> x = y Number.internal_signed_int_dec_lb1: forall x y : Number.signed_int, x = y -> Number.signed_int_beq x y = true Number.internal_signed_int_dec_bl1: forall x y : Number.signed_int, Number.signed_int_beq x y = true -> x = y Hexadecimal.internal_hexadecimal_dec_bl: forall x y : Hexadecimal.hexadecimal, Hexadecimal.hexadecimal_beq x y = true -> x = y Number.internal_uint_dec_lb1: forall x y : Number.uint, x = y -> Number.uint_beq x y = true Decimal.internal_signed_int_dec_bl: forall x y : Decimal.signed_int, Decimal.signed_int_beq x y = true -> x = y Decimal.internal_signed_int_dec_lb: forall x y : Decimal.signed_int, x = y -> Decimal.signed_int_beq x y = true Number.internal_number_dec_bl: forall x y : Number.number, Number.number_beq x y = true -> x = y Byte.of_bits: bool * (bool * (bool * (bool * (bool * (bool * (bool * bool)))))) -> Byte.byte Byte.to_bits: Byte.byte -> bool * (bool * (bool * (bool * (bool * (bool * (bool * bool)))))) Decimal.internal_decimal_dec_bl: forall x y : Decimal.decimal, Decimal.decimal_beq x y = true -> x = y Hexadecimal.internal_uint_dec_bl0: forall x : Hexadecimal.uint, (fun x0 : Hexadecimal.uint => forall y : Hexadecimal.uint, Hexadecimal.uint_beq x0 y = true -> x0 = y) x Decimal.internal_uint_dec_bl: forall x : Decimal.uint, (fun x0 : Decimal.uint => forall y : Decimal.uint, Decimal.uint_beq x0 y = true -> x0 = y) x Decimal.internal_uint_dec_lb: forall x : Decimal.uint, (fun x0 : Decimal.uint => forall y : Decimal.uint, x0 = y -> Decimal.uint_beq x0 y = true) x Hexadecimal.internal_uint_dec_lb0: forall x : Hexadecimal.uint, (fun x0 : Hexadecimal.uint => forall y : Hexadecimal.uint, x0 = y -> Hexadecimal.uint_beq x0 y = true) x andb_prop: forall a b : bool, (a && b)%bool = true -> a = true /\ b = true andb_true_intro: forall [b1 b2 : bool], b1 = true /\ b2 = true -> (b1 && b2)%bool = true BoolSpec_ind: forall [P Q : Prop] (P0 : bool -> Prop), (P -> P0 true) -> (Q -> P0 false) -> forall [b : bool], BoolSpec P Q b -> P0 b BoolSpec_sind: forall [P Q : Prop] (P0 : bool -> SProp), (P -> P0 true) -> (Q -> P0 false) -> forall [b : bool], BoolSpec P Q b -> P0 b Byte.to_bits_of_bits: forall b : bool * (bool * (bool * (bool * (bool * (bool * (bool * bool)))))), Byte.to_bits (Byte.of_bits b) = b bool_choice: forall [S : Set] [R1 R2 : S -> Prop], (forall x : S, {R1 x} + {R2 x}) -> {f : S -> bool | forall x : S, f x = true /\ R1 x \/ f x = false /\ R2 x} mult_n_O: forall n : nat, 0 = n * 0 plus_O_n: forall n : nat, 0 + n = n plus_n_O: forall n : nat, n = n + 0 n_Sn: forall n : nat, n <> S n pred_Sn: forall n : nat, n = Nat.pred (S n) O_S: forall n : nat, 0 <> S n f_equal_pred: forall x y : nat, x = y -> Nat.pred x = Nat.pred y eq_S: forall x y : nat, x = y -> S x = S y eq_add_S: forall n m : nat, S n = S m -> n = m min_r: forall n m : nat, m <= n -> Nat.min n m = m min_l: forall n m : nat, n <= m -> Nat.min n m = n max_r: forall n m : nat, n <= m -> Nat.max n m = m max_l: forall n m : nat, m <= n -> Nat.max n m = n plus_Sn_m: forall n m : nat, S n + m = S (n + m) plus_n_Sm: forall n m : nat, S (n + m) = n + S m f_equal_nat: forall (B : Type) (f : nat -> B) (x y : nat), x = y -> f x = f y not_eq_S: forall n m : nat, n <> m -> S n <> S m mult_n_Sm: forall n m : nat, n * m + n = n * S m f_equal2_plus: forall x1 y1 x2 y2 : nat, x1 = y1 -> x2 = y2 -> x1 + x2 = y1 + y2 f_equal2_mult: forall x1 y1 x2 y2 : nat, x1 = y1 -> x2 = y2 -> x1 * x2 = y1 * y2 f_equal2_nat: forall (B : Type) (f : nat -> nat -> B) (x1 y1 x2 y2 : nat), x1 = y1 -> x2 = y2 -> f x1 x2 = f y1 y2 Number.internal_number_dec_lb: forall x y : Number.number, x = y -> Number.number_beq x y = true Number.internal_signed_int_dec_lb1: forall x y : Number.signed_int, x = y -> Number.signed_int_beq x y = true Number.internal_number_dec_bl: forall x y : Number.number, Number.number_beq x y = true -> x = y Hexadecimal.internal_hexadecimal_dec_lb: forall x y : Hexadecimal.hexadecimal, x = y -> Hexadecimal.hexadecimal_beq x y = true Number.internal_signed_int_dec_bl1: forall x y : Number.signed_int, Number.signed_int_beq x y = true -> x = y Number.internal_uint_dec_lb1: forall x y : Number.uint, x = y -> Number.uint_beq x y = true Number.internal_uint_dec_bl1: forall x y : Number.uint, Number.uint_beq x y = true -> x = y Decimal.internal_decimal_dec_lb: forall x y : Decimal.decimal, x = y -> Decimal.decimal_beq x y = true Hexadecimal.internal_hexadecimal_dec_bl: forall x y : Hexadecimal.hexadecimal, Hexadecimal.hexadecimal_beq x y = true -> x = y Hexadecimal.internal_signed_int_dec_lb0: forall x y : Hexadecimal.signed_int, x = y -> Hexadecimal.signed_int_beq x y = true Hexadecimal.internal_signed_int_dec_bl0: forall x y : Hexadecimal.signed_int, Hexadecimal.signed_int_beq x y = true -> x = y Decimal.internal_signed_int_dec_lb: forall x y : Decimal.signed_int, x = y -> Decimal.signed_int_beq x y = true Decimal.internal_decimal_dec_bl: forall x y : Decimal.decimal, Decimal.decimal_beq x y = true -> x = y Decimal.internal_signed_int_dec_bl: forall x y : Decimal.signed_int, Decimal.signed_int_beq x y = true -> x = y Decimal.internal_uint_dec_bl: forall x : Decimal.uint, (fun x0 : Decimal.uint => forall y : Decimal.uint, Decimal.uint_beq x0 y = true -> x0 = y) x Decimal.internal_uint_dec_lb: forall x : Decimal.uint, (fun x0 : Decimal.uint => forall y : Decimal.uint, x0 = y -> Decimal.uint_beq x0 y = true) x Hexadecimal.internal_uint_dec_lb0: forall x : Hexadecimal.uint, (fun x0 : Hexadecimal.uint => forall y : Hexadecimal.uint, x0 = y -> Hexadecimal.uint_beq x0 y = true) x Hexadecimal.internal_uint_dec_bl0: forall x : Hexadecimal.uint, (fun x0 : Hexadecimal.uint => forall y : Hexadecimal.uint, Hexadecimal.uint_beq x0 y = true -> x0 = y) x andb_prop: forall a b : bool, (a && b)%bool = true -> a = true /\ b = true andb_true_intro: forall [b1 b2 : bool], b1 = true /\ b2 = true -> (b1 && b2)%bool = true bool_choice: forall [S : Set] [R1 R2 : S -> Prop], (forall x : S, {R1 x} + {R2 x}) -> {f : S -> bool | forall x : S, f x = true /\ R1 x \/ f x = false /\ R2 x} Number.internal_number_dec_lb: forall x y : Number.number, x = y -> Number.number_beq x y = true Number.internal_number_dec_bl: forall x y : Number.number, Number.number_beq x y = true -> x = y Number.internal_signed_int_dec_lb1: forall x y : Number.signed_int, x = y -> Number.signed_int_beq x y = true Number.internal_signed_int_dec_bl1: forall x y : Number.signed_int, Number.signed_int_beq x y = true -> x = y Number.internal_uint_dec_lb1: forall x y : Number.uint, x = y -> Number.uint_beq x y = true Number.internal_uint_dec_bl1: forall x y : Number.uint, Number.uint_beq x y = true -> x = y Hexadecimal.internal_hexadecimal_dec_lb: forall x y : Hexadecimal.hexadecimal, x = y -> Hexadecimal.hexadecimal_beq x y = true Hexadecimal.internal_hexadecimal_dec_bl: forall x y : Hexadecimal.hexadecimal, Hexadecimal.hexadecimal_beq x y = true -> x = y Hexadecimal.internal_signed_int_dec_lb0: forall x y : Hexadecimal.signed_int, x = y -> Hexadecimal.signed_int_beq x y = true Hexadecimal.internal_signed_int_dec_bl0: forall x y : Hexadecimal.signed_int, Hexadecimal.signed_int_beq x y = true -> x = y Decimal.internal_decimal_dec_lb: forall x y : Decimal.decimal, x = y -> Decimal.decimal_beq x y = true Decimal.internal_decimal_dec_bl: forall x y : Decimal.decimal, Decimal.decimal_beq x y = true -> x = y Decimal.internal_signed_int_dec_lb: forall x y : Decimal.signed_int, x = y -> Decimal.signed_int_beq x y = true Decimal.internal_signed_int_dec_bl: forall x y : Decimal.signed_int, Decimal.signed_int_beq x y = true -> x = y Hexadecimal.internal_uint_dec_bl0: forall x : Hexadecimal.uint, (fun x0 : Hexadecimal.uint => forall y : Hexadecimal.uint, Hexadecimal.uint_beq x0 y = true -> x0 = y) x Decimal.internal_uint_dec_bl: forall x : Decimal.uint, (fun x0 : Decimal.uint => forall y : Decimal.uint, Decimal.uint_beq x0 y = true -> x0 = y) x Decimal.internal_uint_dec_lb: forall x : Decimal.uint, (fun x0 : Decimal.uint => forall y : Decimal.uint, x0 = y -> Decimal.uint_beq x0 y = true) x Hexadecimal.internal_uint_dec_lb0: forall x : Hexadecimal.uint, (fun x0 : Hexadecimal.uint => forall y : Hexadecimal.uint, x0 = y -> Hexadecimal.uint_beq x0 y = true) x andb_true_intro: forall [b1 b2 : bool], b1 = true /\ b2 = true -> (b1 && b2)%bool = true andb_prop: forall a b : bool, (a && b)%bool = true -> a = true /\ b = true andb_prop: forall a b : bool, (a && b)%bool = true -> a = true /\ b = true h: n <> newdef n h': newdef n <> n h: n <> newdef n h': newdef n <> n h: n <> newdef n h: n <> newdef n h: n <> newdef n h': newdef n <> n File "./output/Search.v", line 23, characters 2-23: The command has indeed failed with message: [Focus] No such goal. File "./output/Search.v", line 24, characters 2-25: The command has indeed failed with message: Query commands only support the single numbered goal selector. File "./output/Search.v", line 25, characters 2-25: The command has indeed failed with message: Query commands only support the single numbered goal selector. h: P n h': ~ P n h: P n h': ~ P n h: P n h': ~ P n h: P n h: P n a: A b: A coq-8.20.0/test-suite/output/Search.v000066400000000000000000000025531466560755400174540ustar00rootroot00000000000000(* Some tests of the Search command *) Search le. (* app nodes *) Search bool. (* no apps *) Search (@eq nat). (* complex pattern *) Search (@eq _ _ true). Search (@eq _ _ _) true -false. (* andb_prop *) Search (@eq _ _ _) true -false "prop" -"intro". (* andb_prop *) Definition newdef := fun x:nat => x. Goal forall n:nat, n <> newdef n -> newdef n <> n -> False. cut False. intros _ n h h'. Search n. (* search hypothesis *) Search newdef. (* search hypothesis *) Search ( _ <> newdef _). (* search hypothesis, pattern *) Search ( _ <> newdef _) -"h'". (* search hypothesis, pattern *) 1:Search newdef. 2:Search newdef. Fail 3:Search newdef. Fail 1-2:Search newdef. Fail all:Search newdef. Abort. Goal forall n (P:nat -> Prop), P n -> ~P n -> False. intros n P h h'. Search P. (* search hypothesis also for patterns *) Search (P _). (* search hypothesis also for patterns *) Search (P n). (* search hypothesis also for patterns *) Search (P _) -"h'". (* search hypothesis also for patterns *) Search (P _) -not. (* search hypothesis also for patterns *) Abort. Module M. Section S. Variable A:Type. Variable a:A. Theorem Thm (b:A) : True. Search A. (* Test search in hypotheses *) Abort. End S. End M. coq-8.20.0/test-suite/output/SearchFixpoint.out000066400000000000000000000000751466560755400215340ustar00rootroot00000000000000Foo.bar: nat -> nat Foo.from: nat -> Foo.Stream Foo.foo: nat coq-8.20.0/test-suite/output/SearchFixpoint.v000066400000000000000000000010301466560755400211620ustar00rootroot00000000000000(** Test file for #18983 *) (** We test that [Search] allows the [is:Fixpoint] and [is:CoFixpoint] search items while not changing [is:Definition]. *) Module Foo. Definition foo := 42. Fixpoint bar (n : nat) := match n with | 0 => 0 | S n => bar n end. (* Example shamelessly taken from the reference manual. *) CoInductive Stream := Seq : nat -> Stream -> Stream. CoFixpoint from (n : nat) := Seq n (from (S n)). End Foo. Search is:Fixpoint inside Foo. Search is:CoFixpoint inside Foo. Search is:Definition inside Foo. coq-8.20.0/test-suite/output/SearchPattern.out000066400000000000000000000065721466560755400213610ustar00rootroot00000000000000false: bool true: bool negb: bool -> bool xorb: bool -> bool -> bool andb: bool -> bool -> bool orb: bool -> bool -> bool implb: bool -> bool -> bool Nat.odd: nat -> bool Nat.even: nat -> bool Number.uint_beq: Number.uint -> Number.uint -> bool Nat.testbit: nat -> nat -> bool Nat.eqb: nat -> nat -> bool Hexadecimal.hexadecimal_beq: Hexadecimal.hexadecimal -> Hexadecimal.hexadecimal -> bool Nat.ltb: nat -> nat -> bool Nat.leb: nat -> nat -> bool Number.number_beq: Number.number -> Number.number -> bool Number.signed_int_beq: Number.signed_int -> Number.signed_int -> bool Hexadecimal.signed_int_beq: Hexadecimal.signed_int -> Hexadecimal.signed_int -> bool Hexadecimal.uint_beq: Hexadecimal.uint -> Hexadecimal.uint -> bool Decimal.decimal_beq: Decimal.decimal -> Decimal.decimal -> bool Decimal.signed_int_beq: Decimal.signed_int -> Decimal.signed_int -> bool Decimal.uint_beq: Decimal.uint -> Decimal.uint -> bool Nat.two: nat Nat.zero: nat Nat.one: nat O: nat Nat.double: nat -> nat Nat.sqrt: nat -> nat Nat.div2: nat -> nat Nat.log2: nat -> nat Nat.pred: nat -> nat Nat.square: nat -> nat S: nat -> nat Nat.succ: nat -> nat Nat.ldiff: nat -> nat -> nat Nat.add: nat -> nat -> nat Nat.land: nat -> nat -> nat Nat.lxor: nat -> nat -> nat Nat.sub: nat -> nat -> nat Nat.mul: nat -> nat -> nat Nat.tail_mul: nat -> nat -> nat Nat.max: nat -> nat -> nat Nat.tail_add: nat -> nat -> nat Nat.pow: nat -> nat -> nat Nat.min: nat -> nat -> nat Nat.modulo: nat -> nat -> nat Nat.div: nat -> nat -> nat Nat.lor: nat -> nat -> nat Nat.gcd: nat -> nat -> nat Hexadecimal.nb_digits: Hexadecimal.uint -> nat Nat.of_hex_uint: Hexadecimal.uint -> nat Nat.of_num_uint: Number.uint -> nat Nat.of_uint: Decimal.uint -> nat Decimal.nb_digits: Decimal.uint -> nat Nat.tail_addmul: nat -> nat -> nat -> nat Nat.of_hex_uint_acc: Hexadecimal.uint -> nat -> nat Nat.of_uint_acc: Decimal.uint -> nat -> nat Nat.sqrt_iter: nat -> nat -> nat -> nat -> nat Nat.log2_iter: nat -> nat -> nat -> nat -> nat length: forall [A : Type], list A -> nat Nat.bitwise: (bool -> bool -> bool) -> nat -> nat -> nat -> nat Nat.div2: nat -> nat Nat.sqrt: nat -> nat Nat.log2: nat -> nat Nat.double: nat -> nat S: nat -> nat Nat.square: nat -> nat Nat.succ: nat -> nat Nat.pred: nat -> nat Nat.land: nat -> nat -> nat Nat.max: nat -> nat -> nat Nat.gcd: nat -> nat -> nat Nat.modulo: nat -> nat -> nat Nat.ldiff: nat -> nat -> nat Nat.tail_add: nat -> nat -> nat Nat.pow: nat -> nat -> nat Nat.lxor: nat -> nat -> nat Nat.div: nat -> nat -> nat Nat.lor: nat -> nat -> nat Nat.mul: nat -> nat -> nat Nat.min: nat -> nat -> nat Nat.add: nat -> nat -> nat Nat.sub: nat -> nat -> nat Nat.tail_mul: nat -> nat -> nat Nat.tail_addmul: nat -> nat -> nat -> nat Nat.of_uint_acc: Decimal.uint -> nat -> nat Nat.of_hex_uint_acc: Hexadecimal.uint -> nat -> nat Nat.sqrt_iter: nat -> nat -> nat -> nat -> nat Nat.log2_iter: nat -> nat -> nat -> nat -> nat Nat.bitwise: (bool -> bool -> bool) -> nat -> nat -> nat -> nat mult_n_Sm: forall n m : nat, n * m + n = n * S m iff_refl: forall A : Prop, A <-> A le_n: forall n : nat, n <= n eq_refl: forall {A : Type} {x : A}, x = x Nat.divmod: nat -> nat -> nat -> nat -> nat * nat (use "About" for full details on the implicit arguments of eq_refl) conj: forall [A B : Prop], A -> B -> A /\ B pair: forall {A B : Type}, A -> B -> A * B Nat.divmod: nat -> nat -> nat -> nat -> nat * nat h: n <> newdef n h: n <> newdef n h: P n h': ~ P n h: P n h: P n coq-8.20.0/test-suite/output/SearchPattern.v000066400000000000000000000017531466560755400210130ustar00rootroot00000000000000(* Some tests of the SearchPattern command *) (* Simple, random tests *) SearchPattern bool. SearchPattern nat. SearchPattern le. (* With some hypothesis *) SearchPattern (nat -> nat). SearchPattern (?n * ?m + ?n = ?n * S ?m). (* Non-linearity *) SearchPattern (_ ?X ?X). (* Non-linearity with hypothesis *) SearchPattern (forall (x:?A) (y:?B), _ ?A ?B). (* No delta-reduction *) SearchPattern (Exc _). Definition newdef := fun x:nat => x. Goal forall n:nat, n <> newdef n -> False. intros n h. SearchPattern ( _ <> newdef _). (* search hypothesis *) SearchPattern ( n <> newdef _). (* search hypothesis *) Abort. Goal forall n (P:nat -> Prop), P n -> ~P n -> False. intros n P h h'. SearchPattern (P _). (* search hypothesis also for patterns *) Search (~P n). (* search hypothesis also for patterns *) Search (P _) -"h'". (* search hypothesis also for patterns *) Search (P _) -not. (* search hypothesis also for patterns *) Abort. coq-8.20.0/test-suite/output/SearchRewrite.out000066400000000000000000000001701466560755400213510ustar00rootroot00000000000000plus_n_O: forall n : nat, n = n + 0 plus_O_n: forall n : nat, 0 + n = n h: n = newdef n h: n = newdef n h: n = newdef n coq-8.20.0/test-suite/output/SearchRewrite.v000066400000000000000000000006001466560755400210050ustar00rootroot00000000000000(* Some tests of the SearchRewrite command *) SearchRewrite (_+0). (* left *) SearchRewrite (0+_). (* right *) Definition newdef := fun x:nat => x. Goal forall n:nat, n = newdef n -> False. intros n h. SearchRewrite (newdef _). SearchRewrite n. (* use hypothesis for patterns *) SearchRewrite (newdef n). (* use hypothesis for patterns *) Abort. coq-8.20.0/test-suite/output/SearchScheme.out000066400000000000000000000012501466560755400211340ustar00rootroot00000000000000nat_sind: forall P : nat -> SProp, P 0 -> (forall n : nat, P n -> P (S n)) -> forall n : nat, P n nat_rec: forall P : nat -> Set, P 0 -> (forall n : nat, P n -> P (S n)) -> forall n : nat, P n nat_ind: forall P : nat -> Prop, P 0 -> (forall n : nat, P n -> P (S n)) -> forall n : nat, P n nat_rect: forall P : nat -> Type, P 0 -> (forall n : nat, P n -> P (S n)) -> forall n : nat, P n le_ind: forall (n : nat) (P : nat -> Prop), P n -> (forall m : nat, n <= m -> P m -> P (S m)) -> forall n0 : nat, n <= n0 -> P n0 le_sind: forall (n : nat) (P : nat -> SProp), P n -> (forall m : nat, n <= m -> P m -> P (S m)) -> forall n0 : nat, n <= n0 -> P n0 coq-8.20.0/test-suite/output/SearchScheme.v000066400000000000000000000000721466560755400205730ustar00rootroot00000000000000Search nat is:Scheme. (* was "le : nat -> nat -> Prop" *) coq-8.20.0/test-suite/output/Search_2.out000066400000000000000000000150351466560755400202360ustar00rootroot00000000000000or_assoc: forall A B C : Prop, (A \/ B) \/ C <-> A \/ B \/ C and_assoc: forall A B C : Prop, (A /\ B) /\ C <-> A /\ B /\ C eq_trans_assoc: forall [A : Type] [x y z t : A] (e : x = y) (e' : y = z) (e'' : z = t), eq_trans e (eq_trans e' e'') = eq_trans (eq_trans e e') e'' plus_O_n: forall n : nat, 0 + n = n plus_n_O: forall n : nat, n = n + 0 plus_n_Sm: forall n m : nat, S (n + m) = n + S m plus_Sn_m: forall n m : nat, S n + m = S (n + m) mult_n_Sm: forall n m : nat, n * m + n = n * S m f_equal2_plus: forall x1 y1 x2 y2 : nat, x1 = y1 -> x2 = y2 -> x1 + x2 = y1 + y2 nat_rect_plus: forall (n m : nat) {A : Type} (f : A -> A) (x : A), nat_rect (fun _ : nat => A) x (fun _ : nat => f) (n + m) = nat_rect (fun _ : nat => A) (nat_rect (fun _ : nat => A) x (fun _ : nat => f) m) (fun _ : nat => f) n Nat.bitwise: (bool -> bool -> bool) -> nat -> nat -> nat -> nat Number.internal_number_dec_bl: forall x y : Number.number, Number.number_beq x y = true -> x = y Number.internal_signed_int_dec_bl1: forall x y : Number.signed_int, Number.signed_int_beq x y = true -> x = y Number.internal_uint_dec_bl1: forall x y : Number.uint, Number.uint_beq x y = true -> x = y Hexadecimal.internal_hexadecimal_dec_bl: forall x y : Hexadecimal.hexadecimal, Hexadecimal.hexadecimal_beq x y = true -> x = y Hexadecimal.internal_signed_int_dec_bl0: forall x y : Hexadecimal.signed_int, Hexadecimal.signed_int_beq x y = true -> x = y Decimal.internal_decimal_dec_bl: forall x y : Decimal.decimal, Decimal.decimal_beq x y = true -> x = y Decimal.internal_signed_int_dec_bl: forall x y : Decimal.signed_int, Decimal.signed_int_beq x y = true -> x = y Byte.of_bits: bool * (bool * (bool * (bool * (bool * (bool * (bool * bool)))))) -> Byte.byte Byte.to_bits_of_bits: forall b : bool * (bool * (bool * (bool * (bool * (bool * (bool * bool)))))), Byte.to_bits (Byte.of_bits b) = b Number.internal_number_dec_lb: forall x y : Number.number, x = y -> Number.number_beq x y = true Number.internal_uint_dec_lb1: forall x y : Number.uint, x = y -> Number.uint_beq x y = true Number.internal_signed_int_dec_lb1: forall x y : Number.signed_int, x = y -> Number.signed_int_beq x y = true Decimal.internal_signed_int_dec_lb: forall x y : Decimal.signed_int, x = y -> Decimal.signed_int_beq x y = true Hexadecimal.internal_hexadecimal_dec_lb: forall x y : Hexadecimal.hexadecimal, x = y -> Hexadecimal.hexadecimal_beq x y = true Hexadecimal.internal_signed_int_dec_lb0: forall x y : Hexadecimal.signed_int, x = y -> Hexadecimal.signed_int_beq x y = true Decimal.internal_decimal_dec_lb: forall x y : Decimal.decimal, x = y -> Decimal.decimal_beq x y = true Byte.to_bits: Byte.byte -> bool * (bool * (bool * (bool * (bool * (bool * (bool * bool)))))) Hexadecimal.internal_uint_dec_bl0: forall x : Hexadecimal.uint, (fun x0 : Hexadecimal.uint => forall y : Hexadecimal.uint, Hexadecimal.uint_beq x0 y = true -> x0 = y) x Decimal.internal_uint_dec_lb: forall x : Decimal.uint, (fun x0 : Decimal.uint => forall y : Decimal.uint, x0 = y -> Decimal.uint_beq x0 y = true) x Decimal.internal_uint_dec_bl: forall x : Decimal.uint, (fun x0 : Decimal.uint => forall y : Decimal.uint, Decimal.uint_beq x0 y = true -> x0 = y) x Hexadecimal.internal_uint_dec_lb0: forall x : Hexadecimal.uint, (fun x0 : Hexadecimal.uint => forall y : Hexadecimal.uint, x0 = y -> Hexadecimal.uint_beq x0 y = true) x andb_prop: forall a b : bool, (a && b)%bool = true -> a = true /\ b = true andb_true_intro: forall [b1 b2 : bool], b1 = true /\ b2 = true -> (b1 && b2)%bool = true Byte.to_bits_of_bits: forall b : bool * (bool * (bool * (bool * (bool * (bool * (bool * bool)))))), Byte.to_bits (Byte.of_bits b) = b bool_choice: forall [S : Set] [R1 R2 : S -> Prop], (forall x : S, {R1 x} + {R2 x}) -> {f : S -> bool | forall x : S, f x = true /\ R1 x \/ f x = false /\ R2 x} Nat.two: nat Nat.zero: nat Nat.one: nat Nat.succ: nat -> nat Nat.log2: nat -> nat Nat.sqrt: nat -> nat Nat.square: nat -> nat Nat.double: nat -> nat Nat.pred: nat -> nat Nat.ldiff: nat -> nat -> nat Nat.tail_mul: nat -> nat -> nat Nat.land: nat -> nat -> nat Nat.div: nat -> nat -> nat Nat.modulo: nat -> nat -> nat Nat.lor: nat -> nat -> nat Nat.lxor: nat -> nat -> nat Nat.of_hex_uint: Hexadecimal.uint -> nat Nat.of_uint: Decimal.uint -> nat Nat.of_num_uint: Number.uint -> nat length: forall [A : Type], list A -> nat plus_n_O: forall n : nat, n = n + 0 plus_O_n: forall n : nat, 0 + n = n plus_n_Sm: forall n m : nat, S (n + m) = n + S m plus_Sn_m: forall n m : nat, S n + m = S (n + m) mult_n_Sm: forall n m : nat, n * m + n = n * S m Nat.land_comm: forall a b : nat, Nat.land a b = Nat.land b a Nat.lor_comm: forall a b : nat, Nat.lor a b = Nat.lor b a Nat.lxor_comm: forall a b : nat, Nat.lxor a b = Nat.lxor b a Nat.lcm_comm: forall a b : nat, Nat.lcm a b = Nat.lcm b a Nat.min_comm: forall n m : nat, Nat.min n m = Nat.min m n Nat.gcd_comm: forall n m : nat, Nat.gcd n m = Nat.gcd m n Bool.xorb_comm: forall b b' : bool, xorb b b' = xorb b' b Nat.max_comm: forall n m : nat, Nat.max n m = Nat.max m n Nat.mul_comm: forall n m : nat, n * m = m * n Nat.add_comm: forall n m : nat, n + m = m + n Bool.orb_comm: forall b1 b2 : bool, (b1 || b2)%bool = (b2 || b1)%bool Bool.andb_comm: forall b1 b2 : bool, (b1 && b2)%bool = (b2 && b1)%bool Nat.eqb_sym: forall x y : nat, (x =? y) = (y =? x) Nat.bit0_eqb: forall a : nat, Nat.testbit a 0 = (a mod 2 =? 1) Nat.Div0.div_exact: forall a b : nat, a = b * (a / b) <-> a mod b = 0 Nat.land_ones: forall a n : nat, Nat.land a (Nat.ones n) = a mod 2 ^ n Nat.testbit_spec': forall a n : nat, Nat.b2n (Nat.testbit a n) = (a / 2 ^ n) mod 2 Nat.pow_div_l: forall a b c : nat, b <> 0 -> a mod b = 0 -> (a / b) ^ c = a ^ c / b ^ c Nat.testbit_eqb: forall a n : nat, Nat.testbit a n = ((a / 2 ^ n) mod 2 =? 1) Nat.testbit_false: forall a n : nat, Nat.testbit a n = false <-> (a / 2 ^ n) mod 2 = 0 Nat.testbit_true: forall a n : nat, Nat.testbit a n = true <-> (a / 2 ^ n) mod 2 = 1 Nat.bit0_eqb: forall a : nat, Nat.testbit a 0 = (a mod 2 =? 1) Nat.Div0.div_exact: forall a b : nat, a = b * (a / b) <-> a mod b = 0 Nat.land_ones: forall a n : nat, Nat.land a (Nat.ones n) = a mod 2 ^ n Nat.testbit_spec': forall a n : nat, Nat.b2n (Nat.testbit a n) = (a / 2 ^ n) mod 2 Nat.pow_div_l: forall a b c : nat, b <> 0 -> a mod b = 0 -> (a / b) ^ c = a ^ c / b ^ c Nat.testbit_eqb: forall a n : nat, Nat.testbit a n = ((a / 2 ^ n) mod 2 =? 1) Nat.testbit_false: forall a n : nat, Nat.testbit a n = false <-> (a / 2 ^ n) mod 2 = 0 Nat.testbit_true: forall a n : nat, Nat.testbit a n = true <-> (a / 2 ^ n) mod 2 = 1 coq-8.20.0/test-suite/output/Search_2.v000066400000000000000000000004521466560755400176710ustar00rootroot00000000000000 (* Reproduce the example of the doc *) Search "_assoc". Search "+". Search hyp:bool -headhyp:bool. Search concl:bool -headconcl:bool. Search [ is:Definition headconcl:nat | is:Lemma (_ + _) ]. Require Import PeanoNat. Search (_ ?n ?m = _ ?m ?n). Search "'mod'" -"mod". Search "mod"%nat -"mod". coq-8.20.0/test-suite/output/Search_3.out000066400000000000000000000022441466560755400202350ustar00rootroot00000000000000iff_Symmetric: Symmetric iff iff_Reflexive: Reflexive iff impl_Reflexive: Reflexive Basics.impl eq_Symmetric: forall {A : Type}, Symmetric eq eq_Reflexive: forall {A : Type}, Reflexive eq Equivalence_Reflexive: forall {A : Type} {R : Relation_Definitions.relation A}, Equivalence R -> Reflexive R Equivalence_Symmetric: forall {A : Type} {R : Relation_Definitions.relation A}, Equivalence R -> Symmetric R PreOrder_Reflexive: forall {A : Type} {R : Relation_Definitions.relation A}, PreOrder R -> Reflexive R PER_Symmetric: forall {A : Type} {R : Relation_Definitions.relation A}, PER R -> Symmetric R neq_Symmetric: forall {A : Type}, Symmetric (fun x y : A => x <> y) reflexive_eq_dom_reflexive: forall {A B : Type} {R' : Relation_Definitions.relation B}, Reflexive R' -> Reflexive (eq ==> R')%signature B.b: B.a A.b: A.a F.L: F.P 0 inr: forall {A B : Type}, B -> A + B inl: forall {A B : Type}, A -> A + B (use "About" for full details on the implicit arguments of inl and inr) f: None = 0 partition_cons1: forall [A : Type] (f : A -> bool) (a : A) (l : list A) [l1 l2 : list A], partition f l = (l1, l2) -> f a = true -> partition f (a :: l) = (a :: l1, l2) coq-8.20.0/test-suite/output/Search_3.v000066400000000000000000000013401466560755400176670ustar00rootroot00000000000000 Require Import Morphisms. Search is:Instance [ Reflexive | Symmetric ]. Module Bug12525. (* This was revealing a kernel bug with delta-resolution *) Module A. Axiom a:Prop. Axiom b:a. End A. Module B. Include A. End B. Module M. Search B.a. End M. End Bug12525. From Coq Require Lia. Module Bug12647. (* Similar to #12525 *) Module Type Foo. Axiom P : nat -> Prop. Axiom L : P 0. End Foo. Module Bar (F : Foo). Search F.P. End Bar. End Bug12647. Module WithCoercions. Search headconcl:(_ + _) inside Datatypes. Coercion Some_nat := @Some nat. Axiom f : None = 0. Search (None = 0). End WithCoercions. Require Import List. Module Wish13349. Search partition "1" inside List. End Wish13349. coq-8.20.0/test-suite/output/Search_bug13298.out000066400000000000000000000000351466560755400212530ustar00rootroot00000000000000snd: forall c : c, fst c = 0 coq-8.20.0/test-suite/output/Search_bug13298.v000066400000000000000000000001361466560755400207130ustar00rootroot00000000000000Set Primitive Projections. Record c : Type := { fst : nat; snd : fst = 0 }. Search concl:fst. coq-8.20.0/test-suite/output/Search_bug17963.out000066400000000000000000000000251466560755400212550ustar00rootroot00000000000000H: Some ?y = Some ?y coq-8.20.0/test-suite/output/Search_bug17963.v000066400000000000000000000001371466560755400207170ustar00rootroot00000000000000Goal exists y, Some y = Some y :> option nat -> True. eexists. intro H. Search Some eq. Abort. coq-8.20.0/test-suite/output/Search_headconcl.out000066400000000000000000000037531466560755400220210ustar00rootroot00000000000000le_n: forall n : nat, n <= n le_0_n: forall n : nat, 0 <= n le_S: forall n m : nat, n <= m -> n <= S m le_pred: forall n m : nat, n <= m -> Nat.pred n <= Nat.pred m le_n_S: forall n m : nat, n <= m -> S n <= S m le_S_n: forall n m : nat, S n <= S m -> n <= m false: bool true: bool negb: bool -> bool xorb: bool -> bool -> bool andb: bool -> bool -> bool orb: bool -> bool -> bool implb: bool -> bool -> bool Nat.odd: nat -> bool Nat.even: nat -> bool Number.uint_beq: Number.uint -> Number.uint -> bool Nat.testbit: nat -> nat -> bool Nat.eqb: nat -> nat -> bool Hexadecimal.hexadecimal_beq: Hexadecimal.hexadecimal -> Hexadecimal.hexadecimal -> bool Nat.ltb: nat -> nat -> bool Nat.leb: nat -> nat -> bool Number.number_beq: Number.number -> Number.number -> bool Number.signed_int_beq: Number.signed_int -> Number.signed_int -> bool Hexadecimal.signed_int_beq: Hexadecimal.signed_int -> Hexadecimal.signed_int -> bool Hexadecimal.uint_beq: Hexadecimal.uint -> Hexadecimal.uint -> bool Decimal.decimal_beq: Decimal.decimal -> Decimal.decimal -> bool Decimal.signed_int_beq: Decimal.signed_int -> Decimal.signed_int -> bool Decimal.uint_beq: Decimal.uint -> Decimal.uint -> bool mult_n_O: forall n : nat, 0 = n * 0 plus_O_n: forall n : nat, 0 + n = n plus_n_O: forall n : nat, n = n + 0 pred_Sn: forall n : nat, n = Nat.pred (S n) f_equal_pred: forall x y : nat, x = y -> Nat.pred x = Nat.pred y eq_add_S: forall n m : nat, S n = S m -> n = m eq_S: forall x y : nat, x = y -> S x = S y max_r: forall n m : nat, n <= m -> Nat.max n m = m max_l: forall n m : nat, m <= n -> Nat.max n m = n min_r: forall n m : nat, m <= n -> Nat.min n m = m min_l: forall n m : nat, n <= m -> Nat.min n m = n plus_n_Sm: forall n m : nat, S (n + m) = n + S m plus_Sn_m: forall n m : nat, S n + m = S (n + m) mult_n_Sm: forall n m : nat, n * m + n = n * S m f_equal2_plus: forall x1 y1 x2 y2 : nat, x1 = y1 -> x2 = y2 -> x1 + x2 = y1 + y2 f_equal2_mult: forall x1 y1 x2 y2 : nat, x1 = y1 -> x2 = y2 -> x1 * x2 = y1 * y2 h: newdef n h: P n coq-8.20.0/test-suite/output/Search_headconcl.v000066400000000000000000000007561466560755400214570ustar00rootroot00000000000000(* Some tests of the Search command *) Search headconcl: le. (* app nodes *) Search headconcl: bool. (* no apps *) Search headconcl: (@eq nat). (* complex pattern *) Definition newdef := fun x:nat => x = x. Goal forall n:nat, newdef n -> False. intros n h. Search headconcl: newdef. (* search hypothesis *) Abort. Goal forall n (P:nat -> Prop), P n -> False. intros n P h. Search headconcl: P. (* search hypothesis also for patterns *) Abort. coq-8.20.0/test-suite/output/Show.out000066400000000000000000000002131466560755400175200ustar00rootroot000000000000003 goals (ID 27) H : 0 = 0 ============================ 1 = 1 goal 2 (ID 31) is: 1 = S (S m') goal 3 (ID 18) is: S (S n') = S m coq-8.20.0/test-suite/output/Show.v000066400000000000000000000004111466560755400171560ustar00rootroot00000000000000(* -*- mode: coq; coq-prog-args: ("-emacs") -*- *) (* tests of Show output with -emacs flag to coqtop; see bug 5535 *) Theorem nums : forall (n m : nat), n = m -> (S n) = (S m). Proof. intros. induction n as [| n']. induction m as [| m']. Show. Admitted. coq-8.20.0/test-suite/output/ShowMatch.out000066400000000000000000000000721466560755400205000ustar00rootroot00000000000000match # with | f => end match # with | A.f => end coq-8.20.0/test-suite/output/ShowMatch.v000066400000000000000000000005441466560755400201420ustar00rootroot00000000000000(* Bug 5546 complained about unqualified constructors in Show Match output, when qualification is needed to disambiguate them *) Module A. Inductive foo := f. Show Match foo. (* no need to disambiguate *) End A. Module B. Inductive foo := f. (* local foo shadows A.foo, so constructor "f" needs disambiguation *) Show Match A.foo. End B. coq-8.20.0/test-suite/output/ShowProof.out000066400000000000000000000000371466560755400205320ustar00rootroot00000000000000(fun x : Type => conj I ?Goal) coq-8.20.0/test-suite/output/ShowProof.v000066400000000000000000000002301466560755400201630ustar00rootroot00000000000000(* Was #4524 *) Definition foo (x : Type) : True /\ True. Proof. split. - exact I. Show Proof. (* Was not finding an evar name at some time *) Abort. coq-8.20.0/test-suite/output/ShowUnivs.out000066400000000000000000000007671466560755400205630ustar00rootroot00000000000000UNIVERSES: {ShowUnivs.5 ShowUnivs.4 ShowUnivs.3 ShowUnivs.2 ShowUnivs.1} |= ShowUnivs.2 < ShowUnivs.3 ShowUnivs.3 < ShowUnivs.4 ShowUnivs.3 <= ShowUnivs.5 ShowUnivs.4 <= ShowUnivs.1 ShowUnivs.5 <= ShowUnivs.1 ALGEBRAIC UNIVERSES: {ShowUnivs.5 ShowUnivs.4 ShowUnivs.1} FLEXIBLE UNIVERSES: ShowUnivs.5 ShowUnivs.4 ShowUnivs.3 ShowUnivs.1 SORTS: α1 := Type α2 := Type α3 := α1 WEAK CONSTRAINTS: Normalized constraints: {ShowUnivs.3 ShowUnivs.2} |= ShowUnivs.2 < ShowUnivs.3 coq-8.20.0/test-suite/output/ShowUnivs.v000066400000000000000000000013261466560755400202110ustar00rootroot00000000000000Goal True. pose (fun x => let y := Type in x y :y). Show Universes. Abort. (* was: UNIVERSES: {ShowUnivs.5 ShowUnivs.4 ShowUnivs.3 ShowUnivs.2 ShowUnivs.1} |= ShowUnivs.2 < ShowUnivs.3 ShowUnivs.3 < ShowUnivs.4 ShowUnivs.3 <= ShowUnivs.5 ShowUnivs.4 <= ShowUnivs.1 ShowUnivs.5 <= ShowUnivs.1 ALGEBRAIC UNIVERSES:{ShowUnivs.5 ShowUnivs.4 ShowUnivs.1} UNDEFINED UNIVERSES: ShowUnivs.5 ShowUnivs.4 ShowUnivs.3 ShowUnivs.1 WEAK CONSTRAINTS: Normalized constraints: {ShowUnivs.3 ShowUnivs.2} |= ShowUnivs.2 < ShowUnivs.3 *) coq-8.20.0/test-suite/output/Sint63NumberSyntax.out000066400000000000000000000051421466560755400222540ustar00rootroot000000000000002%sint63 : int 2 : int -3 : int 4611686018427387903 : int -4611686018427387904 : int 427 : int 427 : int 427 : int 427 : int 427 : int File "./output/Sint63NumberSyntax.v", line 14, characters 11-17: The command has indeed failed with message: Cannot interpret this number as a value of type int File "./output/Sint63NumberSyntax.v", line 15, characters 11-17: The command has indeed failed with message: Cannot interpret this number as a value of type int 0 : int 0 : int File "./output/Sint63NumberSyntax.v", line 18, characters 12-14: The command has indeed failed with message: The reference xg was not found in the current environment. File "./output/Sint63NumberSyntax.v", line 19, characters 12-14: The command has indeed failed with message: The reference xG was not found in the current environment. File "./output/Sint63NumberSyntax.v", line 20, characters 13-15: The command has indeed failed with message: The reference x1 was not found in the current environment. File "./output/Sint63NumberSyntax.v", line 21, characters 12-13: The command has indeed failed with message: The reference x was not found in the current environment. 2 + 2 : int File "./output/Sint63NumberSyntax.v", line 23, characters 11-30: The command has indeed failed with message: Cannot interpret this number as a value of type int File "./output/Sint63NumberSyntax.v", line 24, characters 11-31: The command has indeed failed with message: Cannot interpret this number as a value of type int 0x1%uint63 : int 0x7fffffffffffffff%uint63 : int 2 : nat 2%sint63 : int File "./output/Sint63NumberSyntax.v", line 34, characters 0-37: Warning: Overwriting previous delimiting key sint63 in scope sint63_scope [overwriting-delimiting-key,parsing,default] t = 2%si63 : int File "./output/Sint63NumberSyntax.v", line 37, characters 0-36: Warning: Overwriting previous delimiting key nat in scope nat_scope [overwriting-delimiting-key,parsing,default] File "./output/Sint63NumberSyntax.v", line 37, characters 0-36: Warning: Hiding binding of key sint63 to sint63_scope [hiding-delimiting-key,parsing,default] t = 2%si63 : int 2 : nat 2 : int File "./output/Sint63NumberSyntax.v", line 43, characters 0-39: Warning: Overwriting previous delimiting key si63 in scope sint63_scope [overwriting-delimiting-key,parsing,default] File "./output/Sint63NumberSyntax.v", line 43, characters 0-39: Warning: Hiding binding of key sint63 to nat_scope [hiding-delimiting-key,parsing,default] (2 + 2)%sint63 : int 2 + 2 : int = 4 : int = 37151199385380486 : int coq-8.20.0/test-suite/output/Sint63NumberSyntax.v000066400000000000000000000016641466560755400217170ustar00rootroot00000000000000Require Import Sint63. Check 2%sint63. Open Scope sint63_scope. Check 2. Check -3. Check 4611686018427387903. Check -4611686018427387904. Check 0x1ab. Check 0X1ab. Check 0x1Ab. Check 0x1aB. Check 0x1AB. Fail Check 0x1ap5. (* exponents not implemented (yet?) *) Fail Check 0x1aP5. Check 0x0. Check 0x000. Fail Check 0xg. Fail Check 0xG. Fail Check 00x1. Fail Check 0x. Check (PrimInt63.add 2 2). Fail Check 4611686018427387904. Fail Check -4611686018427387905. Set Printing All. Check 1%sint63. Check (-1)%sint63. Unset Printing All. Open Scope nat_scope. Check 2. (* : nat *) Check 2%sint63. Delimit Scope sint63_scope with si63. Definition t := 2%sint63. Print t. Delimit Scope nat_scope with sint63. Print t. Check 2. Close Scope nat_scope. Check 2. Close Scope sint63_scope. Delimit Scope sint63_scope with sint63. Check (2 + 2)%sint63. Open Scope sint63_scope. Check (2+2). Eval vm_compute in 2+2. Eval vm_compute in 65675757 * 565675998. coq-8.20.0/test-suite/output/SortQuality.out000066400000000000000000000000331466560755400211000ustar00rootroot00000000000000Type@{α1 | SortQuality.1} coq-8.20.0/test-suite/output/SortQuality.v000066400000000000000000000002361466560755400205430ustar00rootroot00000000000000Set Printing Universes. Set Printing Sort Qualities. Goal True. Proof. refine (let H := _ in _). let T := type of H in let s := type of T in idtac s. Abort. coq-8.20.0/test-suite/output/StringSyntax.out000066400000000000000000001051421466560755400212640ustar00rootroot00000000000000byte_rect = fun (P : byte -> Type) (f : P "000") (f0 : P "001") (f1 : P "002") (f2 : P "003") (f3 : P "004") (f4 : P "005") (f5 : P "006") (f6 : P "007") (f7 : P "008") (f8 : P "009") (f9 : P "010") (f10 : P "011") (f11 : P "012") (f12 : P "013") (f13 : P "014") (f14 : P "015") (f15 : P "016") (f16 : P "017") (f17 : P "018") (f18 : P "019") (f19 : P "020") (f20 : P "021") (f21 : P "022") (f22 : P "023") (f23 : P "024") (f24 : P "025") (f25 : P "026") (f26 : P "027") (f27 : P "028") (f28 : P "029") (f29 : P "030") (f30 : P "031") (f31 : P " ") (f32 : P "!") (f33 : P """") (f34 : P "#") (f35 : P "$") (f36 : P "%") (f37 : P "&") (f38 : P "'") (f39 : P "(") (f40 : P ")") (f41 : P "*") (f42 : P "+") (f43 : P ",") (f44 : P "-") (f45 : P ".") (f46 : P "/") (f47 : P "0") (f48 : P "1") (f49 : P "2") (f50 : P "3") (f51 : P "4") (f52 : P "5") (f53 : P "6") (f54 : P "7") (f55 : P "8") (f56 : P "9") (f57 : P ":") (f58 : P ";") (f59 : P "<") (f60 : P "=") (f61 : P ">") (f62 : P "?") (f63 : P "@") (f64 : P "A") (f65 : P "B") (f66 : P "C") (f67 : P "D") (f68 : P "E") (f69 : P "F") (f70 : P "G") (f71 : P "H") (f72 : P "I") (f73 : P "J") (f74 : P "K") (f75 : P "L") (f76 : P "M") (f77 : P "N") (f78 : P "O") (f79 : P "P") (f80 : P "Q") (f81 : P "R") (f82 : P "S") (f83 : P "T") (f84 : P "U") (f85 : P "V") (f86 : P "W") (f87 : P "X") (f88 : P "Y") (f89 : P "Z") (f90 : P "[") (f91 : P "\") (f92 : P "]") (f93 : P "^") (f94 : P "_") (f95 : P "`") (f96 : P "a") (f97 : P "b") (f98 : P "c") (f99 : P "d") (f100 : P "e") (f101 : P "f") (f102 : P "g") (f103 : P "h") (f104 : P "i") (f105 : P "j") (f106 : P "k") (f107 : P "l") (f108 : P "m") (f109 : P "n") (f110 : P "o") (f111 : P "p") (f112 : P "q") (f113 : P "r") (f114 : P "s") (f115 : P "t") (f116 : P "u") (f117 : P "v") (f118 : P "w") (f119 : P "x") (f120 : P "y") (f121 : P "z") (f122 : P "{") (f123 : P "|") (f124 : P "}") (f125 : P "~") (f126 : P "127") (f127 : P "128") (f128 : P "129") (f129 : P "130") (f130 : P "131") (f131 : P "132") (f132 : P "133") (f133 : P "134") (f134 : P "135") (f135 : P "136") (f136 : P "137") (f137 : P "138") (f138 : P "139") (f139 : P "140") (f140 : P "141") (f141 : P "142") (f142 : P "143") (f143 : P "144") (f144 : P "145") (f145 : P "146") (f146 : P "147") (f147 : P "148") (f148 : P "149") (f149 : P "150") (f150 : P "151") (f151 : P "152") (f152 : P "153") (f153 : P "154") (f154 : P "155") (f155 : P "156") (f156 : P "157") (f157 : P "158") (f158 : P "159") (f159 : P "160") (f160 : P "161") (f161 : P "162") (f162 : P "163") (f163 : P "164") (f164 : P "165") (f165 : P "166") (f166 : P "167") (f167 : P "168") (f168 : P "169") (f169 : P "170") (f170 : P "171") (f171 : P "172") (f172 : P "173") (f173 : P "174") (f174 : P "175") (f175 : P "176") (f176 : P "177") (f177 : P "178") (f178 : P "179") (f179 : P "180") (f180 : P "181") (f181 : P "182") (f182 : P "183") (f183 : P "184") (f184 : P "185") (f185 : P "186") (f186 : P "187") (f187 : P "188") (f188 : P "189") (f189 : P "190") (f190 : P "191") (f191 : P "192") (f192 : P "193") (f193 : P "194") (f194 : P "195") (f195 : P "196") (f196 : P "197") (f197 : P "198") (f198 : P "199") (f199 : P "200") (f200 : P "201") (f201 : P "202") (f202 : P "203") (f203 : P "204") (f204 : P "205") (f205 : P "206") (f206 : P "207") (f207 : P "208") (f208 : P "209") (f209 : P "210") (f210 : P "211") (f211 : P "212") (f212 : P "213") (f213 : P "214") (f214 : P "215") (f215 : P "216") (f216 : P "217") (f217 : P "218") (f218 : P "219") (f219 : P "220") (f220 : P "221") (f221 : P "222") (f222 : P "223") (f223 : P "224") (f224 : P "225") (f225 : P "226") (f226 : P "227") (f227 : P "228") (f228 : P "229") (f229 : P "230") (f230 : P "231") (f231 : P "232") (f232 : P "233") (f233 : P "234") (f234 : P "235") (f235 : P "236") (f236 : P "237") (f237 : P "238") (f238 : P "239") (f239 : P "240") (f240 : P "241") (f241 : P "242") (f242 : P "243") (f243 : P "244") (f244 : P "245") (f245 : P "246") (f246 : P "247") (f247 : P "248") (f248 : P "249") (f249 : P "250") (f250 : P "251") (f251 : P "252") (f252 : P "253") (f253 : P "254") (f254 : P "255") (b : byte) => match b as b0 return (P b0) with | "000" => f | "001" => f0 | "002" => f1 | "003" => f2 | "004" => f3 | "005" => f4 | "006" => f5 | "007" => f6 | "008" => f7 | "009" => f8 | "010" => f9 | "011" => f10 | "012" => f11 | "013" => f12 | "014" => f13 | "015" => f14 | "016" => f15 | "017" => f16 | "018" => f17 | "019" => f18 | "020" => f19 | "021" => f20 | "022" => f21 | "023" => f22 | "024" => f23 | "025" => f24 | "026" => f25 | "027" => f26 | "028" => f27 | "029" => f28 | "030" => f29 | "031" => f30 | " " => f31 | "!" => f32 | """" => f33 | "#" => f34 | "$" => f35 | "%" => f36 | "&" => f37 | "'" => f38 | "(" => f39 | ")" => f40 | "*" => f41 | "+" => f42 | "," => f43 | "-" => f44 | "." => f45 | "/" => f46 | "0" => f47 | "1" => f48 | "2" => f49 | "3" => f50 | "4" => f51 | "5" => f52 | "6" => f53 | "7" => f54 | "8" => f55 | "9" => f56 | ":" => f57 | ";" => f58 | "<" => f59 | "=" => f60 | ">" => f61 | "?" => f62 | "@" => f63 | "A" => f64 | "B" => f65 | "C" => f66 | "D" => f67 | "E" => f68 | "F" => f69 | "G" => f70 | "H" => f71 | "I" => f72 | "J" => f73 | "K" => f74 | "L" => f75 | "M" => f76 | "N" => f77 | "O" => f78 | "P" => f79 | "Q" => f80 | "R" => f81 | "S" => f82 | "T" => f83 | "U" => f84 | "V" => f85 | "W" => f86 | "X" => f87 | "Y" => f88 | "Z" => f89 | "[" => f90 | "\" => f91 | "]" => f92 | "^" => f93 | "_" => f94 | "`" => f95 | "a" => f96 | "b" => f97 | "c" => f98 | "d" => f99 | "e" => f100 | "f" => f101 | "g" => f102 | "h" => f103 | "i" => f104 | "j" => f105 | "k" => f106 | "l" => f107 | "m" => f108 | "n" => f109 | "o" => f110 | "p" => f111 | "q" => f112 | "r" => f113 | "s" => f114 | "t" => f115 | "u" => f116 | "v" => f117 | "w" => f118 | "x" => f119 | "y" => f120 | "z" => f121 | "{" => f122 | "|" => f123 | "}" => f124 | "~" => f125 | "127" => f126 | "128" => f127 | "129" => f128 | "130" => f129 | "131" => f130 | "132" => f131 | "133" => f132 | "134" => f133 | "135" => f134 | "136" => f135 | "137" => f136 | "138" => f137 | "139" => f138 | "140" => f139 | "141" => f140 | "142" => f141 | "143" => f142 | "144" => f143 | "145" => f144 | "146" => f145 | "147" => f146 | "148" => f147 | "149" => f148 | "150" => f149 | "151" => f150 | "152" => f151 | "153" => f152 | "154" => f153 | "155" => f154 | "156" => f155 | "157" => f156 | "158" => f157 | "159" => f158 | "160" => f159 | "161" => f160 | "162" => f161 | "163" => f162 | "164" => f163 | "165" => f164 | "166" => f165 | "167" => f166 | "168" => f167 | "169" => f168 | "170" => f169 | "171" => f170 | "172" => f171 | "173" => f172 | "174" => f173 | "175" => f174 | "176" => f175 | "177" => f176 | "178" => f177 | "179" => f178 | "180" => f179 | "181" => f180 | "182" => f181 | "183" => f182 | "184" => f183 | "185" => f184 | "186" => f185 | "187" => f186 | "188" => f187 | "189" => f188 | "190" => f189 | "191" => f190 | "192" => f191 | "193" => f192 | "194" => f193 | "195" => f194 | "196" => f195 | "197" => f196 | "198" => f197 | "199" => f198 | "200" => f199 | "201" => f200 | "202" => f201 | "203" => f202 | "204" => f203 | "205" => f204 | "206" => f205 | "207" => f206 | "208" => f207 | "209" => f208 | "210" => f209 | "211" => f210 | "212" => f211 | "213" => f212 | "214" => f213 | "215" => f214 | "216" => f215 | "217" => f216 | "218" => f217 | "219" => f218 | "220" => f219 | "221" => f220 | "222" => f221 | "223" => f222 | "224" => f223 | "225" => f224 | "226" => f225 | "227" => f226 | "228" => f227 | "229" => f228 | "230" => f229 | "231" => f230 | "232" => f231 | "233" => f232 | "234" => f233 | "235" => f234 | "236" => f235 | "237" => f236 | "238" => f237 | "239" => f238 | "240" => f239 | "241" => f240 | "242" => f241 | "243" => f242 | "244" => f243 | "245" => f244 | "246" => f245 | "247" => f246 | "248" => f247 | "249" => f248 | "250" => f249 | "251" => f250 | "252" => f251 | "253" => f252 | "254" => f253 | "255" => f254 end : forall P : byte -> Type, P "000" -> P "001" -> P "002" -> P "003" -> P "004" -> P "005" -> P "006" -> P "007" -> P "008" -> P "009" -> P "010" -> P "011" -> P "012" -> P "013" -> P "014" -> P "015" -> P "016" -> P "017" -> P "018" -> P "019" -> P "020" -> P "021" -> P "022" -> P "023" -> P "024" -> P "025" -> P "026" -> P "027" -> P "028" -> P "029" -> P "030" -> P "031" -> P " " -> P "!" -> P """" -> P "#" -> P "$" -> P "%" -> P "&" -> P "'" -> P "(" -> P ")" -> P "*" -> P "+" -> P "," -> P "-" -> P "." -> P "/" -> P "0" -> P "1" -> P "2" -> P "3" -> P "4" -> P "5" -> P "6" -> P "7" -> P "8" -> P "9" -> P ":" -> P ";" -> P "<" -> P "=" -> P ">" -> P "?" -> P "@" -> P "A" -> P "B" -> P "C" -> P "D" -> P "E" -> P "F" -> P "G" -> P "H" -> P "I" -> P "J" -> P "K" -> P "L" -> P "M" -> P "N" -> P "O" -> P "P" -> P "Q" -> P "R" -> P "S" -> P "T" -> P "U" -> P "V" -> P "W" -> P "X" -> P "Y" -> P "Z" -> P "[" -> P "\" -> P "]" -> P "^" -> P "_" -> P "`" -> P "a" -> P "b" -> P "c" -> P "d" -> P "e" -> P "f" -> P "g" -> P "h" -> P "i" -> P "j" -> P "k" -> P "l" -> P "m" -> P "n" -> P "o" -> P "p" -> P "q" -> P "r" -> P "s" -> P "t" -> P "u" -> P "v" -> P "w" -> P "x" -> P "y" -> P "z" -> P "{" -> P "|" -> P "}" -> P "~" -> P "127" -> P "128" -> P "129" -> P "130" -> P "131" -> P "132" -> P "133" -> P "134" -> P "135" -> P "136" -> P "137" -> P "138" -> P "139" -> P "140" -> P "141" -> P "142" -> P "143" -> P "144" -> P "145" -> P "146" -> P "147" -> P "148" -> P "149" -> P "150" -> P "151" -> P "152" -> P "153" -> P "154" -> P "155" -> P "156" -> P "157" -> P "158" -> P "159" -> P "160" -> P "161" -> P "162" -> P "163" -> P "164" -> P "165" -> P "166" -> P "167" -> P "168" -> P "169" -> P "170" -> P "171" -> P "172" -> P "173" -> P "174" -> P "175" -> P "176" -> P "177" -> P "178" -> P "179" -> P "180" -> P "181" -> P "182" -> P "183" -> P "184" -> P "185" -> P "186" -> P "187" -> P "188" -> P "189" -> P "190" -> P "191" -> P "192" -> P "193" -> P "194" -> P "195" -> P "196" -> P "197" -> P "198" -> P "199" -> P "200" -> P "201" -> P "202" -> P "203" -> P "204" -> P "205" -> P "206" -> P "207" -> P "208" -> P "209" -> P "210" -> P "211" -> P "212" -> P "213" -> P "214" -> P "215" -> P "216" -> P "217" -> P "218" -> P "219" -> P "220" -> P "221" -> P "222" -> P "223" -> P "224" -> P "225" -> P "226" -> P "227" -> P "228" -> P "229" -> P "230" -> P "231" -> P "232" -> P "233" -> P "234" -> P "235" -> P "236" -> P "237" -> P "238" -> P "239" -> P "240" -> P "241" -> P "242" -> P "243" -> P "244" -> P "245" -> P "246" -> P "247" -> P "248" -> P "249" -> P "250" -> P "251" -> P "252" -> P "253" -> P "254" -> P "255" -> forall b : byte, P b Arguments byte_rect P%function_scope f f0 f1 f2 f3 f4 f5 f6 f7 f8 f9 f10 f11 f12 f13 f14 f15 f16 f17 f18 f19 f20 f21 f22 f23 f24 f25 f26 f27 f28 f29 f30 f31 f32 f33 f34 f35 f36 f37 f38 f39 f40 f41 f42 f43 f44 f45 f46 f47 f48 f49 f50 f51 f52 f53 f54 f55 f56 f57 f58 f59 f60 f61 f62 f63 f64 f65 f66 f67 f68 f69 f70 f71 f72 f73 f74 f75 f76 f77 f78 f79 f80 f81 f82 f83 f84 f85 f86 f87 f88 f89 f90 f91 f92 f93 f94 f95 f96 f97 f98 f99 f100 f101 f102 f103 f104 f105 f106 f107 f108 f109 f110 f111 f112 f113 f114 f115 f116 f117 f118 f119 f120 f121 f122 f123 f124 f125 f126 f127 f128 f129 f130 f131 f132 f133 f134 f135 f136 f137 f138 f139 f140 f141 f142 f143 f144 f145 f146 f147 f148 f149 f150 f151 f152 f153 f154 f155 f156 f157 f158 f159 f160 f161 f162 f163 f164 f165 f166 f167 f168 f169 f170 f171 f172 f173 f174 f175 f176 f177 f178 f179 f180 f181 f182 f183 f184 f185 f186 f187 f188 f189 f190 f191 f192 f193 f194 f195 f196 f197 f198 f199 f200 f201 f202 f203 f204 f205 f206 f207 f208 f209 f210 f211 f212 f213 f214 f215 f216 f217 f218 f219 f220 f221 f222 f223 f224 f225 f226 f227 f228 f229 f230 f231 f232 f233 f234 f235 f236 f237 f238 f239 f240 f241 f242 f243 f244 f245 f246 f247 f248 f249 f250 f251 f252 f253 f254 b%byte_scope byte_rec = fun P : byte -> Set => byte_rect P : forall P : byte -> Set, P "000" -> P "001" -> P "002" -> P "003" -> P "004" -> P "005" -> P "006" -> P "007" -> P "008" -> P "009" -> P "010" -> P "011" -> P "012" -> P "013" -> P "014" -> P "015" -> P "016" -> P "017" -> P "018" -> P "019" -> P "020" -> P "021" -> P "022" -> P "023" -> P "024" -> P "025" -> P "026" -> P "027" -> P "028" -> P "029" -> P "030" -> P "031" -> P " " -> P "!" -> P """" -> P "#" -> P "$" -> P "%" -> P "&" -> P "'" -> P "(" -> P ")" -> P "*" -> P "+" -> P "," -> P "-" -> P "." -> P "/" -> P "0" -> P "1" -> P "2" -> P "3" -> P "4" -> P "5" -> P "6" -> P "7" -> P "8" -> P "9" -> P ":" -> P ";" -> P "<" -> P "=" -> P ">" -> P "?" -> P "@" -> P "A" -> P "B" -> P "C" -> P "D" -> P "E" -> P "F" -> P "G" -> P "H" -> P "I" -> P "J" -> P "K" -> P "L" -> P "M" -> P "N" -> P "O" -> P "P" -> P "Q" -> P "R" -> P "S" -> P "T" -> P "U" -> P "V" -> P "W" -> P "X" -> P "Y" -> P "Z" -> P "[" -> P "\" -> P "]" -> P "^" -> P "_" -> P "`" -> P "a" -> P "b" -> P "c" -> P "d" -> P "e" -> P "f" -> P "g" -> P "h" -> P "i" -> P "j" -> P "k" -> P "l" -> P "m" -> P "n" -> P "o" -> P "p" -> P "q" -> P "r" -> P "s" -> P "t" -> P "u" -> P "v" -> P "w" -> P "x" -> P "y" -> P "z" -> P "{" -> P "|" -> P "}" -> P "~" -> P "127" -> P "128" -> P "129" -> P "130" -> P "131" -> P "132" -> P "133" -> P "134" -> P "135" -> P "136" -> P "137" -> P "138" -> P "139" -> P "140" -> P "141" -> P "142" -> P "143" -> P "144" -> P "145" -> P "146" -> P "147" -> P "148" -> P "149" -> P "150" -> P "151" -> P "152" -> P "153" -> P "154" -> P "155" -> P "156" -> P "157" -> P "158" -> P "159" -> P "160" -> P "161" -> P "162" -> P "163" -> P "164" -> P "165" -> P "166" -> P "167" -> P "168" -> P "169" -> P "170" -> P "171" -> P "172" -> P "173" -> P "174" -> P "175" -> P "176" -> P "177" -> P "178" -> P "179" -> P "180" -> P "181" -> P "182" -> P "183" -> P "184" -> P "185" -> P "186" -> P "187" -> P "188" -> P "189" -> P "190" -> P "191" -> P "192" -> P "193" -> P "194" -> P "195" -> P "196" -> P "197" -> P "198" -> P "199" -> P "200" -> P "201" -> P "202" -> P "203" -> P "204" -> P "205" -> P "206" -> P "207" -> P "208" -> P "209" -> P "210" -> P "211" -> P "212" -> P "213" -> P "214" -> P "215" -> P "216" -> P "217" -> P "218" -> P "219" -> P "220" -> P "221" -> P "222" -> P "223" -> P "224" -> P "225" -> P "226" -> P "227" -> P "228" -> P "229" -> P "230" -> P "231" -> P "232" -> P "233" -> P "234" -> P "235" -> P "236" -> P "237" -> P "238" -> P "239" -> P "240" -> P "241" -> P "242" -> P "243" -> P "244" -> P "245" -> P "246" -> P "247" -> P "248" -> P "249" -> P "250" -> P "251" -> P "252" -> P "253" -> P "254" -> P "255" -> forall b : byte, P b Arguments byte_rec P%function_scope f f0 f1 f2 f3 f4 f5 f6 f7 f8 f9 f10 f11 f12 f13 f14 f15 f16 f17 f18 f19 f20 f21 f22 f23 f24 f25 f26 f27 f28 f29 f30 f31 f32 f33 f34 f35 f36 f37 f38 f39 f40 f41 f42 f43 f44 f45 f46 f47 f48 f49 f50 f51 f52 f53 f54 f55 f56 f57 f58 f59 f60 f61 f62 f63 f64 f65 f66 f67 f68 f69 f70 f71 f72 f73 f74 f75 f76 f77 f78 f79 f80 f81 f82 f83 f84 f85 f86 f87 f88 f89 f90 f91 f92 f93 f94 f95 f96 f97 f98 f99 f100 f101 f102 f103 f104 f105 f106 f107 f108 f109 f110 f111 f112 f113 f114 f115 f116 f117 f118 f119 f120 f121 f122 f123 f124 f125 f126 f127 f128 f129 f130 f131 f132 f133 f134 f135 f136 f137 f138 f139 f140 f141 f142 f143 f144 f145 f146 f147 f148 f149 f150 f151 f152 f153 f154 f155 f156 f157 f158 f159 f160 f161 f162 f163 f164 f165 f166 f167 f168 f169 f170 f171 f172 f173 f174 f175 f176 f177 f178 f179 f180 f181 f182 f183 f184 f185 f186 f187 f188 f189 f190 f191 f192 f193 f194 f195 f196 f197 f198 f199 f200 f201 f202 f203 f204 f205 f206 f207 f208 f209 f210 f211 f212 f213 f214 f215 f216 f217 f218 f219 f220 f221 f222 f223 f224 f225 f226 f227 f228 f229 f230 f231 f232 f233 f234 f235 f236 f237 f238 f239 f240 f241 f242 f243 f244 f245 f246 f247 f248 f249 f250 f251 f252 f253 f254 b%byte_scope byte_ind = fun (P : byte -> Prop) (f : P "000") (f0 : P "001") (f1 : P "002") (f2 : P "003") (f3 : P "004") (f4 : P "005") (f5 : P "006") (f6 : P "007") (f7 : P "008") (f8 : P "009") (f9 : P "010") (f10 : P "011") (f11 : P "012") (f12 : P "013") (f13 : P "014") (f14 : P "015") (f15 : P "016") (f16 : P "017") (f17 : P "018") (f18 : P "019") (f19 : P "020") (f20 : P "021") (f21 : P "022") (f22 : P "023") (f23 : P "024") (f24 : P "025") (f25 : P "026") (f26 : P "027") (f27 : P "028") (f28 : P "029") (f29 : P "030") (f30 : P "031") (f31 : P " ") (f32 : P "!") (f33 : P """") (f34 : P "#") (f35 : P "$") (f36 : P "%") (f37 : P "&") (f38 : P "'") (f39 : P "(") (f40 : P ")") (f41 : P "*") (f42 : P "+") (f43 : P ",") (f44 : P "-") (f45 : P ".") (f46 : P "/") (f47 : P "0") (f48 : P "1") (f49 : P "2") (f50 : P "3") (f51 : P "4") (f52 : P "5") (f53 : P "6") (f54 : P "7") (f55 : P "8") (f56 : P "9") (f57 : P ":") (f58 : P ";") (f59 : P "<") (f60 : P "=") (f61 : P ">") (f62 : P "?") (f63 : P "@") (f64 : P "A") (f65 : P "B") (f66 : P "C") (f67 : P "D") (f68 : P "E") (f69 : P "F") (f70 : P "G") (f71 : P "H") (f72 : P "I") (f73 : P "J") (f74 : P "K") (f75 : P "L") (f76 : P "M") (f77 : P "N") (f78 : P "O") (f79 : P "P") (f80 : P "Q") (f81 : P "R") (f82 : P "S") (f83 : P "T") (f84 : P "U") (f85 : P "V") (f86 : P "W") (f87 : P "X") (f88 : P "Y") (f89 : P "Z") (f90 : P "[") (f91 : P "\") (f92 : P "]") (f93 : P "^") (f94 : P "_") (f95 : P "`") (f96 : P "a") (f97 : P "b") (f98 : P "c") (f99 : P "d") (f100 : P "e") (f101 : P "f") (f102 : P "g") (f103 : P "h") (f104 : P "i") (f105 : P "j") (f106 : P "k") (f107 : P "l") (f108 : P "m") (f109 : P "n") (f110 : P "o") (f111 : P "p") (f112 : P "q") (f113 : P "r") (f114 : P "s") (f115 : P "t") (f116 : P "u") (f117 : P "v") (f118 : P "w") (f119 : P "x") (f120 : P "y") (f121 : P "z") (f122 : P "{") (f123 : P "|") (f124 : P "}") (f125 : P "~") (f126 : P "127") (f127 : P "128") (f128 : P "129") (f129 : P "130") (f130 : P "131") (f131 : P "132") (f132 : P "133") (f133 : P "134") (f134 : P "135") (f135 : P "136") (f136 : P "137") (f137 : P "138") (f138 : P "139") (f139 : P "140") (f140 : P "141") (f141 : P "142") (f142 : P "143") (f143 : P "144") (f144 : P "145") (f145 : P "146") (f146 : P "147") (f147 : P "148") (f148 : P "149") (f149 : P "150") (f150 : P "151") (f151 : P "152") (f152 : P "153") (f153 : P "154") (f154 : P "155") (f155 : P "156") (f156 : P "157") (f157 : P "158") (f158 : P "159") (f159 : P "160") (f160 : P "161") (f161 : P "162") (f162 : P "163") (f163 : P "164") (f164 : P "165") (f165 : P "166") (f166 : P "167") (f167 : P "168") (f168 : P "169") (f169 : P "170") (f170 : P "171") (f171 : P "172") (f172 : P "173") (f173 : P "174") (f174 : P "175") (f175 : P "176") (f176 : P "177") (f177 : P "178") (f178 : P "179") (f179 : P "180") (f180 : P "181") (f181 : P "182") (f182 : P "183") (f183 : P "184") (f184 : P "185") (f185 : P "186") (f186 : P "187") (f187 : P "188") (f188 : P "189") (f189 : P "190") (f190 : P "191") (f191 : P "192") (f192 : P "193") (f193 : P "194") (f194 : P "195") (f195 : P "196") (f196 : P "197") (f197 : P "198") (f198 : P "199") (f199 : P "200") (f200 : P "201") (f201 : P "202") (f202 : P "203") (f203 : P "204") (f204 : P "205") (f205 : P "206") (f206 : P "207") (f207 : P "208") (f208 : P "209") (f209 : P "210") (f210 : P "211") (f211 : P "212") (f212 : P "213") (f213 : P "214") (f214 : P "215") (f215 : P "216") (f216 : P "217") (f217 : P "218") (f218 : P "219") (f219 : P "220") (f220 : P "221") (f221 : P "222") (f222 : P "223") (f223 : P "224") (f224 : P "225") (f225 : P "226") (f226 : P "227") (f227 : P "228") (f228 : P "229") (f229 : P "230") (f230 : P "231") (f231 : P "232") (f232 : P "233") (f233 : P "234") (f234 : P "235") (f235 : P "236") (f236 : P "237") (f237 : P "238") (f238 : P "239") (f239 : P "240") (f240 : P "241") (f241 : P "242") (f242 : P "243") (f243 : P "244") (f244 : P "245") (f245 : P "246") (f246 : P "247") (f247 : P "248") (f248 : P "249") (f249 : P "250") (f250 : P "251") (f251 : P "252") (f252 : P "253") (f253 : P "254") (f254 : P "255") (b : byte) => match b as b0 return (P b0) with | "000" => f | "001" => f0 | "002" => f1 | "003" => f2 | "004" => f3 | "005" => f4 | "006" => f5 | "007" => f6 | "008" => f7 | "009" => f8 | "010" => f9 | "011" => f10 | "012" => f11 | "013" => f12 | "014" => f13 | "015" => f14 | "016" => f15 | "017" => f16 | "018" => f17 | "019" => f18 | "020" => f19 | "021" => f20 | "022" => f21 | "023" => f22 | "024" => f23 | "025" => f24 | "026" => f25 | "027" => f26 | "028" => f27 | "029" => f28 | "030" => f29 | "031" => f30 | " " => f31 | "!" => f32 | """" => f33 | "#" => f34 | "$" => f35 | "%" => f36 | "&" => f37 | "'" => f38 | "(" => f39 | ")" => f40 | "*" => f41 | "+" => f42 | "," => f43 | "-" => f44 | "." => f45 | "/" => f46 | "0" => f47 | "1" => f48 | "2" => f49 | "3" => f50 | "4" => f51 | "5" => f52 | "6" => f53 | "7" => f54 | "8" => f55 | "9" => f56 | ":" => f57 | ";" => f58 | "<" => f59 | "=" => f60 | ">" => f61 | "?" => f62 | "@" => f63 | "A" => f64 | "B" => f65 | "C" => f66 | "D" => f67 | "E" => f68 | "F" => f69 | "G" => f70 | "H" => f71 | "I" => f72 | "J" => f73 | "K" => f74 | "L" => f75 | "M" => f76 | "N" => f77 | "O" => f78 | "P" => f79 | "Q" => f80 | "R" => f81 | "S" => f82 | "T" => f83 | "U" => f84 | "V" => f85 | "W" => f86 | "X" => f87 | "Y" => f88 | "Z" => f89 | "[" => f90 | "\" => f91 | "]" => f92 | "^" => f93 | "_" => f94 | "`" => f95 | "a" => f96 | "b" => f97 | "c" => f98 | "d" => f99 | "e" => f100 | "f" => f101 | "g" => f102 | "h" => f103 | "i" => f104 | "j" => f105 | "k" => f106 | "l" => f107 | "m" => f108 | "n" => f109 | "o" => f110 | "p" => f111 | "q" => f112 | "r" => f113 | "s" => f114 | "t" => f115 | "u" => f116 | "v" => f117 | "w" => f118 | "x" => f119 | "y" => f120 | "z" => f121 | "{" => f122 | "|" => f123 | "}" => f124 | "~" => f125 | "127" => f126 | "128" => f127 | "129" => f128 | "130" => f129 | "131" => f130 | "132" => f131 | "133" => f132 | "134" => f133 | "135" => f134 | "136" => f135 | "137" => f136 | "138" => f137 | "139" => f138 | "140" => f139 | "141" => f140 | "142" => f141 | "143" => f142 | "144" => f143 | "145" => f144 | "146" => f145 | "147" => f146 | "148" => f147 | "149" => f148 | "150" => f149 | "151" => f150 | "152" => f151 | "153" => f152 | "154" => f153 | "155" => f154 | "156" => f155 | "157" => f156 | "158" => f157 | "159" => f158 | "160" => f159 | "161" => f160 | "162" => f161 | "163" => f162 | "164" => f163 | "165" => f164 | "166" => f165 | "167" => f166 | "168" => f167 | "169" => f168 | "170" => f169 | "171" => f170 | "172" => f171 | "173" => f172 | "174" => f173 | "175" => f174 | "176" => f175 | "177" => f176 | "178" => f177 | "179" => f178 | "180" => f179 | "181" => f180 | "182" => f181 | "183" => f182 | "184" => f183 | "185" => f184 | "186" => f185 | "187" => f186 | "188" => f187 | "189" => f188 | "190" => f189 | "191" => f190 | "192" => f191 | "193" => f192 | "194" => f193 | "195" => f194 | "196" => f195 | "197" => f196 | "198" => f197 | "199" => f198 | "200" => f199 | "201" => f200 | "202" => f201 | "203" => f202 | "204" => f203 | "205" => f204 | "206" => f205 | "207" => f206 | "208" => f207 | "209" => f208 | "210" => f209 | "211" => f210 | "212" => f211 | "213" => f212 | "214" => f213 | "215" => f214 | "216" => f215 | "217" => f216 | "218" => f217 | "219" => f218 | "220" => f219 | "221" => f220 | "222" => f221 | "223" => f222 | "224" => f223 | "225" => f224 | "226" => f225 | "227" => f226 | "228" => f227 | "229" => f228 | "230" => f229 | "231" => f230 | "232" => f231 | "233" => f232 | "234" => f233 | "235" => f234 | "236" => f235 | "237" => f236 | "238" => f237 | "239" => f238 | "240" => f239 | "241" => f240 | "242" => f241 | "243" => f242 | "244" => f243 | "245" => f244 | "246" => f245 | "247" => f246 | "248" => f247 | "249" => f248 | "250" => f249 | "251" => f250 | "252" => f251 | "253" => f252 | "254" => f253 | "255" => f254 end : forall P : byte -> Prop, P "000" -> P "001" -> P "002" -> P "003" -> P "004" -> P "005" -> P "006" -> P "007" -> P "008" -> P "009" -> P "010" -> P "011" -> P "012" -> P "013" -> P "014" -> P "015" -> P "016" -> P "017" -> P "018" -> P "019" -> P "020" -> P "021" -> P "022" -> P "023" -> P "024" -> P "025" -> P "026" -> P "027" -> P "028" -> P "029" -> P "030" -> P "031" -> P " " -> P "!" -> P """" -> P "#" -> P "$" -> P "%" -> P "&" -> P "'" -> P "(" -> P ")" -> P "*" -> P "+" -> P "," -> P "-" -> P "." -> P "/" -> P "0" -> P "1" -> P "2" -> P "3" -> P "4" -> P "5" -> P "6" -> P "7" -> P "8" -> P "9" -> P ":" -> P ";" -> P "<" -> P "=" -> P ">" -> P "?" -> P "@" -> P "A" -> P "B" -> P "C" -> P "D" -> P "E" -> P "F" -> P "G" -> P "H" -> P "I" -> P "J" -> P "K" -> P "L" -> P "M" -> P "N" -> P "O" -> P "P" -> P "Q" -> P "R" -> P "S" -> P "T" -> P "U" -> P "V" -> P "W" -> P "X" -> P "Y" -> P "Z" -> P "[" -> P "\" -> P "]" -> P "^" -> P "_" -> P "`" -> P "a" -> P "b" -> P "c" -> P "d" -> P "e" -> P "f" -> P "g" -> P "h" -> P "i" -> P "j" -> P "k" -> P "l" -> P "m" -> P "n" -> P "o" -> P "p" -> P "q" -> P "r" -> P "s" -> P "t" -> P "u" -> P "v" -> P "w" -> P "x" -> P "y" -> P "z" -> P "{" -> P "|" -> P "}" -> P "~" -> P "127" -> P "128" -> P "129" -> P "130" -> P "131" -> P "132" -> P "133" -> P "134" -> P "135" -> P "136" -> P "137" -> P "138" -> P "139" -> P "140" -> P "141" -> P "142" -> P "143" -> P "144" -> P "145" -> P "146" -> P "147" -> P "148" -> P "149" -> P "150" -> P "151" -> P "152" -> P "153" -> P "154" -> P "155" -> P "156" -> P "157" -> P "158" -> P "159" -> P "160" -> P "161" -> P "162" -> P "163" -> P "164" -> P "165" -> P "166" -> P "167" -> P "168" -> P "169" -> P "170" -> P "171" -> P "172" -> P "173" -> P "174" -> P "175" -> P "176" -> P "177" -> P "178" -> P "179" -> P "180" -> P "181" -> P "182" -> P "183" -> P "184" -> P "185" -> P "186" -> P "187" -> P "188" -> P "189" -> P "190" -> P "191" -> P "192" -> P "193" -> P "194" -> P "195" -> P "196" -> P "197" -> P "198" -> P "199" -> P "200" -> P "201" -> P "202" -> P "203" -> P "204" -> P "205" -> P "206" -> P "207" -> P "208" -> P "209" -> P "210" -> P "211" -> P "212" -> P "213" -> P "214" -> P "215" -> P "216" -> P "217" -> P "218" -> P "219" -> P "220" -> P "221" -> P "222" -> P "223" -> P "224" -> P "225" -> P "226" -> P "227" -> P "228" -> P "229" -> P "230" -> P "231" -> P "232" -> P "233" -> P "234" -> P "235" -> P "236" -> P "237" -> P "238" -> P "239" -> P "240" -> P "241" -> P "242" -> P "243" -> P "244" -> P "245" -> P "246" -> P "247" -> P "248" -> P "249" -> P "250" -> P "251" -> P "252" -> P "253" -> P "254" -> P "255" -> forall b : byte, P b Arguments byte_ind P%function_scope f f0 f1 f2 f3 f4 f5 f6 f7 f8 f9 f10 f11 f12 f13 f14 f15 f16 f17 f18 f19 f20 f21 f22 f23 f24 f25 f26 f27 f28 f29 f30 f31 f32 f33 f34 f35 f36 f37 f38 f39 f40 f41 f42 f43 f44 f45 f46 f47 f48 f49 f50 f51 f52 f53 f54 f55 f56 f57 f58 f59 f60 f61 f62 f63 f64 f65 f66 f67 f68 f69 f70 f71 f72 f73 f74 f75 f76 f77 f78 f79 f80 f81 f82 f83 f84 f85 f86 f87 f88 f89 f90 f91 f92 f93 f94 f95 f96 f97 f98 f99 f100 f101 f102 f103 f104 f105 f106 f107 f108 f109 f110 f111 f112 f113 f114 f115 f116 f117 f118 f119 f120 f121 f122 f123 f124 f125 f126 f127 f128 f129 f130 f131 f132 f133 f134 f135 f136 f137 f138 f139 f140 f141 f142 f143 f144 f145 f146 f147 f148 f149 f150 f151 f152 f153 f154 f155 f156 f157 f158 f159 f160 f161 f162 f163 f164 f165 f166 f167 f168 f169 f170 f171 f172 f173 f174 f175 f176 f177 f178 f179 f180 f181 f182 f183 f184 f185 f186 f187 f188 f189 f190 f191 f192 f193 f194 f195 f196 f197 f198 f199 f200 f201 f202 f203 f204 f205 f206 f207 f208 f209 f210 f211 f212 f213 f214 f215 f216 f217 f218 f219 f220 f221 f222 f223 f224 f225 f226 f227 f228 f229 f230 f231 f232 f233 f234 f235 f236 f237 f238 f239 f240 f241 f242 f243 f244 f245 f246 f247 f248 f249 f250 f251 f252 f253 f254 b%byte_scope "000" : byte "a" : byte "127" : byte File "./output/StringSyntax.v", line 18, characters 11-16: The command has indeed failed with message: Expects a single character or a three-digit ASCII code. "000" : ascii "a" : ascii "127" : ascii File "./output/StringSyntax.v", line 25, characters 11-16: The command has indeed failed with message: Expects a single character or a three-digit ASCII code. "000" : string "a" : string "127" : string "€" : string "" : string = "a"%char : ascii = "a"%byte : byte = "a"%string : string = ["a"%byte] : list byte = ["000"; "001"; "002"; "003"; "004"; "005"; "006"; "007"; "008"; "009"; "010"; "011"; "012"; "013"; "014"; "015"; "016"; "017"; "018"; "019"; "020"; "021"; "022"; "023"; "024"; "025"; "026"; "027"; "028"; "029"; "030"; "031"; " "; "!"; """"; "#"; "$"; "%"; "&"; "'"; "("; ")"; "*"; "+"; ","; "-"; "."; "/"; "0"; "1"; "2"; "3"; "4"; "5"; "6"; "7"; "8"; "9"; ":"; ";"; "<"; "="; ">"; "?"; "@"; "A"; "B"; "C"; "D"; "E"; "F"; "G"; "H"; "I"; "J"; "K"; "L"; "M"; "N"; "O"; "P"; "Q"; "R"; "S"; "T"; "U"; "V"; "W"; "X"; "Y"; "Z"; "["; "\"; "]"; "^"; "_"; "`"; "a"; "b"; "c"; "d"; "e"; "f"; "g"; "h"; "i"; "j"; "k"; "l"; "m"; "n"; "o"; "p"; "q"; "r"; "s"; "t"; "u"; "v"; "w"; "x"; "y"; "z"; "{"; "|"; "}"; "~"; "127"; "128"; "129"; "130"; "131"; "132"; "133"; "134"; "135"; "136"; "137"; "138"; "139"; "140"; "141"; "142"; "143"; "144"; "145"; "146"; "147"; "148"; "149"; "150"; "151"; "152"; "153"; "154"; "155"; "156"; "157"; "158"; "159"; "160"; "161"; "162"; "163"; "164"; "165"; "166"; "167"; "168"; "169"; "170"; "171"; "172"; "173"; "174"; "175"; "176"; "177"; "178"; "179"; "180"; "181"; "182"; "183"; "184"; "185"; "186"; "187"; "188"; "189"; "190"; "191"; "192"; "193"; "194"; "195"; "196"; "197"; "198"; "199"; "200"; "201"; "202"; "203"; "204"; "205"; "206"; "207"; "208"; "209"; "210"; "211"; "212"; "213"; "214"; "215"; "216"; "217"; "218"; "219"; "220"; "221"; "222"; "223"; "224"; "225"; "226"; "227"; "228"; "229"; "230"; "231"; "232"; "233"; "234"; "235"; "236"; "237"; "238"; "239"; "240"; "241"; "242"; "243"; "244"; "245"; "246"; "247"; "248"; "249"; "250"; "251"; "252"; "253"; "254"; "255"] : list byte = ["000"; "001"; "002"; "003"; "004"; "005"; "006"; "007"; "008"; "009"; "010"; "011"; "012"; "013"; "014"; "015"; "016"; "017"; "018"; "019"; "020"; "021"; "022"; "023"; "024"; "025"; "026"; "027"; "028"; "029"; "030"; "031"; " "; "!"; """"; "#"; "$"; "%"; "&"; "'"; "("; ")"; "*"; "+"; ","; "-"; "."; "/"; "0"; "1"; "2"; "3"; "4"; "5"; "6"; "7"; "8"; "9"; ":"; ";"; "<"; "="; ">"; "?"; "@"; "A"; "B"; "C"; "D"; "E"; "F"; "G"; "H"; "I"; "J"; "K"; "L"; "M"; "N"; "O"; "P"; "Q"; "R"; "S"; "T"; "U"; "V"; "W"; "X"; "Y"; "Z"; "["; "\"; "]"; "^"; "_"; "`"; "a"; "b"; "c"; "d"; "e"; "f"; "g"; "h"; "i"; "j"; "k"; "l"; "m"; "n"; "o"; "p"; "q"; "r"; "s"; "t"; "u"; "v"; "w"; "x"; "y"; "z"; "{"; "|"; "}"; "~"; "127"; "128"; "129"; "130"; "131"; "132"; "133"; "134"; "135"; "136"; "137"; "138"; "139"; "140"; "141"; "142"; "143"; "144"; "145"; "146"; "147"; "148"; "149"; "150"; "151"; "152"; "153"; "154"; "155"; "156"; "157"; "158"; "159"; "160"; "161"; "162"; "163"; "164"; "165"; "166"; "167"; "168"; "169"; "170"; "171"; "172"; "173"; "174"; "175"; "176"; "177"; "178"; "179"; "180"; "181"; "182"; "183"; "184"; "185"; "186"; "187"; "188"; "189"; "190"; "191"; "192"; "193"; "194"; "195"; "196"; "197"; "198"; "199"; "200"; "201"; "202"; "203"; "204"; "205"; "206"; "207"; "208"; "209"; "210"; "211"; "212"; "213"; "214"; "215"; "216"; "217"; "218"; "219"; "220"; "221"; "222"; "223"; "224"; "225"; "226"; "227"; "228"; "229"; "230"; "231"; "232"; "233"; "234"; "235"; "236"; "237"; "238"; "239"; "240"; "241"; "242"; "243"; "244"; "245"; "246"; "247"; "248"; "249"; "250"; "251"; "252"; "253"; "254"; "255"] : list ascii "abc" : string "000" : nat "001" : nat "002" : nat "255" : nat File "./output/StringSyntax.v", line 95, characters 11-16: The command has indeed failed with message: Expects a single character or a three-digit ASCII code. "abc" : string2 "abc" : string2 : string2 "abc" : string1 : string1 coq-8.20.0/test-suite/output/StringSyntax.v000066400000000000000000000045671466560755400207330ustar00rootroot00000000000000Require Import Coq.Lists.List. Require Import Coq.Strings.String Coq.Strings.Byte Coq.Strings.Ascii. Import ListNotations. Set Printing Depth 100000. Set Printing Width 1000. Close Scope char_scope. Close Scope string_scope. Open Scope byte_scope. Print byte_rect. Print byte_rec. Print byte_ind. Check "000". Check "a". Check "127". Fail Check "€". Close Scope byte_scope. Open Scope char_scope. Check "000". Check "a". Check "127". Fail Check "€". Close Scope char_scope. Open Scope string_scope. Check "000". Check "a". Check "127". Check "€". Check String "001" EmptyString. Close Scope string_scope. Compute ascii_of_byte "a". Compute byte_of_ascii "a". Compute string_of_list_byte ("a"::nil)%byte. Compute list_byte_of_string "a". Local Open Scope byte_scope. Compute List.fold_right (fun n ls => match Byte.of_nat n with | Some b => cons b ls | None => ls end) nil (List.seq 0 256). Local Close Scope byte_scope. Local Open Scope char_scope. Compute List.map Ascii.ascii_of_nat (List.seq 0 256). Local Close Scope char_scope. (* Test numeral notations for parameterized inductives *) Module Test2. Notation string := (list Byte.byte). Definition id_string := @id string. String Notation string id_string id_string : list_scope. Check "abc"%list. End Test2. (* Test the via ... using ... option *) Module Test3. Inductive I := | IO : I | IS : I -> I. Definition of_byte (x : Byte.byte) : I := let fix f n := match n with | O => IO | S n => IS (f n) end in f (Byte.to_nat x). Definition to_byte (x : I) : option Byte.byte := let fix f i := match i with | IO => O | IS i => S (f i) end in Byte.of_nat (f x). String Notation nat of_byte to_byte (via I mapping [O => IO, S => IS]) : nat_scope. Check "000". Check "001". Check "002". Check "255". Fail Check "256". End Test3. (* Test overlapping string notations *) Module Test4. Notation string1 := (list Byte.byte). Definition id_string1 := @id string1. String Notation string1 id_string1 id_string1 : list_scope. Notation string2 := (list Ascii.ascii). Definition a2b := List.map byte_of_ascii. Definition b2a := List.map ascii_of_byte. String Notation string2 b2a a2b : list_scope. Check "abc"%list. Check ["a";"b";"c"]%char%list : string2. Check ["a";"b";"c"]%byte%list : string1. End Test4. coq-8.20.0/test-suite/output/StringSyntaxPrimitive.out000066400000000000000000000004571466560755400231600ustar00rootroot00000000000000"abc" : intList "abc" : intList mk_intList [97%uint63; 98%uint63; 99%uint63] : intList "abc" : intArray "abc" : intArray = "abc" : nestArray "abc" : nestArray "100" : floatList "100" : floatList mk_floatList [1%float; 0%float; 0%float] : floatList coq-8.20.0/test-suite/output/StringSyntaxPrimitive.v000066400000000000000000000117121466560755400226120ustar00rootroot00000000000000Require Import Coq.Lists.List. Require Import Coq.Strings.String Coq.Strings.Byte Coq.Strings.Ascii. Require Coq.Array.PArray Coq.Floats.PrimFloat. Require Import Coq.Numbers.BinNums Coq.Numbers.Cyclic.Int63.Uint63. Set Printing Depth 100000. Set Printing Width 1000. Close Scope char_scope. Close Scope string_scope. (* Notations for primitive integers inside polymorphic datatypes *) Module Test1. Inductive intList := mk_intList (_ : list int). Definition i63_from_byte (b : byte) : int := Uint63.of_Z (BinInt.Z.of_N (Byte.to_N b)). Definition i63_to_byte (i : int) : byte := match Byte.of_N (BinInt.Z.to_N (Uint63.to_Z i)) with Some x => x | None => x00%byte end. Definition to_byte_list '(mk_intList a) := List.map i63_to_byte a. Definition from_byte_list (xs : list byte) : intList:= mk_intList (List.map i63_from_byte xs). Declare Scope intList_scope. Delimit Scope intList_scope with intList. String Notation intList from_byte_list to_byte_list : intList_scope. Open Scope intList_scope. Import List.ListNotations. Check mk_intList [97; 98; 99]%uint63%list. Check "abc"%intList. Definition int' := int. Check mk_intList (@cons int' 97 [98; 99])%uint63%list. End Test1. Import PArray. (* Notations for primitive arrays *) Module Test2. Inductive intArray := mk_intArray (_ : array int). Definition i63_from_byte (b : byte) : Uint63.int := Uint63.of_Z (BinInt.Z.of_N (Byte.to_N b)). Definition i63_to_byte (i : Uint63.int) : byte := match Byte.of_N (BinInt.Z.to_N (Uint63.to_Z i)) with Some x => x | None => x00%byte end. Definition i63_to_nat x := BinInt.Z.to_nat (Uint63.to_Z x). Local Definition nat_length {X} (x : array X) :nat := i63_to_nat (length x). Local Fixpoint list_length_i63 {A} (xs : list A) :int := match xs with | nil => 0 | cons _ xs => 1 + list_length_i63 xs end. Definition to_byte_list '(mk_intArray a) := ((fix go (n : nat) (i : Uint63.int) (acc : list byte) := match n with | 0 => acc | S n => go n (i - 1) (cons (i63_to_byte a.[i]) acc) end) (nat_length a) (length a - 1) nil)%uint63. Definition from_byte_list (xs : list byte) := (let arr := make (list_length_i63 xs) 0 in mk_intArray ((fix go i xs acc := match xs with | nil => acc | cons x xs => go (i + 1) xs (acc.[i <- i63_from_byte x]) end) 0 xs arr))%uint63. Declare Scope intArray_scope. Delimit Scope intArray_scope with intArray. String Notation intArray from_byte_list to_byte_list : intArray_scope. Open Scope intArray_scope. Check mk_intArray ( [| 97; 98; 99 | 0|])%uint63%array. Check "abc"%intArray. End Test2. (* Primitive arrays inside primitive arrays *) Module Test3. Inductive nestArray := mk_nestArray (_ : array (array int)). Definition to_byte_list '(mk_nestArray a) := ((fix go (n : nat) (i : Uint63.int) (acc : list byte) := match n with | 0 => acc | S n => go n (i - 1) (cons (Test2.i63_to_byte a.[i].[0]) acc) end) (Test2.nat_length a) (length a - 1) nil)%uint63. Definition from_byte_list (xs : list byte) := (let arr := make (Test2.list_length_i63 xs) (make 0 0) in mk_nestArray ((fix go i xs acc := match xs with | nil => acc | cons x xs => go (i + 1) xs (acc.[i <- make 1 (Test2.i63_from_byte x)]) end) 0 xs arr))%uint63. Declare Scope nestArray_scope. Delimit Scope nestArray_scope with nestArray. String Notation nestArray from_byte_list to_byte_list : nestArray_scope. Open Scope nestArray_scope. Eval cbv in mk_nestArray ( [| make 1 97; make 1 98; make 1 99 | make 0 0|])%uint63%array. Check "abc"%nestArray. End Test3. (* Notations for primitive floats inside polymorphic datatypes *) Module Test4. Import PrimFloat. Inductive floatList := mk_floatList (_ : list float). Definition float_from_byte (b : byte) : float := if Byte.eqb b "0"%byte then PrimFloat.zero else PrimFloat.one. Definition float_to_byte (f : float) : byte := if PrimFloat.is_zero f then "0" else "1". Definition to_byte_list '(mk_floatList a) := List.map float_to_byte a. Definition from_byte_list (xs : list byte) : floatList:= mk_floatList (List.map float_from_byte xs). Declare Scope floatList_scope. Delimit Scope floatList_scope with floatList. String Notation floatList from_byte_list to_byte_list : floatList_scope. Open Scope floatList_scope. Import List.ListNotations. Check mk_floatList [97; 0; 0]%float%list. Check "100"%floatList. Definition float' := float. Check mk_floatList (@cons float' 1 [0; 0])%float%list. End Test4. Module Bug11237. Inductive bytes := wrap_bytes { unwrap_bytes : list byte }. Declare Scope bytes_scope. Delimit Scope bytes_scope with bytes. Bind Scope bytes_scope with bytes. String Notation bytes wrap_bytes unwrap_bytes : bytes_scope. Open Scope bytes_scope. Example test_match := match "foo" with | "foo" => "bar" | "bar" => "foo" | x => x end. End Bug11237. coq-8.20.0/test-suite/output/Succeed.out000066400000000000000000000006131466560755400201570ustar00rootroot000000000000000 : nat File "./output/Succeed.v", line 5, characters 11-12: The command has indeed failed with message: The reference x was not found in the current environment. File "./output/Succeed.v", line 7, characters 19-23: The command has indeed failed with message: The term "Prop" has type "Type" while it is expected to have type "Prop" (universe inconsistency: Cannot enforce Set+1 <= Prop). coq-8.20.0/test-suite/output/Succeed.v000066400000000000000000000001351466560755400176140ustar00rootroot00000000000000 Succeed Check 0. Succeed Definition x := 0. Fail Check x. Fail Succeed Check Prop : Prop. coq-8.20.0/test-suite/output/SuggestProofUsing.out000066400000000000000000000005411466560755400222410ustar00rootroot00000000000000The proof of Nat should start with one of the following commands: Proof using . Proof using Type*. Proof using Type. The proof of foo should start with one of the following commands: Proof using A B. Proof using All. The proof of sec_exactproof should start with one of the following commands: Proof using . Proof using Type*. Proof using Type. coq-8.20.0/test-suite/output/SuggestProofUsing.v000066400000000000000000000022131466560755400216750ustar00rootroot00000000000000Require Program.Tactics. Set Suggest Proof Using. Set Warnings "-opaque-let". Lemma nosec : nat. Proof. exact 0. Qed. Lemma nosec_exactproof : bool. Proof false. Program Definition nosec_program : nat := _. Next Obligation. exact 1. Qed. Lemma nosec_abstract : nat. Proof. abstract exact 3. Defined. Section Sec. Variables A B : Type. (* Some normal lemma. *) Lemma Nat : Set. Proof. exact nat. Qed. (* Make sure All is suggested even though we add an unused variable to the context. *) Let foo : Type. Proof. exact (A -> B). Qed. (* Having a [Proof using] disables the suggestion message. *) Definition bar : Type. Proof using A. exact A. Qed. (* Transparent definitions don't get a suggestion message. *) Definition baz : Type. Proof. exact A. Defined. (* No suggest, is this OK? There's nowhere to put it anyway. *) Program Definition program : nat := _. Next Obligation. exact 1. Qed. (* Must not suggest *) Lemma sec_abstract : nat. Proof. abstract exact 3. Defined. (* Suggests even though there's nowhere to put it, bug? *) Lemma sec_exactproof : bool. Proof true. End Sec. coq-8.20.0/test-suite/output/Sum.out000066400000000000000000000001431466560755400173460ustar00rootroot00000000000000nat + nat + {True} : Set {True} + {True} + {True} : Set nat + {True} + {True} : Set coq-8.20.0/test-suite/output/Sum.v000066400000000000000000000001351466560755400170050ustar00rootroot00000000000000Check (nat + nat + {True}). Check ({True} + {True} + {True}). Check (nat + {True} + {True}). coq-8.20.0/test-suite/output/Tactics.out000066400000000000000000000013351466560755400202000ustar00rootroot00000000000000Ltac f H := split; [ a H | e H ] Ltac g := match goal with | |- context [ if ?X then _ else _ ] => case X end File "./output/Tactics.v", line 22, characters 13-19: The command has indeed failed with message: H is already used. File "./output/Tactics.v", line 23, characters 20-26: The command has indeed failed with message: H is already used. a File "./output/Tactics.v", line 36, characters 29-34: The command has indeed failed with message: The term "False" has type "Prop" while it is expected to have type "True". File "./output/Tactics.v", line 42, characters 16-17: The command has indeed failed with message: This variable is used in hypothesis H. Ltac test a b c d e := apply a, b in c as [], d, e as -> coq-8.20.0/test-suite/output/Tactics.v000066400000000000000000000021431466560755400176340ustar00rootroot00000000000000(* Test printing of Tactic Notation *) Tactic Notation "a" constr(x) := apply x. Tactic Notation "e" constr(x) := exact x. Ltac f H := split; [a H|e H]. Print Ltac f. (* Test printing of match context *) (* Used to fail after translator removal (see BZ#1070) *) Ltac g := match goal with |- context [if ?X then _ else _ ] => case X end. Print Ltac g. (* Test an error message (BZ#5390) *) Lemma myid (P : Prop) : P <-> P. Proof. split; auto. Qed. Goal True -> (True /\ True) -> True. Proof. intros H. Fail intros [H%myid ?]. Fail destruct 1 as [H%myid ?]. Abort. (* Test that assert_succeeds only runs a tactic once *) Ltac should_not_loop := idtac + should_not_loop. Goal True. assert_succeeds should_not_loop. assert_succeeds (idtac "a" + idtac "b"). (* should only output "a" *) Abort. (* assert_succeeds preserves the error *) Goal True. Fail assert_succeeds exact False. Abort. Module IntroWildcard. Theorem foo : { p:nat*nat & p = (0,0) } -> True. Fail intros ((n,_),H). Abort. End IntroWildcard. Module ApplyIn. Ltac test a b c d e := apply a, b in c as [], d, e as ->. Print test. End ApplyIn. coq-8.20.0/test-suite/output/TermSyntax.out000066400000000000000000000004041466560755400207200ustar00rootroot00000000000000nat * nat : Type : Type 0 * 0 : nat : nat 0 * 0 : Z : Z File "./output/TermSyntax.v", line 11, characters 16-21: The command has indeed failed with message: Unknown interpretation for notation "{ _ ; _ }". λ '(exist _ x _), x : b → bool coq-8.20.0/test-suite/output/TermSyntax.v000066400000000000000000000005021466560755400203550ustar00rootroot00000000000000(* Check cast setting scopes *) Check nat * nat : Type. Check 0 * 0 : nat. Require Import ZArith. Check 0 * 0 : Z. Declare Scope b_scope. Definition b := {x:bool|x=true}. Notation "{ x ; y }" := (exist _ x y) : b_scope. Require Import Utf8. Fail Check λ '({x;y}:b), x. Bind Scope b_scope with b. Check λ '({x;y}:b), x. coq-8.20.0/test-suite/output/TranspModtype.out000066400000000000000000000001311466560755400214100ustar00rootroot00000000000000TrM.A = M.A : Set OpM.A = M.A : Set TrM.B = M.B : Set *** [ OpM.B : Set ] coq-8.20.0/test-suite/output/TranspModtype.v000066400000000000000000000006011466560755400210500ustar00rootroot00000000000000Module Type SIG. Axiom A : Set. Axiom B : Set. End SIG. Module M : SIG. Definition A := nat. Definition B := nat. End M. Module N <: SIG := M. Module TranspId (X: SIG) <: SIG with Definition A := X.A := X. Module OpaqueId (X: SIG) : SIG with Definition A := X.A := X. Module TrM := TranspId M. Module OpM := OpaqueId M. Print TrM.A. Print OpM.A. Print TrM.B. Print OpM.B. coq-8.20.0/test-suite/output/TypeclassDebug.out000066400000000000000000000015111466560755400215200ustar00rootroot00000000000000Debug: 1: looking for foo without backtracking Debug: 1.1: simple apply H on foo, 1 subgoal(s) Debug: 1.1-1 : foo Debug: 1.1-1: looking for foo without backtracking Debug: 1.1-1.1: simple apply H on foo, 1 subgoal(s) Debug: 1.1-1.1-1 : foo Debug: 1.1-1.1-1: looking for foo without backtracking Debug: 1.1-1.1-1.1: simple apply H on foo, 1 subgoal(s) Debug: 1.1-1.1-1.1-1 : foo Debug: 1.1-1.1-1.1-1: looking for foo without backtracking Debug: 1.1-1.1-1.1-1.1: simple apply H on foo, 1 subgoal(s) Debug: 1.1-1.1-1.1-1.1-1 : foo Debug: 1.1-1.1-1.1-1.1-1: looking for foo without backtracking Debug: 1.1-1.1-1.1-1.1-1.1: simple apply H on foo, 1 subgoal(s) Debug: 1.1-1.1-1.1-1.1-1.1-1 : foo File "./output/TypeclassDebug.v", line 9, characters 5-33: The command has indeed failed with message: Tactic failure: Proof search reached its limit. coq-8.20.0/test-suite/output/TypeclassDebug.v000066400000000000000000000003641466560755400211630ustar00rootroot00000000000000(* show alternating separators in typeclass debug output; see discussion in PR #868 *) Parameter foo : Prop. Axiom H : foo -> foo. #[global] Hint Resolve H : foo. Goal foo. Typeclasses eauto := debug. Fail typeclasses eauto 5 with foo. Abort. coq-8.20.0/test-suite/output/UnboundRef.out000066400000000000000000000002361466560755400206540ustar00rootroot00000000000000File "./output/UnboundRef.v", line 1, characters 16-17: The command has indeed failed with message: The reference a was not found in the current environment. coq-8.20.0/test-suite/output/UnboundRef.v000066400000000000000000000001231466560755400203050ustar00rootroot00000000000000Fail Check Prop a b. (* Prop is because we need a real head for the application *) coq-8.20.0/test-suite/output/UnclosedBlocks.out000066400000000000000000000001441466560755400215150ustar00rootroot00000000000000Error: The section Baz, module type Bar and module Foo need to be closed. coqc exited with code 1 coq-8.20.0/test-suite/output/UnclosedBlocks.v000066400000000000000000000002661466560755400211600ustar00rootroot00000000000000Module Foo. Module Closed. End Closed. Module Type Bar. Section Baz. (* end-of-compilation error message reports unclosed sections, blocks, and module types *) coq-8.20.0/test-suite/output/UnexpectedType.out000066400000000000000000000003751466560755400215570ustar00rootroot00000000000000File "./output/UnexpectedType.v", line 33, characters 22-30: The command has indeed failed with message: Found type "A → UU" where "?T" was expected (unable to find a well-typed instantiation for "?T": cannot ensure that "Type" is a subtype of "UU"). coq-8.20.0/test-suite/output/UnexpectedType.v000066400000000000000000000017451466560755400212170ustar00rootroot00000000000000 Notation "'λ' x .. y , t" := (fun x => .. (fun y => t) ..) (at level 200, x binder, y binder, right associativity). (* type this in emacs in agda-input method with \lambda *) Notation "x → y" := (x -> y) (at level 99, y at level 200, right associativity): type_scope. (* written \to or \r- in Agda input method *) (* the level comes from sub/coq/theories/Unicode/Utf8_core.v *) Set Primitive Projections. Set Nonrecursive Elimination Schemes. Definition UU := Type. Identity Coercion fromUUtoType : UU >-> Sortclass. Record total2 { T: UU } ( P: T -> UU ) := tpair { pr1 : T; pr2 : P pr1 }. Arguments tpair {_} _ _ _. Arguments pr1 {_ _} _. Arguments pr2 {_ _} _. Notation "'∑' x .. y , P" := (total2 (λ x, .. (total2 (λ y, P)) ..)) (at level 200, x binder, y binder, right associativity) : type_scope. (* type this in emacs in agda-input method with \sum *) Section Test. Variables (A : UU) (P: (A → UU) → UU). Fail Check ∑ (F : A → UU), P(F). End Test. coq-8.20.0/test-suite/output/Unicode.out000066400000000000000000000025661466560755400202030ustar00rootroot000000000000001 goal very_very_long_type_name1 : Type very_very_long_type_name2 : Type f : very_very_long_type_name1 → very_very_long_type_name2 → Prop ============================ True → True → ∀ (x : very_very_long_type_name1) (y : very_very_long_type_name2), f x y ∧ f x y ∧ f x y ∧ f x y ∧ f x y ∧ f x y 1 goal very_very_long_type_name1 : Type very_very_long_type_name2 : Type f : very_very_long_type_name1 → very_very_long_type_name2 → Prop ============================ True → True → ∀ (x : very_very_long_type_name2) (y : very_very_long_type_name1) (z : very_very_long_type_name2), f y x ∧ f y z 1 goal very_very_long_type_name1 : Type very_very_long_type_name2 : Type f : very_very_long_type_name1 → very_very_long_type_name2 → Prop ============================ True → True → ∀ (x : very_very_long_type_name2) (y : very_very_long_type_name1) (z : very_very_long_type_name2), f y x ∧ f y z ∧ f y x ∧ f y z ∧ f y x ∧ f y z 1 goal very_very_long_type_name1 : Type very_very_long_type_name2 : Type f : very_very_long_type_name1 → very_very_long_type_name2 → Prop ============================ True → True → ∃ (x : very_very_long_type_name1) (y : very_very_long_type_name2), f x y ∧ f x y ∧ f x y ∧ f x y ∧ f x y ∧ f x y coq-8.20.0/test-suite/output/Unicode.v000066400000000000000000000017251466560755400176350ustar00rootroot00000000000000Require Import Coq.Unicode.Utf8. Section test. Context (very_very_long_type_name1 : Type) (very_very_long_type_name2 : Type). Context (f : very_very_long_type_name1 -> very_very_long_type_name2 -> Prop). Lemma test : True -> True -> forall (x : very_very_long_type_name1) (y : very_very_long_type_name2), f x y /\ f x y /\ f x y /\ f x y /\ f x y /\ f x y. Proof. Show. Abort. Lemma test : True -> True -> forall (x : very_very_long_type_name2) (y : very_very_long_type_name1) (z : very_very_long_type_name2), f y x /\ f y z. Proof. Show. Abort. Lemma test : True -> True -> forall (x : very_very_long_type_name2) (y : very_very_long_type_name1) (z : very_very_long_type_name2), f y x /\ f y z /\ f y x /\ f y z /\ f y x /\ f y z. Proof. Show. Abort. Lemma test : True -> True -> exists (x : very_very_long_type_name1) (y : very_very_long_type_name2), f x y /\ f x y /\ f x y /\ f x y /\ f x y /\ f x y. Proof. Show. Abort. End test. coq-8.20.0/test-suite/output/UnivBinders.out000066400000000000000000000170011466560755400210330ustar00rootroot00000000000000Inductive Empty@{uu} : Type@{uu} := . (* uu |= *) Record PWrap@{uu} (A : Type@{uu}) : Type@{uu} := pwrap { punwrap : A }. (* uu |= *) PWrap has primitive projections with eta conversion. Arguments PWrap A%type_scope Arguments pwrap A%type_scope punwrap Arguments punwrap A%type_scope p Record PWrap@{uu} (A : Type@{uu}) : Type@{uu} := pwrap { punwrap : A }. (* uu |= *) PWrap has primitive projections with eta conversion. Arguments PWrap A%type_scope Arguments pwrap A%type_scope punwrap Arguments punwrap A%type_scope p Record RWrap@{uu} (A : Type@{uu}) : Type@{uu} := rwrap { runwrap : A }. (* uu |= *) Arguments RWrap A%type_scope Arguments rwrap A%type_scope runwrap Arguments runwrap A%type_scope r runwrap@{uu} = fun (A : Type@{uu}) (r : RWrap@{uu} A) => let (runwrap) := r in runwrap : forall A : Type@{uu}, RWrap@{uu} A -> A (* uu |= *) runwrap is a projection of RWrap Arguments runwrap A%type_scope r Wrap@{uu} = fun A : Type@{uu} => A : Type@{uu} -> Type@{uu} (* uu |= *) Arguments Wrap A%type_scope wrap@{uu} = fun (A : Type@{uu}) (Wrap : Wrap@{uu} A) => Wrap : forall {A : Type@{uu}}, Wrap@{uu} A -> A (* uu |= *) Arguments wrap {A}%type_scope {Wrap} bar@{uu} = nat : Wrap@{uu} Set (* uu |= Set < uu *) foo@{uu u v} = Type@{u} -> Type@{v} -> Type@{uu} : Type@{max(uu+1,u+1,v+1)} (* uu u v |= *) Type@{i} -> Type@{j} : Type@{max(i+1,j+1)} (* {j i} |= *) = Type@{i} -> Type@{j} : Type@{max(i+1,j+1)} (* {j i} |= *) mono = Type@{mono.uu} : Type@{mono.uu+1} mono : Type@{mono.uu+1} Type@{mono.uu} : Type@{mono.uu+1} File "./output/UnivBinders.v", line 50, characters 2-31: The command has indeed failed with message: Universe uu already exists. monomono : Type@{MONOU+1} mono.monomono : Type@{mono.MONOU+1} monomono : Type@{MONOU+1} mono : Type@{mono.uu+1} File "./output/UnivBinders.v", line 70, characters 0-52: The command has indeed failed with message: Universe uu already exists. bobmorane = let tt := Type@{UnivBinders.32} in let ff := Type@{UnivBinders.34} in tt -> ff : Type@{max(UnivBinders.31,UnivBinders.33)} File "./output/UnivBinders.v", line 85, characters 23-25: The command has indeed failed with message: Universe uu already bound. foo@{E M N} = Type@{M} -> Type@{N} -> Type@{E} : Type@{max(E+1,M+1,N+1)} (* E M N |= *) foo@{uu u v} = Type@{u} -> Type@{v} -> Type@{uu} : Type@{max(uu+1,u+1,v+1)} (* uu u v |= *) foo@{u u IMPORTANT} = Type@{u} -> Type@{IMPORTANT} -> Type@{u} : Type@{max(u+1,u+1,IMPORTANT+1)} (* u u IMPORTANT |= *) Inductive Empty@{E} : Type@{E} := . (* E |= *) Record PWrap@{E} (A : Type@{E}) : Type@{E} := pwrap { punwrap : A }. (* E |= *) PWrap has primitive projections with eta conversion. Arguments PWrap A%type_scope Arguments pwrap A%type_scope punwrap Arguments punwrap A%type_scope p punwrap@{K} : forall A : Type@{K}, PWrap@{K} A -> A (* K |= *) punwrap is universe polymorphic punwrap is a primitive projection of PWrap Arguments punwrap A%type_scope p punwrap is transparent Expands to: Constant UnivBinders.punwrap File "./output/UnivBinders.v", line 102, characters 0-19: The command has indeed failed with message: Universe instance length is 3 but should be 1. File "./output/UnivBinders.v", line 103, characters 0-20: The command has indeed failed with message: Universe instance length is 0 but should be 1. File "./output/UnivBinders.v", line 106, characters 0-30: The command has indeed failed with message: This object does not support universe names. File "./output/UnivBinders.v", line 110, characters 0-50: The command has indeed failed with message: Cannot enforce v < u because u < gU < gV < v insec@{v} = Type@{uu} -> Type@{v} : Type@{max(uu+1,v+1)} (* v |= *) Inductive insecind@{k} : Type@{k+1} := inseccstr : Type@{k} -> insecind@{k}. (* k |= *) Arguments inseccstr _%type_scope insec@{uu v} = Type@{uu} -> Type@{v} : Type@{max(uu+1,v+1)} (* uu v |= *) Inductive insecind@{uu k} : Type@{k+1} := inseccstr : Type@{k} -> insecind@{uu k}. (* uu k |= *) Arguments inseccstr _%type_scope insec2@{u} = Prop : Type@{Set+1} (* u |= *) inmod@{uu} = Type@{uu} : Type@{uu+1} (* uu |= *) SomeMod.inmod@{uu} = Type@{uu} : Type@{uu+1} (* uu |= *) inmod@{uu} = Type@{uu} : Type@{uu+1} (* uu |= *) Applied.infunct@{uu v} = inmod@{uu} -> Type@{v} : Type@{max(uu+1,v+1)} (* uu v |= *) axfoo@{i u u0} : Type@{u} -> Type@{i} (* i u u0 |= *) axfoo is universe polymorphic Arguments axfoo _%type_scope Expands to: Constant UnivBinders.axfoo axbar@{i u u0} : Type@{u0} -> Type@{i} (* i u u0 |= *) axbar is universe polymorphic Arguments axbar _%type_scope Expands to: Constant UnivBinders.axbar axfoo' : Type@{axfoo'.u0} -> Type@{axfoo'.i} axfoo' is not universe polymorphic Arguments axfoo' _%type_scope Expands to: Constant UnivBinders.axfoo' axbar' : Type@{axfoo'.u0} -> Type@{axfoo'.i} axbar' is not universe polymorphic Arguments axbar' _%type_scope Expands to: Constant UnivBinders.axbar' *** [ axfoo@{i u u0} : Type@{u} -> Type@{i} ] (* i u u0 |= *) Arguments axfoo _%type_scope *** [ axbar@{i u u0} : Type@{u0} -> Type@{i} ] (* i u u0 |= *) Arguments axbar _%type_scope *** [ axfoo' : Type@{axfoo'.u0} -> Type@{axfoo'.i} ] Arguments axfoo' _%type_scope *** [ axbar' : Type@{axfoo'.u0} -> Type@{axfoo'.i} ] Arguments axbar' _%type_scope File "./output/UnivBinders.v", line 157, characters 19-26: The command has indeed failed with message: When declaring multiple assumptions in one command, only the first name is allowed to mention a universe binder (which will be shared by the whole block). foo@{i} = Type@{M.i} -> Type@{i} : Type@{max(M.i+1,i+1)} (* i |= *) Type@{u0} -> Type@{UnivBinders.64} : Type@{max(u0+1,UnivBinders.64+1)} (* {UnivBinders.64} |= *) bind_univs.mono = Type@{bind_univs.mono.u} : Type@{bind_univs.mono.u+1} bind_univs.poly@{u} = Type@{u} : Type@{u+1} (* u |= *) Inductive MutualR1@{u} (A : Type@{u}) : Prop := Build_MutualR1 : MutualR2@{u} A -> MutualR1@{u} A with MutualR2@{u} (A : Type@{u}) : Prop := Build_MutualR2 : MutualR1@{u} A -> MutualR2@{u} A. (* u |= *) Arguments MutualR1 A%type_scope Arguments Build_MutualR1 A%type_scope p1 Arguments p1 A%type_scope m Arguments MutualR2 A%type_scope Arguments Build_MutualR2 A%type_scope p2 Arguments p2 A%type_scope m Inductive MutualI1@{u u0} (A : Type@{u}) : Type@{u0} := C1 : MutualI2@{u u0} A -> MutualI1@{u u0} A with MutualI2@{u u0} (A : Type@{u}) : Type@{u0} := C2 : MutualI1@{u u0} A -> MutualI2@{u u0} A. (* u u0 |= *) Arguments MutualI1 A%type_scope Arguments C1 A%type_scope p1 Arguments MutualI2 A%type_scope Arguments C2 A%type_scope p2 CoInductive MutualR1'@{u} (A : Type@{u}) : Prop := Build_MutualR1' : MutualR2'@{u} A -> MutualR1'@{u} A with MutualR2'@{u} (A : Type@{u}) : Prop := Build_MutualR2' : MutualR1'@{u} A -> MutualR2'@{u} A. (* u |= *) Arguments MutualR1' A%type_scope Arguments Build_MutualR1' A%type_scope p1' Arguments p1' A%type_scope m Arguments MutualR2' A%type_scope Arguments Build_MutualR2' A%type_scope p2' Arguments p2' A%type_scope m CoInductive MutualI1'@{u u0} (A : Type@{u}) : Type@{u0} := C1' : MutualI2'@{u u0} A -> MutualI1'@{u u0} A with MutualI2'@{u u0} (A : Type@{u}) : Type@{u0} := C2' : MutualI1'@{u u0} A -> MutualI2'@{u u0} A. (* u u0 |= *) Arguments MutualI1' A%type_scope Arguments C1' A%type_scope p1 Arguments MutualI2' A%type_scope Arguments C2' A%type_scope p2 File "./output/UnivBinders.v", line 208, characters 0-33: The command has indeed failed with message: Universe inconsistency. Cannot enforce a < a because a = a. coq-8.20.0/test-suite/output/UnivBinders.v000066400000000000000000000125441466560755400205000ustar00rootroot00000000000000(* -*- coq-prog-args: ("-top" "UnivBinders"); -*- *) Set Universe Polymorphism. Set Printing Universes. (* Unset Strict Universe Declaration. *) (* universe binders on inductive types and record projections *) Inductive Empty@{uu} : Type@{uu} := . Print Empty. Set Primitive Projections. Record PWrap@{uu} (A:Type@{uu}) := pwrap { punwrap : A }. Print PWrap. Print punwrap. Unset Primitive Projections. Record RWrap@{uu} (A:Type@{uu}) := rwrap { runwrap : A }. Print RWrap. Print runwrap. (* universe binders also go on the constants for operational typeclasses. *) Class Wrap@{uu} (A:Type@{uu}) := wrap : A. Print Wrap. Print wrap. (* Instance in lemma mode used to ignore the binders. *) #[global] Instance bar@{uu} : Wrap@{uu} Set. Proof. exact nat. Qed. Print bar. Unset Strict Universe Declaration. (* The universes in the binder come first, then the extra universes in order of appearance. *) Definition foo@{uu +} := Type -> Type@{v} -> Type@{uu}. Print foo. Check Type@{i} -> Type@{j}. Eval cbv in Type@{i} -> Type@{j}. Set Strict Universe Declaration. (* Binders even work with monomorphic definitions! *) Monomorphic Definition mono@{uu} := Type@{uu}. Print mono. Check mono. Check Type@{mono.uu}. Module mono. Fail Monomorphic Universe uu. Monomorphic Universe MONOU. Monomorphic Definition monomono := Type@{MONOU}. Check monomono. Monomorphic Inductive monoind@{i} : Type@{i} := . Monomorphic Record monorecord@{i} : Type@{i} := mkmonorecord {}. End mono. Check mono.monomono. (* qualified MONOU *) Import mono. Check monomono. (* unqualified MONOU *) Check mono. (* still qualified mono.u *) Monomorphic Constraint Set < UnivBinders.mono.uu. Module mono2. Monomorphic Universe uu. End mono2. Fail Monomorphic Definition mono2@{uu} := Type@{uu}. Module SecLet. Unset Universe Polymorphism. Section foo. (* Fail Let foo@{} := Type@{uu}. (* doesn't parse: Let foo@{...} doesn't exist *) *) Unset Strict Universe Declaration. Let tt : Type@{uu} := Type@{v}. (* names disappear in the ether *) #[clearbody] Let ff : Type@{uu}. Proof. exact Type@{v}. Defined. (* names disappear into space *) Definition bobmorane := tt -> ff. End foo. Print bobmorane. End SecLet. (* fun x x => foo is nonsense with local binders *) Fail Definition fo@{uu uu} := Type@{uu}. (* Using local binders for printing. *) Print foo@{E M N}. (* Underscores discard the name if there's one. *) Print foo@{_ _ _}. (* Can use a name for multiple universes *) Print foo@{u u IMPORTANT}. (* Also works for inductives and records. *) Print Empty@{E}. Print PWrap@{E}. (* Also works for About. *) About punwrap@{K}. (* Instance length check. *) Fail Print foo@{E}. Fail Print mono@{E}. (* Not everything can be printed with custom universe names. *) Fail Print Coq.Init.Logic@{E}. (* Nice error when constraints are impossible. *) Monomorphic Universes gU gV. Monomorphic Constraint gU < gV. Fail Lemma foo'@{u v|u < gU, gV < v, v < u} : nat. Section SomeSec. Universe uu. Definition insec@{v} := Type@{uu} -> Type@{v}. Print insec. Inductive insecind@{k} := inseccstr : Type@{k} -> insecind. Print insecind. End SomeSec. Print insec. Print insecind. Section SomeSec2. Universe u. Definition insec2@{} := Prop. End SomeSec2. Print insec2. Module SomeMod. Definition inmod@{uu} := Type@{uu}. Print inmod. End SomeMod. Print SomeMod.inmod. Import SomeMod. Print inmod. Module Type SomeTyp. Definition inmod := Type. End SomeTyp. Module SomeFunct (In : SomeTyp). Definition infunct@{uu v} := In.inmod@{uu} -> Type@{v}. End SomeFunct. Module Applied := SomeFunct(SomeMod). Print Applied.infunct. (* Multi-axiom declaration In polymorphic mode the domain Type gets separate universes for the different axioms, but all axioms have to declare all universes. In monomorphic mode they get the same universes, ie the type is only interpd once. *) Axiom axfoo@{i+} axbar : Type -> Type@{i}. Monomorphic Axiom axfoo'@{i+} axbar' : Type -> Type@{i}. About axfoo. About axbar. About axfoo'. About axbar'. Print axfoo. Print axbar. Print axfoo'. Print axbar'. Fail Axiom failfoo failbar@{i} : Type. (* Notation interaction *) Module Notas. Unset Universe Polymorphism. Module Import M. Universe i. End M. Polymorphic Definition foo@{i} := Type@{M.i} -> Type@{i}. Print foo. (* must not print Type@{i} -> Type@{i} *) End Notas. Module NoAutoNames. Monomorphic Universe u0. (* The anonymous universe doesn't get a name (names are only invented at the end of a definition/inductive) so no need to qualify u0. *) Check (Type@{u0} -> Type). End NoAutoNames. (* Universe binders survive through compilation, sections and modules. *) Require TestSuite.bind_univs. Print bind_univs.mono. Print bind_univs.poly. Module MutualTypes. Inductive MutualR1 (A:Type) := { p1 : MutualR2 A } with MutualR2 (A:Type) := { p2 : MutualR1 A }. Print MutualR1. Inductive MutualI1 (A:Type) := C1 (p1 : MutualI2 A) with MutualI2 (A:Type) := C2 (p2 : MutualI1 A). Print MutualI1. CoInductive MutualR1' (A:Type) := { p1' : MutualR2' A } with MutualR2' (A:Type) := { p2' : MutualR1' A }. Print MutualR1'. CoInductive MutualI1' (A:Type) := C1' (p1 : MutualI2' A) with MutualI2' (A:Type) := C2' (p2 : MutualI1' A). Print MutualI2'. End MutualTypes. Module Inconsistency. Set Universe Polymorphism. Definition g@{a b} := Type@{a} : Type@{b}. Fail Definition h@{a} := g@{a a}. End Inconsistency. coq-8.20.0/test-suite/output/UpdateLoc.out000066400000000000000000000005221466560755400204630ustar00rootroot00000000000000File "./output/UpdateLoc.v", line 5, characters 14-15: The command has indeed failed with message: The term "0" has type "nat" while it is expected to have type "False". File "./output/UpdateLoc.v", line 6, characters 7-9: The command has indeed failed with message: The term "0" has type "nat" while it is expected to have type "False". coq-8.20.0/test-suite/output/UpdateLoc.v000066400000000000000000000002761466560755400201270ustar00rootroot00000000000000Ltac r0 := refine 0. Goal False. Proof. Fail refine 0. (* before: whole tactic, after: just 0 *) Fail r0. (* before: "refine 0" in the ltac definition, after: r0 in this line *) Abort. coq-8.20.0/test-suite/output/UsePluginWarning.out000066400000000000000000000000161466560755400220420ustar00rootroot00000000000000type foo = __ coq-8.20.0/test-suite/output/UsePluginWarning.v000066400000000000000000000002031466560755400214760ustar00rootroot00000000000000(* -*- mode: coq; coq-prog-args: ("-w" "-extraction-logical-axiom") -*- *) Require Extraction. Axiom foo : Prop. Extraction foo. coq-8.20.0/test-suite/output/UselessSyndef.out000066400000000000000000000000151466560755400213740ustar00rootroot00000000000000a : nat coq-8.20.0/test-suite/output/UselessSyndef.v000066400000000000000000000001721466560755400210360ustar00rootroot00000000000000Module M. Definition a := 0. End M. Module N. Notation a := M.a (only parsing). End N. Import M. Import N. Check a. coq-8.20.0/test-suite/output/Utf8Impargs.out000066400000000000000000000002201466560755400207470ustar00rootroot00000000000000id : ∀ {A : Type}, A -> A id is not universe polymorphic Arguments id {A}%type_scope a id is transparent Expands to: Constant Utf8Impargs.id coq-8.20.0/test-suite/output/Utf8Impargs.v000066400000000000000000000003741466560755400204170ustar00rootroot00000000000000Notation "∀ x .. y , P" := (forall x, .. (forall y, P) ..) (at level 200, x binder, y binder, right associativity, format "'[ ' '[ ' ∀ x .. y ']' , '/' P ']'") : type_scope. (* from Utf8_core.v *) Definition id {A} (a:A) := a. About id. coq-8.20.0/test-suite/output/Warnings.out000066400000000000000000000003221466560755400203710ustar00rootroot00000000000000File "./output/Warnings.v", line 4, characters 0-22: Warning: Projection value has no head constant: let H := tt in True in canonical instance a of b, ignoring it. [projection-no-head-constant,records,default] coq-8.20.0/test-suite/output/Warnings.v000066400000000000000000000002731466560755400200340ustar00rootroot00000000000000(* Term in warning was not printed in the right environment at some time *) Record A := { B:Type; b:Prop }. Definition a B := {| B:=B; b:= let _ := tt in True |}. Canonical Structure a. coq-8.20.0/test-suite/output/ZNumberSyntax.out000066400000000000000000000027271466560755400214050ustar00rootroot0000000000000032%Z : Z eq_refl : 42%Z = 42%Z : 42%Z = 42%Z fun f : nat -> Z => (f 0%nat + 0)%Z : (nat -> Z) -> Z fun x : positive => Z.pos x~0 : positive -> Z fun x : positive => (Z.pos x + 1)%Z : positive -> Z fun x : positive => Z.pos x : positive -> Z fun x : positive => Z.neg x~0 : positive -> Z fun x : positive => (Z.pos x~0 + 0)%Z : positive -> Z fun x : positive => (- Z.pos x~0)%Z : positive -> Z fun x : positive => (- Z.pos x~0 + 0)%Z : positive -> Z (Z.of_nat 0 + 1)%Z : Z (0 + Z.of_nat (0 + 0))%Z : Z Z.of_nat 0 = 0%Z : Prop 0%Z : Z 0%Z : Z 1%Z : Z 2%Z : Z 255%Z : Z 255%Z : Z (- 0)%Z : Z (- 0)%Z : Z (-1)%Z : Z (-2)%Z : Z (-255)%Z : Z (-255)%Z : Z 0%Z : Z 0%Z : Z 1%Z : Z 2%Z : Z 255%Z : Z 255%Z : Z (- 0)%Z : Z (- 0)%Z : Z (-1)%Z : Z (-2)%Z : Z (-255)%Z : Z (-255)%Z : Z 0x2a : Z -0x2a : Z 0x0 : Z 0x2a : Z -0x2a : Z 0x0 : Z 0x0 : Z 0x0 : Z 0x1 : Z 0x2 : Z 0xff : Z 0xff : Z (- 0)%Z : Z (- 0)%Z : Z -0x1 : Z -0x2 : Z -0xff : Z -0xff : Z 0x0 : Z 0x0 : Z 0x1 : Z 0x2 : Z 0xff : Z 0xff : Z 0x0 : Z 0x0 : Z 0x1 : Z 0x2 : Z 0xff : Z 0xff : Z (- 0)%Z : Z (- 0)%Z : Z -0x1 : Z -0x2 : Z -0xff : Z -0xff : Z (0 + Z.of_nat 11)%Z : Z coq-8.20.0/test-suite/output/ZNumberSyntax.v000066400000000000000000000030701466560755400210330ustar00rootroot00000000000000Require Import ZArith. Check 32%Z. Check (eq_refl : 0x2a%Z = 42%Z). Check (fun f : nat -> Z => (f 0%nat + 0)%Z). Check (fun x : positive => Zpos (xO x)). Check (fun x : positive => (Zpos x + 1)%Z). Check (fun x : positive => Zpos x). Check (fun x : positive => Zneg (xO x)). Check (fun x : positive => (Zpos (xO x) + 0)%Z). Check (fun x : positive => (- Zpos (xO x))%Z). Check (fun x : positive => (- Zpos (xO x) + 0)%Z). Check (Z.of_nat 0 + 1)%Z. Check (0 + Z.of_nat (0 + 0))%Z. Check (Z.of_nat 0 = 0%Z). Check 0x0%Z. Check 0x00%Z. Check 0x01%Z. Check 0x02%Z. Check 0xff%Z. Check 0xFF%Z. Check (-0x0)%Z. Check (-0x00)%Z. Check (-0x01)%Z. Check (-0x02)%Z. Check (-0xff)%Z. Check (-0xFF)%Z. Check 0x0%xZ. Check 0x00%xZ. Check 0x01%xZ. Check 0x02%xZ. Check 0xff%xZ. Check 0xFF%xZ. Check (-0x0)%xZ%Z. Check (-0x00)%xZ%Z. Check (-0x01)%xZ. Check (-0x02)%xZ. Check (-0xff)%xZ. Check (-0xFF)%xZ. (* Check hexadecimal printing *) Open Scope hex_Z_scope. Check 42%Z. Check (-42)%Z. Check 0%Z. Check 42%xZ. Check (-42)%xZ. Check 0%xZ. Check 0x0%Z. Check 0x00%Z. Check 0x01%Z. Check 0x02%Z. Check 0xff%Z. Check 0xFF%Z. Check (-0x0)%Z. Check (-0x00)%Z. Check (-0x01)%Z. Check (-0x02)%Z. Check (-0xff)%Z. Check (-0xFF)%Z. Check 0x0. Check 0x00. Check 0x01. Check 0x02. Check 0xff. Check 0xFF. Check 0x0%xZ. Check 0x00%xZ. Check 0x01%xZ. Check 0x02%xZ. Check 0xff%xZ. Check 0xFF%xZ. Check (-0x0)%xZ%Z. Check (-0x00)%xZ%Z. Check (-0x01)%xZ. Check (-0x02)%xZ. Check (-0xff)%xZ. Check (-0xFF)%xZ. Close Scope hex_Z_scope. (* Submitted by Pierre Casteran *) Require Import Arith. Check (0 + Z.of_nat 11)%Z. coq-8.20.0/test-suite/output/activation.out000066400000000000000000000017031466560755400207460ustar00rootroot00000000000000File "./output/activation.v", line 5, characters 0-47: The command has indeed failed with message: More than one interpretation bound to this notation, confirm with the "all" modifier. File "./output/activation.v", line 12, characters 0-22: The command has indeed failed with message: No notation provided. File "./output/activation.v", line 16, characters 0-24: The command has indeed failed with message: Found no matching notation to enable or disable. [no-notation-to-enable-or-disable,syntax,default] a : Type File "./output/activation.v", line 26, characters 11-12: The command has indeed failed with message: The reference a was not found in the current environment. Prop : Type a : Type a : Type 0 : nat x : bool 0 : nat File "./output/activation.v", line 47, characters 0-49: The command has indeed failed with message: Found no matching notation to enable or disable. [no-notation-to-enable-or-disable,syntax,default] coq-8.20.0/test-suite/output/activation.v000066400000000000000000000024331466560755400204050ustar00rootroot00000000000000Disable Notation "x + y" := (Nat.add x y). Declare Custom Entry foo. Notation "x * y" := (Nat.mul x y) (in custom foo at level 0). Fail Disable Notation "x * y" := (Nat.mul x y). (* need flag all *) Disable Notation "x * y" := (Nat.mul x y) (all). Enable Notation := (Nat.mul _ _) : nat_scope. Disable Notation := ex2 (all). Disable Notation "<=" (all). Disable Notation (all) : nat_scope. Fail Disable Notation. Module Abbrev. Set Warnings "+no-notation-to-enable-or-disable". Fail Disable Notation f. (* no abbreviation with such suffix *) Set Warnings "no-notation-to-enable-or-disable". Notation f w := (S w). Disable Notation f w := (S w). Enable Notation := (S _). Module A. Notation a := Prop. End A. Include A. Disable Notation A.a. Check a. Disable Notation a. Fail Check a. Check Prop. Enable Notation a (all). (* Note: reactivation is not necessarily in the same order as it was earlier *) Check a. Check Prop. Module Shadowed. Notation x := true. End Shadowed. Import Shadowed. Notation x := 0. Check x. Disable Notation Abbrev.x. Check x. Enable Notation x. Check x. End Abbrev. Module Bug17782. Declare Custom Entry trm. Set Warnings "+no-notation-to-enable-or-disable". Fail Disable Notation "'foo' _" (in custom trm). Set Warnings "no-notation-to-enable-or-disable". End Bug17782. coq-8.20.0/test-suite/output/allBytes.out000066400000000000000000000004171466560755400203650ustar00rootroot00000000000000File "./output/allBytes.v", line 23, characters 0-44: Warning: Lonely notation "" was already defined with a different format. [notation-incompatible-format,parsing,default] !"#$%&'()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_`abcdefghijklmnopqrstuvwxyz{|}~ coq-8.20.0/test-suite/output/allBytes.v000066400000000000000000000120321466560755400200170ustar00rootroot00000000000000(* Taken from bedrock2 *) (* Note: not an utf8 file *) Require Import Coq.ZArith.BinInt Coq.Lists.List. Require Coq.Init.Byte Coq.Strings.Byte Coq.Strings.String. Definition allBytes: list Byte.byte := map (fun nn => match Byte.of_N (BinNat.N.of_nat nn) with | Some b => b | None => Byte.x00 (* won't happen *) end) (seq 32 95). Notation "a b" := (@cons Byte.byte a b) (only printing, right associativity, at level 3, format "a b"). Notation "" := (@nil Byte.byte) (only printing, right associativity, at level 3, format ""). Set Warnings "-notation-incompatible-prefix". Notation " " := (Byte.x20) (only printing). Notation "'!'" := (Byte.x21) (only printing). Notation "'""'" := (Byte.x22) (only printing). Notation "'#'" := (Byte.x23) (only printing). Notation "'$'" := (Byte.x24) (only printing). Notation "'%'" := (Byte.x25) (only printing). Notation "'&'" := (Byte.x26) (only printing). Notation "'''" := (Byte.x27) (only printing). Notation "'('" := (Byte.x28) (only printing). Notation "')'" := (Byte.x29) (only printing). Notation "'*'" := (Byte.x2a) (only printing). Notation "'+'" := (Byte.x2b) (only printing). Notation "','" := (Byte.x2c) (only printing). Notation "'-'" := (Byte.x2d) (only printing, at level 0). Notation "'.'" := (Byte.x2e) (only printing). Notation "'/'" := (Byte.x2f) (only printing, at level 0). Notation "'0'" := (Byte.x30) (only printing). Notation "'1'" := (Byte.x31) (only printing). Notation "'2'" := (Byte.x32) (only printing). Notation "'3'" := (Byte.x33) (only printing). Notation "'4'" := (Byte.x34) (only printing). Notation "'5'" := (Byte.x35) (only printing). Notation "'6'" := (Byte.x36) (only printing). Notation "'7'" := (Byte.x37) (only printing). Notation "'8'" := (Byte.x38) (only printing). Notation "'9'" := (Byte.x39) (only printing). Notation "':'" := (Byte.x3a) (only printing). Notation "';'" := (Byte.x3b) (only printing). Notation "'<'" := (Byte.x3c) (only printing). Notation "'='" := (Byte.x3d) (only printing). Notation "'>'" := (Byte.x3e) (only printing). Notation "'?'" := (Byte.x3f) (only printing). Notation "'@'" := (Byte.x40) (only printing). Notation "'A'" := (Byte.x41) (only printing). Notation "'B'" := (Byte.x42) (only printing). Notation "'C'" := (Byte.x43) (only printing). Notation "'D'" := (Byte.x44) (only printing). Notation "'E'" := (Byte.x45) (only printing). Notation "'F'" := (Byte.x46) (only printing). Notation "'G'" := (Byte.x47) (only printing). Notation "'H'" := (Byte.x48) (only printing). Notation "'I'" := (Byte.x49) (only printing). Notation "'J'" := (Byte.x4a) (only printing). Notation "'K'" := (Byte.x4b) (only printing). Notation "'L'" := (Byte.x4c) (only printing). Notation "'M'" := (Byte.x4d) (only printing). Notation "'N'" := (Byte.x4e) (only printing). Notation "'O'" := (Byte.x4f) (only printing). Notation "'P'" := (Byte.x50) (only printing). Notation "'Q'" := (Byte.x51) (only printing). Notation "'R'" := (Byte.x52) (only printing). Notation "'S'" := (Byte.x53) (only printing). Notation "'T'" := (Byte.x54) (only printing). Notation "'U'" := (Byte.x55) (only printing). Notation "'V'" := (Byte.x56) (only printing). Notation "'W'" := (Byte.x57) (only printing). Notation "'X'" := (Byte.x58) (only printing). Notation "'Y'" := (Byte.x59) (only printing). Notation "'Z'" := (Byte.x5a) (only printing). Notation "'['" := (Byte.x5b) (only printing). Notation "'\'" := (Byte.x5c) (only printing). Notation "']'" := (Byte.x5d) (only printing). Notation "'^'" := (Byte.x5e) (only printing). Notation "'_'" := (Byte.x5f) (only printing). Notation "'`'" := (Byte.x60) (only printing). Notation "'a'" := (Byte.x61) (only printing). Notation "'b'" := (Byte.x62) (only printing). Notation "'c'" := (Byte.x63) (only printing). Notation "'d'" := (Byte.x64) (only printing). Notation "'e'" := (Byte.x65) (only printing). Notation "'f'" := (Byte.x66) (only printing). Notation "'g'" := (Byte.x67) (only printing). Notation "'h'" := (Byte.x68) (only printing). Notation "'i'" := (Byte.x69) (only printing). Notation "'j'" := (Byte.x6a) (only printing). Notation "'k'" := (Byte.x6b) (only printing). Notation "'l'" := (Byte.x6c) (only printing). Notation "'m'" := (Byte.x6d) (only printing). Notation "'n'" := (Byte.x6e) (only printing). Notation "'o'" := (Byte.x6f) (only printing). Notation "'p'" := (Byte.x70) (only printing). Notation "'q'" := (Byte.x71) (only printing). Notation "'r'" := (Byte.x72) (only printing). Notation "'s'" := (Byte.x73) (only printing). Notation "'t'" := (Byte.x74) (only printing). Notation "'u'" := (Byte.x75) (only printing). Notation "'v'" := (Byte.x76) (only printing). Notation "'w'" := (Byte.x77) (only printing). Notation "'x'" := (Byte.x78) (only printing). Notation "'y'" := (Byte.x79) (only printing). Notation "'z'" := (Byte.x7a) (only printing). Notation "'{'" := (Byte.x7b) (only printing). Notation "'|'" := (Byte.x7c) (only printing). Notation "'}'" := (Byte.x7d) (only printing). Notation "'~'" := (Byte.x7e) (only printing, at level 0). Global Set Printing Width 300. Goal False. let cc := eval cbv in allBytes in idtac cc. Abort. coq-8.20.0/test-suite/output/apply_with.out000066400000000000000000000016331466560755400207670ustar00rootroot00000000000000File "./output/apply_with.v", line 3, characters 11-26: The command has indeed failed with message: No such bound variable d (possible names are: a, b and c). File "./output/apply_with.v", line 4, characters 11-26: The command has indeed failed with message: Unable to find an instance for the variable b. File "./output/apply_with.v", line 5, characters 24-25: The command has indeed failed with message: No such bound variable d (possible names are: a, b and c). File "./output/apply_with.v", line 6, characters 5-31: The command has indeed failed with message: Unable to find an instance for the variables b, c. File "./output/apply_with.v", line 14, characters 23-24: The command has indeed failed with message: No such bound variable c (possible names are: a and b). File "./output/apply_with.v", line 15, characters 5-16: The command has indeed failed with message: Unable to find an instance for the variables a, b. coq-8.20.0/test-suite/output/apply_with.v000066400000000000000000000005741466560755400204300ustar00rootroot00000000000000Axiom f : forall a b c, a + b = 0 -> c = 0. Goal 0 = 0. Fail apply f with (d := 0). Fail apply f with (a := 0). Fail rewrite <- f with (d := 0). Fail rewrite <- f with (a := 0). apply f with (a:=0) (b:=0). auto. Qed. Axiom g : forall a b, S a = S b. Goal forall n, n = 0. intros n. Fail injection g with (c := 0). Fail injection g. injection g with (a := n) (b := 0). auto. Qed. coq-8.20.0/test-suite/output/auto.out000066400000000000000000000007501466560755400175560ustar00rootroot00000000000000(* info auto: *) simple apply or_intror (in core). intro. assumption. (* debug auto: *) * assumption. (*fail*) * intro. (*fail*) * simple apply or_intror (in core). (*success*) ** assumption. (*fail*) ** intro. (*success*) ** assumption. (*success*) (* info eauto: *) simple apply or_intror. intro. exact H. (* debug eauto: *) Debug: 1 depth=5 Debug: 1.1 depth=4 simple apply or_intror Debug: 1.1.1 depth=4 intro Debug: 1.1.1.1 depth=4 exact H (* info trivial: *) exact I (in core). coq-8.20.0/test-suite/output/auto.v000066400000000000000000000002711466560755400172120ustar00rootroot00000000000000(* testing info_*/debug auto/eauto *) Goal False \/ (True -> True). Succeed info_auto. Succeed debug auto. Succeed info_eauto. debug eauto. Defined. Goal True. info_trivial. Defined. coq-8.20.0/test-suite/output/btauto_counterexample.out000066400000000000000000000002431466560755400232140ustar00rootroot00000000000000File "./output/btauto_counterexample.v", line 12, characters 7-13: The command has indeed failed with message: Tactic failure: Not a tautology: [combine := true]. coq-8.20.0/test-suite/output/btauto_counterexample.v000066400000000000000000000003301466560755400226470ustar00rootroot00000000000000 Require Import Coq.btauto.Btauto. Local Open Scope bool_scope. Axiom unsigned : bool. Axiom combine : bool. Lemma foo : (false && unsigned) || (false && combine) = combine . Proof. Fail btauto. Abort. coq-8.20.0/test-suite/output/bug12442.out000066400000000000000000000005751466560755400177650ustar00rootroot00000000000000File "./output/bug12442.v", line 6, characters 7-19: The command has indeed failed with message: No product even after head-reduction. File "./output/bug12442.v", line 7, characters 7-18: The command has indeed failed with message: Not an inductive product. File "./output/bug12442.v", line 9, characters 7-25: The command has indeed failed with message: Not an inductive product. coq-8.20.0/test-suite/output/bug12442.v000066400000000000000000000002421466560755400174120ustar00rootroot00000000000000Parameter A B : Prop. Axiom P : inhabited (A -> B). Goal A -> True. Proof. Fail intros ?%P ?. Fail intros []%P. intro a. Fail apply P in a as []. Abort. coq-8.20.0/test-suite/output/bug5778.out000066400000000000000000000004431466560755400177150ustar00rootroot00000000000000File "./output/bug5778.v", line 7, characters 7-11: The command has indeed failed with message: The term "I" has type "True" which should be Set, Prop or Type. In nested Ltac calls to "c", "abs", "abstract b ltac:(())", "b", "a", "pose (I : I)" and "(I : I)", last term evaluation failed. coq-8.20.0/test-suite/output/bug5778.v000066400000000000000000000002201466560755400173440ustar00rootroot00000000000000Set Ltac Backtrace. Ltac a _ := pose (I : I). Ltac b _ := a (). Ltac abs _ := abstract b (). Ltac c _ := abs (). Goal True. Fail c (). Abort. coq-8.20.0/test-suite/output/bug6404.out000066400000000000000000000004551466560755400177030ustar00rootroot00000000000000File "./output/bug6404.v", line 7, characters 7-11: The command has indeed failed with message: The term "I" has type "True" which should be Set, Prop or Type. In nested Ltac calls to "c", "abs", "transparent_abstract (tactic3)", "b", "a", "pose (I : I)" and "(I : I)", last term evaluation failed. coq-8.20.0/test-suite/output/bug6404.v000066400000000000000000000002341466560755400173340ustar00rootroot00000000000000Set Ltac Backtrace. Ltac a _ := pose (I : I). Ltac b _ := a (). Ltac abs _ := transparent_abstract b (). Ltac c _ := abs (). Goal True. Fail c (). Abort. coq-8.20.0/test-suite/output/bug6821.out000066400000000000000000000000731466560755400177020ustar00rootroot00000000000000forall f : nat -> Type, f x where x : nat := 1 : Type coq-8.20.0/test-suite/output/bug6821.v000066400000000000000000000004021466560755400173340ustar00rootroot00000000000000(* Was failing at printing time with stack overflow due to an infinite eta-expansion *) Notation "x 'where' y .. z := v " := ((fun y => .. ((fun z => x) v) ..) v) (at level 11, v at next level, y binder, z binder). Check forall f, f x where x := 1. coq-8.20.0/test-suite/output/bug7191.out000066400000000000000000000001401466560755400176760ustar00rootroot00000000000000 type unit0 = | Tt (** val f : unit0 -> unit0 **) let f _ = assert false (* absurd case *) coq-8.20.0/test-suite/output/bug7191.v000066400000000000000000000001511466560755400173360ustar00rootroot00000000000000Require Extraction. Definition f (x : False) : unit -> unit := match x with end. Recursive Extraction f. coq-8.20.0/test-suite/output/bug7348.out000066400000000000000000000012121466560755400177030ustar00rootroot00000000000000Extracted code successfully compiled type __ = Obj.t type unit0 = | Tt type bool = | True | False module Case1 = struct type coq_rec = { f : bool } (** val f : bool -> coq_rec -> bool **) let f _ r = r.f (** val silly : bool -> coq_rec -> __ **) let silly x b = match x with | True -> Obj.magic b.f | False -> Obj.magic Tt end module Case2 = struct type coq_rec = { f : (bool -> bool) } (** val f : bool -> coq_rec -> bool -> bool **) let f _ r = r.f (** val silly : bool -> coq_rec -> __ **) let silly x b = match x with | True -> Obj.magic b.f False | False -> Obj.magic Tt end coq-8.20.0/test-suite/output/bug7348.v000066400000000000000000000010011466560755400173350ustar00rootroot00000000000000Require Extraction. Extraction Language OCaml. Set Extraction KeepSingleton. Module Case1. Record rec (x : bool) := { f : bool }. Definition silly x (b : rec x) := if x return (if x then bool else unit) then f x b else tt. End Case1. Module Case2. Record rec (x : bool) := { f : bool -> bool }. Definition silly x (b : rec x) := if x return (if x then bool else unit) then f x b false else tt. End Case2. Extraction TestCompile Case1.silly Case2.silly. Recursive Extraction Case1.silly Case2.silly. coq-8.20.0/test-suite/output/bug_10739.out000066400000000000000000000017611466560755400201310ustar00rootroot00000000000000 type nat = | O | S of nat (** val f : nat **) let f = O (** val f : nat **) let f = O type nat = | O | S of nat (** val f : nat **) let f = O module M = struct (** val g : nat **) let g = f end (** val g : nat **) let g = f type nat = | O | S of nat (** val f : nat **) let f = O module M = struct (** val g : nat **) let g = f module N = struct (** val h : nat **) let h = g end end (** val h : nat **) let h = M.g type nat = | O | S of nat (** val add : nat -> nat -> nat **) let rec add n m = match n with | O -> m | S p -> S (add p m) (** val f : nat **) let f = O module M = struct (** val g : nat **) let g = f module type S = sig val b : nat end module F = functor (X:S) -> struct (** val h : nat **) let h = add g X.b end end (** val h : nat **) let h = add M.g X.b type nat = | O | S of nat type nat = | O | S of nat (** val foo : nat **) let foo = O coq-8.20.0/test-suite/output/bug_10739.v000066400000000000000000000011671466560755400175670ustar00rootroot00000000000000Require Extraction. Definition f := 0. Module M. Recursive Extraction f. Extraction f. Definition g := f. Recursive Extraction g. Extraction g. Module Type S. Definition b := 0. End S. (* Test with sealed module *) Module N : S. Definition b := 0. Definition h := g. Recursive Extraction h. Extraction h. End N. (* Test with a functor *) Module F (X:S). Definition h := g + X.b. Recursive Extraction h. Extraction h. End F. (* Test elsewhere *) Recursive Extraction nat. Extraction nat. Module Type T. Definition foo := 0. Extraction foo. End T. End M. coq-8.20.0/test-suite/output/bug_10803.out000066400000000000000000000001261466560755400201130ustar00rootroot00000000000000a ! : Foo where ?y : [ |- nat] a ! : Foo a : Foo -> Foo a ! : Foo coq-8.20.0/test-suite/output/bug_10803.v000066400000000000000000000006371466560755400175600ustar00rootroot00000000000000Inductive Foo := foo. Declare Scope foo_scope. Delimit Scope foo_scope with foo. Bind Scope foo_scope with Foo. Notation "'!'" := foo : foo_scope. Definition of_foo {x : nat} {y : nat} (f : Foo) := f. Notation a := (@of_foo O). Notation b := (@a). Check a !. Check @a O !. Check @b O. Check @b O !. (* was failing *) (* All are printed "a !", without making explicit the "0", which is incidentally disputable *) coq-8.20.0/test-suite/output/bug_10824.out000066400000000000000000000000361466560755400201160ustar00rootroot00000000000000!! : Prop !! : Prop coq-8.20.0/test-suite/output/bug_10824.v000066400000000000000000000003341466560755400175550ustar00rootroot00000000000000Module A. Notation F := False. Notation "!!" := False (at level 100). Check False. End A. Module B. Notation "!!" := False (at level 100). Notation F := False. Notation "!!" := False (at level 100). Check False. End B. coq-8.20.0/test-suite/output/bug_11342.out000066400000000000000000000000161466560755400201100ustar00rootroot00000000000000without using coq-8.20.0/test-suite/output/bug_11342.v000066400000000000000000000004741466560755400175560ustar00rootroot00000000000000(* -*- mode: coq; coq-prog-args: ("-vos") -*- *) Section foo. Context {H:True}. Theorem test1 : True. Proof. (* this gets printed with -vos because there's no annotation (either [Set Default Proof Using ...] or an explicit [Proof using ...]) *) idtac "without using". exact I. Qed. End foo. coq-8.20.0/test-suite/output/bug_11347.out000066400000000000000000000002351466560755400201200ustar00rootroot00000000000000File "./output/bug_11347.v", line 5, characters 7-29: The command has indeed failed with message: Tactic failure: setoid rewrite failed: Nothing to rewrite. coq-8.20.0/test-suite/output/bug_11347.v000066400000000000000000000003011466560755400175500ustar00rootroot00000000000000Require Import Setoid. Lemma foo (b:unit) : (match b with tt => fun (C : Prop) => C end) True. Proof. Fail setoid_rewrite or_comm. (* or any lemma that can be used for rewriting *) Abort. coq-8.20.0/test-suite/output/bug_11608.out000066400000000000000000000000341466560755400201150ustar00rootroot00000000000000creating x without [Proof.] coq-8.20.0/test-suite/output/bug_11608.v000066400000000000000000000005241466560755400175570ustar00rootroot00000000000000(* -*- mode: coq; coq-prog-args: ("-vos") -*- *) Set Default Proof Using "Type". Section foo. Context (A:Type). Definition x : option A. (* this can get printed with -vos since without "Proof." there's no Proof using, even with a default annotation. *) idtac "creating x without [Proof.]". exact None. Qed. End foo. coq-8.20.0/test-suite/output/bug_11934.out000066400000000000000000000003411466560755400201200ustar00rootroot00000000000000thing = forall x y : foo, bla x y : Prop thing = forall (x : foo@{thing.u0}) (y : foo@{thing.u1}), bla x y : Prop thing = forall (x : @foo@{thing.u0} True) (y : @foo@{thing.u1} True), @bla True True x y : Prop coq-8.20.0/test-suite/output/bug_11934.v000066400000000000000000000006731466560755400175660ustar00rootroot00000000000000Polymorphic Axiom foo@{u} : Prop -> Prop. Arguments foo {_}. Axiom bla : forall {A B}, @foo A -> @foo B -> Prop. Definition thing := forall (x:@foo@{Type} True) (y:@foo@{Type} True), bla x y. Print thing. (* forall x y : foo, bla x y *) Set Printing Universes. Print thing. (* forall (x : foo@{thing.u0}) (y : foo@{thing.u1}), bla x y *) Set Printing Implicit. Print thing. (* BAD: forall x y : @foo@{thing.u0} True, @bla True True x y *) coq-8.20.0/test-suite/output/bug_12159.out000066400000000000000000000003221466560755400201170ustar00rootroot00000000000000f 1%B : unit f 0 : unit 1%B : unit 0 : unit 1%B : unit 1 : unit 1 : unit 0 : unit 1 : unit 0%A : unit 1 : unit 0%A : unit 0 : unit 0 : unit coq-8.20.0/test-suite/output/bug_12159.v000066400000000000000000000015301466560755400175570ustar00rootroot00000000000000Declare Scope A. Declare Scope B. Delimit Scope A with A. Delimit Scope B with B. Definition to_unit (v : Number.uint) : option unit := match Nat.of_num_uint v with O => Some tt | _ => None end. Definition of_unit (v : unit) : Number.uint := Nat.to_num_uint 0. Definition of_unit' (v : unit) : Number.uint := Nat.to_num_uint 1. Number Notation unit to_unit of_unit : A. Number Notation unit to_unit of_unit' : B. Definition f x : unit := x. Check f tt. Arguments f x%_A. Check f tt. Check tt. Open Scope A. Check tt. Close Scope A. Check tt. Open Scope B. Check tt. Undelimit Scope B. Check tt. Open Scope A. Check tt. Close Scope A. Check tt. Close Scope B. Check tt. Open Scope B. Check tt. Notation "1" := true. Check tt. Open Scope A. Check tt. Declare Scope C. Notation "0" := false : C. Open Scope C. Check tt. (* gives 0 but should now be 0%A *) coq-8.20.0/test-suite/output/bug_12777.out000066400000000000000000000000701466560755400201250ustar00rootroot00000000000000Notation tt' := tt Inductive unit : Set := tt : unit. coq-8.20.0/test-suite/output/bug_12777.v000066400000000000000000000001241466560755400175630ustar00rootroot00000000000000Module Import M1. Module Export M2. Notation tt' := tt. End M2. End M1. Print tt'. coq-8.20.0/test-suite/output/bug_12887.out000066400000000000000000000006701466560755400201350ustar00rootroot00000000000000File "./output/bug_12887.v", line 5, characters 25-26: The command has indeed failed with message: Cannot infer this placeholder of type "Type" in environment: Functor : (Type -> Type) -> Type F : Type -> Type fmap : forall A B : Type, (A -> B) -> F A -> F B File "./output/bug_12887.v", line 8, characters 0-53: The command has indeed failed with message: Cannot infer an existential variable of type "nat" in environment: R : nat -> Type coq-8.20.0/test-suite/output/bug_12887.v000066400000000000000000000003731466560755400175730ustar00rootroot00000000000000Arguments id {_} _. Fail Record Functor (F : Type -> Type) := { fmap : forall A B, (A -> B) -> F A -> F B; fmap_identity : fmap _ _ id = id; }. Fail Inductive R (x:nat) := { y : R ltac:(clear x) }. Inductive R (x:nat) := { y : bool; z : R _ }. coq-8.20.0/test-suite/output/bug_12908.out000066400000000000000000000004201466560755400201200ustar00rootroot00000000000000forall m n : nat, m * n = (2 * m * n)%nat : Prop File "./output/bug_12908.v", line 11, characters 0-31: Warning: Notation "_ * _" was already used in scope nat_scope. [notation-overridden,parsing,default] forall m n : nat, m * n = Nat.mul (Nat.mul 2 m) n : Prop coq-8.20.0/test-suite/output/bug_12908.v000066400000000000000000000005421466560755400175630ustar00rootroot00000000000000Definition 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 overridden scoped notation is deactivated *) Infix "*" := mult' : nat_scope. Check forall m n, mult' m n = Nat.mul (Nat.mul 2 m) n. End B. coq-8.20.0/test-suite/output/bug_13004.out000066400000000000000000000000751466560755400201120ustar00rootroot00000000000000Ltac t := ltac2:(print (of_string "hi")) Ltac u := ident:(H) coq-8.20.0/test-suite/output/bug_13004.v000066400000000000000000000001751466560755400175510ustar00rootroot00000000000000Require Import Ltac2.Ltac2 Ltac2.Message. Ltac t := ltac2:(print (of_string "hi")). Ltac u := ident:(H). Print t. Print u. coq-8.20.0/test-suite/output/bug_13018.out000066400000000000000000000003601466560755400201140ustar00rootroot00000000000000gargs:( (!) ) : list nat gargs:( (!, !, !) ) : list nat OnlyGargs[ (!) ] : list nat gargs999:( (!) ) : list nat gargs999:( (!, !, !) ) : list nat OnlyGargs[ (!) ] : list nat OnlyGargs999[ (!) ] : list nat coq-8.20.0/test-suite/output/bug_13018.v000066400000000000000000000025231466560755400175550ustar00rootroot00000000000000Undelimit Scope list_scope. Declare Custom Entry gnat. Declare Custom Entry gargs. Notation "!" := 42 (in custom gnat). Notation "gargs:( e )" := e (e custom gargs). Notation "( x )" := (cons x (@nil nat)) (in custom gargs, x custom gnat). Notation "( x , y , .. , z )" := (cons x (cons y .. (cons z nil) ..)) (in custom gargs, x custom gnat, y custom gnat, z custom gnat). Check gargs:( (!) ). (* cons 42 nil *) Check gargs:( (!, !, !) ). (* cons 42 (42 :: 42 :: nil) *) Definition OnlyGargs {T} (x:T) := x. Notation "OnlyGargs[ x ]" := (OnlyGargs x) (at level 10, x custom gargs). Check OnlyGargs[ (!) ]. (* OnlyGargs[ cons 42 nil] *) Declare Custom Entry gargs999. Notation "gargs999:( e )" := e (e custom gargs999 at level 999). Notation "( x )" := (cons x (@nil nat)) (in custom gargs999, x custom gnat at level 999). Notation "( x , y , .. , z )" := (cons x (cons y .. (cons z nil) ..)) (in custom gargs999, x custom gnat at level 999, y custom gnat at level 999, z custom gnat at level 999). Check gargs999:( (!) ). (* gargs999:( (!)) *) Check gargs999:( (!, !, !) ). (* gargs999:( (!, !, !)) *) Check OnlyGargs[ (!) ]. (* OnlyGargs[ gargs999:( (!))] *) Definition OnlyGargs999 {T} (x:T) := x. Notation "OnlyGargs999[ x ]" := (OnlyGargs999 x) (at level 10, x custom gargs999 at level 999). Check OnlyGargs999[ (!) ]. (* OnlyGargs999[ (!)] *) coq-8.20.0/test-suite/output/bug_13112.out000066400000000000000000000000371466560755400201100ustar00rootroot000000000000000 + 0 : nat HI : nat coq-8.20.0/test-suite/output/bug_13112.v000066400000000000000000000002511466560755400175440ustar00rootroot00000000000000Reserved Notation "'HI'". Notation "'HI'" := (O + O) (only parsing). Check HI. (* 0 + 0 : nat *) Notation "'HI'" := (O + O) (only printing). Check HI. (* 0 + 0 : nat *) coq-8.20.0/test-suite/output/bug_13238.out000066400000000000000000000001521466560755400201170ustar00rootroot00000000000000Ltac t1 x := replace (x x) with (x x) Ltac t2 x := case : x Ltac t3 := by move -> Ltac t4 := congr True coq-8.20.0/test-suite/output/bug_13238.v000066400000000000000000000002601466560755400175550ustar00rootroot00000000000000Require Import ssreflect. Ltac t1 x := replace (x x) with (x x). Print t1. Ltac t2 x := case: x. Print t2. Ltac t3 := by move->. Print t3. Ltac t4 := congr True. Print t4. coq-8.20.0/test-suite/output/bug_13240.out000066400000000000000000000001111466560755400201030ustar00rootroot00000000000000Ltac t1 a b := a ; last b Ltac t2 := do !idtac Ltac t3 := idtac => True coq-8.20.0/test-suite/output/bug_13240.v000066400000000000000000000002051466560755400175450ustar00rootroot00000000000000Require Import ssreflect. Ltac t1 a b := a; last b. Print t1. Ltac t2 := do !idtac. Print t2. Ltac t3 := idtac => True. Print t3. coq-8.20.0/test-suite/output/bug_13244.out000066400000000000000000000010121466560755400201100ustar00rootroot00000000000000negbT: forall [b : bool], b = false -> ~~ b contra_notN: forall [P : Prop] [b : bool], (b -> P) -> ~ P -> ~~ b contraPN: forall [P : Prop] [b : bool], (b -> ~ P) -> P -> ~~ b contraNN: forall [c b : bool], (c -> b) -> ~~ b -> ~~ c contraL: forall [c b : bool], (c -> ~~ b) -> b -> ~~ c contraTN: forall [c b : bool], (c -> ~~ b) -> b -> ~~ c contra: forall [c b : bool], (c -> b) -> ~~ b -> ~~ c introN: forall [P : Prop] [b : bool], reflect P b -> ~ P -> ~~ b contraFN: forall [c b : bool], (c -> b) -> b = false -> ~~ c coq-8.20.0/test-suite/output/bug_13244.v000066400000000000000000000001271466560755400175540ustar00rootroot00000000000000Require Import ssr.ssrbool. Set Warnings "-ssr-search-moved". Search headconcl:(~~ _). coq-8.20.0/test-suite/output/bug_13266.out000066400000000000000000000007601466560755400201250ustar00rootroot00000000000000File "./output/bug_13266.v", line 17, characters 7-18: The command has indeed failed with message: Abstracting over the terms "S", "p" and "u" leads to a term fun (S0 : Type) (p0 : proc S0) (_ : S0) => p0 = Tick -> True which is ill-typed. Reason is: Illegal application: The term "@eq" of type "forall A : Type, A -> A -> Prop" cannot be applied to the terms "proc S0" : "Prop" "p0" : "proc S0" "Tick" : "proc unit" The 3rd term has type "proc unit" which should be a subtype of "proc S0". coq-8.20.0/test-suite/output/bug_13266.v000066400000000000000000000003741466560755400175640ustar00rootroot00000000000000Inductive proc : Type -> Prop := | Tick : proc unit . Inductive exec : forall T, proc T -> T -> Prop := | ExecTick : exec _ (Tick) tt . Lemma foo : exec _ Tick tt -> True. Proof. intros H. remember Tick as p. Fail induction H. Abort. coq-8.20.0/test-suite/output/bug_13320.out000066400000000000000000000001731466560755400201120ustar00rootroot00000000000000File "./output/bug_13320.v", line 2, characters 0-21: The command has indeed failed with message: No obligations remaining coq-8.20.0/test-suite/output/bug_13320.v000066400000000000000000000001271466560755400175470ustar00rootroot00000000000000(* Next Obligation should fail normally, not with an anomaly. *) Fail Next Obligation. coq-8.20.0/test-suite/output/bug_13595.out000066400000000000000000000004321466560755400201260ustar00rootroot00000000000000File "./output/bug_13595.v", line 5, characters 7-17: The command has indeed failed with message: Tactic failure: Goal is solvable by congruence but some arguments are missing. Try "congruence with ((Triple a _ _)) ((Triple d c _))", replacing metavariables by arbitrary terms. coq-8.20.0/test-suite/output/bug_13595.v000066400000000000000000000003671466560755400175730ustar00rootroot00000000000000Inductive Cube:Set :=| Triple: nat -> nat -> nat -> Cube. Theorem incomplete :forall a b c d : nat,Triple a = Triple b->Triple d c = Triple d b->a = c. Proof. Fail congruence. intros. congruence with ((Triple a a a)) ((Triple d c a)). Qed. coq-8.20.0/test-suite/output/bug_13821_native_command_line_warn.out000066400000000000000000000000001466560755400252070ustar00rootroot00000000000000coq-8.20.0/test-suite/output/bug_13821_native_command_line_warn.v000066400000000000000000000002361466560755400246600ustar00rootroot00000000000000(* -*- coq-prog-args: ("-w" "-deprecated-native-compiler-option" "-w" "-native-compiler-disabled" "-native-compiler" "ondemand" "-async-proofs" "no"); -*- *) coq-8.20.0/test-suite/output/bug_13857.out000066400000000000000000000006361466560755400201350ustar00rootroot00000000000000File "./output/bug_13857.v", line 6, characters 13-16: The command has indeed failed with message: Unable to find an instance for the variable x. File "./output/bug_13857.v", line 7, characters 13-17: The command has indeed failed with message: Unable to unify "foo2" with "foo". File "./output/bug_13857.v", line 8, characters 13-17: The command has indeed failed with message: Unable to unify "foo3" with "foo". coq-8.20.0/test-suite/output/bug_13857.v000066400000000000000000000002661466560755400175720ustar00rootroot00000000000000Inductive foo := Foo (x:nat) (H: x=x). Inductive foo2 := Foo2 (x : nat). Inductive foo3 := Foo3 (f : foo2). Goal foo. Fail apply Foo. Fail apply Foo2. Fail apply Foo3. Abort. coq-8.20.0/test-suite/output/bug_13942.out000066400000000000000000000077741466560755400201420ustar00rootroot00000000000000File "./output/bug_13942.v", line 102, characters 2-34: The command has indeed failed with message: The following term contains unresolved implicit arguments: (fi fu) More precisely: - ?A: Cannot infer the implicit parameter A of fi whose type is "Type" in environment: K : Type M : Type -> Type H : FMap K M A : Type B : Type i : Union (M A) i' : Union (M B) fi' : Insert K B (M B) - ?hi: Cannot infer the implicit parameter hi of fi whose type is "Insert K ?A (M ?A)" (no type class instance found) in environment: K : Type M : Type -> Type H : FMap K M A : Type B : Type i : Union (M A) i' : Union (M B) fi' : Insert K B (M B) - ?hu: Cannot infer the implicit parameter hu of fu whose type is "Union (M ?A)" (no type class instance found) in environment: K : Type M : Type -> Type H : FMap K M A : Type B : Type i : Union (M A) i' : Union (M B) fi' : Insert K B (M B) File "./output/bug_13942.v", line 106, characters 2-39: The command has indeed failed with message: The following term contains unresolved implicit arguments: (fi fu) More precisely: - ?hi: Cannot infer the implicit parameter hi of fi whose type is "Insert K A (M A)" (no type class instance found) in environment: K : Type M : Type -> Type H : FMap K M A : Type B : Type i : Union (M A) i' : Union (M B) fi' : Insert K B (M B) File "./output/bug_13942.v", line 120, characters 2-34: The command has indeed failed with message: The following term contains unresolved implicit arguments: (fi fu) More precisely: - ?A: Cannot infer the implicit parameter A of fi whose type is "Type" in environment: K : Type M : Type -> Type H : FMap K M A : Type B : Type i' : Union (M B) fi' : Insert K B (M B) i : Union (M A) - ?hi: Cannot infer the implicit parameter hi of fi whose type is "Insert K ?A (M ?A)" (no type class instance found) in environment: K : Type M : Type -> Type H : FMap K M A : Type B : Type i' : Union (M B) fi' : Insert K B (M B) i : Union (M A) - ?hu: Cannot infer the implicit parameter hu of fu whose type is "Union (M ?A)" (no type class instance found) in environment: K : Type M : Type -> Type H : FMap K M A : Type B : Type i' : Union (M B) fi' : Insert K B (M B) i : Union (M A) File "./output/bug_13942.v", line 124, characters 2-40: The command has indeed failed with message: The following term contains unresolved implicit arguments: (fi fu) More precisely: - ?hi: Cannot infer the implicit parameter hi of fi whose type is "Insert K A (M A)" (no type class instance found) in environment: K : Type M : Type -> Type H : FMap K M A : Type B : Type i' : Union (M B) fi' : Insert K B (M B) i : Union (M A) File "./output/bug_13942.v", line 140, characters 2-20: The command has indeed failed with message: In environment: K : Type M : Type -> Type H : FMap K M A : Type B : Type ifalse : Choose false -> Union (M B) itrue : Choose true -> Union (M B) ib : Insert K B (M B) i : Choose false -> Union (M A) Could not find an instance for the following existential variables: ?hi : Insert K ?A (M ?A) ?hu : Union (M ?A) File "./output/bug_13942.v", line 145, characters 16-18: The command has indeed failed with message: Could not find an instance for "Union (M B)" in environment: K : Type M : Type -> Type H : FMap K M A : Type B : Type ifalse : Choose false -> Union (M B) itrue : Choose true -> Union (M B) ib : Insert K B (M B) i : Choose false -> Union (M A) fi fu : B : B File "./output/bug_13942.v", line 307, characters 20-31: The command has indeed failed with message: Could not find an instance for "Insert K K (M A)" in environment: K : Type M : Type → Type H : FMap M H0 : ∀ A : Type, Lookup K A (M A) Empty : Type → Type H1 : ∀ A : Type, Empty (M A) H2 : ∀ A : Type, PartialAlter K A (M A) OMap : (Type → Type) → Type OMap0 : OMap M H3 : Merge M H4 : ∀ A : Type, FinMapToList K A (M A) EqDecision : Type → Type EqDecision0 : EqDecision K H5 : FinMap K M A : Type m1, m2 : M A i : K x : A coq-8.20.0/test-suite/output/bug_13942.v000066400000000000000000000262311466560755400175650ustar00rootroot00000000000000 Set Warnings "-deprecated". Module Backtrack. Class A (T : Type). (* Global Hint Mode A + : typeclass_instances. *) Class B (T T' : Type) := b : T'. (* Global Hint Mode B - + : typeclass_instances. *) Instance anat : A nat := {}. Instance abool : A bool := {}. Instance bnatnat : B nat nat := { b := 0 }. Definition foo {T'} {T} {a : A T'} {b : B T' T} : T := b. (* This relies on backtracking: we first solve A ? with abool (most recent decl), the find out that B bool _ is not solvable and backtrack, find anat and finally solve B. *) Definition test := (foo : nat). (* This forces a different resolution path, where A ? is stuck at first, then we solve B's constraint, and we come back to A nat which is solvable. *) Global Hint Mode A + : typeclass_instances. Definition test' := (foo : nat). End Backtrack. Module Minimized. Class Insert (K V M : Type) : Prop. Global Hint Mode Insert - - + : typeclass_instances. Class Lookup (K A M : Type) : Prop. Global Hint Mode Lookup - - ! : typeclass_instances. Class Union (A : Type) : Prop. Global Hint Mode Union ! : typeclass_instances. Class FMap (K : Type) (M : Type -> Type) : Prop. Section Foo. Context K M `{FMap K M}. Context {A B : Type}. Axiom fi : forall {A} {hi : Insert K A (M A)}, A -> A. Axiom fu : forall {A} {hu : Union (M A)}, A. Section OrderOne. Context {i : Union (M A)}. Context {i' : Union (M B)}. Context {fi' : Insert K B (M B)}. (** Succees because Union has mode !, so (M _) is enough to trigger i', and then fi'. Union should probably be using + to avoid ambiguities. *) Definition test := (fi fu). End OrderOne. (* We check here that typeclass resolution backtracks correctly when reporting errors and does not follow modes too eagerly. *) Section OrderTwo. Context {i' : Union (M B)}. Context {fi' : Insert K B (M B)}. Context {i : Union (M A)}. (** Here we get two constraints, first is [Insert K ?A (M ?A)], second is [Union (M ?A)]. The first is stuck so we proceed on the second one, which has two solutions. The i / M A is chosen first, but it has no insert instance, so we backtrack on this first solution to find i', even if i respected the mode of Union (just !). *) Definition test' := (fi fu). End OrderTwo. End Foo. End Minimized. Module Minimized'. Class Insert (K V M : Type) : Prop. Global Hint Mode Insert - - + : typeclass_instances. Class Lookup (K A M : Type) : Prop. Global Hint Mode Lookup - - + : typeclass_instances. Class Union (A : Type) : Prop. Global Hint Mode Union + : typeclass_instances. Class FMap (K : Type) (M : Type -> Type) : Prop. Section Foo. Context K M `{FMap K M}. Context {A B : Type}. Axiom fi : forall {A} {hi : Insert K A (M A)}, A -> A. Axiom fu : forall {A} {hu : Union (M A)}, A. Axiom fu' : forall {A} {hu : Union (M A)}, A -> A. Axiom fi' : forall {A} {hi : Insert K A (M A)}, A. Section OrderOne. Context {i : Union (M A)}. Context {i' : Union (M B)}. Context {fi' : Insert K B (M B)}. (** Fail because Union has now mode +, so (M _) is not enough to trigger i' and fi'. So we get a general type error *) Fail Definition test := (fi fu). (** Here we get the precise missing Insert instance when A is chosen: *) Fail Definition test' : A := (fi fu). (** Of course the unambiguous querry works *) Definition test : B := (fi fu). End OrderOne. Section OrderTwo. Context {i' : Union (M B)}. Context {fi' : Insert K B (M B)}. Context {i : Union (M A)}. (** Here this fails because this is entirely ambiguous: it cannot decide even on the A type. *) Fail Definition test := (fi fu). Definition test' : B := (fi fu). (** Here we get the precise missing instance when A is chosen: *) Fail Definition test'' : A := (fi fu). End OrderTwo. (** There can still be internal backtracking: here we check that if the union instance depends on another class we get the right behavior.*) Section OrderThree. Class Choose (b : bool). Context {ifalse : Choose false -> Union (M B)}. Context {itrue : Choose true -> Union (M B)}. Context {ib : Insert K B (M B)}. Context {i : Choose false -> Union (M A)}. (** Here this fails because this is entirely ambiguous: it cannot decide even on the A type. *) Fail Type (fi fu). (** Here we commit to B, but neither ifalse nor itrue applies, so Union (M B) is reported as unsolvable. *) Fail Type (fi fu : B). Context {ct : Choose false}. (** Here we can find ifalse to get Union (M B), after backtracking on the failing application of itrue (which last declared instance) *) Type (fi fu : B). End OrderThree. End Foo. End Minimized'. From Coq Require Export Morphisms RelationClasses List Bool Setoid Peano Utf8. From Coq Require Import Permutation. Export ListNotations. From Coq.Program Require Export Basics Syntax. Module Import base. Global Generalizable All Variables. Obligation Tactic := idtac. (** Throughout this development we use [stdpp_scope] for all general purpose notations that do not belong to a more specific scope. *) Declare Scope stdpp_scope. Delimit Scope stdpp_scope with stdpp. Global Open Scope stdpp_scope. Class Union A := union: A → A → A. Global Hint Mode Union ! : typeclass_instances. Instance: Params (@union) 2 := {}. Infix "∪" := union (at level 50, left associativity) : stdpp_scope. Class ElemOf A B := elem_of: A → B → Prop. Global Hint Mode ElemOf - ! : typeclass_instances. Instance: Params (@elem_of) 3 := {}. Infix "∈" := elem_of (at level 70) : stdpp_scope. Class FMap (M : Type → Type) := fmap : ∀ {A B}, (A → B) → M A → M B. Global Arguments fmap {_ _ _ _} _ !_ / : assert. Instance: Params (@fmap) 4 := {}. Infix "<$>" := fmap (at level 61, left associativity) : stdpp_scope. (** * Operations on maps *) (** In this section we define operational type classes for the operations on maps. In the file [fin_maps] we will axiomatize finite maps. The function look up [m !! k] should yield the element at key [k] in [m]. *) Class Lookup (K A M : Type) := lookup: K → M → option A. Global Hint Mode Lookup - - ! : typeclass_instances. Instance: Params (@lookup) 4 := {}. Notation "m !! i" := (lookup i m) (at level 20) : stdpp_scope. Global Arguments lookup _ _ _ _ !_ !_ / : simpl nomatch, assert. (** The function insert [<[k:=a]>m] should update the element at key [k] with value [a] in [m]. *) Class Insert (K A M : Type) := insert: K → A → M → M. Global Hint Mode Insert - - ! : typeclass_instances. Instance: Params (@insert) 5 := {}. Notation "<[ k := a ]>" := (insert k a) (at level 5, right associativity, format "<[ k := a ]>") : stdpp_scope. Global Arguments insert _ _ _ _ !_ _ !_ / : simpl nomatch, assert. (** The function delete [delete k m] should delete the value at key [k] in [m]. If the key [k] is not a member of [m], the original map should be returned. *) Class Delete (K M : Type) := delete: K → M → M. Global Hint Mode Delete - ! : typeclass_instances. Instance: Params (@delete) 4 := {}. Global Arguments delete _ _ _ !_ !_ / : simpl nomatch, assert. (** The function [partial_alter f k m] should update the value at key [k] using the function [f], which is called with the original value at key [k] or [None] if [k] is not a member of [m]. The value at [k] should be deleted if [f] yields [None]. *) Class PartialAlter (K A M : Type) := partial_alter: (option A → option A) → K → M → M. Global Hint Mode PartialAlter - - ! : typeclass_instances. Instance: Params (@partial_alter) 4 := {}. Global Arguments partial_alter _ _ _ _ _ !_ !_ / : simpl nomatch, assert. (** The function [merge f m1 m2] should merge the maps [m1] and [m2] by constructing a new map whose value at key [k] is [f (m1 !! k) (m2 !! k)].*) Class Merge (M : Type → Type) := merge: ∀ {A B C}, (option A → option B → option C) → M A → M B → M C. Global Hint Mode Merge ! : typeclass_instances. Instance: Params (@merge) 4 := {}. Global Arguments merge _ _ _ _ _ _ !_ !_ / : simpl nomatch, assert. (** The function [union_with f m1 m2] is supposed to yield the union of [m1] and [m2] using the function [f] to combine values of members that are in both [m1] and [m2]. *) Class UnionWith (A M : Type) := union_with: (A → A → option A) → M → M → M. Global Hint Mode UnionWith - ! : typeclass_instances. Instance: Params (@union_with) 3 := {}. Global Arguments union_with {_ _ _} _ !_ !_ / : simpl nomatch, assert. (** We redefine the standard library's [In] and [NoDup] using type classes. *) Inductive elem_of_list {A} : ElemOf A (list A) := | elem_of_list_here (x : A) l : x ∈ x :: l | elem_of_list_further (x y : A) l : x ∈ l → x ∈ y :: l. Existing Instance elem_of_list. End base. (** * Monadic operations *) Global Instance option_fmap: FMap option := @option_map. Global Instance option_union_with {A} : UnionWith A (option A) := λ f mx my, match mx, my with | Some x, Some y => f x y | Some x, None => Some x | None, Some y => Some y | None, None => None end. Global Instance option_union {A} : Union (option A) := union_with (λ x _, Some x). Unset Default Proof Using. Class FinMapToList K A M := map_to_list: M → list (K * A). Global Hint Mode FinMapToList ! - - : typeclass_instances. Global Hint Mode FinMapToList - - ! : typeclass_instances. Class FinMap K M `{FMap M, ∀ A, Lookup K A (M A), ∀ A, Empty (M A), ∀ A, PartialAlter K A (M A), OMap M, Merge M, ∀ A, FinMapToList K A (M A), EqDecision K} := { map_eq {A} (m1 m2 : M A) : (∀ i, m1 !! i = m2 !! i) → m1 = m2; lookup_partial_alter {A} f (m : M A) i : partial_alter f i m !! i = f (m !! i); lookup_partial_alter_ne {A} f (m : M A) i j : i ≠ j → partial_alter f i m !! j = m !! j; lookup_fmap {A B} (f : A → B) (m : M A) i : (f <$> m) !! i = f <$> m !! i; NoDup_map_to_list {A} (m : M A) : NoDup (map_to_list m); elem_of_map_to_list {A} (m : M A) i x : (i,x) ∈ map_to_list m ↔ m !! i = Some x; lookup_merge {A B C} (f : option A → option B → option C) `{!DiagNone f} (m1 : M A) (m2 : M B) i : merge f m1 m2 !! i = f (m1 !! i) (m2 !! i) }. (** * Derived operations *) (** All of the following functions are defined in a generic way for arbitrary finite map implementations. These generic implementations do not cause a significant performance loss, which justifies including them in the finite map interface as primitive operations. *) Global Instance map_insert `{PartialAlter K A M} : Insert K A M := λ i x, partial_alter (λ _, Some x) i. Global Instance map_delete `{PartialAlter K A M} : Delete K M := partial_alter (λ _, None). Global Instance map_union_with `{Merge M} {A} : UnionWith A (M A) := λ f, merge (union_with f). Global Instance map_union `{Merge M} {A} : Union (M A) := union_with (λ x _, Some x). (** * Theorems *) Section theorems. Context `{FinMap K M}. (** Just the Insert instance is missing, as we've commited on (M A) *) Fail Lemma union_delete_insert {A} (m1 m2 : M A) i x : m1 !! i = Some x → delete i m1 ∪ <[i:=i]> m2 = m1 ∪ m2. Lemma union_delete_insert {A} (m1 m2 : M A) i x : m1 !! i = Some x → delete i m1 ∪ <[i:=x]> m2 = m1 ∪ m2. Proof. Abort. End theorems. coq-8.20.0/test-suite/output/bug_14141.out000066400000000000000000000001441466560755400201120ustar00rootroot000000000000001 goal n : nat ============================ forall (n0 : nat) (H : n0 <= S n), S n0 <= S n coq-8.20.0/test-suite/output/bug_14141.v000066400000000000000000000002271466560755400175520ustar00rootroot00000000000000Set Fast Name Printing. Lemma le_succ_diag_r (n : nat) : n <= S n. Proof. apply (nat_ind (fun p : nat => p <= S n)). apply le_0_n. Show. Abort. coq-8.20.0/test-suite/output/bug_14815.out000066400000000000000000000003121466560755400201170ustar00rootroot00000000000000f = fix f (n : nat) : nat := match n with | 0 => 0 | S n0 => g n0 end with g (n : nat) : nat := match n with | 0 => 0 | S n0 => f n0 end for f : nat -> nat Arguments f n%nat_scope coq-8.20.0/test-suite/output/bug_14815.v000066400000000000000000000001611466560755400175570ustar00rootroot00000000000000Fixpoint f n := match n with S n => g n | O => O end with g n := match n with S n => f n | O => O end. Print f. coq-8.20.0/test-suite/output/bug_14899.out000066400000000000000000000001361466560755400201370ustar00rootroot00000000000000proj2_sig a : 0 < proj1_sig a = le_S 1 2 (le_S 1 1 (le_n 1)) : 0 < proj1_sig a coq-8.20.0/test-suite/output/bug_14899.v000066400000000000000000000001471466560755400175770ustar00rootroot00000000000000Definition a : { x | 0 < x }. exists 3. eauto. Defined. Check (proj2_sig a). Compute (proj2_sig a). coq-8.20.0/test-suite/output/bug_15020.out000066400000000000000000000004631466560755400201130ustar00rootroot00000000000000eq_rect : forall {A : Type} {x : A} (P : A -> Type), P x -> forall {y : A}, x = y -> P y eq_rect is not universe polymorphic Arguments eq_rect {A}%type_scope {x} P%function_scope f {y} e (where some original arguments have been renamed) eq_rect is transparent Expands to: Constant Coq.Init.Logic.eq_rect coq-8.20.0/test-suite/output/bug_15020.v000066400000000000000000000001161466560755400175440ustar00rootroot00000000000000(* A variant of bug #13392 *) Arguments eq_rect {_ _} _ _ {_}. About eq_rect. coq-8.20.0/test-suite/output/bug_15097.out000066400000000000000000000005361466560755400201320ustar00rootroot00000000000000File "./output/bug_15097.v", line 1, characters 20-38: The command has indeed failed with message: Cannot find a physical path bound to logical path Coq.Does.Not.Exist. File "./output/bug_15097.v", line 2, characters 29-43: The command has indeed failed with message: Cannot find a physical path bound to logical path Does.Not.Exist with prefix Coq. coq-8.20.0/test-suite/output/bug_15097.v000066400000000000000000000001251466560755400175620ustar00rootroot00000000000000Fail Require Import Coq.Does.Not.Exist. Fail From Coq Require Import Does.Not.Exist. coq-8.20.0/test-suite/output/bug_15106.out000066400000000000000000000001771466560755400201220ustar00rootroot00000000000000File "./output/bug_15106.v", line 7, characters 0-18: The command has indeed failed with message: Obligation 2 already solved. coq-8.20.0/test-suite/output/bug_15106.v000066400000000000000000000003341466560755400175530ustar00rootroot00000000000000Require Import Coq.Program.Tactics. Local Obligation Tactic := try constructor. Axiom P : Prop. Axiom p : P. Program Definition foo := (fun (x : P) (y : True) => I) _ _. Fail Obligation 2. Obligation 1. exact p. Qed. coq-8.20.0/test-suite/output/bug_15221.out000066400000000000000000000002501466560755400201100ustar00rootroot00000000000000chain = fun x y : nat => let/c f := foo x y in let/c b := bar x y in f = b : nat -> nat -> Prop Arguments chain (x y)%nat_scope coq-8.20.0/test-suite/output/bug_15221.v000066400000000000000000000006031466560755400175500ustar00rootroot00000000000000Definition foo{A}(a b: nat)(k: nat -> A): A := k (a + b). Definition bar{A}(a b: nat)(k: nat -> A): A := k (a - b). Notation "'let/c' x := r 'in' b" := (r (fun x => b)) (x binder, at level 200, right associativity, format "'[hv' 'let/c' x := r 'in' '//' b ']'"). Definition chain(x y: nat): Prop := let/c f := foo x y in let/c b := bar x y in f = b. Print chain. coq-8.20.0/test-suite/output/bug_15322.out000066400000000000000000000003021466560755400201100ustar00rootroot00000000000000x `+ (y `+ z) : nat [x `+ (y `+ z)] : nat fun x y z : nat => [x `+ (y `+ z)] : nat -> (nat -> (nat -> nat)) fun x y z : nat => [x `+ (y `+ z)] : nat -> (nat -> (nat -> nat)) coq-8.20.0/test-suite/output/bug_15322.v000066400000000000000000000015321466560755400175540ustar00rootroot00000000000000Set Printing Parentheses. Module Constr. Parameters x y z : nat. Notation "a `+ b" := (a + b) (at level 50, b at level 50, left associativity). Check (x `+ y `+ z). End Constr. Module CustomGlobal. Declare Custom Entry foo. Notation "a `+ b" := (a + b) (in custom foo at level 50, b at level 50). Notation "x" := x (in custom foo at level 0, x global). Notation "( x )" := x (in custom foo at level 0). Notation "[ a ]" := a (a custom foo). Parameters x y z : nat. Check [x `+ y `+ z]. Check fun x y z => [x `+ y `+ z]. End CustomGlobal. Module CustomIdent. Declare Custom Entry bar. Notation "a `+ b" := (a + b) (in custom bar at level 50, b at level 50). Notation "x" := x (in custom bar at level 0, x ident). Notation "( x )" := x (in custom bar at level 0). Notation "[ a ]" := a (a custom bar). Check fun x y z => [x `+ y `+ z]. End CustomIdent. coq-8.20.0/test-suite/output/bug_15334.out000066400000000000000000000002271466560755400201210ustar00rootroot00000000000000File "./output/bug_15334.v", line 4, characters 11-12: Error: Syntax error: [custom:ent] expected after 'ent:(' (in [term]). coqc exited with code 1 coq-8.20.0/test-suite/output/bug_15334.v000066400000000000000000000002231466560755400175530ustar00rootroot00000000000000Declare Custom Entry ent. Notation "ent:( x )" := x (x custom ent). Notation "a ; b" := (pair a b) (in custom ent at level 50). Check ent:(_ ; _). coq-8.20.0/test-suite/output/bug_15687.out000066400000000000000000000010171466560755400201320ustar00rootroot00000000000000File "./output/bug_15687.v", line 7, characters 11-16: The command has indeed failed with message: This expression has type int -> 'a but an expression was expected of type int File "./output/bug_15687.v", line 10, characters 11-16: The command has indeed failed with message: This expression has type int -> bool but an expression was expected of type int File "./output/bug_15687.v", line 18, characters 55-65: The command has indeed failed with message: This expression should not be a function, the expected type is int. coq-8.20.0/test-suite/output/bug_15687.v000066400000000000000000000010471466560755400175730ustar00rootroot00000000000000Require Import Ltac2.Ltac2. Fail Ltac2 rec foo(i: int)(j: int) := foo i (bar j) (*^^^*) with bar(i: int) := Int.add (foo i (*i*)) 1. Fail Ltac2 rec bar(i: int) := Int.add (foo i (*i*)) 1 with foo(i: int)(j: int) : bool := foo i (bar j). (* The location is not great if we write "fun x y => x" but that's unrelated to what we're testing here. Also the toplevel "Ltac2 rec foo :=" is currently not smart enough to recognize a function with type annotation. *) Fail Ltac2 foo := let rec foo : int -> int := fun x => fun y => x in foo. coq-8.20.0/test-suite/output/bug_15709.out000066400000000000000000000000431466560755400201230ustar00rootroot00000000000000String "]" : string -> string coq-8.20.0/test-suite/output/bug_15709.v000066400000000000000000000001301466560755400175560ustar00rootroot00000000000000Require Import Coq.Strings.String. Require Import Coq.Strings.Ascii. Check String "]". coq-8.20.0/test-suite/output/bug_16219.out000066400000000000000000000007511466560755400201260ustar00rootroot00000000000000Closed under the global context Closed under the global context File "./output/bug_16219.v", line 7, characters 0-76: The command has indeed failed with message: Incorrect elimination of "e" in the inductive type "squashed_eq": the return type has sort "Type" while it should be SProp. Elimination of an inductive object of sort SProp is not allowed on a predicate in sort "Type" because strict proofs can be eliminated only to build strict proofs. Axioms: seq relies on definitional UIP. coq-8.20.0/test-suite/output/bug_16219.v000066400000000000000000000006141466560755400175620ustar00rootroot00000000000000Inductive sUnit : SProp := stt. Print Assumptions sUnit. (* was bug: sUnit relies on definitional UIP. *) Inductive squashed_eq {A} a : A -> SProp := squashed_refl : squashed_eq a a. Print Assumptions squashed_eq. Fail Check fun e : squashed_eq 0 1 => match e with squashed_refl _ => 2 end. Set Definitional UIP. Inductive seq {A} a : A -> SProp := srefl : seq a a. Print Assumptions seq_rect. coq-8.20.0/test-suite/output/bug_16224.out000066400000000000000000000002711466560755400201170ustar00rootroot00000000000000[reverse_coercion] : ReverseCoercionSource >-> ReverseCoercionTarget [rc] : Rc >-> A (reversible) [ric] : Ric >-> A (reversible) ric : Ric -> A cic : Cic -> A ri : Ri -> A ci : Ci -> A coq-8.20.0/test-suite/output/bug_16224.v000066400000000000000000000003701466560755400175550ustar00rootroot00000000000000Class A := { n : nat }. Record Rn := { rn : A }. Class Cn := { cn : A }. Record Rc := { rc :> A }. Record Ri := { ri :: A }. Class Ci := { ci :: A }. Record Ric := { ric ::> A }. Class Cic := { cic ::> A }. Print Graph. Print Instances A. coq-8.20.0/test-suite/output/bug_16262.out000066400000000000000000000004121466560755400201160ustar00rootroot00000000000000nat -> nat : Set nat -> nat : Set (1->2)%foo : nat * nat File "./output/bug_16262.v", line 9, characters 0-116: Warning: Notation "_ -> _" was already defined with a different format. [notation-incompatible-format,parsing,default] nat->nat : Set coq-8.20.0/test-suite/output/bug_16262.v000066400000000000000000000005501466560755400175570ustar00rootroot00000000000000Declare Scope foo. Delimit Scope foo with foo. Check (nat -> nat). Notation "a -> b" := (a,b) (b at level 200, only printing, right associativity, at level 99, format "a -> b") : foo. Check (nat -> nat). Check (1,2). Reserved Notation "a -> b" (b at level 200, only printing, right associativity, at level 99, format "a -> b"). Check (nat -> nat). coq-8.20.0/test-suite/output/bug_16335.out000066400000000000000000000001341466560755400201200ustar00rootroot00000000000000Error: There are pending proofs in file ./output/bug_16335.v: foo. coqc exited with code 1 coq-8.20.0/test-suite/output/bug_16335.v000066400000000000000000000000301466560755400175510ustar00rootroot00000000000000Lemma foo: True. Proof. coq-8.20.0/test-suite/output/bug_16411.out000066400000000000000000000000631466560755400201140ustar00rootroot00000000000000Axioms: foo : nat 0 : nat Axioms: axiom : nat coq-8.20.0/test-suite/output/bug_16411.v000066400000000000000000000002361466560755400175540ustar00rootroot00000000000000(* -*- mode: coq; coq-prog-args: ("-vok") -*- *) Require Import TestSuite.for_vos. Print Assumptions foo. Check 0. (* separator *) Print Assumptions bar. coq-8.20.0/test-suite/output/bug_16558.out000066400000000000000000000000341466560755400201260ustar00rootroot00000000000000Ltac t x y := abstract : x coq-8.20.0/test-suite/output/bug_16558.v000066400000000000000000000000761466560755400175720ustar00rootroot00000000000000Require Import ssreflect. Ltac t x y := abstract: x. Print t. coq-8.20.0/test-suite/output/bug_16562.out000066400000000000000000000000251466560755400201210ustar00rootroot00000000000000Ltac t x := unlock x coq-8.20.0/test-suite/output/bug_16562.v000066400000000000000000000000721466560755400175610ustar00rootroot00000000000000Require Import ssreflect. Ltac t x := unlock x. Print t. coq-8.20.0/test-suite/output/bug_16565.out000066400000000000000000000000521466560755400201240ustar00rootroot00000000000000Ltac u a b := functional induction a as b coq-8.20.0/test-suite/output/bug_16565.v000066400000000000000000000001131466560755400175600ustar00rootroot00000000000000Require Import FunInd. Ltac u a b := functional induction a as b. Print u. coq-8.20.0/test-suite/output/bug_16566.out000066400000000000000000000000741466560755400201310ustar00rootroot00000000000000Ltac t a b := rewrite a, b Ltac t a b := rewrite -> a, -> b coq-8.20.0/test-suite/output/bug_16566.v000066400000000000000000000001101466560755400175560ustar00rootroot00000000000000Ltac t a b := rewrite a, b. Print t. Require Import ssreflect. Print t. coq-8.20.0/test-suite/output/bug_16596.out000066400000000000000000000000431466560755400201300ustar00rootroot00000000000000Ltac t := unshelve (only 1: idtac) coq-8.20.0/test-suite/output/bug_16596.v000066400000000000000000000000551466560755400175710ustar00rootroot00000000000000Ltac t := unshelve (only 1: idtac). Print t. coq-8.20.0/test-suite/output/bug_16613.out000066400000000000000000000002421466560755400201170ustar00rootroot00000000000000File "./output/bug_16613.v", line 2, characters 2-10: Warning: This command does not support these attributes: bar, foo. [unsupported-attributes,parsing,default] coq-8.20.0/test-suite/output/bug_16613.v000066400000000000000000000001101466560755400175470ustar00rootroot00000000000000Set Warnings "unsupported-attributes". #[foo, bar] Definition foo := I. coq-8.20.0/test-suite/output/bug_16716.out000066400000000000000000000002221466560755400201210ustar00rootroot00000000000000File "./output/bug_16716.v", line 11, characters 0-55: The command has indeed failed with message: Uncaught Ltac2 exception: E constr:(?X4.(r _)) coq-8.20.0/test-suite/output/bug_16716.v000066400000000000000000000004631466560755400175660ustar00rootroot00000000000000Require Import Ltac2.Ltac2. Set Primitive Projections. Record R A := mkR { r : A }. Ltac2 Type exn ::= [ E (constr) ]. Set Printing Projections. Set Printing Primitive Projection Parameters. Fail Ltac2 Eval Control.zero (E open_constr:(_.(r _))). (* Error: Uncaught Ltac2 exception: E (constr:(...)) *) coq-8.20.0/test-suite/output/bug_16816.out000066400000000000000000000005001466560755400201210ustar00rootroot00000000000000File "./output/bug_16816.v", line 6, characters 15-16: The command has indeed failed with message: In environment s : Box unit T : Type x : T The term "x" has type "T" while it is expected to have type "?S@{u0:=T}" (unable to find a well-typed instantiation for "?S": cannot ensure that "Type" is a subtype of "Set"). coq-8.20.0/test-suite/output/bug_16816.v000066400000000000000000000002301466560755400175570ustar00rootroot00000000000000Inductive Box : Type -> Type := | box : forall A, A -> Box A. Fail Definition open_box (s : Box unit) : unit := match s with | box _ x => x end. coq-8.20.0/test-suite/output/bug_17002.out000066400000000000000000000011721466560755400201130ustar00rootroot00000000000000File "./output/bug_17002.v", line 7, characters 2-24: The command has indeed failed with message: Universe inconsistency. Cannot enforce u < v because v = u. File "./output/bug_17002.v", line 8, characters 2-24: The command has indeed failed with message: Universe inconsistency. Cannot enforce v < u because u = v. File "./output/bug_17002.v", line 15, characters 2-24: The command has indeed failed with message: Universe inconsistency. Cannot enforce u = v because u < v. File "./output/bug_17002.v", line 16, characters 2-24: The command has indeed failed with message: Universe inconsistency. Cannot enforce v = u because u < v. coq-8.20.0/test-suite/output/bug_17002.v000066400000000000000000000004631466560755400175530ustar00rootroot00000000000000 Module Eq. Universes u v. Constraint u = v. (* we test both directions to be invariant wrt which universe got picked as canonical *) Fail Constraint u < v. Fail Constraint v < u. End Eq. Module Lt. Universes u v. Constraint u < v. Fail Constraint u = v. Fail Constraint v = u. End Lt. coq-8.20.0/test-suite/output/bug_17155.out000066400000000000000000000007061466560755400201260ustar00rootroot00000000000000File "./output/bug_17155.v", line 6, characters 0-23: The command has indeed failed with message: Uncaught Ltac2 exception: Invalid_argument None File "./output/bug_17155.v", line 8, characters 0-23: The command has indeed failed with message: Uncaught Ltac2 exception: Invalid_argument None Backtrace: Call M.g Call bug_17155.M.f (* local *) Prim Ltac2 M.g : unit -> 'a M.g := fun _ => bug_17155.M.f (* local *) () coq-8.20.0/test-suite/output/bug_17155.v000066400000000000000000000004601466560755400175610ustar00rootroot00000000000000From Ltac2 Require Import Ltac2. Module M. #[local] Ltac2 f () := Control.throw (Invalid_argument None). Ltac2 g () := f (). End M. Fail Ltac2 Eval M.g (). (* Fails, as expected. *) Set Ltac2 Backtrace. Fail Ltac2 Eval M.g (). (* Anomaly "Uncaught exception Not_found." *) Print M.g. coq-8.20.0/test-suite/output/bug_17369.out000066400000000000000000000002051466560755400201270ustar00rootroot00000000000000{- my_inductive_prop : logical inductive with constructors : constr_1 constr_2 constr_3 constr_4 constr_5 constr_6 constr_7 -} coq-8.20.0/test-suite/output/bug_17369.v000066400000000000000000000005361466560755400175740ustar00rootroot00000000000000(* Ensure that 'logical inductive' comments in extracted Haskell * do not get uncommented by line wrapping *) From Coq Require Import Extraction. Set Printing Width 60. Inductive my_inductive_prop : Prop := constr_1 | constr_2 | constr_3 | constr_4 | constr_5 | constr_6 | constr_7 . Extraction Language Haskell. Extraction my_inductive_prop. coq-8.20.0/test-suite/output/bug_17372.out000066400000000000000000000002371466560755400201260ustar00rootroot00000000000000File "./output/bug_17372.v", line 2, characters 13-16: The command has indeed failed with message: The reference bar was not found in the current environment. coq-8.20.0/test-suite/output/bug_17372.v000066400000000000000000000000601466560755400175560ustar00rootroot00000000000000Goal Prop. Fail refine (bar (A := nat)). Abort. coq-8.20.0/test-suite/output/bug_17386.out000066400000000000000000000001021466560755400201220ustar00rootroot000000000000001 goal x, y := 1 : nat ============================ True coq-8.20.0/test-suite/output/bug_17386.v000066400000000000000000000002111466560755400175610ustar00rootroot00000000000000Goal True. evar (x:nat). pose (y:=1). let _ := constr:(eq_refl : x = 1) in idtac. Show. (* x := 1 y := 1 should be x, y := 1 *) Abort. coq-8.20.0/test-suite/output/bug_17579.out000066400000000000000000000004251466560755400201360ustar00rootroot00000000000000File "./output/bug_17579.v", line 4, characters 0-26: The command has indeed failed with message: Timeout must be > 0. File "./output/bug_17579.v", line 7, characters 8-9: Error: Syntax error: [natural] expected after 'Timeout' (in [vernac_control]). coqc exited with code 1 coq-8.20.0/test-suite/output/bug_17579.v000066400000000000000000000003171466560755400175740ustar00rootroot00000000000000(* -*- coq-prog-args: ("-async-proofs" "no"); -*- *) (* disable async proofs because they get the parse error before running the Fail *) Fail Timeout 0 Check True. (* parse error *) Timeout -1 Check True. coq-8.20.0/test-suite/output/bug_17594.out000066400000000000000000000023551466560755400201370ustar00rootroot000000000000001 3 2 3 File "./output/bug_17594.v", line 12, characters 19-20: The command has indeed failed with message: The term "0" has type "nat" while it is expected to have type "True". 1 3 2 3 File "./output/bug_17594.v", line 17, characters 26-27: The command has indeed failed with message: The term "0" has type "nat" while it is expected to have type "True". 1 3 2 3 File "./output/bug_17594.v", line 23, characters 19-20: The command has indeed failed with message: The term "0" has type "nat" while it is expected to have type "True". 1 3 2 3 File "./output/bug_17594.v", line 28, characters 26-27: The command has indeed failed with message: The term "0" has type "nat" while it is expected to have type "True". 1 3 File "./output/bug_17594.v", line 31, characters 2-106: The command has indeed failed with message: Uncaught Ltac2 exception: Match_failure 1 3 File "./output/bug_17594.v", line 37, characters 2-113: The command has indeed failed with message: No matching clauses for match. 1 3 File "./output/bug_17594.v", line 42, characters 2-119: The command has indeed failed with message: No matching clauses for match. 1 3 File "./output/bug_17594.v", line 48, characters 2-119: The command has indeed failed with message: No matching clauses for match. coq-8.20.0/test-suite/output/bug_17594.v000066400000000000000000000021161466560755400175700ustar00rootroot00000000000000From Ltac2 Require Import Ltac2. From Ltac2 Require Import Message. Ltac2 msg s := print (of_string s). Goal True. (* should be the exact error *) Fail multi_match! 'True with | True => msg "1" | _ => msg "2" end; msg "3"; exact 0. Fail ltac1:(multimatch True with | True => idtac "1" | _ => idtac "2" end; idtac "3"; exact 0). Fail multi_match! goal with | [ |- True ] => msg "1" | [ |- _ ] => msg "2" end; msg "3"; exact 0. Fail ltac1:(multimatch goal with | |- True => idtac "1" | |- _ => idtac "2" end; idtac "3"; exact 0). (* should be match error *) Fail multi_match! 'True with | True => msg "1" | False => msg "2" end; msg "3"; exact 0. Fail ltac1:(multimatch True with | True => idtac "1" | False => idtac "2" end; idtac "3"; exact 0). Fail multi_match! goal with | [ |- True ] => msg "1" | [ |- False ] => msg "2" end; msg "3"; exact 0. Fail ltac1:(multimatch goal with | |- True => idtac "1" | |- False => idtac "2" end; idtac "3"; exact 0). Abort. coq-8.20.0/test-suite/output/bug_17627.out000066400000000000000000000000221466560755400201210ustar00rootroot00000000000000φ (O) : nat coq-8.20.0/test-suite/output/bug_17627.v000066400000000000000000000001341466560755400175630ustar00rootroot00000000000000 Module Import Bar. Notation "'φ' x" := (id x) (at level 0) . End Bar. Check (φ 0). coq-8.20.0/test-suite/output/bug_17708.out000066400000000000000000000003251466560755400201270ustar00rootroot00000000000000File "./output/bug_17708.v", line 1, characters 0-35: Warning: This notation contains Ltac expressions: it will not be used for printing. [non-reversible-notation,parsing,default] Ltac foo := exact ltac:(exact 0) coq-8.20.0/test-suite/output/bug_17708.v000066400000000000000000000001071466560755400175630ustar00rootroot00000000000000Notation zero := (ltac: (exact 0)). Ltac foo := exact zero. Print foo. coq-8.20.0/test-suite/output/bug_17829.out000066400000000000000000000000321466560755400201260ustar00rootroot00000000000000Ltac f := foo (foo idtac) coq-8.20.0/test-suite/output/bug_17829.v000066400000000000000000000001501466560755400175650ustar00rootroot00000000000000Tactic Notation (at level 3) "foo" tactic2(tac) := intro; tac. Ltac f := foo (foo idtac). Print Ltac f. coq-8.20.0/test-suite/output/bug_17854.out000066400000000000000000000007001466560755400201260ustar00rootroot00000000000000File "./output/bug_17854.v", line 3, characters 11-31: The command has indeed failed with message: The variable a is bound several times in pattern. File "./output/bug_17854.v", line 9, characters 11-31: The command has indeed failed with message: The variable a is bound several times in pattern. File "./output/bug_17854.v", line 27, characters 12-21: The command has indeed failed with message: The variable n is bound several times in pattern. coq-8.20.0/test-suite/output/bug_17854.v000066400000000000000000000011671466560755400175740ustar00rootroot00000000000000Fail Check fun b : bool => match b, b with | true as a, true as a | true as a, _ => true | _, _ => false end. Fail Check fun b : bool => match b, b with | true as a, true as a => true | _, _ => false end. Definition f b := match b, b with | true as a as a, true as b => true | _, _ => false end. Module Bug18002. (* Non linearity to be checked first also at the level of inner disjunctive patterns *) Inductive U := p :nat->nat->U. Fail Check match p 1 2 with | (p n 0 | p n (S n)) => 0 | _ => 1 end. End Bug18002. coq-8.20.0/test-suite/output/bug_18138.out000066400000000000000000000002111466560755400201170ustar00rootroot00000000000000Ltac2 bar : 'a -> unit bar := fun foo => M.foo Ltac2 baz : (unit -> 'a) -> constr baz := fun foo => constr:(ltac2:(foo foo)) coq-8.20.0/test-suite/output/bug_18138.v000066400000000000000000000004111466560755400175570ustar00rootroot00000000000000Require Import Ltac2.Ltac2. Module Import M. Ltac2 foo := (). End M. #[warnings="-ltac2-unused-variable"] Ltac2 bar foo := M.foo. Print bar. (* was fun foo => foo *) (* sadly this is still incorrect *) Ltac2 baz foo := constr:(ltac2:(foo M.foo)). Print baz. coq-8.20.0/test-suite/output/bug_18223.out000066400000000000000000000001401466560755400201130ustar00rootroot00000000000000fun a b : A => < {| b a |} > : A -> A -> A fun a b : A => < {| b a |} > : A -> A -> A coq-8.20.0/test-suite/output/bug_18223.v000066400000000000000000000011351466560755400175560ustar00rootroot00000000000000Declare Custom Entry foo. Declare Custom Entry bar. Parameter (A : Type). Parameter (Q : A -> A -> A). Parameter (P : A -> A). Notation "< x >" := (P x) (x custom foo). Notation "x y" := (Q x y) (in custom bar at level 1, right associativity). Notation "x" := x (in custom bar at level 0, x global). Module Order1. Notation "| x |" := (x) (x custom bar). Notation "{ x }" := (x) (in custom foo, x constr). Check (fun a b => < {Q b a} >). End Order1. Module Order2. Notation "{ x }" := (x) (in custom foo, x constr). Notation "| x |" := (x) (x custom bar). Check (fun a b => < {Q b a} >). End Order2. coq-8.20.0/test-suite/output/bug_18342.out000066400000000000000000000002641466560755400201240ustar00rootroot00000000000000<{ SS (? I) }> : nat <{ SS [[{{?}} I]] }> : nat fun x : I => match x with | <{ DD [[{{?}} y]] }> => y | _ => 0 end : I -> nat coq-8.20.0/test-suite/output/bug_18342.v000066400000000000000000000023301466560755400175560ustar00rootroot00000000000000Declare Custom Entry stlc. Module Bug18342. Definition A (T : True) := 0. Notation "?" := A. Notation "<{ e }>" := e (e custom stlc at level 99). Notation "x" := x (in custom stlc at level 0, x constr at level 0). Notation "'SS' x" := (S x) (in custom stlc at level 89, x custom stlc at level 99). Check <{SS (? I)}>. End Bug18342. Declare Custom Entry qmark. Module Bug18342VariantWithExplicitCoercions. Definition A (T : True) := 0. Notation "?" := A (in custom qmark). Notation "{{ x }}" := x (x custom qmark). Notation "<{ e }>" := e (e custom stlc at level 99). Notation "[[ x ]]" := x (in custom stlc at level 0, x constr). Notation "'SS' x" := (S x) (in custom stlc at level 89, x custom stlc at level 99). Check <{SS [[{{?}} I]]}>. End Bug18342VariantWithExplicitCoercions. Module Bug18342VariantPattern. Inductive I := C : nat -> I | D : I -> I. Notation "?" := C (in custom qmark). Notation "{{ x }}" := x (x custom qmark). Notation "<{ e }>" := e (e custom stlc at level 99). Notation "[[ x ]]" := x (in custom stlc at level 0, x constr). Notation "'DD' x" := (D x) (in custom stlc at level 89, x custom stlc at level 99). Check fun x => match x with <{DD [[{{?}} y]]}> => y | _ => 0 end. End Bug18342VariantPattern. coq-8.20.0/test-suite/output/bug_18368.out000066400000000000000000000000021466560755400201220ustar00rootroot00000000000000B coq-8.20.0/test-suite/output/bug_18368.v000066400000000000000000000001751466560755400175730ustar00rootroot00000000000000Tactic Notation (at level 4) "test" := idtac "A". Tactic Notation (at level 5) "test" := idtac "B". Goal True. test. Abort. coq-8.20.0/test-suite/output/bug_18657.out000066400000000000000000000003261466560755400201340ustar00rootroot00000000000000bar_1: bar = 1 First.bar_1: First.bar = 1 bar: nat First.bar: nat First.bar_1: First.bar = 1 bar_1: bar = 1 bar_1: bar = 1 bar_1: bar = 1 one_bar: 1 = bar baz_foo: baz tt = foo baz: unit -> t baz_foo: baz tt = foo coq-8.20.0/test-suite/output/bug_18657.v000066400000000000000000000017641466560755400176010ustar00rootroot00000000000000Module First. Definition bar := 1. Lemma bar_1 : bar = 1. Proof. reflexivity. Qed. End First. Module Import Second. Include First. Search bar. (*First.bar_1: First.bar = 1*) Search "bar". Lemma one_bar : 1 = bar. Proof. rewrite bar_1. reflexivity. Qed. End Second. Module Type B. Definition bar := 1. Lemma bar_1 : bar = 1. Proof. reflexivity. Qed. End B. Module A. Include B. Search bar. (* was nothing *) Lemma one_bar : 1 = bar. Proof. rewrite bar_1; reflexivity. Qed. Search bar. (* was only one_bar *) End A. Module Type HasFoo. Parameter t : Type. Parameter foo : t. End HasFoo. Module MakeBaz (Import M : HasFoo). Definition baz := fun (_ : unit) => foo. Lemma baz_foo : baz tt = foo. Proof. reflexivity. Qed. End MakeBaz. Module Import Baz <: HasFoo. Definition t := nat. Definition foo := 42. Include MakeBaz. Search baz. (* was nothing *) Search "baz". (* was nothing *) Lemma foo_bas : foo = baz tt. Proof. rewrite baz_foo. reflexivity. Qed. End Baz. coq-8.20.0/test-suite/output/bug_18914.out000066400000000000000000000000311466560755400201210ustar00rootroot00000000000000< a ++ b ++ c > : C coq-8.20.0/test-suite/output/bug_18914.v000066400000000000000000000006141466560755400175660ustar00rootroot00000000000000Declare Custom Entry mor. Declare Custom Entry obj. Notation "< x >" := (x) (x custom mor). Notation "x" := x (in custom mor at level 0, x global). Notation "x" := x (in custom obj at level 0, x global). Parameter C : Type. Parameters a b c : C. Parameter op3 : C -> C -> C. Notation "x ++ y" := (op3 x y) (y custom obj, in custom mor at level 40, left associativity). Check (< a ++ b ++ c >). coq-8.20.0/test-suite/output/bug_19047.out000066400000000000000000000013661466560755400201330ustar00rootroot00000000000000File "./output/bug_19047.v", line 11, characters 2-135: The command has indeed failed with message: Recursive definition of F is ill-formed. In environment coacc_rect : forall (A : Type) (R : A -> A -> Prop) (P : A -> Type), (forall x : A, (forall y : A, R x y -> coAcc R y) -> (forall y : A, R x y -> P y) -> P x) -> forall x : A, coAcc R x -> P x A : Type R : A -> A -> Prop P : A -> Type f : forall x : A, (forall y : A, R x y -> coAcc R y) -> (forall y : A, R x y -> P y) -> P x F : forall x : A, coAcc R x -> P x x : R a : coAcc P x The codomain is "f x" which should be a coinductive type. Recursive definition is: "fun (x : A) (a : coAcc R x) => match a with | coAcc_intro _ _ g => f x g (fun (y : A) (r : R x y) => F y (g y r)) end". coq-8.20.0/test-suite/output/bug_19047.v000066400000000000000000000012061466560755400175620ustar00rootroot00000000000000CoInductive coAcc {A : Type} (R : A -> A -> Prop) (x : A) : Prop := | coAcc_intro : (forall y : A, R x y -> coAcc R y) -> coAcc R x. Fail CoFixpoint coacc_rect : forall (A : Type) (R : A -> A -> Prop) (P : A -> Type), (forall x : A, (forall y : A, R x y -> coAcc R y) -> (forall y : A, R x y -> P y) -> P x) -> forall x : A, coAcc R x -> P x := fun (A : Type) (R : A -> A -> Prop) (P : A -> Type) (f : (forall x : A, (forall y : A, R x y -> coAcc R y) -> (forall y : A, R x y -> P y) -> P x)) => cofix F (x : A) (a : coAcc R x) : P x := match a with | coAcc_intro _ _ g => f x g (fun (y : A) (r : R x y) => F y (g y r)) end. coq-8.20.0/test-suite/output/bug_19138.out000066400000000000000000000001021466560755400201170ustar00rootroot00000000000000Existential 1 = ?f : [ |- False] Existential 1 = ?f : [ |- False] coq-8.20.0/test-suite/output/bug_19138.v000066400000000000000000000010521466560755400175620ustar00rootroot00000000000000From Ltac2 Require Import Ltac2 Constr. Import Constr.Unsafe. Goal True. let t := open_constr:(_ :> False) in match kind t with | Evar e _ => Control.new_goal e > [refine 'I|] | _ => Control.throw Not_found end. Show Existentials. (* Existential 1 = ?Goal : [ |- False] (shelved) *) Abort. Goal True. let t := unshelve open_constr:(_ :> False) in Control.extend [Control.shelve] (fun () => ()) []; match kind t with | Evar e _ => Control.new_goal e > [refine 'I|] | _ => Control.throw Not_found end. Show Existentials. Abort. coq-8.20.0/test-suite/output/bug_3810.out000066400000000000000000000002331466560755400200320ustar00rootroot00000000000000test : Foo -> nat -> forall {A : Type}, A test is not universe polymorphic Arguments test H n%nat_scope {A}%type_scope Expands to: Constant bug_3810.test coq-8.20.0/test-suite/output/bug_3810.v000066400000000000000000000003311466560755400174670ustar00rootroot00000000000000Class Foo. Fixpoint test (H : Foo) (n : nat) {A : Type} {struct n} : A. Admitted. About test. (* test : Foo -> nat -> forall A : Type, A test is universe polymorphic Argument n is implicit and maximally inserted *) coq-8.20.0/test-suite/output/bug_4167.out000066400000000000000000000000661466560755400200440ustar00rootroot00000000000000foo = foo : Prop t1.(foo) = t2.(foo) : Prop coq-8.20.0/test-suite/output/bug_4167.v000066400000000000000000000003221466560755400174750ustar00rootroot00000000000000Class test {y x: nat} : Set := { foo: nat }. Parameter (x y:nat) (t1 t2: @ test x y). Existing Instance t1. Existing Instance t2. Check t1.(foo) = t2.(foo). Set Printing Projections. Check t1.(foo) = t2.(foo). coq-8.20.0/test-suite/output/bug_4337.out000066400000000000000000000003531466560755400200420ustar00rootroot00000000000000File "./output/bug_4337.v", line 4, characters 35-36: The command has indeed failed with message: In environment Foo : list var -> term -> Prop l : list var x : var The term "x" has type "var" while it is expected to have type "term". coq-8.20.0/test-suite/output/bug_4337.v000066400000000000000000000001571466560755400175020ustar00rootroot00000000000000Axiom var term : Type. Fail Inductive Foo : list var -> term -> Prop := | foo : forall l x, Foo (cons x l) x. coq-8.20.0/test-suite/output/bug_4712_part2.out000066400000000000000000000004521466560755400211470ustar00rootroot00000000000000File "./output/bug_4712_part2.v", line 6, characters 21-28: The command has indeed failed with message: The reference foobarA was not found in the current environment. File "./output/bug_4712_part2.v", line 8, characters 21-22: Error: Syntax Error: Lexer: Undefined token coqc exited with code 1 coq-8.20.0/test-suite/output/bug_4712_part2.v000066400000000000000000000003151466560755400206030ustar00rootroot00000000000000Module Example2. Notation "'foobar'" := 1. Definition a := foobar. Definition A := 2. Fail Definition b := foobarA. Notation "'\foobar'" := (fun x => 1 + x). Fail Definition b := \foobarA. End Example2. coq-8.20.0/test-suite/output/bug_5222.out000066400000000000000000000004401466560755400200310ustar00rootroot000000000000001 goal ============================ True = (nil : T1 nat) File "./output/bug_5222.v", line 16, characters 2-40: Warning: C2 does not respect the uniform inheritance condition. [uniform-inheritance,coercions,default] 1 goal ============================ True = (nil : T2 nat) coq-8.20.0/test-suite/output/bug_5222.v000066400000000000000000000006611466560755400174740ustar00rootroot00000000000000(* coq-prog-args: ("-async-proofs" "off") *) Definition T1 (X : Type) : Type := list X. Coercion C1 (X: Type) (A : T1 X) : Prop := True. (* Works fine. *) Goal True = (nil : T1 nat). Proof. Show. trivial. Qed. Definition T2 (X : Type) : Type := list X. Section S. Context (X : Type). Coercion C2 (A : T2 X) : Prop := True. End S. Goal True = (nil : T2 nat). (* The coercion works... *) Proof. Show. trivial. Qed. coq-8.20.0/test-suite/output/bug_6764.out000066400000000000000000000002301466560755400200420ustar00rootroot00000000000000forall f : foo, ■ f = ■ f : Prop forall f : foo, ■ f = ■ f : Prop fun x : T => %% x : T -> nat fun x : T => %% x : T -> nat coq-8.20.0/test-suite/output/bug_6764.v000066400000000000000000000011311466560755400175010ustar00rootroot00000000000000Module A. Set Primitive Projections. Record foo := Foo { foo_n : nat }. Notation "'■' x" := (foo_n x) (at level 50). Check forall (f:foo), ■ f = ■ f. End A. Module A'. Set Primitive Projections. Record foo := Foo { foo_n : nat }. Notation "'■' x" := x.(foo_n) (at level 50). Check forall (f:foo), ■ f = ■ f. End A'. (* Variant with non-primitive projections *) Module B. Record T := {a:nat}. Notation "%% x" := (a x) (at level 0, x at level 0). Check fun x => %%x. End B. Module B'. Record T := {a:nat}. Notation "%% x" := x.(a) (at level 0, x at level 0). Check fun x => %%x. End B'. coq-8.20.0/test-suite/output/bug_7443.out000066400000000000000000000013541466560755400200450ustar00rootroot00000000000000Literal 1 : Type File "./output/bug_7443.v", line 21, characters 2-46: Warning: Notation "[ _ ]" was already used in scope foo_scope. [notation-overridden,parsing,default] [1] : Type File "./output/bug_7443.v", line 23, characters 2-82: Warning: Notation "[ _ ]" was already used in scope foo_scope. [notation-overridden,parsing,default] Literal 1 : Type [1] : Type File "./output/bug_7443.v", line 30, characters 14-15: The command has indeed failed with message: The term "1" has type "Datatypes.nat" while it is expected to have type "denote ?t". File "./output/bug_7443.v", line 33, characters 2-82: Warning: Notation "[ _ ]" was already used in scope foo_scope. [notation-overridden,parsing,default] Literal 1 : Type coq-8.20.0/test-suite/output/bug_7443.v000066400000000000000000000032421466560755400175010ustar00rootroot00000000000000Inductive type := nat | bool. Definition denote (t : type) := match t with | nat => Datatypes.nat | bool => Datatypes.bool end. Ltac reify t := lazymatch eval cbv beta in t with | Datatypes.nat => nat | Datatypes.bool => bool end. Notation reify t := (ltac:(let rt := reify t in exact rt)) (only parsing). Notation reify_type_of e := (reify ((fun t (_ : t) => t) _ e)) (only parsing). Axiom Literal : forall {t}, denote t -> Type. Declare Scope foo_scope. Delimit Scope foo_scope with foo. Open Scope foo_scope. Section A. Notation "[ x ]" := (Literal (t:=reify_type_of x) x) (only parsing) : foo_scope. Check [1]. (* Literal 1 : Type *) (* as expected *) Notation "[ x ]" := (Literal x) : foo_scope. Check @Literal nat 1. (* Incorred: gives Literal 1 : Type when it should give [1]. Fixed by #12950 *) Notation "[ x ]" := (Literal (t:=reify_type_of x) x) (only parsing) : foo_scope. Check [1]. (* Incorrect: gives Literal 1 : Type when it should give [1]. This is disputable: #12950 considers that giving an only parsing a previous both-parsing-and-printing notation *) End A. Section B. Notation "[ x ]" := (Literal x) : foo_scope. Check @Literal nat 1. (* [1] : Type *) Fail Check [1]. (* As expected: The command has indeed failed with message: The term "1" has type "Datatypes.nat" while it is expected to have type "denote ?t". *) Notation "[ x ]" := (Literal (t:=reify_type_of x) x) (only parsing) : foo_scope. Check [1]. (* Should succeed, but instead fails with: Error: The term "1" has type "Datatypes.nat" while it is expected to have type "denote ?t". Fixed by #12950, but previous declaration is cancelled by #12950. *) End B. coq-8.20.0/test-suite/output/bug_8206.out000066400000000000000000000004631466560755400200430ustar00rootroot00000000000000File "./output/bug_8206.v", line 11, characters 0-28: The command has indeed failed with message: Signature components for field homework do not match: expected type "forall a b : nat, bug_8206.M.add a b = bug_8206.M.add b a" but found type "nat -> forall b : nat, bug_8206.M.add 0 b = bug_8206.M.add b 0". coq-8.20.0/test-suite/output/bug_8206.v000066400000000000000000000004141466560755400174750ustar00rootroot00000000000000Module Type Sig. Parameter add: nat -> nat -> nat. Axiom homework: forall (a b: nat), add a b = add b a. End Sig. Module Impl. Definition add(a b: nat) := plus a b. Axiom homework: forall (a b: nat), add 0 b = add b 0. End Impl. Fail Module M : Sig := Impl. coq-8.20.0/test-suite/output/bug_9180.out000066400000000000000000000001471466560755400200440ustar00rootroot00000000000000Notation "n .+1" := (S n) : nat_scope (default interpretation) forall x : nat, x.+1 = x.+1 : Prop coq-8.20.0/test-suite/output/bug_9180.v000066400000000000000000000004501466560755400174770ustar00rootroot00000000000000Notation succn := (Datatypes.S). Notation "n .+1" := (succn n) (at level 2, left associativity, format "n .+1") : nat_scope. Locate ".+1". (* Notation *) (* "n .+1" := S n : nat_scope (default interpretation) *) (** so Coq does not apply succn notation *) Check forall x : nat, x.+1 = x.+1. coq-8.20.0/test-suite/output/bug_9370.out000066400000000000000000000002231466560755400200400ustar00rootroot000000000000001 goal ============================ 1 = 1 1 goal ============================ 1 = 1 1 goal ============================ 1 = 1 coq-8.20.0/test-suite/output/bug_9370.v000066400000000000000000000002371466560755400175030ustar00rootroot00000000000000Require Import Reals. Open Scope R_scope. Goal 1/1=1. Proof. field_simplify (1/1). Show. field_simplify. Show. field_simplify. Show. reflexivity. Qed. coq-8.20.0/test-suite/output/bug_9403.out000066400000000000000000000002321466560755400200350ustar00rootroot000000000000001 goal X : tele α, β, γ1, γ2 : X → Prop ============================ accessor α β γ1 → accessor α β (λ.. x : X, γ1 x ∨ γ2 x) coq-8.20.0/test-suite/output/bug_9403.v000066400000000000000000000065111466560755400175010ustar00rootroot00000000000000(* Uselessly long but why not *) From Coq Require Export Utf8. Local Set Universe Polymorphism. Module tele. (** Telescopes *) Inductive tele : Type := | TeleO : tele | TeleS {X} (binder : X → tele) : tele. Arguments TeleS {_} _. (** The telescope version of Coq's function type *) Fixpoint tele_fun (TT : tele) (T : Type) : Type := match TT with | TeleO => T | TeleS b => ∀ x, tele_fun (b x) T end. Notation "TT -t> A" := (tele_fun TT A) (at level 99, A at level 200, right associativity). (** An eliminator for elements of [tele_fun]. We use a [fix] because, for some reason, that makes stuff print nicer in the proofs in iris:bi/lib/telescopes.v *) Definition tele_fold {X Y} {TT : tele} (step : ∀ {A : Type}, (A → Y) → Y) (base : X → Y) : (TT -t> X) → Y := (fix rec {TT} : (TT -t> X) → Y := match TT as TT return (TT -t> X) → Y with | TeleO => λ x : X, base x | TeleS b => λ f, step (λ x, rec (f x)) end) TT. Arguments tele_fold {_ _ !_} _ _ _ /. (** A sigma-like type for an "element" of a telescope, i.e. the data it takes to get a [T] from a [TT -t> T]. *) Inductive tele_arg : tele → Type := | TargO : tele_arg TeleO (* the [x] is the only relevant data here *) | TargS {X} {binder} (x : X) : tele_arg (binder x) → tele_arg (TeleS binder). Definition tele_app {TT : tele} {T} (f : TT -t> T) : tele_arg TT → T := λ a, (fix rec {TT} (a : tele_arg TT) : (TT -t> T) → T := match a in tele_arg TT return (TT -t> T) → T with | TargO => λ t : T, t | TargS x a => λ f, rec a (f x) end) TT a f. Arguments tele_app {!_ _} _ !_ /. Coercion tele_arg : tele >-> Sortclass. Local Coercion tele_app : tele_fun >-> Funclass. (** Operate below [tele_fun]s with argument telescope [TT]. *) Fixpoint tele_bind {U} {TT : tele} : (TT → U) → TT -t> U := match TT as TT return (TT → U) → TT -t> U with | TeleO => λ F, F TargO | @TeleS X b => λ (F : TeleS b → U) (x : X), (* b x -t> U *) tele_bind (λ a, F (TargS x a)) end. Arguments tele_bind {_ !_} _ /. (** Notation-compatible telescope mapping *) (* This adds (tele_app ∘ tele_bind), which is an identity function, around every binder so that, after simplifying, this matches the way we typically write notations involving telescopes. *) Notation "t $ r" := (t r) (at level 65, right associativity, only parsing). Notation "'λ..' x .. y , e" := (tele_app $ tele_bind (λ x, .. (tele_app $ tele_bind (λ y, e)) .. )) (at level 200, x binder, y binder, right associativity, format "'[ ' 'λ..' x .. y ']' , e"). (** Telescopic quantifiers *) Definition texist {TT : tele} (Ψ : TT → Prop) : Prop := tele_fold ex (λ x, x) (tele_bind Ψ). Arguments texist {!_} _ /. Notation "'∃..' x .. y , P" := (texist (λ x, .. (texist (λ y, P)) .. )) (at level 200, x binder, y binder, right associativity, format "∃.. x .. y , P"). End tele. Import tele. (* This is like Iris' accessors, but in Prop. Just to play with telescopes. *) Definition accessor {X : tele} (α β γ : X → Prop) : Prop := ∃.. x, α x ∧ (β x → γ x). (* Working with abstract telescopes. *) Section tests. Context {X : tele}. Implicit Types α β γ : X → Prop. Lemma acc_mono_disj α β γ1 γ2 : accessor α β γ1 → accessor α β (λ.. x, γ1 x ∨ γ2 x). Show. Abort. End tests. coq-8.20.0/test-suite/output/bug_9555.out000066400000000000000000000001121466560755400200420ustar00rootroot00000000000000Module Type F = Funsig (X:S) Sig Parameter T : Type. Parameter a : T. End coq-8.20.0/test-suite/output/bug_9555.v000066400000000000000000000001441466560755400175050ustar00rootroot00000000000000Module Type S. Axiom T : Type. Axiom a : T. End S. Module Type F (X : S) := S. Print Module Type F. coq-8.20.0/test-suite/output/bug_9569.out000066400000000000000000000005521466560755400200570ustar00rootroot000000000000001 goal ============================ exists I : True, I = Logic.I 1 goal ============================ f True False True False (Logic.True /\ Logic.False) 1 goal ============================ [I | I = Logic.I; I = Logic.I] = [I | I = Logic.I; I = Logic.I] 1 goal ============================ [I & I = Logic.I | I = Logic.I; Logic.I = I] coq-8.20.0/test-suite/output/bug_9569.v000066400000000000000000000010421466560755400175100ustar00rootroot00000000000000Goal exists I, I = Logic.I. Show. Abort. Notation f x y p q r := ((forall x, p /\ r) /\ forall y, q /\ r). Goal f True False True False (Logic.True /\ Logic.False). Show. Abort. Notation "[ x | y ; z ; .. ; t ]" := (pair .. (pair (forall x, y) (forall x, z)) .. (forall x, t)). Goal [ I | I = Logic.I ; I = Logic.I ] = [ I | I = Logic.I ; I = Logic.I ]. Show. Abort. Notation "[ x & p | y ; .. ; z ; t ]" := (forall x, p -> y -> .. (forall x, p -> z -> forall x, p -> t) ..). Goal [ I & I = Logic.I | I = Logic.I ; Logic.I = I ]. Show. Abort. coq-8.20.0/test-suite/output/bug_9682.out000066400000000000000000000001601466560755400200460ustar00rootroot00000000000000mmatch 1 + 2 + 3 + 4 + 5 + 6 in nat as x return M (x = x) with | 1 end : unit # : True ## : True coq-8.20.0/test-suite/output/bug_9682.v000066400000000000000000000025451466560755400175150ustar00rootroot00000000000000Declare 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 ##. coq-8.20.0/test-suite/output/clear.out000066400000000000000000000000771466560755400176760ustar00rootroot000000000000001 goal z := 0 : nat ============================ True coq-8.20.0/test-suite/output/clear.v000066400000000000000000000003611466560755400173300ustar00rootroot00000000000000Module Wish11692. (* Support for let-in in clear dependent *) Goal forall x : Prop, let z := 0 in let z' : (fun _ => True) x := I in let y := x in y -> True. Proof. intros x z z' y H. clear dependent x. Show. exact I. Qed. End Wish11692. coq-8.20.0/test-suite/output/coercions_cs.out000066400000000000000000000001421466560755400212520ustar00rootroot00000000000000f foo_nat x : T2 nat : T2 nat f (foo_A nat ?n) x : T2 nat : T2 nat where ?n : [ |- nat] coq-8.20.0/test-suite/output/coercions_cs.v000066400000000000000000000010351466560755400207120ustar00rootroot00000000000000Set Warnings "-uniform-inheritance". Set Printing All. Module CS. Structure foo := { sort :> Type; a : sort }. Axiom T1 : Type -> Type. Axiom T2 : Type -> Type. Axiom x : T1 nat. Module T1. Axiom f : forall A : foo, T1 (sort A) -> T2 nat. #[canonical] Definition foo_nat := {| sort := nat; a := 1 |}. Coercion f : T1 >-> T2. Check (x : T2 _). End T1. Module T2. Axiom f : forall A : foo, T1 (sort A) -> T2 nat. #[canonical] Definition foo_A A x := {| sort := A; a := x |}. Coercion f : T1 >-> T2. Check (f _ x : T2 _). End T2. End CS. coq-8.20.0/test-suite/output/coercions_nonuniform.out000066400000000000000000000005231466560755400230420ustar00rootroot00000000000000File "./output/coercions_nonuniform.v", line 22, characters 0-21: Warning: f does not respect the uniform inheritance condition. [uniform-inheritance,coercions,default] File "./output/coercions_nonuniform.v", line 55, characters 0-17: Warning: f' does not respect the uniform inheritance condition. [uniform-inheritance,coercions,default] coq-8.20.0/test-suite/output/coercions_nonuniform.v000066400000000000000000000027021466560755400225010ustar00rootroot00000000000000(* Test the nonuniform attribute to silence warnings on coercions not satisfying the non uniform inheritance condition. *) Module Test0. Parameter C : nat -> bool -> Type. Parameter D : Type. Parameter f : forall (n : nat) (b : bool), C n b -> D. (* uniform inheritance satisfied, no warning *) Coercion f : C >-> D. End Test0. Module Test1. Parameter C : nat -> bool -> Type. Parameter D : Type. Parameter f : forall (b : bool) (n : nat), C n b -> D. (* uniform inheritance not satisfied, warning *) Coercion f : C >-> D. End Test1. Module Test2. Parameter C : nat -> bool -> Type. Parameter D : Type. Parameter f : forall (b : bool) (n : nat), C n b -> D. (* uniform inheritance not satisfied but attribute, no warning *) #[warning="-uniform-inheritance"] Coercion f : C >-> D. End Test2. Module Test3. Parameter C : nat -> bool -> Type. Parameter D : Type. Parameter f : forall (n : nat) (b : bool), C n b -> D. (* uniform inheritance satisfied, no warning *) Coercion f' := f. End Test3. Module Test4. Parameter C : nat -> bool -> Type. Parameter D : Type. Parameter f : forall (b : bool) (n : nat), C n b -> D. (* uniform inheritance not satisfied, warning *) Coercion f' := f. End Test4. Module Test5. Parameter C : nat -> bool -> Type. Parameter D : Type. Parameter f : forall (b : bool) (n : nat), C n b -> D. (* uniform inheritance not satisfied but attribute, no warning *) #[warning="-uniform-inheritance"] Coercion f' := f. End Test5. coq-8.20.0/test-suite/output/coercions_tc.out000066400000000000000000000002661466560755400212620ustar00rootroot00000000000000f nat (pair_foo nat bool nat_foo bool_foo) x : T2 nat : T2 nat f ?T ?f x : T2 ?T : T2 ?T where ?T : [ |- Type] ?f : [ |- foo ?T] f bool bool_foo x : T2 bool : T2 bool coq-8.20.0/test-suite/output/coercions_tc.v000066400000000000000000000012501466560755400207120ustar00rootroot00000000000000Set Warnings "-uniform-inheritance". Set Printing All. Module TC. Class foo (A : Type) := { a : A }. #[local] Hint Mode foo + : typeclass_instances. #[local] Instance bool_foo : foo bool := {| a := true |}. #[local] Instance nat_foo : foo nat := {| a := 1 |}. #[local] Instance pair_foo A B : foo A -> foo B -> foo (A * B) := fun x y => {| a := (a,a) |}. Axiom T1 : Type -> Type. Axiom T2 : Type -> Type. Axiom x : T1 nat. Module T1. Axiom f : forall A, foo (A * bool) -> T1 A -> T2 nat. Coercion f : T1 >-> T2. Check (x : T2 _). End T1. Module T2. Axiom f : forall A, foo A -> T1 nat -> T2 A. Coercion f : T1 >-> T2. Check (x : T2 _). Check (x : T2 bool). End T2. End TC. coq-8.20.0/test-suite/output/deprecation_definition.out000066400000000000000000000031211466560755400233060ustar00rootroot00000000000000File "./output/deprecation_definition.v", line 27, characters 6-11: Warning: Reference depr1 is deprecated. deprecable [deprecated-reference,deprecated,default] depr1 : True File "./output/deprecation_definition.v", line 28, characters 6-11: Warning: Reference depr2 is deprecated. deprecable [deprecated-reference,deprecated,default] depr2 : True File "./output/deprecation_definition.v", line 29, characters 6-11: Warning: Reference depr3 is deprecated. deprecable [deprecated-reference,deprecated,default] depr3 : True File "./output/deprecation_definition.v", line 30, characters 6-11: Warning: Reference depr4 is deprecated. deprecable [deprecated-reference,deprecated,default] depr4 : Prop File "./output/deprecation_definition.v", line 31, characters 6-11: Warning: Reference depr5 is deprecated. deprecable [deprecated-reference,deprecated,default] depr5 : Prop File "./output/deprecation_definition.v", line 32, characters 6-11: Warning: Reference depr6 is deprecated. deprecable [deprecated-reference,deprecated,default] depr6 : nat -> nat File "./output/deprecation_definition.v", line 38, characters 6-11: Warning: Reference depr7 is deprecated. deprecable [deprecated-reference,deprecated,default] File "./output/deprecation_definition.v", line 38, characters 6-11: Warning: be careful [warn-reference-be-careful-careful,careful,be-careful,warn-reference,user-warn,default] File "./output/deprecation_definition.v", line 38, characters 6-11: Warning: also about bla [warn-reference-careful-careful-bla,careful-bla,careful,warn-reference,user-warn,default] depr7 : Prop coq-8.20.0/test-suite/output/deprecation_definition.v000066400000000000000000000013351466560755400227510ustar00rootroot00000000000000Require Import Coq.Program.Tactics. #[deprecated(note="deprecable")] Lemma depr1 : True. Proof. exact I. Qed. #[deprecated(note="deprecable")] Theorem depr2 : True. Proof. exact I. Qed. #[deprecated(note="deprecable")] Axiom depr3 : True. #[deprecated(note="deprecable")] Definition depr4 := True. #[deprecated(note="deprecable")] Program Definition depr5 := True. #[deprecated(note="deprecable")] Fixpoint depr6 n := match n with S n => depr6 n | 0 => 1 end. Check depr1. Check depr2. Check depr3. Check depr4. Check depr5. Check depr6. #[deprecated(note="deprecable"), warn(note="be careful", cats="careful, be careful"), warn(note="also about bla", cats="careful, careful bla")] Definition depr7 := True. Check depr7. coq-8.20.0/test-suite/output/detype_cast.out000066400000000000000000000003051466560755400211060ustar00rootroot00000000000000(Nat.add : forall (_ : nat) (_ : nat), nat) O O : nat (Nat.add O : forall _ : nat, nat) O : nat (?n O : forall _ : nat, nat) O : nat where ?n : [ |- forall (_ : nat) (_ : nat), nat] coq-8.20.0/test-suite/output/detype_cast.v000066400000000000000000000001631466560755400205460ustar00rootroot00000000000000Set Printing All. Check (plus : nat -> nat -> nat) O O. Check (plus O : nat -> nat) O. Check (_ O : nat -> nat) O. coq-8.20.0/test-suite/output/extra_dep.out000066400000000000000000000004161466560755400205600ustar00rootroot00000000000000File "./output/extra_dep.v", line 1, characters 0-55: The command has indeed failed with message: No LoadPath found for NonExistent. File "./output/extra_dep.v", line 2, characters 0-49: The command has indeed failed with message: File not_there not found in TestSuite. coq-8.20.0/test-suite/output/extra_dep.v000066400000000000000000000001521466560755400202130ustar00rootroot00000000000000Fail From NonExistent Extra Dependency "extra_dep.txt". Fail From TestSuite Extra Dependency "not_there". coq-8.20.0/test-suite/output/extraction_projection.out000066400000000000000000000123401466560755400232200ustar00rootroot00000000000000 type unit0 = | Tt type bool = | True | False type non_prim_record_two_fields = { non_prim_proj1_of_2 : bool; non_prim_proj2_of_2 : bool } type non_prim_record_one_field = bool (* singleton inductive, whose constructor was Build_non_prim_record_one_field *) (** val d11 : non_prim_record_two_fields -> bool **) let d11 x = x.non_prim_proj1_of_2 (** val d12 : (unit0 -> non_prim_record_two_fields) -> bool **) let d12 x = (x Tt).non_prim_proj1_of_2 (** val e11 : non_prim_record_one_field -> bool **) let e11 x = x (** val e12 : (unit0 -> non_prim_record_one_field) -> bool **) let e12 x = x Tt type prim_record_two_fields = { prim_proj1_of_2 : bool; prim_proj2_of_2 : bool } type prim_record_one_field = bool (* singleton inductive, whose constructor was Build_prim_record_one_field *) (** val d21 : prim_record_two_fields -> bool **) let d21 x = x.prim_proj1_of_2 (** val d22 : (unit0 -> prim_record_two_fields) -> bool **) let d22 x = (x Tt).prim_proj1_of_2 (** val e21 : prim_record_one_field -> bool **) let e21 x = x (** val e22 : (unit0 -> prim_record_one_field) -> bool **) let e22 x = x Tt type unit0 = | Tt type bool = | True | False module A = struct type non_prim_record_two_fields = { non_prim_proj1_of_2 : bool; non_prim_proj2_of_2 : bool } (** val non_prim_proj1_of_2 : non_prim_record_two_fields -> bool **) let non_prim_proj1_of_2 n = n.non_prim_proj1_of_2 type non_prim_record_one_field = bool (* singleton inductive, whose constructor was Build_non_prim_record_one_field *) (** val non_prim_proj1_of_1 : non_prim_record_one_field -> bool **) let non_prim_proj1_of_1 n = n (** val d11 : non_prim_record_two_fields -> bool **) let d11 x = x.non_prim_proj1_of_2 (** val d12 : (unit0 -> non_prim_record_two_fields) -> bool **) let d12 x = (x Tt).non_prim_proj1_of_2 (** val e11 : non_prim_record_one_field -> bool **) let e11 x = x (** val e12 : (unit0 -> non_prim_record_one_field) -> bool **) let e12 x = x Tt type prim_record_two_fields = { prim_proj1_of_2 : bool; prim_proj2_of_2 : bool } type prim_record_one_field = bool (* singleton inductive, whose constructor was Build_prim_record_one_field *) (** val d21 : prim_record_two_fields -> bool **) let d21 x = x.prim_proj1_of_2 (** val d22 : (unit0 -> prim_record_two_fields) -> bool **) let d22 x = (x Tt).prim_proj1_of_2 (** val e21 : prim_record_one_field -> bool **) let e21 x = x (** val e22 : (unit0 -> prim_record_one_field) -> bool **) let e22 x = x Tt end type unit0 = | Tt type bool = | True | False module type Nop = sig end module Empty = struct end module M = functor (X:Nop) -> struct type non_prim_record_two_fields = { non_prim_proj1_of_2 : bool; non_prim_proj2_of_2 : bool } (** val non_prim_proj1_of_2 : non_prim_record_two_fields -> bool **) let non_prim_proj1_of_2 n = n.non_prim_proj1_of_2 (** val non_prim_proj2_of_2 : non_prim_record_two_fields -> bool **) let non_prim_proj2_of_2 n = n.non_prim_proj2_of_2 type non_prim_record_one_field = bool (* singleton inductive, whose constructor was Build_non_prim_record_one_field *) (** val non_prim_proj1_of_1 : non_prim_record_one_field -> bool **) let non_prim_proj1_of_1 n = n type non_prim_record_one_field_unused = bool (* singleton inductive, whose constructor was Build_non_prim_record_one_field_unused *) (** val non_prim_proj1_of_1_unused : non_prim_record_one_field_unused -> bool **) let non_prim_proj1_of_1_unused n = n (** val d11 : non_prim_record_two_fields -> bool **) let d11 x = x.non_prim_proj1_of_2 (** val d12 : (unit0 -> non_prim_record_two_fields) -> bool **) let d12 x = (x Tt).non_prim_proj1_of_2 (** val e11 : non_prim_record_one_field -> bool **) let e11 x = x (** val e12 : (unit0 -> non_prim_record_one_field) -> bool **) let e12 x = x Tt type prim_record_two_fields = { prim_proj1_of_2 : bool; prim_proj2_of_2 : bool } (** val prim_proj1_of_2 : prim_record_two_fields -> bool **) let prim_proj1_of_2 p = p.prim_proj1_of_2 (** val prim_proj2_of_2 : prim_record_two_fields -> bool **) let prim_proj2_of_2 p = p.prim_proj2_of_2 type prim_record_one_field = bool (* singleton inductive, whose constructor was Build_prim_record_one_field *) (** val prim_proj1_of_1 : prim_record_one_field -> bool **) let prim_proj1_of_1 p = p type prim_record_one_field_unused = bool (* singleton inductive, whose constructor was Build_prim_record_one_field_unused *) (** val prim_proj1_of_1_unused : prim_record_one_field_unused -> bool **) let prim_proj1_of_1_unused p = p (** val d21 : prim_record_two_fields -> bool **) let d21 x = x.prim_proj1_of_2 (** val d22 : (unit0 -> prim_record_two_fields) -> bool **) let d22 x = (x Tt).prim_proj1_of_2 (** val e21 : prim_record_one_field -> bool **) let e21 x = x (** val e22 : (unit0 -> prim_record_one_field) -> bool **) let e22 x = x Tt end module N = M(Empty) coq-8.20.0/test-suite/output/extraction_projection.v000066400000000000000000000061071466560755400226620ustar00rootroot00000000000000(** Miscellaneous tests on the ocaml extraction *) Require Import Extraction. Extraction Language OCaml. (** Extraction at toplevel *) Record non_prim_record_two_fields := {non_prim_proj1_of_2:bool;non_prim_proj2_of_2:bool}. Record non_prim_record_one_field := {non_prim_proj1_of_1:bool}. Record non_prim_record_one_field_unused := {non_prim_proj1_of_1_unused:bool}. Definition d11 x := x.(non_prim_proj1_of_2). Definition d12 x := (x tt).(non_prim_proj1_of_2). Definition e11 x := x.(non_prim_proj1_of_1). Definition e12 x := (x tt).(non_prim_proj1_of_1). Set Primitive Projections. Record prim_record_two_fields := {prim_proj1_of_2:bool;prim_proj2_of_2:bool}. Record prim_record_one_field := {prim_proj1_of_1:bool}. Record prim_record_one_field_unused := {prim_proj1_of_1_unused:bool}. Unset Primitive Projections. Definition d21 x := x.(prim_proj1_of_2). Definition d22 x := (x tt).(prim_proj1_of_2). Definition e21 x := x.(prim_proj1_of_1). Definition e22 x := (x tt).(prim_proj1_of_1). Recursive Extraction d11 d12 d21 d22 e11 e12 e21 e22. (** Extraction in module *) Module A. Record non_prim_record_two_fields := {non_prim_proj1_of_2:bool;non_prim_proj2_of_2:bool}. Record non_prim_record_one_field := {non_prim_proj1_of_1:bool}. Record non_prim_record_one_field_unused := {non_prim_proj1_of_1_unused:bool}. Definition d11 x := x.(non_prim_proj1_of_2). Definition d12 x := (x tt).(non_prim_proj1_of_2). Definition e11 x := x.(non_prim_proj1_of_1). Definition e12 x := (x tt).(non_prim_proj1_of_1). Set Primitive Projections. Record prim_record_two_fields := {prim_proj1_of_2:bool;prim_proj2_of_2:bool}. Record prim_record_one_field := {prim_proj1_of_1:bool}. Record prim_record_one_field_unused := {prim_proj1_of_1_unused:bool}. Unset Primitive Projections. Definition d21 x := x.(prim_proj1_of_2). Definition d22 x := (x tt).(prim_proj1_of_2). Definition e21 x := x.(prim_proj1_of_1). Definition e22 x := (x tt).(prim_proj1_of_1). End A. Recursive Extraction A.d11 A.d12 A.d21 A.d22 A.e11 A.e12 A.e21 A.e22. (* Inside a functor *) Module Type Nop. End Nop. Module Empty. End Empty. Module M (X : Nop). Record non_prim_record_two_fields := {non_prim_proj1_of_2:bool;non_prim_proj2_of_2:bool}. Record non_prim_record_one_field := {non_prim_proj1_of_1:bool}. Record non_prim_record_one_field_unused := {non_prim_proj1_of_1_unused:bool}. Definition d11 x := x.(non_prim_proj1_of_2). Definition d12 x := (x tt).(non_prim_proj1_of_2). Definition e11 x := x.(non_prim_proj1_of_1). Definition e12 x := (x tt).(non_prim_proj1_of_1). Set Primitive Projections. Record prim_record_two_fields := {prim_proj1_of_2:bool;prim_proj2_of_2:bool}. Record prim_record_one_field := {prim_proj1_of_1:bool}. Record prim_record_one_field_unused := {prim_proj1_of_1_unused:bool}. Unset Primitive Projections. Definition d21 x := x.(prim_proj1_of_2). Definition d22 x := (x tt).(prim_proj1_of_2). Definition e21 x := x.(prim_proj1_of_1). Definition e22 x := (x tt).(prim_proj1_of_1). End M. Module N := M Empty. Recursive Extraction N.d11 N.d12 N.d21 N.d22 N.e11 N.e12 N.e21 N.e22. coq-8.20.0/test-suite/output/goal_output.out000066400000000000000000000020771466560755400211540ustar00rootroot00000000000000Nat.t = nat : Set Nat.t = nat : Set 2 goals ============================ True goal 2 is: True 2 goals, goal 1 (?Goal) ============================ True goal 2 (?Goal0) is: True 1 goal ============================ True 1 goal (?Goal0) ============================ True 1 goal (?Goal0) ============================ True *** Unfocused goals: goal 2 (?Goal1) is: True goal 3 (?Goal) is: True 1 goal ============================ True *** Unfocused goals: goal 2 is: True goal 3 is: True This subproof is complete, but there are some unfocused goals. Focus next goal with bullet -. 2 goals goal 1 is: True goal 2 is: True This subproof is complete, but there are some unfocused goals. Focus next goal with bullet -. 2 goals goal 1 (?Goal0) is: True goal 2 (?Goal) is: True This subproof is complete, but there are some unfocused goals. Focus next goal with bullet -. 1 goal goal 1 is: True This subproof is complete, but there are some unfocused goals. Focus next goal with bullet -. 1 goal goal 1 (?Goal) is: True coq-8.20.0/test-suite/output/goal_output.v000066400000000000000000000010751466560755400206070ustar00rootroot00000000000000(* From - https://coq.inria.fr/bugs/show_bug.cgi?id=5529 - https://coq.inria.fr/bugs/show_bug.cgi?id=5537 *) Print Nat.t. Timeout 1 Print Nat.t. 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. coq-8.20.0/test-suite/output/idtac.out000066400000000000000000000001251466560755400176660ustar00rootroot00000000000000"foo" True foo 3 foo 2 < True False Prop > < True False Prop > < > < > << 1 2 3 >> coq-8.20.0/test-suite/output/idtac.v000066400000000000000000000017451466560755400173350ustar00rootroot00000000000000(* Printing all kinds of Ltac generic arguments *) Tactic Notation "myidtac" string(v) := idtac v. Goal True. myidtac "foo". Abort. Tactic Notation "myidtac2" ref(c) := idtac c. Goal True. myidtac2 True. Abort. Tactic Notation "myidtac3" preident(s) := idtac s. Goal True. myidtac3 foo. Abort. Tactic Notation "myidtac4" int_or_var(n) := idtac n. Goal True. myidtac4 3. Abort. Tactic Notation "myidtac5" ident(id) := idtac id. Goal True. myidtac5 foo. Abort. (* Checking non focussing of idtac for integers *) Goal True/\True. split. all:let c:=numgoals in idtac c. Abort. (* Checking printing of lists and its focussing *) Tactic Notation "myidtac6" constr_list(l) := idtac "<" l ">". Goal True/\True. split. all:myidtac6 True False Prop. (* An empty list is focussing because of interp_genarg of a constr *) (* even if it is not focussing on printing *) all:myidtac6. Abort. Tactic Notation "myidtac7" int_list(l) := idtac "<<" l ">>". Goal True/\True. split. all:myidtac7 1 2 3. Abort. coq-8.20.0/test-suite/output/inference.out000066400000000000000000000007041466560755400205430ustar00rootroot00000000000000P = fun e : option L => match e with | Some cl => Some cl | None => None end : option L -> option L Arguments P e fun n : nat => let y : T n := A n in ?t ?x : T n : forall n : nat, T n where ?t : [n : nat y := A n : T n |- ?T -> T n] ?x : [n : nat y := A n : T n |- ?T] fun n : nat => ?t ?x : T n : forall n : nat, T n where ?t : [n : nat |- ?T -> T n] ?x : [n : nat |- ?T] coq-8.20.0/test-suite/output/inference.v000066400000000000000000000013271466560755400202030ustar00rootroot00000000000000(* Check that types are not uselessly unfolded *) (* Check here that P returns something of type "option L" and not "option (list nat)" *) Definition L := list nat. Definition P (e:option L) := match e with | None => None | Some cl => Some cl end. Print P. (* Check that the heuristic to solve constraints is not artificially dependent on the presence of a let-in, and in particular that the second [_] below is not inferred to be n, as if obtained by first-order unification with [T n] of the conclusion [T _] of the type of the first [_]. *) (* Note: exact numbers of evars are not important... *) Inductive T (n:nat) := A : T n. Check fun n (y:=A n:T n) => _ _ : T n. Check fun n => _ _ : T n. coq-8.20.0/test-suite/output/injection.out000066400000000000000000000003701466560755400205660ustar00rootroot00000000000000File "./output/injection.v", line 4, characters 39-42: The command has indeed failed with message: Unexpected pattern. File "./output/injection.v", line 5, characters 35-42: The command has indeed failed with message: Unexpected injection pattern. coq-8.20.0/test-suite/output/injection.v000066400000000000000000000003231466560755400202220ustar00rootroot00000000000000(* Test error messages *) Goal forall x, (x,0) = (0, S x) -> x = 0. Fail intros x H; injection H as [= H'] H''. Fail intros x H; injection H as H' [= H'']. intros x H; injection H as [= H' H'']. exact H'. Qed. coq-8.20.0/test-suite/output/interleave_options_bad_order.out000066400000000000000000000002331466560755400245140ustar00rootroot00000000000000While loading initial state: Warning: There is no flag or option with this name: "Extraction Optimize". [unknown-option,default] Extraction Optimize is on coq-8.20.0/test-suite/output/interleave_options_bad_order.v000066400000000000000000000001441466560755400241530ustar00rootroot00000000000000(* coq-prog-args: ("-unset" "Extraction Optimize" "-ri" "Extraction") *) Test Extraction Optimize. coq-8.20.0/test-suite/output/interleave_options_correct_order.out000066400000000000000000000000331466560755400254250ustar00rootroot00000000000000Extraction Optimize is off coq-8.20.0/test-suite/output/interleave_options_correct_order.v000066400000000000000000000001441466560755400250660ustar00rootroot00000000000000(* coq-prog-args: ("-ri" "Extraction" "-unset" "Extraction Optimize") *) Test Extraction Optimize. coq-8.20.0/test-suite/output/lexical_convention_in_doc.out000066400000000000000000000005511466560755400240030ustar00rootroot00000000000000not (not True) : Prop not True : Prop not (not True) : Prop not (not True) : Prop not False : Prop (fun x : Prop => not (not x)) o : Prop File "./output/lexical_convention_in_doc.v", line 50, characters 12-15: The command has indeed failed with message: The reference _ho was not found in the current environment. True : Prop coq-8.20.0/test-suite/output/lexical_convention_in_doc.v000066400000000000000000000030111466560755400234330ustar00rootroot00000000000000Set Printing All. Set Warnings "-prefix-incompatible-level". (* if ``~`` and ``~~`` are both defined as tokens, the inputs ``~ ~`` and ``~~`` generate different tokens *) Section TestLexer0. Local Notation "~" := not. Local Notation "~~" := not. Check ~ ~ True. Check ~~ True. End TestLexer0. (* whereas if ``~~`` is not defined, then the two inputs are equivalent *) Section TestLexer1. Local Notation "~" := not. Set Printing All. Check ~ ~ True. Check ~~ True. End TestLexer1. (* Also, if ``~`` and ``~_h`` are both defined as tokens, the input ``~_ho`` is interpreted as ``~ _ho`` rather than ``~_h o`` so as not to cut the identifier-like subsequence ``ho``. *) Section TestLexer2. Local Notation "~" := not. Local Notation "~_h" := (fun x => not (not x)). Local Notation "'_ho'" := False. Let o := True. Check ~_ho. Check ~_h o. End TestLexer2. (* Contrastingly, if only ``~_h`` is defined as a token, then ``~_ho`` is an error because no token can be found that includes the whole subsequence ``ho`` without cutting it in the middle. *) Section TestLexer3. Local Notation "~_h" := (fun x => not (not x)). Fail Check ~_ho. End TestLexer3. (* Finally, if all of ``~``, ``~_h`` and ``~_ho`` are defined as tokens, the input ``~_ho`` is interpreted using the longest match rule, i.e. as the token ``~_ho``. *) Section TestLexer4. Local Notation "~" := not. Local Notation "~_h" := (fun x => not (not x)). Local Notation "'_ho'" := False. Local Notation "~_ho" := True. Check ~_ho. End TestLexer4. coq-8.20.0/test-suite/output/library_attributes.out000066400000000000000000000012451466560755400225200ustar00rootroot00000000000000File "./output/library_attributes.v", line 4, characters 16-21: The command has indeed failed with message: This command does not support this attribute: local. [unsupported-attributes,parsing,default] File "./output/library_attributes.v", line 7, characters 0-70: The command has indeed failed with message: A library attribute should be at toplevel of the library. File "./output/library_attributes.v", line 11, characters 0-69: The command has indeed failed with message: A library attribute should be at toplevel of the library. File "./output/library_attributes.v", line 14, characters 0-71: The command has indeed failed with message: Library file is already deprecated. coq-8.20.0/test-suite/output/library_attributes.v000066400000000000000000000010501466560755400221500ustar00rootroot00000000000000Attributes deprecated(note="This library is useless.", since="XX YY"). (* unsupported attributes *) Fail Attributes local. Section Sec. Fail Attributes deprecated(note="No library attributes in sections."). End Sec. Module Mod. Fail Attributes deprecated(note="No library attributes in modules."). End Mod. Fail Attributes deprecated(note="This library is already deprecated."). Attributes warn(note="This library is dangerous.", cats="dangerous library"). Attributes warn(note="This library is tricky.", cats="dangerous library, tricky library"). coq-8.20.0/test-suite/output/library_attributes_require.out000066400000000000000000000012771466560755400242610ustar00rootroot00000000000000File "./output/library_attributes_require.v", line 1, characters 0-37: Warning: Library File TestSuite.deprecated_library is deprecated since XX YY. This library is useless. [deprecated-library-file-since-XX-YY,deprecated-since-XX-YY,deprecated-library-file,deprecated,default] File "./output/library_attributes_require.v", line 1, characters 0-37: Warning: This library is dangerous. [warn-library-file-dangerous-library,dangerous-library,warn-library-file,user-warn,default] File "./output/library_attributes_require.v", line 1, characters 0-37: Warning: This library is tricky. [warn-library-file-dangerous-library-tricky-library,tricky-library,dangerous-library,warn-library-file,user-warn,default] coq-8.20.0/test-suite/output/library_attributes_require.v000066400000000000000000000000461466560755400237100ustar00rootroot00000000000000Require TestSuite.deprecated_library. coq-8.20.0/test-suite/output/library_attributes_require_transitive.out000066400000000000000000000013401466560755400265200ustar00rootroot00000000000000File "./output/library_attributes_require_transitive.v", line 5, characters 0-37: Warning: Library File TestSuite.deprecated_library is deprecated since XX YY. This library is useless. [deprecated-library-file-since-XX-YY,deprecated-since-XX-YY,deprecated-library-file,deprecated,default] File "./output/library_attributes_require_transitive.v", line 5, characters 0-37: Warning: This library is dangerous. [warn-library-file-dangerous-library,dangerous-library,warn-library-file,user-warn,default] File "./output/library_attributes_require_transitive.v", line 5, characters 0-37: Warning: This library is tricky. [warn-library-file-dangerous-library-tricky-library,tricky-library,dangerous-library,warn-library-file,user-warn,default] coq-8.20.0/test-suite/output/library_attributes_require_transitive.v000066400000000000000000000004421466560755400261600ustar00rootroot00000000000000(* check that file deprecations are only printed on direct requirement *) Require TestSuite.requires_deprecated_library. (* but still printed on direct requirement even if the Require doesn't actually do anything (because file is already loaded) *) Require TestSuite.deprecated_library. coq-8.20.0/test-suite/output/library_attributes_require_transitive_2.out000066400000000000000000000014501466560755400267430ustar00rootroot00000000000000File "./output/library_attributes_require_transitive_2.v", line 5, characters 0-46: Warning: Library File (transitively required) TestSuite.deprecated_library is deprecated since XX YY. This library is useless. [deprecated-transitive-library-file-since-XX-YY,deprecated-since-XX-YY,deprecated-transitive-library-file,deprecated] File "./output/library_attributes_require_transitive_2.v", line 5, characters 0-46: Warning: This library is dangerous. [warn-transitive-library-file-dangerous-library,dangerous-library,warn-transitive-library-file,user-warn] File "./output/library_attributes_require_transitive_2.v", line 5, characters 0-46: Warning: This library is tricky. [warn-transitive-library-file-dangerous-library-tricky-library,tricky-library,dangerous-library,warn-transitive-library-file,user-warn] coq-8.20.0/test-suite/output/library_attributes_require_transitive_2.v000066400000000000000000000004131466560755400263770ustar00rootroot00000000000000(* We have the second warning "deprecated-transitive-library-file" that always triggers (even on transitive requires) *) Set Warnings "deprecated-transitive-library-file". Set Warnings "warn-transitive-library-file". Require TestSuite.requires_deprecated_library. coq-8.20.0/test-suite/output/load/000077500000000000000000000000001466560755400167725ustar00rootroot00000000000000coq-8.20.0/test-suite/output/load/Load_noproof.v000066400000000000000000000000231466560755400215750ustar00rootroot00000000000000Definition f := 2. coq-8.20.0/test-suite/output/load/Load_openproof.v000066400000000000000000000000201466560755400221170ustar00rootroot00000000000000Lemma k : True. coq-8.20.0/test-suite/output/load/Load_proof.v000066400000000000000000000000451466560755400212440ustar00rootroot00000000000000Lemma u : True. Proof. exact I. Qed. coq-8.20.0/test-suite/output/locate.out000066400000000000000000000011421466560755400200510ustar00rootroot00000000000000Notation "b1 && b2" := (if b1 then b2 else false) (default interpretation) Notation "x && y" := (andb x y) : bool_scope Notation "'U' t" := (S t) (default interpretation) Notation "'_' t" := (S t) (default interpretation) Notation "( x , y , .. , z )" := (pair .. (pair x y) .. z) : core_scope (default interpretation) Notation "( x , y , .. , z )" := (pair .. (pair x y) .. z) : core_scope (default interpretation) Notation "( x , y , .. , z )" := (pair .. (pair x y) .. z) : core_scope (default interpretation) Notation "( x , y , .. , z )" := (pair .. (pair x y) .. z) : core_scope (default interpretation) coq-8.20.0/test-suite/output/locate.v000066400000000000000000000007201466560755400175100ustar00rootroot00000000000000Set Printing Width 400. Notation "b1 && b2" := (if b1 then b2 else false). Locate "&&". Module M. Notation "'U' t" := (S t) (at level 0). Notation "'_' t" := (S t) (at level 0). Locate "U". (* was wrongly returning also "'_' t" *) Locate "_". End M. Module N. (* Was not working at some time *) Locate "( t , u , .. , v )". (* Was working though *) Locate "( _ , _ , .. , _ )". (* We also support this *) Locate "( t , u )". Locate "( t , u , v )". End N. coq-8.20.0/test-suite/output/ltac.out000066400000000000000000000040331466560755400175270ustar00rootroot00000000000000File "./output/ltac.v", line 8, characters 13-31: The command has indeed failed with message: Ltac variable y depends on pattern variable name z which is not bound in current context. Ltac f x y z := symmetry in x, y; auto with z; auto; intros; clearbody x; generalize dependent z File "./output/ltac.v", line 38, characters 5-9: The command has indeed failed with message: The term "I" has type "True" while it is expected to have type "False". In nested Ltac calls to "g1" and "refine (uconstr)", last call failed. File "./output/ltac.v", line 39, characters 5-9: The command has indeed failed with message: The term "I" has type "True" while it is expected to have type "False". In nested Ltac calls to "f1 (constr)" and "refine (uconstr)", last call failed. File "./output/ltac.v", line 40, characters 5-9: The command has indeed failed with message: The term "I" has type "True" while it is expected to have type "False". In nested Ltac calls to "g2 (constr)", "g1" and "refine (uconstr)", last call failed. File "./output/ltac.v", line 41, characters 5-9: The command has indeed failed with message: The term "I" has type "True" while it is expected to have type "False". In nested Ltac calls to "f2", "f1 (constr)" and "refine (uconstr)", last call failed. File "./output/ltac.v", line 46, characters 5-8: The command has indeed failed with message: No primitive equality found. In nested Ltac calls to "h" and "injection (destruction_arg)", last call failed. File "./output/ltac.v", line 48, characters 5-8: The command has indeed failed with message: No primitive equality found. In nested Ltac calls to "h" and "injection (destruction_arg)", last call failed. Hx nat nat 0 0 Ltac foo := let x := intros in let y := intros -> in let v := constr:(nil) in let w := () in let z := 1 in pose v 2 goals n : nat ============================ (fix a (n0 : nat) : nat := match n0 with | 0 => 0 | S n1 => a n1 end) n = n goal 2 is: forall a : nat, a = 0 coq-8.20.0/test-suite/output/ltac.v000066400000000000000000000033041466560755400171650ustar00rootroot00000000000000Set Ltac Backtrace. (* This used to refer to b instead of z sometimes between 8.4 and 8.5beta3 *) Goal True. Fail let T := constr:((fun a b : nat => a+b) 1 1) in lazymatch T with | (fun x z => ?y) 1 1 => pose ((fun x _ => y) 1 1) end. Abort. (* This should not raise a warning (see #4317) *) Goal True. assert (H:= eq_refl ((fun x => x) 1)). let HT := type of H in lazymatch goal with | H1 : HT |- _ => idtac end. Abort. Ltac f x y z := symmetry in x, y; auto with z; auto; intros; clearbody x; generalize dependent z. Print Ltac f. (* Error messages *) Ltac g1 x := refine x. Tactic Notation "g2" constr(x) := g1 x. Tactic Notation "f1" constr(x) := refine x. Ltac f2 x := f1 x. Goal False. Fail g1 I. Fail f1 I. Fail g2 I. Fail f2 I. Abort. Ltac h x := injection x. Goal True -> False. Fail h I. intro H. Fail h H. Abort. (* Check printing of the "var" argument "Hx" *) Ltac m H := idtac H; exact H. Goal True. let a:=constr:(let Hx := 0 in ltac:(m Hx)) in idtac. Abort. (* Check consistency of interpretation scopes (#4398) *) Goal nat*(0*0=0) -> nat*(0*0=0). intro. match goal with H: ?x*?y |- _ => idtac x end. match goal with |- ?x*?y => idtac x end. match goal with H: context [?x*?y] |- _ => idtac x end. match goal with |- context [?x*?y] => idtac x end. Abort. (* Check printing of let in Ltac and Tactic Notation *) Ltac foo := let x := intros in let y := intros -> in let v := constr:(@ nil True) in let w := () in let z := 1 in pose v. Print Ltac foo. (* Ltac renaming was not applied to "fix" and "cofix" *) Goal forall a, a = 0. match goal with |- (forall x, x = _) => assert (forall n, (fix x n := match n with O => O | S n => x n end) n = n) end. intro. Show. Abort. coq-8.20.0/test-suite/output/ltac2_abstract.out000066400000000000000000000036351466560755400215030ustar00rootroot00000000000000File "./output/ltac2_abstract.v", line 20, characters 27-28: The command has indeed failed with message: This expression has type int but an expression was expected of type M.t - : M.t = File "./output/ltac2_abstract.v", line 28, characters 27-28: The command has indeed failed with message: This expression has type int but an expression was expected of type t - : int = 2 Ltac2 foo : t -> t foo := fun x => Int.add x 1 Ltac2 three : t three := 3 - : t = File "./output/ltac2_abstract.v", line 47, characters 18-21: The command has indeed failed with message: Unbound constructor M.A File "./output/ltac2_abstract.v", line 49, characters 40-43: The command has indeed failed with message: Unbound constructor M.A - : M.t = - : bool = false Ltac2 M.a : M.t M.a := Ltac2 M.is_b : M.t -> bool M.is_b := fun x => match x with end Ltac2 M.get_b : int -> M.t -> int M.get_b := fun def x => match x with | => x | _ => def end - : int M.t = File "./output/ltac2_abstract.v", line 73, characters 20-21: The command has indeed failed with message: p is not a projection File "./output/ltac2_abstract.v", line 75, characters 30-31: The command has indeed failed with message: p is not a projection - : int t = - : int = 42 File "./output/ltac2_abstract.v", line 81, characters 27-40: The command has indeed failed with message: This expression has type bool but an expression was expected of type int Ltac2 make : 'a -> 'a t make := fun x => Ltac2 p : 'a t -> 'a p := fun x => Ltac2 set : 'a t -> 'a -> unit set := fun x v => File "./output/ltac2_abstract.v", line 91, characters 32-33: The command has indeed failed with message: Open types currently do not support #[abstract]. coq-8.20.0/test-suite/output/ltac2_abstract.v000066400000000000000000000037701466560755400211410ustar00rootroot00000000000000Require Import Ltac2.Ltac2. Module AbstractType. (* redundant, maybe should be an error? *) #[abstract] Ltac2 Type t. End AbstractType. Module DefinedType. Module M. #[abstract] Ltac2 Type t := int. Ltac2 foo (x:t) : t := Int.add x 1. Ltac2 make (x:int) : t := x. Ltac2 repr (x:t) : int := x. Ltac2 three : t := 3. End M. Fail Ltac2 nope : M.t := 0. Ltac2 ok () : M.t := M.make 0. Ltac2 Eval ok (). Import M. Fail Ltac2 nope : M.t := 0. Ltac2 Eval repr (foo (make 1)). Print foo. Print three. Ltac2 Eval three. End DefinedType. Module AlgebraicType. Module M. #[abstract] Ltac2 Type t := [ A | B (int option) ]. Ltac2 a := A. Ltac2 is_b x := match x with B _ => true | _ => false end. Ltac2 get_b def x := match x with B (Some x) => x | _ => def end. End M. Fail Ltac2 Eval M.A. Fail Ltac2 Eval fun x => match x with M.A => true | _ => false end. Ltac2 Eval M.a. Ltac2 Eval M.is_b M.a. Print M.a. Print M.is_b. Print M.get_b. End AlgebraicType. Module RecordType. Module M. #[abstract] Ltac2 Type 'a t := { mutable p : 'a }. Ltac2 make x := { p := x }. Ltac2 set x v := x.(p) := v. Ltac2 p x := x.(p). End M. Ltac2 Eval M.make 0. Import M. Fail Ltac2 Eval { p := 0 }. Fail Ltac2 Eval fun x => x.(p). Ltac2 Eval make 42. Ltac2 Eval p (make 42). Fail Ltac2 Eval Int.add (p (make true)) 0. Print make. Print p. Print set. End RecordType. Module ExtensibleType. Module M. (* TODO figure out what this should do, error until then. *) Fail #[abstract] Ltac2 Type t := [ .. ]. (* Ltac2 Type t ::= [ E | E' ]. *) (* Fail #[abstract] Ltac2 Type t ::= [ F ]. *) (* Ltac2 e := E. *) (* Ltac2 is_e x := match x with E => true | _ => false end. *) End M. (* Import M. *) (* Ltac2 Eval E. *) (* Ltac2 Eval match E with E => true | _ => false end. *) (* Fail Ltac2 Type t ::= [ F ]. *) (* add more tests once we have something to test *) End ExtensibleType. coq-8.20.0/test-suite/output/ltac2_anomaly_backtrace.out000066400000000000000000000003671466560755400233360ustar00rootroot00000000000000File "./output/ltac2_anomaly_backtrace.v", line 9, characters 0-18: Error: Anomaly "Uncaught exception Not_found." Please report at http://coq.inria.fr/bugs/. Backtrace: Call foo Prim coqc exited with code 129 coq-8.20.0/test-suite/output/ltac2_anomaly_backtrace.v000066400000000000000000000011051466560755400227630ustar00rootroot00000000000000Require Import Ltac2.Ltac2. Ltac2 foo () := let v := Constr.Unsafe.make (Constr.Unsafe.Rel -1) in let x := Constr.Binder.make None 'True in let vv := Constr.Unsafe.make (Constr.Unsafe.App v (Array.of_list [v])) in let f := Constr.Unsafe.make (Constr.Unsafe.Lambda x vv) in let ff := Constr.Unsafe.make (Constr.Unsafe.App f (Array.of_list [f])) in Std.eval_hnf ff. Set Ltac2 Backtrace. Ltac2 Eval foo (). (* Error: Anomaly "Uncaught exception Not_found." Please report at http://coq.inria.fr/bugs/. *) coq-8.20.0/test-suite/output/ltac2_bt.out000066400000000000000000000017201466560755400202760ustar00rootroot00000000000000File "./output/ltac2_bt.v", line 8, characters 2-48: The command has indeed failed with message: Uncaught Ltac2 exception: Invalid_argument None Backtrace: Prim Call {Control.zero e} Prim File "./output/ltac2_bt.v", line 9, characters 2-49: The command has indeed failed with message: Uncaught Ltac2 exception: Invalid_argument None Backtrace: Prim Call {Control.throw e} Prim File "./output/ltac2_bt.v", line 10, characters 2-60: The command has indeed failed with message: Uncaught Ltac2 exception: Invalid_argument None Backtrace: Prim Call f Prim File "./output/ltac2_bt.v", line 11, characters 2-61: The command has indeed failed with message: Uncaught Ltac2 exception: Invalid_argument None Backtrace: Prim Call f Prim coq-8.20.0/test-suite/output/ltac2_bt.v000066400000000000000000000005451466560755400177400ustar00rootroot00000000000000From Ltac2 Require Import Ltac2. Ltac2 f () := Control.zero (Invalid_argument None). Goal True. Proof. Set Ltac2 Backtrace. Fail Control.plus f (fun e => Control.zero e). Fail Control.plus f (fun e => Control.throw e). Fail Control.plus_bt f (fun e bt => Control.zero_bt e bt). Fail Control.plus_bt f (fun e bt => Control.throw_bt e bt). Abort. coq-8.20.0/test-suite/output/ltac2_check_globalize.out000066400000000000000000000021711466560755400227770ustar00rootroot00000000000000() () : unit fun x => x : 'a -> 'a () () (1, 2) 3 let x := () in x () File "./output/ltac2_check_globalize.v", line 22, characters 32-33: The command has indeed failed with message: This expression has type unit. It is not a function and cannot be applied. let x := fun x => x in let _ := x 1 in let _ := x "" in () let x := fun x => x in let _ := x 1 in let _ := x "" in () : unit let accu := { contents := []} in (let x := fun x => accu.(contents) := (x :: accu.(contents)) in let _ := x 1 in let _ := x "" in ()); accu.(contents) File "./output/ltac2_check_globalize.v", line 38, characters 0-144: The command has indeed failed with message: This expression has type string but an expression was expected of type int let (m : '__α Pattern.goal_matching) := [(([(None, (Pattern.MatchPattern, pat:(_)))], (Pattern.MatchPattern, pat:(_))), (fun h => let h := Array.get h 0 in fun _ => fun _ => fun _ => fun _ => Std.clear h)); (([], (Pattern.MatchPattern, pat:(_))), (fun _ => fun _ => fun _ => fun _ => fun _ => ()))] : _ Pattern.goal_matching in Pattern.lazy_goal_match0 false m :'__α constr:(ltac2:(())) coq-8.20.0/test-suite/output/ltac2_check_globalize.v000066400000000000000000000021021466560755400224270ustar00rootroot00000000000000Require Import Ltac2.Ltac2. Unset Ltac2 Typed Notations. Ltac2 Notation "foo" := (). Ltac2 Globalize foo. Ltac2 Check foo. Ltac2 Check (fun x => x : 'a -> 'a). Ltac2 Globalize (() ()). Ltac2 Notation "bar" := (1,2). (* check that CTacApp nodes don't get merged or that we handle merging them correctly. *) Ltac2 Globalize bar 3. Ltac2 Globalize let x := () in x (). Fail Ltac2 Check let x := () in x (). Ltac2 Notation "complicated_typing" x(tactic) := let _ := x 1 in let _ := x "" in (). Ltac2 Globalize complicated_typing (fun x => x). Ltac2 Check complicated_typing (fun x => x). Ltac2 Globalize let accu := { contents := [] } in complicated_typing (fun x => accu.(contents) := x :: accu.(contents)); accu.(contents). Fail Ltac2 Check let accu := { contents := [] } in complicated_typing (fun x => accu.(contents) := x :: accu.(contents)); accu.(contents). Ltac2 Globalize lazy_match! goal with | [h: _ |- _] => (* lots of code... *) Std.clear h (* more code... *) | [|- _] => (* lots of code... *) () end. Ltac2 Globalize constr:(ltac2:(foo)). coq-8.20.0/test-suite/output/ltac2_deprecated.out000066400000000000000000000010611466560755400217670ustar00rootroot00000000000000File "./output/ltac2_deprecated.v", line 13, characters 11-14: Warning: Ltac2 definition foo is deprecated. test_definition [deprecated-ltac2-definition,deprecated,default] - : unit = () File "./output/ltac2_deprecated.v", line 14, characters 11-14: Warning: Ltac2 alias bar is deprecated. test_notation [deprecated-ltac2-alias,deprecated,default] - : unit = () File "./output/ltac2_deprecated.v", line 15, characters 11-14: Warning: Ltac2 definition qux is deprecated. test_external [deprecated-ltac2-definition,deprecated,default] - : 'a array -> int = coq-8.20.0/test-suite/output/ltac2_deprecated.v000066400000000000000000000005441466560755400214320ustar00rootroot00000000000000Require Import Ltac2.Ltac2. #[deprecated(note="test_definition")] Ltac2 foo := (). #[deprecated(note="test_notation")] Ltac2 Notation bar := (). #[deprecated(note="test_external")] Ltac2 @ external qux : 'a array -> int := "coq-core.plugins.ltac2" "array_length". (* Randomly picked external function *) Ltac2 Eval foo. Ltac2 Eval bar. Ltac2 Eval qux. coq-8.20.0/test-suite/output/ltac2_match.out000066400000000000000000000006401466560755400207650ustar00rootroot00000000000000File "./output/ltac2_match.v", line 12, characters 41-42: Warning: This pattern is redundant. [redundant-pattern,ltac2,default] File "./output/ltac2_match.v", line 34, characters 5-51: Warning: This clause is redundant. [redundant-pattern,ltac2,default] File "./output/ltac2_match.v", line 36, characters 5-51: Warning: This clause is redundant. [redundant-pattern,ltac2,default] - : string = "10" - : string = "12" coq-8.20.0/test-suite/output/ltac2_match.v000066400000000000000000000026201466560755400204230ustar00rootroot00000000000000Require Import Ltac2.Ltac2. Ltac2 Type rec autre := [ C | D | E (autre) | F (autre, autre) | H (autre) | I | J | K (string) ]. Ltac2 rec autre x := match x with | C,_,_ => 1 | _,C,_ => 2 | D,D,_ => 3 | (D|(F _ _)|(H _)|K _),_,_ => 4 | (_, (D|I|E _|F _ _|H _|K _), _) => 8 | (J,J,((C|D) as x |E x|F _ x)) | (J,_,((C|J) as x)) => autre (x,x,x) | (J, J, (I|H _|K _)) => 9 | I,_,_ => 6 | E _,_,_ => 7 end. Ltac2 Type t_l := [A | B]. Ltac2 f x := match x with | _, _, _, _, _, _, _, _, _, _, _, _, _, B, _, _ => "0" | _, _, _, B, A, _, _, _, _, _, _, _, _, _, _, _ => "1" | _, _, _, B, _, A, _, _, A, _, _, _, _, _, _, _ => "2" | _, _, _, _, _, _, _, _, _, _, B, A, _, A, _, _ => "3" | _, _, _, _, _, _, _, B, _, _, _, _, B, _, A, A => "4" | A, _, _, _, _, _, _, _, _, _, _, _, _, _, _, _ => "5" | _, _, _, _, _, _, _, B, _, B, _, _, _, _, _, _ => "6" | _, B, _, _, _, _, _, _, _, _, _, _, _, _, _, _ => "7" | _, A, A, _, A, _, B, _, _, _, _, _, _, _, _, B => "8" | _, _, _, _, B, _, _, _, _, _, _, _, _, _, B, _ => "9" | _, _, _, _, _, _, _, _, _, _, _, B, _, _, _, _ => "10" | _, _, _, _, _, A, _, _, _, _, B, _, _, _, _, _ => "11" | B, _, _, _, _, _, _, _, _, _, _, _, _, _, _, _ => "12" | _, _, _, _, _, _, _, _, _, _, _, _, _, _, _, _ => "13" end. Ltac2 Eval f (B, A, A, A, A, A, A, A, A, A, A, B, A, A, A, A). Ltac2 Eval f (B, A, A, A, A, A, A, A, A, A, A, A, A, A, A, A). coq-8.20.0/test-suite/output/ltac2_notations_eval_in.out000066400000000000000000000012071466560755400234040ustar00rootroot00000000000000- : constr = constr:((fix add (n m : nat) {struct n} : nat := match n with | 0 => m | S p => S (add p m) end) (1 + 2) 3) - : constr = constr:(S (0 + 2 + 3)) - : constr = constr:(6) - : constr = constr:(1 + 2 + 3) - : constr = constr:(6) - : constr = constr:(1 + 2 + 3) - : constr = constr:(1 + 2 + 3) - : constr = constr:(6) - : constr = constr:(1 + 2 + 3) - : constr = constr:(1 + 2 + 3) - : constr = constr:(6) - : constr = constr:(1 + 2 + 3) - : constr = constr:(1 + 2 + 3) - : constr list = [constr:(0 <> 0); constr:(0 = 0 -> False); constr:((fun P : Prop => P -> False) (0 = 0)); constr:(0 <> 0)] coq-8.20.0/test-suite/output/ltac2_notations_eval_in.v000066400000000000000000000020511466560755400230400ustar00rootroot00000000000000From Ltac2 Require Import Ltac2. From Coq Require Import ZArith. (** * Test eval ... in / reduction tactics *) (** The below test cases test if the notation syntax works - not the tactics as such *) Ltac2 Eval (eval red in (1+2+3)). Ltac2 Eval (eval hnf in (1+2+3)). Ltac2 Eval (eval simpl in (1+2+3)). Ltac2 Eval (eval simpl Z.add in (1+2+3)). Ltac2 Eval (eval cbv in (1+2+3)). Ltac2 Eval (eval cbv delta [Z.add] beta iota in (1+2+3)). Ltac2 Eval (eval cbv delta [Z.add Pos.add] beta iota in (1+2+3)). Ltac2 Eval (eval cbn in (1+2+3)). Ltac2 Eval (eval cbn delta [Z.add] beta iota in (1+2+3)). Ltac2 Eval (eval cbn delta [Z.add Pos.add] beta iota in (1+2+3)). Ltac2 Eval (eval lazy in (1+2+3)). Ltac2 Eval (eval lazy delta [Z.add] beta iota in (1+2+3)). Ltac2 Eval (eval lazy delta [Z.add Pos.add] beta iota in (1+2+3)). (* The example for [fold] in the reference manual *) Ltac2 Eval ( let t1 := '(~0=0) in let t2 := eval unfold not in $t1 in let t3 := eval pattern (0=0) in $t2 in let t4 := eval fold not in $t3 in [t1; t2; t3; t4] ). coq-8.20.0/test-suite/output/ltac2_pr_ctor.out000066400000000000000000000000751466560755400213430ustar00rootroot00000000000000- : pair = C 0 0 - : pair' = C' (0, 0) - : ppair = D (C 0 0) coq-8.20.0/test-suite/output/ltac2_pr_ctor.v000066400000000000000000000005101466560755400207730ustar00rootroot00000000000000Require Import Ltac2.Ltac2. (* cf bug #18556 *) Ltac2 Type pair := [ C (int, int) ]. Ltac2 Eval C 0 0. (* prints "C (0, 0)", should be "C 0 0" *) Ltac2 Type pair' := [ C' (int * int) ]. Ltac2 Eval C' (0, 0). (* prints "C' ((0, 0))", sound but over-parenthesized *) Ltac2 Type ppair := [ D (pair) ]. Ltac2 Eval D (C 0 0). coq-8.20.0/test-suite/output/ltac2_printabout.out000066400000000000000000000016501466560755400220620ustar00rootroot00000000000000fst : 'a * 'b -> 'a snd : 'b * 'a -> 'a type : constr -> constr Ltac2 type : constr -> constr type := @external "coq-core.plugins.ltac2" "constr_type" Ltac2 ltac2_printabout.type Ltac2 type : constr -> constr None : 'a option Some : 'a -> 'a option Ltac2 constructor Err : exn -> 'a result Inl : 'a -> ('a, 'b) either Inr : 'b -> ('a, 'b) either Triple : 'c -> 'b -> 'a -> ('a, 'b, 'c) triple Not_found : exn Out_of_bounds : message option -> exn Ltac2 Notation nota := () () Ltac2 Type constr Ltac2 Type constr := Init.constr ('a, 'b) thing := 'b option Ltac2 Type empty := [ ] 'a option := [ None | Some ('a) ] bool := [ true | false ] Ltac2 Type ('a, 'b, 'c) triple := [ Triple ('c, 'b, 'a) ] Ltac2 Type 'a ref := { mutable contents : 'a; } Ltac2 Type ('a, 'b, 'c) trirecord := { cproj : 'c; mutable bproj : 'b; aproj : 'a; } Ltac2 Type extensible := [ .. ] Ltac2 Type extensible := [ .. | OtherThing (bool) | Thing (string) ] coq-8.20.0/test-suite/output/ltac2_printabout.v000066400000000000000000000020271466560755400215170ustar00rootroot00000000000000Require Import Ltac2.Init. Ltac2 @ external type : constr -> constr := "coq-core.plugins.ltac2" "constr_type". Print Ltac2 Signatures. Print type. Locate type. About type. (* constructors *) Print Ltac2 None. Print Ltac2 Some. Print Err. Ltac2 Type ('a,'b) either := [ Inl ('a) | Inr ('b) ]. Print Ltac2 Inl. Print Ltac2 Inr. Ltac2 Type ('a,'b,'c) triple := [ Triple ('c, 'b, 'a) ]. Print Ltac2 Triple. Print Ltac2 Not_found. Print Ltac2 Out_of_bounds. (* alias *) Ltac2 Notation nota := () (). Print nota. (* types *) Print constr. Ltac2 Type constr := constr. Print constr. Ltac2 Type ('a,'b) thing := 'b option. Print Ltac2 Type thing. Ltac2 Type empty := []. Print empty. Print Ltac2 Type option. Print Ltac2 Type bool. Print triple. Print ref. Ltac2 Type ('a,'b,'c) trirecord := { cproj : 'c; mutable bproj : 'b; aproj : 'a }. Print trirecord. Ltac2 Type extensible := [ .. ]. Print extensible. Ltac2 Type extensible ::= [ Thing (string) ]. Ltac2 Type extensible ::= [ OtherThing (bool) ]. Print extensible. coq-8.20.0/test-suite/output/ltac2_typed_notations.out000066400000000000000000000007701466560755400231200ustar00rootroot00000000000000File "./output/ltac2_typed_notations.v", line 5, characters 9-10: The command has indeed failed with message: This expression has type bool but an expression was expected of type constr fun (b : bool) => let c := b in let (m : '__α Pattern.constr_matching) := [(Pattern.MatchPattern, pat:(true), (fun _ => fun (_ : constr array) => true)); (Pattern.MatchPattern, pat:(false), (fun _ => fun (_ : constr array) => false))] with (t : constr) := c in Pattern.one_match0 t m :'__α : bool coq-8.20.0/test-suite/output/ltac2_typed_notations.v000066400000000000000000000004531466560755400225540ustar00rootroot00000000000000Require Import Ltac2.Ltac2. Fail Ltac2 foo(b: bool): bool := let c := b in match! c with | true => true | false => false end. (* error used to be on the whole command *) Ltac2 Globalize fun (b: bool) => (let c := b in match! c with | true => true | false => false end : bool). coq-8.20.0/test-suite/output/ltac2_unused_var.out000066400000000000000000000032271466560755400220500ustar00rootroot00000000000000File "./output/ltac2_unused_var.v", line 3, characters 6-18: Warning: Unused variable: x. [ltac2-unused-variable,ltac2,default] File "./output/ltac2_unused_var.v", line 5, characters 16-27: Warning: Unused variable: y. [ltac2-unused-variable,ltac2,default] File "./output/ltac2_unused_var.v", line 5, characters 6-27: Warning: Unused variable: x. [ltac2-unused-variable,ltac2,default] File "./output/ltac2_unused_var.v", line 10, characters 0-38: Warning: Unused variable: x. [ltac2-unused-variable,ltac2,default] File "./output/ltac2_unused_var.v", line 16, characters 17-23: Warning: Unused variable: x. [ltac2-unused-variable,ltac2,default] File "./output/ltac2_unused_var.v", line 18, characters 16-40: Warning: Unused variable: y. [ltac2-unused-variable,ltac2,default] File "./output/ltac2_unused_var.v", line 20, characters 16-56: Warning: Unused variable: x. [ltac2-unused-variable,ltac2,default] File "./output/ltac2_unused_var.v", line 22, characters 16-43: Warning: Unused variable: b. [ltac2-unused-variable,ltac2,default] File "./output/ltac2_unused_var.v", line 24, characters 15-32: Warning: Unused variable: x. [ltac2-unused-variable,ltac2,default] File "./output/ltac2_unused_var.v", line 26, characters 23-26: Warning: Unused variables: x y. [ltac2-unused-variable,ltac2,default] File "./output/ltac2_unused_var.v", line 28, characters 23-26: Warning: Unused variable: y. [ltac2-unused-variable,ltac2,default] File "./output/ltac2_unused_var.v", line 30, characters 18-55: Warning: Unused variable: y. [ltac2-unused-variable,ltac2,default] File "./output/ltac2_unused_var.v", line 42, characters 37-39: Warning: Unused variable: x. [ltac2-unused-variable,ltac2,default] coq-8.20.0/test-suite/output/ltac2_unused_var.v000066400000000000000000000023551466560755400215070ustar00rootroot00000000000000Require Import Ltac2.Ltac2. Ltac2 foo1 x := (). Ltac2 foo2 x := fun y => (). (* we don't warn on _ prefixed variable *) Ltac2 foo3 _x := (). Ltac2 Notation "foo4" x(constr) := (). (* questionable behaviour: unused variable in untyped notation warns at notation use time *) Unset Ltac2 Typed Notations. Ltac2 Notation "foo5" x(constr) := (). Set Ltac2 Typed Notations. Ltac2 foo6 () := foo5 1. Ltac2 foo7 x := match x with y => () end. Ltac2 foo8 x := match x with Some x => 1 | None => 2 end. Ltac2 foo9 x := match x with (a,b) => a end. Ltac2 foo10 := let x := () in (). Ltac2 foo11 () := let (x,y) := (1,2) in (). Ltac2 foo12 () := let (x,y) := (1,2) in x. Ltac2 foo13 () := let rec x () := 1 with y () := 2 in x. Ltac2 foo14 () := let rec x () := y () with y () := 2 in x. (* missing warning for unused letrec (bug?) *) Ltac2 foo15 () := let rec x () := y () with y () := x () in (). Ltac2 mutable bar () := (). (* missing warning for unused "Set as" (bug?) *) Ltac2 Set bar as bar0 := fun () => (). Ltac2 foo16 () := ltac1:(ltac2:(x |- ())). (* no warning for y even though it's bound in the ltac2 context (ltac2 can't tell that the notation isn't eg "ltac2:(...) + y") *) Notation foo17 x y := ltac2:(exact $preterm:x) (only parsing). coq-8.20.0/test-suite/output/ltac_extra_args.out000066400000000000000000000011521466560755400217450ustar00rootroot00000000000000File "./output/ltac_extra_args.v", line 6, characters 2-13: The command has indeed failed with message: Illegal tactic application: got 1 extra argument. File "./output/ltac_extra_args.v", line 7, characters 2-16: The command has indeed failed with message: Illegal tactic application: got 2 extra arguments. File "./output/ltac_extra_args.v", line 8, characters 2-16: The command has indeed failed with message: Illegal tactic application: got 1 extra argument. File "./output/ltac_extra_args.v", line 9, characters 2-20: The command has indeed failed with message: Illegal tactic application: got 2 extra arguments. coq-8.20.0/test-suite/output/ltac_extra_args.v000066400000000000000000000002071466560755400214030ustar00rootroot00000000000000Ltac foo := idtac. Ltac bar H := idtac. Goal True. Proof. Fail foo H. Fail foo H H'. Fail bar H H'. Fail bar H H' H''. Abort. coq-8.20.0/test-suite/output/ltac_missing_args.out000066400000000000000000000052651466560755400223040ustar00rootroot00000000000000File "./output/ltac_missing_args.v", line 11, characters 2-11: The command has indeed failed with message: The user-defined tactic "foo" was not fully applied: There is a missing argument for variable x, no arguments at all were provided. Ltac call to "foo" failed. File "./output/ltac_missing_args.v", line 12, characters 2-11: The command has indeed failed with message: The user-defined tactic "bar" was not fully applied: There is a missing argument for variable x, no arguments at all were provided. Ltac call to "bar" failed. File "./output/ltac_missing_args.v", line 13, characters 2-16: The command has indeed failed with message: The user-defined tactic "bar" was not fully applied: There is a missing argument for variable y and 1 more, 1 argument was provided. Ltac call to "bar" failed. File "./output/ltac_missing_args.v", line 14, characters 2-11: The command has indeed failed with message: The user-defined tactic "baz" was not fully applied: There is a missing argument for variable x, no arguments at all were provided. In nested Ltac calls to "baz" and "foo", last call failed. File "./output/ltac_missing_args.v", line 15, characters 2-11: The command has indeed failed with message: The user-defined tactic "qux" was not fully applied: There is a missing argument for variable x, no arguments at all were provided. In nested Ltac calls to "qux" and "bar", last call failed. File "./output/ltac_missing_args.v", line 16, characters 2-36: The command has indeed failed with message: The user-defined tactic "mydo" was not fully applied: There is a missing argument for variable _, no arguments at all were provided. In nested Ltac calls to "mydo" and "tac" (bound to fun _ _ => idtac), last call failed. File "./output/ltac_missing_args.v", line 17, characters 2-42: The command has indeed failed with message: An unnamed user-defined tactic was not fully applied: There is a missing argument for variable _, no arguments at all were provided. File "./output/ltac_missing_args.v", line 18, characters 2-24: The command has indeed failed with message: An unnamed user-defined tactic was not fully applied: There is a missing argument for variable _, no arguments at all were provided. File "./output/ltac_missing_args.v", line 19, characters 2-16: The command has indeed failed with message: The user-defined tactic "rec" was not fully applied: There is a missing argument for variable x, no arguments at all were provided. In nested Ltac calls to "rec" and "rec", last call failed. File "./output/ltac_missing_args.v", line 20, characters 2-40: The command has indeed failed with message: An unnamed user-defined tactic was not fully applied: There is a missing argument for variable x, 1 argument was provided. coq-8.20.0/test-suite/output/ltac_missing_args.v000066400000000000000000000006251466560755400217350ustar00rootroot00000000000000Set Ltac Backtrace. Ltac foo x := idtac x. Ltac bar x := fun y _ => idtac x y. Ltac baz := foo. Ltac qux := bar. Ltac mydo tac := tac (). Ltac rec x := rec. Goal True. Fail foo. Fail bar. Fail bar True. Fail baz. Fail qux. Fail mydo ltac:(fun _ _ => idtac). Fail let tac := (fun _ => idtac) in tac. Fail (fun _ => idtac). Fail rec True. Fail let rec tac x := tac in tac True. Abort. coq-8.20.0/test-suite/output/names.out000066400000000000000000000005031466560755400177050ustar00rootroot00000000000000File "./output/names.v", line 5, characters 37-40: The command has indeed failed with message: In environment y : nat The term "a y" has type "{y0 : nat | y = y0}" while it is expected to have type "{x : nat | x = y}". 1 focused goal (shelved: 1) H : ?n <= 3 -> 3 <= ?n -> ?n = 3 ============================ True coq-8.20.0/test-suite/output/names.v000066400000000000000000000003531466560755400173460ustar00rootroot00000000000000(* Test no clash names occur *) (* see bug #2723 *) Parameter a : forall x, {y:nat|x=y}. Fail Definition b y : {x:nat|x=y} := a y. Goal (forall n m, n <= m -> m <= n -> n = m) -> True. intro H; epose proof (H _ 3) as H. Show. Abort. coq-8.20.0/test-suite/output/non_reversible_notation.out000066400000000000000000000006531466560755400235370ustar00rootroot00000000000000File "./output/non_reversible_notation.v", line 2, characters 0-31: Warning: This notation contains Ltac expressions: it will not be used for printing. [non-reversible-notation,parsing,default] File "./output/non_reversible_notation.v", line 4, characters 0-27: Warning: This notation contains volatile casts: it will not be used for printing. [non-reversible-notation,parsing,default] 1 : nat 2 : nat baz : nat coq-8.20.0/test-suite/output/non_reversible_notation.v000066400000000000000000000001751466560755400231740ustar00rootroot00000000000000 Notation foo := ltac:(exact 1). Notation bar := (2 :> nat). Notation baz := (3 <: nat). Check foo. Check bar. Check baz. coq-8.20.0/test-suite/output/notation_prefix_incompatible_level.out000066400000000000000000000011561466560755400257340ustar00rootroot00000000000000File "./output/notation_prefix_incompatible_level.v", line 4, characters 0-43: Warning: Notations "#0 #1" defined at level 30 and "#0 #1 #2" defined at level 40 have incompatible prefixes. One of them will likely not work. [notation-incompatible-prefix,parsing,default] File "./output/notation_prefix_incompatible_level.v", line 7, characters 0-63: Warning: Notations "#20 #21 _ #3 _" defined at level 50 with arguments constr at level 30 and "#20 #21 _ #34" defined at level 50 with arguments constr at level 40 have incompatible prefixes. One of them will likely not work. [notation-incompatible-prefix,parsing,default] coq-8.20.0/test-suite/output/notation_prefix_incompatible_level.v000066400000000000000000000004051466560755400253660ustar00rootroot00000000000000Set Warnings "-closed-notation-not-level-0". Reserved Notation "#0 #1" (at level 30). Reserved Notation "#0 #1 #2" (at level 40). Reserved Notation "#20 #21 x #3 y" (x at level 30, at level 50). Reserved Notation "#20 #21 x #34" (x at level 40, at level 50). coq-8.20.0/test-suite/output/notation_previous_prefix.out000066400000000000000000000004741466560755400237550ustar00rootroot00000000000000Notation "#0 #1 _" at level 30 with arguments constr at next level, no associativity. Notation "#0 #1 _" in foo at level 40 with arguments custom foo at next level, no associativity. Notation "#2 _ #3 _ #4 _" at level 30 with arguments constr at level 20, constr at level 25, constr at next level, no associativity. coq-8.20.0/test-suite/output/notation_previous_prefix.v000066400000000000000000000006261466560755400234120ustar00rootroot00000000000000Reserved Notation "#0 x" (at level 30). Reserved Notation "#0 #1 x". Print Notation "#0 #1 _". Declare Custom Entry foo. Reserved Notation "#0 x" (in custom foo at level 40). Reserved Notation "#0 #1 x" (in custom foo). Print Notation "#0 #1 _" in custom foo. Reserved Notation "#2 x #3 y" (at level 30, x at level 20, y at level 25). Reserved Notation "#2 z #3 x #4 y". Print Notation "#2 _ #3 _ #4 _". coq-8.20.0/test-suite/output/notation_principal_scope.out000066400000000000000000000025431466560755400236750ustar00rootroot00000000000000File "./output/notation_principal_scope.v", line 4, characters 28-29: The command has indeed failed with message: Argument X was previously inferred to be in scope function_scope but is here used in the empty scope stack. Scope function_scope will be used at parsing time unless you override it by annotating the argument with an explicit scope of choice. [inconsistent-scopes,syntax,default] File "./output/notation_principal_scope.v", line 6, characters 23-36: The command has indeed failed with message: Abbreviations don't support only printing File "./output/notation_principal_scope.v", line 8, characters 22-33: The command has indeed failed with message: The reference nonexisting was not found in the current environment. File "./output/notation_principal_scope.v", line 10, characters 34-57: The command has indeed failed with message: Notation scope for argument X can be specified only once. pp I : True /\ True File "./output/notation_principal_scope.v", line 19, characters 18-19: The command has indeed failed with message: Illegal application (Non-functional construction): The expression "I" of type "True" cannot be applied to the term "I" : "True" File "./output/notation_principal_scope.v", line 21, characters 0-50: Warning: This notation will not be used for printing as it is bound to a single variable. [notation-bound-to-variable,parsing,default] coq-8.20.0/test-suite/output/notation_principal_scope.v000066400000000000000000000011661466560755400233330ustar00rootroot00000000000000Arguments conj {_ _} _ _%_function. Set Warnings "+inconsistent-scopes". Fail Notation pp X := (conj X X). Fail Notation pp := 1 (only printing). Fail Notation pp X := nonexisting. Fail Notation pp X := (conj X X) (X, X in scope nat_scope). Notation pp X := (conj X X) (X in scope nat_scope). Notation "$" := I (only parsing) : nat_scope. Notation "$" := (I I) (only parsing) : bool_scope. Open Scope bool_scope. Check pp $. Fail Check pp (id $). Notation pp1 X := (X%nat) (X in scope bool_scope). Notation pp2 X := ((X + X)%type) (X in scope bool_scope). Notation pp3 X := (((X, X)%type, X)%nat) (X in scope bool_scope). coq-8.20.0/test-suite/output/onlyprinting.out000066400000000000000000000012221466560755400213350ustar00rootroot000000000000000:-) 0 : nat 1 +_a 2 : nat 1 +_b 2 : nat 1 +_b 2 : nat 1 +_c 2 : nat 1 +_c 2 : nat Scope nat_scope Delimiting key is nat Bound to class nat "x >= y" := (ge x y) "x > y" := (gt x y) "x <= y <= z" := (and (le x y) (le y z)) "x <= y < z" := (and (le x y) (lt y z)) "n <= m" := (le n m) "x < y <= z" := (and (lt x y) (le y z)) "x < y < z" := (and (lt x y) (lt y z)) "x < y" := (lt x y) "x - y" := (Nat.sub x y) "x +_c y" := (Nat.add x y) (only printing) "x +_b y" := (Nat.add x y) "x +_a y" := (Nat.add x y) "x + y" := (Nat.add x y) "x * y" := (Nat.mul x y) 1 +_b 2 : nat 1 +_a 2 : nat 1 + 2 : nat 1 +_c 2 : nat coq-8.20.0/test-suite/output/onlyprinting.v000066400000000000000000000012621466560755400207770ustar00rootroot00000000000000Module A. Reserved Notation "x :-) y" (at level 50, only printing). Notation "x :-) y" := (plus x y). Check 0 + 0. End A. Module B. Notation "x +_a y" := (plus x y) (at level 50) : nat_scope. Check 1 +_a 2. Notation "x +_b y" := (plus x y) (at level 50) : nat_scope. Check 1 +_a 2. Check 1 +_b 2. Notation "x +_c y" := (plus x y) (at level 50, only printing) : nat_scope. Check 1 +_a 2. Check 1 +_b 2. Print Scope nat_scope. Disable Notation "_ +_c _" : nat_scope. Check 1 +_a 2. Disable Notation "x +_b y" : nat_scope. Check 1 +_a 2. Disable Notation "_ +_a _" (only printing) : nat_scope. Check 1 +_a 2. Enable Notation "a +_c b" (only printing) : nat_scope. Check 1 +_a 2. End B. coq-8.20.0/test-suite/output/optimize_heap.out000066400000000000000000000001401466560755400214340ustar00rootroot000000000000001 goal ============================ True 1 goal ============================ True coq-8.20.0/test-suite/output/optimize_heap.v000066400000000000000000000001631466560755400210770ustar00rootroot00000000000000(* optimize_heap should not affect the proof state *) Goal True. idtac. Show. optimize_heap. Show. Abort. coq-8.20.0/test-suite/output/prim_array.out000066400000000000000000000003621466560755400207520ustar00rootroot00000000000000[| | 0 : nat |] : array nat [| 1; 2; 3 | 0 : nat |] : array nat [| | 0 : nat |]@{Set} : array@{Set} nat [| bool; list nat | nat : Set |]@{prim_array.8} : array@{prim_array.8} Set (* {prim_array.8} |= Set < prim_array.8 *) coq-8.20.0/test-suite/output/prim_array.v000066400000000000000000000002311466560755400204030ustar00rootroot00000000000000Primitive array := #array_type. Check [| | 0 |]. Check [| 1; 2; 3 | 0 |]. Set Printing Universes. Check [| | 0 |]. Check [| bool; list nat | nat |]. coq-8.20.0/test-suite/output/primitive_tokens.out000066400000000000000000000025651466560755400222070ustar00rootroot00000000000000"foo" : string 1234 : nat Nat.add 1 2 : nat match "a" with | "a" => true | _ => false end : bool match 1 with | 1 => true | _ => false end : bool {| field := 7 |} : test String (Ascii.Ascii false true true false false true true false) (String (Ascii.Ascii true true true true false true true false) (String (Ascii.Ascii true true true true false true true false) EmptyString)) : string S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S ...))))))))))))))))))))))) : nat Nat.add (S O) (S (S O)) : nat match String (Ascii.Ascii true false false false false true true false) EmptyString with | String (Ascii.Ascii true false false false false true true false) EmptyString => true | _ => false end : bool match S O with | S O => true | _ => false end : bool {| field := S (S (S (S (S (S (S O)))))) |} : test coq-8.20.0/test-suite/output/primitive_tokens.v000066400000000000000000000007131466560755400216360ustar00rootroot00000000000000Require Import String. Record test := { field : nat }. Open Scope string_scope. Unset Printing Notations. Check "foo". Check 1234. Check 1 + 2. Check match "a" with "a" => true | _ => false end. Check match 1 with 1 => true | _ => false end. Check {| field := 7 |}. Set Printing Raw Literals. Check "foo". Check 1234. Check 1 + 2. Check match "a" with "a" => true | _ => false end. Check match 1 with 1 => true | _ => false end. Check {| field := 7 |}. coq-8.20.0/test-suite/output/print_ltac.out000066400000000000000000000065301466560755400207470ustar00rootroot00000000000000Ltac t1 := time "my tactic" idtac Ltac t2 := let x := string:("my tactic") in idtac x Ltac t3 := idtacstr "my tactic" Ltac t4 x := match x with | ?A => constr:((A, A)) end File "./output/print_ltac.v", line 17, characters 27-32: The command has indeed failed with message: idnat is bound to a notation that does not denote a reference. Ltac withstrategy l x := let idx := smart_global:(id) in let tl := strategy_level:(transparent) in with_strategy 1 [ id id ] with_strategy l [ id id ] with_strategy tl [ id id ] with_strategy transparent [ id id ] with_strategy transparent [ id id ] with_strategy opaque [ id id ] with_strategy expand [ id id ] with_strategy transparent [ idx ] with_strategy transparent [ id x ] with_strategy transparent [ x id ] with_strategy transparent [ id ] with_strategy transparent [ id x ] with_strategy transparent [ id id ] with_strategy transparent [ id id x ] with_strategy transparent [ id ] with_strategy transparent [ id x ] with_strategy transparent [ id id ] with_strategy transparent [ id id x ] idtac File "./output/print_ltac.v", line 52, characters 29-34: The command has indeed failed with message: idnat is bound to a notation that does not denote a reference. Ltac withstrategy l x := let idx := smart_global:(id) in let tl := strategy_level:(transparent) in with_strategy 1 [ id id ] with_strategy l [ id id ] with_strategy tl [ id id ] with_strategy transparent [ id id ] with_strategy transparent [ id id ] with_strategy opaque [ id id ] with_strategy expand [ id id ] with_strategy transparent [ idx ] with_strategy transparent [ id x ] with_strategy transparent [ x id ] with_strategy transparent [ id ] with_strategy transparent [ id x ] with_strategy transparent [ id id ] with_strategy transparent [ id id x ] with_strategy transparent [ id ] with_strategy transparent [ id x ] with_strategy transparent [ id id ] with_strategy transparent [ id id x ] idtac Ltac FE.withstrategy l x := let idx := smart_global:(FE.id) in let tl := strategy_level:(transparent) in with_strategy 1 [ FE.id FE.id ] with_strategy l [ FE.id FE.id ] with_strategy tl [ FE.id FE.id ] with_strategy transparent [ FE.id FE.id ] with_strategy transparent [ FE.id FE.id ] with_strategy opaque [ FE.id FE.id ] with_strategy expand [ FE.id FE.id ] with_strategy transparent [ idx ] with_strategy transparent [ FE.id x ] with_strategy transparent [ x FE.id ] with_strategy transparent [ FE.id ] with_strategy transparent [ FE.id x ] with_strategy transparent [ FE.id FE.id ] with_strategy transparent [ FE.id FE.id x ] with_strategy transparent [ FE.id ] with_strategy transparent [ FE.id x ] with_strategy transparent [ FE.id FE.id ] with_strategy transparent [ FE.id FE.id x ] idtac coq-8.20.0/test-suite/output/print_ltac.v000066400000000000000000000044561466560755400204120ustar00rootroot00000000000000(* Testing of various things about Print Ltac *) (* https://github.com/coq/coq/issues/10971 *) Ltac t1 := time "my tactic" idtac. Print Ltac t1. Ltac t2 := let x := string:("my tactic") in idtac x. Print Ltac t2. Tactic Notation "idtacstr" string(str) := idtac str. Ltac t3 := idtacstr "my tactic". Print Ltac t3. (* https://github.com/coq/coq/issues/9716 *) Ltac t4 x := match x with ?A => constr:((A, A)) end. Print Ltac t4. Notation idnat := (@id nat). Notation idn := id. Notation idan := (@id). Fail Strategy transparent [idnat]. Strategy transparent [idn]. Strategy transparent [idan]. Ltac withstrategy l x := let idx := smart_global:(id) in let tl := strategy_level:(transparent) in with_strategy 1 [id id] ( with_strategy l [id id] ( with_strategy tl [id id] ( with_strategy 0 [id id] ( with_strategy transparent [id id] ( with_strategy opaque [id id] ( with_strategy expand [id id] ( with_strategy 0 [idx] ( with_strategy 0 [id x] ( with_strategy 0 [x id] ( with_strategy 0 [idn] ( with_strategy 0 [idn x] ( with_strategy 0 [idn id] ( with_strategy 0 [idn id x] ( with_strategy 0 [idan] ( with_strategy 0 [idan x] ( with_strategy 0 [idan id] ( with_strategy 0 [idan id x] ( idtac )))))))))))))))))). Print Ltac withstrategy. Module Type Empty. End Empty. Module E. End E. Module F (E : Empty). Definition id {T} := @id T. Notation idnat := (@id nat). Notation idn := id. Notation idan := (@id). Fail Strategy transparent [idnat]. Strategy transparent [idn]. Strategy transparent [idan]. Ltac withstrategy l x := let idx := smart_global:(id) in let tl := strategy_level:(transparent) in with_strategy 1 [id id] ( with_strategy l [id id] ( with_strategy tl [id id] ( with_strategy 0 [id id] ( with_strategy transparent [id id] ( with_strategy opaque [id id] ( with_strategy expand [id id] ( with_strategy 0 [idx] ( with_strategy 0 [id x] ( with_strategy 0 [x id] ( with_strategy 0 [idn] ( with_strategy 0 [idn x] ( with_strategy 0 [idn id] ( with_strategy 0 [idn id x] ( with_strategy 0 [idan] ( with_strategy 0 [idan x] ( with_strategy 0 [idan id] ( with_strategy 0 [idan id x] ( idtac )))))))))))))))))). Print Ltac withstrategy. End F. Module FE := F E. Print Ltac FE.withstrategy. coq-8.20.0/test-suite/output/qualification.out000066400000000000000000000004011466560755400214270ustar00rootroot00000000000000File "./output/qualification.v", line 20, characters 0-7: Error: Signature components for field test do not match: expected type "qualification.M2.t = qualification.M2.M.t" but found type "qualification.M2.t = qualification.M2.t". coqc exited with code 1 coq-8.20.0/test-suite/output/qualification.v000066400000000000000000000005621466560755400210750ustar00rootroot00000000000000(* coq-prog-args: ("-top" "qualification") *) Module Type T1. Parameter t : Type. End T1. Module Type T2. Declare Module M : T1. Parameter t : Type. Parameter test : t = M.t. End T2. Module M1 <: T1. Definition t : Type := bool. End M1. Module M2 <: T2. Module M := M1. Definition t : Type := nat. Lemma test : t = t. Proof. reflexivity. Qed. End M2. coq-8.20.0/test-suite/output/reduction.out000066400000000000000000000023071466560755400206020ustar00rootroot00000000000000 = a : nat = n + 0 : nat = S (1 + 2) : nat = S (1 + 2) : nat = S ((fix add (n m : nat) {struct n} : nat := match n with | 0 => m | S p => S (add p m) end) 1 2) : nat = 4 : nat = (fix add (n m : nat) {struct n} : nat := match n with | 0 => m | S p => S (add p m) end) 2 2 : nat = S (1 + (2 + 2)) : nat = S (1 + 2 + 2) : nat = 6 : nat = ignore (fun x : nat => 1 + x) : unit = ignore (fun x : nat => 1 + x) : unit = ignore (fun x : nat => 1 + x) : unit = ignore (fun x : nat => 1 + x) : unit - : constr = constr:(4) - : constr = constr:(2 + 2) = let x := 2 in 2 + 2 : nat = let x := 2 in 4 : nat = (let x := 2 in fun x0 : nat => 1 + x0) 2 : nat = match n with | 0 => 1 + 1 | S n => 1 + n end : nat = fix f (n : nat) : nat := match 0 + n with | 0 => 1 + 1 | S n0 => 1 + f n0 end : nat -> nat = 4%uint63 : int = (2 + x)%uint63 : int = 1%float : float coq-8.20.0/test-suite/output/reduction.v000066400000000000000000000027301466560755400202400ustar00rootroot00000000000000(* Test the behaviour of hnf and simpl introduced in revision *) Parameter n:nat. Definition a:=0. Eval simpl in (fix plus (n m : nat) {struct n} : nat := match n with | 0 => m | S p => S (p + m) end) a a. Eval hnf in match (plus (S n) O) with S n => n | _ => O end. Eval simpl head in 2 + 2. Eval cbn head in 2 + 2. Eval lazy head in 2 + 2. Eval cbv head in 2 + 2. Eval lazy head delta in 2 + 2. Eval simpl head in 2 + (2 + 2). Eval simpl head in (2 + 2) + 2. Eval cbv head in (2 + 2) + 2. Axiom ignore : forall {T}, T -> unit. Eval simpl head in ignore (fun x => 1 + x). Eval cbn head in ignore (fun x => 1 + x). Eval lazy head in ignore (fun x => 1 + x). Eval cbv head in ignore (fun x => 1 + x). Require Import Ltac2.Ltac2. Ltac2 Eval eval lazy in (2 + 2). Ltac2 Eval eval lazy head in (2 + 2). (* Cbv examples *) Eval cbv head beta delta iota in let x := 1 + 1 in 2 + 2. (* not fully clear what head w/o zeta should be *) Eval cbv beta delta iota in let x := 1 + 1 in 2 + 2. (* not fully clear what head w/o zeta should be *) Eval cbv head beta delta iota in (let x := 1 + 1 in fun x => 1 + x) 2. (* not fully clear whether we should apply commutative cuts or not *) Eval cbv head in match 0 + n with 0 => 1 + 1 | S n => 1 + n end. Eval cbv head in fix f n := match 0 + n with 0 => 1 + 1 | S n => 1 + f n end. Require Import Uint63. Eval cbv head in (2+2)%uint63. Parameter x:int. Eval cbv head in (2+x)%uint63. Require Import Floats. Eval cbv head in (0x1p+0)%float. coq-8.20.0/test-suite/output/relaxed_ambiguous_paths.out000066400000000000000000000061001466560755400234770ustar00rootroot00000000000000File "./output/relaxed_ambiguous_paths.v", line 13, characters 0-29: Warning: New coercion path [g1; f2] : A >-> B' is ambiguous with existing [f1; g2] : A >-> B'. [ambiguous-paths,coercions,default] File "./output/relaxed_ambiguous_paths.v", line 14, characters 0-29: Warning: New coercion path [h1; f3] : B >-> C' is ambiguous with existing [f2; h2] : B >-> C'. [ambiguous-paths,coercions,default] [f1] : A >-> A' [g1] : A >-> B [f1; g2] : A >-> B' [g1; h1] : A >-> C [f1; g2; h2] : A >-> C' [g2] : A' >-> B' [g2; h2] : A' >-> C' [f2] : B >-> B' [h1] : B >-> C [f2; h2] : B >-> C' [h2] : B' >-> C' [f3] : C >-> C' [reverse_coercion] : ReverseCoercionSource >-> ReverseCoercionTarget File "./output/relaxed_ambiguous_paths.v", line 33, characters 0-28: Warning: New coercion path [ab; bc] : A >-> C is ambiguous with existing [ac] : A >-> C. [ambiguous-paths,coercions,default] [ab] : A >-> B [ac] : A >-> C [ac; cd] : A >-> D [bc] : B >-> C [bc; cd] : B >-> D [cd] : C >-> D [reverse_coercion] : ReverseCoercionSource >-> ReverseCoercionTarget File "./output/relaxed_ambiguous_paths.v", line 50, characters 0-28: Warning: New coercion path [ab; bc] : A >-> C is ambiguous with existing [ac] : A >-> C. [ambiguous-paths,coercions,default] File "./output/relaxed_ambiguous_paths.v", line 51, characters 0-28: Warning: New coercion path [ba; ab] : B >-> B is not definitionally an identity function. New coercion path [ab; ba] : A >-> A is not definitionally an identity function. [ambiguous-paths,coercions,default] [ab] : A >-> B [ac] : A >-> C [ba] : B >-> A [bc] : B >-> C [reverse_coercion] : ReverseCoercionSource >-> ReverseCoercionTarget [reverse_coercion] : ReverseCoercionSource >-> ReverseCoercionTarget [B_A] : B >-> A [C_A] : C >-> A [D_A] : D >-> A [D_B] : D >-> B [D_C] : D >-> C [A'_A] : A' >-> A [reverse_coercion] : ReverseCoercionSource >-> ReverseCoercionTarget [B_A'; A'_A] : B >-> A [B_A'] : B >-> A' [C_A'; A'_A] : C >-> A [C_A'] : C >-> A' [D_A] : D >-> A [D_B; B_A'] : D >-> A' [D_B] : D >-> B [D_C] : D >-> C File "./output/relaxed_ambiguous_paths.v", line 147, characters 0-86: Warning: New coercion path [D_C; C_A'] : D >-> A' is ambiguous with existing [D_B; B_A'] : D >-> A'. [ambiguous-paths,coercions,default] [reverse_coercion] : ReverseCoercionSource >-> ReverseCoercionTarget [A'_A] : A' >-> A [B_A'; A'_A] : B >-> A [B_A'] : B >-> A' [C_A'; A'_A] : C >-> A [C_A'] : C >-> A' [D_A] : D >-> A [D_B; B_A'] : D >-> A' [D_B] : D >-> B [D_C] : D >-> C File "./output/relaxed_ambiguous_paths.v", line 156, characters 0-47: Warning: New coercion path [unwrap_nat; wrap_nat] : NAT >-> NAT is not definitionally an identity function. [ambiguous-paths,coercions,default] File "./output/relaxed_ambiguous_paths.v", line 157, characters 0-64: Warning: New coercion path [unwrap_list; wrap_list] : LIST >-> LIST is not definitionally an identity function. [ambiguous-paths,coercions,default] File "./output/relaxed_ambiguous_paths.v", line 158, characters 0-51: Warning: New coercion path [unwrap_Type; wrap_Type] : TYPE >-> TYPE is not definitionally an identity function. [ambiguous-paths,coercions,default] coq-8.20.0/test-suite/output/relaxed_ambiguous_paths.v000066400000000000000000000072701466560755400231460ustar00rootroot00000000000000Module test1. Section test1. Variable (A B C A' B' C' : Type). Variable (f1 : A -> A') (f2 : B -> B') (f3 : C -> C'). Variable (g1 : A -> B) (g2 : A' -> B') (h1 : B -> C) (h2 : B' -> C'). Local Coercion g1 : A >-> B. Local Coercion g2 : A' >-> B'. Local Coercion h1 : B >-> C. Local Coercion h2 : B' >-> C'. Local Coercion f1 : A >-> A'. Local Coercion f2 : B >-> B'. Local Coercion f3 : C >-> C'. (* [g1; h1; f3], [f1; g2; h2] : A >-> C' should not be reported as ambiguous *) (* paths because they are redundant with `[g1; f2], [f1; g2] : A >-> B'` and *) (* `[h1; f3], [f2; h2] : B >-> C'`. *) Print Graph. End test1. End test1. Module test2. Section test2. Variable (A B C D : Type). Variable (ab : A -> B) (bc : B -> C) (ac : A -> C) (cd : C -> D). Local Coercion ac : A >-> C. Local Coercion cd : C >-> D. Local Coercion ab : A >-> B. Local Coercion bc : B >-> C. (* `[ab; bc; cd], [ac; cd] : A >-> D` should not be reported as ambiguous *) (* paths because they are redundant with `[ab; bc], [ac] : A >-> C`. *) Print Graph. End test2. End test2. Module test3. Section test3. Variable (A B C : Type). Variable (ab : A -> B) (ba : B -> A) (ac : A -> C) (bc : B -> C). Local Coercion ac : A >-> C. Local Coercion bc : B >-> C. Local Coercion ab : A >-> B. Local Coercion ba : B >-> A. (* `[ba; ac], [bc] : B >-> C` should not be reported as ambiguous paths *) (* because they are redundant with `[ab; bc], [ac] : A >-> C` and *) (* `[ba; ab] : B >-> B`. *) Print Graph. End test3. End test3. Module test4. Section test4. Variable (A : Type) (P Q : A -> Prop). Record B := { B_A : A; B_P : P B_A }. Record C := { C_A : A; C_Q : Q C_A }. Record D := { D_A : A; D_P : P D_A; D_Q : Q D_A }. Local Coercion B_A : B >-> A. Local Coercion C_A : C >-> A. Local Coercion D_A : D >-> A. Local Coercion D_B (d : D) : B := Build_B (D_A d) (D_P d). Local Coercion D_C (d : D) : C := Build_C (D_A d) (D_Q d). Print Graph. End test4. End test4. Module test5. Section test5. Variable (A : Type) (P Q : A -> Prop). Definition A' (x : bool) := A. Record B (x : bool) := { B_A' : A' x; B_P : P B_A' }. Record C (x : bool) := { C_A' : A' x; C_Q : Q C_A' }. Record D := { D_A : A; D_P : P D_A; D_Q : Q D_A }. Local Coercion A'_A (x : bool) (a : A' x) : A := a. Local Coercion B_A' : B >-> A'. Local Coercion C_A' : C >-> A'. Local Coercion D_A : D >-> A. Local Coercion D_B (d : D) : B false := Build_B false (D_A d) (D_P d). Local Coercion D_C (d : D) : C true := Build_C true (D_A d) (D_Q d). Print Graph. End test5. End test5. Module test6. Section test6. Variable (A : Type) (P Q : A -> Prop). Record A' (x : bool) := { A'_A : A }. Record B (x : bool) := { B_A' : A' x; B_P : P (A'_A x B_A') }. Record C (x : bool) := { C_A' : A' x; C_Q : Q (A'_A x C_A') }. Record D := { D_A : A; D_P : P D_A; D_Q : Q D_A }. Local Coercion A'_A : A' >-> A. Local Coercion B_A' : B >-> A'. Local Coercion C_A' : C >-> A'. Local Coercion D_A : D >-> A. Local Coercion D_B (d : D) : B false := Build_B false (Build_A' false (D_A d)) (D_P d). Local Coercion D_C (d : D) : C true := Build_C true (Build_A' true (D_A d)) (D_Q d). Print Graph. End test6. End test6. Module test7. Record > NAT := wrap_nat { unwrap_nat :> nat }. Record > LIST (T : Type) := wrap_list { unwrap_list :> list T }. Record > TYPE := wrap_Type { unwrap_Type :> Type }. End test7. Module test8. Set Primitive Projections. Record > NAT_prim := wrap_nat { unwrap_nat :> nat }. Record > LIST_prim (T : Type) := wrap_list { unwrap_list :> list T }. Record > TYPE_prim := wrap_Type { unwrap_Type :> Type }. End test8. coq-8.20.0/test-suite/output/reverse_coercions.out000066400000000000000000000001501466560755400223170ustar00rootroot00000000000000nat : S : S reverse_coercion S_nat nat : S : S @reverse_coercion S Set S_nat nat : S : S coq-8.20.0/test-suite/output/reverse_coercions.v000066400000000000000000000003231466560755400217570ustar00rootroot00000000000000Structure S := { ssort :> Type; sstuff : ssort; }. Canonical Structure S_nat := {| ssort := nat; sstuff := 0; |}. Check nat : S. Set Printing Coercions. Check nat : S. Set Printing All. Check nat : S. coq-8.20.0/test-suite/output/rewrite_2172.out000066400000000000000000000002251466560755400207370ustar00rootroot00000000000000File "./output/rewrite_2172.v", line 21, characters 7-23: The command has indeed failed with message: Unable to find an instance for the variable E. coq-8.20.0/test-suite/output/rewrite_2172.v000066400000000000000000000013451466560755400204010ustar00rootroot00000000000000(* This checks an error message as reported in bug #2172 *) Axiom axiom : forall (E F : nat), E = F. Lemma test : forall (E F : nat), E = F. Proof. intros. (* This used to raise the following non understandable error message: Error: Unable to find an instance for the variable x The reason this error was that rewrite generated the proof "eq_ind ?A ?x ?P ? ?y (axiom ?E ?F)" and the equation ?x=?E was solved in the way ?E:=?x leaving ?x unresolved. A stupid hack for solve this consisted in ordering meta=meta equations the other way round (with most recent evars instantiated first - since they are assumed to come first from the user in rewrite/induction/destruct calls). *) Fail rewrite <- axiom. Abort. coq-8.20.0/test-suite/output/rewrite_strat.out000066400000000000000000000022101466560755400214750ustar00rootroot00000000000000Ltac k1 := rewrite_strat subterms id; choice (subterm fail) fail; fail Ltac k2 := rewrite_strat subterms id; choice (subterm fail) fail; fail Ltac k3 := rewrite_strat subterms id; (choice (subterm fail) fail; fail) Ltac k4 := rewrite_strat subterms (id; choice (subterm fail) fail; fail) Ltac k5 := rewrite_strat subterms subterms fail; subterms subterms fail; choice (subterms try fail; subterms repeat fail) Ltac mytry rewstrategy1 := rewrite_strat choice (rewstrategy1) id Ltac myany rewstrategy1 := rewrite_strat fix fixident := try (rewstrategy1; fixident) Ltac myrepeat rewstrategy1 := rewrite_strat rewstrategy1; any rewstrategy1 Ltac mybottomup rewstrategy1 := rewrite_strat fix fixident := (choice (progress subterms fixident) (rewstrategy1); try fixident) Ltac mytopdown rewstrategy1 := rewrite_strat fix fixident := (choice (rewstrategy1) (progress subterms fixident); try fixident) Ltac myinnermost rewstrategy1 := rewrite_strat fix fixident := choice (subterm fixident) (rewstrategy1) Ltac myoutermost rewstrategy1 := rewrite_strat fix fixident := choice (rewstrategy1) (subterm fixident) coq-8.20.0/test-suite/output/rewrite_strat.v000066400000000000000000000025121466560755400211400ustar00rootroot00000000000000Ltac k1 := rewrite_strat (subterms id; (choice (subterm fail) fail)); fail. Print Ltac k1. Ltac k2 := rewrite_strat subterms id; (choice (subterm fail) fail); fail. Print Ltac k2. Ltac k3 := rewrite_strat subterms id; ((choice (subterm fail) fail); fail). Print Ltac k3. Ltac k4 := rewrite_strat subterms (id; choice (subterm fail) fail; fail). Print Ltac k4. Ltac k5 := rewrite_strat (subterms subterms fail; subterms subterms fail); choice (subterms try fail; subterms repeat fail). Print Ltac k5. Ltac mytry rewstrategy1 := rewrite_strat choice (rewstrategy1) id. Print Ltac mytry. Ltac myany rewstrategy1 := rewrite_strat fix fixident := try (rewstrategy1 ; fixident). Print Ltac myany. Ltac myrepeat rewstrategy1 := rewrite_strat (rewstrategy1; any rewstrategy1). Print Ltac myrepeat. Ltac mybottomup rewstrategy1 := rewrite_strat fix fixident := (choice (progress subterms fixident) (rewstrategy1) ; try fixident). Print Ltac mybottomup. Ltac mytopdown rewstrategy1 := rewrite_strat fix fixident := (choice (rewstrategy1) (progress subterms fixident) ; try fixident). Print Ltac mytopdown. Ltac myinnermost rewstrategy1 := rewrite_strat fix fixident := choice (subterm fixident) (rewstrategy1). Print Ltac myinnermost. Ltac myoutermost rewstrategy1 := rewrite_strat fix fixident := choice (rewstrategy1) (subterm fixident). Print Ltac myoutermost. coq-8.20.0/test-suite/output/section_have.out000066400000000000000000000002021466560755400212450ustar00rootroot00000000000000toto = ssr_have I (fun y : True => conj y y) : True /\ True toto = ssr_have I (fun y : True => conj y y) : True /\ True coq-8.20.0/test-suite/output/section_have.v000066400000000000000000000002511466560755400207070ustar00rootroot00000000000000Require Import ssreflect. Section Foo. Variable x : nat. Lemma toto : True /\ True. Proof. have y : True by []. by split. Qed. Print toto. End Foo. Print toto. coq-8.20.0/test-suite/output/set.out000066400000000000000000000004131466560755400173750ustar00rootroot000000000000001 goal y1 := 0 : nat x := 0 + 0 : nat ============================ x = x 1 goal y1, y2 := 0 : nat x := y2 + 0 : nat ============================ x = x 1 goal y1, y2, y3 := 0 : nat x := y2 + y3 : nat ============================ x = x coq-8.20.0/test-suite/output/set.v000066400000000000000000000002321466560755400170320ustar00rootroot00000000000000Goal let x:=O+O in x=x. intro. set (y1:=O) in (type of x). Show. set (y2:=O) in (value of x) at 1. Show. set (y3:=O) in (value of x). Show. trivial. Qed. coq-8.20.0/test-suite/output/signatureT.out000066400000000000000000000000001466560755400207170ustar00rootroot00000000000000coq-8.20.0/test-suite/output/signatureT.v000066400000000000000000000000531466560755400203650ustar00rootroot00000000000000From Coq Require Import Setoid CMorphisms. coq-8.20.0/test-suite/output/simpl.out000066400000000000000000000134661466560755400177420ustar00rootroot000000000000001 goal x : nat ============================ x = S x 1 goal x : nat ============================ 0 + x = S x 1 goal x : nat ============================ x = 1 + x "** NonRecursiveDefinition" : string = true : bool = true : bool = true : bool = true && true : bool = true && true : bool = true : bool "** RecursiveDefinition" : string = 0 : nat = 0 : nat = 0 : nat = 0 + 0 : nat = 0 + 0 : nat = 0 + 0 : nat "** NonPrimitiveProjection" : string "DirectTuple (NonPrimitiveProjection)" : string = 0 : nat = 0 : nat = 0 : nat = TUPLE.(p) : nat = TUPLE.(p) : nat = 0 : nat "NamedTuple (NonPrimitiveProjection)" : string = 0 : nat = 0 : nat = 0 : nat = a.(p) : nat = a.(p) : nat = 0 : nat = 0 : nat = a.(p) : nat = 0 : nat "DirectCoFix (NonPrimitiveProjection)" : string = COFIX : U = COFIX : U = COFIX : U = COFIX.(p) : U = COFIX.(p) : U = COFIX : U "NamedCoFix (NonPrimitiveProjection)" : string = a : U = a : U = a : U = a.(p) : U = a.(p) : U = a : U = a : U = a.(p) : U = a : U "** PrimitiveProjectionFolded" : string "DirectTuple (PrimitiveProjectionFolded)" : string = 0 : nat = 0 : nat = 0 : nat = TUPLE.(p) : nat = TUPLE.(p) : nat = 0 : nat "NamedTuple (PrimitiveProjectionFolded)" : string = 0 : nat = 0 : nat = 0 : nat = a.(p) : nat = a.(p) : nat = 0 : nat = 0 : nat = a.(p) : nat = 0 : nat "DirectCoFix (PrimitiveProjectionFolded)" : string = COFIX : U = COFIX : U = COFIX : U = COFIX.(p) : U = COFIX.(p) : U = COFIX : U "NamedCoFix (PrimitiveProjectionFolded)" : string = a : U = a : U = a : U = a.(p) : U = a.(p) : U = a : U = a : U = a.(p) : U = a : U "** PrimitiveProjectionUnfolded" : string "DirectTuple (PrimitiveProjectionUnfolded)" : string 1 goal ============================ P 0 1 goal ============================ P 0 1 goal ============================ P 0 1 goal ============================ P 0 1 goal ============================ P {| p := 0 |}.(p) 1 goal ============================ P 0 "NamedTuple (PrimitiveProjectionUnfolded)" : string 1 goal ============================ P 0 1 goal ============================ P 0 1 goal ============================ P a.(p) 1 goal ============================ P 0 1 goal ============================ P a.(p) 1 goal ============================ P a.(p) 1 goal ============================ P 0 1 goal ============================ P a.(p) 1 goal ============================ P a.(p) "DirectCoFix (PrimitiveProjectionUnfolded)" : string 1 goal ============================ P COFIX 1 goal ============================ P COFIX 1 goal ============================ P COFIX 1 goal ============================ P COFIX 1 goal ============================ P COFIX.(q) 1 goal ============================ P COFIX "NamedCoFix (PrimitiveProjectionUnfolded)" : string 1 goal ============================ P a 1 goal ============================ P a 1 goal ============================ P a.(q) 1 goal ============================ P a 1 goal ============================ P a.(q) 1 goal ============================ P a.(q) 1 goal ============================ P a 1 goal ============================ P a.(q) 1 goal ============================ P a.(q) "** PrimitiveProjectionConstant" : string "DirectTuple (PrimitiveProjectionConstant)" : string 1 goal ============================ P 0 1 goal ============================ P 0 1 goal ============================ P TUPLE.(p) 1 goal ============================ P TUPLE.(p) 1 goal ============================ P TUPLE.(p) 1 goal ============================ P TUPLE.(p) "NamedTuple (PrimitiveProjectionConstant)" : string 1 goal ============================ P 0 1 goal ============================ P 0 1 goal ============================ P a.(p) 1 goal ============================ P a.(p) 1 goal ============================ P a.(p) 1 goal ============================ P a.(p) 1 goal ============================ P 0 1 goal ============================ P a.(p) 1 goal ============================ P a.(p) "DirectCoFix (PrimitiveProjectionConstant)" : string 1 goal ============================ P COFIX 1 goal ============================ P COFIX 1 goal ============================ P COFIX.(q) 1 goal ============================ P COFIX.(q) 1 goal ============================ P COFIX.(q) 1 goal ============================ P COFIX.(q) "NamedCoFix (PrimitiveProjectionConstant)" : string 1 goal ============================ P a 1 goal ============================ P a 1 goal ============================ P a.(q) 1 goal ============================ P a.(q) 1 goal ============================ P a.(q) 1 goal ============================ P a.(q) 1 goal ============================ P a 1 goal ============================ P a.(q) 1 goal ============================ P a.(q) coq-8.20.0/test-suite/output/simpl.v000066400000000000000000000272631466560755400174000ustar00rootroot00000000000000(* Simpl with patterns *) Goal forall x, 0+x = 1+x. intro x. simpl (_ + x). Show. change (0+x = 1+x). simpl (_ + x) at 2. Show. change (0+x = 1+x). simpl (0 + _). Show. Abort. Require Import String. Open Scope string_scope. Module NonRecursiveDefinition. Check "** NonRecursiveDefinition". Open Scope bool_scope. Eval simpl in true && true. (* -> true *) Eval cbn in true && true. (* -> true *) Eval hnf in true && true. (* -> true *) Arguments andb : simpl never. Eval simpl in true && true. (* -> true && true *) Eval cbn in true && true. (* -> true && true *) Eval hnf in true && true. (* -> true *) End NonRecursiveDefinition. Module RecursiveDefinition. Check "** RecursiveDefinition". Eval simpl in 0 + 0. (* -> 0 *) Eval cbn in 0 + 0. (* -> 0 *) Eval hnf in 0 + 0. (* -> 0 *) Arguments Nat.add : simpl never. Eval simpl in 0 + 0. (* -> 0 + 0 *) Eval cbn in 0 + 0. (* -> 0 + 0 *) Eval hnf in 0 + 0. (* -> 0 + 0 *) (* hnf modified by simpl never, bug never 2 *) End RecursiveDefinition. Set Printing Projections. Module NonPrimitiveProjection. Check "** NonPrimitiveProjection". Module DirectTuple. Check "DirectTuple (NonPrimitiveProjection)". Record T := {p:nat}. Notation TUPLE := {|p:=0|}. Eval simpl in TUPLE.(p). (* -> 0 *) Eval cbn in TUPLE.(p). (* -> 0 *) Eval hnf in TUPLE.(p). (* -> 0 *) Arguments p : simpl never. Eval simpl in TUPLE.(p). (* -> TUPLE.(p) *) Eval cbn in TUPLE.(p). (* -> TUPLE.(p) *) Eval hnf in TUPLE.(p). (* -> 0 *) End DirectTuple. Module NamedTuple. Check "NamedTuple (NonPrimitiveProjection)". Record T := {p:nat}. Definition a := {|p:=0|}. Eval simpl in a.(p). (* -> 0 *) Eval cbn in a.(p). (* -> 0 *) Eval hnf in a.(p). (* -> 0 *) Arguments p : simpl never. Eval simpl in a.(p). (* -> a.(p) *) Eval cbn in a.(p). (* -> a.(p) *) Eval hnf in a.(p). (* -> 0 *) Arguments p : simpl nomatch. Arguments a : simpl never. Eval simpl in a.(p). (* -> 0 *) (* never not respected on purpose [*] *) Eval cbn in a.(p). (* -> a.(p) *) Eval hnf in a.(p). (* -> 0 *) End NamedTuple. (* [*] Enrico: https://github.com/coq/coq/pull/18581#issuecomment-1914325999 *) Module DirectCoFix. Check "DirectCoFix (NonPrimitiveProjection)". CoInductive U := {p:U}. Notation COFIX := (cofix a := {|p:=a|}). Eval simpl in COFIX.(p). (* -> COFIX *) Eval cbn in COFIX.(p). (* -> COFIX *) Eval hnf in COFIX.(p). (* -> COFIX *) Arguments p : simpl never. Eval simpl in COFIX.(p). (* -> COFIX.(p) *) Eval cbn in COFIX.(p). (* -> COFIX.(p) *) Eval hnf in COFIX.(p). (* -> COFIX *) End DirectCoFix. Module NamedCoFix. Check "NamedCoFix (NonPrimitiveProjection)". CoInductive U := {p:U}. CoFixpoint a := {|p:=a|}. Eval simpl in a.(p). (* -> a *) Eval cbn in a.(p). (* -> a *) Eval hnf in a.(p). (* -> a *) Arguments p : simpl never. Eval simpl in a.(p). (* -> a.(p) *) Eval cbn in a.(p). (* -> a.(p) *) Eval hnf in a.(p). (* -> a *) Arguments p : simpl nomatch. Arguments a : simpl never. Eval simpl in a.(p). (* -> a *) (* never not respected on purpose *) Eval cbn in a.(p). (* -> a.(p) *) Eval hnf in a.(p). (* -> a *) End NamedCoFix. End NonPrimitiveProjection. Module PrimitiveProjectionFolded. Check "** PrimitiveProjectionFolded". Set Primitive Projections. Module DirectTuple. Check "DirectTuple (PrimitiveProjectionFolded)". Record T := {p:nat}. Notation TUPLE := {|p:=0|}. Eval simpl in TUPLE.(p). (* -> 0 *) Eval cbn in TUPLE.(p). (* -> 0 *) Eval hnf in TUPLE.(p). (* -> 0 *) Arguments p : simpl never. Eval simpl in TUPLE.(p). (* -> TUPLE.(p) *) Eval cbn in TUPLE.(p). (* -> TUPLE.(p) *) Eval hnf in TUPLE.(p). (* -> 0 *) End DirectTuple. Module NamedTuple. Check "NamedTuple (PrimitiveProjectionFolded)". Record T := {p:nat}. Definition a := {|p:=0|}. Eval simpl in a.(p). (* -> 0 *) Eval cbn in a.(p). (* -> 0 *) Eval hnf in a.(p). (* -> 0 *) Arguments p : simpl never. Eval simpl in a.(p). (* -> a.(p) *) Eval cbn in a.(p). (* -> a.(p) *) Eval hnf in a.(p). (* -> 0 *) Arguments p : simpl nomatch. Arguments a : simpl never. Eval simpl in a.(p). (* -> ) *) (* never not respected on purpose *) Eval cbn in a.(p). (* -> a.(p) *) Eval hnf in a.(p). (* -> 0 *) End NamedTuple. Module DirectCoFix. Check "DirectCoFix (PrimitiveProjectionFolded)". CoInductive U := {p:U}. Notation COFIX := (cofix a := {|p:=a|}). Eval simpl in COFIX.(p). (* -> COFIX *) Eval cbn in COFIX.(p). (* -> COFIX *) Eval hnf in COFIX.(p). (* -> COFIX *) Arguments p : simpl never. Eval simpl in COFIX.(p). (* -> COFIX.(p) *) Eval cbn in COFIX.(p). (* -> COFIX.(p) *) Eval hnf in COFIX.(p). (* -> COFIX *) End DirectCoFix. Module NamedCoFix. Check "NamedCoFix (PrimitiveProjectionFolded)". CoInductive U := {p:U}. CoFixpoint a := {|p:=a|}. Eval simpl in a.(p). (* -> a *) Eval cbn in a.(p). (* -> a *) Eval hnf in a.(p). (* -> a *) Arguments p : simpl never. Eval simpl in a.(p). (* -> a.(p) *) Eval cbn in a.(p). (* -> a.(p) *) Eval hnf in a.(p). (* -> a *) Arguments p : simpl nomatch. Arguments a : simpl never. Eval simpl in a.(p). (* -> a *) (* never not respected on purpose *) Eval cbn in a.(p). (* -> a.(p) *) Eval hnf in a.(p). (* -> a *) End NamedCoFix. End PrimitiveProjectionFolded. Module PrimitiveProjectionUnfolded. Check "** PrimitiveProjectionUnfolded". (* we use an unfold trick to create an unfolded projection *) Set Primitive Projections. Module DirectTuple. Check "DirectTuple (PrimitiveProjectionUnfolded)". Record T := {p:nat}. Definition a := {|p:=0|}. Axiom P : nat -> Prop. Goal P a.(p). unfold p. cbv delta [a]. simpl. Show. Abort. (* -> 0 *) Goal P a.(p). unfold p. cbv delta [a]. cbn. Show. Abort. (* -> 0 *) Goal P a.(p). unfold p. cbv delta [a]. hnf. Show. Abort. (* -> 0 *) Arguments p : simpl never. Goal P a.(p). unfold p. cbv delta [a]. simpl. Show. Abort. (* -> 0 *) (* bug never 3 *) Goal P a.(p). unfold p. cbv delta [a]. cbn. Show. Abort. (* -> {| p := 0 |}.(p) *) Goal P a.(p). unfold p. cbv delta [a]. hnf. Show. Abort. (* -> 0 *) End DirectTuple. Module NamedTuple. Check "NamedTuple (PrimitiveProjectionUnfolded)". Record T := {p:nat}. Definition a := {|p:=0|}. Axiom P : nat -> Prop. Goal P a.(p). unfold p. simpl. Show. Abort. (* -> 0 *) Goal P a.(p). unfold p. cbn. Show. Abort. (* -> 0 *) Goal P a.(p). unfold p. hnf. Show. Abort. (* -> a.(p) *) (* bug primproj 2 *) Arguments p : simpl never. Goal P a.(p). unfold p. simpl. Show. Abort. (* -> 0 *) (* bug never 3 *) Goal P a.(p). unfold p. cbn. Show. Abort. (* -> a.(p) *) Goal P a.(p). unfold p. hnf. Show. Abort. (* -> a.(p) *) (* bug primproj 2 *) Arguments p : simpl nomatch. Arguments a : simpl never. Goal P a.(p). unfold p. simpl. Show. Abort. (* -> 0 *) (* bug never 1 *) Goal P a.(p). unfold p. cbn. Show. Abort. (* -> a.(p) *) Goal P a.(p). unfold p. hnf. Show. Abort. (* -> a.(p) *) (* bug primproj 2 *) End NamedTuple. Module DirectCoFix. Check "DirectCoFix (PrimitiveProjectionUnfolded)". CoInductive U := {q:U}. CoFixpoint a := {|q:=a|}. Notation COFIX := (cofix a := {|q:=a|}). Axiom P : U -> Prop. Goal P a.(q). unfold q. cbv delta [a]. simpl. Show. Abort. (* -> COFIX *) Goal P a.(q). unfold q. cbv delta [a]. cbn. Show. Abort. (* -> COFIX *) Goal P a.(q). unfold q. cbv delta [a]. hnf. Show. Abort. (* -> COFIX *) Arguments q : simpl never. Goal P a.(q). unfold q. cbv delta [a]. simpl. Show. Abort. (* -> COFIX *) (* never not respected on purpose *) Goal P a.(q). unfold q. cbv delta [a]. cbn. Show. Abort. (* -> COFIX.(q) *) Goal P a.(q). unfold q. cbv delta [a]. hnf. Show. Abort. (* -> COFIX *) End DirectCoFix. Module NamedCoFix. Check "NamedCoFix (PrimitiveProjectionUnfolded)". CoInductive U := {q:U}. CoFixpoint a := {|q:=a|}. Notation COFIX := (cofix a := {|q:=a|}). Axiom P : U -> Prop. Goal P a.(q). unfold q. simpl. Show. Abort. (* -> a *) Goal P a.(q). unfold q. cbn. Show. Abort. (* -> a *) Goal P a.(q). unfold q. hnf. Show. Abort. (* -> a.(q) *) (* bug primproj 4 *) Arguments q : simpl never. Goal P a.(q). unfold q. simpl. Show. Abort. (* -> a *) Goal P a.(q). unfold q. cbn. Show. Abort. (* -> a.(q) *) Goal P a.(q). unfold q. hnf. Show. Abort. (* -> a.(q) *) (* bug primproj 4 *) Arguments q : simpl nomatch. Arguments a : simpl never. Goal P a.(q). unfold q. simpl. Show. Abort. (* -> a *) Goal P a.(q). unfold q. cbn. Show. Abort. (* -> a.(q) *) Goal P a.(q). unfold q. hnf. Show. Abort. (* -> a.(q) *) (* bug primproj 4 *) End NamedCoFix. End PrimitiveProjectionUnfolded. Module PrimitiveProjectionConstant. Check "** PrimitiveProjectionConstant". (* we use a partial application to create a projection constant *) Set Primitive Projections. Module DirectTuple. Check "DirectTuple (PrimitiveProjectionConstant)". Record T := {p:nat}. Notation TUPLE := {|p:=0|}. Definition a := {|p:=0|}. Axiom P : nat -> Prop. Goal P (id p a). unfold id. cbv delta [a]. simpl. Show. Abort. (* -> 0 *) Goal P (id p a). unfold id. cbv delta [a]. cbn. Show. Abort. (* -> 0 *) Goal P (id p a). unfold id. cbv delta [a]. hnf. Show. Abort. (* -> TUPLE.(p) *) (* bug primproj 1 *) Arguments p : simpl never. Goal P (id p a). unfold id. cbv delta [a]. simpl. Show. Abort. (* -> TUPLE.(p) *) Goal P (id p a). unfold id. cbv delta [a]. cbn. Show. Abort. (* -> TUPLE.(p) *) Goal P (id p a). unfold id. cbv delta [a]. hnf. Show. Abort. (* -> TUPLE.(p) *) (* bug primproj 1 *) End DirectTuple. Module NamedTuple. Check "NamedTuple (PrimitiveProjectionConstant)". Record T := {p:nat}. Definition a := {|p:=0|}. Axiom P : nat -> Prop. Goal P (id p a). unfold id. simpl. Show. Abort. (* -> 0 *) Goal P (id p a). unfold id. cbn. Show. Abort. (* -> 0 *) Goal P (id p a). unfold id. hnf. Show. Abort. (* -> a.(p) *) (* bug primproj 2 *) Arguments p : simpl never. Goal P (id p a). unfold id. simpl. Show. Abort. (* -> a.(p) *) Goal P (id p a). unfold id. cbn. Show. Abort. (* -> a.(p) *) Goal P (id p a). unfold id. hnf. Show. Abort. (* -> a.(p) *) (* bug primproj 2 *) Arguments p : simpl nomatch. Arguments a : simpl never. Goal P (id p a). unfold id. simpl. Show. Abort. (* -> 0 *) (* never not respected on purpose *) Goal P (id p a). unfold id. cbn. Show. Abort. (* -> a.(p) *) Goal P (id p a). unfold id. hnf. Show. Abort. (* -> a.(p) *) End NamedTuple. Module DirectCoFix. Check "DirectCoFix (PrimitiveProjectionConstant)". CoInductive U := {q:U}. Notation COFIX := (cofix a := {|q:=a|}). Axiom P : U -> Prop. Goal P (id q COFIX). unfold id. simpl. Show. Abort. (* -> COFIX *) Goal P (id q COFIX). unfold id. cbn. Show. Abort. (* -> COFIX *) Goal P (id q COFIX). unfold id. hnf. Show. Abort. (* -> COFIX.(q) *) (* bug primproj 3 *) Arguments q : simpl never. Goal P (id q COFIX). unfold id. simpl. Show. Abort. (* -> COFIX.(q) *) Goal P (id q COFIX). unfold id. cbn. Show. Abort. (* -> COFIX.(q) *) Goal P (id q COFIX). unfold id. hnf. Show. Abort. (* -> COFIX.(q) *) (* bug primproj 3 *) End DirectCoFix. Module NamedCoFix. Check "NamedCoFix (PrimitiveProjectionConstant)". CoInductive U := {q:U}. CoFixpoint a := {|q:=a|}. Axiom P : U -> Prop. Goal P (id q a). unfold id. simpl. Show. Abort. (* -> a *) Goal P (id q a). unfold id. cbn. Show. Abort. (* -> a *) Goal P (id q a). unfold id. hnf. Show. Abort. (* -> a.(q) *) (* bug primproj 4 *) Arguments q : simpl never. Goal P (id q a). unfold id. simpl. Show. Abort. (* -> a.(q) *) Goal P (id q a). unfold id. cbn. Show. Abort. (* -> a.(q) *) Goal P (id q a). unfold id. hnf. Show. Abort. (* -> a.(q) *) (* bug primproj 4 *) Arguments q : simpl nomatch. Arguments a : simpl never. Goal P (id q a). unfold id. simpl. Show. Abort. (* -> a *) (* never not respected on purpose *) Goal P (id q a). unfold id. cbn. Show. Abort. (* -> a.(q) *) Goal P (id q a). unfold id. hnf. Show. Abort. (* -> a.(q) *) (* bug primproj 4 *) End NamedCoFix. End PrimitiveProjectionConstant. coq-8.20.0/test-suite/output/sint63NumberNotation.out000066400000000000000000000005661466560755400226260ustar00rootroot00000000000000 = 0 : uint = 1 : uint = 9223372036854775807 : uint let v := 0 in v : uint : uint let v := 1 in v : uint : uint let v := 9223372036854775807 in v : uint : uint = 0 : sint = 1 : sint = -1 : sint let v := 0 in v : sint : sint let v := 1 in v : sint : sint let v := -1 in v : sint : sint coq-8.20.0/test-suite/output/sint63NumberNotation.v000066400000000000000000000017771466560755400222710ustar00rootroot00000000000000From Coq Require Import Uint63. Import ZArith. Declare Scope uint_scope. Declare Scope sint_scope. Delimit Scope uint_scope with uint. Delimit Scope sint_scope with sint. Record uint := wrapu { unwrapu : int }. Record sint := wraps { unwraps : int }. Definition uof_Z (v : Z) := wrapu (of_Z v). Definition uto_Z (v : uint) := to_Z (unwrapu v). Definition sof_Z (v : Z) := wraps (of_Z (v mod (2 ^ 31))). Definition as_signed (bw : Z) (v : Z) := (((2 ^ (bw - 1) + v) mod (2 ^ bw)) - 2 ^ (bw - 1))%Z. Definition sto_Z (v : sint) := as_signed 31 (to_Z (unwraps v)). Number Notation uint uof_Z uto_Z : uint_scope. Number Notation sint sof_Z sto_Z : sint_scope. Open Scope uint_scope. Compute uof_Z 0. Compute uof_Z 1. Compute uof_Z (-1). Check let v := 0 in v : uint. Check let v := 1 in v : uint. Check let v := -1 in v : uint. Close Scope uint_scope. Open Scope sint_scope. Compute sof_Z 0. Compute sof_Z 1. Compute sof_Z (-1). Check let v := 0 in v : sint. Check let v := 1 in v : sint. Check let v := -1 in v : sint. coq-8.20.0/test-suite/output/smartlocate.out000066400000000000000000000005401466560755400211210ustar00rootroot00000000000000File "./output/smartlocate.v", line 1, characters 11-15: The command has indeed failed with message: Unable to unambiguously interpret "<>" as a reference. Found: Notation "x <> y" := (not (eq x y)) File "./output/smartlocate.v", line 2, characters 11-26: The command has indeed failed with message: Unable to interpret "'nonexistent'" as a reference. coq-8.20.0/test-suite/output/smartlocate.v000066400000000000000000000000551466560755400205600ustar00rootroot00000000000000Fail Print "<>". Fail Print "'nonexistent'". coq-8.20.0/test-suite/output/sort_poly_elim_error.out000066400000000000000000000031501466560755400230540ustar00rootroot00000000000000File "./output/sort_poly_elim_error.v", line 8, characters 0-108: The command has indeed failed with message: Incorrect elimination of "p" in the inductive type "sum@{Prop | sort_poly_elim_error.3 sort_poly_elim_error.4}": the return type has sort "Type" while it should be SProp or Prop. Elimination of an inductive object of sort Prop is not allowed on a predicate in sort "Type" because proofs can be eliminated only to build proofs. File "./output/sort_poly_elim_error.v", line 19, characters 0-106: The command has indeed failed with message: Incorrect elimination of "x" in the inductive type "sBox@{s s' | u}": the return type has sort "Type@{s | u}" while it should be in sort quality s'. Elimination of a sort polymorphic inductive object instantiated to a variable sort quality is only allowed on a predicate in the same sort quality. File "./output/sort_poly_elim_error.v", line 22, characters 0-105: The command has indeed failed with message: Incorrect elimination of "x" in the inductive type "sBox@{s Type | u}": the return type has sort "Type@{s | u}" while it may not be of a variable sort quality. Elimination of a sort polymorphic inductive object instantiated to sort Type is not allowed on a predicate in a variable sort quality. File "./output/sort_poly_elim_error.v", line 28, characters 0-37: The command has indeed failed with message: Incorrect elimination of "sC" in the inductive type "sP": the return type has sort "Prop" while it should be SProp. Elimination of an inductive object of sort SProp is not allowed on a predicate in sort "Prop" because strict proofs can be eliminated only to build strict proofs. coq-8.20.0/test-suite/output/sort_poly_elim_error.v000066400000000000000000000016411466560755400225150ustar00rootroot00000000000000Set Universe Polymorphism. Inductive sum@{s|u v|} (A : Type@{s|u}) (B : Type@{s|v}) : Type@{s|max(u,v)} := | inl : A -> sum A B | inr : B -> sum A B. Arguments inl {A B}. Arguments inr {A B}. Fail Check (fun p : sum@{Prop|_ _} True False => match p return Set with inl a => unit | inr b => bool end). (* Error: Incorrect elimination of "p" in the inductive type "sum": the return type has sort "Type@{Set+1}" while it should be at some variable quality. Elimination of an inductive object of sort Type is not allowed on a predicate in sort Type because wrong arity. *) Inductive sBox@{s s'|u|} (A:Type@{s|u}) : Type@{s'|u} := sbox (_:A). Fail Definition elim@{s s'|u|} (A:Type@{s|u}) (x:sBox@{s s'|u} A) : A := match x with sbox _ v => v end. Fail Definition elim@{s|u|} (A:Type@{s|u}) (x:sBox@{s Type|u} A) : A := match x with sbox _ v => v end. Inductive sP : SProp := sC. Fail Check match sC with sC => I end. coq-8.20.0/test-suite/output/ssr_clear.out000066400000000000000000000002061466560755400205570ustar00rootroot00000000000000File "./output/ssr_clear.v", line 5, characters 5-26: The command has indeed failed with message: No assumption is named NO_SUCH_NAME coq-8.20.0/test-suite/output/ssr_clear.v000066400000000000000000000001411466560755400202130ustar00rootroot00000000000000Require Import ssreflect. Example foo : True -> True. Proof. Fail move=> {NO_SUCH_NAME}. Abort. coq-8.20.0/test-suite/output/ssr_error_multiple_intro_after_case.out000066400000000000000000000002131466560755400261220ustar00rootroot00000000000000File "./output/ssr_error_multiple_intro_after_case.v", line 3, characters 5-16: The command has indeed failed with message: x already used coq-8.20.0/test-suite/output/ssr_error_multiple_intro_after_case.v000066400000000000000000000001251466560755400255620ustar00rootroot00000000000000Require Import ssreflect. Goal forall p : nat * nat , True. Fail case => x x. Abort. coq-8.20.0/test-suite/output/ssr_explain_match.out000066400000000000000000000047341466560755400223170ustar00rootroot00000000000000File "./output/ssr_explain_match.v", line 12, characters 0-61: Warning: Notation "_ - _" was already used in scope nat_scope. [notation-overridden,parsing,default] File "./output/ssr_explain_match.v", line 12, characters 0-61: Warning: Notation "_ <= _" was already used in scope nat_scope. [notation-overridden,parsing,default] File "./output/ssr_explain_match.v", line 12, characters 0-61: Warning: Notation "_ < _" was already used in scope nat_scope. [notation-overridden,parsing,default] File "./output/ssr_explain_match.v", line 12, characters 0-61: Warning: Notation "_ >= _" was already used in scope nat_scope. [notation-overridden,parsing,default] File "./output/ssr_explain_match.v", line 12, characters 0-61: Warning: Notation "_ > _" was already used in scope nat_scope. [notation-overridden,parsing,default] File "./output/ssr_explain_match.v", line 12, characters 0-61: Warning: Notation "_ <= _ <= _" was already used in scope nat_scope. [notation-overridden,parsing,default] File "./output/ssr_explain_match.v", line 12, characters 0-61: Warning: Notation "_ < _ <= _" was already used in scope nat_scope. [notation-overridden,parsing,default] File "./output/ssr_explain_match.v", line 12, characters 0-61: Warning: Notation "_ <= _ < _" was already used in scope nat_scope. [notation-overridden,parsing,default] File "./output/ssr_explain_match.v", line 12, characters 0-61: Warning: Notation "_ < _ < _" was already used in scope nat_scope. [notation-overridden,parsing,default] File "./output/ssr_explain_match.v", line 12, characters 0-61: Warning: Notation "_ + _" was already used in scope nat_scope. [notation-overridden,parsing,default] File "./output/ssr_explain_match.v", line 12, characters 0-61: Warning: Notation "_ * _" was already used in scope nat_scope. [notation-overridden,parsing,default] BEGIN INSTANCES instance: (x + y + z) matches: (x + y + z) instance: (x + y) matches: (x + y) instance: (x + y) matches: (x + y) END INSTANCES BEGIN INSTANCES instance: (addnC (x + y) z) matches: (x + y + z) instance: (addnC x y) matches: (x + y) instance: (addnC x y) matches: (x + y) END INSTANCES BEGIN INSTANCES instance: (addnA x y z) matches: (x + y + z) END INSTANCES BEGIN INSTANCES instance: (addnA x y z) matches: (x + y + z) instance: (addnC z (x + y)) matches: (x + y + z) instance: (addnC y x) matches: (x + y) instance: (addnC y x) matches: (x + y) END INSTANCES File "./output/ssr_explain_match.v", line 22, characters 5-38: The command has indeed failed with message: Not supported coq-8.20.0/test-suite/output/ssr_explain_match.v000066400000000000000000000020111466560755400217370ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* Prop), (forall x : T1, P1 x) -> {in D1, forall x : T1, P1 x} coq-8.20.0/test-suite/output/ssr_pred.v000066400000000000000000000000671466560755400200660ustar00rootroot00000000000000Require Import ssreflect ssrfun ssrbool. Check @in1W. coq-8.20.0/test-suite/output/ssr_under.out000066400000000000000000000001761466560755400206140ustar00rootroot00000000000000'Under[ m - m ] (G (fun _ : nat => 0) n >= 0) 'Under[ r = R0 \/ E r ] (Rbar_le Rbar0 (Lub_Rbar (fun r : R => r = R0 \/ E r))) coq-8.20.0/test-suite/output/ssr_under.v000066400000000000000000000014461466560755400202530ustar00rootroot00000000000000From Coq Require Import ssreflect. Axiom subnn : forall n : nat, n - n = 0. Parameter G : (nat -> nat) -> nat -> nat. Axiom eq_G : forall F1 F2 : nat -> nat, (forall n : nat, F1 n = F2 n) -> forall n : nat, G F1 n = G F2 n. Ltac show := match goal with [|-?g] => idtac g end. Lemma example_G (n : nat) : G (fun n => n - n) n >= 0. under eq_G => m do [show; rewrite subnn]. show. Abort. Parameters (R Rbar : Set) (R0 : R) (Rbar0 : Rbar). Parameter Rbar_le : Rbar -> Rbar -> Prop. Parameter Lub_Rbar : (R -> Prop) -> Rbar. Parameter Lub_Rbar_eqset : forall E1 E2 : R -> Prop, (forall x : R, E1 x <-> E2 x) -> Lub_Rbar E1 = Lub_Rbar E2. Lemma test_Lub_Rbar (E : R -> Prop) : Rbar_le Rbar0 (Lub_Rbar (fun x => x = R0 \/ E x)). Proof. under Lub_Rbar_eqset => r do show. show. Abort. coq-8.20.0/test-suite/output/subst.out000066400000000000000000000011451466560755400177450ustar00rootroot000000000000001 goal y, z : nat Hy : y = 0 Hz : z = 0 H1 : 0 = 1 HA : True H2 : 0 = 2 H3 : y = 3 HB : True H4 : z = 4 ============================ True 1 goal x, z : nat Hx : x = 0 Hz : z = 0 H1 : x = 1 HA : True H2 : x = 2 H3 : 0 = 3 HB : True H4 : z = 4 ============================ True 1 goal x, y : nat Hx : x = 0 Hy : y = 0 H1 : x = 1 HA : True H2 : x = 2 H3 : y = 3 HB : True H4 : 0 = 4 ============================ True 1 goal H1 : 0 = 1 HA : True H2 : 0 = 2 H3 : 0 = 3 HB : True H4 : 0 = 4 ============================ True coq-8.20.0/test-suite/output/subst.v000066400000000000000000000017311466560755400174040ustar00rootroot00000000000000(* Ensure order of hypotheses is respected after "subst" *) Notation goal := (forall x y z, x = 0 -> y = 0 -> z = 0 -> x = 1 -> True -> x = 2 -> y = 3 -> True -> z = 4 -> True) (only parsing). Ltac do_intros := intros * Hx Hy Hz H1 HA H2 H3 HB H4. Goal goal. do_intros. (* From now on, the order after subst is consistently H1, HA, H2, H3, HB, H4 *) subst x. (* In 8.4 or 8.5 without regular subst tactic mode, the order was HA, H3, HB, H4, H1, H2 *) Show. Abort. Goal goal. do_intros. subst y. (* In 8.4 or 8.5 without regular subst tactic mode, the order was H1, HA, H2, HB, H4, H3 *) Show. Abort. Goal goal. do_intros. subst z. (* In 8.4 or 8.5 without regular subst tactic mode, the order was H1, HA, H2, H3, HB, H4 *) Show. Abort. Goal goal. do_intros. subst. (* In 8.4 or 8.5 without regular subst tactic mode, the order was HA, HB, H4, H3, H1, H2 *) (* In 8.5pl0 and 8.5pl1 with regular subst tactic mode, the order was HA, HB, H1, H2, H3, H4 *) Show. trivial. Qed. coq-8.20.0/test-suite/output/undeclared_key.out000066400000000000000000000017701466560755400215670ustar00rootroot00000000000000File "./output/undeclared_key.v", line 1, characters 0-28: The command has indeed failed with message: There is no flag, option or table with this name: "Search Blacklists". File "./output/undeclared_key.v", line 2, characters 0-35: The command has indeed failed with message: There is no qualid-valued table with this name: "Search Blacklist". File "./output/undeclared_key.v", line 3, characters 0-22: Warning: There is no flag or option with this name: "Search Blacklists". [unknown-option,default] File "./output/undeclared_key.v", line 4, characters 0-40: The command has indeed failed with message: There is no string-valued table with this name: "Search Blacklists". File "./output/undeclared_key.v", line 5, characters 0-39: The command has indeed failed with message: There is no qualid-valued table with this name: "Search Blacklist". File "./output/undeclared_key.v", line 6, characters 0-36: The command has indeed failed with message: There is no qualid-valued table with this name: "Search Blacklist". coq-8.20.0/test-suite/output/undeclared_key.v000066400000000000000000000003161466560755400212200ustar00rootroot00000000000000Fail Test Search Blacklists. Fail Test Search Blacklist for foo. Set Search Blacklists. Fail Remove Search Blacklists "bar" foo. Fail Remove Search Blacklist "bar" foo. Fail Add Search Blacklist "bar" foo. coq-8.20.0/test-suite/output/unifconstraints.out000066400000000000000000000036121466560755400220370ustar00rootroot000000000000003 focused goals (shelved: 1) ============================ ?Goal 0 goal 2 is: forall n : nat, ?Goal n -> ?Goal (S n) goal 3 is: nat unification constraint: ?Goal ?Goal2 <= True /\ True /\ True \/ veeryyyyyyyyyyyyloooooooooooooonggidentifier = veeryyyyyyyyyyyyloooooooooooooonggidentifier 3 focused goals (shelved: 1) n, m : nat ============================ ?Goal@{n:=n; m:=m} 0 goal 2 is: forall n0 : nat, ?Goal@{n:=n; m:=m} n0 -> ?Goal@{n:=n; m:=m} (S n0) goal 3 is: nat unification constraint: ?Goal@{n:=n; m:=m} ?Goal2@{n:=n; m:=m} <= True /\ True /\ True \/ veeryyyyyyyyyyyyloooooooooooooonggidentifier = veeryyyyyyyyyyyyloooooooooooooonggidentifier 3 focused goals (shelved: 1) m : nat ============================ ?Goal1@{m:=m} 0 goal 2 is: forall n0 : nat, ?Goal1@{m:=m} n0 -> ?Goal1@{m:=m} (S n0) goal 3 is: nat unification constraint: n, m : nat |- ?Goal1@{m:=m} ?Goal0@{n:=n; m:=m} <= True /\ True /\ True \/ veeryyyyyyyyyyyyloooooooooooooonggidentifier = veeryyyyyyyyyyyyloooooooooooooonggidentifier 3 focused goals (shelved: 1) m : nat ============================ ?Goal0@{m:=m} 0 goal 2 is: forall n0 : nat, ?Goal0@{m:=m} n0 -> ?Goal0@{m:=m} (S n0) goal 3 is: nat unification constraint: n, m : nat |- ?Goal0@{m:=m} ?Goal2@{n:=n} <= True /\ True /\ True \/ veeryyyyyyyyyyyyloooooooooooooonggidentifier = veeryyyyyyyyyyyyloooooooooooooonggidentifier File "./output/unifconstraints.v", line 29, characters 56-57: The command has indeed failed with message: In environment P : nat -> Type x : nat h : P x Unable to unify "P x" with "?P x" (unable to find a well-typed instantiation for "?P": cannot ensure that "nat -> Type" is a subtype of "nat -> Prop"). File "./output/unifconstraints.v", line 37, characters 5-15: The command has indeed failed with message: Tactic failure: congruence failed (cannot build a well-typed proof). coq-8.20.0/test-suite/output/unifconstraints.v000066400000000000000000000021371466560755400214760ustar00rootroot00000000000000(* -*- coq-prog-args: ("-async-proofs" "no") -*- *) (* Set Printing Existential Instances. *) Unset Solve Unification Constraints. Axiom veeryyyyyyyyyyyyloooooooooooooonggidentifier : nat. Goal True /\ True /\ True \/ veeryyyyyyyyyyyyloooooooooooooonggidentifier = veeryyyyyyyyyyyyloooooooooooooonggidentifier. refine (nat_rect _ _ _ _). Show. Admitted. Set Printing Existential Instances. Goal forall n m : nat, True /\ True /\ True \/ veeryyyyyyyyyyyyloooooooooooooonggidentifier = veeryyyyyyyyyyyyloooooooooooooonggidentifier. intros. refine (nat_rect _ _ _ _). Show. clear n. Show. 3:clear m. Show. Admitted. Unset Printing Existential Instances. (* Check non regression of error message (the example can eventually improve though and succeed) *) Fail Check fun (P : _ -> Type) (x:nat) (h:P x) => exist _ x (h : P x). (* A test about universe level unification in congruence *) Set Universe Polymorphism. Section S. Polymorphic Universes i j. Goal Type@{i} -> (Type@{j} : Type@{i}). Fail congruence. Abort. End S. coq-8.20.0/test-suite/output/unification.out000066400000000000000000000020721466560755400211150ustar00rootroot00000000000000File "./output/unification.v", line 9, characters 35-39: The command has indeed failed with message: In environment x : T T : Type a : T Unable to unify "T" with "?X@{x0:=x; x:=C a}" (cannot instantiate "?X" because "T" is not in its scope: available arguments are "x" "C a"). File "./output/unification.v", line 12, characters 12-14: The command has indeed failed with message: The term "id" has type "ID" while it is expected to have type "Type -> ?T" (cannot instantiate "?T" because "A" is not in its scope). 1 focused goal (shelved: 1) H : forall x : nat, S (S (S x)) = x ============================ ?x = 0 1 focused goal (shelved: 1) H : forall x : nat, S (S (S x)) = x ============================ ?x = 0 1 focused goal (shelved: 1) H : forall x : nat, S (S (S x)) = x ============================ ?x = 0 1 focused goal (shelved: 1) H : forall x : nat, S x = x ============================ ?y = 0 1 focused goal (shelved: 3) T : Prop H : forall Q R S : Prop, (Q /\ R) /\ S -> T ============================ (?Q /\ ?R) /\ ?S coq-8.20.0/test-suite/output/unification.v000066400000000000000000000016651466560755400205620ustar00rootroot00000000000000(* coq-prog-args: ("-async-proofs" "off") *) (* Unification error tests *) Module A. (* Check regression of an UNBOUND_REL bug *) Inductive T := C : forall {A}, A -> T. Fail Check fun x => match x return ?[X] with C a => a end. (* Bug #3634 *) Fail Check (id:Type -> _). End A. (* Choice of evar names *) Goal (forall x, S (S (S x)) = x) -> exists x, S x = 0. eexists. rewrite H. Show. Abort. Goal (forall x, S (S (S x)) = x) -> exists x, S x = 0. eexists ?[x]. rewrite H. Show. Abort. Goal (forall x, S (S (S x)) = x) -> exists x, S x = 0. eexists ?[y]. rewrite H. Show. reflexivity. Qed. (* Preserve the name if there is one *) Goal (forall x, S x = x) -> exists x, S x = 0. eexists ?[y]. rewrite H. Show. reflexivity. Qed. (* Use names also when instantiating an existing evar *) Lemma L (T : Prop) (H : forall Q R S : Prop, (Q /\ R) /\ S -> T) : exists P:Prop, (P -> T) /\ P. Proof. eexists ?[P]. split. - apply H. - Show. Abort. coq-8.20.0/test-suite/output/wish_17316.out000066400000000000000000000001651466560755400203210ustar00rootroot00000000000000Notation "%" := 0 (default interpretation) (only printing) Notation "%" := 0 (default interpretation) (only parsing) coq-8.20.0/test-suite/output/wish_17316.v000066400000000000000000000001211466560755400177470ustar00rootroot00000000000000Notation "%" := 0 (only printing). Notation "%" := 0 (only parsing). Locate "%". coq-8.20.0/test-suite/output/wish_17985.out000066400000000000000000000002271466560755400203340ustar00rootroot00000000000000File "./output/wish_17985.v", line 2, characters 75-91: The command has indeed failed with message: B is already assigned to an entry or constr level. coq-8.20.0/test-suite/output/wish_17985.v000066400000000000000000000002111466560755400177630ustar00rootroot00000000000000(* Do not accept B to be declared twice *) Fail Reserved Notation "'<<<' A '>>>' e '<<<' B '>>>'" (A, B at level 200, e, B at level 55). coq-8.20.0/test-suite/output/wish_18097.out000066400000000000000000000006351466560755400203320ustar00rootroot00000000000000Notation pow := Nat.pow Nat.pow = fix pow (n m : nat) {struct m} : nat := match m with | 0 => 1 | S m0 => n * pow n m0 end : nat -> nat -> nat Arguments Nat.pow (n m)%nat_scope Notation pow := Nat.pow Expands to: Notation wish_18097.pow Nat.pow : nat -> nat -> nat Nat.pow is not universe polymorphic Arguments Nat.pow (n m)%nat_scope Nat.pow is transparent Expands to: Constant Coq.Init.Nat.pow coq-8.20.0/test-suite/output/wish_18097.v000066400000000000000000000000571466560755400177660ustar00rootroot00000000000000Notation pow := Nat.pow. Print pow. About pow. coq-8.20.0/test-suite/precomputed-time-tests/000077500000000000000000000000001466560755400211365ustar00rootroot00000000000000coq-8.20.0/test-suite/precomputed-time-tests/correct-diff-sorting-order-mem/000077500000000000000000000000001466560755400270555ustar00rootroot00000000000000coq-8.20.0/test-suite/precomputed-time-tests/correct-diff-sorting-order-mem/run.sh000077500000000000000000000021131466560755400302150ustar00rootroot00000000000000#!/usr/bin/env bash . ../template/init.sh cd "$(dirname "${BASH_SOURCE[0]}")" $make_both_time_files time-of-build-after.log.in time-of-build-before.log.in time-of-build-both-user.log --sort-by-mem diff -u time-of-build-both-user.log.expected time-of-build-both-user.log || exit $? $make_both_time_files --real time-of-build-after.log.in time-of-build-before.log.in time-of-build-both-real.log --sort-by-mem diff -u time-of-build-both-real.log.expected time-of-build-both-real.log || exit $? for sort_kind in auto absolute diff; do $make_both_time_files time-of-build-after.log.in time-of-build-before.log.in time-of-build-both-user-${sort_kind}.log --sort-by-mem --sort-by=${sort_kind} diff -u time-of-build-both-user-${sort_kind}.log.expected time-of-build-both-user-${sort_kind}.log || exit $? $make_both_time_files --real time-of-build-after.log.in time-of-build-before.log.in time-of-build-both-real-${sort_kind}.log --sort-by-mem --sort-by=${sort_kind} diff -u time-of-build-both-real-${sort_kind}.log.expected time-of-build-both-real-${sort_kind}.log || exit $? done time-of-build-after.log.in000066400000000000000000004047131466560755400336530ustar00rootroot00000000000000coq-8.20.0/test-suite/precomputed-time-tests/correct-diff-sorting-order-memCOQDEP src/Compilers/Z/Bounds/Pipeline/ReflectiveTactics.v COQDEP src/Compilers/Z/Bounds/Pipeline/Definition.v /home/jgross/.local64/coq/coq-master/bin/coq_makefile -f _CoqProject INSTALLDEFAULTROOT = Crypto -o Makefile-old COQ_MAKEFILE -f _CoqProject > Makefile.coq make --no-print-directory -C coqprime make[1]: Nothing to be done for 'all'. ECHO > _CoqProject COQC src/Compilers/Z/Bounds/Pipeline/Definition.v src/Compilers/Z/Bounds/Pipeline/Definition (real: 7.33, user: 7.18, sys: 0.14, mem: 574388 ko) COQC src/Compilers/Z/Bounds/Pipeline/ReflectiveTactics.v src/Compilers/Z/Bounds/Pipeline/ReflectiveTactics (real: 1.93, user: 1.72, sys: 0.20, mem: 544172 ko) COQC src/Compilers/Z/Bounds/Pipeline.v src/Compilers/Z/Bounds/Pipeline (real: 1.38, user: 1.19, sys: 0.16, mem: 539808 ko) COQC src/Specific/Framework/SynthesisFramework.v src/Specific/Framework/SynthesisFramework (real: 1.85, user: 1.67, sys: 0.17, mem: 646300 ko) COQC src/Specific/X25519/C64/Synthesis.v src/Specific/X25519/C64/Synthesis (real: 11.15, user: 10.37, sys: 0.18, mem: 687760 ko) COQC src/Specific/NISTP256/AMD64/Synthesis.v src/Specific/NISTP256/AMD64/Synthesis (real: 13.45, user: 12.55, sys: 0.19, mem: 668216 ko) COQC src/Specific/X25519/C64/feadd.v Finished transaction in 2.814 secs (2.624u,0.s) (successful) total time: 2.576s tactic local total calls max ────────────────────────────────────────┴──────┴──────┴───────┴─────────┘ ─Pipeline.refine_reflectively_gen ------ 0.2% 97.4% 1 2.508s ─ReflectiveTactics.do_reflective_pipelin 0.0% 66.9% 1 1.724s ─ReflectiveTactics.solve_side_conditions 0.0% 65.5% 1 1.688s ─ReflectiveTactics.solve_post_reified_si 1.2% 37.0% 1 0.952s ─Glue.refine_to_reflective_glue' ------- 0.0% 30.3% 1 0.780s ─ReflectiveTactics.do_reify ------------ 0.0% 28.6% 1 0.736s ─Reify.Reify_rhs_gen ------------------- 2.2% 26.6% 1 0.684s ─UnifyAbstractReflexivity.unify_transfor 20.3% 24.1% 7 0.164s ─Glue.zrange_to_reflective ------------- 0.0% 20.3% 1 0.524s ─Glue.zrange_to_reflective_goal -------- 9.5% 15.2% 1 0.392s ─Reify.do_reify_abs_goal --------------- 13.7% 13.8% 2 0.356s ─Reify.do_reifyf_goal ------------------ 12.4% 12.6% 16 0.324s ─ReflectiveTactics.unify_abstract_cbv_in 8.4% 11.2% 1 0.288s ─unify (constr) (constr) --------------- 5.7% 5.7% 6 0.072s ─Glue.pattern_sig_sig_assoc ------------ 0.0% 5.4% 1 0.140s ─assert (H : is_bounded_by' bounds (map' 4.8% 5.1% 2 0.072s ─Glue.pattern_proj1_sig_in_sig --------- 1.7% 5.1% 1 0.132s ─pose proof (pf : Interpretation.Bo 3.7% 3.7% 1 0.096s ─Glue.split_BoundedWordToZ ------------- 0.3% 3.7% 1 0.096s ─destruct_sig -------------------------- 0.2% 3.3% 4 0.044s ─destruct x ---------------------------- 3.1% 3.1% 4 0.036s ─eexact -------------------------------- 3.0% 3.0% 18 0.008s ─clearbody (ne_var_list) --------------- 3.0% 3.0% 4 0.060s ─prove_interp_compile_correct ---------- 0.0% 2.8% 1 0.072s ─synthesize ---------------------------- 0.0% 2.6% 1 0.068s ─rewrite ?EtaInterp.InterpExprEta ------ 2.5% 2.5% 1 0.064s ─ClearbodyAll.clearbody_all ------------ 0.0% 2.3% 2 0.060s ─rewrite H ----------------------------- 2.2% 2.2% 1 0.056s ─reflexivity --------------------------- 2.2% 2.2% 7 0.032s ─Reify.transitivity_tt ----------------- 0.0% 2.2% 2 0.032s ─transitivity -------------------------- 2.0% 2.0% 5 0.024s tactic local total calls max ────────────────────────────────────────┴──────┴──────┴───────┴─────────┘ ─Pipeline.refine_reflectively_gen ------ 0.2% 97.4% 1 2.508s ├─ReflectiveTactics.do_reflective_pipel 0.0% 66.9% 1 1.724s │└ReflectiveTactics.solve_side_conditio 0.0% 65.5% 1 1.688s │ ├─ReflectiveTactics.solve_post_reifie 1.2% 37.0% 1 0.952s │ │ ├─UnifyAbstractReflexivity.unify_tr 20.3% 24.1% 7 0.164s │ │ │└unify (constr) (constr) --------- 3.0% 3.0% 5 0.028s │ │ └─ReflectiveTactics.unify_abstract_ 8.4% 11.2% 1 0.288s │ │ └unify (constr) (constr) --------- 2.8% 2.8% 1 0.072s │ └─ReflectiveTactics.do_reify -------- 0.0% 28.6% 1 0.736s │ └Reify.Reify_rhs_gen --------------- 2.2% 26.6% 1 0.684s │ ├─Reify.do_reify_abs_goal --------- 13.7% 13.8% 2 0.356s │ │└Reify.do_reifyf_goal ------------ 12.4% 12.6% 16 0.324s │ │└eexact -------------------------- 2.6% 2.6% 16 0.008s │ ├─prove_interp_compile_correct ---- 0.0% 2.8% 1 0.072s │ │└rewrite ?EtaInterp.InterpExprEta 2.5% 2.5% 1 0.064s │ ├─rewrite H ----------------------- 2.2% 2.2% 1 0.056s │ └─Reify.transitivity_tt ----------- 0.0% 2.2% 2 0.032s └─Glue.refine_to_reflective_glue' ----- 0.0% 30.3% 1 0.780s ├─Glue.zrange_to_reflective --------- 0.0% 20.3% 1 0.524s │ ├─Glue.zrange_to_reflective_goal -- 9.5% 15.2% 1 0.392s │ │└pose proof (pf : Interpretat 3.7% 3.7% 1 0.096s │ └─assert (H : is_bounded_by' bounds 4.8% 5.1% 2 0.072s ├─Glue.pattern_sig_sig_assoc -------- 0.0% 5.4% 1 0.140s │└Glue.pattern_proj1_sig_in_sig ----- 1.7% 5.1% 1 0.132s │└ClearbodyAll.clearbody_all -------- 0.0% 2.3% 2 0.060s │└clearbody (ne_var_list) ----------- 2.3% 2.3% 1 0.060s └─Glue.split_BoundedWordToZ --------- 0.3% 3.7% 1 0.096s └destruct_sig ---------------------- 0.2% 3.3% 4 0.044s └destruct x ------------------------ 2.5% 2.5% 2 0.036s ─synthesize ---------------------------- 0.0% 2.6% 1 0.068s Finished transaction in 5.021 secs (4.636u,0.s) (successful) Closed under the global context total time: 2.576s tactic local total calls max ────────────────────────────────────────┴──────┴──────┴───────┴─────────┘ ─Pipeline.refine_reflectively_gen ------ 0.2% 97.4% 1 2.508s ─ReflectiveTactics.do_reflective_pipelin 0.0% 66.9% 1 1.724s ─ReflectiveTactics.solve_side_conditions 0.0% 65.5% 1 1.688s ─ReflectiveTactics.solve_post_reified_si 1.2% 37.0% 1 0.952s ─Glue.refine_to_reflective_glue' ------- 0.0% 30.3% 1 0.780s ─ReflectiveTactics.do_reify ------------ 0.0% 28.6% 1 0.736s ─Reify.Reify_rhs_gen ------------------- 2.2% 26.6% 1 0.684s ─UnifyAbstractReflexivity.unify_transfor 20.3% 24.1% 7 0.164s ─Glue.zrange_to_reflective ------------- 0.0% 20.3% 1 0.524s ─Glue.zrange_to_reflective_goal -------- 9.5% 15.2% 1 0.392s ─Reify.do_reify_abs_goal --------------- 13.7% 13.8% 2 0.356s ─Reify.do_reifyf_goal ------------------ 12.4% 12.6% 16 0.324s ─ReflectiveTactics.unify_abstract_cbv_in 8.4% 11.2% 1 0.288s ─unify (constr) (constr) --------------- 5.7% 5.7% 6 0.072s ─Glue.pattern_sig_sig_assoc ------------ 0.0% 5.4% 1 0.140s ─assert (H : is_bounded_by' bounds (map' 4.8% 5.1% 2 0.072s ─Glue.pattern_proj1_sig_in_sig --------- 1.7% 5.1% 1 0.132s ─pose proof (pf : Interpretation.Bo 3.7% 3.7% 1 0.096s ─Glue.split_BoundedWordToZ ------------- 0.3% 3.7% 1 0.096s ─destruct_sig -------------------------- 0.2% 3.3% 4 0.044s ─destruct x ---------------------------- 3.1% 3.1% 4 0.036s ─eexact -------------------------------- 3.0% 3.0% 18 0.008s ─clearbody (ne_var_list) --------------- 3.0% 3.0% 4 0.060s ─prove_interp_compile_correct ---------- 0.0% 2.8% 1 0.072s ─synthesize ---------------------------- 0.0% 2.6% 1 0.068s ─rewrite ?EtaInterp.InterpExprEta ------ 2.5% 2.5% 1 0.064s ─ClearbodyAll.clearbody_all ------------ 0.0% 2.3% 2 0.060s ─rewrite H ----------------------------- 2.2% 2.2% 1 0.056s ─reflexivity --------------------------- 2.2% 2.2% 7 0.032s ─Reify.transitivity_tt ----------------- 0.0% 2.2% 2 0.032s ─transitivity -------------------------- 2.0% 2.0% 5 0.024s tactic local total calls max ────────────────────────────────────────┴──────┴──────┴───────┴─────────┘ ─Pipeline.refine_reflectively_gen ------ 0.2% 97.4% 1 2.508s ├─ReflectiveTactics.do_reflective_pipel 0.0% 66.9% 1 1.724s │└ReflectiveTactics.solve_side_conditio 0.0% 65.5% 1 1.688s │ ├─ReflectiveTactics.solve_post_reifie 1.2% 37.0% 1 0.952s │ │ ├─UnifyAbstractReflexivity.unify_tr 20.3% 24.1% 7 0.164s │ │ │└unify (constr) (constr) --------- 3.0% 3.0% 5 0.028s │ │ └─ReflectiveTactics.unify_abstract_ 8.4% 11.2% 1 0.288s │ │ └unify (constr) (constr) --------- 2.8% 2.8% 1 0.072s │ └─ReflectiveTactics.do_reify -------- 0.0% 28.6% 1 0.736s │ └Reify.Reify_rhs_gen --------------- 2.2% 26.6% 1 0.684s │ ├─Reify.do_reify_abs_goal --------- 13.7% 13.8% 2 0.356s │ │└Reify.do_reifyf_goal ------------ 12.4% 12.6% 16 0.324s │ │└eexact -------------------------- 2.6% 2.6% 16 0.008s │ ├─prove_interp_compile_correct ---- 0.0% 2.8% 1 0.072s │ │└rewrite ?EtaInterp.InterpExprEta 2.5% 2.5% 1 0.064s │ ├─rewrite H ----------------------- 2.2% 2.2% 1 0.056s │ └─Reify.transitivity_tt ----------- 0.0% 2.2% 2 0.032s └─Glue.refine_to_reflective_glue' ----- 0.0% 30.3% 1 0.780s ├─Glue.zrange_to_reflective --------- 0.0% 20.3% 1 0.524s │ ├─Glue.zrange_to_reflective_goal -- 9.5% 15.2% 1 0.392s │ │└pose proof (pf : Interpretat 3.7% 3.7% 1 0.096s │ └─assert (H : is_bounded_by' bounds 4.8% 5.1% 2 0.072s ├─Glue.pattern_sig_sig_assoc -------- 0.0% 5.4% 1 0.140s │└Glue.pattern_proj1_sig_in_sig ----- 1.7% 5.1% 1 0.132s │└ClearbodyAll.clearbody_all -------- 0.0% 2.3% 2 0.060s │└clearbody (ne_var_list) ----------- 2.3% 2.3% 1 0.060s └─Glue.split_BoundedWordToZ --------- 0.3% 3.7% 1 0.096s └destruct_sig ---------------------- 0.2% 3.3% 4 0.044s └destruct x ------------------------ 2.5% 2.5% 2 0.036s ─synthesize ---------------------------- 0.0% 2.6% 1 0.068s src/Specific/X25519/C64/feadd (real: 22.81, user: 20.93, sys: 0.25, mem: 766300 ko) COQC src/Specific/X25519/C64/fecarry.v Finished transaction in 4.343 secs (4.016u,0.004s) (successful) total time: 3.976s tactic local total calls max ────────────────────────────────────────┴──────┴──────┴───────┴─────────┘ ─Pipeline.refine_reflectively_gen ------ 0.0% 99.0% 1 3.936s ─ReflectiveTactics.do_reflective_pipelin 0.0% 87.9% 1 3.496s ─ReflectiveTactics.solve_side_conditions 0.0% 86.9% 1 3.456s ─ReflectiveTactics.do_reify ------------ 0.0% 56.9% 1 2.264s ─Reify.Reify_rhs_gen ------------------- 1.8% 56.2% 1 2.236s ─Reify.do_reify_abs_goal --------------- 36.1% 36.5% 2 1.452s ─Reify.do_reifyf_goal ------------------ 34.8% 35.1% 29 1.396s ─ReflectiveTactics.solve_post_reified_si 0.6% 30.0% 1 1.192s ─UnifyAbstractReflexivity.unify_transfor 17.7% 21.7% 7 0.240s ─Glue.refine_to_reflective_glue' ------- 0.0% 11.1% 1 0.440s ─eexact -------------------------------- 10.9% 10.9% 31 0.024s ─ReflectiveTactics.unify_abstract_cbv_in 5.2% 7.3% 1 0.292s ─Glue.zrange_to_reflective ------------- 0.0% 7.1% 1 0.284s ─prove_interp_compile_correct ---------- 0.0% 5.7% 1 0.228s ─Glue.zrange_to_reflective_goal -------- 4.3% 5.5% 1 0.220s ─unify (constr) (constr) --------------- 5.3% 5.3% 6 0.084s ─rewrite ?EtaInterp.InterpExprEta ------ 5.2% 5.2% 1 0.208s ─rewrite H ----------------------------- 3.5% 3.5% 1 0.140s ─tac ----------------------------------- 1.9% 2.6% 2 0.104s ─reflexivity --------------------------- 2.2% 2.2% 7 0.028s ─Reify.transitivity_tt ----------------- 0.0% 2.2% 2 0.056s ─transitivity -------------------------- 2.0% 2.0% 5 0.048s ─Glue.split_BoundedWordToZ ------------- 0.1% 2.0% 1 0.080s tactic local total calls max ────────────────────────────────────────┴──────┴──────┴───────┴─────────┘ ─Pipeline.refine_reflectively_gen ------ 0.0% 99.0% 1 3.936s ├─ReflectiveTactics.do_reflective_pipel 0.0% 87.9% 1 3.496s │└ReflectiveTactics.solve_side_conditio 0.0% 86.9% 1 3.456s │ ├─ReflectiveTactics.do_reify -------- 0.0% 56.9% 1 2.264s │ │└Reify.Reify_rhs_gen --------------- 1.8% 56.2% 1 2.236s │ │ ├─Reify.do_reify_abs_goal --------- 36.1% 36.5% 2 1.452s │ │ │└Reify.do_reifyf_goal ------------ 34.8% 35.1% 29 1.396s │ │ │└eexact -------------------------- 10.1% 10.1% 29 0.024s │ │ ├─prove_interp_compile_correct ---- 0.0% 5.7% 1 0.228s │ │ │└rewrite ?EtaInterp.InterpExprEta 5.2% 5.2% 1 0.208s │ │ ├─rewrite H ----------------------- 3.5% 3.5% 1 0.140s │ │ ├─tac ----------------------------- 1.9% 2.6% 1 0.104s │ │ └─Reify.transitivity_tt ----------- 0.0% 2.2% 2 0.056s │ │ └transitivity -------------------- 2.0% 2.0% 4 0.048s │ └─ReflectiveTactics.solve_post_reifie 0.6% 30.0% 1 1.192s │ ├─UnifyAbstractReflexivity.unify_tr 17.7% 21.7% 7 0.240s │ │└unify (constr) (constr) --------- 3.2% 3.2% 5 0.048s │ └─ReflectiveTactics.unify_abstract_ 5.2% 7.3% 1 0.292s │ └unify (constr) (constr) --------- 2.1% 2.1% 1 0.084s └─Glue.refine_to_reflective_glue' ----- 0.0% 11.1% 1 0.440s ├─Glue.zrange_to_reflective --------- 0.0% 7.1% 1 0.284s │└Glue.zrange_to_reflective_goal ---- 4.3% 5.5% 1 0.220s └─Glue.split_BoundedWordToZ --------- 0.1% 2.0% 1 0.080s Finished transaction in 7.078 secs (6.728u,0.s) (successful) Closed under the global context total time: 3.976s tactic local total calls max ────────────────────────────────────────┴──────┴──────┴───────┴─────────┘ ─Pipeline.refine_reflectively_gen ------ 0.0% 99.0% 1 3.936s ─ReflectiveTactics.do_reflective_pipelin 0.0% 87.9% 1 3.496s ─ReflectiveTactics.solve_side_conditions 0.0% 86.9% 1 3.456s ─ReflectiveTactics.do_reify ------------ 0.0% 56.9% 1 2.264s ─Reify.Reify_rhs_gen ------------------- 1.8% 56.2% 1 2.236s ─Reify.do_reify_abs_goal --------------- 36.1% 36.5% 2 1.452s ─Reify.do_reifyf_goal ------------------ 34.8% 35.1% 29 1.396s ─ReflectiveTactics.solve_post_reified_si 0.6% 30.0% 1 1.192s ─UnifyAbstractReflexivity.unify_transfor 17.7% 21.7% 7 0.240s ─Glue.refine_to_reflective_glue' ------- 0.0% 11.1% 1 0.440s ─eexact -------------------------------- 10.9% 10.9% 31 0.024s ─ReflectiveTactics.unify_abstract_cbv_in 5.2% 7.3% 1 0.292s ─Glue.zrange_to_reflective ------------- 0.0% 7.1% 1 0.284s ─prove_interp_compile_correct ---------- 0.0% 5.7% 1 0.228s ─Glue.zrange_to_reflective_goal -------- 4.3% 5.5% 1 0.220s ─unify (constr) (constr) --------------- 5.3% 5.3% 6 0.084s ─rewrite ?EtaInterp.InterpExprEta ------ 5.2% 5.2% 1 0.208s ─rewrite H ----------------------------- 3.5% 3.5% 1 0.140s ─tac ----------------------------------- 1.9% 2.6% 2 0.104s ─reflexivity --------------------------- 2.2% 2.2% 7 0.028s ─Reify.transitivity_tt ----------------- 0.0% 2.2% 2 0.056s ─transitivity -------------------------- 2.0% 2.0% 5 0.048s ─Glue.split_BoundedWordToZ ------------- 0.1% 2.0% 1 0.080s tactic local total calls max ────────────────────────────────────────┴──────┴──────┴───────┴─────────┘ ─Pipeline.refine_reflectively_gen ------ 0.0% 99.0% 1 3.936s ├─ReflectiveTactics.do_reflective_pipel 0.0% 87.9% 1 3.496s │└ReflectiveTactics.solve_side_conditio 0.0% 86.9% 1 3.456s │ ├─ReflectiveTactics.do_reify -------- 0.0% 56.9% 1 2.264s │ │└Reify.Reify_rhs_gen --------------- 1.8% 56.2% 1 2.236s │ │ ├─Reify.do_reify_abs_goal --------- 36.1% 36.5% 2 1.452s │ │ │└Reify.do_reifyf_goal ------------ 34.8% 35.1% 29 1.396s │ │ │└eexact -------------------------- 10.1% 10.1% 29 0.024s │ │ ├─prove_interp_compile_correct ---- 0.0% 5.7% 1 0.228s │ │ │└rewrite ?EtaInterp.InterpExprEta 5.2% 5.2% 1 0.208s │ │ ├─rewrite H ----------------------- 3.5% 3.5% 1 0.140s │ │ ├─tac ----------------------------- 1.9% 2.6% 1 0.104s │ │ └─Reify.transitivity_tt ----------- 0.0% 2.2% 2 0.056s │ │ └transitivity -------------------- 2.0% 2.0% 4 0.048s │ └─ReflectiveTactics.solve_post_reifie 0.6% 30.0% 1 1.192s │ ├─UnifyAbstractReflexivity.unify_tr 17.7% 21.7% 7 0.240s │ │└unify (constr) (constr) --------- 3.2% 3.2% 5 0.048s │ └─ReflectiveTactics.unify_abstract_ 5.2% 7.3% 1 0.292s │ └unify (constr) (constr) --------- 2.1% 2.1% 1 0.084s └─Glue.refine_to_reflective_glue' ----- 0.0% 11.1% 1 0.440s ├─Glue.zrange_to_reflective --------- 0.0% 7.1% 1 0.284s │└Glue.zrange_to_reflective_goal ---- 4.3% 5.5% 1 0.220s └─Glue.split_BoundedWordToZ --------- 0.1% 2.0% 1 0.080s src/Specific/X25519/C64/fecarry (real: 27.11, user: 24.99, sys: 0.21, mem: 786052 ko) COQC src/Specific/solinas32_2e255m765_12limbs/Synthesis.v src/Specific/solinas32_2e255m765_12limbs/Synthesis (real: 40.13, user: 36.92, sys: 0.26, mem: 728464 ko) COQC src/Specific/solinas32_2e255m765_13limbs/Synthesis.v src/Specific/solinas32_2e255m765_13limbs/Synthesis (real: 49.44, user: 45.75, sys: 0.18, mem: 744240 ko) COQC src/Specific/X25519/C64/femul.v Finished transaction in 8.415 secs (7.664u,0.015s) (successful) total time: 7.616s tactic local total calls max ────────────────────────────────────────┴──────┴──────┴───────┴─────────┘ ─Pipeline.refine_reflectively_gen ------ 0.0% 94.8% 1 7.220s ─ReflectiveTactics.do_reflective_pipelin 0.0% 85.0% 1 6.476s ─ReflectiveTactics.solve_side_conditions 0.0% 84.2% 1 6.416s ─ReflectiveTactics.do_reify ------------ 0.0% 50.3% 1 3.832s ─Reify.Reify_rhs_gen ------------------- 1.8% 49.4% 1 3.760s ─ReflectiveTactics.solve_post_reified_si 0.5% 33.9% 1 2.584s ─Reify.do_reify_abs_goal --------------- 31.1% 31.4% 2 2.392s ─Reify.do_reifyf_goal ------------------ 30.0% 30.3% 58 1.528s ─UnifyAbstractReflexivity.unify_transfor 22.1% 27.3% 7 0.600s ─Glue.refine_to_reflective_glue' ------- 0.0% 9.8% 1 0.744s ─eexact -------------------------------- 8.2% 8.2% 60 0.024s ─Glue.zrange_to_reflective ------------- 0.1% 6.8% 1 0.516s ─unify (constr) (constr) --------------- 5.9% 5.9% 6 0.124s ─prove_interp_compile_correct ---------- 0.0% 5.8% 1 0.444s ─ReflectiveTactics.unify_abstract_cbv_in 3.9% 5.7% 1 0.432s ─rewrite ?EtaInterp.InterpExprEta ------ 5.4% 5.4% 1 0.408s ─synthesize ---------------------------- 0.0% 5.2% 1 0.396s ─Glue.zrange_to_reflective_goal -------- 3.0% 5.0% 1 0.384s ─IntegrationTestTemporaryMiscCommon.do_r 0.1% 4.8% 1 0.364s ─change G' ----------------------------- 3.9% 3.9% 1 0.300s ─rewrite H ----------------------------- 3.0% 3.0% 1 0.232s ─tac ----------------------------------- 1.5% 2.3% 2 0.176s ─Reify.transitivity_tt ----------------- 0.0% 2.1% 2 0.092s ─reflexivity --------------------------- 2.0% 2.0% 7 0.052s tactic local total calls max ────────────────────────────────────────┴──────┴──────┴───────┴─────────┘ ─Pipeline.refine_reflectively_gen ------ 0.0% 94.8% 1 7.220s ├─ReflectiveTactics.do_reflective_pipel 0.0% 85.0% 1 6.476s │└ReflectiveTactics.solve_side_conditio 0.0% 84.2% 1 6.416s │ ├─ReflectiveTactics.do_reify -------- 0.0% 50.3% 1 3.832s │ │└Reify.Reify_rhs_gen --------------- 1.8% 49.4% 1 3.760s │ │ ├─Reify.do_reify_abs_goal --------- 31.1% 31.4% 2 2.392s │ │ │└Reify.do_reifyf_goal ------------ 30.0% 30.3% 58 1.528s │ │ │└eexact -------------------------- 7.6% 7.6% 58 0.020s │ │ ├─prove_interp_compile_correct ---- 0.0% 5.8% 1 0.444s │ │ │└rewrite ?EtaInterp.InterpExprEta 5.4% 5.4% 1 0.408s │ │ ├─rewrite H ----------------------- 3.0% 3.0% 1 0.232s │ │ ├─tac ----------------------------- 1.5% 2.3% 1 0.176s │ │ └─Reify.transitivity_tt ----------- 0.0% 2.1% 2 0.092s │ └─ReflectiveTactics.solve_post_reifie 0.5% 33.9% 1 2.584s │ ├─UnifyAbstractReflexivity.unify_tr 22.1% 27.3% 7 0.600s │ │└unify (constr) (constr) --------- 4.3% 4.3% 5 0.096s │ └─ReflectiveTactics.unify_abstract_ 3.9% 5.7% 1 0.432s └─Glue.refine_to_reflective_glue' ----- 0.0% 9.8% 1 0.744s └Glue.zrange_to_reflective ----------- 0.1% 6.8% 1 0.516s └Glue.zrange_to_reflective_goal ------ 3.0% 5.0% 1 0.384s ─synthesize ---------------------------- 0.0% 5.2% 1 0.396s └IntegrationTestTemporaryMiscCommon.do_r 0.1% 4.8% 1 0.364s └change G' ----------------------------- 3.9% 3.9% 1 0.300s Finished transaction in 14.616 secs (13.528u,0.008s) (successful) Closed under the global context total time: 7.616s tactic local total calls max ────────────────────────────────────────┴──────┴──────┴───────┴─────────┘ ─Pipeline.refine_reflectively_gen ------ 0.0% 94.8% 1 7.220s ─ReflectiveTactics.do_reflective_pipelin 0.0% 85.0% 1 6.476s ─ReflectiveTactics.solve_side_conditions 0.0% 84.2% 1 6.416s ─ReflectiveTactics.do_reify ------------ 0.0% 50.3% 1 3.832s ─Reify.Reify_rhs_gen ------------------- 1.8% 49.4% 1 3.760s ─ReflectiveTactics.solve_post_reified_si 0.5% 33.9% 1 2.584s ─Reify.do_reify_abs_goal --------------- 31.1% 31.4% 2 2.392s ─Reify.do_reifyf_goal ------------------ 30.0% 30.3% 58 1.528s ─UnifyAbstractReflexivity.unify_transfor 22.1% 27.3% 7 0.600s ─Glue.refine_to_reflective_glue' ------- 0.0% 9.8% 1 0.744s ─eexact -------------------------------- 8.2% 8.2% 60 0.024s ─Glue.zrange_to_reflective ------------- 0.1% 6.8% 1 0.516s ─unify (constr) (constr) --------------- 5.9% 5.9% 6 0.124s ─prove_interp_compile_correct ---------- 0.0% 5.8% 1 0.444s ─ReflectiveTactics.unify_abstract_cbv_in 3.9% 5.7% 1 0.432s ─rewrite ?EtaInterp.InterpExprEta ------ 5.4% 5.4% 1 0.408s ─synthesize ---------------------------- 0.0% 5.2% 1 0.396s ─Glue.zrange_to_reflective_goal -------- 3.0% 5.0% 1 0.384s ─IntegrationTestTemporaryMiscCommon.do_r 0.1% 4.8% 1 0.364s ─change G' ----------------------------- 3.9% 3.9% 1 0.300s ─rewrite H ----------------------------- 3.0% 3.0% 1 0.232s ─tac ----------------------------------- 1.5% 2.3% 2 0.176s ─Reify.transitivity_tt ----------------- 0.0% 2.1% 2 0.092s ─reflexivity --------------------------- 2.0% 2.0% 7 0.052s tactic local total calls max ────────────────────────────────────────┴──────┴──────┴───────┴─────────┘ ─Pipeline.refine_reflectively_gen ------ 0.0% 94.8% 1 7.220s ├─ReflectiveTactics.do_reflective_pipel 0.0% 85.0% 1 6.476s │└ReflectiveTactics.solve_side_conditio 0.0% 84.2% 1 6.416s │ ├─ReflectiveTactics.do_reify -------- 0.0% 50.3% 1 3.832s │ │└Reify.Reify_rhs_gen --------------- 1.8% 49.4% 1 3.760s │ │ ├─Reify.do_reify_abs_goal --------- 31.1% 31.4% 2 2.392s │ │ │└Reify.do_reifyf_goal ------------ 30.0% 30.3% 58 1.528s │ │ │└eexact -------------------------- 7.6% 7.6% 58 0.020s │ │ ├─prove_interp_compile_correct ---- 0.0% 5.8% 1 0.444s │ │ │└rewrite ?EtaInterp.InterpExprEta 5.4% 5.4% 1 0.408s │ │ ├─rewrite H ----------------------- 3.0% 3.0% 1 0.232s │ │ ├─tac ----------------------------- 1.5% 2.3% 1 0.176s │ │ └─Reify.transitivity_tt ----------- 0.0% 2.1% 2 0.092s │ └─ReflectiveTactics.solve_post_reifie 0.5% 33.9% 1 2.584s │ ├─UnifyAbstractReflexivity.unify_tr 22.1% 27.3% 7 0.600s │ │└unify (constr) (constr) --------- 4.3% 4.3% 5 0.096s │ └─ReflectiveTactics.unify_abstract_ 3.9% 5.7% 1 0.432s └─Glue.refine_to_reflective_glue' ----- 0.0% 9.8% 1 0.744s └Glue.zrange_to_reflective ----------- 0.1% 6.8% 1 0.516s └Glue.zrange_to_reflective_goal ------ 3.0% 5.0% 1 0.384s ─synthesize ---------------------------- 0.0% 5.2% 1 0.396s └IntegrationTestTemporaryMiscCommon.do_r 0.1% 4.8% 1 0.364s └change G' ----------------------------- 3.9% 3.9% 1 0.300s src/Specific/X25519/C64/femul (real: 39.72, user: 36.32, sys: 0.26, mem: 825448 ko) COQC src/Specific/X25519/C64/feaddDisplay > src/Specific/X25519/C64/feaddDisplay.log COQC src/Specific/X25519/C64/fecarryDisplay > src/Specific/X25519/C64/fecarryDisplay.log COQC src/Specific/X25519/C64/fesub.v Finished transaction in 3.513 secs (3.211u,0.s) (successful) total time: 3.164s tactic local total calls max ────────────────────────────────────────┴──────┴──────┴───────┴─────────┘ ─Pipeline.refine_reflectively_gen ------ 0.0% 97.6% 1 3.088s ─ReflectiveTactics.do_reflective_pipelin 0.0% 74.1% 1 2.344s ─ReflectiveTactics.solve_side_conditions 0.0% 72.9% 1 2.308s ─ReflectiveTactics.do_reify ------------ 0.0% 38.6% 1 1.220s ─Reify.Reify_rhs_gen ------------------- 1.5% 37.2% 1 1.176s ─ReflectiveTactics.solve_post_reified_si 0.9% 34.4% 1 1.088s ─UnifyAbstractReflexivity.unify_transfor 19.2% 23.9% 7 0.204s ─Glue.refine_to_reflective_glue' ------- 0.0% 23.5% 1 0.744s ─Reify.do_reify_abs_goal --------------- 19.2% 19.5% 2 0.616s ─Reify.do_reifyf_goal ------------------ 18.0% 18.3% 16 0.580s ─Glue.zrange_to_reflective ------------- 0.1% 15.4% 1 0.488s ─Glue.zrange_to_reflective_goal -------- 6.8% 11.5% 1 0.364s ─ReflectiveTactics.unify_abstract_cbv_in 6.2% 9.0% 1 0.284s ─unify (constr) (constr) --------------- 5.9% 5.9% 6 0.080s ─Glue.pattern_sig_sig_assoc ------------ 0.0% 4.6% 1 0.144s ─eexact -------------------------------- 4.4% 4.4% 18 0.012s ─Glue.pattern_proj1_sig_in_sig --------- 1.4% 4.3% 1 0.136s ─prove_interp_compile_correct ---------- 0.0% 3.9% 1 0.124s ─rewrite H ----------------------------- 3.8% 3.8% 1 0.120s ─assert (H : is_bounded_by' bounds (map' 3.8% 3.8% 2 0.064s ─rewrite ?EtaInterp.InterpExprEta ------ 3.5% 3.5% 1 0.112s ─pose proof (pf : Interpretation.Bo 2.9% 2.9% 1 0.092s ─Glue.split_BoundedWordToZ ------------- 0.1% 2.8% 1 0.088s ─tac ----------------------------------- 1.9% 2.5% 2 0.080s ─reflexivity --------------------------- 2.4% 2.4% 7 0.028s ─synthesize ---------------------------- 0.0% 2.4% 1 0.076s ─destruct_sig -------------------------- 0.0% 2.4% 4 0.040s ─destruct x ---------------------------- 2.4% 2.4% 4 0.032s ─clearbody (ne_var_list) --------------- 2.3% 2.3% 4 0.060s ─Reify.transitivity_tt ----------------- 0.1% 2.3% 2 0.036s ─transitivity -------------------------- 2.1% 2.1% 5 0.032s tactic local total calls max ────────────────────────────────────────┴──────┴──────┴───────┴─────────┘ ─Pipeline.refine_reflectively_gen ------ 0.0% 97.6% 1 3.088s ├─ReflectiveTactics.do_reflective_pipel 0.0% 74.1% 1 2.344s │└ReflectiveTactics.solve_side_conditio 0.0% 72.9% 1 2.308s │ ├─ReflectiveTactics.do_reify -------- 0.0% 38.6% 1 1.220s │ │└Reify.Reify_rhs_gen --------------- 1.5% 37.2% 1 1.176s │ │ ├─Reify.do_reify_abs_goal --------- 19.2% 19.5% 2 0.616s │ │ │└Reify.do_reifyf_goal ------------ 18.0% 18.3% 16 0.580s │ │ │└eexact -------------------------- 3.9% 3.9% 16 0.012s │ │ ├─prove_interp_compile_correct ---- 0.0% 3.9% 1 0.124s │ │ │└rewrite ?EtaInterp.InterpExprEta 3.5% 3.5% 1 0.112s │ │ ├─rewrite H ----------------------- 3.8% 3.8% 1 0.120s │ │ ├─tac ----------------------------- 1.9% 2.5% 1 0.080s │ │ └─Reify.transitivity_tt ----------- 0.1% 2.3% 2 0.036s │ │ └transitivity -------------------- 2.0% 2.0% 4 0.032s │ └─ReflectiveTactics.solve_post_reifie 0.9% 34.4% 1 1.088s │ ├─UnifyAbstractReflexivity.unify_tr 19.2% 23.9% 7 0.204s │ │└unify (constr) (constr) --------- 3.4% 3.4% 5 0.036s │ └─ReflectiveTactics.unify_abstract_ 6.2% 9.0% 1 0.284s │ └unify (constr) (constr) --------- 2.5% 2.5% 1 0.080s └─Glue.refine_to_reflective_glue' ----- 0.0% 23.5% 1 0.744s ├─Glue.zrange_to_reflective --------- 0.1% 15.4% 1 0.488s │ ├─Glue.zrange_to_reflective_goal -- 6.8% 11.5% 1 0.364s │ │└pose proof (pf : Interpretat 2.9% 2.9% 1 0.092s │ └─assert (H : is_bounded_by' bounds 3.8% 3.8% 2 0.064s ├─Glue.pattern_sig_sig_assoc -------- 0.0% 4.6% 1 0.144s │└Glue.pattern_proj1_sig_in_sig ----- 1.4% 4.3% 1 0.136s └─Glue.split_BoundedWordToZ --------- 0.1% 2.8% 1 0.088s └destruct_sig ---------------------- 0.0% 2.4% 4 0.040s ─synthesize ---------------------------- 0.0% 2.4% 1 0.076s Finished transaction in 6.12 secs (5.64u,0.008s) (successful) Closed under the global context total time: 3.164s tactic local total calls max ────────────────────────────────────────┴──────┴──────┴───────┴─────────┘ ─Pipeline.refine_reflectively_gen ------ 0.0% 97.6% 1 3.088s ─ReflectiveTactics.do_reflective_pipelin 0.0% 74.1% 1 2.344s ─ReflectiveTactics.solve_side_conditions 0.0% 72.9% 1 2.308s ─ReflectiveTactics.do_reify ------------ 0.0% 38.6% 1 1.220s ─Reify.Reify_rhs_gen ------------------- 1.5% 37.2% 1 1.176s ─ReflectiveTactics.solve_post_reified_si 0.9% 34.4% 1 1.088s ─UnifyAbstractReflexivity.unify_transfor 19.2% 23.9% 7 0.204s ─Glue.refine_to_reflective_glue' ------- 0.0% 23.5% 1 0.744s ─Reify.do_reify_abs_goal --------------- 19.2% 19.5% 2 0.616s ─Reify.do_reifyf_goal ------------------ 18.0% 18.3% 16 0.580s ─Glue.zrange_to_reflective ------------- 0.1% 15.4% 1 0.488s ─Glue.zrange_to_reflective_goal -------- 6.8% 11.5% 1 0.364s ─ReflectiveTactics.unify_abstract_cbv_in 6.2% 9.0% 1 0.284s ─unify (constr) (constr) --------------- 5.9% 5.9% 6 0.080s ─Glue.pattern_sig_sig_assoc ------------ 0.0% 4.6% 1 0.144s ─eexact -------------------------------- 4.4% 4.4% 18 0.012s ─Glue.pattern_proj1_sig_in_sig --------- 1.4% 4.3% 1 0.136s ─prove_interp_compile_correct ---------- 0.0% 3.9% 1 0.124s ─rewrite H ----------------------------- 3.8% 3.8% 1 0.120s ─assert (H : is_bounded_by' bounds (map' 3.8% 3.8% 2 0.064s ─rewrite ?EtaInterp.InterpExprEta ------ 3.5% 3.5% 1 0.112s ─pose proof (pf : Interpretation.Bo 2.9% 2.9% 1 0.092s ─Glue.split_BoundedWordToZ ------------- 0.1% 2.8% 1 0.088s ─tac ----------------------------------- 1.9% 2.5% 2 0.080s ─reflexivity --------------------------- 2.4% 2.4% 7 0.028s ─synthesize ---------------------------- 0.0% 2.4% 1 0.076s ─destruct_sig -------------------------- 0.0% 2.4% 4 0.040s ─destruct x ---------------------------- 2.4% 2.4% 4 0.032s ─clearbody (ne_var_list) --------------- 2.3% 2.3% 4 0.060s ─Reify.transitivity_tt ----------------- 0.1% 2.3% 2 0.036s ─transitivity -------------------------- 2.1% 2.1% 5 0.032s tactic local total calls max ────────────────────────────────────────┴──────┴──────┴───────┴─────────┘ ─Pipeline.refine_reflectively_gen ------ 0.0% 97.6% 1 3.088s ├─ReflectiveTactics.do_reflective_pipel 0.0% 74.1% 1 2.344s │└ReflectiveTactics.solve_side_conditio 0.0% 72.9% 1 2.308s │ ├─ReflectiveTactics.do_reify -------- 0.0% 38.6% 1 1.220s │ │└Reify.Reify_rhs_gen --------------- 1.5% 37.2% 1 1.176s │ │ ├─Reify.do_reify_abs_goal --------- 19.2% 19.5% 2 0.616s │ │ │└Reify.do_reifyf_goal ------------ 18.0% 18.3% 16 0.580s │ │ │└eexact -------------------------- 3.9% 3.9% 16 0.012s │ │ ├─prove_interp_compile_correct ---- 0.0% 3.9% 1 0.124s │ │ │└rewrite ?EtaInterp.InterpExprEta 3.5% 3.5% 1 0.112s │ │ ├─rewrite H ----------------------- 3.8% 3.8% 1 0.120s │ │ ├─tac ----------------------------- 1.9% 2.5% 1 0.080s │ │ └─Reify.transitivity_tt ----------- 0.1% 2.3% 2 0.036s │ │ └transitivity -------------------- 2.0% 2.0% 4 0.032s │ └─ReflectiveTactics.solve_post_reifie 0.9% 34.4% 1 1.088s │ ├─UnifyAbstractReflexivity.unify_tr 19.2% 23.9% 7 0.204s │ │└unify (constr) (constr) --------- 3.4% 3.4% 5 0.036s │ └─ReflectiveTactics.unify_abstract_ 6.2% 9.0% 1 0.284s │ └unify (constr) (constr) --------- 2.5% 2.5% 1 0.080s └─Glue.refine_to_reflective_glue' ----- 0.0% 23.5% 1 0.744s ├─Glue.zrange_to_reflective --------- 0.1% 15.4% 1 0.488s │ ├─Glue.zrange_to_reflective_goal -- 6.8% 11.5% 1 0.364s │ │└pose proof (pf : Interpretat 2.9% 2.9% 1 0.092s │ └─assert (H : is_bounded_by' bounds 3.8% 3.8% 2 0.064s ├─Glue.pattern_sig_sig_assoc -------- 0.0% 4.6% 1 0.144s │└Glue.pattern_proj1_sig_in_sig ----- 1.4% 4.3% 1 0.136s └─Glue.split_BoundedWordToZ --------- 0.1% 2.8% 1 0.088s └destruct_sig ---------------------- 0.0% 2.4% 4 0.040s ─synthesize ---------------------------- 0.0% 2.4% 1 0.076s src/Specific/X25519/C64/fesub (real: 24.71, user: 22.65, sys: 0.24, mem: 778792 ko) COQC src/Specific/X25519/C64/fesquare.v Finished transaction in 6.132 secs (5.516u,0.012s) (successful) total time: 5.480s tactic local total calls max ────────────────────────────────────────┴──────┴──────┴───────┴─────────┘ ─synthesize ---------------------------- -0.0% 100.0% 1 5.480s ─Pipeline.refine_reflectively_gen ------ 0.0% 95.7% 1 5.244s ─ReflectiveTactics.do_reflective_pipelin 0.0% 88.6% 1 4.856s ─ReflectiveTactics.solve_side_conditions 0.0% 87.7% 1 4.804s ─ReflectiveTactics.do_reify ------------ 0.0% 53.3% 1 2.920s ─Reify.Reify_rhs_gen ------------------- 2.0% 52.5% 1 2.876s ─ReflectiveTactics.solve_post_reified_si 0.6% 34.4% 1 1.884s ─Reify.do_reify_abs_goal --------------- 33.2% 33.6% 2 1.844s ─Reify.do_reifyf_goal ------------------ 31.5% 32.0% 47 1.392s ─UnifyAbstractReflexivity.unify_transfor 21.9% 26.6% 7 0.400s ─eexact -------------------------------- 10.0% 10.0% 49 0.028s ─Glue.refine_to_reflective_glue' ------- 0.0% 7.1% 1 0.388s ─ReflectiveTactics.unify_abstract_cbv_in 5.0% 6.9% 1 0.380s ─unify (constr) (constr) --------------- 5.8% 5.8% 6 0.104s ─prove_interp_compile_correct ---------- 0.0% 5.8% 1 0.316s ─rewrite ?EtaInterp.InterpExprEta ------ 5.3% 5.3% 1 0.288s ─Glue.zrange_to_reflective ------------- 0.1% 5.1% 1 0.280s ─IntegrationTestTemporaryMiscCommon.do_r 0.1% 4.0% 1 0.220s ─Glue.zrange_to_reflective_goal -------- 3.1% 3.9% 1 0.212s ─change G' ----------------------------- 3.4% 3.4% 1 0.184s ─tac ----------------------------------- 2.0% 2.8% 2 0.156s ─rewrite H ----------------------------- 2.8% 2.8% 1 0.156s ─reflexivity --------------------------- 2.8% 2.8% 7 0.064s tactic local total calls max ────────────────────────────────────────┴──────┴──────┴───────┴─────────┘ ─synthesize ---------------------------- -0.0% 100.0% 1 5.480s ├─Pipeline.refine_reflectively_gen ---- 0.0% 95.7% 1 5.244s │ ├─ReflectiveTactics.do_reflective_pip 0.0% 88.6% 1 4.856s │ │└ReflectiveTactics.solve_side_condit 0.0% 87.7% 1 4.804s │ │ ├─ReflectiveTactics.do_reify ------ 0.0% 53.3% 1 2.920s │ │ │└Reify.Reify_rhs_gen ------------- 2.0% 52.5% 1 2.876s │ │ │ ├─Reify.do_reify_abs_goal ------- 33.2% 33.6% 2 1.844s │ │ │ │└Reify.do_reifyf_goal ---------- 31.5% 32.0% 47 1.392s │ │ │ │└eexact ------------------------ 9.1% 9.1% 47 0.024s │ │ │ ├─prove_interp_compile_correct -- 0.0% 5.8% 1 0.316s │ │ │ │└rewrite ?EtaInterp.InterpExprEt 5.3% 5.3% 1 0.288s │ │ │ ├─tac --------------------------- 2.0% 2.8% 1 0.156s │ │ │ └─rewrite H --------------------- 2.8% 2.8% 1 0.156s │ │ └─ReflectiveTactics.solve_post_reif 0.6% 34.4% 1 1.884s │ │ ├─UnifyAbstractReflexivity.unify_ 21.9% 26.6% 7 0.400s │ │ │└unify (constr) (constr) ------- 3.9% 3.9% 5 0.072s │ │ └─ReflectiveTactics.unify_abstrac 5.0% 6.9% 1 0.380s │ └─Glue.refine_to_reflective_glue' --- 0.0% 7.1% 1 0.388s │ └Glue.zrange_to_reflective --------- 0.1% 5.1% 1 0.280s │ └Glue.zrange_to_reflective_goal ---- 3.1% 3.9% 1 0.212s └─IntegrationTestTemporaryMiscCommon.do 0.1% 4.0% 1 0.220s └change G' --------------------------- 3.4% 3.4% 1 0.184s Finished transaction in 10.475 secs (9.728u,0.007s) (successful) Closed under the global context total time: 5.480s tactic local total calls max ────────────────────────────────────────┴──────┴──────┴───────┴─────────┘ ─synthesize ---------------------------- -0.0% 100.0% 1 5.480s ─Pipeline.refine_reflectively_gen ------ 0.0% 95.7% 1 5.244s ─ReflectiveTactics.do_reflective_pipelin 0.0% 88.6% 1 4.856s ─ReflectiveTactics.solve_side_conditions 0.0% 87.7% 1 4.804s ─ReflectiveTactics.do_reify ------------ 0.0% 53.3% 1 2.920s ─Reify.Reify_rhs_gen ------------------- 2.0% 52.5% 1 2.876s ─ReflectiveTactics.solve_post_reified_si 0.6% 34.4% 1 1.884s ─Reify.do_reify_abs_goal --------------- 33.2% 33.6% 2 1.844s ─Reify.do_reifyf_goal ------------------ 31.5% 32.0% 47 1.392s ─UnifyAbstractReflexivity.unify_transfor 21.9% 26.6% 7 0.400s ─eexact -------------------------------- 10.0% 10.0% 49 0.028s ─Glue.refine_to_reflective_glue' ------- 0.0% 7.1% 1 0.388s ─ReflectiveTactics.unify_abstract_cbv_in 5.0% 6.9% 1 0.380s ─unify (constr) (constr) --------------- 5.8% 5.8% 6 0.104s ─prove_interp_compile_correct ---------- 0.0% 5.8% 1 0.316s ─rewrite ?EtaInterp.InterpExprEta ------ 5.3% 5.3% 1 0.288s ─Glue.zrange_to_reflective ------------- 0.1% 5.1% 1 0.280s ─IntegrationTestTemporaryMiscCommon.do_r 0.1% 4.0% 1 0.220s ─Glue.zrange_to_reflective_goal -------- 3.1% 3.9% 1 0.212s ─change G' ----------------------------- 3.4% 3.4% 1 0.184s ─tac ----------------------------------- 2.0% 2.8% 2 0.156s ─rewrite H ----------------------------- 2.8% 2.8% 1 0.156s ─reflexivity --------------------------- 2.8% 2.8% 7 0.064s tactic local total calls max ────────────────────────────────────────┴──────┴──────┴───────┴─────────┘ ─synthesize ---------------------------- -0.0% 100.0% 1 5.480s ├─Pipeline.refine_reflectively_gen ---- 0.0% 95.7% 1 5.244s │ ├─ReflectiveTactics.do_reflective_pip 0.0% 88.6% 1 4.856s │ │└ReflectiveTactics.solve_side_condit 0.0% 87.7% 1 4.804s │ │ ├─ReflectiveTactics.do_reify ------ 0.0% 53.3% 1 2.920s │ │ │└Reify.Reify_rhs_gen ------------- 2.0% 52.5% 1 2.876s │ │ │ ├─Reify.do_reify_abs_goal ------- 33.2% 33.6% 2 1.844s │ │ │ │└Reify.do_reifyf_goal ---------- 31.5% 32.0% 47 1.392s │ │ │ │└eexact ------------------------ 9.1% 9.1% 47 0.024s │ │ │ ├─prove_interp_compile_correct -- 0.0% 5.8% 1 0.316s │ │ │ │└rewrite ?EtaInterp.InterpExprEt 5.3% 5.3% 1 0.288s │ │ │ ├─tac --------------------------- 2.0% 2.8% 1 0.156s │ │ │ └─rewrite H --------------------- 2.8% 2.8% 1 0.156s │ │ └─ReflectiveTactics.solve_post_reif 0.6% 34.4% 1 1.884s │ │ ├─UnifyAbstractReflexivity.unify_ 21.9% 26.6% 7 0.400s │ │ │└unify (constr) (constr) ------- 3.9% 3.9% 5 0.072s │ │ └─ReflectiveTactics.unify_abstrac 5.0% 6.9% 1 0.380s │ └─Glue.refine_to_reflective_glue' --- 0.0% 7.1% 1 0.388s │ └Glue.zrange_to_reflective --------- 0.1% 5.1% 1 0.280s │ └Glue.zrange_to_reflective_goal ---- 3.1% 3.9% 1 0.212s └─IntegrationTestTemporaryMiscCommon.do 0.1% 4.0% 1 0.220s └change G' --------------------------- 3.4% 3.4% 1 0.184s src/Specific/X25519/C64/fesquare (real: 33.08, user: 30.13, sys: 0.24, mem: 799620 ko) COQC src/Specific/X25519/C64/femulDisplay > src/Specific/X25519/C64/femulDisplay.log COQC src/Specific/X25519/C64/freeze.v Finished transaction in 7.307 secs (6.763u,0.011s) (successful) total time: 6.732s tactic local total calls max ────────────────────────────────────────┴──────┴──────┴───────┴─────────┘ ─synthesize_freeze --------------------- 0.0% 100.0% 1 6.732s ─Pipeline.refine_reflectively_gen ------ 0.0% 99.3% 1 6.684s ─ReflectiveTactics.do_reflective_pipelin 0.0% 92.8% 1 6.248s ─ReflectiveTactics.solve_side_conditions 0.0% 92.0% 1 6.192s ─ReflectiveTactics.do_reify ------------ -0.0% 60.3% 1 4.060s ─Reify.Reify_rhs_gen ------------------- 1.5% 59.6% 1 4.012s ─Reify.do_reify_abs_goal --------------- 42.4% 42.7% 2 2.876s ─Reify.do_reifyf_goal ------------------ 41.3% 41.7% 129 2.804s ─ReflectiveTactics.solve_post_reified_si 0.6% 31.7% 1 2.132s ─UnifyAbstractReflexivity.unify_transfor 21.7% 25.8% 7 0.424s ─eexact -------------------------------- 13.7% 13.7% 131 0.036s ─Glue.refine_to_reflective_glue' ------- 0.0% 6.5% 1 0.436s ─prove_interp_compile_correct ---------- 0.0% 5.1% 1 0.344s ─ReflectiveTactics.unify_abstract_cbv_in 3.4% 5.0% 1 0.336s ─rewrite ?EtaInterp.InterpExprEta ------ 4.7% 4.7% 1 0.316s ─unify (constr) (constr) --------------- 4.6% 4.6% 6 0.100s ─Glue.zrange_to_reflective ------------- 0.0% 4.2% 1 0.280s ─Glue.zrange_to_reflective_goal -------- 2.4% 3.3% 1 0.220s ─Reify.transitivity_tt ----------------- 0.1% 2.6% 2 0.116s ─rewrite H ----------------------------- 2.6% 2.6% 1 0.172s ─tac ----------------------------------- 1.5% 2.3% 2 0.156s ─reflexivity --------------------------- 2.3% 2.3% 7 0.052s tactic local total calls max ────────────────────────────────────────┴──────┴──────┴───────┴─────────┘ ─synthesize_freeze --------------------- 0.0% 100.0% 1 6.732s └Pipeline.refine_reflectively_gen ------ 0.0% 99.3% 1 6.684s ├─ReflectiveTactics.do_reflective_pipel 0.0% 92.8% 1 6.248s │└ReflectiveTactics.solve_side_conditio 0.0% 92.0% 1 6.192s │ ├─ReflectiveTactics.do_reify -------- -0.0% 60.3% 1 4.060s │ │└Reify.Reify_rhs_gen --------------- 1.5% 59.6% 1 4.012s │ │ ├─Reify.do_reify_abs_goal --------- 42.4% 42.7% 2 2.876s │ │ │└Reify.do_reifyf_goal ------------ 41.3% 41.7% 129 2.804s │ │ │└eexact -------------------------- 13.0% 13.0% 129 0.036s │ │ ├─prove_interp_compile_correct ---- 0.0% 5.1% 1 0.344s │ │ │└rewrite ?EtaInterp.InterpExprEta 4.7% 4.7% 1 0.316s │ │ ├─Reify.transitivity_tt ----------- 0.1% 2.6% 2 0.116s │ │ ├─rewrite H ----------------------- 2.6% 2.6% 1 0.172s │ │ └─tac ----------------------------- 1.5% 2.3% 1 0.156s │ └─ReflectiveTactics.solve_post_reifie 0.6% 31.7% 1 2.132s │ ├─UnifyAbstractReflexivity.unify_tr 21.7% 25.8% 7 0.424s │ │└unify (constr) (constr) --------- 3.1% 3.1% 5 0.084s │ └─ReflectiveTactics.unify_abstract_ 3.4% 5.0% 1 0.336s └─Glue.refine_to_reflective_glue' ----- 0.0% 6.5% 1 0.436s └Glue.zrange_to_reflective ----------- 0.0% 4.2% 1 0.280s └Glue.zrange_to_reflective_goal ------ 2.4% 3.3% 1 0.220s Finished transaction in 10.495 secs (9.756u,0.s) (successful) Closed under the global context total time: 6.732s tactic local total calls max ────────────────────────────────────────┴──────┴──────┴───────┴─────────┘ ─synthesize_freeze --------------------- 0.0% 100.0% 1 6.732s ─Pipeline.refine_reflectively_gen ------ 0.0% 99.3% 1 6.684s ─ReflectiveTactics.do_reflective_pipelin 0.0% 92.8% 1 6.248s ─ReflectiveTactics.solve_side_conditions 0.0% 92.0% 1 6.192s ─ReflectiveTactics.do_reify ------------ -0.0% 60.3% 1 4.060s ─Reify.Reify_rhs_gen ------------------- 1.5% 59.6% 1 4.012s ─Reify.do_reify_abs_goal --------------- 42.4% 42.7% 2 2.876s ─Reify.do_reifyf_goal ------------------ 41.3% 41.7% 129 2.804s ─ReflectiveTactics.solve_post_reified_si 0.6% 31.7% 1 2.132s ─UnifyAbstractReflexivity.unify_transfor 21.7% 25.8% 7 0.424s ─eexact -------------------------------- 13.7% 13.7% 131 0.036s ─Glue.refine_to_reflective_glue' ------- 0.0% 6.5% 1 0.436s ─prove_interp_compile_correct ---------- 0.0% 5.1% 1 0.344s ─ReflectiveTactics.unify_abstract_cbv_in 3.4% 5.0% 1 0.336s ─rewrite ?EtaInterp.InterpExprEta ------ 4.7% 4.7% 1 0.316s ─unify (constr) (constr) --------------- 4.6% 4.6% 6 0.100s ─Glue.zrange_to_reflective ------------- 0.0% 4.2% 1 0.280s ─Glue.zrange_to_reflective_goal -------- 2.4% 3.3% 1 0.220s ─Reify.transitivity_tt ----------------- 0.1% 2.6% 2 0.116s ─rewrite H ----------------------------- 2.6% 2.6% 1 0.172s ─tac ----------------------------------- 1.5% 2.3% 2 0.156s ─reflexivity --------------------------- 2.3% 2.3% 7 0.052s tactic local total calls max ────────────────────────────────────────┴──────┴──────┴───────┴─────────┘ ─synthesize_freeze --------------------- 0.0% 100.0% 1 6.732s └Pipeline.refine_reflectively_gen ------ 0.0% 99.3% 1 6.684s ├─ReflectiveTactics.do_reflective_pipel 0.0% 92.8% 1 6.248s │└ReflectiveTactics.solve_side_conditio 0.0% 92.0% 1 6.192s │ ├─ReflectiveTactics.do_reify -------- -0.0% 60.3% 1 4.060s │ │└Reify.Reify_rhs_gen --------------- 1.5% 59.6% 1 4.012s │ │ ├─Reify.do_reify_abs_goal --------- 42.4% 42.7% 2 2.876s │ │ │└Reify.do_reifyf_goal ------------ 41.3% 41.7% 129 2.804s │ │ │└eexact -------------------------- 13.0% 13.0% 129 0.036s │ │ ├─prove_interp_compile_correct ---- 0.0% 5.1% 1 0.344s │ │ │└rewrite ?EtaInterp.InterpExprEta 4.7% 4.7% 1 0.316s │ │ ├─Reify.transitivity_tt ----------- 0.1% 2.6% 2 0.116s │ │ ├─rewrite H ----------------------- 2.6% 2.6% 1 0.172s │ │ └─tac ----------------------------- 1.5% 2.3% 1 0.156s │ └─ReflectiveTactics.solve_post_reifie 0.6% 31.7% 1 2.132s │ ├─UnifyAbstractReflexivity.unify_tr 21.7% 25.8% 7 0.424s │ │└unify (constr) (constr) --------- 3.1% 3.1% 5 0.084s │ └─ReflectiveTactics.unify_abstract_ 3.4% 5.0% 1 0.336s └─Glue.refine_to_reflective_glue' ----- 0.0% 6.5% 1 0.436s └Glue.zrange_to_reflective ----------- 0.0% 4.2% 1 0.280s └Glue.zrange_to_reflective_goal ------ 2.4% 3.3% 1 0.220s src/Specific/X25519/C64/freeze (real: 34.35, user: 31.50, sys: 0.24, mem: 828104 ko) COQC src/Specific/NISTP256/AMD64/feadd.v Finished transaction in 8.784 secs (8.176u,0.011s) (successful) total time: 8.140s tactic local total calls max ────────────────────────────────────────┴──────┴──────┴───────┴─────────┘ ─Pipeline.refine_reflectively_gen ------ 0.0% 52.4% 1 4.268s ─synthesize_montgomery ----------------- 0.0% 47.6% 1 3.872s ─ReflectiveTactics.do_reflective_pipelin 0.0% 43.8% 1 3.568s ─ReflectiveTactics.solve_side_conditions 0.0% 43.2% 1 3.520s ─IntegrationTestTemporaryMiscCommon.fact 1.4% 23.6% 1 1.924s ─IntegrationTestTemporaryMiscCommon.do_r 0.0% 22.1% 1 1.796s ─ReflectiveTactics.do_reify ------------ 0.1% 21.7% 1 1.768s ─ReflectiveTactics.solve_post_reified_si 0.6% 21.5% 1 1.752s ─Reify.Reify_rhs_gen ------------------- 1.0% 20.9% 1 1.704s ─op_sig_side_conditions_t -------------- 0.0% 20.0% 1 1.624s ─DestructHyps.do_all_matches_then ------ 0.0% 20.0% 8 0.244s ─DestructHyps.do_one_match_then -------- 0.7% 19.9% 44 0.052s ─do_tac -------------------------------- 0.0% 19.2% 36 0.052s ─destruct H ---------------------------- 19.2% 19.2% 36 0.052s ─rewrite <- (lem : lemT) by by_tac ltac: 0.2% 17.3% 1 1.408s ─IntegrationTestTemporaryMiscCommon.do_r 0.0% 17.3% 1 1.408s ─by_tac -------------------------------- 0.0% 17.1% 4 0.504s ─rewrite <- (ZRange.is_bounded_by_None_r 16.7% 16.7% 8 0.344s ─UnifyAbstractReflexivity.unify_transfor 13.3% 16.1% 7 0.360s ─Reify.do_reify_abs_goal --------------- 9.9% 10.1% 2 0.820s ─Reify.do_reifyf_goal ------------------ 9.1% 9.3% 93 0.748s ─Glue.refine_to_reflective_glue' ------- 0.0% 8.6% 1 0.700s ─Glue.zrange_to_reflective ------------- 0.0% 5.3% 1 0.432s ─IntegrationTestTemporaryMiscCommon.do_s 0.0% 4.8% 1 0.388s ─ MapProjections.proj2 2.4% 2.4% 2 0.120s tactic local total calls max ────────────────────────────────────────┴──────┴──────┴───────┴─────────┘ ─Pipeline.refine_reflectively_gen ------ 0.0% 52.4% 1 4.268s ├─ReflectiveTactics.do_reflective_pipel 0.0% 43.8% 1 3.568s │└ReflectiveTactics.solve_side_conditio 0.0% 43.2% 1 3.520s │ ├─ReflectiveTactics.do_reify -------- 0.1% 21.7% 1 1.768s │ │└Reify.Reify_rhs_gen --------------- 1.0% 20.9% 1 1.704s │ │ ├─Reify.do_reify_abs_goal --------- 9.9% 10.1% 2 0.820s │ │ │└Reify.do_reifyf_goal ------------ 9.1% 9.3% 93 0.748s │ │ │└eexact -------------------------- 2.3% 2.3% 93 0.024s │ │ ├─prove_interp_compile_correct ---- 0.0% 2.5% 1 0.204s │ │ └─rewrite H ----------------------- 2.4% 2.4% 1 0.196s │ └─ReflectiveTactics.solve_post_reifie 0.6% 21.5% 1 1.752s │ ├─UnifyAbstractReflexivity.unify_tr 13.3% 16.1% 7 0.360s │ │└unify (constr) (constr) --------- 2.2% 2.2% 5 0.064s │ └─ReflectiveTactics.unify_abstract_ 3.3% 4.5% 1 0.368s └─Glue.refine_to_reflective_glue' ----- 0.0% 8.6% 1 0.700s └Glue.zrange_to_reflective ----------- 0.0% 5.3% 1 0.432s └Glue.zrange_to_reflective_goal ------ 2.6% 4.0% 1 0.324s ─synthesize_montgomery ----------------- 0.0% 47.6% 1 3.872s ├─IntegrationTestTemporaryMiscCommon.fa 1.4% 23.6% 1 1.924s │└op_sig_side_conditions_t ------------ 0.0% 20.0% 1 1.624s │ ├─DestructHyps.do_all_matches_then -- 0.0% 11.4% 4 0.244s │ │└DestructHyps.do_one_match_then ---- 0.3% 11.4% 24 0.052s │ │└do_tac ---------------------------- 0.0% 11.1% 20 0.052s │ │└destruct H ------------------------ 11.1% 11.1% 20 0.052s │ └─rewrite <- (ZRange.is_bounded_by_No 8.4% 8.4% 4 0.328s └─IntegrationTestTemporaryMiscCommon.do 0.0% 22.1% 1 1.796s ├─IntegrationTestTemporaryMiscCommon. 0.0% 17.3% 1 1.408s │└rewrite <- (lem : lemT) by by_tac l 0.2% 17.3% 1 1.408s │└by_tac ---------------------------- 0.0% 17.1% 4 0.504s │ ├─DestructHyps.do_all_matches_then 0.0% 8.6% 4 0.184s │ │└DestructHyps.do_one_match_then -- 0.3% 8.5% 20 0.052s │ │└do_tac -------------------------- 0.0% 8.2% 16 0.052s │ │└destruct H ---------------------- 8.2% 8.2% 16 0.052s │ └─rewrite <- (ZRange.is_bounded_by_ 8.3% 8.3% 4 0.344s └─IntegrationTestTemporaryMiscCommon. 0.0% 4.8% 1 0.388s └ MapProjections.proj2 2.4% 2.4% 2 0.120s tactic local total calls max ────────────────────────────────────────┴──────┴──────┴───────┴─────────┘ ─Pipeline.refine_reflectively_gen ------ 0.0% 52.4% 1 4.268s ├─ReflectiveTactics.do_reflective_pipel 0.0% 43.8% 1 3.568s │└ReflectiveTactics.solve_side_conditio 0.0% 43.2% 1 3.520s │ ├─ReflectiveTactics.do_reify -------- 0.1% 21.7% 1 1.768s │ │└Reify.Reify_rhs_gen --------------- 1.0% 20.9% 1 1.704s │ │ ├─Reify.do_reify_abs_goal --------- 9.9% 10.1% 2 0.820s │ │ │└Reify.do_reifyf_goal ------------ 9.1% 9.3% 93 0.748s │ │ │└eexact -------------------------- 2.3% 2.3% 93 0.024s │ │ ├─prove_interp_compile_correct ---- 0.0% 2.5% 1 0.204s │ │ └─rewrite H ----------------------- 2.4% 2.4% 1 0.196s │ └─ReflectiveTactics.solve_post_reifie 0.6% 21.5% 1 1.752s │ ├─UnifyAbstractReflexivity.unify_tr 13.3% 16.1% 7 0.360s │ │└unify (constr) (constr) --------- 2.2% 2.2% 5 0.064s │ └─ReflectiveTactics.unify_abstract_ 3.3% 4.5% 1 0.368s └─Glue.refine_to_reflective_glue' ----- 0.0% 8.6% 1 0.700s └Glue.zrange_to_reflective ----------- 0.0% 5.3% 1 0.432s └Glue.zrange_to_reflective_goal ------ 2.6% 4.0% 1 0.324s ─synthesize_montgomery ----------------- 0.0% 47.6% 1 3.872s ├─IntegrationTestTemporaryMiscCommon.fa 1.4% 23.6% 1 1.924s │└op_sig_side_conditions_t ------------ 0.0% 20.0% 1 1.624s │ ├─DestructHyps.do_all_matches_then -- 0.0% 11.4% 4 0.244s │ │└DestructHyps.do_one_match_then ---- 0.3% 11.4% 24 0.052s │ │└do_tac ---------------------------- 0.0% 11.1% 20 0.052s │ │└destruct H ------------------------ 11.1% 11.1% 20 0.052s │ └─rewrite <- (ZRange.is_bounded_by_No 8.4% 8.4% 4 0.328s └─IntegrationTestTemporaryMiscCommon.do 0.0% 22.1% 1 1.796s ├─IntegrationTestTemporaryMiscCommon. 0.0% 17.3% 1 1.408s │└rewrite <- (lem : lemT) by by_tac l 0.2% 17.3% 1 1.408s │└by_tac ---------------------------- 0.0% 17.1% 4 0.504s │ ├─DestructHyps.do_all_matches_then 0.0% 8.6% 4 0.184s │ │└DestructHyps.do_one_match_then -- 0.3% 8.5% 20 0.052s │ │└do_tac -------------------------- 0.0% 8.2% 16 0.052s │ │└destruct H ---------------------- 8.2% 8.2% 16 0.052s │ └─rewrite <- (ZRange.is_bounded_by_ 8.3% 8.3% 4 0.344s └─IntegrationTestTemporaryMiscCommon. 0.0% 4.8% 1 0.388s └ src/Specific/NISTP256/AMD64/feaddDisplay.log COQC src/Specific/NISTP256/AMD64/fenzDisplay > src/Specific/NISTP256/AMD64/fenzDisplay.log COQC src/Specific/solinas32_2e255m765_12limbs/femul.v Finished transaction in 50.426 secs (46.528u,0.072s) (successful) total time: 46.544s tactic local total calls max ────────────────────────────────────────┴──────┴──────┴───────┴─────────┘ ─Pipeline.refine_reflectively_gen ------ -0.0% 94.9% 1 44.164s ─ReflectiveTactics.do_reflective_pipelin 0.0% 87.1% 1 40.552s ─ReflectiveTactics.solve_side_conditions 0.0% 86.7% 1 40.372s ─ReflectiveTactics.do_reify ------------ 0.0% 59.6% 1 27.740s ─Reify.Reify_rhs_gen ------------------- 1.6% 58.9% 1 27.432s ─Reify.do_reify_abs_goal --------------- 43.3% 43.6% 2 20.312s ─Reify.do_reifyf_goal ------------------ 42.5% 42.8% 108 10.328s ─ReflectiveTactics.solve_post_reified_si 0.1% 27.1% 1 12.632s ─UnifyAbstractReflexivity.unify_transfor 18.6% 23.5% 7 3.552s ─eexact -------------------------------- 13.7% 13.7% 110 0.136s ─Glue.refine_to_reflective_glue' ------- 0.0% 7.8% 1 3.612s ─Glue.zrange_to_reflective ------------- 0.0% 7.2% 1 3.332s ─Glue.zrange_to_reflective_goal -------- 1.7% 5.5% 1 2.544s ─synthesize ---------------------------- 0.0% 5.1% 1 2.380s ─unify (constr) (constr) --------------- 5.1% 5.1% 6 1.068s ─IntegrationTestTemporaryMiscCommon.do_r 0.0% 5.0% 1 2.320s ─change G' ----------------------------- 4.8% 4.8% 1 2.252s ─rewrite H ----------------------------- 3.8% 3.8% 1 1.748s ─pose proof (pf : Interpretation.Bo 3.6% 3.6% 1 1.664s ─prove_interp_compile_correct ---------- 0.0% 3.5% 1 1.616s ─rewrite ?EtaInterp.InterpExprEta ------ 3.2% 3.2% 1 1.468s ─ReflectiveTactics.unify_abstract_cbv_in 1.6% 2.4% 1 1.124s ─reflexivity --------------------------- 2.1% 2.1% 7 0.396s tactic local total calls max ────────────────────────────────────────┴──────┴──────┴───────┴─────────┘ ─Pipeline.refine_reflectively_gen ------ -0.0% 94.9% 1 44.164s ├─ReflectiveTactics.do_reflective_pipel 0.0% 87.1% 1 40.552s │└ReflectiveTactics.solve_side_conditio 0.0% 86.7% 1 40.372s │ ├─ReflectiveTactics.do_reify -------- 0.0% 59.6% 1 27.740s │ │└Reify.Reify_rhs_gen --------------- 1.6% 58.9% 1 27.432s │ │ ├─Reify.do_reify_abs_goal --------- 43.3% 43.6% 2 20.312s │ │ │└Reify.do_reifyf_goal ------------ 42.5% 42.8% 108 10.328s │ │ │└eexact -------------------------- 13.2% 13.2% 108 0.072s │ │ ├─rewrite H ----------------------- 3.8% 3.8% 1 1.748s │ │ └─prove_interp_compile_correct ---- 0.0% 3.5% 1 1.616s │ │ └rewrite ?EtaInterp.InterpExprEta 3.2% 3.2% 1 1.468s │ └─ReflectiveTactics.solve_post_reifie 0.1% 27.1% 1 12.632s │ ├─UnifyAbstractReflexivity.unify_tr 18.6% 23.5% 7 3.552s │ │└unify (constr) (constr) --------- 4.3% 4.3% 5 1.068s │ └─ReflectiveTactics.unify_abstract_ 1.6% 2.4% 1 1.124s └─Glue.refine_to_reflective_glue' ----- 0.0% 7.8% 1 3.612s └Glue.zrange_to_reflective ----------- 0.0% 7.2% 1 3.332s └Glue.zrange_to_reflective_goal ------ 1.7% 5.5% 1 2.544s └pose proof (pf : Interpretation. 3.6% 3.6% 1 1.664s ─synthesize ---------------------------- 0.0% 5.1% 1 2.380s └IntegrationTestTemporaryMiscCommon.do_r 0.0% 5.0% 1 2.320s └change G' ----------------------------- 4.8% 4.8% 1 2.252s Finished transaction in 80.129 secs (74.068u,0.024s) (successful) Closed under the global context total time: 46.544s tactic local total calls max ────────────────────────────────────────┴──────┴──────┴───────┴─────────┘ ─Pipeline.refine_reflectively_gen ------ -0.0% 94.9% 1 44.164s ─ReflectiveTactics.do_reflective_pipelin 0.0% 87.1% 1 40.552s ─ReflectiveTactics.solve_side_conditions 0.0% 86.7% 1 40.372s ─ReflectiveTactics.do_reify ------------ 0.0% 59.6% 1 27.740s ─Reify.Reify_rhs_gen ------------------- 1.6% 58.9% 1 27.432s ─Reify.do_reify_abs_goal --------------- 43.3% 43.6% 2 20.312s ─Reify.do_reifyf_goal ------------------ 42.5% 42.8% 108 10.328s ─ReflectiveTactics.solve_post_reified_si 0.1% 27.1% 1 12.632s ─UnifyAbstractReflexivity.unify_transfor 18.6% 23.5% 7 3.552s ─eexact -------------------------------- 13.7% 13.7% 110 0.136s ─Glue.refine_to_reflective_glue' ------- 0.0% 7.8% 1 3.612s ─Glue.zrange_to_reflective ------------- 0.0% 7.2% 1 3.332s ─Glue.zrange_to_reflective_goal -------- 1.7% 5.5% 1 2.544s ─synthesize ---------------------------- 0.0% 5.1% 1 2.380s ─unify (constr) (constr) --------------- 5.1% 5.1% 6 1.068s ─IntegrationTestTemporaryMiscCommon.do_r 0.0% 5.0% 1 2.320s ─change G' ----------------------------- 4.8% 4.8% 1 2.252s ─rewrite H ----------------------------- 3.8% 3.8% 1 1.748s ─pose proof (pf : Interpretation.Bo 3.6% 3.6% 1 1.664s ─prove_interp_compile_correct ---------- 0.0% 3.5% 1 1.616s ─rewrite ?EtaInterp.InterpExprEta ------ 3.2% 3.2% 1 1.468s ─ReflectiveTactics.unify_abstract_cbv_in 1.6% 2.4% 1 1.124s ─reflexivity --------------------------- 2.1% 2.1% 7 0.396s tactic local total calls max ────────────────────────────────────────┴──────┴──────┴───────┴─────────┘ ─Pipeline.refine_reflectively_gen ------ -0.0% 94.9% 1 44.164s ├─ReflectiveTactics.do_reflective_pipel 0.0% 87.1% 1 40.552s │└ReflectiveTactics.solve_side_conditio 0.0% 86.7% 1 40.372s │ ├─ReflectiveTactics.do_reify -------- 0.0% 59.6% 1 27.740s │ │└Reify.Reify_rhs_gen --------------- 1.6% 58.9% 1 27.432s │ │ ├─Reify.do_reify_abs_goal --------- 43.3% 43.6% 2 20.312s │ │ │└Reify.do_reifyf_goal ------------ 42.5% 42.8% 108 10.328s │ │ │└eexact -------------------------- 13.2% 13.2% 108 0.072s │ │ ├─rewrite H ----------------------- 3.8% 3.8% 1 1.748s │ │ └─prove_interp_compile_correct ---- 0.0% 3.5% 1 1.616s │ │ └rewrite ?EtaInterp.InterpExprEta 3.2% 3.2% 1 1.468s │ └─ReflectiveTactics.solve_post_reifie 0.1% 27.1% 1 12.632s │ ├─UnifyAbstractReflexivity.unify_tr 18.6% 23.5% 7 3.552s │ │└unify (constr) (constr) --------- 4.3% 4.3% 5 1.068s │ └─ReflectiveTactics.unify_abstract_ 1.6% 2.4% 1 1.124s └─Glue.refine_to_reflective_glue' ----- 0.0% 7.8% 1 3.612s └Glue.zrange_to_reflective ----------- 0.0% 7.2% 1 3.332s └Glue.zrange_to_reflective_goal ------ 1.7% 5.5% 1 2.544s └pose proof (pf : Interpretation. 3.6% 3.6% 1 1.664s ─synthesize ---------------------------- 0.0% 5.1% 1 2.380s └IntegrationTestTemporaryMiscCommon.do_r 0.0% 5.0% 1 2.320s └change G' ----------------------------- 4.8% 4.8% 1 2.252s src/Specific/solinas32_2e255m765_12limbs/femul (real: 155.79, user: 143.70, sys: 0.32, mem: 1454696 ko) COQC src/Specific/NISTP256/AMD64/feoppDisplay > src/Specific/NISTP256/AMD64/feoppDisplay.log COQC src/Specific/NISTP256/AMD64/fesubDisplay > src/Specific/NISTP256/AMD64/fesubDisplay.log COQC src/Specific/X25519/C64/fesquareDisplay > src/Specific/X25519/C64/fesquareDisplay.log COQC src/Specific/X25519/C64/fesubDisplay > src/Specific/X25519/C64/fesubDisplay.log COQC src/Specific/X25519/C64/freezeDisplay > src/Specific/X25519/C64/freezeDisplay.log COQC src/Specific/solinas32_2e255m765_13limbs/femul.v Finished transaction in 61.854 secs (57.328u,0.079s) (successful) total time: 57.348s tactic local total calls max ────────────────────────────────────────┴──────┴──────┴───────┴─────────┘ ─Pipeline.refine_reflectively_gen ------ 0.0% 94.6% 1 54.224s ─ReflectiveTactics.do_reflective_pipelin 0.0% 86.2% 1 49.452s ─ReflectiveTactics.solve_side_conditions 0.0% 85.9% 1 49.264s ─ReflectiveTactics.do_reify ------------ -0.0% 57.6% 1 33.004s ─Reify.Reify_rhs_gen ------------------- 1.3% 56.9% 1 32.608s ─Reify.do_reify_abs_goal --------------- 43.1% 43.3% 2 24.840s ─Reify.do_reifyf_goal ------------------ 42.3% 42.6% 117 12.704s ─ReflectiveTactics.solve_post_reified_si 0.1% 28.4% 1 16.260s ─UnifyAbstractReflexivity.unify_transfor 19.6% 25.0% 7 4.824s ─eexact -------------------------------- 13.9% 13.9% 119 0.144s ─Glue.refine_to_reflective_glue' ------- 0.0% 8.3% 1 4.772s ─Glue.zrange_to_reflective ------------- 0.0% 7.8% 1 4.484s ─Glue.zrange_to_reflective_goal -------- 1.7% 6.0% 1 3.464s ─synthesize ---------------------------- 0.0% 5.4% 1 3.124s ─unify (constr) (constr) --------------- 5.4% 5.4% 6 1.540s ─IntegrationTestTemporaryMiscCommon.do_r 0.0% 5.3% 1 3.040s ─change G' ----------------------------- 5.2% 5.2% 1 2.964s ─pose proof (pf : Interpretation.Bo 4.2% 4.2% 1 2.416s ─prove_interp_compile_correct ---------- 0.0% 3.3% 1 1.904s ─rewrite H ----------------------------- 3.3% 3.3% 1 1.896s ─rewrite ?EtaInterp.InterpExprEta ------ 3.0% 3.0% 1 1.732s ─ReflectiveTactics.unify_abstract_cbv_in 1.4% 2.1% 1 1.212s tactic local total calls max ────────────────────────────────────────┴──────┴──────┴───────┴─────────┘ ─Pipeline.refine_reflectively_gen ------ 0.0% 94.6% 1 54.224s ├─ReflectiveTactics.do_reflective_pipel 0.0% 86.2% 1 49.452s │└ReflectiveTactics.solve_side_conditio 0.0% 85.9% 1 49.264s │ ├─ReflectiveTactics.do_reify -------- -0.0% 57.6% 1 33.004s │ │└Reify.Reify_rhs_gen --------------- 1.3% 56.9% 1 32.608s │ │ ├─Reify.do_reify_abs_goal --------- 43.1% 43.3% 2 24.840s │ │ │└Reify.do_reifyf_goal ------------ 42.3% 42.6% 117 12.704s │ │ │└eexact -------------------------- 13.4% 13.4% 117 0.084s │ │ ├─prove_interp_compile_correct ---- 0.0% 3.3% 1 1.904s │ │ │└rewrite ?EtaInterp.InterpExprEta 3.0% 3.0% 1 1.732s │ │ └─rewrite H ----------------------- 3.3% 3.3% 1 1.896s │ └─ReflectiveTactics.solve_post_reifie 0.1% 28.4% 1 16.260s │ ├─UnifyAbstractReflexivity.unify_tr 19.6% 25.0% 7 4.824s │ │└unify (constr) (constr) --------- 4.8% 4.8% 5 1.540s │ └─ReflectiveTactics.unify_abstract_ 1.4% 2.1% 1 1.212s └─Glue.refine_to_reflective_glue' ----- 0.0% 8.3% 1 4.772s └Glue.zrange_to_reflective ----------- 0.0% 7.8% 1 4.484s └Glue.zrange_to_reflective_goal ------ 1.7% 6.0% 1 3.464s └pose proof (pf : Interpretation. 4.2% 4.2% 1 2.416s ─synthesize ---------------------------- 0.0% 5.4% 1 3.124s └IntegrationTestTemporaryMiscCommon.do_r 0.0% 5.3% 1 3.040s └change G' ----------------------------- 5.2% 5.2% 1 2.964s Finished transaction in 94.432 secs (86.96u,0.02s) (successful) Closed under the global context total time: 57.348s tactic local total calls max ────────────────────────────────────────┴──────┴──────┴───────┴─────────┘ ─Pipeline.refine_reflectively_gen ------ 0.0% 94.6% 1 54.224s ─ReflectiveTactics.do_reflective_pipelin 0.0% 86.2% 1 49.452s ─ReflectiveTactics.solve_side_conditions 0.0% 85.9% 1 49.264s ─ReflectiveTactics.do_reify ------------ -0.0% 57.6% 1 33.004s ─Reify.Reify_rhs_gen ------------------- 1.3% 56.9% 1 32.608s ─Reify.do_reify_abs_goal --------------- 43.1% 43.3% 2 24.840s ─Reify.do_reifyf_goal ------------------ 42.3% 42.6% 117 12.704s ─ReflectiveTactics.solve_post_reified_si 0.1% 28.4% 1 16.260s ─UnifyAbstractReflexivity.unify_transfor 19.6% 25.0% 7 4.824s ─eexact -------------------------------- 13.9% 13.9% 119 0.144s ─Glue.refine_to_reflective_glue' ------- 0.0% 8.3% 1 4.772s ─Glue.zrange_to_reflective ------------- 0.0% 7.8% 1 4.484s ─Glue.zrange_to_reflective_goal -------- 1.7% 6.0% 1 3.464s ─synthesize ---------------------------- 0.0% 5.4% 1 3.124s ─unify (constr) (constr) --------------- 5.4% 5.4% 6 1.540s ─IntegrationTestTemporaryMiscCommon.do_r 0.0% 5.3% 1 3.040s ─change G' ----------------------------- 5.2% 5.2% 1 2.964s ─pose proof (pf : Interpretation.Bo 4.2% 4.2% 1 2.416s ─prove_interp_compile_correct ---------- 0.0% 3.3% 1 1.904s ─rewrite H ----------------------------- 3.3% 3.3% 1 1.896s ─rewrite ?EtaInterp.InterpExprEta ------ 3.0% 3.0% 1 1.732s ─ReflectiveTactics.unify_abstract_cbv_in 1.4% 2.1% 1 1.212s tactic local total calls max ────────────────────────────────────────┴──────┴──────┴───────┴─────────┘ ─Pipeline.refine_reflectively_gen ------ 0.0% 94.6% 1 54.224s ├─ReflectiveTactics.do_reflective_pipel 0.0% 86.2% 1 49.452s │└ReflectiveTactics.solve_side_conditio 0.0% 85.9% 1 49.264s │ ├─ReflectiveTactics.do_reify -------- -0.0% 57.6% 1 33.004s │ │└Reify.Reify_rhs_gen --------------- 1.3% 56.9% 1 32.608s │ │ ├─Reify.do_reify_abs_goal --------- 43.1% 43.3% 2 24.840s │ │ │└Reify.do_reifyf_goal ------------ 42.3% 42.6% 117 12.704s │ │ │└eexact -------------------------- 13.4% 13.4% 117 0.084s │ │ ├─prove_interp_compile_correct ---- 0.0% 3.3% 1 1.904s │ │ │└rewrite ?EtaInterp.InterpExprEta 3.0% 3.0% 1 1.732s │ │ └─rewrite H ----------------------- 3.3% 3.3% 1 1.896s │ └─ReflectiveTactics.solve_post_reifie 0.1% 28.4% 1 16.260s │ ├─UnifyAbstractReflexivity.unify_tr 19.6% 25.0% 7 4.824s │ │└unify (constr) (constr) --------- 4.8% 4.8% 5 1.540s │ └─ReflectiveTactics.unify_abstract_ 1.4% 2.1% 1 1.212s └─Glue.refine_to_reflective_glue' ----- 0.0% 8.3% 1 4.772s └Glue.zrange_to_reflective ----------- 0.0% 7.8% 1 4.484s └Glue.zrange_to_reflective_goal ------ 1.7% 6.0% 1 3.464s └pose proof (pf : Interpretation. 4.2% 4.2% 1 2.416s ─synthesize ---------------------------- 0.0% 5.4% 1 3.124s └IntegrationTestTemporaryMiscCommon.do_r 0.0% 5.3% 1 3.040s └change G' ----------------------------- 5.2% 5.2% 1 2.964s src/Specific/solinas32_2e255m765_13limbs/femul (real: 181.77, user: 168.52, sys: 0.40, mem: 1589516 ko) COQC src/Specific/NISTP256/AMD64/femul.v Finished transaction in 119.257 secs (109.936u,0.256s) (successful) total time: 110.140s tactic local total calls max ────────────────────────────────────────┴──────┴──────┴───────┴─────────┘ ─Pipeline.refine_reflectively_gen ------ 0.0% 97.1% 1 106.964s ─ReflectiveTactics.do_reflective_pipelin -0.0% 96.4% 1 106.196s ─ReflectiveTactics.solve_side_conditions 0.0% 96.2% 1 105.992s ─ReflectiveTactics.do_reify ------------ -0.0% 83.7% 1 92.208s ─Reify.Reify_rhs_gen ------------------- 0.7% 83.5% 1 91.960s ─Reify.do_reify_abs_goal --------------- 77.7% 77.8% 2 85.708s ─Reify.do_reifyf_goal ------------------ 77.4% 77.5% 901 85.364s ─eexact -------------------------------- 17.9% 17.9% 903 0.136s ─ReflectiveTactics.solve_post_reified_si 0.3% 12.5% 1 13.784s ─UnifyAbstractReflexivity.unify_transfor 9.8% 11.2% 7 3.356s ─synthesize_montgomery ----------------- 0.0% 2.9% 1 3.176s tactic local total calls max ────────────────────────────────────────┴──────┴──────┴───────┴─────────┘ ─Pipeline.refine_reflectively_gen ------ 0.0% 97.1% 1 106.964s └ReflectiveTactics.do_reflective_pipelin -0.0% 96.4% 1 106.196s └ReflectiveTactics.solve_side_conditions 0.0% 96.2% 1 105.992s ├─ReflectiveTactics.do_reify ---------- -0.0% 83.7% 1 92.208s │└Reify.Reify_rhs_gen ----------------- 0.7% 83.5% 1 91.960s │└Reify.do_reify_abs_goal ------------- 77.7% 77.8% 2 85.708s │└Reify.do_reifyf_goal ---------------- 77.4% 77.5% 901 85.364s │└eexact ------------------------------ 17.7% 17.7% 901 0.136s └─ReflectiveTactics.solve_post_reified_ 0.3% 12.5% 1 13.784s └UnifyAbstractReflexivity.unify_transf 9.8% 11.2% 7 3.356s ─synthesize_montgomery ----------------- 0.0% 2.9% 1 3.176s Finished transaction in 61.452 secs (58.503u,0.055s) (successful) Closed under the global context total time: 110.140s tactic local total calls max ────────────────────────────────────────┴──────┴──────┴───────┴─────────┘ ─Pipeline.refine_reflectively_gen ------ 0.0% 97.1% 1 106.964s ─ReflectiveTactics.do_reflective_pipelin -0.0% 96.4% 1 106.196s ─ReflectiveTactics.solve_side_conditions 0.0% 96.2% 1 105.992s ─ReflectiveTactics.do_reify ------------ -0.0% 83.7% 1 92.208s ─Reify.Reify_rhs_gen ------------------- 0.7% 83.5% 1 91.960s ─Reify.do_reify_abs_goal --------------- 77.7% 77.8% 2 85.708s ─Reify.do_reifyf_goal ------------------ 77.4% 77.5% 901 85.364s ─eexact -------------------------------- 17.9% 17.9% 903 0.136s ─ReflectiveTactics.solve_post_reified_si 0.3% 12.5% 1 13.784s ─UnifyAbstractReflexivity.unify_transfor 9.8% 11.2% 7 3.356s ─synthesize_montgomery ----------------- 0.0% 2.9% 1 3.176s tactic local total calls max ────────────────────────────────────────┴──────┴──────┴───────┴─────────┘ ─Pipeline.refine_reflectively_gen ------ 0.0% 97.1% 1 106.964s └ReflectiveTactics.do_reflective_pipelin -0.0% 96.4% 1 106.196s └ReflectiveTactics.solve_side_conditions 0.0% 96.2% 1 105.992s ├─ReflectiveTactics.do_reify ---------- -0.0% 83.7% 1 92.208s │└Reify.Reify_rhs_gen ----------------- 0.7% 83.5% 1 91.960s │└Reify.do_reify_abs_goal ------------- 77.7% 77.8% 2 85.708s │└Reify.do_reifyf_goal ---------------- 77.4% 77.5% 901 85.364s │└eexact ------------------------------ 17.7% 17.7% 901 0.136s └─ReflectiveTactics.solve_post_reified_ 0.3% 12.5% 1 13.784s └UnifyAbstractReflexivity.unify_transf 9.8% 11.2% 7 3.356s ─synthesize_montgomery ----------------- 0.0% 2.9% 1 3.176s src/Specific/NISTP256/AMD64/femul (real: 202.96, user: 189.62, sys: 0.64, mem: 3302508 ko) COQC src/Specific/NISTP256/AMD64/femulDisplay > src/Specific/NISTP256/AMD64/femulDisplay.log COQC src/Specific/X25519/C64/ladderstep.v total time: 52.080s tactic local total calls max ────────────────────────────────────────┴──────┴──────┴───────┴─────────┘ ─synthesize_xzladderstep --------------- 0.0% 100.0% 1 52.080s ─Pipeline.refine_reflectively_gen ------ 0.0% 98.5% 1 51.320s ─ReflectiveTactics.do_reflective_pipelin 0.0% 93.8% 1 48.872s ─ReflectiveTactics.solve_side_conditions 0.0% 93.7% 1 48.776s ─ReflectiveTactics.solve_post_reified_si 0.2% 56.5% 1 29.412s ─UnifyAbstractReflexivity.unify_transfor 44.7% 49.1% 7 6.968s ─ReflectiveTactics.do_reify ------------ 0.0% 37.2% 1 19.364s ─Reify.Reify_rhs_gen ------------------- 2.1% 23.4% 1 12.200s ─Reify.do_reifyf_goal ------------------ 11.2% 11.3% 138 1.884s ─Compilers.Reify.reify_context_variables 0.1% 9.2% 1 4.808s ─rewrite H ----------------------------- 7.3% 7.3% 1 3.816s ─ReflectiveTactics.unify_abstract_cbv_in 4.7% 6.4% 1 3.336s ─Glue.refine_to_reflective_glue' ------- 0.0% 4.7% 1 2.448s ─Glue.zrange_to_reflective ------------- 0.0% 4.0% 1 2.068s ─Reify.transitivity_tt ----------------- 0.1% 3.7% 2 0.984s ─transitivity -------------------------- 3.5% 3.5% 10 0.880s ─reflexivity --------------------------- 3.4% 3.4% 11 0.772s ─Glue.zrange_to_reflective_goal -------- 2.4% 3.3% 1 1.728s ─eexact -------------------------------- 3.2% 3.2% 140 0.032s ─unify (constr) (constr) --------------- 3.1% 3.1% 6 0.852s ─clear (var_list) ---------------------- 3.1% 3.1% 98 0.584s ─UnfoldArg.unfold_second_arg ----------- 0.4% 3.0% 2 1.576s ─tac ----------------------------------- 2.1% 3.0% 2 1.564s ─ClearAll.clear_all -------------------- 0.2% 2.8% 7 0.584s ─ChangeInAll.change_with_compute_in_all 0.0% 2.6% 221 0.012s ─change c with c' in * ----------------- 2.5% 2.5% 221 0.012s ─Reify.do_reify_abs_goal --------------- 2.4% 2.5% 2 1.276s tactic local total calls max ────────────────────────────────────────┴──────┴──────┴───────┴─────────┘ ─synthesize_xzladderstep --------------- 0.0% 100.0% 1 52.080s └Pipeline.refine_reflectively_gen ------ 0.0% 98.5% 1 51.320s ├─ReflectiveTactics.do_reflective_pipel 0.0% 93.8% 1 48.872s │└ReflectiveTactics.solve_side_conditio 0.0% 93.7% 1 48.776s │ ├─ReflectiveTactics.solve_post_reifie 0.2% 56.5% 1 29.412s │ │ ├─UnifyAbstractReflexivity.unify_tr 44.7% 49.1% 7 6.968s │ │ │└ClearAll.clear_all -------------- 0.2% 2.8% 7 0.584s │ │ │└clear (var_list) ---------------- 2.7% 2.7% 65 0.584s │ │ └─ReflectiveTactics.unify_abstract_ 4.7% 6.4% 1 3.336s │ └─ReflectiveTactics.do_reify -------- 0.0% 37.2% 1 19.364s │ ├─Reify.Reify_rhs_gen ------------- 2.1% 23.4% 1 12.200s │ │ ├─rewrite H --------------------- 7.3% 7.3% 1 3.816s │ │ ├─Reify.transitivity_tt --------- 0.1% 3.7% 2 0.984s │ │ │└transitivity ------------------ 3.4% 3.4% 4 0.880s │ │ ├─tac --------------------------- 2.1% 3.0% 1 1.564s │ │ └─Reify.do_reify_abs_goal ------- 2.4% 2.5% 2 1.276s │ │ └Reify.do_reifyf_goal ---------- 2.2% 2.2% 25 1.148s │ ├─Compilers.Reify.reify_context_var 0.1% 9.2% 1 4.808s │ │└Reify.do_reifyf_goal ------------ 9.0% 9.1% 113 1.884s │ │└eexact -------------------------- 2.4% 2.4% 113 0.032s │ └─UnfoldArg.unfold_second_arg ----- 0.4% 3.0% 2 1.576s │ └ChangeInAll.change_with_compute_i 0.0% 2.6% 221 0.012s │ └change c with c' in * ----------- 2.5% 2.5% 221 0.012s └─Glue.refine_to_reflective_glue' ----- 0.0% 4.7% 1 2.448s └Glue.zrange_to_reflective ----------- 0.0% 4.0% 1 2.068s └Glue.zrange_to_reflective_goal ------ 2.4% 3.3% 1 1.728s Finished transaction in 171.122 secs (161.392u,0.039s) (successful) Closed under the global context total time: 52.080s tactic local total calls max ────────────────────────────────────────┴──────┴──────┴───────┴─────────┘ ─synthesize_xzladderstep --------------- 0.0% 100.0% 1 52.080s ─Pipeline.refine_reflectively_gen ------ 0.0% 98.5% 1 51.320s ─ReflectiveTactics.do_reflective_pipelin 0.0% 93.8% 1 48.872s ─ReflectiveTactics.solve_side_conditions 0.0% 93.7% 1 48.776s ─ReflectiveTactics.solve_post_reified_si 0.2% 56.5% 1 29.412s ─UnifyAbstractReflexivity.unify_transfor 44.7% 49.1% 7 6.968s ─ReflectiveTactics.do_reify ------------ 0.0% 37.2% 1 19.364s ─Reify.Reify_rhs_gen ------------------- 2.1% 23.4% 1 12.200s ─Reify.do_reifyf_goal ------------------ 11.2% 11.3% 138 1.884s ─Compilers.Reify.reify_context_variables 0.1% 9.2% 1 4.808s ─rewrite H ----------------------------- 7.3% 7.3% 1 3.816s ─ReflectiveTactics.unify_abstract_cbv_in 4.7% 6.4% 1 3.336s ─Glue.refine_to_reflective_glue' ------- 0.0% 4.7% 1 2.448s ─Glue.zrange_to_reflective ------------- 0.0% 4.0% 1 2.068s ─Reify.transitivity_tt ----------------- 0.1% 3.7% 2 0.984s ─transitivity -------------------------- 3.5% 3.5% 10 0.880s ─reflexivity --------------------------- 3.4% 3.4% 11 0.772s ─Glue.zrange_to_reflective_goal -------- 2.4% 3.3% 1 1.728s ─eexact -------------------------------- 3.2% 3.2% 140 0.032s ─unify (constr) (constr) --------------- 3.1% 3.1% 6 0.852s ─clear (var_list) ---------------------- 3.1% 3.1% 98 0.584s ─UnfoldArg.unfold_second_arg ----------- 0.4% 3.0% 2 1.576s ─tac ----------------------------------- 2.1% 3.0% 2 1.564s ─ClearAll.clear_all -------------------- 0.2% 2.8% 7 0.584s ─ChangeInAll.change_with_compute_in_all 0.0% 2.6% 221 0.012s ─change c with c' in * ----------------- 2.5% 2.5% 221 0.012s ─Reify.do_reify_abs_goal --------------- 2.4% 2.5% 2 1.276s tactic local total calls max ────────────────────────────────────────┴──────┴──────┴───────┴─────────┘ ─synthesize_xzladderstep --------------- 0.0% 100.0% 1 52.080s └Pipeline.refine_reflectively_gen ------ 0.0% 98.5% 1 51.320s ├─ReflectiveTactics.do_reflective_pipel 0.0% 93.8% 1 48.872s │└ReflectiveTactics.solve_side_conditio 0.0% 93.7% 1 48.776s │ ├─ReflectiveTactics.solve_post_reifie 0.2% 56.5% 1 29.412s │ │ ├─UnifyAbstractReflexivity.unify_tr 44.7% 49.1% 7 6.968s │ │ │└ClearAll.clear_all -------------- 0.2% 2.8% 7 0.584s │ │ │└clear (var_list) ---------------- 2.7% 2.7% 65 0.584s │ │ └─ReflectiveTactics.unify_abstract_ 4.7% 6.4% 1 3.336s │ └─ReflectiveTactics.do_reify -------- 0.0% 37.2% 1 19.364s │ ├─Reify.Reify_rhs_gen ------------- 2.1% 23.4% 1 12.200s │ │ ├─rewrite H --------------------- 7.3% 7.3% 1 3.816s │ │ ├─Reify.transitivity_tt --------- 0.1% 3.7% 2 0.984s │ │ │└transitivity ------------------ 3.4% 3.4% 4 0.880s │ │ ├─tac --------------------------- 2.1% 3.0% 1 1.564s │ │ └─Reify.do_reify_abs_goal ------- 2.4% 2.5% 2 1.276s │ │ └Reify.do_reifyf_goal ---------- 2.2% 2.2% 25 1.148s │ ├─Compilers.Reify.reify_context_var 0.1% 9.2% 1 4.808s │ │└Reify.do_reifyf_goal ------------ 9.0% 9.1% 113 1.884s │ │└eexact -------------------------- 2.4% 2.4% 113 0.032s │ └─UnfoldArg.unfold_second_arg ----- 0.4% 3.0% 2 1.576s │ └ChangeInAll.change_with_compute_i 0.0% 2.6% 221 0.012s │ └change c with c' in * ----------- 2.5% 2.5% 221 0.012s └─Glue.refine_to_reflective_glue' ----- 0.0% 4.7% 1 2.448s └Glue.zrange_to_reflective ----------- 0.0% 4.0% 1 2.068s └Glue.zrange_to_reflective_goal ------ 2.4% 3.3% 1 1.728s src/Specific/X25519/C64/ladderstep (real: 256.77, user: 241.34, sys: 0.45, mem: 1617000 ko) COQC src/Specific/X25519/C64/ladderstepDisplay > src/Specific/X25519/C64/ladderstepDisplay.log time-of-build-before.log.in000066400000000000000000003660331466560755400340160ustar00rootroot00000000000000coq-8.20.0/test-suite/precomputed-time-tests/correct-diff-sorting-order-memCOQDEP src/Compilers/Z/Bounds/Pipeline/Definition.v COQDEP src/Compilers/Z/Bounds/Pipeline/ReflectiveTactics.v /home/jgross/.local64/coq/coq-master/bin/coq_makefile -f _CoqProject INSTALLDEFAULTROOT = Crypto -o Makefile-old COQ_MAKEFILE -f _CoqProject > Makefile.coq make --no-print-directory -C coqprime make[1]: Nothing to be done for 'all'. ECHO > _CoqProject COQC src/Compilers/Z/Bounds/Pipeline/Definition.v src/Compilers/Z/Bounds/Pipeline/Definition (real: 7.40, user: 7.22, sys: 0.15, mem: 578344 ko) COQC src/Compilers/Z/Bounds/Pipeline/ReflectiveTactics.v src/Compilers/Z/Bounds/Pipeline/ReflectiveTactics (real: 1.73, user: 1.58, sys: 0.14, mem: 546112 ko) COQC src/Compilers/Z/Bounds/Pipeline.v src/Compilers/Z/Bounds/Pipeline (real: 1.18, user: 1.04, sys: 0.14, mem: 539160 ko) COQC src/Specific/Framework/SynthesisFramework.v src/Specific/Framework/SynthesisFramework (real: 1.95, user: 1.72, sys: 0.22, mem: 648632 ko) COQC src/Specific/X25519/C64/Synthesis.v src/Specific/X25519/C64/Synthesis (real: 11.23, user: 10.30, sys: 0.19, mem: 687812 ko) COQC src/Specific/NISTP256/AMD64/Synthesis.v src/Specific/NISTP256/AMD64/Synthesis (real: 13.74, user: 12.54, sys: 0.23, mem: 667664 ko) COQC src/Specific/X25519/C64/feadd.v Finished transaction in 2.852 secs (2.699u,0.012s) (successful) total time: 2.664s tactic local total calls max ────────────────────────────────────────┴──────┴──────┴───────┴─────────┘ ─Pipeline.refine_reflectively_gen ------ 0.0% 97.4% 1 2.596s ─ReflectiveTactics.do_reflective_pipelin 0.0% 70.9% 1 1.888s ─ReflectiveTactics.solve_side_conditions 0.0% 69.5% 1 1.852s ─ReflectiveTactics.solve_post_reified_si 1.4% 43.7% 1 1.164s ─UnifyAbstractReflexivity.unify_transfor 27.0% 31.7% 8 0.256s ─Glue.refine_to_reflective_glue' ------- 0.0% 26.6% 1 0.708s ─ReflectiveTactics.do_reify ------------ 0.0% 25.8% 1 0.688s ─Reify.Reify_rhs_gen ------------------- 2.0% 24.0% 1 0.640s ─Glue.zrange_to_reflective ------------- 0.0% 17.9% 1 0.476s ─Glue.zrange_to_reflective_goal -------- 8.1% 13.1% 1 0.348s ─Reify.do_reify_abs_goal --------------- 12.8% 12.9% 2 0.344s ─Reify.do_reifyf_goal ------------------ 11.7% 11.9% 16 0.316s ─ReflectiveTactics.unify_abstract_cbv_in 7.7% 10.2% 1 0.272s ─unify (constr) (constr) --------------- 6.0% 6.0% 7 0.064s ─Glue.pattern_sig_sig_assoc ------------ 0.0% 5.0% 1 0.132s ─assert (H : is_bounded_by' bounds (map' 4.5% 4.7% 2 0.068s ─Glue.pattern_proj1_sig_in_sig --------- 1.5% 4.7% 1 0.124s ─pose proof (pf : Interpretation.Bo 3.3% 3.3% 1 0.088s ─Glue.split_BoundedWordToZ ------------- 0.2% 3.0% 1 0.080s ─destruct x ---------------------------- 2.7% 2.7% 4 0.032s ─clearbody (ne_var_list) --------------- 2.7% 2.7% 4 0.056s ─destruct_sig -------------------------- 0.0% 2.7% 4 0.040s ─synthesize ---------------------------- 0.0% 2.6% 1 0.068s ─prove_interp_compile_correct ---------- 0.0% 2.4% 1 0.064s ─reflexivity --------------------------- 2.3% 2.3% 7 0.028s ─rewrite ?EtaInterp.InterpExprEta ------ 2.3% 2.3% 1 0.060s ─ClearbodyAll.clearbody_all ------------ 0.0% 2.1% 2 0.056s tactic local total calls max ────────────────────────────────────────┴──────┴──────┴───────┴─────────┘ ─Pipeline.refine_reflectively_gen ------ 0.0% 97.4% 1 2.596s ├─ReflectiveTactics.do_reflective_pipel 0.0% 70.9% 1 1.888s │└ReflectiveTactics.solve_side_conditio 0.0% 69.5% 1 1.852s │ ├─ReflectiveTactics.solve_post_reifie 1.4% 43.7% 1 1.164s │ │ ├─UnifyAbstractReflexivity.unify_tr 27.0% 31.7% 8 0.256s │ │ │└unify (constr) (constr) --------- 3.6% 3.6% 6 0.028s │ │ └─ReflectiveTactics.unify_abstract_ 7.7% 10.2% 1 0.272s │ │ └unify (constr) (constr) --------- 2.4% 2.4% 1 0.064s │ └─ReflectiveTactics.do_reify -------- 0.0% 25.8% 1 0.688s │ └Reify.Reify_rhs_gen --------------- 2.0% 24.0% 1 0.640s │ ├─Reify.do_reify_abs_goal --------- 12.8% 12.9% 2 0.344s │ │└Reify.do_reifyf_goal ------------ 11.7% 11.9% 16 0.316s │ └─prove_interp_compile_correct ---- 0.0% 2.4% 1 0.064s │ └rewrite ?EtaInterp.InterpExprEta 2.3% 2.3% 1 0.060s └─Glue.refine_to_reflective_glue' ----- 0.0% 26.6% 1 0.708s ├─Glue.zrange_to_reflective --------- 0.0% 17.9% 1 0.476s │ ├─Glue.zrange_to_reflective_goal -- 8.1% 13.1% 1 0.348s │ │└pose proof (pf : Interpretat 3.3% 3.3% 1 0.088s │ └─assert (H : is_bounded_by' bounds 4.5% 4.7% 2 0.068s ├─Glue.pattern_sig_sig_assoc -------- 0.0% 5.0% 1 0.132s │└Glue.pattern_proj1_sig_in_sig ----- 1.5% 4.7% 1 0.124s │└ClearbodyAll.clearbody_all -------- 0.0% 2.1% 2 0.056s │└clearbody (ne_var_list) ----------- 2.1% 2.1% 1 0.056s └─Glue.split_BoundedWordToZ --------- 0.2% 3.0% 1 0.080s └destruct_sig ---------------------- 0.0% 2.7% 4 0.040s └destruct x ------------------------ 2.1% 2.1% 2 0.032s ─synthesize ---------------------------- 0.0% 2.6% 1 0.068s Finished transaction in 5.46 secs (5.068u,0.003s) (successful) Closed under the global context total time: 2.664s tactic local total calls max ────────────────────────────────────────┴──────┴──────┴───────┴─────────┘ ─Pipeline.refine_reflectively_gen ------ 0.0% 97.4% 1 2.596s ─ReflectiveTactics.do_reflective_pipelin 0.0% 70.9% 1 1.888s ─ReflectiveTactics.solve_side_conditions 0.0% 69.5% 1 1.852s ─ReflectiveTactics.solve_post_reified_si 1.4% 43.7% 1 1.164s ─UnifyAbstractReflexivity.unify_transfor 27.0% 31.7% 8 0.256s ─Glue.refine_to_reflective_glue' ------- 0.0% 26.6% 1 0.708s ─ReflectiveTactics.do_reify ------------ 0.0% 25.8% 1 0.688s ─Reify.Reify_rhs_gen ------------------- 2.0% 24.0% 1 0.640s ─Glue.zrange_to_reflective ------------- 0.0% 17.9% 1 0.476s ─Glue.zrange_to_reflective_goal -------- 8.1% 13.1% 1 0.348s ─Reify.do_reify_abs_goal --------------- 12.8% 12.9% 2 0.344s ─Reify.do_reifyf_goal ------------------ 11.7% 11.9% 16 0.316s ─ReflectiveTactics.unify_abstract_cbv_in 7.7% 10.2% 1 0.272s ─unify (constr) (constr) --------------- 6.0% 6.0% 7 0.064s ─Glue.pattern_sig_sig_assoc ------------ 0.0% 5.0% 1 0.132s ─assert (H : is_bounded_by' bounds (map' 4.5% 4.7% 2 0.068s ─Glue.pattern_proj1_sig_in_sig --------- 1.5% 4.7% 1 0.124s ─pose proof (pf : Interpretation.Bo 3.3% 3.3% 1 0.088s ─Glue.split_BoundedWordToZ ------------- 0.2% 3.0% 1 0.080s ─destruct x ---------------------------- 2.7% 2.7% 4 0.032s ─clearbody (ne_var_list) --------------- 2.7% 2.7% 4 0.056s ─destruct_sig -------------------------- 0.0% 2.7% 4 0.040s ─synthesize ---------------------------- 0.0% 2.6% 1 0.068s ─prove_interp_compile_correct ---------- 0.0% 2.4% 1 0.064s ─reflexivity --------------------------- 2.3% 2.3% 7 0.028s ─rewrite ?EtaInterp.InterpExprEta ------ 2.3% 2.3% 1 0.060s ─ClearbodyAll.clearbody_all ------------ 0.0% 2.1% 2 0.056s tactic local total calls max ────────────────────────────────────────┴──────┴──────┴───────┴─────────┘ ─Pipeline.refine_reflectively_gen ------ 0.0% 97.4% 1 2.596s ├─ReflectiveTactics.do_reflective_pipel 0.0% 70.9% 1 1.888s │└ReflectiveTactics.solve_side_conditio 0.0% 69.5% 1 1.852s │ ├─ReflectiveTactics.solve_post_reifie 1.4% 43.7% 1 1.164s │ │ ├─UnifyAbstractReflexivity.unify_tr 27.0% 31.7% 8 0.256s │ │ │└unify (constr) (constr) --------- 3.6% 3.6% 6 0.028s │ │ └─ReflectiveTactics.unify_abstract_ 7.7% 10.2% 1 0.272s │ │ └unify (constr) (constr) --------- 2.4% 2.4% 1 0.064s │ └─ReflectiveTactics.do_reify -------- 0.0% 25.8% 1 0.688s │ └Reify.Reify_rhs_gen --------------- 2.0% 24.0% 1 0.640s │ ├─Reify.do_reify_abs_goal --------- 12.8% 12.9% 2 0.344s │ │└Reify.do_reifyf_goal ------------ 11.7% 11.9% 16 0.316s │ └─prove_interp_compile_correct ---- 0.0% 2.4% 1 0.064s │ └rewrite ?EtaInterp.InterpExprEta 2.3% 2.3% 1 0.060s └─Glue.refine_to_reflective_glue' ----- 0.0% 26.6% 1 0.708s ├─Glue.zrange_to_reflective --------- 0.0% 17.9% 1 0.476s │ ├─Glue.zrange_to_reflective_goal -- 8.1% 13.1% 1 0.348s │ │└pose proof (pf : Interpretat 3.3% 3.3% 1 0.088s │ └─assert (H : is_bounded_by' bounds 4.5% 4.7% 2 0.068s ├─Glue.pattern_sig_sig_assoc -------- 0.0% 5.0% 1 0.132s │└Glue.pattern_proj1_sig_in_sig ----- 1.5% 4.7% 1 0.124s │└ClearbodyAll.clearbody_all -------- 0.0% 2.1% 2 0.056s │└clearbody (ne_var_list) ----------- 2.1% 2.1% 1 0.056s └─Glue.split_BoundedWordToZ --------- 0.2% 3.0% 1 0.080s └destruct_sig ---------------------- 0.0% 2.7% 4 0.040s └destruct x ------------------------ 2.1% 2.1% 2 0.032s ─synthesize ---------------------------- 0.0% 2.6% 1 0.068s src/Specific/X25519/C64/feadd (real: 23.43, user: 21.41, sys: 0.26, mem: 766168 ko) COQC src/Specific/solinas32_2e255m765_12limbs/Synthesis.v src/Specific/solinas32_2e255m765_12limbs/Synthesis (real: 39.53, user: 36.64, sys: 0.21, mem: 729464 ko) COQC src/Specific/X25519/C64/fecarry.v Finished transaction in 4.798 secs (4.375u,0.003s) (successful) total time: 4.332s tactic local total calls max ────────────────────────────────────────┴──────┴──────┴───────┴─────────┘ ─Pipeline.refine_reflectively_gen ------ 0.1% 99.0% 1 4.288s ─ReflectiveTactics.do_reflective_pipelin 0.0% 89.2% 1 3.864s ─ReflectiveTactics.solve_side_conditions 0.0% 88.1% 1 3.816s ─ReflectiveTactics.do_reify ------------ 0.0% 53.2% 1 2.304s ─Reify.Reify_rhs_gen ------------------- 1.8% 52.6% 1 2.280s ─ReflectiveTactics.solve_post_reified_si 0.6% 34.9% 1 1.512s ─Reify.do_reify_abs_goal --------------- 33.5% 33.9% 2 1.468s ─Reify.do_reifyf_goal ------------------ 32.1% 32.5% 29 1.408s ─UnifyAbstractReflexivity.unify_transfor 22.5% 27.1% 8 0.316s ─Glue.refine_to_reflective_glue' ------- 0.1% 9.7% 1 0.420s ─eexact -------------------------------- 9.3% 9.3% 31 0.024s ─ReflectiveTactics.unify_abstract_cbv_in 5.2% 7.0% 1 0.304s ─Glue.zrange_to_reflective ------------- 0.1% 6.2% 1 0.268s ─prove_interp_compile_correct ---------- 0.0% 5.6% 1 0.244s ─rewrite ?EtaInterp.InterpExprEta ------ 5.3% 5.3% 1 0.228s ─unify (constr) (constr) --------------- 5.3% 5.3% 7 0.076s ─Glue.zrange_to_reflective_goal -------- 4.0% 4.9% 1 0.212s ─rewrite H ----------------------------- 3.4% 3.4% 1 0.148s ─tac ----------------------------------- 1.8% 2.6% 2 0.112s tactic local total calls max ────────────────────────────────────────┴──────┴──────┴───────┴─────────┘ ─Pipeline.refine_reflectively_gen ------ 0.1% 99.0% 1 4.288s ├─ReflectiveTactics.do_reflective_pipel 0.0% 89.2% 1 3.864s │└ReflectiveTactics.solve_side_conditio 0.0% 88.1% 1 3.816s │ ├─ReflectiveTactics.do_reify -------- 0.0% 53.2% 1 2.304s │ │└Reify.Reify_rhs_gen --------------- 1.8% 52.6% 1 2.280s │ │ ├─Reify.do_reify_abs_goal --------- 33.5% 33.9% 2 1.468s │ │ │└Reify.do_reifyf_goal ------------ 32.1% 32.5% 29 1.408s │ │ │└eexact -------------------------- 8.6% 8.6% 29 0.024s │ │ ├─prove_interp_compile_correct ---- 0.0% 5.6% 1 0.244s │ │ │└rewrite ?EtaInterp.InterpExprEta 5.3% 5.3% 1 0.228s │ │ ├─rewrite H ----------------------- 3.4% 3.4% 1 0.148s │ │ └─tac ----------------------------- 1.8% 2.6% 1 0.112s │ └─ReflectiveTactics.solve_post_reifie 0.6% 34.9% 1 1.512s │ ├─UnifyAbstractReflexivity.unify_tr 22.5% 27.1% 8 0.316s │ │└unify (constr) (constr) --------- 3.5% 3.5% 6 0.044s │ └─ReflectiveTactics.unify_abstract_ 5.2% 7.0% 1 0.304s └─Glue.refine_to_reflective_glue' ----- 0.1% 9.7% 1 0.420s └Glue.zrange_to_reflective ----------- 0.1% 6.2% 1 0.268s └Glue.zrange_to_reflective_goal ------ 4.0% 4.9% 1 0.212s Finished transaction in 8.342 secs (7.604u,0.008s) (successful) Closed under the global context total time: 4.332s tactic local total calls max ────────────────────────────────────────┴──────┴──────┴───────┴─────────┘ ─Pipeline.refine_reflectively_gen ------ 0.1% 99.0% 1 4.288s ─ReflectiveTactics.do_reflective_pipelin 0.0% 89.2% 1 3.864s ─ReflectiveTactics.solve_side_conditions 0.0% 88.1% 1 3.816s ─ReflectiveTactics.do_reify ------------ 0.0% 53.2% 1 2.304s ─Reify.Reify_rhs_gen ------------------- 1.8% 52.6% 1 2.280s ─ReflectiveTactics.solve_post_reified_si 0.6% 34.9% 1 1.512s ─Reify.do_reify_abs_goal --------------- 33.5% 33.9% 2 1.468s ─Reify.do_reifyf_goal ------------------ 32.1% 32.5% 29 1.408s ─UnifyAbstractReflexivity.unify_transfor 22.5% 27.1% 8 0.316s ─Glue.refine_to_reflective_glue' ------- 0.1% 9.7% 1 0.420s ─eexact -------------------------------- 9.3% 9.3% 31 0.024s ─ReflectiveTactics.unify_abstract_cbv_in 5.2% 7.0% 1 0.304s ─Glue.zrange_to_reflective ------------- 0.1% 6.2% 1 0.268s ─prove_interp_compile_correct ---------- 0.0% 5.6% 1 0.244s ─rewrite ?EtaInterp.InterpExprEta ------ 5.3% 5.3% 1 0.228s ─unify (constr) (constr) --------------- 5.3% 5.3% 7 0.076s ─Glue.zrange_to_reflective_goal -------- 4.0% 4.9% 1 0.212s ─rewrite H ----------------------------- 3.4% 3.4% 1 0.148s ─tac ----------------------------------- 1.8% 2.6% 2 0.112s tactic local total calls max ────────────────────────────────────────┴──────┴──────┴───────┴─────────┘ ─Pipeline.refine_reflectively_gen ------ 0.1% 99.0% 1 4.288s ├─ReflectiveTactics.do_reflective_pipel 0.0% 89.2% 1 3.864s │└ReflectiveTactics.solve_side_conditio 0.0% 88.1% 1 3.816s │ ├─ReflectiveTactics.do_reify -------- 0.0% 53.2% 1 2.304s │ │└Reify.Reify_rhs_gen --------------- 1.8% 52.6% 1 2.280s │ │ ├─Reify.do_reify_abs_goal --------- 33.5% 33.9% 2 1.468s │ │ │└Reify.do_reifyf_goal ------------ 32.1% 32.5% 29 1.408s │ │ │└eexact -------------------------- 8.6% 8.6% 29 0.024s │ │ ├─prove_interp_compile_correct ---- 0.0% 5.6% 1 0.244s │ │ │└rewrite ?EtaInterp.InterpExprEta 5.3% 5.3% 1 0.228s │ │ ├─rewrite H ----------------------- 3.4% 3.4% 1 0.148s │ │ └─tac ----------------------------- 1.8% 2.6% 1 0.112s │ └─ReflectiveTactics.solve_post_reifie 0.6% 34.9% 1 1.512s │ ├─UnifyAbstractReflexivity.unify_tr 22.5% 27.1% 8 0.316s │ │└unify (constr) (constr) --------- 3.5% 3.5% 6 0.044s │ └─ReflectiveTactics.unify_abstract_ 5.2% 7.0% 1 0.304s └─Glue.refine_to_reflective_glue' ----- 0.1% 9.7% 1 0.420s └Glue.zrange_to_reflective ----------- 0.1% 6.2% 1 0.268s └Glue.zrange_to_reflective_goal ------ 4.0% 4.9% 1 0.212s src/Specific/X25519/C64/fecarry (real: 28.85, user: 26.31, sys: 0.25, mem: 787148 ko) COQC src/Specific/solinas32_2e255m765_13limbs/Synthesis.v src/Specific/solinas32_2e255m765_13limbs/Synthesis (real: 49.50, user: 45.58, sys: 0.18, mem: 744472 ko) COQC src/Specific/X25519/C64/femul.v Finished transaction in 9.325 secs (8.62u,0.016s) (successful) total time: 8.576s tactic local total calls max ────────────────────────────────────────┴──────┴──────┴───────┴─────────┘ ─Pipeline.refine_reflectively_gen ------ 0.0% 95.8% 1 8.220s ─ReflectiveTactics.do_reflective_pipelin 0.0% 87.7% 1 7.524s ─ReflectiveTactics.solve_side_conditions 0.0% 87.0% 1 7.460s ─ReflectiveTactics.do_reify ------------ 0.0% 43.8% 1 3.760s ─ReflectiveTactics.solve_post_reified_si 0.6% 43.1% 1 3.700s ─Reify.Reify_rhs_gen ------------------- 1.4% 43.0% 1 3.688s ─UnifyAbstractReflexivity.unify_transfor 31.1% 36.7% 8 1.096s ─Reify.do_reify_abs_goal --------------- 26.3% 26.6% 2 2.284s ─Reify.do_reifyf_goal ------------------ 25.3% 25.6% 58 1.440s ─Glue.refine_to_reflective_glue' ------- 0.0% 8.1% 1 0.696s ─eexact -------------------------------- 7.6% 7.6% 60 0.032s ─unify (constr) (constr) --------------- 5.8% 5.8% 7 0.128s ─Glue.zrange_to_reflective ------------- 0.0% 5.7% 1 0.488s ─ReflectiveTactics.unify_abstract_cbv_in 3.8% 5.5% 1 0.468s ─prove_interp_compile_correct ---------- 0.0% 5.2% 1 0.448s ─rewrite ?EtaInterp.InterpExprEta ------ 4.9% 4.9% 1 0.416s ─Glue.zrange_to_reflective_goal -------- 2.6% 4.2% 1 0.364s ─synthesize ---------------------------- 0.0% 4.2% 1 0.356s ─IntegrationTestTemporaryMiscCommon.do_r 0.0% 3.8% 1 0.328s ─rewrite H ----------------------------- 3.2% 3.2% 1 0.276s ─change G' ----------------------------- 3.2% 3.2% 1 0.272s ─tac ----------------------------------- 1.4% 2.1% 2 0.180s tactic local total calls max ────────────────────────────────────────┴──────┴──────┴───────┴─────────┘ ─Pipeline.refine_reflectively_gen ------ 0.0% 95.8% 1 8.220s ├─ReflectiveTactics.do_reflective_pipel 0.0% 87.7% 1 7.524s │└ReflectiveTactics.solve_side_conditio 0.0% 87.0% 1 7.460s │ ├─ReflectiveTactics.do_reify -------- 0.0% 43.8% 1 3.760s │ │└Reify.Reify_rhs_gen --------------- 1.4% 43.0% 1 3.688s │ │ ├─Reify.do_reify_abs_goal --------- 26.3% 26.6% 2 2.284s │ │ │└Reify.do_reifyf_goal ------------ 25.3% 25.6% 58 1.440s │ │ │└eexact -------------------------- 6.9% 6.9% 58 0.032s │ │ ├─prove_interp_compile_correct ---- 0.0% 5.2% 1 0.448s │ │ │└rewrite ?EtaInterp.InterpExprEta 4.9% 4.9% 1 0.416s │ │ ├─rewrite H ----------------------- 3.2% 3.2% 1 0.276s │ │ └─tac ----------------------------- 1.4% 2.1% 1 0.180s │ └─ReflectiveTactics.solve_post_reifie 0.6% 43.1% 1 3.700s │ ├─UnifyAbstractReflexivity.unify_tr 31.1% 36.7% 8 1.096s │ │└unify (constr) (constr) --------- 4.3% 4.3% 6 0.092s │ └─ReflectiveTactics.unify_abstract_ 3.8% 5.5% 1 0.468s └─Glue.refine_to_reflective_glue' ----- 0.0% 8.1% 1 0.696s └Glue.zrange_to_reflective ----------- 0.0% 5.7% 1 0.488s └Glue.zrange_to_reflective_goal ------ 2.6% 4.2% 1 0.364s ─synthesize ---------------------------- 0.0% 4.2% 1 0.356s └IntegrationTestTemporaryMiscCommon.do_r 0.0% 3.8% 1 0.328s └change G' ----------------------------- 3.2% 3.2% 1 0.272s Finished transaction in 16.611 secs (15.352u,0.s) (successful) Closed under the global context total time: 8.576s tactic local total calls max ────────────────────────────────────────┴──────┴──────┴───────┴─────────┘ ─Pipeline.refine_reflectively_gen ------ 0.0% 95.8% 1 8.220s ─ReflectiveTactics.do_reflective_pipelin 0.0% 87.7% 1 7.524s ─ReflectiveTactics.solve_side_conditions 0.0% 87.0% 1 7.460s ─ReflectiveTactics.do_reify ------------ 0.0% 43.8% 1 3.760s ─ReflectiveTactics.solve_post_reified_si 0.6% 43.1% 1 3.700s ─Reify.Reify_rhs_gen ------------------- 1.4% 43.0% 1 3.688s ─UnifyAbstractReflexivity.unify_transfor 31.1% 36.7% 8 1.096s ─Reify.do_reify_abs_goal --------------- 26.3% 26.6% 2 2.284s ─Reify.do_reifyf_goal ------------------ 25.3% 25.6% 58 1.440s ─Glue.refine_to_reflective_glue' ------- 0.0% 8.1% 1 0.696s ─eexact -------------------------------- 7.6% 7.6% 60 0.032s ─unify (constr) (constr) --------------- 5.8% 5.8% 7 0.128s ─Glue.zrange_to_reflective ------------- 0.0% 5.7% 1 0.488s ─ReflectiveTactics.unify_abstract_cbv_in 3.8% 5.5% 1 0.468s ─prove_interp_compile_correct ---------- 0.0% 5.2% 1 0.448s ─rewrite ?EtaInterp.InterpExprEta ------ 4.9% 4.9% 1 0.416s ─Glue.zrange_to_reflective_goal -------- 2.6% 4.2% 1 0.364s ─synthesize ---------------------------- 0.0% 4.2% 1 0.356s ─IntegrationTestTemporaryMiscCommon.do_r 0.0% 3.8% 1 0.328s ─rewrite H ----------------------------- 3.2% 3.2% 1 0.276s ─change G' ----------------------------- 3.2% 3.2% 1 0.272s ─tac ----------------------------------- 1.4% 2.1% 2 0.180s tactic local total calls max ────────────────────────────────────────┴──────┴──────┴───────┴─────────┘ ─Pipeline.refine_reflectively_gen ------ 0.0% 95.8% 1 8.220s ├─ReflectiveTactics.do_reflective_pipel 0.0% 87.7% 1 7.524s │└ReflectiveTactics.solve_side_conditio 0.0% 87.0% 1 7.460s │ ├─ReflectiveTactics.do_reify -------- 0.0% 43.8% 1 3.760s │ │└Reify.Reify_rhs_gen --------------- 1.4% 43.0% 1 3.688s │ │ ├─Reify.do_reify_abs_goal --------- 26.3% 26.6% 2 2.284s │ │ │└Reify.do_reifyf_goal ------------ 25.3% 25.6% 58 1.440s │ │ │└eexact -------------------------- 6.9% 6.9% 58 0.032s │ │ ├─prove_interp_compile_correct ---- 0.0% 5.2% 1 0.448s │ │ │└rewrite ?EtaInterp.InterpExprEta 4.9% 4.9% 1 0.416s │ │ ├─rewrite H ----------------------- 3.2% 3.2% 1 0.276s │ │ └─tac ----------------------------- 1.4% 2.1% 1 0.180s │ └─ReflectiveTactics.solve_post_reifie 0.6% 43.1% 1 3.700s │ ├─UnifyAbstractReflexivity.unify_tr 31.1% 36.7% 8 1.096s │ │└unify (constr) (constr) --------- 4.3% 4.3% 6 0.092s │ └─ReflectiveTactics.unify_abstract_ 3.8% 5.5% 1 0.468s └─Glue.refine_to_reflective_glue' ----- 0.0% 8.1% 1 0.696s └Glue.zrange_to_reflective ----------- 0.0% 5.7% 1 0.488s └Glue.zrange_to_reflective_goal ------ 2.6% 4.2% 1 0.364s ─synthesize ---------------------------- 0.0% 4.2% 1 0.356s └IntegrationTestTemporaryMiscCommon.do_r 0.0% 3.8% 1 0.328s └change G' ----------------------------- 3.2% 3.2% 1 0.272s src/Specific/X25519/C64/femul (real: 42.98, user: 39.50, sys: 0.29, mem: 839624 ko) COQC src/Specific/X25519/C64/feaddDisplay > src/Specific/X25519/C64/feaddDisplay.log COQC src/Specific/X25519/C64/fecarryDisplay > src/Specific/X25519/C64/fecarryDisplay.log COQC src/Specific/X25519/C64/fesub.v Finished transaction in 3.729 secs (3.48u,0.012s) (successful) total time: 3.444s tactic local total calls max ────────────────────────────────────────┴──────┴──────┴───────┴─────────┘ ─Pipeline.refine_reflectively_gen ------ 0.0% 98.0% 1 3.376s ─ReflectiveTactics.do_reflective_pipelin 0.0% 77.1% 1 2.656s ─ReflectiveTactics.solve_side_conditions 0.0% 75.8% 1 2.612s ─ReflectiveTactics.solve_post_reified_si 1.2% 40.1% 1 1.380s ─ReflectiveTactics.do_reify ------------ 0.0% 35.8% 1 1.232s ─Reify.Reify_rhs_gen ------------------- 1.4% 34.4% 1 1.184s ─UnifyAbstractReflexivity.unify_transfor 25.7% 30.5% 8 0.324s ─Glue.refine_to_reflective_glue' ------- 0.0% 20.9% 1 0.720s ─Reify.do_reify_abs_goal --------------- 18.5% 18.8% 2 0.648s ─Reify.do_reifyf_goal ------------------ 17.3% 17.5% 16 0.604s ─Glue.zrange_to_reflective ------------- 0.0% 14.2% 1 0.488s ─Glue.zrange_to_reflective_goal -------- 6.5% 10.6% 1 0.364s ─ReflectiveTactics.unify_abstract_cbv_in 5.8% 8.0% 1 0.276s ─unify (constr) (constr) --------------- 5.8% 5.8% 7 0.076s ─eexact -------------------------------- 4.4% 4.4% 18 0.012s ─Glue.pattern_sig_sig_assoc ------------ 0.0% 3.8% 1 0.132s ─assert (H : is_bounded_by' bounds (map' 3.6% 3.6% 2 0.064s ─Glue.pattern_proj1_sig_in_sig --------- 1.2% 3.6% 1 0.124s ─prove_interp_compile_correct ---------- 0.0% 3.5% 1 0.120s ─rewrite H ----------------------------- 3.4% 3.4% 1 0.116s ─rewrite ?EtaInterp.InterpExprEta ------ 3.1% 3.1% 1 0.108s ─pose proof (pf : Interpretation.Bo 2.7% 2.7% 1 0.092s ─reflexivity --------------------------- 2.6% 2.6% 7 0.032s ─Glue.split_BoundedWordToZ ------------- 0.2% 2.4% 1 0.084s ─tac ----------------------------------- 1.7% 2.2% 2 0.076s ─Reify.transitivity_tt ----------------- 0.1% 2.2% 2 0.040s ─transitivity -------------------------- 2.1% 2.1% 5 0.032s ─clearbody (ne_var_list) --------------- 2.1% 2.1% 4 0.056s ─destruct_sig -------------------------- 0.0% 2.1% 4 0.040s tactic local total calls max ────────────────────────────────────────┴──────┴──────┴───────┴─────────┘ ─Pipeline.refine_reflectively_gen ------ 0.0% 98.0% 1 3.376s ├─ReflectiveTactics.do_reflective_pipel 0.0% 77.1% 1 2.656s │└ReflectiveTactics.solve_side_conditio 0.0% 75.8% 1 2.612s │ ├─ReflectiveTactics.solve_post_reifie 1.2% 40.1% 1 1.380s │ │ ├─UnifyAbstractReflexivity.unify_tr 25.7% 30.5% 8 0.324s │ │ │└unify (constr) (constr) --------- 3.6% 3.6% 6 0.040s │ │ └─ReflectiveTactics.unify_abstract_ 5.8% 8.0% 1 0.276s │ │ └unify (constr) (constr) --------- 2.2% 2.2% 1 0.076s │ └─ReflectiveTactics.do_reify -------- 0.0% 35.8% 1 1.232s │ └Reify.Reify_rhs_gen --------------- 1.4% 34.4% 1 1.184s │ ├─Reify.do_reify_abs_goal --------- 18.5% 18.8% 2 0.648s │ │└Reify.do_reifyf_goal ------------ 17.3% 17.5% 16 0.604s │ │└eexact -------------------------- 3.8% 3.8% 16 0.012s │ ├─prove_interp_compile_correct ---- 0.0% 3.5% 1 0.120s │ │└rewrite ?EtaInterp.InterpExprEta 3.1% 3.1% 1 0.108s │ ├─rewrite H ----------------------- 3.4% 3.4% 1 0.116s │ ├─tac ----------------------------- 1.7% 2.2% 1 0.076s │ └─Reify.transitivity_tt ----------- 0.1% 2.2% 2 0.040s └─Glue.refine_to_reflective_glue' ----- 0.0% 20.9% 1 0.720s ├─Glue.zrange_to_reflective --------- 0.0% 14.2% 1 0.488s │ ├─Glue.zrange_to_reflective_goal -- 6.5% 10.6% 1 0.364s │ │└pose proof (pf : Interpretat 2.7% 2.7% 1 0.092s │ └─assert (H : is_bounded_by' bounds 3.6% 3.6% 2 0.064s ├─Glue.pattern_sig_sig_assoc -------- 0.0% 3.8% 1 0.132s │└Glue.pattern_proj1_sig_in_sig ----- 1.2% 3.6% 1 0.124s └─Glue.split_BoundedWordToZ --------- 0.2% 2.4% 1 0.084s └destruct_sig ---------------------- 0.0% 2.1% 4 0.040s Finished transaction in 6.763 secs (6.183u,0.s) (successful) Closed under the global context total time: 3.444s tactic local total calls max ────────────────────────────────────────┴──────┴──────┴───────┴─────────┘ ─Pipeline.refine_reflectively_gen ------ 0.0% 98.0% 1 3.376s ─ReflectiveTactics.do_reflective_pipelin 0.0% 77.1% 1 2.656s ─ReflectiveTactics.solve_side_conditions 0.0% 75.8% 1 2.612s ─ReflectiveTactics.solve_post_reified_si 1.2% 40.1% 1 1.380s ─ReflectiveTactics.do_reify ------------ 0.0% 35.8% 1 1.232s ─Reify.Reify_rhs_gen ------------------- 1.4% 34.4% 1 1.184s ─UnifyAbstractReflexivity.unify_transfor 25.7% 30.5% 8 0.324s ─Glue.refine_to_reflective_glue' ------- 0.0% 20.9% 1 0.720s ─Reify.do_reify_abs_goal --------------- 18.5% 18.8% 2 0.648s ─Reify.do_reifyf_goal ------------------ 17.3% 17.5% 16 0.604s ─Glue.zrange_to_reflective ------------- 0.0% 14.2% 1 0.488s ─Glue.zrange_to_reflective_goal -------- 6.5% 10.6% 1 0.364s ─ReflectiveTactics.unify_abstract_cbv_in 5.8% 8.0% 1 0.276s ─unify (constr) (constr) --------------- 5.8% 5.8% 7 0.076s ─eexact -------------------------------- 4.4% 4.4% 18 0.012s ─Glue.pattern_sig_sig_assoc ------------ 0.0% 3.8% 1 0.132s ─assert (H : is_bounded_by' bounds (map' 3.6% 3.6% 2 0.064s ─Glue.pattern_proj1_sig_in_sig --------- 1.2% 3.6% 1 0.124s ─prove_interp_compile_correct ---------- 0.0% 3.5% 1 0.120s ─rewrite H ----------------------------- 3.4% 3.4% 1 0.116s ─rewrite ?EtaInterp.InterpExprEta ------ 3.1% 3.1% 1 0.108s ─pose proof (pf : Interpretation.Bo 2.7% 2.7% 1 0.092s ─reflexivity --------------------------- 2.6% 2.6% 7 0.032s ─Glue.split_BoundedWordToZ ------------- 0.2% 2.4% 1 0.084s ─tac ----------------------------------- 1.7% 2.2% 2 0.076s ─Reify.transitivity_tt ----------------- 0.1% 2.2% 2 0.040s ─transitivity -------------------------- 2.1% 2.1% 5 0.032s ─clearbody (ne_var_list) --------------- 2.1% 2.1% 4 0.056s ─destruct_sig -------------------------- 0.0% 2.1% 4 0.040s tactic local total calls max ────────────────────────────────────────┴──────┴──────┴───────┴─────────┘ ─Pipeline.refine_reflectively_gen ------ 0.0% 98.0% 1 3.376s ├─ReflectiveTactics.do_reflective_pipel 0.0% 77.1% 1 2.656s │└ReflectiveTactics.solve_side_conditio 0.0% 75.8% 1 2.612s │ ├─ReflectiveTactics.solve_post_reifie 1.2% 40.1% 1 1.380s │ │ ├─UnifyAbstractReflexivity.unify_tr 25.7% 30.5% 8 0.324s │ │ │└unify (constr) (constr) --------- 3.6% 3.6% 6 0.040s │ │ └─ReflectiveTactics.unify_abstract_ 5.8% 8.0% 1 0.276s │ │ └unify (constr) (constr) --------- 2.2% 2.2% 1 0.076s │ └─ReflectiveTactics.do_reify -------- 0.0% 35.8% 1 1.232s │ └Reify.Reify_rhs_gen --------------- 1.4% 34.4% 1 1.184s │ ├─Reify.do_reify_abs_goal --------- 18.5% 18.8% 2 0.648s │ │└Reify.do_reifyf_goal ------------ 17.3% 17.5% 16 0.604s │ │└eexact -------------------------- 3.8% 3.8% 16 0.012s │ ├─prove_interp_compile_correct ---- 0.0% 3.5% 1 0.120s │ │└rewrite ?EtaInterp.InterpExprEta 3.1% 3.1% 1 0.108s │ ├─rewrite H ----------------------- 3.4% 3.4% 1 0.116s │ ├─tac ----------------------------- 1.7% 2.2% 1 0.076s │ └─Reify.transitivity_tt ----------- 0.1% 2.2% 2 0.040s └─Glue.refine_to_reflective_glue' ----- 0.0% 20.9% 1 0.720s ├─Glue.zrange_to_reflective --------- 0.0% 14.2% 1 0.488s │ ├─Glue.zrange_to_reflective_goal -- 6.5% 10.6% 1 0.364s │ │└pose proof (pf : Interpretat 2.7% 2.7% 1 0.092s │ └─assert (H : is_bounded_by' bounds 3.6% 3.6% 2 0.064s ├─Glue.pattern_sig_sig_assoc -------- 0.0% 3.8% 1 0.132s │└Glue.pattern_proj1_sig_in_sig ----- 1.2% 3.6% 1 0.124s └─Glue.split_BoundedWordToZ --------- 0.2% 2.4% 1 0.084s └destruct_sig ---------------------- 0.0% 2.1% 4 0.040s src/Specific/X25519/C64/fesub (real: 26.11, user: 23.72, sys: 0.24, mem: 781808 ko) COQC src/Specific/X25519/C64/fesquare.v Finished transaction in 6.477 secs (6.044u,0.008s) (successful) total time: 6.012s tactic local total calls max ────────────────────────────────────────┴──────┴──────┴───────┴─────────┘ ─synthesize ---------------------------- 0.0% 100.0% 1 6.012s ─Pipeline.refine_reflectively_gen ------ 0.0% 95.9% 1 5.764s ─ReflectiveTactics.do_reflective_pipelin 0.0% 89.6% 1 5.388s ─ReflectiveTactics.solve_side_conditions 0.0% 88.8% 1 5.340s ─ReflectiveTactics.do_reify ------------ 0.0% 47.0% 1 2.828s ─Reify.Reify_rhs_gen ------------------- 1.5% 46.3% 1 2.784s ─ReflectiveTactics.solve_post_reified_si 0.5% 41.8% 1 2.512s ─UnifyAbstractReflexivity.unify_transfor 28.5% 34.1% 8 0.552s ─Reify.do_reify_abs_goal --------------- 28.7% 29.1% 2 1.752s ─Reify.do_reifyf_goal ------------------ 27.6% 27.9% 47 1.320s ─eexact -------------------------------- 8.4% 8.4% 49 0.024s ─ReflectiveTactics.unify_abstract_cbv_in 5.0% 6.9% 1 0.412s ─unify (constr) (constr) --------------- 6.3% 6.3% 7 0.104s ─Glue.refine_to_reflective_glue' ------- 0.0% 6.3% 1 0.376s ─prove_interp_compile_correct ---------- 0.0% 5.3% 1 0.316s ─rewrite ?EtaInterp.InterpExprEta ------ 4.8% 4.8% 1 0.288s ─Glue.zrange_to_reflective ------------- 0.0% 4.4% 1 0.264s ─IntegrationTestTemporaryMiscCommon.do_r 0.1% 3.7% 1 0.224s ─Glue.zrange_to_reflective_goal -------- 2.6% 3.3% 1 0.196s ─change G' ----------------------------- 3.1% 3.1% 1 0.188s ─rewrite H ----------------------------- 3.0% 3.0% 1 0.180s ─tac ----------------------------------- 1.9% 2.7% 2 0.160s ─reflexivity --------------------------- 2.4% 2.4% 7 0.060s tactic local total calls max ────────────────────────────────────────┴──────┴──────┴───────┴─────────┘ ─synthesize ---------------------------- 0.0% 100.0% 1 6.012s ├─Pipeline.refine_reflectively_gen ---- 0.0% 95.9% 1 5.764s │ ├─ReflectiveTactics.do_reflective_pip 0.0% 89.6% 1 5.388s │ │└ReflectiveTactics.solve_side_condit 0.0% 88.8% 1 5.340s │ │ ├─ReflectiveTactics.do_reify ------ 0.0% 47.0% 1 2.828s │ │ │└Reify.Reify_rhs_gen ------------- 1.5% 46.3% 1 2.784s │ │ │ ├─Reify.do_reify_abs_goal ------- 28.7% 29.1% 2 1.752s │ │ │ │└Reify.do_reifyf_goal ---------- 27.6% 27.9% 47 1.320s │ │ │ │└eexact ------------------------ 7.7% 7.7% 47 0.024s │ │ │ ├─prove_interp_compile_correct -- 0.0% 5.3% 1 0.316s │ │ │ │└rewrite ?EtaInterp.InterpExprEt 4.8% 4.8% 1 0.288s │ │ │ ├─rewrite H --------------------- 3.0% 3.0% 1 0.180s │ │ │ └─tac --------------------------- 1.9% 2.7% 1 0.160s │ │ └─ReflectiveTactics.solve_post_reif 0.5% 41.8% 1 2.512s │ │ ├─UnifyAbstractReflexivity.unify_ 28.5% 34.1% 8 0.552s │ │ │└unify (constr) (constr) ------- 4.6% 4.6% 6 0.076s │ │ └─ReflectiveTactics.unify_abstrac 5.0% 6.9% 1 0.412s │ └─Glue.refine_to_reflective_glue' --- 0.0% 6.3% 1 0.376s │ └Glue.zrange_to_reflective --------- 0.0% 4.4% 1 0.264s │ └Glue.zrange_to_reflective_goal ---- 2.6% 3.3% 1 0.196s └─IntegrationTestTemporaryMiscCommon.do 0.1% 3.7% 1 0.224s └change G' --------------------------- 3.1% 3.1% 1 0.188s Finished transaction in 12.356 secs (11.331u,0.004s) (successful) Closed under the global context total time: 6.012s tactic local total calls max ────────────────────────────────────────┴──────┴──────┴───────┴─────────┘ ─synthesize ---------------------------- 0.0% 100.0% 1 6.012s ─Pipeline.refine_reflectively_gen ------ 0.0% 95.9% 1 5.764s ─ReflectiveTactics.do_reflective_pipelin 0.0% 89.6% 1 5.388s ─ReflectiveTactics.solve_side_conditions 0.0% 88.8% 1 5.340s ─ReflectiveTactics.do_reify ------------ 0.0% 47.0% 1 2.828s ─Reify.Reify_rhs_gen ------------------- 1.5% 46.3% 1 2.784s ─ReflectiveTactics.solve_post_reified_si 0.5% 41.8% 1 2.512s ─UnifyAbstractReflexivity.unify_transfor 28.5% 34.1% 8 0.552s ─Reify.do_reify_abs_goal --------------- 28.7% 29.1% 2 1.752s ─Reify.do_reifyf_goal ------------------ 27.6% 27.9% 47 1.320s ─eexact -------------------------------- 8.4% 8.4% 49 0.024s ─ReflectiveTactics.unify_abstract_cbv_in 5.0% 6.9% 1 0.412s ─unify (constr) (constr) --------------- 6.3% 6.3% 7 0.104s ─Glue.refine_to_reflective_glue' ------- 0.0% 6.3% 1 0.376s ─prove_interp_compile_correct ---------- 0.0% 5.3% 1 0.316s ─rewrite ?EtaInterp.InterpExprEta ------ 4.8% 4.8% 1 0.288s ─Glue.zrange_to_reflective ------------- 0.0% 4.4% 1 0.264s ─IntegrationTestTemporaryMiscCommon.do_r 0.1% 3.7% 1 0.224s ─Glue.zrange_to_reflective_goal -------- 2.6% 3.3% 1 0.196s ─change G' ----------------------------- 3.1% 3.1% 1 0.188s ─rewrite H ----------------------------- 3.0% 3.0% 1 0.180s ─tac ----------------------------------- 1.9% 2.7% 2 0.160s ─reflexivity --------------------------- 2.4% 2.4% 7 0.060s tactic local total calls max ────────────────────────────────────────┴──────┴──────┴───────┴─────────┘ ─synthesize ---------------------------- 0.0% 100.0% 1 6.012s ├─Pipeline.refine_reflectively_gen ---- 0.0% 95.9% 1 5.764s │ ├─ReflectiveTactics.do_reflective_pip 0.0% 89.6% 1 5.388s │ │└ReflectiveTactics.solve_side_condit 0.0% 88.8% 1 5.340s │ │ ├─ReflectiveTactics.do_reify ------ 0.0% 47.0% 1 2.828s │ │ │└Reify.Reify_rhs_gen ------------- 1.5% 46.3% 1 2.784s │ │ │ ├─Reify.do_reify_abs_goal ------- 28.7% 29.1% 2 1.752s │ │ │ │└Reify.do_reifyf_goal ---------- 27.6% 27.9% 47 1.320s │ │ │ │└eexact ------------------------ 7.7% 7.7% 47 0.024s │ │ │ ├─prove_interp_compile_correct -- 0.0% 5.3% 1 0.316s │ │ │ │└rewrite ?EtaInterp.InterpExprEt 4.8% 4.8% 1 0.288s │ │ │ ├─rewrite H --------------------- 3.0% 3.0% 1 0.180s │ │ │ └─tac --------------------------- 1.9% 2.7% 1 0.160s │ │ └─ReflectiveTactics.solve_post_reif 0.5% 41.8% 1 2.512s │ │ ├─UnifyAbstractReflexivity.unify_ 28.5% 34.1% 8 0.552s │ │ │└unify (constr) (constr) ------- 4.6% 4.6% 6 0.076s │ │ └─ReflectiveTactics.unify_abstrac 5.0% 6.9% 1 0.412s │ └─Glue.refine_to_reflective_glue' --- 0.0% 6.3% 1 0.376s │ └Glue.zrange_to_reflective --------- 0.0% 4.4% 1 0.264s │ └Glue.zrange_to_reflective_goal ---- 2.6% 3.3% 1 0.196s └─IntegrationTestTemporaryMiscCommon.do 0.1% 3.7% 1 0.224s └change G' --------------------------- 3.1% 3.1% 1 0.188s src/Specific/X25519/C64/fesquare (real: 35.23, user: 32.24, sys: 0.26, mem: 802776 ko) COQC src/Specific/X25519/C64/femulDisplay > src/Specific/X25519/C64/femulDisplay.log COQC src/Specific/X25519/C64/freeze.v Finished transaction in 7.785 secs (7.139u,0.019s) (successful) total time: 7.112s tactic local total calls max ────────────────────────────────────────┴──────┴──────┴───────┴─────────┘ ─synthesize_freeze --------------------- -0.0% 100.0% 1 7.112s ─Pipeline.refine_reflectively_gen ------ 0.0% 99.2% 1 7.056s ─ReflectiveTactics.do_reflective_pipelin 0.0% 92.8% 1 6.600s ─ReflectiveTactics.solve_side_conditions -0.0% 91.8% 1 6.532s ─ReflectiveTactics.do_reify ------------ 0.0% 57.1% 1 4.060s ─Reify.Reify_rhs_gen ------------------- 1.5% 56.4% 1 4.012s ─Reify.do_reify_abs_goal --------------- 40.1% 40.3% 2 2.868s ─Reify.do_reifyf_goal ------------------ 39.1% 39.4% 129 2.800s ─ReflectiveTactics.solve_post_reified_si 0.6% 34.8% 1 2.472s ─UnifyAbstractReflexivity.unify_transfor 25.2% 29.4% 8 0.428s ─eexact -------------------------------- 12.9% 12.9% 131 0.028s ─Glue.refine_to_reflective_glue' ------- 0.1% 6.4% 1 0.456s ─prove_interp_compile_correct ---------- 0.0% 4.7% 1 0.332s ─unify (constr) (constr) --------------- 4.6% 4.6% 7 0.096s ─ReflectiveTactics.unify_abstract_cbv_in 3.1% 4.6% 1 0.324s ─rewrite ?EtaInterp.InterpExprEta ------ 4.3% 4.3% 1 0.308s ─Glue.zrange_to_reflective ------------- 0.0% 4.1% 1 0.292s ─Glue.zrange_to_reflective_goal -------- 2.6% 3.2% 1 0.228s ─rewrite H ----------------------------- 3.0% 3.0% 1 0.212s ─reflexivity --------------------------- 2.3% 2.3% 7 0.064s ─Reify.transitivity_tt ----------------- 0.0% 2.1% 2 0.096s ─transitivity -------------------------- 2.1% 2.1% 5 0.084s tactic local total calls max ────────────────────────────────────────┴──────┴──────┴───────┴─────────┘ ─synthesize_freeze --------------------- -0.0% 100.0% 1 7.112s └Pipeline.refine_reflectively_gen ------ 0.0% 99.2% 1 7.056s ├─ReflectiveTactics.do_reflective_pipel 0.0% 92.8% 1 6.600s │└ReflectiveTactics.solve_side_conditio -0.0% 91.8% 1 6.532s │ ├─ReflectiveTactics.do_reify -------- 0.0% 57.1% 1 4.060s │ │└Reify.Reify_rhs_gen --------------- 1.5% 56.4% 1 4.012s │ │ ├─Reify.do_reify_abs_goal --------- 40.1% 40.3% 2 2.868s │ │ │└Reify.do_reifyf_goal ------------ 39.1% 39.4% 129 2.800s │ │ │└eexact -------------------------- 12.4% 12.4% 129 0.028s │ │ ├─prove_interp_compile_correct ---- 0.0% 4.7% 1 0.332s │ │ │└rewrite ?EtaInterp.InterpExprEta 4.3% 4.3% 1 0.308s │ │ ├─rewrite H ----------------------- 3.0% 3.0% 1 0.212s │ │ └─Reify.transitivity_tt ----------- 0.0% 2.1% 2 0.096s │ │ └transitivity -------------------- 2.0% 2.0% 4 0.084s │ └─ReflectiveTactics.solve_post_reifie 0.6% 34.8% 1 2.472s │ ├─UnifyAbstractReflexivity.unify_tr 25.2% 29.4% 8 0.428s │ │└unify (constr) (constr) --------- 3.2% 3.2% 6 0.068s │ └─ReflectiveTactics.unify_abstract_ 3.1% 4.6% 1 0.324s └─Glue.refine_to_reflective_glue' ----- 0.1% 6.4% 1 0.456s └Glue.zrange_to_reflective ----------- 0.0% 4.1% 1 0.292s └Glue.zrange_to_reflective_goal ------ 2.6% 3.2% 1 0.228s Finished transaction in 12.063 secs (11.036u,0.012s) (successful) Closed under the global context total time: 7.112s tactic local total calls max ────────────────────────────────────────┴──────┴──────┴───────┴─────────┘ ─synthesize_freeze --------------------- -0.0% 100.0% 1 7.112s ─Pipeline.refine_reflectively_gen ------ 0.0% 99.2% 1 7.056s ─ReflectiveTactics.do_reflective_pipelin 0.0% 92.8% 1 6.600s ─ReflectiveTactics.solve_side_conditions -0.0% 91.8% 1 6.532s ─ReflectiveTactics.do_reify ------------ 0.0% 57.1% 1 4.060s ─Reify.Reify_rhs_gen ------------------- 1.5% 56.4% 1 4.012s ─Reify.do_reify_abs_goal --------------- 40.1% 40.3% 2 2.868s ─Reify.do_reifyf_goal ------------------ 39.1% 39.4% 129 2.800s ─ReflectiveTactics.solve_post_reified_si 0.6% 34.8% 1 2.472s ─UnifyAbstractReflexivity.unify_transfor 25.2% 29.4% 8 0.428s ─eexact -------------------------------- 12.9% 12.9% 131 0.028s ─Glue.refine_to_reflective_glue' ------- 0.1% 6.4% 1 0.456s ─prove_interp_compile_correct ---------- 0.0% 4.7% 1 0.332s ─unify (constr) (constr) --------------- 4.6% 4.6% 7 0.096s ─ReflectiveTactics.unify_abstract_cbv_in 3.1% 4.6% 1 0.324s ─rewrite ?EtaInterp.InterpExprEta ------ 4.3% 4.3% 1 0.308s ─Glue.zrange_to_reflective ------------- 0.0% 4.1% 1 0.292s ─Glue.zrange_to_reflective_goal -------- 2.6% 3.2% 1 0.228s ─rewrite H ----------------------------- 3.0% 3.0% 1 0.212s ─reflexivity --------------------------- 2.3% 2.3% 7 0.064s ─Reify.transitivity_tt ----------------- 0.0% 2.1% 2 0.096s ─transitivity -------------------------- 2.1% 2.1% 5 0.084s tactic local total calls max ────────────────────────────────────────┴──────┴──────┴───────┴─────────┘ ─synthesize_freeze --------------------- -0.0% 100.0% 1 7.112s └Pipeline.refine_reflectively_gen ------ 0.0% 99.2% 1 7.056s ├─ReflectiveTactics.do_reflective_pipel 0.0% 92.8% 1 6.600s │└ReflectiveTactics.solve_side_conditio -0.0% 91.8% 1 6.532s │ ├─ReflectiveTactics.do_reify -------- 0.0% 57.1% 1 4.060s │ │└Reify.Reify_rhs_gen --------------- 1.5% 56.4% 1 4.012s │ │ ├─Reify.do_reify_abs_goal --------- 40.1% 40.3% 2 2.868s │ │ │└Reify.do_reifyf_goal ------------ 39.1% 39.4% 129 2.800s │ │ │└eexact -------------------------- 12.4% 12.4% 129 0.028s │ │ ├─prove_interp_compile_correct ---- 0.0% 4.7% 1 0.332s │ │ │└rewrite ?EtaInterp.InterpExprEta 4.3% 4.3% 1 0.308s │ │ ├─rewrite H ----------------------- 3.0% 3.0% 1 0.212s │ │ └─Reify.transitivity_tt ----------- 0.0% 2.1% 2 0.096s │ │ └transitivity -------------------- 2.0% 2.0% 4 0.084s │ └─ReflectiveTactics.solve_post_reifie 0.6% 34.8% 1 2.472s │ ├─UnifyAbstractReflexivity.unify_tr 25.2% 29.4% 8 0.428s │ │└unify (constr) (constr) --------- 3.2% 3.2% 6 0.068s │ └─ReflectiveTactics.unify_abstract_ 3.1% 4.6% 1 0.324s └─Glue.refine_to_reflective_glue' ----- 0.1% 6.4% 1 0.456s └Glue.zrange_to_reflective ----------- 0.0% 4.1% 1 0.292s └Glue.zrange_to_reflective_goal ------ 2.6% 3.2% 1 0.228s src/Specific/X25519/C64/freeze (real: 36.42, user: 33.24, sys: 0.26, mem: 826476 ko) COQC src/Specific/NISTP256/AMD64/feadd.v Finished transaction in 9.065 secs (8.452u,0.004s) (successful) total time: 8.408s tactic local total calls max ────────────────────────────────────────┴──────┴──────┴───────┴─────────┘ ─Pipeline.refine_reflectively_gen ------ 0.0% 56.0% 1 4.712s ─ReflectiveTactics.do_reflective_pipelin 0.0% 47.7% 1 4.012s ─ReflectiveTactics.solve_side_conditions 0.0% 47.1% 1 3.960s ─synthesize_montgomery ----------------- 0.0% 44.0% 1 3.696s ─ReflectiveTactics.solve_post_reified_si 0.6% 26.4% 1 2.220s ─UnifyAbstractReflexivity.unify_transfor 18.0% 21.3% 8 0.508s ─IntegrationTestTemporaryMiscCommon.fact 1.3% 21.3% 1 1.788s ─IntegrationTestTemporaryMiscCommon.do_r 0.0% 21.0% 1 1.768s ─ReflectiveTactics.do_reify ------------ 0.0% 20.7% 1 1.740s ─Reify.Reify_rhs_gen ------------------- 1.0% 20.0% 1 1.684s ─DestructHyps.do_all_matches_then ------ 0.1% 18.6% 8 0.220s ─DestructHyps.do_one_match_then -------- 0.8% 18.5% 44 0.056s ─op_sig_side_conditions_t -------------- 0.0% 17.9% 1 1.504s ─do_tac -------------------------------- 0.0% 17.7% 43 0.052s ─destruct H ---------------------------- 17.7% 17.7% 36 0.052s ─rewrite <- (lem : lemT) by by_tac ltac: 0.3% 17.3% 1 1.452s ─IntegrationTestTemporaryMiscCommon.do_r 0.0% 17.3% 1 1.452s ─by_tac -------------------------------- 0.0% 17.0% 4 0.532s ─rewrite <- (ZRange.is_bounded_by_None_r 15.7% 15.8% 8 0.360s ─Reify.do_reify_abs_goal --------------- 9.1% 9.3% 2 0.780s ─Reify.do_reifyf_goal ------------------ 8.5% 8.6% 93 0.716s ─Glue.refine_to_reflective_glue' ------- 0.0% 8.3% 1 0.700s ─Glue.zrange_to_reflective ------------- 0.0% 5.3% 1 0.444s ─ReflectiveTactics.unify_abstract_cbv_in 2.9% 4.3% 1 0.360s ─Glue.zrange_to_reflective_goal -------- 2.5% 4.0% 1 0.336s ─unify (constr) (constr) --------------- 3.9% 3.9% 9 0.108s ─IntegrationTestTemporaryMiscCommon.do_s 0.0% 3.8% 1 0.316s ─ MapProjections.proj2 2.1% 2.1% 2 0.108s tactic local total calls max ────────────────────────────────────────┴──────┴──────┴───────┴─────────┘ ─Pipeline.refine_reflectively_gen ------ 0.0% 56.0% 1 4.712s ├─ReflectiveTactics.do_reflective_pipel 0.0% 47.7% 1 4.012s │└ReflectiveTactics.solve_side_conditio 0.0% 47.1% 1 3.960s │ ├─ReflectiveTactics.solve_post_reifie 0.6% 26.4% 1 2.220s │ │ ├─UnifyAbstractReflexivity.unify_tr 18.0% 21.3% 8 0.508s │ │ │└unify (constr) (constr) --------- 2.6% 2.6% 6 0.064s │ │ └─ReflectiveTactics.unify_abstract_ 2.9% 4.3% 1 0.360s │ └─ReflectiveTactics.do_reify -------- 0.0% 20.7% 1 1.740s │ └Reify.Reify_rhs_gen --------------- 1.0% 20.0% 1 1.684s │ ├─Reify.do_reify_abs_goal --------- 9.1% 9.3% 2 0.780s │ │└Reify.do_reifyf_goal ------------ 8.5% 8.6% 93 0.716s │ ├─prove_interp_compile_correct ---- 0.0% 2.4% 1 0.200s │ │└rewrite ?EtaInterp.InterpExprEta 2.2% 2.2% 1 0.188s │ └─rewrite H ----------------------- 2.3% 2.3% 1 0.192s └─Glue.refine_to_reflective_glue' ----- 0.0% 8.3% 1 0.700s └Glue.zrange_to_reflective ----------- 0.0% 5.3% 1 0.444s └Glue.zrange_to_reflective_goal ------ 2.5% 4.0% 1 0.336s ─synthesize_montgomery ----------------- 0.0% 44.0% 1 3.696s ├─IntegrationTestTemporaryMiscCommon.fa 1.3% 21.3% 1 1.788s │└op_sig_side_conditions_t ------------ 0.0% 17.9% 1 1.504s │ ├─DestructHyps.do_all_matches_then -- 0.1% 10.1% 4 0.220s │ │└DestructHyps.do_one_match_then ---- 0.4% 10.0% 24 0.052s │ │└do_tac ---------------------------- 0.0% 9.6% 20 0.048s │ │└destruct H ------------------------ 9.6% 9.6% 20 0.048s │ └─rewrite <- (ZRange.is_bounded_by_No 7.5% 7.6% 4 0.308s └─IntegrationTestTemporaryMiscCommon.do 0.0% 21.0% 1 1.768s ├─IntegrationTestTemporaryMiscCommon. 0.0% 17.3% 1 1.452s │└rewrite <- (lem : lemT) by by_tac l 0.3% 17.3% 1 1.452s │└by_tac ---------------------------- 0.0% 17.0% 4 0.532s │ ├─DestructHyps.do_all_matches_then 0.0% 8.5% 4 0.184s │ │└DestructHyps.do_one_match_then -- 0.3% 8.5% 20 0.056s │ │└do_tac -------------------------- 0.0% 8.2% 16 0.052s │ │└destruct H ---------------------- 8.2% 8.2% 16 0.052s │ └─rewrite <- (ZRange.is_bounded_by_ 8.2% 8.3% 4 0.360s └─IntegrationTestTemporaryMiscCommon. 0.0% 3.8% 1 0.316s └ MapProjections.proj2 2.1% 2.1% 2 0.108s tactic local total calls max ────────────────────────────────────────┴──────┴──────┴───────┴─────────┘ ─Pipeline.refine_reflectively_gen ------ 0.0% 56.0% 1 4.712s ├─ReflectiveTactics.do_reflective_pipel 0.0% 47.7% 1 4.012s │└ReflectiveTactics.solve_side_conditio 0.0% 47.1% 1 3.960s │ ├─ReflectiveTactics.solve_post_reifie 0.6% 26.4% 1 2.220s │ │ ├─UnifyAbstractReflexivity.unify_tr 18.0% 21.3% 8 0.508s │ │ │└unify (constr) (constr) --------- 2.6% 2.6% 6 0.064s │ │ └─ReflectiveTactics.unify_abstract_ 2.9% 4.3% 1 0.360s │ └─ReflectiveTactics.do_reify -------- 0.0% 20.7% 1 1.740s │ └Reify.Reify_rhs_gen --------------- 1.0% 20.0% 1 1.684s │ ├─Reify.do_reify_abs_goal --------- 9.1% 9.3% 2 0.780s │ │└Reify.do_reifyf_goal ------------ 8.5% 8.6% 93 0.716s │ ├─prove_interp_compile_correct ---- 0.0% 2.4% 1 0.200s │ │└rewrite ?EtaInterp.InterpExprEta 2.2% 2.2% 1 0.188s │ └─rewrite H ----------------------- 2.3% 2.3% 1 0.192s └─Glue.refine_to_reflective_glue' ----- 0.0% 8.3% 1 0.700s └Glue.zrange_to_reflective ----------- 0.0% 5.3% 1 0.444s └Glue.zrange_to_reflective_goal ------ 2.5% 4.0% 1 0.336s ─synthesize_montgomery ----------------- 0.0% 44.0% 1 3.696s ├─IntegrationTestTemporaryMiscCommon.fa 1.3% 21.3% 1 1.788s │└op_sig_side_conditions_t ------------ 0.0% 17.9% 1 1.504s │ ├─DestructHyps.do_all_matches_then -- 0.1% 10.1% 4 0.220s │ │└DestructHyps.do_one_match_then ---- 0.4% 10.0% 24 0.052s │ │└do_tac ---------------------------- 0.0% 9.6% 20 0.048s │ │└destruct H ------------------------ 9.6% 9.6% 20 0.048s │ └─rewrite <- (ZRange.is_bounded_by_No 7.5% 7.6% 4 0.308s └─IntegrationTestTemporaryMiscCommon.do 0.0% 21.0% 1 1.768s ├─IntegrationTestTemporaryMiscCommon. 0.0% 17.3% 1 1.452s │└rewrite <- (lem : lemT) by by_tac l 0.3% 17.3% 1 1.452s │└by_tac ---------------------------- 0.0% 17.0% 4 0.532s │ ├─DestructHyps.do_all_matches_then 0.0% 8.5% 4 0.184s │ │└DestructHyps.do_one_match_then -- 0.3% 8.5% 20 0.056s │ │└do_tac -------------------------- 0.0% 8.2% 16 0.052s │ │└destruct H ---------------------- 8.2% 8.2% 16 0.052s │ └─rewrite <- (ZRange.is_bounded_by_ 8.2% 8.3% 4 0.360s └─IntegrationTestTemporaryMiscCommon. 0.0% 3.8% 1 0.316s └ src/Specific/NISTP256/AMD64/feaddDisplay.log COQC src/Specific/NISTP256/AMD64/fenzDisplay > src/Specific/NISTP256/AMD64/fenzDisplay.log COQC src/Specific/NISTP256/AMD64/feoppDisplay > src/Specific/NISTP256/AMD64/feoppDisplay.log COQC src/Specific/NISTP256/AMD64/fesubDisplay > src/Specific/NISTP256/AMD64/fesubDisplay.log COQC src/Specific/X25519/C64/fesquareDisplay > src/Specific/X25519/C64/fesquareDisplay.log COQC src/Specific/solinas32_2e255m765_12limbs/femul.v Finished transaction in 60.265 secs (55.388u,0.103s) (successful) total time: 55.440s tactic local total calls max ────────────────────────────────────────┴──────┴──────┴───────┴─────────┘ ─Pipeline.refine_reflectively_gen ------ 0.0% 95.9% 1 53.156s ─ReflectiveTactics.do_reflective_pipelin 0.0% 89.2% 1 49.464s ─ReflectiveTactics.solve_side_conditions 0.0% 88.9% 1 49.288s ─ReflectiveTactics.do_reify ------------ -0.0% 49.9% 1 27.684s ─Reify.Reify_rhs_gen ------------------- 1.3% 49.3% 1 27.348s ─ReflectiveTactics.solve_post_reified_si 0.1% 39.0% 1 21.604s ─Reify.do_reify_abs_goal --------------- 36.3% 36.6% 2 20.272s ─UnifyAbstractReflexivity.unify_transfor 30.8% 36.1% 8 8.636s ─Reify.do_reifyf_goal ------------------ 35.7% 35.9% 108 10.356s ─eexact -------------------------------- 11.5% 11.5% 110 0.128s ─Glue.refine_to_reflective_glue' ------- 0.0% 6.7% 1 3.692s ─Glue.zrange_to_reflective ------------- 0.0% 6.2% 1 3.424s ─unify (constr) (constr) --------------- 4.9% 4.9% 7 1.140s ─Glue.zrange_to_reflective_goal -------- 1.4% 4.7% 1 2.592s ─synthesize ---------------------------- 0.0% 4.1% 1 2.284s ─IntegrationTestTemporaryMiscCommon.do_r 0.0% 4.0% 1 2.220s ─change G' ----------------------------- 3.9% 3.9% 1 2.148s ─pose proof (pf : Interpretation.Bo 3.1% 3.1% 1 1.736s ─rewrite H ----------------------------- 3.1% 3.1% 1 1.692s ─prove_interp_compile_correct ---------- 0.0% 3.0% 1 1.636s ─rewrite ?EtaInterp.InterpExprEta ------ 2.7% 2.7% 1 1.484s tactic local total calls max ────────────────────────────────────────┴──────┴──────┴───────┴─────────┘ ─Pipeline.refine_reflectively_gen ------ 0.0% 95.9% 1 53.156s ├─ReflectiveTactics.do_reflective_pipel 0.0% 89.2% 1 49.464s │└ReflectiveTactics.solve_side_conditio 0.0% 88.9% 1 49.288s │ ├─ReflectiveTactics.do_reify -------- -0.0% 49.9% 1 27.684s │ │└Reify.Reify_rhs_gen --------------- 1.3% 49.3% 1 27.348s │ │ ├─Reify.do_reify_abs_goal --------- 36.3% 36.6% 2 20.272s │ │ │└Reify.do_reifyf_goal ------------ 35.7% 35.9% 108 10.356s │ │ │└eexact -------------------------- 11.1% 11.1% 108 0.072s │ │ ├─rewrite H ----------------------- 3.1% 3.1% 1 1.692s │ │ └─prove_interp_compile_correct ---- 0.0% 3.0% 1 1.636s │ │ └rewrite ?EtaInterp.InterpExprEta 2.7% 2.7% 1 1.484s │ └─ReflectiveTactics.solve_post_reifie 0.1% 39.0% 1 21.604s │ └UnifyAbstractReflexivity.unify_tran 30.8% 36.1% 8 8.636s │ └unify (constr) (constr) ----------- 4.4% 4.4% 6 1.140s └─Glue.refine_to_reflective_glue' ----- 0.0% 6.7% 1 3.692s └Glue.zrange_to_reflective ----------- 0.0% 6.2% 1 3.424s └Glue.zrange_to_reflective_goal ------ 1.4% 4.7% 1 2.592s └pose proof (pf : Interpretation. 3.1% 3.1% 1 1.736s ─synthesize ---------------------------- 0.0% 4.1% 1 2.284s └IntegrationTestTemporaryMiscCommon.do_r 0.0% 4.0% 1 2.220s └change G' ----------------------------- 3.9% 3.9% 1 2.148s Finished transaction in 92.046 secs (84.315u,0.032s) (successful) Closed under the global context total time: 55.440s tactic local total calls max ────────────────────────────────────────┴──────┴──────┴───────┴─────────┘ ─Pipeline.refine_reflectively_gen ------ 0.0% 95.9% 1 53.156s ─ReflectiveTactics.do_reflective_pipelin 0.0% 89.2% 1 49.464s ─ReflectiveTactics.solve_side_conditions 0.0% 88.9% 1 49.288s ─ReflectiveTactics.do_reify ------------ -0.0% 49.9% 1 27.684s ─Reify.Reify_rhs_gen ------------------- 1.3% 49.3% 1 27.348s ─ReflectiveTactics.solve_post_reified_si 0.1% 39.0% 1 21.604s ─Reify.do_reify_abs_goal --------------- 36.3% 36.6% 2 20.272s ─UnifyAbstractReflexivity.unify_transfor 30.8% 36.1% 8 8.636s ─Reify.do_reifyf_goal ------------------ 35.7% 35.9% 108 10.356s ─eexact -------------------------------- 11.5% 11.5% 110 0.128s ─Glue.refine_to_reflective_glue' ------- 0.0% 6.7% 1 3.692s ─Glue.zrange_to_reflective ------------- 0.0% 6.2% 1 3.424s ─unify (constr) (constr) --------------- 4.9% 4.9% 7 1.140s ─Glue.zrange_to_reflective_goal -------- 1.4% 4.7% 1 2.592s ─synthesize ---------------------------- 0.0% 4.1% 1 2.284s ─IntegrationTestTemporaryMiscCommon.do_r 0.0% 4.0% 1 2.220s ─change G' ----------------------------- 3.9% 3.9% 1 2.148s ─pose proof (pf : Interpretation.Bo 3.1% 3.1% 1 1.736s ─rewrite H ----------------------------- 3.1% 3.1% 1 1.692s ─prove_interp_compile_correct ---------- 0.0% 3.0% 1 1.636s ─rewrite ?EtaInterp.InterpExprEta ------ 2.7% 2.7% 1 1.484s tactic local total calls max ────────────────────────────────────────┴──────┴──────┴───────┴─────────┘ ─Pipeline.refine_reflectively_gen ------ 0.0% 95.9% 1 53.156s ├─ReflectiveTactics.do_reflective_pipel 0.0% 89.2% 1 49.464s │└ReflectiveTactics.solve_side_conditio 0.0% 88.9% 1 49.288s │ ├─ReflectiveTactics.do_reify -------- -0.0% 49.9% 1 27.684s │ │└Reify.Reify_rhs_gen --------------- 1.3% 49.3% 1 27.348s │ │ ├─Reify.do_reify_abs_goal --------- 36.3% 36.6% 2 20.272s │ │ │└Reify.do_reifyf_goal ------------ 35.7% 35.9% 108 10.356s │ │ │└eexact -------------------------- 11.1% 11.1% 108 0.072s │ │ ├─rewrite H ----------------------- 3.1% 3.1% 1 1.692s │ │ └─prove_interp_compile_correct ---- 0.0% 3.0% 1 1.636s │ │ └rewrite ?EtaInterp.InterpExprEta 2.7% 2.7% 1 1.484s │ └─ReflectiveTactics.solve_post_reifie 0.1% 39.0% 1 21.604s │ └UnifyAbstractReflexivity.unify_tran 30.8% 36.1% 8 8.636s │ └unify (constr) (constr) ----------- 4.4% 4.4% 6 1.140s └─Glue.refine_to_reflective_glue' ----- 0.0% 6.7% 1 3.692s └Glue.zrange_to_reflective ----------- 0.0% 6.2% 1 3.424s └Glue.zrange_to_reflective_goal ------ 1.4% 4.7% 1 2.592s └pose proof (pf : Interpretation. 3.1% 3.1% 1 1.736s ─synthesize ---------------------------- 0.0% 4.1% 1 2.284s └IntegrationTestTemporaryMiscCommon.do_r 0.0% 4.0% 1 2.220s └change G' ----------------------------- 3.9% 3.9% 1 2.148s src/Specific/solinas32_2e255m765_12limbs/femul (real: 179.21, user: 164.11, sys: 0.42, mem: 1549104 ko) COQC src/Specific/X25519/C64/fesubDisplay > src/Specific/X25519/C64/fesubDisplay.log COQC src/Specific/X25519/C64/freezeDisplay > src/Specific/X25519/C64/freezeDisplay.log COQC src/Specific/solinas32_2e255m765_13limbs/femul.v Finished transaction in 74.548 secs (68.928u,0.079s) (successful) total time: 68.948s tactic local total calls max ────────────────────────────────────────┴──────┴──────┴───────┴─────────┘ ─Pipeline.refine_reflectively_gen ------ 0.0% 95.7% 1 65.956s ─ReflectiveTactics.do_reflective_pipelin 0.0% 88.7% 1 61.172s ─ReflectiveTactics.solve_side_conditions 0.0% 88.4% 1 60.944s ─ReflectiveTactics.do_reify ------------ 0.0% 48.5% 1 33.408s ─Reify.Reify_rhs_gen ------------------- 1.3% 47.9% 1 33.020s ─ReflectiveTactics.solve_post_reified_si 0.1% 39.9% 1 27.536s ─UnifyAbstractReflexivity.unify_transfor 32.0% 37.2% 8 11.528s ─Reify.do_reify_abs_goal --------------- 36.0% 36.2% 2 24.960s ─Reify.do_reifyf_goal ------------------ 35.3% 35.5% 117 12.840s ─eexact -------------------------------- 11.4% 11.4% 119 0.160s ─Glue.refine_to_reflective_glue' ------- 0.0% 6.9% 1 4.784s ─Glue.zrange_to_reflective ------------- 0.0% 6.5% 1 4.512s ─Glue.zrange_to_reflective_goal -------- 1.3% 4.9% 1 3.396s ─unify (constr) (constr) --------------- 4.9% 4.9% 7 1.524s ─synthesize ---------------------------- 0.0% 4.3% 1 2.992s ─IntegrationTestTemporaryMiscCommon.do_r 0.0% 4.2% 1 2.912s ─change G' ----------------------------- 4.1% 4.1% 1 2.840s ─pose proof (pf : Interpretation.Bo 3.5% 3.5% 1 2.420s ─rewrite H ----------------------------- 3.0% 3.0% 1 2.084s ─prove_interp_compile_correct ---------- 0.0% 2.7% 1 1.856s ─rewrite ?EtaInterp.InterpExprEta ------ 2.5% 2.5% 1 1.692s tactic local total calls max ────────────────────────────────────────┴──────┴──────┴───────┴─────────┘ ─Pipeline.refine_reflectively_gen ------ 0.0% 95.7% 1 65.956s ├─ReflectiveTactics.do_reflective_pipel 0.0% 88.7% 1 61.172s │└ReflectiveTactics.solve_side_conditio 0.0% 88.4% 1 60.944s │ ├─ReflectiveTactics.do_reify -------- 0.0% 48.5% 1 33.408s │ │└Reify.Reify_rhs_gen --------------- 1.3% 47.9% 1 33.020s │ │ ├─Reify.do_reify_abs_goal --------- 36.0% 36.2% 2 24.960s │ │ │└Reify.do_reifyf_goal ------------ 35.3% 35.5% 117 12.840s │ │ │└eexact -------------------------- 10.9% 10.9% 117 0.088s │ │ ├─rewrite H ----------------------- 3.0% 3.0% 1 2.084s │ │ └─prove_interp_compile_correct ---- 0.0% 2.7% 1 1.856s │ │ └rewrite ?EtaInterp.InterpExprEta 2.5% 2.5% 1 1.692s │ └─ReflectiveTactics.solve_post_reifie 0.1% 39.9% 1 27.536s │ └UnifyAbstractReflexivity.unify_tran 32.0% 37.2% 8 11.528s │ └unify (constr) (constr) ----------- 4.3% 4.3% 6 1.524s └─Glue.refine_to_reflective_glue' ----- 0.0% 6.9% 1 4.784s └Glue.zrange_to_reflective ----------- 0.0% 6.5% 1 4.512s └Glue.zrange_to_reflective_goal ------ 1.3% 4.9% 1 3.396s └pose proof (pf : Interpretation. 3.5% 3.5% 1 2.420s ─synthesize ---------------------------- 0.0% 4.3% 1 2.992s └IntegrationTestTemporaryMiscCommon.do_r 0.0% 4.2% 1 2.912s └change G' ----------------------------- 4.1% 4.1% 1 2.840s Finished transaction in 105.62 secs (97.6u,0.02s) (successful) Closed under the global context total time: 68.948s tactic local total calls max ────────────────────────────────────────┴──────┴──────┴───────┴─────────┘ ─Pipeline.refine_reflectively_gen ------ 0.0% 95.7% 1 65.956s ─ReflectiveTactics.do_reflective_pipelin 0.0% 88.7% 1 61.172s ─ReflectiveTactics.solve_side_conditions 0.0% 88.4% 1 60.944s ─ReflectiveTactics.do_reify ------------ 0.0% 48.5% 1 33.408s ─Reify.Reify_rhs_gen ------------------- 1.3% 47.9% 1 33.020s ─ReflectiveTactics.solve_post_reified_si 0.1% 39.9% 1 27.536s ─UnifyAbstractReflexivity.unify_transfor 32.0% 37.2% 8 11.528s ─Reify.do_reify_abs_goal --------------- 36.0% 36.2% 2 24.960s ─Reify.do_reifyf_goal ------------------ 35.3% 35.5% 117 12.840s ─eexact -------------------------------- 11.4% 11.4% 119 0.160s ─Glue.refine_to_reflective_glue' ------- 0.0% 6.9% 1 4.784s ─Glue.zrange_to_reflective ------------- 0.0% 6.5% 1 4.512s ─Glue.zrange_to_reflective_goal -------- 1.3% 4.9% 1 3.396s ─unify (constr) (constr) --------------- 4.9% 4.9% 7 1.524s ─synthesize ---------------------------- 0.0% 4.3% 1 2.992s ─IntegrationTestTemporaryMiscCommon.do_r 0.0% 4.2% 1 2.912s ─change G' ----------------------------- 4.1% 4.1% 1 2.840s ─pose proof (pf : Interpretation.Bo 3.5% 3.5% 1 2.420s ─rewrite H ----------------------------- 3.0% 3.0% 1 2.084s ─prove_interp_compile_correct ---------- 0.0% 2.7% 1 1.856s ─rewrite ?EtaInterp.InterpExprEta ------ 2.5% 2.5% 1 1.692s tactic local total calls max ────────────────────────────────────────┴──────┴──────┴───────┴─────────┘ ─Pipeline.refine_reflectively_gen ------ 0.0% 95.7% 1 65.956s ├─ReflectiveTactics.do_reflective_pipel 0.0% 88.7% 1 61.172s │└ReflectiveTactics.solve_side_conditio 0.0% 88.4% 1 60.944s │ ├─ReflectiveTactics.do_reify -------- 0.0% 48.5% 1 33.408s │ │└Reify.Reify_rhs_gen --------------- 1.3% 47.9% 1 33.020s │ │ ├─Reify.do_reify_abs_goal --------- 36.0% 36.2% 2 24.960s │ │ │└Reify.do_reifyf_goal ------------ 35.3% 35.5% 117 12.840s │ │ │└eexact -------------------------- 10.9% 10.9% 117 0.088s │ │ ├─rewrite H ----------------------- 3.0% 3.0% 1 2.084s │ │ └─prove_interp_compile_correct ---- 0.0% 2.7% 1 1.856s │ │ └rewrite ?EtaInterp.InterpExprEta 2.5% 2.5% 1 1.692s │ └─ReflectiveTactics.solve_post_reifie 0.1% 39.9% 1 27.536s │ └UnifyAbstractReflexivity.unify_tran 32.0% 37.2% 8 11.528s │ └unify (constr) (constr) ----------- 4.3% 4.3% 6 1.524s └─Glue.refine_to_reflective_glue' ----- 0.0% 6.9% 1 4.784s └Glue.zrange_to_reflective ----------- 0.0% 6.5% 1 4.512s └Glue.zrange_to_reflective_goal ------ 1.3% 4.9% 1 3.396s └pose proof (pf : Interpretation. 3.5% 3.5% 1 2.420s ─synthesize ---------------------------- 0.0% 4.3% 1 2.992s └IntegrationTestTemporaryMiscCommon.do_r 0.0% 4.2% 1 2.912s └change G' ----------------------------- 4.1% 4.1% 1 2.840s src/Specific/solinas32_2e255m765_13limbs/femul (real: 207.94, user: 192.95, sys: 0.48, mem: 1656912 ko) COQC src/Specific/NISTP256/AMD64/femul.v Finished transaction in 122.29 secs (111.972u,0.239s) (successful) total time: 112.164s tactic local total calls max ────────────────────────────────────────┴──────┴──────┴───────┴─────────┘ ─Pipeline.refine_reflectively_gen ------ 0.0% 97.1% 1 108.944s ─ReflectiveTactics.do_reflective_pipelin -0.0% 96.5% 1 108.236s ─ReflectiveTactics.solve_side_conditions 0.0% 96.3% 1 108.000s ─ReflectiveTactics.do_reify ------------ 0.0% 81.8% 1 91.740s ─Reify.Reify_rhs_gen ------------------- 0.7% 81.6% 1 91.504s ─Reify.do_reify_abs_goal --------------- 75.6% 75.7% 2 84.892s ─Reify.do_reifyf_goal ------------------ 75.2% 75.4% 901 84.532s ─eexact -------------------------------- 17.1% 17.1% 903 0.140s ─ReflectiveTactics.solve_post_reified_si 0.2% 14.5% 1 16.260s ─UnifyAbstractReflexivity.unify_transfor 11.7% 13.3% 8 3.152s ─synthesize_montgomery ----------------- 0.0% 2.9% 1 3.220s tactic local total calls max ────────────────────────────────────────┴──────┴──────┴───────┴─────────┘ ─Pipeline.refine_reflectively_gen ------ 0.0% 97.1% 1 108.944s └ReflectiveTactics.do_reflective_pipelin -0.0% 96.5% 1 108.236s └ReflectiveTactics.solve_side_conditions 0.0% 96.3% 1 108.000s ├─ReflectiveTactics.do_reify ---------- 0.0% 81.8% 1 91.740s │└Reify.Reify_rhs_gen ----------------- 0.7% 81.6% 1 91.504s │└Reify.do_reify_abs_goal ------------- 75.6% 75.7% 2 84.892s │└Reify.do_reifyf_goal ---------------- 75.2% 75.4% 901 84.532s │└eexact ------------------------------ 16.9% 16.9% 901 0.140s └─ReflectiveTactics.solve_post_reified_ 0.2% 14.5% 1 16.260s └UnifyAbstractReflexivity.unify_transf 11.7% 13.3% 8 3.152s ─synthesize_montgomery ----------------- 0.0% 2.9% 1 3.220s Finished transaction in 72.408 secs (68.432u,0.064s) (successful) Closed under the global context total time: 112.164s tactic local total calls max ────────────────────────────────────────┴──────┴──────┴───────┴─────────┘ ─Pipeline.refine_reflectively_gen ------ 0.0% 97.1% 1 108.944s ─ReflectiveTactics.do_reflective_pipelin -0.0% 96.5% 1 108.236s ─ReflectiveTactics.solve_side_conditions 0.0% 96.3% 1 108.000s ─ReflectiveTactics.do_reify ------------ 0.0% 81.8% 1 91.740s ─Reify.Reify_rhs_gen ------------------- 0.7% 81.6% 1 91.504s ─Reify.do_reify_abs_goal --------------- 75.6% 75.7% 2 84.892s ─Reify.do_reifyf_goal ------------------ 75.2% 75.4% 901 84.532s ─eexact -------------------------------- 17.1% 17.1% 903 0.140s ─ReflectiveTactics.solve_post_reified_si 0.2% 14.5% 1 16.260s ─UnifyAbstractReflexivity.unify_transfor 11.7% 13.3% 8 3.152s ─synthesize_montgomery ----------------- 0.0% 2.9% 1 3.220s tactic local total calls max ────────────────────────────────────────┴──────┴──────┴───────┴─────────┘ ─Pipeline.refine_reflectively_gen ------ 0.0% 97.1% 1 108.944s └ReflectiveTactics.do_reflective_pipelin -0.0% 96.5% 1 108.236s └ReflectiveTactics.solve_side_conditions 0.0% 96.3% 1 108.000s ├─ReflectiveTactics.do_reify ---------- 0.0% 81.8% 1 91.740s │└Reify.Reify_rhs_gen ----------------- 0.7% 81.6% 1 91.504s │└Reify.do_reify_abs_goal ------------- 75.6% 75.7% 2 84.892s │└Reify.do_reifyf_goal ---------------- 75.2% 75.4% 901 84.532s │└eexact ------------------------------ 16.9% 16.9% 901 0.140s └─ReflectiveTactics.solve_post_reified_ 0.2% 14.5% 1 16.260s └UnifyAbstractReflexivity.unify_transf 11.7% 13.3% 8 3.152s ─synthesize_montgomery ----------------- 0.0% 2.9% 1 3.220s src/Specific/NISTP256/AMD64/femul (real: 217.80, user: 202.52, sys: 0.53, mem: 3307052 ko) COQC src/Specific/NISTP256/AMD64/femulDisplay > src/Specific/NISTP256/AMD64/femulDisplay.log COQC src/Specific/X25519/C64/ladderstep.v total time: 82.012s tactic local total calls max ────────────────────────────────────────┴──────┴──────┴───────┴─────────┘ ─synthesize_xzladderstep --------------- 0.0% 100.0% 1 82.012s ─Pipeline.refine_reflectively_gen ------ 0.0% 99.0% 1 81.228s ─ReflectiveTactics.do_reflective_pipelin 0.0% 96.1% 1 78.784s ─ReflectiveTactics.solve_side_conditions 0.0% 95.9% 1 78.684s ─ReflectiveTactics.solve_post_reified_si 0.1% 72.6% 1 59.540s ─UnifyAbstractReflexivity.unify_transfor 64.6% 68.0% 8 30.740s ─ReflectiveTactics.do_reify ------------ 0.0% 23.3% 1 19.144s ─Reify.Reify_rhs_gen ------------------- 1.2% 14.5% 1 11.860s ─Reify.do_reifyf_goal ------------------ 7.1% 7.2% 138 1.908s ─Compilers.Reify.reify_context_variables 0.0% 5.9% 1 4.828s ─rewrite H ----------------------------- 4.4% 4.4% 1 3.600s ─ReflectiveTactics.unify_abstract_cbv_in 2.9% 4.0% 1 3.288s ─Glue.refine_to_reflective_glue' ------- 0.0% 3.0% 1 2.444s ─Glue.zrange_to_reflective ------------- 0.0% 2.5% 1 2.060s ─reflexivity --------------------------- 2.3% 2.3% 11 0.816s ─Reify.transitivity_tt ----------------- 0.0% 2.1% 2 0.968s ─Glue.zrange_to_reflective_goal -------- 1.4% 2.1% 1 1.720s ─clear (var_list) ---------------------- 2.0% 2.0% 159 0.584s ─eexact -------------------------------- 2.0% 2.0% 140 0.032s tactic local total calls max ────────────────────────────────────────┴──────┴──────┴───────┴─────────┘ ─synthesize_xzladderstep --------------- 0.0% 100.0% 1 82.012s └Pipeline.refine_reflectively_gen ------ 0.0% 99.0% 1 81.228s ├─ReflectiveTactics.do_reflective_pipel 0.0% 96.1% 1 78.784s │└ReflectiveTactics.solve_side_conditio 0.0% 95.9% 1 78.684s │ ├─ReflectiveTactics.solve_post_reifie 0.1% 72.6% 1 59.540s │ │ ├─UnifyAbstractReflexivity.unify_tr 64.6% 68.0% 8 30.740s │ │ └─ReflectiveTactics.unify_abstract_ 2.9% 4.0% 1 3.288s │ └─ReflectiveTactics.do_reify -------- 0.0% 23.3% 1 19.144s │ ├─Reify.Reify_rhs_gen ------------- 1.2% 14.5% 1 11.860s │ │ ├─rewrite H --------------------- 4.4% 4.4% 1 3.600s │ │ └─Reify.transitivity_tt --------- 0.0% 2.1% 2 0.968s │ └─Compilers.Reify.reify_context_var 0.0% 5.9% 1 4.828s │ └Reify.do_reifyf_goal ------------ 5.7% 5.8% 113 1.908s └─Glue.refine_to_reflective_glue' ----- 0.0% 3.0% 1 2.444s └Glue.zrange_to_reflective ----------- 0.0% 2.5% 1 2.060s └Glue.zrange_to_reflective_goal ------ 1.4% 2.1% 1 1.720s Finished transaction in 194.903 secs (185.732u,0.043s) (successful) Closed under the global context total time: 82.012s tactic local total calls max ────────────────────────────────────────┴──────┴──────┴───────┴─────────┘ ─synthesize_xzladderstep --------------- 0.0% 100.0% 1 82.012s ─Pipeline.refine_reflectively_gen ------ 0.0% 99.0% 1 81.228s ─ReflectiveTactics.do_reflective_pipelin 0.0% 96.1% 1 78.784s ─ReflectiveTactics.solve_side_conditions 0.0% 95.9% 1 78.684s ─ReflectiveTactics.solve_post_reified_si 0.1% 72.6% 1 59.540s ─UnifyAbstractReflexivity.unify_transfor 64.6% 68.0% 8 30.740s ─ReflectiveTactics.do_reify ------------ 0.0% 23.3% 1 19.144s ─Reify.Reify_rhs_gen ------------------- 1.2% 14.5% 1 11.860s ─Reify.do_reifyf_goal ------------------ 7.1% 7.2% 138 1.908s ─Compilers.Reify.reify_context_variables 0.0% 5.9% 1 4.828s ─rewrite H ----------------------------- 4.4% 4.4% 1 3.600s ─ReflectiveTactics.unify_abstract_cbv_in 2.9% 4.0% 1 3.288s ─Glue.refine_to_reflective_glue' ------- 0.0% 3.0% 1 2.444s ─Glue.zrange_to_reflective ------------- 0.0% 2.5% 1 2.060s ─reflexivity --------------------------- 2.3% 2.3% 11 0.816s ─Reify.transitivity_tt ----------------- 0.0% 2.1% 2 0.968s ─Glue.zrange_to_reflective_goal -------- 1.4% 2.1% 1 1.720s ─clear (var_list) ---------------------- 2.0% 2.0% 159 0.584s ─eexact -------------------------------- 2.0% 2.0% 140 0.032s tactic local total calls max ────────────────────────────────────────┴──────┴──────┴───────┴─────────┘ ─synthesize_xzladderstep --------------- 0.0% 100.0% 1 82.012s └Pipeline.refine_reflectively_gen ------ 0.0% 99.0% 1 81.228s ├─ReflectiveTactics.do_reflective_pipel 0.0% 96.1% 1 78.784s │└ReflectiveTactics.solve_side_conditio 0.0% 95.9% 1 78.684s │ ├─ReflectiveTactics.solve_post_reifie 0.1% 72.6% 1 59.540s │ │ ├─UnifyAbstractReflexivity.unify_tr 64.6% 68.0% 8 30.740s │ │ └─ReflectiveTactics.unify_abstract_ 2.9% 4.0% 1 3.288s │ └─ReflectiveTactics.do_reify -------- 0.0% 23.3% 1 19.144s │ ├─Reify.Reify_rhs_gen ------------- 1.2% 14.5% 1 11.860s │ │ ├─rewrite H --------------------- 4.4% 4.4% 1 3.600s │ │ └─Reify.transitivity_tt --------- 0.0% 2.1% 2 0.968s │ └─Compilers.Reify.reify_context_var 0.0% 5.9% 1 4.828s │ └Reify.do_reifyf_goal ------------ 5.7% 5.8% 113 1.908s └─Glue.refine_to_reflective_glue' ----- 0.0% 3.0% 1 2.444s └Glue.zrange_to_reflective ----------- 0.0% 2.5% 1 2.060s └Glue.zrange_to_reflective_goal ------ 1.4% 2.1% 1 1.720s src/Specific/X25519/C64/ladderstep (real: 316.83, user: 299.49, sys: 0.52, mem: 1621500 ko) COQC src/Specific/X25519/C64/ladderstepDisplay > src/Specific/X25519/C64/ladderstepDisplay.log time-of-build-both-real-absolute.log.expected000066400000000000000000000076441466560755400374400ustar00rootroot00000000000000coq-8.20.0/test-suite/precomputed-time-tests/correct-diff-sorting-order-mem After | Peak Mem | File Name | Before | Peak Mem || Change || Change (mem) | % Change | % Change (mem) --------------------------------------------------------------------------------------------------------------------------------------------------------- 20m46.07s | 3302508 ko | Total Time / Peak Mem | 23m06.31s | 3307052 ko || -2m20.24s || -4544 ko | -10.11% | -0.13% --------------------------------------------------------------------------------------------------------------------------------------------------------- 3m22.96s | 3302508 ko | Specific/NISTP256/AMD64/femul | 3m37.80s | 3307052 ko || -0m14.84s || -4544 ko | -6.81% | -0.13% 4m16.77s | 1617000 ko | Specific/X25519/C64/ladderstep | 5m16.83s | 1621500 ko || -1m00.06s || -4500 ko | -18.95% | -0.27% 3m01.77s | 1589516 ko | Specific/solinas32_2e255m765_13limbs/femul | 3m27.94s | 1656912 ko || -0m26.17s || -67396 ko | -12.58% | -4.06% 2m35.79s | 1454696 ko | Specific/solinas32_2e255m765_12limbs/femul | 2m59.21s | 1549104 ko || -0m23.42s || -94408 ko | -13.06% | -6.09% 0m34.35s | 828104 ko | Specific/X25519/C64/freeze | 0m36.42s | 826476 ko || -0m02.07s || 1628 ko | -5.68% | +0.19% 0m39.72s | 825448 ko | Specific/X25519/C64/femul | 0m42.98s | 839624 ko || -0m03.26s || -14176 ko | -7.58% | -1.68% 0m33.08s | 799620 ko | Specific/X25519/C64/fesquare | 0m35.23s | 802776 ko || -0m02.15s || -3156 ko | -6.10% | -0.39% 0m38.19s | 799216 ko | Specific/NISTP256/AMD64/feadd | 0m40.48s | 797944 ko || -0m02.29s || 1272 ko | -5.65% | +0.15% 0m43.34s | 793376 ko | Specific/NISTP256/AMD64/fesub | 0m43.78s | 799668 ko || -0m00.44s || -6292 ko | -1.00% | -0.78% 0m27.11s | 786052 ko | Specific/X25519/C64/fecarry | 0m28.85s | 787148 ko || -0m01.74s || -1096 ko | -6.03% | -0.13% 0m24.71s | 778792 ko | Specific/X25519/C64/fesub | 0m26.11s | 781808 ko || -0m01.40s || -3016 ko | -5.36% | -0.38% 0m22.81s | 766300 ko | Specific/X25519/C64/feadd | 0m23.43s | 766168 ko || -0m00.62s || 132 ko | -2.64% | +0.01% 0m31.00s | 765208 ko | Specific/NISTP256/AMD64/feopp | 0m32.08s | 765212 ko || -0m01.08s || -4 ko | -3.36% | -0.00% 0m27.81s | 756080 ko | Specific/NISTP256/AMD64/fenz | 0m28.91s | 756216 ko || -0m01.10s || -136 ko | -3.80% | -0.01% 0m49.44s | 744240 ko | Specific/solinas32_2e255m765_13limbs/Synthesis | 0m49.50s | 744472 ko || -0m00.06s || -232 ko | -0.12% | -0.03% 0m40.13s | 728464 ko | Specific/solinas32_2e255m765_12limbs/Synthesis | 0m39.53s | 729464 ko || +0m00.60s || -1000 ko | +1.51% | -0.13% 0m11.15s | 687760 ko | Specific/X25519/C64/Synthesis | 0m11.23s | 687812 ko || -0m00.08s || -52 ko | -0.71% | -0.00% 0m13.45s | 668216 ko | Specific/NISTP256/AMD64/Synthesis | 0m13.74s | 667664 ko || -0m00.29s || 552 ko | -2.11% | +0.08% 0m01.85s | 646300 ko | Specific/Framework/SynthesisFramework | 0m01.95s | 648632 ko || -0m00.10s || -2332 ko | -5.12% | -0.35% 0m07.33s | 574388 ko | Compilers/Z/Bounds/Pipeline/Definition | 0m07.40s | 578344 ko || -0m00.07s || -3956 ko | -0.94% | -0.68% 0m01.93s | 544172 ko | Compilers/Z/Bounds/Pipeline/ReflectiveTactics | 0m01.73s | 546112 ko || +0m00.20s || -1940 ko | +11.56% | -0.35% 0m01.38s | 539808 ko | Compilers/Z/Bounds/Pipeline | 0m01.18s | 539160 ko || +0m00.20s || 648 ko | +16.94% | +0.12% time-of-build-both-real-auto.log.expected000066400000000000000000000076441466560755400365720ustar00rootroot00000000000000coq-8.20.0/test-suite/precomputed-time-tests/correct-diff-sorting-order-mem After | Peak Mem | File Name | Before | Peak Mem || Change || Change (mem) | % Change | % Change (mem) --------------------------------------------------------------------------------------------------------------------------------------------------------- 20m46.07s | 3302508 ko | Total Time / Peak Mem | 23m06.31s | 3307052 ko || -2m20.24s || -4544 ko | -10.11% | -0.13% --------------------------------------------------------------------------------------------------------------------------------------------------------- 2m35.79s | 1454696 ko | Specific/solinas32_2e255m765_12limbs/femul | 2m59.21s | 1549104 ko || -0m23.42s || -94408 ko | -13.06% | -6.09% 3m01.77s | 1589516 ko | Specific/solinas32_2e255m765_13limbs/femul | 3m27.94s | 1656912 ko || -0m26.17s || -67396 ko | -12.58% | -4.06% 0m39.72s | 825448 ko | Specific/X25519/C64/femul | 0m42.98s | 839624 ko || -0m03.26s || -14176 ko | -7.58% | -1.68% 0m43.34s | 793376 ko | Specific/NISTP256/AMD64/fesub | 0m43.78s | 799668 ko || -0m00.44s || -6292 ko | -1.00% | -0.78% 3m22.96s | 3302508 ko | Specific/NISTP256/AMD64/femul | 3m37.80s | 3307052 ko || -0m14.84s || -4544 ko | -6.81% | -0.13% 4m16.77s | 1617000 ko | Specific/X25519/C64/ladderstep | 5m16.83s | 1621500 ko || -1m00.06s || -4500 ko | -18.95% | -0.27% 0m07.33s | 574388 ko | Compilers/Z/Bounds/Pipeline/Definition | 0m07.40s | 578344 ko || -0m00.07s || -3956 ko | -0.94% | -0.68% 0m33.08s | 799620 ko | Specific/X25519/C64/fesquare | 0m35.23s | 802776 ko || -0m02.15s || -3156 ko | -6.10% | -0.39% 0m24.71s | 778792 ko | Specific/X25519/C64/fesub | 0m26.11s | 781808 ko || -0m01.40s || -3016 ko | -5.36% | -0.38% 0m01.85s | 646300 ko | Specific/Framework/SynthesisFramework | 0m01.95s | 648632 ko || -0m00.10s || -2332 ko | -5.12% | -0.35% 0m01.93s | 544172 ko | Compilers/Z/Bounds/Pipeline/ReflectiveTactics | 0m01.73s | 546112 ko || +0m00.20s || -1940 ko | +11.56% | -0.35% 0m34.35s | 828104 ko | Specific/X25519/C64/freeze | 0m36.42s | 826476 ko || -0m02.07s || 1628 ko | -5.68% | +0.19% 0m38.19s | 799216 ko | Specific/NISTP256/AMD64/feadd | 0m40.48s | 797944 ko || -0m02.29s || 1272 ko | -5.65% | +0.15% 0m27.11s | 786052 ko | Specific/X25519/C64/fecarry | 0m28.85s | 787148 ko || -0m01.74s || -1096 ko | -6.03% | -0.13% 0m40.13s | 728464 ko | Specific/solinas32_2e255m765_12limbs/Synthesis | 0m39.53s | 729464 ko || +0m00.60s || -1000 ko | +1.51% | -0.13% 0m01.38s | 539808 ko | Compilers/Z/Bounds/Pipeline | 0m01.18s | 539160 ko || +0m00.20s || 648 ko | +16.94% | +0.12% 0m13.45s | 668216 ko | Specific/NISTP256/AMD64/Synthesis | 0m13.74s | 667664 ko || -0m00.29s || 552 ko | -2.11% | +0.08% 0m49.44s | 744240 ko | Specific/solinas32_2e255m765_13limbs/Synthesis | 0m49.50s | 744472 ko || -0m00.06s || -232 ko | -0.12% | -0.03% 0m27.81s | 756080 ko | Specific/NISTP256/AMD64/fenz | 0m28.91s | 756216 ko || -0m01.10s || -136 ko | -3.80% | -0.01% 0m22.81s | 766300 ko | Specific/X25519/C64/feadd | 0m23.43s | 766168 ko || -0m00.62s || 132 ko | -2.64% | +0.01% 0m11.15s | 687760 ko | Specific/X25519/C64/Synthesis | 0m11.23s | 687812 ko || -0m00.08s || -52 ko | -0.71% | -0.00% 0m31.00s | 765208 ko | Specific/NISTP256/AMD64/feopp | 0m32.08s | 765212 ko || -0m01.08s || -4 ko | -3.36% | -0.00% time-of-build-both-real-diff.log.expected000066400000000000000000000076441466560755400365320ustar00rootroot00000000000000coq-8.20.0/test-suite/precomputed-time-tests/correct-diff-sorting-order-mem After | Peak Mem | File Name | Before | Peak Mem || Change || Change (mem) | % Change | % Change (mem) --------------------------------------------------------------------------------------------------------------------------------------------------------- 20m46.07s | 3302508 ko | Total Time / Peak Mem | 23m06.31s | 3307052 ko || -2m20.24s || -4544 ko | -10.11% | -0.13% --------------------------------------------------------------------------------------------------------------------------------------------------------- 0m34.35s | 828104 ko | Specific/X25519/C64/freeze | 0m36.42s | 826476 ko || -0m02.07s || 1628 ko | -5.68% | +0.19% 0m38.19s | 799216 ko | Specific/NISTP256/AMD64/feadd | 0m40.48s | 797944 ko || -0m02.29s || 1272 ko | -5.65% | +0.15% 0m01.38s | 539808 ko | Compilers/Z/Bounds/Pipeline | 0m01.18s | 539160 ko || +0m00.20s || 648 ko | +16.94% | +0.12% 0m13.45s | 668216 ko | Specific/NISTP256/AMD64/Synthesis | 0m13.74s | 667664 ko || -0m00.29s || 552 ko | -2.11% | +0.08% 0m22.81s | 766300 ko | Specific/X25519/C64/feadd | 0m23.43s | 766168 ko || -0m00.62s || 132 ko | -2.64% | +0.01% 0m31.00s | 765208 ko | Specific/NISTP256/AMD64/feopp | 0m32.08s | 765212 ko || -0m01.08s || -4 ko | -3.36% | -0.00% 0m11.15s | 687760 ko | Specific/X25519/C64/Synthesis | 0m11.23s | 687812 ko || -0m00.08s || -52 ko | -0.71% | -0.00% 0m27.81s | 756080 ko | Specific/NISTP256/AMD64/fenz | 0m28.91s | 756216 ko || -0m01.10s || -136 ko | -3.80% | -0.01% 0m49.44s | 744240 ko | Specific/solinas32_2e255m765_13limbs/Synthesis | 0m49.50s | 744472 ko || -0m00.06s || -232 ko | -0.12% | -0.03% 0m40.13s | 728464 ko | Specific/solinas32_2e255m765_12limbs/Synthesis | 0m39.53s | 729464 ko || +0m00.60s || -1000 ko | +1.51% | -0.13% 0m27.11s | 786052 ko | Specific/X25519/C64/fecarry | 0m28.85s | 787148 ko || -0m01.74s || -1096 ko | -6.03% | -0.13% 0m01.93s | 544172 ko | Compilers/Z/Bounds/Pipeline/ReflectiveTactics | 0m01.73s | 546112 ko || +0m00.20s || -1940 ko | +11.56% | -0.35% 0m01.85s | 646300 ko | Specific/Framework/SynthesisFramework | 0m01.95s | 648632 ko || -0m00.10s || -2332 ko | -5.12% | -0.35% 0m24.71s | 778792 ko | Specific/X25519/C64/fesub | 0m26.11s | 781808 ko || -0m01.40s || -3016 ko | -5.36% | -0.38% 0m33.08s | 799620 ko | Specific/X25519/C64/fesquare | 0m35.23s | 802776 ko || -0m02.15s || -3156 ko | -6.10% | -0.39% 0m07.33s | 574388 ko | Compilers/Z/Bounds/Pipeline/Definition | 0m07.40s | 578344 ko || -0m00.07s || -3956 ko | -0.94% | -0.68% 4m16.77s | 1617000 ko | Specific/X25519/C64/ladderstep | 5m16.83s | 1621500 ko || -1m00.06s || -4500 ko | -18.95% | -0.27% 3m22.96s | 3302508 ko | Specific/NISTP256/AMD64/femul | 3m37.80s | 3307052 ko || -0m14.84s || -4544 ko | -6.81% | -0.13% 0m43.34s | 793376 ko | Specific/NISTP256/AMD64/fesub | 0m43.78s | 799668 ko || -0m00.44s || -6292 ko | -1.00% | -0.78% 0m39.72s | 825448 ko | Specific/X25519/C64/femul | 0m42.98s | 839624 ko || -0m03.26s || -14176 ko | -7.58% | -1.68% 3m01.77s | 1589516 ko | Specific/solinas32_2e255m765_13limbs/femul | 3m27.94s | 1656912 ko || -0m26.17s || -67396 ko | -12.58% | -4.06% 2m35.79s | 1454696 ko | Specific/solinas32_2e255m765_12limbs/femul | 2m59.21s | 1549104 ko || -0m23.42s || -94408 ko | -13.06% | -6.09% time-of-build-both-real.log.expected000066400000000000000000000076441466560755400356240ustar00rootroot00000000000000coq-8.20.0/test-suite/precomputed-time-tests/correct-diff-sorting-order-mem After | Peak Mem | File Name | Before | Peak Mem || Change || Change (mem) | % Change | % Change (mem) --------------------------------------------------------------------------------------------------------------------------------------------------------- 20m46.07s | 3302508 ko | Total Time / Peak Mem | 23m06.31s | 3307052 ko || -2m20.24s || -4544 ko | -10.11% | -0.13% --------------------------------------------------------------------------------------------------------------------------------------------------------- 2m35.79s | 1454696 ko | Specific/solinas32_2e255m765_12limbs/femul | 2m59.21s | 1549104 ko || -0m23.42s || -94408 ko | -13.06% | -6.09% 3m01.77s | 1589516 ko | Specific/solinas32_2e255m765_13limbs/femul | 3m27.94s | 1656912 ko || -0m26.17s || -67396 ko | -12.58% | -4.06% 0m39.72s | 825448 ko | Specific/X25519/C64/femul | 0m42.98s | 839624 ko || -0m03.26s || -14176 ko | -7.58% | -1.68% 0m43.34s | 793376 ko | Specific/NISTP256/AMD64/fesub | 0m43.78s | 799668 ko || -0m00.44s || -6292 ko | -1.00% | -0.78% 3m22.96s | 3302508 ko | Specific/NISTP256/AMD64/femul | 3m37.80s | 3307052 ko || -0m14.84s || -4544 ko | -6.81% | -0.13% 4m16.77s | 1617000 ko | Specific/X25519/C64/ladderstep | 5m16.83s | 1621500 ko || -1m00.06s || -4500 ko | -18.95% | -0.27% 0m07.33s | 574388 ko | Compilers/Z/Bounds/Pipeline/Definition | 0m07.40s | 578344 ko || -0m00.07s || -3956 ko | -0.94% | -0.68% 0m33.08s | 799620 ko | Specific/X25519/C64/fesquare | 0m35.23s | 802776 ko || -0m02.15s || -3156 ko | -6.10% | -0.39% 0m24.71s | 778792 ko | Specific/X25519/C64/fesub | 0m26.11s | 781808 ko || -0m01.40s || -3016 ko | -5.36% | -0.38% 0m01.85s | 646300 ko | Specific/Framework/SynthesisFramework | 0m01.95s | 648632 ko || -0m00.10s || -2332 ko | -5.12% | -0.35% 0m01.93s | 544172 ko | Compilers/Z/Bounds/Pipeline/ReflectiveTactics | 0m01.73s | 546112 ko || +0m00.20s || -1940 ko | +11.56% | -0.35% 0m34.35s | 828104 ko | Specific/X25519/C64/freeze | 0m36.42s | 826476 ko || -0m02.07s || 1628 ko | -5.68% | +0.19% 0m38.19s | 799216 ko | Specific/NISTP256/AMD64/feadd | 0m40.48s | 797944 ko || -0m02.29s || 1272 ko | -5.65% | +0.15% 0m27.11s | 786052 ko | Specific/X25519/C64/fecarry | 0m28.85s | 787148 ko || -0m01.74s || -1096 ko | -6.03% | -0.13% 0m40.13s | 728464 ko | Specific/solinas32_2e255m765_12limbs/Synthesis | 0m39.53s | 729464 ko || +0m00.60s || -1000 ko | +1.51% | -0.13% 0m01.38s | 539808 ko | Compilers/Z/Bounds/Pipeline | 0m01.18s | 539160 ko || +0m00.20s || 648 ko | +16.94% | +0.12% 0m13.45s | 668216 ko | Specific/NISTP256/AMD64/Synthesis | 0m13.74s | 667664 ko || -0m00.29s || 552 ko | -2.11% | +0.08% 0m49.44s | 744240 ko | Specific/solinas32_2e255m765_13limbs/Synthesis | 0m49.50s | 744472 ko || -0m00.06s || -232 ko | -0.12% | -0.03% 0m27.81s | 756080 ko | Specific/NISTP256/AMD64/fenz | 0m28.91s | 756216 ko || -0m01.10s || -136 ko | -3.80% | -0.01% 0m22.81s | 766300 ko | Specific/X25519/C64/feadd | 0m23.43s | 766168 ko || -0m00.62s || 132 ko | -2.64% | +0.01% 0m11.15s | 687760 ko | Specific/X25519/C64/Synthesis | 0m11.23s | 687812 ko || -0m00.08s || -52 ko | -0.71% | -0.00% 0m31.00s | 765208 ko | Specific/NISTP256/AMD64/feopp | 0m32.08s | 765212 ko || -0m01.08s || -4 ko | -3.36% | -0.00% time-of-build-both-user-absolute.log.expected000066400000000000000000000076441466560755400374730ustar00rootroot00000000000000coq-8.20.0/test-suite/precomputed-time-tests/correct-diff-sorting-order-mem After | Peak Mem | File Name | Before | Peak Mem || Change || Change (mem) | % Change | % Change (mem) --------------------------------------------------------------------------------------------------------------------------------------------------------- 19m16.05s | 3302508 ko | Total Time / Peak Mem | 21m25.28s | 3307052 ko || -2m09.23s || -4544 ko | -10.05% | -0.13% --------------------------------------------------------------------------------------------------------------------------------------------------------- 3m09.62s | 3302508 ko | Specific/NISTP256/AMD64/femul | 3m22.52s | 3307052 ko || -0m12.90s || -4544 ko | -6.36% | -0.13% 4m01.34s | 1617000 ko | Specific/X25519/C64/ladderstep | 4m59.49s | 1621500 ko || -0m58.15s || -4500 ko | -19.41% | -0.27% 2m48.52s | 1589516 ko | Specific/solinas32_2e255m765_13limbs/femul | 3m12.95s | 1656912 ko || -0m24.43s || -67396 ko | -12.66% | -4.06% 2m23.70s | 1454696 ko | Specific/solinas32_2e255m765_12limbs/femul | 2m44.11s | 1549104 ko || -0m20.41s || -94408 ko | -12.43% | -6.09% 0m31.50s | 828104 ko | Specific/X25519/C64/freeze | 0m33.24s | 826476 ko || -0m01.74s || 1628 ko | -5.23% | +0.19% 0m36.32s | 825448 ko | Specific/X25519/C64/femul | 0m39.50s | 839624 ko || -0m03.18s || -14176 ko | -8.05% | -1.68% 0m30.13s | 799620 ko | Specific/X25519/C64/fesquare | 0m32.24s | 802776 ko || -0m02.11s || -3156 ko | -6.54% | -0.39% 0m35.40s | 799216 ko | Specific/NISTP256/AMD64/feadd | 0m37.21s | 797944 ko || -0m01.81s || 1272 ko | -4.86% | +0.15% 0m39.59s | 793376 ko | Specific/NISTP256/AMD64/fesub | 0m40.09s | 799668 ko || -0m00.50s || -6292 ko | -1.24% | -0.78% 0m24.99s | 786052 ko | Specific/X25519/C64/fecarry | 0m26.31s | 787148 ko || -0m01.32s || -1096 ko | -5.01% | -0.13% 0m22.65s | 778792 ko | Specific/X25519/C64/fesub | 0m23.72s | 781808 ko || -0m01.07s || -3016 ko | -4.51% | -0.38% 0m20.93s | 766300 ko | Specific/X25519/C64/feadd | 0m21.41s | 766168 ko || -0m00.48s || 132 ko | -2.24% | +0.01% 0m28.51s | 765208 ko | Specific/NISTP256/AMD64/feopp | 0m29.46s | 765212 ko || -0m00.95s || -4 ko | -3.22% | -0.00% 0m25.50s | 756080 ko | Specific/NISTP256/AMD64/fenz | 0m26.41s | 756216 ko || -0m00.91s || -136 ko | -3.44% | -0.01% 0m45.75s | 744240 ko | Specific/solinas32_2e255m765_13limbs/Synthesis | 0m45.58s | 744472 ko || +0m00.17s || -232 ko | +0.37% | -0.03% 0m36.92s | 728464 ko | Specific/solinas32_2e255m765_12limbs/Synthesis | 0m36.64s | 729464 ko || +0m00.28s || -1000 ko | +0.76% | -0.13% 0m10.37s | 687760 ko | Specific/X25519/C64/Synthesis | 0m10.30s | 687812 ko || +0m00.07s || -52 ko | +0.67% | -0.00% 0m12.55s | 668216 ko | Specific/NISTP256/AMD64/Synthesis | 0m12.54s | 667664 ko || +0m00.01s || 552 ko | +0.07% | +0.08% 0m01.67s | 646300 ko | Specific/Framework/SynthesisFramework | 0m01.72s | 648632 ko || -0m00.05s || -2332 ko | -2.90% | -0.35% 0m07.18s | 574388 ko | Compilers/Z/Bounds/Pipeline/Definition | 0m07.22s | 578344 ko || -0m00.04s || -3956 ko | -0.55% | -0.68% 0m01.72s | 544172 ko | Compilers/Z/Bounds/Pipeline/ReflectiveTactics | 0m01.58s | 546112 ko || +0m00.14s || -1940 ko | +8.86% | -0.35% 0m01.19s | 539808 ko | Compilers/Z/Bounds/Pipeline | 0m01.04s | 539160 ko || +0m00.15s || 648 ko | +14.42% | +0.12% time-of-build-both-user-auto.log.expected000066400000000000000000000076441466560755400366250ustar00rootroot00000000000000coq-8.20.0/test-suite/precomputed-time-tests/correct-diff-sorting-order-mem After | Peak Mem | File Name | Before | Peak Mem || Change || Change (mem) | % Change | % Change (mem) --------------------------------------------------------------------------------------------------------------------------------------------------------- 19m16.05s | 3302508 ko | Total Time / Peak Mem | 21m25.28s | 3307052 ko || -2m09.23s || -4544 ko | -10.05% | -0.13% --------------------------------------------------------------------------------------------------------------------------------------------------------- 2m23.70s | 1454696 ko | Specific/solinas32_2e255m765_12limbs/femul | 2m44.11s | 1549104 ko || -0m20.41s || -94408 ko | -12.43% | -6.09% 2m48.52s | 1589516 ko | Specific/solinas32_2e255m765_13limbs/femul | 3m12.95s | 1656912 ko || -0m24.43s || -67396 ko | -12.66% | -4.06% 0m36.32s | 825448 ko | Specific/X25519/C64/femul | 0m39.50s | 839624 ko || -0m03.18s || -14176 ko | -8.05% | -1.68% 0m39.59s | 793376 ko | Specific/NISTP256/AMD64/fesub | 0m40.09s | 799668 ko || -0m00.50s || -6292 ko | -1.24% | -0.78% 3m09.62s | 3302508 ko | Specific/NISTP256/AMD64/femul | 3m22.52s | 3307052 ko || -0m12.90s || -4544 ko | -6.36% | -0.13% 4m01.34s | 1617000 ko | Specific/X25519/C64/ladderstep | 4m59.49s | 1621500 ko || -0m58.15s || -4500 ko | -19.41% | -0.27% 0m07.18s | 574388 ko | Compilers/Z/Bounds/Pipeline/Definition | 0m07.22s | 578344 ko || -0m00.04s || -3956 ko | -0.55% | -0.68% 0m30.13s | 799620 ko | Specific/X25519/C64/fesquare | 0m32.24s | 802776 ko || -0m02.11s || -3156 ko | -6.54% | -0.39% 0m22.65s | 778792 ko | Specific/X25519/C64/fesub | 0m23.72s | 781808 ko || -0m01.07s || -3016 ko | -4.51% | -0.38% 0m01.67s | 646300 ko | Specific/Framework/SynthesisFramework | 0m01.72s | 648632 ko || -0m00.05s || -2332 ko | -2.90% | -0.35% 0m01.72s | 544172 ko | Compilers/Z/Bounds/Pipeline/ReflectiveTactics | 0m01.58s | 546112 ko || +0m00.14s || -1940 ko | +8.86% | -0.35% 0m31.50s | 828104 ko | Specific/X25519/C64/freeze | 0m33.24s | 826476 ko || -0m01.74s || 1628 ko | -5.23% | +0.19% 0m35.40s | 799216 ko | Specific/NISTP256/AMD64/feadd | 0m37.21s | 797944 ko || -0m01.81s || 1272 ko | -4.86% | +0.15% 0m24.99s | 786052 ko | Specific/X25519/C64/fecarry | 0m26.31s | 787148 ko || -0m01.32s || -1096 ko | -5.01% | -0.13% 0m36.92s | 728464 ko | Specific/solinas32_2e255m765_12limbs/Synthesis | 0m36.64s | 729464 ko || +0m00.28s || -1000 ko | +0.76% | -0.13% 0m01.19s | 539808 ko | Compilers/Z/Bounds/Pipeline | 0m01.04s | 539160 ko || +0m00.15s || 648 ko | +14.42% | +0.12% 0m12.55s | 668216 ko | Specific/NISTP256/AMD64/Synthesis | 0m12.54s | 667664 ko || +0m00.01s || 552 ko | +0.07% | +0.08% 0m45.75s | 744240 ko | Specific/solinas32_2e255m765_13limbs/Synthesis | 0m45.58s | 744472 ko || +0m00.17s || -232 ko | +0.37% | -0.03% 0m25.50s | 756080 ko | Specific/NISTP256/AMD64/fenz | 0m26.41s | 756216 ko || -0m00.91s || -136 ko | -3.44% | -0.01% 0m20.93s | 766300 ko | Specific/X25519/C64/feadd | 0m21.41s | 766168 ko || -0m00.48s || 132 ko | -2.24% | +0.01% 0m10.37s | 687760 ko | Specific/X25519/C64/Synthesis | 0m10.30s | 687812 ko || +0m00.07s || -52 ko | +0.67% | -0.00% 0m28.51s | 765208 ko | Specific/NISTP256/AMD64/feopp | 0m29.46s | 765212 ko || -0m00.95s || -4 ko | -3.22% | -0.00% time-of-build-both-user-diff.log.expected000066400000000000000000000076441466560755400365650ustar00rootroot00000000000000coq-8.20.0/test-suite/precomputed-time-tests/correct-diff-sorting-order-mem After | Peak Mem | File Name | Before | Peak Mem || Change || Change (mem) | % Change | % Change (mem) --------------------------------------------------------------------------------------------------------------------------------------------------------- 19m16.05s | 3302508 ko | Total Time / Peak Mem | 21m25.28s | 3307052 ko || -2m09.23s || -4544 ko | -10.05% | -0.13% --------------------------------------------------------------------------------------------------------------------------------------------------------- 0m31.50s | 828104 ko | Specific/X25519/C64/freeze | 0m33.24s | 826476 ko || -0m01.74s || 1628 ko | -5.23% | +0.19% 0m35.40s | 799216 ko | Specific/NISTP256/AMD64/feadd | 0m37.21s | 797944 ko || -0m01.81s || 1272 ko | -4.86% | +0.15% 0m01.19s | 539808 ko | Compilers/Z/Bounds/Pipeline | 0m01.04s | 539160 ko || +0m00.15s || 648 ko | +14.42% | +0.12% 0m12.55s | 668216 ko | Specific/NISTP256/AMD64/Synthesis | 0m12.54s | 667664 ko || +0m00.01s || 552 ko | +0.07% | +0.08% 0m20.93s | 766300 ko | Specific/X25519/C64/feadd | 0m21.41s | 766168 ko || -0m00.48s || 132 ko | -2.24% | +0.01% 0m28.51s | 765208 ko | Specific/NISTP256/AMD64/feopp | 0m29.46s | 765212 ko || -0m00.95s || -4 ko | -3.22% | -0.00% 0m10.37s | 687760 ko | Specific/X25519/C64/Synthesis | 0m10.30s | 687812 ko || +0m00.07s || -52 ko | +0.67% | -0.00% 0m25.50s | 756080 ko | Specific/NISTP256/AMD64/fenz | 0m26.41s | 756216 ko || -0m00.91s || -136 ko | -3.44% | -0.01% 0m45.75s | 744240 ko | Specific/solinas32_2e255m765_13limbs/Synthesis | 0m45.58s | 744472 ko || +0m00.17s || -232 ko | +0.37% | -0.03% 0m36.92s | 728464 ko | Specific/solinas32_2e255m765_12limbs/Synthesis | 0m36.64s | 729464 ko || +0m00.28s || -1000 ko | +0.76% | -0.13% 0m24.99s | 786052 ko | Specific/X25519/C64/fecarry | 0m26.31s | 787148 ko || -0m01.32s || -1096 ko | -5.01% | -0.13% 0m01.72s | 544172 ko | Compilers/Z/Bounds/Pipeline/ReflectiveTactics | 0m01.58s | 546112 ko || +0m00.14s || -1940 ko | +8.86% | -0.35% 0m01.67s | 646300 ko | Specific/Framework/SynthesisFramework | 0m01.72s | 648632 ko || -0m00.05s || -2332 ko | -2.90% | -0.35% 0m22.65s | 778792 ko | Specific/X25519/C64/fesub | 0m23.72s | 781808 ko || -0m01.07s || -3016 ko | -4.51% | -0.38% 0m30.13s | 799620 ko | Specific/X25519/C64/fesquare | 0m32.24s | 802776 ko || -0m02.11s || -3156 ko | -6.54% | -0.39% 0m07.18s | 574388 ko | Compilers/Z/Bounds/Pipeline/Definition | 0m07.22s | 578344 ko || -0m00.04s || -3956 ko | -0.55% | -0.68% 4m01.34s | 1617000 ko | Specific/X25519/C64/ladderstep | 4m59.49s | 1621500 ko || -0m58.15s || -4500 ko | -19.41% | -0.27% 3m09.62s | 3302508 ko | Specific/NISTP256/AMD64/femul | 3m22.52s | 3307052 ko || -0m12.90s || -4544 ko | -6.36% | -0.13% 0m39.59s | 793376 ko | Specific/NISTP256/AMD64/fesub | 0m40.09s | 799668 ko || -0m00.50s || -6292 ko | -1.24% | -0.78% 0m36.32s | 825448 ko | Specific/X25519/C64/femul | 0m39.50s | 839624 ko || -0m03.18s || -14176 ko | -8.05% | -1.68% 2m48.52s | 1589516 ko | Specific/solinas32_2e255m765_13limbs/femul | 3m12.95s | 1656912 ko || -0m24.43s || -67396 ko | -12.66% | -4.06% 2m23.70s | 1454696 ko | Specific/solinas32_2e255m765_12limbs/femul | 2m44.11s | 1549104 ko || -0m20.41s || -94408 ko | -12.43% | -6.09% time-of-build-both-user.log.expected000066400000000000000000000076441466560755400356570ustar00rootroot00000000000000coq-8.20.0/test-suite/precomputed-time-tests/correct-diff-sorting-order-mem After | Peak Mem | File Name | Before | Peak Mem || Change || Change (mem) | % Change | % Change (mem) --------------------------------------------------------------------------------------------------------------------------------------------------------- 19m16.05s | 3302508 ko | Total Time / Peak Mem | 21m25.28s | 3307052 ko || -2m09.23s || -4544 ko | -10.05% | -0.13% --------------------------------------------------------------------------------------------------------------------------------------------------------- 2m23.70s | 1454696 ko | Specific/solinas32_2e255m765_12limbs/femul | 2m44.11s | 1549104 ko || -0m20.41s || -94408 ko | -12.43% | -6.09% 2m48.52s | 1589516 ko | Specific/solinas32_2e255m765_13limbs/femul | 3m12.95s | 1656912 ko || -0m24.43s || -67396 ko | -12.66% | -4.06% 0m36.32s | 825448 ko | Specific/X25519/C64/femul | 0m39.50s | 839624 ko || -0m03.18s || -14176 ko | -8.05% | -1.68% 0m39.59s | 793376 ko | Specific/NISTP256/AMD64/fesub | 0m40.09s | 799668 ko || -0m00.50s || -6292 ko | -1.24% | -0.78% 3m09.62s | 3302508 ko | Specific/NISTP256/AMD64/femul | 3m22.52s | 3307052 ko || -0m12.90s || -4544 ko | -6.36% | -0.13% 4m01.34s | 1617000 ko | Specific/X25519/C64/ladderstep | 4m59.49s | 1621500 ko || -0m58.15s || -4500 ko | -19.41% | -0.27% 0m07.18s | 574388 ko | Compilers/Z/Bounds/Pipeline/Definition | 0m07.22s | 578344 ko || -0m00.04s || -3956 ko | -0.55% | -0.68% 0m30.13s | 799620 ko | Specific/X25519/C64/fesquare | 0m32.24s | 802776 ko || -0m02.11s || -3156 ko | -6.54% | -0.39% 0m22.65s | 778792 ko | Specific/X25519/C64/fesub | 0m23.72s | 781808 ko || -0m01.07s || -3016 ko | -4.51% | -0.38% 0m01.67s | 646300 ko | Specific/Framework/SynthesisFramework | 0m01.72s | 648632 ko || -0m00.05s || -2332 ko | -2.90% | -0.35% 0m01.72s | 544172 ko | Compilers/Z/Bounds/Pipeline/ReflectiveTactics | 0m01.58s | 546112 ko || +0m00.14s || -1940 ko | +8.86% | -0.35% 0m31.50s | 828104 ko | Specific/X25519/C64/freeze | 0m33.24s | 826476 ko || -0m01.74s || 1628 ko | -5.23% | +0.19% 0m35.40s | 799216 ko | Specific/NISTP256/AMD64/feadd | 0m37.21s | 797944 ko || -0m01.81s || 1272 ko | -4.86% | +0.15% 0m24.99s | 786052 ko | Specific/X25519/C64/fecarry | 0m26.31s | 787148 ko || -0m01.32s || -1096 ko | -5.01% | -0.13% 0m36.92s | 728464 ko | Specific/solinas32_2e255m765_12limbs/Synthesis | 0m36.64s | 729464 ko || +0m00.28s || -1000 ko | +0.76% | -0.13% 0m01.19s | 539808 ko | Compilers/Z/Bounds/Pipeline | 0m01.04s | 539160 ko || +0m00.15s || 648 ko | +14.42% | +0.12% 0m12.55s | 668216 ko | Specific/NISTP256/AMD64/Synthesis | 0m12.54s | 667664 ko || +0m00.01s || 552 ko | +0.07% | +0.08% 0m45.75s | 744240 ko | Specific/solinas32_2e255m765_13limbs/Synthesis | 0m45.58s | 744472 ko || +0m00.17s || -232 ko | +0.37% | -0.03% 0m25.50s | 756080 ko | Specific/NISTP256/AMD64/fenz | 0m26.41s | 756216 ko || -0m00.91s || -136 ko | -3.44% | -0.01% 0m20.93s | 766300 ko | Specific/X25519/C64/feadd | 0m21.41s | 766168 ko || -0m00.48s || 132 ko | -2.24% | +0.01% 0m10.37s | 687760 ko | Specific/X25519/C64/Synthesis | 0m10.30s | 687812 ko || +0m00.07s || -52 ko | +0.67% | -0.00% 0m28.51s | 765208 ko | Specific/NISTP256/AMD64/feopp | 0m29.46s | 765212 ko || -0m00.95s || -4 ko | -3.22% | -0.00% coq-8.20.0/test-suite/precomputed-time-tests/correct-diff-sorting-order/000077500000000000000000000000001466560755400263015ustar00rootroot00000000000000coq-8.20.0/test-suite/precomputed-time-tests/correct-diff-sorting-order/run.sh000077500000000000000000000020231466560755400274410ustar00rootroot00000000000000#!/usr/bin/env bash . ../template/init.sh cd "$(dirname "${BASH_SOURCE[0]}")" $make_both_time_files time-of-build-after.log.in time-of-build-before.log.in time-of-build-both-user.log diff -u time-of-build-both-user.log.expected time-of-build-both-user.log || exit $? $make_both_time_files --real time-of-build-after.log.in time-of-build-before.log.in time-of-build-both-real.log diff -u time-of-build-both-real.log.expected time-of-build-both-real.log || exit $? for sort_kind in auto absolute diff; do $make_both_time_files time-of-build-after.log.in time-of-build-before.log.in time-of-build-both-user-${sort_kind}.log --sort-by=${sort_kind} diff -u time-of-build-both-user-${sort_kind}.log.expected time-of-build-both-user-${sort_kind}.log || exit $? $make_both_time_files --real time-of-build-after.log.in time-of-build-before.log.in time-of-build-both-real-${sort_kind}.log --sort-by=${sort_kind} diff -u time-of-build-both-real-${sort_kind}.log.expected time-of-build-both-real-${sort_kind}.log || exit $? done coq-8.20.0/test-suite/precomputed-time-tests/correct-diff-sorting-order/time-of-build-after.log.in000066400000000000000000004047131466560755400331560ustar00rootroot00000000000000COQDEP src/Compilers/Z/Bounds/Pipeline/ReflectiveTactics.v COQDEP src/Compilers/Z/Bounds/Pipeline/Definition.v /home/jgross/.local64/coq/coq-master/bin/coq_makefile -f _CoqProject INSTALLDEFAULTROOT = Crypto -o Makefile-old COQ_MAKEFILE -f _CoqProject > Makefile.coq make --no-print-directory -C coqprime make[1]: Nothing to be done for 'all'. ECHO > _CoqProject COQC src/Compilers/Z/Bounds/Pipeline/Definition.v src/Compilers/Z/Bounds/Pipeline/Definition (real: 7.33, user: 7.18, sys: 0.14, mem: 574388 ko) COQC src/Compilers/Z/Bounds/Pipeline/ReflectiveTactics.v src/Compilers/Z/Bounds/Pipeline/ReflectiveTactics (real: 1.93, user: 1.72, sys: 0.20, mem: 544172 ko) COQC src/Compilers/Z/Bounds/Pipeline.v src/Compilers/Z/Bounds/Pipeline (real: 1.38, user: 1.19, sys: 0.16, mem: 539808 ko) COQC src/Specific/Framework/SynthesisFramework.v src/Specific/Framework/SynthesisFramework (real: 1.85, user: 1.67, sys: 0.17, mem: 646300 ko) COQC src/Specific/X25519/C64/Synthesis.v src/Specific/X25519/C64/Synthesis (real: 11.15, user: 10.37, sys: 0.18, mem: 687760 ko) COQC src/Specific/NISTP256/AMD64/Synthesis.v src/Specific/NISTP256/AMD64/Synthesis (real: 13.45, user: 12.55, sys: 0.19, mem: 668216 ko) COQC src/Specific/X25519/C64/feadd.v Finished transaction in 2.814 secs (2.624u,0.s) (successful) total time: 2.576s tactic local total calls max ────────────────────────────────────────┴──────┴──────┴───────┴─────────┘ ─Pipeline.refine_reflectively_gen ------ 0.2% 97.4% 1 2.508s ─ReflectiveTactics.do_reflective_pipelin 0.0% 66.9% 1 1.724s ─ReflectiveTactics.solve_side_conditions 0.0% 65.5% 1 1.688s ─ReflectiveTactics.solve_post_reified_si 1.2% 37.0% 1 0.952s ─Glue.refine_to_reflective_glue' ------- 0.0% 30.3% 1 0.780s ─ReflectiveTactics.do_reify ------------ 0.0% 28.6% 1 0.736s ─Reify.Reify_rhs_gen ------------------- 2.2% 26.6% 1 0.684s ─UnifyAbstractReflexivity.unify_transfor 20.3% 24.1% 7 0.164s ─Glue.zrange_to_reflective ------------- 0.0% 20.3% 1 0.524s ─Glue.zrange_to_reflective_goal -------- 9.5% 15.2% 1 0.392s ─Reify.do_reify_abs_goal --------------- 13.7% 13.8% 2 0.356s ─Reify.do_reifyf_goal ------------------ 12.4% 12.6% 16 0.324s ─ReflectiveTactics.unify_abstract_cbv_in 8.4% 11.2% 1 0.288s ─unify (constr) (constr) --------------- 5.7% 5.7% 6 0.072s ─Glue.pattern_sig_sig_assoc ------------ 0.0% 5.4% 1 0.140s ─assert (H : is_bounded_by' bounds (map' 4.8% 5.1% 2 0.072s ─Glue.pattern_proj1_sig_in_sig --------- 1.7% 5.1% 1 0.132s ─pose proof (pf : Interpretation.Bo 3.7% 3.7% 1 0.096s ─Glue.split_BoundedWordToZ ------------- 0.3% 3.7% 1 0.096s ─destruct_sig -------------------------- 0.2% 3.3% 4 0.044s ─destruct x ---------------------------- 3.1% 3.1% 4 0.036s ─eexact -------------------------------- 3.0% 3.0% 18 0.008s ─clearbody (ne_var_list) --------------- 3.0% 3.0% 4 0.060s ─prove_interp_compile_correct ---------- 0.0% 2.8% 1 0.072s ─synthesize ---------------------------- 0.0% 2.6% 1 0.068s ─rewrite ?EtaInterp.InterpExprEta ------ 2.5% 2.5% 1 0.064s ─ClearbodyAll.clearbody_all ------------ 0.0% 2.3% 2 0.060s ─rewrite H ----------------------------- 2.2% 2.2% 1 0.056s ─reflexivity --------------------------- 2.2% 2.2% 7 0.032s ─Reify.transitivity_tt ----------------- 0.0% 2.2% 2 0.032s ─transitivity -------------------------- 2.0% 2.0% 5 0.024s tactic local total calls max ────────────────────────────────────────┴──────┴──────┴───────┴─────────┘ ─Pipeline.refine_reflectively_gen ------ 0.2% 97.4% 1 2.508s ├─ReflectiveTactics.do_reflective_pipel 0.0% 66.9% 1 1.724s │└ReflectiveTactics.solve_side_conditio 0.0% 65.5% 1 1.688s │ ├─ReflectiveTactics.solve_post_reifie 1.2% 37.0% 1 0.952s │ │ ├─UnifyAbstractReflexivity.unify_tr 20.3% 24.1% 7 0.164s │ │ │└unify (constr) (constr) --------- 3.0% 3.0% 5 0.028s │ │ └─ReflectiveTactics.unify_abstract_ 8.4% 11.2% 1 0.288s │ │ └unify (constr) (constr) --------- 2.8% 2.8% 1 0.072s │ └─ReflectiveTactics.do_reify -------- 0.0% 28.6% 1 0.736s │ └Reify.Reify_rhs_gen --------------- 2.2% 26.6% 1 0.684s │ ├─Reify.do_reify_abs_goal --------- 13.7% 13.8% 2 0.356s │ │└Reify.do_reifyf_goal ------------ 12.4% 12.6% 16 0.324s │ │└eexact -------------------------- 2.6% 2.6% 16 0.008s │ ├─prove_interp_compile_correct ---- 0.0% 2.8% 1 0.072s │ │└rewrite ?EtaInterp.InterpExprEta 2.5% 2.5% 1 0.064s │ ├─rewrite H ----------------------- 2.2% 2.2% 1 0.056s │ └─Reify.transitivity_tt ----------- 0.0% 2.2% 2 0.032s └─Glue.refine_to_reflective_glue' ----- 0.0% 30.3% 1 0.780s ├─Glue.zrange_to_reflective --------- 0.0% 20.3% 1 0.524s │ ├─Glue.zrange_to_reflective_goal -- 9.5% 15.2% 1 0.392s │ │└pose proof (pf : Interpretat 3.7% 3.7% 1 0.096s │ └─assert (H : is_bounded_by' bounds 4.8% 5.1% 2 0.072s ├─Glue.pattern_sig_sig_assoc -------- 0.0% 5.4% 1 0.140s │└Glue.pattern_proj1_sig_in_sig ----- 1.7% 5.1% 1 0.132s │└ClearbodyAll.clearbody_all -------- 0.0% 2.3% 2 0.060s │└clearbody (ne_var_list) ----------- 2.3% 2.3% 1 0.060s └─Glue.split_BoundedWordToZ --------- 0.3% 3.7% 1 0.096s └destruct_sig ---------------------- 0.2% 3.3% 4 0.044s └destruct x ------------------------ 2.5% 2.5% 2 0.036s ─synthesize ---------------------------- 0.0% 2.6% 1 0.068s Finished transaction in 5.021 secs (4.636u,0.s) (successful) Closed under the global context total time: 2.576s tactic local total calls max ────────────────────────────────────────┴──────┴──────┴───────┴─────────┘ ─Pipeline.refine_reflectively_gen ------ 0.2% 97.4% 1 2.508s ─ReflectiveTactics.do_reflective_pipelin 0.0% 66.9% 1 1.724s ─ReflectiveTactics.solve_side_conditions 0.0% 65.5% 1 1.688s ─ReflectiveTactics.solve_post_reified_si 1.2% 37.0% 1 0.952s ─Glue.refine_to_reflective_glue' ------- 0.0% 30.3% 1 0.780s ─ReflectiveTactics.do_reify ------------ 0.0% 28.6% 1 0.736s ─Reify.Reify_rhs_gen ------------------- 2.2% 26.6% 1 0.684s ─UnifyAbstractReflexivity.unify_transfor 20.3% 24.1% 7 0.164s ─Glue.zrange_to_reflective ------------- 0.0% 20.3% 1 0.524s ─Glue.zrange_to_reflective_goal -------- 9.5% 15.2% 1 0.392s ─Reify.do_reify_abs_goal --------------- 13.7% 13.8% 2 0.356s ─Reify.do_reifyf_goal ------------------ 12.4% 12.6% 16 0.324s ─ReflectiveTactics.unify_abstract_cbv_in 8.4% 11.2% 1 0.288s ─unify (constr) (constr) --------------- 5.7% 5.7% 6 0.072s ─Glue.pattern_sig_sig_assoc ------------ 0.0% 5.4% 1 0.140s ─assert (H : is_bounded_by' bounds (map' 4.8% 5.1% 2 0.072s ─Glue.pattern_proj1_sig_in_sig --------- 1.7% 5.1% 1 0.132s ─pose proof (pf : Interpretation.Bo 3.7% 3.7% 1 0.096s ─Glue.split_BoundedWordToZ ------------- 0.3% 3.7% 1 0.096s ─destruct_sig -------------------------- 0.2% 3.3% 4 0.044s ─destruct x ---------------------------- 3.1% 3.1% 4 0.036s ─eexact -------------------------------- 3.0% 3.0% 18 0.008s ─clearbody (ne_var_list) --------------- 3.0% 3.0% 4 0.060s ─prove_interp_compile_correct ---------- 0.0% 2.8% 1 0.072s ─synthesize ---------------------------- 0.0% 2.6% 1 0.068s ─rewrite ?EtaInterp.InterpExprEta ------ 2.5% 2.5% 1 0.064s ─ClearbodyAll.clearbody_all ------------ 0.0% 2.3% 2 0.060s ─rewrite H ----------------------------- 2.2% 2.2% 1 0.056s ─reflexivity --------------------------- 2.2% 2.2% 7 0.032s ─Reify.transitivity_tt ----------------- 0.0% 2.2% 2 0.032s ─transitivity -------------------------- 2.0% 2.0% 5 0.024s tactic local total calls max ────────────────────────────────────────┴──────┴──────┴───────┴─────────┘ ─Pipeline.refine_reflectively_gen ------ 0.2% 97.4% 1 2.508s ├─ReflectiveTactics.do_reflective_pipel 0.0% 66.9% 1 1.724s │└ReflectiveTactics.solve_side_conditio 0.0% 65.5% 1 1.688s │ ├─ReflectiveTactics.solve_post_reifie 1.2% 37.0% 1 0.952s │ │ ├─UnifyAbstractReflexivity.unify_tr 20.3% 24.1% 7 0.164s │ │ │└unify (constr) (constr) --------- 3.0% 3.0% 5 0.028s │ │ └─ReflectiveTactics.unify_abstract_ 8.4% 11.2% 1 0.288s │ │ └unify (constr) (constr) --------- 2.8% 2.8% 1 0.072s │ └─ReflectiveTactics.do_reify -------- 0.0% 28.6% 1 0.736s │ └Reify.Reify_rhs_gen --------------- 2.2% 26.6% 1 0.684s │ ├─Reify.do_reify_abs_goal --------- 13.7% 13.8% 2 0.356s │ │└Reify.do_reifyf_goal ------------ 12.4% 12.6% 16 0.324s │ │└eexact -------------------------- 2.6% 2.6% 16 0.008s │ ├─prove_interp_compile_correct ---- 0.0% 2.8% 1 0.072s │ │└rewrite ?EtaInterp.InterpExprEta 2.5% 2.5% 1 0.064s │ ├─rewrite H ----------------------- 2.2% 2.2% 1 0.056s │ └─Reify.transitivity_tt ----------- 0.0% 2.2% 2 0.032s └─Glue.refine_to_reflective_glue' ----- 0.0% 30.3% 1 0.780s ├─Glue.zrange_to_reflective --------- 0.0% 20.3% 1 0.524s │ ├─Glue.zrange_to_reflective_goal -- 9.5% 15.2% 1 0.392s │ │└pose proof (pf : Interpretat 3.7% 3.7% 1 0.096s │ └─assert (H : is_bounded_by' bounds 4.8% 5.1% 2 0.072s ├─Glue.pattern_sig_sig_assoc -------- 0.0% 5.4% 1 0.140s │└Glue.pattern_proj1_sig_in_sig ----- 1.7% 5.1% 1 0.132s │└ClearbodyAll.clearbody_all -------- 0.0% 2.3% 2 0.060s │└clearbody (ne_var_list) ----------- 2.3% 2.3% 1 0.060s └─Glue.split_BoundedWordToZ --------- 0.3% 3.7% 1 0.096s └destruct_sig ---------------------- 0.2% 3.3% 4 0.044s └destruct x ------------------------ 2.5% 2.5% 2 0.036s ─synthesize ---------------------------- 0.0% 2.6% 1 0.068s src/Specific/X25519/C64/feadd (real: 22.81, user: 20.93, sys: 0.25, mem: 766300 ko) COQC src/Specific/X25519/C64/fecarry.v Finished transaction in 4.343 secs (4.016u,0.004s) (successful) total time: 3.976s tactic local total calls max ────────────────────────────────────────┴──────┴──────┴───────┴─────────┘ ─Pipeline.refine_reflectively_gen ------ 0.0% 99.0% 1 3.936s ─ReflectiveTactics.do_reflective_pipelin 0.0% 87.9% 1 3.496s ─ReflectiveTactics.solve_side_conditions 0.0% 86.9% 1 3.456s ─ReflectiveTactics.do_reify ------------ 0.0% 56.9% 1 2.264s ─Reify.Reify_rhs_gen ------------------- 1.8% 56.2% 1 2.236s ─Reify.do_reify_abs_goal --------------- 36.1% 36.5% 2 1.452s ─Reify.do_reifyf_goal ------------------ 34.8% 35.1% 29 1.396s ─ReflectiveTactics.solve_post_reified_si 0.6% 30.0% 1 1.192s ─UnifyAbstractReflexivity.unify_transfor 17.7% 21.7% 7 0.240s ─Glue.refine_to_reflective_glue' ------- 0.0% 11.1% 1 0.440s ─eexact -------------------------------- 10.9% 10.9% 31 0.024s ─ReflectiveTactics.unify_abstract_cbv_in 5.2% 7.3% 1 0.292s ─Glue.zrange_to_reflective ------------- 0.0% 7.1% 1 0.284s ─prove_interp_compile_correct ---------- 0.0% 5.7% 1 0.228s ─Glue.zrange_to_reflective_goal -------- 4.3% 5.5% 1 0.220s ─unify (constr) (constr) --------------- 5.3% 5.3% 6 0.084s ─rewrite ?EtaInterp.InterpExprEta ------ 5.2% 5.2% 1 0.208s ─rewrite H ----------------------------- 3.5% 3.5% 1 0.140s ─tac ----------------------------------- 1.9% 2.6% 2 0.104s ─reflexivity --------------------------- 2.2% 2.2% 7 0.028s ─Reify.transitivity_tt ----------------- 0.0% 2.2% 2 0.056s ─transitivity -------------------------- 2.0% 2.0% 5 0.048s ─Glue.split_BoundedWordToZ ------------- 0.1% 2.0% 1 0.080s tactic local total calls max ────────────────────────────────────────┴──────┴──────┴───────┴─────────┘ ─Pipeline.refine_reflectively_gen ------ 0.0% 99.0% 1 3.936s ├─ReflectiveTactics.do_reflective_pipel 0.0% 87.9% 1 3.496s │└ReflectiveTactics.solve_side_conditio 0.0% 86.9% 1 3.456s │ ├─ReflectiveTactics.do_reify -------- 0.0% 56.9% 1 2.264s │ │└Reify.Reify_rhs_gen --------------- 1.8% 56.2% 1 2.236s │ │ ├─Reify.do_reify_abs_goal --------- 36.1% 36.5% 2 1.452s │ │ │└Reify.do_reifyf_goal ------------ 34.8% 35.1% 29 1.396s │ │ │└eexact -------------------------- 10.1% 10.1% 29 0.024s │ │ ├─prove_interp_compile_correct ---- 0.0% 5.7% 1 0.228s │ │ │└rewrite ?EtaInterp.InterpExprEta 5.2% 5.2% 1 0.208s │ │ ├─rewrite H ----------------------- 3.5% 3.5% 1 0.140s │ │ ├─tac ----------------------------- 1.9% 2.6% 1 0.104s │ │ └─Reify.transitivity_tt ----------- 0.0% 2.2% 2 0.056s │ │ └transitivity -------------------- 2.0% 2.0% 4 0.048s │ └─ReflectiveTactics.solve_post_reifie 0.6% 30.0% 1 1.192s │ ├─UnifyAbstractReflexivity.unify_tr 17.7% 21.7% 7 0.240s │ │└unify (constr) (constr) --------- 3.2% 3.2% 5 0.048s │ └─ReflectiveTactics.unify_abstract_ 5.2% 7.3% 1 0.292s │ └unify (constr) (constr) --------- 2.1% 2.1% 1 0.084s └─Glue.refine_to_reflective_glue' ----- 0.0% 11.1% 1 0.440s ├─Glue.zrange_to_reflective --------- 0.0% 7.1% 1 0.284s │└Glue.zrange_to_reflective_goal ---- 4.3% 5.5% 1 0.220s └─Glue.split_BoundedWordToZ --------- 0.1% 2.0% 1 0.080s Finished transaction in 7.078 secs (6.728u,0.s) (successful) Closed under the global context total time: 3.976s tactic local total calls max ────────────────────────────────────────┴──────┴──────┴───────┴─────────┘ ─Pipeline.refine_reflectively_gen ------ 0.0% 99.0% 1 3.936s ─ReflectiveTactics.do_reflective_pipelin 0.0% 87.9% 1 3.496s ─ReflectiveTactics.solve_side_conditions 0.0% 86.9% 1 3.456s ─ReflectiveTactics.do_reify ------------ 0.0% 56.9% 1 2.264s ─Reify.Reify_rhs_gen ------------------- 1.8% 56.2% 1 2.236s ─Reify.do_reify_abs_goal --------------- 36.1% 36.5% 2 1.452s ─Reify.do_reifyf_goal ------------------ 34.8% 35.1% 29 1.396s ─ReflectiveTactics.solve_post_reified_si 0.6% 30.0% 1 1.192s ─UnifyAbstractReflexivity.unify_transfor 17.7% 21.7% 7 0.240s ─Glue.refine_to_reflective_glue' ------- 0.0% 11.1% 1 0.440s ─eexact -------------------------------- 10.9% 10.9% 31 0.024s ─ReflectiveTactics.unify_abstract_cbv_in 5.2% 7.3% 1 0.292s ─Glue.zrange_to_reflective ------------- 0.0% 7.1% 1 0.284s ─prove_interp_compile_correct ---------- 0.0% 5.7% 1 0.228s ─Glue.zrange_to_reflective_goal -------- 4.3% 5.5% 1 0.220s ─unify (constr) (constr) --------------- 5.3% 5.3% 6 0.084s ─rewrite ?EtaInterp.InterpExprEta ------ 5.2% 5.2% 1 0.208s ─rewrite H ----------------------------- 3.5% 3.5% 1 0.140s ─tac ----------------------------------- 1.9% 2.6% 2 0.104s ─reflexivity --------------------------- 2.2% 2.2% 7 0.028s ─Reify.transitivity_tt ----------------- 0.0% 2.2% 2 0.056s ─transitivity -------------------------- 2.0% 2.0% 5 0.048s ─Glue.split_BoundedWordToZ ------------- 0.1% 2.0% 1 0.080s tactic local total calls max ────────────────────────────────────────┴──────┴──────┴───────┴─────────┘ ─Pipeline.refine_reflectively_gen ------ 0.0% 99.0% 1 3.936s ├─ReflectiveTactics.do_reflective_pipel 0.0% 87.9% 1 3.496s │└ReflectiveTactics.solve_side_conditio 0.0% 86.9% 1 3.456s │ ├─ReflectiveTactics.do_reify -------- 0.0% 56.9% 1 2.264s │ │└Reify.Reify_rhs_gen --------------- 1.8% 56.2% 1 2.236s │ │ ├─Reify.do_reify_abs_goal --------- 36.1% 36.5% 2 1.452s │ │ │└Reify.do_reifyf_goal ------------ 34.8% 35.1% 29 1.396s │ │ │└eexact -------------------------- 10.1% 10.1% 29 0.024s │ │ ├─prove_interp_compile_correct ---- 0.0% 5.7% 1 0.228s │ │ │└rewrite ?EtaInterp.InterpExprEta 5.2% 5.2% 1 0.208s │ │ ├─rewrite H ----------------------- 3.5% 3.5% 1 0.140s │ │ ├─tac ----------------------------- 1.9% 2.6% 1 0.104s │ │ └─Reify.transitivity_tt ----------- 0.0% 2.2% 2 0.056s │ │ └transitivity -------------------- 2.0% 2.0% 4 0.048s │ └─ReflectiveTactics.solve_post_reifie 0.6% 30.0% 1 1.192s │ ├─UnifyAbstractReflexivity.unify_tr 17.7% 21.7% 7 0.240s │ │└unify (constr) (constr) --------- 3.2% 3.2% 5 0.048s │ └─ReflectiveTactics.unify_abstract_ 5.2% 7.3% 1 0.292s │ └unify (constr) (constr) --------- 2.1% 2.1% 1 0.084s └─Glue.refine_to_reflective_glue' ----- 0.0% 11.1% 1 0.440s ├─Glue.zrange_to_reflective --------- 0.0% 7.1% 1 0.284s │└Glue.zrange_to_reflective_goal ---- 4.3% 5.5% 1 0.220s └─Glue.split_BoundedWordToZ --------- 0.1% 2.0% 1 0.080s src/Specific/X25519/C64/fecarry (real: 27.11, user: 24.99, sys: 0.21, mem: 786052 ko) COQC src/Specific/solinas32_2e255m765_12limbs/Synthesis.v src/Specific/solinas32_2e255m765_12limbs/Synthesis (real: 40.13, user: 36.92, sys: 0.26, mem: 728464 ko) COQC src/Specific/solinas32_2e255m765_13limbs/Synthesis.v src/Specific/solinas32_2e255m765_13limbs/Synthesis (real: 49.44, user: 45.75, sys: 0.18, mem: 744240 ko) COQC src/Specific/X25519/C64/femul.v Finished transaction in 8.415 secs (7.664u,0.015s) (successful) total time: 7.616s tactic local total calls max ────────────────────────────────────────┴──────┴──────┴───────┴─────────┘ ─Pipeline.refine_reflectively_gen ------ 0.0% 94.8% 1 7.220s ─ReflectiveTactics.do_reflective_pipelin 0.0% 85.0% 1 6.476s ─ReflectiveTactics.solve_side_conditions 0.0% 84.2% 1 6.416s ─ReflectiveTactics.do_reify ------------ 0.0% 50.3% 1 3.832s ─Reify.Reify_rhs_gen ------------------- 1.8% 49.4% 1 3.760s ─ReflectiveTactics.solve_post_reified_si 0.5% 33.9% 1 2.584s ─Reify.do_reify_abs_goal --------------- 31.1% 31.4% 2 2.392s ─Reify.do_reifyf_goal ------------------ 30.0% 30.3% 58 1.528s ─UnifyAbstractReflexivity.unify_transfor 22.1% 27.3% 7 0.600s ─Glue.refine_to_reflective_glue' ------- 0.0% 9.8% 1 0.744s ─eexact -------------------------------- 8.2% 8.2% 60 0.024s ─Glue.zrange_to_reflective ------------- 0.1% 6.8% 1 0.516s ─unify (constr) (constr) --------------- 5.9% 5.9% 6 0.124s ─prove_interp_compile_correct ---------- 0.0% 5.8% 1 0.444s ─ReflectiveTactics.unify_abstract_cbv_in 3.9% 5.7% 1 0.432s ─rewrite ?EtaInterp.InterpExprEta ------ 5.4% 5.4% 1 0.408s ─synthesize ---------------------------- 0.0% 5.2% 1 0.396s ─Glue.zrange_to_reflective_goal -------- 3.0% 5.0% 1 0.384s ─IntegrationTestTemporaryMiscCommon.do_r 0.1% 4.8% 1 0.364s ─change G' ----------------------------- 3.9% 3.9% 1 0.300s ─rewrite H ----------------------------- 3.0% 3.0% 1 0.232s ─tac ----------------------------------- 1.5% 2.3% 2 0.176s ─Reify.transitivity_tt ----------------- 0.0% 2.1% 2 0.092s ─reflexivity --------------------------- 2.0% 2.0% 7 0.052s tactic local total calls max ────────────────────────────────────────┴──────┴──────┴───────┴─────────┘ ─Pipeline.refine_reflectively_gen ------ 0.0% 94.8% 1 7.220s ├─ReflectiveTactics.do_reflective_pipel 0.0% 85.0% 1 6.476s │└ReflectiveTactics.solve_side_conditio 0.0% 84.2% 1 6.416s │ ├─ReflectiveTactics.do_reify -------- 0.0% 50.3% 1 3.832s │ │└Reify.Reify_rhs_gen --------------- 1.8% 49.4% 1 3.760s │ │ ├─Reify.do_reify_abs_goal --------- 31.1% 31.4% 2 2.392s │ │ │└Reify.do_reifyf_goal ------------ 30.0% 30.3% 58 1.528s │ │ │└eexact -------------------------- 7.6% 7.6% 58 0.020s │ │ ├─prove_interp_compile_correct ---- 0.0% 5.8% 1 0.444s │ │ │└rewrite ?EtaInterp.InterpExprEta 5.4% 5.4% 1 0.408s │ │ ├─rewrite H ----------------------- 3.0% 3.0% 1 0.232s │ │ ├─tac ----------------------------- 1.5% 2.3% 1 0.176s │ │ └─Reify.transitivity_tt ----------- 0.0% 2.1% 2 0.092s │ └─ReflectiveTactics.solve_post_reifie 0.5% 33.9% 1 2.584s │ ├─UnifyAbstractReflexivity.unify_tr 22.1% 27.3% 7 0.600s │ │└unify (constr) (constr) --------- 4.3% 4.3% 5 0.096s │ └─ReflectiveTactics.unify_abstract_ 3.9% 5.7% 1 0.432s └─Glue.refine_to_reflective_glue' ----- 0.0% 9.8% 1 0.744s └Glue.zrange_to_reflective ----------- 0.1% 6.8% 1 0.516s └Glue.zrange_to_reflective_goal ------ 3.0% 5.0% 1 0.384s ─synthesize ---------------------------- 0.0% 5.2% 1 0.396s └IntegrationTestTemporaryMiscCommon.do_r 0.1% 4.8% 1 0.364s └change G' ----------------------------- 3.9% 3.9% 1 0.300s Finished transaction in 14.616 secs (13.528u,0.008s) (successful) Closed under the global context total time: 7.616s tactic local total calls max ────────────────────────────────────────┴──────┴──────┴───────┴─────────┘ ─Pipeline.refine_reflectively_gen ------ 0.0% 94.8% 1 7.220s ─ReflectiveTactics.do_reflective_pipelin 0.0% 85.0% 1 6.476s ─ReflectiveTactics.solve_side_conditions 0.0% 84.2% 1 6.416s ─ReflectiveTactics.do_reify ------------ 0.0% 50.3% 1 3.832s ─Reify.Reify_rhs_gen ------------------- 1.8% 49.4% 1 3.760s ─ReflectiveTactics.solve_post_reified_si 0.5% 33.9% 1 2.584s ─Reify.do_reify_abs_goal --------------- 31.1% 31.4% 2 2.392s ─Reify.do_reifyf_goal ------------------ 30.0% 30.3% 58 1.528s ─UnifyAbstractReflexivity.unify_transfor 22.1% 27.3% 7 0.600s ─Glue.refine_to_reflective_glue' ------- 0.0% 9.8% 1 0.744s ─eexact -------------------------------- 8.2% 8.2% 60 0.024s ─Glue.zrange_to_reflective ------------- 0.1% 6.8% 1 0.516s ─unify (constr) (constr) --------------- 5.9% 5.9% 6 0.124s ─prove_interp_compile_correct ---------- 0.0% 5.8% 1 0.444s ─ReflectiveTactics.unify_abstract_cbv_in 3.9% 5.7% 1 0.432s ─rewrite ?EtaInterp.InterpExprEta ------ 5.4% 5.4% 1 0.408s ─synthesize ---------------------------- 0.0% 5.2% 1 0.396s ─Glue.zrange_to_reflective_goal -------- 3.0% 5.0% 1 0.384s ─IntegrationTestTemporaryMiscCommon.do_r 0.1% 4.8% 1 0.364s ─change G' ----------------------------- 3.9% 3.9% 1 0.300s ─rewrite H ----------------------------- 3.0% 3.0% 1 0.232s ─tac ----------------------------------- 1.5% 2.3% 2 0.176s ─Reify.transitivity_tt ----------------- 0.0% 2.1% 2 0.092s ─reflexivity --------------------------- 2.0% 2.0% 7 0.052s tactic local total calls max ────────────────────────────────────────┴──────┴──────┴───────┴─────────┘ ─Pipeline.refine_reflectively_gen ------ 0.0% 94.8% 1 7.220s ├─ReflectiveTactics.do_reflective_pipel 0.0% 85.0% 1 6.476s │└ReflectiveTactics.solve_side_conditio 0.0% 84.2% 1 6.416s │ ├─ReflectiveTactics.do_reify -------- 0.0% 50.3% 1 3.832s │ │└Reify.Reify_rhs_gen --------------- 1.8% 49.4% 1 3.760s │ │ ├─Reify.do_reify_abs_goal --------- 31.1% 31.4% 2 2.392s │ │ │└Reify.do_reifyf_goal ------------ 30.0% 30.3% 58 1.528s │ │ │└eexact -------------------------- 7.6% 7.6% 58 0.020s │ │ ├─prove_interp_compile_correct ---- 0.0% 5.8% 1 0.444s │ │ │└rewrite ?EtaInterp.InterpExprEta 5.4% 5.4% 1 0.408s │ │ ├─rewrite H ----------------------- 3.0% 3.0% 1 0.232s │ │ ├─tac ----------------------------- 1.5% 2.3% 1 0.176s │ │ └─Reify.transitivity_tt ----------- 0.0% 2.1% 2 0.092s │ └─ReflectiveTactics.solve_post_reifie 0.5% 33.9% 1 2.584s │ ├─UnifyAbstractReflexivity.unify_tr 22.1% 27.3% 7 0.600s │ │└unify (constr) (constr) --------- 4.3% 4.3% 5 0.096s │ └─ReflectiveTactics.unify_abstract_ 3.9% 5.7% 1 0.432s └─Glue.refine_to_reflective_glue' ----- 0.0% 9.8% 1 0.744s └Glue.zrange_to_reflective ----------- 0.1% 6.8% 1 0.516s └Glue.zrange_to_reflective_goal ------ 3.0% 5.0% 1 0.384s ─synthesize ---------------------------- 0.0% 5.2% 1 0.396s └IntegrationTestTemporaryMiscCommon.do_r 0.1% 4.8% 1 0.364s └change G' ----------------------------- 3.9% 3.9% 1 0.300s src/Specific/X25519/C64/femul (real: 39.72, user: 36.32, sys: 0.26, mem: 825448 ko) COQC src/Specific/X25519/C64/feaddDisplay > src/Specific/X25519/C64/feaddDisplay.log COQC src/Specific/X25519/C64/fecarryDisplay > src/Specific/X25519/C64/fecarryDisplay.log COQC src/Specific/X25519/C64/fesub.v Finished transaction in 3.513 secs (3.211u,0.s) (successful) total time: 3.164s tactic local total calls max ────────────────────────────────────────┴──────┴──────┴───────┴─────────┘ ─Pipeline.refine_reflectively_gen ------ 0.0% 97.6% 1 3.088s ─ReflectiveTactics.do_reflective_pipelin 0.0% 74.1% 1 2.344s ─ReflectiveTactics.solve_side_conditions 0.0% 72.9% 1 2.308s ─ReflectiveTactics.do_reify ------------ 0.0% 38.6% 1 1.220s ─Reify.Reify_rhs_gen ------------------- 1.5% 37.2% 1 1.176s ─ReflectiveTactics.solve_post_reified_si 0.9% 34.4% 1 1.088s ─UnifyAbstractReflexivity.unify_transfor 19.2% 23.9% 7 0.204s ─Glue.refine_to_reflective_glue' ------- 0.0% 23.5% 1 0.744s ─Reify.do_reify_abs_goal --------------- 19.2% 19.5% 2 0.616s ─Reify.do_reifyf_goal ------------------ 18.0% 18.3% 16 0.580s ─Glue.zrange_to_reflective ------------- 0.1% 15.4% 1 0.488s ─Glue.zrange_to_reflective_goal -------- 6.8% 11.5% 1 0.364s ─ReflectiveTactics.unify_abstract_cbv_in 6.2% 9.0% 1 0.284s ─unify (constr) (constr) --------------- 5.9% 5.9% 6 0.080s ─Glue.pattern_sig_sig_assoc ------------ 0.0% 4.6% 1 0.144s ─eexact -------------------------------- 4.4% 4.4% 18 0.012s ─Glue.pattern_proj1_sig_in_sig --------- 1.4% 4.3% 1 0.136s ─prove_interp_compile_correct ---------- 0.0% 3.9% 1 0.124s ─rewrite H ----------------------------- 3.8% 3.8% 1 0.120s ─assert (H : is_bounded_by' bounds (map' 3.8% 3.8% 2 0.064s ─rewrite ?EtaInterp.InterpExprEta ------ 3.5% 3.5% 1 0.112s ─pose proof (pf : Interpretation.Bo 2.9% 2.9% 1 0.092s ─Glue.split_BoundedWordToZ ------------- 0.1% 2.8% 1 0.088s ─tac ----------------------------------- 1.9% 2.5% 2 0.080s ─reflexivity --------------------------- 2.4% 2.4% 7 0.028s ─synthesize ---------------------------- 0.0% 2.4% 1 0.076s ─destruct_sig -------------------------- 0.0% 2.4% 4 0.040s ─destruct x ---------------------------- 2.4% 2.4% 4 0.032s ─clearbody (ne_var_list) --------------- 2.3% 2.3% 4 0.060s ─Reify.transitivity_tt ----------------- 0.1% 2.3% 2 0.036s ─transitivity -------------------------- 2.1% 2.1% 5 0.032s tactic local total calls max ────────────────────────────────────────┴──────┴──────┴───────┴─────────┘ ─Pipeline.refine_reflectively_gen ------ 0.0% 97.6% 1 3.088s ├─ReflectiveTactics.do_reflective_pipel 0.0% 74.1% 1 2.344s │└ReflectiveTactics.solve_side_conditio 0.0% 72.9% 1 2.308s │ ├─ReflectiveTactics.do_reify -------- 0.0% 38.6% 1 1.220s │ │└Reify.Reify_rhs_gen --------------- 1.5% 37.2% 1 1.176s │ │ ├─Reify.do_reify_abs_goal --------- 19.2% 19.5% 2 0.616s │ │ │└Reify.do_reifyf_goal ------------ 18.0% 18.3% 16 0.580s │ │ │└eexact -------------------------- 3.9% 3.9% 16 0.012s │ │ ├─prove_interp_compile_correct ---- 0.0% 3.9% 1 0.124s │ │ │└rewrite ?EtaInterp.InterpExprEta 3.5% 3.5% 1 0.112s │ │ ├─rewrite H ----------------------- 3.8% 3.8% 1 0.120s │ │ ├─tac ----------------------------- 1.9% 2.5% 1 0.080s │ │ └─Reify.transitivity_tt ----------- 0.1% 2.3% 2 0.036s │ │ └transitivity -------------------- 2.0% 2.0% 4 0.032s │ └─ReflectiveTactics.solve_post_reifie 0.9% 34.4% 1 1.088s │ ├─UnifyAbstractReflexivity.unify_tr 19.2% 23.9% 7 0.204s │ │└unify (constr) (constr) --------- 3.4% 3.4% 5 0.036s │ └─ReflectiveTactics.unify_abstract_ 6.2% 9.0% 1 0.284s │ └unify (constr) (constr) --------- 2.5% 2.5% 1 0.080s └─Glue.refine_to_reflective_glue' ----- 0.0% 23.5% 1 0.744s ├─Glue.zrange_to_reflective --------- 0.1% 15.4% 1 0.488s │ ├─Glue.zrange_to_reflective_goal -- 6.8% 11.5% 1 0.364s │ │└pose proof (pf : Interpretat 2.9% 2.9% 1 0.092s │ └─assert (H : is_bounded_by' bounds 3.8% 3.8% 2 0.064s ├─Glue.pattern_sig_sig_assoc -------- 0.0% 4.6% 1 0.144s │└Glue.pattern_proj1_sig_in_sig ----- 1.4% 4.3% 1 0.136s └─Glue.split_BoundedWordToZ --------- 0.1% 2.8% 1 0.088s └destruct_sig ---------------------- 0.0% 2.4% 4 0.040s ─synthesize ---------------------------- 0.0% 2.4% 1 0.076s Finished transaction in 6.12 secs (5.64u,0.008s) (successful) Closed under the global context total time: 3.164s tactic local total calls max ────────────────────────────────────────┴──────┴──────┴───────┴─────────┘ ─Pipeline.refine_reflectively_gen ------ 0.0% 97.6% 1 3.088s ─ReflectiveTactics.do_reflective_pipelin 0.0% 74.1% 1 2.344s ─ReflectiveTactics.solve_side_conditions 0.0% 72.9% 1 2.308s ─ReflectiveTactics.do_reify ------------ 0.0% 38.6% 1 1.220s ─Reify.Reify_rhs_gen ------------------- 1.5% 37.2% 1 1.176s ─ReflectiveTactics.solve_post_reified_si 0.9% 34.4% 1 1.088s ─UnifyAbstractReflexivity.unify_transfor 19.2% 23.9% 7 0.204s ─Glue.refine_to_reflective_glue' ------- 0.0% 23.5% 1 0.744s ─Reify.do_reify_abs_goal --------------- 19.2% 19.5% 2 0.616s ─Reify.do_reifyf_goal ------------------ 18.0% 18.3% 16 0.580s ─Glue.zrange_to_reflective ------------- 0.1% 15.4% 1 0.488s ─Glue.zrange_to_reflective_goal -------- 6.8% 11.5% 1 0.364s ─ReflectiveTactics.unify_abstract_cbv_in 6.2% 9.0% 1 0.284s ─unify (constr) (constr) --------------- 5.9% 5.9% 6 0.080s ─Glue.pattern_sig_sig_assoc ------------ 0.0% 4.6% 1 0.144s ─eexact -------------------------------- 4.4% 4.4% 18 0.012s ─Glue.pattern_proj1_sig_in_sig --------- 1.4% 4.3% 1 0.136s ─prove_interp_compile_correct ---------- 0.0% 3.9% 1 0.124s ─rewrite H ----------------------------- 3.8% 3.8% 1 0.120s ─assert (H : is_bounded_by' bounds (map' 3.8% 3.8% 2 0.064s ─rewrite ?EtaInterp.InterpExprEta ------ 3.5% 3.5% 1 0.112s ─pose proof (pf : Interpretation.Bo 2.9% 2.9% 1 0.092s ─Glue.split_BoundedWordToZ ------------- 0.1% 2.8% 1 0.088s ─tac ----------------------------------- 1.9% 2.5% 2 0.080s ─reflexivity --------------------------- 2.4% 2.4% 7 0.028s ─synthesize ---------------------------- 0.0% 2.4% 1 0.076s ─destruct_sig -------------------------- 0.0% 2.4% 4 0.040s ─destruct x ---------------------------- 2.4% 2.4% 4 0.032s ─clearbody (ne_var_list) --------------- 2.3% 2.3% 4 0.060s ─Reify.transitivity_tt ----------------- 0.1% 2.3% 2 0.036s ─transitivity -------------------------- 2.1% 2.1% 5 0.032s tactic local total calls max ────────────────────────────────────────┴──────┴──────┴───────┴─────────┘ ─Pipeline.refine_reflectively_gen ------ 0.0% 97.6% 1 3.088s ├─ReflectiveTactics.do_reflective_pipel 0.0% 74.1% 1 2.344s │└ReflectiveTactics.solve_side_conditio 0.0% 72.9% 1 2.308s │ ├─ReflectiveTactics.do_reify -------- 0.0% 38.6% 1 1.220s │ │└Reify.Reify_rhs_gen --------------- 1.5% 37.2% 1 1.176s │ │ ├─Reify.do_reify_abs_goal --------- 19.2% 19.5% 2 0.616s │ │ │└Reify.do_reifyf_goal ------------ 18.0% 18.3% 16 0.580s │ │ │└eexact -------------------------- 3.9% 3.9% 16 0.012s │ │ ├─prove_interp_compile_correct ---- 0.0% 3.9% 1 0.124s │ │ │└rewrite ?EtaInterp.InterpExprEta 3.5% 3.5% 1 0.112s │ │ ├─rewrite H ----------------------- 3.8% 3.8% 1 0.120s │ │ ├─tac ----------------------------- 1.9% 2.5% 1 0.080s │ │ └─Reify.transitivity_tt ----------- 0.1% 2.3% 2 0.036s │ │ └transitivity -------------------- 2.0% 2.0% 4 0.032s │ └─ReflectiveTactics.solve_post_reifie 0.9% 34.4% 1 1.088s │ ├─UnifyAbstractReflexivity.unify_tr 19.2% 23.9% 7 0.204s │ │└unify (constr) (constr) --------- 3.4% 3.4% 5 0.036s │ └─ReflectiveTactics.unify_abstract_ 6.2% 9.0% 1 0.284s │ └unify (constr) (constr) --------- 2.5% 2.5% 1 0.080s └─Glue.refine_to_reflective_glue' ----- 0.0% 23.5% 1 0.744s ├─Glue.zrange_to_reflective --------- 0.1% 15.4% 1 0.488s │ ├─Glue.zrange_to_reflective_goal -- 6.8% 11.5% 1 0.364s │ │└pose proof (pf : Interpretat 2.9% 2.9% 1 0.092s │ └─assert (H : is_bounded_by' bounds 3.8% 3.8% 2 0.064s ├─Glue.pattern_sig_sig_assoc -------- 0.0% 4.6% 1 0.144s │└Glue.pattern_proj1_sig_in_sig ----- 1.4% 4.3% 1 0.136s └─Glue.split_BoundedWordToZ --------- 0.1% 2.8% 1 0.088s └destruct_sig ---------------------- 0.0% 2.4% 4 0.040s ─synthesize ---------------------------- 0.0% 2.4% 1 0.076s src/Specific/X25519/C64/fesub (real: 24.71, user: 22.65, sys: 0.24, mem: 778792 ko) COQC src/Specific/X25519/C64/fesquare.v Finished transaction in 6.132 secs (5.516u,0.012s) (successful) total time: 5.480s tactic local total calls max ────────────────────────────────────────┴──────┴──────┴───────┴─────────┘ ─synthesize ---------------------------- -0.0% 100.0% 1 5.480s ─Pipeline.refine_reflectively_gen ------ 0.0% 95.7% 1 5.244s ─ReflectiveTactics.do_reflective_pipelin 0.0% 88.6% 1 4.856s ─ReflectiveTactics.solve_side_conditions 0.0% 87.7% 1 4.804s ─ReflectiveTactics.do_reify ------------ 0.0% 53.3% 1 2.920s ─Reify.Reify_rhs_gen ------------------- 2.0% 52.5% 1 2.876s ─ReflectiveTactics.solve_post_reified_si 0.6% 34.4% 1 1.884s ─Reify.do_reify_abs_goal --------------- 33.2% 33.6% 2 1.844s ─Reify.do_reifyf_goal ------------------ 31.5% 32.0% 47 1.392s ─UnifyAbstractReflexivity.unify_transfor 21.9% 26.6% 7 0.400s ─eexact -------------------------------- 10.0% 10.0% 49 0.028s ─Glue.refine_to_reflective_glue' ------- 0.0% 7.1% 1 0.388s ─ReflectiveTactics.unify_abstract_cbv_in 5.0% 6.9% 1 0.380s ─unify (constr) (constr) --------------- 5.8% 5.8% 6 0.104s ─prove_interp_compile_correct ---------- 0.0% 5.8% 1 0.316s ─rewrite ?EtaInterp.InterpExprEta ------ 5.3% 5.3% 1 0.288s ─Glue.zrange_to_reflective ------------- 0.1% 5.1% 1 0.280s ─IntegrationTestTemporaryMiscCommon.do_r 0.1% 4.0% 1 0.220s ─Glue.zrange_to_reflective_goal -------- 3.1% 3.9% 1 0.212s ─change G' ----------------------------- 3.4% 3.4% 1 0.184s ─tac ----------------------------------- 2.0% 2.8% 2 0.156s ─rewrite H ----------------------------- 2.8% 2.8% 1 0.156s ─reflexivity --------------------------- 2.8% 2.8% 7 0.064s tactic local total calls max ────────────────────────────────────────┴──────┴──────┴───────┴─────────┘ ─synthesize ---------------------------- -0.0% 100.0% 1 5.480s ├─Pipeline.refine_reflectively_gen ---- 0.0% 95.7% 1 5.244s │ ├─ReflectiveTactics.do_reflective_pip 0.0% 88.6% 1 4.856s │ │└ReflectiveTactics.solve_side_condit 0.0% 87.7% 1 4.804s │ │ ├─ReflectiveTactics.do_reify ------ 0.0% 53.3% 1 2.920s │ │ │└Reify.Reify_rhs_gen ------------- 2.0% 52.5% 1 2.876s │ │ │ ├─Reify.do_reify_abs_goal ------- 33.2% 33.6% 2 1.844s │ │ │ │└Reify.do_reifyf_goal ---------- 31.5% 32.0% 47 1.392s │ │ │ │└eexact ------------------------ 9.1% 9.1% 47 0.024s │ │ │ ├─prove_interp_compile_correct -- 0.0% 5.8% 1 0.316s │ │ │ │└rewrite ?EtaInterp.InterpExprEt 5.3% 5.3% 1 0.288s │ │ │ ├─tac --------------------------- 2.0% 2.8% 1 0.156s │ │ │ └─rewrite H --------------------- 2.8% 2.8% 1 0.156s │ │ └─ReflectiveTactics.solve_post_reif 0.6% 34.4% 1 1.884s │ │ ├─UnifyAbstractReflexivity.unify_ 21.9% 26.6% 7 0.400s │ │ │└unify (constr) (constr) ------- 3.9% 3.9% 5 0.072s │ │ └─ReflectiveTactics.unify_abstrac 5.0% 6.9% 1 0.380s │ └─Glue.refine_to_reflective_glue' --- 0.0% 7.1% 1 0.388s │ └Glue.zrange_to_reflective --------- 0.1% 5.1% 1 0.280s │ └Glue.zrange_to_reflective_goal ---- 3.1% 3.9% 1 0.212s └─IntegrationTestTemporaryMiscCommon.do 0.1% 4.0% 1 0.220s └change G' --------------------------- 3.4% 3.4% 1 0.184s Finished transaction in 10.475 secs (9.728u,0.007s) (successful) Closed under the global context total time: 5.480s tactic local total calls max ────────────────────────────────────────┴──────┴──────┴───────┴─────────┘ ─synthesize ---------------------------- -0.0% 100.0% 1 5.480s ─Pipeline.refine_reflectively_gen ------ 0.0% 95.7% 1 5.244s ─ReflectiveTactics.do_reflective_pipelin 0.0% 88.6% 1 4.856s ─ReflectiveTactics.solve_side_conditions 0.0% 87.7% 1 4.804s ─ReflectiveTactics.do_reify ------------ 0.0% 53.3% 1 2.920s ─Reify.Reify_rhs_gen ------------------- 2.0% 52.5% 1 2.876s ─ReflectiveTactics.solve_post_reified_si 0.6% 34.4% 1 1.884s ─Reify.do_reify_abs_goal --------------- 33.2% 33.6% 2 1.844s ─Reify.do_reifyf_goal ------------------ 31.5% 32.0% 47 1.392s ─UnifyAbstractReflexivity.unify_transfor 21.9% 26.6% 7 0.400s ─eexact -------------------------------- 10.0% 10.0% 49 0.028s ─Glue.refine_to_reflective_glue' ------- 0.0% 7.1% 1 0.388s ─ReflectiveTactics.unify_abstract_cbv_in 5.0% 6.9% 1 0.380s ─unify (constr) (constr) --------------- 5.8% 5.8% 6 0.104s ─prove_interp_compile_correct ---------- 0.0% 5.8% 1 0.316s ─rewrite ?EtaInterp.InterpExprEta ------ 5.3% 5.3% 1 0.288s ─Glue.zrange_to_reflective ------------- 0.1% 5.1% 1 0.280s ─IntegrationTestTemporaryMiscCommon.do_r 0.1% 4.0% 1 0.220s ─Glue.zrange_to_reflective_goal -------- 3.1% 3.9% 1 0.212s ─change G' ----------------------------- 3.4% 3.4% 1 0.184s ─tac ----------------------------------- 2.0% 2.8% 2 0.156s ─rewrite H ----------------------------- 2.8% 2.8% 1 0.156s ─reflexivity --------------------------- 2.8% 2.8% 7 0.064s tactic local total calls max ────────────────────────────────────────┴──────┴──────┴───────┴─────────┘ ─synthesize ---------------------------- -0.0% 100.0% 1 5.480s ├─Pipeline.refine_reflectively_gen ---- 0.0% 95.7% 1 5.244s │ ├─ReflectiveTactics.do_reflective_pip 0.0% 88.6% 1 4.856s │ │└ReflectiveTactics.solve_side_condit 0.0% 87.7% 1 4.804s │ │ ├─ReflectiveTactics.do_reify ------ 0.0% 53.3% 1 2.920s │ │ │└Reify.Reify_rhs_gen ------------- 2.0% 52.5% 1 2.876s │ │ │ ├─Reify.do_reify_abs_goal ------- 33.2% 33.6% 2 1.844s │ │ │ │└Reify.do_reifyf_goal ---------- 31.5% 32.0% 47 1.392s │ │ │ │└eexact ------------------------ 9.1% 9.1% 47 0.024s │ │ │ ├─prove_interp_compile_correct -- 0.0% 5.8% 1 0.316s │ │ │ │└rewrite ?EtaInterp.InterpExprEt 5.3% 5.3% 1 0.288s │ │ │ ├─tac --------------------------- 2.0% 2.8% 1 0.156s │ │ │ └─rewrite H --------------------- 2.8% 2.8% 1 0.156s │ │ └─ReflectiveTactics.solve_post_reif 0.6% 34.4% 1 1.884s │ │ ├─UnifyAbstractReflexivity.unify_ 21.9% 26.6% 7 0.400s │ │ │└unify (constr) (constr) ------- 3.9% 3.9% 5 0.072s │ │ └─ReflectiveTactics.unify_abstrac 5.0% 6.9% 1 0.380s │ └─Glue.refine_to_reflective_glue' --- 0.0% 7.1% 1 0.388s │ └Glue.zrange_to_reflective --------- 0.1% 5.1% 1 0.280s │ └Glue.zrange_to_reflective_goal ---- 3.1% 3.9% 1 0.212s └─IntegrationTestTemporaryMiscCommon.do 0.1% 4.0% 1 0.220s └change G' --------------------------- 3.4% 3.4% 1 0.184s src/Specific/X25519/C64/fesquare (real: 33.08, user: 30.13, sys: 0.24, mem: 799620 ko) COQC src/Specific/X25519/C64/femulDisplay > src/Specific/X25519/C64/femulDisplay.log COQC src/Specific/X25519/C64/freeze.v Finished transaction in 7.307 secs (6.763u,0.011s) (successful) total time: 6.732s tactic local total calls max ────────────────────────────────────────┴──────┴──────┴───────┴─────────┘ ─synthesize_freeze --------------------- 0.0% 100.0% 1 6.732s ─Pipeline.refine_reflectively_gen ------ 0.0% 99.3% 1 6.684s ─ReflectiveTactics.do_reflective_pipelin 0.0% 92.8% 1 6.248s ─ReflectiveTactics.solve_side_conditions 0.0% 92.0% 1 6.192s ─ReflectiveTactics.do_reify ------------ -0.0% 60.3% 1 4.060s ─Reify.Reify_rhs_gen ------------------- 1.5% 59.6% 1 4.012s ─Reify.do_reify_abs_goal --------------- 42.4% 42.7% 2 2.876s ─Reify.do_reifyf_goal ------------------ 41.3% 41.7% 129 2.804s ─ReflectiveTactics.solve_post_reified_si 0.6% 31.7% 1 2.132s ─UnifyAbstractReflexivity.unify_transfor 21.7% 25.8% 7 0.424s ─eexact -------------------------------- 13.7% 13.7% 131 0.036s ─Glue.refine_to_reflective_glue' ------- 0.0% 6.5% 1 0.436s ─prove_interp_compile_correct ---------- 0.0% 5.1% 1 0.344s ─ReflectiveTactics.unify_abstract_cbv_in 3.4% 5.0% 1 0.336s ─rewrite ?EtaInterp.InterpExprEta ------ 4.7% 4.7% 1 0.316s ─unify (constr) (constr) --------------- 4.6% 4.6% 6 0.100s ─Glue.zrange_to_reflective ------------- 0.0% 4.2% 1 0.280s ─Glue.zrange_to_reflective_goal -------- 2.4% 3.3% 1 0.220s ─Reify.transitivity_tt ----------------- 0.1% 2.6% 2 0.116s ─rewrite H ----------------------------- 2.6% 2.6% 1 0.172s ─tac ----------------------------------- 1.5% 2.3% 2 0.156s ─reflexivity --------------------------- 2.3% 2.3% 7 0.052s tactic local total calls max ────────────────────────────────────────┴──────┴──────┴───────┴─────────┘ ─synthesize_freeze --------------------- 0.0% 100.0% 1 6.732s └Pipeline.refine_reflectively_gen ------ 0.0% 99.3% 1 6.684s ├─ReflectiveTactics.do_reflective_pipel 0.0% 92.8% 1 6.248s │└ReflectiveTactics.solve_side_conditio 0.0% 92.0% 1 6.192s │ ├─ReflectiveTactics.do_reify -------- -0.0% 60.3% 1 4.060s │ │└Reify.Reify_rhs_gen --------------- 1.5% 59.6% 1 4.012s │ │ ├─Reify.do_reify_abs_goal --------- 42.4% 42.7% 2 2.876s │ │ │└Reify.do_reifyf_goal ------------ 41.3% 41.7% 129 2.804s │ │ │└eexact -------------------------- 13.0% 13.0% 129 0.036s │ │ ├─prove_interp_compile_correct ---- 0.0% 5.1% 1 0.344s │ │ │└rewrite ?EtaInterp.InterpExprEta 4.7% 4.7% 1 0.316s │ │ ├─Reify.transitivity_tt ----------- 0.1% 2.6% 2 0.116s │ │ ├─rewrite H ----------------------- 2.6% 2.6% 1 0.172s │ │ └─tac ----------------------------- 1.5% 2.3% 1 0.156s │ └─ReflectiveTactics.solve_post_reifie 0.6% 31.7% 1 2.132s │ ├─UnifyAbstractReflexivity.unify_tr 21.7% 25.8% 7 0.424s │ │└unify (constr) (constr) --------- 3.1% 3.1% 5 0.084s │ └─ReflectiveTactics.unify_abstract_ 3.4% 5.0% 1 0.336s └─Glue.refine_to_reflective_glue' ----- 0.0% 6.5% 1 0.436s └Glue.zrange_to_reflective ----------- 0.0% 4.2% 1 0.280s └Glue.zrange_to_reflective_goal ------ 2.4% 3.3% 1 0.220s Finished transaction in 10.495 secs (9.756u,0.s) (successful) Closed under the global context total time: 6.732s tactic local total calls max ────────────────────────────────────────┴──────┴──────┴───────┴─────────┘ ─synthesize_freeze --------------------- 0.0% 100.0% 1 6.732s ─Pipeline.refine_reflectively_gen ------ 0.0% 99.3% 1 6.684s ─ReflectiveTactics.do_reflective_pipelin 0.0% 92.8% 1 6.248s ─ReflectiveTactics.solve_side_conditions 0.0% 92.0% 1 6.192s ─ReflectiveTactics.do_reify ------------ -0.0% 60.3% 1 4.060s ─Reify.Reify_rhs_gen ------------------- 1.5% 59.6% 1 4.012s ─Reify.do_reify_abs_goal --------------- 42.4% 42.7% 2 2.876s ─Reify.do_reifyf_goal ------------------ 41.3% 41.7% 129 2.804s ─ReflectiveTactics.solve_post_reified_si 0.6% 31.7% 1 2.132s ─UnifyAbstractReflexivity.unify_transfor 21.7% 25.8% 7 0.424s ─eexact -------------------------------- 13.7% 13.7% 131 0.036s ─Glue.refine_to_reflective_glue' ------- 0.0% 6.5% 1 0.436s ─prove_interp_compile_correct ---------- 0.0% 5.1% 1 0.344s ─ReflectiveTactics.unify_abstract_cbv_in 3.4% 5.0% 1 0.336s ─rewrite ?EtaInterp.InterpExprEta ------ 4.7% 4.7% 1 0.316s ─unify (constr) (constr) --------------- 4.6% 4.6% 6 0.100s ─Glue.zrange_to_reflective ------------- 0.0% 4.2% 1 0.280s ─Glue.zrange_to_reflective_goal -------- 2.4% 3.3% 1 0.220s ─Reify.transitivity_tt ----------------- 0.1% 2.6% 2 0.116s ─rewrite H ----------------------------- 2.6% 2.6% 1 0.172s ─tac ----------------------------------- 1.5% 2.3% 2 0.156s ─reflexivity --------------------------- 2.3% 2.3% 7 0.052s tactic local total calls max ────────────────────────────────────────┴──────┴──────┴───────┴─────────┘ ─synthesize_freeze --------------------- 0.0% 100.0% 1 6.732s └Pipeline.refine_reflectively_gen ------ 0.0% 99.3% 1 6.684s ├─ReflectiveTactics.do_reflective_pipel 0.0% 92.8% 1 6.248s │└ReflectiveTactics.solve_side_conditio 0.0% 92.0% 1 6.192s │ ├─ReflectiveTactics.do_reify -------- -0.0% 60.3% 1 4.060s │ │└Reify.Reify_rhs_gen --------------- 1.5% 59.6% 1 4.012s │ │ ├─Reify.do_reify_abs_goal --------- 42.4% 42.7% 2 2.876s │ │ │└Reify.do_reifyf_goal ------------ 41.3% 41.7% 129 2.804s │ │ │└eexact -------------------------- 13.0% 13.0% 129 0.036s │ │ ├─prove_interp_compile_correct ---- 0.0% 5.1% 1 0.344s │ │ │└rewrite ?EtaInterp.InterpExprEta 4.7% 4.7% 1 0.316s │ │ ├─Reify.transitivity_tt ----------- 0.1% 2.6% 2 0.116s │ │ ├─rewrite H ----------------------- 2.6% 2.6% 1 0.172s │ │ └─tac ----------------------------- 1.5% 2.3% 1 0.156s │ └─ReflectiveTactics.solve_post_reifie 0.6% 31.7% 1 2.132s │ ├─UnifyAbstractReflexivity.unify_tr 21.7% 25.8% 7 0.424s │ │└unify (constr) (constr) --------- 3.1% 3.1% 5 0.084s │ └─ReflectiveTactics.unify_abstract_ 3.4% 5.0% 1 0.336s └─Glue.refine_to_reflective_glue' ----- 0.0% 6.5% 1 0.436s └Glue.zrange_to_reflective ----------- 0.0% 4.2% 1 0.280s └Glue.zrange_to_reflective_goal ------ 2.4% 3.3% 1 0.220s src/Specific/X25519/C64/freeze (real: 34.35, user: 31.50, sys: 0.24, mem: 828104 ko) COQC src/Specific/NISTP256/AMD64/feadd.v Finished transaction in 8.784 secs (8.176u,0.011s) (successful) total time: 8.140s tactic local total calls max ────────────────────────────────────────┴──────┴──────┴───────┴─────────┘ ─Pipeline.refine_reflectively_gen ------ 0.0% 52.4% 1 4.268s ─synthesize_montgomery ----------------- 0.0% 47.6% 1 3.872s ─ReflectiveTactics.do_reflective_pipelin 0.0% 43.8% 1 3.568s ─ReflectiveTactics.solve_side_conditions 0.0% 43.2% 1 3.520s ─IntegrationTestTemporaryMiscCommon.fact 1.4% 23.6% 1 1.924s ─IntegrationTestTemporaryMiscCommon.do_r 0.0% 22.1% 1 1.796s ─ReflectiveTactics.do_reify ------------ 0.1% 21.7% 1 1.768s ─ReflectiveTactics.solve_post_reified_si 0.6% 21.5% 1 1.752s ─Reify.Reify_rhs_gen ------------------- 1.0% 20.9% 1 1.704s ─op_sig_side_conditions_t -------------- 0.0% 20.0% 1 1.624s ─DestructHyps.do_all_matches_then ------ 0.0% 20.0% 8 0.244s ─DestructHyps.do_one_match_then -------- 0.7% 19.9% 44 0.052s ─do_tac -------------------------------- 0.0% 19.2% 36 0.052s ─destruct H ---------------------------- 19.2% 19.2% 36 0.052s ─rewrite <- (lem : lemT) by by_tac ltac: 0.2% 17.3% 1 1.408s ─IntegrationTestTemporaryMiscCommon.do_r 0.0% 17.3% 1 1.408s ─by_tac -------------------------------- 0.0% 17.1% 4 0.504s ─rewrite <- (ZRange.is_bounded_by_None_r 16.7% 16.7% 8 0.344s ─UnifyAbstractReflexivity.unify_transfor 13.3% 16.1% 7 0.360s ─Reify.do_reify_abs_goal --------------- 9.9% 10.1% 2 0.820s ─Reify.do_reifyf_goal ------------------ 9.1% 9.3% 93 0.748s ─Glue.refine_to_reflective_glue' ------- 0.0% 8.6% 1 0.700s ─Glue.zrange_to_reflective ------------- 0.0% 5.3% 1 0.432s ─IntegrationTestTemporaryMiscCommon.do_s 0.0% 4.8% 1 0.388s ─ MapProjections.proj2 2.4% 2.4% 2 0.120s tactic local total calls max ────────────────────────────────────────┴──────┴──────┴───────┴─────────┘ ─Pipeline.refine_reflectively_gen ------ 0.0% 52.4% 1 4.268s ├─ReflectiveTactics.do_reflective_pipel 0.0% 43.8% 1 3.568s │└ReflectiveTactics.solve_side_conditio 0.0% 43.2% 1 3.520s │ ├─ReflectiveTactics.do_reify -------- 0.1% 21.7% 1 1.768s │ │└Reify.Reify_rhs_gen --------------- 1.0% 20.9% 1 1.704s │ │ ├─Reify.do_reify_abs_goal --------- 9.9% 10.1% 2 0.820s │ │ │└Reify.do_reifyf_goal ------------ 9.1% 9.3% 93 0.748s │ │ │└eexact -------------------------- 2.3% 2.3% 93 0.024s │ │ ├─prove_interp_compile_correct ---- 0.0% 2.5% 1 0.204s │ │ └─rewrite H ----------------------- 2.4% 2.4% 1 0.196s │ └─ReflectiveTactics.solve_post_reifie 0.6% 21.5% 1 1.752s │ ├─UnifyAbstractReflexivity.unify_tr 13.3% 16.1% 7 0.360s │ │└unify (constr) (constr) --------- 2.2% 2.2% 5 0.064s │ └─ReflectiveTactics.unify_abstract_ 3.3% 4.5% 1 0.368s └─Glue.refine_to_reflective_glue' ----- 0.0% 8.6% 1 0.700s └Glue.zrange_to_reflective ----------- 0.0% 5.3% 1 0.432s └Glue.zrange_to_reflective_goal ------ 2.6% 4.0% 1 0.324s ─synthesize_montgomery ----------------- 0.0% 47.6% 1 3.872s ├─IntegrationTestTemporaryMiscCommon.fa 1.4% 23.6% 1 1.924s │└op_sig_side_conditions_t ------------ 0.0% 20.0% 1 1.624s │ ├─DestructHyps.do_all_matches_then -- 0.0% 11.4% 4 0.244s │ │└DestructHyps.do_one_match_then ---- 0.3% 11.4% 24 0.052s │ │└do_tac ---------------------------- 0.0% 11.1% 20 0.052s │ │└destruct H ------------------------ 11.1% 11.1% 20 0.052s │ └─rewrite <- (ZRange.is_bounded_by_No 8.4% 8.4% 4 0.328s └─IntegrationTestTemporaryMiscCommon.do 0.0% 22.1% 1 1.796s ├─IntegrationTestTemporaryMiscCommon. 0.0% 17.3% 1 1.408s │└rewrite <- (lem : lemT) by by_tac l 0.2% 17.3% 1 1.408s │└by_tac ---------------------------- 0.0% 17.1% 4 0.504s │ ├─DestructHyps.do_all_matches_then 0.0% 8.6% 4 0.184s │ │└DestructHyps.do_one_match_then -- 0.3% 8.5% 20 0.052s │ │└do_tac -------------------------- 0.0% 8.2% 16 0.052s │ │└destruct H ---------------------- 8.2% 8.2% 16 0.052s │ └─rewrite <- (ZRange.is_bounded_by_ 8.3% 8.3% 4 0.344s └─IntegrationTestTemporaryMiscCommon. 0.0% 4.8% 1 0.388s └ MapProjections.proj2 2.4% 2.4% 2 0.120s tactic local total calls max ────────────────────────────────────────┴──────┴──────┴───────┴─────────┘ ─Pipeline.refine_reflectively_gen ------ 0.0% 52.4% 1 4.268s ├─ReflectiveTactics.do_reflective_pipel 0.0% 43.8% 1 3.568s │└ReflectiveTactics.solve_side_conditio 0.0% 43.2% 1 3.520s │ ├─ReflectiveTactics.do_reify -------- 0.1% 21.7% 1 1.768s │ │└Reify.Reify_rhs_gen --------------- 1.0% 20.9% 1 1.704s │ │ ├─Reify.do_reify_abs_goal --------- 9.9% 10.1% 2 0.820s │ │ │└Reify.do_reifyf_goal ------------ 9.1% 9.3% 93 0.748s │ │ │└eexact -------------------------- 2.3% 2.3% 93 0.024s │ │ ├─prove_interp_compile_correct ---- 0.0% 2.5% 1 0.204s │ │ └─rewrite H ----------------------- 2.4% 2.4% 1 0.196s │ └─ReflectiveTactics.solve_post_reifie 0.6% 21.5% 1 1.752s │ ├─UnifyAbstractReflexivity.unify_tr 13.3% 16.1% 7 0.360s │ │└unify (constr) (constr) --------- 2.2% 2.2% 5 0.064s │ └─ReflectiveTactics.unify_abstract_ 3.3% 4.5% 1 0.368s └─Glue.refine_to_reflective_glue' ----- 0.0% 8.6% 1 0.700s └Glue.zrange_to_reflective ----------- 0.0% 5.3% 1 0.432s └Glue.zrange_to_reflective_goal ------ 2.6% 4.0% 1 0.324s ─synthesize_montgomery ----------------- 0.0% 47.6% 1 3.872s ├─IntegrationTestTemporaryMiscCommon.fa 1.4% 23.6% 1 1.924s │└op_sig_side_conditions_t ------------ 0.0% 20.0% 1 1.624s │ ├─DestructHyps.do_all_matches_then -- 0.0% 11.4% 4 0.244s │ │└DestructHyps.do_one_match_then ---- 0.3% 11.4% 24 0.052s │ │└do_tac ---------------------------- 0.0% 11.1% 20 0.052s │ │└destruct H ------------------------ 11.1% 11.1% 20 0.052s │ └─rewrite <- (ZRange.is_bounded_by_No 8.4% 8.4% 4 0.328s └─IntegrationTestTemporaryMiscCommon.do 0.0% 22.1% 1 1.796s ├─IntegrationTestTemporaryMiscCommon. 0.0% 17.3% 1 1.408s │└rewrite <- (lem : lemT) by by_tac l 0.2% 17.3% 1 1.408s │└by_tac ---------------------------- 0.0% 17.1% 4 0.504s │ ├─DestructHyps.do_all_matches_then 0.0% 8.6% 4 0.184s │ │└DestructHyps.do_one_match_then -- 0.3% 8.5% 20 0.052s │ │└do_tac -------------------------- 0.0% 8.2% 16 0.052s │ │└destruct H ---------------------- 8.2% 8.2% 16 0.052s │ └─rewrite <- (ZRange.is_bounded_by_ 8.3% 8.3% 4 0.344s └─IntegrationTestTemporaryMiscCommon. 0.0% 4.8% 1 0.388s └ src/Specific/NISTP256/AMD64/feaddDisplay.log COQC src/Specific/NISTP256/AMD64/fenzDisplay > src/Specific/NISTP256/AMD64/fenzDisplay.log COQC src/Specific/solinas32_2e255m765_12limbs/femul.v Finished transaction in 50.426 secs (46.528u,0.072s) (successful) total time: 46.544s tactic local total calls max ────────────────────────────────────────┴──────┴──────┴───────┴─────────┘ ─Pipeline.refine_reflectively_gen ------ -0.0% 94.9% 1 44.164s ─ReflectiveTactics.do_reflective_pipelin 0.0% 87.1% 1 40.552s ─ReflectiveTactics.solve_side_conditions 0.0% 86.7% 1 40.372s ─ReflectiveTactics.do_reify ------------ 0.0% 59.6% 1 27.740s ─Reify.Reify_rhs_gen ------------------- 1.6% 58.9% 1 27.432s ─Reify.do_reify_abs_goal --------------- 43.3% 43.6% 2 20.312s ─Reify.do_reifyf_goal ------------------ 42.5% 42.8% 108 10.328s ─ReflectiveTactics.solve_post_reified_si 0.1% 27.1% 1 12.632s ─UnifyAbstractReflexivity.unify_transfor 18.6% 23.5% 7 3.552s ─eexact -------------------------------- 13.7% 13.7% 110 0.136s ─Glue.refine_to_reflective_glue' ------- 0.0% 7.8% 1 3.612s ─Glue.zrange_to_reflective ------------- 0.0% 7.2% 1 3.332s ─Glue.zrange_to_reflective_goal -------- 1.7% 5.5% 1 2.544s ─synthesize ---------------------------- 0.0% 5.1% 1 2.380s ─unify (constr) (constr) --------------- 5.1% 5.1% 6 1.068s ─IntegrationTestTemporaryMiscCommon.do_r 0.0% 5.0% 1 2.320s ─change G' ----------------------------- 4.8% 4.8% 1 2.252s ─rewrite H ----------------------------- 3.8% 3.8% 1 1.748s ─pose proof (pf : Interpretation.Bo 3.6% 3.6% 1 1.664s ─prove_interp_compile_correct ---------- 0.0% 3.5% 1 1.616s ─rewrite ?EtaInterp.InterpExprEta ------ 3.2% 3.2% 1 1.468s ─ReflectiveTactics.unify_abstract_cbv_in 1.6% 2.4% 1 1.124s ─reflexivity --------------------------- 2.1% 2.1% 7 0.396s tactic local total calls max ────────────────────────────────────────┴──────┴──────┴───────┴─────────┘ ─Pipeline.refine_reflectively_gen ------ -0.0% 94.9% 1 44.164s ├─ReflectiveTactics.do_reflective_pipel 0.0% 87.1% 1 40.552s │└ReflectiveTactics.solve_side_conditio 0.0% 86.7% 1 40.372s │ ├─ReflectiveTactics.do_reify -------- 0.0% 59.6% 1 27.740s │ │└Reify.Reify_rhs_gen --------------- 1.6% 58.9% 1 27.432s │ │ ├─Reify.do_reify_abs_goal --------- 43.3% 43.6% 2 20.312s │ │ │└Reify.do_reifyf_goal ------------ 42.5% 42.8% 108 10.328s │ │ │└eexact -------------------------- 13.2% 13.2% 108 0.072s │ │ ├─rewrite H ----------------------- 3.8% 3.8% 1 1.748s │ │ └─prove_interp_compile_correct ---- 0.0% 3.5% 1 1.616s │ │ └rewrite ?EtaInterp.InterpExprEta 3.2% 3.2% 1 1.468s │ └─ReflectiveTactics.solve_post_reifie 0.1% 27.1% 1 12.632s │ ├─UnifyAbstractReflexivity.unify_tr 18.6% 23.5% 7 3.552s │ │└unify (constr) (constr) --------- 4.3% 4.3% 5 1.068s │ └─ReflectiveTactics.unify_abstract_ 1.6% 2.4% 1 1.124s └─Glue.refine_to_reflective_glue' ----- 0.0% 7.8% 1 3.612s └Glue.zrange_to_reflective ----------- 0.0% 7.2% 1 3.332s └Glue.zrange_to_reflective_goal ------ 1.7% 5.5% 1 2.544s └pose proof (pf : Interpretation. 3.6% 3.6% 1 1.664s ─synthesize ---------------------------- 0.0% 5.1% 1 2.380s └IntegrationTestTemporaryMiscCommon.do_r 0.0% 5.0% 1 2.320s └change G' ----------------------------- 4.8% 4.8% 1 2.252s Finished transaction in 80.129 secs (74.068u,0.024s) (successful) Closed under the global context total time: 46.544s tactic local total calls max ────────────────────────────────────────┴──────┴──────┴───────┴─────────┘ ─Pipeline.refine_reflectively_gen ------ -0.0% 94.9% 1 44.164s ─ReflectiveTactics.do_reflective_pipelin 0.0% 87.1% 1 40.552s ─ReflectiveTactics.solve_side_conditions 0.0% 86.7% 1 40.372s ─ReflectiveTactics.do_reify ------------ 0.0% 59.6% 1 27.740s ─Reify.Reify_rhs_gen ------------------- 1.6% 58.9% 1 27.432s ─Reify.do_reify_abs_goal --------------- 43.3% 43.6% 2 20.312s ─Reify.do_reifyf_goal ------------------ 42.5% 42.8% 108 10.328s ─ReflectiveTactics.solve_post_reified_si 0.1% 27.1% 1 12.632s ─UnifyAbstractReflexivity.unify_transfor 18.6% 23.5% 7 3.552s ─eexact -------------------------------- 13.7% 13.7% 110 0.136s ─Glue.refine_to_reflective_glue' ------- 0.0% 7.8% 1 3.612s ─Glue.zrange_to_reflective ------------- 0.0% 7.2% 1 3.332s ─Glue.zrange_to_reflective_goal -------- 1.7% 5.5% 1 2.544s ─synthesize ---------------------------- 0.0% 5.1% 1 2.380s ─unify (constr) (constr) --------------- 5.1% 5.1% 6 1.068s ─IntegrationTestTemporaryMiscCommon.do_r 0.0% 5.0% 1 2.320s ─change G' ----------------------------- 4.8% 4.8% 1 2.252s ─rewrite H ----------------------------- 3.8% 3.8% 1 1.748s ─pose proof (pf : Interpretation.Bo 3.6% 3.6% 1 1.664s ─prove_interp_compile_correct ---------- 0.0% 3.5% 1 1.616s ─rewrite ?EtaInterp.InterpExprEta ------ 3.2% 3.2% 1 1.468s ─ReflectiveTactics.unify_abstract_cbv_in 1.6% 2.4% 1 1.124s ─reflexivity --------------------------- 2.1% 2.1% 7 0.396s tactic local total calls max ────────────────────────────────────────┴──────┴──────┴───────┴─────────┘ ─Pipeline.refine_reflectively_gen ------ -0.0% 94.9% 1 44.164s ├─ReflectiveTactics.do_reflective_pipel 0.0% 87.1% 1 40.552s │└ReflectiveTactics.solve_side_conditio 0.0% 86.7% 1 40.372s │ ├─ReflectiveTactics.do_reify -------- 0.0% 59.6% 1 27.740s │ │└Reify.Reify_rhs_gen --------------- 1.6% 58.9% 1 27.432s │ │ ├─Reify.do_reify_abs_goal --------- 43.3% 43.6% 2 20.312s │ │ │└Reify.do_reifyf_goal ------------ 42.5% 42.8% 108 10.328s │ │ │└eexact -------------------------- 13.2% 13.2% 108 0.072s │ │ ├─rewrite H ----------------------- 3.8% 3.8% 1 1.748s │ │ └─prove_interp_compile_correct ---- 0.0% 3.5% 1 1.616s │ │ └rewrite ?EtaInterp.InterpExprEta 3.2% 3.2% 1 1.468s │ └─ReflectiveTactics.solve_post_reifie 0.1% 27.1% 1 12.632s │ ├─UnifyAbstractReflexivity.unify_tr 18.6% 23.5% 7 3.552s │ │└unify (constr) (constr) --------- 4.3% 4.3% 5 1.068s │ └─ReflectiveTactics.unify_abstract_ 1.6% 2.4% 1 1.124s └─Glue.refine_to_reflective_glue' ----- 0.0% 7.8% 1 3.612s └Glue.zrange_to_reflective ----------- 0.0% 7.2% 1 3.332s └Glue.zrange_to_reflective_goal ------ 1.7% 5.5% 1 2.544s └pose proof (pf : Interpretation. 3.6% 3.6% 1 1.664s ─synthesize ---------------------------- 0.0% 5.1% 1 2.380s └IntegrationTestTemporaryMiscCommon.do_r 0.0% 5.0% 1 2.320s └change G' ----------------------------- 4.8% 4.8% 1 2.252s src/Specific/solinas32_2e255m765_12limbs/femul (real: 155.79, user: 143.70, sys: 0.32, mem: 1454696 ko) COQC src/Specific/NISTP256/AMD64/feoppDisplay > src/Specific/NISTP256/AMD64/feoppDisplay.log COQC src/Specific/NISTP256/AMD64/fesubDisplay > src/Specific/NISTP256/AMD64/fesubDisplay.log COQC src/Specific/X25519/C64/fesquareDisplay > src/Specific/X25519/C64/fesquareDisplay.log COQC src/Specific/X25519/C64/fesubDisplay > src/Specific/X25519/C64/fesubDisplay.log COQC src/Specific/X25519/C64/freezeDisplay > src/Specific/X25519/C64/freezeDisplay.log COQC src/Specific/solinas32_2e255m765_13limbs/femul.v Finished transaction in 61.854 secs (57.328u,0.079s) (successful) total time: 57.348s tactic local total calls max ────────────────────────────────────────┴──────┴──────┴───────┴─────────┘ ─Pipeline.refine_reflectively_gen ------ 0.0% 94.6% 1 54.224s ─ReflectiveTactics.do_reflective_pipelin 0.0% 86.2% 1 49.452s ─ReflectiveTactics.solve_side_conditions 0.0% 85.9% 1 49.264s ─ReflectiveTactics.do_reify ------------ -0.0% 57.6% 1 33.004s ─Reify.Reify_rhs_gen ------------------- 1.3% 56.9% 1 32.608s ─Reify.do_reify_abs_goal --------------- 43.1% 43.3% 2 24.840s ─Reify.do_reifyf_goal ------------------ 42.3% 42.6% 117 12.704s ─ReflectiveTactics.solve_post_reified_si 0.1% 28.4% 1 16.260s ─UnifyAbstractReflexivity.unify_transfor 19.6% 25.0% 7 4.824s ─eexact -------------------------------- 13.9% 13.9% 119 0.144s ─Glue.refine_to_reflective_glue' ------- 0.0% 8.3% 1 4.772s ─Glue.zrange_to_reflective ------------- 0.0% 7.8% 1 4.484s ─Glue.zrange_to_reflective_goal -------- 1.7% 6.0% 1 3.464s ─synthesize ---------------------------- 0.0% 5.4% 1 3.124s ─unify (constr) (constr) --------------- 5.4% 5.4% 6 1.540s ─IntegrationTestTemporaryMiscCommon.do_r 0.0% 5.3% 1 3.040s ─change G' ----------------------------- 5.2% 5.2% 1 2.964s ─pose proof (pf : Interpretation.Bo 4.2% 4.2% 1 2.416s ─prove_interp_compile_correct ---------- 0.0% 3.3% 1 1.904s ─rewrite H ----------------------------- 3.3% 3.3% 1 1.896s ─rewrite ?EtaInterp.InterpExprEta ------ 3.0% 3.0% 1 1.732s ─ReflectiveTactics.unify_abstract_cbv_in 1.4% 2.1% 1 1.212s tactic local total calls max ────────────────────────────────────────┴──────┴──────┴───────┴─────────┘ ─Pipeline.refine_reflectively_gen ------ 0.0% 94.6% 1 54.224s ├─ReflectiveTactics.do_reflective_pipel 0.0% 86.2% 1 49.452s │└ReflectiveTactics.solve_side_conditio 0.0% 85.9% 1 49.264s │ ├─ReflectiveTactics.do_reify -------- -0.0% 57.6% 1 33.004s │ │└Reify.Reify_rhs_gen --------------- 1.3% 56.9% 1 32.608s │ │ ├─Reify.do_reify_abs_goal --------- 43.1% 43.3% 2 24.840s │ │ │└Reify.do_reifyf_goal ------------ 42.3% 42.6% 117 12.704s │ │ │└eexact -------------------------- 13.4% 13.4% 117 0.084s │ │ ├─prove_interp_compile_correct ---- 0.0% 3.3% 1 1.904s │ │ │└rewrite ?EtaInterp.InterpExprEta 3.0% 3.0% 1 1.732s │ │ └─rewrite H ----------------------- 3.3% 3.3% 1 1.896s │ └─ReflectiveTactics.solve_post_reifie 0.1% 28.4% 1 16.260s │ ├─UnifyAbstractReflexivity.unify_tr 19.6% 25.0% 7 4.824s │ │└unify (constr) (constr) --------- 4.8% 4.8% 5 1.540s │ └─ReflectiveTactics.unify_abstract_ 1.4% 2.1% 1 1.212s └─Glue.refine_to_reflective_glue' ----- 0.0% 8.3% 1 4.772s └Glue.zrange_to_reflective ----------- 0.0% 7.8% 1 4.484s └Glue.zrange_to_reflective_goal ------ 1.7% 6.0% 1 3.464s └pose proof (pf : Interpretation. 4.2% 4.2% 1 2.416s ─synthesize ---------------------------- 0.0% 5.4% 1 3.124s └IntegrationTestTemporaryMiscCommon.do_r 0.0% 5.3% 1 3.040s └change G' ----------------------------- 5.2% 5.2% 1 2.964s Finished transaction in 94.432 secs (86.96u,0.02s) (successful) Closed under the global context total time: 57.348s tactic local total calls max ────────────────────────────────────────┴──────┴──────┴───────┴─────────┘ ─Pipeline.refine_reflectively_gen ------ 0.0% 94.6% 1 54.224s ─ReflectiveTactics.do_reflective_pipelin 0.0% 86.2% 1 49.452s ─ReflectiveTactics.solve_side_conditions 0.0% 85.9% 1 49.264s ─ReflectiveTactics.do_reify ------------ -0.0% 57.6% 1 33.004s ─Reify.Reify_rhs_gen ------------------- 1.3% 56.9% 1 32.608s ─Reify.do_reify_abs_goal --------------- 43.1% 43.3% 2 24.840s ─Reify.do_reifyf_goal ------------------ 42.3% 42.6% 117 12.704s ─ReflectiveTactics.solve_post_reified_si 0.1% 28.4% 1 16.260s ─UnifyAbstractReflexivity.unify_transfor 19.6% 25.0% 7 4.824s ─eexact -------------------------------- 13.9% 13.9% 119 0.144s ─Glue.refine_to_reflective_glue' ------- 0.0% 8.3% 1 4.772s ─Glue.zrange_to_reflective ------------- 0.0% 7.8% 1 4.484s ─Glue.zrange_to_reflective_goal -------- 1.7% 6.0% 1 3.464s ─synthesize ---------------------------- 0.0% 5.4% 1 3.124s ─unify (constr) (constr) --------------- 5.4% 5.4% 6 1.540s ─IntegrationTestTemporaryMiscCommon.do_r 0.0% 5.3% 1 3.040s ─change G' ----------------------------- 5.2% 5.2% 1 2.964s ─pose proof (pf : Interpretation.Bo 4.2% 4.2% 1 2.416s ─prove_interp_compile_correct ---------- 0.0% 3.3% 1 1.904s ─rewrite H ----------------------------- 3.3% 3.3% 1 1.896s ─rewrite ?EtaInterp.InterpExprEta ------ 3.0% 3.0% 1 1.732s ─ReflectiveTactics.unify_abstract_cbv_in 1.4% 2.1% 1 1.212s tactic local total calls max ────────────────────────────────────────┴──────┴──────┴───────┴─────────┘ ─Pipeline.refine_reflectively_gen ------ 0.0% 94.6% 1 54.224s ├─ReflectiveTactics.do_reflective_pipel 0.0% 86.2% 1 49.452s │└ReflectiveTactics.solve_side_conditio 0.0% 85.9% 1 49.264s │ ├─ReflectiveTactics.do_reify -------- -0.0% 57.6% 1 33.004s │ │└Reify.Reify_rhs_gen --------------- 1.3% 56.9% 1 32.608s │ │ ├─Reify.do_reify_abs_goal --------- 43.1% 43.3% 2 24.840s │ │ │└Reify.do_reifyf_goal ------------ 42.3% 42.6% 117 12.704s │ │ │└eexact -------------------------- 13.4% 13.4% 117 0.084s │ │ ├─prove_interp_compile_correct ---- 0.0% 3.3% 1 1.904s │ │ │└rewrite ?EtaInterp.InterpExprEta 3.0% 3.0% 1 1.732s │ │ └─rewrite H ----------------------- 3.3% 3.3% 1 1.896s │ └─ReflectiveTactics.solve_post_reifie 0.1% 28.4% 1 16.260s │ ├─UnifyAbstractReflexivity.unify_tr 19.6% 25.0% 7 4.824s │ │└unify (constr) (constr) --------- 4.8% 4.8% 5 1.540s │ └─ReflectiveTactics.unify_abstract_ 1.4% 2.1% 1 1.212s └─Glue.refine_to_reflective_glue' ----- 0.0% 8.3% 1 4.772s └Glue.zrange_to_reflective ----------- 0.0% 7.8% 1 4.484s └Glue.zrange_to_reflective_goal ------ 1.7% 6.0% 1 3.464s └pose proof (pf : Interpretation. 4.2% 4.2% 1 2.416s ─synthesize ---------------------------- 0.0% 5.4% 1 3.124s └IntegrationTestTemporaryMiscCommon.do_r 0.0% 5.3% 1 3.040s └change G' ----------------------------- 5.2% 5.2% 1 2.964s src/Specific/solinas32_2e255m765_13limbs/femul (real: 181.77, user: 168.52, sys: 0.40, mem: 1589516 ko) COQC src/Specific/NISTP256/AMD64/femul.v Finished transaction in 119.257 secs (109.936u,0.256s) (successful) total time: 110.140s tactic local total calls max ────────────────────────────────────────┴──────┴──────┴───────┴─────────┘ ─Pipeline.refine_reflectively_gen ------ 0.0% 97.1% 1 106.964s ─ReflectiveTactics.do_reflective_pipelin -0.0% 96.4% 1 106.196s ─ReflectiveTactics.solve_side_conditions 0.0% 96.2% 1 105.992s ─ReflectiveTactics.do_reify ------------ -0.0% 83.7% 1 92.208s ─Reify.Reify_rhs_gen ------------------- 0.7% 83.5% 1 91.960s ─Reify.do_reify_abs_goal --------------- 77.7% 77.8% 2 85.708s ─Reify.do_reifyf_goal ------------------ 77.4% 77.5% 901 85.364s ─eexact -------------------------------- 17.9% 17.9% 903 0.136s ─ReflectiveTactics.solve_post_reified_si 0.3% 12.5% 1 13.784s ─UnifyAbstractReflexivity.unify_transfor 9.8% 11.2% 7 3.356s ─synthesize_montgomery ----------------- 0.0% 2.9% 1 3.176s tactic local total calls max ────────────────────────────────────────┴──────┴──────┴───────┴─────────┘ ─Pipeline.refine_reflectively_gen ------ 0.0% 97.1% 1 106.964s └ReflectiveTactics.do_reflective_pipelin -0.0% 96.4% 1 106.196s └ReflectiveTactics.solve_side_conditions 0.0% 96.2% 1 105.992s ├─ReflectiveTactics.do_reify ---------- -0.0% 83.7% 1 92.208s │└Reify.Reify_rhs_gen ----------------- 0.7% 83.5% 1 91.960s │└Reify.do_reify_abs_goal ------------- 77.7% 77.8% 2 85.708s │└Reify.do_reifyf_goal ---------------- 77.4% 77.5% 901 85.364s │└eexact ------------------------------ 17.7% 17.7% 901 0.136s └─ReflectiveTactics.solve_post_reified_ 0.3% 12.5% 1 13.784s └UnifyAbstractReflexivity.unify_transf 9.8% 11.2% 7 3.356s ─synthesize_montgomery ----------------- 0.0% 2.9% 1 3.176s Finished transaction in 61.452 secs (58.503u,0.055s) (successful) Closed under the global context total time: 110.140s tactic local total calls max ────────────────────────────────────────┴──────┴──────┴───────┴─────────┘ ─Pipeline.refine_reflectively_gen ------ 0.0% 97.1% 1 106.964s ─ReflectiveTactics.do_reflective_pipelin -0.0% 96.4% 1 106.196s ─ReflectiveTactics.solve_side_conditions 0.0% 96.2% 1 105.992s ─ReflectiveTactics.do_reify ------------ -0.0% 83.7% 1 92.208s ─Reify.Reify_rhs_gen ------------------- 0.7% 83.5% 1 91.960s ─Reify.do_reify_abs_goal --------------- 77.7% 77.8% 2 85.708s ─Reify.do_reifyf_goal ------------------ 77.4% 77.5% 901 85.364s ─eexact -------------------------------- 17.9% 17.9% 903 0.136s ─ReflectiveTactics.solve_post_reified_si 0.3% 12.5% 1 13.784s ─UnifyAbstractReflexivity.unify_transfor 9.8% 11.2% 7 3.356s ─synthesize_montgomery ----------------- 0.0% 2.9% 1 3.176s tactic local total calls max ────────────────────────────────────────┴──────┴──────┴───────┴─────────┘ ─Pipeline.refine_reflectively_gen ------ 0.0% 97.1% 1 106.964s └ReflectiveTactics.do_reflective_pipelin -0.0% 96.4% 1 106.196s └ReflectiveTactics.solve_side_conditions 0.0% 96.2% 1 105.992s ├─ReflectiveTactics.do_reify ---------- -0.0% 83.7% 1 92.208s │└Reify.Reify_rhs_gen ----------------- 0.7% 83.5% 1 91.960s │└Reify.do_reify_abs_goal ------------- 77.7% 77.8% 2 85.708s │└Reify.do_reifyf_goal ---------------- 77.4% 77.5% 901 85.364s │└eexact ------------------------------ 17.7% 17.7% 901 0.136s └─ReflectiveTactics.solve_post_reified_ 0.3% 12.5% 1 13.784s └UnifyAbstractReflexivity.unify_transf 9.8% 11.2% 7 3.356s ─synthesize_montgomery ----------------- 0.0% 2.9% 1 3.176s src/Specific/NISTP256/AMD64/femul (real: 202.96, user: 189.62, sys: 0.64, mem: 3302508 ko) COQC src/Specific/NISTP256/AMD64/femulDisplay > src/Specific/NISTP256/AMD64/femulDisplay.log COQC src/Specific/X25519/C64/ladderstep.v total time: 52.080s tactic local total calls max ────────────────────────────────────────┴──────┴──────┴───────┴─────────┘ ─synthesize_xzladderstep --------------- 0.0% 100.0% 1 52.080s ─Pipeline.refine_reflectively_gen ------ 0.0% 98.5% 1 51.320s ─ReflectiveTactics.do_reflective_pipelin 0.0% 93.8% 1 48.872s ─ReflectiveTactics.solve_side_conditions 0.0% 93.7% 1 48.776s ─ReflectiveTactics.solve_post_reified_si 0.2% 56.5% 1 29.412s ─UnifyAbstractReflexivity.unify_transfor 44.7% 49.1% 7 6.968s ─ReflectiveTactics.do_reify ------------ 0.0% 37.2% 1 19.364s ─Reify.Reify_rhs_gen ------------------- 2.1% 23.4% 1 12.200s ─Reify.do_reifyf_goal ------------------ 11.2% 11.3% 138 1.884s ─Compilers.Reify.reify_context_variables 0.1% 9.2% 1 4.808s ─rewrite H ----------------------------- 7.3% 7.3% 1 3.816s ─ReflectiveTactics.unify_abstract_cbv_in 4.7% 6.4% 1 3.336s ─Glue.refine_to_reflective_glue' ------- 0.0% 4.7% 1 2.448s ─Glue.zrange_to_reflective ------------- 0.0% 4.0% 1 2.068s ─Reify.transitivity_tt ----------------- 0.1% 3.7% 2 0.984s ─transitivity -------------------------- 3.5% 3.5% 10 0.880s ─reflexivity --------------------------- 3.4% 3.4% 11 0.772s ─Glue.zrange_to_reflective_goal -------- 2.4% 3.3% 1 1.728s ─eexact -------------------------------- 3.2% 3.2% 140 0.032s ─unify (constr) (constr) --------------- 3.1% 3.1% 6 0.852s ─clear (var_list) ---------------------- 3.1% 3.1% 98 0.584s ─UnfoldArg.unfold_second_arg ----------- 0.4% 3.0% 2 1.576s ─tac ----------------------------------- 2.1% 3.0% 2 1.564s ─ClearAll.clear_all -------------------- 0.2% 2.8% 7 0.584s ─ChangeInAll.change_with_compute_in_all 0.0% 2.6% 221 0.012s ─change c with c' in * ----------------- 2.5% 2.5% 221 0.012s ─Reify.do_reify_abs_goal --------------- 2.4% 2.5% 2 1.276s tactic local total calls max ────────────────────────────────────────┴──────┴──────┴───────┴─────────┘ ─synthesize_xzladderstep --------------- 0.0% 100.0% 1 52.080s └Pipeline.refine_reflectively_gen ------ 0.0% 98.5% 1 51.320s ├─ReflectiveTactics.do_reflective_pipel 0.0% 93.8% 1 48.872s │└ReflectiveTactics.solve_side_conditio 0.0% 93.7% 1 48.776s │ ├─ReflectiveTactics.solve_post_reifie 0.2% 56.5% 1 29.412s │ │ ├─UnifyAbstractReflexivity.unify_tr 44.7% 49.1% 7 6.968s │ │ │└ClearAll.clear_all -------------- 0.2% 2.8% 7 0.584s │ │ │└clear (var_list) ---------------- 2.7% 2.7% 65 0.584s │ │ └─ReflectiveTactics.unify_abstract_ 4.7% 6.4% 1 3.336s │ └─ReflectiveTactics.do_reify -------- 0.0% 37.2% 1 19.364s │ ├─Reify.Reify_rhs_gen ------------- 2.1% 23.4% 1 12.200s │ │ ├─rewrite H --------------------- 7.3% 7.3% 1 3.816s │ │ ├─Reify.transitivity_tt --------- 0.1% 3.7% 2 0.984s │ │ │└transitivity ------------------ 3.4% 3.4% 4 0.880s │ │ ├─tac --------------------------- 2.1% 3.0% 1 1.564s │ │ └─Reify.do_reify_abs_goal ------- 2.4% 2.5% 2 1.276s │ │ └Reify.do_reifyf_goal ---------- 2.2% 2.2% 25 1.148s │ ├─Compilers.Reify.reify_context_var 0.1% 9.2% 1 4.808s │ │└Reify.do_reifyf_goal ------------ 9.0% 9.1% 113 1.884s │ │└eexact -------------------------- 2.4% 2.4% 113 0.032s │ └─UnfoldArg.unfold_second_arg ----- 0.4% 3.0% 2 1.576s │ └ChangeInAll.change_with_compute_i 0.0% 2.6% 221 0.012s │ └change c with c' in * ----------- 2.5% 2.5% 221 0.012s └─Glue.refine_to_reflective_glue' ----- 0.0% 4.7% 1 2.448s └Glue.zrange_to_reflective ----------- 0.0% 4.0% 1 2.068s └Glue.zrange_to_reflective_goal ------ 2.4% 3.3% 1 1.728s Finished transaction in 171.122 secs (161.392u,0.039s) (successful) Closed under the global context total time: 52.080s tactic local total calls max ────────────────────────────────────────┴──────┴──────┴───────┴─────────┘ ─synthesize_xzladderstep --------------- 0.0% 100.0% 1 52.080s ─Pipeline.refine_reflectively_gen ------ 0.0% 98.5% 1 51.320s ─ReflectiveTactics.do_reflective_pipelin 0.0% 93.8% 1 48.872s ─ReflectiveTactics.solve_side_conditions 0.0% 93.7% 1 48.776s ─ReflectiveTactics.solve_post_reified_si 0.2% 56.5% 1 29.412s ─UnifyAbstractReflexivity.unify_transfor 44.7% 49.1% 7 6.968s ─ReflectiveTactics.do_reify ------------ 0.0% 37.2% 1 19.364s ─Reify.Reify_rhs_gen ------------------- 2.1% 23.4% 1 12.200s ─Reify.do_reifyf_goal ------------------ 11.2% 11.3% 138 1.884s ─Compilers.Reify.reify_context_variables 0.1% 9.2% 1 4.808s ─rewrite H ----------------------------- 7.3% 7.3% 1 3.816s ─ReflectiveTactics.unify_abstract_cbv_in 4.7% 6.4% 1 3.336s ─Glue.refine_to_reflective_glue' ------- 0.0% 4.7% 1 2.448s ─Glue.zrange_to_reflective ------------- 0.0% 4.0% 1 2.068s ─Reify.transitivity_tt ----------------- 0.1% 3.7% 2 0.984s ─transitivity -------------------------- 3.5% 3.5% 10 0.880s ─reflexivity --------------------------- 3.4% 3.4% 11 0.772s ─Glue.zrange_to_reflective_goal -------- 2.4% 3.3% 1 1.728s ─eexact -------------------------------- 3.2% 3.2% 140 0.032s ─unify (constr) (constr) --------------- 3.1% 3.1% 6 0.852s ─clear (var_list) ---------------------- 3.1% 3.1% 98 0.584s ─UnfoldArg.unfold_second_arg ----------- 0.4% 3.0% 2 1.576s ─tac ----------------------------------- 2.1% 3.0% 2 1.564s ─ClearAll.clear_all -------------------- 0.2% 2.8% 7 0.584s ─ChangeInAll.change_with_compute_in_all 0.0% 2.6% 221 0.012s ─change c with c' in * ----------------- 2.5% 2.5% 221 0.012s ─Reify.do_reify_abs_goal --------------- 2.4% 2.5% 2 1.276s tactic local total calls max ────────────────────────────────────────┴──────┴──────┴───────┴─────────┘ ─synthesize_xzladderstep --------------- 0.0% 100.0% 1 52.080s └Pipeline.refine_reflectively_gen ------ 0.0% 98.5% 1 51.320s ├─ReflectiveTactics.do_reflective_pipel 0.0% 93.8% 1 48.872s │└ReflectiveTactics.solve_side_conditio 0.0% 93.7% 1 48.776s │ ├─ReflectiveTactics.solve_post_reifie 0.2% 56.5% 1 29.412s │ │ ├─UnifyAbstractReflexivity.unify_tr 44.7% 49.1% 7 6.968s │ │ │└ClearAll.clear_all -------------- 0.2% 2.8% 7 0.584s │ │ │└clear (var_list) ---------------- 2.7% 2.7% 65 0.584s │ │ └─ReflectiveTactics.unify_abstract_ 4.7% 6.4% 1 3.336s │ └─ReflectiveTactics.do_reify -------- 0.0% 37.2% 1 19.364s │ ├─Reify.Reify_rhs_gen ------------- 2.1% 23.4% 1 12.200s │ │ ├─rewrite H --------------------- 7.3% 7.3% 1 3.816s │ │ ├─Reify.transitivity_tt --------- 0.1% 3.7% 2 0.984s │ │ │└transitivity ------------------ 3.4% 3.4% 4 0.880s │ │ ├─tac --------------------------- 2.1% 3.0% 1 1.564s │ │ └─Reify.do_reify_abs_goal ------- 2.4% 2.5% 2 1.276s │ │ └Reify.do_reifyf_goal ---------- 2.2% 2.2% 25 1.148s │ ├─Compilers.Reify.reify_context_var 0.1% 9.2% 1 4.808s │ │└Reify.do_reifyf_goal ------------ 9.0% 9.1% 113 1.884s │ │└eexact -------------------------- 2.4% 2.4% 113 0.032s │ └─UnfoldArg.unfold_second_arg ----- 0.4% 3.0% 2 1.576s │ └ChangeInAll.change_with_compute_i 0.0% 2.6% 221 0.012s │ └change c with c' in * ----------- 2.5% 2.5% 221 0.012s └─Glue.refine_to_reflective_glue' ----- 0.0% 4.7% 1 2.448s └Glue.zrange_to_reflective ----------- 0.0% 4.0% 1 2.068s └Glue.zrange_to_reflective_goal ------ 2.4% 3.3% 1 1.728s src/Specific/X25519/C64/ladderstep (real: 256.77, user: 241.34, sys: 0.45, mem: 1617000 ko) COQC src/Specific/X25519/C64/ladderstepDisplay > src/Specific/X25519/C64/ladderstepDisplay.log coq-8.20.0/test-suite/precomputed-time-tests/correct-diff-sorting-order/time-of-build-before.log.in000066400000000000000000003660331466560755400333210ustar00rootroot00000000000000COQDEP src/Compilers/Z/Bounds/Pipeline/Definition.v COQDEP src/Compilers/Z/Bounds/Pipeline/ReflectiveTactics.v /home/jgross/.local64/coq/coq-master/bin/coq_makefile -f _CoqProject INSTALLDEFAULTROOT = Crypto -o Makefile-old COQ_MAKEFILE -f _CoqProject > Makefile.coq make --no-print-directory -C coqprime make[1]: Nothing to be done for 'all'. ECHO > _CoqProject COQC src/Compilers/Z/Bounds/Pipeline/Definition.v src/Compilers/Z/Bounds/Pipeline/Definition (real: 7.40, user: 7.22, sys: 0.15, mem: 578344 ko) COQC src/Compilers/Z/Bounds/Pipeline/ReflectiveTactics.v src/Compilers/Z/Bounds/Pipeline/ReflectiveTactics (real: 1.73, user: 1.58, sys: 0.14, mem: 546112 ko) COQC src/Compilers/Z/Bounds/Pipeline.v src/Compilers/Z/Bounds/Pipeline (real: 1.18, user: 1.04, sys: 0.14, mem: 539160 ko) COQC src/Specific/Framework/SynthesisFramework.v src/Specific/Framework/SynthesisFramework (real: 1.95, user: 1.72, sys: 0.22, mem: 648632 ko) COQC src/Specific/X25519/C64/Synthesis.v src/Specific/X25519/C64/Synthesis (real: 11.23, user: 10.30, sys: 0.19, mem: 687812 ko) COQC src/Specific/NISTP256/AMD64/Synthesis.v src/Specific/NISTP256/AMD64/Synthesis (real: 13.74, user: 12.54, sys: 0.23, mem: 667664 ko) COQC src/Specific/X25519/C64/feadd.v Finished transaction in 2.852 secs (2.699u,0.012s) (successful) total time: 2.664s tactic local total calls max ────────────────────────────────────────┴──────┴──────┴───────┴─────────┘ ─Pipeline.refine_reflectively_gen ------ 0.0% 97.4% 1 2.596s ─ReflectiveTactics.do_reflective_pipelin 0.0% 70.9% 1 1.888s ─ReflectiveTactics.solve_side_conditions 0.0% 69.5% 1 1.852s ─ReflectiveTactics.solve_post_reified_si 1.4% 43.7% 1 1.164s ─UnifyAbstractReflexivity.unify_transfor 27.0% 31.7% 8 0.256s ─Glue.refine_to_reflective_glue' ------- 0.0% 26.6% 1 0.708s ─ReflectiveTactics.do_reify ------------ 0.0% 25.8% 1 0.688s ─Reify.Reify_rhs_gen ------------------- 2.0% 24.0% 1 0.640s ─Glue.zrange_to_reflective ------------- 0.0% 17.9% 1 0.476s ─Glue.zrange_to_reflective_goal -------- 8.1% 13.1% 1 0.348s ─Reify.do_reify_abs_goal --------------- 12.8% 12.9% 2 0.344s ─Reify.do_reifyf_goal ------------------ 11.7% 11.9% 16 0.316s ─ReflectiveTactics.unify_abstract_cbv_in 7.7% 10.2% 1 0.272s ─unify (constr) (constr) --------------- 6.0% 6.0% 7 0.064s ─Glue.pattern_sig_sig_assoc ------------ 0.0% 5.0% 1 0.132s ─assert (H : is_bounded_by' bounds (map' 4.5% 4.7% 2 0.068s ─Glue.pattern_proj1_sig_in_sig --------- 1.5% 4.7% 1 0.124s ─pose proof (pf : Interpretation.Bo 3.3% 3.3% 1 0.088s ─Glue.split_BoundedWordToZ ------------- 0.2% 3.0% 1 0.080s ─destruct x ---------------------------- 2.7% 2.7% 4 0.032s ─clearbody (ne_var_list) --------------- 2.7% 2.7% 4 0.056s ─destruct_sig -------------------------- 0.0% 2.7% 4 0.040s ─synthesize ---------------------------- 0.0% 2.6% 1 0.068s ─prove_interp_compile_correct ---------- 0.0% 2.4% 1 0.064s ─reflexivity --------------------------- 2.3% 2.3% 7 0.028s ─rewrite ?EtaInterp.InterpExprEta ------ 2.3% 2.3% 1 0.060s ─ClearbodyAll.clearbody_all ------------ 0.0% 2.1% 2 0.056s tactic local total calls max ────────────────────────────────────────┴──────┴──────┴───────┴─────────┘ ─Pipeline.refine_reflectively_gen ------ 0.0% 97.4% 1 2.596s ├─ReflectiveTactics.do_reflective_pipel 0.0% 70.9% 1 1.888s │└ReflectiveTactics.solve_side_conditio 0.0% 69.5% 1 1.852s │ ├─ReflectiveTactics.solve_post_reifie 1.4% 43.7% 1 1.164s │ │ ├─UnifyAbstractReflexivity.unify_tr 27.0% 31.7% 8 0.256s │ │ │└unify (constr) (constr) --------- 3.6% 3.6% 6 0.028s │ │ └─ReflectiveTactics.unify_abstract_ 7.7% 10.2% 1 0.272s │ │ └unify (constr) (constr) --------- 2.4% 2.4% 1 0.064s │ └─ReflectiveTactics.do_reify -------- 0.0% 25.8% 1 0.688s │ └Reify.Reify_rhs_gen --------------- 2.0% 24.0% 1 0.640s │ ├─Reify.do_reify_abs_goal --------- 12.8% 12.9% 2 0.344s │ │└Reify.do_reifyf_goal ------------ 11.7% 11.9% 16 0.316s │ └─prove_interp_compile_correct ---- 0.0% 2.4% 1 0.064s │ └rewrite ?EtaInterp.InterpExprEta 2.3% 2.3% 1 0.060s └─Glue.refine_to_reflective_glue' ----- 0.0% 26.6% 1 0.708s ├─Glue.zrange_to_reflective --------- 0.0% 17.9% 1 0.476s │ ├─Glue.zrange_to_reflective_goal -- 8.1% 13.1% 1 0.348s │ │└pose proof (pf : Interpretat 3.3% 3.3% 1 0.088s │ └─assert (H : is_bounded_by' bounds 4.5% 4.7% 2 0.068s ├─Glue.pattern_sig_sig_assoc -------- 0.0% 5.0% 1 0.132s │└Glue.pattern_proj1_sig_in_sig ----- 1.5% 4.7% 1 0.124s │└ClearbodyAll.clearbody_all -------- 0.0% 2.1% 2 0.056s │└clearbody (ne_var_list) ----------- 2.1% 2.1% 1 0.056s └─Glue.split_BoundedWordToZ --------- 0.2% 3.0% 1 0.080s └destruct_sig ---------------------- 0.0% 2.7% 4 0.040s └destruct x ------------------------ 2.1% 2.1% 2 0.032s ─synthesize ---------------------------- 0.0% 2.6% 1 0.068s Finished transaction in 5.46 secs (5.068u,0.003s) (successful) Closed under the global context total time: 2.664s tactic local total calls max ────────────────────────────────────────┴──────┴──────┴───────┴─────────┘ ─Pipeline.refine_reflectively_gen ------ 0.0% 97.4% 1 2.596s ─ReflectiveTactics.do_reflective_pipelin 0.0% 70.9% 1 1.888s ─ReflectiveTactics.solve_side_conditions 0.0% 69.5% 1 1.852s ─ReflectiveTactics.solve_post_reified_si 1.4% 43.7% 1 1.164s ─UnifyAbstractReflexivity.unify_transfor 27.0% 31.7% 8 0.256s ─Glue.refine_to_reflective_glue' ------- 0.0% 26.6% 1 0.708s ─ReflectiveTactics.do_reify ------------ 0.0% 25.8% 1 0.688s ─Reify.Reify_rhs_gen ------------------- 2.0% 24.0% 1 0.640s ─Glue.zrange_to_reflective ------------- 0.0% 17.9% 1 0.476s ─Glue.zrange_to_reflective_goal -------- 8.1% 13.1% 1 0.348s ─Reify.do_reify_abs_goal --------------- 12.8% 12.9% 2 0.344s ─Reify.do_reifyf_goal ------------------ 11.7% 11.9% 16 0.316s ─ReflectiveTactics.unify_abstract_cbv_in 7.7% 10.2% 1 0.272s ─unify (constr) (constr) --------------- 6.0% 6.0% 7 0.064s ─Glue.pattern_sig_sig_assoc ------------ 0.0% 5.0% 1 0.132s ─assert (H : is_bounded_by' bounds (map' 4.5% 4.7% 2 0.068s ─Glue.pattern_proj1_sig_in_sig --------- 1.5% 4.7% 1 0.124s ─pose proof (pf : Interpretation.Bo 3.3% 3.3% 1 0.088s ─Glue.split_BoundedWordToZ ------------- 0.2% 3.0% 1 0.080s ─destruct x ---------------------------- 2.7% 2.7% 4 0.032s ─clearbody (ne_var_list) --------------- 2.7% 2.7% 4 0.056s ─destruct_sig -------------------------- 0.0% 2.7% 4 0.040s ─synthesize ---------------------------- 0.0% 2.6% 1 0.068s ─prove_interp_compile_correct ---------- 0.0% 2.4% 1 0.064s ─reflexivity --------------------------- 2.3% 2.3% 7 0.028s ─rewrite ?EtaInterp.InterpExprEta ------ 2.3% 2.3% 1 0.060s ─ClearbodyAll.clearbody_all ------------ 0.0% 2.1% 2 0.056s tactic local total calls max ────────────────────────────────────────┴──────┴──────┴───────┴─────────┘ ─Pipeline.refine_reflectively_gen ------ 0.0% 97.4% 1 2.596s ├─ReflectiveTactics.do_reflective_pipel 0.0% 70.9% 1 1.888s │└ReflectiveTactics.solve_side_conditio 0.0% 69.5% 1 1.852s │ ├─ReflectiveTactics.solve_post_reifie 1.4% 43.7% 1 1.164s │ │ ├─UnifyAbstractReflexivity.unify_tr 27.0% 31.7% 8 0.256s │ │ │└unify (constr) (constr) --------- 3.6% 3.6% 6 0.028s │ │ └─ReflectiveTactics.unify_abstract_ 7.7% 10.2% 1 0.272s │ │ └unify (constr) (constr) --------- 2.4% 2.4% 1 0.064s │ └─ReflectiveTactics.do_reify -------- 0.0% 25.8% 1 0.688s │ └Reify.Reify_rhs_gen --------------- 2.0% 24.0% 1 0.640s │ ├─Reify.do_reify_abs_goal --------- 12.8% 12.9% 2 0.344s │ │└Reify.do_reifyf_goal ------------ 11.7% 11.9% 16 0.316s │ └─prove_interp_compile_correct ---- 0.0% 2.4% 1 0.064s │ └rewrite ?EtaInterp.InterpExprEta 2.3% 2.3% 1 0.060s └─Glue.refine_to_reflective_glue' ----- 0.0% 26.6% 1 0.708s ├─Glue.zrange_to_reflective --------- 0.0% 17.9% 1 0.476s │ ├─Glue.zrange_to_reflective_goal -- 8.1% 13.1% 1 0.348s │ │└pose proof (pf : Interpretat 3.3% 3.3% 1 0.088s │ └─assert (H : is_bounded_by' bounds 4.5% 4.7% 2 0.068s ├─Glue.pattern_sig_sig_assoc -------- 0.0% 5.0% 1 0.132s │└Glue.pattern_proj1_sig_in_sig ----- 1.5% 4.7% 1 0.124s │└ClearbodyAll.clearbody_all -------- 0.0% 2.1% 2 0.056s │└clearbody (ne_var_list) ----------- 2.1% 2.1% 1 0.056s └─Glue.split_BoundedWordToZ --------- 0.2% 3.0% 1 0.080s └destruct_sig ---------------------- 0.0% 2.7% 4 0.040s └destruct x ------------------------ 2.1% 2.1% 2 0.032s ─synthesize ---------------------------- 0.0% 2.6% 1 0.068s src/Specific/X25519/C64/feadd (real: 23.43, user: 21.41, sys: 0.26, mem: 766168 ko) COQC src/Specific/solinas32_2e255m765_12limbs/Synthesis.v src/Specific/solinas32_2e255m765_12limbs/Synthesis (real: 39.53, user: 36.64, sys: 0.21, mem: 729464 ko) COQC src/Specific/X25519/C64/fecarry.v Finished transaction in 4.798 secs (4.375u,0.003s) (successful) total time: 4.332s tactic local total calls max ────────────────────────────────────────┴──────┴──────┴───────┴─────────┘ ─Pipeline.refine_reflectively_gen ------ 0.1% 99.0% 1 4.288s ─ReflectiveTactics.do_reflective_pipelin 0.0% 89.2% 1 3.864s ─ReflectiveTactics.solve_side_conditions 0.0% 88.1% 1 3.816s ─ReflectiveTactics.do_reify ------------ 0.0% 53.2% 1 2.304s ─Reify.Reify_rhs_gen ------------------- 1.8% 52.6% 1 2.280s ─ReflectiveTactics.solve_post_reified_si 0.6% 34.9% 1 1.512s ─Reify.do_reify_abs_goal --------------- 33.5% 33.9% 2 1.468s ─Reify.do_reifyf_goal ------------------ 32.1% 32.5% 29 1.408s ─UnifyAbstractReflexivity.unify_transfor 22.5% 27.1% 8 0.316s ─Glue.refine_to_reflective_glue' ------- 0.1% 9.7% 1 0.420s ─eexact -------------------------------- 9.3% 9.3% 31 0.024s ─ReflectiveTactics.unify_abstract_cbv_in 5.2% 7.0% 1 0.304s ─Glue.zrange_to_reflective ------------- 0.1% 6.2% 1 0.268s ─prove_interp_compile_correct ---------- 0.0% 5.6% 1 0.244s ─rewrite ?EtaInterp.InterpExprEta ------ 5.3% 5.3% 1 0.228s ─unify (constr) (constr) --------------- 5.3% 5.3% 7 0.076s ─Glue.zrange_to_reflective_goal -------- 4.0% 4.9% 1 0.212s ─rewrite H ----------------------------- 3.4% 3.4% 1 0.148s ─tac ----------------------------------- 1.8% 2.6% 2 0.112s tactic local total calls max ────────────────────────────────────────┴──────┴──────┴───────┴─────────┘ ─Pipeline.refine_reflectively_gen ------ 0.1% 99.0% 1 4.288s ├─ReflectiveTactics.do_reflective_pipel 0.0% 89.2% 1 3.864s │└ReflectiveTactics.solve_side_conditio 0.0% 88.1% 1 3.816s │ ├─ReflectiveTactics.do_reify -------- 0.0% 53.2% 1 2.304s │ │└Reify.Reify_rhs_gen --------------- 1.8% 52.6% 1 2.280s │ │ ├─Reify.do_reify_abs_goal --------- 33.5% 33.9% 2 1.468s │ │ │└Reify.do_reifyf_goal ------------ 32.1% 32.5% 29 1.408s │ │ │└eexact -------------------------- 8.6% 8.6% 29 0.024s │ │ ├─prove_interp_compile_correct ---- 0.0% 5.6% 1 0.244s │ │ │└rewrite ?EtaInterp.InterpExprEta 5.3% 5.3% 1 0.228s │ │ ├─rewrite H ----------------------- 3.4% 3.4% 1 0.148s │ │ └─tac ----------------------------- 1.8% 2.6% 1 0.112s │ └─ReflectiveTactics.solve_post_reifie 0.6% 34.9% 1 1.512s │ ├─UnifyAbstractReflexivity.unify_tr 22.5% 27.1% 8 0.316s │ │└unify (constr) (constr) --------- 3.5% 3.5% 6 0.044s │ └─ReflectiveTactics.unify_abstract_ 5.2% 7.0% 1 0.304s └─Glue.refine_to_reflective_glue' ----- 0.1% 9.7% 1 0.420s └Glue.zrange_to_reflective ----------- 0.1% 6.2% 1 0.268s └Glue.zrange_to_reflective_goal ------ 4.0% 4.9% 1 0.212s Finished transaction in 8.342 secs (7.604u,0.008s) (successful) Closed under the global context total time: 4.332s tactic local total calls max ────────────────────────────────────────┴──────┴──────┴───────┴─────────┘ ─Pipeline.refine_reflectively_gen ------ 0.1% 99.0% 1 4.288s ─ReflectiveTactics.do_reflective_pipelin 0.0% 89.2% 1 3.864s ─ReflectiveTactics.solve_side_conditions 0.0% 88.1% 1 3.816s ─ReflectiveTactics.do_reify ------------ 0.0% 53.2% 1 2.304s ─Reify.Reify_rhs_gen ------------------- 1.8% 52.6% 1 2.280s ─ReflectiveTactics.solve_post_reified_si 0.6% 34.9% 1 1.512s ─Reify.do_reify_abs_goal --------------- 33.5% 33.9% 2 1.468s ─Reify.do_reifyf_goal ------------------ 32.1% 32.5% 29 1.408s ─UnifyAbstractReflexivity.unify_transfor 22.5% 27.1% 8 0.316s ─Glue.refine_to_reflective_glue' ------- 0.1% 9.7% 1 0.420s ─eexact -------------------------------- 9.3% 9.3% 31 0.024s ─ReflectiveTactics.unify_abstract_cbv_in 5.2% 7.0% 1 0.304s ─Glue.zrange_to_reflective ------------- 0.1% 6.2% 1 0.268s ─prove_interp_compile_correct ---------- 0.0% 5.6% 1 0.244s ─rewrite ?EtaInterp.InterpExprEta ------ 5.3% 5.3% 1 0.228s ─unify (constr) (constr) --------------- 5.3% 5.3% 7 0.076s ─Glue.zrange_to_reflective_goal -------- 4.0% 4.9% 1 0.212s ─rewrite H ----------------------------- 3.4% 3.4% 1 0.148s ─tac ----------------------------------- 1.8% 2.6% 2 0.112s tactic local total calls max ────────────────────────────────────────┴──────┴──────┴───────┴─────────┘ ─Pipeline.refine_reflectively_gen ------ 0.1% 99.0% 1 4.288s ├─ReflectiveTactics.do_reflective_pipel 0.0% 89.2% 1 3.864s │└ReflectiveTactics.solve_side_conditio 0.0% 88.1% 1 3.816s │ ├─ReflectiveTactics.do_reify -------- 0.0% 53.2% 1 2.304s │ │└Reify.Reify_rhs_gen --------------- 1.8% 52.6% 1 2.280s │ │ ├─Reify.do_reify_abs_goal --------- 33.5% 33.9% 2 1.468s │ │ │└Reify.do_reifyf_goal ------------ 32.1% 32.5% 29 1.408s │ │ │└eexact -------------------------- 8.6% 8.6% 29 0.024s │ │ ├─prove_interp_compile_correct ---- 0.0% 5.6% 1 0.244s │ │ │└rewrite ?EtaInterp.InterpExprEta 5.3% 5.3% 1 0.228s │ │ ├─rewrite H ----------------------- 3.4% 3.4% 1 0.148s │ │ └─tac ----------------------------- 1.8% 2.6% 1 0.112s │ └─ReflectiveTactics.solve_post_reifie 0.6% 34.9% 1 1.512s │ ├─UnifyAbstractReflexivity.unify_tr 22.5% 27.1% 8 0.316s │ │└unify (constr) (constr) --------- 3.5% 3.5% 6 0.044s │ └─ReflectiveTactics.unify_abstract_ 5.2% 7.0% 1 0.304s └─Glue.refine_to_reflective_glue' ----- 0.1% 9.7% 1 0.420s └Glue.zrange_to_reflective ----------- 0.1% 6.2% 1 0.268s └Glue.zrange_to_reflective_goal ------ 4.0% 4.9% 1 0.212s src/Specific/X25519/C64/fecarry (real: 28.85, user: 26.31, sys: 0.25, mem: 787148 ko) COQC src/Specific/solinas32_2e255m765_13limbs/Synthesis.v src/Specific/solinas32_2e255m765_13limbs/Synthesis (real: 49.50, user: 45.58, sys: 0.18, mem: 744472 ko) COQC src/Specific/X25519/C64/femul.v Finished transaction in 9.325 secs (8.62u,0.016s) (successful) total time: 8.576s tactic local total calls max ────────────────────────────────────────┴──────┴──────┴───────┴─────────┘ ─Pipeline.refine_reflectively_gen ------ 0.0% 95.8% 1 8.220s ─ReflectiveTactics.do_reflective_pipelin 0.0% 87.7% 1 7.524s ─ReflectiveTactics.solve_side_conditions 0.0% 87.0% 1 7.460s ─ReflectiveTactics.do_reify ------------ 0.0% 43.8% 1 3.760s ─ReflectiveTactics.solve_post_reified_si 0.6% 43.1% 1 3.700s ─Reify.Reify_rhs_gen ------------------- 1.4% 43.0% 1 3.688s ─UnifyAbstractReflexivity.unify_transfor 31.1% 36.7% 8 1.096s ─Reify.do_reify_abs_goal --------------- 26.3% 26.6% 2 2.284s ─Reify.do_reifyf_goal ------------------ 25.3% 25.6% 58 1.440s ─Glue.refine_to_reflective_glue' ------- 0.0% 8.1% 1 0.696s ─eexact -------------------------------- 7.6% 7.6% 60 0.032s ─unify (constr) (constr) --------------- 5.8% 5.8% 7 0.128s ─Glue.zrange_to_reflective ------------- 0.0% 5.7% 1 0.488s ─ReflectiveTactics.unify_abstract_cbv_in 3.8% 5.5% 1 0.468s ─prove_interp_compile_correct ---------- 0.0% 5.2% 1 0.448s ─rewrite ?EtaInterp.InterpExprEta ------ 4.9% 4.9% 1 0.416s ─Glue.zrange_to_reflective_goal -------- 2.6% 4.2% 1 0.364s ─synthesize ---------------------------- 0.0% 4.2% 1 0.356s ─IntegrationTestTemporaryMiscCommon.do_r 0.0% 3.8% 1 0.328s ─rewrite H ----------------------------- 3.2% 3.2% 1 0.276s ─change G' ----------------------------- 3.2% 3.2% 1 0.272s ─tac ----------------------------------- 1.4% 2.1% 2 0.180s tactic local total calls max ────────────────────────────────────────┴──────┴──────┴───────┴─────────┘ ─Pipeline.refine_reflectively_gen ------ 0.0% 95.8% 1 8.220s ├─ReflectiveTactics.do_reflective_pipel 0.0% 87.7% 1 7.524s │└ReflectiveTactics.solve_side_conditio 0.0% 87.0% 1 7.460s │ ├─ReflectiveTactics.do_reify -------- 0.0% 43.8% 1 3.760s │ │└Reify.Reify_rhs_gen --------------- 1.4% 43.0% 1 3.688s │ │ ├─Reify.do_reify_abs_goal --------- 26.3% 26.6% 2 2.284s │ │ │└Reify.do_reifyf_goal ------------ 25.3% 25.6% 58 1.440s │ │ │└eexact -------------------------- 6.9% 6.9% 58 0.032s │ │ ├─prove_interp_compile_correct ---- 0.0% 5.2% 1 0.448s │ │ │└rewrite ?EtaInterp.InterpExprEta 4.9% 4.9% 1 0.416s │ │ ├─rewrite H ----------------------- 3.2% 3.2% 1 0.276s │ │ └─tac ----------------------------- 1.4% 2.1% 1 0.180s │ └─ReflectiveTactics.solve_post_reifie 0.6% 43.1% 1 3.700s │ ├─UnifyAbstractReflexivity.unify_tr 31.1% 36.7% 8 1.096s │ │└unify (constr) (constr) --------- 4.3% 4.3% 6 0.092s │ └─ReflectiveTactics.unify_abstract_ 3.8% 5.5% 1 0.468s └─Glue.refine_to_reflective_glue' ----- 0.0% 8.1% 1 0.696s └Glue.zrange_to_reflective ----------- 0.0% 5.7% 1 0.488s └Glue.zrange_to_reflective_goal ------ 2.6% 4.2% 1 0.364s ─synthesize ---------------------------- 0.0% 4.2% 1 0.356s └IntegrationTestTemporaryMiscCommon.do_r 0.0% 3.8% 1 0.328s └change G' ----------------------------- 3.2% 3.2% 1 0.272s Finished transaction in 16.611 secs (15.352u,0.s) (successful) Closed under the global context total time: 8.576s tactic local total calls max ────────────────────────────────────────┴──────┴──────┴───────┴─────────┘ ─Pipeline.refine_reflectively_gen ------ 0.0% 95.8% 1 8.220s ─ReflectiveTactics.do_reflective_pipelin 0.0% 87.7% 1 7.524s ─ReflectiveTactics.solve_side_conditions 0.0% 87.0% 1 7.460s ─ReflectiveTactics.do_reify ------------ 0.0% 43.8% 1 3.760s ─ReflectiveTactics.solve_post_reified_si 0.6% 43.1% 1 3.700s ─Reify.Reify_rhs_gen ------------------- 1.4% 43.0% 1 3.688s ─UnifyAbstractReflexivity.unify_transfor 31.1% 36.7% 8 1.096s ─Reify.do_reify_abs_goal --------------- 26.3% 26.6% 2 2.284s ─Reify.do_reifyf_goal ------------------ 25.3% 25.6% 58 1.440s ─Glue.refine_to_reflective_glue' ------- 0.0% 8.1% 1 0.696s ─eexact -------------------------------- 7.6% 7.6% 60 0.032s ─unify (constr) (constr) --------------- 5.8% 5.8% 7 0.128s ─Glue.zrange_to_reflective ------------- 0.0% 5.7% 1 0.488s ─ReflectiveTactics.unify_abstract_cbv_in 3.8% 5.5% 1 0.468s ─prove_interp_compile_correct ---------- 0.0% 5.2% 1 0.448s ─rewrite ?EtaInterp.InterpExprEta ------ 4.9% 4.9% 1 0.416s ─Glue.zrange_to_reflective_goal -------- 2.6% 4.2% 1 0.364s ─synthesize ---------------------------- 0.0% 4.2% 1 0.356s ─IntegrationTestTemporaryMiscCommon.do_r 0.0% 3.8% 1 0.328s ─rewrite H ----------------------------- 3.2% 3.2% 1 0.276s ─change G' ----------------------------- 3.2% 3.2% 1 0.272s ─tac ----------------------------------- 1.4% 2.1% 2 0.180s tactic local total calls max ────────────────────────────────────────┴──────┴──────┴───────┴─────────┘ ─Pipeline.refine_reflectively_gen ------ 0.0% 95.8% 1 8.220s ├─ReflectiveTactics.do_reflective_pipel 0.0% 87.7% 1 7.524s │└ReflectiveTactics.solve_side_conditio 0.0% 87.0% 1 7.460s │ ├─ReflectiveTactics.do_reify -------- 0.0% 43.8% 1 3.760s │ │└Reify.Reify_rhs_gen --------------- 1.4% 43.0% 1 3.688s │ │ ├─Reify.do_reify_abs_goal --------- 26.3% 26.6% 2 2.284s │ │ │└Reify.do_reifyf_goal ------------ 25.3% 25.6% 58 1.440s │ │ │└eexact -------------------------- 6.9% 6.9% 58 0.032s │ │ ├─prove_interp_compile_correct ---- 0.0% 5.2% 1 0.448s │ │ │└rewrite ?EtaInterp.InterpExprEta 4.9% 4.9% 1 0.416s │ │ ├─rewrite H ----------------------- 3.2% 3.2% 1 0.276s │ │ └─tac ----------------------------- 1.4% 2.1% 1 0.180s │ └─ReflectiveTactics.solve_post_reifie 0.6% 43.1% 1 3.700s │ ├─UnifyAbstractReflexivity.unify_tr 31.1% 36.7% 8 1.096s │ │└unify (constr) (constr) --------- 4.3% 4.3% 6 0.092s │ └─ReflectiveTactics.unify_abstract_ 3.8% 5.5% 1 0.468s └─Glue.refine_to_reflective_glue' ----- 0.0% 8.1% 1 0.696s └Glue.zrange_to_reflective ----------- 0.0% 5.7% 1 0.488s └Glue.zrange_to_reflective_goal ------ 2.6% 4.2% 1 0.364s ─synthesize ---------------------------- 0.0% 4.2% 1 0.356s └IntegrationTestTemporaryMiscCommon.do_r 0.0% 3.8% 1 0.328s └change G' ----------------------------- 3.2% 3.2% 1 0.272s src/Specific/X25519/C64/femul (real: 42.98, user: 39.50, sys: 0.29, mem: 839624 ko) COQC src/Specific/X25519/C64/feaddDisplay > src/Specific/X25519/C64/feaddDisplay.log COQC src/Specific/X25519/C64/fecarryDisplay > src/Specific/X25519/C64/fecarryDisplay.log COQC src/Specific/X25519/C64/fesub.v Finished transaction in 3.729 secs (3.48u,0.012s) (successful) total time: 3.444s tactic local total calls max ────────────────────────────────────────┴──────┴──────┴───────┴─────────┘ ─Pipeline.refine_reflectively_gen ------ 0.0% 98.0% 1 3.376s ─ReflectiveTactics.do_reflective_pipelin 0.0% 77.1% 1 2.656s ─ReflectiveTactics.solve_side_conditions 0.0% 75.8% 1 2.612s ─ReflectiveTactics.solve_post_reified_si 1.2% 40.1% 1 1.380s ─ReflectiveTactics.do_reify ------------ 0.0% 35.8% 1 1.232s ─Reify.Reify_rhs_gen ------------------- 1.4% 34.4% 1 1.184s ─UnifyAbstractReflexivity.unify_transfor 25.7% 30.5% 8 0.324s ─Glue.refine_to_reflective_glue' ------- 0.0% 20.9% 1 0.720s ─Reify.do_reify_abs_goal --------------- 18.5% 18.8% 2 0.648s ─Reify.do_reifyf_goal ------------------ 17.3% 17.5% 16 0.604s ─Glue.zrange_to_reflective ------------- 0.0% 14.2% 1 0.488s ─Glue.zrange_to_reflective_goal -------- 6.5% 10.6% 1 0.364s ─ReflectiveTactics.unify_abstract_cbv_in 5.8% 8.0% 1 0.276s ─unify (constr) (constr) --------------- 5.8% 5.8% 7 0.076s ─eexact -------------------------------- 4.4% 4.4% 18 0.012s ─Glue.pattern_sig_sig_assoc ------------ 0.0% 3.8% 1 0.132s ─assert (H : is_bounded_by' bounds (map' 3.6% 3.6% 2 0.064s ─Glue.pattern_proj1_sig_in_sig --------- 1.2% 3.6% 1 0.124s ─prove_interp_compile_correct ---------- 0.0% 3.5% 1 0.120s ─rewrite H ----------------------------- 3.4% 3.4% 1 0.116s ─rewrite ?EtaInterp.InterpExprEta ------ 3.1% 3.1% 1 0.108s ─pose proof (pf : Interpretation.Bo 2.7% 2.7% 1 0.092s ─reflexivity --------------------------- 2.6% 2.6% 7 0.032s ─Glue.split_BoundedWordToZ ------------- 0.2% 2.4% 1 0.084s ─tac ----------------------------------- 1.7% 2.2% 2 0.076s ─Reify.transitivity_tt ----------------- 0.1% 2.2% 2 0.040s ─transitivity -------------------------- 2.1% 2.1% 5 0.032s ─clearbody (ne_var_list) --------------- 2.1% 2.1% 4 0.056s ─destruct_sig -------------------------- 0.0% 2.1% 4 0.040s tactic local total calls max ────────────────────────────────────────┴──────┴──────┴───────┴─────────┘ ─Pipeline.refine_reflectively_gen ------ 0.0% 98.0% 1 3.376s ├─ReflectiveTactics.do_reflective_pipel 0.0% 77.1% 1 2.656s │└ReflectiveTactics.solve_side_conditio 0.0% 75.8% 1 2.612s │ ├─ReflectiveTactics.solve_post_reifie 1.2% 40.1% 1 1.380s │ │ ├─UnifyAbstractReflexivity.unify_tr 25.7% 30.5% 8 0.324s │ │ │└unify (constr) (constr) --------- 3.6% 3.6% 6 0.040s │ │ └─ReflectiveTactics.unify_abstract_ 5.8% 8.0% 1 0.276s │ │ └unify (constr) (constr) --------- 2.2% 2.2% 1 0.076s │ └─ReflectiveTactics.do_reify -------- 0.0% 35.8% 1 1.232s │ └Reify.Reify_rhs_gen --------------- 1.4% 34.4% 1 1.184s │ ├─Reify.do_reify_abs_goal --------- 18.5% 18.8% 2 0.648s │ │└Reify.do_reifyf_goal ------------ 17.3% 17.5% 16 0.604s │ │└eexact -------------------------- 3.8% 3.8% 16 0.012s │ ├─prove_interp_compile_correct ---- 0.0% 3.5% 1 0.120s │ │└rewrite ?EtaInterp.InterpExprEta 3.1% 3.1% 1 0.108s │ ├─rewrite H ----------------------- 3.4% 3.4% 1 0.116s │ ├─tac ----------------------------- 1.7% 2.2% 1 0.076s │ └─Reify.transitivity_tt ----------- 0.1% 2.2% 2 0.040s └─Glue.refine_to_reflective_glue' ----- 0.0% 20.9% 1 0.720s ├─Glue.zrange_to_reflective --------- 0.0% 14.2% 1 0.488s │ ├─Glue.zrange_to_reflective_goal -- 6.5% 10.6% 1 0.364s │ │└pose proof (pf : Interpretat 2.7% 2.7% 1 0.092s │ └─assert (H : is_bounded_by' bounds 3.6% 3.6% 2 0.064s ├─Glue.pattern_sig_sig_assoc -------- 0.0% 3.8% 1 0.132s │└Glue.pattern_proj1_sig_in_sig ----- 1.2% 3.6% 1 0.124s └─Glue.split_BoundedWordToZ --------- 0.2% 2.4% 1 0.084s └destruct_sig ---------------------- 0.0% 2.1% 4 0.040s Finished transaction in 6.763 secs (6.183u,0.s) (successful) Closed under the global context total time: 3.444s tactic local total calls max ────────────────────────────────────────┴──────┴──────┴───────┴─────────┘ ─Pipeline.refine_reflectively_gen ------ 0.0% 98.0% 1 3.376s ─ReflectiveTactics.do_reflective_pipelin 0.0% 77.1% 1 2.656s ─ReflectiveTactics.solve_side_conditions 0.0% 75.8% 1 2.612s ─ReflectiveTactics.solve_post_reified_si 1.2% 40.1% 1 1.380s ─ReflectiveTactics.do_reify ------------ 0.0% 35.8% 1 1.232s ─Reify.Reify_rhs_gen ------------------- 1.4% 34.4% 1 1.184s ─UnifyAbstractReflexivity.unify_transfor 25.7% 30.5% 8 0.324s ─Glue.refine_to_reflective_glue' ------- 0.0% 20.9% 1 0.720s ─Reify.do_reify_abs_goal --------------- 18.5% 18.8% 2 0.648s ─Reify.do_reifyf_goal ------------------ 17.3% 17.5% 16 0.604s ─Glue.zrange_to_reflective ------------- 0.0% 14.2% 1 0.488s ─Glue.zrange_to_reflective_goal -------- 6.5% 10.6% 1 0.364s ─ReflectiveTactics.unify_abstract_cbv_in 5.8% 8.0% 1 0.276s ─unify (constr) (constr) --------------- 5.8% 5.8% 7 0.076s ─eexact -------------------------------- 4.4% 4.4% 18 0.012s ─Glue.pattern_sig_sig_assoc ------------ 0.0% 3.8% 1 0.132s ─assert (H : is_bounded_by' bounds (map' 3.6% 3.6% 2 0.064s ─Glue.pattern_proj1_sig_in_sig --------- 1.2% 3.6% 1 0.124s ─prove_interp_compile_correct ---------- 0.0% 3.5% 1 0.120s ─rewrite H ----------------------------- 3.4% 3.4% 1 0.116s ─rewrite ?EtaInterp.InterpExprEta ------ 3.1% 3.1% 1 0.108s ─pose proof (pf : Interpretation.Bo 2.7% 2.7% 1 0.092s ─reflexivity --------------------------- 2.6% 2.6% 7 0.032s ─Glue.split_BoundedWordToZ ------------- 0.2% 2.4% 1 0.084s ─tac ----------------------------------- 1.7% 2.2% 2 0.076s ─Reify.transitivity_tt ----------------- 0.1% 2.2% 2 0.040s ─transitivity -------------------------- 2.1% 2.1% 5 0.032s ─clearbody (ne_var_list) --------------- 2.1% 2.1% 4 0.056s ─destruct_sig -------------------------- 0.0% 2.1% 4 0.040s tactic local total calls max ────────────────────────────────────────┴──────┴──────┴───────┴─────────┘ ─Pipeline.refine_reflectively_gen ------ 0.0% 98.0% 1 3.376s ├─ReflectiveTactics.do_reflective_pipel 0.0% 77.1% 1 2.656s │└ReflectiveTactics.solve_side_conditio 0.0% 75.8% 1 2.612s │ ├─ReflectiveTactics.solve_post_reifie 1.2% 40.1% 1 1.380s │ │ ├─UnifyAbstractReflexivity.unify_tr 25.7% 30.5% 8 0.324s │ │ │└unify (constr) (constr) --------- 3.6% 3.6% 6 0.040s │ │ └─ReflectiveTactics.unify_abstract_ 5.8% 8.0% 1 0.276s │ │ └unify (constr) (constr) --------- 2.2% 2.2% 1 0.076s │ └─ReflectiveTactics.do_reify -------- 0.0% 35.8% 1 1.232s │ └Reify.Reify_rhs_gen --------------- 1.4% 34.4% 1 1.184s │ ├─Reify.do_reify_abs_goal --------- 18.5% 18.8% 2 0.648s │ │└Reify.do_reifyf_goal ------------ 17.3% 17.5% 16 0.604s │ │└eexact -------------------------- 3.8% 3.8% 16 0.012s │ ├─prove_interp_compile_correct ---- 0.0% 3.5% 1 0.120s │ │└rewrite ?EtaInterp.InterpExprEta 3.1% 3.1% 1 0.108s │ ├─rewrite H ----------------------- 3.4% 3.4% 1 0.116s │ ├─tac ----------------------------- 1.7% 2.2% 1 0.076s │ └─Reify.transitivity_tt ----------- 0.1% 2.2% 2 0.040s └─Glue.refine_to_reflective_glue' ----- 0.0% 20.9% 1 0.720s ├─Glue.zrange_to_reflective --------- 0.0% 14.2% 1 0.488s │ ├─Glue.zrange_to_reflective_goal -- 6.5% 10.6% 1 0.364s │ │└pose proof (pf : Interpretat 2.7% 2.7% 1 0.092s │ └─assert (H : is_bounded_by' bounds 3.6% 3.6% 2 0.064s ├─Glue.pattern_sig_sig_assoc -------- 0.0% 3.8% 1 0.132s │└Glue.pattern_proj1_sig_in_sig ----- 1.2% 3.6% 1 0.124s └─Glue.split_BoundedWordToZ --------- 0.2% 2.4% 1 0.084s └destruct_sig ---------------------- 0.0% 2.1% 4 0.040s src/Specific/X25519/C64/fesub (real: 26.11, user: 23.72, sys: 0.24, mem: 781808 ko) COQC src/Specific/X25519/C64/fesquare.v Finished transaction in 6.477 secs (6.044u,0.008s) (successful) total time: 6.012s tactic local total calls max ────────────────────────────────────────┴──────┴──────┴───────┴─────────┘ ─synthesize ---------------------------- 0.0% 100.0% 1 6.012s ─Pipeline.refine_reflectively_gen ------ 0.0% 95.9% 1 5.764s ─ReflectiveTactics.do_reflective_pipelin 0.0% 89.6% 1 5.388s ─ReflectiveTactics.solve_side_conditions 0.0% 88.8% 1 5.340s ─ReflectiveTactics.do_reify ------------ 0.0% 47.0% 1 2.828s ─Reify.Reify_rhs_gen ------------------- 1.5% 46.3% 1 2.784s ─ReflectiveTactics.solve_post_reified_si 0.5% 41.8% 1 2.512s ─UnifyAbstractReflexivity.unify_transfor 28.5% 34.1% 8 0.552s ─Reify.do_reify_abs_goal --------------- 28.7% 29.1% 2 1.752s ─Reify.do_reifyf_goal ------------------ 27.6% 27.9% 47 1.320s ─eexact -------------------------------- 8.4% 8.4% 49 0.024s ─ReflectiveTactics.unify_abstract_cbv_in 5.0% 6.9% 1 0.412s ─unify (constr) (constr) --------------- 6.3% 6.3% 7 0.104s ─Glue.refine_to_reflective_glue' ------- 0.0% 6.3% 1 0.376s ─prove_interp_compile_correct ---------- 0.0% 5.3% 1 0.316s ─rewrite ?EtaInterp.InterpExprEta ------ 4.8% 4.8% 1 0.288s ─Glue.zrange_to_reflective ------------- 0.0% 4.4% 1 0.264s ─IntegrationTestTemporaryMiscCommon.do_r 0.1% 3.7% 1 0.224s ─Glue.zrange_to_reflective_goal -------- 2.6% 3.3% 1 0.196s ─change G' ----------------------------- 3.1% 3.1% 1 0.188s ─rewrite H ----------------------------- 3.0% 3.0% 1 0.180s ─tac ----------------------------------- 1.9% 2.7% 2 0.160s ─reflexivity --------------------------- 2.4% 2.4% 7 0.060s tactic local total calls max ────────────────────────────────────────┴──────┴──────┴───────┴─────────┘ ─synthesize ---------------------------- 0.0% 100.0% 1 6.012s ├─Pipeline.refine_reflectively_gen ---- 0.0% 95.9% 1 5.764s │ ├─ReflectiveTactics.do_reflective_pip 0.0% 89.6% 1 5.388s │ │└ReflectiveTactics.solve_side_condit 0.0% 88.8% 1 5.340s │ │ ├─ReflectiveTactics.do_reify ------ 0.0% 47.0% 1 2.828s │ │ │└Reify.Reify_rhs_gen ------------- 1.5% 46.3% 1 2.784s │ │ │ ├─Reify.do_reify_abs_goal ------- 28.7% 29.1% 2 1.752s │ │ │ │└Reify.do_reifyf_goal ---------- 27.6% 27.9% 47 1.320s │ │ │ │└eexact ------------------------ 7.7% 7.7% 47 0.024s │ │ │ ├─prove_interp_compile_correct -- 0.0% 5.3% 1 0.316s │ │ │ │└rewrite ?EtaInterp.InterpExprEt 4.8% 4.8% 1 0.288s │ │ │ ├─rewrite H --------------------- 3.0% 3.0% 1 0.180s │ │ │ └─tac --------------------------- 1.9% 2.7% 1 0.160s │ │ └─ReflectiveTactics.solve_post_reif 0.5% 41.8% 1 2.512s │ │ ├─UnifyAbstractReflexivity.unify_ 28.5% 34.1% 8 0.552s │ │ │└unify (constr) (constr) ------- 4.6% 4.6% 6 0.076s │ │ └─ReflectiveTactics.unify_abstrac 5.0% 6.9% 1 0.412s │ └─Glue.refine_to_reflective_glue' --- 0.0% 6.3% 1 0.376s │ └Glue.zrange_to_reflective --------- 0.0% 4.4% 1 0.264s │ └Glue.zrange_to_reflective_goal ---- 2.6% 3.3% 1 0.196s └─IntegrationTestTemporaryMiscCommon.do 0.1% 3.7% 1 0.224s └change G' --------------------------- 3.1% 3.1% 1 0.188s Finished transaction in 12.356 secs (11.331u,0.004s) (successful) Closed under the global context total time: 6.012s tactic local total calls max ────────────────────────────────────────┴──────┴──────┴───────┴─────────┘ ─synthesize ---------------------------- 0.0% 100.0% 1 6.012s ─Pipeline.refine_reflectively_gen ------ 0.0% 95.9% 1 5.764s ─ReflectiveTactics.do_reflective_pipelin 0.0% 89.6% 1 5.388s ─ReflectiveTactics.solve_side_conditions 0.0% 88.8% 1 5.340s ─ReflectiveTactics.do_reify ------------ 0.0% 47.0% 1 2.828s ─Reify.Reify_rhs_gen ------------------- 1.5% 46.3% 1 2.784s ─ReflectiveTactics.solve_post_reified_si 0.5% 41.8% 1 2.512s ─UnifyAbstractReflexivity.unify_transfor 28.5% 34.1% 8 0.552s ─Reify.do_reify_abs_goal --------------- 28.7% 29.1% 2 1.752s ─Reify.do_reifyf_goal ------------------ 27.6% 27.9% 47 1.320s ─eexact -------------------------------- 8.4% 8.4% 49 0.024s ─ReflectiveTactics.unify_abstract_cbv_in 5.0% 6.9% 1 0.412s ─unify (constr) (constr) --------------- 6.3% 6.3% 7 0.104s ─Glue.refine_to_reflective_glue' ------- 0.0% 6.3% 1 0.376s ─prove_interp_compile_correct ---------- 0.0% 5.3% 1 0.316s ─rewrite ?EtaInterp.InterpExprEta ------ 4.8% 4.8% 1 0.288s ─Glue.zrange_to_reflective ------------- 0.0% 4.4% 1 0.264s ─IntegrationTestTemporaryMiscCommon.do_r 0.1% 3.7% 1 0.224s ─Glue.zrange_to_reflective_goal -------- 2.6% 3.3% 1 0.196s ─change G' ----------------------------- 3.1% 3.1% 1 0.188s ─rewrite H ----------------------------- 3.0% 3.0% 1 0.180s ─tac ----------------------------------- 1.9% 2.7% 2 0.160s ─reflexivity --------------------------- 2.4% 2.4% 7 0.060s tactic local total calls max ────────────────────────────────────────┴──────┴──────┴───────┴─────────┘ ─synthesize ---------------------------- 0.0% 100.0% 1 6.012s ├─Pipeline.refine_reflectively_gen ---- 0.0% 95.9% 1 5.764s │ ├─ReflectiveTactics.do_reflective_pip 0.0% 89.6% 1 5.388s │ │└ReflectiveTactics.solve_side_condit 0.0% 88.8% 1 5.340s │ │ ├─ReflectiveTactics.do_reify ------ 0.0% 47.0% 1 2.828s │ │ │└Reify.Reify_rhs_gen ------------- 1.5% 46.3% 1 2.784s │ │ │ ├─Reify.do_reify_abs_goal ------- 28.7% 29.1% 2 1.752s │ │ │ │└Reify.do_reifyf_goal ---------- 27.6% 27.9% 47 1.320s │ │ │ │└eexact ------------------------ 7.7% 7.7% 47 0.024s │ │ │ ├─prove_interp_compile_correct -- 0.0% 5.3% 1 0.316s │ │ │ │└rewrite ?EtaInterp.InterpExprEt 4.8% 4.8% 1 0.288s │ │ │ ├─rewrite H --------------------- 3.0% 3.0% 1 0.180s │ │ │ └─tac --------------------------- 1.9% 2.7% 1 0.160s │ │ └─ReflectiveTactics.solve_post_reif 0.5% 41.8% 1 2.512s │ │ ├─UnifyAbstractReflexivity.unify_ 28.5% 34.1% 8 0.552s │ │ │└unify (constr) (constr) ------- 4.6% 4.6% 6 0.076s │ │ └─ReflectiveTactics.unify_abstrac 5.0% 6.9% 1 0.412s │ └─Glue.refine_to_reflective_glue' --- 0.0% 6.3% 1 0.376s │ └Glue.zrange_to_reflective --------- 0.0% 4.4% 1 0.264s │ └Glue.zrange_to_reflective_goal ---- 2.6% 3.3% 1 0.196s └─IntegrationTestTemporaryMiscCommon.do 0.1% 3.7% 1 0.224s └change G' --------------------------- 3.1% 3.1% 1 0.188s src/Specific/X25519/C64/fesquare (real: 35.23, user: 32.24, sys: 0.26, mem: 802776 ko) COQC src/Specific/X25519/C64/femulDisplay > src/Specific/X25519/C64/femulDisplay.log COQC src/Specific/X25519/C64/freeze.v Finished transaction in 7.785 secs (7.139u,0.019s) (successful) total time: 7.112s tactic local total calls max ────────────────────────────────────────┴──────┴──────┴───────┴─────────┘ ─synthesize_freeze --------------------- -0.0% 100.0% 1 7.112s ─Pipeline.refine_reflectively_gen ------ 0.0% 99.2% 1 7.056s ─ReflectiveTactics.do_reflective_pipelin 0.0% 92.8% 1 6.600s ─ReflectiveTactics.solve_side_conditions -0.0% 91.8% 1 6.532s ─ReflectiveTactics.do_reify ------------ 0.0% 57.1% 1 4.060s ─Reify.Reify_rhs_gen ------------------- 1.5% 56.4% 1 4.012s ─Reify.do_reify_abs_goal --------------- 40.1% 40.3% 2 2.868s ─Reify.do_reifyf_goal ------------------ 39.1% 39.4% 129 2.800s ─ReflectiveTactics.solve_post_reified_si 0.6% 34.8% 1 2.472s ─UnifyAbstractReflexivity.unify_transfor 25.2% 29.4% 8 0.428s ─eexact -------------------------------- 12.9% 12.9% 131 0.028s ─Glue.refine_to_reflective_glue' ------- 0.1% 6.4% 1 0.456s ─prove_interp_compile_correct ---------- 0.0% 4.7% 1 0.332s ─unify (constr) (constr) --------------- 4.6% 4.6% 7 0.096s ─ReflectiveTactics.unify_abstract_cbv_in 3.1% 4.6% 1 0.324s ─rewrite ?EtaInterp.InterpExprEta ------ 4.3% 4.3% 1 0.308s ─Glue.zrange_to_reflective ------------- 0.0% 4.1% 1 0.292s ─Glue.zrange_to_reflective_goal -------- 2.6% 3.2% 1 0.228s ─rewrite H ----------------------------- 3.0% 3.0% 1 0.212s ─reflexivity --------------------------- 2.3% 2.3% 7 0.064s ─Reify.transitivity_tt ----------------- 0.0% 2.1% 2 0.096s ─transitivity -------------------------- 2.1% 2.1% 5 0.084s tactic local total calls max ────────────────────────────────────────┴──────┴──────┴───────┴─────────┘ ─synthesize_freeze --------------------- -0.0% 100.0% 1 7.112s └Pipeline.refine_reflectively_gen ------ 0.0% 99.2% 1 7.056s ├─ReflectiveTactics.do_reflective_pipel 0.0% 92.8% 1 6.600s │└ReflectiveTactics.solve_side_conditio -0.0% 91.8% 1 6.532s │ ├─ReflectiveTactics.do_reify -------- 0.0% 57.1% 1 4.060s │ │└Reify.Reify_rhs_gen --------------- 1.5% 56.4% 1 4.012s │ │ ├─Reify.do_reify_abs_goal --------- 40.1% 40.3% 2 2.868s │ │ │└Reify.do_reifyf_goal ------------ 39.1% 39.4% 129 2.800s │ │ │└eexact -------------------------- 12.4% 12.4% 129 0.028s │ │ ├─prove_interp_compile_correct ---- 0.0% 4.7% 1 0.332s │ │ │└rewrite ?EtaInterp.InterpExprEta 4.3% 4.3% 1 0.308s │ │ ├─rewrite H ----------------------- 3.0% 3.0% 1 0.212s │ │ └─Reify.transitivity_tt ----------- 0.0% 2.1% 2 0.096s │ │ └transitivity -------------------- 2.0% 2.0% 4 0.084s │ └─ReflectiveTactics.solve_post_reifie 0.6% 34.8% 1 2.472s │ ├─UnifyAbstractReflexivity.unify_tr 25.2% 29.4% 8 0.428s │ │└unify (constr) (constr) --------- 3.2% 3.2% 6 0.068s │ └─ReflectiveTactics.unify_abstract_ 3.1% 4.6% 1 0.324s └─Glue.refine_to_reflective_glue' ----- 0.1% 6.4% 1 0.456s └Glue.zrange_to_reflective ----------- 0.0% 4.1% 1 0.292s └Glue.zrange_to_reflective_goal ------ 2.6% 3.2% 1 0.228s Finished transaction in 12.063 secs (11.036u,0.012s) (successful) Closed under the global context total time: 7.112s tactic local total calls max ────────────────────────────────────────┴──────┴──────┴───────┴─────────┘ ─synthesize_freeze --------------------- -0.0% 100.0% 1 7.112s ─Pipeline.refine_reflectively_gen ------ 0.0% 99.2% 1 7.056s ─ReflectiveTactics.do_reflective_pipelin 0.0% 92.8% 1 6.600s ─ReflectiveTactics.solve_side_conditions -0.0% 91.8% 1 6.532s ─ReflectiveTactics.do_reify ------------ 0.0% 57.1% 1 4.060s ─Reify.Reify_rhs_gen ------------------- 1.5% 56.4% 1 4.012s ─Reify.do_reify_abs_goal --------------- 40.1% 40.3% 2 2.868s ─Reify.do_reifyf_goal ------------------ 39.1% 39.4% 129 2.800s ─ReflectiveTactics.solve_post_reified_si 0.6% 34.8% 1 2.472s ─UnifyAbstractReflexivity.unify_transfor 25.2% 29.4% 8 0.428s ─eexact -------------------------------- 12.9% 12.9% 131 0.028s ─Glue.refine_to_reflective_glue' ------- 0.1% 6.4% 1 0.456s ─prove_interp_compile_correct ---------- 0.0% 4.7% 1 0.332s ─unify (constr) (constr) --------------- 4.6% 4.6% 7 0.096s ─ReflectiveTactics.unify_abstract_cbv_in 3.1% 4.6% 1 0.324s ─rewrite ?EtaInterp.InterpExprEta ------ 4.3% 4.3% 1 0.308s ─Glue.zrange_to_reflective ------------- 0.0% 4.1% 1 0.292s ─Glue.zrange_to_reflective_goal -------- 2.6% 3.2% 1 0.228s ─rewrite H ----------------------------- 3.0% 3.0% 1 0.212s ─reflexivity --------------------------- 2.3% 2.3% 7 0.064s ─Reify.transitivity_tt ----------------- 0.0% 2.1% 2 0.096s ─transitivity -------------------------- 2.1% 2.1% 5 0.084s tactic local total calls max ────────────────────────────────────────┴──────┴──────┴───────┴─────────┘ ─synthesize_freeze --------------------- -0.0% 100.0% 1 7.112s └Pipeline.refine_reflectively_gen ------ 0.0% 99.2% 1 7.056s ├─ReflectiveTactics.do_reflective_pipel 0.0% 92.8% 1 6.600s │└ReflectiveTactics.solve_side_conditio -0.0% 91.8% 1 6.532s │ ├─ReflectiveTactics.do_reify -------- 0.0% 57.1% 1 4.060s │ │└Reify.Reify_rhs_gen --------------- 1.5% 56.4% 1 4.012s │ │ ├─Reify.do_reify_abs_goal --------- 40.1% 40.3% 2 2.868s │ │ │└Reify.do_reifyf_goal ------------ 39.1% 39.4% 129 2.800s │ │ │└eexact -------------------------- 12.4% 12.4% 129 0.028s │ │ ├─prove_interp_compile_correct ---- 0.0% 4.7% 1 0.332s │ │ │└rewrite ?EtaInterp.InterpExprEta 4.3% 4.3% 1 0.308s │ │ ├─rewrite H ----------------------- 3.0% 3.0% 1 0.212s │ │ └─Reify.transitivity_tt ----------- 0.0% 2.1% 2 0.096s │ │ └transitivity -------------------- 2.0% 2.0% 4 0.084s │ └─ReflectiveTactics.solve_post_reifie 0.6% 34.8% 1 2.472s │ ├─UnifyAbstractReflexivity.unify_tr 25.2% 29.4% 8 0.428s │ │└unify (constr) (constr) --------- 3.2% 3.2% 6 0.068s │ └─ReflectiveTactics.unify_abstract_ 3.1% 4.6% 1 0.324s └─Glue.refine_to_reflective_glue' ----- 0.1% 6.4% 1 0.456s └Glue.zrange_to_reflective ----------- 0.0% 4.1% 1 0.292s └Glue.zrange_to_reflective_goal ------ 2.6% 3.2% 1 0.228s src/Specific/X25519/C64/freeze (real: 36.42, user: 33.24, sys: 0.26, mem: 826476 ko) COQC src/Specific/NISTP256/AMD64/feadd.v Finished transaction in 9.065 secs (8.452u,0.004s) (successful) total time: 8.408s tactic local total calls max ────────────────────────────────────────┴──────┴──────┴───────┴─────────┘ ─Pipeline.refine_reflectively_gen ------ 0.0% 56.0% 1 4.712s ─ReflectiveTactics.do_reflective_pipelin 0.0% 47.7% 1 4.012s ─ReflectiveTactics.solve_side_conditions 0.0% 47.1% 1 3.960s ─synthesize_montgomery ----------------- 0.0% 44.0% 1 3.696s ─ReflectiveTactics.solve_post_reified_si 0.6% 26.4% 1 2.220s ─UnifyAbstractReflexivity.unify_transfor 18.0% 21.3% 8 0.508s ─IntegrationTestTemporaryMiscCommon.fact 1.3% 21.3% 1 1.788s ─IntegrationTestTemporaryMiscCommon.do_r 0.0% 21.0% 1 1.768s ─ReflectiveTactics.do_reify ------------ 0.0% 20.7% 1 1.740s ─Reify.Reify_rhs_gen ------------------- 1.0% 20.0% 1 1.684s ─DestructHyps.do_all_matches_then ------ 0.1% 18.6% 8 0.220s ─DestructHyps.do_one_match_then -------- 0.8% 18.5% 44 0.056s ─op_sig_side_conditions_t -------------- 0.0% 17.9% 1 1.504s ─do_tac -------------------------------- 0.0% 17.7% 43 0.052s ─destruct H ---------------------------- 17.7% 17.7% 36 0.052s ─rewrite <- (lem : lemT) by by_tac ltac: 0.3% 17.3% 1 1.452s ─IntegrationTestTemporaryMiscCommon.do_r 0.0% 17.3% 1 1.452s ─by_tac -------------------------------- 0.0% 17.0% 4 0.532s ─rewrite <- (ZRange.is_bounded_by_None_r 15.7% 15.8% 8 0.360s ─Reify.do_reify_abs_goal --------------- 9.1% 9.3% 2 0.780s ─Reify.do_reifyf_goal ------------------ 8.5% 8.6% 93 0.716s ─Glue.refine_to_reflective_glue' ------- 0.0% 8.3% 1 0.700s ─Glue.zrange_to_reflective ------------- 0.0% 5.3% 1 0.444s ─ReflectiveTactics.unify_abstract_cbv_in 2.9% 4.3% 1 0.360s ─Glue.zrange_to_reflective_goal -------- 2.5% 4.0% 1 0.336s ─unify (constr) (constr) --------------- 3.9% 3.9% 9 0.108s ─IntegrationTestTemporaryMiscCommon.do_s 0.0% 3.8% 1 0.316s ─ MapProjections.proj2 2.1% 2.1% 2 0.108s tactic local total calls max ────────────────────────────────────────┴──────┴──────┴───────┴─────────┘ ─Pipeline.refine_reflectively_gen ------ 0.0% 56.0% 1 4.712s ├─ReflectiveTactics.do_reflective_pipel 0.0% 47.7% 1 4.012s │└ReflectiveTactics.solve_side_conditio 0.0% 47.1% 1 3.960s │ ├─ReflectiveTactics.solve_post_reifie 0.6% 26.4% 1 2.220s │ │ ├─UnifyAbstractReflexivity.unify_tr 18.0% 21.3% 8 0.508s │ │ │└unify (constr) (constr) --------- 2.6% 2.6% 6 0.064s │ │ └─ReflectiveTactics.unify_abstract_ 2.9% 4.3% 1 0.360s │ └─ReflectiveTactics.do_reify -------- 0.0% 20.7% 1 1.740s │ └Reify.Reify_rhs_gen --------------- 1.0% 20.0% 1 1.684s │ ├─Reify.do_reify_abs_goal --------- 9.1% 9.3% 2 0.780s │ │└Reify.do_reifyf_goal ------------ 8.5% 8.6% 93 0.716s │ ├─prove_interp_compile_correct ---- 0.0% 2.4% 1 0.200s │ │└rewrite ?EtaInterp.InterpExprEta 2.2% 2.2% 1 0.188s │ └─rewrite H ----------------------- 2.3% 2.3% 1 0.192s └─Glue.refine_to_reflective_glue' ----- 0.0% 8.3% 1 0.700s └Glue.zrange_to_reflective ----------- 0.0% 5.3% 1 0.444s └Glue.zrange_to_reflective_goal ------ 2.5% 4.0% 1 0.336s ─synthesize_montgomery ----------------- 0.0% 44.0% 1 3.696s ├─IntegrationTestTemporaryMiscCommon.fa 1.3% 21.3% 1 1.788s │└op_sig_side_conditions_t ------------ 0.0% 17.9% 1 1.504s │ ├─DestructHyps.do_all_matches_then -- 0.1% 10.1% 4 0.220s │ │└DestructHyps.do_one_match_then ---- 0.4% 10.0% 24 0.052s │ │└do_tac ---------------------------- 0.0% 9.6% 20 0.048s │ │└destruct H ------------------------ 9.6% 9.6% 20 0.048s │ └─rewrite <- (ZRange.is_bounded_by_No 7.5% 7.6% 4 0.308s └─IntegrationTestTemporaryMiscCommon.do 0.0% 21.0% 1 1.768s ├─IntegrationTestTemporaryMiscCommon. 0.0% 17.3% 1 1.452s │└rewrite <- (lem : lemT) by by_tac l 0.3% 17.3% 1 1.452s │└by_tac ---------------------------- 0.0% 17.0% 4 0.532s │ ├─DestructHyps.do_all_matches_then 0.0% 8.5% 4 0.184s │ │└DestructHyps.do_one_match_then -- 0.3% 8.5% 20 0.056s │ │└do_tac -------------------------- 0.0% 8.2% 16 0.052s │ │└destruct H ---------------------- 8.2% 8.2% 16 0.052s │ └─rewrite <- (ZRange.is_bounded_by_ 8.2% 8.3% 4 0.360s └─IntegrationTestTemporaryMiscCommon. 0.0% 3.8% 1 0.316s └ MapProjections.proj2 2.1% 2.1% 2 0.108s tactic local total calls max ────────────────────────────────────────┴──────┴──────┴───────┴─────────┘ ─Pipeline.refine_reflectively_gen ------ 0.0% 56.0% 1 4.712s ├─ReflectiveTactics.do_reflective_pipel 0.0% 47.7% 1 4.012s │└ReflectiveTactics.solve_side_conditio 0.0% 47.1% 1 3.960s │ ├─ReflectiveTactics.solve_post_reifie 0.6% 26.4% 1 2.220s │ │ ├─UnifyAbstractReflexivity.unify_tr 18.0% 21.3% 8 0.508s │ │ │└unify (constr) (constr) --------- 2.6% 2.6% 6 0.064s │ │ └─ReflectiveTactics.unify_abstract_ 2.9% 4.3% 1 0.360s │ └─ReflectiveTactics.do_reify -------- 0.0% 20.7% 1 1.740s │ └Reify.Reify_rhs_gen --------------- 1.0% 20.0% 1 1.684s │ ├─Reify.do_reify_abs_goal --------- 9.1% 9.3% 2 0.780s │ │└Reify.do_reifyf_goal ------------ 8.5% 8.6% 93 0.716s │ ├─prove_interp_compile_correct ---- 0.0% 2.4% 1 0.200s │ │└rewrite ?EtaInterp.InterpExprEta 2.2% 2.2% 1 0.188s │ └─rewrite H ----------------------- 2.3% 2.3% 1 0.192s └─Glue.refine_to_reflective_glue' ----- 0.0% 8.3% 1 0.700s └Glue.zrange_to_reflective ----------- 0.0% 5.3% 1 0.444s └Glue.zrange_to_reflective_goal ------ 2.5% 4.0% 1 0.336s ─synthesize_montgomery ----------------- 0.0% 44.0% 1 3.696s ├─IntegrationTestTemporaryMiscCommon.fa 1.3% 21.3% 1 1.788s │└op_sig_side_conditions_t ------------ 0.0% 17.9% 1 1.504s │ ├─DestructHyps.do_all_matches_then -- 0.1% 10.1% 4 0.220s │ │└DestructHyps.do_one_match_then ---- 0.4% 10.0% 24 0.052s │ │└do_tac ---------------------------- 0.0% 9.6% 20 0.048s │ │└destruct H ------------------------ 9.6% 9.6% 20 0.048s │ └─rewrite <- (ZRange.is_bounded_by_No 7.5% 7.6% 4 0.308s └─IntegrationTestTemporaryMiscCommon.do 0.0% 21.0% 1 1.768s ├─IntegrationTestTemporaryMiscCommon. 0.0% 17.3% 1 1.452s │└rewrite <- (lem : lemT) by by_tac l 0.3% 17.3% 1 1.452s │└by_tac ---------------------------- 0.0% 17.0% 4 0.532s │ ├─DestructHyps.do_all_matches_then 0.0% 8.5% 4 0.184s │ │└DestructHyps.do_one_match_then -- 0.3% 8.5% 20 0.056s │ │└do_tac -------------------------- 0.0% 8.2% 16 0.052s │ │└destruct H ---------------------- 8.2% 8.2% 16 0.052s │ └─rewrite <- (ZRange.is_bounded_by_ 8.2% 8.3% 4 0.360s └─IntegrationTestTemporaryMiscCommon. 0.0% 3.8% 1 0.316s └ src/Specific/NISTP256/AMD64/feaddDisplay.log COQC src/Specific/NISTP256/AMD64/fenzDisplay > src/Specific/NISTP256/AMD64/fenzDisplay.log COQC src/Specific/NISTP256/AMD64/feoppDisplay > src/Specific/NISTP256/AMD64/feoppDisplay.log COQC src/Specific/NISTP256/AMD64/fesubDisplay > src/Specific/NISTP256/AMD64/fesubDisplay.log COQC src/Specific/X25519/C64/fesquareDisplay > src/Specific/X25519/C64/fesquareDisplay.log COQC src/Specific/solinas32_2e255m765_12limbs/femul.v Finished transaction in 60.265 secs (55.388u,0.103s) (successful) total time: 55.440s tactic local total calls max ────────────────────────────────────────┴──────┴──────┴───────┴─────────┘ ─Pipeline.refine_reflectively_gen ------ 0.0% 95.9% 1 53.156s ─ReflectiveTactics.do_reflective_pipelin 0.0% 89.2% 1 49.464s ─ReflectiveTactics.solve_side_conditions 0.0% 88.9% 1 49.288s ─ReflectiveTactics.do_reify ------------ -0.0% 49.9% 1 27.684s ─Reify.Reify_rhs_gen ------------------- 1.3% 49.3% 1 27.348s ─ReflectiveTactics.solve_post_reified_si 0.1% 39.0% 1 21.604s ─Reify.do_reify_abs_goal --------------- 36.3% 36.6% 2 20.272s ─UnifyAbstractReflexivity.unify_transfor 30.8% 36.1% 8 8.636s ─Reify.do_reifyf_goal ------------------ 35.7% 35.9% 108 10.356s ─eexact -------------------------------- 11.5% 11.5% 110 0.128s ─Glue.refine_to_reflective_glue' ------- 0.0% 6.7% 1 3.692s ─Glue.zrange_to_reflective ------------- 0.0% 6.2% 1 3.424s ─unify (constr) (constr) --------------- 4.9% 4.9% 7 1.140s ─Glue.zrange_to_reflective_goal -------- 1.4% 4.7% 1 2.592s ─synthesize ---------------------------- 0.0% 4.1% 1 2.284s ─IntegrationTestTemporaryMiscCommon.do_r 0.0% 4.0% 1 2.220s ─change G' ----------------------------- 3.9% 3.9% 1 2.148s ─pose proof (pf : Interpretation.Bo 3.1% 3.1% 1 1.736s ─rewrite H ----------------------------- 3.1% 3.1% 1 1.692s ─prove_interp_compile_correct ---------- 0.0% 3.0% 1 1.636s ─rewrite ?EtaInterp.InterpExprEta ------ 2.7% 2.7% 1 1.484s tactic local total calls max ────────────────────────────────────────┴──────┴──────┴───────┴─────────┘ ─Pipeline.refine_reflectively_gen ------ 0.0% 95.9% 1 53.156s ├─ReflectiveTactics.do_reflective_pipel 0.0% 89.2% 1 49.464s │└ReflectiveTactics.solve_side_conditio 0.0% 88.9% 1 49.288s │ ├─ReflectiveTactics.do_reify -------- -0.0% 49.9% 1 27.684s │ │└Reify.Reify_rhs_gen --------------- 1.3% 49.3% 1 27.348s │ │ ├─Reify.do_reify_abs_goal --------- 36.3% 36.6% 2 20.272s │ │ │└Reify.do_reifyf_goal ------------ 35.7% 35.9% 108 10.356s │ │ │└eexact -------------------------- 11.1% 11.1% 108 0.072s │ │ ├─rewrite H ----------------------- 3.1% 3.1% 1 1.692s │ │ └─prove_interp_compile_correct ---- 0.0% 3.0% 1 1.636s │ │ └rewrite ?EtaInterp.InterpExprEta 2.7% 2.7% 1 1.484s │ └─ReflectiveTactics.solve_post_reifie 0.1% 39.0% 1 21.604s │ └UnifyAbstractReflexivity.unify_tran 30.8% 36.1% 8 8.636s │ └unify (constr) (constr) ----------- 4.4% 4.4% 6 1.140s └─Glue.refine_to_reflective_glue' ----- 0.0% 6.7% 1 3.692s └Glue.zrange_to_reflective ----------- 0.0% 6.2% 1 3.424s └Glue.zrange_to_reflective_goal ------ 1.4% 4.7% 1 2.592s └pose proof (pf : Interpretation. 3.1% 3.1% 1 1.736s ─synthesize ---------------------------- 0.0% 4.1% 1 2.284s └IntegrationTestTemporaryMiscCommon.do_r 0.0% 4.0% 1 2.220s └change G' ----------------------------- 3.9% 3.9% 1 2.148s Finished transaction in 92.046 secs (84.315u,0.032s) (successful) Closed under the global context total time: 55.440s tactic local total calls max ────────────────────────────────────────┴──────┴──────┴───────┴─────────┘ ─Pipeline.refine_reflectively_gen ------ 0.0% 95.9% 1 53.156s ─ReflectiveTactics.do_reflective_pipelin 0.0% 89.2% 1 49.464s ─ReflectiveTactics.solve_side_conditions 0.0% 88.9% 1 49.288s ─ReflectiveTactics.do_reify ------------ -0.0% 49.9% 1 27.684s ─Reify.Reify_rhs_gen ------------------- 1.3% 49.3% 1 27.348s ─ReflectiveTactics.solve_post_reified_si 0.1% 39.0% 1 21.604s ─Reify.do_reify_abs_goal --------------- 36.3% 36.6% 2 20.272s ─UnifyAbstractReflexivity.unify_transfor 30.8% 36.1% 8 8.636s ─Reify.do_reifyf_goal ------------------ 35.7% 35.9% 108 10.356s ─eexact -------------------------------- 11.5% 11.5% 110 0.128s ─Glue.refine_to_reflective_glue' ------- 0.0% 6.7% 1 3.692s ─Glue.zrange_to_reflective ------------- 0.0% 6.2% 1 3.424s ─unify (constr) (constr) --------------- 4.9% 4.9% 7 1.140s ─Glue.zrange_to_reflective_goal -------- 1.4% 4.7% 1 2.592s ─synthesize ---------------------------- 0.0% 4.1% 1 2.284s ─IntegrationTestTemporaryMiscCommon.do_r 0.0% 4.0% 1 2.220s ─change G' ----------------------------- 3.9% 3.9% 1 2.148s ─pose proof (pf : Interpretation.Bo 3.1% 3.1% 1 1.736s ─rewrite H ----------------------------- 3.1% 3.1% 1 1.692s ─prove_interp_compile_correct ---------- 0.0% 3.0% 1 1.636s ─rewrite ?EtaInterp.InterpExprEta ------ 2.7% 2.7% 1 1.484s tactic local total calls max ────────────────────────────────────────┴──────┴──────┴───────┴─────────┘ ─Pipeline.refine_reflectively_gen ------ 0.0% 95.9% 1 53.156s ├─ReflectiveTactics.do_reflective_pipel 0.0% 89.2% 1 49.464s │└ReflectiveTactics.solve_side_conditio 0.0% 88.9% 1 49.288s │ ├─ReflectiveTactics.do_reify -------- -0.0% 49.9% 1 27.684s │ │└Reify.Reify_rhs_gen --------------- 1.3% 49.3% 1 27.348s │ │ ├─Reify.do_reify_abs_goal --------- 36.3% 36.6% 2 20.272s │ │ │└Reify.do_reifyf_goal ------------ 35.7% 35.9% 108 10.356s │ │ │└eexact -------------------------- 11.1% 11.1% 108 0.072s │ │ ├─rewrite H ----------------------- 3.1% 3.1% 1 1.692s │ │ └─prove_interp_compile_correct ---- 0.0% 3.0% 1 1.636s │ │ └rewrite ?EtaInterp.InterpExprEta 2.7% 2.7% 1 1.484s │ └─ReflectiveTactics.solve_post_reifie 0.1% 39.0% 1 21.604s │ └UnifyAbstractReflexivity.unify_tran 30.8% 36.1% 8 8.636s │ └unify (constr) (constr) ----------- 4.4% 4.4% 6 1.140s └─Glue.refine_to_reflective_glue' ----- 0.0% 6.7% 1 3.692s └Glue.zrange_to_reflective ----------- 0.0% 6.2% 1 3.424s └Glue.zrange_to_reflective_goal ------ 1.4% 4.7% 1 2.592s └pose proof (pf : Interpretation. 3.1% 3.1% 1 1.736s ─synthesize ---------------------------- 0.0% 4.1% 1 2.284s └IntegrationTestTemporaryMiscCommon.do_r 0.0% 4.0% 1 2.220s └change G' ----------------------------- 3.9% 3.9% 1 2.148s src/Specific/solinas32_2e255m765_12limbs/femul (real: 179.21, user: 164.11, sys: 0.42, mem: 1549104 ko) COQC src/Specific/X25519/C64/fesubDisplay > src/Specific/X25519/C64/fesubDisplay.log COQC src/Specific/X25519/C64/freezeDisplay > src/Specific/X25519/C64/freezeDisplay.log COQC src/Specific/solinas32_2e255m765_13limbs/femul.v Finished transaction in 74.548 secs (68.928u,0.079s) (successful) total time: 68.948s tactic local total calls max ────────────────────────────────────────┴──────┴──────┴───────┴─────────┘ ─Pipeline.refine_reflectively_gen ------ 0.0% 95.7% 1 65.956s ─ReflectiveTactics.do_reflective_pipelin 0.0% 88.7% 1 61.172s ─ReflectiveTactics.solve_side_conditions 0.0% 88.4% 1 60.944s ─ReflectiveTactics.do_reify ------------ 0.0% 48.5% 1 33.408s ─Reify.Reify_rhs_gen ------------------- 1.3% 47.9% 1 33.020s ─ReflectiveTactics.solve_post_reified_si 0.1% 39.9% 1 27.536s ─UnifyAbstractReflexivity.unify_transfor 32.0% 37.2% 8 11.528s ─Reify.do_reify_abs_goal --------------- 36.0% 36.2% 2 24.960s ─Reify.do_reifyf_goal ------------------ 35.3% 35.5% 117 12.840s ─eexact -------------------------------- 11.4% 11.4% 119 0.160s ─Glue.refine_to_reflective_glue' ------- 0.0% 6.9% 1 4.784s ─Glue.zrange_to_reflective ------------- 0.0% 6.5% 1 4.512s ─Glue.zrange_to_reflective_goal -------- 1.3% 4.9% 1 3.396s ─unify (constr) (constr) --------------- 4.9% 4.9% 7 1.524s ─synthesize ---------------------------- 0.0% 4.3% 1 2.992s ─IntegrationTestTemporaryMiscCommon.do_r 0.0% 4.2% 1 2.912s ─change G' ----------------------------- 4.1% 4.1% 1 2.840s ─pose proof (pf : Interpretation.Bo 3.5% 3.5% 1 2.420s ─rewrite H ----------------------------- 3.0% 3.0% 1 2.084s ─prove_interp_compile_correct ---------- 0.0% 2.7% 1 1.856s ─rewrite ?EtaInterp.InterpExprEta ------ 2.5% 2.5% 1 1.692s tactic local total calls max ────────────────────────────────────────┴──────┴──────┴───────┴─────────┘ ─Pipeline.refine_reflectively_gen ------ 0.0% 95.7% 1 65.956s ├─ReflectiveTactics.do_reflective_pipel 0.0% 88.7% 1 61.172s │└ReflectiveTactics.solve_side_conditio 0.0% 88.4% 1 60.944s │ ├─ReflectiveTactics.do_reify -------- 0.0% 48.5% 1 33.408s │ │└Reify.Reify_rhs_gen --------------- 1.3% 47.9% 1 33.020s │ │ ├─Reify.do_reify_abs_goal --------- 36.0% 36.2% 2 24.960s │ │ │└Reify.do_reifyf_goal ------------ 35.3% 35.5% 117 12.840s │ │ │└eexact -------------------------- 10.9% 10.9% 117 0.088s │ │ ├─rewrite H ----------------------- 3.0% 3.0% 1 2.084s │ │ └─prove_interp_compile_correct ---- 0.0% 2.7% 1 1.856s │ │ └rewrite ?EtaInterp.InterpExprEta 2.5% 2.5% 1 1.692s │ └─ReflectiveTactics.solve_post_reifie 0.1% 39.9% 1 27.536s │ └UnifyAbstractReflexivity.unify_tran 32.0% 37.2% 8 11.528s │ └unify (constr) (constr) ----------- 4.3% 4.3% 6 1.524s └─Glue.refine_to_reflective_glue' ----- 0.0% 6.9% 1 4.784s └Glue.zrange_to_reflective ----------- 0.0% 6.5% 1 4.512s └Glue.zrange_to_reflective_goal ------ 1.3% 4.9% 1 3.396s └pose proof (pf : Interpretation. 3.5% 3.5% 1 2.420s ─synthesize ---------------------------- 0.0% 4.3% 1 2.992s └IntegrationTestTemporaryMiscCommon.do_r 0.0% 4.2% 1 2.912s └change G' ----------------------------- 4.1% 4.1% 1 2.840s Finished transaction in 105.62 secs (97.6u,0.02s) (successful) Closed under the global context total time: 68.948s tactic local total calls max ────────────────────────────────────────┴──────┴──────┴───────┴─────────┘ ─Pipeline.refine_reflectively_gen ------ 0.0% 95.7% 1 65.956s ─ReflectiveTactics.do_reflective_pipelin 0.0% 88.7% 1 61.172s ─ReflectiveTactics.solve_side_conditions 0.0% 88.4% 1 60.944s ─ReflectiveTactics.do_reify ------------ 0.0% 48.5% 1 33.408s ─Reify.Reify_rhs_gen ------------------- 1.3% 47.9% 1 33.020s ─ReflectiveTactics.solve_post_reified_si 0.1% 39.9% 1 27.536s ─UnifyAbstractReflexivity.unify_transfor 32.0% 37.2% 8 11.528s ─Reify.do_reify_abs_goal --------------- 36.0% 36.2% 2 24.960s ─Reify.do_reifyf_goal ------------------ 35.3% 35.5% 117 12.840s ─eexact -------------------------------- 11.4% 11.4% 119 0.160s ─Glue.refine_to_reflective_glue' ------- 0.0% 6.9% 1 4.784s ─Glue.zrange_to_reflective ------------- 0.0% 6.5% 1 4.512s ─Glue.zrange_to_reflective_goal -------- 1.3% 4.9% 1 3.396s ─unify (constr) (constr) --------------- 4.9% 4.9% 7 1.524s ─synthesize ---------------------------- 0.0% 4.3% 1 2.992s ─IntegrationTestTemporaryMiscCommon.do_r 0.0% 4.2% 1 2.912s ─change G' ----------------------------- 4.1% 4.1% 1 2.840s ─pose proof (pf : Interpretation.Bo 3.5% 3.5% 1 2.420s ─rewrite H ----------------------------- 3.0% 3.0% 1 2.084s ─prove_interp_compile_correct ---------- 0.0% 2.7% 1 1.856s ─rewrite ?EtaInterp.InterpExprEta ------ 2.5% 2.5% 1 1.692s tactic local total calls max ────────────────────────────────────────┴──────┴──────┴───────┴─────────┘ ─Pipeline.refine_reflectively_gen ------ 0.0% 95.7% 1 65.956s ├─ReflectiveTactics.do_reflective_pipel 0.0% 88.7% 1 61.172s │└ReflectiveTactics.solve_side_conditio 0.0% 88.4% 1 60.944s │ ├─ReflectiveTactics.do_reify -------- 0.0% 48.5% 1 33.408s │ │└Reify.Reify_rhs_gen --------------- 1.3% 47.9% 1 33.020s │ │ ├─Reify.do_reify_abs_goal --------- 36.0% 36.2% 2 24.960s │ │ │└Reify.do_reifyf_goal ------------ 35.3% 35.5% 117 12.840s │ │ │└eexact -------------------------- 10.9% 10.9% 117 0.088s │ │ ├─rewrite H ----------------------- 3.0% 3.0% 1 2.084s │ │ └─prove_interp_compile_correct ---- 0.0% 2.7% 1 1.856s │ │ └rewrite ?EtaInterp.InterpExprEta 2.5% 2.5% 1 1.692s │ └─ReflectiveTactics.solve_post_reifie 0.1% 39.9% 1 27.536s │ └UnifyAbstractReflexivity.unify_tran 32.0% 37.2% 8 11.528s │ └unify (constr) (constr) ----------- 4.3% 4.3% 6 1.524s └─Glue.refine_to_reflective_glue' ----- 0.0% 6.9% 1 4.784s └Glue.zrange_to_reflective ----------- 0.0% 6.5% 1 4.512s └Glue.zrange_to_reflective_goal ------ 1.3% 4.9% 1 3.396s └pose proof (pf : Interpretation. 3.5% 3.5% 1 2.420s ─synthesize ---------------------------- 0.0% 4.3% 1 2.992s └IntegrationTestTemporaryMiscCommon.do_r 0.0% 4.2% 1 2.912s └change G' ----------------------------- 4.1% 4.1% 1 2.840s src/Specific/solinas32_2e255m765_13limbs/femul (real: 207.94, user: 192.95, sys: 0.48, mem: 1656912 ko) COQC src/Specific/NISTP256/AMD64/femul.v Finished transaction in 122.29 secs (111.972u,0.239s) (successful) total time: 112.164s tactic local total calls max ────────────────────────────────────────┴──────┴──────┴───────┴─────────┘ ─Pipeline.refine_reflectively_gen ------ 0.0% 97.1% 1 108.944s ─ReflectiveTactics.do_reflective_pipelin -0.0% 96.5% 1 108.236s ─ReflectiveTactics.solve_side_conditions 0.0% 96.3% 1 108.000s ─ReflectiveTactics.do_reify ------------ 0.0% 81.8% 1 91.740s ─Reify.Reify_rhs_gen ------------------- 0.7% 81.6% 1 91.504s ─Reify.do_reify_abs_goal --------------- 75.6% 75.7% 2 84.892s ─Reify.do_reifyf_goal ------------------ 75.2% 75.4% 901 84.532s ─eexact -------------------------------- 17.1% 17.1% 903 0.140s ─ReflectiveTactics.solve_post_reified_si 0.2% 14.5% 1 16.260s ─UnifyAbstractReflexivity.unify_transfor 11.7% 13.3% 8 3.152s ─synthesize_montgomery ----------------- 0.0% 2.9% 1 3.220s tactic local total calls max ────────────────────────────────────────┴──────┴──────┴───────┴─────────┘ ─Pipeline.refine_reflectively_gen ------ 0.0% 97.1% 1 108.944s └ReflectiveTactics.do_reflective_pipelin -0.0% 96.5% 1 108.236s └ReflectiveTactics.solve_side_conditions 0.0% 96.3% 1 108.000s ├─ReflectiveTactics.do_reify ---------- 0.0% 81.8% 1 91.740s │└Reify.Reify_rhs_gen ----------------- 0.7% 81.6% 1 91.504s │└Reify.do_reify_abs_goal ------------- 75.6% 75.7% 2 84.892s │└Reify.do_reifyf_goal ---------------- 75.2% 75.4% 901 84.532s │└eexact ------------------------------ 16.9% 16.9% 901 0.140s └─ReflectiveTactics.solve_post_reified_ 0.2% 14.5% 1 16.260s └UnifyAbstractReflexivity.unify_transf 11.7% 13.3% 8 3.152s ─synthesize_montgomery ----------------- 0.0% 2.9% 1 3.220s Finished transaction in 72.408 secs (68.432u,0.064s) (successful) Closed under the global context total time: 112.164s tactic local total calls max ────────────────────────────────────────┴──────┴──────┴───────┴─────────┘ ─Pipeline.refine_reflectively_gen ------ 0.0% 97.1% 1 108.944s ─ReflectiveTactics.do_reflective_pipelin -0.0% 96.5% 1 108.236s ─ReflectiveTactics.solve_side_conditions 0.0% 96.3% 1 108.000s ─ReflectiveTactics.do_reify ------------ 0.0% 81.8% 1 91.740s ─Reify.Reify_rhs_gen ------------------- 0.7% 81.6% 1 91.504s ─Reify.do_reify_abs_goal --------------- 75.6% 75.7% 2 84.892s ─Reify.do_reifyf_goal ------------------ 75.2% 75.4% 901 84.532s ─eexact -------------------------------- 17.1% 17.1% 903 0.140s ─ReflectiveTactics.solve_post_reified_si 0.2% 14.5% 1 16.260s ─UnifyAbstractReflexivity.unify_transfor 11.7% 13.3% 8 3.152s ─synthesize_montgomery ----------------- 0.0% 2.9% 1 3.220s tactic local total calls max ────────────────────────────────────────┴──────┴──────┴───────┴─────────┘ ─Pipeline.refine_reflectively_gen ------ 0.0% 97.1% 1 108.944s └ReflectiveTactics.do_reflective_pipelin -0.0% 96.5% 1 108.236s └ReflectiveTactics.solve_side_conditions 0.0% 96.3% 1 108.000s ├─ReflectiveTactics.do_reify ---------- 0.0% 81.8% 1 91.740s │└Reify.Reify_rhs_gen ----------------- 0.7% 81.6% 1 91.504s │└Reify.do_reify_abs_goal ------------- 75.6% 75.7% 2 84.892s │└Reify.do_reifyf_goal ---------------- 75.2% 75.4% 901 84.532s │└eexact ------------------------------ 16.9% 16.9% 901 0.140s └─ReflectiveTactics.solve_post_reified_ 0.2% 14.5% 1 16.260s └UnifyAbstractReflexivity.unify_transf 11.7% 13.3% 8 3.152s ─synthesize_montgomery ----------------- 0.0% 2.9% 1 3.220s src/Specific/NISTP256/AMD64/femul (real: 217.80, user: 202.52, sys: 0.53, mem: 3307052 ko) COQC src/Specific/NISTP256/AMD64/femulDisplay > src/Specific/NISTP256/AMD64/femulDisplay.log COQC src/Specific/X25519/C64/ladderstep.v total time: 82.012s tactic local total calls max ────────────────────────────────────────┴──────┴──────┴───────┴─────────┘ ─synthesize_xzladderstep --------------- 0.0% 100.0% 1 82.012s ─Pipeline.refine_reflectively_gen ------ 0.0% 99.0% 1 81.228s ─ReflectiveTactics.do_reflective_pipelin 0.0% 96.1% 1 78.784s ─ReflectiveTactics.solve_side_conditions 0.0% 95.9% 1 78.684s ─ReflectiveTactics.solve_post_reified_si 0.1% 72.6% 1 59.540s ─UnifyAbstractReflexivity.unify_transfor 64.6% 68.0% 8 30.740s ─ReflectiveTactics.do_reify ------------ 0.0% 23.3% 1 19.144s ─Reify.Reify_rhs_gen ------------------- 1.2% 14.5% 1 11.860s ─Reify.do_reifyf_goal ------------------ 7.1% 7.2% 138 1.908s ─Compilers.Reify.reify_context_variables 0.0% 5.9% 1 4.828s ─rewrite H ----------------------------- 4.4% 4.4% 1 3.600s ─ReflectiveTactics.unify_abstract_cbv_in 2.9% 4.0% 1 3.288s ─Glue.refine_to_reflective_glue' ------- 0.0% 3.0% 1 2.444s ─Glue.zrange_to_reflective ------------- 0.0% 2.5% 1 2.060s ─reflexivity --------------------------- 2.3% 2.3% 11 0.816s ─Reify.transitivity_tt ----------------- 0.0% 2.1% 2 0.968s ─Glue.zrange_to_reflective_goal -------- 1.4% 2.1% 1 1.720s ─clear (var_list) ---------------------- 2.0% 2.0% 159 0.584s ─eexact -------------------------------- 2.0% 2.0% 140 0.032s tactic local total calls max ────────────────────────────────────────┴──────┴──────┴───────┴─────────┘ ─synthesize_xzladderstep --------------- 0.0% 100.0% 1 82.012s └Pipeline.refine_reflectively_gen ------ 0.0% 99.0% 1 81.228s ├─ReflectiveTactics.do_reflective_pipel 0.0% 96.1% 1 78.784s │└ReflectiveTactics.solve_side_conditio 0.0% 95.9% 1 78.684s │ ├─ReflectiveTactics.solve_post_reifie 0.1% 72.6% 1 59.540s │ │ ├─UnifyAbstractReflexivity.unify_tr 64.6% 68.0% 8 30.740s │ │ └─ReflectiveTactics.unify_abstract_ 2.9% 4.0% 1 3.288s │ └─ReflectiveTactics.do_reify -------- 0.0% 23.3% 1 19.144s │ ├─Reify.Reify_rhs_gen ------------- 1.2% 14.5% 1 11.860s │ │ ├─rewrite H --------------------- 4.4% 4.4% 1 3.600s │ │ └─Reify.transitivity_tt --------- 0.0% 2.1% 2 0.968s │ └─Compilers.Reify.reify_context_var 0.0% 5.9% 1 4.828s │ └Reify.do_reifyf_goal ------------ 5.7% 5.8% 113 1.908s └─Glue.refine_to_reflective_glue' ----- 0.0% 3.0% 1 2.444s └Glue.zrange_to_reflective ----------- 0.0% 2.5% 1 2.060s └Glue.zrange_to_reflective_goal ------ 1.4% 2.1% 1 1.720s Finished transaction in 194.903 secs (185.732u,0.043s) (successful) Closed under the global context total time: 82.012s tactic local total calls max ────────────────────────────────────────┴──────┴──────┴───────┴─────────┘ ─synthesize_xzladderstep --------------- 0.0% 100.0% 1 82.012s ─Pipeline.refine_reflectively_gen ------ 0.0% 99.0% 1 81.228s ─ReflectiveTactics.do_reflective_pipelin 0.0% 96.1% 1 78.784s ─ReflectiveTactics.solve_side_conditions 0.0% 95.9% 1 78.684s ─ReflectiveTactics.solve_post_reified_si 0.1% 72.6% 1 59.540s ─UnifyAbstractReflexivity.unify_transfor 64.6% 68.0% 8 30.740s ─ReflectiveTactics.do_reify ------------ 0.0% 23.3% 1 19.144s ─Reify.Reify_rhs_gen ------------------- 1.2% 14.5% 1 11.860s ─Reify.do_reifyf_goal ------------------ 7.1% 7.2% 138 1.908s ─Compilers.Reify.reify_context_variables 0.0% 5.9% 1 4.828s ─rewrite H ----------------------------- 4.4% 4.4% 1 3.600s ─ReflectiveTactics.unify_abstract_cbv_in 2.9% 4.0% 1 3.288s ─Glue.refine_to_reflective_glue' ------- 0.0% 3.0% 1 2.444s ─Glue.zrange_to_reflective ------------- 0.0% 2.5% 1 2.060s ─reflexivity --------------------------- 2.3% 2.3% 11 0.816s ─Reify.transitivity_tt ----------------- 0.0% 2.1% 2 0.968s ─Glue.zrange_to_reflective_goal -------- 1.4% 2.1% 1 1.720s ─clear (var_list) ---------------------- 2.0% 2.0% 159 0.584s ─eexact -------------------------------- 2.0% 2.0% 140 0.032s tactic local total calls max ────────────────────────────────────────┴──────┴──────┴───────┴─────────┘ ─synthesize_xzladderstep --------------- 0.0% 100.0% 1 82.012s └Pipeline.refine_reflectively_gen ------ 0.0% 99.0% 1 81.228s ├─ReflectiveTactics.do_reflective_pipel 0.0% 96.1% 1 78.784s │└ReflectiveTactics.solve_side_conditio 0.0% 95.9% 1 78.684s │ ├─ReflectiveTactics.solve_post_reifie 0.1% 72.6% 1 59.540s │ │ ├─UnifyAbstractReflexivity.unify_tr 64.6% 68.0% 8 30.740s │ │ └─ReflectiveTactics.unify_abstract_ 2.9% 4.0% 1 3.288s │ └─ReflectiveTactics.do_reify -------- 0.0% 23.3% 1 19.144s │ ├─Reify.Reify_rhs_gen ------------- 1.2% 14.5% 1 11.860s │ │ ├─rewrite H --------------------- 4.4% 4.4% 1 3.600s │ │ └─Reify.transitivity_tt --------- 0.0% 2.1% 2 0.968s │ └─Compilers.Reify.reify_context_var 0.0% 5.9% 1 4.828s │ └Reify.do_reifyf_goal ------------ 5.7% 5.8% 113 1.908s └─Glue.refine_to_reflective_glue' ----- 0.0% 3.0% 1 2.444s └Glue.zrange_to_reflective ----------- 0.0% 2.5% 1 2.060s └Glue.zrange_to_reflective_goal ------ 1.4% 2.1% 1 1.720s src/Specific/X25519/C64/ladderstep (real: 316.83, user: 299.49, sys: 0.52, mem: 1621500 ko) COQC src/Specific/X25519/C64/ladderstepDisplay > src/Specific/X25519/C64/ladderstepDisplay.log time-of-build-both-real-absolute.log.expected000066400000000000000000000076441466560755400366640ustar00rootroot00000000000000coq-8.20.0/test-suite/precomputed-time-tests/correct-diff-sorting-order After | Peak Mem | File Name | Before | Peak Mem || Change || Change (mem) | % Change | % Change (mem) --------------------------------------------------------------------------------------------------------------------------------------------------------- 20m46.07s | 3302508 ko | Total Time / Peak Mem | 23m06.31s | 3307052 ko || -2m20.24s || -4544 ko | -10.11% | -0.13% --------------------------------------------------------------------------------------------------------------------------------------------------------- 4m16.77s | 1617000 ko | Specific/X25519/C64/ladderstep | 5m16.83s | 1621500 ko || -1m00.06s || -4500 ko | -18.95% | -0.27% 3m22.96s | 3302508 ko | Specific/NISTP256/AMD64/femul | 3m37.80s | 3307052 ko || -0m14.84s || -4544 ko | -6.81% | -0.13% 3m01.77s | 1589516 ko | Specific/solinas32_2e255m765_13limbs/femul | 3m27.94s | 1656912 ko || -0m26.17s || -67396 ko | -12.58% | -4.06% 2m35.79s | 1454696 ko | Specific/solinas32_2e255m765_12limbs/femul | 2m59.21s | 1549104 ko || -0m23.42s || -94408 ko | -13.06% | -6.09% 0m49.44s | 744240 ko | Specific/solinas32_2e255m765_13limbs/Synthesis | 0m49.50s | 744472 ko || -0m00.06s || -232 ko | -0.12% | -0.03% 0m43.34s | 793376 ko | Specific/NISTP256/AMD64/fesub | 0m43.78s | 799668 ko || -0m00.44s || -6292 ko | -1.00% | -0.78% 0m40.13s | 728464 ko | Specific/solinas32_2e255m765_12limbs/Synthesis | 0m39.53s | 729464 ko || +0m00.60s || -1000 ko | +1.51% | -0.13% 0m39.72s | 825448 ko | Specific/X25519/C64/femul | 0m42.98s | 839624 ko || -0m03.26s || -14176 ko | -7.58% | -1.68% 0m38.19s | 799216 ko | Specific/NISTP256/AMD64/feadd | 0m40.48s | 797944 ko || -0m02.29s || 1272 ko | -5.65% | +0.15% 0m34.35s | 828104 ko | Specific/X25519/C64/freeze | 0m36.42s | 826476 ko || -0m02.07s || 1628 ko | -5.68% | +0.19% 0m33.08s | 799620 ko | Specific/X25519/C64/fesquare | 0m35.23s | 802776 ko || -0m02.15s || -3156 ko | -6.10% | -0.39% 0m31.00s | 765208 ko | Specific/NISTP256/AMD64/feopp | 0m32.08s | 765212 ko || -0m01.08s || -4 ko | -3.36% | -0.00% 0m27.81s | 756080 ko | Specific/NISTP256/AMD64/fenz | 0m28.91s | 756216 ko || -0m01.10s || -136 ko | -3.80% | -0.01% 0m27.11s | 786052 ko | Specific/X25519/C64/fecarry | 0m28.85s | 787148 ko || -0m01.74s || -1096 ko | -6.03% | -0.13% 0m24.71s | 778792 ko | Specific/X25519/C64/fesub | 0m26.11s | 781808 ko || -0m01.40s || -3016 ko | -5.36% | -0.38% 0m22.81s | 766300 ko | Specific/X25519/C64/feadd | 0m23.43s | 766168 ko || -0m00.62s || 132 ko | -2.64% | +0.01% 0m13.45s | 668216 ko | Specific/NISTP256/AMD64/Synthesis | 0m13.74s | 667664 ko || -0m00.29s || 552 ko | -2.11% | +0.08% 0m11.15s | 687760 ko | Specific/X25519/C64/Synthesis | 0m11.23s | 687812 ko || -0m00.08s || -52 ko | -0.71% | -0.00% 0m07.33s | 574388 ko | Compilers/Z/Bounds/Pipeline/Definition | 0m07.40s | 578344 ko || -0m00.07s || -3956 ko | -0.94% | -0.68% 0m01.93s | 544172 ko | Compilers/Z/Bounds/Pipeline/ReflectiveTactics | 0m01.73s | 546112 ko || +0m00.20s || -1940 ko | +11.56% | -0.35% 0m01.85s | 646300 ko | Specific/Framework/SynthesisFramework | 0m01.95s | 648632 ko || -0m00.10s || -2332 ko | -5.12% | -0.35% 0m01.38s | 539808 ko | Compilers/Z/Bounds/Pipeline | 0m01.18s | 539160 ko || +0m00.20s || 648 ko | +16.94% | +0.12% time-of-build-both-real-auto.log.expected000066400000000000000000000076441466560755400360160ustar00rootroot00000000000000coq-8.20.0/test-suite/precomputed-time-tests/correct-diff-sorting-order After | Peak Mem | File Name | Before | Peak Mem || Change || Change (mem) | % Change | % Change (mem) --------------------------------------------------------------------------------------------------------------------------------------------------------- 20m46.07s | 3302508 ko | Total Time / Peak Mem | 23m06.31s | 3307052 ko || -2m20.24s || -4544 ko | -10.11% | -0.13% --------------------------------------------------------------------------------------------------------------------------------------------------------- 4m16.77s | 1617000 ko | Specific/X25519/C64/ladderstep | 5m16.83s | 1621500 ko || -1m00.06s || -4500 ko | -18.95% | -0.27% 3m01.77s | 1589516 ko | Specific/solinas32_2e255m765_13limbs/femul | 3m27.94s | 1656912 ko || -0m26.17s || -67396 ko | -12.58% | -4.06% 2m35.79s | 1454696 ko | Specific/solinas32_2e255m765_12limbs/femul | 2m59.21s | 1549104 ko || -0m23.42s || -94408 ko | -13.06% | -6.09% 3m22.96s | 3302508 ko | Specific/NISTP256/AMD64/femul | 3m37.80s | 3307052 ko || -0m14.84s || -4544 ko | -6.81% | -0.13% 0m39.72s | 825448 ko | Specific/X25519/C64/femul | 0m42.98s | 839624 ko || -0m03.26s || -14176 ko | -7.58% | -1.68% 0m38.19s | 799216 ko | Specific/NISTP256/AMD64/feadd | 0m40.48s | 797944 ko || -0m02.29s || 1272 ko | -5.65% | +0.15% 0m34.35s | 828104 ko | Specific/X25519/C64/freeze | 0m36.42s | 826476 ko || -0m02.07s || 1628 ko | -5.68% | +0.19% 0m33.08s | 799620 ko | Specific/X25519/C64/fesquare | 0m35.23s | 802776 ko || -0m02.15s || -3156 ko | -6.10% | -0.39% 0m31.00s | 765208 ko | Specific/NISTP256/AMD64/feopp | 0m32.08s | 765212 ko || -0m01.08s || -4 ko | -3.36% | -0.00% 0m27.81s | 756080 ko | Specific/NISTP256/AMD64/fenz | 0m28.91s | 756216 ko || -0m01.10s || -136 ko | -3.80% | -0.01% 0m27.11s | 786052 ko | Specific/X25519/C64/fecarry | 0m28.85s | 787148 ko || -0m01.74s || -1096 ko | -6.03% | -0.13% 0m24.71s | 778792 ko | Specific/X25519/C64/fesub | 0m26.11s | 781808 ko || -0m01.40s || -3016 ko | -5.36% | -0.38% 0m49.44s | 744240 ko | Specific/solinas32_2e255m765_13limbs/Synthesis | 0m49.50s | 744472 ko || -0m00.06s || -232 ko | -0.12% | -0.03% 0m43.34s | 793376 ko | Specific/NISTP256/AMD64/fesub | 0m43.78s | 799668 ko || -0m00.44s || -6292 ko | -1.00% | -0.78% 0m40.13s | 728464 ko | Specific/solinas32_2e255m765_12limbs/Synthesis | 0m39.53s | 729464 ko || +0m00.60s || -1000 ko | +1.51% | -0.13% 0m22.81s | 766300 ko | Specific/X25519/C64/feadd | 0m23.43s | 766168 ko || -0m00.62s || 132 ko | -2.64% | +0.01% 0m13.45s | 668216 ko | Specific/NISTP256/AMD64/Synthesis | 0m13.74s | 667664 ko || -0m00.29s || 552 ko | -2.11% | +0.08% 0m11.15s | 687760 ko | Specific/X25519/C64/Synthesis | 0m11.23s | 687812 ko || -0m00.08s || -52 ko | -0.71% | -0.00% 0m07.33s | 574388 ko | Compilers/Z/Bounds/Pipeline/Definition | 0m07.40s | 578344 ko || -0m00.07s || -3956 ko | -0.94% | -0.68% 0m01.93s | 544172 ko | Compilers/Z/Bounds/Pipeline/ReflectiveTactics | 0m01.73s | 546112 ko || +0m00.20s || -1940 ko | +11.56% | -0.35% 0m01.85s | 646300 ko | Specific/Framework/SynthesisFramework | 0m01.95s | 648632 ko || -0m00.10s || -2332 ko | -5.12% | -0.35% 0m01.38s | 539808 ko | Compilers/Z/Bounds/Pipeline | 0m01.18s | 539160 ko || +0m00.20s || 648 ko | +16.94% | +0.12% time-of-build-both-real-diff.log.expected000066400000000000000000000076441466560755400357560ustar00rootroot00000000000000coq-8.20.0/test-suite/precomputed-time-tests/correct-diff-sorting-order After | Peak Mem | File Name | Before | Peak Mem || Change || Change (mem) | % Change | % Change (mem) --------------------------------------------------------------------------------------------------------------------------------------------------------- 20m46.07s | 3302508 ko | Total Time / Peak Mem | 23m06.31s | 3307052 ko || -2m20.24s || -4544 ko | -10.11% | -0.13% --------------------------------------------------------------------------------------------------------------------------------------------------------- 0m40.13s | 728464 ko | Specific/solinas32_2e255m765_12limbs/Synthesis | 0m39.53s | 729464 ko || +0m00.60s || -1000 ko | +1.51% | -0.13% 0m01.38s | 539808 ko | Compilers/Z/Bounds/Pipeline | 0m01.18s | 539160 ko || +0m00.20s || 648 ko | +16.94% | +0.12% 0m01.93s | 544172 ko | Compilers/Z/Bounds/Pipeline/ReflectiveTactics | 0m01.73s | 546112 ko || +0m00.20s || -1940 ko | +11.56% | -0.35% 0m49.44s | 744240 ko | Specific/solinas32_2e255m765_13limbs/Synthesis | 0m49.50s | 744472 ko || -0m00.06s || -232 ko | -0.12% | -0.03% 0m07.33s | 574388 ko | Compilers/Z/Bounds/Pipeline/Definition | 0m07.40s | 578344 ko || -0m00.07s || -3956 ko | -0.94% | -0.68% 0m11.15s | 687760 ko | Specific/X25519/C64/Synthesis | 0m11.23s | 687812 ko || -0m00.08s || -52 ko | -0.71% | -0.00% 0m01.85s | 646300 ko | Specific/Framework/SynthesisFramework | 0m01.95s | 648632 ko || -0m00.10s || -2332 ko | -5.12% | -0.35% 0m13.45s | 668216 ko | Specific/NISTP256/AMD64/Synthesis | 0m13.74s | 667664 ko || -0m00.29s || 552 ko | -2.11% | +0.08% 0m43.34s | 793376 ko | Specific/NISTP256/AMD64/fesub | 0m43.78s | 799668 ko || -0m00.44s || -6292 ko | -1.00% | -0.78% 0m22.81s | 766300 ko | Specific/X25519/C64/feadd | 0m23.43s | 766168 ko || -0m00.62s || 132 ko | -2.64% | +0.01% 0m31.00s | 765208 ko | Specific/NISTP256/AMD64/feopp | 0m32.08s | 765212 ko || -0m01.08s || -4 ko | -3.36% | -0.00% 0m27.81s | 756080 ko | Specific/NISTP256/AMD64/fenz | 0m28.91s | 756216 ko || -0m01.10s || -136 ko | -3.80% | -0.01% 0m24.71s | 778792 ko | Specific/X25519/C64/fesub | 0m26.11s | 781808 ko || -0m01.40s || -3016 ko | -5.36% | -0.38% 0m27.11s | 786052 ko | Specific/X25519/C64/fecarry | 0m28.85s | 787148 ko || -0m01.74s || -1096 ko | -6.03% | -0.13% 0m34.35s | 828104 ko | Specific/X25519/C64/freeze | 0m36.42s | 826476 ko || -0m02.07s || 1628 ko | -5.68% | +0.19% 0m33.08s | 799620 ko | Specific/X25519/C64/fesquare | 0m35.23s | 802776 ko || -0m02.15s || -3156 ko | -6.10% | -0.39% 0m38.19s | 799216 ko | Specific/NISTP256/AMD64/feadd | 0m40.48s | 797944 ko || -0m02.29s || 1272 ko | -5.65% | +0.15% 0m39.72s | 825448 ko | Specific/X25519/C64/femul | 0m42.98s | 839624 ko || -0m03.26s || -14176 ko | -7.58% | -1.68% 3m22.96s | 3302508 ko | Specific/NISTP256/AMD64/femul | 3m37.80s | 3307052 ko || -0m14.84s || -4544 ko | -6.81% | -0.13% 2m35.79s | 1454696 ko | Specific/solinas32_2e255m765_12limbs/femul | 2m59.21s | 1549104 ko || -0m23.42s || -94408 ko | -13.06% | -6.09% 3m01.77s | 1589516 ko | Specific/solinas32_2e255m765_13limbs/femul | 3m27.94s | 1656912 ko || -0m26.17s || -67396 ko | -12.58% | -4.06% 4m16.77s | 1617000 ko | Specific/X25519/C64/ladderstep | 5m16.83s | 1621500 ko || -1m00.06s || -4500 ko | -18.95% | -0.27% time-of-build-both-real.log.expected000066400000000000000000000076441466560755400350500ustar00rootroot00000000000000coq-8.20.0/test-suite/precomputed-time-tests/correct-diff-sorting-order After | Peak Mem | File Name | Before | Peak Mem || Change || Change (mem) | % Change | % Change (mem) --------------------------------------------------------------------------------------------------------------------------------------------------------- 20m46.07s | 3302508 ko | Total Time / Peak Mem | 23m06.31s | 3307052 ko || -2m20.24s || -4544 ko | -10.11% | -0.13% --------------------------------------------------------------------------------------------------------------------------------------------------------- 4m16.77s | 1617000 ko | Specific/X25519/C64/ladderstep | 5m16.83s | 1621500 ko || -1m00.06s || -4500 ko | -18.95% | -0.27% 3m01.77s | 1589516 ko | Specific/solinas32_2e255m765_13limbs/femul | 3m27.94s | 1656912 ko || -0m26.17s || -67396 ko | -12.58% | -4.06% 2m35.79s | 1454696 ko | Specific/solinas32_2e255m765_12limbs/femul | 2m59.21s | 1549104 ko || -0m23.42s || -94408 ko | -13.06% | -6.09% 3m22.96s | 3302508 ko | Specific/NISTP256/AMD64/femul | 3m37.80s | 3307052 ko || -0m14.84s || -4544 ko | -6.81% | -0.13% 0m39.72s | 825448 ko | Specific/X25519/C64/femul | 0m42.98s | 839624 ko || -0m03.26s || -14176 ko | -7.58% | -1.68% 0m38.19s | 799216 ko | Specific/NISTP256/AMD64/feadd | 0m40.48s | 797944 ko || -0m02.29s || 1272 ko | -5.65% | +0.15% 0m34.35s | 828104 ko | Specific/X25519/C64/freeze | 0m36.42s | 826476 ko || -0m02.07s || 1628 ko | -5.68% | +0.19% 0m33.08s | 799620 ko | Specific/X25519/C64/fesquare | 0m35.23s | 802776 ko || -0m02.15s || -3156 ko | -6.10% | -0.39% 0m31.00s | 765208 ko | Specific/NISTP256/AMD64/feopp | 0m32.08s | 765212 ko || -0m01.08s || -4 ko | -3.36% | -0.00% 0m27.81s | 756080 ko | Specific/NISTP256/AMD64/fenz | 0m28.91s | 756216 ko || -0m01.10s || -136 ko | -3.80% | -0.01% 0m27.11s | 786052 ko | Specific/X25519/C64/fecarry | 0m28.85s | 787148 ko || -0m01.74s || -1096 ko | -6.03% | -0.13% 0m24.71s | 778792 ko | Specific/X25519/C64/fesub | 0m26.11s | 781808 ko || -0m01.40s || -3016 ko | -5.36% | -0.38% 0m49.44s | 744240 ko | Specific/solinas32_2e255m765_13limbs/Synthesis | 0m49.50s | 744472 ko || -0m00.06s || -232 ko | -0.12% | -0.03% 0m43.34s | 793376 ko | Specific/NISTP256/AMD64/fesub | 0m43.78s | 799668 ko || -0m00.44s || -6292 ko | -1.00% | -0.78% 0m40.13s | 728464 ko | Specific/solinas32_2e255m765_12limbs/Synthesis | 0m39.53s | 729464 ko || +0m00.60s || -1000 ko | +1.51% | -0.13% 0m22.81s | 766300 ko | Specific/X25519/C64/feadd | 0m23.43s | 766168 ko || -0m00.62s || 132 ko | -2.64% | +0.01% 0m13.45s | 668216 ko | Specific/NISTP256/AMD64/Synthesis | 0m13.74s | 667664 ko || -0m00.29s || 552 ko | -2.11% | +0.08% 0m11.15s | 687760 ko | Specific/X25519/C64/Synthesis | 0m11.23s | 687812 ko || -0m00.08s || -52 ko | -0.71% | -0.00% 0m07.33s | 574388 ko | Compilers/Z/Bounds/Pipeline/Definition | 0m07.40s | 578344 ko || -0m00.07s || -3956 ko | -0.94% | -0.68% 0m01.93s | 544172 ko | Compilers/Z/Bounds/Pipeline/ReflectiveTactics | 0m01.73s | 546112 ko || +0m00.20s || -1940 ko | +11.56% | -0.35% 0m01.85s | 646300 ko | Specific/Framework/SynthesisFramework | 0m01.95s | 648632 ko || -0m00.10s || -2332 ko | -5.12% | -0.35% 0m01.38s | 539808 ko | Compilers/Z/Bounds/Pipeline | 0m01.18s | 539160 ko || +0m00.20s || 648 ko | +16.94% | +0.12% time-of-build-both-user-absolute.log.expected000066400000000000000000000076441466560755400367170ustar00rootroot00000000000000coq-8.20.0/test-suite/precomputed-time-tests/correct-diff-sorting-order After | Peak Mem | File Name | Before | Peak Mem || Change || Change (mem) | % Change | % Change (mem) --------------------------------------------------------------------------------------------------------------------------------------------------------- 19m16.05s | 3302508 ko | Total Time / Peak Mem | 21m25.28s | 3307052 ko || -2m09.23s || -4544 ko | -10.05% | -0.13% --------------------------------------------------------------------------------------------------------------------------------------------------------- 4m01.34s | 1617000 ko | Specific/X25519/C64/ladderstep | 4m59.49s | 1621500 ko || -0m58.15s || -4500 ko | -19.41% | -0.27% 3m09.62s | 3302508 ko | Specific/NISTP256/AMD64/femul | 3m22.52s | 3307052 ko || -0m12.90s || -4544 ko | -6.36% | -0.13% 2m48.52s | 1589516 ko | Specific/solinas32_2e255m765_13limbs/femul | 3m12.95s | 1656912 ko || -0m24.43s || -67396 ko | -12.66% | -4.06% 2m23.70s | 1454696 ko | Specific/solinas32_2e255m765_12limbs/femul | 2m44.11s | 1549104 ko || -0m20.41s || -94408 ko | -12.43% | -6.09% 0m45.75s | 744240 ko | Specific/solinas32_2e255m765_13limbs/Synthesis | 0m45.58s | 744472 ko || +0m00.17s || -232 ko | +0.37% | -0.03% 0m39.59s | 793376 ko | Specific/NISTP256/AMD64/fesub | 0m40.09s | 799668 ko || -0m00.50s || -6292 ko | -1.24% | -0.78% 0m36.92s | 728464 ko | Specific/solinas32_2e255m765_12limbs/Synthesis | 0m36.64s | 729464 ko || +0m00.28s || -1000 ko | +0.76% | -0.13% 0m36.32s | 825448 ko | Specific/X25519/C64/femul | 0m39.50s | 839624 ko || -0m03.18s || -14176 ko | -8.05% | -1.68% 0m35.40s | 799216 ko | Specific/NISTP256/AMD64/feadd | 0m37.21s | 797944 ko || -0m01.81s || 1272 ko | -4.86% | +0.15% 0m31.50s | 828104 ko | Specific/X25519/C64/freeze | 0m33.24s | 826476 ko || -0m01.74s || 1628 ko | -5.23% | +0.19% 0m30.13s | 799620 ko | Specific/X25519/C64/fesquare | 0m32.24s | 802776 ko || -0m02.11s || -3156 ko | -6.54% | -0.39% 0m28.51s | 765208 ko | Specific/NISTP256/AMD64/feopp | 0m29.46s | 765212 ko || -0m00.95s || -4 ko | -3.22% | -0.00% 0m25.50s | 756080 ko | Specific/NISTP256/AMD64/fenz | 0m26.41s | 756216 ko || -0m00.91s || -136 ko | -3.44% | -0.01% 0m24.99s | 786052 ko | Specific/X25519/C64/fecarry | 0m26.31s | 787148 ko || -0m01.32s || -1096 ko | -5.01% | -0.13% 0m22.65s | 778792 ko | Specific/X25519/C64/fesub | 0m23.72s | 781808 ko || -0m01.07s || -3016 ko | -4.51% | -0.38% 0m20.93s | 766300 ko | Specific/X25519/C64/feadd | 0m21.41s | 766168 ko || -0m00.48s || 132 ko | -2.24% | +0.01% 0m12.55s | 668216 ko | Specific/NISTP256/AMD64/Synthesis | 0m12.54s | 667664 ko || +0m00.01s || 552 ko | +0.07% | +0.08% 0m10.37s | 687760 ko | Specific/X25519/C64/Synthesis | 0m10.30s | 687812 ko || +0m00.07s || -52 ko | +0.67% | -0.00% 0m07.18s | 574388 ko | Compilers/Z/Bounds/Pipeline/Definition | 0m07.22s | 578344 ko || -0m00.04s || -3956 ko | -0.55% | -0.68% 0m01.72s | 544172 ko | Compilers/Z/Bounds/Pipeline/ReflectiveTactics | 0m01.58s | 546112 ko || +0m00.14s || -1940 ko | +8.86% | -0.35% 0m01.67s | 646300 ko | Specific/Framework/SynthesisFramework | 0m01.72s | 648632 ko || -0m00.05s || -2332 ko | -2.90% | -0.35% 0m01.19s | 539808 ko | Compilers/Z/Bounds/Pipeline | 0m01.04s | 539160 ko || +0m00.15s || 648 ko | +14.42% | +0.12% time-of-build-both-user-auto.log.expected000066400000000000000000000076441466560755400360510ustar00rootroot00000000000000coq-8.20.0/test-suite/precomputed-time-tests/correct-diff-sorting-order After | Peak Mem | File Name | Before | Peak Mem || Change || Change (mem) | % Change | % Change (mem) --------------------------------------------------------------------------------------------------------------------------------------------------------- 19m16.05s | 3302508 ko | Total Time / Peak Mem | 21m25.28s | 3307052 ko || -2m09.23s || -4544 ko | -10.05% | -0.13% --------------------------------------------------------------------------------------------------------------------------------------------------------- 4m01.34s | 1617000 ko | Specific/X25519/C64/ladderstep | 4m59.49s | 1621500 ko || -0m58.15s || -4500 ko | -19.41% | -0.27% 2m48.52s | 1589516 ko | Specific/solinas32_2e255m765_13limbs/femul | 3m12.95s | 1656912 ko || -0m24.43s || -67396 ko | -12.66% | -4.06% 2m23.70s | 1454696 ko | Specific/solinas32_2e255m765_12limbs/femul | 2m44.11s | 1549104 ko || -0m20.41s || -94408 ko | -12.43% | -6.09% 3m09.62s | 3302508 ko | Specific/NISTP256/AMD64/femul | 3m22.52s | 3307052 ko || -0m12.90s || -4544 ko | -6.36% | -0.13% 0m36.32s | 825448 ko | Specific/X25519/C64/femul | 0m39.50s | 839624 ko || -0m03.18s || -14176 ko | -8.05% | -1.68% 0m30.13s | 799620 ko | Specific/X25519/C64/fesquare | 0m32.24s | 802776 ko || -0m02.11s || -3156 ko | -6.54% | -0.39% 0m35.40s | 799216 ko | Specific/NISTP256/AMD64/feadd | 0m37.21s | 797944 ko || -0m01.81s || 1272 ko | -4.86% | +0.15% 0m31.50s | 828104 ko | Specific/X25519/C64/freeze | 0m33.24s | 826476 ko || -0m01.74s || 1628 ko | -5.23% | +0.19% 0m24.99s | 786052 ko | Specific/X25519/C64/fecarry | 0m26.31s | 787148 ko || -0m01.32s || -1096 ko | -5.01% | -0.13% 0m22.65s | 778792 ko | Specific/X25519/C64/fesub | 0m23.72s | 781808 ko || -0m01.07s || -3016 ko | -4.51% | -0.38% 0m45.75s | 744240 ko | Specific/solinas32_2e255m765_13limbs/Synthesis | 0m45.58s | 744472 ko || +0m00.17s || -232 ko | +0.37% | -0.03% 0m39.59s | 793376 ko | Specific/NISTP256/AMD64/fesub | 0m40.09s | 799668 ko || -0m00.50s || -6292 ko | -1.24% | -0.78% 0m36.92s | 728464 ko | Specific/solinas32_2e255m765_12limbs/Synthesis | 0m36.64s | 729464 ko || +0m00.28s || -1000 ko | +0.76% | -0.13% 0m28.51s | 765208 ko | Specific/NISTP256/AMD64/feopp | 0m29.46s | 765212 ko || -0m00.95s || -4 ko | -3.22% | -0.00% 0m25.50s | 756080 ko | Specific/NISTP256/AMD64/fenz | 0m26.41s | 756216 ko || -0m00.91s || -136 ko | -3.44% | -0.01% 0m20.93s | 766300 ko | Specific/X25519/C64/feadd | 0m21.41s | 766168 ko || -0m00.48s || 132 ko | -2.24% | +0.01% 0m12.55s | 668216 ko | Specific/NISTP256/AMD64/Synthesis | 0m12.54s | 667664 ko || +0m00.01s || 552 ko | +0.07% | +0.08% 0m10.37s | 687760 ko | Specific/X25519/C64/Synthesis | 0m10.30s | 687812 ko || +0m00.07s || -52 ko | +0.67% | -0.00% 0m07.18s | 574388 ko | Compilers/Z/Bounds/Pipeline/Definition | 0m07.22s | 578344 ko || -0m00.04s || -3956 ko | -0.55% | -0.68% 0m01.72s | 544172 ko | Compilers/Z/Bounds/Pipeline/ReflectiveTactics | 0m01.58s | 546112 ko || +0m00.14s || -1940 ko | +8.86% | -0.35% 0m01.67s | 646300 ko | Specific/Framework/SynthesisFramework | 0m01.72s | 648632 ko || -0m00.05s || -2332 ko | -2.90% | -0.35% 0m01.19s | 539808 ko | Compilers/Z/Bounds/Pipeline | 0m01.04s | 539160 ko || +0m00.15s || 648 ko | +14.42% | +0.12% time-of-build-both-user-diff.log.expected000066400000000000000000000076441466560755400360110ustar00rootroot00000000000000coq-8.20.0/test-suite/precomputed-time-tests/correct-diff-sorting-order After | Peak Mem | File Name | Before | Peak Mem || Change || Change (mem) | % Change | % Change (mem) --------------------------------------------------------------------------------------------------------------------------------------------------------- 19m16.05s | 3302508 ko | Total Time / Peak Mem | 21m25.28s | 3307052 ko || -2m09.23s || -4544 ko | -10.05% | -0.13% --------------------------------------------------------------------------------------------------------------------------------------------------------- 0m36.92s | 728464 ko | Specific/solinas32_2e255m765_12limbs/Synthesis | 0m36.64s | 729464 ko || +0m00.28s || -1000 ko | +0.76% | -0.13% 0m45.75s | 744240 ko | Specific/solinas32_2e255m765_13limbs/Synthesis | 0m45.58s | 744472 ko || +0m00.17s || -232 ko | +0.37% | -0.03% 0m01.19s | 539808 ko | Compilers/Z/Bounds/Pipeline | 0m01.04s | 539160 ko || +0m00.15s || 648 ko | +14.42% | +0.12% 0m01.72s | 544172 ko | Compilers/Z/Bounds/Pipeline/ReflectiveTactics | 0m01.58s | 546112 ko || +0m00.14s || -1940 ko | +8.86% | -0.35% 0m10.37s | 687760 ko | Specific/X25519/C64/Synthesis | 0m10.30s | 687812 ko || +0m00.07s || -52 ko | +0.67% | -0.00% 0m12.55s | 668216 ko | Specific/NISTP256/AMD64/Synthesis | 0m12.54s | 667664 ko || +0m00.01s || 552 ko | +0.07% | +0.08% 0m07.18s | 574388 ko | Compilers/Z/Bounds/Pipeline/Definition | 0m07.22s | 578344 ko || -0m00.04s || -3956 ko | -0.55% | -0.68% 0m01.67s | 646300 ko | Specific/Framework/SynthesisFramework | 0m01.72s | 648632 ko || -0m00.05s || -2332 ko | -2.90% | -0.35% 0m20.93s | 766300 ko | Specific/X25519/C64/feadd | 0m21.41s | 766168 ko || -0m00.48s || 132 ko | -2.24% | +0.01% 0m39.59s | 793376 ko | Specific/NISTP256/AMD64/fesub | 0m40.09s | 799668 ko || -0m00.50s || -6292 ko | -1.24% | -0.78% 0m25.50s | 756080 ko | Specific/NISTP256/AMD64/fenz | 0m26.41s | 756216 ko || -0m00.91s || -136 ko | -3.44% | -0.01% 0m28.51s | 765208 ko | Specific/NISTP256/AMD64/feopp | 0m29.46s | 765212 ko || -0m00.95s || -4 ko | -3.22% | -0.00% 0m22.65s | 778792 ko | Specific/X25519/C64/fesub | 0m23.72s | 781808 ko || -0m01.07s || -3016 ko | -4.51% | -0.38% 0m24.99s | 786052 ko | Specific/X25519/C64/fecarry | 0m26.31s | 787148 ko || -0m01.32s || -1096 ko | -5.01% | -0.13% 0m31.50s | 828104 ko | Specific/X25519/C64/freeze | 0m33.24s | 826476 ko || -0m01.74s || 1628 ko | -5.23% | +0.19% 0m35.40s | 799216 ko | Specific/NISTP256/AMD64/feadd | 0m37.21s | 797944 ko || -0m01.81s || 1272 ko | -4.86% | +0.15% 0m30.13s | 799620 ko | Specific/X25519/C64/fesquare | 0m32.24s | 802776 ko || -0m02.11s || -3156 ko | -6.54% | -0.39% 0m36.32s | 825448 ko | Specific/X25519/C64/femul | 0m39.50s | 839624 ko || -0m03.18s || -14176 ko | -8.05% | -1.68% 3m09.62s | 3302508 ko | Specific/NISTP256/AMD64/femul | 3m22.52s | 3307052 ko || -0m12.90s || -4544 ko | -6.36% | -0.13% 2m23.70s | 1454696 ko | Specific/solinas32_2e255m765_12limbs/femul | 2m44.11s | 1549104 ko || -0m20.41s || -94408 ko | -12.43% | -6.09% 2m48.52s | 1589516 ko | Specific/solinas32_2e255m765_13limbs/femul | 3m12.95s | 1656912 ko || -0m24.43s || -67396 ko | -12.66% | -4.06% 4m01.34s | 1617000 ko | Specific/X25519/C64/ladderstep | 4m59.49s | 1621500 ko || -0m58.15s || -4500 ko | -19.41% | -0.27% time-of-build-both-user.log.expected000066400000000000000000000076441466560755400351030ustar00rootroot00000000000000coq-8.20.0/test-suite/precomputed-time-tests/correct-diff-sorting-order After | Peak Mem | File Name | Before | Peak Mem || Change || Change (mem) | % Change | % Change (mem) --------------------------------------------------------------------------------------------------------------------------------------------------------- 19m16.05s | 3302508 ko | Total Time / Peak Mem | 21m25.28s | 3307052 ko || -2m09.23s || -4544 ko | -10.05% | -0.13% --------------------------------------------------------------------------------------------------------------------------------------------------------- 4m01.34s | 1617000 ko | Specific/X25519/C64/ladderstep | 4m59.49s | 1621500 ko || -0m58.15s || -4500 ko | -19.41% | -0.27% 2m48.52s | 1589516 ko | Specific/solinas32_2e255m765_13limbs/femul | 3m12.95s | 1656912 ko || -0m24.43s || -67396 ko | -12.66% | -4.06% 2m23.70s | 1454696 ko | Specific/solinas32_2e255m765_12limbs/femul | 2m44.11s | 1549104 ko || -0m20.41s || -94408 ko | -12.43% | -6.09% 3m09.62s | 3302508 ko | Specific/NISTP256/AMD64/femul | 3m22.52s | 3307052 ko || -0m12.90s || -4544 ko | -6.36% | -0.13% 0m36.32s | 825448 ko | Specific/X25519/C64/femul | 0m39.50s | 839624 ko || -0m03.18s || -14176 ko | -8.05% | -1.68% 0m30.13s | 799620 ko | Specific/X25519/C64/fesquare | 0m32.24s | 802776 ko || -0m02.11s || -3156 ko | -6.54% | -0.39% 0m35.40s | 799216 ko | Specific/NISTP256/AMD64/feadd | 0m37.21s | 797944 ko || -0m01.81s || 1272 ko | -4.86% | +0.15% 0m31.50s | 828104 ko | Specific/X25519/C64/freeze | 0m33.24s | 826476 ko || -0m01.74s || 1628 ko | -5.23% | +0.19% 0m24.99s | 786052 ko | Specific/X25519/C64/fecarry | 0m26.31s | 787148 ko || -0m01.32s || -1096 ko | -5.01% | -0.13% 0m22.65s | 778792 ko | Specific/X25519/C64/fesub | 0m23.72s | 781808 ko || -0m01.07s || -3016 ko | -4.51% | -0.38% 0m45.75s | 744240 ko | Specific/solinas32_2e255m765_13limbs/Synthesis | 0m45.58s | 744472 ko || +0m00.17s || -232 ko | +0.37% | -0.03% 0m39.59s | 793376 ko | Specific/NISTP256/AMD64/fesub | 0m40.09s | 799668 ko || -0m00.50s || -6292 ko | -1.24% | -0.78% 0m36.92s | 728464 ko | Specific/solinas32_2e255m765_12limbs/Synthesis | 0m36.64s | 729464 ko || +0m00.28s || -1000 ko | +0.76% | -0.13% 0m28.51s | 765208 ko | Specific/NISTP256/AMD64/feopp | 0m29.46s | 765212 ko || -0m00.95s || -4 ko | -3.22% | -0.00% 0m25.50s | 756080 ko | Specific/NISTP256/AMD64/fenz | 0m26.41s | 756216 ko || -0m00.91s || -136 ko | -3.44% | -0.01% 0m20.93s | 766300 ko | Specific/X25519/C64/feadd | 0m21.41s | 766168 ko || -0m00.48s || 132 ko | -2.24% | +0.01% 0m12.55s | 668216 ko | Specific/NISTP256/AMD64/Synthesis | 0m12.54s | 667664 ko || +0m00.01s || 552 ko | +0.07% | +0.08% 0m10.37s | 687760 ko | Specific/X25519/C64/Synthesis | 0m10.30s | 687812 ko || +0m00.07s || -52 ko | +0.67% | -0.00% 0m07.18s | 574388 ko | Compilers/Z/Bounds/Pipeline/Definition | 0m07.22s | 578344 ko || -0m00.04s || -3956 ko | -0.55% | -0.68% 0m01.72s | 544172 ko | Compilers/Z/Bounds/Pipeline/ReflectiveTactics | 0m01.58s | 546112 ko || +0m00.14s || -1940 ko | +8.86% | -0.35% 0m01.67s | 646300 ko | Specific/Framework/SynthesisFramework | 0m01.72s | 648632 ko || -0m00.05s || -2332 ko | -2.90% | -0.35% 0m01.19s | 539808 ko | Compilers/Z/Bounds/Pipeline | 0m01.04s | 539160 ko || +0m00.15s || 648 ko | +14.42% | +0.12% coq-8.20.0/test-suite/precomputed-time-tests/no-output-sync/000077500000000000000000000000001466560755400240625ustar00rootroot00000000000000coq-8.20.0/test-suite/precomputed-time-tests/no-output-sync/run.sh000077500000000000000000000004701466560755400252260ustar00rootroot00000000000000#!/usr/bin/env bash . ../template/init.sh cd "$(dirname "${BASH_SOURCE[0]}")" $make_one_time_file time-of-build.log.in time-of-build.log 2>time-of-build.err.log || exit $? diff -u time-of-build.log.expected time-of-build.log || exit $? diff -u time-of-build.err.log.expected time-of-build.err.log || exit $? coq-8.20.0/test-suite/precomputed-time-tests/no-output-sync/time-of-build.err.log.expected000066400000000000000000000001311466560755400316040ustar00rootroot00000000000000WARNING: Invalid time string: not the right number of dots (.); expected one: '0.240.05' coq-8.20.0/test-suite/precomputed-time-tests/no-output-sync/time-of-build.log.expected000066400000000000000000000601441466560755400310270ustar00rootroot00000000000000 Time | Peak Mem | File Name ------------------------------------------------------------- 29m02.88s | 1136588 ko | Total Time / Peak Mem ------------------------------------------------------------- 2m19.40s | 1007764 ko | PCUICSafeConversion.vo 1m59.92s | 1136588 ko | PCUICSafeReduce.vo 1m34.58s | 849824 ko | PCUICParallelReductionConfluence.vo 1m26.21s | 1038900 ko | erasure_live_test.vo 1m20.36s | 975764 ko | PCUICSR.vo 0m56.51s | 896928 ko | bugkncst.vo 0m56.17s | 1113548 ko | ErasureCorrectness.vo 0m56.09s | 958816 ko | PCUICSafeChecker.vo 0m51.78s | 809012 ko | Typing.vo 0m42.82s | 727688 ko | PCUICTyping.vo 0m39.21s | 1012876 ko | ErasureFunction.vo 0m39.04s | 790088 ko | PCUICEquality.vo 0m38.12s | 657100 ko | PCUICSigmaCalculus.vo 0m34.44s | 742788 ko | PCUICConfluence.vo 0m29.65s | 750296 ko | PCUICConversion.vo 0m28.26s | 779308 ko | PCUICParallelReduction.vo 0m28.24s | 723216 ko | PCUICPosition.vo 0m27.93s | 621392 ko | Substitution.vo 0m26.28s | 597996 ko | PCUICLiftSubst.vo 0m26.11s | 959132 ko | PCUICPrincipality.vo 0m25.86s | 857128 ko | times_bool_fun.vo 0m25.65s | 673140 ko | PCUICSubstitution.vo 0m23.99s | 654592 ko | PCUICClosed.vo 0m23.42s | 685852 ko | PCUICWeakening.vo 0m23.34s | 854428 ko | SafeErasureFunction.vo 0m22.85s | 706592 ko | PCUICSpine.vo 0m21.55s | 603616 ko | Closed.vo 0m19.93s | 581920 ko | tauto.vo 0m19.08s | 683776 ko | PCUICInductives.vo 0m17.91s | 741808 ko | param_original.vo 0m15.64s | 579100 ko | Weakening.vo 0m14.98s | 623196 ko | PCUICNameless.vo 0m13.39s | 794032 ko | ESubstitution.vo 0m13.16s | 641024 ko | TemplateToPCUICCorrectness.vo 0m11.81s | 532016 ko | LiftSubst.vo 0m11.54s | 589944 ko | PCUICWcbvEval.vo 0m10.41s | 621644 ko | PCUICUnivSubstitution.vo 0m10.39s | 661964 ko | PCUICInductiveInversion.vo 0m10.08s | 521520 ko | ELiftSubst.vo 0m09.58s | 684644 ko | PCUICAlpha.vo 0m09.35s | 622488 ko | PCUICInversion.vo 0m08.74s | 629108 ko | PCUICContextConversion.vo 0m08.61s | 892080 ko | param_generous_packed.vo 0m08.05s | 556676 ko | TypingWf.vo 0m07.84s | 608576 ko | PCUICToTemplateCorrectness.vo 0m07.75s | 625664 ko | PCUICArities.vo 0m07.64s | 646256 ko | PCUICElimination.vo 0m07.23s | 614752 ko | times_bool_fun2.vo 0m06.54s | 667924 ko | PCUICSafeLemmata.vo 0m06.33s | 615568 ko | PCUICContexts.vo 0m06.30s | 733700 ko | PCUICSafeRetyping.vo 0m06.16s | 583116 ko | PCUICReduction.vo 0m06.04s | 529900 ko | utils/MCCompare.vo 0m05.85s | 551516 ko | common/uGraph.vo 0m05.66s | 643396 ko | EArities.vo 0m04.94s | 533768 ko | WcbvEval.vo 0m04.90s | 501352 ko | vs.vo 0m04.72s | 498552 ko | utils/wGraph.vo 0m04.53s | 552364 ko | Reflect.vo 0m04.41s | 348856 ko | MiniHoTT.vo 0m04.38s | 571076 ko | PCUICWeakeningEnv.vo 0m04.23s | 531272 ko | Universes.vo 0m04.11s | 543956 ko | PCUICReflect.vo 0m04.00s | 555748 ko | Checker.vo 0m03.99s | 624912 ko | PCUICValidity.vo 0m03.99s | 806128 ko | SafeTemplateErasure.vo 0m03.85s | 520080 ko | EWcbvEval.vo 0m03.42s | 350716 ko | MiniHoTT_paths.vo 0m03.39s | 741428 ko | Prelim.vo 0m03.34s | 586388 ko | PCUICGeneration.vo 0m03.33s | 533884 ko | PCUICUnivSubst.vo 0m03.11s | 561316 ko | Extraction.vo 0m03.11s | 490756 ko | UnivSubst.vo 0m02.89s | 726228 ko | safechecker_test.vo 0m02.80s | 512292 ko | WeakeningEnv.vo 0m02.78s | 543424 ko | PCUICAstUtils.vo 0m02.78s | 465984 ko | utils/All_Forall.vo 0m02.67s | 729072 ko | EInversion.vo 0m02.42s | 703592 ko | SafeTemplateChecker.vo 0m02.27s | 558304 ko | TypingTests.vo 0m02.12s | 630488 ko | PCUICSN.vo 0m01.93s | 556444 ko | param_binary.vo 0m01.85s | 561876 ko | PCUICCumulativity.vo 0m01.82s | 554420 ko | translation_utils.vo 0m01.77s | 491968 ko | EnvironmentTyping.vo 0m01.75s | 598288 ko | PCUICCtxShape.vo 0m01.69s | 514692 ko | Generation.vo 0m01.62s | 512080 ko | bug5.vo 0m01.58s | 589768 ko | PCUICRetyping.vo 0m01.57s | 617808 ko | Extract.vo 0m01.56s | 527740 ko | demo.vo 0m01.55s | 562424 ko | PCUICCSubst.vo 0m01.49s | 553352 ko | param_cheap_packed.vo 0m01.47s | 527440 ko | PCUICUtils.vo 0m01.47s | 452340 ko | utils/MCList.vo 0m01.44s | 503484 ko | PCUICSize.vo 0m01.42s | 619396 ko | EAll.vo 0m01.37s | 551200 ko | PCUICNormal.vo 0m01.35s | 526276 ko | modules_sections.vo 0m01.34s | 549492 ko | standard_model.vo 0m01.30s | 551364 ko | PCUICPretty.vo 0m01.29s | 545736 ko | All.vo 0m01.21s | 524028 ko | proj.vo 0m01.21s | 513888 ko | test/test.vo 0m01.18s | 486324 ko | Induction.vo 0m01.13s | 524144 ko | add_constructor.vo 0m01.11s | 549776 ko | PCUICChecker.vo 0m01.10s | 487520 ko | EAstUtils.vo 0m01.10s | 484172 ko | Environment.vo 0m01.10s | 543584 ko | erasure_test.vo 0m01.09s | 525128 ko | order_rec.vo 0m01.05s | 512080 ko | ECSubst.vo 0m01.05s | 489932 ko | WfInv.vo 0m01.05s | 522968 ko | issue28.vo 0m01.04s | 527408 ko | PCUICToTemplate.vo 0m01.03s | 510284 ko | bug1.vo 0m01.03s | 522996 ko | run_in_tactic.vo 0m01.03s | 522248 ko | unfold.vo 0m01.02s | 522688 ko | issue27.vo 0m01.01s | 524932 ko | tmVariable.vo 0m01.00s | 485664 ko | AstUtils.vo 0m00.99s | 522992 ko | univ.vo 0m00.98s | 522552 ko | tmInferInstance.vo 0m00.96s | 546928 ko | PCUICMetaTheory.vo 0m00.94s | 510368 ko | castprop.vo 0m00.94s | 500016 ko | opaque.vo 0m00.92s | 522724 ko | tmExistingInstance.vo 0m00.91s | 513348 ko | MyPlugin.vo 0m00.90s | 524140 ko | Retyping.vo 0m00.90s | 500080 ko | letin.vo 0m00.89s | 481312 ko | PCUICInduction.vo 0m00.89s | 500252 ko | bug7.vo 0m00.89s | 500068 ko | mutind.vo 0m00.88s | 500120 ko | case.vo 0m00.88s | 501748 ko | extractable.vo 0m00.87s | 486460 ko | Pretty.vo 0m00.86s | 500064 ko | sigma.vo 0m00.85s | 500408 ko | bug6.vo 0m00.84s | 497360 ko | Normal.vo 0m00.84s | 500436 ko | bug8.vo 0m00.82s | 498504 ko | Constants.vo 0m00.81s | 500380 ko | bug2.vo 0m00.81s | 500192 ko | cofix.vo 0m00.80s | 502088 ko | hnf_ctor.vo 0m00.79s | 479940 ko | Ast.vo 0m00.79s | 500100 ko | evars.vo 0m00.77s | 488076 ko | EPretty.vo 0m00.75s | 450728 ko | BasicAst.vo 0m00.75s | 477372 ko | PCUICAst.vo 0m00.73s | 487644 ko | ETyping.vo 0m00.73s | 481988 ko | TemplateMonad/Core.vo 0m00.72s | 477800 ko | EAst.vo 0m00.71s | 479012 ko | EInduction.vo 0m00.70s | 485084 ko | EWndEval.vo 0m00.70s | 481156 ko | TemplateMonad/Extractable.vo 0m00.69s | 482472 ko | TemplateToPCUIC.vo 0m00.60s | 433064 ko | PCUICCheckerCompleteness.vo 0m00.60s | 437492 ko | TemplateMonad/Common.vo 0m00.56s | 440168 ko | utils/MCOption.vo 0m00.54s | 420452 ko | TemplateMonad.vo 0m00.52s | 385340 ko | utils.vo 0m00.48s | 404556 ko | utils/MCArith.vo 0m00.42s | 339136 ko | utils/LibHypsNaming.vo 0m00.41s | 39160 ko | gen-src/universes0.cmx 0m00.33s | 45284 ko | pCUICSafeChecker.cmx 0m00.30s | 270156 ko | utils/MCString.vo 0m00.29s | 238116 ko | Loader.vo 0m00.27s | 43056 ko | pCUICSafeConversion.cmx 0m00.240s | N/A | denoter.cmx 0m00.19s | 34468 ko | gen-src/quoter.cmx 0m00.17s | 33044 ko | constr_quoter.cmx 0m00.15s | 25208 ko | gen-src/binPos.cmx 0m00.15s | 38520 ko | run_template_monad.cmx 0m00.14s | 31740 ko | constr_denoter.cmx 0m00.14s | 25372 ko | gen-src/all_Forall.cmx 0m00.14s | 149456 ko | monad_utils.vo 0m00.14s | 31636 ko | wGraph.cmx 0m00.13s | 23892 ko | gen-src/binPosDef.cmx 0m00.13s | 20232 ko | metacoq_erasure_plugin.cmxs 0m00.12s | 22784 ko | gen-src/binInt.cmx 0m00.11s | 31208 ko | erasureFunction.cmx 0m00.11s | 31632 ko | gen-src/metacoq_template_plugin.cmx 0m00.11s | 20224 ko | metacoq_safechecker_plugin.cmxs 0m00.11s | 30984 ko | uGraph0.cmx 0m00.10s | 28644 ko | eAst.cmx 0m00.10s | 33140 ko | g_template_coq.cmx 0m00.10s | 27364 ko | gen-src/ast_quoter.cmx 0m00.10s | 20796 ko | gen-src/binNat.cmx 0m00.10s | 18416 ko | gen-src/metacoq_template_plugin.cmxs 0m00.10s | 27228 ko | gen-src/myPlugin.cmx 0m00.10s | 26404 ko | gen-src/quoter.cmo 0m00.09s | 26992 ko | ePretty.cmx 0m00.09s | 35368 ko | g_metacoq_safechecker.cmx 0m00.09s | 24572 ko | gen-src/ast0.cmx 0m00.09s | 20020 ko | gen-src/hexadecimal.cmx 0m00.09s | 30504 ko | gen-src/run_extractable.cmx 0m00.09s | 29148 ko | pCUICPretty.cmx 0m00.09s | 29852 ko | safeErasureFunction.cmx 0m00.09s | 88348 ko | utils/MCProd.vo 0m00.08s | 27288 ko | gen-src/ast_denoter.cmx 0m00.08s | 24324 ko | gen-src/denoter.cmx 0m00.08s | 21352 ko | gen-src/mSetList.cmx 0m00.08s | 22020 ko | gen-src/pretty.cmx 0m00.08s | 32668 ko | metacoq_erasure_plugin.cmx 0m00.08s | 26392 ko | pCUICAstUtils.cmx 0m00.08s | 27752 ko | pCUICTyping.cmx 0m00.07s | 19912 ko | gen-src/peanoNat.cmx 0m00.07s | 27504 ko | gen-src/plugin_core.cmx 0m00.07s | 27792 ko | pCUICSafeReduce.cmx 0m00.07s | 30244 ko | safeTemplateErasure.cmx 0m00.06s | 24684 ko | eTyping.cmx 0m00.06s | 22652 ko | erasureFunction.cmi 0m00.06s | 27844 ko | g_demo_plugin.cmx 0m00.06s | 30052 ko | g_metacoq_erasure.cmx 0m00.06s | 25216 ko | mSetWeakList.cmx 0m00.06s | 30436 ko | metacoq_safechecker_plugin.cmx 0m00.06s | 26256 ko | pCUICEquality.cmx 0m00.06s | 26244 ko | pCUICLiftSubst.cmx 0m00.06s | 26048 ko | pCUICPosition.cmx 0m00.06s | 23232 ko | pCUICSafeConversion.cmi 0m00.06s | 27380 ko | pCUICSafeRetyping.cmx 0m00.06s | 25408 ko | safeTemplateChecker.cmx 0m00.06s | 26384 ko | templateToPCUIC.cmx 0m00.06s | 24780 ko | uGraph0.cmi 0m00.05s | 64048 ko | Lens.vo 0m00.05s | 24800 ko | eAstUtils.cmx 0m00.05s | 25192 ko | eLiftSubst.cmx 0m00.05s | 22440 ko | gen-src/ast_quoter.cmo 0m00.05s | 20324 ko | gen-src/mSetInterface.cmx 0m00.05s | 26032 ko | pCUICAst.cmx 0m00.05s | 25140 ko | pCUICChecker.cmx 0m00.05s | 24336 ko | pCUICReflect.cmx 0m00.05s | 24300 ko | pCUICSafeChecker.cmi 0m00.05s | 21556 ko | pCUICSafeReduce.cmi 0m00.05s | 25180 ko | pCUICUnivSubst.cmx 0m00.05s | 21660 ko | safeErasureFunction.cmi 0m00.05s | 23148 ko | safeTemplateErasure.cmi 0m00.05s | 21328 ko | templateToPCUIC.cmi 0m00.05s | 16040 ko | template_coq.cmxs 0m00.05s | 24076 ko | typing0.cmx 0m00.05s | 63096 ko | utils/MCPrelude.vo 0m00.05s | 68156 ko | utils/MCRelations.vo 0m00.05s | 22824 ko | wGraph.cmi 0m00.04s | 62716 ko | ExtractableLoader.vo 0m00.04s | 61716 ko | config.vo 0m00.04s | 22020 ko | constr_reification.cmx 0m00.04s | 21964 ko | demo_plugin.cmx 0m00.04s | 20540 ko | ePretty.cmi 0m00.04s | 23032 ko | extract.cmx 0m00.04s | 19608 ko | gen-src/astUtils.cmx 0m00.04s | 18780 ko | gen-src/extractable.cmx 0m00.04s | 22124 ko | gen-src/lens.cmx 0m00.04s | 19008 ko | gen-src/liftSubst.cmx 0m00.04s | 19600 ko | gen-src/mSetProperties.cmx 0m00.04s | 20208 ko | gen-src/myPlugin.cmi 0m00.04s | 18464 ko | gen-src/nat0.cmx 0m00.04s | 22136 ko | gen-src/tm_util.cmx 0m00.04s | 18504 ko | gen-src/universes0.cmi 0m00.04s | 20108 ko | mSetWeakList.cmi 0m00.04s | 22452 ko | monad_utils.cmx 0m00.04s | 21244 ko | pCUICAst.cmi 0m00.04s | 20412 ko | pCUICAstUtils.cmi 0m00.04s | 21236 ko | pCUICChecker.cmi 0m00.04s | 20560 ko | pCUICPretty.cmi 0m00.04s | 21400 ko | pCUICTyping.cmi 0m00.04s | 20348 ko | safeTemplateChecker.cmi 0m00.04s | 19228 ko | utils.cmi 0m00.04s | 22212 ko | utils.cmx 0m00.04s | 62924 ko | utils/MCEquality.vo 0m00.04s | 61384 ko | utils/MCSquash.vo 0m00.03s | 19340 ko | classes0.cmi 0m00.03s | 20908 ko | eAst.cmi 0m00.03s | 19496 ko | eAstUtils.cmi 0m00.03s | 20252 ko | eTyping.cmi 0m00.03s | 19268 ko | eqDecInstances.cmi 0m00.03s | 22196 ko | eqDecInstances.cmx 0m00.03s | 19396 ko | eqdepFacts.cmi 0m00.03s | 22072 ko | eqdepFacts.cmx 0m00.03s | 21060 ko | extract.cmi 0m00.03s | 18744 ko | gen-src/basicAst.cmx 0m00.03s | 17936 ko | gen-src/decimal.cmx 0m00.03s | 19716 ko | gen-src/environment.cmx 0m00.03s | 19172 ko | gen-src/lens.cmi 0m00.03s | 17796 ko | gen-src/list0.cmx 0m00.03s | 18548 ko | gen-src/univSubst0.cmx 0m00.03s | 19324 ko | init.cmi 0m00.03s | 22188 ko | init.cmx 0m00.03s | 19272 ko | monad_utils.cmi 0m00.03s | 20372 ko | pCUICEquality.cmi 0m00.03s | 20444 ko | pCUICLiftSubst.cmi 0m00.03s | 22044 ko | pCUICNormal.cmx 0m00.03s | 20488 ko | pCUICPosition.cmi 0m00.03s | 20240 ko | pCUICReflect.cmi 0m00.03s | 19348 ko | pCUICSafeLemmata.cmi 0m00.03s | 21604 ko | pCUICSafeRetyping.cmi 0m00.03s | 20308 ko | pCUICUnivSubst.cmi 0m00.03s | 21812 ko | tm_util.cmx 0m00.03s | 20300 ko | typing0.cmi 0m00.02s | 21960 ko | classes0.cmx 0m00.02s | 19300 ko | eLiftSubst.cmi 0m00.02s | 16900 ko | gen-src/ascii.cmx 0m00.02s | 16836 ko | gen-src/cRelationClasses.cmx 0m00.02s | 16420 ko | gen-src/common0.cmx 0m00.02s | 16472 ko | gen-src/mCString.cmx 0m00.02s | 15244 ko | gen-src/mSetInterface.cmi 0m00.02s | 15212 ko | gen-src/mSetProperties.cmi 0m00.02s | 17196 ko | gen-src/plugin_core.cmi 0m00.02s | 16332 ko | gen-src/specif.cmx 0m00.02s | 16504 ko | gen-src/string0.cmx 0m00.02s | 18448 ko | gen-src/tm_util.cmo 0m00.02s | 19224 ko | pCUICCumulativity.cmi 0m00.02s | 21940 ko | pCUICCumulativity.cmx 0m00.02s | 19304 ko | pCUICNormal.cmi 0m00.02s | 22084 ko | pCUICSafeLemmata.cmx 0m00.02s | 19220 ko | ssrbool.cmi 0m00.02s | 21912 ko | ssrbool.cmx 0m00.02s | 19956 ko | template_coq.cmx 0m00.01s | 14256 ko | demo_plugin.cmxs 0m00.01s | 14992 ko | gen-src/all_Forall.cmi 0m00.01s | 15204 ko | gen-src/ast0.cmi 0m00.01s | 14404 ko | gen-src/basicAst.cmi 0m00.01s | 13564 ko | gen-src/binInt.cmi 0m00.01s | 14264 ko | gen-src/binPos.cmi 0m00.01s | 15772 ko | gen-src/bool.cmx 0m00.01s | 13388 ko | gen-src/cRelationClasses.cmi 0m00.01s | 15536 ko | gen-src/compare_dec.cmx 0m00.01s | 16200 ko | gen-src/datatypes.cmx 0m00.01s | 14988 ko | gen-src/environment.cmi 0m00.01s | 15840 ko | gen-src/equalities.cmx 0m00.01s | 13404 ko | gen-src/list0.cmi 0m00.01s | 15672 ko | gen-src/mCCompare.cmx 0m00.01s | 16712 ko | gen-src/mCList.cmx 0m00.01s | 15708 ko | gen-src/mCProd.cmx 0m00.01s | 13748 ko | gen-src/mSetFacts.cmi 0m00.01s | 17012 ko | gen-src/mSetFacts.cmx 0m00.01s | 15760 ko | gen-src/mSetList.cmi 0m00.01s | 14056 ko | gen-src/metacoq_template_plugin.cmxa 0m00.01s | 15860 ko | gen-src/orderedType0.cmx 0m00.01s | 13748 ko | gen-src/orders.cmi 0m00.01s | 16768 ko | gen-src/orders.cmx 0m00.01s | 16032 ko | gen-src/ordersFacts.cmx 0m00.01s | 15844 ko | gen-src/ordersTac.cmx 0m00.01s | 11760 ko | gen-src/reification.cmo 0m00.01s | 14740 ko | gen-src/reification.cmx 0m00.01s | 13824 ko | gen-src/run_extractable.cmi 0m00.01s | 13460 ko | i 0m00.01s | 17068 ko | plugin_core.cmi 0m00.01s | 14796 ko | reification.cmx 0m00.00s | 13200 ko | demo_plugin.cmxa 0m00.00s | 12228 ko | gen-src/ascii.cmi 0m00.00s | 14040 ko | gen-src/astUtils.cmi 0m00.00s | 11244 ko | gen-src/basics.cmi 0m00.00s | 13444 ko | gen-src/binNat.cmi 0m00.00s | 11340 ko | gen-src/binNums.cmi 0m00.00s | 13536 ko | gen-src/binPosDef.cmi 0m00.00s | 11744 ko | gen-src/bool.cmi 0m00.00s | 13492 ko | gen-src/common0.cmi 0m00.00s | 11720 ko | gen-src/compare_dec.cmi 0m00.00s | 11112 ko | gen-src/config0.cmi 0m00.00s | 14648 ko | gen-src/config0.cmx 0m00.00s | 12948 ko | gen-src/datatypes.cmi 0m00.00s | 12404 ko | gen-src/decimal.cmi 0m00.00s | 13240 ko | gen-src/equalities.cmi 0m00.00s | 13580 ko | gen-src/extractable.cmi 0m00.00s | 13064 ko | gen-src/hexadecimal.cmi 0m00.00s | 13680 ko | gen-src/liftSubst.cmi 0m00.00s | 11524 ko | gen-src/logic0.cmi 0m00.00s | 15516 ko | gen-src/logic0.cmx 0m00.00s | 11644 ko | gen-src/mCCompare.cmi 0m00.00s | 13612 ko | gen-src/mCList.cmi 0m00.00s | 12200 ko | gen-src/mCOption.cmi 0m00.00s | 11228 ko | gen-src/mCPrelude.cmi 0m00.00s | 14368 ko | gen-src/mCPrelude.cmx 0m00.00s | 11620 ko | gen-src/mCProd.cmi 0m00.00s | 11080 ko | gen-src/mCRelations.cmi 0m00.00s | 14184 ko | gen-src/mCRelations.cmx 0m00.00s | 11712 ko | gen-src/mCString.cmi 0m00.00s | 13776 ko | gen-src/mSetDecide.cmi 0m00.00s | 11900 ko | gen-src/numeral.cmi 0m00.00s | 15820 ko | gen-src/numeral.cmx 0m00.00s | 12108 ko | gen-src/orderedType0.cmi 0m00.00s | 13444 ko | gen-src/ordersFacts.cmi 0m00.00s | 11760 ko | gen-src/ordersLists.cmi 0m00.00s | 15096 ko | gen-src/ordersLists.cmx 0m00.00s | 12464 ko | gen-src/ordersTac.cmi 0m00.00s | 15060 ko | gen-src/pretty.cmi 0m00.00s | 13160 ko | gen-src/specif.cmi 0m00.00s | 12236 ko | gen-src/string0.cmi 0m00.00s | 14128 ko | gen-src/univSubst0.cmi 0m00.00s | 13520 ko | metacoq_erasure_plugin.cmxa 0m00.00s | 13624 ko | metacoq_safechecker_plugin.cmxa 0m00.00s | 13148 ko | run_template_monad.cmi 0m00.00s | 13520 ko | template_coq.cmxa 0m00.00s | 15004 ko | template_monad.cmi coq-8.20.0/test-suite/precomputed-time-tests/no-output-sync/time-of-build.log.in000066400000000000000000011442121466560755400276340ustar00rootroot00000000000000Running with gitlab-runner 11.9.2 (fa86510e)  on roquableu curNbQZR Using Docker executor with image registry.gitlab.com/coq/coq:bionic_coq-V2020-08-28-V92 ... Pulling docker image registry.gitlab.com/coq/coq:bionic_coq-V2020-08-28-V92 ... Using docker image sha256:f232f9802a06400390b5d6afa5fd280d73c89890309a27e840013ef2e9809c91 for registry.gitlab.com/coq/coq:bionic_coq-V2020-08-28-V92 ... section_start:1598963621:prepare_script Running on runner-curNbQZR-project-6138686-concurrent-1 via roquableu... section_end:1598963624:prepare_script section_start:1598963624:get_sources Reinitialized existing Git repository in /builds/coq/coq/.git/ Removing _build_ci/ Removing _install_ci/ Removing config/Makefile Removing config/coq_config.ml Removing config/coq_config.py Removing test-suite/misc/universes/all_stdlib.v Removing time-of-build.log Removing tools/TimeFileMaker.pyc Clean repository Fetching changes with git depth set to 10... fatal: remote origin already exists. Auto packing the repository in background for optimum performance. See "git help gc" for manual housekeeping. Checking out fdbbc0cb as pr-12653... Skipping Git submodules setup section_end:1598963638:get_sources section_start:1598963638:restore_cache section_end:1598963641:restore_cache section_start:1598963641:download_artifacts Downloading artifacts for build:base (713526714)... Downloading artifacts from coordinator... ok  id=713526714 responseStatus=200 OK token=CwEA_cmf Downloading artifacts for plugin:ci-equations (713526793)... Downloading artifacts from coordinator... ok  id=713526793 responseStatus=200 OK token=hxEjzCme section_end:1598963691:download_artifacts section_start:1598963691:build_script $ cat /proc/{cpu,mem}info || true processor : 0 vendor_id : GenuineIntel cpu family : 6 model : 45 model name : Intel(R) Xeon(R) CPU E5-2667 0 @ 2.90GHz stepping : 7 microcode : 0x718 cpu MHz : 3192.059 cache size : 15360 KB physical id : 0 siblings : 12 core id : 0 cpu cores : 6 apicid : 0 initial apicid : 0 fpu : yes fpu_exception : yes cpuid level : 13 wp : yes flags : fpu vme de pse tsc msr pae mce cx8 apic sep mtrr pge mca cmov pat pse36 clflush dts acpi mmx fxsr sse sse2 ss ht tm pbe syscall nx pdpe1gb rdtscp lm constant_tsc arch_perfmon pebs bts rep_good nopl xtopology nonstop_tsc cpuid aperfmperf pni pclmulqdq dtes64 monitor ds_cpl vmx smx est tm2 ssse3 cx16 xtpr pdcm pcid dca sse4_1 sse4_2 x2apic popcnt tsc_deadline_timer aes xsave avx lahf_lm epb pti ssbd ibrs ibpb stibp tpr_shadow vnmi flexpriority ept vpid xsaveopt dtherm ida arat pln pts md_clear flush_l1d bugs : cpu_meltdown spectre_v1 spectre_v2 spec_store_bypass l1tf mds swapgs itlb_multihit bogomips : 5785.73 clflush size : 64 cache_alignment : 64 address sizes : 46 bits physical, 48 bits virtual power management: processor : 1 vendor_id : GenuineIntel cpu family : 6 model : 45 model name : Intel(R) Xeon(R) CPU E5-2667 0 @ 2.90GHz stepping : 7 microcode : 0x718 cpu MHz : 3192.128 cache size : 15360 KB physical id : 0 siblings : 12 core id : 1 cpu cores : 6 apicid : 2 initial apicid : 2 fpu : yes fpu_exception : yes cpuid level : 13 wp : yes flags : fpu vme de pse tsc msr pae mce cx8 apic sep mtrr pge mca cmov pat pse36 clflush dts acpi mmx fxsr sse sse2 ss ht tm pbe syscall nx pdpe1gb rdtscp lm constant_tsc arch_perfmon pebs bts rep_good nopl xtopology nonstop_tsc cpuid aperfmperf pni pclmulqdq dtes64 monitor ds_cpl vmx smx est tm2 ssse3 cx16 xtpr pdcm pcid dca sse4_1 sse4_2 x2apic popcnt tsc_deadline_timer aes xsave avx lahf_lm epb pti ssbd ibrs ibpb stibp tpr_shadow vnmi flexpriority ept vpid xsaveopt dtherm ida arat pln pts md_clear flush_l1d bugs : cpu_meltdown spectre_v1 spectre_v2 spec_store_bypass l1tf mds swapgs itlb_multihit bogomips : 5785.73 clflush size : 64 cache_alignment : 64 address sizes : 46 bits physical, 48 bits virtual power management: processor : 2 vendor_id : GenuineIntel cpu family : 6 model : 45 model name : Intel(R) Xeon(R) CPU E5-2667 0 @ 2.90GHz stepping : 7 microcode : 0x718 cpu MHz : 3192.132 cache size : 15360 KB physical id : 0 siblings : 12 core id : 2 cpu cores : 6 apicid : 4 initial apicid : 4 fpu : yes fpu_exception : yes cpuid level : 13 wp : yes flags : fpu vme de pse tsc msr pae mce cx8 apic sep mtrr pge mca cmov pat pse36 clflush dts acpi mmx fxsr sse sse2 ss ht tm pbe syscall nx pdpe1gb rdtscp lm constant_tsc arch_perfmon pebs bts rep_good nopl xtopology nonstop_tsc cpuid aperfmperf pni pclmulqdq dtes64 monitor ds_cpl vmx smx est tm2 ssse3 cx16 xtpr pdcm pcid dca sse4_1 sse4_2 x2apic popcnt tsc_deadline_timer aes xsave avx lahf_lm epb pti ssbd ibrs ibpb stibp tpr_shadow vnmi flexpriority ept vpid xsaveopt dtherm ida arat pln pts md_clear flush_l1d bugs : cpu_meltdown spectre_v1 spectre_v2 spec_store_bypass l1tf mds swapgs itlb_multihit bogomips : 5785.73 clflush size : 64 cache_alignment : 64 address sizes : 46 bits physical, 48 bits virtual power management: processor : 3 vendor_id : GenuineIntel cpu family : 6 model : 45 model name : Intel(R) Xeon(R) CPU E5-2667 0 @ 2.90GHz stepping : 7 microcode : 0x718 cpu MHz : 3192.131 cache size : 15360 KB physical id : 0 siblings : 12 core id : 3 cpu cores : 6 apicid : 6 initial apicid : 6 fpu : yes fpu_exception : yes cpuid level : 13 wp : yes flags : fpu vme de pse tsc msr pae mce cx8 apic sep mtrr pge mca cmov pat pse36 clflush dts acpi mmx fxsr sse sse2 ss ht tm pbe syscall nx pdpe1gb rdtscp lm constant_tsc arch_perfmon pebs bts rep_good nopl xtopology nonstop_tsc cpuid aperfmperf pni pclmulqdq dtes64 monitor ds_cpl vmx smx est tm2 ssse3 cx16 xtpr pdcm pcid dca sse4_1 sse4_2 x2apic popcnt tsc_deadline_timer aes xsave avx lahf_lm epb pti ssbd ibrs ibpb stibp tpr_shadow vnmi flexpriority ept vpid xsaveopt dtherm ida arat pln pts md_clear flush_l1d bugs : cpu_meltdown spectre_v1 spectre_v2 spec_store_bypass l1tf mds swapgs itlb_multihit bogomips : 5785.73 clflush size : 64 cache_alignment : 64 address sizes : 46 bits physical, 48 bits virtual power management: processor : 4 vendor_id : GenuineIntel cpu family : 6 model : 45 model name : Intel(R) Xeon(R) CPU E5-2667 0 @ 2.90GHz stepping : 7 microcode : 0x718 cpu MHz : 3192.127 cache size : 15360 KB physical id : 0 siblings : 12 core id : 4 cpu cores : 6 apicid : 8 initial apicid : 8 fpu : yes fpu_exception : yes cpuid level : 13 wp : yes flags : fpu vme de pse tsc msr pae mce cx8 apic sep mtrr pge mca cmov pat pse36 clflush dts acpi mmx fxsr sse sse2 ss ht tm pbe syscall nx pdpe1gb rdtscp lm constant_tsc arch_perfmon pebs bts rep_good nopl xtopology nonstop_tsc cpuid aperfmperf pni pclmulqdq dtes64 monitor ds_cpl vmx smx est tm2 ssse3 cx16 xtpr pdcm pcid dca sse4_1 sse4_2 x2apic popcnt tsc_deadline_timer aes xsave avx lahf_lm epb pti ssbd ibrs ibpb stibp tpr_shadow vnmi flexpriority ept vpid xsaveopt dtherm ida arat pln pts md_clear flush_l1d bugs : cpu_meltdown spectre_v1 spectre_v2 spec_store_bypass l1tf mds swapgs itlb_multihit bogomips : 5785.73 clflush size : 64 cache_alignment : 64 address sizes : 46 bits physical, 48 bits virtual power management: processor : 5 vendor_id : GenuineIntel cpu family : 6 model : 45 model name : Intel(R) Xeon(R) CPU E5-2667 0 @ 2.90GHz stepping : 7 microcode : 0x718 cpu MHz : 3192.186 cache size : 15360 KB physical id : 0 siblings : 12 core id : 5 cpu cores : 6 apicid : 10 initial apicid : 10 fpu : yes fpu_exception : yes cpuid level : 13 wp : yes flags : fpu vme de pse tsc msr pae mce cx8 apic sep mtrr pge mca cmov pat pse36 clflush dts acpi mmx fxsr sse sse2 ss ht tm pbe syscall nx pdpe1gb rdtscp lm constant_tsc arch_perfmon pebs bts rep_good nopl xtopology nonstop_tsc cpuid aperfmperf pni pclmulqdq dtes64 monitor ds_cpl vmx smx est tm2 ssse3 cx16 xtpr pdcm pcid dca sse4_1 sse4_2 x2apic popcnt tsc_deadline_timer aes xsave avx lahf_lm epb pti ssbd ibrs ibpb stibp tpr_shadow vnmi flexpriority ept vpid xsaveopt dtherm ida arat pln pts md_clear flush_l1d bugs : cpu_meltdown spectre_v1 spectre_v2 spec_store_bypass l1tf mds swapgs itlb_multihit bogomips : 5785.73 clflush size : 64 cache_alignment : 64 address sizes : 46 bits physical, 48 bits virtual power management: processor : 6 vendor_id : GenuineIntel cpu family : 6 model : 45 model name : Intel(R) Xeon(R) CPU E5-2667 0 @ 2.90GHz stepping : 7 microcode : 0x718 cpu MHz : 3192.248 cache size : 15360 KB physical id : 1 siblings : 12 core id : 0 cpu cores : 6 apicid : 32 initial apicid : 32 fpu : yes fpu_exception : yes cpuid level : 13 wp : yes flags : fpu vme de pse tsc msr pae mce cx8 apic sep mtrr pge mca cmov pat pse36 clflush dts acpi mmx fxsr sse sse2 ss ht tm pbe syscall nx pdpe1gb rdtscp lm constant_tsc arch_perfmon pebs bts rep_good nopl xtopology nonstop_tsc cpuid aperfmperf pni pclmulqdq dtes64 monitor ds_cpl vmx smx est tm2 ssse3 cx16 xtpr pdcm pcid dca sse4_1 sse4_2 x2apic popcnt tsc_deadline_timer aes xsave avx lahf_lm epb pti ssbd ibrs ibpb stibp tpr_shadow vnmi flexpriority ept vpid xsaveopt dtherm ida arat pln pts md_clear flush_l1d bugs : cpu_meltdown spectre_v1 spectre_v2 spec_store_bypass l1tf mds swapgs itlb_multihit bogomips : 5792.29 clflush size : 64 cache_alignment : 64 address sizes : 46 bits physical, 48 bits virtual power management: processor : 7 vendor_id : GenuineIntel cpu family : 6 model : 45 model name : Intel(R) Xeon(R) CPU E5-2667 0 @ 2.90GHz stepping : 7 microcode : 0x718 cpu MHz : 3192.131 cache size : 15360 KB physical id : 1 siblings : 12 core id : 1 cpu cores : 6 apicid : 34 initial apicid : 34 fpu : yes fpu_exception : yes cpuid level : 13 wp : yes flags : fpu vme de pse tsc msr pae mce cx8 apic sep mtrr pge mca cmov pat pse36 clflush dts acpi mmx fxsr sse sse2 ss ht tm pbe syscall nx pdpe1gb rdtscp lm constant_tsc arch_perfmon pebs bts rep_good nopl xtopology nonstop_tsc cpuid aperfmperf pni pclmulqdq dtes64 monitor ds_cpl vmx smx est tm2 ssse3 cx16 xtpr pdcm pcid dca sse4_1 sse4_2 x2apic popcnt tsc_deadline_timer aes xsave avx lahf_lm epb pti ssbd ibrs ibpb stibp tpr_shadow vnmi flexpriority ept vpid xsaveopt dtherm ida arat pln pts md_clear flush_l1d bugs : cpu_meltdown spectre_v1 spectre_v2 spec_store_bypass l1tf mds swapgs itlb_multihit bogomips : 5792.29 clflush size : 64 cache_alignment : 64 address sizes : 46 bits physical, 48 bits virtual power management: processor : 8 vendor_id : GenuineIntel cpu family : 6 model : 45 model name : Intel(R) Xeon(R) CPU E5-2667 0 @ 2.90GHz stepping : 7 microcode : 0x718 cpu MHz : 3192.137 cache size : 15360 KB physical id : 1 siblings : 12 core id : 2 cpu cores : 6 apicid : 36 initial apicid : 36 fpu : yes fpu_exception : yes cpuid level : 13 wp : yes flags : fpu vme de pse tsc msr pae mce cx8 apic sep mtrr pge mca cmov pat pse36 clflush dts acpi mmx fxsr sse sse2 ss ht tm pbe syscall nx pdpe1gb rdtscp lm constant_tsc arch_perfmon pebs bts rep_good nopl xtopology nonstop_tsc cpuid aperfmperf pni pclmulqdq dtes64 monitor ds_cpl vmx smx est tm2 ssse3 cx16 xtpr pdcm pcid dca sse4_1 sse4_2 x2apic popcnt tsc_deadline_timer aes xsave avx lahf_lm epb pti ssbd ibrs ibpb stibp tpr_shadow vnmi flexpriority ept vpid xsaveopt dtherm ida arat pln pts md_clear flush_l1d bugs : cpu_meltdown spectre_v1 spectre_v2 spec_store_bypass l1tf mds swapgs itlb_multihit bogomips : 5792.29 clflush size : 64 cache_alignment : 64 address sizes : 46 bits physical, 48 bits virtual power management: processor : 9 vendor_id : GenuineIntel cpu family : 6 model : 45 model name : Intel(R) Xeon(R) CPU E5-2667 0 @ 2.90GHz stepping : 7 microcode : 0x718 cpu MHz : 3192.147 cache size : 15360 KB physical id : 1 siblings : 12 core id : 3 cpu cores : 6 apicid : 38 initial apicid : 38 fpu : yes fpu_exception : yes cpuid level : 13 wp : yes flags : fpu vme de pse tsc msr pae mce cx8 apic sep mtrr pge mca cmov pat pse36 clflush dts acpi mmx fxsr sse sse2 ss ht tm pbe syscall nx pdpe1gb rdtscp lm constant_tsc arch_perfmon pebs bts rep_good nopl xtopology nonstop_tsc cpuid aperfmperf pni pclmulqdq dtes64 monitor ds_cpl vmx smx est tm2 ssse3 cx16 xtpr pdcm pcid dca sse4_1 sse4_2 x2apic popcnt tsc_deadline_timer aes xsave avx lahf_lm epb pti ssbd ibrs ibpb stibp tpr_shadow vnmi flexpriority ept vpid xsaveopt dtherm ida arat pln pts md_clear flush_l1d bugs : cpu_meltdown spectre_v1 spectre_v2 spec_store_bypass l1tf mds swapgs itlb_multihit bogomips : 5792.29 clflush size : 64 cache_alignment : 64 address sizes : 46 bits physical, 48 bits virtual power management: processor : 10 vendor_id : GenuineIntel cpu family : 6 model : 45 model name : Intel(R) Xeon(R) CPU E5-2667 0 @ 2.90GHz stepping : 7 microcode : 0x718 cpu MHz : 3192.129 cache size : 15360 KB physical id : 1 siblings : 12 core id : 4 cpu cores : 6 apicid : 40 initial apicid : 40 fpu : yes fpu_exception : yes cpuid level : 13 wp : yes flags : fpu vme de pse tsc msr pae mce cx8 apic sep mtrr pge mca cmov pat pse36 clflush dts acpi mmx fxsr sse sse2 ss ht tm pbe syscall nx pdpe1gb rdtscp lm constant_tsc arch_perfmon pebs bts rep_good nopl xtopology nonstop_tsc cpuid aperfmperf pni pclmulqdq dtes64 monitor ds_cpl vmx smx est tm2 ssse3 cx16 xtpr pdcm pcid dca sse4_1 sse4_2 x2apic popcnt tsc_deadline_timer aes xsave avx lahf_lm epb pti ssbd ibrs ibpb stibp tpr_shadow vnmi flexpriority ept vpid xsaveopt dtherm ida arat pln pts md_clear flush_l1d bugs : cpu_meltdown spectre_v1 spectre_v2 spec_store_bypass l1tf mds swapgs itlb_multihit bogomips : 5792.29 clflush size : 64 cache_alignment : 64 address sizes : 46 bits physical, 48 bits virtual power management: processor : 11 vendor_id : GenuineIntel cpu family : 6 model : 45 model name : Intel(R) Xeon(R) CPU E5-2667 0 @ 2.90GHz stepping : 7 microcode : 0x718 cpu MHz : 3192.131 cache size : 15360 KB physical id : 1 siblings : 12 core id : 5 cpu cores : 6 apicid : 42 initial apicid : 42 fpu : yes fpu_exception : yes cpuid level : 13 wp : yes flags : fpu vme de pse tsc msr pae mce cx8 apic sep mtrr pge mca cmov pat pse36 clflush dts acpi mmx fxsr sse sse2 ss ht tm pbe syscall nx pdpe1gb rdtscp lm constant_tsc arch_perfmon pebs bts rep_good nopl xtopology nonstop_tsc cpuid aperfmperf pni pclmulqdq dtes64 monitor ds_cpl vmx smx est tm2 ssse3 cx16 xtpr pdcm pcid dca sse4_1 sse4_2 x2apic popcnt tsc_deadline_timer aes xsave avx lahf_lm epb pti ssbd ibrs ibpb stibp tpr_shadow vnmi flexpriority ept vpid xsaveopt dtherm ida arat pln pts md_clear flush_l1d bugs : cpu_meltdown spectre_v1 spectre_v2 spec_store_bypass l1tf mds swapgs itlb_multihit bogomips : 5792.29 clflush size : 64 cache_alignment : 64 address sizes : 46 bits physical, 48 bits virtual power management: processor : 12 vendor_id : GenuineIntel cpu family : 6 model : 45 model name : Intel(R) Xeon(R) CPU E5-2667 0 @ 2.90GHz stepping : 7 microcode : 0x718 cpu MHz : 3192.062 cache size : 15360 KB physical id : 0 siblings : 12 core id : 0 cpu cores : 6 apicid : 1 initial apicid : 1 fpu : yes fpu_exception : yes cpuid level : 13 wp : yes flags : fpu vme de pse tsc msr pae mce cx8 apic sep mtrr pge mca cmov pat pse36 clflush dts acpi mmx fxsr sse sse2 ss ht tm pbe syscall nx pdpe1gb rdtscp lm constant_tsc arch_perfmon pebs bts rep_good nopl xtopology nonstop_tsc cpuid aperfmperf pni pclmulqdq dtes64 monitor ds_cpl vmx smx est tm2 ssse3 cx16 xtpr pdcm pcid dca sse4_1 sse4_2 x2apic popcnt tsc_deadline_timer aes xsave avx lahf_lm epb pti ssbd ibrs ibpb stibp tpr_shadow vnmi flexpriority ept vpid xsaveopt dtherm ida arat pln pts md_clear flush_l1d bugs : cpu_meltdown spectre_v1 spectre_v2 spec_store_bypass l1tf mds swapgs itlb_multihit bogomips : 5785.73 clflush size : 64 cache_alignment : 64 address sizes : 46 bits physical, 48 bits virtual power management: processor : 13 vendor_id : GenuineIntel cpu family : 6 model : 45 model name : Intel(R) Xeon(R) CPU E5-2667 0 @ 2.90GHz stepping : 7 microcode : 0x718 cpu MHz : 3192.084 cache size : 15360 KB physical id : 0 siblings : 12 core id : 1 cpu cores : 6 apicid : 3 initial apicid : 3 fpu : yes fpu_exception : yes cpuid level : 13 wp : yes flags : fpu vme de pse tsc msr pae mce cx8 apic sep mtrr pge mca cmov pat pse36 clflush dts acpi mmx fxsr sse sse2 ss ht tm pbe syscall nx pdpe1gb rdtscp lm constant_tsc arch_perfmon pebs bts rep_good nopl xtopology nonstop_tsc cpuid aperfmperf pni pclmulqdq dtes64 monitor ds_cpl vmx smx est tm2 ssse3 cx16 xtpr pdcm pcid dca sse4_1 sse4_2 x2apic popcnt tsc_deadline_timer aes xsave avx lahf_lm epb pti ssbd ibrs ibpb stibp tpr_shadow vnmi flexpriority ept vpid xsaveopt dtherm ida arat pln pts md_clear flush_l1d bugs : cpu_meltdown spectre_v1 spectre_v2 spec_store_bypass l1tf mds swapgs itlb_multihit bogomips : 5785.73 clflush size : 64 cache_alignment : 64 address sizes : 46 bits physical, 48 bits virtual power management: processor : 14 vendor_id : GenuineIntel cpu family : 6 model : 45 model name : Intel(R) Xeon(R) CPU E5-2667 0 @ 2.90GHz stepping : 7 microcode : 0x718 cpu MHz : 3194.423 cache size : 15360 KB physical id : 0 siblings : 12 core id : 2 cpu cores : 6 apicid : 5 initial apicid : 5 fpu : yes fpu_exception : yes cpuid level : 13 wp : yes flags : fpu vme de pse tsc msr pae mce cx8 apic sep mtrr pge mca cmov pat pse36 clflush dts acpi mmx fxsr sse sse2 ss ht tm pbe syscall nx pdpe1gb rdtscp lm constant_tsc arch_perfmon pebs bts rep_good nopl xtopology nonstop_tsc cpuid aperfmperf pni pclmulqdq dtes64 monitor ds_cpl vmx smx est tm2 ssse3 cx16 xtpr pdcm pcid dca sse4_1 sse4_2 x2apic popcnt tsc_deadline_timer aes xsave avx lahf_lm epb pti ssbd ibrs ibpb stibp tpr_shadow vnmi flexpriority ept vpid xsaveopt dtherm ida arat pln pts md_clear flush_l1d bugs : cpu_meltdown spectre_v1 spectre_v2 spec_store_bypass l1tf mds swapgs itlb_multihit bogomips : 5785.73 clflush size : 64 cache_alignment : 64 address sizes : 46 bits physical, 48 bits virtual power management: processor : 15 vendor_id : GenuineIntel cpu family : 6 model : 45 model name : Intel(R) Xeon(R) CPU E5-2667 0 @ 2.90GHz stepping : 7 microcode : 0x718 cpu MHz : 3192.132 cache size : 15360 KB physical id : 0 siblings : 12 core id : 3 cpu cores : 6 apicid : 7 initial apicid : 7 fpu : yes fpu_exception : yes cpuid level : 13 wp : yes flags : fpu vme de pse tsc msr pae mce cx8 apic sep mtrr pge mca cmov pat pse36 clflush dts acpi mmx fxsr sse sse2 ss ht tm pbe syscall nx pdpe1gb rdtscp lm constant_tsc arch_perfmon pebs bts rep_good nopl xtopology nonstop_tsc cpuid aperfmperf pni pclmulqdq dtes64 monitor ds_cpl vmx smx est tm2 ssse3 cx16 xtpr pdcm pcid dca sse4_1 sse4_2 x2apic popcnt tsc_deadline_timer aes xsave avx lahf_lm epb pti ssbd ibrs ibpb stibp tpr_shadow vnmi flexpriority ept vpid xsaveopt dtherm ida arat pln pts md_clear flush_l1d bugs : cpu_meltdown spectre_v1 spectre_v2 spec_store_bypass l1tf mds swapgs itlb_multihit bogomips : 5785.73 clflush size : 64 cache_alignment : 64 address sizes : 46 bits physical, 48 bits virtual power management: processor : 16 vendor_id : GenuineIntel cpu family : 6 model : 45 model name : Intel(R) Xeon(R) CPU E5-2667 0 @ 2.90GHz stepping : 7 microcode : 0x718 cpu MHz : 3192.170 cache size : 15360 KB physical id : 0 siblings : 12 core id : 4 cpu cores : 6 apicid : 9 initial apicid : 9 fpu : yes fpu_exception : yes cpuid level : 13 wp : yes flags : fpu vme de pse tsc msr pae mce cx8 apic sep mtrr pge mca cmov pat pse36 clflush dts acpi mmx fxsr sse sse2 ss ht tm pbe syscall nx pdpe1gb rdtscp lm constant_tsc arch_perfmon pebs bts rep_good nopl xtopology nonstop_tsc cpuid aperfmperf pni pclmulqdq dtes64 monitor ds_cpl vmx smx est tm2 ssse3 cx16 xtpr pdcm pcid dca sse4_1 sse4_2 x2apic popcnt tsc_deadline_timer aes xsave avx lahf_lm epb pti ssbd ibrs ibpb stibp tpr_shadow vnmi flexpriority ept vpid xsaveopt dtherm ida arat pln pts md_clear flush_l1d bugs : cpu_meltdown spectre_v1 spectre_v2 spec_store_bypass l1tf mds swapgs itlb_multihit bogomips : 5785.73 clflush size : 64 cache_alignment : 64 address sizes : 46 bits physical, 48 bits virtual power management: processor : 17 vendor_id : GenuineIntel cpu family : 6 model : 45 model name : Intel(R) Xeon(R) CPU E5-2667 0 @ 2.90GHz stepping : 7 microcode : 0x718 cpu MHz : 3191.946 cache size : 15360 KB physical id : 0 siblings : 12 core id : 5 cpu cores : 6 apicid : 11 initial apicid : 11 fpu : yes fpu_exception : yes cpuid level : 13 wp : yes flags : fpu vme de pse tsc msr pae mce cx8 apic sep mtrr pge mca cmov pat pse36 clflush dts acpi mmx fxsr sse sse2 ss ht tm pbe syscall nx pdpe1gb rdtscp lm constant_tsc arch_perfmon pebs bts rep_good nopl xtopology nonstop_tsc cpuid aperfmperf pni pclmulqdq dtes64 monitor ds_cpl vmx smx est tm2 ssse3 cx16 xtpr pdcm pcid dca sse4_1 sse4_2 x2apic popcnt tsc_deadline_timer aes xsave avx lahf_lm epb pti ssbd ibrs ibpb stibp tpr_shadow vnmi flexpriority ept vpid xsaveopt dtherm ida arat pln pts md_clear flush_l1d bugs : cpu_meltdown spectre_v1 spectre_v2 spec_store_bypass l1tf mds swapgs itlb_multihit bogomips : 5785.73 clflush size : 64 cache_alignment : 64 address sizes : 46 bits physical, 48 bits virtual power management: processor : 18 vendor_id : GenuineIntel cpu family : 6 model : 45 model name : Intel(R) Xeon(R) CPU E5-2667 0 @ 2.90GHz stepping : 7 microcode : 0x718 cpu MHz : 3192.131 cache size : 15360 KB physical id : 1 siblings : 12 core id : 0 cpu cores : 6 apicid : 33 initial apicid : 33 fpu : yes fpu_exception : yes cpuid level : 13 wp : yes flags : fpu vme de pse tsc msr pae mce cx8 apic sep mtrr pge mca cmov pat pse36 clflush dts acpi mmx fxsr sse sse2 ss ht tm pbe syscall nx pdpe1gb rdtscp lm constant_tsc arch_perfmon pebs bts rep_good nopl xtopology nonstop_tsc cpuid aperfmperf pni pclmulqdq dtes64 monitor ds_cpl vmx smx est tm2 ssse3 cx16 xtpr pdcm pcid dca sse4_1 sse4_2 x2apic popcnt tsc_deadline_timer aes xsave avx lahf_lm epb pti ssbd ibrs ibpb stibp tpr_shadow vnmi flexpriority ept vpid xsaveopt dtherm ida arat pln pts md_clear flush_l1d bugs : cpu_meltdown spectre_v1 spectre_v2 spec_store_bypass l1tf mds swapgs itlb_multihit bogomips : 5792.29 clflush size : 64 cache_alignment : 64 address sizes : 46 bits physical, 48 bits virtual power management: processor : 19 vendor_id : GenuineIntel cpu family : 6 model : 45 model name : Intel(R) Xeon(R) CPU E5-2667 0 @ 2.90GHz stepping : 7 microcode : 0x718 cpu MHz : 3192.134 cache size : 15360 KB physical id : 1 siblings : 12 core id : 1 cpu cores : 6 apicid : 35 initial apicid : 35 fpu : yes fpu_exception : yes cpuid level : 13 wp : yes flags : fpu vme de pse tsc msr pae mce cx8 apic sep mtrr pge mca cmov pat pse36 clflush dts acpi mmx fxsr sse sse2 ss ht tm pbe syscall nx pdpe1gb rdtscp lm constant_tsc arch_perfmon pebs bts rep_good nopl xtopology nonstop_tsc cpuid aperfmperf pni pclmulqdq dtes64 monitor ds_cpl vmx smx est tm2 ssse3 cx16 xtpr pdcm pcid dca sse4_1 sse4_2 x2apic popcnt tsc_deadline_timer aes xsave avx lahf_lm epb pti ssbd ibrs ibpb stibp tpr_shadow vnmi flexpriority ept vpid xsaveopt dtherm ida arat pln pts md_clear flush_l1d bugs : cpu_meltdown spectre_v1 spectre_v2 spec_store_bypass l1tf mds swapgs itlb_multihit bogomips : 5792.29 clflush size : 64 cache_alignment : 64 address sizes : 46 bits physical, 48 bits virtual power management: processor : 20 vendor_id : GenuineIntel cpu family : 6 model : 45 model name : Intel(R) Xeon(R) CPU E5-2667 0 @ 2.90GHz stepping : 7 microcode : 0x718 cpu MHz : 3192.123 cache size : 15360 KB physical id : 1 siblings : 12 core id : 2 cpu cores : 6 apicid : 37 initial apicid : 37 fpu : yes fpu_exception : yes cpuid level : 13 wp : yes flags : fpu vme de pse tsc msr pae mce cx8 apic sep mtrr pge mca cmov pat pse36 clflush dts acpi mmx fxsr sse sse2 ss ht tm pbe syscall nx pdpe1gb rdtscp lm constant_tsc arch_perfmon pebs bts rep_good nopl xtopology nonstop_tsc cpuid aperfmperf pni pclmulqdq dtes64 monitor ds_cpl vmx smx est tm2 ssse3 cx16 xtpr pdcm pcid dca sse4_1 sse4_2 x2apic popcnt tsc_deadline_timer aes xsave avx lahf_lm epb pti ssbd ibrs ibpb stibp tpr_shadow vnmi flexpriority ept vpid xsaveopt dtherm ida arat pln pts md_clear flush_l1d bugs : cpu_meltdown spectre_v1 spectre_v2 spec_store_bypass l1tf mds swapgs itlb_multihit bogomips : 5792.29 clflush size : 64 cache_alignment : 64 address sizes : 46 bits physical, 48 bits virtual power management: processor : 21 vendor_id : GenuineIntel cpu family : 6 model : 45 model name : Intel(R) Xeon(R) CPU E5-2667 0 @ 2.90GHz stepping : 7 microcode : 0x718 cpu MHz : 3192.131 cache size : 15360 KB physical id : 1 siblings : 12 core id : 3 cpu cores : 6 apicid : 39 initial apicid : 39 fpu : yes fpu_exception : yes cpuid level : 13 wp : yes flags : fpu vme de pse tsc msr pae mce cx8 apic sep mtrr pge mca cmov pat pse36 clflush dts acpi mmx fxsr sse sse2 ss ht tm pbe syscall nx pdpe1gb rdtscp lm constant_tsc arch_perfmon pebs bts rep_good nopl xtopology nonstop_tsc cpuid aperfmperf pni pclmulqdq dtes64 monitor ds_cpl vmx smx est tm2 ssse3 cx16 xtpr pdcm pcid dca sse4_1 sse4_2 x2apic popcnt tsc_deadline_timer aes xsave avx lahf_lm epb pti ssbd ibrs ibpb stibp tpr_shadow vnmi flexpriority ept vpid xsaveopt dtherm ida arat pln pts md_clear flush_l1d bugs : cpu_meltdown spectre_v1 spectre_v2 spec_store_bypass l1tf mds swapgs itlb_multihit bogomips : 5792.29 clflush size : 64 cache_alignment : 64 address sizes : 46 bits physical, 48 bits virtual power management: processor : 22 vendor_id : GenuineIntel cpu family : 6 model : 45 model name : Intel(R) Xeon(R) CPU E5-2667 0 @ 2.90GHz stepping : 7 microcode : 0x718 cpu MHz : 3192.149 cache size : 15360 KB physical id : 1 siblings : 12 core id : 4 cpu cores : 6 apicid : 41 initial apicid : 41 fpu : yes fpu_exception : yes cpuid level : 13 wp : yes flags : fpu vme de pse tsc msr pae mce cx8 apic sep mtrr pge mca cmov pat pse36 clflush dts acpi mmx fxsr sse sse2 ss ht tm pbe syscall nx pdpe1gb rdtscp lm constant_tsc arch_perfmon pebs bts rep_good nopl xtopology nonstop_tsc cpuid aperfmperf pni pclmulqdq dtes64 monitor ds_cpl vmx smx est tm2 ssse3 cx16 xtpr pdcm pcid dca sse4_1 sse4_2 x2apic popcnt tsc_deadline_timer aes xsave avx lahf_lm epb pti ssbd ibrs ibpb stibp tpr_shadow vnmi flexpriority ept vpid xsaveopt dtherm ida arat pln pts md_clear flush_l1d bugs : cpu_meltdown spectre_v1 spectre_v2 spec_store_bypass l1tf mds swapgs itlb_multihit bogomips : 5792.29 clflush size : 64 cache_alignment : 64 address sizes : 46 bits physical, 48 bits virtual power management: processor : 23 vendor_id : GenuineIntel cpu family : 6 model : 45 model name : Intel(R) Xeon(R) CPU E5-2667 0 @ 2.90GHz stepping : 7 microcode : 0x718 cpu MHz : 3195.640 cache size : 15360 KB physical id : 1 siblings : 12 core id : 5 cpu cores : 6 apicid : 43 initial apicid : 43 fpu : yes fpu_exception : yes cpuid level : 13 wp : yes flags : fpu vme de pse tsc msr pae mce cx8 apic sep mtrr pge mca cmov pat pse36 clflush dts acpi mmx fxsr sse sse2 ss ht tm pbe syscall nx pdpe1gb rdtscp lm constant_tsc arch_perfmon pebs bts rep_good nopl xtopology nonstop_tsc cpuid aperfmperf pni pclmulqdq dtes64 monitor ds_cpl vmx smx est tm2 ssse3 cx16 xtpr pdcm pcid dca sse4_1 sse4_2 x2apic popcnt tsc_deadline_timer aes xsave avx lahf_lm epb pti ssbd ibrs ibpb stibp tpr_shadow vnmi flexpriority ept vpid xsaveopt dtherm ida arat pln pts md_clear flush_l1d bugs : cpu_meltdown spectre_v1 spectre_v2 spec_store_bypass l1tf mds swapgs itlb_multihit bogomips : 5792.29 clflush size : 64 cache_alignment : 64 address sizes : 46 bits physical, 48 bits virtual power management: MemTotal: 65879492 kB MemFree: 10395980 kB MemAvailable: 59790724 kB Buffers: 12390688 kB Cached: 18542568 kB SwapCached: 37680 kB Active: 20395936 kB Inactive: 14205172 kB Active(anon): 3459064 kB Inactive(anon): 165896 kB Active(file): 16936872 kB Inactive(file): 14039276 kB Unevictable: 48 kB Mlocked: 48 kB SwapTotal: 4194300 kB SwapFree: 3334988 kB Dirty: 13300 kB Writeback: 0 kB AnonPages: 3648112 kB Mapped: 555304 kB Shmem: 784 kB KReclaimable: 19083648 kB Slab: 20438420 kB SReclaimable: 19083648 kB SUnreclaim: 1354772 kB KernelStack: 16012 kB PageTables: 33208 kB NFS_Unstable: 0 kB Bounce: 0 kB WritebackTmp: 0 kB CommitLimit: 37134044 kB Committed_AS: 10963564 kB VmallocTotal: 34359738367 kB VmallocUsed: 161980 kB VmallocChunk: 0 kB Percpu: 137728 kB HardwareCorrupted: 0 kB AnonHugePages: 0 kB ShmemHugePages: 0 kB ShmemPmdMapped: 0 kB FileHugePages: 0 kB FilePmdMapped: 0 kB CmaTotal: 0 kB CmaFree: 0 kB HugePages_Total: 0 HugePages_Free: 0 HugePages_Rsvd: 0 HugePages_Surp: 0 Hugepagesize: 2048 kB Hugetlb: 0 kB DirectMap4k: 10120980 kB DirectMap2M: 56909824 kB DirectMap1G: 0 kB $ ls -a . .. .git .gitattributes .github .gitignore .gitlab-ci.yml .mailmap .merlin.in .ocamlformat .ocamlinit CODE_OF_CONDUCT.md CONTRIBUTING.md CREDITS INSTALL.md LICENSE META.coq-core.in Makefile Makefile.build Makefile.checker Makefile.ci Makefile.common Makefile.dev Makefile.doc Makefile.ide Makefile.install Makefile.make Makefile.vofiles README.md _build_ci _install_ci azure-pipelines.yml checker clib config configure configure.ml coq-doc.opam coq.opam coq.opam.docker coqide-server.opam coqide.opam coqpp default.nix dev doc dune dune-project engine gramlib ide install.sh interp kernel lib library man parsing plugins pretyping printing proofs shell.nix stm tactics test-suite theories tools topbin toplevel user-contrib vernac $ printenv -0 | sort -z | tr '\0' '\n' BASE_ONLY_OPAM=elpi.1.11.0 BASE_OPAM=num zarith.1.9.1 ocamlfind.1.8.1 ounit2.2.2.3 odoc.1.5.0 BASE_OPAM_EDGE=dune.2.5.1 dune-release.1.3.3 ocamlformat.0.14.2 CACHEKEY=bionic_coq-V2020-08-28-V92 CI=true CI_API_V4_URL=https://gitlab.com/api/v4 CI_BUILD_BEFORE_SHA=727d9e5de2b64fd98bc085089b92891bcbad095f CI_BUILD_ID=713656562 CI_BUILD_NAME=plugin:ci-metacoq CI_BUILD_REF=fdbbc0cbc3906704e6e4e92d5bf2f6ffe8476357 CI_BUILD_REF_NAME=pr-12653 CI_BUILD_REF_SLUG=pr-12653 CI_BUILD_STAGE=stage-3 CI_BUILD_TOKEN=[MASKED] CI_COMMIT_BEFORE_SHA=727d9e5de2b64fd98bc085089b92891bcbad095f CI_COMMIT_BRANCH=pr-12653 CI_COMMIT_DESCRIPTION= Bot merge 0d30f79268fea18ef99c040a859956f61c3d978a and 7c1779e124fe4bf2733af12488b18bee92840127 CI_COMMIT_MESSAGE=[CI merge] PR #12653: Syntax for specifying cumulative inductives Bot merge 0d30f79268fea18ef99c040a859956f61c3d978a and 7c1779e124fe4bf2733af12488b18bee92840127 CI_COMMIT_REF_NAME=pr-12653 CI_COMMIT_REF_PROTECTED=false CI_COMMIT_REF_SLUG=pr-12653 CI_COMMIT_SHA=fdbbc0cbc3906704e6e4e92d5bf2f6ffe8476357 CI_COMMIT_SHORT_SHA=fdbbc0cb CI_COMMIT_TITLE=[CI merge] PR #12653: Syntax for specifying cumulative inductives CI_CONFIG_PATH=.gitlab-ci.yml CI_DEFAULT_BRANCH=master CI_DISPOSABLE_ENVIRONMENT=true CI_JOB_ID=713656562 CI_JOB_JWT=[MASKED] CI_JOB_NAME=plugin:ci-metacoq CI_JOB_STAGE=stage-3 CI_JOB_TOKEN=[MASKED] CI_JOB_URL=https://gitlab.com/coq/coq/-/jobs/713656562 CI_NODE_TOTAL=1 CI_OPAM=menhir.20190626 ocamlgraph.1.8.8 CI_PAGES_DOMAIN=gitlab.io CI_PAGES_URL=https://coq.gitlab.io/coq CI_PIPELINE_ID=184301476 CI_PIPELINE_IID=17942 CI_PIPELINE_SOURCE=push CI_PIPELINE_URL=https://gitlab.com/coq/coq/-/pipelines/184301476 CI_PROJECT_DIR=/builds/coq/coq CI_PROJECT_ID=6138686 CI_PROJECT_NAME=coq CI_PROJECT_NAMESPACE=coq CI_PROJECT_PATH=coq/coq CI_PROJECT_PATH_SLUG=coq-coq CI_PROJECT_REPOSITORY_LANGUAGES=ocaml,coq,shell,tex,c CI_PROJECT_ROOT_NAMESPACE=coq CI_PROJECT_TITLE=coq CI_PROJECT_URL=https://gitlab.com/coq/coq CI_PROJECT_VISIBILITY=public CI_REGISTRY=registry.gitlab.com CI_REGISTRY_IMAGE=registry.gitlab.com/coq/coq CI_REGISTRY_PASSWORD=[MASKED] CI_REGISTRY_USER=gitlab-ci-token CI_REPOSITORY_URL=https://gitlab-ci-token:[MASKED]@gitlab.com/coq/coq.git CI_RUNNER_DESCRIPTION=roquableu CI_RUNNER_EXECUTABLE_ARCH=linux/amd64 CI_RUNNER_ID=816543 CI_RUNNER_REVISION=fa86510e CI_RUNNER_TAGS= CI_RUNNER_VERSION=11.9.2 CI_SERVER=yes CI_SERVER_HOST=gitlab.com CI_SERVER_NAME=GitLab CI_SERVER_PORT=443 CI_SERVER_PROTOCOL=https CI_SERVER_REVISION=e937f778b66 CI_SERVER_TLS_CA_FILE=/builds/coq/coq.tmp/CI_SERVER_TLS_CA_FILE CI_SERVER_URL=https://gitlab.com CI_SERVER_VERSION=13.4.0-pre CI_SERVER_VERSION_MAJOR=13 CI_SERVER_VERSION_MINOR=4 CI_SERVER_VERSION_PATCH=0 COMPILER=4.05.0 COMPILER_EDGE=4.10.0 COQIDE_OPAM=cairo2.0.6.1 lablgtk3-sourceview3.3.1.0 DEBIAN_FRONTEND=noninteractive FF_K8S_USE_ENTRYPOINT_OVER_COMMAND=true FULL_CI=true GITLAB_CI=true GITLAB_FEATURES=audit_events,blocked_issues,burndown_charts,code_owners,code_review_analytics,contribution_analytics,description_diffs,elastic_search,group_activity_analytics,group_bulk_edit,group_burndown_charts,group_webhooks,issuable_default_templates,issue_weights,iterations,jenkins_integration,ldap_group_sync,member_lock,merge_request_approvers,milestone_charts,multiple_issue_assignees,multiple_ldap_servers,multiple_merge_request_assignees,project_merge_request_analytics,protected_refs_for_users,push_rules,repository_mirrors,repository_size_limit,seat_link,send_emails_from_admin_area,scoped_issue_board,usage_quotas,visual_review_app,wip_limits,adjourned_deletion_for_projects_and_groups,admin_audit_log,auditor_user,blocking_merge_requests,board_assignee_lists,board_milestone_lists,ci_cd_projects,ci_secrets_management,cluster_agents,cluster_deployments,code_owner_approval_required,commit_committer_check,compliance_framework,cross_project_pipelines,custom_file_templates,custom_file_templates_for_namespace,custom_project_templates,cycle_analytics_for_groups,db_load_balancing,default_branch_protection_restriction_in_groups,default_project_deletion_protection,dependency_proxy,deploy_board,disable_name_update_for_users,email_additional_text,epics,extended_audit_events,external_authorization_service_api_management,feature_flags,file_locks,geo,generic_alert_fingerprinting,github_project_service_integration,group_allowed_email_domains,group_coverage_reports,group_forking_protection,group_ip_restriction,group_merge_request_analytics,group_project_templates,group_saml,issues_analytics,jira_dev_panel_integration,jira_issues_integration,ldap_group_sync_filter,merge_pipelines,merge_request_performance_metrics,admin_merge_request_approvers_rules,merge_trains,metrics_reports,multiple_approval_rules,multiple_group_issue_boards,object_storage,operations_dashboard,opsgenie_integration,package_forwarding,pages_size_limit,productivity_analytics,project_aliases,protected_environments,reject_unsigned_commits,required_ci_templates,scoped_labels,smartcard_auth,group_timelogs,type_of_work_analytics,unprotection_restrictions,ci_project_subscriptions,container_scanning,coverage_fuzzing,credentials_inventory,dast,dependency_scanning,enterprise_templates,api_fuzzing,group_level_compliance_dashboard,incident_management,insights,issuable_health_status,license_scanning,personal_access_token_api_management,personal_access_token_expiration_policy,enforce_pat_expiration,prometheus_alerts,pseudonymizer,release_evidence_test_artifacts,report_approver_rules,requirements,sast,secret_detection,security_dashboard,security_on_demand_scans,status_page,subepics,threat_monitoring,tracing,quality_management GITLAB_USER_EMAIL=gaetan.gilbert@skyskimmer.net GITLAB_USER_ID=1343245 GITLAB_USER_LOGIN=SkySkimmer GITLAB_USER_NAME=Gaëtan Gilbert GIT_DEPTH=10 HOME=/root HOSTNAME=runner-curNbQZR-project-6138686-concurrent-1 IMAGE=registry.gitlab.com/coq/coq:bionic_coq-V2020-08-28-V92 NJOBS=2 OLDPWD=/ OPAMJOBS=2 OPAMROOT=/root/.opamcache OPAMROOTISOK=true OPAMYES=true OPAM_SWITCH=base OPAM_VARIANT= PATH=/usr/local/sbin:/usr/local/bin:/usr/sbin:/usr/bin:/sbin:/bin PWD=/builds/coq/coq SHLVL=1 SKIP_DOCKER=true UNRELIABLE=enabled WINDOWS=enabled WINDOWS_ALL_ADDONS=disabled _=/usr/bin/printenv $ declare -A switch_table $ switch_table=( ["base"]="$COMPILER" ["edge"]="$COMPILER_EDGE" ) $ opam switch set -y "${switch_table[$OPAM_SWITCH]}$OPAM_VARIANT" # Run eval $(opam env) to update the current shell environment $ eval $(opam env) $ opam list # Packages matching: installed # Name # Installed # Synopsis astring 0.8.5 Alternative String module for OCaml base-bigarray base base-bytes base Bytes library distributed with the OCaml compiler base-num base Num library distributed with the OCaml compiler base-threads base base-unix base cairo2 0.6.1 Binding to Cairo, a 2D Vector Graphics Library camlp5 7.12 Preprocessor-pretty-printer of OCaml cmdliner 1.0.4 Declarative definition of command line interfaces for OCaml conf-cairo 1 Virtual package relying on a Cairo system installation conf-gmp 1 Virtual package relying on a GMP lib system installation conf-gtk3 18 Virtual package relying on GTK+ 3 conf-gtksourceview3 0+2 Virtual package relying on a GtkSourceView-3 system installation conf-m4 1 Virtual package relying on m4 conf-perl 1 Virtual package relying on perl conf-pkg-config 1.3 Virtual package relying on pkg-config installation cppo 1.6.6 Code preprocessor like cpp for OCaml dune 2.7.0 Fast, portable, and opinionated build system dune-configurator 2.7.0 Helper library for gathering system configuration elpi 1.11.0 ELPI - Embeddable λProlog Interpreter fpath 0.7.2 File system paths for OCaml lablgtk3 3.1.0 OCaml interface to GTK+3 lablgtk3-sourceview3 3.1.0 OCaml interface to GTK+ gtksourceview library menhir 20190626 An LR(1) parser generator num 0 The Num library for arbitrary-precision integer and rational arithmetic ocaml 4.05.0 The OCaml compiler (virtual package) ocaml-base-compiler 4.05.0 Official 4.05.0 release ocaml-compiler-libs v0.12.1 OCaml compiler libraries repackaged ocaml-config 1 OCaml Switch Configuration ocaml-migrate-parsetree 1.7.3 Convert OCaml parsetrees between different versions ocaml-secondary-compiler 4.08.1-1 OCaml 4.08.1 Secondary Switch Compiler ocamlbuild 0.14.0 OCamlbuild is a build system with builtin rules to easily build most OCaml projects. ocamlfind 1.8.1 A library manager for OCaml ocamlfind-secondary 1.8.1 ocamlfind support for ocaml-secondary-compiler ocamlgraph 1.8.8 A generic graph library for OCaml odoc 1.5.0 OCaml documentation generator ounit2 2.2.3 OUnit testing framework ppx_derivers 1.2.1 Shared [@@deriving] plugin registry ppx_deriving 4.5 Type-driven code generation for OCaml >=4.02.2 ppx_tools 5.0+4.05.0 Tools for authors of ppx rewriters and other syntactic tools ppxfind 1.4 Tool combining ocamlfind and ppx ppxlib 0.15.0 Standard library for ppx rewriters re 1.9.0 RE is a regular expression library for OCaml result 1.5 Compatibility Result module seq 0.2.2 Compatibility package for OCaml's standard iterator type starting from 4.07 sexplib0 v0.14.0 Library containing the definition of S-expressions and some base converters stdlib-shims 0.1.0 Backport some of the new stdlib features to older compiler topkg 1.0.2 The transitory OCaml software packager tyxml 4.4.0 TyXML is a library for building correct HTML and SVG documents uchar 0.0.2 Compatibility library for OCaml's Uchar module uutf 1.0.2 Non-blocking streaming Unicode codec for OCaml zarith 1.9.1 Implements arithmetic and logical operations over arbitrary-precision integers $ opam config list <><> Global opam variables ><><><><><><><><><><><><><><><><><><><><><><><><><><> arch x86_64 # Inferred from system jobs 2 # The number of parallel jobs set up in opam configuration make make # The 'make' command to use opam-version 2.0.6 # The currently running opam version os linux # Inferred from system os-distribution ubuntu # Inferred from system os-family debian # Inferred from system os-version 18.04 # Inferred from system root /root/.opamcache # The current opam root directory switch 4.05.0 # The identifier of the current switch sys-ocaml-version # OCaml version present on your system independently of opam, if any <><> Configuration variables from the current switch ><><><><><><><><><><><><><> prefix /root/.opamcache/4.05.0 lib /root/.opamcache/4.05.0/lib bin /root/.opamcache/4.05.0/bin sbin /root/.opamcache/4.05.0/sbin share /root/.opamcache/4.05.0/share doc /root/.opamcache/4.05.0/doc etc /root/.opamcache/4.05.0/etc man /root/.opamcache/4.05.0/man toplevel /root/.opamcache/4.05.0/lib/toplevel stublibs /root/.opamcache/4.05.0/lib/stublibs user root group root <><> Package variables ('opam config list PKG' to show) <><><><><><><><><><><><> PKG:name # Name of the package PKG:version # Version of the package PKG:depends # Resolved direct dependencies of the package PKG:installed # Whether the package is installed PKG:enable # Takes the value "enable" or "disable" depending on whether the package is installed PKG:pinned # Whether the package is pinned PKG:bin # Binary directory for this package PKG:sbin # System binary directory for this package PKG:lib # Library directory for this package PKG:man # Man directory for this package PKG:doc # Doc directory for this package PKG:share # Share directory for this package PKG:etc # Etc directory for this package PKG:build # Directory where the package was built PKG:hash # Hash of the package archive PKG:dev # True if this is a development package PKG:build-id # A hash identifying the precise package version with all its dependencies $ set -e $ echo 'start:coq.test' start:coq.test $ make -f Makefile.ci -j "$NJOBS" "${CI_JOB_NAME#*:}" ./dev/ci/ci-wrapper.sh equations ++ : 2 ++ export NJOBS ++ '[' -n true ']' ++ export OCAMLPATH=/builds/coq/coq/_install_ci/lib: ++ OCAMLPATH=/builds/coq/coq/_install_ci/lib: ++ export COQBIN=/builds/coq/coq/_install_ci/bin ++ COQBIN=/builds/coq/coq/_install_ci/bin ++ export CI_BRANCH=pr-12653 ++ CI_BRANCH=pr-12653 ++ [[ 12653 =~ ^[0-9]*$ ]] ++ export CI_PULL_REQUEST=12653 ++ CI_PULL_REQUEST=12653 ++ export PATH=/builds/coq/coq/_install_ci/bin:/root/.opamcache/4.05.0/bin:/usr/local/sbin:/usr/local/bin:/usr/sbin:/usr/bin:/sbin:/bin ++ PATH=/builds/coq/coq/_install_ci/bin:/root/.opamcache/4.05.0/bin:/usr/local/sbin:/usr/local/bin:/usr/sbin:/usr/bin:/sbin:/bin ++ export COQBIN=/builds/coq/coq/_install_ci/bin/ ++ COQBIN=/builds/coq/coq/_install_ci/bin/ ++ ls -l /builds/coq/coq/_install_ci/bin/ total 377964 -rwxr-xr-x 1 root root 1885376 Sep 1 11:46 coq-tex -rwxr-xr-x 1 root root 2500248 Sep 1 11:46 coq_makefile -rwxr-xr-x 1 root root 24673120 Sep 1 11:46 coqc -rwxr-xr-x 1 root root 9648760 Sep 1 11:46 coqchk -rwxr-xr-x 1 root root 5855160 Sep 1 11:46 coqdep -rwxr-xr-x 1 root root 4413792 Sep 1 11:46 coqdoc -rwxr-xr-x 1 root root 11526312 Sep 1 11:47 coqide -rwxr-xr-x 1 root root 25110448 Sep 1 11:47 coqidetop -rwxr-xr-x 1 root root 25110448 Sep 1 11:47 coqidetop.opt -rwxr-xr-x 1 root root 449295 Sep 1 11:46 coqpp -rwxr-xr-x 1 root root 32153472 Sep 1 11:47 coqproofworker.byte -rwxr-xr-x 1 root root 24673424 Sep 1 11:46 coqproofworker.opt -rwxr-xr-x 1 root root 32153472 Sep 1 11:47 coqqueryworker.byte -rwxr-xr-x 1 root root 24673424 Sep 1 11:46 coqqueryworker.opt -rwxr-xr-x 1 root root 32153477 Sep 1 11:47 coqtacticworker.byte -rwxr-xr-x 1 root root 24673448 Sep 1 11:46 coqtacticworker.opt -rwxr-xr-x 1 root root 24673288 Sep 1 11:46 coqtop -rwxr-xr-x 1 root root 41805680 Sep 1 11:47 coqtop.byte -rwxr-xr-x 1 root root 24673288 Sep 1 11:46 coqtop.opt -rwxr-xr-x 1 root root 1821312 Sep 1 11:46 coqwc -rwxr-xr-x 1 root root 2827416 Sep 1 11:46 coqworkmgr -rwxr-xr-x 1 root root 5905992 Sep 1 11:47 fake_ide -rwxr-xr-x 1 root root 1757920 Sep 1 11:46 ocamllibdep -rwxr-xr-x 1 root root 1877056 Sep 1 11:46 votour ++ CI_BUILD_DIR=/builds/coq/coq/_build_ci ++ ls -l /builds/coq/coq/_build_ci total 4 drwxr-xr-x 8 root root 4096 Sep 1 11:51 equations ++ set +x + git_download equations + local PROJECT=equations + local DEST=/builds/coq/coq/_build_ci/equations + local GITURL_VAR=equations_CI_GITURL + local GITURL=https://github.com/SkySkimmer/Coq-Equations + local REF_VAR=equations_CI_REF + local REF=cumul-syntax + '[' -d /builds/coq/coq/_build_ci/equations ']' + echo 'Warning: download and unpacking of equations skipped because /builds/coq/coq/_build_ci/equations already exists.' Warning: download and unpacking of equations skipped because /builds/coq/coq/_build_ci/equations already exists. + cd /builds/coq/coq/_build_ci/equations + ./configure.sh coq Building Coq version (default) + make ci + '[' -z x ']' + command make ci + make ci make[1]: Entering directory '/builds/coq/coq/_build_ci/equations' make[2]: Nothing to be done for 'real-all'. cd test-suite && make cd examples && make make[2]: Entering directory '/builds/coq/coq/_build_ci/equations/test-suite' make[2]: Entering directory '/builds/coq/coq/_build_ci/equations/examples' make[3]: Nothing to be done for 'real-all'. make[2]: Leaving directory '/builds/coq/coq/_build_ci/equations/examples' make[3]: Nothing to be done for 'real-all'. make[2]: Leaving directory '/builds/coq/coq/_build_ci/equations/test-suite' make[1]: Leaving directory '/builds/coq/coq/_build_ci/equations' + make install + '[' -z x ']' + command make install + make install make[1]: Entering directory '/builds/coq/coq/_build_ci/equations' INSTALL theories/Init.vo /builds/coq/coq/_install_ci/lib/coq//user-contrib/Equations/ INSTALL theories/Signature.vo /builds/coq/coq/_install_ci/lib/coq//user-contrib/Equations/ INSTALL theories/CoreTactics.vo /builds/coq/coq/_install_ci/lib/coq//user-contrib/Equations/ INSTALL theories/Prop/Logic.vo /builds/coq/coq/_install_ci/lib/coq//user-contrib/Equations//Prop INSTALL theories/Prop/Classes.vo /builds/coq/coq/_install_ci/lib/coq//user-contrib/Equations//Prop INSTALL theories/Prop/EqDec.vo /builds/coq/coq/_install_ci/lib/coq//user-contrib/Equations//Prop INSTALL theories/Prop/EqDecInstances.vo /builds/coq/coq/_install_ci/lib/coq//user-contrib/Equations//Prop INSTALL theories/Prop/Subterm.vo /builds/coq/coq/_install_ci/lib/coq//user-contrib/Equations//Prop INSTALL theories/Prop/DepElim.vo /builds/coq/coq/_install_ci/lib/coq//user-contrib/Equations//Prop INSTALL theories/Prop/Tactics.vo /builds/coq/coq/_install_ci/lib/coq//user-contrib/Equations//Prop INSTALL theories/Prop/Constants.vo /builds/coq/coq/_install_ci/lib/coq//user-contrib/Equations//Prop INSTALL theories/Prop/NoConfusion.vo /builds/coq/coq/_install_ci/lib/coq//user-contrib/Equations//Prop INSTALL theories/Prop/FunctionalInduction.vo /builds/coq/coq/_install_ci/lib/coq//user-contrib/Equations//Prop INSTALL theories/Prop/Loader.vo /builds/coq/coq/_install_ci/lib/coq//user-contrib/Equations//Prop INSTALL theories/Prop/Telescopes.vo /builds/coq/coq/_install_ci/lib/coq//user-contrib/Equations//Prop INSTALL theories/Prop/TransparentEquations.vo /builds/coq/coq/_install_ci/lib/coq//user-contrib/Equations//Prop INSTALL theories/Prop/OpaqueEquations.vo /builds/coq/coq/_install_ci/lib/coq//user-contrib/Equations//Prop INSTALL theories/Equations.vo /builds/coq/coq/_install_ci/lib/coq//user-contrib/Equations/ INSTALL theories/Type/Logic.vo /builds/coq/coq/_install_ci/lib/coq//user-contrib/Equations//Type INSTALL theories/Type/FunctionalExtensionality.vo /builds/coq/coq/_install_ci/lib/coq//user-contrib/Equations//Type INSTALL theories/Type/Relation.vo /builds/coq/coq/_install_ci/lib/coq//user-contrib/Equations//Type INSTALL theories/Type/Relation_Properties.vo /builds/coq/coq/_install_ci/lib/coq//user-contrib/Equations//Type INSTALL theories/Type/WellFounded.vo /builds/coq/coq/_install_ci/lib/coq//user-contrib/Equations//Type INSTALL theories/Type/Classes.vo /builds/coq/coq/_install_ci/lib/coq//user-contrib/Equations//Type INSTALL theories/Type/EqDec.vo /builds/coq/coq/_install_ci/lib/coq//user-contrib/Equations//Type INSTALL theories/Type/DepElim.vo /builds/coq/coq/_install_ci/lib/coq//user-contrib/Equations//Type INSTALL theories/Type/Tactics.vo /builds/coq/coq/_install_ci/lib/coq//user-contrib/Equations//Type INSTALL theories/Type/Subterm.vo /builds/coq/coq/_install_ci/lib/coq//user-contrib/Equations//Type INSTALL theories/Type/Constants.vo /builds/coq/coq/_install_ci/lib/coq//user-contrib/Equations//Type INSTALL theories/Type/EqDecInstances.vo /builds/coq/coq/_install_ci/lib/coq//user-contrib/Equations//Type INSTALL theories/Type/NoConfusion.vo /builds/coq/coq/_install_ci/lib/coq//user-contrib/Equations//Type INSTALL theories/Type/FunctionalInduction.vo /builds/coq/coq/_install_ci/lib/coq//user-contrib/Equations//Type INSTALL theories/Type/Loader.vo /builds/coq/coq/_install_ci/lib/coq//user-contrib/Equations//Type INSTALL theories/Type/Telescopes.vo /builds/coq/coq/_install_ci/lib/coq//user-contrib/Equations//Type INSTALL theories/Type/WellFoundedInstances.vo /builds/coq/coq/_install_ci/lib/coq//user-contrib/Equations//Type INSTALL theories/Type/All.vo /builds/coq/coq/_install_ci/lib/coq//user-contrib/Equations//Type INSTALL theories/Init.v /builds/coq/coq/_install_ci/lib/coq//user-contrib/Equations/ INSTALL theories/Signature.v /builds/coq/coq/_install_ci/lib/coq//user-contrib/Equations/ INSTALL theories/CoreTactics.v /builds/coq/coq/_install_ci/lib/coq//user-contrib/Equations/ INSTALL theories/Prop/Logic.v /builds/coq/coq/_install_ci/lib/coq//user-contrib/Equations//Prop INSTALL theories/Prop/Classes.v /builds/coq/coq/_install_ci/lib/coq//user-contrib/Equations//Prop INSTALL theories/Prop/EqDec.v /builds/coq/coq/_install_ci/lib/coq//user-contrib/Equations//Prop INSTALL theories/Prop/EqDecInstances.v /builds/coq/coq/_install_ci/lib/coq//user-contrib/Equations//Prop INSTALL theories/Prop/Subterm.v /builds/coq/coq/_install_ci/lib/coq//user-contrib/Equations//Prop INSTALL theories/Prop/DepElim.v /builds/coq/coq/_install_ci/lib/coq//user-contrib/Equations//Prop INSTALL theories/Prop/Tactics.v /builds/coq/coq/_install_ci/lib/coq//user-contrib/Equations//Prop INSTALL theories/Prop/Constants.v /builds/coq/coq/_install_ci/lib/coq//user-contrib/Equations//Prop INSTALL theories/Prop/NoConfusion.v /builds/coq/coq/_install_ci/lib/coq//user-contrib/Equations//Prop INSTALL theories/Prop/FunctionalInduction.v /builds/coq/coq/_install_ci/lib/coq//user-contrib/Equations//Prop INSTALL theories/Prop/Loader.v /builds/coq/coq/_install_ci/lib/coq//user-contrib/Equations//Prop INSTALL theories/Prop/Telescopes.v /builds/coq/coq/_install_ci/lib/coq//user-contrib/Equations//Prop INSTALL theories/Prop/TransparentEquations.v /builds/coq/coq/_install_ci/lib/coq//user-contrib/Equations//Prop INSTALL theories/Prop/OpaqueEquations.v /builds/coq/coq/_install_ci/lib/coq//user-contrib/Equations//Prop INSTALL theories/Equations.v /builds/coq/coq/_install_ci/lib/coq//user-contrib/Equations/ INSTALL theories/Type/Logic.v /builds/coq/coq/_install_ci/lib/coq//user-contrib/Equations//Type INSTALL theories/Type/FunctionalExtensionality.v /builds/coq/coq/_install_ci/lib/coq//user-contrib/Equations//Type INSTALL theories/Type/Relation.v /builds/coq/coq/_install_ci/lib/coq//user-contrib/Equations//Type INSTALL theories/Type/Relation_Properties.v /builds/coq/coq/_install_ci/lib/coq//user-contrib/Equations//Type INSTALL theories/Type/WellFounded.v /builds/coq/coq/_install_ci/lib/coq//user-contrib/Equations//Type INSTALL theories/Type/Classes.v /builds/coq/coq/_install_ci/lib/coq//user-contrib/Equations//Type INSTALL theories/Type/EqDec.v /builds/coq/coq/_install_ci/lib/coq//user-contrib/Equations//Type INSTALL theories/Type/DepElim.v /builds/coq/coq/_install_ci/lib/coq//user-contrib/Equations//Type INSTALL theories/Type/Tactics.v /builds/coq/coq/_install_ci/lib/coq//user-contrib/Equations//Type INSTALL theories/Type/Subterm.v /builds/coq/coq/_install_ci/lib/coq//user-contrib/Equations//Type INSTALL theories/Type/Constants.v /builds/coq/coq/_install_ci/lib/coq//user-contrib/Equations//Type INSTALL theories/Type/EqDecInstances.v /builds/coq/coq/_install_ci/lib/coq//user-contrib/Equations//Type INSTALL theories/Type/NoConfusion.v /builds/coq/coq/_install_ci/lib/coq//user-contrib/Equations//Type INSTALL theories/Type/FunctionalInduction.v /builds/coq/coq/_install_ci/lib/coq//user-contrib/Equations//Type INSTALL theories/Type/Loader.v /builds/coq/coq/_install_ci/lib/coq//user-contrib/Equations//Type INSTALL theories/Type/Telescopes.v /builds/coq/coq/_install_ci/lib/coq//user-contrib/Equations//Type INSTALL theories/Type/WellFoundedInstances.v /builds/coq/coq/_install_ci/lib/coq//user-contrib/Equations//Type INSTALL theories/Type/All.v /builds/coq/coq/_install_ci/lib/coq//user-contrib/Equations//Type INSTALL theories/Init.glob /builds/coq/coq/_install_ci/lib/coq//user-contrib/Equations/ INSTALL theories/Signature.glob /builds/coq/coq/_install_ci/lib/coq//user-contrib/Equations/ INSTALL theories/CoreTactics.glob /builds/coq/coq/_install_ci/lib/coq//user-contrib/Equations/ INSTALL theories/Prop/Logic.glob /builds/coq/coq/_install_ci/lib/coq//user-contrib/Equations//Prop INSTALL theories/Prop/Classes.glob /builds/coq/coq/_install_ci/lib/coq//user-contrib/Equations//Prop INSTALL theories/Prop/EqDec.glob /builds/coq/coq/_install_ci/lib/coq//user-contrib/Equations//Prop INSTALL theories/Prop/EqDecInstances.glob /builds/coq/coq/_install_ci/lib/coq//user-contrib/Equations//Prop INSTALL theories/Prop/Subterm.glob /builds/coq/coq/_install_ci/lib/coq//user-contrib/Equations//Prop INSTALL theories/Prop/DepElim.glob /builds/coq/coq/_install_ci/lib/coq//user-contrib/Equations//Prop INSTALL theories/Prop/Tactics.glob /builds/coq/coq/_install_ci/lib/coq//user-contrib/Equations//Prop INSTALL theories/Prop/Constants.glob /builds/coq/coq/_install_ci/lib/coq//user-contrib/Equations//Prop INSTALL theories/Prop/NoConfusion.glob /builds/coq/coq/_install_ci/lib/coq//user-contrib/Equations//Prop INSTALL theories/Prop/FunctionalInduction.glob /builds/coq/coq/_install_ci/lib/coq//user-contrib/Equations//Prop INSTALL theories/Prop/Loader.glob /builds/coq/coq/_install_ci/lib/coq//user-contrib/Equations//Prop INSTALL theories/Prop/Telescopes.glob /builds/coq/coq/_install_ci/lib/coq//user-contrib/Equations//Prop INSTALL theories/Prop/TransparentEquations.glob /builds/coq/coq/_install_ci/lib/coq//user-contrib/Equations//Prop INSTALL theories/Prop/OpaqueEquations.glob /builds/coq/coq/_install_ci/lib/coq//user-contrib/Equations//Prop INSTALL theories/Equations.glob /builds/coq/coq/_install_ci/lib/coq//user-contrib/Equations/ INSTALL theories/Type/Logic.glob /builds/coq/coq/_install_ci/lib/coq//user-contrib/Equations//Type INSTALL theories/Type/FunctionalExtensionality.glob /builds/coq/coq/_install_ci/lib/coq//user-contrib/Equations//Type INSTALL theories/Type/Relation.glob /builds/coq/coq/_install_ci/lib/coq//user-contrib/Equations//Type INSTALL theories/Type/Relation_Properties.glob /builds/coq/coq/_install_ci/lib/coq//user-contrib/Equations//Type INSTALL theories/Type/WellFounded.glob /builds/coq/coq/_install_ci/lib/coq//user-contrib/Equations//Type INSTALL theories/Type/Classes.glob /builds/coq/coq/_install_ci/lib/coq//user-contrib/Equations//Type INSTALL theories/Type/EqDec.glob /builds/coq/coq/_install_ci/lib/coq//user-contrib/Equations//Type INSTALL theories/Type/DepElim.glob /builds/coq/coq/_install_ci/lib/coq//user-contrib/Equations//Type INSTALL theories/Type/Tactics.glob /builds/coq/coq/_install_ci/lib/coq//user-contrib/Equations//Type INSTALL theories/Type/Subterm.glob /builds/coq/coq/_install_ci/lib/coq//user-contrib/Equations//Type INSTALL theories/Type/Constants.glob /builds/coq/coq/_install_ci/lib/coq//user-contrib/Equations//Type INSTALL theories/Type/EqDecInstances.glob /builds/coq/coq/_install_ci/lib/coq//user-contrib/Equations//Type INSTALL theories/Type/NoConfusion.glob /builds/coq/coq/_install_ci/lib/coq//user-contrib/Equations//Type INSTALL theories/Type/FunctionalInduction.glob /builds/coq/coq/_install_ci/lib/coq//user-contrib/Equations//Type INSTALL theories/Type/Loader.glob /builds/coq/coq/_install_ci/lib/coq//user-contrib/Equations//Type INSTALL theories/Type/Telescopes.glob /builds/coq/coq/_install_ci/lib/coq//user-contrib/Equations//Type INSTALL theories/Type/WellFoundedInstances.glob /builds/coq/coq/_install_ci/lib/coq//user-contrib/Equations//Type INSTALL theories/Type/All.glob /builds/coq/coq/_install_ci/lib/coq//user-contrib/Equations//Type INSTALL src/g_equations.cmi /builds/coq/coq/_install_ci/lib/coq//user-contrib/Equations/ INSTALL src/equations_common.cmi /builds/coq/coq/_install_ci/lib/coq//user-contrib/Equations/ INSTALL src/ederive.cmi /builds/coq/coq/_install_ci/lib/coq//user-contrib/Equations/ INSTALL src/sigma_types.cmi /builds/coq/coq/_install_ci/lib/coq//user-contrib/Equations/ INSTALL src/subterm.cmi /builds/coq/coq/_install_ci/lib/coq//user-contrib/Equations/ INSTALL src/eqdec.cmi /builds/coq/coq/_install_ci/lib/coq//user-contrib/Equations/ INSTALL src/depelim.cmi /builds/coq/coq/_install_ci/lib/coq//user-contrib/Equations/ INSTALL src/syntax.cmi /builds/coq/coq/_install_ci/lib/coq//user-contrib/Equations/ INSTALL src/context_map.cmi /builds/coq/coq/_install_ci/lib/coq//user-contrib/Equations/ INSTALL src/simplify.cmi /builds/coq/coq/_install_ci/lib/coq//user-contrib/Equations/ INSTALL src/splitting.cmi /builds/coq/coq/_install_ci/lib/coq//user-contrib/Equations/ INSTALL src/covering.cmi /builds/coq/coq/_install_ci/lib/coq//user-contrib/Equations/ INSTALL src/principles_proofs.cmi /builds/coq/coq/_install_ci/lib/coq//user-contrib/Equations/ INSTALL src/principles.cmi /builds/coq/coq/_install_ci/lib/coq//user-contrib/Equations/ INSTALL src/equations.cmi /builds/coq/coq/_install_ci/lib/coq//user-contrib/Equations/ INSTALL src/noconf_hom.cmi /builds/coq/coq/_install_ci/lib/coq//user-contrib/Equations/ INSTALL src/noconf.cmi /builds/coq/coq/_install_ci/lib/coq//user-contrib/Equations/ INSTALL src/extra_tactics.cmi /builds/coq/coq/_install_ci/lib/coq//user-contrib/Equations/ INSTALL src/equations_plugin_mod.cmi /builds/coq/coq/_install_ci/lib/coq//user-contrib/Equations/ INSTALL src/equations_common.cmi /builds/coq/coq/_install_ci/lib/coq//user-contrib/Equations/ INSTALL src/ederive.cmi /builds/coq/coq/_install_ci/lib/coq//user-contrib/Equations/ INSTALL src/sigma_types.cmi /builds/coq/coq/_install_ci/lib/coq//user-contrib/Equations/ INSTALL src/subterm.cmi /builds/coq/coq/_install_ci/lib/coq//user-contrib/Equations/ INSTALL src/eqdec.cmi /builds/coq/coq/_install_ci/lib/coq//user-contrib/Equations/ INSTALL src/depelim.cmi /builds/coq/coq/_install_ci/lib/coq//user-contrib/Equations/ INSTALL src/syntax.cmi /builds/coq/coq/_install_ci/lib/coq//user-contrib/Equations/ INSTALL src/context_map.cmi /builds/coq/coq/_install_ci/lib/coq//user-contrib/Equations/ INSTALL src/simplify.cmi /builds/coq/coq/_install_ci/lib/coq//user-contrib/Equations/ INSTALL src/splitting.cmi /builds/coq/coq/_install_ci/lib/coq//user-contrib/Equations/ INSTALL src/covering.cmi /builds/coq/coq/_install_ci/lib/coq//user-contrib/Equations/ INSTALL src/principles_proofs.cmi /builds/coq/coq/_install_ci/lib/coq//user-contrib/Equations/ INSTALL src/principles.cmi /builds/coq/coq/_install_ci/lib/coq//user-contrib/Equations/ INSTALL src/equations.cmi /builds/coq/coq/_install_ci/lib/coq//user-contrib/Equations/ INSTALL src/noconf_hom.cmi /builds/coq/coq/_install_ci/lib/coq//user-contrib/Equations/ INSTALL src/noconf.cmi /builds/coq/coq/_install_ci/lib/coq//user-contrib/Equations/ INSTALL src/extra_tactics.cmi /builds/coq/coq/_install_ci/lib/coq//user-contrib/Equations/ INSTALL src/equations_plugin.cmxs /builds/coq/coq/_install_ci/lib/coq//user-contrib/Equations/ INSTALL src/equations_plugin.cmxa /builds/coq/coq/_install_ci/lib/coq//user-contrib/Equations/ INSTALL src/g_equations.cmx /builds/coq/coq/_install_ci/lib/coq//user-contrib/Equations/ INSTALL src/equations_common.cmx /builds/coq/coq/_install_ci/lib/coq//user-contrib/Equations/ INSTALL src/ederive.cmx /builds/coq/coq/_install_ci/lib/coq//user-contrib/Equations/ INSTALL src/sigma_types.cmx /builds/coq/coq/_install_ci/lib/coq//user-contrib/Equations/ INSTALL src/subterm.cmx /builds/coq/coq/_install_ci/lib/coq//user-contrib/Equations/ INSTALL src/eqdec.cmx /builds/coq/coq/_install_ci/lib/coq//user-contrib/Equations/ INSTALL src/depelim.cmx /builds/coq/coq/_install_ci/lib/coq//user-contrib/Equations/ INSTALL src/syntax.cmx /builds/coq/coq/_install_ci/lib/coq//user-contrib/Equations/ INSTALL src/context_map.cmx /builds/coq/coq/_install_ci/lib/coq//user-contrib/Equations/ INSTALL src/simplify.cmx /builds/coq/coq/_install_ci/lib/coq//user-contrib/Equations/ INSTALL src/splitting.cmx /builds/coq/coq/_install_ci/lib/coq//user-contrib/Equations/ INSTALL src/covering.cmx /builds/coq/coq/_install_ci/lib/coq//user-contrib/Equations/ INSTALL src/principles_proofs.cmx /builds/coq/coq/_install_ci/lib/coq//user-contrib/Equations/ INSTALL src/principles.cmx /builds/coq/coq/_install_ci/lib/coq//user-contrib/Equations/ INSTALL src/equations.cmx /builds/coq/coq/_install_ci/lib/coq//user-contrib/Equations/ INSTALL src/noconf_hom.cmx /builds/coq/coq/_install_ci/lib/coq//user-contrib/Equations/ INSTALL src/noconf.cmx /builds/coq/coq/_install_ci/lib/coq//user-contrib/Equations/ INSTALL src/extra_tactics.cmx /builds/coq/coq/_install_ci/lib/coq//user-contrib/Equations/ INSTALL src/equations_plugin_mod.cmx /builds/coq/coq/_install_ci/lib/coq//user-contrib/Equations/ make[2]: Entering directory '/builds/coq/coq/_build_ci/equations' make[2]: Leaving directory '/builds/coq/coq/_build_ci/equations' make[1]: Leaving directory '/builds/coq/coq/_build_ci/equations' Aggregating timing log... No timing data ./dev/ci/ci-wrapper.sh metacoq ++ : 2 ++ export NJOBS ++ '[' -n true ']' ++ export OCAMLPATH=/builds/coq/coq/_install_ci/lib: ++ OCAMLPATH=/builds/coq/coq/_install_ci/lib: ++ export COQBIN=/builds/coq/coq/_install_ci/bin ++ COQBIN=/builds/coq/coq/_install_ci/bin ++ export CI_BRANCH=pr-12653 ++ CI_BRANCH=pr-12653 ++ [[ 12653 =~ ^[0-9]*$ ]] ++ export CI_PULL_REQUEST=12653 ++ CI_PULL_REQUEST=12653 ++ export PATH=/builds/coq/coq/_install_ci/bin:/root/.opamcache/4.05.0/bin:/usr/local/sbin:/usr/local/bin:/usr/sbin:/usr/bin:/sbin:/bin ++ PATH=/builds/coq/coq/_install_ci/bin:/root/.opamcache/4.05.0/bin:/usr/local/sbin:/usr/local/bin:/usr/sbin:/usr/bin:/sbin:/bin ++ export COQBIN=/builds/coq/coq/_install_ci/bin/ ++ COQBIN=/builds/coq/coq/_install_ci/bin/ ++ ls -l /builds/coq/coq/_install_ci/bin/ total 377964 -rwxr-xr-x 1 root root 1885376 Sep 1 11:46 coq-tex -rwxr-xr-x 1 root root 2500248 Sep 1 11:46 coq_makefile -rwxr-xr-x 1 root root 24673120 Sep 1 11:46 coqc -rwxr-xr-x 1 root root 9648760 Sep 1 11:46 coqchk -rwxr-xr-x 1 root root 5855160 Sep 1 11:46 coqdep -rwxr-xr-x 1 root root 4413792 Sep 1 11:46 coqdoc -rwxr-xr-x 1 root root 11526312 Sep 1 11:47 coqide -rwxr-xr-x 1 root root 25110448 Sep 1 11:47 coqidetop -rwxr-xr-x 1 root root 25110448 Sep 1 11:47 coqidetop.opt -rwxr-xr-x 1 root root 449295 Sep 1 11:46 coqpp -rwxr-xr-x 1 root root 32153472 Sep 1 11:47 coqproofworker.byte -rwxr-xr-x 1 root root 24673424 Sep 1 11:46 coqproofworker.opt -rwxr-xr-x 1 root root 32153472 Sep 1 11:47 coqqueryworker.byte -rwxr-xr-x 1 root root 24673424 Sep 1 11:46 coqqueryworker.opt -rwxr-xr-x 1 root root 32153477 Sep 1 11:47 coqtacticworker.byte -rwxr-xr-x 1 root root 24673448 Sep 1 11:46 coqtacticworker.opt -rwxr-xr-x 1 root root 24673288 Sep 1 11:46 coqtop -rwxr-xr-x 1 root root 41805680 Sep 1 11:47 coqtop.byte -rwxr-xr-x 1 root root 24673288 Sep 1 11:46 coqtop.opt -rwxr-xr-x 1 root root 1821312 Sep 1 11:46 coqwc -rwxr-xr-x 1 root root 2827416 Sep 1 11:46 coqworkmgr -rwxr-xr-x 1 root root 5905992 Sep 1 11:47 fake_ide -rwxr-xr-x 1 root root 1757920 Sep 1 11:46 ocamllibdep -rwxr-xr-x 1 root root 1877056 Sep 1 11:46 votour ++ CI_BUILD_DIR=/builds/coq/coq/_build_ci ++ ls -l /builds/coq/coq/_build_ci total 4 drwxr-xr-x 8 root root 4096 Sep 1 12:34 equations ++ set +x + git_download metacoq + local PROJECT=metacoq + local DEST=/builds/coq/coq/_build_ci/metacoq + local GITURL_VAR=metacoq_CI_GITURL + local GITURL=https://github.com/SkySkimmer/metacoq + local REF_VAR=metacoq_CI_REF + local REF=cumul-syntax + '[' -d /builds/coq/coq/_build_ci/metacoq ']' + '[' '' = 1 ']' + '[' true = '' ']' + local ARCHIVEURL_VAR=metacoq_CI_ARCHIVEURL + local ARCHIVEURL=https://github.com/SkySkimmer/metacoq/archive + mkdir -p /builds/coq/coq/_build_ci/metacoq + cd /builds/coq/coq/_build_ci/metacoq ++ git ls-remote https://github.com/SkySkimmer/metacoq refs/heads/cumul-syntax ++ cut -f 1 + local COMMIT=130dee007744c0e743d13613a398cfbe15ad95ff + [[ 130dee007744c0e743d13613a398cfbe15ad95ff == '' ]] + wget https://github.com/SkySkimmer/metacoq/archive/130dee007744c0e743d13613a398cfbe15ad95ff.tar.gz --2020-09-01 12:34:56-- https://github.com/SkySkimmer/metacoq/archive/130dee007744c0e743d13613a398cfbe15ad95ff.tar.gz Resolving github.com (github.com)... 140.82.121.3 Connecting to github.com (github.com)|140.82.121.3|:443... connected. HTTP request sent, awaiting response... 302 Found Location: https://codeload.github.com/SkySkimmer/metacoq/tar.gz/130dee007744c0e743d13613a398cfbe15ad95ff [following] --2020-09-01 12:34:56-- https://codeload.github.com/SkySkimmer/metacoq/tar.gz/130dee007744c0e743d13613a398cfbe15ad95ff Resolving codeload.github.com (codeload.github.com)... 140.82.121.9 Connecting to codeload.github.com (codeload.github.com)|140.82.121.9|:443... connected. HTTP request sent, awaiting response... 200 OK Length: unspecified [application/x-gzip] Saving to: '130dee007744c0e743d13613a398cfbe15ad95ff.tar.gz' 0K .......... .......... .......... .......... .......... 1.14M 50K .......... .......... .......... .......... .......... 2.37M 100K .......... .......... .......... .......... .......... 10.9M 150K .......... .......... .......... .......... .......... 10.9M 200K .......... .......... .......... .......... .......... 3.08M 250K .......... .......... .......... .......... .......... 10.9M 300K .......... .......... .......... .......... .......... 11.4M 350K .......... .......... .......... .......... .......... 10.9M 400K .......... .......... .......... .......... .......... 7.25M 450K .......... .......... .......... .......... .......... 9.97M 500K .......... .......... .......... .......... .......... 10.9M 550K .......... .......... .......... .......... .......... 3.39M 600K .......... .......... .......... .......... .......... 10.8M 650K .......... .......... .......... .......... .......... 2.57M 700K .......... .......... .......... .......... .......... 11.4M 750K .......... .......... .......... .......... .......... 10.8M 800K .......... .......... .......... .......... ......... 11.3M=0.2s 2020-09-01 12:34:57 (4.92 MB/s) - '130dee007744c0e743d13613a398cfbe15ad95ff.tar.gz' saved [869537] + tar xfz 130dee007744c0e743d13613a398cfbe15ad95ff.tar.gz --strip-components=1 + rm -f 130dee007744c0e743d13613a398cfbe15ad95ff.tar.gz + cd /builds/coq/coq/_build_ci/metacoq + ./configure.sh local make[1]: Entering directory '/builds/coq/coq/_build_ci/metacoq' make -C template-coq mrproper make[2]: Entering directory '/builds/coq/coq/_build_ci/metacoq/template-coq' rm -f Makefile.coq rm -f Makefile.plugin rm -f Makefile.template make[2]: Leaving directory '/builds/coq/coq/_build_ci/metacoq/template-coq' make -C pcuic mrproper make[2]: Entering directory '/builds/coq/coq/_build_ci/metacoq/pcuic' rm -f metacoq-config rm -f Makefile.plugin _PluginProject rm -f Makefile.pcuic _CoqProject make[2]: Leaving directory '/builds/coq/coq/_build_ci/metacoq/pcuic' make -C safechecker mrproper make[2]: Entering directory '/builds/coq/coq/_build_ci/metacoq/safechecker' rm -f metacoq-config rm -f Makefile.plugin _PluginProject rm -f Makefile.safechecker _CoqProject make[2]: Leaving directory '/builds/coq/coq/_build_ci/metacoq/safechecker' make -C erasure mrproper make[2]: Entering directory '/builds/coq/coq/_build_ci/metacoq/erasure' rm -f Makefile.plugin rm -f Makefile.erasure make[2]: Leaving directory '/builds/coq/coq/_build_ci/metacoq/erasure' make -C checker mrproper make[2]: Entering directory '/builds/coq/coq/_build_ci/metacoq/checker' rm -f Makefile.coq Makefile.plugin _CoqProject _PluginProject make[2]: Leaving directory '/builds/coq/coq/_build_ci/metacoq/checker' make -C examples mrproper make[2]: Entering directory '/builds/coq/coq/_build_ci/metacoq/examples' rm -f Makefile.coq make[2]: Leaving directory '/builds/coq/coq/_build_ci/metacoq/examples' make -C test-suite mrproper make[2]: Entering directory '/builds/coq/coq/_build_ci/metacoq/test-suite' rm -f Makefile.coq make[2]: Leaving directory '/builds/coq/coq/_build_ci/metacoq/test-suite' make -C translations mrproper make[2]: Entering directory '/builds/coq/coq/_build_ci/metacoq/translations' rm -f Makefile.coq make[2]: Leaving directory '/builds/coq/coq/_build_ci/metacoq/translations' make[1]: Leaving directory '/builds/coq/coq/_build_ci/metacoq' Building MetaCoq locally + make .merlin + '[' -z x ']' + command make .merlin + make .merlin make[1]: Entering directory '/builds/coq/coq/_build_ci/metacoq' make -C template-coq .merlin make[2]: Entering directory '/builds/coq/coq/_build_ci/metacoq/template-coq' coq_makefile -f _PluginProject -o Makefile.plugin `which gsed || which sed` -i -e s/coqdeps/coqdeps.plugin/g Makefile.plugin make -f Makefile.plugin .merlin make[3]: Entering directory '/builds/coq/coq/_build_ci/metacoq/template-coq' COQDEP VFILES OCAMLLIBDEP gen-src/metacoq_template_plugin.mlpack FILL .merlin make[4]: Entering directory '/builds/coq/coq/_build_ci/metacoq/template-coq' make[4]: Leaving directory '/builds/coq/coq/_build_ci/metacoq/template-coq' make[3]: Leaving directory '/builds/coq/coq/_build_ci/metacoq/template-coq' make[2]: Leaving directory '/builds/coq/coq/_build_ci/metacoq/template-coq' make -C pcuic .merlin make[2]: Entering directory '/builds/coq/coq/_build_ci/metacoq/pcuic' cat metacoq-config > _PluginProject cat _PluginProject.in >> _PluginProject coq_makefile -f _PluginProject -o Makefile.plugin `which gsed || which sed` -i -e s/coqdeps/coqdeps.plugin/g Makefile.plugin make -f Makefile.plugin .merlin make[3]: Entering directory '/builds/coq/coq/_build_ci/metacoq/pcuic' make[3]: warning: jobserver unavailable: using -j1. Add '+' to parent make rule. COQDEP VFILES Fatal error: exception Sys_error("../template-coq/build: No such file or directory") OCAMLLIBDEP src/metacoq_pcuic_plugin.mlpack Uncaught exception: Sys_error("../template-coq/build: No such file or directory") FILL .merlin make[4]: Entering directory '/builds/coq/coq/_build_ci/metacoq/pcuic' COQDEP VFILES Fatal error: exception Sys_error("../template-coq/build: No such file or directory") OCAMLLIBDEP src/metacoq_pcuic_plugin.mlpack Uncaught exception: Sys_error("../template-coq/build: No such file or directory") make[4]: Leaving directory '/builds/coq/coq/_build_ci/metacoq/pcuic' make[3]: Leaving directory '/builds/coq/coq/_build_ci/metacoq/pcuic' make[2]: Leaving directory '/builds/coq/coq/_build_ci/metacoq/pcuic' make -C safechecker .merlin make[2]: Entering directory '/builds/coq/coq/_build_ci/metacoq/safechecker' cat metacoq-config > _PluginProject cat _PluginProject.in >> _PluginProject coq_makefile -f _PluginProject -o Makefile.plugin `which gsed || which sed` -i -e s/coqdeps/coqdeps.plugin/g Makefile.plugin make -f Makefile.plugin .merlin make[3]: Entering directory '/builds/coq/coq/_build_ci/metacoq/safechecker' make[3]: warning: jobserver unavailable: using -j1. Add '+' to parent make rule. COQDEP VFILES Fatal error: exception Sys_error("../template-coq/build: No such file or directory") COQPP src/g_metacoq_safechecker.mlg OCAMLLIBDEP src/metacoq_safechecker_plugin.mlpack Uncaught exception: Sys_error("../template-coq/build: No such file or directory") CAMLDEP src/g_metacoq_safechecker.ml Bad -I option: ../template-coq/build: No such file or directory FILL .merlin make[4]: Entering directory '/builds/coq/coq/_build_ci/metacoq/safechecker' COQDEP VFILES Fatal error: exception Sys_error("../template-coq/build: No such file or directory") OCAMLLIBDEP src/metacoq_safechecker_plugin.mlpack Uncaught exception: Sys_error("../template-coq/build: No such file or directory") CAMLDEP src/g_metacoq_safechecker.ml Bad -I option: ../template-coq/build: No such file or directory make[4]: Leaving directory '/builds/coq/coq/_build_ci/metacoq/safechecker' make[3]: Leaving directory '/builds/coq/coq/_build_ci/metacoq/safechecker' make[2]: Leaving directory '/builds/coq/coq/_build_ci/metacoq/safechecker' make -C erasure .merlin make[2]: Entering directory '/builds/coq/coq/_build_ci/metacoq/erasure' cat metacoq-config > _PluginProject cat _PluginProject.in >> _PluginProject coq_makefile -f _PluginProject -o Makefile.plugin `which gsed || which sed` -i -e s/coqdeps/coqdeps.plugin/g Makefile.plugin make -f Makefile.plugin .merlin make[3]: Entering directory '/builds/coq/coq/_build_ci/metacoq/erasure' make[3]: warning: jobserver unavailable: using -j1. Add '+' to parent make rule. COQDEP VFILES Fatal error: exception Sys_error("../template-coq/build: No such file or directory") COQPP src/g_metacoq_erasure.mlg OCAMLLIBDEP src/metacoq_erasure_plugin.mlpack Uncaught exception: Sys_error("../template-coq/build: No such file or directory") CAMLDEP src/g_metacoq_erasure.ml Bad -I option: ../template-coq/build: No such file or directory FILL .merlin make[4]: Entering directory '/builds/coq/coq/_build_ci/metacoq/erasure' COQDEP VFILES Fatal error: exception Sys_error("../template-coq/build: No such file or directory") OCAMLLIBDEP src/metacoq_erasure_plugin.mlpack Uncaught exception: Sys_error("../template-coq/build: No such file or directory") CAMLDEP src/g_metacoq_erasure.ml Bad -I option: ../template-coq/build: No such file or directory make[4]: Leaving directory '/builds/coq/coq/_build_ci/metacoq/erasure' make[3]: Leaving directory '/builds/coq/coq/_build_ci/metacoq/erasure' make[2]: Leaving directory '/builds/coq/coq/_build_ci/metacoq/erasure' make -C checker .merlin make[2]: Entering directory '/builds/coq/coq/_build_ci/metacoq/checker' cat metacoq-config > _PluginProject cat _PluginProject.in >> _PluginProject coq_makefile -f _PluginProject -o Makefile.plugin make -f Makefile.plugin .merlin make[3]: Entering directory '/builds/coq/coq/_build_ci/metacoq/checker' make[3]: warning: jobserver unavailable: using -j1. Add '+' to parent make rule. COQDEP VFILES Fatal error: exception Sys_error("../template-coq/build: No such file or directory") COQPP src/g_metacoq_checker.mlg OCAMLLIBDEP src/metacoq_checker_plugin.mlpack Uncaught exception: Sys_error("../template-coq/build: No such file or directory") CAMLDEP src/g_metacoq_checker.ml Bad -I option: ../template-coq/build: No such file or directory FILL .merlin make[4]: Entering directory '/builds/coq/coq/_build_ci/metacoq/checker' COQDEP VFILES Fatal error: exception Sys_error("../template-coq/build: No such file or directory") OCAMLLIBDEP src/metacoq_checker_plugin.mlpack Uncaught exception: Sys_error("../template-coq/build: No such file or directory") CAMLDEP src/g_metacoq_checker.ml Bad -I option: ../template-coq/build: No such file or directory make[4]: Leaving directory '/builds/coq/coq/_build_ci/metacoq/checker' make[3]: Leaving directory '/builds/coq/coq/_build_ci/metacoq/checker' make[2]: Leaving directory '/builds/coq/coq/_build_ci/metacoq/checker' make[1]: Leaving directory '/builds/coq/coq/_build_ci/metacoq' + make ci-local + '[' -z x ']' + command make ci-local + make ci-local make[1]: Entering directory '/builds/coq/coq/_build_ci/metacoq' make all test-suite make[2]: Entering directory '/builds/coq/coq/_build_ci/metacoq' make -C template-coq make[3]: Entering directory '/builds/coq/coq/_build_ci/metacoq/template-coq' coq_makefile -f _CoqProject -o Makefile.coq coq_makefile -f _TemplateCoqProject -o Makefile.template `which gsed || which sed` -i -e s/coqdeps/coqdeps.template/g Makefile.template make -f Makefile.coq make[4]: Entering directory '/builds/coq/coq/_build_ci/metacoq/template-coq' COQDEP VFILES COQC theories/utils/MCPrelude.v COQC theories/utils/MCRelations.v theories/utils/MCPrelude.vo (real: 0.09, user: 0.05, sys: 0.04, mem: 63096 ko) COQC theories/utils/MCProd.v theories/utils/MCRelations.vo (real: 0.09, user: 0.05, sys: 0.04, mem: 68156 ko) COQC theories/utils/MCSquash.v theories/utils/MCSquash.vo (real: 0.09, user: 0.04, sys: 0.04, mem: 61384 ko) COQC theories/utils/MCArith.v theories/utils/MCProd.vo (real: 0.14, user: 0.09, sys: 0.04, mem: 88348 ko) COQC theories/utils/MCCompare.v theories/utils/MCArith.vo (real: 0.70, user: 0.48, sys: 0.22, mem: 404556 ko) COQC theories/utils/MCEquality.v theories/utils/MCEquality.vo (real: 0.08, user: 0.04, sys: 0.03, mem: 62924 ko) COQC theories/utils/LibHypsNaming.v theories/utils/LibHypsNaming.vo (real: 0.60, user: 0.42, sys: 0.18, mem: 339136 ko) COQC theories/config.v theories/config.vo (real: 0.08, user: 0.04, sys: 0.03, mem: 61716 ko) COQC theories/monad_utils.v theories/monad_utils.vo (real: 0.22, user: 0.14, sys: 0.08, mem: 149456 ko) COQC theories/utils/MCList.v theories/utils/MCList.vo (real: 1.71, user: 1.47, sys: 0.22, mem: 452340 ko) COQC theories/utils/MCOption.v theories/utils/MCOption.vo (real: 0.79, user: 0.56, sys: 0.22, mem: 440168 ko) COQC theories/utils/All_Forall.v theories/utils/MCCompare.vo (real: 6.40, user: 6.04, sys: 0.32, mem: 529900 ko) COQC theories/utils/MCString.v theories/utils/MCString.vo (real: 0.44, user: 0.30, sys: 0.13, mem: 270156 ko) theories/utils/All_Forall.vo (real: 3.03, user: 2.78, sys: 0.23, mem: 465984 ko) COQC theories/utils.v theories/utils.vo (real: 0.71, user: 0.52, sys: 0.18, mem: 385340 ko) COQC theories/utils/wGraph.v COQC theories/BasicAst.v theories/BasicAst.vo (real: 0.98, user: 0.75, sys: 0.22, mem: 450728 ko) COQC theories/Universes.v theories/utils/wGraph.vo (real: 5.22, user: 4.72, sys: 0.47, mem: 498552 ko) theories/Universes.vo (real: 4.54, user: 4.23, sys: 0.28, mem: 531272 ko) COQC theories/common/uGraph.v COQC theories/Environment.v theories/Environment.vo (real: 1.35, user: 1.10, sys: 0.24, mem: 484172 ko) COQC theories/Ast.v theories/Ast.vo (real: 1.04, user: 0.79, sys: 0.24, mem: 479940 ko) COQC theories/AstUtils.v theories/AstUtils.vo (real: 1.24, user: 1.00, sys: 0.23, mem: 485664 ko) COQC theories/TemplateMonad/Common.v theories/TemplateMonad/Common.vo (real: 0.82, user: 0.60, sys: 0.22, mem: 437492 ko) COQC theories/Induction.v theories/Induction.vo (real: 1.45, user: 1.18, sys: 0.26, mem: 486324 ko) COQC theories/EnvironmentTyping.v theories/common/uGraph.vo (real: 6.23, user: 5.85, sys: 0.35, mem: 551516 ko) COQC theories/WfInv.v theories/WfInv.vo (real: 1.31, user: 1.05, sys: 0.25, mem: 489932 ko) COQC theories/TemplateMonad/Core.v theories/EnvironmentTyping.vo (real: 2.05, user: 1.77, sys: 0.27, mem: 491968 ko) COQC theories/TemplateMonad/Extractable.v theories/TemplateMonad/Core.vo (real: 0.97, user: 0.73, sys: 0.24, mem: 481988 ko) COQC theories/LiftSubst.v theories/TemplateMonad/Extractable.vo (real: 0.95, user: 0.70, sys: 0.23, mem: 481156 ko) COQC theories/TemplateMonad.v theories/TemplateMonad.vo (real: 0.79, user: 0.54, sys: 0.24, mem: 420452 ko) COQC theories/Constants.v theories/Constants.vo (real: 1.08, user: 0.82, sys: 0.25, mem: 498504 ko) theories/LiftSubst.vo (real: 12.60, user: 11.81, sys: 0.72, mem: 532016 ko) COQC theories/UnivSubst.v COQC theories/Pretty.v theories/Pretty.vo (real: 1.11, user: 0.87, sys: 0.24, mem: 486460 ko) theories/UnivSubst.vo (real: 3.38, user: 3.11, sys: 0.24, mem: 490756 ko) COQC theories/Typing.v COQC theories/Extraction.v theories/Extraction.vo (real: 9.78, user: 9.33, sys: 0.41, mem: 571876 ko) theories/Typing.vo (real: 53.00, user: 51.78, sys: 0.98, mem: 809012 ko) COQC theories/TypingWf.v theories/TypingWf.vo (real: 8.46, user: 8.05, sys: 0.36, mem: 556676 ko) ./update_plugin.sh Updating gen-src from src Copying from src to gen-src Renaming files to camelCase Moving All_Forall.ml to all_Forall.ml Moving All_Forall.mli to all_Forall.mli Moving Ascii.ml to ascii.ml Moving Ascii.mli to ascii.mli Moving Ast0.ml to ast0.ml Moving Ast0.mli to ast0.mli Moving AstUtils.ml to astUtils.ml Moving AstUtils.mli to astUtils.mli Moving BasicAst.ml to basicAst.ml Moving BasicAst.mli to basicAst.mli Moving Basics.ml to basics.ml Moving Basics.mli to basics.mli Moving BinInt.ml to binInt.ml Moving BinInt.mli to binInt.mli Moving BinNat.ml to binNat.ml Moving BinNat.mli to binNat.mli Moving BinNums.ml to binNums.ml Moving BinNums.mli to binNums.mli Moving BinPos.ml to binPos.ml Moving BinPos.mli to binPos.mli Moving BinPosDef.ml to binPosDef.ml Moving BinPosDef.mli to binPosDef.mli Moving Bool.ml to bool.ml Moving Bool.mli to bool.mli Moving Byte.ml to byte.ml Moving Byte.mli to byte.mli Moving CRelationClasses.ml to cRelationClasses.ml Moving CRelationClasses.mli to cRelationClasses.mli Moving Common0.ml to common0.ml Moving Common0.mli to common0.mli Moving Compare_dec.ml to compare_dec.ml Moving Compare_dec.mli to compare_dec.mli Moving Datatypes.ml to datatypes.ml Moving Datatypes.mli to datatypes.mli Moving Decimal.ml to decimal.ml Moving Decimal.mli to decimal.mli Moving Environment.ml to environment.ml Moving Environment.mli to environment.mli Moving Equalities.ml to equalities.ml Moving Equalities.mli to equalities.mli Moving Extractable.ml to extractable.ml Moving Extractable.mli to extractable.mli Moving Hexadecimal.ml to hexadecimal.ml Moving Hexadecimal.mli to hexadecimal.mli Moving Induction.ml to induction.ml Moving Induction.mli to induction.mli Moving LiftSubst.ml to liftSubst.ml Moving LiftSubst.mli to liftSubst.mli Moving List0.ml to list0.ml Moving List0.mli to list0.mli Moving Logic0.ml to logic0.ml Moving Logic0.mli to logic0.mli Moving MCCompare.ml to mCCompare.ml Moving MCCompare.mli to mCCompare.mli Moving MCList.ml to mCList.ml Moving MCList.mli to mCList.mli Moving MCOption.ml to mCOption.ml Moving MCOption.mli to mCOption.mli Moving MCPrelude.ml to mCPrelude.ml Moving MCPrelude.mli to mCPrelude.mli Moving MCProd.ml to mCProd.ml Moving MCProd.mli to mCProd.mli Moving MCRelations.ml to mCRelations.ml Moving MCRelations.mli to mCRelations.mli Moving MCString.ml to mCString.ml Moving MCString.mli to mCString.mli Moving MSetDecide.ml to mSetDecide.ml Moving MSetDecide.mli to mSetDecide.mli Moving MSetFacts.ml to mSetFacts.ml Moving MSetFacts.mli to mSetFacts.mli Moving MSetInterface.ml to mSetInterface.ml Moving MSetInterface.mli to mSetInterface.mli Moving MSetList.ml to mSetList.ml Moving MSetList.mli to mSetList.mli Moving MSetProperties.ml to mSetProperties.ml Moving MSetProperties.mli to mSetProperties.mli Moving Nat0.ml to nat0.ml Moving Nat0.mli to nat0.mli Moving Numeral.ml to numeral.ml Moving Numeral.mli to numeral.mli Moving OrderedType0.ml to orderedType0.ml Moving OrderedType0.mli to orderedType0.mli Moving Orders.ml to orders.ml Moving Orders.mli to orders.mli Moving OrdersFacts.ml to ordersFacts.ml Moving OrdersFacts.mli to ordersFacts.mli Moving OrdersLists.ml to ordersLists.ml Moving OrdersLists.mli to ordersLists.mli Moving OrdersTac.ml to ordersTac.ml Moving OrdersTac.mli to ordersTac.mli Moving PeanoNat.ml to peanoNat.ml Moving PeanoNat.mli to peanoNat.mli Moving Pretty.ml to pretty.ml Moving Pretty.mli to pretty.mli Moving Specif.ml to specif.ml Moving Specif.mli to specif.mli Moving String0.ml to string0.ml Moving String0.mli to string0.mli Moving UnivSubst0.ml to univSubst0.ml Moving UnivSubst0.mli to univSubst0.mli Moving Universes0.ml to universes0.ml Moving Universes0.mli to universes0.mli patching file gen-src/cRelationClasses.mli make[4]: Leaving directory '/builds/coq/coq/_build_ci/metacoq/template-coq' make -f Makefile.template optfiles make[4]: Entering directory '/builds/coq/coq/_build_ci/metacoq/template-coq' COQDEP VFILES COQPP src/g_template_coq.mlg CAMLDEP src/plugin_core.mli CAMLDEP src/run_template_monad.mli CAMLDEP src/template_monad.mli OCAMLLIBDEP src/template_coq.mlpack CAMLDEP src/plugin_core.ml CAMLDEP src/run_template_monad.ml CAMLDEP src/template_monad.ml CAMLDEP src/constr_denoter.ml CAMLDEP src/constr_quoter.ml CAMLDEP src/constr_reification.ml CAMLDEP src/denoter.ml CAMLDEP src/quoter.ml CAMLDEP src/reification.ml CAMLDEP src/tm_util.ml CAMLDEP src/g_template_coq.ml CAMLOPT -c -for-pack Template_coq src/tm_util.ml CAMLOPT -c -for-pack Template_coq src/reification.ml src/reification.cmx (real: 0.04, user: 0.01, sys: 0.01, mem: 14796 ko) CAMLOPT -c -for-pack Template_coq src/constr_reification.ml src/tm_util.cmx (real: 0.07, user: 0.03, sys: 0.02, mem: 21812 ko) CAMLC -c src/template_monad.mli src/template_monad.cmi (real: 0.02, user: 0.00, sys: 0.01, mem: 15004 ko) CAMLC -c src/plugin_core.mli src/constr_reification.cmx (real: 0.07, user: 0.04, sys: 0.02, mem: 22020 ko) CAMLOPT -c -for-pack Template_coq src/quoter.ml src/plugin_core.cmi (real: 0.03, user: 0.01, sys: 0.01, mem: 17068 ko) CAMLOPT -c -for-pack Template_coq src/denoter.ml src/denoter.cmx (real: src/quoter.cmx (real: 0.22, user: 0.240.05, ,u sesry:s :0.16 , 0.02sy,s :m em: 0.0224280, mkeom:) 34576 ko) CAMLOPT -c -for-pack Template_coq src/template_monad.ml CAMLOPT -c -for-pack Template_coq src/plugin_core.ml src/templaster_cm/opnaludg.inc_cmoxr e(.rcemaxl :( real: 0.10, user: 0.06, sys: 0.02, mem: 27236 ko) 0.10, user: 0.08, sys: 0.01, mem: 26216 ko) CAMLC -c src/run_template_monad.mli CAMLOPT -c -for-pack Template_coq src/constr_quoter.ml src/run_template_monad.cmi (real: 0.01, user: 0.00, sys: 0.01, mem: 13148 ko) CAMLOPT -c -for-pack Template_coq src/constr_denoter.ml src/constr_denoter.cmx (real: 0.18, user: 0.14, sys: 0.01, mem: 31740 ko) src/constr_quoter.cmx (real: 0.24, user: 0.17, sys: 0.03, mem: 33044 ko) CAMLOPT -c -for-pack Template_coq src/run_template_monad.ml src/run_template_monad.cmx (real: 0.28, user: 0.15, sys: 0.03, mem: 38520 ko) CAMLOPT -c -for-pack Template_coq src/g_template_coq.ml src/g_template_coq.cmx (real: 0.25, user: 0.10, sys: 0.02, mem: 33140 ko) CAMLOPT -pack -o src/template_coq.cmx src/template_coq.cmx (real: 0.13, user: 0.02, sys: 0.02, mem: 19956 ko) CAMLOPT -a -o src/template_coq.cmxa src/template_coq.cmxa (real: 0.03, user: 0.00, sys: 0.01, mem: 13520 ko) CAMLOPT -shared -o src/template_coq.cmxs src/template_coq.cmxs (real: 0.08, user: 0.05, sys: 0.03, mem: 16040 ko) make[4]: Leaving directory '/builds/coq/coq/_build_ci/metacoq/template-coq' cp src/template_coq.cm* build/ make -f Makefile.template make[4]: Entering directory '/builds/coq/coq/_build_ci/metacoq/template-coq' COQC theories/Loader.v theories/Loader.vo (real: 1.04, user: 0.77, sys: 0.26, mem: 500040 ko) COQC theories/All.v theories/All.vo (real: 1.25, user: 0.95, sys: 0.28, mem: 521596 ko) make[4]: Leaving directory '/builds/coq/coq/_build_ci/metacoq/template-coq' make -f Makefile.plugin make[4]: Entering directory '/builds/coq/coq/_build_ci/metacoq/template-coq' CAMLDEP gen-src/univSubst0.mli CAMLDEP gen-src/universes0.mli CAMLDEP gen-src/string0.mli CAMLDEP gen-src/specif.mli CAMLDEP gen-src/run_extractable.mli CAMLDEP gen-src/pretty.mli CAMLDEP gen-src/plugin_core.mli CAMLDEP gen-src/peanoNat.mli CAMLDEP gen-src/ordersTac.mli CAMLDEP gen-src/ordersLists.mli CAMLDEP gen-src/orders.mli CAMLDEP gen-src/ordersFacts.mli CAMLDEP gen-src/orderedType0.mli CAMLDEP gen-src/numeral.mli CAMLDEP gen-src/nat0.mli CAMLDEP gen-src/mSetProperties.mli CAMLDEP gen-src/mSetList.mli CAMLDEP gen-src/mSetInterface.mli CAMLDEP gen-src/mSetFacts.mli CAMLDEP gen-src/mSetDecide.mli CAMLDEP gen-src/mCString.mli CAMLDEP gen-src/mCRelations.mli CAMLDEP gen-src/mCProd.mli CAMLDEP gen-src/mCOption.mli CAMLDEP gen-src/mCList.mli CAMLDEP gen-src/mCCompare.mli CAMLDEP gen-src/mCPrelude.mli CAMLDEP gen-src/logic0.mli CAMLDEP gen-src/list0.mli CAMLDEP gen-src/liftSubst.mli CAMLDEP gen-src/hexadecimal.mli CAMLDEP gen-src/extractable.mli CAMLDEP gen-src/equalities.mli CAMLDEP gen-src/environment.mli CAMLDEP gen-src/decimal.mli CAMLDEP gen-src/datatypes.mli CAMLDEP gen-src/cRelationClasses.mli CAMLDEP gen-src/config0.mli CAMLDEP gen-src/compare_dec.mli CAMLDEP gen-src/common0.mli CAMLDEP gen-src/bool.mli CAMLDEP gen-src/binPos.mli CAMLDEP gen-src/binPosDef.mli CAMLDEP gen-src/binNums.mli CAMLDEP gen-src/binNat.mli CAMLDEP gen-src/binInt.mli CAMLDEP gen-src/basics.mli CAMLDEP gen-src/basicAst.mli CAMLDEP gen-src/astUtils.mli CAMLDEP gen-src/ast0.mli CAMLDEP gen-src/ascii.mli CAMLDEP gen-src/all_Forall.mli OCAMLLIBDEP gen-src/metacoq_template_plugin.mlpack CAMLDEP gen-src/univSubst0.ml CAMLDEP gen-src/universes0.ml CAMLDEP gen-src/tm_util.ml CAMLDEP gen-src/string0.ml CAMLDEP gen-src/specif.ml CAMLDEP gen-src/run_extractable.ml CAMLDEP gen-src/quoter.ml CAMLDEP gen-src/reification.ml CAMLDEP gen-src/pretty.ml CAMLDEP gen-src/plugin_core.ml CAMLDEP gen-src/peanoNat.ml CAMLDEP gen-src/ordersTac.ml CAMLDEP gen-src/orders.ml CAMLDEP gen-src/ordersLists.ml CAMLDEP gen-src/ordersFacts.ml CAMLDEP gen-src/orderedType0.ml CAMLDEP gen-src/numeral.ml CAMLDEP gen-src/nat0.ml CAMLDEP gen-src/mSetProperties.ml CAMLDEP gen-src/mSetList.ml CAMLDEP gen-src/mSetInterface.ml CAMLDEP gen-src/mSetFacts.ml CAMLDEP gen-src/mSetDecide.ml CAMLDEP gen-src/mCString.ml CAMLDEP gen-src/mCRelations.ml CAMLDEP gen-src/mCProd.ml CAMLDEP gen-src/mCOption.ml CAMLDEP gen-src/mCList.ml CAMLDEP gen-src/mCCompare.ml CAMLDEP gen-src/mCPrelude.ml CAMLDEP gen-src/logic0.ml CAMLDEP gen-src/list0.ml CAMLDEP gen-src/liftSubst.ml CAMLDEP gen-src/hexadecimal.ml CAMLDEP gen-src/extractable.ml CAMLDEP gen-src/equalities.ml CAMLDEP gen-src/environment.ml CAMLDEP gen-src/denoter.ml CAMLDEP gen-src/decimal.ml CAMLDEP gen-src/datatypes.ml CAMLDEP gen-src/cRelationClasses.ml CAMLDEP gen-src/config0.ml CAMLDEP gen-src/compare_dec.ml CAMLDEP gen-src/common0.ml CAMLDEP gen-src/bool.ml CAMLDEP gen-src/binPos.ml CAMLDEP gen-src/binPosDef.ml CAMLDEP gen-src/binNums.ml CAMLDEP gen-src/binNat.ml CAMLDEP gen-src/binInt.ml CAMLDEP gen-src/basics.ml CAMLDEP gen-src/basicAst.ml CAMLDEP gen-src/astUtils.ml CAMLDEP gen-src/ast_quoter.ml CAMLDEP gen-src/ast_denoter.ml CAMLDEP gen-src/ast0.ml CAMLDEP gen-src/ascii.ml CAMLDEP gen-src/all_Forall.ml CAMLC -c gen-src/datatypes.mli CAMLC -c gen-src/basics.mli gen-src/basics.cmi (real: 0.01, user: 0.00, sys: 0.00, mem: 11244 ko) CAMLC -c gen-src/binNums.mli gen-src/datatypes.cmi (real: 0.01, user: 0.00, sys: 0.00, mem: 12948 ko) CAMLC -c gen-src/mCPrelude.mli gen-src/binNums.cmi (real: 0.01, user: 0.00, sys: 0.00, mem: 11340 ko) CAMLC -c gen-src/mCRelations.mli gen-src/mCPrelude.cmi (real: 0.01, user: 0.00, sys: 0.00, mem: 11228 ko) CAMLC -c gen-src/mCProd.mli gen-src/mCRelations.cmi (real: 0.01, user: 0.00, sys: 0.00, mem: 11080 ko) CAMLC -c gen-src/config0.mli gen-src/mCProd.cmi (real: 0.01, user: 0.00, sys: 0.00, mem: 11620 ko) CAMLC -c gen-src/logic0.mli gen-src/config0.cmi (real: 0.01, user: 0.00, sys: 0.00, mem: 11112 ko) CAMLOPT -c -for-pack Metacoq_template_plugin gen-src/tm_util.ml gen-src/logic0.cmi (real: 0.01, user: 0.00, sys: 0.00, mem: 11524 ko) CAMLOPT -c -for-pack Metacoq_template_plugin gen-src/reification.ml gen-src/reification.cmx (real: 0.02, user: 0.01, sys: 0.00, mem: 14848 ko) CAMLC -c gen-src/plugin_core.mli gen-src/plugin_core.cmi (real: 0.02, user: 0.01, sys: 0.00, mem: 17156 ko) CAMLC -c gen-src/tm_util.ml gen-src/tm_util.cmo (real: 0.03, user: 0.02, sys: 0.01, mem: 18388 ko) CAMLC -c gen-src/reification.ml gen-src/reification.cmo (real: 0.01, user: 0.00, sys: 0.00, mem: 11740 ko) CAMLOPT -c -for-pack Metacoq_template_plugin gen-src/datatypes.ml gen-src/datatypes.cmx (real: 0.15, user: 0.01, sys: 0.01, mem: 16200 ko) gen-src/tm_util.cmx (real: 0.26, user: 0.03, sys: 0.02, mem: 22128 ko) CAMLC -c gen-src/bool.mli CAMLC -c gen-src/decimal.mli gen-src/decimal.cmi (real: 0.01, user: 0.00, sys: 0.00, mem: 12404 ko) gen-src/bool.cmi (real: 0.01, user: 0.00, sys: 0.00, mem: 11744 ko) CAMLC -c gen-src/specif.mli CAMLOPT -c -for-pack Metacoq_template_plugin gen-src/basics.ml gen-src/specif.cmi (real: 0.01, user: 0.00, sys: 0.00, mem: 13160 ko) CAMLOPT -c -for-pack Metacoq_template_plugin gen-src/binNums.ml ggeenn--ssrrcc//bbaisniNcusm.sc.mcxm x( r(eraela:l : 0.040.05,, uusseerr:: 0.010.00,, ssyyss:: 0.010.01,, mmeemm:: 1566414584 kkoo)) CAMLC -c gen-src/cRelationClasses.mli CAMLC -c gen-src/compare_dec.mli gen-src/compare_dec.cmi (real: 0.01, user: 0.00, sys: 0.00, mem: 11720 ko) CAMLOPT -c -for-pack Metacoq_template_plugin gen-src/mCPrelude.ml gen-src/cRelationClasses.cmi (real: 0.01, user: 0.01, sys: 0.00, mem: 13388 ko) CAMLOPT -c -for-pack Metacoq_template_plugin gen-src/mCRelations.ml gen-src/mCPrelude.cmx (real: 0.04, user: 0.00, sys: 0.01, mem: 14368 ko) CAMLOPT -c -for-pack Metacoq_template_plugin gen-src/mCProd.ml gen-src/mCRelations.cmx (real: 0.09, user: 0.00, sys: 0.01, mem: 14184 ko) CAMLOPT -c -for-pack Metacoq_template_plugin gen-src/config0.ml gen-src/mCProd.cmx (real: 0.07, user: 0.01, sys: 0.01, mem: 15708 ko) CAMLOPT -c -for-pack Metacoq_template_plugin gen-src/logic0.ml gen-src/logic0.cmx (real: 0.02, user: 0.00, sys: 0.01, mem: 15516 ko) CAMLOPT -c -for-pack Metacoq_template_plugin gen-src/quoter.ml gen-src/config0.cmx (real: 0.09, user: 0.00, sys: 0.01, mem: 14648 ko) CAMLOPT -c -for-pack Metacoq_template_plugin gen-src/denoter.ml gen-src/denoter.cmx (real: 0.07, user: 0.05, sys: 0.01, mem: 24396 ko) CAMLOPT -c -for-pack Metacoq_template_plugin gen-src/plugin_core.ml gen-src/quoter.cmx (real: 0.17, user: 0.14, sys: 0.02, mem: 34476 ko) CAMLC -c gen-src/quoter.ml gen-src/plugin_core.cmx (real: 0.09, user: 0.06, sys: 0.02, mem: 27344 ko) CAMLOPT -c -for-pack Metacoq_template_plugin gen-src/bool.ml gen-src/bool.cmx (real: 0.02, user: 0.01, sys: 0.01, mem: 15772 ko) CAMLC -c gen-src/equalities.mli gen-src/equalities.cmi (real: 0.04, user: 0.00, sys: 0.00, mem: 13240 ko) CAMLOPT -c -for-pack Metacoq_template_plugin gen-src/decimal.ml gen-src/quoter.cmo (real: 0.16, user: 0.08, sys: 0.01, mem: 26408 ko) CAMLC -c gen-src/hexadecimal.mli gen-src/hexadecimal.cmi (real: 0.01, user: 0.00, sys: 0.00, mem: 13064 ko) CAMLOPT -c -for-pack Metacoq_template_plugin gen-src/specif.ml gen-src/decimal.cmx (real: 0.24, user: 0.03, sys: 0.01, mem: 17936 ko) gen-src/specif.cmx (real: 0.17, user: 0.02, sys: 0.01, mem: 16332 ko) CAMLC -c gen-src/orders.mli CAMLOPT -c -for-pack Metacoq_template_plugin gen-src/cRelationClasses.ml gen-src/orders.cmi (real: 0.02, user: 0.01, sys: 0.00, mem: 13748 ko) CAMLOPT -c -for-pack Metacoq_template_plugin gen-src/compare_dec.ml gen-src/cRelationClasses.cmx (real: 0.04, user: 0.02, sys: 0.01, mem: 16836 ko) CAMLOPT -c -for-pack Metacoq_template_plugin gen-src/equalities.ml gen-src/compare_dec.cmx (real: 0.03, user: 0.01, sys: 0.01, mem: 15536 ko) CAMLOPT -c -for-pack Metacoq_template_plugin gen-src/hexadecimal.ml gen-src/equalities.cmx (real: 0.03, user: 0.01, sys: 0.01, mem: 15840 ko) CAMLC -c gen-src/numeral.mli gen-src/numeral.cmi (real: 0.01, user: 0.00, sys: 0.00, mem: 11900 ko) CAMLOPT -c -for-pack Metacoq_template_plugin gen-src/orders.ml findlib: [WARNING] Interface numeral.cmi occurs in several directories: /builds/coq/coq/_install_ci/lib/coq/plugins/syntax, gen-src gen-src/orders.cmx (real: 0.04, user: 0.01, sys: 0.01, mem: 16768 ko) CAMLC -c gen-src/ordersTac.mli findlib: [WARNING] Interface numeral.cmi occurs in several directories: /builds/coq/coq/_install_ci/lib/coq/plugins/syntax, gen-src gen-src/ordersTac.cmi (real: 0.01, user: 0.00, sys: 0.00, mem: 12464 ko) CAMLC -c gen-src/ordersLists.mli findlib: [WARNING] Interface numeral.cmi occurs in several directories: /builds/coq/coq/_install_ci/lib/coq/plugins/syntax, gen-src gen-src/ordersLists.cmi (real: 0.01, user: 0.00, sys: 0.00, mem: 11760 ko) CAMLC -c gen-src/orderedType0.mli findlib: [WARNING] Interface numeral.cmi occurs in several directories: /builds/coq/coq/_install_ci/lib/coq/plugins/syntax, gen-src gen-src/orderedType0.cmi (real: 0.01, user: 0.00, sys: 0.01, mem: 12108 ko) gen-src/hexadecimal.cmx (real: 0.13, user: 0.09, sys: 0.02, mem: 20020 ko) CAMLC -c gen-src/nat0.mli CAMLC -c gen-src/peanoNat.mli findlib: [WARNING] Interface numeral.cmi occurs in several directories: /builds/coq/coq/_install_ci/lib/coq/plugins/syntax, gen-src findlib: [WARNING] Interface numeral.cmi occurs in several directories: /builds/coq/coq/_install_ci/lib/coq/plugins/syntax, gen-src gen-src/peanoNat.cmi (real: 0.01, user: 0.01, sys:g e0.00n,- smrecm/:n at133640 .kco)m i (real: 0.02, user: 0.01, sys: 0.00, mem: 13460 ko) CAMLOPT -c -for-pack Metacoq_template_plugin gen-src/ordersTac.ml CAMLC -c gen-src/ordersFacts.mli findlib: [WARNING] Interface numeral.cmi occurs in several directories: /builds/coq/coq/_install_ci/lib/coq/plugins/syntax, gen-src findlib: [WARNING] Interface numeral.cmi occurs in several directories: /builds/coq/coq/_install_ci/lib/coq/plugins/syntax, gen-src gen-src/ordersFacts.cmi (real: 0.01, user: 0.00, sys: 0.01, mem: 13444 ko) CAMLOPT -c -for-pack Metacoq_template_plugin gen-src/ordersLists.ml findlib: [WARNING] Interface numeral.cmi occurs in several directories: /builds/coq/coq/_install_ci/lib/coq/plugins/syntax, gen-src gen-src/ordersLists.cmx (real: 0.20, user: 0.00, sys: 0.01, mem: 15096 ko) CAMLC -c gen-src/mSetInterface.mli findlib: [WARNING] Interface numeral.cmi occurs in several directories: /builds/coq/coq/_install_ci/lib/coq/plugins/syntax, gen-src gen-src/mSetInterface.cmi (real: 0.02, user: 0.02, sys: 0.00, mem: 15244 ko) CAMLC -c gen-src/mCCompare.mli findlib: [WARNING] Interface numeral.cmi occurs in several directories: /builds/coq/coq/_install_ci/lib/coq/plugins/syntax, gen-src gen-src/mCCompare.cmi (real: 0.01, user: 0.00, sys: 0.00, mem: 11644 ko) CAMLOPT -c -for-pack Metacoq_template_plugin gen-src/numeral.ml findlib: [WARNING] Interface numeral.cmi occurs in several directories: /builds/coq/coq/_install_ci/lib/coq/plugins/syntax, gen-src gen-src/ordersTac.cmx (real: 0.27, user: 0.01, sys: 0.01, mem: 15844 ko) CAMLC -c gen-src/list0.mli findlib: [WARNING] Interface numeral.cmi occurs in several directories: /builds/coq/coq/_install_ci/lib/coq/plugins/syntax, gen-src gen-src/list0.cmi (real: 0.02, user: 0.01, sys: 0.00, mem: 13404 ko) CAMLC -c gen-src/binPosDef.mli findlib: [WARNING] Interface numeral.cmi occurs in several directories: /builds/coq/coq/_install_ci/lib/coq/plugins/syntax, gen-src gen-src/numeral.cmx (real: 0.04, user: 0.00, sys: 0.01, mem: 15820 ko) CAMLOPT -c -for-pack Metacoq_template_plugin gen-src/ordersFacts.ml findlib: [WARNING] Interface numeral.cmi occurs in several directories: /builds/coq/coq/_install_ci/lib/coq/plugins/syntax, gen-src gen-src/binPosDef.cmi (real: 0.01, user: 0.00, sys: 0.01, mem: 13536 ko) CAMLOPT -c -for-pack Metacoq_template_plugin gen-src/orderedType0.ml findlib: [WARNING] Interface numeral.cmi occurs in several directories: /builds/coq/coq/_install_ci/lib/coq/plugins/syntax, gen-src gen-src/ordersFacts.cmx (real: 0.02, user: 0.01, sys: 0.01, mem: 16032 ko) CAMLC -c gen-src/mSetFacts.mli findlib: [WARNING] Interface numeral.cmi occurs in several directories: /builds/coq/coq/_install_ci/lib/coq/plugins/syntax, gen-src gen-src/mSetFacts.cmi (real: 0.02, user: 0.01, sys: 0.00, mem: 13748 ko) CAMLC -c gen-src/mSetList.mli findlib: [WARNING] Interface numeral.cmi occurs in several directories: /builds/coq/coq/_install_ci/lib/coq/plugins/syntax, gen-src gen-src/mSetList.cmi (real: 0.02, user: 0.01, sys: 0.00, mem: 15760 ko) CAMLC -c gen-src/mCList.mli findlib: [WARNING] Interface numeral.cmi occurs in several directories: /builds/coq/coq/_install_ci/lib/coq/plugins/syntax, gen-src gen-src/orderedType0.cmx (real: 0.07, user: 0.01, sys: 0.01, mem: 15860 ko) CAMLOPT -c -for-pack Metacoq_template_plugin gen-src/nat0.ml findlib: [WARNING] Interface numeral.cmi occurs in several directories: /builds/coq/coq/_install_ci/lib/coq/plugins/syntax, gen-src gen-src/mCList.cmi (real: 0.01, user: 0.00, sys: 0.01, mem: 13612 ko) CAMLOPT -c -for-pack Metacoq_template_plugin gen-src/peanoNat.ml findlib: [WARNING] Interface numeral.cmi occurs in several directories: /builds/coq/coq/_install_ci/lib/coq/plugins/syntax, gen-src gen-src/nat0.cmx (real: 0.21, user: 0.04, sys: 0.01, mem: 18464 ko) CAMLC -c gen-src/binPos.mli findlib: [WARNING] Interface numeral.cmi occurs in several directories: /builds/coq/coq/_install_ci/lib/coq/plugins/syntax, gen-src gen-src/binPos.cmi (real: 0.01, user: 0.01, sys: 0.00, mem: 14264 ko) CAMLOPT -c -for-pack Metacoq_template_plugin gen-src/mSetInterface.ml findlib: [WARNING] Interface numeral.cmi occurs in several directories: /builds/coq/coq/_install_ci/lib/coq/plugins/syntax, gen-src gen-src/peanoNat.cmx (real: 0.26, user: 0.07, sys: 0.02, mem: 19912 ko) CAMLC -c gen-src/mSetDecide.mli findlib: [WARNING] Interface numeral.cmi occurs in several directories: /builds/coq/coq/_install_ci/lib/coq/plugins/syntax, gen-src gen-src/mSetDecide.cmi (real: 0.01, user: 0.00, sys: 0.00, mem: 13776 ko) CAMLC -c gen-src/mCOption.mli findlib: [WARNING] Interface numeral.cmi occurs in several directories: /builds/coq/coq/_install_ci/lib/coq/plugins/syntax, gen-src gen-src/mCOption.cmi (real: 0.01, user: 0.00, sys: 0.00, mem: 12200 ko) CAMLOPT -c -for-pack Metacoq_template_plugin gen-src/mCCompare.ml findlib: [WARNING] Interface numeral.cmi occurs in several directories: /builds/coq/coq/_install_ci/lib/coq/plugins/syntax, gen-src gen-src/mSetInterface.cmx (real: 0.11, user: 0.05, sys: 0.02, mem: 20324 ko) CAMLC -c gen-src/all_Forall.mli findlib: [WARNING] Interface numeral.cmi occurs in several directories: /builds/coq/coq/_install_ci/lib/coq/plugins/syntax, gen-src gen-src/all_Forall.cmi (real: 0.02, user: 0.01, sys: 0.00, mem: 14992 ko) CAMLOPT -c -for-pack Metacoq_template_plugin gen-src/list0.ml findlib: [WARNING] Interface numeral.cmi occurs in several directories: /builds/coq/coq/_install_ci/lib/coq/plugins/syntax, gen-src gen-src/mCCompare.cmx (real: 0.08, user: 0.01, sys: 0.01, mem: 15672 ko) CAMLOPT -c -for-pack Metacoq_template_plugin gen-src/binPosDef.ml findlib: [WARNING] Interface numeral.cmi occurs in several directories: /builds/coq/coq/_install_ci/lib/coq/plugins/syntax, gen-src gen-src/list0.cmx (real: 0.04, user: 0.03, sys: 0.01, mem: 17796 ko) CAMLC -c gen-src/binNat.mli findlib: [WARNING] Interface numeral.cmi occurs in several directories: /builds/coq/coq/_install_ci/lib/coq/plugins/syntax, gen-src gen-src/binNat.cmi (real: 0.01, user: 0.00, sys: 0.00, mem: 13444 ko) CAMLOPT -c -for-pack Metacoq_template_plugin gen-src/mSetFacts.ml findlib: [WARNING] Interface numeral.cmi occurs in several directories: /builds/coq/coq/_install_ci/lib/coq/plugins/syntax, gen-src gen-src/mSetFacts.cmx (real: 0.12, user: 0.01, sys: 0.01, mem: 17012 ko) gen-src/binPosDef.cmx (real: 0.18, user: 0.13, sys: 0.03, mem: 23892 ko) CAMLOPT -c -for-pack Metacoq_template_plugin gen-src/mSetList.ml CAMLC -c gen-src/mSetProperties.mli findlib: [WARNING] Interface numeral.cmi occurs in several directories: /builds/coq/coq/_install_ci/lib/coq/plugins/syntax, gen-src findlib: [WARNING] Interface numeral.cmi occurs in several directories: /builds/coq/coq/_install_ci/lib/coq/plugins/syntax, gen-src gen-src/mSetProperties.cmi (real: 0.07, user: 0.02, sys: 0.00, mem: 15212 ko) CAMLOPT -c -for-pack Metacoq_template_plugin gen-src/mCList.ml findlib: [WARNING] Interface numeral.cmi occurs in several directories: /builds/coq/coq/_install_ci/lib/coq/plugins/syntax, gen-src gen-src/mSetList.cmx (real: 0.28, user: 0.08, sys: 0.02, mem: 21352 ko) CAMLOPT -c -for-pack Metacoq_template_plugin gen-src/binPos.ml findlib: [WARNING] Interface numeral.cmi occurs in several directories: /builds/coq/coq/_install_ci/lib/coq/plugins/syntax, gen-src gen-src/mCList.cmx (real: 0.25, user: 0.01, sys: 0.01, mem: 16712 ko) CAMLC -c gen-src/binInt.mli findlib: [WARNING] Interface numeral.cmi occurs in several directories: /builds/coq/coq/_install_ci/lib/coq/plugins/syntax, gen-src gen-src/binInt.cmi (real: 0.02, user: 0.01, sys: 0.01, mem: 13564 ko) CAMLC -c gen-src/ascii.mli findlib: [WARNING] Interface numeral.cmi occurs in several directories: /builds/coq/coq/_install_ci/lib/coq/plugins/syntax, gen-src gen-src/ascii.cmi (real: 0.01, user: 0.00, sys: 0.01, mem: 12228 ko) CAMLOPT -c -for-pack Metacoq_template_plugin gen-src/mSetDecide.ml findlib: [WARNING] Interface numeral.cmi occurs in several directories: /builds/coq/coq/_install_ci/lib/coq/plugins/syntax, gen-src gen-src/binPos.cmx (real: 0.19, user: 0.15, sys: 0.03, mem: 25208 ko) CAMLOPT -c -for-pack Metacoq_template_plugin gen-src/mCOption.ml findlib: [WARNING] Interface numeral.cmi occurs in several directories: /builds/coq/coq/_install_ci/lib/coq/plugins/syntax, gen-src gen-src/mSetDecide.cmx (real: 0.18g, euns-esrr:c /mC0.01O,p tsiyosn:. cm0.01x, (mreema:l : 17180 ko) 0.08, user: 0.01, sys: 0.01, mem: 16020 ko) CAMLOPT -c -for-pack Metacoq_template_plugin gen-src/binNat.ml CAMLC -c gen-src/string0.mli findlib: [WARNING] Interface numeral.cmi occurs in several directories: /builds/coq/coq/_install_ci/lib/coq/plugins/syntax, gen-src findlib: [WARNING] Interface numeral.cmi occurs in several directories: /builds/coq/coq/_install_ci/lib/coq/plugins/syntax, gen-src gen-src/string0.cmi (real: 0.01, user: 0.00, sys: 0.01, mem: 12236 ko) CAMLOPT -c -for-pack Metacoq_template_plugin gen-src/mSetProperties.ml findlib: [WARNING] Interface numeral.cmi occurs in several directories: /builds/coq/coq/_install_ci/lib/coq/plugins/syntax, gen-src gen-src/mSetProperties.cmx (real: 0.10, user: 0.04, sys: 0.01, mem: 19600 ko) CAMLC -c gen-src/mCString.mli findlib: [WARNING] Interface numeral.cmi occurs in several directories: /builds/coq/coq/_install_ci/lib/coq/plugins/syntax, gen-src gen-src/binNat.cmx (real: 0.13, user: 0.10, sys: 0.02, mem: 20796 ko) CAMLOPT -c -for-pack Metacoq_template_plugin gen-src/all_Forall.ml gen-src/mCString.cmi (real: 0.01, user: 0.00, sys: 0.00, mem: 11712 ko) findlib: [WARNING] Interface numeral.cmi occurs in several directories: /builds/coq/coq/_install_ci/lib/coq/plugins/syntax, gen-src CAMLOPT -c -for-pack Metacoq_template_plugin gen-src/binInt.ml findlib: [WARNING] Interface numeral.cmi occurs in several directories: /builds/coq/coq/_install_ci/lib/coq/plugins/syntax, gen-src gen-src/binInt.cmx (real: 0.32, user: 0.12, sys: 0.02, mem: 22784 ko) gen-src/all_Forall.cmx (real: 0.33, user: 0.14, sys: 0.02, mem: 25372 ko) CAMLOPT -c -for-pack Metacoq_template_plugin gen-src/ascii.ml CAMLC -c gen-src/basicAst.mli findlib: [WARNING] Interface numeral.cmi occurs in several directories: /builds/coq/coq/_install_ci/lib/coq/plugins/syntax, gen-src findlib: [WARNING] Interface numeral.cmi occurs in several directories: /builds/coq/coq/_install_ci/lib/coq/plugins/syntax, gen-src gen-src/basicAst.cmi (real: 0.02, user: 0.01, sys: 0.00, mem: 14404 ko) CAMLC -c gen-src/universes0.mli findlib: [WARNING] Interface numeral.cmi occurs in several directories: /builds/coq/coq/_install_ci/lib/coq/plugins/syntax, gen-src gen-src/ascii.cmx (real: 0.06, user: 0.02, sys: 0.01, mem: 16900 ko) CAMLOPT -c -for-pack Metacoq_template_plugin gen-src/string0.ml findlib: [WARNING] Interface numeral.cmi occurs in several directories: /builds/coq/coq/_install_ci/lib/coq/plugins/syntax, gen-src gen-src/universes0.cmi (real: 0.06, user: 0.04, sys: 0.01, mem: 18504 ko) CAMLC -c gen-src/environment.mli findlib: [WARNING] Interface numeral.cmi occurs in several directories: /builds/coq/coq/_install_ci/lib/coq/plugins/syntax, gen-src gen-src/string0.cmx (real: 0.04, user: 0.02, sys: 0.01, mem: 16504 ko) CAMLC -c gen-src/ast0.mli findlib: [WARNING] Interface numeral.cmi occurs in several directories: /builds/coq/coq/_install_ci/lib/coq/plugins/syntax, gen-src gen-src/environment.cmi (real: 0.02, user: 0.01, sys: 0.01, mem: 14988 ko) CAMLOPT -c -for-pack Metacoq_template_plugin gen-src/mCString.ml findlib: [WARNING] Interface numeral.cmi occurs in several directories: /builds/coq/coq/_install_ci/lib/coq/plugins/syntax, gen-src gen-src/ast0.cmi (real: 0.03, user: 0.01, sys: 0.01, mem: 15204 ko) CAMLC -c gen-src/astUtils.mli findlib: [WARNING] Interface numeral.cmi occurs in several directories: /builds/coq/coq/_install_ci/lib/coq/plugins/syntax, gen-src gen-src/astUtils.cmi (real: 0.01, user: 0.00, sys: 0.00, mem: 14040 ko) CAMLC -c gen-src/liftSubst.mli findlib: [WARNING] Interface numeral.cmi occurs in several directories: /builds/coq/coq/_install_ci/lib/coq/plugins/syntax, gen-src gen-src/liftSubst.cmi (real: 0.01, user: 0.00, sys: 0.00, mem: 13680 ko) CAMLC -c gen-src/univSubst0.mli findlib: [WARNING] Interface numeral.cmi occurs in several directories: /builds/coq/coq/_install_ci/lib/coq/plugins/syntax, gen-src gen-src/univSubst0.cmi (real: 0.01, user: 0.00, sys: 0.00, mem: 14128 ko) CAMLC -c gen-src/pretty.mli findlib: [WARNING] Interface numeral.cmi occurs in several directories: /builds/coq/coq/_install_ci/lib/coq/plugins/syntax, gen-src gen-src/pretty.cmi (real: 0.01, user: 0.00, sys: 0.01, mem: 15060 ko) CAMLC -c gen-src/common0.mli findlib: [WARNING] Interface numeral.cmi occurs in several directories: /builds/coq/coq/_install_ci/lib/coq/plugins/syntax, gen-src gen-src/common0.cmi (real: 0.01, user: 0.00, sys: 0.00, mem: 13492 ko) CAMLC -c gen-src/ast_quoter.ml findlib: [WARNING] Interface numeral.cmi occurs in several directories: /builds/coq/coq/_install_ci/lib/coq/plugins/syntax, gen-src gen-src/ast_quoter.cmo (real: 0.06, user: 0.04, sys: 0.01, mem: 22660 ko) CAMLC -c gen-src/extractable.mli findlib: [WARNING] Interface numeral.cmi occurs in several directories: /builds/coq/coq/_install_ci/lib/coq/plugins/syntax, gen-src gen-src/mCString.cmx (real: 0.24, user: 0.02, sys: 0.01, mem: 16472 ko) CAMLOPT -c -for-pack Metacoq_template_plugin gen-src/basicAst.ml gen-src/extractable.cmi (real: 0.07, user: 0.00, sys: 0.00, mem: 13580 ko) CAMLC -c gen-src/run_extractable.mli findlib: [WARNING] Interface numeral.cmi occurs in several directories: /builds/coq/coq/_install_ci/lib/coq/plugins/syntax, gen-src findlib: [WARNING] Interface numeral.cmi occurs in several directories: /builds/coq/coq/_install_ci/lib/coq/plugins/syntax, gen-src gen-src/run_extractable.cmi (real: 0.01, user: 0.00, sys: 0.00, mem: 13668 ko) gen-src/basicAst.cmx (real: 0.05, user: 0.03, sys: 0.01, mem: 18744 ko) CAMLOPT -c -for-pack Metacoq_template_plugin gen-src/universes0.ml findlib: [WARNING] Interface numeral.cmi occurs in several directories: /builds/coq/coq/_install_ci/lib/coq/plugins/syntax, gen-src gen-src/universes0.cmx (real: 0.59, user: 0.41, sys: 0.03, mem: 39160 ko) CAMLOPT -c -for-pack Metacoq_template_plugin gen-src/environment.ml findlib: [WARNING] Interface numeral.cmi occurs in several directories: /builds/coq/coq/_install_ci/lib/coq/plugins/syntax, gen-src gen-src/environment.cmx (real: 0.16, user: 0.03, sys: 0.01, mem: 19716 ko) CAMLOPT -c -for-pack Metacoq_template_plugin gen-src/ast0.ml findlib: [WARNING] Interface numeral.cmi occurs in several directories: /builds/coq/coq/_install_ci/lib/coq/plugins/syntax, gen-src gen-src/ast0.cmx (real: 0.25, user: 0.09, sys: 0.02, mem: 24572 ko) CAMLOPT -c -for-pack Metacoq_template_plugin gen-src/astUtils.ml CAMLOPT -c -for-pack Metacoq_template_plugin gen-src/liftSubst.ml findlib: [WARNING] Interface numeral.cmi occurs in several directories: /builds/coq/coq/_install_ci/lib/coq/plugins/syntax, gen-src findlib: [WARNING] Interface numeral.cmi occurs in several directories: /builds/coq/coq/_install_ci/lib/coq/plugins/syntax, gen-src gen-src/astUtils.cmx (real: 0.05, user: 0.04, sys: 0.01, mem: 19608 ko) CAMLOPT -c -for-pack Metacoq_template_plugin gen-src/univSubst0.ml gen-src/liftSubst.cmx (real: 0.06, user: 0.04, sys: 0.01, mem: 19008 ko) CAMLOPT -c -for-pack Metacoq_template_plugin gen-src/common0.ml findlib: [WARNING] Interface numeral.cmi occurs in several directories: /builds/coq/coq/_install_ci/lib/coq/plugins/syntax, gen-src findlib: [WARNING] Interface numeral.cmi occurs in several directories: /builds/coq/coq/_install_ci/lib/coq/plugins/syntax, gen-src gen-src/common0.cmx (real: 0.05, user: 0.02, sys: 0.01, mem: 16420 ko) gen-src/univSubst0.cmx (real: 0.05, user: 0.03, sys: 0.01, mem: 18548 ko) CAMLOPT -c -for-pack Metacoq_template_plugin gen-src/ast_quoter.ml CAMLOPT -c -for-pack Metacoq_template_plugin gen-src/pretty.ml findlib: [WARNING] Interface numeral.cmi occurs in several directories: /builds/coq/coq/_install_ci/lib/coq/plugins/syntax, gen-src findlib: [WARNING] Interface numeral.cmi occurs in several directories: /builds/coq/coq/_install_ci/lib/coq/plugins/syntax, gen-src gen-src/pretty.cmx (real: 0.11, user: 0.08, sys: 0.01, mem: 22020 ko) CAMLOPT -c -for-pack Metacoq_template_plugin gen-src/extractable.ml findlib: [WARNING] Interface numeral.cmi occurs in several directories: /builds/coq/coq/_install_ci/lib/coq/plugins/syntax, gen-src gen-src/extractable.cmx (real: 0.08, user: 0.04, sys: 0.01, mem: 18780 ko) gen-src/ast_quoter.cmx (real: 0.20, user: 0.10, sys: 0.02, mem: 27252 ko) CAMLOPT -c -for-pack Metacoq_template_plugin gen-src/ast_denoter.ml findlib: [WARNING] Interface numeral.cmi occurs in several directories: /builds/coq/coq/_install_ci/lib/coq/plugins/syntax, gen-src gen-src/ast_denoter.cmx (real: 0.12, user: 0.07, sys: 0.02, mem: 27180 ko) CAMLOPT -c -for-pack Metacoq_template_plugin gen-src/run_extractable.ml findlib: [WARNING] Interface numeral.cmi occurs in several directories: /builds/coq/coq/_install_ci/lib/coq/plugins/syntax, gen-src gen-src/run_extractable.cmx (real: 0.13, user: 0.10, sys: 0.02, mem: 30484 ko) CAMLOPT -pack -o gen-src/metacoq_template_plugin.cmx findlib: [WARNING] Interface numeral.cmi occurs in several directories: /builds/coq/coq/_install_ci/lib/coq/plugins/syntax, gen-src gen-src/metacoq_template_plugin.cmx (real: 0.15, user: 0.09, sys: 0.04, mem: 31648 ko) CAMLOPT -a -o gen-src/metacoq_template_plugin.cmxa findlib: [WARNING] Interface numeral.cmi occurs in several directories: /builds/coq/coq/_install_ci/lib/coq/plugins/syntax, gen-src gen-src/metacoq_template_plugin.cmxa (real: 0.03, user: 0.01, sys: 0.02, mem: 13896 ko) CAMLOPT -shared -o gen-src/metacoq_template_plugin.cmxs findlib: [WARNING] Interface numeral.cmi occurs in several directories: /builds/coq/coq/_install_ci/lib/coq/plugins/syntax, gen-src gen-src/metacoq_template_plugin.cmxs (real: 0.13, user: 0.09, sys: 0.03, mem: 18540 ko) COQC theories/ExtractableLoader.v theories/ExtractableLoader.vo (real: 0.09, user: 0.05, sys: 0.03, mem: 62540 ko) cp gen-src/metacoq_template_plugin.cm* build/ make[4]: Leaving directory '/builds/coq/coq/_build_ci/metacoq/template-coq' make[3]: Leaving directory '/builds/coq/coq/_build_ci/metacoq/template-coq' make -C checker make -C pcuic make[3]: Entering directory '/builds/coq/coq/_build_ci/metacoq/checker' cat metacoq-config > _CoqProject make[3]: Entering directory '/builds/coq/coq/_build_ci/metacoq/pcuic' cat metacoq-config > _CoqProject cat _CoqProject.in >> _CoqProject cat _CoqProject.in >> _CoqProject coq_makefile -f _CoqProject -o Makefile.pcuic coq_makefile -f _CoqProject -o Makefile.coq Warning: ../template-coq/theories (used in -R or -Q) is not a subdirectory of the current directory make -f Makefile.coq Warning: ../template-coq/theories (used in -R or -Q) is not a subdirectory of the current directory make -f Makefile.pcuic make[4]: Entering directory '/builds/coq/coq/_build_ci/metacoq/checker' make[4]: Entering directory '/builds/coq/coq/_build_ci/metacoq/pcuic' COQDEP VFILES COQDEP VFILES COQC theories/Reflect.v COQC theories/PCUICAst.v theories/PCUICAst.vo (real: 0.99, user: 0.75, sys: 0.23, mem: 477372 ko) COQC theories/PCUICSize.v theories/PCUICSize.vo (real: 1.73, user: 1.44, sys: 0.28, mem: 503484 ko) COQC theories/PCUICInduction.v theories/PCUICInduction.vo (real: 1.19, user: 0.89, sys: 0.29, mem: 481312 ko) COQC theories/PCUICCheckerCompleteness.v theories/PCUICCheckerCompleteness.vo (real: 0.85, user: 0.60, sys: 0.24, mem: 433064 ko) COQC theories/TemplateToPCUIC.v theories/Reflect.vo (real: 5.26, user: 4.53, sys: 0.70, mem: 552364 ko) COQC theories/WeakeningEnv.v theories/TemplateToPCUIC.vo (real: 0.98, user: 0.69, sys: 0.27, mem: 482472 ko) COQC theories/PCUICAstUtils.v theories/WeakeningEnv.vo (real: 3.33, user: 2.80, sys: 0.50, mem: 512292 ko) COQC theories/Checker.v theories/PCUICAstUtils.vo (real: 3.13, user: 2.78, sys: 0.32, mem: 543424 ko) COQC theories/PCUICReflect.v theories/Checker.vo (real: 4.71, user: 4.00, sys: 0.69, mem: 555748 ko) COQC theories/WcbvEval.v theories/PCUICReflect.vo (real: 4.46, user: 4.11, sys: 0.32, mem: 543956 ko) COQC theories/PCUICLiftSubst.v theories/WcbvEval.vo (real: 5.56, user: 4.94, sys: 0.59, mem: 533768 ko) COQC theories/Retyping.v theories/Retyping.vo (real: 1.16, user: 0.90, sys: 0.26, mem: 524140 ko) COQC theories/Normal.v theories/Normal.vo (real: 1.10, user: 0.84, sys: 0.25, mem: 497360 ko) COQC theories/Generation.v theories/Generation.vo (real: 1.95, user: 1.69, sys: 0.25, mem: 514692 ko) COQC theories/Closed.v File "./theories/Closed.v", line 299, characters 2-42: Warning: Automatically inlined signature for type All_local_env. Use [Derive Signature for All_local_env.] to avoid this. theories/PCUICLiftSubst.vo (real: 27.51, user: 26.28, sys: 0.94, mem: 597996 ko) COQC theories/PCUICToTemplate.v theories/PCUICToTemplate.vo (real: 1.33, user: 1.04, sys: 0.28, mem: 527408 ko) COQC theories/PCUICUtils.v theories/PCUICUtils.vo (real: 1.81, user: 1.47, sys: 0.33, mem: 527440 ko) COQC theories/PCUICUnivSubst.v theories/Closed.vo (real: 22.03, user: 21.55, sys: 0.36, mem: 603616 ko) COQC theories/Weakening.v theories/PCUICUnivSubst.vo (real: 3.67, user: 3.33, sys: 0.32, mem: 533884 ko) COQC theories/PCUICEquality.v theories/Weakening.vo (real: 16.17, user: 15.64, sys: 0.43, mem: 579100 ko) COQC theories/Substitution.v theories/PCUICEquality.vo (real: 40.79, user: 39.04, sys: 1.52, mem: 790088 ko) COQC theories/PCUICPosition.v theories/Substitution.vo (real: 29.09, user: 27.93, sys: 0.98, mem: 621392 ko) COQC theories/All.v theories/All.vo (real: 1.65, user: 1.29, sys: 0.34, mem: 545736 ko) ./update_plugin.sh Renaming extracted files make[4]: Leaving directory '/builds/coq/coq/_build_ci/metacoq/checker' make[3]: Leaving directory '/builds/coq/coq/_build_ci/metacoq/checker' make -C examples make[3]: Entering directory '/builds/coq/coq/_build_ci/metacoq/examples' coq_makefile -f _CoqProject -o Makefile.coq Warning: ../template-coq/theories (used in -R or -Q) is not a subdirectory of the current directory make -f Makefile.coq pretty-timed make[4]: Entering directory '/builds/coq/coq/_build_ci/metacoq/examples' COQDEP VFILES COQC demo.v demo.vo (real: 1.94, user: 1.56, sys: 0.36, mem: 527740 ko) COQC add_constructor.v add_constructor.vo (real: 1.44, user: 1.13, sys: 0.30, mem: 524144 ko) COQC tauto.v tauto.vo (real: 20.77, user: 19.93, sys: 0.72, mem: 581920 ko) Time | Peak Mem | File Name -------------------------------------------- 0m22.62s | 581920 ko | Total Time / Peak Mem -------------------------------------------- 0m19.93s | 581920 ko | tauto.vo 0m01.56s | 527740 ko | demo.vo 0m01.13s | 524144 ko | add_constructor.vo make[4]: Leaving directory '/builds/coq/coq/_build_ci/metacoq/examples' make[3]: Leaving directory '/builds/coq/coq/_build_ci/metacoq/examples' theories/PCUICPosition.vo (real: 29.43, user: 28.24, sys: 1.03, mem: 723216 ko) COQC theories/PCUICTyping.v Axioms: ind_guard : mutual_inductive_body -> bool fix_guard : mfixpoint term -> bool cofix_guard : mfixpoint term -> bool theories/PCUICTyping.vo (real: 44.26, user: 42.82, sys: 1.17, mem: 727688 ko) COQC theories/PCUICReduction.v COQC theories/PCUICWeakeningEnv.v theories/PCUICWeakeningEnv.vo (real: 5.17, user: 4.38, sys: 0.74, mem: 571076 ko) COQC theories/PCUICGeneration.v theories/PCUICReduction.vo (real: 6.98, user: 6.16, sys: 0.78, mem: 583116 ko) COQC theories/PCUICNormal.v theories/PCUICNormal.vo (real: 1.72, user: 1.37, sys: 0.33, mem: 551200 ko) COQC theories/PCUICNameless.v theories/PCUICGeneration.vo (real: 3.72, user: 3.34, sys: 0.36, mem: 586388 ko) COQC theories/PCUICMetaTheory.v theories/PCUICMetaTheory.vo (real: 1.26, user: 0.96, sys: 0.29, mem: 546928 ko) COQC theories/PCUICChecker.v theories/PCUICChecker.vo (real: 1.41, user: 1.11, sys: 0.29, mem: 549776 ko) COQC theories/PCUICToTemplateCorrectness.v theories/PCUICToTemplateCorrectness.vo (real: 8.69, user: 7.84, sys: 0.79, mem: 608576 ko) COQC theories/PCUICCumulativity.v theories/PCUICCumulativity.vo (real: 2.17, user: 1.85, sys: 0.30, mem: 561876 ko) COQC theories/PCUICClosed.v theories/PCUICNameless.vo (real: 15.98, user: 14.98, sys: 0.89, mem: 623196 ko) COQC theories/PCUICPretty.v theories/PCUICPretty.vo (real: 1.64, user: 1.30, sys: 0.33, mem: 551364 ko) theories/PCUICClosed.vo (real: 24.65, user: 23.99, sys: 0.51, mem: 654592 ko) COQC theories/PCUICWeakening.v COQC theories/PCUICCSubst.v theories/PCUICCSubst.vo (real: 1.93, user: 1.55, sys: 0.36, mem: 562424 ko) COQC theories/PCUICWcbvEval.v theories/PCUICWcbvEval.vo (real: 12.05, user: 11.54, sys: 0.43, mem: 589944 ko) theories/PCUICWeakening.vo (real: 24.20, user: 23.42, sys: 0.64, mem: 685852 ko) COQC theories/PCUICSigmaCalculus.v COQC theories/PCUICUnivSubstitution.v theories/PCUICUnivSubstitution.vo (real: 10.93, user: 10.41, sys: 0.45, mem: 621644 ko) theories/PCUICSigmaCalculus.vo (real: 39.32, user: 38.12, sys: 0.96, mem: 657100 ko) COQC theories/PCUICSubstitution.v theories/PCUICSubstitution.vo (real: 26.54, user: 25.65, sys: 0.68, mem: 673140 ko) COQC theories/PCUICParallelReduction.v COQC theories/TemplateToPCUICCorrectness.v theories/TemplateToPCUICCorrectness.vo (real: 13.77, user: 13.16, sys: 0.52, mem: 641024 ko) theories/PCUICParallelReduction.vo (real: 29.43, user: 28.26, sys: 0.87, mem: 779308 ko) COQC theories/PCUICParallelReductionConfluence.v Axioms: ind_guard : mutual_inductive_body → bool FunctionalExtensionality.functional_extensionality_dep : ∀ (A : Type) (B : A → Type) (f g : ∀ x : A, B x), (∀ x : A, f x = g x) → f = g fix_guard : mfixpoint term → bool cofix_guard : mfixpoint term → bool theories/PCUICParallelReductionConfluence.vo (real: 96.83, user: 94.58, sys: 1.69, mem: 849824 ko) COQC theories/PCUICConfluence.v theories/PCUICConfluence.vo (real: 35.96, user: 34.44, sys: 1.27, mem: 742788 ko) COQC theories/PCUICContextConversion.v theories/PCUICContextConversion.vo (real: 9.28, user: 8.74, sys: 0.48, mem: 629108 ko) COQC theories/PCUICConversion.v File "./theories/PCUICConversion.v", line 2097, characters 4-13: Warning: Automatically inlined signature for type clos_refl_trans_1n. Use [Derive Signature for clos_refl_trans_1n.] to avoid this. File "./theories/PCUICConversion.v", line 2234, characters 4-37: Warning: Cannot remove s'. [cannot-remove-as-expected,tactics] theories/PCUICConversion.vo (real: 30.61, user: 29.65, sys: 0.79, mem: 750296 ko) COQC theories/PCUICInversion.v COQC theories/PCUICRetyping.v theories/PCUICRetyping.vo (real: 1.94, user: 1.58, sys: 0.34, mem: 589768 ko) theories/PCUICInversion.vo (real: 10.19, user: 9.35, sys: 0.77, mem: 622488 ko) COQC theories/PCUICCtxShape.v theories/PCUICCtxShape.vo (real: 2.23, user: 1.75, sys: 0.38, mem: 598288 ko) COQC theories/PCUICContexts.v theories/PCUICContexts.vo (real: 6.83, user: 6.33, sys: 0.45, mem: 615568 ko) COQC theories/PCUICArities.v theories/PCUICArities.vo (real: 8.61, user: 7.75, sys: 0.80, mem: 625664 ko) COQC theories/PCUICSpine.v theories/PCUICSpine.vo (real: 23.61, user: 22.85, sys: 0.63, mem: 706592 ko) COQC theories/PCUICInductives.v theories/PCUICInductives.vo (real: 19.89, user: 19.08, sys: 0.66, mem: 683776 ko) COQC theories/PCUICValidity.v theories/PCUICValidity.vo (real: 4.40, user: 3.99, sys: 0.36, mem: 624912 ko) COQC theories/PCUICAlpha.v COQC theories/PCUICInductiveInversion.v theories/PCUICAlpha.vo (real: 10.12, user: 9.58, sys: 0.47, mem: 684644 ko) theories/PCUICInductiveInversion.vo (real: 10.95, user: 10.39, sys: 0.48, mem: 661964 ko) COQC theories/PCUICSR.v Axioms: todounivs : forall A : Type, A todoeta : forall A : Type, A ind_guard : mutual_inductive_body -> bool FunctionalExtensionality.functional_extensionality_dep : forall (A : Type) (B : A -> Type) (f g : forall x : A, B x), (forall x : A, f x = g x) -> f = g fix_guard_subst_instance : forall (mfix : mfixpoint term) (u : Instance.t), fix_guard mfix -> fix_guard (map (map_def (subst_instance_constr u) (subst_instance_constr u)) mfix) fix_guard_subst : forall (mfix : list (def term)) (s : list term) (k : nat), let k' := #|mfix| + k in let mfix' := map (map_def (subst s k) (subst s k')) mfix in fix_guard mfix -> fix_guard mfix' fix_guard_red1 : forall (Σ : global_env) (Γ : context) (mfix mfix' : mfixpoint term) (idx : nat), fix_guard mfix -> red1 Σ Γ (tFix mfix idx) (tFix mfix' idx) -> fix_guard mfix' fix_guard_lift : forall (mfix : list (def term)) (n k : nat), let k' := #|mfix| + k in let mfix' := map (map_def (lift n k) (lift n k')) mfix in fix_guard mfix -> fix_guard mfix' fix_guard : mfixpoint term -> bool cofix_guard_subst_instance : forall (mfix : mfixpoint term) (u : Instance.t), cofix_guard mfix -> cofix_guard (map (map_def (subst_instance_constr u) (subst_instance_constr u)) mfix) cofix_guard_subst : forall (mfix : list (def term)) (s : list term) (k : nat), let k' := #|mfix| + k in let mfix' := map (map_def (subst s k) (subst s k')) mfix in cofix_guard mfix -> cofix_guard mfix' cofix_guard_red1 : forall (Σ : global_env) (Γ : context) (mfix mfix' : mfixpoint term) (idx : nat), cofix_guard mfix -> red1 Σ Γ (tCoFix mfix idx) (tCoFix mfix' idx) -> cofix_guard mfix' cofix_guard_lift : forall (mfix : list (def term)) (n k : nat), let k' := #|mfix| + k in let mfix' := map (map_def (lift n k) (lift n k')) mfix in cofix_guard mfix -> cofix_guard mfix' cofix_guard : mfixpoint term -> bool theories/PCUICSR.vo (real: 82.63, user: 80.36, sys: 1.84, mem: 975764 ko) COQC theories/PCUICPrincipality.v Axioms: todounivs : forall A : Type@{todounivs.u0}, A todoeta : forall A : Type@{todoeta.u0}, A ind_guard : mutual_inductive_body -> bool FunctionalExtensionality.functional_extensionality_dep : forall (A : Type@{FunctionalExtensionality.functional_extensionality_dep.u0}) (B : A -> Type@{FunctionalExtensionality.functional_extensionality_dep.u1}) (f g : forall x : A, B x), (forall x : A, f x = g x) -> f = g PCUICUnivSubstitution.fix_guard_subst_instance : forall (mfix : mfixpoint term) (u : Instance.t), fix_guard mfix -> fix_guard (map (map_def (subst_instance_constr u) (subst_instance_constr u)) mfix) fix_guard_subst : forall (mfix : list (def term)) (s : list term) (k : nat), let k' := #|mfix| + k in let mfix' := map (map_def (subst s k) (subst s k')) mfix in fix_guard mfix -> fix_guard mfix' fix_guard_red1 : forall (Σ : global_env) (Γ : context) (mfix mfix' : mfixpoint term) (idx : nat), fix_guard mfix -> red1 Σ Γ (tFix mfix idx) (tFix mfix' idx) -> fix_guard mfix' fix_guard_lift : forall (mfix : list (def term)) (n k : nat), let k' := #|mfix| + k in let mfix' := map (map_def (lift n k) (lift n k')) mfix in fix_guard mfix -> fix_guard mfix' fix_guard_eq_term : forall (mfix mfix' : mfixpoint term) (idx : nat), fix_guard mfix -> tFix mfix idx ≡ tFix mfix' idx -> fix_guard mfix' fix_guard : mfixpoint term -> bool PCUICUnivSubstitution.cofix_guard_subst_instance : forall (mfix : mfixpoint term) (u : Instance.t), cofix_guard mfix -> cofix_guard (map (map_def (subst_instance_constr u) (subst_instance_constr u)) mfix) cofix_guard_subst : forall (mfix : list (def term)) (s : list term) (k : nat), let k' := #|mfix| + k in let mfix' := map (map_def (subst s k) (subst s k')) mfix in cofix_guard mfix -> cofix_guard mfix' cofix_guard_red1 : forall (Σ : global_env) (Γ : context) (mfix mfix' : mfixpoint term) (idx : nat), cofix_guard mfix -> red1 Σ Γ (tCoFix mfix idx) (tCoFix mfix' idx) -> cofix_guard mfix' cofix_guard_lift : forall (mfix : list (def term)) (n k : nat), let k' := #|mfix| + k in let mfix' := map (map_def (lift n k) (lift n k')) mfix in cofix_guard mfix -> cofix_guard mfix' cofix_guard_eq_term : forall (mfix mfix' : mfixpoint term) (idx : nat), cofix_guard mfix -> tCoFix mfix idx ≡ tCoFix mfix' idx -> cofix_guard mfix' cofix_guard : mfixpoint term -> bool theories/PCUICPrincipality.vo (real: 27.66, user: 26.11, sys: 1.08, mem: 959132 ko) COQC theories/PCUICSafeLemmata.v theories/PCUICSafeLemmata.vo (real: 7.45, user: 6.54, sys: 0.85, mem: 667924 ko) COQC theories/PCUICSN.v COQC theories/PCUICElimination.v theories/PCUICSN.vo (real: 2.47, user: 2.12, sys: 0.33, mem: 630488 ko) theories/PCUICElimination.vo (real: 8.12, user: 7.64, sys: 0.44, mem: 646256 ko) # echo "All done, moving extraction files!" # ./clean_extraction.sh make[4]: Leaving directory '/builds/coq/coq/_build_ci/metacoq/pcuic' make[3]: Leaving directory '/builds/coq/coq/_build_ci/metacoq/pcuic' make -C safechecker make[3]: Entering directory '/builds/coq/coq/_build_ci/metacoq/safechecker' cat metacoq-config > _CoqProject cat _CoqProject.in >> _CoqProject coq_makefile -f _CoqProject -o Makefile.safechecker Warning: ../template-coq/theories (used in -R or -Q) is not a subdirectory of the current directory make -f Makefile.safechecker make[4]: Entering directory '/builds/coq/coq/_build_ci/metacoq/safechecker' COQDEP VFILES COQC theories/PCUICSafeReduce.v theories/PCUICSafeReduce.vo (real: 121.19, user: 119.92, sys: 0.74, mem: 1136588 ko) COQC theories/PCUICSafeConversion.v theories/PCUICSafeConversion.vo (real: 140.66, user: 139.40, sys: 0.64, mem: 1007764 ko) COQC theories/PCUICSafeChecker.v File "./theories/PCUICSafeChecker.v", line 1035, characters 4-15: Warning: Automatically inlined signature for type Forall. Use [Derive Signature for Forall.] to avoid this. File "./theories/PCUICSafeChecker.v", line 1039, characters 4-19: Warning: Automatically inlined signature for type Forall. Use [Derive Signature for Forall.] to avoid this. Axioms: todounivs : forall A : Type, A todoeta : forall A : Type, A todo : string -> forall A : Type, A proof_irrelevance : forall (P : Prop) (p1 p2 : P), p1 = p2 normalisation' : forall (cf : checker_flags) (Σ : global_env_ext) (Γ : context) (t : term), wf Σ -> wellformed Σ Γ t -> Acc (cored Σ.1 Γ) t ind_guard : mutual_inductive_body -> bool functional_extensionality_dep : forall (A : Type) (B : A -> Type) (f g : forall x : A, B x), (forall x : A, f x = g x) -> f = g PCUICUnivSubstitution.fix_guard_subst_instance : forall (mfix : mfixpoint term) (u : Instance.t), fix_guard mfix -> fix_guard (map (map_def (subst_instance_constr u) (subst_instance_constr u)) mfix) fix_guard_subst : forall (mfix : list (def term)) (s : list term) (k : nat), let k' := (#|mfix| + k)%nat in let mfix' := map (map_def (subst s k) (subst s k')) mfix in fix_guard mfix -> fix_guard mfix' fix_guard_red1 : forall (Σ : global_env) (Γ : context) (mfix mfix' : mfixpoint term) (idx : nat), fix_guard mfix -> red1 Σ Γ (tFix mfix idx) (tFix mfix' idx) -> fix_guard mfix' fix_guard_lift : forall (mfix : list (def term)) (n k : nat), let k' := (#|mfix| + k)%nat in let mfix' := map (map_def (lift n k) (lift n k')) mfix in fix_guard mfix -> fix_guard mfix' fix_guard_eq_term : forall (mfix mfix' : mfixpoint term) (idx : nat), fix_guard mfix -> tFix mfix idx ≡ tFix mfix' idx -> fix_guard mfix' fix_guard : mfixpoint term -> bool PCUICUnivSubstitution.cofix_guard_subst_instance : forall (mfix : mfixpoint term) (u : Instance.t), cofix_guard mfix -> cofix_guard (map (map_def (subst_instance_constr u) (subst_instance_constr u)) mfix) cofix_guard_subst : forall (mfix : list (def term)) (s : list term) (k : nat), let k' := (#|mfix| + k)%nat in let mfix' := map (map_def (subst s k) (subst s k')) mfix in cofix_guard mfix -> cofix_guard mfix' cofix_guard_red1 : forall (Σ : global_env) (Γ : context) (mfix mfix' : mfixpoint term) (idx : nat), cofix_guard mfix -> red1 Σ Γ (tCoFix mfix idx) (tCoFix mfix' idx) -> cofix_guard mfix' cofix_guard_lift : forall (mfix : list (def term)) (n k : nat), let k' := (#|mfix| + k)%nat in let mfix' := map (map_def (lift n k) (lift n k')) mfix in cofix_guard mfix -> cofix_guard mfix' cofix_guard_eq_term : forall (mfix mfix' : mfixpoint term) (idx : nat), cofix_guard mfix -> tCoFix mfix idx ≡ tCoFix mfix' idx -> cofix_guard mfix' cofix_guard : mfixpoint term -> bool theories/PCUICSafeChecker.vo (real: 56.94, user: 56.09, sys: 0.61, mem: 958816 ko) COQC theories/SafeTemplateChecker.v COQC theories/PCUICSafeRetyping.v theories/SafeTemplateChecker.vo (real: 2.78, user: 2.42, sys: 0.35, mem: 703592 ko) COQC theories/Extraction.v theories/PCUICSafeRetyping.vo (real: 6.81, user: 6.30, sys: 0.48, mem: 733700 ko) theories/Extraction.vo (real: 4.93, user: 4.47, sys: 0.43, mem: 749140 ko) echo "Done extracting the safe checker, moving extraction files!" Done extracting the safe checker, moving extraction files! ./clean_extraction.sh Cleaning result of extraction Moving All_Forall.ml to all_Forall.ml Moving All_Forall.mli to all_Forall.mli Moving Ascii.ml to ascii.ml Moving Ascii.mli to ascii.mli Moving Ast0.ml to ast0.ml Moving Ast0.mli to ast0.mli Moving BasicAst.ml to basicAst.ml Moving BasicAst.mli to basicAst.mli Moving Basics.ml to basics.ml Moving Basics.mli to basics.mli Moving BinInt.ml to binInt.ml Moving BinInt.mli to binInt.mli Moving BinNat.ml to binNat.ml Moving BinNat.mli to binNat.mli Moving BinNums.ml to binNums.ml Moving BinNums.mli to binNums.mli Moving BinPos.ml to binPos.ml Moving BinPos.mli to binPos.mli Moving Bool.ml to bool.ml Moving Bool.mli to bool.mli Moving Byte.ml to byte.ml Moving Byte.mli to byte.mli Moving Classes0.ml to classes0.ml Moving Classes0.mli to classes0.mli Moving Compare_dec.ml to compare_dec.ml Moving Compare_dec.mli to compare_dec.mli Moving Datatypes.ml to datatypes.ml Moving Datatypes.mli to datatypes.mli Moving Environment.ml to environment.ml Moving Environment.mli to environment.mli Moving EqDecInstances.ml to eqDecInstances.ml Moving EqDecInstances.mli to eqDecInstances.mli Moving EqdepFacts.ml to eqdepFacts.ml Moving EqdepFacts.mli to eqdepFacts.mli Moving Equalities.ml to equalities.ml Moving Equalities.mli to equalities.mli Moving List0.ml to list0.ml Moving List0.mli to list0.mli Moving MCCompare.ml to mCCompare.ml Moving MCCompare.mli to mCCompare.mli Moving MCList.ml to mCList.ml Moving MCList.mli to mCList.mli Moving MCOption.ml to mCOption.ml Moving MCOption.mli to mCOption.mli Moving MCProd.ml to mCProd.ml Moving MCProd.mli to mCProd.mli Moving MCString.ml to mCString.ml Moving MCString.mli to mCString.mli Moving MSetDecide.ml to mSetDecide.ml Moving MSetDecide.mli to mSetDecide.mli Moving MSetFacts.ml to mSetFacts.ml Moving MSetFacts.mli to mSetFacts.mli Moving MSetInterface.ml to mSetInterface.ml Moving MSetInterface.mli to mSetInterface.mli Moving MSetList.ml to mSetList.ml Moving MSetList.mli to mSetList.mli Moving MSetProperties.ml to mSetProperties.ml Moving MSetProperties.mli to mSetProperties.mli Moving MSetWeakList.ml to mSetWeakList.ml Moving MSetWeakList.mli to mSetWeakList.mli Moving Nat0.ml to nat0.ml Moving Nat0.mli to nat0.mli Moving Orders.ml to orders.ml Moving Orders.mli to orders.mli Moving OrdersFacts.ml to ordersFacts.ml Moving OrdersFacts.mli to ordersFacts.mli Moving OrdersLists.ml to ordersLists.ml Moving OrdersLists.mli to ordersLists.mli Moving OrdersTac.ml to ordersTac.ml Moving OrdersTac.mli to ordersTac.mli Moving PCUICAst.ml to pCUICAst.ml Moving PCUICAst.mli to pCUICAst.mli Moving PCUICAstUtils.ml to pCUICAstUtils.ml Moving PCUICAstUtils.mli to pCUICAstUtils.mli Moving PCUICChecker.ml to pCUICChecker.ml Moving PCUICChecker.mli to pCUICChecker.mli Moving PCUICCumulativity.ml to pCUICCumulativity.ml Moving PCUICCumulativity.mli to pCUICCumulativity.mli Moving PCUICEquality.ml to pCUICEquality.ml Moving PCUICEquality.mli to pCUICEquality.mli Moving PCUICLiftSubst.ml to pCUICLiftSubst.ml Moving PCUICLiftSubst.mli to pCUICLiftSubst.mli Moving PCUICNormal.ml to pCUICNormal.ml Moving PCUICNormal.mli to pCUICNormal.mli Moving PCUICPosition.ml to pCUICPosition.ml Moving PCUICPosition.mli to pCUICPosition.mli Moving PCUICPretty.ml to pCUICPretty.ml Moving PCUICPretty.mli to pCUICPretty.mli Moving PCUICReflect.ml to pCUICReflect.ml Moving PCUICReflect.mli to pCUICReflect.mli Moving PCUICSafeChecker.ml to pCUICSafeChecker.ml Moving PCUICSafeChecker.mli to pCUICSafeChecker.mli Moving PCUICSafeConversion.ml to pCUICSafeConversion.ml Moving PCUICSafeConversion.mli to pCUICSafeConversion.mli Moving PCUICSafeLemmata.ml to pCUICSafeLemmata.ml Moving PCUICSafeLemmata.mli to pCUICSafeLemmata.mli Moving PCUICSafeReduce.ml to pCUICSafeReduce.ml Moving PCUICSafeReduce.mli to pCUICSafeReduce.mli Moving PCUICTyping.ml to pCUICTyping.ml Moving PCUICTyping.mli to pCUICTyping.mli Moving PCUICUnivSubst.ml to pCUICUnivSubst.ml Moving PCUICUnivSubst.mli to pCUICUnivSubst.mli Moving PeanoNat.ml to peanoNat.ml Moving PeanoNat.mli to peanoNat.mli Moving SafeTemplateChecker.ml to safeTemplateChecker.ml Moving SafeTemplateChecker.mli to safeTemplateChecker.mli Moving Specif.ml to specif.ml Moving Specif.mli to specif.mli Moving String0.ml to string0.ml Moving String0.mli to string0.mli Moving TemplateToPCUIC.ml to templateToPCUIC.ml Moving TemplateToPCUIC.mli to templateToPCUIC.mli Moving Typing0.ml to typing0.ml Moving Typing0.mli to typing0.mli Moving UnivSubst0.ml to univSubst0.ml Moving UnivSubst0.mli to univSubst0.mli Moving Universes0.ml to universes0.ml Moving Universes0.mli to universes0.mli Moving config0.ml to config0.ml mv: 'config0.ml' and 'config0.ml' are the same file Moving config0.mli to config0.mli mv: 'config0.mli' and 'config0.mli' are the same file Moving g_metacoq_safechecker.ml to g_metacoq_safechecker.ml mv: 'g_metacoq_safechecker.ml' and 'g_metacoq_safechecker.ml' are the same file Moving g_metacoq_safechecker.mlg to g_metacoq_safechecker.mlg mv: 'g_metacoq_safechecker.mlg' and 'g_metacoq_safechecker.mlg' are the same file Moving metacoq_safechecker_plugin.mlpack to metacoq_safechecker_plugin.mlpack mv: 'metacoq_safechecker_plugin.mlpack' and 'metacoq_safechecker_plugin.mlpack' are the same file Moving monad_utils.ml to monad_utils.ml mv: 'monad_utils.ml' and 'monad_utils.ml' are the same file Moving monad_utils.mli to monad_utils.mli mv: 'monad_utils.mli' and 'monad_utils.mli' are the same file Moving ssrbool.ml to ssrbool.ml mv: 'ssrbool.ml' and 'ssrbool.ml' are the same file Moving ssrbool.mli to ssrbool.mli mv: 'ssrbool.mli' and 'ssrbool.mli' are the same file Moving uGraph0.ml to uGraph0.ml mv: 'uGraph0.ml' and 'uGraph0.ml' are the same file Moving uGraph0.mli to uGraph0.mli mv: 'uGraph0.mli' and 'uGraph0.mli' are the same file Moving utils.ml to utils.ml mv: 'utils.ml' and 'utils.ml' are the same file Moving utils.mli to utils.mli mv: 'utils.mli' and 'utils.mli' are the same file Moving wGraph.ml to wGraph.ml mv: 'wGraph.ml' and 'wGraph.ml' are the same file Moving wGraph.mli to wGraph.mli mv: 'wGraph.mli' and 'wGraph.mli' are the same file Removing: src/all_Forall.ml src/all_Forall.mli src/ascii.ml src/ascii.mli src/ast0.ml src/ast0.mli src/ast_denoter.ml src/ast_quoter.ml src/astUtils.ml src/astUtils.mli src/basicAst.ml src/basicAst.mli src/basics.ml src/basics.mli src/binInt.ml src/binInt.mli src/binNat.ml src/binNat.mli src/binNums.ml src/binNums.mli src/binPosDef.ml src/binPosDef.mli src/binPos.ml src/binPos.mli src/bool.ml src/bool.mli src/common0.ml src/common0.mli src/compare_dec.ml src/compare_dec.mli src/config0.ml src/config0.mli src/cRelationClasses.ml src/cRelationClasses.mli src/datatypes.ml src/datatypes.mli src/decimal.ml src/decimal.mli src/denoter.ml src/environment.ml src/environment.mli src/equalities.ml src/equalities.mli src/extractable.ml src/extractable.mli src/hexadecimal.ml src/hexadecimal.mli src/liftSubst.ml src/liftSubst.mli src/list0.ml src/list0.mli src/logic0.ml src/logic0.mli src/mCPrelude.mli src/mCPrelude.ml src/mCCompare.ml src/mCCompare.mli src/mCList.ml src/mCList.mli src/mCOption.ml src/mCOption.mli src/mCProd.ml src/mCProd.mli src/mCRelations.ml src/mCRelations.mli src/mCString.ml src/mCString.mli src/mSetDecide.ml src/mSetDecide.mli src/mSetFacts.ml src/mSetFacts.mli src/mSetInterface.ml src/mSetInterface.mli src/mSetList.ml src/mSetList.mli src/mSetProperties.ml src/mSetProperties.mli src/nat0.ml src/nat0.mli src/numeral.ml src/numeral.mli src/orderedType0.ml src/orderedType0.mli src/ordersFacts.ml src/ordersFacts.mli src/ordersLists.ml src/ordersLists.mli src/orders.ml src/orders.mli src/ordersTac.ml src/ordersTac.mli src/peanoNat.ml src/peanoNat.mli src/plugin_core.ml src/plugin_core.mli src/pretty.ml src/pretty.mli src/reification.ml src/quoter.ml src/run_extractable.ml src/run_extractable.mli src/specif.ml src/specif.mli src/string0.ml src/string0.mli src/tm_util.ml src/universes0.ml src/universes0.mli src/univSubst0.ml src/univSubst0.mli make[4]: Leaving directory '/builds/coq/coq/_build_ci/metacoq/safechecker' make -f Makefile.plugin make[4]: Entering directory '/builds/coq/coq/_build_ci/metacoq/safechecker' COQDEP VFILES CAMLDEP src/safeTemplateChecker.mli CAMLDEP src/pCUICSafeChecker.mli CAMLDEP src/pCUICSafeConversion.mli CAMLDEP src/pCUICSafeReduce.mli CAMLDEP src/pCUICPretty.mli CAMLDEP src/pCUICChecker.mli CAMLDEP src/templateToPCUIC.mli CAMLDEP src/pCUICSafeLemmata.mli CAMLDEP src/pCUICNormal.mli CAMLDEP src/pCUICCumulativity.mli CAMLDEP src/pCUICPosition.mli CAMLDEP src/pCUICUnivSubst.mli CAMLDEP src/pCUICTyping.mli CAMLDEP src/pCUICEquality.mli CAMLDEP src/pCUICReflect.mli CAMLDEP src/eqDecInstances.mli CAMLDEP src/pCUICLiftSubst.mli CAMLDEP src/pCUICAstUtils.mli CAMLDEP src/pCUICAst.mli CAMLDEP src/typing0.mli CAMLDEP src/wGraph.mli CAMLDEP src/uGraph0.mli CAMLDEP src/utils.mli CAMLDEP src/monad_utils.mli CAMLDEP src/ssrbool.mli CAMLDEP src/eqdepFacts.mli CAMLDEP src/mSetWeakList.mli CAMLDEP src/classes0.mli OCAMLLIBDEP src/metacoq_safechecker_plugin.mlpack CAMLDEP src/safeTemplateChecker.ml CAMLDEP src/pCUICSafeChecker.ml CAMLDEP src/pCUICSafeConversion.ml CAMLDEP src/pCUICSafeReduce.ml CAMLDEP src/pCUICPretty.ml CAMLDEP src/pCUICChecker.ml CAMLDEP src/templateToPCUIC.ml CAMLDEP src/pCUICSafeLemmata.ml CAMLDEP src/pCUICNormal.ml CAMLDEP src/pCUICPosition.ml CAMLDEP src/pCUICCumulativity.ml CAMLDEP src/pCUICUnivSubst.ml CAMLDEP src/pCUICTyping.ml CAMLDEP src/pCUICEquality.ml CAMLDEP src/pCUICReflect.ml CAMLDEP src/eqDecInstances.ml CAMLDEP src/pCUICLiftSubst.ml CAMLDEP src/pCUICAstUtils.ml CAMLDEP src/pCUICAst.ml CAMLDEP src/typing0.ml CAMLDEP src/wGraph.ml CAMLDEP src/uGraph0.ml CAMLDEP src/utils.ml CAMLDEP src/monad_utils.ml CAMLDEP src/ssrbool.ml CAMLDEP src/eqdepFacts.ml CAMLDEP src/classes0.ml CAMLDEP src/mSetWeakList.ml CAMLDEP src/g_metacoq_safechecker.ml CAMLC -c src/monad_utils.mli CAMLC -c src/mSetWeakList.mli src/monad_utils.cmi (real: 0.10, user: 0.03, sys: 0.01, mem: 19196 ko) CAMLC -c src/eqdepFacts.mli src/mSetWeakList.cmi (real: 0.10, user: 0.03, sys: 0.01, mem: 20008 ko) CAMLC -c src/utils.mli src/utils.cmi (real: src/eqdep0.04Fac,t s.ucsmie r(:re al:0.03 , sys: 0.01, mem: 19340 ko) 0.04, user: 0.03, sys: 0.01, mem: 19268 ko) CAMLC -c src/ssrbool.mli CAMLC -c src/typing0.mli src/typing0.cmi (real: 0.04, user: 0.02, sys: 0.01, mem: 20364 ko) CAMLC -c src/classes0.mli src/ssrbool.cmi (real: 0.05, user: 0.03, sys: 0.01, mem: 19332 ko) CAMLC -c src/pCUICAst.mli src/classes0.cmi (real: 0.05, user: 0.03, sys: 0.01, mem: 19328 ko) CAMLC -c src/pCUICNormal.mli src/pCUICAst.cmi (real: 0.05, user: 0.03, sys: 0.01, mem: 21440 ko) CAMLC -c src/pCUICCumulativity.mli src/pCUICNormal.cmi (real: 0.04, user: 0.03, sys: 0.01, mem: 19372 ko) CAMLOPT -c -for-pack Metacoq_safechecker_plugin src/monad_utils.ml src/pCUICCumulativity.cmi (real: 0.03, user: 0.02, sys: 0.01, mem: 19220 ko) CAMLOPT -c -for-pack Metacoq_safechecker_plugin src/mSetWeakList.ml src/monad_utils.cmx (real: 0.05, user: 0.03, sys: 0.01, mem: 21960 ko) CAMLOPT -c -for-pack Metacoq_safechecker_plugin src/eqdepFacts.ml src/mSetWeakList.cmx (real: 0.07, user: 0.05, sys: 0.01, mem: 25168 ko) CAMLOPT -c -for-pack Metacoq_safechecker_plugin src/utils.ml src/eqdepFacts.cmx (real: 0.04, user: 0.02, sys: 0.02, mem: 22016 ko) CAMLOPT -c -for-pack Metacoq_safechecker_plugin src/ssrbool.ml src/utils.cmx (real: 0.05, user: 0.03, sys: 0.01, mem: 22096 ko) CAMLC -c src/wGraph.mli src/ssrbool.cmx (real: 0.04, user: 0.02, sys: 0.01, mem: 22104 ko) CAMLOPT -c -for-pack Metacoq_safechecker_plugin src/typing0.ml src/wGraph.cmi (real: 0.05, user: 0.04, sys: 0.01, mem: 22812 ko) CAMLOPT -c -for-pack Metacoq_safechecker_plugin src/classes0.ml src/typing0.cmx (real: 0.07, user: 0.04, sys: 0.02, mem: 24164 ko) CAMLOPT -c -for-pack Metacoq_safechecker_plugin src/pCUICAst.ml src/classes0.cmx (real: 0.04, user: 0.03, sys: 0.01, mem: 22056 ko) CAMLC -c src/pCUICAstUtils.mli src/pCUICAstUtils.cmi (real: 0.04, user: 0.03, sys: 0.01, mem: 20292 ko) CAMLC -c src/pCUICUnivSubst.mli src/pCUICAst.cmx (real: 0.08, user: 0.05, sys: 0.02, mem: 26084 ko) CAMLC -c src/pCUICLiftSubst.mli src/pCUICUnivSubst.cmi (real: 0.04, user: 0.04, sys: 0.00, mem: 20452 ko) CAMLC -c src/eqDecInstances.mli src/pCUICLiftSubst.cmi (real: 0.04, user: 0.02, sys: 0.01, mem: 20432 ko) CAMLC -c src/pCUICReflect.mli src/eqDecInstances.cmi (real: 0.03, user: 0.02, sys: 0.01, mem: 19260 ko) CAMLOPT -c -for-pack Metacoq_safechecker_plugin src/pCUICNormal.ml src/pCUICReflect.cmi (real: 0.04, user: 0.02, sys: 0.01, mem: 20232 ko) CAMLC -c src/pCUICPosition.mli src/pCUICNormal.cmx (real: 0.04, user: 0.03, sys: 0.01, mem: 22004 ko) CAMLC -c src/templateToPCUIC.mli src/pCUICPosition.cmi (real: 0.04, user: 0.02, sys: 0.01, mem: 20460 ko) CAMLC -c src/pCUICSafeLemmata.mli src/pCUICSafeLemmata.cmi (real: 0.03, user: 0.02, sys: 0.01, mem: 19172 ko) CAMLOPT -c -for-pack Metacoq_safechecker_plugin src/pCUICCumulativity.ml src/templateToPCUIC.cmi (real: 0.05, user: 0.04, sys: 0.01, mem: 20348 ko) CAMLOPT -c -for-pack Metacoq_safechecker_plugin src/wGraph.ml src/pCUICCumulativity.cmx (real: 0.04, user: 0.03, sys: 0.01, mem: 22036 ko) CAMLC -c src/uGraph0.mli src/uGraph0.cmi (real: 0.07, user: 0.05, sys: 0.01, mem: 24772 ko) CAMLOPT -c -for-pack Metacoq_safechecker_plugin src/pCUICAstUtils.ml src/wGraph.cmx (real: 0.14, user: 0.12, sys: 0.02, mem: 31828 ko) CAMLOPT -c -for-pack Metacoq_safechecker_plugin src/pCUICUnivSubst.ml src/pCUICAstUtils.cmx (real: 0.08, user: 0.06, sys: 0.02, mem: 25948 ko) CAMLOPT -c -for-pack Metacoq_safechecker_plugin src/pCUICLiftSubst.ml src/pCUICUnivSubst.cmx (real: 0.06, user: 0.04, sys: 0.01, mem: 25096 ko) CAMLOPT -c -for-pack Metacoq_safechecker_plugin src/eqDecInstances.ml src/eqDecInstances.cmx (real: 0.05, user: 0.03, sys: 0.02, mem: 22024 ko) CAMLOPT -c -for-pack Metacoq_safechecker_plugin src/pCUICReflect.ml src/pCUICLiftSubst.cmx (real: 0.08, user: 0.06, sys: 0.02, mem: 26296 ko) CAMLC -c src/pCUICEquality.mli src/pCUICReflect.cmx (real: 0.06, user: 0.05, sys: 0.01, mem: 24360 ko) CAMLC -c src/pCUICTyping.mli src/pCUICEquality.cmi (real: 0.04, user: 0.03, sys: 0.01, mem: 20432 ko) CAMLOPT -c -for-pack Metacoq_safechecker_plugin src/pCUICPosition.ml src/pCUICTyping.cmi (real: 0.04, user: 0.03, sys: 0.01, mem: 21428 ko) CAMLOPT -c -for-pack Metacoq_safechecker_plugin src/templateToPCUIC.ml src/pCUICPosition.cmx (real: 0.09, user: 0.07, sys: 0.01, mem: 26028 ko) CAMLOPT -c -for-pack Metacoq_safechecker_plugin src/pCUICSafeLemmata.ml src/templateToPCUIC.cmx (real: 0.07, user: 0.06, sys: 0.01, mem: 25572 ko) CAMLC -c src/pCUICSafeReduce.mli src/pCUICSafeLemmata.cmx (real: 0.05, user: 0.03, sys: 0.01, mem: 22056 ko) CAMLOPT -c -for-pack Metacoq_safechecker_plugin src/uGraph0.ml src/pCUICSafeReduce.cmi (real: 0.04, user: 0.03, sys: 0.01, mem: 21588 ko) CAMLOPT -c -for-pack Metacoq_safechecker_plugin src/pCUICEquality.ml src/pCUICEquality.cmx (real: 0.07, user: 0.05, sys: 0.02, mem: 26416 ko) CAMLOPT -c -for-pack Metacoq_safechecker_plugin src/pCUICTyping.ml src/uGraph0.cmx (real: 0.13, user: 0.11, sys: 0.02, mem: 30828 ko) CAMLC -c src/pCUICChecker.mli src/pCUICChecker.cmi (real: 0.04, user: 0.03, sys: 0.01, mem: 21248 ko) CAMLC -c src/pCUICSafeConversion.mli src/pCUICTyping.cmx (real: 0.10, user: 0.08, sys: 0.02, mem: 27292 ko) CAMLOPT -c -for-pack Metacoq_safechecker_plugin src/pCUICChecker.ml src/pCUICSafeConversion.cmi (real: 0.05, user: 0.04, sys: 0.01, mem: 23348 ko) CAMLC -c src/pCUICPretty.mli src/pCUICChecker.cmx (real: 0.06, user: 0.04, sys: 0.02, mem: 25104 ko) CAMLOPT -c -for-pack Metacoq_safechecker_plugin src/pCUICSafeReduce.ml src/pCUICPretty.cmi (real: 0.04, user: 0.03, sys: 0.01, mem: 20340 ko) CAMLOPT -c -for-pack Metacoq_safechecker_plugin src/pCUICPretty.ml src/pCUICSafeReduce.cmx (real: 0.10, user: 0.07, sys: 0.02, mem: 27680 ko) CAMLC -c src/pCUICSafeChecker.mli src/pCUICPretty.cmx (real: 0.11, user: 0.09, sys: 0.02, mem: 28948 ko) CAMLOPT -c -for-pack Metacoq_safechecker_plugin src/pCUICSafeConversion.ml src/pCUICSafeChecker.cmi (real: 0.06, user: 0.06, sys: 0.00, mem: 24128 ko) CAMLC -c src/safeTemplateChecker.mli src/safeTemplateChecker.cmi (real: 0.05, user: 0.03, sys: 0.01, mem: 21632 ko) src/pCUICSafeConversion.cmx (real: 0.27, user: 0.24, sys: 0.03, mem: 43304 ko) CAMLOPT -c -for-pack Metacoq_safechecker_plugin src/pCUICSafeChecker.ml src/pCUICSafeChecker.cmx (real: 0.34, user: 0.29, sys: 0.04, mem: 43492 ko) CAMLOPT -c -for-pack Metacoq_safechecker_plugin src/safeTemplateChecker.ml src/safeTemplateChecker.cmx (real: 0.07, user: 0.05, sys: 0.01, mem: 27148 ko) CAMLOPT -c -for-pack Metacoq_safechecker_plugin src/g_metacoq_safechecker.ml src/g_metacoq_safechecker.cmx (real: 0.11, user: 0.09, sys: 0.02, mem: 35368 ko) CAMLOPT -pack -o src/metacoq_safechecker_plugin.cmx src/metacoq_safechecker_plugin.cmx (real: 0.10, user: 0.06, sys: 0.03, mem: 30436 ko) CAMLOPT -a -o src/metacoq_safechecker_plugin.cmxa src/metacoq_safechecker_plugin.cmxa (real: 0.05, user: 0.00, sys: 0.01, mem: 13624 ko) CAMLOPT -shared -o src/metacoq_safechecker_plugin.cmxs src/metacoq_safechecker_plugin.cmxs (real: 0.14, user: 0.11, sys: 0.03, mem: 20224 ko) COQC theories/Loader.v theories/Loader.vo (real: 0.09, user: 0.05, sys: 0.03, mem: 63536 ko) make[4]: Leaving directory '/builds/coq/coq/_build_ci/metacoq/safechecker' make[3]: Leaving directory '/builds/coq/coq/_build_ci/metacoq/safechecker' make -C erasure make[3]: Entering directory '/builds/coq/coq/_build_ci/metacoq/erasure' cat metacoq-config > _CoqProject cat _CoqProject.in >> _CoqProject coq_makefile -f _CoqProject -o Makefile.erasure Warning: ../template-coq/theories (used in -R or -Q) is not a subdirectory of the current directory make -f Makefile.erasure make[4]: Entering directory '/builds/coq/coq/_build_ci/metacoq/erasure' COQDEP VFILES COQC theories/EAst.v theories/EAst.vo (real: 0.97, user: 0.72, sys: 0.24, mem: 477800 ko) COQC theories/EAstUtils.v COQC theories/EInduction.v theories/EInduction.vo (real: 0.97, user: 0.71, sys: 0.25, mem: 479012 ko) COQC theories/Extract.v theories/EAstUtils.vo (real: 1.36, user: 1.10, sys: 0.26, mem: 487520 ko) COQC theories/ELiftSubst.v theories/Extract.vo (real: 1.89, user: 1.57, sys: 0.32, mem: 617808 ko) COQC theories/EArities.v theories/EArities.vo (real: 6.12, user: 5.66, sys: 0.42, mem: 643396 ko) theories/ELiftSubst.vo (real: 10.89, user: 10.08, sys: 0.75, mem: 521520 ko) COQC theories/ETyping.v COQC theories/ECSubst.v theories/ETyping.vo (real: 1.01, user: 0.73, sys: 0.27, mem: 487644 ko) COQC theories/EPretty.v theories/ECSubst.vo (real: 1.31, user: 1.05, sys: 0.25, mem: 512080 ko) COQC theories/EWndEval.v theories/EPretty.vo (real: 1.02, user: 0.77, sys: 0.24, mem: 488076 ko) COQC theories/EWcbvEval.v theories/EWndEval.vo (real: 0.97, user: 0.70, sys: 0.26, mem: 485084 ko) theories/EWcbvEval.vo (real: 4.15, user: 3.85, sys: 0.28, mem: 520080 ko) COQC theories/EAll.v COQC theories/Prelim.v theories/EAll.vo (real: 1.76, user: 1.42, sys: 0.32, mem: 619396 ko) theories/Prelim.vo (real: 3.82, user: 3.39, sys: 0.40, mem: 741428 ko) COQC theories/ESubstitution.v COQC theories/EInversion.v theories/EInversion.vo (real: 3.19, user: 2.67, sys: 0.50, mem: 729072 ko) theories/ESubstitution.vo (real: 14.12, user: 13.39, sys: 0.67, mem: 794032 ko) COQC theories/ErasureCorrectness.v Axioms: todounivs : forall A : Type, A todoeta : forall A : Type, A todo : string -> forall A : Type, A ind_guard : mutual_inductive_body -> bool functional_extensionality_dep : forall (A : Type) (B : A -> Type) (f g : forall x : A, B x), (forall x : A, f x = g x) -> f = g fix_guard_subst_instance : forall (mfix : mfixpoint term) (u : Instance.t), fix_guard mfix -> fix_guard (map (map_def (subst_instance_constr u) (subst_instance_constr u)) mfix) fix_guard_subst : forall (mfix : list (def term)) (s : list term) (k : nat), let k' := #|mfix| + k in let mfix' := map (map_def (PCUICLiftSubst.subst s k) (PCUICLiftSubst.subst s k')) mfix in fix_guard mfix -> fix_guard mfix' fix_guard_red1 : forall (Σ : global_env) (Γ : context) (mfix mfix' : mfixpoint term) (idx : nat), fix_guard mfix -> red1 Σ Γ (tFix mfix idx) (tFix mfix' idx) -> fix_guard mfix' fix_guard_lift : forall (mfix : list (def term)) (n k : nat), let k' := #|mfix| + k in let mfix' := map (map_def (PCUICLiftSubst.lift n k) (PCUICLiftSubst.lift n k')) mfix in fix_guard mfix -> fix_guard mfix' fix_guard_eq_term : forall (mfix mfix' : mfixpoint term) (idx : nat), fix_guard mfix -> PCUICEquality.upto_names (tFix mfix idx) (tFix mfix' idx) -> fix_guard mfix' fix_guard : mfixpoint term -> bool erases_closed : forall (Σ : global_env_ext) (Γ : list context_decl) (a : term) (e : E.term), PCUICLiftSubst.closedn #|Γ| a -> Σ;;; Γ |- a ⇝ℇ e -> closedn #|Γ| e cofix_guard_subst_instance : forall (mfix : mfixpoint term) (u : Instance.t), cofix_guard mfix -> cofix_guard (map (map_def (subst_instance_constr u) (subst_instance_constr u)) mfix) cofix_guard_subst : forall (mfix : list (def term)) (s : list term) (k : nat), let k' := #|mfix| + k in let mfix' := map (map_def (PCUICLiftSubst.subst s k) (PCUICLiftSubst.subst s k')) mfix in cofix_guard mfix -> cofix_guard mfix' cofix_guard_red1 : forall (Σ : global_env) (Γ : context) (mfix mfix' : mfixpoint term) (idx : nat), cofix_guard mfix -> red1 Σ Γ (tCoFix mfix idx) (tCoFix mfix' idx) -> cofix_guard mfix' cofix_guard_lift : forall (mfix : list (def term)) (n k : nat), let k' := #|mfix| + k in let mfix' := map (map_def (PCUICLiftSubst.lift n k) (PCUICLiftSubst.lift n k')) mfix in cofix_guard mfix -> cofix_guard mfix' cofix_guard_eq_term : forall (mfix mfix' : mfixpoint term) (idx : nat), cofix_guard mfix -> PCUICEquality.upto_names (tCoFix mfix idx) (tCoFix mfix' idx) -> cofix_guard mfix' cofix_guard : mfixpoint term -> bool theories/ErasureCorrectness.vo (real: 58.09, user: 56.17, sys: 1.60, mem: 1113548 ko) COQC theories/ErasureFunction.v COQC theories/SafeErasureFunction.v theories/SafeErasureFunction.vo (real: 24.59, user: 23.34, sys: 1.11, mem: 854428 ko) Axioms: todounivs : forall A : Type, A todoeta : forall A : Type, A todo : string -> forall A : Type, A proof_irrelevance : forall (P : Prop) (p1 p2 : P), p1 = p2 normalisation' : forall (cf : checker_flags) (Σ : global_env_ext) (Γ : context) (t : term), wf Σ -> wellformed Σ Γ t -> Acc (cored Σ.1 Γ) t ind_guard : mutual_inductive_body -> bool functional_extensionality_dep : forall (A : Type) (B : A -> Type) (f g : forall x : A, B x), (forall x : A, f x = g x) -> f = g PCUICUnivSubstitution.fix_guard_subst_instance : forall (mfix : mfixpoint term) (u : Instance.t), fix_guard mfix -> fix_guard (map (map_def (PCUICUnivSubst.subst_instance_constr u) (PCUICUnivSubst.subst_instance_constr u)) mfix) fix_guard_subst : forall (mfix : list (def term)) (s : list term) (k : nat), let k' := (#|mfix| + k)%nat in let mfix' := map (map_def (subst s k) (subst s k')) mfix in fix_guard mfix -> fix_guard mfix' fix_guard_red1 : forall (Σ : global_env) (Γ : context) (mfix mfix' : mfixpoint term) (idx : nat), fix_guard mfix -> red1 Σ Γ (tFix mfix idx) (tFix mfix' idx) -> fix_guard mfix' fix_guard_lift : forall (mfix : list (def term)) (n k : nat), let k' := (#|mfix| + k)%nat in let mfix' := map (map_def (lift n k) (lift n k')) mfix in fix_guard mfix -> fix_guard mfix' fix_guard_eq_term : forall (mfix mfix' : mfixpoint term) (idx : nat), fix_guard mfix -> PCUICEquality.upto_names (tFix mfix idx) (tFix mfix' idx) -> fix_guard mfix' fix_guard : mfixpoint term -> bool PCUICUnivSubstitution.cofix_guard_subst_instance : forall (mfix : mfixpoint term) (u : Instance.t), cofix_guard mfix -> cofix_guard (map (map_def (PCUICUnivSubst.subst_instance_constr u) (PCUICUnivSubst.subst_instance_constr u)) mfix) cofix_guard_subst : forall (mfix : list (def term)) (s : list term) (k : nat), let k' := (#|mfix| + k)%nat in let mfix' := map (map_def (subst s k) (subst s k')) mfix in cofix_guard mfix -> cofix_guard mfix' cofix_guard_red1 : forall (Σ : global_env) (Γ : context) (mfix mfix' : mfixpoint term) (idx : nat), cofix_guard mfix -> red1 Σ Γ (tCoFix mfix idx) (tCoFix mfix' idx) -> cofix_guard mfix' cofix_guard_lift : forall (mfix : list (def term)) (n k : nat), let k' := (#|mfix| + k)%nat in let mfix' := map (map_def (lift n k) (lift n k')) mfix in cofix_guard mfix -> cofix_guard mfix' cofix_guard_eq_term : forall (mfix mfix' : mfixpoint term) (idx : nat), cofix_guard mfix -> PCUICEquality.upto_names (tCoFix mfix idx) (tCoFix mfix' idx) -> cofix_guard mfix' cofix_guard : mfixpoint term -> bool theories/ErasureFunction.vo (real: 40.61, user: 39.21, sys: 1.22, mem: 1012876 ko) COQC theories/SafeTemplateErasure.v theories/SafeTemplateErasure.vo (real: 4.47, user: 3.99, sys: 0.45, mem: 806128 ko) COQC theories/Extraction.v theories/Extraction.vo (real: 6.38, user: 5.74, sys: 0.59, mem: 872556 ko) echo "Done extracting the erasure, moving extraction files!" Done extracting the erasure, moving extraction files! ./clean_extraction.sh Cleaning result of extraction Moving All_Forall.ml to all_Forall.ml Moving All_Forall.mli to all_Forall.mli Moving Ascii.ml to ascii.ml Moving Ascii.mli to ascii.mli Moving Ast0.ml to ast0.ml Moving Ast0.mli to ast0.mli Moving AstUtils.ml to astUtils.ml Moving AstUtils.mli to astUtils.mli Moving BasicAst.ml to basicAst.ml Moving BasicAst.mli to basicAst.mli Moving Basics.ml to basics.ml Moving Basics.mli to basics.mli Moving BinInt.ml to binInt.ml Moving BinInt.mli to binInt.mli Moving BinNat.ml to binNat.ml Moving BinNat.mli to binNat.mli Moving BinNums.ml to binNums.ml Moving BinNums.mli to binNums.mli Moving BinPos.ml to binPos.ml Moving BinPos.mli to binPos.mli Moving Bool.ml to bool.ml Moving Bool.mli to bool.mli Moving Byte.ml to byte.ml Moving Byte.mli to byte.mli Moving Classes0.ml to classes0.ml Moving Classes0.mli to classes0.mli Moving Compare_dec.ml to compare_dec.ml Moving Compare_dec.mli to compare_dec.mli Moving Datatypes.ml to datatypes.ml Moving Datatypes.mli to datatypes.mli Moving EAst.ml to eAst.ml Moving EAst.mli to eAst.mli Moving EAstUtils.ml to eAstUtils.ml Moving EAstUtils.mli to eAstUtils.mli Moving ELiftSubst.ml to eLiftSubst.ml Moving ELiftSubst.mli to eLiftSubst.mli Moving EPretty.ml to ePretty.ml Moving EPretty.mli to ePretty.mli Moving ETyping.ml to eTyping.ml Moving ETyping.mli to eTyping.mli Moving Environment.ml to environment.ml Moving Environment.mli to environment.mli Moving EqDecInstances.ml to eqDecInstances.ml Moving EqDecInstances.mli to eqDecInstances.mli Moving EqdepFacts.ml to eqdepFacts.ml Moving EqdepFacts.mli to eqdepFacts.mli Moving Equalities.ml to equalities.ml Moving Equalities.mli to equalities.mli Moving ErasureFunction.ml to erasureFunction.ml Moving ErasureFunction.mli to erasureFunction.mli Moving Extract.ml to extract.ml Moving Extract.mli to extract.mli Moving Init.ml to init.ml Moving Init.mli to init.mli Moving LiftSubst.ml to liftSubst.ml Moving LiftSubst.mli to liftSubst.mli Moving List0.ml to list0.ml Moving List0.mli to list0.mli Moving MCCompare.ml to mCCompare.ml Moving MCCompare.mli to mCCompare.mli Moving MCList.ml to mCList.ml Moving MCList.mli to mCList.mli Moving MCOption.ml to mCOption.ml Moving MCOption.mli to mCOption.mli Moving MCProd.ml to mCProd.ml Moving MCProd.mli to mCProd.mli Moving MCString.ml to mCString.ml Moving MCString.mli to mCString.mli Moving MSetDecide.ml to mSetDecide.ml Moving MSetDecide.mli to mSetDecide.mli Moving MSetFacts.ml to mSetFacts.ml Moving MSetFacts.mli to mSetFacts.mli Moving MSetInterface.ml to mSetInterface.ml Moving MSetInterface.mli to mSetInterface.mli Moving MSetList.ml to mSetList.ml Moving MSetList.mli to mSetList.mli Moving MSetProperties.ml to mSetProperties.ml Moving MSetProperties.mli to mSetProperties.mli Moving MSetWeakList.ml to mSetWeakList.ml Moving MSetWeakList.mli to mSetWeakList.mli Moving Nat0.ml to nat0.ml Moving Nat0.mli to nat0.mli Moving Orders.ml to orders.ml Moving Orders.mli to orders.mli Moving OrdersFacts.ml to ordersFacts.ml Moving OrdersFacts.mli to ordersFacts.mli Moving OrdersLists.ml to ordersLists.ml Moving OrdersLists.mli to ordersLists.mli Moving OrdersTac.ml to ordersTac.ml Moving OrdersTac.mli to ordersTac.mli Moving PCUICAst.ml to pCUICAst.ml Moving PCUICAst.mli to pCUICAst.mli Moving PCUICAstUtils.ml to pCUICAstUtils.ml Moving PCUICAstUtils.mli to pCUICAstUtils.mli Moving PCUICChecker.ml to pCUICChecker.ml Moving PCUICChecker.mli to pCUICChecker.mli Moving PCUICCumulativity.ml to pCUICCumulativity.ml Moving PCUICCumulativity.mli to pCUICCumulativity.mli Moving PCUICEquality.ml to pCUICEquality.ml Moving PCUICEquality.mli to pCUICEquality.mli Moving PCUICLiftSubst.ml to pCUICLiftSubst.ml Moving PCUICLiftSubst.mli to pCUICLiftSubst.mli Moving PCUICNormal.ml to pCUICNormal.ml Moving PCUICNormal.mli to pCUICNormal.mli Moving PCUICPosition.ml to pCUICPosition.ml Moving PCUICPosition.mli to pCUICPosition.mli Moving PCUICPretty.ml to pCUICPretty.ml Moving PCUICPretty.mli to pCUICPretty.mli Moving PCUICReflect.ml to pCUICReflect.ml Moving PCUICReflect.mli to pCUICReflect.mli Moving PCUICSafeChecker.ml to pCUICSafeChecker.ml Moving PCUICSafeChecker.mli to pCUICSafeChecker.mli Moving PCUICSafeConversion.ml to pCUICSafeConversion.ml Moving PCUICSafeConversion.mli to pCUICSafeConversion.mli Moving PCUICSafeLemmata.ml to pCUICSafeLemmata.ml Moving PCUICSafeLemmata.mli to pCUICSafeLemmata.mli Moving PCUICSafeReduce.ml to pCUICSafeReduce.ml Moving PCUICSafeReduce.mli to pCUICSafeReduce.mli Moving PCUICSafeRetyping.ml to pCUICSafeRetyping.ml Moving PCUICSafeRetyping.mli to pCUICSafeRetyping.mli Moving PCUICTyping.ml to pCUICTyping.ml Moving PCUICTyping.mli to pCUICTyping.mli Moving PCUICUnivSubst.ml to pCUICUnivSubst.ml Moving PCUICUnivSubst.mli to pCUICUnivSubst.mli Moving PeanoNat.ml to peanoNat.ml Moving PeanoNat.mli to peanoNat.mli Moving Pretty.ml to pretty.ml Moving Pretty.mli to pretty.mli Moving SafeErasureFunction.ml to safeErasureFunction.ml Moving SafeErasureFunction.mli to safeErasureFunction.mli Moving SafeTemplateChecker.ml to safeTemplateChecker.ml Moving SafeTemplateChecker.mli to safeTemplateChecker.mli Moving SafeTemplateErasure.ml to safeTemplateErasure.ml Moving SafeTemplateErasure.mli to safeTemplateErasure.mli Moving Specif.ml to specif.ml Moving Specif.mli to specif.mli Moving String0.ml to string0.ml Moving String0.mli to string0.mli Moving TemplateToPCUIC.ml to templateToPCUIC.ml Moving TemplateToPCUIC.mli to templateToPCUIC.mli Moving Typing0.ml to typing0.ml Moving Typing0.mli to typing0.mli Moving UnivSubst0.ml to univSubst0.ml Moving UnivSubst0.mli to univSubst0.mli Moving Universes0.ml to universes0.ml Moving Universes0.mli to universes0.mli Moving config0.ml to config0.ml mv: 'config0.ml' and 'config0.ml' are the same file Moving config0.mli to config0.mli mv: 'config0.mli' and 'config0.mli' are the same file Moving g_metacoq_erasure.ml to g_metacoq_erasure.ml mv: 'g_metacoq_erasure.ml' and 'g_metacoq_erasure.ml' are the same file Moving g_metacoq_erasure.mlg to g_metacoq_erasure.mlg mv: 'g_metacoq_erasure.mlg' and 'g_metacoq_erasure.mlg' are the same file Moving metacoq_erasure_plugin.mlpack to metacoq_erasure_plugin.mlpack mv: 'metacoq_erasure_plugin.mlpack' and 'metacoq_erasure_plugin.mlpack' are the same file Moving monad_utils.ml to monad_utils.ml mv: 'monad_utils.ml' and 'monad_utils.ml' are the same file Moving monad_utils.mli to monad_utils.mli mv: 'monad_utils.mli' and 'monad_utils.mli' are the same file Moving ssrbool.ml to ssrbool.ml mv: 'ssrbool.ml' and 'ssrbool.ml' are the same file Moving ssrbool.mli to ssrbool.mli mv: 'ssrbool.mli' and 'ssrbool.mli' are the same file Moving uGraph0.ml to uGraph0.ml mv: 'uGraph0.ml' and 'uGraph0.ml' are the same file Moving uGraph0.mli to uGraph0.mli mv: 'uGraph0.mli' and 'uGraph0.mli' are the same file Moving utils.ml to utils.ml mv: 'utils.ml' and 'utils.ml' are the same file Moving utils.mli to utils.mli mv: 'utils.mli' and 'utils.mli' are the same file Moving wGraph.ml to wGraph.ml mv: 'wGraph.ml' and 'wGraph.ml' are the same file Moving wGraph.mli to wGraph.mli mv: 'wGraph.mli' and 'wGraph.mli' are the same file Removing: src/all_Forall.ml src/all_Forall.mli src/ascii.ml src/ascii.mli src/ast0.ml src/ast0.mli src/ast_denoter.ml src/ast_quoter.ml src/astUtils.ml src/astUtils.mli src/basicAst.ml src/basicAst.mli src/basics.ml src/basics.mli src/binInt.ml src/binInt.mli src/binNat.ml src/binNat.mli src/binNums.ml src/binNums.mli src/binPosDef.ml src/binPosDef.mli src/binPos.ml src/binPos.mli src/bool.ml src/bool.mli src/common0.ml src/common0.mli src/compare_dec.ml src/compare_dec.mli src/config0.ml src/config0.mli src/cRelationClasses.ml src/cRelationClasses.mli src/datatypes.ml src/datatypes.mli src/decimal.ml src/decimal.mli src/denoter.ml src/environment.ml src/environment.mli src/equalities.ml src/equalities.mli src/extractable.ml src/extractable.mli src/hexadecimal.ml src/hexadecimal.mli src/liftSubst.ml src/liftSubst.mli src/list0.ml src/list0.mli src/logic0.ml src/logic0.mli src/mCPrelude.mli src/mCPrelude.ml src/mCCompare.ml src/mCCompare.mli src/mCList.ml src/mCList.mli src/mCOption.ml src/mCOption.mli src/mCProd.ml src/mCProd.mli src/mCRelations.ml src/mCRelations.mli src/mCString.ml src/mCString.mli src/mSetDecide.ml src/mSetDecide.mli src/mSetFacts.ml src/mSetFacts.mli src/mSetInterface.ml src/mSetInterface.mli src/mSetList.ml src/mSetList.mli src/mSetProperties.ml src/mSetProperties.mli src/nat0.ml src/nat0.mli src/numeral.ml src/numeral.mli src/orderedType0.ml src/orderedType0.mli src/ordersFacts.ml src/ordersFacts.mli src/ordersLists.ml src/ordersLists.mli src/orders.ml src/orders.mli src/ordersTac.ml src/ordersTac.mli src/peanoNat.ml src/peanoNat.mli src/plugin_core.ml src/plugin_core.mli src/pretty.ml src/pretty.mli src/reification.ml src/quoter.ml src/run_extractable.ml src/run_extractable.mli src/specif.ml src/specif.mli src/string0.ml src/string0.mli src/tm_util.ml src/universes0.ml src/universes0.mli src/univSubst0.ml src/univSubst0.mli make[4]: Leaving directory '/builds/coq/coq/_build_ci/metacoq/erasure' ./clean_extraction.sh Cleaning result of extraction Moving byte.ml to byte.ml mv: 'byte.ml' and 'byte.ml' are the same file Moving byte.mli to byte.mli mv: 'byte.mli' and 'byte.mli' are the same file Moving classes0.ml to classes0.ml mv: 'classes0.ml' and 'classes0.ml' are the same file Moving classes0.mli to classes0.mli mv: 'classes0.mli' and 'classes0.mli' are the same file Moving eAst.ml to eAst.ml mv: 'eAst.ml' and 'eAst.ml' are the same file Moving eAst.mli to eAst.mli mv: 'eAst.mli' and 'eAst.mli' are the same file Moving eAstUtils.ml to eAstUtils.ml mv: 'eAstUtils.ml' and 'eAstUtils.ml' are the same file Moving eAstUtils.mli to eAstUtils.mli mv: 'eAstUtils.mli' and 'eAstUtils.mli' are the same file Moving eLiftSubst.ml to eLiftSubst.ml mv: 'eLiftSubst.ml' and 'eLiftSubst.ml' are the same file Moving eLiftSubst.mli to eLiftSubst.mli mv: 'eLiftSubst.mli' and 'eLiftSubst.mli' are the same file Moving ePretty.ml to ePretty.ml mv: 'ePretty.ml' and 'ePretty.ml' are the same file Moving ePretty.mli to ePretty.mli mv: 'ePretty.mli' and 'ePretty.mli' are the same file Moving eTyping.ml to eTyping.ml mv: 'eTyping.ml' and 'eTyping.ml' are the same file Moving eTyping.mli to eTyping.mli mv: 'eTyping.mli' and 'eTyping.mli' are the same file Moving eqDecInstances.ml to eqDecInstances.ml mv: 'eqDecInstances.ml' and 'eqDecInstances.ml' are the same file Moving eqDecInstances.mli to eqDecInstances.mli mv: 'eqDecInstances.mli' and 'eqDecInstances.mli' are the same file Moving eqdepFacts.ml to eqdepFacts.ml mv: 'eqdepFacts.ml' and 'eqdepFacts.ml' are the same file Moving eqdepFacts.mli to eqdepFacts.mli mv: 'eqdepFacts.mli' and 'eqdepFacts.mli' are the same file Moving erasureFunction.ml to erasureFunction.ml mv: 'erasureFunction.ml' and 'erasureFunction.ml' are the same file Moving erasureFunction.mli to erasureFunction.mli mv: 'erasureFunction.mli' and 'erasureFunction.mli' are the same file Moving extract.ml to extract.ml mv: 'extract.ml' and 'extract.ml' are the same file Moving extract.mli to extract.mli mv: 'extract.mli' and 'extract.mli' are the same file Moving g_metacoq_erasure.ml to g_metacoq_erasure.ml mv: 'g_metacoq_erasure.ml' and 'g_metacoq_erasure.ml' are the same file Moving g_metacoq_erasure.mlg to g_metacoq_erasure.mlg mv: 'g_metacoq_erasure.mlg' and 'g_metacoq_erasure.mlg' are the same file Moving init.ml to init.ml mv: 'init.ml' and 'init.ml' are the same file Moving init.mli to init.mli mv: 'init.mli' and 'init.mli' are the same file Moving mSetWeakList.ml to mSetWeakList.ml mv: 'mSetWeakList.ml' and 'mSetWeakList.ml' are the same file Moving mSetWeakList.mli to mSetWeakList.mli mv: 'mSetWeakList.mli' and 'mSetWeakList.mli' are the same file Moving metacoq_erasure_plugin.mlpack to metacoq_erasure_plugin.mlpack mv: 'metacoq_erasure_plugin.mlpack' and 'metacoq_erasure_plugin.mlpack' are the same file Moving monad_utils.ml to monad_utils.ml mv: 'monad_utils.ml' and 'monad_utils.ml' are the same file Moving monad_utils.mli to monad_utils.mli mv: 'monad_utils.mli' and 'monad_utils.mli' are the same file Moving pCUICAst.ml to pCUICAst.ml mv: 'pCUICAst.ml' and 'pCUICAst.ml' are the same file Moving pCUICAst.mli to pCUICAst.mli mv: 'pCUICAst.mli' and 'pCUICAst.mli' are the same file Moving pCUICAstUtils.ml to pCUICAstUtils.ml mv: 'pCUICAstUtils.ml' and 'pCUICAstUtils.ml' are the same file Moving pCUICAstUtils.mli to pCUICAstUtils.mli mv: 'pCUICAstUtils.mli' and 'pCUICAstUtils.mli' are the same file Moving pCUICChecker.ml to pCUICChecker.ml mv: 'pCUICChecker.ml' and 'pCUICChecker.ml' are the same file Moving pCUICChecker.mli to pCUICChecker.mli mv: 'pCUICChecker.mli' and 'pCUICChecker.mli' are the same file Moving pCUICCumulativity.ml to pCUICCumulativity.ml mv: 'pCUICCumulativity.ml' and 'pCUICCumulativity.ml' are the same file Moving pCUICCumulativity.mli to pCUICCumulativity.mli mv: 'pCUICCumulativity.mli' and 'pCUICCumulativity.mli' are the same file Moving pCUICEquality.ml to pCUICEquality.ml mv: 'pCUICEquality.ml' and 'pCUICEquality.ml' are the same file Moving pCUICEquality.mli to pCUICEquality.mli mv: 'pCUICEquality.mli' and 'pCUICEquality.mli' are the same file Moving pCUICLiftSubst.ml to pCUICLiftSubst.ml mv: 'pCUICLiftSubst.ml' and 'pCUICLiftSubst.ml' are the same file Moving pCUICLiftSubst.mli to pCUICLiftSubst.mli mv: 'pCUICLiftSubst.mli' and 'pCUICLiftSubst.mli' are the same file Moving pCUICNormal.ml to pCUICNormal.ml mv: 'pCUICNormal.ml' and 'pCUICNormal.ml' are the same file Moving pCUICNormal.mli to pCUICNormal.mli mv: 'pCUICNormal.mli' and 'pCUICNormal.mli' are the same file Moving pCUICPosition.ml to pCUICPosition.ml mv: 'pCUICPosition.ml' and 'pCUICPosition.ml' are the same file Moving pCUICPosition.mli to pCUICPosition.mli mv: 'pCUICPosition.mli' and 'pCUICPosition.mli' are the same file Moving pCUICPretty.ml to pCUICPretty.ml mv: 'pCUICPretty.ml' and 'pCUICPretty.ml' are the same file Moving pCUICPretty.mli to pCUICPretty.mli mv: 'pCUICPretty.mli' and 'pCUICPretty.mli' are the same file Moving pCUICReflect.ml to pCUICReflect.ml mv: 'pCUICReflect.ml' and 'pCUICReflect.ml' are the same file Moving pCUICReflect.mli to pCUICReflect.mli mv: 'pCUICReflect.mli' and 'pCUICReflect.mli' are the same file Moving pCUICSafeChecker.ml to pCUICSafeChecker.ml mv: 'pCUICSafeChecker.ml' and 'pCUICSafeChecker.ml' are the same file Moving pCUICSafeChecker.mli to pCUICSafeChecker.mli mv: 'pCUICSafeChecker.mli' and 'pCUICSafeChecker.mli' are the same file Moving pCUICSafeConversion.ml to pCUICSafeConversion.ml mv: 'pCUICSafeConversion.ml' and 'pCUICSafeConversion.ml' are the same file Moving pCUICSafeConversion.mli to pCUICSafeConversion.mli mv: 'pCUICSafeConversion.mli' and 'pCUICSafeConversion.mli' are the same file Moving pCUICSafeLemmata.ml to pCUICSafeLemmata.ml mv: 'pCUICSafeLemmata.ml' and 'pCUICSafeLemmata.ml' are the same file Moving pCUICSafeLemmata.mli to pCUICSafeLemmata.mli mv: 'pCUICSafeLemmata.mli' and 'pCUICSafeLemmata.mli' are the same file Moving pCUICSafeReduce.ml to pCUICSafeReduce.ml mv: 'pCUICSafeReduce.ml' and 'pCUICSafeReduce.ml' are the same file Moving pCUICSafeReduce.mli to pCUICSafeReduce.mli mv: 'pCUICSafeReduce.mli' and 'pCUICSafeReduce.mli' are the same file Moving pCUICSafeRetyping.ml to pCUICSafeRetyping.ml mv: 'pCUICSafeRetyping.ml' and 'pCUICSafeRetyping.ml' are the same file Moving pCUICSafeRetyping.mli to pCUICSafeRetyping.mli mv: 'pCUICSafeRetyping.mli' and 'pCUICSafeRetyping.mli' are the same file Moving pCUICTyping.ml to pCUICTyping.ml mv: 'pCUICTyping.ml' and 'pCUICTyping.ml' are the same file Moving pCUICTyping.mli to pCUICTyping.mli mv: 'pCUICTyping.mli' and 'pCUICTyping.mli' are the same file Moving pCUICUnivSubst.ml to pCUICUnivSubst.ml mv: 'pCUICUnivSubst.ml' and 'pCUICUnivSubst.ml' are the same file Moving pCUICUnivSubst.mli to pCUICUnivSubst.mli mv: 'pCUICUnivSubst.mli' and 'pCUICUnivSubst.mli' are the same file Moving safeErasureFunction.ml to safeErasureFunction.ml mv: 'safeErasureFunction.ml' and 'safeErasureFunction.ml' are the same file Moving safeErasureFunction.mli to safeErasureFunction.mli mv: 'safeErasureFunction.mli' and 'safeErasureFunction.mli' are the same file Moving safeTemplateChecker.ml to safeTemplateChecker.ml mv: 'safeTemplateChecker.ml' and 'safeTemplateChecker.ml' are the same file Moving safeTemplateChecker.mli to safeTemplateChecker.mli mv: 'safeTemplateChecker.mli' and 'safeTemplateChecker.mli' are the same file Moving safeTemplateErasure.ml to safeTemplateErasure.ml mv: 'safeTemplateErasure.ml' and 'safeTemplateErasure.ml' are the same file Moving safeTemplateErasure.mli to safeTemplateErasure.mli mv: 'safeTemplateErasure.mli' and 'safeTemplateErasure.mli' are the same file Moving ssrbool.ml to ssrbool.ml mv: 'ssrbool.ml' and 'ssrbool.ml' are the same file Moving ssrbool.mli to ssrbool.mli mv: 'ssrbool.mli' and 'ssrbool.mli' are the same file Moving templateToPCUIC.ml to templateToPCUIC.ml mv: 'templateToPCUIC.ml' and 'templateToPCUIC.ml' are the same file Moving templateToPCUIC.mli to templateToPCUIC.mli mv: 'templateToPCUIC.mli' and 'templateToPCUIC.mli' are the same file Moving typing0.ml to typing0.ml mv: 'typing0.ml' and 'typing0.ml' are the same file Moving typing0.mli to typing0.mli mv: 'typing0.mli' and 'typing0.mli' are the same file Moving uGraph0.ml to uGraph0.ml mv: 'uGraph0.ml' and 'uGraph0.ml' are the same file Moving uGraph0.mli to uGraph0.mli mv: 'uGraph0.mli' and 'uGraph0.mli' are the same file Moving utils.ml to utils.ml mv: 'utils.ml' and 'utils.ml' are the same file Moving utils.mli to utils.mli mv: 'utils.mli' and 'utils.mli' are the same file Moving wGraph.ml to wGraph.ml mv: 'wGraph.ml' and 'wGraph.ml' are the same file Moving wGraph.mli to wGraph.mli mv: 'wGraph.mli' and 'wGraph.mli' are the same file Removing: src/all_Forall.ml src/all_Forall.mli src/ascii.ml src/ascii.mli src/ast0.ml src/ast0.mli src/ast_denoter.ml src/ast_quoter.ml src/astUtils.ml src/astUtils.mli src/basicAst.ml src/basicAst.mli src/basics.ml src/basics.mli src/binInt.ml src/binInt.mli src/binNat.ml src/binNat.mli src/binNums.ml src/binNums.mli src/binPosDef.ml src/binPosDef.mli src/binPos.ml src/binPos.mli src/bool.ml src/bool.mli src/common0.ml src/common0.mli src/compare_dec.ml src/compare_dec.mli src/config0.ml src/config0.mli src/cRelationClasses.ml src/cRelationClasses.mli src/datatypes.ml src/datatypes.mli src/decimal.ml src/decimal.mli src/denoter.ml src/environment.ml src/environment.mli src/equalities.ml src/equalities.mli src/extractable.ml src/extractable.mli src/hexadecimal.ml src/hexadecimal.mli src/liftSubst.ml src/liftSubst.mli src/list0.ml src/list0.mli src/logic0.ml src/logic0.mli src/mCPrelude.mli src/mCPrelude.ml src/mCCompare.ml src/mCCompare.mli src/mCList.ml src/mCList.mli src/mCOption.ml src/mCOption.mli src/mCProd.ml src/mCProd.mli src/mCRelations.ml src/mCRelations.mli src/mCString.ml src/mCString.mli src/mSetDecide.ml src/mSetDecide.mli src/mSetFacts.ml src/mSetFacts.mli src/mSetInterface.ml src/mSetInterface.mli src/mSetList.ml src/mSetList.mli src/mSetProperties.ml src/mSetProperties.mli src/nat0.ml src/nat0.mli src/numeral.ml src/numeral.mli src/orderedType0.ml src/orderedType0.mli src/ordersFacts.ml src/ordersFacts.mli src/ordersLists.ml src/ordersLists.mli src/orders.ml src/orders.mli src/ordersTac.ml src/ordersTac.mli src/peanoNat.ml src/peanoNat.mli src/plugin_core.ml src/plugin_core.mli src/pretty.ml src/pretty.mli src/reification.ml src/quoter.ml src/run_extractable.ml src/run_extractable.mli src/specif.ml src/specif.mli src/string0.ml src/string0.mli src/tm_util.ml src/universes0.ml src/universes0.mli src/univSubst0.ml src/univSubst0.mli make -f Makefile.plugin make[4]: Entering directory '/builds/coq/coq/_build_ci/metacoq/erasure' COQDEP VFILES CAMLDEP src/safeTemplateErasure.mli CAMLDEP src/ePretty.mli CAMLDEP src/safeErasureFunction.mli CAMLDEP src/extract.mli CAMLDEP src/erasureFunction.mli CAMLDEP src/eTyping.mli CAMLDEP src/eLiftSubst.mli CAMLDEP src/eAstUtils.mli CAMLDEP src/eAst.mli CAMLDEP src/safeTemplateChecker.mli CAMLDEP src/pCUICSafeRetyping.mli CAMLDEP src/pCUICSafeChecker.mli CAMLDEP src/pCUICSafeConversion.mli CAMLDEP src/pCUICSafeReduce.mli CAMLDEP src/templateToPCUIC.mli CAMLDEP src/pCUICSafeLemmata.mli CAMLDEP src/pCUICPretty.mli CAMLDEP src/pCUICChecker.mli CAMLDEP src/pCUICNormal.mli CAMLDEP src/pCUICPosition.mli CAMLDEP src/pCUICCumulativity.mli CAMLDEP src/pCUICUnivSubst.mli CAMLDEP src/pCUICTyping.mli CAMLDEP src/pCUICReflect.mli CAMLDEP src/pCUICEquality.mli CAMLDEP src/eqDecInstances.mli CAMLDEP src/pCUICLiftSubst.mli CAMLDEP src/pCUICAstUtils.mli CAMLDEP src/pCUICAst.mli CAMLDEP src/typing0.mli CAMLDEP src/wGraph.mli CAMLDEP src/uGraph0.mli CAMLDEP src/monad_utils.mli CAMLDEP src/utils.mli CAMLDEP src/ssrbool.mli CAMLDEP src/eqdepFacts.mli CAMLDEP src/mSetWeakList.mli CAMLDEP src/classes0.mli CAMLDEP src/init.mli OCAMLLIBDEP src/metacoq_erasure_plugin.mlpack CAMLDEP src/safeTemplateErasure.ml CAMLDEP src/ePretty.ml CAMLDEP src/safeErasureFunction.ml CAMLDEP src/erasureFunction.ml CAMLDEP src/extract.ml CAMLDEP src/eTyping.ml CAMLDEP src/eLiftSubst.ml CAMLDEP src/eAstUtils.ml CAMLDEP src/eAst.ml CAMLDEP src/safeTemplateChecker.ml CAMLDEP src/pCUICSafeRetyping.ml CAMLDEP src/pCUICSafeChecker.ml CAMLDEP src/pCUICSafeConversion.ml CAMLDEP src/pCUICSafeReduce.ml CAMLDEP src/templateToPCUIC.ml CAMLDEP src/pCUICSafeLemmata.ml CAMLDEP src/pCUICPretty.ml CAMLDEP src/pCUICChecker.ml CAMLDEP src/pCUICNormal.ml CAMLDEP src/pCUICPosition.ml CAMLDEP src/pCUICCumulativity.ml CAMLDEP src/pCUICUnivSubst.ml CAMLDEP src/pCUICTyping.ml CAMLDEP src/pCUICEquality.ml CAMLDEP src/pCUICReflect.ml CAMLDEP src/eqDecInstances.ml CAMLDEP src/pCUICLiftSubst.ml CAMLDEP src/pCUICAstUtils.ml CAMLDEP src/pCUICAst.ml CAMLDEP src/typing0.ml CAMLDEP src/wGraph.ml CAMLDEP src/uGraph0.ml CAMLDEP src/monad_utils.ml CAMLDEP src/utils.ml CAMLDEP src/ssrbool.ml CAMLDEP src/eqdepFacts.ml CAMLDEP src/mSetWeakList.ml CAMLDEP src/classes0.ml CAMLDEP src/init.ml CAMLDEP src/g_metacoq_erasure.ml CAMLC -c src/mSetWeakList.mli CAMLC -c src/monad_utils.mli src/monad_utils.cmi (real: 0.04, user: 0.03, sys: 0.01, mem: 19272 ko) CAMLC -c src/eqdepFacts.mli src/mSetWeakList.cmi (real: 0.06, user: 0.04, sys: 0.01, mem: 20108 ko) CAMLC -c src/ssrbool.mli src/eqdepFacts.cmi (real: 0.04, user: 0.03, sys: 0.01, mem: 19396 ko) CAMLC -c src/utils.mli src/ssrbool.cmi (real: 0.04, user: 0.02, sys: 0.01, mem: 19220 ko) CAMLC -c src/typing0.mli src/typing0.cmi (real: 0.04, user: 0.03, sys: 0.01, mem: 20300 ko) CAMLC -c src/init.mli src/utils.cmi (real: 0.05, user: 0.04, sys: 0.01, mem: 19228 ko) CAMLC -c src/classes0.mli src/init.cmi (real: 0.04, user: 0.03, sys: 0.01, mem: 19324 ko) CAMLC -c src/pCUICAst.mli src/classes0.cmi (real: 0.05, user: 0.03, sys: 0.01, mem: 19340 ko) CAMLC -c src/pCUICNormal.mli src/pCUICNormal.cmi (real: 0.03, user: 0.02, sys: 0.01, mem: 19304 ko) CAMLC -c src/pCUICCumulativity.mli src/pCUICAst.cmi (real: 0.06, user: 0.04, sys: 0.01, mem: 21244 ko) CAMLC -c src/safeTemplateChecker.mli src/pCUICCumulativity.cmi (real: 0.03, user: 0.02, sys: 0.01, mem: 19224 ko) CAMLC -c src/eAst.mli src/safeTemplateChecker.cmi (real: 0.05, user: 0.04, sys: 0.01, mem: 20348 ko) CAMLOPT -c -for-pack Metacoq_erasure_plugin src/monad_utils.ml src/eAst.cmi (real: 0.05, user: 0.03, sys: 0.01, mem: 20908 ko) CAMLOPT -c -for-pack Metacoq_erasure_plugin src/mSetWeakList.ml src/monad_utils.cmx (real: 0.07, user: 0.04, sys: 0.02, mem: 22452 ko) CAMLOPT -c -for-pack Metacoq_erasure_plugin src/eqdepFacts.ml src/mSetWeakList.cmx (real: 0.08, user: 0.06, sys: 0.01, mem: 25216 ko) CAMLOPT -c -for-pack Metacoq_erasure_plugin src/ssrbool.ml src/eqdepFacts.cmx (real: 0.05, user: 0.03, sys: 0.01, mem: 22072 ko) CAMLOPT -c -for-pack Metacoq_erasure_plugin src/utils.ml src/ssrbool.cmx (real: 0.05, user: 0.02, sys: 0.02, mem: 21912 ko) CAMLC -c src/wGraph.mli src/utils.cmx (real: 0.06, user: 0.04, sys: 0.02, mem: 22212 ko) CAMLOPT -c -for-pack Metacoq_erasure_plugin src/typing0.ml src/wGraph.cmi (real: 0.06, user: 0.05, sys: 0.00, mem: 22824 ko) CAMLOPT -c -for-pack Metacoq_erasure_plugin src/init.ml src/typing0.cmx (real: 0.07, user: 0.05, sys: 0.01, mem: 24076 ko) CAMLOPT -c -for-pack Metacoq_erasure_plugin src/classes0.ml src/init.cmx (real: 0.05, user: 0.03, sys: 0.02, mem: 22188 ko) CAMLOPT -c -for-pack Metacoq_erasure_plugin src/pCUICAst.ml src/classes0.cmx (real: 0.05, user: 0.02, sys: 0.02, mem: 21960 ko) CAMLC -c src/pCUICAstUtils.mli src/pCUICAst.cmx (real: 0.07, user: 0.05, sys: 0.01, mem: 26032 ko) CAMLC -c src/pCUICUnivSubst.mli src/pCUICAstUtils.cmi (real: 0.06, user: 0.04, sys: 0.01, mem: 20412 ko) CAMLC -c src/pCUICLiftSubst.mli src/pCUICUnivSubst.cmi (real: 0.04, user: 0.03, sys: 0.01, mem: 20308 ko) CAMLC -c src/eqDecInstances.mli src/pCUICLiftSubst.cmi (real: 0.05, user: 0.03, sys: 0.01, mem: 20444 ko) CAMLC -c src/pCUICReflect.mli src/eqDecInstances.cmi (real: 0.04, user: 0.03, sys: 0.01, mem: 19268 ko) CAMLOPT -c -for-pack Metacoq_erasure_plugin src/pCUICNormal.ml src/pCUICReflect.cmi (real: 0.04, user: 0.03, sys: 0.01, mem: 20240 ko) CAMLC -c src/pCUICPosition.mli src/pCUICNormal.cmx (real: 0.05, user: 0.03, sys: 0.02, mem: 22044 ko) CAMLC -c src/templateToPCUIC.mli src/pCUICPosition.cmi (real: 0.04, user: 0.03, sys: 0.01, mem: 20488 ko) CAMLC -c src/pCUICSafeLemmata.mli src/pCUICSafeLemmata.cmi (real: 0.04, user: 0.03, sys: 0.00, mem: 19348 ko) CAMLOPT -c -for-pack Metacoq_erasure_plugin src/pCUICCumulativity.ml src/templateToPCUIC.cmi (real: 0.06, user: 0.05, sys: 0.01, mem: 21328 ko) CAMLOPT -c -for-pack Metacoq_erasure_plugin src/safeTemplateChecker.ml src/pCUICCumulativity.cmx (real: 0.04, user: 0.02, sys: 0.02, mem: 21940 ko) CAMLOPT -c -for-pack Metacoq_erasure_plugin src/eAst.ml src/safeTemplateChecker.cmx (real: 0.08, user: 0.06, sys: 0.02, mem: 25408 ko) CAMLC -c src/eAstUtils.mli src/eAstUtils.cmi (real: 0.04, user: 0.03, sys: 0.01, mem: 19496 ko) CAMLC -c src/eLiftSubst.mli src/eAst.cmx (real: 0.12, user: 0.10, sys: 0.02, mem: 28644 ko) CAMLC -c src/extract.mli src/eLiftSubst.cmi (real: 0.04, user: 0.02, sys: 0.01, mem: 19300 ko) CAMLOPT -c -for-pack Metacoq_erasure_plugin src/wGraph.ml src/extract.cmi (real: 0.05, user: 0.03, sys: 0.01, mem: 21060 ko) CAMLC -c src/uGraph0.mli src/uGraph0.cmi (real: 0.08, user: 0.06, sys: 0.01, mem: 24780 ko) CAMLOPT -c -for-pack Metacoq_erasure_plugin src/pCUICAstUtils.ml src/wGraph.cmx (real: 0.17, user: 0.14, sys: 0.02, mem: 31636 ko) CAMLOPT -c -for-pack Metacoq_erasure_plugin src/pCUICUnivSubst.ml src/pCUICAstUtils.cmx (real: 0.11, user: 0.08, sys: 0.02, mem: 26392 ko) CAMLOPT -c -for-pack Metacoq_erasure_plugin src/pCUICLiftSubst.ml src/pCUICUnivSubst.cmx (real: 0.08, user: 0.05, sys: 0.02, mem: 25180 ko) CAMLOPT -c -for-pack Metacoq_erasure_plugin src/eqDecInstances.ml src/eqDecInstances.cmx (real: 0.06, user: 0.03, sys: 0.02, mem: 22196 ko) CAMLOPT -c -for-pack Metacoq_erasure_plugin src/pCUICReflect.ml src/pCUICLiftSubst.cmx (real: 0.09, user: 0.06, sys: 0.02, mem: 26244 ko) CAMLC -c src/pCUICEquality.mli src/pCUICEquality.cmi (real: 0.05, user: 0.03, sys: 0.01, mem: 20372 ko) CAMLC -c src/pCUICTyping.mli src/pCUICReflect.cmx (real: 0.07, user: 0.05, sys: 0.02, mem: 24336 ko) CAMLOPT -c -for-pack Metacoq_erasure_plugin src/pCUICPosition.ml src/pCUICTyping.cmi (real: 0.05, user: 0.04, sys: 0.01, mem: 21400 ko) CAMLOPT -c -for-pack Metacoq_erasure_plugin src/templateToPCUIC.ml src/pCUICPosition.cmx (real: 0.08, user: 0.06, sys: 0.01, mem: 26048 ko) CAMLOPT -c -for-pack Metacoq_erasure_plugin src/pCUICSafeLemmata.ml src/templateToPCUIC.cmx (real: 0.08, user: 0.06, sys: 0.02, mem: 26384 ko) src/pCUICSafeLemmata.cmx (real: 0.05, user: 0.02, sys: 0.02, mem: 22084 ko) CAMLC -c src/pCUICSafeReduce.mli CAMLOPT -c -for-pack Metacoq_erasure_plugin src/eAstUtils.ml src/pCUICSafeReduce.cmi (real: 0.06, user: 0.05, sys: 0.01, mem: 21556 ko) CAMLOPT -c -for-pack Metacoq_erasure_plugin src/eLiftSubst.ml src/eAstUtils.cmx (real: 0.08, user: 0.05, sys: 0.02, mem: 24800 ko) CAMLC -c src/eTyping.mli src/eTyping.cmi (real: 0.04, user: 0.03, sys: 0.00, mem: 20252 ko) CAMLOPT -c -for-pack Metacoq_erasure_plugin src/extract.ml src/eLiftSubst.cmx (real: 0.07, user: 0.05, sys: 0.02, mem: 25192 ko) CAMLOPT -c -for-pack Metacoq_erasure_plugin src/uGraph0.ml src/extract.cmx (real: 0.07, user: 0.04, sys: 0.02, mem: 23032 ko) CAMLOPT -c -for-pack Metacoq_erasure_plugin src/pCUICEquality.ml src/uGraph0.cmx (real: 0.13, user: 0.11, sys: 0.02, mem: 30984 ko) CAMLOPT -c -for-pack Metacoq_erasure_plugin src/pCUICTyping.ml src/pCUICEquality.cmx (real: 0.09, user: 0.06, sys: 0.02, mem: 26256 ko) CAMLC -c src/pCUICChecker.mli src/pCUICChecker.cmi (real: 0.06, user: 0.04, sys: 0.01, mem: 21236 ko) CAMLC -c src/pCUICSafeConversion.mli src/pCUICTyping.cmx (real: 0.11, user: 0.08, sys: 0.03, mem: 27752 ko) CAMLOPT -c -for-pack Metacoq_erasure_plugin src/eTyping.ml src/pCUICSafeConversion.cmi (real: 0.08, user: 0.06, sys: 0.02, mem: 23232 ko) CAMLC -c src/ePretty.mli src/eTyping.cmx (real: 0.08, user: 0.06, sys: 0.02, mem: 24684 ko) CAMLOPT -c -for-pack Metacoq_erasure_plugin src/pCUICChecker.ml src/ePretty.cmi (real: 0.06, user: 0.04, sys: 0.01, mem: 20540 ko) CAMLC -c src/pCUICPretty.mli src/pCUICPretty.cmi (real: 0.05, user: 0.04, sys: 0.01, mem: 20560 ko) CAMLOPT -c -for-pack Metacoq_erasure_plugin src/pCUICSafeReduce.ml src/pCUICChecker.cmx (real: 0.07, user: 0.05, sys: 0.02, mem: 25140 ko) CAMLC -c src/pCUICSafeChecker.mli src/pCUICSafeChecker.cmi (real: 0.07, user: 0.05, sys: 0.01, mem: 24300 ko) CAMLOPT -c -for-pack Metacoq_erasure_plugin src/ePretty.ml src/pCUICSafeReduce.cmx (real: 0.09, user: 0.07, sys: 0.02, mem: 27792 ko) CAMLC -c src/erasureFunction.mli src/erasureFunction.cmi (real: 0.08, user: 0.06, sys: 0.01, mem: 22652 ko) CAMLOPT -c -for-pack Metacoq_erasure_plugin src/pCUICPretty.ml src/ePretty.cmx (real: 0.11, user: 0.09, sys: 0.02, mem: 26992 ko) CAMLOPT -c -for-pack Metacoq_erasure_plugin src/pCUICSafeConversion.ml src/pCUICPretty.cmx (real: 0.11, user: 0.09, sys: 0.02, mem: 29148 ko) CAMLC -c src/pCUICSafeRetyping.mli src/pCUICSafeRetyping.cmi (real: 0.05, user: 0.03, sys: 0.01, mem: 21604 ko) CAMLC -c src/safeErasureFunction.mli src/safeErasureFunction.cmi (real: 0.07, user: 0.05, sys: 0.01, mem: 21660 ko) CAMLC -c src/safeTemplateErasure.mli src/safeTemplateErasure.cmi (real: 0.07, user: 0.05, sys: 0.01, mem: 23148 ko) src/pCUICSafeConversion.cmx (real: 0.31, user: 0.27, sys: 0.03, mem: 43056 ko) CAMLOPT -c -for-pack Metacoq_erasure_plugin src/pCUICSafeChecker.ml src/pCUICSafeChecker.cmx (real: 0.37, user: 0.33, sys: 0.03, mem: 45284 ko) CAMLOPT -c -for-pack Metacoq_erasure_plugin src/pCUICSafeRetyping.ml CAMLOPT -c -for-pack Metacoq_erasure_plugin src/erasureFunction.ml src/pCUICSafeRetyping.cmx (real: 0.09, user: 0.06, sys: 0.02, mem: 27380 ko) CAMLOPT -c -for-pack Metacoq_erasure_plugin src/safeErasureFunction.ml src/erasureFunction.cmx (real: 0.14, user: 0.11, sys: 0.02, mem: 31208 ko) src/safeErasureFunction.cmx (real: 0.12, user: 0.09, sys: 0.01, mem: 29852 ko) CAMLOPT -c -for-pack Metacoq_erasure_plugin src/safeTemplateErasure.ml src/safeTemplateErasure.cmx (real: 0.09, user: 0.07, sys: 0.02, mem: 30244 ko) CAMLOPT -c -for-pack Metacoq_erasure_plugin src/g_metacoq_erasure.ml src/g_metacoq_erasure.cmx (real: 0.09, user: 0.06, sys: 0.02, mem: 30052 ko) CAMLOPT -pack -o src/metacoq_erasure_plugin.cmx src/metacoq_erasure_plugin.cmx (real: 0.12, user: 0.08, sys: 0.03, mem: 32668 ko) CAMLOPT -a -o src/metacoq_erasure_plugin.cmxa src/metacoq_erasure_plugin.cmxa (real: 0.02, user: 0.00, sys: 0.01, mem: 13520 ko) CAMLOPT -shared -o src/metacoq_erasure_plugin.cmxs src/metacoq_erasure_plugin.cmxs (real: 0.17, user: 0.13, sys: 0.03, mem: 20232 ko) COQC theories/Loader.v theories/Loader.vo (real: 0.41, user: 0.30, sys: 0.11, mem: 237756 ko) make[4]: Leaving directory '/builds/coq/coq/_build_ci/metacoq/erasure' make[3]: Leaving directory '/builds/coq/coq/_build_ci/metacoq/erasure' make -C test-suite make[3]: Entering directory '/builds/coq/coq/_build_ci/metacoq/test-suite' coq_makefile -f _CoqProject -o Makefile.coq make -C plugin-demo make[4]: Entering directory '/builds/coq/coq/_build_ci/metacoq/test-suite/plugin-demo' coq_makefile -f _CoqProject -o Makefile.coq Warning: ../template-coq/theories (used in -R or -Q) is not a subdirectory of the current directory make -f Makefile.coq pretty-timed make[4]: Entering directory '/builds/coq/coq/_build_ci/metacoq/test-suite' Warning: ../../template-coq/theories (used in -R or -Q) is not a subdirectory of the current directory make -f Makefile.coq make[5]: Entering directory '/builds/coq/coq/_build_ci/metacoq/test-suite/plugin-demo' COQDEP VFILES COQDEP VFILES *** Warning: in file theories/MyPlugin.v, required library Loader matches several files in path (found Loader.v in ../../template-coq/theories and theories; used the latter) COQC theories/Lens.v theories/Lens.vo (real: 0.10, user: 0.05, sys: 0.04, mem: 64048 ko) COQC theories/MyPlugin.v COQC bug1.v File "./theories/MyPlugin.v", line 10, characters 0-24: Warning: Interpreting this declaration as if a global declaration prefixed by "Local", i.e. as a global declaration which shall not be available without qualification when imported. [local-declaration,scope] theories/MyPlugin.vo (real: 1.20, user: 0.91, sys: 0.28, mem: 513348 ko) COQC theories/Extraction.v bug1.vo (real: 1.30, user: 1.03, sys: 0.26, mem: 510284 ko) COQC bug2.v bug2.vo (real: 1.09, user: 0.81, sys: 0.26, mem: 500380 ko) COQC bug5.v File "./theories/Extraction.v", line 7, characters 0-28: Warning: The extraction is currently set to bypass opacity, the following opaque constant bodies have been accessed : All_Forall.All2_firstn All_Forall.All2_All_mix_right CRelationClasses.PartialOrder_inverse All_Forall.All_All2_All2_mix fold_rec_bis cardinal_inv_2b All_Forall.All_rev All_Forall.All_mix All_Forall.All_map All_Forall.All_app All_Forall.OnOne2_impl_exist_and_All_r Universes.fresh_universe All_Forall.Alli_rev All_Forall.Alli_mix All_Forall.Alli_app All_Forall.Alli_All All_Forall.All_prod All_Forall.All_mapi All_Forall.All_impl All_Forall.All_Alli All_Forall.All_All2 List.Forall_rect All_Forall.All2_sym All_Forall.All2_rev All_Forall.All2_nth All_Forall.All2_mix All_Forall.All2_map All_Forall.All2_app All_Forall.All2_All fold_rec_nodep Universes.Level.eqb_spec All_Forall.Alli_shiftn_inv Universes.fresh_level All_Forall.All2_All_mix_left All_Forall.All2_nth_error_Some_r All_Forall.Alli_nth_error All_Forall.forall_nth_error_All All_Forall.forall_nth_error_Alli All_Forall.All2_nth_error All_Forall.nth_error_all All_Forall.All2_prod_inv All_Forall.Alli_mapi List.nth_in_or_default All_Forall.forallb_nth' CRelationClasses.partial_order_antisym All_Forall.All_skipn CRelationClasses.flip_PreOrder All_Forall.Alli_shiftn All_Forall.Forall_All CRelationClasses.relation_implication_preorder All_Forall.OnOne2_impl_exist_and_All All_Forall.All2i_rev All_Forall.All2i_app All_Forall.All2_symP All_Forall.All2_swap All_Forall.All2_same All_Forall.All2_mapi All_Forall.All2_impl All_Forall.All2_app_inv String.eqb_spec All_Forall.OnOne2_All_mix_left List.exists_last All_Forall.All2i_mapi All_Forall.All2i_impl All_Forall.All_nth_error All_Forall.All_repeat All_Forall.Alli_app_inv All_Forall.All2_trans All_Forall.All2_skipn All_Forall.All2_right All_Forall.All2_eq_eq All_Forall.All2_app_r All_Forall.All_firstn All_Forall.All2_All_right All_Forall.All2_map_left MCOption.option_map_Some CRelationClasses.flip_Reflexive All_Forall.All2_map_right All_Forall.All2_map_left' All_Forall.forallb2_All2 All_Forall.All_app_inv MCList.rev_case CRelationClasses.flip_StrictOrder MCList.nth_error_spec List.destruct_list CRelationClasses.relation_equivalence_equivalence All_Forall.OnOne2_split All_Forall.OnOne2_ind_l All_Forall.OnOne2_exist cardinal_inv_2 All_Forall.All2_All_left All_Forall.OnOne2_mapP All_Forall.OnOne2_impl All_Forall.nth_error_alli Universes.ConstraintType.eq_dec MCList.rev_list_ind In_dec Ascii.eqb_spec All_Forall.All_prod_inv set_induction_min set_induction_max MCCompare.string_Compare All_Forall.All2_nth_error_Some_right MCList.nth_error_Some' All_Forall.map_option_out_All All_Forall.All_rev_map All_Forall.All_rev_inv All_Forall.All_All2_refl CRelationClasses.flip_Antisymmetric All_Forall.All2_app_inv_r fold_rel fold_rec MCCompare.ascii_Compare CRelationClasses.flip_PER All_Forall.Alli_All_mix set_induction All_Forall.All2_mix_inv CRelationClasses.flip_Equivalence All_Forall.forallb_All All_Forall.All2_map_inv MCList.rev_ind All_Forall.All2_right_triv set_induction_bis MCList.list_rect_rev fold_rec_weak BasicAst.ident_eq_spec All_Forall.OnOne2_sym All_Forall.OnOne2_map All_Forall.OnOne2_app All_Forall.All2_from_nth_error All_Forall.map_eq_inj All_Forall.Alli_rev_nth_error All_Forall.All2_map_right' All_Forall.All2_nth_error_Some All_Forall.OnOne2_nth_error All_Forall.All2_All_left_pack All_Forall.All_safe_nth CRelationClasses.subrelation_symmetric MCOption.nth_map_option_out All_Forall.All_map_inv All_Forall.Alli_shift All_Forall.All2_impl_In. [extraction-opaque-accessed,extraction] bug5.vo (real: 1.92, user: 1.62, sys: 0.29, mem: 512080 ko) COQC bug6.v File "./theories/Extraction.v", line 7, characters 0-28: Warning: The identifier __top_assumption_ contains __ which is reserved for the extraction [extraction-reserved-identifier,extraction] File "./theories/Extraction.v", line 7, characters 0-28: Warning: The identifier __top_assumption_ contains __ which is reserved for the extraction [extraction-reserved-identifier,extraction] File "./theories/Extraction.v", line 7, characters 0-28: Warning: The identifier t__rect contains __ which is reserved for the extraction [extraction-reserved-identifier,extraction] File "./theories/Extraction.v", line 7, characters 0-28: Warning: The identifier t__rec contains __ which is reserved for the extraction [extraction-reserved-identifier,extraction] File "./theories/Extraction.v", line 7, characters 0-28: Warning: The identifier t__rect contains __ which is reserved for the extraction [extraction-reserved-identifier,extraction] File "./theories/Extraction.v", line 7, characters 0-28: Warning: The identifier t__rec contains __ which is reserved for the extraction [extraction-reserved-identifier,extraction] File "./theories/Extraction.v", line 7, characters 0-28: Warning: The identifier t__rect contains __ which is reserved for the extraction [extraction-reserved-identifier,extraction] File "./theories/Extraction.v", line 7, characters 0-28: Warning: The identifier t__rec contains __ which is reserved for the extraction [extraction-reserved-identifier,extraction] File "./theories/Extraction.v", line 7, characters 0-28: Warning: The identifier t__rect contains __ which is reserved for the extraction [extraction-reserved-identifier,extraction] File "./theories/Extraction.v", line 7, characters 0-28: Warning: The identifier t__rec contains __ which is reserved for the extraction [extraction-reserved-identifier,extraction] theories/Extraction.vo (real: 3.67, user: 3.11, sys: 0.54, mem: 561316 ko) make[5]: Leaving directory '/builds/coq/coq/_build_ci/metacoq/test-suite/plugin-demo' cd gen-src && ./to-lower.sh Moving Lens.ml to lens.ml Moving Lens.mli to lens.mli Moving MyPlugin.ml to myPlugin.ml Moving MyPlugin.mli to myPlugin.mli make -f Makefile.plugin make[5]: Entering directory '/builds/coq/coq/_build_ci/metacoq/test-suite/plugin-demo' Makefile.plugin:20: Makefile.plugin.conf: No such file or directory COQDEP VFILES *** Warning: in file test/test.v, required library Loader matches several files in path (found Loader.v in ../../template-coq/theories and theories; used the latter) coq_makefile -f _PluginProject -o Makefile.plugin Warning: ../../template-coq/theories (used in -R or -Q) is not a subdirectory of the current directory COQPP src/g_demo_plugin.mlg CAMLDEP gen-src/lens.mli CAMLDEP gen-src/myPlugin.mli OCAMLLIBDEP src/demo_plugin.mlpack CAMLDEP gen-src/lens.ml CAMLDEP gen-src/myPlugin.ml CAMLDEP src/g_demo_plugin.ml CAMLC -c gen-src/lens.mli gen-src/lens.cmi (real: 0.04, user: 0.03, sys: 0.01, mem: 19172 ko) CAMLC -c gen-src/myPlugin.mli gen-src/myPlugin.cmi (real: 0.05, user: 0.04, sys: 0.01, mem: 20208 ko) CAMLOPT -c -for-pack Demo_plugin gen-src/lens.ml gen-src/lens.cmx (real: 0.07, user: 0.04, sys: 0.02, mem: 22124 ko) CAMLOPT -c -for-pack Demo_plugin gen-src/myPlugin.ml bug6.vo (real: 1.11, user: 0.85, sys: 0.25, mem: 500408 ko) COQC bug7.v gen-src/myPlugin.cmx (real: 0.12, user: 0.10, sys: 0.02, mem: 27228 ko) CAMLOPT -c -for-pack Demo_plugin src/g_demo_plugin.ml src/g_demo_plugin.cmx (real: 0.09, user: 0.06, sys: 0.02, mem: 27844 ko) CAMLOPT -pack -o src/demo_plugin.cmx src/demo_plugin.cmx (real: 0.06, user: 0.04, sys: 0.02, mem: 21964 ko) CAMLOPT -a -o src/demo_plugin.cmxa src/demo_plugin.cmxa (real: 0.02, user: 0.00, sys: 0.01, mem: 13200 ko) CAMLOPT -shared -o src/demo_plugin.cmxs src/demo_plugin.cmxs (real: 0.04, user: 0.01, sys: 0.02, mem: 14256 ko) COQC theories/Loader.v theories/Loader.vo (real: 0.10, user: 0.05, sys: 0.04, mem: 62308 ko) COQC test/test.v bug7.vo (real: 1.21, user: 0.89, sys: 0.31, mem: 500252 ko) COQC bug8.v Notation plus := Nat.add Expands to: Notation Coq.Init.Peano.plus (1 + 2) File "./test/test.v", line 19, characters 0-16: Warning: 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 [ssr-search-moved,deprecated] x: Point -> nat y: Point -> nat Build_Point: nat -> nat -> Point _y: Lens Point Point nat nat _x: Lens Point Point nat nat test/test.vo (real: 1.51, user: 1.21, sys: 0.29, mem: 513888 ko) make[5]: Leaving directory '/builds/coq/coq/_build_ci/metacoq/test-suite/plugin-demo' make[4]: Leaving directory '/builds/coq/coq/_build_ci/metacoq/test-suite/plugin-demo' COQC bugkncst.v bug8.vo (real: 1.10, user: 0.84, sys: 0.25, mem: 500436 ko) COQC case.v File "./bugkncst.v", line 12, characters 21-36: Warning: omega is deprecated since 8.12; use “lia” instead. [omega-is-deprecated,deprecated] case.vo (real: 1.12, user: 0.88, sys: 0.23, mem: 500120 ko) COQC castprop.v castprop.vo (real: 1.23, user: 0.94, sys: 0.28, mem: 510368 ko) COQC cofix.v cofix.vo (real: 1.11, user: 0.81, sys: 0.29, mem: 500192 ko) COQC erasure_live_test.v bugkncst.vo (real: 57.89, user: 56.51, sys: 1.14, mem: 896928 ko) COQC vs.v File "./vs.v", line 91, characters 0-145: Warning: omega is deprecated since 8.12; use “lia” instead. [omega-is-deprecated,deprecated] File "./vs.v", line 1065, characters 1-7: Warning: omega is deprecated since 8.12; use “lia” instead. [omega-is-deprecated,deprecated] File "./vs.v", line 1066, characters 1-7: Warning: omega is deprecated since 8.12; use “lia” instead. [omega-is-deprecated,deprecated] File "./vs.v", line 1486, characters 0-143: Warning: omega is deprecated since 8.12; use “lia” instead. [omega-is-deprecated,deprecated] File "./vs.v", line 1519, characters 0-4: Warning: Cannot define graph(s) for main [funind-cannot-define-graph,funind] File "./vs.v", line 1519, characters 0-4: Warning: Cannot build inversion information [funind-cannot-build-inversion,funind] File "./vs.v", line 1870, characters 0-758: Warning: Not a truly recursive fixpoint. [non-recursive,fixpoints] File "./vs.v", line 2020, characters 0-145: Warning: omega is deprecated since 8.12; use “lia” instead. [omega-is-deprecated,deprecated] File "./vs.v", line 2347, characters 0-27: Warning: The extraction is currently set to bypass opacity, the following opaque constant bodies have been accessed : the_loop_terminate main_terminate. [extraction-opaque-accessed,extraction] File "./vs.v", line 2370, characters 0-21: Warning: The extraction is currently set to bypass opacity, the following opaque constant bodies have been accessed : the_loop_terminate main_terminate. [extraction-opaque-accessed,extraction] vs.vo (real: 5.44, user: 4.90, sys: 0.51, mem: 501352 ko) COQC evars.v evars.vo (real: 1.10, user: 0.79, sys: 0.29, mem: 500100 ko) COQC extractable.v extractable.vo (real: 1.17, user: 0.88, sys: 0.29, mem: 501748 ko) COQC hnf_ctor.v hnf_ctor.vo (real: 1.11, user: 0.80, sys: 0.30, mem: 502088 ko) COQC issue27.v issue27.vo (real: 1.35, user: 1.02, sys: 0.31, mem: 522688 ko) COQC issue28.v File "./issue28.v", line 31, characters 0-282: Warning: Interpreting this declaration as if a global declaration prefixed by "Local", i.e. as a global declaration which shall not be available without qualification when imported. [local-declaration,scope] issue28.vo (real: 1.35, user: 1.05, sys: 0.29, mem: 522968 ko) COQC letin.v letin.vo (real: 1.21, user: 0.90, sys: 0.29, mem: 500080 ko) COQC modules_sections.v modules_sections.vo (real: 1.73, user: 1.35, sys: 0.35, mem: 526276 ko) COQC mutind.v mutind.vo (real: 1.19, user: 0.89, sys: 0.29, mem: 500068 ko) COQC opaque.v opaque.vo (real: 1.26, user: 0.94, sys: 0.31, mem: 500016 ko) COQC proj.v proj.vo (real: 1.52, user: 1.21, sys: 0.29, mem: 524028 ko) COQC run_in_tactic.v run_in_tactic.vo (real: 1.34, user: 1.03, sys: 0.29, mem: 522996 ko) COQC safechecker_test.v File "./safechecker_test.v", line 39, characters 0-27: Warning: To avoid stack overflow, large numbers in nat are interpreted as applications of Nat.of_num_uint. [abstract-large-number,numbers] File "./safechecker_test.v", line 54, characters 0-44: Warning: Notation "_ * _" was already used in scope type_scope. [notation-overridden,parsing] File "./safechecker_test.v", line 70, characters 0-50: Warning: Notation "_ = _ :> _" was already used in scope type_scope. [notation-overridden,parsing] File "./safechecker_test.v", line 72, characters 0-45: Warning: Notation "_ = _" was already used in scope type_scope. [notation-overridden,parsing] File "./safechecker_test.v", line 88, characters 0-68: Warning: Notation "{ _ : _ & _ }" was already used in scope type_scope. [notation-overridden,parsing] File "./safechecker_test.v", line 432, characters 0-221: Warning: Ignored instance declaration for “e_inv”: “forall (A : Type@{Var(0)}) (B : Type@{Var(1)}) (f : A -> B), IsEquiv@{Var(0) Var(1)} f -> B -> A” is not a class [not-a-class,typeclasses] File "./safechecker_test.v", line 440, characters 0-83: Warning: Ignored instance declaration for “e_fun”: “forall (A : Type@{Var(0)}) (B : Type@{Var(1)}), Equiv@{Var(0) Var(1)} A B -> A -> B” is not a class [not-a-class,typeclasses] safechecker_test.vo (real: 3.34, user: 2.89, sys: 0.44, mem: 726228 ko) COQC tmExistingInstance.v tmExistingInstance.vo (real: 1.21, user: 0.92, sys: 0.28, mem: 522724 ko) COQC tmInferInstance.v tmInferInstance.vo (real: 1.30, user: 0.98, sys: 0.31, mem: 522552 ko) COQC TypingTests.v TypingTests.vo (real: 2.62, user: 2.27, sys: 0.34, mem: 558304 ko) COQC unfold.v unfold.vo (real: 1.35, user: 1.03, sys: 0.31, mem: 522248 ko) COQC univ.v univ.vo (real: 1.28, user: 0.99, sys: 0.28, mem: 522992 ko) COQC tmVariable.v tmVariable.vo (real: 1.31, user: 1.01, sys: 0.29, mem: 524932 ko) COQC order_rec.v order_rec.vo (real: 1.41, user: 1.09, sys: 0.30, mem: 525128 ko) COQC erasure_test.v erasure_live_test.vo (real: 88.03, user: 86.21, sys: 1.46, mem: 1038900 ko) File "./erasure_test.v", line 44, characters 0-27: Warning: To avoid stack overflow, large numbers in nat are interpreted as applications of Nat.of_num_uint. [abstract-large-number,numbers] erasure_test.vo (real: 1.42, user: 1.10, sys: 0.31, mem: 543584 ko) Time | Peak Mem | File Name --------------------------------------------- 2m59.43s | 1038900 ko | Total Time / Peak Mem --------------------------------------------- 1m26.21s | 1038900 ko | erasure_live_test.vo 0m56.51s | 896928 ko | bugkncst.vo 0m04.90s | 501352 ko | vs.vo 0m02.89s | 726228 ko | safechecker_test.vo 0m02.27s | 558304 ko | TypingTests.vo 0m01.62s | 512080 ko | bug5.vo 0m01.35s | 526276 ko | modules_sections.vo 0m01.21s | 524028 ko | proj.vo 0m01.10s | 543584 ko | erasure_test.vo 0m01.09s | 525128 ko | order_rec.vo 0m01.05s | 522968 ko | issue28.vo 0m01.03s | 510284 ko | bug1.vo 0m01.03s | 522996 ko | run_in_tactic.vo 0m01.03s | 522248 ko | unfold.vo 0m01.02s | 522688 ko | issue27.vo 0m01.01s | 524932 ko | tmVariable.vo 0m00.99s | 522992 ko | univ.vo 0m00.98s | 522552 ko | tmInferInstance.vo 0m00.94s | 510368 ko | castprop.vo 0m00.94s | 500016 ko | opaque.vo 0m00.92s | 522724 ko | tmExistingInstance.vo 0m00.90s | 500080 ko | letin.vo 0m00.89s | 500252 ko | bug7.vo 0m00.89s | 500068 ko | mutind.vo 0m00.88s | 500120 ko | case.vo 0m00.88s | 501748 ko | extractable.vo 0m00.85s | 500408 ko | bug6.vo 0m00.84s | 500436 ko | bug8.vo 0m00.81s | 500380 ko | bug2.vo 0m00.81s | 500192 ko | cofix.vo 0m00.80s | 502088 ko | hnf_ctor.vo 0m00.79s | 500100 ko | evars.vo make[4]: Leaving directory '/builds/coq/coq/_build_ci/metacoq/test-suite' make[3]: Leaving directory '/builds/coq/coq/_build_ci/metacoq/test-suite' make[2]: Leaving directory '/builds/coq/coq/_build_ci/metacoq' make[1]: Leaving directory '/builds/coq/coq/_build_ci/metacoq' + make install + '[' -z x ']' + command make install + make install make[1]: Entering directory '/builds/coq/coq/_build_ci/metacoq' make -C template-coq make[2]: Entering directory '/builds/coq/coq/_build_ci/metacoq/template-coq' make -f Makefile.coq make[3]: Entering directory '/builds/coq/coq/_build_ci/metacoq/template-coq' make[4]: Nothing to be done for 'real-all'. ./update_plugin.sh Updating gen-src from src Copying from src to gen-src Renaming files to camelCase patching file gen-src/cRelationClasses.mli Reversed (or previously applied) patch detected! Skipping patch. 1 out of 1 hunk ignored -- saving rejects to file gen-src/cRelationClasses.mli.rej make[3]: Leaving directory '/builds/coq/coq/_build_ci/metacoq/template-coq' make -f Makefile.template optfiles make[3]: Entering directory '/builds/coq/coq/_build_ci/metacoq/template-coq' make[3]: Nothing to be done for 'optfiles'. make[3]: Leaving directory '/builds/coq/coq/_build_ci/metacoq/template-coq' cp src/template_coq.cm* build/ make -f Makefile.template make[3]: Entering directory '/builds/coq/coq/_build_ci/metacoq/template-coq' make[4]: Nothing to be done for 'real-all'. make[3]: Leaving directory '/builds/coq/coq/_build_ci/metacoq/template-coq' make -f Makefile.plugin make[3]: Entering directory '/builds/coq/coq/_build_ci/metacoq/template-coq' CAMLDEP gen-src/univSubst0.mli CAMLDEP gen-src/universes0.mli CAMLDEP gen-src/string0.mli CAMLDEP gen-src/run_extractable.mli CAMLDEP gen-src/specif.mli CAMLDEP gen-src/pretty.mli CAMLDEP gen-src/plugin_core.mli CAMLDEP gen-src/peanoNat.mli CAMLDEP gen-src/ordersTac.mli CAMLDEP gen-src/orders.mli CAMLDEP gen-src/ordersLists.mli CAMLDEP gen-src/ordersFacts.mli CAMLDEP gen-src/orderedType0.mli CAMLDEP gen-src/numeral.mli CAMLDEP gen-src/nat0.mli CAMLDEP gen-src/mSetProperties.mli CAMLDEP gen-src/mSetList.mli CAMLDEP gen-src/mSetInterface.mli CAMLDEP gen-src/mSetFacts.mli CAMLDEP gen-src/mSetDecide.mli CAMLDEP gen-src/mCString.mli CAMLDEP gen-src/mCRelations.mli CAMLDEP gen-src/mCProd.mli CAMLDEP gen-src/mCOption.mli CAMLDEP gen-src/mCList.mli CAMLDEP gen-src/mCCompare.mli CAMLDEP gen-src/mCPrelude.mli CAMLDEP gen-src/logic0.mli CAMLDEP gen-src/list0.mli CAMLDEP gen-src/liftSubst.mli CAMLDEP gen-src/hexadecimal.mli CAMLDEP gen-src/extractable.mli CAMLDEP gen-src/equalities.mli CAMLDEP gen-src/environment.mli CAMLDEP gen-src/decimal.mli CAMLDEP gen-src/datatypes.mli CAMLDEP gen-src/cRelationClasses.mli CAMLDEP gen-src/config0.mli CAMLDEP gen-src/compare_dec.mli CAMLDEP gen-src/common0.mli CAMLDEP gen-src/bool.mli CAMLDEP gen-src/binPos.mli CAMLDEP gen-src/binPosDef.mli CAMLDEP gen-src/binNums.mli CAMLDEP gen-src/binNat.mli CAMLDEP gen-src/binInt.mli CAMLDEP gen-src/basics.mli CAMLDEP gen-src/basicAst.mli CAMLDEP gen-src/astUtils.mli CAMLDEP gen-src/ast0.mli CAMLDEP gen-src/ascii.mli CAMLDEP gen-src/all_Forall.mli OCAMLLIBDEP gen-src/metacoq_template_plugin.mlpack CAMLDEP gen-src/univSubst0.ml CAMLDEP gen-src/universes0.ml CAMLDEP gen-src/tm_util.ml CAMLDEP gen-src/string0.ml CAMLDEP gen-src/specif.ml CAMLDEP gen-src/run_extractable.ml CAMLDEP gen-src/quoter.ml CAMLDEP gen-src/reification.ml CAMLDEP gen-src/pretty.ml CAMLDEP gen-src/plugin_core.ml CAMLDEP gen-src/peanoNat.ml CAMLDEP gen-src/ordersTac.ml CAMLDEP gen-src/orders.ml CAMLDEP gen-src/ordersLists.ml CAMLDEP gen-src/ordersFacts.ml CAMLDEP gen-src/orderedType0.ml CAMLDEP gen-src/numeral.ml CAMLDEP gen-src/nat0.ml CAMLDEP gen-src/mSetProperties.ml CAMLDEP gen-src/mSetList.ml CAMLDEP gen-src/mSetInterface.ml CAMLDEP gen-src/mSetFacts.ml CAMLDEP gen-src/mSetDecide.ml CAMLDEP gen-src/mCString.ml CAMLDEP gen-src/mCRelations.ml CAMLDEP gen-src/mCProd.ml CAMLDEP gen-src/mCOption.ml CAMLDEP gen-src/mCList.ml CAMLDEP gen-src/mCCompare.ml CAMLDEP gen-src/mCPrelude.ml CAMLDEP gen-src/logic0.ml CAMLDEP gen-src/list0.ml CAMLDEP gen-src/liftSubst.ml CAMLDEP gen-src/hexadecimal.ml CAMLDEP gen-src/extractable.ml CAMLDEP gen-src/equalities.ml CAMLDEP gen-src/environment.ml CAMLDEP gen-src/denoter.ml CAMLDEP gen-src/decimal.ml CAMLDEP gen-src/datatypes.ml CAMLDEP gen-src/cRelationClasses.ml CAMLDEP gen-src/config0.ml CAMLDEP gen-src/compare_dec.ml CAMLDEP gen-src/common0.ml CAMLDEP gen-src/bool.ml CAMLDEP gen-src/binPos.ml CAMLDEP gen-src/binPosDef.ml CAMLDEP gen-src/binNums.ml CAMLDEP gen-src/binNat.ml CAMLDEP gen-src/binInt.ml CAMLDEP gen-src/basics.ml CAMLDEP gen-src/basicAst.ml CAMLDEP gen-src/astUtils.ml CAMLDEP gen-src/ast_quoter.ml CAMLDEP gen-src/ast_denoter.ml CAMLDEP gen-src/ast0.ml CAMLDEP gen-src/ascii.ml CAMLDEP gen-src/all_Forall.ml CAMLOPT -c -for-pack Metacoq_template_plugin gen-src/tm_util.ml CAMLOPT -c -for-pack Metacoq_template_plugin gen-src/reification.ml findlib: [WARNING] Interface numeral.cmi occurs in several directories: /builds/coq/coq/_install_ci/lib/coq/plugins/syntax, gen-src findlib: [WARNING] Interface numeral.cmi occurs in several directories: /builds/coq/coq/_install_ci/lib/coq/plugins/syntax, gen-src gen-src/reification.cmx (real: 0.03, user: 0.01, sys: 0.01, mem: 14744 ko) CAMLC -c gen-src/plugin_core.mli findlib: [WARNING] Interface numeral.cmi occurs in several directories: /builds/coq/coq/_install_ci/lib/coq/plugins/syntax, gen-src gen-src/plugin_core.cmi (real: 0.02, user: 0.01, sys: 0.01, mem: 17304 ko) CAMLC -c gen-src/tm_util.ml findlib: [WARNING] Interface numeral.cmi occurs in several directories: /builds/coq/coq/_install_ci/lib/coq/plugins/syntax, gen-src gen-src/tm_util.cmx (real: 0.08, user: 0.04, sys: 0.03, mem: 21988 ko) CAMLC -c gen-src/reification.ml findlib: [WARNING] Interface numeral.cmi occurs in several directories: /builds/coq/coq/_install_ci/lib/coq/plugins/syntax, gen-src gen-src/reification.cmo (real: 0.01, user: 0.00, sys: 0.01, mem: 11896 ko) CAMLOPT -c -for-pack Metacoq_template_plugin gen-src/quoter.ml findlib: [WARNING] Interface numeral.cmi occurs in several directories: /builds/coq/coq/_install_ci/lib/coq/plugins/syntax, gen-src gen-src/tm_util.cmo (real: 0.04, user: 0.03, sys: 0.01, mem: 18588 ko) CAMLOPT -c -for-pack Metacoq_template_plugin gen-src/denoter.ml findlib: [WARNING] Interface numeral.cmi occurs in several directories: /builds/coq/coq/_install_ci/lib/coq/plugins/syntax, gen-src gen-src/denoter.cmx (real: 0.08, user: 0.06, sys: 0.02, mem: 24368 ko) CAMLOPT -c -for-pack Metacoq_template_plugin gen-src/plugin_core.ml findlib: [WARNING] Interface numeral.cmi occurs in several directories: /builds/coq/coq/_install_ci/lib/coq/plugins/syntax, gen-src gen-src/plugin_core.cmx (real: 0.10, user: 0.07, sys: 0.02, mem: 27576 ko) gen-src/quoter.cmx (real: 0.20, user: 0.16, sys: 0.03, mem: 34528 ko) CAMLC -c gen-src/quoter.ml CAMLOPT -c -for-pack Metacoq_template_plugin gen-src/ast_quoter.ml findlib: [WARNING] Interface numeral.cmi occurs in several directories: /builds/coq/coq/_install_ci/lib/coq/plugins/syntax, gen-src findlib: [WARNING] Interface numeral.cmi occurs in several directories: /builds/coq/coq/_install_ci/lib/coq/plugins/syntax, gen-src gen-src/quoter.cmo (real: 0.12, user: 0.09, sys: 0.02, mem: 26444 ko) CAMLC -c gen-src/ast_quoter.ml findlib: [WARNING] Interface numeral.cmi occurs in several directories: /builds/coq/coq/_install_ci/lib/coq/plugins/syntax, gen-src gen-src/ast_quoter.cmx (real: 0.12, user: 0.09, sys: 0.03, mem: 27268 ko) CAMLOPT -c -for-pack Metacoq_template_plugin gen-src/ast_denoter.ml findlib: [WARNING] Interface numeral.cmi occurs in several directories: /builds/coq/coq/_install_ci/lib/coq/plugins/syntax, gen-src gen-src/ast_quoter.cmo (real: 0.07, user: 0.05, sys: 0.02, mem: 22532 ko) CAMLC -c gen-src/run_extractable.mli findlib: [WARNING] Interface numeral.cmi occurs in several directories: /builds/coq/coq/_install_ci/lib/coq/plugins/syntax, gen-src gen-src/run_extractable.cmi (real: 0.02, user: 0.01, sys: 0.00, mem: 13788 ko) gen-src/ast_denoter.cmx (real: 0.09, user: 0.07, sys: 0.02, mem: 27192 ko) CAMLOPT -c -for-pack Metacoq_template_plugin gen-src/run_extractable.ml findlib: [WARNING] Interface numeral.cmi occurs in several directories: /builds/coq/coq/_install_ci/lib/coq/plugins/syntax, gen-src gen-src/run_extractable.cmx (real: 0.14, user: 0.11, sys: 0.02, mem: 30592 ko) CAMLOPT -pack -o gen-src/metacoq_template_plugin.cmx findlib: [WARNING] Interface numeral.cmi occurs in several directories: /builds/coq/coq/_install_ci/lib/coq/plugins/syntax, gen-src gen-src/metacoq_template_plugin.cmx (real: 0.21, user: 0.09, sys: 0.04, mem: 31480 ko) CAMLOPT -a -o gen-src/metacoq_template_plugin.cmxa findlib: [WARNING] Interface numeral.cmi occurs in several directories: /builds/coq/coq/_install_ci/lib/coq/plugins/syntax, gen-src gen-src/metacoq_template_plugin.cmxa (real: 0.03, user: 0.01, sys: 0.02, mem: 13916 ko) CAMLOPT -shared -o gen-src/metacoq_template_plugin.cmxs findlib: [WARNING] Interface numeral.cmi occurs in several directories: /builds/coq/coq/_install_ci/lib/coq/plugins/syntax, gen-src gen-src/metacoq_template_plugin.cmxs (real: 0.14, user: 0.10, sys: 0.03, mem: 18520 ko) COQC theories/ExtractableLoader.v theories/ExtractableLoader.vo (real: 0.10, user: 0.06, sys: 0.04, mem: 62624 ko) cp gen-src/metacoq_template_plugin.cm* build/ make[3]: Leaving directory '/builds/coq/coq/_build_ci/metacoq/template-coq' make[2]: Leaving directory '/builds/coq/coq/_build_ci/metacoq/template-coq' make -C checker make -C pcuic make[2]: Entering directory '/builds/coq/coq/_build_ci/metacoq/checker' make -f Makefile.coq make[2]: Entering directory '/builds/coq/coq/_build_ci/metacoq/pcuic' make -f Makefile.pcuic make[3]: Entering directory '/builds/coq/coq/_build_ci/metacoq/checker' make[3]: Entering directory '/builds/coq/coq/_build_ci/metacoq/pcuic' make[4]: Nothing to be done for 'real-all'. ./update_plugin.sh Renaming extracted files make[3]: Leaving directory '/builds/coq/coq/_build_ci/metacoq/checker' make[2]: Leaving directory '/builds/coq/coq/_build_ci/metacoq/checker' make -C examples make[2]: Entering directory '/builds/coq/coq/_build_ci/metacoq/examples' make -f Makefile.coq pretty-timed make[3]: Entering directory '/builds/coq/coq/_build_ci/metacoq/examples' make[4]: Nothing to be done for 'real-all'. # echo "All done, moving extraction files!" # ./clean_extraction.sh make[3]: Leaving directory '/builds/coq/coq/_build_ci/metacoq/pcuic' make[2]: Leaving directory '/builds/coq/coq/_build_ci/metacoq/pcuic' make -C safechecker make[2]: Entering directory '/builds/coq/coq/_build_ci/metacoq/safechecker' make -f Makefile.safechecker make[3]: Entering directory '/builds/coq/coq/_build_ci/metacoq/safechecker' make[6]: Nothing to be done for 'real-all'. make[4]: Nothing to be done for 'real-all'. echo "Done extracting the safe checker, moving extraction files!" Done extracting the safe checker, moving extraction files! ./clean_extraction.sh Cleaning result of extraction Extraction up-to date make[3]: Leaving directory '/builds/coq/coq/_build_ci/metacoq/safechecker' make -f Makefile.plugin make[3]: Entering directory '/builds/coq/coq/_build_ci/metacoq/safechecker' Time | Peak Mem | File Name -------------------------------------------- 0m22.62s | 581920 ko | Total Time / Peak Mem -------------------------------------------- 0m19.93s | 581920 ko | tauto.vo 0m01.56s | 527740 ko | demo.vo 0m01.13s | 524144 ko | add_constructor.vo make[3]: Leaving directory '/builds/coq/coq/_build_ci/metacoq/examples' make[2]: Leaving directory '/builds/coq/coq/_build_ci/metacoq/examples' COQC theories/Loader.v theories/Loader.vo (real: 0.11, user: 0.07, sys: 0.03, mem: 63372 ko) make[3]: Leaving directory '/builds/coq/coq/_build_ci/metacoq/safechecker' make[2]: Leaving directory '/builds/coq/coq/_build_ci/metacoq/safechecker' make -C erasure make[2]: Entering directory '/builds/coq/coq/_build_ci/metacoq/erasure' make -f Makefile.erasure make[3]: Entering directory '/builds/coq/coq/_build_ci/metacoq/erasure' make[4]: Nothing to be done for 'real-all'. echo "Done extracting the erasure, moving extraction files!" Done extracting the erasure, moving extraction files! ./clean_extraction.sh Cleaning result of extraction Extraction up-to date make[3]: Leaving directory '/builds/coq/coq/_build_ci/metacoq/erasure' ./clean_extraction.sh Cleaning result of extraction Extraction up-to date make -f Makefile.plugin make[3]: Entering directory '/builds/coq/coq/_build_ci/metacoq/erasure' COQC theories/Loader.v theories/Loader.vo (real: 0.44, user: 0.28, sys: 0.15, mem: 237408 ko) make[3]: Leaving directory '/builds/coq/coq/_build_ci/metacoq/erasure' make[2]: Leaving directory '/builds/coq/coq/_build_ci/metacoq/erasure' make -C template-coq install make[2]: Entering directory '/builds/coq/coq/_build_ci/metacoq/template-coq' make -f Makefile.coq make[3]: Entering directory '/builds/coq/coq/_build_ci/metacoq/template-coq' make[4]: Nothing to be done for 'real-all'. ./update_plugin.sh Updating gen-src from src Copying from src to gen-src Renaming files to camelCase patching file gen-src/cRelationClasses.mli Reversed (or previously applied) patch detected! Skipping patch. 1 out of 1 hunk ignored -- saving rejects to file gen-src/cRelationClasses.mli.rej make[3]: Leaving directory '/builds/coq/coq/_build_ci/metacoq/template-coq' make -f Makefile.template optfiles make[3]: Entering directory '/builds/coq/coq/_build_ci/metacoq/template-coq' make[3]: Nothing to be done for 'optfiles'. make[3]: Leaving directory '/builds/coq/coq/_build_ci/metacoq/template-coq' cp src/template_coq.cm* build/ make -f Makefile.template make[3]: Entering directory '/builds/coq/coq/_build_ci/metacoq/template-coq' make[4]: Nothing to be done for 'real-all'. make[3]: Leaving directory '/builds/coq/coq/_build_ci/metacoq/template-coq' make -f Makefile.plugin make[3]: Entering directory '/builds/coq/coq/_build_ci/metacoq/template-coq' CAMLDEP gen-src/univSubst0.mli CAMLDEP gen-src/universes0.mli CAMLDEP gen-src/string0.mli CAMLDEP gen-src/specif.mli CAMLDEP gen-src/run_extractable.mli CAMLDEP gen-src/pretty.mli CAMLDEP gen-src/plugin_core.mli CAMLDEP gen-src/peanoNat.mli CAMLDEP gen-src/ordersTac.mli CAMLDEP gen-src/orders.mli CAMLDEP gen-src/ordersLists.mli CAMLDEP gen-src/ordersFacts.mli CAMLDEP gen-src/orderedType0.mli CAMLDEP gen-src/numeral.mli CAMLDEP gen-src/nat0.mli CAMLDEP gen-src/mSetProperties.mli CAMLDEP gen-src/mSetList.mli CAMLDEP gen-src/mSetFacts.mli CAMLDEP gen-src/mSetInterface.mli CAMLDEP gen-src/mSetDecide.mli CAMLDEP gen-src/mCString.mli CAMLDEP gen-src/mCRelations.mli CAMLDEP gen-src/mCProd.mli CAMLDEP gen-src/mCOption.mli CAMLDEP gen-src/mCList.mli CAMLDEP gen-src/mCCompare.mli CAMLDEP gen-src/mCPrelude.mli CAMLDEP gen-src/logic0.mli CAMLDEP gen-src/list0.mli CAMLDEP gen-src/liftSubst.mli CAMLDEP gen-src/hexadecimal.mli CAMLDEP gen-src/extractable.mli CAMLDEP gen-src/equalities.mli CAMLDEP gen-src/environment.mli CAMLDEP gen-src/decimal.mli CAMLDEP gen-src/datatypes.mli CAMLDEP gen-src/cRelationClasses.mli CAMLDEP gen-src/config0.mli CAMLDEP gen-src/compare_dec.mli CAMLDEP gen-src/common0.mli CAMLDEP gen-src/bool.mli CAMLDEP gen-src/binPos.mli CAMLDEP gen-src/binPosDef.mli CAMLDEP gen-src/binNums.mli CAMLDEP gen-src/binNat.mli CAMLDEP gen-src/binInt.mli CAMLDEP gen-src/basics.mli CAMLDEP gen-src/basicAst.mli CAMLDEP gen-src/astUtils.mli CAMLDEP gen-src/ast0.mli CAMLDEP gen-src/ascii.mli CAMLDEP gen-src/all_Forall.mli OCAMLLIBDEP gen-src/metacoq_template_plugin.mlpack CAMLDEP gen-src/univSubst0.ml CAMLDEP gen-src/universes0.ml CAMLDEP gen-src/tm_util.ml CAMLDEP gen-src/string0.ml CAMLDEP gen-src/specif.ml CAMLDEP gen-src/run_extractable.ml CAMLDEP gen-src/quoter.ml CAMLDEP gen-src/reification.ml CAMLDEP gen-src/pretty.ml CAMLDEP gen-src/plugin_core.ml CAMLDEP gen-src/peanoNat.ml CAMLDEP gen-src/ordersTac.ml CAMLDEP gen-src/orders.ml CAMLDEP gen-src/ordersLists.ml CAMLDEP gen-src/ordersFacts.ml CAMLDEP gen-src/orderedType0.ml CAMLDEP gen-src/numeral.ml CAMLDEP gen-src/nat0.ml CAMLDEP gen-src/mSetProperties.ml CAMLDEP gen-src/mSetList.ml CAMLDEP gen-src/mSetInterface.ml CAMLDEP gen-src/mSetFacts.ml CAMLDEP gen-src/mSetDecide.ml CAMLDEP gen-src/mCString.ml CAMLDEP gen-src/mCRelations.ml CAMLDEP gen-src/mCProd.ml CAMLDEP gen-src/mCOption.ml CAMLDEP gen-src/mCList.ml CAMLDEP gen-src/mCCompare.ml CAMLDEP gen-src/mCPrelude.ml CAMLDEP gen-src/logic0.ml CAMLDEP gen-src/list0.ml CAMLDEP gen-src/liftSubst.ml CAMLDEP gen-src/hexadecimal.ml CAMLDEP gen-src/extractable.ml CAMLDEP gen-src/equalities.ml CAMLDEP gen-src/environment.ml CAMLDEP gen-src/denoter.ml CAMLDEP gen-src/decimal.ml CAMLDEP gen-src/datatypes.ml CAMLDEP gen-src/cRelationClasses.ml CAMLDEP gen-src/config0.ml CAMLDEP gen-src/compare_dec.ml CAMLDEP gen-src/common0.ml CAMLDEP gen-src/bool.ml CAMLDEP gen-src/binPos.ml CAMLDEP gen-src/binPosDef.ml CAMLDEP gen-src/binNums.ml CAMLDEP gen-src/binNat.ml CAMLDEP gen-src/binInt.ml CAMLDEP gen-src/basics.ml CAMLDEP gen-src/astUtils.ml CAMLDEP gen-src/basicAst.ml CAMLDEP gen-src/ast_denoter.ml CAMLDEP gen-src/ast_quoter.ml CAMLDEP gen-src/ast0.ml CAMLDEP gen-src/ascii.ml CAMLDEP gen-src/all_Forall.ml CAMLOPT -c -for-pack Metacoq_template_plugin gen-src/reification.ml CAMLOPT -c -for-pack Metacoq_template_plugin gen-src/tm_util.ml findlib: [WARNING] Interface numeral.cmi occurs in several directories: /builds/coq/coq/_install_ci/lib/coq/plugins/syntax, gen-src findlib: [WARNING] Interface numeral.cmi occurs in several directories: /builds/coq/coq/_install_ci/lib/coq/plugins/syntax, gen-src gen-src/reification.cmx (real: 0.02, user: 0.01, sys: 0.01, mem: 14740 ko) CAMLC -c gen-src/plugin_core.mli findlib: [WARNING] Interface numeral.cmi occurs in several directories: /builds/coq/coq/_install_ci/lib/coq/plugins/syntax, gen-src gen-src/plugin_core.cmi (real: 0.03, user: 0.02, sys: 0.00, mem: 17196 ko) CAMLC -c gen-src/tm_util.ml findlib: [WARNING] Interface numeral.cmi occurs in several directories: /builds/coq/coq/_install_ci/lib/coq/plugins/syntax, gen-src gen-src/tm_util.cmx (real: 0.08, user: 0.04, sys: 0.02, mem: 22136 ko) CAMLC -c gen-src/reification.ml findlib: [WARNING] Interface numeral.cmi occurs in several directories: /builds/coq/coq/_install_ci/lib/coq/plugins/syntax, gen-src gen-src/reification.cmo (real: 0.02, user: 0.01, sys: 0.00, mem: 11760 ko) CAMLOPT -c -for-pack Metacoq_template_plugin gen-src/quoter.ml gen-src/tm_util.cmo (real: 0.04, user: 0.02, sys: 0.01, mem: 18448 ko) CAMLOPT -c -for-pack Metacoq_template_plugin gen-src/denoter.ml findlib: [WARNING] Interface numeral.cmi occurs in several directories: /builds/coq/coq/_install_ci/lib/coq/plugins/syntax, gen-src findlib: [WARNING] Interface numeral.cmi occurs in several directories: /builds/coq/coq/_install_ci/lib/coq/plugins/syntax, gen-src gen-src/denoter.cmx (real: 0.12, user: 0.08, sys: 0.02, mem: 24324 ko) CAMLOPT -c -for-pack Metacoq_template_plugin gen-src/plugin_core.ml findlib: [WARNING] Interface numeral.cmi occurs in several directories: /builds/coq/coq/_install_ci/lib/coq/plugins/syntax, gen-src gen-src/quoter.cmx (real: 0.22, user: 0.19, sys: 0.03, mem: 34468 ko) CAMLC -c gen-src/quoter.ml findlib: [WARNING] Interface numeral.cmi occurs in several directories: /builds/coq/coq/_install_ci/lib/coq/plugins/syntax, gen-src gen-src/quoter.cmo (real: 0.12, user: 0.10, sys: 0.01, mem: 26404 ko) CAMLOPT -c -for-pack Metacoq_template_plugin gen-src/ast_quoter.ml findlib: [WARNING] Interface numeral.cmi occurs in several directories: /builds/coq/coq/_install_ci/lib/coq/plugins/syntax, gen-src gen-src/plugin_core.cmx (real: 0.28, user: 0.07, sys: 0.03, mem: 27504 ko) CAMLC -c gen-src/ast_quoter.ml findlib: [WARNING] Interface numeral.cmi occurs in several directories: /builds/coq/coq/_install_ci/lib/coq/plugins/syntax, gen-src gen-src/ast_quoter.cmo (real: 0.09, user: 0.05, sys: 0.02, mem: 22440 ko) CAMLC -c gen-src/run_extractable.mli findlib: [WARNING] Interface numeral.cmi occurs in several directories: /builds/coq/coq/_install_ci/lib/coq/plugins/syntax, gen-src gen-src/run_extractable.cmi (real: 0.02, user: 0.01, sys: 0.00, mem: 13824 ko) gen-src/ast_quoter.cmx (real: 0.20, user: 0.10, sys: 0.03, mem: 27364 ko) CAMLOPT -c -for-pack Metacoq_template_plugin gen-src/ast_denoter.ml findlib: [WARNING] Interface numeral.cmi occurs in several directories: /builds/coq/coq/_install_ci/lib/coq/plugins/syntax, gen-src gen-src/ast_denoter.cmx (real: 0.19, user: 0.08, sys: 0.03, mem: 27288 ko) CAMLOPT -c -for-pack Metacoq_template_plugin gen-src/run_extractable.ml findlib: [WARNING] Interface numeral.cmi occurs in several directories: /builds/coq/coq/_install_ci/lib/coq/plugins/syntax, gen-src gen-src/run_extractable.cmx (real: 0.18, user: 0.09, sys: 0.03, mem: 30504 ko) CAMLOPT -pack -o gen-src/metacoq_template_plugin.cmx findlib: [WARNING] Interface numeral.cmi occurs in several directories: /builds/coq/coq/_install_ci/lib/coq/plugins/syntax, gen-src gen-src/metacoq_template_plugin.cmx (real: 0.18, user: 0.11, sys: 0.04, mem: 31632 ko) CAMLOPT -a -o gen-src/metacoq_template_plugin.cmxa findlib: [WARNING] Interface numeral.cmi occurs in several directories: /builds/coq/coq/_install_ci/lib/coq/plugins/syntax, gen-src gen-src/metacoq_template_plugin.cmxa (real: 0.05, user: 0.01, sys: 0.02, mem: 14056 ko) CAMLOPT -shared -o gen-src/metacoq_template_plugin.cmxs findlib: [WARNING] Interface numeral.cmi occurs in several directories: /builds/coq/coq/_install_ci/lib/coq/plugins/syntax, gen-src gen-src/metacoq_template_plugin.cmxs (real: 0.15, user: 0.10, sys: 0.04, mem: 18416 ko) COQC theories/ExtractableLoader.v theories/ExtractableLoader.vo (real: 0.09, user: 0.04, sys: 0.04, mem: 62716 ko) cp gen-src/metacoq_template_plugin.cm* build/ make[3]: Leaving directory '/builds/coq/coq/_build_ci/metacoq/template-coq' make -f Makefile.coq install make[3]: Entering directory '/builds/coq/coq/_build_ci/metacoq/template-coq' INSTALL theories/utils/MCPrelude.vo /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/Template//utils INSTALL theories/utils/All_Forall.vo /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/Template//utils INSTALL theories/utils/MCArith.vo /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/Template//utils INSTALL theories/utils/MCCompare.vo /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/Template//utils INSTALL theories/utils/MCEquality.vo /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/Template//utils INSTALL theories/utils/LibHypsNaming.vo /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/Template//utils INSTALL theories/utils/MCList.vo /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/Template//utils INSTALL theories/utils/MCOption.vo /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/Template//utils INSTALL theories/utils/MCProd.vo /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/Template//utils INSTALL theories/utils/MCRelations.vo /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/Template//utils INSTALL theories/utils/MCSquash.vo /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/Template//utils INSTALL theories/utils/MCString.vo /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/Template//utils INSTALL theories/utils/wGraph.vo /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/Template//utils INSTALL theories/common/uGraph.vo /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/Template//common INSTALL theories/utils.vo /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/Template/ INSTALL theories/config.vo /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/Template/ INSTALL theories/Universes.vo /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/Template/ INSTALL theories/BasicAst.vo /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/Template/ INSTALL theories/Environment.vo /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/Template/ INSTALL theories/Ast.vo /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/Template/ INSTALL theories/AstUtils.vo /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/Template/ INSTALL theories/Induction.vo /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/Template/ INSTALL theories/LiftSubst.vo /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/Template/ INSTALL theories/UnivSubst.vo /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/Template/ INSTALL theories/Pretty.vo /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/Template/ INSTALL theories/EnvironmentTyping.vo /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/Template/ INSTALL theories/WfInv.vo /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/Template/ INSTALL theories/Typing.vo /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/Template/ INSTALL theories/TypingWf.vo /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/Template/ INSTALL theories/TemplateMonad.vo /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/Template/ INSTALL theories/TemplateMonad/Common.vo /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/Template//TemplateMonad INSTALL theories/TemplateMonad/Core.vo /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/Template//TemplateMonad INSTALL theories/TemplateMonad/Extractable.vo /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/Template//TemplateMonad INSTALL theories/monad_utils.vo /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/Template/ INSTALL theories/Constants.vo /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/Template/ INSTALL theories/Extraction.vo /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/Template/ INSTALL theories/utils/MCPrelude.v /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/Template//utils INSTALL theories/utils/All_Forall.v /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/Template//utils INSTALL theories/utils/MCArith.v /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/Template//utils INSTALL theories/utils/MCCompare.v /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/Template//utils INSTALL theories/utils/MCEquality.v /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/Template//utils INSTALL theories/utils/LibHypsNaming.v /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/Template//utils INSTALL theories/utils/MCList.v /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/Template//utils INSTALL theories/utils/MCOption.v /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/Template//utils INSTALL theories/utils/MCProd.v /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/Template//utils INSTALL theories/utils/MCRelations.v /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/Template//utils INSTALL theories/utils/MCSquash.v /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/Template//utils INSTALL theories/utils/MCString.v /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/Template//utils INSTALL theories/utils/wGraph.v /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/Template//utils INSTALL theories/common/uGraph.v /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/Template//common INSTALL theories/utils.v /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/Template/ INSTALL theories/config.v /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/Template/ INSTALL theories/Universes.v /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/Template/ INSTALL theories/BasicAst.v /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/Template/ INSTALL theories/Environment.v /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/Template/ INSTALL theories/Ast.v /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/Template/ INSTALL theories/AstUtils.v /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/Template/ INSTALL theories/Induction.v /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/Template/ INSTALL theories/LiftSubst.v /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/Template/ INSTALL theories/UnivSubst.v /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/Template/ INSTALL theories/Pretty.v /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/Template/ INSTALL theories/EnvironmentTyping.v /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/Template/ INSTALL theories/WfInv.v /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/Template/ INSTALL theories/Typing.v /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/Template/ INSTALL theories/TypingWf.v /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/Template/ INSTALL theories/TemplateMonad.v /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/Template/ INSTALL theories/TemplateMonad/Common.v /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/Template//TemplateMonad INSTALL theories/TemplateMonad/Core.v /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/Template//TemplateMonad INSTALL theories/TemplateMonad/Extractable.v /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/Template//TemplateMonad INSTALL theories/monad_utils.v /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/Template/ INSTALL theories/Constants.v /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/Template/ INSTALL theories/Extraction.v /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/Template/ INSTALL theories/utils/MCPrelude.glob /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/Template//utils INSTALL theories/utils/All_Forall.glob /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/Template//utils INSTALL theories/utils/MCArith.glob /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/Template//utils INSTALL theories/utils/MCCompare.glob /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/Template//utils INSTALL theories/utils/MCEquality.glob /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/Template//utils INSTALL theories/utils/LibHypsNaming.glob /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/Template//utils INSTALL theories/utils/MCList.glob /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/Template//utils INSTALL theories/utils/MCOption.glob /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/Template//utils INSTALL theories/utils/MCProd.glob /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/Template//utils INSTALL theories/utils/MCRelations.glob /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/Template//utils INSTALL theories/utils/MCSquash.glob /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/Template//utils INSTALL theories/utils/MCString.glob /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/Template//utils INSTALL theories/utils/wGraph.glob /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/Template//utils INSTALL theories/common/uGraph.glob /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/Template//common INSTALL theories/utils.glob /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/Template/ INSTALL theories/config.glob /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/Template/ INSTALL theories/Universes.glob /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/Template/ INSTALL theories/BasicAst.glob /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/Template/ INSTALL theories/Environment.glob /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/Template/ INSTALL theories/Ast.glob /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/Template/ INSTALL theories/AstUtils.glob /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/Template/ INSTALL theories/Induction.glob /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/Template/ INSTALL theories/LiftSubst.glob /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/Template/ INSTALL theories/UnivSubst.glob /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/Template/ INSTALL theories/Pretty.glob /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/Template/ INSTALL theories/EnvironmentTyping.glob /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/Template/ INSTALL theories/WfInv.glob /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/Template/ INSTALL theories/Typing.glob /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/Template/ INSTALL theories/TypingWf.glob /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/Template/ INSTALL theories/TemplateMonad.glob /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/Template/ INSTALL theories/TemplateMonad/Common.glob /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/Template//TemplateMonad INSTALL theories/TemplateMonad/Core.glob /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/Template//TemplateMonad INSTALL theories/TemplateMonad/Extractable.glob /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/Template//TemplateMonad INSTALL theories/monad_utils.glob /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/Template/ INSTALL theories/Constants.glob /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/Template/ INSTALL theories/Extraction.glob /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/Template/ make[4]: Entering directory '/builds/coq/coq/_build_ci/metacoq/template-coq' make[4]: Leaving directory '/builds/coq/coq/_build_ci/metacoq/template-coq' make[3]: Leaving directory '/builds/coq/coq/_build_ci/metacoq/template-coq' make -f Makefile.template install make[3]: Entering directory '/builds/coq/coq/_build_ci/metacoq/template-coq' INSTALL theories/Loader.vo /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/Template/ INSTALL theories/All.vo /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/Template/ INSTALL theories/Loader.v /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/Template/ INSTALL theories/All.v /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/Template/ INSTALL theories/Loader.glob /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/Template/ INSTALL theories/All.glob /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/Template/ INSTALL src/template_coq.cmi /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/Template/ INSTALL src/template_coq.cmxs /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/Template/ INSTALL src/template_coq.cmxs /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/Template/ INSTALL src/template_coq.cmxa /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/Template/ INSTALL src/template_coq.cmx /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/Template/ make[4]: Entering directory '/builds/coq/coq/_build_ci/metacoq/template-coq' make[4]: Leaving directory '/builds/coq/coq/_build_ci/metacoq/template-coq' make[3]: Leaving directory '/builds/coq/coq/_build_ci/metacoq/template-coq' make -f Makefile.plugin install make[3]: Entering directory '/builds/coq/coq/_build_ci/metacoq/template-coq' INSTALL theories/ExtractableLoader.vo /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/Template/ INSTALL theories/ExtractableLoader.v /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/Template/ INSTALL theories/ExtractableLoader.glob /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/Template/ INSTALL gen-src/mCPrelude.cmi /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/Template/ INSTALL gen-src/metacoq_template_plugin.cmi /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/Template/ INSTALL gen-src/mCPrelude.cmi /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/Template/ INSTALL gen-src/metacoq_template_plugin.cmxs /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/Template/ INSTALL gen-src/metacoq_template_plugin.cmxs /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/Template/ INSTALL gen-src/metacoq_template_plugin.cmxa /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/Template/ INSTALL gen-src/mCPrelude.cmx /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/Template/ INSTALL gen-src/metacoq_template_plugin.cmx /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/Template/ make[4]: Entering directory '/builds/coq/coq/_build_ci/metacoq/template-coq' make[4]: Leaving directory '/builds/coq/coq/_build_ci/metacoq/template-coq' make[3]: Leaving directory '/builds/coq/coq/_build_ci/metacoq/template-coq' make[2]: Leaving directory '/builds/coq/coq/_build_ci/metacoq/template-coq' make -C checker install make[2]: Entering directory '/builds/coq/coq/_build_ci/metacoq/checker' make -f Makefile.coq make[3]: Entering directory '/builds/coq/coq/_build_ci/metacoq/checker' make[4]: Nothing to be done for 'real-all'. ./update_plugin.sh Renaming extracted files make[3]: Leaving directory '/builds/coq/coq/_build_ci/metacoq/checker' make -f Makefile.coq install make[3]: Entering directory '/builds/coq/coq/_build_ci/metacoq/checker' INSTALL theories/Reflect.vo /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/Checker/ INSTALL theories/Generation.vo /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/Checker/ INSTALL theories/WeakeningEnv.vo /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/Checker/ INSTALL theories/Closed.vo /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/Checker/ INSTALL theories/Weakening.vo /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/Checker/ INSTALL theories/Substitution.vo /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/Checker/ INSTALL theories/Checker.vo /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/Checker/ INSTALL theories/WcbvEval.vo /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/Checker/ INSTALL theories/Retyping.vo /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/Checker/ INSTALL theories/Normal.vo /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/Checker/ INSTALL theories/All.vo /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/Checker/ INSTALL theories/Reflect.v /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/Checker/ INSTALL theories/Generation.v /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/Checker/ INSTALL theories/WeakeningEnv.v /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/Checker/ INSTALL theories/Closed.v /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/Checker/ INSTALL theories/Weakening.v /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/Checker/ INSTALL theories/Substitution.v /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/Checker/ INSTALL theories/Checker.v /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/Checker/ INSTALL theories/WcbvEval.v /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/Checker/ INSTALL theories/Retyping.v /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/Checker/ INSTALL theories/Normal.v /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/Checker/ INSTALL theories/All.v /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/Checker/ INSTALL theories/Reflect.glob /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/Checker/ INSTALL theories/Generation.glob /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/Checker/ INSTALL theories/WeakeningEnv.glob /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/Checker/ INSTALL theories/Closed.glob /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/Checker/ INSTALL theories/Weakening.glob /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/Checker/ INSTALL theories/Substitution.glob /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/Checker/ INSTALL theories/Checker.glob /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/Checker/ INSTALL theories/WcbvEval.glob /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/Checker/ INSTALL theories/Retyping.glob /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/Checker/ INSTALL theories/Normal.glob /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/Checker/ INSTALL theories/All.glob /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/Checker/ make[4]: Entering directory '/builds/coq/coq/_build_ci/metacoq/checker' make[4]: Leaving directory '/builds/coq/coq/_build_ci/metacoq/checker' make[3]: Leaving directory '/builds/coq/coq/_build_ci/metacoq/checker' # make -f Makefile.plugin install make[2]: Leaving directory '/builds/coq/coq/_build_ci/metacoq/checker' make -C pcuic install make[2]: Entering directory '/builds/coq/coq/_build_ci/metacoq/pcuic' make -f Makefile.pcuic make[3]: Entering directory '/builds/coq/coq/_build_ci/metacoq/pcuic' make[4]: Nothing to be done for 'real-all'. # echo "All done, moving extraction files!" # ./clean_extraction.sh make[3]: Leaving directory '/builds/coq/coq/_build_ci/metacoq/pcuic' make -f Makefile.pcuic install make[3]: Entering directory '/builds/coq/coq/_build_ci/metacoq/pcuic' INSTALL theories/PCUICUtils.vo /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/PCUIC/ INSTALL theories/PCUICAst.vo /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/PCUIC/ INSTALL theories/PCUICSize.vo /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/PCUIC/ INSTALL theories/PCUICAstUtils.vo /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/PCUIC/ INSTALL theories/PCUICInduction.vo /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/PCUIC/ INSTALL theories/PCUICReflect.vo /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/PCUIC/ INSTALL theories/PCUICLiftSubst.vo /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/PCUIC/ INSTALL theories/PCUICUnivSubst.vo /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/PCUIC/ INSTALL theories/PCUICTyping.vo /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/PCUIC/ INSTALL theories/PCUICInversion.vo /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/PCUIC/ INSTALL theories/PCUICPosition.vo /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/PCUIC/ INSTALL theories/PCUICNormal.vo /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/PCUIC/ INSTALL theories/PCUICNameless.vo /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/PCUIC/ INSTALL theories/PCUICEquality.vo /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/PCUIC/ INSTALL theories/PCUICWeakeningEnv.vo /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/PCUIC/ INSTALL theories/PCUICClosed.vo /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/PCUIC/ INSTALL theories/PCUICWeakening.vo /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/PCUIC/ INSTALL theories/PCUICUnivSubstitution.vo /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/PCUIC/ INSTALL theories/PCUICSubstitution.vo /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/PCUIC/ INSTALL theories/PCUICCumulativity.vo /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/PCUIC/ INSTALL theories/PCUICReduction.vo /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/PCUIC/ INSTALL theories/PCUICParallelReduction.vo /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/PCUIC/ INSTALL theories/PCUICParallelReductionConfluence.vo /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/PCUIC/ INSTALL theories/PCUICConfluence.vo /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/PCUIC/ INSTALL theories/PCUICContextConversion.vo /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/PCUIC/ INSTALL theories/PCUICConversion.vo /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/PCUIC/ INSTALL theories/PCUICGeneration.vo /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/PCUIC/ INSTALL theories/PCUICAlpha.vo /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/PCUIC/ INSTALL theories/PCUICPrincipality.vo /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/PCUIC/ INSTALL theories/PCUICCtxShape.vo /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/PCUIC/ INSTALL theories/PCUICContexts.vo /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/PCUIC/ INSTALL theories/PCUICArities.vo /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/PCUIC/ INSTALL theories/PCUICSpine.vo /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/PCUIC/ INSTALL theories/PCUICInductives.vo /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/PCUIC/ INSTALL theories/PCUICValidity.vo /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/PCUIC/ INSTALL theories/PCUICInductiveInversion.vo /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/PCUIC/ INSTALL theories/PCUICSR.vo /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/PCUIC/ INSTALL theories/PCUICMetaTheory.vo /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/PCUIC/ INSTALL theories/PCUICCSubst.vo /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/PCUIC/ INSTALL theories/PCUICWcbvEval.vo /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/PCUIC/ INSTALL theories/PCUICChecker.vo /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/PCUIC/ INSTALL theories/PCUICPretty.vo /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/PCUIC/ INSTALL theories/PCUICCheckerCompleteness.vo /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/PCUIC/ INSTALL theories/PCUICRetyping.vo /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/PCUIC/ INSTALL theories/PCUICElimination.vo /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/PCUIC/ INSTALL theories/PCUICSN.vo /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/PCUIC/ INSTALL theories/PCUICSigmaCalculus.vo /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/PCUIC/ INSTALL theories/PCUICSafeLemmata.vo /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/PCUIC/ INSTALL theories/TemplateToPCUIC.vo /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/PCUIC/ INSTALL theories/TemplateToPCUICCorrectness.vo /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/PCUIC/ INSTALL theories/PCUICToTemplate.vo /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/PCUIC/ INSTALL theories/PCUICToTemplateCorrectness.vo /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/PCUIC/ INSTALL theories/PCUICUtils.v /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/PCUIC/ INSTALL theories/PCUICAst.v /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/PCUIC/ INSTALL theories/PCUICSize.v /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/PCUIC/ INSTALL theories/PCUICAstUtils.v /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/PCUIC/ INSTALL theories/PCUICInduction.v /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/PCUIC/ INSTALL theories/PCUICReflect.v /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/PCUIC/ INSTALL theories/PCUICLiftSubst.v /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/PCUIC/ INSTALL theories/PCUICUnivSubst.v /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/PCUIC/ INSTALL theories/PCUICTyping.v /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/PCUIC/ INSTALL theories/PCUICInversion.v /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/PCUIC/ INSTALL theories/PCUICPosition.v /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/PCUIC/ INSTALL theories/PCUICNormal.v /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/PCUIC/ INSTALL theories/PCUICNameless.v /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/PCUIC/ INSTALL theories/PCUICEquality.v /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/PCUIC/ INSTALL theories/PCUICWeakeningEnv.v /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/PCUIC/ INSTALL theories/PCUICClosed.v /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/PCUIC/ INSTALL theories/PCUICWeakening.v /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/PCUIC/ INSTALL theories/PCUICUnivSubstitution.v /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/PCUIC/ INSTALL theories/PCUICSubstitution.v /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/PCUIC/ INSTALL theories/PCUICCumulativity.v /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/PCUIC/ INSTALL theories/PCUICReduction.v /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/PCUIC/ INSTALL theories/PCUICParallelReduction.v /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/PCUIC/ INSTALL theories/PCUICParallelReductionConfluence.v /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/PCUIC/ INSTALL theories/PCUICConfluence.v /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/PCUIC/ INSTALL theories/PCUICContextConversion.v /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/PCUIC/ INSTALL theories/PCUICConversion.v /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/PCUIC/ INSTALL theories/PCUICGeneration.v /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/PCUIC/ INSTALL theories/PCUICAlpha.v /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/PCUIC/ INSTALL theories/PCUICPrincipality.v /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/PCUIC/ INSTALL theories/PCUICCtxShape.v /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/PCUIC/ INSTALL theories/PCUICContexts.v /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/PCUIC/ INSTALL theories/PCUICArities.v /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/PCUIC/ INSTALL theories/PCUICSpine.v /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/PCUIC/ INSTALL theories/PCUICInductives.v /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/PCUIC/ INSTALL theories/PCUICValidity.v /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/PCUIC/ INSTALL theories/PCUICInductiveInversion.v /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/PCUIC/ INSTALL theories/PCUICSR.v /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/PCUIC/ INSTALL theories/PCUICMetaTheory.v /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/PCUIC/ INSTALL theories/PCUICCSubst.v /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/PCUIC/ INSTALL theories/PCUICWcbvEval.v /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/PCUIC/ INSTALL theories/PCUICChecker.v /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/PCUIC/ INSTALL theories/PCUICPretty.v /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/PCUIC/ INSTALL theories/PCUICCheckerCompleteness.v /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/PCUIC/ INSTALL theories/PCUICRetyping.v /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/PCUIC/ INSTALL theories/PCUICElimination.v /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/PCUIC/ INSTALL theories/PCUICSN.v /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/PCUIC/ INSTALL theories/PCUICSigmaCalculus.v /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/PCUIC/ INSTALL theories/PCUICSafeLemmata.v /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/PCUIC/ INSTALL theories/TemplateToPCUIC.v /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/PCUIC/ INSTALL theories/TemplateToPCUICCorrectness.v /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/PCUIC/ INSTALL theories/PCUICToTemplate.v /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/PCUIC/ INSTALL theories/PCUICToTemplateCorrectness.v /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/PCUIC/ INSTALL theories/PCUICUtils.glob /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/PCUIC/ INSTALL theories/PCUICAst.glob /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/PCUIC/ INSTALL theories/PCUICSize.glob /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/PCUIC/ INSTALL theories/PCUICAstUtils.glob /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/PCUIC/ INSTALL theories/PCUICInduction.glob /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/PCUIC/ INSTALL theories/PCUICReflect.glob /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/PCUIC/ INSTALL theories/PCUICLiftSubst.glob /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/PCUIC/ INSTALL theories/PCUICUnivSubst.glob /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/PCUIC/ INSTALL theories/PCUICTyping.glob /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/PCUIC/ INSTALL theories/PCUICInversion.glob /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/PCUIC/ INSTALL theories/PCUICPosition.glob /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/PCUIC/ INSTALL theories/PCUICNormal.glob /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/PCUIC/ INSTALL theories/PCUICNameless.glob /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/PCUIC/ INSTALL theories/PCUICEquality.glob /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/PCUIC/ INSTALL theories/PCUICWeakeningEnv.glob /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/PCUIC/ INSTALL theories/PCUICClosed.glob /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/PCUIC/ INSTALL theories/PCUICWeakening.glob /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/PCUIC/ INSTALL theories/PCUICUnivSubstitution.glob /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/PCUIC/ INSTALL theories/PCUICSubstitution.glob /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/PCUIC/ INSTALL theories/PCUICCumulativity.glob /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/PCUIC/ INSTALL theories/PCUICReduction.glob /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/PCUIC/ INSTALL theories/PCUICParallelReduction.glob /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/PCUIC/ INSTALL theories/PCUICParallelReductionConfluence.glob /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/PCUIC/ INSTALL theories/PCUICConfluence.glob /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/PCUIC/ INSTALL theories/PCUICContextConversion.glob /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/PCUIC/ INSTALL theories/PCUICConversion.glob /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/PCUIC/ INSTALL theories/PCUICGeneration.glob /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/PCUIC/ INSTALL theories/PCUICAlpha.glob /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/PCUIC/ INSTALL theories/PCUICPrincipality.glob /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/PCUIC/ INSTALL theories/PCUICCtxShape.glob /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/PCUIC/ INSTALL theories/PCUICContexts.glob /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/PCUIC/ INSTALL theories/PCUICArities.glob /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/PCUIC/ INSTALL theories/PCUICSpine.glob /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/PCUIC/ INSTALL theories/PCUICInductives.glob /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/PCUIC/ INSTALL theories/PCUICValidity.glob /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/PCUIC/ INSTALL theories/PCUICInductiveInversion.glob /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/PCUIC/ INSTALL theories/PCUICSR.glob /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/PCUIC/ INSTALL theories/PCUICMetaTheory.glob /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/PCUIC/ INSTALL theories/PCUICCSubst.glob /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/PCUIC/ INSTALL theories/PCUICWcbvEval.glob /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/PCUIC/ INSTALL theories/PCUICChecker.glob /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/PCUIC/ INSTALL theories/PCUICPretty.glob /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/PCUIC/ INSTALL theories/PCUICCheckerCompleteness.glob /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/PCUIC/ INSTALL theories/PCUICRetyping.glob /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/PCUIC/ INSTALL theories/PCUICElimination.glob /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/PCUIC/ INSTALL theories/PCUICSN.glob /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/PCUIC/ INSTALL theories/PCUICSigmaCalculus.glob /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/PCUIC/ INSTALL theories/PCUICSafeLemmata.glob /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/PCUIC/ INSTALL theories/TemplateToPCUIC.glob /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/PCUIC/ INSTALL theories/TemplateToPCUICCorrectness.glob /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/PCUIC/ INSTALL theories/PCUICToTemplate.glob /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/PCUIC/ INSTALL theories/PCUICToTemplateCorrectness.glob /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/PCUIC/ make[4]: Entering directory '/builds/coq/coq/_build_ci/metacoq/pcuic' make[4]: Leaving directory '/builds/coq/coq/_build_ci/metacoq/pcuic' make[3]: Leaving directory '/builds/coq/coq/_build_ci/metacoq/pcuic' # make -f Makefile.plugin install make[2]: Leaving directory '/builds/coq/coq/_build_ci/metacoq/pcuic' make -C safechecker install make[2]: Entering directory '/builds/coq/coq/_build_ci/metacoq/safechecker' make -f Makefile.safechecker make[3]: Entering directory '/builds/coq/coq/_build_ci/metacoq/safechecker' make[4]: Nothing to be done for 'real-all'. echo "Done extracting the safe checker, moving extraction files!" Done extracting the safe checker, moving extraction files! ./clean_extraction.sh Cleaning result of extraction Extraction up-to date make[3]: Leaving directory '/builds/coq/coq/_build_ci/metacoq/safechecker' make -f Makefile.plugin make[3]: Entering directory '/builds/coq/coq/_build_ci/metacoq/safechecker' COQC theories/Loader.v theories/Loader.vo (real: 0.12, user: 0.07, sys: 0.04, mem: 63996 ko) make[3]: Leaving directory '/builds/coq/coq/_build_ci/metacoq/safechecker' make -f Makefile.safechecker install make[3]: Entering directory '/builds/coq/coq/_build_ci/metacoq/safechecker' INSTALL theories/PCUICSafeReduce.vo /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/SafeChecker/ INSTALL theories/PCUICSafeConversion.vo /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/SafeChecker/ INSTALL theories/PCUICSafeChecker.vo /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/SafeChecker/ INSTALL theories/SafeTemplateChecker.vo /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/SafeChecker/ INSTALL theories/PCUICSafeRetyping.vo /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/SafeChecker/ INSTALL theories/Extraction.vo /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/SafeChecker/ INSTALL theories/PCUICSafeReduce.v /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/SafeChecker/ INSTALL theories/PCUICSafeConversion.v /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/SafeChecker/ INSTALL theories/PCUICSafeChecker.v /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/SafeChecker/ INSTALL theories/SafeTemplateChecker.v /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/SafeChecker/ INSTALL theories/PCUICSafeRetyping.v /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/SafeChecker/ INSTALL theories/Extraction.v /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/SafeChecker/ INSTALL theories/PCUICSafeReduce.glob /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/SafeChecker/ INSTALL theories/PCUICSafeConversion.glob /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/SafeChecker/ INSTALL theories/PCUICSafeChecker.glob /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/SafeChecker/ INSTALL theories/SafeTemplateChecker.glob /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/SafeChecker/ INSTALL theories/PCUICSafeRetyping.glob /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/SafeChecker/ INSTALL theories/Extraction.glob /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/SafeChecker/ make[4]: Entering directory '/builds/coq/coq/_build_ci/metacoq/safechecker' make[4]: Leaving directory '/builds/coq/coq/_build_ci/metacoq/safechecker' make[3]: Leaving directory '/builds/coq/coq/_build_ci/metacoq/safechecker' make -f Makefile.plugin install make[3]: Entering directory '/builds/coq/coq/_build_ci/metacoq/safechecker' INSTALL theories/Loader.vo /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/SafeChecker/ INSTALL theories/Loader.v /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/SafeChecker/ INSTALL theories/Loader.glob /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/SafeChecker/ INSTALL src/metacoq_safechecker_plugin.cmi /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/SafeChecker/ INSTALL src/metacoq_safechecker_plugin.cmxs /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/SafeChecker/ INSTALL src/metacoq_safechecker_plugin.cmxs /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/SafeChecker/ INSTALL src/metacoq_safechecker_plugin.cmxa /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/SafeChecker/ INSTALL src/metacoq_safechecker_plugin.cmx /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/SafeChecker/ make[4]: Entering directory '/builds/coq/coq/_build_ci/metacoq/safechecker' make[4]: Leaving directory '/builds/coq/coq/_build_ci/metacoq/safechecker' make[3]: Leaving directory '/builds/coq/coq/_build_ci/metacoq/safechecker' make[2]: Leaving directory '/builds/coq/coq/_build_ci/metacoq/safechecker' make -C erasure install make[2]: Entering directory '/builds/coq/coq/_build_ci/metacoq/erasure' make -f Makefile.erasure make[3]: Entering directory '/builds/coq/coq/_build_ci/metacoq/erasure' make[4]: Nothing to be done for 'real-all'. echo "Done extracting the erasure, moving extraction files!" Done extracting the erasure, moving extraction files! ./clean_extraction.sh Cleaning result of extraction Extraction up-to date make[3]: Leaving directory '/builds/coq/coq/_build_ci/metacoq/erasure' ./clean_extraction.sh Cleaning result of extraction Extraction up-to date make -f Makefile.plugin make[3]: Entering directory '/builds/coq/coq/_build_ci/metacoq/erasure' COQC theories/Loader.v theories/Loader.vo (real: 0.45, user: 0.29, sys: 0.15, mem: 238116 ko) make[3]: Leaving directory '/builds/coq/coq/_build_ci/metacoq/erasure' make -f Makefile.erasure install make[3]: Entering directory '/builds/coq/coq/_build_ci/metacoq/erasure' INSTALL theories/EAst.vo /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/Erasure/ INSTALL theories/EAstUtils.vo /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/Erasure/ INSTALL theories/EInduction.vo /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/Erasure/ INSTALL theories/ELiftSubst.vo /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/Erasure/ INSTALL theories/EPretty.vo /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/Erasure/ INSTALL theories/ECSubst.vo /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/Erasure/ INSTALL theories/EWcbvEval.vo /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/Erasure/ INSTALL theories/EWndEval.vo /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/Erasure/ INSTALL theories/ETyping.vo /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/Erasure/ INSTALL theories/Extract.vo /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/Erasure/ INSTALL theories/EAll.vo /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/Erasure/ INSTALL theories/Extraction.vo /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/Erasure/ INSTALL theories/Prelim.vo /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/Erasure/ INSTALL theories/ESubstitution.vo /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/Erasure/ INSTALL theories/EInversion.vo /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/Erasure/ INSTALL theories/EArities.vo /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/Erasure/ INSTALL theories/ErasureCorrectness.vo /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/Erasure/ INSTALL theories/ErasureFunction.vo /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/Erasure/ INSTALL theories/SafeErasureFunction.vo /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/Erasure/ INSTALL theories/SafeTemplateErasure.vo /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/Erasure/ INSTALL theories/EAst.v /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/Erasure/ INSTALL theories/EAstUtils.v /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/Erasure/ INSTALL theories/EInduction.v /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/Erasure/ INSTALL theories/ELiftSubst.v /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/Erasure/ INSTALL theories/EPretty.v /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/Erasure/ INSTALL theories/ECSubst.v /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/Erasure/ INSTALL theories/EWcbvEval.v /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/Erasure/ INSTALL theories/EWndEval.v /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/Erasure/ INSTALL theories/ETyping.v /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/Erasure/ INSTALL theories/Extract.v /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/Erasure/ INSTALL theories/EAll.v /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/Erasure/ INSTALL theories/Extraction.v /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/Erasure/ INSTALL theories/Prelim.v /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/Erasure/ INSTALL theories/ESubstitution.v /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/Erasure/ INSTALL theories/EInversion.v /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/Erasure/ INSTALL theories/EArities.v /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/Erasure/ INSTALL theories/ErasureCorrectness.v /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/Erasure/ INSTALL theories/ErasureFunction.v /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/Erasure/ INSTALL theories/SafeErasureFunction.v /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/Erasure/ INSTALL theories/SafeTemplateErasure.v /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/Erasure/ INSTALL theories/EAst.glob /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/Erasure/ INSTALL theories/EAstUtils.glob /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/Erasure/ INSTALL theories/EInduction.glob /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/Erasure/ INSTALL theories/ELiftSubst.glob /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/Erasure/ INSTALL theories/EPretty.glob /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/Erasure/ INSTALL theories/ECSubst.glob /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/Erasure/ INSTALL theories/EWcbvEval.glob /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/Erasure/ INSTALL theories/EWndEval.glob /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/Erasure/ INSTALL theories/ETyping.glob /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/Erasure/ INSTALL theories/Extract.glob /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/Erasure/ INSTALL theories/EAll.glob /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/Erasure/ INSTALL theories/Extraction.glob /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/Erasure/ INSTALL theories/Prelim.glob /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/Erasure/ INSTALL theories/ESubstitution.glob /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/Erasure/ INSTALL theories/EInversion.glob /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/Erasure/ INSTALL theories/EArities.glob /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/Erasure/ INSTALL theories/ErasureCorrectness.glob /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/Erasure/ INSTALL theories/ErasureFunction.glob /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/Erasure/ INSTALL theories/SafeErasureFunction.glob /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/Erasure/ INSTALL theories/SafeTemplateErasure.glob /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/Erasure/ make[4]: Entering directory '/builds/coq/coq/_build_ci/metacoq/erasure' make[4]: Leaving directory '/builds/coq/coq/_build_ci/metacoq/erasure' make[3]: Leaving directory '/builds/coq/coq/_build_ci/metacoq/erasure' make -f Makefile.plugin install make[3]: Entering directory '/builds/coq/coq/_build_ci/metacoq/erasure' INSTALL theories/Loader.vo /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/Erasure/ INSTALL theories/Loader.v /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/Erasure/ INSTALL theories/Loader.glob /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/Erasure/ INSTALL src/metacoq_erasure_plugin.cmi /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/Erasure/ INSTALL src/metacoq_erasure_plugin.cmxs /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/Erasure/ INSTALL src/metacoq_erasure_plugin.cmxs /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/Erasure/ INSTALL src/metacoq_erasure_plugin.cmxa /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/Erasure/ INSTALL src/metacoq_erasure_plugin.cmx /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/Erasure/ make[4]: Entering directory '/builds/coq/coq/_build_ci/metacoq/erasure' make[4]: Leaving directory '/builds/coq/coq/_build_ci/metacoq/erasure' make[3]: Leaving directory '/builds/coq/coq/_build_ci/metacoq/erasure' make[2]: Leaving directory '/builds/coq/coq/_build_ci/metacoq/erasure' make -C translations install make[2]: Entering directory '/builds/coq/coq/_build_ci/metacoq/translations' cat metacoq-config > _CoqProject cat _CoqProject.in >> _CoqProject coq_makefile -f _CoqProject -o Makefile.coq Warning: ../template-coq/theories (used in -R or -Q) is not a subdirectory of the current directory make -f Makefile.coq pretty-timed make[3]: Entering directory '/builds/coq/coq/_build_ci/metacoq/translations' COQDEP VFILES *** Warning: in file sigma.v, required library Loader matches several files in path (found Loader.v in ../template-coq/theories and ../checker/theories; used the latter) COQC sigma.v COQC MiniHoTT.v File "./MiniHoTT.v", line 37, characters 0-198: Warning: Notation "exists _ .. _ , _" was already used in scope type_scope. [notation-overridden,parsing] File "./MiniHoTT.v", line 41, characters 0-64: Warning: Notation "{ _ : _ & _ }" was already used in scope type_scope. [notation-overridden,parsing] File "./MiniHoTT.v", line 96, characters 0-37: Warning: Declaring a scope implicitly is deprecated; use in advance an explicit "Declare Scope equiv_scope.". [undeclared-scope,deprecated] File "./MiniHoTT.v", line 98, characters 0-35: Warning: Declaring a scope implicitly is deprecated; use in advance an explicit "Declare Scope path_scope.". [undeclared-scope,deprecated] File "./MiniHoTT.v", line 99, characters 0-45: Warning: Declaring a scope implicitly is deprecated; use in advance an explicit "Declare Scope fibration_scope.". [undeclared-scope,deprecated] File "./MiniHoTT.v", line 100, characters 0-37: Warning: Declaring a scope implicitly is deprecated; use in advance an explicit "Declare Scope trunc_scope.". [undeclared-scope,deprecated] File "./MiniHoTT.v", line 136, characters 0-21: Warning: Adding and removing hints in the core database implicitly is deprecated. Please specify a hint database. [implicit-core-hint-db,deprecated] File "./MiniHoTT.v", line 139, characters 0-52: Warning: Notation "_ = _ :> _" was already used in scope type_scope. [notation-overridden,parsing] File "./MiniHoTT.v", line 140, characters 0-45: Warning: Notation "_ = _" was already used in scope type_scope. [notation-overridden,parsing] sigma.vo (real: 1.17, user: 0.86, sys: 0.30, mem: 500064 ko) COQC MiniHoTT_paths.v File "./MiniHoTT_paths.v", line 41, characters 0-198: Warning: Notation "exists _ .. _ , _" was already used in scope type_scope. [notation-overridden,parsing] File "./MiniHoTT_paths.v", line 45, characters 0-64: Warning: Notation "{ _ : _ & _ }" was already used in scope type_scope. [notation-overridden,parsing] File "./MiniHoTT_paths.v", line 100, characters 0-37: Warning: Declaring a scope implicitly is deprecated; use in advance an explicit "Declare Scope equiv_scope.". [undeclared-scope,deprecated] File "./MiniHoTT_paths.v", line 102, characters 0-35: Warning: Declaring a scope implicitly is deprecated; use in advance an explicit "Declare Scope path_scope.". [undeclared-scope,deprecated] File "./MiniHoTT_paths.v", line 103, characters 0-45: Warning: Declaring a scope implicitly is deprecated; use in advance an explicit "Declare Scope fibration_scope.". [undeclared-scope,deprecated] File "./MiniHoTT_paths.v", line 104, characters 0-37: Warning: Declaring a scope implicitly is deprecated; use in advance an explicit "Declare Scope trunc_scope.". [undeclared-scope,deprecated] File "./MiniHoTT_paths.v", line 140, characters 0-21: Warning: Adding and removing hints in the core database implicitly is deprecated. Please specify a hint database. [implicit-core-hint-db,deprecated] File "./MiniHoTT_paths.v", line 143, characters 0-52: Warning: Notation "_ = _ :> _" was already used in scope type_scope. [notation-overridden,parsing] File "./MiniHoTT_paths.v", line 144, characters 0-45: Warning: Notation "_ = _" was already used in scope type_scope. [notation-overridden,parsing] MiniHoTT_paths.vo (real: 3.65, user: 3.42, sys: 0.20, mem: 350716 ko) COQC translation_utils.v MiniHoTT.vo (real: 4.94, user: 4.41, sys: 0.50, mem: 348856 ko) translation_utils.vo (real: 2.16, user: 1.82, sys: 0.33, mem: 554420 ko) COQC param_original.v COQC param_cheap_packed.v Coq.Init.Datatypes.nat has been translated. Coq.Init.Datatypes.list has been translated. listᵗ : forall A : TYPE, list A.1 -> Type : forall A : TYPE, list A.1 -> Type nilᵗ : forall A : TYPE, listᵗ A [] : forall A : TYPE, listᵗ A [] consᵗ : forall (A : TYPE) (x : El A) (lH : ∃ l : list A.1, listᵗ A l), listᵗ A (x.1 :: lH.1) : forall (A : TYPE) (x : El A) (lH : ∃ l : list A.1, listᵗ A l), listᵗ A (x.1 :: lH.1) param_cheap_packed.vo (real: 1.82, user: 1.49, sys: 0.32, mem: 553352 ko) COQC param_generous_packed.v "T has been translated as Tᵗ" "tm has been translated as tmᵗ" Coq.Init.Datatypes.nat has been translated. Coq.Init.Datatypes.bool has been translated. "pred has been translated as predᵗ" "ID has been translated as IDᵗ" "toto has been translated as totoᵗ" "my_id has been translated as my_idᵗ" "~~~~~~~~~~~~~~~~~~" "Translating Coq.Init.Logic.eq" "Coq.Init.Logic.eq has been translated." "Translating MetaCoq.Translations.param_original.Id2.ID" "ID has been translated as IDᵗ" "~~~~~~~~~~~~~~~~~~" "Translating Coq.Init.Logic.eq" "Coq.Init.Logic.eq was already translated" "Translating Coq.Init.Logic.eq_trans" "eq_trans has been translated as eq_transᵗ" "Translating Coq.Init.Logic.eq_sym" "eq_sym has been translated as eq_symᵗ" "Translating MetaCoq.Translations.param_original.Id2.ID" "MetaCoq.Translations.param_original.Id2.ID was already translated" "Translating MetaCoq.Translations.param_original.Id2.myf" "myf has been translated as myfᵗ" Coq.Vectors.VectorDef.t has been translated. Coq.Arith.Even.even has been translated. File "./param_generous_packed.v", line 7, characters 0-30: Warning: Notation "exists _ .. _ , _" was already used in scope type_scope. [notation-overridden,parsing] File "./param_generous_packed.v", line 7, characters 0-30: Warning: Notation "{ _ : _ & _ }" was already used in scope type_scope. [notation-overridden,parsing] File "./param_generous_packed.v", line 7, characters 0-30: Warning: Notation "_ = _ :> _" was already used in scope type_scope. [notation-overridden,parsing] File "./param_generous_packed.v", line 7, characters 0-30: Warning: Notation "_ = _" was already used in scope type_scope. [notation-overridden,parsing] Coq.Init.Datatypes.list has been translated. "rev_type has been translated as rev_typeᵗ" Fresh universe MetaCoq.Translations.param_generous_packed.603 was added to the context. Fresh universe MetaCoq.Translations.param_generous_packed.604 was added to the context. Fresh universe MetaCoq.Translations.param_generous_packed.605 was added to the context. "Ty has been translated as Tyᵗ" Tyᵗ : El Tyᵗ : El Tyᵗ File "./param_original.v", line 261, characters 0-24: Warning: Notation "exists _ .. _ , _" was already used in scope type_scope. [notation-overridden,parsing] File "./param_original.v", line 261, characters 0-24: Warning: Notation "{ _ : _ & _ }" was already used in scope type_scope. [notation-overridden,parsing] File "./param_original.v", line 261, characters 0-24: Warning: Notation "_ = _ :> _" was already used in scope type_scope. [notation-overridden,parsing] File "./param_original.v", line 261, characters 0-24: Warning: Notation "_ = _" was already used in scope type_scope. [notation-overridden,parsing] "sigT has been translated as sigTᵗ" "~~~~~~~~~~~~~~~~~~" "Translating Coq.Init.Logic.eq" "Coq.Init.Logic.eq has been translated." "Translating MetaCoq.Translations.MiniHoTT.paths" "paths has been translated as pathsᵗ" "existT has been translated as existTᵗ" "Translating MetaCoq.Translations.param_original.Axioms.UIP" "UIP has been translated as UIPᵗ" "wFunext has been translated as wFunextᵗ" "~~~~~~~~~~~~~~~~~~" "Translating Coq.Init.Logic.eq" "Coq.Init.Logic.eq was already translated" "Translating MetaCoq.Translations.MiniHoTT.paths" "MetaCoq.Translations.MiniHoTT.paths was already translated" "Translating MetaCoq.Translations.MiniHoTT.Sect" "Sect has been translated as Sectᵗ" "Translating MetaCoq.Translations.MiniHoTT.idpath" "idpath has been translated as idpathᵗ" "Translating MetaCoq.Translations.MiniHoTT.paths_ind" "paths_ind has been translated as paths_indᵗ" "Translating MetaCoq.Translations.MiniHoTT.transport" "transport has been translated as transportᵗ" Finished transaction in 1.071 secs (0.906u,0.16s) (successful) "Translating MetaCoq.Translations.MiniHoTT.ap" "ap has been translated as apᵗ" "sigT_ind has been translated as sigT_indᵗ" "Translating MetaCoq.Translations.MiniHoTT.IsEquiv" "MetaCoq.Translations.MiniHoTT.IsEquiv has been translated." "paths has been translated as pathsᵗ" "idpath has been translated as idpathᵗ" "Translating MetaCoq.Translations.MiniHoTT.Equiv" "MetaCoq.Translations.MiniHoTT.Equiv has been translated." "paths_ind has been translated as paths_indᵗ" "Translating MetaCoq.Translations.param_original.Axioms.wUnivalence" "wUnivalence has been translated as wUnivalenceᵗ" Fresh universe MetaCoq.Translations.param_generous_packed.696 was added to the context. Fresh universe MetaCoq.Translations.param_generous_packed.697 was added to the context. Fresh universe MetaCoq.Translations.param_generous_packed.698 was added to the context. Fresh universe MetaCoq.Translations.param_generous_packed.699 was added to the context. Fresh universe MetaCoq.Translations.param_generous_packed.700 was added to the context. Fresh universe MetaCoq.Translations.param_generous_packed.701 was added to the context. Fresh universe MetaCoq.Translations.param_generous_packed.702 was added to the context. Fresh universe MetaCoq.Translations.param_generous_packed.703 was added to the context. Fresh universe MetaCoq.Translations.param_generous_packed.704 was added to the context. Fresh universe MetaCoq.Translations.param_generous_packed.705 was added to the context. Fresh universe MetaCoq.Translations.param_generous_packed.706 was added to the context. Fresh universe MetaCoq.Translations.param_generous_packed.707 was added to the context. Fresh universe MetaCoq.Translations.param_generous_packed.708 was added to the context. Fresh universe MetaCoq.Translations.param_generous_packed.709 was added to the context. Fresh universe MetaCoq.Translations.param_generous_packed.710 was added to the context. Fresh universe MetaCoq.Translations.param_generous_packed.711 was added to the context. Fresh universe MetaCoq.Translations.param_generous_packed.712 was added to the context. Fresh universe MetaCoq.Translations.param_generous_packed.713 was added to the context. Fresh universe MetaCoq.Translations.param_generous_packed.714 was added to the context. Fresh universe MetaCoq.Translations.param_generous_packed.715 was added to the context. Fresh universe MetaCoq.Translations.param_generous_packed.716 was added to the context. "Funext has been translated as Funextᵗ" Fresh universe MetaCoq.Translations.param_generous_packed.728 was added to the context. Fresh universe MetaCoq.Translations.param_generous_packed.729 was added to the context. Fresh universe MetaCoq.Translations.param_generous_packed.730 was added to the context. "FALSE has been translated as FALSEᵗ" "~~~~~~~~~~~~~~~~~~" "Translating Coq.Init.Logic.eq" "Coq.Init.Logic.eq was already translated" "Translating MetaCoq.Translations.MiniHoTT.paths" "MetaCoq.Translations.MiniHoTT.paths was already translated" "Translating MetaCoq.Translations.MiniHoTT.Sect" "MetaCoq.Translations.MiniHoTT.Sect was already translated" "Translating MetaCoq.Translations.MiniHoTT.idpath" "MetaCoq.Translations.MiniHoTT.idpath was already translated" "Translating MetaCoq.Translations.MiniHoTT.paths_ind" "MetaCoq.Translations.MiniHoTT.paths_ind was already translated" "Translating MetaCoq.Translations.MiniHoTT.transport" "MetaCoq.Translations.MiniHoTT.transport was already translated" "Translating MetaCoq.Translations.MiniHoTT.ap" "MetaCoq.Translations.MiniHoTT.ap was already translated" "UIP has been translated as UIPᵗ" "Translating MetaCoq.Translations.MiniHoTT.IsEquiv" "MetaCoq.Translations.MiniHoTT.IsEquiv was already translated" "Translating MetaCoq.Translations.param_original.Axioms.coe" "coe has been translated as coeᵗ" "False has been translated as Falseᵗ" "Translating MetaCoq.Translations.param_original.Axioms.Univalence'" "Univalence' has been translated as Univalence'ᵗ" "~~~~~~~~~~~~~~~~~~" "Translating Coq.Init.Logic.eq" "Coq.Init.Logic.eq was already translated" "Translating MetaCoq.Translations.MiniHoTT.paths" "MetaCoq.Translations.MiniHoTT.paths was already translated" "Translating MetaCoq.Translations.MiniHoTT.Sect" "MetaCoq.Translations.MiniHoTT.Sect was already translated" "Translating MetaCoq.Translations.MiniHoTT.idpath" "MetaCoq.Translations.MiniHoTT.idpath was already translated" "Translating MetaCoq.Translations.MiniHoTT.paths_ind" "MetaCoq.Translations.MiniHoTT.paths_ind was already translated" "Translating MetaCoq.Translations.MiniHoTT.transport" "MetaCoq.Translations.MiniHoTT.transport was already translated" "Translating MetaCoq.Translations.MiniHoTT.ap" "MetaCoq.Translations.MiniHoTT.ap was already translated" "Translating MetaCoq.Translations.MiniHoTT.IsEquiv" "MetaCoq.Translations.MiniHoTT.IsEquiv was already translated" "Translating MetaCoq.Translations.param_original.Axioms.coe" "MetaCoq.Translations.param_original.Axioms.coe was already translated" "Translating MetaCoq.Translations.param_original.Axioms.Univalence'" "MetaCoq.Translations.param_original.Axioms.Univalence' was already translated" "Translating MetaCoq.Translations.MiniHoTT.Equiv" "MetaCoq.Translations.MiniHoTT.Equiv was already translated" "Translating MetaCoq.Translations.MiniHoTT.equiv_fun" "equiv_fun has been translated as equiv_funᵗ" Fresh universe MetaCoq.Translations.param_generous_packed.764 was added to the context. Fresh universe MetaCoq.Translations.param_generous_packed.765 was added to the context. Fresh universe MetaCoq.Translations.param_generous_packed.766 was added to the context. Fresh universe MetaCoq.Translations.param_generous_packed.767 was added to the context. Fresh universe MetaCoq.Translations.param_generous_packed.768 was added to the context. Fresh universe MetaCoq.Translations.param_generous_packed.769 was added to the context. Fresh universe MetaCoq.Translations.param_generous_packed.770 was added to the context. Fresh universe MetaCoq.Translations.param_generous_packed.771 was added to the context. Fresh universe MetaCoq.Translations.param_generous_packed.772 was added to the context. Fresh universe MetaCoq.Translations.param_generous_packed.773 was added to the context. Fresh universe MetaCoq.Translations.param_generous_packed.774 was added to the context. Fresh universe MetaCoq.Translations.param_generous_packed.775 was added to the context. Fresh universe MetaCoq.Translations.param_generous_packed.776 was added to the context. Fresh universe MetaCoq.Translations.param_generous_packed.777 was added to the context. Fresh universe MetaCoq.Translations.param_generous_packed.778 was added to the context. Fresh universe MetaCoq.Translations.param_generous_packed.779 was added to the context. Fresh universe MetaCoq.Translations.param_generous_packed.780 was added to the context. Fresh universe MetaCoq.Translations.param_generous_packed.781 was added to the context. Fresh universe MetaCoq.Translations.param_generous_packed.782 was added to the context. Fresh universe MetaCoq.Translations.param_generous_packed.783 was added to the context. Fresh universe MetaCoq.Translations.param_generous_packed.784 was added to the context. Fresh universe MetaCoq.Translations.param_generous_packed.785 was added to the context. Fresh universe MetaCoq.Translations.param_generous_packed.786 was added to the context. Fresh universe MetaCoq.Translations.param_generous_packed.787 was added to the context. Fresh universe MetaCoq.Translations.param_generous_packed.788 was added to the context. Fresh universe MetaCoq.Translations.param_generous_packed.789 was added to the context. Fresh universe MetaCoq.Translations.param_generous_packed.790 was added to the context. Fresh universe MetaCoq.Translations.param_generous_packed.791 was added to the context. Fresh universe MetaCoq.Translations.param_generous_packed.792 was added to the context. Fresh universe MetaCoq.Translations.param_generous_packed.793 was added to the context. Fresh universe MetaCoq.Translations.param_generous_packed.794 was added to the context. Fresh universe MetaCoq.Translations.param_generous_packed.795 was added to the context. Fresh universe MetaCoq.Translations.param_generous_packed.796 was added to the context. Fresh universe MetaCoq.Translations.param_generous_packed.797 was added to the context. Fresh universe MetaCoq.Translations.param_generous_packed.798 was added to the context. Fresh universe MetaCoq.Translations.param_generous_packed.799 was added to the context. Fresh universe MetaCoq.Translations.param_generous_packed.800 was added to the context. Fresh universe MetaCoq.Translations.param_generous_packed.801 was added to the context. Fresh universe MetaCoq.Translations.param_generous_packed.802 was added to the context. Fresh universe MetaCoq.Translations.param_generous_packed.803 was added to the context. Fresh universe MetaCoq.Translations.param_generous_packed.804 was added to the context. Fresh universe MetaCoq.Translations.param_generous_packed.805 was added to the context. Fresh universe MetaCoq.Translations.param_generous_packed.806 was added to the context. Fresh universe MetaCoq.Translations.param_generous_packed.807 was added to the context. Fresh universe MetaCoq.Translations.param_generous_packed.808 was added to the context. Fresh universe MetaCoq.Translations.param_generous_packed.809 was added to the context. Fresh universe MetaCoq.Translations.param_generous_packed.810 was added to the context. "equiv has been translated as equivᵗ" "Translating MetaCoq.Translations.MiniHoTT.isequiv_idmap" "isequiv_idmap has been translated as isequiv_idmapᵗ" param_generous_packed.vo (real: 9.61, user: 8.61, sys: 0.95, mem: 892080 ko) COQC times_bool_fun.v "Translating MetaCoq.Translations.MiniHoTT.equiv_idmap" "equiv_idmap has been translated as equiv_idmapᵗ" File "./times_bool_fun.v", line 2, characters 0-68: Warning: Notation "exists _ .. _ , _" was already used in scope type_scope. [notation-overridden,parsing] File "./times_bool_fun.v", line 2, characters 0-68: Warning: Notation "{ _ : _ & _ }" was already used in scope type_scope. [notation-overridden,parsing] File "./times_bool_fun.v", line 2, characters 0-68: Warning: Notation "_ = _ :> _" was already used in scope type_scope. [notation-overridden,parsing] File "./times_bool_fun.v", line 2, characters 0-68: Warning: Notation "_ = _" was already used in scope type_scope. [notation-overridden,parsing] File "./times_bool_fun.v", line 15, characters 0-48: Warning: Declaring a scope implicitly is deprecated; use in advance an explicit "Declare Scope prod_scope.". [undeclared-scope,deprecated] "~~~~~~~~~~~~~~~~~~" "Translating Coq.Init.Logic.eq" "Translating MetaCoq.Translations.param_original.Axioms.equiv_paths" "Coq.Init.Logic.eq has been translated." "Translating MetaCoq.Translations.MiniHoTT.paths" "paths has been translated as pathsᵗ" "Translating Coq.Init.Logic.False" "Coq.Init.Logic.False has been translated." "Translating MetaCoq.Translations.times_bool_fun.NotFunext" "NotFunext has been translated as NotFunextᵗ" "equiv_paths has been translated as equiv_pathsᵗ" "notFunext has been translated as notFunextᵗ" "notη has been translated as notηᵗ" "~~~~~~~~~~~~~~~~~~" "Translating Coq.Init.Logic.eq" "Coq.Init.Logic.eq was already translated" "Translating MetaCoq.Translations.MiniHoTT.paths" "MetaCoq.Translations.MiniHoTT.paths was already translated" "Translating MetaCoq.Translations.times_bool_fun.UIP" "UIP has been translated as UIPᵗ" "~~~~~~~~~~~~~~~~~~" "Translating Coq.Init.Logic.eq" "Coq.Init.Logic.eq was already translated" "Translating MetaCoq.Translations.MiniHoTT.paths" "MetaCoq.Translations.MiniHoTT.paths was already translated" "Translating MetaCoq.Translations.times_bool_fun.wFunext" "wFunext has been translated as wFunextᵗ" "Translating Coq.Init.Logic.False" "Coq.Init.Logic.False was already translated" "Translating MetaCoq.Translations.param_original.Axioms.Univalence" "notwFunext has been translated as notwFunextᵗ" "Univalence has been translated as Univalenceᵗ" "idpath has been translated as idpathᵗ" "paths_ind has been translated as paths_indᵗ" "Translating MetaCoq.Translations.param_original.Axioms.UU'" "~~~~~~~~~~~~~~~~~~" "Translating Coq.Init.Logic.eq" "Coq.Init.Logic.eq was already translated" "Translating MetaCoq.Translations.MiniHoTT.paths" "MetaCoq.Translations.MiniHoTT.paths was already translated" "Translating MetaCoq.Translations.MiniHoTT.Sect" Fresh universe MetaCoq.Translations.times_bool_fun.576 was added to the context. Fresh universe MetaCoq.Translations.times_bool_fun.577 was added to the context. Fresh universe MetaCoq.Translations.times_bool_fun.578 was added to the context. Fresh universe MetaCoq.Translations.times_bool_fun.579 was added to the context. "Sect has been translated as Sectᵗ" "Translating MetaCoq.Translations.MiniHoTT.idpath" "MetaCoq.Translations.MiniHoTT.idpath was already translated" "UU' has been translated as UU'ᵗ" "Translating MetaCoq.Translations.MiniHoTT.paths_ind" "MetaCoq.Translations.MiniHoTT.paths_ind was already translated" "Translating MetaCoq.Translations.MiniHoTT.transport" "transport has been translated as transportᵗ" "Translating MetaCoq.Translations.MiniHoTT.ap" "ap has been translated as apᵗ" "Translating MetaCoq.Translations.MiniHoTT.IsEquiv" "MetaCoq.Translations.MiniHoTT.IsEquiv has been translated." "Translating MetaCoq.Translations.MiniHoTT.Equiv" param_original.vo (real: 18.98, user: 17.91, sys: 0.96, mem: 741808 ko) COQC param_binary.v "MetaCoq.Translations.MiniHoTT.Equiv has been translated." File "./param_binary.v", line 207, characters 23-24: Warning: Ignoring implicit binder declaration in unexpected position. [unexpected-implicit-declaration,syntax] File "./param_binary.v", line 207, characters 25-26: Warning: Ignoring implicit binder declaration in unexpected position. [unexpected-implicit-declaration,syntax] Coq.Init.Datatypes.nat has been translated. Coq.Init.Datatypes.bool has been translated. Coq.Init.Datatypes.list has been translated. "HD has been translated as HDᵗ" "MAP has been translated as MAPᵗ" param_binary.vo (real: 2.24, user: 1.93, sys: 0.29, mem: 556444 ko) COQC standard_model.v "Translating MetaCoq.Translations.times_bool_fun.wUnivalence" "wUnivalence has been translated as wUnivalenceᵗ" check_guarded: true check_positive: true check_universes: true cumulative sprop: false definitional uip: false "toto has been translated as totoᵗ" totoᵗ : unit -> (forall A : Type, A -> A) -> Type -> Type : unit -> (forall A : Type, A -> A) -> Type -> Type "FALSE has been translated as FALSEᵗ" "toto" "a has been translated as aᵗ" "T has been translated as Tᵗ" "tm has been translated as tmᵗ" standard_model.vo (real: 1.63, user: 1.34, sys: 0.28, mem: 549492 ko) Fresh universe MetaCoq.Translations.times_bool_fun.631 was added to the context. Fresh universe MetaCoq.Translations.times_bool_fun.632 was added to the context. Fresh universe MetaCoq.Translations.times_bool_fun.633 was added to the context. "isequiv_idmap has been translated as isequiv_idmapᵗ" Fresh universe MetaCoq.Translations.times_bool_fun.635 was added to the context. Fresh universe MetaCoq.Translations.times_bool_fun.636 was added to the context. Fresh universe MetaCoq.Translations.times_bool_fun.637 was added to the context. Fresh universe MetaCoq.Translations.times_bool_fun.638 was added to the context. Fresh universe MetaCoq.Translations.times_bool_fun.639 was added to the context. "equiv_idmap has been translated as equiv_idmapᵗ" Fresh universe MetaCoq.Translations.times_bool_fun.641 was added to the context. Fresh universe MetaCoq.Translations.times_bool_fun.642 was added to the context. Fresh universe MetaCoq.Translations.times_bool_fun.643 was added to the context. Fresh universe MetaCoq.Translations.times_bool_fun.644 was added to the context. Fresh universe MetaCoq.Translations.times_bool_fun.645 was added to the context. Fresh universe MetaCoq.Translations.times_bool_fun.646 was added to the context. Fresh universe MetaCoq.Translations.times_bool_fun.647 was added to the context. Fresh universe MetaCoq.Translations.times_bool_fun.648 was added to the context. Fresh universe MetaCoq.Translations.times_bool_fun.649 was added to the context. "UA has been translated as UAᵗ" "notUA has been translated as notUAᵗ" times_bool_fun.vo (real: 27.19, user: 25.86, sys: 1.20, mem: 857128 ko) COQC times_bool_fun2.v File "./times_bool_fun2.v", line 4, characters 0-83: Warning: Notation "exists _ .. _ , _" was already used in scope type_scope. [notation-overridden,parsing] File "./times_bool_fun2.v", line 4, characters 0-83: Warning: Notation "{ _ : _ & _ }" was already used in scope type_scope. [notation-overridden,parsing] File "./times_bool_fun2.v", line 4, characters 0-83: Warning: Notation "_ = _ :> _" was already used in scope type_scope. [notation-overridden,parsing] File "./times_bool_fun2.v", line 4, characters 0-83: Warning: Notation "_ = _" was already used in scope type_scope. [notation-overridden,parsing] "paths has been translated as pathsᵗ" "idpath has been translated as idpathᵗ" "paths_ind has been translated as paths_indᵗ" "transport has been translated as transportᵗ" Fresh universe MetaCoq.Translations.times_bool_fun2.269 was added to the context. "sigT has been translated as sigTᵗ" "projT1 has been translated as projT1ᵗ" "projT2 has been translated as projT2ᵗ" "existT has been translated as existTᵗ" Fresh universe MetaCoq.Translations.times_bool_fun2.377 was added to the context. Fresh universe MetaCoq.Translations.times_bool_fun2.378 was added to the context. Fresh universe MetaCoq.Translations.times_bool_fun2.379 was added to the context. Fresh universe MetaCoq.Translations.times_bool_fun2.380 was added to the context. Fresh universe MetaCoq.Translations.times_bool_fun2.381 was added to the context. "isequiv has been translated as isequivᵗ" Fresh universe MetaCoq.Translations.times_bool_fun2.383 was added to the context. Fresh universe MetaCoq.Translations.times_bool_fun2.384 was added to the context. Fresh universe MetaCoq.Translations.times_bool_fun2.385 was added to the context. "equiv has been translated as equivᵗ" "eq has been translated as eqᵗ" "inverse has been translated as inverseᵗ" Fresh universe MetaCoq.Translations.times_bool_fun2.416 was added to the context. Fresh universe MetaCoq.Translations.times_bool_fun2.417 was added to the context. "contr has been translated as contrᵗ" "weakFunext has been translated as weakFunextᵗ" times_bool_fun2.vo (real: 7.77, user: 7.23, sys: 0.50, mem: 614752 ko) Time | Peak Mem | File Name ----------------------------------------------- 1m14.87s | 892080 ko | Total Time / Peak Mem ----------------------------------------------- 0m25.86s | 857128 ko | times_bool_fun.vo 0m17.91s | 741808 ko | param_original.vo 0m08.61s | 892080 ko | param_generous_packed.vo 0m07.23s | 614752 ko | times_bool_fun2.vo 0m04.41s | 348856 ko | MiniHoTT.vo 0m03.42s | 350716 ko | MiniHoTT_paths.vo 0m01.93s | 556444 ko | param_binary.vo 0m01.82s | 554420 ko | translation_utils.vo 0m01.49s | 553352 ko | param_cheap_packed.vo 0m01.34s | 549492 ko | standard_model.vo 0m00.86s | 500064 ko | sigma.vo make[3]: Leaving directory '/builds/coq/coq/_build_ci/metacoq/translations' make -f Makefile.coq install make[3]: Entering directory '/builds/coq/coq/_build_ci/metacoq/translations' INSTALL sigma.vo /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/Translations/ INSTALL MiniHoTT.vo /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/Translations/ INSTALL MiniHoTT_paths.vo /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/Translations/ INSTALL translation_utils.vo /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/Translations/ INSTALL param_original.vo /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/Translations/ INSTALL param_cheap_packed.vo /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/Translations/ INSTALL param_generous_packed.vo /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/Translations/ INSTALL times_bool_fun.vo /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/Translations/ INSTALL times_bool_fun2.vo /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/Translations/ INSTALL param_binary.vo /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/Translations/ INSTALL standard_model.vo /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/Translations/ INSTALL sigma.v /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/Translations/ INSTALL MiniHoTT.v /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/Translations/ INSTALL MiniHoTT_paths.v /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/Translations/ INSTALL translation_utils.v /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/Translations/ INSTALL param_original.v /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/Translations/ INSTALL param_cheap_packed.v /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/Translations/ INSTALL param_generous_packed.v /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/Translations/ INSTALL times_bool_fun.v /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/Translations/ INSTALL times_bool_fun2.v /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/Translations/ INSTALL param_binary.v /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/Translations/ INSTALL standard_model.v /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/Translations/ INSTALL sigma.glob /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/Translations/ INSTALL MiniHoTT.glob /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/Translations/ INSTALL MiniHoTT_paths.glob /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/Translations/ INSTALL translation_utils.glob /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/Translations/ INSTALL param_original.glob /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/Translations/ INSTALL param_cheap_packed.glob /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/Translations/ INSTALL param_generous_packed.glob /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/Translations/ INSTALL times_bool_fun.glob /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/Translations/ INSTALL times_bool_fun2.glob /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/Translations/ INSTALL param_binary.glob /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/Translations/ INSTALL standard_model.glob /builds/coq/coq/_install_ci/lib/coq//user-contrib/MetaCoq/Translations/ make[4]: Entering directory '/builds/coq/coq/_build_ci/metacoq/translations' make[4]: Leaving directory '/builds/coq/coq/_build_ci/metacoq/translations' make[3]: Leaving directory '/builds/coq/coq/_build_ci/metacoq/translations' make[2]: Leaving directory '/builds/coq/coq/_build_ci/metacoq/translations' make[1]: Leaving directory '/builds/coq/coq/_build_ci/metacoq' Aggregating timing log... Traceback (most recent call last): File "./tools/make-one-time-file.py", line 13, in stats_dict = get_times_and_mems(args.FILE_NAME, use_real=args.real, include_mem=args.include_mem) File "/builds/coq/coq/tools/TimeFileMaker.py", line 161, in get_times_and_mems return merge_dicts(get_times_of_lines(lines, use_real=use_real), File "/builds/coq/coq/tools/TimeFileMaker.py", line 156, in get_times_of_lines return dict((name, {TIME_KEY:reformat_time_string(time)}) for name, time in times) File "/builds/coq/coq/tools/TimeFileMaker.py", line 156, in return dict((name, {TIME_KEY:reformat_time_string(time)}) for name, time in times) File "/builds/coq/coq/tools/TimeFileMaker.py", line 104, in reformat_time_string seconds, milliseconds = time.split('.') ValueError: too many values to unpack Makefile.ci:90: recipe for target 'ci-metacoq' failed make: *** [ci-metacoq] Error 1 section_end:1598965182:build_script section_start:1598965182:after_script section_end:1598965184:after_script section_start:1598965184:upload_artifacts_on_failure section_end:1598965189:upload_artifacts_on_failure ERROR: Job failed: exit code 1  coq-8.20.0/test-suite/precomputed-time-tests/non-utf8/000077500000000000000000000000001466560755400226145ustar00rootroot00000000000000coq-8.20.0/test-suite/precomputed-time-tests/non-utf8/run.sh000077500000000000000000000010651466560755400237610ustar00rootroot00000000000000#!/usr/bin/env bash . ../template/init.sh cd "$(dirname "${BASH_SOURCE[0]}")" $make_one_time_file time-of-build.log.in time-of-build-pretty.log || exit $? diff -u time-of-build-pretty.log.expected time-of-build-pretty.log || exit $? cat time-of-build.log.in | $make_one_time_file - time-of-build-pretty.log || exit $? diff -u time-of-build-pretty.log.expected time-of-build-pretty.log || exit $? ($make_one_time_file time-of-build.log.in - || exit $?) > time-of-build-pretty.log diff -u time-of-build-pretty.log.expected time-of-build-pretty.log || exit $? coq-8.20.0/test-suite/precomputed-time-tests/non-utf8/time-of-build-pretty.log.expected000066400000000000000000000627641466560755400311200ustar00rootroot00000000000000 Time | Peak Mem | File Name ------------------------------------------------------------------------------------ 39m02.52s | 1980772 ko | Total Time / Peak Mem ------------------------------------------------------------------------------------ 3m26.96s | 1980772 ko | Kami/Ex/Multiplier64 3m22.44s | 899104 ko | bedrock2/compiler/src/FlatToRiscv 2m19.56s | 1730872 ko | bedrock2/deps/riscv-coq/src/Proofs/DecodeEncodeI 2m11.59s | 1411224 ko | Kami/Ex/Divider64 1m44.22s | 997556 ko | bedrock2/deps/riscv-coq/src/Proofs/DecodeEncodeCSR 1m44.11s | 1131272 ko | Kami/Ex/Multiplier32 1m41.50s | 564436 ko | bedrock2/bedrock2/src/Examples/bsearch 1m08.57s | 1312068 ko | Kami/Ex/ProcFDInl 1m07.92s | 590104 ko | bedrock2/deps/riscv-coq/src/Platform/MinimalMMIO 1m01.07s | 798376 ko | Kami/Ex/FifoCorrect 1m00.73s | 847228 ko | Kami/Ex/Divider32 0m50.15s | 573560 ko | bedrock2/deps/riscv-coq/src/Proofs/EncodeBound 0m40.64s | 588832 ko | bedrock2/bedrock2/src/Examples/FE310CompilerDemo 0m40.29s | 668564 ko | Kami/InlineFacts 0m39.12s | 563328 ko | Kami/Renaming 0m37.44s | 672092 ko | Kami/Ex/SimpleFifoCorrect 0m37.08s | 601836 ko | Kami/SemFacts 0m36.08s | 562540 ko | ─preprbedrock2/deps/coqutil/src/Map/TestGoals 0m32.76s | 885880 ko | Kami/ModularFacts 0m28.68s | 639092 ko | bedrock2/deps/riscv-coq/src/Proofs/DecodeEncodeA 0m26.60s | 741048 ko | Kami/Lib/Word 0m26.55s | 632108 ko | bedrock2/deps/riscv-coq/src/Proofs/invert_encode_SB 0m26.45s | 605916 ko | bedrock2/deps/riscv-coq/src/Proofs/DecodeEncodeA64 0m25.80s | 650288 ko | bedrock2/deps/riscv-coq/src/Proofs/DecodeEncodeI64 0m25.47s | 729768 ko | bedrock2/processor/src/KamiRiscv 0m23.66s | 610544 ko | bedrock2/compiler/src/EmitsValid 0m22.68s | 653084 ko | Kami/Ex/InDepthTutorial 0m22.60s | 589708 ko | bedrock2/deps/riscv-coq/src/Proofs/DecodeEncodeM 0m21.68s | 506640 ko | Kami/Specialize 0m21.59s | 525428 ko | bedrock2/bedrock2/src/Examples/lightbulb 0m19.20s | 526372 ko | bedrock2/deps/riscv-coq/src/Proofs/invert_encode_I_shift_66 0m19.19s | 580040 ko | bedrock2/deps/riscv-coq/src/Proofs/invert_encode_UJ 0m17.33s | 724164 ko | Kami/Ex/ProcDecInl 0m15.63s | 555732 ko | bedrock2/compiler/src/examples/MMIO 0m14.78s | 561068 ko | Kami/ParametricSyntax 0m12.11s | 518652 ko | bedrock2/deps/riscv-coq/src/Proofs/invert_encode_S 0m11.74s | 501100 ko | bedrock2/deps/riscv-coq/src/Platform/MetricMinimal 0m09.95s | 568468 ko | bedrock2/deps/coqutil/src/Word/Properties 0m09.77s | 523092 ko | bedrock2/deps/riscv-coq/src/Proofs/DecodeEncodeM64 0m09.56s | 537308 ko | Kami/Lib/FMap 0m09.35s | 496100 ko | bedrock2/bedrock2/src/Examples/ipow 0m09.26s | 504428 ko | Kami/StepDet 0m09.19s | 663884 ko | bedrock2/bedrock2/src/WeakestPreconditionProperties 0m09.16s | 495544 ko | bedrock2/deps/riscv-coq/src/Proofs/invert_encode_Fence 0m08.98s | 511956 ko | Kami/RefinementFacts 0m08.68s | 494004 ko | bedrock2/deps/riscv-coq/src/Proofs/invert_encode_R_atomic 0m08.26s | 505664 ko | bedrock2/compiler/src/FlatToRiscv32 0m07.55s | 534616 ko | Kami/Ex/Fifo 0m07.54s | 454624 ko | ─ensbedrock2/deps/coqutil/src/Map/SlowGoals 0m06.99s | 482444 ko | bedrock2/deps/riscv-coq/src/Platform/Minimal 0m06.89s | 480324 ko | bedrock2/compiler/src/GoFlatToRiscv 0m06.82s | 485168 ko | bedrock2/deps/riscv-coq/src/Proofs/invert_encode_I 0m06.72s | 485544 ko | bedrock2/deps/riscv-coq/src/Proofs/invert_encode_FenceI 0m06.50s | 501300 ko | Kami/Semantics 0m06.36s | 478692 ko | bedrock2/deps/riscv-coq/src/Proofs/invert_encode_I_shift_57 0m06.32s | 478812 ko | bedrock2/deps/riscv-coq/src/Proofs/invert_encode_R 0m06.24s | 509232 ko | Kami/PartialInlineFacts 0m06.02s | 486764 ko | bedrock2/deps/coqutil/src/Map/Properties 0m05.62s | 535096 ko | Kami/Ex/ProcThreeStage 0m05.56s | 507520 ko | Kami/Decomposition 0m05.12s | 505436 ko | Kami/Amortization 0m05.07s | 561800 ko | Kami/Ex/SCMMInl 0m04.71s | 470712 ko | bedrock2/deps/riscv-coq/src/Proofs/invert_encode_I_system 0m04.46s | 468412 ko | bedrock2/deps/riscv-coq/src/Proofs/invert_encode_U 0m04.19s | 509168 ko | Kami/ParametricInline 0m04.13s | 512264 ko | Kami/Ex/ProcDec 0m03.88s | 478956 ko | bedrock2/bedrock2/src/Examples/swap 0m03.81s | 510132 ko | Kami/Ex/SC 0m03.64s | 472892 ko | bedrock2/bedrock2/src/FE310CSemantics 0m03.39s | 517872 ko | Kami/Tutorial 0m03.30s | 510956 ko | bedrock2/compiler/src/examples/Fibonacci 0m03.17s | 486656 ko | Kami/Label 0m03.17s | 492768 ko | Kami/ModuleBoundEx 0m03.10s | 492424 ko | Kami/ParametricEquiv 0m03.06s | 499932 ko | Kami/Wf 0m02.50s | 505076 ko | bedrock2/compiler/src/Pipeline 0m02.42s | 526316 ko | Kami/Ex/ProcFDInv 0m02.42s | 489812 ko | Kami/ParamDup 0m02.39s | 487424 ko | Kami/Duplicate 0m02.19s | 489072 ko | Kami/ParametricWf 0m02.11s | 508168 ko | Kami/Ex/ProcFetchDecode 0m02.06s | 465924 ko | bedrock2/bedrock2/src/Examples/ARPResponder 0m01.94s | 494008 ko | Kami/MapReifyEx 0m01.89s | 479116 ko | Kami/Syntax 0m01.88s | 521816 ko | Kami/Ex/IsaRv32/PgmGcd 0m01.87s | 522776 ko | Kami/Ex/IsaRv32/PgmBankerWorker1 0m01.87s | 519908 ko | Kami/Ex/IsaRv32/PgmMatMulReport 0m01.85s | 520188 ko | Kami/Ex/IsaRv32/PgmBankerWorker3 0m01.83s | 524584 ko | Kami/Ex/IsaRv32/PgmDekker2 0m01.83s | 522312 ko | Kami/Ex/IsaRv32/PgmFact 0m01.83s | 519240 ko | Kami/Ex/IsaRv32/PgmMatMulNormal1 0m01.81s | 522124 ko | Kami/Ex/IsaRv32/PgmBankerInit 0m01.81s | 521416 ko | Kami/Ex/IsaRv32/PgmMatMulInit 0m01.81s | 519724 ko | Kami/Ex/IsaRv32/PgmMatMulNormal2 0m01.81s | 495792 ko | Kami/Ex/RegFile 0m01.80s | 520460 ko | Kami/Ex/IsaRv32/PgmBankerWorker2 0m01.80s | 519680 ko | Kami/Ex/IsaRv32/PgmPeterson1 0m01.80s | 519696 ko | Kami/Ex/IsaRv32/PgmPeterson2 0m01.80s | 461200 ko | bedrock2/bedrock2/src/ptsto_bytes 0m01.78s | 520604 ko | Kami/Ex/IsaRv32/PgmDekker1 0m01.78s | 495196 ko | Kami/Ex/ProcDecInv 0m01.76s | 433996 ko | bedrock2/bedrock2/src/Map/SeparationLogic 0m01.75s | 521896 ko | Kami/Ex/IsaRv32/PgmBsort 0m01.74s | 522080 ko | Kami/Ex/IsaRv32/PgmHanoi 0m01.70s | 490720 ko | Kami/Ex/NativeFifo 0m01.52s | 429812 ko | Kami/Lib/NatLib 0m01.51s | 473632 ko | bedrock2/processor/src/Test 0m01.48s | 476176 ko | Kami/SymEval 0m01.47s | 497260 ko | Kami/Ex/MemAtomic 0m01.44s | 498104 ko | Kami/Ex/ProcThreeStInv 0m01.35s | 457132 ko | bedrock2/bedrock2/src/Array 0m01.34s | 461368 ko | bedrock2/bedrock2/src/TailRecursion 0m01.30s | 509008 ko | Kami/Ex/IsaRv32 0m01.29s | 485936 ko | Kami/ModuleBound 0m01.29s | 418180 ko | bedrock2/bedrock2/src/Byte 0m01.25s | 435736 ko | bedrock2/bedrock2/src/Examples/chacha20 0m01.19s | 495240 ko | Kami/Ex/ProcThreeStDec 0m01.18s | 457564 ko | bedrock2/bedrock2/src/Scalars 0m01.17s | 444076 ko | bedrock2/deps/riscv-coq/src/Utility/ListLib 0m01.15s | 487776 ko | Kami/Ex/OneEltFifo 0m01.14s | 449412 ko | bedrock2/bedrock2/src/Examples/Trace 0m01.13s | 457912 ko | bedrock2/bedrock2/src/TODO_absint 0m01.10s | 419492 ko | bedrock2/compiler/lib/LibTactics 0m01.08s | 421756 ko | Kami/Lib/StringAsList 0m01.00s | 442912 ko | bedrock2/deps/coqutil/src/Z/ZLib 0m00.99s | 435576 ko | Kami/Lib/Struct 0m00.98s | 426872 ko | bedrock2/compiler/src/examples/toposort 0m00.95s | 441452 ko | bedrock2/deps/riscv-coq/src/Utility/prove_Zeq_bitwise 0m00.94s | 450352 ko | bedrock2/deps/riscv-coq/src/Proofs/DecodeEncodeProver 0m00.94s | 454504 ko | bedrock2/deps/riscv-coq/src/Spec/ExecuteI 0m00.93s | 493232 ko | Kami/Ex/ProcDecSC 0m00.92s | 550756 ko | Kami/Ex/IsaRv32PgmExt 0m00.90s | 421100 ko | Kami/Lib/Indexer 0m00.89s | 484828 ko | Kami/Tactics 0m00.88s | 427540 ko | bedrock2/compiler/src/util/ListLib 0m00.87s | 460284 ko | Kami/Notations 0m00.84s | 443020 ko | bedrock2/bedrock2/src/Memory 0m00.83s | 526908 ko | Kami/Ex/ProcFDCorrect 0m00.83s | 439724 ko | bedrock2/deps/riscv-coq/src/Utility/ZBitOps 0m00.82s | 507796 ko | Kami/Ex/IsaRv32Pgm 0m00.82s | 422368 ko | Kami/Lib/ilist 0m00.81s | 488468 ko | Kami/Ex/ProcDecSCN 0m00.81s | 439216 ko | bedrock2/deps/coqutil/src/Z/BitOps 0m00.80s | 527136 ko | Kami/Ex/ProcFourStDec 0m00.80s | 499980 ko | bedrock2/compiler/src/examples/EditDistExample 0m00.79s | 477872 ko | Kami/Ext/BSyntax 0m00.79s | 488532 ko | Kami/Ext/Extraction 0m00.77s | 486708 ko | Kami/ParametricInlineLtac 0m00.76s | 409784 ko | bedrock2/deps/riscv-coq/src/Platform/Example64Literal 0m00.76s | 459200 ko | bedrock2/deps/riscv-coq/src/Spec/MetricPrimitives 0m00.75s | 490144 ko | Kami/Ex/ProcThreeStInl 0m00.74s | 485920 ko | Kami/Kami 0m00.74s | 501084 ko | bedrock2/compiler/src/examples/CompileExamples 0m00.74s | 505316 ko | bedrock2/compiler/src/examples/swap_bytes_over_uart_hexdump 0m00.74s | 460380 ko | bedrock2/deps/riscv-coq/src/Platform/MinimalLogging 0m00.72s | 473852 ko | Kami/Substitute 0m00.72s | 458732 ko | bedrock2/compiler/src/examples/TestExprImp 0m00.72s | 457772 ko | bedrock2/deps/riscv-coq/src/Spec/Primitives 0m00.71s | 452980 ko | Kami/Ex/MemTypes 0m00.71s | 483356 ko | bedrock2/compiler/src/examples/InlineAssemblyMacro 0m00.71s | 459820 ko | bedrock2/compiler/src/examples/TestFlatImp 0m00.71s | 449484 ko | bedrock2/deps/riscv-coq/src/Platform/Memory 0m00.71s | 446048 ko | bedrock2/deps/riscv-coq/src/Spec/Decode 0m00.70s | 469696 ko | Kami/Inline 0m00.70s | 423260 ko | Kami/Lib/StringAsOT 0m00.69s | 466532 ko | bedrock2/compiler/src/FlatToRiscvDef 0m00.68s | 447424 ko | bedrock2/compiler/src/Rem4 0m00.67s | 474056 ko | Kami/SymEvalTac 0m00.67s | 446424 ko | bedrock2/compiler/src/SimplWordExpr 0m00.67s | 446648 ko | bedrock2/deps/riscv-coq/src/Utility/Encode 0m00.66s | 441912 ko | bedrock2/bedrock2/src/Semantics 0m00.63s | 420276 ko | Kami/Lib/StringStringAsOT 0m00.63s | 426168 ko | bedrock2/deps/coqutil/src/Datatypes/PropSet 0m00.61s | 446012 ko | bedrock2/compiler/src/UnmappedMemForExtSpec 0m00.61s | 357880 ko | bedrock2/deps/riscv-coq/src/Utility/Monads 0m00.60s | 426440 ko | bedrock2/deps/coqutil/src/Map/SortedList 0m00.59s | 442252 ko | Kami/Synthesize 0m00.59s | 371952 ko | bedrock2/compiler/src/util/Common 0m00.59s | 440596 ko | bedrock2/deps/coqutil/src/Map/SortedListWord 0m00.58s | 415316 ko | bedrock2/deps/coqutil/src/Word/Naive 0m00.58s | 408744 ko | bedrock2/deps/riscv-coq/src/Utility/runsToNonDet_Run 0m00.57s | 403188 ko | bedrock2/bedrock2/src/BasicC64Semantics 0m00.57s | 358716 ko | bedrock2/deps/riscv-coq/src/Utility/Utility 0m00.56s | 432120 ko | Kami/Lib/WordSupport 0m00.56s | 410516 ko | bedrock2/bedrock2/src/WeakestPrecondition 0m00.55s | 413664 ko | Kami/Lib/StringEq 0m00.55s | 387552 ko | bedrock2/bedrock2/src/BasicC32Semantics 0m00.55s | 420416 ko | bedrock2/compiler/src/examples/highlevel/FuncMut 0m00.55s | 401008 ko | bedrock2/deps/riscv-coq/src/Spec/ExecuteI64 0m00.55s | 376020 ko | bedrock2/deps/riscv-coq/src/Utility/DefaultMemImpl32 0m00.54s | 310296 ko | bedrock2/bedrock2/src/Examples/MultipleReturnValues 0m00.53s | 386872 ko | bedrock2/compiler/src/RegAlloc2 0m00.53s | 387416 ko | bedrock2/deps/riscv-coq/src/Spec/ExecuteM 0m00.52s | 371960 ko | bedrock2/bedrock2/src/ProgramLogic 0m00.52s | 374676 ko | bedrock2/deps/riscv-coq/src/Platform/Run 0m00.52s | 375816 ko | bedrock2/deps/riscv-coq/src/Spec/ExecuteM64 0m00.52s | 375840 ko | bedrock2/deps/riscv-coq/src/Utility/DefaultMemImpl64 0m00.52s | 346660 ko | bedrock2/deps/riscv-coq/src/Utility/Words32Naive 0m00.50s | 322924 ko | bedrock2/bedrock2/src/BasicCSyntax 0m00.50s | 385968 ko | bedrock2/compiler/src/Basic32Semantics 0m00.50s | 389304 ko | bedrock2/compiler/src/RegAlloc3 0m00.49s | 411496 ko | bedrock2/bedrock2/src/BytedumpTest 0m00.49s | 411496 ko | bedrock2/bedrock2/src/BytedumpTestα 0m00.49s | 365272 ko | bedrock2/deps/coqutil/src/Map/Z_keyed_SortedListMap 0m00.49s | 375808 ko | bedrock2/deps/riscv-coq/src/Spec/Machine 0m00.49s | 360632 ko | bedrock2/deps/riscv-coq/src/Utility/MkMachineWidth 0m00.49s | 346980 ko | bedrock2/deps/riscv-coq/src/Utility/Words64Naive 0m00.48s | 276676 ko | bedrock2/bedrock2/src/ToCString 0m00.48s | 352200 ko | bedrock2/compiler/src/SeparationLogic 0m00.48s | 375156 ko | bedrock2/deps/coqutil/src/Decidable 0m00.48s | 362608 ko | bedrock2/deps/riscv-coq/src/Platform/MetricRiscvMachine 0m00.48s | 370692 ko | bedrock2/deps/riscv-coq/src/Platform/RiscvMachine 0m00.47s | 321560 ko | bedrock2/bedrock2/src/BasicC64Syntax 0m00.47s | 338992 ko | bedrock2/deps/riscv-coq/src/Spec/PseudoInstructions 0m00.46s | 351756 ko | bedrock2/compiler/src/ZNameGen 0m00.46s | 344552 ko | bedrock2/deps/riscv-coq/src/Platform/MetricLogging 0m00.45s | 350576 ko | bedrock2/compiler/src/RegAllocAnnotatedNotations 0m00.45s | 358800 ko | bedrock2/processor/src/KamiWord 0m00.44s | 305528 ko | bedrock2/deps/coqutil/src/Map/SortedListString_test 0m00.44s | 321736 ko | bedrock2/deps/coqutil/src/Tactics/Tactics 0m00.44s | 336624 ko | bedrock2/deps/riscv-coq/src/Spec/Execute 0m00.44s | 340268 ko | bedrock2/deps/riscv-coq/src/Utility/InstructionNotations 0m00.43s | 289244 ko | bedrock2/bedrock2/src/Map/Separation 0m00.43s | 362292 ko | bedrock2/compiler/src/RiscvWordProperties 0m00.43s | 321032 ko | bedrock2/deps/riscv-coq/src/Spec/VirtualMemory 0m00.43s | 313976 ko | bedrock2/deps/riscv-coq/src/Utility/InstructionCoercions 0m00.42s | 374624 ko | bedrock2/deps/riscv-coq/src/Proofs/DecodeEncode 0m00.40s | 282384 ko | bedrock2/compiler/src/util/Tactics 0m00.40s | 323944 ko | bedrock2/deps/coqutil/src/Map/Interface 0m00.39s | 303504 ko | bedrock2/deps/coqutil/src/Z/HexNotation 0m00.38s | 319992 ko | Kami/Lib/CommonTactics 0m00.38s | 363832 ko | Kami/Lib/Nomega 0m00.38s | 294268 ko | bedrock2/bedrock2/src/ZNamesSyntax 0m00.37s | 316400 ko | bedrock2/deps/coqutil/src/Map/Funext 0m00.37s | 295668 ko | bedrock2/deps/riscv-coq/src/Utility/div_mod_to_quot_rem 0m00.36s | 271052 ko | Kami/Ex/Names 0m00.36s | 338456 ko | Kami/Lib/Concat 0m00.36s | 272052 ko | bedrock2/bedrock2/src/string2ident 0m00.36s | 298624 ko | bedrock2/compiler/src/Simp 0m00.36s | 312496 ko | bedrock2/deps/coqutil/src/Map/Solver 0m00.36s | 298516 ko | bedrock2/deps/riscv-coq/src/Utility/nat_div_mod_to_quot_rem 0m00.35s | 299684 ko | Kami/Lib/Misc 0m00.35s | 272888 ko | bedrock2/bedrock2/src/Examples/StructAccess 0m00.35s | 267768 ko | bedrock2/bedrock2/src/StructNotations 0m00.35s | 295952 ko | bedrock2/deps/coqutil/src/Map/Empty_set_keyed_map 0m00.35s | 289456 ko | bedrock2/deps/coqutil/src/Map/SortedListString 0m00.34s | 328692 ko | Kami/Lib/Reflection 0m00.34s | 272812 ko | bedrock2/bedrock2/src/Bytedump 0m00.34s | 294376 ko | bedrock2/deps/riscv-coq/src/Utility/Tactics 0m00.33s | 301112 ko | bedrock2/bedrock2/src/NotationsCustomEntry 0m00.33s | 289700 ko | bedrock2/compiler/src/util/MyOmega 0m00.32s | 274924 ko | bedrock2/bedrock2/src/Hexdump 0m00.32s | 286108 ko | bedrock2/compiler/src/NameGen 0m00.31s | 301996 ko | bedrock2/compiler/lib/LibTacticsMin 0m00.30s | 252388 ko | bedrock2/bedrock2/src/StringNamesSyntax 0m00.30s | 282580 ko | bedrock2/compiler/src/util/Set 0m00.30s | 290132 ko | bedrock2/compiler/src/util/SetSolverTests 0m00.29s | 252176 ko | bedrock2/deps/coqutil/src/Datatypes/String 0m00.27s | 227732 ko | bedrock2/deps/coqutil/src/Word/LittleEndian 0m00.27s | 255852 ko | bedrock2/deps/riscv-coq/src/Utility/MonadTests 0m00.26s | 238732 ko | bedrock2/deps/coqutil/src/Z/div_mod_to_equations 0m00.23s | 212520 ko | bedrock2/deps/riscv-coq/src/Utility/MonadT 0m00.19s | 172428 ko | bedrock2/bedrock2/src/NotationsInConstr 0m00.19s | 180476 ko | bedrock2/deps/coqutil/src/Datatypes/HList 0m00.17s | 180940 ko | Kami/Lib/VectorFacts 0m00.17s | 184664 ko | bedrock2/deps/riscv-coq/src/Utility/JMonad 0m00.14s | 160816 ko | Kami/Lib/DepEq 0m00.13s | 142092 ko | Kami/Lib/FinNotations 0m00.13s | 144616 ko | bedrock2/bedrock2/src/ListPred 0m00.13s | 149744 ko | bedrock2/bedrock2/src/Variables 0m00.13s | 142420 ko | bedrock2/deps/coqutil/src/Datatypes/List 0m00.12s | 146976 ko | bedrock2/deps/riscv-coq/src/Utility/MonadNotations 0m00.09s | 116312 ko | bedrock2/bedrock2/src/Lift1Prop 0m00.09s | 108600 ko | bedrock2/deps/coqutil/src/Datatypes/Option 0m00.09s | 93184 ko | bedrock2/deps/coqutil/src/Datatypes/Prod 0m00.07s | 87856 ko | Kami/Lib/BasicLogic 0m00.07s | 93508 ko | bedrock2/bedrock2/src/Syntax 0m00.06s | 76484 ko | Kami/Lib/DepEqNat 0m00.06s | 67708 ko | bedrock2/deps/coqutil/src/Macros/symmetry 0m00.05s | 56680 ko | bedrock2/compiler/lib/fiat_crypto_tactics/Not 0m00.05s | 70976 ko | bedrock2/compiler/src/util/Misc 0m00.05s | 65768 ko | bedrock2/deps/riscv-coq/src/Utility/PowerFunc 0m00.05s | 65120 ko | bedrock2/deps/riscv-coq/src/Utility/runsToNonDet 0m00.04s | 57444 ko | bedrock2/bedrock2/src/Markers 0m00.04s | 56396 ko | bedrock2/bedrock2/src/Notations 0m00.04s | 55660 ko | bedrock2/compiler/lib/fiat_crypto_tactics/Test 0m00.04s | 57340 ko | bedrock2/compiler/lib/fiat_crypto_tactics/UniquePose 0m00.04s | 57364 ko | bedrock2/compiler/src/NoActionSyntaxParams 0m00.04s | 56364 ko | bedrock2/compiler/src/eqexact 0m00.04s | 55764 ko | bedrock2/compiler/src/examples/highlevel/For 0m00.04s | 56680 ko | bedrock2/compiler/src/on_hyp_containing 0m00.04s | 58420 ko | bedrock2/compiler/src/util/Learning 0m00.04s | 56232 ko | bedrock2/deps/coqutil/src/Datatypes/PrimitivePair 0m00.04s | 54100 ko | bedrock2/deps/coqutil/src/Macros/subst 0m00.04s | 54384 ko | bedrock2/deps/coqutil/src/Macros/unique 0m00.04s | 55016 ko | bedrock2/deps/coqutil/src/Tactics/eabstract 0m00.04s | 55296 ko | bedrock2/deps/coqutil/src/Tactics/letexists 0m00.04s | 54916 ko | bedrock2/deps/coqutil/src/Tactics/rdelta 0m00.04s | 56184 ko | bedrock2/deps/coqutil/src/Tactics/syntactic_unify 0m00.04s | 54440 ko | bedrock2/deps/coqutil/src/dlet 0m00.04s | 54804 ko | bedrock2/deps/coqutil/src/sanity 0m00.04s | 56096 ko | bedrock2/deps/riscv-coq/src/Utility/MMIOTrace 0m00.03s | 54716 ko | bedrock2/compiler/src/util/LogGoal coq-8.20.0/test-suite/precomputed-time-tests/non-utf8/time-of-build.log.in000066400000000000000000006620031466560755400263700ustar00rootroot00000000000000bedrock2/deps/coqutil/src/Tactics/eabstract (real: 0.17, user: 0.04, sys: 0.03, mem: 55016 ko) bedrock2/deps/coqutil/src/sanity (real: 0.18, user: 0.04, sys: 0.03, mem: 54804 ko) bedrock2/deps/coqutil/src/Tactics/letexists (real: 0.17, user: 0.04, sys: 0.03, mem: 55296 ko) bedrock2/deps/coqutil/src/Tactics/rdelta (real: 0.17, user: 0.04, sys: 0.04, mem: 54916 ko) bedrock2/deps/coqutil/src/Macros/subst (real: 0.16, user: 0.04, sys: 0.03, mem: 54100 ko) bedrock2/deps/coqutil/src/dlet (real: 0.17, user: 0.04, sys: 0.03, mem: 54440 ko) File "bedrock2/deps/coqutil/src/Datatypes/PrimitivePair.v", line 9, characters 2-67: Warning: Notation "_ * _" was already used in scope type_scope. [notation-overridden,parsing] File "bedrock2/deps/coqutil/src/Datatypes/PrimitivePair.v", line 11, characters 2-63: Warning: Notation "{ _ & _ }" was already used in scope type_scope. [notation-overridden,parsing] File "bedrock2/deps/coqutil/src/Datatypes/PrimitivePair.v", line 14, characters 2-67: Warning: Notation "{ _ : _ & _ }" was already used in scope type_scope. [notation-overridden,parsing] bedrock2/deps/coqutil/src/Macros/unique (real: 0.16, user: 0.04, sys: 0.03, mem: 54384 ko) File "bedrock2/deps/coqutil/src/Datatypes/PrimitivePair.v", line 15, characters 2-73: Warning: Notation "{ ' _ : _ & _ }" was already used in scope type_scope. [notation-overridden,parsing] File "bedrock2/deps/coqutil/src/Datatypes/PrimitivePair.v", line 17, characters 2-70: Warning: Notation "( _ , _ , .. , _ )" was already used in scope core_scope. [notation-overridden,parsing] bedrock2/deps/coqutil/src/Datatypes/PrimitivePair (real: 0.17, user: 0.04, sys: 0.03, mem: 56232 ko) bedrock2/deps/coqutil/src/Datatypes/List (real: 0.58, user: 0.13, sys: 0.09, mem: 142420 ko) bedrock2/deps/coqutil/src/Datatypes/String (real: 0.85, user: 0.29, sys: 0.16, mem: 252176 ko) bedrock2/deps/coqutil/src/Datatypes/Option (real: 0.37, user: 0.09, sys: 0.06, mem: 108600 ko) make[1]: Entering directory 'bedrock2' make -C bedrock2/deps/coqutil make[2]: Entering directory 'bedrock2/deps/coqutil' /builds/coq/coq/_install_ci/bin/coq_makefile -f _CoqProject INSTALLDEFAULTROOT = coqutil -arg "-async-proofs-tac-j 1" bedrock2/deps/coqutil/src/Tactics/Tactics.v bedrock2/deps/coqutil/src/Tactics/eabstract.v bedrock2/deps/coqutil/src/Tactics/letexists.v bedrock2/deps/coqutil/src/Tactics/rdelta.v bedrock2/deps/coqutil/src/Tactics/syntactic_unify.v bedrock2/deps/coqutil/src/dlet.v bedrock2/deps/coqutil/src/Map/Funext.v bedrock2/deps/coqutil/src/Map/Empty_set_keyed_map.v bedrock2/deps/coqutil/src/Map/SortedListString.v bedrock2/deps/coqutil/src/Map/Z_keyed_SortedListMap.v bedrock2/deps/coqutil/src/Map/SortedListWord.v bedrock2/deps/coqutil/src/Map/Properties.v bedrock2/deps/coqutil/src/Map/TestLemmas.v bedrock2/deps/coqutil/src/Map/Interface.v bedrock2/deps/coqutil/src/Map/TestGoals.v bedrock2/deps/coqutil/src/Map/SlowGoals.v bedrock2/deps/coqutil/src/Map/SortedListString_test.v bedrock2/deps/coqutil/src/Map/Solver.v bedrock2/deps/coqutil/src/Map/SortedList.v bedrock2/deps/coqutil/src/Z/div_mod_to_equations.v bedrock2/deps/coqutil/src/Z/ZLib.v bedrock2/deps/coqutil/src/Z/HexNotation.v bedrock2/deps/coqutil/src/Z/BitOps.v bedrock2/deps/coqutil/src/Datatypes/String.v bedrock2/deps/coqutil/src/Datatypes/List.v bedrock2/deps/coqutil/src/Datatypes/PropSet.v bedrock2/deps/coqutil/src/Datatypes/Option.v bedrock2/deps/coqutil/src/Datatypes/Prod.v bedrock2/deps/coqutil/src/Datatypes/HList.v bedrock2/deps/coqutil/src/Datatypes/PrimitivePair.v bedrock2/deps/coqutil/src/Word/Naive.v bedrock2/deps/coqutil/src/Word/Properties.v bedrock2/deps/coqutil/src/Word/Interface.v bedrock2/deps/coqutil/src/Word/LittleEndian.v bedrock2/deps/coqutil/src/sanity.v bedrock2/deps/coqutil/src/Decidable.v bedrock2/deps/coqutil/src/Macros/subst.v bedrock2/deps/coqutil/src/Macros/symmetry.v bedrock2/deps/coqutil/src/Macros/unique.v -o Makefile.coq.all make -f Makefile.coq.all make[3]: Entering directory 'bedrock2/deps/coqutil' COQDEP VFILES COQC bedrock2/deps/coqutil/src/Tactics/eabstract.v COQC bedrock2/deps/coqutil/src/sanity.v COQC bedrock2/deps/coqutil/src/Tactics/letexists.v COQC bedrock2/deps/coqutil/src/Tactics/rdelta.v COQC bedrock2/deps/coqutil/src/dlet.v COQC bedrock2/deps/coqutil/src/Macros/subst.v COQC bedrock2/deps/coqutil/src/Macros/unique.v COQC bedrock2/deps/coqutil/src/Datatypes/PrimitivePair.v COQC bedrock2/deps/coqutil/src/Datatypes/List.v COQC bedrock2/deps/coqutil/src/Datatypes/String.v COQC bedrock2/deps/coqutil/src/Word/Interface.v COQC bedrock2/deps/coqutil/src/Datatypes/Option.v COQC bedbedrock2/deps/coqutil/src/Word/Interface (real: 1.40, user: 0.31, sys: 0.22, mem: 293000 ko) bedrock2/deps/coqutil/src/Z/div_mod_to_equations (real: 0.92, user: 0.26, sys: 0.17, mem: 238732 ko) bedrock2/deps/coqutil/src/Z/HexNotation (real: 1.24, user: 0.39, sys: 0.18, mem: 303504 ko) bedrock2/deps/coqutil/src/Z/ZLib (real: 2.83, user: 1.00, sys: 0.28, mem: 442912 ko) bedrock2/deps/coqutil/src/Datatypes/Prod (real: 0.32, user: 0.09, sys: 0.06, mem: 93184 ko) bedrock2/deps/coqutil/src/Z/BitOps (real: 2.25, user: 0.81, sys: 0.26, mem: 439216 ko) bedrock2/deps/coqutil/src/Word/Naive (real: 1.75, user: 0.58, sys: 0.27, mem: 415316 ko) bedrock2/deps/coqutil/src/Macros/symmetry (real: 0.23, user: 0.06, sys: 0.04, mem: 67708 ko) bedrock2/deps/coqutil/src/Decidable (real: 1.50, user: 0.48, sys: 0.23, mem: 375156 ko) bedrock2/deps/coqutil/src/Tactics/syntactic_unify (real: 0.18, user: 0.04, sys: 0.04, mem: 56184 ko) File "bedrock2/deps/coqutil/src/Datatypes/HList.v", line 2, characters 48-60: Warning: Notation "_ * _" was already used in scope type_scope. [notation-overridden,parsing] File "bedrock2/deps/coqutil/src/Datatypes/HList.v", line 2, characters 48-60: Warning: Notation "{ _ & _ }" was already used in scope type_scope. [notation-overridden,parsing] File "bedrock2/deps/coqutil/src/Datatypes/HList.v", line 2, characters 48-60: Warning: Notation "{ _ : _ & _ }" was already used in scope type_scope. [notation-overridden,parsing] File "bedrock2/deps/coqutil/src/Datatypes/HList.v", line 2, characters 48-60: Warning: Notation "{ ' _ : _ & _ }" was already used in scope type_scope. [notation-overridden,parsing] File "bedrock2/deps/coqutil/src/Datatypes/HList.v", line 2, characters 48-60: Warning: Notation "( _ , _ , .. , _ )" was already used in scope core_scope. [notation-overridden,parsing] File "bedrock2/deps/coqutil/src/Datatypes/HList.v", line 90, characters 2-19: Warning: Notation "_ * _" was already used in scope type_scope. [notation-overridden,parsing] File "bedrock2/deps/coqutil/src/Datatypes/HList.v", line 90, characters 2-19: Warning: Notation "( _ , _ , .. , _ )" was already used in scope core_scope. [notation-overridden,parsing] bedrock2/deps/coqutil/src/Datatypes/HList (real: 0.63, user: 0.19, sys: 0.12, mem: 180476 ko) bedrock2/deps/coqutil/src/Tactics/Tactics (real: 1.35, user: 0.44, sys: 0.19, mem: 321736 ko) bedrock2/deps/coqutil/src/Word/LittleEndian (real: 0.89, user: 0.27, sys: 0.16, mem: 227732 ko) bedrock2/deps/coqutil/src/Datatypes/PropSet (real: 1.93, user: 0.63, sys: 0.29, mem: 426168 ko) bedrock2/deps/coqutil/src/Map/Interface (real: 1.32, user: 0.40, sys: 0.23, mem: 323944 ko) bedrock2/deps/coqutil/src/Map/Funext (real: 1.24, user: 0.37, sys: 0.23, mem: 316400 ko) bedrock2/deps/coqutil/src/Map/Empty_set_keyed_map (real: 1.17, user: 0.35, sys: 0.21, mem: 295952 ko) File "bedrock2/deps/coqutil/src/Map/SortedList.v", line 110, characters 2-28: Warning: Use of “Require” inside a section is deprecated. [require-in-section,deprecated] bedrock2/deps/coqutil/src/Map/SortedList (real: 1.86, user: 0.60, sys: 0.29, mem: 426440 ko) bedrock2/deps/coqutil/src/Word/Properties (real: 21.22, user: 9.95, sys: 0.38, mem: 568468 ko) bedrock2/deps/coqutil/src/Map/SortedListString (real: 1.20, user: 0.35, sys: 0.22, mem: 289456 ko) bedrock2/deps/coqutil/src/Map/Z_keyed_SortedListMap (real: 1.56, user: 0.49, sys: 0.26, mem: 365272 ko) bedrock2/deps/coqutil/src/Map/SortedListWord (real: 1.88, user: 0.59, sys: 0.30, mem: 440596 ko) bedrock2/deps/coqutil/src/Map/Properties (real: 13.04, user: 6.02, sys: 0.32, mem: 486764 ko) bedrock2/deps/coqutil/src/Map/SortedListString_test (real: 1.34, user: 0.44, sys: 0.21, mem: 305528 ko) bedrock2/deps/coqutil/src/Map/Solver (real: 0.80, user: 0.36, sys: 0.21, mem: 312496 ko) rock2/deps/coqutil/src/Z/div_mod_to_equations.v COQC bedrock2/deps/coqutil/src/Z/ZLib.v COQC bedrock2/deps/coqutil/src/Z/HexNotation.v COQC bedrock2/deps/coqutil/src/Z/BitOps.v COQC bedrock2/deps/coqutil/src/Datatypes/Prod.v COQC bedrock2/deps/coqutil/src/Word/Naive.v COQC bedrock2/deps/coqutil/src/Word/Properties.v COQC bedrock2/deps/coqutil/src/Macros/symmetry.v COQC bedrock2/deps/coqutil/src/Decidable.v COQC bedrock2/deps/coqutil/src/Tactics/syntactic_unify.v COQC bedrock2/deps/coqutil/src/Datatypes/HList.v COQC bedrock2/deps/coqutil/src/Tactics/Tactics.v COQC bedrock2/deps/coqutil/src/Word/LittleEndian.v COQC bedrock2/deps/coqutil/src/Datatypes/PropSet.v COQC bedrock2/deps/coqutil/src/Map/Interface.v COQC bedrock2/deps/coqutil/src/Map/Funext.v COQC bedrock2/deps/coqutil/src/Map/Empty_set_keyed_map.v COQC bedrock2/deps/coqutil/src/Map/SortedList.v COQC bedrock2/deps/coqutil/src/Map/Properties.v COQC bedrock2/deps/coqutil/src/Map/SortedListString.v COQC bedrock2/deps/coqutil/src/Map/Z_keyed_SortedListMap.v COQC bedrock2/deps/coqutil/src/Map/SortedListWord.v COQC bedrock2/deps/coqutil/src/Map/SortedListString_test.v COQC bedrock2/deps/coqutil/src/Map/Solver.v COQC bedrock2/deps/coqutil/src/Map/TestGoals.v COQC bedrock2/deps/coqutil/src/Map/TestLemmas.v Finished transaction in 0.297 secs (0.095u,0.05s) (successful) Part 1a: Small goals (originally took <5s each) Finished transaction in 0.35 secs (0.143u,0.032s) (successful) Finished transaction in 0.438 secs (0.204u,0.008s) (successful) End of TestLemmas.v total time: 1.147s tactic local total calls max ────────────────────────────────────────┴──────┴──────┴───────┴─────────┘ ─map_solver ---------------------------- 0.1% 99.9% 15 0.252s ─map_solver_core ----------------------- 1.0% 69.6% 15 0.209s ─map_solver_core_impl ------------------ 0.9% 68.2% 0 0.207s ─map_specialize ------------------------ 0.2% 54.9% 15 0.199s ─map_specialize_step ------------------- 24.9% 54.7% 42 0.146s ─preprocess_impl ----------------------- 1.8% 30.1% 15 0.043s ─abstract_unrecogs --------------------- 3.2% 19.8% 15 0.030s ─unrecogs_in_prop ---------------------- 15.2% 15.2% 0 0.017s ─specialize (constr_with_bindings) ----- 12.3% 12.3% 769 0.081s ─canonicalize_map_hyp ------------------ 2.3% 8.9% 316 0.011s ─unrecogs_in_option_value -------------- 3.6% 8.3% 0 0.013s ─maps_propositional -------------------- 0.3% 6.5% 15 0.009s ─ensure_no_body ------------------------ 2.1% 5.3% 602 0.006s ─assert_fails -------------------------- 1.9% 4.4% 756 0.006s ─rew_map_specs_in ---------------------- 1.3% 4.4% 316 0.010s ─canonicalize_all ---------------------- 0.6% 4.2% 15 0.006s ─maps_leaf_tac ------------------------- 0.3% 3.8% 32 0.003s ─one_rew_map_specs --------------------- 2.6% 3.5% 0 0.010s ─unrecogs_in_key ----------------------- 1.6% 2.9% 0 0.001s ─pose proof H as H' -------------------- 2.8% 2.8% 448 0.000s ─tac ----------------------------------- 1.8% 2.5% 756 0.000s ─revert_all_Props bedrock2/deps/coqutil/src/Map/TestLemmas (real: 3.68, user: 1.47, sys: 0.32, mem: 435336 ko) ---------------------- 2.1% 2.2% 15 0.003s ─autounfold (hintbases) (clause_dft_conc 2.2% 2.2% 62 0.001s ─unrecogs_in_map ----------------------- 1.4% 2.0% 0 0.002s tactic local total calls max ────────────────────────────────────────┴──────┴──────┴───────┴─────────┘ ─map_solver ---------------------------- 0.1% 99.9% 15 0.252s ├─map_solver_core --------------------- 1.0% 69.6% 15 0.209s │└map_solver_core_impl ---------------- 0.9% 68.2% 0 0.207s │ ├─map_specialize -------------------- 0.2% 54.9% 15 0.199s │ │└map_specialize_step --------------- 24.9% 54.7% 42 0.146s │ │ ├─specialize (constr_with_bindings) 10.7% 10.7% 448 0.081s │ │ ├─canonicalize_map_hyp ------------ 1.2% 5.9% 154 0.011s │ │ │└rew_map_specs_in ---------------- 0.8% 3.3% 154 0.010s │ │ │└one_rew_map_specs --------------- 1.9% 2.5% 0 0.010s │ │ ├─ensure_no_body ------------------ 2.1% 5.3% 602 0.006s │ │ │└assert_fails -------------------- 1.6% 3.1% 602 0.006s │ │ └─pose proof H as H' -------------- 2.8% 2.8% 448 0.000s │ ├─maps_propositional ---------------- 0.3% 6.5% 15 0.009s │ │└maps_leaf_tac --------------------- 0.3% 3.8% 32 0.003s │ └─canonicalize_all ------------------ 0.6% 4.2% 15 0.006s │ └canonicalize_map_hyp -------------- 1.1% 3.0% 162 0.001s └─preprocess_impl --------------------- 1.8% 30.1% 15 0.043s ├─abstract_unrecogs ----------------- 3.2% 19.8% 15 0.030s │└unrecogs_in_prop ------------------ 15.2% 15.2% 0 0.017s │└unrecogs_in_option_value ---------- 3.6% 8.3% 0 0.013s │ ├─unrecogs_in_key ----------------- 1.1% 2.0% 0 0.001s │ └─unrecogs_in_map ----------------- 1.4% 2.0% 0 0.002s └─revert_all_Props ------------------ 2.1% 2.2% 15 0.003s COQC bedrock2/deps/coqutil/src/Map/SlowGoals.v Finished transaction in 3.949 secs (1.835u,0.093s) (successful) Finished transaction in 6.898 secs (3.179u,0.177s) (successful) Finished transaction in 6.138 secs (2.811u,0.154s) (successful) Finished transaction in 15.112 secs (7.09u,0.222s) (successful) Finished transaction in 0.047 secs (0.024u,0.s) (successful) End of SlowGoals.v total time: 7.313s tactic local total calls max ────────────────────────────────────────┴──────┴──────┴───────┴─────────┘ ─map_solver_core ----------------------- 0.0% 100.0% 1 7.312s ─map_solver_core_impl ------------------ 0.0% 100.0% 0 7.310s ─maps_propositional -------------------- 0.6% 61.3% 33 4.485s ─map_specialize ------------------------ 0.0% 38.0% 1 2.779s ─map_specialize_step ------------------- 15.8% 38.0% 37 1.817s ─maps_leaf_tac ------------------------- 0.7% 32.8% 228 0.018s ─propositional_cheap_step -------------- 25.2% 25.6% 427 0.013s ─congruence ---------------------------- 16.9% 16.9% 228 0.010s ─maps_choice_step ---------------------- 0.1% 15.7% 0 0.040s ─next ---------------------------------- 15.7% 15.7% 32 0.040s ─auto (int_or_var_opt) (auto_using) (hin 14.8% 14.8% 358 0.008s ─unify (constr) (constr) --------------- 5.5% 5.5% 4416 0.006s ─canonicalize_map_hyp ------------------ 1.0% 4.4% 822 0.008s ─specialize (constr_with_bindings) ----- 4.2% 4.2% 3293 0.008s ─ensbedrock2/deps/coqutil/src/Map/SlowGoals (real: 16.46, user: 7.54, sys: 0.41, mem: 454624 ko) ure_no_body ------------------------ 1.5% 3.6% 3220 0.008s ─assert_fails -------------------------- 0.9% 3.2% 4005 0.008s ─pose proof H as H' -------------------- 3.0% 3.0% 2405 0.009s ─tac ----------------------------------- 1.4% 2.3% 4005 0.008s ─maps_split_step ----------------------- 0.3% 2.2% 260 0.006s tactic local total calls max ────────────────────────────────────────┴──────┴──────┴───────┴─────────┘ ─map_solver_core ----------------------- 0.0% 100.0% 1 7.312s └map_solver_core_impl ------------------ 0.0% 100.0% 0 7.310s ├─maps_propositional ------------------ 0.6% 61.3% 33 4.485s │ ├─maps_leaf_tac --------------------- 0.7% 32.8% 228 0.018s │ │ ├─congruence ---------------------- 16.9% 16.9% 228 0.010s │ │ └─auto (int_or_var_opt) (auto_using 14.8% 14.8% 358 0.008s │ ├─propositional_cheap_step ---------- 25.0% 25.4% 424 0.013s │ ├─maps_choice_step ------------------ 0.1% 15.7% 0 0.040s │ │└next ------------------------------ 15.7% 15.7% 32 0.040s │ └─maps_split_step ------------------- 0.3% 2.2% 260 0.006s └─map_specialize ---------------------- 0.0% 38.0% 1 2.779s └map_specialize_step ----------------- 15.8% 38.0% 37 1.817s ├─unify (constr) (constr) ----------- 5.5% 5.5% 4413 0.006s ├─canonicalize_map_hyp -------------- 0.9% 4.2% 785 0.008s ├─ensure_no_body -------------------- 1.5% 3.6% 3220 0.008s │└assert_fails ---------------------- 0.7% 2.1% 3220 0.008s ├─pose proof H as H' ---------------- 3.0% 3.0% 2405 0.009s └─specialize (constr_with_bindings) - 2.5% 2.5% 2405 0.007s Finished transaction in 2.274 secs (1.721u,0.068s) (successful) Finished transaction in 1.891 secs (1.771u,0.084s) (successful) Finished transaction in 1.713 secs (1.599u,0.076s) (successful) Finished transaction in 0.196 secs (0.185u,0.008s) (successful) Part 1b: Medium goals (originally took >5s each) Finished transaction in 1.398 secs (1.318u,0.055s) (successful) Finished transaction in 3.691 secs (3.403u,0.173s) (successful) Finished transaction in 3.279 secs (3.017u,0.167s) (successful) Finished transaction in 1.982 secs (1.851u,0.083s) (successful) Finished transaction in 1.932 secs (1.8u,0.097s) (successful) Finished transaction in 3.391 secs (3.136u,0.144s) (successful) Finished transaction in 3.23 secs (3.024u,0.138s) (successful) Part 1c: Large goals (originally took >50s each) Finished transaction in 4.687 secs (4.34u,0.215s) (successful) End of TestGoals.v total time: 37.262s tactic local total calls max ────────────────────────────────────────┴──────┴──────┴───────┴─────────┘ ─map_solver ---------------------------- 0.0% 100.0% 18 4.555s ─map_solver_core ----------------------- 0.0% 96.9% 18 4.483s ─map_solver_core_impl ------------------ 0.0% 96.8% 0 4.482s ─map_specialize ------------------------ 0.0% 93.4% 18 4.351s ─map_specialize_step ------------------- 43.0% 93.3% 428 1.253s ─ensure_no_body ------------------------ 5.8% 13.2% 62635 0.014s ─specialize (constr_with_bindings) ----- 12.8% 12.8% 63060 0.013s ─pose proof H as H' -------------------- 11.4% 11.4% 55172 0.009s ─assert_fails -------------------------- 3.3% 9.5% 69963 0.014s ─canonicalize_map_hyp ------------------ 1.8% 7.6% 7811 0.014s ─tac ----------------------------------- 4.2% 6.2% 69963 0.014s ─preprbedrock2/deps/coqutil/src/Map/TestGoals (real: 49.22, user: 36.08, sys: 2.04, mem: 562540 ko) ocess_impl ----------------------- 0.1% 3.1% 18 0.116s ─Tactics.ensure_new -------------------- 1.1% 3.1% 7328 0.014s ─rew_map_specs_in ---------------------- 1.0% 3.0% 7812 0.014s ─maps_propositional -------------------- 0.0% 2.8% 22 0.231s ─abstract_unrecogs --------------------- 0.4% 2.4% 18 0.107s ─unify (constr) (constr) --------------- 2.2% 2.2% 75932 0.009s ─one_rew_map_specs --------------------- 1.4% 2.1% 0 0.014s tactic local total calls max ────────────────────────────────────────┴──────┴──────┴───────┴─────────┘ ─map_solver ---------------------------- 0.0% 100.0% 18 4.555s ├─map_solver_core --------------------- 0.0% 96.9% 18 4.483s │└map_solver_core_impl ---------------- 0.0% 96.8% 0 4.482s │ ├─map_specialize -------------------- 0.0% 93.4% 18 4.351s │ │└map_specialize_step --------------- 43.0% 93.3% 428 1.253s │ │ ├─ensure_no_body ------------------ 5.8% 13.2% 62635 0.014s │ │ │└assert_fails -------------------- 2.9% 7.5% 62635 0.014s │ │ │└tac ----------------------------- 3.3% 4.6% 62635 0.011s │ │ ├─pose proof H as H' -------------- 11.4% 11.4% 55172 0.009s │ │ ├─specialize (constr_with_bindings) 10.5% 10.5% 55172 0.010s │ │ ├─canonicalize_map_hyp ------------ 1.7% 7.3% 7328 0.014s │ │ │ ├─rew_map_specs_in -------------- 0.9% 2.9% 7328 0.014s │ │ │ └─specialize (constr_with_binding 2.2% 2.2% 7328 0.013s │ │ ├─Tactics.ensure_new -------------- 1.1% 3.1% 7328 0.014s │ │ │└assert_fails -------------------- 0.4% 2.0% 7328 0.014s │ │ └─unify (constr) (constr) --------- 2.2% 2.2% 75866 0.009s │ └─maps_propositional ---------------- 0.0% 2.8% 22 0.231s └─preprocess_impl --------------------- 0.1% 3.1% 18 0.116s └abstract_unrecogs ------------------- 0.4% 2.4% 18 0.107s make[3]: Leaving directory 'bedrock2/deps/coqutil' make[2]: Leaving directory 'bedrock2/deps/coqutil' make -C bedrock2/deps/riscv-coq all make -C bedrock2/bedrock2 make[2]: Entering directory 'bedrock2/deps/riscv-coq' /builds/coq/coq/_install_ci/bin/coq_makefile -f _CoqProject INSTALLDEFAULTROOT = riscv -arg "-async-proofs-tac-j 1" bedrock2/deps/riscv-coq/src/Spec/Primitives.v bedrock2/deps/riscv-coq/src/Spec/ExecuteI.v bedrock2/deps/riscv-coq/src/Spec/ExecuteI64.v bedrock2/deps/riscv-coq/src/Spec/MetricPrimitives.v bedrock2/deps/riscv-coq/src/Spec/Machine.v bedrock2/deps/riscv-coq/src/Spec/ExecuteM.v bedrock2/deps/riscv-coq/src/Spec/ExecuteM64.v bedrock2/deps/riscv-coq/src/Spec/PseudoInstructions.v bedrock2/deps/riscv-coq/src/Spec/Execute.v bedrock2/deps/riscv-coq/src/Spec/Decode.v bedrock2/deps/riscv-coq/src/Spec/VirtualMemory.v bedrock2/deps/riscv-coq/src/Utility/MMIOTrace.v bedrock2/deps/riscv-coq/src/Utility/InstructionNotations.v bedrock2/deps/riscv-coq/src/Utility/nat_div_mod_to_quot_rem.v bedrock2/deps/riscv-coq/src/Utility/prove_Zeq_bitwise.v bedrock2/deps/riscv-coq/src/Utility/InstructionCoercions.v bedrock2/deps/riscv-coq/src/Utility/Words32Naive.v bedrock2/deps/riscv-coq/src/Utility/JMonad.v bedrock2/deps/riscv-coq/src/Utility/Utility.v bedrock2/deps/riscv-coq/src/Utility/DefaultMemImpl64.v bedrock2/deps/riscv-coq/src/Utility/runsToNonDet_Run.v bedrock2/deps/riscv-coq/src/Utility/ZBitOps.v bedrock2/deps/riscv-coq/src/Utility/MonadNotations.v bedrock2/deps/riscv-coq/src/Utility/Tactics.v bedrock2/deps/riscv-coq/src/Utility/MonadTests.v bedrock2/deps/riscv-coq/src/Utility/Words64Naive.v bedrock2/deps/riscv-coq/src/Utility/Encode.v bedrock2/deps/riscv-coq/src/Utility/MkMachineWidth.v bedrock2/deps/riscv-coq/src/Utility/MonadT.v bedrock2/deps/riscv-coq/src/Utility/div_mod_to_quot_rem.v bedrock2/deps/riscv-coq/src/Utility/DefaultMemImpl32.v bedrock2/deps/riscv-coq/src/Utility/PowerFunc.v bedrock2/deps/riscv-coq/src/Utility/ListLib.v bedrock2/deps/riscv-coq/src/Utility/runsToNonDet.v bedrock2/deps/riscv-coq/src/Utility/Monads.v bedrock2/deps/riscv-coq/src/Platform/MetricLogging.v bedrock2/deps/riscv-coq/src/Platform/Example64Literal.v bedrock2/deps/riscv-coq/src/Platform/RiscvMachine.v bedrock2/deps/riscv-coq/src/Platform/MetricMinimal.v bedrock2/deps/riscv-coq/src/Platform/Example.v bedrock2/deps/riscv-coq/src/Platform/Memory.v bedrock2/deps/riscv-coq/src/Platform/MinimalLogging.v bedrock2/deps/riscv-coq/src/Platform/Run.v bedrock2/deps/riscv-coq/src/Platform/MetricRiscvMachine.v bedrock2/deps/riscv-coq/src/Platform/Minimal.v bedrock2/deps/riscv-coq/src/Platform/MinimalMMIO.v bedrock2/deps/riscv-coq/src/Proofs/invert_encode_Fence.v bedrock2/deps/riscv-coq/src/Proofs/DecodeEncodeA64.v bedrock2/deps/riscv-coq/src/Proofs/DecodeEncodeCSR.v bedrock2/deps/riscv-coq/src/Proofs/invert_encode_SB.v bedrock2/deps/riscv-coq/src/Proofs/DecodeEncodeI64.v bedrock2/deps/riscv-coq/src/Proofs/DecodeEncodeA.v bedrock2/deps/riscv-coq/src/Proofs/invert_encode_U.v bedrock2/deps/riscv-coq/src/Proofs/invert_encode_I.v bedrock2/deps/riscv-coq/src/Proofs/DecodeEncodeProver.v bedrock2/deps/riscv-coq/src/Proofs/DecodeEncodeI.v bedrock2/deps/riscv-coq/src/Proofs/invert_encode_FenceI.v bedrock2/deps/riscv-coq/src/Proofs/invert_encode_R_atomic.v bedrock2/deps/riscv-coq/src/Proofs/DecodeEncodeM64.v bedrock2/deps/riscv-coq/src/Proofs/EncodeBound.v bedrock2/deps/riscv-coq/src/Proofs/invert_encode_R.v bedrock2/deps/riscv-coq/src/Proofs/invert_encode_S.v bedrock2/deps/riscv-coq/src/Proofs/DecodeEncode.v bedrock2/deps/riscv-coq/src/Proofs/invert_encode_I_system.v bedrock2/deps/riscv-coq/src/Proofs/DecodeEncodeM.v bedrock2/deps/riscv-coq/src/Proofs/invert_encode_UJ.v bedrock2/deps/riscv-coq/src/Proofs/invert_encode_I_shift_57.v bedrock2/deps/riscv-coq/src/Proofs/invert_encode_I_shift_66.v -o Makefile.coq.all make[2]: Entering directory 'bedrock2/bedrock2' printf -- '-Q src bedrock2\n-Q /builds/coq/coWarning: ../coqutil/src (used in -R or -Q) is not a subdirectory of the current directory bedrock2/bedrock2/src/Syntax (real: 0.28, user: 0.07, sys: 0.04, mem: 93508 ko) bedrock2/deps/riscv-coq/src/Utility/Monads (real: 1.74, user: 0.61, sys: 0.22, mem: 357880 ko) bedrock2/deps/riscv-coq/src/Utility/Tactics (real: 1.14, user: 0.34, sys: 0.21, mem: 294376 ko) bedrock2/bedrock2/src/Byte (real: 3.14, user: 1.29, sys: 0.27, mem: 418180 ko) bedrock2/bedrock2/src/Notations (real: 0.16, user: 0.04, sys: 0.03, mem: 56396 ko) bedrock2/deps/riscv-coq/src/Platform/MetricLogging (real: 1.44, user: 0.46, sys: 0.23, mem: 344552 ko) bedrock2/deps/riscv-coq/src/Utility/MMIOTrace (real: 0.17, user: 0.04, sys: 0.03, mem: 56096 ko) q/_build_ci/bedrock2/deps/coqutil/src coqutil\n' > _CoqProject /builds/coq/coq/_install_ci/bin/coq_makefile -f _CoqProject INSTALLDEFAULTROOT = bedrock2 -arg "-async-proofs-tac-j 1" bedrock2/bedrock2/src/BasicCSyntax.v bedrock2/bedrock2/src/ToCString.v bedrock2/bedrock2/src/BytedumpTest.v bedrock2/bedrock2/src/BasicC32Semantics.v bedrock2/bedrock2/src/Byte.v bedrock2/bedrock2/src/Variables.v bedrock2/bedrock2/src/Semantics.v bedrock2/bedrock2/src/div10.v bedrock2/bedrock2/src/NotationsCustomEntry.v bedrock2/bedrock2/src/ListPred.v bedrock2/bedrock2/src/BasicC64Semantics.v bedrock2/bedrock2/src/Map/SeparationLogic.v bedrock2/bedrock2/src/Map/Separation.v bedrock2/bedrock2/src/Syntax.v bedrock2/bedrock2/src/WeakestPreconditionProperties.v bedrock2/bedrock2/src/NotationsInConstr.v bedrock2/bedrock2/src/WeakestPrecondition.v bedrock2/bedrock2/src/TODO_absint.v bedrock2/bedrock2/src/Bytedump.v bedrock2/bedrock2/src/FE310CSemantics.v bedrock2/bedrock2/src/StructNotations.v bedrock2/bedrock2/src/Examples/lightbulb.v bedrock2/bedrock2/src/Examples/MultipleReturnValues.v bedrock2/bedrock2/src/Examples/ARPResponder.v bedrock2/bedrock2/src/Examples/swap.v bedrock2/bedrock2/src/Examples/chacha20.v bedrock2/bedrock2/src/Examples/Demos.v bedrock2/bedrock2/src/Examples/bsearch.v bedrock2/bedrock2/src/Examples/Trace.v bedrock2/bedrock2/src/Examples/StructAccess.v bedrock2/bedrock2/src/Examples/FE310CompilerDemo.v bedrock2/bedrock2/src/Examples/ipow.v bedrock2/bedrock2/src/Markers.v bedrock2/bedrock2/src/Memory.v bedrock2/bedrock2/src/Structs.v bedrock2/bedrock2/src/Notations.v bedrock2/bedrock2/src/ProgramLogic.v bedrock2/bedrock2/src/Hexdump.v bedrock2/bedrock2/src/BasicC64Syntax.v bedrock2/bedrock2/src/Scalars.v bedrock2/bedrock2/src/string2ident.v bedrock2/bedrock2/src/ptsto_bytes.v bedrock2/bedrock2/src/StringNamesSyntax.v bedrock2/bedrock2/src/Lift1Prop.v bedrock2/bedrock2/src/ZNamesSyntax.v bedrock2/bedrock2/src/TailRecursion.v bedrock2/bedrock2/src/Array.v -o Makefile.coq.all make -f Makefile.coq.all make -f Makefile.coq.all make[3]: Entering directory 'bedrock2/deps/riscv-coq' make[3]: Entering directory 'bedrock2/bedrock2' COQDEP VFILES COQDEP VFILES COQC bedrock2/bedrock2/src/Syntax.v COQC bedrock2/deps/riscv-coq/src/Utility/Monads.v COQC bedrock2/bedrock2/src/Byte.v COQC bedrock2/deps/riscv-coq/src/Utility/Tactics.v COQC bedrock2/deps/riscv-coq/src/Platform/MetricLogging.v COQC bedrock2/bedrock2/src/Notations.v COQC bedrock2/bedrock2/src/div10.v COQC bedrock2/deps/riscv-coq/src/Utility/MMIOTrace.v COQC bedrock2/deps/riscv-coq/src/Utility/nat_div_mbedrock2/bedrock2/src/div10 (real: 1.82, user: 0.61, sys: 0.29, mem: 437628 ko) bedrock2/deps/riscv-coq/src/Utility/nat_div_mod_to_quot_rem (real: 1.14, user: 0.36, sys: 0.19, mem: 298516 ko) File "bedrock2/bedrock2/src/NotationsCustomEntry.v", line 50, characters 0-51: Warning: Declaring a scope implicitly is deprecated; use in advance an explicit "Declare Scope bedrock_nontail.". [undeclared-scope,deprecated] File "bedrock2/bedrock2/src/NotationsCustomEntry.v", line 142, characters 0-45: Warning: Declaring a scope implicitly is deprecated; use in advance an explicit "Declare Scope bedrock_tail.". [undeclared-scope,deprecated] File "bedrock2/deps/riscv-coq/src/Utility/JMonad.v", line 13, characters 0-102: Warning: Declaring a scope implicitly is deprecated; use in advance an explicit "Declare Scope monad_scope.". [undeclared-scope,deprecated] bedrock2/bedrock2/src/NotationsCustomEntry (real: 1.07, user: 0.33, sys: 0.18, mem: 301112 ko) bedrock2/deps/riscv-coq/src/Utility/JMonad (real: 0.64, user: 0.17, sys: 0.13, mem: 184664 ko) bedrock2/bedrock2/src/ListPred (real: 0.47, user: 0.13, sys: 0.09, mem: 144616 ko) File "bedrock2/deps/riscv-coq/src/Utility/MonadNotations.v", line 3, characters 0-102: Warning: Declaring a scope implicitly is deprecated; use in advance an explicit "Declare Scope monad_scope.". [undeclared-scope,deprecated] bedrock2/deps/riscv-coq/src/Utility/MonadNotations (real: 0.48, user: 0.12, sys: 0.11, mem: 146976 ko) bedrock2/deps/riscv-coq/src/Utility/PowerFunc (real: 0.20, user: 0.05, sys: 0.04, mem: 65768 ko) bedrock2/bedrock2/src/Lift1Prop (real: 0.32, user: 0.09, sys: 0.06, mem: 116312 ko) File "bedrock2/deps/riscv-coq/src/Utility/MonadTests.v", line 10, characters 0-102: Warning: Declaring a scope implicitly is deprecated; use in advance an explicit "Declare Scope monad_scope.". [undeclared-scope,deprecated] File "bedrock2/bedrock2/src/NotationsInConstr.v", line 5, characters 0-43: Warning: Declaring a scope implicitly is deprecated; use in advance an explicit "Declare Scope bedrock_var.". [undeclared-scope,deprecated] File "bedrock2/bedrock2/src/NotationsInConstr.v", line 7, characters 0-45: Warning: Declaring a scope implicitly is deprecated; use in advance an explicit "Declare Scope bedrock_expr.". [undeclared-scope,deprecated] File "bedrock2/bedrock2/src/NotationsInConstr.v", line 21, characters 0-43: Warning: Declaring a scope implicitly is deprecated; use in advance an explicit "Declare Scope bedrock_cmd.". [undeclared-scope,deprecated] File "bedrock2/bedrock2/src/NotationsInConstr.v", line 46, characters 0-55: Warning: Declaring a scope implicitly is deprecated; use in advance an explicit "Declare Scope bedrock_func_body.". [undeclared-scope,deprecated] bedrock2/bedrock2/src/NotationsInConstr (real: 0.66, user: 0.19, sys: 0.10, mem: 172428 ko) bedrock2/deps/riscv-coq/src/Utility/MonadTests (real: 0.93, user: 0.27, sys: 0.16, mem: 255852 ko) File "bedrock2/deps/riscv-coq/src/Utility/MonadT.v", line 17, characters 0-102: Warning: Declaring a scope implicitly is deprecated; use in advance an explicit "Declare Scope monad_scope.". [undeclared-scope,deprecated] File "bedrock2/deps/riscv-coq/src/Utility/MonadT.v", line 265, characters 2-23: Warning: State is declared as a local axiom [local-declaration,scope] File "bedrock2/deps/riscv-coq/src/Utility/MonadT.v", line 266, characters 2-37: Warning: step is declared as a local axiom [local-declaration,scope] File "bedrock2/deps/riscv-coq/src/Utility/MonadT.v", line 280, characters 2-23: Warning: State is declared as a local axiom [local-declaration,scope] File "bedrock2/deps/riscv-coq/src/Utility/MonadT.v", line 281, characters 2-37: Warning: step is declared as a local axiom [local-declaration,scope] File "bedrock2/deps/riscv-coq/src/Utility/MonadT.v", line 311, characters 2-27: Warning: Adding and removing hints in the core database implicitly is deprecated. Please specify a hint database. [implicit-core-hint-db,deprecated] bedrock2/deps/riscv-coq/src/Utility/MonadT (real: 0.78, user: 0.23, sys: 0.15, mem: 212520 ko) od_to_quot_rem.v COQC bedrock2/bedrock2/src/NotationsCustomEntry.v COQC bedrock2/deps/riscv-coq/src/Utility/JMonad.v COQC bedrock2/bedrock2/src/ListPred.v COQC bedrock2/deps/riscv-coq/src/Utility/MonadNotations.v COQC bedrock2/bedrock2/src/Lift1Prop.v COQC bedrock2/deps/riscv-coq/src/Utility/PowerFunc.v COQC bedrock2/deps/riscv-coq/src/Utility/MonadTests.v COQC bedrock2/bedrock2/src/NotationsInConstr.v = [(3, true); (3, false); (4, true); (4, false)] : Id (list (nat * bool)) = None : Id (option (list nat)) = [Some 3; Some 4; None] : Id (list (option nat)) = (tt, 5) : Id (unit * nat) = [(tt, 6); (tt, 7)] : Id (list (unit * nat)) = [0; 1; 2; 3] : list nat = [(tt, 0); (tt, 1); (tt, 2); (tt, 3)] : Id (list (unit * nat)) COQC bedrock2/bedrock2/src/Structs.v = ([(0, 1); (0, 0)], (0, 0)) : Id (list (nat * nat) * (nat * nat)) = [(0, 1, (0, 1)); (1, 0, (1, 0))] : Id (list (nat * nat * (nat * nat))) = ([0; 1; 2; 3], 3) : Id (list nat * nat) = ([0; 5; 6; 15], 15) : Id (list nat * nat) = (tt, <<20,10,10>>) : Id (unit * Regs) = ([<<0,20,30>>; <<1,20,30>>; <<2,20,30>>], <<2,20,30>>) : Id (list Regs * Regs) = ([<<0,11,11>>; <<1,11,11>>; <<2,11,11>>; <<3,11,11>>], <<3,11,11>>) : Id (list Regs * Regs) COQC bedrock2/deps/riscv-coq/src/Utility/MonadT.v = list (option nat) : Type = fun (A : Type) (aset : (A -> Prop) -> Prop) (f : (A -> Prop) -> A) (b : A) => exists a : A -> Prop, aset a /\ f a = b : forall A : Type, ((A -> Prop) -> Prop) -> ((A -> Prop) -> A) -> A -> Prop runsTo_ind : forall (initial : State) (P : State -> Prop) (P0 : Prop), (P initial -> P0) -> ((forall omid : option State, step initial omid -> exists mid : State, omid = Some mid /\ runsTo mid P) -> P0) -> runsTo initial P -> P0 runsTo_ind = fun (initial : State) (P : State -> Prop) (P0 : Prop) (f : P initial -> P0) (f0 : (forall omid : option (option unit * State), step initial omid -> exists mid : State, omid = Some (Some tt, mid) /\ runsTo mid P) -> P0) (r : runsTo initial P) => match r with | runsToDone _ _ x => f x | runsToStep _ _ x => f0 x end : forall (initial : State) (P : State -> Prop) (P0 : Prop), (P initial -> P0) -> ((forall omid : option (option unit * State), step initial omid -> exists mid : State, omid = Some (Some tt, mid) /\ runsTo mid P) -> P0) -> runsTo initial P -> P0 Argument scopes are [_ function_scope type_scope function_scope function_scope _] Closed under the global context COQC bedrock2/deps/riscv-coq/src/Utility/ListLib.v = 4%Z : Z = 20%Z : Z = 30%Z : Z = 90%Z : Z = inr (Struct (("first", Array 15 (Bytes 1)) :: ("last", Array 15 (Bytes 1)) :: nil), 30%Z) : PathError Z + type * Z = inr (Array 15 (Bytes 1), 45%Z) : PathError Z + type * Z = inr (Bytes 1, 47%Z) : PathError Z + type * Z = fun (p : parameters) (add mul : bopname) (base : expr) => inr (Struct (("first", Array 15 (Bytes 1)) :: ("last", Array 15 (Bytes 1)) :: nil), expr.op add base (expr.op mul (expr.literal 1) (expr.literal 30))) : forall p : parameters, bopname -> bopname -> expr -> PathError expr + type * expr = fun (p : parameters) (add mul : bopname) (base : expr) => inr (Array 15 (Bytes 1), expr.op add (expr.op add base (expr.op mul (expr.literal 1) (expr.literal 30))) (expr.literal 15)) : forall p : parameters, bopname -> bopname -> expr -> PathError expr + type * bedrock2/bedrock2/src/Structs (real: 1.31, user: 0.44, sys: 0.20, mem: 308516 ko) File "bedrock2/bedrock2/src/Markers.v", line 19, characters 2-71: Warning: Declaring a scope implicitly is deprecated; use in advance an explicit "Declare Scope hide_markers.". [undeclared-scope,deprecated] bedrock2/bedrock2/src/Markers (real: 0.18, user: 0.04, sys: 0.04, mem: 57444 ko) bedrock2/bedrock2/src/string2ident (real: 1.15, user: 0.36, sys: 0.20, mem: 272052 ko) File "bedrock2/bedrock2/src/Hexdump.v", line 16, characters 0-41: Warning: Declaring a scope implicitly is deprecated; use in advance an explicit "Declare Scope hexdump_scope.". [undeclared-scope,deprecated] bedrock2/bedrock2/src/Hexdump (real: 1.06, user: 0.32, sys: 0.19, mem: 274924 ko) bedrock2/deps/riscv-coq/src/Utility/ListLib (real: 2.96, user: 1.17, sys: 0.28, mem: 444076 ko) bedrock2/bedrock2/src/ZNamesSyntax (real: 1.16, user: 0.38, sys: 0.18, mem: 294268 ko) bedrock2/deps/riscv-coq/src/Utility/div_mod_to_quot_rem (real: 1.14, user: 0.37, sys: 0.18, mem: 295668 ko) File "bedrock2/deps/riscv-coq/src/Utility/runsToNonDet.v", line 20, characters 2-27: Warning: Adding and removing hints in the core database implicitly is deprecated. Please specify a hint database. [implicit-core-hint-db,deprecated] File "bedrock2/deps/riscv-coq/src/Utility/runsToNonDet.v", line 30, characters 2-28: Warning: Adding and removing hints in the core database implicitly is deprecated. Please specify a hint database. [implicit-core-hint-db,deprecated] bedrock2/deps/riscv-coq/src/Utility/runsToNonDet (real: 0.20, user: 0.05, sys: 0.03, mem: 65120 ko) bedrock2/bedrock2/src/Variables (real: 0.46, user: 0.13, sys: 0.09, mem: 149744 ko) bedrock2/bedrock2/src/StringNamesSyntax (real: 1.02, user: 0.30, sys: 0.18, mem: 252388 ko) File "bedrock2/bedrock2/src/Bytedump.v", line 2, characters 0-43: Warning: Declaring a scope implicitly is deprecated; use in advance an explicit "Declare Scope bytedump_scope.". [undeclared-scope,deprecated] bedrock2/bedrock2/src/Bytedump (real: 1.08, user: 0.34, sys: 0.18, mem: 272812 ko) bedrock2/deps/riscv-coq/src/Utility/ZBitOps (real: 2.28, user: 0.83, sys: 0.28, mem: 439724 ko) File "bedrock2/deps/riscv-coq/src/Utility/Utility.v", line 120, characters 0-78: Warning: Declaring a scope implicitly is deprecated; use in advance an explicit "Declare Scope alu_scope.". [undeclared-scope,deprecated] bedrock2/deps/riscv-coq/src/Utility/Utility (real: 1.69, user: 0.57, sys: 0.25, mem: 358716 ko) bedrock2/bedrock2/src/Memory (real: 2.40, user: 0.84, sys: 0.30, mem: 443020 ko) bedrock2/bedrock2/src/Map/Separation (real: 1.31, user: 0.43, sys: 0.20, mem: 289244 ko) bedrock2/deps/riscv-coq/src/Utility/prove_Zeq_bitwise (real: 2.66, user: 0.95, sys: 0.32, mem: 441452 ko) bedrock2/bedrock2/src/StructNotations (real: 1.10, user: 0.35, sys: 0.18, mem: 267768 ko) bedrock2/deps/riscv-coq/src/Utility/Words32Naive (real: 1.51, user: 0.52, sys: 0.21, mem: 346660 ko) bedrock2/bedrock2/src/ToCString (real: 1.34, user: 0.48, sys: 0.17, mem: 276676 ko) bedrock2/deps/riscv-coq/src/Utility/Words64Naive (real: 1.41, user: 0.49, sys: 0.19, mem: 346980 ko) bedrock2/bedrock2/src/BytedumpTest (real: 1.52, user: 0.49, sys: 0.25, mem: 411496 ko) bedrock2/bedrock2/src/BytedumpTestα (real: 1.52, user: 0.49, sys: 0.25, mem: 411496 ko) bedrock2/deps/riscv-coq/src/Utility/DefaultMemImpl32 (real: 1.64, user: 0.55, sys: 0.23, mem: 376020 ko) bedrock2/bedrock2/src/Semantics (real: 1.81, user: 0.66, sys: 0.26, mem: 441912 ko) bedrock2/deps/riscv-coq/src/Spec/Decode (real: 2.09, user: 0.71, sys: 0.28, mem: 446048 ko) bedrock2/deps/riscv-coq/src/Platform/Memory (real: 2.06, user: 0.71, sys: 0.27, mem: 449484 ko) bedrock2/bedrock2/src/Map/SeparationLogic (real: 4.20, user: 1.76, sys: 0.27, mem: 433996 ko) bedrock2/deps/riscv-coq/src/Spec/Machine (real: 1.50, user: 0.49, sys: 0.24, mem: 375808 ko) bedrock2/bedrock2/src/WeakestPrecondition (real: 1.67, user: 0.56, sys: 0.24, mem: 410516 ko) bedrock2/deps/riscv-coq/src/Platform/RiscvMachine (real: 1.48, user: 0.48, sys: 0.24, mem: 370692 ko) bedrock2/deps/riscv-coq/src/Utility/MkMachineWidth (real: 1.44, user: 0.49, sys: 0.21, mem: 360632 ko) bedrock2/bedrock2/src/Array (real: 3.30, user: 1.35, sys: 0.27, mem: 457132 ko) bedrock2/deps/riscv-coq/src/Spec/VirtualMemory (real: 1.33, user: 0.43, sys: 0.22, mem: 321032 ko) bedrock2/bedrock2/src/BasicC64Syntax (real: 1.40, user: 0.47, sys: 0.21, mem: 321560 ko) bedrock2/deps/riscv-coq/src/Platform/MetricRiscvMachine (real: 1.49, user: 0.48, sys: 0.24, mem: 362608 ko) bedrock2/deps/riscv-coq/src/Spec/ExecuteM (real: 1.62, user: 0.53, sys: 0.26, mem: 387416 ko) bedrock2/bedrock2/src/Examples/Trace (real: 2.96, user: 1.14, sys: 0.29, mem: 449412 ko) bedrock2/deps/riscv-coq/src/Spec/ExecuteM64 (real: 1.64, user: 0.52, sys: 0.25, mem: 375816 ko) bedrock2/bedrock2/src/Examples/StructAccess (real: 1.12, user: 0.35, sys: 0.19, mem: 272888 ko) bedrock2/deps/riscv-coq/src/Spec/PseudoInstructions (real: 1.40, user: 0.47, sys: 0.21, mem: 338992 ko) bedrock2/bedrock2/src/BasicCSyntax (real: 1.40, user: 0.50, sys: 0.18, mem: 322924 ko) expr = fun (p : parameters) (add mul : bopname) (base : expr) => inr (Bytes 1, expr.op add (expr.op add (expr.op add base (expr.op mul (expr.literal 1) (expr.literal 30))) (expr.literal 15)) (expr.op mul (expr.literal 2) (expr.literal 1))) : forall p : parameters, bopname -> bopname -> expr -> PathError expr + type * expr COQC bedrock2/bedrock2/src/Markers.v COQC bedrock2/bedrock2/src/string2ident.v COQC bedrock2/bedrock2/src/Hexdump.v COQC bedrock2/bedrock2/src/ZNamesSyntax.v COQC bedrock2/deps/riscv-coq/src/Utility/div_mod_to_quot_rem.v COQC bedrock2/bedrock2/src/Variables.v COQC bedrock2/deps/riscv-coq/src/Utility/runsToNonDet.v COQC bedrock2/deps/riscv-coq/src/Utility/ZBitOps.v COQC bedrock2/bedrock2/src/StringNamesSyntax.v COQC bedrock2/bedrock2/src/Bytedump.v COQC bedrock2/bedrock2/src/Memory.v COQC bedrock2/deps/riscv-coq/src/Utility/Utility.v COQC bedrock2/deps/riscv-coq/src/Utility/prove_Zeq_bitwise.v COQC bedrock2/bedrock2/src/Map/Separation.v COQC bedrock2/bedrock2/src/StructNotations.v COQC bedrock2/deps/riscv-coq/src/Utility/Words32Naive.v COQC bedrock2/bedrock2/src/ToCString.v COQC bedrock2/deps/riscv-coq/src/Utility/Words64Naive.v COQC bedrock2/bedrock2/src/BytedumpTest.v COQC bedrock2/deps/riscv-coq/src/Utility/DefaultMemImpl32.v   !"#$%&'()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_`abcdefghijklmnopqrstuvwxyz{|}~ COQC bedrock2/bedrock2/src/Semantics.v COQC bedrock2/deps/riscv-coq/src/Spec/Decode.v COQC bedrock2/bedrock2/src/Map/SeparationLogic.v COQC bedrock2/deps/riscv-coq/src/Platform/Memory.v COQC bedrock2/deps/riscv-coq/src/Spec/Machine.v COQC bedrock2/bedrock2/src/WeakestPrecondition.v COQC bedrock2/deps/riscv-coq/src/Platform/RiscvMachine.v COQC bedrock2/bedrock2/src/Array.v COQC bedrock2/deps/riscv-coq/src/Utility/MkMachineWidth.v COQC bedrock2/deps/riscv-coq/src/Spec/VirtualMemory.v COQC bedrock2/bedrock2/src/BasicC64Syntax.v COQC bedrock2/deps/riscv-coq/src/Platform/MetricRiscvMachine.v COQC bedrock2/bedrock2/src/Examples/Trace.v COQC bedrock2/deps/riscv-coq/src/Spec/ExecuteM.v COQC bedrock2/deps/riscv-coq/src/Spec/ExecuteM64.v squarer_correct : forall (m : Semantics.mem) (l : Semantics.locals), exec map.empty squarer [] m l (fun (t' : trace) (_ : Semantics.mem) (_ : Semantics.locals) => squarer_trace t') squarer_correct : forall (m : Semantics.mem) (l : Semantics.locals), exec map.empty squarer [] m l (fun (t' : trace) (_ : Semantics.mem) (_ : Semantics.locals) => squarer_trace t') COQC bedrock2/bedrock2/src/Examples/StructAccess.v COQC bedrock2/deps/riscv-coq/src/Spec/PseudoInstructions.v COQC bedrock2/bedrock2/src/BasicCSyntax.v COQC bedrock2/deps/riscv-coq/src/Utility/InstructionCoercions.v COQC bedrock2/bedrock2/src/WeakestPreconditionFile "bedrock2/deps/riscv-coq/src/Utility/InstructionCoercions.v", line 10, characters 0-70: Warning: Declaring a scope implicitly is deprecated; use in advance an explicit "Declare Scope ilist_scope.". [undeclared-scope,deprecated] bedrock2/deps/riscv-coq/src/Utility/InstructionCoercions (real: 1.33, user: 0.43, sys: 0.21, mem: 313976 ko) bedrock2/deps/riscv-coq/src/Utility/DefaultMemImpl64 (real: 1.59, user: 0.52, sys: 0.25, mem: 375840 ko) bedrock2/deps/riscv-coq/src/Utility/Encode (real: 2.03, user: 0.67, sys: 0.31, mem: 446648 ko) bedrock2/deps/riscv-coq/src/Spec/Primitives (real: 2.21, user: 0.72, sys: 0.34, mem: 457772 ko) bedrock2/deps/riscv-coq/src/Spec/ExecuteI (real: 2.60, user: 0.94, sys: 0.32, mem: 454504 ko) bedrock2/deps/riscv-coq/src/Spec/ExecuteI64 (real: 1.85, user: 0.55, sys: 0.28, mem: 401008 ko) bedrock2/deps/riscv-coq/src/Spec/MetricPrimitives (real: 2.20, user: 0.76, sys: 0.30, mem: 459200 ko) bedrock2/deps/riscv-coq/src/Spec/Execute (real: 1.43, user: 0.44, sys: 0.24, mem: 336624 ko) bedrock2/deps/riscv-coq/src/Utility/InstructionNotations (real: 1.41, user: 0.44, sys: 0.24, mem: 340268 ko) bedrock2/deps/riscv-coq/src/Platform/Run (real: 1.69, user: 0.52, sys: 0.27, mem: 374676 ko) File "bedrock2/bedrock2/src/WeakestPreconditionProperties.v", line 193, characters 2-41: Warning: Adding and removing hints in the core database implicitly is deprecated. Please specify a hint database. [implicit-core-hint-db,deprecated] bedrock2/bedrock2/src/WeakestPreconditionProperties (real: 19.56, user: 9.19, sys: 0.41, mem: 663884 ko) bedrock2/bedrock2/src/FE310CSemantics (real: 8.23, user: 3.64, sys: 0.34, mem: 472892 ko) File "bedrock2/bedrock2/src/TailRecursion.v", line 16, characters 2-67: Warning: Notation "_ /\ _" was already used in scope type_scope. [notation-overridden,parsing] File "bedrock2/bedrock2/src/TailRecursion.v", line 47, characters 2-14: Warning: Notation "_ * _" was already used in scope type_scope. [notation-overridden,parsing] File "bedrock2/bedrock2/src/TailRecursion.v", line 47, characters 2-14: Warning: Notation "{ _ & _ }" was already used in scope type_scope. [notation-overridden,parsing] File "bedrock2/bedrock2/src/TailRecursion.v", line 47, characters 2-14: Warning: Notation "{ _ : _ & _ }" was already used in scope type_scope. [notation-overridden,parsing] File "bedrock2/bedrock2/src/TailRecursion.v", line 47, characters 2-14: Warning: Notation "{ ' _ : _ & _ }" was already used in scope type_scope. [notation-overridden,parsing] File "bedrock2/bedrock2/src/TailRecursion.v", line 47, characters 2-14: Warning: Notation "( _ , _ , .. , _ )" was already used in scope core_scope. [notation-overridden,parsing] File "bedrock2/bedrock2/src/TailRecursion.v", line 138, characters 2-49: Warning: Notation "_ * _" was already used in scope type_scope. [notation-overridden,parsing] bedrock2/bedrock2/src/TailRecursion (real: 3.43, user: 1.34, sys: 0.32, mem: 461368 ko) bedrock2/deps/riscv-coq/src/Platform/Minimal (real: 14.97, user: 6.99, sys: 0.33, mem: 482444 ko) File "bedrock2/bedrock2/src/ptsto_bytes.v", line 151, characters 6-173: Warning: Unused introduction patterns: R IH [unused-intro-pattern,tactics] File "bedrock2/bedrock2/src/ptsto_bytes.v", line 163, characters 6-132: Warning: Unused introduction patterns: R IH [unused-intro-pattern,tactics] bedrock2/bedrock2/src/ptsto_bytes (real: 4.33, user: 1.80, sys: 0.31, mem: 461200 ko) bedrock2/bedrock2/src/Examples/MultipleReturnValues (real: 1.64, user: 0.54, sys: 0.23, mem: 310296 ko) bedrock2/bedrock2/src/Examples/ARPResponder (real: 4.88, user: 2.06, sys: 0.33, mem: 465924 ko) bedrock2/bedrock2/src/Examples/chacha20 (real: 3.11, user: 1.25, sys: 0.26, mem: 435736 ko) Properties.v COQC bedrock2/deps/riscv-coq/src/Utility/DefaultMemImpl64.v COQC bedrock2/deps/riscv-coq/src/Utility/Encode.v COQC bedrock2/deps/riscv-coq/src/Spec/Primitives.v COQC bedrock2/deps/riscv-coq/src/Spec/ExecuteI.v COQC bedrock2/deps/riscv-coq/src/Spec/ExecuteI64.v COQC bedrock2/deps/riscv-coq/src/Spec/MetricPrimitives.v COQC bedrock2/deps/riscv-coq/src/Spec/Execute.v COQC bedrock2/deps/riscv-coq/src/Utility/InstructionNotations.v COQC bedrock2/deps/riscv-coq/src/Platform/Run.v COQC bedrock2/deps/riscv-coq/src/Platform/Minimal.v COQC bedrock2/bedrock2/src/FE310CSemantics.v COQC bedrock2/bedrock2/src/TailRecursion.v COQC bedrock2/bedrock2/src/ptsto_bytes.v COQC bedrock2/deps/riscv-coq/src/Platform/MinimalMMIO.v COQC bedrock2/bedrock2/src/Examples/MultipleReturnValues.v COQC bedrock2/bedrock2/src/Examples/ARPResponder.v COQC bedrock2/bedrock2/src/Examples/chacha20.v COQC bedrock2/bedrock2/src/Examples/Demos.v allProgs@{bedrock2.Examples.Demos.686 bedrock2.Examples.Demos.687} = [("bsearch", ([left; right; target], [left], (while (right - left) {{ mid = left + (right - left) >> 4 << 3;; (if (*(uintptr_t*) mid < target) {{ left = mid + 8 }} else {{ right = mid }});; cmd.unset mid }})%bedrock_cmd)); ("listsum", ([], [sumreg], (sumreg = 0;; n = *(uint32_t*) 1024;; ListSum.i = 0;; while (ListSum.i < n) {{ ListSum.a = *(uint32_t*) (1024 + 4 + 4 * ListSum.i);; sumreg = sumreg + ListSum.a;; ListSum.i = ListSum.i + 1 }})%bedrock_cmd)); ("fibonacci", ([], [b], (a = 0;; b = 1;; i = 0;; while (i < 6) {{ c = a + b;; a = b;; b = c;; i = i + 1 }})%bedrock_cmd))] : list Prog allProgs@{bedrock2.Examples.Demos.135 bedrock2.Examples.Demos.136 bedrock2.Examples.Demos.137 bedrock2.Examples.Demos.146 bedrock2.Examples.Demos.171 bedrock2.Examples.Demos.345 bedrock2.Examples.Demos.515 bedrock2.Examples.Demos.686 bedrock2.Examples.Demos.687} = fun (p : Syntax.parameters) (bsearchNames : BinarySearch.Names) (listsumNames : ListSum.Names) (fibonacciNames : Fibonacci.Names) => [("bsearch", ([BinarySearch.left; BinarySearch.right; BinarySearch.target], [BinarySearch.left], cmd.while (expr.op bopname.sub (var BinarySearch.right) (var BinarySearch.left)) (cmd.seq (cmd.set BinarySearch.mid (expr.op bopname.add (var BinarySearch.left) (expr.op bopname.slu (expr.op bopname.sru (expr.op bopname.sub (var BinarySearch.right) (var BinarySearch.left)) (literal 4)) (literal 3)))) (cmd.seq (cmd.cond (expr.op bopname.ltu (expr.load access_size.word (var BinarySearch.mid)) (var BinarySearch.target)) (cmd.set BinarySearch.left (expr.op bopname.add (var BinarySearch.mid) (literal 8))) (cmd.set BinarySearch.right (var BinarySearch.mid))) (cmd.unset BinarySearch.mid))))); ("listsum", ([], [ListSum.sumreg], cmd.seq (cmd.set ListSum.sumreg (literal 0)) (cmd.seq (cmd.set ListSum.n (expr.load access_size.four (literal 1024))) (cmd.seq (cmd.set ListSum.i (literal 0)) (cmd.while (expr.op bopname.ltu (var ListSum.i) (var ListSum.n)) (cmd.seq (cmd.set ListSum.a (expr.load access_size.four (expr.op bopname.add (literal (1024 + 4)) (expr.op bopname.mul (literal 4) (var ListSum.i))))) (cmd.seq (cmd.set ListSum.sumreg (expr.op bopname.add (var ListSum.sumreg) (var ListSum.a))) bedrock2/bedrock2/src/Examples/Demos (real: 1.93, user: 0.69, sys: 0.23, mem: 353168 ko) bedrock2/bedrock2/src/BasicC32Semantics (real: 1.66, user: 0.55, sys: 0.25, mem: 387552 ko) bedrock2/bedrock2/src/BasicC64Semantics (real: 1.74, user: 0.57, sys: 0.27, mem: 403188 ko) bedrock2/bedrock2/src/Scalars (real: 3.04, user: 1.18, sys: 0.30, mem: 457564 ko) bedrock2/bedrock2/src/TODO_absint (real: 2.93, user: 1.13, sys: 0.30, mem: 457912 ko) (cmd.set ListSum.i (expr.op bopname.add (var ListSum.i) (literal 1)))))))))); ("fibonacci", ([], [Fibonacci.b], cmd.seq (cmd.set Fibonacci.a (literal 0)) (cmd.seq (cmd.set Fibonacci.b (literal 1)) (cmd.seq (cmd.set Fibonacci.i (literal 0)) (cmd.while (expr.op bopname.ltu (var Fibonacci.i) (literal 6)) (cmd.seq (cmd.set Fibonacci.c (expr.op bopname.add (var Fibonacci.a) (var Fibonacci.b))) (cmd.seq (cmd.set Fibonacci.a (var Fibonacci.b)) (cmd.seq (cmd.set Fibonacci.b (var Fibonacci.c)) (cmd.set Fibonacci.i (expr.op bopname.add (var Fibonacci.i) (literal 1)))))))))))] : forall p : Syntax.parameters, BinarySearch.Names -> ListSum.Names -> Fibonacci.Names -> list Prog Arguments p, bsearchNames, listsumNames, fibonacciNames are implicit and maximally inserted allProgsAsCStrings@{} = ["uintptr_t bsearch(uintptr_t left, uintptr_t right, uintptr_t target) { uintptr_t mid; while ((right)-(left)) { mid = (left)+((((right)-(left))>>((uintptr_t)4ULL))<<((uintptr_t)3ULL)); if ((*(uintptr_t*)(mid))<(target)) { left = (mid)+((uintptr_t)8ULL); } else { right = mid; } // unset mid } return left; } "; "uintptr_t listsum() { uintptr_t n, sumreg, a, i; sumreg = (uintptr_t)0ULL; n = *(uint32_t*)((uintptr_t)1024ULL); i = (uintptr_t)0ULL; while ((i)<(n)) { a = *(uint32_t*)(((uintptr_t)1028ULL)+(((uintptr_t)4ULL)*(i))); sumreg = (sumreg)+(a); i = (i)+((uintptr_t)1ULL); } return sumreg; } "; "uintptr_t fibonacci() { uintptr_t a, b, c, i; a = (uintptr_t)0ULL; b = (uintptr_t)1ULL; i = (uintptr_t)0ULL; while ((i)<((uintptr_t)6ULL)) { c = (a)+(b); a = b; b = c; i = (i)+((uintptr_t)1ULL); } return b; } "] : list string allProgsWithZNames@{bedrock2.Examples.Demos.721} = [("bsearch", ([1; 2; 3], [1], cmd.while (expr.op bopname.sub (expr.var 2) (expr.var 1)) (cmd.seq (cmd.set 4 (expr.op bopname.add (expr.var 1) (expr.op bopname.slu (expr.op bopname.sru (expr.op bopname.sub (expr.var 2) (expr.var 1)) (expr.literal 4)) (expr.literal 3)))) (cmd.seq (cmd.cond (expr.op bopname.ltu (expr.load access_size.word (expr.var 4)) (expr.var 3)) (cmd.set 1 (expr.op bopname.add (expr.var 4) (expr.literal 8))) (cmd.set 2 (expr.var 4))) (cmd.unset 4))))); ("listsum", ([], [3], cmd.seq (cmd.set 3 (expr.literal 0)) (cmd.seq (cmd.set 1 (expr.load access_size.four (expr.literal 1024))) (cmd.seq (cmd.set 2 (expr.literal 0)) (cmd.while (expr.op bopname.ltu (expr.var 2) (expr.var 1)) (cmd.seq (cmd.set 4 (expr.load access_size.four (expr.op bopname.add (expr.literal 1028) (expr.op bopname.mul (expr.literal 4) (expr.var 2))))) (cmd.seq (cmd.set 3 (expr.op bopname.add (expr.var 3) (expr.var 4))) (cmd.set 2 (expr.op bopname.add (expr.var 2) (expr.literal 1)))))))))); ("fibonacci", ([], [2], cmd.seq (cmd.set 1 (expr.literal 0)) (cmd.seq (cmd.set 2 (expr.literal 1)) (cmd.seq (cmd.set 4 (expr.literal 0)) (cmd.while (expr.op bopname.ltu (expr.var 4) (expr.literal 6)) (cmd.seq (cmd.set 3 (expr.op bopname.add (expr.var 1) (expr.var 2))) (cmd.seq (cmd.set 1 (expr.var 2)) (cmd.seq (cmd.set 2 (expr.var 3)) (cmd.set 4 (expr.op bopname.add (expr.var 4) (expr.literal 1)))))))))))] : list (string * (list Z * list Z * cmd)) COQC bedrock2/bedrock2/src/BasicC32Semantics.v COQC bedrock2/bedrock2/src/BasicC64Semantics.v COQC bedrock2/bedrock2/src/Scalars.v COQC bedrock2/bedrock2/src/TODO_absint.v bedrock2/bedrock2/src/ProgramLogic (real: 1.65, user: 0.52, sys: 0.25, mem: 371960 ko) File "bedrock2/bedrock2/src/Examples/lightbulb.v", line 48, characters 0-36: Warning: Notation "_ * _" was already used in scope type_scope. [notation-overridden,parsing] bedrock2/bedrock2/src/Examples/lightbulb (real: 44.98, user: 21.59, sys: 0.37, mem: 525428 ko) File "bedrock2/bedrock2/src/Examples/swap.v", line 31, characters 24-60: Warning: Notation "_ * _" was already used in scope type_scope. [notation-overridden,parsing] bedrock2/bedrock2/src/Examples/swap (real: 8.68, user: 3.88, sys: 0.33, mem: 478956 ko) bedrock2/deps/riscv-coq/src/Platform/MinimalMMIO (real: 140.04, user: 67.92, sys: 0.50, mem: 590104 ko) bedrock2/deps/riscv-coq/src/Proofs/invert_encode_Fence (real: 19.81, user: 9.16, sys: 0.36, mem: 495544 ko) bedrock2/deps/riscv-coq/src/Proofs/invert_encode_R (real: 13.71, user: 6.32, sys: 0.36, mem: 478812 ko) bedrock2/deps/riscv-coq/src/Proofs/invert_encode_R_atomic (real: 18.82, user: 8.68, sys: 0.36, mem: 494004 ko) bedrock2/deps/riscv-coq/src/Proofs/invert_encode_I (real: 14.67, user: 6.82, sys: 0.30, mem: 485168 ko) bedrock2/deps/riscv-coq/src/Proofs/invert_encode_I_shift_57 (real: 13.83, user: 6.36, sys: 0.32, mem: 478692 ko) bedrock2/deps/riscv-coq/src/Proofs/invert_encode_I_shift_66 (real: 40.12, user: 19.20, sys: 0.36, mem: 526372 ko) bedrock2/deps/riscv-coq/src/Proofs/invert_encode_I_system (real: 10.48, user: 4.71, sys: 0.33, mem: 470712 ko) bedrock2/bedrock2/src/Examples/bsearch (real: 208.32, user: 101.50, sys: 0.51, mem: 564436 ko) bedrock2/deps/riscv-coq/src/Proofs/invert_encode_S (real: 25.56, user: 12.11, sys: 0.34, mem: 518652 ko) bedrock2/deps/riscv-coq/src/Proofs/invert_encode_SB (real: 55.25, user: 26.55, sys: 0.40, mem: 632108 ko) bedrock2/deps/riscv-coq/src/Proofs/invert_encode_U (real: 9.99, user: 4.46, sys: 0.31, mem: 468412 ko) bedrock2/bedrock2/src/Examples/FE310CompilerDemo (real: 83.94, user: 40.64, sys: 0.41, mem: 588832 ko) bedrock2/bedrock2/src/Examples/ipow (real: 19.97, user: 9.35, sys: 0.30, mem: 496100 ko) /bin/sh: 1: hexdump: not found bedrock2/deps/riscv-coq/src/Proofs/invert_encode_UJ (real: 39.56, user: 19.19, sys: 0.35, mem: 580040 ko) bedrock2/deps/riscv-coq/src/Proofs/invert_encode_FenceI (real: 14.48, user: 6.72, sys: 0.31, mem: 485544 ko) bedrock2/deps/riscv-coq/src/Utility/runsToNonDet_Run (real: 1.66, user: 0.58, sys: 0.23, mem: 408744 ko) bedrock2/deps/riscv-coq/src/Platform/MinimalLogging (real: 2.10, user: 0.74, sys: 0.27, mem: 460380 ko) bedrock2/deps/riscv-coq/src/Platform/MetricMinimal (real: 24.74, user: 11.74, sys: 0.31, mem: 501100 ko) COQC bedrock2/bedrock2/src/ProgramLogic.v COQC bedrock2/bedrock2/src/Examples/lightbulb.v = "uintptr_t lightbulb(uintptr_t packet, uintptr_t len) { uintptr_t ethertype, protocol, mmio_val, command, r; ethertype = ((*(uint8_t*)((packet)+((uintptr_t)12ULL)))<<((uintptr_t)8ULL))|(*(uint8_t*)((packet)+((uintptr_t)13ULL))); if (((uintptr_t)1535ULL)<(ethertype)) { protocol = *(uint8_t*)((packet)+((uintptr_t)23ULL)); if ((protocol)==((uintptr_t)17ULL)) { command = *(uint8_t*)((packet)+((uintptr_t)42ULL)); mmio_val = MMIOREAD((uintptr_t)268509192ULL); MMIOWRITE((uintptr_t)268509192ULL, (mmio_val)|(((uintptr_t)1ULL)<<((uintptr_t)23ULL))); mmio_val = MMIOREAD((uintptr_t)268509196ULL); MMIOWRITE((uintptr_t)268509196ULL, (mmio_val)|((command)<<((uintptr_t)23ULL))); r = (uintptr_t)0ULL; } else { r = (uintptr_t)-1ULL; } } else { r = (uintptr_t)-1ULL; } return r; } " : string COQC bedrock2/bedrock2/src/Examples/swap.v static void swap(uintptr_t a, uintptr_t b); void swap_swap(uintptr_t a, uintptr_t b) { swap(a, b); swap(a, b); return; } static void swap(uintptr_t a, uintptr_t b) { uintptr_t t; t = *(uintptr_t*)(b); *(uintptr_t*)(b) = *(uintptr_t*)(a); *(uintptr_t*)(a) = t; return; } COQC bedrock2/bedrock2/src/Examples/bsearch.v H19 H13 COQC bedrock2/deps/riscv-coq/src/Proofs/invert_encode_Fence.v COQC bedrock2/deps/riscv-coq/src/Proofs/invert_encode_R.v COQC bedrock2/deps/riscv-coq/src/Proofs/invert_encode_R_atomic.v COQC bedrock2/deps/riscv-coq/src/Proofs/invert_encode_I.v COQC bedrock2/deps/riscv-coq/src/Proofs/invert_encode_I_shift_57.v COQC bedrock2/deps/riscv-coq/src/Proofs/invert_encode_I_shift_66.v COQC bedrock2/deps/riscv-coq/src/Proofs/invert_encode_I_system.v COQC bedrock2/deps/riscv-coq/src/Proofs/invert_encode_S.v COQC bedrock2/bedrock2/src/Examples/FE310CompilerDemo.v COQC bedrock2/deps/riscv-coq/src/Proofs/invert_encode_SB.v COQC bedrock2/deps/riscv-coq/src/Proofs/invert_encode_U.v COQC bedrock2/deps/riscv-coq/src/Proofs/invert_encode_UJ.v COQC bedrock2/bedrock2/src/Examples/ipow.v make[3]: Leaving directory 'bedrock2/bedrock2' make src/BytedumpTest.out make[3]: Entering directory 'bedrock2/bedrock2' coqc -q -Q src bedrock2 -Q bedrock2/deps/coqutil/src coqutil src/BytedumpTest.v | head --bytes -1 > src/BytedumpTest.out.tmp hexdump < /dev/null && \ hexdump -C src/BytedumpTest.golden.bin > src/BytedumpTest.golden.hex && \ hexdump -C src/BytedumpTest.out.tmp > src/BytedumpTest.out.hex && \ diff -u src/BytedumpTest.golden.hex src/BytedumpTest.out.hex && \ rm src/BytedumpTest.golden.hex src/BytedumpTest.out.hex || true diff -u src/BytedumpTest.golden.bin src/BytedumpTest.out.tmp mv src/BytedumpTest.out.tmp src/BytedumpTest.out make[3]: Leaving directory 'bedrock2/bedrock2' make[2]: Leaving directory 'bedrock2/bedrock2' COQC bedrock2/deps/riscv-coq/src/Proofs/invert_encode_FenceI.v COQC bedrock2/deps/riscv-coq/src/Proofs/EncodeBound.v COQC bedrock2/deps/riscv-coq/src/Utility/runsToNonDet_Run.v COQC bedrock2/deps/riscv-coq/src/Platform/MinimalLogging.v COQC bedrock2/deps/riscv-coq/src/Platform/MetricMinimal.v COQC bedrock2/deps/riscv-coq/src/Platform/Example.v = [({| SortedList.value := []; SortedList._value_ok := eq_refl |}, EvLoadWord 36 (IInstruction (Blt 9 19 (-16))), [], ({| SortedList.value := []; SortedList._value_ok := eq_refl |}, [])); ({| SortedList.value := []; SortedList._value_ok := eq_refl |}, EvLoadWord 32 (IInstruction (Addi 9 9 1)), [], ({| SortedList.value := []; SortedList._value_ok := eq_refl |}, [])); ({| SortedList.value := []; SortedList._value_ok := eq_refl |}, EvLoadWord 28 (IInstruction (Addi 18 21 0)), [], ({| SortedList.value := []; SortedList._value_ok := eq_refl |}, [])); ({| SortedList.value := []; SortedList._value_ok := eq_refl |}, EvLoadWord 24 (IInstruction (Addi 20 18 0)), [], ({| SortedList.value := []; SortedList._value_ok := eq_refl |}, [])); ({| SortedList.value := []; SortedList._value_ok := eq_refl |}, EvLoadWord 20 (IInstruction (Add 21 20 18)), [], ({| SortedList.value := []; SortedList._value_ok := eq_refl |}, [])); ({| SortedList.value := []; SortedList._value_ok := eq_refl |}, EvLoadWord 36 (IInstruction (Blt 9 19 (-16))), [], ({| SortedList.value := []; SortedList._value_ok := eq_refl |}, [])); ({| SortedList.value := []; SortedList._value_ok := eq_refl |}, EvLoadWord 32 (IInstruction (Addi 9 9 1)), [], ({| SortedList.value := []; SortedList._value_ok := eq_refl |}, [])); ({| SortedList.value := []; SortedList._value_ok := eq_refl |}, EvLoadWord 28 (IInstruction (Addi 18 21 0)), [], ({| SortedList.value := []; SortedList._value_ok := eq_refl |}, [])); ({| SortedList.value := []; SortedList._value_ok := eq_refl |}, EvLoadWord 24 (IInstruction (Addi 20 18 0)), [], ({| SortedList.value := []; SortedList._value_ok := eq_refl |}, [])); ({| SortedList.value := []; SortedList._value_ok := eq_refl |}, EvLoadWord 20 (IInstruction (Add 21 20 18)), [], ({| SortedList.value := []; SortedList._value_ok := eq_refl |}, [])); ({| SortedList.value := []; SortedList._value_ok := eq_refl |}, EvLoadWord 36 (IInstruction (Blt 9 19 (-16))), [], ({| SortedList.value := []; SortedList._value_ok := eq_refl |}, [])); ({| SortedList.value := []; SortedList._value_ok := eq_refl |}, EvLoadWord 32 (IInstruction (Addi 9 9 1)), [], ({| SortedList.value := []; SortedList._value_ok := eq_refl |}, [])); ({| SortedList.value := []; SortedList._value_ok := eq_refl |}, EvLoadWord 28 (IInstruction (Addi 18 21 0)), [], ({| SortedList.value := []; SortedList._value_ok := eq_refl |}, [])); ({| SortedList.value := []; SortedList._value_ok := eq_refl |}, EvLoadWord 24 (IInstruction (Addi 20 18 0)), [], ({| SortedList.value := []; SortedList._value_ok := eq_refl |}, [])); ({| SortedList.value := []; SortedList._value_ok := eq_refl |}, EvLoadWord 20 (IInstruction (Add 21 20 18)), [], ({| SortedList.value := []; SortedList._value_ok := eq_refl |}, [])); ({| SortedList.value := []; SortedList._value_ok := eq_refl |}, EvLoadWord 36 (IInstruction (Blt 9 19 (-16))), [], ({| SortedList.value := []; SortedList._value_ok := eq_refl |}, [])); ({| SortedList.value := []; SortedList._value_ok := eq_refl |}, EvLoadWord 32 (IInstruction (Addi 9 9 1)), [], ({| SortedList.value := []; SortedList._value_ok := eq_refl |}, [])); ({| SortedList.value := []; SortedList._value_ok := eq_refl |}, EvLoadWord 28 (IInstruction (Addi 18 21 0)), [], ({| SortedList.value := []; SortedList._value_ok := eq_refl |}, [])); ({| SortedList.value := []; SortedList._value_ok := eq_refl |}, EvLoadWord 24 (IInstruction (Addi 20 18 0)), [], ({| SortedList.value := []; SortedList._value_ok := eq_refl |}, [])); ({| SortedList.value := []; SortedList._value_ok := eq_refl |}, EvLoadWord 20 (IInstruction (Add 21 20 18)), [], ({| SortedList.value := []; SortedList._value_ok := eq_refl |}, [])); ({| SortedList.value := []; SortedList._value_ok := eq_refl |}, EvLoadWord 36 (IInstruction (Blt 9 19 (-16))), [], ({| SortedList.value := []; Sbedrock2/deps/riscv-coq/src/Platform/Example (real: 4.13, user: 1.62, sys: 0.27, mem: 468188 ko) bedrock2/deps/riscv-coq/src/Proofs/DecodeEncodeProver (real: 2.54, user: 0.94, sys: 0.29, mem: 450352 ko) bedrock2/deps/riscv-coq/src/Platform/Example64Literal (real: 2.12, user: 0.76, sys: 0.28, mem: 409784 ko) bedrock2/deps/riscv-coq/src/Proofs/DecodeEncodeA64 (real: 55.42, user: 26.45, sys: 0.45, mem: 605916 ko) bedrock2/deps/riscv-coq/src/Proofs/EncodeBound (real: 103.45, user: 50.15, sys: 0.41, mem: 573560 ko) bedrock2/deps/riscv-coq/src/Proofs/DecodeEncodeI64 (real: 53.82, user: 25.80, sys: 0.43, mem: 650288 ko) bedrock2/deps/riscv-coq/src/Proofs/DecodeEncodeA (real: 60.04, user: 28.68, sys: 0.44, mem: 639092 ko) bedrock2/deps/riscv-coq/src/Proofs/DecodeEncodeCSR (real: 215.18, user: 104.22, sys: 0.79, mem: 997556 ko) bedrock2/deps/riscv-coq/src/Proofs/DecodeEncodeM64 (real: 21.95, user: 9.77, sys: 0.34, mem: 523092 ko) bedrock2/deps/riscv-coq/src/Proofs/DecodeEncodeM (real: 47.35, user: 22.60, sys: 0.37, mem: 589708 ko) bedrock2/deps/riscv-coq/src/Proofs/DecodeEncodeI (real: 226.75, user: 139.56, sys: 1.26, mem: 1730872 ko) bedrock2/deps/riscv-coq/src/Proofs/DecodeEncode (real: 0.81, user: 0.42, sys: 0.18, mem: 374624 ko) ortedList._value_ok := eq_refl |}, [])); ({| SortedList.value := []; SortedList._value_ok := eq_refl |}, EvLoadWord 32 (IInstruction (Addi 9 9 1)), [], ({| SortedList.value := []; SortedList._value_ok := eq_refl |}, [])); ({| SortedList.value := []; SortedList._value_ok := eq_refl |}, EvLoadWord 28 (IInstruction (Addi 18 21 0)), [], ({| SortedList.value := []; SortedList._value_ok := eq_refl |}, [])); ({| SortedList.value := []; SortedList._value_ok := eq_refl |}, EvLoadWord 24 (IInstruction (Addi 20 18 0)), [], ({| SortedList.value := []; SortedList._value_ok := eq_refl |}, [])); ({| SortedList.value := []; SortedList._value_ok := eq_refl |}, EvLoadWord 20 (IInstruction (Add 21 20 18)), [], ({| SortedList.value := []; SortedList._value_ok := eq_refl |}, [])); ({| SortedList.value := []; SortedList._value_ok := eq_refl |}, EvLoadWord 36 (IInstruction (Blt 9 19 (-16))), [], ({| SortedList.value := []; SortedList._value_ok := eq_refl |}, [])); ({| SortedList.value := []; SortedList._value_ok := eq_refl |}, EvLoadWord 32 (IInstruction (Addi 9 9 1)), [], ({| SortedList.value := []; SortedList._value_ok := eq_refl |}, [])); ({| SortedList.value := []; SortedList._value_ok := eq_refl |}, EvLoadWord 28 (IInstruction (Addi 18 21 0)), [], ({| SortedList.value := []; SortedList._value_ok := eq_refl |}, [])); ({| SortedList.value := []; SortedList._value_ok := eq_refl |}, EvLoadWord 24 (IInstruction (Addi 20 18 0)), [], ({| SortedList.value := []; SortedList._value_ok := eq_refl |}, [])); ({| SortedList.value := []; SortedList._value_ok := eq_refl |}, EvLoadWord 20 (IInstruction (Add 21 20 18)), [], ({| SortedList.value := []; SortedList._value_ok := eq_refl |}, [])); ({| SortedList.value := []; SortedList._value_ok := eq_refl |}, EvLoadWord 36 (IInstruction (Blt 9 19 (-16))), [], ({| SortedList.value := []; SortedList._value_ok := eq_refl |}, [])); ({| SortedList.value := []; SortedList._value_ok := eq_refl |}, EvLoadWord 16 (IInstruction (Jal 0 20)), [], ({| SortedList.value := []; SortedList._value_ok := eq_refl |}, [])); ({| SortedList.value := []; SortedList._value_ok := eq_refl |}, EvLoadWord 12 (IInstruction (Addi 9 0 0)), [], ({| SortedList.value := []; SortedList._value_ok := eq_refl |}, [])); ({| SortedList.value := []; SortedList._value_ok := eq_refl |}, EvLoadWord 8 (IInstruction (Addi 18 0 1)), [], ({| SortedList.value := []; SortedList._value_ok := eq_refl |}, [])); ({| SortedList.value := []; SortedList._value_ok := eq_refl |}, EvLoadWord 4 (IInstruction (Addi 20 0 0)), [], ({| SortedList.value := []; SortedList._value_ok := eq_refl |}, [])); ({| SortedList.value := []; SortedList._value_ok := eq_refl |}, EvLoadWord 0 (IInstruction (Addi 19 0 6)), [], ({| SortedList.value := []; SortedList._value_ok := eq_refl |}, []))] : list (LogItem LogEvent) COQC bedrock2/deps/riscv-coq/src/Proofs/DecodeEncodeProver.v COQC bedrock2/deps/riscv-coq/src/Platform/Example64Literal.v = {| unsigned := 1073745919; _unsigned_in_range := eq_refl |} : word64 COQC bedrock2/deps/riscv-coq/src/Proofs/DecodeEncodeA64.v COQC bedrock2/deps/riscv-coq/src/Proofs/DecodeEncodeCSR.v COQC bedrock2/deps/riscv-coq/src/Proofs/DecodeEncodeI64.v COQC bedrock2/deps/riscv-coq/src/Proofs/DecodeEncodeA.v COQC bedrock2/deps/riscv-coq/src/Proofs/DecodeEncodeI.v COQC bedrock2/deps/riscv-coq/src/Proofs/DecodeEncodeM64.v COQC bedrock2/deps/riscv-coq/src/Proofs/DecodeEncodeM.v COQC bedrock2/deps/riscv-coq/src/Proofs/DecodeEncode.v make[3]: Leaving directory 'bedrock2/deps/riscv-coq' make[2]: Leaving directory 'bedrock2/deps/riscv-coq' make -C bedrock2/compiler make -C bedrock2/deps/kami make[2]: Entering directory 'bedrock2/compiler' printf -- '-Q ../bedrock2/src bedrock2\n-Q bedrock2/deps/coqutil/src coqutil\n-Q bedrock2/deps/riscv-coq/src riscv\n-Q ./lib lib\n-Q ./src compiler\n' > _CoqProject /builds/coq/coq/_install_ci/bin/coq_makefile -f _CoqProject INSTALLDEFAULTROOT = bedrock2 -arg "-async-proofs-tac-j 1" bedrock2/compiler/src/EmitsValid.v bedrock2/compiler/src/util/Misc.v bedrock2/compiler/src/util/Learning.v bedrock2/compiler/src/util/Tactics.v bedrock2/compiler/src/util/MyOmega.v bedrock2/compiler/src/util/ListLib.v bedrock2/compiler/src/util/Set.v bedrock2/compiler/src/util/SetSolverTests.v bedrock2/compiler/src/util/Common.v bedrock2/compiler/src/util/LogGoal.v bedrock2/compiler/src/SeparationLogic.v bedrock2/compiler/src/ExprImp.v bedrock2/compiler/src/FlatToRiscv32.v bedrock2/compiler/src/FlatToRiscv.v bedrock2/compiler/src/on_hyp_containing.v bedrock2/compiler/src/Basic32Semantics.v bedrock2/compiler/src/Simp.v bedrock2/compiler/src/FlatToRiscvDef.v bedrock2/compiler/src/RegAlloc3.v bedrock2/compiler/src/RegAllocAnnotatedNotations.v bedrock2/compiler/src/UnmappedMemForExtSpec.v bedrock2/compiler/src/RegAlloc2.v bedrock2/compiler/src/NoActionSyntaxParams.v bedrock2/compiler/src/Pipeline.v bedrock2/compiler/src/RiscvWordProperties.v bedrock2/compiler/src/GoFlatToRiscv.v bedrock2/compiler/src/Rem4.v bedrock2/compiler/src/SimplWordExpr.v bedrock2/compiler/src/ZNameGen.v bedrock2/compiler/src/NameGen.v bedrock2/compiler/src/FlatImp.v bedrock2/compiler/src/FlattenExpr.v bedrock2/compiler/src/eqexact.v bedrock2/compiler/src/examples/swap_bytes_over_uart_hexdump.v bedrock2/compiler/src/examples/TestExprImp.v bedrock2/compiler/src/examples/highlevel/FuncMut.v bedrock2/compiler/src/examples/highlevel/For.v bedrock2/compiler/src/examples/InlineAssemblyMacro.v bedrock2/compiler/src/examples/CompileExamples.v bedrock2/compiler/src/examples/toposort.v bedrock2/compiler/src/examples/FE310Compiler.v bedrock2/compiler/src/examples/EditDistExample.v bedrock2/compiler/src/examples/Fibonacci.v bedrock2/compiler/src/examples/TestFlatImp.v bedrock2/compiler/src/examples/MMIO.v bedrock2/compiler/lib/LibTacticsMin.v bedrock2/compiler/lib/fiat_crypto_tactics/Not.v bedrock2/compiler/lib/fiat_crypto_tactics/Test.v bedrock2/compiler/lib/fiat_crypto_tactics/UniquePose.v bedrock2/compiler/lib/LibTactics.v -o Makefile.coq.all make[2]: Entering directory 'bedrock2/deps/kami' printf -- '-R Kami Kami\n-Q bedrock2/deps/Warning: ../bedrock2/src (used in -R or -Q) is not a subdirectory of the current directory Warning: bedrock2/deps/riscv-coq/src (used in -R or -Q) is not a subdirectory of the current directory Warning: no common logical root Warning: in such case INSTALLDEFAULTROOT must be defined Warning: the install-doc target is going to install files Warning: in orphan_riscv_coqutil_Kami bedrock2/compiler/lib/fiat_crypto_tactics/Test (real: 0.17, user: 0.04, sys: 0.04, mem: 55660 ko) File "bedrock2/compiler/lib/LibTacticsMin.v", line 76, characters 0-32: Warning: Adding and removing hints in the core database implicitly is deprecated. Please specify a hint database. [implicit-core-hint-db,deprecated] File "bedrock2/compiler/lib/LibTacticsMin.v", line 121, characters 0-42: Warning: Declaring a scope implicitly is deprecated; use in advance an explicit "Declare Scope ltac_scope.". [undeclared-scope,deprecated] File "bedrock2/compiler/lib/LibTacticsMin.v", line 463, characters 0-16: Warning: Adding and removing hints in the core database implicitly is deprecated. Please specify a hint database. [implicit-core-hint-db,deprecated] bedrock2/compiler/lib/LibTacticsMin (real: 0.92, user: 0.31, sys: 0.14, mem: 301996 ko) bedrock2/compiler/src/NoActionSyntaxParams (real: 0.17, user: 0.04, sys: 0.03, mem: 57364 ko) bedrock2/compiler/lib/fiat_crypto_tactics/UniquePose (real: 0.16, user: 0.04, sys: 0.03, mem: 57340 ko) File "./Kami/Lib/StringAsOT.v", line 86, characters 2-38: Warning: Adding and removing hints in the core database implicitly is deprecated. Please specify a hint database. [implicit-core-hint-db,deprecated] Kami/Lib/StringAsOT (real: 1.80, user: 0.70, sys: 0.19, mem: 423260 ko) bedrock2/compiler/src/Simp (real: 1.02, user: 0.36, sys: 0.13, mem: 298624 ko) bedrock2/compiler/src/util/Misc (real: 0.19, user: 0.05, sys: 0.04, mem: 70976 ko) bedrock2/compiler/src/util/Learning (real: 0.16, user: 0.04, sys: 0.03, mem: 58420 ko) File "./Kami/Lib/CommonTactics.v", line 276, characters 0-39: Warning: Adding and removing hints in the core database implicitly is deprecated. Please specify a hint database. [implicit-core-hint-db,deprecated] File "./Kami/Lib/CommonTactics.v", line 277, characters 0-92: Warning: Adding and removing hints in the core database implicitly is deprecated. Please specify a hint database. [implicit-core-hint-db,deprecated] Kami/Lib/CommonTactics (real: 1.03, user: 0.38, sys: 0.13, mem: 319992 ko) bedrock2/compiler/src/util/MyOmega (real: 0.97, user: 0.33, sys: 0.14, mem: 289700 ko) bedrock2/compiler/src/util/LogGoal (real: 0.15, user: 0.03, sys: 0.03, mem: 54716 ko) Kami/Lib/StringEq (real: 1.50, user: 0.55, sys: 0.18, mem: 413664 ko) File "bedrock2/compiler/src/SeparationLogic.v", line 10, characters 0-29: Warning: Declaring a scope implicitly is deprecated; use in advance an explicit "Declare Scope sep_scope.". [undeclared-scope,deprecated] bedrock2/compiler/src/SeparationLogic (real: 1.37, user: 0.48, sys: 0.16, mem: 352200 ko) Kami/Lib/Nomega (real: 1.17, user: 0.38, sys: 0.19, mem: 363832 ko) Kami/Lib/DepEq (real: 0.46, user: 0.14, sys: 0.08, mem: 160816 ko) Kami/Lib/VectorFacts (real: 0.56, user: 0.17, sys: 0.09, mem: 180940 ko) bedrock2/compiler/src/Rem4 (real: 1.86, user: 0.68, sys: 0.21, mem: 447424 ko) bedrock2/compiler/src/SimplWordExpr (real: 1.85, user: 0.67, sys: 0.22, mem: 446424 ko) Kami/Lib/StringAsList (real: 2.62, user: 1.08, sys: 0.20, mem: 421756 ko) Kami/Lib/FinNotations (real: 0.43, user: 0.13, sys: 0.07, mem: 142092 ko) bedrock2/compiler/src/RiscvWordProperties (real: 1.24, user: 0.43, sys: 0.18, mem: 362292 ko) bedrock2/compiler/src/eqexact (real: 0.15, user: 0.04, sys: 0.03, mem: 56364 ko) bedrock2/compiler/src/on_hyp_containing (real: 0.15, user: 0.04, sys: 0.03, mem: 56680 ko) Kami/Lib/Reflection (real: 1.00, user: 0.34, sys: 0.15, mem: 328692 ko) Kami/Lib/Concat (real: 1.06, user: 0.36, sys: 0.16, mem: 338456 ko) bedrock2/compiler/src/Basic32Semantics (real: 1.46, user: 0.50, sys: 0.20, mem: 385968 ko) riscv-coq/src riscv\n-Q bedrock2/deps/coqutil/src coqutil\n' > _CoqProject make -f Makefile.coq.all make[3]: Entering directory 'bedrock2/compiler' /builds/coq/coq/_install_ci/bin/coq_makefile -f _CoqProject Kami/Lib/StringStringAsOT.v Kami/Lib/FMap.v Kami/Lib/ilist.v Kami/Lib/Indexer.v Kami/Lib/DepEq.v Kami/Lib/Nomega.v Kami/Lib/StringEq.v Kami/Lib/Misc.v Kami/Lib/Word.v Kami/Lib/FinNotations.v Kami/Lib/Reflection.v Kami/Lib/NatLib.v Kami/Lib/StringAsList.v Kami/Lib/Concat.v Kami/Lib/ListSupport.v Kami/Lib/VectorFacts.v Kami/Lib/StringAsOT.v Kami/Lib/CommonTactics.v Kami/Lib/WordSupport.v Kami/Lib/BasicLogic.v Kami/Lib/DepEqNat.v Kami/Lib/Struct.v Kami/SemFacts.v Kami/ParametricInlineLtac.v Kami/PartialInlineFacts.v Kami/Wf.v Kami/Semantics.v Kami/ParametricSyntax.v Kami/Inline.v Kami/StepDet.v Kami/InlineFacts.v Kami/Amortization.v Kami/Tutorial.v Kami/Label.v Kami/MapReifyEx.v Kami/ParametricEquiv.v Kami/ParametricInline.v Kami/Notations.v Kami/Substitute.v Kami/ParametricWf.v Kami/ParamDup.v Kami/SymEval.v Kami/Syntax.v Kami/ModuleBoundEx.v Kami/Tactics.v Kami/SymEvalTac.v Kami/ModularFacts.v Kami/Synthesize.v Kami/RefinementFacts.v Kami/Decomposition.v Kami/Renaming.v Kami/Kami.v Kami/Duplicate.v Kami/ModuleBound.v Kami/Specialize.v Kami/Ex/ProcThreeStage.v Kami/Ex/SimpleFifoCorrect.v Kami/Ex/IsaRv32PgmExt.v Kami/Ex/ProcThreeStInv.v Kami/Ex/Divider32.v Kami/Ex/SC.v Kami/Ex/Names.v Kami/Ex/OneEltFifo.v Kami/Ex/Multiplier64.v Kami/Ex/Multiplier32.v Kami/Ex/ProcFDInv.v Kami/Ex/ProcDec.v Kami/Ex/ProcFourStDec.v Kami/Ex/IsaRv32.v Kami/Ex/MemAtomic.v Kami/Ex/ProcFDInl.v Kami/Ex/IsaRv32Pgm.v Kami/Ex/Divider64.v Kami/Ex/Fifo.v Kami/Ex/ProcThreeStInl.v Kami/Ex/ProcDecSC.v Kami/Ex/ProcDecSCN.v Kami/Ex/NativeFifo.v Kami/Ex/FifoCorrect.v Kami/Ex/ProcThreeStDec.v Kami/Ex/RegFile.v Kami/Ex/InDepthTutorial.v Kami/Ex/ProcDecInv.v Kami/Ex/ProcFetchDecode.v Kami/Ex/SCMMInl.v Kami/Ex/ProcFDCorrect.v Kami/Ex/MemTypes.v Kami/Ex/ProcDecInl.v Kami/Ex/IsaRv32/PgmFact.v Kami/Ex/IsaRv32/PgmMatMulReport.v Kami/Ex/IsaRv32/PgmBankerWorker3.v Kami/Ex/IsaRv32/PgmGcd.v Kami/Ex/IsaRv32/PgmMatMulInit.v Kami/Ex/IsaRv32/PgmPeterson2.v Kami/Ex/IsaRv32/PgmHanoi.v Kami/Ex/IsaRv32/PgmBankerWorker1.v Kami/Ex/IsaRv32/PgmPeterson1.v Kami/Ex/IsaRv32/PgmBankerInit.v Kami/Ex/IsaRv32/PgmMatMulNormal1.v Kami/Ex/IsaRv32/PgmDekker1.v Kami/Ex/IsaRv32/PgmBankerWorker2.v Kami/Ex/IsaRv32/PgmBsort.v Kami/Ex/IsaRv32/PgmMatMulNormal2.v Kami/Ex/IsaRv32/PgmDekker2.v Kami/Ext/Extraction.v Kami/Ext/BSyntax.v -o Makefile.coq.all make -f Makefile.coq.all make[3]: Entering directory 'bedrock2/deps/kami' COQDEP VFILES COQDEP VFILES COQC bedrock2/compiler/lib/fiat_crypto_tactics/Test.v COQC bedrock2/compiler/lib/LibTacticsMin.v COQC Kami/Lib/StringAsOT.v COQC bedrock2/compiler/src/NoActionSyntaxParams.v COQC bedrock2/compiler/lib/fiat_crypto_tactics/UniquePose.v COQC bedrock2/compiler/src/Simp.v COQC Kami/Lib/CommonTactics.v COQC bedrock2/compiler/src/util/Misc.v COQC bedrock2/compiler/src/util/Learning.v COQC bedrock2/compiler/src/util/MyOmega.v COQC Kami/Lib/StringEq.v COQC bedrock2/compiler/src/util/LogGoal.v COQC bedrock2/compiler/src/SeparationLogic.v COQC Kami/Lib/Nomega.v COQC bedrock2/compiler/src/Rem4.v COQC Kami/Lib/DepEq.v COQC Kami/Lib/VectorFacts.v COQC Kami/Lib/StringAsList.v COQC bedrock2/compiler/src/SimplWordExpr.v COQC bedrock2/compiler/src/RiscvWordProperties.v COQC Kami/Lib/FinNotations.v COQC Kami/Lib/Reflection.v COQC bedrock2/compiler/src/eqexact.v COQC bedrock2/compiler/src/on_hyp_containing.v COQC bedrock2/compiler/src/Basic32Semantics.v COQC Kami/Lib/Concat.v COQC Kami/LKami/Lib/ListSupport (real: 1.09, user: 0.37, sys: 0.15, mem: 353524 ko) File "bedrock2/compiler/src/UnmappedMemForExtSpec.v", line 45, characters 2-49: Warning: Adding and removing hints in the core database implicitly is deprecated. Please specify a hint database. [implicit-core-hint-db,deprecated] File "bedrock2/compiler/src/UnmappedMemForExtSpec.v", line 47, characters 2-30: Warning: Adding and removing hints in the core database implicitly is deprecated. Please specify a hint database. [implicit-core-hint-db,deprecated] Kami/Lib/BasicLogic (real: 0.24, user: 0.07, sys: 0.03, mem: 87856 ko) Kami/Lib/DepEqNat (real: 0.22, user: 0.06, sys: 0.03, mem: 76484 ko) bedrock2/compiler/src/UnmappedMemForExtSpec (real: 1.68, user: 0.61, sys: 0.21, mem: 446012 ko) Kami/Ex/Names (real: 1.02, user: 0.36, sys: 0.13, mem: 271052 ko) bedrock2/compiler/src/NameGen (real: 0.95, user: 0.32, sys: 0.15, mem: 286108 ko) bedrock2/compiler/src/examples/highlevel/For (real: 0.15, user: 0.04, sys: 0.02, mem: 55764 ko) Kami/Lib/StringStringAsOT (real: 1.73, user: 0.63, sys: 0.19, mem: 420276 ko) bedrock2/compiler/src/examples/toposort (real: 2.47, user: 0.98, sys: 0.21, mem: 426872 ko) File "bedrock2/compiler/lib/LibTactics.v", line 55, characters 0-32: Warning: Adding and removing hints in the core database implicitly is deprecated. Please specify a hint database. [implicit-core-hint-db,deprecated] File "bedrock2/compiler/lib/LibTactics.v", line 100, characters 0-42: Warning: Declaring a scope implicitly is deprecated; use in advance an explicit "Declare Scope ltac_scope.". [undeclared-scope,deprecated] File "bedrock2/compiler/lib/LibTactics.v", line 581, characters 0-16: Warning: Adding and removing hints in the core database implicitly is deprecated. Please specify a hint database. [implicit-core-hint-db,deprecated] File "bedrock2/compiler/lib/LibTactics.v", line 4771, characters 0-28: Warning: skip_axiom is declared as a local axiom [local-declaration,scope] File "bedrock2/compiler/lib/LibTactics.v", line 4998, characters 0-196: Warning: Declaring a scope implicitly is deprecated; use in advance an explicit "Declare Scope let_scope.". [undeclared-scope,deprecated] Kami/Lib/NatLib (real: 3.58, user: 1.52, sys: 0.22, mem: 429812 ko) bedrock2/compiler/lib/LibTactics (real: 2.73, user: 1.10, sys: 0.23, mem: 419492 ko) bedrock2/compiler/lib/fiat_crypto_tactics/Not (real: 0.17, user: 0.05, sys: 0.03, mem: 56680 ko) bedrock2/compiler/src/util/Tactics (real: 1.16, user: 0.40, sys: 0.17, mem: 282384 ko) Kami/Lib/ilist (real: 2.17, user: 0.82, sys: 0.23, mem: 422368 ko) bedrock2/compiler/src/util/Common (real: 1.69, user: 0.59, sys: 0.22, mem: 371952 ko) Kami/Lib/Indexer (real: 2.29, user: 0.90, sys: 0.21, mem: 421100 ko) bedrock2/compiler/src/util/ListLib (real: 2.24, user: 0.88, sys: 0.22, mem: 427540 ko) Kami/Lib/Misc (real: 1.05, user: 0.35, sys: 0.16, mem: 299684 ko) bedrock2/compiler/src/util/Set (real: 0.96, user: 0.30, sys: 0.14, mem: 282580 ko) File "./Kami/Lib/Word.v", line 19, characters 0-35: Warning: Declaring a scope implicitly is deprecated; use in advance an explicit "Declare Scope word_scope.". [undeclared-scope,deprecated] File "./Kami/Lib/Word.v", line 147, characters 0-28: Warning: Adding and removing hints in the core database implicitly is deprecated. Please specify a hint database. [implicit-core-hint-db,deprecated] File "./Kami/Lib/Word.v", line 400, characters 0-45: Warning: Adding and removing hints in the core database implicitly is deprecated. Please specify a hint database. [implicit-core-hint-db,deprecated] File "./Kami/Lib/Word.v", line 1090, characters 0-43: Warning: Adding and removing hints in the core database implicitly is deprecated. Please specify a hint database. [implicit-core-hint-db,deprecated] File "./Kami/Lib/Word.v", line 1217, characters 0-42: Warning: Adding and removing hints in the core database implicitly is deprecated. Please specify a hint database. [implicit-core-hint-db,deprecated] File "bedrock2/compiler/src/ExprImp.v", line 407, characters 4-639: Warning: Ltac Profiler cannot yet handle backtracking into multi-success tactics; profiling results may be wildly inaccurate. [profile-backtracking,ltac] File "bedrock2/compiler/src/ExprImp.v", line 407, characters 4-639: Warning: Ltac Profiler cannot yet handle backtracking into multi-success tactics; profiling results may be wildly inaccurate. [profile-backtracking,ltac] File "bedrock2/compiler/src/ExprImp.v", line 407, characters 4-639: Warning: Ltac Profiler cannot yet handle backtracking into multi-success tactics; profiling results may be wildly inaccurate. [profile-backtracking,ltac] File "bedrock2/compiler/src/ExprImp.v", line 407, characters 4-639: Warning: Ltac Profiler cannot yet handle backtracking into multi-success tactics; profiling results may be wildly inaccurate. [profile-backtracking,ltac] File "bedrock2/compiler/src/ExprImp.v", line 407, characters 4-639: Warning: Ltac Profiler cannot yet handle backtracking into multi-success tactics; profiling results may be wildly inaccurate. [profile-backtracking,ltac] File "bedrock2/compiler/src/ExprImp.v", line 407, characters 4-639: Warning: Ltac Profiler cannot yet handle backtracking into multi-success tactics; profiling results may be wildly inaccurate. [profile-backtracking,ltac] File "bedrock2/compiler/src/ExprImp.v", line 464, characters 4-57: Warning: Ltac Profiler cannot yet handle backtracking into multi-success tactics; profiling results may be wildly inaccurate. [profile-backtracking,ltac] File "bedrock2/compiler/src/ExprImp.v", line 464, characters 4-57: Warning: Ltac Profiler cannot yet handle backtracking into multi-success tactics; profiling results may be wildly inaccurate. [profile-backtracking,ltac] File "bedrock2/compiler/src/ExprImp.v", line 491, characters 4-95: Warning: Ltac Profiler cannot yet handle backtracking into multi-success tactics; profiling results may be wildly inaccurate. [profile-backtracking,ltac] File "bedrock2/compiler/src/ExprImp.v", line 491, characters 4-95: Warning: Ltac Profiler cannot yet handle backtracking into multi-success tactics; profiling results may be wildly inaccurate. [profile-backtracking,ltac] File "bedrock2/compiler/src/ExprImp.v", line 491, characters 4-95: Warning: Ltac Profiler cannot yet handle backtracking into multi-success tactics; profiling results may be wildly inaccurate. [profile-backtracking,ltac] File "bedrock2/compiler/src/ExprImp.v", line 533, characters 4-108: Warning: Ltac Profiler cannot yet handle backtracking into multi-success tactics; profiling results may be wildly inaccurate. [profile-backtracking,ltac] File "bedrock2/compiler/src/ExprImp.v", line 533, characters 4-108: Warning: Ltac Profiler cannot yet handle backtracking into multi-success tactics; profiling results may be wildly inaccurate. [profile-backtracking,ltac] File "bedrock2/compiler/src/ExprImp.v", line 533, characters 4-108: Warning: Ltac Profiler cannot yet handle backtracking into multi-success tactics; profiling results may be wildly inaccurate. [profile-backtracking,ltac] ib/ListSupport.v COQC bedrock2/compiler/src/UnmappedMemForExtSpec.v COQC Kami/Lib/BasicLogic.v COQC Kami/Lib/DepEqNat.v COQC Kami/Ex/Names.v COQC bedrock2/compiler/src/NameGen.v COQC Kami/Lib/StringStringAsOT.v COQC bedrock2/compiler/src/examples/highlevel/For.v COQC bedrock2/compiler/src/examples/toposort.v COQC Kami/Lib/NatLib.v COQC bedrock2/compiler/lib/LibTactics.v COQC Kami/Lib/ilist.v COQC bedrock2/compiler/lib/fiat_crypto_tactics/Not.v COQC bedrock2/compiler/src/util/Tactics.v COQC bedrock2/compiler/src/util/Common.v COQC Kami/Lib/Indexer.v COQC bedrock2/compiler/src/util/ListLib.v COQC Kami/Lib/Misc.v COQC bedrock2/compiler/src/util/Set.v COQC Kami/Lib/Word.v COQC bedrock2/compiler/src/ExprImp.v End of ExprImp.v total time: 8.389s tactic local total calls max ────────────────────────────────────────┴──────┴──────┴───────┴─────────┘ ─map_solver ---------------------------- 0.0% 49.5% 44 0.222s ─preprocess_impl ----------------------- 0.7% 39.2% 44 0.177s ─abstract_unrecogs --------------------- 16.3% 34.8% 44 0.161s ─set_solver_generic -------------------- 0.2% 15.1% 30 0.405s ─ --- 0.0% 14.9% 34 0.400s ─t_tauto_intuit ------------------------ 3.0% 14.9% 93 0.400s ─remember_unrecogs --------------------- 3.1% 12.3% 548 0.016s ─ -------------- 9.4% 12.1% 93 0.334s ─map_solver_core ----------------------- 0.5% 10.2% 29 0.085s ─map_solver_core_impl ------------------ 0.3% 9.6% 2 0.084s ─inversion H --------------------------- 9.4% 9.4% 74 0.061s ─inversion_lemma ----------------------- 0.1% 6.2% 9 0.217s ─inversionss --------------------------- 0.1% 6.0% 10 0.226s ─inverts (var) ------------------------- 0.1% 5.9% 63 0.030s ─inverts_tactic ------------------------ 0.2% 5.8% 63 0.030s ─unrecogs_in_prop ---------------------- 5.7% 5.7% 0 0.027s ─map_specialize ------------------------ 0.0% 5.1% 29 0.041s ─map_specialize_step ------------------- 3.7% 5.1% 35 0.036s ─congruence ---------------------------- 4.5% 4.5% 117 0.027s ─invert keep (var) --------------------- 0.1% 4.5% 63 0.028s ─remember P as name eqn:a -------------- 4.5% 4.5% 197 0.012s ─eauto (int_or_var_opt) (int_or_var_opt) 4.3% 4.5% 53 0.055s ─apply mk_Abstracted in a -------------- 3.8% 3.8% 264 0.002s ─replace (uconstr) with (constr) (clause 0.8% 3.6% 21 0.032s ─econstructor -------------------------- 2.8% 2.8% 49 0.010s ─maps_propositional -------------------- 0.1% 2.8% 45 0.043s ─pose proof IH as IH' ------------------ 2.6% 2.6% 3724 0.006s tactic local total calls max ────────────────────────────────────────┴──────┴──────┴───────┴─────────┘ ─map_solver ---------------------------- 0.0% 49.5% 44 0.222s ├─preprocess_impl --------------------- 0.7% 39.2% 44 0.177s │└abstract_unrecogs ------------------- 16.3% 34.8% 44 0.161s │ ├─remember_unrecogs ----------------- 3.1% 12.3% 548 0.016s │ │ ├─remember P as name eqn:a -------- 4.5% 4.5% 197 0.012s │ │ └─apply mk_Abstracted in a -------- bedrock2/compiler/src/ExprImp (real: 23.40, user: 10.90, sys: 0.52, mem: 540624 ko) bedrock2/compiler/src/ZNameGen (real: 1.33, user: 0.46, sys: 0.18, mem: 351756 ko) bedrock2/compiler/src/examples/TestExprImp (real: 2.02, user: 0.72, sys: 0.26, mem: 458732 ko) bedrock2/compiler/src/examples/highlevel/FuncMut (real: 1.61, user: 0.55, sys: 0.23, mem: 420416 ko) File "bedrock2/compiler/src/FlatImp.v", line 418, characters 6-59: Warning: Ltac Profiler cannot yet handle backtracking into multi-success tactics; profiling results may be wildly inaccurate. [profile-backtracking,ltac] File "./Kami/Lib/Word.v", line 2154, characters 0-28: Warning: Adding and removing hints in the core database implicitly is deprecated. Please specify a hint database. [implicit-core-hint-db,deprecated] Kami/Lib/Word (real: 55.47, user: 26.60, sys: 0.45, mem: 741048 ko) File "./Kami/Lib/Struct.v", line 151, characters 0-57: Warning: Adding and removing hints in the core database implicitly is deprecated. Please specify a hint database. [implicit-core-hint-db,deprecated] Kami/Lib/Struct (real: 2.57, user: 0.99, sys: 0.21, mem: 435576 ko) File "bedrock2/compiler/src/FlatImp.v", line 474, characters 6-210: Warning: Ltac Profiler cannot yet handle backtracking into multi-success tactics; profiling results may be wildly inaccurate. [profile-backtracking,ltac] File "bedrock2/compiler/src/FlatImp.v", line 474, characters 6-210: Warning: Ltac Profiler cannot yet handle backtracking into multi-success tactics; profiling results may be wildly inaccurate. [profile-backtracking,ltac] File "bedrock2/compiler/src/FlatImp.v", line 474, characters 6-210: Warning: Ltac Profiler cannot yet handle backtracking into multi-success tactics; profiling results may be wildly inaccurate. [profile-backtracking,ltac] Kami/Lib/WordSupport (real: 1.56, user: 0.56, sys: 0.20, mem: 432120 ko) File "./Kami/Lib/FMap.v", line 563, characters 2-19: Warning: Adding and removing hints in the core database implicitly is deprecated. Please specify a hint database. [implicit-core-hint-db,deprecated] File "./Kami/Lib/FMap.v", line 567, characters 2-51: Warning: Adding and removing hints in the core database implicitly is deprecated. Please specify a hint database. [implicit-core-hint-db,deprecated] File "./Kami/Lib/FMap.v", line 595, characters 2-43: Warning: Adding and removing hints in the core database implicitly is deprecated. Please specify a hint database. [implicit-core-hint-db,deprecated] File "./Kami/Lib/FMap.v", line 618, characters 2-44: Warning: Adding and removing hints in the core database implicitly is deprecated. Please specify a hint database. [implicit-core-hint-db,deprecated] File "./Kami/Lib/FMap.v", line 626, characters 2-41: Warning: Adding and removing hints in the core database implicitly is deprecated. Please specify a hint database. [implicit-core-hint-db,deprecated] File "./Kami/Lib/FMap.v", line 876, characters 2-45: Warning: Adding and removing hints in the core database implicitly is deprecated. Please specify a hint database. [implicit-core-hint-db,deprecated] File "./Kami/Lib/FMap.v", line 913, characters 2-46: Warning: Adding and removing hints in the core database implicitly is deprecated. Please specify a hint database. [implicit-core-hint-db,deprecated] File "./Kami/Lib/FMap.v", line 1328, characters 2-43: Warning: Adding and removing hints in the core database implicitly is deprecated. Please specify a hint database. [implicit-core-hint-db,deprecated] File "./Kami/Lib/FMap.v", line 1475, characters 2-45: Warning: Adding and removing hints in the core database implicitly is deprecated. Please specify a hint database. [implicit-core-hint-db,deprecated] File "./Kami/Lib/FMap.v", line 2482, characters 0-44: Warning: Declaring a scope implicitly is deprecated; use in advance an explicit "Declare Scope fmap_scope.". [undeclared-scope,deprecated] File "./Kami/Lib/FMap.v", line 2681, characters 0-41: Warning: Adding and removing hints in the core database implicitly is deprecated. Please specify a hint database. [implicit-core-hint-db,deprecated] File "./Kami/Lib/FMap.v", line 2682, characters 0-48: Warning: Adding and removing hints in the core database implicitly is deprecated. Please specify a hint database. [implicit-core-hint-db,deprecated] Kami/Lib/FMap (real: 20.44, user: 9.56, sys: 0.30, mem: 537308 ko) File "bedrock2/compiler/src/FlatImp.v", line 624, characters 4-95: Warning: Ltac Profiler cannot yet handle backtracking into multi-success tactics; profiling results may be wildly inaccurate. [profile-backtracking,ltac] File "bedrock2/compiler/src/FlatImp.v", line 624, characters 4-95: Warning: Ltac Profiler cannot yet handle backtracking into multi-success tactics; profiling results may be wildly inaccurate. [profile-backtracking,ltac] File "./Kami/Syntax.v", line 1139, characters 2-33: Warning: Adding and removing hints in the core database implicitly is deprecated. Please specify a hint database. [implicit-core-hint-db,deprecated] File "./Kami/Syntax.v", line 1309, characters 0-121: Warning: Adding and removing hints in the core database implicitly is deprecated. Please specify a hint database. [implicit-core-hint-db,deprecated] File "./Kami/Syntax.v", line 1315, characters 0-84: Warning: Declaring a scope implicitly is deprecated; use in advance an explicit "Declare Scope kami_struct_scope.". [undeclared-scope,deprecated] File "./Kami/Syntax.v", line 1317, characters 0-54: Warning: Declaring a scope implicitly is deprecated; use in advance an explicit "Declare Scope kami_scope.". [undeclared-scope,deprecated] Kami/Syntax (real: 4.38, user: 1.89, sys: 0.23, mem: 479116 ko) 3.8% 3.8% 264 0.002s │ └─unrecogs_in_prop ------------------ 5.7% 5.7% 0 0.027s └─map_solver_core --------------------- 0.5% 10.2% 29 0.085s └map_solver_core_impl ---------------- 0.3% 9.6% 2 0.084s ├─map_specialize -------------------- 0.0% 5.1% 29 0.041s │└map_specialize_step --------------- 3.7% 5.1% 35 0.036s └─maps_propositional ---------------- 0.1% 2.8% 45 0.043s ─set_solver_generic -------------------- 0.2% 15.1% 30 0.405s └ --- 0.0% 14.0% 30 0.400s └t_tauto_intuit ------------------------ 3.0% 14.0% 89 0.400s └ -------------- 8.8% 11.3% 89 0.334s ─inversion_lemma ----------------------- 0.1% 6.2% 9 0.217s └inversionss --------------------------- 0.0% 3.3% 9 0.084s └inverts (var) ------------------------- 0.0% 3.2% 32 0.020s └inverts_tactic ------------------------ 0.1% 3.2% 32 0.020s └invert keep (var) --------------------- 0.0% 2.5% 32 0.018s ─inversion H --------------------------- 6.0% 6.0% 11 0.061s ─replace (uconstr) with (constr) (clause 0.8% 3.6% 21 0.032s └congruence ---------------------------- 2.8% 2.8% 21 0.027s ─eauto (int_or_var_opt) (int_or_var_opt) 3.2% 3.3% 44 0.023s ─econstructor -------------------------- 2.8% 2.8% 49 0.010s ─inversionss --------------------------- 0.1% 2.7% 1 0.226s └inverts (var) ------------------------- 0.0% 2.6% 31 0.030s └inverts_tactic ------------------------ 0.1% 2.6% 31 0.030s └invert keep (var) --------------------- 0.0% 2.0% 31 0.028s ─pose proof IH as IH' ------------------ 2.6% 2.6% 3724 0.006s COQC bedrock2/compiler/src/ZNameGen.v COQC bedrock2/compiler/src/examples/TestExprImp.v COQC bedrock2/compiler/src/examples/highlevel/FuncMut.v COQC bedrock2/compiler/src/FlatImp.v COQC Kami/Lib/Struct.v COQC Kami/Lib/WordSupport.v COQC Kami/Lib/FMap.v COQC Kami/Syntax.v COQC Kami/Semantics.v End of FlatImp.v total time: 26.926s tactic local total calls max ────────────────────────────────────────┴──────┴──────┴───────┴─────────┘ ─simp ---------------------------------- 0.0% 71.8% 97 2.046s ─simp_step ----------------------------- 0.1% 71.8% 209 0.530s ─unique_inversion ---------------------- 71.4% 71.4% 3388 0.529s ─inversion H --------------------------- 66.5% 66.5% 686 0.199s ─equalities ---------------------------- 0.3% 57.3% 3 10.539s ─map_solver ---------------------------- 0.0% 11.2% 30 0.277s ─preprocess_impl ----------------------- 0.2% 8.1% 30 0.215s ─abstract_unrecogs --------------------- 2.9% 7.0% 30 0.198s ─protect_equalities -------------------- 2.0% 3.8% 593 0.011s ─congruence ---------------------------- 3.6% 3.6% 187 0.043s ─map_solver_core ----------------------- 0.1% 3.1% 25 0.077s ─map_solver_core_impl ------------------ 0.1% 3.0% 2 0.076s ─pose proof IH as IH' ------------------ 2.5% 2.5% 11247 0.004s ─remember_unrecogs --------------------- 0.6% 2.5% 303 0.016s ─inversion_lemma ----------------------- 0.0% 2.3% 11 0.208s ─inversionss --------------------------- 0.0% 2.2% 12 0.246s ─inverts (var) ------------------------- 0.0% 2.2% 81 0.023s ─inverts_tactic ------------------------ 0.1% 2.1% 81 0.023s ─assert (H : e1 = e2) by congruence ---- 0.1% 2.1% 80 0.026s tactic bedrock2/compiler/src/FlatImp (real: 62.83, user: 30.21, sys: 0.60, mem: 608088 ko) bedrock2/compiler/src/util/SetSolverTests (real: 1.00, user: 0.30, sys: 0.15, mem: 290132 ko) bedrock2/compiler/src/RegAlloc2 (real: 1.61, user: 0.53, sys: 0.21, mem: 386872 ko) File "./Kami/Semantics.v", line 947, characters 2-35: Warning: Adding and removing hints in the core database implicitly is deprecated. Please specify a hint database. [implicit-core-hint-db,deprecated] Kami/Semantics (real: 13.71, user: 6.50, sys: 0.26, mem: 501300 ko) Kami/Inline (real: 1.93, user: 0.70, sys: 0.23, mem: 469696 ko) Kami/SymEval (real: 3.58, user: 1.48, sys: 0.24, mem: 476176 ko) File "./Kami/Wf.v", line 16, characters 2-22: Warning: Adding and removing hints in the core database implicitly is deprecated. Please specify a hint database. [implicit-core-hint-db,deprecated] Kami/Wf (real: 6.87, user: 3.06, sys: 0.29, mem: 499932 ko) File "./Kami/SemFacts.v", line 1666, characters 0-20: Warning: Adding and removing hints in the core database implicitly is deprecated. Please specify a hint database. [implicit-core-hint-db,deprecated] Kami/SemFacts (real: 76.97, user: 37.08, sys: 0.39, mem: 601836 ko) File "./Kami/ModularFacts.v", line 42, characters 2-30: Warning: Adding and removing hints in the core database implicitly is deprecated. Please specify a hint database. [implicit-core-hint-db,deprecated] Kami/ModularFacts (real: 68.49, user: 32.76, sys: 0.55, mem: 885880 ko) Kami/StepDet (real: 19.67, user: 9.26, sys: 0.28, mem: 504428 ko) Kami/Label (real: 7.13, user: 3.17, sys: 0.27, mem: 486656 ko) Kami/RefinementFacts (real: 18.99, user: 8.98, sys: 0.27, mem: 511956 ko) Kami/InlineFacts (real: 83.55, user: 40.29, sys: 0.46, mem: 668564 ko) File "./Kami/Renaming.v", line 16, characters 0-25: Warning: Adding and removing hints in the core database implicitly is deprecated. Please specify a hint database. [implicit-core-hint-db,deprecated] File "./Kami/Renaming.v", line 185, characters 2-44: Warning: Adding and removing hints in the core database implicitly is deprecated. Please specify a hint database. [implicit-core-hint-db,deprecated] File "./Kami/Renaming.v", line 203, characters 2-58: Warning: Adding and removing hints in the core database implicitly is deprecated. Please specify a hint database. [implicit-core-hint-db,deprecated] Kami/Renaming (real: 81.06, user: 39.12, sys: 0.38, mem: 563328 ko) Kami/Substitute (real: 2.10, user: 0.72, sys: 0.26, mem: 473852 ko) Kami/Decomposition (real: 11.95, user: 5.56, sys: 0.26, mem: 507520 ko) Kami/Amortization (real: 11.22, user: 5.12, sys: 0.29, mem: 505436 ko) Kami/SymEvalTac (real: 1.93, user: 0.67, sys: 0.23, mem: 474056 ko) Kami/PartialInlineFacts (real: 13.41, user: 6.24, sys: 0.29, mem: 509232 ko) Kami/ParametricSyntax (real: 31.00, user: 14.78, sys: 0.34, mem: 561068 ko) File "./Kami/Specialize.v", line 858, characters 2-44: Warning: Adding and removing hints in the core database implicitly is deprecated. Please specify a hint database. [implicit-core-hint-db,deprecated] File "./Kami/Specialize.v", line 1194, characters 0-130: Warning: Adding and removing hints in the core database implicitly is deprecated. Please specify a hint database. [implicit-core-hint-db,deprecated] Kami/Specialize (real: 45.09, user: 21.68, sys: 0.30, mem: 506640 ko) Kami/ParametricWf (real: 5.32, user: 2.19, sys: 0.29, mem: 489072 ko) File "./Kami/ParametricEquiv.v", line 10, characters 2-22: Warning: Adding and removing hints in the core database implicitly is deprecated. Please specify a hint database. [implicit-core-hint-db,deprecated] Kami/ParametricEquiv (real: 6.90, user: 3.10, sys: 0.28, mem: 492424 ko) File "./Kami/Notations.v", line 28, characters 0-81: Warning: Declaring a scope implicitly is deprecated; use in advance an explicit "Declare Scope kami_expr_scope.". [undeclared-scope,deprecated] File "./Kami/Notations.v", line 89, characters 0-169: Warning: Declaring a scope implicitly is deprecated; use in advance an explicit "Declare Scope init_scope.". [undeclared-scope,deprecated] File "./Kami/Notations.v", line 110, characters 0-190: Warning: Declaring a scope implicitly is deprecated; use in advance an explicit "Declare Scope kami_action_scope.". [undeclared-scope,deprecated] File "./Kami/Notations.v", line 263, characters 0-212: Warning: Declaring a scope implicitly is deprecated; use in advance an explicit "Declare Scope kami_sin_scope.". [undeclared-scope,deprecated] File "./Kami/Notations.v", line 404, characters 0-247: Warning: Declaring a scope implicitly is deprecated; use in advance an explicit "Declare Scope kami_gen_scope.". [undeclared-scope,deprecated] File "./Kami/Notations.v", line 663, characters 0-260: Warning: Declaring a scope implicitly is deprecated; use in advance an explicit "Declare Scope kami_meta_scope.". [undeclared-scope,deprecated] Kami/Notations (real: 2.42, user: 0.87, sys: 0.28, mem: 460284 ko) Kami/Duplicate (real: 5.46, user: 2.39, sys: 0.28, mem: 487424 ko) Kami/Synthesize (real: 1.72, user: 0.59, sys: 0.24, mem: 442252 ko) Kami/Ex/MemTypes (real: 1.99, user: 0.71, sys: 0.23, mem: 452980 ko) Kami/Ext/BSyntax (real: 2.19, user: 0.79, sys: 0.27, mem: 477872 ko) Kami/ParametricInline (real: 9.22, user: 4.19, sys: 0.30, mem: 509168 ko) Kami/ModuleBound (real: 3.21, user: 1.29, sys: 0.27, mem: 485936 ko) File "./Kami/ModuleBoundEx.v", line 25, characters 2-71: Warning: Declaring a scope implicitly is deprecated; use in advance an explicit "Declare Scope namebound_scope.". [undeclared-scope,deprecated] File "./Kami/ModuleBoundEx.v", line 332, characters 2-71: Warning: Declaring a scope implicitly is deprecated; use in advance an explicit "Declare Scope namebound_scope.". [undeclared-scope,deprecated] Kami/ModuleBoundEx (real: 7.16, user: 3.17, sys: 0.30, mem: 492768 ko) Kami/ParamDup (real: 5.47, user: 2.42, sys: 0.25, mem: 489812 ko) File "./Kami/Tactics.v", line 923, characters 0-59: Warning: Adding and removing hints in the core database implicitly is deprecated. Please specify a hint database. [implicit-core-hint-db,deprecated] File "./Kami/Tactics.v", line 924, characters 0-77: Warning: Adding and removing hints in the core database implicitly is deprecated. Please specify a hint database. [implicit-core-hint-db,deprecated] File "./Kami/Tactics.v", line 984, characters 0-543: Warning: Declaring a scope implicitly is deprecated; use in advance an explicit "Declare Scope mapping_scope.". [undeclared-scope,deprecated] Kami/Tactics (real: 2.58, user: 0.89, sys: 0.26, mem: 484828 ko) Kami/ParametricInlineLtac (real: 2.11, user: 0.77, sys: 0.26, mem: 486708 ko) Kami/MapReifyEx (real: 4.56, user: 1.94, sys: 0.29, mem: 494008 ko) File "./Kami/Ex/SC.v", line 432, characters 2-30: Warning: Adding and removing hints in the core database implicitly is deprecated. Please specify a hint database. [implicit-core-hint-db,deprecated] File "./Kami/Ex/SC.v", line 441, characters 2-33: Warning: Adding and removing hints in the core database implicitly is deprecated. Please specify a hint database. [implicit-core-hint-db,deprecated] File "./Kami/Ex/SC.v", line 460, characters 0-72: Warning: Adding and removing hints in the core database implicitly is deprecated. Please specify a hint database. [implicit-core-hint-db,deprecated] Kami/Ex/SC (real: 8.37, user: 3.81, sys: 0.27, mem: 510132 ko) File "./Kami/Ex/OneEltFifo.v", line 85, characters 0-50: Warning: Adding and removing hints in the core database implicitly is deprecated. Please specify a hint database. [implicit-core-hint-db,deprecated] File "./Kami/Ex/OneEltFifo.v", line 86, characters 0-56: Warning: Adding and removing hints in the core database implicitly is deprecated. Please specify a hint database. [implicit-core-hint-db,deprecated] File "./Kami/Ex/OneEltFifo.v", line 87, characters 0-56: Warning: Adding and removing hints in the core database implicitly is deprecated. Please specify a hint database. [implicit-core-hint-db,deprecated] Kami/Ex/OneEltFifo (real: 2.92, user: 1.15, sys: 0.26, mem: 487776 ko) File "./Kami/Ex/Fifo.v", line 197, characters 2-29: Warning: Adding and removing hints in the core database implicitly is deprecated. Please specify a hint database. [implicit-core-hint-db,deprecated] File "./Kami/Ex/Fifo.v", line 202, characters 2-35: Warning: Adding and removing hints in the core database implicitly is deprecated. Please specify a hint database. [implicit-core-hint-db,deprecated] File "./Kami/Ex/Fifo.v", line 207, characters 2-30: Warning: Adding and removing hints in the core database implicitly is deprecated. Please specify a hint database. [implicit-core-hint-db,deprecated] File "./Kami/Ex/Fifo.v", line 212, characters 2-36: Warning: Adding and removing hints in the core database implicitly is deprecated. Please specify a hint database. [implicit-core-hint-db,deprecated] File "./Kami/Ex/Fifo.v", line 266, characters 0-167: Warning: Adding and removing hints in the core database implicitly is deprecated. Please specify a hint database. [implicit-core-hint-db,deprecated] File "./Kami/Ex/Fifo.v", line 270, characters 0-175: Warning: Adding and removing hints in the core database implicitly is deprecated. Please specify a hint database. [implicit-core-hint-db,deprecated] Kami/Ex/Fifo (real: 16.06, user: 7.55, sys: 0.28, mem: 534616 ko) File "./Kami/Ex/NativeFifo.v", line 174, characters 2-35: Warning: Adding and removing hints in the core database implicitly is deprecated. Please specify a hint database. [implicit-core-hint-db,deprecated] File "./Kami/Ex/NativeFifo.v", line 181, characters 2-41: Warning: Adding and removing hints in the core database implicitly is deprecated. Please specify a hint database. [implicit-core-hint-db,deprecated] File "./Kami/Ex/NativeFifo.v", line 188, characters 2-36: Warning: Adding and removing hints in the core database implicitly is deprecated. Please specify a hint database. [implicit-core-hint-db,deprecated] File "./Kami/Ex/NativeFifo.v", line 195, characters 2-42: Warning: Adding and removing hints in the core database implicitly is deprecated. Please specify a hint database. [implicit-core-hint-db,deprecated] File "./Kami/Ex/NativeFifo.v", line 273, characters 0-215: Warning: Adding and removing hints in the core database implicitly is deprecated. Please specify a hint database. [implicit-core-hint-db,deprecated] File "./Kami/Ex/NativeFifo.v", line 277, characters 0-223: Warning: Adding and removing hints in the core database implicitly is deprecated. Please specify a hint database. [implicit-core-hint-db,deprecated] Kami/Ex/NativeFifo (real: 4.03, user: 1.70, sys: 0.27, mem: 490720 ko) File "./Kami/Ex/IsaRv32.v", line 88, characters 0-79: Warning: Notation "$ _" was already used in scope kami_expr_scope. [notation-overridden,parsing] Kami/Ex/IsaRv32 (real: 3.31, user: 1.30, sys: 0.26, mem: 509008 ko) File "./Kami/Ex/Divider32.v", line 1058, characters 2-1168: Warning: ndiXq cannot be defined because it is informative and NrDividerInv is not. [cannot-define-projection,records] File "./Kami/Ex/Divider32.v", line 1058, characters 2-1168: Warning: HndiXq cannot be defined because the projection ndiXq was not defined. [cannot-define-projection,records] File "./Kami/Ex/Divider32.v", line 1058, characters 2-1168: Warning: ndiX cannot be defined because it is informative and NrDividerInv is not. [cannot-define-projection,records] File "./Kami/Ex/Divider32.v", line 1058, characters 2-1168: Warning: HndiX cannot be defined because the projection ndiX was not defined. [cannot-define-projection,records] File "./Kami/Ex/Divider32.v", line 1058, characters 2-1168: Warning: ndiD cannot be defined because it is informative and NrDividerInv is not. [cannot-define-projection,records] File "./Kami/Ex/Divider32.v", line 1058, characters 2-1168: Warning: HndiD cannot be defined because the projection ndiD was not defined. [cannot-define-projection,records] File "./Kami/Ex/Divider32.v", line 1058, characters 2-1168: Warning: ndiDp cannot be defined because it is informative and NrDividerInv is not. [cannot-define-projection,records] File "./Kami/Ex/Divider32.v", line 1058, characters 2-1168: Warning: HndiDp cannot be defined because the projection ndiDp was not defined. [cannot-define-projection,records] File "./Kami/Ex/Divider32.v", line 1058, characters 2-1168: Warning: ndiDn cannot be defined because it is informative and NrDividerInv is not. [cannot-define-projection,records] File "./Kami/Ex/Divider32.v", line 1058, characters 2-1168: Warning: HndiDn cannot be defined because the projection ndiDn was not defined. [cannot-define-projection,records] File "./Kami/Ex/Divider32.v", line 1058, characters 2-1168: Warning: ndiCnt cannot be defined because it is informative and NrDividerInv is not. [cannot-define-projection,records] File "./Kami/Ex/Divider32.v", line 1058, characters 2-1168: Warning: HndiCnt cannot be defined because the projection ndiCnt was not defined. [cannot-define-projection,records] File "./Kami/Ex/Divider32.v", line 1058, characters 2-1168: Warning: HndiDdp cannot be defined because the projections ndiDp, ndiD were not defined. [cannot-define-projection,records] File "./Kami/Ex/Divider32.v", line 1058, characters 2-1168: Warning: HndiDdn cannot be defined because the projections ndiDn, ndiDp were not defined. [cannot-define-projection,records] File "./Kami/Ex/Divider32.v", line 1058, characters 2-1168: Warning: HndiInv cannot be defined because the projections ndiD, ndiCnt, ndiXq, ndiX, ndiD were not defined. [cannot-define-projection,records] Kami/Ex/Divider32 (real: 125.49, user: 60.73, sys: 0.58, mem: 847228 ko) File "./Kami/Ex/Multiplier64.v", line 399, characters 2-24: Warning: Use of “Require” inside a section is deprecated. [require-in-section,deprecated] File "./Kami/Ex/Multiplier64.v", line 431, characters 4-143: Warning: Declaring a scope implicitly is deprecated; use in advance an explicit "Declare Scope bword_scope.". [undeclared-scope,deprecated] File "./Kami/Ex/Multiplier64.v", line 1125, characters 2-1192: Warning: bsiM cannot be defined because it is informative and BoothMultiplierInv is not. [cannot-define-projection,records] File "./Kami/Ex/Multiplier64.v", line 1125, characters 2-1192: Warning: HbsiM cannot be defined because the projection bsiM was not defined. [cannot-define-projection,records] File "./Kami/Ex/Multiplier64.v", line 1125, characters 2-1192: Warning: bsiR cannot be defined because it is informative and BoothMultiplierInv is not. [cannot-define-projection,records] File "./Kami/Ex/Multiplier64.v", line 1125, characters 2-1192: Warning: HbsiR cannot be defined because the projection bsiR was not defined. [cannot-define-projection,records] File "./Kami/Ex/Multiplier64.v", line 1125, characters 2-1192: Warning: bsiMp cannot be defined because it is informative and BoothMultiplierInv is not. [cannot-define-projection,records] File "./Kami/Ex/Multiplier64.v", line 1125, characters 2-1192: Warning: HbsiMp cannot be defined because the projection bsiMp was not defined. [cannot-define-projection,records] File "./Kami/Ex/Multiplier64.v", line 1125, characters 2-1192: Warning: bsiMn cannot be defined because it is informative and BoothMultiplierInv is not. [cannot-define-projection,records] File "./Kami/Ex/Multiplier64.v", line 1125, characters 2-1192: Warning: HbsiMn cannot be defined because the projection bsiMn was not defined. [cannot-define-projection,records] File "./Kami/Ex/Multiplier64.v", line 1125, characters 2-1192: Warning: bsiP cannot be defined because it is informative and BoothMultiplierInv is not. [cannot-define-projection,records] File "./Kami/Ex/Multiplier64.v", line 1125, characters 2-1192: Warning: HbsiP cannot be defined because the projection bsiP was not defined. [cannot-define-projection,records] File "./Kami/Ex/Multiplier64.v", line 1125, characters 2-1192: Warning: bsiCnt cannot be defined because it is informative and BoothMultiplierInv is not. [cannot-define-projection,records] File "./Kami/Ex/Multiplier64.v", line 1125, characters 2-1192: Warning: HbsiCnt cannot be defined because the projection bsiCnt was not defined. [cannot-define-projection,records] File "./Kami/Ex/Multiplier64.v", line 1125, characters 2-1192: Warning: HbsiMmp cannot be defined because the projections bsiMp, bsiM were not defined. [cannot-define-projection,records] File "./Kami/Ex/Multiplier64.v", line 1125, characters 2-1192: Warning: HbsiMmn cannot be defined because the projections bsiMn, bsiM were not defined. [cannot-define-projection,records] File "./Kami/Ex/Multiplier64.v", line 1125, characters 2-1192: Warning: HmInv cannot be defined because the projection bsiM was not defined. [cannot-define-projection,records] File "./Kami/Ex/Multiplier64.v", line 1125, characters 2-1192: Warning: HbsiInv cannot be defined because the projections bsiCnt, bsiP, bsiM, bsiR were not defined. [cannot-define-projection,records] Kami/Ex/Multiplier64 (real: 430.88, user: 206.96, sys: 1.70, mem: 1980772 ko) File "./Kami/Ex/Multiplier32.v", line 399, characters 2-24: Warning: Use of “Require” inside a section is deprecated. [require-in-section,deprecated] File "./Kami/Ex/Multiplier32.v", line 431, characters 4-143: Warning: Declaring a scope implicitly is deprecated; use in advance an explicit "Declare Scope bword_scope.". [undeclared-scope,deprecated] File "./Kami/Ex/Multiplier32.v", line 1125, characters 2-1192: Warning: bsiM cannot be defined because it is informative and BoothMultiplierInv is not. [cannot-define-projection,records] File "./Kami/Ex/Multiplier32.v", line 1125, characters 2-1192: Warning: HbsiM cannot be defined because the projection bsiM was not defined. [cannot-define-projection,records] File "./Kami/Ex/Multiplier32.v", line 1125, characters 2-1192: Warning: bsiR cannot be defined because it is informative and BoothMultiplierInv is not. [cannot-define-projection,records] File "./Kami/Ex/Multiplier32.v", line 1125, characters 2-1192: Warning: HbsiR cannot be defined because the projection bsiR was not defined. [cannot-define-projection,records] File "./Kami/Ex/Multiplier32.v", line 1125, characters 2-1192: Warning: bsiMp cannot be defined because it is informative and BoothMultiplierInv is not. [cannot-define-projection,records] File "./Kami/Ex/Multiplier32.v", line 1125, characters 2-1192: Warning: HbsiMp cannot be defined because the projection bsiMp was not defined. [cannot-define-projection,records] File "./Kami/Ex/Multiplier32.v", line 1125, characters 2-1192: Warning: bsiMn cannot be defined because it is informative and BoothMultiplierInv is not. [cannot-define-projection,records] File "./Kami/Ex/Multiplier32.v", line 1125, characters 2-1192: Warning: HbsiMn cannot be defined because the projection bsiMn was not defined. [cannot-define-projection,records] File "./Kami/Ex/Multiplier32.v", line 1125, characters 2-1192: Warning: bsiP cannot be defined because it is informative and BoothMultiplierInv is not. [cannot-define-projection,records] File "./Kami/Ex/Multiplier32.v", line 1125, characters 2-1192: Warning: HbsiP cannot be defined because the projection bsiP was not defined. [cannot-define-projection,records] File "./Kami/Ex/Multiplier32.v", line 1125, characters 2-1192: Warning: bsiCnt cannot be defined because it is informative and BoothMultiplierInv is not. [cannot-define-projection,records] File "./Kami/Ex/Multiplier32.v", line 1125, characters 2-1192: Warning: HbsiCnt cannot be defined because the projection bsiCnt was not defined. [cannot-define-projection,records] File "./Kami/Ex/Multiplier32.v", line 1125, characters 2-1192: Warning: HbsiMmp cannot be defined because the projections bsiMp, bsiM were not defined. [cannot-define-projection,records] File "./Kami/Ex/Multiplier32.v", line 1125, characters 2-1192: Warning: HbsiMmn cannot be defined because the projections bsiMn, bsiM were not defined. [cannot-define-projection,records] File "./Kami/Ex/Multiplier32.v", line 1125, characters 2-1192: Warning: HmInv cannot be defined because the projection bsiM was not defined. [cannot-define-projection,records] File "./Kami/Ex/Multiplier32.v", line 1125, characters 2-1192: Warning: HbsiInv cannot be defined because the projections bsiCnt, bsiP, bsiM, bsiR were not defined. [cannot-define-projection,records] local total calls max ────────────────────────────────────────┴──────┴──────┴───────┴─────────┘ ─equalities ---------------------------- 0.3% 57.3% 3 10.539s ├─simp -------------------------------- 0.0% 54.9% 77 2.046s │└simp_step --------------------------- 0.0% 54.9% 160 0.530s │└unique_inversion -------------------- 54.6% 54.6% 2632 0.529s │ ├─inversion H ----------------------- 47.8% 47.8% 454 0.170s │ └─protect_equalities ---------------- 1.7% 3.3% 454 0.010s └─assert (H : e1 = e2) by congruence -- 0.1% 2.1% 80 0.026s └congruence -------------------------- 2.0% 2.0% 80 0.025s ─simp ---------------------------------- 0.0% 17.0% 20 0.417s └simp_step ----------------------------- 0.0% 17.0% 49 0.396s └unique_inversion ---------------------- 16.8% 16.8% 756 0.395s └inversion H --------------------------- 15.4% 15.4% 139 0.199s ─map_solver ---------------------------- 0.0% 11.2% 30 0.277s ├─preprocess_impl --------------------- 0.2% 8.1% 30 0.215s │└abstract_unrecogs ------------------- 2.9% 7.0% 30 0.198s │└remember_unrecogs ------------------- 0.6% 2.5% 303 0.016s └─map_solver_core --------------------- 0.1% 3.1% 25 0.077s └map_solver_core_impl ---------------- 0.1% 3.0% 2 0.076s ─pose proof IH as IH' ------------------ 2.5% 2.5% 11247 0.004s ─inversion_lemma ----------------------- 0.0% 2.3% 11 0.208s COQC bedrock2/compiler/src/util/SetSolverTests.v COQC bedrock2/compiler/src/RegAlloc2.v COQC bedrock2/compiler/src/FlattenExpr.v COQC Kami/Inline.v COQC Kami/SymEval.v COQC Kami/Wf.v COQC Kami/SemFacts.v COQC Kami/ModularFacts.v COQC Kami/StepDet.v COQC Kami/Label.v COQC Kami/RefinementFacts.v COQC Kami/InlineFacts.v COQC Kami/Renaming.v COQC Kami/Substitute.v COQC Kami/Decomposition.v COQC Kami/Amortization.v COQC Kami/SymEvalTac.v COQC Kami/PartialInlineFacts.v COQC Kami/ParametricSyntax.v COQC Kami/Specialize.v COQC Kami/ParametricWf.v COQC Kami/ParametricEquiv.v COQC Kami/Notations.v COQC Kami/Duplicate.v COQC Kami/Synthesize.v COQC Kami/Ex/MemTypes.v COQC Kami/Ext/BSyntax.v COQC Kami/ParametricInline.v COQC Kami/ModuleBound.v COQC Kami/ModuleBoundEx.v COQC Kami/ParamDup.v COQC Kami/Tactics.v COQC Kami/ParametricInlineLtac.v COQC Kami/MapReifyEx.v COQC Kami/Ex/SC.v COQC Kami/Ex/OneEltFifo.v COQC Kami/Ex/Fifo.v COQC Kami/Ex/NativeFifo.v COQC Kami/Ex/IsaRv32.v COQC Kami/Ex/Divider32.v COQC Kami/Ex/Multiplier64.v COQC Kami/Ex/Multiplier32.v End of FlattenExpr.v total time: 587.422s tactic local total calls max ────────────────────────────────────────┴──────┴──────┴───────┴─────────┘ ─maps ---------------------------------- 0.0% 88.3% 84 17.968s ─map_solver ---------------------------- 0.0% 54.8% 95 9.899s ─map_solver_core ----------------------- 0.1% 42.7% 92 9.552s ─map_solver_core_impl ------------------ 0.0% 42.6% 13 9.549s ─default_flattenBooleanExpr ------------ 0.0% 37.3% 21 36.430s ─map_specialize ------------------------ 0.0% 36.3% 92 7.801s ─map_specialize_step ------------------- 24.9% 36.3% 1911 5.056s ─pose_flatten_var_ineqs ---------------- 4.0% 34.0% 86 10.352s ─unique eapply (constr) in copy of (iden 1.0% 30.1% 59814 0.049s ─unshelve (tactic1) -------------------- 0.7% 26.8% 59814 0.048s ─eapply p in H' ------------------------ 26.2% 26.2% 59814 0.048s ─preprocess_impl ----------------------- 0.0% 12.1% 95 2.152s ─abstract_unrecogs --------------------- 7.0% 11.1% 95 2.057s ─simp ---------------------------------- 0.0% 6.3% 78 3.196s ─simp_step ----------------------------- 0.0% 6.3% 644 1.145s ─maps_propositional -------------------- 0.0% 6.0% 480 7.295s ─unique_inversion ---------------------- 3.9% 3.9% 5338 1.144s ─maps_leaf_tac ------------------------- 0.1% 3.5% 2100 0.035s ─inversion H --------------------------- 3.4% 3.4% 1097 1.070s ─congruence ---------------------------- 3.2% 3.2% 2495 0.085s ─pose proof H as H' -------------------- 3.1% 3.1% 185783 0.026s ─canonicalize_map_hyp ------------------ 0.6% 2.9% 37401 0.022s ─specialize (constr_with_bindings) ----- 2.5% 2.5% 166250 0.022s ─destruct_unique_match ----------------- 2.4% 2.4% 821 0.389s ─remember_unrecogs --------------------- 0.9% 2.4% 2727 0.644s ─ensure_no_body ------------------------ 1.0% 2.3% 161949 0.015s ─propositional_cheap_step -------------- 2.2% 2.3% 3800 0.016s ─auto (int_or_var_opt) (auto_using) (hin 1.8% 2.1% 3290 0.023s ─assert_fails -------------------------- 0.6% 2.0% 196767 0.023s tactic local total calls max ────────────────────────────────────────┴──────┴──────┴───────┴─────────┘ ─maps ---------------------------------- 0.0% 52.5% 53 17.968s ├─map_solver -------------------------- 0.0% 30.3% 64 9.899s │ ├─map_solver_core ------------------- 0.0% 22.4% 64 9.552s │ │└map_solver_core_impl -------------- 0.0% 22.4% 1 9.549s │ │ ├─map_specialize ------------------ 0.0% 17.8% 64 5.088s │ │ │└map_specialize_step ------------- 12.7% 17.8% 1057 4.472s │ │ └─maps_propositional -------------- 0.0% 4.4% 350 7.295s │ │ └maps_leaf_tac ------------------- 0.0% 2.5% 1634 0.025s │ └─preprocess_impl ------------------- 0.0% 7.9% 64 2.152s │ └abstract_unrecogs ----------------- 4.6% 7.3% 64 2.057s └─pose_flatten_var_ineqs -------------- 2.5% 22.1% 53 10.352s └unique eapply (constr) in copy of (id 0.6% 19.7% 36953 0.049s └unshelve (tactic1) ------------------ 0.4% 17.8% 36953 0.048s └eapply p in H' ---------------------- 17.4% 17.4% 36953 0.048s ─default_flattenBooleanExpr ------------ 0.0% 37.3% 21 36.430s ├─maps -------------------------------- 0.0% 35.0% 30 12.207s │ ├─map_solver ------------------------ 0.0% 24.0% 30 9.184s │ │ ├─map_solver_core ----------------- 0.0% 20.1% 27 7.870s │ │ │└map_solver_core_impl ------------ 0.0% 20.1% 12 7.859s │ │ │└map_specialize ------------------ 0.0% 18.3% 27 7.801s │ │ │└map_specialize_step ------------- 12.1% 18.3% 845 5.056s │ │ └─preprocess_impl ----------------- 0.0% 3.9% 30 1.349s │ │ └abstract_unrecogs --------------- 2.3% 3.6% 30 1.238s │ └─pose_flatten_var_ineqs ------------ 1.4% 11.0% 30 3.250s │ └unique eapply (constr) in copy of ( 0.4% 9.6% 21011 0.027s │ └unshelve (tactic1) ---------------- 0.2% 8.3% 21011 0.027s │ └eapply p in H' -------------------- 8.1% 8.1% 21011 0.027s └─simp -------------------------------- 0.0% 2.2% 21 1.839s └simp_step --------------------------- 0.0% 2.1% 243 0.174s ─simp ---------------------------------- 0.0% 4.2% 57 3.196s └simp_step ----------------------------- 0.0% 4.2% 401 1.145s └unique_inversion --------bedrock2/compiler/src/FlattenExpr (real: 1225.77, user: 593.01, sys: 9.58, mem: 1060368 ko) bedrock2/compiler/src/examples/TestFlatImp (real: 4.39, user: 0.71, sys: 0.28, mem: 459820 ko) bedrock2/compiler/src/FlatToRiscvDef (real: 2.44, user: 0.69, sys: 0.24, mem: 466532 ko) bedrock2/compiler/src/RegAlloc3 (real: 1.44, user: 0.50, sys: 0.18, mem: 389304 ko) bedrock2/compiler/src/EmitsValid (real: 49.36, user: 23.66, sys: 0.35, mem: 610544 ko) bedrock2/compiler/src/RegAllocAnnotatedNotations (real: 1.73, user: 0.45, sys: 0.18, mem: 350576 ko) bedrock2/compiler/src/GoFlatToRiscv (real: 15.43, user: 6.89, sys: 0.27, mem: 480324 ko) bedrock2/compiler/src/FlatToRiscv32 (real: 17.62, user: 8.26, sys: 0.29, mem: 505664 ko) Kami/Ex/Multiplier32 (real: 214.00, user: 104.11, sys: 0.86, mem: 1131272 ko) File "./Kami/Ex/Divider64.v", line 1058, characters 2-1168: Warning: ndiXq cannot be defined because it is informative and NrDividerInv is not. [cannot-define-projection,records] File "./Kami/Ex/Divider64.v", line 1058, characters 2-1168: Warning: HndiXq cannot be defined because the projection ndiXq was not defined. [cannot-define-projection,records] File "./Kami/Ex/Divider64.v", line 1058, characters 2-1168: Warning: ndiX cannot be defined because it is informative and NrDividerInv is not. [cannot-define-projection,records] File "./Kami/Ex/Divider64.v", line 1058, characters 2-1168: Warning: HndiX cannot be defined because the projection ndiX was not defined. [cannot-define-projection,records] File "./Kami/Ex/Divider64.v", line 1058, characters 2-1168: Warning: ndiD cannot be defined because it is informative and NrDividerInv is not. [cannot-define-projection,records] File "./Kami/Ex/Divider64.v", line 1058, characters 2-1168: Warning: HndiD cannot be defined because the projection ndiD was not defined. [cannot-define-projection,records] File "./Kami/Ex/Divider64.v", line 1058, characters 2-1168: Warning: ndiDp cannot be defined because it is informative and NrDividerInv is not. [cannot-define-projection,records] File "./Kami/Ex/Divider64.v", line 1058, characters 2-1168: Warning: HndiDp cannot be defined because the projection ndiDp was not defined. [cannot-define-projection,records] File "./Kami/Ex/Divider64.v", line 1058, characters 2-1168: Warning: ndiDn cannot be defined because it is informative and NrDividerInv is not. [cannot-define-projection,records] File "./Kami/Ex/Divider64.v", line 1058, characters 2-1168: Warning: HndiDn cannot be defined because the projection ndiDn was not defined. [cannot-define-projection,records] File "./Kami/Ex/Divider64.v", line 1058, characters 2-1168: Warning: ndiCnt cannot be defined because it is informative and NrDividerInv is not. [cannot-define-projection,records] File "./Kami/Ex/Divider64.v", line 1058, characters 2-1168: Warning: HndiCnt cannot be defined because the projection ndiCnt was not defined. [cannot-define-projection,records] File "./Kami/Ex/Divider64.v", line 1058, characters 2-1168: Warning: HndiDdp cannot be defined because the projections ndiDp, ndiD were not defined. [cannot-define-projection,records] File "./Kami/Ex/Divider64.v", line 1058, characters 2-1168: Warning: HndiDdn cannot be defined because the projections ndiDn, ndiDp were not defined. [cannot-define-projection,records] File "./Kami/Ex/Divider64.v", line 1058, characters 2-1168: Warning: HndiInv cannot be defined because the projections ndiD, ndiCnt, ndiXq, ndiX, ndiD were not defined. [cannot-define-projection,records] Kami/Ex/Divider64 (real: 271.33, user: 131.59, sys: 1.01, mem: 1411224 ko) bedrock2/compiler/src/FlatToRiscv (real: 415.73, user: 202.44, sys: 0.75, mem: 899104 ko) bedrock2/compiler/src/Pipeline (real: 5.85, user: 2.50, sys: 0.27, mem: 505076 ko) Kami/Ex/FifoCorrect (real: 125.57, user: 61.07, sys: 0.56, mem: 798376 ko) File "./Kami/Ex/RegFile.v", line 132, characters 0-66: Warning: Adding and removing hints in the core database implicitly is deprecated. Please specify a hint database. [implicit-core-hint-db,deprecated] File "./Kami/Ex/RegFile.v", line 133, characters 0-69: Warning: Adding and removing hints in the core database implicitly is deprecated. Please specify a hint database. [implicit-core-hint-db,deprecated] Kami/Ex/RegFile (real: 4.25, user: 1.81, sys: 0.24, mem: 495792 ko) Kami/Ex/SCMMInl (real: 11.10, user: 5.07, sys: 0.30, mem: 561800 ko) Kami/Kami (real: 2.25, user: 0.74, sys: 0.24, mem: 485920 ko) File "./Kami/Ex/MemAtomic.v", line 121, characters 2-29: Warning: Adding and removing hints in the core database implicitly is deprecated. Please specify a hint database. [implicit-core-hint-db,deprecated] bedrock2/compiler/src/examples/MMIO (real: 32.79, user: 15.63, sys: 0.31, mem: 555732 ko) File "./Kami/Ex/MemAtomic.v", line 128, characters 2-28: Warning: Adding and removing hints in the core database implicitly is deprecated. Please specify a hint database. [implicit-core-hint-db,deprecated] File "./Kami/Ex/MemAtomic.v", line 137, characters 2-29: Warning: Adding and removing hints in the core database implicitly is deprecated. Please specify a hint database. [implicit-core-hint-db,deprecated] File "./Kami/Ex/MemAtomic.v", line 144, characters 2-29: Warning: Adding and removing hints in the core database implicitly is deprecated. Please specify a hint database. [implicit-core-hint-db,deprecated] File "./Kami/Ex/MemAtomic.v", line 166, characters 0-146: Warning: Adding and removing hints in the core database implicitly is deprecated. Please specify a hint database. [implicit-core-hint-db,deprecated] Kami/Ex/MemAtomic (real: 3.50, user: 1.47, sys: 0.24, mem: 497260 ko) bedrock2/compiler/src/examples/InlineAssemblyMacro (real: 1.97, user: 0.71, sys: 0.26, mem: 483356 ko) bedrock2/compiler/src/examples/CompileExamples (real: 2.52, user: 0.74, sys: 0.21, mem: 501084 ko) bedrock2/compiler/src/examples/Fibonacci (real: 7.21, user: 3.30, sys: 0.23, mem: 510956 ko) -------------- 3.2% 3.2% 3570 1.144s └inversion H --------------------------- 2.7% 2.7% 626 1.070s COQC bedrock2/compiler/src/examples/TestFlatImp.v COQC bedrock2/compiler/src/FlatToRiscvDef.v COQC bedrock2/compiler/src/RegAlloc3.v COQC bedrock2/compiler/src/EmitsValid.v COQC bedrock2/compiler/src/RegAllocAnnotatedNotations.v COQC bedrock2/compiler/src/GoFlatToRiscv.v COQC bedrock2/compiler/src/FlatToRiscv32.v COQC bedrock2/compiler/src/FlatToRiscv.v COQC Kami/Ex/Divider64.v COQC Kami/Ex/FifoCorrect.v COQC bedrock2/compiler/src/Pipeline.v COQC bedrock2/compiler/src/examples/MMIO.v compiled@{} = [[Lui addr 268582912; Addi addr addr 0; Lw i addr 0; Beq i 0 16; Mul s i i; Sw addr s 0; Jal 0 (-16)]] : list Instruction COQC Kami/Ex/RegFile.v COQC Kami/Ex/SCMMInl.v COQC Kami/Kami.v COQC Kami/Ex/MemAtomic.v COQC bedrock2/compiler/src/examples/InlineAssemblyMacro.v COQC Kami/Ex/SimpleFifoCorrect.v compiled@{} = [[Lw 9 1 0; Mul 4 2 3; Add 5 2 3; Sub 6 2 3; Auipc 31 0; Add 31 31 9; Jalr 0 31 8; Addi 7 4 0; Jal 0 20; Addi 7 5 0; Jal 0 12; Addi 7 6 0; Jal 0 4]] : list Instruction COQC bedrock2/compiler/src/examples/CompileExamples.v COQC bedrock2/compiler/src/examples/Fibonacci.v fib_ExprImp@{compiler.examples.Fibonacci.17} = fun n : Z => cmd.seq (cmd.set 1 (expr.literal 0)) (cmd.seq (cmd.set 2 (expr.literal 1)) (cmd.seq (cmd.set 4 (expr.literal 0)) (cmd.while (expr.op ltu (expr.var 4) (expr.literal n)) (cmd.seq (cmd.set 3 (expr.op add (expr.var 1) (expr.var 2))) (cmd.seq (cmd.set 1 (expr.var 2)) (cmd.seq (cmd.set 2 (expr.var 3)) (cmd.set 4 (expr.op add (expr.var 4) (expr.literal 1))))))))) : Z -> cmd Argument scope is [Z_scope] = SSeq (SLit 1 0) (SSeq (SLit 2 1) (SSeq (SLit 4 0) (SLoop (SSeq SSkip (SLit 5 6)) (CondBinary BLtu 4 5) (SSeq (SSeq SSkip (SSeq SSkip (SOp 3 add 1 2))) (SSeq (SSet 1 2) (SSeq (SSet 2 3) (SSeq SSkip (SSeq (SLit 6 1) (SOp 4 add 4 6))))))))) : stmt Finished transaction in 0.012 secs (0.007u,0.s) (successful) fib6_riscv@{} = [Addi 1 0 0; Addi 2 0 1; Addi 4 0 0; Addi 5 0 6; Bgeu 4 5 28; Add 3 1 2; Add 1 0 2; Add 2 0 3; Addi 6 0 1; Add 4 4 6; Jal 0 (-28)] : list Instruction fib6_riscv@{} = RISCV: addi x1, x0, 0 addi x2, x0, 1 addi x4, x0, 0 addi x5, x0, 6 bgeu x4, x5, 28 add x3, x1, x2 add x1, x0, x2 add x2, x0, x3 addi x6, x0, 1 add x4, x4, x6 jal x0, -28 : list Instruction 93000000 13011000 13020000 93026000 637e5200 b3812000 b3002000 33013000 13031000 33026200 6ff05ffe = {| Naive.unsigned := 13; Naive._unsigned_in_range := eq_refl |} : word COQC bedrock2/compiler/src/examples/FE310Compiler.v Finished transaction in 0.063 secs (0.028u,0.001s) (successful) Axioms: AdmitAxiom.proof_admitted : False used in map_ok_subproof5 to prove: forall (m1 m2 : map p ok) (k : parameters.key) (v : parameters.value), map.get m2 k = Some v -> map.get (map.putmany m1 m2) k = Some v used in map_ok_subproof4 to prove: forall (m1 m2 : map p ok) (k : parameters.key), map.get m2 k = None -> map.get (map.putmany m1 m2) k = map.get m1 k used in map_ok_subproof3 to prove: forall (m : map p ok) (k k' : parameters.key), k <> k' -> map.get (map.remove m k') k = map.get m k used in map_ok_subproof2 to prove: forall (m : map p ok) (k : parameters.key), map.get (map.remove m k) k = None used in map_ok_subproof1 to prove: forall (m : map p ok) (k : parameters.key) (v : parameters.value) (k' : parameters.key), k <> k' -> map.get (map.put m k' v) k = map.get m k used in map_ok_subproof0 to prove: forall (m : map p ok) (k : parameters.key) (v : parameters.value), map.get (map.put m k v) k = Some v used in map_ok_subproof to prove: forall m1 m2 : map p ok, (forall k : parameters.key, map.get m1 k = map.get m2 k) -> m1 = m2 ext_spec_Proper : forall (trace : list (mem * actname * list Semantics.word * (mem * list Semantics.word))) (m : mem) (act : actname) (args : list Semantics.word), Morphisms.Proper (Morphisms.respectful (Morphisms.pointwise_relation mem (Morphisms.pointwise_relation (list Semantics.word) Basics.impl)) Basics.impl) (ext_spec trace m act args) Axioms: FlatToRiscv.word_eq_dec : forall p : FlatToRiscv.FlatToRiscv.parameters, FlatToRiscv.FlatToRiscv.assumptions -> DecidableEq word undef_on_unchecked_store_byte_tuple_list : forall (n : nat) (l : list (HList.tuple word8 n)) (start : word32), map.undef_on (unchecked_store_byte_tuple_list start l map.empty) (fun x : word32 => ~ word.unsigned start <= word.unsigned x < word.unsigned start + Z.of_nat n * Zlength l) store_program_empty : forall (prog : list Instruction) (addr : word), GoFlatToRiscv.program addr prog (unchecked_store_program addr prog map.empty) FlatToRiscv.reduce_eq_to_sub_and_lt : forall p : FlatToRiscv.FlatToRiscv.parameters, FlatToRiscv.FlatToRiscv.assumptions -> forall (y z : word) (T : Type) (thenVal elseVal : T), (if word.eqb y z then thenVal else elseVal) = (if word.ltu (word.sub y z) (word.of_Z 1) then thenVal else elseVal) real_ext_spec_implies_simple_ext_spec : forall (p : MMIO.parameters) (t : trace) (m : MMIO.mem) (a : MMIOAction) (args : list MMIO.word) (post : MMIO.mem -> list MMIO.word -> Prop), real_ext_spec t m a args post -> simple_ext_spec t m a args post FlatToRiscv.put_put_same : forall (K V : Type) (M : map.map K V) (k : K) (v1 v2 : V) (m : M), map.put (map.put m k v1) k v2 = map.put m k v2 PropExtensionality.propositional_extensionality : forall P Q : Prop, P <-> Q -> P = Q AdmitAxiom.proof_admitted : False used in map_ok_subproof5 to prove: forall (m1 m2 : map p ok) (k : parameters.key) (v : parameters.value), map.get m2 k = Some v -> map.get (map.putmany m1 m2) k = Some v used in map_ok_subproof4 to prove: forall (m1 m2 : map p ok) (k : parameters.key), map.get m2 k = None -> map.get (map.putmany m1 m2) k = map.get m1 k used in map_ok_subproof3 to prove: forall (m : map p ok) (k k' : parameters.key), k <> k' -> map.get (map.remove m k') k = map.get m k used in map_ok_subproof2 to prove: forall (m : map p ok) (k : parameters.key), map.get (map.remove m k) k = None used in map_ok_subproof1 to prove: forall (m : map p ok) (k : parameters.key) (v : parameters.value) (k' : parameters.key), k <> k' -> map.get (map.put m k' v) k = map.get m k used in map_ok_subproof0 to prove: forall (m : map p ok) (k : parameters.key) (v : parameters.value), map.get (map.put m k v) k = Some v used in map_ok_subproof to prove: forall m1 m2 : map p ok, (forall k : parameters.key, map.get m1 k = map.get m2 k) -> m1 = m2 max_ext_call_code_size_bound : forall (p : FlattenExpr.parameters) (f : FlattenExpr.actname), 0 <= FlattenExpr.max_ext_call_code_size f <= 7 map_undef_on_weaken : forall (P Q : PropSet.set word32) (m : Mem), map.undef_on m Q -> PropSet.subset P Q -> map.undef_on m P FlatImp.exec.map_split_diff : forall pp : Semantics.parameters, FlatImp.env -> forall m m1 m2 m3 : mem, map.split m m2 m1 -> map.split m m3 m1 -> m2 = m3 load4bytes_in_MMIO_is_None : forall (p : MMIO.parameters) (m : MMIO.mem) (addr : MMIO.word), map.undef_on m isMMIOAddr -> isMMIOAddr addr -> load_bytes 4 m addr = None FunctionalExtensionality.functional_extensionality_dep : forall (A : Type) (B : A -> Type) (f g : forall x : A, B x), (forall x : A, f x = g x) -> f = g FlatImp.exec.ext_spec_intersect : forall (pp : Semantics.parameters) (t : list (mem * actname * list Semantics.word * (mem * list Semantics.word))) (mGive1 mGive2 : mem) (a : actname) (args : list Semantics.word) (post1 post2 : mem -> list Semantics.word -> Prop), ext_spec t mGive1 a args post1 -> ext_spec t mGive2 a args post2 -> mGive1 = mGive2 /\ ext_spec t mGive1 a args (fun (mReceive : mem) (resvals : list Semantics.word) => post1 mReceive resvals /\ post2 mReceive resvals) ext_spec_Proper : forall (trace : list (mem * actname * list Semantics.word * (mem * list Semantics.word))) (m : mem) (act : actname) (args : list Semantics.word), Morphisms.Proper (Morphisms.respectful (Morphisms.pointwise_relation mem (Morphisms.pointwise_relation (list Semantics.word) Basics.impl)) Basics.impl) (ext_spec trace m act args) FlatToRiscv.divisibleBy4_admit : forall p : FlatToRiscv.FlatToRiscv.parameters, FlatToRiscv.FlatToRiscv.assumptions -> forall x y : word, FlatToRiscv.divisibleBy4 x -> FlatToRiscv.divisibleBy4 y compile_lit_new_size : forall iset : InstructionSet, FlatToRiscvDef.FlatToRiscvDef.parameters -> forall (x : Register) (v : Z), 0 <= Zlength (FlatToRiscvDef.compile_lit_new iset x v) <= 15 FlatToRiscv.compile_lit_correct_full : forall p : FlatToRiscv.FlatToRiscv.parameters, FlatToRiscv.FlatToRiscv.assumptions -> forall (initialL : RiscvMachine.RiscvMachine Syntax.varname FlatToRiscvDef.FlatToRiscvDef.actname) (post : RiscvMachine.RiscvMachine Register FlatToRiscvDef.FlatToRiscvDef.actname -> Prop) (x : Syntax.varname) (v : Z) (R : FlatToRiscv.FlatToRiscv.mem -> Prop), getNextPc initialL = add (getPc initialL) (ZToReg 4) -> let insts := FlatToRiscvDef.compile_stmt FlatToRiscv.FlatToRiscv.iset (FlatImp.SLit x v) in let d := mul (ZToReg 4) (ZToReg (Zlength insts)) in Separation.sep (GoFlatToRiscv.program (getPc initialL) insts) R (getMem initialL) -> FlatToRiscvDef.valid_registers (FlatImp.SLit x v) -> FlatToRiscv.runsTo (withRegs (map.put (getRegs inibedrock2/compiler/src/examples/FE310Compiler (real: 42.80, user: 20.27, sys: 0.35, mem: 610324 ko) bedrock2/compiler/src/examples/EditDistExample (real: 2.19, user: 0.80, sys: 0.26, mem: 499980 ko) bedrock2/compiler/src/examples/swap_bytes_over_uart_hexdump (real: 2.04, user: 0.74, sys: 0.23, mem: 505316 ko) Kami/Ex/IsaRv32Pgm (real: 2.28, user: 0.82, sys: 0.26, mem: 507796 ko) File "./Kami/Ex/ProcDec.v", line 279, characters 2-29: Warning: Adding and removing hints in the core database implicitly is deprecated. Please specify a hint database. [implicit-core-hint-db,deprecated] File "./Kami/Ex/ProcDec.v", line 289, characters 2-30: Warning: Adding and removing hints in the core database implicitly is deprecated. Please specify a hint database. [implicit-core-hint-db,deprecated] File "./Kami/Ex/ProcDec.v", line 301, characters 2-31: Warning: Adding and removing hints in the core database implicitly is deprecated. Please specify a hint database. [implicit-core-hint-db,deprecated] File "./Kami/Ex/ProcDec.v", line 314, characters 0-76: Warning: Adding and removing hints in the core database implicitly is deprecated. Please specify a hint database. [implicit-core-hint-db,deprecated] Kami/Ex/ProcDec (real: 9.01, user: 4.13, sys: 0.26, mem: 512264 ko) Kami/Ext/Extraction (real: 2.36, user: 0.79, sys: 0.24, mem: 488532 ko) Kami/Ex/SimpleFifoCorrect (real: 74.95, user: 37.44, sys: 0.37, mem: 672092 ko) File "./Kami/Tutorial.v", line 72, characters 0-27: Warning: Adding and removing hints in the core database implicitly is deprecated. Please specify a hint database. [implicit-core-hint-db,deprecated] File "./Kami/Ex/ProcThreeStage.v", line 801, characters 2-32: Warning: Adding and removing hints in the core database implicitly is deprecated. Please specify a hint database. [implicit-core-hint-db,deprecated] Kami/Tutorial (real: 7.47, user: 3.39, sys: 0.25, mem: 517872 ko) File "./Kami/Ex/ProcThreeStage.v", line 806, characters 2-35: Warning: Adding and removing hints in the core database implicitly is deprecated. Please specify a hint database. [implicit-core-hint-db,deprecated] File "./Kami/Ex/ProcThreeStage.v", line 811, characters 2-35: Warning: Adding and removing hints in the core database implicitly is deprecated. Please specify a hint database. [implicit-core-hint-db,deprecated] File "./Kami/Ex/ProcThreeStage.v", line 816, characters 2-38: Warning: Adding and removing hints in the core database implicitly is deprecated. Please specify a hint database. [implicit-core-hint-db,deprecated] File "./Kami/Ex/ProcThreeStage.v", line 821, characters 2-38: Warning: Adding and removing hints in the core database implicitly is deprecated. Please specify a hint database. [implicit-core-hint-db,deprecated] File "./Kami/Ex/ProcThreeStage.v", line 831, characters 2-36: Warning: Adding and removing hints in the core database implicitly is deprecated. Please specify a hint database. [implicit-core-hint-db,deprecated] File "./Kami/Ex/ProcThreeStage.v", line 839, characters 2-33: Warning: Adding and removing hints in the core database implicitly is deprecated. Please specify a hint database. [implicit-core-hint-db,deprecated] File "./Kami/Ex/ProcThreeStage.v", line 844, characters 2-30: Warning: Adding and removing hints in the core database implicitly is deprecated. Please specify a hint database. [implicit-core-hint-db,deprecated] Kami/Ex/IsaRv32/PgmGcd (real: 4.45, user: 1.88, sys: 0.27, mem: 521816 ko) File "./Kami/Ex/ProcThreeStage.v", line 855, characters 2-27: Warning: Adding and removing hints in the core database implicitly is deprecated. Please specify a hint database. [implicit-core-hint-db,deprecated] File "./Kami/Ex/ProcThreeStage.v", line 871, characters 0-251: Warning: Adding and removing hints in the core database implicitly is deprecated. Please specify a hint database. [implicit-core-hint-db,deprecated] Kami/Ex/ProcThreeStage (real: 12.09, user: 5.62, sys: 0.28, mem: 535096 ko) Kami/Ex/IsaRv32/PgmFact (real: 4.26, user: 1.83, sys: 0.25, mem: 522312 ko) Kami/Ex/IsaRv32/PgmBsort (real: 4.09, user: 1.75, sys: 0.23, mem: 521896 ko) Kami/Ex/IsaRv32/PgmHanoi (real: 4.05, user: 1.74, sys: 0.23, mem: 522080 ko) Kami/Ex/IsaRv32/PgmDekker1 (real: 4.24, user: 1.78, sys: 0.27, mem: 520604 ko) Kami/Ex/IsaRv32/PgmDekker2 (real: 4.29, user: 1.83, sys: 0.25, mem: 524584 ko) Kami/Ex/IsaRv32/PgmPeterson1 (real: 4.23, user: 1.80, sys: 0.27, mem: 519680 ko) Kami/Ex/IsaRv32/PgmPeterson2 (real: 4.14, user: 1.80, sys: 0.24, mem: 519696 ko) Kami/Ex/IsaRv32/PgmMatMulInit (real: 4.29, user: 1.81, sys: 0.25, mem: 521416 ko) Kami/Ex/IsaRv32/PgmMatMulNormal1 (real: 4.30, user: 1.83, sys: 0.26, mem: 519240 ko) Kami/Ex/IsaRv32/PgmMatMulNormal2 (real: 4.21, user: 1.81, sys: 0.24, mem: 519724 ko) Kami/Ex/IsaRv32/PgmMatMulReport (real: 4.32, user: 1.87, sys: 0.25, mem: 519908 ko) Kami/Ex/IsaRv32/PgmBankerInit (real: 4.21, user: 1.81, sys: 0.24, mem: 522124 ko) Kami/Ex/IsaRv32/PgmBankerWorker1 (real: 4.43, user: 1.87, sys: 0.27, mem: 522776 ko) Kami/Ex/IsaRv32/PgmBankerWorker2 (real: 4.24, user: 1.80, sys: 0.25, mem: 520460 ko) Kami/Ex/ProcThreeStInl (real: 2.03, user: 0.75, sys: 0.23, mem: 490144 ko) Kami/Ex/IsaRv32/PgmBankerWorker3 (real: 4.25, user: 1.85, sys: 0.24, mem: 520188 ko) File "./Kami/Ex/ProcFetchDecode.v", line 333, characters 2-32: Warning: Adding and removing hints in the core database implicitly is deprecated. Please specify a hint database. [implicit-core-hint-db,deprecated] File "./Kami/Ex/ProcFetchDecode.v", line 342, characters 2-32: Warning: Adding and removing hints in the core database implicitly is deprecated. Please specify a hint database. [implicit-core-hint-db,deprecated] File "./Kami/Ex/ProcFetchDecode.v", line 356, characters 0-68: Warning: Adding and removing hints in the core database implicitly is deprecated. Please specify a hint database. [implicit-core-hint-db,deprecated] Kami/Ex/ProcFetchDecode (real: 4.85, user: 2.11, sys: 0.24, mem: 508168 ko) tialL) x (ZToReg v)) (withPc (add (getPc initialL) d) (withNextPc (add (getNextPc initialL) d) initialL))) post -> FlatToRiscv.runsTo initialL post assume_riscv_word_properties : forall p : MMIO.parameters, RiscvWordProperties.word.riscv_ok MMIO.word COQC bedrock2/compiler/src/examples/EditDistExample.v COQC bedrock2/compiler/src/examples/swap_bytes_over_uart_hexdump.v 37250200 1305c5fe 03210500 b7850010 93850500 37060040 13060600 9306f001 3377d100 93070001 3318f700 b3680601 23a01501 13031000 37390110 13098901 93090027 23203901 373a0110 130a8a00 23206a00 b73a0110 938aca00 23a06a00 372b0110 130b8b03 b70b0300 938b0b00 23207b01 9303e002 b3007000 33027340 630c0206 b7020080 93820200 33015000 b3047340 33fc2400 b37c5c00 638c0c00 373d0110 130d4d00 03210d00 b3846440 6ff05ffe 37340110 13040400 b3015000 b3047340 b3fd3400 33fe5d00 63080e00 83210400 b3846440 6ff0dffe 23201400 b3002000 33026240 63967000 33424200 6f004000 6ff0dff8 make[3]: Leaving directory 'bedrock2/compiler' make[2]: Leaving directory 'bedrock2/compiler' COQC Kami/Ex/IsaRv32Pgm.v COQC Kami/Ex/ProcDec.v COQC Kami/Ext/Extraction.v COQC Kami/Tutorial.v COQC Kami/Ex/ProcThreeStage.v COQC Kami/Ex/IsaRv32/PgmGcd.v COQC Kami/Ex/IsaRv32/PgmFact.v COQC Kami/Ex/IsaRv32/PgmBsort.v COQC Kami/Ex/IsaRv32/PgmHanoi.v COQC Kami/Ex/IsaRv32/PgmDekker1.v COQC Kami/Ex/IsaRv32/PgmDekker2.v COQC Kami/Ex/IsaRv32/PgmPeterson1.v COQC Kami/Ex/IsaRv32/PgmPeterson2.v COQC Kami/Ex/IsaRv32/PgmMatMulInit.v COQC Kami/Ex/IsaRv32/PgmMatMulNormal1.v COQC Kami/Ex/IsaRv32/PgmMatMulNormal2.v COQC Kami/Ex/IsaRv32/PgmMatMulReport.v COQC Kami/Ex/IsaRv32/PgmBankerInit.v COQC Kami/Ex/IsaRv32/PgmBankerWorker1.v COQC Kami/Ex/IsaRv32/PgmBankerWorker2.v COQC Kami/Ex/IsaRv32/PgmBankerWorker3.v COQC Kami/Ex/ProcThreeStInl.v COQC Kami/Ex/ProcFetchDecode.v COQC Kami/Ex/ProcDecInl.v COQC Kami/Ex/InDepthTutorial.v Inductive Modules : Type := RegFile : string -> list string -> string -> forall (IdxBits : nat) (Data : Kind), ConstT (Vector Data IdxBits) -> Modules | Mod : list RegInitT -> list (Struct.Attribute (Action Void)) -> list DefMethT -> Modules | ConcatMod : Modules -> Modules -> Modules For RegFile: Arguments IdxBits, Data are implicit For RegFile: Argument scopes are [string_scope list_scope string_scope nat_scope _ _] For Mod: Argument scopes are [list_scope list_scope list_scope] Inductive ActionT (ty : Kind -> Type) (lretT : Kind) : Type := MCall : string -> forall s : SignatureT, (arg s) @ (ty) -> (ty (ret s) -> ActionT ty lretT) -> ActionT ty lretT | Let_ : forall lretT' : FullKind, Expr ty lretT' -> (fullType ty lretT' -> ActionT ty lretT) -> ActionT ty lretT | ReadNondet : forall k : FullKind, (fullType ty k -> ActionT ty lretT) -> ActionT ty lretT | ReadReg : string -> forall k : FullKind, (fullType ty k -> ActionT ty lretT) -> ActionT ty lretT | WriteReg : string -> forall k : FullKind, Expr ty k -> ActionT ty lretT -> ActionT ty lretT | IfElse : (Bool) @ (ty) -> forall k : Kind, ActionT ty k -> ActionT ty k -> (ty k -> ActionT ty lretT) -> ActionT ty lretT | Assert_ : (Bool) @ (ty) -> ActionT ty lretT -> ActionT ty lretT | Displ : list (Disp ty) -> ActionT ty lretT -> ActionT ty lretT | Return : (lretT) @ (ty) -> ActionT ty lretT For MCall: Arguments ty, lretT are implicit For Let_: Arguments ty, lretT, lretT' are implicit For ReadNondet: Arguments ty, lretT are implicit For ReadReg: Arguments ty, lretT are implicit For WriteReg: Arguments ty, lretT, k are implicit For IfElse: Arguments ty, lretT, k are implicit For Assert_: Arguments ty, lretT are implicit For Displ: Arguments ty, lretT are implicit For Return: Arguments ty, lretT are implicit For ActionT: Argument scopes are [function_scope _] For MCall: Argument scopes are [function_scope _ string_scope _ _ function_scope] For Let_: Argument scopes are [function_scope _ _ _ function_scope] For ReadNondet: Argument scopes are [function_scope _ _ function_scope] For ReadReg: Argument scopes are [function_scope _ string_scope _ function_scope] For WriteReg: Argument scopes are [function_scope _ string_scope _ _ _] For IfElse: Argument scopes are [function_scope _ _ _ _ _ function_scope] For Assert_: Argument scopes are [function_scope _ _ _] For Displ: Argument scopes are [function_scope _ list_scope _] For Return: Argument scopes are [function_scope _ _] Inductive Expr (ty : Kind -> Type) : FullKind -> Type := Var : forall k : FullKind, fullType ty k -> Expr ty k | Const : forall k : Kind, ConstT k -> (k) @ (ty) | UniBool : UniBoolOp -> (Bool) @ (ty) -> (Bool) @ (ty) | BinBool : BinBoolOp -> (Bool) @ (ty) -> (Bool) @ (ty) -> (Bool) @ (ty) | UniBit : forall n1 n2 : nat, UniBitOp n1 n2 -> (Bit n1) @ (ty) -> (Bit n2) @ (ty) | BinBit : forall n1 n2 n3 : nat, BinBitOp n1 n2 n3 -> (Bit n1) @ (ty) -> (Bit n2) @ (ty) -> (Bit n3) @ (ty) | BinBitBool : forall n1 n2 : nat, BinBitBoolOp n1 n2 -> (Bit n1) @ (ty) -> (Bit n2) @ (ty) -> (Bool) @ (ty) | ITE : forall k : FullKind, (Bool) @ (ty) -> Expr ty k -> Expr ty k -> Expr ty k | Eq : forall k : Kind, (k) @ (ty) -> (k) @ (ty) -> (Bool) @ (ty) | ReadIndex : forall (i : nat) (k : Kind), (Bit i) @ (ty) -> (Vector k i) @ (ty) -> (k) @ (ty) | ReadField : forall (n : nat) (ls : Vector.t (Struct.Attribute Kind) n) (i : Fin.t n), (Struct ls) @ (ty) -> (Vector.nth (Vector.map (Struct.attrType (A:=Kind)) ls) i) @ (ty) | BuildVector : forall (n : Kind) (k : nat), Vec (n) @ (ty) k -> (Vector n k) @ (ty) | BuildStruct : forall (n : nat) (attrs : Vector.t (Struct.Attribute Kind) n), ilist.ilist (fun a : Struct.Attribute Kind => (Struct.attrType a) @ (ty)) attrs -> (Struct attrs) @ (ty) | UpdateVector : forall (i : nat) (k : Kind), (Vector k i) @ (ty) -> (Bit i) @ (ty) -> (k) @ (ty) -> (Vector k i) @ (ty) | ReadArrayIndex : forall (i : nat) (k : Kind), (Bit (Nat.log2 (2 * i))) @ (ty) -> (Array k i) @ (ty) -> (k) @ (ty) | BuildArray : forall (n : Kind) (k : nat), Vector.t (n) @ (ty) (S k) -> (Array n k) @ (ty) | UpdateArray : forall (i : nat) (k : Kind), (Array k i) @ (ty) -> (Bit (Nat.log2 (2 * i))) @ (ty) -> (k) @ (ty) -> (Array k i) @ (ty) For Const: Argument k is implicit For UniBool: Argument ty is implicit For BinBool: Argument ty is implicit For UniBit: Arguments ty, n1, n2 are implicit For BinBit: Arguments ty, n1, n2, n3 are implicit For BinBitBool: Arguments ty, n1, n2 are implicit For ITE: Arguments ty, k are implicit For Eq: Arguments ty, k are implicit For ReadIndex: Arguments ty, i, k are implicit For ReadField: Arguments ty, n, ls are implicit For BuildVector: Arguments ty, n, k are implicit For BuildStruct: Arguments ty, n, attrs are implicit For UpdateVector: Arguments ty, i, k are implicit For ReadArrayIndex: Arguments ty, i, k are implicit For BuildArray: Arguments ty, n, k are implicit For UpdateArray: Arguments ty, i, k are implicit For Expr: Argument scopes are [function_scope _] For Var: Argument scopes are [function_scope _ _] For Const: Argument scopes are [function_scope _ _] For UniBool: Argument scopes are [function_scope _ _] For BinBool: Argument scopes are [function_scope _ _ _] For UniBit: Argument scopes are [function_scope nat_scope nat_scope _ _] For BinBit: Argument scopes are [function_scope nat_scope nat_scope nat_scope _ _ _] For BinBitBool: Argument scopes are [function_scope nat_scope nat_scope _ _ _] For ITE: Argument scopes are [function_scope _ _ _ _] For Eq: Argument scopes are [function_scope _ _ _] For ReadIndex: Argument scopes are [function_scope nat_scope _ _ _] For ReadField: Argument scopes are [function_scope nat_scope _ _ _] For BuildVector: Argument scopes are [function_scope _ nat_scope _] For BuildStruct: Argument scopes are [function_scope nat_scope _ _] For UpdateVector: Argument scopes are [function_scope nat_scope _ _ _ _] For ReadArrayIndex: Argument scopes are [function_scope nat_scope _ _ _] For BuildArray: Argument scopes are [function_scope _ nat_scope _] For UpdateArray: Argument scopes are [function_scope nat_scope _ _ _ _] evalExpr = fix evalExpr (exprT : FullKind) (e : Expr type exprT) {struct e} : fullType type exprT := match e in (Expr _ exprT0) return (fullType type exprT0) with | @Var _ _ v => v | @Const _ k v => evalConstT v | UniBool op e1 => evalUniBool op (evalExpr (SyntaxKind Bool) e1) | BinBool op e1 e2 => evalBinBool op (evalExpr (SyntaxKind Bool) e1) (evalExpr (SyntaxKind Bool) e2) | @UniBit _ n1 n2 op e1 => evalUniBit op (evalExpr (SyntaxKind (Bit n1)) e1) | @BinBit _ n1 n2 n3 op e1 e2 => evalBinBit op (evalExpr (SyntaxKind (Bit n1)) e1) (evalExpr (SyntaxKind (Bit n2)) e2) | @BinBitBool _ n1 n2 op e1 e2 => evalBinBitBool op (evalExpr (SyntaxKind (Bit n1)) e1) (evalExpr (SyntaxKind (Bit n2)) e2) | @ITE _ k p e1 e2 => if evalExpr (SyntaxKind Bool) p then evalExpr k e1 else evalExpr k e2 | @Eq _ k e1 e2 => if isEq k (evalExpr (SyntaxKind k) e1) (evalExpr (SyntaxKind k) e2) then true else false | @ReadIndex _ i0 k i f => evalExpr (SyntaxKind (Vector k i0)) f (evalExpr (SyntaxKind (Bit i0)) i) | @ReadField _ n ls i e0 => VectorFacts.Vector_nth_map (Struct.attrType (A:=Kind)) type ls (evalExpr (SyntaxKind (Struct ls)) e0) i | @BuildVector _ n k vec => evalVec (mapVec (evalExpr (SyntaxKind n)) vec) | @BuildStruct _ n attrs ils => ilist.ilist_to_fun_m (Expr type) (fullType type) (fun sk : Struct.Attribute Kind => SyntaxKind (Struct.attrType sk)) evalExpr ils | @UpdateVector _ i0 k fn i v => fun w : word i0 => if weq w (evalExpr (SyntaxKind (Bit i0)) i) then evalExpr (SyntaxKind k) v else evalExpr (SyntaxKind (Vector k i0)) fn w | @ReadArrayIndex _ i k idx vec => evalExpr (SyntaxKind (Array k i)) vec (natToFin i # (evalExpr (SyntaxKind (Bit (Nat.log2 (2 * i)))) idx)) | @BuildArray _ i k vecVal => evalArray (Vector.map (evalExpr (SyntaxKind i)) vecVal) | @UpdateArray _ i k arr idx val => fun fini : Fin.t (S i) => if Fin.eq_dec fini (natToFin i # (evalExpr (SyntaxKind (Bit (Nat.log2 (2 * i)))) idx)) then evalExpr (SyntaxKind k) val else evalExpr (SyntaxKind (Array k i)) arr fini end : forall exprT : FullKind, Expr type exprT -> fullType type exprT Argument exprT is implicit Inductive SemAction (oldRegs : RegsT) : forall k : Kind, ActionT type k -> UpdatesT -> MethsT -> type k -> Prop := SemMCall : forall (meth : M.key) (s : SignatureT) (marg : (arg s) @ (type)) (mret : type (ret s)) (retK : Kind) (fret : type retK) (cont : type (ret s) -> ActionT type retK) (newRegs : UpdatesT) (calls : MethsT) (acalls : M.t {x : SignatureT & SignT x}), (calls) @[ meth]%fmap = None -> acalls = (calls) #[ meth |-> (evalExpr marg, mret)]%fmap -> SemAction oldRegs (cont mret) newRegs calls fret -> SemAction oldRegs (MCall meth s marg cont) newRegs acalls fret | SemLet : forall (k : FullKind) (e : Expr type k) (retK : Kind) (fret : type retK) (cont : fullType type k -> ActionT type retK) (newRegs : UpdatesT) (calls : MethsT), SemAction oldRegs (cont (evalExpr e)) newRegs calls fret -> SemAction oldRegs (LET name <- e; cont name)%kami_action newRegs calls fret | SemReadNondet : forall (valueT : FullKind) (valueV : fullType type valueT) (retK : Kind) (fret : type retK) (cont : fullType type valueT -> ActionT type retK) (newRegs : UpdatesT) (calls : MethsT), SemAction oldRegs (cont valueV) newRegs calls fret -> SemAction oldRegs (Nondet name : valueT; cont name)%kami_action newRegs calls fret | SemReadReg : forall (r : string) (regT : FullKind) (regV : fullType type regT) (retK : Kind) (fret : type retK) (cont : fullType type regT -> ActionT type retK) (newRegs : UpdatesT) (calls : MethsT), (oldRegs) @[ r]%fmap = Some (existT (fullType type) regT regV) -> SemAction oldRegs (cont regV) newRegs calls fret -> SemAction oldRegs (Read name <- r; cont name)%kami_action newRegs calls fret | SemWriteReg : forall (r : string) (k : FullKind) (e : Expr type k) (retK : Kind) (fret : type retK) (cont : ActionT type retK) (newRegs : M.t {x : FullKind & fullType type x}) (calls : MethsT) (anewRegs : M.t {x : FullKind & fullType type x}), (newRegs) @[ r]%fmap = None -> anewRegs = (newRegs) #[ r |-> evalExpr e]%fmap -> SemAction oldRegs cont newRegs calls fret -> SemAction oldRegs (Write r <- e; cont)%kami_action anewRegs calls fret | SemIfElseTrue : forall (p : (Bool) @ (type)) (k1 : Kind) (a a' : ActionT type k1) (r1 : type k1) (k2 : Kind) (cont : type k1 -> ActionT type k2) (newRegs1 newRegs2 : M.Map.t {x : FullKind & fullType type x}) (calls1 calls2 : M.Map.t {x : SignatureT & SignT x}) (r2 : type k2), M.Disj newRegs1 newRegs2 -> M.Disj calls1 calls2 -> evalExpr p = true -> SemAction oldRegs a newRegs1 calls1 r1 -> SemAction oldRegs (cont r1) newRegs2 calls2 r2 -> forall (unewRegs : M.Map.t {x : FullKind & fullType type x}) (ucalls : M.Map.t {x : SignatureT & SignT x}), unewRegs = M.union newRegs1 newRegs2 -> ucalls = M.union calls1 calls2 -> SemAction oldRegs (If p then a else a' as name; cont name)%kami_action unewRegs ucalls r2 | SemIfElseFalse : forall (p : (Bool) @ (type)) (k1 : Kind) (a a' : ActionT type k1) (r1 : type k1) (k2 : Kind) (cont : type k1 -> ActionT type k2) (newRegs1 newRegs2 : M.Map.t {x : FullKind & fullType type x}) (calls1 calls2 : M.Map.t {x : SignatureT & SignT x}) (r2 : type k2), M.Disj newRegs1 newRegs2 -> M.Disj calls1 calls2 -> evalExpr p = false -> SemAction oldRegs a' newRegs1 calls1 r1 -> SemAction oldRegs (cont r1) newRegs2 calls2 r2 -> forall (unewRegs : M.Map.t {x : FullKind & fullType type x}) (ucalls : M.Map.t {x : SignatureT & SignT x}), unewRegs = M.union newRegs1 newRegs2 -> ucalls = M.union calls1 calls2 -> SemAction oldRegs (If p then a else a' as name; cont name)%kami_action unewRegs ucalls r2 | SemAssertTrue : forall (p : (Bool) @ (type)) (k2 : Kind) (cont : ActionT type k2) (newRegs2 : UpdatesT) (calls2 : MethsT) (r2 : type k2), evalExpr p = true -> SemAction oldRegs cont newRegs2 calls2 r2 -> SemAction oldRegs (Assert p; cont)%kami_action newRegs2 calls2 r2 | SemDispl : forall (ls : list (Disp type)) (k2 : Kind) (cont : ActionT type k2) (newRegs2 : UpdatesT) (calls2 : MethsT) (r2 : type k2), SemAction oldRegs cont newRegs2 calls2 r2 -> SemAction oldRegs (Displ ls cont) newRegs2 calls2 r2 | SemReturn : forall (k : Kind) (e : (k) @ (type)) (evale : fullType type (SyntaxKind k)), evale = evalExpr e -> SemAction oldRegs (Ret e)%kami_action []%fmap []%fmap evale For SemAction: Argument k is implicit For SemMCall: Arguments oldRegs, meth, s, mret, retK, fret, newRegs, calls, acalls are implicit For SemLet: Arguments oldRegs, k, retK, fret, newRegs, calls are implicit For SemReadNondet: Arguments oldRegs, retK, fret, newRegs, calls are implicit For SemReadReg: Arguments oldRegs, regT, regV, retK, fret, newRegs, calls are implicit For SemWriteReg: Arguments oldRegs, r, k, retK, fret, cont, newRegs, calls, anewRegs are implicit For SemIfElseTrue: Arguments oldRegs, k1, a, r1, k2, newRegs1, newRegs2, calls1, calls2, r2, unewRegs, ucalls are implicit For SemIfElseFalse: Arguments oldRegs, k1, a', r1, k2, newRegs1, newRegs2, calls1, calls2, r2, unewRegs, ucalls are implicit For SemAssertTrue: Arguments oldRegs, k2, cont, newRegs2, calls2, r2 are implicit For SemDispl: Arguments oldRegs, k2, cont, newRegs2, calls2, r2 are implicit For SemReturn: Arguments k, evale are implicit For SemMCall: Argument scopes are [_ _ _ _ _ _ _ function_scope _ _ _ _ _ _] For SemLet: Argument scopes are [_ _ _ _ _ function_scope _ _ _] For SemReadNondet: Argument scopes are [_ _ _ _ _ function_scope _ _ _] For SemReadReg: Argument scopes are [_ string_scope _ _ _ _ function_scope _ _ _ _] For SemWriteReg: Argument scopes are [_ string_scope _ _ _ _ _ _ _ _ _ _ _] For SemIfElseTrue: Argument scopes are [_ _ _ _ _ _ _ function_scope _ _ _ _ _ _ _ _ _ _ _ _ _ _] For SemIfElseFalse: Argument scopes are [_ _ _ _ _ _ _ function_scope _ _ _ _ _ _ _ _ _ _ _ _ _ _] For SemDispl: Argument scopes are [_ list_scope _ _ _ _ _ _] Record LabelT : Type := Build_LabelT { annot : option (option string); defs : MethsT; calls : MethsT } Inductive Substep (m : Modules) (o : RegsT) : UpdatesT -> UnitLabel -> MethsT -> Prop := EmptyRule : Substep m o []%fmap (Rle None) []%fmap | EmptyMeth : Substep m o []%fmap (Meth None) []%fmap | SingleRule : forall (k : string) (a : Action Void), In (k :: a)%struct (getRules m) -> forall (u : UpdatesT) (cs : MethsT), SemAction o (a type) u cs WO -> Substep m o u (Rle (Some k)) cs | SingleMeth : forall f : DefMethT, In f (getDefsBodies m) -> forall (u : UpdatesT) (cs : MethsT) (argV : type (arg (projT1 (Struct.attrType f)))) (retV : type (ret (projT1 (Struct.attrType f)))), SemAction o (projT2 (Struct.attrType f) type argV) u cs retV -> forall sig : Struct.Attribute {x : SignatureT & SignT x}, sig = (Struct.attrName f :: existT SignT (projT1 (Struct.attrType f)) (argV, retV))%struct -> Substep m o u (Meth (Some sig)) cs For SingleRule: Arguments o, u, cs are implicit For SingleMeth: Arguments o, u, cs, argV, retV, sig are implicit For SingleRule: Argument scopes are [_ _ string_scope _ _ _ _ _] Inductive SubstepsInd (m : Modules) (o : RegsT) : UpdatesT -> LabelT -> Prop := SubstepsNil : SubstepsInd m o []%fmap {| annot := None; defs := []%fmap; calls := []%fmap |} | SubstepsCons : forall (u : UpdatesT) (l : LabelT), SubstepsInd m o u l -> forall (su : UpdatesT) (scs : MethsT) (sul : UnitLabel), Substep m o su sul scs -> CanCombineUUL u l su scs sul -> forall (uu : M.Map.t {x : FullKind & fullType type x}) (ll : LabelT), uu = M.union u su -> ll = mergeLabel (getLabel sul scs) l -> SubstepsInd m o uu ll For SubstepsCons: Arguments m, o, u, l, su, scs, sul, uu, ll are implicit Inductive StepInd (m : Modules) (o : RegsT) : UpdatesT -> LabelT -> Prop := StepIndIntro : forall (u : UpdatesT) (l : LabelT), SubstepsInd m o u l -> wellHidden m (hide l) -> StepInd m o u (hide l) For StepIndIntro: Arguments m, o, u, l are implicit Inductive Multistep (m : Modules) : RegsT -> RegsT -> list LabelT -> Prop := NilMultistep : forall o1 o2 : RegsT, o1 = o2 -> Multistep m o1 o2 nil | Multi : forall (o : RegsT) (a : list LabelT) (n : RegsT), Multistep m o n a -> forall (u : UpdatesT) (l : LabelT), Step m n u l -> Multistep m o (M.union u n) (l :: a) For NilMultistep: Arguments o1, o2 are implicit For Multi: Arguments m, o, a, n, u, l are implicit For Multistep: Argument scopes are [_ _ _ list_scope] For Multi: Argument scopes are [_ _ list_scope _ _ _ _ _] Inductive Behavior (m : Modules) : RegsT -> LabelSeqT -> Prop := BehaviorIntro : forall (a : list LabelT) (n : RegsT), Multistep m (initRegs (getRegInits m)) n a -> Behavior m n a For BehaviorIntro: Arguments m, a, n are implicit For BehaviorIntro: Argument scopes are [_ list_scope _ _] traceRefines = fun (p : MethsT -> MethsT) (m1 m2 : Modules) => forall (s1 : RegsT) (sig1 : LabelSeqT), Behavior m1 s1 sig1 -> exists (s2 : RegsT) (sig2 : LabelSeqT), Behavior m2 s2 sig2 /\ equivalentLabelSeq p sig1 sig2 : (MethsT -> MethsT) -> Modules -> Modules -> Prop Argument scopes are [function_scope _ _] traceRefines_refl : forall m : Modules, traceRefines id m m traceRefines_trans : forall (ma mb mc : Modules) (p q : MethsT -> MethsT), traceRefines p ma mb -> traceRefines q mb mc -> traceRefines (fun f : MethsT => q (p f)) ma mc traceRefines_comm : forall ma mb : Modules, NoDup (Struct.namesOf (getRegInits (ma ++ mb)%kami)) -> traceRefines id (ma ++ mb)%kami (mb ++ ma)%kami traceRefines_assoc_1 : forall ma mb mc : Modules, traceRefines id ((ma ++ mb) ++ mc)%kami (ma ++ mb ++ mc)%kami traceRefines_assoc_2 : forall ma mb mc : Modules, traceRefines id (ma ++ mb ++ mc)%kami ((ma ++ mb) ++ mc)%kami traceRefines_modular_noninteracting : forall ma mb mc md : Modules, ModEquiv type typeUT ma -> ModEquiv type typeUT mb -> ModEquiv type typeUT mc -> ModEquiv type typeUT md -> DisjList (Struct.namesOf (getRegInits ma)) (Struct.namesOf (getRegInits mc)) -> DisjList (Struct.namesOf (getRegInits mb)) (Struct.namesOf (getRegInits md)) -> ValidRegsModules type (ma ++ mc)%kami -> ValidRegsModules type (mb ++ md)%kami -> DisjList (getDefs ma) (getDefs mc) -> DisjList (getCalls ma) (getCalls mc) -> DisjList (getDefs mb) (getDefs md) -> DisjList (getCalls mb) (getCalls md) -> forall vp : M.key -> {x : SignatureT & SignT x} -> option {x : SignatureT & SignT x}, NonInteracting ma mc -> NonInteracting mb md -> (ma <<=[ vp ] mb) -> (mc <<=[File "./Kami/Ex/InDepthTutorial.v", line 229, characters 0-58: Warning: Adding and removing hints in the core database implicitly is deprecated. Please specify a hint database. [implicit-core-hint-db,deprecated] File "./Kami/Ex/InDepthTutorial.v", line 232, characters 0-26: Warning: Adding and removing hints in the core database implicitly is deprecated. Please specify a hint database. [implicit-core-hint-db,deprecated] File "./Kami/Ex/InDepthTutorial.v", line 241, characters 0-55: Warning: Adding and removing hints in the core database implicitly is deprecated. Please specify a hint database. [implicit-core-hint-db,deprecated] File "./Kami/Ex/InDepthTutorial.v", line 245, characters 0-25: Warning: Adding and removing hints in the core database implicitly is deprecated. Please specify a hint database. [implicit-core-hint-db,deprecated] File "./Kami/Ex/InDepthTutorial.v", line 274, characters 0-30: Warning: Adding and removing hints in the core database implicitly is deprecated. Please specify a hint database. [implicit-core-hint-db,deprecated] File "./Kami/Ex/InDepthTutorial.v", line 277, characters 0-29: Warning: Adding and removing hints in the core database implicitly is deprecated. Please specify a hint database. [implicit-core-hint-db,deprecated] File "./Kami/Ex/InDepthTutorial.v", line 357, characters 0-28: Warning: Adding and removing hints in the core database implicitly is deprecated. Please specify a hint database. [implicit-core-hint-db,deprecated] File "./Kami/Ex/InDepthTutorial.v", line 360, characters 0-27: Warning: Adding and removing hints in the core database implicitly is deprecated. Please specify a hint database. [implicit-core-hint-db,deprecated] File "./Kami/Ex/InDepthTutorial.v", line 379, characters 0-28: Warning: Adding and removing hints in the core database implicitly is deprecated. Please specify a hint database. [implicit-core-hint-db,deprecated] File "./Kami/Ex/InDepthTutorial.v", line 382, characters 0-27: Warning: Adding and removing hints in the core database implicitly is deprecated. Please specify a hint database. [implicit-core-hint-db,deprecated] File "./Kami/Ex/InDepthTutorial.v", line 408, characters 0-334: Warning: datav cannot be defined because it is informative and impl12_inv is not. [cannot-define-projection,records] File "./Kami/Ex/InDepthTutorial.v", line 408, characters 0-334: Warning: Hdatav cannot be defined because the projection datav was not defined. [cannot-define-projection,records] File "./Kami/Ex/InDepthTutorial.v", line 408, characters 0-334: Warning: eltv cannot be defined because it is informative and impl12_inv is not. [cannot-define-projection,records] File "./Kami/Ex/InDepthTutorial.v", line 408, characters 0-334: Warning: Heltv cannot be defined because the projection eltv was not defined. [cannot-define-projection,records] File "./Kami/Ex/InDepthTutorial.v", line 408, characters 0-334: Warning: Hinv cannot be defined because the projections eltv, datav were not defined. [cannot-define-projection,records] File "./Kami/Ex/InDepthTutorial.v", line 527, characters 0-29: Warning: Adding and removing hints in the core database implicitly is deprecated. Please specify a hint database. [implicit-core-hint-db,deprecated] File "./Kami/Ex/InDepthTutorial.v", line 530, characters 0-28: Warning: Adding and removing hints in the core database implicitly is deprecated. Please specify a hint database. [implicit-core-hint-db,deprecated] File "./Kami/Ex/InDepthTutorial.v", line 554, characters 0-33: Warning: Adding and removing hints in the core database implicitly is deprecated. Please specify a hint database. [implicit-core-hint-db,deprecated] File "./Kami/Ex/InDepthTutorial.v", line 557, characters 0-343: Warning: datav cannot be defined because it is informative and impl123_inv is not. [cannot-define-projection,records] File "./Kami/Ex/InDepthTutorial.v", line 557, characters 0-343: Warning: Hdatav cannot be defined because the projection datav was not defined. [cannot-define-projection,records] File "./Kami/Ex/InDepthTutorial.v", line 557, characters 0-343: Warning: eltv cannot be defined because it is informative and impl123_inv is not. [cannot-define-projection,records] File "./Kami/Ex/InDepthTutorial.v", line 557, characters 0-343: Warning: Heltv cannot be defined because the projection eltv was not defined. [cannot-define-projection,records] File "./Kami/Ex/InDepthTutorial.v", line 557, characters 0-343: Warning: Hinv cannot be defined because the projections eltv, datav were not defined. [cannot-define-projection,records] Kami/Ex/ProcDecInl (real: 36.23, user: 17.33, sys: 0.37, mem: 724164 ko) Kami/Ex/IsaRv32PgmExt (real: 2.54, user: 0.92, sys: 0.31, mem: 550756 ko) File "./Kami/Ex/ProcThreeStInv.v", line 155, characters 2-1108: Warning: sbv0 cannot be defined because it is informative and p3st_scoreboard_waw_inv is not. [cannot-define-projection,records] File "./Kami/Ex/ProcThreeStInv.v", line 155, characters 2-1108: Warning: Hsbv0 cannot be defined because the projection sbv0 was not defined. [cannot-define-projection,records] File "./Kami/Ex/ProcThreeStInv.v", line 155, characters 2-1108: Warning: d2eeltv0 cannot be defined because it is informative and p3st_scoreboard_waw_inv is not. [cannot-define-projection,records] File "./Kami/Ex/ProcThreeStInv.v", line 155, characters 2-1108: Warning: Hd2eeltv0 cannot be defined because the projection d2eeltv0 was not defined. [cannot-define-projection,records] File "./Kami/Ex/ProcThreeStInv.v", line 155, characters 2-1108: Warning: d2efullv0 cannot be defined because it is informative and p3st_scoreboard_waw_inv is not. [cannot-define-projection,records] File "./Kami/Ex/ProcThreeStInv.v", line 155, characters 2-1108: Warning: Hd2efullv0 cannot be defined because the projection d2efullv0 was not defined. [cannot-define-projection,records] File "./Kami/Ex/ProcThreeStInv.v", line 155, characters 2-1108: Warning: e2weltv0 cannot be defined because it is informative and p3st_scoreboard_waw_inv is not. [cannot-define-projection,records] File "./Kami/Ex/ProcThreeStInv.v", line 155, characters 2-1108: Warning: He2weltv0 cannot be defined because the projection e2weltv0 was not defined. [cannot-define-projection,records] File "./Kami/Ex/ProcThreeStInv.v", line 155, characters 2-1108: Warning: e2wfullv0 cannot be defined because it is informative and p3st_scoreboard_waw_inv is not. [cannot-define-projection,records] File "./Kami/Ex/ProcThreeStInv.v", line 155, characters 2-1108: Warning: He2wfullv0 cannot be defined because the projection e2wfullv0 was not defined. [cannot-define-projection,records] File "./Kami/Ex/ProcThreeStInv.v", line 155, characters 2-1108: Warning: stallv0 cannot be defined because it is informative and p3st_scoreboard_waw_inv is not. [cannot-define-projection,records] File "./Kami/Ex/ProcThreeStInv.v", line 155, characters 2-1108: Warning: Hstallv0 cannot be defined because the projection stallv0 was not defined. [cannot-define-projection,records] File "./Kami/Ex/ProcThreeStInv.v", line 155, characters 2-1108: Warning: stalledv0 cannot be defined because it is informative and p3st_scoreboard_waw_inv is not. [cannot-define-projection,records] File "./Kami/Ex/ProcThreeStInv.v", line 155, characters 2-1108: Warning: Hstalledv0 cannot be defined because the projection stalledv0 was not defined. [cannot-define-projection,records] File "./Kami/Ex/ProcThreeStInv.v", line 155, characters 2-1108: Warning: Hinv0 cannot be defined because the projections d2efullv0, d2eeltv0, e2wfullv0, e2weltv0, stallv0, stalledv0, sbv0 were not defined. [cannot-define-projection,records] File "./Kami/Ex/ProcThreeStInv.v", line 192, characters 2-1091: Warning: d2eeltv1 cannot be defined because it is informative and p3st_raw_inv is not. [cannot-define-projection,records] File "./Kami/Ex/ProcThreeStInv.v", line 192, characters 2-1091: Warning: Hd2eeltv1 cannot be defined because the projection d2eeltv1 was not defined. [cannot-define-projection,records] File "./Kami/Ex/ProcThreeStInv.v", line 192, characters 2-1091: Warning: d2efullv1 cannot be defined because it is informative and p3st_raw_inv is not. [cannot-define-projection,records] File "./Kami/Ex/ProcThreeStInv.v", line 192, characters 2-1091: Warning: Hd2efullv1 cannot be defined because the projection d2efullv1 was not defined. [cannot-define-projection,records] File "./Kami/Ex/ProcThreeStInv.v", line 192, characters 2-1091: Warning: e2weltv1 cannot be defined because it is informative and p3st_raw_inv is not. [cannot-define-projection,records] File "./Kami/Ex/ProcThreeStInv.v", line 192, characters 2-1091: Warning: He2weltv1 cannot be defined because the projection e2weltv1 was not defined. [cannot-define-projection,records] File "./Kami/Ex/ProcThreeStInv.v", line 192, characters 2-1091: Warning: e2wfullv1 cannot be defined because it is informative and p3st_raw_inv is not. [cannot-define-projection,records] File "./Kami/Ex/ProcThreeStInv.v", line 192, characters 2-1091: Warning: He2wfullv1 cannot be defined because the projection e2wfullv1 was not defined. [cannot-define-projection,records] File "./Kami/Ex/ProcThreeStInv.v", line 192, characters 2-1091: Warning: stallv1 cannot be defined because it is informative and p3st_raw_inv is not. [cannot-define-projection,records] File "./Kami/Ex/ProcThreeStInv.v", line 192, characters 2-1091: Warning: Hstallv1 cannot be defined because the projection stallv1 was not defined. [cannot-define-projection,records] File "./Kami/Ex/ProcThreeStInv.v", line 192, characters 2-1091: Warning: stalledv1 cannot be defined because it is informative and p3st_raw_inv is not. [cannot-define-projection,records] File "./Kami/Ex/ProcThreeStInv.v", line 192, characters 2-1091: Warning: Hstalledv1 cannot be defined because the projection stalledv1 was not defined. [cannot-define-projection,records] File "./Kami/Ex/ProcThreeStInv.v", line 192, characters 2-1091: Warning: Hd2einv1 cannot be defined because the projections d2efullv1, stallv1, d2eeltv1, stalledv1 were not defined. [cannot-define-projection,records] File "./Kami/Ex/ProcThreeStInv.v", line 192, characters 2-1091: Warning: He2winv1 cannot be defined because the projections e2wfullv1, stallv1, e2weltv1, stalledv1 were not defined. [cannot-define-projection,records] File "./Kami/Ex/ProcThreeStInv.v", line 192, characters 2-1091: Warning: Hd2winv1 cannot be defined because the projections d2efullv1, e2wfullv1, d2eeltv1, e2weltv1 were not defined. [cannot-define-projection,records] File "./Kami/Ex/ProcThreeStInv.v", line 238, characters 2-1015: Warning: pgmv2 cannot be defined because it is informative and p3st_decode_inv is not. [cannot-define-projection,records] File "./Kami/Ex/ProcThreeStInv.v", line 238, characters 2-1015: Warning: Hpgmv2 cannot be defined because the projection pgmv2 was not defined. [cannot-define-projection,records] File "./Kami/Ex/ProcThreeStInv.v", line 238, characters 2-1015: Warning: rfv2 cannot be defined because it is informative and p3st_decode_inv is not. [cannot-define-projection,records] File "./Kami/Ex/ProcThreeStInv.v", line 238, characters 2-1015: Warning: Hrfv2 cannot be defined because the projection rfv2 was not defined. [cannot-define-projection,records] File "./Kami/Ex/ProcThreeStInv.v", line 238, characters 2-1015: Warning: d2eeltv2 cannot be defined because it is informative and p3st_decode_inv is not. [cannot-define-projection,records] File "./Kami/Ex/ProcThreeStInv.v", line 238, characters 2-1015: Warning: Hd2eeltv2 cannot be defined because the projection d2eeltv2 was not defined. [cannot-define-projection,records] File "./Kami/Ex/ProcThreeStInv.v", line 238, characters 2-1015: Warning: d2efullv2 cannot be defined because it is informative and p3st_decode_inv is not. [cannot-define-projection,records] File "./Kami/Ex/ProcThreeStInv.v", line 238, characters 2-1015: Warning: Hd2efullv2 cannot be defined because the projection d2efullv2 was not defined. [cannot-define-projection,records] File "./Kami/Ex/ProcThreeStInv.v", line 238, characters 2-1015: Warning: e2weltv2 cannot be defined because it is informative and p3st_decode_inv is not. [cannot-define-projection,records] File "./Kami/Ex/ProcThreeStInv.v", line 238, characters 2-1015: Warning: He2weltv2 cannot be defined because the projection e2weltv2 was not defined. [cannot-define-projection,records] File "./Kami/Ex/ProcThreeStInv.v", line 238, characters 2-1015: Warning: e2wfullv2 cannot be defined because it is informative and p3st_decode_inv is not. [cannot-define-projection,records] File "./Kami/Ex/ProcThreeStInv.v", line 238, characters 2-1015: Warning: He2wfullv2 cannot be defined because the projection e2wfullv2 was not defined. [cannot-define-projection,records] File "./Kami/Ex/ProcThreeStInv.v", line 238, characters 2-1015: Warning: Hd2einv2 cannot be defined because the projections pgmv2, rfv2, d2eeltv2, d2efullv2 were not defined. [cannot-define-projection,records] File "./Kami/Ex/ProcThreeStInv.v", line 238, characters 2-1015: Warning: He2winv2 cannot be defined because the projections pgmv2, rfv2, e2weltv2, e2wfullv2 were not defined. [cannot-define-projection,records] File "./Kami/Ex/ProcThreeStInv.v", line 272, characters 2-641: Warning: pgmv3 cannot be defined because it is informative and p3st_stalled_inv is not. [cannot-define-projection,records] File "./Kami/Ex/ProcThreeStInv.v", line 272, characters 2-641: Warning: Hpgmv3 cannot be defined because the projection pgmv3 was not defined. [cannot-define-projection,records] File "./Kami/Ex/ProcThreeStInv.v", line 272, characters 2-641: Warning: rfv3 cannot be defined because it is informative and p3st_stalled_inv is not. [cannot-define-projection,records] File "./Kami/Ex/ProcThreeStInv.v", line 272, characters 2-641: Warning: Hrfv3 cannot be defined because the projection rfv3 was not defined. [cannot-define-projection,records] File "./Kami/Ex/ProcThreeStInv.v", line 272, characters 2-641: Warning: stallv3 cannot be defined because it is informative and p3st_stalled_inv is not. [cannot-define-projection,records] File "./Kami/Ex/ProcThreeStInv.v", line 272, characters 2-641: Warning: Hstallv3 cannot be defined because the projection stallv3 was not defined. [cannot-define-projection,records] File "./Kami/Ex/ProcThreeStInv.v", line 272, characters 2-641: Warning: stalledv3 cannot be defined because it is informative and p3st_stalled_inv is not. [cannot-define-projection,records] File "./Kami/Ex/ProcThreeStInv.v", line 272, characters 2-641: Warning: Hstalledv3 cannot be defined because the projection stalledv3 was not defined. [cannot-define-projection,records] File "./Kami/Ex/ProcThreeStInv.v", line 272, characters 2-641: Warning: Hinv3 cannot be defined because the projections pgmv3, rfv3, stallv3, stalledv3 were not defined. [cannot-define-projection,records] File "./Kami/Ex/ProcThreeStInv.v", line 299, characters 2-621: Warning: pcv4 cannot be defined because it is informative and p3st_exec_inv is not. [cannot-define-projection,records] File "./Kami/Ex/ProcThreeStInv.v", line 299, characters 2-621: Warning: Hpcv4 cannot be defined because the projection pcv4 was not defined. [cannot-define-projection,records] File "./Kami/Ex/ProcThreeStInv.v", line 299, characters 2-621: Warning: rfv4 cannot be defined because it is informative and p3st_exec_inv is not. [cannot-define-projection,records] File "./Kami/Ex/ProcThreeStInv.v", line 299, characters 2-621: Warning: Hrfv4 cannot be defined because the projection rfv4 was not defined. [cannot-define-projection,records] File "./Kami/Ex/ProcThreeStInv.v", line 299, characters 2-621: Warning: e2weltv4 cannot be defined because it is informative and p3st_exec_inv is not. [cannot-define-projection,records] File "./Kami/Ex/ProcThreeStInv.v", line 299, characters 2-621: Warning: He2weltv4 cannot be defined because the projection e2weltv4 was not defined. [cannot-define-projection,records] File "./Kami/Ex/ProcThreeStInv.v", line 299, characters 2-621: Warning: e2wfullv4 cannot be defined because it is informative and p3st_exec_inv is not. [cannot-define-projection,records] File "./Kami/Ex/ProcThreeStInv.v", line 299, characters 2-621: Warning: He2wfullv4 cannot be defined because the projection e2wfullv4 was not defined. [cannot-define-projection,records] File "./Kami/Ex/ProcThreeStInv.v", line 299, characters 2-621: Warning: Hinv4 cannot be defined because the projections pcv4, rfv4, e2wfullv4, e2weltv4 were not defined. [cannot-define-projection,records] File "./Kami/Ex/ProcThreeStInv.v", line 340, characters 2-1704: Warning: pcv5 cannot be defined because it is informative and p3st_epochs_inv is not. [cannot-define-projection,records] File "./Kami/Ex/ProcThreeStInv.v", line 340, characters 2-1704: Warning: Hpcv5 cannot be defined because the projection pcv5 was not defined. [cannot-define-projection,records] File "./Kami/Ex/ProcThreeStInv.v", line 340, characters 2-1704: Warning: fepochv5 cannot be defined because it is informative and p3st_epochs_inv is not. [cannot-define-projection,records] File "./Kami/Ex/ProcThreeStInv.v", line 340, characters 2-1704: Warning: Hfepochv5 cannot be defined because the projection fepochv5 was not defined. [cannot-define-projection,records] File "./Kami/Ex/ProcThreeStInv.v", line 340, characters 2-1704: Warning: d2eeltv5 cannot be defined because it is informative and p3st_epochs_inv is not. [cannot-define-projection,records] File "./Kami/Ex/ProcThreeStInv.v", line 340, characters 2-1704: Warning: Hd2eeltv5 cannot be defined because the projection d2eeltv5 was not defined. [cannot-define-projection,records] File "./Kami/Ex/ProcThreeStInv.v", line 340, characters 2-1704: Warning: d2efullv5 cannot be defined because it is informative and p3st_epochs_inv is not. [cannot-define-projection,records] File "./Kami/Ex/ProcThreeStInv.v", line 340, characters 2-1704: Warning: Hd2efullv5 cannot be defined because the projection d2efullv5 was not defined. [cannot-define-projection,records] File "./Kami/Ex/ProcThreeStInv.v", line 340, characters 2-1704: Warning: w2deltv5 cannot be defined because it is informative and p3st_epochs_inv is not. [cannot-define-projection,records] File "./Kami/Ex/ProcThreeStInv.v", line 340, characters 2-1704: Warning: Hw2deltv5 cannot be defined because the projection w2deltv5 was not defined. [cannot-define-projection,records] File "./Kami/Ex/ProcThreeStInv.v", line 340, characters 2-1704: Warning: w2dfullv5 cannot be defined because it is informative and p3st_epochs_inv is not. [cannot-define-projection,records] File "./Kami/Ex/ProcThreeStInv.v", line 340, characters 2-1704: Warning: Hw2dfullv5 cannot be defined because the projection w2dfullv5 was not defined. [cannot-define-projection,records] File "./Kami/Ex/ProcThreeStInv.v", line 340, characters 2-1704: Warning: e2weltv5 cannot be defined because it is informative and p3st_epochs_inv is not. [cannot-define-projection,records] File "./Kami/Ex/ProcThreeStInv.v", line 340, characters 2-1704: Warning: He2weltv5 cannot be defined because the projection e2weltv5 was not defined. [cannot-define-projection,records] File "./Kami/Ex/ProcThreeStInv.v", line 340, characters 2-1704: Warning: e2wfullv5 cannot be defined because it is informative and p3st_epochs_inv is not. [cannot-define-projection,records] File "./Kami/Ex/ProcThreeStInv.v", line 340, characters 2-1704: Warning: He2wfullv5 cannot be defined because the projection e2wfullv5 was not defined. [cannot-define-projection,records] File "./Kami/Ex/ProcThreeStInv.v", line 340, characters 2-1704: Warning: stallv5 cannot be defined because it is informative and p3st_epochs_inv is not. [cannot-define-projection,records] File "./Kami/Ex/ProcThreeStInv.v", line 340, characters 2-1704: Warning: Hstallv5 cannot be defined because the projection stallv5 was not defined. [cannot-define-projection,records] File "./Kami/Ex/ProcThreeStInv.v", line 340, characters 2-1704: Warning: stalledv5 cannot be defined because it is informative and p3st_epochs_inv is not. [cannot-define-projection,records] File "./Kami/Ex/ProcThreeStInv.v", line 340, characters 2-1704: Warning: Hstalledv5 cannot be defined because the projection stalledv5 was not defined. [cannot-define-projection,records] File "./Kami/Ex/ProcThreeStInv.v", line 340, characters 2-1704: Warning: eepochv5 cannot be defined because it is informative and p3st_epochs_inv is not. [cannot-define-projection,records] File "./Kami/Ex/ProcThreeStInv.v", line 340, characters 2-1704: Warning: Heepochv5 cannot be defined because the projection eepochv5 was not defined. [cannot-define-projection,records] File "./Kami/Ex/ProcThreeStInv.v", line 340, characters 2-1704: Warning: Hinv5 cannot be defined because the projections fepochv5, eepochv5, d2efullv5, e2wfullv5, w2dfullv5, stallv5, pcv5, d2eeltv5, e2weltv5, stalledv5 were not defined. [cannot-define-projection,records] File "./Kami/Ex/ProcThreeStInv.v", line 398, characters 2-1469: Warning: pcv6 cannot be defined because it is informative and p3st_pc_inv is not. [cannot-define-projection,records] File "./Kami/Ex/ProcThreeStInv.v", line 398, characters 2-1469: Warning: Hpcv6 cannot be defined because the projection pcv6 was not defined. [cannot-define-projection,records] File "./Kami/Ex/ProcThreeStInv.v", line 398, characters 2-1469: Warning: fepochv6 cannot be defined because it is informative and p3st_pc_inv is not. [cannot-define-projection,records] File "./Kami/Ex/ProcThreeStInv.v", line 398, characters 2-1469: Warning: Hfepochv6 cannot be defined because the projection fepochv6 was not defined. [cannot-define-projection,records] File "./Kami/Ex/ProcThreeStInv.v", line 398, characters 2-1469: Warning: d2eeltv6 cannot be defined because it is informative and p3st_pc_inv is not. [cannot-define-projection,records] File "./Kami/Ex/ProcThreeStInv.v", line 398, characters 2-1469: Warning: Hd2eeltv6 cannot be defined because the projection d2eeltv6 was not defined. [cannot-define-projection,records] File "./Kami/Ex/ProcThreeStInv.v", line 398, characters 2-1469: Warning: d2efullv6 cannot be defined because it is informative and p3st_pc_inv is not. [cannot-define-projection,records] File "./Kami/Ex/ProcThreeStInv.v", line 398, characters 2-1469: Warning: Hd2efullv6 cannot be defined because the projection d2efullv6 was not defined. [cannot-define-projection,records] File "./Kami/Ex/ProcThreeStInv.v", line 398, characters 2-1469: Warning: w2dfullv6 cannot be defined because it is informative and p3st_pc_inv is not. [cannot-define-projection,records] File "./Kami/Ex/ProcThreeStInv.v", line 398, characters 2-1469: Warning: Hw2dfullv6 cannot be defined because the projection w2dfullv6 was not defined. [cannot-define-projection,records] File "./Kami/Ex/ProcThreeStInv.v", line 398, characters 2-1469: Warning: e2weltv6 cannot be defined because it is informative and p3st_pc_inv is not. [cannot-define-projection,records] File "./Kami/Ex/ProcThreeStInv.v", line 398, characters 2-1469: Warning: He2weltv6 cannot be defined because the projection e2weltv6 was not defined. [cannot-define-projection,records] File "./Kami/Ex/ProcThreeStInv.v", line 398, characters 2-1469: Warning: e2wfullv6 cannot be defined because it is informative and p3st_pc_inv is not. [cannot-define-projection,records] File "./Kami/Ex/ProcThreeStInv.v", line 398, characters 2-1469: Warning: He2wfullv6 cannot be defined because the projection e2wfullv6 was not defined. [cannot-define-projection,records] File "./Kami/Ex/ProcThreeStInv.v", line 398, characters 2-1469: Warning: stallv6 cannot be defined because it is informative and p3st_pc_inv is not. [cannot-define-projection,records] File "./Kami/Ex/ProcThreeStInv.v", line 398, characters 2-1469: Warning: Hstallv6 cannot be defined because the projection stallv6 was not defined. [cannot-define-projection,records] File "./Kami/Ex/ProcThreeStInv.v", line 398, characters 2-1469: Warning: stalledv6 cannot be defined because it is informative and p3st_pc_inv is not. [cannot-define-projection,records] File "./Kami/Ex/ProcThreeStInv.v", line 398, characters 2-1469: Warning: Hstalledv6 cannot be defined because the projection stalledv6 was not defined. [cannot-define-projection,records] File "./Kami/Ex/ProcThreeStInv.v", line 398, characters 2-1469: Warning: eepochv6 cannot be defined because it is informative and p3st_pc_inv is not. [cannot-define-projection,records] File "./Kami/Ex/ProcThreeStInv.v", line 398, characters 2-1469: Warning: Heepochv6 cannot be defined because the projection eepochv6 was not defined. [cannot-define-projection,records] File "./Kami/Ex/ProcThreeStInv.v", line 398, characters 2-1469: Warning: Hinv6 cannot be defined because the projections fepochv6, eepochv6, d2efullv6, e2wfullv6, w2dfullv6, stallv6, pcv6, d2eeltv6, e2weltv6, stalledv6 were not defined. [cannot-define-projection,records] Kami/Ex/ProcThreeStInv (real: 3.48, user: 1.44, sys: 0.25, mem: 498104 ko) File "./Kami/Ex/InDepthTutorial.v", line 680, characters 0-16: Warning: The spelling "OCaml" should be used instead of "Ocaml". [deprecated-ocaml-spelling,deprecated] Kami/Ex/InDepthTutorial (real: 47.16, user: 22.68, sys: 0.34, mem: 653084 ko) File "./Kami/Ex/ProcThreeStDec.v", line 120, characters 2-59: Warning: Adding and removing hints in the core database implicitly is deprecated. Please specify a hint database. [implicit-core-hint-db,deprecated] File "./Kami/Ex/ProcThreeStDec.v", line 121, characters 2-59: Warning: Adding and removing hints in the core database implicitly is deprecated. Please specify a hint database. [implicit-core-hint-db,deprecated] Kami/Ex/ProcThreeStDec (real: 2.97, user: 1.19, sys: 0.25, mem: 495240 ko) File "./Kami/Ex/ProcDecInv.v", line 82, characters 2-2422: Warning: pcv cannot be defined because it is informative and procDec_inv is not. [cannot-define-projection,records] File "./Kami/Ex/ProcDecInv.v", line 82, characters 2-2422: Warning: Hpcv cannot be defined because the projection pcv was not defined. [cannot-define-projection,records] File "./Kami/Ex/ProcDecInv.v", line 82, characters 2-2422: Warning: rfv cannot be defined because it is informative and procDec_inv is not. [cannot-define-projection,records] File "./Kami/Ex/ProcDecInv.v", line 82, characters 2-2422: Warning: Hrfv cannot be defined because the projection rfv was not defined. [cannot-define-projection,records] File "./Kami/Ex/ProcDecInv.v", line 82, characters 2-2422: Warning: pgmv cannot be defined because it is informative and procDec_inv is not. [cannot-define-projection,records] File "./Kami/Ex/ProcDecInv.v", line 82, characters 2-2422: Warning: Hpgmv cannot be defined because the projection pgmv was not defined. [cannot-define-projection,records] File "./Kami/Ex/ProcDecInv.v", line 82, characters 2-2422: Warning: stallv cannot be defined because it is informative and procDec_inv is not. [cannot-define-projection,records] File "./Kami/Ex/ProcDecInv.v", line 82, characters 2-2422: Warning: Hstallv cannot be defined because the projection stallv was not defined. [cannot-define-projection,records] File "./Kami/Ex/ProcDecInv.v", line 82, characters 2-2422: Warning: iev cannot be defined because it is informative and procDec_inv is not. [cannot-define-projection,records] File "./Kami/Ex/ProcDecInv.v", line 82, characters 2-2422: Warning: Hiev cannot be defined because the projection iev was not defined. [cannot-define-projection,records] File "./Kami/Ex/ProcDecInv.v", line 82, characters 2-2422: Warning: ifv cannot be defined because it is informative and procDec_inv is not. [cannot-define-projection,records] File "./Kami/Ex/ProcDecInv.v", line 82, characters 2-2422: Warning: Hifv cannot be defined because the projection ifv was not defined. [cannot-define-projection,records] File "./Kami/Ex/ProcDecInv.v", line 82, characters 2-2422: Warning: ienqpv cannot be defined because it is informative and procDec_inv is not. [cannot-define-projection,records] File "./Kami/Ex/ProcDecInv.v", line 82, characters 2-2422: Warning: Hienqpv cannot be defined because the projection ienqpv was not defined. [cannot-define-projection,records] File "./Kami/Ex/ProcDecInv.v", line 82, characters 2-2422: Warning: ideqpv cannot be defined because it is informative and procDec_inv is not. [cannot-define-projection,records] File "./Kami/Ex/ProcDecInv.v", line 82, characters 2-2422: Warning: Hideqpv cannot be defined because the projection ideqpv was not defined. [cannot-define-projection,records] File "./Kami/Ex/ProcDecInv.v", line 82, characters 2-2422: Warning: ieltv cannot be defined because it is informative and procDec_inv is not. [cannot-define-projection,records] File "./Kami/Ex/ProcDecInv.v", line 82, characters 2-2422: Warning: Hieltv cannot be defined because the projection ieltv was not defined. [cannot-define-projection,records] File "./Kami/Ex/ProcDecInv.v", line 82, characters 2-2422: Warning: oev cannot be defined because it is informative and procDec_inv is not. [cannot-define-projection,records] File "./Kami/Ex/ProcDecInv.v", line 82, characters 2-2422: Warning: Hoev cannot be defined because the projection oev was not defined. [cannot-define-projection,records] File "./Kami/Ex/ProcDecInv.v", line 82, characters 2-2422: Warning: ofv cannot be defined because it is informative and procDec_inv is not. [cannot-define-projection,records] File "./Kami/Ex/ProcDecInv.v", line 82, characters 2-2422: Warning: Hofv cannot be defined because the projection ofv was not defined. [cannot-define-projection,records] File "./Kami/Ex/ProcDecInv.v", line 82, characters 2-2422: Warning: oenqpv cannot be defined because it is informative and procDec_inv is not. [cannot-define-projection,records] File "./Kami/Ex/ProcDecInv.v", line 82, characters 2-2422: Warning: Hoenqpv cannot be defined because the projection oenqpv was not defined. [cannot-define-projection,records] File "./Kami/Ex/ProcDecInv.v", line 82, characters 2-2422: Warning: odeqpv cannot be defined because it is informative and procDec_inv is not. [cannot-define-projection,records] File "./Kami/Ex/ProcDecInv.v", line 82, characters 2-2422: Warning: Hodeqpv cannot be defined because the projection odeqpv was not defined. [cannot-define-projection,records] File "./Kami/Ex/ProcDecInv.v", line 82, characters 2-2422: Warning: oeltv cannot be defined because it is informative and procDec_inv is not. [cannot-define-projection,records] File "./Kami/Ex/ProcDecInv.v", line 82, characters 2-2422: Warning: Hoeltv cannot be defined because the projection oeltv was not defined. [cannot-define-projection,records] File "./Kami/Ex/ProcDecInv.v", line 82, characters 2-2422: Warning: Hinv cannot be defined because the projections stallv, iev, ienqpv, ideqpv, oev, oenqpv, odeqpv, stallv, iev, ienqpv, ideqpv, oev, oenqpv, odeqpv, pgmv, pcv, rfv, iev, ieltv, ideqpv, stallv, iev, ienqpv, ideqpv, oev, oenqpv, odeqpv were not defined. [cannot-define-projection,records] Kami/Ex/ProcDecInv (real: 4.24, user: 1.78, sys: 0.26, mem: 495196 ko) File "./Kami/Ex/ProcDecSC.v", line 46, characters 2-59: Warning: Adding and removing hints in the core database implicitly is deprecated. Please specify a hint database. [implicit-core-hint-db,deprecated] File "./Kami/Ex/ProcDecSC.v", line 47, characters 2-61: Warning: Adding and removing hints in the core database implicitly is deprecated. Please specify a hint database. [implicit-core-hint-db,deprecated] Kami/Ex/ProcDecSC (real: 4.07, user: 0.93, sys: 0.30, mem: 493232 ko) Kami/Ex/ProcDecSCN (real: 2.30, user: 0.81, sys: 0.29, mem: 488468 ko) Kami/Ex/ProcFDInl (real: 81.62, user: 68.57, sys: 0.68, mem: 1312068 ko) File "./Kami/Ex/ProcFDInv.v", line 103, characters 2-743: Warning: pcv cannot be defined because it is informative and fetchDecode_inv is not. [cannot-define-projection,records] File "./Kami/Ex/ProcFDInv.v", line 103, characters 2-743: Warning: Hpcv cannot be defined because the projection pcv was not defined. [cannot-define-projection,records] File "./Kami/Ex/ProcFDInv.v", line 103, characters 2-743: Warning: pgmv cannot be defined because it is informative and fetchDecode_inv is not. [cannot-define-projection,records] File "./Kami/Ex/ProcFDInv.v", line 103, characters 2-743: Warning: Hpgmv cannot be defined because the projection pgmv was not defined. [cannot-define-projection,records] File "./Kami/Ex/ProcFDInv.v", line 103, characters 2-743: Warning: fepochv cannot be defined because it is informative and fetchDecode_inv is not. [cannot-define-projection,records] File "./Kami/Ex/ProcFDInv.v", line 103, characters 2-743: Warning: Hfepochv cannot be defined because the projection fepochv was not defined. [cannot-define-projection,records] File "./Kami/Ex/ProcFDInv.v", line 103, characters 2-743: Warning: f2dfullv cannot be defined because it is informative and fetchDecode_inv is not. [cannot-define-projection,records] File "./Kami/Ex/ProcFDInv.v", line 103, characters 2-743: Warning: Hf2dfullv cannot be defined because the projection f2dfullv was not defined. [cannot-define-projection,records] File "./Kami/Ex/ProcFDInv.v", line 103, characters 2-743: Warning: f2deltv cannot be defined because it is informative and fetchDecode_inv is not. [cannot-define-projection,records] File "./Kami/Ex/ProcFDInv.v", line 103, characters 2-743: Warning: Hf2deltv cannot be defined because the projection f2deltv was not defined. [cannot-define-projection,records] File "./Kami/Ex/ProcFDInv.v", line 103, characters 2-743: Warning: Hinv cannot be defined because the projections pcv, pgmv, fepochv, f2dfullv, f2deltv were not defined. [cannot-define-projection,records] Kami/Ex/ProcFDInv (real: 2.76, user: 2.42, sys: 0.23, mem: 526316 ko) File "./Kami/Ex/ProcFDCorrect.v", line 96, characters 2-73: Warning: Adding and removing hints in the core database implicitly is deprecated. Please specify a hint database. [implicit-core-hint-db,deprecated] File "./Kami/Ex/ProcFDCorrect.v", line 97, characters 2-75: Warning: Adding and removing hints in the core database implicitly is deprecated. Please specify a hint database. [implicit-core-hint-db,deprecated] Kami/Ex/ProcFDCorrect (real: 1.11, user: 0.83, sys: 0.23, mem: 526908 ko) Kami/Ex/ProcFourStDec (real: 1.06, user: 0.80, sys: 0.23, mem: 527136 ko) Warning: bedrock2/deps/coqutil/src (used in -R or -Q) is not a subdirectory of the current directory bedrock2/processor/src/KamiWord (real: 1.30, user: 0.45, sys: 0.16, mem: 358800 ko) bedrock2/processor/src/Test (real: 3.56, user: 1.51, sys: 0.22, mem: 473632 ko) bedrock2/processor/src/KamiRiscv (real: 27.54, user: 25.47, sys: 0.35, mem: 729768 ko) vp ] md) -> (ma ++ mc)%kami <<=[ vp ] (mb ++ md)%kami simpleFifo : string -> nat -> Kind -> Modules = Mod [("data" :: RegInitDefault (SyntaxKind (Bit dataSize)))%struct; ("elt.fifo1" :: RegInitCustom (existT ConstFullT (list (word dataSize)) #< (nil)%kami_expr (NativeConst nil nil)))%struct] [("produce" :: (fun type : Kind -> Type => (Read a : Bit dataSize <- "data"; LET a0 : Bit dataSize <- # (a); Read a1 <- "elt.fifo1"; Write "elt.fifo1" <- Var type (list (type (Bit dataSize))) #< (nil) ((fix app (l m : list (type (Bit dataSize))) {struct l} : list (type (Bit dataSize)) := match l with | nil => m | a2 :: l1 => a2 :: app l1 m end) a1 [a0]); LET _ : Void <- $$ (WO); Write "data" : Bit dataSize <- # (a) + $$ ($ (1)); Ret $$ (WO))%kami_action))%struct; ("doDouble" :: (fun type : Kind -> Type => (LET _ : Void <- $$ (WO); Read a0 <- "elt.fifo1"; Assert ! $$ (match a0 with | nil => true | _ :: _ => false end); Write "elt.fifo1" <- Var type (list (type (Bit dataSize))) #< (nil) match a0 with | nil => nil | _ :: t => t end; LET ak : Bit dataSize <- match a0 with | nil => $$ (getDefaultConstBit dataSize) | h :: _ => # (h) end; LET a1 : Bit dataSize <- $$ ($ (2)) * # (ak); CallM _ : Void <- "enq.fifo2" (# (a1) : Bit dataSize); Ret $$ (WO))%kami_action))%struct] nil : Modules COQC Kami/Ex/IsaRv32PgmExt.v COQC Kami/Ex/ProcThreeStInv.v COQC Kami/Ex/ProcFDInl.v impl = fun dataSize : nat => (stage1 dataSize ++ fifo1 dataSize ++ stage2 dataSize ++ fifo2 dataSize ++ stage3 dataSize)%kami : nat -> Modules Argument scope is [nat_scope] COQC Kami/Ex/ProcThreeStDec.v COQC Kami/Ex/ProcDecInv.v COQC Kami/Ex/ProcDecSC.v COQC Kami/Ex/ProcDecSCN.v COQC Kami/Ex/ProcFDInv.v COQC Kami/Ex/ProcFDCorrect.v COQC Kami/Ex/ProcFourStDec.v make[3]: Leaving directory 'bedrock2/deps/kami' make[2]: Leaving directory 'bedrock2/deps/kami' make -C bedrock2/processor make[2]: Entering directory 'bedrock2/processor' printf -- '-Q bedrock2/deps/coqutil/src coqutil\n-Q bedrock2/deps/riscv-coq/src riscv\n-R bedrock2/deps/kami/Kami/ Kami\n-Q ./src processor\n' > _CoqProject /builds/coq/coq/_install_ci/bin/coq_makefile -f _CoqProject INSTALLDEFAULTROOT = bedrock2 -arg "-async-proofs-tac-j 1" bedrock2/processor/src/Test.v bedrock2/processor/src/KamiWord.v bedrock2/processor/src/KamiRiscv.v -o Makefile.coq.all make -f Makefile.coq.all make[3]: Entering directory 'bedrock2/processor' COQDEP VFILES COQC bedrock2/processor/src/Test.v COQC bedrock2/processor/src/KamiWord.v COQC bedrock2/processor/src/KamiRiscv.v make[3]: Leaving directory 'bedrock2/processor' make[2]: Leaving directory 'bedrock2/processor' make[1]: Leaving directory 'bedrock2' coq-8.20.0/test-suite/precomputed-time-tests/per-file-fuzz/000077500000000000000000000000001466560755400236355ustar00rootroot00000000000000coq-8.20.0/test-suite/precomputed-time-tests/per-file-fuzz/foo-real.v.timing.diff.expected000066400000000000000000000060741466560755400315340ustar00rootroot00000000000000 After | Code | Before || Change | % Change ----------------------------------------------------------------------------------------------------------- 0m01.24s | Total | 0m01.28s || -0m00.04s | -3.50% ----------------------------------------------------------------------------------------------------------- 0m00.53s | Chars 260-284 ~ 280-304 [(vm_compute;~reflexivity).] | 0m00.566s || -0m00.04s | -6.36% 0m00.4s | Chars 285-289 ~ 305-309 [Qed.] | 0m00.411s || -0m00.01s | -2.67% 0m00.194s | Chars 031-064 ~ 031-064 [Require~Import~Coq.ZArith.ZArith.] | 0m00.192s || +0m00.00s | +1.04% 0m00.114s | Chars 000-030 ~ 000-030 [Require~Import~Coq.Lists.List.] | 0m00.114s || +0m00.00s | +0.00% 0m00.s | Chars 065-075 ~ 065-075 [Goal~_~True.] | 0m00.s || +0m00.00s | N/A 0m00.s | Chars 078-086 ~ 078-086 [exact~I.] | N/A || +0m00.00s | N/A N/A | Chars 078-090 ~ 078-090 [constructor.] | 0m00.s || +0m00.00s | N/A 0m00.s | Chars 087-091 ~ 091-095 [Qed.] | 0m00.s || +0m00.00s | N/A 0m00.s | Chars 092-102 ~ 096-106 [Goal~_~True.] | 0m00.s || +0m00.00s | N/A 0m00.s | Chars 105-113 ~ 109-117 [exact~I.] | N/A || +0m00.00s | N/A N/A | Chars 105-117 ~ 109-121 [constructor.] | 0m00.s || +0m00.00s | N/A 0m00.s | Chars 114-118 ~ 122-126 [Qed.] | 0m00.s || +0m00.00s | N/A 0m00.s | Chars 119-129 ~ 127-137 [Goal~_~True.] | 0m00.s || +0m00.00s | N/A 0m00.s | Chars 132-140 ~ 140-148 [exact~I.] | N/A || +0m00.00s | N/A N/A | Chars 132-144 ~ 140-152 [constructor.] | 0m00.s || +0m00.00s | N/A 0m00.s | Chars 141-145 ~ 153-157 [Qed.] | 0m00.s || +0m00.00s | N/A 0m00.s | Chars 146-156 ~ 158-168 [Goal~_~True.] | 0m00.s || +0m00.00s | N/A 0m00.s | Chars 159-167 ~ 171-179 [exact~I.] | N/A || +0m00.00s | N/A N/A | Chars 159-171 ~ 171-183 [constructor.] | 0m00.s || +0m00.00s | N/A 0m00.s | Chars 168-172 ~ 184-188 [Qed.] | 0m00.s || +0m00.00s | N/A 0m00.s | Chars 173-183 ~ 189-199 [Goal~_~True.] | 0m00.s || +0m00.00s | N/A 0m00.s | Chars 186-194 ~ 202-210 [exact~I.] | N/A || +0m00.00s | N/A N/A | Chars 186-198 ~ 202-214 [constructor.] | 0m00.s || +0m00.00s | N/A 0m00.s | Chars 195-199 ~ 215-219 [Qed.] | 0m00.s || +0m00.00s | N/A 0m00.s | Chars 200-257 ~ 220-277 [Goal~_~List.repeat~Z.div_eucl~...] | 0m00.s || +0m00.00s | N/A coq-8.20.0/test-suite/precomputed-time-tests/per-file-fuzz/foo-user.v.timing.diff.expected000066400000000000000000000060761466560755400315710ustar00rootroot00000000000000 After | Code | Before || Change | % Change ----------------------------------------------------------------------------------------------------------- 0m01.15s | Total | 0m01.16s || -0m00.01s | -0.77% ----------------------------------------------------------------------------------------------------------- 0m00.504s | Chars 260-284 ~ 280-304 [(vm_compute;~reflexivity).] | 0m00.528s || -0m00.02s | -4.54% 0m00.384s | Chars 285-289 ~ 305-309 [Qed.] | 0m00.4s || -0m00.02s | -4.00% 0m00.172s | Chars 031-064 ~ 031-064 [Require~Import~Coq.ZArith.ZArith.] | 0m00.156s || +0m00.02s | +10.25% 0m00.083s | Chars 000-030 ~ 000-030 [Require~Import~Coq.Lists.List.] | 0m00.072s || +0m00.01s | +15.27% 0m00.004s | Chars 200-257 ~ 220-277 [Goal~_~List.repeat~Z.div_eucl~...] | 0m00.s || +0m00.00s | ∞ 0m00.s | Chars 065-075 ~ 065-075 [Goal~_~True.] | 0m00.s || +0m00.00s | N/A 0m00.s | Chars 078-086 ~ 078-086 [exact~I.] | N/A || +0m00.00s | N/A N/A | Chars 078-090 ~ 078-090 [constructor.] | 0m00.s || +0m00.00s | N/A 0m00.s | Chars 087-091 ~ 091-095 [Qed.] | 0m00.s || +0m00.00s | N/A 0m00.s | Chars 092-102 ~ 096-106 [Goal~_~True.] | 0m00.s || +0m00.00s | N/A 0m00.s | Chars 105-113 ~ 109-117 [exact~I.] | N/A || +0m00.00s | N/A N/A | Chars 105-117 ~ 109-121 [constructor.] | 0m00.s || +0m00.00s | N/A 0m00.s | Chars 114-118 ~ 122-126 [Qed.] | 0m00.s || +0m00.00s | N/A 0m00.s | Chars 119-129 ~ 127-137 [Goal~_~True.] | 0m00.s || +0m00.00s | N/A 0m00.s | Chars 132-140 ~ 140-148 [exact~I.] | N/A || +0m00.00s | N/A N/A | Chars 132-144 ~ 140-152 [constructor.] | 0m00.s || +0m00.00s | N/A 0m00.s | Chars 141-145 ~ 153-157 [Qed.] | 0m00.s || +0m00.00s | N/A 0m00.s | Chars 146-156 ~ 158-168 [Goal~_~True.] | 0m00.s || +0m00.00s | N/A 0m00.s | Chars 159-167 ~ 171-179 [exact~I.] | N/A || +0m00.00s | N/A N/A | Chars 159-171 ~ 171-183 [constructor.] | 0m00.s || +0m00.00s | N/A 0m00.s | Chars 168-172 ~ 184-188 [Qed.] | 0m00.s || +0m00.00s | N/A 0m00.s | Chars 173-183 ~ 189-199 [Goal~_~True.] | 0m00.s || +0m00.00s | N/A 0m00.s | Chars 186-194 ~ 202-210 [exact~I.] | N/A || +0m00.00s | N/A N/A | Chars 186-198 ~ 202-214 [constructor.] | 0m00.s || +0m00.00s | N/A 0m00.s | Chars 195-199 ~ 215-219 [Qed.] | 0m00.s || +0m00.00s | N/A coq-8.20.0/test-suite/precomputed-time-tests/per-file-fuzz/foo.v.after-timing.in000066400000000000000000000017621466560755400276070ustar00rootroot00000000000000Chars 0 - 30 [Require~Import~Coq.Lists.List.] 0.114 secs (0.083u,0.032s) Chars 31 - 64 [Require~Import~Coq.ZArith.ZArith.] 0.194 secs (0.172u,0.023s) Chars 65 - 75 [Goal~_~True.] 0. secs (0.u,0.s) Chars 78 - 86 [exact~I.] 0. secs (0.u,0.s) Chars 87 - 91 [Qed.] 0. secs (0.u,0.s) Chars 92 - 102 [Goal~_~True.] 0. secs (0.u,0.s) Chars 105 - 113 [exact~I.] 0. secs (0.u,0.s) Chars 114 - 118 [Qed.] 0. secs (0.u,0.s) Chars 119 - 129 [Goal~_~True.] 0. secs (0.u,0.s) Chars 132 - 140 [exact~I.] 0. secs (0.u,0.s) Chars 141 - 145 [Qed.] 0. secs (0.u,0.s) Chars 146 - 156 [Goal~_~True.] 0. secs (0.u,0.s) Chars 159 - 167 [exact~I.] 0. secs (0.u,0.s) Chars 168 - 172 [Qed.] 0. secs (0.u,0.s) Chars 173 - 183 [Goal~_~True.] 0. secs (0.u,0.s) Chars 186 - 194 [exact~I.] 0. secs (0.u,0.s) Chars 195 - 199 [Qed.] 0. secs (0.u,0.s) Chars 200 - 257 [Goal~_~List.repeat~Z.div_eucl~...] 0. secs (0.004u,0.s) Chars 260 - 284 [(vm_compute;~reflexivity).] 0.53 secs (0.504u,0.024s) Chars 285 - 289 [Qed.] 0.4 secs (0.384u,0.016s) coq-8.20.0/test-suite/precomputed-time-tests/per-file-fuzz/foo.v.before-timing.in000066400000000000000000000020071466560755400277410ustar00rootroot00000000000000Chars 0 - 30 [Require~Import~Coq.Lists.List.] 0.114 secs (0.072u,0.044s) Chars 31 - 64 [Require~Import~Coq.ZArith.ZArith.] 0.192 secs (0.156u,0.035s) Chars 65 - 75 [Goal~_~True.] 0. secs (0.u,0.s) Chars 78 - 90 [constructor.] 0. secs (0.u,0.s) Chars 91 - 95 [Qed.] 0. secs (0.u,0.s) Chars 96 - 106 [Goal~_~True.] 0. secs (0.u,0.s) Chars 109 - 121 [constructor.] 0. secs (0.u,0.s) Chars 122 - 126 [Qed.] 0. secs (0.u,0.s) Chars 127 - 137 [Goal~_~True.] 0. secs (0.u,0.s) Chars 140 - 152 [constructor.] 0. secs (0.u,0.004s) Chars 153 - 157 [Qed.] 0. secs (0.u,0.s) Chars 158 - 168 [Goal~_~True.] 0. secs (0.u,0.s) Chars 171 - 183 [constructor.] 0. secs (0.u,0.s) Chars 184 - 188 [Qed.] 0. secs (0.u,0.s) Chars 189 - 199 [Goal~_~True.] 0. secs (0.u,0.s) Chars 202 - 214 [constructor.] 0. secs (0.u,0.s) Chars 215 - 219 [Qed.] 0. secs (0.u,0.s) Chars 220 - 277 [Goal~_~List.repeat~Z.div_eucl~...] 0. secs (0.u,0.s) Chars 280 - 304 [(vm_compute;~reflexivity).] 0.566 secs (0.528u,0.039s) Chars 305 - 309 [Qed.] 0.411 secs (0.4u,0.008s) coq-8.20.0/test-suite/precomputed-time-tests/per-file-fuzz/foo_after.v000066400000000000000000000004421466560755400257700ustar00rootroot00000000000000Require Import Coq.Lists.List. Require Import Coq.ZArith.ZArith. Goal True. exact I. Qed. Goal True. exact I. Qed. Goal True. exact I. Qed. Goal True. exact I. Qed. Goal True. exact I. Qed. Goal List.repeat Z.div_eucl 5 = List.repeat Z.div_eucl 5. vm_compute; reflexivity. Qed. coq-8.20.0/test-suite/precomputed-time-tests/per-file-fuzz/foo_before.v000066400000000000000000000004661466560755400261370ustar00rootroot00000000000000Require Import Coq.Lists.List. Require Import Coq.ZArith.ZArith. Goal True. constructor. Qed. Goal True. constructor. Qed. Goal True. constructor. Qed. Goal True. constructor. Qed. Goal True. constructor. Qed. Goal List.repeat Z.div_eucl 5 = List.repeat Z.div_eucl 5. vm_compute; reflexivity. Qed. coq-8.20.0/test-suite/precomputed-time-tests/per-file-fuzz/run.sh000077500000000000000000000007371466560755400250070ustar00rootroot00000000000000#!/usr/bin/env bash . ../template/init.sh cd "$(dirname "${BASH_SOURCE[0]}")" $make_both_single_timing_files --fuzz=20 foo.v.after-timing.in foo.v.before-timing.in foo-real.v.timing.diff || exit $? diff -u foo-real.v.timing.diff.expected foo-real.v.timing.diff || exit $? $make_both_single_timing_files --fuzz=20 --user foo.v.after-timing.in foo.v.before-timing.in foo-user.v.timing.diff || exit $? diff -u foo-user.v.timing.diff.expected foo-user.v.timing.diff || exit $? coq-8.20.0/test-suite/precomputed-time-tests/single-file-sorting/000077500000000000000000000000001466560755400250175ustar00rootroot00000000000000coq-8.20.0/test-suite/precomputed-time-tests/single-file-sorting/run.sh000077500000000000000000000006221466560755400261620ustar00rootroot00000000000000#!/usr/bin/env bash . ../template/init.sh cd "$(dirname "${BASH_SOURCE[0]}")" $make_one_time_file time-of-build.log.in time-of-build-pretty-user.log diff -u time-of-build-pretty-user.log.expected time-of-build-pretty-user.log || exit $? $make_one_time_file time-of-build.log.in time-of-build-pretty-real.log diff -u time-of-build-pretty-real.log.expected time-of-build-pretty-real.log || exit $? time-of-build-pretty-real.log.expected000066400000000000000000000035201466560755400341460ustar00rootroot00000000000000coq-8.20.0/test-suite/precomputed-time-tests/single-file-sorting Time | Peak Mem | File Name ----------------------------------------------------------------------- 19m16.05s | 3302508 ko | Total Time / Peak Mem ----------------------------------------------------------------------- 4m01.34s | 1617000 ko | Specific/X25519/C64/ladderstep 3m09.62s | 3302508 ko | Specific/NISTP256/AMD64/femul 2m48.52s | 1589516 ko | Specific/solinas32_2e255m765_13limbs/femul 2m23.70s | 1454696 ko | Specific/solinas32_2e255m765_12limbs/femul 0m45.75s | 744240 ko | Specific/solinas32_2e255m765_13limbs/Synthesis 0m39.59s | 793376 ko | Specific/NISTP256/AMD64/fesub 0m36.92s | 728464 ko | Specific/solinas32_2e255m765_12limbs/Synthesis 0m36.32s | 825448 ko | Specific/X25519/C64/femul 0m35.40s | 799216 ko | Specific/NISTP256/AMD64/feadd 0m31.50s | 828104 ko | Specific/X25519/C64/freeze 0m30.13s | 799620 ko | Specific/X25519/C64/fesquare 0m28.51s | 765208 ko | Specific/NISTP256/AMD64/feopp 0m25.50s | 756080 ko | Specific/NISTP256/AMD64/fenz 0m24.99s | 786052 ko | Specific/X25519/C64/fecarry 0m22.65s | 778792 ko | Specific/X25519/C64/fesub 0m20.93s | 766300 ko | Specific/X25519/C64/feadd 0m12.55s | 668216 ko | Specific/NISTP256/AMD64/Synthesis 0m10.37s | 687760 ko | Specific/X25519/C64/Synthesis 0m07.18s | 574388 ko | Compilers/Z/Bounds/Pipeline/Definition 0m01.72s | 544172 ko | Compilers/Z/Bounds/Pipeline/ReflectiveTactics 0m01.67s | 646300 ko | Specific/Framework/SynthesisFramework 0m01.19s | 539808 ko | Compilers/Z/Bounds/Pipeline time-of-build-pretty-user.log.expected000066400000000000000000000035201466560755400342010ustar00rootroot00000000000000coq-8.20.0/test-suite/precomputed-time-tests/single-file-sorting Time | Peak Mem | File Name ----------------------------------------------------------------------- 19m16.05s | 3302508 ko | Total Time / Peak Mem ----------------------------------------------------------------------- 4m01.34s | 1617000 ko | Specific/X25519/C64/ladderstep 3m09.62s | 3302508 ko | Specific/NISTP256/AMD64/femul 2m48.52s | 1589516 ko | Specific/solinas32_2e255m765_13limbs/femul 2m23.70s | 1454696 ko | Specific/solinas32_2e255m765_12limbs/femul 0m45.75s | 744240 ko | Specific/solinas32_2e255m765_13limbs/Synthesis 0m39.59s | 793376 ko | Specific/NISTP256/AMD64/fesub 0m36.92s | 728464 ko | Specific/solinas32_2e255m765_12limbs/Synthesis 0m36.32s | 825448 ko | Specific/X25519/C64/femul 0m35.40s | 799216 ko | Specific/NISTP256/AMD64/feadd 0m31.50s | 828104 ko | Specific/X25519/C64/freeze 0m30.13s | 799620 ko | Specific/X25519/C64/fesquare 0m28.51s | 765208 ko | Specific/NISTP256/AMD64/feopp 0m25.50s | 756080 ko | Specific/NISTP256/AMD64/fenz 0m24.99s | 786052 ko | Specific/X25519/C64/fecarry 0m22.65s | 778792 ko | Specific/X25519/C64/fesub 0m20.93s | 766300 ko | Specific/X25519/C64/feadd 0m12.55s | 668216 ko | Specific/NISTP256/AMD64/Synthesis 0m10.37s | 687760 ko | Specific/X25519/C64/Synthesis 0m07.18s | 574388 ko | Compilers/Z/Bounds/Pipeline/Definition 0m01.72s | 544172 ko | Compilers/Z/Bounds/Pipeline/ReflectiveTactics 0m01.67s | 646300 ko | Specific/Framework/SynthesisFramework 0m01.19s | 539808 ko | Compilers/Z/Bounds/Pipeline coq-8.20.0/test-suite/precomputed-time-tests/single-file-sorting/time-of-build.log.in000066400000000000000000004047131466560755400305750ustar00rootroot00000000000000COQDEP src/Compilers/Z/Bounds/Pipeline/ReflectiveTactics.v COQDEP src/Compilers/Z/Bounds/Pipeline/Definition.v /home/jgross/.local64/coq/coq-master/bin/coq_makefile -f _CoqProject INSTALLDEFAULTROOT = Crypto -o Makefile-old COQ_MAKEFILE -f _CoqProject > Makefile.coq make --no-print-directory -C coqprime make[1]: Nothing to be done for 'all'. ECHO > _CoqProject COQC src/Compilers/Z/Bounds/Pipeline/Definition.v src/Compilers/Z/Bounds/Pipeline/Definition (real: 7.33, user: 7.18, sys: 0.14, mem: 574388 ko) COQC src/Compilers/Z/Bounds/Pipeline/ReflectiveTactics.v src/Compilers/Z/Bounds/Pipeline/ReflectiveTactics (real: 1.93, user: 1.72, sys: 0.20, mem: 544172 ko) COQC src/Compilers/Z/Bounds/Pipeline.v src/Compilers/Z/Bounds/Pipeline (real: 1.38, user: 1.19, sys: 0.16, mem: 539808 ko) COQC src/Specific/Framework/SynthesisFramework.v src/Specific/Framework/SynthesisFramework (real: 1.85, user: 1.67, sys: 0.17, mem: 646300 ko) COQC src/Specific/X25519/C64/Synthesis.v src/Specific/X25519/C64/Synthesis (real: 11.15, user: 10.37, sys: 0.18, mem: 687760 ko) COQC src/Specific/NISTP256/AMD64/Synthesis.v src/Specific/NISTP256/AMD64/Synthesis (real: 13.45, user: 12.55, sys: 0.19, mem: 668216 ko) COQC src/Specific/X25519/C64/feadd.v Finished transaction in 2.814 secs (2.624u,0.s) (successful) total time: 2.576s tactic local total calls max ────────────────────────────────────────┴──────┴──────┴───────┴─────────┘ ─Pipeline.refine_reflectively_gen ------ 0.2% 97.4% 1 2.508s ─ReflectiveTactics.do_reflective_pipelin 0.0% 66.9% 1 1.724s ─ReflectiveTactics.solve_side_conditions 0.0% 65.5% 1 1.688s ─ReflectiveTactics.solve_post_reified_si 1.2% 37.0% 1 0.952s ─Glue.refine_to_reflective_glue' ------- 0.0% 30.3% 1 0.780s ─ReflectiveTactics.do_reify ------------ 0.0% 28.6% 1 0.736s ─Reify.Reify_rhs_gen ------------------- 2.2% 26.6% 1 0.684s ─UnifyAbstractReflexivity.unify_transfor 20.3% 24.1% 7 0.164s ─Glue.zrange_to_reflective ------------- 0.0% 20.3% 1 0.524s ─Glue.zrange_to_reflective_goal -------- 9.5% 15.2% 1 0.392s ─Reify.do_reify_abs_goal --------------- 13.7% 13.8% 2 0.356s ─Reify.do_reifyf_goal ------------------ 12.4% 12.6% 16 0.324s ─ReflectiveTactics.unify_abstract_cbv_in 8.4% 11.2% 1 0.288s ─unify (constr) (constr) --------------- 5.7% 5.7% 6 0.072s ─Glue.pattern_sig_sig_assoc ------------ 0.0% 5.4% 1 0.140s ─assert (H : is_bounded_by' bounds (map' 4.8% 5.1% 2 0.072s ─Glue.pattern_proj1_sig_in_sig --------- 1.7% 5.1% 1 0.132s ─pose proof (pf : Interpretation.Bo 3.7% 3.7% 1 0.096s ─Glue.split_BoundedWordToZ ------------- 0.3% 3.7% 1 0.096s ─destruct_sig -------------------------- 0.2% 3.3% 4 0.044s ─destruct x ---------------------------- 3.1% 3.1% 4 0.036s ─eexact -------------------------------- 3.0% 3.0% 18 0.008s ─clearbody (ne_var_list) --------------- 3.0% 3.0% 4 0.060s ─prove_interp_compile_correct ---------- 0.0% 2.8% 1 0.072s ─synthesize ---------------------------- 0.0% 2.6% 1 0.068s ─rewrite ?EtaInterp.InterpExprEta ------ 2.5% 2.5% 1 0.064s ─ClearbodyAll.clearbody_all ------------ 0.0% 2.3% 2 0.060s ─rewrite H ----------------------------- 2.2% 2.2% 1 0.056s ─reflexivity --------------------------- 2.2% 2.2% 7 0.032s ─Reify.transitivity_tt ----------------- 0.0% 2.2% 2 0.032s ─transitivity -------------------------- 2.0% 2.0% 5 0.024s tactic local total calls max ────────────────────────────────────────┴──────┴──────┴───────┴─────────┘ ─Pipeline.refine_reflectively_gen ------ 0.2% 97.4% 1 2.508s ├─ReflectiveTactics.do_reflective_pipel 0.0% 66.9% 1 1.724s │└ReflectiveTactics.solve_side_conditio 0.0% 65.5% 1 1.688s │ ├─ReflectiveTactics.solve_post_reifie 1.2% 37.0% 1 0.952s │ │ ├─UnifyAbstractReflexivity.unify_tr 20.3% 24.1% 7 0.164s │ │ │└unify (constr) (constr) --------- 3.0% 3.0% 5 0.028s │ │ └─ReflectiveTactics.unify_abstract_ 8.4% 11.2% 1 0.288s │ │ └unify (constr) (constr) --------- 2.8% 2.8% 1 0.072s │ └─ReflectiveTactics.do_reify -------- 0.0% 28.6% 1 0.736s │ └Reify.Reify_rhs_gen --------------- 2.2% 26.6% 1 0.684s │ ├─Reify.do_reify_abs_goal --------- 13.7% 13.8% 2 0.356s │ │└Reify.do_reifyf_goal ------------ 12.4% 12.6% 16 0.324s │ │└eexact -------------------------- 2.6% 2.6% 16 0.008s │ ├─prove_interp_compile_correct ---- 0.0% 2.8% 1 0.072s │ │└rewrite ?EtaInterp.InterpExprEta 2.5% 2.5% 1 0.064s │ ├─rewrite H ----------------------- 2.2% 2.2% 1 0.056s │ └─Reify.transitivity_tt ----------- 0.0% 2.2% 2 0.032s └─Glue.refine_to_reflective_glue' ----- 0.0% 30.3% 1 0.780s ├─Glue.zrange_to_reflective --------- 0.0% 20.3% 1 0.524s │ ├─Glue.zrange_to_reflective_goal -- 9.5% 15.2% 1 0.392s │ │└pose proof (pf : Interpretat 3.7% 3.7% 1 0.096s │ └─assert (H : is_bounded_by' bounds 4.8% 5.1% 2 0.072s ├─Glue.pattern_sig_sig_assoc -------- 0.0% 5.4% 1 0.140s │└Glue.pattern_proj1_sig_in_sig ----- 1.7% 5.1% 1 0.132s │└ClearbodyAll.clearbody_all -------- 0.0% 2.3% 2 0.060s │└clearbody (ne_var_list) ----------- 2.3% 2.3% 1 0.060s └─Glue.split_BoundedWordToZ --------- 0.3% 3.7% 1 0.096s └destruct_sig ---------------------- 0.2% 3.3% 4 0.044s └destruct x ------------------------ 2.5% 2.5% 2 0.036s ─synthesize ---------------------------- 0.0% 2.6% 1 0.068s Finished transaction in 5.021 secs (4.636u,0.s) (successful) Closed under the global context total time: 2.576s tactic local total calls max ────────────────────────────────────────┴──────┴──────┴───────┴─────────┘ ─Pipeline.refine_reflectively_gen ------ 0.2% 97.4% 1 2.508s ─ReflectiveTactics.do_reflective_pipelin 0.0% 66.9% 1 1.724s ─ReflectiveTactics.solve_side_conditions 0.0% 65.5% 1 1.688s ─ReflectiveTactics.solve_post_reified_si 1.2% 37.0% 1 0.952s ─Glue.refine_to_reflective_glue' ------- 0.0% 30.3% 1 0.780s ─ReflectiveTactics.do_reify ------------ 0.0% 28.6% 1 0.736s ─Reify.Reify_rhs_gen ------------------- 2.2% 26.6% 1 0.684s ─UnifyAbstractReflexivity.unify_transfor 20.3% 24.1% 7 0.164s ─Glue.zrange_to_reflective ------------- 0.0% 20.3% 1 0.524s ─Glue.zrange_to_reflective_goal -------- 9.5% 15.2% 1 0.392s ─Reify.do_reify_abs_goal --------------- 13.7% 13.8% 2 0.356s ─Reify.do_reifyf_goal ------------------ 12.4% 12.6% 16 0.324s ─ReflectiveTactics.unify_abstract_cbv_in 8.4% 11.2% 1 0.288s ─unify (constr) (constr) --------------- 5.7% 5.7% 6 0.072s ─Glue.pattern_sig_sig_assoc ------------ 0.0% 5.4% 1 0.140s ─assert (H : is_bounded_by' bounds (map' 4.8% 5.1% 2 0.072s ─Glue.pattern_proj1_sig_in_sig --------- 1.7% 5.1% 1 0.132s ─pose proof (pf : Interpretation.Bo 3.7% 3.7% 1 0.096s ─Glue.split_BoundedWordToZ ------------- 0.3% 3.7% 1 0.096s ─destruct_sig -------------------------- 0.2% 3.3% 4 0.044s ─destruct x ---------------------------- 3.1% 3.1% 4 0.036s ─eexact -------------------------------- 3.0% 3.0% 18 0.008s ─clearbody (ne_var_list) --------------- 3.0% 3.0% 4 0.060s ─prove_interp_compile_correct ---------- 0.0% 2.8% 1 0.072s ─synthesize ---------------------------- 0.0% 2.6% 1 0.068s ─rewrite ?EtaInterp.InterpExprEta ------ 2.5% 2.5% 1 0.064s ─ClearbodyAll.clearbody_all ------------ 0.0% 2.3% 2 0.060s ─rewrite H ----------------------------- 2.2% 2.2% 1 0.056s ─reflexivity --------------------------- 2.2% 2.2% 7 0.032s ─Reify.transitivity_tt ----------------- 0.0% 2.2% 2 0.032s ─transitivity -------------------------- 2.0% 2.0% 5 0.024s tactic local total calls max ────────────────────────────────────────┴──────┴──────┴───────┴─────────┘ ─Pipeline.refine_reflectively_gen ------ 0.2% 97.4% 1 2.508s ├─ReflectiveTactics.do_reflective_pipel 0.0% 66.9% 1 1.724s │└ReflectiveTactics.solve_side_conditio 0.0% 65.5% 1 1.688s │ ├─ReflectiveTactics.solve_post_reifie 1.2% 37.0% 1 0.952s │ │ ├─UnifyAbstractReflexivity.unify_tr 20.3% 24.1% 7 0.164s │ │ │└unify (constr) (constr) --------- 3.0% 3.0% 5 0.028s │ │ └─ReflectiveTactics.unify_abstract_ 8.4% 11.2% 1 0.288s │ │ └unify (constr) (constr) --------- 2.8% 2.8% 1 0.072s │ └─ReflectiveTactics.do_reify -------- 0.0% 28.6% 1 0.736s │ └Reify.Reify_rhs_gen --------------- 2.2% 26.6% 1 0.684s │ ├─Reify.do_reify_abs_goal --------- 13.7% 13.8% 2 0.356s │ │└Reify.do_reifyf_goal ------------ 12.4% 12.6% 16 0.324s │ │└eexact -------------------------- 2.6% 2.6% 16 0.008s │ ├─prove_interp_compile_correct ---- 0.0% 2.8% 1 0.072s │ │└rewrite ?EtaInterp.InterpExprEta 2.5% 2.5% 1 0.064s │ ├─rewrite H ----------------------- 2.2% 2.2% 1 0.056s │ └─Reify.transitivity_tt ----------- 0.0% 2.2% 2 0.032s └─Glue.refine_to_reflective_glue' ----- 0.0% 30.3% 1 0.780s ├─Glue.zrange_to_reflective --------- 0.0% 20.3% 1 0.524s │ ├─Glue.zrange_to_reflective_goal -- 9.5% 15.2% 1 0.392s │ │└pose proof (pf : Interpretat 3.7% 3.7% 1 0.096s │ └─assert (H : is_bounded_by' bounds 4.8% 5.1% 2 0.072s ├─Glue.pattern_sig_sig_assoc -------- 0.0% 5.4% 1 0.140s │└Glue.pattern_proj1_sig_in_sig ----- 1.7% 5.1% 1 0.132s │└ClearbodyAll.clearbody_all -------- 0.0% 2.3% 2 0.060s │└clearbody (ne_var_list) ----------- 2.3% 2.3% 1 0.060s └─Glue.split_BoundedWordToZ --------- 0.3% 3.7% 1 0.096s └destruct_sig ---------------------- 0.2% 3.3% 4 0.044s └destruct x ------------------------ 2.5% 2.5% 2 0.036s ─synthesize ---------------------------- 0.0% 2.6% 1 0.068s src/Specific/X25519/C64/feadd (real: 22.81, user: 20.93, sys: 0.25, mem: 766300 ko) COQC src/Specific/X25519/C64/fecarry.v Finished transaction in 4.343 secs (4.016u,0.004s) (successful) total time: 3.976s tactic local total calls max ────────────────────────────────────────┴──────┴──────┴───────┴─────────┘ ─Pipeline.refine_reflectively_gen ------ 0.0% 99.0% 1 3.936s ─ReflectiveTactics.do_reflective_pipelin 0.0% 87.9% 1 3.496s ─ReflectiveTactics.solve_side_conditions 0.0% 86.9% 1 3.456s ─ReflectiveTactics.do_reify ------------ 0.0% 56.9% 1 2.264s ─Reify.Reify_rhs_gen ------------------- 1.8% 56.2% 1 2.236s ─Reify.do_reify_abs_goal --------------- 36.1% 36.5% 2 1.452s ─Reify.do_reifyf_goal ------------------ 34.8% 35.1% 29 1.396s ─ReflectiveTactics.solve_post_reified_si 0.6% 30.0% 1 1.192s ─UnifyAbstractReflexivity.unify_transfor 17.7% 21.7% 7 0.240s ─Glue.refine_to_reflective_glue' ------- 0.0% 11.1% 1 0.440s ─eexact -------------------------------- 10.9% 10.9% 31 0.024s ─ReflectiveTactics.unify_abstract_cbv_in 5.2% 7.3% 1 0.292s ─Glue.zrange_to_reflective ------------- 0.0% 7.1% 1 0.284s ─prove_interp_compile_correct ---------- 0.0% 5.7% 1 0.228s ─Glue.zrange_to_reflective_goal -------- 4.3% 5.5% 1 0.220s ─unify (constr) (constr) --------------- 5.3% 5.3% 6 0.084s ─rewrite ?EtaInterp.InterpExprEta ------ 5.2% 5.2% 1 0.208s ─rewrite H ----------------------------- 3.5% 3.5% 1 0.140s ─tac ----------------------------------- 1.9% 2.6% 2 0.104s ─reflexivity --------------------------- 2.2% 2.2% 7 0.028s ─Reify.transitivity_tt ----------------- 0.0% 2.2% 2 0.056s ─transitivity -------------------------- 2.0% 2.0% 5 0.048s ─Glue.split_BoundedWordToZ ------------- 0.1% 2.0% 1 0.080s tactic local total calls max ────────────────────────────────────────┴──────┴──────┴───────┴─────────┘ ─Pipeline.refine_reflectively_gen ------ 0.0% 99.0% 1 3.936s ├─ReflectiveTactics.do_reflective_pipel 0.0% 87.9% 1 3.496s │└ReflectiveTactics.solve_side_conditio 0.0% 86.9% 1 3.456s │ ├─ReflectiveTactics.do_reify -------- 0.0% 56.9% 1 2.264s │ │└Reify.Reify_rhs_gen --------------- 1.8% 56.2% 1 2.236s │ │ ├─Reify.do_reify_abs_goal --------- 36.1% 36.5% 2 1.452s │ │ │└Reify.do_reifyf_goal ------------ 34.8% 35.1% 29 1.396s │ │ │└eexact -------------------------- 10.1% 10.1% 29 0.024s │ │ ├─prove_interp_compile_correct ---- 0.0% 5.7% 1 0.228s │ │ │└rewrite ?EtaInterp.InterpExprEta 5.2% 5.2% 1 0.208s │ │ ├─rewrite H ----------------------- 3.5% 3.5% 1 0.140s │ │ ├─tac ----------------------------- 1.9% 2.6% 1 0.104s │ │ └─Reify.transitivity_tt ----------- 0.0% 2.2% 2 0.056s │ │ └transitivity -------------------- 2.0% 2.0% 4 0.048s │ └─ReflectiveTactics.solve_post_reifie 0.6% 30.0% 1 1.192s │ ├─UnifyAbstractReflexivity.unify_tr 17.7% 21.7% 7 0.240s │ │└unify (constr) (constr) --------- 3.2% 3.2% 5 0.048s │ └─ReflectiveTactics.unify_abstract_ 5.2% 7.3% 1 0.292s │ └unify (constr) (constr) --------- 2.1% 2.1% 1 0.084s └─Glue.refine_to_reflective_glue' ----- 0.0% 11.1% 1 0.440s ├─Glue.zrange_to_reflective --------- 0.0% 7.1% 1 0.284s │└Glue.zrange_to_reflective_goal ---- 4.3% 5.5% 1 0.220s └─Glue.split_BoundedWordToZ --------- 0.1% 2.0% 1 0.080s Finished transaction in 7.078 secs (6.728u,0.s) (successful) Closed under the global context total time: 3.976s tactic local total calls max ────────────────────────────────────────┴──────┴──────┴───────┴─────────┘ ─Pipeline.refine_reflectively_gen ------ 0.0% 99.0% 1 3.936s ─ReflectiveTactics.do_reflective_pipelin 0.0% 87.9% 1 3.496s ─ReflectiveTactics.solve_side_conditions 0.0% 86.9% 1 3.456s ─ReflectiveTactics.do_reify ------------ 0.0% 56.9% 1 2.264s ─Reify.Reify_rhs_gen ------------------- 1.8% 56.2% 1 2.236s ─Reify.do_reify_abs_goal --------------- 36.1% 36.5% 2 1.452s ─Reify.do_reifyf_goal ------------------ 34.8% 35.1% 29 1.396s ─ReflectiveTactics.solve_post_reified_si 0.6% 30.0% 1 1.192s ─UnifyAbstractReflexivity.unify_transfor 17.7% 21.7% 7 0.240s ─Glue.refine_to_reflective_glue' ------- 0.0% 11.1% 1 0.440s ─eexact -------------------------------- 10.9% 10.9% 31 0.024s ─ReflectiveTactics.unify_abstract_cbv_in 5.2% 7.3% 1 0.292s ─Glue.zrange_to_reflective ------------- 0.0% 7.1% 1 0.284s ─prove_interp_compile_correct ---------- 0.0% 5.7% 1 0.228s ─Glue.zrange_to_reflective_goal -------- 4.3% 5.5% 1 0.220s ─unify (constr) (constr) --------------- 5.3% 5.3% 6 0.084s ─rewrite ?EtaInterp.InterpExprEta ------ 5.2% 5.2% 1 0.208s ─rewrite H ----------------------------- 3.5% 3.5% 1 0.140s ─tac ----------------------------------- 1.9% 2.6% 2 0.104s ─reflexivity --------------------------- 2.2% 2.2% 7 0.028s ─Reify.transitivity_tt ----------------- 0.0% 2.2% 2 0.056s ─transitivity -------------------------- 2.0% 2.0% 5 0.048s ─Glue.split_BoundedWordToZ ------------- 0.1% 2.0% 1 0.080s tactic local total calls max ────────────────────────────────────────┴──────┴──────┴───────┴─────────┘ ─Pipeline.refine_reflectively_gen ------ 0.0% 99.0% 1 3.936s ├─ReflectiveTactics.do_reflective_pipel 0.0% 87.9% 1 3.496s │└ReflectiveTactics.solve_side_conditio 0.0% 86.9% 1 3.456s │ ├─ReflectiveTactics.do_reify -------- 0.0% 56.9% 1 2.264s │ │└Reify.Reify_rhs_gen --------------- 1.8% 56.2% 1 2.236s │ │ ├─Reify.do_reify_abs_goal --------- 36.1% 36.5% 2 1.452s │ │ │└Reify.do_reifyf_goal ------------ 34.8% 35.1% 29 1.396s │ │ │└eexact -------------------------- 10.1% 10.1% 29 0.024s │ │ ├─prove_interp_compile_correct ---- 0.0% 5.7% 1 0.228s │ │ │└rewrite ?EtaInterp.InterpExprEta 5.2% 5.2% 1 0.208s │ │ ├─rewrite H ----------------------- 3.5% 3.5% 1 0.140s │ │ ├─tac ----------------------------- 1.9% 2.6% 1 0.104s │ │ └─Reify.transitivity_tt ----------- 0.0% 2.2% 2 0.056s │ │ └transitivity -------------------- 2.0% 2.0% 4 0.048s │ └─ReflectiveTactics.solve_post_reifie 0.6% 30.0% 1 1.192s │ ├─UnifyAbstractReflexivity.unify_tr 17.7% 21.7% 7 0.240s │ │└unify (constr) (constr) --------- 3.2% 3.2% 5 0.048s │ └─ReflectiveTactics.unify_abstract_ 5.2% 7.3% 1 0.292s │ └unify (constr) (constr) --------- 2.1% 2.1% 1 0.084s └─Glue.refine_to_reflective_glue' ----- 0.0% 11.1% 1 0.440s ├─Glue.zrange_to_reflective --------- 0.0% 7.1% 1 0.284s │└Glue.zrange_to_reflective_goal ---- 4.3% 5.5% 1 0.220s └─Glue.split_BoundedWordToZ --------- 0.1% 2.0% 1 0.080s src/Specific/X25519/C64/fecarry (real: 27.11, user: 24.99, sys: 0.21, mem: 786052 ko) COQC src/Specific/solinas32_2e255m765_12limbs/Synthesis.v src/Specific/solinas32_2e255m765_12limbs/Synthesis (real: 40.13, user: 36.92, sys: 0.26, mem: 728464 ko) COQC src/Specific/solinas32_2e255m765_13limbs/Synthesis.v src/Specific/solinas32_2e255m765_13limbs/Synthesis (real: 49.44, user: 45.75, sys: 0.18, mem: 744240 ko) COQC src/Specific/X25519/C64/femul.v Finished transaction in 8.415 secs (7.664u,0.015s) (successful) total time: 7.616s tactic local total calls max ────────────────────────────────────────┴──────┴──────┴───────┴─────────┘ ─Pipeline.refine_reflectively_gen ------ 0.0% 94.8% 1 7.220s ─ReflectiveTactics.do_reflective_pipelin 0.0% 85.0% 1 6.476s ─ReflectiveTactics.solve_side_conditions 0.0% 84.2% 1 6.416s ─ReflectiveTactics.do_reify ------------ 0.0% 50.3% 1 3.832s ─Reify.Reify_rhs_gen ------------------- 1.8% 49.4% 1 3.760s ─ReflectiveTactics.solve_post_reified_si 0.5% 33.9% 1 2.584s ─Reify.do_reify_abs_goal --------------- 31.1% 31.4% 2 2.392s ─Reify.do_reifyf_goal ------------------ 30.0% 30.3% 58 1.528s ─UnifyAbstractReflexivity.unify_transfor 22.1% 27.3% 7 0.600s ─Glue.refine_to_reflective_glue' ------- 0.0% 9.8% 1 0.744s ─eexact -------------------------------- 8.2% 8.2% 60 0.024s ─Glue.zrange_to_reflective ------------- 0.1% 6.8% 1 0.516s ─unify (constr) (constr) --------------- 5.9% 5.9% 6 0.124s ─prove_interp_compile_correct ---------- 0.0% 5.8% 1 0.444s ─ReflectiveTactics.unify_abstract_cbv_in 3.9% 5.7% 1 0.432s ─rewrite ?EtaInterp.InterpExprEta ------ 5.4% 5.4% 1 0.408s ─synthesize ---------------------------- 0.0% 5.2% 1 0.396s ─Glue.zrange_to_reflective_goal -------- 3.0% 5.0% 1 0.384s ─IntegrationTestTemporaryMiscCommon.do_r 0.1% 4.8% 1 0.364s ─change G' ----------------------------- 3.9% 3.9% 1 0.300s ─rewrite H ----------------------------- 3.0% 3.0% 1 0.232s ─tac ----------------------------------- 1.5% 2.3% 2 0.176s ─Reify.transitivity_tt ----------------- 0.0% 2.1% 2 0.092s ─reflexivity --------------------------- 2.0% 2.0% 7 0.052s tactic local total calls max ────────────────────────────────────────┴──────┴──────┴───────┴─────────┘ ─Pipeline.refine_reflectively_gen ------ 0.0% 94.8% 1 7.220s ├─ReflectiveTactics.do_reflective_pipel 0.0% 85.0% 1 6.476s │└ReflectiveTactics.solve_side_conditio 0.0% 84.2% 1 6.416s │ ├─ReflectiveTactics.do_reify -------- 0.0% 50.3% 1 3.832s │ │└Reify.Reify_rhs_gen --------------- 1.8% 49.4% 1 3.760s │ │ ├─Reify.do_reify_abs_goal --------- 31.1% 31.4% 2 2.392s │ │ │└Reify.do_reifyf_goal ------------ 30.0% 30.3% 58 1.528s │ │ │└eexact -------------------------- 7.6% 7.6% 58 0.020s │ │ ├─prove_interp_compile_correct ---- 0.0% 5.8% 1 0.444s │ │ │└rewrite ?EtaInterp.InterpExprEta 5.4% 5.4% 1 0.408s │ │ ├─rewrite H ----------------------- 3.0% 3.0% 1 0.232s │ │ ├─tac ----------------------------- 1.5% 2.3% 1 0.176s │ │ └─Reify.transitivity_tt ----------- 0.0% 2.1% 2 0.092s │ └─ReflectiveTactics.solve_post_reifie 0.5% 33.9% 1 2.584s │ ├─UnifyAbstractReflexivity.unify_tr 22.1% 27.3% 7 0.600s │ │└unify (constr) (constr) --------- 4.3% 4.3% 5 0.096s │ └─ReflectiveTactics.unify_abstract_ 3.9% 5.7% 1 0.432s └─Glue.refine_to_reflective_glue' ----- 0.0% 9.8% 1 0.744s └Glue.zrange_to_reflective ----------- 0.1% 6.8% 1 0.516s └Glue.zrange_to_reflective_goal ------ 3.0% 5.0% 1 0.384s ─synthesize ---------------------------- 0.0% 5.2% 1 0.396s └IntegrationTestTemporaryMiscCommon.do_r 0.1% 4.8% 1 0.364s └change G' ----------------------------- 3.9% 3.9% 1 0.300s Finished transaction in 14.616 secs (13.528u,0.008s) (successful) Closed under the global context total time: 7.616s tactic local total calls max ────────────────────────────────────────┴──────┴──────┴───────┴─────────┘ ─Pipeline.refine_reflectively_gen ------ 0.0% 94.8% 1 7.220s ─ReflectiveTactics.do_reflective_pipelin 0.0% 85.0% 1 6.476s ─ReflectiveTactics.solve_side_conditions 0.0% 84.2% 1 6.416s ─ReflectiveTactics.do_reify ------------ 0.0% 50.3% 1 3.832s ─Reify.Reify_rhs_gen ------------------- 1.8% 49.4% 1 3.760s ─ReflectiveTactics.solve_post_reified_si 0.5% 33.9% 1 2.584s ─Reify.do_reify_abs_goal --------------- 31.1% 31.4% 2 2.392s ─Reify.do_reifyf_goal ------------------ 30.0% 30.3% 58 1.528s ─UnifyAbstractReflexivity.unify_transfor 22.1% 27.3% 7 0.600s ─Glue.refine_to_reflective_glue' ------- 0.0% 9.8% 1 0.744s ─eexact -------------------------------- 8.2% 8.2% 60 0.024s ─Glue.zrange_to_reflective ------------- 0.1% 6.8% 1 0.516s ─unify (constr) (constr) --------------- 5.9% 5.9% 6 0.124s ─prove_interp_compile_correct ---------- 0.0% 5.8% 1 0.444s ─ReflectiveTactics.unify_abstract_cbv_in 3.9% 5.7% 1 0.432s ─rewrite ?EtaInterp.InterpExprEta ------ 5.4% 5.4% 1 0.408s ─synthesize ---------------------------- 0.0% 5.2% 1 0.396s ─Glue.zrange_to_reflective_goal -------- 3.0% 5.0% 1 0.384s ─IntegrationTestTemporaryMiscCommon.do_r 0.1% 4.8% 1 0.364s ─change G' ----------------------------- 3.9% 3.9% 1 0.300s ─rewrite H ----------------------------- 3.0% 3.0% 1 0.232s ─tac ----------------------------------- 1.5% 2.3% 2 0.176s ─Reify.transitivity_tt ----------------- 0.0% 2.1% 2 0.092s ─reflexivity --------------------------- 2.0% 2.0% 7 0.052s tactic local total calls max ────────────────────────────────────────┴──────┴──────┴───────┴─────────┘ ─Pipeline.refine_reflectively_gen ------ 0.0% 94.8% 1 7.220s ├─ReflectiveTactics.do_reflective_pipel 0.0% 85.0% 1 6.476s │└ReflectiveTactics.solve_side_conditio 0.0% 84.2% 1 6.416s │ ├─ReflectiveTactics.do_reify -------- 0.0% 50.3% 1 3.832s │ │└Reify.Reify_rhs_gen --------------- 1.8% 49.4% 1 3.760s │ │ ├─Reify.do_reify_abs_goal --------- 31.1% 31.4% 2 2.392s │ │ │└Reify.do_reifyf_goal ------------ 30.0% 30.3% 58 1.528s │ │ │└eexact -------------------------- 7.6% 7.6% 58 0.020s │ │ ├─prove_interp_compile_correct ---- 0.0% 5.8% 1 0.444s │ │ │└rewrite ?EtaInterp.InterpExprEta 5.4% 5.4% 1 0.408s │ │ ├─rewrite H ----------------------- 3.0% 3.0% 1 0.232s │ │ ├─tac ----------------------------- 1.5% 2.3% 1 0.176s │ │ └─Reify.transitivity_tt ----------- 0.0% 2.1% 2 0.092s │ └─ReflectiveTactics.solve_post_reifie 0.5% 33.9% 1 2.584s │ ├─UnifyAbstractReflexivity.unify_tr 22.1% 27.3% 7 0.600s │ │└unify (constr) (constr) --------- 4.3% 4.3% 5 0.096s │ └─ReflectiveTactics.unify_abstract_ 3.9% 5.7% 1 0.432s └─Glue.refine_to_reflective_glue' ----- 0.0% 9.8% 1 0.744s └Glue.zrange_to_reflective ----------- 0.1% 6.8% 1 0.516s └Glue.zrange_to_reflective_goal ------ 3.0% 5.0% 1 0.384s ─synthesize ---------------------------- 0.0% 5.2% 1 0.396s └IntegrationTestTemporaryMiscCommon.do_r 0.1% 4.8% 1 0.364s └change G' ----------------------------- 3.9% 3.9% 1 0.300s src/Specific/X25519/C64/femul (real: 39.72, user: 36.32, sys: 0.26, mem: 825448 ko) COQC src/Specific/X25519/C64/feaddDisplay > src/Specific/X25519/C64/feaddDisplay.log COQC src/Specific/X25519/C64/fecarryDisplay > src/Specific/X25519/C64/fecarryDisplay.log COQC src/Specific/X25519/C64/fesub.v Finished transaction in 3.513 secs (3.211u,0.s) (successful) total time: 3.164s tactic local total calls max ────────────────────────────────────────┴──────┴──────┴───────┴─────────┘ ─Pipeline.refine_reflectively_gen ------ 0.0% 97.6% 1 3.088s ─ReflectiveTactics.do_reflective_pipelin 0.0% 74.1% 1 2.344s ─ReflectiveTactics.solve_side_conditions 0.0% 72.9% 1 2.308s ─ReflectiveTactics.do_reify ------------ 0.0% 38.6% 1 1.220s ─Reify.Reify_rhs_gen ------------------- 1.5% 37.2% 1 1.176s ─ReflectiveTactics.solve_post_reified_si 0.9% 34.4% 1 1.088s ─UnifyAbstractReflexivity.unify_transfor 19.2% 23.9% 7 0.204s ─Glue.refine_to_reflective_glue' ------- 0.0% 23.5% 1 0.744s ─Reify.do_reify_abs_goal --------------- 19.2% 19.5% 2 0.616s ─Reify.do_reifyf_goal ------------------ 18.0% 18.3% 16 0.580s ─Glue.zrange_to_reflective ------------- 0.1% 15.4% 1 0.488s ─Glue.zrange_to_reflective_goal -------- 6.8% 11.5% 1 0.364s ─ReflectiveTactics.unify_abstract_cbv_in 6.2% 9.0% 1 0.284s ─unify (constr) (constr) --------------- 5.9% 5.9% 6 0.080s ─Glue.pattern_sig_sig_assoc ------------ 0.0% 4.6% 1 0.144s ─eexact -------------------------------- 4.4% 4.4% 18 0.012s ─Glue.pattern_proj1_sig_in_sig --------- 1.4% 4.3% 1 0.136s ─prove_interp_compile_correct ---------- 0.0% 3.9% 1 0.124s ─rewrite H ----------------------------- 3.8% 3.8% 1 0.120s ─assert (H : is_bounded_by' bounds (map' 3.8% 3.8% 2 0.064s ─rewrite ?EtaInterp.InterpExprEta ------ 3.5% 3.5% 1 0.112s ─pose proof (pf : Interpretation.Bo 2.9% 2.9% 1 0.092s ─Glue.split_BoundedWordToZ ------------- 0.1% 2.8% 1 0.088s ─tac ----------------------------------- 1.9% 2.5% 2 0.080s ─reflexivity --------------------------- 2.4% 2.4% 7 0.028s ─synthesize ---------------------------- 0.0% 2.4% 1 0.076s ─destruct_sig -------------------------- 0.0% 2.4% 4 0.040s ─destruct x ---------------------------- 2.4% 2.4% 4 0.032s ─clearbody (ne_var_list) --------------- 2.3% 2.3% 4 0.060s ─Reify.transitivity_tt ----------------- 0.1% 2.3% 2 0.036s ─transitivity -------------------------- 2.1% 2.1% 5 0.032s tactic local total calls max ────────────────────────────────────────┴──────┴──────┴───────┴─────────┘ ─Pipeline.refine_reflectively_gen ------ 0.0% 97.6% 1 3.088s ├─ReflectiveTactics.do_reflective_pipel 0.0% 74.1% 1 2.344s │└ReflectiveTactics.solve_side_conditio 0.0% 72.9% 1 2.308s │ ├─ReflectiveTactics.do_reify -------- 0.0% 38.6% 1 1.220s │ │└Reify.Reify_rhs_gen --------------- 1.5% 37.2% 1 1.176s │ │ ├─Reify.do_reify_abs_goal --------- 19.2% 19.5% 2 0.616s │ │ │└Reify.do_reifyf_goal ------------ 18.0% 18.3% 16 0.580s │ │ │└eexact -------------------------- 3.9% 3.9% 16 0.012s │ │ ├─prove_interp_compile_correct ---- 0.0% 3.9% 1 0.124s │ │ │└rewrite ?EtaInterp.InterpExprEta 3.5% 3.5% 1 0.112s │ │ ├─rewrite H ----------------------- 3.8% 3.8% 1 0.120s │ │ ├─tac ----------------------------- 1.9% 2.5% 1 0.080s │ │ └─Reify.transitivity_tt ----------- 0.1% 2.3% 2 0.036s │ │ └transitivity -------------------- 2.0% 2.0% 4 0.032s │ └─ReflectiveTactics.solve_post_reifie 0.9% 34.4% 1 1.088s │ ├─UnifyAbstractReflexivity.unify_tr 19.2% 23.9% 7 0.204s │ │└unify (constr) (constr) --------- 3.4% 3.4% 5 0.036s │ └─ReflectiveTactics.unify_abstract_ 6.2% 9.0% 1 0.284s │ └unify (constr) (constr) --------- 2.5% 2.5% 1 0.080s └─Glue.refine_to_reflective_glue' ----- 0.0% 23.5% 1 0.744s ├─Glue.zrange_to_reflective --------- 0.1% 15.4% 1 0.488s │ ├─Glue.zrange_to_reflective_goal -- 6.8% 11.5% 1 0.364s │ │└pose proof (pf : Interpretat 2.9% 2.9% 1 0.092s │ └─assert (H : is_bounded_by' bounds 3.8% 3.8% 2 0.064s ├─Glue.pattern_sig_sig_assoc -------- 0.0% 4.6% 1 0.144s │└Glue.pattern_proj1_sig_in_sig ----- 1.4% 4.3% 1 0.136s └─Glue.split_BoundedWordToZ --------- 0.1% 2.8% 1 0.088s └destruct_sig ---------------------- 0.0% 2.4% 4 0.040s ─synthesize ---------------------------- 0.0% 2.4% 1 0.076s Finished transaction in 6.12 secs (5.64u,0.008s) (successful) Closed under the global context total time: 3.164s tactic local total calls max ────────────────────────────────────────┴──────┴──────┴───────┴─────────┘ ─Pipeline.refine_reflectively_gen ------ 0.0% 97.6% 1 3.088s ─ReflectiveTactics.do_reflective_pipelin 0.0% 74.1% 1 2.344s ─ReflectiveTactics.solve_side_conditions 0.0% 72.9% 1 2.308s ─ReflectiveTactics.do_reify ------------ 0.0% 38.6% 1 1.220s ─Reify.Reify_rhs_gen ------------------- 1.5% 37.2% 1 1.176s ─ReflectiveTactics.solve_post_reified_si 0.9% 34.4% 1 1.088s ─UnifyAbstractReflexivity.unify_transfor 19.2% 23.9% 7 0.204s ─Glue.refine_to_reflective_glue' ------- 0.0% 23.5% 1 0.744s ─Reify.do_reify_abs_goal --------------- 19.2% 19.5% 2 0.616s ─Reify.do_reifyf_goal ------------------ 18.0% 18.3% 16 0.580s ─Glue.zrange_to_reflective ------------- 0.1% 15.4% 1 0.488s ─Glue.zrange_to_reflective_goal -------- 6.8% 11.5% 1 0.364s ─ReflectiveTactics.unify_abstract_cbv_in 6.2% 9.0% 1 0.284s ─unify (constr) (constr) --------------- 5.9% 5.9% 6 0.080s ─Glue.pattern_sig_sig_assoc ------------ 0.0% 4.6% 1 0.144s ─eexact -------------------------------- 4.4% 4.4% 18 0.012s ─Glue.pattern_proj1_sig_in_sig --------- 1.4% 4.3% 1 0.136s ─prove_interp_compile_correct ---------- 0.0% 3.9% 1 0.124s ─rewrite H ----------------------------- 3.8% 3.8% 1 0.120s ─assert (H : is_bounded_by' bounds (map' 3.8% 3.8% 2 0.064s ─rewrite ?EtaInterp.InterpExprEta ------ 3.5% 3.5% 1 0.112s ─pose proof (pf : Interpretation.Bo 2.9% 2.9% 1 0.092s ─Glue.split_BoundedWordToZ ------------- 0.1% 2.8% 1 0.088s ─tac ----------------------------------- 1.9% 2.5% 2 0.080s ─reflexivity --------------------------- 2.4% 2.4% 7 0.028s ─synthesize ---------------------------- 0.0% 2.4% 1 0.076s ─destruct_sig -------------------------- 0.0% 2.4% 4 0.040s ─destruct x ---------------------------- 2.4% 2.4% 4 0.032s ─clearbody (ne_var_list) --------------- 2.3% 2.3% 4 0.060s ─Reify.transitivity_tt ----------------- 0.1% 2.3% 2 0.036s ─transitivity -------------------------- 2.1% 2.1% 5 0.032s tactic local total calls max ────────────────────────────────────────┴──────┴──────┴───────┴─────────┘ ─Pipeline.refine_reflectively_gen ------ 0.0% 97.6% 1 3.088s ├─ReflectiveTactics.do_reflective_pipel 0.0% 74.1% 1 2.344s │└ReflectiveTactics.solve_side_conditio 0.0% 72.9% 1 2.308s │ ├─ReflectiveTactics.do_reify -------- 0.0% 38.6% 1 1.220s │ │└Reify.Reify_rhs_gen --------------- 1.5% 37.2% 1 1.176s │ │ ├─Reify.do_reify_abs_goal --------- 19.2% 19.5% 2 0.616s │ │ │└Reify.do_reifyf_goal ------------ 18.0% 18.3% 16 0.580s │ │ │└eexact -------------------------- 3.9% 3.9% 16 0.012s │ │ ├─prove_interp_compile_correct ---- 0.0% 3.9% 1 0.124s │ │ │└rewrite ?EtaInterp.InterpExprEta 3.5% 3.5% 1 0.112s │ │ ├─rewrite H ----------------------- 3.8% 3.8% 1 0.120s │ │ ├─tac ----------------------------- 1.9% 2.5% 1 0.080s │ │ └─Reify.transitivity_tt ----------- 0.1% 2.3% 2 0.036s │ │ └transitivity -------------------- 2.0% 2.0% 4 0.032s │ └─ReflectiveTactics.solve_post_reifie 0.9% 34.4% 1 1.088s │ ├─UnifyAbstractReflexivity.unify_tr 19.2% 23.9% 7 0.204s │ │└unify (constr) (constr) --------- 3.4% 3.4% 5 0.036s │ └─ReflectiveTactics.unify_abstract_ 6.2% 9.0% 1 0.284s │ └unify (constr) (constr) --------- 2.5% 2.5% 1 0.080s └─Glue.refine_to_reflective_glue' ----- 0.0% 23.5% 1 0.744s ├─Glue.zrange_to_reflective --------- 0.1% 15.4% 1 0.488s │ ├─Glue.zrange_to_reflective_goal -- 6.8% 11.5% 1 0.364s │ │└pose proof (pf : Interpretat 2.9% 2.9% 1 0.092s │ └─assert (H : is_bounded_by' bounds 3.8% 3.8% 2 0.064s ├─Glue.pattern_sig_sig_assoc -------- 0.0% 4.6% 1 0.144s │└Glue.pattern_proj1_sig_in_sig ----- 1.4% 4.3% 1 0.136s └─Glue.split_BoundedWordToZ --------- 0.1% 2.8% 1 0.088s └destruct_sig ---------------------- 0.0% 2.4% 4 0.040s ─synthesize ---------------------------- 0.0% 2.4% 1 0.076s src/Specific/X25519/C64/fesub (real: 24.71, user: 22.65, sys: 0.24, mem: 778792 ko) COQC src/Specific/X25519/C64/fesquare.v Finished transaction in 6.132 secs (5.516u,0.012s) (successful) total time: 5.480s tactic local total calls max ────────────────────────────────────────┴──────┴──────┴───────┴─────────┘ ─synthesize ---------------------------- -0.0% 100.0% 1 5.480s ─Pipeline.refine_reflectively_gen ------ 0.0% 95.7% 1 5.244s ─ReflectiveTactics.do_reflective_pipelin 0.0% 88.6% 1 4.856s ─ReflectiveTactics.solve_side_conditions 0.0% 87.7% 1 4.804s ─ReflectiveTactics.do_reify ------------ 0.0% 53.3% 1 2.920s ─Reify.Reify_rhs_gen ------------------- 2.0% 52.5% 1 2.876s ─ReflectiveTactics.solve_post_reified_si 0.6% 34.4% 1 1.884s ─Reify.do_reify_abs_goal --------------- 33.2% 33.6% 2 1.844s ─Reify.do_reifyf_goal ------------------ 31.5% 32.0% 47 1.392s ─UnifyAbstractReflexivity.unify_transfor 21.9% 26.6% 7 0.400s ─eexact -------------------------------- 10.0% 10.0% 49 0.028s ─Glue.refine_to_reflective_glue' ------- 0.0% 7.1% 1 0.388s ─ReflectiveTactics.unify_abstract_cbv_in 5.0% 6.9% 1 0.380s ─unify (constr) (constr) --------------- 5.8% 5.8% 6 0.104s ─prove_interp_compile_correct ---------- 0.0% 5.8% 1 0.316s ─rewrite ?EtaInterp.InterpExprEta ------ 5.3% 5.3% 1 0.288s ─Glue.zrange_to_reflective ------------- 0.1% 5.1% 1 0.280s ─IntegrationTestTemporaryMiscCommon.do_r 0.1% 4.0% 1 0.220s ─Glue.zrange_to_reflective_goal -------- 3.1% 3.9% 1 0.212s ─change G' ----------------------------- 3.4% 3.4% 1 0.184s ─tac ----------------------------------- 2.0% 2.8% 2 0.156s ─rewrite H ----------------------------- 2.8% 2.8% 1 0.156s ─reflexivity --------------------------- 2.8% 2.8% 7 0.064s tactic local total calls max ────────────────────────────────────────┴──────┴──────┴───────┴─────────┘ ─synthesize ---------------------------- -0.0% 100.0% 1 5.480s ├─Pipeline.refine_reflectively_gen ---- 0.0% 95.7% 1 5.244s │ ├─ReflectiveTactics.do_reflective_pip 0.0% 88.6% 1 4.856s │ │└ReflectiveTactics.solve_side_condit 0.0% 87.7% 1 4.804s │ │ ├─ReflectiveTactics.do_reify ------ 0.0% 53.3% 1 2.920s │ │ │└Reify.Reify_rhs_gen ------------- 2.0% 52.5% 1 2.876s │ │ │ ├─Reify.do_reify_abs_goal ------- 33.2% 33.6% 2 1.844s │ │ │ │└Reify.do_reifyf_goal ---------- 31.5% 32.0% 47 1.392s │ │ │ │└eexact ------------------------ 9.1% 9.1% 47 0.024s │ │ │ ├─prove_interp_compile_correct -- 0.0% 5.8% 1 0.316s │ │ │ │└rewrite ?EtaInterp.InterpExprEt 5.3% 5.3% 1 0.288s │ │ │ ├─tac --------------------------- 2.0% 2.8% 1 0.156s │ │ │ └─rewrite H --------------------- 2.8% 2.8% 1 0.156s │ │ └─ReflectiveTactics.solve_post_reif 0.6% 34.4% 1 1.884s │ │ ├─UnifyAbstractReflexivity.unify_ 21.9% 26.6% 7 0.400s │ │ │└unify (constr) (constr) ------- 3.9% 3.9% 5 0.072s │ │ └─ReflectiveTactics.unify_abstrac 5.0% 6.9% 1 0.380s │ └─Glue.refine_to_reflective_glue' --- 0.0% 7.1% 1 0.388s │ └Glue.zrange_to_reflective --------- 0.1% 5.1% 1 0.280s │ └Glue.zrange_to_reflective_goal ---- 3.1% 3.9% 1 0.212s └─IntegrationTestTemporaryMiscCommon.do 0.1% 4.0% 1 0.220s └change G' --------------------------- 3.4% 3.4% 1 0.184s Finished transaction in 10.475 secs (9.728u,0.007s) (successful) Closed under the global context total time: 5.480s tactic local total calls max ────────────────────────────────────────┴──────┴──────┴───────┴─────────┘ ─synthesize ---------------------------- -0.0% 100.0% 1 5.480s ─Pipeline.refine_reflectively_gen ------ 0.0% 95.7% 1 5.244s ─ReflectiveTactics.do_reflective_pipelin 0.0% 88.6% 1 4.856s ─ReflectiveTactics.solve_side_conditions 0.0% 87.7% 1 4.804s ─ReflectiveTactics.do_reify ------------ 0.0% 53.3% 1 2.920s ─Reify.Reify_rhs_gen ------------------- 2.0% 52.5% 1 2.876s ─ReflectiveTactics.solve_post_reified_si 0.6% 34.4% 1 1.884s ─Reify.do_reify_abs_goal --------------- 33.2% 33.6% 2 1.844s ─Reify.do_reifyf_goal ------------------ 31.5% 32.0% 47 1.392s ─UnifyAbstractReflexivity.unify_transfor 21.9% 26.6% 7 0.400s ─eexact -------------------------------- 10.0% 10.0% 49 0.028s ─Glue.refine_to_reflective_glue' ------- 0.0% 7.1% 1 0.388s ─ReflectiveTactics.unify_abstract_cbv_in 5.0% 6.9% 1 0.380s ─unify (constr) (constr) --------------- 5.8% 5.8% 6 0.104s ─prove_interp_compile_correct ---------- 0.0% 5.8% 1 0.316s ─rewrite ?EtaInterp.InterpExprEta ------ 5.3% 5.3% 1 0.288s ─Glue.zrange_to_reflective ------------- 0.1% 5.1% 1 0.280s ─IntegrationTestTemporaryMiscCommon.do_r 0.1% 4.0% 1 0.220s ─Glue.zrange_to_reflective_goal -------- 3.1% 3.9% 1 0.212s ─change G' ----------------------------- 3.4% 3.4% 1 0.184s ─tac ----------------------------------- 2.0% 2.8% 2 0.156s ─rewrite H ----------------------------- 2.8% 2.8% 1 0.156s ─reflexivity --------------------------- 2.8% 2.8% 7 0.064s tactic local total calls max ────────────────────────────────────────┴──────┴──────┴───────┴─────────┘ ─synthesize ---------------------------- -0.0% 100.0% 1 5.480s ├─Pipeline.refine_reflectively_gen ---- 0.0% 95.7% 1 5.244s │ ├─ReflectiveTactics.do_reflective_pip 0.0% 88.6% 1 4.856s │ │└ReflectiveTactics.solve_side_condit 0.0% 87.7% 1 4.804s │ │ ├─ReflectiveTactics.do_reify ------ 0.0% 53.3% 1 2.920s │ │ │└Reify.Reify_rhs_gen ------------- 2.0% 52.5% 1 2.876s │ │ │ ├─Reify.do_reify_abs_goal ------- 33.2% 33.6% 2 1.844s │ │ │ │└Reify.do_reifyf_goal ---------- 31.5% 32.0% 47 1.392s │ │ │ │└eexact ------------------------ 9.1% 9.1% 47 0.024s │ │ │ ├─prove_interp_compile_correct -- 0.0% 5.8% 1 0.316s │ │ │ │└rewrite ?EtaInterp.InterpExprEt 5.3% 5.3% 1 0.288s │ │ │ ├─tac --------------------------- 2.0% 2.8% 1 0.156s │ │ │ └─rewrite H --------------------- 2.8% 2.8% 1 0.156s │ │ └─ReflectiveTactics.solve_post_reif 0.6% 34.4% 1 1.884s │ │ ├─UnifyAbstractReflexivity.unify_ 21.9% 26.6% 7 0.400s │ │ │└unify (constr) (constr) ------- 3.9% 3.9% 5 0.072s │ │ └─ReflectiveTactics.unify_abstrac 5.0% 6.9% 1 0.380s │ └─Glue.refine_to_reflective_glue' --- 0.0% 7.1% 1 0.388s │ └Glue.zrange_to_reflective --------- 0.1% 5.1% 1 0.280s │ └Glue.zrange_to_reflective_goal ---- 3.1% 3.9% 1 0.212s └─IntegrationTestTemporaryMiscCommon.do 0.1% 4.0% 1 0.220s └change G' --------------------------- 3.4% 3.4% 1 0.184s src/Specific/X25519/C64/fesquare (real: 33.08, user: 30.13, sys: 0.24, mem: 799620 ko) COQC src/Specific/X25519/C64/femulDisplay > src/Specific/X25519/C64/femulDisplay.log COQC src/Specific/X25519/C64/freeze.v Finished transaction in 7.307 secs (6.763u,0.011s) (successful) total time: 6.732s tactic local total calls max ────────────────────────────────────────┴──────┴──────┴───────┴─────────┘ ─synthesize_freeze --------------------- 0.0% 100.0% 1 6.732s ─Pipeline.refine_reflectively_gen ------ 0.0% 99.3% 1 6.684s ─ReflectiveTactics.do_reflective_pipelin 0.0% 92.8% 1 6.248s ─ReflectiveTactics.solve_side_conditions 0.0% 92.0% 1 6.192s ─ReflectiveTactics.do_reify ------------ -0.0% 60.3% 1 4.060s ─Reify.Reify_rhs_gen ------------------- 1.5% 59.6% 1 4.012s ─Reify.do_reify_abs_goal --------------- 42.4% 42.7% 2 2.876s ─Reify.do_reifyf_goal ------------------ 41.3% 41.7% 129 2.804s ─ReflectiveTactics.solve_post_reified_si 0.6% 31.7% 1 2.132s ─UnifyAbstractReflexivity.unify_transfor 21.7% 25.8% 7 0.424s ─eexact -------------------------------- 13.7% 13.7% 131 0.036s ─Glue.refine_to_reflective_glue' ------- 0.0% 6.5% 1 0.436s ─prove_interp_compile_correct ---------- 0.0% 5.1% 1 0.344s ─ReflectiveTactics.unify_abstract_cbv_in 3.4% 5.0% 1 0.336s ─rewrite ?EtaInterp.InterpExprEta ------ 4.7% 4.7% 1 0.316s ─unify (constr) (constr) --------------- 4.6% 4.6% 6 0.100s ─Glue.zrange_to_reflective ------------- 0.0% 4.2% 1 0.280s ─Glue.zrange_to_reflective_goal -------- 2.4% 3.3% 1 0.220s ─Reify.transitivity_tt ----------------- 0.1% 2.6% 2 0.116s ─rewrite H ----------------------------- 2.6% 2.6% 1 0.172s ─tac ----------------------------------- 1.5% 2.3% 2 0.156s ─reflexivity --------------------------- 2.3% 2.3% 7 0.052s tactic local total calls max ────────────────────────────────────────┴──────┴──────┴───────┴─────────┘ ─synthesize_freeze --------------------- 0.0% 100.0% 1 6.732s └Pipeline.refine_reflectively_gen ------ 0.0% 99.3% 1 6.684s ├─ReflectiveTactics.do_reflective_pipel 0.0% 92.8% 1 6.248s │└ReflectiveTactics.solve_side_conditio 0.0% 92.0% 1 6.192s │ ├─ReflectiveTactics.do_reify -------- -0.0% 60.3% 1 4.060s │ │└Reify.Reify_rhs_gen --------------- 1.5% 59.6% 1 4.012s │ │ ├─Reify.do_reify_abs_goal --------- 42.4% 42.7% 2 2.876s │ │ │└Reify.do_reifyf_goal ------------ 41.3% 41.7% 129 2.804s │ │ │└eexact -------------------------- 13.0% 13.0% 129 0.036s │ │ ├─prove_interp_compile_correct ---- 0.0% 5.1% 1 0.344s │ │ │└rewrite ?EtaInterp.InterpExprEta 4.7% 4.7% 1 0.316s │ │ ├─Reify.transitivity_tt ----------- 0.1% 2.6% 2 0.116s │ │ ├─rewrite H ----------------------- 2.6% 2.6% 1 0.172s │ │ └─tac ----------------------------- 1.5% 2.3% 1 0.156s │ └─ReflectiveTactics.solve_post_reifie 0.6% 31.7% 1 2.132s │ ├─UnifyAbstractReflexivity.unify_tr 21.7% 25.8% 7 0.424s │ │└unify (constr) (constr) --------- 3.1% 3.1% 5 0.084s │ └─ReflectiveTactics.unify_abstract_ 3.4% 5.0% 1 0.336s └─Glue.refine_to_reflective_glue' ----- 0.0% 6.5% 1 0.436s └Glue.zrange_to_reflective ----------- 0.0% 4.2% 1 0.280s └Glue.zrange_to_reflective_goal ------ 2.4% 3.3% 1 0.220s Finished transaction in 10.495 secs (9.756u,0.s) (successful) Closed under the global context total time: 6.732s tactic local total calls max ────────────────────────────────────────┴──────┴──────┴───────┴─────────┘ ─synthesize_freeze --------------------- 0.0% 100.0% 1 6.732s ─Pipeline.refine_reflectively_gen ------ 0.0% 99.3% 1 6.684s ─ReflectiveTactics.do_reflective_pipelin 0.0% 92.8% 1 6.248s ─ReflectiveTactics.solve_side_conditions 0.0% 92.0% 1 6.192s ─ReflectiveTactics.do_reify ------------ -0.0% 60.3% 1 4.060s ─Reify.Reify_rhs_gen ------------------- 1.5% 59.6% 1 4.012s ─Reify.do_reify_abs_goal --------------- 42.4% 42.7% 2 2.876s ─Reify.do_reifyf_goal ------------------ 41.3% 41.7% 129 2.804s ─ReflectiveTactics.solve_post_reified_si 0.6% 31.7% 1 2.132s ─UnifyAbstractReflexivity.unify_transfor 21.7% 25.8% 7 0.424s ─eexact -------------------------------- 13.7% 13.7% 131 0.036s ─Glue.refine_to_reflective_glue' ------- 0.0% 6.5% 1 0.436s ─prove_interp_compile_correct ---------- 0.0% 5.1% 1 0.344s ─ReflectiveTactics.unify_abstract_cbv_in 3.4% 5.0% 1 0.336s ─rewrite ?EtaInterp.InterpExprEta ------ 4.7% 4.7% 1 0.316s ─unify (constr) (constr) --------------- 4.6% 4.6% 6 0.100s ─Glue.zrange_to_reflective ------------- 0.0% 4.2% 1 0.280s ─Glue.zrange_to_reflective_goal -------- 2.4% 3.3% 1 0.220s ─Reify.transitivity_tt ----------------- 0.1% 2.6% 2 0.116s ─rewrite H ----------------------------- 2.6% 2.6% 1 0.172s ─tac ----------------------------------- 1.5% 2.3% 2 0.156s ─reflexivity --------------------------- 2.3% 2.3% 7 0.052s tactic local total calls max ────────────────────────────────────────┴──────┴──────┴───────┴─────────┘ ─synthesize_freeze --------------------- 0.0% 100.0% 1 6.732s └Pipeline.refine_reflectively_gen ------ 0.0% 99.3% 1 6.684s ├─ReflectiveTactics.do_reflective_pipel 0.0% 92.8% 1 6.248s │└ReflectiveTactics.solve_side_conditio 0.0% 92.0% 1 6.192s │ ├─ReflectiveTactics.do_reify -------- -0.0% 60.3% 1 4.060s │ │└Reify.Reify_rhs_gen --------------- 1.5% 59.6% 1 4.012s │ │ ├─Reify.do_reify_abs_goal --------- 42.4% 42.7% 2 2.876s │ │ │└Reify.do_reifyf_goal ------------ 41.3% 41.7% 129 2.804s │ │ │└eexact -------------------------- 13.0% 13.0% 129 0.036s │ │ ├─prove_interp_compile_correct ---- 0.0% 5.1% 1 0.344s │ │ │└rewrite ?EtaInterp.InterpExprEta 4.7% 4.7% 1 0.316s │ │ ├─Reify.transitivity_tt ----------- 0.1% 2.6% 2 0.116s │ │ ├─rewrite H ----------------------- 2.6% 2.6% 1 0.172s │ │ └─tac ----------------------------- 1.5% 2.3% 1 0.156s │ └─ReflectiveTactics.solve_post_reifie 0.6% 31.7% 1 2.132s │ ├─UnifyAbstractReflexivity.unify_tr 21.7% 25.8% 7 0.424s │ │└unify (constr) (constr) --------- 3.1% 3.1% 5 0.084s │ └─ReflectiveTactics.unify_abstract_ 3.4% 5.0% 1 0.336s └─Glue.refine_to_reflective_glue' ----- 0.0% 6.5% 1 0.436s └Glue.zrange_to_reflective ----------- 0.0% 4.2% 1 0.280s └Glue.zrange_to_reflective_goal ------ 2.4% 3.3% 1 0.220s src/Specific/X25519/C64/freeze (real: 34.35, user: 31.50, sys: 0.24, mem: 828104 ko) COQC src/Specific/NISTP256/AMD64/feadd.v Finished transaction in 8.784 secs (8.176u,0.011s) (successful) total time: 8.140s tactic local total calls max ────────────────────────────────────────┴──────┴──────┴───────┴─────────┘ ─Pipeline.refine_reflectively_gen ------ 0.0% 52.4% 1 4.268s ─synthesize_montgomery ----------------- 0.0% 47.6% 1 3.872s ─ReflectiveTactics.do_reflective_pipelin 0.0% 43.8% 1 3.568s ─ReflectiveTactics.solve_side_conditions 0.0% 43.2% 1 3.520s ─IntegrationTestTemporaryMiscCommon.fact 1.4% 23.6% 1 1.924s ─IntegrationTestTemporaryMiscCommon.do_r 0.0% 22.1% 1 1.796s ─ReflectiveTactics.do_reify ------------ 0.1% 21.7% 1 1.768s ─ReflectiveTactics.solve_post_reified_si 0.6% 21.5% 1 1.752s ─Reify.Reify_rhs_gen ------------------- 1.0% 20.9% 1 1.704s ─op_sig_side_conditions_t -------------- 0.0% 20.0% 1 1.624s ─DestructHyps.do_all_matches_then ------ 0.0% 20.0% 8 0.244s ─DestructHyps.do_one_match_then -------- 0.7% 19.9% 44 0.052s ─do_tac -------------------------------- 0.0% 19.2% 36 0.052s ─destruct H ---------------------------- 19.2% 19.2% 36 0.052s ─rewrite <- (lem : lemT) by by_tac ltac: 0.2% 17.3% 1 1.408s ─IntegrationTestTemporaryMiscCommon.do_r 0.0% 17.3% 1 1.408s ─by_tac -------------------------------- 0.0% 17.1% 4 0.504s ─rewrite <- (ZRange.is_bounded_by_None_r 16.7% 16.7% 8 0.344s ─UnifyAbstractReflexivity.unify_transfor 13.3% 16.1% 7 0.360s ─Reify.do_reify_abs_goal --------------- 9.9% 10.1% 2 0.820s ─Reify.do_reifyf_goal ------------------ 9.1% 9.3% 93 0.748s ─Glue.refine_to_reflective_glue' ------- 0.0% 8.6% 1 0.700s ─Glue.zrange_to_reflective ------------- 0.0% 5.3% 1 0.432s ─IntegrationTestTemporaryMiscCommon.do_s 0.0% 4.8% 1 0.388s ─ MapProjections.proj2 2.4% 2.4% 2 0.120s tactic local total calls max ────────────────────────────────────────┴──────┴──────┴───────┴─────────┘ ─Pipeline.refine_reflectively_gen ------ 0.0% 52.4% 1 4.268s ├─ReflectiveTactics.do_reflective_pipel 0.0% 43.8% 1 3.568s │└ReflectiveTactics.solve_side_conditio 0.0% 43.2% 1 3.520s │ ├─ReflectiveTactics.do_reify -------- 0.1% 21.7% 1 1.768s │ │└Reify.Reify_rhs_gen --------------- 1.0% 20.9% 1 1.704s │ │ ├─Reify.do_reify_abs_goal --------- 9.9% 10.1% 2 0.820s │ │ │└Reify.do_reifyf_goal ------------ 9.1% 9.3% 93 0.748s │ │ │└eexact -------------------------- 2.3% 2.3% 93 0.024s │ │ ├─prove_interp_compile_correct ---- 0.0% 2.5% 1 0.204s │ │ └─rewrite H ----------------------- 2.4% 2.4% 1 0.196s │ └─ReflectiveTactics.solve_post_reifie 0.6% 21.5% 1 1.752s │ ├─UnifyAbstractReflexivity.unify_tr 13.3% 16.1% 7 0.360s │ │└unify (constr) (constr) --------- 2.2% 2.2% 5 0.064s │ └─ReflectiveTactics.unify_abstract_ 3.3% 4.5% 1 0.368s └─Glue.refine_to_reflective_glue' ----- 0.0% 8.6% 1 0.700s └Glue.zrange_to_reflective ----------- 0.0% 5.3% 1 0.432s └Glue.zrange_to_reflective_goal ------ 2.6% 4.0% 1 0.324s ─synthesize_montgomery ----------------- 0.0% 47.6% 1 3.872s ├─IntegrationTestTemporaryMiscCommon.fa 1.4% 23.6% 1 1.924s │└op_sig_side_conditions_t ------------ 0.0% 20.0% 1 1.624s │ ├─DestructHyps.do_all_matches_then -- 0.0% 11.4% 4 0.244s │ │└DestructHyps.do_one_match_then ---- 0.3% 11.4% 24 0.052s │ │└do_tac ---------------------------- 0.0% 11.1% 20 0.052s │ │└destruct H ------------------------ 11.1% 11.1% 20 0.052s │ └─rewrite <- (ZRange.is_bounded_by_No 8.4% 8.4% 4 0.328s └─IntegrationTestTemporaryMiscCommon.do 0.0% 22.1% 1 1.796s ├─IntegrationTestTemporaryMiscCommon. 0.0% 17.3% 1 1.408s │└rewrite <- (lem : lemT) by by_tac l 0.2% 17.3% 1 1.408s │└by_tac ---------------------------- 0.0% 17.1% 4 0.504s │ ├─DestructHyps.do_all_matches_then 0.0% 8.6% 4 0.184s │ │└DestructHyps.do_one_match_then -- 0.3% 8.5% 20 0.052s │ │└do_tac -------------------------- 0.0% 8.2% 16 0.052s │ │└destruct H ---------------------- 8.2% 8.2% 16 0.052s │ └─rewrite <- (ZRange.is_bounded_by_ 8.3% 8.3% 4 0.344s └─IntegrationTestTemporaryMiscCommon. 0.0% 4.8% 1 0.388s └ MapProjections.proj2 2.4% 2.4% 2 0.120s tactic local total calls max ────────────────────────────────────────┴──────┴──────┴───────┴─────────┘ ─Pipeline.refine_reflectively_gen ------ 0.0% 52.4% 1 4.268s ├─ReflectiveTactics.do_reflective_pipel 0.0% 43.8% 1 3.568s │└ReflectiveTactics.solve_side_conditio 0.0% 43.2% 1 3.520s │ ├─ReflectiveTactics.do_reify -------- 0.1% 21.7% 1 1.768s │ │└Reify.Reify_rhs_gen --------------- 1.0% 20.9% 1 1.704s │ │ ├─Reify.do_reify_abs_goal --------- 9.9% 10.1% 2 0.820s │ │ │└Reify.do_reifyf_goal ------------ 9.1% 9.3% 93 0.748s │ │ │└eexact -------------------------- 2.3% 2.3% 93 0.024s │ │ ├─prove_interp_compile_correct ---- 0.0% 2.5% 1 0.204s │ │ └─rewrite H ----------------------- 2.4% 2.4% 1 0.196s │ └─ReflectiveTactics.solve_post_reifie 0.6% 21.5% 1 1.752s │ ├─UnifyAbstractReflexivity.unify_tr 13.3% 16.1% 7 0.360s │ │└unify (constr) (constr) --------- 2.2% 2.2% 5 0.064s │ └─ReflectiveTactics.unify_abstract_ 3.3% 4.5% 1 0.368s └─Glue.refine_to_reflective_glue' ----- 0.0% 8.6% 1 0.700s └Glue.zrange_to_reflective ----------- 0.0% 5.3% 1 0.432s └Glue.zrange_to_reflective_goal ------ 2.6% 4.0% 1 0.324s ─synthesize_montgomery ----------------- 0.0% 47.6% 1 3.872s ├─IntegrationTestTemporaryMiscCommon.fa 1.4% 23.6% 1 1.924s │└op_sig_side_conditions_t ------------ 0.0% 20.0% 1 1.624s │ ├─DestructHyps.do_all_matches_then -- 0.0% 11.4% 4 0.244s │ │└DestructHyps.do_one_match_then ---- 0.3% 11.4% 24 0.052s │ │└do_tac ---------------------------- 0.0% 11.1% 20 0.052s │ │└destruct H ------------------------ 11.1% 11.1% 20 0.052s │ └─rewrite <- (ZRange.is_bounded_by_No 8.4% 8.4% 4 0.328s └─IntegrationTestTemporaryMiscCommon.do 0.0% 22.1% 1 1.796s ├─IntegrationTestTemporaryMiscCommon. 0.0% 17.3% 1 1.408s │└rewrite <- (lem : lemT) by by_tac l 0.2% 17.3% 1 1.408s │└by_tac ---------------------------- 0.0% 17.1% 4 0.504s │ ├─DestructHyps.do_all_matches_then 0.0% 8.6% 4 0.184s │ │└DestructHyps.do_one_match_then -- 0.3% 8.5% 20 0.052s │ │└do_tac -------------------------- 0.0% 8.2% 16 0.052s │ │└destruct H ---------------------- 8.2% 8.2% 16 0.052s │ └─rewrite <- (ZRange.is_bounded_by_ 8.3% 8.3% 4 0.344s └─IntegrationTestTemporaryMiscCommon. 0.0% 4.8% 1 0.388s └ src/Specific/NISTP256/AMD64/feaddDisplay.log COQC src/Specific/NISTP256/AMD64/fenzDisplay > src/Specific/NISTP256/AMD64/fenzDisplay.log COQC src/Specific/solinas32_2e255m765_12limbs/femul.v Finished transaction in 50.426 secs (46.528u,0.072s) (successful) total time: 46.544s tactic local total calls max ────────────────────────────────────────┴──────┴──────┴───────┴─────────┘ ─Pipeline.refine_reflectively_gen ------ -0.0% 94.9% 1 44.164s ─ReflectiveTactics.do_reflective_pipelin 0.0% 87.1% 1 40.552s ─ReflectiveTactics.solve_side_conditions 0.0% 86.7% 1 40.372s ─ReflectiveTactics.do_reify ------------ 0.0% 59.6% 1 27.740s ─Reify.Reify_rhs_gen ------------------- 1.6% 58.9% 1 27.432s ─Reify.do_reify_abs_goal --------------- 43.3% 43.6% 2 20.312s ─Reify.do_reifyf_goal ------------------ 42.5% 42.8% 108 10.328s ─ReflectiveTactics.solve_post_reified_si 0.1% 27.1% 1 12.632s ─UnifyAbstractReflexivity.unify_transfor 18.6% 23.5% 7 3.552s ─eexact -------------------------------- 13.7% 13.7% 110 0.136s ─Glue.refine_to_reflective_glue' ------- 0.0% 7.8% 1 3.612s ─Glue.zrange_to_reflective ------------- 0.0% 7.2% 1 3.332s ─Glue.zrange_to_reflective_goal -------- 1.7% 5.5% 1 2.544s ─synthesize ---------------------------- 0.0% 5.1% 1 2.380s ─unify (constr) (constr) --------------- 5.1% 5.1% 6 1.068s ─IntegrationTestTemporaryMiscCommon.do_r 0.0% 5.0% 1 2.320s ─change G' ----------------------------- 4.8% 4.8% 1 2.252s ─rewrite H ----------------------------- 3.8% 3.8% 1 1.748s ─pose proof (pf : Interpretation.Bo 3.6% 3.6% 1 1.664s ─prove_interp_compile_correct ---------- 0.0% 3.5% 1 1.616s ─rewrite ?EtaInterp.InterpExprEta ------ 3.2% 3.2% 1 1.468s ─ReflectiveTactics.unify_abstract_cbv_in 1.6% 2.4% 1 1.124s ─reflexivity --------------------------- 2.1% 2.1% 7 0.396s tactic local total calls max ────────────────────────────────────────┴──────┴──────┴───────┴─────────┘ ─Pipeline.refine_reflectively_gen ------ -0.0% 94.9% 1 44.164s ├─ReflectiveTactics.do_reflective_pipel 0.0% 87.1% 1 40.552s │└ReflectiveTactics.solve_side_conditio 0.0% 86.7% 1 40.372s │ ├─ReflectiveTactics.do_reify -------- 0.0% 59.6% 1 27.740s │ │└Reify.Reify_rhs_gen --------------- 1.6% 58.9% 1 27.432s │ │ ├─Reify.do_reify_abs_goal --------- 43.3% 43.6% 2 20.312s │ │ │└Reify.do_reifyf_goal ------------ 42.5% 42.8% 108 10.328s │ │ │└eexact -------------------------- 13.2% 13.2% 108 0.072s │ │ ├─rewrite H ----------------------- 3.8% 3.8% 1 1.748s │ │ └─prove_interp_compile_correct ---- 0.0% 3.5% 1 1.616s │ │ └rewrite ?EtaInterp.InterpExprEta 3.2% 3.2% 1 1.468s │ └─ReflectiveTactics.solve_post_reifie 0.1% 27.1% 1 12.632s │ ├─UnifyAbstractReflexivity.unify_tr 18.6% 23.5% 7 3.552s │ │└unify (constr) (constr) --------- 4.3% 4.3% 5 1.068s │ └─ReflectiveTactics.unify_abstract_ 1.6% 2.4% 1 1.124s └─Glue.refine_to_reflective_glue' ----- 0.0% 7.8% 1 3.612s └Glue.zrange_to_reflective ----------- 0.0% 7.2% 1 3.332s └Glue.zrange_to_reflective_goal ------ 1.7% 5.5% 1 2.544s └pose proof (pf : Interpretation. 3.6% 3.6% 1 1.664s ─synthesize ---------------------------- 0.0% 5.1% 1 2.380s └IntegrationTestTemporaryMiscCommon.do_r 0.0% 5.0% 1 2.320s └change G' ----------------------------- 4.8% 4.8% 1 2.252s Finished transaction in 80.129 secs (74.068u,0.024s) (successful) Closed under the global context total time: 46.544s tactic local total calls max ────────────────────────────────────────┴──────┴──────┴───────┴─────────┘ ─Pipeline.refine_reflectively_gen ------ -0.0% 94.9% 1 44.164s ─ReflectiveTactics.do_reflective_pipelin 0.0% 87.1% 1 40.552s ─ReflectiveTactics.solve_side_conditions 0.0% 86.7% 1 40.372s ─ReflectiveTactics.do_reify ------------ 0.0% 59.6% 1 27.740s ─Reify.Reify_rhs_gen ------------------- 1.6% 58.9% 1 27.432s ─Reify.do_reify_abs_goal --------------- 43.3% 43.6% 2 20.312s ─Reify.do_reifyf_goal ------------------ 42.5% 42.8% 108 10.328s ─ReflectiveTactics.solve_post_reified_si 0.1% 27.1% 1 12.632s ─UnifyAbstractReflexivity.unify_transfor 18.6% 23.5% 7 3.552s ─eexact -------------------------------- 13.7% 13.7% 110 0.136s ─Glue.refine_to_reflective_glue' ------- 0.0% 7.8% 1 3.612s ─Glue.zrange_to_reflective ------------- 0.0% 7.2% 1 3.332s ─Glue.zrange_to_reflective_goal -------- 1.7% 5.5% 1 2.544s ─synthesize ---------------------------- 0.0% 5.1% 1 2.380s ─unify (constr) (constr) --------------- 5.1% 5.1% 6 1.068s ─IntegrationTestTemporaryMiscCommon.do_r 0.0% 5.0% 1 2.320s ─change G' ----------------------------- 4.8% 4.8% 1 2.252s ─rewrite H ----------------------------- 3.8% 3.8% 1 1.748s ─pose proof (pf : Interpretation.Bo 3.6% 3.6% 1 1.664s ─prove_interp_compile_correct ---------- 0.0% 3.5% 1 1.616s ─rewrite ?EtaInterp.InterpExprEta ------ 3.2% 3.2% 1 1.468s ─ReflectiveTactics.unify_abstract_cbv_in 1.6% 2.4% 1 1.124s ─reflexivity --------------------------- 2.1% 2.1% 7 0.396s tactic local total calls max ────────────────────────────────────────┴──────┴──────┴───────┴─────────┘ ─Pipeline.refine_reflectively_gen ------ -0.0% 94.9% 1 44.164s ├─ReflectiveTactics.do_reflective_pipel 0.0% 87.1% 1 40.552s │└ReflectiveTactics.solve_side_conditio 0.0% 86.7% 1 40.372s │ ├─ReflectiveTactics.do_reify -------- 0.0% 59.6% 1 27.740s │ │└Reify.Reify_rhs_gen --------------- 1.6% 58.9% 1 27.432s │ │ ├─Reify.do_reify_abs_goal --------- 43.3% 43.6% 2 20.312s │ │ │└Reify.do_reifyf_goal ------------ 42.5% 42.8% 108 10.328s │ │ │└eexact -------------------------- 13.2% 13.2% 108 0.072s │ │ ├─rewrite H ----------------------- 3.8% 3.8% 1 1.748s │ │ └─prove_interp_compile_correct ---- 0.0% 3.5% 1 1.616s │ │ └rewrite ?EtaInterp.InterpExprEta 3.2% 3.2% 1 1.468s │ └─ReflectiveTactics.solve_post_reifie 0.1% 27.1% 1 12.632s │ ├─UnifyAbstractReflexivity.unify_tr 18.6% 23.5% 7 3.552s │ │└unify (constr) (constr) --------- 4.3% 4.3% 5 1.068s │ └─ReflectiveTactics.unify_abstract_ 1.6% 2.4% 1 1.124s └─Glue.refine_to_reflective_glue' ----- 0.0% 7.8% 1 3.612s └Glue.zrange_to_reflective ----------- 0.0% 7.2% 1 3.332s └Glue.zrange_to_reflective_goal ------ 1.7% 5.5% 1 2.544s └pose proof (pf : Interpretation. 3.6% 3.6% 1 1.664s ─synthesize ---------------------------- 0.0% 5.1% 1 2.380s └IntegrationTestTemporaryMiscCommon.do_r 0.0% 5.0% 1 2.320s └change G' ----------------------------- 4.8% 4.8% 1 2.252s src/Specific/solinas32_2e255m765_12limbs/femul (real: 155.79, user: 143.70, sys: 0.32, mem: 1454696 ko) COQC src/Specific/NISTP256/AMD64/feoppDisplay > src/Specific/NISTP256/AMD64/feoppDisplay.log COQC src/Specific/NISTP256/AMD64/fesubDisplay > src/Specific/NISTP256/AMD64/fesubDisplay.log COQC src/Specific/X25519/C64/fesquareDisplay > src/Specific/X25519/C64/fesquareDisplay.log COQC src/Specific/X25519/C64/fesubDisplay > src/Specific/X25519/C64/fesubDisplay.log COQC src/Specific/X25519/C64/freezeDisplay > src/Specific/X25519/C64/freezeDisplay.log COQC src/Specific/solinas32_2e255m765_13limbs/femul.v Finished transaction in 61.854 secs (57.328u,0.079s) (successful) total time: 57.348s tactic local total calls max ────────────────────────────────────────┴──────┴──────┴───────┴─────────┘ ─Pipeline.refine_reflectively_gen ------ 0.0% 94.6% 1 54.224s ─ReflectiveTactics.do_reflective_pipelin 0.0% 86.2% 1 49.452s ─ReflectiveTactics.solve_side_conditions 0.0% 85.9% 1 49.264s ─ReflectiveTactics.do_reify ------------ -0.0% 57.6% 1 33.004s ─Reify.Reify_rhs_gen ------------------- 1.3% 56.9% 1 32.608s ─Reify.do_reify_abs_goal --------------- 43.1% 43.3% 2 24.840s ─Reify.do_reifyf_goal ------------------ 42.3% 42.6% 117 12.704s ─ReflectiveTactics.solve_post_reified_si 0.1% 28.4% 1 16.260s ─UnifyAbstractReflexivity.unify_transfor 19.6% 25.0% 7 4.824s ─eexact -------------------------------- 13.9% 13.9% 119 0.144s ─Glue.refine_to_reflective_glue' ------- 0.0% 8.3% 1 4.772s ─Glue.zrange_to_reflective ------------- 0.0% 7.8% 1 4.484s ─Glue.zrange_to_reflective_goal -------- 1.7% 6.0% 1 3.464s ─synthesize ---------------------------- 0.0% 5.4% 1 3.124s ─unify (constr) (constr) --------------- 5.4% 5.4% 6 1.540s ─IntegrationTestTemporaryMiscCommon.do_r 0.0% 5.3% 1 3.040s ─change G' ----------------------------- 5.2% 5.2% 1 2.964s ─pose proof (pf : Interpretation.Bo 4.2% 4.2% 1 2.416s ─prove_interp_compile_correct ---------- 0.0% 3.3% 1 1.904s ─rewrite H ----------------------------- 3.3% 3.3% 1 1.896s ─rewrite ?EtaInterp.InterpExprEta ------ 3.0% 3.0% 1 1.732s ─ReflectiveTactics.unify_abstract_cbv_in 1.4% 2.1% 1 1.212s tactic local total calls max ────────────────────────────────────────┴──────┴──────┴───────┴─────────┘ ─Pipeline.refine_reflectively_gen ------ 0.0% 94.6% 1 54.224s ├─ReflectiveTactics.do_reflective_pipel 0.0% 86.2% 1 49.452s │└ReflectiveTactics.solve_side_conditio 0.0% 85.9% 1 49.264s │ ├─ReflectiveTactics.do_reify -------- -0.0% 57.6% 1 33.004s │ │└Reify.Reify_rhs_gen --------------- 1.3% 56.9% 1 32.608s │ │ ├─Reify.do_reify_abs_goal --------- 43.1% 43.3% 2 24.840s │ │ │└Reify.do_reifyf_goal ------------ 42.3% 42.6% 117 12.704s │ │ │└eexact -------------------------- 13.4% 13.4% 117 0.084s │ │ ├─prove_interp_compile_correct ---- 0.0% 3.3% 1 1.904s │ │ │└rewrite ?EtaInterp.InterpExprEta 3.0% 3.0% 1 1.732s │ │ └─rewrite H ----------------------- 3.3% 3.3% 1 1.896s │ └─ReflectiveTactics.solve_post_reifie 0.1% 28.4% 1 16.260s │ ├─UnifyAbstractReflexivity.unify_tr 19.6% 25.0% 7 4.824s │ │└unify (constr) (constr) --------- 4.8% 4.8% 5 1.540s │ └─ReflectiveTactics.unify_abstract_ 1.4% 2.1% 1 1.212s └─Glue.refine_to_reflective_glue' ----- 0.0% 8.3% 1 4.772s └Glue.zrange_to_reflective ----------- 0.0% 7.8% 1 4.484s └Glue.zrange_to_reflective_goal ------ 1.7% 6.0% 1 3.464s └pose proof (pf : Interpretation. 4.2% 4.2% 1 2.416s ─synthesize ---------------------------- 0.0% 5.4% 1 3.124s └IntegrationTestTemporaryMiscCommon.do_r 0.0% 5.3% 1 3.040s └change G' ----------------------------- 5.2% 5.2% 1 2.964s Finished transaction in 94.432 secs (86.96u,0.02s) (successful) Closed under the global context total time: 57.348s tactic local total calls max ────────────────────────────────────────┴──────┴──────┴───────┴─────────┘ ─Pipeline.refine_reflectively_gen ------ 0.0% 94.6% 1 54.224s ─ReflectiveTactics.do_reflective_pipelin 0.0% 86.2% 1 49.452s ─ReflectiveTactics.solve_side_conditions 0.0% 85.9% 1 49.264s ─ReflectiveTactics.do_reify ------------ -0.0% 57.6% 1 33.004s ─Reify.Reify_rhs_gen ------------------- 1.3% 56.9% 1 32.608s ─Reify.do_reify_abs_goal --------------- 43.1% 43.3% 2 24.840s ─Reify.do_reifyf_goal ------------------ 42.3% 42.6% 117 12.704s ─ReflectiveTactics.solve_post_reified_si 0.1% 28.4% 1 16.260s ─UnifyAbstractReflexivity.unify_transfor 19.6% 25.0% 7 4.824s ─eexact -------------------------------- 13.9% 13.9% 119 0.144s ─Glue.refine_to_reflective_glue' ------- 0.0% 8.3% 1 4.772s ─Glue.zrange_to_reflective ------------- 0.0% 7.8% 1 4.484s ─Glue.zrange_to_reflective_goal -------- 1.7% 6.0% 1 3.464s ─synthesize ---------------------------- 0.0% 5.4% 1 3.124s ─unify (constr) (constr) --------------- 5.4% 5.4% 6 1.540s ─IntegrationTestTemporaryMiscCommon.do_r 0.0% 5.3% 1 3.040s ─change G' ----------------------------- 5.2% 5.2% 1 2.964s ─pose proof (pf : Interpretation.Bo 4.2% 4.2% 1 2.416s ─prove_interp_compile_correct ---------- 0.0% 3.3% 1 1.904s ─rewrite H ----------------------------- 3.3% 3.3% 1 1.896s ─rewrite ?EtaInterp.InterpExprEta ------ 3.0% 3.0% 1 1.732s ─ReflectiveTactics.unify_abstract_cbv_in 1.4% 2.1% 1 1.212s tactic local total calls max ────────────────────────────────────────┴──────┴──────┴───────┴─────────┘ ─Pipeline.refine_reflectively_gen ------ 0.0% 94.6% 1 54.224s ├─ReflectiveTactics.do_reflective_pipel 0.0% 86.2% 1 49.452s │└ReflectiveTactics.solve_side_conditio 0.0% 85.9% 1 49.264s │ ├─ReflectiveTactics.do_reify -------- -0.0% 57.6% 1 33.004s │ │└Reify.Reify_rhs_gen --------------- 1.3% 56.9% 1 32.608s │ │ ├─Reify.do_reify_abs_goal --------- 43.1% 43.3% 2 24.840s │ │ │└Reify.do_reifyf_goal ------------ 42.3% 42.6% 117 12.704s │ │ │└eexact -------------------------- 13.4% 13.4% 117 0.084s │ │ ├─prove_interp_compile_correct ---- 0.0% 3.3% 1 1.904s │ │ │└rewrite ?EtaInterp.InterpExprEta 3.0% 3.0% 1 1.732s │ │ └─rewrite H ----------------------- 3.3% 3.3% 1 1.896s │ └─ReflectiveTactics.solve_post_reifie 0.1% 28.4% 1 16.260s │ ├─UnifyAbstractReflexivity.unify_tr 19.6% 25.0% 7 4.824s │ │└unify (constr) (constr) --------- 4.8% 4.8% 5 1.540s │ └─ReflectiveTactics.unify_abstract_ 1.4% 2.1% 1 1.212s └─Glue.refine_to_reflective_glue' ----- 0.0% 8.3% 1 4.772s └Glue.zrange_to_reflective ----------- 0.0% 7.8% 1 4.484s └Glue.zrange_to_reflective_goal ------ 1.7% 6.0% 1 3.464s └pose proof (pf : Interpretation. 4.2% 4.2% 1 2.416s ─synthesize ---------------------------- 0.0% 5.4% 1 3.124s └IntegrationTestTemporaryMiscCommon.do_r 0.0% 5.3% 1 3.040s └change G' ----------------------------- 5.2% 5.2% 1 2.964s src/Specific/solinas32_2e255m765_13limbs/femul (real: 181.77, user: 168.52, sys: 0.40, mem: 1589516 ko) COQC src/Specific/NISTP256/AMD64/femul.v Finished transaction in 119.257 secs (109.936u,0.256s) (successful) total time: 110.140s tactic local total calls max ────────────────────────────────────────┴──────┴──────┴───────┴─────────┘ ─Pipeline.refine_reflectively_gen ------ 0.0% 97.1% 1 106.964s ─ReflectiveTactics.do_reflective_pipelin -0.0% 96.4% 1 106.196s ─ReflectiveTactics.solve_side_conditions 0.0% 96.2% 1 105.992s ─ReflectiveTactics.do_reify ------------ -0.0% 83.7% 1 92.208s ─Reify.Reify_rhs_gen ------------------- 0.7% 83.5% 1 91.960s ─Reify.do_reify_abs_goal --------------- 77.7% 77.8% 2 85.708s ─Reify.do_reifyf_goal ------------------ 77.4% 77.5% 901 85.364s ─eexact -------------------------------- 17.9% 17.9% 903 0.136s ─ReflectiveTactics.solve_post_reified_si 0.3% 12.5% 1 13.784s ─UnifyAbstractReflexivity.unify_transfor 9.8% 11.2% 7 3.356s ─synthesize_montgomery ----------------- 0.0% 2.9% 1 3.176s tactic local total calls max ────────────────────────────────────────┴──────┴──────┴───────┴─────────┘ ─Pipeline.refine_reflectively_gen ------ 0.0% 97.1% 1 106.964s └ReflectiveTactics.do_reflective_pipelin -0.0% 96.4% 1 106.196s └ReflectiveTactics.solve_side_conditions 0.0% 96.2% 1 105.992s ├─ReflectiveTactics.do_reify ---------- -0.0% 83.7% 1 92.208s │└Reify.Reify_rhs_gen ----------------- 0.7% 83.5% 1 91.960s │└Reify.do_reify_abs_goal ------------- 77.7% 77.8% 2 85.708s │└Reify.do_reifyf_goal ---------------- 77.4% 77.5% 901 85.364s │└eexact ------------------------------ 17.7% 17.7% 901 0.136s └─ReflectiveTactics.solve_post_reified_ 0.3% 12.5% 1 13.784s └UnifyAbstractReflexivity.unify_transf 9.8% 11.2% 7 3.356s ─synthesize_montgomery ----------------- 0.0% 2.9% 1 3.176s Finished transaction in 61.452 secs (58.503u,0.055s) (successful) Closed under the global context total time: 110.140s tactic local total calls max ────────────────────────────────────────┴──────┴──────┴───────┴─────────┘ ─Pipeline.refine_reflectively_gen ------ 0.0% 97.1% 1 106.964s ─ReflectiveTactics.do_reflective_pipelin -0.0% 96.4% 1 106.196s ─ReflectiveTactics.solve_side_conditions 0.0% 96.2% 1 105.992s ─ReflectiveTactics.do_reify ------------ -0.0% 83.7% 1 92.208s ─Reify.Reify_rhs_gen ------------------- 0.7% 83.5% 1 91.960s ─Reify.do_reify_abs_goal --------------- 77.7% 77.8% 2 85.708s ─Reify.do_reifyf_goal ------------------ 77.4% 77.5% 901 85.364s ─eexact -------------------------------- 17.9% 17.9% 903 0.136s ─ReflectiveTactics.solve_post_reified_si 0.3% 12.5% 1 13.784s ─UnifyAbstractReflexivity.unify_transfor 9.8% 11.2% 7 3.356s ─synthesize_montgomery ----------------- 0.0% 2.9% 1 3.176s tactic local total calls max ────────────────────────────────────────┴──────┴──────┴───────┴─────────┘ ─Pipeline.refine_reflectively_gen ------ 0.0% 97.1% 1 106.964s └ReflectiveTactics.do_reflective_pipelin -0.0% 96.4% 1 106.196s └ReflectiveTactics.solve_side_conditions 0.0% 96.2% 1 105.992s ├─ReflectiveTactics.do_reify ---------- -0.0% 83.7% 1 92.208s │└Reify.Reify_rhs_gen ----------------- 0.7% 83.5% 1 91.960s │└Reify.do_reify_abs_goal ------------- 77.7% 77.8% 2 85.708s │└Reify.do_reifyf_goal ---------------- 77.4% 77.5% 901 85.364s │└eexact ------------------------------ 17.7% 17.7% 901 0.136s └─ReflectiveTactics.solve_post_reified_ 0.3% 12.5% 1 13.784s └UnifyAbstractReflexivity.unify_transf 9.8% 11.2% 7 3.356s ─synthesize_montgomery ----------------- 0.0% 2.9% 1 3.176s src/Specific/NISTP256/AMD64/femul (real: 202.96, user: 189.62, sys: 0.64, mem: 3302508 ko) COQC src/Specific/NISTP256/AMD64/femulDisplay > src/Specific/NISTP256/AMD64/femulDisplay.log COQC src/Specific/X25519/C64/ladderstep.v total time: 52.080s tactic local total calls max ────────────────────────────────────────┴──────┴──────┴───────┴─────────┘ ─synthesize_xzladderstep --------------- 0.0% 100.0% 1 52.080s ─Pipeline.refine_reflectively_gen ------ 0.0% 98.5% 1 51.320s ─ReflectiveTactics.do_reflective_pipelin 0.0% 93.8% 1 48.872s ─ReflectiveTactics.solve_side_conditions 0.0% 93.7% 1 48.776s ─ReflectiveTactics.solve_post_reified_si 0.2% 56.5% 1 29.412s ─UnifyAbstractReflexivity.unify_transfor 44.7% 49.1% 7 6.968s ─ReflectiveTactics.do_reify ------------ 0.0% 37.2% 1 19.364s ─Reify.Reify_rhs_gen ------------------- 2.1% 23.4% 1 12.200s ─Reify.do_reifyf_goal ------------------ 11.2% 11.3% 138 1.884s ─Compilers.Reify.reify_context_variables 0.1% 9.2% 1 4.808s ─rewrite H ----------------------------- 7.3% 7.3% 1 3.816s ─ReflectiveTactics.unify_abstract_cbv_in 4.7% 6.4% 1 3.336s ─Glue.refine_to_reflective_glue' ------- 0.0% 4.7% 1 2.448s ─Glue.zrange_to_reflective ------------- 0.0% 4.0% 1 2.068s ─Reify.transitivity_tt ----------------- 0.1% 3.7% 2 0.984s ─transitivity -------------------------- 3.5% 3.5% 10 0.880s ─reflexivity --------------------------- 3.4% 3.4% 11 0.772s ─Glue.zrange_to_reflective_goal -------- 2.4% 3.3% 1 1.728s ─eexact -------------------------------- 3.2% 3.2% 140 0.032s ─unify (constr) (constr) --------------- 3.1% 3.1% 6 0.852s ─clear (var_list) ---------------------- 3.1% 3.1% 98 0.584s ─UnfoldArg.unfold_second_arg ----------- 0.4% 3.0% 2 1.576s ─tac ----------------------------------- 2.1% 3.0% 2 1.564s ─ClearAll.clear_all -------------------- 0.2% 2.8% 7 0.584s ─ChangeInAll.change_with_compute_in_all 0.0% 2.6% 221 0.012s ─change c with c' in * ----------------- 2.5% 2.5% 221 0.012s ─Reify.do_reify_abs_goal --------------- 2.4% 2.5% 2 1.276s tactic local total calls max ────────────────────────────────────────┴──────┴──────┴───────┴─────────┘ ─synthesize_xzladderstep --------------- 0.0% 100.0% 1 52.080s └Pipeline.refine_reflectively_gen ------ 0.0% 98.5% 1 51.320s ├─ReflectiveTactics.do_reflective_pipel 0.0% 93.8% 1 48.872s │└ReflectiveTactics.solve_side_conditio 0.0% 93.7% 1 48.776s │ ├─ReflectiveTactics.solve_post_reifie 0.2% 56.5% 1 29.412s │ │ ├─UnifyAbstractReflexivity.unify_tr 44.7% 49.1% 7 6.968s │ │ │└ClearAll.clear_all -------------- 0.2% 2.8% 7 0.584s │ │ │└clear (var_list) ---------------- 2.7% 2.7% 65 0.584s │ │ └─ReflectiveTactics.unify_abstract_ 4.7% 6.4% 1 3.336s │ └─ReflectiveTactics.do_reify -------- 0.0% 37.2% 1 19.364s │ ├─Reify.Reify_rhs_gen ------------- 2.1% 23.4% 1 12.200s │ │ ├─rewrite H --------------------- 7.3% 7.3% 1 3.816s │ │ ├─Reify.transitivity_tt --------- 0.1% 3.7% 2 0.984s │ │ │└transitivity ------------------ 3.4% 3.4% 4 0.880s │ │ ├─tac --------------------------- 2.1% 3.0% 1 1.564s │ │ └─Reify.do_reify_abs_goal ------- 2.4% 2.5% 2 1.276s │ │ └Reify.do_reifyf_goal ---------- 2.2% 2.2% 25 1.148s │ ├─Compilers.Reify.reify_context_var 0.1% 9.2% 1 4.808s │ │└Reify.do_reifyf_goal ------------ 9.0% 9.1% 113 1.884s │ │└eexact -------------------------- 2.4% 2.4% 113 0.032s │ └─UnfoldArg.unfold_second_arg ----- 0.4% 3.0% 2 1.576s │ └ChangeInAll.change_with_compute_i 0.0% 2.6% 221 0.012s │ └change c with c' in * ----------- 2.5% 2.5% 221 0.012s └─Glue.refine_to_reflective_glue' ----- 0.0% 4.7% 1 2.448s └Glue.zrange_to_reflective ----------- 0.0% 4.0% 1 2.068s └Glue.zrange_to_reflective_goal ------ 2.4% 3.3% 1 1.728s Finished transaction in 171.122 secs (161.392u,0.039s) (successful) Closed under the global context total time: 52.080s tactic local total calls max ────────────────────────────────────────┴──────┴──────┴───────┴─────────┘ ─synthesize_xzladderstep --------------- 0.0% 100.0% 1 52.080s ─Pipeline.refine_reflectively_gen ------ 0.0% 98.5% 1 51.320s ─ReflectiveTactics.do_reflective_pipelin 0.0% 93.8% 1 48.872s ─ReflectiveTactics.solve_side_conditions 0.0% 93.7% 1 48.776s ─ReflectiveTactics.solve_post_reified_si 0.2% 56.5% 1 29.412s ─UnifyAbstractReflexivity.unify_transfor 44.7% 49.1% 7 6.968s ─ReflectiveTactics.do_reify ------------ 0.0% 37.2% 1 19.364s ─Reify.Reify_rhs_gen ------------------- 2.1% 23.4% 1 12.200s ─Reify.do_reifyf_goal ------------------ 11.2% 11.3% 138 1.884s ─Compilers.Reify.reify_context_variables 0.1% 9.2% 1 4.808s ─rewrite H ----------------------------- 7.3% 7.3% 1 3.816s ─ReflectiveTactics.unify_abstract_cbv_in 4.7% 6.4% 1 3.336s ─Glue.refine_to_reflective_glue' ------- 0.0% 4.7% 1 2.448s ─Glue.zrange_to_reflective ------------- 0.0% 4.0% 1 2.068s ─Reify.transitivity_tt ----------------- 0.1% 3.7% 2 0.984s ─transitivity -------------------------- 3.5% 3.5% 10 0.880s ─reflexivity --------------------------- 3.4% 3.4% 11 0.772s ─Glue.zrange_to_reflective_goal -------- 2.4% 3.3% 1 1.728s ─eexact -------------------------------- 3.2% 3.2% 140 0.032s ─unify (constr) (constr) --------------- 3.1% 3.1% 6 0.852s ─clear (var_list) ---------------------- 3.1% 3.1% 98 0.584s ─UnfoldArg.unfold_second_arg ----------- 0.4% 3.0% 2 1.576s ─tac ----------------------------------- 2.1% 3.0% 2 1.564s ─ClearAll.clear_all -------------------- 0.2% 2.8% 7 0.584s ─ChangeInAll.change_with_compute_in_all 0.0% 2.6% 221 0.012s ─change c with c' in * ----------------- 2.5% 2.5% 221 0.012s ─Reify.do_reify_abs_goal --------------- 2.4% 2.5% 2 1.276s tactic local total calls max ────────────────────────────────────────┴──────┴──────┴───────┴─────────┘ ─synthesize_xzladderstep --------------- 0.0% 100.0% 1 52.080s └Pipeline.refine_reflectively_gen ------ 0.0% 98.5% 1 51.320s ├─ReflectiveTactics.do_reflective_pipel 0.0% 93.8% 1 48.872s │└ReflectiveTactics.solve_side_conditio 0.0% 93.7% 1 48.776s │ ├─ReflectiveTactics.solve_post_reifie 0.2% 56.5% 1 29.412s │ │ ├─UnifyAbstractReflexivity.unify_tr 44.7% 49.1% 7 6.968s │ │ │└ClearAll.clear_all -------------- 0.2% 2.8% 7 0.584s │ │ │└clear (var_list) ---------------- 2.7% 2.7% 65 0.584s │ │ └─ReflectiveTactics.unify_abstract_ 4.7% 6.4% 1 3.336s │ └─ReflectiveTactics.do_reify -------- 0.0% 37.2% 1 19.364s │ ├─Reify.Reify_rhs_gen ------------- 2.1% 23.4% 1 12.200s │ │ ├─rewrite H --------------------- 7.3% 7.3% 1 3.816s │ │ ├─Reify.transitivity_tt --------- 0.1% 3.7% 2 0.984s │ │ │└transitivity ------------------ 3.4% 3.4% 4 0.880s │ │ ├─tac --------------------------- 2.1% 3.0% 1 1.564s │ │ └─Reify.do_reify_abs_goal ------- 2.4% 2.5% 2 1.276s │ │ └Reify.do_reifyf_goal ---------- 2.2% 2.2% 25 1.148s │ ├─Compilers.Reify.reify_context_var 0.1% 9.2% 1 4.808s │ │└Reify.do_reifyf_goal ------------ 9.0% 9.1% 113 1.884s │ │└eexact -------------------------- 2.4% 2.4% 113 0.032s │ └─UnfoldArg.unfold_second_arg ----- 0.4% 3.0% 2 1.576s │ └ChangeInAll.change_with_compute_i 0.0% 2.6% 221 0.012s │ └change c with c' in * ----------- 2.5% 2.5% 221 0.012s └─Glue.refine_to_reflective_glue' ----- 0.0% 4.7% 1 2.448s └Glue.zrange_to_reflective ----------- 0.0% 4.0% 1 2.068s └Glue.zrange_to_reflective_goal ------ 2.4% 3.3% 1 1.728s src/Specific/X25519/C64/ladderstep (real: 256.77, user: 241.34, sys: 0.45, mem: 1617000 ko) COQC src/Specific/X25519/C64/ladderstepDisplay > src/Specific/X25519/C64/ladderstepDisplay.log coq-8.20.0/test-suite/precomputed-time-tests/strip-leading-pwd/000077500000000000000000000000001466560755400244705ustar00rootroot00000000000000coq-8.20.0/test-suite/precomputed-time-tests/strip-leading-pwd/run.sh000077500000000000000000000010361466560755400256330ustar00rootroot00000000000000#!/usr/bin/env bash . ../template/init.sh cd "$(dirname "${BASH_SOURCE[0]}")" /usr/bin/env python3 -c 'import os; open("time-of-build.log", "w").write(open("time-of-build.log.in", "r").read().replace("$PWD", os.getcwd()))' $make_one_time_file time-of-build.log time-of-build-pretty-user.log diff -u time-of-build-pretty-user.log.expected time-of-build-pretty-user.log || exit $? $make_one_time_file time-of-build.log time-of-build-pretty-real.log diff -u time-of-build-pretty-real.log.expected time-of-build-pretty-real.log || exit $? time-of-build-pretty-real.log.expected000066400000000000000000000276641466560755400336360ustar00rootroot00000000000000coq-8.20.0/test-suite/precomputed-time-tests/strip-leading-pwd Time | Peak Mem | File Name ---------------------------------------------------------------------- 2m02.85s | 575776 ko | Total Time / Peak Mem ---------------------------------------------------------------------- 0m16.08s | 435484 ko | coqutil/Map/TestGoals.vo 0m08.38s | 575776 ko | coqutil/Word/Properties.vo 0m06.40s | 452836 ko | coqutil/Map/Properties.vo 0m06.20s | 444256 ko | coqutil/Tactics/ident_of_string.vo 0m04.95s | 413708 ko | coqutil/Map/SlowGoals.vo 0m04.85s | 434980 ko | coqutil/Datatypes/List.vo 0m02.50s | 421756 ko | coqutil/Word/LittleEndianList.vo 0m02.23s | 406924 ko | coqutil/Datatypes/PropSet.vo 0m02.22s | 420764 ko | coqutil/Map/MapEauto.vo 0m01.65s | 420928 ko | coqutil/Word/LittleEndian.vo 0m01.45s | 417760 ko | coqutil/Word/BigEndian.vo 0m01.39s | 416228 ko | coqutil/Z/BitOps.vo 0m01.28s | 418272 ko | coqutil/Map/SortedList.vo 0m01.09s | 415560 ko | coqutil/Datatypes/OperatorOverloading.vo 0m01.05s | 102644 ko | coqutil/Map/Interface.vo.native 0m01.03s | 407636 ko | coqutil/Z/PushPullMod.vo 0m00.97s | 415948 ko | coqutil/Datatypes/ListSet.vo 0m00.95s | 103212 ko | coqutil/Datatypes/OperatorOverloading.vo.native 0m00.94s | 78484 ko | coqutil/Word/Interface.vo.native 0m00.92s | 414256 ko | coqutil/Z/bitblast.vo 0m00.89s | 101560 ko | coqutil/Sorting/OrderToPermutation.vo.native 0m00.88s | 102424 ko | coqutil/Map/SortedList.vo.native 0m00.85s | 101692 ko | coqutil/Datatypes/Inhabited.vo.native 0m00.84s | 103096 ko | coqutil/Map/Empty_set_keyed_map.vo.native 0m00.80s | 102372 ko | coqutil/Map/Funext.vo.native 0m00.78s | 412576 ko | coqutil/Word/Naive.vo 0m00.78s | 408248 ko | coqutil/Z/ZLib.vo 0m00.77s | 100032 ko | coqutil/Map/Properties.vo.native 0m00.75s | 417728 ko | coqutil/Map/OfFunc.vo 0m00.74s | 421844 ko | coqutil/Map/OfListWord.vo 0m00.74s | 419828 ko | coqutil/Word/ZifyLittleEndian.vo 0m00.73s | 104180 ko | coqutil/Tactics/fwd_word_hints.vo.native 0m00.72s | 103220 ko | coqutil/Map/SortedListString.vo.native 0m00.72s | 103964 ko | coqutil/Map/Z_keyed_SortedListMap.vo.native 0m00.69s | 102576 ko | coqutil/Tactics/SafeSimpl.vo.native 0m00.69s | 102316 ko | coqutil/Word/Naive.vo.native 0m00.66s | 101836 ko | coqutil/Datatypes/ListSet.vo.native 0m00.66s | 103320 ko | coqutil/Word/Properties.vo.native 0m00.66s | 104132 ko | coqutil/Word/ZifyLittleEndian.vo.native 0m00.64s | 104208 ko | coqutil/Tactics/fwd.vo.native 0m00.64s | 419144 ko | coqutil/Word/SimplWordExpr.vo 0m00.63s | 101324 ko | coqutil/Map/OfFunc.vo.native 0m00.63s | 104700 ko | coqutil/Map/Solver.vo.native 0m00.63s | 104004 ko | coqutil/Word/LittleEndianList.vo.native 0m00.63s | 102316 ko | coqutil/Z/BitOps.vo.native 0m00.62s | 104040 ko | coqutil/Map/SortedListWord.vo.native 0m00.62s | 101924 ko | coqutil/Tactics/fwd_list_hints.vo.native 0m00.62s | 101904 ko | coqutil/Tactics/rewr.vo.native 0m00.61s | 101844 ko | coqutil/Datatypes/PropSet.vo.native 0m00.60s | 103528 ko | coqutil/Map/SortedListString_test.vo.native 0m00.60s | 104064 ko | coqutil/Word/LittleEndian.vo.native 0m00.59s | 103836 ko | coqutil/Word/BigEndian.vo.native 0m00.58s | 319092 ko | coqutil/Map/Z_keyed_SortedListMap.vo 0m00.58s | 103300 ko | coqutil/Word/DebugWordEq.vo.native 0m00.58s | 413136 ko | coqutil/Z/prove_Zeq_bitwise.vo 0m00.57s | 54340 ko | coqutil/Datatypes/HList.vo.native 0m00.57s | 99024 ko | coqutil/Datatypes/List.vo.native 0m00.57s | 288536 ko | coqutil/Map/Empty_set_keyed_map.vo 0m00.57s | 311552 ko | coqutil/Map/Funext.vo 0m00.56s | 104332 ko | coqutil/Map/OfListWord.vo.native 0m00.56s | 88000 ko | coqutil/Tactics/ident_of_string.vo.native 0m00.56s | 103836 ko | coqutil/Z/bitblast.vo.native 0m00.55s | 101296 ko | coqutil/Word/Bitwidth.vo.native 0m00.55s | 101360 ko | coqutil/Word/Bitwidth32.vo.native 0m00.55s | 104148 ko | coqutil/Word/SimplWordExpr.vo.native 0m00.53s | 100712 ko | coqutil/Byte.vo.native 0m00.53s | 100992 ko | coqutil/Z/PushPullMod.vo.native 0m00.52s | 99996 ko | coqutil/Z/Lia.vo.native 0m00.51s | 284324 ko | coqutil/Datatypes/Inhabited.vo 0m00.51s | 100544 ko | coqutil/Tactics/Simp.vo.native 0m00.51s | 100016 ko | coqutil/Tactics/Tactics.vo.native 0m00.51s | 88936 ko | coqutil/Tactics/destr.vo.native 0m00.50s | 88688 ko | coqutil/Decidable.vo.native 0m00.50s | 363816 ko | coqutil/Map/SortedListWord.vo 0m00.50s | 102472 ko | coqutil/Word/Bitwidth64.vo.native 0m00.50s | 361320 ko | coqutil/Word/DebugWordEq.vo 0m00.49s | 87608 ko | coqutil/Datatypes/String.vo.native 0m00.49s | 87980 ko | coqutil/Tactics/fwd_core.vo.native 0m00.48s | 87324 ko | coqutil/Macros/ident_to_string.vo.native 0m00.48s | 79096 ko | coqutil/Tactics/fwd_arith_hints.vo.native 0m00.48s | 100668 ko | coqutil/Z/ZLib.vo.native 0m00.47s | 312492 ko | coqutil/Map/SortedListString_test.vo 0m00.47s | 78704 ko | coqutil/Z/div_to_equations.vo.native 0m00.46s | 100708 ko | coqutil/Datatypes/ToConversion.vo.native 0m00.46s | 101892 ko | coqutil/Map/MapEauto.vo.native 0m00.46s | 102724 ko | coqutil/Tactics/fwd_map_hints.vo.native 0m00.45s | 101768 ko | coqutil/Map/MapKeys.vo.native 0m00.44s | 326076 ko | coqutil/Map/Interface.vo 0m00.43s | 392964 ko | coqutil/Map/MapKeys.vo 0m00.43s | 317964 ko | coqutil/Sorting/OrderToPermutation.vo 0m00.42s | 299108 ko | coqutil/Tactics/rewr.vo 0m00.42s | 102696 ko | coqutil/Z/prove_Zeq_bitwise.vo.native 0m00.41s | 278808 ko | coqutil/Tactics/SafeSimpl.vo 0m00.40s | 352920 ko | coqutil/Datatypes/String.vo 0m00.40s | 310528 ko | coqutil/Tactics/fwd_word_hints.vo 0m00.39s | 304396 ko | coqutil/Map/Solver.vo 0m00.39s | 279768 ko | coqutil/Map/SortedListString.vo 0m00.39s | 291400 ko | coqutil/Z/Lia.vo 0m00.38s | 297656 ko | coqutil/Tactics/fwd.vo 0m00.37s | 292180 ko | coqutil/Word/Bitwidth32.vo 0m00.36s | 101432 ko | coqutil/Map/SlowGoals.vo.native 0m00.36s | 295528 ko | coqutil/Tactics/Tactics.vo 0m00.36s | 274956 ko | coqutil/Tactics/fwd_list_hints.vo 0m00.36s | 291996 ko | coqutil/Word/Bitwidth64.vo 0m00.36s | 77596 ko | coqutil/Z/div_mod_to_equations.vo.native 0m00.35s | 269884 ko | coqutil/Decidable.vo 0m00.34s | 301660 ko | coqutil/Datatypes/ToConversion.vo 0m00.34s | 102636 ko | coqutil/Map/TestGoals.vo.native 0m00.33s | 283128 ko | coqutil/Tactics/fwd_map_hints.vo 0m00.32s | 345240 ko | coqutil/Byte.vo 0m00.32s | 293652 ko | coqutil/Tactics/Simp.vo 0m00.32s | 329896 ko | coqutil/Word/Interface.vo 0m00.31s | 214876 ko | coqutil/Tactics/fwd_arith_hints.vo 0m00.31s | 291312 ko | coqutil/Word/Bitwidth.vo 0m00.27s | 29464 ko | coqutil/Datatypes/Prod.vo.native 0m00.27s | 240248 ko | coqutil/Tactics/fwd_core.vo 0m00.26s | 27288 ko | coqutil/Datatypes/Option.vo.native 0m00.24s | 56896 ko | coqutil/Sorting/Permutation.vo.native 0m00.24s | 208528 ko | coqutil/Z/div_mod_to_equations.vo 0m00.23s | 227492 ko | coqutil/Macros/ident_to_string.vo 0m00.23s | 54316 ko | coqutil/Tactics/Records.vo.native 0m00.21s | 174320 ko | coqutil/Datatypes/HList.vo 0m00.21s | 221288 ko | coqutil/Tactics/destr.vo 0m00.18s | 201096 ko | coqutil/Z/div_to_equations.vo 0m00.17s | 138328 ko | coqutil/Sorting/Permutation.vo 0m00.17s | 149096 ko | coqutil/Tactics/Records.vo 0m00.14s | 109820 ko | coqutil/Datatypes/Option.vo 0m00.11s | 23276 ko | coqutil/Ltac2Lib/Log.vo.native 0m00.10s | 22064 ko | coqutil/Macros/subst.vo.native 0m00.10s | 22936 ko | coqutil/Macros/symmetry.vo.native 0m00.10s | 21952 ko | coqutil/Macros/unique.vo.native 0m00.10s | 73372 ko | coqutil/Tactics/ParamRecords.vo 0m00.10s | 79672 ko | coqutil/Tactics/eplace.vo 0m00.10s | 22032 ko | coqutil/Tactics/ltac_list_ops.vo.native 0m00.09s | 73944 ko | coqutil/Macros/symmetry.vo 0m00.09s | 22416 ko | coqutil/Tactics/fwd_bool_hints.vo.native 0m00.09s | 65792 ko | coqutil/Tactics/simpl_rewrite.vo 0m00.08s | 94084 ko | coqutil/Datatypes/Prod.vo 0m00.08s | 71232 ko | coqutil/Ltac2Lib/Log.vo 0m00.08s | 63624 ko | coqutil/Tactics/eabstract.vo 0m00.08s | 22032 ko | coqutil/Tactics/eabstract.vo.native 0m00.08s | 22228 ko | coqutil/Tactics/forward.vo.native 0m00.08s | 63820 ko | coqutil/Tactics/rdelta.vo 0m00.08s | 22092 ko | coqutil/Tactics/syntactic_unify.vo.native 0m00.07s | 23256 ko | coqutil/Ltac2Lib/Constr.vo.native 0m00.07s | 22004 ko | coqutil/Tactics/autoforward.vo.native 0m00.07s | 22100 ko | coqutil/Tactics/eplace.vo.native 0m00.07s | 65820 ko | coqutil/Tactics/fwd_bool_hints.vo 0m00.07s | 65508 ko | coqutil/Tactics/ltac_list_ops.vo 0m00.07s | 21888 ko | coqutil/dlet.vo.native 0m00.06s | 66532 ko | coqutil/Datatypes/PrimitivePair.vo 0m00.06s | 22040 ko | coqutil/Datatypes/PrimitivePair.vo.native 0m00.06s | 23220 ko | coqutil/Ltac2Lib/Msg.vo.native 0m00.06s | 64172 ko | coqutil/Tactics/letexists.vo 0m00.06s | 22076 ko | coqutil/Tactics/rdelta.vo.native 0m00.06s | 22100 ko | coqutil/Tactics/simpl_rewrite.vo.native 0m00.06s | 65768 ko | coqutil/Tactics/syntactic_unify.vo 0m00.06s | 63768 ko | coqutil/dlet.vo 0m00.06s | 64964 ko | coqutil/sanity.vo 0m00.05s | 69124 ko | coqutil/Ltac2Lib/Msg.vo 0m00.05s | 63844 ko | coqutil/Macros/subst.vo 0m00.05s | 63500 ko | coqutil/Macros/unique.vo 0m00.05s | 64908 ko | coqutil/Tactics/autoforward.vo 0m00.05s | 68064 ko | coqutil/Tactics/forward.vo 0m00.05s | 22024 ko | coqutil/Tactics/letexists.vo.native 0m00.04s | 71420 ko | coqutil/Ltac2Lib/Constr.vo 0m00.04s | 23244 ko | coqutil/Tactics/ParamRecords.vo.native 0m00.04s | 21960 ko | coqutil/sanity.vo.native time-of-build-pretty-user.log.expected000066400000000000000000000276641466560755400336710ustar00rootroot00000000000000coq-8.20.0/test-suite/precomputed-time-tests/strip-leading-pwd Time | Peak Mem | File Name ---------------------------------------------------------------------- 2m02.85s | 575776 ko | Total Time / Peak Mem ---------------------------------------------------------------------- 0m16.08s | 435484 ko | coqutil/Map/TestGoals.vo 0m08.38s | 575776 ko | coqutil/Word/Properties.vo 0m06.40s | 452836 ko | coqutil/Map/Properties.vo 0m06.20s | 444256 ko | coqutil/Tactics/ident_of_string.vo 0m04.95s | 413708 ko | coqutil/Map/SlowGoals.vo 0m04.85s | 434980 ko | coqutil/Datatypes/List.vo 0m02.50s | 421756 ko | coqutil/Word/LittleEndianList.vo 0m02.23s | 406924 ko | coqutil/Datatypes/PropSet.vo 0m02.22s | 420764 ko | coqutil/Map/MapEauto.vo 0m01.65s | 420928 ko | coqutil/Word/LittleEndian.vo 0m01.45s | 417760 ko | coqutil/Word/BigEndian.vo 0m01.39s | 416228 ko | coqutil/Z/BitOps.vo 0m01.28s | 418272 ko | coqutil/Map/SortedList.vo 0m01.09s | 415560 ko | coqutil/Datatypes/OperatorOverloading.vo 0m01.05s | 102644 ko | coqutil/Map/Interface.vo.native 0m01.03s | 407636 ko | coqutil/Z/PushPullMod.vo 0m00.97s | 415948 ko | coqutil/Datatypes/ListSet.vo 0m00.95s | 103212 ko | coqutil/Datatypes/OperatorOverloading.vo.native 0m00.94s | 78484 ko | coqutil/Word/Interface.vo.native 0m00.92s | 414256 ko | coqutil/Z/bitblast.vo 0m00.89s | 101560 ko | coqutil/Sorting/OrderToPermutation.vo.native 0m00.88s | 102424 ko | coqutil/Map/SortedList.vo.native 0m00.85s | 101692 ko | coqutil/Datatypes/Inhabited.vo.native 0m00.84s | 103096 ko | coqutil/Map/Empty_set_keyed_map.vo.native 0m00.80s | 102372 ko | coqutil/Map/Funext.vo.native 0m00.78s | 412576 ko | coqutil/Word/Naive.vo 0m00.78s | 408248 ko | coqutil/Z/ZLib.vo 0m00.77s | 100032 ko | coqutil/Map/Properties.vo.native 0m00.75s | 417728 ko | coqutil/Map/OfFunc.vo 0m00.74s | 421844 ko | coqutil/Map/OfListWord.vo 0m00.74s | 419828 ko | coqutil/Word/ZifyLittleEndian.vo 0m00.73s | 104180 ko | coqutil/Tactics/fwd_word_hints.vo.native 0m00.72s | 103220 ko | coqutil/Map/SortedListString.vo.native 0m00.72s | 103964 ko | coqutil/Map/Z_keyed_SortedListMap.vo.native 0m00.69s | 102576 ko | coqutil/Tactics/SafeSimpl.vo.native 0m00.69s | 102316 ko | coqutil/Word/Naive.vo.native 0m00.66s | 101836 ko | coqutil/Datatypes/ListSet.vo.native 0m00.66s | 103320 ko | coqutil/Word/Properties.vo.native 0m00.66s | 104132 ko | coqutil/Word/ZifyLittleEndian.vo.native 0m00.64s | 104208 ko | coqutil/Tactics/fwd.vo.native 0m00.64s | 419144 ko | coqutil/Word/SimplWordExpr.vo 0m00.63s | 101324 ko | coqutil/Map/OfFunc.vo.native 0m00.63s | 104700 ko | coqutil/Map/Solver.vo.native 0m00.63s | 104004 ko | coqutil/Word/LittleEndianList.vo.native 0m00.63s | 102316 ko | coqutil/Z/BitOps.vo.native 0m00.62s | 104040 ko | coqutil/Map/SortedListWord.vo.native 0m00.62s | 101924 ko | coqutil/Tactics/fwd_list_hints.vo.native 0m00.62s | 101904 ko | coqutil/Tactics/rewr.vo.native 0m00.61s | 101844 ko | coqutil/Datatypes/PropSet.vo.native 0m00.60s | 103528 ko | coqutil/Map/SortedListString_test.vo.native 0m00.60s | 104064 ko | coqutil/Word/LittleEndian.vo.native 0m00.59s | 103836 ko | coqutil/Word/BigEndian.vo.native 0m00.58s | 319092 ko | coqutil/Map/Z_keyed_SortedListMap.vo 0m00.58s | 103300 ko | coqutil/Word/DebugWordEq.vo.native 0m00.58s | 413136 ko | coqutil/Z/prove_Zeq_bitwise.vo 0m00.57s | 54340 ko | coqutil/Datatypes/HList.vo.native 0m00.57s | 99024 ko | coqutil/Datatypes/List.vo.native 0m00.57s | 288536 ko | coqutil/Map/Empty_set_keyed_map.vo 0m00.57s | 311552 ko | coqutil/Map/Funext.vo 0m00.56s | 104332 ko | coqutil/Map/OfListWord.vo.native 0m00.56s | 88000 ko | coqutil/Tactics/ident_of_string.vo.native 0m00.56s | 103836 ko | coqutil/Z/bitblast.vo.native 0m00.55s | 101296 ko | coqutil/Word/Bitwidth.vo.native 0m00.55s | 101360 ko | coqutil/Word/Bitwidth32.vo.native 0m00.55s | 104148 ko | coqutil/Word/SimplWordExpr.vo.native 0m00.53s | 100712 ko | coqutil/Byte.vo.native 0m00.53s | 100992 ko | coqutil/Z/PushPullMod.vo.native 0m00.52s | 99996 ko | coqutil/Z/Lia.vo.native 0m00.51s | 284324 ko | coqutil/Datatypes/Inhabited.vo 0m00.51s | 100544 ko | coqutil/Tactics/Simp.vo.native 0m00.51s | 100016 ko | coqutil/Tactics/Tactics.vo.native 0m00.51s | 88936 ko | coqutil/Tactics/destr.vo.native 0m00.50s | 88688 ko | coqutil/Decidable.vo.native 0m00.50s | 363816 ko | coqutil/Map/SortedListWord.vo 0m00.50s | 102472 ko | coqutil/Word/Bitwidth64.vo.native 0m00.50s | 361320 ko | coqutil/Word/DebugWordEq.vo 0m00.49s | 87608 ko | coqutil/Datatypes/String.vo.native 0m00.49s | 87980 ko | coqutil/Tactics/fwd_core.vo.native 0m00.48s | 87324 ko | coqutil/Macros/ident_to_string.vo.native 0m00.48s | 79096 ko | coqutil/Tactics/fwd_arith_hints.vo.native 0m00.48s | 100668 ko | coqutil/Z/ZLib.vo.native 0m00.47s | 312492 ko | coqutil/Map/SortedListString_test.vo 0m00.47s | 78704 ko | coqutil/Z/div_to_equations.vo.native 0m00.46s | 100708 ko | coqutil/Datatypes/ToConversion.vo.native 0m00.46s | 101892 ko | coqutil/Map/MapEauto.vo.native 0m00.46s | 102724 ko | coqutil/Tactics/fwd_map_hints.vo.native 0m00.45s | 101768 ko | coqutil/Map/MapKeys.vo.native 0m00.44s | 326076 ko | coqutil/Map/Interface.vo 0m00.43s | 392964 ko | coqutil/Map/MapKeys.vo 0m00.43s | 317964 ko | coqutil/Sorting/OrderToPermutation.vo 0m00.42s | 299108 ko | coqutil/Tactics/rewr.vo 0m00.42s | 102696 ko | coqutil/Z/prove_Zeq_bitwise.vo.native 0m00.41s | 278808 ko | coqutil/Tactics/SafeSimpl.vo 0m00.40s | 352920 ko | coqutil/Datatypes/String.vo 0m00.40s | 310528 ko | coqutil/Tactics/fwd_word_hints.vo 0m00.39s | 304396 ko | coqutil/Map/Solver.vo 0m00.39s | 279768 ko | coqutil/Map/SortedListString.vo 0m00.39s | 291400 ko | coqutil/Z/Lia.vo 0m00.38s | 297656 ko | coqutil/Tactics/fwd.vo 0m00.37s | 292180 ko | coqutil/Word/Bitwidth32.vo 0m00.36s | 101432 ko | coqutil/Map/SlowGoals.vo.native 0m00.36s | 295528 ko | coqutil/Tactics/Tactics.vo 0m00.36s | 274956 ko | coqutil/Tactics/fwd_list_hints.vo 0m00.36s | 291996 ko | coqutil/Word/Bitwidth64.vo 0m00.36s | 77596 ko | coqutil/Z/div_mod_to_equations.vo.native 0m00.35s | 269884 ko | coqutil/Decidable.vo 0m00.34s | 301660 ko | coqutil/Datatypes/ToConversion.vo 0m00.34s | 102636 ko | coqutil/Map/TestGoals.vo.native 0m00.33s | 283128 ko | coqutil/Tactics/fwd_map_hints.vo 0m00.32s | 345240 ko | coqutil/Byte.vo 0m00.32s | 293652 ko | coqutil/Tactics/Simp.vo 0m00.32s | 329896 ko | coqutil/Word/Interface.vo 0m00.31s | 214876 ko | coqutil/Tactics/fwd_arith_hints.vo 0m00.31s | 291312 ko | coqutil/Word/Bitwidth.vo 0m00.27s | 29464 ko | coqutil/Datatypes/Prod.vo.native 0m00.27s | 240248 ko | coqutil/Tactics/fwd_core.vo 0m00.26s | 27288 ko | coqutil/Datatypes/Option.vo.native 0m00.24s | 56896 ko | coqutil/Sorting/Permutation.vo.native 0m00.24s | 208528 ko | coqutil/Z/div_mod_to_equations.vo 0m00.23s | 227492 ko | coqutil/Macros/ident_to_string.vo 0m00.23s | 54316 ko | coqutil/Tactics/Records.vo.native 0m00.21s | 174320 ko | coqutil/Datatypes/HList.vo 0m00.21s | 221288 ko | coqutil/Tactics/destr.vo 0m00.18s | 201096 ko | coqutil/Z/div_to_equations.vo 0m00.17s | 138328 ko | coqutil/Sorting/Permutation.vo 0m00.17s | 149096 ko | coqutil/Tactics/Records.vo 0m00.14s | 109820 ko | coqutil/Datatypes/Option.vo 0m00.11s | 23276 ko | coqutil/Ltac2Lib/Log.vo.native 0m00.10s | 22064 ko | coqutil/Macros/subst.vo.native 0m00.10s | 22936 ko | coqutil/Macros/symmetry.vo.native 0m00.10s | 21952 ko | coqutil/Macros/unique.vo.native 0m00.10s | 73372 ko | coqutil/Tactics/ParamRecords.vo 0m00.10s | 79672 ko | coqutil/Tactics/eplace.vo 0m00.10s | 22032 ko | coqutil/Tactics/ltac_list_ops.vo.native 0m00.09s | 73944 ko | coqutil/Macros/symmetry.vo 0m00.09s | 22416 ko | coqutil/Tactics/fwd_bool_hints.vo.native 0m00.09s | 65792 ko | coqutil/Tactics/simpl_rewrite.vo 0m00.08s | 94084 ko | coqutil/Datatypes/Prod.vo 0m00.08s | 71232 ko | coqutil/Ltac2Lib/Log.vo 0m00.08s | 63624 ko | coqutil/Tactics/eabstract.vo 0m00.08s | 22032 ko | coqutil/Tactics/eabstract.vo.native 0m00.08s | 22228 ko | coqutil/Tactics/forward.vo.native 0m00.08s | 63820 ko | coqutil/Tactics/rdelta.vo 0m00.08s | 22092 ko | coqutil/Tactics/syntactic_unify.vo.native 0m00.07s | 23256 ko | coqutil/Ltac2Lib/Constr.vo.native 0m00.07s | 22004 ko | coqutil/Tactics/autoforward.vo.native 0m00.07s | 22100 ko | coqutil/Tactics/eplace.vo.native 0m00.07s | 65820 ko | coqutil/Tactics/fwd_bool_hints.vo 0m00.07s | 65508 ko | coqutil/Tactics/ltac_list_ops.vo 0m00.07s | 21888 ko | coqutil/dlet.vo.native 0m00.06s | 66532 ko | coqutil/Datatypes/PrimitivePair.vo 0m00.06s | 22040 ko | coqutil/Datatypes/PrimitivePair.vo.native 0m00.06s | 23220 ko | coqutil/Ltac2Lib/Msg.vo.native 0m00.06s | 64172 ko | coqutil/Tactics/letexists.vo 0m00.06s | 22076 ko | coqutil/Tactics/rdelta.vo.native 0m00.06s | 22100 ko | coqutil/Tactics/simpl_rewrite.vo.native 0m00.06s | 65768 ko | coqutil/Tactics/syntactic_unify.vo 0m00.06s | 63768 ko | coqutil/dlet.vo 0m00.06s | 64964 ko | coqutil/sanity.vo 0m00.05s | 69124 ko | coqutil/Ltac2Lib/Msg.vo 0m00.05s | 63844 ko | coqutil/Macros/subst.vo 0m00.05s | 63500 ko | coqutil/Macros/unique.vo 0m00.05s | 64908 ko | coqutil/Tactics/autoforward.vo 0m00.05s | 68064 ko | coqutil/Tactics/forward.vo 0m00.05s | 22024 ko | coqutil/Tactics/letexists.vo.native 0m00.04s | 71420 ko | coqutil/Ltac2Lib/Constr.vo 0m00.04s | 23244 ko | coqutil/Tactics/ParamRecords.vo.native 0m00.04s | 21960 ko | coqutil/sanity.vo.native coq-8.20.0/test-suite/precomputed-time-tests/strip-leading-pwd/time-of-build.log.in000066400000000000000000000754451466560755400302540ustar00rootroot00000000000000printf -- '-R $PWD/src/coqutil/ coqutil\n-arg -w -arg unsupported-attributes\n' > _CoqProject Generating Makefile.coq.all make -f Makefile.coq.all make[1]: Entering directory '/home/jgross/Documents/GitHub/coqutil' COQDEP VFILES make[1]: Leaving directory '/home/jgross/Documents/GitHub/coqutil' COQC $PWD/src/coqutil/Byte.v COQC $PWD/src/coqutil/sanity.v COQC $PWD/src/coqutil/Tactics/autoforward.v COQC $PWD/src/coqutil/dlet.v COQC $PWD/src/coqutil/Ltac2Lib/Constr.v COQC $PWD/src/coqutil/Ltac2Lib/Msg.v $PWD/src/coqutil/dlet.vo (real: 0.08, user: 0.06, sys: 0.01, mem: 63768 ko) COQNATIVE $PWD/src/coqutil/dlet.vo $PWD/src/coqutil/Tactics/autoforward.vo (real: 0.09, user: 0.05, sys: 0.03, mem: 64908 ko) $PWD/src/coqutil/sanity.vo (real: 0.09, user: 0.06, sys: 0.02, mem: 64964 ko) COQNATIVE $PWD/src/coqutil/Tactics/autoforward.vo COQNATIVE $PWD/src/coqutil/sanity.vo $PWD/src/coqutil/Ltac2Lib/Msg.vo (real: 0.09, user: 0.05, sys: 0.03, mem: 69124 ko) COQNATIVE $PWD/src/coqutil/Ltac2Lib/Msg.vo $PWD/src/coqutil/Ltac2Lib/Constr.vo (real: 0.09, user: 0.04, sys: 0.04, mem: 71420 ko) COQNATIVE $PWD/src/coqutil/Ltac2Lib/Constr.vo $PWD/src/coqutil/Ltac2Lib/Msg.vo.native (real: 0.16, user: 0.06, sys: 0.02, mem: 23220 ko) COQC $PWD/src/coqutil/Ltac2Lib/Log.v $PWD/src/coqutil/dlet.vo.native (real: 0.18, user: 0.07, sys: 0.01, mem: 21888 ko) $PWD/src/coqutil/Tactics/autoforward.vo.native (real: 0.17, user: 0.07, sys: 0.01, mem: 22004 ko) $PWD/src/coqutil/sanity.vo.native (real: 0.17, user: 0.04, sys: 0.04, mem: 21960 ko) $PWD/src/coqutil/Ltac2Lib/Constr.vo.native (real: 0.17, user: 0.07, sys: 0.01, mem: 23256 ko) COQC $PWD/src/coqutil/Macros/unique.v COQC $PWD/src/coqutil/Macros/subst.v COQC $PWD/src/coqutil/Macros/ident_to_string.v COQC $PWD/src/coqutil/Tactics/forward.v $PWD/src/coqutil/Macros/unique.vo (real: 0.09, user: 0.05, sys: 0.03, mem: 63500 ko) $PWD/src/coqutil/Macros/subst.vo (real: 0.09, user: 0.05, sys: 0.03, mem: 63844 ko) COQNATIVE $PWD/src/coqutil/Macros/unique.vo COQNATIVE $PWD/src/coqutil/Macros/subst.vo $PWD/src/coqutil/Tactics/forward.vo (real: 0.10, user: 0.05, sys: 0.04, mem: 68064 ko) $PWD/src/coqutil/Ltac2Lib/Log.vo (real: 0.11, user: 0.08, sys: 0.03, mem: 71232 ko) COQNATIVE $PWD/src/coqutil/Tactics/forward.vo COQNATIVE $PWD/src/coqutil/Ltac2Lib/Log.vo $PWD/src/coqutil/Macros/subst.vo.native (real: 0.18, user: 0.10, sys: 0.01, mem: 22064 ko) $PWD/src/coqutil/Macros/unique.vo.native (real: 0.18, user: 0.10, sys: 0.01, mem: 21952 ko) $PWD/src/coqutil/Tactics/forward.vo.native (real: 0.17, user: 0.08, sys: 0.01, mem: 22228 ko) COQC $PWD/src/coqutil/Z/Lia.v COQC $PWD/src/coqutil/Datatypes/Option.v COQC $PWD/src/coqutil/Sorting/Permutation.v $PWD/src/coqutil/Byte.vo (real: 0.59, user: 0.32, sys: 0.10, mem: 345240 ko) COQNATIVE $PWD/src/coqutil/Byte.vo $PWD/src/coqutil/Ltac2Lib/Log.vo.native (real: 0.21, user: 0.11, sys: 0.01, mem: 23276 ko) COQC $PWD/src/coqutil/Datatypes/PrimitivePair.v $PWD/src/coqutil/Macros/ident_to_string.vo (real: 0.33, user: 0.23, sys: 0.08, mem: 227492 ko) COQNATIVE $PWD/src/coqutil/Macros/ident_to_string.vo $PWD/src/coqutil/Datatypes/PrimitivePair.vo (real: 0.10, user: 0.06, sys: 0.03, mem: 66532 ko) COQNATIVE $PWD/src/coqutil/Datatypes/PrimitivePair.vo $PWD/src/coqutil/Datatypes/Option.vo (real: 0.15, user: 0.14, sys: 0.01, mem: 109820 ko) COQNATIVE $PWD/src/coqutil/Datatypes/Option.vo $PWD/src/coqutil/Sorting/Permutation.vo (real: 0.20, user: 0.17, sys: 0.03, mem: 138328 ko) COQNATIVE $PWD/src/coqutil/Sorting/Permutation.vo $PWD/src/coqutil/Datatypes/PrimitivePair.vo.native (real: 0.19, user: 0.06, sys: 0.03, mem: 22040 ko) COQC $PWD/src/coqutil/Word/Interface.v $PWD/src/coqutil/Datatypes/Option.vo.native (real: 0.43, user: 0.26, sys: 0.07, mem: 27288 ko) COQC $PWD/src/coqutil/Datatypes/Prod.v $PWD/src/coqutil/Z/Lia.vo (real: 0.60, user: 0.39, sys: 0.06, mem: 291400 ko) COQNATIVE $PWD/src/coqutil/Z/Lia.vo $PWD/src/coqutil/Sorting/Permutation.vo.native (real: 0.40, user: 0.24, sys: 0.05, mem: 56896 ko) COQC $PWD/src/coqutil/Z/div_mod_to_equations.v $PWD/src/coqutil/Macros/ident_to_string.vo.native (real: 0.67, user: 0.48, sys: 0.06, mem: 87324 ko) COQC $PWD/src/coqutil/Z/PushPullMod.v $PWD/src/coqutil/Datatypes/Prod.vo (real: 0.13, user: 0.08, sys: 0.04, mem: 94084 ko) COQNATIVE $PWD/src/coqutil/Datatypes/Prod.vo $PWD/src/coqutil/Byte.vo.native (real: 0.74, user: 0.53, sys: 0.07, mem: 100712 ko) COQC $PWD/src/coqutil/Tactics/fwd_bool_hints.v $PWD/src/coqutil/Word/Interface.vo (real: 0.43, user: 0.32, sys: 0.10, mem: 329896 ko) COQNATIVE $PWD/src/coqutil/Word/Interface.vo $PWD/src/coqutil/Tactics/fwd_bool_hints.vo (real: 0.10, user: 0.07, sys: 0.02, mem: 65820 ko) COQNATIVE $PWD/src/coqutil/Tactics/fwd_bool_hints.vo $PWD/src/coqutil/Z/div_mod_to_equations.vo (real: 0.29, user: 0.24, sys: 0.04, mem: 208528 ko) COQNATIVE $PWD/src/coqutil/Z/div_mod_to_equations.vo $PWD/src/coqutil/Tactics/fwd_bool_hints.vo.native (real: 0.20, user: 0.09, sys: 0.01, mem: 22416 ko) COQC $PWD/src/coqutil/Tactics/eabstract.v $PWD/src/coqutil/Tactics/eabstract.vo (real: 0.11, user: 0.08, sys: 0.03, mem: 63624 ko) COQNATIVE $PWD/src/coqutil/Tactics/eabstract.vo $PWD/src/coqutil/Datatypes/Prod.vo.native (real: 0.47, user: 0.27, sys: 0.08, mem: 29464 ko) COQC $PWD/src/coqutil/Tactics/fwd_arith_hints.v $PWD/src/coqutil/Z/Lia.vo.native (real: 0.68, user: 0.52, sys: 0.05, mem: 99996 ko) COQC $PWD/src/coqutil/Tactics/simpl_rewrite.v $PWD/src/coqutil/Tactics/simpl_rewrite.vo (real: 0.13, user: 0.09, sys: 0.04, mem: 65792 ko) COQNATIVE $PWD/src/coqutil/Tactics/simpl_rewrite.vo $PWD/src/coqutil/Tactics/eabstract.vo.native (real: 0.25, user: 0.08, sys: 0.03, mem: 22032 ko) COQC $PWD/src/coqutil/Tactics/rdelta.v $PWD/src/coqutil/Z/div_mod_to_equations.vo.native (real: 0.63, user: 0.36, sys: 0.14, mem: 77596 ko) COQC $PWD/src/coqutil/Tactics/syntactic_unify.v $PWD/src/coqutil/Tactics/rdelta.vo (real: 0.14, user: 0.08, sys: 0.05, mem: 63820 ko) COQNATIVE $PWD/src/coqutil/Tactics/rdelta.vo $PWD/src/coqutil/Tactics/fwd_arith_hints.vo (real: 0.40, user: 0.31, sys: 0.09, mem: 214876 ko) COQNATIVE $PWD/src/coqutil/Tactics/fwd_arith_hints.vo $PWD/src/coqutil/Tactics/syntactic_unify.vo (real: 0.14, user: 0.06, sys: 0.08, mem: 65768 ko) COQNATIVE $PWD/src/coqutil/Tactics/syntactic_unify.vo $PWD/src/coqutil/Tactics/simpl_rewrite.vo.native (real: 0.29, user: 0.06, sys: 0.06, mem: 22100 ko) COQC $PWD/src/coqutil/Tactics/ident_of_string.v $PWD/src/coqutil/Tactics/rdelta.vo.native (real: 0.23, user: 0.06, sys: 0.05, mem: 22076 ko) COQC $PWD/src/coqutil/Tactics/ParamRecords.v $PWD/src/coqutil/Tactics/syntactic_unify.vo.native (real: 0.21, user: 0.08, sys: 0.02, mem: 22092 ko) COQC $PWD/src/coqutil/Tactics/eplace.v $PWD/src/coqutil/Word/Interface.vo.native (real: 1.19, user: 0.94, sys: 0.12, mem: 78484 ko) COQC $PWD/src/coqutil/Tactics/letexists.v $PWD/src/coqutil/Tactics/ParamRecords.vo (real: 0.13, user: 0.10, sys: 0.02, mem: 73372 ko) COQNATIVE $PWD/src/coqutil/Tactics/ParamRecords.vo $PWD/src/coqutil/Z/PushPullMod.vo (real: 1.27, user: 1.03, sys: 0.09, mem: 407636 ko) COQNATIVE $PWD/src/coqutil/Z/PushPullMod.vo $PWD/src/coqutil/Tactics/eplace.vo (real: 0.12, user: 0.10, sys: 0.00, mem: 79672 ko) COQNATIVE $PWD/src/coqutil/Tactics/eplace.vo $PWD/src/coqutil/Tactics/letexists.vo (real: 0.09, user: 0.06, sys: 0.02, mem: 64172 ko) COQNATIVE $PWD/src/coqutil/Tactics/letexists.vo $PWD/src/coqutil/Tactics/eplace.vo.native (real: 0.16, user: 0.07, sys: 0.02, mem: 22100 ko) COQC $PWD/src/coqutil/Tactics/Simp.v $PWD/src/coqutil/Tactics/ParamRecords.vo.native (real: 0.22, user: 0.04, sys: 0.06, mem: 23244 ko) COQC $PWD/src/coqutil/Z/div_to_equations.v $PWD/src/coqutil/Tactics/fwd_arith_hints.vo.native (real: 0.59, user: 0.48, sys: 0.04, mem: 79096 ko) COQC $PWD/src/coqutil/Decidable.v $PWD/src/coqutil/Tactics/letexists.vo.native (real: 0.19, user: 0.05, sys: 0.04, mem: 22024 ko) COQC $PWD/src/coqutil/Macros/symmetry.v $PWD/src/coqutil/Macros/symmetry.vo (real: 0.12, user: 0.09, sys: 0.02, mem: 73944 ko) COQNATIVE $PWD/src/coqutil/Macros/symmetry.vo $PWD/src/coqutil/Z/div_to_equations.vo (real: 0.32, user: 0.18, sys: 0.13, mem: 201096 ko) COQNATIVE $PWD/src/coqutil/Z/div_to_equations.vo $PWD/src/coqutil/Macros/symmetry.vo.native (real: 0.24, user: 0.10, sys: 0.01, mem: 22936 ko) COQC $PWD/src/coqutil/Datatypes/HList.v $PWD/src/coqutil/Decidable.vo (real: 0.44, user: 0.35, sys: 0.08, mem: 269884 ko) COQNATIVE $PWD/src/coqutil/Decidable.vo $PWD/src/coqutil/Z/PushPullMod.vo.native (real: 0.70, user: 0.53, sys: 0.05, mem: 100992 ko) COQC $PWD/src/coqutil/Datatypes/ToConversion.v $PWD/src/coqutil/Tactics/Simp.vo (real: 0.66, user: 0.32, sys: 0.18, mem: 293652 ko) COQNATIVE $PWD/src/coqutil/Tactics/Simp.vo $PWD/src/coqutil/Datatypes/HList.vo (real: 0.24, user: 0.21, sys: 0.03, mem: 174320 ko) COQNATIVE $PWD/src/coqutil/Datatypes/HList.vo $PWD/src/coqutil/Z/div_to_equations.vo.native (real: 0.64, user: 0.47, sys: 0.05, mem: 78704 ko) COQC $PWD/src/coqutil/Word/Bitwidth.v $PWD/src/coqutil/Datatypes/ToConversion.vo (real: 0.65, user: 0.34, sys: 0.14, mem: 301660 ko) COQNATIVE $PWD/src/coqutil/Datatypes/ToConversion.vo $PWD/src/coqutil/Decidable.vo.native (real: 0.72, user: 0.50, sys: 0.10, mem: 88688 ko) COQC $PWD/src/coqutil/Z/bitblast.v $PWD/src/coqutil/Tactics/Simp.vo.native (real: 0.73, user: 0.51, sys: 0.12, mem: 100544 ko) COQC $PWD/src/coqutil/Z/ZLib.v $PWD/src/coqutil/Datatypes/HList.vo.native (real: 0.75, user: 0.57, sys: 0.08, mem: 54340 ko) COQC $PWD/src/coqutil/Tactics/ltac_list_ops.v $PWD/src/coqutil/Tactics/ltac_list_ops.vo (real: 0.13, user: 0.07, sys: 0.05, mem: 65508 ko) COQNATIVE $PWD/src/coqutil/Tactics/ltac_list_ops.vo $PWD/src/coqutil/Word/Bitwidth.vo (real: 0.61, user: 0.31, sys: 0.15, mem: 291312 ko) COQNATIVE $PWD/src/coqutil/Word/Bitwidth.vo $PWD/src/coqutil/Tactics/ltac_list_ops.vo.native (real: 0.20, user: 0.10, sys: 0.01, mem: 22032 ko) COQC $PWD/src/coqutil/Tactics/destr.v $PWD/src/coqutil/Datatypes/ToConversion.vo.native (real: 0.65, user: 0.46, sys: 0.10, mem: 100708 ko) COQC $PWD/src/coqutil/Datatypes/String.v $PWD/src/coqutil/Tactics/destr.vo (real: 0.39, user: 0.21, sys: 0.18, mem: 221288 ko) COQNATIVE $PWD/src/coqutil/Tactics/destr.vo $PWD/src/coqutil/Z/bitblast.vo (real: 1.15, user: 0.92, sys: 0.07, mem: 414256 ko) COQNATIVE $PWD/src/coqutil/Z/bitblast.vo $PWD/src/coqutil/Datatypes/String.vo (real: 0.54, user: 0.40, sys: 0.14, mem: 352920 ko) COQNATIVE $PWD/src/coqutil/Datatypes/String.vo $PWD/src/coqutil/Word/Bitwidth.vo.native (real: 0.76, user: 0.55, sys: 0.08, mem: 101296 ko) COQC $PWD/src/coqutil/Tactics/Records.v $PWD/src/coqutil/Z/ZLib.vo (real: 1.09, user: 0.78, sys: 0.16, mem: 408248 ko) COQNATIVE $PWD/src/coqutil/Z/ZLib.vo $PWD/src/coqutil/Tactics/Records.vo (real: 0.20, user: 0.17, sys: 0.03, mem: 149096 ko) COQNATIVE $PWD/src/coqutil/Tactics/Records.vo $PWD/src/coqutil/Tactics/destr.vo.native (real: 0.67, user: 0.51, sys: 0.05, mem: 88936 ko) COQC $PWD/src/coqutil/Tactics/Tactics.v $PWD/src/coqutil/Tactics/Records.vo.native (real: 0.43, user: 0.23, sys: 0.09, mem: 54316 ko) COQC $PWD/src/coqutil/Word/Bitwidth32.v $PWD/src/coqutil/Datatypes/String.vo.native (real: 0.69, user: 0.49, sys: 0.09, mem: 87608 ko) $PWD/src/coqutil/Z/bitblast.vo.native (real: 0.71, user: 0.56, sys: 0.05, mem: 103836 ko) COQC $PWD/src/coqutil/Word/Bitwidth64.v COQC $PWD/src/coqutil/Tactics/fwd_core.v $PWD/src/coqutil/Z/ZLib.vo.native (real: 0.71, user: 0.48, sys: 0.12, mem: 100668 ko) COQC $PWD/src/coqutil/Word/Properties.v $PWD/src/coqutil/Tactics/fwd_core.vo (real: 0.34, user: 0.27, sys: 0.06, mem: 240248 ko) COQNATIVE $PWD/src/coqutil/Tactics/fwd_core.vo $PWD/src/coqutil/Tactics/Tactics.vo (real: 0.60, user: 0.36, sys: 0.07, mem: 295528 ko) COQNATIVE $PWD/src/coqutil/Tactics/Tactics.vo $PWD/src/coqutil/Word/Bitwidth32.vo (real: 0.63, user: 0.37, sys: 0.08, mem: 292180 ko) COQNATIVE $PWD/src/coqutil/Word/Bitwidth32.vo $PWD/src/coqutil/Word/Bitwidth64.vo (real: 0.63, user: 0.36, sys: 0.10, mem: 291996 ko) COQNATIVE $PWD/src/coqutil/Word/Bitwidth64.vo $PWD/src/coqutil/Tactics/fwd_core.vo.native (real: 0.67, user: 0.49, sys: 0.08, mem: 87980 ko) COQC $PWD/src/coqutil/Z/BitOps.v $PWD/src/coqutil/Tactics/Tactics.vo.native (real: 0.69, user: 0.51, sys: 0.07, mem: 100016 ko) COQC $PWD/src/coqutil/Datatypes/PropSet.v $PWD/src/coqutil/Word/Bitwidth32.vo.native (real: 0.78, user: 0.55, sys: 0.09, mem: 101360 ko) COQC $PWD/src/coqutil/Datatypes/List.v $PWD/src/coqutil/Word/Bitwidth64.vo.native (real: 0.80, user: 0.50, sys: 0.13, mem: 102472 ko) COQC $PWD/src/coqutil/Tactics/SafeSimpl.v $PWD/src/coqutil/Tactics/SafeSimpl.vo (real: 0.79, user: 0.41, sys: 0.18, mem: 278808 ko) COQNATIVE $PWD/src/coqutil/Tactics/SafeSimpl.vo $PWD/src/coqutil/Tactics/ident_of_string.vo (real: 6.32, user: 6.20, sys: 0.11, mem: 444256 ko) COQNATIVE $PWD/src/coqutil/Tactics/ident_of_string.vo $PWD/src/coqutil/Z/BitOps.vo (real: 1.76, user: 1.39, sys: 0.19, mem: 416228 ko) COQNATIVE $PWD/src/coqutil/Z/BitOps.vo $PWD/src/coqutil/Tactics/SafeSimpl.vo.native (real: 0.87, user: 0.69, sys: 0.07, mem: 102576 ko) $PWD/src/coqutil/Tactics/ident_of_string.vo.native (real: 0.77, user: 0.56, sys: 0.08, mem: 88000 ko) $PWD/src/coqutil/Z/BitOps.vo.native (real: 0.80, user: 0.63, sys: 0.05, mem: 102316 ko) COQC $PWD/src/coqutil/Z/prove_Zeq_bitwise.v $PWD/src/coqutil/Datatypes/PropSet.vo (real: 2.52, user: 2.23, sys: 0.17, mem: 406924 ko) COQNATIVE $PWD/src/coqutil/Datatypes/PropSet.vo $PWD/src/coqutil/Z/prove_Zeq_bitwise.vo (real: 0.84, user: 0.58, sys: 0.10, mem: 413136 ko) COQNATIVE $PWD/src/coqutil/Z/prove_Zeq_bitwise.vo $PWD/src/coqutil/Datatypes/PropSet.vo.native (real: 0.82, user: 0.61, sys: 0.08, mem: 101844 ko) $PWD/src/coqutil/Z/prove_Zeq_bitwise.vo.native (real: 0.56, user: 0.42, sys: 0.06, mem: 102696 ko) File "$PWD/src/coqutil/Datatypes/List.v", line 1021, characters 37-53: Warning: Notation Minus.minus_plus is deprecated since 8.16. The Arith.Minus file is obsolete. Use Nat.add_sub (together with Nat.add_com) instead. [deprecated-syntactic-definition,deprecated] File "$PWD/src/coqutil/Datatypes/List.v", line 1021, characters 37-53: Warning: Notation Minus.minus_plus is deprecated since 8.16. The Arith.Minus file is obsolete. Use Nat.add_sub (together with Nat.add_com) instead. [deprecated-syntactic-definition,deprecated] File "$PWD/src/coqutil/Datatypes/List.v", line 1021, characters 37-53: Warning: Notation Minus.minus_plus is deprecated since 8.16. The Arith.Minus file is obsolete. Use Nat.add_sub (together with Nat.add_com) instead. [deprecated-syntactic-definition,deprecated] File "$PWD/src/coqutil/Datatypes/List.v", line 1040, characters 34-50: Warning: Notation Minus.minus_plus is deprecated since 8.16. The Arith.Minus file is obsolete. Use Nat.add_sub (together with Nat.add_com) instead. [deprecated-syntactic-definition,deprecated] File "$PWD/src/coqutil/Datatypes/List.v", line 1040, characters 34-50: Warning: Notation Minus.minus_plus is deprecated since 8.16. The Arith.Minus file is obsolete. Use Nat.add_sub (together with Nat.add_com) instead. [deprecated-syntactic-definition,deprecated] File "$PWD/src/coqutil/Datatypes/List.v", line 1040, characters 34-50: Warning: Notation Minus.minus_plus is deprecated since 8.16. The Arith.Minus file is obsolete. Use Nat.add_sub (together with Nat.add_com) instead. [deprecated-syntactic-definition,deprecated] File "$PWD/src/coqutil/Datatypes/List.v", line 1789, characters 13-26: Warning: Notation Zdiv.div_Zdiv is deprecated since 8.14. Use Nat2Z.inj_div instead. [deprecated-syntactic-definition,deprecated] File "$PWD/src/coqutil/Datatypes/List.v", line 1789, characters 29-42: Warning: Notation Zdiv.mod_Zmod is deprecated since 8.14. Use Nat2Z.inj_mod instead. [deprecated-syntactic-definition,deprecated] $PWD/src/coqutil/Datatypes/List.vo (real: 5.28, user: 4.85, sys: 0.24, mem: 434980 ko) COQNATIVE $PWD/src/coqutil/Datatypes/List.vo $PWD/src/coqutil/Datatypes/List.vo.native (real: 0.72, user: 0.57, sys: 0.07, mem: 99024 ko) COQC $PWD/src/coqutil/Datatypes/ListSet.v COQC $PWD/src/coqutil/Map/Interface.v COQC $PWD/src/coqutil/Tactics/rewr.v COQC $PWD/src/coqutil/Tactics/fwd_list_hints.v COQC $PWD/src/coqutil/Sorting/OrderToPermutation.v $PWD/src/coqutil/Tactics/fwd_list_hints.vo (real: 0.64, user: 0.36, sys: 0.15, mem: 274956 ko) COQNATIVE $PWD/src/coqutil/Tactics/fwd_list_hints.vo $PWD/src/coqutil/Sorting/OrderToPermutation.vo (real: 0.71, user: 0.43, sys: 0.16, mem: 317964 ko) COQNATIVE $PWD/src/coqutil/Sorting/OrderToPermutation.vo $PWD/src/coqutil/Map/Interface.vo (real: 0.73, user: 0.44, sys: 0.14, mem: 326076 ko) $PWD/src/coqutil/Tactics/rewr.vo (real: 0.73, user: 0.42, sys: 0.15, mem: 299108 ko) COQNATIVE $PWD/src/coqutil/Map/Interface.vo COQNATIVE $PWD/src/coqutil/Tactics/rewr.vo $PWD/src/coqutil/Datatypes/ListSet.vo (real: 1.29, user: 0.97, sys: 0.15, mem: 415948 ko) COQNATIVE $PWD/src/coqutil/Datatypes/ListSet.vo $PWD/src/coqutil/Word/Properties.vo (real: 8.70, user: 8.38, sys: 0.18, mem: 575776 ko) COQNATIVE $PWD/src/coqutil/Word/Properties.vo $PWD/src/coqutil/Tactics/fwd_list_hints.vo.native (real: 0.87, user: 0.62, sys: 0.11, mem: 101924 ko) $PWD/src/coqutil/Tactics/rewr.vo.native (real: 0.88, user: 0.62, sys: 0.11, mem: 101904 ko) $PWD/src/coqutil/Sorting/OrderToPermutation.vo.native (real: 1.11, user: 0.89, sys: 0.09, mem: 101560 ko) $PWD/src/coqutil/Map/Interface.vo.native (real: 1.29, user: 1.05, sys: 0.11, mem: 102644 ko) COQC $PWD/src/coqutil/Datatypes/Inhabited.v COQC $PWD/src/coqutil/Map/Properties.v COQC $PWD/src/coqutil/Map/SortedList.v COQC $PWD/src/coqutil/Map/Empty_set_keyed_map.v $PWD/src/coqutil/Datatypes/ListSet.vo.native (real: 0.91, user: 0.66, sys: 0.09, mem: 101836 ko) COQC $PWD/src/coqutil/Map/Funext.v $PWD/src/coqutil/Word/Properties.vo.native (real: 0.87, user: 0.66, sys: 0.08, mem: 103320 ko) COQC $PWD/src/coqutil/Word/LittleEndianList.v $PWD/src/coqutil/Datatypes/Inhabited.vo (real: 0.77, user: 0.51, sys: 0.10, mem: 284324 ko) COQNATIVE $PWD/src/coqutil/Datatypes/Inhabited.vo $PWD/src/coqutil/Map/Empty_set_keyed_map.vo (real: 0.79, user: 0.57, sys: 0.07, mem: 288536 ko) COQNATIVE $PWD/src/coqutil/Map/Empty_set_keyed_map.vo $PWD/src/coqutil/Map/Funext.vo (real: 1.01, user: 0.57, sys: 0.18, mem: 311552 ko) COQNATIVE $PWD/src/coqutil/Map/Funext.vo $PWD/src/coqutil/Map/SortedList.vo (real: 1.60, user: 1.28, sys: 0.18, mem: 418272 ko) COQNATIVE $PWD/src/coqutil/Map/SortedList.vo $PWD/src/coqutil/Map/Empty_set_keyed_map.vo.native (real: 1.08, user: 0.84, sys: 0.11, mem: 103096 ko) COQC $PWD/src/coqutil/Word/BigEndian.v $PWD/src/coqutil/Datatypes/Inhabited.vo.native (real: 1.13, user: 0.85, sys: 0.14, mem: 101692 ko) COQC $PWD/src/coqutil/Word/DebugWordEq.v $PWD/src/coqutil/Map/Funext.vo.native (real: 1.03, user: 0.80, sys: 0.08, mem: 102372 ko) COQC $PWD/src/coqutil/Word/Naive.v $PWD/src/coqutil/Map/SortedList.vo.native (real: 1.16, user: 0.88, sys: 0.15, mem: 102424 ko) COQC $PWD/src/coqutil/Word/SimplWordExpr.v $PWD/src/coqutil/Word/DebugWordEq.vo (real: 0.86, user: 0.50, sys: 0.17, mem: 361320 ko) COQNATIVE $PWD/src/coqutil/Word/DebugWordEq.vo $PWD/src/coqutil/Word/LittleEndianList.vo (real: 2.85, user: 2.50, sys: 0.14, mem: 421756 ko) COQNATIVE $PWD/src/coqutil/Word/LittleEndianList.vo $PWD/src/coqutil/Word/Naive.vo (real: 1.14, user: 0.78, sys: 0.17, mem: 412576 ko) COQNATIVE $PWD/src/coqutil/Word/Naive.vo $PWD/src/coqutil/Word/DebugWordEq.vo.native (real: 0.79, user: 0.58, sys: 0.08, mem: 103300 ko) COQC $PWD/src/coqutil/Tactics/fwd_word_hints.v $PWD/src/coqutil/Word/SimplWordExpr.vo (real: 0.93, user: 0.64, sys: 0.13, mem: 419144 ko) COQNATIVE $PWD/src/coqutil/Word/SimplWordExpr.vo $PWD/src/coqutil/Word/BigEndian.vo (real: 1.82, user: 1.45, sys: 0.18, mem: 417760 ko) COQNATIVE $PWD/src/coqutil/Word/BigEndian.vo $PWD/src/coqutil/Word/LittleEndianList.vo.native (real: 0.85, user: 0.63, sys: 0.11, mem: 104004 ko) COQC $PWD/src/coqutil/Map/SortedListString.v $PWD/src/coqutil/Tactics/fwd_word_hints.vo (real: 0.66, user: 0.40, sys: 0.07, mem: 310528 ko) COQNATIVE $PWD/src/coqutil/Tactics/fwd_word_hints.vo $PWD/src/coqutil/Word/Naive.vo.native (real: 0.99, user: 0.69, sys: 0.17, mem: 102316 ko) COQC $PWD/src/coqutil/Map/SortedListWord.v $PWD/src/coqutil/Word/SimplWordExpr.vo.native (real: 0.78, user: 0.55, sys: 0.11, mem: 104148 ko) COQC $PWD/src/coqutil/Map/Z_keyed_SortedListMap.v $PWD/src/coqutil/Word/BigEndian.vo.native (real: 0.82, user: 0.59, sys: 0.10, mem: 103836 ko) COQC $PWD/src/coqutil/Datatypes/OperatorOverloading.v $PWD/src/coqutil/Map/SortedListString.vo (real: 0.68, user: 0.39, sys: 0.08, mem: 279768 ko) COQNATIVE $PWD/src/coqutil/Map/SortedListString.vo $PWD/src/coqutil/Tactics/fwd_word_hints.vo.native (real: 0.99, user: 0.73, sys: 0.11, mem: 104180 ko) COQC $PWD/src/coqutil/Word/LittleEndian.v $PWD/src/coqutil/Map/SortedListWord.vo (real: 0.92, user: 0.50, sys: 0.23, mem: 363816 ko) COQNATIVE $PWD/src/coqutil/Map/SortedListWord.vo $PWD/src/coqutil/Map/Z_keyed_SortedListMap.vo (real: 0.90, user: 0.58, sys: 0.12, mem: 319092 ko) COQNATIVE $PWD/src/coqutil/Map/Z_keyed_SortedListMap.vo $PWD/src/coqutil/Map/SortedListString.vo.native (real: 1.00, user: 0.72, sys: 0.16, mem: 103220 ko) COQC $PWD/src/coqutil/Map/SortedListString_test.v $PWD/src/coqutil/Datatypes/OperatorOverloading.vo (real: 1.53, user: 1.09, sys: 0.24, mem: 415560 ko) COQNATIVE $PWD/src/coqutil/Datatypes/OperatorOverloading.vo $PWD/src/coqutil/Map/SortedListWord.vo.native (real: 0.92, user: 0.62, sys: 0.15, mem: 104040 ko) $PWD/src/coqutil/Map/Z_keyed_SortedListMap.vo.native (real: 1.08, user: 0.72, sys: 0.15, mem: 103964 ko) $PWD/src/coqutil/Map/SortedListString_test.vo (real: 0.80, user: 0.47, sys: 0.13, mem: 312492 ko) COQNATIVE $PWD/src/coqutil/Map/SortedListString_test.vo $PWD/src/coqutil/Map/Properties.vo (real: 6.71, user: 6.40, sys: 0.16, mem: 452836 ko) COQNATIVE $PWD/src/coqutil/Map/Properties.vo $PWD/src/coqutil/Word/LittleEndian.vo (real: 1.93, user: 1.65, sys: 0.12, mem: 420928 ko) COQNATIVE $PWD/src/coqutil/Word/LittleEndian.vo $PWD/src/coqutil/Datatypes/OperatorOverloading.vo.native (real: 1.25, user: 0.95, sys: 0.17, mem: 103212 ko) $PWD/src/coqutil/Map/SortedListString_test.vo.native (real: 0.82, user: 0.60, sys: 0.08, mem: 103528 ko) $PWD/src/coqutil/Map/Properties.vo.native (real: 0.96, user: 0.77, sys: 0.08, mem: 100032 ko) COQC $PWD/src/coqutil/Tactics/fwd_map_hints.v COQC $PWD/src/coqutil/Map/Solver.v COQC $PWD/src/coqutil/Map/MapKeys.v $PWD/src/coqutil/Word/LittleEndian.vo.native (real: 0.80, user: 0.60, sys: 0.08, mem: 104064 ko) COQC $PWD/src/coqutil/Word/ZifyLittleEndian.v $PWD/src/coqutil/Tactics/fwd_map_hints.vo (real: 0.50, user: 0.33, sys: 0.06, mem: 283128 ko) COQNATIVE $PWD/src/coqutil/Tactics/fwd_map_hints.vo $PWD/src/coqutil/Map/MapKeys.vo (real: 0.61, user: 0.43, sys: 0.08, mem: 392964 ko) COQNATIVE $PWD/src/coqutil/Map/MapKeys.vo $PWD/src/coqutil/Map/Solver.vo (real: 0.62, user: 0.39, sys: 0.08, mem: 304396 ko) COQNATIVE $PWD/src/coqutil/Map/Solver.vo $PWD/src/coqutil/Tactics/fwd_map_hints.vo.native (real: 0.70, user: 0.46, sys: 0.09, mem: 102724 ko) COQC $PWD/src/coqutil/Tactics/fwd.v File "$PWD/src/coqutil/Word/ZifyLittleEndian.v", line 11, characters 41-61: Warning: Notation combine is deprecated. Use coqutil.Word.LittleEndianList.le_combine. [deprecated-syntactic-definition,deprecated] File "$PWD/src/coqutil/Word/ZifyLittleEndian.v", line 11, characters 41-61: Warning: Notation combine is deprecated. Use coqutil.Word.LittleEndianList.le_combine. [deprecated-syntactic-definition,deprecated] File "$PWD/src/coqutil/Word/ZifyLittleEndian.v", line 15, characters 9-29: Warning: Notation combine is deprecated. Use coqutil.Word.LittleEndianList.le_combine. [deprecated-syntactic-definition,deprecated] File "$PWD/src/coqutil/Word/ZifyLittleEndian.v", line 21, characters 47-67: Warning: Notation combine is deprecated. Use coqutil.Word.LittleEndianList.le_combine. [deprecated-syntactic-definition,deprecated] File "$PWD/src/coqutil/Word/ZifyLittleEndian.v", line 25, characters 41-61: Warning: Notation combine is deprecated. Use coqutil.Word.LittleEndianList.le_combine. [deprecated-syntactic-definition,deprecated] File "$PWD/src/coqutil/Word/ZifyLittleEndian.v", line 25, characters 41-61: Warning: Notation combine is deprecated. Use coqutil.Word.LittleEndianList.le_combine. [deprecated-syntactic-definition,deprecated] File "$PWD/src/coqutil/Word/ZifyLittleEndian.v", line 29, characters 9-29: Warning: Notation combine is deprecated. Use coqutil.Word.LittleEndianList.le_combine. [deprecated-syntactic-definition,deprecated] File "$PWD/src/coqutil/Word/ZifyLittleEndian.v", line 35, characters 47-67: Warning: Notation combine is deprecated. Use coqutil.Word.LittleEndianList.le_combine. [deprecated-syntactic-definition,deprecated] File "$PWD/src/coqutil/Word/ZifyLittleEndian.v", line 39, characters 41-61: Warning: Notation combine is deprecated. Use coqutil.Word.LittleEndianList.le_combine. [deprecated-syntactic-definition,deprecated] File "$PWD/src/coqutil/Word/ZifyLittleEndian.v", line 39, characters 41-61: Warning: Notation combine is deprecated. Use coqutil.Word.LittleEndianList.le_combine. [deprecated-syntactic-definition,deprecated] File "$PWD/src/coqutil/Word/ZifyLittleEndian.v", line 43, characters 9-29: Warning: Notation combine is deprecated. Use coqutil.Word.LittleEndianList.le_combine. [deprecated-syntactic-definition,deprecated] File "$PWD/src/coqutil/Word/ZifyLittleEndian.v", line 49, characters 47-67: Warning: Notation combine is deprecated. Use coqutil.Word.LittleEndianList.le_combine. [deprecated-syntactic-definition,deprecated] File "$PWD/src/coqutil/Word/ZifyLittleEndian.v", line 53, characters 41-61: Warning: Notation combine is deprecated. Use coqutil.Word.LittleEndianList.le_combine. [deprecated-syntactic-definition,deprecated] File "$PWD/src/coqutil/Word/ZifyLittleEndian.v", line 53, characters 41-61: Warning: Notation combine is deprecated. Use coqutil.Word.LittleEndianList.le_combine. [deprecated-syntactic-definition,deprecated] File "$PWD/src/coqutil/Word/ZifyLittleEndian.v", line 57, characters 9-29: Warning: Notation combine is deprecated. Use coqutil.Word.LittleEndianList.le_combine. [deprecated-syntactic-definition,deprecated] File "$PWD/src/coqutil/Word/ZifyLittleEndian.v", line 63, characters 47-67: Warning: Notation combine is deprecated. Use coqutil.Word.LittleEndianList.le_combine. [deprecated-syntactic-definition,deprecated] File "$PWD/src/coqutil/Word/ZifyLittleEndian.v", line 82, characters 4-24: Warning: Notation combine is deprecated. Use coqutil.Word.LittleEndianList.le_combine. [deprecated-syntactic-definition,deprecated] File "$PWD/src/coqutil/Word/ZifyLittleEndian.v", line 82, characters 43-63: Warning: Notation combine is deprecated. Use coqutil.Word.LittleEndianList.le_combine. [deprecated-syntactic-definition,deprecated] File "$PWD/src/coqutil/Word/ZifyLittleEndian.v", line 83, characters 4-24: Warning: Notation combine is deprecated. Use coqutil.Word.LittleEndianList.le_combine. [deprecated-syntactic-definition,deprecated] File "$PWD/src/coqutil/Word/ZifyLittleEndian.v", line 83, characters 43-63: Warning: Notation combine is deprecated. Use coqutil.Word.LittleEndianList.le_combine. [deprecated-syntactic-definition,deprecated] File "$PWD/src/coqutil/Word/ZifyLittleEndian.v", line 84, characters 4-24: Warning: Notation combine is deprecated. Use coqutil.Word.LittleEndianList.le_combine. [deprecated-syntactic-definition,deprecated] File "$PWD/src/coqutil/Word/ZifyLittleEndian.v", line 84, characters 43-63: Warning: Notation combine is deprecated. Use coqutil.Word.LittleEndianList.le_combine. [deprecated-syntactic-definition,deprecated] File "$PWD/src/coqutil/Word/ZifyLittleEndian.v", line 85, characters 4-24: Warning: Notation combine is deprecated. Use coqutil.Word.LittleEndianList.le_combine. [deprecated-syntactic-definition,deprecated] File "$PWD/src/coqutil/Word/ZifyLittleEndian.v", line 85, characters 43-63: Warning: Notation combine is deprecated. Use coqutil.Word.LittleEndianList.le_combine. [deprecated-syntactic-definition,deprecated] $PWD/src/coqutil/Word/ZifyLittleEndian.vo (real: 0.94, user: 0.74, sys: 0.08, mem: 419828 ko) COQNATIVE $PWD/src/coqutil/Word/ZifyLittleEndian.vo $PWD/src/coqutil/Map/MapKeys.vo.native (real: 0.67, user: 0.45, sys: 0.11, mem: 101768 ko) COQC $PWD/src/coqutil/Map/OfFunc.v $PWD/src/coqutil/Map/Solver.vo.native (real: 0.80, user: 0.63, sys: 0.06, mem: 104700 ko) COQC $PWD/src/coqutil/Map/SlowGoals.v COQC $PWD/src/coqutil/Map/TestGoals.v COQC $PWD/src/coqutil/Map/MapEauto.v $PWD/src/coqutil/Tactics/fwd.vo (real: 0.66, user: 0.38, sys: 0.10, mem: 297656 ko) COQNATIVE $PWD/src/coqutil/Tactics/fwd.vo $PWD/src/coqutil/Word/ZifyLittleEndian.vo.native (real: 0.85, user: 0.66, sys: 0.05, mem: 104132 ko) $PWD/src/coqutil/Map/OfFunc.vo (real: 1.05, user: 0.75, sys: 0.12, mem: 417728 ko) COQNATIVE $PWD/src/coqutil/Map/OfFunc.vo $PWD/src/coqutil/Tactics/fwd.vo.native (real: 0.95, user: 0.64, sys: 0.16, mem: 104208 ko) $PWD/src/coqutil/Map/OfFunc.vo.native (real: 0.78, user: 0.63, sys: 0.06, mem: 101324 ko) COQC $PWD/src/coqutil/Map/OfListWord.v $PWD/src/coqutil/Map/MapEauto.vo (real: 2.65, user: 2.22, sys: 0.23, mem: 420764 ko) COQNATIVE $PWD/src/coqutil/Map/MapEauto.vo $PWD/src/coqutil/Map/OfListWord.vo (real: 1.03, user: 0.74, sys: 0.12, mem: 421844 ko) COQNATIVE $PWD/src/coqutil/Map/OfListWord.vo $PWD/src/coqutil/Map/MapEauto.vo.native (real: 0.69, user: 0.46, sys: 0.11, mem: 101892 ko) $PWD/src/coqutil/Map/OfListWord.vo.native (real: 0.75, user: 0.56, sys: 0.07, mem: 104332 ko) Finished transaction in 4.513 secs (4.448u,0.065s) (successful) Finished transaction in 0.014 secs (0.013u,0.s) (successful) $PWD/src/coqutil/Map/SlowGoals.vo (real: 5.25, user: 4.95, sys: 0.18, mem: 413708 ko) COQNATIVE $PWD/src/coqutil/Map/SlowGoals.vo $PWD/src/coqutil/Map/SlowGoals.vo.native (real: 0.52, user: 0.36, sys: 0.07, mem: 101432 ko) Finished transaction in 0.046 secs (0.026u,0.019s) (successful) Finished transaction in 0.207 secs (0.125u,0.082s) (successful) Part 1a: Small goals (originally took <5s each) Finished transaction in 0.087 secs (0.087u,0.s) (successful) Finished transaction in 0.156 secs (0.156u,0.s) (successful) Finished transaction in 1.197 secs (1.188u,0.s) (successful) Finished transaction in 1.63 secs (1.63u,0.s) (successful) Finished transaction in 1.229 secs (1.225u,0.004s) (successful) Finished transaction in 0.761 secs (0.761u,0.s) (successful) Finished transaction in 0.762 secs (0.762u,0.s) (successful) Finished transaction in 0.685 secs (0.685u,0.s) (successful) Finished transaction in 0.082 secs (0.082u,0.s) (successful) Part 1b: Medium goals (originally took >5s each) Finished transaction in 0.524 secs (0.524u,0.s) (successful) Finished transaction in 1.414 secs (1.414u,0.s) (successful) Finished transaction in 1.143 secs (1.142u,0.s) (successful) Finished transaction in 0.718 secs (0.718u,0.s) (successful) Finished transaction in 0.73 secs (0.73u,0.s) (successful) Finished transaction in 1.299 secs (1.299u,0.s) (successful) Finished transaction in 1.242 secs (1.242u,0.s) (successful) Part 1c: Large goals (originally took >50s each) Finished transaction in 1.681 secs (1.681u,0.s) (successful) $PWD/src/coqutil/Map/TestGoals.vo (real: 16.41, user: 16.08, sys: 0.20, mem: 435484 ko) COQNATIVE $PWD/src/coqutil/Map/TestGoals.vo $PWD/src/coqutil/Map/TestGoals.vo.native (real: 0.43, user: 0.34, sys: 0.02, mem: 102636 ko) coq-8.20.0/test-suite/precomputed-time-tests/template/000077500000000000000000000000001466560755400227515ustar00rootroot00000000000000coq-8.20.0/test-suite/precomputed-time-tests/template/init.sh000066400000000000000000000011261466560755400242500ustar00rootroot00000000000000#!/usr/bin/env bash set -x set -e set -o pipefail export PATH="$COQBIN:$PATH" export LC_ALL=C # tools TTOOLSDIR="$COQPREFIX/lib/coq-core/tools" export make_both_time_files="$TTOOLSDIR"/make-both-time-files.py export make_one_time_file="$TTOOLSDIR"/make-one-time-file.py export make_both_single_timing_files="$TTOOLSDIR"/make-both-single-timing-files.py # native stack overflows too easily, see eg # https://gitlab.com/coq/coq/-/jobs/3250939810 export COQEXTRAFLAGS='-native-compiler no' # reset MAKEFLAGS so that, e.g., `make -C test-suite -B coq-makefile` doesn't give us issues MAKEFLAGS= coq-8.20.0/test-suite/precomputed-time-tests/zero-before/000077500000000000000000000000001466560755400233555ustar00rootroot00000000000000coq-8.20.0/test-suite/precomputed-time-tests/zero-before/run.sh000077500000000000000000000004001466560755400245120ustar00rootroot00000000000000#!/usr/bin/env bash . ../template/init.sh cd "$(dirname "${BASH_SOURCE[0]}")" $make_both_time_files time-of-build-after.log.in time-of-build-before.log.in time-of-build-both.log diff -u time-of-build-both.log.expected time-of-build-both.log || exit $? coq-8.20.0/test-suite/precomputed-time-tests/zero-before/time-of-build-after.log.in000066400000000000000000000050161466560755400302230ustar00rootroot00000000000000./src/Rewriter/PerfTesting/Specific/make.py primes.txt make --no-print-directory -C rewriter make[2]: Nothing to be done for 'real-all'. make --no-print-directory -C bedrock2/deps/coqutil Generating Makefile.coq.all make -f Makefile.coq.all make[3]: Nothing to be done for 'real-all'. make --no-print-directory -C bedrock2/bedrock2 noex Generating Makefile.coq.noex rm -f .coqdeps.d make -f Makefile.coq.noex make[3]: Nothing to be done for 'real-all'. make --no-print-directory -C coqprime src/Coqprime/PrimalityTest/Zp.vo make[1]: 'src/Coqprime/PrimalityTest/Zp.vo' is up to date. coq_makefile -f _CoqProject INSTALLDEFAULTROOT = Crypto -o Makefile-coq COQ_MAKEFILE -f _CoqProject > Makefile.coq make --no-print-directory -C rewriter make[2]: Nothing to be done for 'real-all'. make --no-print-directory -C bedrock2/deps/coqutil Generating Makefile.coq.all make -f Makefile.coq.all make[3]: Nothing to be done for 'real-all'. make --no-print-directory -C bedrock2/bedrock2 noex Generating Makefile.coq.noex rm -f .coqdeps.d make -f Makefile.coq.noex make[3]: Nothing to be done for 'real-all'. make --no-print-directory -C coqprime src/Coqprime/PrimalityTest/Zp.vo make[1]: 'src/Coqprime/PrimalityTest/Zp.vo' is up to date. COQDEP VFILES make --no-print-directory -C rewriter make[2]: Nothing to be done for 'real-all'. make --no-print-directory -C bedrock2/deps/coqutil Generating Makefile.coq.all make -f Makefile.coq.all make[3]: Nothing to be done for 'real-all'. make --no-print-directory -C bedrock2/bedrock2 noex Generating Makefile.coq.noex rm -f .coqdeps.d make -f Makefile.coq.noex make[3]: Nothing to be done for 'real-all'. make --no-print-directory -C coqprime src/Coqprime/PrimalityTest/Zp.vo make[1]: 'src/Coqprime/PrimalityTest/Zp.vo' is up to date. COQC src/UnsaturatedSolinasHeuristics/Tests.v Finished transaction in 25.269 secs (24.869u,0.051s) (successful) src/UnsaturatedSolinasHeuristics/Tests.vo (real: 26.27, user: 25.97, sys: 0.27, mem: 566428 ko) DIFF Crypto.Fancy.Montgomery256.Prod.MontRed256 DIFF Crypto.Fancy.Montgomery256.prod_montred256_correct DIFF Crypto.Fancy.Montgomery256.prod_montred256_correct.Assumptions DIFF Crypto.Fancy.Montgomery256.montred256 DIFF Crypto.Fancy.Barrett256.Prod.MulMod DIFF Crypto.Fancy.Barrett256.prod_barrett_red256_correct DIFF Crypto.Fancy.Barrett256.prod_barrett_red256_correct.Assumptions DIFF Crypto.Fancy.Barrett256.barrett_red256 DIFF Crypto.UnsaturatedSolinasHeuristics.Tests.get_possible_limbs cp -f AUTHORS fiat-rust/AUTHORS cp -f CONTRIBUTORS fiat-rust/CONTRIBUTORS cp -f LICENSE fiat-rust/LICENSE coq-8.20.0/test-suite/precomputed-time-tests/zero-before/time-of-build-before.log.in000066400000000000000000000033361466560755400303670ustar00rootroot00000000000000./src/Rewriter/PerfTesting/Specific/make.py primes.txt make --no-print-directory -C rewriter make[2]: Nothing to be done for 'real-all'. make --no-print-directory -C bedrock2/deps/coqutil Generating Makefile.coq.all make -f Makefile.coq.all make[3]: Nothing to be done for 'real-all'. make --no-print-directory -C bedrock2/bedrock2 noex Generating Makefile.coq.noex rm -f .coqdeps.d make -f Makefile.coq.noex make[3]: Nothing to be done for 'real-all'. make --no-print-directory -C coqprime src/Coqprime/PrimalityTest/Zp.vo make[1]: 'src/Coqprime/PrimalityTest/Zp.vo' is up to date. coq_makefile -f _CoqProject INSTALLDEFAULTROOT = Crypto -o Makefile-coq COQ_MAKEFILE -f _CoqProject > Makefile.coq make --no-print-directory -C rewriter make[2]: Nothing to be done for 'real-all'. make --no-print-directory -C bedrock2/deps/coqutil Generating Makefile.coq.all make -f Makefile.coq.all make[3]: Nothing to be done for 'real-all'. make --no-print-directory -C bedrock2/bedrock2 noex Generating Makefile.coq.noex rm -f .coqdeps.d make -f Makefile.coq.noex make[3]: Nothing to be done for 'real-all'. make --no-print-directory -C coqprime src/Coqprime/PrimalityTest/Zp.vo make[1]: 'src/Coqprime/PrimalityTest/Zp.vo' is up to date. DIFF Crypto.Fancy.Montgomery256.Prod.MontRed256 DIFF Crypto.Fancy.Montgomery256.prod_montred256_correct DIFF Crypto.Fancy.Montgomery256.prod_montred256_correct.Assumptions DIFF Crypto.Fancy.Montgomery256.montred256 DIFF Crypto.Fancy.Barrett256.Prod.MulMod DIFF Crypto.Fancy.Barrett256.prod_barrett_red256_correct DIFF Crypto.Fancy.Barrett256.prod_barrett_red256_correct.Assumptions DIFF Crypto.Fancy.Barrett256.barrett_red256 cp -f AUTHORS fiat-rust/AUTHORS cp -f CONTRIBUTORS fiat-rust/CONTRIBUTORS cp -f LICENSE fiat-rust/LICENSE coq-8.20.0/test-suite/precomputed-time-tests/zero-before/time-of-build-both.log.expected000066400000000000000000000013021466560755400312430ustar00rootroot00000000000000 After | Peak Mem | File Name | Before | Peak Mem || Change || Change (mem) | % Change | % Change (mem) ------------------------------------------------------------------------------------------------------------------------------------------- 0m25.97s | 566428 ko | Total Time / Peak Mem | 0m00.00s | 0 ko || +0m25.97s || 566428 ko | N/A | ∞ ------------------------------------------------------------------------------------------------------------------------------------------- 0m25.97s | 566428 ko | UnsaturatedSolinasHeuristics/Tests.vo | N/A | N/A || +0m25.97s || 566428 ko | ∞ | ∞ coq-8.20.0/test-suite/prerequisite/000077500000000000000000000000001466560755400172345ustar00rootroot00000000000000coq-8.20.0/test-suite/prerequisite/admit.v000066400000000000000000000001011466560755400205110ustar00rootroot00000000000000Axiom proof_admitted : False. Ltac admit := case proof_admitted. coq-8.20.0/test-suite/prerequisite/bind_univs.v000066400000000000000000000002331466560755400215610ustar00rootroot00000000000000(* Used in output/UnivBinders.v *) Monomorphic Definition mono@{u} := Type@{u}. Polymorphic Definition poly@{u} := Type@{u}. Monomorphic Universe reqU. coq-8.20.0/test-suite/prerequisite/deprecated_library.v000066400000000000000000000003601466560755400232460ustar00rootroot00000000000000Attributes deprecated(note="This library is useless.", since="XX YY"). Attributes warn(note="This library is dangerous.", cats="dangerous library"). Attributes warn(note="This library is tricky.", cats="dangerous library, tricky library"). coq-8.20.0/test-suite/prerequisite/extra_dep.txt000066400000000000000000000000001466560755400217360ustar00rootroot00000000000000coq-8.20.0/test-suite/prerequisite/for_vos.v000066400000000000000000000002431466560755400210770ustar00rootroot00000000000000(* -*- mode: coq; coq-prog-args: ("-vos") -*- *) Axiom axiom : nat. Lemma foo : nat. Proof. exact axiom. Qed. Lemma bar : nat. Proof. exact axiom. Defined. coq-8.20.0/test-suite/prerequisite/make_local.v000066400000000000000000000003641466560755400215150ustar00rootroot00000000000000(* Used in Import.v to test the locality flag *) Definition f (A:Type) (a:A) := a. Local Arguments f [A]%_type_scope _%_type_scope. (* Used in ImportedCoercion.v to test the locality flag *) Local Coercion g (b:bool) := if b then 0 else 1. coq-8.20.0/test-suite/prerequisite/make_notation.v000066400000000000000000000005611466560755400222550ustar00rootroot00000000000000(* Used in Notation.v to test import of notations from files in sections *) Notation "'Z'" := O (at level 9). Notation plus := plus. Notation succ := S. Notation mult := mult (only parsing). Notation less := le (only parsing). (* Test bug 2168: ending section of some name was removing objects of the same name *) Notation add2 n:=(S n). Section add2. End add2. coq-8.20.0/test-suite/prerequisite/module_bug7192.v000066400000000000000000000005031466560755400220660ustar00rootroot00000000000000(* Variant of #7192 to be tested in a file requiring this file *) (* #7192 is about Print Assumptions not entering implementation of submodules *) Definition a := True. Module Type B. Axiom f : Prop. End B. Module Type C. Declare Module D : B. End C. Module M7192: C. Module D <: B. Definition f := a. End D. End M7192. coq-8.20.0/test-suite/prerequisite/module_bug8416.v000066400000000000000000000001261466560755400220670ustar00rootroot00000000000000Module Type A. Axiom f : True. End A. Module M8416 : A. Definition f := I. End M8416. coq-8.20.0/test-suite/prerequisite/requires_deprecated_library.v000066400000000000000000000000461466560755400251660ustar00rootroot00000000000000Require TestSuite.deprecated_library. coq-8.20.0/test-suite/prerequisite/ssr_mini_mathcomp.v000066400000000000000000001352631466560755400231500ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* -> Sortclass. Variables (T : Type) (cT : type). Definition class := let: Pack _ c _ := cT return class_of cT in c. Definition pack c := @Pack T c T. Definition clone := fun c & cT -> T & phant_id (pack c) cT => pack c. End ClassDef. Module Exports. Coercion sort : type >-> Sortclass. Notation eqType := type. Notation EqMixin := Mixin. Notation EqType T m := (@pack T m). Notation "[ 'eqMixin' 'of' T ]" := (class _ : mixin_of T) (at level 0, format "[ 'eqMixin' 'of' T ]") : form_scope. Notation "[ 'eqType' 'of' T 'for' C ]" := (@clone T C _ idfun id) (at level 0, format "[ 'eqType' 'of' T 'for' C ]") : form_scope. Notation "[ 'eqType' 'of' T ]" := (@clone T _ _ id id) (at level 0, format "[ 'eqType' 'of' T ]") : form_scope. End Exports. End Equality. Export Equality.Exports. Definition eq_op T := Equality.op (Equality.class T). Lemma eqE T x : eq_op x = Equality.op (Equality.class T) x. Proof. by []. Qed. Lemma eqP T : Equality.axiom (@eq_op T). Proof. by case: T => ? []. Qed. Arguments eqP {T x y}. Declare Scope eq_scope. Delimit Scope eq_scope with EQ. Open Scope eq_scope. Notation "x == y" := (eq_op x y) (at level 70, no associativity) : bool_scope. Notation "x == y :> T" := ((x : T) == (y : T)) (at level 70, y at next level) : bool_scope. Notation "x != y" := (~~ (x == y)) (at level 70, no associativity) : bool_scope. Notation "x != y :> T" := (~~ (x == y :> T)) (at level 70, y at next level) : bool_scope. Notation "x =P y" := (eqP : reflect (x = y) (x == y)) (at level 70, no associativity) : eq_scope. Notation "x =P y :> T" := (eqP : reflect (x = y :> T) (x == y :> T)) (at level 70, y at next level, no associativity) : eq_scope. Prenex Implicits eq_op eqP. Lemma eq_refl (T : eqType) (x : T) : x == x. Proof. exact/eqP. Qed. Notation eqxx := eq_refl. Lemma eq_sym (T : eqType) (x y : T) : (x == y) = (y == x). Proof. exact/eqP/eqP. Qed. #[global] Hint Resolve eq_refl eq_sym : core. Definition eqb b := addb (~~ b). Lemma eqbP : Equality.axiom eqb. Proof. by do 2!case; constructor. Qed. Canonical bool_eqMixin := EqMixin eqbP. Canonical bool_eqType := Eval hnf in EqType bool bool_eqMixin. Section ProdEqType. Variable T1 T2 : eqType. Definition pair_eq := [rel u v : T1 * T2 | (u.1 == v.1) && (u.2 == v.2)]. Lemma pair_eqP : Equality.axiom pair_eq. Proof. move=> [x1 x2] [y1 y2] /=; apply: (iffP andP) => [[]|[<- <-]] //=. by do 2!move/eqP->. Qed. Definition prod_eqMixin := EqMixin pair_eqP. Canonical prod_eqType := Eval hnf in EqType (T1 * T2) prod_eqMixin. End ProdEqType. Section OptionEqType. Variable T : eqType. Definition opt_eq (u v : option T) : bool := oapp (fun x => oapp (eq_op x) false v) (~~ v) u. Lemma opt_eqP : Equality.axiom opt_eq. Proof. case=> [x|] [y|] /=; by [constructor | apply: (iffP eqP) => [|[]] ->]. Qed. Canonical option_eqMixin := EqMixin opt_eqP. Canonical option_eqType := Eval hnf in EqType (option T) option_eqMixin. End OptionEqType. Notation xpred1 := (fun a1 x => x == a1). Notation xpredU1 := (fun a1 (p : pred _) x => (x == a1) || p x). Section EqPred. Variable T : eqType. Definition pred1 (a1 : T) := SimplPred (xpred1 a1). Definition predU1 (a1 : T) p := SimplPred (xpredU1 a1 p). End EqPred. Section TransferEqType. Variables (T : Type) (eT : eqType) (f : T -> eT). Lemma inj_eqAxiom : injective f -> Equality.axiom (fun x y => f x == f y). Proof. by move=> f_inj x y; apply: (iffP eqP) => [|-> //]; apply: f_inj. Qed. Definition InjEqMixin f_inj := EqMixin (inj_eqAxiom f_inj). Definition PcanEqMixin g (fK : pcancel f g) := InjEqMixin (pcan_inj fK). Definition CanEqMixin g (fK : cancel f g) := InjEqMixin (can_inj fK). End TransferEqType. (* We use the module system to circumvent a silly limitation that *) (* forbids using the same constant to coerce to different targets. *) Module Type EqTypePredSig. Parameter sort : eqType -> predArgType. End EqTypePredSig. Module MakeEqTypePred (eqmod : EqTypePredSig). Coercion eqmod.sort : eqType >-> predArgType. End MakeEqTypePred. Module Export EqTypePred := MakeEqTypePred Equality. Section SubType. Variables (T : Type) (P : pred T). Structure subType : Type := SubType { sub_sort :> Type; val : sub_sort -> T; Sub : forall x, P x -> sub_sort; _ : forall K (_ : forall x Px, K (@Sub x Px)) u, K u; _ : forall x Px, val (@Sub x Px) = x }. Arguments Sub [s]. Lemma vrefl : forall x, P x -> x = x. Proof. by []. Qed. Definition vrefl_rect := vrefl. Definition clone_subType U v := fun sT & sub_sort sT -> U => fun c Urec cK (sT' := @SubType U v c Urec cK) & phant_id sT' sT => sT'. Variable sT : subType. Variant Sub_spec : sT -> Type := SubSpec x Px : Sub_spec (Sub x Px). Lemma SubP u : Sub_spec u. Proof. by case: sT Sub_spec SubSpec u => T' _ C rec /= _. Qed. Lemma SubK x Px : @val sT (Sub x Px) = x. Proof. by case: sT. Qed. Definition insub x := if @idP (P x) is ReflectT Px then @Some sT (Sub x Px) else None. Definition insubd u0 x := odflt u0 (insub x). Variant insub_spec x : option sT -> Type := | InsubSome u of P x & val u = x : insub_spec x (Some u) | InsubNone of ~~ P x : insub_spec x None. Lemma insubP x : insub_spec x (insub x). Proof. by rewrite /insub; case: {-}_ / idP; [left; rewrite ?SubK | right; apply/negP]. Qed. Lemma insubT x Px : insub x = Some (Sub x Px). Admitted. Lemma insubF x : P x = false -> insub x = None. Proof. by move/idP; case: insubP. Qed. Lemma insubN x : ~~ P x -> insub x = None. Proof. by move/negPf/insubF. Qed. Lemma isSome_insub : ([eta insub] : pred T) =1 P. Proof. by apply: fsym => x; case: insubP => // /negPf. Qed. Lemma insubK : ocancel insub (@val _). Proof. by move=> x; case: insubP. Qed. Lemma valP (u : sT) : P (val u). Proof. by case/SubP: u => x Px; rewrite SubK. Qed. Lemma valK : pcancel (@val _) insub. Proof. by case/SubP=> x Px; rewrite SubK; apply: insubT. Qed. Lemma val_inj : injective (@val sT). Proof. exact: pcan_inj valK. Qed. Lemma valKd u0 : cancel (@val _) (insubd u0). Proof. by move=> u; rewrite /insubd valK. Qed. Lemma val_insubd u0 x : val (insubd u0 x) = if P x then x else val u0. Proof. by rewrite /insubd; case: insubP => [u -> | /negPf->]. Qed. Lemma insubdK u0 : {in P, cancel (insubd u0) (@val _)}. Proof. by move=> x Px; rewrite /= val_insubd [P x]Px. Qed. Definition insub_eq x := let Some_sub Px := Some (Sub x Px : sT) in let None_sub _ := None in (if P x as Px return P x = Px -> _ then Some_sub else None_sub) (erefl _). Lemma insub_eqE : insub_eq =1 insub. Proof. rewrite /insub_eq /insub => x; case: {2 3}_ / idP (erefl _) => // Px Px'. by congr (Some _); apply: val_inj; rewrite !SubK. Qed. End SubType. Arguments SubType [T P]. Arguments Sub [T P s]. Arguments vrefl [T P]. Arguments vrefl_rect [T P]. Arguments clone_subType [T P] U v [sT] _ [c Urec cK]. Arguments insub [T P sT]. Arguments insubT [T] P [sT x]. Arguments val_inj [T P sT]. Prenex Implicits val Sub vrefl vrefl_rect insub insubd val_inj. Local Notation inlined_sub_rect := (fun K K_S u => let (x, Px) as u return K u := u in K_S x Px). Local Notation inlined_new_rect := (fun K K_S u => let (x) as u return K u := u in K_S x). Notation "[ 'subType' 'for' v ]" := (SubType _ v _ inlined_sub_rect vrefl_rect) (at level 0, only parsing) : form_scope. Notation "[ 'sub' 'Type' 'for' v ]" := (SubType _ v _ _ vrefl_rect) (at level 0, format "[ 'sub' 'Type' 'for' v ]") : form_scope. Notation "[ 'subType' 'for' v 'by' rec ]" := (SubType _ v _ rec vrefl) (at level 0, format "[ 'subType' 'for' v 'by' rec ]") : form_scope. Notation "[ 'subType' 'of' U 'for' v ]" := (clone_subType U v id idfun) (at level 0, format "[ 'subType' 'of' U 'for' v ]") : form_scope. (* Notation "[ 'subType' 'for' v ]" := (clone_subType _ v id idfun) (at level 0, format "[ 'subType' 'for' v ]") : form_scope. *) Notation "[ 'subType' 'of' U ]" := (clone_subType U _ id id) (at level 0, format "[ 'subType' 'of' U ]") : form_scope. Definition NewType T U v c Urec := let Urec' P IH := Urec P (fun x : T => IH x isT : P _) in SubType U v (fun x _ => c x) Urec'. Arguments NewType [T U]. Notation "[ 'newType' 'for' v ]" := (NewType v _ inlined_new_rect vrefl_rect) (at level 0, only parsing) : form_scope. Notation "[ 'new' 'Type' 'for' v ]" := (NewType v _ _ vrefl_rect) (at level 0, format "[ 'new' 'Type' 'for' v ]") : form_scope. Notation "[ 'newType' 'for' v 'by' rec ]" := (NewType v _ rec vrefl) (at level 0, format "[ 'newType' 'for' v 'by' rec ]") : form_scope. Definition innew T nT x := @Sub T predT nT x (erefl true). Arguments innew [T nT]. Prenex Implicits innew. Lemma innew_val T nT : cancel val (@innew T nT). Proof. by move=> u; apply: val_inj; apply: SubK. Qed. (* Prenex Implicits and renaming. *) Notation sval := (@proj1_sig _ _). Notation "@ 'sval'" := (@proj1_sig) (at level 10, format "@ 'sval'"). Section SubEqType. Variables (T : eqType) (P : pred T) (sT : subType P). Local Notation ev_ax := (fun T v => @Equality.axiom T (fun x y => v x == v y)). Lemma val_eqP : ev_ax sT val. Proof. exact: inj_eqAxiom val_inj. Qed. Definition sub_eqMixin := EqMixin val_eqP. Canonical sub_eqType := Eval hnf in EqType sT sub_eqMixin. Definition SubEqMixin := (let: SubType _ v _ _ _ as sT' := sT return ev_ax sT' val -> Equality.class_of sT' in fun vP : ev_ax _ v => EqMixin vP ) val_eqP. Lemma val_eqE (u v : sT) : (val u == val v) = (u == v). Proof. by []. Qed. End SubEqType. Arguments val_eqP {T P sT x y}. Prenex Implicits val_eqP. Notation "[ 'eqMixin' 'of' T 'by' <: ]" := (SubEqMixin _ : Equality.class_of T) (at level 0, format "[ 'eqMixin' 'of' T 'by' <: ]") : form_scope. (* ssrnat ---------------------------------------------------------- *) Notation succn := Datatypes.S. Notation predn := Peano.pred. Notation "n .+1" := (succn n) (at level 2, left associativity, format "n .+1") : nat_scope. Notation "n .+2" := n.+1.+1 (at level 2, left associativity, format "n .+2") : nat_scope. Notation "n .+3" := n.+2.+1 (at level 2, left associativity, format "n .+3") : nat_scope. Notation "n .+4" := n.+2.+2 (at level 2, left associativity, format "n .+4") : nat_scope. Notation "n .-1" := (predn n) (at level 2, left associativity, format "n .-1") : nat_scope. Notation "n .-2" := n.-1.-1 (at level 2, left associativity, format "n .-2") : nat_scope. Fixpoint eqn m n {struct m} := match m, n with | 0, 0 => true | m'.+1, n'.+1 => eqn m' n' | _, _ => false end. Lemma eqnP : Equality.axiom eqn. Proof. move=> n m; apply: (iffP idP) => [|<-]; last by elim n. by elim: n m => [|n IHn] [|m] //= /IHn->. Qed. Canonical nat_eqMixin := EqMixin eqnP. Canonical nat_eqType := Eval hnf in EqType nat nat_eqMixin. Arguments eqnP {x y}. Prenex Implicits eqnP. Coercion nat_of_bool (b : bool) := if b then 1 else 0. Fixpoint odd n := if n is n'.+1 then ~~ odd n' else false. Lemma oddb (b : bool) : odd b = b. Proof. by case: b. Qed. Declare Scope nat_rec_scope. Set Warnings "-notation-overridden". Definition subn_rec := minus. Notation "m - n" := (subn_rec m n) : nat_rec_scope. Definition subn := nosimpl subn_rec. Notation "m - n" := (subn m n) : nat_scope. Definition leq m n := m - n == 0. Notation "m <= n" := (leq m n) : nat_scope. Notation "m < n" := (m.+1 <= n) : nat_scope. Notation "m >= n" := (n <= m) (only parsing) : nat_scope. Notation "m > n" := (n < m) (only parsing) : nat_scope. Notation "m <= n <= p" := ((m <= n) && (n <= p)) : nat_scope. Notation "m < n <= p" := ((m < n) && (n <= p)) : nat_scope. Notation "m <= n < p" := ((m <= n) && (n < p)) : nat_scope. Notation "m < n < p" := ((m < n) && (n < p)) : nat_scope. Open Scope nat_scope. Lemma ltnS m n : (m < n.+1) = (m <= n). Proof. by []. Qed. Lemma leq0n n : 0 <= n. Proof. by []. Qed. Lemma ltn0Sn n : 0 < n.+1. Proof. by []. Qed. Lemma ltn0 n : n < 0 = false. Proof. by []. Qed. Lemma leqnn n : n <= n. Proof. by elim: n. Qed. #[global] Hint Resolve leqnn : core. Lemma leqnSn n : n <= n.+1. Proof. by elim: n. Qed. Lemma leq_trans n m p : m <= n -> n <= p -> m <= p. Admitted. Lemma leq_ltn_trans n m p : m <= n -> n < p -> m < p. Admitted. Lemma leqW m n : m <= n -> m <= n.+1. Admitted. #[global] Hint Resolve leqnSn : core. Lemma ltnW m n : m < n -> m <= n. Proof. exact: leq_trans. Qed. #[global] Hint Resolve ltnW : core. Definition addn_rec := plus. Notation "m + n" := (addn_rec m n) : nat_rec_scope. Definition addn := nosimpl addn_rec. Notation "m + n" := (addn m n) : nat_scope. Lemma addn0 : right_id 0 addn. Proof. by move=> n; apply/eqP; elim: n. Qed. Lemma add0n : left_id 0 addn. Proof. by []. Qed. Lemma addSn m n : m.+1 + n = (m + n).+1. Proof. by []. Qed. Lemma addnS m n : m + n.+1 = (m + n).+1. Proof. by elim: m. Qed. Lemma addnCA : left_commutative addn. Proof. by move=> m n p; elim: m => //= m; rewrite addnS => <-. Qed. Lemma addnC : commutative addn. Proof. by move=> m n; rewrite -{1}[n]addn0 addnCA addn0. Qed. Lemma addnA : associative addn. Proof. by move=> m n p; rewrite (addnC n) addnCA addnC. Qed. Lemma subnK m n : m <= n -> (n - m) + m = n. Admitted. Definition muln_rec := mult. Notation "m * n" := (muln_rec m n) : nat_rec_scope. Definition muln := nosimpl muln_rec. Notation "m * n" := (muln m n) : nat_scope. Lemma mul0n : left_zero 0 muln. Proof. by []. Qed. Lemma muln0 : right_zero 0 muln. Proof. by elim. Qed. Lemma mul1n : left_id 1 muln. Proof. exact: addn0. Qed. Lemma mulSn m n : m.+1 * n = n + m * n. Proof. by []. Qed. Lemma mulSnr m n : m.+1 * n = m * n + n. Proof. exact: addnC. Qed. Lemma mulnS m n : m * n.+1 = m + m * n. Proof. by elim: m => // m; rewrite !mulSn !addSn addnCA => ->. Qed. Lemma mulnSr m n : m * n.+1 = m * n + m. Proof. by rewrite addnC mulnS. Qed. Lemma muln1 : right_id 1 muln. Proof. by move=> n; rewrite mulnSr muln0. Qed. Lemma mulnC : commutative muln. Proof. by move=> m n; elim: m => [|m]; rewrite (muln0, mulnS) // mulSn => ->. Qed. Lemma mulnDl : left_distributive muln addn. Proof. by move=> m1 m2 n; elim: m1 => //= m1 IHm; rewrite -addnA -IHm. Qed. Lemma mulnDr : right_distributive muln addn. Proof. by move=> m n1 n2; rewrite !(mulnC m) mulnDl. Qed. Lemma mulnA : associative muln. Proof. by move=> m n p; elim: m => //= m; rewrite mulSn mulnDl => ->. Qed. Lemma mulnCA : left_commutative muln. Proof. by move=> m n1 n2; rewrite !mulnA (mulnC m). Qed. Lemma mulnAC : right_commutative muln. Proof. by move=> m n p; rewrite -!mulnA (mulnC n). Qed. Lemma mulnACA : interchange muln muln. Proof. by move=> m n p q; rewrite -!mulnA (mulnCA n). Qed. (* seq ------------------------------------------------------------- *) Declare Scope seq_scope. Delimit Scope seq_scope with SEQ. Open Scope seq_scope. (* Inductive seq (T : Type) : Type := Nil | Cons of T & seq T. *) Notation seq := list. Prenex Implicits cons. Notation Cons T := (@cons T) (only parsing). Notation Nil T := (@nil T) (only parsing). Bind Scope seq_scope with list. Arguments cons _%_type _ _%_SEQ. (* As :: and ++ are (improperly) declared in Init.datatypes, we only rebind *) (* them here. *) Infix "::" := cons : seq_scope. (* GG - this triggers a camlp4 warning, as if this Notation had been Reserved *) Notation "[ :: ]" := nil (at level 0, format "[ :: ]") : seq_scope. Notation "[ :: x1 ]" := (x1 :: [::]) (at level 0, format "[ :: x1 ]") : seq_scope. Notation "[ :: x & s ]" := (x :: s) (at level 0, only parsing) : seq_scope. Notation "[ :: x1 , x2 , .. , xn & s ]" := (x1 :: x2 :: .. (xn :: s) ..) (at level 0, format "'[hv' [ :: '[' x1 , '/' x2 , '/' .. , '/' xn ']' '/ ' & s ] ']'" ) : seq_scope. Notation "[ :: x1 ; x2 ; .. ; xn ]" := (x1 :: x2 :: .. [:: xn] ..) (at level 0, format "[ :: '[' x1 ; '/' x2 ; '/' .. ; '/' xn ']' ]" ) : seq_scope. Section Sequences. Variable n0 : nat. (* numerical parameter for take, drop et al *) Variable T : Type. (* must come before the implicit Type *) Variable x0 : T. (* default for head/nth *) Implicit Types x y z : T. Implicit Types m n : nat. Implicit Type s : seq T. Fixpoint size s := if s is _ :: s' then (size s').+1 else 0. Fixpoint cat s1 s2 := if s1 is x :: s1' then x :: s1' ++ s2 else s2 where "s1 ++ s2" := (cat s1 s2) : seq_scope. Lemma cat0s s : [::] ++ s = s. Proof. by []. Qed. Lemma cats0 s : s ++ [::] = s. Proof. by elim: s => //= x s ->. Qed. Lemma catA s1 s2 s3 : s1 ++ s2 ++ s3 = (s1 ++ s2) ++ s3. Proof. by elim: s1 => //= x s1 ->. Qed. Fixpoint nth s n {struct n} := if s is x :: s' then if n is n'.+1 then @nth s' n' else x else x0. Fixpoint rcons s z := if s is x :: s' then x :: rcons s' z else [:: z]. Variant last_spec : seq T -> Type := | LastNil : last_spec [::] | LastRcons s x : last_spec (rcons s x). Lemma lastP s : last_spec s. Proof using. Admitted. Lemma last_ind P : P [::] -> (forall s x, P s -> P (rcons s x)) -> forall s, P s. Proof using. Admitted. Section Map. Variables (T2 : Type) (f : T -> T2). Fixpoint map s := if s is x :: s' then f x :: map s' else [::]. End Map. Section SeqFind. Variable a : pred T. Fixpoint count s := if s is x :: s' then a x + count s' else 0. Fixpoint filter s := if s is x :: s' then if a x then x :: filter s' else filter s' else [::]. End SeqFind. End Sequences. Infix "++" := cat : seq_scope. Notation count_mem x := (count (pred_of_simpl (pred1 x))). Section EqSeq. Variables (n0 : nat) (T : eqType) (x0 : T). Local Notation nth := (nth x0). Implicit Type s : seq T. Implicit Types x y z : T. Fixpoint eqseq s1 s2 {struct s2} := match s1, s2 with | [::], [::] => true | x1 :: s1', x2 :: s2' => (x1 == x2) && eqseq s1' s2' | _, _ => false end. Lemma eqseqP : Equality.axiom eqseq. Proof. move; elim=> [|x1 s1 IHs] [|x2 s2]; do [by constructor | simpl]. case: (x1 =P x2) => [<-|neqx]; last by right; case. by apply: (iffP (IHs s2)) => [<-|[]]. Qed. Canonical seq_eqMixin := EqMixin eqseqP. Canonical seq_eqType := Eval hnf in EqType (seq T) seq_eqMixin. Fixpoint mem_seq (s : seq T) := if s is y :: s' then xpredU1 y (mem_seq s') else xpred0. Definition eqseq_class := seq T. Identity Coercion seq_of_eqseq : eqseq_class >-> seq. Coercion pred_of_eq_seq (s : eqseq_class) : {pred T} := [eta mem_seq s]. Canonical seq_predType := @PredType T (seq T) pred_of_eq_seq. Fixpoint uniq s := if s is x :: s' then (x \notin s') && uniq s' else true. End EqSeq. Definition bitseq := seq bool. Canonical bitseq_eqType := Eval hnf in [eqType of bitseq]. Canonical bitseq_predType := Eval hnf in [predType of bitseq]. Section Pmap. Variables (aT rT : Type) (f : aT -> option rT) (g : rT -> aT). Fixpoint pmap s := if s is x :: s' then let r := pmap s' in oapp (cons^~ r) r (f x) else [::]. End Pmap. Fixpoint iota m n := if n is n'.+1 then m :: iota m.+1 n' else [::]. Section FoldRight. Variables (T : Type) (R : Type) (f : T -> R -> R) (z0 : R). Fixpoint foldr s := if s is x :: s' then f x (foldr s') else z0. End FoldRight. Lemma mem_iota m n i : (i \in iota m n) = (m <= i) && (i < m + n). Admitted. (* choice ------------------------------------------------------------- *) Module Choice. Section ClassDef. Record mixin_of T := Mixin { find : pred T -> nat -> option T; _ : forall P n x, find P n = Some x -> P x; _ : forall P : pred T, (exists x, P x) -> exists n, find P n; _ : forall P Q : pred T, P =1 Q -> find P =1 find Q }. Record class_of T := Class {base : Equality.class_of T; mixin : mixin_of T}. Local Coercion base : class_of >-> Equality.class_of. Structure type := Pack {sort; _ : class_of sort; _ : Type}. Local Coercion sort : type >-> Sortclass. Variables (T : Type) (cT : type). Definition class := let: Pack _ c _ as cT' := cT return class_of cT' in c. Definition clone c of phant_id class c := @Pack T c T. Let xT := let: Pack T _ _ := cT in T. Notation xclass := (class : class_of xT). Definition pack m := fun b bT & phant_id (Equality.class bT) b => Pack (@Class T b m) T. (* Inheritance *) Definition eqType := @Equality.Pack cT xclass xT. End ClassDef. Module Import Exports. Coercion base : class_of >-> Equality.class_of. Coercion sort : type >-> Sortclass. Coercion eqType : type >-> Equality.type. Canonical eqType. Notation choiceType := type. Notation choiceMixin := mixin_of. Notation ChoiceType T m := (@pack T m _ _ id). Notation "[ 'choiceType' 'of' T 'for' cT ]" := (@clone T cT _ idfun) (at level 0, format "[ 'choiceType' 'of' T 'for' cT ]") : form_scope. Notation "[ 'choiceType' 'of' T ]" := (@clone T _ _ id) (at level 0, format "[ 'choiceType' 'of' T ]") : form_scope. End Exports. End Choice. Export Choice.Exports. Section ChoiceTheory. Variable T : choiceType. Section CanChoice. Variables (sT : Type) (f : sT -> T). Lemma PcanChoiceMixin f' : pcancel f f' -> choiceMixin sT. Admitted. Definition CanChoiceMixin f' (fK : cancel f f') := PcanChoiceMixin (can_pcan fK). End CanChoice. Section SubChoice. Variables (P : pred T) (sT : subType P). Definition sub_choiceMixin := PcanChoiceMixin (@valK T P sT). Definition sub_choiceClass := @Choice.Class sT (sub_eqMixin sT) sub_choiceMixin. Canonical sub_choiceType := Choice.Pack sub_choiceClass sT. End SubChoice. Fact seq_choiceMixin : choiceMixin (seq T). Admitted. Canonical seq_choiceType := Eval hnf in ChoiceType (seq T) seq_choiceMixin. End ChoiceTheory. Fact nat_choiceMixin : choiceMixin nat. Proof. pose f := [fun (P : pred nat) n => if P n then Some n else None]. exists f => [P n m | P [n Pn] | P Q eqPQ n] /=; last by rewrite eqPQ. by case: ifP => // Pn [<-]. by exists n; rewrite Pn. Qed. Canonical nat_choiceType := Eval hnf in ChoiceType nat nat_choiceMixin. Definition bool_choiceMixin := CanChoiceMixin oddb. Canonical bool_choiceType := Eval hnf in ChoiceType bool bool_choiceMixin. Canonical bitseq_choiceType := Eval hnf in [choiceType of bitseq]. Notation "[ 'choiceMixin' 'of' T 'by' <: ]" := (sub_choiceMixin _ : choiceMixin T) (at level 0, format "[ 'choiceMixin' 'of' T 'by' <: ]") : form_scope. Module Countable. Record mixin_of (T : Type) : Type := Mixin { pickle : T -> nat; unpickle : nat -> option T; pickleK : pcancel pickle unpickle }. Definition EqMixin T m := PcanEqMixin (@pickleK T m). Definition ChoiceMixin T m := PcanChoiceMixin (@pickleK T m). Section ClassDef. Record class_of T := Class { base : Choice.class_of T; mixin : mixin_of T }. Local Coercion base : class_of >-> Choice.class_of. Structure type : Type := Pack {sort : Type; _ : class_of sort; _ : Type}. Local Coercion sort : type >-> Sortclass. Variables (T : Type) (cT : type). Definition class := let: Pack _ c _ as cT' := cT return class_of cT' in c. Definition clone c of phant_id class c := @Pack T c T. Let xT := let: Pack T _ _ := cT in T. Notation xclass := (class : class_of xT). Definition pack m := fun bT b & phant_id (Choice.class bT) b => Pack (@Class T b m) T. Definition eqType := @Equality.Pack cT xclass xT. Definition choiceType := @Choice.Pack cT xclass xT. End ClassDef. Module Exports. Coercion base : class_of >-> Choice.class_of. Coercion mixin : class_of >-> mixin_of. Coercion sort : type >-> Sortclass. Coercion eqType : type >-> Equality.type. Canonical eqType. Coercion choiceType : type >-> Choice.type. Canonical choiceType. Notation countType := type. Notation CountType T m := (@pack T m _ _ id). Notation CountMixin := Mixin. Notation CountChoiceMixin := ChoiceMixin. Notation "[ 'countType' 'of' T 'for' cT ]" := (@clone T cT _ idfun) (at level 0, format "[ 'countType' 'of' T 'for' cT ]") : form_scope. Notation "[ 'countType' 'of' T ]" := (@clone T _ _ id) (at level 0, format "[ 'countType' 'of' T ]") : form_scope. End Exports. End Countable. Export Countable.Exports. Definition unpickle T := Countable.unpickle (Countable.class T). Definition pickle T := Countable.pickle (Countable.class T). Arguments unpickle [T]. Prenex Implicits pickle unpickle. Section CountableTheory. Variable T : countType. Lemma pickleK : @pcancel nat T pickle unpickle. Proof. exact: Countable.pickleK. Qed. Definition pickle_inv n := obind (fun x : T => if pickle x == n then Some x else None) (unpickle n). Lemma pickle_invK : ocancel pickle_inv pickle. Proof. by rewrite /pickle_inv => n; case def_x: (unpickle n) => //= [x]; case: eqP. Qed. Lemma pickleK_inv : pcancel pickle pickle_inv. Proof. by rewrite /pickle_inv => x; rewrite pickleK /= eqxx. Qed. Lemma pcan_pickleK sT f f' : @pcancel T sT f f' -> pcancel (pickle \o f) (pcomp f' unpickle). Proof. by move=> fK x; rewrite /pcomp pickleK /= fK. Qed. Definition PcanCountMixin sT f f' (fK : pcancel f f') := @CountMixin sT _ _ (pcan_pickleK fK). Definition CanCountMixin sT f f' (fK : cancel f f') := @PcanCountMixin sT _ _ (can_pcan fK). Definition sub_countMixin P sT := PcanCountMixin (@valK T P sT). End CountableTheory. Notation "[ 'countMixin' 'of' T 'by' <: ]" := (sub_countMixin _ : Countable.mixin_of T) (at level 0, format "[ 'countMixin' 'of' T 'by' <: ]") : form_scope. Section SubCountType. Variables (T : choiceType) (P : pred T). Import Countable. Structure subCountType : Type := SubCountType {subCount_sort :> subType P; _ : mixin_of subCount_sort}. Coercion sub_countType (sT : subCountType) := Eval hnf in pack (let: SubCountType _ m := sT return mixin_of sT in m) id. Canonical sub_countType. Definition pack_subCountType U := fun sT cT & sub_sort sT * sort cT -> U * U => fun b m & phant_id (Class b m) (class cT) => @SubCountType sT m. End SubCountType. (* This assumes that T has both countType and subType structures. *) Notation "[ 'subCountType' 'of' T ]" := (@pack_subCountType _ _ T _ _ id _ _ id) (at level 0, format "[ 'subCountType' 'of' T ]") : form_scope. Lemma nat_pickleK : pcancel id (@Some nat). Proof. by []. Qed. Definition nat_countMixin := CountMixin nat_pickleK. Canonical nat_countType := Eval hnf in CountType nat nat_countMixin. (* fintype --------------------------------------------------------- *) Module Finite. Section RawMixin. Variable T : eqType. Definition axiom e := forall x : T, count_mem x e = 1. Lemma uniq_enumP e : uniq e -> e =i T -> axiom e. Admitted. Record mixin_of := Mixin { mixin_base : Countable.mixin_of T; mixin_enum : seq T; _ : axiom mixin_enum }. End RawMixin. Section Mixins. Variable T : countType. Definition EnumMixin := let: Countable.Pack _ (Countable.Class _ m) _ as cT := T return forall e : seq cT, axiom e -> mixin_of cT in @Mixin (EqType _ _) m. Definition UniqMixin e Ue eT := @EnumMixin e (uniq_enumP Ue eT). Variable n : nat. End Mixins. Section ClassDef. Record class_of T := Class { base : Choice.class_of T; mixin : mixin_of (Equality.Pack base T) }. Definition base2 T c := Countable.Class (@base T c) (mixin_base (mixin c)). Local Coercion base : class_of >-> Choice.class_of. Structure type : Type := Pack {sort; _ : class_of sort; _ : Type}. Local Coercion sort : type >-> Sortclass. Variables (T : Type) (cT : type). Definition class := let: Pack _ c _ as cT' := cT return class_of cT' in c. Definition clone c of phant_id class c := @Pack T c T. Let xT := let: Pack T _ _ := cT in T. Notation xclass := (class : class_of xT). Definition pack b0 (m0 : mixin_of (EqType T b0)) := fun bT b & phant_id (Choice.class bT) b => fun m & phant_id m0 m => Pack (@Class T b m) T. Definition eqType := @Equality.Pack cT xclass xT. Definition choiceType := @Choice.Pack cT xclass xT. Definition countType := @Countable.Pack cT (base2 xclass) xT. End ClassDef. Module Import Exports. Coercion mixin_base : mixin_of >-> Countable.mixin_of. Coercion base : class_of >-> Choice.class_of. Coercion mixin : class_of >-> mixin_of. Coercion base2 : class_of >-> Countable.class_of. Coercion sort : type >-> Sortclass. Coercion eqType : type >-> Equality.type. Canonical eqType. Coercion choiceType : type >-> Choice.type. Canonical choiceType. Coercion countType : type >-> Countable.type. Canonical countType. Notation finType := type. Notation FinType T m := (@pack T _ m _ _ id _ id). Notation FinMixin := EnumMixin. Notation UniqFinMixin := UniqMixin. Notation "[ 'finType' 'of' T 'for' cT ]" := (@clone T cT _ idfun) (at level 0, format "[ 'finType' 'of' T 'for' cT ]") : form_scope. Notation "[ 'finType' 'of' T ]" := (@clone T _ _ id) (at level 0, format "[ 'finType' 'of' T ]") : form_scope. End Exports. Module Type EnumSig. Parameter enum : forall cT : type, seq cT. Axiom enumDef : enum = fun cT => mixin_enum (class cT). End EnumSig. Module EnumDef : EnumSig. Definition enum cT := mixin_enum (class cT). Definition enumDef := erefl enum. End EnumDef. Notation enum := EnumDef.enum. End Finite. Export Finite.Exports. Section SubFinType. Variables (T : choiceType) (P : pred T). Import Finite. Structure subFinType := SubFinType { subFin_sort :> subType P; _ : mixin_of (sub_eqType subFin_sort) }. Definition pack_subFinType U := fun cT b m & phant_id (class cT) (@Class U b m) => fun sT m' & phant_id m' m => @SubFinType sT m'. Implicit Type sT : subFinType. Definition subFin_mixin sT := let: SubFinType _ m := sT return mixin_of (sub_eqType sT) in m. Coercion subFinType_subCountType sT := @SubCountType _ _ sT (subFin_mixin sT). Canonical subFinType_subCountType. Coercion subFinType_finType sT := Pack (@Class sT (sub_choiceClass sT) (subFin_mixin sT)) sT. Canonical subFinType_finType. Definition enum_mem T (mA : mem_pred _) := filter mA (Finite.enum T). Definition image_mem T T' f mA : seq T' := map f (@enum_mem T mA). Definition codom T T' f := @image_mem T T' f (mem T). Lemma codom_val sT x : (x \in codom (val : sT -> T)) = P x. Admitted. End SubFinType. (* This assumes that T has both finType and subCountType structures. *) Notation "[ 'subFinType' 'of' T ]" := (@pack_subFinType _ _ T _ _ _ id _ _ id) (at level 0, format "[ 'subFinType' 'of' T ]") : form_scope. Section OrdinalSub. Variable n : nat. Inductive ordinal : predArgType := Ordinal m of m < n. Coercion nat_of_ord i := let: Ordinal m _ := i in m. Canonical ordinal_subType := [subType for nat_of_ord]. Definition ordinal_eqMixin := Eval hnf in [eqMixin of ordinal by <:]. Canonical ordinal_eqType := Eval hnf in EqType ordinal ordinal_eqMixin. Definition ordinal_choiceMixin := [choiceMixin of ordinal by <:]. Canonical ordinal_choiceType := Eval hnf in ChoiceType ordinal ordinal_choiceMixin. Definition ordinal_countMixin := [countMixin of ordinal by <:]. Canonical ordinal_countType := Eval hnf in CountType ordinal ordinal_countMixin. Canonical ordinal_subCountType := [subCountType of ordinal]. Lemma ltn_ord (i : ordinal) : i < n. Proof. exact: valP i. Qed. Lemma ord_inj : injective nat_of_ord. Proof. exact: val_inj. Qed. Definition ord_enum : seq ordinal := pmap insub (iota 0 n). Lemma val_ord_enum : map val ord_enum = iota 0 n. Admitted. Lemma ord_enum_uniq : uniq ord_enum. Admitted. Lemma mem_ord_enum i : i \in ord_enum. Admitted. Definition ordinal_finMixin := Eval hnf in UniqFinMixin ord_enum_uniq mem_ord_enum. Canonical ordinal_finType := Eval hnf in FinType ordinal ordinal_finMixin. Canonical ordinal_subFinType := Eval hnf in [subFinType of ordinal]. End OrdinalSub. Notation "''I_' n" := (ordinal n) (at level 8, n at level 2, format "''I_' n"). (* bigop ----------------------------------------------------------------- *) Reserved Notation "\big [ op / idx ]_ i F" (at level 36, F at level 36, op, idx at level 10, i at level 0, right associativity, format "'[' \big [ op / idx ]_ i '/ ' F ']'"). Reserved Notation "\big [ op / idx ]_ ( i <- r | P ) F" (at level 36, F at level 36, op, idx at level 10, i, r at level 50, format "'[' \big [ op / idx ]_ ( i <- r | P ) '/ ' F ']'"). Reserved Notation "\big [ op / idx ]_ ( i <- r ) F" (at level 36, F at level 36, op, idx at level 10, i, r at level 50, format "'[' \big [ op / idx ]_ ( i <- r ) '/ ' F ']'"). Reserved Notation "\big [ op / idx ]_ ( m <= i < n | P ) F" (at level 36, F at level 36, op, idx at level 10, m, i, n at level 50, format "'[' \big [ op / idx ]_ ( m <= i < n | P ) F ']'"). Reserved Notation "\big [ op / idx ]_ ( m <= i < n ) F" (at level 36, F at level 36, op, idx at level 10, i, m, n at level 50, format "'[' \big [ op / idx ]_ ( m <= i < n ) '/ ' F ']'"). Reserved Notation "\big [ op / idx ]_ ( i | P ) F" (at level 36, F at level 36, op, idx at level 10, i at level 50, format "'[' \big [ op / idx ]_ ( i | P ) '/ ' F ']'"). Reserved Notation "\big [ op / idx ]_ ( i : t | P ) F" (at level 36, F at level 36, op, idx at level 10, i at level 50, format "'[' \big [ op / idx ]_ ( i : t | P ) '/ ' F ']'"). Reserved Notation "\big [ op / idx ]_ ( i : t ) F" (at level 36, F at level 36, op, idx at level 10, i at level 50, format "'[' \big [ op / idx ]_ ( i : t ) '/ ' F ']'"). Reserved Notation "\big [ op / idx ]_ ( i < n | P ) F" (at level 36, F at level 36, op, idx at level 10, i, n at level 50, format "'[' \big [ op / idx ]_ ( i < n | P ) '/ ' F ']'"). Reserved Notation "\big [ op / idx ]_ ( i < n ) F" (at level 36, F at level 36, op, idx at level 10, i, n at level 50, format "'[' \big [ op / idx ]_ ( i < n ) F ']'"). Reserved Notation "\big [ op / idx ]_ ( i 'in' A | P ) F" (at level 36, F at level 36, op, idx at level 10, i, A at level 50, format "'[' \big [ op / idx ]_ ( i 'in' A | P ) '/ ' F ']'"). Reserved Notation "\big [ op / idx ]_ ( i 'in' A ) F" (at level 36, F at level 36, op, idx at level 10, i, A at level 50, format "'[' \big [ op / idx ]_ ( i 'in' A ) '/ ' F ']'"). Module Monoid. Section Definitions. Variables (T : Type) (idm : T). Structure law := Law { operator : T -> T -> T; _ : associative operator; _ : left_id idm operator; _ : right_id idm operator }. Local Coercion operator : law >-> Funclass. Structure com_law := ComLaw { com_operator : law; _ : commutative com_operator }. Local Coercion com_operator : com_law >-> law. Structure mul_law := MulLaw { mul_operator : T -> T -> T; _ : left_zero idm mul_operator; _ : right_zero idm mul_operator }. Local Coercion mul_operator : mul_law >-> Funclass. Structure add_law (mul : T -> T -> T) := AddLaw { add_operator : com_law; _ : left_distributive mul add_operator; _ : right_distributive mul add_operator }. Local Coercion add_operator : add_law >-> com_law. Let op_id (op1 op2 : T -> T -> T) := phant_id op1 op2. Definition clone_law op := fun (opL : law) & op_id opL op => fun opmA op1m opm1 (opL' := @Law op opmA op1m opm1) & phant_id opL' opL => opL'. Definition clone_com_law op := fun (opL : law) (opC : com_law) & op_id opL op & op_id opC op => fun opmC (opC' := @ComLaw opL opmC) & phant_id opC' opC => opC'. Definition clone_mul_law op := fun (opM : mul_law) & op_id opM op => fun op0m opm0 (opM' := @MulLaw op op0m opm0) & phant_id opM' opM => opM'. Definition clone_add_law mop aop := fun (opC : com_law) (opA : add_law mop) & op_id opC aop & op_id opA aop => fun mopDm mopmD (opA' := @AddLaw mop opC mopDm mopmD) & phant_id opA' opA => opA'. End Definitions. Module Import Exports. Coercion operator : law >-> Funclass. Coercion com_operator : com_law >-> law. Coercion mul_operator : mul_law >-> Funclass. Coercion add_operator : add_law >-> com_law. Notation "[ 'law' 'of' f ]" := (@clone_law _ _ f _ id _ _ _ id) (at level 0, format"[ 'law' 'of' f ]") : form_scope. Notation "[ 'com_law' 'of' f ]" := (@clone_com_law _ _ f _ _ id id _ id) (at level 0, format "[ 'com_law' 'of' f ]") : form_scope. Notation "[ 'mul_law' 'of' f ]" := (@clone_mul_law _ _ f _ id _ _ id) (at level 0, format"[ 'mul_law' 'of' f ]") : form_scope. Notation "[ 'add_law' m 'of' a ]" := (@clone_add_law _ _ m a _ _ id id _ _ id) (at level 0, format "[ 'add_law' m 'of' a ]") : form_scope. End Exports. Section CommutativeAxioms. Variable (T : Type) (zero one : T) (mul add : T -> T -> T) (inv : T -> T). Hypothesis mulC : commutative mul. Lemma mulC_id : left_id one mul -> right_id one mul. Proof. by move=> mul1x x; rewrite mulC. Qed. Lemma mulC_zero : left_zero zero mul -> right_zero zero mul. Proof. by move=> mul0x x; rewrite mulC. Qed. Lemma mulC_dist : left_distributive mul add -> right_distributive mul add. Proof. by move=> mul_addl x y z; rewrite !(mulC x). Qed. End CommutativeAxioms. Module Theory. Section Theory. Variables (T : Type) (idm : T). Section Plain. Variable mul : law idm. Lemma mul1m : left_id idm mul. Proof. by case mul. Qed. Lemma mulm1 : right_id idm mul. Proof. by case mul. Qed. Lemma mulmA : associative mul. Proof. by case mul. Qed. (*Lemma iteropE n x : iterop n mul x idm = iter n (mul x) idm.*) End Plain. Section Commutative. Variable mul : com_law idm. Lemma mulmC : commutative mul. Proof. by case mul. Qed. Lemma mulmCA : left_commutative mul. Proof. by move=> x y z; rewrite !mulmA (mulmC x). Qed. Lemma mulmAC : right_commutative mul. Proof. by move=> x y z; rewrite -!mulmA (mulmC y). Qed. Lemma mulmACA : interchange mul mul. Proof. by move=> x y z t; rewrite -!mulmA (mulmCA y). Qed. End Commutative. Section Mul. Variable mul : mul_law idm. Lemma mul0m : left_zero idm mul. Proof. by case mul. Qed. Lemma mulm0 : right_zero idm mul. Proof. by case mul. Qed. End Mul. Section Add. Variables (mul : T -> T -> T) (add : add_law idm mul). Lemma addmA : associative add. Proof. exact: mulmA. Qed. Lemma addmC : commutative add. Proof. exact: mulmC. Qed. Lemma addmCA : left_commutative add. Proof. exact: mulmCA. Qed. Lemma addmAC : right_commutative add. Proof. exact: mulmAC. Qed. Lemma add0m : left_id idm add. Proof. exact: mul1m. Qed. Lemma addm0 : right_id idm add. Proof. exact: mulm1. Qed. Lemma mulm_addl : left_distributive mul add. Proof. by case add. Qed. Lemma mulm_addr : right_distributive mul add. Proof. by case add. Qed. End Add. Definition simpm := (mulm1, mulm0, mul1m, mul0m, mulmA). End Theory. End Theory. Include Theory. End Monoid. Export Monoid.Exports. Section PervasiveMonoids. Import Monoid. Canonical andb_monoid := Law andbA andTb andbT. Canonical andb_comoid := ComLaw andbC. Canonical andb_muloid := MulLaw andFb andbF. Canonical orb_monoid := Law orbA orFb orbF. Canonical orb_comoid := ComLaw orbC. Canonical orb_muloid := MulLaw orTb orbT. Canonical addb_monoid := Law addbA addFb addbF. Canonical addb_comoid := ComLaw addbC. Canonical orb_addoid := AddLaw andb_orl andb_orr. Canonical andb_addoid := AddLaw orb_andl orb_andr. Canonical addb_addoid := AddLaw andb_addl andb_addr. Canonical addn_monoid := Law addnA add0n addn0. Canonical addn_comoid := ComLaw addnC. Canonical muln_monoid := Law mulnA mul1n muln1. Canonical muln_comoid := ComLaw mulnC. Canonical muln_muloid := MulLaw mul0n muln0. Canonical addn_addoid := AddLaw mulnDl mulnDr. Canonical cat_monoid T := Law (@catA T) (@cat0s T) (@cats0 T). End PervasiveMonoids. Declare Scope big_scope. Delimit Scope big_scope with BIG. Open Scope big_scope. (* The bigbody wrapper is a workaround for a quirk of the Coq pretty-printer, *) (* which would fail to redisplay the \big notation when the or *) (* do not depend on the bound index. The BigBody constructor *) (* packages both in in a term in which i occurs; it also depends on the *) (* iterated , as this can give more information on the expected type of *) (* the , thus allowing for the insertion of coercions. *) Variant bigbody R I := BigBody of I & (R -> R -> R) & bool & R. Definition applybig {R I} (body : bigbody R I) x := let: BigBody _ op b v := body in if b then op v x else x. Definition reducebig R I idx r (body : I -> bigbody R I) := foldr (applybig \o body) idx r. Module Type BigOpSig. Parameter bigop : forall R I, R -> seq I -> (I -> bigbody R I) -> R. Axiom bigopE : bigop = reducebig. End BigOpSig. Module BigOp : BigOpSig. Definition bigop := reducebig. Lemma bigopE : bigop = reducebig. Proof. by []. Qed. End BigOp. Notation bigop := BigOp.bigop (only parsing). Canonical bigop_unlock := Unlockable BigOp.bigopE. Definition index_iota m n := iota m (n - m). Definition index_enum (T : finType) := Finite.enum T. Lemma mem_index_iota m n i : i \in index_iota m n = (m <= i < n). Admitted. Lemma mem_index_enum T i : i \in index_enum T. Admitted. #[global] Hint Resolve mem_index_enum : core. (* Lemma filter_index_enum T P : filter P (index_enum T) = enum P. Proof. by []. Qed. *) Notation "\big [ op / idx ]_ ( i <- r | P ) F" := (bigop idx r (fun i => BigBody i op P%B F)) : big_scope. Notation "\big [ op / idx ]_ ( i <- r ) F" := (bigop idx r (fun i => BigBody i op true F)) : big_scope. Notation "\big [ op / idx ]_ ( m <= i < n | P ) F" := (bigop idx (index_iota m n) (fun i : nat => BigBody i op P%B F)) : big_scope. Notation "\big [ op / idx ]_ ( m <= i < n ) F" := (bigop idx (index_iota m n) (fun i : nat => BigBody i op true F)) : big_scope. Notation "\big [ op / idx ]_ ( i | P ) F" := (bigop idx (index_enum _) (fun i => BigBody i op P%B F)) : big_scope. Notation "\big [ op / idx ]_ i F" := (bigop idx (index_enum _) (fun i => BigBody i op true F)) : big_scope. Notation "\big [ op / idx ]_ ( i : t | P ) F" := (bigop idx (index_enum _) (fun i : t => BigBody i op P%B F)) (only parsing) : big_scope. Notation "\big [ op / idx ]_ ( i : t ) F" := (bigop idx (index_enum _) (fun i : t => BigBody i op true F)) (only parsing) : big_scope. Notation "\big [ op / idx ]_ ( i < n | P ) F" := (\big[op/idx]_(i : ordinal n | P%B) F) : big_scope. Notation "\big [ op / idx ]_ ( i < n ) F" := (\big[op/idx]_(i : ordinal n) F) : big_scope. Notation "\big [ op / idx ]_ ( i 'in' A | P ) F" := (\big[op/idx]_(i | (i \in A) && P) F) : big_scope. Notation "\big [ op / idx ]_ ( i 'in' A ) F" := (\big[op/idx]_(i | i \in A) F) : big_scope. Notation BIG_F := (F in \big[_/_]_(i <- _ | _) F i)%pattern. Notation BIG_P := (P in \big[_/_]_(i <- _ | P i) _)%pattern. (* Induction loading *) Lemma big_load R (K K' : R -> Type) idx op I r (P : pred I) F : K (\big[op/idx]_(i <- r | P i) F i) * K' (\big[op/idx]_(i <- r | P i) F i) -> K' (\big[op/idx]_(i <- r | P i) F i). Proof. by case. Qed. Arguments big_load [R] K [K'] idx op [I]. Section Elim3. Variables (R1 R2 R3 : Type) (K : R1 -> R2 -> R3 -> Type). Variables (id1 : R1) (op1 : R1 -> R1 -> R1). Variables (id2 : R2) (op2 : R2 -> R2 -> R2). Variables (id3 : R3) (op3 : R3 -> R3 -> R3). Hypothesis Kid : K id1 id2 id3. Lemma big_rec3 I r (P : pred I) F1 F2 F3 (K_F : forall i y1 y2 y3, P i -> K y1 y2 y3 -> K (op1 (F1 i) y1) (op2 (F2 i) y2) (op3 (F3 i) y3)) : K (\big[op1/id1]_(i <- r | P i) F1 i) (\big[op2/id2]_(i <- r | P i) F2 i) (\big[op3/id3]_(i <- r | P i) F3 i). Proof. by rewrite unlock; elim: r => //= i r; case: ifP => //; apply: K_F. Qed. Hypothesis Kop : forall x1 x2 x3 y1 y2 y3, K x1 x2 x3 -> K y1 y2 y3-> K (op1 x1 y1) (op2 x2 y2) (op3 x3 y3). Lemma big_ind3 I r (P : pred I) F1 F2 F3 (K_F : forall i, P i -> K (F1 i) (F2 i) (F3 i)) : K (\big[op1/id1]_(i <- r | P i) F1 i) (\big[op2/id2]_(i <- r | P i) F2 i) (\big[op3/id3]_(i <- r | P i) F3 i). Proof. by apply: big_rec3 => i x1 x2 x3 /K_F; apply: Kop. Qed. End Elim3. Arguments big_rec3 [R1 R2 R3] K [id1 op1 id2 op2 id3 op3] _ [I r P F1 F2 F3]. Arguments big_ind3 [R1 R2 R3] K [id1 op1 id2 op2 id3 op3] _ _ [I r P F1 F2 F3]. Section Elim2. Variables (R1 R2 : Type) (K : R1 -> R2 -> Type) (f : R2 -> R1). Variables (id1 : R1) (op1 : R1 -> R1 -> R1). Variables (id2 : R2) (op2 : R2 -> R2 -> R2). Hypothesis Kid : K id1 id2. Lemma big_rec2 I r (P : pred I) F1 F2 (K_F : forall i y1 y2, P i -> K y1 y2 -> K (op1 (F1 i) y1) (op2 (F2 i) y2)) : K (\big[op1/id1]_(i <- r | P i) F1 i) (\big[op2/id2]_(i <- r | P i) F2 i). Proof. by rewrite unlock; elim: r => //= i r; case: ifP => //; apply: K_F. Qed. Hypothesis Kop : forall x1 x2 y1 y2, K x1 x2 -> K y1 y2 -> K (op1 x1 y1) (op2 x2 y2). Lemma big_ind2 I r (P : pred I) F1 F2 (K_F : forall i, P i -> K (F1 i) (F2 i)) : K (\big[op1/id1]_(i <- r | P i) F1 i) (\big[op2/id2]_(i <- r | P i) F2 i). Proof. by apply: big_rec2 => i x1 x2 /K_F; apply: Kop. Qed. Hypotheses (f_op : {morph f : x y / op2 x y >-> op1 x y}) (f_id : f id2 = id1). Lemma big_morph I r (P : pred I) F : f (\big[op2/id2]_(i <- r | P i) F i) = \big[op1/id1]_(i <- r | P i) f (F i). Proof. by rewrite unlock; elim: r => //= i r <-; rewrite -f_op -fun_if. Qed. End Elim2. Arguments big_rec2 [R1 R2] K [id1 op1 id2 op2] _ [I r P F1 F2]. Arguments big_ind2 [R1 R2] K [id1 op1 id2 op2] _ _ [I r P F1 F2]. Arguments big_morph [R1 R2] f [id1 op1 id2 op2] _ _ [I]. Section Elim1. Variables (R : Type) (K : R -> Type) (f : R -> R). Variables (idx : R) (op op' : R -> R -> R). Hypothesis Kid : K idx. Lemma big_rec I r (P : pred I) F (Kop : forall i x, P i -> K x -> K (op (F i) x)) : K (\big[op/idx]_(i <- r | P i) F i). Proof. by rewrite unlock; elim: r => //= i r; case: ifP => //; apply: Kop. Qed. Hypothesis Kop : forall x y, K x -> K y -> K (op x y). Lemma big_ind I r (P : pred I) F (K_F : forall i, P i -> K (F i)) : K (\big[op/idx]_(i <- r | P i) F i). Proof. by apply: big_rec => // i x /K_F /Kop; apply. Qed. Hypothesis Kop' : forall x y, K x -> K y -> op x y = op' x y. Lemma eq_big_op I r (P : pred I) F (K_F : forall i, P i -> K (F i)) : \big[op/idx]_(i <- r | P i) F i = \big[op'/idx]_(i <- r | P i) F i. Proof. by elim/(big_load K): _; elim/big_rec2: _ => // i _ y Pi [Ky <-]; auto. Qed. Hypotheses (fM : {morph f : x y / op x y}) (f_id : f idx = idx). Lemma big_endo I r (P : pred I) F : f (\big[op/idx]_(i <- r | P i) F i) = \big[op/idx]_(i <- r | P i) f (F i). Proof. exact: big_morph. Qed. End Elim1. Arguments big_rec [R] K [idx op] _ [I r P F]. Arguments big_ind [R] K [idx op] _ _ [I r P F]. Arguments eq_big_op [R] K [idx op] op' _ _ _ [I]. Arguments big_endo [R] f [idx op] _ _ [I]. (* zmodp -------------------------------------------------------------------- *) Lemma ord1 : all_equal_to (@Ordinal 1 0 is_true_true : 'I_1). Admitted. coq-8.20.0/test-suite/prerequisite/ssr_ssrsyntax1.v000066400000000000000000000021301466560755400224450ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* nat) := [| fun x => x | fun x => O |]. Definition foo21 := (eq_refl : t3.[0] 2 = 2). Definition foo22 := (eq_refl 2 <: t3.[0] 2 = 2). Definition foo23 := (eq_refl 2 <<: t3.[0] 2 = 2). Definition x9 := Eval compute in t3.[0] 2. Definition foo24 := (eq_refl : x9 = 2). Definition x10 := Eval cbn in t3.[0] 2. Definition foo25 := (eq_refl : x10 = 2). Ltac check_const_eq name constr := let v := (eval cbv delta [name] in name) in tryif constr_eq v constr then idtac else fail 0 "Not syntactically equal:" name ":=" v "<>" constr. Notation check_const_eq name constr := (ltac:(check_const_eq name constr; exact constr)) (only parsing). (* Stuck primitive *) Definition lazy_stuck_get := Eval lazy in (fun A (t : array A) => t.[0]). Definition vm_stuck_get := Eval vm_compute in (fun A (t : array A) => t.[0]). Definition native_stuck_get := Eval native_compute in (fun A (t : array A) => t.[0]). Definition compute_stuck_get := Eval compute in (fun A (t : array A) => t.[0]). Definition cbn_stuck_get := Eval cbn in (fun A (t : array A) => t.[0]). Check check_const_eq lazy_stuck_get (fun A (t : array A) => t.[0]). Check check_const_eq vm_stuck_get (fun A (t : array A) => t.[0]). Check check_const_eq native_stuck_get (fun A (t : array A) => t.[0]). Check check_const_eq compute_stuck_get (fun A (t : array A) => t.[0]). Check check_const_eq cbn_stuck_get (fun A (t : array A) => t.[0]). (* Under-application *) Definition lazy_get := Eval lazy in @PArray.get. Definition vm_get := Eval vm_compute in @PArray.get. Definition native_get := Eval native_compute in @PArray.get. Definition compute_get := Eval compute in @PArray.get. Definition cbn_get := Eval cbn in @PArray.get. Check check_const_eq lazy_get (@PArray.get). Check check_const_eq vm_get (fun A (t : array A) i => t.[i]). Check check_const_eq native_get (fun A (t : array A) i => t.[i]). Check check_const_eq compute_get (@PArray.get). Check check_const_eq cbn_get (@PArray.get). coq-8.20.0/test-suite/primitive/arrays/length.v000066400000000000000000000007061466560755400214770ustar00rootroot00000000000000From Coq Require Import Uint63 PArray. Open Scope uint63_scope. Definition t : array nat := [| 1; 3; 2 | 4 |]%nat. Definition foo1 := (eq_refl : PArray.length t = 3). Definition foo2 := (eq_refl 3 <: PArray.length t = 3). Definition foo3 := (eq_refl 3 <<: PArray.length t = 3). Definition x1 := Eval compute in PArray.length t. Definition foo4 := (eq_refl : x1 = 3). Definition x2 := Eval cbn in PArray.length t. Definition foo5 := (eq_refl : x2 = 3). coq-8.20.0/test-suite/primitive/arrays/literal.v000066400000000000000000000002241466560755400216450ustar00rootroot00000000000000From Coq Require Import Uint63 PArray. Open Scope array_scope. Definition t1 : array nat := [| 3; 3; 3; 3 | 3 |]. Definition t2 := [|Type|Type|]. coq-8.20.0/test-suite/primitive/arrays/make.v000066400000000000000000000011531466560755400211300ustar00rootroot00000000000000From Coq Require Import Uint63 PArray. Open Scope array_scope. (* Immediate values *) Definition t1 : array nat := [| 3; 3; 3; 3 | 3 |]. Definition t2 := PArray.make 4 3. Definition foo1 := (eq_refl : t1 = t2). Definition foo2 := (eq_refl t1 <: t1 = t2). Definition foo3 := (eq_refl t1 <<: t1 = t2). Definition x1 := Eval compute in t2. Definition foo4 := (eq_refl : x1 = t1). Definition x2 := Eval cbn in t2. Definition foo5 := (eq_refl : x2 = t1). Definition partial1 := Eval lazy in @PArray.make. Definition partial2 := Eval vm_compute in @PArray.make. Definition partial3 := Eval native_compute in @PArray.make. coq-8.20.0/test-suite/primitive/arrays/max_length.v000066400000000000000000000010561466560755400223430ustar00rootroot00000000000000From Coq Require Import Uint63 PArray. Open Scope uint63_scope. Definition max_length := 4194303. Definition foo1 := (eq_refl max_length : PArray.max_length = max_length). Definition foo2 := (eq_refl max_length <: PArray.max_length = max_length). Definition foo3 := (eq_refl max_length <<: PArray.max_length = max_length). Definition max_length2 := Eval compute in PArray.max_length. Definition foo4 := (eq_refl : max_length = max_length2). Definition max_length3 := Eval cbn in PArray.max_length. Definition foo5 := (eq_refl : max_length = max_length3). coq-8.20.0/test-suite/primitive/arrays/nested.v000066400000000000000000000014551466560755400215020ustar00rootroot00000000000000From Coq Require Import Uint63 PArray. Open Scope array_scope. Module OneLevel. Inductive foo : Set := C : array foo -> foo. Fixpoint f1 (x : foo) {struct x} : False := match x with | C t => f1 (t.[0]) end. Fixpoint f2 (x : foo) {struct x} : False := f2 match x with | C t => t.[0] end. Fixpoint f3 (x : foo) {struct x} : False := match x with | C t => f3 (PArray.default t) end. End OneLevel. Module TwoLevels. Inductive foo : Set := C : array (array foo) -> foo. Fixpoint f1 (x : foo) {struct x} : False := match x with | C t => f1 (t.[0].[0]) end. Fixpoint f2 (x : foo) {struct x} : False := f2 match x with | C t => t.[0].[0] end. Fixpoint f3 (x : foo) {struct x} : False := match x with | C t => f3 (PArray.default (PArray.default t)) end. End TwoLevels. coq-8.20.0/test-suite/primitive/arrays/set.v000066400000000000000000000061321466560755400210100ustar00rootroot00000000000000From Coq Require Import Uint63 PArray. Open Scope array_scope. Definition t : array nat := [| 1; 3; 2 | 4 |]. Definition t' : array nat := t.[1 <- 5]. 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] = 3). Definition foo7 := (eq_refl 3 <: t.[1] = 3). Definition foo8 := (eq_refl 3 <<: t.[1] = 3). Definition x3 := Eval compute in t.[1]. Definition foo9 := (eq_refl : x3 = 3). Definition x4 := Eval cbn in t.[1]. Definition foo10 := (eq_refl : x4 = 3). Ltac check_const_eq name constr := let v := (eval cbv delta [name] in name) in tryif constr_eq v constr then idtac else fail 0 "Not syntactically equal:" name ":=" v "<>" constr. Notation check_const_eq name constr := (ltac:(check_const_eq name constr; exact constr)) (only parsing). (* Stuck primitive *) Definition lazy_stuck_set := Eval lazy in (fun A (t : array A) v => t.[1 <- v]). Definition vm_stuck_set := Eval vm_compute in (fun A (t : array A) v => t.[1 <- v]). Definition native_stuck_set := Eval native_compute in (fun A (t : array A) v => t.[1 <- v]). Definition compute_stuck_set := Eval compute in (fun A (t : array A) v => t.[1 <- v]). Definition cbn_stuck_set := Eval cbn in (fun A (t : array A) v => t.[1 <- v]). Check check_const_eq lazy_stuck_set (fun A (t : array A) v => t.[1 <- v]). Check check_const_eq vm_stuck_set (fun A (t : array A) v => t.[1 <- v]). Check check_const_eq native_stuck_set (fun A (t : array A) v => t.[1 <- v]). Check check_const_eq compute_stuck_set (fun A (t : array A) v => t.[1 <- v]). Check check_const_eq cbn_stuck_set (fun A (t : array A) v => t.[1 <- v]). (* Not stuck primitive, but with an accumulator as last argument *) Definition lazy_accu_set := Eval lazy in (fun v => t.[1 <- v]). Definition vm_accu_set := Eval vm_compute in (fun v => t.[1 <- v]). Definition native_accu_set := Eval native_compute in (fun v => t.[1 <- v]). Definition compute_accu_set := Eval compute in (fun v => t.[1 <- v]). Definition cbn_accu_set := Eval cbn in (fun v => t.[1 <- v]). Check check_const_eq lazy_accu_set (fun v => [| 1; v; 2 | 4 |]). Check check_const_eq vm_accu_set (fun v => [| 1; v; 2 | 4 |]). Check check_const_eq native_accu_set (fun v => [| 1; v; 2 | 4 |]). Check check_const_eq compute_accu_set (fun v => [| 1; v; 2 | 4 |]). Check check_const_eq cbn_accu_set (fun v => [| 1; v; 2 | 4 |]). (* Under-application *) Definition lazy_set := Eval lazy in @PArray.set. Definition vm_set := Eval vm_compute in @PArray.set. Definition native_set := Eval native_compute in @PArray.set. Definition compute_set := Eval compute in @PArray.set. Definition cbn_set := Eval cbn in @PArray.set. Check check_const_eq lazy_set (@PArray.set). Check check_const_eq vm_set (fun A (t : array A) i v => t.[i <- v]). Check check_const_eq native_set (fun A (t : array A) i v => t.[i <- v]). Check check_const_eq compute_set (@PArray.set). Check check_const_eq cbn_set (@PArray.set). coq-8.20.0/test-suite/primitive/arrays/univs.v000066400000000000000000000002001466560755400213470ustar00rootroot00000000000000Primitive array := #array_type. Fail Check [| | nat : Set |]@{Set}. Check [| | nat : Set |]@{_}. Check [| | 0 : nat |]@{Set}. coq-8.20.0/test-suite/primitive/float/000077500000000000000000000000001466560755400176305ustar00rootroot00000000000000coq-8.20.0/test-suite/primitive/float/classify.v000066400000000000000000000007651466560755400216440ustar00rootroot00000000000000Require Import ZArith Floats. Definition epsilon := Eval compute in Z.ldexp one (-1024)%Z. Check (eq_refl : classify one = PNormal). Check (eq_refl : classify (- one)%float = NNormal). Check (eq_refl : classify epsilon = PSubn). Check (eq_refl : classify (- epsilon)%float = NSubn). Check (eq_refl : classify zero = PZero). Check (eq_refl : classify neg_zero = NZero). Check (eq_refl : classify infinity = PInf). Check (eq_refl : classify neg_infinity = NInf). Check (eq_refl : classify nan = NaN). coq-8.20.0/test-suite/primitive/float/compare.v000066400000000000000000000121711466560755400214470ustar00rootroot00000000000000(* DO NOT EDIT THIS FILE: automatically generated by ./gen_compare.sh *) Require Import ZArith Floats. Local Open Scope float_scope. Definition min_denorm := Eval compute in Z.ldexp one (-1074)%Z. Definition min_norm := Eval compute in Z.ldexp one (-1024)%Z. Check (eq_refl : nan =? nan = false). Check (eq_refl : nan =? nan = false). Check (eq_refl : nan compare.v cat <&2 "genTest expects 10 arguments" fi OPS=("=?" " int | FLOAT => float | SPEC_FLOAT => spec_float end. (** ** Fully-instantiated ("bare") specifications *) (** (Perhaps we want a better name than "bare" meaning "no binders"? *) (** As we'll see later, we check for [EQ l r] that [l] and [r] are [Constr.equal], and we'll check for [IFF (x = y) (x' = y')] that [Constr.equal x y] and [Constr.equal x' y'] are the same. (We don't currently support reporting results about [IFF A B] for [A] and [B] not equalities. *) Inductive BARE_SPEC := | EQ {T1 T2} (lhs : T1) (rhs : T2) | IFF {T1 T2} (lhs : T1) (rhs : T2). (** A [SPEC] is a [BARE_SPEC] prenex-quanified over known variable types. We hold the original proposition here so that we can pretty-print it easily *) Inductive SPEC := | BARE {U : Prop} (spec : U) (* for printing purposes *) (s : BARE_SPEC) | FORALL (T : SPEC_VAR_TYPE) (s : T -> SPEC). (** An [ANNOTATED_BARE_SPEC] holds the [BARE_SPEC] and also the propositional spec for pretty-printing of results. *) Definition ANNOTATED_BARE_SPEC : Type := BARE_SPEC * {P : Prop | P}. (** ** Machinery for instantiating specifications with all examples *) Fixpoint instantiate1_all_ways (s : SPEC) : list ANNOTATED_BARE_SPEC := match s with | @BARE U spec s => [(s, exist _ U spec)] | @FORALL T s => List.flat_map (fun v => instantiate1_all_ways (s v)) match T with | INT => tricky_ints | FLOAT => tricky_floats | SPEC_FLOAT => tricky_spec_floats end end. Definition instantiate_all_ways_nored (ls : list SPEC) : list ANNOTATED_BARE_SPEC := List.flat_map instantiate1_all_ways ls. Definition instantiate_all_ways (ls : list SPEC) : list ANNOTATED_BARE_SPEC := Eval cbv in instantiate_all_ways_nored ls. (** ** Some General Ltac2 Machinery *) Import Ltac2.Constr. Import Constr.Unsafe. Ltac2 Type exn ::= [ PrimFloat_Test_InternalError (message) | PrimFloat_SpecTest_Failed (message) ]. Ltac2 Type exn ::= [ Reification_error (message) | Reification_unhandled_kind (message, kind) ]. Ltac2 unify_bool (x : constr) (y : constr) : bool := match Control.case (fun () => Std.unify x y) with | Val _ => true | Err _ => false end. Ltac2 lf () := String.make 1 (Char.of_int 10). Ltac2 rec count_prod (x : constr) : int := match kind x with | Cast x _ _ => count_prod x | Prod _ x => Int.add 1 (count_prod x) | _ => 0 end. Ltac2 mkApp f x := Unsafe.make (App f (Array.of_list x)). Ltac2 mkRel i := Unsafe.make (Rel i). Ltac2 mkLambda b body := Unsafe.make (Lambda b body). (** ** Reification of known variable types *) Ltac2 reify_var_type (t : constr) : constr := match List.assoc_opt Constr.equal t [('spec_float, 'SPEC_FLOAT) ; ('float, 'FLOAT) ; ('int, 'INT)] with | Some v => v | None => Control.throw (Reification_error (fprintf "Unhandled type %t" t)) end. (** ** A kludgy hack we have to do to support some specifications that aren't equalities but have case statements out front *) (** turns [let '(x, y) := z in w = q] into [(let '(x, y) := z in w) = (let '(x, y) := z in q)] *) (** Does not run typechecking, and therefore works on open terms (with unbound rels) *) Ltac2 rec push_case_eq (tag : constr) (mkCase : constr (* retty *) -> constr -> constr) (branch : constr) : constr := match kind branch with | Lambda b body => push_case_eq tag (fun retty body => mkCase retty (mkLambda b body)) body | App f args => if Constr.equal f '@eq then let ty := Array.get args 0 in let x := Array.get args 1 in let y := Array.get args 2 in mkApp f [ty; mkCase ty x; mkCase ty y] else Control.throw (Reification_error (fprintf "Unrecognized under case %t (from %t from %t)" f branch tag)) | _ => Control.throw (Reification_error (fprintf "Unrecognized kind under case %t (from %t)" branch tag)) end. Ltac2 swap_case_eq (x : constr) : constr := match kind x with | Case c (retty, rel) ci discr branches => if Int.equal 1 (Array.length branches) then match kind retty with | Lambda retty_b rtProp => if Constr.equal rtProp 'Prop then push_case_eq x (fun retty b => Unsafe.make (Case c (mkLambda retty_b (liftn 1 1 retty), rel) ci discr (Array.of_list [b]))) (Array.get branches 0) else x | _ => x end else x | _ => x end. (** ** Reification of specifications after binders have been removed *) (** Does not run typechecking, and therefore works on open terms (with unbound rels) *) Ltac2 reify_bare_spec (ty : constr) : constr := let ty := swap_case_eq ty in match kind ty with | App f args => if Constr.equal f '@eq then Unsafe.make (App (mkApp '@EQ [Array.get args 0]) args) else if Constr.equal f '@iff then Unsafe.make (App (mkApp '@IFF ['Prop; 'Prop]) args) else Control.throw (Reification_error (fprintf "Unhandled base spec app %t" ty)) | k => Control.throw (Reification_unhandled_kind (fprintf "Unhandled base spec %t" ty) k) end. (** ** Reification of specs, including binders *) (** [n] is how many binders are left to remove in [spec], and therefore which [Rel] the [spec] should be eventually applied to *) Ltac2 rec reify_spec' (ty : constr) (spec : constr) (n : int) : constr := match kind ty with | Cast ty _ _ => reify_spec' ty spec n | Prod b body => let ty := reify_var_type (Binder.type b) in let body := reify_spec' body (mkApp spec [mkRel n]) (Int.sub n 1) in mkApp 'FORALL [ty; mkLambda b body] | _ => let r := reify_bare_spec ty in mkApp '@BARE [ty; spec; r] end. Ltac2 reify_spec (spec : constr) : constr := let ty := Constr.type spec in reify_spec' ty spec (count_prod ty). Notation "` x" := (ltac2:(let v := reify_spec (pretype x) in exact $v)) (only parsing, at level 10). (** * Machinery for reporting results *) Ltac2 report_result (red : string) (result : constr) (specTy : constr) (spec : constr) : message option := let msg := lazy_match! result with | EQ ?x ?y => if Constr.equal x y then None else (* if unify_bool x y (* commented out because of https://github.com/coq/coq/pull/17899 *) then Some (fprintf "%s failed to fully reduce, leaving over %t (expected: %t), in %t %t" red x y spec specTy) else *) Some (fprintf "%s failed!%sGot: %t%sExpected: %t%sIn %t %t" red (lf ()) x (lf ()) y (lf ()) spec specTy) | IFF (?x = ?x') (?y = ?y') => let (lhs, rhs) := lazy_match! result with | IFF ?lhs ?rhs => (lhs, rhs) | _ => Control.throw (PrimFloat_Test_InternalError (fprintf "Impossible! Result branch mismatch %t" result)) end in let descr := if unify_bool y y' then "should" else "should not" in if Bool.and (Bool.equal (Constr.equal x x') (Constr.equal y y')) (Bool.equal (unify_bool x x') (unify_bool y y')) then None else (* if Bool.equal (unify_bool x x') (unify_bool y y') (* commented out because of https://github.com/coq/coq/pull/17899 *) then Some (fprintf "%s failed to fully reduce, leaving over %t (expected something equivalent to: %t), in %t %t" red lhs rhs spec specTy) else *) Some (fprintf "%s failed!%sGot: %t%sExpected something equivalent to: %t%s(both sides %s unify)%sIn %t %t" red (lf ()) lhs (lf ()) rhs (lf ()) descr (lf ()) spec specTy) | _ => Control.throw (PrimFloat_Test_InternalError (fprintf "Unhandled result %t (on %t : %t with %s)" result spec specTy red)) end in match msg with | Some msg => Message.print (Message.concat (Message.of_string "Test Error: ") msg) | None => () end; msg. Ltac2 rec report_results_gen (error_early : bool) (red : string) (results : constr) : unit := lazy_match! results with | nil => () | cons (?res, exist _ ?specTy ?spec) ?results => let err := report_result red res specTy spec in let check_rest () := report_results_gen error_early red results in let zero_err () := match err with | Some err => Control.zero (PrimFloat_SpecTest_Failed err) | None => () end in if error_early then (zero_err (); check_rest ()) else (check_rest (); zero_err ()) | cons ?v _ => Control.throw (PrimFloat_Test_InternalError (fprintf "Invalid result format %t" v)) | _ => let results' := Std.eval_hnf results in if Constr.equal results results' then Control.throw (PrimFloat_Test_InternalError (fprintf "Results must be a literal list, not %t" results)) else report_results_gen error_early red results' end. Ltac2 report_results red results := report_results_gen false red results. Ltac2 report_results_fast red results := report_results_gen true red results. (** *************************************************************************) (** * List of (reified) specifications *) (** EDIT HERE TO ADD MORE TESTS *) (* [Prim2SF_SF2Prim] has an hypothesis not handled by the above machinery so let's check something stronger in theory but equivalent in practice, since all test cases satisfy the hypothesis by construction. *) Axiom Prim2SF_SF2Prim' : forall x, (* valid_binary x = true -> *) Prim2SF (SF2Prim x) = x. Definition spec_list : list SPEC := [ `Prim2SF_valid ; `SF2Prim_Prim2SF ; `Prim2SF_SF2Prim' ; `opp_spec ; `abs_spec ; `eqb_spec ; `ltb_spec ; `leb_spec ; `compare_spec ; `Leibniz.eqb_spec ; `classify_spec ; `mul_spec ; `add_spec ; `sub_spec ; `div_spec ; `sqrt_spec ; `of_uint63_spec ; `normfr_mantissa_spec ; `frshiftexp_spec ; `ldshiftexp_spec ; `next_up_spec ; `next_down_spec ]. (* Spec to check that evaluation mechanisms agree for each operator. *) #[local] Notation reflspec1 f := (fun x => @eq_refl _ (f x)). #[local] Notation reflspec2 f := (fun x y => @eq_refl _ (f x y)). Definition op_spec_list : list SPEC := [ ` (reflspec1 PrimFloat.classify) ; ` (reflspec1 PrimFloat.abs) ; ` (reflspec1 PrimFloat.sqrt) ; ` (reflspec1 PrimFloat.opp) ; ` (reflspec2 PrimFloat.eqb) ; ` (reflspec2 PrimFloat.ltb) ; ` (reflspec2 PrimFloat.leb) ; ` (reflspec2 PrimFloat.compare) ; ` (reflspec2 PrimFloat.Leibniz.eqb) ; ` (reflspec2 PrimFloat.mul) ; ` (reflspec2 PrimFloat.add) ; ` (reflspec2 PrimFloat.sub) ; ` (reflspec2 PrimFloat.div) ; ` (reflspec1 PrimFloat.of_uint63) ; ` (reflspec1 PrimFloat.normfr_mantissa) ; ` (reflspec1 PrimFloat.frshiftexp) ; ` (reflspec2 PrimFloat.ldshiftexp) ; ` (reflspec1 PrimFloat.next_up) ; ` (reflspec1 PrimFloat.next_down) ]. (** *************************************************************************) (** * Utility definitions for managing lists specifications *) (** We unfold standard library constants early to guarantee that we won't run afoul of constants that show up in the specs themselves *) Definition map_fst : list ANNOTATED_BARE_SPEC -> list BARE_SPEC := Eval cbv in List.map (@fst _ _). Definition combine_annotations (orig : list ANNOTATED_BARE_SPEC) (result : list BARE_SPEC) : list ANNOTATED_BARE_SPEC := Eval cbv in List.map (fun '((_, anno), v) => (v, anno)) (List.combine orig result). (** The native compiler is much slower if we feed it the precomputed instantiations of specs, whereas we want to make sure that [simpl] and [cbn] have as few places to take the wrong path as possible. Reductions like [cbv] and [lazy] and the [vm] are mostly indifferent. So we maintain both [_red] versions for [simpl] and [cbn] and non-[_red] versions for [native_compute]. *) (** We make [_red] definitions [Let] statements, to work around COQBUG(https://github.com/coq/coq/issues/4790) and avoid stack overflows in COQNATIVE *) (** * 1. Test the specs *) Section TestSpecs. Time Let specs_red : list ANNOTATED_BARE_SPEC := Eval cbv [spec_list instantiate_all_ways] in instantiate_all_ways spec_list. (* 0.911 secs *) Let bare_specs_red : list BARE_SPEC := Eval cbv [map_fst specs_red] in map_fst specs_red. Time Let bare_specs_vm : list BARE_SPEC := Eval vm_compute in bare_specs_red. (* 1.934 secs *) (** ** Fuse in the annotations so that we can report errors nicely *) Time Let results_vm : list ANNOTATED_BARE_SPEC := Eval cbv [combine_annotations bare_specs_vm specs_red] in combine_annotations specs_red bare_specs_vm. (* 1.374 secs *) (** ** Report results *) Time Ltac2 Eval report_results "vm" 'results_vm. (* 0.634 secs *) End TestSpecs. (** Check that the machinery indeed fail, providing useful error messages, on some purposely-wrong spec. *) Section NegativeTest. Axiom wrong_spec : forall x, (- x)%float = PrimFloat.abs x. Definition wrong_spec_list : list SPEC := [ `wrong_spec ]. Let wrong_specs : list ANNOTATED_BARE_SPEC := Eval cbv [wrong_spec_list instantiate_all_ways] in instantiate_all_ways wrong_spec_list. Let wrong_bare_specs : list BARE_SPEC := Eval cbv [map_fst wrong_specs] in map_fst wrong_specs. Let wrong_bare_specs_vm : list BARE_SPEC := Eval vm_compute in wrong_bare_specs. (** ** Fuse in the annotations so that we can report errors nicely *) Let wrong_results_vm : list ANNOTATED_BARE_SPEC := Eval cbv [combine_annotations wrong_bare_specs_vm wrong_specs] in combine_annotations wrong_specs wrong_bare_specs_vm. (** ** Report results *) Fail Ltac2 Eval report_results "vm" 'wrong_results_vm. (* Test Error: vm failed! Got: neg_infinity Expected: infinity In (wrong_spec infinity) (- infinity = abs infinity) ... *) End NegativeTest. (** * 2. Test the evaluation mechanisms *) Definition op_specs : list ANNOTATED_BARE_SPEC := instantiate_all_ways_nored op_spec_list. Time Let op_specs_red : list ANNOTATED_BARE_SPEC := Eval cbv [instantiate_all_ways op_spec_list] in instantiate_all_ways op_spec_list. (* 0.883 secs *) Definition op_bare_specs : list BARE_SPEC := map fst op_specs. Let op_bare_specs_red : list BARE_SPEC := Eval cbv [map_fst op_specs_red] in map_fst op_specs_red. (** Machinery for evaluating independently the LHS of specs *) (** To check that all evaluation mechanism agree, we will then 0. evaluate [op_specs] with [vm_compute] 1. [extract_lhs] of [op_specs] 2. evaluate LHS with each mechanism 3. [merge_lhs] with results of 2. and 0. *) Inductive hlist := hnil | hcons {T} (x : T) (_ : hlist). Fixpoint extract_lhs (ls : list BARE_SPEC) : hlist := match ls with | [] => hnil | x :: xs => let rest := extract_lhs xs in match x with EQ v _ | IFF v _ => hcons v rest end end. Fixpoint merge_lhs (ls : list BARE_SPEC) (result : hlist) : list BARE_SPEC := match ls, result with | [], _ | _, hnil => [] | x :: xs, hcons v vs => match x with | EQ _ x' => EQ v x' | IFF _ x' => IFF v x' end :: merge_lhs xs vs end. (** 0. evaluate [op_specs] with [vm_compute] *) Let op_bare_specs_vm : list BARE_SPEC := Eval vm_compute in op_bare_specs_red. (** 1. [extract_lhs] of [op_specs] *) Definition LHS_op : hlist := extract_lhs op_bare_specs. Let LHS_op_red : hlist := Eval cbv [op_bare_specs_red extract_lhs] in extract_lhs op_bare_specs_red. (** 2. evaluate LHS with each mechanism *) (** *************************************************************************) (** * Computing reduced expressions *) (** EDIT HERE TO ADD MORE REDUCTION STRATEGIES *) (** ** [vm_compute] is ommited as it is the reference *) (** ** [native_compute] *) (** Native is slow at compiling big code, so we start from smaller code *) Let LHS_op_native := Eval native_compute in extract_lhs op_bare_specs. (** ** [hnf] *) (** recursively applies hnf to all elements of the list *) Ltac2 rec eval_hnf_hlist (c : constr) : constr := lazy_match! c with | hcons ?h ?t => let h := Std.eval_hnf h in let t := eval_hnf_hlist t in '(hcons $h $t) | hnil => 'hnil end. Time Let LHS_op_hnf := ltac2:(let l := Std.eval_hnf 'LHS_op_red in let x := eval_hnf_hlist l in exact $x). (* 16.309 secs *) (** ** [cbn] *) Time Let LHS_op_cbn := Eval cbn in ltac2:(let l := Std.eval_hnf 'LHS_op_red in exact $l). (* 0.25 secs *) (** ** [simpl] *) Time Let LHS_op_simpl := Eval simpl in ltac2:(let l := Std.eval_hnf 'LHS_op_red in exact $l). (* 0.296 secs *) (** ** [cbv] *) Time Let LHS_op_cbv := Eval cbv in ltac2:(let l := Std.eval_hnf 'LHS_op_red in exact $l). (* 0.292 secs *) (** ** [lazy] *) Time Let LHS_op_lazy := Eval lazy in ltac2:(let l := Std.eval_hnf 'LHS_op_red in exact $l). (* 0.259 secs *) (** 3. [merge_lhs] with results of 2. and 0. *) (** ** fuse the results of vm RHS (vm because it's fast) back into cbn/hnf/simpl LHS for comparison *) Let op_bare_specs_native : list BARE_SPEC := Eval cbv [merge_lhs op_bare_specs_vm LHS_op_native] in merge_lhs op_bare_specs_vm LHS_op_native. Let op_bare_specs_hnf : list BARE_SPEC := Eval cbv [merge_lhs op_bare_specs_vm LHS_op_hnf] in merge_lhs op_bare_specs_vm LHS_op_hnf. Let op_bare_specs_cbn : list BARE_SPEC := Eval cbv [merge_lhs op_bare_specs_vm LHS_op_cbn] in merge_lhs op_bare_specs_vm LHS_op_cbn. Let op_bare_specs_simpl : list BARE_SPEC := Eval cbv [merge_lhs op_bare_specs_vm LHS_op_simpl] in merge_lhs op_bare_specs_vm LHS_op_simpl. Let op_bare_specs_cbv : list BARE_SPEC := Eval cbv [merge_lhs op_bare_specs_vm LHS_op_cbv] in merge_lhs op_bare_specs_vm LHS_op_cbv. Let op_bare_specs_lazy : list BARE_SPEC := Eval cbv [merge_lhs op_bare_specs_vm LHS_op_lazy] in merge_lhs op_bare_specs_vm LHS_op_lazy. (** ** Fuse in the annotations so that we can report errors nicely *) Time Let op_results_native : list ANNOTATED_BARE_SPEC := Eval cbv [combine_annotations op_specs_red op_bare_specs_native] in combine_annotations op_specs_red op_bare_specs_native. (* 0.826 secs *) Time Let op_results_hnf : list ANNOTATED_BARE_SPEC := Eval cbv [combine_annotations op_specs_red op_bare_specs_hnf] in combine_annotations op_specs_red op_bare_specs_hnf. (* 0.83 secs *) Time Let op_results_cbn : list ANNOTATED_BARE_SPEC := Eval cbv [combine_annotations op_specs_red op_bare_specs_cbn] in combine_annotations op_specs_red op_bare_specs_cbn. (* 0.83 secs *) Time Let op_results_simpl : list ANNOTATED_BARE_SPEC := Eval cbv [combine_annotations op_specs_red op_bare_specs_simpl] in combine_annotations op_specs_red op_bare_specs_simpl. (* 0.865 secs *) Time Let op_results_cbv : list ANNOTATED_BARE_SPEC := Eval cbv [combine_annotations op_specs_red op_bare_specs_cbv] in combine_annotations op_specs_red op_bare_specs_cbv. (* 0.845 secs *) Time Let op_results_lazy : list ANNOTATED_BARE_SPEC := Eval cbv [combine_annotations op_specs_red op_bare_specs_lazy] in combine_annotations op_specs_red op_bare_specs_lazy. (* 0.812 secs *) (** ** Report results *) Set Printing Depth 100000000. Ltac2 Eval report_results "native" 'op_results_native. Ltac2 Eval report_results "hnf" 'op_results_hnf. Ltac2 Eval report_results "cbn" 'op_results_cbn. Ltac2 Eval report_results "simpl" 'op_results_simpl. Ltac2 Eval report_results "cbv" 'op_results_cbv. Ltac2 Eval report_results "lazy" 'op_results_lazy. End __WORK_AROUND_COQBUG_4790. coq-8.20.0/test-suite/primitive/float/sqrt.v000066400000000000000000000007031466560755400210100ustar00rootroot00000000000000Require Import ZArith Uint63 Floats. Open Scope float_scope. Definition three := Eval compute in of_uint63 3%uint63. Definition nine := Eval compute in of_uint63 9%uint63. Check (eq_refl : sqrt nine = three). Check (eq_refl : sqrt zero = zero). Check (eq_refl : sqrt neg_zero = neg_zero). Check (eq_refl : sqrt one = one). Check (eq_refl : sqrt (-one) = nan). Check (eq_refl : sqrt infinity = infinity). Check (eq_refl : sqrt neg_infinity = nan). coq-8.20.0/test-suite/primitive/float/sub.v000066400000000000000000000011471466560755400206130ustar00rootroot00000000000000Require Import ZArith Uint63 Floats. Open Scope float_scope. Definition huge := Eval compute in Z.ldexp one 1023%Z. Definition tiny := Eval compute in Z.ldexp one (-1023)%Z. Check (eq_refl : huge - tiny = huge). Check (eq_refl : huge - huge = zero). Check (eq_refl : one - nan = nan). Check (eq_refl : infinity - infinity = nan). Check (eq_refl : infinity - neg_infinity = infinity). Check (eq_refl : zero - zero = zero). Check (eq_refl : neg_zero - zero = neg_zero). Check (eq_refl : neg_zero - neg_zero = zero). Check (eq_refl : zero - neg_zero = zero). Check (eq_refl : huge - neg_infinity = infinity). coq-8.20.0/test-suite/primitive/float/syntax.v000066400000000000000000000005661466560755400213540ustar00rootroot00000000000000Require Import Floats. Open Scope float_scope. Definition two := Eval compute in one + one. Definition half := Eval compute in one / two. Check (eq_refl : 1.5 = one + half). Check (eq_refl : 15e-1 = one + half). Check (eq_refl : 150e-2 = one + half). Check (eq_refl : 0.15e+1 = one + half). Check (eq_refl : 0.15e1 = one + half). Check (eq_refl : 0.0015e3 = one + half). coq-8.20.0/test-suite/primitive/float/zero.v000066400000000000000000000002721466560755400207770ustar00rootroot00000000000000Require Import ZArith Uint63 Floats. Open Scope float_scope. Fail Check (eq_refl : zero = neg_zero). Fail Check (eq_refl <: zero = neg_zero). Fail Check (eq_refl <<: zero = neg_zero). coq-8.20.0/test-suite/primitive/sint63/000077500000000000000000000000001466560755400176515ustar00rootroot00000000000000coq-8.20.0/test-suite/primitive/sint63/add.v000066400000000000000000000014671466560755400206000ustar00rootroot00000000000000Require Import Sint63. Set Implicit Arguments. Open Scope sint63_scope. Check (eq_refl : 2 + 3 = 5). Check (eq_refl 5 <: 2 + 3 = 5). Check (eq_refl 5 <<: 2 + 3 = 5). Definition compute1 := Eval compute in 2 + 3. Check (eq_refl compute1 : 5 = 5). Check (eq_refl : 4611686018427387903 + 1 = -4611686018427387904). Check (eq_refl (-4611686018427387904) <: 4611686018427387903 + 1 = -4611686018427387904). Check (eq_refl (-4611686018427387904) <<: 4611686018427387903 + 1 = -4611686018427387904). Definition compute2 := Eval compute in 4611686018427387903 + 1. Check (eq_refl compute2 : -4611686018427387904 = -4611686018427387904). Check (eq_refl : 2 - 3 = -1). Check (eq_refl (-1) <: 2 - 3 = -1). Check (eq_refl (-1) <<: 2 - 3 = -1). Definition compute3 := Eval compute in 2 - 3. Check (eq_refl compute3 : -1 = -1). coq-8.20.0/test-suite/primitive/sint63/asr.v000066400000000000000000000026661466560755400206370ustar00rootroot00000000000000Require Import Sint63. Set Implicit Arguments. Open Scope sint63_scope. Check (eq_refl : (-2305843009213693952) >> 61 = -1). Check (eq_refl (-1) <: (-2305843009213693952) >> 61 = -1). Check (eq_refl (-1) <<: (-2305843009213693952) >> 61 = -1). Definition compute1 := Eval compute in (-2305843009213693952) >> 61. Check (eq_refl compute1 : -1 = -1). Check (eq_refl : 2305843009213693952 >> 62 = 0). Check (eq_refl 0 <: 2305843009213693952 >> 62 = 0). Check (eq_refl 0 <<: 2305843009213693952 >> 62 = 0). Definition compute2 := Eval compute in 2305843009213693952 >> 62. Check (eq_refl compute2 : 0 = 0). Check (eq_refl : 4611686018427387903 >> 63 = 0). Check (eq_refl 0 <: 4611686018427387903 >> 63 = 0). Check (eq_refl 0 <<: 4611686018427387903 >> 63 = 0). Definition compute3 := Eval compute in 4611686018427387903 >> 63. Check (eq_refl compute3 : 0 = 0). Check (eq_refl : (-1) >> 1 = -1). Check (eq_refl (-1) <: (-1) >> 1 = -1). Check (eq_refl (-1) <<: (-1) >> 1 = -1). Definition compute4 := Eval compute in (-1) >> 1. Check (eq_refl compute4 : -1 = -1). Check (eq_refl : (-1) >> (-1) = 0). Check (eq_refl 0 <: (-1) >> (-1) = 0). Check (eq_refl 0 <<: (-1) >> (-1) = 0). Definition compute5 := Eval compute in (-1) >> (-1). Check (eq_refl compute5 : 0 = 0). Check (eq_refl : 73 >> (-2) = 0). Check (eq_refl 0 <: 73 >> (-2) = 0). Check (eq_refl 0 <<: 73 >> (-2) = 0). Definition compute6 := Eval compute in 73 >> (-2). Check (eq_refl compute6 : 0 = 0). coq-8.20.0/test-suite/primitive/sint63/compare.v000066400000000000000000000023161466560755400214700ustar00rootroot00000000000000Require Import Sint63. Set Implicit Arguments. Open Scope sint63_scope. Check (eq_refl : 1 ?= 1 = Eq). Check (eq_refl Eq <: 1 ?= 1 = Eq). Check (eq_refl Eq <<: 1 ?= 1 = Eq). Definition compute1 := Eval compute in 1 ?= 1. Check (eq_refl compute1 : Eq = Eq). Check (eq_refl : 1 ?= 2 = Lt). Check (eq_refl Lt <: 1 ?= 2 = Lt). Check (eq_refl Lt <<: 1 ?= 2 = Lt). Definition compute2 := Eval compute in 1 ?= 2. Check (eq_refl compute2 : Lt = Lt). Check (eq_refl : 4611686018427387903 ?= 0 = Gt). Check (eq_refl Gt <: 4611686018427387903 ?= 0 = Gt). Check (eq_refl Gt <<: 4611686018427387903 ?= 0 = Gt). Definition compute3 := Eval compute in 4611686018427387903 ?= 0. Check (eq_refl compute3 : Gt = Gt). Check (eq_refl : -1 ?= 1 = Lt). Check (eq_refl Lt <: -1 ?= 1 = Lt). Check (eq_refl Lt <<: -1 ?= 1 = Lt). Definition compute4 := Eval compute in -1 ?= 1. Check (eq_refl compute4 : Lt = Lt). Check (eq_refl : 4611686018427387903 ?= -4611686018427387904 = Gt). Check (eq_refl Gt <: 4611686018427387903 ?= -4611686018427387904 = Gt). Check (eq_refl Gt <<: 4611686018427387903 ?= -4611686018427387904 = Gt). Definition compute5 := Eval compute in 4611686018427387903 ?= -4611686018427387904. Check (eq_refl compute5 : Gt = Gt). coq-8.20.0/test-suite/primitive/sint63/div.v000066400000000000000000000036321466560755400206260ustar00rootroot00000000000000Require Import Sint63. Set Implicit Arguments. Open Scope sint63_scope. Check (eq_refl : 6 / 3 = 2). Check (eq_refl 2 <: 6 / 3 = 2). Check (eq_refl 2 <<: 6 / 3 = 2). Definition compute1 := Eval compute in 6 / 3. Check (eq_refl compute1 : 2 = 2). Check (eq_refl : -6 / 3 = -2). Check (eq_refl (-2) <: -6 / 3 = -2). Check (eq_refl (-2) <<: -6 / 3 = -2). Definition compute2 := Eval compute in -6 / 3. Check (eq_refl compute2 : -2 = -2). Check (eq_refl : 6 / -3 = -2). Check (eq_refl (-2) <: 6 / -3 = -2). Check (eq_refl (-2) <<: 6 / -3 = -2). Definition compute3 := Eval compute in 6 / -3. Check (eq_refl compute3 : -2 = -2). Check (eq_refl : -6 / -3 = 2). Check (eq_refl 2 <: -6 / -3 = 2). Check (eq_refl 2 <<: -6 / -3 = 2). Definition compute4 := Eval compute in -6 / -3. Check (eq_refl compute4 : 2 = 2). Check (eq_refl : 3 / 2 = 1). Check (eq_refl 1 <: 3 / 2 = 1). Check (eq_refl 1 <<: 3 / 2 = 1). Definition compute5 := Eval compute in 3 / 2. Check (eq_refl compute5 : 1 = 1). Check (eq_refl : -3 / 2 = -1). Check (eq_refl (-1) <: -3 / 2 = -1). Check (eq_refl (-1) <<: -3 / 2 = -1). Definition compute6 := Eval compute in -3 / 2. Check (eq_refl compute6 : -1 = -1). Check (eq_refl : 3 / -2 = -1). Check (eq_refl (-1) <: 3 / -2 = -1). Check (eq_refl (-1) <<: 3 / -2 = -1). Definition compute7 := Eval compute in 3 / -2. Check (eq_refl compute7 : -1 = -1). Check (eq_refl : -3 / -2 = 1). Check (eq_refl 1 <: -3 / -2 = 1). Check (eq_refl 1 <<: -3 / -2 = 1). Definition compute8 := Eval compute in -3 / -2. Check (eq_refl compute8 : 1 = 1). Check (eq_refl : -4611686018427387904 / -1 = -4611686018427387904). Check (eq_refl (-4611686018427387904) <: -4611686018427387904 / -1 = -4611686018427387904). Check (eq_refl (-4611686018427387904) <<: -4611686018427387904 / -1 = -4611686018427387904). Definition compute9 := Eval compute in -4611686018427387904 / -1. Check (eq_refl compute9 : -4611686018427387904 = -4611686018427387904). coq-8.20.0/test-suite/primitive/sint63/eqb.v000066400000000000000000000010511466560755400206040ustar00rootroot00000000000000Require Import Sint63. Set Implicit Arguments. Open Scope sint63_scope. Check (eq_refl : 1 =? 1 = true). Check (eq_refl true <: 1 =? 1 = true). Check (eq_refl true <<: 1 =? 1 = true). Definition compute1 := Eval compute in 1 =? 1. Check (eq_refl compute1 : true = true). Check (eq_refl : 4611686018427387903 =? 0 = false). Check (eq_refl false <: 4611686018427387903 =? 0 = false). Check (eq_refl false <<: 4611686018427387903 =? 0 = false). Definition compute2 := Eval compute in 4611686018427387903 =? 0. Check (eq_refl compute2 : false = false). coq-8.20.0/test-suite/primitive/sint63/isint.v000066400000000000000000000034621466560755400211730ustar00rootroot00000000000000(* This file tests the check that arithmetic operations use to know if their arguments are ground. The various test cases correspond to possible optimizations of these tests made by the compiler. *) Require Import Sint63. Set Implicit Arguments. Open Scope sint63_scope. Section test. Variable m n : int. Check (eq_refl : (fun x => x + 3) m = m + 3). Check (eq_refl (m + 3) <: (fun x => x + 3) m = m + 3). Check (eq_refl (m + 3) <<: (fun x => x + 3) m = m + 3). Definition compute1 := Eval compute in (fun x => x + 3) m. Check (eq_refl compute1 : m + 3 = m + 3). Check (eq_refl : (fun x => 3 + x) m = 3 + m). Check (eq_refl (3 + m) <: (fun x => 3 + x) m = 3 + m). Check (eq_refl (3 + m) <<: (fun x => 3 + x) m = 3 + m). Definition compute2 := Eval compute in (fun x => 3 + x) m. Check (eq_refl compute2 : 3 + m = 3 + m). Check (eq_refl : (fun x y => x + y) m n = m + n). Check (eq_refl (m + n) <: (fun x y => x + y) m n = m + n). Check (eq_refl (m + n) <<: (fun x y => x + y) m n = m + n). Definition compute3 := Eval compute in (fun x y => x + y) m n. Check (eq_refl compute3 : m + n = m + n). Check (eq_refl : (fun x y => x + y) 2 3 = 5). Check (eq_refl 5 <: (fun x y => x + y) 2 3 = 5). Check (eq_refl 5 <<: (fun x y => x + y) 2 3 = 5). Definition compute4 := Eval compute in (fun x y => x + y) 2 3. Check (eq_refl compute4 : 5 = 5). Check (eq_refl : (fun x => x + x) m = m + m). Check (eq_refl (m + m) <: (fun x => x + x) m = m + m). Check (eq_refl (m + m) <<: (fun x => x + x) m = m + m). Definition compute5 := Eval compute in (fun x => x + x) m. Check (eq_refl compute5 : m + m = m + m). Check (eq_refl : (fun x => x + x) 2 = 4). Check (eq_refl 4 <: (fun x => x + x) 2 = 4). Check (eq_refl 4 <<: (fun x => x + x) 2 = 4). Definition compute6 := Eval compute in (fun x => x + x) 2. Check (eq_refl compute6 : 4 = 4). End test. coq-8.20.0/test-suite/primitive/sint63/leb.v000066400000000000000000000017241466560755400206060ustar00rootroot00000000000000Require Import Sint63. Set Implicit Arguments. Open Scope sint63_scope. Check (eq_refl : 1 <=? 1 = true). Check (eq_refl true <: 1 <=? 1 = true). Check (eq_refl true <<: 1 <=? 1 = true). Definition compute1 := Eval compute in 1 <=? 1. Check (eq_refl compute1 : true = true). Check (eq_refl : 1 <=? 2 = true). Check (eq_refl true <: 1 <=? 2 = true). Check (eq_refl true <<: 1 <=? 2 = true). Definition compute2 := Eval compute in 1 <=? 2. Check (eq_refl compute2 : true = true). Check (eq_refl : 4611686018427387903 <=? 0 = false). Check (eq_refl false <: 4611686018427387903 <=? 0 = false). Check (eq_refl false <<: 4611686018427387903 <=? 0 = false). Definition compute3 := Eval compute in 4611686018427387903 <=? 0. Check (eq_refl compute3 : false = false). Check (eq_refl : 1 <=? -1 = false). Check (eq_refl false <: 1 <=? -1 = false). Check (eq_refl false <<: 1 <=? -1 = false). Definition compute4 := Eval compute in 1 <=? -1. Check (eq_refl compute4 : false = false). coq-8.20.0/test-suite/primitive/sint63/lsl.v000066400000000000000000000033161466560755400206350ustar00rootroot00000000000000Require Import Sint63. Set Implicit Arguments. Open Scope sint63_scope. Check (eq_refl : 3 << 61 = -2305843009213693952). Check (eq_refl (-2305843009213693952) <: 3 << 61 = -2305843009213693952). Check (eq_refl (-2305843009213693952) <<: 3 << 61 = -2305843009213693952). Definition compute1 := Eval compute in 3 << 61. Check (eq_refl compute1 : -2305843009213693952 = -2305843009213693952). Check (eq_refl : 2 << 62 = 0). Check (eq_refl 0 <: 2 << 62 = 0). Check (eq_refl 0 <<: 2 << 62 = 0). Definition compute2 := Eval compute in 2 << 62. Check (eq_refl compute2 : 0 = 0). Check (eq_refl : 4611686018427387903 << 63 = 0). Check (eq_refl 0 <: 4611686018427387903 << 63 = 0). Check (eq_refl 0 <<: 4611686018427387903 << 63 = 0). Definition compute3 := Eval compute in 4611686018427387903 << 63. Check (eq_refl compute3 : 0 = 0). Check (eq_refl : 4611686018427387903 << 62 = -4611686018427387904). Check (eq_refl (-4611686018427387904) <: 4611686018427387903 << 62 = -4611686018427387904). Check (eq_refl (-4611686018427387904) <<: 4611686018427387903 << 62 = -4611686018427387904). Definition compute4 := Eval compute in 4611686018427387903 << 62. Check (eq_refl compute4 : -4611686018427387904 = -4611686018427387904). Check (eq_refl : 1 << 62 = -4611686018427387904). Check (eq_refl (-4611686018427387904) <: 1 << 62 = -4611686018427387904). Check (eq_refl (-4611686018427387904) <<: 1 << 62 = -4611686018427387904). Definition compute5 := Eval compute in 1 << 62. Check (eq_refl compute5 : -4611686018427387904 = -4611686018427387904). Check (eq_refl : -1 << 1 = -2). Check (eq_refl (-2) <: -1 << 1 = -2). Check (eq_refl (-2) <<: -1 << 1 = -2). Definition compute6 := Eval compute in -1 << 1. Check (eq_refl compute6 : -2 = -2). coq-8.20.0/test-suite/primitive/sint63/ltb.v000066400000000000000000000017131466560755400206230ustar00rootroot00000000000000Require Import Sint63. Set Implicit Arguments. Open Scope sint63_scope. Check (eq_refl : 1 apply (@eq_refl _ x) end. (* [lazy] *) Goal make 5 "a" = cat (make 2 "a") (make 3 "a"). Proof. lazy. syntactic_refl. Qed. Goal get "aaa" 0 = "a"%char63. Proof. lazy. syntactic_refl. Qed. Goal sub "abcd" 2 1 = "c". Proof. lazy. syntactic_refl. Qed. Goal cat "ab" "ba" = "abba". Proof. lazy. syntactic_refl. Qed. Goal compare "ab" "ab" = Eq. Proof. lazy. syntactic_refl. Qed. Goal compare "ab" "a" = Gt. Proof. lazy. syntactic_refl. Qed. Goal compare "a" "ab" = Lt. Proof. lazy. syntactic_refl. Qed. (* [cbn] *) Goal make 5 "a" = cat (make 2 "a") (make 3 "a"). Proof. cbn. syntactic_refl. Qed. Goal get "aaa" 0 = "a"%char63. Proof. cbn. syntactic_refl. Qed. Goal sub "abcd" 2 1 = "c". Proof. cbn. syntactic_refl. Qed. Goal cat "ab" "ba" = "abba". Proof. cbn. syntactic_refl. Qed. Goal compare "ab" "ab" = Eq. Proof. cbn. syntactic_refl. Qed. Goal compare "ab" "a" = Gt. Proof. cbn. syntactic_refl. Qed. Goal compare "a" "ab" = Lt. Proof. cbn. syntactic_refl. Qed. (* [cbv] *) Goal make 5 "a" = cat (make 2 "a") (make 3 "a"). Proof. cbv. syntactic_refl. Qed. Goal get "aaa" 0 = "a"%char63. Proof. cbv. syntactic_refl. Qed. Goal sub "abcd" 2 1 = "c". Proof. cbv. syntactic_refl. Qed. Goal cat "ab" "ba" = "abba". Proof. cbv. syntactic_refl. Qed. Goal compare "ab" "ab" = Eq. Proof. cbv. syntactic_refl. Qed. Goal compare "ab" "a" = Gt. Proof. cbv. syntactic_refl. Qed. Goal compare "a" "ab" = Lt. Proof. cbv. syntactic_refl. Qed. (* [simpl] *) Goal make 5 "a" = cat (make 2 "a") (make 3 "a"). Proof. simpl. syntactic_refl. Qed. Goal get "aaa" 0 = "a"%char63. Proof. simpl. syntactic_refl. Qed. Goal sub "abcd" 2 1 = "c". Proof. simpl. syntactic_refl. Qed. Goal cat "ab" "ba" = "abba". Proof. simpl. syntactic_refl. Qed. Goal compare "ab" "ab" = Eq. Proof. simpl. syntactic_refl. Qed. Goal compare "ab" "a" = Gt. Proof. simpl. syntactic_refl. Qed. Goal compare "a" "ab" = Lt. Proof. simpl. syntactic_refl. Qed. (* [hnf] *) (* Reduce with [hnf] on either side of an equality. *) Ltac hnf_eq := lazymatch goal with | |- ?lhs = ?rhs => let lhs := eval hnf in lhs in let rhs := eval hnf in rhs in assert (lhs = rhs) as H; [|exact H] end. Goal make 5 "a" = cat (make 2 "a") (make 3 "a"). Proof. hnf_eq. syntactic_refl. Qed. Goal get "aaa" 0 = "a"%char63. Proof. hnf_eq. syntactic_refl. Qed. Goal sub "abcd" 2 1 = "c". Proof. hnf_eq. syntactic_refl. Qed. Goal cat "ab" "ba" = "abba". Proof. hnf_eq. syntactic_refl. Qed. Goal compare "ab" "ab" = Eq. Proof. hnf_eq. syntactic_refl. Qed. Goal compare "ab" "a" = Gt. Proof. hnf_eq. syntactic_refl. Qed. Goal compare "a" "ab" = Lt. Proof. hnf_eq. syntactic_refl. Qed. (* [vm_compute] *) Goal make 5 "a" = cat (make 2 "a") (make 3 "a"). Proof. vm_compute. syntactic_refl. Qed. Goal get "aaa" 0 = "a"%char63. Proof. vm_compute. syntactic_refl. Qed. Goal sub "abcd" 2 1 = "c". Proof. vm_compute. syntactic_refl. Qed. Goal cat "ab" "ba" = "abba". Proof. vm_compute. syntactic_refl. Qed. Goal compare "ab" "ab" = Eq. Proof. vm_compute. syntactic_refl. Qed. Goal compare "ab" "a" = Gt. Proof. vm_compute. syntactic_refl. Qed. Goal compare "a" "ab" = Lt. Proof. vm_compute. syntactic_refl. Qed. Check (eq_refl "aaaaa" <: make 5 "a" = cat (make 2 "a") (make 3 "a")). Check (eq_refl (char63_wrap "a"%char63) <: get "aaa" 0 = "a"%char63). Check (eq_refl "c" <: sub "abcd" 2 1 = "c"). Check (eq_refl "abba" <: cat "ab" "ba" = "abba"). Check (eq_refl Eq <: compare "ab" "ab" = Eq). Check (eq_refl Gt <: compare "ab" "a" = Gt). Check (eq_refl Lt <: compare "a" "ab" = Lt). (* [native_compute] *) Goal make 5 "a" = cat (make 2 "a") (make 3 "a"). Proof. native_compute. syntactic_refl. Qed. Goal get "aaa" 0 = "a"%char63. Proof. native_compute. syntactic_refl. Qed. Goal sub "abcd" 2 1 = "c". Proof. native_compute. syntactic_refl. Qed. Goal cat "ab" "ba" = "abba". Proof. native_compute. syntactic_refl. Qed. Goal compare "ab" "ab" = Eq. Proof. native_compute. syntactic_refl. Qed. Goal compare "ab" "a" = Gt. Proof. native_compute. syntactic_refl. Qed. Goal compare "a" "ab" = Lt. Proof. native_compute. syntactic_refl. Qed. Check (eq_refl "aaaaa" <<: make 5 "a" = cat (make 2 "a") (make 3 "a")). Check (eq_refl (char63_wrap "a"%char63) <<: get "aaa" 0 = "a"%char63). Check (eq_refl "c" <<: sub "abcd" 2 1 = "c"). Check (eq_refl "abba" <<: cat "ab" "ba" = "abba"). Check (eq_refl Eq <<: compare "ab" "ab" = Eq). Check (eq_refl Gt <<: compare "ab" "a" = Gt). Check (eq_refl Lt <<: compare "a" "ab" = Lt). coq-8.20.0/test-suite/primitive/uint63/000077500000000000000000000000001466560755400176535ustar00rootroot00000000000000coq-8.20.0/test-suite/primitive/uint63/add.v000066400000000000000000000007611466560755400205760ustar00rootroot00000000000000Require Import Uint63. Set Implicit Arguments. Open Scope uint63_scope. Check (eq_refl : 2 + 3 = 5). Check (eq_refl 5 <: 2 + 3 = 5). Check (eq_refl 5 <<: 2 + 3 = 5). Definition compute1 := Eval compute in 2 + 3. Check (eq_refl compute1 : 5 = 5). Check (eq_refl : 9223372036854775807 + 1 = 0). Check (eq_refl 0 <: 9223372036854775807 + 1 = 0). Check (eq_refl 0 <<: 9223372036854775807 + 1 = 0). Definition compute2 := Eval compute in 9223372036854775807 + 1. Check (eq_refl compute2 : 0 = 0). coq-8.20.0/test-suite/primitive/uint63/addc.v000066400000000000000000000010521466560755400207330ustar00rootroot00000000000000Require Import Uint63. Set Implicit Arguments. Open Scope uint63_scope. Check (eq_refl : 2 +c 3 = C0 5). Check (eq_refl (C0 5) <: 2 +c 3 = C0 5). Check (eq_refl (C0 5) <<: 2 +c 3 = C0 5). Definition compute1 := Eval compute in 2 +c 3. Check (eq_refl compute1 : C0 5 = C0 5). Check (eq_refl : 9223372036854775807 +c 2 = C1 1). Check (eq_refl (C1 1) <: 9223372036854775807 +c 2 = C1 1). Check (eq_refl (C1 1) <<: 9223372036854775807 +c 2 = C1 1). Definition compute2 := Eval compute in 9223372036854775807 +c 2. Check (eq_refl compute2 : C1 1 = C1 1). coq-8.20.0/test-suite/primitive/uint63/addcarryc.v000066400000000000000000000011451466560755400217770ustar00rootroot00000000000000Require Import PrimInt63. Set Implicit Arguments. Open Scope uint63_scope. Check (eq_refl : addcarryc 2 3 = C0 6). Check (eq_refl (C0 6) <: addcarryc 2 3 = C0 6). Check (eq_refl (C0 6) <<: addcarryc 2 3 = C0 6). Definition compute1 := Eval compute in addcarryc 2 3. Check (eq_refl compute1 : C0 6 = C0 6). Check (eq_refl : addcarryc 9223372036854775807 2 = C1 2). Check (eq_refl (C1 2) <: addcarryc 9223372036854775807 2 = C1 2). Check (eq_refl (C1 2) <<: addcarryc 9223372036854775807 2 = C1 2). Definition compute2 := Eval compute in addcarryc 9223372036854775807 2. Check (eq_refl compute2 : C1 2 = C1 2). coq-8.20.0/test-suite/primitive/uint63/addmuldiv.v000066400000000000000000000020511466560755400220110ustar00rootroot00000000000000Require Import PrimInt63. Set Implicit Arguments. Open Scope uint63_scope. Check (eq_refl : addmuldiv 32 3 5629499534213120 = 12887523328). Check (eq_refl 12887523328 <: addmuldiv 32 3 5629499534213120 = 12887523328). Check (eq_refl 12887523328 <<: addmuldiv 32 3 5629499534213120 = 12887523328). Definition compute2 := Eval compute in addmuldiv 32 3 5629499534213120. Check (eq_refl compute2 : 12887523328 = 12887523328). Check (eq_refl : addmuldiv 0 256 9223372036854775807 = 256). Check (eq_refl 256 <: addmuldiv 0 256 9223372036854775807 = 256). Check (eq_refl 256 <<: addmuldiv 0 256 9223372036854775807 = 256). Check (eq_refl : addmuldiv 63 9223372036854775807 256 = 256). Check (eq_refl 256 <: addmuldiv 63 9223372036854775807 256 = 256). Check (eq_refl 256 <<: addmuldiv 63 9223372036854775807 256 = 256). Check (eq_refl : addmuldiv 65536 9223372036854775807 9223372036854775807 = 0). Check (eq_refl 0 <: addmuldiv 65536 9223372036854775807 9223372036854775807 = 0). Check (eq_refl 0 <<: addmuldiv 65536 9223372036854775807 9223372036854775807 = 0). coq-8.20.0/test-suite/primitive/uint63/compare.v000066400000000000000000000013001466560755400214620ustar00rootroot00000000000000Require Import Uint63. Set Implicit Arguments. Open Scope uint63_scope. Check (eq_refl : 1 ?= 1 = Eq). Check (eq_refl Eq <: 1 ?= 1 = Eq). Check (eq_refl Eq <<: 1 ?= 1 = Eq). Definition compute1 := Eval compute in 1 ?= 1. Check (eq_refl compute1 : Eq = Eq). Check (eq_refl : 1 ?= 2 = Lt). Check (eq_refl Lt <: 1 ?= 2 = Lt). Check (eq_refl Lt <<: 1 ?= 2 = Lt). Definition compute2 := Eval compute in 1 ?= 2. Check (eq_refl compute2 : Lt = Lt). Check (eq_refl : 9223372036854775807 ?= 0 = Gt). Check (eq_refl Gt <: 9223372036854775807 ?= 0 = Gt). Check (eq_refl Gt <<: 9223372036854775807 ?= 0 = Gt). Definition compute3 := Eval compute in 9223372036854775807 ?= 0. Check (eq_refl compute3 : Gt = Gt). coq-8.20.0/test-suite/primitive/uint63/div.v000066400000000000000000000006501466560755400206250ustar00rootroot00000000000000Require Import Uint63. Set Implicit Arguments. Open Scope uint63_scope. Check (eq_refl : 6 / 3 = 2). Check (eq_refl 2 <: 6 / 3 = 2). Check (eq_refl 2 <<: 6 / 3 = 2). Definition compute1 := Eval compute in 6 / 3. Check (eq_refl compute1 : 2 = 2). Check (eq_refl : 3 / 2 = 1). Check (eq_refl 1 <: 3 / 2 = 1). Check (eq_refl 1 <<: 3 / 2 = 1). Definition compute2 := Eval compute in 3 / 2. Check (eq_refl compute2 : 1 = 1). coq-8.20.0/test-suite/primitive/uint63/diveucl.v000066400000000000000000000010231466560755400214710ustar00rootroot00000000000000Require Import PrimInt63. Set Implicit Arguments. Open Scope uint63_scope. Check (eq_refl : diveucl 6 3 = (2,0)). Check (eq_refl (2,0) <: diveucl 6 3 = (2,0)). Check (eq_refl (2,0) <<: diveucl 6 3 = (2,0)). Definition compute1 := Eval compute in diveucl 6 3. Check (eq_refl compute1 : (2,0) = (2,0)). Check (eq_refl : diveucl 5 3 = (1,2)). Check (eq_refl (1,2) <: diveucl 5 3 = (1,2)). Check (eq_refl (1,2) <<: diveucl 5 3 = (1,2)). Definition compute2 := Eval compute in diveucl 5 3. Check (eq_refl compute2 : (1,2) = (1,2)). coq-8.20.0/test-suite/primitive/uint63/diveucl_21.v000066400000000000000000000027371466560755400220100ustar00rootroot00000000000000Require Import Uint63. Set Implicit Arguments. Open Scope uint63_scope. Check (eq_refl : diveucl_21 1 1 2 = (4611686018427387904,1)). Check (eq_refl (4611686018427387904,1) <: diveucl_21 1 1 2 = (4611686018427387904,1)). Check (eq_refl (4611686018427387904,1) <<: diveucl_21 1 1 2 = (4611686018427387904,1)). Definition compute1 := Eval compute in diveucl_21 1 1 2. Check (eq_refl compute1 : (4611686018427387904,1) = (4611686018427387904,1)). Check (eq_refl : diveucl_21 3 1 2 = (0, 0)). Check (eq_refl (0, 0) <: diveucl_21 3 1 2 = (0, 0)). Check (eq_refl (0, 0) <<: diveucl_21 3 1 2 = (0, 0)). Definition compute2 := Eval compute in diveucl_21 3 1 2. Check (eq_refl compute2 : (0, 0) = (0, 0)). Check (eq_refl : diveucl_21 1 1 0 = (0,0)). Check (eq_refl (0,0) <: diveucl_21 1 1 0 = (0,0)). Check (eq_refl (0,0) <<: diveucl_21 1 1 0 = (0,0)). Check (eq_refl : diveucl_21 9223372036854775807 0 1 = (0,0)). Check (eq_refl (0,0) <: diveucl_21 9223372036854775807 0 1 = (0,0)). Check (eq_refl (0,0) <<: diveucl_21 9223372036854775807 0 1 = (0,0)). Check (eq_refl : diveucl_21 9305446873517 1793572051078448654 4930380657631323783 = (17407905077428, 3068214991893055266)). Check (eq_refl (17407905077428, 3068214991893055266) <: diveucl_21 9305446873517 1793572051078448654 4930380657631323783 = (17407905077428, 3068214991893055266)). Check (eq_refl (17407905077428, 3068214991893055266) <<: diveucl_21 9305446873517 1793572051078448654 4930380657631323783 = (17407905077428, 3068214991893055266)). coq-8.20.0/test-suite/primitive/uint63/eqb.v000066400000000000000000000010511466560755400206060ustar00rootroot00000000000000Require Import Uint63. Set Implicit Arguments. Open Scope uint63_scope. Check (eq_refl : 1 =? 1 = true). Check (eq_refl true <: 1 =? 1 = true). Check (eq_refl true <<: 1 =? 1 = true). Definition compute1 := Eval compute in 1 =? 1. Check (eq_refl compute1 : true = true). Check (eq_refl : 9223372036854775807 =? 0 = false). Check (eq_refl false <: 9223372036854775807 =? 0 = false). Check (eq_refl false <<: 9223372036854775807 =? 0 = false). Definition compute2 := Eval compute in 9223372036854775807 =? 0. Check (eq_refl compute2 : false = false). coq-8.20.0/test-suite/primitive/uint63/head0.v000066400000000000000000000013101466560755400210160ustar00rootroot00000000000000Require Import PrimInt63. Set Implicit Arguments. Open Scope uint63_scope. Check (eq_refl : head0 3 = 61). Check (eq_refl 61 <: head0 3 = 61). Check (eq_refl 61 <<: head0 3 = 61). Definition compute1 := Eval compute in head0 3. Check (eq_refl compute1 : 61 = 61). Check (eq_refl : head0 4611686018427387904 = 0). Check (eq_refl 0 <: head0 4611686018427387904 = 0). Check (eq_refl 0 <<: head0 4611686018427387904 = 0). Definition compute2 := Eval compute in head0 4611686018427387904. Check (eq_refl compute2 : 0 = 0). Check (eq_refl : head0 0 = 63). Check (eq_refl 63 <: head0 0 = 63). Check (eq_refl 63 <<: head0 0 = 63). Definition compute3 := Eval compute in head0 0. Check (eq_refl compute3 : 63 = 63). coq-8.20.0/test-suite/primitive/uint63/isint.v000066400000000000000000000034621466560755400211750ustar00rootroot00000000000000(* This file tests the check that arithmetic operations use to know if their arguments are ground. The various test cases correspond to possible optimizations of these tests made by the compiler. *) Require Import Uint63. Set Implicit Arguments. Open Scope uint63_scope. Section test. Variable m n : int. Check (eq_refl : (fun x => x + 3) m = m + 3). Check (eq_refl (m + 3) <: (fun x => x + 3) m = m + 3). Check (eq_refl (m + 3) <<: (fun x => x + 3) m = m + 3). Definition compute1 := Eval compute in (fun x => x + 3) m. Check (eq_refl compute1 : m + 3 = m + 3). Check (eq_refl : (fun x => 3 + x) m = 3 + m). Check (eq_refl (3 + m) <: (fun x => 3 + x) m = 3 + m). Check (eq_refl (3 + m) <<: (fun x => 3 + x) m = 3 + m). Definition compute2 := Eval compute in (fun x => 3 + x) m. Check (eq_refl compute2 : 3 + m = 3 + m). Check (eq_refl : (fun x y => x + y) m n = m + n). Check (eq_refl (m + n) <: (fun x y => x + y) m n = m + n). Check (eq_refl (m + n) <<: (fun x y => x + y) m n = m + n). Definition compute3 := Eval compute in (fun x y => x + y) m n. Check (eq_refl compute3 : m + n = m + n). Check (eq_refl : (fun x y => x + y) 2 3 = 5). Check (eq_refl 5 <: (fun x y => x + y) 2 3 = 5). Check (eq_refl 5 <<: (fun x y => x + y) 2 3 = 5). Definition compute4 := Eval compute in (fun x y => x + y) 2 3. Check (eq_refl compute4 : 5 = 5). Check (eq_refl : (fun x => x + x) m = m + m). Check (eq_refl (m + m) <: (fun x => x + x) m = m + m). Check (eq_refl (m + m) <<: (fun x => x + x) m = m + m). Definition compute5 := Eval compute in (fun x => x + x) m. Check (eq_refl compute5 : m + m = m + m). Check (eq_refl : (fun x => x + x) 2 = 4). Check (eq_refl 4 <: (fun x => x + x) 2 = 4). Check (eq_refl 4 <<: (fun x => x + x) 2 = 4). Definition compute6 := Eval compute in (fun x => x + x) 2. Check (eq_refl compute6 : 4 = 4). End test. coq-8.20.0/test-suite/primitive/uint63/land.v000066400000000000000000000023241466560755400207610ustar00rootroot00000000000000Require Import Uint63. Set Implicit Arguments. Open Scope uint63_scope. Check (eq_refl : 0 land 0 = 0). Check (eq_refl 0 <: 0 land 0 = 0). Check (eq_refl 0 <<: 0 land 0 = 0). Definition compute1 := Eval compute in 0 land 0. Check (eq_refl compute1 : 0 = 0). Check (eq_refl : 9223372036854775807 land 0 = 0). Check (eq_refl 0 <: 9223372036854775807 land 0 = 0). Check (eq_refl 0 <<: 9223372036854775807 land 0 = 0). Definition compute2 := Eval compute in 9223372036854775807 land 0. Check (eq_refl compute2 : 0 = 0). Check (eq_refl : 0 land 9223372036854775807 = 0). Check (eq_refl 0 <: 0 land 9223372036854775807 = 0). Check (eq_refl 0 <<: 0 land 9223372036854775807 = 0). Definition compute3 := Eval compute in 0 land 9223372036854775807. Check (eq_refl compute3 : 0 = 0). Check (eq_refl : 9223372036854775807 land 9223372036854775807 = 9223372036854775807). Check (eq_refl 9223372036854775807 <: 9223372036854775807 land 9223372036854775807 = 9223372036854775807). Check (eq_refl 9223372036854775807 <<: 9223372036854775807 land 9223372036854775807 = 9223372036854775807). Definition compute4 := Eval compute in 9223372036854775807 land 9223372036854775807. Check (eq_refl compute4 : 9223372036854775807 = 9223372036854775807). coq-8.20.0/test-suite/primitive/uint63/leb.v000066400000000000000000000013751466560755400206120ustar00rootroot00000000000000Require Import Uint63. Set Implicit Arguments. Open Scope uint63_scope. Check (eq_refl : 1 <=? 1 = true). Check (eq_refl true <: 1 <=? 1 = true). Check (eq_refl true <<: 1 <=? 1 = true). Definition compute1 := Eval compute in 1 <=? 1. Check (eq_refl compute1 : true = true). Check (eq_refl : 1 <=? 2 = true). Check (eq_refl true <: 1 <=? 2 = true). Check (eq_refl true <<: 1 <=? 2 = true). Definition compute2 := Eval compute in 1 <=? 2. Check (eq_refl compute2 : true = true). Check (eq_refl : 9223372036854775807 <=? 0 = false). Check (eq_refl false <: 9223372036854775807 <=? 0 = false). Check (eq_refl false <<: 9223372036854775807 <=? 0 = false). Definition compute3 := Eval compute in 9223372036854775807 <=? 0. Check (eq_refl compute3 : false = false). coq-8.20.0/test-suite/primitive/uint63/lor.v000066400000000000000000000027001466560755400206350ustar00rootroot00000000000000Require Import Uint63. Set Implicit Arguments. Open Scope uint63_scope. Check (eq_refl : 0 lor 0 = 0). Check (eq_refl 0 <: 0 lor 0 = 0). Check (eq_refl 0 <<: 0 lor 0 = 0). Definition compute1 := Eval compute in 0 lor 0. Check (eq_refl compute1 : 0 = 0). Check (eq_refl : 9223372036854775807 lor 0 = 9223372036854775807). Check (eq_refl 9223372036854775807 <: 9223372036854775807 lor 0 = 9223372036854775807). Check (eq_refl 9223372036854775807 <<: 9223372036854775807 lor 0 = 9223372036854775807). Definition compute2 := Eval compute in 9223372036854775807 lor 0. Check (eq_refl compute2 : 9223372036854775807 = 9223372036854775807). Check (eq_refl : 0 lor 9223372036854775807 = 9223372036854775807). Check (eq_refl 9223372036854775807 <: 0 lor 9223372036854775807 = 9223372036854775807). Check (eq_refl 9223372036854775807 <<: 0 lor 9223372036854775807 = 9223372036854775807). Definition compute3 := Eval compute in 0 lor 9223372036854775807. Check (eq_refl compute3 : 9223372036854775807 = 9223372036854775807). Check (eq_refl : 9223372036854775807 lor 9223372036854775807 = 9223372036854775807). Check (eq_refl 9223372036854775807 <: 9223372036854775807 lor 9223372036854775807 = 9223372036854775807). Check (eq_refl 9223372036854775807 <<: 9223372036854775807 lor 9223372036854775807 = 9223372036854775807). Definition compute4 := Eval compute in 9223372036854775807 lor 9223372036854775807. Check (eq_refl compute4 : 9223372036854775807 = 9223372036854775807). coq-8.20.0/test-suite/primitive/uint63/lsl.v000066400000000000000000000014651466560755400206420ustar00rootroot00000000000000Require Import Uint63. Set Implicit Arguments. Open Scope uint63_scope. Check (eq_refl : 3 << 61 = 6917529027641081856). Check (eq_refl 6917529027641081856 <: 3 << 61 = 6917529027641081856). Check (eq_refl 6917529027641081856 <<: 3 << 61 = 6917529027641081856). Definition compute1 := Eval compute in 3 << 61. Check (eq_refl compute1 : 6917529027641081856 = 6917529027641081856). Check (eq_refl : 2 << 62 = 0). Check (eq_refl 0 <: 2 << 62 = 0). Check (eq_refl 0 <<: 2 << 62 = 0). Definition compute2 := Eval compute in 2 << 62. Check (eq_refl compute2 : 0 = 0). Check (eq_refl : 9223372036854775807 << 64 = 0). Check (eq_refl 0 <: 9223372036854775807 << 64 = 0). Check (eq_refl 0 <<: 9223372036854775807 << 64 = 0). Definition compute3 := Eval compute in 9223372036854775807 << 64. Check (eq_refl compute3 : 0 = 0). coq-8.20.0/test-suite/primitive/uint63/lsr.v000066400000000000000000000015071466560755400206450ustar00rootroot00000000000000Require Import Uint63. Set Implicit Arguments. Open Scope uint63_scope. Check (eq_refl : 6917529027641081856 >> 61 = 3). Check (eq_refl 3 <: 6917529027641081856 >> 61 = 3). Check (eq_refl 3 <<: 6917529027641081856 >> 61 = 3). Definition compute1 := Eval compute in 6917529027641081856 >> 61. Check (eq_refl compute1 : 3 = 3). Check (eq_refl : 2305843009213693952 >> 62 = 0). Check (eq_refl 0 <: 2305843009213693952 >> 62 = 0). Check (eq_refl 0 <<: 2305843009213693952 >> 62 = 0). Definition compute2 := Eval compute in 2305843009213693952 >> 62. Check (eq_refl compute2 : 0 = 0). Check (eq_refl : 9223372036854775807 >> 64 = 0). Check (eq_refl 0 <: 9223372036854775807 >> 64 = 0). Check (eq_refl 0 <<: 9223372036854775807 >> 64 = 0). Definition compute3 := Eval compute in 9223372036854775807 >> 64. Check (eq_refl compute3 : 0 = 0). coq-8.20.0/test-suite/primitive/uint63/ltb.v000066400000000000000000000013701466560755400206240ustar00rootroot00000000000000Require Import Uint63. Set Implicit Arguments. Open Scope uint63_scope. Check (eq_refl : 1 (n + m)%uint63 | _ => (2*m)%uint63 end. Goal forall n, (n ?= 42)%uint63 = Gt -> f n 256 = 512%uint63. intros. unfold f. cbn. Undo. cbv. (* Test reductions under match clauses *) rewrite H. reflexivity. Qed. coq-8.20.0/test-suite/primitive/uint63/sub.v000066400000000000000000000010461466560755400206340ustar00rootroot00000000000000Require Import Uint63. Set Implicit Arguments. Open Scope uint63_scope. Check (eq_refl : 3 - 2 = 1). Check (eq_refl 1 <: 3 - 2 = 1). Check (eq_refl 1 <<: 3 - 2 = 1). Definition compute1 := Eval compute in 3 - 2. Check (eq_refl compute1 : 1 = 1). Check (eq_refl : 0 - 1 = 9223372036854775807). Check (eq_refl 9223372036854775807 <: 0 - 1 = 9223372036854775807). Check (eq_refl 9223372036854775807 <<: 0 - 1 = 9223372036854775807). Definition compute2 := Eval compute in 0 - 1. Check (eq_refl compute2 : 9223372036854775807 = 9223372036854775807). coq-8.20.0/test-suite/primitive/uint63/subc.v000066400000000000000000000011401466560755400207720ustar00rootroot00000000000000Require Import Uint63. Set Implicit Arguments. Open Scope uint63_scope. Check (eq_refl : 3 -c 2 = C0 1). Check (eq_refl (C0 1) <: 3 -c 2 = C0 1). Check (eq_refl (C0 1) <<: 3 -c 2 = C0 1). Definition compute1 := Eval compute in 3 -c 2. Check (eq_refl compute1 : C0 1 = C0 1). Check (eq_refl : 0 -c 1 = C1 9223372036854775807). Check (eq_refl (C1 9223372036854775807) <: 0 -c 1 = C1 9223372036854775807). Check (eq_refl (C1 9223372036854775807) <<: 0 -c 1 = C1 9223372036854775807). Definition compute2 := Eval compute in 0 -c 1. Check (eq_refl compute2 : C1 9223372036854775807 = C1 9223372036854775807). coq-8.20.0/test-suite/primitive/uint63/subcarryc.v000066400000000000000000000012331466560755400220360ustar00rootroot00000000000000Require Import PrimInt63. Set Implicit Arguments. Open Scope uint63_scope. Check (eq_refl : subcarryc 3 1 = C0 1). Check (eq_refl (C0 1) <: subcarryc 3 1 = C0 1). Check (eq_refl (C0 1) <<: subcarryc 3 1 = C0 1). Definition compute1 := Eval compute in subcarryc 3 1. Check (eq_refl compute1 : C0 1 = C0 1). Check (eq_refl : subcarryc 0 1 = C1 9223372036854775806). Check (eq_refl (C1 9223372036854775806) <: subcarryc 0 1 = C1 9223372036854775806). Check (eq_refl (C1 9223372036854775806) <<: subcarryc 0 1 = C1 9223372036854775806). Definition compute2 := Eval compute in subcarryc 0 1. Check (eq_refl compute2 : C1 9223372036854775806 = C1 9223372036854775806). coq-8.20.0/test-suite/primitive/uint63/tail0.v000066400000000000000000000013101466560755400210460ustar00rootroot00000000000000Require Import PrimInt63. Set Implicit Arguments. Open Scope uint63_scope. Check (eq_refl : tail0 2305843009213693952 = 61). Check (eq_refl 61 <: tail0 2305843009213693952 = 61). Check (eq_refl 61 <<: tail0 2305843009213693952 = 61). Definition compute1 := Eval compute in tail0 2305843009213693952. Check (eq_refl compute1 : 61 = 61). Check (eq_refl : tail0 1 = 0). Check (eq_refl 0 <: tail0 1 = 0). Check (eq_refl 0 <<: tail0 1 = 0). Definition compute2 := Eval compute in tail0 1. Check (eq_refl compute2 : 0 = 0). Check (eq_refl : tail0 0 = 63). Check (eq_refl 63 <: tail0 0 = 63). Check (eq_refl 63 <<: tail0 0 = 63). Definition compute3 := Eval compute in tail0 0. Check (eq_refl compute3 : 63 = 63). coq-8.20.0/test-suite/primitive/uint63/unsigned.v000066400000000000000000000010611466560755400216540ustar00rootroot00000000000000(* This file checks that operations over int63 are unsigned. *) Require Import Uint63. Open Scope uint63_scope. (* (0-1) must be the maximum integer value and not negative 1 *) Check (eq_refl : 1/(0-1) = 0). Check (eq_refl 0 <: 1/(0-1) = 0). Check (eq_refl 0 <<: 1/(0-1) = 0). Definition compute1 := Eval compute in 1/(0-1). Check (eq_refl compute1 : 0 = 0). Check (eq_refl : 3 mod (0-1) = 3). Check (eq_refl 3 <: 3 mod (0-1) = 3). Check (eq_refl 3 <<: 3 mod (0-1) = 3). Definition compute2 := Eval compute in 3 mod (0-1). Check (eq_refl compute2 : 3 = 3). coq-8.20.0/test-suite/report.sh000077500000000000000000000020771466560755400163730ustar00rootroot00000000000000#!/usr/bin/env bash # save failed logs to logs/, then print failure information # returns failure code if any failed logs exist # save step SAVEDIR="logs" # reset for local builds rm -rf "$SAVEDIR" mkdir "$SAVEDIR" FAILED=$(mktemp) grep -F 'Error!' -r . -l --null --include="*.log" > "$FAILED" rsync -a --from0 --files-from="$FAILED" . "$SAVEDIR" cp summary.log "$SAVEDIR"/ # cleanup rm "$FAILED" # print info if [ -n "$CI" ] || [ -n "$PRINT_LOGS" ]; then find logs/ -name '*.log' -not -name 'summary.log' -print0 | while IFS= read -r -d '' file; do printf '%s\n' "$file" cat "$file" printf '\n' done printed_logs=1 fi if grep -q -F 'Error!' summary.log ; then echo FAILURES; grep -F 'Error!' summary.log; if [ -z "$printed_logs" ]; then echo 'To print details of failed tests, rerun with environment variable PRINT_LOGS=1' echo 'eg "make report PRINT_LOGS=1" from the test suite directory"' echo 'See README.md in the test suite directory for more information.' fi false else echo NO FAILURES; fi coq-8.20.0/test-suite/ssr/000077500000000000000000000000001466560755400153225ustar00rootroot00000000000000coq-8.20.0/test-suite/ssr/absevarprop.v000066400000000000000000000066441466560755400200470ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* val x = y -> Some x = insub y. move=> y x le_1 defx; rewrite insubT ?(leq_trans le_1) // => ?. by congr (Some _); apply: val_inj=> /=; exact: defx. Qed. Axiom P : nat -> Prop. Axiom Q : forall n, P n -> Prop. Definition R := fun (x : nat) (p : P x) m (q : P (x+1)) => m > 0. Inductive myEx : Type := ExI : forall n (pn : P n) pn', Q n pn -> R n pn n pn' -> myEx. Parameter P1 : P 1. Parameter P11 : P (1 + 1). Parameter Q1 : forall P1, Q 1 P1. Lemma testmE1 : myEx. Proof. apply: ExI 1 _ _ _ _. match goal with |- P 1 => exact: P1 | _ => fail end. match goal with |- P (1+1) => exact: P11 | _ => fail end. match goal with |- forall p : P 1, Q 1 p => move=> *; exact: Q1 | _ => fail end. match goal with |- forall (p : P 1) (q : P (1+1)), is_true (R 1 p 1 q) => done | _ => fail end. Qed. Lemma testE2 : exists y : { x | P x }, sval y = 1. Proof. apply: ex_intro (exist _ 1 _) _. match goal with |- P 1 => exact: P1 | _ => fail end. match goal with |- forall p : P 1, @sval _ _ (@exist _ _ 1 p) = 1 => done | _ => fail end. Qed. Lemma testE3 : exists y : { x | P x }, sval y = 1. Proof. have := (ex_intro _ (exist _ 1 _) _); apply. match goal with |- P 1 => exact: P1 | _ => fail end. match goal with |- forall p : P 1, @sval _ _ (@exist _ _ 1 p) = 1 => done | _ => fail end. Qed. Lemma testE4 : P 2 -> exists y : { x | P x }, sval y = 2. Proof. move=> P2; apply: ex_intro (exist _ 2 _) _. match goal with |- @sval _ _ (@exist _ _ 2 P2) = 2 => done | _ => fail end. Qed. #[export] Hint Resolve P1. Lemma testmE12 : myEx. Proof. apply: ExI 1 _ _ _ _. match goal with |- P (1+1) => exact: P11 | _ => fail end. match goal with |- Q 1 P1 => exact: Q1 | _ => fail end. match goal with |- forall (q : P (1+1)), is_true (R 1 P1 1 q) => done | _ => fail end. Qed. Create HintDb SSR. #[export] Hint Resolve P11 : SSR. Ltac ssrautoprop := trivial with SSR. Lemma testmE13 : myEx. Proof. apply: ExI 1 _ _ _ _. match goal with |- Q 1 P1 => exact: Q1 | _ => fail end. match goal with |- is_true (R 1 P1 1 P11) => done | _ => fail end. Qed. Definition R1 := fun (x : nat) (p : P x) m (q : P (x+1)) (r : Q x p) => m > 0. Inductive myEx1 : Type := ExI1 : forall n (pn : P n) pn' (q : Q n pn), R1 n pn n pn' q -> myEx1. #[export] Hint Extern 0 (Q 1 P1) => apply (Q1 P1) : SSR. (* tests that goals in prop are solved in the right order, propagating instantiations, thus the goal Q 1 ?p1 is faced by trivial after ?p1, and is thus evar free *) Lemma testmE14 : myEx1. Proof. apply: ExI1 1 _ _ _ _. match goal with |- is_true (R1 1 P1 1 P11 (Q1 P1)) => done | _ => fail end. Qed. coq-8.20.0/test-suite/ssr/abstract_var2.v000066400000000000000000000017111466560755400202460ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* nat -> Prop. Axiom tr : forall x y z, P x y -> P y z -> P x z. Lemma test a b c : P a c -> P a b. Proof. intro H. Fail have [: s1 s2] H1 : P a b := @tr _ _ _ s1 s2. have [: w s1 s2] H1 : P a b := @tr _ w _ s1 s2. Abort. coq-8.20.0/test-suite/ssr/autoclean.v000066400000000000000000000001731466560755400174650ustar00rootroot00000000000000Require Import ssreflect. Lemma view_disappears A B (AB : A -> B) : A -> False. Proof. move=> {}/(AB). have := AB. Abort. coq-8.20.0/test-suite/ssr/bang_rewrite.v000066400000000000000000000005101466560755400201550ustar00rootroot00000000000000Set Universe Polymorphism. Require Import ssreflect. Axiom mult@{i} : nat -> nat -> nat. Notation "m * n" := (mult m n). Axiom multA : forall a b c, (a * b) * c = a * (b * c). (* Previously the following gave a universe error: *) Lemma multAA a b c d : ((a * b) * c) * d = a * (b * (c * d)). Proof. by rewrite !multA. Qed. coq-8.20.0/test-suite/ssr/binders.v000066400000000000000000000035371466560755400171470ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* H2. have H3 T (x : T) := x. have ? : bool := H1 _ x. have ? : bool := H2 _ x. have ? : bool := H3 _ x. have ? (z : bool) : forall y : bool, z = z := fun y => refl_equal _. have ? w : w = w := @refl_equal nat w. have ? y : true by []. have ? (z : bool) : z = z. exact: (@refl_equal _ z). have ? (z w : bool) : z = z by exact: (@refl_equal _ z). have H w (a := 3) (_ := 4) : w && true = w. by rewrite andbT. exact I. Qed. Lemma test1 : True. suff (x : bool): x = x /\ True. by move/(_ true); case=> _. split; first by exact: (@refl_equal _ x). suff H y : y && true = y /\ True. by case: (H true). suff H1 /= : true && true /\ True. by rewrite andbT; split; [exact: (@refl_equal _ y) | exact: I]. match goal with |- is_true true /\ True => idtac end. by split. Qed. Lemma foo n : n >= 0. have f i (j := i + n) : j < n. match goal with j := i + n |- _ => idtac end. Undo 2. suff f i (j := i + n) : j < n. done. match goal with j := i + n |- _ => idtac end. Undo 3. done. Qed. coq-8.20.0/test-suite/ssr/binders_of.v000066400000000000000000000017221466560755400176250ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* true | EFin r1, EFin r2 => true | ENInf, _ | _, EPInf => true | EPInf, _ | _, ENInf => false end. Axiom lee_pinfty : forall (x : extended), is_true (le_ereal x (EPInf)). Definition adde_subdef (x y : extended) := match x, y with | EFin _, EFin _ => x | ENInf, _ => ENInf | _ , ENInf => ENInf | EPInf, _ => EPInf | _ , EPInf => EPInf end. Definition adde := nosimpl adde_subdef. Goal forall (x : R), (forall e : R, is_true (le_ereal (EFin x) (adde (EPInf) (EFin e)))) -> True. Proof. intros x. Fail rewrite (lee_pinfty (EFin x)). constructor. Qed. coq-8.20.0/test-suite/ssr/bug_15753_2.v000066400000000000000000000003501466560755400172510ustar00rootroot00000000000000Require Import Coq.ssr.ssreflect. Class FromPureT (φ : Type) := from_pureT : exists ψ : Prop, φ = ψ. Lemma into_forall_impl_pure φ : FromPureT φ -> φ -> True. Proof. rewrite /FromPureT => -[φ' ->]. constructor. Qed. coq-8.20.0/test-suite/ssr/bug_15770.v000066400000000000000000000005341466560755400170330ustar00rootroot00000000000000Require Import Coq.ssr.ssreflect. Axiom xget : forall {T} (P : T -> Prop), T. Variant xget_spec {T} (P : T -> Prop) : T -> Prop -> Type := | XGetSome x of P x : xget_spec P x True. Axiom xgetP : forall {T} (P : T -> Prop), xget_spec P (xget P) (P (xget P)). Lemma xgetPex {T} (P : T -> Prop) : P (xget P). Proof. case: xgetP. constructor. Qed. coq-8.20.0/test-suite/ssr/bug_16720.v000066400000000000000000000015001466560755400170210ustar00rootroot00000000000000From Coq Require Import ssreflect. Class Trivial := trivial {}. #[local] Existing Instance trivial. Goal Trivial. Succeed assert True. have: True. match goal with |- True => admit end. match goal with |- True -> Trivial => admit end. Abort. From Coq Require Import DecidableClass. Goal True. Proof. (* Works as expected. *) have P_iff : (forall n, n = 0 <-> 0 = n). match goal with |- (forall n, n = 0 <-> 0 = n) => admit end. match goal with P_iff : (forall n, n = 0 <-> 0 = n) |- True => admit end. Abort. Goal forall (x y : bool), Decidable (eq x y). Proof. Succeed apply _. have P_iff : (forall n, n = 0 <-> 0 = n). match goal with |- (forall n, n = 0 <-> 0 = n) => admit end. match goal with P_iff : (forall n, n = 0 <-> 0 = n) |- forall (x y : bool), Decidable (eq x y) => admit end. Abort. coq-8.20.0/test-suite/ssr/bug_19229.v000066400000000000000000000160001466560755400170310ustar00rootroot00000000000000From Coq.ssr Require Import ssreflect ssrfun ssrbool. Set Implicit Arguments. Unset Strict Implicit. Unset Printing Implicit Defensive. Module isSub. (* val_subdef being a primitive projections is what makes it fail *) #[projections(primitive)] Record axioms_ T (P : pred T) sub_sort : Type := Axioms_ { val_subdef : sub_sort -> T }. Definition phant_Build T (P : pred T) sub_sort (val_subdef : sub_sort -> T) := @isSub.Axioms_ T P sub_sort val_subdef. End isSub. Module SubType. Record axioms_ T (P : pred T) S : Type := Class { ssralg_isSub_mixin : isSub.axioms_ P S }. Record type T (P : pred T) : Type := Pack { sort : Type; class : @SubType.axioms_ T P sort }. Definition phant_on_ T (P : pred T) (S : type P) (_ : phant (sort S)) := class S. Notation on elpi_ctx_entry_1_was_T_ := (phant_on_ (Phant _) : axioms_ _ elpi_ctx_entry_1_was_T_). Module Exports. Coercion sort : type >-> Sortclass. Coercion ssralg_isSub_mixin : axioms_ >-> isSub.axioms_. Definition val_subdef T (P : pred T) (s : type P) := isSub.val_subdef (SubType.ssralg_isSub_mixin (class s)). End Exports. End SubType. Export SubType.Exports. (* We need a canonical projection so that rewrite can do keyd matching modulo CS inference *) Notation val := ((SubType.on _).(isSub.val_subdef)). Notation "\val" := ((SubType.on _).(isSub.val_subdef)) (only parsing). Notation "\val" := ((_).(isSub.val_subdef)) (only printing). Module isNmodule. Record axioms_ V : Type := Axioms_ { add : V -> V -> V }. Definition phant_Build V (add : V -> V -> V) := Axioms_ add. End isNmodule. Module Nmodule. Record axioms_ (V : Type) : Type := Class { ssralg_isNmodule_mixin : isNmodule.axioms_ V } as record. Record type : Type := Pack { sort : Type; class : Nmodule.axioms_ sort }. Module Exports. Notation nmodType := Nmodule.type. Coercion sort : type >-> Sortclass. Definition add (s : Nmodule.type) := isNmodule.add (Nmodule.ssralg_isNmodule_mixin (Nmodule.class s)). End Exports. End Nmodule. Export Nmodule.Exports. Module isSemiAdditive. Variant axioms_ (U V : Nmodule.type) (apply : forall _ : Nmodule.sort U, Nmodule.sort V) : Type := Axioms_. Definition phant_Build (U V : Nmodule.type) (apply : forall _ : Nmodule.sort U, Nmodule.sort V) := @isSemiAdditive.Axioms_ U V apply. End isSemiAdditive. Module Additive. Record axioms_ (U V : nmodType) (f : U -> V) : Type := Class { ssralg_isSemiAdditive_mixin : isSemiAdditive.axioms_ f } as record. Record type (U V : nmodType) : Type := Pack { sort : U -> V; class : Additive.axioms_ sort }. Module Exports. Coercion sort : type >-> Funclass. End Exports. End Additive. Export Additive.Exports. Lemma raddfD U V (f : Additive.type U V) : {morph f : x y / add x y}. Admitted. Module isAddClosed. Variant axioms_ (V : Nmodule.type) (S : @pred_sort (Nmodule.sort V) (predPredType (Nmodule.sort V))) : Type := Axioms_. Definition phant_Build (V : Nmodule.type) (S : pred_sort (predPredType (Nmodule.sort V))) := Axioms_ S. End isAddClosed. Module AddClosed. Record axioms_ (V : Nmodule.type) (S : pred_sort (predPredType (Nmodule.sort V))) : Type := Class { ssralg_isAddClosed_mixin : isAddClosed.axioms_ S }. Record type (V : Nmodule.type) : Type := Pack { sort : pred_sort (predPredType (Nmodule.sort V)); _ : AddClosed.axioms_ sort }. End AddClosed. Module isSubNmodule. Definition isSubNmodule_U__canonical__ssralg_SubType (V : nmodType) (S : pred V) (U : Type) (local_mixin_ssralg_isSub : isSub.axioms_ S U) := {| SubType.sort := U; SubType.class := {| SubType.ssralg_isSub_mixin := local_mixin_ssralg_isSub |} |}. Definition isSubNmodule_U__canonical__ssralg_Nmodule (U : Type) (local_mixin_ssralg_isNmodule : isNmodule.axioms_ U) := {| Nmodule.sort := U; Nmodule.class := {| Nmodule.ssralg_isNmodule_mixin := local_mixin_ssralg_isNmodule |} |}. Record axioms_ (V : nmodType) (S : pred V) (U : Type) (local_mixin_ssralg_isSub : isSub.axioms_ S U) (local_mixin_ssralg_isNmodule : isNmodule.axioms_ U) : Type := Axioms_ { }. Definition phant_Build (V : nmodType) (S : pred V) (U : Type) (m : isSub.axioms_ S U) (m0 : isNmodule.axioms_ U) := Axioms_ m m0. End isSubNmodule. Module SubNmodule. Record axioms_ (V : nmodType) (S : pred V) (U : Type) : Type := Class { ssralg_isSub_mixin :> isSub.axioms_ S U; ssralg_isNmodule_mixin :> isNmodule.axioms_ U; ssralg_isSubNmodule_mixin :> isSubNmodule.axioms_ ssralg_isSub_mixin ssralg_isNmodule_mixin }. Record type (V : nmodType) (S : pred V) : Type := Pack { sort :> Type; class : SubNmodule.axioms_ S sort }. Module Exports. Coercion ssralg_SubNmodule_class__to__ssralg_Nmodule_class (V : nmodType) (S : pred V) (U : Type) (c : SubNmodule.axioms_ S U) := {| Nmodule.ssralg_isNmodule_mixin := c |}. Coercion ssralg_SubNmodule__to__ssralg_Nmodule (V : nmodType) (S : pred V) (s : SubNmodule.type S) := {| Nmodule.sort := s; Nmodule.class := SubNmodule.class s |}. Coercion ssralg_SubNmodule_class__to__ssralg_SubType_class (V : nmodType) (S : pred V) (U : Type) (c : SubNmodule.axioms_ S U) := {| SubType.ssralg_isSub_mixin := c |}. Coercion ssralg_SubNmodule__to__ssralg_SubType (V : nmodType) (S : pred V) (s : SubNmodule.type S) := {| SubType.sort := s; SubType.class := SubNmodule.class s |}. Canonical join_ssralg_SubNmodule_between_ssralg_Nmodule_and_ssralg_SubType (V : nmodType) (S : pred V) (U : SubNmodule.type S) := {| SubType.sort := U; SubType.class := SubType.class U |}. End Exports. End SubNmodule. Export SubNmodule.Exports. Definition HB_unnamed_factory_0 (V : Nmodule.type) (S : pred (Nmodule.sort V)) (U : @SubNmodule.type V S) := @isSemiAdditive.Axioms_ U V (@isSub.val_subdef _ _ _ (SubType.ssralg_isSub_mixin (SubType.phant_on_ (Phant _)))). Canonical isSub_val_subdef__canonical__ssralg_Additive (V : Nmodule.type) (S : pred (Nmodule.sort V)) (U : @SubNmodule.type V S) := @Additive.Pack (@ssralg_SubNmodule__to__ssralg_Nmodule V S U) V (isSub.val_subdef _) (Additive.Class (HB_unnamed_factory_0 U)). Parameter V : Nmodule.type. Parameter S : pred (Nmodule.sort V). Parameter U : Type. Parameter local_mixin_ssralg_isSub : isSub.axioms_ S U. Canonical Builders_18_U__canonical__ssralg_SubType := @SubType.Pack (Nmodule.sort V) S U (@SubType.Class (Nmodule.sort V) S U local_mixin_ssralg_isSub). Definition HB_unnamed_factory_1 := @isAddClosed.phant_Build V S. Canonical Builders_4_S__canonical__ssralg_AddClosed := @AddClosed.Pack V S (AddClosed.Class HB_unnamed_factory_1). Parameter addU : U -> U -> U. Definition HB_unnamed_factory_2 := @isNmodule.phant_Build U addU. Canonical Builders_4_U__canonical__ssralg_Nmodule := @Nmodule.Pack U (Nmodule.Class HB_unnamed_factory_2). Definition HB_unnamed_factory_3 := @isSubNmodule.phant_Build V S U local_mixin_ssralg_isSub HB_unnamed_factory_2. Canonical Builders_4_U__canonical__ssralg_SubNmodule := @SubNmodule.Pack V S U (SubNmodule.Class HB_unnamed_factory_3). Lemma mulrDl (x y : U) : \val (add x y) = \val (add y x). Proof. rewrite raddfD. (* but "rewrite [LHS]raddfD." works *) Abort. coq-8.20.0/test-suite/ssr/case_TC.v000066400000000000000000000005141466560755400170120ustar00rootroot00000000000000From Coq Require Import ssreflect. From Coq Require Import ssrbool. Set Printing All. Set Debug Ssreflect. Class Class := { sort : Type ; op : sort -> bool }. Coercion sort : Class >-> Sortclass. Arguments op [_] _. Section Section. Context (A B: Class) (a: A). Goal op a || ~~ op a. by case: op. Abort. End Section. coq-8.20.0/test-suite/ssr/case_TC2.v000066400000000000000000000005651466560755400171020ustar00rootroot00000000000000From Coq Require Import Bool ssreflect. Set Printing All. Set Debug Ssreflect. Class Class := { sort : Type ; op : sort -> bool }. Coercion sort : Class >-> Sortclass. Arguments op [_] _. Lemma opP (A: Class) (a: A) : reflect True (op a). Proof. Admitted. Section Section. Context (A B: Class) (a: A). Goal is_true (op a). by case: opP. Abort. End Section. coq-8.20.0/test-suite/ssr/case_TC3.v000066400000000000000000000006271466560755400171020ustar00rootroot00000000000000From Coq Require Import Utf8 Bool ssreflect. Set Printing All. Set Debug Ssreflect. Class Class sort := { op : sort → bool }. Arguments op {_ _}. #[export] Hint Mode Class !. Lemma opP A (C: Class A) (a: A) : reflect True (op a). Proof. Admitted. Arguments op {_ _}. Section Section. Context A B (CA : Class A) (CB : Class B) (a: A). Goal is_true (op a). by case: opP. Abort. End Section. coq-8.20.0/test-suite/ssr/case_polyuniv.v000066400000000000000000000004131466560755400203670ustar00rootroot00000000000000Require Import ssreflect. Set Universe Polymorphism. Cumulative Variant paths {A} (x:A) : A -> Type := idpath : paths x x. Register paths as core.eq.type. Register idpath as core.eq.refl. Lemma case_test (b:bool) : paths b b. Proof. case B:b; reflexivity. Qed. coq-8.20.0/test-suite/ssr/caseeqltac.v000066400000000000000000000001721466560755400176160ustar00rootroot00000000000000Require Import ssreflect. Goal (1 + 2 = 3). Proof. let E := fresh "F" in move E: (2 in LHS) => n. rewrite F. by []. Qed. coq-8.20.0/test-suite/ssr/caseview.v000066400000000000000000000015321466560755400173200ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* True. Proof. by case=> _ /id _. Qed. coq-8.20.0/test-suite/ssr/congr.v000066400000000000000000000033131466560755400166210ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* a == 0 -> b == 0. Proof. move=> a b Eab Eac; congr (_ == 0) : Eac; exact: eqP Eab. Qed. Definition arrow A B := A -> B. Lemma test2 : forall a b : nat, a == b -> arrow (a == 0) (b == 0). Proof. move=> a b Eab; congr (_ == 0); exact: eqP Eab. Qed. Definition equals T (A B : T) := A = B. Lemma test3 : forall a b : nat, a = b -> equals nat (a + b) (b + b). Proof. move=> a b E; congr (_ + _); exact E. Qed. Parameter S : eqType. Parameter f : nat -> S. Coercion f : nat >-> Equality.sort. Lemma test4 : forall a b : nat, b = a -> @eq S (b + b) (a + a). Proof. move=> a b Eba; congr (_ + _); exact: Eba. Qed. Open Scope type_scope. Lemma test5 : forall (P Q Q' : Type) (h : Q = Q'), P * Q = P * Q'. Proof. move=>*; by congr (_ * _). Qed. Lemma test6 : forall (P Q Q' : Type) (h : Q = Q'), P * Q -> P * Q'. Proof. move=> P Q Q' h; by congr (_ * _). Qed. coq-8.20.0/test-suite/ssr/deferclear.v000066400000000000000000000023611466560755400176070ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* a b {a} a c; exact I. Qed. Parameter P : T -> Prop. Lemma test1 : forall a b c : T, P a -> forall d : T, True. Proof. move=> a b {a} a _ d; exact I. Qed. Definition Q := forall x y : nat, x = y. Axiom L : 0 = 0 -> Q. Axiom L' : 0 = 0 -> forall x y : nat, x = y. Lemma test3 : Q. by apply/L. Undo. rewrite /Q. by apply/L. Undo 2. by apply/L'. Qed. coq-8.20.0/test-suite/ssr/delayed_clear_rename.v000066400000000000000000000002001466560755400216050ustar00rootroot00000000000000Require Import ssreflect. Example foo (t t1 t2 : True) : True /\ True -> True -> True. Proof. move=>[{t1 t2 t} t1 t2] t. Abort. coq-8.20.0/test-suite/ssr/dependent_type_err.v000066400000000000000000000020441466560755400213700ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* n <= p -> m < p. move=> n m p Hmn Hnp; rewrite -ltnS. Fail rewrite (_ : forall n0 m0 p0 : nat, m0 <= n0 -> n0 < p0 -> m0 < p0). Fail rewrite leq_ltn_trans. Admitted. coq-8.20.0/test-suite/ssr/derive_inversion.v000066400000000000000000000021641466560755400210660ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* option T -> Type := | wf_f : wf false None | wf_t : forall x, wf true (Some x). Derive Inversion wf_inv with (forall T b (o : option T), wf b o) Sort Prop. Lemma Problem T b (o : option T) : wf b o -> match b with | true => exists x, o = Some x | false => o = None end. Proof. by case: b; elim/wf_inv=> //; case: o=> // a *; exists a. Qed. coq-8.20.0/test-suite/ssr/elim.v000066400000000000000000000236641466560755400164520ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* A s; elim branch: s => [|x xs _]. match goal with _ : _ = [::] |- [::] = [::] => move: branch => // | _ => fail end. match goal with _ : _ = _ :: _ |- _ :: _ = _ :: _ => move: branch => // | _ => fail end. Qed. (* The same but with explicit eliminator and a conflict in the intro pattern *) Lemma testL2 : forall A (s : seq A), s = s. Proof. move=> A s; elim/last_ind branch: s => [|x s _]. match goal with _ : _ = [::] |- [::] = [::] => move: branch => // | _ => fail end. match goal with _ : _ = rcons _ _ |- rcons _ _ = rcons _ _ => move: branch => // | _ => fail end. Qed. (* The same but without names for variables involved in the generated eq *) Lemma testL3 : forall A (s : seq A), s = s. Proof. move=> A s; elim branch: s. match goal with _ : _ = [::] |- [::] = [::] => move: branch => // | _ => fail end. move=> _; match goal with _ : _ = _ :: _ |- _ :: _ = _ :: _ => move: branch => // | _ => fail end. Qed. Inductive foo : Type := K1 : foo | K2 : foo -> foo -> foo | K3 : (nat -> foo) -> foo. (* The same but with more intros to be done *) Lemma testL4 : forall (o : foo), o = o. Proof. move=> o; elim branch: o. match goal with _ : _ = K1 |- K1 = K1 => move: branch => // | _ => fail end. move=> _; match goal with _ : _ = K2 _ _ |- K2 _ _ = K2 _ _ => move: branch => // | _ => fail end. move=> _; match goal with _ : _ = K3 _ |- K3 _ = K3 _ => move: branch => // | _ => fail end. Qed. (* Occurrence counting *) Lemma testO1: forall (b : bool), b = b. Proof. move=> b; case: (b) / idP. match goal with |- is_true b -> true = true => done | _ => fail end. match goal with |- ~ is_true b -> false = false => done | _ => fail end. Qed. (* The same but only the second occ *) Lemma testO2: forall (b : bool), b = b. Proof. move=> b; case: {2}(b) / idP. match goal with |- is_true b -> b = true => done | _ => fail end. match goal with |- ~ is_true b -> b = false => move/(introF idP) => // | _ => fail end. Qed. (* The same but with eq generation *) Lemma testO3: forall (b : bool), b = b. Proof. move=> b; case E: {2}(b) / idP. match goal with _ : is_true b, _ : b = true |- b = true => move: E => _; done | _ => fail end. match goal with H : ~ is_true b, _ : b = false |- b = false => move: E => _; move/(introF idP): H => // | _ => fail end. Qed. (* Views *) Lemma testV1 : forall A (s : seq A), s = s. Proof. move=> A s; case/lastP E: {1}s => [| x xs]. match goal with _ : s = [::] |- [::] = s => symmetry; exact E | _ => fail end. match goal with _ : s = rcons x xs |- rcons _ _ = s => symmetry; exact E | _ => fail end. Qed. Lemma testV2 : forall A (s : seq A), s = s. Proof. move=> A s; case/lastP E: s => [| x xs]. match goal with _ : s = [::] |- [::] = [::] => done | _ => fail end. match goal with _ : s = rcons x xs |- rcons _ _ = rcons _ _ => done | _ => fail end. Qed. Lemma testV3 : forall A (s : seq A), s = s. Proof. move=> A s; case/lastP: s => [| x xs]. match goal with |- [::] = [::] => done | _ => fail end. match goal with |- rcons _ _ = rcons _ _ => done | _ => fail end. Qed. (* Patterns *) Lemma testP1: forall (x y : nat), (y == x) && (y == x) -> y == x. move=> x y; elim: {2}(_ == _) / eqP. match goal with |- (y = x -> is_true ((y == x) && true) -> is_true (y == x)) => move=> -> // | _ => fail end. match goal with |- (y <> x -> is_true ((y == x) && false) -> is_true (y == x)) => move=> _; rewrite andbC // | _ => fail end. Qed. (* The same but with an implicit pattern *) Lemma testP2 : forall (x y : nat), (y == x) && (y == x) -> y == x. move=> x y; elim: {2}_ / eqP. match goal with |- (y = x -> is_true ((y == x) && true) -> is_true (y == x)) => move=> -> // | _ => fail end. match goal with |- (y <> x -> is_true ((y == x) && false) -> is_true (y == x)) => move=> _; rewrite andbC // | _ => fail end. Qed. (* The same but with an eq generation switch *) Lemma testP3 : forall (x y : nat), (y == x) && (y == x) -> y == x. move=> x y; elim E: {2}_ / eqP. match goal with _ : y = x |- (is_true ((y == x) && true) -> is_true (y == x)) => rewrite E; reflexivity | _ => fail end. match goal with _ : y <> x |- (is_true ((y == x) && false) -> is_true (y == x)) => rewrite E => /= H; exact H | _ => fail end. Qed. Inductive spec : nat -> nat -> nat -> Prop := | specK : forall a b c, a = 0 -> b = 2 -> c = 4 -> spec a b c. Lemma specP : spec 0 2 4. Proof. by constructor. Qed. Lemma testP4 : (1+1) * 4 = 2 + (1+1) + (2 + 2). Proof. case: specP => a b c defa defb defc. match goal with |- (a.+1 + a.+1) * c = b + (a.+1 + a.+1) + (b + b) => subst; done | _ => fail end. Qed. Lemma testP5 : (1+1) * 4 = 2 + (1+1) + (2 + 2). Proof. case: (1 + 1) _ / specP => a b c defa defb defc. match goal with |- b * c = a.+2 + b + (a.+2 + a.+2) => subst; done | _ => fail end. Qed. Lemma testP6 : (1+1) * 4 = 2 + (1+1) + (2 + 2). Proof. case: {2}(1 + 1) _ / specP => a b c defa defb defc. match goal with |- (a.+1 + a.+1) * c = a.+2 + b + (a.+2 + a.+2) => subst; done | _ => fail end. Qed. Lemma testP7 : (1+1) * 4 = 2 + (1+1) + (2 + 2). Proof. case: _ (1 + 1) (2 + _) / specP => a b c defa defb defc. match goal with |- b * a.+4 = c + c => subst; done | _ => fail end. Qed. Lemma testP8 : (1+1) * 4 = 2 + (1+1) + (2 + 2). Proof. case E: (1 + 1) (2 + _) / specP=> [a b c defa defb defc]. match goal with |- b * a.+4 = c + c => subst; done | _ => fail end. Qed. Parameters (T : Type) (tr : T -> T). Inductive exec (cf0 cf1 : T) : seq T -> Prop := | exec_step : tr cf0 = cf1 -> exec cf0 cf1 [::] | exec_star : forall cf2 t, tr cf0 = cf2 -> exec cf2 cf1 t -> exec cf0 cf1 (cf2 :: t). Inductive execr (cf0 cf1 : T) : seq T -> Prop := | execr_step : tr cf0 = cf1 -> execr cf0 cf1 [::] | execr_star : forall cf2 t, execr cf0 cf2 t -> tr cf2 = cf1 -> execr cf0 cf1 (t ++ [:: cf2]). Lemma execP : forall cf0 cf1 t, exec cf0 cf1 t <-> execr cf0 cf1 t. Proof. move=> cf0 cf1 t; split => [] Ecf. elim: Ecf. match goal with |- forall cf2 cf3 : T, tr cf2 = cf3 -> execr cf2 cf3 [::] => myadmit | _ => fail end. match goal with |- forall (cf2 cf3 cf4 : T) (t0 : seq T), tr cf2 = cf4 -> exec cf4 cf3 t0 -> execr cf4 cf3 t0 -> execr cf2 cf3 (cf4 :: t0) => myadmit | _ => fail end. elim: Ecf. match goal with |- forall cf2 : T, tr cf0 = cf2 -> exec cf0 cf2 [::] => myadmit | _ => fail end. match goal with |- forall (cf2 cf3 : T) (t0 : seq T), execr cf0 cf3 t0 -> exec cf0 cf3 t0 -> tr cf3 = cf2 -> exec cf0 cf2 (t0 ++ [:: cf3]) => myadmit | _ => fail end. Qed. Fixpoint plus (m n : nat) {struct n} : nat := match n with | 0 => m | S p => S (plus m p) end. Definition plus_equation : forall m n : nat, plus m n = match n with | 0 => m | p.+1 => (plus m p).+1 end := fun m n : nat => match n as n0 return (forall m0 : nat, plus m0 n0 = match n0 with | 0 => m0 | p.+1 => (plus m0 p).+1 end) with | 0 => @erefl nat | n0.+1 => fun m0 : nat => erefl (plus m0 n0).+1 end m. Definition plus_rect : forall (m : nat) (P : nat -> nat -> Type), (forall n : nat, n = 0 -> P 0 m) -> (forall n p : nat, n = p.+1 -> P p (plus m p) -> P p.+1 (plus m p).+1) -> forall n : nat, P n (plus m n) := fun (m : nat) (P : nat -> nat -> Type) (f0 : forall n : nat, n = 0 -> P 0 m) (f : forall n p : nat, n = p.+1 -> P p (plus m p) -> P p.+1 (plus m p).+1) => fix plus0 (n : nat) : P n (plus m n) := eq_rect_r [eta P n] (let f1 := f0 n in let f2 := f n in match n as n0 return (n = n0 -> (forall p : nat, n0 = p.+1 -> P p (plus m p) -> P p.+1 (plus m p).+1) -> (n0 = 0 -> P 0 m) -> P n0 match n0 with | 0 => m | p.+1 => (plus m p).+1 end) with | 0 => fun (_ : n = 0) (_ : forall p : nat, 0 = p.+1 -> P p (plus m p) -> P p.+1 (plus m p).+1) (f4 : 0 = 0 -> P 0 m) => unkeyed (f4 (erefl 0)) | n0.+1 => fun (_ : n = n0.+1) (f3 : forall p : nat, n0.+1 = p.+1 -> P p (plus m p) -> P p.+1 (plus m p).+1) (_ : n0.+1 = 0 -> P 0 m) => let f5 := let p := n0 in let H := erefl n0.+1 : n0.+1 = p.+1 in f3 p H in unkeyed (let Hrec := plus0 n0 in f5 Hrec) end (erefl n) f2 f1) (plus_equation m n). Definition plus_ind := plus_rect. Lemma exF x y z: plus (plus x y) z = plus x (plus y z). elim/plus_ind: z / (plus _ z). match goal with |- forall n : nat, n = 0 -> plus x y = plus x (plus y 0) => idtac end. Undo 2. elim/plus_ind: (plus _ z). match goal with |- forall n : nat, n = 0 -> plus x y = plus x (plus y 0) => idtac end. Undo 2. elim/plus_ind: {z}(plus _ z). match goal with |- forall n : nat, n = 0 -> plus x y = plus x (plus y 0) => idtac end. Undo 2. elim/plus_ind: {z}_. match goal with |- forall n : nat, n = 0 -> plus x y = plus x (plus y 0) => idtac end. Undo 2. elim/plus_ind: z / _. match goal with |- forall n : nat, n = 0 -> plus x y = plus x (plus y 0) => idtac end. done. by move=> _ p _ ->. Qed. (* BUG elim-False *) Lemma testeF : False -> 1 = 0. Proof. by elim. Qed. coq-8.20.0/test-suite/ssr/elim2.v000066400000000000000000000051721466560755400165260ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* Type) idx op I r (P : pred I) F : let s := \big[op/idx]_(i <- r | P i) F i in K s * K' s -> K' s. Proof. by move=> /= [_]. Qed. Arguments big_load [R] K [K' idx op I r P F]. Section Elim1. Variables (R : Type) (K : R -> Type) (f : R -> R). Variables (idx : R) (op op' : R -> R -> R). Hypothesis Kid : K idx. Ltac ASSERT1 := match goal with |- (K idx) => myadmit end. Ltac ASSERT2 K := match goal with |- (forall x1 : R, R -> forall y1 : R, R -> K x1 -> K y1 -> K (op x1 y1)) => myadmit end. Lemma big_rec I r (P : pred I) F (Kop : forall i x, P i -> K x -> K (op (F i) x)) : K (\big[op/idx]_(i <- r | P i) F i). Proof. elim/big_ind2: {-}_. ASSERT1. ASSERT2 K. match goal with |- (forall i : I, is_true (P i) -> K (F i)) => myadmit end. Undo 4. elim/big_ind2: _ / {-}_. ASSERT1. ASSERT2 K. match goal with |- (forall i : I, is_true (P i) -> K (F i)) => myadmit end. Undo 4. elim/big_rec2: (\big[op/idx]_(i <- r | P i) op idx (F i)) / (\big[op/idx]_(i <- r | P i) F i). ASSERT1. match goal with |- (forall i : I, R -> forall y2 : R, is_true (P i) -> K y2 -> K (op (F i) y2)) => myadmit end. Undo 3. elim/(big_load (phantom R)): _. Undo. Fail elim/big_rec2: {2}_. elim/big_rec2: (\big[op/idx]_(i <- r | P i) F i) / {1}(\big[op/idx]_(i <- r | P i) F i). Undo. elim/(big_load (phantom R)): _. Undo. Fail elim/big_rec2: _ / {2}(\big[op/idx]_(i <- r | P i) F i). Admitted. Definition morecomplexthannecessary A (P : A -> A -> Prop) x y := P x y. Lemma grab A (P : A -> A -> Prop) n m : (n = m) -> (P n n) -> morecomplexthannecessary A P n m. by move->. Qed. Goal forall n m, m + (n + m) = m + (n * 1 + m). Proof. move=> n m; elim/grab : (_ * _) / {1}n => //; exact: muln1. Qed. End Elim1. coq-8.20.0/test-suite/ssr/elim_noquant.v000066400000000000000000000012701466560755400202040ustar00rootroot00000000000000Require Import ssreflect. Axiom app : forall T, list T -> list T -> list T. Arguments app {_}. Infix "++" := app. Lemma test (aT rT : Type) (pmap : (aT -> option rT) -> list aT -> list rT) (perm_eq : list rT -> list rT -> Prop) (f : aT -> option rT) (g : rT -> aT) (s t : list aT) (E : forall T : list aT -> Type, (forall s1 s2 s3 : list aT, T (s1 ++ s2 ++ s3) -> T (s2 ++ s1 ++ s3)) -> T s -> T t) : perm_eq (pmap f s) (pmap f t). Proof. elim/E: (t). Admitted. Lemma test2 (a b : nat) : a = b -> b = 1. Proof. elim. match goal with |- a = 1 => idtac end. Admitted. coq-8.20.0/test-suite/ssr/elim_pattern.v000066400000000000000000000023741466560755400202020ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* _. match goal with |- (x == x) = true => myadmit end. match goal with |- (x == x) = false => myadmit end. Qed. Lemma test1 x : (x == x) = (x + x.+1 == 2 * x + 1). elim: (x in RHS). match goal with |- (x == x) = _ => myadmit end. match goal with |- forall n, (x == x) = _ -> (x == x) = _ => myadmit end. Qed. coq-8.20.0/test-suite/ssr/first_n.v000066400000000000000000000017221466560755400171570ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* (bool -> False -> True -> True) -> True. move=> F; let w := constr:(2) in apply; last w first. - by apply: F. - by apply: I. - by apply: true. Qed. coq-8.20.0/test-suite/ssr/gen_have.v000066400000000000000000000124121466560755400172650ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* Prop. Lemma clear_test (b1 b2 : bool) : b2 = b2. Proof. (* wlog gH : (b3 := b2) / b2 = b3. myadmit. *) gen have {b1} H, gH : (b3 := b2) (w := erefl 3) / b2 = b3. myadmit. Fail exact (H b1). exact (H b2 (erefl _)). Qed. Lemma test1 n (ngt0 : 0 < n) : P n. gen have lt2le, /andP[H1 H2] : n ngt0 / (0 <= n) && (n != 0). match goal with |- is_true((0 <= n) && (n != 0)) => myadmit end. Check (lt2le : forall n : nat, 0 < n -> (0 <= n) && (n != 0)). Check (H1 : 0 <= n). Check (H2 : n != 0). myadmit. Qed. Lemma test2 n (ngt0 : 0 < n) : P n. gen have _, /andP[H1 H2] : n ngt0 / (0 <= n) && (n != 0). match goal with |- is_true((0 <= n) && (n != 0)) => myadmit end. lazymatch goal with | lt2le : forall n : nat, is_true(0 < n) -> is_true((0 <= n) && (n != 0)) |- _ => fail "not cleared" | _ => idtac end. Check (H1 : 0 <= n). Check (H2 : n != 0). myadmit. Qed. Lemma test3 n (ngt0 : 0 < n) : P n. gen have H : n ngt0 / (0 <= n) && (n != 0). match goal with |- is_true((0 <= n) && (n != 0)) => myadmit end. Check (H : forall n : nat, 0 < n -> (0 <= n) && (n != 0)). myadmit. Qed. Lemma test4 n (ngt0 : 0 < n) : P n. gen have : n ngt0 / (0 <= n) && (n != 0). match goal with |- is_true((0 <= n) && (n != 0)) => myadmit end. move=> H. Check(H : forall n : nat, 0 < n -> (0 <= n) && (n != 0)). myadmit. Qed. Lemma test4bis n (ngt0 : 0 < n) : P n. wlog suff : n ngt0 / (0 <= n) && (n != 0); last first. match goal with |- is_true((0 <= n) && (n != 0)) => myadmit end. move=> H. Check(H : forall n : nat, 0 < n -> (0 <= n) && (n != 0)). myadmit. Qed. Lemma test5 n (ngt0 : 0 < n) : P n. Fail gen have : / (0 <= n) && (n != 0). Abort. Lemma test6 n (ngt0 : 0 < n) : P n. gen have : n ngt0 / (0 <= n) && (n != 0) by myadmit. Abort. Lemma test7 n (ngt0 : 0 < n) : P n. Fail gen have : n / (0 <= n) && (n != 0). Abort. Lemma test3wlog2 n (ngt0 : 0 < n) : P n. gen have H : (m := n) ngt0 / (0 <= m) && (m != 0). match goal with ngt0 : is_true(0 < m) |- is_true((0 <= m) && (m != 0)) => myadmit end. Check (H : forall n : nat, 0 < n -> (0 <= n) && (n != 0)). myadmit. Qed. Lemma test3wlog3 n (ngt0 : 0 < n) : P n. gen have H : {n} (m := n) (n := 0) ngt0 / (0 <= m) && (m != n). match goal with ngt0 : is_true(n < m) |- is_true((0 <= m) && (m != n)) => myadmit end. Check (H : forall m n : nat, n < m -> (0 <= m) && (m != n)). myadmit. Qed. Lemma testw1 n (ngt0 : 0 < n) : n <= 0. wlog H : (z := 0) (m := n) ngt0 / m != 0. match goal with |- (forall z m, is_true(z < m) -> is_true(m != 0) -> is_true(m <= z)) -> is_true(n <= 0) => myadmit end. Check(n : nat). Check(m : nat). Check(z : nat). Check(ngt0 : z < m). Check(H : m != 0). myadmit. Qed. Lemma testw2 n (ngt0 : 0 < n) : n <= 0. wlog H : (m := n) (z := (X in n <= X)) ngt0 / m != z. match goal with |- (forall m z : nat, is_true(0 < m) -> is_true(m != z) -> is_true(m <= z)) -> is_true(n <= 0) => idtac end. Restart. wlog H : (m := n) (one := (X in X <= _)) ngt0 / m != one. match goal with |- (forall m one : nat, is_true(one <= m) -> is_true(m != one) -> is_true(m <= 0)) -> is_true(n <= 0) => idtac end. Restart. wlog H : {n} (m := n) (z := (X in _ <= X)) ngt0 / m != z. match goal with |- (forall m z : nat, is_true(0 < z) -> is_true(m != z) -> is_true(m <= 0)) -> is_true(n <= 0) => idtac end. myadmit. Fail Check n. myadmit. Qed. Section Test. Variable x : nat. Definition addx y := y + x. Lemma testw3 (m n : nat) (ngt0 : 0 < n) : n <= addx x. wlog H : (n0 := n) (y := x) (@twoy := (id _ as X in _ <= X)) / twoy = 2 * y. myadmit. myadmit. Qed. Definition twox := x + x. Definition bis := twox. Lemma testw3x n (ngt0 : 0 < n) : n + x <= twox. wlog H : (y := x) (@twoy := (X in _ <= X)) / twoy = 2 * y. match goal with |- (forall y : nat, let twoy := y + y in twoy = 2 * y -> is_true(n + y <= twoy)) -> is_true(n + x <= twox) => myadmit end. Restart. wlog H : (y := x) (@twoy := (id _ as X in _ <= X)) / twoy = 2 * y. match goal with |- (forall y : nat, let twoy := twox in twoy = 2 * y -> is_true(n + y <= twoy)) -> is_true(n + x <= twox) => myadmit end. myadmit. Qed. End Test. Lemma test_in n k (def_k : k = 0) (ngtk : k < n) : P n. rewrite -(add0n n) in {def_k k ngtk} (m := k) (def_m := def_k) (ngtm := ngtk). rewrite def_m add0n in {ngtm} (e := erefl 0 ) (ngt0 := ngtm) => {def_m}. myadmit. Qed. coq-8.20.0/test-suite/ssr/gen_pattern.v000066400000000000000000000026571466560755400200310ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* idtac end. Admitted. Lemma bar x y : x + x.+1 = x.+1 + y. move E: ((x.+1 in y)) => w. match goal with |- x + x.+1 = w => rewrite -{w}E end. move E: (x.+1 in y)%myscope => w. match goal with |- x + x.+1 = w => rewrite -{w}E end. move E: ((x + y).+1 as RHS) => w. match goal with |- x + x.+1 = w => rewrite -{}E -addSn end. Admitted. coq-8.20.0/test-suite/ssr/have_TC.v000066400000000000000000000030661466560755400170270ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* _. exact I. Qed. Set SsrHave NoTCResolution. Lemma a' : True. set toto := bar _ 8. have titi : bar _ 5. Fail reflexivity. by myadmit. have titi2 : bar _ 5 := . Fail reflexivity. by myadmit. have totoc (H : bar _ 5) : 3 = 3 := eq_refl. move/totoc: nat => _. exact I. Qed. Unset SsrHave NoTCResolution. #[export] Instance test : foo bool. Proof. have : foo nat. Abort. coq-8.20.0/test-suite/ssr/have_transp.v000066400000000000000000000031171466560755400200250ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* = 0. Proof. have [:s1] @h m : 'I_(n+m).+1. apply: Sub 0 _. abstract: s1 m. by auto. cut (forall m, 0 < (n+m).+1); last assumption. rewrite [_ 1 _]/= in s1 h *. by []. Qed. Lemma test2 n : n >= 0. Proof. have [:s1] @h m : 'I_(n+m).+1 := Sub 0 (s1 m). move=> m; reflexivity. cut (forall m, 0 < (n+m).+1); last assumption. by []. Qed. Lemma test3 n : n >= 0. Proof. Fail have [:s1] @h m : 'I_(n+m).+1 by apply: (Sub 0 (s1 m)); auto. have [:s1] @h m : 'I_(n+m).+1 by apply: (Sub 0); abstract: s1 m; auto. cut (forall m, 0 < (n+m).+1); last assumption. by []. Qed. Lemma test4 n : n >= 0. Proof. have @h m : 'I_(n+m).+1 by apply: (Sub 0); abstract auto. by []. Qed. Lemma test5 : True. Proof. have @t : nat := 3. have : t = 3 by []. by []. Qed. coq-8.20.0/test-suite/ssr/have_view_idiom.v000066400000000000000000000016261466560755400206540ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* //] /= : true && (a && b) := pab. Qed. coq-8.20.0/test-suite/ssr/havesuff.v000066400000000000000000000045451466560755400173300ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* G) -> P -> G. Proof. move=> pg p. have suff {pg} H : P. match goal with |- P -> G => move=> _; exact: pg p | _ => fail end. match goal with H : P -> G |- G => exact: H p | _ => fail end. Qed. Lemma test2 : (P -> G) -> P -> G. Proof. move=> pg p. have suffices {pg} H : P. match goal with |- P -> G => move=> _; exact: pg p | _ => fail end. match goal with H : P -> G |- G => exact: H p | _ => fail end. Qed. Lemma test3 : (P -> G) -> P -> G. Proof. move=> pg p. suff have {pg} H : P. match goal with H : P |- G => exact: pg H | _ => fail end. match goal with |- (P -> G) -> G => move=> H; exact: H p | _ => fail end. Qed. Lemma test4 : (P -> G) -> P -> G. Proof. move=> pg p. suffices have {pg} H: P. match goal with H : P |- G => exact: pg H | _ => fail end. match goal with |- (P -> G) -> G => move=> H; exact: H p | _ => fail end. Qed. (* Lemma test5 : (P -> G) -> P -> G. Proof. move=> pg p. suff have {pg} H : P := pg H. match goal with |- (P -> G) -> G => move=> H; exact: H p | _ => fail end. Qed. *) (* Lemma test6 : (P -> G) -> P -> G. Proof. move=> pg p. suff have {pg} H := pg H. match goal with |- (P -> G) -> G => move=> H; exact: H p | _ => fail end. Qed. *) Lemma test7 : (P -> G) -> P -> G. Proof. move=> pg p. have suff {pg} H : P := pg. match goal with H : P -> G |- G => exact: H p | _ => fail end. Qed. Lemma test8 : (P -> G) -> P -> G. Proof. move=> pg p. have suff {pg} H := pg. match goal with H : P -> G |- G => exact: H p | _ => fail end. Qed. Goal forall x y : bool, x = y -> x = y. move=> x y E. by have {x E} -> : x = y by []. Qed. coq-8.20.0/test-suite/ssr/if_isnt.v000066400000000000000000000017541466560755400171530ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* Prop) := forall x, P x. Axiom P : T -> T -> Prop. Lemma foo : C (fun x => forall y, let z := x in P y x). move=> a b. match goal with |- (let y := _ in _) => idtac end. Admitted. coq-8.20.0/test-suite/ssr/intro_noop.v000066400000000000000000000026321466560755400177020ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* bool -> bool. Proof. by []. Qed. Reserved Notation " a -/ b " (at level 0). Reserved Notation " a -// b " (at level 0). Reserved Notation " a -/= b " (at level 0). Reserved Notation " a -//= b " (at level 0). Lemma test : forall a b c, a || b || c. Proof. move=> ---a--- - -/=- -//- -/=- -//=- b [|-]. move: {-}a => /v/v-H; have _ := H I I. Fail move: {-}a {H} => /v-/v-H. have - -> : a = (id a) by []. have --> : a = (id a) by []. have - - _ : a = (id a) by []. have -{1}-> : a = (id a) by []. by myadmit. move: a. case: b => -[] //. by myadmit. Qed. coq-8.20.0/test-suite/ssr/ipat_apply.v000066400000000000000000000002571466560755400176570ustar00rootroot00000000000000Require Import ssreflect. Section Apply. Variable P : nat -> Prop. Lemma test_apply A B : forall (f : A -> B) (a : A), B. Proof. move=> /[apply] b. exact. Qed. End Apply. coq-8.20.0/test-suite/ssr/ipat_clear_if_id.v000066400000000000000000000010271466560755400207460ustar00rootroot00000000000000Require Import ssreflect. Axiom v1 : nat -> bool. Section Foo. Variable v2 : nat -> bool. Lemma test (v3 : nat -> bool) (v4 : bool -> bool) (v5 : bool -> bool) : nat -> nat -> nat -> nat -> True. Proof. Set Debug Ssreflect. move=> {}/v1 b1 {}/v2 b2 {}/v3 b3 {}/v2/v4/v5 b4. Check b1 : bool. Check b2 : bool. Check b3 : bool. Check b4 : bool. Fail Check v3. Fail Check v4. Fail Check v5. Check v2 : nat -> bool. by []. Qed. Lemma test2 (v : True <-> False) : True -> False. Proof. move=> {}/v. Fail Check v. by []. Qed. End Foo. coq-8.20.0/test-suite/ssr/ipat_dup.v000066400000000000000000000010121466560755400173100ustar00rootroot00000000000000Require Import ssreflect. Section Dup. Section withP. Variable P : nat -> Prop. Lemma test_dup1 : forall n : nat, P n. Proof. move=> /[dup] m n; suff: P n by []. Abort. Lemma test_dup2 : let n := 1 in False. Proof. move=> /[dup] m n; have : m = n := eq_refl. Abort. End withP. Lemma test_dup_plus P Q : P -> Q -> False. Proof. move=> + /[dup] q. suff: P -> Q -> False by []. Abort. Lemma test_dup_plus2 P : P -> let x := 0 in False. Proof. move=> + /[dup] y. suff: P -> let x := 0 in False by []. Abort. End Dup. coq-8.20.0/test-suite/ssr/ipat_fast_any.v000066400000000000000000000006601466560755400203340ustar00rootroot00000000000000Require Import ssreflect. Goal forall y x : nat, x = y -> x = x. Proof. move=> + > ->. match goal with |- forall y, y = y => by [] end. Qed. Goal forall y x : nat, le x y -> x = y. Proof. move=> > [|]. by []. match goal with |- forall a, _ <= a -> _ = S a => admit end. Admitted. Goal forall y x : nat, le x y -> x = y. Proof. move=> y x. case E: x => >. admit. match goal with |- S _ <= y -> S _ = y => admit end. Admitted. coq-8.20.0/test-suite/ssr/ipat_fastid.v000066400000000000000000000015731466560755400200060ustar00rootroot00000000000000Require Import ssreflect. Axiom odd : nat -> Prop. Lemma simple : forall x, 3 <= x -> forall y, odd (y+x) -> x = y -> True. Proof. move=> >x_ge_3 >xy_odd. lazymatch goal with | |- ?x = ?y -> True => done end. Qed. Lemma simple2 : forall x, 3 <= x -> forall y, odd (y+x) -> x = y -> True. Proof. move=> >; move=>x_ge_3; move=> >; move=>xy_odd. lazymatch goal with | |- ?x = ?y -> True => done end. Qed. Definition stuff x := 3 <= x -> forall y, odd (y+x) -> x = y -> True. Lemma harder : forall x, stuff x. Proof. move=> >x_ge_3 >xy_odd. lazymatch goal with | |- ?x = ?y -> True => done end. Qed. Lemma harder2 : forall x, stuff x. Proof. move=> >; move=>x_ge_3;move=> >; move=>xy_odd. lazymatch goal with | |- ?x = ?y -> True => done end. Qed. Lemma homotop : forall x : nat, forall e : x = x, e = e -> True. Proof. move=> >eq_ee. lazymatch goal with | |- True => done end. Qed. coq-8.20.0/test-suite/ssr/ipat_replace.v000066400000000000000000000003431466560755400201410ustar00rootroot00000000000000Require Import ssreflect. Lemma test : True. Proof. have H : True. by []. have {}H : True. by apply: H. by apply: H. Qed. Lemma test2 (H : True) : False -> False -> False. Proof. move=> {}W. move=> {}H. by apply: H. Qed. coq-8.20.0/test-suite/ssr/ipat_seed.v000066400000000000000000000022271466560755400174510ustar00rootroot00000000000000Require Import ssreflect. Section foo. Variable A : Type. Record bar (X : Type) := mk_bar { a : X * A; b : A; c := (a,7); _ : X; _ : X }. Inductive baz (X : Type) (Y : Type) : nat -> Type := | K1 x (e : 0=1) (f := 3) of x=x:>X : baz X Y O | K2 n of n=n & baz X nat 0 : baz X Y (n+1). Axiom Q : nat -> Prop. Axiom Qx : forall x, Q x. Axiom my_ind : forall P : nat -> Prop, P O -> (forall n m (w : P n /\ P m), P (n+m)) -> forall w, P w. Lemma test x : bar nat -> baz nat nat x -> forall n : nat, Q n. Proof. (* record *) move => [^~ _ccc ]. Check (refl_equal _ : c_ccc = (a_ccc, 7)). (* inductive *) move=> [^ xxx_ ]. Check (refl_equal _ : xxx_f = 3). by []. Check (refl_equal _ : xxx_n = xxx_n). (* eliminator *) elim/my_ind => [^ wow_ ]. exact: Qx 0. Check (wow_w : Q wow_n /\ Q wow_m). exact: Qx (wow_n + wow_m). Qed. Arguments mk_bar A x y z w : rename. Arguments K1 A B a b c : rename. Lemma test2 x : bar nat -> baz nat nat x -> forall n : nat, Q n. Proof. move=> [^~ _ccc ]. Check (refl_equal _ : c_ccc = (x_ccc, 7)). move=> [^ xxx_ ]. Check (refl_equal _ : xxx_f = 3). by []. Check (refl_equal _ : xxx_n = xxx_n). Abort. End foo. coq-8.20.0/test-suite/ssr/ipat_swap.v000066400000000000000000000011451466560755400175010ustar00rootroot00000000000000Require Import ssreflect. Section Swap. Definition P n := match n with 1 => true | _ => false end. Lemma test_swap1 : forall (n : nat) (b : bool), P n = b. Proof. move=> /[swap] b n; suff: P n = b by []. Abort. Lemma test_swap2 : let n := 1 in let b := true in False. Proof. move=> /[swap] b n; have : P n = b := eq_refl. Abort. Lemma test_swap_plus P Q R : P -> Q -> R -> False. Proof. move=> + /[swap]. suff: P -> R -> Q -> False by []. Abort. Lemma test_swap_plus2 P : P -> let x := 0 in let y := 1 in False. Proof. move=> + /[swap]. suff: P -> let y := 1 in let x := 0 in False by []. Abort. End Swap. coq-8.20.0/test-suite/ssr/ipat_tac.v000066400000000000000000000015071466560755400173000ustar00rootroot00000000000000Require Import ssreflect. Ltac fancy := case; last first. Notation fancy := (ltac:( fancy )). Ltac replicate n := let what := fresh "_replicate_" in move=> what; do n! [ have := what ]; clear what. Notation replicate n := (ltac:( replicate n )). Lemma foo x (w : nat) (J : bool -> nat -> nat) : exists y, x=0+y. Proof. move: (w) => /ltac:(idtac) _. move: w => /(replicate 6) w1 w2 w3 w4 w5 w6. move: w1 => /J/fancy [w'||];last exact: false. move: w' => /J/fancy[w''||]; last exact: false. by exists x. by exists x. by exists x. Qed. Ltac unfld what := rewrite /what. Notation "% n" := (ltac:( unfld n )) (at level 0) : ssripat_scope. Notation "% n" := n : nat_scope. Open Scope nat_scope. Definition def := 4. Lemma test : True -> def = 4. Proof. move=> _ /(% def). match goal with |- 4 = 4 => reflexivity end. Qed. coq-8.20.0/test-suite/ssr/ipat_tmp.v000066400000000000000000000010511466560755400173230ustar00rootroot00000000000000Require Import ssreflect ssrbool. Axiom eqn : nat -> nat -> bool. Infix "==" := eqn (at level 40). Axiom eqP : forall x y : nat, reflect (x = y) (x == y). Lemma test1 : forall x y : nat, x = y -> forall z : nat, y == z -> x = z. Proof. by move=> x y + z /eqP <-; apply. Qed. Lemma test2 : forall (x y : nat) (e : x = y), e = e -> x = y. Proof. move=> + y + _ => x def_x; exact: (def_x : x = y). Qed. Lemma test3 : forall x y : nat, x = y -> forall z : nat, y == z -> x = z. Proof. move=> ++++ /eqP <- => x y e z; exact: e. Qed. coq-8.20.0/test-suite/ssr/ipatalternation.v000066400000000000000000000016531466560755400207140ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* Prop -> Prop -> Prop -> Prop -> True = False -> Prop -> True \/ True. by move=> A /= /= /= B C {A} {B} ? _ {C} {1}-> *; right. Qed. coq-8.20.0/test-suite/ssr/ltac_have.v000066400000000000000000000025341466560755400174430ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* H. Ltac subst2 H := rewrite addnC in H. Goal ( forall a b: nat, b+a = 0 -> b+a=0). Proof. move=> a b hyp. subst1 hyp. subst2 hyp. done. Qed. coq-8.20.0/test-suite/ssr/misc_extended.v000066400000000000000000000042321466560755400203250ustar00rootroot00000000000000Require Import ssreflect. Require Import List. Lemma test_elim_pattern_1 : forall A (l:list A), l ++ nil = l. Proof. intros A. elim/list_ind => [^~ 1 ]. by []. match goal with |- (a1 :: l1) ++ nil = a1 :: l1 => idtac end. Abort. Lemma test_elim_pattern_2 : forall A (l:list A), l ++ nil = l. Proof. intros. elim: l => [^~ 1 ]. by []. match goal with |- (a1 :: l1) ++ nil = a1 :: l1 => idtac end. Abort. Lemma test_elim_pattern_3 : forall A (l:list A), l ++ nil = l. Proof. intros. elim: l => [ | x l' IH ]. by []. match goal with |- (x :: l') ++ nil = x :: l' => idtac end. Abort. Generalizable Variables A. Class Inhab (A:Type) : Type := { arbitrary : A }. Lemma test_intro_typeclass_1 : forall A `{Inhab A} (l1 l2:list A), l2 = nil -> l1 ++ l2 = l1. Proof. move =>> H. match goal with |- _ = _ => idtac end. Abort. Lemma test_intro_typeclass_2 : forall A `{Inhab A} (x:A), x = arbitrary -> x = arbitrary. Proof. move =>> H. match goal with |- _ = _ => idtac end. Abort. Lemma test_intro_temporary_1 : forall A (l1 l2:list A), l2 = nil -> l1 ++ l2 = l1. Proof. move => A + l2. match goal with |- forall l1, l2 = nil -> l1 ++ l2 = l1 => idtac end. Abort. Lemma test_intro_temporary_2 : forall A `{Inhab A} (l1 l2:list A), l2 = nil -> l1 ++ l2 = l1. Proof. move => > E. match goal with |- _ = _ => idtac end. Abort. Lemma test_dispatch : (forall x:nat, x= x )/\ (forall y:nat, y = y). Proof. intros. split => [ a | b ]. match goal with |- a = a => by [] end. match goal with |- b = b => by [] end. Abort. Lemma test_tactics_as_view_1 : forall A (l1:list A), nil ++ l1 = l1. Proof. move => /ltac:(simpl). Abort. Lemma test_tactics_as_view_2 : forall A, (forall (l1:list A), nil ++ l1 = l1) /\ (nil ++ nil = @nil A). Proof. move => A. (* TODO: I want to do [split =>.] as a temporary step in setting up my script, but this syntax does not seem to be supported. Can't we have an empty ipat? Note that I can do [split => [ | ]]*) split => [| /ltac:(simpl)]. Abort. Notation "%%" := (ltac:(simpl)) : ssripat_scope. Lemma test_tactics_as_view_3 : forall A, (forall (l1:list A), nil ++ l1 = l1) /\ (nil ++ nil = @nil A). Proof. move => /ltac:(split) [ | /%% ]. Abort. coq-8.20.0/test-suite/ssr/misc_tc.v000066400000000000000000000020611466560755400171310ustar00rootroot00000000000000Require Import ssreflect List. Generalizable Variables A B. Class Inhab (A:Type) : Type := { arbitrary : A }. Lemma test_intro_typeclass_1 : forall A `{Inhab A} (x:A), x = arbitrary -> x = arbitrary. Proof. move =>> H. (* introduces [H:x=arbitrary] because first non dependent hypothesis *) Abort. Lemma test_intro_typeclass_2 : forall A `{Inhab A} (l1 l2:list A), l2 = nil -> l1 ++ l2 = l1. Proof. move =>> H. (* introduces [Inhab A] automatically because it is a typeclass instance *) Abort. Lemma test_intro_typeclass_3 : forall `{Inhab A, Inhab B} (x:A) (y:B), True -> x = x. Proof. (* Above types [A] and [B] are implicitly quantified *) move =>> y H. (* introduces the two typeclass instances automatically *) Abort. Class Foo `{Inhab A} : Type := { foo : A }. Lemma test_intro_typeclass_4 : forall `{Foo A}, True -> True. Proof. (* Above, [A] and [{Inhab A}] are implicitly quantified *) move =>> H. (* introduces [A] and [Inhab A] because they are dependently used, and introduce [Foo A] automatically because it is an instance. *) Abort. coq-8.20.0/test-suite/ssr/move_after.v000066400000000000000000000015261466560755400176440ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* True -> True. move=> H1 H2. move H1 after H2. Admitted. coq-8.20.0/test-suite/ssr/multiview.v000066400000000000000000000037031466560755400175410ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* m <= n -> m <= p. by move=> m n p le_n_p /leq_trans; apply. Undo 1. by move=> m n p le_n_p /leq_trans /(_ le_n_p) le_m_p; exact: le_m_p. Undo 1. by move=> m n p le_n_p /leq_trans ->. Qed. Goal forall P Q X : Prop, Q -> (True -> X -> Q = P) -> X -> P. by move=> P Q X q V /V <-. Qed. Lemma test0: forall a b, a && a && b -> b. by move=> a b; repeat move=> /andP []; move=> *. Qed. Lemma test1 : forall a b, a && b -> b. by move=> a b /andP /andP /andP [] //. Qed. Lemma test2 : forall a b, a && b -> b. by move=> a b /andP /andP /(@andP a) [] //. Qed. Lemma test3 : forall a b, a && (b && b) -> b. by move=> a b /andP [_ /andP [_ //]]. Qed. Lemma test4: forall a b, a && b = b && a. by move=> a b; apply/andP/andP=> ?; apply/andP/andP/andP; rewrite andbC; apply/andP. Qed. Lemma test5: forall C I A O, (True -> O) -> (O -> A) -> (True -> A -> I) -> (I -> C) -> C. by move=> c i a o O A I C; apply/C/I/A/O. Qed. Lemma test6: forall A B, (A -> B) -> A -> B. move=> A B A_to_B a; move/A_to_B in a; exact: a. Qed. Lemma test7: forall A B, (A -> B) -> A -> B. move=> A B A_to_B a; apply A_to_B in a; exact: a. Qed. coq-8.20.0/test-suite/ssr/nonPropType.v000066400000000000000000000011711466560755400200060ustar00rootroot00000000000000Require Import ssreflect. (** Test the nonPropType interface and its application to prevent unwanted instantiations in views. **) Lemma raw_flip {T} (x y : T) : x = y -> y = x. Proof. by []. Qed. Lemma flip {T : nonPropType} (x y : T) : x = y -> y = x. Proof. by []. Qed. Lemma testSet : true = false -> True. Proof. Fail move/raw_flip. have flip_true := @flip _ true. (* flip_true : forall y : notProp bool, x = y -> y = x *) simpl in flip_true. (* flip_true : forall y : bool, x = y -> y = x *) by move/flip. Qed. Lemma override (t1 t2 : True) : t1 = t2 -> True. Proof. Fail move/flip. by move/(@flip (notProp True)). Qed. coq-8.20.0/test-suite/ssr/noting_to_inject.v000066400000000000000000000003031466560755400210410ustar00rootroot00000000000000Require Import ssreflect ssrfun ssrbool. Goal forall b : bool, b -> False. Set Warnings "+spurious-ssr-injection". Fail move=> b []. Set Warnings "-spurious-ssr-injection". move=> b []. Abort. coq-8.20.0/test-suite/ssr/occarrow.v000066400000000000000000000021271466560755400173320ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* m * m + n * n = n * n + n * n. move=> n m E; have [{2}-> _] : n * n = m * n /\ True by move: E => {1}<-. by move: E => {3}->. Qed. Lemma test2 : forall n m : nat, True /\ (n = m -> n * n = n * m). by move=> n m; constructor=> [|{2}->]. Qed. coq-8.20.0/test-suite/ssr/over.v000066400000000000000000000027241466560755400164710ustar00rootroot00000000000000Require Import ssreflect. Axiom daemon : False. Ltac myadmit := case: daemon. (** Testing over for the 1-var case *) Lemma test_over_1_1 : False. intros. evar (I : Type); evar (R : Type); evar (x2 : I -> R). assert (H : forall i : nat, i + 2 * i - i = x2 i). intros i. unfold x2 in *; clear x2; unfold R in *; clear R; unfold I in *; clear I. apply Under_rel_from_rel. Fail done. over. myadmit. Qed. Lemma test_over_1_2 : False. intros. evar (I : Type); evar (R : Type); evar (x2 : I -> R). assert (H : forall i : nat, i + 2 * i - i = x2 i). intros i. unfold x2 in *; clear x2; unfold R in *; clear R; unfold I in *; clear I. apply Under_rel_from_rel. Fail done. by rewrite over. myadmit. Qed. (** Testing over for the 2-var case *) Lemma test_over_2_1 : False. intros. evar (I : Type); evar (J : Type); evar (R : Type); evar (x2 : I -> J -> R). assert (H : forall i j, i + 2 * j - i = x2 i j). intros i j. unfold x2 in *; clear x2; unfold R in *; clear R; unfold J in *; clear J; unfold I in *; clear I. apply Under_rel_from_rel. Fail done. over. myadmit. Qed. Lemma test_over_2_2 : False. intros. evar (I : Type); evar (J : Type); evar (R : Type); evar (x2 : I -> J -> R). assert (H : forall i j : nat, i + 2 * j - i = x2 i j). intros i j. unfold x2 in *; clear x2; unfold R in *; clear R; unfold J in *; clear J; unfold I in *; clear I. apply Under_rel_from_rel. Fail done. rewrite over. done. myadmit. Qed. coq-8.20.0/test-suite/ssr/patnoX.v000066400000000000000000000015711466560755400167660ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* x. Fail (rewrite [X in _ && _]andbT). Abort. coq-8.20.0/test-suite/ssr/pattern.v000066400000000000000000000022461466560755400171720ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* True -> 3 = 7) : 28 = 3 * 4. Proof. at [ X in X * 4 ] ltac:(fun place => rewrite -> H in place). - reflexivity. - trivial. - trivial. Qed. coq-8.20.0/test-suite/ssr/predRewrite.v000066400000000000000000000022661466560755400200130ustar00rootroot00000000000000Require Import ssreflect ssrfun ssrbool. (** Test the various idioms that control rewriting in boolean predicate. **) Definition simpl_P := [pred a | ~~ a]. Definition nosimpl_P : pred bool := [pred a | ~~ a]. Definition coll_P : collective_pred bool := [pred a | ~~ a]. Definition appl_P : applicative_pred bool := [pred a | ~~ a]. Definition can_appl_P : pred bool := [pred a | ~~ a]. Canonical register_can_appl_P := ApplicativePred can_appl_P. Ltac see_neg := (let x := fresh "x" in set x := {-}(~~ _); clear x). Lemma test_pred_rewrite (f := false) : True. Proof. have _: f \in simpl_P by rewrite inE; see_neg. have _ a: simpl_P (a && f) by simpl; see_neg; rewrite andbF. have _ a: simpl_P (a && f) by rewrite inE; see_neg; rewrite andbF. have _: f \in nosimpl_P by rewrite inE; see_neg. have _: nosimpl_P f. simpl. Fail see_neg. Fail rewrite inE. done. have _: f \in coll_P. Fail rewrite inE. by rewrite in_collective; see_neg. have _: f \in appl_P. rewrite inE. Fail see_neg. Fail rewrite inE. simpl. Fail see_neg. Fail rewrite app_predE. done. have _: f \in can_appl_P. rewrite inE. Fail see_neg. Fail rewrite inE. simpl. Fail see_neg. by rewrite app_predE in_simpl; see_neg. done. Qed. coq-8.20.0/test-suite/ssr/primproj.v000066400000000000000000000063571466560755400173660ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* A. Parameter e : @foo_car = alias. Goal foo_car _ bar = alias _ bar. Proof. (* Coq equally fails *) Fail rewrite -> e. Fail rewrite e at 1. Fail setoid_rewrite e. Fail setoid_rewrite e at 1. Set Keyed Unification. Fail rewrite -> e. Fail rewrite e at 1. Fail setoid_rewrite e. Fail setoid_rewrite e at 1. Admitted. End CoqBug. (* ----------------------------------------------- *) Require Import ssreflect. Set Primitive Projections. Module T1. Record foo A := Foo { foo_car : A }. Definition bar : foo _ := Foo nat 10. Goal foo_car _ bar = 10. Proof. match goal with | |- foo_car _ bar = 10 => idtac end. rewrite /foo_car. (* Fail match goal with | |- foo_car _ bar = 10 => idtac end. *) Admitted. End T1. Module T2. Record foo {A} := Foo { foo_car : A }. Definition bar : foo := Foo nat 10. Goal foo_car bar = 10. match goal with | |- foo_car bar = 10 => idtac end. rewrite /foo_car. (* Fail match goal with | |- foo_car bar = 10 => idtac end. *) Admitted. End T2. Module T3. Record foo {A} := Foo { foo_car : A }. Definition bar : foo := Foo nat 10. Goal foo_car bar = 10. Proof. rewrite -[foo_car _]/(id _). match goal with |- id _ = 10 => idtac end. Admitted. Goal foo_car bar = 10. Proof. set x := foo_car _. match goal with |- x = 10 => idtac end. Admitted. End T3. Module T4. Inductive seal {A} (f : A) := { unseal : A; seal_eq : unseal = f }. Arguments unseal {_ _} _. Arguments seal_eq {_ _} _. Record uPred : Type := IProp { uPred_holds :> Prop }. Definition uPred_or_def (P Q : uPred) : uPred := {| uPred_holds := P \/ Q |}. Definition uPred_or_aux : seal (@uPred_or_def). by eexists. Qed. Definition uPred_or := unseal uPred_or_aux. Definition uPred_or_eq: @uPred_or = @uPred_or_def := seal_eq uPred_or_aux. Lemma foobar (P1 P2 Q : uPred) : (P1 <-> P2) -> (uPred_or P1 Q) <-> (uPred_or P2 Q). Proof. rewrite uPred_or_eq. (* This fails. *) Admitted. End T4. Module DesignFlaw. Record foo A := Foo { foo_car : A }. Definition bar : foo _ := Foo nat 10. Definition app (f : foo nat -> nat) x := f x. Goal app (foo_car _) bar = 10. Proof. unfold app. (* mkApp should produce a Proj *) Fail set x := (foo_car _ _). Admitted. End DesignFlaw. Module Bug. Record foo A := Foo { foo_car : A }. Definition bar : foo _ := Foo nat 10. Parameter alias : forall A, foo A -> A. Parameter e : @foo_car = alias. Goal foo_car _ bar = alias _ bar. Proof. Fail rewrite e. (* Issue: #86 *) Admitted. End Bug. coq-8.20.0/test-suite/ssr/rew_polyuniv.v000066400000000000000000000060251466560755400202560ustar00rootroot00000000000000From Coq Require Import Utf8 Setoid ssreflect. Set Default Proof Using "Type". Local Set Universe Polymorphism. (** Telescopes *) Inductive tele : Type := | TeleO : tele | TeleS {X} (binder : X → tele) : tele. Arguments TeleS {_} _. (** The telescope version of Coq's function type *) Fixpoint tele_fun (TT : tele) (T : Type) : Type := match TT with | TeleO => T | TeleS b => ∀ x, tele_fun (b x) T end. Notation "TT -t> A" := (tele_fun TT A) (at level 99, A at level 200, right associativity). (** A sigma-like type for an "element" of a telescope, i.e. the data it takes to get a [T] from a [TT -t> T]. *) Inductive tele_arg : tele → Type := | TargO : tele_arg TeleO (* the [x] is the only relevant data here *) | TargS {X} {binder} (x : X) : tele_arg (binder x) → tele_arg (TeleS binder). Definition tele_app {TT : tele} {T} (f : TT -t> T) : tele_arg TT → T := λ a, (fix rec {TT} (a : tele_arg TT) : (TT -t> T) → T := match a in tele_arg TT return (TT -t> T) → T with | TargO => λ t : T, t | TargS x a => λ f, rec a (f x) end) TT a f. Arguments tele_app {!_ _} _ !_ /. Coercion tele_arg : tele >-> Sortclass. Coercion tele_app : tele_fun >-> Funclass. (** Inversion lemma for [tele_arg] *) Lemma tele_arg_inv {TT : tele} (a : TT) : match TT as TT return TT → Prop with | TeleO => λ a, a = TargO | TeleS f => λ a, ∃ x a', a = TargS x a' end a. Proof. induction a; eauto. Qed. Lemma tele_arg_O_inv (a : TeleO) : a = TargO. Proof. exact (tele_arg_inv a). Qed. Lemma tele_arg_S_inv {X} {f : X → tele} (a : TeleS f) : ∃ x a', a = TargS x a'. Proof. exact (tele_arg_inv a). Qed. (** Operate below [tele_fun]s with argument telescope [TT]. *) Fixpoint tele_bind {U} {TT : tele} : (TT → U) → TT -t> U := match TT as TT return (TT → U) → TT -t> U with | TeleO => λ F, F TargO | @TeleS X b => λ (F : TeleS b → U) (x : X), (* b x -t> U *) tele_bind (λ a, F (TargS x a)) end. Arguments tele_bind {_ !_} _ /. (* Show that tele_app ∘ tele_bind is the identity. *) Lemma tele_app_bind {U} {TT : tele} (f : TT → U) x : (tele_app (tele_bind f)) x = f x. Proof. induction TT as [|X b IH]; simpl in *. - rewrite (tele_arg_O_inv x). auto. - destruct (tele_arg_S_inv x) as [x' [a' ->]]. simpl. rewrite IH. auto. Qed. (** Notation-compatible telescope mapping *) (* This adds (tele_app ∘ tele_bind), which is an identity function, around every binder so that, after simplifying, this matches the way we typically write notations involving telescopes. *) Notation "'λ..' x .. y , e" := (tele_app (tele_bind (λ x, .. (tele_app (tele_bind (λ y, e))) .. ))) (at level 200, x binder, y binder, right associativity, format "'[ ' 'λ..' x .. y ']' , e"). (* The testcase *) Lemma test {TA TB : tele} {X} (α' β' γ' : X → Prop) (Φ : TA → TB → Prop) x' : (forall P Q, ((P /\ Q) = Q) * ((P -> Q) = Q)) -> ∀ a b, Φ a b = (λ.. x y, β' x' ∧ (γ' x' → Φ x y)) a b. Proof. intros cheat a b. rewrite !tele_app_bind. by rewrite !cheat. Qed. coq-8.20.0/test-suite/ssr/rewpatterns.v000066400000000000000000000127351466560755400200770ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* nat), f (x + y).+1 = f (y + x.+1). by move=> x y f; rewrite [_.+1](addnC x.+1). Qed. Lemma test2 : forall x y f, x + y + f (y + x) + f (y + x) = x + y + f (y + x) + f (x + y). by move=> x y f; rewrite {2}[in f _]addnC. Qed. Lemma test2' : forall x y f, true && f (x * (y + x)) = true && f(x * (x + y)). by move=> x y f; rewrite [in f _](addnC y). Qed. Lemma test2'' : forall x y f, f (y + x) + f(y + x) + f(y + x) = f(x + y) + f(y + x) + f(x + y). by move=> x y f; rewrite {1 3}[in f _](addnC y). Qed. (* patterns catching bound vars not supported *) Lemma test2_1 : forall x y f, true && (let z := x in f (z * (y + x))) = true && f(x * (x + y)). by move=> x y f; rewrite [in f _](addnC x). (* put y when bound var will be OK *) Qed. Lemma test3 : forall x y f, x + f (x + y) (f (y + x) x) = x + f (x + y) (f (x + y) x). by move=> x y f; rewrite [in X in (f _ X)](addnC y). Qed. Lemma test3' : forall x y f, x = y -> x + f (x + x) x + f (x + x) x = x + f (x + y) x + f (y + x) x. by move=> x y f E; rewrite {2 3}[in X in (f X _)]E. Qed. Lemma test3'' : forall x y f, x = y -> x + f (x + y) x + f (x + y) x = x + f (x + y) x + f (y + y) x. by move=> x y f E; rewrite {2}[in X in (f X _)]E. Qed. Lemma test4 : forall x y f, x = y -> x + f (fun _ : nat => x + x) x + f (fun _ => x + x) x = x + f (fun _ => x + y) x + f (fun _ => y + x) x. by move=> x y f E; rewrite {2 3}[in X in (f X _)]E. Qed. Lemma test4' : forall x y f, x = y -> x + f (fun _ _ _ : nat => x + x) x = x + f (fun _ _ _ => x + y) x. by move=> x y f E; rewrite {2}[in X in (f X _)]E. Qed. Lemma test5 : forall x y f, x = y -> x + f (y + x) x + f (y + x) x = x + f (x + y) x + f (y + x) x. by move=> x y f E; rewrite {1}[X in (f X _)]addnC. Qed. Lemma test3''' : forall x y f, x = y -> x + f (x + y) x + f (x + y) (x + y) = x + f (x + y) x + f (y + y) (x + y). by move=> x y f E; rewrite {1}[in X in (f X X)]E. Qed. Lemma test3'''' : forall x y f, x = y -> x + f (x + y) x + f (x + y) (x + y) = x + f (x + y) x + f (y + y) (y + y). by move=> x y f E; rewrite [in X in (f X X)]E. Qed. Lemma test3x : forall x y f, y+y = x+y -> x + f (x + y) x + f (x + y) (x + y) = x + f (x + y) x + f (y + y) (y + y). by move=> x y f E; rewrite -[X in (f X X)]E. Qed. Lemma test6 : forall x y (f : nat -> nat), f (x + y).+1 = f (y.+1 + x). by move=> x y f; rewrite [(x + y) in X in (f X)]addnC. Qed. Lemma test7 : forall x y (f : nat -> nat), f (x + y).+1 = f (y + x.+1). by move=> x y f; rewrite [(x.+1 + y) as X in (f X)]addnC. Qed. Lemma manual x y z (f : nat -> nat -> nat) : (x + y).+1 + f (x.+1 + y) (z + (x + y).+1) = 0. Proof. rewrite [in f _]addSn. match goal with |- (x + y).+1 + f (x + y).+1 (z + (x + y).+1) = 0 => idtac end. rewrite -[X in _ = X]addn0. match goal with |- (x + y).+1 + f (x + y).+1 (z + (x + y).+1) = 0 + 0 => idtac end. rewrite -{2}[in X in _ = X](addn0 0). match goal with |- (x + y).+1 + f (x + y).+1 (z + (x + y).+1) = 0 + (0 + 0) => idtac end. rewrite [_.+1 in X in f _ X](addnC x.+1). match goal with |- (x + y).+1 + f (x + y).+1 (z + (y + x.+1)) = 0 + (0 + 0) => idtac end. rewrite [x.+1 + y as X in f X _]addnC. match goal with |- (x + y).+1 + f (y + x.+1) (z + (y + x.+1)) = 0 + (0 + 0) => idtac end. Admitted. Goal (exists x : 'I_3, x > 0). apply: (ex_intro _ (@Ordinal _ 2 _)). Admitted. Goal (forall y, 1 < y < 2 -> exists x : 'I_3, x > 0). move=> y; case/andP=> y_gt1 y_lt2; apply: (ex_intro _ (@Ordinal _ y _)). by apply: leq_trans y_lt2 _. by move=> y_lt3; apply: leq_trans _ y_gt1. Qed. Goal (forall x y : nat, forall P : nat -> Prop, x = y -> True). move=> x y P E. have: P x -> P y by suff: x = y by move=> ?; congr (P _). Admitted. Goal forall a : bool, a -> true && a || false && a. by move=> a ?; rewrite [true && _]/= [_ && a]/= orbC [_ || _]//=. Qed. Goal forall a : bool, a -> true && a || false && a. by move=> a ?; rewrite [X in X || _]/= [X in _ || X]/= orbC [false && a as X in X || _]//=. Qed. Parameter a : bool. Definition f x := x || a. Definition g x := f x. Goal a -> g false. by move=> Ha; rewrite [g _]/f orbC Ha. Qed. Goal a -> g false || g false. move=> Ha; rewrite {2}[g _]/f orbC Ha. match goal with |- (is_true (false || true || g false)) => done end. Qed. Goal a -> (a && a || true && a) && true. by move=> Ha; rewrite -[_ || _]/(g _) andbC /= Ha [g _]/f. Qed. Goal a -> (a || a) && true. by move=> Ha; rewrite -[in _ || _]/(f _) Ha andbC /f. Qed. coq-8.20.0/test-suite/ssr/rewrite_illtyped.v000066400000000000000000000003001466560755400210710ustar00rootroot00000000000000From Coq Require Import ssreflect Setoid. Structure SEProp := {prop_of : Prop; _ : prop_of <-> True}. Fact anomaly: forall P : SEProp, prop_of P. Proof. move=> [P E]. Fail rewrite E. Abort. coq-8.20.0/test-suite/ssr/rewrtite_err_msg.v000066400000000000000000000017611466560755400211010ustar00rootroot00000000000000Require Import ssreflect ssrbool. Set Implicit Arguments. Unset Strict Implicit. Unset Printing Implicit Defensive. Axiom finGroupType : Type. Axiom group : finGroupType -> Type. Axiom abelian : forall gT : finGroupType, group gT -> Prop. Arguments abelian {_} _. Axiom carrier : finGroupType -> Type. Coercion carrier : finGroupType >-> Sortclass. Axiom mem : forall gT : finGroupType, gT -> group gT -> Prop. Arguments mem {_} _ _. Axiom mul : forall gT : finGroupType, gT -> gT -> gT. Arguments mul {_} _ _. Definition centralised gT (G : group gT) (x : gT) := forall y, mul x y = mul y x. Arguments centralised {gT} _. Axiom b : bool. Axiom centsP : forall (gT : finGroupType) (A B : group gT), reflect (forall a, mem a A -> centralised B a) b. Arguments centsP {_ _ _}. Lemma commute_abelian (gT : finGroupType) (G : group gT) (G_abelian : abelian G) (g g' : gT) (gG : mem g G) (g'G : mem g' G) : mul g g' = mul g' g. Proof. Fail rewrite (centsP _). (* fails but without an anomaly *) Abort. coq-8.20.0/test-suite/ssr/set_lamda.v000066400000000000000000000021531466560755400174430ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* nat, f nat = 0). Proof. set (f:= fun _:Set =>0). by exists f. Qed. Goal (exists f: Set -> nat, f nat = 0). Proof. set f := (fun _:Set =>0). by exists f. Qed. coq-8.20.0/test-suite/ssr/set_pattern.v000066400000000000000000000062521466560755400200460ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* set t := (x in X in _ = X) end. Ltac T2 x := first [set t := (x in RHS)]. Ltac T3 x := first [set t := (x in Y in _ = Y)|idtac]. Ltac T4 x := set t := (x in RHS); idtac. Ltac T5 x := match goal with |- _ => set t := (x in RHS) | |- _ => idtac end. Require Import ssrbool TestSuite.ssr_mini_mathcomp. Open Scope nat_scope. Lemma foo x y : x.+1 = y + x.+1. set t := (_.+1 in RHS). match goal with |- x.+1 = y + t => rewrite /t {t} end. set t := (x in RHS). match goal with |- x.+1 = y + t.+1 => rewrite /t {t} end. set t := (x in _ = x). match goal with |- x.+1 = t => rewrite /t {t} end. set t := (x in X in _ = X). match goal with |- x.+1 = y + t.+1 => rewrite /t {t} end. set t := (x in RHS). match goal with |- x.+1 = y + t.+1 => rewrite /t {t} end. set t := (y + (1 + x) as X in _ = X). match goal with |- x.+1 = t => rewrite /t addSn add0n {t} end. set t := x.+1. match goal with |- t = y + t => rewrite /t {t} end. set t := (x).+1. match goal with |- t = y + t => rewrite /t {t} end. set t := ((x).+1 in X in _ = X). match goal with |- x.+1 = y + t => rewrite /t {t} end. set t := (x.+1 in RHS). match goal with |- x.+1 = y + t => rewrite /t {t} end. T1 (x.+1). match goal with |- x.+1 = y + t => rewrite /t {t} end. T2 (x.+1). match goal with |- x.+1 = y + t => rewrite /t {t} end. T3 (x.+1). match goal with |- x.+1 = y + t => rewrite /t {t} end. T4 (x.+1). match goal with |- x.+1 = y + t => rewrite /t {t} end. T5 (x.+1). match goal with |- x.+1 = y + t => rewrite /t {t} end. rewrite [RHS]addnC. match goal with |- x.+1 = x.+1 + y => rewrite -[RHS]addnC end. rewrite -[in RHS](@subnK 1 x.+1) //. match goal with |- x.+1 = y + (x.+1 - 1 + 1) => rewrite subnK // end. have H : x.+1 = y by myadmit. set t := _.+1 in H |- *. match goal with H : t = y |- t = y + t => rewrite /t {t} in H * end. set t := (_.+1 in X in _ + X) in H |- *. match goal with H : x.+1 = y |- x.+1 = y + t => rewrite /t {t} in H * end. set t := 0. match goal with t := 0 |- x.+1 = y + x.+1 => clear t end. set t := y + _. match goal with |- x.+1 = t => rewrite /t {t} end. set t : nat := 0. clear t. set t : nat := (x in RHS). match goal with |- x.+1 = y + t.+1 => rewrite /t {t} end. set t : nat := RHS. match goal with |- x.+1 = t => rewrite /t {t} end. (* set t := 0 + _. *) (* set t := (x).+1 in X in _ + X in H |-. *) (* set t := (x).+1 in X in _ = X.*) Admitted. coq-8.20.0/test-suite/ssr/set_polyuniv.v000066400000000000000000000003271466560755400202530ustar00rootroot00000000000000From Coq Require Import ssreflect. Set Default Proof Using "Type". Local Set Universe Polymorphism. Axiom foo : Type -> Prop. Lemma test : foo nat. Proof. set x := foo _. (* key @foo{i} matches @foo{j} *) Abort. coq-8.20.0/test-suite/ssr/simpl_done.v000066400000000000000000000010431466560755400176400ustar00rootroot00000000000000Require Import ssreflect. Inductive lit : Set := | LitP : lit | LitL : lit . Inductive val : Set := | Val : lit -> val. Definition tyref := fun (vl : list val) => match vl with | cons (Val LitL) (cons (Val LitP) _) => False | _ => False end. (** Check that simplification and resolution are performed in the right order by "//=" when several goals are under focus. *) Goal exists vl1 : list val, cons (Val LitL) (cons (Val LitL) nil) = vl1 /\ (tyref vl1) . Proof. eexists (cons _ (cons _ _)). split =>//=. Fail progress simpl. Abort. coq-8.20.0/test-suite/ssr/ssr_sProp.v000066400000000000000000000001441466560755400175020ustar00rootroot00000000000000Require Import ssreflect StrictProp. Goal True. have h := (fun x : sEmpty => x). constructor. Qed. coq-8.20.0/test-suite/ssr/ssrpattern.v000066400000000000000000000002371466560755400177200ustar00rootroot00000000000000Require Import ssrmatching. Goal forall n, match n with 0 => 0 | _ => 0 end = 0. Proof. intro n. ssrpattern (match _ with 0 => _ | S n' => _ end). Abort. coq-8.20.0/test-suite/ssr/ssrsyntax2.v000066400000000000000000000016171466560755400176560ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* id x = 0. Proof. Fail move=> _; reflexivity. Timeout 2 rewrite E => _; reflexivity. Qed. Definition P {A} (x : A) : Prop := x = x. Axiom V : forall A {f : foo A} (x:A), P x -> P (id x). Lemma test1 (x : nat) : P x -> P (id x). Proof. move=> px. Timeout 2 Fail move/V: px. Timeout 2 move/V : (px) => _. move/(V nat) : px => H; exact H. Qed. coq-8.20.0/test-suite/ssr/tcfwd.v000066400000000000000000000003741466560755400166240ustar00rootroot00000000000000Require Import ssreflect. Axioms A B D : Type. Class C := {}. Axiom f : C -> A -> B. Axiom g : D -> C. Local Hint Extern 0 C => apply g;shelve : typeclass_instances. Lemma foo : A -> Type. Proof. move=> /f. (* Not_found *) intro;exact nat. Qed. coq-8.20.0/test-suite/ssr/try_case.v000066400000000000000000000003511466560755400173210ustar00rootroot00000000000000From Coq Require Import ssreflect. Axiom T : Type. Axiom R : T -> T -> Type. (** Check that internal exceptions are correctly caught in the monad *) Goal forall (a b : T) (Hab : R a b), True. Proof. intros. try (case: Hab). Abort. coq-8.20.0/test-suite/ssr/typeof.v000066400000000000000000000016201466560755400170160ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* [ x | ]; [ exact x | exact I ]. Qed. coq-8.20.0/test-suite/ssr/under.v000066400000000000000000000267401466560755400166370ustar00rootroot00000000000000Require Import ssreflect. Require Import ssrbool TestSuite.ssr_mini_mathcomp. Global Unset SsrOldRewriteGoalsOrder. (* under : {occs}[patt]. under : {occs}[patt] by tac1. under : {occs}[patt] by [tac1 | ...]. *) Set Implicit Arguments. Unset Strict Implicit. Unset Printing Implicit Defensive. Axiom daemon : False. Ltac myadmit := case: daemon. Module Mocks. (* Mock bigop.v definitions to test the behavior of under with bigops without requiring mathcomp *) Definition eqfun := fun (A B : Type) (f g : forall _ : B, A) => forall x : B, @eq A (f x) (g x). Section Defix. Variables (T : Type) (n : nat) (f : forall _ : T, T) (x : T). Fixpoint loop (m : nat) : T := match m return T with | O => x | S i => f (loop i) end. Definition iter := loop n. End Defix. Parameter eq_bigl : forall (R : Type) (idx : R) (op : forall (_ : R) (_ : R), R) (I : Type) (r : list I) (P1 P2 : pred I) (F : forall _ : I, R) (_ : @eqfun bool I P1 P2), @eq R (@bigop R I idx r (fun i : I => @BigBody R I i op (P1 i) (F i))) (@bigop R I idx r (fun i : I => @BigBody R I i op (P2 i) (F i))). Parameter eq_big : forall (R : Type) (idx : R) (op : forall (_ : R) (_ : R), R) (I : Type) (r : list I) (P1 P2 : pred I) (F1 F2 : forall _ : I, R) (_ : @eqfun bool I P1 P2) (_ : forall (i : I) (_ : is_true (P1 i)), @eq R (F1 i) (F2 i)), @eq R (@bigop R I idx r (fun i : I => @BigBody R I i op (P1 i) (F1 i))) (@bigop R I idx r (fun i : I => @BigBody R I i op (P2 i) (F2 i))). Parameter eq_bigr : forall (R : Type) (idx : R) (op : forall (_ : R) (_ : R), R) (I : Type) (r : list I) (P : pred I) (F1 F2 : forall _ : I, R) (_ : forall (i : I) (_ : is_true (P i)), @eq R (F1 i) (F2 i)), @eq R (@bigop R I idx r (fun i : I => @BigBody R I i op (P i) (F1 i))) (@bigop R I idx r (fun i : I => @BigBody R I i op (P i) (F2 i))). Parameter big_const_nat : forall (R : Type) (idx : R) (op : forall (_ : R) (_ : R), R) (m n : nat) (x : R), @eq R (@bigop R nat idx (index_iota m n) (fun i : nat => @BigBody R nat i op true x)) (@iter R (subn n m) (op x) idx). Delimit Scope N_scope with num. Delimit Scope nat_scope with N. Reserved Notation "\sum_ ( m <= i < n | P ) F" (at level 41, F at level 41, i, m, n at level 50, format "'[' \sum_ ( m <= i < n | P ) '/ ' F ']'"). Reserved Notation "\sum_ ( m <= i < n ) F" (at level 41, F at level 41, i, m, n at level 50, format "'[' \sum_ ( m <= i < n ) '/ ' F ']'"). Local Notation "+%N" := addn (at level 0, only parsing). Notation "\sum_ ( m <= i < n | P ) F" := (\big[+%N/0%N]_(m <= i < n | P%B) F%N) : (*nat_scope*) big_scope. Notation "\sum_ ( m <= i < n ) F" := (\big[+%N/0%N]_(m <= i < n) F%N) : (*nat_scope*) big_scope. Parameter iter_addn_0 : forall m n : nat, @eq nat (@iter nat n (addn m) O) (muln m n). End Mocks. Import Mocks. (*****************************************************************************) Lemma test_big_nested_1 (F G : nat -> nat) (m n : nat) : \sum_(0 <= i < m) \sum_(0 <= j < n | odd (j * 1)) (i + j) = \sum_(0 <= i < m) \sum_(0 <= j < n | odd j) (j + i). Proof. (* in interactive mode *) under eq_bigr => i Hi. under eq_big => [j|j Hj]. { rewrite muln1. over. } { rewrite addnC. over. } simpl. (* or: cbv beta. *) over. by []. Qed. Lemma test_big_nested_2 (F G : nat -> nat) (m n : nat) : \sum_(0 <= i < m) \sum_(0 <= j < n | odd (j * 1)) (i + j) = \sum_(0 <= i < m) \sum_(0 <= j < n | odd j) (j + i). Proof. (* in one-liner mode *) under eq_bigr => i Hi do under eq_big => [j|j Hj] do [rewrite muln1 | rewrite addnC ]. done. Qed. Lemma test_big_2cond_0intro (F : nat -> nat) (m : nat) : \sum_(0 <= i < m | odd (i + 1)) (i + 2) >= 0. Proof. (* in interactive mode *) under eq_big. { move=> n; rewrite (addnC n 1); over. } { move=> i Hi; rewrite (addnC i 2); over. } done. Qed. Lemma test_big_2cond_1intro (F : nat -> nat) (m : nat) : \sum_(0 <= i < m | odd (i + 1)) (i + 2) >= 0. Proof. (* in interactive mode *) Fail under eq_big => i. (* as it amounts to [under eq_big => [i]] *) Abort. Lemma test_big_2cond_all (F : nat -> nat) (m : nat) : \sum_(0 <= i < m | odd (i + 1)) (i + 2) >= 0. Proof. (* in interactive mode *) Fail under eq_big => *. (* as it amounts to [under eq_big => [*]] *) Abort. Lemma test_big_2cond_all_implied (F : nat -> nat) (m : nat) : \sum_(0 <= i < m | odd (i + 1)) (i + 2) >= 0. Proof. (* in one-liner mode *) under eq_big do [rewrite addnC |rewrite addnC]. (* amounts to [under eq_big => [*|*] do [...|...]] *) done. Qed. Lemma test_big_patt1 (F G : nat -> nat) (n : nat) : \sum_(0 <= i < n) (F i + G i) = \sum_(0 <= i < n) (G i + F i) + 0. Proof. under [in RHS]eq_bigr => i Hi. by rewrite addnC over. done. Qed. Lemma test_big_patt2 (F G : nat -> nat) (n : nat) : \sum_(0 <= i < n) (F i + F i) = \sum_(0 <= i < n) 0 + \sum_(0 <= i < n) (F i * 2). Proof. under [X in _ = _ + X]eq_bigr => i Hi do rewrite mulnS muln1. by rewrite big_const_nat iter_addn_0. Qed. Lemma test_big_occs (F G : nat -> nat) (n : nat) : \sum_(0 <= i < n) (i * 0) = \sum_(0 <= i < n) (i * 0) + \sum_(0 <= i < n) (i * 0). Proof. under {2}[in RHS]eq_bigr => i Hi do rewrite muln0. by rewrite big_const_nat iter_addn_0 mul0n addn0. Qed. Lemma test_big_occs_inH (F G : nat -> nat) (n : nat) : \sum_(0 <= i < n) (i * 0) = \sum_(0 <= i < n) (i * 0) + \sum_(0 <= i < n) (i * 0) -> True. Proof. move=> H. do [under {2}[in RHS]eq_bigr => i Hi do rewrite muln0] in H. by rewrite big_const_nat iter_addn_0 mul0n addn0 in H. Qed. (* Solely used, one such renaming is useless in practice, but it works anyway *) Lemma test_big_cosmetic (F G : nat -> nat) (m n : nat) : \sum_(0 <= i < m) \sum_(0 <= j < n | odd (j * 1)) (i + j) = \sum_(0 <= i < m) \sum_(0 <= j < n | odd j) (j + i). Proof. under [RHS]eq_bigr => a A do under eq_bigr => b B do []. (* renaming bound vars *) myadmit. Qed. Lemma test_big_andb (F : nat -> nat) (m n : nat) : \sum_(0 <= i < 5 | odd i && (i == 1)) i = 1. Proof. under eq_bigl => i do [rewrite andb_idl; first by move/eqP->]. under eq_bigr => i do move/eqP=>{1}->. (* the 2nd occ should not be touched *) myadmit. Qed. Lemma test_foo (f1 f2 : nat -> nat) (f_eq : forall n, f1 n = f2 n) (G : (nat -> nat) -> nat) (Lem : forall f1 f2 : nat -> nat, True -> (forall n, f1 n = f2 n) -> False = False -> G f1 = G f2) : G f1 = G f2. Proof. (* under x: Lem. - done. - rewrite f_eq; over. - done. *) under Lem => [|x|] do [done|rewrite f_eq|done]. done. Qed. (* Inspired From Coquelicot.Lub. *) (* http://coquelicot.saclay.inria.fr/html/Coquelicot.Lub.html#Lub_Rbar_eqset *) Parameters (R Rbar : Set) (R0 : R) (Rbar0 : Rbar). Parameter Rbar_le : Rbar -> Rbar -> Prop. Parameter Lub_Rbar : (R -> Prop) -> Rbar. Parameter Lub_Rbar_eqset : forall E1 E2 : R -> Prop, (forall x : R, E1 x <-> E2 x) -> Lub_Rbar E1 = Lub_Rbar E2. Lemma test_Lub_Rbar (E : R -> Prop) : Rbar_le Rbar0 (Lub_Rbar (fun x => x = R0 \/ E x)). Proof. under Lub_Rbar_eqset => r. by rewrite over. Abort. Lemma ex_iff R (P1 P2 : R -> Prop) : (forall x : R, P1 x <-> P2 x) -> ((exists x, P1 x) <-> (exists x, P2 x)). Proof. by move=> H; split; move=> [x Hx]; exists x; apply H. Qed. Arguments ex_iff [R P1] P2 iffP12. (** Load the [setoid_rewrite] machinery *) Require Setoid. (** Replay the tactics from [test_Lub_Rbar] in this new environment *) Lemma test_Lub_Rbar_again (E : R -> Prop) : Rbar_le Rbar0 (Lub_Rbar (fun x => x = R0 \/ E x)). Proof. under Lub_Rbar_eqset => r. by rewrite over. Abort. Lemma test_ex_iff (P : nat -> Prop) : (exists x, P x) -> True. under ex_iff => n. (* this requires [Setoid] *) by rewrite over. by move=> _. Qed. Section TestGeneric. Context {A B : Type} {R : nat -> B -> B -> Prop} `{!forall n : nat, RelationClasses.Equivalence (R n)}. Variables (F : (A -> A -> B) -> B). Hypothesis ex_gen : forall (n : nat) (P1 P2 : A -> A -> B), (forall x y : A, R n (P1 x y) (P2 x y)) -> (R n (F P1) (F P2)). Arguments ex_gen [n P1] P2 _. Lemma test_ex_gen (P1 P2 : A -> A -> B) (n : nat) : (forall x y : A, P2 x y = P2 y x) -> R n (F P1) (F P2) /\ True -> True. Proof. move=> P2C. under [X in R _ _ X]ex_gen => a b. by rewrite P2C over. by move => _. Qed. End TestGeneric. Import Setoid. (* to expose [Coq.Relations.Relation_Definitions.reflexive], [Coq.Classes.RelationClasses.RewriteRelation], and so on. *) Section TestGeneric2. (* Some toy abstract example with a parameterized setoid type *) Record Setoid (m n : nat) : Type := { car : Type ; Rel : car -> car -> Prop ; refl : reflexive _ Rel ; sym : symmetric _ Rel ; trans : transitive _ Rel }. Context {m n : nat}. Add Parametric Relation (s : Setoid m n) : (car s) (@Rel _ _ s) reflexivity proved by (@refl _ _ s) symmetry proved by (@sym _ _ s) transitivity proved by (@trans _ _ s) as eq_rel. Context {A : Type} {s1 s2 : Setoid m n}. Let B := @car m n s1. Let C := @car m n s2. Variable (F : C -> (A -> A -> B) -> C). Hypothesis rel2_gen : forall (c1 c2 : C) (P1 P2 : A -> A -> B), Rel c1 c2 -> (forall a b : A, Rel (P1 a b) (P2 a b)) -> Rel (F c1 P1) (F c2 P2). Arguments rel2_gen [c1] c2 [P1] P2 _ _. Lemma test_rel2_gen (c : C) (P : A -> A -> B) (toy_hyp : forall a b, P a b = P b a) : Rel (F c P) (F c (fun a b => P b a)). Proof. under [here in Rel _ here]rel2_gen. - over. - by move=> a b; rewrite toy_hyp over. - reflexivity. Qed. End TestGeneric2. Section TestPreOrder. (* inspired by https://github.com/coq/coq/pull/10022#issuecomment-530101950 *) Require Import Morphisms. (** Tip to tell rewrite that the LHS of [leq' x y (:= leq x y = true)] is x, not [leq x y] *) Definition rel_true {T} (R : rel T) x y := is_true (R x y). Definition leq' : nat -> nat -> Prop := rel_true leq. Parameter leq_add : forall m1 m2 n1 n2 : nat, m1 <= n1 -> m2 <= n2 -> m1 + m2 <= n1 + n2. Parameter leq_mul : forall m1 m2 n1 n2 : nat, m1 <= n1 -> m2 <= n2 -> m1 * m2 <= n1 * n2. Local Notation "+%N" := addn (at level 0, only parsing). (** Context lemma *) Lemma leq'_big : forall I (F G : I -> nat) (r : seq I), (forall i : I, leq' (F i) (G i)) -> (leq' (\big[+%N/0%N]_(i <- r) F i) (\big[+%N/0%N]_(i <- r) G i)). Proof. red=> F G m n HFG. apply: (big_ind2 leq _ _ (P := xpredT) (op1 := addn) (op2 := addn)) =>//. move=> *; exact: leq_add. move=> *; exact: HFG. Qed. (** Instances for [setoid_rewrite] *) Instance leq'_rr : RewriteRelation leq' := {}. Instance leq'_proper_addn : Proper (leq' ==> leq' ==> leq') addn. Proof. move=> a1 b1 le1 a2 b2 le2; exact/leq_add. Qed. Instance leq'_proper_muln : Proper (leq' ==> leq' ==> leq') muln. Proof. move=> a1 b1 le1 a2 b2 le2; exact/leq_mul. Qed. Instance leq'_preorder : PreOrder leq'. (** encompasses [Reflexive] *) Proof. rewrite /leq' /rel_true; split =>// ??? A B; exact: leq_trans A B. Qed. Instance leq'_reflexive : Reflexive leq'. Proof. by rewrite /leq' /rel_true. Qed. Parameter leq_add2l : forall p m n : nat, (p + m <= p + n) = (m <= n). Lemma test : forall n : nat, (1 + 2 * (\big[+%N/0]_(i < n) (3 + i)) * 4 + 5 <= 6 + 24 * n + 8 * n * n)%N. Proof. move=> n; rewrite -[is_true _]/(rel_true _ _ _) -/leq'. have lem : forall (i : nat), i < n -> leq' (3 + i) (3 + n). { by move=> i Hi; rewrite /leq' /rel_true leq_add2l; apply/ltnW. } under leq'_big => i. { rewrite UnderE. (* instantiate the evar with the bound "3 + n" *) apply: lem; exact: ltn_ord. } cbv beta. now_show (leq' (1 + 2 * \big[+%N/0]_(i < n) (3 + n) * 4 + 5) (6 + 24 * n + 8 * n * n)). (* uninteresting end of proof, omitted *) Abort. End TestPreOrder. coq-8.20.0/test-suite/ssr/unfold_Opaque.v000066400000000000000000000014041466560755400203110ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* Type := idpath : paths x x. Register paths as core.eq.type. Register idpath as core.eq.refl. Structure type := Pack {sort; op : rel sort}. Example unfold_fold (T : type) (x : sort T) (a : op T x x) : op T x x. Proof. rewrite /op. rewrite -/(op _ _ _). assumption. Qed. Example pattern_unfold_fold (b:bool) (a := b) : paths a b. Proof. rewrite [in X in paths X _]/a. rewrite -[in X in paths X _]/a. constructor. Qed. Example unfold_in_hyp (b:bool) (a := b) : unit. Proof. assert (paths a a) as A by reflexivity. rewrite [in X in paths X _]/a in A. rewrite /a in (B := idpath a). rewrite [in X in paths _ X]/a in (C := idpath a). constructor. Qed. Example fold_in_hyp (b:bool) (p := idpath b) : unit. Proof. assert (paths (idpath b) (idpath b)) as A by reflexivity. rewrite -[in X in paths X _]/p in A. rewrite -[in X in paths _ X]/p in (C := idpath (idpath b)). constructor. Qed. coq-8.20.0/test-suite/ssr/unkeyed.v000066400000000000000000000024011466560755400171520ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* Prop. Goal (forall T (s : seq T), P _ s). move=> T s. elim: s => [| x /lastP [| s] IH]. Admitted. Goal forall x : 'I_1, x = 0 :> nat. move=> /ord1 -> /=; exact: refl_equal. Qed. Goal forall x : 'I_1, x = 0 :> nat. move=> x. move=> /ord1 -> in x |- *. exact: refl_equal. Qed. coq-8.20.0/test-suite/ssr/wlog_suff.v000066400000000000000000000020431466560755400175030ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* Prop. Definition f := fun x y : T => x. Lemma test1 : forall x y : T, P (f x y) -> P x. Proof. move=> x y; set fxy := f x y; move=> Pfxy. wlog H : @fxy Pfxy / P x. match goal with |- (let fxy0 := f x y in P fxy0 -> P x -> P x) -> P x => by auto | _ => fail end. exact: H. Qed. Lemma test2 : forall x y : T, P (f x y) -> P x. Proof. move=> x y; set fxy := f x y; move=> Pfxy. wlog H : fxy Pfxy / P x. match goal with |- (forall fxy, P fxy -> P x -> P x) -> P x => by auto | _ => fail end. exact: H. Qed. Lemma test3 : forall x y : T, P (f x y) -> P x. Proof. move=> x y; set fxy := f x y; move=> Pfxy. move: {1}@fxy (Pfxy) (Pfxy). match goal with |- (let fxy0 := f x y in P fxy0 -> P fxy -> P x) => by auto | _ => fail end. Qed. Lemma test4 : forall n m z: bool, n = z -> let x := n in x = m && n -> x = m && n. move=> n m z E x H. case: true. by rewrite {1 2}E in (x) H |- *. by rewrite {1}E in x H |- *. Qed. coq-8.20.0/test-suite/ssr/wlong_intro.v000066400000000000000000000016421466560755400200550ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* x y. wlog suff: x y / x <= y. Admitted. coq-8.20.0/test-suite/stm/000077500000000000000000000000001466560755400153165ustar00rootroot00000000000000coq-8.20.0/test-suite/stm/Nijmegen_QArithSternBrocot_Zaux.v000066400000000000000000001727451466560755400237250ustar00rootroot00000000000000(* -*- coq-prog-args: ("-async-proofs" "on"); -*- *) (* This program is free software; you can redistribute it and/or *) (* modify it under the terms of the GNU Lesser General Public License *) (* as published by the Free Software Foundation; either version 2.1 *) (* of the License, or (at your option) any later version. *) (* *) (* This program is distributed in the hope that it will be useful, *) (* but WITHOUT ANY WARRANTY; without even the implied warranty of *) (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the *) (* GNU General Public License for more details. *) (* *) (* You should have received a copy of the GNU Lesser General Public *) (* License along with this program; if not, write to the Free *) (* Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA *) (* 02110-1301 USA *) (** This file includes random facts about Integers (and natural numbers) which are not found in the standard library. Some of the lemma here are not used in the QArith development but are rather useful. *) Require Export ZArith. Require Export ZArithRing. Require Import Lia. Tactic Notation "ElimCompare" constr(c) constr(d) := elim_compare c d. Ltac Flip := apply Z.gt_lt || apply Z.lt_gt || apply Z.le_ge || apply Z.ge_le; assumption. Ltac Falsum := try intro; apply False_ind; repeat match goal with | id1:(~ ?X1) |- ?X2 => (apply id1; assumption || reflexivity) || clear id1 end. Ltac Step_l a := match goal with | |- (?X1 < ?X2)%Z => replace X1 with a; [ idtac | try ring ] end. Ltac Step_r a := match goal with | |- (?X1 < ?X2)%Z => replace X2 with a; [ idtac | try ring ] end. Ltac CaseEq formula := generalize (refl_equal formula); pattern formula at -1 in |- *; case formula. Lemma pair_1 : forall (A B : Set) (H : A * B), H = pair (fst H) (snd H). Proof. intros. case H. intros. simpl in |- *. reflexivity. Qed. Lemma pair_2 : forall (A B : Set) (H1 H2 : A * B), fst H1 = fst H2 -> snd H1 = snd H2 -> H1 = H2. Proof. intros A B H1 H2. case H1. case H2. simpl in |- *. intros. rewrite H. rewrite H0. reflexivity. Qed. Section projection. Variable A : Set. Variable P : A -> Prop. Definition projP1 (H : sig P) := let (x, h) := H in x. Definition projP2 (H : sig P) := let (x, h) as H return (P (projP1 H)) := H in h. End projection. (*###########################################################################*) (* Declaring some relations on natural numbers for stepl and stepr tactics. *) (*###########################################################################*) Lemma le_stepl: forall x y z, le x y -> x=z -> le z y. Proof. intros x y z H_le H_eq; subst z; trivial. Qed. Lemma le_stepr: forall x y z, le x y -> y=z -> le x z. Proof. intros x y z H_le H_eq; subst z; trivial. Qed. Lemma lt_stepl: forall x y z, lt x y -> x=z -> lt z y. Proof. intros x y z H_lt H_eq; subst z; trivial. Qed. Lemma lt_stepr: forall x y z, lt x y -> y=z -> lt x z. Proof. intros x y z H_lt H_eq; subst z; trivial. Qed. Lemma neq_stepl:forall (x y z:nat), x<>y -> x=z -> z<>y. Proof. intros x y z H_lt H_eq; subst; assumption. Qed. Lemma neq_stepr:forall (x y z:nat), x<>y -> y=z -> x<>z. Proof. intros x y z H_lt H_eq; subst; assumption. Qed. Declare Left Step le_stepl. Declare Right Step le_stepr. Declare Left Step lt_stepl. Declare Right Step lt_stepr. Declare Left Step neq_stepl. Declare Right Step neq_stepr. (*###########################################################################*) (** Some random facts about natural numbers, positive numbers and integers *) (*###########################################################################*) Lemma not_O_S : forall n : nat, n <> 0 -> {p : nat | n = S p}. Proof. intros [| np] Hn; [ exists 0; apply False_ind; apply Hn | exists np ]; reflexivity. Qed. Lemma lt_minus_neq : forall m n : nat, m < n -> n - m <> 0. Proof. intros. lia. Qed. Lemma lt_minus_eq_0 : forall m n : nat, m < n -> m - n = 0. Proof. intros. lia. Qed. Lemma le_plus_Sn_1_SSn : forall n : nat, S n + 1 <= S (S n). Proof. intros. lia. Qed. Lemma le_plus_O_l : forall p q : nat, p + q <= 0 -> p = 0. Proof. intros; lia. Qed. Lemma le_plus_O_r : forall p q : nat, p + q <= 0 -> q = 0. Proof. intros; lia. Qed. Lemma minus_pred : forall m n : nat, 0 < n -> pred m - pred n = m - n. Proof. intros. lia. Qed. (*###########################################################################*) (* Declaring some relations on integers for stepl and stepr tactics. *) (*###########################################################################*) Lemma Zle_stepl: forall x y z, (x<=y)%Z -> x=z -> (z<=y)%Z. Proof. intros x y z H_le H_eq; subst z; trivial. Qed. Lemma Zle_stepr: forall x y z, (x<=y)%Z -> y=z -> (x<=z)%Z. Proof. intros x y z H_le H_eq; subst z; trivial. Qed. Lemma Zlt_stepl: forall x y z, (x x=z -> (z y=z -> (xy)%Z -> x=z -> (z<>y)%Z. Proof. intros x y z H_lt H_eq; subst; assumption. Qed. Lemma Zneq_stepr:forall (x y z:Z), (x<>y)%Z -> y=z -> (x<>z)%Z. Proof. intros x y z H_lt H_eq; subst; assumption. Qed. Declare Left Step Zle_stepl. Declare Right Step Zle_stepr. Declare Left Step Zlt_stepl. Declare Right Step Zlt_stepr. Declare Left Step Zneq_stepl. Declare Right Step Zneq_stepr. (*###########################################################################*) (** Informative case analysis *) (*###########################################################################*) Lemma Zlt_cotrans : forall x y : Z, (x < y)%Z -> forall z : Z, {(x < z)%Z} + {(z < y)%Z}. Proof. intros. case (Z_lt_ge_dec x z). intro. left. assumption. intro. right. apply Z.le_lt_trans with (m := x). apply Z.ge_le. assumption. assumption. Qed. Lemma Zlt_cotrans_pos : forall x y : Z, (0 < x + y)%Z -> {(0 < x)%Z} + {(0 < y)%Z}. Proof. intros. case (Zlt_cotrans 0 (x + y) H x). intro. left. assumption. intro. right. apply Zplus_lt_reg_l with (p := x). rewrite Zplus_0_r. assumption. Qed. Lemma Zlt_cotrans_neg : forall x y : Z, (x + y < 0)%Z -> {(x < 0)%Z} + {(y < 0)%Z}. Proof. intros x y H; case (Zlt_cotrans (x + y) 0 H x); intro Hxy; [ right; apply Zplus_lt_reg_l with (p := x); rewrite Zplus_0_r | left ]; assumption. Qed. Lemma not_Zeq_inf : forall x y : Z, x <> y -> {(x < y)%Z} + {(y < x)%Z}. Proof. intros. case Z_lt_ge_dec with x y. intro. left. assumption. intro H0. generalize (Z.ge_le _ _ H0). intro. case (Z_le_lt_eq_dec _ _ H1). intro. right. assumption. intro. apply False_rec. apply H. symmetry in |- *. assumption. Qed. Lemma Z_dec : forall x y : Z, {(x < y)%Z} + {(x > y)%Z} + {x = y}. Proof. intros. case (Z_lt_ge_dec x y). intro H. left. left. assumption. intro H. generalize (Z.ge_le _ _ H). intro H0. case (Z_le_lt_eq_dec y x H0). intro H1. left. right. apply Z.lt_gt. assumption. intro. right. symmetry in |- *. assumption. Qed. Lemma Z_dec' : forall x y : Z, {(x < y)%Z} + {(y < x)%Z} + {x = y}. Proof. intros x y. case (Z.eq_dec x y); intro H; [ right; assumption | left; apply (not_Zeq_inf _ _ H) ]. Qed. Lemma Z_lt_le_dec : forall x y : Z, {(x < y)%Z} + {(y <= x)%Z}. Proof. intros. case (Z_lt_ge_dec x y). intro. left. assumption. intro. right. apply Z.ge_le. assumption. Qed. Lemma Z_le_lt_dec : forall x y : Z, {(x <= y)%Z} + {(y < x)%Z}. Proof. intros; case (Z_lt_le_dec y x); [ right | left ]; assumption. Qed. Lemma Z_lt_lt_S_eq_dec : forall x y : Z, (x < y)%Z -> {(x + 1 < y)%Z} + {(x + 1)%Z = y}. Proof. intros. generalize (Zlt_le_succ _ _ H). unfold Z.succ in |- *. apply Z_le_lt_eq_dec. Qed. Lemma quadro_leq_inf : forall a b c d : Z, {(c <= a)%Z /\ (d <= b)%Z} + {~ ((c <= a)%Z /\ (d <= b)%Z)}. Proof. intros. case (Z_lt_le_dec a c). intro z. right. intro. elim H. intros. generalize z. apply Zle_not_lt. assumption. intro. case (Z_lt_le_dec b d). intro z0. right. intro. elim H. intros. generalize z0. apply Zle_not_lt. assumption. intro. left. split. assumption. assumption. Qed. (*###########################################################################*) (** General auxiliary lemmata *) (*###########################################################################*) Lemma Zminus_eq : forall x y : Z, (x - y)%Z = 0%Z -> x = y. Proof. intros. apply Zplus_reg_l with (- y)%Z. rewrite Zplus_opp_l. unfold Zminus in H. rewrite Zplus_comm. assumption. Qed. Lemma Zlt_minus : forall a b : Z, (b < a)%Z -> (0 < a - b)%Z. Proof. intros a b. intros. apply Zplus_lt_reg_l with b. unfold Zminus in |- *. rewrite (Zplus_comm a). rewrite (Zplus_assoc b (- b)). rewrite Zplus_opp_r. simpl in |- *. rewrite <- Zplus_0_r_reverse. assumption. Qed. Lemma Zle_minus : forall a b : Z, (b <= a)%Z -> (0 <= a - b)%Z. Proof. intros a b. intros. apply Zplus_le_reg_l with b. unfold Zminus in |- *. rewrite (Zplus_comm a). rewrite (Zplus_assoc b (- b)). rewrite Zplus_opp_r. simpl in |- *. rewrite <- Zplus_0_r_reverse. assumption. Qed. Lemma Zlt_plus_plus : forall m n p q : Z, (m < n)%Z -> (p < q)%Z -> (m + p < n + q)%Z. Proof. intros. apply Z.lt_trans with (m := (n + p)%Z). rewrite Zplus_comm. rewrite Zplus_comm with (n := n). apply Zplus_lt_compat_l. assumption. apply Zplus_lt_compat_l. assumption. Qed. Lemma Zgt_plus_plus : forall m n p q : Z, (m > n)%Z -> (p > q)%Z -> (m + p > n + q)%Z. intros. apply Zgt_trans with (m := (n + p)%Z). rewrite Zplus_comm. rewrite Zplus_comm with (n := n). apply Zplus_gt_compat_l. assumption. apply Zplus_gt_compat_l. assumption. Qed. Lemma Zle_lt_plus_plus : forall m n p q : Z, (m <= n)%Z -> (p < q)%Z -> (m + p < n + q)%Z. Proof. intros. case (Zle_lt_or_eq m n). assumption. intro. apply Zlt_plus_plus. assumption. assumption. intro. rewrite H1. apply Zplus_lt_compat_l. assumption. Qed. Lemma Zge_gt_plus_plus : forall m n p q : Z, (m >= n)%Z -> (p > q)%Z -> (m + p > n + q)%Z. Proof. intros. case (Zle_lt_or_eq n m). apply Z.ge_le. assumption. intro. apply Zgt_plus_plus. apply Z.lt_gt. assumption. assumption. intro. rewrite H1. apply Zplus_gt_compat_l. assumption. Qed. Lemma Zgt_ge_plus_plus : forall m n p q : Z, (m > n)%Z -> (p >= q)%Z -> (m + p > n + q)%Z. Proof. intros. rewrite Zplus_comm. replace (n + q)%Z with (q + n)%Z. apply Zge_gt_plus_plus. assumption. assumption. apply Zplus_comm. Qed. Lemma Zlt_resp_pos : forall x y : Z, (0 < x)%Z -> (0 < y)%Z -> (0 < x + y)%Z. Proof. intros. rewrite <- Zplus_0_r with 0%Z. apply Zlt_plus_plus; assumption. Qed. Lemma Zle_resp_neg : forall x y : Z, (x <= 0)%Z -> (y <= 0)%Z -> (x + y <= 0)%Z. Proof. intros. rewrite <- Zplus_0_r with 0%Z. apply Zplus_le_compat; assumption. Qed. Lemma Zlt_pos_opp : forall x : Z, (0 < x)%Z -> (- x < 0)%Z. Proof. intros. apply Zplus_lt_reg_l with x. rewrite Zplus_opp_r. rewrite Zplus_0_r. assumption. Qed. Lemma Zlt_neg_opp : forall x : Z, (x < 0)%Z -> (0 < - x)%Z. Proof. intros. apply Zplus_lt_reg_l with x. rewrite Zplus_opp_r. rewrite Zplus_0_r. assumption. Qed. Lemma Zle_neg_opp : forall x : Z, (x <= 0)%Z -> (0 <= - x)%Z. Proof. intros. apply Zplus_le_reg_l with x. rewrite Zplus_opp_r. rewrite Zplus_0_r. assumption. Qed. Lemma Zle_pos_opp : forall x : Z, (0 <= x)%Z -> (- x <= 0)%Z. Proof. intros. apply Zplus_le_reg_l with x. rewrite Zplus_opp_r. rewrite Zplus_0_r. assumption. Qed. Lemma Zge_opp : forall x y : Z, (x <= y)%Z -> (- x >= - y)%Z. Proof. intros. apply Z.le_ge. apply Zplus_le_reg_l with (p := (x + y)%Z). ring_simplify (x + y + - y)%Z (x + y + - x)%Z. assumption. Qed. (* Omega can't solve this *) Lemma Zmult_pos_pos : forall x y : Z, (0 < x)%Z -> (0 < y)%Z -> (0 < x * y)%Z. Proof. intros [| px| px] [| py| py] Hx Hy; trivial || constructor. Qed. Lemma Zmult_neg_neg : forall x y : Z, (x < 0)%Z -> (y < 0)%Z -> (0 < x * y)%Z. Proof. intros [| px| px] [| py| py] Hx Hy; trivial || constructor. Qed. Lemma Zmult_neg_pos : forall x y : Z, (x < 0)%Z -> (0 < y)%Z -> (x * y < 0)%Z. Proof. intros [| px| px] [| py| py] Hx Hy; trivial || constructor. Qed. Lemma Zmult_pos_neg : forall x y : Z, (0 < x)%Z -> (y < 0)%Z -> (x * y < 0)%Z. Proof. intros [| px| px] [| py| py] Hx Hy; trivial || constructor. Qed. Local Hint Resolve Zmult_pos_pos Zmult_neg_neg Zmult_neg_pos Zmult_pos_neg: zarith. Lemma Zle_reg_mult_l : forall x y a : Z, (0 < a)%Z -> (x <= y)%Z -> (a * x <= a * y)%Z. Proof. intros. apply Zplus_le_reg_l with (p := (- a * x)%Z). ring_simplify (- a * x + a * x)%Z. replace (- a * x + a * y)%Z with ((y - x) * a)%Z. apply Zmult_gt_0_le_0_compat. apply Z.lt_gt. assumption. unfold Zminus in |- *. apply Zle_left. assumption. ring. Qed. Lemma Zsimpl_plus_l_dep : forall x y m n : Z, (x + m)%Z = (y + n)%Z -> x = y -> m = n. Proof. intros. apply Zplus_reg_l with x. rewrite <- H0 in H. assumption. Qed. Lemma Zsimpl_plus_r_dep : forall x y m n : Z, (m + x)%Z = (n + y)%Z -> x = y -> m = n. Proof. intros. apply Zplus_reg_l with x. rewrite Zplus_comm. rewrite Zplus_comm with x n. rewrite <- H0 in H. assumption. Qed. Lemma Zmult_simpl : forall n m p q : Z, n = m -> p = q -> (n * p)%Z = (m * q)%Z. Proof. intros. rewrite H. rewrite H0. reflexivity. Qed. Lemma Zsimpl_mult_l : forall n m p : Z, n <> 0%Z -> (n * m)%Z = (n * p)%Z -> m = p. Proof. intros. apply Zplus_reg_l with (n := (- p)%Z). replace (- p + p)%Z with 0%Z. apply Zmult_integral_l with (n := n). assumption. replace ((- p + m) * n)%Z with (n * m + - (n * p))%Z. apply Zegal_left. assumption. ring. ring. Qed. Lemma Zlt_reg_mult_l : forall x y z : Z, (x > 0)%Z -> (y < z)%Z -> (x * y < x * z)%Z. (*QA*) Proof. intros. case (Zcompare_Gt_spec x 0). unfold Z.gt in H. assumption. intros. cut (x = Zpos x0). intro. rewrite H2. unfold Z.lt in H0. unfold Z.lt in |- *. cut ((Zpos x0 * y ?= Zpos x0 * z)%Z = (y ?= z)%Z). intro. exact (trans_eq H3 H0). apply Zcompare_mult_compat. cut (x = (x + - (0))%Z). intro. exact (trans_eq H2 H1). simpl in |- *. apply (sym_eq (A:=Z)). exact (Zplus_0_r x). Qed. Lemma Zlt_opp : forall x y : Z, (x < y)%Z -> (- x > - y)%Z. (*QA*) Proof. intros. red in |- *. apply sym_eq. cut (Datatypes.Gt = (y ?= x)%Z). intro. cut ((y ?= x)%Z = (- x ?= - y)%Z). intro. exact (trans_eq H0 H1). exact (Zcompare_opp y x). apply sym_eq. exact (Z.lt_gt x y H). Qed. Lemma Zlt_conv_mult_l : forall x y z : Z, (x < 0)%Z -> (y < z)%Z -> (x * y > x * z)%Z. (*QA*) Proof. intros. cut (- x > 0)%Z. intro. cut (- x * y < - x * z)%Z. intro. cut (- (- x * y) > - (- x * z))%Z. intro. cut (- - (x * y) > - - (x * z))%Z. intro. cut ((- - (x * y))%Z = (x * y)%Z). intro. rewrite H5 in H4. cut ((- - (x * z))%Z = (x * z)%Z). intro. rewrite H6 in H4. assumption. exact (Z.opp_involutive (x * z)). exact (Z.opp_involutive (x * y)). cut ((- (- x * y))%Z = (- - (x * y))%Z). intro. rewrite H4 in H3. cut ((- (- x * z))%Z = (- - (x * z))%Z). intro. rewrite H5 in H3. assumption. cut ((- x * z)%Z = (- (x * z))%Z). intro. exact (f_equal Z.opp H5). exact (Zopp_mult_distr_l_reverse x z). cut ((- x * y)%Z = (- (x * y))%Z). intro. exact (f_equal Z.opp H4). exact (Zopp_mult_distr_l_reverse x y). exact (Zlt_opp (- x * y) (- x * z) H2). exact (Zlt_reg_mult_l (- x) y z H1 H0). exact (Zlt_opp x 0 H). Qed. Lemma Zgt_not_eq : forall x y : Z, (x > y)%Z -> x <> y. (*QA*) Proof. intros. cut (y < x)%Z. intro. cut (y <> x). intro. red in |- *. intros. cut (y = x). intros. apply H1. assumption. exact (sym_eq H2). exact (Zorder.Zlt_not_eq y x H0). exact (Z.gt_lt x y H). Qed. Lemma Zmult_resp_nonzero : forall x y : Z, x <> 0%Z -> y <> 0%Z -> (x * y)%Z <> 0%Z. Proof. intros x y Hx Hy Hxy. apply Hx. apply Zmult_integral_l with y; assumption. Qed. Lemma Zopp_app : forall y : Z, y <> 0%Z -> (- y)%Z <> 0%Z. Proof. intros. intro. apply H. apply Zplus_reg_l with (- y)%Z. rewrite Zplus_opp_l. rewrite H0. simpl in |- *. reflexivity. Qed. Lemma Zle_neq_Zlt : forall a b : Z, (a <= b)%Z -> b <> a -> (a < b)%Z. Proof. intros a b H H0. case (Z_le_lt_eq_dec _ _ H); trivial. intro; apply False_ind; apply H0; symmetry in |- *; assumption. Qed. Lemma not_Zle_lt : forall x y : Z, ~ (y <= x)%Z -> (x < y)%Z. Proof. intros; apply Z.gt_lt; apply Znot_le_gt; assumption. Qed. Lemma not_Zlt : forall x y : Z, ~ (y < x)%Z -> (x <= y)%Z. Proof. intros x y H1 H2; apply H1; apply Z.gt_lt; assumption. Qed. Lemma Zmult_absorb : forall x y z : Z, x <> 0%Z -> (x * y)%Z = (x * z)%Z -> y = z. (*QA*) Proof. intros. case (dec_eq y z). intro. assumption. intro. case (not_Zeq y z). assumption. intro. case (not_Zeq x 0). assumption. intro. apply False_ind. cut (x * y > x * z)%Z. intro. cut ((x * y)%Z <> (x * z)%Z). intro. apply H5. assumption. exact (Zgt_not_eq (x * y) (x * z) H4). exact (Zlt_conv_mult_l x y z H3 H2). intro. apply False_ind. cut (x * y < x * z)%Z. intro. cut ((x * y)%Z <> (x * z)%Z). intro. apply H5. assumption. exact (Zorder.Zlt_not_eq (x * y) (x * z) H4). cut (x > 0)%Z. intro. exact (Zlt_reg_mult_l x y z H4 H2). exact (Z.lt_gt 0 x H3). intro. apply False_ind. cut (x * z < x * y)%Z. intro. cut ((x * z)%Z <> (x * y)%Z). intro. apply H4. apply (sym_eq (A:=Z)). assumption. exact (Zorder.Zlt_not_eq (x * z) (x * y) H3). apply False_ind. case (not_Zeq x 0). assumption. intro. cut (x * z > x * y)%Z. intro. cut ((x * z)%Z <> (x * y)%Z). intro. apply H5. apply (sym_eq (A:=Z)). assumption. exact (Zgt_not_eq (x * z) (x * y) H4). exact (Zlt_conv_mult_l x z y H3 H2). intro. cut (x * z < x * y)%Z. intro. cut ((x * z)%Z <> (x * y)%Z). intro. apply H5. apply (sym_eq (A:=Z)). assumption. exact (Zorder.Zlt_not_eq (x * z) (x * y) H4). cut (x > 0)%Z. intro. exact (Zlt_reg_mult_l x z y H4 H2). exact (Z.lt_gt 0 x H3). Qed. Lemma Zlt_mult_mult : forall a b c d : Z, (0 < a)%Z -> (0 < d)%Z -> (a < b)%Z -> (c < d)%Z -> (a * c < b * d)%Z. Proof. intros. apply Z.lt_trans with (a * d)%Z. apply Zlt_reg_mult_l. Flip. assumption. rewrite Zmult_comm. rewrite Zmult_comm with b d. apply Zlt_reg_mult_l. Flip. assumption. Qed. Lemma Zgt_mult_conv_absorb_l : forall a x y : Z, (a < 0)%Z -> (a * x > a * y)%Z -> (x < y)%Z. (*QC*) Proof. intros. case (dec_eq x y). intro. apply False_ind. rewrite H1 in H0. cut ((a * y)%Z = (a * y)%Z). change ((a * y)%Z <> (a * y)%Z) in |- *. apply Zgt_not_eq. assumption. trivial. intro. case (not_Zeq x y H1). trivial. intro. apply False_ind. cut (a * y > a * x)%Z. apply Zgt_asym with (m := (a * y)%Z) (n := (a * x)%Z). assumption. apply Zlt_conv_mult_l. assumption. assumption. Qed. Lemma Zgt_mult_reg_absorb_l : forall a x y : Z, (a > 0)%Z -> (a * x > a * y)%Z -> (x > y)%Z. (*QC*) Proof. intros. cut (- - a > - - (0))%Z. intro. cut (- a < - (0))%Z. simpl in |- *. intro. replace x with (- - x)%Z. replace y with (- - y)%Z. apply Zlt_opp. apply Zgt_mult_conv_absorb_l with (a := (- a)%Z) (x := (- x)%Z). assumption. rewrite Zmult_opp_opp. rewrite Zmult_opp_opp. assumption. apply Z.opp_involutive. apply Z.opp_involutive. apply Z.gt_lt. apply Zlt_opp. apply Z.gt_lt. assumption. simpl in |- *. rewrite Z.opp_involutive. assumption. Qed. Lemma Zopp_Zlt : forall x y : Z, (y < x)%Z -> (- x < - y)%Z. Proof. intros x y Hyx. apply Zgt_mult_conv_absorb_l with (a := (-1)%Z). constructor. replace (-1 * - y)%Z with y. replace (-1 * - x)%Z with x. Flip. ring. ring. Qed. Lemma Zmin_cancel_Zlt : forall x y : Z, (- x < - y)%Z -> (y < x)%Z. Proof. intros. apply Zgt_mult_conv_absorb_l with (a := (-1)%Z). constructor. replace (-1 * y)%Z with (- y)%Z. replace (-1 * x)%Z with (- x)%Z. apply Z.lt_gt. assumption. ring. ring. Qed. Lemma Zmult_cancel_Zle : forall a x y : Z, (a < 0)%Z -> (a * x <= a * y)%Z -> (y <= x)%Z. Proof. intros. case (Z_le_gt_dec y x). trivial. intro. apply False_ind. apply (Z.lt_irrefl (a * x)). apply Z.le_lt_trans with (m := (a * y)%Z). assumption. apply Z.gt_lt. apply Zlt_conv_mult_l. assumption. apply Z.gt_lt. assumption. Qed. Lemma Zlt_mult_cancel_l : forall x y z : Z, (0 < x)%Z -> (x * y < x * z)%Z -> (y < z)%Z. Proof. intros. apply Z.gt_lt. apply Zgt_mult_reg_absorb_l with x. apply Z.lt_gt. assumption. apply Z.lt_gt. assumption. Qed. Lemma Zmin_cancel_Zle : forall x y : Z, (- x <= - y)%Z -> (y <= x)%Z. Proof. intros. apply Zmult_cancel_Zle with (a := (-1)%Z). constructor. replace (-1 * y)%Z with (- y)%Z. replace (-1 * x)%Z with (- x)%Z. assumption. ring. ring. Qed. Lemma Zmult_resp_Zle : forall a x y : Z, (0 < a)%Z -> (a * y <= a * x)%Z -> (y <= x)%Z. Proof. intros. case (Z_le_gt_dec y x). trivial. intro. apply False_ind. apply (Z.lt_irrefl (a * y)). apply Z.le_lt_trans with (m := (a * x)%Z). assumption. apply Zlt_reg_mult_l. apply Z.lt_gt. assumption. apply Z.gt_lt. assumption. Qed. Lemma Zopp_Zle : forall x y : Z, (y <= x)%Z -> (- x <= - y)%Z. Proof. intros. apply Zmult_cancel_Zle with (a := (-1)%Z). constructor. replace (-1 * - y)%Z with y. replace (-1 * - x)%Z with x. assumption. clear y H; ring. clear x H; ring. Qed. Lemma Zle_lt_eq_S : forall x y : Z, (x <= y)%Z -> (y < x + 1)%Z -> y = x. Proof. intros. case (Z_le_lt_eq_dec x y H). intro H1. apply False_ind. generalize (Zlt_le_succ x y H1). intro. apply (Zlt_not_le y (x + 1) H0). replace (x + 1)%Z with (Z.succ x). assumption. reflexivity. intro H1. symmetry in |- *. assumption. Qed. Lemma Zlt_le_eq_S : forall x y : Z, (x < y)%Z -> (y <= x + 1)%Z -> y = (x + 1)%Z. Proof. intros. case (Z_le_lt_eq_dec y (x + 1) H0). intro H1. apply False_ind. generalize (Zlt_le_succ x y H). intro. apply (Zlt_not_le y (x + 1) H1). replace (x + 1)%Z with (Z.succ x). assumption. reflexivity. trivial. Qed. Lemma double_not_equal_zero : forall c d : Z, ~ (c = 0%Z /\ d = 0%Z) -> c <> d \/ c <> 0%Z. Proof. intros. case (Z_zerop c). intro. rewrite e. left. apply sym_not_eq. intro. apply H; repeat split; assumption. intro; right; assumption. Qed. Lemma triple_not_equal_zero : forall a b c : Z, ~ (a = 0%Z /\ b = 0%Z /\ c = 0%Z) -> a <> 0%Z \/ b <> 0%Z \/ c <> 0%Z. Proof. intros a b c H; case (Z_zerop a); intro Ha; [ case (Z_zerop b); intro Hb; [ case (Z_zerop c); intro Hc; [ apply False_ind; apply H; repeat split | right; right ] | right; left ] | left ]; assumption. Qed. Lemma mediant_1 : forall m n m' n' : Z, (m' * n < m * n')%Z -> ((m + m') * n < m * (n + n'))%Z. Proof. intros. rewrite Zmult_plus_distr_r. rewrite Zmult_plus_distr_l. apply Zplus_lt_compat_l. assumption. Qed. Lemma mediant_2 : forall m n m' n' : Z, (m' * n < m * n')%Z -> (m' * (n + n') < (m + m') * n')%Z. Proof. intros. rewrite Zmult_plus_distr_l. rewrite Zmult_plus_distr_r. apply Zplus_lt_compat_r. assumption. Qed. Lemma mediant_3 : forall a b m n m' n' : Z, (0 <= a * m + b * n)%Z -> (0 <= a * m' + b * n')%Z -> (0 <= a * (m + m') + b * (n + n'))%Z. Proof. intros. replace (a * (m + m') + b * (n + n'))%Z with (a * m + b * n + (a * m' + b * n'))%Z. apply Zplus_le_0_compat. assumption. assumption. ring. Qed. Lemma fraction_lt_trans : forall a b c d e f : Z, (0 < b)%Z -> (0 < d)%Z -> (0 < f)%Z -> (a * d < c * b)%Z -> (c * f < e * d)%Z -> (a * f < e * b)%Z. Proof. intros. apply Z.gt_lt. apply Zgt_mult_reg_absorb_l with d. Flip. apply Zgt_trans with (c * b * f)%Z. replace (d * (e * b))%Z with (b * (e * d))%Z. replace (c * b * f)%Z with (b * (c * f))%Z. apply Z.lt_gt. apply Zlt_reg_mult_l. Flip. assumption. ring. ring. replace (c * b * f)%Z with (f * (c * b))%Z. replace (d * (a * f))%Z with (f * (a * d))%Z. apply Z.lt_gt. apply Zlt_reg_mult_l. Flip. assumption. ring. ring. Qed. Lemma square_pos : forall a : Z, a <> 0%Z -> (0 < a * a)%Z. Proof. intros [| p| p]; intros; [ Falsum | constructor | constructor ]. Qed. Local Hint Resolve square_pos: zarith. (*###########################################################################*) (** Properties of positive numbers, mapping between Z and nat *) (*###########################################################################*) Definition Z2positive (z : Z) := match z with | Zpos p => p | Zneg p => p | Z0 => 1%positive end. Lemma ZL9 : forall p : positive, Z_of_nat (nat_of_P p) = Zpos p. (*QF*) Proof. intro. cut (exists h : nat, nat_of_P p = S h). intro. case H. intros. unfold Z_of_nat in |- *. rewrite H0. apply f_equal with (A := positive) (B := Z) (f := Zpos). cut (P_of_succ_nat (nat_of_P p) = P_of_succ_nat (S x)). intro. rewrite P_of_succ_nat_o_nat_of_P_eq_succ in H1. cut (Pos.pred (Pos.succ p) = Pos.pred (P_of_succ_nat (S x))). intro. rewrite Pos.pred_succ in H2. simpl in H2. rewrite Pos.pred_succ in H2. apply sym_eq. assumption. apply f_equal with (A := positive) (B := positive) (f := Pos.pred). assumption. apply f_equal with (f := P_of_succ_nat). assumption. apply ZL4. Qed. Coercion Z_of_nat : nat >-> Z. Lemma ZERO_lt_POS : forall p : positive, (0 < Zpos p)%Z. Proof. intros. constructor. Qed. Lemma POS_neq_ZERO : forall p : positive, Zpos p <> 0%Z. Proof. intros. apply sym_not_eq. apply Zorder.Zlt_not_eq. apply ZERO_lt_POS. Qed. Lemma NEG_neq_ZERO : forall p : positive, Zneg p <> 0%Z. Proof. intros. apply Zorder.Zlt_not_eq. unfold Z.lt in |- *. constructor. Qed. Lemma POS_resp_eq : forall p0 p1 : positive, Zpos p0 = Zpos p1 -> p0 = p1. Proof. intros. injection H. trivial. Qed. Lemma nat_nat_pos : forall m n : nat, ((m + 1) * (n + 1) > 0)%Z. (*QF*) Proof. intros. apply Z.lt_gt. cut (Z_of_nat m + 1 > 0)%Z. intro. cut (0 < Z_of_nat n + 1)%Z. intro. cut ((Z_of_nat m + 1) * 0 < (Z_of_nat m + 1) * (Z_of_nat n + 1))%Z. rewrite Zmult_0_r. intro. assumption. apply Zlt_reg_mult_l. assumption. assumption. change (0 < Z.succ (Z_of_nat n))%Z in |- *. apply Zle_lt_succ. change (Z_of_nat 0 <= Z_of_nat n)%Z in |- *. apply Znat.inj_le. apply Nat.le_0_l. apply Z.lt_gt. change (0 < Z.succ (Z_of_nat m))%Z in |- *. apply Zle_lt_succ. change (Z_of_nat 0 <= Z_of_nat m)%Z in |- *. apply Znat.inj_le. apply Nat.le_0_l. Qed. Theorem S_predn : forall m : nat, m <> 0 -> S (pred m) = m. (*QF*) Proof. intros. case (O_or_S m). intro. case s. intros. rewrite <- e. rewrite <- pred_Sn with (n := x). trivial. intro. apply False_ind. apply H. apply sym_eq. assumption. Qed. Lemma absolu_1 : forall x : Z, Z.abs_nat x = 0 -> x = 0%Z. (*QF*) Proof. intros. case (dec_eq x 0). intro. assumption. intro. apply False_ind. cut ((x < 0)%Z \/ (x > 0)%Z). intro. ElimCompare x 0%Z. intro. cut (x = 0%Z). assumption. cut ((x ?= 0)%Z = Datatypes.Eq -> x = 0%Z). intro. apply H3. assumption. apply proj1 with (B := x = 0%Z -> (x ?= 0)%Z = Datatypes.Eq). change ((x ?= 0)%Z = Datatypes.Eq <-> x = 0%Z) in |- *. apply Zcompare_Eq_iff_eq. (***) intro. cut (exists h : nat, Z.abs_nat x = S h). intro. case H3. rewrite H. exact O_S. change (x < 0)%Z in H2. cut (0 > x)%Z. intro. cut (exists p : positive, (0 + - x)%Z = Zpos p). simpl in |- *. intro. case H4. intros. cut (exists q : positive, x = Zneg q). intro. case H6. intros. rewrite H7. unfold Z.abs_nat in |- *. generalize x1. exact ZL4. cut (x = (- Zpos x0)%Z). simpl in |- *. intro. exists x0. assumption. cut ((- - x)%Z = x). intro. rewrite <- H6. exact (f_equal Z.opp H5). apply Z.opp_involutive. apply Zcompare_Gt_spec. assumption. apply Z.lt_gt. assumption. (***) intro. cut (exists h : nat, Z.abs_nat x = S h). intro. case H3. rewrite H. exact O_S. cut (exists p : positive, (x + - (0))%Z = Zpos p). simpl in |- *. rewrite Zplus_0_r. intro. case H3. intros. rewrite H4. unfold Z.abs_nat in |- *. generalize x0. exact ZL4. apply Zcompare_Gt_spec. assumption. (***) cut ((x < 0)%Z \/ (0 < x)%Z). intro. apply or_ind with (A := (x < 0)%Z) (B := (0 < x)%Z) (P := (x < 0)%Z \/ (x > 0)%Z). intro. left. assumption. intro. right. apply Z.lt_gt. assumption. assumption. apply not_Zeq. assumption. Qed. Lemma absolu_2 : forall x : Z, x <> 0%Z -> Z.abs_nat x <> 0. (*QF*) Proof. intros. intro. apply H. apply absolu_1. assumption. Qed. Lemma absolu_inject_nat : forall n : nat, Z.abs_nat (Z_of_nat n) = n. Proof. simple induction n; simpl in |- *. reflexivity. intros. apply nat_of_P_o_P_of_succ_nat_eq_succ. Qed. Lemma eq_inj : forall m n : nat, m = n :>Z -> m = n. Proof. intros. generalize (f_equal Z.abs_nat H). intro. rewrite (absolu_inject_nat m) in H0. rewrite (absolu_inject_nat n) in H0. assumption. Qed. Lemma lt_inj : forall m n : nat, (m < n)%Z -> m < n. Proof. intros. lia. Qed. Lemma le_inj : forall m n : nat, (m <= n)%Z -> m <= n. Proof. intros. lia. Qed. Lemma inject_nat_S_inf : forall x : Z, (0 < x)%Z -> {n : nat | x = S n}. Proof. intros [| p| p] Hp; try discriminate Hp. exists (pred (nat_of_P p)). rewrite S_predn. symmetry in |- *; apply ZL9. clear Hp; apply Nat.neq_0_lt_0, lt_O_nat_of_P. Qed. Lemma le_absolu : forall x y : Z, (0 <= x)%Z -> (0 <= y)%Z -> (x <= y)%Z -> Z.abs_nat x <= Z.abs_nat y. Proof. intros [| x| x] [| y| y] Hx Hy Hxy; apply Nat.le_0_l || (try match goal with | id1:(0 <= Zneg _)%Z |- _ => apply False_ind; apply id1; constructor | id1:(Zpos _ <= 0)%Z |- _ => apply False_ind; apply id1; constructor | id1:(Zpos _ <= Zneg _)%Z |- _ => apply False_ind; apply id1; constructor end). simpl in |- *. apply le_inj. do 2 rewrite ZL9. assumption. Qed. Lemma lt_absolu : forall x y : Z, (0 <= x)%Z -> (0 <= y)%Z -> (x < y)%Z -> Z.abs_nat x < Z.abs_nat y. Proof. intros [| x| x] [| y| y] Hx Hy Hxy; inversion Hxy; try match goal with | id1:(0 <= Zneg _)%Z |- _ => apply False_ind; apply id1; constructor | id1:(Zpos _ <= 0)%Z |- _ => apply False_ind; apply id1; constructor | id1:(Zpos _ <= Zneg _)%Z |- _ => apply False_ind; apply id1; constructor end; simpl in |- *; apply lt_inj; repeat rewrite ZL9; assumption. Qed. Lemma absolu_plus : forall x y : Z, (0 <= x)%Z -> (0 <= y)%Z -> Z.abs_nat (x + y) = Z.abs_nat x + Z.abs_nat y. Proof. intros [| x| x] [| y| y] Hx Hy; trivial; try match goal with | id1:(0 <= Zneg _)%Z |- _ => apply False_ind; apply id1; constructor | id1:(Zpos _ <= 0)%Z |- _ => apply False_ind; apply id1; constructor | id1:(Zpos _ <= Zneg _)%Z |- _ => apply False_ind; apply id1; constructor end. rewrite <- BinInt.Zpos_plus_distr. unfold Z.abs_nat in |- *. apply nat_of_P_plus_morphism. Qed. Lemma pred_absolu : forall x : Z, (0 < x)%Z -> pred (Z.abs_nat x) = Z.abs_nat (x - 1). Proof. intros x Hx. generalize (Z_lt_lt_S_eq_dec 0 x Hx); simpl in |- *; intros [H1| H1]; [ replace (Z.abs_nat x) with (Z.abs_nat (x - 1 + 1)); [ idtac | apply f_equal with Z; auto with zarith ]; rewrite absolu_plus; [ unfold Z.abs_nat at 2, nat_of_P, Pos.iter_op in |- *; lia | auto with zarith | intro; discriminate ] | rewrite <- H1; reflexivity ]. Qed. Definition pred_nat : forall (x : Z) (Hx : (0 < x)%Z), nat. intros [| px| px] Hx; try abstract (discriminate Hx). exact (pred (nat_of_P px)). Defined. Lemma pred_nat_equal : forall (x : Z) (Hx1 Hx2 : (0 < x)%Z), pred_nat x Hx1 = pred_nat x Hx2. Proof. intros [| px| px] Hx1 Hx2; try (discriminate Hx1); trivial. Qed. #[local] Definition pred_nat_unfolded_subproof px : Pos.to_nat px <> 0. Proof. apply Nat.neq_0_lt_0, lt_O_nat_of_P. Qed. Lemma pred_nat_unfolded : forall (x : Z) (Hx : (0 < x)%Z), x = S (pred_nat x Hx). Proof. intros [| px| px] Hx; try discriminate Hx. unfold pred_nat in |- *. rewrite S_predn. symmetry in |- *; apply ZL9. clear Hx; apply pred_nat_unfolded_subproof. Qed. Lemma absolu_pred_nat : forall (m : Z) (Hm : (0 < m)%Z), S (pred_nat m Hm) = Z.abs_nat m. Proof. intros [| px| px] Hx; try discriminate Hx. unfold pred_nat in |- *. rewrite S_predn. reflexivity. apply pred_nat_unfolded_subproof. Qed. Lemma pred_nat_absolu : forall (m : Z) (Hm : (0 < m)%Z), pred_nat m Hm = Z.abs_nat (m - 1). Proof. intros [| px| px] Hx; try discriminate Hx. unfold pred_nat in |- *. rewrite <- pred_absolu; reflexivity || assumption. Qed. Lemma minus_pred_nat : forall (n m : Z) (Hn : (0 < n)%Z) (Hm : (0 < m)%Z) (Hnm : (0 < n - m)%Z), S (pred_nat n Hn) - S (pred_nat m Hm) = S (pred_nat (n - m) Hnm). Proof. intros. simpl in |- *. destruct n; try discriminate Hn. destruct m; try discriminate Hm. unfold pred_nat at 1 2 in |- *. rewrite minus_pred; try apply lt_O_nat_of_P. apply eq_inj. rewrite <- pred_nat_unfolded. rewrite Znat.inj_minus1. repeat rewrite ZL9. reflexivity. apply le_inj. apply Zlt_le_weak. repeat rewrite ZL9. apply Zlt_O_minus_lt. assumption. Qed. (*###########################################################################*) (** Properties of Zsgn *) (*###########################################################################*) Lemma Zsgn_1 : forall x : Z, {Z.sgn x = 0%Z} + {Z.sgn x = 1%Z} + {Z.sgn x = (-1)%Z}. (*QF*) Proof. intros. case x. left. left. unfold Z.sgn in |- *. reflexivity. intro. simpl in |- *. left. right. reflexivity. intro. right. simpl in |- *. reflexivity. Qed. Lemma Zsgn_2 : forall x : Z, Z.sgn x = 0%Z -> x = 0%Z. (*QF*) Proof. intros [| p1| p1]; simpl in |- *; intro H; constructor || discriminate H. Qed. Lemma Zsgn_3 : forall x : Z, x <> 0%Z -> Z.sgn x <> 0%Z. (*QF*) Proof. intro. case x. intros. apply False_ind. apply H. reflexivity. intros. simpl in |- *. discriminate. intros. simpl in |- *. discriminate. Qed. Theorem Zsgn_4 : forall a : Z, a = (Z.sgn a * Z.abs_nat a)%Z. (*QF*) Proof. intro. case a. simpl in |- *. reflexivity. intro. unfold Z.sgn in |- *. unfold Z.abs_nat in |- *. rewrite Zmult_1_l. symmetry in |- *. apply ZL9. intros. unfold Z.sgn in |- *. unfold Z.abs_nat in |- *. rewrite ZL9. constructor. Qed. Theorem Zsgn_5 : forall a b x y : Z, x <> 0%Z -> y <> 0%Z -> (Z.sgn a * x)%Z = (Z.sgn b * y)%Z -> (Z.sgn a * y)%Z = (Z.sgn b * x)%Z. (*QF*) Proof. intros a b x y H H0. case a. case b. simpl in |- *. trivial. intro. unfold Z.sgn in |- *. intro. rewrite Zmult_1_l in H1. simpl in H1. apply False_ind. apply H0. symmetry in |- *. assumption. intro. unfold Z.sgn in |- *. intro. apply False_ind. apply H0. apply Z.opp_inj. simpl in |- *. transitivity (-1 * y)%Z. constructor. transitivity (0 * x)%Z. symmetry in |- *. assumption. simpl in |- *. reflexivity. intro. unfold Z.sgn at 1 in |- *. unfold Z.sgn at 2 in |- *. intro. transitivity y. rewrite Zmult_1_l. reflexivity. transitivity (Z.sgn b * (Z.sgn b * y))%Z. case (Zsgn_1 b). intro. case s. intro. apply False_ind. apply H. rewrite e in H1. change ((1 * x)%Z = 0%Z) in H1. rewrite Zmult_1_l in H1. assumption. intro. rewrite e. rewrite Zmult_1_l. rewrite Zmult_1_l. reflexivity. intro. rewrite e. ring. rewrite Zmult_1_l in H1. rewrite H1. reflexivity. intro. unfold Z.sgn at 1 in |- *. unfold Z.sgn at 2 in |- *. intro. transitivity (Z.sgn b * (-1 * (Z.sgn b * y)))%Z. case (Zsgn_1 b). intros. case s. intro. apply False_ind. apply H. apply Z.opp_inj. transitivity (-1 * x)%Z. ring. unfold Z.opp in |- *. rewrite e in H1. transitivity (0 * y)%Z. assumption. simpl in |- *. reflexivity. intro. rewrite e. ring. intro. rewrite e. ring. rewrite <- H1. ring. Qed. Lemma Zsgn_6 : forall x : Z, x = 0%Z -> Z.sgn x = 0%Z. Proof. intros. rewrite H. simpl in |- *. reflexivity. Qed. Lemma Zsgn_7 : forall x : Z, (x > 0)%Z -> Z.sgn x = 1%Z. Proof. intro. case x. intro. apply False_ind. apply (Z.lt_irrefl 0). Flip. intros. simpl in |- *. reflexivity. intros. apply False_ind. apply (Z.lt_irrefl (Zneg p)). apply Z.lt_trans with 0%Z. constructor. Flip. Qed. Lemma Zsgn_7' : forall x : Z, (0 < x)%Z -> Z.sgn x = 1%Z. Proof. intros; apply Zsgn_7; Flip. Qed. Lemma Zsgn_8 : forall x : Z, (x < 0)%Z -> Z.sgn x = (-1)%Z. Proof. intro. case x. intro. apply False_ind. apply (Z.lt_irrefl 0). assumption. intros. apply False_ind. apply (Z.lt_irrefl 0). apply Z.lt_trans with (Zpos p). constructor. assumption. intros. simpl in |- *. reflexivity. Qed. Lemma Zsgn_9 : forall x : Z, Z.sgn x = 1%Z -> (0 < x)%Z. Proof. intro. case x. intro. apply False_ind. simpl in H. discriminate. intros. constructor. intros. apply False_ind. discriminate. Qed. Lemma Zsgn_10 : forall x : Z, Z.sgn x = (-1)%Z -> (x < 0)%Z. Proof. intro. case x. intro. apply False_ind. discriminate. intros. apply False_ind. discriminate. intros. constructor. Qed. Lemma Zsgn_11 : forall x : Z, (Z.sgn x < 0)%Z -> (x < 0)%Z. Proof. intros. apply Zsgn_10. case (Zsgn_1 x). intro. apply False_ind. case s. intro. generalize (Zorder.Zlt_not_eq _ _ H). intro. apply (H0 e). intro. rewrite e in H. generalize (Zorder.Zlt_not_eq _ _ H). intro. discriminate. trivial. Qed. Lemma Zsgn_12 : forall x : Z, (0 < Z.sgn x)%Z -> (0 < x)%Z. Proof. intros. apply Zsgn_9. case (Zsgn_1 x). intro. case s. intro. generalize (Zorder.Zlt_not_eq _ _ H). intro. generalize (sym_eq e). intro. apply False_ind. apply (H0 H1). trivial. intro. rewrite e in H. generalize (Zorder.Zlt_not_eq _ _ H). intro. apply False_ind. discriminate. Qed. Lemma Zsgn_13 : forall x : Z, (0 <= Z.sgn x)%Z -> (0 <= x)%Z. Proof. intros. case (Z_le_lt_eq_dec 0 (Z.sgn x) H). intro. apply Zlt_le_weak. apply Zsgn_12. assumption. intro. assert (x = 0%Z). apply Zsgn_2. symmetry in |- *. assumption. rewrite H0. apply Z.le_refl. Qed. Lemma Zsgn_14 : forall x : Z, (Z.sgn x <= 0)%Z -> (x <= 0)%Z. Proof. intros. case (Z_le_lt_eq_dec (Z.sgn x) 0 H). intro. apply Zlt_le_weak. apply Zsgn_11. assumption. intro. assert (x = 0%Z). apply Zsgn_2. assumption. rewrite H0. apply Z.le_refl. Qed. Lemma Zsgn_15 : forall x y : Z, Z.sgn (x * y) = (Z.sgn x * Z.sgn y)%Z. Proof. intros [|p1|p1]; [intros y|intros [|p2|p2] ..]; simpl in |- *; constructor. Qed. Lemma Zsgn_16 : forall x y : Z, Z.sgn (x * y) = 1%Z -> {(0 < x)%Z /\ (0 < y)%Z} + {(x < 0)%Z /\ (y < 0)%Z}. Proof. intros [|p1|p1]; [intros y|intros [|p2|p2] ..]; simpl in |- *; intro H; try discriminate H; [ left | right ]; repeat split. Qed. Lemma Zsgn_17 : forall x y : Z, Z.sgn (x * y) = (-1)%Z -> {(0 < x)%Z /\ (y < 0)%Z} + {(x < 0)%Z /\ (0 < y)%Z}. Proof. intros [|p1|p1]; [intros y|intros [|p2|p2] ..]; simpl in |- *; intro H; try discriminate H; [ left | right ]; repeat split. Qed. Lemma Zsgn_18 : forall x y : Z, Z.sgn (x * y) = 0%Z -> {x = 0%Z} + {y = 0%Z}. Proof. intros [|p1|p1]; [intros y|intros [|p2|p2] ..]; simpl in |- *; intro H; try discriminate H; [ left | right | right ]; constructor. Qed. Lemma Zsgn_19 : forall x y : Z, (0 < Z.sgn x + Z.sgn y)%Z -> (0 < x + y)%Z. Proof. Proof. intros [|p1|p1]; [intros y|intros [|p2|p2] ..]; simpl in |- *; intro H; discriminate H || (constructor || apply Zsgn_12; assumption). Qed. Lemma Zsgn_20 : forall x y : Z, (Z.sgn x + Z.sgn y < 0)%Z -> (x + y < 0)%Z. Proof. Proof. intros [|p1|p1]; [intros y|intros [|p2|p2] ..]; simpl in |- *; intro H; discriminate H || (constructor || apply Zsgn_11; assumption). Qed. Lemma Zsgn_21 : forall x y : Z, (0 < Z.sgn x + Z.sgn y)%Z -> (0 <= x)%Z. Proof. intros [|p1|p1]; [intros y|intros [|p2|p2] ..]; simpl in |- *; intros H H0; discriminate H || discriminate H0. Qed. Lemma Zsgn_22 : forall x y : Z, (Z.sgn x + Z.sgn y < 0)%Z -> (x <= 0)%Z. Proof. Proof. intros [|p1|p1]; [intros y|intros [|p2|p2] ..]; simpl in |- *; intros H H0; discriminate H || discriminate H0. Qed. Lemma Zsgn_23 : forall x y : Z, (0 < Z.sgn x + Z.sgn y)%Z -> (0 <= y)%Z. Proof. intros [|p1|p1] [|p2|p2]; simpl in |- *; intros H H0; discriminate H || discriminate H0. Qed. Lemma Zsgn_24 : forall x y : Z, (Z.sgn x + Z.sgn y < 0)%Z -> (y <= 0)%Z. Proof. intros [|p1|p1] [|p2|p2]; simpl in |- *; intros H H0; discriminate H || discriminate H0. Qed. Lemma Zsgn_25 : forall x : Z, Z.sgn (- x) = (- Z.sgn x)%Z. Proof. intros [| p1| p1]; simpl in |- *; reflexivity. Qed. Lemma Zsgn_26 : forall x : Z, (0 < x)%Z -> (0 < Z.sgn x)%Z. Proof. intros [| p| p] Hp; trivial. Qed. Lemma Zsgn_27 : forall x : Z, (x < 0)%Z -> (Z.sgn x < 0)%Z. Proof. intros [| p| p] Hp; trivial. Qed. Local Hint Resolve Zsgn_1 Zsgn_2 Zsgn_3 Zsgn_4 Zsgn_5 Zsgn_6 Zsgn_7 Zsgn_7' Zsgn_8 Zsgn_9 Zsgn_10 Zsgn_11 Zsgn_12 Zsgn_13 Zsgn_14 Zsgn_15 Zsgn_16 Zsgn_17 Zsgn_18 Zsgn_19 Zsgn_20 Zsgn_21 Zsgn_22 Zsgn_23 Zsgn_24 Zsgn_25 Zsgn_26 Zsgn_27: zarith. (*###########################################################################*) (** Properties of Zabs *) (*###########################################################################*) Lemma Zabs_1 : forall z p : Z, (Z.abs z < p)%Z -> (z < p)%Z /\ (- p < z)%Z. Proof. intros z p. case z. intros. simpl in H. split. assumption. apply Zgt_mult_conv_absorb_l with (a := (-1)%Z). replace (-1)%Z with (Z.pred 0). apply Zlt_pred. simpl; trivial. ring_simplify (-1 * - p)%Z (-1 * 0)%Z. apply Z.lt_gt. assumption. intros. simpl in H. split. assumption. apply Z.lt_trans with (m := 0%Z). apply Zgt_mult_conv_absorb_l with (a := (-1)%Z). replace (-1)%Z with (Z.pred 0). apply Zlt_pred. simpl; trivial. ring_simplify (-1 * - p)%Z (-1 * 0)%Z. apply Z.lt_gt. apply Z.lt_trans with (m := Zpos p0). constructor. assumption. constructor. intros. simpl in H. split. apply Z.lt_trans with (m := Zpos p0). constructor. assumption. apply Zgt_mult_conv_absorb_l with (a := (-1)%Z). replace (-1)%Z with (Z.pred 0). apply Zlt_pred. simpl;trivial. ring_simplify (-1 * - p)%Z. replace (-1 * Zneg p0)%Z with (- Zneg p0)%Z. replace (- Zneg p0)%Z with (Zpos p0). apply Z.lt_gt. assumption. symmetry in |- *. apply Zopp_neg. rewrite Zopp_mult_distr_l_reverse with (n := 1%Z). simpl in |- *. constructor. Qed. Lemma Zabs_2 : forall z p : Z, (Z.abs z > p)%Z -> (z > p)%Z \/ (- p > z)%Z. Proof. intros z p. case z. intros. simpl in H. left. assumption. intros. simpl in H. left. assumption. intros. simpl in H. right. apply Z.lt_gt. apply Zgt_mult_conv_absorb_l with (a := (-1)%Z). constructor. ring_simplify (-1 * - p)%Z. replace (-1 * Zneg p0)%Z with (Zpos p0). assumption. reflexivity. Qed. Lemma Zabs_3 : forall z p : Z, (z < p)%Z /\ (- p < z)%Z -> (Z.abs z < p)%Z. Proof. intros z p. case z. intro. simpl in |- *. elim H. intros. assumption. intros. elim H. intros. simpl in |- *. assumption. intros. elim H. intros. simpl in |- *. apply Zgt_mult_conv_absorb_l with (a := (-1)%Z). constructor. replace (-1 * Zpos p0)%Z with (Zneg p0). replace (-1 * p)%Z with (- p)%Z. apply Z.lt_gt. assumption. ring. simpl in |- *. reflexivity. Qed. Lemma Zabs_4 : forall z p : Z, (Z.abs z < p)%Z -> (- p < z < p)%Z. Proof. intros. split. apply proj2 with (A := (z < p)%Z). apply Zabs_1. assumption. apply proj1 with (B := (- p < z)%Z). apply Zabs_1. assumption. Qed. Lemma Zabs_5 : forall z p : Z, (Z.abs z <= p)%Z -> (- p <= z <= p)%Z. Proof. intros. split. replace (- p)%Z with (Z.succ (- Z.succ p)). apply Zlt_le_succ. apply proj2 with (A := (z < Z.succ p)%Z). apply Zabs_1. apply Zle_lt_succ. assumption. unfold Z.succ in |- *. ring. apply Zlt_succ_le. apply proj1 with (B := (- Z.succ p < z)%Z). apply Zabs_1. apply Zle_lt_succ. assumption. Qed. Lemma Zabs_6 : forall z p : Z, (Z.abs z <= p)%Z -> (z <= p)%Z. Proof. intros. apply proj2 with (A := (- p <= z)%Z). apply Zabs_5. assumption. Qed. Lemma Zabs_7 : forall z p : Z, (Z.abs z <= p)%Z -> (- p <= z)%Z. Proof. intros. apply proj1 with (B := (z <= p)%Z). apply Zabs_5. assumption. Qed. Lemma Zabs_8 : forall z p : Z, (- p <= z <= p)%Z -> (Z.abs z <= p)%Z. Proof. intros. apply Zlt_succ_le. apply Zabs_3. elim H. intros. split. apply Zle_lt_succ. assumption. apply Z.lt_le_trans with (m := (- p)%Z). apply Z.gt_lt. apply Zlt_opp. apply Zlt_succ. assumption. Qed. Lemma Zabs_min : forall z : Z, Z.abs z = Z.abs (- z). Proof. intro. case z. simpl in |- *. reflexivity. intro. simpl in |- *. reflexivity. intro. simpl in |- *. reflexivity. Qed. Lemma Zabs_9 : forall z p : Z, (0 <= p)%Z -> (p < z)%Z \/ (z < - p)%Z -> (p < Z.abs z)%Z. Proof. intros. case H0. intro. replace (Z.abs z) with z. assumption. symmetry in |- *. apply Z.abs_eq. apply Zlt_le_weak. apply Z.le_lt_trans with (m := p). assumption. assumption. intro. cut (Z.abs z = (- z)%Z). intro. rewrite H2. apply Zmin_cancel_Zlt. ring_simplify (- - z)%Z. assumption. rewrite Zabs_min. apply Z.abs_eq. apply Zlt_le_weak. apply Z.le_lt_trans with (m := p). assumption. apply Zmin_cancel_Zlt. ring_simplify (- - z)%Z. assumption. Qed. Lemma Zabs_10 : forall z : Z, (0 <= Z.abs z)%Z. Proof. intro. case (Z_zerop z). intro. rewrite e. simpl in |- *. apply Z.le_refl. intro. case (not_Zeq z 0 n). intro. apply Zlt_le_weak. apply Zabs_9. apply Z.le_refl. simpl in |- *. right. assumption. intro. apply Zlt_le_weak. apply Zabs_9. apply Z.le_refl. simpl in |- *. left. assumption. Qed. Lemma Zabs_11 : forall z : Z, z <> 0%Z -> (0 < Z.abs z)%Z. Proof. intros. apply Zabs_9. apply Z.le_refl. simpl in |- *. apply not_Zeq. intro. apply H. symmetry in |- *. assumption. Qed. Lemma Zabs_12 : forall z m : Z, (m < Z.abs z)%Z -> {(m < z)%Z} + {(z < - m)%Z}. Proof. intros [| p| p] m; simpl in |- *; intros H; [ left | left | right; apply Zmin_cancel_Zlt; rewrite Z.opp_involutive ]; assumption. Qed. Lemma Zabs_mult : forall z p : Z, Z.abs (z * p) = (Z.abs z * Z.abs p)%Z. Proof. intros. case z. simpl in |- *. reflexivity. case p. simpl in |- *. reflexivity. intros. simpl in |- *. reflexivity. intros. simpl in |- *. reflexivity. case p. intro. simpl in |- *. reflexivity. intros. simpl in |- *. reflexivity. intros. simpl in |- *. reflexivity. Qed. Lemma Zabs_plus : forall z p : Z, (Z.abs (z + p) <= Z.abs z + Z.abs p)%Z. Proof. intros. case z. simpl in |- *. apply Z.le_refl. case p. intro. simpl in |- *. apply Z.le_refl. intros. simpl in |- *. apply Z.le_refl. intros. unfold Z.abs at 2 in |- *. unfold Z.abs at 2 in |- *. apply Zabs_8. split. apply Zplus_le_reg_l with (Zpos p1 - Zneg p0)%Z. replace (Zpos p1 - Zneg p0 + - (Zpos p1 + Zpos p0))%Z with (- (Zpos p0 + Zneg p0))%Z. replace (Zpos p1 - Zneg p0 + (Zpos p1 + Zneg p0))%Z with (2 * Zpos p1)%Z. replace (- (Zpos p0 + Zneg p0))%Z with 0%Z. apply Zmult_gt_0_le_0_compat. constructor. apply Zlt_le_weak. constructor. rewrite <- Zopp_neg with p0. ring. ring. ring. apply Zplus_le_compat. apply Z.le_refl. apply Zlt_le_weak. constructor. case p. simpl in |- *. intro. apply Z.le_refl. intros. unfold Z.abs at 2 in |- *. unfold Z.abs at 2 in |- *. apply Zabs_8. split. apply Zplus_le_reg_l with (Zpos p1 + Zneg p0)%Z. replace (Zpos p1 + Zneg p0 + - (Zpos p1 + Zpos p0))%Z with (Zneg p0 - Zpos p0)%Z. replace (Zpos p1 + Zneg p0 + (Zneg p1 + Zpos p0))%Z with 0%Z. apply Zplus_le_reg_l with (Zpos p0). replace (Zpos p0 + (Zneg p0 - Zpos p0))%Z with (Zneg p0). simpl in |- *. apply Zlt_le_weak. constructor. ring. replace (Zpos p1 + Zneg p0 + (Zneg p1 + Zpos p0))%Z with (Zpos p1 + Zneg p1 + (Zpos p0 + Zneg p0))%Z. replace 0%Z with (0 + 0)%Z. apply Zplus_eq_compat. rewrite <- Zopp_neg with p1. ring. rewrite <- Zopp_neg with p0. ring. simpl in |- *. constructor. ring. ring. apply Zplus_le_compat. apply Zlt_le_weak. constructor. apply Z.le_refl. intros. simpl in |- *. apply Z.le_refl. Qed. Lemma Zabs_neg : forall z : Z, (z <= 0)%Z -> Z.abs z = (- z)%Z. Proof. intro. case z. simpl in |- *. intro. reflexivity. intros. apply False_ind. apply H. simpl in |- *. reflexivity. intros. simpl in |- *. reflexivity. Qed. Lemma Zle_Zabs: forall z, (z <= Z.abs z)%Z. Proof. intros [|z|z]; simpl; auto with zarith; apply Zle_neg_pos. Qed. Local Hint Resolve Zabs_1 Zabs_2 Zabs_3 Zabs_4 Zabs_5 Zabs_6 Zabs_7 Zabs_8 Zabs_9 Zabs_10 Zabs_11 Zabs_12 Zabs_min Zabs_neg Zabs_mult Zabs_plus Zle_Zabs: zarith. (*###########################################################################*) (** Induction on Z *) (*###########################################################################*) Lemma Zind : forall (P : Z -> Prop) (p : Z), P p -> (forall q : Z, (p <= q)%Z -> P q -> P (q + 1)%Z) -> forall q : Z, (p <= q)%Z -> P q. Proof. intros P p. intro. intro. cut (forall q : Z, (p <= q)%Z -> exists k : nat, q = (p + k)%Z). intro. cut (forall k : nat, P (p + k)%Z). intro. intros. cut (exists k : nat, q = (p + Z_of_nat k)%Z). intro. case H4. intros. rewrite H5. apply H2. apply H1. assumption. intro. induction k as [| k Hreck]. simpl in |- *. ring_simplify (p + 0)%Z. assumption. replace (p + Z_of_nat (S k))%Z with (p + k + 1)%Z. apply H0. apply Zplus_le_reg_l with (p := (- p)%Z). replace (- p + p)%Z with (Z_of_nat 0). ring_simplify (- p + (p + Z_of_nat k))%Z. apply Znat.inj_le. apply Nat.le_0_l. ring_simplify; auto with arith. assumption. rewrite (Znat.inj_S k). unfold Z.succ in |- *. ring. intros. cut (exists k : nat, (q - p)%Z = Z_of_nat k). intro. case H2. intro k. intros. exists k. apply Zplus_reg_l with (n := (- p)%Z). replace (- p + q)%Z with (q - p)%Z. rewrite H3. ring. ring. apply Z_of_nat_complete. unfold Zminus in |- *. apply Zle_left. assumption. Qed. Lemma Zrec : forall (P : Z -> Set) (p : Z), P p -> (forall q : Z, (p <= q)%Z -> P q -> P (q + 1)%Z) -> forall q : Z, (p <= q)%Z -> P q. Proof. intros F p. intro. intro. cut (forall q : Z, (p <= q)%Z -> {k : nat | q = (p + k)%Z}). intro. cut (forall k : nat, F (p + k)%Z). intro. intros. cut {k : nat | q = (p + Z_of_nat k)%Z}. intro. case H4. intros. rewrite e. apply H2. apply H1. assumption. intro. induction k as [| k Hreck]. simpl in |- *. rewrite Zplus_0_r. assumption. replace (p + Z_of_nat (S k))%Z with (p + k + 1)%Z. apply H0. apply Zplus_le_reg_l with (p := (- p)%Z). replace (- p + p)%Z with (Z_of_nat 0). replace (- p + (p + Z_of_nat k))%Z with (Z_of_nat k). apply Znat.inj_le. apply Nat.le_0_l. rewrite Zplus_assoc; rewrite Zplus_opp_l; reflexivity. rewrite Zplus_opp_l; reflexivity. assumption. rewrite (Znat.inj_S k). unfold Z.succ in |- *. apply Zplus_assoc_reverse. intros. cut {k : nat | (q - p)%Z = Z_of_nat k}. intro H2. case H2. intro k. intros. exists k. apply Zplus_reg_l with (n := (- p)%Z). replace (- p + q)%Z with (q - p)%Z. rewrite e. rewrite Zplus_assoc; rewrite Zplus_opp_l; reflexivity. unfold Zminus in |- *. apply Zplus_comm. apply Z_of_nat_complete_inf. unfold Zminus in |- *. apply Zle_left. assumption. Qed. Lemma Zrec_down : forall (P : Z -> Set) (p : Z), P p -> (forall q : Z, (q <= p)%Z -> P q -> P (q - 1)%Z) -> forall q : Z, (q <= p)%Z -> P q. Proof. intros F p. intro. intro. cut (forall q : Z, (q <= p)%Z -> {k : nat | q = (p - k)%Z}). intro. cut (forall k : nat, F (p - k)%Z). intro. intros. cut {k : nat | q = (p - Z_of_nat k)%Z}. intro. case H4. intros. rewrite e. apply H2. apply H1. assumption. intro. induction k as [| k Hreck]. simpl in |- *. replace (p - 0)%Z with p. assumption. unfold Zminus in |- *. unfold Z.opp in |- *. rewrite Zplus_0_r; reflexivity. replace (p - Z_of_nat (S k))%Z with (p - k - 1)%Z. apply H0. apply Zplus_le_reg_l with (p := (- p)%Z). replace (- p + p)%Z with (- Z_of_nat 0)%Z. replace (- p + (p - Z_of_nat k))%Z with (- Z_of_nat k)%Z. apply Z.ge_le. apply Zge_opp. apply Znat.inj_le. apply Nat.le_0_l. unfold Zminus in |- *; rewrite Zplus_assoc; rewrite Zplus_opp_l; reflexivity. rewrite Zplus_opp_l; reflexivity. assumption. rewrite (Znat.inj_S k). unfold Z.succ in |- *. unfold Zminus at 1 2 in |- *. rewrite Zplus_assoc_reverse. rewrite <- Zopp_plus_distr. reflexivity. intros. cut {k : nat | (p - q)%Z = Z_of_nat k}. intro. case H2. intro k. intros. exists k. apply Z.opp_inj. apply Zplus_reg_l with (n := p). replace (p + - (p - Z_of_nat k))%Z with (Z_of_nat k). rewrite <- e. reflexivity. unfold Zminus in |- *. rewrite Zopp_plus_distr. rewrite Zplus_assoc. rewrite Zplus_opp_r. rewrite Z.opp_involutive. reflexivity. apply Z_of_nat_complete_inf. unfold Zminus in |- *. apply Zle_left. assumption. Qed. Lemma Zind_down : forall (P : Z -> Prop) (p : Z), P p -> (forall q : Z, (q <= p)%Z -> P q -> P (q - 1)%Z) -> forall q : Z, (q <= p)%Z -> P q. Proof. intros F p. intro. intro. cut (forall q : Z, (q <= p)%Z -> exists k : nat, q = (p - k)%Z). intro. cut (forall k : nat, F (p - k)%Z). intro. intros. cut (exists k : nat, q = (p - Z_of_nat k)%Z). intro. case H4. intros x e. rewrite e. apply H2. apply H1. assumption. intro. induction k as [| k Hreck]. simpl in |- *. replace (p - 0)%Z with p. assumption. ring. replace (p - Z_of_nat (S k))%Z with (p - k - 1)%Z. apply H0. apply Zplus_le_reg_l with (p := (- p)%Z). replace (- p + p)%Z with (- Z_of_nat 0)%Z. replace (- p + (p - Z_of_nat k))%Z with (- Z_of_nat k)%Z. apply Z.ge_le. apply Zge_opp. apply Znat.inj_le. apply Nat.le_0_l. ring. ring_simplify; auto with arith. assumption. rewrite (Znat.inj_S k). unfold Z.succ in |- *. ring. intros. cut (exists k : nat, (p - q)%Z = Z_of_nat k). intro. case H2. intro k. intros. exists k. apply Z.opp_inj. apply Zplus_reg_l with (n := p). replace (p + - (p - Z_of_nat k))%Z with (Z_of_nat k). rewrite <- H3. ring. ring. apply Z_of_nat_complete. unfold Zminus in |- *. apply Zle_left. assumption. Qed. Lemma Zrec_wf : forall (P : Z -> Set) (p : Z), (forall q : Z, (forall r : Z, (p <= r < q)%Z -> P r) -> P q) -> forall q : Z, (p <= q)%Z -> P q. Proof. intros P p WF_ind_step q Hq. cut (forall x : Z, (p <= x)%Z -> forall y : Z, (p <= y < x)%Z -> P y). intro. apply (H (Z.succ q)). apply Zle_le_succ. assumption. split; [ assumption | exact (Zlt_succ q) ]. intros x0 Hx0; generalize Hx0; pattern x0 in |- *. apply Zrec with (p := p). intros. absurd (p <= p)%Z. apply Zgt_not_le. apply Zgt_le_trans with (m := y). apply Z.lt_gt. elim H. intros. assumption. elim H. intros. assumption. apply Z.le_refl. intros. apply WF_ind_step. intros. apply (H0 H). split. elim H2. intros. assumption. apply Z.lt_le_trans with y. elim H2. intros. assumption. apply Zgt_succ_le. apply Z.lt_gt. elim H1. intros. unfold Z.succ in |- *. assumption. assumption. Qed. Lemma Zrec_wf2 : forall (q : Z) (P : Z -> Set) (p : Z), (forall q : Z, (forall r : Z, (p <= r < q)%Z -> P r) -> P q) -> (p <= q)%Z -> P q. Proof. intros. apply Zrec_wf with (p := p). assumption. assumption. Qed. Lemma Zrec_wf_double : forall (P : Z -> Z -> Set) (p0 q0 : Z), (forall n m : Z, (forall p q : Z, (q0 <= q)%Z -> (p0 <= p < n)%Z -> P p q) -> (forall p : Z, (q0 <= p < m)%Z -> P n p) -> P n m) -> forall p q : Z, (q0 <= q)%Z -> (p0 <= p)%Z -> P p q. Proof. intros P p0 q0 Hrec p. intros. generalize q H. pattern p in |- *. apply Zrec_wf with (p := p0). intros p1 H1. intros. pattern q1 in |- *. apply Zrec_wf with (p := q0). intros q2 H3. apply Hrec. intros. apply H1. assumption. assumption. intros. apply H3. assumption. assumption. assumption. Qed. Lemma Zind_wf : forall (P : Z -> Prop) (p : Z), (forall q : Z, (forall r : Z, (p <= r < q)%Z -> P r) -> P q) -> forall q : Z, (p <= q)%Z -> P q. Proof. intros P p WF_ind_step q Hq. cut (forall x : Z, (p <= x)%Z -> forall y : Z, (p <= y < x)%Z -> P y). intro. apply (H (Z.succ q)). apply Zle_le_succ. assumption. split; [ assumption | exact (Zlt_succ q) ]. intros x0 Hx0; generalize Hx0; pattern x0 in |- *. apply Zind with (p := p). intros. absurd (p <= p)%Z. apply Zgt_not_le. apply Zgt_le_trans with (m := y). apply Z.lt_gt. elim H. intros. assumption. elim H. intros. assumption. apply Z.le_refl. intros. apply WF_ind_step. intros. apply (H0 H). split. elim H2. intros. assumption. apply Z.lt_le_trans with y. elim H2. intros. assumption. apply Zgt_succ_le. apply Z.lt_gt. elim H1. intros. unfold Z.succ in |- *. assumption. assumption. Qed. Lemma Zind_wf2 : forall (q : Z) (P : Z -> Prop) (p : Z), (forall q : Z, (forall r : Z, (p <= r < q)%Z -> P r) -> P q) -> (p <= q)%Z -> P q. Proof. intros. apply Zind_wf with (p := p). assumption. assumption. Qed. Lemma Zind_wf_double : forall (P : Z -> Z -> Prop) (p0 q0 : Z), (forall n m : Z, (forall p q : Z, (q0 <= q)%Z -> (p0 <= p < n)%Z -> P p q) -> (forall p : Z, (q0 <= p < m)%Z -> P n p) -> P n m) -> forall p q : Z, (q0 <= q)%Z -> (p0 <= p)%Z -> P p q. Proof. intros P p0 q0 Hrec p. intros. generalize q H. pattern p in |- *. apply Zind_wf with (p := p0). intros p1 H1. intros. pattern q1 in |- *. apply Zind_wf with (p := q0). intros q2 H3. apply Hrec. intros. apply H1. assumption. assumption. intros. apply H3. assumption. assumption. assumption. Qed. (*###########################################################################*) (** Properties of Zmax *) (*###########################################################################*) Definition Zmax (n m : Z) := (n + m - Z.min n m)%Z. Lemma ZmaxSS : forall n m : Z, (Zmax n m + 1)%Z = Zmax (n + 1) (m + 1). Proof. intros. unfold Zmax in |- *. replace (Z.min (n + 1) (m + 1)) with (Z.min n m + 1)%Z. ring. symmetry in |- *. change (Z.min (Z.succ n) (Z.succ m) = Z.succ (Z.min n m)) in |- *. symmetry in |- *. apply Zmin_SS. Qed. Lemma Zle_max_l : forall n m : Z, (n <= Zmax n m)%Z. Proof. intros. unfold Zmax in |- *. apply Zplus_le_reg_l with (p := (- n + Z.min n m)%Z). ring_simplify (- n + Z.min n m + n)%Z. ring_simplify (- n + Z.min n m + (n + m - Z.min n m))%Z. apply Z.le_min_r. Qed. Lemma Zle_max_r : forall n m : Z, (m <= Zmax n m)%Z. Proof. intros. unfold Zmax in |- *. apply Zplus_le_reg_l with (p := (- m + Z.min n m)%Z). ring_simplify (- m + Z.min n m + m)%Z. ring_simplify (- m + Z.min n m + (n + m - Z.min n m))%Z. apply Z.le_min_l. Qed. Lemma Zmin_or_informative : forall n m : Z, {Z.min n m = n} + {Z.min n m = m}. Proof. intros. case (Z_lt_ge_dec n m). unfold Z.min in |- *. unfold Z.lt in |- *. intro z. rewrite z. left. reflexivity. intro. cut ({(n > m)%Z} + {n = m :>Z}). intro. case H. intros z0. unfold Z.min in |- *. unfold Z.gt in z0. rewrite z0. right. reflexivity. intro. rewrite e. right. apply Zmin_n_n. cut ({(m < n)%Z} + {m = n :>Z}). intro. elim H. intro. left. apply Z.lt_gt. assumption. intro. right. symmetry in |- *. assumption. apply Z_le_lt_eq_dec. apply Z.ge_le. assumption. Qed. Lemma Zmax_case : forall (n m : Z) (P : Z -> Set), P n -> P m -> P (Zmax n m). Proof. intros. unfold Zmax in |- *. case Zmin_or_informative with (n := n) (m := m). intro. rewrite e. cut ((n + m - n)%Z = m). intro. rewrite H1. assumption. ring. intro. rewrite e. cut ((n + m - m)%Z = n). intro. rewrite H1. assumption. ring. Qed. Lemma Zmax_or_informative : forall n m : Z, {Zmax n m = n} + {Zmax n m = m}. Proof. intros. unfold Zmax in |- *. case Zmin_or_informative with (n := n) (m := m). intro. rewrite e. right. ring. intro. rewrite e. left. ring. Qed. Lemma Zmax_n_n : forall n : Z, Zmax n n = n. Proof. intros. unfold Zmax in |- *. rewrite (Zmin_n_n n). ring. Qed. Local Hint Resolve ZmaxSS Zle_max_r Zle_max_l Zmax_n_n: zarith. (*###########################################################################*) (** Properties of Arity *) (*###########################################################################*) Lemma Zeven_S : forall x : Z, Zeven.Zodd x -> Zeven.Zeven (x + 1). Proof. exact Zeven.Zeven_Sn. Qed. Lemma Zeven_pred : forall x : Z, Zeven.Zodd x -> Zeven.Zeven (x - 1). Proof. exact Zeven.Zeven_pred. Qed. (* This lemma used to be useful since it was mentioned with an unnecessary premise `x>=0` as Z_modulo_2 in ZArith, but the ZArith version has been fixed. *) Definition Z_modulo_2_always : forall x : Z, {y : Z | x = (2 * y)%Z} + {y : Z | x = (2 * y + 1)%Z} := Zeven.Z_modulo_2. (*###########################################################################*) (** Properties of Zdiv *) (*###########################################################################*) Lemma Z_div_mod_eq_2 : forall a b : Z, (0 < b)%Z -> (b * (a / b))%Z = (a - a mod b)%Z. Proof. intros. apply Zplus_minus_eq. rewrite Zplus_comm. apply Z_div_mod_eq_full. Qed. Lemma Z_div_le : forall a b c : Z, (0 < c)%Z -> (b <= a)%Z -> (b / c <= a / c)%Z. Proof. intros. apply Z.ge_le. apply Z_div_ge; Flip; assumption. Qed. Lemma Z_div_nonneg : forall a b : Z, (0 < b)%Z -> (0 <= a)%Z -> (0 <= a / b)%Z. Proof. intros. apply Z.ge_le. apply Z_div_ge0; Flip; assumption. Qed. Lemma Z_div_neg : forall a b : Z, (0 < b)%Z -> (a < 0)%Z -> (a / b < 0)%Z. Proof. intros. rewrite (Z_div_mod_eq_full a b) in H0. elim (Z_mod_lt a b). intros H1 _. apply Znot_ge_lt. intro. apply (Zlt_not_le (b * (a / b) + a mod b) 0 H0). apply Zplus_le_0_compat. apply Zmult_le_0_compat. apply Zlt_le_weak; assumption. Flip. assumption. Flip. Qed. Local Hint Resolve Z_div_mod_eq_2 Z_div_le Z_div_nonneg Z_div_neg: zarith. (*###########################################################################*) (** Properties of Zpower *) (*###########################################################################*) Lemma Zpower_1 : forall a : Z, (a ^ 1)%Z = a. Proof. intros; unfold Zpower in |- *; unfold Zpower_pos in |- *; simpl in |- *; auto with zarith. Qed. Lemma Zpower_2 : forall a : Z, (a ^ 2)%Z = (a * a)%Z. Proof. intros; unfold Zpower in |- *; unfold Zpower_pos in |- *; simpl in |- *; ring. Qed. Local Hint Resolve Zpower_1 Zpower_2: zarith. coq-8.20.0/test-suite/stm/arg_filter_1.v000066400000000000000000000002511466560755400200410ustar00rootroot00000000000000(* -*- coq-prog-args: ("-async-proofs" "on" "-async-proofs-tac-j" "1"); -*- *) Lemma foo (A B : Prop) n : n + 0 = n /\ (A -> B -> A). Proof. split. par: now auto. Qed. coq-8.20.0/test-suite/stm/classify_set_proof_mode_9093.v000066400000000000000000000002521466560755400230710ustar00rootroot00000000000000(* -*- coq-prog-args: ("-async-proofs" "on" "-noinit"); -*- *) Declare ML Module "coq-core.plugins.ltac". Set Default Proof Mode "Classic". Goal Prop. idtac. Abort. coq-8.20.0/test-suite/stm/delayed_restrict_univs_9093.v000066400000000000000000000005271466560755400227470ustar00rootroot00000000000000(* -*- coq-prog-args: ("-async-proofs" "on"); -*- *) Unset Universe Polymorphism. Ltac exact0 := let x := constr:(Type) in exact 0. Lemma lemma_restrict_abstract@{} : (nat * nat)%type. Proof. split;[exact 0|abstract exact0]. Qed. (* Debug: 10237:proofworker:0:0 STM: sending back a fat state Error: Universe {polymorphism.1} is unbound. *) coq-8.20.0/test-suite/success/000077500000000000000000000000001466560755400161635ustar00rootroot00000000000000coq-8.20.0/test-suite/success/Abstract.v000066400000000000000000000006621466560755400201210ustar00rootroot00000000000000(* Cf BZ#546 *) Require Import Lia. Section S. Variables n m : nat. Variable H : n Set := | Dummy0 : Dummy 0 | Dummy2 : Dummy 2 | DummyApp : forall i j, Dummy i -> Dummy j -> Dummy (i+j). Definition Bug : Dummy (2*n). Proof. induction n. simpl ; apply Dummy0. replace (2 * S n0) with (2*n0 + 2) ; auto with arith. apply DummyApp. 2:exact Dummy2. apply IHn0 ; abstract lia. Defined. End S. coq-8.20.0/test-suite/success/AdvancedCanonicalStructure.v000066400000000000000000000064451466560755400236210ustar00rootroot00000000000000Require Import TestSuite.admit. Section group_morphism. (* An example with default canonical structures *) Variable A B : Type. Variable plusA : A -> A -> A. Variable plusB : B -> B -> B. Variable zeroA : A. Variable zeroB : B. Variable eqA : A -> A -> Prop. Variable eqB : B -> B -> Prop. Variable phi : A -> B. Record img := { ia : A; ib :> B; prf : phi ia = ib }. Parameter eq_img : forall (i1:img) (i2:img), eqB (ib i1) (ib i2) -> eqA (ia i1) (ia i2). Lemma phi_img (a:A) : img. exists a (phi a). refine ( refl_equal _). Defined. Canonical Structure phi_img. Lemma zero_img : img. exists zeroA zeroB. admit. Defined. Canonical Structure zero_img. Lemma plus_img : img -> img -> img. intros i1 i2. exists (plusA (ia i1) (ia i2)) (plusB (ib i1) (ib i2)). admit. Defined. Canonical Structure plus_img. (* Print Canonical Projections. *) Goal forall a1 a2, eqA (plusA a1 zeroA) a2. intros a1 a2. refine (eq_img _ _ _). change (eqB (plusB (phi a1) zeroB) (phi a2)). Admitted. Variable foo : A -> Type. Definition local0 := fun (a1 : A) (a2 : A) (a3 : A) => (eq_refl : plusA a1 (plusA zeroA a2) = ia _). Definition local1 := fun (a1 : A) (a2 : A) (f : A -> A) => (eq_refl : plusA a1 (plusA zeroA (f a2)) = ia _). Definition local2 := fun (a1 : A) (f : A -> A) => (eq_refl : (f a1) = ia _). Goal forall a1 a2, eqA (plusA a1 zeroA) a2. intros a1 a2. refine (eq_img _ _ _). change (eqB (plusB (phi a1) zeroB) (phi a2)). Admitted. End group_morphism. Open Scope type_scope. Section type_reification. Inductive term :Type := Fun : term -> term -> term | Prod : term -> term -> term | Bool : term | SET :term | PROP :term | TYPE :term | Var : Type -> term. Fixpoint interp (t:term) := match t with Bool => bool | SET => Set | PROP => Prop | TYPE => Type | Fun a b => interp a -> interp b | Prod a b => interp a * interp b | Var x => x end. Record interp_pair :Type := { repr:>term; abs:>Type; link: abs = interp repr }. Lemma prod_interp :forall (a b:interp_pair),a * b = interp (Prod a b) . Proof. intros a b. change (a * b = interp a * interp b). rewrite (link a), (link b); reflexivity. Qed. Lemma fun_interp :forall (a b:interp_pair), (a -> b) = interp (Fun a b). Proof. intros a b. change ((a -> b) = (interp a -> interp b)). rewrite (link a), (link b); reflexivity. Qed. Canonical Structure ProdCan (a b:interp_pair) := Build_interp_pair (Prod a b) (a * b) (prod_interp a b). Canonical Structure FunCan (a b:interp_pair) := Build_interp_pair (Fun a b) (a -> b) (fun_interp a b). Canonical Structure BoolCan := Build_interp_pair Bool bool (refl_equal _). Canonical Structure VarCan (x:Type) := Build_interp_pair (Var x) x (refl_equal _). Canonical Structure SetCan := Build_interp_pair SET Set (refl_equal _). Canonical Structure PropCan := Build_interp_pair PROP Prop (refl_equal _). Canonical Structure TypeCan := Build_interp_pair TYPE Type (refl_equal _). (* Print Canonical Projections. *) Variable A:Type. Variable Inhabited: term -> Prop. Variable Inhabited_correct: forall p, Inhabited (repr p) -> abs p. Lemma L : Prop * A -> bool * (Type -> Set) . refine (Inhabited_correct _ _). change (Inhabited (Fun (Prod PROP (Var A)) (Prod Bool (Fun TYPE SET)))). Admitted. Check L : abs _ . End type_reification. coq-8.20.0/test-suite/success/AdvancedTypeClasses.v000066400000000000000000000042651466560755400222460ustar00rootroot00000000000000Generalizable All Variables. Open Scope type_scope. Section type_reification. Inductive term :Type := Fun : term -> term -> term | Prod : term -> term -> term | Bool : term | SET :term | PROP :term | TYPE :term | Var : Type -> term. Fixpoint interp (t:term) := match t with Bool => bool | SET => Set | PROP => Prop | TYPE => Type | Fun a b => interp a -> interp b | Prod a b => interp a * interp b | Var x => x end. Class interp_pair (abs : Type) := { repr : term; link: abs = interp repr }. Arguments repr _ {interp_pair}. Arguments link _ {interp_pair}. Lemma prod_interp `{interp_pair a, interp_pair b} : a * b = interp (Prod (repr a) (repr b)). simpl. intros. rewrite <- link. rewrite <- (link b). reflexivity. Qed. Lemma fun_interp :forall `{interp_pair a, interp_pair b}, (a -> b) = interp (Fun (repr a) (repr b)). simpl. intros. rewrite <- link. rewrite <- (link b). reflexivity. Qed. Coercion repr : interp_pair >-> term. Definition abs `{interp_pair a} : Type := a. Coercion abs : interp_pair >-> Sortclass. Lemma fun_interp' :forall `{ia : interp_pair, ib : interp_pair}, (ia -> ib) = interp (Fun ia ib). simpl. intros a ia b ib. rewrite <- link. rewrite <- (link b). reflexivity. Qed. Instance ProdCan `(interp_pair a, interp_pair b) : interp_pair (a * b) := { repr := Prod (repr a) (repr b) ; link := prod_interp }. Instance FunCan `(interp_pair a, interp_pair b) : interp_pair (a -> b) := { link := fun_interp }. Instance BoolCan : interp_pair bool := { repr := Bool ; link := refl_equal _ }. Instance VarCan x : interp_pair x | 10 := { repr := Var x ; link := refl_equal _ }. Instance SetCan : interp_pair Set := { repr := SET ; link := refl_equal _ }. Instance PropCan : interp_pair Prop := { repr := PROP ; link := refl_equal _ }. Instance TypeCan : interp_pair Type := { repr := TYPE ; link := refl_equal _ }. (* Print Canonical Projections. *) Variable A:Type. Variable Inhabited: term -> Prop. Variable Inhabited_correct: forall `{interp_pair p}, Inhabited (repr p) -> p. Lemma L : Prop * A -> bool * (Type -> Set) . apply Inhabited_correct. change (Inhabited (Fun (Prod PROP (Var A)) (Prod Bool (Fun TYPE SET)))). Admitted. End type_reification. coq-8.20.0/test-suite/success/Assumptions.v000066400000000000000000000033741466560755400207060ustar00rootroot00000000000000(* Test about assumptions *) (* Test instances *) Module Instances. Class C' := { f' : unit }. Class D := { g : unit }. Module Type T. #[warning="context-outside-section"] Context (c':={|f':=tt|}). Fail Definition a'' := _ : C'. End T. (* Not instance *) Module Type U. Definition d':={|g:=tt|}. Fail Definition b'' := _ : D. End U. (* Not instance *) (* Local assumptions are always instances by default *) (* Global assumptions are instances if using Context *) Class C := { f : unit }. Section A. Context (c:C). Definition a := _ : C. End A. (* Instance *) Section B. Variable d:D. Definition b := _ : D. End B. (* Instance *) #[warning="context-outside-section"] Context (c:C). Definition a0 := _ : C. (* Instance *) Parameter d:D. Fail Definition b0 := _ : D. (* Not instance *) (* Local/global definitions are never instances by default, using Context or not *) Section A'. Context (c':={|f':=tt|}). Fail Definition a' := _ : C'. End A'. (* Not instance *) Section B'. Let d:={|g:=tt|}. Fail Definition b' := _ : D. End B'. (* Not instance *) #[warning="context-outside-section"] Context (c':={|f':=tt|}). Fail Definition a0' := _ : C'. (* Not instance *) Definition d':={|g:=tt|}. Fail Definition b0' := _ : D. (* Not instance *) End Instances. (* Type factorization *) Module TypeSharing. (* How to observe it? *) Section S. Context (A B : Type). End S. (* Distinct universes *) Section T. Variables A B : Type. End T. (* Same universe *) Section S. Fail Context (a b : _) (e : a = 0). End S. (* not shared *) Section S. Variables (a b : _) (e : a = 0). End S. (* shared *) End TypeSharing. coq-8.20.0/test-suite/success/AutoPropLowering.v000066400000000000000000000004071466560755400216330ustar00rootroot00000000000000Set Warnings "+automatic-prop-lowering". Fail Inductive foo : Type := . Unset Automatic Proposition Inductives. Inductive foo : Type := . Fail Check foo : Prop. Inductive bar := . Check bar : Prop. Inductive baz := Baz (_:True) (_:baz). Check baz : Prop. coq-8.20.0/test-suite/success/BidirectionalityHints.v000066400000000000000000000073161466560755400226650ustar00rootroot00000000000000From Coq Require Import Utf8. Set Default Proof Using "Type". Module SimpleExamples. Axiom c : bool -> nat. Coercion c : bool >-> nat. Inductive Boxed A := Box (a : A). Arguments Box {A} & a. Check Box true : Boxed nat. (* Here we check that there is no regression due e.g. to refining arguments in the wrong order *) Axiom f : forall b : bool, (if b then bool else nat) -> Type. Check f true true : Type. Arguments f & _ _. Check f true true : Type. End SimpleExamples. Module Issue7910. Local Set Universe Polymorphism. (** Telescopes *) Inductive tele : Type := | TeleO : tele | TeleS {X} (binder : X → tele) : tele. Arguments TeleS {_} _. (** The telescope version of Coq's function type *) Fixpoint tele_fun (TT : tele) (T : Type) : Type := match TT with | TeleO => T | TeleS b => ∀ x, tele_fun (b x) T end. Notation "TT -t> A" := (tele_fun TT A) (at level 99, A at level 200, right associativity). (** An eliminator for elements of [tele_fun]. We use a [fix] because, for some reason, that makes stuff print nicer in the proofs in iris:bi/lib/telescopes.v *) Definition tele_fold {X Y} {TT : tele} (step : ∀ {A : Type}, (A → Y) → Y) (base : X → Y) : (TT -t> X) → Y := (fix rec {TT} : (TT -t> X) → Y := match TT as TT return (TT -t> X) → Y with | TeleO => λ x : X, base x | TeleS b => λ f, step (λ x, rec (f x)) end) TT. Arguments tele_fold {_ _ !_} _ _ _ /. (** A sigma-like type for an "element" of a telescope, i.e. the data it takes to get a [T] from a [TT -t> T]. *) Inductive tele_arg : tele → Type := | TargO : tele_arg TeleO (* the [x] is the only relevant data here *) | TargS {X} {binder} (x : X) : tele_arg (binder x) → tele_arg (TeleS binder). Definition tele_app {TT : tele} {T} (f : TT -t> T) : tele_arg TT → T := λ a, (fix rec {TT} (a : tele_arg TT) : (TT -t> T) → T := match a in tele_arg TT return (TT -t> T) → T with | TargO => λ t : T, t | TargS x a => λ f, rec a (f x) end) TT a f. Arguments tele_app {!_ _} & _ !_ /. Coercion tele_arg : tele >-> Sortclass. Coercion tele_app : tele_fun >-> Funclass. (** Operate below [tele_fun]s with argument telescope [TT]. *) Fixpoint tele_bind {U} {TT : tele} : (TT → U) → TT -t> U := match TT as TT return (TT → U) → TT -t> U with | TeleO => λ F, F TargO | @TeleS X b => λ (F : TeleS b → U) (x : X), (* b x -t> U *) tele_bind (λ a, F (TargS x a)) end. Arguments tele_bind {_ !_} _ /. (** Telescopic quantifiers *) Definition tforall {TT : tele} (Ψ : TT → Prop) : Prop := tele_fold (λ (T : Type) (b : T → Prop), ∀ x : T, b x) (λ x, x) (tele_bind Ψ). Arguments tforall {!_} _ /. Definition texist {TT : tele} (Ψ : TT → Prop) : Prop := tele_fold ex (λ x, x) (tele_bind Ψ). Arguments texist {!_} _ /. Notation "'∀..' x .. y , P" := (tforall (λ x, .. (tforall (λ y, P)) .. )) (at level 200, x binder, y binder, right associativity, format "∀.. x .. y , P"). Notation "'∃..' x .. y , P" := (texist (λ x, .. (texist (λ y, P)) .. )) (at level 200, x binder, y binder, right associativity, format "∃.. x .. y , P"). (** The actual test case *) Definition test {TT : tele} (t : TT → Prop) : Prop := ∀.. x, t x ∧ t x. Notation "'[TEST' x .. z , P ']'" := (test (TT:=(TeleS (fun x => .. (TeleS (fun z => TeleO)) ..))) (tele_app (λ x, .. (λ z, P) ..))) (x binder, z binder). Notation "'[TEST2' x .. z , P ']'" := (test (TT:=(TeleS (fun x => .. (TeleS (fun z => TeleO)) ..))) (tele_app (TT:=(TeleS (fun x => .. (TeleS (fun z => TeleO)) ..))) (λ x, .. (λ z, P) ..))) (x binder, z binder). Check [TEST (x y : nat), x = y]. Check [TEST2 (x y : nat), x = y]. End Issue7910. coq-8.20.0/test-suite/success/BracketsWithGoalSelector.v000066400000000000000000000010131466560755400232430ustar00rootroot00000000000000Goal forall A B, B \/ A -> A \/ B. Proof. intros * [HB | HA]. 2: { left. exact HA. Fail right. (* No such goal. Try unfocusing with "}". *) } Fail 2: { (* Non-existent goal. *) idtac. (* The idtac is to get a dot, so that IDEs know to stop there. *) 1:{ (* Syntactic test: no space before bracket. *) right. exact HB. Fail Qed. } Qed. Lemma foo (n: nat) (P : nat -> Prop): P n. Proof. intros. refine (nat_ind _ ?[Base] ?[Step] _). [Base]: { admit. } [Step]: { admit. } Abort. coq-8.20.0/test-suite/success/CanonicalStructure.v000066400000000000000000000154661466560755400221760ustar00rootroot00000000000000(* Bug #1172 *) Structure foo : Type := Foo { A : Set; Aopt := option A; unopt : Aopt -> A }. Canonical Structure unopt_nat := @Foo nat (fun _ => O). (* Granted wish #1187 *) Record Silly (X : Set) : Set := mkSilly { x : X }. Definition anotherMk := mkSilly. Definition struct := anotherMk nat 3. Canonical Structure struct. (* Intertwinning canonical structures and delta-expansion *) (* Assia's short example *) Open Scope bool_scope. Set Implicit Arguments. Structure test_struct : Type := mk_test {dom :> Type; f : dom -> dom -> bool}. Notation " x != y":= (f _ x y)(at level 10). Canonical Structure bool_test := mk_test (fun x y => x || y). Definition b := bool. Check (fun x : b => x != x). Inductive four := x0 | x1 | x2 | x3. Structure local := MKL { l : four }. Module X. Definition s0 := MKL x0. #[local] Canonical Structure s0. Check (refl_equal _ : l _ = x0). #[local] Canonical Structure s1 := MKL x1. Check (refl_equal _ : l _ = x1). Local Canonical Structure s2 := MKL x2. Check (refl_equal _ : l _ = x2). End X. Fail Check (refl_equal _ : l _ = x0). Fail Check (refl_equal _ : l _ = x1). Fail Check (refl_equal _ : l _ = x2). Check X.s0. Check X.s1. Check X.s2. Module Y. Definition s3 := MKL x3. Canonical Structure s3. Check (refl_equal _ : l _ = x3). End Y. Fail Check (refl_equal _ : l _ = x3). Fail Check s3. Module V. #[canonical] Definition s3 := MKL x3. Check (refl_equal _ : l _ = x3). End V. Module W. #[canonical, local] Definition s2' := MKL x2. Check (refl_equal _ : l _ = x2). End W. Fail Check (refl_equal _ : l _ = x2). (* Lambda keys *) Module LambdaKeys. Structure cs_lambda := { cs_lambda_key : nat -> nat }. Module L1. #[local] Canonical Structure cs_lambda_func := {| cs_lambda_key := fun x => x + 1 |}. Check (refl_equal _ : cs_lambda_key _ = fun _ => _ + _). End L1. Module L2. #[local] Canonical Structure cs_lambda_func2 := {| cs_lambda_key := fun x => 1 + x |}. Check (refl_equal _ : cs_lambda_key _ = fun x => 1 + x). End L2. Module L3. #[local] Canonical Structure cs_lambda_func3 := {| cs_lambda_key := fun x => 1 + x |}. Check (refl_equal _ : cs_lambda_key _ = Nat.add 1). End L3. Module L4. #[local] Canonical Structure cs_lambda_func4 := {| cs_lambda_key := Nat.add 1 |}. Check (refl_equal _ : cs_lambda_key _ = Nat.add 1). End L4. Module L5. #[local] Canonical Structure cs_lambda_func5 := {| cs_lambda_key := Nat.add 1 |}. Check (refl_equal _ : cs_lambda_key _ = fun x => 1 + x). End L5. End LambdaKeys. Module DepProd. Structure hello := { hello_key : Type }. Module FixedTypes. Local Canonical Structure hello_dep1 := {| hello_key := forall x : nat, x = x |}. Example ex_hello2 := let h := _ in fun f : hello_key h => (f : forall x : nat, x = x) 1. End FixedTypes. Module VariableTypes. Local Canonical Structure hello_dep2 v1 v2 := {| hello_key := forall x : list v1, x = v2 |}. Example ex_hello1 : _ -> _ = nil := let h := _ in fun f : hello_key h => (f : forall x : list _, _ = _) (@nil nat). End VariableTypes. End DepProd. (* Testing that canonical projections equipped with function type instances ([forall _, _]) or default instances ([_]) can be used in places where functions/function types are expected. This feature triggers CS search in two typing cases: 1. [f x : _] when [f : proj _] 2. [(fun x => _) : proj _]. *) Module NoCasts. Module Basic. Structure r1 (useless_param: bool) := { #[canonical=no] r1_pre : unit ; #[canonical=yes] r1_key : Type ; #[canonical=no] r1_post: nat }. Canonical Structure r1_func b : r1 b := {| r1_pre:= tt; r1_key := nat -> nat; r1_post:= 0|}. Example ex_r1_1 p := let b := _ in fun f : @r1_key p b => f 1. Example ex_r1_2 p := let b := _ in (fun x => x) : @r1_key p b. End Basic. Module Primitive. Local Set Primitive Projections. Structure r2 (useless_param: bool) := { #[canonical=no] r2_pre : unit ; #[canonical=yes] r2_key : Type ; #[canonical=no] r2_post: nat; }. Canonical Structure r2_func b : r2 b := {| r2_pre:= tt; r2_key := nat -> nat; r2_post:= 0|}. Example ex_r2_1 p := let b := _ in fun f : @r2_key p b => f 1. Example ex_r2_2 p := let b := _ in (fun x => x) : @r2_key p b. End Primitive. Module UsedParameters. Structure r3 (useless_param: bool) (T : Type) := { #[canonical=no] r3_pre : unit ; #[canonical=yes] r3_key : Type ; #[canonical=no] r3_post: T }. Canonical Structure r3_func b : r3 b nat := {| r3_pre:= tt; r3_key := nat -> nat; r3_post:= 0|}. Example ex_r3_1 p := let b := _ in fun f : @r3_key p _ b => f 1. Example ex_r3_2 p := let b := _ in (fun x => x) : @r3_key p _ b. End UsedParameters. Module LetBoundFieldBefore. Structure r4 (useless_param: bool) := { #[canonical=no] r4_pre : unit ; #[canonical=no] r4_let := true ; #[canonical=yes] r4_key : Type ; #[canonical=no] r4_post: nat; }. Canonical Structure r4_func b : r4 b := {| r4_pre:= tt; r4_key := nat -> nat; r4_post:= 0|}. Example ex_r4_1 p := let b := _ in fun f : @r4_key p b => f 1. Example ex_r4_2 p := let b := _ in (fun x => x) : @r4_key p b. End LetBoundFieldBefore. Module LetBoundFieldAfter. Structure r4 (useless_param: bool) := { #[canonical=no] r4_pre : unit ; #[canonical=yes] r4_key : Type ; #[canonical=no] r4_let := true ; #[canonical=no] r4_post: nat; }. Canonical Structure r4_func b : r4 b := {| r4_pre:= tt; r4_key := nat -> nat; r4_post:= 0|}. Example ex_r4_1 p := let b := _ in fun f : @r4_key p b => f 1. Example ex_r4_2 p := let b := _ in (fun x => x) : @r4_key p b. End LetBoundFieldAfter. Module Tele. Inductive tele : Type := | TeleO : tele | TeleS {X} : (X -> tele) -> tele. #[local] Set Primitive Projections. Structure tele_of := { tele_term : Type; #[canonical=no] tele_tele : tele; }. Canonical Structure tele_of_prod {X} {t : X -> tele_of} := {| tele_term := forall x, (tele_term (t x)); tele_tele := TeleS (fun x => tele_tele (t x))|}. Canonical Structure tele_of_base {T} := {| tele_term := T; tele_tele := TeleO |}. Check let t : tele_of := _ in fun f : tele_term t => (f 0). (* Was Error: Ill-typed evar instance in #12383/#14715 original version *) End Tele. End NoCasts. (* Testing that we find coherent surrounding stacks for CS problems. *) Module ExtraArgs. Structure Fun := {apply : nat -> nat}. Canonical S_Fun := {| apply := S |}. Check eq_refl : apply _ = S. Check eq_refl : apply _ 0 = S 0. Canonical generic_Fun (f : nat -> nat) := {| apply := f |}. Set Debug "unification". Set Printing All. Check fun (f : nat -> nat) => eq_refl : apply _ = f. Check fun (f : nat -> nat) => eq_refl : apply _ 0 = f 0. End ExtraArgs. coq-8.20.0/test-suite/success/Case1.v000066400000000000000000000005171466560755400173110ustar00rootroot00000000000000(* Testing eta-expansion of elimination predicate *) Section NATIND2. Variable P : nat -> Type. Variable H0 : P 0. Variable H1 : P 1. Variable H2 : forall n : nat, P n -> P (S (S n)). Fixpoint nat_ind2 (n : nat) : P n := match n as x return (P x) with | O => H0 | S O => H1 | S (S n) => H2 n (nat_ind2 n) end. End NATIND2. coq-8.20.0/test-suite/success/Case10.v000066400000000000000000000013421466560755400173660ustar00rootroot00000000000000(* ============================================== *) (* To test compilation of dependent case *) (* Multiple Patterns *) (* ============================================== *) Inductive skel : Type := | PROP : skel | PROD : skel -> skel -> skel. Parameter Can : skel -> Type. Parameter default_can : forall s : skel, Can s. Type (fun s1 s2 : skel => match s1, s2 return (Can s1) with | PROP, PROP => default_can PROP | s1, _ => default_can s1 end). Type (fun s1 s2 : skel => match s1, s2 return (Can s1) with | PROP, PROP => default_can PROP | PROP as s, _ => default_can s | PROD s1 s2 as s, PROP => default_can s | PROD s1 s2 as s, _ => default_can s end). coq-8.20.0/test-suite/success/Case11.v000066400000000000000000000005351466560755400173720ustar00rootroot00000000000000(* L'algo d'inférence du prédicat doit gérer le K-rédex dans le type de b *) (* Problème rapporté par Solange Coupet *) Section A. Variables (Alpha : Set) (Beta : Set). Definition nodep_prod_of_dep (c : sigT (fun a : Alpha => Beta)) : Alpha * Beta := match c with | existT _ a b => (a, b) end. End A. coq-8.20.0/test-suite/success/Case12.v000066400000000000000000000040431466560755400173710ustar00rootroot00000000000000(* This example was proposed by Cuihtlauac ALVARADO *) Require Import List. Fixpoint mult2 (n : nat) : nat := match n with | O => 0 | S n => S (S (mult2 n)) end. Inductive list : nat -> Set := | nil : list 0 | cons : forall n : nat, list (mult2 n) -> list (S (S (mult2 n))). Type (fun (P : forall n : nat, list n -> Prop) (f : P 0 nil) (f0 : forall (n : nat) (l : list (mult2 n)), P (mult2 n) l -> P (S (S (mult2 n))) (cons n l)) => fix F (n : nat) (l : list n) {struct l} : P n l := match l as x0 in (list x) return (P x x0) with | nil => f | cons n0 l0 => f0 n0 l0 (F (mult2 n0) l0) end). Inductive list' : nat -> Set := | nil' : list' 0 | cons' : forall n : nat, let m := mult2 n in list' m -> list' (S (S m)). Fixpoint length n (l : list' n) {struct l} : nat := match l with | nil' => 0 | cons' _ m l0 => S (length m l0) end. Type (fun (P : forall n : nat, list' n -> Prop) (f : P 0 nil') (f0 : forall n : nat, let m := mult2 n in forall l : list' m, P m l -> P (S (S m)) (cons' n l)) => fix F (n : nat) (l : list' n) {struct l} : P n l := match l as x0 in (list' x) return (P x x0) with | nil' => f | cons' n0 m l0 => f0 n0 l0 (F m l0) end). (* Check on-the-fly insertion of let-in patterns for compatibility *) Inductive list'' : nat -> Set := | nil'' : list'' 0 | cons'' : forall n : nat, let m := mult2 n in list'' m -> let p := S (S m) in list'' p. Check (fix length n (l : list'' n) {struct l} : nat := match l with | nil'' => 0 | cons'' n l0 => S (length (mult2 n) l0) end). (* Check let-in in both parameters and in constructors *) Inductive list''' (A:Set) (B:=(A*A)%type) (a:A) : B -> Set := | nil''' : list''' A a (a,a) | cons''' : forall a' : A, let m := (a',a) in list''' A a m -> list''' A a (a,a). Fixpoint length''' (A:Set) (B:=(A*A)%type) (a:A) (m:B) (l:list''' A a m) {struct l} : nat := match l with | nil''' _ _ => 0 | @cons''' _ _ _ _ m l0 => S (length''' A a m l0) end. coq-8.20.0/test-suite/success/Case13.v000066400000000000000000000073351466560755400174010ustar00rootroot00000000000000(* Check coercions in patterns *) Inductive I : Set := | C1 : nat -> I | C2 : I -> I. Coercion C1 : nat >-> I. (* Coercion at the root of pattern *) Check (fun x => match x with | C2 n => 0 | O => 0 | S n => n end). (* Coercion not at the root of pattern *) Check (fun x => match x with | C2 O => 0 | _ => 0 end). (* Unification and coercions inside patterns *) Check (fun x : option nat => match x with | None => 0 | Some O => 0 | _ => 0 end). (* Coercion up to delta-conversion, and unification *) Coercion somenat := Some (A:=nat). Check (fun x => match x with | None => 0 | O => 0 | S n => n end). (* Coercions with parameters *) Inductive listn : nat -> Set := | niln : listn 0 | consn : forall n : nat, nat -> listn n -> listn (S n). Inductive I' : nat -> Set := | C1' : forall n : nat, listn n -> I' n | C2' : forall n : nat, I' n -> I' n. Coercion C1' : listn >-> I'. Check (fun x : I' 0 => match x with | C2' _ _ => 0 | niln => 0 | _ => 0 end). Check (fun x : I' 0 => match x with | C2' _ niln => 0 | _ => 0 end). (* This one could eventually be solved, the "Fail" is just to ensure *) (* that it does not fail with an anomaly, as it did at some time *) Fail Check (fun x : I' 0 => match x return _ x with | C2' _ _ => 0 | niln => 0 | _ => 0 end). (* Check insertion of coercions around matched subterm *) Parameter A:Set. Parameter f:> A -> nat. Inductive J : Set := D : A -> J. Check (fun x => match x with | D 0 => 0 | D _ => 1 end). (* Check coercions against the type of the term to match *) (* Used to fail in V8.1beta *) Inductive C : Set := c : C. Inductive E : Set := e :> C -> E. Check fun (x : E) => match x with c => e c end. (* Check coercions with uniform parameters (cf bug #1168) *) Inductive C' : bool -> Set := c' : C' true. Inductive E' (b : bool) : Set := e' :> C' b -> E' b. Check fun (x : E' true) => match x with c' => e' true c' end. (* Check use of the no-dependency strategy when a type constraint is given (and when the "inversion-and-dependencies-as-evars" strategy is not strong enough because of a constructor with a type whose pattern structure is not refined enough for it to be captured by the inversion predicate) *) Inductive K : bool -> bool -> Type := F : K true true | G x : K x x. Check fun z P Q (y:K true z) (H1 H2:P y) (f:forall y, P y -> Q y z) => match y with | F => f y H1 | G _ => f y H2 end : Q y z. (* Check use of the maximal-dependency-in-variable strategy even when no explicit type constraint is given (and when the "inversion-and-dependencies-as-evars" strategy is not strong enough because of a constructor with a type whose pattern structure is not refined enough for it to be captured by the inversion predicate) *) Check fun z P Q (y:K true z) (H1 H2:P y) (f:forall y z, P y -> Q y z) => match y with | F => f y true H1 | G b => f y b H2 end. (* Check use of the maximal-dependency-in-variable strategy for "Var" variables *) Goal forall z P Q (y:K true z) (H1 H2:P y) (f:forall y z, P y -> Q y z), Q y z. intros z P Q y H1 H2 f. Show. refine (match y with | F => f y true H1 | G b => f y b H2 end). Qed. coq-8.20.0/test-suite/success/Case14.v000066400000000000000000000007761466560755400174040ustar00rootroot00000000000000(* Test of inference of elimination predicate for "if" *) (* submitted by Robert R Schneck *) Axiom bad : false = true. Definition try1 : False := match bad in (_ = b) return (if b then False else True) with | refl_equal => I end. Definition try2 : False := match bad in (_ = b) return ((if b then False else True):Prop) with | refl_equal => I end. Definition try3 : False := match bad in (_ = b) return ((fun b' : bool => if b' then False else True) b) with | refl_equal => I end. coq-8.20.0/test-suite/success/Case15.v000066400000000000000000000024431466560755400173760ustar00rootroot00000000000000(* Check compilation of multiple pattern-matching on terms non apparently of inductive type *) (* Check that the non dependency in y is OK both in V7 and V8 *) Check (fun x (y : Prop) z => match x, y, z return (x = x \/ z = z) with | O, y, z' => or_introl (z' = z') (refl_equal 0) | _, y, O => or_intror _ (refl_equal 0) | x, y, _ => or_introl _ (refl_equal x) end). (* Suggested by Pierre Letouzey (PR#207) *) Inductive Boite : Set := boite : forall b : bool, (if b then nat else (nat * nat)%type) -> Boite. Definition test (B : Boite) := match B return nat with | boite true n => n | boite false (n, m) => n + m end. (* Check laziness of compilation ... future work Inductive I : Set := c : (b:bool)(if b then bool else nat)->I. Check [x] Cases x of (c (true as y) (true as x)) => (if x then y else true) | (c false O) => true | _ => false end. Check [x] Cases x of (c true true) => true | (c false O) => true | _ => false end. (* Devrait produire ceci mais trouver le type intermediaire est coton ! *) Check [x:I] Cases x of (c b y) => (<[b:bool](if b then bool else nat)->bool>if b then [y](if y then true else false) else [y]Cases y of O => true | (S _) => false end y) end. *) coq-8.20.0/test-suite/success/Case16.v000066400000000000000000000006311466560755400173740ustar00rootroot00000000000000(**********************************************************************) (* Test dependencies in constructors *) (**********************************************************************) Check (fun x : {b : bool | if b then True else False} => match x return (let (b, _) := x in if b then True else False) with | exist _ true y => y | exist _ false z => z end). coq-8.20.0/test-suite/success/Case17.v000066400000000000000000000035051466560755400174000ustar00rootroot00000000000000(* Check the synthesis of predicate from a cast in case of matching of the first component (here [list bool]) of a dependent type (here [sigT]) (Simplification of an example from file parsing2.v of the Coq'Art exercises) *) Require Import List. Parameter parse_rel : list bool -> list bool -> nat -> Prop. Parameter (l0 : list bool) (rec : forall l' : list bool, length l' <= S (length l0) -> {l'' : list bool & {t : nat | parse_rel l' l'' t /\ length l'' <= length l'}} + {(forall (l'' : list bool) (t : nat), ~ parse_rel l' l'' t)}). Axiom HHH : forall A : Prop, A. Check (match rec l0 (HHH _) with | inleft (existT _ (false :: l1) _) => inright _ (HHH _) | inleft (existT _ (true :: l1) (exist _ t1 (conj Hp Hl))) => inright _ (HHH _) | inleft (existT _ _ _) => inright _ (HHH _) | inright Hnp => inright _ (HHH _) end :{l'' : list bool & {t : nat | parse_rel (true :: l0) l'' t /\ length l'' <= S (length l0)}} + {(forall (l'' : list bool) (t : nat), ~ parse_rel (true :: l0) l'' t)}). (* The same but with relative links to l0 and rec *) Check (fun (l0 : list bool) (rec : forall l' : list bool, length l' <= S (length l0) -> {l'' : list bool & {t : nat | parse_rel l' l'' t /\ length l'' <= length l'}} + {(forall (l'' : list bool) (t : nat), ~ parse_rel l' l'' t)}) => match rec l0 (HHH _) with | inleft (existT _ (false :: l1) _) => inright _ (HHH _) | inleft (existT _ (true :: l1) (exist _ t1 (conj Hp Hl))) => inright _ (HHH _) | inleft (existT _ _ _) => inright _ (HHH _) | inright Hnp => inright _ (HHH _) end :{l'' : list bool & {t : nat | parse_rel (true :: l0) l'' t /\ length l'' <= S (length l0)}} + {(forall (l'' : list bool) (t : nat), ~ parse_rel (true :: l0) l'' t)}). coq-8.20.0/test-suite/success/Case18.v000066400000000000000000000011441466560755400173760ustar00rootroot00000000000000(* Check or-patterns *) (* Non-interference with Numbers divisibility. *) Reserved Notation "( p | q )" (at level 0). Definition g x := match x with ((((1 as x),_) | (_,x)), ((_,(2 as y)) | (y,_))) => (x,y) end. Check (refl_equal _ : g ((1,2),(3,4)) = (1,3)). Check (refl_equal _ : g ((1,4),(3,2)) = (1,2)). Fixpoint max (n m:nat) {struct m} : nat := match n, m with | S n', S m' => S (max n' m') | 0, p | p, 0 => p end. (* Check bug #1477 *) Inductive I : Set := | A : nat -> nat -> I | B : nat -> nat -> I. Definition foo (x:I) : nat := match x with | A a b | B b a => S b end. coq-8.20.0/test-suite/success/Case19.v000066400000000000000000000017141466560755400174020ustar00rootroot00000000000000(* This used to fail in Coq version 8.1 beta due to a non variable universe (issued by template polymorphism) being sent by pretyping to the kernel (bug #1182) *) Parameter T : Type. Parameter x : nat*nat. Check let (_, _) := x in sigT (fun _ : T => nat). (* This used to raise an anomaly in V8.4, up to pl2 *) Goal {x: nat & x=x}. Fail exists (fun x => match projT2 (projT2 x) as e in (_ = y) return _ = existT _ (projT1 x) (existT _ y e) with | eq_refl => eq_refl end). Abort. (* Some tests with ltac matching on building "if" and "let" *) Goal forall b c d, (if negb b then c else d) = 0. intros. match goal with |- (if ?b then ?c else ?d) = 0 => transitivity (if b then d else c) end. Abort. Definition swap {A} {B} '((x,y):A*B) := (y,x). Goal forall p, (let '(x,y) := swap p in x + y) = 0. intros. match goal with |- (let '(x,y) := ?p in x + y) = 0 => transitivity (let (x,y) := p in x+y) end. Abort. coq-8.20.0/test-suite/success/Case2.v000066400000000000000000000004621466560755400173110ustar00rootroot00000000000000(* ============================================== *) (* To test compilation of dependent case *) (* Nested patterns *) (* ============================================== *) Type match 0 as n return (n = n) with | O => refl_equal 0 | m => refl_equal m end. coq-8.20.0/test-suite/success/Case20.v000066400000000000000000000021221466560755400173640ustar00rootroot00000000000000(* Example taken from RelationAlgebra *) (* Was failing from r16205 up to now *) Require Import BinNums. Section A. Context (A:Type) {X: A} (tst:A->Type) (top:forall X, X). Inductive v: (positive -> A) -> Type := | v_L: forall f', v f' | v_N: forall f', v (fun n => f' (xO n)) -> (positive -> tst (f' xH)) -> v (fun n => f' (xI n)) -> v f'. Fixpoint v_add f' (t: v f') n: (positive -> tst (f' n)) -> v f' := match t in (v o) return ((positive -> (tst (o n))) -> v o) with | v_L f' => match n return ((positive -> (tst (f' n))) -> v f') with | xH => fun x => v_N _ (v_L _) x (v_L _) | xO n => fun x => v_N _ (v_add (fun n => f' (xO n)) (v_L _) n x) (fun _ => top _) (v_L _) | xI n => fun x => v_N _ (v_L _) (fun _ => top _) (v_add (fun n => f' (xI n)) (v_L _) n x) end | v_N f' l y r => match n with | xH => fun x => v_N _ l x r | xO n => fun x => v_N _ (v_add (fun n => f' (xO n)) l n x) y r | xI n => fun x => v_N _ l y (v_add (fun n => f' (xI n)) r n x) end end. End A. coq-8.20.0/test-suite/success/Case21.v000066400000000000000000000007341466560755400173740ustar00rootroot00000000000000(* Check insertion of impossible case when there is no branch at all *) Inductive eq_true : bool -> Prop := is_eq_true : eq_true true. Check fun H:eq_true false => match H with end : False. Inductive I : bool -> bool -> Prop := C : I true true. Check fun x (H:I x false) => match H with end : False. Check fun x (H:I false x) => match H with end : False. Inductive I' : bool -> Type := C1 : I' true | C2 : I' true. Check fun x : I' false => match x with end : False. coq-8.20.0/test-suite/success/Case22.v000066400000000000000000000062431466560755400173760ustar00rootroot00000000000000(* Check typing in the presence of let-in in inductive arity *) Inductive I : let a := 1 in a=a -> let b := 2 in Type := C : I (eq_refl). Lemma a : forall x:I eq_refl, match x in I a b c return b = b with C => eq_refl end = eq_refl. intro. match goal with |- ?c => let x := eval cbv in c in change x end. Abort. Check forall x:I eq_refl, match x in I x return x = x with C => eq_refl end = eq_refl. (* This is bug #3210 *) Inductive I' : let X := Set in X := | C' : I'. Definition foo (x : I') : bool := match x with C' => true end. (* Bug found in november 2015: was wrongly failing in 8.5beta2 and 8.5beta3 *) Inductive I2 (A:Type) : let B:=A in forall C, let D:=(C*B)%type in Type := E2 : I2 A nat. Check fun x:I2 nat nat => match x in I2 _ X Y Z return X*Y*Z with E2 _ => (0,0,(0,0)) end. (* This used to succeed in 8.3, 8.4 and 8.5beta1 *) Inductive IND : forall X:Type, let Y:=X in Type := CONSTR : IND True. Definition F (x:IND True) (A:Type) := (* This failed in 8.5beta2 though it should have been accepted *) match x in IND X Y return Y with CONSTR => Logic.I end. Theorem paradox : False. (* This succeeded in 8.3, 8.4 and 8.5beta1 because F had wrong type *) Fail Proof (F C False). Abort. (* Another bug found in November 2015 (a substitution was wrongly reversed at pretyping level) *) Inductive Ind (A:Type) : let X:=A in forall Y:Type, let Z:=(X*Y)%type in Type := Constr : Ind A nat. Check fun x:Ind bool nat => match x in Ind _ X Y Z return Z with | Constr _ => (true,0) end. (* A vm_compute bug (the type of constructors was not supposed to contain local definitions before proper parameters) *) Inductive Ind2 (b:=1) (c:nat) : Type := Constr2 : Ind2 c. Eval vm_compute in Constr2 2. (* A bug introduced in ade2363 (similar to #5322 and #5324). This commit started to see that some List.rev was wrong in the "var" case of a pattern-matching problem but it failed to see that a transformation from a list of arguments into a substitution was still needed. *) (* The order of real arguments was made wrong by ade2363 in the "var" case of the compilation of "match" *) Inductive IND2 : forall X Y:Type, Type := CONSTR2 : IND2 unit Empty_set. Check fun x:IND2 bool nat => match x in IND2 a b return a with | y => _ end = true. (* From January 2017, using the proper function to turn arguments into a substitution up to a context possibly containing let-ins, so that the following, which was wrong also before ade2363, now works correctly *) Check fun x:Ind bool nat => match x in Ind _ X Y Z return Z with | y => (true,0) end. (* A check that multi-implicit arguments work *) Check fun x : {True}+{False} => match x with left _ _ => 0 | right _ _ => 1 end. Check fun x : {True}+{False} => match x with left _ => 0 | right _ => 1 end. (* Check that Asymmetric Patterns does not apply to the in clause *) Inductive expr {A} : A -> Type := intro : forall {n:nat} (a:A), n=n -> expr a. Check fun (x:expr true) => match x in expr n return n=n with intro _ _ => eq_refl end. Set Asymmetric Patterns. Check fun (x:expr true) => match x in expr n return n=n with intro _ a _ => eq_refl a end. Unset Asymmetric Patterns. coq-8.20.0/test-suite/success/Case3.v000066400000000000000000000013201466560755400173040ustar00rootroot00000000000000Inductive Le : nat -> nat -> Set := | LeO : forall n : nat, Le 0 n | LeS : forall n m : nat, Le n m -> Le (S n) (S m). Parameter discr_l : forall n : nat, S n <> 0. Type (fun n : nat => match n return (n = 0 \/ n <> 0) with | O => or_introl (0 <> 0) (refl_equal 0) | S O => or_intror (1 = 0) (discr_l 0) | S (S x) => or_intror (S (S x) = 0) (discr_l (S x)) end). Parameter iguales : forall (n m : nat) (h : Le n m), Prop. Type match LeO 0 as h in (Le n m) return Prop with | LeO O => True | LeS (S x) (S y) H => iguales (S x) (S y) H | _ => False end. Type match LeO 0 as h in (Le n m) return Prop with | LeO O => True | LeS (S x) O H => iguales (S x) 0 H | _ => False end. coq-8.20.0/test-suite/success/Case4.v000066400000000000000000000022611466560755400173120ustar00rootroot00000000000000Inductive listn : nat -> Set := | niln : listn 0 | consn : forall n : nat, nat -> listn n -> listn (S n). Inductive empty : forall n : nat, listn n -> Prop := intro_empty : empty 0 niln. Parameter inv_empty : forall (n a : nat) (l : listn n), ~ empty (S n) (consn n a l). Type (fun (n : nat) (l : listn n) => match l in (listn n) return (empty n l \/ ~ empty n l) with | niln => or_introl (~ empty 0 niln) intro_empty | consn n O y as b => or_intror (empty (S n) b) (inv_empty n 0 y) | consn n a y as b => or_intror (empty (S n) b) (inv_empty n a y) end). Type (fun (n : nat) (l : listn n) => match l in (listn n) return (empty n l \/ ~ empty n l) with | niln => or_introl (~ empty 0 niln) intro_empty | consn n O y => or_intror (empty (S n) (consn n 0 y)) (inv_empty n 0 y) | consn n a y => or_intror (empty (S n) (consn n a y)) (inv_empty n a y) end). Type (fun (n : nat) (l : listn n) => match l in (listn n) return (empty n l \/ ~ empty n l) with | niln => or_introl (~ empty 0 niln) intro_empty | consn O a y as b => or_intror (empty 1 b) (inv_empty 0 a y) | consn n a y as b => or_intror (empty (S n) b) (inv_empty n a y) end). coq-8.20.0/test-suite/success/Case5.v000066400000000000000000000005551466560755400173170ustar00rootroot00000000000000 Parameter ff : forall n m : nat, n <> m -> S n <> S m. Parameter discr_r : forall n : nat, 0 <> S n. Parameter discr_l : forall n : nat, S n <> 0. Type (fun n : nat => match n return (n = 0 \/ n <> 0) with | O => or_introl (0 <> 0) (refl_equal 0) | S O => or_intror (1 = 0) (discr_l 0) | S (S x) => or_intror (S (S x) = 0) (discr_l (S x)) end). coq-8.20.0/test-suite/success/Case6.v000066400000000000000000000011071466560755400173120ustar00rootroot00000000000000Parameter ff : forall n m : nat, n <> m -> S n <> S m. Parameter discr_r : forall n : nat, 0 <> S n. Parameter discr_l : forall n : nat, S n <> 0. Fixpoint eqdec (n m : nat) {struct n} : n = m \/ n <> m := match n, m return (n = m \/ n <> m) with | O, O => or_introl (0 <> 0) (refl_equal 0) | O, S x => or_intror (0 = S x) (discr_r x) | S x, O => or_intror _ (discr_l x) | S x as N, S y as M => match eqdec x y return (N = M \/ N <> M) with | or_introl h => or_introl (N <> M) (f_equal S h) | or_intror h => or_intror (N = M) (ff x y h) end end. coq-8.20.0/test-suite/success/Case7.v000066400000000000000000000007361466560755400173220ustar00rootroot00000000000000Inductive List (A : Set) : Set := | Nil : List A | Cons : A -> List A -> List A. Inductive Empty (A : Set) : List A -> Prop := intro_Empty : Empty A (Nil A). Parameter inv_Empty : forall (A : Set) (a : A) (x : List A), ~ Empty A (Cons A a x). Type (fun (A : Set) (l : List A) => match l return (Empty A l \/ ~ Empty A l) with | Nil _ => or_introl (~ Empty A (Nil A)) (intro_Empty A) | Cons _ a y as b => or_intror (Empty A b) (inv_Empty A a y) end). coq-8.20.0/test-suite/success/Case8.v000066400000000000000000000005221466560755400173140ustar00rootroot00000000000000(* Check dependencies in the matching predicate (was failing in V8.0pl1) *) Inductive t : forall x : 0 = 0, x = x -> Prop := c : forall x : 0 = 0, t x (refl_equal x). Definition a (x : t _ (refl_equal (refl_equal 0))) := match x return match x with | c y => Prop end with | c y => y = y end. coq-8.20.0/test-suite/success/Case9.v000066400000000000000000000043351466560755400173230ustar00rootroot00000000000000Inductive List (A : Set) : Set := | Nil : List A | Cons : A -> List A -> List A. Inductive eqlong : List nat -> List nat -> Prop := | eql_cons : forall (n m : nat) (x y : List nat), eqlong x y -> eqlong (Cons nat n x) (Cons nat m y) | eql_nil : eqlong (Nil nat) (Nil nat). Parameter V1 : eqlong (Nil nat) (Nil nat) \/ ~ eqlong (Nil nat) (Nil nat). Parameter V2 : forall (a : nat) (x : List nat), eqlong (Nil nat) (Cons nat a x) \/ ~ eqlong (Nil nat) (Cons nat a x). Parameter V3 : forall (a : nat) (x : List nat), eqlong (Cons nat a x) (Nil nat) \/ ~ eqlong (Cons nat a x) (Nil nat). Parameter V4 : forall (a : nat) (x : List nat) (b : nat) (y : List nat), eqlong (Cons nat a x) (Cons nat b y) \/ ~ eqlong (Cons nat a x) (Cons nat b y). Parameter nff : forall (n m : nat) (x y : List nat), ~ eqlong x y -> ~ eqlong (Cons nat n x) (Cons nat m y). Parameter inv_r : forall (n : nat) (x : List nat), ~ eqlong (Nil nat) (Cons nat n x). Parameter inv_l : forall (n : nat) (x : List nat), ~ eqlong (Cons nat n x) (Nil nat). Fixpoint eqlongdec (x y : List nat) {struct x} : eqlong x y \/ ~ eqlong x y := match x, y return (eqlong x y \/ ~ eqlong x y) with | Nil _, Nil _ => or_introl (~ eqlong (Nil nat) (Nil nat)) eql_nil | Nil _, Cons _ a x as L => or_intror (eqlong (Nil nat) L) (inv_r a x) | Cons _ a x as L, Nil _ => or_intror (eqlong L (Nil nat)) (inv_l a x) | Cons _ a x as L1, Cons _ b y as L2 => match eqlongdec x y return (eqlong L1 L2 \/ ~ eqlong L1 L2) with | or_introl h => or_introl (~ eqlong L1 L2) (eql_cons a b x y h) | or_intror h => or_intror (eqlong L1 L2) (nff a b x y h) end end. Type match Nil nat as x, Nil nat as y return (eqlong x y \/ ~ eqlong x y) with | Nil _, Nil _ => or_introl (~ eqlong (Nil nat) (Nil nat)) eql_nil | Nil _, Cons _ a x as L => or_intror (eqlong (Nil nat) L) (inv_r a x) | Cons _ a x as L, Nil _ => or_intror (eqlong L (Nil nat)) (inv_l a x) | Cons _ a x as L1, Cons _ b y as L2 => match eqlongdec x y return (eqlong L1 L2 \/ ~ eqlong L1 L2) with | or_introl h => or_introl (~ eqlong L1 L2) (eql_cons a b x y h) | or_intror h => or_intror (eqlong L1 L2) (nff a b x y h) end end. coq-8.20.0/test-suite/success/CaseAlias.v000066400000000000000000000050461466560755400202040ustar00rootroot00000000000000(*********************************************) (* This has been a bug reported by Y. Bertot *) Inductive expr : Set := | b : expr -> expr -> expr | u : expr -> expr | a : expr | var : nat -> expr. Fixpoint f (t : expr) : expr := match t with | b t1 t2 => b (f t1) (f t2) | a => a | x => b t a end. Fixpoint f2 (t : expr) : expr := match t with | b t1 t2 => b (f2 t1) (f2 t2) | a => a | x => b x a end. (*********************************************) (* Test expansion of aliases *) (* Originally taken from NMake_gen.v *) Local Notation SizePlus n := (S (S (S (S (S (S n)))))). Local Notation Size := (SizePlus O). Parameter zn2z : Type -> Type. Parameter w0 : Type. Fixpoint word (w : Type) (n : nat) {struct n} : Type := match n with | 0 => w | S n0 => zn2z (word w n0) end. Definition w1 := zn2z w0. Definition w2 := zn2z w1. Definition w3 := zn2z w2. Definition w4 := zn2z w3. Definition w5 := zn2z w4. Definition w6 := zn2z w5. Definition dom_t n := match n with | 0 => w0 | 1 => w1 | 2 => w2 | 3 => w3 | 4 => w4 | 5 => w5 | 6 => w6 | SizePlus n => word w6 n end. Parameter plus_t : forall n m : nat, word (dom_t n) m -> dom_t (m + n). (* This used to fail because of a bug in expansion of SizePlus wrongly reusing n as an alias for the subpattern *) Definition plus_t1 n : forall m, word (dom_t n) m -> dom_t (m+n) := match n return (forall m, word (dom_t n) m -> dom_t (m+n)) with | SizePlus (S n') as n => plus_t n | _ as n => fun m => match m return (word (dom_t n) m -> dom_t (m+n)) with | SizePlus (S (S m')) as m => plus_t n m | _ => fun x => x end end. (* Test (useless) intermediate alias *) Definition plus_t2 n : forall m, word (dom_t n) m -> dom_t (m+n) := match n return (forall m, word (dom_t n) m -> dom_t (m+n)) with | S (S (S (S (S (S (S n'))))) as n) as n'' => plus_t n'' | _ as n => fun m => match m return (word (dom_t n) m -> dom_t (m+n)) with | SizePlus (S (S m')) as m => plus_t n m | _ => fun x => x end end. (*****************************************************************************) (* Check that alias expansion behaves consistently from versions to versions *) Definition g m := match pred m with | 0 => 0 | n => n (* For compatibility, right-hand side should be (S n), not (pred m) *) end. Goal forall m, g m = match pred m with 0 => 0 | S n => S n end. intro; reflexivity. Abort. coq-8.20.0/test-suite/success/CaseCumul.v000066400000000000000000000003651466560755400202370ustar00rootroot00000000000000Inductive boolε : bool -> Type := | trueε : boolε true | falseε : boolε false. (* Check branch sort inference with implicit Prop ⊆ Type cumulativity *) Definition test (x : boolε true) := match x with | trueε => I | falseε => tt end. coq-8.20.0/test-suite/success/CaseInClause.v000066400000000000000000000017371466560755400206610ustar00rootroot00000000000000(* in clause pattern *) Require Vector. Check (fun n (x: Vector.t True (S n)) => match x in Vector.t _ (S m) return True with |Vector.cons _ h _ _ => h end). (* Notation *) Import Vector.VectorNotations. Notation "A \dots n" := (Vector.t A n) (at level 200). Check (fun m (x: Vector.t nat m) => match x in _ \dots k return Vector.t nat (S k) with | Vector.nil _ => 0 :: [] | Vector.cons _ h _ t => h :: h :: t end). (* N should be a variable and not the inductiveRef *) Require Import NArith. Theorem foo : forall (n m : nat) (pf : n = m), match pf in _ = N with | eq_refl => unit end. Abort. (* Check redundant clause is removed *) Inductive I : nat * nat -> Type := C : I (0,0). Check fun x : I (1,1) => match x in I (y,z) return y = z with C => eq_refl end. (* An example of non-local inference of the type of an impossible case *) Check (fun y n (x:Vector.t nat (S n)) => match x with a::_ => a | _ => y end) 2. coq-8.20.0/test-suite/success/Cases.v000066400000000000000000001226531466560755400174210ustar00rootroot00000000000000(****************************************************************************) (* Pattern-matching when non inductive terms occur *) (* Dependent form of annotation *) Type match 0 as n, @eq return nat with | O, x => 0 | S x, y => x end. Type match 0, 0, @eq return nat with | O, x, y => 0 | S x, y, z => x end. Type match 0, @eq, 0 return _ with | O, x, y => 0 | S x, y, z => x end. (* Non dependent form of annotation *) Type match 0, @eq return nat with | O, x => 0 | S x, y => x end. (* Combining dependencies and non inductive arguments *) Type (fun (A : Set) (a : A) (H : 0 = 0) => match H in (_ = x), a return (H = H) with | _, _ => refl_equal H end). (* Interaction with coercions *) Parameter bool2nat : bool -> nat. Coercion bool2nat : bool >-> nat. Definition foo : nat -> nat := fun x => match x with | O => true | S _ => 0 end. (****************************************************************************) (* All remaining examples come from Cristina Cornes' V6 TESTS/MultCases.v *) Inductive IFExpr : Set := | Var : nat -> IFExpr | Tr : IFExpr | Fa : IFExpr | IfE : IFExpr -> IFExpr -> IFExpr -> IFExpr. Inductive List (A : Set) : Set := | Nil : List A | Cons : A -> List A -> List A. Inductive listn : nat -> Set := | niln : listn 0 | consn : forall n : nat, nat -> listn n -> listn (S n). Inductive Listn (A : Set) : nat -> Set := | Niln : Listn A 0 | Consn : forall n : nat, nat -> Listn A n -> Listn A (S n). Inductive Le : nat -> nat -> Set := | LeO : forall n : nat, Le 0 n | LeS : forall n m : nat, Le n m -> Le (S n) (S m). Inductive LE (n : nat) : nat -> Set := | LE_n : LE n n | LE_S : forall m : nat, LE n m -> LE n (S m). Require Import Bool. Inductive PropForm : Set := | Fvar : nat -> PropForm | Or : PropForm -> PropForm -> PropForm. Section testIFExpr. Definition Assign := nat -> bool. Parameter Prop_sem : Assign -> PropForm -> bool. Type (fun (A : Assign) (F : PropForm) => match F return bool with | Fvar n => A n | Or F G => Prop_sem A F || Prop_sem A G end). Type (fun (A : Assign) (H : PropForm) => match H return bool with | Fvar n => A n | Or F G => Prop_sem A F || Prop_sem A G end). End testIFExpr. Type (fun x : nat => match x return nat with | O => 0 | x => x end). Module Type testlist. Parameter A : Set. Inductive list : Set := | nil : list | cons : A -> list -> list. Parameter inf : A -> A -> Prop. Definition list_Lowert2 (a : A) (l : list) := match l return Prop with | nil => True | cons b l => inf a b end. Definition titi (a : A) (l : list) := match l return list with | nil => l | cons b l => l end. End testlist. (* To test translation *) (* ------------------- *) Type match 0 return nat with | O => 0 | _ => 0 end. Type match 0 return nat with | O as b => b | S O => 0 | S (S x) => x end. Type match 0 with | O as b => b | S O => 0 | S (S x) => x end. Type (fun x : nat => match x return nat with | O as b => b | S x => x end). Type (fun x : nat => match x with | O as b => b | S x => x end). Type match 0 return nat with | O as b => b | S x => x end. Type match 0 return nat with | x => x end. Type match 0 with | x => x end. Type match 0 return nat with | O => 0 | S x as b => b end. Type (fun x : nat => match x return nat with | O => 0 | S x as b => b end). Type (fun x : nat => match x with | O => 0 | S x as b => b end). Type match 0 return nat with | O => 0 | S x => 0 end. Type match 0 return (nat * nat) with | O => (0, 0) | S x => (x, 0) end. Type match 0 with | O => (0, 0) | S x => (x, 0) end. Type match 0 return (nat -> nat) with | O => fun n : nat => 0 | S x => fun n : nat => 0 end. Type match 0 with | O => fun n : nat => 0 | S x => fun n : nat => 0 end. Type match 0 return (nat -> nat) with | O => fun n : nat => 0 | S x => fun n : nat => x + n end. Type match 0 with | O => fun n : nat => 0 | S x => fun n : nat => x + n end. Type match 0 return nat with | O => 0 | S x as b => b + x end. Type match 0 return nat with | O => 0 | S a as b => b + a end. Type match 0 with | O => 0 | S a as b => b + a end. Type match 0 with | O => 0 | _ => 0 end. Type match 0 return nat with | O => 0 | x => x end. Type match 0, 1 return nat with | x, y => x + y end. Type match 0, 1 with | x, y => x + y end. Type match 0, 1 return nat with | O, y => y | S x, y => x + y end. Type match 0, 1 with | O, y => y | S x, y => x + y end. Type match 0, 1 return nat with | O, x => x | S y, O => y | x, y => x + y end. Type match 0, 1 with | O, x => x + 0 | S y, O => y + 0 | x, y => x + y end. Type match 0, 1 return nat with | O, x => x + 0 | S y, O => y + 0 | x, y => x + y end. Type match 0, 1 return nat with | O, x => x | S x as b, S y => b + x + y | x, y => x + y end. Type match 0, 1 with | O, x => x | S x as b, S y => b + x + y | x, y => x + y end. Type (fun l : List nat => match l return (List nat) with | Nil _ => Nil nat | Cons _ a l => l end). Type (fun l : List nat => match l with | Nil _ => Nil nat | Cons _ a l => l end). Type match Nil nat return nat with | Nil _ => 0 | Cons _ a l => S a end. Type match Nil nat with | Nil _ => 0 | Cons _ a l => S a end. Type match Nil nat return (List nat) with | Cons _ a l => l | x => x end. Type match Nil nat with | Cons _ a l => l | x => x end. Type match Nil nat return (List nat) with | Nil _ => Nil nat | Cons _ a l => l end. Type match Nil nat with | Nil _ => Nil nat | Cons _ a l => l end. Type match 0 return nat with | O => 0 | S x => match Nil nat return nat with | Nil _ => x | Cons _ a l => x + a end end. Type match 0 with | O => 0 | S x => match Nil nat with | Nil _ => x | Cons _ a l => x + a end end. Type (fun y : nat => match y with | O => 0 | S x => match Nil nat with | Nil _ => x | Cons _ a l => x + a end end). Type match 0, Nil nat return nat with | O, x => 0 | S x, Nil _ => x | S x, Cons _ a l => x + a end. Type (fun (n : nat) (l : listn n) => match l return nat with | niln => 0 | x => 0 end). Type (fun (n : nat) (l : listn n) => match l with | niln => 0 | x => 0 end). Type match niln return nat with | niln => 0 | x => 0 end. Type match niln with | niln => 0 | x => 0 end. Type match niln return nat with | niln => 0 | consn n a l => a end. Type match niln with | niln => 0 | consn n a l => a end. Type match niln in (listn n) return nat with | consn m _ niln => m | _ => 1 end. Type (fun (n x : nat) (l : listn n) => match x, l return nat with | O, niln => 0 | y, x => 0 end). Type match 0, niln return nat with | O, niln => 0 | y, x => 0 end. Type match niln, 0 return nat with | niln, O => 0 | y, x => 0 end. Type match niln, 0 with | niln, O => 0 | y, x => 0 end. Type match niln, niln return nat with | niln, niln => 0 | x, y => 0 end. Type match niln, niln with | niln, niln => 0 | x, y => 0 end. Type match niln, niln, niln return nat with | niln, niln, niln => 0 | x, y, z => 0 end. Type match niln, niln, niln with | niln, niln, niln => 0 | x, y, z => 0 end. Type match niln return nat with | niln => 0 | consn n a l => 0 end. Type match niln with | niln => 0 | consn n a l => 0 end. Type match niln, niln return nat with | niln, niln => 0 | niln, consn n a l => n | consn n a l, x => a end. Type match niln, niln with | niln, niln => 0 | niln, consn n a l => n | consn n a l, x => a end. Type (fun (n : nat) (l : listn n) => match l return nat with | niln => 0 | x => 0 end). Type (fun (c : nat) (s : bool) => match c, s return nat with | O, _ => 0 | _, _ => c end). Type (fun (c : nat) (s : bool) => match c, s return nat with | O, _ => 0 | S _, _ => c end). (* Rows of pattern variables: some tricky cases *) Axioms (P : nat -> Prop) (f : forall n : nat, P n). Type (fun i : nat => match true, i as n return (P n) with | true, k => f k | _, k => f k end). Type (fun i : nat => match i as n, true return (P n) with | k, true => f k | k, _ => f k end). (* Nested Cases: the SYNTH of the Cases on n used to make Multcase believe * it has to synthesize the predicate on O (which he can't) *) Type match 0 as n return match n with | O => bool | S _ => nat end with | O => true | S _ => 0 end. Type (fun (n : nat) (l : listn n) => match l with | niln => 0 | x => 0 end). Type (fun (n : nat) (l : listn n) => match l return nat with | niln => 0 | consn n a niln => 0 | consn n a (consn m b l) => n + m end). Type (fun (n : nat) (l : listn n) => match l with | niln => 0 | consn n a niln => 0 | consn n a (consn m b l) => n + m end). Type (fun (n : nat) (l : listn n) => match l return nat with | niln => 0 | consn n a niln => 0 | consn n a (consn m b l) => n + m end). Type (fun (n : nat) (l : listn n) => match l with | niln => 0 | consn n a niln => 0 | consn n a (consn m b l) => n + m end). Type (fun (A : Set) (n : nat) (l : Listn A n) => match l return nat with | Niln _ => 0 | Consn _ n a (Niln _) => 0 | Consn _ n a (Consn _ m b l) => n + m end). Type (fun (A : Set) (n : nat) (l : Listn A n) => match l with | Niln _ => 0 | Consn _ n a (Niln _) => 0 | Consn _ n a (Consn _ m b l) => n + m end). Type (fun (A:Set) (n:nat) (l:Listn A n) => match l return Listn A O with | Niln _ as b => b | Consn _ n a (Niln _ as b) => (Niln A) | Consn _ n a (Consn _ m b l) => (Niln A) end). (* Type (fun (A:Set) (n:nat) (l:Listn A n) => match l with | Niln _ as b => b | Consn _ n a (Niln _ as b) => (Niln A) | Consn _ n a (Consn _ m b l) => (Niln A) end). *) Type (fun (A:Set) (n:nat) (l:Listn A n) => match l return Listn A (S 0) with | Niln _ as b => Consn A O O b | Consn _ n a (Niln _) as L => L | Consn _ n a _ => Consn A O O (Niln A) end). Type (fun (A:Set) (n:nat) (l:Listn A n) => match l return Listn A (S 0) with | Niln _ as b => Consn A O O b | Consn _ n a (Niln _) as L => L | Consn _ n a _ => Consn A O O (Niln A) end). (* To test treatment of as-patterns in depth *) Type (fun (A : Set) (l : List A) => match l with | Nil _ as b => Nil A | Cons _ a (Nil _) as L => L | Cons _ a (Cons _ b m) as L => L end). Type (fun (n : nat) (l : listn n) => match l return (listn n) with | niln => l | consn n a c => l end). Type (fun (n : nat) (l : listn n) => match l with | niln => l | consn n a c => l end). Type (fun (n : nat) (l : listn n) => match l return (listn n) with | niln as b => l | _ => l end). Type (fun (n : nat) (l : listn n) => match l with | niln as b => l | _ => l end). Type (fun (n : nat) (l : listn n) => match l return (listn n) with | niln as b => l | x => l end). Type (fun (A : Set) (n : nat) (l : Listn A n) => match l with | Niln _ as b => l | _ => l end). Type (fun (A : Set) (n : nat) (l : Listn A n) => match l return (Listn A n) with | Niln _ => l | Consn _ n a (Niln _) => l | Consn _ n a (Consn _ m b c) => l end). Type (fun (A : Set) (n : nat) (l : Listn A n) => match l with | Niln _ => l | Consn _ n a (Niln _) => l | Consn _ n a (Consn _ m b c) => l end). Type (fun (A : Set) (n : nat) (l : Listn A n) => match l return (Listn A n) with | Niln _ as b => l | Consn _ n a (Niln _ as b) => l | Consn _ n a (Consn _ m b _) => l end). Type (fun (A : Set) (n : nat) (l : Listn A n) => match l with | Niln _ as b => l | Consn _ n a (Niln _ as b) => l | Consn _ n a (Consn _ m b _) => l end). Type match niln return nat with | niln => 0 | consn n a niln => 0 | consn n a (consn m b l) => n + m end. Type match niln with | niln => 0 | consn n a niln => 0 | consn n a (consn m b l) => n + m end. Type match LeO 0 return nat with | LeO x => x | LeS n m h => n + m end. Type match LeO 0 with | LeO x => x | LeS n m h => n + m end. Type (fun (n : nat) (l : Listn nat n) => match l return nat with | Niln _ => 0 | Consn _ n a l => 0 end). Type (fun (n : nat) (l : Listn nat n) => match l with | Niln _ => 0 | Consn _ n a l => 0 end). Type match Niln nat with | Niln _ => 0 | Consn _ n a l => 0 end. Type match LE_n 0 return nat with | LE_n _ => 0 | LE_S _ m h => 0 end. Type match LE_n 0 with | LE_n _ => 0 | LE_S _ m h => 0 end. Type match LE_n 0 with | LE_n _ => 0 | LE_S _ m h => 0 end. Type match niln return nat with | niln => 0 | consn n a niln => n | consn n a (consn m b l) => n + m end. Type match niln with | niln => 0 | consn n a niln => n | consn n a (consn m b l) => n + m end. Type match Niln nat return nat with | Niln _ => 0 | Consn _ n a (Niln _ ) => n | Consn _ n a (Consn _ m b l) => n + m end. Type match Niln nat with | Niln _ => 0 | Consn _ n a (Niln _) => n | Consn _ n a (Consn _ m b l) => n + m end. Type match LeO 0 return nat with | LeO x => x | LeS n m (LeO x) => x + m | LeS n m (LeS x y h) => n + x end. Type match LeO 0 with | LeO x => x | LeS n m (LeO x) => x + m | LeS n m (LeS x y h) => n + x end. Type match LeO 0 return nat with | LeO x => x | LeS n m (LeO x) => x + m | LeS n m (LeS x y h) => m end. Type match LeO 0 with | LeO x => x | LeS n m (LeO x) => x + m | LeS n m (LeS x y h) => m end. Type (fun (n m : nat) (h : Le n m) => match h return nat with | LeO x => x | x => 0 end). Type (fun (n m : nat) (h : Le n m) => match h with | LeO x => x | x => 0 end). Type (fun (n m : nat) (h : Le n m) => match h return nat with | LeS n m h => n | x => 0 end). Type (fun (n m : nat) (h : Le n m) => match h with | LeS n m h => n | x => 0 end). Type (fun (n m : nat) (h : Le n m) => match h return (nat * nat) with | LeO n => (0, n) | LeS n m _ => (S n, S m) end). Type (fun (n m : nat) (h : Le n m) => match h with | LeO n => (0, n) | LeS n m _ => (S n, S m) end). Module Type F_v1. Fixpoint F (n m : nat) (h : Le n m) {struct h} : Le n (S m) := match h in (Le n m) return (Le n (S m)) with | LeO m' => LeO (S m') | LeS n' m' h' => LeS n' (S m') (F n' m' h') end. End F_v1. Module Type F_v2. Fixpoint F (n m : nat) (h : Le n m) {struct h} : Le n (S m) := match h in (Le n m) return (Le n (S m)) with | LeS n m h => LeS n (S m) (F n m h) | LeO m => LeO (S m) end. End F_v2. (* Rend la longueur de la liste *) Module Type L1. Definition length (n : nat) (l : listn n) := match l return nat with | consn n _ (consn m _ _) => S (S m) | consn n _ _ => 1 | _ => 0 end. End L1. Module Type L1'. Definition length (n : nat) (l : listn n) := match l with | consn n _ (consn m _ _) => S (S m) | consn n _ _ => 1 | _ => 0 end. End L1'. Module Type L2. Definition length (n : nat) (l : listn n) := match l return nat with | consn n _ (consn m _ _) => S (S m) | consn n _ _ => S n | _ => 0 end. End L2. Module Type L2'. Definition length (n : nat) (l : listn n) := match l with | consn n _ (consn m _ _) => S (S m) | consn n _ _ => S n | _ => 0 end. End L2'. Module Type L3. Definition length (n : nat) (l : listn n) := match l return nat with | consn n _ (consn m _ l) => S n | consn n _ _ => 1 | _ => 0 end. End L3. Module Type L3'. Definition length (n : nat) (l : listn n) := match l with | consn n _ (consn m _ l) => S n | consn n _ _ => 1 | _ => 0 end. End L3'. Type match LeO 0 return nat with | LeS n m h => n + m | x => 0 end. Type match LeO 0 with | LeS n m h => n + m | x => 0 end. Type (fun (n m : nat) (h : Le n m) => match h return nat with | LeO x => x | LeS n m (LeO x) => x + m | LeS n m (LeS x y h) => n + (m + (x + y)) end). Type (fun (n m : nat) (h : Le n m) => match h with | LeO x => x | LeS n m (LeO x) => x + m | LeS n m (LeS x y h) => n + (m + (x + y)) end). Type match LeO 0 return nat with | LeO x => x | LeS n m (LeO x) => x + m | LeS n m (LeS x y h) => n + (m + (x + y)) end. Type match LeO 0 with | LeO x => x | LeS n m (LeO x) => x + m | LeS n m (LeS x y h) => n + (m + (x + y)) end. Type match LE_n 0 return nat with | LE_n _ => 0 | LE_S _ m (LE_n _) => 0 + m | LE_S _ m (LE_S _ y h) => 0 + m end. Type match LE_n 0 with | LE_n _ => 0 | LE_S _ m (LE_n _) => 0 + m | LE_S _ m (LE_S _ y h) => 0 + m end. Type (fun (n m : nat) (h : Le n m) => match h with | x => x end). Type (fun (n m : nat) (h : Le n m) => match h return nat with | LeO n => n | x => 0 end). Type (fun (n m : nat) (h : Le n m) => match h with | LeO n => n | x => 0 end). Type (fun n : nat => match niln return (nat -> nat) with | niln => fun _ : nat => 0 | consn n a niln => fun _ : nat => 0 | consn n a (consn m b l) => fun _ : nat => n + m end). Type (fun n : nat => match niln with | niln => fun _ : nat => 0 | consn n a niln => fun _ : nat => 0 | consn n a (consn m b l) => fun _ : nat => n + m end). Type (fun (A : Set) (n : nat) (l : Listn A n) => match l return (nat -> nat) with | Niln _ => fun _ : nat => 0 | Consn _ n a (Niln _) => fun _ : nat => n | Consn _ n a (Consn _ m b l) => fun _ : nat => n + m end). Type (fun (A : Set) (n : nat) (l : Listn A n) => match l with | Niln _ => fun _ : nat => 0 | Consn _ n a (Niln _) => fun _ : nat => n | Consn _ n a (Consn _ m b l) => fun _ : nat => n + m end). (* Also tests for multiple _ patterns *) Type (fun (A : Set) (n : nat) (l : Listn A n) => match l in (Listn _ n) return (Listn A n) with | Niln _ as b => b | Consn _ _ _ _ as b => b end). (** This one was said to raised once an "Horrible error message!" *) Type (fun (A:Set) (n:nat) (l:Listn A n) => match l with | Niln _ as b => b | Consn _ _ _ _ as b => b end). Type match niln in (listn n) return (listn n) with | niln as b => b | consn _ _ _ as b => b end. Type match niln in (listn n) return (listn n) with | niln as b => b | x => x end. Type (fun (n m : nat) (h : LE n m) => match h return (nat -> nat) with | LE_n _ => fun _ : nat => n | LE_S _ m (LE_n _) => fun _ : nat => n + m | LE_S _ m (LE_S _ y h) => fun _ : nat => m + y end). Type (fun (n m : nat) (h : LE n m) => match h with | LE_n _ => fun _ : nat => n | LE_S _ m (LE_n _) => fun _ : nat => n + m | LE_S _ m (LE_S _ y h) => fun _ : nat => m + y end). Type (fun (n m : nat) (h : LE n m) => match h return nat with | LE_n _ => n | LE_S _ m (LE_n _) => n + m | LE_S _ m (LE_S _ y (LE_n _)) => n + m + y | LE_S _ m (LE_S _ y (LE_S _ y' h)) => n + m + (y + y') end). Type (fun (n m : nat) (h : LE n m) => match h with | LE_n _ => n | LE_S _ m (LE_n _) => n + m | LE_S _ m (LE_S _ y (LE_n _)) => n + m + y | LE_S _ m (LE_S _ y (LE_S _ y' h)) => n + m + (y + y') end). Type (fun (n m : nat) (h : LE n m) => match h return nat with | LE_n _ => n | LE_S _ m (LE_n _) => n + m | LE_S _ m (LE_S _ y h) => n + m + y end). Type (fun (n m : nat) (h : LE n m) => match h with | LE_n _ => n | LE_S _ m (LE_n _) => n + m | LE_S _ m (LE_S _ y h) => n + m + y end). Type (fun n m : nat => match LeO 0 return nat with | LeS n m h => n + m | x => 0 end). Type (fun n m : nat => match LeO 0 with | LeS n m h => n + m | x => 0 end). Parameter test : forall n : nat, {0 <= n} + {False}. Type (fun n : nat => match test n return nat with | left _ => 0 | _ => 0 end). Type (fun n : nat => match test n return nat with | left _ => 0 | _ => 0 end). Type (fun n : nat => match test n with | left _ => 0 | _ => 0 end). Parameter compare : forall n m : nat, {n < m} + {n = m} + {n > m}. Type match compare 0 0 return nat with (* k 0 (* k=i *) | inleft _ => 0 (* k>i *) | inright _ => 0 end. Type match compare 0 0 with (* k 0 (* k=i *) | inleft _ => 0 (* k>i *) | inright _ => 0 end. CoInductive SStream (A : Set) : (nat -> A -> Prop) -> Type := scons : forall (P : nat -> A -> Prop) (a : A), P 0 a -> SStream A (fun n : nat => P (S n)) -> SStream A P. Parameter B : Set. Type (fun (P : nat -> B -> Prop) (x : SStream B P) => match x return B with | scons _ _ a _ _ => a end). Type (fun (P : nat -> B -> Prop) (x : SStream B P) => match x with | scons _ _ a _ _ => a end). Type match (0, 0) return (nat * nat) with | (x, y) => (S x, S y) end. Type match (0, 0) return (nat * nat) with | (b, y) => (S b, S y) end. Type match (0, 0) return (nat * nat) with | (x, y) => (S x, S y) end. Type match (0, 0) with | (x, y) => (S x, S y) end. Type match (0, 0) with | (b, y) => (S b, S y) end. Type match (0, 0) with | (x, y) => (S x, S y) end. Module Type test_concat. Parameter concat : forall A : Set, List A -> List A -> List A. Type match Nil nat, Nil nat return (List nat) with | Nil _ as b, x => concat nat b x | Cons _ _ _ as d, Nil _ as c => concat nat d c | _, _ => Nil nat end. Type match Nil nat, Nil nat with | Nil _ as b, x => concat nat b x | Cons _ _ _ as d, Nil _ as c => concat nat d c | _, _ => Nil nat end. End test_concat. Inductive redexes : Set := | VAR : nat -> redexes | Fun : redexes -> redexes | Ap : bool -> redexes -> redexes -> redexes. Fixpoint regular (U : redexes) : Prop := match U return Prop with | VAR n => True | Fun V => regular V | Ap true (Fun _ as V) W => regular V /\ regular W | Ap true _ W => False | Ap false V W => regular V /\ regular W end. Type (fun n : nat => match n with | O => 0 | S (S n as V) => V | _ => 0 end). Parameter concat : forall n : nat, listn n -> forall m : nat, listn m -> listn (n + m). Type (fun (n : nat) (l : listn n) (m : nat) (l' : listn m) => match l in (listn n), l' return (listn (n + m)) with | niln, x => x | consn n a l'', x => consn (n + m) a (concat n l'' m x) end). Type (fun (x y z : nat) (H : x = y) (H0 : y = z) => match H return (x = z) with | refl_equal => match H0 in (_ = n) return (x = n) with | refl_equal => H end end). Type (fun h : False => match h return False with end). Type (fun h : False => match h return True with end). Definition is_zero (n : nat) := match n with | O => True | _ => False end. Type (fun (n : nat) (h : 0 = S n) => match h in (_ = n) return (is_zero n) with | refl_equal => I end). Definition disc (n : nat) (h : 0 = S n) : False := match h in (_ = n) return (is_zero n) with | refl_equal => I end. Definition nlength3 (n : nat) (l : listn n) := match l with | niln => 0 | consn O _ _ => 1 | consn (S n) _ _ => S (S n) end. (* == Testing strategy elimintation predicate synthesis == *) Section titi. Variable h : False. Type match 0 with | O => 0 | _ => except h end. End titi. Type match niln with | consn _ a niln => a | consn n _ x => 0 | niln => 0 end. Inductive wsort : Set := | ws : wsort | wt : wsort. Inductive TS : wsort -> Set := | id : TS ws | lift : TS ws -> TS ws. Type (fun (b : wsort) (M N : TS b) => match M, N with | lift M1, id => False | _, _ => True end). (* ===================================================================== *) (* To test pattern matching over a non-dependent inductive type, but *) (* having constructors with some arguments that depend on others *) (* I.e. to test manipulation of elimination predicate *) (* ===================================================================== *) Module Type test_term. Parameter LTERM : nat -> Set. Inductive TERM : Type := | var : TERM | oper : forall op : nat, LTERM op -> TERM. Parameter t1 t2 : TERM. Type match t1, t2 with | var, var => True | oper op1 l1, oper op2 l2 => False | _, _ => False end. End test_term. Require Import Peano_dec. Parameter n : nat. Definition eq_prf := exists m : _, n = m. Parameter p : eq_prf. Type match p with | ex_intro _ c eqc => match eq_nat_dec c n with | right _ => refl_equal n | left y => (* c=n*) refl_equal n end end. Parameter ordre_total : nat -> nat -> Prop. Parameter N_cla : forall N : nat, {N = 0} + {N = 1} + {N >= 2}. Parameter exist_U2 : forall N : nat, N >= 2 -> {n : nat | forall m : nat, 0 < m /\ m <= N /\ ordre_total n m /\ 0 < n /\ n < N}. Type (fun N : nat => match N_cla N with | inright H => match exist_U2 N H with | exist _ a b => a end | _ => 0 end). (* ============================================== *) (* To test compilation of dependent case *) (* Nested patterns *) (* ============================================== *) (* == To test that terms named with AS are correctly absolutized before substitution in rhs == *) Type (fun n : nat => match n return nat with | O => 0 | S O => 0 | S (S n1) as N => N end). (* ========= *) Type match niln in (listn n) return Prop with | niln => True | consn (S O) _ _ => False | _ => True end. Type match niln in (listn n) return Prop with | niln => True | consn (S (S O)) _ _ => False | _ => True end. Type match LeO 0 as h in (Le n m) return nat with | LeO _ => 0 | LeS (S x) _ _ => x | _ => 1 end. Type match LeO 0 as h in (Le n m) return nat with | LeO _ => 0 | LeS (S x) (S y) _ => x | _ => 1 end. Type match LeO 0 as h in (Le n m) return nat with | LeO _ => 0 | LeS (S x as b) (S y) _ => b | _ => 1 end. Module Type ff. Parameter ff : forall n m : nat, n <> m -> S n <> S m. Parameter discr_r : forall n : nat, 0 <> S n. Parameter discr_l : forall n : nat, S n <> 0. Type (fun n : nat => match n return (n = 0 \/ n <> 0) with | O => or_introl (0 <> 0) (refl_equal 0) | S x => or_intror (S x = 0) (discr_l x) end). Module Type eqdec. Fixpoint eqdec (n m : nat) {struct n} : n = m \/ n <> m := match n, m return (n = m \/ n <> m) with | O, O => or_introl (0 <> 0) (refl_equal 0) | O, S x => or_intror (0 = S x) (discr_r x) | S x, O => or_intror _ (discr_l x) | S x, S y => match eqdec x y return (S x = S y \/ S x <> S y) with | or_introl h => or_introl (S x <> S y) (f_equal S h) | or_intror h => or_intror (S x = S y) (ff x y h) end end. End eqdec. Module Type eqdec'. Fixpoint eqdec (n : nat) : forall m : nat, n = m \/ n <> m := match n return (forall m : nat, n = m \/ n <> m) with | O => fun m : nat => match m return (0 = m \/ 0 <> m) with | O => or_introl (0 <> 0) (refl_equal 0) | S x => or_intror (0 = S x) (discr_r x) end | S x => fun m : nat => match m return (S x = m \/ S x <> m) with | O => or_intror (S x = 0) (discr_l x) | S y => match eqdec x y return (S x = S y \/ S x <> S y) with | or_introl h => or_introl (S x <> S y) (f_equal S h) | or_intror h => or_intror (S x = S y) (ff x y h) end end end. End eqdec'. Inductive empty : forall n : nat, listn n -> Prop := intro_empty : empty 0 niln. Parameter inv_empty : forall (n a : nat) (l : listn n), ~ empty (S n) (consn n a l). Type (fun (n : nat) (l : listn n) => match l in (listn n) return (empty n l \/ ~ empty n l) with | niln => or_introl (~ empty 0 niln) intro_empty | consn n a y as b => or_intror (empty (S n) b) (inv_empty n a y) end). End ff. Module Type ff'. Parameter ff : forall n m : nat, n <> m -> S n <> S m. Parameter discr_r : forall n : nat, 0 <> S n. Parameter discr_l : forall n : nat, S n <> 0. Type (fun n : nat => match n return (n = 0 \/ n <> 0) with | O => or_introl (0 <> 0) (refl_equal 0) | S x => or_intror (S x = 0) (discr_l x) end). Module Type eqdec. Fixpoint eqdec (n m : nat) {struct n} : n = m \/ n <> m := match n, m return (n = m \/ n <> m) with | O, O => or_introl (0 <> 0) (refl_equal 0) | O, S x => or_intror (0 = S x) (discr_r x) | S x, O => or_intror _ (discr_l x) | S x, S y => match eqdec x y return (S x = S y \/ S x <> S y) with | or_introl h => or_introl (S x <> S y) (f_equal S h) | or_intror h => or_intror (S x = S y) (ff x y h) end end. End eqdec. Module Type eqdec'. Fixpoint eqdec (n : nat) : forall m : nat, n = m \/ n <> m := match n return (forall m : nat, n = m \/ n <> m) with | O => fun m : nat => match m return (0 = m \/ 0 <> m) with | O => or_introl (0 <> 0) (refl_equal 0) | S x => or_intror (0 = S x) (discr_r x) end | S x => fun m : nat => match m return (S x = m \/ S x <> m) with | O => or_intror (S x = 0) (discr_l x) | S y => match eqdec x y return (S x = S y \/ S x <> S y) with | or_introl h => or_introl (S x <> S y) (f_equal S h) | or_intror h => or_intror (S x = S y) (ff x y h) end end end. End eqdec'. End ff'. (* ================================================== *) (* Pour tester parametres *) (* ================================================== *) Inductive Empty (A : Set) : List A -> Prop := intro_Empty : Empty A (Nil A). Parameter inv_Empty : forall (A : Set) (a : A) (x : List A), ~ Empty A (Cons A a x). Type match Nil nat as l return (Empty nat l \/ ~ Empty nat l) with | Nil _ => or_introl (~ Empty nat (Nil nat)) (intro_Empty nat) | Cons _ a y => or_intror (Empty nat (Cons nat a y)) (inv_Empty nat a y) end. (* ================================================== *) (* Sur les listes *) (* ================================================== *) Inductive empty : forall n : nat, listn n -> Prop := intro_empty : empty 0 niln. Parameter inv_empty : forall (n a : nat) (l : listn n), ~ empty (S n) (consn n a l). Type (fun (n : nat) (l : listn n) => match l in (listn n) return (empty n l \/ ~ empty n l) with | niln => or_introl (~ empty 0 niln) intro_empty | consn n a y as b => or_intror (empty (S n) b) (inv_empty n a y) end). (* ===================================== *) (* Test parametros: *) (* ===================================== *) Inductive eqlong : List nat -> List nat -> Prop := | eql_cons : forall (n m : nat) (x y : List nat), eqlong x y -> eqlong (Cons nat n x) (Cons nat m y) | eql_nil : eqlong (Nil nat) (Nil nat). Parameter V1 : eqlong (Nil nat) (Nil nat) \/ ~ eqlong (Nil nat) (Nil nat). Parameter V2 : forall (a : nat) (x : List nat), eqlong (Nil nat) (Cons nat a x) \/ ~ eqlong (Nil nat) (Cons nat a x). Parameter V3 : forall (a : nat) (x : List nat), eqlong (Cons nat a x) (Nil nat) \/ ~ eqlong (Cons nat a x) (Nil nat). Parameter V4 : forall (a : nat) (x : List nat) (b : nat) (y : List nat), eqlong (Cons nat a x) (Cons nat b y) \/ ~ eqlong (Cons nat a x) (Cons nat b y). Type match Nil nat as x, Nil nat as y return (eqlong x y \/ ~ eqlong x y) with | Nil _, Nil _ => V1 | Nil _, Cons _ a x => V2 a x | Cons _ a x, Nil _ => V3 a x | Cons _ a x, Cons _ b y => V4 a x b y end. Type (fun x y : List nat => match x, y return (eqlong x y \/ ~ eqlong x y) with | Nil _, Nil _ => V1 | Nil _, Cons _ a x => V2 a x | Cons _ a x, Nil _ => V3 a x | Cons _ a x, Cons _ b y => V4 a x b y end). (* ===================================== *) Inductive Eqlong : forall n : nat, listn n -> forall m : nat, listn m -> Prop := | Eql_cons : forall (n m : nat) (x : listn n) (y : listn m) (a b : nat), Eqlong n x m y -> Eqlong (S n) (consn n a x) (S m) (consn m b y) | Eql_niln : Eqlong 0 niln 0 niln. Parameter W1 : Eqlong 0 niln 0 niln \/ ~ Eqlong 0 niln 0 niln. Parameter W2 : forall (n a : nat) (x : listn n), Eqlong 0 niln (S n) (consn n a x) \/ ~ Eqlong 0 niln (S n) (consn n a x). Parameter W3 : forall (n a : nat) (x : listn n), Eqlong (S n) (consn n a x) 0 niln \/ ~ Eqlong (S n) (consn n a x) 0 niln. Parameter W4 : forall (n a : nat) (x : listn n) (m b : nat) (y : listn m), Eqlong (S n) (consn n a x) (S m) (consn m b y) \/ ~ Eqlong (S n) (consn n a x) (S m) (consn m b y). Type match niln as x in (listn n), niln as y in (listn m) return (Eqlong n x m y \/ ~ Eqlong n x m y) with | niln, niln => W1 | niln, consn n a x => W2 n a x | consn n a x, niln => W3 n a x | consn n a x, consn m b y => W4 n a x m b y end. Type (fun (n m : nat) (x : listn n) (y : listn m) => match x in (listn n), y in (listn m) return (Eqlong n x m y \/ ~ Eqlong n x m y) with | niln, niln => W1 | niln, consn n a x => W2 n a x | consn n a x, niln => W3 n a x | consn n a x, consn m b y => W4 n a x m b y end). Parameter Inv_r : forall (n a : nat) (x : listn n), ~ Eqlong 0 niln (S n) (consn n a x). Parameter Inv_l : forall (n a : nat) (x : listn n), ~ Eqlong (S n) (consn n a x) 0 niln. Parameter Nff : forall (n a : nat) (x : listn n) (m b : nat) (y : listn m), ~ Eqlong n x m y -> ~ Eqlong (S n) (consn n a x) (S m) (consn m b y). Fixpoint Eqlongdec (n : nat) (x : listn n) (m : nat) (y : listn m) {struct x} : Eqlong n x m y \/ ~ Eqlong n x m y := match x in (listn n), y in (listn m) return (Eqlong n x m y \/ ~ Eqlong n x m y) with | niln, niln => or_introl (~ Eqlong 0 niln 0 niln) Eql_niln | niln, consn n a x as L => or_intror (Eqlong 0 niln (S n) L) (Inv_r n a x) | consn n a x as L, niln => or_intror (Eqlong (S n) L 0 niln) (Inv_l n a x) | consn n a x as L1, consn m b y as L2 => match Eqlongdec n x m y return (Eqlong (S n) L1 (S m) L2 \/ ~ Eqlong (S n) L1 (S m) L2) with | or_introl h => or_introl (~ Eqlong (S n) L1 (S m) L2) (Eql_cons n m x y a b h) | or_intror h => or_intror (Eqlong (S n) L1 (S m) L2) (Nff n a x m b y h) end end. (* ============================================== *) (* To test compilation of dependent case *) (* Multiple Patterns *) (* ============================================== *) Inductive skel : Type := | PROP : skel | PROD : skel -> skel -> skel. Parameter Can : skel -> Type. Parameter default_can : forall s : skel, Can s. Type (fun s1 s2 s1 s2 : skel => match s1, s2 return (Can s1) with | PROP, PROP => default_can PROP | PROD x y, PROP => default_can (PROD x y) | PROD x y, _ => default_can (PROD x y) | PROP, _ => default_can PROP end). (* to test bindings in nested Cases *) (* ================================ *) Inductive Pair : Set := | pnil : Pair | pcons : Pair -> Pair -> Pair. Type (fun p q : Pair => match p with | pcons _ x => match q with | pcons _ (pcons _ x) => True | _ => False end | _ => False end). Type (fun p q : Pair => match p with | pcons _ x => match q with | pcons _ (pcons _ x) => match q with | pcons _ (pcons _ (pcons _ x)) => x | _ => pnil end | _ => pnil end | _ => pnil end). Type (fun (n : nat) (l : listn (S n)) => match l in (listn z) return (listn (pred z)) with | niln => niln | consn n _ l => match l in (listn m) return (listn m) with | niln => niln | b => b end end). (* Test de la syntaxe avec nombres *) Require Import Arith. Type (fun n => match n with | S (S O) => true | _ => false end). Require Import ZArith. Type (fun n => match n with | Z0 => true | _ => false end). (* Check that types with unknown sort, as A below, are not fatal to the pattern-matching compilation *) Definition transport {A} (P : A->Type) {x y : A} (p : x=y) (u : P x) : P y := match p with eq_refl => u end. (* Check in-pattern clauses with constant constructors, which were previously interpreted as variables (before 8.5) *) Check match eq_refl 0 in _=O return O=O with eq_refl => eq_refl end. Check match niln in listn O return O=O with niln => eq_refl end. (* A test about nested "as" clauses *) (* (was failing up to May 2017) *) Check fun x => match x with (y,z) as t as w => (y+z,t) = (0,w) end. (* A test about binding variables of "in" clause of "match" *) (* (was failing from 8.5 to Dec 2018) *) Check match O in nat return nat with O => O | _ => O end. (* Checking that aliases are substituted in the correct order *) Check match eq_refl (1,0) in _ = (y as z, y' as z) return z = z with eq_refl => eq_refl end : 0=0. (* Checking use of argument scopes *) Module Intern. Inductive I (A:Type) := C : nat -> let a:=0 in bool -> list bool -> bool -> I A. Close Scope nat_scope. Notation "0" := true : bool_scope. Notation "0" := nil : list_scope. Notation C' := @C (only parsing). Notation C'' := C (only parsing). Notation C''' := (C _ 0) (only parsing). Set Asymmetric Patterns. Check fun x => match x with C 0 0 0 0 => O | _ => O end. (* 8.5 regression *) Check fun x => match x with C 0 _ 0 0 0 => O | _ => O end. (* was not supported *) Check fun x => match x with C' 0 0 0 0 => O | _ => O end. (* 8.5 regression *) Check fun x => match x with C' _ 0 0 0 => O | _ => O end. (* 8.5 regression *) Check fun x => match x with C' 0 _ 0 0 0 => O | _ => O end. (* was not supported *) Check fun x => match x with C' _ _ 0 0 0 => O | _ => O end. (* was pre 8.5 bug *) Check fun x => match x with C'' 0 0 0 0 => O | _ => O end. (* 8.5 regression *) Check fun x => match x with C'' _ 0 0 0 => O | _ => O end. (* 8.5 regression *) Check fun x => match x with C'' 0 _ 0 0 0 => O | _ => O end. (* was not supported *) Check fun x => match x with C'' _ _ 0 0 0 => O | _ => O end. (* was pre 8.5 bug *) Check fun x => match x with C''' 0 0 0 => O | _ => O end. (* 8.5 regression *) Check fun x => match x with C''' _ 0 0 0 => O | _ => O end. (* was not supported *) Unset Asymmetric Patterns. Arguments C {A} _ {x} _ _. Check fun x => match x with C 0 0 0 => O | _ => O end. (* was ok *) Check fun x => match x with C 0 _ 0 0 => O | _ => O end. (* was wrong scope on last argument with let-in *) Check fun x => match x with C' _ 0 _ 0 0 => O | _ => O end. (* was wrong scope *) Check fun x => match x with C' _ 0 _ 0 0 0 => O | _ => O end. (* was wrong scope *) Check fun x => match x with C'' _ 0 0 => O | _ => O end. (* was ok *) Check fun x => match x with C'' _ _ 0 0 => O | _ => O end. (* was wrong scope *) Check fun x => match x with C''' 0 0 => O | _ => O end. (* was wrong scope *) Check fun x => match x with C''' _ 0 0 => O | _ => O end. (* works by miscount compensating *) Check fun x => match x with (@C _ 0) _ 0 0 => O | _ => O end. (* was wrong scope *) Check fun x => match x with (@C _ 0) _ _ 0 0 => O | _ => O end. (* was wrong scope *) Check fun x => match x with @C _ 0 _ 0 0 => O | _ => O end. (* was ok *) Check fun x => match x with @C _ 0 _ _ 0 0 => O | _ => O end. (* was wrong scope *) Check fun x => match x with (@C) _ O _ 0 0 => O | _ => O end. (* was wrong scope *) Check fun x => match x with (@C) _ O _ _ 0 0 => O | _ => O end. (* was wrong scope *) End Intern. coq-8.20.0/test-suite/success/CasesDep.v000066400000000000000000000342601466560755400200460ustar00rootroot00000000000000(* Check forward dependencies *) Check (fun (P : nat -> Prop) Q (A : P 0 -> Q) (B : forall n : nat, P (S n) -> Q) x => match x return Q with | exist _ O H => A H | exist _ (S n) H => B n H end). (* Check dependencies in anonymous arguments (from FTA/listn.v) *) Inductive listn (A : Set) : nat -> Set := | niln : listn A 0 | consn : forall (a : A) (n : nat), listn A n -> listn A (S n). Section Folding. Variable B C : Set. Variable g : B -> C -> C. Variable c : C. Fixpoint foldrn (n : nat) (bs : listn B n) {struct bs} : C := match bs with | niln _ => c | consn _ b _ tl => g b (foldrn _ tl) end. End Folding. (** Testing post-processing of nested dependencies *) Check fun x:{x|x=0}*nat+nat => match x with | inl ((exist _ 0 eq_refl),0) => None | _ => Some 0 end. Check fun x:{_:{x|x=0}|True}+nat => match x with | inl (exist _ (exist _ 0 eq_refl) I) => None | _ => Some 0 end. Check fun x:{_:{x|x=0}|True}+nat => match x with | inl (exist _ (exist _ 0 eq_refl) I) => None | _ => Some 0 end. Check fun x:{_:{x|x=0}|True}+nat => match x return option nat with | inl (exist _ (exist _ 0 eq_refl) I) => None | _ => Some 0 end. (* the next two examples were failing from r14703 (Nov 22 2011) to r14732 *) (* due to a bug in dependencies postprocessing (revealed by CoLoR) *) Check fun x:{x:nat*nat|fst x = 0 & True} => match x return option nat with | exist2 _ _ (x,y) eq_refl I => None end. Check fun x:{_:{x:nat*nat|fst x = 0 & True}|True}+nat => match x return option nat with | inl (exist _ (exist2 _ _ (x,y) eq_refl I) I) => None | _ => Some 0 end. (* -------------------------------------------------------------------- *) (* Example to test patterns matching on dependent families *) (* This exemple extracted from the development done by Nacira Chabane *) (* (equipe Paris 6) *) (* -------------------------------------------------------------------- *) Require Import Prelude. Section Orderings. Variable U : Type. Definition Relation := U -> U -> Prop. Variable R : Relation. Definition Reflexive : Prop := forall x : U, R x x. Definition Transitive : Prop := forall x y z : U, R x y -> R y z -> R x z. Definition Symmetric : Prop := forall x y : U, R x y -> R y x. Definition Antisymmetric : Prop := forall x y : U, R x y -> R y x -> x = y. Definition contains (R R' : Relation) : Prop := forall x y : U, R' x y -> R x y. Definition same_relation (R R' : Relation) : Prop := contains R R' /\ contains R' R. Inductive Equivalence : Prop := Build_Equivalence : Reflexive -> Transitive -> Symmetric -> Equivalence. Inductive PER : Prop := Build_PER : Symmetric -> Transitive -> PER. End Orderings. (***** Setoid *******) Inductive Setoid : Type := Build_Setoid : forall (S : Type) (R : Relation S), Equivalence _ R -> Setoid. Definition elem (A : Setoid) := let (S, R, e) := A in S. Definition equal (A : Setoid) := let (S, R, e) as s return (Relation (elem s)) := A in R. Axiom prf_equiv : forall A : Setoid, Equivalence (elem A) (equal A). Axiom prf_refl : forall A : Setoid, Reflexive (elem A) (equal A). Axiom prf_sym : forall A : Setoid, Symmetric (elem A) (equal A). Axiom prf_trans : forall A : Setoid, Transitive (elem A) (equal A). Section Maps. Variable A B : Setoid. Definition Map_law (f : elem A -> elem B) := forall x y : elem A, equal _ x y -> equal _ (f x) (f y). Inductive Map : Type := Build_Map : forall (f : elem A -> elem B) (p : Map_law f), Map. Definition explicit_ap (m : Map) := match m return (elem A -> elem B) with | Build_Map f p => f end. Axiom pres : forall m : Map, Map_law (explicit_ap m). Definition ext (f g : Map) := forall x : elem A, equal _ (explicit_ap f x) (explicit_ap g x). Axiom Equiv_map_eq : Equivalence Map ext. Definition Map_setoid := Build_Setoid Map ext Equiv_map_eq. End Maps. Notation ap := (explicit_ap _ _). (* : Grammar is replaced by Notation *) Definition ap2 (A B C : Setoid) (f : elem (Map_setoid A (Map_setoid B C))) (a : elem A) := ap (ap f a). (***** posint ******) Inductive posint : Type := | Z : posint | Suc : posint -> posint. Axiom f_equal : forall (A B : Type) (f : A -> B) (x y : A), x = y -> f x = f y. Axiom eq_Suc : forall n m : posint, n = m -> Suc n = Suc m. (* The predecessor function *) Definition pred (n : posint) : posint := match n return posint with | Z => (* Z *) Z (* Suc u *) | Suc u => u end. Axiom pred_Sucn : forall m : posint, m = pred (Suc m). Axiom eq_add_Suc : forall n m : posint, Suc n = Suc m -> n = m. Axiom not_eq_Suc : forall n m : posint, n <> m -> Suc n <> Suc m. Definition IsSuc (n : posint) : Prop := match n return Prop with | Z => (* Z *) False (* Suc p *) | Suc p => True end. Definition IsZero (n : posint) : Prop := match n with | Z => True | Suc _ => False end. Axiom Z_Suc : forall n : posint, Z <> Suc n. Axiom Suc_Z : forall n : posint, Suc n <> Z. Axiom n_Sucn : forall n : posint, n <> Suc n. Axiom Sucn_n : forall n : posint, Suc n <> n. Axiom eqT_symt : forall a b : posint, a <> b -> b <> a. (******* Dsetoid *****) Definition Decidable (A : Type) (R : Relation A) := forall x y : A, R x y \/ ~ R x y. Record DSetoid : Type := {Set_of : Setoid; prf_decid : Decidable (elem Set_of) (equal Set_of)}. (* example de Dsetoide d'entiers *) Axiom eqT_equiv : Equivalence posint (eq (A:=posint)). Axiom Eq_posint_deci : Decidable posint (eq (A:=posint)). (* Dsetoide des posint*) Definition Set_of_posint := Build_Setoid posint (eq (A:=posint)) eqT_equiv. Definition Dposint := Build_DSetoid Set_of_posint Eq_posint_deci. (**************************************) (* Definition des signatures *) (* une signature est un ensemble d'operateurs muni de l'arite de chaque operateur *) Module Sig. Record Signature : Type := {Sigma : DSetoid; Arity : Map (Set_of Sigma) (Set_of Dposint)}. Parameter S : Signature. Parameter Var : DSetoid. Inductive TERM : Type := | var : elem (Set_of Var) -> TERM | oper : forall op : elem (Set_of (Sigma S)), LTERM (ap (Arity S) op) -> TERM with LTERM : posint -> Type := | nil : LTERM Z | cons : TERM -> forall n : posint, LTERM n -> LTERM (Suc n). (* -------------------------------------------------------------------- *) (* Examples *) (* -------------------------------------------------------------------- *) Parameter t1 t2 : TERM. Type match t1, t2 with | var v1, var v2 => True | oper op1 l1, oper op2 l2 => False | _, _ => False end. Parameter n2 : posint. Parameter l1 l2 : LTERM n2. Type match l1, l2 with | nil, nil => True | cons v m y, nil => False | _, _ => False end. Type match l1, l2 with | nil, nil => True | cons u n x, cons v m y => False | _, _ => False end. Module Type Version1. Definition equalT (t1 t2 : TERM) : Prop := match t1, t2 with | var v1, var v2 => True | oper op1 l1, oper op2 l2 => False | _, _ => False end. Definition EqListT (n1 : posint) (l1 : LTERM n1) (n2 : posint) (l2 : LTERM n2) : Prop := match l1, l2 with | nil, nil => True | cons t1 n1' l1', cons t2 n2' l2' => False | _, _ => False end. End Version1. (* ------------------------------------------------------------------*) (* Initial example (without patterns) *) (*-------------------------------------------------------------------*) Module Version2. Fixpoint equalT (t1 : TERM) : TERM -> Prop := match t1 return (TERM -> Prop) with | var v1 => (*var*) fun t2 : TERM => match t2 return Prop with | var v2 => (*var*) equal _ v1 v2 (*oper*) | oper op2 _ => False end (*oper*) | oper op1 l1 => fun t2 : TERM => match t2 return Prop with | var v2 => (*var*) False (*oper*) | oper op2 l2 => equal _ op1 op2 /\ EqListT (ap (Arity S) op1) l1 (ap (Arity S) op2) l2 end end with EqListT (n1 : posint) (l1 : LTERM n1) {struct l1} : forall n2 : posint, LTERM n2 -> Prop := match l1 in (LTERM _) return (forall n2 : posint, LTERM n2 -> Prop) with | nil => (*nil*) fun (n2 : posint) (l2 : LTERM n2) => match l2 in (LTERM _) return Prop with | nil => (*nil*) True (*cons*) | cons t2 n2' l2' => False end (*cons*) | cons t1 n1' l1' => fun (n2 : posint) (l2 : LTERM n2) => match l2 in (LTERM _) return Prop with | nil => (*nil*) False (*cons*) | cons t2 n2' l2' => equalT t1 t2 /\ EqListT n1' l1' n2' l2' end end. End Version2. (* ---------------------------------------------------------------- *) (* Version with simple patterns *) (* ---------------------------------------------------------------- *) Module Version3. Fixpoint equalT (t1 : TERM) : TERM -> Prop := match t1 with | var v1 => fun t2 : TERM => match t2 with | var v2 => equal _ v1 v2 | oper op2 _ => False end | oper op1 l1 => fun t2 : TERM => match t2 with | var _ => False | oper op2 l2 => equal _ op1 op2 /\ EqListT (ap (Arity S) op1) l1 (ap (Arity S) op2) l2 end end with EqListT (n1 : posint) (l1 : LTERM n1) {struct l1} : forall n2 : posint, LTERM n2 -> Prop := match l1 return (forall n2 : posint, LTERM n2 -> Prop) with | nil => fun (n2 : posint) (l2 : LTERM n2) => match l2 with | nil => True | _ => False end | cons t1 n1' l1' => fun (n2 : posint) (l2 : LTERM n2) => match l2 with | nil => False | cons t2 n2' l2' => equalT t1 t2 /\ EqListT n1' l1' n2' l2' end end. End Version3. Module Version4. Fixpoint equalT (t1 : TERM) : TERM -> Prop := match t1 with | var v1 => fun t2 : TERM => match t2 with | var v2 => equal _ v1 v2 | oper op2 _ => False end | oper op1 l1 => fun t2 : TERM => match t2 with | var _ => False | oper op2 l2 => equal _ op1 op2 /\ EqListT (ap (Arity S) op1) l1 (ap (Arity S) op2) l2 end end with EqListT (n1 : posint) (l1 : LTERM n1) (n2 : posint) (l2 : LTERM n2) {struct l1} : Prop := match l1 with | nil => match l2 with | nil => True | _ => False end | cons t1 n1' l1' => match l2 with | nil => False | cons t2 n2' l2' => equalT t1 t2 /\ EqListT n1' l1' n2' l2' end end. End Version4. (* ---------------------------------------------------------------- *) (* Version with multiple patterns *) (* ---------------------------------------------------------------- *) Module Version5. Fixpoint equalT (t1 t2 : TERM) {struct t1} : Prop := match t1, t2 with | var v1, var v2 => equal _ v1 v2 | oper op1 l1, oper op2 l2 => equal _ op1 op2 /\ EqListT (ap (Arity S) op1) l1 (ap (Arity S) op2) l2 | _, _ => False end with EqListT (n1 : posint) (l1 : LTERM n1) (n2 : posint) (l2 : LTERM n2) {struct l1} : Prop := match l1, l2 with | nil, nil => True | cons t1 n1' l1', cons t2 n2' l2' => equalT t1 t2 /\ EqListT n1' l1' n2' l2' | _, _ => False end. End Version5. (* ------------------------------------------------------------------ *) End Sig. (* Exemple soumis par Bruno *) Definition bProp (b : bool) : Prop := if b then True else False. Definition f0 (F : False) (ty : bool) : bProp ty := match ty as _, ty return (bProp ty) with | true, true => I | _, false => F | _, true => I end. (* Simplification of bug/wish #1671 *) Inductive I : unit -> Type := | C : forall a, I a -> I tt. (* Definition F (l:I tt) : l = l := match l return l = l with | C tt (C _ l') => refl_equal (C tt (C _ l')) end. one would expect that the compilation of F (this involves some kind of pattern-unification) would produce: *) Definition F (l:I tt) : l = l := match l return l = l with | C tt l' => match l' return C _ l' = C _ l' with C _ l'' => refl_equal (C tt (C _ l'')) end end. Inductive J : nat -> Type := | D : forall a, J (S a) -> J a. (* Definition G (l:J O) : l = l := match l return l = l with | D O (D 1 l') => refl_equal (D O (D 1 l')) | D _ _ => refl_equal _ end. one would expect that the compilation of G (this involves inversion) would produce: *) Definition G (l:J O) : l = l := match l return l = l with | D 0 l'' => match l'' as _l'' in J n return match n return forall l:J n, Prop with | O => fun _ => l = l | S p => fun l'' => D p l'' = D p l'' end _l'' with | D 1 l' => refl_equal (D O (D 1 l')) | _ => refl_equal _ end | _ => refl_equal _ end. Fixpoint app {A} {n m} (v : listn A n) (w : listn A m) : listn A (n + m) := match v with | niln _ => w | consn _ a n' v' => consn _ a _ (app v' w) end. (* Testing regression of bug 2106 *) Set Implicit Arguments. Require Import List. Inductive nt := E. Definition root := E. Inductive ctor : list nt -> nt -> Type := Plus : ctor (cons E (cons E nil)) E. Inductive term : nt -> Type := | Term : forall s n, ctor s n -> spine s -> term n with spine : list nt -> Type := | EmptySpine : spine nil | ConsSpine : forall n s, term n -> spine s -> spine (n :: s). Inductive step : nt -> nt -> Type := | Step : forall l n r n' (c:ctor (l++n::r) n'), spine l -> spine r -> step n n'. Definition test (s:step E E) := match s with | @Step nil _ (cons E nil) _ Plus l l' => true | _ => false end. (* Testing regression of bug 2454 ("get" used not be type-checkable when defined with its type constraint) *) Inductive K : nat -> Type := KC : forall (p q:nat), K p. Definition get : K O -> nat := fun x => match x with KC p q => q end. (* Checking correct order of substitution of realargs *) (* (was broken from revision 14664 to 14669) *) (* Example extracted from contrib CoLoR *) Inductive EQ : nat -> nat -> Prop := R x y : EQ x y. Check fun e t (d1 d2:EQ e t) => match d1 in EQ e1 t1, d2 in EQ e2 t2 return (e1,t1) = (e2,t2) -> (e1,t1) = (e,t) -> 0=0 with | R _ _, R _ _ => fun _ _ => eq_refl end. coq-8.20.0/test-suite/success/Cases_bug1834.v000066400000000000000000000005761466560755400205750ustar00rootroot00000000000000(* Bug in the computation of generalization *) (* The following bug, elaborated by Bruno Barras, is solved from r11083 *) Parameter P : unit -> Prop. Definition T := sig P. Parameter Q : T -> Prop. Definition U := sig Q. Parameter a : U. Check (match a with exist _ (exist _ tt e2) e3 => e3=e3 end). (* There is still a form submitted by Pierre Corbineau (#1834) which fails *) coq-8.20.0/test-suite/success/Cases_bug3758.v000066400000000000000000000006021466560755400205720ustar00rootroot00000000000000(* There used to be an evar leak in the to_nat example *) Require Import Coq.Lists.List. Import ListNotations. Fixpoint Idx {A:Type} (l:list A) : Type := match l with | [] => False | _::l => True + Idx l end. Fixpoint to_nat {A:Type} (l:list A) (i:Idx l) : nat := match l,i with | [] , i => match i with end | _::_, inl _ => 0 | _::l, inr i => S (to_nat l i) end. coq-8.20.0/test-suite/success/Check.v000066400000000000000000000017041466560755400173710ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* Type := | evenO : even x 0 | evenS : forall n, odd x n -> even x (S n) with odd (x : bool) : nat -> Type := | oddS : forall n, even x n -> odd x (S n). Scheme even_ind_prop := Induction for even Sort Prop with odd_ind_prop := Induction for odd Sort Prop. Combined Scheme even_cprop from even_ind_prop, odd_ind_prop. Check even_cprop : forall (x : bool) (P : forall n : nat, even x n -> Prop) (P0 : forall n : nat, odd x n -> Prop), P 0 (evenO x) -> (forall (n : nat) (o : odd x n), P0 n o -> P (S n) (evenS x n o)) -> (forall (n : nat) (e : even x n), P n e -> P0 (S n) (oddS x n e)) -> (forall (n : nat) (e : even x n), P n e) /\ (forall (n : nat) (o : odd x n), P0 n o). Scheme even_ind_type := Induction for even Sort Type with odd_ind_type := Induction for odd Sort Type. (* This didn't work in v8.7 *) Combined Scheme even_ctype from even_ind_type, odd_ind_type. Check even_ctype : forall (x : bool) (P : forall n : nat, even x n -> Prop) (P0 : forall n : nat, odd x n -> Prop), P 0 (evenO x) -> (forall (n : nat) (o : odd x n), P0 n o -> P (S n) (evenS x n o)) -> (forall (n : nat) (e : even x n), P n e -> P0 (S n) (oddS x n e)) -> (forall (n : nat) (e : even x n), P n e) * (forall (n : nat) (o : odd x n), P0 n o). coq-8.20.0/test-suite/success/CompatCurrentFlag.v000066400000000000000000000002431466560755400217310ustar00rootroot00000000000000(* -*- coq-prog-args: ("-compat" "8.20") -*- *) (** Check that the current compatibility flag actually requires the relevant modules. *) Import Coq.Compat.Coq820. coq-8.20.0/test-suite/success/CompatOldFlag.v000066400000000000000000000003411466560755400210240ustar00rootroot00000000000000(* -*- coq-prog-args: ("-compat" "8.18") -*- *) (** Check that the current-minus-two compatibility flag actually requires the relevant modules. *) Import Coq.Compat.Coq820. Import Coq.Compat.Coq819. Import Coq.Compat.Coq818. coq-8.20.0/test-suite/success/CompatPreviousFlag.v000066400000000000000000000003071466560755400221240ustar00rootroot00000000000000(* -*- coq-prog-args: ("-compat" "8.19") -*- *) (** Check that the current-minus-one compatibility flag actually requires the relevant modules. *) Import Coq.Compat.Coq820. Import Coq.Compat.Coq819. coq-8.20.0/test-suite/success/Conjecture.v000066400000000000000000000003471466560755400204570ustar00rootroot00000000000000(* Check keywords Conjecture and Admitted are recognized *) Conjecture c : forall n : nat, n = 0. Check c. Theorem d : forall n : nat, n = 0. Proof. induction n. reflexivity. assert (H : False). 2: destruct H. Admitted. coq-8.20.0/test-suite/success/ConversionOrder.v000066400000000000000000000010011466560755400214630ustar00rootroot00000000000000(* The kernel may convert application arguments right to left, resulting in ill-typed terms, but should be robust to them. *) Inductive Hide := hide : forall A, A -> Hide. Lemma foo : (hide Type Type) = (hide (nat -> Type) (fun x : nat => Type)). Proof. Fail reflexivity. match goal with |- ?l = _ => exact_no_check (eq_refl l) end. Fail Defined. Abort. Definition HideMore (_:Hide) := 0. Definition foo : HideMore (hide Type Type) = HideMore (hide (nat -> Type) (fun x : nat => Type)) := eq_refl. coq-8.20.0/test-suite/success/CumulInd.v000066400000000000000000000027251466560755400201000ustar00rootroot00000000000000 (* variances other than Invariant are forbidden for non-cumul inductives *) Fail Inductive foo@{+u} : Prop := . Fail Polymorphic Inductive foo@{*u} : Prop := . Inductive foo@{=u} : Prop := . Set Universe Polymorphism. Set Polymorphic Inductive Cumulativity. Inductive force_invariant@{=u} : Prop := . Fail Definition lift@{u v | u < v} (x:force_invariant@{u}) : force_invariant@{v} := x. Inductive force_covariant@{+u} : Prop := . Fail Definition lift@{u v | v < u} (x:force_covariant@{u}) : force_covariant@{v} := x. Definition lift@{u v | u < v} (x:force_covariant@{u}) : force_covariant@{v} := x. Fail Inductive not_irrelevant@{*u} : Prop := nirr (_ : Type@{u}). Inductive check_covariant@{+u} : Prop := cov (_ : Type@{u}). Fail Inductive not_covariant@{+u} : Prop := ncov (_ : Type@{u} -> nat). Inductive must_unfold@{+u *v} : Prop := cmust (_ : @id Type@{v} Type@{u}). Inductive actually_default_unfold@{u v} : Prop := cnodef (_ : @id Type@{v} Type@{u}). Inductive actually_default_unfold_check@{+u *v} : Prop := cnodef_check (_ : actually_default_unfold@{u v}). Inductive irrelevant@{*u} : Prop := . (* weak constraints help minimization *) Definition irrelevant_with_weak@{u} : irrelevant@{u} -> irrelevant := fun x => x. Unset Cumulativity Weak Constraints. Fail Definition irrelevant_without_weak@{u} : irrelevant@{u} -> irrelevant := fun x => x. Definition irrelevant_without_weak@{u+} : irrelevant@{u} -> irrelevant := fun x => x. Check irrelevant_without_weak@{_ _}. coq-8.20.0/test-suite/success/DHyp.v000066400000000000000000000000011466560755400172050ustar00rootroot00000000000000 coq-8.20.0/test-suite/success/Decompose.v000066400000000000000000000003321466560755400202660ustar00rootroot00000000000000(* This was a Decompose bug reported by Randy Pollack (29 Mar 2000) *) Goal 0 = 0 /\ (forall x : nat, x = x -> x = x /\ (forall y : nat, y = y -> y = y)) -> True. intro H. decompose [and] H. (* Was failing *) Abort. coq-8.20.0/test-suite/success/DependentPropositionEliminators.v000066400000000000000000000002401466560755400247310ustar00rootroot00000000000000 Set Dependent Proposition Eliminators. Inductive bar : Prop := XBAR | YBAR. Check bar_ind : forall P : bar -> Prop, P XBAR -> P YBAR -> forall b : bar, P b. coq-8.20.0/test-suite/success/DisableVM.v000066400000000000000000000002421466560755400201560ustar00rootroot00000000000000(* -*- coq-prog-args: ("-bytecode-compiler" "no"); -*- *) Eval lazy in 0. Eval vm_compute in 0. Set Warnings "+vm-compute-disabled". Fail Eval vm_compute in 0. coq-8.20.0/test-suite/success/DiscrR.v000066400000000000000000000006631466560755400175450ustar00rootroot00000000000000Require Import Reals. Require Import DiscrR. Lemma ex0 : 1%R <> 0%R. Proof. discrR. Qed. Lemma ex1 : 0%R <> 2%R. Proof. discrR. Qed. Lemma ex2 : 4%R <> 3%R. Proof. discrR. Qed. Lemma ex3 : 3%R <> 5%R. Proof. discrR. Qed. Lemma ex4 : (-1)%R <> 0%R. Proof. discrR. Qed. Lemma ex5 : (-2)%R <> (-3)%R. Proof. discrR. Qed. Lemma ex6 : 8%R <> (-3)%R. Proof. discrR. Qed. Lemma ex7 : (-8)%R <> 3%R. Proof. discrR. Qed. coq-8.20.0/test-suite/success/Discriminate.v000066400000000000000000000014661466560755400207740ustar00rootroot00000000000000(* Check the behaviour of Discriminate *) (* Check that Discriminate tries Intro until *) Lemma l1 : 0 = 1 -> False. discriminate 1. Qed. Lemma l2 : forall H : 0 = 1, H = H. discriminate H. Qed. (* Check the variants of discriminate *) Goal O = S O -> True. discriminate 1. Undo. intros. discriminate H. Undo. Ltac g x := discriminate x. g H. Abort. Goal (forall x y : nat, x = y -> x = S y) -> True. intros. try discriminate (H O) || exact I. Qed. Goal (forall x y : nat, x = y -> x = S y) -> True. intros. ediscriminate (H O). instantiate (1:=O). Abort. (* Check discriminate on identity *) Goal ~ identity 0 1. discriminate. Qed. (* Check discriminate on types with local definitions *) Inductive A := B (T := unit) (x y : bool) (z := x). Goal forall x y, B x true = B y false -> False. discriminate. Qed. coq-8.20.0/test-suite/success/Discriminate_HoTT.v000066400000000000000000000047131466560755400216700ustar00rootroot00000000000000(* -*- mode: coq; coq-prog-args: ("-noinit" "-indices-matter") -*- *) (* This file tests the discriminate tactic compatibility with HoTT. The first part of the file will setup a mini HoTT environment. Afterwards a number of tests are performed. The tests are basically copied from the Discriminate.v test file. *) Unset Elimination Schemes. Set Universe Polymorphism. Declare ML Module "coq-core.plugins.ltac". Global Set Default Proof Mode "Classic". Notation "x -> y" := (forall (_:x), y) (at level 99, right associativity, y at level 200). Cumulative Variant paths {A} (a:A) : A -> Type := idpath : paths a a. Arguments idpath {A a} , [A] a. Scheme paths_ind := Induction for paths Sort Type. Arguments paths_ind [A] a P f y p : rename. Notation "x = y :> A" := (@paths A x y) (at level 70, y at next level, no associativity). Notation "x = y" := (x = y :>_) (at level 70, no associativity). Register paths as core.identity.type. Register idpath as core.identity.refl. Register paths_ind as core.identity.ind. Definition inverse {A : Type} {x y : A} (p : x = y) : y = x := match p with idpath => idpath end. Arguments inverse {A x y} p : simpl nomatch. Register inverse as core.identity.sym. Definition concat {A : Type} {x y z : A} (p : x = y) (q : y = z) : x = z := match p, q with idpath, idpath => idpath end. Arguments concat {A x y z} p q : simpl nomatch. Register concat as core.identity.trans. Definition ap {A B:Type} (f:A -> B) {x y:A} (p:x = y) : f x = f y := match p with idpath => idpath end. Arguments ap {A B} f {x y} p. Register ap as core.identity.congr. Variant Empty : Type :=. Register Empty as core.False.type. Variant Unit : Type := tt. Register Unit as core.True.type. Register tt as core.True.I. Variant Bool : Type := true | false. Inductive nat : Type := O | S (n:nat). (*********** Test discriminate tactic below. ***************) Goal O = S O -> Empty. discriminate 1. Qed. Goal forall H : O = S O, H = H. discriminate H. Qed. Goal O = S O -> Unit. intros. discriminate H. Qed. Goal O = S O -> Unit. intros. Ltac g x := discriminate x. g H. Qed. Goal (forall x y : nat, x = y -> x = S y) -> Unit. intros. try discriminate (H O) || exact tt. Qed. Goal (forall x y : nat, x = y -> x = S y) -> Unit. intros. ediscriminate (H O). instantiate (1:=O). Abort. (* Check discriminate on types with local definitions *) Inductive A := B (T := Unit) (x y : Bool) (z := x). Goal forall x y, B x true = B y false -> Empty. discriminate. Qed. coq-8.20.0/test-suite/success/Field.v000066400000000000000000000041201466560755400173720ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* R) (x0 x1 : R), (f x1 - f x0) * (1 / (x1 - x0)) + (g x1 - g x0) * (1 / (x1 - x0)) = (f x1 + g x1 - (f x0 + g x0)) * (1 / (x1 - x0)). Proof. intros. field. Abort. (* Example 3 *) Goal forall a b : R, 1 / (a * b) * (1 / (1 / b)) = 1 / a. Proof. intros. field. Abort. Goal forall a b : R, 1 / (a * b) * (1 / 1 / b) = 1 / a. Proof. intros. field_simplify_eq. Abort. Goal forall a b : R, 1 / (a * b) * (1 / 1 / b) = 1 / a. Proof. intros. field_simplify (1 / (a * b) * (1 / 1 / b)). Abort. (* Example 4 *) Goal forall a b : R, a <> 0 -> b <> 0 -> 1 / (a * b) / (1 / b) = 1 / a. Proof. intros. field; auto. Qed. (* Example 5 *) Goal forall a : R, 1 = 1 * (1 / a) * a. Proof. intros. field. Abort. (* Example 6 *) Goal forall a b : R, b = b * / a * a. Proof. intros. field. Abort. (* Example 7 *) Goal forall a b : R, b = b * (1 / a) * a. Proof. intros. field. Abort. (* Example 8 *) Goal forall x y : R, x * (1 / x + x / (x + y)) = - (1 / y) * y * (- (x * (x / (x + y))) - 1). Proof. intros. field. Abort. (* Example 9 *) Goal forall a b : R, 1 / (a * b) * (1 / 1 / b) = 1 / a -> False. Proof. intros. field_simplify_eq in H. Abort. coq-8.20.0/test-suite/success/FinalObligation.v000066400000000000000000000012171466560755400214140ustar00rootroot00000000000000Require Import Program.Tactics. Program Definition foo : nat := _. Program Definition bar : nat * nat := (_, _). Final Obligation. exact 0. Fail Defined. Abort. Next Obligation. exact 0. Defined. Final Obligation. exact 1. Fail Defined. Abort. Final Obligation of bar. exact 1. Defined. Final Obligation. exact 2. Defined. Obligation Tactic := try constructor. Program Definition baz := _ : _. Final Obligation. exact True. Defined. Obligation Tactic := idtac. Program Definition boz : nat := _. Module M. Program Definition mboz : nat := _. Final Obligation. exact 0. Qed. End M. Final Obligation. exact 0. Qed. coq-8.20.0/test-suite/success/FixStronglyWf.v000066400000000000000000000040031466560755400211340ustar00rootroot00000000000000(* Examples of fixpoints with loops in erasable subterms *) (* Loop in erasable local definition *) Fail Fixpoint foo (n : nat) := let g := foo n in 0. (* Loop in erasable branch *) Fail Fixpoint foo (n : nat) := match 0 with | 0 => 0 | S x => foo n end. (* Loop in inert type *) Fail Fixpoint foo (n : nat) := forall x : foo n, True. (* Loop in erasable (and inert) types *) Fail Fixpoint foo (n : nat) := let _ := fun x : foo n => 0 in True. Fail Fixpoint foo (n : nat) := (fun _ : foo n = foo n => True) eq_refl. Fail Fixpoint foo (n : nat) := 0 : id (fun _ => nat) (foo n). (* Competition between an internally bound recursive argument and an invalid argument; also checks that it does not depend on order *) Fail Fixpoint foo p (n : nat) := match n with | 0 => 0 | S x => foo p (id (fun y => match p with | true => y | false => n end) x) end. Fail Fixpoint foo p (n : nat) := match n with | 0 => 0 | S x => foo p (id (fun y => match p with | true => n | false => y end) x) end. (* These one are presumably inoffensive but we continue to reject them *) Fail Fixpoint foo1 (n : nat) := forall x : foo1 = foo1, True. Fail Fixpoint foo2 (n : nat) := eq foo2 foo2. (* Should we allow the following? This is practically uninteresting but a priori ok *) Fail Fixpoint foo (n : nat) := forall n, forall x : foo n = foo n, True. Fail Fixpoint foo (n : nat) := forall n, eq (foo n) (foo n). (* Loop after one step of reduction *) Fail Fixpoint foo (n : nat) := (fun f p => (fun _ => True) (foo p)) n. Fail Fixpoint foo (n : nat) := (if true then fun p => if true then True else foo n else fun p => True) n. (* Loop in dead branch *) Fail Fixpoint foo n := match n with | 0 => 0 | S n => (fix aux n := match n with | 0 => foo n | S n => aux n end) (S n) end. (* Loop in inert erasable subterm *) Fail Fixpoint g (n:nat) : Prop := (fun x : g n -> True => True) (fun y : g n => I). coq-8.20.0/test-suite/success/Fixpoint.v000066400000000000000000000345341466560755400201630ustar00rootroot00000000000000(* Playing with (co-)fixpoints with local definitions *) Inductive listn : nat -> Set := niln : listn 0 | consn : forall n:nat, nat -> listn n -> listn (S n). Fixpoint f (n:nat) (m:=pred n) (l:listn m) (p:=S n) {struct l} : nat := match n with O => p | _ => match l with niln => p | consn q _ l => f (S q) l end end. Eval compute in (f 2 (consn 0 0 niln)). CoInductive Stream : nat -> Set := Consn : forall n, nat -> Stream n -> Stream (S n). CoFixpoint g (n:nat) (m:=pred n) (l:Stream m) (p:=S n) : Stream p := match n return (let m:=pred n in forall l:Stream m, let p:=S n in Stream p) with | O => fun l:Stream 0 => Consn O 0 l | S n' => fun l:Stream n' => let l' := match l in Stream q return Stream (pred q) with Consn _ _ l => l end in let a := match l with Consn _ a l => a end in Consn (S n') (S a) (g n' l') end l. Eval compute in (fun l => match g 2 (Consn 0 6 l) with Consn _ a _ => a end). (* Check inference of simple types in presence of non ambiguous dependencies (needs revision 10125) *) Section folding. Inductive vector (A:Type) : nat -> Type := | Vnil : vector A 0 | Vcons : forall (a:A) (n:nat), vector A n -> vector A (S n). Variables (B C : Set) (g : B -> C -> C) (c : C). Fixpoint foldrn n bs := match bs with | Vnil _ => c | Vcons _ b _ tl => g b (foldrn _ tl) end. End folding. (* Check definition by tactics *) Inductive even : nat -> Type := | even_O : even 0 | even_S : forall n, odd n -> even (S n) with odd : nat -> Type := odd_S : forall n, even n -> odd (S n). Fixpoint even_div2 n (H:even n) : nat := match H with | even_O => 0 | even_S n H => S (odd_div2 n H) end with odd_div2 n H : nat. destruct H. apply even_div2 with n. assumption. Qed. Fixpoint even_div2' n (H:even n) : nat with odd_div2' n (H:odd n) : nat. destruct H. exact 0. apply odd_div2' with n. assumption. destruct H. apply even_div2' with n. assumption. Qed. CoInductive Stream1 (A B:Type) := Cons1 : A -> Stream2 A B -> Stream1 A B with Stream2 (A B:Type) := Cons2 : B -> Stream1 A B -> Stream2 A B. CoFixpoint ex1 (n:nat) (b:bool) : Stream1 nat bool with ex2 (n:nat) (b:bool) : Stream2 nat bool. apply Cons1. exact n. apply (ex2 n b). apply Cons2. exact b. apply (ex1 (S n) (negb b)). Defined. Section visibility. Let Fixpoint imm (n:nat) : True := I. Let Fixpoint by_proof (n:nat) : True. Proof. exact I. Defined. Let Fixpoint foo (n:nat) : bool with bar (n:nat) : bool. Proof. - destruct n as [|n]. + exact true. + exact (bar n). - destruct n as [|n]. + exact false. + exact (foo n). Qed. Let Fixpoint bla (n:nat) : Type with bli (n:nat) : bool. Admitted. End visibility. Fail Check imm. Fail Check by_proof. Check bla. Check bli. Module Import mod_local. Fixpoint imm_importable (n:nat) : True := I. Local Fixpoint imm_local (n:nat) : True := I. Fixpoint by_proof_importable (n:nat) : True. Proof. exact I. Defined. Local Fixpoint by_proof_local (n:nat) : True. Proof. exact I. Defined. End mod_local. Check imm_importable. Fail Check imm_local. Check mod_local.imm_local. Check by_proof_importable. Fail Check by_proof_local. Check mod_local.by_proof_local. (* Miscellaneous tests *) Module IotaRedex. Fixpoint minus (n m:nat) {struct n} : nat := match (n, m) with | (O , _) => O | (S _ , O) => n | (S n', S m') => minus n' m' end. End IotaRedex. Module ReturningInductive. Fail Fixpoint geneq s (x: list nat) {struct s} : Prop := match x with | cons a t => geneq (S a) t /\ geneq (S a) t | _ => False end. End ReturningInductive. Module NestingAndUnfolding. Fail Fixpoint f (x:nat) := id (fix g x : nat := f x) 0. Fixpoint f x := match x with | 0 => 0 | S n => id (fix g x := f x) n end. End NestingAndUnfolding. Module NestingAndConstructedUnfolding. Definition fold_left {A B : Type} (f : A -> B -> A) := fix fold_left (l : list B) (a0 : A) {struct l} : A := match l with | nil => a0 | cons b t => fold_left t (f a0 b) end. Record t A : Type := mk { elt: A }. Arguments elt {A} t. Inductive LForm : Type := | LIMPL : t LForm -> list (t LForm) -> LForm. Fixpoint hcons (m : unit) (f : LForm) := match f with | LIMPL f l => fold_left (fun m f => hcons m f.(elt) ) (cons f l) m end. End NestingAndConstructedUnfolding. Module CofixRedex. CoInductive Stream := {hd : nat; tl : Stream}. Definition zeros := cofix zeros := {|hd := 0; tl := zeros|}. Fixpoint f n := match n with | 0 => 0 | S n => match zeros with | {|hd:=_|} => fun f => f n end f end. End CofixRedex. Module CofixRedexPrimProj. Set Primitive Projections. CoInductive Stream A := {hd : A; tl : Stream A}. Arguments hd {A} s. Fixpoint f n := match n with | 0 => 0 | S n => (cofix cst := {|hd := (fun f => f n); tl := cst|}).(hd) f end. End CofixRedexPrimProj. Module ArgumentsAcrossMatch. (* large subterm passed across match *) Fail Fixpoint f n p {struct n} := match n with | 0 => fun _ => 0 | S q => fun r => f q (f r 0) end n. (* strict subterm passed across match *) Fixpoint f n p {struct n} := match n with | 0 => 0 | S q => match q with | 0 => fun _ => 0 | S q' => fun r => f q (f r 0) end q end. End ArgumentsAcrossMatch. Module LetToExpand. Fixpoint h n := let f n := (fun x : h n -> True => True) (fun y : h n => I) in match n with | 0 => True | S n => f n end. End LetToExpand. Module RecursiveCallInsideCoFix. CoInductive I := { field : I }. Fail Fixpoint f (n:nat) := (cofix g n := {| field := f n |}) 0. End RecursiveCallInsideCoFix. Module NestedRedexes. Fixpoint f n := match n with | 0 => 0 | S n => id (fun x => id (fun _ => id (f x)) 0) n end. End NestedRedexes. Module NestedRedexesWithCofix. CoInductive I := { field : nat -> nat }. Fail Fixpoint f n := ((cofix g h := {| field := h |}) f).(field) n. Fixpoint f n := match n with | 0 => 0 | S p => ((cofix g h := {| field := h |}) f).(field) p end. End NestedRedexesWithCofix. Module NestedApplicationsWithVariables. Section S. Variable h : (nat -> nat) -> nat. Fixpoint f n := match n with | 0 => 0 | S p => (fun _ => 0) (h f) end. End S. End NestedApplicationsWithVariables. Module NestedApplicationsWithParameters. Parameter h : (nat -> nat) -> nat. Fixpoint f n := match n with | 0 => 0 | S p => (fun _ => 0) (h f) end. End NestedApplicationsWithParameters. Module NestedApplicationsWithLocalVariables. Fixpoint f (h:(nat->nat)->nat) n := match n with | 0 => 0 | S p => (fun _ => 0) (h (f h)) end. End NestedApplicationsWithLocalVariables. Module NestedApplicationsWithProjections. Set Primitive Projections. Record R := { field : (nat -> nat) -> nat }. Fixpoint f x n := match n with | 0 => 0 | S p => (fun _ => 0) (x.(field) (f x)) end. End NestedApplicationsWithProjections. Module NestedRedexesWithFix. Fixpoint f n := match n with | 0 => 0 | S p => (fun _ => 0) ((fix h k (q:nat) {struct q} := k) f) end. (* inner fix fully applied with a match subterm *) Fixpoint f' n := match n with | 0 => 0 | S p => (fun _ => 0) ((fix h k (q:nat) {struct q} := k) f' p) end. (* inner fix fully applied with an arbitrary term *) Fixpoint f'' o n := match n with | 0 => 0 | S p => (fun _ => 0) ((fix h k (q:nat) {struct q} := k o) f'' o) end. End NestedRedexesWithFix. Module NestedRedexesWithMatch. Fixpoint f o n := match n with | 0 => 0 | S p => (fun _ => 0) (match o with tt => f o end) end. Fixpoint f' o n := match n with | 0 => 0 | S p => (fun _ => 0) ((match o with tt => fun x => x o end) f') end. End NestedRedexesWithMatch. Module ErasableInertSubterm. Fixpoint P (n:nat) := (fun _ => True) (forall a : (forall p, P p), True). End ErasableInertSubterm. Module WithLetInLift. Fixpoint f (n : nat) : nat := match n with | 0 => 0 | S n => (let x := 0 in fun n => f n) n end. End WithLetInLift. Module WithLateCaseReduction. Definition B := true. Fixpoint f (n : nat) := match n with | 0 => 0 | S n => (if B as b return if b then nat -> nat else unit then fun n => f n else tt) n end. End WithLateCaseReduction. Module NtnInteractiveFixpoint. Reserved Notation "# n" (at level 2, right associativity). Fixpoint f (n:nat) : nat where "# n" := (f n). exact (match n with 0 => 0 | S n => # n end). Defined. Check eq_refl : # 0 = f 0. End NtnInteractiveFixpoint. Module NoArgumentFixpoint. Fail Fixpoint f : nat. (* was an anomaly at some time *) End NoArgumentFixpoint. Module FixpointRelevance. (* Check that the recursive reference to a fixpoint name has correct relevance, in different execution paths *) Inductive STrue : SProp := SI. Inductive seq (a:STrue) : STrue -> SProp := srefl : seq a a. Fixpoint g1 (n:nat) : STrue := match n with | 0 => SI | S n => let x := srefl (g1 n) : seq (g1 n) (g2 n) in g2 n end with g2 (n:nat) : STrue := match n with | 0 => SI | S n => let x := srefl (g1 n) : seq (g1 n) (g2 n) in g1 n end. Fixpoint h1 (n:nat) : STrue with h2 (n:nat) : STrue. exact (match n with | 0 => SI | S n => let x := srefl (h1 n) : seq (h1 n) (h2 n) in h2 n end). exact (match n with | 0 => SI | S n => let x := srefl (h1 n) : seq (h1 n) (h2 n) in h1 n end). Defined. Theorem k1 (n:nat) : STrue with k2 (n:nat) : STrue. exact (match n with | 0 => SI | S n => let x := srefl (k1 n) : seq (k1 n) (k2 n) in k2 n end). exact (match n with | 0 => SI | S n => let x := srefl (k1 n) : seq (k1 n) (k2 n) in k1 n end). Defined. End FixpointRelevance. Module ClearFixBody. CoInductive Stream : Set := Cons : nat -> Stream -> Stream. Section S. #[clearbody] Let CoFixpoint f : Stream := Cons 1 f. #[clearbody] Let Fixpoint g n := match n with 0 => 0 | S n => g n end. Goal True. Fail Check eq_refl : f = cofix f := Cons 1 f. Fail Check eq_refl : g = fix g n := match n with 0 => 0 | S n => g n end. Abort. End S. End ClearFixBody. Module TheoremWithUnivs. Fail Fixpoint f@{u} (n:nat) : nat with g@{v} (n:nat) : nat. Fail Theorem f@{u} (n:nat) : nat with g@{v} (n:nat) : nat. Fail CoFixpoint f@{u} (n:nat) : Stream 0 with g@{v} (n:nat) : Stream 0. Succeed Fixpoint f@{u} (n:nat) : nat with g@{u} (n:nat) : nat. Succeed Theorem f@{u} (n:nat) : nat with g@{u} (n:nat) : nat. Succeed CoFixpoint f@{u} (n:nat) : Stream 0 with g@{u} (n:nat) : Stream 0. Succeed Fixpoint f@{u} (n:nat) : nat with g (n:nat) : nat. (* Accepted *) Succeed Theorem f@{u} (n:nat) : nat with g (n:nat) : nat. (* Accepted *) Succeed CoFixpoint f@{u} (n:nat) : Stream 0 with g (n:nat) : Stream 0. (* Accepted *) End TheoremWithUnivs. Module DependMutualFix. Inductive tree (A : Type) := Node : A -> list (tree A) -> tree A. Definition lmap' {A B} (f : A -> B) : list A -> list B := fix F l := match l with | nil => nil | cons x l => cons (f x) (G l) end with G l := match l with | nil => nil | cons x l => cons (f x) (F l) end for F. (* Not yet able to accept this *) Fail Fixpoint map {A B} (f : A -> B) (t : tree A) {struct t} : tree B := match t with | Node _ x l => Node _ (f x) (lmap' (map f) l) end. End DependMutualFix. Module Wish16040. Inductive tree (A : Type) := Node : A -> list (tree A) -> tree A. Fixpoint lmap {A B} (f : A -> B) (l : list A) : list B := match l with | nil => nil | cons x l => cons (f x) (lmap f l) end. Fixpoint map {A B} (f : A -> B) (t : tree A) {struct t} : tree B := match t with | Node _ x l => Node _ (f x) (lmap (map f) l) end. (* Check that we don't find too much uniform parameters *) Fixpoint lmap' {A} (f g : A -> A) (l : list A) : list A := match l with | nil => nil | cons x l => cons (f x) (lmap' g f l) end. (* Not supposed to be detected guarded, as only A is uniform in lmap' *) Fail Fixpoint map' {A} (f : A -> A) (t : tree A) {struct t} : tree A := match t with | Node _ x l => Node _ (f x) (lmap' (map' f) (map' f) l) end. (* Uniform arguments after a non-uniform one *) Fixpoint lmap'' {A} n (f : A -> A) (l : list A) : list A := match l with | nil => nil | cons x l => cons (f x) (lmap'' (S n) f l) end. (* The current guard supports extrusion of uniform arguments only in prefix position *) Fail Fixpoint map'' {A} (f : A -> A) (t : tree A) {struct t} : tree A := match t with | Node _ x l => Node _ (f x) (lmap'' 0 (map'' f) l) end. End Wish16040. Module TheoremWith. CoInductive Stream : Set := Cons : nat -> Stream -> Stream. (* Support for mutually recursive theorems in non-mutual types *) Theorem a : Stream with b : Stream. Proof. apply (Cons 0), b. apply (Cons 0), a. Defined. Theorem c (n:nat) : Stream with d (n:nat) : Stream. (* corecursive *) Proof. apply (Cons n), (d n). apply (Cons n), (c n). Defined. Theorem c' (n:nat) : Stream with d' (n:nat) : Stream. (* recursive *) Proof. destruct n as [|n']. apply a. apply (d' n'). destruct n as [|n']. apply a. apply (c' n'). Defined. End TheoremWith. Module HighlyNested. Inductive T A := E : A * list A * list (list A) -> T A. Inductive U := H : T (T U) -> U. Definition map {A B : Type} (f : A -> B) := fix map (l : list A) : list B := match l with | nil => nil | cons a t => cons (f a) (map t) end. Definition mapT {A B} (f:A -> B) t := match t with E _ (a, l, ll) => E _ (f a, map f l, map (map f) ll) end. Fixpoint mapU (f:U->U) u := match u with | H t => H (mapT (mapT (mapU f)) t) end. End HighlyNested. Module TestIntersection. (* This example used to stress rtree.inter (3 nested types) *) Inductive Pmap_ne (A : Type) := | PNode010 : A -> Pmap_ne A | PNode110 : Pmap_ne A -> A -> Pmap_ne A. Arguments PNode010 {A} _ : assert. Arguments PNode110 {A} _ _ : assert. Variant Pmap (A : Type) := PEmpty : Pmap A | PNodes : Pmap_ne A -> Pmap A. Arguments PEmpty {A}. Arguments PNodes {A} _. Definition Pmap_ne_case {A B} (t : Pmap_ne A) (f : Pmap A -> option A -> Pmap A -> B) : B := match t with | PNode010 x => f PEmpty (Some x) PEmpty | PNode110 l x => f (PNodes l) (Some x) PEmpty end. Definition Pmap_fold_aux {A B} (go : B -> Pmap_ne A -> B) (y : B) (mt : Pmap A) : B := match mt with PEmpty => y | PNodes t => go y t end. Definition Pmap_ne_fold {A B} (f : A -> B -> B) : B -> Pmap_ne A -> B := fix go y t := Pmap_ne_case t (fun ml mx mr => Pmap_fold_aux go (Pmap_fold_aux go match mx with None => y | Some x => f x y end ml) mr). Definition Pmap_fold {A} {B} (f : A -> B -> B) := Pmap_fold_aux (Pmap_ne_fold f). Inductive test := Test : Pmap test -> test. Fixpoint test_size (t : test) : nat := let 'Test ts := t in S (Pmap_fold (fun t' => plus (test_size t')) 0%nat ts). End TestIntersection. coq-8.20.0/test-suite/success/Funind.v000066400000000000000000000244571466560755400176110ustar00rootroot00000000000000 Require Import Coq.funind.FunInd. Definition iszero (n : nat) : bool := match n with | O => true | _ => false end. Functional Scheme iszero_ind := Induction for iszero Sort Prop. Lemma toto : forall n : nat, n = 0 -> iszero n = true. intros x eg. functional induction iszero x; simpl. trivial. inversion eg. Qed. Function ftest (n m : nat) : nat := match n with | O => match m with | O => 0 | _ => 1 end | S p => 0 end. (* MS: FIXME: apparently can't define R_ftest_complete. Rest of the file goes through. *) Lemma test1 : forall n m : nat, ftest n m <= 2. intros n m. functional induction ftest n m; auto. Qed. Lemma test2 : forall m n, ~ 2 = ftest n m. Proof. intros n m;intro H. functional inversion H ftest. Qed. Lemma test3 : forall n m, ftest n m = 0 -> (n = 0 /\ m = 0) \/ n <> 0. Proof. functional inversion 1 ftest;auto. Qed. Require Import Arith. Lemma test11 : forall m : nat, ftest 0 m <= 2. intros m. functional induction ftest 0 m. auto. auto. auto with *. Qed. Function lamfix (m n : nat) {struct n } : nat := match n with | O => m | S p => lamfix m p end. (* Parameter v1 v2 : nat. *) Lemma lamfix_lem : forall v1 v2 : nat, lamfix v1 v2 = v1. intros v1 v2. functional induction lamfix v1 v2. trivial. assumption. Defined. (* polymorphic function *) Require Import List. Functional Scheme app_ind := Induction for app Sort Prop. Lemma appnil : forall (A : Set) (l l' : list A), l' = nil -> l = l ++ l'. intros A l l'. functional induction app l l'; intuition. rewrite <- H0; trivial. Qed. Require Export Arith. Function trivfun (n : nat) : nat := match n with | O => 0 | S m => trivfun m end. (* essaie de parametre variables non locaux:*) Parameter varessai : nat. Lemma first_try : trivfun varessai = 0. functional induction trivfun varessai. trivial. assumption. Defined. Functional Scheme triv_ind := Induction for trivfun Sort Prop. Lemma bisrepetita : forall n' : nat, trivfun n' = 0. intros n'. functional induction trivfun n'. trivial. assumption. Qed. Function iseven (n : nat) : bool := match n with | O => true | S (S m) => iseven m | _ => false end. Function funex (n : nat) : nat := match iseven n with | true => n | false => match n with | O => 0 | S r => funex r end end. Function nat_equal_bool (n m : nat) {struct n} : bool := match n with | O => match m with | O => true | _ => false end | S p => match m with | O => false | S q => nat_equal_bool p q end end. Require Import Nat. Functional Scheme div2_ind := Induction for Nat.div2 Sort Prop. Lemma div2_inf : forall n : nat, Nat.div2 n <= n. intros n. functional induction Nat.div2 n. auto. auto. apply le_S. apply le_n_S. exact IHn0. Qed. (* reuse this lemma as a scheme:*) Function nested_lam (n : nat) : nat -> nat := match n with | O => fun m : nat => 0 | S n' => fun m : nat => m + nested_lam n' m end. Lemma nest : forall n m : nat, nested_lam n m = n * m. intros n m. functional induction nested_lam n m; simpl;auto. Qed. Function essai (x : nat) (p : nat * nat) {struct x} : nat := let (n, m) := (p: nat*nat) in match n with | O => 0 | S q => match x with | O => 1 | S r => S (essai r (q, m)) end end. Lemma essai_essai : forall (x : nat) (p : nat * nat), let (n, m) := p in 0 < n -> 0 < essai x p. intros x p. functional induction essai x p; intros. inversion H. auto with arith. auto with arith. Qed. Function plus_x_not_five'' (n m : nat) {struct n} : nat := let x := nat_equal_bool m 5 in let y := 0 in match n with | O => y | S q => let recapp := plus_x_not_five'' q m in match x with | true => S recapp | false => S recapp end end. Lemma notplusfive'' : forall x y : nat, y = 5 -> plus_x_not_five'' x y = x. intros a b. functional induction plus_x_not_five'' a b; intros hyp; simpl; auto. Qed. Lemma iseq_eq : forall n m : nat, n = m -> nat_equal_bool n m = true. intros n m. functional induction nat_equal_bool n m; simpl; intros hyp; auto. rewrite <- hyp in y; simpl in y;tauto. inversion hyp. Qed. Lemma iseq_eq' : forall n m : nat, nat_equal_bool n m = true -> n = m. intros n m. functional induction nat_equal_bool n m; simpl; intros eg; auto. inversion eg. inversion eg. Qed. Inductive istrue : bool -> Prop := istrue0 : istrue true. Functional Scheme add_ind := Induction for add Sort Prop. Lemma inf_x_plusxy' : forall x y : nat, x <= x + y. intros n m. functional induction add n m; intros. auto with arith. auto with arith. Qed. Lemma inf_x_plusxy'' : forall x : nat, x <= x + 0. intros n. unfold plus. functional induction plus n 0; intros. auto with arith. apply le_n_S. assumption. Qed. Lemma inf_x_plusxy''' : forall x : nat, x <= 0 + x. intros n. functional induction plus 0 n; intros; auto with arith. Qed. Function mod2 (n : nat) : nat := match n with | O => 0 | S (S m) => S (mod2 m) | _ => 0 end. Lemma princ_mod2 : forall n : nat, mod2 n <= n. intros n. functional induction mod2 n; simpl; auto with arith. Qed. Function isfour (n : nat) : bool := match n with | S (S (S (S O))) => true | _ => false end. Function isononeorfour (n : nat) : bool := match n with | S O => true | S (S (S (S O))) => true | _ => false end. Lemma toto'' : forall n : nat, istrue (isfour n) -> istrue (isononeorfour n). intros n. functional induction isononeorfour n; intros istr; simpl; inversion istr. apply istrue0. destruct n. inversion istr. destruct n. tauto. destruct n. inversion istr. destruct n. inversion istr. destruct n. tauto. simpl in *. inversion H0. Qed. Lemma toto' : forall n m : nat, n = 4 -> istrue (isononeorfour n). intros n. functional induction isononeorfour n; intros m istr; inversion istr. apply istrue0. rewrite H in y; simpl in y;tauto. Qed. Function ftest4 (n m : nat) : nat := match n with | O => match m with | O => 0 | S q => 1 end | S p => match m with | O => 0 | S r => 1 end end. Lemma test4 : forall n m : nat, ftest n m <= 2. intros n m. functional induction ftest n m; auto with arith. Qed. Lemma test4' : forall n m : nat, ftest4 (S n) m <= 2. intros n m. assert ({n0 | n0 = S n}). exists (S n);reflexivity. destruct H as [n0 H1]. rewrite <- H1;revert H1. functional induction ftest4 n0 m. inversion 1. inversion 1. auto with arith. auto with arith. Qed. Function ftest44 (x : nat * nat) (n m : nat) : nat := let (p, q) := (x: nat*nat) in match n with | O => match m with | O => 0 | S q => 1 end | S p => match m with | O => 0 | S r => 1 end end. Lemma test44 : forall (pq : nat * nat) (n m o r s : nat), ftest44 pq n (S m) <= 2. intros pq n m o r s. functional induction ftest44 pq n (S m). auto with arith. auto with arith. auto with arith. auto with arith. Qed. Function ftest2 (n m : nat) {struct n} : nat := match n with | O => match m with | O => 0 | S q => 0 end | S p => ftest2 p m end. Lemma test2' : forall n m : nat, ftest2 n m <= 2. intros n m. functional induction ftest2 n m; simpl; intros; auto. Qed. Function ftest3 (n m : nat) {struct n} : nat := match n with | O => 0 | S p => match m with | O => ftest3 p 0 | S r => 0 end end. Lemma test3' : forall n m : nat, ftest3 n m <= 2. intros n m. functional induction ftest3 n m. intros. auto. intros. auto. intros. simpl. auto. Qed. Function ftest5 (n m : nat) {struct n} : nat := match n with | O => 0 | S p => match m with | O => ftest5 p 0 | S r => ftest5 p r end end. Lemma test5 : forall n m : nat, ftest5 n m <= 2. intros n m. functional induction ftest5 n m. intros. auto. intros. auto. intros. simpl. auto. Qed. Function ftest7 (n : nat) : nat := match ftest5 n 0 with | O => 0 | S r => 0 end. Lemma essai7 : forall (Hrec : forall n : nat, ftest5 n 0 = 0 -> ftest7 n <= 2) (Hrec0 : forall n r : nat, ftest5 n 0 = S r -> ftest7 n <= 2) (n : nat), ftest7 n <= 2. intros hyp1 hyp2 n. functional induction ftest7 n; auto. Qed. Function ftest6 (n m : nat) {struct n} : nat := match n with | O => 0 | S p => match ftest5 p 0 with | O => ftest6 p 0 | S r => ftest6 p r end end. Lemma princ6 : (forall n m : nat, n = 0 -> ftest6 0 m <= 2) -> (forall n m p : nat, ftest6 p 0 <= 2 -> ftest5 p 0 = 0 -> n = S p -> ftest6 (S p) m <= 2) -> (forall n m p r : nat, ftest6 p r <= 2 -> ftest5 p 0 = S r -> n = S p -> ftest6 (S p) m <= 2) -> forall x y : nat, ftest6 x y <= 2. intros hyp1 hyp2 hyp3 n m. generalize hyp1 hyp2 hyp3. clear hyp1 hyp2 hyp3. functional induction ftest6 n m; auto. Qed. Lemma essai6 : forall n m : nat, ftest6 n m <= 2. intros n m. functional induction ftest6 n m; simpl; auto. Qed. (* Some tests with modules *) Module M. Function test_m (n:nat) : nat := match n with | 0 => 0 | S n => S (S (test_m n)) end. Lemma test_m_is_double : forall n, div2 (test_m n) = n. Proof. intros n. functional induction (test_m n). reflexivity. simpl;rewrite IHn0;reflexivity. Qed. End M. (* We redefine a new Function with the same name *) Function test_m (n:nat) : nat := pred n. Lemma test_m_is_pred : forall n, test_m n = pred n. Proof. intro n. functional induction (test_m n). (* the test_m_ind to use is the last defined saying that test_m = pred*) reflexivity. Qed. (* Checks if the dot notation are correctly treated in infos *) Lemma M_test_m_is_double : forall n, div2 (M.test_m n) = n. intro n. (* here we should apply M.test_m_ind *) functional induction (M.test_m n). reflexivity. simpl;rewrite IHn0;reflexivity. Qed. Import M. (* Now test_m is the one which defines double *) Lemma test_m_is_double : forall n, div2 (M.test_m n) = n. intro n. (* here we should apply M.test_m_ind *) functional induction (test_m n). reflexivity. simpl;rewrite IHn0;reflexivity. Qed. (* An example with projections *) Require Import FunInd. Require Import List. Record foo (X:Type):= {a:nat; b:X}. Inductive ind X: Type := | C: foo X -> ind X | D: ind X -> ind X. Function f X (deflt:X) (x:ind X) {struct x} := match x with @C _ fo => match fo.(a X) with O => fo.(b X) | S n => deflt end | D _ d => f _ deflt d end. coq-8.20.0/test-suite/success/Generalization.v000066400000000000000000000007521466560755400213310ustar00rootroot00000000000000Generalizable All Variables. Check `(a = 0). Check `(a = 0)%type. Definition relation A := A -> A -> Prop. Definition equivalence `(R : relation A) := True. Check (`(@equivalence A R)). Definition a_eq_b : `( a = 0 /\ a = b /\ b > c \/ d = e /\ d = 1). Admitted. Print a_eq_b. Require Import Morphisms. Class Equiv A := equiv : A -> A -> Prop. Class Setoid A `{Equiv A} := setoid_equiv :: Equivalence (equiv). Lemma vcons_proper A `[Equiv A] `[!Setoid A] (x : True) : True. Admitted. coq-8.20.0/test-suite/success/Generalize.v000066400000000000000000000002601466560755400204350ustar00rootroot00000000000000(* Check Generalize Dependent *) Lemma l1 : let a := 0 in let b := a in forall (c : b = b) (d : True -> b = b), d = d. intros. generalize dependent a. intros a b c d. Abort. coq-8.20.0/test-suite/success/HintMode.v000066400000000000000000000035071466560755400200660ustar00rootroot00000000000000Module Postponing. Class In A T := { IsIn : A -> T -> Prop }. Class Empty T := { empty : T }. Class EmptyIn (A T : Type) `{In A T} `{Empty T} := { isempty : forall x, IsIn x empty -> False }. #[export] Hint Mode EmptyIn ! ! - - : typeclass_instances. #[export] Hint Mode Empty ! : typeclass_instances. #[export] Hint Mode In ! - : typeclass_instances. Existing Class IsIn. Goal forall A T `{In A T} `{Empty T} `{EmptyIn A T}, forall x : A, IsIn x empty -> False. Proof. intros. eapply @isempty. (* Second goal needs to be solved first, to un-stuck the first one (hence the Existing Class IsIn to allow finding the assumption of IsIn here) *) all:typeclasses eauto. Qed. End Postponing. Module Heads. Set Primitive Projections. Class A (X : Type) := { somex : X }. Local Hint Mode A ! : typeclass_instances. Record foo := { car : Type; obj : car }. Local Instance foo_A (f : foo) : A (car f) := { somex := obj f }. Definition onef := {| car := nat; obj := 0 |}. Goal {f : foo & A (car f)}. Proof. unshelve eexists; cycle 1. solve [typeclasses eauto]. exact onef. Defined. End Heads. Module BestEffort. Class A (T : Type). Global Hint Mode A + : typeclass_instances. Class B (T : Type). Global Hint Mode B + : typeclass_instances. #[export] Instance a_imp_b T : A T -> B T := {}. #[export] Instance anat : B nat := {}. Lemma b : B nat * A nat. Proof. Fail split; typeclasses eauto. Set Typeclasses Debug Verbosity 2. Fail split; solve [typeclasses eauto best_effort]. (* Here typeclasses eauto best_effort, when run on the 2 goals at once, can solve the B goal which has a nat instance nd whose mode is + (this morally assumes that there is only one instance matching B nat) *) split; typeclasses eauto best_effort. admit. Admitted. End BestEffort. coq-8.20.0/test-suite/success/Hints.v000066400000000000000000000134721466560755400174460ustar00rootroot00000000000000(* Checks syntax of Hints commands *) (* Old-style syntax *) #[export] Hint Resolve eq_refl eq_sym. #[export] Hint Resolve eq_refl eq_sym: foo. #[export] Hint Immediate eq_refl eq_sym. #[export] Hint Immediate eq_refl eq_sym: foo. #[export] Hint Unfold fst eq_sym. #[export] Hint Unfold fst eq_sym: foo. (* Checks that qualified names are accepted *) (* New-style syntax *) #[export] Hint Resolve eq_refl: core arith. #[export] Hint Immediate eq_trans. #[export] Hint Unfold eq_sym: core. #[export] Hint Constructors eq: foo bar. #[export] Hint Extern 3 (_ = _) => apply eq_refl: foo bar. (* Extended new syntax with patterns *) #[export] Hint Resolve eq_refl | 4 (_ = _) : baz. #[export] Hint Resolve eq_sym eq_trans : baz. #[export] Hint Extern 3 (_ = _) => apply eq_sym : baz. Parameter pred : nat -> Prop. Parameter pred0 : pred 0. Parameter f : nat -> nat. Parameter predf : forall n, pred n -> pred (f n). (* No conversion on let-bound variables and constants in pred (the default) *) #[export] Hint Resolve pred0 | 1 (pred _) : pred. #[export] Hint Resolve predf | 0 : pred. (* Allow full conversion on let-bound variables and constants *) Create HintDb predconv discriminated. #[export] Hint Resolve pred0 | 1 (pred _) : predconv. #[export] Hint Resolve predf | 0 : predconv. Parameter predconv : forall n, pred n -> pred (0 + S n). (* The inferred pattern contains 0 + ?n, syntactic match will fail to see convertible terms *) #[export] Hint Resolve pred0 : pred2. #[export] Hint Resolve predconv : pred2. (** In this database we allow predconv to apply to pred (S _) goals, more generally than the inferred pattern (pred (0 + S _)). *) Create HintDb pred2conv discriminated. #[export] Hint Resolve pred0 : pred2conv. #[export] Hint Resolve predconv | 1 (pred (S _)) : pred2conv. Goal pred 3. Fail typeclasses eauto with pred2. typeclasses eauto with pred2conv. Abort. Set Typeclasses Debug Verbosity 2. #[export] Hint Resolve predconv | 1 (pred _) : pred. #[export] Hint Resolve predconv | 1 (pred (S _)) : predconv. Test Typeclasses Limit Intros. Goal pred 3. (* predf is not tried as it doesn't match the goal *) (* predconv is tried but fails as the transparent state doesn't allow unfolding + *) Fail typeclasses eauto with pred. (* Here predconv succeeds as it matches (pred (S _)) and then full unification is allowed *) typeclasses eauto with predconv. Qed. (* Checks that local names are accepted *) Section A. Remark Refl : forall (A : Set) (x : A), x = x. Proof. exact @eq_refl. Defined. Definition Sym := eq_sym. Let Trans := eq_trans. Hint Resolve Refl: foo. Hint Resolve Sym: bar. Hint Resolve Trans: foo2. Hint Immediate Refl. Hint Immediate Sym. Hint Immediate Trans. Hint Unfold Refl. Hint Unfold Sym. Hint Unfold Trans. Hint Resolve Sym Trans Refl. Hint Immediate Sym Trans Refl. Hint Unfold Sym Trans Refl. End A. Axiom a : forall n, n=0 <-> n<=0. #[export] Hint Resolve -> a. Goal forall n, n=0 -> n<=0. auto. Qed. (* This example comes from Chlipala's ltamer *) (* It used to fail from r12902 to r13112 since type_of started to call *) (* e_cumul (instead of conv_leq) which was not able to unify "?id" and *) (* "(fun x => x) ?id" *) Notation "e :? pf" := (eq_rect _ (fun X : Set => X) e _ pf) (no associativity, at level 90). Axiom cast_coalesce : forall (T1 T2 T3 : Set) (e : T1) (pf1 : T1 = T2) (pf2 : T2 = T3), ((e :? pf1) :? pf2) = (e :? trans_eq pf1 pf2). #[export] Hint Rewrite cast_coalesce : ltamer. Require Import Program. Module HintCut. Class A (f : nat -> nat) := a : True. Class B (f : nat -> nat) := b : True. Class C (f : nat -> nat) := c : True. Class D (f : nat -> nat) := d : True. Class E (f : nat -> nat) := e : True. #[export] Instance a_is_b f : A f -> B f. Proof. easy. Qed. #[export] Instance b_is_c f : B f -> C f. Proof. easy. Qed. #[export] Instance c_is_d f : C f -> D f. Proof. easy. Qed. #[export] Instance d_is_e f : D f -> E f. Proof. easy. Qed. #[export] Instance a_compose f g : A f -> A g -> A (compose f g). Proof. easy. Qed. #[export] Instance b_compose f g : B f -> B g -> B (compose f g). Proof. easy. Qed. #[export] Instance c_compose f g : C f -> C g -> C (compose f g). Proof. easy. Qed. #[export] Instance d_compose f g : D f -> D g -> D (compose f g). Proof. easy. Qed. #[export] Instance e_compose f g : E f -> E g -> E (compose f g). Proof. easy. Qed. #[export] Instance a_id : A id. Proof. easy. Qed. #[export] Instance foo f : E (id ∘ id ∘ id ∘ id ∘ id ∘ id ∘ id ∘ id ∘ id ∘ id ∘ id ∘ id ∘ id ∘ id ∘ id ∘ id ∘ id ∘ id ∘ id ∘ id ∘ f ∘ id ∘ id ∘ id ∘ id ∘ id ∘ id ∘ id). Proof. #[export] Hint Cut [_* (a_is_b | b_is_c | c_is_d | d_is_e) (a_compose | b_compose | c_compose | d_compose | e_compose)] : typeclass_instances. Timeout 1 Fail apply _. (* 0.06s *) Abort. End HintCut. (* Check that auto-like tactics do not prefer "eq_refl" over more complex solutions, *) (* e.g. those tactics when considering a goal with existential variables *) (* like "m = ?n" won't pick "plus_n_O" hint over "eq_refl" hint. *) (* See this Coq club post for more detail: *) (* https://sympa.inria.fr/sympa/arc/coq-club/2017-12/msg00103.html *) Goal forall (m : nat), exists n, m = n /\ m = n. intros m; eexists; split; [trivial | reflexivity]. Qed. Section HintTransparent. Definition fn (x : nat) := S x. Create HintDb trans. Hint Resolve eq_refl | (_ = _) : trans. (* No reduction *) Hint Variables Opaque : trans. Hint Constants Opaque : trans. Goal forall x : nat, fn x = S x. Proof. intros. Fail typeclasses eauto with trans. unfold fn. typeclasses eauto with trans. Qed. (** Now allow unfolding fn *) Hint Constants Transparent : trans. Goal forall x : nat, fn x = S x. Proof. intros. typeclasses eauto with trans. Qed. End HintTransparent. coq-8.20.0/test-suite/success/ImplicitArguments.v000066400000000000000000000032261466560755400220150ustar00rootroot00000000000000 Axiom foo : forall (x y z t : nat), nat. Arguments foo {_} _ [z] t. Check (foo 1). Arguments foo {_} _ {z} {t}. Fail Arguments foo {_} _ [z] {t}. Check (foo 1). Definition foo1 [m] n := n + m. Check (foo1 1). Inductive vector {A : Type} : nat -> Type := | vnil : vector 0 | vcons : A -> forall {n'}, vector n' -> vector (S n'). Arguments vector A : clear implicits. Require Import Coq.Program.Program. Program Definition head {A : Type} {n : nat} (v : vector A (S n)) : vector A n := match v with | vnil => ! | vcons a v' => v' end. Fixpoint app {A : Type} {n m : nat} (v : vector A n) (w : vector A m) : vector A (n + m) := match v in vector _ n return vector A (n + m) with | vnil => w | vcons a v' => vcons a (app v' w) end. (* Test sharing information between different hypotheses *) Parameters (a:_) (b:a=0). (* These examples were failing due to a lifting wrongly taking let-in into account *) Definition foo6 (x:=1) : forall {n:nat}, n=n := fun n => eq_refl. Fixpoint foo7 (x:=1) (n:nat) {p:nat} {struct n} : nat. Abort. (* Some example which should succeed with local implicit arguments *) Inductive A {P:forall m {n}, n=m -> Prop} := C : P 0 eq_refl -> A. Inductive B (P:forall m {n}, n=m -> Prop) := D : P 0 eq_refl -> B P. Inductive A' {P:forall m [n], n=m -> Prop} := C' : P 0 eq_refl -> A'. Inductive A'' [P:forall m {n}, n=m -> Prop] (b : bool):= C'' : P 0 eq_refl -> A'' b. Inductive A''' (P:forall m [n], n=m -> Prop) (b : bool):= C''' : P 0 eq_refl -> A''' P b. Definition F (id: forall [A] [x : A], A) := id. Definition G := let id := (fun [A] (x : A) => x) in id. Fail Definition G' := let id := (fun {A} (x : A) => x) in id. coq-8.20.0/test-suite/success/Import.v000066400000000000000000000003321466560755400176220ustar00rootroot00000000000000(* Test visibility of imported objects *) Require Import make_local. (* Check local implicit arguments are not imported *) Check (f nat 0). (* Check local arguments scopes are not imported *) Check (f nat (0*0)). coq-8.20.0/test-suite/success/ImportCat.v000066400000000000000000000031021466560755400202500ustar00rootroot00000000000000Axioms A B C D : Type. Axiom a : A. Module M. Axiom AB : A -> B. Coercion AB : A >-> B. Module Inner. Axiom BC : B -> C. Coercion BC : B >-> C. End Inner. Export Inner. Module Alt. Axiom BD : B -> D. Coercion BD : B >-> D. End Alt. Notation "x <<< y" := (x + y) (at level 22). Reserved Notation "@@". Tactic Notation "@@" := idtac. End M. Module N. Notation "x <<< y" := (x - y) (at level 23). End N. Fail Import(coercions) M(AB). Module Test1. Import(coercions) M. Check a : B. Check a : C. Fail Check a : D. (* names not imported *) Fail Import Alt. Fail Check AB. Check M.AB. Import M.Alt. Check a : D. Import N. (* notations didn't get imported *) End Test1. Module Test2. Import -(coercions) M. Fail Check a : B. Check AB. Fail Check AB a : C. Fail Import N. Check Inner.BC. Import Inner. Check AB a : C. Fail Check a : C. End Test2. Module TestExport. Import M(AB). Module Import(notations) X. Module Y. Definition bla := 0. Coercion AB : A >-> B. End Y. Export(coercions) Y. End X. Fail Check a : B. Import X. Check a : B. Fail Check bla. Check Y.bla. End TestExport. Module Notas. Import -(ltac.notations,notations) M. Import N. Check eq_refl : 1 <<< 1 = 0. Module X. Tactic Notation "@@" := fail. Lemma foo : False. Proof. Fail @@. Abort. End X. Import (ltac.notations) M. Lemma foo : False. Proof. @@. Abort. End Notas. Require Import(notations) Sumbool. Check Sumbool.sumbool_of_bool. Fail Check sumbool_of_bool. coq-8.20.0/test-suite/success/Inductive.v000066400000000000000000000144251466560755400203120ustar00rootroot00000000000000(* Test des definitions inductives imbriquees *) Inductive X : Set := cons1 : list X -> X. Inductive Y : Set := cons2 : list (Y * Y) -> Y. (* Test inductive types with local definitions (arity) *) Inductive eq1 : forall A:Type, let B:=A in A -> Prop := refl1 : eq1 True I. Check fun (P : forall A : Type, let B := A in A -> Type) (f : P True I) (A : Type) => let B := A in fun (a : A) (e : eq1 A a) => match e in (@eq1 A0 B0 a0) return (P A0 a0) with | refl1 => f end. Inductive eq2 (A:Type) (a:A) : forall B C:Type, let D:=(A*B*C)%type in D -> Prop := refl2 : eq2 A a unit bool (a,tt,true). (* Check inductive types with local definitions (parameters) *) Inductive A (C D : Prop) (E:=C) (F:=D) (x y : E -> F) : E -> Set := I : forall z : E, A C D x y z. Check (fun C D : Prop => let E := C in let F := D in fun (x y : E -> F) (P : forall c : C, A C D x y c -> Type) (f : forall z : C, P z (I C D x y z)) (y0 : C) (a : A C D x y y0) => match a as a0 in (A _ _ _ _ y1) return (P y1 a0) with | I _ _ _ _ x0 => f x0 end). Record B (C D : Set) (E:=C) (F:=D) (x y : E -> F) : Set := {p : C; q : E}. Check (fun C D : Set => let E := C in let F := D in fun (x y : E -> F) (P : B C D x y -> Type) (f : forall p0 q0 : C, P (Build_B C D x y p0 q0)) (b : B C D x y) => match b as b0 return (P b0) with | Build_B _ _ _ _ x0 x1 => f x0 x1 end). (* Check inductive types with local definitions (constructors) *) Inductive I1 : Set := C1 (_:I1) (_:=0). Check (fun x:I1 => match x with | C1 i n => (i,n) end). (* Check implicit parameters of inductive types (submitted by Pierre Casteran and also implicit in BZ#338) *) Set Implicit Arguments. Unset Strict Implicit. CoInductive LList (A : Set) : Set := | LNil : LList A | LCons : A -> LList A -> LList A. Arguments LNil {A}. Inductive Finite (A : Set) : LList A -> Prop := | Finite_LNil : Finite LNil | Finite_LCons : forall (a : A) (l : LList A), Finite l -> Finite (LCons a l). (* Check positivity modulo reduction (cf bug BZ#983) *) Record P:Type := {PA:Set; PB:Set}. Definition F (p:P) := (PA p) -> (PB p). Inductive I_F:Set := c : (F (Build_P nat I_F)) -> I_F. (* Check that test for binders capturing implicit arguments is not stronger than needed (problem raised by Cedric Auger) *) Set Implicit Arguments. Inductive bool_comp2 (b: bool): bool -> Prop := | Opp2: forall q, (match b return Prop with | true => match q return Prop with true => False | false => True end | false => match q return Prop with true => True | false => False end end) -> bool_comp2 b q. (* This one is still to be made acceptable... Set Implicit Arguments. Inductive I A : A->Prop := C a : (forall A, A) -> I a. *) (* Test recursively non-uniform parameters (was formerly in params_ind.v) *) Inductive list (A : Set) : Set := | nil : list A | cons : A -> list (A -> A) -> list A. (* Check inference of evars in arity using information from constructors *) Inductive foo1 : forall p, Prop := cc1 : foo1 0. (* Check cross inference of evars from constructors *) Inductive foo2 : forall p, Prop := cc2 : forall q, foo2 q | cc3 : foo2 0. (* An example with reduction removing an occurrence of the inductive type in one of its argument *) Inductive IND1 (A:Type) := CONS1 : IND1 ((fun x => A) IND1). (* These types were considered as ill-formed before March 2015, while they could be accepted considering that the type IND1 above was accepted *) Inductive IND2 (A:Type) (T:=fun _ : Type->Type => A) := CONS2 : IND2 A -> IND2 (T IND2). Inductive IND3 (A:Type) (T:=fun _ : Type->Type => A) := CONS3 : IND3 (T IND3) -> IND3 A. Inductive IND4 (A:Type) := CONS4 : IND4 ((fun x => A) IND4) -> IND4 A. (* This type was ok before March 2015 *) Inductive IND5 (A : Type) (T := A) : Type := CONS5 : IND5 ((fun _ => A) 0) -> IND5 A. (* An example of nested positivity which was rejected by the kernel before 24 March 2015 (even with Unset Elimination Schemes to avoid the _rect bug) due to the wrong computation of non-recursively uniform parameters in list' *) Inductive list' (A:Type) (B:=A) := | nil' : list' A | cons' : A -> list' B -> list' A. Inductive tree := node : list' tree -> tree. (* This type was raising an anomaly when building the _rect scheme, because of a bug in Inductiveops.get_arity in the presence of let-ins and recursively non-uniform parameters. *) Inductive L (A:Type) (T:=A) : Type := C : L nat -> L A. (* This type was raising an anomaly when building the _rect scheme, because of a wrong computation of the number of non-recursively uniform parameters when conversion is needed, leading the example to hit the Inductiveops.get_arity bug mentioned above (see #3491) *) Inductive IND6 (A:Type) (T:=A) := CONS6 : IND6 T -> IND6 A. Module TemplateProp. (** Check lowering of a template universe polymorphic inductive to Prop *) Inductive Foo (A : Type) : Type := foo : A -> Foo A. Check Foo True : Prop. End TemplateProp. Module PolyNoLowerProp. (** Check lowering of a general universe polymorphic inductive to Prop is _failing_ *) Polymorphic Inductive Foo (A : Type) : Type := foo : A -> Foo A. Fail Check Foo True : Prop. End PolyNoLowerProp. (* Test building of elimination scheme with noth let-ins and non-recursively uniform parameters *) Module NonRecLetIn. Unset Implicit Arguments. Inductive Ind (b:=2) (a:nat) (c:=1) : Type := | Base : Ind a | Rec : Ind (S a) -> Ind a. Check Ind_rect (fun n (b:Ind n) => b = b) (fun n => eq_refl) (fun n b c => f_equal (Rec n) eq_refl) 0 (Rec 0 (Base 1)). End NonRecLetIn. (* Test treatment of let-in in the definition of Records *) (* Should fail with "Sort expected" *) Fail Inductive foo (T : Type) : let T := Type in T := { r : forall x : T, x = x }. Module Discharge. (* discharge test *) Section S. Let x := Prop. Inductive foo : x := bla : foo. End S. Check bla:foo. Section S. Variables (A:Type). (* ensure params are scanned for needed section variables even with template arity *) #[universes(template)] Inductive bar (d:A) := . End S. Check @bar nat 0. End Discharge. coq-8.20.0/test-suite/success/InductiveVsImplicitsVsTC.v000066400000000000000000000012741466560755400232370ustar00rootroot00000000000000Module NoConv. Class C := {}. Definition useC {c:C} := nat. Inductive foo {a b : C} := CC : useC -> foo. (* If TC search runs before parameter unification it will pick the wrong instance for the first parameter. useC makes sure we don't completely skip TC search. *) End NoConv. Module ForConv. Class Bla := { bla : Type }. #[export] Instance bli : Bla := { bla := nat }. Inductive vs := C : forall x : bla, x = 2 -> vs. (* here we need to resolve TC to pass the conversion problem if we combined with the previous example it would fail as TC resolution for conversion is unrestricted and so would resolve the conclusion too early. *) End ForConv. coq-8.20.0/test-suite/success/Injection.v000066400000000000000000000076671466560755400203140ustar00rootroot00000000000000Require Eqdep_dec. (* Check the behaviour of Injection *) (* Check that Injection tries Intro until *) Unset Structural Injection. Lemma l1 : forall x : nat, S x = S (S x) -> False. injection 1. apply n_Sn. Qed. Lemma l2 : forall (x : nat) (H : S x = S (S x)), H = H -> False. injection H. intros. apply (n_Sn x H0). Qed. (* Check that no tuple needs to be built *) Lemma l3 : forall x y : nat, existT (fun n : nat => {n = n} + {n = n}) x (left _ (refl_equal x)) = existT (fun n : nat => {n = n} + {n = n}) y (left _ (refl_equal y)) -> x = y. intros x y H. injection H. exact (fun H => H). Qed. (* Check that a tuple is built (actually the same as the initial one) *) Lemma l4 : forall p1 p2 : {0 = 0} + {0 = 0}, existT (fun n : nat => {n = n} + {n = n}) 0 p1 = existT (fun n : nat => {n = n} + {n = n}) 0 p2 -> existT (fun n : nat => {n = n} + {n = n}) 0 p1 = existT (fun n : nat => {n = n} + {n = n}) 0 p2. intros. injection H. exact (fun H => H). Qed. Set Structural Injection. (* Test injection as *) Lemma l5 : forall x y z t : nat, (x,y) = (z,t) -> x=z. intros; injection H as Hxz Hyt. exact Hxz. Qed. (* Check the variants of injection *) Goal forall x y, S x = S y -> True. injection 1 as H'. Undo. intros. injection H as H'. Undo. Ltac f x := injection x. f H. Abort. Goal (forall x y : nat, x = y -> S x = S y) -> True. intros. try injection (H O) || exact I. Qed. Goal (forall x y : nat, x = y -> S x = S y) -> True. intros. einjection (H O). 2:instantiate (1:=O). Abort. Goal (forall x y : nat, x = y -> S x = S y) -> True. intros. einjection (H O ?[y]) as H0. instantiate (y:=O). Abort. (* Test the injection intropattern *) Goal forall (a b:nat) l l', cons a l = cons b l' -> a=b. intros * [= H1 H2]. exact H1. Qed. (* Test injection using K, knowing that an equality is decidable *) (* Basic case, using sigT *) Scheme Equality for nat. Unset Structural Injection. Goal forall n:nat, forall P:nat -> Type, forall H1 H2:P n, existT P n H1 = existT P n H2 -> H1 = H2. intros. injection H. intro H0. exact H0. Abort. Set Structural Injection. Goal forall n:nat, forall P:nat -> Type, forall H1 H2:P n, existT P n H1 = existT P n H2 -> H1 = H2. intros. injection H as H0. exact H0. Abort. (* Test injection using K, knowing that an equality is decidable *) (* Basic case, using sigT, with "as" clause *) Goal forall n:nat, forall P:nat -> Type, forall H1 H2:P n, existT P n H1 = existT P n H2 -> H1 = H2. intros. injection H as H. exact H. Abort. (* Test injection using K, knowing that an equality is decidable *) (* Dependent case not directly exposing sigT *) Inductive my_sig (A : Type) (P : A -> Type) : Type := my_exist : forall x : A, P x -> my_sig A P. Goal forall n:nat, forall P:nat -> Type, forall H1 H2:P n, my_exist _ _ n H1 = my_exist _ _ n H2 -> H1 = H2. intros. injection H as H. exact H. Abort. (* Test injection using K, knowing that an equality is decidable *) (* Dependent case not directly exposing sigT deeply nested *) Goal forall n:nat, forall P:nat -> Type, forall H1 H2:P n, (my_exist _ _ n H1,0) = (my_exist _ _ n H2,0) -> H1 = H2. intros * [= H]. exact H. Abort. (* Test the Keep Proof Equalities option. *) Set Keep Proof Equalities. Unset Structural Injection. Inductive pbool : Prop := Pbool1 | Pbool2. Inductive pbool_shell : Set := Pbsc : pbool -> pbool_shell. Goal Pbsc Pbool1 = Pbsc Pbool2 -> True. injection 1. match goal with |- Pbool1 = Pbool2 -> True => idtac | |- True => fail end. Abort. (* Injection in the presence of local definitions *) Inductive A := B (T := unit) (x y : bool) (z := x). Goal forall x y x' y', B x y = B x' y' -> y = y'. intros * [= H1 H2]. exact H2. Qed. (* Injection does not project at positions in Prop... allow it? Inductive t (A:Prop) : Set := c : A -> t A. Goal forall p q : True\/True, c _ p = c _ q -> False. intros. injection H. Abort. *) (* Injection does not project on discriminable positions... allow it? Goal 1=2 -> 1=0. intro H. injection H. intro; assumption. Qed. *) coq-8.20.0/test-suite/success/Inversion.v000066400000000000000000000123651466560755400203350ustar00rootroot00000000000000Axiom magic : False. (* Submitted by Dachuan Yu (BZ#220) *) Fixpoint T (n : nat) : Type := match n with | O => nat -> Prop | S n' => T n' end. Inductive R : forall n : nat, T n -> nat -> Prop := | RO : forall (Psi : T 0) (l : nat), Psi l -> R 0 Psi l | RS : forall (n : nat) (Psi : T (S n)) (l : nat), R n Psi l -> R (S n) Psi l. Definition Psi00 (n : nat) : Prop := False. Definition Psi0 : T 0 := Psi00. Lemma Inversion_RO : forall l : nat, R 0 Psi0 l -> Psi00 l. inversion 1. Abort. (* Submitted by Pierre Casteran (BZ#540) *) Set Implicit Arguments. Unset Strict Implicit. Parameter rule : Set -> Type. Inductive extension (I : Set) : Type := | NL : extension I | add_rule : rule I -> extension I -> extension I. Inductive in_extension (I : Set) (r : rule I) : extension I -> Type := | in_first : forall e, in_extension r (add_rule r e) | in_rest : forall e r', in_extension r e -> in_extension r (add_rule r' e). Arguments NL {I}. Inductive super_extension (I : Set) (e : extension I) : extension I -> Type := | super_NL : super_extension e NL | super_add : forall r (e' : extension I), in_extension r e -> super_extension e e' -> super_extension e (add_rule r e'). Lemma super_def : forall (I : Set) (e1 e2 : extension I), super_extension e2 e1 -> forall ru, in_extension ru e1 -> in_extension ru e2. Proof. simple induction 1. inversion 1; auto. elim magic. Qed. (* Example from Norbert Schirmer on Coq-Club, Sep 2000 *) Set Strict Implicit. Unset Implicit Arguments. Definition Q (n m : nat) (prf : n <= m) := True. Goal forall (n m : nat) (H : S n <= m), Q (S n) m H = True. intros. dependent inversion_clear H. elim magic. elim magic. Qed. (* Submitted by Boris Yakobowski (BZ#529) *) (* Check that Inversion does not fail due to unnormalized evars *) Set Implicit Arguments. Unset Strict Implicit. Require Import Bvector. Inductive I : nat -> Set := | C1 : I 1 | C2 : forall k i : nat, Vector.t (I i) k -> I i. Inductive SI : forall k : nat, I k -> Vector.t nat k -> nat -> Prop := SC2 : forall (k i vf : nat) (v : Vector.t (I i) k) (xi : Vector.t nat i), SI (C2 v) xi vf. Theorem SUnique : forall (k : nat) (f : I k) (c : Vector.t nat k) v v', SI f c v -> SI f c v' -> v = v'. Proof. induction 1. intros H; inversion H. Admitted. (* Used to failed at some time *) Set Strict Implicit. Unset Implicit Arguments. Parameter bar : forall p q : nat, p = q -> Prop. Inductive foo : nat -> nat -> Prop := C : forall (a b : nat) (Heq : a = b), bar a b Heq -> foo a b. Lemma depinv : forall a b, foo a b -> True. intros a b H. inversion H. Abort. (* Check non-regression of BZ#1968 *) Inductive foo2 : option nat -> Prop := Foo : forall t, foo2 (Some t). Goal forall o, foo2 o -> 0 = 1. intros. eapply trans_eq. inversion H. Abort. (* Check that the part of "injection" that is called by "inversion" does the same number of intros as the number of equations introduced, even in presence of dependent equalities that "injection" renounces to split *) Fixpoint prodn (n : nat) := match n with | O => unit | (S m) => prod (prodn m) nat end. Inductive U : forall n : nat, prodn n -> bool -> Prop := | U_intro : U 0 tt true. Lemma foo3 : forall n (t : prodn n), U n t true -> False. Proof. (* used to fail because dEqThen thought there were 2 new equations but inject_at_positions actually introduced only one; leading then to an inconsistent state that disturbed "inversion" *) intros. inversion H. Abort. (* BZ#2314 (simplified): check that errors do not show as anomalies *) Goal True -> True. intro. Fail inversion H using False. Fail inversion foo using True_ind. Abort. (* Was failing at some time between 7 and 10 September 2014 *) (* even though, it is not clear that the resulting context is interesting *) Parameter P:nat*nat->Prop. Inductive IND : nat * nat -> { x : nat * nat | P x } * nat -> Prop := CONSTR a b (H:P (a,b)) c : IND (a,b) (exist _ (a,b) H, c). Goal forall x y z t u (H':P (z,t)), IND (x,y) (exist _ (z,t) H', u) -> x = z. intros * Hyp. inversion Hyp. (* By the way, why is "H" removed even in non-clear mode ? *) reflexivity. Qed. Goal forall x y z t u (H':P (z,t)), IND (x,y) (exist _ (z,t) H', u) -> x = z. intros * Hyp. inversion Hyp as (a,b,H,c,(H1_1,H1_2),(H2_1,H2_2,H2_3)). reflexivity. Qed. (* Up to September 2014, Mapp below was called MApp0 because of a bug in intro_replacing (short version of BZ#2164.v) (example taken from CoLoR) *) Parameter Term : Type. Parameter isApp : Term -> Prop. Parameter appBodyL : forall M, isApp M -> Prop. Parameter lower : forall M Mapp, appBodyL M Mapp -> Term. Inductive BetaStep : Term -> Term -> Prop := Beta M Mapp Mabs : BetaStep M (lower M Mapp Mabs). Goal forall M N, BetaStep M N -> True. intros M N H. inversion H as (P,Mapp,Mabs,H0,H1). clear Mapp Mabs H0 H1. exact Logic.I. Qed. (* Up to September 2014, H0 below was renamed called H1 because of a collision with the automatically generated names for equations. (example taken from CoLoR) *) Inductive term := Var | Fun : term -> term -> term. Inductive lt : term -> term -> Prop := mpo f g ss ts : lt Var (Fun f ts) -> lt (Fun f ss) (Fun g ts). Goal forall f g ss ts, lt (Fun f ss) (Fun g ts) -> lt Var (Fun f ts). intros. inversion H as (f',g',ss',ts',H0). exact H0. Qed. coq-8.20.0/test-suite/success/InversionSigma.v000066400000000000000000000232771466560755400213220ustar00rootroot00000000000000Section inversion_sigma. Local Unset Implicit Arguments. Context A (B B' : A -> Prop) (C C' : forall a, B a -> Prop) (D : forall a b, C a b -> Prop) (E : forall a b c, D a b c -> Prop). Context (AP : Prop) (BP BP' : AP -> Prop) (CP CP' : forall a, BP a -> Prop) (DP : forall a b, CP a b -> Prop) (EP : forall a b c, DP a b c -> Prop). (* Require that, after destructing sigma types and inverting equalities, we can subst equalities of variables only, and reduce down to [eq_refl = eq_refl]. *) Local Ltac destr_sigma := repeat match goal with | [ H : ex _ |- _ ] => destruct H | [ H : sig _ |- _ ] => destruct H | [ H : sigT _ |- _ ] => destruct H | [ H : ex2 _ _ |- _ ] => destruct H | [ H : sig2 _ _ |- _ ] => destruct H | [ H : sigT2 _ _ |- _ ] => destruct H end; simpl in *. Local Ltac fin_test_inversion_sigma := match goal with | [ |- eq_refl = eq_refl ] => reflexivity end. Local Ltac test_inversion_sigma := intros; destr_sigma; inversion_sigma; repeat match goal with | [ H : ?x = ?y |- _ ] => is_var x; is_var y; subst x; simpl in * end; fin_test_inversion_sigma. Local Ltac test_inversion_sigma_in_H := intros; destr_sigma; repeat match goal with H : _ = _ |- _ => inversion_sigma H end; repeat match goal with | [ H : ?x = ?y |- _ ] => is_var x; is_var y; subst x; simpl in * end; fin_test_inversion_sigma. Goal forall (x y : { a : A & { b : { b : B a & C a b } & { d : D a (projT1 b) (projT2 b) & E _ _ _ d } } }) (p : x = y), p = p. Proof. intros x y p; destr_sigma. inversion_sigma p as [-> p]; cbn [eq_rect] in *. lazymatch type of p with | existT _ (existT _ ?a ?b) (existT _ ?c ?d) = existT _ (existT _ ?e ?f) (existT _ ?g ?h) => is_var a; is_var b; is_var c; is_var d; is_var e; is_var f; is_var g; is_var h end. inversion_sigma p as [p1 p2]. lazymatch type of p1 with existT _ ?a ?b = existT _ ?c ?d => is_var a; is_var b; is_var c; is_var d end. inversion_sigma p1 as [-> <-]; cbn [eq_rect eq_existT_uncurried eq_sigT eq_existT_curried eq_sigT_uncurried] in * |- . lazymatch type of p2 with existT _ ?a ?b = existT _ ?c ?d => is_var a; is_var b; is_var c; is_var d end. inversion_sigma p2 as [-> <-]. cbn. fin_test_inversion_sigma. Qed. Goal forall (x y : { a : A | { b : { b : B a | C a b } | { d : D a (proj1_sig b) (proj2_sig b) | E _ _ _ d } } }) (p : x = y), p = p. Proof. intros x y p; destr_sigma. inversion_sigma p as [-> p]; cbn [eq_rect] in *. lazymatch type of p with | exist _ (exist _ ?a ?b) (exist _ ?c ?d) = exist _ (exist _ ?e ?f) (exist _ ?g ?h) => is_var a; is_var b; is_var c; is_var d; is_var e; is_var f; is_var g; is_var h end. inversion_sigma p as [p1 p2]. lazymatch type of p1 with exist _ ?a ?b = exist _ ?c ?d => is_var a; is_var b; is_var c; is_var d end. inversion_sigma p1 as [-> <-]; cbn [eq_rect eq_exist_uncurried eq_sig eq_exist_curried eq_sig_uncurried] in * |- . lazymatch type of p2 with exist _ ?a ?b = exist _ ?c ?d => is_var a; is_var b; is_var c; is_var d end. inversion_sigma p2 as [-> <-]. cbn. fin_test_inversion_sigma. Qed. Goal forall (x y : exists a : AP, exists b : exists b : BP a, CP a b, exists d : DP a (ex_proj1 b) (ex_proj2 b), EP _ _ _ d) (p : x = y), p = p. Proof. intros x y p; destr_sigma. inversion_sigma p as [-> p]; cbn [eq_rect] in *. lazymatch type of p with | ex_intro _ (ex_intro _ ?a ?b) (ex_intro _ ?c ?d) = ex_intro _ (ex_intro _ ?e ?f) (ex_intro _ ?g ?h) => is_var a; is_var b; is_var c; is_var d; is_var e; is_var f; is_var g; is_var h end. inversion_sigma p as [p1 p2]. lazymatch type of p1 with ex_intro _ ?a ?b = ex_intro _ ?c ?d => is_var a; is_var b; is_var c; is_var d end. inversion_sigma p1 as [-> <-]; cbn [eq_rect eq_ex_intro_uncurried eq_ex_intro eq_ex eq_ex_uncurried] in * |- . lazymatch type of p2 with ex_intro _ ?a ?b = ex_intro _ ?c ?d => is_var a; is_var b; is_var c; is_var d end. inversion_sigma p2 as [-> <-]. cbn. fin_test_inversion_sigma. Qed. Goal forall (x y : { a : { a : A & B a } & C _ (projT2 a) & C' _ (projT2 a) }) (p : x = y), p = p. Proof. intros x y p; destr_sigma. inversion_sigma p as [p <- <-]; cbn [eq_rect] in *. lazymatch type of p with existT _ ?a ?b = existT _ ?c ?d => is_var a; is_var b; is_var c; is_var d end. inversion_sigma p as [-> <-]. cbn. fin_test_inversion_sigma. Qed. Goal forall (x y : { a : { a : A & B a } | C _ (projT2 a) & C' _ (projT2 a) }) (p : x = y), p = p. Proof. intros x y p; destr_sigma. inversion_sigma p as [p <- <-]; cbn [eq_rect] in *. lazymatch type of p with existT _ ?a ?b = existT _ ?c ?d => is_var a; is_var b; is_var c; is_var d end. inversion_sigma p as [-> <-]. cbn. fin_test_inversion_sigma. Qed. Goal forall (x y : exists2 a : exists a : AP, BP a, CP _ (ex_proj2 a) & CP' _ (ex_proj2 a)) (p : x = y), p = p. Proof. intros x y p; destr_sigma. inversion_sigma p as [p <- <-]; cbn [eq_rect] in *. lazymatch type of p with ex_intro _ ?a ?b = ex_intro _ ?c ?d => is_var a; is_var b; is_var c; is_var d end. inversion_sigma p as [-> <-]. cbn. fin_test_inversion_sigma. Qed. Goal forall (x y : { a : { a : A & B a & B' a } & C _ (projT2 (sigT_of_sigT2 a)) & C' _ (projT2 (sigT_of_sigT2 a)) }) (p : x = y), p = p. Proof. intros x y p; destr_sigma. inversion_sigma p as [p <- <-]; cbn [eq_rect] in *. lazymatch type of p with existT2 _ _ ?a ?b ?c = existT2 _ _ ?d ?e ?f => is_var a; is_var b; is_var c; is_var d; is_var e; is_var f end. inversion_sigma p as [-> <- <-]. cbn. fin_test_inversion_sigma. Qed. Goal forall (x y : { a : { a : A & B a & B' a } | C _ (projT2 (sigT_of_sigT2 a)) & C' _ (projT2 (sigT_of_sigT2 a)) }) (p : x = y), p = p. Proof. intros x y p; destr_sigma. inversion_sigma p as [p <- <-]; cbn [eq_rect] in *. lazymatch type of p with existT2 _ _ ?a ?b ?c = existT2 _ _ ?d ?e ?f => is_var a; is_var b; is_var c; is_var d; is_var e; is_var f end. inversion_sigma p as [-> <- <-]. cbn. fin_test_inversion_sigma. Qed. Goal forall (x y : exists2 a : exists2 a : AP, BP a & BP' a, CP _ (ex_proj2 (ex_of_ex2 a)) & CP' _ (ex_proj2 (ex_of_ex2 a))) (p : x = y), p = p. Proof. intros x y p; destr_sigma. inversion_sigma p as [p <- <-]; cbn [eq_rect] in *. lazymatch type of p with ex_intro2 _ _ ?a ?b ?c = ex_intro2 _ _ ?d ?e ?f => is_var a; is_var b; is_var c; is_var d; is_var e; is_var f end. inversion_sigma p as [-> <- <-]. cbn. fin_test_inversion_sigma. Qed. Goal forall (x y : { a : A & { b : { b : B a & C a b } & { d : D a (projT1 b) (projT2 b) & E _ _ _ d } } }) (p : x = y), p = p. Proof. test_inversion_sigma. Qed. Goal forall (x y : { a : A | { b : { b : B a | C a b } | { d : D a (proj1_sig b) (proj2_sig b) | E _ _ _ d } } }) (p : x = y), p = p. Proof. test_inversion_sigma. Qed. Goal forall (x y : exists a : AP, exists b : exists b : BP a, CP a b, exists d : DP a (ex_proj1 b) (ex_proj2 b), EP _ _ _ d) (p : x = y), p = p. Proof. test_inversion_sigma. Qed. Goal forall (x y : { a : { a : A & B a } & C _ (projT2 a) & C' _ (projT2 a) }) (p : x = y), p = p. Proof. test_inversion_sigma. Qed. Goal forall (x y : { a : { a : A & B a } | C _ (projT2 a) & C' _ (projT2 a) }) (p : x = y), p = p. Proof. test_inversion_sigma. Qed. Goal forall (x y : { a : { a : A & B a & B' a } | C _ (projT2 (sigT_of_sigT2 a)) & C' _ (projT2 (sigT_of_sigT2 a)) }) (p : x = y), p = p. Proof. test_inversion_sigma. Qed. Goal forall (x y : { a : { a : A & B a & B' a } | C _ (projT2 (sigT_of_sigT2 a)) & C' _ (projT2 (sigT_of_sigT2 a)) }) (p : x = y), p = p. Proof. test_inversion_sigma. Qed. Goal forall (x y : exists2 a : exists2 a : AP, BP a & BP' a, CP _ (ex_proj2 (ex_of_ex2 a)) & CP' _ (ex_proj2 (ex_of_ex2 a))) (p : x = y), p = p. Proof. test_inversion_sigma. Qed. Goal forall (x y : { a : A & { b : { b : B a & C a b } & { d : D a (projT1 b) (projT2 b) & E _ _ _ d } } }) (p : x = y), p = p. Proof. test_inversion_sigma_in_H. Qed. Goal forall (x y : { a : A | { b : { b : B a | C a b } | { d : D a (proj1_sig b) (proj2_sig b) | E _ _ _ d } } }) (p : x = y), p = p. Proof. test_inversion_sigma_in_H. Qed. Goal forall (x y : exists a : AP, exists b : exists b : BP a, CP a b, exists d : DP a (ex_proj1 b) (ex_proj2 b), EP _ _ _ d) (p : x = y), p = p. Proof. test_inversion_sigma_in_H. Qed. Goal forall (x y : { a : { a : A & B a } & C _ (projT2 a) & C' _ (projT2 a) }) (p : x = y), p = p. Proof. test_inversion_sigma_in_H. Qed. Goal forall (x y : { a : { a : A & B a } | C _ (projT2 a) & C' _ (projT2 a) }) (p : x = y), p = p. Proof. test_inversion_sigma_in_H. Qed. Goal forall (x y : { a : { a : A & B a & B' a } | C _ (projT2 (sigT_of_sigT2 a)) & C' _ (projT2 (sigT_of_sigT2 a)) }) (p : x = y), p = p. Proof. test_inversion_sigma_in_H. Qed. Goal forall (x y : { a : { a : A & B a & B' a } | C _ (projT2 (sigT_of_sigT2 a)) & C' _ (projT2 (sigT_of_sigT2 a)) }) (p : x = y), p = p. Proof. test_inversion_sigma_in_H. Qed. Goal forall (x y : exists2 a : exists2 a : AP, BP a & BP' a, CP _ (ex_proj2 (ex_of_ex2 a)) & CP' _ (ex_proj2 (ex_of_ex2 a))) (p : x = y), p = p. Proof. test_inversion_sigma_in_H. Qed. End inversion_sigma. coq-8.20.0/test-suite/success/LetIn.v000066400000000000000000000005441466560755400173700ustar00rootroot00000000000000(* Simple let-in's *) Definition l1 := let P := 0 in P. Definition l2 := let P := nat in P. Definition l3 := let P := True in P. Definition l4 := let P := Prop in P. Definition l5 := let P := Type in P. (* Check casting of let-in *) Definition l6 := let P := 0:nat in P. Definition l7 := let P := True:Prop in P. Definition l8 := let P := True:Type in P. coq-8.20.0/test-suite/success/LetPat.v000066400000000000000000000033411466560755400175440ustar00rootroot00000000000000(* Simple let-patterns *) Parameter A B : Type. Definition l1 (t : A * B * B) : A := let '(x, y, z) := t in x. Print l1. Definition l2 (t : (A * B) * B) : A := let '((x, y), z) := t in x. Definition l3 (t : A * (B * B)) : A := let '(x, (y, z)) := t in x. Print l3. Record someT (A : Type) := mkT { a : nat; b: A }. Definition l4 A (t : someT A) : nat := let 'mkT _ x y := t in x. Print l4. Print sigT. Definition l5 A (B : A -> Type) (t : sigT B) : B (projT1 t) := let 'existT _ x y := t return B (projT1 t) in y. Definition l6 A (B : A -> Type) (t : sigT B) : B (projT1 t) := let 'existT _ x y as t' := t return B (projT1 t') in y. Definition l7 A (B : A -> Type) (t : sigT B) : B (projT1 t) := let 'existT _ x y as t' in sigT _ := t return B (projT1 t') in y. Definition l8 A (B : A -> Type) (t : sigT B) : B (projT1 t) := match t with existT _ x y => y end. (** An example from algebra, using let' and inference of return clauses to deconstruct contexts. *) Record a_category (A : Type) (hom : A -> A -> Type) := { }. Definition category := { A : Type & { hom : A -> A -> Type & a_category A hom } }. Record a_functor (A : Type) (hom : A -> A -> Type) (C : a_category A hom) := { }. Notation " x :& y " := (@existT _ _ x y) (right associativity, at level 55) : core_scope. Definition functor (c d : category) := let ' A :& homA :& CA := c in let ' B :& homB :& CB := d in A -> B. Definition identity_functor (c : category) : functor c c := let 'A :& homA :& CA := c in fun x => x. Definition functor_composition (a b c : category) : functor a b -> functor b c -> functor a c := let 'A :& homA :& CA := a in let 'B :& homB :& CB := b in let 'C :& homB :& CB := c in fun f g => fun x => g (f x). coq-8.20.0/test-suite/success/LocalDefinition.v000066400000000000000000000024561466560755400214240ustar00rootroot00000000000000(* Test consistent behavior of Local Definition (#8722) *) (* Test consistent behavior of Local Definition wrt Admitted *) Module TestAdmittedVisibility. Module A. #[warning="declaration-outside-section"] Let a1 : nat. Admitted. (* Suppose to behave like a "Local Definition" *) Local Definition b1 : nat. Admitted. (* Told to be a "Local Definition" *) Local Definition c1 := 0. Local Parameter d1 : nat. Section S. Let a2 : nat. Admitted. (* Told to be turned into a toplevel assumption *) Local Definition b2 : nat. Admitted. (* Told to be a "Local Definition" *) Local Definition c2 := 0. Local Parameter d2 : nat. End S. End A. Import A. Fail Check a1. (* used to be accepted *) Fail Check b1. (* used to be accepted *) Fail Check c1. Fail Check d1. Fail Check a2. (* used to be accepted *) Fail Check b2. (* used to be accepted *) Fail Check c2. Fail Check d2. End TestAdmittedVisibility. Module TestVariableAsInstances. Class U. Local Parameter b : U. Fail Definition testU := _ : U. (* _ unresolved *) Class T. #[warning="declaration-outside-section"] Variable a : T. (* warned to be the same as "Local Parameter" thus should not be an instance *) Fail Definition testT := _ : T. (* used to succeed *) End TestVariableAsInstances. coq-8.20.0/test-suite/success/LraTest.v000066400000000000000000000004351466560755400177320ustar00rootroot00000000000000Require Import Reals. Require Import Lra. Open Scope R_scope. Lemma l1 : forall x y z : R, Rabs (x - z) <= Rabs (x - y) + Rabs (y - z). intros; split_Rabs; lra. Qed. Lemma l2 : forall x y : R, x < Rabs y -> y < 1 -> x >= 0 -> - y <= 1 -> Rabs x <= 1. intros. split_Rabs; lra. Qed. coq-8.20.0/test-suite/success/LtacDeprecation.v000066400000000000000000000007311466560755400214140ustar00rootroot00000000000000Set Warnings "+deprecated". #[deprecated(since = "8.8", note = "Use idtac instead")] Ltac foo x := idtac. Goal True. Fail (foo true). Abort. Fail Ltac bar := foo. Fail Tactic Notation "bar" := foo. #[deprecated(since = "8.8", note = "Use idtac instead")] Tactic Notation "bar" := idtac. Goal True. Fail bar. Abort. Fail Ltac zar := bar. Set Warnings "-deprecated". Ltac zar := foo. Ltac zarzar := bar. Set Warnings "+deprecated". Goal True. zar x. zarzar. Abort. coq-8.20.0/test-suite/success/MangleNamesLight.v000066400000000000000000000010721466560755400215310ustar00rootroot00000000000000Axiom X : Type. Goal forall (x y z : X), X. intro. Check x. Set Mangle Names. intro. Fail Check y. Check _0. Set Mangle Names Light. intro. Fail Check z. Fail Check _1. Check _z. Abort. Fixpoint Lots (n : nat) : Type := match n with | 0 => X | S k => forall (x : X), Lots k end. Goal Lots 10. assert (_x8 : X) by admit. cbv; intros. Check _x9. Abort. Fixpoint Lots' (x : X) (n : nat) : Type := match n with | 0 => X | S k => forall _x, Lots' _x k end. Goal forall _x0, Lots' _x0 10. assert (_x8 : X) by admit. cbv; intros. Check __x9. simpl. Abort. coq-8.20.0/test-suite/success/MatchFail.v000066400000000000000000000015141466560755400202030ustar00rootroot00000000000000Require Export ZArith. Require Export ZArithRing. (* Cette tactique a pour objectif de remplacer toute instance de (POS (xI e)) ou de (POS (xO e)) par 2*(POS e)+1 ou 2*(POS e), pour rendre les expressions plus à même d'être utilisées par Ring, lorsque ces expressions contiennent des variables de type positive. *) Ltac compute_POS := match goal with | |- context [(Zpos (xI ?X1))] => let v := constr:(X1) in match constr:(v) with | 1%positive => fail 1 | _ => rewrite (BinInt.Pos2Z.inj_xI v) end | |- context [(Zpos (xO ?X1))] => let v := constr:(X1) in match constr:(v) with | 1%positive => fail 1 | _ => rewrite (BinInt.Pos2Z.inj_xO v) end end. Goal forall x : positive, Zpos (xI (xI x)) = (4 * Zpos x + 3)%Z. intros. repeat compute_POS. ring. Qed. coq-8.20.0/test-suite/success/Mod_ltac.v000066400000000000000000000004561466560755400201010ustar00rootroot00000000000000(* Submitted by Houda Anoun *) Module toto. Ltac titi := auto. End toto. Module ti. Import toto. Ltac equal := match goal with | |- (?X1 = ?X1) => titi | |- _ => idtac end. End ti. Import ti. Definition simple : forall a : nat, a = a. intro. equal. Qed. coq-8.20.0/test-suite/success/Mod_params.v000066400000000000000000000025371466560755400204430ustar00rootroot00000000000000(* Syntax test - all possible kinds of module parameters *) Module Type SIG. End SIG. Module Type FSIG (X: SIG). End FSIG. Module F (X: SIG). End F. Module Q. End Q. (* #trace Nametab.push;; #trace Nametab.push_short_name;; #trace Nametab.freeze;; #trace Nametab.unfreeze;; #trace Nametab.exists_cci;; *) Module M01. End M01. Module M02 (X: SIG). End M02. Module M03 (X Y: SIG). End M03. Module M04 (X: SIG) (Y: SIG). End M04. Module M05 (X Y: SIG) (Z1 Z: SIG). End M05. Module M06 (X: SIG) (Y: SIG). End M06. Module M07 (X Y: SIG) (Z1 Z: SIG). End M07. Module M08 : SIG. End M08. Module M09 (X: SIG) : SIG. End M09. Module M10 (X Y: SIG) : SIG. End M10. Module M11 (X: SIG) (Y: SIG) : SIG. End M11. Module M12 (X Y: SIG) (Z1 Z: SIG) : SIG. End M12. Module M13 (X: SIG) (Y: SIG) : SIG. End M13. Module M14 (X Y: SIG) (Z1 Z: SIG) : SIG. End M14. Module M15 := F Q. Module M16 (X: FSIG) := X Q. Module M17 (X Y: FSIG) := X Q. Module M18 (X: FSIG) (Y: SIG) := X Y. Module M19 (X Y: FSIG) (Z1 Z: SIG) := X Z. Module M20 (X: FSIG) (Y: SIG) := X Y. Module M21 (X Y: FSIG) (Z1 Z: SIG) := X Z. Module M22 : SIG := F Q. Module M23 (X: FSIG) : SIG := X Q. Module M24 (X Y: FSIG) : SIG := X Q. Module M25 (X: FSIG) (Y: SIG) : SIG := X Y. Module M26 (X Y: FSIG) (Z1 Z: SIG) : SIG := X Z. Module M27 (X: FSIG) (Y: SIG) : SIG := X Y. Module M28 (X Y: FSIG) (Z1 Z: SIG) : SIG := X Z. coq-8.20.0/test-suite/success/Mod_strengthen.v000066400000000000000000000017031466560755400213330ustar00rootroot00000000000000Module Type Sub. Axiom Refl1 : forall x : nat, x = x. Axiom Refl2 : forall x : nat, x = x. Axiom Refl3 : forall x : nat, x = x. Inductive T : Set := A : T. End Sub. Module Type Main. Declare Module M: Sub. End Main. Module A <: Main. Module M <: Sub. Lemma Refl1 : forall x : nat, x = x. intros; reflexivity. Qed. Axiom Refl2 : forall x : nat, x = x. Lemma Refl3 : forall x : nat, x = x. intros; reflexivity. Defined. Inductive T : Set := A : T. End M. End A. (* first test *) Module F (S: Sub). Module M := S. End F. Module B <: Main with Module M:=A.M := F A.M. (* second test *) Lemma r1 : (A.M.Refl1 = B.M.Refl1). Proof. reflexivity. Qed. Lemma r2 : (A.M.Refl2 = B.M.Refl2). Proof. reflexivity. Qed. Lemma r3 : (A.M.Refl3 = B.M.Refl3). Proof. reflexivity. Qed. Lemma t : (A.M.T = B.M.T). Proof. reflexivity. Qed. Lemma a : (A.M.A = B.M.A). Proof. reflexivity. Qed. coq-8.20.0/test-suite/success/Mod_type.v000066400000000000000000000010031466560755400201240ustar00rootroot00000000000000(* Check BZ#1025 submitted by Pierre-Luc Carmel Biron *) Module Type FOO. Parameter A : Type. End FOO. Module Type BAR. Declare Module Foo : FOO. End BAR. Module Bar : BAR. Module Fu : FOO. Definition A := Prop. End Fu. Module Foo := Fu. End Bar. (* Check BZ#2809: correct printing of modules with notations *) Module C. Inductive test : Type := | c1 : test | c2 : nat -> test. Notation "! x" := (c2 x) (at level 50). End C. Print C. (* Should print test_rect without failing *) coq-8.20.0/test-suite/success/NatRing.v000066400000000000000000000001751466560755400177170ustar00rootroot00000000000000Require Import ArithRing. Lemma l1 : 2 = 1 + 1. ring. Qed. Lemma l2 : forall x : nat, S (S x) = 1 + S x. intro. ring. Qed. coq-8.20.0/test-suite/success/NestedInd.v000066400000000000000000000134551466560755400202370ustar00rootroot00000000000000Require Import Utf8. Unset Elimination Schemes. Definition Decision (P : Prop) := {P} + {¬ P}. Definition RelDecision {A B : Type} (R : A → B → Prop) := ∀ (x : A) (y : B), Decision (R x y) : Type. Inductive gmap_dep_ne (A : Type) : Type := GNode001 : gmap_dep_ne A → gmap_dep_ne A | GNode010 : A → gmap_dep_ne A | GNode011 : A → gmap_dep_ne A → gmap_dep_ne A | GNode100 : gmap_dep_ne A → gmap_dep_ne A | GNode101 : gmap_dep_ne A → gmap_dep_ne A → gmap_dep_ne A | GNode110 : gmap_dep_ne A → A → gmap_dep_ne A | GNode111 : gmap_dep_ne A → A → gmap_dep_ne A → gmap_dep_ne A. Variant gmap_dep (A : Type) : Type := GEmpty : gmap_dep A | GNodes : gmap_dep_ne A → gmap_dep A. Arguments GEmpty {A}. Arguments GNodes {A}. Record gmap {K : Type} (EqDecision0 : RelDecision (@eq K)) (A : Type) : Type := GMap { gmap_car : gmap_dep A }. Inductive gtest {K : Type} (H : RelDecision (@eq K)) := GTest : gmap H (gtest H) → gtest H. Arguments GTest {_ _} _. Definition option_union_with (A : Type) (f : A → A → option A) (mx my : option A) := match mx with | Some x => match my with | Some y => f x y | None => Some x end | None => match my with | Some y => Some y | None => None end end. Definition gmap_dep_ne_case (A : Type) (B : Type) (t : gmap_dep_ne A) (f : gmap_dep A → option A → gmap_dep A → B) := match t with | GNode001 _ r => f GEmpty None (GNodes r) | GNode010 _ x => f GEmpty (Some (x)) GEmpty | GNode011 _ x r => f GEmpty (Some (x)) (GNodes r) | GNode100 _ l => f (GNodes l) None GEmpty | GNode101 _ l r => f (GNodes l) None (GNodes r) | GNode110 _ l x => f (GNodes l) (Some (x)) GEmpty | GNode111 _ l x r => f (GNodes l) (Some (x)) (GNodes r) end. Definition gmap_dep_omap_aux {A B : Type} (go : gmap_dep_ne A → gmap_dep B) (tm : gmap_dep A) := match tm with | GEmpty => GEmpty | GNodes t' => go t' end. Definition option_bind {A B : Type} (f : A → option B) (mx : option A) := match mx with | Some x => f x | None => None end. Definition GNode (A : Type) (ml : gmap_dep A) (mx : option (A)) (mr : gmap_dep A) := match ml with | GEmpty => match mx with | Some x => match mr with | GEmpty => GNodes (GNode010 _ x) | GNodes r => GNodes (GNode011 _ x r) end | None => match mr with | GEmpty => GEmpty | GNodes r => GNodes (GNode001 _ r) end end | GNodes l => match mx with | Some (x) => match mr with | GEmpty => GNodes (GNode110 _ l x) | GNodes r => GNodes (GNode111 _ l x r) end | None => match mr with | GEmpty => GNodes (GNode100 _ l) | GNodes r => GNodes (GNode101 _ l r) end end end. Definition gmap_dep_ne_omap (A B : Type) (f : A → option B) := fix go (t : gmap_dep_ne A) {struct t} : gmap_dep B := gmap_dep_ne_case _ _ t (λ (ml : gmap_dep A) (mx : option A) (mr : gmap_dep A), GNode _ (gmap_dep_omap_aux (go) ml) (option_bind f mx) (gmap_dep_omap_aux (go) mr)). Definition gmap_merge_aux (A B C : Type) (go : gmap_dep_ne A → gmap_dep_ne B → gmap_dep C) (f : option A → option B → option C) (mt1 : gmap_dep A) (mt2 : gmap_dep B) := match mt1 with | GEmpty => match mt2 with | GEmpty => GEmpty | GNodes t2' => gmap_dep_ne_omap _ _ (λ x : B, f None (Some x)) t2' end | GNodes t1' => match mt2 with | GEmpty => gmap_dep_ne_omap _ _ (λ x : A, f (Some x) None) t1' | GNodes t2' => go t1' t2' end end. Definition diag_None' {A B C : Type} (f : option A → option B → option C) (mx : option (A)) (my : option (B)) := match mx with | Some (x) => match my with | Some (y) => f (Some x) (Some y) | None => f (Some x) None end | None => match my with | Some (y) => f None (Some y) | None => None end end. Definition gmap_dep_ne_merge {A B C : Type} (f : option A → option B → option C) := fix go (t1 : gmap_dep_ne A) (t2 : gmap_dep_ne B) {struct t1} : gmap_dep C := gmap_dep_ne_case _ _ t1 (λ (ml1 : gmap_dep A) (mx1 : option (A)) (mr1 : gmap_dep A) , gmap_dep_ne_case _ _ t2 (λ (ml2 : gmap_dep B) (mx2 : option (B)) (mr2 : gmap_dep B), GNode _ (gmap_merge_aux _ _ _ go f ml1 ml2) (diag_None' f mx1 mx2) (gmap_merge_aux _ _ _ go f mr1 mr2))). Definition gmap_dep_merge {A B C : Type} (f : option A → option B → option C) := gmap_merge_aux _ _ _ (gmap_dep_ne_merge f) f : gmap_dep A → gmap_dep B → gmap_dep C. Definition gmap_merge (K : Type) (H : RelDecision (@eq K)) (A B C : Type) (f : option A → option B → option C) := (fun '{| gmap_car := mt1 |} '{| gmap_car := mt2 |} => {| gmap_car := gmap_dep_merge f mt1 mt2 |}) : (gmap H A) -> (gmap H B) -> (gmap H C). Fixpoint gtest_merge {K : Type} (H : RelDecision (@eq K)) (t1 t2 : gtest H) {struct t1} : gtest H := match t1, t2 with | GTest ts1, GTest ts2 => GTest (gmap_merge K H _ _ _ (@option_union_with _ (λ t1 t2, Some (gtest_merge H t1 t2))) ts1 ts2) end. (* An example from metacoq (simplified) *) Notation "x .π2" := (projT2 x) (at level 0). Parameter term : Type. Inductive All (P : term -> Type) : Type := | All_cons : {x:term & P x} -> All P -> All P. Inductive inferring (Σ : unit) : term -> Type := | infer x : All (inferring Σ) -> inferring Σ x. Fixpoint inferring_size {Σ t} (d : inferring Σ t) {struct d} : nat := match d with | infer _ _ (All_cons _ p _) => inferring_size p.π2 end. coq-8.20.0/test-suite/success/Nia.v000066400000000000000000001463721466560755400170760ustar00rootroot00000000000000(* -*- coqchk-prog-args: ("-bytecode-compiler" "yes") -*- *) Require Import Coq.ZArith.ZArith. Require Import Coq.micromega.Lia. Open Scope Z_scope. (** Add [Z.to_euclidean_division_equations] to the end of [zify], just for this file. *) Require Zify. Ltac Zify.zify_post_hook ::= Z.to_euclidean_division_equations. Lemma Z_zerop_or x : x = 0 \/ x <> 0. Proof. apply Z.eq_decidable. Qed. Lemma Z_eq_dec_or (x y : Z) : x = y \/ x <> y. Proof. apply Z.eq_decidable. Qed. Ltac with_mod tac := match goal with | [ |- context[?x mod ?y] ] => tac x y | [ H : context[?x mod ?y] |- _ ] => tac x y end. Ltac with_rem tac := match goal with | [ |- context[Z.rem ?x ?y] ] => tac x y | [ H : context[Z.rem ?x ?y] |- _ ] => tac x y end. Ltac with_div tac := match goal with | [ |- context[?x / ?y] ] => tac x y | [ H : context[?x / ?y] |- _ ] => tac x y end. Ltac with_quot tac := match goal with | [ |- context[Z.quot ?x ?y] ] => tac x y | [ H : context[Z.quot ?x ?y] |- _ ] => tac x y end. Ltac with_mod_rem tac := first [ with_mod tac | with_rem tac ]. Ltac with_div_quot tac := first [ with_div tac | with_quot tac ]. Ltac with_div_mod tac := first [ with_div tac | with_mod tac ]. Ltac with_quot_rem tac := first [ with_quot tac | with_rem tac ]. Ltac pose_eq_fact x y := Z.euclidean_division_equations_pose_eq_fact x y. Ltac saturate_mod_div_0 := repeat first [ with_mod_rem ltac:(fun x y => pose_eq_fact (x / y) 0) | with_div_quot ltac:(fun x y => pose_eq_fact y 0) ]. Ltac saturate_quot_div_0 := repeat first [ with_quot ltac:(fun x y => pose_eq_fact (x ÷ y) 0) | with_div ltac:(fun x y => pose_eq_fact (x / y) 0) ]. Ltac saturate_mod_div_eq := let with_the_quot tac := first [ with_div_mod ltac:(fun x y => tac (x / y)) | with_quot_rem ltac:(fun x y => tac (x ÷ y)) ] in repeat with_the_quot ltac:(fun q => with_the_quot ltac:(fun q' => pose_eq_fact q q')). Ltac destr_step := match goal with | [ H : and _ _ |- _ ] => destruct H | [ H : or _ _ |- _ ] => destruct H end. Ltac t := intros; saturate_mod_div_0; try nia. Ltac t_zero := intros; saturate_mod_div_0; saturate_quot_div_0; try nia. (* sometimes this next one is faster? *) Ltac t_zero_subst := intros; saturate_mod_div_0; saturate_quot_div_0; repeat destr_step; try nia. Ltac t_eq := intros; saturate_mod_div_eq; try nia. Ltac t_all := intros; saturate_mod_div_0; saturate_mod_div_eq; try nia. Example mod_0_l: forall x : Z, 0 mod x = 0. Proof. t. Qed. Example mod_0_r: forall x : Z, x mod 0 = x. Proof. intros; nia. Qed. Example Z_mod_same_full: forall a : Z, a mod a = 0. Proof. t. Qed. Example Zmod_0_l: forall a : Z, 0 mod a = 0. Proof. t. Qed. Example Zmod_0_r: forall a : Z, a mod 0 = a. Proof. intros; nia. Qed. Example mod_mod_same: forall x y : Z, (x mod y) mod y = x mod y. Proof. t. Qed. Example Zmod_mod: forall a n : Z, (a mod n) mod n = a mod n. Proof. t. Qed. Example Zmod_1_r: forall a : Z, a mod 1 = 0. Proof. intros; nia. Qed. Example Zmod_div: forall a b : Z, a mod b / b = 0. Proof. intros; nia. Qed. Example Z_mod_1_r: forall a : Z, a mod 1 = 0. Proof. intros; nia. Qed. Example Z_mod_same: forall a : Z, a > 0 -> a mod a = 0. Proof. t. Qed. Example Z_mod_mult: forall a b : Z, (a * b) mod b = 0. Proof. intros; nia. Qed. Example Z_mod_same': forall a : Z, a <> 0 -> a mod a = 0. Proof. t. Qed. Example Z_mod_0_l: forall a : Z, a <> 0 -> 0 mod a = 0. Proof. t. Qed. Example Zmod_opp_opp: forall a b : Z, - a mod - b = - (a mod b). Proof. t_eq. Qed. Example Z_mod_le: forall a b : Z, 0 <= a -> 0 < b -> a mod b <= a. Proof. t. Qed. Example Zmod_le: forall a b : Z, 0 < b -> 0 <= a -> a mod b <= a. Proof. t. Qed. Example Zplus_mod_idemp_r: forall a b n : Z, (b + a mod n) mod n = (b + a) mod n. Proof. intros a b n. destruct (Z_zerop n); [ subst; nia | ]. assert ((b + a mod n) / n = (b / n) + (b mod n + a mod n) / n) by nia. assert ((b + a) / n = (b / n) + (a / n) + (b mod n + a mod n) / n) by nia. nia. Qed. Example Zplus_mod_idemp_l: forall a b n : Z, (a mod n + b) mod n = (a + b) mod n. Proof. intros a b n. destruct (Z_zerop n); [ subst; nia | ]. assert ((a mod n + b) / n = (b / n) + (b mod n + a mod n) / n) by nia. assert ((a + b) / n = (b / n) + (a / n) + (b mod n + a mod n) / n) by nia. nia. Qed. Example Z_mod_zero_opp_full: forall a b : Z, a mod b = 0 -> - a mod b = 0. Proof. intros a b. pose proof (Z_eq_dec_or (a/b) (-(-a/b))). nia. Qed. Example Zmult_mod_idemp_r: forall a b n : Z, (b * (a mod n)) mod n = (b * a) mod n. Proof. intros a b n. destruct (Z_zerop n); [ subst; nia | ]. assert ((b * (a mod n)) / n = (b / n) * (a mod n) + ((b mod n) * (a mod n)) / n) by nia. assert ((b * a) / n = (b / n) * (a / n) * n + (b / n) * (a mod n) + (b mod n) * (a / n) + ((b mod n) * (a mod n)) / n) by nia. nia. Qed. Example Zmult_mod_idemp_l: forall a b n : Z, (a mod n * b) mod n = (a * b) mod n. Proof. intros a b n. destruct (Z_zerop n); [ subst; nia | ]. assert (((a mod n) * b) / n = (b / n) * (a mod n) + ((b mod n) * (a mod n)) / n) by nia. assert ((a * b) / n = (b / n) * (a / n) * n + (b / n) * (a mod n) + (b mod n) * (a / n) + ((b mod n) * (a mod n)) / n) by nia. nia. Qed. Example Zminus_mod_idemp_r: forall a b n : Z, (a - b mod n) mod n = (a - b) mod n. Proof. intros a b n. destruct (Z_zerop n); [ subst; nia | ]. assert ((a - b mod n) / n = a / n + ((a mod n) - (b mod n)) / n) by nia. assert ((a - b) / n = a / n - b / n + ((a mod n) - (b mod n)) / n) by nia. nia. Qed. Example Zminus_mod_idemp_l: forall a b n : Z, (a mod n - b) mod n = (a - b) mod n. Proof. intros a b n. destruct (Z_zerop n); [ subst; nia | ]. assert ((a mod n - b) / n = - (b / n) + ((a mod n) - (b mod n)) / n) by nia. assert ((a - b) / n = a / n - b / n + ((a mod n) - (b mod n)) / n) by nia. nia. Qed. Example Z_mod_plus_full: forall a b c : Z, (a + b * c) mod c = a mod c. Proof. intros a b c. pose proof (Z_eq_dec_or ((a+b*c)/c) (a/c + b)). nia. Qed. Example Z_mod_zero_opp_r: forall a b : Z, a mod b = 0 -> a mod - b = 0. Proof. intros a b. pose proof (Z_eq_dec_or (a/b) (-(a/-b))). nia. Qed. Example Zmod_1_l: forall a : Z, 1 < a -> 1 mod a = 1. Proof. t. Qed. Example Z_mod_1_l: forall a : Z, 1 < a -> 1 mod a = 1. Proof. t. Qed. Example Z_mod_mul: forall a b : Z, b <> 0 -> (a * b) mod b = 0. Proof. intros; nia. Qed. Example Zminus_mod: forall a b n : Z, (a - b) mod n = (a mod n - b mod n) mod n. Proof. intros a b n. destruct (Z_zerop n); [ subst; nia | ]. assert ((a - b) / n = (a / n) - (b / n) + ((a mod n) - (b mod n)) / n) by nia. nia. Qed. Example Zplus_mod: forall a b n : Z, (a + b) mod n = (a mod n + b mod n) mod n. Proof. intros a b n. destruct (Z_zerop n); [ subst; nia | ]. assert ((a + b) / n = (a / n) + (b / n) + ((a mod n) + (b mod n)) / n) by nia. nia. Qed. Example Zmult_mod: forall a b n : Z, (a * b) mod n = (a mod n * (b mod n)) mod n. Proof. intros a b n. destruct (Z_zerop n); [ subst; nia | ]. assert ((a * b) / n = n * (a / n) * (b / n) + (a mod n) * (b / n) + (a / n) * (b mod n) + ((a mod n) * (b mod n)) / n) by nia. nia. Qed. Example Z_mod_mod: forall a n : Z, n <> 0 -> (a mod n) mod n = a mod n. Proof. t. Qed. Example Z_mod_div: forall a b : Z, b <> 0 -> a mod b / b = 0. Proof. intros; nia. Qed. Example Z_div_exact_full_1: forall a b : Z, a = b * (a / b) -> a mod b = 0. Proof. intros; nia. Qed. Example Z_mod_pos_bound: forall a b : Z, 0 < b -> 0 <= a mod b < b. Proof. intros; nia. Qed. Example Z_mod_sign_mul: forall a b : Z, b <> 0 -> 0 <= a mod b * b. Proof. intros; nia. Qed. Example Z_mod_neg_bound: forall a b : Z, b < 0 -> b < a mod b <= 0. Proof. intros; nia. Qed. Example Z_mod_neg: forall a b : Z, b < 0 -> b < a mod b <= 0. Proof. intros; nia. Qed. Example div_mod_small: forall x y : Z, 0 <= x < y -> x mod y = x. Proof. t. Qed. Example Zmod_small: forall a n : Z, 0 <= a < n -> a mod n = a. Proof. t. Qed. Example Z_mod_small: forall a b : Z, 0 <= a < b -> a mod b = a. Proof. t. Qed. Example Z_div_zero_opp_full: forall a b : Z, a mod b = 0 -> - a / b = - (a / b). Proof. intros; nia. Qed. Example Z_mod_zero_opp: forall a b : Z, b > 0 -> a mod b = 0 -> - a mod b = 0. Proof. intros a b. pose proof (Z_eq_dec_or (a/b) (-(-a/b))). nia. Qed. Example Z_div_zero_opp_r: forall a b : Z, a mod b = 0 -> a / - b = - (a / b). Proof. intros; nia. Qed. Example Z_mod_lt: forall a b : Z, b > 0 -> 0 <= a mod b < b. Proof. intros; nia. Qed. Example Z_mod_opp_opp: forall a b : Z, b <> 0 -> - a mod - b = - (a mod b). Proof. t_eq. Qed. Example Z_mod_bound_pos: forall a b : Z, 0 <= a -> 0 < b -> 0 <= a mod b < b. Proof. intros; nia. Qed. Example Z_mod_opp_l_z: forall a b : Z, b <> 0 -> a mod b = 0 -> - a mod b = 0. Proof. intros a b. pose proof (Z_eq_dec_or (a/b) (-(-a/b))). nia. Qed. Example Z_mod_plus: forall a b c : Z, c > 0 -> (a + b * c) mod c = a mod c. Proof. intros a b c. pose proof (Z_eq_dec_or ((a+b*c)/c) (a/c+b)). nia. Qed. Example Z_mod_opp_r_z: forall a b : Z, b <> 0 -> a mod b = 0 -> a mod - b = 0. Proof. intros a b. pose proof (Z_eq_dec_or (a/b) (-(a/-b))). nia. Qed. Example Zmod_eq: forall a b : Z, b > 0 -> a mod b = a - a / b * b. Proof. intros; nia. Qed. Example Z_div_exact_2: forall a b : Z, b > 0 -> a mod b = 0 -> a = b * (a / b). Proof. intros; nia. Qed. Example Z_div_mod_eq: forall a b : Z, b > 0 -> a = b * (a / b) + a mod b. Proof. intros; nia. Qed. Example Z_div_exact_1: forall a b : Z, b > 0 -> a = b * (a / b) -> a mod b = 0. Proof. intros; nia. Qed. Example Z_mod_add: forall a b c : Z, c <> 0 -> (a + b * c) mod c = a mod c. Proof. intros a b c. pose proof (Z_eq_dec_or ((a+b*c)/c) (a/c+b)). nia. Qed. Example Z_mod_nz_opp_r: forall a b : Z, a mod b <> 0 -> a mod - b = a mod b - b. Proof. intros a b. assert (b <> 0 -> a mod b <> 0 -> a / -b = -(a/b)-1) by t. nia. Qed. Example Z_mul_mod_idemp_l: forall a b n : Z, n <> 0 -> (a mod n * b) mod n = (a * b) mod n. Proof. intros a b n ?. assert (((a mod n) * b) / n = (b / n) * (a mod n) + ((b mod n) * (a mod n)) / n) by nia. assert ((a * b) / n = (b / n) * (a / n) * n + (b / n) * (a mod n) + (b mod n) * (a / n) + ((b mod n) * (a mod n)) / n) by nia. nia. Qed. Example Z_mod_nz_opp_full: forall a b : Z, a mod b <> 0 -> - a mod b = b - a mod b. Proof. intros a b. assert (b <> 0 -> a mod b <> 0 -> -a/b = -1-a/b) by nia. nia. Qed. Example Z_add_mod_idemp_r: forall a b n : Z, n <> 0 -> (a + b mod n) mod n = (a + b) mod n. Proof. intros a b n ?. assert ((a + b mod n) / n = (a / n) + (a mod n + b mod n) / n) by nia. assert ((a + b) / n = (a / n) + (b / n) + (a mod n + b mod n) / n) by nia. nia. Qed. Example Z_add_mod_idemp_l: forall a b n : Z, n <> 0 -> (a mod n + b) mod n = (a + b) mod n. Proof. intros a b n ?. assert ((a mod n + b) / n = (b / n) + (a mod n + b mod n) / n) by nia. assert ((a + b) / n = (a / n) + (b / n) + (a mod n + b mod n) / n) by nia. nia. Qed. Example Z_mul_mod_idemp_r: forall a b n : Z, n <> 0 -> (a * (b mod n)) mod n = (a * b) mod n. Proof. intros a b n ?. assert ((a * (b mod n)) / n = (a / n) * (b mod n) + ((a mod n) * (b mod n)) / n) by nia. assert ((a * b) / n = (b / n) * (a / n) * n + (b / n) * (a mod n) + (b mod n) * (a / n) + ((a mod n) * (b mod n)) / n) by nia. nia. Qed. Example Zmod_eq_full: forall a b : Z, b <> 0 -> a mod b = a - a / b * b. Proof. intros; nia. Qed. Example div_eq: forall x y : Z, y <> 0 -> x mod y = 0 -> x / y * y = x. Proof. intros; nia. Qed. Example Z_mod_eq: forall a b : Z, b <> 0 -> a mod b = a - b * (a / b). Proof. intros; nia. Qed. Example Z_mod_sign_nz: forall a b : Z, b <> 0 -> a mod b <> 0 -> Z.sgn (a mod b) = Z.sgn b. Proof. intros; nia. Qed. Example Z_div_exact_full_2: forall a b : Z, b <> 0 -> a mod b = 0 -> a = b * (a / b). Proof. intros; nia. Qed. Example Z_div_mod: forall a b : Z, b <> 0 -> a = b * (a / b) + a mod b. Proof. intros; nia. Qed. Example Z_add_mod: forall a b n : Z, n <> 0 -> (a + b) mod n = (a mod n + b mod n) mod n. Proof. intros a b n ?. assert ((a + b) / n = (a / n) + (b / n) + (a mod n + b mod n) / n) by nia. nia. Qed. Example Z_mul_mod: forall a b n : Z, n <> 0 -> (a * b) mod n = (a mod n * (b mod n)) mod n. Proof. intros a b n ?. assert ((a * b) / n = (b / n) * (a / n) * n + (b / n) * (a mod n) + (b mod n) * (a / n) + ((a mod n) * (b mod n)) / n) by nia. nia. Qed. Example Z_div_exact: forall a b : Z, b <> 0 -> a = b * (a / b) <-> a mod b = 0. Proof. intros; nia. Qed. Example Z_div_opp_l_z: forall a b : Z, b <> 0 -> a mod b = 0 -> - a / b = - (a / b). Proof. intros; nia. Qed. Example Z_div_opp_r_z: forall a b : Z, b <> 0 -> a mod b = 0 -> a / - b = - (a / b). Proof. intros; nia. Qed. Example Z_mod_opp_r_nz: forall a b : Z, b <> 0 -> a mod b <> 0 -> a mod - b = a mod b - b. Proof. intros a b. assert (b <> 0 -> a mod b <> 0 -> a/(-b) = -1-a/b) by nia. nia. Qed. Example Z_mod_opp_l_nz: forall a b : Z, b <> 0 -> a mod b <> 0 -> - a mod b = b - a mod b. Proof. intros a b. assert (b <> 0 -> a mod b <> 0 -> -a/b = -1-a/b) by nia. nia. Qed. Example mod_eq: forall x x' y : Z, x / y = x' / y -> x mod y = x' mod y -> y <> 0 -> x = x'. Proof. intros; nia. Qed. Example Z_div_nz_opp_r: forall a b : Z, b <> 0 -> a mod b <> 0 -> a / - b = - (a / b) - 1. Proof. intros; nia. Qed. Example Z_div_nz_opp_full: forall a b : Z, b <> 0 -> a mod b <> 0 -> - a / b = - (a / b) - 1. Proof. intros; nia. Qed. Example Zmod_unique: forall a b q r : Z, 0 <= r < b -> a = b * q + r -> r = a mod b. Proof. intros; nia. Qed. Example Z_mod_unique_neg: forall a b q r : Z, b < r <= 0 -> a = b * q + r -> r = a mod b. Proof. intros; nia. Qed. Example Z_mod_unique_pos: forall a b q r : Z, 0 <= r < b -> a = b * q + r -> r = a mod b. Proof. intros; nia. Qed. Example Z_mod_bound_or: forall a b : Z, b <> 0 -> 0 <= a mod b < b \/ b < a mod b <= 0. Proof. intros; nia. Qed. Example Z_div_opp_l_nz: forall a b : Z, b <> 0 -> a mod b <> 0 -> - a / b = - (a / b) - 1. Proof. intros; nia. Qed. Example Z_div_opp_r_nz: forall a b : Z, b <> 0 -> a mod b <> 0 -> a / - b = - (a / b) - 1. Proof. intros; nia. Qed. Example Z_mod_small_iff: forall a b : Z, b <> 0 -> a mod b = a <-> 0 <= a < b \/ b < a <= 0. Proof. t. Qed. Example Z_mod_unique: forall a b q r : Z, 0 <= r < b \/ b < r <= 0 -> a = b * q + r -> r = a mod b. Proof. intros. nia. Qed. Example Z_opp_mod_bound_or: forall a b : Z, b <> 0 -> 0 <= - (a mod b) < - b \/ - b < - (a mod b) <= 0. Proof. intros; nia. Qed. Example Zdiv_0_r: forall a : Z, a / 0 = 0. Proof. intros; nia. Qed. Example Zdiv_0_l: forall a : Z, 0 / a = 0. Proof. intros; nia. Qed. Example Z_div_1_r: forall a : Z, a / 1 = a. Proof. intros; nia. Qed. Example Zdiv_1_r: forall a : Z, a / 1 = a. Proof. intros; nia. Qed. Example Zdiv_opp_opp: forall a b : Z, - a / - b = a / b. Proof. intros; nia. Qed. Example Z_div_0_l: forall a : Z, a <> 0 -> 0 / a = 0. Proof. intros; nia. Qed. Example Z_div_pos: forall a b : Z, b > 0 -> 0 <= a -> 0 <= a / b. Proof. intros; nia. Qed. Example Z_div_ge0: forall a b : Z, b > 0 -> a >= 0 -> a / b >= 0. Proof. intros; nia. Qed. Example Z_div_pos': forall a b : Z, 0 <= a -> 0 < b -> 0 <= a / b. Proof. intros; nia. Qed. Example Z_mult_div_ge: forall a b : Z, b > 0 -> b * (a / b) <= a. Proof. intros; nia. Qed. Example Z_mult_div_ge_neg: forall a b : Z, b < 0 -> b * (a / b) >= a. Proof. intros; nia. Qed. Example Z_mul_div_le: forall a b : Z, 0 < b -> b * (a / b) <= a. Proof. intros; nia. Qed. Example Z_mul_div_ge: forall a b : Z, b < 0 -> a <= b * (a / b). Proof. intros; nia. Qed. Example Z_div_same: forall a : Z, a > 0 -> a / a = 1. Proof. intros; nia. Qed. Example Z_div_mult: forall a b : Z, b > 0 -> a * b / b = a. Proof. intros; nia. Qed. Example Z_mul_succ_div_gt: forall a b : Z, 0 < b -> a < b * Z.succ (a / b). Proof. intros; nia. Qed. Example Z_mul_succ_div_lt: forall a b : Z, b < 0 -> b * Z.succ (a / b) < a. Proof. intros; nia. Qed. Example Zdiv_1_l: forall a : Z, 1 < a -> 1 / a = 0. Proof. intros; nia. Qed. Example Z_div_1_l: forall a : Z, 1 < a -> 1 / a = 0. Proof. intros; nia. Qed. Example Z_div_str_pos: forall a b : Z, 0 < b <= a -> 0 < a / b. Proof. intros; nia. Qed. Example Z_div_ge: forall a b c : Z, c > 0 -> a >= b -> a / c >= b / c. Proof. intros; nia. Qed. Example Z_div_mult_full: forall a b : Z, b <> 0 -> a * b / b = a. Proof. intros; nia. Qed. Example Z_div_same': forall a : Z, a <> 0 -> a / a = 1. Proof. intros; nia. Qed. Example Zdiv_lt_upper_bound: forall a b q : Z, 0 < b -> a < q * b -> a / b < q. Proof. intros; nia. Qed. Example Z_div_mul: forall a b : Z, b <> 0 -> a * b / b = a. Proof. intros; nia. Qed. Example Z_div_lt: forall a b : Z, 0 < a -> 1 < b -> a / b < a. Proof. intros; nia. Qed. Example Z_div_le_mono: forall a b c : Z, 0 < c -> a <= b -> a / c <= b / c. Proof. intros; nia. Qed. Example Zdiv_sgn: forall a b : Z, 0 <= Z.sgn (a / b) * Z.sgn a * Z.sgn b. Proof. intros; nia. Qed. Example Z_div_same_full: forall a : Z, a <> 0 -> a / a = 1. Proof. intros; nia. Qed. Example Z_div_lt_upper_bound: forall a b q : Z, 0 < b -> a < b * q -> a / b < q. Proof. intros; nia. Qed. Example Z_div_le: forall a b c : Z, c > 0 -> a <= b -> a / c <= b / c. Proof. intros; nia. Qed. Example Z_div_le_lower_bound: forall a b q : Z, 0 < b -> b * q <= a -> q <= a / b. Proof. intros; nia. Qed. Example Zdiv_le_lower_bound: forall a b q : Z, 0 < b -> q * b <= a -> q <= a / b. Proof. intros; nia. Qed. Example Zdiv_le_upper_bound: forall a b q : Z, 0 < b -> a <= q * b -> a / b <= q. Proof. intros; nia. Qed. Example Z_div_le_upper_bound: forall a b q : Z, 0 < b -> a <= b * q -> a / b <= q. Proof. intros; nia. Qed. Example Z_div_small: forall a b : Z, 0 <= a < b -> a / b = 0. Proof. intros; nia. Qed. Example Zdiv_small: forall a b : Z, 0 <= a < b -> a / b = 0. Proof. intros; nia. Qed. Example Z_div_opp_opp: forall a b : Z, b <> 0 -> - a / - b = a / b. Proof. intros; nia. Qed. Example Z_div_unique_exact: forall a b q : Z, b <> 0 -> a = b * q -> q = a / b. Proof. intros; nia. Qed. Example Zdiv_le_compat_l: forall p q r : Z, 0 <= p -> 0 < q < r -> p / r <= p / q. Proof. intros p q r ??. assert (p mod r <= p mod q \/ p mod q <= p mod r) by nia. assert (0 <= p / r) by nia. assert (0 <= p / q) by nia. nia. Qed. Example Z_div_le_compat_l: forall p q r : Z, 0 <= p -> 0 < q <= r -> p / r <= p / q. Proof. intros p q r ??. assert (p mod r <= p mod q \/ p mod q <= p mod r) by nia. assert (0 <= p / r) by nia. assert (0 <= p / q) by nia. nia. Qed. Example Z_div_plus: forall a b c : Z, c > 0 -> (a + b * c) / c = a / c + b. Proof. intros; nia. Qed. Example Z_div_lt': forall a b : Z, b >= 2 -> a > 0 -> a / b < a. Proof. intros; nia. Qed. Example Zdiv_mult_le: forall a b c : Z, 0 <= a -> 0 <= b -> 0 <= c -> c * (a / b) <= c * a / b. Proof. intros; nia. Qed. Example Z_div_add_l: forall a b c : Z, b <> 0 -> (a * b + c) / b = a + c / b. Proof. intros; nia. Qed. Example Z_div_plus_full_l: forall a b c : Z, b <> 0 -> (a * b + c) / b = a + c / b. Proof. intros; nia. Qed. Example Z_div_add: forall a b c : Z, c <> 0 -> (a + b * c) / c = a / c + b. Proof. intros; nia. Qed. Example Z_div_plus_full: forall a b c : Z, c <> 0 -> (a + b * c) / c = a / c + b. Proof. intros; nia. Qed. Example Z_div_mul_le: forall a b c : Z, 0 <= a -> 0 < b -> 0 <= c -> c * (a / b) <= c * a / b. Proof. intros; nia. Qed. Example Z_div_mul_cancel_r: forall a b c : Z, b <> 0 -> c <> 0 -> a * c / (b * c) = a / b. Proof. intros; nia. Qed. Example Z_div_div: forall a b c : Z, b <> 0 -> 0 < c -> a / b / c = a / (b * c). Proof. intros; nia. Qed. Example Z_div_mul_cancel_l: forall a b c : Z, b <> 0 -> c <> 0 -> c * a / (c * b) = a / b. Proof. intros; nia. Qed. Example Z_div_unique_neg: forall a b q r : Z, b < r <= 0 -> a = b * q + r -> q = a / b. Proof. intros; nia. Qed. Example Zdiv_unique: forall a b q r : Z, 0 <= r < b -> a = b * q + r -> q = a / b. Proof. intros; nia. Qed. Example Z_div_unique_pos: forall a b q r : Z, 0 <= r < b -> a = b * q + r -> q = a / b. Proof. intros; nia. Qed. Example Z_div_small_iff: forall a b : Z, b <> 0 -> a / b = 0 <-> 0 <= a < b \/ b < a <= 0. Proof. intros; nia. Qed. Example Z_div_unique: forall a b q r : Z, 0 <= r < b \/ b < r <= 0 -> a = b * q + r -> q = a / b. Proof. intros; nia. Qed. Example Z_divide_mod : forall a b : Z, (b | a) -> a mod b = 0. Proof. intros. nia. Qed. Example Z_mod_divide: forall a b : Z, b <> 0 -> a mod b = 0 <-> (b | a). Proof. split; intros. Fail all: nia. Abort. Example Zmod_divides: forall a b : Z, b <> 0 -> a mod b = 0 <-> (exists c : Z, a = b * c). Proof. split; intros. Fail all: nia. Abort. (** Now we do the same, but with [Z.quot] and [Z.rem] instead. *) Example N2Z_inj_quot : forall n m : N, Z.of_N (n / m) = Z.of_N n ÷ Z.of_N m. Proof. intros; nia. Qed. Example N2Z_inj_rem : forall n m : N, Z.of_N (n mod m) = Z.rem (Z.of_N n) (Z.of_N m). Proof. intros; nia. Qed. Example OrdersEx_Z_as_DT_mul_quot_ge : forall a b : Z, a <= 0 -> b <> 0 -> a <= b * (a ÷ b) <= 0. Proof. t_zero. Qed. Example OrdersEx_Z_as_DT_mul_quot_le : forall a b : Z, 0 <= a -> b <> 0 -> 0 <= b * (a ÷ b) <= a. Proof. t_zero. Qed. Example OrdersEx_Z_as_DT_Private_Div_NZQuot_div_0_l : forall a : Z, 0 < a -> 0 ÷ a = 0. Proof. intros; nia. Qed. Example OrdersEx_Z_as_DT_Private_Div_NZQuot_div_1_l : forall a : Z, 1 < a -> 1 ÷ a = 0. Proof. intros; nia. Qed. Example OrdersEx_Z_as_DT_Private_Div_NZQuot_div_1_r : forall a : Z, 0 <= a -> a ÷ 1 = a. Proof. intros; nia. Qed. Example OrdersEx_Z_as_DT_Private_Div_NZQuot_div_add : forall a b c : Z, 0 <= a -> 0 <= a + b * c -> 0 < c -> (a + b * c) ÷ c = a ÷ c + b. Proof. intros; nia. Qed. Example OrdersEx_Z_as_DT_Private_Div_NZQuot_div_add_l : forall a b c : Z, 0 <= c -> 0 <= a * b + c -> 0 < b -> (a * b + c) ÷ b = a + c ÷ b. Proof. intros; nia. Qed. Example OrdersEx_Z_as_DT_Private_Div_NZQuot_div_div : forall a b c : Z, 0 <= a -> 0 < b -> 0 < c -> a ÷ b ÷ c = a ÷ (b * c). Proof. intros; assert (0 < b * c) by nia; nia. Qed. Example OrdersEx_Z_as_DT_Private_Div_NZQuot_div_le_lower_bound : forall a b q : Z, 0 <= a -> 0 < b -> b * q <= a -> q <= a ÷ b. Proof. intros; nia. Qed. Example OrdersEx_Z_as_DT_Private_Div_NZQuot_div_le_mono : forall a b c : Z, 0 < c -> 0 <= a <= b -> a ÷ c <= b ÷ c. Proof. intros; nia. Qed. Example OrdersEx_Z_as_DT_Private_Div_NZQuot_div_le_upper_bound : forall a b q : Z, 0 <= a -> 0 < b -> a <= b * q -> a ÷ b <= q. Proof. intros; nia. Qed. Example OrdersEx_Z_as_DT_Private_Div_NZQuot_div_lt : forall a b : Z, 0 < a -> 1 < b -> a ÷ b < a. Proof. intros; nia. Qed. Example OrdersEx_Z_as_DT_Private_Div_NZQuot_div_lt_upper_bound : forall a b q : Z, 0 <= a -> 0 < b -> a < b * q -> a ÷ b < q. Proof. intros; nia. Qed. Example OrdersEx_Z_as_DT_Private_Div_NZQuot_div_mul : forall a b : Z, 0 <= a -> 0 < b -> a * b ÷ b = a. Proof. intros; nia. Qed. Example OrdersEx_Z_as_DT_Private_Div_NZQuot_div_mul_le : forall a b c : Z, 0 <= a -> 0 < b -> 0 <= c -> c * (a ÷ b) <= c * a ÷ b. Proof. intros; nia. Qed. Example OrdersEx_Z_as_DT_Private_Div_NZQuot_div_pos : forall a b : Z, 0 <= a -> 0 < b -> 0 <= a ÷ b. Proof. intros; nia. Qed. Example OrdersEx_Z_as_DT_Private_Div_NZQuot_div_same : forall a : Z, 0 < a -> a ÷ a = 1. Proof. intros; nia. Qed. Example OrdersEx_Z_as_DT_Private_Div_NZQuot_div_small : forall a b : Z, 0 <= a < b -> a ÷ b = 0. Proof. intros; nia. Qed. Example OrdersEx_Z_as_DT_Private_Div_NZQuot_div_small_iff : forall a b : Z, 0 <= a -> 0 < b -> a ÷ b = 0 <-> a < b. Proof. intros; nia. Qed. Example OrdersEx_Z_as_DT_Private_Div_NZQuot_div_str_pos : forall a b : Z, 0 < b <= a -> 0 < a ÷ b. Proof. intros; nia. Qed. Example OrdersEx_Z_as_DT_Private_Div_NZQuot_div_str_pos_iff : forall a b : Z, 0 <= a -> 0 < b -> 0 < a ÷ b <-> b <= a. Proof. intros; nia. Qed. Example OrdersEx_Z_as_DT_Private_Div_NZQuot_div_unique_exact : forall a b q : Z, 0 <= a -> 0 < b -> a = b * q -> q = a ÷ b. Proof. intros; nia. Qed. Example OrdersEx_Z_as_DT_Private_Div_NZQuot_mul_div_le : forall a b : Z, 0 <= a -> 0 < b -> b * (a ÷ b) <= a. Proof. intros; nia. Qed. Example OrdersEx_Z_as_DT_quot_0_l : forall a : Z, a <> 0 -> 0 ÷ a = 0. Proof. intros; nia. Qed. Example OrdersEx_Z_as_DT_quot_1_l : forall a : Z, 1 < a -> 1 ÷ a = 0. Proof. intros; nia. Qed. Example OrdersEx_Z_as_DT_quot_1_r : forall a : Z, a ÷ 1 = a. Proof. intros; nia. Qed. Example OrdersEx_Z_as_DT_quot_div_nonneg : forall a b : Z, 0 <= a -> 0 < b -> a ÷ b = a / b. Proof. intros; nia. Qed. Example OrdersEx_Z_as_DT_quot_le_lower_bound : forall a b q : Z, 0 < b -> b * q <= a -> q <= a ÷ b. Proof. intros; nia. Qed. Example OrdersEx_Z_as_DT_quot_le_mono : forall a b c : Z, 0 < c -> a <= b -> a ÷ c <= b ÷ c. Proof. t_zero. Qed. Example OrdersEx_Z_as_DT_quot_le_upper_bound : forall a b q : Z, 0 < b -> a <= b * q -> a ÷ b <= q. Proof. intros; nia. Qed. Example OrdersEx_Z_as_DT_quot_lt : forall a b : Z, 0 < a -> 1 < b -> a ÷ b < a. Proof. intros; nia. Qed. Example OrdersEx_Z_as_DT_quot_lt_upper_bound : forall a b q : Z, 0 <= a -> 0 < b -> a < b * q -> a ÷ b < q. Proof. intros; nia. Qed. Example OrdersEx_Z_as_DT_quot_mul : forall a b : Z, b <> 0 -> a * b ÷ b = a. Proof. intros; nia. Qed. Example OrdersEx_Z_as_DT_quot_mul_le : forall a b c : Z, 0 <= a -> 0 < b -> 0 <= c -> c * (a ÷ b) <= c * a ÷ b. Proof. intros; nia. Qed. Example OrdersEx_Z_as_DT_quot_pos : forall a b : Z, 0 <= a -> 0 < b -> 0 <= a ÷ b. Proof. intros; nia. Qed. Example OrdersEx_Z_as_DT_quot_same : forall a : Z, a <> 0 -> a ÷ a = 1. Proof. intros; nia. Qed. Example OrdersEx_Z_as_DT_quot_small : forall a b : Z, 0 <= a < b -> a ÷ b = 0. Proof. intros; nia. Qed. Example OrdersEx_Z_as_DT_quot_str_pos : forall a b : Z, 0 < b <= a -> 0 < a ÷ b. Proof. intros; nia. Qed. Example OrdersEx_Z_as_DT_quot_unique_exact : forall a b q : Z, b <> 0 -> a = b * q -> q = a ÷ b. Proof. intros; nia. Qed. Example OrdersEx_Z_as_DT_quot_unique : forall a b q r : Z, 0 <= a -> 0 <= r < b -> a = b * q + r -> q = a ÷ b. Proof. intros; nia. Qed. Example OrdersEx_Z_as_OT_mul_quot_ge : forall a b : Z, a <= 0 -> b <> 0 -> a <= b * (a ÷ b) <= 0. Proof. intros. assert (0 < a ÷ b \/ a ÷ b = 0 \/ a ÷ b < 0) by nia. nia. Qed. Example OrdersEx_Z_as_OT_mul_quot_le : forall a b : Z, 0 <= a -> b <> 0 -> 0 <= b * (a ÷ b) <= a. Proof. intros. assert (0 < a ÷ b \/ a ÷ b = 0 \/ a ÷ b < 0) by nia. nia. Qed. Example OrdersEx_Z_as_OT_Private_Div_NZQuot_div_0_l : forall a : Z, 0 < a -> 0 ÷ a = 0. Proof. intros; nia. Qed. Example OrdersEx_Z_as_OT_Private_Div_NZQuot_div_1_l : forall a : Z, 1 < a -> 1 ÷ a = 0. Proof. intros; nia. Qed. Example OrdersEx_Z_as_OT_Private_Div_NZQuot_div_1_r : forall a : Z, 0 <= a -> a ÷ 1 = a. Proof. intros; nia. Qed. Example OrdersEx_Z_as_OT_Private_Div_NZQuot_div_add : forall a b c : Z, 0 <= a -> 0 <= a + b * c -> 0 < c -> (a + b * c) ÷ c = a ÷ c + b. Proof. intros; nia. Qed. Example OrdersEx_Z_as_OT_Private_Div_NZQuot_div_add_l : forall a b c : Z, 0 <= c -> 0 <= a * b + c -> 0 < b -> (a * b + c) ÷ b = a + c ÷ b. Proof. intros; nia. Qed. Example OrdersEx_Z_as_OT_Private_Div_NZQuot_div_le_lower_bound : forall a b q : Z, 0 <= a -> 0 < b -> b * q <= a -> q <= a ÷ b. Proof. intros; nia. Qed. Example OrdersEx_Z_as_OT_Private_Div_NZQuot_div_le_mono : forall a b c : Z, 0 < c -> 0 <= a <= b -> a ÷ c <= b ÷ c. Proof. intros; nia. Qed. Example OrdersEx_Z_as_OT_Private_Div_NZQuot_div_le_upper_bound : forall a b q : Z, 0 <= a -> 0 < b -> a <= b * q -> a ÷ b <= q. Proof. intros; nia. Qed. Example OrdersEx_Z_as_OT_Private_Div_NZQuot_div_lt : forall a b : Z, 0 < a -> 1 < b -> a ÷ b < a. Proof. intros; nia. Qed. Example OrdersEx_Z_as_OT_Private_Div_NZQuot_div_lt_upper_bound : forall a b q : Z, 0 <= a -> 0 < b -> a < b * q -> a ÷ b < q. Proof. intros; nia. Qed. Example OrdersEx_Z_as_OT_Private_Div_NZQuot_div_mul_cancel_l : forall a b c : Z, 0 <= a -> 0 < b -> 0 < c -> c * a ÷ (c * b) = a ÷ b. Proof. intros; nia. Qed. Example OrdersEx_Z_as_OT_Private_Div_NZQuot_div_mul_cancel_r : forall a b c : Z, 0 <= a -> 0 < b -> 0 < c -> a * c ÷ (b * c) = a ÷ b. Proof. intros; nia. Qed. Example OrdersEx_Z_as_OT_Private_Div_NZQuot_div_mul : forall a b : Z, 0 <= a -> 0 < b -> a * b ÷ b = a. Proof. intros; nia. Qed. Example OrdersEx_Z_as_OT_Private_Div_NZQuot_div_mul_le : forall a b c : Z, 0 <= a -> 0 < b -> 0 <= c -> c * (a ÷ b) <= c * a ÷ b. Proof. intros; nia. Qed. Example OrdersEx_Z_as_OT_Private_Div_NZQuot_div_pos : forall a b : Z, 0 <= a -> 0 < b -> 0 <= a ÷ b. Proof. intros; nia. Qed. Example OrdersEx_Z_as_OT_Private_Div_NZQuot_div_same : forall a : Z, 0 < a -> a ÷ a = 1. Proof. intros; nia. Qed. Example OrdersEx_Z_as_OT_Private_Div_NZQuot_div_small : forall a b : Z, 0 <= a < b -> a ÷ b = 0. Proof. intros; nia. Qed. Example OrdersEx_Z_as_OT_Private_Div_NZQuot_div_small_iff : forall a b : Z, 0 <= a -> 0 < b -> a ÷ b = 0 <-> a < b. Proof. intros; nia. Qed. Example OrdersEx_Z_as_OT_Private_Div_NZQuot_div_str_pos : forall a b : Z, 0 < b <= a -> 0 < a ÷ b. Proof. intros; nia. Qed. Example OrdersEx_Z_as_OT_Private_Div_NZQuot_div_str_pos_iff : forall a b : Z, 0 <= a -> 0 < b -> 0 < a ÷ b <-> b <= a. Proof. intros; nia. Qed. Example OrdersEx_Z_as_OT_Private_Div_NZQuot_div_unique_exact : forall a b q : Z, 0 <= a -> 0 < b -> a = b * q -> q = a ÷ b. Proof. intros; nia. Qed. Example OrdersEx_Z_as_OT_Private_Div_NZQuot_div_unique : forall a b q r : Z, 0 <= a -> 0 <= r < b -> a = b * q + r -> q = a ÷ b. Proof. intros; nia. Qed. Example OrdersEx_Z_as_OT_Private_Div_NZQuot_mul_div_le : forall a b : Z, 0 <= a -> 0 < b -> b * (a ÷ b) <= a. Proof. intros; nia. Qed. Example OrdersEx_Z_as_OT_quot_0_l : forall a : Z, a <> 0 -> 0 ÷ a = 0. Proof. intros; nia. Qed. Example OrdersEx_Z_as_OT_quot_1_l : forall a : Z, 1 < a -> 1 ÷ a = 0. Proof. intros; nia. Qed. Example OrdersEx_Z_as_OT_quot_1_r : forall a : Z, a ÷ 1 = a. Proof. intros; nia. Qed. Example OrdersEx_Z_as_OT_quot_div_nonneg : forall a b : Z, 0 <= a -> 0 < b -> a ÷ b = a / b. Proof. intros; nia. Qed. Example OrdersEx_Z_as_OT_quot_le_lower_bound : forall a b q : Z, 0 < b -> b * q <= a -> q <= a ÷ b. Proof. intros; nia. Qed. Example OrdersEx_Z_as_OT_quot_le_mono : forall a b c : Z, 0 < c -> a <= b -> a ÷ c <= b ÷ c. Proof. t_zero. Qed. Example OrdersEx_Z_as_OT_quot_le_upper_bound : forall a b q : Z, 0 < b -> a <= b * q -> a ÷ b <= q. Proof. intros; nia. Qed. Example OrdersEx_Z_as_OT_quot_lt : forall a b : Z, 0 < a -> 1 < b -> a ÷ b < a. Proof. intros; nia. Qed. Example OrdersEx_Z_as_OT_quot_lt_upper_bound : forall a b q : Z, 0 <= a -> 0 < b -> a < b * q -> a ÷ b < q. Proof. intros; nia. Qed. Example OrdersEx_Z_as_OT_quot_mul : forall a b : Z, b <> 0 -> a * b ÷ b = a. Proof. intros; nia. Qed. Example OrdersEx_Z_as_OT_quot_mul_le : forall a b c : Z, 0 <= a -> 0 < b -> 0 <= c -> c * (a ÷ b) <= c * a ÷ b. Proof. intros; nia. Qed. Example OrdersEx_Z_as_OT_quot_opp_l : forall a b : Z, b <> 0 -> - a ÷ b = - (a ÷ b). Proof. intros; nia. Qed. Example OrdersEx_Z_as_OT_quot_pos : forall a b : Z, 0 <= a -> 0 < b -> 0 <= a ÷ b. Proof. intros; nia. Qed. Example OrdersEx_Z_as_OT_quot_same : forall a : Z, a <> 0 -> a ÷ a = 1. Proof. intros; nia. Qed. Example OrdersEx_Z_as_OT_quot_small : forall a b : Z, 0 <= a < b -> a ÷ b = 0. Proof. intros; nia. Qed. Example OrdersEx_Z_as_OT_quot_str_pos : forall a b : Z, 0 < b <= a -> 0 < a ÷ b. Proof. intros; nia. Qed. Example OrdersEx_Z_as_OT_quot_unique_exact : forall a b q : Z, b <> 0 -> a = b * q -> q = a ÷ b. Proof. intros; nia. Qed. Example OrdersEx_Z_as_OT_quot_unique : forall a b q r : Z, 0 <= a -> 0 <= r < b -> a = b * q + r -> q = a ÷ b. Proof. intros; nia. Qed. Example Z2N_inj_rem : forall n m : Z, 0 <= n -> 0 <= m -> Z.to_N (Z.rem n m) = (Z.to_N n mod Z.to_N m)%N. Proof. intros. Abort. Example Zabs2N_inj_rem : forall n m : Z, Z.abs_N (Z.rem n m) = (Z.abs_N n mod Z.abs_N m)%N. Proof. intros. Abort. Example Z_add_rem_idemp_l : forall a b n : Z, n <> 0 -> 0 <= a * b -> Z.rem (Z.rem a n + b) n = Z.rem (a + b) n. Proof. intros. Fail nia. Abort. Example Z_add_rem_idemp_r : forall a b n : Z, n <> 0 -> 0 <= a * b -> Z.rem (a + Z.rem b n) n = Z.rem (a + b) n. Proof. intros. Fail nia. Abort. Example Z_gcd_quot_gcd : forall a b g : Z, g <> 0 -> g = Z.gcd a b -> Z.gcd (a ÷ g) (b ÷ g) = 1. Proof. intros. Fail nia. Abort. Example Z_gcd_rem : forall a b : Z, b <> 0 -> Z.gcd (Z.rem a b) b = Z.gcd b a. Proof. intros. Fail nia. Abort. Example Z_mul_pred_quot_gt : forall a b : Z, 0 <= a -> b < 0 -> a < b * Z.pred (a ÷ b). Proof. intros; nia. Qed. Example Z_mul_pred_quot_lt : forall a b : Z, a <= 0 -> 0 < b -> b * Z.pred (a ÷ b) < a. Proof. intros; nia. Qed. Example Z_mul_quot_ge : forall a b : Z, a <= 0 -> b <> 0 -> a <= b * (a ÷ b) <= 0. Proof. intros. Fail nia. Abort. Example Z_mul_quot_le : forall a b : Z, 0 <= a -> b <> 0 -> 0 <= b * (a ÷ b) <= a. Proof. intros. Fail nia. Abort. Example Z_mul_rem_distr_l : forall a b c : Z, b <> 0 -> c <> 0 -> Z.rem (c * a) (c * b) = c * Z.rem a b. Proof. intros. Fail nia. Abort. Example Z_mul_rem_distr_r : forall a b c : Z, b <> 0 -> c <> 0 -> Z.rem (a * c) (b * c) = Z.rem a b * c. Proof. intros. Fail nia. Abort. Example Z_mul_rem_idemp_l : forall a b n : Z, n <> 0 -> Z.rem (Z.rem a n * b) n = Z.rem (a * b) n. Proof. intros. Fail nia. Abort. Example Z_mul_rem_idemp_r : forall a b n : Z, n <> 0 -> Z.rem (a * Z.rem b n) n = Z.rem (a * b) n. Proof. intros. Fail nia. Abort. Example Z_mul_succ_quot_gt : forall a b : Z, 0 <= a -> 0 < b -> a < b * Z.succ (a ÷ b). Proof. intros; nia. Qed. Example Z_mul_succ_quot_lt : forall a b : Z, a <= 0 -> b < 0 -> b * Z.succ (a ÷ b) < a. Proof. intros; nia. Qed. Example Z_Private_Div_NZQuot_add_mod : forall a b n : Z, 0 <= a -> 0 <= b -> 0 < n -> Z.rem (a + b) n = Z.rem (Z.rem a n + Z.rem b n) n. Proof. intros. Fail nia. Abort. Example Z_Private_Div_NZQuot_add_mod_idemp_l : forall a b n : Z, 0 <= a -> 0 <= b -> 0 < n -> Z.rem (Z.rem a n + b) n = Z.rem (a + b) n. Proof. intros. Fail nia. Abort. Example Z_Private_Div_NZQuot_add_mod_idemp_r : forall a b n : Z, 0 <= a -> 0 <= b -> 0 < n -> Z.rem (a + Z.rem b n) n = Z.rem (a + b) n. Proof. intros. Fail nia. Abort. Example Z_Private_Div_NZQuot_div_0_l : forall a : Z, 0 < a -> 0 ÷ a = 0. Proof. intros; nia. Qed. Example Z_Private_Div_NZQuot_div_1_l : forall a : Z, 1 < a -> 1 ÷ a = 0. Proof. intros; nia. Qed. Example Z_Private_Div_NZQuot_div_1_r : forall a : Z, 0 <= a -> a ÷ 1 = a. Proof. intros; nia. Qed. Example Z_Private_Div_NZQuot_div_add : forall a b c : Z, 0 <= a -> 0 <= a + b * c -> 0 < c -> (a + b * c) ÷ c = a ÷ c + b. Proof. intros; nia. Qed. Example Z_Private_Div_NZQuot_div_add_l : forall a b c : Z, 0 <= c -> 0 <= a * b + c -> 0 < b -> (a * b + c) ÷ b = a + c ÷ b. Proof. intros; nia. Qed. Example Z_Private_Div_NZQuot_div_exact : forall a b : Z, 0 <= a -> 0 < b -> a = b * (a ÷ b) <-> Z.rem a b = 0. Proof. intros; nia. Qed. Example Z_Private_Div_NZQuot_div_le_lower_bound : forall a b q : Z, 0 <= a -> 0 < b -> b * q <= a -> q <= a ÷ b. Proof. intros; nia. Qed. Example Z_Private_Div_NZQuot_div_le_mono : forall a b c : Z, 0 < c -> 0 <= a <= b -> a ÷ c <= b ÷ c. Proof. intros; nia. Qed. Example Z_Private_Div_NZQuot_div_le_upper_bound : forall a b q : Z, 0 <= a -> 0 < b -> a <= b * q -> a ÷ b <= q. Proof. intros; nia. Qed. Example Z_Private_Div_NZQuot_div_lt : forall a b : Z, 0 < a -> 1 < b -> a ÷ b < a. Proof. intros; nia. Qed. Example Z_Private_Div_NZQuot_div_lt_upper_bound : forall a b q : Z, 0 <= a -> 0 < b -> a < b * q -> a ÷ b < q. Proof. intros; nia. Qed. Example Z_Private_Div_NZQuot_div_mul_cancel_l : forall a b c : Z, 0 <= a -> 0 < b -> 0 < c -> c * a ÷ (c * b) = a ÷ b. Proof. intros; nia. Qed. Example Z_Private_Div_NZQuot_div_mul_cancel_r : forall a b c : Z, 0 <= a -> 0 < b -> 0 < c -> a * c ÷ (b * c) = a ÷ b. Proof. intros; nia. Qed. Example Z_Private_Div_NZQuot_div_mul : forall a b : Z, 0 <= a -> 0 < b -> a * b ÷ b = a. Proof. intros; nia. Qed. Example Z_Private_Div_NZQuot_div_mul_le : forall a b c : Z, 0 <= a -> 0 < b -> 0 <= c -> c * (a ÷ b) <= c * a ÷ b. Proof. intros; nia. Qed. Example Z_Private_Div_NZQuot_div_pos : forall a b : Z, 0 <= a -> 0 < b -> 0 <= a ÷ b. Proof. intros; nia. Qed. Example Z_Private_Div_NZQuot_div_same : forall a : Z, 0 < a -> a ÷ a = 1. Proof. intros; nia. Qed. Example Z_Private_Div_NZQuot_div_small : forall a b : Z, 0 <= a < b -> a ÷ b = 0. Proof. intros; nia. Qed. Example Z_Private_Div_NZQuot_div_small_iff : forall a b : Z, 0 <= a -> 0 < b -> a ÷ b = 0 <-> a < b. Proof. intros; nia. Qed. Example Z_Private_Div_NZQuot_div_str_pos : forall a b : Z, 0 < b <= a -> 0 < a ÷ b. Proof. intros; nia. Qed. Example Z_Private_Div_NZQuot_div_str_pos_iff : forall a b : Z, 0 <= a -> 0 < b -> 0 < a ÷ b <-> b <= a. Proof. intros; nia. Qed. Example Z_Private_Div_NZQuot_div_unique_exact : forall a b q : Z, 0 <= a -> 0 < b -> a = b * q -> q = a ÷ b. Proof. intros; nia. Qed. Example Z_Private_Div_NZQuot_div_unique : forall a b q r : Z, 0 <= a -> 0 <= r < b -> a = b * q + r -> q = a ÷ b. Proof. intros; nia. Qed. Example Z_Private_Div_NZQuot_mod_0_l : forall a : Z, 0 < a -> Z.rem 0 a = 0. Proof. intros; nia. Qed. Example Z_Private_Div_NZQuot_mod_1_l : forall a : Z, 1 < a -> Z.rem 1 a = 1. Proof. intros. Fail nia. Abort. Example Z_Private_Div_NZQuot_mod_1_r : forall a : Z, 0 <= a -> Z.rem a 1 = 0. Proof. intros; nia. Qed. Example Z_Private_Div_NZQuot_mod_add : forall a b c : Z, 0 <= a -> 0 <= a + b * c -> 0 < c -> Z.rem (a + b * c) c = Z.rem a c. Proof. intros. Fail nia. Abort. Example Z_Private_Div_NZQuot_mod_divides : forall a b : Z, 0 <= a -> 0 < b -> Z.rem a b = 0 <-> (exists c : Z, a = b * c). Proof. intros. Fail nia. Abort. Example Z_Private_Div_NZQuot_mod_le : forall a b : Z, 0 <= a -> 0 < b -> Z.rem a b <= a. Proof. intros. Fail nia. Abort. Example Z_Private_Div_NZQuot_mod_mod : forall a n : Z, 0 <= a -> 0 < n -> Z.rem (Z.rem a n) n = Z.rem a n. Proof. intros. Fail nia. Abort. Example Z_Private_Div_NZQuot_mod_mul : forall a b : Z, 0 <= a -> 0 < b -> Z.rem (a * b) b = 0. Proof. intros; nia. Qed. Example Z_Private_Div_NZQuot_mod_mul_r : forall a b c : Z, 0 <= a -> 0 < b -> 0 < c -> Z.rem a (b * c) = Z.rem a b + b * Z.rem (a ÷ b) c. Proof. intros. Fail nia. Abort. Example Z_Private_Div_NZQuot_mod_same : forall a : Z, 0 < a -> Z.rem a a = 0. Proof. intros. Fail nia. Abort. Example Z_Private_Div_NZQuot_mod_small : forall a b : Z, 0 <= a < b -> Z.rem a b = a. Proof. intros. Fail nia. Abort. Example Z_Private_Div_NZQuot_mod_small_iff : forall a b : Z, 0 <= a -> 0 < b -> Z.rem a b = a <-> a < b. Proof. intros. Fail nia. Abort. Example Z_Private_Div_NZQuot_mul_div_le : forall a b : Z, 0 <= a -> 0 < b -> b * (a ÷ b) <= a. Proof. intros; nia. Qed. Example Z_Private_Div_NZQuot_mul_mod_distr_l : forall a b c : Z, 0 <= a -> 0 < b -> 0 < c -> Z.rem (c * a) (c * b) = c * Z.rem a b. Proof. intros. Fail nia. Abort. Example Z_Private_Div_NZQuot_mul_mod_distr_r : forall a b c : Z, 0 <= a -> 0 < b -> 0 < c -> Z.rem (a * c) (b * c) = Z.rem a b * c. Proof. intros. Fail nia. Abort. Example Z_Private_Div_NZQuot_mul_mod_idemp_l : forall a b n : Z, 0 <= a -> 0 <= b -> 0 < n -> Z.rem (Z.rem a n * b) n = Z.rem (a * b) n. Proof. intros. Fail nia. Abort. Example Z_Private_Div_NZQuot_mul_mod_idemp_r : forall a b n : Z, 0 <= a -> 0 <= b -> 0 < n -> Z.rem (a * Z.rem b n) n = Z.rem (a * b) n. Proof. intros. Fail nia. Abort. Example Z_Private_Div_NZQuot_mul_succ_div_gt : forall a b : Z, 0 <= a -> 0 < b -> a < b * Z.succ (a ÷ b). Proof. intros; nia. Qed. Example Z_Private_Div_Quot2Div_div_mod : forall a b : Z, b <> 0 -> a = b * (a ÷ b) + Z.rem a b. Proof. intros; nia. Qed. Example Z_Private_Div_Quot2Div_div_wd : Morphisms.Proper (Morphisms.respectful eq (Morphisms.respectful eq eq)) Z.quot. Proof. repeat intro; subst; nia. Qed. Example Z_Private_Div_Quot2Div_mod_bound_pos : forall a b : Z, 0 <= a -> 0 < b -> 0 <= Z.rem a b < b. Proof. intros; nia. Qed. Example Z_Private_Div_Quot2Div_mod_wd : Morphisms.Proper (Morphisms.respectful eq (Morphisms.respectful eq eq)) Z.rem. Proof. repeat intro; subst; nia. Qed. Example Z_quot_0_l : forall a : Z, a <> 0 -> 0 ÷ a = 0. Proof. intros; nia. Qed. Example Z_quot_0_r_ext : forall x y : Z, y = 0 -> x ÷ y = 0. Proof. intros; nia. Qed. Example Z_quot_1_l : forall a : Z, 1 < a -> 1 ÷ a = 0. Proof. intros; nia. Qed. Example Z_quot_1_r : forall a : Z, a ÷ 1 = a. Proof. intros; nia. Qed. Example Zquot2_quot : forall n : Z, Z.quot2 n = n ÷ 2. Proof. intros; nia. Qed. Example Z_quot_div_nonneg : forall a b : Z, 0 <= a -> 0 < b -> a ÷ b = a / b. Proof. intros; nia. Qed. Example Z_quot_exact : forall a b : Z, b <> 0 -> a = b * (a ÷ b) <-> Z.rem a b = 0. Proof. intros; nia. Qed. Example Z_quot_le_compat_l : forall p q r : Z, 0 <= p -> 0 < q <= r -> p ÷ r <= p ÷ q. Proof. intros. Fail nia. Abort. Example Z_quot_le_lower_bound : forall a b q : Z, 0 < b -> b * q <= a -> q <= a ÷ b. Proof. intros; nia. Qed. Example Z_quot_le_mono : forall a b c : Z, 0 < c -> a <= b -> a ÷ c <= b ÷ c. Proof. intros. Fail nia. Abort. Example Z_quot_le_upper_bound : forall a b q : Z, 0 < b -> a <= b * q -> a ÷ b <= q. Proof. intros; nia. Qed. Example Z_quot_lt : forall a b : Z, 0 < a -> 1 < b -> a ÷ b < a. Proof. intros; nia. Qed. Example Z_quot_lt_upper_bound : forall a b q : Z, 0 <= a -> 0 < b -> a < b * q -> a ÷ b < q. Proof. intros; nia. Qed. Example Z_quot_mul : forall a b : Z, b <> 0 -> a * b ÷ b = a. Proof. intros; nia. Qed. Example Z_quot_mul_le : forall a b c : Z, 0 <= a -> 0 < b -> 0 <= c -> c * (a ÷ b) <= c * a ÷ b. Proof. intros; nia. Qed. Example Z_quot_opp_l : forall a b : Z, b <> 0 -> - a ÷ b = - (a ÷ b). Proof. intros; nia. Qed. Example Z_quot_pos : forall a b : Z, 0 <= a -> 0 < b -> 0 <= a ÷ b. Proof. intros; nia. Qed. Example Z_quot_rem' : forall a b : Z, a = b * (a ÷ b) + Z.rem a b. Proof. intros; nia. Qed. Example Z_quot_rem : forall a b : Z, b <> 0 -> a = b * (a ÷ b) + Z.rem a b. Proof. intros; nia. Qed. Example Z_quot_same : forall a : Z, a <> 0 -> a ÷ a = 1. Proof. intros; nia. Qed. Example Z_quot_small : forall a b : Z, 0 <= a < b -> a ÷ b = 0. Proof. intros; nia. Qed. Example Z_quot_small_iff : forall a b : Z, b <> 0 -> a ÷ b = 0 <-> Z.abs a < Z.abs b. Proof. intros; nia. Qed. Example Z_quot_str_pos : forall a b : Z, 0 < b <= a -> 0 < a ÷ b. Proof. intros; nia. Qed. Example Z_quot_unique_exact : forall a b q : Z, b <> 0 -> a = b * q -> q = a ÷ b. Proof. intros; nia. Qed. Example Z_quot_unique : forall a b q r : Z, 0 <= a -> 0 <= r < b -> a = b * q + r -> q = a ÷ b. Proof. intros; nia. Qed. Example Z_quot_wd : Morphisms.Proper (Morphisms.respectful Z.eq (Morphisms.respectful Z.eq Z.eq)) Z.quot. Proof. repeat intro. Fail nia. Abort. Example Zquot_Zeven_rem : forall a : Z, Z.even a = (Z.rem a 2 =? 0). Proof. intros. Fail nia. Abort. Example Zquot_Z_mult_quot_ge : forall a b : Z, a <= 0 -> a <= b * (a ÷ b) <= 0. Proof. intros. Fail nia. Abort. Example Zquot_Z_mult_quot_le : forall a b : Z, 0 <= a -> 0 <= b * (a ÷ b) <= a. Proof. intros. Fail nia. Abort. Example Zquot_Zodd_rem : forall a : Z, Z.odd a = negb (Z.rem a 2 =? 0). Proof. intros. Fail nia. Abort. Example Zquot_Zplus_rem : forall a b n : Z, 0 <= a * b -> Z.rem (a + b) n = Z.rem (Z.rem a n + Z.rem b n) n. Proof. intros. Abort. Example Zquot_Zplus_rem_idemp_l : forall a b n : Z, 0 <= a * b -> Z.rem (Z.rem a n + b) n = Z.rem (a + b) n. Proof. intros. Abort. Example Zquot_Zplus_rem_idemp_r : forall a b n : Z, 0 <= a * b -> Z.rem (b + Z.rem a n) n = Z.rem (b + a) n. Proof. intros. Abort. Example Zquot_Zquot_0_l : forall a : Z, 0 ÷ a = 0. Proof. intros; nia. Qed. Example Zquot_Zquot_0_r : forall a : Z, a ÷ 0 = 0. Proof. intros; nia. Qed. Example Zquot_Z_quot_exact_full : forall a b : Z, a = b * (a ÷ b) <-> Z.rem a b = 0. Proof. intros; nia. Qed. Example Zquot_Zquot_le_lower_bound : forall a b q : Z, 0 < b -> q * b <= a -> q <= a ÷ b. Proof. intros; nia. Qed. Example Zquot_Zquot_le_upper_bound : forall a b q : Z, 0 < b -> a <= q * b -> a ÷ b <= q. Proof. intros; nia. Qed. Example Zquot_Z_quot_lt : forall a b : Z, 0 < a -> 2 <= b -> a ÷ b < a. Proof. intros; nia. Qed. Example Zquot_Zquot_lt_upper_bound : forall a b q : Z, 0 <= a -> 0 < b -> a < q * b -> a ÷ b < q. Proof. intros; nia. Qed. From Coq Require Zquot. Example Zquot_Zquot_mod_unique_full : forall a b q r : Z, Zquot.Remainder a b r -> a = b * q + r -> q = a ÷ b /\ r = Z.rem a b. Proof. intros. Fail nia. Abort. Example Zquot_Z_quot_monotone : forall a b c : Z, 0 <= c -> a <= b -> a ÷ c <= b ÷ c. Proof. intros. Fail nia. Abort. Example Zquot_Zquot_mult_cancel_l : forall a b c : Z, c <> 0 -> c * a ÷ (c * b) = a ÷ b. Proof. intros. Abort. Example Zquot_Zquot_mult_cancel_r : forall a b c : Z, c <> 0 -> a * c ÷ (b * c) = a ÷ b. Proof. intros. Abort. Example Zquot_Zquot_mult_le : forall a b c : Z, 0 <= a -> 0 <= b -> 0 <= c -> c * (a ÷ b) <= c * a ÷ b. Proof. intros; nia. Qed. Example Zquot_Z_quot_pos : forall a b : Z, 0 <= a -> 0 <= b -> 0 <= a ÷ b. Proof. intros; nia. Qed. Example Zquot_Zquotrem_Zdiv_eucl_pos : forall a b : Z, 0 <= a -> 0 < b -> a ÷ b = a / b /\ Z.rem a b = a mod b. Proof. intros; nia. Qed. Example Zquot_Zquot_sgn : forall a b : Z, 0 <= Z.sgn (a ÷ b) * Z.sgn a * Z.sgn b. Proof. intros; nia. Qed. Example Zquot_Zquot_unique_full : forall a b q r : Z, Zquot.Remainder a b r -> a = b * q + r -> q = a ÷ b. Proof. intros. Fail nia. Abort. Example Zquot_Zquot_Zdiv_pos : forall a b : Z, 0 <= a -> 0 <= b -> a ÷ b = a / b. Proof. intros; nia. Qed. Example Zquot_Zquot_Zquot : forall a b c : Z, a ÷ b ÷ c = a ÷ (b * c). Proof. intros. Abort. Example Zquot_Zrem_0_l : forall a : Z, Z.rem 0 a = 0. Proof. intros; nia. Qed. Example Zquot_Zrem_0_r : forall a : Z, Z.rem a 0 = a. Proof. intros; nia. Qed. Example Zquot_Zrem_divides : forall a b : Z, Z.rem a b = 0 <-> (exists c : Z, a = b * c). Proof. intros. Fail nia. Abort. Example Zquot_Zrem_even : forall a : Z, Z.rem a 2 = (if Z.even a then 0 else Z.sgn a). Proof. intros. Fail nia. Abort. Example Zquot_Zrem_le : forall a b : Z, 0 <= a -> 0 <= b -> Z.rem a b <= a. Proof. intros. Fail nia. Abort. Example Zquot_Zrem_lt_neg : forall a b : Z, a <= 0 -> b <> 0 -> - Z.abs b < Z.rem a b <= 0. Proof. intros; nia. Qed. Example Zquot_Zrem_lt_neg_neg : forall a b : Z, a <= 0 -> b < 0 -> b < Z.rem a b <= 0. Proof. intros; nia. Qed. Example Zquot_Zrem_lt_neg_pos : forall a b : Z, a <= 0 -> 0 < b -> - b < Z.rem a b <= 0. Proof. intros; nia. Qed. Example Zquot_Zrem_lt_pos : forall a b : Z, 0 <= a -> b <> 0 -> 0 <= Z.rem a b < Z.abs b. Proof. intros; nia. Qed. Example Zquot_Zrem_lt_pos_neg : forall a b : Z, 0 <= a -> b < 0 -> 0 <= Z.rem a b < - b. Proof. intros; nia. Qed. Example Zquot_Zrem_lt_pos_pos : forall a b : Z, 0 <= a -> 0 < b -> 0 <= Z.rem a b < b. Proof. intros; nia. Qed. Example Zquot_Z_rem_mult : forall a b : Z, Z.rem (a * b) b = 0. Proof. intros; nia. Qed. Example Zquot_Zrem_odd : forall a : Z, Z.rem a 2 = (if Z.odd a then Z.sgn a else 0). Proof. intros. Fail nia. Abort. Example Zquot_Zrem_opp_l : forall a b : Z, Z.rem (- a) b = - Z.rem a b. Proof. intros. Fail nia. Abort. Example Zquot_Zrem_opp_opp : forall a b : Z, Z.rem (- a) (- b) = - Z.rem a b. Proof. intros. Fail nia. Abort. Example Zquot_Zrem_opp_r : forall a b : Z, Z.rem a (- b) = Z.rem a b. Proof. intros. Fail nia. Abort. Example Zquot_Z_rem_plus : forall a b c : Z, 0 <= (a + b * c) * a -> Z.rem (a + b * c) c = Z.rem a c. Proof. intros. Fail nia. Abort. Example Zquot_Zrem_rem : forall a n : Z, Z.rem (Z.rem a n) n = Z.rem a n. Proof. intros. Fail nia. Abort. Example Zquot_Z_rem_same : forall a : Z, Z.rem a a = 0. Proof. intros. Fail nia. Abort. Example Zquot_Zrem_sgn2 : forall a b : Z, 0 <= Z.rem a b * a. Proof. intros. Fail nia. Abort. Example Zquot_Zrem_sgn : forall a b : Z, 0 <= Z.sgn (Z.rem a b) * Z.sgn a. Proof. intros; nia. Qed. Example Zquot_Zrem_unique_full : forall a b q r : Z, Zquot.Remainder a b r -> a = b * q + r -> r = Z.rem a b. Proof. intros. Fail nia. Abort. Example Zquot_Zrem_Zmod_pos : forall a b : Z, 0 <= a -> 0 < b -> Z.rem a b = a mod b. Proof. intros; nia. Qed. Example Zquot_Zrem_Zmod_zero : forall a b : Z, b <> 0 -> Z.rem a b = 0 <-> a mod b = 0. Proof. intros; nia. Qed. Example Z_rem_0_l : forall a : Z, a <> 0 -> Z.rem 0 a = 0. Proof. intros; nia. Qed. Example Z_rem_0_r_ext : forall x y : Z, y = 0 -> Z.rem x y = x. Proof. intros; nia. Qed. Example Z_rem_1_l : forall a : Z, 1 < a -> Z.rem 1 a = 1. Proof. intros. Fail nia. Abort. Example Z_rem_1_r : forall a : Z, Z.rem a 1 = 0. Proof. intros; nia. Qed. Example Z_rem_abs : forall a b : Z, b <> 0 -> Z.rem (Z.abs a) (Z.abs b) = Z.abs (Z.rem a b). Proof. intros. Fail nia. Abort. Example Z_rem_abs_l : forall a b : Z, b <> 0 -> Z.rem (Z.abs a) b = Z.abs (Z.rem a b). Proof. intros. Fail nia. Abort. Example Z_rem_abs_r : forall a b : Z, b <> 0 -> Z.rem a (Z.abs b) = Z.rem a b. Proof. intros. Fail nia. Abort. Example Z_rem_add : forall a b c : Z, c <> 0 -> 0 <= (a + b * c) * a -> Z.rem (a + b * c) c = Z.rem a c. Proof. intros. Fail nia. Abort. Example Z_rem_bound_abs : forall a b : Z, b <> 0 -> Z.abs (Z.rem a b) < Z.abs b. Proof. intros; nia. Qed. Example Z_rem_bound_neg_neg : forall x y : Z, y < 0 -> x <= 0 -> y < Z.rem x y <= 0. Proof. intros; nia. Qed. Example Z_rem_bound_neg_pos : forall x y : Z, y < 0 -> 0 <= x -> 0 <= Z.rem x y < - y. Proof. intros; nia. Qed. Example Z_rem_bound_pos : forall a b : Z, 0 <= a -> 0 < b -> 0 <= Z.rem a b < b. Proof. intros; nia. Qed. Example Z_rem_bound_pos_neg : forall x y : Z, 0 < y -> x <= 0 -> - y < Z.rem x y <= 0. Proof. intros; nia. Qed. Example Z_rem_bound_pos_pos : forall x y : Z, 0 < y -> 0 <= x -> 0 <= Z.rem x y < y. Proof. intros; nia. Qed. Example Z_rem_eq : forall a b : Z, b <> 0 -> Z.rem a b = a - b * (a ÷ b). Proof. intros; nia. Qed. Example Z_rem_le : forall a b : Z, 0 <= a -> 0 < b -> Z.rem a b <= a. Proof. intros. Fail nia. Abort. Example Z_rem_mod_eq_0 : forall a b : Z, b <> 0 -> Z.rem a b = 0 <-> a mod b = 0. Proof. intros; nia. Qed. Example Z_rem_mod : forall a b : Z, b <> 0 -> Z.rem a b = Z.sgn a * (Z.abs a mod Z.abs b). Proof. intros. Fail nia. Abort. Example Z_rem_mod_nonneg : forall a b : Z, 0 <= a -> 0 < b -> Z.rem a b = a mod b. Proof. intros; nia. Qed. Example Z_rem_mul : forall a b : Z, b <> 0 -> Z.rem (a * b) b = 0. Proof. intros; nia. Qed. Example Z_rem_nonneg : forall a b : Z, b <> 0 -> 0 <= a -> 0 <= Z.rem a b. Proof. intros; nia. Qed. Example Z_rem_nonpos : forall a b : Z, b <> 0 -> a <= 0 -> Z.rem a b <= 0. Proof. intros; nia. Qed. Example Z_rem_opp_l : forall a b : Z, b <> 0 -> Z.rem (- a) b = - Z.rem a b. Proof. intros. Fail nia. Abort. Example Z_rem_opp_l' : forall a b : Z, Z.rem (- a) b = - Z.rem a b. Proof. intros. Fail nia. Abort. Example Z_rem_opp_opp : forall a b : Z, b <> 0 -> Z.rem (- a) (- b) = - Z.rem a b. Proof. intros. Fail nia. Abort. Example Z_rem_opp_r : forall a b : Z, b <> 0 -> Z.rem a (- b) = Z.rem a b. Proof. intros. Fail nia. Abort. Example Z_rem_opp_r' : forall a b : Z, Z.rem a (- b) = Z.rem a b. Proof. intros. Fail nia. Abort. Example Z_rem_quot : forall a b : Z, b <> 0 -> Z.rem a b ÷ b = 0. Proof. intros; nia. Qed. Example Z_rem_rem : forall a n : Z, n <> 0 -> Z.rem (Z.rem a n) n = Z.rem a n. Proof. intros. Fail nia. Abort. Example Z_rem_same : forall a : Z, a <> 0 -> Z.rem a a = 0. Proof. intros. Fail nia. Abort. Example Z_rem_sign : forall a b : Z, a <> 0 -> b <> 0 -> Z.sgn (Z.rem a b) <> - Z.sgn a. Proof. intros; nia. Qed. Example Z_rem_sign_mul : forall a b : Z, b <> 0 -> 0 <= Z.rem a b * a. Proof. intros. Fail nia. Abort. Example Z_rem_sign_nz : forall a b : Z, b <> 0 -> Z.rem a b <> 0 -> Z.sgn (Z.rem a b) = Z.sgn a. Proof. intros; nia. Qed. Example Z_rem_small : forall a b : Z, 0 <= a < b -> Z.rem a b = a. Proof. intros. Fail nia. Abort. Example Z_rem_small_iff : forall a b : Z, b <> 0 -> Z.rem a b = a <-> Z.abs a < Z.abs b. Proof. intros. Fail nia. Abort. Example Z_rem_unique : forall a b q r : Z, 0 <= a -> 0 <= r < b -> a = b * q + r -> r = Z.rem a b. Proof. intros; nia. Qed. Example Z_rem_divide: forall a b : Z, b <> 0 -> Z.rem a b = 0 <-> (b | a). Proof. split; intros. Fail all: nia. Abort. Example Zrem_divides: forall a b : Z, b <> 0 -> Z.rem a b = 0 <-> (exists c : Z, a = b * c). Proof. split; intros. Fail all: nia. Abort. Example Z_rem_wd : Morphisms.Proper (Morphisms.respectful Z.eq (Morphisms.respectful Z.eq Z.eq)) Z.rem. Proof. repeat intro; subst. Fail nia. Abort. coq-8.20.0/test-suite/success/NotationDeprecation.v000066400000000000000000000012131466560755400223200ustar00rootroot00000000000000Module Syndefs. #[deprecated(since = "8.9", note = "Do not use.")] Notation foo := Prop. Fail #[deprecated(since = "8.9", note = "Do not use."), deprecated(since = "8.10", note = "Duplicated deprecation.")] Notation foo := Prop. Check foo. Set Warnings "+deprecated". Fail Check foo. End Syndefs. Module Notations. #[deprecated(since = "8.9", note = "Do not use.")] Notation "!!" := Prop. Check !!. Set Warnings "+deprecated". Fail Check !!. End Notations. Module Infix. #[deprecated(since = "8.9", note = "Do not use.")] Infix "!!" := plus (at level 1). Check (_ !! _). Set Warnings "+deprecated". Fail Check (_ !! _). End Infix. coq-8.20.0/test-suite/success/Notations.v000066400000000000000000000122411466560755400203300ustar00rootroot00000000000000(* Check that "where" clause behaves as if given independently of the *) (* definition (variant of BZ#1132 submitted by Assia Mahboubi) *) Fixpoint plus1 (n m:nat) {struct n} : nat := match n with | O => m | S p => S (p+m) end where "n + m" := (plus1 n m) : nat_scope. (* Check behaviour wrt yet empty levels (see Stephane's bug #1850) *) Parameter P : Type -> Type -> Type -> Type. Notation "e |= t --> v" := (P e t v) (at level 100, t at level 54). Check (nat |= nat --> nat). (* Check that first non empty definition at an empty level can be of any associativity *) Module Type v1. Notation "x +1" := (S x) (at level 8, left associativity). End v1. Module Type v2. Notation "x +1" := (S x) (at level 8, right associativity). End v2. (* Check that empty levels (here 8 and 2 in pattern) are added in the right order *) Notation "' 'C_' G ( A )" := (A,G) (at level 8, G at level 2). (* Check import of notations from within a section *) Notation "+1 x" := (S x) (at level 25, x at level 9). Section A. Require Import make_notation. End A. (* Check use of "$" (see bug #1961) *) Notation "$ x" := (id x) (at level 30). Check ($ 5). (* Check regression of bug #2087 *) Notation "'exists' x , P" := (x, P) (at level 200, x ident, right associativity, only parsing). Definition foo P := let '(exists x, Q) := P in x = Q :> nat. (* Check empty levels when extending binder_constr *) Notation "'exists' x >= y , P" := (exists x, x >= y /\ P)%nat (at level 200, x ident, right associativity, y at level 69). (* This used to loop at some time before r12491 *) Notation R x := (@pair _ _ x). Check (fun x:nat*nat => match x with R x y => (x,y) end). (* Check multi-tokens recursive notations *) Local Notation "[ a # ; .. # ; b ]" := (a + .. (b + 0) ..). Check [ 0 ]. Check [ 0 # ; 1 ]. (* Check well-scoping of alpha-renaming of private binders *) (* see bug #2248 (thanks to Marc Lasson) *) Notation "{ q , r | P }" := (fun (p:nat*nat) => let (q, r) := p in P). Check (fun p => {q,r| q + r = p}). (* Check that declarations of empty levels are correctly backtracked *) Section B. Notation "*" := 5 (at level 0) : nat_scope. Notation "[ h ] p" := (h + p) (at level 8, p at level 9, h at level 7) : nat_scope. End B. (* Should succeed *) Definition n := 5 * 5. (* Check that lonely notations (here FOO) do not modify the visibility of scoped interpretations (bug #2634 fixed in r14819) *) Notation "x ++++ y" := (mult x y) (at level 40). Notation "x ++++ y" := (plus x y) : A_scope. Open Scope A_scope. Notation "'FOO' x" := (S x) (at level 40). Goal (2 ++++ 3) = 5. reflexivity. Abort. (* Check correct failure handling when a non-constructor notation is used in cases pattern (bug #2724 in 8.3 and 8.4beta) *) Notation "'FORALL' x .. y , P" := (forall x, .. (forall y, P) ..) (at level 200, x binder, y binder, right associativity) : type_scope. Fail Check fun x => match x with S (FORALL x, _) => 0 end. (* Bug #2708: don't check for scope of variables used as binder *) Parameter traverse : (nat -> unit) -> (nat -> unit). Notation traverse_var f l := (traverse (fun l => f l) l). (* Check that when an ident become a keyword, it does not break previous rules relying on the string to be classified as an ident *) Notation "'intros' x" := (S x) (at level 0). Goal True -> True. intros H. exact H. Qed. (* Check absence of collision on ".." in nested notations with ".." *) Notation "[ a , .. , b ]" := (a, (.. (b,tt) ..)). (* Check that vector notations do not break Ltac [] (bugs #4785, #4733) *) Require Import Coq.Vectors.VectorDef. Import VectorNotations. Goal True. idtac; []. (* important for test: no space here *) constructor. Qed. (* Check parsing of { and } is not affected by notations #3479 *) Notation " |- {{ a }} b" := (a=b) (no associativity, at level 10). Goal True. {{ exact I. }} Qed. Check |- {{ 0 }} 0. (* Check parsing of { and } is not affected by notations #3479 *) Notation " |- {{ a }} b" := (a=b) (no associativity, at level 10). Goal True. {{ exact I. }} Qed. (* Check that we can have notations without any symbol iff they are "only printing". *) Fail Notation "" := (@nil). Notation "" := (@nil) (only printing). (* Check that a notation cannot be neither parsing nor printing. *) Fail Notation "'foobarkeyword'" := (@nil) (only parsing, only printing). (* Check "where" clause for inductive types with parameters *) Reserved Notation "x === y" (at level 50). Inductive EQ {A} (x:A) : A -> Prop := REFL : x === x where "x === y" := (EQ x y). (* Check that strictly ident or _ are coerced to a name *) Fail Check {x@{u},y|x=x}. Fail Check {?[n],y|0=0}. (* Check that 10 is well declared left associative *) Section C. Notation "f $$$ x" := (id f x) (at level 10, left associativity). End C. (* Scope names should not start with an underscore *) Fail Declare Scope _scope_start_underscore. (* Scope delimiters should not start with an underscore *) Fail Delimit Scope type_scope with _type. Module ImplicitArgumentsPrimToken. (* Check that implicit arguments of number notations are taken into account *) Class T (A:Type). Parameter (a:T nat). Axiom f : forall A, T A -> A. Arguments f {A} {_}. Notation "0" := f. Check 0 = 1. End ImplicitArgumentsPrimToken. coq-8.20.0/test-suite/success/Notations2.v000066400000000000000000000211721466560755400204150ustar00rootroot00000000000000(* This file is giving some examples about how implicit arguments and scopes are treated when using abbreviations or notations, in terms or patterns, or when using @ and parentheses in terms and patterns. The convention is: Constant foo with implicit arguments and scopes used in a term or a pattern: foo do not deactivate further arguments and scopes @foo deactivate further arguments and scopes (foo x) deactivate further arguments and scopes (@foo x) deactivate further arguments and scopes Notations binding to foo: # := foo do not deactivate further arguments and scopes # := @foo deactivate further arguments and scopes # x := foo x do not deactivate further arguments and scopes # x := @foo x do not deactivate further arguments and scopes Abbreviations binding to foo: f := foo do not deactivate further arguments and scopes f := @foo deactivate further arguments and scopes f x := foo x do not deactivate further arguments and scopes f x := @foo x do not deactivate further arguments and scopes *) (* One checks that abbreviations and notations in patterns now behave like in terms *) Inductive prod' A : Type -> Type := | pair' (a:A) B (b:B) (c:bool) : prod' A B. Arguments pair' [A] a%_bool_scope [B] b%_bool_scope c%_bool_scope. Notation "0" := true : bool_scope. (* 1. Abbreviations do not stop implicit arguments to be inserted and scopes to be used *) Notation c1 x := (pair' x). Check pair' 0 0 0 : prod' bool bool. Check (pair' 0) _ 0%bool 0%bool : prod' bool bool. (* parentheses are blocking implicit and scopes *) Check c1 0 0 0 : prod' bool bool. Check fun x : prod' bool bool => match x with c1 0 y 0 => 2 | _ => 1 end. (* 2. Abbreviations do not stop implicit arguments to be inserted and scopes to be used *) Notation c2 x := (@pair' _ x). Check (@pair' _ 0) _ 0%bool 0%bool : prod' bool bool. (* parentheses are blocking implicit and scopes *) Check c2 0 0 0 : prod' bool bool. Check fun A (x : prod' bool A) => match x with c2 0 y 0 => 2 | _ => 1 end. Check fun A (x : prod' bool A) => match x with (@pair' _ 0) _ y 0%bool => 2 | _ => 1 end. (* 3. Abbreviations do not stop implicit arguments to be inserted and scopes to be used *) Notation c3 x := ((@pair') _ x). Check (@pair') _ 0%bool _ 0%bool 0%bool : prod' bool bool. (* @ is blocking implicit and scopes *) Check ((@pair') _ 0%bool) _ 0%bool 0%bool : prod' bool bool. (* parentheses and @ are blocking implicit and scopes *) Check c3 0 0 0 : prod' bool bool. Check fun A (x :prod' bool A) => match x with c3 0 y 0 => 2 | _ => 1 end. (* 4. Abbreviations do not stop implicit arguments to be inserted and scopes to be used *) (* unless an atomic @ is given *) Notation c4 := (@pair'). Check (@pair') _ 0%bool _ 0%bool 0%bool : prod' bool bool. Check c4 _ 0%bool _ 0%bool 0%bool : prod' bool bool. Check fun A (x :prod' bool A) => match x with c4 _ 0%bool _ y 0%bool => 2 | _ => 1 end. Check fun A (x :prod' bool A) => match x with (@pair') _ 0%bool _ y 0%bool => 2 | _ => 1 end. (* 5. Non-@id notations inherit implicit arguments to be inserted and scopes to be used *) Notation "# x" := (pair' x) (at level 0, x at level 1). Check pair' 0 0 0 : prod' bool bool. Check # 0 0 0 : prod' bool bool. Check fun A (x :prod' bool A) => match x with # 0 y 0 => 2 | _ => 1 end. (* 6. Non-@id notations inherit implicit arguments to be inserted and scopes to be used *) Notation "## x" := ((@pair') _ x) (at level 0, x at level 1). Check (@pair') _ 0%bool _ 0%bool 0%bool : prod' bool bool. Check ((@pair') _ 0%bool) _ 0%bool 0%bool : prod' bool bool. Check ## 0%bool 0 0 : prod' bool bool. Check fun A (x :prod' bool A) => match x with ## 0%bool y 0 => 2 | _ => 1 end. (* 7. Notations stop further implicit arguments to be inserted and scopes to be used *) Notation "###" := (@pair') (at level 0). Check (@pair') _ 0%bool _ 0%bool 0%bool : prod' bool bool. Check ### _ 0%bool _ 0%bool 0%bool : prod' bool bool. Check fun A (x :prod' bool A) => match x with ### _ 0%bool _ y 0%bool => 2 | _ => 1 end. (* 8. Notations w/o @ preserves implicit arguments and scopes *) Notation "####" := pair' (at level 0). Check #### 0 0 0 : prod' bool bool. Check fun A (x :prod' bool A) => match x with #### 0 y 0 => 2 | _ => 1 end. (* 9. Non-@id notations inherit implicit arguments and scopes *) Notation "##### x" := (pair' x) (at level 0, x at level 1). Check ##### 0 0 0 : prod' bool bool. Check fun A (x :prod' bool A) => match x with ##### 0 y 0 => 2 | _ => 1 end. (* 10. Check computation of binding variable through other notations *) (* it should be detected as binding variable and the scopes not being checked *) Notation "'FUNNAT' i => t" := (fun i : nat => i = t) (at level 200). Notation "'Funnat' i => t" := (FUNNAT i => t + i%nat) (at level 200). (* 11. Notations with needed factorization of a recursive pattern *) (* See https://github.com/coq/coq/issues/6078#issuecomment-342287412 *) Module M11. Notation "[:: x1 ; .. ; xn & s ]" := (cons x1 .. (cons xn s) ..). Notation "[:: x1 ; .. ; xn ]" := (cons x1 .. (cons xn nil) ..). Check [:: 1 ; 2 ; 3 ]. Check [:: 1 ; 2 ; 3 & nil ]. (* was failing *) End M11. (* 12. Preventively check that a variable which does not occur can be instantiated *) (* by any term. In particular, it should not be restricted to a binder *) Module M12. Notation "N ++ x" := (S x) (only parsing). Check 2 ++ 0. End M12. (* 13. Check that internal data about associativity are not used in comparing levels *) Module M13. Notation "x ;; z" := (x + z) (at level 100, z at level 200, only parsing, right associativity). Notation "x ;; z" := (x * z) (at level 100, z at level 200, only parsing) : foo_scope. End M13. (* 14. Check that a notation with a "ident" binder does not include a pattern *) Module M14. Notation "'myexists' x , p" := (ex (fun x => p)) (at level 200, x ident, p at level 200, right associativity) : type_scope. Check myexists I, I = 0. (* Should not be seen as a constructor *) End M14. (* 15. Testing different ways to give the same levels without failing *) Module M15. Local Notation "###### x" := (S x) (right associativity, at level 79, x at next level). Fail Local Notation "###### x" := (S x) (right associativity, at level 79, x at level 79). Local Notation "###### x" := (S x) (at level 79). End M15. (* 16. Some test about custom entries *) Module M16. (* Test locality *) Local Declare Custom Entry foo. Fail Notation "#" := 0 (in custom foo). (* Should be local *) Local Notation "#" := 0 (in custom foo). (* Test import *) Module A. Declare Custom Entry foo2. End A. Notation "##" := 0 (in custom foo2). Import A. Local Notation "####" := 0 (in custom foo2). (* Test Print Grammar *) Print Custom Grammar foo. Print Custom Grammar foo2. End M16. Fail Local Notation "###" := 0 (in custom foo). Fail Print Custom Grammar foo. Notation "####" := 0 (in custom foo2). (* Example showing the need for strong evaluation of cases_pattern_of_glob_constr (this used to raise Not_found at some time) *) Module M17. Notation "# x ## t & u" := ((fun x => (x,t)),(fun x => (x,u))) (at level 0, x pattern). Check fun y : nat => # (x,z) ## y & y. End M17. Module Bug10750. Notation "#" := 0 (only printing). Print Visibility. End Bug10750. Module M18. Module A. Module B. Infix "+++" := Nat.add (at level 70). End B. End A. Import A. (* Check that the notation in module B is not visible *) Infix "+++" := Nat.add (at level 80). End M18. Module InheritanceArgumentScopes. Axiom p : forall (A:Type) (b:nat), A = A /\ b = b. Check fun A n => p (A * A) (n * n). (* safety check *) Notation q := @p. Check fun A n => q (A * A) (n * n). (* check that argument scopes are propagated *) End InheritanceArgumentScopes. Module InheritanceMaximalImplicitPureNotation. Definition id {A B:Type} (a:B) := a. Notation "#" := (@id nat). Check # = (fun a:nat => a). (* # should inherit its maximal implicit argument *) End InheritanceMaximalImplicitPureNotation. Module TreeLikeLookAhead. Notation "6 ^" := true (at level 0, format "6 ^"). Notation "6 ?" := false (at level 0, format "6 ?"). Check 6. End TreeLikeLookAhead. Module FactorizationListSeparators. Notation "[ a + + .. + + c | d ]" := (cons a .. (cons c d) ..) (a at level 10). Notation "[ a + + .. + + c ]" := (cons a .. (cons c nil) ..) (a at level 10). Check [0 + + 1 | nil]. Check [0 + + 1]. End FactorizationListSeparators. Module TestNonExistentCustomOnlyPrinting. Fail Notation "[ x ]" := (id x) (x custom doesntexist, only printing). Fail Notation "# x" := (id x) (in custom doesntexist, only printing). End TestNonExistentCustomOnlyPrinting. Module NotationClauseIn. Notation "1" := unit. Check fun x => match x in 1 with tt => 0 end. End NotationClauseIn. coq-8.20.0/test-suite/success/NotationsAndLtac.v000066400000000000000000000027711466560755400215660ustar00rootroot00000000000000(* Test that adding notations that overlap with the tactic grammar does not * interfere with Ltac parsing. *) Module test1. Notation "x [ y ]" := (fst (id x, id y)) (at level 11). Goal True \/ (exists x : nat, True /\ True) -> True. Proof. intros [|[a [y z]]]; [idtac|idtac]; try solve [eauto | trivial; [trivial]]. Qed. End test1. Module test2. Notation "x [ y ]" := (fst (id x, id y)) (at level 100). Goal True \/ (exists x : nat, True /\ True) -> True. Proof. intros [|[a [y z]]]; [idtac|idtac]; try solve [eauto | trivial; [trivial]]. Qed. End test2. Module test3. Notation "x [ y ]" := (fst (id x, id y)) (at level 1). Goal True \/ (exists x : nat, True /\ True) -> True. Proof. intros [|[a [y z]]]; [idtac|idtac]; try solve [eauto | trivial; [trivial]]. Qed. End test3. Module test1'. Notation "x [ [ y ] ] " := (fst (id x, id y)) (at level 11). Goal True \/ (exists x : nat, True /\ True) -> True. Proof. intros [|[a [y z]]]; [idtac|idtac]; try solve [eauto | trivial; [trivial]]. Qed. End test1'. Module test2'. Notation "x [ [ y ] ]" := (fst (id x, id y)) (at level 100). Goal True \/ (exists x : nat, True /\ True) -> True. Proof. intros [|[a [y z]]]; [idtac|idtac]; try solve [eauto | trivial; [trivial]]. Qed. End test2'. Module test3'. Notation "x [ [ y ] ]" := (fst (id x, id y)) (at level 1). Goal True \/ (exists x : nat, True /\ True) -> True. Proof. intros [|[a [y z]]]; [idtac|idtac]; try solve [eauto | trivial; [trivial]]. Qed. End test3'. coq-8.20.0/test-suite/success/Nsatz.v000066400000000000000000000336211466560755400174560ustar00rootroot00000000000000Require Import TestSuite.admit. (* compile en user 3m39.915s sur cachalot *) Require Import Nsatz. Require List. Import List.ListNotations. (* Example with a generic domain *) Section test. Context {A:Type}`{Aid:Integral_domain A}. Lemma example3 : forall x y z, x+y+z==0 -> x*y+x*z+y*z==0-> x*y*z==0 -> x^3%Z==0. Proof. Time nsatz. Qed. Lemma example4 : forall x y z u, x+y+z+u==0 -> x*y+x*z+x*u+y*z+y*u+z*u==0-> x*y*z+x*y*u+x*z*u+y*z*u==0-> x*y*z*u==0 -> x^4%Z==0. Proof. Time nsatz. Qed. Lemma example5 : forall x y z u v, x+y+z+u+v==0 -> x*y+x*z+x*u+x*v+y*z+y*u+y*v+z*u+z*v+u*v==0-> x*y*z+x*y*u+x*y*v+x*z*u+x*z*v+x*u*v+y*z*u+y*z*v+y*u*v+z*u*v==0-> x*y*z*u+y*z*u*v+z*u*v*x+u*v*x*y+v*x*y*z==0 -> x*y*z*u*v==0 -> x^5%Z==0. Proof. Time nsatz. Qed. Goal forall x y:Z, x = y -> (x+0)%Z = (y*1+0)%Z. nsatz. Qed. Require Import Rbase. Goal forall x y:R, x = y -> (x+0)%R = (y*1+0)%R. nsatz. Qed. Goal forall a b c x:R, a = b -> b = c -> (a*a)%R = (c*c)%R. nsatz. Qed. End test. Section Geometry. (* See the interactive pictures of Laurent Théry on http://www-sop.inria.fr/marelle/CertiGeo/ and research paper on https://docs.google.com/fileview?id=0ByhB3nPmbnjTYzFiZmIyNGMtYTkwNC00NWFiLWJiNzEtODM4NmVkYTc2NTVk&hl=fr *) Require Import Rbase. Require Import List. Record point:Type:={ X:R; Y:R}. Definition collinear(A B C:point):= (X A - X B)*(Y C - Y B)-(Y A - Y B)*(X C - X B)=0. Definition parallel (A B C D:point):= ((X A)-(X B))*((Y C)-(Y D))=((Y A)-(Y B))*((X C)-(X D)). Definition notparallel (A B C D:point)(x:R):= x*(((X A)-(X B))*((Y C)-(Y D))-((Y A)-(Y B))*((X C)-(X D)))=1. Definition orthogonal (A B C D:point):= ((X A)-(X B))*((X C)-(X D))+((Y A)-(Y B))*((Y C)-(Y D))=0. Definition equal2(A B:point):= (X A)=(X B) /\ (Y A)=(Y B). Definition equal3(A B:point):= ((X A)-(X B))^2%Z+((Y A)-(Y B))^2%Z = 0. Definition nequal2(A B:point):= (X A)<>(X B) \/ (Y A)<>(Y B). Definition nequal3(A B:point):= not (((X A)-(X B))^2%Z+((Y A)-(Y B))^2%Z = 0). Definition middle(A B I:point):= 2%R*(X I)=(X A)+(X B) /\ 2%R*(Y I)=(Y A)+(Y B). Definition distance2(A B:point):= (X B - X A)^2%Z + (Y B - Y A)^2%Z. (* AB = CD *) Definition samedistance2(A B C D:point):= (X B - X A)^2%Z + (Y B - Y A)^2%Z = (X D - X C)^2%Z + (Y D - Y C)^2%Z. Definition determinant(A O B:point):= (X A - X O)*(Y B - Y O) - (Y A - Y O)*(X B - X O). Definition scalarproduct(A O B:point):= (X A - X O)*(X B - X O) + (Y A - Y O)*(Y B - Y O). Definition norm2(A O B:point):= ((X A - X O)^2%Z+(Y A - Y O)^2%Z)*((X B - X O)^2%Z+(Y B - Y O)^2%Z). Definition equaldistance(A B C D:point):= ((X B) - (X A))^2%Z + ((Y B) - (Y A))^2%Z = ((X D) - (X C))^2%Z + ((Y D) - (Y C))^2%Z. Definition equaltangente(A B C D E F:point):= let s1:= determinant A B C in let c1:= scalarproduct A B C in let s2:= determinant D E F in let c2:= scalarproduct D E F in s1 * c2 = s2 * c1. Ltac cnf2 f := match f with | ?A \/ (?B /\ ?C) => let c1 := cnf2 (A\/B) in let c2 := cnf2 (A\/C) in constr:(c1/\c2) | (?B /\ ?C) \/ ?A => let c1 := cnf2 (B\/A) in let c2 := cnf2 (C\/A) in constr:(c1/\c2) | (?A \/ ?B) \/ ?C => let c1 := cnf2 (B\/C) in cnf2 (A \/ c1) | _ => f end with cnf f := match f with | ?A \/ ?B => let c1 := cnf A in let c2 := cnf B in cnf2 (c1 \/ c2) | ?A /\ ?B => let c1 := cnf A in let c2 := cnf B in constr:(c1 /\ c2) | _ => f end. Ltac scnf := match goal with | |- ?f => let c := cnf f in assert c;[repeat split| tauto] end. Ltac disj_to_pol f := match f with | ?a = ?b \/ ?g => let p := disj_to_pol g in constr:((a - b)* p) | ?a = ?b => constr:(a - b) end. Lemma fastnsatz1:forall x y:R, x - y = 0 -> x = y. nsatz. Qed. Ltac fastnsatz:= try trivial; try apply fastnsatz1; try trivial; nsatz. Ltac proof_pol_disj := match goal with | |- ?g => let p := disj_to_pol g in let h := fresh "hp" in assert (h:p = 0); [idtac| prod_disj h p] | _ => idtac end with prod_disj h p := match goal with | |- ?a = ?b \/ ?g => match p with | ?q * ?p1 => let h0 := fresh "hp" in let h1 := fresh "hp" in let h2 := fresh "hp" in assert (h0:a - b = 0 \/ p1 = 0); [apply Rmult_integral; exact h| destruct h0 as [h1|h2]; [left; fastnsatz| right; prod_disj h2 p1]] end | _ => fastnsatz end. (* Goal forall a b c d e f:R, a=b \/ c=d \/ e=f \/ e=a. intros. scnf; proof_pol_disj . admit.*) Ltac geo_unfold := unfold collinear, parallel, notparallel, orthogonal, equal2, equal3, nequal2, nequal3, middle, samedistance2, determinant, scalarproduct, norm2, distance2, equaltangente, determinant, scalarproduct, equaldistance. Ltac geo_rewrite_hyps:= repeat (match goal with | h:X _ = _ |- _ => rewrite h in *; clear h | h:Y _ = _ |- _ => rewrite h in *; clear h end). Ltac geo_split_hyps:= repeat (match goal with | h:_ /\ _ |- _ => destruct h end). Ltac geo_begin:= geo_unfold; intros; geo_rewrite_hyps; geo_split_hyps; scnf; proof_pol_disj. (* Examples *) Lemma medians: forall A B C A1 B1 C1 H:point, middle B C A1 -> middle A C B1 -> middle A B C1 -> collinear A A1 H -> collinear B B1 H -> collinear C C1 H \/ collinear A B C. Proof. geo_begin. idtac "Medians". Time nsatz. (*Finished transaction in 2. secs (2.69359u,0.s) *) Qed. Lemma Pythagore: forall A B C:point, orthogonal A B A C -> distance2 A C + distance2 A B = distance2 B C. Proof. geo_begin. idtac "Pythagore". Time nsatz. (*Finished transaction in 0. secs (0.354946u,0.s) *) Qed. Lemma Thales: forall O A B C D:point, collinear O A C -> collinear O B D -> parallel A B C D -> (distance2 O B * distance2 O C = distance2 O D * distance2 O A /\ distance2 O B * distance2 C D = distance2 O D * distance2 A B) \/ collinear O A B. geo_begin. idtac "Thales". Time nsatz. (*Finished transaction in 2. secs (1.598757u,0.s)*) Time nsatz. Qed. Lemma segments_of_chords: forall A B C D M O:point, equaldistance O A O B -> equaldistance O A O C -> equaldistance O A O D -> collinear A B M -> collinear C D M -> (distance2 M A) * (distance2 M B) = (distance2 M C) * (distance2 M D) \/ parallel A B C D. Proof. geo_begin. idtac "segments_of_chords". Time nsatz. (*Finished transaction in 3. secs (2.704589u,0.s) *) Qed. Lemma isoceles: forall A B C:point, equaltangente A B C B C A -> distance2 A B = distance2 A C \/ collinear A B C. Proof. geo_begin. Time nsatz. (*Finished transaction in 1. secs (1.140827u,0.s)*) Qed. Lemma minh: forall A B C D O E H I:point, X A = 0 -> Y A = 0 -> Y O = 0 -> equaldistance O A O B -> equaldistance O A O C -> equaldistance O A O D -> orthogonal A C B D -> collinear A C E -> collinear B D E -> collinear A B H -> orthogonal E H A B -> collinear C D I -> middle C D I -> collinear H E I \/ (X C)^2%Z * (X B)^5%Z * (X O)^2%Z * (X C - 2%Z * X O)^3%Z * (-2%Z * X O + X B)=0 \/ parallel A C B D. Proof. geo_begin. idtac "minh". Time nsatz with radicalmax :=1%N strategy:=1%Z parameters:=[X O; X B; X C] variables:= (@nil R). (*Finished transaction in 13. secs (10.102464u,0.s) *) Qed. Lemma Pappus: forall A B C A1 B1 C1 P Q S:point, X A = 0 -> Y A = 0 -> Y B = 0 -> Y C = 0 -> collinear A1 B1 C1 -> collinear A B1 P -> collinear A1 B P -> collinear A C1 Q -> collinear A1 C Q -> collinear B C1 S -> collinear B1 C S -> collinear P Q S \/ (Y A1 - Y B1)^2%Z=0 \/ (X A = X B1) \/ (X A1 = X C) \/ (X C = X B1) \/ parallel A B1 A1 B \/ parallel A C1 A1 C \/ parallel B C1 B1 C. 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] 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. Lemma Simson: forall A B C O D E F G:point, X A = 0 -> Y A = 0 -> equaldistance O A O B -> equaldistance O A O C -> equaldistance O A O D -> orthogonal E D B C -> collinear B C E -> orthogonal F D A C -> collinear A C F -> orthogonal G D A B -> collinear A B G -> collinear E F G \/ (X C)^2%Z = 0 \/ (Y C)^2%Z = 0 \/ (X B)^2%Z = 0 \/ (Y B)^2%Z = 0 \/ (Y C - Y B)^2%Z = 0 \/ equal3 B A \/ equal3 A C \/ (X C - X B)^2%Z = 0 \/ equal3 B C. 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] variables:= (@nil R). (* compute -[X Y]. *) (*Finished transaction in 8. secs (7.550852u,0.s) *) Qed. Lemma threepoints: forall A B C A1 B1 A2 B2 H1 H2 H3:point, (* H1 intersection of bisections *) middle B C A1 -> orthogonal H1 A1 B C -> middle A C B1 -> orthogonal H1 B1 A C -> (* H2 intersection of medians *) collinear A A1 H2 -> collinear B B1 H2 -> (* H3 intersection of altitudes *) collinear B C A2 -> orthogonal A A2 B C -> collinear A C B2 -> orthogonal B B2 A C -> collinear A A1 H3 -> collinear B B1 H3 -> collinear H1 H2 H3 \/ collinear A B C. Proof. geo_begin. idtac "threepoints". Time nsatz. (*Finished transaction in 7. secs (6.282045u,0.s) *) Qed. Lemma Feuerbach: forall A B C A1 B1 C1 O A2 B2 C2 O2:point, forall r r2:R, X A = 0 -> Y A = 0 -> X B = 1 -> Y B = 0-> middle A B C1 -> middle B C A1 -> middle C A B1 -> distance2 O A1 = distance2 O B1 -> distance2 O A1 = distance2 O C1 -> collinear A B C2 -> orthogonal A B O2 C2 -> collinear B C A2 -> orthogonal B C O2 A2 -> collinear A C B2 -> orthogonal A C O2 B2 -> distance2 O2 A2 = distance2 O2 B2 -> distance2 O2 A2 = distance2 O2 C2 -> r^2%Z = distance2 O A1 -> r2^2%Z = distance2 O2 A2 -> distance2 O O2 = (r + r2)^2%Z \/ distance2 O O2 = (r - r2)^2%Z \/ collinear A B C. Proof. geo_begin. idtac "Feuerbach". Time nsatz. (*Finished transaction in 21. secs (19.021109u,0.s)*) Qed. Lemma Euler_circle: forall A B C A1 B1 C1 A2 B2 C2 O:point, middle A B C1 -> middle B C A1 -> middle C A B1 -> orthogonal A B C C2 -> collinear A B C2 -> orthogonal B C A A2 -> collinear B C A2 -> orthogonal A C B B2 -> collinear A C B2 -> distance2 O A1 = distance2 O B1 -> distance2 O A1 = distance2 O C1 -> (distance2 O A2 = distance2 O A1 /\distance2 O B2 = distance2 O A1 /\distance2 O C2 = distance2 O A1) \/ collinear A B C. Proof. geo_begin. idtac "Euler_circle 3 goals". Time nsatz. (*Finished transaction in 13. secs (11.208296u,0.124981s)*) Time nsatz. (*Finished transaction in 10. secs (8.846655u,0.s)*) Time nsatz. (*Finished transaction in 11. secs (9.186603u,0.s)*) Qed. Lemma Desargues: forall A B C A1 B1 C1 P Q T S:point, X S = 0 -> Y S = 0 -> Y A = 0 -> collinear A S A1 -> collinear B S B1 -> collinear C S C1 -> collinear B1 C1 P -> collinear B C P -> collinear A1 C1 Q -> collinear A C Q -> collinear A1 B1 T -> collinear A B T -> collinear P Q T \/ X A = X B \/ X A = X C \/ X B = X C \/ X A = 0 \/ Y B = 0 \/ Y C = 0 \/ collinear S B C \/ parallel A C A1 C1 \/ parallel A B A1 B1. 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] 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] variables:= lv. (*Finished transaction in 8. secs (8.02578u,0.001s)*) Qed. Lemma chords: forall O A B C D M:point, equaldistance O A O B -> equaldistance O A O C -> equaldistance O A O D -> collinear A B M -> collinear C D M -> scalarproduct A M B = scalarproduct C M D \/ parallel A B C D. Proof. geo_begin. idtac "chords". Time nsatz. (*Finished transaction in 4. secs (3.959398u,0.s)*) Qed. Lemma Ceva: forall A B C D E F M:point, collinear M A D -> collinear M B E -> collinear M C F -> collinear B C D -> collinear E A C -> collinear F A B -> (distance2 D B) * (distance2 E C) * (distance2 F A) = (distance2 D C) * (distance2 E A) * (distance2 F B) \/ collinear A B C. Proof. geo_begin. idtac "Ceva". Time nsatz. (*Finished transaction in 105. secs (104.121171u,0.474928s)*) Qed. Lemma bissectrices: forall A B C M:point, equaltangente C A M M A B -> equaltangente A B M M B C -> equaltangente B C M M C A \/ equal3 A B. Proof. geo_begin. idtac "bissectrices". Time nsatz. (*Finished transaction in 2. secs (1.937705u,0.s)*) Qed. Lemma bisections: forall A B C A1 B1 C1 H:point, middle B C A1 -> orthogonal H A1 B C -> middle A C B1 -> orthogonal H B1 A C -> middle A B C1 -> orthogonal H C1 A B \/ collinear A B C. Proof. geo_begin. idtac "bisections". Time nsatz. (*Finished transaction in 2. secs (2.024692u,0.002s)*) Qed. Lemma altitudes: forall A B C A1 B1 C1 H:point, collinear B C A1 -> orthogonal A A1 B C -> collinear A C B1 -> orthogonal B B1 A C -> collinear A B C1 -> orthogonal C C1 A B -> collinear A A1 H -> collinear B B1 H -> collinear C C1 H \/ equal2 A B \/ collinear A B C. Proof. geo_begin. idtac "altitudes". Time nsatz. (*Finished transaction in 3. secs (3.001544u,0.s)*) Time nsatz. (*Finished transaction in 4. secs (3.113527u,0.s)*) Qed. Lemma hauteurs:forall A B C A1 B1 C1 H:point, collinear B C A1 -> orthogonal A A1 B C -> collinear A C B1 -> orthogonal B B1 A C -> collinear A B C1 -> orthogonal C C1 A B -> collinear A A1 H -> collinear B B1 H -> collinear C C1 H \/ collinear A B C. 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]) in nsatz with radicalmax := 2%N strategy := 1%Z parameters := (@Datatypes.nil R) variables := lv. (*Finished transaction in 5. secs (4.360337u,0.008999s)*) Qed. End Geometry. coq-8.20.0/test-suite/success/NumberNotationsNoLocal.v000066400000000000000000000006421466560755400227530ustar00rootroot00000000000000(* Test that number notations don't work on proof-local variables, especially not ones containing evars *) Inductive unit11 := tt11. Declare Scope unit11_scope. Delimit Scope unit11_scope with unit11. Goal True. evar (to_uint : unit11 -> Decimal.uint). evar (of_uint : Decimal.uint -> unit11). Fail Number Notation unit11 of_uint to_uint : uint11_scope. exact I. Unshelve. all: solve [ constructor ]. Qed. coq-8.20.0/test-suite/success/NumberScopes.v000066400000000000000000000016311466560755400207600ustar00rootroot00000000000000 (* We check that various definitions or lemmas have the correct argument scopes, especially the ones created via functor application. *) Close Scope nat_scope. Require Import PArith. Check (Pos.add 1 2). Check (Pos.add_comm 1 2). Check (Pos.min_comm 1 2). Definition f_pos (x:positive) := x. Definition f_pos' (x:Pos.t) := x. Check (f_pos 1). Check (f_pos' 1). Require Import ZArith. Check (Z.add 1 2). Check (Z.add_comm 1 2). Check (Z.min_comm 1 2). Definition f_Z (x:Z) := x. Definition f_Z' (x:Z.t) := x. Check (f_Z 1). Check (f_Z' 1). Require Import NArith. Check (N.add 1 2). Check (N.add_comm 1 2). Check (N.min_comm 1 2). Definition f_N (x:N) := x. Definition f_N' (x:N.t) := x. Check (f_N 1). Check (f_N' 1). Require Import Arith. Check (Nat.add 1 2). Check (Nat.add_comm 1 2). Check (Nat.min_comm 1 2). Definition f_nat (x:nat) := x. Definition f_nat' (x:Nat.t) := x. Check (f_nat 1). Check (f_nat' 1). coq-8.20.0/test-suite/success/Omega.v000066400000000000000000000041641466560755400174070ustar00rootroot00000000000000Require Import Lia ZArith. (* Submitted by Xavier Urbain 18 Jan 2002 *) Lemma lem1 : forall x y : Z, (-5 < x < 5)%Z -> (-5 < y)%Z -> (-5 < x + y + 5)%Z. Proof. intros x y. lia. Qed. (* Proposed by Pierre Crégut *) Lemma lem2 : forall x : Z, (x < 4)%Z -> (x > 2)%Z -> x = 3%Z. intro. lia. Qed. (* Proposed by Jean-Christophe Filliâtre *) Lemma lem3 : forall x y : Z, x = y -> (x + x)%Z = (y + y)%Z. Proof. intros. lia. Qed. (* Proposed by Jean-Christophe Filliâtre: confusion between an Omega *) (* internal variable and a section variable (June 2001) *) Section A. Variable x y : Z. Hypothesis H : (x > y)%Z. Lemma lem4 : (x > y)%Z. lia. Qed. End A. (* Proposed by Yves Bertot: because a section var, L was wrongly renamed L0 *) (* May 2002 *) Section B. Variable R1 R2 S1 S2 H S : Z. Hypothesis I : (R1 < 0)%Z -> R2 = (R1 + (2 * S1 - 1))%Z. Hypothesis J : (R1 < 0)%Z -> S2 = (S1 - 1)%Z. Hypothesis K : (R1 >= 0)%Z -> R2 = R1. Hypothesis L : (R1 >= 0)%Z -> S2 = S1. Hypothesis M : (H <= 2 * S)%Z. Hypothesis N : (S < H)%Z. Lemma lem5 : (H > 0)%Z. lia. Qed. End B. (* From Nicolas Oury (BZ#180): handling -> on Set (fixed Oct 2002) *) Lemma lem6 : forall (A : Set) (i : Z), (i <= 0)%Z -> ((i <= 0)%Z -> A) -> (i <= 0)%Z. intros. lia. Qed. (* Adapted from an example in Nijmegen/FTA/ftc/RefSeparating (Oct 2002) *) Require Import Lia. Section C. Parameter g : forall m : nat, m <> 0 -> Prop. Parameter f : forall (m : nat) (H : m <> 0), g m H. Variable n : nat. Variable ap_n : n <> 0. Let delta := f n ap_n. Lemma lem7 : n = n. lia. Qed. End C. (* Problem of dependencies *) Require Import Lia. Lemma lem8 : forall H : 0 = 0 -> 0 = 0, H = H -> 0 = 0. intros; lia. Qed. (* Bug that what caused by the use of intro_using in Omega *) Require Import Lia. Lemma lem9 : forall p q : nat, ~ (p <= q /\ p < q \/ q <= p /\ p < q) -> p < p \/ p <= p. intros; lia. Qed. (* Check that the interpretation of mult on nat enforces its positivity *) (* Submitted by Hubert Thierry (BZ#743) *) (* Postponed... problem with goals of the form "(n*m=0)%nat -> (n*m=0)%Z" *) Lemma lem10 : forall n m:nat, le n (plus n (mult n m)). Proof. intros; lia. Qed. coq-8.20.0/test-suite/success/Omega0.v000066400000000000000000000045331466560755400174670ustar00rootroot00000000000000Require Import ZArith Lia. Open Scope Z_scope. (* Pierre L: examples gathered while debugging romega. *) Lemma test_romega_0 : forall m m', 0<= m <= 1 -> 0<= m' <= 1 -> (0 < m <-> 0 < m') -> m = m'. Proof. intros. lia. Qed. Lemma test_romega_0b : forall m m', 0<= m <= 1 -> 0<= m' <= 1 -> (0 < m <-> 0 < m') -> m = m'. Proof. intros m m'. lia. Qed. Lemma test_romega_1 : forall (z z1 z2 : Z), z2 <= z1 -> z1 <= z2 -> z1 >= 0 -> z2 >= 0 -> z1 >= z2 /\ z = z1 \/ z1 <= z2 /\ z = z2 -> z >= 0. Proof. intros. lia. Qed. Lemma test_romega_1b : forall (z z1 z2 : Z), z2 <= z1 -> z1 <= z2 -> z1 >= 0 -> z2 >= 0 -> z1 >= z2 /\ z = z1 \/ z1 <= z2 /\ z = z2 -> z >= 0. Proof. intros z z1 z2. lia. Qed. Lemma test_romega_2 : forall a b c:Z, 0<=a-b<=1 -> b-c<=2 -> a-c<=3. Proof. intros. lia. Qed. Lemma test_romega_2b : forall a b c:Z, 0<=a-b<=1 -> b-c<=2 -> a-c<=3. Proof. intros a b c. lia. Qed. Lemma test_romega_3 : forall a b h hl hr ha hb, 0 <= ha - hl <= 1 -> -2 <= hl - hr <= 2 -> h =b+1 -> (ha >= hr /\ a = ha \/ ha <= hr /\ a = hr) -> (hl >= hr /\ b = hl \/ hl <= hr /\ b = hr) -> (-3 <= ha -hr <=3 -> 0 <= hb - a <= 1) -> (-2 <= ha-hr <=2 -> hb = a + 1) -> 0 <= hb - h <= 1. Proof. intros. lia. Qed. Lemma test_romega_3b : forall a b h hl hr ha hb, 0 <= ha - hl <= 1 -> -2 <= hl - hr <= 2 -> h =b+1 -> (ha >= hr /\ a = ha \/ ha <= hr /\ a = hr) -> (hl >= hr /\ b = hl \/ hl <= hr /\ b = hr) -> (-3 <= ha -hr <=3 -> 0 <= hb - a <= 1) -> (-2 <= ha-hr <=2 -> hb = a + 1) -> 0 <= hb - h <= 1. Proof. intros a b h hl hr ha hb. lia. Qed. Lemma test_romega_4 : forall hr ha, ha = 0 -> (ha = 0 -> hr =0) -> hr = 0. Proof. intros hr ha. lia. Qed. Lemma test_romega_5 : forall hr ha, ha = 0 -> (~ha = 0 \/ hr =0) -> hr = 0. Proof. intros hr ha. lia. Qed. Lemma test_romega_6 : forall z, z>=0 -> 0>z+2 -> False. Proof. intros. lia. Qed. Lemma test_romega_6b : forall z, z>=0 -> 0>z+2 -> False. Proof. intros z. lia. Qed. Lemma test_romega_7 : forall z, 0>=0 /\ z=0 \/ 0<=0 /\ z =0 -> 1 = z+1. Proof. intros. lia. Qed. Lemma test_romega_7b : forall z, 0>=0 /\ z=0 \/ 0<=0 /\ z =0 -> 1 = z+1. Proof. intros. lia. Qed. (* Magaud BZ#240 *) Lemma test_romega_8 : forall x y:Z, x*x ~ y*y <= x*x. intros. lia. Qed. Lemma test_romega_8b : forall x y:Z, x*x ~ y*y <= x*x. intros x y. lia. Qed. coq-8.20.0/test-suite/success/Omega2.v000066400000000000000000000013711466560755400174660ustar00rootroot00000000000000Require Import ZArith Lia. (* Submitted by Yegor Bryukhov (BZ#922) *) Open Scope Z_scope. Lemma Test46 : forall v1 v2 v3 v4 v5 : Z, ((2 * v4) + (5)) + (8 * v2) <= ((4 * v4) + (3 * v4)) + (5 * v4) -> 9 * v4 > (1 * v4) + ((2 * v1) + (0 * v2)) -> ((9 * v3) + (2 * v5)) + (5 * v2) = 3 * v4 -> 0 > 6 * v1 -> (0 * v3) + (6 * v2) <> 2 -> (0 * v3) + (5 * v5) <> ((4 * v2) + (8 * v2)) + (2 * v5) -> 7 * v3 > 5 * v5 -> 0 * v4 >= ((5 * v1) + (4 * v1)) + ((6 * v5) + (3 * v5)) -> 7 * v2 = ((3 * v2) + (6 * v5)) + (7 * v2) -> 0 * v3 > 7 * v1 -> 9 * v2 < 9 * v5 -> (2 * v3) + (8 * v1) <= 5 * v4 -> 5 * v2 = ((5 * v1) + (0 * v5)) + (1 * v2) -> 0 * v5 <= 9 * v2 -> ((7 * v1) + (1 * v3)) + ((2 * v3) + (1 * v3)) >= ((6 * v5) + (4)) + ((1) + (9)) -> False. intros. lia. Qed. coq-8.20.0/test-suite/success/OmegaPre.v000066400000000000000000000036531466560755400200600ustar00rootroot00000000000000Require Import ZArith Nnat Lia. Open Scope Z_scope. (** Test of the zify preprocessor for (R)Omega *) (* More details in file PreOmega.v (r)omega with Z : starts with zify_op (r)omega with nat : starts with zify_nat (r)omega with positive : starts with zify_positive (r)omega with N : starts with uses zify_N (r)omega with * : starts zify (a saturation of the others) *) (* zify_op *) Goal forall a:Z, Z.max a a = a. intros. lia. Qed. Goal forall a b:Z, Z.max a b = Z.max b a. intros. lia. Qed. Goal forall a b c:Z, Z.max a (Z.max b c) = Z.max (Z.max a b) c. intros. lia. Qed. Goal forall a b:Z, Z.max a b + Z.min a b = a + b. intros. lia. Qed. Goal forall a:Z, (Z.abs a)*(Z.sgn a) = a. intros. intuition; subst; lia. Qed. Goal forall a:Z, Z.abs a = a -> a >= 0. intros. lia. Qed. Goal forall a:Z, Z.sgn a = a -> a = 1 \/ a = 0 \/ a = -1. intros. lia. Qed. (* zify_nat *) Goal forall m: nat, (m<2)%nat -> (0<= m+m <=2)%nat. intros. lia. Qed. Goal forall m:nat, (m<1)%nat -> (m=0)%nat. intros. lia. Qed. Goal forall m: nat, (m<=100)%nat -> (0<= m+m <=200)%nat. intros. lia. Qed. (* 2000 instead of 200: works, but quite slow *) Goal forall m: nat, (m*m>=0)%nat. intros. lia. Qed. (* zify_positive *) Goal forall m: positive, (m<2)%positive -> (2 <= m+m /\ m+m <= 2)%positive. intros. lia. Qed. Goal forall m:positive, (m<2)%positive -> (m=1)%positive. intros. lia. Qed. Goal forall m: positive, (m<=1000)%positive -> (2<=m+m/\m+m <=2000)%positive. intros. lia. Qed. Goal forall m: positive, (m*m>=1)%positive. intros. lia. Qed. (* zify_N *) Goal forall m:N, (m<2)%N -> (0 <= m+m /\ m+m <= 2)%N. intros. lia. Qed. Goal forall m:N, (m<1)%N -> (m=0)%N. intros. lia. Qed. Goal forall m:N, (m<=1000)%N -> (0<=m+m/\m+m <=2000)%N. intros. lia. Qed. Goal forall m:N, (m*m>=0)%N. intros. lia. Qed. (* mix of datatypes *) Goal forall p, Z.of_N (N.of_nat (N.to_nat (Npos p))) = Zpos p. intros. lia. Qed. coq-8.20.0/test-suite/success/PCase.v000066400000000000000000000027531466560755400173540ustar00rootroot00000000000000 (** Some tests of patterns containing matchs ending with joker branches. Cf. the new form of the [constr_pattern] constructor [PCase] in [pretyping/pattern.ml] *) (* A universal match matcher *) Ltac kill_match := match goal with |- context [ match ?x with _ => _ end ] => destruct x end. (* A match matcher restricted to a given type : nat *) Ltac kill_match_nat := match goal with |- context [ match ?x in nat with _ => _ end ] => destruct x end. (* Another way to restrict to a given type : give a branch *) Ltac kill_match_nat2 := match goal with |- context [ match ?x with S _ => _ | _ => _ end ] => destruct x end. (* This should act only on empty match *) Ltac kill_match_empty := match goal with |- context [ match ?x with end ] => destruct x end. Lemma test1 (b:bool) : if b then True else O=O. Proof. Fail kill_match_nat. Fail kill_match_nat2. Fail kill_match_empty. kill_match. exact I. exact eq_refl. Qed. Lemma test2a (n:nat) : match n with O => True | S n => (n = n) end. Proof. Fail kill_match_empty. kill_match_nat. exact I. exact eq_refl. Qed. Lemma test2b (n:nat) : match n with O => True | S n => (n = n) end. Proof. kill_match_nat2. exact I. exact eq_refl. Qed. Lemma test2c (n:nat) : match n with O => True | S n => (n = n) end. Proof. kill_match. exact I. exact eq_refl. Qed. Lemma test3a (f:False) : match f return Prop with end. Proof. kill_match_empty. Qed. Lemma test3b (f:False) : match f return Prop with end. Proof. kill_match. Qed. coq-8.20.0/test-suite/success/PPFix.v000066400000000000000000000003571466560755400173450ustar00rootroot00000000000000 (* To test PP of fixpoints *) Require Import PeanoNat. Check fix a(n: nat): n<5 -> nat := match n return n<5 -> nat with | 0 => fun _ => 0 | S n => fun h => S (a n (proj2 (Nat.succ_lt_mono _ _) (Nat.lt_lt_succ_r _ _ h))) end. coq-8.20.0/test-suite/success/PartialImport.v000066400000000000000000000040321466560755400211400ustar00rootroot00000000000000Module M. Definition a := 0. Definition b := 1. Module N. Notation c := (a + b). End N. Inductive even : nat -> Prop := | even_0 : even 0 | even_S n : odd n -> even (S n) with odd : nat -> Set := odd_S n : even n -> odd (S n). End M. Module Simple. Import M(a). Check a. Fail Check b. Fail Check N.c. (* todo output test: this prints a+M.b since the notation isn't imported *) Check M.N.c. Fail Import M(c). Fail Import M(M.b). Import M(N.c). Check N.c. (* interestingly prints N.c (also does with unfiltered Import M) *) Import M(even(..)). Check even. Check even_0. Check even_S. Check even_sind. Check even_ind. Fail Check even_rect. (* doesn't exist *) Fail Check odd. Check M.odd. Fail Check odd_S. Fail Check odd_sind. End Simple. Module WithExport. Module X. Export M(a, N.c). End X. Import X. Check a. Check N.c. (* also prints N.c *) Fail Check b. End WithExport. Module IgnoreLocals. Module X. Local Definition x := 0. Definition y := 1. End X. Set Warnings "+not-importable". Fail Import X(x,y). Set Warnings "-not-importable". Import X(x,y). Check y. Fail Check x. Check X.x. End IgnoreLocals. Module FancyFunctor. (* A fancy behaviour with functors, not sure if we want to keep it but at least the test will ensure changes are deliberate. *) Module Type T. Parameter x : nat. End T. Module X. Definition x := 0. Definition y := 1. End X. Module Y. Local Definition x := 2. End Y. Module F(A:T). Export A(x). End F. Module Import M := F X. Check x. Fail Check y. Module N := F Y. Set Warnings "+not-importable". Fail Import N. Set Warnings "-not-importable". Import N. Check eq_refl : x = 0. End FancyFunctor. Require Import Sumbool(sumbool_of_bool). Check sumbool_of_bool. Check Sumbool.bool_eq_rec. Fail Check bool_eq_rec. Fail Require Sumbool(sumbool_of_bool). Fail Require Import Sumbool(not_a_real_definition). Fail Require Import(notations) Sumbool(sumbool_of_bool). coq-8.20.0/test-suite/success/PatternsInBinders.v000066400000000000000000000026221466560755400217520ustar00rootroot00000000000000(** The purpose of this file is to test functional properties of the destructive patterns used in binders ([fun] and [forall]). *) Definition swap {A B} '((x,y) : A*B) := (y,x). (** Tests the use of patterns in [fun] and [Definition] *) Section TestFun. Variables A B : Type. Goal forall (x:A) (y:B), swap (x,y) = (y,x). Proof. reflexivity. Qed. Goal forall u:A*B, swap (swap u) = u. Proof. destruct u. reflexivity. Qed. Goal @swap A B = fun '(x,y) => (y,x). Proof. reflexivity. Qed. End TestFun. (** Tests the use of patterns in [forall] *) Section TestForall. Variables A B : Type. Goal forall '((x,y) : A*B), swap (x,y) = (y,x). Proof. intros [x y]. reflexivity. Qed. Goal forall x0:A, exists '((x,y) : A*A), swap (x,y) = (x,y). Proof. intros x0. exists (x0,x0). reflexivity. Qed. End TestForall. (** Tests the use of patterns in dependent definitions. *) Section TestDependent. Inductive Fin (n:nat) := Z : Fin n. Definition F '(n,p) : Type := (Fin n * Fin p)%type. Definition both_z '(n,p) : F (n,p) := (Z _,Z _). End TestDependent. (** Tests with a few other types just to make sure parsing is robust. *) Section TestExtra. Definition proj_informative {A P} '(exist _ x _ : { x:A | P x }) : A := x. Inductive Foo := Bar : nat -> bool -> unit -> nat -> Foo. Definition foo '(Bar n b tt p) := if b then n+p else n-p. End TestExtra. coq-8.20.0/test-suite/success/Print.v000066400000000000000000000004411466560755400174450ustar00rootroot00000000000000Print Tables. Print ML Path. Print ML Modules. Print LoadPath. Print Graph. Print Coercions. Print Classes. Print nat. Print Term O. Print All. Print Grammar constr. Inspect 10. Section A. Coercion f (x : nat) : Prop := True. Print Coercion Paths nat Sortclass. Print Section A. End A. coq-8.20.0/test-suite/success/PrintSortedUniverses.v000066400000000000000000000000471466560755400225340ustar00rootroot00000000000000Require Reals. Print Sorted Universes. coq-8.20.0/test-suite/success/PrivateInd.v000066400000000000000000000014131466560755400204160ustar00rootroot00000000000000 Module M. Private Inductive foo := . Definition bar (A:Prop) (_:A=True) (x:foo) : A := match x with end. End M. Goal M.foo -> False. Proof. Fail let c := eval cbv in c in match c with context c [True] => (* ltac context instantiation calls Typing *) let c := context c [False] in exact c end. let c := open_constr:(M.bar False (ltac:(exact_no_check (eq_refl True)))) in let c := eval cbv in c in exact c. (* check no goals remain *) Unshelve. all:fail. Fail Qed. Abort. Fail Definition bar := Eval cbv in M.bar. Module N. Private Inductive foo := C : nat -> nat -> foo. Definition use x := match x with C a b => a + b end. End N. Definition five := N.C 2 3. Definition five' := Eval cbv in N.use five. Check eq_refl : five' = 5. coq-8.20.0/test-suite/success/ProgramCases.v000066400000000000000000000021271466560755400207420ustar00rootroot00000000000000Require Import Vector Program. Module T. Inductive T A B : forall n, t A n -> Type := cons n m p c d e : A -> B -> T A B n c -> T A B m d -> T A B p e. Program Definition h {A B : Type} {n1 n2 : nat} (v1 : t A n1) (v2 : t A n2) (p1 : T A B n1 v1) (p2 : T A B n2 v2) : nat := match p1, p2 with | cons _ _ i1 j1 k1 c1 d1 e1 a1 b1 q1 r1, cons _ _ i2 j2 k2 c2 d2 e2 a2 b2 q2 r2 => 0 end. Program Definition h2 {A B : Type} b {n1 n2 : nat} (v1 : t A n1) (v2 : t A n2) (p1 : T A B n1 v1) (p2 : T A B n2 v2) : nat := match b, p1, p2 with | true, cons _ _ i1 j1 k1 c1 d1 e1 a1 b1 q1 r1, _ => 0 | false, _, cons _ _ i2 j2 k2 c2 d2 e2 a2 b2 q2 r2 => 0 end. End T. Module U. Inductive U A B : forall n, t A n -> Type := | cons n m p c d e : A -> B -> U A B n c -> U A B m d -> U A B p e | nil n c : U A B n c. Program Definition h {A B : Type} {n1 n2 : nat} (v1 : t A n1) (v2 : t A n2) (p1 : U A B n1 v1) (p2 : U A B n2 v2) : nat := match p1, p2 with | cons _ _ i1 j1 k1 c1 d1 e1 a1 b1 q1 r1, _ => 0 | _, cons _ _ i2 j2 k2 c2 d2 e2 a2 b2 q2 r2 => 0 | _, _ => 0 end. End U. coq-8.20.0/test-suite/success/ProgramWf.v000066400000000000000000000060131466560755400202560ustar00rootroot00000000000000(* Before loading Program, check non-anomaly on missing library Program *) Fail Program Definition f n (e:n=n): {n|n=0} := match n,e with 0, refl => 0 | _, _ => 0 end. (* Then we test Program properly speaking *) Require Import Arith Program. Require Import ZArith Zwf. Set Implicit Arguments. (* Set Printing All. *) Print sigT_rect. Obligation Tactic := program_simplify ; auto with *. About MR. Program Fixpoint merge (n m : nat) {measure (n + m) lt} : nat := match n with | 0 => 0 | S n' => merge n' m end. Print merge. Print Z.lt. Print Zwf. Local Open Scope Z_scope. Program Fixpoint Zwfrec (n m : Z) {measure (n + m) (Zwf 0)} : Z := match n ?= m with | Lt => Zwfrec n (Z.pred m) | _ => 0 end. Next Obligation. red. Admitted. Close Scope Z_scope. Program Fixpoint merge_wf (n m : nat) {wf lt m} : nat := match n with | 0 => 0 | S n' => merge n' m end. Print merge_wf. Program Fixpoint merge_one (n : nat) {measure n} : nat := match n with | 0 => 0 | S n' => merge_one n' end. Print Hint well_founded. Print merge_one. Eval cbv delta [merge_one] beta zeta in merge_one. Import WfExtensionality. Lemma merge_unfold n m : merge n m = match n with | 0 => 0 | S n' => merge n' m end. Proof. intros. unfold merge at 1. unfold merge_func. unfold_sub merge (merge n m). simpl. destruct n ; reflexivity. Qed. Print merge. Require Import Arith. Unset Implicit Arguments. Time Program Fixpoint check_n (n : nat) (P : { i | i < n } -> bool) (p : nat) (H : forall (i : { i | i < n }), i < p -> P i = true) {measure (n - p)} : Exc (forall (p : { i | i < n}), P p = true) := match le_lt_dec n p with | left _ => value _ | right cmp => if dec (P p) then check_n n P (S p) _ else error end. Require Import Lia Setoid. Next Obligation. intros ; simpl in *. apply H. simpl in * ; lia. Qed. Next Obligation. simpl in *; intros. revert e ; clear_subset_proofs. intros. case (le_gt_dec p i) ; intro. simpl in *. assert(p = i) by lia. subst. revert e ; clear_subset_proofs ; tauto. apply H. simpl. lia. Qed. Program Fixpoint check_n' (n : nat) (m : {m:nat | m = n}) (p : nat) (q:{q : nat | q = p}) {measure (p - n)} : nat := _. Module FurtherArguments. Program Fixpoint zero (n : nat) {measure n} : nat -> nat := match n with | 0 => fun _ => 0 | S n' => zero n' end. Program Fixpoint f n {B} (b:B) {measure n} : forall {A}, A -> A * B := match n with | 0 => fun A a => (a, b) | S n => fun A a => f n b a end. End FurtherArguments. Module Notations. Reserved Notation "[ x ]". Program Fixpoint zero (n : nat) {measure n} : nat -> nat := match n with | 0 => fun _ => 0 | S n' => [ n' ] end where "[ n ]" := (zero n). Check eq_refl : ([ 0 ] 0) = 0. Reserved Notation "[[ x | y ]]". Program Fixpoint zero' (n : nat) {measure n} : nat -> nat := match n with | 0 => fun _ => 0 | S n' => fun a => [[ n' | a ]] end where "[[ n | p ]]" := (zero' n p). Check eq_refl : [[ 0 | 0 ]] = 0. End Notations. coq-8.20.0/test-suite/success/Projection.v000066400000000000000000000023761466560755400204760ustar00rootroot00000000000000Record foo (A : Type) := { B :> Type }. Lemma bar (f : foo nat) (x : f) : x = x. destruct f. simpl B. simpl B in x. Abort. Structure S : Type := {Dom : Type; Op : Dom -> Dom -> Dom}. Check (fun s : S => Dom s). Check (fun s : S => Op s). Check (fun (s : S) (a b : Dom s) => Op s a b). (* v8 Check fun s:S => s.(Dom). Check fun s:S => s.(Op). Check fun (s:S) (a b:s.(Dom)) => s.(Op) a b. *) Set Implicit Arguments. Unset Strict Implicit. Unset Strict Implicit. Structure S' (A : Set) : Type := {Dom' : Type; Op' : A -> Dom' -> Dom'}. Check (fun s : S' nat => Dom' s). Check (fun s : S' nat => Op' (s:=s)). Check (fun s : S' nat => Op' (A:=nat) (s:=s)). Check (fun (s : S' nat) (a : nat) (b : Dom' s) => Op' a b). Check (fun (s : S' nat) (a : nat) (b : Dom' s) => Op' (A:=nat) (s:=s) a b). (* v8 Check fun s:S' => s.(Dom'). Check fun s:S' => s.(Op'). Check fun (s:S') (a b:s.(Dom')) => _.(Op') a b. Check fun (s:S') (a b:s.(Dom')) => s.(Op') a b. Set Implicit Arguments. Unset Strict Implicits. Structure S' (A:Set) : Type := {Dom' : Type; Op' : A -> Dom' -> Dom'}. Check fun s:S' nat => s.(Dom'). Check fun s:S' nat => s.(Op'). Check fun (s:S' nat) (a:nat) (b:s.(Dom')) => _.(@Op' nat) a b. Check fun (s:S' nat) (a:nat) (b:s.(Dom')) => s.(Op') a b. *) coq-8.20.0/test-suite/success/ROmega.v000066400000000000000000000043441466560755400175310ustar00rootroot00000000000000(* This file used to test the `romega` tactics. In Coq 8.9 (end of 2018), these tactics are deprecated. The tests in this file remain but now call the `lia` tactic. *) Require Import ZArith Lia. (* Submitted by Xavier Urbain 18 Jan 2002 *) Lemma lem1 : forall x y : Z, (-5 < x < 5)%Z -> (-5 < y)%Z -> (-5 < x + y + 5)%Z. Proof. intros x y. lia. Qed. (* Proposed by Pierre Crégut *) Lemma lem2 : forall x : Z, (x < 4)%Z -> (x > 2)%Z -> x = 3%Z. intro. lia. Qed. (* Proposed by Jean-Christophe Filliâtre *) Lemma lem3 : forall x y : Z, x = y -> (x + x)%Z = (y + y)%Z. Proof. intros. lia. Qed. (* Proposed by Jean-Christophe Filliâtre: confusion between an Omega *) (* internal variable and a section variable (June 2001) *) Section A. Variable x y : Z. Hypothesis H : (x > y)%Z. Lemma lem4 : (x > y)%Z. lia. Qed. End A. (* Proposed by Yves Bertot: because a section var, L was wrongly renamed L0 *) (* May 2002 *) Section B. Variable R1 R2 S1 S2 H S : Z. Hypothesis I : (R1 < 0)%Z -> R2 = (R1 + (2 * S1 - 1))%Z. Hypothesis J : (R1 < 0)%Z -> S2 = (S1 - 1)%Z. Hypothesis K : (R1 >= 0)%Z -> R2 = R1. Hypothesis L : (R1 >= 0)%Z -> S2 = S1. Hypothesis M : (H <= 2 * S)%Z. Hypothesis N : (S < H)%Z. Lemma lem5 : (H > 0)%Z. lia. Qed. End B. (* From Nicolas Oury (BZ#180): handling -> on Set (fixed Oct 2002) *) Lemma lem6 : forall (A : Set) (i : Z), (i <= 0)%Z -> ((i <= 0)%Z -> A) -> (i <= 0)%Z. intros. lia. Qed. (* Adapted from an example in Nijmegen/FTA/ftc/RefSeparating (Oct 2002) *) Section C. Parameter g : forall m : nat, m <> 0 -> Prop. Parameter f : forall (m : nat) (H : m <> 0), g m H. Variable n : nat. Variable ap_n : n <> 0. Let delta := f n ap_n. Lemma lem7 : n = n. lia. Qed. End C. (* Problem of dependencies *) Lemma lem8 : forall H : 0 = 0 -> 0 = 0, H = H -> 0 = 0. intros. lia. Qed. (* Bug that what caused by the use of intro_using in Omega *) Lemma lem9 : forall p q : nat, ~ (p <= q /\ p < q \/ q <= p /\ p < q) -> p < p \/ p <= p. intros. lia. Qed. (* Check that the interpretation of mult on nat enforces its positivity *) (* Submitted by Hubert Thierry (BZ#743) *) (* Postponed... problem with goals of the form "(n*m=0)%nat -> (n*m=0)%Z" *) Lemma lem10 : forall n m : nat, le n (plus n (mult n m)). Proof. intros; lia. Qed. coq-8.20.0/test-suite/success/ROmega0.v000066400000000000000000000053401466560755400176060ustar00rootroot00000000000000Require Import ZArith Lia. Open Scope Z_scope. (* Pierre L: examples gathered while debugging romega. *) (* Starting from Coq 8.9 (late 2018), `romega` tactics are deprecated. The tests in this file remain but now call the `lia` tactic. *) Lemma test_lia_0 : forall m m', 0<= m <= 1 -> 0<= m' <= 1 -> (0 < m <-> 0 < m') -> m = m'. Proof. intros. lia. Qed. Lemma test_lia_0b : forall m m', 0<= m <= 1 -> 0<= m' <= 1 -> (0 < m <-> 0 < m') -> m = m'. Proof. intros m m'. lia. Qed. Lemma test_lia_1 : forall (z z1 z2 : Z), z2 <= z1 -> z1 <= z2 -> z1 >= 0 -> z2 >= 0 -> z1 >= z2 /\ z = z1 \/ z1 <= z2 /\ z = z2 -> z >= 0. Proof. intros. lia. Qed. Lemma test_lia_1b : forall (z z1 z2 : Z), z2 <= z1 -> z1 <= z2 -> z1 >= 0 -> z2 >= 0 -> z1 >= z2 /\ z = z1 \/ z1 <= z2 /\ z = z2 -> z >= 0. Proof. intros z z1 z2. lia. Qed. Lemma test_lia_2 : forall a b c:Z, 0<=a-b<=1 -> b-c<=2 -> a-c<=3. Proof. intros. lia. Qed. Lemma test_lia_2b : forall a b c:Z, 0<=a-b<=1 -> b-c<=2 -> a-c<=3. Proof. intros a b c. lia. Qed. Lemma test_lia_3 : forall a b h hl hr ha hb, 0 <= ha - hl <= 1 -> -2 <= hl - hr <= 2 -> h =b+1 -> (ha >= hr /\ a = ha \/ ha <= hr /\ a = hr) -> (hl >= hr /\ b = hl \/ hl <= hr /\ b = hr) -> (-3 <= ha -hr <=3 -> 0 <= hb - a <= 1) -> (-2 <= ha-hr <=2 -> hb = a + 1) -> 0 <= hb - h <= 1. Proof. intros. lia. Qed. Lemma test_lia_3b : forall a b h hl hr ha hb, 0 <= ha - hl <= 1 -> -2 <= hl - hr <= 2 -> h =b+1 -> (ha >= hr /\ a = ha \/ ha <= hr /\ a = hr) -> (hl >= hr /\ b = hl \/ hl <= hr /\ b = hr) -> (-3 <= ha -hr <=3 -> 0 <= hb - a <= 1) -> (-2 <= ha-hr <=2 -> hb = a + 1) -> 0 <= hb - h <= 1. Proof. intros a b h hl hr ha hb. lia. Qed. Lemma test_lia_4 : forall hr ha, ha = 0 -> (ha = 0 -> hr =0) -> hr = 0. Proof. intros hr ha. lia. Qed. Lemma test_lia_5 : forall hr ha, ha = 0 -> (~ha = 0 \/ hr =0) -> hr = 0. Proof. intros hr ha. lia. Qed. Lemma test_lia_6 : forall z, z>=0 -> 0>z+2 -> False. Proof. intros. lia. Qed. Lemma test_lia_6b : forall z, z>=0 -> 0>z+2 -> False. Proof. intros z. lia. Qed. Lemma test_lia_7 : forall z, 0>=0 /\ z=0 \/ 0<=0 /\ z =0 -> 1 = z+1. Proof. intros. lia. Qed. Lemma test_lia_7b : forall z, 0>=0 /\ z=0 \/ 0<=0 /\ z =0 -> 1 = z+1. Proof. intros. lia. Qed. (* Magaud BZ#240 *) Lemma test_lia_8 : forall x y:Z, x*x ~ y*y <= x*x. Proof. intros. lia. Qed. Lemma test_lia_8b : forall x y:Z, x*x ~ y*y <= x*x. Proof. intros x y. lia. Qed. (* Besson BZ#1298 *) Lemma test_lia9 : forall z z':Z, z<>z' -> z'=z -> False. Proof. intros. lia. Qed. (* Letouzey, May 2017 *) Lemma test_lia10 : forall x a a' b b', a' <= b -> a <= b' -> b < b' -> a < a' -> a <= x < b' <-> a <= x < b \/ a' <= x < b'. Proof. intros. lia. Qed. coq-8.20.0/test-suite/success/ROmega2.v000066400000000000000000000021311466560755400176030ustar00rootroot00000000000000(* Starting from Coq 8.9 (late 2018), `romega` tactics are deprecated. The tests in this file remain but now call the `lia` tactic. *) Require Import ZArith Lia. (* Submitted by Yegor Bryukhov (BZ#922) *) Open Scope Z_scope. (* First a simplified version used during debug of romega on Test46 *) Lemma Test46_simplified : forall v1 v2 v5 : Z, 0 = v2 + v5 -> 0 < v5 -> 0 < v2 -> 4*v2 <> 5*v1. intros. lia. Qed. (* The complete problem *) Lemma Test46 : forall v1 v2 v3 v4 v5 : Z, ((2 * v4) + (5)) + (8 * v2) <= ((4 * v4) + (3 * v4)) + (5 * v4) -> 9 * v4 > (1 * v4) + ((2 * v1) + (0 * v2)) -> ((9 * v3) + (2 * v5)) + (5 * v2) = 3 * v4 -> 0 > 6 * v1 -> (0 * v3) + (6 * v2) <> 2 -> (0 * v3) + (5 * v5) <> ((4 * v2) + (8 * v2)) + (2 * v5) -> 7 * v3 > 5 * v5 -> 0 * v4 >= ((5 * v1) + (4 * v1)) + ((6 * v5) + (3 * v5)) -> 7 * v2 = ((3 * v2) + (6 * v5)) + (7 * v2) -> 0 * v3 > 7 * v1 -> 9 * v2 < 9 * v5 -> (2 * v3) + (8 * v1) <= 5 * v4 -> 5 * v2 = ((5 * v1) + (0 * v5)) + (1 * v2) -> 0 * v5 <= 9 * v2 -> ((7 * v1) + (1 * v3)) + ((2 * v3) + (1 * v3)) >= ((6 * v5) + (4)) + ((1) + (9)) -> False. intros. lia. Qed. coq-8.20.0/test-suite/success/ROmega4.v000066400000000000000000000007371466560755400176170ustar00rootroot00000000000000(** ROmega is now aware of the bodies of context variables (of type Z or nat). See also #148 for the corresponding improvement in Omega. *) Require Import ZArith Lia. Open Scope Z. Goal let x := 3 in x = 3. intros. lia. Qed. (** Example seen in #4132 (actually solvable even if b isn't known to be 5) *) Lemma foo (x y x' zxy zxy' z : Z) (b := 5) (Ry : - b <= y < b) (Bx : x' <= b) (H : - zxy' <= zxy) (H' : zxy' <= x') : - b <= zxy. Proof. lia. Qed. coq-8.20.0/test-suite/success/ROmegaPre.v000066400000000000000000000034441466560755400202000ustar00rootroot00000000000000Require Import ZArith Nnat Lia. Open Scope Z_scope. (** Test of the zify preprocessor for (R)Omega *) (* Starting from Coq 8.9 (late 2018), `romega` tactics are deprecated. The tests in this file remain but now call the `lia` tactic. *) (* More details in file PreOmega.v *) (* zify_op *) Goal forall a:Z, Z.max a a = a. intros. lia. Qed. Goal forall a b:Z, Z.max a b = Z.max b a. intros. lia. Qed. Goal forall a b c:Z, Z.max a (Z.max b c) = Z.max (Z.max a b) c. intros. lia. Qed. Goal forall a b:Z, Z.max a b + Z.min a b = a + b. intros. lia. Qed. Goal forall a:Z, (Z.abs a)*(Z.sgn a) = a. intros. intuition; subst; lia. Qed. Goal forall a:Z, Z.abs a = a -> a >= 0. intros. lia. Qed. Goal forall a:Z, Z.sgn a = a -> a = 1 \/ a = 0 \/ a = -1. intros. lia. Qed. (* zify_nat *) Goal forall m: nat, (m<2)%nat -> (0<= m+m <=2)%nat. intros. lia. Qed. Goal forall m:nat, (m<1)%nat -> (m=0)%nat. intros. lia. Qed. Goal forall m: nat, (m<=100)%nat -> (0<= m+m <=200)%nat. intros. lia. Qed. (* 2000 instead of 200: works, but quite slow *) Goal forall m: nat, (m*m>=0)%nat. intros. lia. Qed. (* zify_positive *) Goal forall m: positive, (m<2)%positive -> (2 <= m+m /\ m+m <= 2)%positive. intros. lia. Qed. Goal forall m:positive, (m<2)%positive -> (m=1)%positive. intros. lia. Qed. Goal forall m: positive, (m<=1000)%positive -> (2<=m+m/\m+m <=2000)%positive. intros. lia. Qed. Goal forall m: positive, (m*m>=1)%positive. intros. lia. Qed. (* zify_N *) Goal forall m:N, (m<2)%N -> (0 <= m+m /\ m+m <= 2)%N. intros. lia. Qed. Goal forall m:N, (m<1)%N -> (m=0)%N. intros. lia. Qed. Goal forall m:N, (m<=1000)%N -> (0<=m+m/\m+m <=2000)%N. intros. lia. Qed. Goal forall m:N, (m*m>=0)%N. intros. lia. Qed. (* mix of datatypes *) Goal forall p, Z.of_N (N.of_nat (N.to_nat (Npos p))) = Zpos p. intros. lia. Qed. coq-8.20.0/test-suite/success/RecTutorial.v000066400000000000000000000611141466560755400206120ustar00rootroot00000000000000Module Type LocalNat. Inductive nat : Set := | O : nat | S : nat->nat. Check nat. Check O. Check S. End LocalNat. Print nat. Print le. Theorem zero_leq_three: 0 <= 3. Proof. constructor 2. constructor 2. constructor 2. constructor 1. Qed. Print zero_leq_three. Lemma zero_leq_three': 0 <= 3. repeat constructor. Qed. Lemma zero_lt_three : 0 < 3. Proof. unfold lt. repeat constructor. Qed. Require Import List. Print list. Check list. Check (nil (A:=nat)). Check (nil (A:= nat -> nat)). Check (fun A: Set => (cons (A:=A))). Check (cons 3 (cons 2 nil)). Require Import Bvector. Print Vector.t. Check (Vector.nil nat). Check (fun (A:Set)(a:A)=> Vector.cons _ a _ (Vector.nil _)). Check (Vector.cons _ 5 _ (Vector.cons _ 3 _ (Vector.nil _))). Lemma eq_3_3 : 2 + 1 = 3. Proof. reflexivity. Qed. Print eq_3_3. Lemma eq_proof_proof : refl_equal (2*6) = refl_equal (3*4). Proof. reflexivity. Qed. Print eq_proof_proof. Lemma eq_lt_le : ( 2 < 4) = (3 <= 4). Proof. reflexivity. Qed. Lemma eq_nat_nat : nat = nat. Proof. reflexivity. Qed. Lemma eq_Set_Set : Set = Set. Proof. reflexivity. Qed. Lemma eq_Type_Type : Type = Type. Proof. reflexivity. Qed. Check (2 + 1 = 3). Check (Type = Type). Goal Type = Type. reflexivity. Qed. Print or. Print and. Print sumbool. Print ex. Require Import ZArith. Require Import Compare_dec. Check le_lt_dec. Definition max (n p :nat) := match le_lt_dec n p with | left _ => p | right _ => n end. Theorem le_max : forall n p, n <= p -> max n p = p. Proof. intros n p ; unfold max ; case (le_lt_dec n p); simpl. trivial. intros; absurd (p < p); eauto with arith. Qed. Require Coq.extraction.Extraction. Extraction max. Inductive tree(A:Set) : Set := node : A -> forest A -> tree A with forest (A: Set) : Set := nochild : forest A | addchild : tree A -> forest A -> forest A. Inductive even : nat->Prop := evenO : even O | evenS : forall n, odd n -> even (S n) with odd : nat->Prop := oddS : forall n, even n -> odd (S n). Lemma odd_49 : odd (7 * 7). simpl; repeat constructor. Qed. Definition nat_case := fun (Q : Type)(g0 : Q)(g1 : nat -> Q)(n:nat) => match n return Q with | 0 => g0 | S p => g1 p end. Eval simpl in (nat_case nat 0 (fun p => p) 34). Eval simpl in (fun g0 g1 => nat_case nat g0 g1 34). Eval simpl in (fun g0 g1 => nat_case nat g0 g1 0). Definition pred (n:nat) := match n with O => O | S m => m end. Eval simpl in pred 56. Eval simpl in pred 0. Eval simpl in fun p => pred (S p). Definition xorb (b1 b2:bool) := match b1, b2 with | false, true => true | true, false => true | _ , _ => false end. Definition pred_spec (n:nat) := {m:nat | n=0 /\ m=0 \/ n = S m}. Definition predecessor : forall n:nat, pred_spec n. intro n;case n. unfold pred_spec;exists 0;auto. unfold pred_spec; intro n0;exists n0; auto. Defined. Print predecessor. Extraction predecessor. Theorem nat_expand : forall n:nat, n = match n with 0 => 0 | S p => S p end. intro n;case n;simpl;auto. Qed. Check (fun p:False => match p return 2=3 with end). Theorem fromFalse : False -> 0=1. intro absurd. contradiction. Qed. Section equality_elimination. Variables (A: Type) (a b : A) (p : a = b) (Q : A -> Type). Check (fun H : Q a => match p in (eq _ y) return Q y with refl_equal => H end). End equality_elimination. Theorem trans : forall n m p:nat, n=m -> m=p -> n=p. Proof. intros n m p eqnm. case eqnm. trivial. Qed. Lemma Rw : forall x y: nat, y = y * x -> y * x * x = y. intros x y e; do 2 rewrite <- e. reflexivity. Qed. Require Import Arith. Check Nat.mul_1_l. (* Nat.mul_1_l : forall n : nat, 1 * n = n *) Check Nat.mul_add_distr_r. (* Nat.mul_add_distr_r : forall n m p : nat, (n + m) * p = n * p + m * p *) Lemma mul_distr_S : forall n p : nat, n * p + p = (S n)* p. simpl; auto with arith. Qed. Lemma four_n : forall n:nat, n+n+n+n = 4*n. intro n;rewrite <- (Nat.mul_1_l n). Undo. intro n; pattern n at 1. rewrite <- Nat.mul_1_l. repeat rewrite mul_distr_S. trivial. Qed. Section Le_case_analysis. Variables (n p : nat) (H : n <= p) (Q : nat -> Prop) (H0 : Q n) (HS : forall m, n <= m -> Q (S m)). Check ( match H in (_ <= q) return (Q q) with | le_n _ => H0 | le_S _ m Hm => HS m Hm end ). End Le_case_analysis. Lemma predecessor_of_positive : forall n, 1 <= n -> exists p:nat, n = S p. Proof. intros n H; case H. exists 0; trivial. intros m Hm; exists m; trivial. Qed. Definition Vtail_total (A : Set) (n : nat) (v : Vector.t A n) : Vector.t A (pred n):= match v in (Vector.t _ n0) return (Vector.t A (pred n0)) with | Vector.nil _ => Vector.nil A | Vector.cons _ _ n0 v0 => v0 end. Definition Vtail' (A:Set)(n:nat)(v:Vector.t A n) : Vector.t A (pred n). case v. simpl. exact (Vector.nil A). simpl. auto. Defined. (* Inductive Lambda : Set := lambda : (Lambda -> False) -> Lambda. Error: Non strictly positive occurrence of "Lambda" in "(Lambda -> False) -> Lambda" *) Section Paradox. Variable Lambda : Set. Variable lambda : (Lambda -> False) ->Lambda. Variable matchL : Lambda -> forall Q:Prop, ((Lambda ->False) -> Q) -> Q. (* understand matchL Q l (fun h : Lambda -> False => t) as match l return Q with lambda h => t end *) Definition application (f x: Lambda) :False := matchL f False (fun h => h x). Definition Delta : Lambda := lambda (fun x : Lambda => application x x). Definition loop : False := application Delta Delta. Theorem two_is_three : 2 = 3. Proof. elim loop. Qed. End Paradox. Require Import ZArith. Inductive itree : Set := | ileaf : itree | inode : Z-> (nat -> itree) -> itree. Definition isingle l := inode l (fun i => ileaf). Definition t1 := inode 0 (fun n => isingle (Z.of_nat (2*n))). Definition t2 := inode 0 (fun n : nat => inode (Z.of_nat n) (fun p => isingle (Z.of_nat (n*p)))). Inductive itree_le : itree-> itree -> Prop := | le_leaf : forall t, itree_le ileaf t | le_node : forall l l' s s', Z.le l l' -> (forall i, exists j:nat, itree_le (s i) (s' j)) -> itree_le (inode l s) (inode l' s'). Theorem itree_le_trans : forall t t', itree_le t t' -> forall t'', itree_le t' t'' -> itree_le t t''. induction t. constructor 1. intros t'; case t'. inversion 1. intros z0 i0 H0. intro t'';case t''. inversion 1. intros. inversion_clear H1. constructor 2. inversion_clear H0;eauto with zarith. inversion_clear H0. intro i2; case (H4 i2). intros. generalize (H i2 _ H0). intros. case (H3 x);intros. generalize (H5 _ H6). exists x0;auto. Qed. Inductive itree_le' : itree-> itree -> Prop := | le_leaf' : forall t, itree_le' ileaf t | le_node' : forall l l' s s' g, Z.le l l' -> (forall i, itree_le' (s i) (s' (g i))) -> itree_le' (inode l s) (inode l' s'). Lemma t1_le_t2 : itree_le t1 t2. unfold t1, t2. constructor. auto with zarith. intro i; exists (2 * i). unfold isingle. constructor. auto with zarith. exists i;constructor. Qed. Lemma t1_le'_t2 : itree_le' t1 t2. unfold t1, t2. constructor 2 with (fun i : nat => 2 * i). auto with zarith. unfold isingle; intro i ; constructor 2 with (fun i :nat => i). auto with zarith. constructor . Qed. Require Import List. Inductive ltree (A:Set) : Set := lnode : A -> list (ltree A) -> ltree A. Inductive prop : Prop := prop_intro : Prop -> prop. Lemma prop_inject: prop. Proof prop_intro prop. Inductive ex_Prop (P : Prop -> Prop) : Prop := exP_intro : forall X : Prop, P X -> ex_Prop P. Lemma ex_Prop_inhabitant : ex_Prop (fun P => P -> P). Proof. exists (ex_Prop (fun P => P -> P)). trivial. Qed. Fail Check (fun (P:Prop->Prop)(p: ex_Prop P) => match p with exP_intro X HX => X end). (* Error: Incorrect elimination of "p" in the inductive type "ex_Prop", the return type has sort "Type" while it should be "Prop" Elimination of an inductive object of sort "Prop" is not allowed on a predicate in sort "Type" because proofs can be eliminated only to build proofs *) Fail Check (match prop_inject with (prop_intro p) => p end). (* Error: Incorrect elimination of "prop_inject" in the inductive type "prop", the return type has sort "Type" while it should be "Prop" Elimination of an inductive object of sort "Prop" is not allowed on a predicate in sort "Type" because proofs can be eliminated only to build proofs *) Print prop_inject. (* prop_inject = prop_inject = prop_intro prop : prop *) Inductive typ : Type := typ_intro : Type -> typ. Definition typ_inject: typ. split. Fail exact typ. (* Error: Universe Inconsistency. *) Abort. Fail Inductive aSet : Set := aSet_intro: Set -> aSet. (* User error: Large non-propositional inductive types must be in Type *) Inductive ex_Set (P : Set -> Prop) : Type := exS_intro : forall X : Set, P X -> ex_Set P. Module Type Version1. Inductive comes_from_the_left (P Q:Prop): P \/ Q -> Prop := c1 : forall p, comes_from_the_left P Q (or_introl (A:=P) Q p). Goal (comes_from_the_left _ _ (or_introl True I)). split. Qed. Goal ~(comes_from_the_left _ _ (or_intror True I)). red;inversion 1. (* discriminate H0. *) Abort. End Version1. Fail Definition comes_from_the_left (P Q:Prop)(H:P \/ Q): Prop := match H with | or_introl p => True | or_intror q => False end. (* Error: Incorrect elimination of "H" in the inductive type "or", the return type has sort "Type" while it should be "Prop" Elimination of an inductive object of sort "Prop" is not allowed on a predicate in sort "Type" because proofs can be eliminated only to build proofs *) Definition comes_from_the_left_sumbool (P Q:Prop)(x:{P}+{Q}): Prop := match x with | left p => True | right q => False end. Close Scope Z_scope. Theorem S_is_not_O : forall n, S n <> 0. Set Nested Proofs Allowed. Definition Is_zero (x:nat):= match x with | 0 => True | _ => False end. Lemma O_is_zero : forall m, m = 0 -> Is_zero m. Proof. intros m H; subst m. (* ============================ Is_zero 0 *) simpl;trivial. Qed. red; intros n Hn. apply O_is_zero with (m := S n). assumption. Qed. Theorem disc2 : forall n, S (S n) <> 1. Proof. intros n Hn; discriminate. Qed. Theorem disc3 : forall n, S (S n) = 0 -> forall Q:Prop, Q. Proof. intros n Hn Q. discriminate. Qed. Theorem inj_succ : forall n m, S n = S m -> n = m. Proof. Lemma inj_pred : forall n m, n = m -> pred n = pred m. Proof. intros n m eq_n_m. rewrite eq_n_m. trivial. Qed. intros n m eq_Sn_Sm. apply inj_pred with (n:= S n) (m := S m); assumption. Qed. Lemma list_inject : forall (A:Set)(a b :A)(l l':list A), a :: b :: l = b :: a :: l' -> a = b /\ l = l'. Proof. intros A a b l l' e. injection e. auto. Qed. Theorem not_le_Sn_0 : forall n:nat, ~ (S n <= 0). Proof. red; intros n H. case H. Undo. Lemma not_le_Sn_0_with_constraints : forall n p , S n <= p -> p = 0 -> False. Proof. intros n p H; case H ; intros; discriminate. Qed. eapply not_le_Sn_0_with_constraints; eauto. Qed. Theorem not_le_Sn_0' : forall n:nat, ~ (S n <= 0). Proof. red; intros n H ; inversion H. Qed. Derive Inversion le_Sn_0_inv with (forall n :nat, S n <= 0). Check le_Sn_0_inv. Theorem le_Sn_0'' : forall n p : nat, ~ S n <= 0 . Proof. intros n p H; inversion H using le_Sn_0_inv. Qed. Derive Inversion_clear le_Sn_0_inv' with (forall n :nat, S n <= 0). Check le_Sn_0_inv'. Theorem le_reverse_rules : forall n m:nat, n <= m -> n = m \/ exists p, n <= p /\ m = S p. Proof. intros n m H; inversion H. left;trivial. right; exists m0; split; trivial. Restart. intros n m H; inversion_clear H. left;trivial. right; exists m0; split; trivial. Qed. Inductive ArithExp : Set := Zero : ArithExp | Succ : ArithExp -> ArithExp | Plus : ArithExp -> ArithExp -> ArithExp. Inductive RewriteRel : ArithExp -> ArithExp -> Prop := RewSucc : forall e1 e2 :ArithExp, RewriteRel e1 e2 -> RewriteRel (Succ e1) (Succ e2) | RewPlus0 : forall e:ArithExp, RewriteRel (Plus Zero e) e | RewPlusS : forall e1 e2:ArithExp, RewriteRel e1 e2 -> RewriteRel (Plus (Succ e1) e2) (Succ (Plus e1 e2)). Fixpoint plus (n p:nat) {struct n} : nat := match n with | 0 => p | S m => S (plus m p) end. Fixpoint plus' (n p:nat) {struct p} : nat := match p with | 0 => n | S q => S (plus' n q) end. Fixpoint plus'' (n p:nat) {struct n} : nat := match n with | 0 => p | S m => plus'' m (S p) end. Module Type even_test_v1. Fixpoint even_test (n:nat) : bool := match n with 0 => true | 1 => false | S (S p) => even_test p end. End even_test_v1. Module even_test_v2. Fixpoint even_test (n:nat) : bool := match n with | 0 => true | S p => odd_test p end with odd_test (n:nat) : bool := match n with | 0 => false | S p => even_test p end. Eval simpl in even_test. Eval simpl in (fun x : nat => even_test x). Eval simpl in (fun x : nat => plus 5 x). Eval simpl in (fun x : nat => even_test (plus 5 x)). Eval simpl in (fun x : nat => even_test (plus x 5)). End even_test_v2. Section Principle_of_Induction. Variable P : nat -> Prop. Hypothesis base_case : P 0. Hypothesis inductive_step : forall n:nat, P n -> P (S n). Fixpoint nat_ind (n:nat) : (P n) := match n return P n with | 0 => base_case | S m => inductive_step m (nat_ind m) end. End Principle_of_Induction. Scheme Even_induction := Minimality for even Sort Prop with Odd_induction := Minimality for odd Sort Prop. Arguments Even_induction P P0 : rename. Theorem even_plus_four : forall n:nat, even n -> even (4+n). Proof. intros n H. elim H using Even_induction with (P0 := fun n => odd (4+n)); simpl;repeat constructor;assumption. Qed. Section Principle_of_Double_Induction. Variable P : nat -> nat ->Prop. Hypothesis base_case1 : forall x:nat, P 0 x. Hypothesis base_case2 : forall x:nat, P (S x) 0. Hypothesis inductive_step : forall n m:nat, P n m -> P (S n) (S m). Fixpoint nat_double_ind (n m:nat){struct n} : P n m := match n, m return P n m with | 0 , x => base_case1 x | (S x), 0 => base_case2 x | (S x), (S y) => inductive_step x y (nat_double_ind x y) end. End Principle_of_Double_Induction. Section Principle_of_Double_Recursion. Variable P : nat -> nat -> Set. Hypothesis base_case1 : forall x:nat, P 0 x. Hypothesis base_case2 : forall x:nat, P (S x) 0. Hypothesis inductive_step : forall n m:nat, P n m -> P (S n) (S m). Fixpoint nat_double_rec (n m:nat){struct n} : P n m := match n, m return P n m with | 0 , x => base_case1 x | (S x), 0 => base_case2 x | (S x), (S y) => inductive_step x y (nat_double_rec x y) end. End Principle_of_Double_Recursion. Definition min : nat -> nat -> nat := nat_double_rec (fun (x y:nat) => nat) (fun (x:nat) => 0) (fun (y:nat) => 0) (fun (x y r:nat) => S r). Eval compute in (min 5 8). Eval compute in (min 8 5). Lemma not_circular : forall n:nat, n <> S n. Proof. intro n. apply nat_ind with (P:= fun n => n <> S n). discriminate. red; intros n0 Hn0 eqn0Sn0;injection eqn0Sn0;auto. Qed. Definition eq_nat_dec : forall n p:nat , {n=p}+{n <> p}. Proof. intros n p. apply nat_double_rec with (P:= fun (n q:nat) => {q=p}+{q <> p}). Undo. pattern p,n. elim n using nat_double_rec. destruct x; auto. destruct x; auto. intros n0 m H; case H. intro eq; rewrite eq ; auto. intro neg; right; red ; injection 1; auto. Defined. Definition eq_nat_dec' : forall n p:nat, {n=p}+{n <> p}. decide equality. Defined. Print Acc. Fail Fixpoint div (x y:nat){struct x}: nat := if eq_nat_dec x 0 then 0 else if eq_nat_dec y 0 then x else S (div (x-y) y). (* Error: Recursive definition of div is ill-formed. In environment div : nat -> nat -> nat x : nat y : nat _ : x <> 0 _ : y <> 0 Recursive call to div has principal argument equal to "x - y" instead of a subterm of x *) Lemma minus_smaller_S: forall x y:nat, x - y < S x. Proof. intros x y; pattern y, x; elim x using nat_double_ind. destruct x0; auto with arith. simpl; auto with arith. simpl; auto with arith. Qed. Lemma minus_smaller_positive : forall x y:nat, x <>0 -> y <> 0 -> x - y < x. Proof. destruct x; destruct y; ( simpl;intros; apply minus_smaller_S || intros; absurd (0=0); auto). Qed. Definition minus_decrease : forall x y:nat, Acc lt x -> x <> 0 -> y <> 0 -> Acc lt (x-y). Proof. intros x y H; case H. intros Hz posz posy. apply Hz; apply minus_smaller_positive; assumption. Defined. Print minus_decrease. Fixpoint div_aux (x y:nat)(H: Acc lt x):nat. refine (if eq_nat_dec x 0 then 0 else if eq_nat_dec y 0 then y else div_aux (x-y) y _). apply (minus_decrease x y H);assumption. Defined. Print div_aux. (* div_aux = (fix div_aux (x y : nat) (H : Acc lt x) {struct H} : nat := match eq_nat_dec x 0 with | left _ => 0 | right _ => match eq_nat_dec y 0 with | left _ => y | right _0 => div_aux (x - y) y (minus_decrease x y H _ _0) end end) : forall x : nat, nat -> Acc lt x -> nat *) Require Import Wf_nat. Definition div x y := div_aux x y (lt_wf x). Extraction div. (* let div x y = div_aux x y *) Extraction div_aux. (* let rec div_aux x y = match eq_nat_dec x O with | Left -> O | Right -> (match eq_nat_dec y O with | Left -> y | Right -> div_aux (minus x y) y) *) Lemma vector0_is_vnil : forall (A:Set)(v:Vector.t A 0), v = Vector.nil A. Proof. intros A v;inversion v. Abort. Fail Lemma vector0_is_vnil_aux : forall (A:Set)(n:nat)(v:Vector.t A n), n= 0 -> v = Vector.nil A. (* Error: In environment A : Set n : nat v : Vector.t A n The term "[]" has type "Vector.t A 0" while it is expected to have type "Vector.t A n" *) Require Import JMeq. Lemma vector0_is_vnil_aux : forall (A:Set)(n:nat)(v:Vector.t A n), n= 0 -> JMeq v (Vector.nil A). Proof. destruct v. auto. intro; discriminate. Qed. Lemma vector0_is_vnil : forall (A:Set)(v:Vector.t A 0), v = Vector.nil A. Proof. intros a v;apply JMeq_eq. apply vector0_is_vnil_aux. trivial. Qed. Arguments Vector.cons [A] _ [n]. Arguments Vector.nil {A}. Arguments Vector.hd [A n]. Arguments Vector.tl [A n]. Definition Vid : forall (A : Type)(n:nat), Vector.t A n -> Vector.t A n. Proof. destruct n; intro v. exact Vector.nil. exact (Vector.cons (Vector.hd v) (Vector.tl v)). Defined. Eval simpl in (fun (A:Set)(v:Vector.t A 0) => (Vid _ _ v)). Eval simpl in (fun (A:Set)(v:Vector.t A 0) => v). Lemma Vid_eq : forall (n:nat) (A:Type)(v:Vector.t A n), v=(Vid _ n v). Proof. destruct v. reflexivity. reflexivity. Defined. Theorem zero_nil : forall A (v:Vector.t A 0), v = Vector.nil. Proof. intros. change (Vector.nil (A:=A)) with (Vid _ 0 v). apply Vid_eq. Defined. Theorem decomp : forall (A : Set) (n : nat) (v : Vector.t A (S n)), v = Vector.cons (Vector.hd v) (Vector.tl v). Proof. intros. change (Vector.cons (Vector.hd v) (Vector.tl v)) with (Vid _ (S n) v). apply Vid_eq. Defined. Definition vector_double_rect : forall (A:Set) (P: forall (n:nat),(Vector.t A n)->(Vector.t A n) -> Type), P 0 Vector.nil Vector.nil -> (forall n (v1 v2 : Vector.t A n) a b, P n v1 v2 -> P (S n) (Vector.cons a v1) (Vector.cons b v2)) -> forall n (v1 v2 : Vector.t A n), P n v1 v2. induction n. intros; rewrite (zero_nil _ v1); rewrite (zero_nil _ v2). auto. intros v1 v2; rewrite (decomp _ _ v1);rewrite (decomp _ _ v2). apply X0; auto. Defined. Require Import Bool. Definition bitwise_or n v1 v2 : Vector.t bool n := vector_double_rect bool (fun n v1 v2 => Vector.t bool n) Vector.nil (fun n v1 v2 a b r => Vector.cons (orb a b) r) n v1 v2. Fixpoint vector_nth (A:Set)(n:nat)(p:nat)(v:Vector.t A p){struct v} : option A := match n,v with _ , Vector.nil => None | 0 , Vector.cons b _ => Some b | S n', Vector.cons _ v' => vector_nth A n' _ v' end. Arguments vector_nth [A] _ [p]. Lemma nth_bitwise : forall (n:nat) (v1 v2: Vector.t bool n) i a b, vector_nth i v1 = Some a -> vector_nth i v2 = Some b -> vector_nth i (bitwise_or _ v1 v2) = Some (orb a b). Proof. intros n v1 v2; pattern n,v1,v2. apply vector_double_rect. simpl. destruct i; discriminate 1. destruct i; simpl;auto. injection 1 as ->; injection 1 as ->; auto. Qed. Set Implicit Arguments. CoInductive Stream (A:Set) : Set := | Cons : A -> Stream A -> Stream A. CoInductive LList (A: Set) : Set := | LNil : LList A | LCons : A -> LList A -> LList A. Definition head (A:Set)(s : Stream A) := match s with Cons a s' => a end. Definition tail (A : Set)(s : Stream A) := match s with Cons a s' => s' end. CoFixpoint repeat (A:Set)(a:A) : Stream A := Cons a (repeat a). CoFixpoint iterate (A: Set)(f: A -> A)(a : A) : Stream A:= Cons a (iterate f (f a)). CoFixpoint map (A B:Set)(f: A -> B)(s : Stream A) : Stream B:= match s with Cons a tl => Cons (f a) (map f tl) end. Eval simpl in (fun (A:Set)(a:A) => repeat a). Eval simpl in (fun (A:Set)(a:A) => head (repeat a)). CoInductive EqSt (A: Set) : Stream A -> Stream A -> Prop := eqst : forall s1 s2: Stream A, head s1 = head s2 -> EqSt (tail s1) (tail s2) -> EqSt s1 s2. Section Parks_Principle. Variable A : Set. Variable R : Stream A -> Stream A -> Prop. Hypothesis bisim1 : forall s1 s2:Stream A, R s1 s2 -> head s1 = head s2. Hypothesis bisim2 : forall s1 s2:Stream A, R s1 s2 -> R (tail s1) (tail s2). CoFixpoint park_ppl : forall s1 s2:Stream A, R s1 s2 -> EqSt s1 s2 := fun s1 s2 (p : R s1 s2) => eqst s1 s2 (bisim1 p) (park_ppl (bisim2 p)). End Parks_Principle. Theorem map_iterate : forall (A:Set)(f:A->A)(x:A), EqSt (iterate f (f x)) (map f (iterate f x)). Proof. intros A f x. apply park_ppl with (R:= fun s1 s2 => exists x: A, s1 = iterate f (f x) /\ s2 = map f (iterate f x)). intros s1 s2 (x0,(eqs1,eqs2));rewrite eqs1;rewrite eqs2;reflexivity. intros s1 s2 (x0,(eqs1,eqs2)). exists (f x0);split;[rewrite eqs1|rewrite eqs2]; reflexivity. exists x;split; reflexivity. Qed. Ltac infiniteproof f := cofix f; constructor; [clear f| simpl; try (apply f; clear f)]. Theorem map_iterate' : forall (A:Set)(f:A->A)(x:A), EqSt (iterate f (f x)) (map f (iterate f x)). infiniteproof map_iterate'. reflexivity. Qed. Arguments LNil {A}. Lemma Lnil_not_Lcons : forall (A:Set)(a:A)(l:LList A), LNil <> (LCons a l). intros;discriminate. Qed. Lemma injection_demo : forall (A:Set)(a b : A)(l l': LList A), LCons a (LCons b l) = LCons b (LCons a l') -> a = b /\ l = l'. Proof. intros A a b l l' e; injection e; auto. Qed. Inductive Finite (A:Set) : LList A -> Prop := | Lnil_fin : Finite (LNil (A:=A)) | Lcons_fin : forall a l, Finite l -> Finite (LCons a l). CoInductive Infinite (A:Set) : LList A -> Prop := | LCons_inf : forall a l, Infinite l -> Infinite (LCons a l). Lemma LNil_not_Infinite : forall (A:Set), ~ Infinite (LNil (A:=A)). Proof. intros A H;inversion H. Qed. Lemma Finite_not_Infinite : forall (A:Set)(l:LList A), Finite l -> ~ Infinite l. Proof. intros A l H; elim H. apply LNil_not_Infinite. intros a l0 F0 I0' I1. case I0'; inversion_clear I1. trivial. Qed. Lemma Not_Finite_Infinite : forall (A:Set)(l:LList A), ~ Finite l -> Infinite l. Proof. cofix H. destruct l. intro; absurd (Finite (LNil (A:=A)));[auto|constructor]. constructor. apply H. red; intro H1;case H0. constructor. trivial. Qed. coq-8.20.0/test-suite/success/Record.v000066400000000000000000000062151466560755400175740ustar00rootroot00000000000000(* Nijmegen expects redefinition of sorts *) Definition CProp := Prop. Record test : CProp := {n : nat ; m : bool ; _ : n <> 0 }. Require Import Program. Require Import List. Import ListNotations. Record vector {A : Type} {n : nat} := { vec_list : list A ; vec_len : length vec_list = n }. Arguments vector : clear implicits. Coercion vec_list : vector >-> list. #[export] Hint Rewrite @vec_len : datatypes. Ltac crush := repeat (program_simplify ; autorewrite with list datatypes ; auto with *). Obligation Tactic := crush. Program Definition vnil {A} : vector A 0 := {| vec_list := [] |}. Program Definition vcons {A n} (a : A) (v : vector A n) : vector A (S n) := {| vec_list := cons a (vec_list v) |}. #[export] Hint Rewrite map_length rev_length : datatypes. Program Definition vmap {A B n} (f : A -> B) (v : vector A n) : vector B n := {| vec_list := map f v |}. Program Definition vreverse {A n} (v : vector A n) : vector A n := {| vec_list := rev v |}. Fixpoint va_list {A B} (v : list (A -> B)) (w : list A) : list B := match v, w with | nil, nil => nil | cons f fs, cons x xs => cons (f x) (va_list fs xs) | _, _ => nil end. Program Definition va {A B n} (v : vector (A -> B) n) (w : vector A n) : vector B n := {| vec_list := va_list v w |}. Next Obligation. destruct v as [v Hv]; destruct w as [w Hw] ; simpl. subst n. revert w Hw. induction v ; destruct w ; crush. rewrite IHv ; auto. Qed. (* Correct type inference of record notation. Initial example by Spiwack. *) Inductive Machin := { Bazar : option Machin }. Definition bli : Machin := {| Bazar := Some ({| Bazar := None |}:Machin) |}. Definition bli' : option (option Machin) := Some (Some {| Bazar := None |} ). Definition bli'' : Machin := {| Bazar := Some {| Bazar := None |} |}. Definition bli''' := {| Bazar := Some {| Bazar := None |} |}. (** Correctly use scoping information *) Require Import ZArith. Record Foo := { bar : Z }. Definition foo := {| bar := 0 |}. (** Notations inside records *) Require Import Relation_Definitions. Record DecidableOrder : Type := { A : Type ; le : relation A where "x <= y" := (le x y) ; le_refl : reflexive _ le ; le_antisym : antisymmetric _ le ; le_trans : transitive _ le ; le_total : forall x y, {x <= y}+{y <= x} }. (* Test syntactic sugar suggested by wish report #2138 *) Record R : Type := { P (A : Type) : Prop := exists x : A -> A, x = x; Q A : P A -> P A }. (* We allow reusing an implicit parameter named in non-recursive types *) (* 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; }. Module MaximalImplicit. Record T := { f : forall a, a = 0 }. Arguments f _ {a}. Check fun x => x.(f) : 0 = 0. End MaximalImplicit. Module NoRecursiveRecordVariant. Fail Record t := {a:t}. Fail Variant t := C : t -> t. End NoRecursiveRecordVariant. coq-8.20.0/test-suite/success/RefineInstance.v000066400000000000000000000007371466560755400212560ustar00rootroot00000000000000 Class Foo := foo { a : nat; b : bool }. Fail #[export] Instance bla : Foo := { b:= true }. #[refine, export] Instance bla : Foo := { b:= true }. Proof. exact 0. Defined. #[export] Instance bli : Foo := { a:=1; b := false}. Check bli. Fail #[program, refine] Instance bla : Foo := {b := true}. #[program, export] Instance blo : Foo := {b := true}. Next Obligation. exact 2. Qed. Check blo. #[refine, export] Instance xbar : Foo := {a:=4; b:=true}. Proof. Qed. Check xbar. coq-8.20.0/test-suite/success/Reg.v000066400000000000000000000057661466560755400171050ustar00rootroot00000000000000Require Import Reals. Axiom y : R -> R. Axiom d_y : derivable y. Axiom n_y : forall x : R, y x <> 0%R. Axiom dy_0 : derive_pt y 0 (d_y 0%R) = 1%R. Lemma essai0 : continuity_pt (fun x : R => ((x + 2) / y x + x / y x)%R) 0. assert (H := d_y). assert (H0 := n_y). reg. Qed. Lemma essai1 : derivable_pt (fun x : R => (/ 2 * sin x)%R) 1. reg. Qed. Lemma essai2 : continuity (fun x : R => (Rsqr x * cos (x * x) + x)%R). reg. Qed. Lemma essai3 : derivable_pt (fun x : R => (x * (Rsqr x + 3))%R) 0. reg. Qed. Lemma essai4 : derivable (fun x : R => ((x + x) * sin x)%R). reg. Qed. Lemma essai5 : derivable (fun x : R => (1 + sin (2 * x + 3) * cos (cos x))%R). reg. Qed. Lemma essai6 : derivable (fun x : R => cos (x + 3)). reg. Qed. Lemma essai7 : derivable_pt (fun x : R => (cos (/ sqrt x) * Rsqr (sin x + 1))%R) 1. reg. apply Rlt_0_1. red; intro; rewrite sqrt_1 in H; assert (H0 := R1_neq_R0); elim H0; assumption. Qed. Lemma essai8 : derivable_pt (fun x : R => sqrt (Rsqr x + sin x + 1)) 0. reg. rewrite sin_0. rewrite Rsqr_0. replace (0 + 0 + 1)%R with 1%R; [ apply Rlt_0_1 | ring ]. Qed. Lemma essai9 : derivable_pt (id + sin) 1. reg. Qed. Lemma essai10 : derivable_pt (fun x : R => (x + 2)%R) 0. reg. Qed. Lemma essai11 : derive_pt (fun x : R => (x + 2)%R) 0 essai10 = 1%R. reg. Qed. Lemma essai12 : derivable (fun x : R => (x + Rsqr (x + 2))%R). reg. Qed. Lemma essai13 : derive_pt (fun x : R => (x + Rsqr (x + 2))%R) 0 (essai12 0%R) = 5%R. reg. Qed. Lemma essai14 : derivable_pt (fun x : R => (2 * x + x)%R) 2. reg. Qed. Lemma essai15 : derive_pt (fun x : R => (2 * x + x)%R) 2 essai14 = 3%R. reg. Qed. Lemma essai16 : derivable_pt (fun x : R => (x + sin x)%R) 0. reg. Qed. Lemma essai17 : derive_pt (fun x : R => (x + sin x)%R) 0 essai16 = 2%R. reg. rewrite cos_0. reflexivity. Qed. Lemma essai18 : derivable_pt (fun x : R => (x + y x)%R) 0. assert (H := d_y). reg. Qed. Lemma essai19 : derive_pt (fun x : R => (x + y x)%R) 0 essai18 = 2%R. assert (H := dy_0). assert (H0 := d_y). reg. Qed. Axiom z : R -> R. Axiom d_z : derivable z. Lemma essai20 : derivable_pt (fun x : R => z (y x)) 0. reg. apply d_y. apply d_z. Qed. Lemma essai21 : derive_pt (fun x : R => z (y x)) 0 essai20 = 1%R. assert (H := dy_0). reg. Abort. Lemma essai22 : derivable (fun x : R => (sin (z x) + Rsqr (z x) / y x)%R). assert (H := d_y). reg. apply n_y. apply d_z. Qed. (* Pour tester la continuite de sqrt en 0 *) Lemma essai23 : continuity_pt (fun x : R => (sin (sqrt (x - 1)) + exp (Rsqr (sqrt x + 3)))%R) 1. reg. left; apply Rlt_0_1. right; unfold Rminus; rewrite Rplus_opp_r; reflexivity. Qed. Lemma essai24 : derivable (fun x : R => (sqrt (x * x + 2 * x + 2) + Rabs (x * x + 1))%R). reg. replace (x * x + 2 * x + 2)%R with (Rsqr (x + 1) + 1)%R. apply Rplus_le_lt_0_compat; [ apply Rle_0_sqr | apply Rlt_0_1 ]. unfold Rsqr; ring. red; intro; cut (0 < x * x + 1)%R. intro; rewrite H in H0; elim (Rlt_irrefl _ H0). apply Rplus_le_lt_0_compat; [ replace (x * x)%R with (Rsqr x); [ apply Rle_0_sqr | reflexivity ] | apply Rlt_0_1 ]. Qed. coq-8.20.0/test-suite/success/Remark.v000066400000000000000000000002541466560755400175740ustar00rootroot00000000000000(* Test obsolete, Remark est maintenant global Section A. Section B. Section C. Remark t : True. Proof I. End C. Locate C.t. End B. Locate B.C.t. End A. Locate A.B.C.t. *) coq-8.20.0/test-suite/success/RemoteUnivs.v000066400000000000000000000005601466560755400206330ustar00rootroot00000000000000 Goal Type * Type. Proof. split. par: exact Type. Qed. Goal Type. Proof. exact Type. Qed. (* (* coqide test, note the delegated proofs seem to get an empty dirpath? or I got confused because I had lemma foo in file foo *) Definition U := Type. Lemma foo : U. Proof. exact Type. Qed. Lemma foo1 : Type. Proof. exact (U:Type). Qed. Print foo. *) coq-8.20.0/test-suite/success/Rename.v000066400000000000000000000003361466560755400175630ustar00rootroot00000000000000Goal forall n : nat, n = 0 -> n = 0. intros. rename n into p. induction p; auto. Qed. (* Submitted by Iris Loeb (BZ#842) *) Section rename. Variable A:Prop. Lemma Tauto: A->A. rename A into B. tauto. Qed. End rename. coq-8.20.0/test-suite/success/Reordering.v000066400000000000000000000005731466560755400204570ustar00rootroot00000000000000(* Testing the reordering of hypothesis required by pattern, fold and change. *) Goal forall (A:Set) (x:A) (A':=A), True. intros. fold A' in x. (* succeeds: x is moved after A' *) Undo. pattern A' in x. Undo. change A' in x. Abort. (* p and m should be moved before H *) Goal forall n:nat, n=n -> forall m:nat, let p := (m,n) in True. intros. change n with (snd p) in H. Abort. coq-8.20.0/test-suite/success/Require.v000066400000000000000000000003001466560755400177570ustar00rootroot00000000000000(* -*- coq-prog-args: ("-noinit"); -*- *) Require Import Coq.Arith.PeanoNat. Locate Library Coq.Arith.PeanoNat. (* Check that Init didn't get exported by the import above *) Fail Check nat. coq-8.20.0/test-suite/success/RewriteRegisteredElim.v000066400000000000000000000016651466560755400226300ustar00rootroot00000000000000 Set Universe Polymorphism. Cumulative Inductive EQ {A} (x : A) : A -> Type := EQ_refl : EQ x x. Register EQ as core.eq.type. Lemma renamed_EQ_rect {A} (x:A) (P : A -> Type) (c : P x) (y : A) (e : EQ x y) : P y. Proof. destruct e. assumption. Qed. Register renamed_EQ_rect as core.eq.rect. Register renamed_EQ_rect as core.eq.ind. Lemma renamed_EQ_rect_r {A} (x:A) (P : A -> Type) (c : P x) (y : A) (e : EQ y x) : P y. Proof. destruct e. assumption. Qed. Register renamed_EQ_rect_r as core.eq.rect_r. Register renamed_EQ_rect_r as core.eq.ind_r. Lemma EQ_sym1 {A} {x y : A} (e : EQ x y) : EQ y x. Proof. rewrite e. reflexivity. Qed. Lemma EQ_sym2 {A} {x y : A} (e : EQ x y) : EQ y x. Proof. rewrite <- e. reflexivity. Qed. Require Import ssreflect. Lemma ssr_EQ_sym1 {A} {x y : A} (e : EQ x y) : EQ y x. Proof. rewrite e. reflexivity. Qed. Lemma ssr_EQ_sym2 {A} {x y : A} (e : EQ x y) : EQ y x. Proof. rewrite -e. reflexivity. Qed. coq-8.20.0/test-suite/success/Scheme.v000066400000000000000000000014211466560755400175540ustar00rootroot00000000000000(* This failed in 8.3pl2 *) Scheme Induction for eq Sort Prop. Check eq_ind_dep. (* This was broken in v8.5 *) Set Rewriting Schemes. Inductive myeq A (a:A) : A -> Prop := myrefl : myeq A a a. Unset Rewriting Schemes. Check myeq_rect. Check myeq_ind. Check myeq_rec. Check myeq_congr. Check myeq_sym_internal. Check myeq_rew. Check myeq_rew_dep. Check myeq_rew_fwd_dep. Check myeq_rew_r. Check myeq_sym_involutive. Check myeq_rew_r_dep. Check myeq_rew_fwd_r_dep. Set Rewriting Schemes. Inductive myeq_true : bool -> Prop := myrefl_true : myeq_true true. Unset Rewriting Schemes. (* check that the scheme doesn't minimize itself into something non general *) Polymorphic Inductive foo@{u v|u<=v} : Type@{u}:= . Lemma bla@{u v|u < v} : foo@{u v} -> False. Proof. induction 1. Qed. coq-8.20.0/test-suite/success/SchemeEquality.v000066400000000000000000000271471466560755400213070ustar00rootroot00000000000000(* -*- coq-prog-args: ("-native-compiler" "no"); -*- *) (* Examples of use of Scheme Equality *) Module A. Definition N := nat. Inductive list := nil | cons : N -> list -> list. Scheme Equality for list. End A. Module B. Section A. Context A (eq_A:A->A->bool) (A_bl : forall x y, eq_A x y = true -> x = y) (A_lb : forall x y, x = y -> eq_A x y = true). Inductive I := C : A -> I. Scheme Equality for I. End A. End B. Module C. Parameter A : Type. Parameter eq_A : A->A->bool. Parameter A_bl : forall x y, eq_A x y = true -> x = y. Parameter A_lb : forall x y, x = y -> eq_A x y = true. #[export] Hint Resolve A_bl A_lb : core. Inductive I := C : A -> I. Scheme Equality for I. Inductive J := D : list A -> J. Scheme Equality for J. End C. (* Universe polymorphism *) Module D. Set Universe Polymorphism. Inductive unit := tt. Scheme Equality for unit. Inductive prod (A B:Type) := pair : A -> B -> prod A B. Scheme Equality for prod. (* With an indirection *) Inductive box A := c : A -> box A. Inductive prodbox (A B:Type) := pairbox : box A -> box B -> prodbox A B. Scheme Equality for prodbox. Check eq_refl : prodbox_beq @{Set Set} = fun (A B : Type@{Set}) eq_A eq_B (X Y : prodbox A B) => match X, Y with | pairbox _ _ x x0, pairbox _ _ x1 x2 => (internal_box_beq A eq_A x x1 && internal_box_beq B eq_B x0 x2)%bool end. End D. (* With hidden "X" and "Y" (was formerly cause of collisions) *) Module E. Section S. Variables X Y : Type. Variable eq_X : X -> X -> bool. Variable eq_Y : Y -> Y -> bool. Inductive EI := EC : X -> Y -> EI. Scheme Boolean Equality for EI. End S. End E. (* With inductive parameters instantiated by non-variable types *) Module F. Inductive FI := FC : list nat -> FI. Scheme Boolean Equality for FI. Inductive tree := node : list tree -> tree. Scheme Boolean Equality for tree. Inductive rose A := Leaf : A -> rose A | Node : list (rose A) -> rose A. Scheme Boolean Equality for rose. Print rose_beq. Check eq_refl : rose_beq = fun (A : Type) (eq_A : A -> A -> bool) => fix rose_eqrec (X Y : rose A) {struct X} : bool := match X with | Leaf _ x => match Y with | Leaf _ x0 => eq_A x x0 | Node _ _ => false end | Node _ x => match Y with | Leaf _ _ => false | Node _ x0 => C.internal_list_beq (rose A) rose_eqrec x x0 end end. End F. (* With higher-order parameters and non-Type parameters *) Module G. Inductive GI (F:Type->Type) A := GC : F A -> F nat -> GI F A. Scheme Boolean Equality for GI. Inductive GJ (F:nat->(nat->Type->Type)->Type) (f:nat->nat) (n:nat) (A:nat->Type->Type) := GD : F 0 (fun n => list) -> F 1 A -> GJ F f n A. Scheme Boolean Equality for GJ. End G. (* With local definitions in constructors *) Module H. Inductive HJ A : Type := HD : let a := 0 in nat -> list A -> HJ A. Scheme Boolean Equality for HJ. End H. (* With recursively non-uniform arguments *) Module I. Inductive T A := C : A -> T (option A) -> T A. Scheme Boolean Equality for T. Check eq_refl : T_beq = fix T_eqrec (A : Type) (eq_A : A -> A -> bool) (X Y : T A) {struct X} : bool := match X, Y with | C _ x x0, C _ x1 x2 => (eq_A x x1 && T_eqrec (option A) (internal_option_beq A eq_A) x0 x2)%bool end. End I. (* With mutual definitions *) Module J. Inductive tree A := node : forest A -> tree A with forest A := nil : forest A | cons : A -> tree A -> forest A. Scheme Boolean Equality for tree. Inductive K (F:nat->(nat->Type->Type)->Type) (A:nat->Type->Type) := D : L F A -> F 1 A -> K F A with L (F:nat->(nat->Type->Type)->Type) (A:nat->Type->Type) := E : F 0 (fun n => list) -> K F A -> L F A. Scheme Boolean Equality for K. End J. (* With "match" or "fix" *) Module K. Inductive K1 (b:bool) (F : if b then Type else Type->Type) : Type := C1 : nat -> K1 b F. Scheme Boolean Equality for K1. Inductive K2 (b:bool) (F : if b then Type else Type->Type) : Type := C2 : (if b return (if b then Type else Type->Type) -> Type then fun A => A else fun F => F nat) F -> K2 b F. Scheme Boolean Equality for K2. (* Almost work *) Inductive K3 (n:nat) (A : Type) : Type := C3 : (fix mkprod n := match n with 0 => A | S n => (mkprod n * A)%type end) n -> K3 n A. Fail Scheme Boolean Equality for K3. End K. Require Uint63 Floats. Module ElpiTestSuite. Inductive empty := . Scheme Equality for empty. Inductive unit := tt. Scheme Equality for unit. Inductive peano := Zero | Succ (n : peano). Scheme Equality for peano. Inductive option A := None | Some (_ : A). Scheme Equality for option. Inductive pair A B := Comma (a : A) (b : B). Scheme Equality for pair. Inductive seq A := Nil | Cons (x : A) (xs : seq A). Scheme Equality for seq. Inductive nest A := NilN | ConsN (x : A) (xs : nest (pair A A)). Scheme Boolean Equality for nest. Inductive zeta Sender (Receiver := Sender) := Envelope (a : Sender) (ReplyTo := a) (c : Receiver). Scheme Boolean Equality for zeta. Inductive beta (A : (fun x : Type => x) Type) := Redex (a : (fun x : Type => x) A). Scheme Boolean Equality for beta. Inductive large := | K1 (_ : bool) | K2 (_ : bool) (_ : bool) | K3 (_ : bool) (_ : bool) (_ : bool) | K4 (_ : bool) (_ : bool) (_ : bool) (_ : bool) | K5 (_ : bool) (_ : bool) (_ : bool) (_ : bool) (_ : bool) | K6 (_ : bool) (_ : bool) (_ : bool) (_ : bool) (_ : bool) (_ : bool) | K7 (_ : bool) (_ : bool) (_ : bool) (_ : bool) (_ : bool) (_ : bool) (_ : bool) | K8 (_ : bool) (_ : bool) (_ : bool) (_ : bool) (_ : bool) (_ : bool) (_ : bool) (_ : bool) | K9 (_ : bool) (_ : bool) (_ : bool) (_ : bool) (_ : bool) (_ : bool) (_ : bool) (_ : bool) (_ : bool) | K10(_ : bool) (_ : bool) (_ : bool) (_ : bool) (_ : bool) (_ : bool) (_ : bool) (_ : bool) (_ : bool) (_ : bool) | K11(_ : bool) (_ : bool) (_ : bool) (_ : bool) (_ : bool) (_ : bool) (_ : bool) (_ : bool) (_ : bool) (_ : bool) (_ : bool) | K12(_ : bool) (_ : bool) (_ : bool) (_ : bool) (_ : bool) (_ : bool) (_ : bool) (_ : bool) (_ : bool) (_ : bool) (_ : bool) (_ : bool) | K13(_ : bool) (_ : bool) (_ : bool) (_ : bool) (_ : bool) (_ : bool) (_ : bool) (_ : bool) (_ : bool) (_ : bool) (_ : bool) (_ : bool) (_ : bool) | K14(_ : bool) (_ : bool) (_ : bool) (_ : bool) (_ : bool) (_ : bool) (_ : bool) (_ : bool) (_ : bool) (_ : bool) (_ : bool) (_ : bool) (_ : bool) (_ : bool) | K15(_ : bool) (_ : bool) (_ : bool) (_ : bool) (_ : bool) (_ : bool) (_ : bool) (_ : bool) (_ : bool) (_ : bool) (_ : bool) (_ : bool) (_ : bool) (_ : bool) (_ : bool) | K16(_ : bool) (_ : bool) (_ : bool) (_ : bool) (_ : bool) (_ : bool) (_ : bool) (_ : bool) (_ : bool) (_ : bool) (_ : bool) (_ : bool) (_ : bool) (_ : bool) (_ : bool) (_ : bool) | K17(_ : bool) (_ : bool) (_ : bool) (_ : bool) (_ : bool) (_ : bool) (_ : bool) (_ : bool) (_ : bool) (_ : bool) (_ : bool) (_ : bool) (_ : bool) (_ : bool) (_ : bool) (_ : bool) (_ : bool) | K18(_ : bool) (_ : bool) (_ : bool) (_ : bool) (_ : bool) (_ : bool) (_ : bool) (_ : bool) (_ : bool) (_ : bool) (_ : bool) (_ : bool) (_ : bool) (_ : bool) (_ : bool) (_ : bool) (_ : bool) (_ : bool) | K19(_ : bool) (_ : bool) (_ : bool) (_ : bool) (_ : bool) (_ : bool) (_ : bool) (_ : bool) (_ : bool) (_ : bool) (_ : bool) (_ : bool) (_ : bool) (_ : bool) (_ : bool) (_ : bool) (_ : bool) (_ : bool) (_ : bool) | K20(_ : bool) (_ : bool) (_ : bool) (_ : bool) (_ : bool) (_ : bool) (_ : bool) (_ : bool) (_ : bool) (_ : bool) (_ : bool) (_ : bool) (_ : bool) (_ : bool) (_ : bool) (_ : bool) (_ : bool) (_ : bool) (_ : bool) (_ : bool) | K21(_ : bool) (_ : bool) (_ : bool) (_ : bool) (_ : bool) (_ : bool) (_ : bool) (_ : bool) (_ : bool) (_ : bool) (_ : bool) (_ : bool) (_ : bool) (_ : bool) (_ : bool) (_ : bool) (_ : bool) (_ : bool) (_ : bool) (_ : bool) (_ : bool) | K22(_ : bool) (_ : bool) (_ : bool) (_ : bool) (_ : bool) (_ : bool) (_ : bool) (_ : bool) (_ : bool) (_ : bool) (_ : bool) (_ : bool) (_ : bool) (_ : bool) (_ : bool) (_ : bool) (_ : bool) (_ : bool) (_ : bool) (_ : bool) (_ : bool) (_ : bool) | K23(_ : bool) (_ : bool) (_ : bool) (_ : bool) (_ : bool) (_ : bool) (_ : bool) (_ : bool) (_ : bool) (_ : bool) (_ : bool) (_ : bool) (_ : bool) (_ : bool) (_ : bool) (_ : bool) (_ : bool) (_ : bool) (_ : bool) (_ : bool) (_ : bool) (_ : bool) (_ : bool) | K24(_ : bool) (_ : bool) (_ : bool) (_ : bool) (_ : bool) (_ : bool) (_ : bool) (_ : bool) (_ : bool) (_ : bool) (_ : bool) (_ : bool) (_ : bool) (_ : bool) (_ : bool) (_ : bool) (_ : bool) (_ : bool) (_ : bool) (_ : bool) (_ : bool) (_ : bool) (_ : bool) (_ : bool) | K25(_ : bool) (_ : bool) (_ : bool) (_ : bool) (_ : bool) (_ : bool) (_ : bool) (_ : bool) (_ : bool) (_ : bool) (_ : bool) (_ : bool) (_ : bool) (_ : bool) (_ : bool) (_ : bool) (_ : bool) (_ : bool) (_ : bool) (_ : bool) (_ : bool) (_ : bool) (_ : bool) (_ : bool) (_ : bool) | K26(_ : bool) (_ : bool) (_ : bool) (_ : bool) (_ : bool) (_ : bool) (_ : bool) (_ : bool) (_ : bool) (_ : bool) (_ : bool) (_ : bool) (_ : bool) (_ : bool) (_ : bool) (_ : bool) (_ : bool) (_ : bool) (_ : bool) (_ : bool) (_ : bool) (_ : bool) (_ : bool) (_ : bool) (_ : bool) (_ : bool). Scheme Equality for large. Inductive prim_int := PI (i : Uint63.int). Scheme Boolean Equality for prim_int. Inductive prim_float := PF (f : PrimFloat.float). Scheme Boolean Equality for prim_float. Record fo_record := { f1 : peano; f2 : bool; }. Scheme Equality for fo_record. Record pa_record A := { f3 : peano; f4 : A; }. Scheme Equality for pa_record. Set Primitive Projections. Record pr_record A := { pf3 : peano; pf4 : A; }. Unset Primitive Projections. Scheme Boolean Equality for pr_record. Variant enum := E1 | E2 | E3. Scheme Equality for enum. End ElpiTestSuite. (* Ignoring SProp/Prop subterms *) Module L. Inductive seq {A} (x:A) : A -> SProp := seq_refl : seq x x. Inductive A := C : forall n, seq n 0 -> A. Scheme Boolean Equality for A. Check eq_refl : A_beq = fun (X Y : A) => match X, Y with | C n _, C n0 _ => A.internal_nat_beq n n0 end. End L. (* An example from fiat_crypto which fails for two reasons: - parameters of the form [Type * Type] are not yet supported - Prop arguments are not supported *) Require Import ZArith. Module M. Fixpoint tuple' T n : Type := match n with | O => T | S n' => (tuple' T n' * T)%type end. Definition tuple T n : Type := match n with | O => unit | S n' => tuple' T n' end. Definition reg_state := tuple Z 16. Definition flag_state := tuple (option bool) 6. Class parameters := { param_key : Type; param_value : Type; param_ltb : param_key -> param_key -> bool }. Axiom sorted : forall {p : parameters}, list (param_key * param_value) -> bool. Record rep (p : parameters) := { value : list (param_key * param_value); _value_ok : sorted value = true }. Record word (width : Z) := { word_rep : Type; word_ltu : word_rep -> word_rep -> bool; }. Open Scope Z_scope. Record naive_rep width := { unsigned : Z ; _unsigned_in_range : unsigned mod (2^width) = unsigned }. Definition naive width : word width := {| word_rep := naive_rep width; word_ltu x y := Z.ltb (unsigned _ x) (unsigned _ y); |}. Definition SortedList_parameters {width} (w:word width) value : parameters := {| param_value := value; param_key := word_rep _ w; param_ltb := word_ltu _ w |}. Definition mem_state := rep (SortedList_parameters (naive 64) Z). Record machine_state := { machine_reg_state :> reg_state ; machine_flag_state :> flag_state ; machine_mem_state :> mem_state }. (* Should succeed! *) Fail Scheme Boolean Equality for machine_state. End M. coq-8.20.0/test-suite/success/Scopes.v000066400000000000000000000021101466560755400176000ustar00rootroot00000000000000(* Check exportation of Argument Scopes even without import of modules *) Require Import ZArith. Module A. Definition opp := Z.opp. End A. Check (A.opp 3). (* Test extra scopes to be used in the presence of coercions *) Record B := { f :> Z -> Z }. Parameter a:B. Arguments a _%_Z_scope : extra scopes. Check a 0. (* Check that casts activate scopes if ever possible *) Inductive U := A. Bind Scope u with U. Notation "'ε'" := A : u. Definition c := ε : U. (* Check activation of type scope for tactics such as assert *) Goal True. assert (nat * nat). Abort. (* Check propagation of scopes in indirect applications to references *) Module PropagateIndirect. Notation "0" := true : bool_scope. Axiom f : bool -> bool -> nat. Check (@f 0) 0. Record R := { p : bool -> nat }. Check fun r => r.(@p) 0. End PropagateIndirect. Module ScopeProjNotation. Declare Scope foo_scope. Delimit Scope foo_scope with foo. Record prod A B := pair { fst : A ; snd : B }. Notation "[[ t , u ]]" := (pair _ _ t u) : foo_scope. Arguments fst {A B} p%_foo. Check [[2,3]].(fst). End ScopeProjNotation. coq-8.20.0/test-suite/success/Section.v000066400000000000000000000002101466560755400177470ustar00rootroot00000000000000(* Test bug 2168: ending section of some name was removing objects of the same name *) Require Import make_notation. Check add2 3. coq-8.20.0/test-suite/success/ShowExtraction.v000066400000000000000000000011201466560755400213250ustar00rootroot00000000000000 Require Extraction. Require Import List. Section Test. Variable A : Type. Variable decA : forall (x y:A), {x=y}+{x<>y}. (** Should fail when no proofs are started *) Fail Show Extraction. Lemma decListA : forall (xs ys : list A), {xs=ys}+{xs<>ys}. Proof. Show Extraction. fix decListA 1. destruct xs as [|x xs], ys as [|y ys]. Show Extraction. - now left. - now right. - now right. - Show Extraction. destruct (decA x y). + destruct (decListA xs ys). * left; now f_equal. * Show Extraction. right. congruence. + right. congruence. Show Extraction. Defined. End Test. coq-8.20.0/test-suite/success/Simplify_eq.v000066400000000000000000000003741466560755400206370ustar00rootroot00000000000000(* Check the behaviour of Simplify_eq *) (* Check that Simplify_eq tries Intro until *) Lemma l1 : 0 = 1 -> False. simplify_eq 1. Qed. Lemma l2 : forall (x : nat) (H : S x = S (S x)), H = H -> False. simplify_eq H. intros. apply (n_Sn x H0). Qed. coq-8.20.0/test-suite/success/StuckHintMode.v000066400000000000000000000013551466560755400210770ustar00rootroot00000000000000 Require Import Coq.Setoids.Setoid Coq.Classes.Morphisms. Class PartialOrder {A} (R : relation A) : Prop := { partial_order_pre :: PreOrder R; }. Global Hint Mode PartialOrder - ! : typeclass_instances. Axiom Permutation : forall {A:Type}, list A -> list A -> Prop. Infix "≡ₚ" := Permutation (at level 70, no associativity). Global Declare Instance Permutation_cons A : Proper (Logic.eq ==> @Permutation A ==> @Permutation A) (@cons A) | 7. (* priority < 7 does not trigger the bug *) Global Declare Instance Permutation_Equivalence A : Equivalence (@Permutation A). Lemma bla A (x:A) (lc lc' lac lbc : list A) (Hc: lac ++ lbc ≡ₚ lc') (HH:x :: lc' ≡ₚ lc) : True /\ x :: lac ++ lbc ≡ₚ lc. Proof. rewrite Hc. auto. Qed. coq-8.20.0/test-suite/success/TCbacktrack.v000066400000000000000000000051331466560755400205300ustar00rootroot00000000000000(* Set Typeclasses Unique Instances *) (** This lets typeclass search assume that instance heads are unique, so if one matches no other need to be tried, avoiding backtracking (even in unique solutions mode) This is on a class-by-class basis. *) (* Non unique *) Class B. Class A. Set Typeclasses Unique Instances. (* Unique *) Class D. Class C (A : Type) := c : A. #[export] Hint Mode C +. Fail Definition test := c. Unset Typeclasses Unique Instances. #[export] Instance cN1 : B -> D -> C nat := fun _ _ => 0. #[export] Instance cN2 : A -> D -> C nat := fun _ _ => 1. #[export] Instance cB : B -> C bool := fun _ => true. #[export] Instance Copt : forall A, C A -> C (option A) := fun A _ => None. Set Typeclasses Debug. Set Typeclasses Unique Solutions. (** This forces typeclass resolution to fail if at least two solutions exist to a given set of constraints. This is a global setting. For constraints involving assumed unique instances, it will not fail if two such instances could apply, however it will fail if two different instances of a unique class could apply. *) Succeed Definition foo (d d' : D) (b b' : B) (a' a'' : A) := c : nat. Definition foo (d d' : D) (b b' : B) (a' : A) := c : nat. Succeed Definition foo' (b b' : B) := _ : B. Unset Typeclasses Unique Solutions. Definition foo' (b b' : B) := _ : B. Set Typeclasses Unique Solutions. Definition foo'' (d d' : D) := _ : D. (** Cut backtracking *) Module BacktrackGreenCut. Unset Typeclasses Unique Solutions. Class C (A : Type) := c : A. Class D (A : Type) : Type := { c_of_d :: C A }. #[export] Instance D1 : D unit. Admitted. #[export] Instance D2 : D unit. Admitted. (** Two instances of D unit, but when searching for [C unit], no backtracking on the second instance should be needed except in dependent cases. Check by adding an unresolvable constraint. *) Parameter f : D unit -> C bool -> True. Fail Definition foo := f _ _. Fail Definition foo' := let y := _ : D unit in let x := _ : C bool in f _ x. Unset Typeclasses Strict Resolution. Class Transitive (A : Type) := { trans : True }. Class PreOrder (A : Type) := { preorder_trans :: Transitive A }. Class PartialOrder (A : Type) := { partialorder_trans :: Transitive A }. Class PartialOrder' (A : Type) := { partialorder_trans' :: Transitive A }. #[export] Instance: PreOrder nat. Admitted. #[export] Instance: PartialOrder nat. Admitted. Class NoInst (A : Type) := {}. Parameter foo : forall `{ T : Transitive nat } `{ NoInst (let x:=@trans _ T in nat) }, nat. Fail Definition bar := foo. End BacktrackGreenCut. coq-8.20.0/test-suite/success/TacticNotation1.v000066400000000000000000000003061466560755400213550ustar00rootroot00000000000000Module Type S. End S. Module F (E : S). Tactic Notation "foo" := idtac. Ltac bar := foo. End F. Module G (E : S). Module M := F E. Lemma Foo : True. Proof. M.bar. Abort. End G. coq-8.20.0/test-suite/success/TacticNotation2.v000066400000000000000000000004661466560755400213650ustar00rootroot00000000000000Tactic Notation "complete" tactic(tac) := tac; fail. Ltac f0 := complete (intuition idtac). (** FIXME: This is badly printed because of bug #3079. At least we check that it does not fail anomalously. *) Print Ltac f0. Ltac f1 := complete f1. Print Ltac f1. Ltac f2 := complete intuition. Print Ltac f2. coq-8.20.0/test-suite/success/Tauto.v000066400000000000000000000122571466560755400174550ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* Prop. Parameter P : nat -> Prop. Lemma Ex_Wallen : (A -> B /\ C) -> (A -> B) \/ (A -> C). Proof. tauto. Qed. Lemma Ex_Klenne : ~ ~ (A \/ ~ A). Proof. tauto. Qed. Lemma Ex_Klenne' : forall n : nat, ~ ~ (even n \/ ~ even n). Proof. tauto. Qed. Lemma Ex_Klenne'' : ~ ~ ((forall n : nat, even n) \/ ~ (forall m : nat, even m)). Proof. tauto. Qed. Lemma tauto : (forall x : nat, P x) -> forall y : nat, P y. Proof. tauto. Qed. Lemma tauto1 : A -> A. Proof. tauto. Qed. Lemma tauto2 : (A -> B -> C) -> (A -> B) -> A -> C. Proof. tauto. Qed. Lemma a : forall (x0 : A \/ B) (x1 : B /\ C), A -> B. Proof. tauto. Qed. Lemma a2 : (A -> B /\ C) -> (A -> B) \/ (A -> C). Proof. tauto. Qed. Lemma a4 : ~ A -> ~ A. Proof. tauto. Qed. Lemma e2 : ~ ~ (A \/ ~ A). Proof. tauto. Qed. Lemma e4 : ~ ~ (A \/ B -> A \/ B). Proof. tauto. Qed. Lemma y0 : forall (x0 : A) (x1 : ~ A) (x2 : A -> B) (x3 : A \/ B) (x4 : A /\ B), A -> False. Proof. tauto. Qed. Lemma y1 : forall x0 : (A /\ B) /\ C, B. Proof. tauto. Qed. Lemma y2 : forall (x0 : A) (x1 : B), C \/ B. Proof. tauto. Qed. Lemma y3 : forall x0 : A /\ B, B /\ A. Proof. tauto. Qed. Lemma y5 : forall x0 : A \/ B, B \/ A. Proof. tauto. Qed. Lemma y6 : forall (x0 : A -> B) (x1 : A), B. Proof. tauto. Qed. Lemma y7 : forall (x0 : A /\ B -> C) (x1 : B) (x2 : A), C. Proof. tauto. Qed. Lemma y8 : forall (x0 : A \/ B -> C) (x1 : A), C. Proof. tauto. Qed. Lemma y9 : forall (x0 : A \/ B -> C) (x1 : B), C. Proof. tauto. Qed. Lemma y10 : forall (x0 : (A -> B) -> C) (x1 : B), C. Proof. tauto. Qed. (* This example took much time with the old version of Tauto *) Lemma critical_example0 : (~ ~ B -> B) -> (A -> B) -> ~ ~ A -> B. Proof. tauto. Qed. (* Same remark as previously *) Lemma critical_example1 : (~ ~ B -> B) -> (~ B -> ~ A) -> ~ ~ A -> B. Proof. tauto. Qed. (* This example took very much time (about 3mn on a PIII 450MHz in bytecode) with the old Tauto. Now, it's immediate (less than 1s). *) Lemma critical_example2 : (~ A <-> B) -> (~ B <-> A) -> (~ ~ A <-> A). Proof. tauto. Qed. (* This example was a bug *) Lemma old_bug0 : (~ A <-> B) -> (~ (C \/ E) <-> D /\ F) -> (~ (C \/ A \/ E) <-> D /\ B /\ F). Proof. tauto. Qed. (* Another bug *) Lemma old_bug1 : ((A -> B -> False) -> False) -> (B -> False) -> False. Proof. tauto. Qed. (* A bug again *) Lemma old_bug2 : ((((C -> False) -> A) -> ((B -> False) -> A) -> False) -> False) -> (((C -> B -> False) -> False) -> False) -> ~ A -> A. Proof. tauto. Qed. (* A bug from CNF form *) Lemma old_bug3 : ((~ A \/ B) /\ (~ B \/ B) /\ (~ A \/ ~ B) /\ (~ B \/ ~ B) -> False) -> ~ ((A -> B) -> B) -> False. Proof. tauto. Qed. (* sometimes, the behaviour of Tauto depends on the order of the hyps *) Lemma old_bug3bis : ~ ((A -> B) -> B) -> ((~ B \/ ~ B) /\ (~ B \/ ~ A) /\ (B \/ ~ B) /\ (B \/ ~ A) -> False) -> False. Proof. tauto. Qed. (* A bug found by Freek Wiedijk *) Lemma new_bug : ((A <-> B) -> (B <-> C)) -> ((B <-> C) -> (C <-> A)) -> ((C <-> A) -> (A <-> B)) -> (A <-> B). Proof. tauto. Qed. (* A private club has the following rules : * * . rule 1 : Every non-scottish member wears red socks * . rule 2 : Every member wears a kilt or doesn't wear red socks * . rule 3 : The married members don't go out on sunday * . rule 4 : A member goes out on sunday if and only if he is scottish * . rule 5 : Every member who wears a kilt is scottish and married * . rule 6 : Every scottish member wears a kilt * * Actually, no one can be accepted ! *) Section club. Variable Scottish RedSocks WearKilt Married GoOutSunday : Prop. Hypothesis rule1 : ~ Scottish -> RedSocks. Hypothesis rule2 : WearKilt \/ ~ RedSocks. Hypothesis rule3 : Married -> ~ GoOutSunday. Hypothesis rule4 : GoOutSunday <-> Scottish. Hypothesis rule5 : WearKilt -> Scottish /\ Married. Hypothesis rule6 : Scottish -> WearKilt. Lemma NoMember : False. tauto. Qed. End club. (**** Use of Intuition ****) Lemma intu0 : (forall x : nat, P x) /\ B -> (forall y : nat, P y) /\ P 0 \/ B /\ P 0. Proof. intuition. Qed. Lemma intu1 : (forall A : Prop, A \/ ~ A) -> forall x y : nat, x = y \/ x <> y. Proof. intuition. Qed. coq-8.20.0/test-suite/success/Template.v000066400000000000000000000126671466560755400201410ustar00rootroot00000000000000Set Printing Universes. Module AutoYes. Inductive Box (A:Type) : Type := box : A -> Box A. About Box. (* This checks that Box is template poly, see module No for how it fails *) Universe i j. Constraint i < j. Definition j_lebox (A:Type@{j}) := Box A. Definition box_lti A := Box A : Type@{i}. End AutoYes. Module AutoNo. Unset Auto Template Polymorphism. Inductive Box (A:Type) : Type := box : A -> Box A. About Box. Universe i j. Constraint i < j. Definition j_lebox (A:Type@{j}) := Box A. Fail Definition box_lti A := Box A : Type@{i}. End AutoNo. Module Yes. #[universes(template)] Inductive Box@{i} (A:Type@{i}) : Type@{i} := box : A -> Box A. About Box. Universe i j. Constraint i < j. Definition j_lebox (A:Type@{j}) := Box A. Definition box_lti A := Box A : Type@{i}. End Yes. Module No. #[universes(template=no)] Inductive Box (A:Type) : Type := box : A -> Box A. About Box. Universe i j. Constraint i < j. Definition j_lebox (A:Type@{j}) := Box A. Fail Definition box_lti A := Box A : Type@{i}. End No. Module DefaultProp. Inductive identity (A : Type) (a : A) : A -> Type := id_refl : identity A a a. (* By default template polymorphism does not interact with inductives which naturally fall in Prop *) Check (identity nat 0 0 : Prop). End DefaultProp. Module ExplicitTemplate. #[universes(template)] Inductive identity@{i} (A : Type@{i}) (a : A) : A -> Type@{i} := id_refl : identity A a a. (* There used to be a weird interaction of template polymorphism and inductive types which fall in Prop due to kernel sort inference. This inductive is template polymorphic, but the universe annotation Type@{i} was ignored by the kernel which infered it lived in any universe and thus put it in Prop. This is not the case anymore since return sort inference has been removed from the kernel. Now the universe annotation is respected by the kernel. *) Fail Check (identity Type nat nat : Prop). Check (identity True I I : Prop). End ExplicitTemplate. Polymorphic Definition f@{i} : Type@{i} := nat. Polymorphic Definition baz@{i} : Type@{i} -> Type@{i} := fun x => x. Section Foo. Universe u. Context (A : Type@{u}). Inductive Bar := | bar : A -> Bar. Set Universe Minimization ToSet. Inductive Baz := | cbaz : A -> baz Baz -> Baz. Inductive Baz' := | cbaz' : A -> baz@{Set} nat -> Baz'. (* 2 constructors, at least in Set *) Inductive Bazset@{v} := | cbaz1 : A -> baz@{v} Bazset -> Bazset | cbaz2 : Bazset. Eval compute in ltac:(let T := type of A in exact T). Inductive Foo : Type := | foo : A -> f -> Foo. End Foo. Set Printing Universes. (* Cannot fall back to Prop or Set anymore as baz is no longer template-polymorphic *) Fail Check Bar True : Prop. Fail Check Bar nat : Set. About Baz. Check cbaz True I. (** Neither can it be Set *) Fail Check Baz nat : Set. (** No longer possible for Baz' which contains a type in Set *) Fail Check Baz' True : Prop. Fail Check Baz' nat : Set. Fail Check Bazset True : Prop. Fail Check Bazset True : Set. (** We can force the universe instantiated in [baz Bazset] to be [u], so Bazset lives in max(Set, u). *) Constraint u = Bazset.v. (** As u is global it is already > Set, so: *) Definition bazsetex@{i | i < u} : Type@{u} := Bazset Type@{i}. (* Bazset is closed for universes u = u0, cannot be instantiated with Prop *) Definition bazseetpar (X : Type@{u}) : Type@{u} := Bazset X. (** Would otherwise break singleton elimination and extraction. *) Fail Check Foo True : Prop. Fail Check Foo True : Set. Definition foo_proj {A} (f : Foo A) : nat := match f with foo _ _ n => n end. Definition ex : Foo True := foo _ I 0. Check foo_proj ex. (** See failure/Template.v for a test of the unsafe Unset Template Check usage *) Module AutoTemplateTest. Set Warnings "+auto-template". Section Foo. Universe u'. Context (A : Type@{u'}). (* Not failing as Bar cannot be made template polymorphic at all *) Inductive Bar := | bar : A -> Bar. End Foo. End AutoTemplateTest. Module TestTemplateAttribute. Section Foo. Universe u. Context (A : Type@{u}). Set Warnings "+no-template-universe". (* Failing as Bar cannot be made template polymorphic at all *) Fail #[universes(template)] Inductive Bar := | bar : A -> Bar. End Foo. End TestTemplateAttribute. Module SharingWithoutSection. Inductive Foo A (S:= fun _ => Set : ltac:(let ty := type of A in exact ty)) := foo : S A -> Foo A. Fail Check Foo True : Prop. End SharingWithoutSection. Module OkNotCovered. (* Here it happens that box is safe but we don't see it *) Section S. Universe u. Variable A : Type@{u}. Inductive box (A:Type@{u}) := Box : A -> box A. Definition B := Set : Type@{u}. End S. Fail Check box True : Prop. End OkNotCovered. Module BoxBox. Inductive Box (A:Type) := box (_:A). Inductive Box' (A:Type) := box' (_:Box A). Check Box' True : Prop. End BoxBox. Module TemplateUnit. Set Warnings "-no-template-universe". (* This is marked as template without any actual template universe. *) #[universes(template)] Inductive foo := Foo. Check (foo : Prop). End TemplateUnit. Module TemplateParamUnit. (* In theory, A could be template but the upper layers don't mark it as such *) Set Warnings "+no-template-universe". Fail #[universes(template)] Inductive foo (A : Type) := Foo. Set Warnings "-no-template-universe". #[universes(template)] Inductive foo (A : Type) := Foo. Check (foo unit : Prop). End TemplateParamUnit. coq-8.20.0/test-suite/success/TestRefine.v000066400000000000000000000105451466560755400204270ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* match x0 with | O => _ | S p => _ end)). Restart. refine (fun x0 : nat => match x0 as n return (n = n) with | O => _ | S p => _ end). (* OK *) Restart. refine (fun x0 : nat => match x0 as n return (n = n) with | O => _ | S p => _ end). (* OK *) Restart. (** Refine [x0:nat]Cases x0 of O => ? | (S p) => ? end. (* cannot be executed *) **) Abort. (************************************************************************) Lemma T : nat. refine (S _). Abort. (************************************************************************) Lemma essai2 : forall x : nat, x = x. refine (fix f (x : nat) : x = x := _). Restart. refine (fix f (x : nat) : x = x := match x as n return (n = n :>nat) with | O => _ | S p => _ end). Restart. refine (fix f (x : nat) : x = x := match x as n return (n = n) with | O => _ | S p => _ end). Restart. refine (fix f (x : nat) : x = x := match x as n return (n = n :>nat) with | O => _ | S p => f_equal S _ end). Restart. refine (fix f (x : nat) : x = x := match x as n return (n = n :>nat) with | O => _ | S p => f_equal S _ end). Abort. (************************************************************************) Parameter f : nat * nat -> nat -> nat. Lemma essai : nat. refine (f _ ((fun x : nat => _:nat) 0)). Restart. refine (f _ 0). Abort. (************************************************************************) Parameter P : nat -> Prop. Lemma essai : {x : nat | x = 1}. refine (exist _ 1 _). (* ECHEC *) Restart. (* mais si on contraint par le but alors ca marche : *) (* Remarque : on peut toujours faire ça *) refine (exist _ 1 _:{x : nat | x = 1}). Restart. refine (exist (fun x : nat => x = 1) 1 _). Abort. (************************************************************************) Lemma essai : forall n : nat, {x : nat | x = S n}. refine (fun n : nat => match n return {x : nat | x = S n} with | O => _ | S p => _ end). Restart. refine (fun n : nat => match n with | O => _ | S p => _ end). Restart. refine (fun n : nat => match n return {x : nat | x = S n} with | O => _ | S p => _ end). Restart. refine (fix f (n : nat) : {x : nat | x = S n} := match n return {x : nat | x = S n} with | O => _ | S p => _ end). Restart. refine (fix f (n : nat) : {x : nat | x = S n} := match n return {x : nat | x = S n} with | O => _ | S p => _ end). exists 1. trivial. elim (f p). refine (fun (x : nat) (h : x = S p) => exist (fun x : nat => x = S (S p)) (S x) _). rewrite h. auto. Qed. (* Quelques essais de recurrence bien fondée *) Require Import Init.Wf. Require Import Wf_nat. Lemma essai_wf : nat -> nat. refine (fun x : nat => well_founded_induction _ (fun _ : nat => nat -> nat) (fun (phi0 : nat) (w : forall phi : nat, phi < phi0 -> nat -> nat) => w x _) x x). exact lt_wf. Abort. Require Import Arith_base. Lemma fibo : nat -> nat. refine (well_founded_induction _ (fun _ : nat => nat) (fun (x0 : nat) (fib : forall x : nat, x < x0 -> nat) => match zerop x0 with | left _ => 1 | right h1 => match zerop (pred x0) with | left _ => 1 | right h2 => fib (pred x0) _ + fib (pred (pred x0)) _ end end)). exact lt_wf. auto with arith. apply Nat.lt_trans with (m := pred x0); auto with arith. Qed. coq-8.20.0/test-suite/success/Try.v000066400000000000000000000002541466560755400171310ustar00rootroot00000000000000(* To shorten interactive scripts, it is better that Try catches non-existent names in Unfold [cf BZ#263] *) Lemma lem1 : True. try unfold i_dont_exist. trivial. Qed. coq-8.20.0/test-suite/success/Typeclasses.v000066400000000000000000000220271466560755400206540ustar00rootroot00000000000000(* coq-prog-args: ("-async-proofs" "off") *) Module applydestruct. Class Foo (A : Type) := { bar : nat -> A; baz : A -> nat }. #[export] Hint Mode Foo + : typeclass_instances. Class C (A : Type). #[export] Hint Mode C + : typeclass_instances. Parameter fool : forall {A} {F : Foo A} (x : A), C A -> bar 0 = x. (* apply leaves non-dependent subgoals of typeclass type alone *) Goal forall {A} {F : Foo A} (x : A), bar 0 = x. Proof. intros. apply fool. match goal with |[ |- C A ] => idtac end. Abort. Parameter fooli : forall {A} {F : Foo A} {c : C A} (x : A), bar 0 = x. (* apply tries to resolve implicit argument typeclass constraints. *) Goal forall {A} {F : Foo A} (x : A), bar 0 = x. Proof. intros. Fail apply fooli. Fail unshelve eapply fooli; solve [typeclasses eauto]. eapply fooli. Abort. (* It applies resolution after unification of the goal *) Goal forall {A} {F : Foo A} {C : C A} (x : A), bar 0 = x. Proof. intros. apply fooli. Abort. Set Typeclasses Debug Verbosity 2. Inductive bazdestr {A} (F : Foo A) : nat -> Prop := | isbas : bazdestr F 1. Parameter fooinv : forall {A} {F : Foo A} (x : A), bazdestr F (baz x). (* Destruct applies resolution early, before finding occurrences to abstract. *) Goal forall {A} {F : Foo A} {C : C A} (x : A), baz x = 0. Proof. intros. Fail destruct (fooinv _). destruct (fooinv x). Abort. Goal forall {A} {F : Foo A} (x y : A), x = y. Proof. intros. rewrite <- (fool x). rewrite <- (fool y). reflexivity. match goal with |[ |- C A ] => idtac end. Abort. End applydestruct. Module onlyclasses. (* In 8.6 we still allow non-class subgoals *) Parameter Foo : Type. Parameter foo : Foo. #[export] Hint Extern 0 Foo => exact foo : typeclass_instances. Goal Foo * Foo. split. shelve. Set Typeclasses Debug. typeclasses eauto. Unshelve. typeclasses eauto. Qed. Module RJung. Class Foo (x : nat). #[export] Instance foo x : x = 2 -> Foo x := {}. #[export] Hint Extern 0 (_ = _) => reflexivity : typeclass_instances. Typeclasses eauto := debug. Check (_ : Foo 2). Fail Definition foo := (_ : 0 = 0). End RJung. End onlyclasses. Module shelve_non_class_subgoals. Parameter Foo : Type. Parameter foo : Foo. #[export] Hint Extern 0 Foo => exact foo : typeclass_instances. Class Bar := {}. #[export] Instance bar1 (f:Foo) : Bar := {}. Typeclasses eauto := debug. Set Typeclasses Debug Verbosity 2. Goal Bar. (* Solution has shelved subgoals (of non typeclass type) *) typeclasses eauto. Abort. End shelve_non_class_subgoals. Module RefineVsNoTceauto. Class Foo (A : Type) := foo : A. #[export] Instance: Foo nat := { foo := 0 }. #[export] Instance: Foo nat := { foo := 42 }. #[export] Hint Extern 0 (_ = _) => refine eq_refl : typeclass_instances. Goal exists (f : Foo nat), @foo _ f = 0. Proof. unshelve (notypeclasses refine (ex_intro _ _ _)). Set Typeclasses Debug. Set Printing All. all:once (typeclasses eauto). Fail idtac. (* Check no subgoals are left *) Undo 3. (** In this case, the (_ = _) subgoal is not considered by typeclass resolution *) refine (ex_intro _ _ _). Fail reflexivity. Abort. End RefineVsNoTceauto. Module Leivantex2PR339. (** Was a bug preventing to find hints associated with no pattern *) Class Bar := {}. #[export] Instance bar1 (t:Type) : Bar := {}. Local Hint Extern 0 => exact True : typeclass_instances. Typeclasses eauto := debug. Goal Bar. Set Typeclasses Debug Verbosity 2. typeclasses eauto. (* Relies on resolution of a non-class subgoal *) Undo 1. typeclasses eauto with typeclass_instances. Qed. End Leivantex2PR339. Module HintMode_NonStuck_Failure_Refine_DoNotShelve. Class test (x : nat) := testv : True. Local Hint Mode test ! : typeclass_instances. Record foo := { n : nat ; t : test n ; h : t = t }. Goal True. (* This tests that non-stuck classes whose resolution fails are left as proper subgoals and not shelved if failure is allowed. *) simple refine (let name := (_ : test 5) in _); [|]. Abort. End HintMode_NonStuck_Failure_Refine_DoNotShelve. Module bt. Require Import Classes.Init. Record Equ (A : Type) (R : A -> A -> Prop). Definition equiv {A} R (e : Equ A R) := R. Record Refl (A : Type) (R : A -> A -> Prop). Axiom equ_refl : forall A R (e : Equ A R), Refl _ (@equiv A R e). #[export] Hint Extern 0 (Refl _ _) => unshelve class_apply @equ_refl; [shelve|] : foo. Parameter R : nat -> nat -> Prop. Lemma bas : Equ nat R. Admitted. #[export] Hint Resolve bas : foo. #[export] Hint Extern 1 => match goal with |- (_ -> _ -> Prop) => shelve end : foo. Goal exists R, @Refl nat R. eexists. solve [typeclasses eauto with foo]. Qed. End bt. Generalizable All Variables. Module mon. Reserved Notation "'return' t" (at level 0). Reserved Notation "x >>= y" (at level 65, left associativity). Record Monad {m : Type -> Type} := { unit : forall {α}, α -> m α where "'return' t" := (unit t) ; bind : forall {α β}, m α -> (α -> m β) -> m β where "x >>= y" := (bind x y) ; bind_unit_left : forall {α β} (a : α) (f : α -> m β), return a >>= f = f a }. Print Visibility. Print unit. Arguments unit {m _ α}. Arguments Monad : clear implicits. Notation "'return' t" := (unit t). (* Test correct handling of existentials and defined fields. *) Class A `(e: T) := { a := True }. Class B `(e_: T) := { e := e_; sg_ass :: A e }. (* Set Typeclasses Debug. *) (* Set Typeclasses Debug Verbosity 2. *) Goal forall `{B T}, Prop. intros. apply a. Defined. Goal forall `{B T}, Prop. intros. refine (@a _ _ _). Defined. Class B' `(e_: T) := { e' := e_; sg_ass' :: A e_ }. Goal forall `{B' T}, a. intros. exact I. Defined. End mon. Module deftwice. Class C (A : Type) := c : A -> Type. Record Inhab (A : Type) := { witness : A }. #[export] Instance inhab_C : C Type := Inhab. Axiom full : forall A (X : C A), forall x : A, c x. Definition truc {A : Type} : Inhab A := (full _ _ _). End deftwice. (* Correct treatment of dependent goals *) (* First some preliminaries: *) Section sec. Context {N: Type}. Class C (f: N->N) := {}. Class E := { e: N -> N }. Context (g: N -> N) `(E) `(C e) `(forall (f: N -> N), C f -> C (fun x => f x)) (U: forall f: N -> N, C f -> False). (* Now consider the following: *) Let foo := U (fun x => e x). Check foo _. (* This type checks fine, so far so good. But now let's try to get rid of the intermediate constant foo. Surely we can just expand it inline, right? Wrong!: *) Check U (fun x => e x) _. End sec. Module UniqueSolutions. Set Typeclasses Unique Solutions. Class Eq (A : Type) : Set. #[export] Instance eqa : Eq nat := {}. #[export] Instance eqb : Eq nat := {}. Goal Eq nat. try apply _. Fail exactly_once typeclasses eauto. Abort. End UniqueSolutions. Module UniqueInstances. (** Optimize proof search on this class by never backtracking on (closed) goals for it. *) Set Typeclasses Unique Instances. Class Eq (A : Type) : Set. #[export] Instance eqa : Eq nat. Qed. #[export] Instance eqb : Eq nat := {}. Class Foo (A : Type) (e : Eq A) : Set. #[export] Instance fooa : Foo _ eqa := {}. Tactic Notation "refineu" open_constr(c) := unshelve refine c. Set Typeclasses Debug. Goal { e : Eq nat & Foo nat e }. unshelve refineu (existT _ _ _). all:simpl. (** Does not backtrack on the (wrong) solution eqb *) Fail all:typeclasses eauto. Abort. End UniqueInstances. Module IterativeDeepening. Class A. Class B. Class C. #[export] Instance: B -> A | 0 := {}. #[export] Instance: C -> A | 0 := {}. #[export] Instance: C -> B -> A | 0 := {}. #[export] Instance: A -> A | 0 := {}. Goal C -> A. intros. Fail Timeout 1 typeclasses eauto. Set Typeclasses Iterative Deepening. Fail typeclasses eauto 1. typeclasses eauto 2. Undo. Unset Typeclasses Iterative Deepening. Fail Timeout 1 typeclasses eauto. Set Typeclasses Iterative Deepening. typeclasses eauto. Qed. End IterativeDeepening. Module AxiomsAreNotInstances. Class TestClass2 := {}. Axiom testax2 : TestClass2. Fail Definition testdef2 : TestClass2 := _. (* we didn't break typeclasses *) #[export] Existing Instance testax2. Definition testdef2 : TestClass2 := _. End AxiomsAreNotInstances. Module InternalHintBacktracking. Class A (T : Type) := mkA { ofA : T }. Definition a0 : A nat := {| ofA := 0 |}. Definition a1 : A bool := {| ofA := true |}. (** This defines an instance that returns an A bool on first success and A nat on second success *) Local Hint Extern 0 (A _) => exact a1 + exact a0 : typeclass_instances. Class B (T : Type). #[export] Instance b0 : B nat := {}. Definition foo {T} {x : A T} {b : B T} : T := ofA. (* This definition only passes because we backtrack on [exact a1] above and try a0 : A nat *) Definition test := foo. Check test : nat. End InternalHintBacktracking. coq-8.20.0/test-suite/success/TypeclassesOpaque.v000066400000000000000000000042041466560755400220240ustar00rootroot00000000000000 (** Testing the Typeclasses Opaque hints. We create two identical typeclasses [P] and [Q] and compare the behaviour of Typeclasses Opaque and Hint Opaque. They should be the same. *) Axiom A : Type. Axiom P : A -> Type. Axiom Q : A -> Type. Existing Class P. Existing Class Q. Axiom a : A. Axiom pa : P a. Axiom qa : Q a. #[local] Existing Instance pa. #[local] Existing Instance qa. Definition b := a. Definition c := a. (** b is transparent so typeclass search should find it. *) Goal P b. Proof. Succeed typeclasses eauto. Abort. (** c is transparent so typeclass search should find it. *) Goal Q c. Proof. Succeed typeclasses eauto. Abort. (** Creating a local hint in a module or a section *) Section Foo. #[local] Hint Opaque b : typeclass_instances. #[local] Typeclasses Opaque c. End Foo. (** Closing the module/section should get rid of the hint, so we expect the same behaviour as before. *) (** b is transparent so typeclass search should find it. *) Goal P b. Proof. Succeed typeclasses eauto. Abort. (** c is transparent so typeclass search should find it. *) Goal Q c. Proof. Succeed typeclasses eauto. Abort. (** Now setting the locality as export *) Module Foo. #[export] Hint Opaque b : typeclass_instances. #[export] Typeclasses Opaque c. (** Things should fail inside *) Goal P b. Proof. Fail typeclasses eauto. Abort. Goal Q c. Proof. Fail typeclasses eauto. Abort. End Foo. (** But succeed outside *) Goal P b. Proof. Succeed typeclasses eauto. Abort. Goal Q c. Proof. Succeed typeclasses eauto. Abort. (** Until of course we export the module *) Export Foo. Goal P b. Proof. Fail typeclasses eauto. Abort. Goal Q c. Proof. Fail typeclasses eauto. Abort. (** Finally we test the localities for this alias *) Succeed #[local] Typeclasses Opaque b. Succeed #[global] Typeclasses Opaque b. Succeed #[export] Typeclasses Opaque b. Succeed #[local] Typeclasses Transparent b. Succeed #[global] Typeclasses Transparent b. Succeed #[export] Typeclasses Transparent b. Notation bar := (0 + 0). Fail Local Typeclasses Transparent bar. Notation baz := b. Succeed Local Typeclasses Transparent baz. coq-8.20.0/test-suite/success/Typeclasses_eauto_dfs_bfs.v000066400000000000000000000022031466560755400235310ustar00rootroot00000000000000Class A := a : nat. Class B := b : nat. Class C := c : nat. Class D := d : nat. #[local] Instance CtoA : C -> A := fun x => x. #[local] Instance BtoA : B -> A := fun x => x. #[local] Instance DtoB : D -> B := fun x => x. #[local] Instance someC : C := 2. #[local] Instance someD : D := 3. (** Here is our class structure: *) (* A / \ B C* / D* *) (** In a dfs (depth-first search) the instance at D* should be found. In a bfs (breadth-first search) the instance at C* should be found. *) Set Typeclasses Debug. (** We test that [typeclasses eauto] is really using bfs or dfs. *) Goal exists x : A, x = 3. simple notypeclasses refine (ex_intro _ _ _). 1: typeclasses eauto. reflexivity. Qed. Goal exists x : A, x = 2. simple notypeclasses refine (ex_intro _ _ _). 1: typeclasses eauto bfs. reflexivity. Qed. Set Typeclasses Iterative Deepening. Goal exists x : A, x = 3. simple notypeclasses refine (ex_intro _ _ _). 1: typeclasses eauto dfs. reflexivity. Qed. Goal exists x : A, x = 2. simple notypeclasses refine (ex_intro _ _ _). 1: typeclasses eauto. reflexivity. Qed. coq-8.20.0/test-suite/success/ValidateProof.v000066400000000000000000000004241466560755400211110ustar00rootroot00000000000000 Module M. Private Inductive foo := . Definition to_nat (f:foo) : nat := match f with end. End M. Lemma bar : False. Proof. exact_no_check I. Fail Validate Proof. Abort. Lemma bar f : M.to_nat f = 0. Proof. Validate Proof. cbv. Fail Validate Proof. Abort. coq-8.20.0/test-suite/success/ZModulo.v000066400000000000000000001061061466560755400177470ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* 1%positive. #[deprecated(note="Cyclic.ZModulo will be moved to the test suite", since="8.17")] Definition wB := base digits. #[deprecated(note="Cyclic.ZModulo will be moved to the test suite", since="8.17")] Definition t := Z. #[deprecated(note="Cyclic.ZModulo will be moved to the test suite", since="8.17")] Definition zdigits := Zpos digits. #[deprecated(note="Cyclic.ZModulo will be moved to the test suite", since="8.17")] Definition to_Z x := x mod wB. #[deprecated(note="Cyclic.ZModulo will be moved to the test suite", since="8.17")] Notation "[| x |]" := (to_Z x) (at level 0, x at level 99). #[deprecated(note="Cyclic.ZModulo will be moved to the test suite", since="8.17")] Notation "[+| c |]" := (interp_carry 1 wB to_Z c) (at level 0, c at level 99). #[deprecated(note="Cyclic.ZModulo will be moved to the test suite", since="8.17")] Notation "[-| c |]" := (interp_carry (-1) wB to_Z c) (at level 0, c at level 99). #[deprecated(note="Cyclic.ZModulo will be moved to the test suite", since="8.17")] Notation "[|| x ||]" := (zn2z_to_Z wB to_Z x) (at level 0, x at level 99). #[deprecated(note="Cyclic.ZModulo will be moved to the test suite", since="8.17")] Lemma spec_more_than_1_digit: 1 < Zpos digits. Proof. generalize digits_ne_1; destruct digits; red; auto. destruct 1; auto. Qed. Let digits_gt_1 := spec_more_than_1_digit. #[deprecated(note="Cyclic.ZModulo will be moved to the test suite", since="8.17")] Lemma wB_pos : wB > 0. Proof. apply Z.lt_gt. unfold wB, base; auto with zarith. Qed. #[local] Hint Resolve wB_pos : core. #[deprecated(note="Cyclic.ZModulo will be moved to the test suite", since="8.17")] Lemma spec_to_Z_1 : forall x, 0 <= [|x|]. Proof. unfold to_Z; intros; destruct (Z_mod_lt x wB wB_pos); auto. Qed. #[deprecated(note="Cyclic.ZModulo will be moved to the test suite", since="8.17")] Lemma spec_to_Z_2 : forall x, [|x|] < wB. Proof. unfold to_Z; intros; destruct (Z_mod_lt x wB wB_pos); auto. Qed. #[local] Hint Resolve spec_to_Z_1 spec_to_Z_2 : core. #[deprecated(note="Cyclic.ZModulo will be moved to the test suite", since="8.17")] Lemma spec_to_Z : forall x, 0 <= [|x|] < wB. Proof. auto. Qed. #[deprecated(note="Cyclic.ZModulo will be moved to the test suite", since="8.17")] Definition of_pos x := let (q,r) := Z.pos_div_eucl x wB in (N_of_Z q, r). #[deprecated(note="Cyclic.ZModulo will be moved to the test suite", since="8.17")] Lemma spec_of_pos : forall p, Zpos p = (Z.of_N (fst (of_pos p)))*wB + [|(snd (of_pos p))|]. Proof. intros; unfold of_pos; simpl. generalize (Z_div_mod_POS wB wB_pos p). destruct (Z.pos_div_eucl p wB); simpl; destruct 1. unfold to_Z; rewrite Zmod_small; auto. assert (0 <= z). { replace z with (Zpos p / wB) by (symmetry; apply Zdiv_unique with z0; auto). apply Z_div_pos; auto with zarith. } replace (Z.of_N (N_of_Z z)) with z by (destruct z; simpl; auto; elim H1; auto). rewrite Z.mul_comm; auto. Qed. #[deprecated(note="Cyclic.ZModulo will be moved to the test suite", since="8.17")] Lemma spec_zdigits : [|zdigits|] = Zpos digits. Proof. unfold to_Z, zdigits. apply Zmod_small. unfold wB, base. split; auto with zarith. apply Zpower2_lt_lin; auto with zarith. Qed. #[deprecated(note="Cyclic.ZModulo will be moved to the test suite", since="8.17")] Definition zero := 0. #[deprecated(note="Cyclic.ZModulo will be moved to the test suite", since="8.17")] Definition one := 1. #[deprecated(note="Cyclic.ZModulo will be moved to the test suite", since="8.17")] Definition minus_one := wB - 1. #[deprecated(note="Cyclic.ZModulo will be moved to the test suite", since="8.17")] Lemma spec_0 : [|zero|] = 0. Proof. unfold to_Z, zero. apply Zmod_small; generalize wB_pos. lia. Qed. #[deprecated(note="Cyclic.ZModulo will be moved to the test suite", since="8.17")] Lemma spec_1 : [|one|] = 1. Proof. unfold to_Z, one. apply Zmod_small; split; auto with zarith. unfold wB, base. apply Z.lt_trans with (Zpos digits); auto. apply Zpower2_lt_lin; auto with zarith. Qed. #[deprecated(note="Cyclic.ZModulo will be moved to the test suite", since="8.17")] Lemma spec_Bm1 : [|minus_one|] = wB - 1. Proof. unfold to_Z, minus_one. apply Zmod_small; split. 2: lia. unfold wB, base. cut (1 <= 2 ^ Zpos digits). { lia. } apply Z.le_trans with (Zpos digits). { lia. } apply Zpower2_le_lin; auto with zarith. Qed. #[deprecated(note="Cyclic.ZModulo will be moved to the test suite", since="8.17")] Definition compare x y := Z.compare [|x|] [|y|]. #[deprecated(note="Cyclic.ZModulo will be moved to the test suite", since="8.17")] Lemma spec_compare : forall x y, compare x y = Z.compare [|x|] [|y|]. Proof. reflexivity. Qed. #[deprecated(note="Cyclic.ZModulo will be moved to the test suite", since="8.17")] Definition eq0 x := match [|x|] with Z0 => true | _ => false end. #[deprecated(note="Cyclic.ZModulo will be moved to the test suite", since="8.17")] Lemma spec_eq0 : forall x, eq0 x = true -> [|x|] = 0. Proof. unfold eq0; intros; now destruct [|x|]. Qed. #[deprecated(note="Cyclic.ZModulo will be moved to the test suite", since="8.17")] Definition opp_c x := if eq0 x then C0 0 else C1 (- x). #[deprecated(note="Cyclic.ZModulo will be moved to the test suite", since="8.17")] Definition opp x := - x. #[deprecated(note="Cyclic.ZModulo will be moved to the test suite", since="8.17")] Definition opp_carry x := - x - 1. #[deprecated(note="Cyclic.ZModulo will be moved to the test suite", since="8.17")] Lemma spec_opp_c : forall x, [-|opp_c x|] = -[|x|]. Proof. intros; unfold opp_c, to_Z; auto. case_eq (eq0 x); intros; unfold interp_carry. - fold [|x|]; rewrite (spec_eq0 x H); auto. - assert (x mod wB <> 0). { unfold eq0, to_Z in H. intro H0; rewrite H0 in H; discriminate. } rewrite Z_mod_nz_opp_full; lia. Qed. #[deprecated(note="Cyclic.ZModulo will be moved to the test suite", since="8.17")] Lemma spec_opp : forall x, [|opp x|] = (-[|x|]) mod wB. Proof. intros; unfold opp, to_Z; auto. change ((- x) mod wB = (0 - (x mod wB)) mod wB). rewrite Zminus_mod_idemp_r; simpl; auto. Qed. #[deprecated(note="Cyclic.ZModulo will be moved to the test suite", since="8.17")] Lemma spec_opp_carry : forall x, [|opp_carry x|] = wB - [|x|] - 1. Proof. intros; unfold opp_carry, to_Z; auto. replace (- x - 1) with (- 1 - x) by lia. rewrite <- Zminus_mod_idemp_r. replace ( -1 - x mod wB) with (0 + ( -1 - x mod wB)) by lia. rewrite <- (Z_mod_same_full wB). rewrite Zplus_mod_idemp_l. replace (wB + (-1 - x mod wB)) with (wB - x mod wB -1) by lia. apply Zmod_small. generalize (Z_mod_lt x wB wB_pos); lia. Qed. #[deprecated(note="Cyclic.ZModulo will be moved to the test suite", since="8.17")] Definition succ_c x := let y := Z.succ x in if eq0 y then C1 0 else C0 y. #[deprecated(note="Cyclic.ZModulo will be moved to the test suite", since="8.17")] Definition add_c x y := let z := [|x|] + [|y|] in if Z_lt_le_dec z wB then C0 z else C1 (z-wB). #[deprecated(note="Cyclic.ZModulo will be moved to the test suite", since="8.17")] Definition add_carry_c x y := let z := [|x|]+[|y|]+1 in if Z_lt_le_dec z wB then C0 z else C1 (z-wB). #[deprecated(note="Cyclic.ZModulo will be moved to the test suite", since="8.17")] Definition succ := Z.succ. #[deprecated(note="Cyclic.ZModulo will be moved to the test suite", since="8.17")] Definition add := Z.add. #[deprecated(note="Cyclic.ZModulo will be moved to the test suite", since="8.17")] Definition add_carry x y := x + y + 1. #[deprecated(note="Cyclic.ZModulo will be moved to the test suite", since="8.17")] Lemma Zmod_equal : forall x y z, z>0 -> (x-y) mod z = 0 -> x mod z = y mod z. Proof. intros. generalize (Z_div_mod_eq_full (x-y) z); rewrite H0, Z.add_0_r. remember ((x-y)/z) as k. rewrite Z.sub_move_r, Z.add_comm, Z.mul_comm. intros ->. now apply Z_mod_plus. Qed. #[deprecated(note="Cyclic.ZModulo will be moved to the test suite", since="8.17")] Lemma spec_succ_c : forall x, [+|succ_c x|] = [|x|] + 1. Proof. intros; unfold succ_c, to_Z, Z.succ. case_eq (eq0 (x+1)); intros; unfold interp_carry. - rewrite Z.mul_1_l. replace (wB + 0 mod wB) with wB by auto with zarith. symmetry. rewrite Z.add_move_r. assert ((x+1) mod wB = 0) by (apply spec_eq0; auto). replace (wB-1) with ((wB-1) mod wB) by (apply Zmod_small; generalize wB_pos; lia). rewrite <- Zminus_mod_idemp_l; rewrite Z_mod_same; simpl; auto. apply Zmod_equal; auto. - assert ((x+1) mod wB <> 0). { unfold eq0, to_Z in *; now destruct ((x+1) mod wB). } assert (x mod wB + 1 <> wB). { contradict H0. rewrite Z.add_move_r in H0; simpl in H0. rewrite <- Zplus_mod_idemp_l; rewrite H0. replace (wB-1+1) with wB by lia; apply Z_mod_same; auto. } rewrite <- Zplus_mod_idemp_l. apply Zmod_small. generalize (Z_mod_lt x wB wB_pos); lia. Qed. #[deprecated(note="Cyclic.ZModulo will be moved to the test suite", since="8.17")] Lemma spec_add_c : forall x y, [+|add_c x y|] = [|x|] + [|y|]. Proof. intros; unfold add_c, to_Z, interp_carry. destruct Z_lt_le_dec. - apply Zmod_small; generalize (Z_mod_lt x wB wB_pos) (Z_mod_lt y wB wB_pos); lia. - rewrite Z.mul_1_l, Z.add_comm, Z.add_move_r. apply Zmod_small; generalize (Z_mod_lt x wB wB_pos) (Z_mod_lt y wB wB_pos); lia. Qed. #[deprecated(note="Cyclic.ZModulo will be moved to the test suite", since="8.17")] Lemma spec_add_carry_c : forall x y, [+|add_carry_c x y|] = [|x|] + [|y|] + 1. Proof. intros; unfold add_carry_c, to_Z, interp_carry. destruct Z_lt_le_dec. - apply Zmod_small; generalize (Z_mod_lt x wB wB_pos) (Z_mod_lt y wB wB_pos); lia. - rewrite Z.mul_1_l, Z.add_comm, Z.add_move_r. apply Zmod_small; generalize (Z_mod_lt x wB wB_pos) (Z_mod_lt y wB wB_pos); lia. Qed. #[deprecated(note="Cyclic.ZModulo will be moved to the test suite", since="8.17")] Lemma spec_succ : forall x, [|succ x|] = ([|x|] + 1) mod wB. Proof. intros; unfold succ, to_Z, Z.succ. symmetry; apply Zplus_mod_idemp_l. Qed. #[deprecated(note="Cyclic.ZModulo will be moved to the test suite", since="8.17")] Lemma spec_add : forall x y, [|add x y|] = ([|x|] + [|y|]) mod wB. Proof. intros; unfold add, to_Z; apply Zplus_mod. Qed. #[deprecated(note="Cyclic.ZModulo will be moved to the test suite", since="8.17")] Lemma spec_add_carry : forall x y, [|add_carry x y|] = ([|x|] + [|y|] + 1) mod wB. Proof. intros; unfold add_carry, to_Z. rewrite <- Zplus_mod_idemp_l. rewrite (Zplus_mod x y). rewrite Zplus_mod_idemp_l; auto. Qed. #[deprecated(note="Cyclic.ZModulo will be moved to the test suite", since="8.17")] Definition pred_c x := if eq0 x then C1 (wB-1) else C0 (x-1). #[deprecated(note="Cyclic.ZModulo will be moved to the test suite", since="8.17")] Definition sub_c x y := let z := [|x|]-[|y|] in if Z_lt_le_dec z 0 then C1 (wB+z) else C0 z. #[deprecated(note="Cyclic.ZModulo will be moved to the test suite", since="8.17")] Definition sub_carry_c x y := let z := [|x|]-[|y|]-1 in if Z_lt_le_dec z 0 then C1 (wB+z) else C0 z. #[deprecated(note="Cyclic.ZModulo will be moved to the test suite", since="8.17")] Definition pred := Z.pred. #[deprecated(note="Cyclic.ZModulo will be moved to the test suite", since="8.17")] Definition sub := Z.sub. #[deprecated(note="Cyclic.ZModulo will be moved to the test suite", since="8.17")] Definition sub_carry x y := x - y - 1. #[deprecated(note="Cyclic.ZModulo will be moved to the test suite", since="8.17")] Lemma spec_pred_c : forall x, [-|pred_c x|] = [|x|] - 1. Proof. intros; unfold pred_c, to_Z, interp_carry. case_eq (eq0 x); intros. - fold [|x|]; rewrite spec_eq0; auto. replace ((wB-1) mod wB) with (wB-1). + lia. + symmetry; apply Zmod_small; generalize wB_pos; lia. - assert (x mod wB <> 0). + unfold eq0, to_Z in *; now destruct (x mod wB). + rewrite <- Zminus_mod_idemp_l. apply Zmod_small. generalize (Z_mod_lt x wB wB_pos); lia. Qed. #[deprecated(note="Cyclic.ZModulo will be moved to the test suite", since="8.17")] Lemma spec_sub_c : forall x y, [-|sub_c x y|] = [|x|] - [|y|]. Proof. intros; unfold sub_c, to_Z, interp_carry. destruct Z_lt_le_dec. - replace ((wB + (x mod wB - y mod wB)) mod wB) with (wB + (x mod wB - y mod wB)). + lia. + symmetry; apply Zmod_small. generalize wB_pos (Z_mod_lt x wB wB_pos) (Z_mod_lt y wB wB_pos); lia. - apply Zmod_small. generalize wB_pos (Z_mod_lt x wB wB_pos) (Z_mod_lt y wB wB_pos); lia. Qed. #[deprecated(note="Cyclic.ZModulo will be moved to the test suite", since="8.17")] Lemma spec_sub_carry_c : forall x y, [-|sub_carry_c x y|] = [|x|] - [|y|] - 1. Proof. intros; unfold sub_carry_c, to_Z, interp_carry. destruct Z_lt_le_dec. - replace ((wB + (x mod wB - y mod wB - 1)) mod wB) with (wB + (x mod wB - y mod wB -1)). + lia. + symmetry; apply Zmod_small. generalize wB_pos (Z_mod_lt x wB wB_pos) (Z_mod_lt y wB wB_pos); lia. - apply Zmod_small. generalize wB_pos (Z_mod_lt x wB wB_pos) (Z_mod_lt y wB wB_pos); lia. Qed. #[deprecated(note="Cyclic.ZModulo will be moved to the test suite", since="8.17")] Lemma spec_pred : forall x, [|pred x|] = ([|x|] - 1) mod wB. Proof. intros; unfold pred, to_Z, Z.pred. rewrite <- Zplus_mod_idemp_l; auto. Qed. #[deprecated(note="Cyclic.ZModulo will be moved to the test suite", since="8.17")] Lemma spec_sub : forall x y, [|sub x y|] = ([|x|] - [|y|]) mod wB. Proof. intros; unfold sub, to_Z; apply Zminus_mod. Qed. #[deprecated(note="Cyclic.ZModulo will be moved to the test suite", since="8.17")] Lemma spec_sub_carry : forall x y, [|sub_carry x y|] = ([|x|] - [|y|] - 1) mod wB. Proof. intros; unfold sub_carry, to_Z. rewrite <- Zminus_mod_idemp_l. rewrite (Zminus_mod x y). rewrite Zminus_mod_idemp_l. auto. Qed. #[deprecated(note="Cyclic.ZModulo will be moved to the test suite", since="8.17")] Definition mul_c x y := let (h,l) := Z.div_eucl ([|x|]*[|y|]) wB in if eq0 h then if eq0 l then W0 else WW h l else WW h l. #[deprecated(note="Cyclic.ZModulo will be moved to the test suite", since="8.17")] Definition mul := Z.mul. #[deprecated(note="Cyclic.ZModulo will be moved to the test suite", since="8.17")] Definition square_c x := mul_c x x. #[deprecated(note="Cyclic.ZModulo will be moved to the test suite", since="8.17")] Lemma spec_mul_c : forall x y, [|| mul_c x y ||] = [|x|] * [|y|]. Proof. intros; unfold mul_c, zn2z_to_Z. assert (Z.div_eucl ([|x|]*[|y|]) wB = (([|x|]*[|y|])/wB,([|x|]*[|y|]) mod wB)). - unfold Z.modulo, Z.div; destruct Z.div_eucl; auto. - generalize (Z_div_mod ([|x|]*[|y|]) wB wB_pos); destruct Z.div_eucl as (h,l). destruct 1; injection H as [= ? ?]. rewrite H0. assert ([|l|] = l). + apply Zmod_small; auto. + assert ([|h|] = h). * apply Zmod_small. subst h. split. -- apply Z_div_pos; auto with zarith. -- apply Zdiv_lt_upper_bound. ++ lia. ++ apply Z.mul_lt_mono_nonneg; auto with zarith. * clear H H0 H1 H2. case_eq (eq0 h); simpl; intros. -- case_eq (eq0 l); simpl; intros. ++ rewrite <- H3, <- H4, (spec_eq0 h), (spec_eq0 l); auto. lia. ++ rewrite H3, H4; auto with zarith. -- rewrite H3, H4; auto with zarith. Qed. #[deprecated(note="Cyclic.ZModulo will be moved to the test suite", since="8.17")] Lemma spec_mul : forall x y, [|mul x y|] = ([|x|] * [|y|]) mod wB. Proof. intros; unfold mul, to_Z; apply Zmult_mod. Qed. #[deprecated(note="Cyclic.ZModulo will be moved to the test suite", since="8.17")] Lemma spec_square_c : forall x, [|| square_c x||] = [|x|] * [|x|]. Proof. intros x; exact (spec_mul_c x x). Qed. #[deprecated(note="Cyclic.ZModulo will be moved to the test suite", since="8.17")] Definition div x y := Z.div_eucl [|x|] [|y|]. #[deprecated(note="Cyclic.ZModulo will be moved to the test suite", since="8.17")] Lemma spec_div : forall a b, 0 < [|b|] -> let (q,r) := div a b in [|a|] = [|q|] * [|b|] + [|r|] /\ 0 <= [|r|] < [|b|]. Proof. intros; unfold div. assert ([|b|]>0) by lia. assert (Z.div_eucl [|a|] [|b|] = ([|a|]/[|b|], [|a|] mod [|b|])). { unfold Z.modulo, Z.div; destruct Z.div_eucl; auto. } generalize (Z_div_mod [|a|] [|b|] H0). destruct Z.div_eucl as (q,r); destruct 1; intros. injection H1 as [= ? ?]. assert ([|r|]=r). { apply Zmod_small; generalize (Z_mod_lt b wB wB_pos); fold [|b|]; lia. } assert ([|q|]=q). { apply Zmod_small. subst q. split. - apply Z_div_pos; auto with zarith. - apply Zdiv_lt_upper_bound; auto with zarith. apply Z.lt_le_trans with (wB*1). + rewrite Z.mul_1_r; auto with zarith. + apply Z.mul_le_mono_nonneg; generalize wB_pos; lia. } rewrite H5, H6; rewrite Z.mul_comm; auto with zarith. Qed. #[deprecated(note="Cyclic.ZModulo will be moved to the test suite", since="8.17")] Definition div_gt := div. #[deprecated(note="Cyclic.ZModulo will be moved to the test suite", since="8.17")] Lemma spec_div_gt : forall a b, [|a|] > [|b|] -> 0 < [|b|] -> let (q,r) := div_gt a b in [|a|] = [|q|] * [|b|] + [|r|] /\ 0 <= [|r|] < [|b|]. Proof. intros. apply spec_div; auto. Qed. #[deprecated(note="Cyclic.ZModulo will be moved to the test suite", since="8.17")] Definition modulo x y := [|x|] mod [|y|]. #[deprecated(note="Cyclic.ZModulo will be moved to the test suite", since="8.17")] Definition modulo_gt x y := [|x|] mod [|y|]. #[deprecated(note="Cyclic.ZModulo will be moved to the test suite", since="8.17")] Lemma spec_modulo : forall a b, 0 < [|b|] -> [|modulo a b|] = [|a|] mod [|b|]. Proof. intros; unfold modulo. apply Zmod_small. assert ([|b|]>0) by lia. generalize (Z_mod_lt [|a|] [|b|] H0) (Z_mod_lt b wB wB_pos). fold [|b|]; lia. Qed. #[deprecated(note="Cyclic.ZModulo will be moved to the test suite", since="8.17")] Lemma spec_modulo_gt : forall a b, [|a|] > [|b|] -> 0 < [|b|] -> [|modulo_gt a b|] = [|a|] mod [|b|]. Proof. intros; apply spec_modulo; auto. Qed. #[deprecated(note="Cyclic.ZModulo will be moved to the test suite", since="8.17")] Definition gcd x y := Z.gcd [|x|] [|y|]. #[deprecated(note="Cyclic.ZModulo will be moved to the test suite", since="8.17")] Definition gcd_gt x y := Z.gcd [|x|] [|y|]. #[deprecated(note="Cyclic.ZModulo will be moved to the test suite", since="8.17")] Lemma Zgcd_bound : forall a b, 0<=a -> 0<=b -> Z.gcd a b <= Z.max a b. Proof. intros. generalize (Zgcd_is_gcd a b); inversion_clear 1. destruct H2 as (q,H2); destruct H3 as (q',H3); clear H4. assert (H4:=Z.gcd_nonneg a b). destruct (Z.eq_dec (Z.gcd a b) 0) as [->|Hneq]. - generalize (Zmax_spec a b); lia. - assert (0 <= q). { apply Z.mul_le_mono_pos_r with (Z.gcd a b); lia. } destruct (Z.eq_dec q 0). + subst q; simpl in *; subst a; simpl; auto. generalize (Zmax_spec 0 b) (Zabs_spec b); lia. + apply Z.le_trans with a. * rewrite H2 at 2. rewrite <- (Z.mul_1_l (Z.gcd a b)) at 1. apply Z.mul_le_mono_nonneg; lia. * generalize (Zmax_spec a b); lia. Qed. #[deprecated(note="Cyclic.ZModulo will be moved to the test suite", since="8.17")] Lemma spec_gcd : forall a b, Zis_gcd [|a|] [|b|] [|gcd a b|]. Proof. intros; unfold gcd. generalize (Z_mod_lt a wB wB_pos)(Z_mod_lt b wB wB_pos); intros. fold [|a|] in *; fold [|b|] in *. replace ([|Z.gcd [|a|] [|b|]|]) with (Z.gcd [|a|] [|b|]). - apply Zgcd_is_gcd. - symmetry; apply Zmod_small. split. + apply Z.gcd_nonneg. + apply Z.le_lt_trans with (Z.max [|a|] [|b|]). * apply Zgcd_bound; auto with zarith. * generalize (Zmax_spec [|a|] [|b|]); lia. Qed. #[deprecated(note="Cyclic.ZModulo will be moved to the test suite", since="8.17")] Lemma spec_gcd_gt : forall a b, [|a|] > [|b|] -> Zis_gcd [|a|] [|b|] [|gcd_gt a b|]. Proof. intros. apply spec_gcd; auto. Qed. #[deprecated(note="Cyclic.ZModulo will be moved to the test suite", since="8.17")] Definition div21 a1 a2 b := Z.div_eucl ([|a1|]*wB+[|a2|]) [|b|]. #[deprecated(note="Cyclic.ZModulo will be moved to the test suite", since="8.17")] Lemma spec_div21 : forall a1 a2 b, wB/2 <= [|b|] -> [|a1|] < [|b|] -> let (q,r) := div21 a1 a2 b in [|a1|] *wB+ [|a2|] = [|q|] * [|b|] + [|r|] /\ 0 <= [|r|] < [|b|]. Proof. intros; unfold div21. generalize (Z_mod_lt a1 wB wB_pos); fold [|a1|]; intros. generalize (Z_mod_lt a2 wB wB_pos); fold [|a2|]; intros. assert ([|b|]>0) by lia. remember ([|a1|]*wB+[|a2|]) as a. assert (Z.div_eucl a [|b|] = (a/[|b|], a mod [|b|])). { unfold Z.modulo, Z.div; destruct Z.div_eucl; auto. } generalize (Z_div_mod a [|b|] H3). destruct Z.div_eucl as (q,r); destruct 1; intros. injection H4 as [= ? ?]. assert ([|r|]=r). { apply Zmod_small; generalize (Z_mod_lt b wB wB_pos); fold [|b|]; lia. } assert ([|q|]=q). { apply Zmod_small. subst q. split. - apply Z_div_pos. + lia. + subst a. nia. - apply Zdiv_lt_upper_bound; nia. } subst a. replace (wB*[|b|]) with (([|b|]-1)*wB + wB) by ring. lia. Qed. #[deprecated(note="Cyclic.ZModulo will be moved to the test suite", since="8.17")] Definition add_mul_div p x y := ([|x|] * (2 ^ [|p|]) + [|y|] / (2 ^ ((Zpos digits) - [|p|]))). #[deprecated(note="Cyclic.ZModulo will be moved to the test suite", since="8.17")] Lemma spec_add_mul_div : forall x y p, [|p|] <= Zpos digits -> [| add_mul_div p x y |] = ([|x|] * (2 ^ [|p|]) + [|y|] / (2 ^ ((Zpos digits) - [|p|]))) mod wB. Proof. intros; unfold add_mul_div; auto. Qed. #[deprecated(note="Cyclic.ZModulo will be moved to the test suite", since="8.17")] Definition pos_mod p w := [|w|] mod (2 ^ [|p|]). #[deprecated(note="Cyclic.ZModulo will be moved to the test suite", since="8.17")] Lemma spec_pos_mod : forall w p, [|pos_mod p w|] = [|w|] mod (2 ^ [|p|]). Proof. intros; unfold pos_mod. apply Zmod_small. generalize (Z_mod_lt [|w|] (2 ^ [|p|])); intros. split. - destruct H; auto using Z.lt_gt with zarith. - apply Z.le_lt_trans with [|w|]; auto with zarith. apply Zmod_le; auto with zarith. Qed. #[deprecated(note="Cyclic.ZModulo will be moved to the test suite", since="8.17")] Definition is_even x := if Z.eq_dec ([|x|] mod 2) 0 then true else false. #[deprecated(note="Cyclic.ZModulo will be moved to the test suite", since="8.17")] Lemma spec_is_even : forall x, if is_even x then [|x|] mod 2 = 0 else [|x|] mod 2 = 1. Proof. intros; unfold is_even; destruct Z.eq_dec; auto. generalize (Z_mod_lt [|x|] 2); lia. Qed. #[deprecated(note="Cyclic.ZModulo will be moved to the test suite", since="8.17")] Definition sqrt x := Z.sqrt [|x|]. #[deprecated(note="Cyclic.ZModulo will be moved to the test suite", since="8.17")] Lemma spec_sqrt : forall x, [|sqrt x|] ^ 2 <= [|x|] < ([|sqrt x|] + 1) ^ 2. Proof. intros. unfold sqrt. repeat rewrite Z.pow_2_r. replace [|Z.sqrt [|x|]|] with (Z.sqrt [|x|]). - apply Z.sqrt_spec; auto with zarith. - symmetry; apply Zmod_small. split. + apply Z.sqrt_nonneg; auto. + apply Z.le_lt_trans with [|x|]; auto. apply Z.sqrt_le_lin; auto. Qed. #[deprecated(note="Cyclic.ZModulo will be moved to the test suite", since="8.17")] Definition sqrt2 x y := let z := [|x|]*wB+[|y|] in match z with | Z0 => (0, C0 0) | Zpos p => let (s,r) := Z.sqrtrem (Zpos p) in (s, if Z_lt_le_dec r wB then C0 r else C1 (r-wB)) | Zneg _ => (0, C0 0) end. #[deprecated(note="Cyclic.ZModulo will be moved to the test suite", since="8.17")] Lemma spec_sqrt2 : forall x y, wB/ 4 <= [|x|] -> let (s,r) := sqrt2 x y in [||WW x y||] = [|s|] ^ 2 + [+|r|] /\ [+|r|] <= 2 * [|s|]. Proof. intros; unfold sqrt2. simpl zn2z_to_Z. remember ([|x|]*wB+[|y|]) as z. destruct z. - auto with zarith. - generalize (Z.sqrtrem_spec (Zpos p)). destruct Z.sqrtrem as (s,r); intros [U V]. { lia. } assert (s < wB). { destruct (Z_lt_le_dec s wB); auto. assert (wB * wB <= Zpos p). { apply Z.le_trans with (s*s). 2: lia. apply Z.mul_le_mono_nonneg; generalize wB_pos; lia. } assert (Zpos p < wB*wB). { rewrite Heqz. replace (wB*wB) with ((wB-1)*wB+wB) by ring. apply Z.add_le_lt_mono. 2: auto with zarith. apply Z.mul_le_mono_nonneg. 1, 3-4: auto with zarith. 1:generalize wB_pos; lia. generalize (spec_to_Z x); lia. } auto with zarith. } replace [|s|] with s by (symmetry; apply Zmod_small; lia). destruct Z_lt_le_dec; unfold interp_carry. + replace [|r|] with r by (symmetry; apply Zmod_small; lia). rewrite Z.pow_2_r; lia. + replace [|r-wB|] with (r-wB) by (symmetry; apply Zmod_small; lia). rewrite Z.pow_2_r; lia. - assert (0<=Zneg p). { generalize (spec_to_Z x) (spec_to_Z y); nia. } lia. Qed. #[deprecated(note="Cyclic.ZModulo will be moved to the test suite", since="8.17")] Lemma two_p_power2 : forall x, x>=0 -> two_p x = 2 ^ x. Proof. intros. unfold two_p. destruct x; simpl; auto. apply two_power_pos_correct. Qed. #[deprecated(note="Cyclic.ZModulo will be moved to the test suite", since="8.17")] Definition head0 x := match [| x |] with | Z0 => zdigits | Zneg _ => 0 | (Zpos _) as p => zdigits - Z.log2 p - 1 end. #[deprecated(note="Cyclic.ZModulo will be moved to the test suite", since="8.17")] Lemma spec_head00: forall x, [|x|] = 0 -> [|head0 x|] = Zpos digits. Proof. unfold head0; intros x ->; apply spec_zdigits. Qed. #[deprecated(note="Cyclic.ZModulo will be moved to the test suite", since="8.17")] Lemma spec_head0 : forall x, 0 < [|x|] -> wB/ 2 <= 2 ^ ([|head0 x|]) * [|x|] < wB. Proof. intros; unfold head0. generalize (spec_to_Z x). destruct [|x|]; try discriminate. pose proof (Z.log2_nonneg (Zpos p)). destruct (Z.log2_spec (Zpos p)); auto. intros. assert (0 <= zdigits - Z.log2 (Zpos p) - 1 < wB) as Hrange. { split. - cut (Z.log2 (Zpos p) < zdigits). + lia. + unfold zdigits. unfold wB, base in *. apply Z.log2_lt_pow2; intuition. - apply Z.lt_trans with zdigits. + lia. + unfold zdigits, wB, base; apply Zpower2_lt_lin; auto with zarith. } unfold to_Z; rewrite (Zmod_small _ _ Hrange). split. - apply Z.le_trans with (2^(zdigits - Z.log2 (Zpos p) - 1)*(2^Z.log2 (Zpos p))). + apply Zdiv_le_upper_bound; auto with zarith. rewrite <- Zpower_exp; auto with zarith. rewrite Z.mul_comm; rewrite <- Z.pow_succ_r; auto with zarith. replace (Z.succ (zdigits - Z.log2 (Zpos p) -1 + Z.log2 (Zpos p))) with zdigits by ring. unfold wB, base, zdigits; auto with zarith. + apply Z.mul_le_mono_nonneg; auto with zarith. - apply Z.lt_le_trans with (2^(zdigits - Z.log2 (Zpos p) - 1)*(2^(Z.succ (Z.log2 (Zpos p))))). + apply Z.mul_lt_mono_pos_l; auto with zarith. + rewrite <- Zpower_exp; auto with zarith. replace (zdigits - Z.log2 (Zpos p) -1 +Z.succ (Z.log2 (Zpos p))) with zdigits by ring. unfold wB, base, zdigits; auto with zarith. Qed. #[deprecated(note="Cyclic.ZModulo will be moved to the test suite", since="8.17")] Fixpoint Ptail p := match p with | xO p => (Ptail p)+1 | _ => 0 end. #[deprecated(note="Cyclic.ZModulo will be moved to the test suite", since="8.17")] Lemma Ptail_pos : forall p, 0 <= Ptail p. Proof. induction p; simpl; auto with zarith. Qed. #[local] Hint Resolve Ptail_pos : core. #[deprecated(note="Cyclic.ZModulo will be moved to the test suite", since="8.17")] Lemma Ptail_bounded : forall p d, Zpos p < 2^(Zpos d) -> Ptail p < Zpos d. Proof. induction p; try (compute; auto; fail). intros; simpl. assert (d <> xH). { intro; subst. compute in H; destruct p; discriminate. } assert (Z.succ (Zpos (Pos.pred d)) = Zpos d). { simpl; f_equal. rewrite Pos.add_1_r. destruct (Pos.succ_pred_or d); auto. rewrite H1 in H0; elim H0; auto. } assert (Ptail p < Zpos (Pos.pred d)). { apply IHp. apply Z.mul_lt_mono_pos_r with 2; auto with zarith. rewrite (Z.mul_comm (Zpos p)). change (2 * Zpos p) with (Zpos p~0). rewrite Z.mul_comm. rewrite <- Z.pow_succ_r; auto with zarith. rewrite H1; auto. } rewrite <- H1; lia. Qed. #[deprecated(note="Cyclic.ZModulo will be moved to the test suite", since="8.17")] Definition tail0 x := match [|x|] with | Z0 => zdigits | Zpos p => Ptail p | Zneg _ => 0 end. #[deprecated(note="Cyclic.ZModulo will be moved to the test suite", since="8.17")] Lemma spec_tail00: forall x, [|x|] = 0 -> [|tail0 x|] = Zpos digits. Proof. unfold tail0; intros. rewrite H; simpl. apply spec_zdigits. Qed. #[deprecated(note="Cyclic.ZModulo will be moved to the test suite", since="8.17")] Lemma spec_tail0 : forall x, 0 < [|x|] -> exists y, 0 <= y /\ [|x|] = (2 * y + 1) * (2 ^ [|tail0 x|]). Proof. intros; unfold tail0. generalize (spec_to_Z x). destruct [|x|]; try discriminate; intros. assert ([|Ptail p|] = Ptail p). { apply Zmod_small. split; auto. unfold wB, base in *. apply Z.lt_trans with (Zpos digits). - apply Ptail_bounded; auto with zarith. - apply Zpower2_lt_lin; auto with zarith. } rewrite H1. clear; induction p. - exists (Zpos p); simpl; rewrite Pos.mul_1_r; auto with zarith. - destruct IHp as (y & Yp & Ye). exists y. split; auto. change (Zpos p~0) with (2*Zpos p). rewrite Ye. change (Ptail p~0) with (Z.succ (Ptail p)). rewrite Z.pow_succ_r; auto; ring. - exists 0; simpl; auto with zarith. Qed. #[deprecated(note="Cyclic.ZModulo will be moved to the test suite", since="8.17")] Definition lor := Z.lor. #[deprecated(note="Cyclic.ZModulo will be moved to the test suite", since="8.17")] Definition land := Z.land. #[deprecated(note="Cyclic.ZModulo will be moved to the test suite", since="8.17")] Definition lxor := Z.lxor. #[deprecated(note="Cyclic.ZModulo will be moved to the test suite", since="8.17")] Lemma spec_lor x y : [|lor x y|] = Z.lor [|x|] [|y|]. Proof. unfold lor, to_Z. apply Z.bits_inj'; intros n Hn. rewrite Z.lor_spec. unfold wB, base. destruct (Z.le_gt_cases (Z.pos digits) n). - rewrite !Z.mod_pow2_bits_high; auto with zarith. - rewrite !Z.mod_pow2_bits_low, Z.lor_spec; auto with zarith. Qed. #[deprecated(note="Cyclic.ZModulo will be moved to the test suite", since="8.17")] Lemma spec_land x y : [|land x y|] = Z.land [|x|] [|y|]. Proof. unfold land, to_Z. apply Z.bits_inj'; intros n Hn. rewrite Z.land_spec. unfold wB, base. destruct (Z.le_gt_cases (Z.pos digits) n). - rewrite !Z.mod_pow2_bits_high; auto with zarith. - rewrite !Z.mod_pow2_bits_low, Z.land_spec; auto with zarith. Qed. #[deprecated(note="Cyclic.ZModulo will be moved to the test suite", since="8.17")] Lemma spec_lxor x y : [|lxor x y|] = Z.lxor [|x|] [|y|]. Proof. unfold lxor, to_Z. apply Z.bits_inj'; intros n Hn. rewrite Z.lxor_spec. unfold wB, base. destruct (Z.le_gt_cases (Z.pos digits) n). - rewrite !Z.mod_pow2_bits_high; auto with zarith. - rewrite !Z.mod_pow2_bits_low, Z.lxor_spec; auto with zarith. Qed. (** Let's now group everything in two records *) #[deprecated(note="Cyclic.ZModulo will be moved to the test suite", since="8.17")] Definition zmod_ops : ZnZ.Ops Z := ZnZ.MkOps (digits : positive) (zdigits: t) (to_Z : t -> Z) (of_pos : positive -> N * t) (head0 : t -> t) (tail0 : t -> t) (zero : t) (one : t) (minus_one : t) (compare : t -> t -> comparison) (eq0 : t -> bool) (opp_c : t -> carry t) (opp : t -> t) (opp_carry : t -> t) (succ_c : t -> carry t) (add_c : t -> t -> carry t) (add_carry_c : t -> t -> carry t) (succ : t -> t) (add : t -> t -> t) (add_carry : t -> t -> t) (pred_c : t -> carry t) (sub_c : t -> t -> carry t) (sub_carry_c : t -> t -> carry t) (pred : t -> t) (sub : t -> t -> t) (sub_carry : t -> t -> t) (mul_c : t -> t -> zn2z t) (mul : t -> t -> t) (square_c : t -> zn2z t) (div21 : t -> t -> t -> t*t) (div_gt : t -> t -> t * t) (div : t -> t -> t * t) (modulo_gt : t -> t -> t) (modulo : t -> t -> t) (gcd_gt : t -> t -> t) (gcd : t -> t -> t) (add_mul_div : t -> t -> t -> t) (pos_mod : t -> t -> t) (is_even : t -> bool) (sqrt2 : t -> t -> t * carry t) (sqrt : t -> t) (lor : t -> t -> t) (land : t -> t -> t) (lxor : t -> t -> t). Existing Instance zmod_ops. #[deprecated(note="Cyclic.ZModulo will be moved to the test suite", since="8.17")] Definition zmod_specs : ZnZ.Specs zmod_ops := ZnZ.MkSpecs spec_to_Z spec_of_pos spec_zdigits spec_more_than_1_digit spec_0 spec_1 spec_Bm1 spec_compare spec_eq0 spec_opp_c spec_opp spec_opp_carry spec_succ_c spec_add_c spec_add_carry_c spec_succ spec_add spec_add_carry spec_pred_c spec_sub_c spec_sub_carry_c spec_pred spec_sub spec_sub_carry spec_mul_c spec_mul spec_square_c spec_div21 spec_div_gt spec_div spec_modulo_gt spec_modulo spec_gcd_gt spec_gcd spec_head00 spec_head0 spec_tail00 spec_tail0 spec_add_mul_div spec_pos_mod spec_is_even spec_sqrt2 spec_sqrt spec_lor spec_land spec_lxor. Existing Instance zmod_specs. End ZModulo. (** A modular version of the previous construction. *) Module Type PositiveNotOne. #[deprecated(note="Cyclic.ZModulo will be moved to the test suite", since="8.17")] Parameter p : positive. #[deprecated(note="Cyclic.ZModulo will be moved to the test suite", since="8.17")] Axiom not_one : p <> 1%positive. End PositiveNotOne. Module ZModuloCyclicType (P:PositiveNotOne) <: CyclicType. #[deprecated(note="Cyclic.ZModulo will be moved to the test suite", since="8.17")] Definition t := Z. #[global] #[deprecated(note="Cyclic.ZModulo will be moved to the test suite", since="8.17")] Definition ops : ZnZ.Ops t := zmod_ops P.p. Existing Instance ops. #[global] #[deprecated(note="Cyclic.ZModulo will be moved to the test suite", since="8.17")] Definition specs : ZnZ.Specs ops := zmod_specs P.not_one. Existing Instance specs. End ZModuloCyclicType. coq-8.20.0/test-suite/success/abstract_chain.v000066400000000000000000000015651466560755400213260ustar00rootroot00000000000000Lemma foo1 : nat -> True. Proof. intros _. assert (H : True -> True). { abstract (exact (fun x => x)) using bar. } assert (H' : True). { abstract (exact (bar I)) using qux. } exact H'. Qed. Lemma foo2 : True. Proof. assert (H : True -> True). { abstract (exact (fun x => x)) using bar. } assert (H' : True). { abstract (exact (bar I)) using qux. } assert (H'' : True). { abstract (exact (bar qux)) using quz. } exact H''. Qed. Set Universe Polymorphism. Lemma foo3 : nat -> True. Proof. intros _. assert (H : True -> True). { abstract (exact (fun x => x)) using bar. } assert (H' : True). { abstract (exact (bar I)) using qux. } exact H'. Qed. Lemma foo4 : True. Proof. assert (H : True -> True). { abstract (exact (fun x => x)) using bar. } assert (H' : True). { abstract (exact (bar I)) using qux. } assert (H'' : True). { abstract (exact (bar qux)) using quz. } exact H''. Qed. coq-8.20.0/test-suite/success/abstract_poly.v000066400000000000000000000010011466560755400212100ustar00rootroot00000000000000Set Universe Polymorphism. Inductive path@{i} {A : Type@{i}} (x : A) : A -> Type@{i} := refl : path x x. Inductive unit@{i} : Type@{i} := tt. Lemma foo@{i j} : forall (m n : unit@{i}) (P : unit -> Type@{j}), path m n -> P m -> P n. Proof. intros m n P e p. abstract (rewrite e in p; exact p). Defined. Check foo_subproof@{Set Set}. Lemma bar : forall (m n : unit) (P : unit -> Type), path m n -> P m -> P n. Proof. intros m n P e p. abstract (rewrite e in p; exact p). Defined. Check bar_subproof@{Set Set}. coq-8.20.0/test-suite/success/abstract_with_evars.v000066400000000000000000000011171466560755400224100ustar00rootroot00000000000000 Goal unit. let x := open_constr:(_) in let _ := open_constr:(eq_refl : x = tt) in abstract (exact x). Qed. Goal unit. let x := open_constr:(_) in let tac := exact x in (* <- this is a closure *) let _ := open_constr:(eq_refl : x = tt) in abstract tac. Qed. Goal unit. Fail let x := open_constr:(_) in abstract exact x. Abort. Require Import Ltac2.Ltac2. Goal unit. let x := '_ in let _ := '(eq_refl : $x = tt) in abstract (exact $x). Qed. Goal unit. let x := '_ in let tac () := exact $x in let _ := '(eq_refl : $x = tt) in abstract (tac ()). Qed. coq-8.20.0/test-suite/success/all_check.v000066400000000000000000000000441466560755400202550ustar00rootroot00000000000000Goal True. Fail all:Check _. Abort. coq-8.20.0/test-suite/success/apply.v000066400000000000000000000357731466560755400175160ustar00rootroot00000000000000(* Test apply in *) Goal (forall x y, x = S y -> y=y) -> 2 = 4 -> 3=3. intros H H0. apply H in H0. assumption. Qed. Require Import ZArith. Goal (forall x y z, ~ z <= 0 -> x * z < y * z -> x <= y)%Z. intros; apply Znot_le_gt, Z.gt_lt in H. apply Zmult_lt_reg_r, Z.lt_le_incl in H0; auto. Qed. (* Test application under tuples *) Goal (forall x, x=0 <-> 0=x) -> 1=0 -> 0=1. intros H H'. apply H in H'. exact H'. Qed. (* Test as clause *) Goal (forall x, x=0 <-> (0=x /\ True)) -> 1=0 -> True. intros H H'. apply H in H' as (_,H'). exact H'. Qed. (* Test application modulo conversion *) Goal (forall x, id x = 0 -> 0 = x) -> 1 = id 0 -> 0 = 1. intros H H'. apply H in H'. exact H'. Qed. (* Check apply/eapply distinction in presence of open terms *) Parameter h : forall x y z : nat, x = z -> x = y. Arguments h {x y}. Goal 1 = 0 -> True. intro H. apply h in H || exact I. Qed. Goal False -> 1 = 0. intro H. apply h || contradiction. Qed. (* Check if it unfolds when there are not enough premises *) Goal forall n, n = S n -> False. intros. apply n_Sn in H. assumption. Qed. (* Check naming in with bindings: do not rename *) Notation S':=S (only parsing). Goal (forall S, S = S' S) -> (forall S, S = S' S). intros. apply H with (S := S). Qed. (* Check inference of implicit arguments in bindings *) Goal exists y : nat -> Type, y 0 = y 0. exists (fun x => True). trivial. Qed. (* Check universe handling in typed unificationn *) Definition E := Type. Goal exists y : E, y = y. exists Prop. trivial. Qed. Parameter Eq : Prop = (Prop -> Prop) :> E. Goal Prop. rewrite Eq. Abort. (* Check insertion of coercions in bindings *) Coercion eq_true : bool >-> Sortclass. Goal exists A:Prop, A = A. exists true. trivial. Qed. (* Check use of unification of bindings types in specialize *) Module Type Test. Parameter P : nat -> Prop. Parameter L : forall (l : nat), P l -> P l. Goal P 0 -> True. intros. specialize L with (1:=H). Abort. End Test. (* Two examples that show that hnf_constr is used when unifying types of bindings (a simplification of a script from Field_Theory) *) Require Import List. Open Scope list_scope. Fixpoint P (l : list nat) : Prop := match l with | nil => True | e1 :: nil => e1 = e1 | e1 :: l1 => e1 = e1 /\ P l1 end. Parameter L : forall n l, P (n::l) -> P l. Goal forall (x:nat) l, P (x::l) -> P l. intros. apply L with (1:=H). Qed. Goal forall (x:nat) l, match l with nil => x=x | _::_ => x=x /\ P l end -> P l. intros. apply L with (1:=H). Qed. (* The following call to auto fails if the type of the clause associated to the H is not beta-reduced [but apply H works] (a simplification of a script from FSetAVL) *) Definition apply (f:nat->Prop) := forall x, f x. Goal apply (fun n => n=0) -> 1=0. intro H. auto. Qed. (* The following fails if the coercion Zpos is not introduced around p before trying a subterm that matches the left-hand-side of the equality (a simplication of an example taken from Nijmegen/QArith) *) Require Import ZArith. Coercion Zpos : positive >-> Z. Parameter f : Z -> Z -> Z. Parameter g : forall q1 q2 p : Z, f (f q1 p) (f q2 p) = Z0. Goal forall p q1 q2, f (f q1 (Zpos p)) (f q2 (Zpos p)) = Z0. intros; rewrite g with (p:=p). reflexivity. Qed. (* A funny example where the behavior differs depending on which of a multiple solution to a unification problem is chosen (an instance of this case can be found in the proof of Buchberger.BuchRed.nf_divp) *) Definition succ x := S x. Goal forall (I : nat -> Set) (P : nat -> Prop) (Q : forall n:nat, I n -> Prop), (forall x y, P x -> Q x y) -> (forall x, P (S x)) -> forall y: I (S 0), Q (succ 0) y. intros. apply H with (y:=y). (* [x] had two possible instances: [S 0], coming from unifying the type of [y] with [I ?n] and [succ 0] coming from the unification with the goal; only the first one allows the next apply (which does not work modulo delta) work *) apply H0. Qed. (* A similar example with a arbitrary long conversion between the two possible instances *) Fixpoint compute_succ x := match x with O => S 0 | S n => S (compute_succ n) end. Goal forall (I : nat -> Set) (P : nat -> Prop) (Q : forall n:nat, I n -> Prop), (forall x y, P x -> Q x y) -> (forall x, P (S x)) -> forall y: I (S 100), Q (compute_succ 100) y. intros. apply H with (y:=y). apply H0. Qed. (* Another example with multiple convertible solutions to the same metavariable (extracted from Algebra.Hom_module.Hom_module, 10th subgoal which precisely fails) *) Definition ID (A:Type) := A. Goal forall f:Type -> Type, forall (P : forall A:Type, A -> Prop), (forall (B:Type) x, P (f B) x -> P (f B) x) -> (forall (A:Type) x, P (f (f A)) x) -> forall (A:Type) (x:f (f A)), P (f (ID (f A))) x. intros. apply H. (* The parameter [B] had two possible instances: [ID (f A)] by direct unification and [f A] by unification of the type of [x]; only the first choice makes the next command fail, as it was (unfortunately?) in Hom_module *) try apply H. unfold ID; apply H0. Qed. (* Test hyp in "apply -> ... in hyp" is correctly instantiated by Ltac *) Goal (True <-> False) -> True -> False. intros Heq H. match goal with [ H : True |- _ ] => apply -> Heq in H end. Abort. (* Test coercion below product and on non meta-free terms in with bindings *) (* Cf wishes #1408 from E. Makarov *) Parameter bool_Prop :> bool -> Prop. Parameter r : bool -> bool -> bool. Axiom ax : forall (A : Set) (R : A -> A -> Prop) (x y : A), R x y. Theorem t : r true false. apply ax with (R := r). Qed. (* Check verification of type at unification (submitted by Stéphane Lengrand): without verification, the first "apply" works what leads to the incorrect instantiation of x by Prop *) Theorem u : ~(forall x:Prop, ~x). unfold not. intro. eapply H. apply (forall B:Prop,B->B) || (instantiate (1:=True); exact I). Defined. (* Fine-tuning coercion insertion in presence of unfolding (bug #1883) *) Parameter name : Set. Definition atom := name. Inductive exp : Set := | var : atom -> exp. Coercion var : atom >-> exp. Axiom silly_axiom : forall v : exp, v = v -> False. Lemma silly_lemma : forall x : atom, False. intros x. apply silly_axiom with (v := x). (* fails *) reflexivity. Qed. (* Check that unification does not commit too early to a representative of an eta-equivalence class that would be incompatible with other unification constraints *) Lemma eta : forall f : (forall P, P 1), (forall P, f P = f P) -> forall Q, f (fun x => Q x) = f (fun x => Q x). intros. apply H. Qed. (* Test propagation of evars from subgoal to brother subgoals *) (* This works because unfold calls clos_norm_flags which calls nf_evar *) Lemma eapply_evar_unfold : let x:=O in O=x -> 0=O. intros x H; eapply eq_trans; [apply H | unfold x;match goal with |- ?x = ?x => reflexivity end]. Qed. (* Test non-regression of (temporary) bug 1981 *) Goal exists n : nat, True. eapply ex_intro. exact O. trivial. Qed. (* Check pattern-unification on evars in apply unification *) Lemma evar : exists f : nat -> nat, forall x, f x = 0 -> x = 0. Proof. eexists; intros x H. apply H. Qed. (* Check that "as" clause applies to main premise only and leave the side conditions away *) Lemma side_condition : forall (A:Type) (B:Prop) x, (True -> B -> x=0) -> B -> x=x. Proof. intros. apply H in H0 as ->. reflexivity. exact I. Qed. (* Check that "apply" is chained on the last subgoal of each lemma and that side conditions come first (as it is the case since 8.2) *) Lemma chaining : forall A B C : Prop, (1=1 -> (2=2 -> A -> B) /\ True) -> (3=3 -> (True /\ (4=4 -> C -> A))) -> C -> B. Proof. intros. apply H, H0. exact (refl_equal 1). exact (refl_equal 2). exact (refl_equal 3). exact (refl_equal 4). assumption. Qed. (* Check that the side conditions of "apply in", even when chained and used through conjunctions, come last (as it is the case for single calls to "apply in" w/o destruction of conjunction since 8.2) *) Lemma chaining_in : forall A B C : Prop, (1=1 -> True /\ (B -> 2=2 -> 5=0)) -> (3=3 -> (A -> 4=4 -> B) /\ True) -> A -> 0=5. Proof. intros. apply H0, H in H1 as ->. exact (refl_equal 0). exact (refl_equal 1). exact (refl_equal 2). exact (refl_equal 3). exact (refl_equal 4). Qed. (* From 12612, Dec 2009, descent in conjunctions is more powerful *) (* The following, which was failing badly in bug 1980, is now properly rejected, as descend in conjunctions builds an ill-formed elimination from Prop to the domain of ex which is in Type. *) Goal True. Fail eapply ex_intro. exact I. Qed. Goal True. Fail eapply (ex_intro _). exact I. Qed. (* No failure here, because the domain of ex is in Prop *) Goal True. eapply (ex_intro (fun _ => 0=0) I). reflexivity. Qed. Goal True. eapply (ex_intro (fun _ => 0=0) I _). Unshelve. (* In 8.4: Grab Existential Variables. *) reflexivity. Qed. Goal True. eapply (fun (A:Prop) (x:A) => conj I x). Unshelve. (* In 8.4: the goal ?A was there *) exact I. Qed. (* The following was not accepted from r12612 to r12657 *) Record sig0 := { p1 : nat; p2 : p1 = 0 }. Goal forall x : sig0, p1 x = 0. intro x; apply x. Qed. (* The following worked in 8.2 but was not accepted from r12229 to r12926 because "simple apply" started to use pattern unification of evars. Evars pattern unification for simple (e)apply was disabled in 12927 but "simple eapply" below worked from 12898 to 12926 because pattern-unification also started supporting abstraction over Metas. However it did not find the "simple" solution and hence the subsequent "assumption" failed. *) Goal exists f:nat->nat, forall x y, x = y -> f x = f y. intros; eexists; intros. simple eapply (@f_equal nat). assumption. Unshelve. exact (fun x => x). Qed. (* The following worked in 8.2 but was not accepted from r12229 to r12897 for the same reason because eauto uses "simple apply". It worked from 12898 to 12926 because eauto uses eassumption and not assumption. *) Goal exists f:nat->nat, forall x y, x = y -> f x = f y. intros; eexists; intros. eauto. Unshelve. exact (fun x => x). Qed. (* The following was accepted before r12612 but is still not accepted in r12658 Goal forall x : { x:nat | x = 0}, proj1_sig x = 0. intro x; apply x. *) Section A. Variable map : forall (T1 T2 : Type) (f : T1 -> T2) (t11 t12 : T1), identity (f t11) (f t12). Variable mapfuncomp : forall (X Y Z : Type) (f : X -> Y) (g : Y -> Z) (x x' : X), identity (map Y Z g (f x) (f x')) (map X Z (fun x0 : X => g (f x0)) x x'). Goal forall X:Type, forall Y:Type, forall f:X->Y, forall x : X, forall x' : X, forall g : Y -> X, let gf := (fun x : X => g (f x)) : X -> X in identity (map Y X g (f x) (f x')) (map X X gf x x'). intros. apply mapfuncomp. Abort. End A. (* Check "with" clauses refer to names as they are printed *) Definition hide p := forall n:nat, p = n. Goal forall n, (forall n, n=0) -> hide n -> n=0. unfold hide. intros n H H'. (* H is displayed as (forall n, n=0) *) apply H with (n:=n). Undo. (* H' is displayed as (forall n0, n=n0) *) apply H' with (n:=0). Qed. (* Check that evars originally present in goal do not prevent apply in to work*) Goal (forall x, x <= 0 -> x = 0) -> exists x, x <= 0 -> 0 = 0. intros. eexists. intros. apply H in H0. Abort. (* Check correct failure of apply in when hypothesis is dependent *) Goal forall H:0=0, H = H. intros. Fail apply eq_sym in H. Abort. (* Check that unresolved evars not originally present in goal prevent apply in to work*) Goal (forall x y, x <= 0 -> x + y = 0) -> exists x, x <= 0 -> 0 = 0. intros. eexists. intros. Fail apply H in H0. Abort. (* Check naming pattern in apply in *) Goal ((False /\ (True -> True))) -> True -> True. intros F H. apply F in H as H0. (* Check that H0 is not used internally *) exact H0. Qed. Goal ((False /\ (True -> True/\True))) -> True -> True/\True. intros F H. apply F in H as (?,?). split. exact H. (* Check that generated names are H and H0 *) exact H0. Qed. (* This failed at some time in between 18 August 2014 and 2 September 2014 *) Goal forall A B C: Prop, (True -> A -> B /\ C) -> A -> B. intros * H. apply H. Abort. (* This failed between 2 and 3 September 2014 *) Goal forall A B C D:Prop, (A<->B)/\(C<->D) -> A -> B. intros. apply H in H0. pose proof I as H1. (* Test that H1 does not exist *) Abort. Goal forall A B C D:Prop, (A<->B)/\(C<->D) -> A. intros. apply H. pose proof I as H0. (* Test that H0 does not exist *) Abort. (* The first example below failed at some time in between 18 August 2014 and 2 September 2014 *) Goal forall x, 2=0 -> x+1=2 -> (forall x, S x = 0) -> True. intros x H H0 H1. eapply eq_trans in H. 2:apply H0. rewrite H1 in H. change (x+0=0) in H. (* Check the result in H1 *) Abort. Goal forall x, 2=x+1 -> (forall x, S x = 0) -> 2 = 0. intros x H H0. eapply eq_trans. apply H. rewrite H0. change (x+0=0). Abort. Goal (forall x y, x <= y -> y + x = 0 /\ True) -> exists x y, (x <= 0 -> y <= 1 -> 0 = 0 /\ 1 = 0). intros. do 2 eexists. intros. eapply H in H0 as (H0,_), H1 as (H1,_). split. - exact H0. - exact H1. Qed. (* 2nd order apply used to have delta on local definitions even though it does not have delta on global definitions; keep it by compatibility while finding a more uniform way to proceed. *) Goal forall f:nat->nat, (forall P x, P (f x)) -> let x:=f 0 in x = 0. intros f H x. apply H. Qed. (* Test that occur-check is not too restrictive (see comments of #3141) *) Lemma bar (X: nat -> nat -> Prop) (foo:forall x, X x x) (a: unit) (H: tt = a): exists x, exists y, X x y. Proof. intros; eexists; eexists ?[y]; case H. apply (foo ?y). Unshelve. exact 0. Qed. (* Test position of new hypotheses when using "apply ... in ... as ..." *) Goal (True -> 0=0 /\ True) -> True -> False -> True/\0=0. intros H H0 H1. apply H in H0 as (a,b). (* clear H1:False *) match goal with H:_ |- _ => clear H end. split. - (* use b:True *) match goal with H:_ |- _ => exact H end. - (* clear b:True *) match goal with H:_ |- _ => clear H end. (* use a:0=0 *) match goal with H:_ |- _ => exact H end. Qed. (* Test choice of most dependent solution *) Goal forall n, n = 0 -> exists p, p = n /\ p = 0. intros. eexists ?[p]. split. rewrite H. reflexivity. (* Compatibility tells [?p:=n] rather than [?p:=0] *) exact H. (* this checks that the goal is [n=0], not [0=0] *) Qed. (* Check insensitivity to alphabetic order of names*) (* In both cases, the last name is conventionally chosen *) (* Before 8.9, the name coming first in alphabetic order *) (* was chosen. *) Goal forall m n, m = n -> n = 0 -> exists p, p = n /\ p = 0. intros. eexists ?[p]. split. rewrite H. reflexivity. exact H0. Qed. Goal forall n m, n = m -> m = 0 -> exists p, p = m /\ p = 0. intros. eexists ?[p]. split. rewrite H. reflexivity. exact H0. Qed. (* apply and side conditions: we check that apply in iterates only on the main subgoals *) Goal (forall x, x=0 -> x>=0 -> x<=0 \/ x<=1) -> 0>=0 -> 1>=0 -> 1=0 -> True. intros f H H0 H1. apply f in H as [], H0 as []. 1-3: change (0 <= 0) in H. 4-6: change (0 <= 1) in H. 1: change (1 <= 0) in H0. 4: change (1 <= 0) in H0. 2: change (1 <= 1) in H0. 5: change (1 <= 1) in H0. 1-2,4-5: exact I. 1,2: exact H1. change (0 >= 0) in H. change (1 >= 0) in H0. exact (eq_refl 0). Qed. coq-8.20.0/test-suite/success/applyTC.v000066400000000000000000000004531466560755400177300ustar00rootroot00000000000000Axiom P : nat -> Prop. Class class (A : Type) := { val : A }. Lemma usetc {t : class nat} : P (@val nat t). Admitted. Notation "{val:= v }" := (@val _ v). #[export] Instance zero : class nat := {| val := 0 |}. Lemma test : P 0. Fail apply usetc. pose (tmp := usetc); apply tmp; clear tmp. Qed. coq-8.20.0/test-suite/success/attribute_syntax.v000066400000000000000000000021161466560755400217630ustar00rootroot00000000000000From Coq Require Program.Wf. Section Scope. #[local] Coercion nat_of_bool (b: bool) : nat := if b then 0 else 1. Check (refl_equal : true = 0 :> nat). End Scope. Fail Check 0 = true :> nat. #[universes(polymorphic)] Definition ι T (x: T) := x. Check ι _ ι. #[universes(polymorphic=no)] Definition ιι T (x: T) := x. Fail Check ιι _ ιι. #[program] Fixpoint f (n: nat) {wf lt n} : nat := _. Reset f. #[program=yes] Fixpoint f (n: nat) {wf lt n} : nat := _. Reset f. #[deprecated(since="8.9.0")] Ltac foo := foo. Module M. #[local] #[universes(polymorphic)] Definition zed := Type. #[local, universes(polymorphic)] Definition kats := Type. End M. Check M.zed@{_}. Fail Check zed. Check M.kats@{_}. Fail Check kats. Export Set Foo. #[ export ] Set Foo. Fail #[ export ] Export Foo. (* Attribute for Locality specified twice *) (* Tests for deprecated attribute syntax *) Set Warnings "-deprecated-attribute-syntax". #[program=yes] Fixpoint f (n: nat) {wf lt n} : nat := _. Reset f. #[universes(polymorphic=no)] Definition ιιι T (x: T) := x. Fail Check ιιι _ ιιι. coq-8.20.0/test-suite/success/auto.v000066400000000000000000000066141466560755400173310ustar00rootroot00000000000000(* coq-prog-args: ("-async-proofs" "off") *) (* Wish #2154 by E. van der Weegen *) (* auto was not using f_equal-style lemmas with metavariables occurring only in the type of an evar of the concl, but not directly in the concl itself *) Parameters (F: Prop -> Prop) (G: forall T, (T -> Prop) -> Type) (L: forall A (P: A -> Prop), G A P -> forall x, F (P x)) (Q: unit -> Prop). #[export] Hint Resolve L. Goal G unit Q -> F (Q tt). intro. eauto. Qed. (* Test implicit arguments in "using" clause *) Goal forall n:nat, nat * nat. epose (H := pair O). auto using H. Undo. eauto using H. Qed. Create HintDb test discriminated. Parameter foo : forall x, x = x + 0. #[export] Hint Resolve foo : test. Parameter C : nat -> Type -> Prop. Parameter c_inst : C 0 nat. #[export] Hint Resolve c_inst : test. #[export] Hint Mode C - + : test. #[export] Hint Resolve c_inst : test2. #[export] Hint Mode C + + : test2. Goal exists n, C n nat. Proof. eexists. Fail progress debug eauto with test2. progress eauto with test. Qed. (** Patterns of Extern have a "matching" semantics. It is not so for apply/exact hints *) Class B (A : Type). Class I. #[export] Instance i : I := {}. Definition flip {A B C : Type} (f : A -> B -> C) := fun y x => f x y. Class D (f : nat -> nat -> nat). Definition ftest (x y : nat) := x + y. Definition flipD (f : nat -> nat -> nat) : D f -> D (flip f). Admitted. Module Instnopat. Local Instance: B nat := {}. (* pattern_of_constr -> B nat *) (* exact hint *) Check (_ : B nat). (* map_eauto -> B_instance0 *) (* NO Constr_matching.matches !!! *) Check (_ : B _). Goal exists T, B T. eexists. eauto with typeclass_instances. Qed. Local Instance: D ftest := {}. Local Hint Resolve flipD | 0 : typeclass_instances. (* pattern: D (flip _) *) Fail Timeout 1 Check (_ : D _). (* loops applying flipD *) End Instnopat. Module InstnopatApply. Local Instance: I -> B nat := {}. (* pattern_of_constr -> B nat *) (* apply hint *) Check (_ : B nat). (* map_eauto -> B_instance0 *) (* NO Constr_matching.matches !!! *) Check (_ : B _). Goal exists T, B T. eexists. eauto with typeclass_instances. Qed. End InstnopatApply. Module InstPat. #[export] Hint Extern 3 (B nat) => split : typeclass_instances. (* map_eauto -> Extern hint *) (* Constr_matching.matches -> true *) Check (_ : B nat). (* map_eauto -> Extern hint *) (* Constr_matching.matches -> false: Because an inductive in the pattern does not match an evar in the goal *) Check (_ : B _). Goal exists T, B T. eexists. (* map_existential -> Extern hint *) (* Constr_matching.matches -> false *) Fail progress eauto with typeclass_instances. (* map_eauto -> Extern hint *) (* Constr_matching.matches -> false *) Fail typeclasses eauto. Abort. #[export] Hint Extern 0 (D (flip _)) => apply flipD : typeclass_instances. Module withftest. Local Instance: D ftest := {}. Check (_ : D _). (* D_instance_0 : D ftest *) Check (_ : D (flip _)). (* ... : D (flip ftest) *) End withftest. Module withoutftest. #[export] Hint Extern 0 (D ftest) => split : typeclass_instances. Check (_ : D _). (* ? : D ?, _not_ looping *) Check (_ : D (flip _)). (* ? : D (flip ?), _not_ looping *) Check (_ : D (flip ftest)). (* flipD ftest {| |} : D (flip ftest) *) End withoutftest. End InstPat. coq-8.20.0/test-suite/success/autointros.v000066400000000000000000000006611466560755400205640ustar00rootroot00000000000000Inductive even : nat -> Prop := | even_0 : even 0 | even_odd : forall n, odd n -> even (S n) with odd : nat -> Prop := | odd_1 : odd 1 | odd_even : forall n, even n -> odd (S n). Lemma foo {n : nat} (E : even n) : even (S (S n)) with bar {n : nat} (O : odd n) : odd (S (S n)). Proof. destruct E. constructor. constructor. apply even_odd. apply (bar _ H). destruct O. repeat constructor. apply odd_even. apply (foo _ H). Defined. coq-8.20.0/test-suite/success/autorewrite.v000066400000000000000000000016661466560755400207350ustar00rootroot00000000000000Parameter Ack : nat -> nat -> nat. Axiom Ack0 : forall m : nat, Ack 0 m = S m. Axiom Ack1 : forall n : nat, Ack (S n) 0 = Ack n 1. Axiom Ack2 : forall n m : nat, Ack (S n) (S m) = Ack n (Ack (S n) m). Module M. #[export] Hint Rewrite Ack0 Ack1 Ack2 : base0. Lemma ResAck0 : (Ack 2 2 = 7 -> False) -> False. Proof. intros. autorewrite with base0 in H using try (apply H; reflexivity). Qed. End M. Lemma ResAck1 : forall H:(Ack 2 2 = 7 -> False), True -> False. Proof. intros. Fail autorewrite with base0 in *. Abort. Import M. Lemma ResAck1 : forall H:(Ack 2 2 = 7 -> False), True -> False. Proof. intros. autorewrite with base0 in *. apply H;reflexivity. Qed. (* Check autorewrite does not solve existing evars *) (* See discussion started by A. Chargueraud in Oct 2010 on coqdev *) Global Hint Rewrite <- plus_n_O : base1. Goal forall y, exists x, y+x = y. eexists. autorewrite with base1. Fail reflexivity. Abort. coq-8.20.0/test-suite/success/boundvars.v000066400000000000000000000011551466560755400203570ustar00rootroot00000000000000(* An example showing a bug in the detection of free variables *) (* "x" is not free in the common type of "x" and "y" *) Check forall (x z:unit) (x y : match z as x return x=x with tt => eq_refl end = eq_refl), x=x. (* An example showing a bug in the detection of bound variables *) Goal forall x, match x return x = x with 0 => eq_refl | _ => eq_refl end = eq_refl. intro. match goal with |- (match x as y in nat return y = y with O => _ | S n => _ end) = _ => assert (forall y, y = 0) end. intro. Check x0. (* Check that "y" has been bound to "x0" while matching "match x as x0 return x0=x0 with ... end" *) Abort. coq-8.20.0/test-suite/success/btauto.v000066400000000000000000000003331466560755400176470ustar00rootroot00000000000000Require Import Btauto. Open Scope bool_scope. Lemma test_orb a b : (if a || b then negb (negb b && negb a) else negb a && negb b) = true. Proof. btauto. Qed. Lemma test_xorb a : xorb a a = false. Proof. btauto. Qed. coq-8.20.0/test-suite/success/bteauto.v000066400000000000000000000103431466560755400200160ustar00rootroot00000000000000(* coq-prog-args: ("-async-proofs" "off") *) Require Import Program.Tactics. Module Backtracking. Class A := { foo : nat }. #[global] Instance A_1 : A | 2 := { foo := 42 }. #[global] Instance A_0 : A | 1 := { foo := 0 }. Lemma aeq (a : A) : foo = foo. reflexivity. Qed. Arguments foo A : clear implicits. Example find42 : exists n, n = 42. Proof. eexists. eapply eq_trans. evar (a : A). subst a. refine (@aeq ?a). Unshelve. all:cycle 1. typeclasses eauto. Fail reflexivity. Undo 2. (* Without multiple successes it fails *) Set Typeclasses Debug Verbosity 2. Fail all:((once (typeclasses eauto with typeclass_instances)) + apply eq_refl). (* Does backtrack if other goals fail *) all:[> typeclasses eauto + reflexivity .. ]. Undo 1. all:(typeclasses eauto + reflexivity). (* Note "+" is a focussing combinator *) Show Proof. Qed. Print find42. #[global] Hint Extern 0 (_ = _) => reflexivity : equality. Goal exists n, n = 42. eexists. eapply eq_trans. evar (a : A). subst a. refine (@aeq ?a). Unshelve. all:cycle 1. typeclasses eauto. Fail reflexivity. Undo 2. (* Does backtrack between individual goals *) Set Typeclasses Debug. all:(typeclasses eauto with typeclass_instances equality). Qed. Unset Typeclasses Debug. Module Leivant. Axiom A : Type. Existing Class A. Axioms a b c d e: A. #[global] Existing Instances a b c d e. Ltac get_value H := eval cbv delta [H] in H. Goal True. Fail refine (let H := _ : A in _); let v := get_value H in idtac v; fail. Admitted. Goal exists x:A, x=a. unshelve evar (t : A). all:cycle 1. refine (@ex_intro _ _ t _). all:cycle 1. all:(typeclasses eauto + reflexivity). Qed. End Leivant. End Backtracking. #[export] Hint Resolve eq_sym eq_trans | 100 : core. #[export] Hint Cut [(_)* eq_sym eq_sym] : core. #[export] Hint Cut [_* eq_trans eq_trans] : core. #[export] Hint Cut [_* eq_trans eq_sym eq_trans] : core. Goal forall x y z : nat, x = y -> z = y -> x = z. Proof. intros. typeclasses eauto with core. Qed. Module Hierarchies. Class A := mkA { data : nat }. Class B := mkB { aofb :: A }. #[export] Existing Instance mkB. Definition makeB (a : A) : B := _. Definition makeA (a : B) : A := _. Fail Timeout 1 Definition makeA' : A := _. #[export] Hint Cut [_* mkB aofb] : typeclass_instances. Fail Definition makeA' : A := _. Fail Definition makeB' : B := _. End Hierarchies. (** Hint modes *) Class Equality (A : Type) := { eqp : A -> A -> Prop }. Check (eqp 0%nat 0). #[export] Instance nat_equality : Equality nat := { eqp := eq }. #[export] Instance default_equality A : Equality A | 1000 := { eqp := eq }. Check (eqp 0%nat 0). (* Defaulting *) Check (fun x y => eqp x y). (* No more defaulting, reduce "trigger-happiness" *) Definition ambiguous x y := eqp x y. #[export] Hint Mode Equality ! : typeclass_instances. Fail Definition ambiguous' x y := eqp x y. Definition nonambiguous (x y : nat) := eqp x y. (** Typical looping instances with defaulting: *) Definition flip {A B C} (f : A -> B -> C) := fun x y => f y x. Class SomeProp {A : Type} (f : A -> A -> A) := { prf : forall x y, f x y = f x y }. #[export] Instance propflip (A : Type) (f : A -> A -> A) : SomeProp f -> SomeProp (flip f). Proof. intros []. constructor. reflexivity. Qed. Fail Timeout 1 Check prf. #[export] Hint Mode SomeProp + + : typeclass_instances. Check prf. Check (fun H : SomeProp plus => _ : SomeProp (flip plus)). (** Iterative deepening / breadth-first search *) Module IterativeDeepening. Class A. Class B. Class C. #[export] Instance: B -> A | 0 := {}. #[export] Instance: C -> A | 0 := {}. #[export] Instance: C -> B -> A | 0 := {}. #[export] Instance: A -> A | 0 := {}. Goal C -> A. intros. Fail Timeout 1 typeclasses eauto. Set Typeclasses Iterative Deepening. Fail typeclasses eauto 1. typeclasses eauto 2. Undo. Unset Typeclasses Iterative Deepening. Fail Timeout 1 typeclasses eauto. Set Typeclasses Iterative Deepening. Typeclasses eauto := debug 3. typeclasses eauto. Qed. End IterativeDeepening. coq-8.20.0/test-suite/success/bug_10890.v000066400000000000000000000003161466560755400176700ustar00rootroot00000000000000Require Import Derive. Derive foo SuchThat (foo = foo :> nat) As bar. Proof. Unshelve. 2:abstract exact 0. exact eq_refl. Defined. (* or Qed: anomaly kernel doesn't support existential variables *) coq-8.20.0/test-suite/success/bug_14174.v000066400000000000000000000011161466560755400176660ustar00rootroot00000000000000(** Check that we avoid an extraction error that came up in PR #14174 in metacoq *) Require Import Coq.extraction.ExtrOcamlBasic. Module A. Include Coq.Init.Specif. End A. Recursive Extraction A. (* Avoding Error: The informative inductive type sig2 has a Prop instance in A.eq_sig2_rec_uncurried (or in its mutual block). This happens when a sort-polymorphic singleton inductive type has logical parameters, such as (I,I) : (True * True) : Prop. The Ocaml extraction cannot handle this situation yet. Instead, use a sort-monomorphic type such as (True /\ True) or extract to Haskell. *) coq-8.20.0/test-suite/success/bullet.v000066400000000000000000000000651466560755400176420ustar00rootroot00000000000000Goal True /\ True. split. - exact I. - exact I. Qed. coq-8.20.0/test-suite/success/case_let_conversion.v000066400000000000000000000014551466560755400224030ustar00rootroot00000000000000Axiom checker_flags : Set. Inductive Box (R : Type) : Type := box : Box R. Inductive typing (H : checker_flags) : Type := | type_Rel : typing H -> typing H | type_Case : let i := tt in Box (typing H) -> typing H. Definition unbox (P : Type) (b : Box P) := match b with box _ => 0 end. Definition size (H : checker_flags) (d : typing H) : nat. Proof. revert d. fix size 1. destruct 1. - exact (size d). - exact (unbox _ b). Defined. Definition foo (H : checker_flags) (a : typing H) : size H (type_Rel H a) = size H a. Proof. simpl. reflexivity. Qed. Definition bar (H : checker_flags) (a : typing H) : size H (type_Rel H a) = size H a. Proof. vm_compute. reflexivity. Qed. Definition qux (H : checker_flags) (a : typing H) : size H (type_Rel H a) = size H a. Proof. native_compute. reflexivity. Qed. coq-8.20.0/test-suite/success/case_let_param.v000066400000000000000000000004311466560755400213070ustar00rootroot00000000000000Inductive foo (x := tt) := Foo : forall (y := x), foo. Definition get (t : foo) := match t with Foo _ y => y end. Goal get Foo = tt. Proof. reflexivity. Qed. Goal forall x : foo, match x with Foo _ y => y end = match x with Foo _ _ => tt end. Proof. intros. reflexivity. Qed. coq-8.20.0/test-suite/success/cbn.v000066400000000000000000000032151466560755400171150ustar00rootroot00000000000000(* cbn is able to refold mutual recursive calls *) Fixpoint foo (n : nat) := match n with | 0 => true | S n => g n end with g (n : nat) : bool := match n with | 0 => true | S n => foo n end. Goal forall n, foo (S n) = g n. intros. cbn. match goal with |- g _ = g _ => reflexivity end. Qed. (* simpl nomatch *) Definition thing n := match n with 0 => True | S n => False end. Arguments thing _ / : simpl nomatch. Goal forall x, thing x. intros. cbn. match goal with |- thing x => idtac end. Abort. Definition thing' n := n + n. Arguments thing' !_ / : simpl nomatch. Lemma bar n : thing' n = 0. Proof. cbn. match goal with |- thing' _ = _ => idtac end. Arguments thing' _ / : simpl nomatch. cbn. match goal with |- _ + _ = _ => idtac end. Abort. Module MutualFixCoFixInSection. Section S. Variable p:nat. Fixpoint f n := match n with 0 => p | S n => f n + g n end with g n := match n with 0 => p | S n => f n + g n end. End S. Goal forall n, f n (S n) = g 0 (S n). intros. cbn. match goal with [ |- f n n + g n n = f 0 n + g 0 n ] => idtac end. Abort. CoInductive stream {A:Type} : Type := | scons: A->stream->stream. Definition stream_unfold {A} (s: @ stream A) := match s with | scons a s' => (a, scons a s') end. Section C. Variable (x:nat). CoFixpoint mut_stream1 (n:nat) := scons n (mut_stream2 (n+x)) with mut_stream2 (n:nat) := scons n (mut_stream1 (n+x)). End C. Goal (forall x n, stream_unfold (mut_stream1 x n) = stream_unfold (mut_stream2 x n)). intros. cbn. match goal with [ |- (n, scons n (mut_stream2 x (n + x))) = (n, scons n (mut_stream1 x (n + x))) ] => idtac end. Abort. End MutualFixCoFixInSection. coq-8.20.0/test-suite/success/cbv_let.v000066400000000000000000000012311466560755400177650ustar00rootroot00000000000000Record T : Type := Build_T { f : unit; g := pair f f; }. Definition t : T := {| f := tt; |}. Goal match t return unit with Build_T f g => f end = tt. Proof. cbv. reflexivity. Qed. Goal match t return prod unit unit with Build_T f g => g end = pair tt tt. Proof. cbv. reflexivity. Qed. Goal forall (x : T), match x return prod unit unit with Build_T f g => g end = pair match x return unit with Build_T f g => fst g end match x return unit with Build_T f g => snd g end. Proof. cbv. destruct x. reflexivity. Qed. Record U : Type := Build_U { h := tt }. Definition u : U := Build_U. Goal match u with Build_U h => h end = tt. Proof. cbv. reflexivity. Qed. coq-8.20.0/test-suite/success/cc.v000066400000000000000000000066201466560755400167430ustar00rootroot00000000000000 Theorem t1 : forall (A : Set) (a : A) (f : A -> A), f a = a -> f (f a) = a. intros. congruence. Qed. Theorem t2 : forall (A : Set) (a b : A) (f : A -> A) (g : A -> A -> A), a = f a -> g b (f a) = f (f a) -> g a b = f (g b a) -> g a b = a. intros. congruence. Qed. (* 15=0 /\ 10=0 /\ 6=0 -> 0=1 *) Theorem t3 : forall (N : Set) (o : N) (s d : N -> N), s (s (s (s (s (s (s (s (s (s (s (s (s (s (s o)))))))))))))) = o -> s (s (s (s (s (s (s (s (s (s o))))))))) = o -> s (s (s (s (s (s o))))) = o -> o = s o. intros. congruence. Qed. (* Examples that fail due to dependencies *) (* yields transitivity problem *) Theorem dep : forall (A : Set) (P : A -> Set) (f g : forall x : A, P x) (x y : A) (e : x = y) (e0 : f y = g y), f x = g x. intros; dependent rewrite e; exact e0. Qed. (* yields congruence problem *) Theorem dep2 : forall (A B : Set) (f : forall (A : Set) (b : bool), if b then unit else A -> unit) (e : A = B), f A true = f B true. intros; rewrite e; reflexivity. Qed. (* example that Congruence. can solve (dependent function applied to the same argument)*) Theorem dep3 : forall (A : Set) (P : A -> Set) (f g : forall x : A, P x), f = g -> forall x : A, f x = g x. intros. congruence. Qed. (* Examples with injection rule *) Theorem inj1 : forall (A : Set) (a b c d : A), (a, c) = (b, d) -> a = b /\ c = d. intros. split; congruence. Qed. Theorem inj2 : forall (A : Set) (a c d : A) (f : A -> A * A), f = pair (B:=A) a -> Some (f c) = Some (f d) -> c = d. intros. congruence. Qed. (* Examples with discrimination rule *) Theorem discr1 : true = false -> False. intros. congruence. Qed. Theorem discr2 : Some true = Some false -> False. intros. congruence. Qed. (* example with implications *) Theorem arrow : forall (A B: Prop) (C D:Set) , A=B -> C=D -> (A -> C) = (B -> D). congruence. Qed. Set Implicit Arguments. Parameter elt: Set. Parameter elt_eq: forall (x y: elt), {x = y} + {x <> y}. Definition t (A: Set) := elt -> A. Definition get (A: Set) (x: elt) (m: t A) := m x. Definition set (A: Set) (x: elt) (v: A) (m: t A) := fun (y: elt) => if elt_eq y x then v else m y. Lemma gsident: forall (A: Set) (i j: elt) (m: t A), get j (set i (get i m) m) = get j m. Proof. intros. unfold get, set. case (elt_eq j i); intro. congruence. auto. Qed. (* bug 2447 is now closed (PC, 2014) *) Section bug_2447. Variable T:Type. Record R := mkR {x:T;y:T;z:T}. Variables a a' b b' c c':T. Lemma bug_2447: mkR a b c = mkR a' b c -> a = a'. congruence. Qed. Lemma bug_2447_variant1: mkR a b c = mkR a b' c -> b = b'. congruence. Qed. Lemma bug_2447_variant2: mkR a b c = mkR a b c' -> c = c'. congruence. Qed. End bug_2447. (* congruence was supposed to do discriminate but it was bugged for types with indices *) Inductive I : nat -> Type := C : I 0 | D : I 0. Goal ~C=D. congruence. Qed. (* Example by Jonathan Leivant, congruence up to universes *) Section JLeivant. Variables S1 S2 : Set. Definition T1 : Type := S1. Definition T2 : Type := S2. Goal T1 = T1. congruence. Undo. unfold T1. congruence. Qed. End JLeivant. (* An example with primitive projections *) Module PrimitiveProjections. Set Primitive Projections. Record t (A:Type) := { f : A }. Goal forall g (a:t nat), @f nat = g -> f a = 0 -> g a = 0. congruence. Undo. intros. unfold f in H0. (* internally turn the projection to unfolded form *) congruence. Qed. End PrimitiveProjections. coq-8.20.0/test-suite/success/change.v000066400000000000000000000040561466560755400176040ustar00rootroot00000000000000(* A few tests of the syntax of clauses and of the interpretation of change *) Goal let a := 0+0 in a=a. intro. change 0 in (value of a). change ((fun A:Type => A) nat) in (type of a). Abort. Goal forall x, 2 + S x = 1 + S x. intro. change (?u + S x) with (S (u + x)). Abort. (* Check the combination of at, with and in (see bug #2146) *) Goal 3=3 -> 3=3. intro H. change 3 with (1+2) at 2. change 3 with (1+2) in H at 2 |-. change 3 with (1+2) in H at 1 |- * at 1. (* Now check that there are no more 3's *) change 3 with (1+2) in * || reflexivity. Qed. (* Note: the following is invalid and must fail change 3 at 1 with (1+2) at 3. change 3 at 1 with (1+2) in *. change 3 at 1 with (1+2) in H at 2 |-. change 3 at 1 with (1+2) at 3. change 3 at 1 with (1+2) in H |- *. change 3 at 1 with (1+2) in H, H|-. change 3 at 1. *) (* Test that pretyping checks allowed elimination sorts *) Goal True. Fail change True with (let (x,a) := ex_intro _ True (eq_refl True) in x). Fail change True with match ex_intro _ True (eq_refl True) with ex_intro x _ => x end. Abort. (* Check absence of loop in identity substitution (was failing up to Sep 2014, see #3641) *) Goal True. change ?x with x. Abort. (* Check typability after change of type subterms *) Goal nat = nat :> Set. Fail change nat with (@id Type nat). (* would otherwise be ill-typed *) Abort. (* Check typing env for rhs is the correct one *) Goal forall n, let x := n in id (fun n => n + x) 0 = 0. intros. unfold x. (* check that n in 0+n is not interpreted as the n from "fun n" *) change n with (0+n). Abort. (* Check non-collision of non-normalized defined evars with pattern variables *) Goal exists x, 1=1 -> x=1/\x=1. eexists ?[n]; intros; split. eassumption. match goal with |- ?x=1 => change (x=1) with (0+x=1) end. match goal with |- 0+1=1 => trivial end. Qed. (* Mini-check that no_check does not check *) Goal True -> False. intro H. change_no_check nat. apply S. change_no_check nat with bool. change_no_check nat in H. change_no_check nat with (bool->bool) in H. exact (H true). Fail Qed. Abort. coq-8.20.0/test-suite/success/change_case.v000066400000000000000000000006411466560755400205730ustar00rootroot00000000000000Inductive box (A : Type) := Box : A -> box A. Axiom PRED : unit -> Prop. Axiom FUN : forall (u : unit), box (PRED u). Axiom U : unit. Definition V := U. Goal match FUN U with Box _ _ => True end. Proof. repeat match goal with | [ |- context G[ U ] ] => let e := context G [ V ] in change e end. set (Z := V). clearbody Z. (* This fails if change misses the case parameters *) destruct (FUN Z). constructor. Qed. coq-8.20.0/test-suite/success/change_pattern.v000066400000000000000000000023431466560755400213360ustar00rootroot00000000000000Set Implicit Arguments. Unset Strict Implicit. Axiom vector : Type -> nat -> Type. Record KleeneStore i j a := kleeneStore { dim : nat ; peek : vector j dim -> a ; pos : vector i dim }. Definition KSmap i j a b (f : a -> b) (s : KleeneStore i j a) : KleeneStore i j b := kleeneStore (fun v => f (peek v)) (pos s). Record KleeneCoalg (i o : Type -> Type) := kleeneCoalg { coalg :> forall a b, (o a) -> KleeneStore (i a) (i b) (o b) }. Axiom free_b_dim : forall i o (k : KleeneCoalg i o) a b b' (x : o a), dim (coalg k b x) = dim (coalg k b' x). Axiom t : Type -> Type. Axiom traverse : KleeneCoalg (fun x => x) t. Definition size a (x:t a) : nat := dim (traverse a a x). Lemma iso1_iso2_2 a (y : {x : t unit & vector a (size x)}) : False. Proof. destruct y. pose (X := KSmap (traverse a unit) (traverse unit a x)). set (e :=(eq_sym (free_b_dim traverse (a:=unit) a unit x))). clearbody e. (** The pattern generated by change must have holes where there were implicit arguments in the original user-provided term. This particular example fails if this is not the case because the inferred argument does not coincide with the one in the considered term. *) progress (change (dim (traverse unit a x)) with (dim X) in e). Abort. coq-8.20.0/test-suite/success/clear.v000066400000000000000000000010701466560755400174360ustar00rootroot00000000000000Goal forall x:nat, (forall x, x=0 -> True)->True. intros; eapply H. instantiate (1:=(fun y => _) (S x)). simpl. clear x. trivial. Qed. Goal forall y z, (forall x:nat, x=y -> True) -> y=z -> True. intros; eapply H. rename z into z'. clear H0. clear z'. reflexivity. Qed. Class A. Section Foo. Variable a : A. Goal A. solve [typeclasses eauto]. Undo 1. clear a. try typeclasses eauto. assert(a:=Build_A). solve [ typeclasses eauto ]. Undo 2. assert(b:=Build_A). solve [ typeclasses eauto ]. Qed. End Foo. coq-8.20.0/test-suite/success/coercions.v000066400000000000000000000143341466560755400203430ustar00rootroot00000000000000Module InitialTest. (* Interaction between coercions and casts *) (* Example provided by Eduardo Gimenez *) Parameter Z S : Set. Parameter f : S -> Z. Coercion f : S >-> Z. Parameter g : Z -> Z. Check (fun s => g (s:S)). (* Check uniform inheritance condition *) Parameter h : nat -> nat -> Prop. Parameter i : forall n m : nat, h n m -> nat. Coercion i : h >-> nat. (* Check coercion to funclass when the source occurs in the target *) Parameter C : nat -> nat -> nat. Coercion C : nat >-> Funclass. (* Remark: in the following example, it cannot be decided whether C is from nat to Funclass or from A to nat. An explicit Coercion command is expected Parameter A : nat -> Prop. Parameter C:> forall n:nat, A n -> nat. *) (* Check coercion between products based on eta-expansion *) (* (there was a de Bruijn bug until rev 9254) *) Section P. Variable E : Set. Variables C D : E -> Prop. Variable G :> forall x, C x -> D x. Check fun (H : forall y:E, y = y -> C y) => (H : forall y:E, y = y -> D y). End P. (* Check that class arguments are computed the same when looking for a coercion and when applying it (class_args_of) (failed until rev 9255) *) Section Q. Variable bool : Set. Variables C D : bool -> Prop. Variable G :> forall x, C x -> D x. Variable f : nat -> bool. Definition For_all (P : nat -> Prop) := forall x, P x. Check fun (H : For_all (fun x => C (f x))) => H : forall x, D (f x). Check fun (H : For_all (fun x => C (f x))) x => H x : D (f x). Check fun (H : For_all (fun x => C (f x))) => H : For_all (fun x => D (f x)). End Q. (* Combining class lookup and path lookup so that if a lookup fails, another descent in the class can be found (see wish #1934) *) Record Setoid : Type := { car :> Type }. Record Morphism (X Y:Setoid) : Type := {evalMorphism :> X -> Y}. Definition extSetoid (X Y:Setoid) : Setoid. constructor. exact (Morphism X Y). Defined. Definition ClaimA := forall (X Y:Setoid) (f: extSetoid X Y) x, f x= f x. Coercion irrelevant := (fun _ => I) : True -> car (Build_Setoid True). Definition ClaimB := forall (X Y:Setoid) (f: extSetoid X Y) (x:X), f x= f x. (* Check that coercions are made visible only when modules are imported *) Module A. Module B. Coercion b2n (b:bool) := if b then 0 else 1. End B. Fail Check S true. End A. Import A. Fail Check S true. (* Tests after the inheritance condition constraint is relaxed *) Inductive list (A : Type) : Type := nil : list A | cons : A -> list A -> list A. Inductive vect (A : Type) : nat -> Type := vnil : vect A 0 | vcons : forall n, A -> vect A n -> vect A (1+n). Fixpoint size A (l : list A) : nat := match l with nil _ => 0 | cons _ _ tl => 1+size _ tl end. Section test_non_unif_but_complete. Fixpoint l2v A (l : list A) : vect A (size A l) := match l as l return vect A (size A l) with | nil _ => vnil A | cons _ x xs => vcons A (size A xs) x (l2v A xs) end. Local Coercion l2v : list >-> vect. Check (fun l : list nat => (l : vect _ _)). End test_non_unif_but_complete. Section what_we_could_do. Variables T1 T2 : Type. Variable c12 : T1 -> T2. Class coercion (A B : Type) : Type := cast : A -> B. Instance atom : coercion T1 T2 := c12. Instance pair A B C D (c1 : coercion A B) (c2 : coercion C D) : coercion (A * C) (B * D) := fun x => (c1 (fst x), c2 (snd x)). Fixpoint l2v2 {A B} {c : coercion A B} (l : list A) : (vect B (size A l)) := match l as l return vect B (size A l) with | nil _ => vnil B | cons _ x xs => vcons _ _ (c x) (l2v2 xs) end. Local Coercion l2v2 : list >-> vect. Check (fun l : list (T1 * T1) => (l : vect _ _)). Check (fun l : list (T1 * T1) => (l2v2 l : vect _ _)). End what_we_could_do. End InitialTest. (** Unit test for Prop as source class *) Module TestPropAsSourceCoercion. Parameter heap : Prop. Parameter heap_empty : heap. Definition hprop := heap -> Prop. Coercion hpure (P:Prop) : hprop := fun h => h = heap_empty /\ P. Parameter heap_single : nat -> nat -> hprop. Parameter hstar : hprop -> hprop -> hprop. Notation "H1 \* H2" := (hstar H1 H2) (at level 69). Definition test := heap_single 4 5 \* (5 <> 4) \* heap_single 2 4 \* (True). (* Print test. -- reveals [hpure] coercions *) End TestPropAsSourceCoercion. (** Unit test for Type as source class *) Module TestTypeAsSourceCoercion. Require Import Coq.Setoids.Setoid. Record setoid := { A : Type ; R : relation A ; eqv : Equivalence R }. Definition default_setoid (T : Type) : setoid := {| A := T ; R := eq ; eqv := _ |}. Coercion default_setoid : Sortclass >-> setoid. Definition foo := Type : setoid. Inductive type := U | Nat. Inductive term : type -> Type := | ty (_ : Type) : term U | nv (_ : nat) : term Nat. Coercion ty : Sortclass >-> term. Definition ty1 := Type : term _. Definition ty2 := Prop : term _. Definition ty3 := Set : term _. Definition ty4 := (Type : Type) : term _. End TestTypeAsSourceCoercion. Module NonUniformInheritance. Parameters (C : nat -> bool-> Type) (D : nat -> Type). Parameter c : C O true. Parameter T : D O -> nat. Section Test0. Parameter f0 : forall (b : bool) (n : nat), C n b -> D n. Local Coercion f0 : C >-> D. Check T c. End Test0. Section Test1. Parameter f1 : forall (n : nat), C n true -> D n. Local Coercion f1 : C >-> D. Check T c. End Test1. Section Test2. Parameter f2 : forall (b : bool) (n : nat) (_ : unit), C n b -> D n. Local Coercion f2 : C >-> D. Check T c. End Test2. Section Test3. Class TC := tc : unit. Instance i : TC := tt. Parameter f3 : forall (b : bool) (n : nat) (_ : TC), C n b -> D n. Local Coercion f3 : C >-> D. Check T c. End Test3. End NonUniformInheritance. Module PhantType. Variant phant (p : Type) : Prop := Phant : phant p. Section SetType. Variable T : Type. Variant set_type : Type := FinSet : T -> set_type. Definition set_of (_ : phant T) := set_type. Identity Coercion type_of_set_of : set_of >-> set_type. End SetType. Definition sort (gT : Type) := set_of _ (Phant gT). Identity Coercion GroupSet_of_sort : sort >-> set_of. Structure group_type (gT : Type) : Type := Group { gval : sort gT; }. Coercion gval : group_type >-> sort. Section GroupProp. Variable G : group_type unit. Check G : @set_type unit. Lemma group1 : let y := G : @set_type unit in True. Abort. End GroupProp. End PhantType. coq-8.20.0/test-suite/success/cofixtac.v000066400000000000000000000003211466560755400201460ustar00rootroot00000000000000CoInductive stream := | C : content -> stream with content := | D : nat -> stream -> content. Lemma one : stream. cofix c with (d : content). - constructor. apply d. - constructor. exact 1. apply c. Defined. coq-8.20.0/test-suite/success/coindprim.v000066400000000000000000000054121466560755400203400ustar00rootroot00000000000000Require Import Program. Set Primitive Projections. CoInductive Stream (A : Type) := mkStream { hd : A; tl : Stream A}. Arguments mkStream [A] hd tl. Arguments hd [A] s. Arguments tl [A] s. Definition eta {A} (s : Stream A) := {| hd := s.(hd); tl := s.(tl) |}. CoFixpoint ones := {| hd := 1; tl := ones |}. CoFixpoint ticks := {| hd := tt; tl := ticks |}. CoInductive stream_equiv {A} (s : Stream A) (s' : Stream A) : Prop := mkStreamEq { hdeq : s.(hd) = s'.(hd); tleq : stream_equiv s.(tl) s'.(tl) }. Arguments hdeq {A} {s} {s'}. Arguments tleq {A} {s} {s'}. Program CoFixpoint ones_eq : stream_equiv ones ones.(tl) := {| hdeq := eq_refl; tleq := ones_eq |}. CoFixpoint stream_equiv_refl {A} (s : Stream A) : stream_equiv s s := {| hdeq := eq_refl; tleq := stream_equiv_refl (tl s) |}. CoFixpoint stream_equiv_sym {A} (s s' : Stream A) (H : stream_equiv s s') : stream_equiv s' s := {| hdeq := eq_sym H.(hdeq); tleq := stream_equiv_sym _ _ H.(tleq) |}. CoFixpoint stream_equiv_trans {A} {s s' s'' : Stream A} (H : stream_equiv s s') (H' : stream_equiv s' s'') : stream_equiv s s'' := {| hdeq := eq_trans H.(hdeq) H'.(hdeq); tleq := stream_equiv_trans H.(tleq) H'.(tleq) |}. Program Definition eta_eq {A} (s : Stream A) : stream_equiv s (eta s):= {| hdeq := eq_refl; tleq := stream_equiv_refl (tl (eta s))|}. Section Parks. Variable A : Type. Variable R : Stream A -> Stream A -> Prop. Hypothesis bisim1 : forall s1 s2:Stream A, R s1 s2 -> hd s1 = hd s2. Hypothesis bisim2 : forall s1 s2:Stream A, R s1 s2 -> R (tl s1) (tl s2). CoFixpoint park_ppl : forall s1 s2:Stream A, R s1 s2 -> stream_equiv s1 s2 := fun s1 s2 (p : R s1 s2) => mkStreamEq _ _ _ (bisim1 s1 s2 p) (park_ppl (tl s1) (tl s2) (bisim2 s1 s2 p)). End Parks. Program CoFixpoint iterate {A} (f : A -> A) (x : A) : Stream A := {| hd := x; tl := iterate f (f x) |}. Program CoFixpoint map {A B} (f : A -> B) (s : Stream A) : Stream B := {| hd := f s.(hd); tl := map f s.(tl) |}. Theorem map_iterate A (f : A -> A) (x : A) : stream_equiv (iterate f (f x)) (map f (iterate f x)). Proof. apply park_ppl with (R:= fun s1 s2 => exists x : A, s1 = iterate f (f x) /\ s2 = map f (iterate f x)). now intros s1 s2 (x0,(->,->)). intros s1 s2 (x0,(->,->)). now exists (f x0). now exists x. Qed. Fail Check (fun A (s : Stream A) => eq_refl : s = eta s). Notation convertible x y := (eq_refl x : x = y). Fail Check convertible ticks {| hd := hd ticks; tl := tl ticks |}. CoInductive U := inU { outU : U }. CoFixpoint u : U := inU u. CoFixpoint force (u : U) : U := inU (outU u). Lemma eq (x : U) : x = force x. Proof. Fail destruct x. Abort. (* Impossible *) coq-8.20.0/test-suite/success/contradiction.v000066400000000000000000000010631466560755400212120ustar00rootroot00000000000000(* Some tests for contradiction *) Lemma L1 : forall A B : Prop, A -> ~A -> B. Proof. intros; contradiction. Qed. Lemma L2 : forall A B : Prop, ~A -> A -> B. Proof. intros; contradiction. Qed. Lemma L3 : forall A : Prop, ~True -> A. Proof. intros; contradiction. Qed. Lemma L4 : forall A : Prop, forall x : nat, ~x=x -> A. Proof. intros; contradiction. Qed. Lemma L5 : forall A : Prop, forall x y : nat, ~x=y -> x=y -> A. Proof. intros; contradiction. Qed. Lemma L6 : forall A : Prop, forall x y : nat, x=y -> ~x=y -> A. Proof. intros; contradiction. Qed. coq-8.20.0/test-suite/success/conv_pbs.v000066400000000000000000000166351466560755400201760ustar00rootroot00000000000000(* A bit complex but realistic example whose last fixpoint definition used to fail in 8.1 because of wrong environment in conversion problems (see revision 9664) *) Require Import List. Require Import Arith. Parameter predicate : Set. Parameter function : Set. Definition variable := nat. Definition x0 := 0. Definition var_eq_dec := eq_nat_dec. Inductive term : Set := | App : function -> term -> term | Var : variable -> term. Definition atom := (predicate * term)%type. Inductive formula : Set := | Atom : atom -> formula | Imply : formula -> formula -> formula | Forall : variable -> formula -> formula. Notation "A --> B" := (Imply A B) (at level 40). Definition substitution range := list (variable * range). Fixpoint remove_assoc (A:Set)(x:variable)(rho: substitution A){struct rho} : substitution A := match rho with | nil => rho | (y,t) :: rho => if var_eq_dec x y then remove_assoc A x rho else (y,t) :: remove_assoc A x rho end. Fixpoint assoc (A:Set)(x:variable)(rho:substitution A){struct rho} : option A := match rho with | nil => None | (y,t) :: rho => if var_eq_dec x y then Some t else assoc A x rho end. Fixpoint subst_term (rho:substitution term)(t:term){struct t} : term := match t with | Var x => match assoc _ x rho with | Some a => a | None => Var x end | App f t' => App f (subst_term rho t') end. Fixpoint subst_formula (rho:substitution term)(A:formula){struct A}:formula := match A with | Atom (p,t) => Atom (p, subst_term rho t) | A --> B => subst_formula rho A --> subst_formula rho B | Forall y A => Forall y (subst_formula (remove_assoc _ y rho) A) (* assume t closed *) end. Definition subst A x t := subst_formula ((x,t):: nil) A. Record Kripke : Type := { worlds: Set; wle : worlds -> worlds -> Type; wle_refl : forall w, wle w w ; wle_trans : forall w w' w'', wle w w' -> wle w' w'' -> wle w w''; domain : Set; vars : variable -> domain; funs : function -> domain -> domain; atoms : worlds -> predicate * domain -> Type; atoms_mon : forall w w', wle w w' -> forall P, atoms w P -> atoms w' P }. Section Sem. Variable K : Kripke. Fixpoint sem (rho: substitution (domain K))(t:term){struct t} : domain K := match t with | Var x => match assoc _ x rho with | Some a => a | None => vars K x end | App f t' => funs K f (sem rho t') end. End Sem. Notation "w <= w'" := (wle _ w w'). Set Implicit Arguments. Reserved Notation "w ||- A" (at level 70). Definition context := list formula. Parameter fresh : variable -> context -> Prop. Parameter fresh_out : context -> variable. Axiom fresh_out_spec : forall Gamma, fresh (fresh_out Gamma) Gamma. Axiom fresh_peel : forall x A Gamma, fresh x (A::Gamma) -> fresh x Gamma. Fixpoint force (K:Kripke)(rho: substitution (domain K))(w:worlds K)(A:formula) {struct A} : Type := match A with | Atom (p,t) => atoms K w (p, sem K rho t) | A --> B => forall w', w <= w' -> force K rho w' A -> force K rho w' B | Forall x A => forall w', w <= w' -> forall t, force K ((x,t)::remove_assoc _ x rho) w' A end. Notation "w ||- A" := (force _ nil w A). Reserved Notation "Gamma |- A" (at level 70). Reserved Notation "Gamma ; A |- C" (at level 70, A at next level). Inductive context_prefix (Gamma:context) : context -> Type := | CtxPrefixRefl : context_prefix Gamma Gamma | CtxPrefixTrans : forall A Gamma', context_prefix Gamma Gamma' -> context_prefix Gamma (cons A Gamma'). Inductive in_context (A:formula) : list formula -> Prop := | InAxiom : forall Gamma, in_context A (cons A Gamma) | OmWeak : forall Gamma B, in_context A Gamma -> in_context A (cons B Gamma). Inductive prove : list formula -> formula -> Type := | ProofImplyR : forall A B Gamma, prove (cons A Gamma) B -> prove Gamma (A --> B) | ProofForallR : forall x A Gamma, (forall y, fresh y (A::Gamma) -> prove Gamma (subst A x (Var y))) -> prove Gamma (Forall x A) | ProofCont : forall A Gamma Gamma' C, context_prefix (A::Gamma) Gamma' -> (prove_stoup Gamma' A C) -> (Gamma' |- C) where "Gamma |- A" := (prove Gamma A) with prove_stoup : list formula -> formula -> formula -> Type := | ProofAxiom Gamma C: Gamma ; C |- C | ProofImplyL Gamma C : forall A B, (Gamma |- A) -> (prove_stoup Gamma B C) -> (prove_stoup Gamma (A --> B) C) | ProofForallL Gamma C : forall x t A, (prove_stoup Gamma (subst A x t) C) -> (prove_stoup Gamma (Forall x A) C) where " Gamma ; B |- A " := (prove_stoup Gamma B A). Axiom context_prefix_trans : forall Gamma Gamma' Gamma'', context_prefix Gamma Gamma' -> context_prefix Gamma' Gamma'' -> context_prefix Gamma Gamma''. Axiom Weakening : forall Gamma Gamma' A, context_prefix Gamma Gamma' -> Gamma |- A -> Gamma' |- A. Axiom universal_weakening : forall Gamma Gamma', context_prefix Gamma Gamma' -> forall P, Gamma |- Atom P -> Gamma' |- Atom P. Canonical Structure Universal := Build_Kripke context context_prefix CtxPrefixRefl context_prefix_trans term Var App (fun Gamma P => Gamma |- Atom P) universal_weakening. Axiom subst_commute : forall A rho x t, subst_formula ((x,t)::rho) A = subst (subst_formula rho A) x t. Axiom subst_formula_atom : forall rho p t, Atom (p, sem _ rho t) = subst_formula rho (Atom (p,t)). Fixpoint universal_completeness (Gamma:context)(A:formula){struct A} : forall rho:substitution term, force _ rho Gamma A -> Gamma |- subst_formula rho A := match A return forall rho, force _ rho Gamma A -> Gamma |- subst_formula rho A with | Atom (p,t) => fun rho H => eq_rect _ (fun A => Gamma |- A) H _ (subst_formula_atom rho p t) | A --> B => fun rho HImplyAB => let A' := subst_formula rho A in ProofImplyR (universal_completeness (A'::Gamma) B rho (HImplyAB (A'::Gamma)(CtxPrefixTrans A' (CtxPrefixRefl Gamma)) (universal_completeness_stoup A rho (fun C Gamma' Hle p => ProofCont Hle p)))) | Forall x A => fun rho HForallA => ProofForallR x (fun y Hfresh => eq_rect _ _ (universal_completeness Gamma A _ (HForallA Gamma (CtxPrefixRefl Gamma)(Var y))) _ (subst_commute _ _ _ _ )) end with universal_completeness_stoup (Gamma:context)(A:formula){struct A} : forall rho, (forall C Gamma', context_prefix Gamma Gamma' -> Gamma' ; subst_formula rho A |- C -> Gamma' |- C) -> force _ rho Gamma A := match A return forall rho, (forall C Gamma', context_prefix Gamma Gamma' -> Gamma' ; subst_formula rho A |- C -> Gamma' |- C) -> force _ rho Gamma A with | Atom (p,t) as C => fun rho H => H _ Gamma (CtxPrefixRefl Gamma)(ProofAxiom _ _) | A --> B => fun rho H => fun Gamma' Hle HA => universal_completeness_stoup B rho (fun C Gamma'' Hle' p => H C Gamma'' (context_prefix_trans Hle Hle') (ProofImplyL (Weakening Hle' (universal_completeness Gamma' A rho HA)) p)) | Forall x A => fun rho H => fun Gamma' Hle t => (universal_completeness_stoup A ((x,t)::remove_assoc _ x rho) (fun C Gamma'' Hle' p => H C Gamma'' (context_prefix_trans Hle Hle') (ProofForallL x t (subst_formula (remove_assoc _ x rho) A) (eq_rect _ (fun D => Gamma'' ; D |- C) p _ (subst_commute _ _ _ _))))) end. (* A simple example that raised an uncaught exception at some point *) Fail Check fun x => @eq_refl x <: true = true. coq-8.20.0/test-suite/success/cumulativity.v000066400000000000000000000113021466560755400211060ustar00rootroot00000000000000Polymorphic Cumulative Inductive T1 := t1 : T1. Fail Monomorphic Cumulative Inductive T2 := t2 : T2. Polymorphic Cumulative Record R1 := { r1 : T1 }. Fail Monomorphic Cumulative Inductive R2 := {r2 : T1}. Set Universe Polymorphism. Set Polymorphic Inductive Cumulativity. Set Printing Universes. Inductive List (A: Type) := nil | cons : A -> List A -> List A. Definition LiftL@{k i j|k <= i, k <= j} {A:Type@{k}} : List@{i} A -> List@{j} A := fun x => x. Lemma LiftL_Lem A (l : List A) : l = LiftL l. Proof. reflexivity. Qed. Inductive Tp := tp : Type -> Tp. Definition LiftTp@{i j|i <= j} : Tp@{i} -> Tp@{j} := fun x => x. Fail Definition LowerTp@{i j|j < i} : Tp@{i} -> Tp@{j} := fun x => x. Record Tp' := { tp' : Tp }. Definition CTp := Tp. (* here we have to reduce a constant to infer the correct subtyping. *) Record Tp''@{+u} := { tp'' : CTp@{u} }. Definition LiftTp'@{i j|i <= j} : Tp'@{i} -> Tp'@{j} := fun x => x. Definition LiftTp''@{i j|i <= j} : Tp''@{i} -> Tp''@{j} := fun x => x. Lemma LiftC_Lem (t : Tp) : LiftTp t = t. Proof. reflexivity. Qed. Section subtyping_test. Universe i j. Constraint i < j. Inductive TP2 := tp2 : Type@{i} -> Type@{j} -> TP2. End subtyping_test. Record A : Type := { a :> Type; }. Record B (X : A) : Type := { b : X; }. NonCumulative Inductive NCList (A: Type) := ncnil | nccons : A -> NCList A -> NCList A. Fail Definition LiftNCL@{k i j|k <= i, k <= j} {A:Type@{k}} : NCList@{i} A -> NCList@{j} A := fun x => x. Inductive eq@{i} {A : Type@{i}} (x : A) : A -> Type@{i} := eq_refl : eq x x. Definition funext_type@{a b e} (A : Type@{a}) (B : A -> Type@{b}) := forall f g : (forall a, B a), (forall x, eq@{e} (f x) (g x)) -> eq@{e} f g. Section down. Universes a b e e'. Constraint e' < e. Lemma funext_down {A B} : @funext_type@{a b e} A B -> @funext_type@{a b e'} A B. Proof. intros H f g Hfg. exact (H f g Hfg). Defined. End down. Record Arrow@{i j} := { arrow : Type@{i} -> Type@{j} }. Fail Definition arrow_lift@{i i' j j' | i' < i, j < j'} : Arrow@{i j} -> Arrow@{i' j'} := fun x => x. Definition arrow_lift@{i i' j j' | i' = i, j <= j'} : Arrow@{i j} -> Arrow@{i' j'} := fun x => x. Inductive Mut1 A := | Base1 : Type -> Mut1 A | Node1 : (A -> Mut2 A) -> Mut1 A with Mut2 A := | Base2 : Type -> Mut2 A | Node2 : Mut1 A -> Mut2 A. (* If we don't reduce T while inferring cumulativity for the constructor we will see a Rel and believe i is irrelevant. *) Inductive withparams@{i j} (T:=Type@{i}:Type@{j}) := mkwithparams : T -> withparams. Definition withparams_co@{i i' j|i < i', i' < j} : withparams@{i j} -> withparams@{i' j} := fun x => x. Fail Definition withparams_not_irr@{i i' j|i' < i, i' < j} : withparams@{i j} -> withparams@{i' j} := fun x => x. (** Cumulative constructors *) Record twotys@{u v w} : Type@{w} := twoconstr { fstty : Type@{u}; sndty : Type@{v} }. Monomorphic Universes i j k l. Monomorphic Constraint i < j. Monomorphic Constraint j < k. Monomorphic Constraint k < l. Parameter Tyi : Type@{i}. Definition checkcumul := eq_refl _ : @eq twotys@{k k l} (twoconstr@{i j k} Tyi Tyi) (twoconstr@{j i k} Tyi Tyi). (* They can only be compared at the highest type *) Fail Definition checkcumul' := eq_refl _ : @eq twotys@{i k l} (twoconstr@{i j k} Tyi Tyi) (twoconstr@{j i k} Tyi Tyi). (* An inductive type with an irrelevant universe *) Inductive foo@{i} : Type@{i} := mkfoo { }. Definition bar := foo. (* The universe on mkfoo is flexible and should be unified with i. *) Definition foo1@{i} : foo@{i} := let x := mkfoo in x. (* fast path for conversion *) Definition foo2@{i} : bar@{i} := let x := mkfoo in x. (* must reduce *) (* Rigid universes however should not be unified unnecessarily. *) Definition foo3@{i j|} : foo@{i} := let x := mkfoo@{j} in x. Definition foo4@{i j|} : bar@{i} := let x := mkfoo@{j} in x. (* Constructors for an inductive with indices *) Module WithIndex. Inductive foo@{i} : (Prop -> Prop) -> Prop := mkfoo: foo (fun x => x). Monomorphic Universes i j. Monomorphic Constraint i < j. Definition bar : eq mkfoo@{i} mkfoo@{j} := eq_refl _. End WithIndex. Module CumulApp. (* i is covariant here, and we have one parameter *) Inductive foo@{i} (A : nat) : Type@{i+1} := mkfoo (B : Type@{i}). Definition bar@{i j|i<=j} := fun x : foo@{i} 0 => x : foo@{j} 0. End CumulApp. Module InSection. Section S. Polymorphic Cumulative Structure T : Type := {sort : Type}. Polymorphic Universe u. Polymorphic Cumulative Structure T' : Type := {sort' : Type -> Type@{u}}. Polymorphic Cumulative Structure T'' : Type := {sort'' : Type}. End S. Check T@{Set}. Check T'@{Set Set}. (* T'' expects two universes, that is also u; do we really want it? *) Fail Check T''@{Set}. End InSection. coq-8.20.0/test-suite/success/custom_entry.v000066400000000000000000000003541466560755400211070ustar00rootroot00000000000000Declare Custom Entry foo. Print Custom Grammar foo. Notation "[ e ]" := e (e custom foo at level 0). Print Custom Grammar foo. Notation "1" := O (in custom foo at level 0). Print Custom Grammar foo. Fail Declare Custom Entry foo. coq-8.20.0/test-suite/success/definition_using.v000066400000000000000000000054361466560755400217170ustar00rootroot00000000000000Require Import Program. Axiom bogus : Type. Section A. Variable x : bogus. #[using="All"] Definition c1 : bool := true. #[using="All"] Fixpoint c2 n : bool := match n with | O => true | S p => c3 p end with c3 n : bool := match n with | O => true | S p => c2 p end. #[using="All"] Definition c4 : bool. Proof. exact true. Qed. #[using="All"] Fixpoint c5 (n : nat) {struct n} : bool. Proof. destruct n as [|p]. exact true. exact (c5 p). Qed. #[using="All", program] Definition c6 : bool. Proof. exact true. Qed. #[using="All", program] Fixpoint c7 (n : nat) {struct n} : bool := match n with | O => true | S p => c7 p end. Fail #[using="dummy", program] Fixpoint c7' (n : nat) {struct n} : bool := match n with | O => true | S p => c7' p end. Fail #[using="c7'", program] Fixpoint c7' (n : nat) {struct n} : bool := match n with | O => true | S p => c7' p end. End A. Check c1 : bogus -> bool. Check c2 : bogus -> nat -> bool. Check c3 : bogus -> nat -> bool. Check c4 : bogus -> bool. Check c5 : bogus -> nat -> bool. Check c6 : bogus -> bool. Check c7 : bogus -> nat -> bool. Section B. Variable a : bogus. Variable h : c1 a = true. #[using="a*"] Definition c8 : bogus := a. Collection ccc := a h. #[using="ccc"] Definition c9 : bogus := a. #[using="ccc - h"] Definition c10 : bogus := a. End B. Check c8 : forall a, c1 a = true -> bogus. Check c9 : forall a, c1 a = true -> bogus. Check c10: bogus -> bogus. Module TypeBehavior. Section S. Variables a : nat. #[using="Type", warning="-non-recursive"] Program Fixpoint b1 (n:nat) : nat := (fun _ => 0) a. Program Fixpoint b2 (n:nat) : (fun X _ => X) nat a := 0. Program Fixpoint b3 (n:nat) : (fun X _ => X) nat a := (fun _ => 0) a. Program Definition c1 : nat := (fun _ => 0) a. Program Definition c2 : (fun X _ => X) nat a := 0. Program Definition c3 : (fun X _ => X) nat a := (fun _ => 0) a. Fixpoint d1 (n:nat) : nat := (fun _ => 0) a. Fixpoint d2 (n:nat) : (fun X _ => X) nat a := 0. Fixpoint d3 (n:nat) : (fun X _ => X) nat a := (fun _ => 0) a. Definition e1 : nat := (fun _ => 0) a. Definition e2 : (fun X _ => X) nat a := 0. Definition e3 : (fun X _ => X) nat a := (fun _ => 0) a. End S. (* Not clear what is most expected below... *) (* Dependency in a with Program Fixpoint: the body is not reduced. *) (* As of now, we don't seem to have such a case. *) (* No dependency in a with Program Fixpoint, because both body and type are beta-reduced *) Check b1 0 : nat. Check b2 0 : nat. Check b3 0 : nat. (* With Program Definition, type is beta-reduced but not the body *) Check c1 0 : nat. Check c2 : nat. Check c3 0 : nat. (* With Definition/Fixpoint, neither body nor type are beta-reduced *) Check d1 0 0 : nat. Check d2 0 0 : nat. Check d3 0 0 : nat. Check e1 0 : nat. Check e2 0 : nat. Check e3 0 : nat. End TypeBehavior. coq-8.20.0/test-suite/success/dependentind.v000066400000000000000000000075401466560755400210210ustar00rootroot00000000000000Require Import Coq.Program.Program Coq.Program.Equality. Goal forall (H: forall n m : nat, n = m -> n = 0) x, x = tt. intros. dependent destruction x. reflexivity. Qed. Parameter A : Set. Inductive vector : nat -> Type := vnil : vector 0 | vcons : A -> forall {n}, vector n -> vector (S n). Goal forall n, forall v : vector (S n), vector n. Proof. intros n H. dependent destruction H. assumption. Qed. Require Import ProofIrrelevance. Goal forall n, forall v : vector (S n), exists v' : vector n, exists a : A, v = vcons a v'. Proof. intros n v. dependent destruction v. exists v ; exists a. reflexivity. Qed. (* Extraction Unnamed_thm. *) Inductive type : Type := | base : type | arrow : type -> type -> type. Notation " t --> t' " := (arrow t t') (at level 20, t' at next level). Inductive ctx : Type := | empty : ctx | snoc : ctx -> type -> ctx. Bind Scope context_scope with ctx. Delimit Scope context_scope with ctx. Arguments snoc _%_context_scope. Notation " Γ , τ " := (snoc Γ τ) (at level 25, τ at next level, left associativity) : context_scope. Fixpoint conc (Δ Γ : ctx) : ctx := match Δ with | empty => Γ | snoc Δ' x => snoc (conc Δ' Γ) x end. Notation " Γ ; Δ " := (conc Δ Γ) (at level 25, left associativity) : context_scope. Reserved Notation " Γ ⊢ τ " (at level 30, no associativity). Generalizable All Variables. Inductive term : ctx -> type -> Type := | ax : `(Γ, τ ⊢ τ) | weak : `{Γ ⊢ τ -> Γ, τ' ⊢ τ} | abs : `{Γ, τ ⊢ τ' -> Γ ⊢ τ --> τ'} | app : `{Γ ⊢ τ --> τ' -> Γ ⊢ τ -> Γ ⊢ τ'} where " Γ ⊢ τ " := (term Γ τ) : type_scope. #[export] Hint Constructors term : lambda. Local Open Scope context_scope. Ltac eqns := subst ; reverse ; simplify_dep_elim ; simplify_IH_hyps. Lemma weakening : forall Γ Δ τ, Γ ; Δ ⊢ τ -> forall τ', Γ , τ' ; Δ ⊢ τ. Proof with simpl in * ; eqns ; eauto with lambda. intros Γ Δ τ H. dependent induction H. destruct Δ as [|Δ τ'']... destruct Δ as [|Δ τ'']... destruct Δ as [|Δ τ'']... apply abs. specialize (IHterm Γ (Δ, τ'', τ))... intro. eapply app... Defined. Lemma weakening_ctx : forall Γ Δ τ, Γ ; Δ ⊢ τ -> forall Δ', Γ ; Δ' ; Δ ⊢ τ. Proof with simpl in * ; eqns ; eauto with lambda. intros Γ Δ τ H. dependent induction H. destruct Δ as [|Δ τ'']... induction Δ'... destruct Δ as [|Δ τ'']... induction Δ'... destruct Δ as [|Δ τ'']... apply abs. specialize (IHterm Γ (empty, τ))... apply abs. specialize (IHterm Γ (Δ, τ'', τ))... intro. eapply app... Defined. Lemma exchange : forall Γ Δ α β τ, term (Γ, α, β ; Δ) τ -> term (Γ, β, α ; Δ) τ. Proof with simpl in * ; eqns ; eauto. intros until 1. dependent induction H. destruct Δ ; eqns. apply weak ; apply ax. apply ax. destruct Δ... pose (weakening Γ (empty, α))... apply weak... apply abs... specialize (IHterm Γ (Δ, τ))... eapply app... Defined. (** Example by Andrew Kenedy, uses simplification of the first component of dependent pairs. *) Set Implicit Arguments. Inductive Ty := | Nat : Ty | Prod : Ty -> Ty -> Ty. Inductive Exp : Ty -> Type := | Const : nat -> Exp Nat | Pair : forall t1 t2, Exp t1 -> Exp t2 -> Exp (Prod t1 t2) | Fst : forall t1 t2, Exp (Prod t1 t2) -> Exp t1. Inductive Ev : forall t, Exp t -> Exp t -> Prop := | EvConst : forall n, Ev (Const n) (Const n) | EvPair : forall t1 t2 (e1:Exp t1) (e2:Exp t2) e1' e2', Ev e1 e1' -> Ev e2 e2' -> Ev (Pair e1 e2) (Pair e1' e2') | EvFst : forall t1 t2 (e:Exp (Prod t1 t2)) e1 e2, Ev e (Pair e1 e2) -> Ev (Fst e) e1. Lemma EvFst_inversion : forall t1 t2 (e:Exp (Prod t1 t2)) e1, Ev (Fst e) e1 -> exists e2, Ev e (Pair e1 e2). intros t1 t2 e e1 ev. dependent destruction ev. exists e2 ; assumption. Qed. coq-8.20.0/test-suite/success/destruct.v000066400000000000000000000232621466560755400202140ustar00rootroot00000000000000(* Submitted by Robert Schneck *) Parameters A B C D : Prop. Axiom X : A -> B -> C /\ D. Lemma foo : A -> B -> C. Proof. intros. destruct X. (* Should find axiom X and should handle arguments of X *) assumption. assumption. assumption. Qed. (* Simplification of BZ#711 *) Parameter f : true = false. Goal let p := f in True. intro p. set (b := true) in *. (* Check that it doesn't fail with an anomaly *) (* Ultimately, adapt destruct to make it succeeding *) try destruct b. Abort. (* Used to fail with error "n is used in conclusion" before revision 9447 *) Goal forall n, n = S n. induction S. Abort. (* Check that elimination with remaining evars do not raise an bad error message *) Theorem Refl : forall P, P <-> P. tauto. Qed. Goal True. case Refl || ecase Refl. Abort. (* Submitted by B. Baydemir (BZ#1882) *) Require Import List. Definition alist R := list (nat * R)%type. Section Properties. Variable A : Type. Variable a : A. Variable E : alist A. Lemma silly : E = E. Proof. clear. induction E. (* this fails. *) Abort. End Properties. (* This used not to work before revision 11944 *) Goal forall P:(forall n, 0=n -> Prop), forall H: 0=0, P 0 H. destruct H. Abort. (* The calls to "destruct" below did not work before revision 12356 *) Parameter A0:Type. Parameter P:A0->Type. Require Import JMeq. Goal forall a b (p:P a) (q:P b), forall H:a = b, eq_rect a P p b H = q -> JMeq (existT _ a p) (existT _ b q). intros. destruct H. destruct H0. reflexivity. Qed. (* These did not work before 8.4 *) Goal (exists x, x=0) -> True. destruct 1 as (_,_); exact I. Abort. Goal (exists x, x=0 /\ True) -> True. destruct 1 as (_,(_,H)); exact H. Abort. Goal (exists x, x=0 /\ True) -> True. destruct 1 as (_,(_,x)); exact x. Abort. Goal let T:=nat in forall (x:nat) (g:T -> nat), g x = 0. intros. destruct (g _). (* This was failing in at least r14571 *) Abort. (* Check that subterm selection does not solve existing evars *) Goal exists x, S x = S 0. eexists ?[x]. Show x. (* Incidentally test Show on a named goal *) destruct (S _). (* Incompatible occurrences but takes the first one since Oct 2014 *) change (0 = S 0). Abort. Goal exists x, S 0 = S x. eexists ?[x]. destruct (S _). (* Incompatible occurrences but takes the first one since Oct 2014 *) change (0 = S ?x). [x]: exact 0. (* Incidentally test applying a tactic to a goal on the shelve *) Abort. Goal exists n p:nat, (S n,S n) = (S p,S p) /\ p = n. eexists ?[n]; eexists ?[p]. destruct (_, S _). (* Was unifying at some time in trunk, now takes the first occurrence *) change ((n, n0) = (S ?p, S ?p) /\ ?p = ?n). Abort. (* An example with incompatible but convertible occurrences *) Goal id (id 0) = 0. Fail destruct (id _) at 1 2. Abort. (* Avoid unnatural selection of a subterm larger than expected *) Goal let g := fun x:nat => x in g (S 0) = 0. intro. destruct S. (* Check that it is not the larger subterm "g (S 0)" which is selected, as it was the case in 8.4 *) unfold g at 1. Abort. (* Some tricky examples convenient to support *) Goal forall x, nat_rect (fun _ => nat) O (fun x y => S x) x = nat_rect (fun _ => nat) O (fun x y => S x) x. intros. destruct (nat_rect _ _ _ _). Abort. (* Check compatibility in selecting what is open or "shelved" *) Goal (forall x, x=0 -> nat) -> True. intros. Fail destruct H. edestruct H. - reflexivity. - exact Logic.I. - exact Logic.I. Qed. (* Check an example which was working with case/elim in 8.4 but not with destruct/induction *) Goal forall x, (True -> x = 0) -> 0=0. intros. destruct H. - trivial. - apply (eq_refl x). Qed. (* Check an example which was working with case/elim in 8.4 but not with destruct/induction (not the different order between induction/destruct) *) Goal forall x, (True -> x = 0) -> 0=0. intros. induction H. - apply (eq_refl x). - trivial. Qed. (* This test assumes that destruct/induction on non-dependent hypotheses behave the same when using holes or not Goal forall x, (True -> x = 0) -> 0=0. intros. destruct (H _). - apply I. - apply (eq_refl x). Qed. *) (* Check destruct vs edestruct *) Goal forall x, (forall y, y = 0 -> x = 0) -> 0=0. intros. Fail destruct H. edestruct H. - trivial. - apply (eq_refl x). Qed. Goal forall x, (forall y, y = 0 -> x = 0) -> 0=0. intros. Fail destruct (H _ _). (* Now a test which assumes that edestruct on non-dependent hypotheses accept unresolved subterms in the induction argument. edestruct (H _ _). - trivial. - apply (eq_refl x). Qed. *) Abort. (* Test selection when not in an inductive type *) Parameter T:Type. Axiom elim: forall P, T -> P. Goal forall a:T, a = a. induction a using elim. Qed. Goal forall a:nat -> T, a 0 = a 1. intro a. induction (a 0) using elim. Qed. (* From Oct 2014, a subterm is found, as if without "using"; in 8.4, it did not find a subterm *) Goal forall a:nat -> T, a 0 = a 1. intro a. induction a using elim. Qed. Goal forall a:nat -> T, forall b, a 0 = b. intros a b. induction a using elim. Qed. (* From Oct 2014, first subterm is found; in 8.4, it failed because it found "a 0" and wanted to clear a *) Goal forall a:nat -> nat, a 0 = a 1. intro a. destruct a. change (0 = a 1). Abort. (* This example of a variable not fully applied in the goal was working in 8.4*) Goal forall H : 0<>0, H = H. destruct H. reflexivity. Qed. (* Check that variables not fully applied in the goal are not erased (this example was failing in 8.4 because of a forbidden "clear H" in the code of "destruct H" *) Goal forall H : True -> True, H = H. destruct H. - exact I. - reflexivity. Qed. (* Check destruct on idents with maximal implicit arguments - which did not work in 8.4 *) Parameter g : forall {n:nat}, n=n -> nat. Goal g (eq_refl 0) = 0. destruct g. Abort. (* This one was working in 8.4 (because of full conv on closed arguments) *) Class E. #[export] Instance a:E := {}. Goal forall h : E -> nat -> nat, h (id a) 0 = h a 0. intros. destruct (h _). change (0=0). Abort. (* This one was not working in 8.4 because an occurrence of f was remaining, blocking the "clear f" *) Goal forall h : E -> nat -> nat, h a 0 = h a 1. intros. destruct h. Abort. (* This was not working in 8.4 *) Section S1. Variables x y : Type. Variable H : x = y. Goal True. destruct H. (* Was not working in 8.4 *) (* Now check that H statement has itself be subject of the rewriting *) change (x=x) in H. Abort. End S1. (* This was not working in 8.4 because of untracked dependencies *) Goal forall y, forall h:forall x, x = y, h 0 = h 0. intros. destruct (h 0). Abort. (* Check absence of useless local definitions *) Section S2. Variable H : 1=1. Goal 0=1. destruct H. Fail clear n. (* Check that there is no n as it was in Coq <= 8.4 *) Abort. End S2. Goal forall x:nat, x=x->x=1. intros x H. destruct H. Fail clear n. (* Check that there is no n as it was in Coq <= 8.4 *) Fail clear H. (* Check that H has been removed *) Abort. (* Check support for induction arguments which do not expose an inductive type rightaway *) Definition U := nat -> nat. Definition S' := S : U. Goal forall n, S' n = 0. intro. destruct S'. Abort. (* This was working by chance in 8.4 thanks to "accidental" use of select subterms _syntactically_ equal to the first matching one. Parameter f2:bool -> unit. Parameter r2:f2 true=f2 true. Goal forall (P: forall b, b=b -> Prop), f2 (id true) = tt -> P (f2 true) r2. intros. destruct f2. Abort. *) (* This did not work in 8.4, because of a clear failing *) Inductive IND : forall x y:nat, x=y -> Type := CONSTR : IND 0 0 eq_refl. Goal forall x y e (h:x=y -> y=x) (z:IND y x (h e)), e = e /\ z = z. intros. destruct z. Abort. (* The two following examples show how the variables occurring in the term being destruct affects the generalization; don't know if these behaviors are "good". None of them was working in 8.4. *) Goal forall x y e (t:x=y) (z:x=y -> IND y x e), e = e. intros. destruct (z t). change (0=0) in t. (* Generalization made *) Abort. Goal forall x y e (t:x=y) (z:x=y -> IND y x e), e = e /\ z t = z t. intros. destruct (z t). change (0=0) in t. (* Generalization made *) Abort. (* Check that destruct on a scheme with a functional argument works *) Goal (forall P:Prop, (nat->nat) -> P) -> forall h:nat->nat, h 0 = h 0. intros. destruct h using H. Qed. Goal (forall P:Prop, (nat->nat) -> P) -> forall h:nat->nat->nat, h 0 0 = h 1 0. intros. induction (h 1) using H. Qed. (* Check blocking generalization is not too strong (failed at some time) *) Goal (E -> 0=1) -> 1=0 -> True. intros. destruct (H _). change (0=0) in H0. (* Check generalization on H0 was made *) Abort. (* Check absence of anomaly (failed at some time) *) Goal forall A (a:A) (P Q:A->Prop), (forall a, P a -> Q a) -> True. intros. Fail destruct H. Abort. (* Check keep option (BZ#3791) *) Goal forall b:bool, True. intro b. destruct (b). clear b. (* b has to be here *) Abort. (* Check clearing of names *) Inductive IND2 : nat -> Prop := CONSTR2 : forall y, y = y -> IND2 y. Goal forall x y z:nat, y = z -> x = y -> y = x -> x = y. intros * Heq H Heq'. destruct H. Abort. Goal 2=1 -> 1=0. intro H. destruct H. Fail (match goal with n:nat |- _ => unfold n end). (* Check that no let-in remains *) Abort. (* Check clearing of names *) Inductive eqnat (x : nat) : nat -> Prop := reflnat : forall y, x = y -> eqnat x y. Goal forall x z:nat, x = z -> eqnat x z -> True. intros * H1 H. destruct H. Fail clear z. (* Should not be here *) Abort. (* Check ok in the presence of an equation *) Goal forall b:bool, b = b. intros. destruct b eqn:H. Abort. (* Check natural instantiation behavior when the goal has already an evar *) Goal exists x, S x = x. eexists ?[x]. destruct (S _). change (0 = ?x). Abort. Goal (forall P, P 0 -> True/\True) -> True. intro H. destruct (H (fun x => True)). match goal with |- True => idtac end. Abort. coq-8.20.0/test-suite/success/dtauto_let_deps.v000066400000000000000000000014321466560755400215310ustar00rootroot00000000000000(* This test is sensitive to changes in which let-ins are expanded when checking for dependencies in constructors. If the (x := X) is not reduced, Foo1 won't be recognized as a conjunction, and if the (y := X) is reduced, Foo2 will be recognized as a conjunction. This tests the behavior of engine/termops.ml : prod_applist_assum, which is currently specified to reduce exactly the parameters. If dtauto is changed to reduce lets in constructors before checking dependency, this test will need to be changed. *) Parameter (P Q : Type). Inductive Foo1 (X : Type) (x := X) := foo1 : let y := X in P -> Q -> Foo1 x. Inductive Foo2 (X : Type) (x := X) := foo2 : let y := X in P -> Q -> Foo2 y. Goal P -> Q -> Foo1 nat. solve [dtauto]. Qed. Goal P -> Q -> Foo2 nat. Fail solve [dtauto]. Abort. coq-8.20.0/test-suite/success/eapply_evar.v000066400000000000000000000004341466560755400206620ustar00rootroot00000000000000(* Test propagation of evars from subgoal to brother subgoals *) (* This does not work (oct 2008) because "match goal" sees "?evar = O" and not "O = O" *) Lemma eapply_evar : O=O -> 0=O. intro H; eapply eq_trans; [apply H | match goal with |- ?x = ?x => reflexivity end]. Qed. coq-8.20.0/test-suite/success/eauto.v000066400000000000000000000135101466560755400174670ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* constructor : typeclass_instances. Existing Class and. Goal exists (T : Type) (t : T), A T /\ B T t. Proof. eexists. eexists. typeclasses eauto. Defined. #[export] Instance ab: A bool := {}. (* Backtrack on A instance *) Goal exists (T : Type) (t : T), A T /\ B T t. Proof. eexists. eexists. typeclasses eauto. Defined. Class C {T} `(a : A T) (t : T). Require Import Classes.Init. #[export] Hint Extern 0 { x : ?A & _ } => unshelve class_apply @existT : typeclass_instances. Existing Class sigT. Set Typeclasses Debug. #[export] Instance can: C an 0 := {}. (* Backtrack on instance implementation *) Goal exists (T : Type) (t : T), { x : A T & C x t }. Proof. eexists. eexists. typeclasses eauto. Defined. Class D T `(a: A T). #[export] Instance: D _ an := {}. Goal exists (T : Type), { x : A T & D T x }. Proof. eexists. typeclasses eauto. Defined. (* Example from Nicolas Magaud on coq-club - Jul 2000 *) Definition Nat : Set := nat. Parameter S' : Nat -> Nat. Parameter plus' : Nat -> Nat -> Nat. Lemma simpl_plus_l_rr1 : (forall n0 : Nat, (forall m p : Nat, plus' n0 m = plus' n0 p -> m = p) -> forall m p : Nat, S' (plus' n0 m) = S' (plus' n0 p) -> m = p) -> forall n : Nat, (forall m p : Nat, plus' n m = plus' n p -> m = p) -> forall m p : Nat, S' (plus' n m) = S' (plus' n p) -> m = p. intros. apply H0. apply f_equal_nat. Time info_eauto. Undo. Set Typeclasses Debug. Set Typeclasses Iterative Deepening. Time typeclasses eauto 6 with nocore. Show Proof. Undo. Time eauto. (* does EApply H *) Qed. (* Example from Nicolas Tabareau on coq-club - Feb 2016. Full backtracking on dependent subgoals. *) Require Import Coq.Classes.Init. Module NTabareau. Set Typeclasses Dependency Order. Unset Typeclasses Iterative Deepening. Notation "x .1" := (projT1 x). Notation "x .2" := (projT2 x). Parameter myType: Type. Class Foo (a:myType) := {}. Class Bar (a:myType) := {}. Class Qux (a:myType) := {}. Parameter fooTobar : forall a (H : Foo a), {b: myType & Bar b}. Parameter barToqux : forall a (H : Bar a), {b: myType & Qux b}. #[export] Hint Extern 5 (Bar ?D.1) => destruct D; simpl : typeclass_instances. #[export] Hint Extern 5 (Qux ?D.1) => destruct D; simpl : typeclass_instances. #[export] Hint Extern 1 myType => unshelve refine (fooTobar _ _).1 : typeclass_instances. #[export] Hint Extern 1 myType => unshelve refine (barToqux _ _).1 : typeclass_instances. #[export] Hint Extern 0 { x : _ & _ } => simple refine (existT _ _ _) : typeclass_instances. Unset Typeclasses Debug. Definition trivial a (H : Foo a) : {b : myType & Qux b}. Proof. Time typeclasses eauto 10 with typeclass_instances. Undo. Set Typeclasses Iterative Deepening. Time typeclasses eauto with typeclass_instances. Defined. End NTabareau. Module NTabareauClasses. Set Typeclasses Dependency Order. Unset Typeclasses Iterative Deepening. Notation "x .1" := (projT1 x). Notation "x .2" := (projT2 x). Parameter myType: Type. Existing Class myType. Class Foo (a:myType) := {}. Class Bar (a:myType) := {}. Class Qux (a:myType) := {}. Parameter fooTobar : forall a (H : Foo a), {b: myType & Bar b}. Parameter barToqux : forall a (H : Bar a), {b: myType & Qux b}. #[export] Hint Extern 5 (Bar ?D.1) => destruct D; simpl : typeclass_instances. #[export] Hint Extern 5 (Qux ?D.1) => destruct D; simpl : typeclass_instances. #[export] Hint Extern 1 myType => unshelve notypeclasses refine (fooTobar _ _).1 : typeclass_instances. #[export] Hint Extern 1 myType => unshelve notypeclasses refine (barToqux _ _).1 : typeclass_instances. #[export] Hint Extern 0 { x : _ & _ } => unshelve notypeclasses refine (existT _ _ _) : typeclass_instances. Unset Typeclasses Debug. Definition trivial a (H : Foo a) : {b : myType & Qux b}. Proof. Time typeclasses eauto 10 with typeclass_instances. Undo. Set Typeclasses Iterative Deepening. (* Much faster in iteratove deepening mode *) Time typeclasses eauto with typeclass_instances. Defined. End NTabareauClasses. Require Import List. Parameter in_list : list (nat * nat) -> nat -> Prop. Definition not_in_list (l : list (nat * nat)) (n : nat) : Prop := ~ in_list l n. (* Hints Unfold not_in_list. *) Axiom lem1 : forall (l1 l2 : list (nat * nat)) (n : nat), not_in_list (l1 ++ l2) n -> not_in_list l1 n. Axiom lem2 : forall (l1 l2 : list (nat * nat)) (n : nat), not_in_list (l1 ++ l2) n -> not_in_list l2 n. Axiom lem3 : forall (l : list (nat * nat)) (n p q : nat), not_in_list ((p, q) :: l) n -> not_in_list l n. Axiom lem4 : forall (l1 l2 : list (nat * nat)) (n : nat), not_in_list l1 n -> not_in_list l2 n -> not_in_list (l1 ++ l2) n. #[export] Hint Resolve lem1 lem2 lem3 lem4: essai. Goal forall (l : list (nat * nat)) (n p q : nat), not_in_list ((p, q) :: l) n -> not_in_list l n. intros. eauto with essai. Qed. coq-8.20.0/test-suite/success/eqdecide.v000066400000000000000000000022441466560755400201170ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* T. Lemma lem1 : forall x y : T, {x = y} + {x <> y}. decide equality. Qed. Lemma lem1' : forall x y : T, x = y \/ x <> y. decide equality. Qed. Lemma lem1'' : forall x y : T, {x <> y} + {x = y}. decide equality. Qed. Lemma lem1''' : forall x y : T, x <> y \/ x = y. decide equality. Qed. Lemma lem2 : forall x y : T, {x = y} + {x <> y}. intros x y. decide equality. Qed. Lemma lem4 : forall x y : T, {x = y} + {x <> y}. intros x y. compare x y; auto. Qed. coq-8.20.0/test-suite/success/eqtacticsnois.v000066400000000000000000000005431466560755400212250ustar00rootroot00000000000000(* coq-prog-args: ("-nois") *) Inductive eq {A : Type} (x : A) : forall a:A, Prop := eq_refl : eq x x. Axiom sym : forall A (x y : A) (_ : eq x y), eq y x. Require Import Ltac. Register eq as core.eq.type. Register sym as core.eq.sym. Goal forall A (x y:A) (_ : forall z, eq y z), eq x x. intros * H. replace x with y. - reflexivity. - apply H. Qed. coq-8.20.0/test-suite/success/eta.v000066400000000000000000000011231466560755400171200ustar00rootroot00000000000000(* Kernel test (head term is a constant) *) Check (fun a : S = S => a : S = fun x => S x). (* Kernel test (head term is a variable) *) Check (fun (f:nat->nat) (a : f = f) => a : f = fun x => f x). (* Test type inference (head term is syntactically rigid) *) Check (fun (a : list = list) => a : list = fun A => _ A). (* Test type inference (head term is a variable) *) (* This one is still to be done... Check (fun (f:nat->nat) (a : f = f) => a : f = fun x => _ x). *) (* Test tactic unification *) Goal (forall f:nat->nat, (fun x => f x) = (fun x => f x)) -> S = S. intro H; apply H. Qed. coq-8.20.0/test-suite/success/evars.v000066400000000000000000000326701466560755400175020ustar00rootroot00000000000000 (* The "?" of cons and eq should be inferred *) Parameter list : Set -> Set. Parameter cons : forall T : Set, T -> list T -> list T. Check (forall n : list nat, exists l : _, (exists x : _, n = cons _ x l)). (* Examples provided by Eduardo Gimenez *) Definition c A (Q : (nat * A -> Prop) -> Prop) P := Q (fun p : nat * A => let (i, v) := p in P i v). (* What does this test ? *) Require Import List. Definition list_forall_bool (A : Set) (p : A -> bool) (l : list A) : bool := fold_right (fun a r => if p a then r else false) true l. (* Checks that solvable ? in the lambda prefix of the definition are harmless*) Parameter A1 A2 F B C : Set. Parameter f : F -> A1 -> B. Definition f1 frm0 a1 : B := f frm0 a1. (* Checks that solvable ? in the type part of the definition are harmless *) Definition f2 frm0 a1 : B := f frm0 a1. (* Checks that sorts that are evars are handled correctly (BZ#705) *) Require Import List. Fixpoint build (nl : list nat) : match nl with | nil => True | _ => False end -> unit := match nl return (match nl with | nil => True | _ => False end -> unit) with | nil => fun _ => tt | n :: rest => match n with | O => fun _ => tt | S m => fun a => build rest (False_ind _ a) end end. (* Checks that disjoint contexts are correctly set by restrict_hyp *) (* Bug de 1999 corrigé en déc 2004 *) Check (let p := fun (m : nat) f (n : nat) => match f m n with | exist _ a b => exist _ a b end in p :forall x : nat, (forall y n : nat, {q : nat | y = q * n}) -> forall n : nat, {q : nat | x = q * n}). (* Check instantiation of nested evars (BZ#1089) *) Check (fun f:(forall (v:Type->Type), v (v nat) -> nat) => f _ (Some (Some O))). (* This used to fail with anomaly (Pp.str "evar was not declared.") in V8.0pl3 *) Theorem contradiction : forall p, ~ p -> p -> False. Proof. trivial. Qed. #[export] Hint Resolve contradiction. Goal False. eauto. Abort. (* This used to fail in V8.1beta because first-order unification was used before using type information *) Check (exist _ O (refl_equal 0) : {n:nat|n=0}). Check (exist _ O I : {n:nat|True}). (* An example (initially from Marseille/Fairisle) that involves an evar with different solutions (Input, Output or bool) that may or may not be considered distinct depending on which kind of conversion is used *) Section A. Definition STATE := (nat * bool)%type. Let Input := bool. Let Output := bool. Parameter Out : STATE -> Output. Check fun (s : STATE) (reg : Input) => reg = Out s. End A. (* The return predicate found should be: "in _=U return U" *) (* (feature already available in V8.0) *) Definition g (T1 T2:Type) (x:T1) (e:T1=T2) : T2 := match e with | refl_equal => x end. (* An example extracted from FMapAVL which (may) test restriction on evars problems of the form ?n[args1]=?n[args2] with distinct args1 and args2 *) Set Implicit Arguments. Parameter t:Set->Set. Parameter map:forall elt elt' : Set, (elt -> elt') -> t elt -> t elt'. Parameter avl: forall elt : Set, t elt -> Prop. Parameter bst: forall elt : Set, t elt -> Prop. Parameter map_avl: forall (elt elt' : Set) (f : elt -> elt') (m : t elt), avl m -> avl (map f m). Parameter map_bst: forall (elt elt' : Set) (f : elt -> elt') (m : t elt), bst m -> bst (map f m). Record bbst (elt:Set) : Set := Bbst {this :> t elt; is_bst : bst this; is_avl: avl this}. Definition t' := bbst. Section B. Variables elt elt': Set. Definition map' f (m:t' elt) : t' elt' := Bbst (map_bst f m.(is_bst)) (map_avl f m.(is_avl)). End B. Unset Implicit Arguments. (* An example from Lexicographic_Exponentiation that tests the contraction of reducible fixpoints in type inference *) Require Import List. Check (fun (A:Set) (a b x:A) (l:list A) (H : l ++ cons x nil = cons b (cons a nil)) => app_inj_tail l (cons b nil) _ _ H). (* An example from NMake (simplified), that uses restriction in solve_refl *) Parameter h:(nat->nat)->(nat->nat). Fixpoint G p cont {struct p} := h (fun n => match p with O => cont | S p => G p cont end n). (* An example from Bordeaux/Cantor that applies evar restriction below a binder *) Require Import Relations. Parameter lex : forall (A B : Set), (forall (a1 a2:A), {a1=a2}+{a1<>a2}) -> relation A -> relation B -> A * B -> A * B -> Prop. Check forall (A B : Set) eq_A_dec o1 o2, antisymmetric A o1 -> transitive A o1 -> transitive B o2 -> transitive _ (lex _ _ eq_A_dec o1 o2). (* Another example from Julien Forest that tests unification below binders *) Require Import List. Set Implicit Arguments. Parameter merge : forall (A B : Set) (eqA : forall (a1 a2 : A), {a1=a2}+{a1<>a2}) (eqB : forall (b1 b2 : B), {b1=b2}+{b1<>b2}) (partial_res l : list (A*B)), option (list (A*B)). Axiom merge_correct : forall (A B : Set) eqA eqB (l1 l2 : list (A*B)), (forall a2 b2 c2, In (a2,b2) l2 -> In (a2,c2) l2 -> b2 = c2) -> match merge eqA eqB l1 l2 with _ => True end. Unset Implicit Arguments. (* An example from Bordeaux/Additions that tests restriction below binders *) Section Additions_while. Variable A : Set. Variables P Q : A -> Prop. Variable le : A -> A -> Prop. Hypothesis Q_dec : forall s : A, P s -> {Q s} + {~ Q s}. Hypothesis le_step : forall s : A, ~ Q s -> P s -> {s' | P s' /\ le s' s}. Hypothesis le_wf : well_founded le. Lemma loopexec : forall s : A, P s -> {s' : A | P s' /\ Q s'}. refine (well_founded_induction_type le_wf (fun s => _ -> {s' : A | _ /\ _}) (fun s hr i => match Q_dec s i with | left _ => _ | right _ => match le_step s _ _ with | exist _ s' h' => match hr s' _ _ with | exist _ s'' _ => exist _ s'' _ end end end)). Abort. End Additions_while. (* Two examples from G. Melquiond (BZ#1878 and BZ#1884) *) Parameter F1 G1 : nat -> Prop. Goal forall x : nat, F1 x -> G1 x. refine (fun x H => proj2 (_ x H)). Abort. Goal forall x : nat, F1 x -> G1 x. refine (fun x H => proj2 (_ x H) _). Abort. (* An example from y-not that was failing in 8.2rc1 *) Fixpoint filter (A:nat->Set) (l:list (sigT A)) : list (sigT A) := match l with | nil => nil | (existT _ k v)::l' => (existT _ k v):: (filter A l') end. (* BZ#2000: used to raise Out of memory in 8.2 while it should fail by lack of information on the conclusion of the type of j *) Goal True. set (p:=fun j => j (or_intror _ (fun a:True => j (or_introl _ a)))) || idtac. Abort. (* Remark: the following example stopped succeeding at some time in the development of 8.2 but it works again (this was because 8.2 algorithm was more general and did not exclude a solution that it should have excluded for typing reason; handling of types and backtracking is still to be done) *) Section S. Variables A B : nat -> Prop. Goal forall x : nat, A x -> B x. refine (fun x H => proj2 (_ x H) _). Abort. End S. (* Check that constraints are taken into account by tactics that instantiate *) Lemma inj : forall n m, S n = S m -> n = m. intros n m H. eapply f_equal with (* should fail because ill-typed *) (f := fun n => match n return match n with S _ => nat | _ => unit end with | S n => n | _ => tt end) in H || injection H. Abort. (* A legitimate simple eapply that was failing in coq <= 8.3. Cf. in Unification.w_merge the addition of an extra pose_all_metas_as_evars on 30/9/2010 *) Lemma simple_eapply_was_failing : (forall f:nat->nat, exists g, f = g) -> True. Proof. assert (modusponens : forall P Q, P -> (P->Q) -> Q) by auto. intros. eapply modusponens. simple eapply H. (* error message with V8.3 : Impossible to unify "?18" with "fun g : nat -> nat => ?6 = g". *) Abort. (* Regression test *) Definition fo : option nat -> nat := option_rec _ (fun a => 0) 0. (* This example revealed an incorrect evar restriction at some time around October 2011 *) Goal forall (A:Type) (a:A) (P:forall A, A -> Prop), (P A a) /\ (P A a). intros. refine ((fun H => conj (proj1 H) (proj2 H)) _). Abort. (* The argument of e below failed to be inferred from r14219 (Oct 2011) to *) (* r14753 after the restrictions made on detecting Miller's pattern in the *) (* presence of alias, only the second-order unification procedure was *) (* able to solve this problem but it was deactivated for 8.4 in r14219 *) Definition k0 (e:forall P : nat -> Prop, (exists n : nat, P n) -> nat) (j : forall a, exists n : nat, n = a) o := match o with (* note: match introduces an alias! *) | Some a => e _ (j a) | None => O end. Definition k1 (e:forall P : nat -> Prop, (exists n : nat, P n) -> nat) (j : forall a, exists n : nat, n = a) a (b:=a) := e _ (j a). Definition k2 (e:forall P : nat -> Prop, (exists n : nat, P n) -> nat) (j : forall a, exists n : nat, n = a) a (b:=a) := e _ (j b). (* Other examples about aliases involved in pattern unification *) Definition k3 (e:forall P : nat -> Prop, (exists n : nat, P n) -> nat) (j : forall a, exists n : nat, let a' := a in n = a') a (b:=a) := e _ (j b). Definition k4 (e:forall P : nat -> Prop, (exists n : nat, P n) -> nat) (j : forall a, exists n : nat, let a' := S a in n = a') a (b:=a) := e _ (j b). Definition k5 (e:forall P : nat -> Prop, (exists n : nat, P n) -> nat) (j : forall a, let a' := S a in exists n : nat, n = a') a (b:=a) := e _ (j b). Definition k6 (e:forall P : nat -> Prop, (exists n : nat, P n) -> nat) (j : forall a, exists n : nat, let n' := S n in n' = a) a (b:=a) := e _ (j b). Definition k7 (e:forall P : nat -> Prop, (exists n : nat, let n' := n in P n') -> nat) (j : forall a, exists n : nat, n = a) a (b:=a) := e _ (j b). (* An example that uses materialize_evar under binders *) (* Extracted from bigop.v in the mathematical components library *) Section Bigop. Variable bigop : forall R I: Type, R -> (R -> R -> R) -> list I -> (I->Prop) -> (I -> R) -> R. Hypothesis eq_bigr : forall (R : Type) (idx : R) (op : R -> R -> R) (I : Type) (r : list I) (P : I -> Prop) (F1 F2 : I -> R), (forall i : I, P i -> F1 i = F2 i) -> bigop R I idx op r (fun i : I => P i) (fun i : I => F1 i) = idx. Hypothesis big_tnth : forall (R : Type) (idx : R) (op : R -> R -> R) (I : Type) (r : list I) (P : I -> Prop) (F : I -> R), bigop R I idx op r (fun i : I => P i) (fun i : I => F i) = idx. Hypothesis big_tnth_with_letin : forall (R : Type) (idx : R) (op : R -> R -> R) (I : Type) (r : list I) (P : I -> Prop) (F : I -> R), bigop R I idx op r (fun i : I => let i:=i in P i) (fun i : I => F i) = idx. Variable R : Type. Variable idx : R. Variable op : R -> R -> R. Variable I : Type. Variable J : Type. Variable rI : list I. Variable rJ : list J. Variable xQ : J -> Prop. Variable P : I -> Prop. Variable Q : I -> J -> Prop. Variable F : I -> J -> R. (* Check unification under binders *) Check (eq_bigr _ _ _ _ _ _ _ _ (fun _ _ => big_tnth _ _ _ _ rI _ _)) : (bigop R J idx op rJ (fun j : J => let k:=j in xQ k) (fun j : J => let k:=j in bigop R I idx op rI (fun i : I => P i /\ Q i k) (fun i : I => let k:=j in F i k))) = idx. (* Check also with let-in *) Check (eq_bigr _ _ _ _ _ _ _ _ (fun _ _ => big_tnth_with_letin _ _ _ _ rI _ _)) : (bigop R J idx op rJ (fun j : J => let k:=j in xQ k) (fun j : J => let k:=j in bigop R I idx op rI (fun i : I => P i /\ Q i k) (fun i : I => let k:=j in F i k))) = idx. End Bigop. (* Check the use of (at least) an heuristic to solve problems of the form "?x[t] = ?y" where ?y occurs in t without easily knowing if ?y can eventually be erased in t *) Section evar_evar_occur. Variable id : nat -> nat. Variable f : forall x, id x = 0 -> id x = 0 -> x = 1 /\ x = 2. Variable g : forall y, id y = 0 /\ id y = 0. (* Still evars in the resulting type, but constraints should be solved *) Check match g _ with conj a b => f _ a b end. End evar_evar_occur. (* Eta expansion (BZ#2936) *) Record iffT (X Y:Type) : Type := mkIff { iffLR : X->Y; iffRL : Y->X }. Record tri (R:Type->Type->Type) (S:Type->Type->Type) (T:Type->Type->Type) := mkTri { tri0 : forall a b c, R a b -> S a c -> T b c }. Arguments mkTri [R S T]. Definition tri_iffT : tri iffT iffT iffT := (mkTri (fun X0 X1 X2 E01 E02 => (mkIff _ _ (fun x1 => iffLR _ _ E02 (iffRL _ _ E01 x1)) (fun x2 => iffLR _ _ E01 (iffRL _ _ E02 x2))))). (* Check that local defs names are preserved if possible during unification *) Goal forall x (x':=x) (f:forall y, y=y:>nat -> Prop), f _ (eq_refl x'). intros. unfold x' at 2. (* A way to check that there are indeed 2 occurrences of x' *) Abort. (* A simple example we would like not to fail (it used to fail because of not strict enough evar restriction) *) Check match Some _ with None => _ | _ => _ end. (* Used to fail for a couple of days in Nov 2014 *) Axiom test : forall P1 P2, P1 = P2 -> P1 -> P2. (* Check use of candidates *) Import EqNotations. Definition test2 {A B:Type} {H:A=B} (a:A) : B := rew H in a. (* Check that pre-existing evars are not counted as newly undefined in "set" *) (* Reported by Théo *) Goal exists n : nat, n = n -> True. eexists. set (H := _ = _). Abort. (* Check interpretation of default evar instance in pretyping *) (* (reported as bug #7356) *) Check fun (P : nat -> Prop) (x:nat) (h:P x) => exist _ ?[z] (h : P ?z). (* A printing check in passing *) Axiom abs : forall T, T. Fail Type let x := _ in ltac:( let t := type of x in unify x (abs t); exact 0). coq-8.20.0/test-suite/success/export_hint.v000066400000000000000000000003131466560755400207120ustar00rootroot00000000000000Create HintDb foo. Module Foo. Axiom F : False. #[export] Hint Immediate F : foo. End Foo. Goal False. Proof. Fail solve [auto with foo]. Abort. Import Foo. Goal False. Proof. auto with foo. Qed. coq-8.20.0/test-suite/success/export_inst.v000066400000000000000000000010421466560755400207250ustar00rootroot00000000000000Class Foo. Module Foo. #[export] Instance F : Foo := {}. End Foo. Fail Definition foo_test := let _ : Foo := _ in tt. Import Foo. Definition foo_test := let _ : Foo := _ in tt. Class Bar. Module Bar. Section Bar. Variable b : Bar. #[export] Instance B : Bar := {}. (* Cannot declare variables as export instances *) Fail #[export] Existing Instance b. End Bar. Definition bar_test := let _ : Bar := _ in tt. End Bar. Fail Definition bar_test := let _ : Bar := _ in tt. Import Bar. Definition bar_test := let _ : Bar := _ in tt. coq-8.20.0/test-suite/success/extra_dep.v000066400000000000000000000003361466560755400203270ustar00rootroot00000000000000From TestSuite Extra Dependency "extra_dep.txt". From TestSuite Extra Dependency "extra_dep.txt" as d1. Fail From TestSuite Extra Dependency "extra_dep.txt" as d1. From TestSuite Extra Dependency "extra_dep.txt" as d2. coq-8.20.0/test-suite/success/extra_dep2.v000066400000000000000000000002321466560755400204040ustar00rootroot00000000000000(* coq-prog-args: ("-Q" "prerequisite/subdir" "TestSuite") *) Set Warnings "+ambiguous-extra-dep". Fail From TestSuite Extra Dependency "extra_dep.txt". coq-8.20.0/test-suite/success/extraction.v000066400000000000000000000403161466560755400205360ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* nat) (x:nat) := f x. Extraction test2. (* let test2 f x = f x *) Definition test3 (f:nat -> Set -> nat) (x:nat) := f x nat. Extraction test3. (* let test3 f x = f x __ *) Definition test4 (f:(nat -> nat) -> nat) (x:nat) (g:nat -> nat) := f g. Extraction test4. (* let test4 f x g = f g *) Definition test5 := (1, 0). Extraction test5. (* let test5 = Pair ((S O), O) *) Definition cf (x:nat) (_:x <= 0) := S x. Extraction NoInline cf. Definition test6 := cf 0 (le_n 0). Extraction test6. (* let test6 = cf O *) Definition test7 := (fun (X:Set) (x:X) => x) nat. Extraction test7. (* let test7 x = x *) Definition d (X:Type) := X. Extraction d. (* type 'x d = 'x *) Definition d2 := d Set. Extraction d2. (* type d2 = __ d *) Definition d3 (x:d Set) := 0. Extraction d3. (* let d3 _ = O *) Definition d4 := d nat. Extraction d4. (* type d4 = nat d *) Definition d5 := (fun x:d Type => 0) Type. Extraction d5. (* let d5 = O *) Definition d6 (x:d Type) := x. Extraction d6. (* type 'x d6 = 'x *) Definition test8 := (fun (X:Type) (x:X) => x) Set nat. Extraction test8. (* type test8 = nat *) Definition test9 := let t := nat in id Set t. Extraction test9. (* type test9 = nat *) Definition test10 := (fun (X:Type) (x:X) => 0) Type Type. Extraction test10. (* let test10 = O *) Definition test11 := let n := 0 in let p := S n in S p. Extraction test11. (* let test11 = S (S O) *) Definition test12 := forall x:forall X:Type, X -> X, x Type Type. Extraction test12. (* type test12 = (__ -> __ -> __) -> __ *) Definition test13 := match @left True True I with | left x => 1 | right x => 0 end. Extraction test13. (* let test13 = S O *) (** example with more arguments that given by the type *) Definition test19 := nat_rec (fun n:nat => nat -> nat) (fun n:nat => 0) (fun (n:nat) (f:nat -> nat) => f) 0 0. Extraction test19. (* let test19 = let rec f = function | O -> (fun n0 -> O) | S n0 -> f n0 in f O O *) (** casts *) Definition test20 := True:Type. Extraction test20. (* type test20 = __ *) (** Simple inductive type and recursor. *) Extraction nat. (* type nat = | O | S of nat *) Extraction sumbool_rect. (* let sumbool_rect f f0 = function | Left -> f __ | Right -> f0 __ *) (** Less simple inductive type. *) Inductive c (x:nat) : nat -> Set := | refl : c x x | trans : forall y z:nat, c x y -> y <= z -> c x z. Extraction c. (* type c = | Refl | Trans of nat * nat * c *) Definition Ensemble (U:Type) := U -> Prop. Definition Empty_set (U:Type) (x:U) := False. Definition Add (U:Type) (A:Ensemble U) (x y:U) := A y \/ x = y. Inductive Finite (U:Type) : Ensemble U -> Type := | Empty_is_finite : Finite U (Empty_set U) | Union_is_finite : forall A:Ensemble U, Finite U A -> forall x:U, ~ A x -> Finite U (Add U A x). Extraction Finite. (* type 'u finite = | Empty_is_finite | Union_is_finite of 'u finite * 'u *) (** Mutual Inductive *) Inductive tree : Set := Node : nat -> forest -> tree with forest : Set := | Leaf : nat -> forest | Cons : tree -> forest -> forest. Extraction tree. (* type tree = | Node of nat * forest and forest = | Leaf of nat | Cons of tree * forest *) Fixpoint tree_size (t:tree) : nat := match t with | Node a f => S (forest_size f) end with forest_size (f:forest) : nat := match f with | Leaf b => 1 | Cons t f' => tree_size t + forest_size f' end. Extraction tree_size. (* let rec tree_size = function | Node (a, f) -> S (forest_size f) and forest_size = function | Leaf b -> S O | Cons (t, f') -> plus (tree_size t) (forest_size f') *) (** Eta-expansions of inductive constructor *) Inductive titi : Set := tata : nat -> nat -> nat -> nat -> titi. Definition test14 := tata 0. Extraction test14. (* let test14 x x0 x1 = Tata (O, x, x0, x1) *) Definition test15 := tata 0 1. Extraction test15. (* let test15 x x0 = Tata (O, (S O), x, x0) *) Inductive eta : Type := eta_c : nat -> Prop -> nat -> Prop -> eta. Extraction eta_c. (* type eta = | Eta_c of nat * nat *) Definition test16 := eta_c 0. Extraction test16. (* let test16 x = Eta_c (O, x) *) Definition test17 := eta_c 0 True. Extraction test17. (* let test17 x = Eta_c (O, x) *) Definition test18 := eta_c 0 True 0. Extraction test18. (* let test18 _ = Eta_c (O, O) *) (** Example of singleton inductive type *) Inductive bidon (A:Prop) (B:Type) : Type := tb : forall (x:A) (y:B), bidon A B. Definition fbidon (A B:Type) (f:A -> B -> bidon True nat) (x:A) (y:B) := f x y. Extraction bidon. (* type 'b bidon = 'b *) Extraction tb. (* tb : singleton inductive constructor *) Extraction fbidon. (* let fbidon f x y = f x y *) Definition fbidon2 := fbidon True nat (tb True nat). Extraction fbidon2. (* let fbidon2 y = y *) Extraction NoInline fbidon. Extraction fbidon2. (* let fbidon2 y = fbidon (fun _ x -> x) __ y *) (* NB: first argument of fbidon2 has type [True], so it disappears. *) (** mutual inductive on many sorts *) Inductive test_0 : Prop := ctest0 : test_0 with test_1 : Set := ctest1 : test_0 -> test_1. Extraction test_0. (* test0 : logical inductive *) Extraction test_1. (* type test1 = | Ctest1 *) (** logical singleton *) Extraction eq. (* eq : logical inductive *) Extraction eq_rect. (* let eq_rect x f y = f *) (** No more propagation of type parameters. Obj.t instead. *) Inductive tp1 : Type := T : forall (C:Set) (c:C), tp2 -> tp1 with tp2 : Type := T' : tp1 -> tp2. Extraction tp1. (* type tp1 = | T of __ * tp2 and tp2 = | T' of tp1 *) Inductive tp1bis : Type := Tbis : tp2bis -> tp1bis with tp2bis : Type := T'bis : forall (C:Set) (c:C), tp1bis -> tp2bis. Extraction tp1bis. (* type tp1bis = | Tbis of tp2bis and tp2bis = | T'bis of __ * tp1bis *) (** Strange inductive type. *) Inductive Truc : Set -> Type := | chose : forall A:Set, Truc A | machin : forall A:Set, A -> Truc bool -> Truc A. Extraction Truc. (* type 'x truc = | Chose | Machin of 'x * bool truc *) (** Dependant type over Type *) Definition test24 := sigT (fun a:Set => option a). Extraction test24. (* type test24 = (__, __ option) sigT *) (** Coq term non strongly-normalizable after extraction *) Definition loop (Ax:Acc gt 0) := (fix F (a:nat) (b:Acc gt a) {struct b} : nat := F (S a) (Acc_inv b (S a) (Nat.lt_succ_diag_r a))) 0 Ax. Extraction loop. (* let loop _ = let rec f a = f (S a) in f O *) (*** EXAMPLES NEEDING OBJ.MAGIC *) (** False conversion of type: *) Lemma oups : forall H:nat = list nat, nat -> nat. intros. generalize H0; intros. rewrite H in H1. case H1. exact H0. intros. exact n. Defined. Extraction oups. (* let oups h0 = match Obj.magic h0 with | Nil -> h0 | Cons0 (n, l) -> n *) (** hybrids *) Definition horibilis (b:bool) := if b as b return (if b then Type else nat) then Set else 0. Extraction horibilis. (* let horibilis = function | True -> Obj.magic __ | False -> Obj.magic O *) Definition PropSet (b:bool) := if b then Prop else Set. Extraction PropSet. (* type propSet = __ *) Definition natbool (b:bool) := if b then nat else bool. Extraction natbool. (* type natbool = __ *) Definition zerotrue (b:bool) := if b as x return natbool x then 0 else true. Extraction zerotrue. (* let zerotrue = function | True -> Obj.magic O | False -> Obj.magic True *) Definition natProp (b:bool) := if b return Type then nat else Prop. Definition natTrue (b:bool) := if b return Type then nat else True. Definition zeroTrue (b:bool) := if b as x return natProp x then 0 else True. Extraction zeroTrue. (* let zeroTrue = function | True -> Obj.magic O | False -> Obj.magic __ *) Definition natTrue2 (b:bool) := if b return Type then nat else True. Definition zeroprop (b:bool) := if b as x return natTrue x then 0 else I. Extraction zeroprop. (* let zeroprop = function | True -> Obj.magic O | False -> Obj.magic __ *) (** polymorphic f applied several times *) Definition test21 := (id nat 0, id bool true). Extraction test21. (* let test21 = Pair ((id O), (id True)) *) (** ok *) Definition test22 := (fun f:forall X:Type, X -> X => (f nat 0, f bool true)) (fun (X:Type) (x:X) => x). Extraction test22. (* let test22 = let f = fun x -> x in Pair ((f O), (f True)) *) (* still ok via optim beta -> let *) Definition test23 (f:forall X:Type, X -> X) := (f nat 0, f bool true). Extraction test23. (* let test23 f = Pair ((Obj.magic f __ O), (Obj.magic f __ True)) *) (* problem: fun f -> (f 0, f true) not legal in ocaml *) (* solution: magic ... *) (** Dummy constant __ can be applied.... *) Definition f (X:Type) (x:nat -> X) (y:X -> bool) : bool := y (x 0). Extraction f. (* let f x y = y (x O) *) Definition f_prop := f (0 = 0) (fun _ => refl_equal 0) (fun _ => true). Extraction NoInline f. Extraction f_prop. (* let f_prop = f (Obj.magic __) (fun _ -> True) *) Definition f_arity := f Set (fun _:nat => nat) (fun _:Set => true). Extraction f_arity. (* let f_arity = f (Obj.magic __) (fun _ -> True) *) Definition f_normal := f nat (fun x => x) (fun x => match x with | O => true | _ => false end). Extraction f_normal. (* let f_normal = f (fun x -> x) (fun x -> match x with | O -> True | S n -> False) *) (* inductive with magic needed *) Inductive Boite : Set := boite : forall b:bool, (if b then nat else (nat * nat)%type) -> Boite. Extraction Boite. (* type boite = | Boite of bool * __ *) Definition boite1 := boite true 0. Extraction boite1. (* let boite1 = Boite (True, (Obj.magic O)) *) Definition boite2 := boite false (0, 0). Extraction boite2. (* let boite2 = Boite (False, (Obj.magic (Pair (O, O)))) *) Definition test_boite (B:Boite) := match B return nat with | boite true n => n | boite false n => fst n + snd n end. Extraction test_boite. (* let test_boite = function | Boite (b0, n) -> (match b0 with | True -> Obj.magic n | False -> plus (fst (Obj.magic n)) (snd (Obj.magic n))) *) (* singleton inductive with magic needed *) Inductive Box : Type := box : forall A:Set, A -> Box. Extraction Box. (* type box = __ *) Definition box1 := box nat 0. Extraction box1. (* let box1 = Obj.magic O *) (* applied constant, magic needed *) Definition idzarb (b:bool) (x:if b then nat else bool) := x. Definition zarb := idzarb true 0. Extraction NoInline idzarb. Extraction zarb. (* let zarb = Obj.magic idzarb True (Obj.magic O) *) (** function of variable arity. *) (** Fun n = nat -> nat -> ... -> nat *) Fixpoint Fun (n:nat) : Set := match n with | O => nat | S n => nat -> Fun n end. Fixpoint Const (k n:nat) {struct n} : Fun n := match n as x return Fun x with | O => k | S n => fun p:nat => Const k n end. Fixpoint proj (k n:nat) {struct n} : Fun n := match n as x return Fun x with | O => 0 (* ou assert false ....*) | S n => match k with | O => fun x => Const x n | S k => fun x => proj k n end end. Definition test_proj := proj 2 4 0 1 2 3. Eval compute in test_proj. Recursive Extraction test_proj. (*** TO SUM UP: ***) Module Everything. Definition idnat := idnat. Definition id := id. Definition id' := id'. Definition test2 := test2. Definition test3 := test3. Definition test4 := test4. Definition test5 := test5. Definition test6 := test6. Definition test7 := test7. Definition d := d. Definition d2 := d2. Definition d3 := d3. Definition d4 := d4. Definition d5 := d5. Definition d6 := d6. Definition test8 := test8. Definition test9 := test9. Definition test10 := test10. Definition test11 := test11. Definition test12 := test12. Definition test13 := test13. Definition test19 := test19. Definition test20 := test20. Definition nat := nat. Definition sumbool_rect := sumbool_rect. Definition c := c. Definition Finite := Finite. Definition tree := tree. Definition tree_size := tree_size. Definition test14 := test14. Definition test15 := test15. Definition eta_c := eta_c. Definition test16 := test16. Definition test17 := test17. Definition test18 := test18. Definition bidon := bidon. Definition tb := tb. Definition fbidon := fbidon. Definition fbidon2 := fbidon2. Definition test_0 := test_0. Definition test_1 := test_1. Definition eq_rect := eq_rect. Definition tp1 := tp1. Definition tp1bis := tp1bis. Definition Truc := Truc. Definition oups := oups. Definition test24 := test24. Definition loop := loop. Definition horibilis := horibilis. Definition PropSet := PropSet. Definition natbool := natbool. Definition zerotrue := zerotrue. Definition zeroTrue := zeroTrue. Definition zeroprop := zeroprop. Definition test21 := test21. Definition test22 := test22. Definition test23 := test23. Definition f := f. Definition f_prop := f_prop. Definition f_arity := f_arity. Definition f_normal := f_normal. Definition Boite := Boite. Definition boite1 := boite1. Definition boite2 := boite2. Definition test_boite := test_boite. Definition Box := Box. Definition box1 := box1. Definition zarb := zarb. Definition test_proj := test_proj. End Everything. (* Extraction "test_extraction.ml" Everything. *) Recursive Extraction Everything. (* Check that the previous OCaml code is compilable *) Extraction TestCompile Everything. Extraction Language Haskell. (* Extraction "Test_extraction.hs" Everything. *) Recursive Extraction Everything. Extraction Language Scheme. (* Extraction "test_extraction.scm" Everything. *) Recursive Extraction Everything. (*** Finally, a test more focused on everyday's life situations ***) Require Import ZArith. Extraction Language OCaml. Require Import String. Definition string_test1 := string_dec "foo" "bar". Definition string_test2 (x: string) : unit := match x with | EmptyString => tt | _ => tt end. Definition string_test3 (x : string) : string := String.string_of_list_ascii (String.list_ascii_of_string x). Definition string_test4 (x : string) : string := String.string_of_list_byte (String.list_byte_of_string x). Definition string_test := (string_test1, string_test2, string_test3, string_test4). (* Raw extraction of strings *) Extraction TestCompile string_test. (* Extraction to char list *) Require Import ExtrOcamlString. Extraction TestCompile string_test. (* Extraction to native strings *) Require Import ExtrOcamlNativeString. Extraction TestCompile string_test compare. Recursive Extraction Z_modulo_2 Zdiv_eucl_exist. Extraction TestCompile Z_modulo_2 Zdiv_eucl_exist. Require Import ExtrOcamlZBigInt. Recursive Extraction N.pred N.sub N.div N.modulo N.compare Z.add Z.mul Z.compare Z.of_N Z.abs_N Z.div Z.modulo Pos.add Pos.pred Pos.sub Pos.mul Pos.compare. Extraction TestCompile N.pred N.sub N.div N.modulo N.compare Z.add Z.mul Z.compare Z.of_N Z.abs_N Z.div Z.modulo Pos.add Pos.pred Pos.sub Pos.mul Pos.compare. Require Import Euclid ExtrOcamlNatBigInt. Definition test n m (H:m>0) := let (q,r,_,_) := eucl_dev m H n in Nat.compare n (q*m+r). Recursive Extraction test fact pred minus max min Nat.div2. Extraction TestCompile test fact pred minus max min Nat.div2. coq-8.20.0/test-suite/success/extraction_bigint.v000066400000000000000000000047551466560755400221010ustar00rootroot00000000000000(** Test extraction of big integers using zarith *) From Coq Require Extraction ExtrOcamlZBigInt. From Coq Require Import Bool Arith ZArith List. Import ListNotations. Definition from_sumbool {P Q} (p : {P} + {Q}) : bool := match p with | left _ => true | right _ => false end. Definition tests_Pos : list bool := [ 1 =? 1 ; Pos.succ 3 =? 4 ; Pos.pred 3 =? 2 ; 1 + 2 =? 3 ; 6 - 2 =? 4 ; 3 - 3 =? 1 ; 3 - 6 =? 1 ; 3 * 4 =? 12 ; Pos.min 2 3 =? 2 ; Pos.max 2 3 =? 3 ; Pos.eqb 1 1 ; Pos.shiftl 2 3 =? 16 ; Pos.shiftr 4 2 =? 1 ; from_sumbool (Pos.eq_dec 1 1) ; negb (from_sumbool (Pos.eq_dec 1 2)) ]%positive. Definition test_positive : { b | b = true } := exist _ (forallb (fun x => x) tests_Pos) eq_refl. Definition eq_N2 (x y : N * N) : bool := ((fst x =? fst y) && (snd x =? snd y))%N. Definition tests_N : list bool := [ 0 =? 0 ; N.succ 3 =? 4 ; N.pred 3 =? 2 ; 1 + 2 =? 3 ; 6 - 2 =? 4 ; 3 - 4 =? 0 ; 3 * 4 =? 12 ; N.min 2 3 =? 2 ; N.max 2 3 =? 3 ; N.eqb 1 1 ; 11 / 2 =? 5 ; 11 mod 3 =? 2 ; N.shiftl 2 3 =? 16 ; N.shiftr 4 2 =? 1 ; negb (N.eqb 0 1) ; from_sumbool (N.eq_dec 0 0) ; negb (from_sumbool (N.eq_dec 0 1)) ; Z.to_N 3 =? 3 ; eq_N2 (N.div_eucl 11 0) (0, 11) ; eq_N2 (N.div_eucl 11 3) (3, 2) ]%N. Definition test_N : { b | b = true } := exist _ (forallb (fun x => x) tests_N) eq_refl. Definition eq_Z2 (x y : Z * Z) : bool := ((fst x =? fst y) && (snd x =? snd y))%Z. Definition tests_Z : list bool := [ 0 =? 0 ; Z.succ 3 =? 4 ; Z.pred 3 =? 2 ; 1 + 2 =? 3 ; 1 + (-4) =? -3 ; 3 - 4 =? -1 ; 3 - (-4) =? 7 ; (-3) * (-4) =? 12 ; (-3) * 4 =? -12 ; Z.opp 3 =? -3 ; Z.opp (-3) =? 3 ; Z.abs 3 =? 3 ; Z.abs (-3) =? 3 ; Z.min (-3) 3 =? -3 ; Z.max (-3) 3 =? 3 ; Z.eqb 1 1 ; 11 / 0 =? 0 ; 11 / 2 =? 5 ; (-11) / 2 =? -6 ; 11 / (-2) =? -6 ; (-11) / (-2) =? 5 ; 11 mod 0 =? 11 ; 11 mod 3 =? 2 ; (-11) mod 3 =? 1 ; 11 mod (-3) =? -1 ; (-11) mod (-3) =? -2 ; Z.shiftl 2 3 =? 16 ; Z.shiftl 2 (-1) =? 1 ; Z.shiftr 4 2 =? 1 ; Z.shiftr 4 (-3) =? 32 ; negb (Z.eqb 0 1) ; from_sumbool (Z.eq_dec 0 0) ; negb (from_sumbool (Z.eq_dec 0 1)) ; Z.of_N 3 =? 3 ; eq_Z2 (Z.div_eucl 11 0) (0, 11) ; eq_Z2 (Z.div_eucl 11 3) (3, 2) ; eq_Z2 (Z.div_eucl (-11) 3) (-4, 1) ; eq_Z2 (Z.div_eucl 11 (-3)) (-4, -1) ; eq_Z2 (Z.div_eucl (-11) (-3)) (3, -2) ]%Z. Definition test_Z : { b | b = true } := exist _ (forallb (fun x => x) tests_Z) eq_refl. Extraction TestCompile test_positive test_Z test_N. coq-8.20.0/test-suite/success/extraction_dep.v000066400000000000000000000017361466560755400213710ustar00rootroot00000000000000 (** Examples of code elimination inside modules during extraction *) Require Coq.extraction.Extraction. (** NB: we should someday check the produced code instead of extracting and just compiling. *) (** 1) Without signature ... *) Module A. Definition u := 0. Definition v := 1. Module B. Definition w := 2. Definition x := 3. End B. End A. Definition testA := A.u + A.B.x. Recursive Extraction testA. (* without: v w *) Extraction TestCompile testA. (** 1b) Same with an Include *) Module Abis. Include A. Definition y := 4. End Abis. Definition testAbis := Abis.u + Abis.y. Recursive Extraction testAbis. (* without: A B v w x *) Extraction TestCompile testAbis. (** 2) With signature, we only keep elements mentioned in signature. *) Module Type SIG. Parameter u : nat. Parameter v : nat. End SIG. Module Ater : SIG. Include A. End Ater. Definition testAter := Ater.u. Recursive Extraction testAter. (* with only: u v *) Extraction TestCompile testAter. coq-8.20.0/test-suite/success/extraction_impl.v000066400000000000000000000036021466560755400215540ustar00rootroot00000000000000 (** Examples of extraction with manually-declared implicit arguments *) (** NB: we should someday check the produced code instead of extracting and just compiling. *) Require Coq.extraction.Extraction. (** Bug #4243, part 1 *) Inductive dnat : nat -> Type := | d0 : dnat 0 | ds : forall n m, n = m -> dnat n -> dnat (S n). Extraction Implicit ds [m]. Lemma dnat_nat: forall n, dnat n -> nat. Proof. intros n d. induction d as [| n m Heq d IHn]. exact 0. exact (S IHn). Defined. Recursive Extraction dnat_nat. Extraction TestCompile dnat_nat. Extraction Implicit dnat_nat [n]. Recursive Extraction dnat_nat. Extraction TestCompile dnat_nat. (** Same, with a Fixpoint *) Fixpoint dnat_nat' n (d:dnat n) := match d with | d0 => 0 | ds n m _ d => S (dnat_nat' n d) end. Recursive Extraction dnat_nat'. Extraction TestCompile dnat_nat'. Extraction Implicit dnat_nat' [n]. Recursive Extraction dnat_nat'. Extraction TestCompile dnat_nat'. (** Bug #4243, part 2 *) Inductive enat: nat -> Type := e0: enat 0 | es: forall n, enat n -> enat (S n). Lemma enat_nat: forall n, enat n -> nat. Proof. intros n e. induction e as [| n e IHe]. exact (O). exact (S IHe). Defined. Extraction Implicit es [n]. Extraction Implicit enat_nat [n]. Recursive Extraction enat_nat. Extraction TestCompile enat_nat. (** Same, with a Fixpoint *) Fixpoint enat_nat' n (e:enat n) : nat := match e with | e0 => 0 | es n e => S (enat_nat' n e) end. Extraction Implicit enat_nat' [n]. Recursive Extraction enat_nat'. Extraction TestCompile enat_nat'. (** Bug #4228 *) Module Food. Inductive Course := | main: nat -> Course | dessert: nat -> Course. Inductive Meal : Course -> Type := | one_course : forall n:nat, Meal (main n) | two_course : forall n m, Meal (main n) -> Meal (dessert m). Extraction Implicit two_course [n]. End Food. Recursive Extraction Food.Meal. Extraction TestCompile Food.Meal. coq-8.20.0/test-suite/success/extraction_polyprop.v000066400000000000000000000006161466560755400225010ustar00rootroot00000000000000(* The current extraction cannot handle this situation, and shouldn't try, otherwise it might produce some Ocaml code that segfaults. See Table.error_singleton_become_prop or S. Glondu's thesis for more details. *) Require Coq.extraction.Extraction. Definition f {X} (p : (nat -> X) * True) : X * nat := (fst p 0, 0). Definition f_prop := f ((fun _ => I),I). Fail Extraction f_prop. coq-8.20.0/test-suite/success/fix.v000066400000000000000000000053041466560755400171420ustar00rootroot00000000000000(* Ancien bug signale par Laurent Thery sur la condition de garde *) Require Import Bool. Require Import ZArith. Definition rNat := positive. Inductive rBoolOp : Set := | rAnd : rBoolOp | rEq : rBoolOp. Definition rlt (a b : rNat) : Prop := Pos.compare_cont Eq a b = Lt. Definition rltDec : forall m n : rNat, {rlt m n} + {rlt n m \/ m = n}. Proof. intros n m; generalize (nat_of_P_lt_Lt_compare_morphism n m); generalize (nat_of_P_gt_Gt_compare_morphism n m); generalize (Pcompare_Eq_eq n m); case (Pos.compare_cont Eq n m). intros H' H'0 H'1; right; right; auto. intros H' H'0 H'1; left; unfold rlt. apply nat_of_P_lt_Lt_compare_complement_morphism; auto. intros H' H'0 H'1; right; left; unfold rlt. apply nat_of_P_lt_Lt_compare_complement_morphism; auto. apply H'0; auto. Defined. Definition rmax : rNat -> rNat -> rNat. Proof. intros n m; case (rltDec n m); intros Rlt0. exact m. exact n. Defined. Inductive rExpr : Set := | rV : rNat -> rExpr | rN : rExpr -> rExpr | rNode : rBoolOp -> rExpr -> rExpr -> rExpr. Fixpoint maxVar (e : rExpr) : rNat := match e with | rV n => n | rN p => maxVar p | rNode n p q => rmax (maxVar p) (maxVar q) end. (* Check bug #1491 *) Require Import Streams. Definition decomp (s:Stream nat) : Stream nat := match s with Cons _ s => s end. CoFixpoint bx0 : Stream nat := Cons 0 bx1 with bx1 : Stream nat := Cons 1 bx0. Lemma bx0bx : decomp bx0 = bx1. simpl. (* used to return bx0 in V8.1 and before instead of bx1 *) reflexivity. Qed. (* Check mutually inductive statements *) Require Import ZArith_base Lia. Open Scope Z_scope. Inductive even: Z -> Prop := | even_base: even 0 | even_succ: forall n, odd (n - 1) -> even n with odd: Z -> Prop := | odd_succ: forall n, even (n - 1) -> odd n. Lemma even_pos_odd_pos: forall n, even n -> n >= 0 with odd_pos_even_pos : forall n, odd n -> n >= 1. Proof. intros. destruct H. lia. apply odd_pos_even_pos in H. lia. intros. destruct H. apply even_pos_odd_pos in H. lia. Qed. CoInductive a : Prop := acons : b -> a with b : Prop := bcons : a -> b. Lemma a1 : a with b1 : b. Proof. apply acons. assumption. apply bcons. assumption. Qed. Require Import List. (** Extracted from coq_performance_tests *) Module InnerMatch. Fixpoint take_uniform_n' {T} (ls : list T) (len : nat) (n : nat) : list T := match n, ls, List.rev ls with | 0%nat, _, _ => nil | _, nil, _ => nil | _, _, nil => nil | 1%nat, cons x _, _ => cons x nil | 2%nat, cons x nil, _ => cons x nil | 2%nat, cons x _, cons y _ => cons x (cons y nil) | S n', cons x xs, _ => let skip := (Nat.div len n + 1)%nat in cons x (take_uniform_n' (skipn skip xs) (len - 1 - skip) n') end. End InnerMatch. coq-8.20.0/test-suite/success/forward.v000066400000000000000000000013161466560755400200170ustar00rootroot00000000000000(* Testing forward reasoning *) Goal 0=0. Fail assert (_ = _). eassert (_ = _)by reflexivity. eassumption. Qed. Goal 0=0. Fail set (S ?[nl]). eset (S ?[n]). remember (S ?n) as x. instantiate (n:=0). Fail remember (S (S _)). eremember (S (S ?[x])). instantiate (x:=0). reflexivity. Qed. (* Don't know if it is good or not but the compatibility tells that the asserted goal to prove is subject to beta-iota but not the asserted hypothesis *) Goal True. assert ((fun x => x) False). Fail match goal with |- (?f ?a) => idtac end. (* should be beta-iota reduced *) 2:match goal with _: (?f ?a) |- _ => idtac end. (* should not be beta-iota reduced *) Abort. Goal nat. assert nat as J%S by exact 0. exact J. Qed. coq-8.20.0/test-suite/success/freshness.v000066400000000000000000000003131466560755400203470ustar00rootroot00000000000000Definition bar := 0. Section S. Let bar := bar. Definition foo := 0. Let foo := foo. End S. Section S'. Let bar : nat. exact 0. Defined. Definition foo' := 0. Let foo' : nat. exact 0. Defined. End S'. coq-8.20.0/test-suite/success/goal_selector.v000066400000000000000000000027151466560755400212010ustar00rootroot00000000000000Inductive two : bool -> Prop := | Zero : two false | One : two true. Ltac dup := let H := fresh in assert (forall (P : Prop), P -> P -> P) as H by (intros; trivial); apply H; clear H. Lemma transform : two false <-> two true. Proof. split; intros _; constructor. Qed. Goal two false /\ two true /\ two false /\ two true /\ two true /\ two true. Proof. do 2 dup. - repeat split. Fail 7:idtac. Fail 2-1:idtac. 1,2,4-6:idtac. 2-5:exact One. par:exact Zero. - repeat split. 3-6:swap 1 4. 1-5:swap 1 5. 1-4:exact One. all:exact Zero. - repeat split. 1, 3:exact Zero. 1, 2, 3, 4: exact One. - repeat split. all:apply transform. 2, 4, 6:apply transform. all:apply transform. 1-5:apply transform. 1-6:exact One. Qed. Goal True -> True. Proof. intros y. 1-1:match goal with y : _ |- _ => let x := y in idtac x end. Fail 1-1:let x := y in idtac x. 1:let x := y in idtac x. exact I. Qed. Goal True /\ (True /\ True). Proof. dup. - split; only 2: (split; exact I). exact I. - split; only 2: split; exact I. Qed. Goal True -> exists (x : Prop), x. Proof. intro H; eexists ?[x]; only [x]: exact True. 1: assumption. Qed. Goal Prop. refine ?[x]. [x]: refine _. exact True. Qed. (* Strict focusing! *) Set Default Goal Selector "!". Goal True -> True /\ True /\ True. Proof. intro. split;only 2:split. Fail exact I. Fail !:exact I. 1:exact I. - !:exact H. - exact I. Qed. coq-8.20.0/test-suite/success/guard.v000066400000000000000000000014741466560755400174620ustar00rootroot00000000000000(* Specific tests about guard condition *) (* f must unfold to x, not F (de Bruijn mix-up!) *) Check let x (f:nat->nat) k := f k in fun (y z:nat->nat) => let f:=x in (* f := Rel 3 *) fix F (n:nat) : nat := match n with | 0 => 0 | S k => f F k (* here Rel 3 = F ! *) end. (** Commutation of guard condition allows recursive calls on functional arguments, despite rewriting in their domain types. *) Inductive foo : Type -> Type := | End A : foo A | Next A : (A -> foo A) -> foo A. Definition nat : Type := nat. Fixpoint bar (A : Type) (e : nat = A) (f : foo A) {struct f} : nat := match f with | End _ => fun _ => O | Next A g => fun e => match e in (_ = B) return (B -> foo A) -> nat with | eq_refl => fun (g' : nat -> foo A) => bar A e (g' O) end g end e. coq-8.20.0/test-suite/success/hint_discr_unfold.v000066400000000000000000000011741466560755400220520ustar00rootroot00000000000000Create HintDb foo discriminated. Definition myid (A : Prop) := A. Section Test1. #[local] Hint Constructors True : foo. Lemma test1 : myid True. Proof. Fail typeclasses eauto with foo. Abort. End Test1. Section Test2. Definition hide (A : Prop) := A. #[local] Hint Extern 1 => match goal with [ |- hide True ] => constructor end : foo. #[local] Hint Unfold myid : foo. Lemma test2 : hide (myid True). Proof. Fail typeclasses eauto with foo. Abort. End Test2. Section Test3. #[local] Hint Constructors True : foo. #[local] Hint Unfold myid : foo. Lemma test3 : myid True. Proof. typeclasses eauto with foo. Qed. End Test3. coq-8.20.0/test-suite/success/hintdb_in_ltac.v000066400000000000000000000004351466560755400213150ustar00rootroot00000000000000Definition x := 0. #[export] Hint Unfold x : mybase. Ltac autounfoldify base := autounfold with base. Tactic Notation "autounfoldify_bis" ident(base) := autounfold with base. Goal x = 0. progress autounfoldify mybase. Undo. progress autounfoldify_bis mybase. trivial. Qed. coq-8.20.0/test-suite/success/hintdb_in_ltac_bis.v000066400000000000000000000003671466560755400221560ustar00rootroot00000000000000Parameter Foo : Prop. Axiom H : Foo. #[export] Hint Resolve H : mybase. Ltac foo base := eauto with base. Tactic Notation "bar" ident(base) := typeclasses eauto with base. Goal Foo. progress foo mybase. Undo. progress bar mybase. Qed. coq-8.20.0/test-suite/success/hyps_inclusion.v000066400000000000000000000022101466560755400214130ustar00rootroot00000000000000(* Simplified example for bug #1325 *) (* Explanation: the proof engine see section variables as goal variables; especially, it can change their types so that, at type-checking, the section variables are not recognized (Typeops.check_hyps_inclusion raises "types do no match"). It worked before the introduction of polymorphic inductive types because tactics were using Typing.type_of and not Typeops.typing; the former was not checking hyps inclusion so that the discrepancy in the types of section variables seen as goal variables was not a problem (at the end, when the proof is completed, the section variable recovers its original type and all is correct for Typeops) *) Section A. Variable H:not True. Lemma f:nat->nat. destruct H. exact I. Defined. Goal f 0=f 1. red in H. (* next tactic was failing wrt bug #1325 because type-checking the goal detected a syntactically different type for the section variable H *) case 0. Abort. End A. (* Variant with polymorphic inductive types for bug #1325 *) Section B. Variable H:not True. Inductive I (n:nat) : Type := C : H=H -> I n. Goal I 0. red in H. case 0. Abort. End B. coq-8.20.0/test-suite/success/if.v000066400000000000000000000005561466560755400167560ustar00rootroot00000000000000(* The synthesis of the elimination predicate may fail if algebraic *) (* universes are not cautiously treated *) Check (fun b : bool => if b then Type else nat). (* Check correct use of if-then-else predicate annotation (cf BZ#690) *) Check fun b : bool => if b as b0 return (if b0 then b0 = true else b0 = false) then refl_equal true else refl_equal false. coq-8.20.0/test-suite/success/implicit.v000066400000000000000000000112301466560755400201610ustar00rootroot00000000000000(* Testing the behavior of implicit arguments *) (* Implicit on section variables *) Set Implicit Arguments. Unset Strict Implicit. (* Example submitted by David Nowak *) Section Spec. Variable A : Set. Variable op : forall A : Set, A -> A -> Set. Infix "#" := op (at level 70). Check (forall x : A, x # x). (* Example submitted by Christine *) Record stack : Type := {type : Set; elt : type; empty : type -> bool; proof : empty elt = true}. Check (forall (type : Set) (elt : type) (empty : type -> bool), empty elt = true -> stack). (* Nested sections and manual/automatic implicit arguments *) Variable op' : forall A : Set, A -> A -> Set. Variable op'' : forall A : Set, A -> A -> Set. Section B. Definition eq1 := fun (A:Type) (x y:A) => x=y. Definition eq2 := fun (A:Type) (x y:A) => x=y. Definition eq3 := fun (A:Type) (x y:A) => x=y. Arguments op' : clear implicits. Global Arguments op'' : clear implicits. Arguments eq2 : clear implicits. Global Arguments eq3 : clear implicits. Check (op 0 0). Check (op' nat 0 0). Check (op'' nat 0 0). Check (eq1 0 0). Check (eq2 nat 0 0). Check (eq3 nat 0 0). End B. Check (op 0 0). Check (op' 0 0). Check (op'' nat 0 0). Check (eq1 0 0). Check (eq2 0 0). Check (eq3 nat 0 0). End Spec. Check (eq1 0 0). Check (eq2 0 0). Check (eq3 nat 0 0). (* Example submitted by Frédéric (interesting in v8 syntax) *) Parameter f : nat -> nat * nat. Notation lhs := fst. Check (fun x => fst (f x)). Check (fun x => fst (f x)). Notation rhs := snd. Check (fun x => snd (f x)). Check (fun x => @ rhs _ _ (f x)). (* Implicit arguments in fixpoints and inductive declarations *) Fixpoint g n := match n with O => true | S n => g n end. Inductive P n : nat -> Prop := c : P n n. (* Avoid evars in the computation of implicit arguments (cf r9827) *) Require Import List. Fixpoint plus n m {struct n} := match n with | 0 => m | S p => S (plus p m) end. (* Check multiple implicit arguments signatures *) Arguments eq_refl {A x}, {A}. Check eq_refl : 0 = 0. (* Check that notations preserve implicit (since 8.3) *) Parameter p : forall A, A -> forall n, n = 0 -> True. Arguments p [A] _ [n]. Notation Q := (p 0). Check Q eq_refl. (* Check implicits with Context *) Section C. Context {A:Set}. Definition h (a:A) := a. End C. Check h 0. (* Check implicit arguments in arity of inductive types. The three following examples used to fail before r13671 *) Inductive I {A} (a:A) : forall {n:nat}, Prop := | C : I a (n:=0). Inductive I' [A] (a:A) : forall [n:nat], n =0 -> Prop := | C' : I' a eq_refl. Inductive I2 (x:=0) : Prop := | C2 {p:nat} : p = 0 -> I2 | C2' [p:nat] : p = 0 -> I2. Check C2' eq_refl. Inductive I3 {A} (x:=0) (a:A) : forall {n:nat}, Prop := | C3 : I3 a (n:=0). (* Check global implicit declaration over ref not in section *) Section D. Global Arguments eq [A] _ _. End D. (* Check local manual implicit arguments *) (* Gives a warning and make the second x anonymous *) (* Isn't the name "arg_1" a bit fragile though? *) Check fun f : forall {x:nat} {x:bool} (x:unit), unit => f (x:=1) (arg_2:=true) tt. (* Check the existence of a shadowing warning *) Set Warnings "+syntax". Fail Check fun f : forall {x:nat} {x:bool} (x:unit), unit => f (x:=1) (arg_2:=true) tt. Set Warnings "syntax". (* Test failure when implicit arguments are mentioned in subterms which are not types of variables *) Set Warnings "+syntax". Fail Check (id (forall {a}, a)). Set Warnings "syntax". (* Miscellaneous tests *) Check let f := fun {x:nat} y => y=true in f false. Check let f := fun [x:nat] y => y=true in f false. (* Isn't the name "arg_1" a bit fragile, here? *) Check fun f : forall {_:nat}, nat => f (arg_1:=0). (* This test was wrongly warning/failing at some time *) Set Warnings "+syntax". Check id (fun x => let f c {a} (b:a=a) := b in f true (eq_refl 0)). Set Warnings "syntax". Axiom eq0le0 : forall (n : nat) (x : n = 0), n <= 0. Parameter eq0le0' : forall (n : nat) {x : n = 0}, n <= 0. Axiom eq0le0'' : forall (n : nat) {x : n = 0}, n <= 0. Definition eq0le0''' : forall (n : nat) {x : n = 0}, n <= 0. Admitted. Fail Axiom eq0le0'''' : forall [n : nat] {x : n = 0}, n <= 0. Module TestUnnamedImplicit. Axiom foo : forall A, A -> A. Arguments foo {A} {_}. Check foo (arg_2:=true) : bool. Check foo (1:=true) : bool. Check foo : bool. Arguments foo {A} {x}. Check foo (x:=true) : bool. Axiom bar : forall A, A -> nat -> forall B, B -> A * B. Arguments bar {A} {x} _ {B} {y}. Check bar (1:=true) 0 (3:=false). End TestUnnamedImplicit. Module NotationAppliedConstantMultipleImplicit. Axiom f : nat -> nat -> nat -> nat. Arguments f {_} _ _, {_ _} _. Notation "#" := (@f 0). Check # 0 : nat. End NotationAppliedConstantMultipleImplicit. coq-8.20.0/test-suite/success/import_lib.v000066400000000000000000000070421466560755400205150ustar00rootroot00000000000000Definition le_trans := 0. Module Test_Read. Module M. Require PeanoNat. (* Reading without importing *) Check PeanoNat.Nat.le_trans. Lemma th0 : le_trans = 0. reflexivity. Qed. End M. Check PeanoNat.Nat.le_trans. Lemma th0 : le_trans = 0. reflexivity. Qed. Import M. Lemma th1 : le_trans = 0. reflexivity. Qed. End Test_Read. (****************************************************************) (* Arith.Compare containes Require Export Wf_nat. *) Definition le_decide := 1. (* from Arith/Compare *) Definition lt_wf := 0. (* from Arith/Wf_nat *) Module Test_Require. Module M. Require Import Compare. (* Imports Compare_dec as well *) Lemma th1 n : le_decide n = le_decide n. reflexivity. Qed. Lemma th2 n : lt_wf n = lt_wf n. reflexivity. Qed. End M. (* Checks that Compare and Wf_nat are loaded *) Check Compare.le_decide. Check Wf_nat.lt_wf. (* Checks that Compare and Wf_nat are _not_ imported *) Lemma th1 : le_decide = 1. reflexivity. Qed. Lemma th2 : lt_wf = 0. reflexivity. Qed. (* It should still be the case after Import M *) Import M. Lemma th3 : le_decide = 1. reflexivity. Qed. Lemma th4 : lt_wf = 0. reflexivity. Qed. End Test_Require. (****************************************************************) Module Test_Import. Module M. Import Compare. (* Imports Wf_nat as well *) Lemma th1 n : le_decide n = le_decide n. reflexivity. Qed. Lemma th2 n : lt_wf n = lt_wf n. reflexivity. Qed. End M. (* Checks that Compare and Wf_nat are loaded *) Check Compare.le_decide. Check Wf_nat.lt_wf. (* Checks that Compare and Wf_nat are _not_ imported *) Lemma th1 : le_decide = 1. reflexivity. Qed. Lemma th2 : lt_wf = 0. reflexivity. Qed. (* It should still be the case after Import M *) Import M. Lemma th3 : le_decide = 1. reflexivity. Qed. Lemma th4 : lt_wf = 0. reflexivity. Qed. End Test_Import. (************************************************************************) Module Test_Export. Module M. Export Compare. (* Exports Wf_nat as well *) Lemma th1 n : le_decide n = le_decide n. reflexivity. Qed. Lemma th2 n : lt_wf n = lt_wf n. reflexivity. Qed. End M. (* Checks that Compare and Wf_nat are _not_ imported *) Lemma th1 : le_decide = 1. reflexivity. Qed. Lemma th2 : lt_wf = 0. reflexivity. Qed. (* After Import M they should be imported as well *) Import M. Lemma th3 n : le_decide n = le_decide n. reflexivity. Qed. Lemma th4 n : lt_wf n = lt_wf n. reflexivity. Qed. End Test_Export. (************************************************************************) Module Test_Require_Export. Definition le_decide := 1. (* from Arith/Compare *) Definition lt_wf := 0. (* from Arith/Wf_nat *) Module M. Require Export Compare. (* Exports Wf_nat as well *) Lemma th1 n : le_decide n = le_decide n. reflexivity. Qed. Lemma th2 n : lt_wf n = lt_wf n. reflexivity. Qed. End M. (* Checks that Compare and Wf_nat are _not_ imported *) Lemma th1 : le_decide = 1. reflexivity. Qed. Lemma th2 : lt_wf = 0. reflexivity. Qed. (* After Import M they should be imported as well *) Import M. Lemma th3 n : le_decide n = le_decide n. reflexivity. Qed. Lemma th4 n : lt_wf n = lt_wf n. reflexivity. Qed. End Test_Require_Export. coq-8.20.0/test-suite/success/import_mod.v000066400000000000000000000017411466560755400205260ustar00rootroot00000000000000 Definition p := 0. Definition m := 0. Module Test_Import. Module P. Definition p := 1. End P. Module M. Import P. Definition m := p. End M. Module N. Import M. Lemma th0 : p = 0. reflexivity. Qed. End N. (* M and P should be closed *) Lemma th1 : m = 0 /\ p = 0. split; reflexivity. Qed. Import N. (* M and P should still be closed *) Lemma th2 : m = 0 /\ p = 0. split; reflexivity. Qed. End Test_Import. (********************************************************************) Module Test_Export. Module P. Definition p := 1. End P. Module M. Export P. Definition m := p. End M. Module N. Export M. Lemma th0 : p = 1. reflexivity. Qed. End N. (* M and P should be closed *) Lemma th1 : m = 0 /\ p = 0. split; reflexivity. Qed. Import N. (* M and P should now be opened *) Lemma th2 : m = 1 /\ p = 1. split; reflexivity. Qed. End Test_Export. coq-8.20.0/test-suite/success/indelim.v000066400000000000000000000025201466560755400177720ustar00rootroot00000000000000Inductive boolP : Prop := | trueP : boolP | falseP : boolP. Fail Check boolP_rect. Inductive True : Prop := I : True. Inductive False : Prop :=. Inductive Empty_set : Set :=. Fail Inductive Large_set : Set := large_constr : forall A : Set, A -> Large_set. Inductive smallunitProp : Prop := | onlyProps : True -> smallunitProp. Check smallunitProp_rect. Inductive nonsmallunitProp : Prop := | notonlyProps : nat -> nonsmallunitProp. Fail Check nonsmallunitProp_rect. Set Printing Universes. Inductive inferProp := | hasonlyProps : True -> nonsmallunitProp -> inferProp. Check (inferProp : Prop). Inductive inferSet := | hasaset : nat -> True -> nonsmallunitProp -> inferSet. Fail Check (inferSet : Prop). Check (inferSet : Set). Inductive inferLargeSet := | hasalargeset : Set -> True -> nonsmallunitProp -> inferLargeSet. Fail Check (inferLargeSet : Set). Inductive largeProp : Prop := somelargeprop : Set -> largeProp. Inductive comparison : Set := | Eq : comparison | Lt : comparison | Gt : comparison. Inductive CompareSpecT (Peq Plt Pgt : Prop) : comparison -> Type := | CompEqT : Peq -> CompareSpecT Peq Plt Pgt Eq | CompLtT : Plt -> CompareSpecT Peq Plt Pgt Lt | CompGtT : Pgt -> CompareSpecT Peq Plt Pgt Gt. Inductive color := Red | Black. Inductive option (A : Type) : Type := | None : option A | Some : A -> option A. coq-8.20.0/test-suite/success/inds_type_sec.v000066400000000000000000000013501466560755400212010ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* T U. End S. coq-8.20.0/test-suite/success/induct.v000066400000000000000000000103121466560755400176350ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* X. Inductive Y : Set := cons2 : list (Y * Y) -> Y. (* Test inductive types with local definitions *) Inductive eq1 : forall A:Type, let B:=A in A -> Prop := refl1 : eq1 True I. Check fun (P : forall A : Type, let B := A in A -> Type) (f : P True I) (A : Type) => let B := A in fun (a : A) (e : eq1 A a) => match e in (eq1 A0 a0) return (P A0 a0) with | refl1 => f end. Inductive eq2 (A:Type) (a:A) : forall B C:Type, let D:=(A*B*C)%type in D -> Prop := refl2 : eq2 A a unit bool (a,tt,true). (* Check that induction variables are cleared even with in clause *) Lemma foo : forall n m : nat, n + m = n + m. Proof. intros; induction m as [|m] in n |- *. auto. auto. Qed. (* Check selection of occurrences by pattern *) Goal forall x, S x = S (S x). intros. induction (S _) in |- * at -2. now_show (0=1). Undo 2. induction (S _) in |- * at 1 3. now_show (0=1). Undo 2. induction (S _) in |- * at 1. now_show (0=S (S x)). Undo 2. induction (S _) in |- * at 2. now_show (S x=0). Undo 2. induction (S _) in |- * at 3. now_show (S x=1). Undo 2. Fail induction (S _) in |- * at 4. Abort. (* Check use of "as" clause *) Inductive I := C : forall x, x<0 -> I -> I. Goal forall x:I, x=x. intros. induction x as [y * IHx]. change (x = x) in IHx. (* We should have IHx:x=x *) Abort. (* This was not working in 8.4 *) Goal forall h:nat->nat, h 0 = h 1 -> h 1 = h 2 -> h 0 = h 2. intros. induction h. 2:change (n = h 1 -> n = h 2) in IHn. Abort. (* This was not working in 8.4 *) Goal forall h:nat->nat, h 0 = h 1 -> h 1 = h 2 -> h 0 = h 2. intros h H H0. induction h in H |- *. Abort. (* "at" was not granted in 8.4 in the next two examples *) Goal forall h:nat->nat, h 0 = h 1 -> h 1 = h 2 -> h 0 = h 2. intros h H H0. induction h in H at 2, H0 at 1. change (h 0 = 0) in H. Abort. Goal forall h:nat->nat, h 0 = h 1 -> h 1 = h 2 -> h 0 = h 2. intros h H H0. Fail induction h in H at 2 |- *. (* Incompatible occurrences *) Abort. (* Check generalization with dependencies in section variables *) Section S3. Variables x : nat. Definition cond := x = x. Goal cond -> x = 0. intros H. induction x as [|n IHn]. 2:change (n = 0) in IHn. (* We don't want a generalization over cond *) Abort. End S3. (* These examples show somehow arbitrary choices of generalization wrt to indices, when those indices are not linear. We check here 8.4 compatibility: when an index is a subterm of a parameter of the inductive type, it is not generalized. *) Inductive repr (x:nat) : nat -> Prop := reprc z : repr x z -> repr x z. Goal forall x, 0 = x -> repr x x -> True. intros x H1 H. induction H. change True in IHrepr. Abort. Goal forall x, 0 = S x -> repr (S x) (S x) -> True. intros x H1 H. induction H. change True in IHrepr. Abort. Inductive repr' (x:nat) : nat -> Prop := reprc' z : repr' x (S z) -> repr' x z. Goal forall x, 0 = x -> repr' x x -> True. intros x H1 H. induction H. change True in IHrepr'. Abort. (* In this case, generalization was done in 8.4 and we preserve it; this is arbitrary choice *) Inductive repr'' : nat -> nat -> Prop := reprc'' x z : repr'' x z -> repr'' x z. Goal forall x, 0 = x -> repr'' x x -> True. intros x H1 H. induction H. change (0 = z -> True) in IHrepr''. Abort. (* Mentioned as part of bug #12944 *) Inductive test : Set := cons : forall (IHv : nat) (v : test), test. Goal test -> test. induction 1 as [? IHv]. Undo. destruct 1 as [? IHv]. exact IHv. (* Check that the name is granted *) Qed. coq-8.20.0/test-suite/success/instantiate.v000066400000000000000000000002131466560755400206710ustar00rootroot00000000000000Goal True. Proof. refine (let ev := (fun (n : nat) => _) in _). revert ev. instantiate (1 := nat). instantiate (1 := n). constructor. Qed. coq-8.20.0/test-suite/success/intros.v000066400000000000000000000067061466560755400177010ustar00rootroot00000000000000(* Thinning introduction hypothesis must be done after all introductions *) (* Submitted by Guillaume Melquiond (BZ#1000) *) Goal forall A, A -> True. intros _ _. Abort. (* This did not work until March 2013, because of underlying "red" *) Goal (fun x => True -> True) 0. intro H. Abort. (* This should still work, with "intro" calling "hnf" *) Goal (fun f => True -> f 0 = f 0) (fun x => x). intro H. match goal with [ |- 0 = 0 ] => reflexivity end. Abort. (* Somewhat related: This did not work until March 2013 *) Goal (fun f => f 0 = f 0) (fun x => x). hnf. match goal with [ |- 0 = 0 ] => reflexivity end. Abort. (* Fixing behavior of "*" and "**" in branches, so that they do not introduce more than what the branch expects them to introduce at most *) Goal forall n p, n + p = 0. intros [|*]; intro p. Abort. (* Check non-interference of "_" with name generation *) Goal True -> True -> True. intros _ ?. exact H. Qed. (* A short test about introduction pattern pat%c *) Goal (True -> 0=0) -> True /\ False -> 0=0. intros H (H1%H,_). exact H1. Qed. (* A test about bugs in 8.5beta2 *) Goal (True -> 0=0) -> True /\ False -> False -> 0=0. intros H H0 H1. destruct H0 as (a%H,_). (* Check that H0 is removed (was bugged in 8.5beta2) *) Fail clear H0. (* Check position of newly created hypotheses when using pat%c (was left at top in 8.5beta2) *) match goal with H:_ |- _ => clear H end. (* clear H1:False *) match goal with H:_ |- _ => exact H end. (* check that next hyp shows 0=0 *) Qed. Goal (True -> 0=0) -> True -> 0=0. intros H H1%H. exact H1. Qed. Goal forall n, n = S n -> 0=0. intros n H%n_Sn. destruct H. Qed. (* Another check about generated names and cleared hypotheses with pat%c patterns *) Goal (True -> 0=0 /\ 1=1) -> True -> 0=0. intros H (H1,?)%H. change (1=1) in H0. exact H1. Qed. (* Checking iterated pat%c1...%cn introduction patterns and side conditions *) Goal forall A B C D:Prop, (A -> B -> C) -> (C -> D) -> B -> A -> D. intros * H H0 H1. intros H2%H%H0. - exact H2. - exact H1. Qed. (* Bug found by Enrico *) Goal forall x : nat, True. intros y%(fun x => x). Abort. (* Fixing a bug in the order of side conditions of a "->" step *) Goal (True -> 1=0) -> 1=1. intros ->. - reflexivity. - exact I. Qed. Goal forall x, (True -> x=0) -> 0=x. intros x ->. - reflexivity. - exact I. Qed. (* Fixing a bug when destructing a type with let-ins in the constructor *) Inductive I := C : let x:=1 in x=1 -> I. Goal I -> True. intros [x H]. (* Was failing in 8.5 *) Abort. (* Ensuring that the (pat1,...,patn) intropatterns has the expected size, up to skipping let-ins *) Goal I -> 1=1. intros (H). (* This skips x *) exact H. Qed. Goal I -> 1=1. Fail intros (x,H,H'). Fail intros [|]. intros (x,H). exact H. Qed. Goal Acc le 0 -> True. Fail induction 1 as (n,H). (* Induction hypothesis is missing *) induction 1 as (n,H,IH). exact Logic.I. Qed. (* Make "intro"/"intros" progress on existential variables *) Module Evar. Goal exists (A:Prop), A. eexists. unshelve (intro y). - exact nat. - exact (y=y). - auto. Qed. Goal exists (A:Prop), A. eexists. unshelve (intros x). - exact nat. - exact (x=x). - auto. Qed. Definition d := ltac:(let x := fresh in intro x; exact (x*x)). Definition d' : nat -> _ := ltac:(intros;exact 0). End Evar. Module Wildcard. (* We check that the wildcard internal name does not interfere with user fresh names (currently the prefix is "_H") *) Goal nat -> bool -> nat -> bool. intros _ ?_H ?_H. exact _H. Qed. End Wildcard. coq-8.20.0/test-suite/success/keyedrewrite.v000066400000000000000000000025421466560755400210600ustar00rootroot00000000000000Set Keyed Unification. Section foo. Variable f : nat -> nat. Definition g := f. Variable lem : g 0 = 0. Goal f 0 = 0. Proof. Fail rewrite lem. Abort. Declare Equivalent Keys @g @f. (** Now f and g are considered equivalent heads for subterm selection *) Goal f 0 = 0. Proof. rewrite lem. reflexivity. Qed. Print Equivalent Keys. End foo. Require Import Arith List. Definition G {A} (f : A -> A -> A) (x : A) := f x x. Lemma list_foo A (l : list A) : G (@app A) (l ++ nil) = G (@app A) l. Proof. unfold G; rewrite app_nil_r; reflexivity. Qed. (* Bundled version of a magma *) Structure magma := Magma { b_car :> Type; op : b_car -> b_car -> b_car }. Arguments op {_} _ _. (* Instance for lists *) Canonical Structure list_magma A := Magma (list A) (@app A). (* Basically like list_foo, but now uses the op projection instead of app for the argument of G *) Lemma test1 A (l : list A) : G op (l ++ nil) = G op l. (* Ensure that conversion of terms with evars is allowed once a keyed candidate unifier is found *) rewrite -> list_foo. reflexivity. Qed. (* Basically like list_foo, but now uses the op projection for everything *) Lemma test2 A (l : list A) : G op (op l nil) = G op l. Proof. rewrite ->list_foo. reflexivity. Qed. Require Import Bool. Set Keyed Unification. Lemma test b : b && true = b. Fail rewrite andb_true_l. Admitted. coq-8.20.0/test-suite/success/let_pattern_mismatch.v000066400000000000000000000011201466560755400225520ustar00rootroot00000000000000(* Weird corner case accepted by the pattern-matching algorithm. Destructuring let-bindings in patterns can actually be shorter than the case they match. *) Inductive ascii : Set := | Ascii : bool -> bool -> bool -> bool -> bool -> bool -> bool -> bool -> ascii. Definition dummy (a : ascii) : unit := let (a0,a1,a2,a3,a4,a5,a6,a7) := a in tt. Goal forall (a : ascii) (H : tt = dummy a), True. Proof. intros a H. unfold dummy in *. (* Two bound variables in the pattern, eight in the term. *) match goal with | H:context [ let (x, y) := ?X in _ ] |- _ => destruct X eqn:? end. Abort. coq-8.20.0/test-suite/success/let_universes.v000066400000000000000000000001301466560755400212330ustar00rootroot00000000000000Section S. Let bla@{} := Prop. Let bli@{u} := Type@{u}. Fail Let blo@{} := Type. End S. coq-8.20.0/test-suite/success/letproj.v000066400000000000000000000004631466560755400200340ustar00rootroot00000000000000Set Primitive Projections. Set Nonrecursive Elimination Schemes. Record Foo (A : Type) := { bar : A -> A; baz : A }. Definition test (A : Type) (f : Foo A) := let (x, y) := f in x. Scheme foo_case := Case for Foo Sort Type. Definition test' (A : Type) (f : Foo A) := let 'Build_Foo _ x y := f in x. coq-8.20.0/test-suite/success/locality_attributes_modules.v000066400000000000000000000250621466560755400241750ustar00rootroot00000000000000(** This file tests how locality attributes affect usual vernacular commands. PLEASE, when this file fails to compute following a voluntary change in Coq's behaviour, modify accordingly the tables in [sections.rst] and [modules.rst] in [doc/sphinx/language/core]. Also look at the corresponding discussions about locality attributes in the refman (directory doc/sphinx) - For Definition, Lemma, ..., look at language/core/definitions.rst - For Axiom, Conjecture, ..., look at language/core/assumptions.rst - For abbreviations, look at user-extensions/syntax-extensions.rst - For Notations, look at user-extensions/syntax-extensions.rst - For Tactic Notations, look at user-extensions/syntax-extensions.rst - For Ltac, look at proof-engine/ltac.rst - For Canonical Structures, look at language/extensions/canonical.rst - For Hints, look at proofs/automatic-tactics/auto.rst - For Coercions, look at addendum/implicit-coercions.rst - For Ltac2, look at proof-engine/ltac2.rst - For Ltac2 Notations, look at proof-engine/ltac2.rst - For Set, look at language/core/basic.rst *) (** This structure is used to test availability or not of a [Canonical Structure]. *) Structure PointedType : Type := { Carrier :> Set; point : Carrier }. (** This HintDb is used to test availability or not of a [Hint] command. *) Create HintDb plop. (** ** Tests for modules and visibility attributes *) (** *** Without attribute (default) *) Module InModuleDefault. Module Bar. (* A parameter: *) Parameter (secret : nat). (* An axiom: *) Axiom secret_is_42 : secret = 42. (* A custom tactic: *) Ltac find_secret := rewrite secret_is_42. (* An abbreviation: *) Notation add_42 := (Nat.add 42). (* A tactic notation: *) Tactic Notation "rfl" := reflexivity. (* A notation: *) Infix "+p" := Nat.add (only parsing, at level 30, right associativity) : nat_scope. (* A lemma: *) Lemma secret_42 : secret = 42. Proof. find_secret. rfl. Qed. (* A Canonical Structure: *) Canonical natPointed : PointedType := {| Carrier := nat; point := 42 |}. (* A Coercion: *) Coercion to_nat (b : bool) := if b then 1 else 0. (* A Setting: *) Set Universe Polymorphism. (* A Hint: *) Hint Resolve secret_42 : plop. End Bar. (** **** Without importing: *) (* Availability of the parameter *) Check Bar.secret. Fail Check secret. (* Availability of the axiom *) Check Bar.secret_is_42. Fail Check secret_is_42. (* Availability of the tactic *) Fail Print find_secret. Print Bar.find_secret. (* Availability of the abbreviation *) Fail Check add_42. Check Bar.add_42. (* Availability of the tactic notation *) Lemma plop_ni : 2 + 2 = 4. Proof. Fail rfl. Admitted. (* Availability of the notation *) Fail Check (2 +p 3). (* Availability of the canonical structure *) Fail Check (point nat). (* Availability of the coercion *) Fail Check (true + 2). (* Availability of [Set Universe Polymorphism] *) Definition foo_ni@{u} := nat. Fail Check foo_ni@{_}. (* Availability of the [Hint] *) Lemma hop_ni : Bar.secret = 42. Proof. Fail solve [auto with plop]. Admitted. (** **** After importing: *) Import Bar. (* Availability of the parameter *) Check Bar.secret. Check secret. (* Availability of the axiom *) Check Bar.secret_is_42. Check secret_is_42. (* Availability of the tactic *) Print find_secret. Print Bar.find_secret. (* Availability of the abbreviation *) Check add_42. Check Bar.add_42. (* Availability of the tactic notation *) Lemma plop_i : 2 + 2 = 4. Proof. rfl. Qed. (* Availability of the notation *) Check (2 +p 3). (* Availability of the canonical structure *) Check (point nat). (* Availability of the coercion *) Check (true + 2). (* Availability of [Set Universe Polymorphism] *) Definition foo_i@{u} := nat. Fail Check foo_i@{_}. (* Availability of the [Hint] *) Lemma hop_i : Bar.secret = 42. Proof. solve [auto with plop]. Qed. End InModuleDefault. Module InModuleLocal. Module Bar. (* A parameter: *) #[local] Parameter (secret : nat). (* An axiom: *) #[local] Axiom secret_is_42 : secret = 42. (* A custom tactic: *) #[local] Ltac find_secret := rewrite secret_is_42. (* An abbreviation: *) #[local] Notation add_42 := (Nat.add 42). (* A tactic notation: *) #[local] Tactic Notation "rfl" := reflexivity. (* A notation: *) #[local] Infix "+p" := Nat.add (only parsing, at level 30, right associativity) : nat_scope. (* A lemma: *) #[local] Lemma secret_42 : secret = 42. Proof. find_secret. rfl. Qed. (* A Canonical Structure *) #[local] Canonical natPointed : PointedType := {| Carrier := nat; point := 42 |}. (* A Coercion *) #[local] Coercion to_nat (b : bool) := if b then 1 else 0. (* A Setting *) #[local] Set Universe Polymorphism. (* A Hint *) #[local] Hint Resolve secret_42 : plop. End Bar. (** **** Without importing: *) (* Availability of the parameter *) Check Bar.secret. Fail Check secret. (* Availability of the axiom *) Check Bar.secret_is_42. Fail Check secret_is_42. (* Availability of the tactic *) Fail Print find_secret. Fail Print Bar.find_secret. (* Availability of the abbreviation *) Fail Check add_42. Fail Check Bar.add_42. (* Availability of the tactic notation *) Lemma plop_ni : 2 + 2 = 4. Proof. Fail rfl. Admitted. (* Availability of the notation *) Fail Check (2 +p 3). (* Availability of the canonical structure *) Fail Check (point nat). (* Availability of the coercion *) Fail Check (true + 2). (* Availability of [Set Universe Polymorphism] *) Definition foo_ni@{u} := nat. Fail Check foo_ni@{_}. (* Availability of the [Hint] *) Lemma hop_ni : Bar.secret = 42. Proof. Fail solve [auto with plop]. Admitted. (** **** After importing: *) Import Bar. (* Availability of the parameter *) Check Bar.secret. Fail Check secret. (* Availability of the axiom *) Check Bar.secret_is_42. Fail Check secret_is_42. (* Availability of the tactic *) Fail Print find_secret. Fail Print Bar.find_secret. (* Availability of the abbreviation *) Fail Check add_42. Fail Check Bar.add_42. (* Availability of the tactic notation *) Lemma plop_i : 2 + 2 = 4. Proof. Fail rfl. Admitted. (* Availability of the notation *) Fail Check (2 +p 3). (* Availability of the canonical structure *) Check (point nat). (* Availability of the coercion *) Fail Check (true + 2). (* Availability of [Set Universe Polymorphism] *) Definition foo_i@{u} := nat. Fail Check foo_i@{_}. (* Availability of the [Hint] *) Lemma hop_i : Bar.secret = 42. Proof. Fail solve [auto with plop]. Admitted. End InModuleLocal. Module InModuleExport. Module Bar. (* A parameter: *) Fail #[export] Parameter (secret : nat). (* An axiom: *) Fail #[export] Axiom plop : 0 = 0. (* A custom tactic: *) Fail #[export] Ltac find_secret := reflexivity. (* An abbreviation: *) Fail #[export] Notation add_42 := (Nat.add 42). (* A tactic notation: *) Fail #[export] Tactic Notation "rfl" := reflexivity. (* A notation: *) Fail #[export] Infix "+p" := Nat.add (only parsing, at level 30, right associativity) : nat_scope. (* A lemma: *) Fail #[export] Lemma secret_42 : secret = 42. (* A Canonical Structure *) Fail #[export] Canonical natPointed : PointedType := {| Carrier := nat; point := 42 |}. (* A Coercion *) Fail#[export] Coercion to_nat (b : bool) := if b then 1 else 0. (* A Setting *) #[export] Set Universe Polymorphism. (* A Hint *) Parameter (secret : nat). Axiom secret_42 : secret = 42. #[export] Hint Resolve secret_42 : plop. End Bar. (** **** Without importing: *) (* Availability of [Set Universe Polymorphism] *) Definition foo_ni@{u} := nat. Fail Check foo_ni@{_}. (* Availability of the [Hint] *) Lemma hop_ni : Bar.secret = 42. Proof. Fail solve [auto with plop]. Admitted. (** **** After importing: *) Import Bar. (* Availability of [Set Universe Polymorphism] *) Definition foo_i@{u} := nat. Check foo_i@{_}. (* Availability of the [Hint] *) Lemma hop_i : Bar.secret = 42. Proof. solve [auto with plop]. Qed. End InModuleExport. Module InModuleGlobal. Module Bar. (* A parameter: *) #[global] Parameter (secret : nat). (* An axiom: *) #[global] Axiom secret_is_42 : secret = 42. (* A custom tactic: *) #[global] Ltac find_secret := rewrite secret_is_42. (* An abbreviation: *) #[global] Notation add_42 := (Nat.add 42). (* A tactic notation: *) #[global] Tactic Notation "rfl" := reflexivity. (* A notation: *) #[global] Infix "+p" := Nat.add (only parsing, at level 30, right associativity) : nat_scope. (* A lemma: *) #[global] Lemma secret_42 : secret = 42. Proof. find_secret. rfl. Qed. (* A Canonical Structure *) #[global] Canonical natPointed : PointedType := {| Carrier := nat; point := 42 |}. (* A Coercion *) #[global] Coercion to_nat (b : bool) := if b then 1 else 0. (* A Setting *) #[global] Set Universe Polymorphism. (* A Hint *) #[global] Hint Resolve secret_42 : plop. End Bar. (** **** Without importing: *) (* Availability of the parameter *) Check Bar.secret. Fail Check secret. (* Availability of the axiom *) Check Bar.secret_is_42. Fail Check secret_is_42. (* Availability of the tactic *) Fail Print find_secret. Print Bar.find_secret. (* Availability of the abbreviation *) Fail Check add_42. Check Bar.add_42. (* Availability of the tactic notation *) Lemma plop_ni : 2 + 2 = 4. Proof. Fail rfl. Admitted. (* Availability of the notation *) Fail Check (2 +p 3). (* Availability of the canonical structure *) Fail Check (point nat). (* Availability of the coercion *) Fail Check (true + 2). (* Availability of [Set Universe Polymorphism] *) Definition foo_ni@{u} := nat. Check foo_ni@{_}. (* Availability of the [Hint] *) Lemma hop_ni : Bar.secret = 42. Proof. solve [auto with plop]. Admitted. (** **** After importing: *) Import Bar. (* Availability of the parameter *) Check Bar.secret. Check secret. (* Availability of the axiom *) Check Bar.secret_is_42. Check secret_is_42. (* Availability of the tactic *) Print find_secret. Print Bar.find_secret. (* Availability of the abbreviation *) Check add_42. Check Bar.add_42. (* Availability of the tactic notation *) Lemma plop_i : 2 + 2 = 4. Proof. rfl. Qed. (* Availability of the notation *) Check (2 +p 3). (* Availability of the canonical structure *) Check (point nat). (* Availability of the coercion *) Check (true + 2). (* Availability of [Set Universe Polymorphism] *) Definition foo_i@{u} := nat. Check foo_i@{_}. (* Availability of the [Hint] *) Lemma hop_i : Bar.secret = 42. Proof. solve [auto with plop]. Qed. End InModuleGlobal. (** Since I have some global Hints and Settings, the corresponding tests for Sections are in the file locality_attributes_sections.v *) coq-8.20.0/test-suite/success/locality_attributes_modules_ltac2.v000066400000000000000000000066331466560755400252650ustar00rootroot00000000000000(** This file tests how locality attributes affect usual vernacular commands. PLEASE, when this file fails to compute following a voluntary change in Coq's behaviour, modify accordingly the tables in [sections.rst] and [modules.rst] in [doc/sphinx/language/core] Also look at the corresponding discussions about locality attributes in the refman (directory doc/sphinx) - For Definition, Lemma, ..., look at language/core/definitions.rst - For Axiom, Conjecture, ..., look at language/core/assumptions.rst - For abbreviations, look at user-extensions/syntax-extensions.rst - For Notations, look at user-extensions/syntax-extensions.rst - For Tactic Notations, look at user-extensions/syntax-extensions.rst - For Ltac, look at proof-engine/ltac.rst - For Canonical Structures, look at language/extensions/canonical.rst - For Hints, look at proofs/automatic-tactics/auto.rst - For Coercions, look at addendum/implicit-coercions.rst - For Ltac2, look at proof-engine/ltac2.rst - For Ltac2 Notations, look at proof-engine/ltac2.rst - For Set, look at language/core/basic.rst *) From Ltac2 Require Import Ltac2. (** ** Tests for modules and visibility attributes with Ltac2 *) (* A parameter: *) Parameter (secret : nat). (* An axiom: *) Axiom secret_is_42 : secret = 42. (** *** Without attribute (default) *) Module InModuleDefault. Module Bar. (* A custom tactic: *) Ltac2 find_secret () := rewrite secret_is_42. Ltac2 Notation "rfl" := reflexivity. End Bar. (** **** Without importing: *) (* Availability of the tactic *) Fail Print find_secret. Print Bar.find_secret. (* Availability of the tactic notation *) Lemma plop_ni : 2 + 2 = 4. Proof. Fail rfl. Admitted. (** **** After importing: *) Import Bar. (* Availability of the tactic *) Print find_secret. Print Bar.find_secret. (* Availability of the tactic notation *) Lemma plop_i : 2 + 2 = 4. Proof. rfl. Qed. End InModuleDefault. Module InModuleLocal. Module Bar. #[local] Ltac2 find_secret () := rewrite secret_is_42. #[local] Ltac2 Notation "rfl" := reflexivity. End Bar. (** **** Without importing: *) (* Availability of the tactic *) Fail Print find_secret. Fail Print Bar.find_secret. (* Availability of the tactic notation *) Lemma plop_ni : 2 + 2 = 4. Proof. Fail rfl. Admitted. (** **** After importing: *) Import Bar. (* Availability of the tactic *) Fail Print find_secret. Fail Print Bar.find_secret. (* Availability of the tactic notation *) Lemma plop_i : 2 + 2 = 4. Proof. Fail rfl. Admitted. End InModuleLocal. Module InModuleExport. Module Bar. (* A custom tactic: *) Fail #[export] Ltac2 find_secret := reflexivity. (* A tactic notation: *) Fail #[export] Ltac2 Notation "rfl" := reflexivity. End Bar. (** Nothing to check, Ltac2 and Ltac2 Notation do not support the [export] attribute. *) End InModuleExport. Module InModuleGlobal. Module Bar. #[global] Ltac2 find_secret () := rewrite secret_is_42. (* A tactic notation: *) #[global] Ltac2 Notation "rfl" := reflexivity. End Bar. (** **** Without importing: *) (* Availability of the tactic *) Fail Print find_secret. Print Bar.find_secret. (* Availability of the tactic notation *) Lemma plop_ni : 2 + 2 = 4. Proof. Fail rfl. Admitted. (** **** After importing: *) Import Bar. Print find_secret. Print Bar.find_secret. (* Availability of the tactic notation *) Lemma plop_i : 2 + 2 = 4. Proof. rfl. Qed. End InModuleGlobal. coq-8.20.0/test-suite/success/locality_attributes_sections.v000066400000000000000000000156341466560755400243600ustar00rootroot00000000000000(** This file tests how locality attributes affect usual vernacular commands. PLEASE, when this file fails to compute following a voluntary change in Coq's behaviour, modify accordingly the tables in [sections.rst] and [modules.rst] in [doc/sphinx/language/core]. Also look at the corresponding discussions about locality attributes in the refman (directory doc/sphinx) - For Definition, Lemma, ..., look at language/core/definitions.rst - For Axiom, Conjecture, ..., look at language/core/assumptions.rst - For abbreviations, look at user-extensions/syntax-extensions.rst - For Notations, look at user-extensions/syntax-extensions.rst - For Tactic Notations, look at user-extensions/syntax-extensions.rst - For Ltac, look at proof-engine/ltac.rst - For Canonical Structures, look at language/extensions/canonical.rst - For Hints, look at proofs/automatic-tactics/auto.rst - For Coercions, look at addendum/implicit-coercions.rst - For Ltac2, look at proof-engine/ltac2.rst - For Ltac2 Notations, look at proof-engine/ltac2.rst - For Set, look at language/core/basic.rst *) (** This structure is used to test availability or not of a [Canonical Structure]. *) Structure PointedType : Type := { Carrier :> Set; point : Carrier }. (** This HintDb is used to test availability or not of a [Hint] command. *) Create HintDb plop. (** ** Tests for sections and visibility attributes *) (** *** Without attribute (default) *) Module InSectionDefault. Section Bar. (* A parameter: *) Parameter (secret : nat). (* An axiom: *) Axiom secret_is_42 : secret = 42. (* A custom tactic: *) Ltac find_secret := rewrite secret_is_42. (* An abbreviation: *) Notation add_42 := (Nat.add 42). (* A tactic notation: *) Tactic Notation "rfl" := reflexivity. (* A notation: *) Infix "+p" := Nat.add (only parsing, at level 30, right associativity) : nat_scope. (* A lemma: *) Lemma secret_42 : secret = 42. Proof. find_secret. rfl. Qed. (* A Canonical Structure: *) Canonical natPointed : PointedType := {| Carrier := nat; point := 42 |}. (* A Coercion: *) Coercion to_nat (b : bool) := if b then 1 else 0. (* A Setting: *) Set Universe Polymorphism. (* A Hint: *) Hint Resolve secret_42 : plop. End Bar. (* Availability of the parameter *) Check secret. (* Availability of the axiom *) Check secret_is_42. (* Availability of the tactic *) Fail Print find_secret. (* Availability of the abbreviation *) Fail Check add_42. (* Availability of the tactic notation *) Lemma plop_i : 2 + 2 = 4. Proof. Fail rfl. Admitted. (* Availability of the notation *) Fail Check (2 +p 3). (* Availability of the canonical structure *) Check (point nat). (* Availability of the coercion *) Check (true + 2). (* Availability of [Set Universe Polymorphism] *) Definition foo_i@{u} := nat. Check foo_i@{_}. (* Availability of the [Hint] *) Lemma hop_i : secret = 42. Proof. Fail solve [auto with plop]. Admitted. End InSectionDefault. Module InSectionLocal. Section Bar. (* A parameter: *) #[local] Parameter (secret : nat). (* An axiom: *) #[local] Axiom secret_is_42 : secret = 42. (* A custom tactic: *) #[local] Ltac find_secret := rewrite secret_is_42. (* An abbreviation: *) #[local] Notation add_42 := (Nat.add 42). (* A tactic notation: *) #[local] Tactic Notation "rfl" := reflexivity. (* A notation: *) #[local] Infix "+p" := Nat.add (only parsing, at level 30, right associativity) : nat_scope. (* A lemma: *) #[local] Lemma secret_42 : secret = 42. Proof. find_secret. rfl. Qed. (* A Canonical Structure *) #[local] Canonical natPointed : PointedType := {| Carrier := nat; point := 42 |}. (* A Coercion *) #[local] Coercion to_nat (b : bool) := if b then 1 else 0. (* A Setting *) #[local] Set Universe Polymorphism. (* A Hint *) #[local] Hint Resolve secret_42 : plop. End Bar. (** **** Without importing: *) (* Availability of the parameter *) Check secret. (* Availability of the axiom *) Check secret_is_42. (* Availability of the tactic *) Fail Print find_secret. (* Availability of the abbreviation *) Fail Check add_42. (* Availability of the tactic notation *) Lemma plop_ni : 2 + 2 = 4. Proof. Fail rfl. Admitted. (* Availability of the notation *) Fail Check (2 +p 3). (* Availability of the canonical structure *) Fail Check (point nat). (* Availability of the coercion *) Fail Check (true + 2). (* Availability of [Set Universe Polymorphism] *) Definition foo_ni@{u} := nat. Fail Check foo_ni@{_}. (* Availability of the [Hint] *) Lemma hop_ni : secret = 42. Proof. Fail solve [auto with plop]. Admitted. End InSectionLocal. Module InSectionExport. Section Bar. (* A parameter: *) Fail #[export] Parameter (secret : nat). (* An axiom: *) Fail #[export] Axiom plop : 0 = 0. (* A custom tactic: *) Fail #[export] Ltac find_secret := reflexivity. (* An abbreviation: *) Fail #[export] Notation add_42 := (Nat.add 42). (* A tactic notation: *) Fail #[export] Tactic Notation "rfl" := reflexivity. (* A notation: *) Fail #[export] Infix "+p" := Nat.add (only parsing, at level 30, right associativity) : nat_scope. (* A lemma: *) Fail #[export] Lemma secret_42 : secret = 42. (* A Canonical Structure *) Fail #[export] Canonical natPointed : PointedType := {| Carrier := nat; point := 42 |}. (* A Coercion *) Fail#[export] Coercion to_nat (b : bool) := if b then 1 else 0. (* A Setting *) #[export] Set Universe Polymorphism. (* A Hint *) Parameter (secret : nat). Axiom secret_42 : secret = 42. Fail #[export] Hint Resolve secret_42 : plop. End Bar. (* Availability of [Set Universe Polymorphism] *) Definition foo_ni@{u} := nat. Check foo_ni@{_}. End InSectionExport. Module InSectionGlobal. Section Bar. (* A parameter: *) #[global] Parameter (secret : nat). (* An axiom: *) #[global] Axiom secret_is_42 : secret = 42. (* A custom tactic: *) Fail #[global] Ltac find_secret := rewrite secret_is_42. (* An abbreviation: *) Fail #[global] Notation add_42 := (Nat.add 42). (* A tactic notation: *) Fail #[global] Tactic Notation "rfl" := reflexivity. (* A notation: *) Fail #[global] Infix "+p" := Nat.add (only parsing, at level 30, right associativity) : nat_scope. (* A Canonical Structure *) #[global] Canonical natPointed : PointedType := {| Carrier := nat; point := 42 |}. (* A Coercion *) #[global] Coercion to_nat (b : bool) := if b then 1 else 0. (* A Setting *) #[global] Set Universe Polymorphism. (* A Hint *) Fail #[global] Hint Resolve secret_is_42 : plop. End Bar. (** **** Without importing: *) (* Availability of the parameter *) Check secret. (* Availability of the axiom *) Check secret_is_42. (* Availability of the canonical structure *) Check (point nat). (* Availability of the coercion *) Check (true + 2). (* Availability of [Set Universe Polymorphism] *) Definition foo_ni@{u} := nat. Check foo_ni@{_}. End InSectionGlobal. coq-8.20.0/test-suite/success/locality_attributes_sections_in_modules.v000066400000000000000000000121751466560755400265730ustar00rootroot00000000000000(** This file tests how locality attributes affect usual vernacular commands. PLEASE, when this file fails to compute following a voluntary change in Coq's behaviour, modify accordingly the tables in [sections.rst] and [modules.rst] in [doc/sphinx/language/core]. Also look at the corresponding discussions about locality attributes in the refman (directory doc/sphinx) - For Definition, Lemma, ..., look at language/core/definitions.rst - For Axiom, Conjecture, ..., look at language/core/assumptions.rst - For abbreviations, look at user-extensions/syntax-extensions.rst - For Notations, look at user-extensions/syntax-extensions.rst - For Tactic Notations, look at user-extensions/syntax-extensions.rst - For Ltac, look at proof-engine/ltac.rst - For Canonical Structures, look at language/extensions/canonical.rst - For Hints, look at proofs/automatic-tactics/auto.rst - For Coercions, look at addendum/implicit-coercions.rst - For Ltac2, look at proof-engine/ltac2.rst - For Ltac2 Notations, look at proof-engine/ltac2.rst - For Set, look at language/core/basic.rst *) (** This structure is used to test availability or not of a [Canonical Structure]. *) Structure PointedType : Type := { Carrier :> Set; point : Carrier }. (** ** Tests of visibility attributes in a section inside a module *) (** We only test [Definition], [Coercion], [Canonical] and [Set], the other commands only support the [local] attribute in sections, which is also the default visibility, making them unavailable outside the section. *) (** *** Without attribute (default) *) Module InSectionDefault. Module M. Section Bar. (* A definition: *) Definition foo := 42. (* A Coercion: *) Coercion to_nat (b : bool) := if b then 1 else 0. (* A Canonical Structure: *) Canonical natPointed : PointedType := {| Carrier := nat; point := 42 |}. (* A Setting: *) Set Universe Polymorphism. End Bar. End M. Module M_not_imported. (** First, we do not import M. *) (* Availability of the definition *) Fail Check foo. (* not imported *) (* Availability of the coercion *) Fail Check (true + 2). (* not imported *) (* Availability of the canonical structure *) Fail Check (point nat). (* not imported *) (* Availability of [Set Universe Polymorphism] *) Definition foo_i@{u} := nat. Fail Check foo_i@{_}. End M_not_imported. Module M_imported. (** Now we import M. *) Import M. (* Availability of the definition *) Check foo. (* Availability of the coercion *) Check (true + 2). (* Availability of the canonical structure *) Check (point nat). (* Availability of [Set Universe Polymorphism] *) Definition foo_i@{u} := nat. Fail Check foo_i@{_}. End M_imported. End InSectionDefault. (** *** With the [local] attribute *) (** We only need to test a definition, we know the other commands have no effect outside the section (hence outside the module containing the section). *) Module InSectionLocal. Module M. Section Bar. (* A definition: *) #[local] Definition foo := 42. End Bar. End M. Module M_not_imported. (** First, we do not import M. *) (* Availability of the definition *) Fail Check foo. (* not imported *) Check M.foo. End M_not_imported. Module M_imported. (** Now we import M. *) Import M. (* Availability of the definition *) Fail Check foo. (* /!\ notice the local attribute has been passed to the module! *) Check M.foo. End M_imported. End InSectionLocal. (** *** With the [export] attribute *) (** We only need to test a setting, it is the only command for which [export] is supported inside a [Section]. *) Module InSectionExport. Module M. Section Bar. (* A Setting *) #[export] Set Universe Polymorphism. End Bar. End M. Module M_not_imported. (** **** Without importing: *) (* Availability of [Set Universe Polymorphism] *) Definition foo_ni@{u} := nat. Fail Check foo_ni@{_}. End M_not_imported. Module M_imported. Import M. (* Availability of [Set Universe Polymorphism] *) Definition foo_ni@{u} := nat. Check foo_ni@{_}. End M_imported. End InSectionExport. (** *** With the [export] attribute *) (** We only need to test [Coercion], [Canonical] and [Set]. *) Module InSectionGlobal. Module M. Section Bar. (* A Coercion: *) #[global] Coercion to_nat (b : bool) := if b then 1 else 0. (* A Canonical Structure: *) #[global] Canonical natPointed : PointedType := {| Carrier := nat; point := 42 |}. (* A Setting: *) #[global] Set Universe Polymorphism. End Bar. End M. Module M_not_imported. (** First, we do not import M. *) (* Availability of the coercion *) Fail Check (true + 2). (* not imported *) (* Availability of the canonical structure *) Fail Check (point nat). (* not imported *) (* Availability of [Set Universe Polymorphism] *) Definition foo_i@{u} := nat. Check foo_i@{_}. (* available *) (* /!\ global for [Set] in a section is passed to the module! *) End M_not_imported. Module M_imported. (** Now we import M. *) Import M. (* Availability of the coercion *) Check (true + 2). (* Availability of the canonical structure *) Check (point nat). (* Availability of [Set Universe Polymorphism] *) Definition foo_i@{u} := nat. Check foo_i@{_}. End M_imported. End InSectionGlobal. coq-8.20.0/test-suite/success/locality_attributes_sections_ltac2.v000066400000000000000000000053401466560755400254360ustar00rootroot00000000000000(** This file tests how locality attributes affect usual vernacular commands. PLEASE, when this file fails to compute following a voluntary change in Coq's behaviour, modify accordingly the tables in [sections.rst] and [modules.rst] in [doc/sphinx/language/core]. Also look at the corresponding discussions about locality attributes in the refman (directory doc/sphinx) - For Definition, Lemma, ..., look at language/core/definitions.rst - For Axiom, Conjecture, ..., look at language/core/assumptions.rst - For abbreviations, look at user-extensions/syntax-extensions.rst - For Notations, look at user-extensions/syntax-extensions.rst - For Tactic Notations, look at user-extensions/syntax-extensions.rst - For Ltac, look at proof-engine/ltac.rst - For Canonical Structures, look at language/extensions/canonical.rst - For Hints, look at proofs/automatic-tactics/auto.rst - For Coercions, look at addendum/implicit-coercions.rst - For Ltac2, look at proof-engine/ltac2.rst - For Ltac2 Notations, look at proof-engine/ltac2.rst - For Set, look at language/core/basic.rst *) From Ltac2 Require Import Ltac2. (** ** Tests for sections and visibility attributes with Ltac2 *) (* A parameter: *) Parameter (secret : nat). (* An axiom: *) Axiom secret_is_42 : secret = 42. (** *** Without attribute (default) *) Module InSectionDefault. Section Bar. (* A custom tactic: *) Ltac2 find_secret () := rewrite secret_is_42. Ltac2 Notation "rfl" := reflexivity. End Bar. (* Availability of the tactic *) Fail Print find_secret. (* Availability of the tactic notation *) Lemma plop_ni : 2 + 2 = 4. Proof. Fail rfl. Admitted. End InSectionDefault. Module InSectionLocal. Section Bar. #[local] Ltac2 find_secret () := rewrite secret_is_42. #[local] Ltac2 Notation "rfl" := reflexivity. End Bar. (* Availability of the tactic *) Fail Print find_secret. Fail Print Bar.find_secret. (* Availability of the tactic notation *) Lemma plop_ni : 2 + 2 = 4. Proof. Fail rfl. Admitted. End InSectionLocal. Module InSectionExport. Section Bar. (* A custom tactic: *) Fail #[export] Ltac2 find_secret := reflexivity. (* A tactic notation: *) Fail #[export] Ltac2 Notation "rfl" := reflexivity. End Bar. (** Nothing to check, Ltac2 and Ltac2 Notation do not support the [export] attribute. *) End InSectionExport. Module InSectionGlobal. Section Bar. (* A custom tactic: *) #[global] Ltac2 find_secret () := rewrite secret_is_42. (* A tactic notation: *) #[global] Ltac2 Notation "rfl" := reflexivity. End Bar. (* Availability of the tactic *) Fail Print find_secret. (* Availability of the tactic notation *) Lemma plop_ni : 2 + 2 = 4. Proof. Fail rfl. Admitted. End InSectionGlobal. coq-8.20.0/test-suite/success/ltac.v000066400000000000000000000231271466560755400173020ustar00rootroot00000000000000(* The tactic language *) (* Submitted by Pierre Crégut *) (* Checks substitution of x *) Ltac f x := unfold x; idtac. Lemma lem1 : 0 + 0 = 0. f plus. reflexivity. Qed. (* Submitted by Pierre Crégut *) (* Check syntactic correctness *) Ltac F x := idtac; G x with G y := idtac; F y. (* Check that Match Context keeps a closure *) Ltac U := let a := constr:(I) in match goal with | |- _ => apply a end. Lemma lem2 : True. U. Qed. (* Check that Match giving non-tactic arguments are evaluated at Let-time *) Ltac B := let y := (match goal with | z:_ |- _ => z end) in (intro H1; exact y). Lemma lem3 : True -> False -> True -> False. intros H H0. B. (* y is H0 if at let-time, H1 otherwise *) Qed. (* Checks the matching order of hypotheses *) Ltac Y := match goal with | x:_,y:_ |- _ => apply x end. Ltac Z := match goal with | y:_,x:_ |- _ => apply x end. Lemma lem4 : (True -> False) -> (False -> False) -> False. intros H H0. Z. (* Apply H0 *) Y. (* Apply H *) exact I. Qed. (* Check backtracking *) Lemma back1 : 0 = 1 -> 0 = 0 -> 1 = 1 -> 0 = 0. intros; match goal with | _:(0 = ?X1),_:(1 = 1) |- _ => exact (refl_equal X1) end. Qed. Lemma back2 : 0 = 0 -> 0 = 1 -> 1 = 1 -> 0 = 0. intros; match goal with | _:(0 = ?X1),_:(1 = 1) |- _ => exact (refl_equal X1) end. Qed. Lemma back3 : 0 = 0 -> 1 = 1 -> 0 = 1 -> 0 = 0. intros; match goal with | _:(0 = ?X1),_:(1 = 1) |- _ => exact (refl_equal X1) end. Qed. (* Check context binding *) Ltac sym t := match constr:(t) with | context C[(?X1 = ?X2)] => context C [X1 = X2] end. Lemma sym : 0 <> 1 -> 1 <> 0. intro H. let t := sym type of H in assert t. exact H. intro H1. apply H. symmetry . assumption. Qed. (* Check context binding in match goal *) (* This wasn't working in V8.0pl1, as the list of matched hyps wasn't empty *) Ltac sym' := match goal with | _:True |- context C[(?X1 = ?X2)] => let t := context C [X2 = X1] in assert t end. Lemma sym' : True -> 0 <> 1 -> 1 <> 0. intros Ht H. sym'. exact H. intro H1. apply H. symmetry . assumption. Qed. (* Check that fails abort the current match context *) Lemma decide : True \/ False. match goal with | _ => fail 1 | _ => right end || left. exact I. Qed. (* Check that "match c with" backtracks on subterms *) Lemma refl : 1 = 1. let t := (match constr:(1 = 2) with | context [(S ?X1)] => constr:(refl_equal X1:1 = 1) end) in assert (H := t). assumption. Qed. (* Note that backtracking in "match c with" is only on type-checking not on evaluation of tactics. E.g., this does not work Lemma refl : (1)=(1). Match (1)=(2) With [[(S ?1)]] -> Apply (refl_equal nat ?1). Qed. *) (* Check the precedences of rel context, ltac context and vars context *) (* (was wrong in V8.0) *) Ltac check_binding y := cut ((fun y => y) = S). Goal True. check_binding ipattern:(H). Abort. (* Check that variables explicitly parsed as ltac variables are not seen as intro pattern or constr (BZ#984) *) Ltac afi tac := intros; tac. Goal 1 = 2. afi ltac:(auto). Abort. (* Tactic Notation avec listes *) Tactic Notation "pat" hyp(id) "occs" integer_list(l) := pattern id at l. Goal forall x, x=0 -> x=x. intro x. pat x occs 1 3. Abort. Tactic Notation "revert" ne_hyp_list(l) := generalize l; clear l. Goal forall a b c, a=0 -> b=c+a. intros. revert a b c H. Abort. (* Used to fail until revision 9280 because of a parasitic App node with empty args *) Goal True. match constr:(@None) with @None => exact I end. Abort. (* Check second-order pattern unification *) Ltac to_exist := match goal with |- forall x y, @?P x y => let Q := eval lazy beta in (exists x, forall y, P x y) in assert (Q->Q) end. Goal forall x y : nat, x = y. to_exist. exact (fun H => H). Abort. (* Used to fail in V8.1 *) Tactic Notation "test" constr(t) integer(n) := set (k := t) at n. Goal forall x : nat, x = 1 -> x + x + x = 3. intros x H. test x 2. Abort. (* Utilisation de let rec sans arguments *) Ltac is := let rec i := match goal with |- ?A -> ?B => intro; i | _ => idtac end in i. Goal True -> True -> True. is. exact I. Abort. (* Interférence entre espaces des noms *) Ltac O := intro. Ltac Z1 t := set (x:=t). Ltac Z2 t := t. Goal True -> True. Z1 O. Z2 ltac:(O). exact I. Qed. (* Illegal application used to make Ltac loop. *) Section LtacLoopTest. Ltac g x := idtac. Goal True. Timeout 1 try g()(). Abort. End LtacLoopTest. (* Test binding of open terms *) Ltac test_open_match z := match z with (forall y x, ?h = 0) => assert (forall x y, h = x + y) end. Goal True. test_open_match (forall z y, y + z = 0). reflexivity. apply I. Qed. (* Test binding of open terms with non linear matching *) Ltac f_non_linear t := match t with (forall x y, ?u = 0) -> (forall y x, ?u = 0) => assert (forall x y:nat, u = u) end. Goal True. f_non_linear ((forall x y, x+y = 0) -> (forall x y, y+x = 0)). reflexivity. f_non_linear ((forall a b, a+b = 0) -> (forall a b, b+a = 0)). reflexivity. f_non_linear ((forall a b, a+b = 0) -> (forall x y, y+x = 0)). reflexivity. f_non_linear ((forall x y, x+y = 0) -> (forall a b, b+a = 0)). reflexivity. f_non_linear ((forall x y, x+y = 0) -> (forall y x, x+y = 0)). reflexivity. f_non_linear ((forall x y, x+y = 0) -> (forall y x, y+x = 0)) (* should fail *) || exact I. Qed. (* Test regular failure when clear/intro breaks soundness of the interpretation of terms in current environment *) Ltac g y := clear y; assert (y=y). Goal forall x:nat, True. intro x. Fail g x. Abort. Ltac h y := assert (y=y). Goal forall x:nat, True. intro x. Fail clear x; f x. Abort. (* Do not consider evars as unification holes in Ltac matching (and at least not as holes unrelated to the original evars) [Example adapted from Ynot code] *) Ltac not_eq e1 e2 := match e1 with | e2 => fail 1 | _ => idtac end. Goal True. evar(foo:nat). let evval := eval compute in foo in not_eq evval 1. let evval := eval compute in foo in not_eq 1 evval. Abort. (* Check instantiation of binders using ltac names *) Goal True. let x := ipattern:(y) in assert (forall x y, x = y + 0). intro. destruct y. (* Check that the name is y here *) Abort. (* An example suggested by Jason (see #4317) showing the intended semantics *) (* Order of binders is reverted because y is just told to depend on x *) Goal 1=1. let T := constr:(fun a b : nat => a) in lazymatch T with | (fun x z => ?y) => pose ((fun x x => y) 2 1) end. exact (eq_refl n). Qed. (* A variant of #2602 which was wrongly succeeding because "a", bound to "?m", was then internally turned into a "_" in the second matching *) Goal exists m, S m > 0. eexists. Fail match goal with | |- context [ S ?a ] => match goal with | |- S a > a => idtac end end. Abort. (* Test evar syntax *) Goal True. evar (0=0). Abort. (* Test location of hypothesis in "symmetry in H". This was broken in 8.6 where H, when the oldest hyp, was moved at the place of most recent hypothesis *) Goal 0=1 -> True -> True. intros H H0. symmetry in H. (* H should be the first hypothesis *) match goal with h:_ |- _ => assert (h=h) end. (* h should be H0 *) exact (eq_refl H0). Abort. (* Check that internal names used in "match" compilation to push "term to match" on the environment are not interpreted as ltac variables *) Module ToMatchNames. Ltac g c := let r := constr:(match c return _ with a => 1 end) in idtac. Goal True. g 1. Abort. End ToMatchNames. (* An example where internal names used to build the return predicate (here "n" because "a" is bound to "nil" and "n" is the first letter of "nil") by small inversion should be taken distinct from Ltac names. *) Module LtacNames. Inductive t (A : Type) : nat -> Type := nil : t A 0 | cons : A -> forall n : nat, t A n -> t A (S n). Ltac f a n := let x := constr:(match a with nil _ => true | cons _ _ _ _ => I end) in assert (x=x/\n=n). Goal forall (y:t nat 0), True. intros. f y true. Abort. End LtacNames. (* Test binding of the name of existential variables in Ltac *) Module EvarNames. Ltac pick x := eexists ?[x]. Goal exists y, y = 0. pick foo. [foo]:exact 0. auto. Qed. Ltac goal x := refine ?[x]. Goal forall n, n + 0 = n. Proof. induction n; [ goal Base | goal Rec ]. [Base]: { easy. } [Rec]: { simpl. now f_equal. } Qed. End EvarNames. Module LocalRedef. Ltac thetac := idtac. Ltac thetac' := idtac. Module Inner. Ltac thetac ::= fail. Local Ltac thetac' ::= fail. Goal False. Fail thetac. Fail thetac'. Abort. End Inner. Goal False. Fail thetac. thetac'. Abort. Section S. Variable f : False. Fail Global Ltac thetac' ::= exact f. Ltac thetac' ::= exact f. Goal False. Proof. thetac'. Qed. End S. Goal False. Proof. thetac'. Fail Qed. Abort. End LocalRedef. Module MatchCastInPattern. Goal let x := True in True. Proof. intro x. lazymatch goal with | [ H := ?v : ?T |- _ ] => constr_eq T Prop end. Fail lazymatch goal with | [ H := ?v <: ?T |- _ ] => constr_eq T Prop end. (* Warning: Casts are ignored in patterns [cast-in-pattern,automation] *) Set Warnings "+cast-in-pattern". Fail lazymatch goal with | [ H := ?v <: _ |- _ ] => idtac end. Fail lazymatch goal with | [ H := [ ?v : _ ] : _ |- _ ] => idtac end. Abort. End MatchCastInPattern. Module StrictModeConfusion. Goal True. Fail let x := constr:(match _ with x x => _ end) in idtac. (* for_grammar does not reset the ref when an exception is raised *) Abort. Fail Ltac bad := exact x. (* was wrongly accepted *) End StrictModeConfusion. coq-8.20.0/test-suite/success/ltac_match_pattern_names.v000066400000000000000000000011341466560755400233700ustar00rootroot00000000000000(* example from bug 5345 *) Ltac break_tuple := match goal with | [ H: context[let '(n, m) := ?a in _] |- _ ] => let n := fresh n in let m := fresh m in destruct a as [n m] end. (* desugared version of break_tuple *) Ltac break_tuple' := match goal with | [ H: context[match ?a with | pair n m => _ end] |- _ ] => let n := fresh n in let m := fresh m in idtac end. Ltac multiple_branches := match goal with | [ H: match _ with | left P => _ | right Q => _ end |- _ ] => let P := fresh P in let Q := fresh Q in idtac end. coq-8.20.0/test-suite/success/ltac_plus.v000066400000000000000000000005451466560755400203440ustar00rootroot00000000000000(** Checks that Ltac's '+' tactical works as intended. *) Goal forall (A B C D:Prop), (A->C) -> (B->C) -> (D->C) -> B -> C. Proof. intros A B C D h0 h1 h2 h3. (* backtracking *) (apply h0 + apply h1);apply h3. Undo. Fail ((apply h0+apply h2) || apply h1); apply h3. (* interaction with || *) ((apply h0+apply h1) || apply h2); apply h3. Qed. coq-8.20.0/test-suite/success/ltacprof.v000066400000000000000000000013741466560755400201710ustar00rootroot00000000000000(** Some LtacProf tests *) Set Ltac Profiling. Ltac multi := (idtac + idtac). Goal True. try (multi; fail). (* Used to result in: Anomaly: Uncaught exception Failure("hd"). Please report. *) Admitted. Show Ltac Profile. (* backtracking across profiler manipulation *) Unset Ltac Profiling. Reset Ltac Profile. Fixpoint slow (n : nat) : unit := match n with | 0 => tt | S n => fst (slow n, slow n) end. Ltac slow := idtac; let v := eval cbv in (slow 16) in idtac. Ltac multi2 := try (((idtac; slow) + (start ltac profiling; slow) + (idtac; slow) + (slow; stop ltac profiling; slow) + slow + (start ltac profiling; (idtac + slow); ((stop ltac profiling + idtac); fail))); slow; fail); slow; show ltac profile. Goal True. multi2. Admitted. coq-8.20.0/test-suite/success/match_case_pattern_variables.v000066400000000000000000000014251466560755400242300ustar00rootroot00000000000000(** Check that bound variables in case patterns are handled correctly. *) Goal forall (ch : unit) (t : list unit) (s : list unit), match s with | nil => False | cons a l => ch = a /\ l = t end. Proof. intros. match goal with | |- match ?e with | nil => ?N | cons a b => ?P end => let f := constr:((fun (e' : list unit) => match e' with | nil => N | cons a b => P end)) in change (f e) end. Abort. Goal forall (ch : unit) (n : nat) (s : prod unit nat), let (a, l) := s in ch = a /\ l = n. Proof. intros. match goal with | [ |- let (a, b) := ?e in ?P ] => let f := constr:((fun (e' : prod unit nat) => match e' with pair a b => P end)) in change (f e) end. Abort. coq-8.20.0/test-suite/success/module_with_def_univ_poly.v000066400000000000000000000012351466560755400236150ustar00rootroot00000000000000 (* When doing Module Foo with Definition bar := ..., bar must be generated with the same polymorphism as Foo.bar. *) Module Mono. Unset Universe Polymorphism. Module Type T. Parameter foo : Type. End T. Module Type F(A:T). End F. Set Universe Polymorphism. Module M : T with Definition foo := Type. Monomorphic Definition foo := Type. End M. End Mono. Module Poly. Set Universe Polymorphism. Module Type T. Parameter foo@{i|Set < i} : Type@{i}. End T. Module Type F(A:T). End F. Unset Universe Polymorphism. Module M : T with Definition foo := Set : Type. Polymorphic Definition foo := Set : Type. End M. End Poly. coq-8.20.0/test-suite/success/mutual_ind.v000066400000000000000000000033301466560755400205120ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* sort -> bool; sort_beq_refl : forall f : sort, true = sort_beq f f; sort_beq_eq : forall f1 f2 : sort, true = sort_beq f1 f2 -> f1 = f2; fsym :> Set; fsym_type : fsym -> list sort * sort; fsym_beq : fsym -> fsym -> bool; fsym_beq_refl : forall f : fsym, true = fsym_beq f f; fsym_beq_eq : forall f1 f2 : fsym, true = fsym_beq f1 f2 -> f1 = f2}. Parameter F : signature. Definition vsym := (sort F * nat)%type. Definition vsym_sort := fst (A:=sort F) (B:=nat). Definition vsym_nat := snd (A:=sort F) (B:=nat). Inductive term : sort F -> Set := | term_var : forall v : vsym, term (vsym_sort v) | term_app : forall f : F, list_term (fst (fsym_type F f)) -> term (snd (fsym_type F f)) with list_term : list (sort F) -> Set := | term_nil : list_term nil | term_cons : forall (s : sort F) (l : list (sort F)), term s -> list_term l -> list_term (s :: l). coq-8.20.0/test-suite/success/mutual_record.v000066400000000000000000000013611466560755400212200ustar00rootroot00000000000000Module M0. Inductive foo (A : Type) := Foo { foo0 : option (bar A); foo1 : nat; foo2 := foo1 = 0; foo3 : foo2; } with bar (A : Type) := Bar { bar0 : A; bar1 := 0; bar2 : bar1 = 0; bar3 : nat -> foo A; }. End M0. Module M1. Set Primitive Projections. Inductive foo (A : Type) := Foo { foo0 : option (bar A); foo1 : nat; foo2 := foo1 = 0; foo3 : foo2; } with bar (A : Type) := Bar { bar0 : A; bar1 := 0; bar2 : bar1 = 0; bar3 : nat -> foo A; }. End M1. Module M2. Set Primitive Projections. CoInductive foo (A : Type) := Foo { foo0 : option (bar A); foo1 : nat; foo2 := foo1 = 0; foo3 : foo2; } with bar (A : Type) := Bar { bar0 : A; bar1 := 0; bar2 : bar1 = 0; bar3 : nat -> foo A; }. End M2. coq-8.20.0/test-suite/success/name_mangling.v000066400000000000000000000061431466560755400211520ustar00rootroot00000000000000Set Mangle Names. (* Check that refine policy of redefining previous names make these names private *) Goal True -> True. intro. Fail exact H. exact _0. Abort. Unset Mangle Names. Goal True -> True. intro; exact H. Abort. Set Mangle Names. Set Mangle Names Prefix "baz". Goal True -> True. intro. Fail exact H. Fail exact _0. exact baz0. Abort. Goal True -> True. intro; assumption. Abort. Goal True -> True. intro x; exact x. Abort. Goal forall x y, x+y=0. intro x. refine (fun x => _). Fail Check x0. Check x. Abort. (* Example from Emilio *) Goal forall b : False, b = b. intro b. refine (let b := I in _). Fail destruct b0. Abort. (* Example from Cyprien *) Goal True -> True. Proof. refine (fun _ => _). Fail exact t. Abort. (* Example from Jason *) Goal False -> False. intro H. abstract exact H. Abort. (* Variant *) Goal False -> False. intro. Fail abstract exact H. Abort. (* Example from Jason *) Lemma lem1 : False -> False. intro H. (* Name H' is from Ltac here, so it preserves the privacy *) (* But abstract messes everything up *) let H' := H in abstract exact H'. Qed. (* Variant *) Goal False -> False. intro. Fail let H' := H in abstract exact H'. Abort. (* Indirectly testing preservation of names by move (derived from Jason) *) Inductive nat2 := S2 (_ _ : nat2). Goal forall t : nat2, True. intro t. let IHt1 := fresh "IHt1" in let IHt2 := fresh "IHt2" in induction t as [? IHt1 ? IHt2]. Fail exact IHt1. Abort. (* Example on "pose proof" (from Jason) *) Goal False -> False. intro; pose proof I as H0. Fail exact H. Abort. (* Testing the approach for which non alpha-renamed quantified names are user-generated *) Section foo. Context (b : True). Goal forall b : False, b = b. Fail destruct b0. Abort. Lemma lem2 : forall b : False, b = b. now destruct b. Qed. End foo. (* Test stability of "fix" *) Lemma a : forall n, n = 0. Proof. fix a 1. Check a. Fail fix a 1. Abort. (* Test stability of "induction" *) Lemma a : forall n : nat, n = n. Proof. intro n; induction n as [ | n IHn ]. - auto. - Check n. Check IHn. Abort. Inductive I := C : I -> I -> I. Lemma a : forall n : I, n = n. Proof. intro n; induction n as [ n1 IHn1 n2 IHn2 ]. Check n1. Check n2. apply f_equal2. + apply IHn1. + apply IHn2. Qed. (* Testing remember *) Lemma c : 0 = 0. Proof. remember 0 as x eqn:Heqx. Check Heqx. Abort. Lemma c : forall Heqx, Heqx -> 0 = 0. Proof. intros Heqx X. remember 0 as x. Fail Check Heqx0. (* Heqx0 is not canonical *) Abort. (* An example by Jason from the discussion for PR #268 *) Goal nat -> Set -> True. intros x y. match goal with | [ x : _, y : _ |- _ ] => let z := fresh "z" in rename y into z, x into y; let x' := fresh "x" in rename z into x' end. revert y. (* x has been explicitly moved to y *) Fail revert x. (* x comes from "fresh" *) Abort. Goal nat -> Set -> True. intros. match goal with | [ x : _, y : _ |- _ ] => let z := fresh "z" in rename y into z, x into y; let x' := fresh "x" in rename z into x' end. Fail revert y. (* generated by intros *) Fail revert x. (* generated by intros *) Abort. coq-8.20.0/test-suite/success/namedunivs.v000066400000000000000000000054111466560755400205240ustar00rootroot00000000000000(* Inductive paths {A} (x : A) : A -> Type := idpath : paths x x where "x = y" := (@paths _ x y) : type_scope. *) (* Goal forall A B : Set, @paths Type A B -> @paths Set A B. *) (* intros A B H. *) (* Fail exact H. *) (* Section . *) Unset Strict Universe Declaration. #[universes(polymorphic)] Section lift_strict. Polymorphic Definition liftlt := let t := Type@{i} : Type@{k} in fun A : Type@{i} => A : Type@{k}. Polymorphic Definition liftle := fun A : Type@{i} => A : Type@{k}. End lift_strict. Set Universe Polymorphism. (* Inductive option (A : Type) : Type := *) (* | None : option A *) (* | Some : A -> option A. *) Inductive option (A : Type@{i}) : Type@{i} := | None : option A | Some : A -> option A. Definition foo' {A : Type@{i}} (o : option@{i} A) : option@{i} A := o. Definition foo'' {A : Type@{i}} (o : option@{j} A) : option@{k} A := o. Definition testm (A : Type@{i}) : Type@{max(i,j)} := A. (* Inductive prod (A : Type@{i}) (B : Type@{j}) := *) (* | pair : A -> B -> prod A B. *) (* Definition snd {A : Type@{i}} (B : Type@{j}) (p : prod A B) : B := *) (* match p with *) (* | pair _ _ a b => b *) (* end. *) (* Definition snd' {A : Type@{i}} (B : Type@{i}) (p : prod A B) : B := *) (* match p with *) (* | pair _ _ a b => b *) (* end. *) (* Inductive paths {A : Type} : A -> A -> Type := *) (* | idpath (a : A) : paths a a. *) Inductive paths {A : Type@{i}} : A -> A -> Type@{i} := | idpath (a : A) : paths a a. Definition Funext := forall (A : Type) (B : A -> Type), forall f g : (forall a, B a), (forall x : A, paths (f x) (g x)) -> paths f g. Definition paths_lift_closed (A : Type@{i}) (x y : A) : paths x y -> @paths (liftle@{j Type} A) x y. Proof. intros. destruct X. exact (idpath _). Defined. Definition paths_lift (A : Type@{i}) (x y : A) : paths x y -> paths@{j} x y. Proof. intros. destruct X. exact (idpath _). Defined. Definition paths_lift_closed_strict (A : Type@{i}) (x y : A) : paths x y -> @paths (liftlt@{j Type} A) x y. Proof. intros. destruct X. exact (idpath _). Defined. Definition paths_downward_closed_le (A : Type@{i}) (x y : A) : paths@{j} (A:=liftle@{i j} A) x y -> paths@{i} x y. Proof. intros. destruct X. exact (idpath _). Defined. Definition paths_downward_closed_lt (A : Type@{i}) (x y : A) : @paths (liftlt@{j i} A) x y -> paths x y. Proof. intros. destruct X. exact (idpath _). Defined. Definition paths_downward_closed_lt_nolift (A : Type@{i}) (x y : A) : paths@{j} x y -> paths x y. Proof. intros. destruct X. exact (idpath _). Defined. Definition funext_downward_closed (F : Funext@{i' j' k'}) : Funext@{i j k}. Proof. intros A B f g H. red in F. pose (F A B f g (fun x => paths_lift _ _ _ (H x))). apply paths_downward_closed_lt_nolift. apply p. Defined. coq-8.20.0/test-suite/success/nativecompute.v000066400000000000000000000001771466560755400212420ustar00rootroot00000000000000(* An example with local definitions *) Inductive I (a:=0) (b:nat) (c:=1) := C : I b. Eval native_compute in (fun x => C) 0. coq-8.20.0/test-suite/success/onlyprinting.v000066400000000000000000000002261466560755400211060ustar00rootroot00000000000000Notation "x ++ y" := (plus x y) (only printing). Fail Check 0 ++ 0. Notation "x + y" := (max x y) (only printing). Check (eq_refl : 42 + 18 = 60). coq-8.20.0/test-suite/success/options.v000066400000000000000000000012621466560755400200460ustar00rootroot00000000000000(* Check that the syntax for options works *) Set Implicit Arguments. Unset Strict Implicit. Set Strict Implicit. Unset Implicit Arguments. Test Implicit Arguments. Set Printing Coercions. Unset Printing Coercions. Test Printing Coercions. Set Silent. Unset Silent. Test Silent. Set Printing Depth 100. Test Printing Depth. Parameter i : bool -> nat. Coercion i : bool >-> nat. Add Printing Coercion i. Remove Printing Coercion i. Test Printing Coercion for i. Test Printing Let. Test Printing If. Remove Printing Let sig. Remove Printing If bool. Unset Printing Synth. Set Printing Synth. Test Printing Synth. Unset Printing Wildcard. Set Printing Wildcard. Test Printing Wildcard. coq-8.20.0/test-suite/success/par_abstract.v000066400000000000000000000007251466560755400210230ustar00rootroot00000000000000Axiom T : Type. Lemma foo : True * Type. Proof. split. par: abstract (exact I || exact T). Defined. (* Yes, these names are generated hence the test is fragile. I want to assert that abstract was correctly handled by par: *) Check foo_subproof. Check foo_subproof0. Check (refl_equal _ : foo = pair foo_subproof foo_subproof0). Lemma bar : True * Type. Proof. split. par: (exact I || exact T). Defined. Check (refl_equal _ : bar = pair I T). coq-8.20.0/test-suite/success/paralleltac.v000066400000000000000000000022711466560755400206400ustar00rootroot00000000000000Lemma test_nofail_like_all1 : True /\ False. Proof. split. all: trivial. Admitted. Lemma test_nofail_like_all2 : True /\ False. Proof. split. par: trivial. Admitted. Fixpoint fib n := match n with | O => 1 | S m => match m with | O => 1 | S o => fib o + fib m end end. Ltac sleep n := try (assert (fib n = S (fib n)) by reflexivity). (* Tune that depending on your PC *) #[local] Definition time := 18. Axiom P : nat -> Prop. Axiom P_triv : Type -> forall x, P x. Ltac solve_P := match goal with |- P (S ?X) => sleep time; exact (P_triv Type _) end. Lemma test_old x : P (S x) /\ P (S x) /\ P (S x) /\ P (S x). Proof. repeat split. idtac "T1: linear". Time all: solve [solve_P]. Qed. Lemma test_ok x : P (S x) /\ P (S x) /\ P (S x) /\ P (S x). Proof. repeat split. idtac "T2: parallel". Time par: solve [solve_P]. Qed. Lemma test_fail x : P (S x) /\ P x /\ P (S x) /\ P (S x). Proof. repeat split. idtac "T3: linear failure". Fail Time all: solve solve_P. all: solve [apply (P_triv Type)]. Qed. Lemma test_fail2 x : P (S x) /\ P x /\ P (S x) /\ P (S x). Proof. repeat split. idtac "T4: parallel failure". Fail Time par: solve [solve_P]. all: solve [apply (P_triv Type)]. Qed. coq-8.20.0/test-suite/success/parsing.v000066400000000000000000000003321466560755400200130ustar00rootroot00000000000000Section A. Notation "*" := O (at level 8). Notation "**" := O (at level 99). Notation "***" := O (at level 9). End A. Notation "*" := O (at level 8). Notation "**" := O (at level 99). Notation "***" := O (at level 9). coq-8.20.0/test-suite/success/pattern.v000066400000000000000000000025701466560755400200330ustar00rootroot00000000000000(* Test pattern with dependent occurrences; Note that it does not behave as the succession of three generalize because each quantification introduces new occurrences that are automatically abstracted with the numbering still based on the original statement *) Goal (id true,id false)=(id true,id true). generalize bool at 2 4 6 8 10 as B, true at 3 as tt, false as ff. Abort. (* Check use of occurrences in hypotheses for a reduction tactic such as pattern *) (* Did not work in 8.2 *) Goal 0=0->True. intro H. pattern 0 in H at 2. set (f n := 0 = n) in H. (* check pattern worked correctly *) Abort. (* Syntactic variant which was working in 8.2 *) Goal 0=0->True. intro H. pattern 0 at 2 in H. set (f n := 0 = n) in H. (* check pattern worked correctly *) Abort. (* Ambiguous occurrence selection *) Goal 0=0->True. intro H. pattern 0 at 1 in H at 2 || exact I. (* check pattern fails *) Qed. (* Ambiguous occurrence selection *) Goal 0=1->True. intro H. pattern 0, 1 in H at 1 2 || exact I. (* check pattern fails *) Qed. (* Occurrence selection shared over hypotheses is difficult to advocate and hence no longer allowed *) Goal 0=1->1=0->True. intros H1 H2. pattern 0 at 1, 1 in H1, H2 || exact I. (* check pattern fails *) Qed. (* Test catching of reduction tactics errors (was not the case in 8.2) *) Goal eq_refl 0 = eq_refl 0. pattern 0 at 1 || reflexivity. Qed. coq-8.20.0/test-suite/success/pattern_genarg.v000066400000000000000000000002021466560755400213440ustar00rootroot00000000000000 Succeed Hint Resolve O | nat : core. Fail Hint Resolve O | ltac:(idtac) : core. Fail Hint Resolve O | ltac:(exact nat) : core. coq-8.20.0/test-suite/success/polymorphism.v000066400000000000000000000260731466560755400211240ustar00rootroot00000000000000Unset Strict Universe Declaration. Module withoutpoly. Inductive empty :=. Inductive emptyt : Type :=. Inductive singleton : Type := single. Inductive singletoninfo : Type := singleinfo : unit -> singletoninfo. Inductive singletonset : Set := singleset. Inductive singletonnoninfo : Type := singlenoninfo : empty -> singletonnoninfo. Inductive singletoninfononinfo : Prop := singleinfononinfo : unit -> singletoninfononinfo. Inductive bool : Type := | true | false. Inductive smashedbool : Prop := | trueP | falseP. End withoutpoly. Set Universe Polymorphism. Inductive empty :=. Inductive emptyt : Type :=. Inductive singleton : Type := single. Inductive singletoninfo : Type := singleinfo : unit -> singletoninfo. Inductive singletonset : Set := singleset. Inductive singletonnoninfo : Type := singlenoninfo : empty -> singletonnoninfo. Inductive singletoninfononinfo : Prop := singleinfononinfo : unit -> singletoninfononinfo. Inductive bool : Type := | true | false. Inductive smashedbool : Prop := | trueP | falseP. Section foo. Let T := Type. Inductive polybool : T := | trueT | falseT. End foo. Inductive list (A: Type) : Type := | nil : list A | cons : A -> list A -> list A. Module ftypSetSet. Inductive ftyp : Type := | Funit : ftyp | Ffun : list ftyp -> ftyp | Fref : area -> ftyp with area : Type := | Stored : ftyp -> area . End ftypSetSet. Module ftypSetProp. Inductive ftyp : Type := | Funit : ftyp | Ffun : list ftyp -> ftyp | Fref : area -> ftyp with area : Type := | Stored : (* ftyp -> *)area . End ftypSetProp. Module ftypSetSetForced. Inductive ftyp : Type := | Funit : ftyp | Ffun : list ftyp -> ftyp | Fref : area -> ftyp with area : Set (* Type *) := | Stored : (* ftyp -> *)area . End ftypSetSetForced. Unset Universe Polymorphism. Set Printing Universes. Module Easy. Polymorphic Inductive prod (A : Type) (B : Type) : Type := pair : A -> B -> prod A B. Check prod nat nat. Print Universes. Polymorphic Inductive sum (A B:Type) : Type := | inl : A -> sum A B | inr : B -> sum A B. Print sum. Check (sum nat nat). End Easy. Section Hierarchy. Definition Type3 := Type. Definition Type2 := Type : Type3. Definition Type1 := Type : Type2. Definition id1 := ((forall A : Type1, A) : Type2). Definition id2 := ((forall A : Type2, A) : Type3). Definition id1' := ((forall A : Type1, A) : Type3). Fail Definition id1impred := ((forall A : Type1, A) : Type1). End Hierarchy. Record hypo : Type := mkhypo { hypo_type : Type; hypo_proof : hypo_type }. Definition typehypo (A : Type) : hypo := {| hypo_proof := A |}. Polymorphic Record dyn : Type := mkdyn { dyn_type : Type; dyn_proof : dyn_type }. Definition monotypedyn (A : Type) : dyn := {| dyn_proof := A |}. Polymorphic Definition typedyn (A : Type) : dyn := {| dyn_proof := A |}. Definition atypedyn : dyn := typedyn Type. Definition projdyn := dyn_type atypedyn. Definition nested := {| dyn_type := dyn; dyn_proof := atypedyn |}. Definition nested2 := {| dyn_type := dyn; dyn_proof := nested |}. Definition projnested2 := dyn_type nested2. Polymorphic Definition nest (d : dyn) := {| dyn_proof := d |}. Polymorphic Definition twoprojs (d : dyn) := dyn_proof d = dyn_proof d. Module binders. Definition mynat@{|} := nat. Definition foo@{i j | i < j, i < j} (A : Type@{i}) : Type@{j}. exact A. Defined. Polymorphic Lemma hidden_strict_type : Type. Proof. exact Type. Qed. Check hidden_strict_type@{_}. Fail Check hidden_strict_type@{Set}. Fail Definition morec@{i j|} (A : Type@{i}) : Type@{j} := A. (* By default constraints are extensible *) Polymorphic Definition morec@{i j} (A : Type@{i}) : Type@{j} := A. Check morec@{_ _}. (* Handled in proofs as well *) Lemma bar@{i j | } : Type@{i}. exact Type@{j}. Fail Defined. Abort. Fail Lemma bar@{u v | } : let x := (fun x => x) : Type@{u} -> Type@{v} in nat. Lemma bar@{i j| i < j} : Type@{j}. Proof. exact Type@{i}. Qed. Lemma barext@{i j|+} : Type@{j}. Proof. exact Type@{i}. Qed. Monomorphic Universe M. Fail Definition with_mono@{u|} : Type@{M} := Type@{u}. Definition with_mono@{u|u < M} : Type@{M} := Type@{u}. End binders. #[universes(polymorphic)] Section cats. Local Set Universe Polymorphism. Require Import Utf8. Definition fibration (A : Type) := A -> Type. Definition Hom (A : Type) := A -> A -> Type. Record sigma (A : Type) (P : fibration A) := { proj1 : A; proj2 : P proj1} . Class Identity {A} (M : Hom A) := identity : ∀ x, M x x. Class Inverse {A} (M : Hom A) := inverse : ∀ x y:A, M x y -> M y x. Class Composition {A} (M : Hom A) := composition : ∀ {x y z:A}, M x y -> M y z -> M x z. Notation "g ° f" := (composition f g) (at level 50). Class Equivalence T (Eq : Hom T):= { Equivalence_Identity :: Identity Eq ; Equivalence_Inverse :: Inverse Eq ; Equivalence_Composition :: Composition Eq }. Class EquivalenceType (T : Type) : Type := { m2: Hom T; equiv_struct :: Equivalence T m2 }. Polymorphic Record cat (T : Type) := { cat_hom : Hom T; cat_equiv : forall x y, EquivalenceType (cat_hom x y) }. Definition catType := sigma Type cat. Notation "[ T ]" := (proj1 T). Require Import Program. Program Definition small_cat : cat Empty_set := {| cat_hom x y := unit |}. Next Obligation. refine ({|m2:=fun x y => True|}). constructor; red; intros; trivial. Defined. Record iso (T U : Set) := { f : T -> U; g : U -> T }. Program Definition Set_cat : cat Set := {| cat_hom := iso |}. Next Obligation. refine ({|m2:=fun x y => True|}). constructor; red; intros; trivial. Defined. Record isoT (T U : Type) := { isoT_f : T -> U; isoT_g : U -> T }. Program Definition Type_cat : cat Type := {| cat_hom := isoT |}. Next Obligation. refine ({|m2:=fun x y => True|}). constructor; red; intros; trivial. Defined. Polymorphic Record cat1 (T : Type) := { cat1_car : Type; cat1_hom : Hom cat1_car; cat1_hom_cat : forall x y, cat (cat1_hom x y) }. End cats. Polymorphic Definition id {A : Type} (a : A) : A := a. Definition typeid := (@id Type). Fail Check (Prop : Set). Fail Check (Set : Set). Check (Set : Type). Check (Prop : Type). Definition setType := ltac:(let t := type of Set in exact t). Definition foo (A : Prop) := A. Fail Check foo Set. Check fun A => foo A. Fail Check fun A : Type => foo A. Check fun A : Prop => foo A. Fail Definition bar := fun A : Set => foo A. Fail Check (let A := Type in foo (id A)). Definition fooS (A : Set) := A. Check (let A := nat in fooS (id A)). Fail Check (let A := Set in fooS (id A)). Fail Check (let A := Prop in fooS (id A)). (* Some tests of sort-polymorphisme *) #[universes(polymorphic)] Section S. Polymorphic Variable A:Type. (* Definition f (B:Type) := (A * B)%type. *) Polymorphic Inductive I (B:Type) : Type := prod : A->B->I B. Check I nat. End S. (* Check f nat nat : Set. *) Definition foo' := I nat nat. Print Universes. Print foo. Set Printing Universes. Print foo. (* Polymorphic axioms: *) Polymorphic Axiom funext : forall (A B : Type) (f g : A -> B), (forall x, f x = g x) -> f = g. (* Check @funext. *) (* Check funext. *) Polymorphic Definition fun_ext (A B : Type) := forall (f g : A -> B), (forall x, f x = g x) -> f = g. Polymorphic Class Funext A B := extensional : fun_ext A B. Section foo2. Context `{forall A B, Funext A B}. Print Universes. End foo2. Module eta. Set Universe Polymorphism. Set Printing Universes. Axiom admit : forall A, A. Record R := {O : Type}. Definition RL (x : R@{i}) : ltac:(let u := constr:(Type@{i}:Type@{j}) in exact (R@{j}) ) := {|O := @O x|}. Definition RLRL : forall x : R, RL x = RL (RL x) := fun x => eq_refl. Definition RLRL' : forall x : R, RL x = RL (RL x). intros. apply eq_refl. Qed. End eta. Module Hurkens'. Require Import Hurkens. Polymorphic Record box (X : Type) (T := Type) : Type := wrap { unwrap : T }. Definition unwrap' := fun (X : Type) (b : box X) => let (unw) := b in unw. Fail Definition bad : False := TypeNeqSmallType.paradox (unwrap' Type (wrap _ Type)) eq_refl. End Hurkens'. Module Anonymous. Set Universe Polymorphism. Definition defaultid := (fun x => x) : Type -> Type. Definition collapseid := defaultid@{_ _}. Check collapseid@{_}. Definition anonid := (fun x => x) : Type -> Type@{_}. Check anonid@{_}. Definition defaultalg := (fun x : Type => x) (Type : Type). Definition usedefaultalg := defaultalg@{_ _ _}. Check usedefaultalg@{_ _}. Definition anonalg := (fun x : Type@{_} => x) (Type : Type). Check anonalg@{_ _}. Definition unrelated@{i j} := nat. Definition useunrelated := unrelated@{_ _}. Check useunrelated@{_ _}. Definition inthemiddle@{i j k} := let _ := defaultid@{i j} in anonalg@{k j}. (* i <= j < k *) Definition collapsethemiddle := inthemiddle@{i _ j}. Check collapsethemiddle@{_ _}. End Anonymous. Module Restrict. (* Universes which don't appear in the term should be pruned, unless they have names *) Set Universe Polymorphism. Ltac exact0 := let x := constr:(Type) in exact 0. Definition dummy_pruned@{} : nat := ltac:(exact0). Definition named_not_pruned@{u} : nat := 0. Check named_not_pruned@{_}. Definition named_not_pruned_nonstrict : nat := ltac:(let x := constr:(Type@{u}) in exact 0). Check named_not_pruned_nonstrict@{_}. Lemma lemma_restrict_poly@{} : nat. Proof. exact0. Defined. Unset Universe Polymorphism. Lemma lemma_restrict_mono_qed@{} : nat. Proof. exact0. Qed. Lemma lemma_restrict_abstract@{} : nat. Proof. abstract exact0. Qed. End Restrict. Module F. #[warning="context-outside-section"] Context {A B : Type}. Definition foo : Type := B. End F. Set Universe Polymorphism. Cumulative Record box (X : Type) (T := Type) : Type := wrap { unwrap : T }. Section test_letin_subtyping. Universe i j k i' j' k'. Constraint j < j'. Context (W : Type) (X : box@{i j k} W). Definition Y := X : box@{i' j' k'} W. Universe i1 j1 k1 i2 j2 k2. Constraint i1 < i2. Constraint k2 < k1. Context (V : Type). Definition Z : box@{i1 j1 k1} V := {| unwrap := V |}. Definition Z' : box@{i2 j2 k2} V := {| unwrap := V |}. Lemma ZZ' : @eq (box@{i2 j2 k2} V) Z Z'. Proof. Set Printing All. Set Printing Universes. cbv. reflexivity. Qed. End test_letin_subtyping. 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@{_ _ _ _ _ _ _}. End ObligationRegression. Axiom poly@{i} : forall(A : Type@{i}) (a : A), unit. Definition nonpoly := @poly True Logic.I. Definition check := nonpoly@{}. Module ProgramFixpoint. Local Set Universe Polymorphism. Program Fixpoint f@{u} (A:Type@{u}) (n:nat) : Type@{u} := match n with 0 => A | S n => f (A->A) n end. Check f@{Set}. (* Check that it depends on only one universe *) End ProgramFixpoint. coq-8.20.0/test-suite/success/pose.v000066400000000000000000000002151466560755400173160ustar00rootroot00000000000000(* Test syntax *) Goal 0=0. pose proof (a := I). Fail clearbody a. epose proof (b := fun _ => eq_refl). Fail clearbody b. exact (b a). Qed. coq-8.20.0/test-suite/success/primitive.v000066400000000000000000000042201466560755400203600ustar00rootroot00000000000000(* This file mostly tests for the error paths in declaring primitives. Successes are tested in the various test-suite/primitive/* directories *) (* [Primitive] should be forbidden in sections, otherwise its type after cooking will be incorrect. *) Section S. Variable A : Type. Fail Primitive int : let x := A in Set := #int63_type. Fail Primitive int := #int63_type. (* we fail even if section variable not used *) End S. Section S. Fail Primitive int := #int63_type. (* we fail even if no section variables *) End S. (* can't declare primitives with nonsense types *) Fail Primitive xx : nat := #int63_type. (* non-cumulative conversion *) Fail Primitive xx : Type := #int63_type. (* check evars *) Fail Primitive xx : let x := _ in Set := #int63_type. (* explicit type is unified with expected type, not just converted extra universes are OK for monomorphic primitives (even though their usefulness is questionable, there's no difference compared with predeclaring them) *) Primitive xx : let x := Type in _ := #int63_type. (* double declaration *) Fail Primitive yy := #int63_type. Module DoubleCarry. (* XXX maybe should be an output test: this is the case where the new declaration is already in the nametab so can be nicely printed *) Module M. Variant carry (A : Type) := | C0 : A -> carry A | C1 : A -> carry A. Register carry as kernel.ind_carry. End M. Module N. Variant carry (A : Type) := | C0 : A -> carry A | C1 : A -> carry A. Fail Register carry as kernel.ind_carry. End N. End DoubleCarry. (* univ polymorphic primitives *) (* universe count must be as expected *) Fail Primitive array@{u v} : Type@{u} -> Type@{v} := #array_type. (* use a phantom universe to ensure we check conversion not just the universe count *) Fail Primitive array@{u} : Set -> Set := #array_type. (* no constraints allowed! *) Fail Primitive array@{u | Set < u} : Type@{u} -> Type@{u} := #array_type. (* unification works for polymorphic primitives too (although universe counts mean it's not enough) *) Fail Primitive array : let x := Type in _ -> Type := #array_type. Primitive array : _ -> Type := #array_type. coq-8.20.0/test-suite/success/primitive_strategy.v000066400000000000000000000010151466560755400223010ustar00rootroot00000000000000#[projections(primitive)] Record r := R { f : unit }. Definition rv := {| f := tt |}. Module Reduction. Ltac syn_eq := lazymatch goal with |- tt = tt => reflexivity end. Goal rv.(f) = tt. Proof. Succeed lazy; syn_eq. Fail with_strategy opaque [f] lazy; syn_eq. Succeed cbn; syn_eq. Fail with_strategy opaque [f] cbn; syn_eq. Succeed simpl; syn_eq. Fail with_strategy opaque [f] simpl; syn_eq. Succeed cbv; syn_eq. Fail with_strategy opaque [f] cbv; syn_eq. Abort. End Reduction. coq-8.20.0/test-suite/success/primitive_tc.v000066400000000000000000000047111466560755400210530ustar00rootroot00000000000000Create HintDb test discriminated. (* Testing that projections can be made hint opaque. *) Module ProjOpaque. #[projections(primitive)] Record bla := { x : unit }. Definition bli := {| x := tt |}. Class C (p : unit) := {}. Definition I : C (x bli) := Build_C _. #[local] Hint Resolve I : test. #[local] Hint Opaque x : test. Goal C tt. Proof. Fail typeclasses eauto with test. Abort. End ProjOpaque. (* Testing that compatibility constants are equated with their projections in the bnet. *) Module CompatConstants. Class T (p : Prop) : Prop := {}. Axiom prod : Prop -> Prop -> Prop. Axiom T_prod : forall p1 p2, T p1 -> T p2 -> T (prod p1 p2). Axiom T_True : T True. Class F (f : unit -> Prop) : Prop := { F_T :: forall u, T (f u) }. #[projections(primitive)] Record R (useless : unit) : Type := { v : unit -> Prop; v_F : F (v); }. Hint Opaque v : test. Hint Resolve v_F F_T T_prod T_True : test. (* Notation constant := (@v tt). *) Goal forall (a : R tt) q, T (prod (v _ a q) (True)). Proof. intros a. (* [v _ a] gets turned into its compatibility constant by the application of [T_prod]. The application of [v_F] after [F_T] only works if the bnet correctly equates the compatibility constant with the projection used in the type and pattern of [v_F] *) typeclasses eauto with test. Qed. End CompatConstants. (* Testing that projection opacity settings are properly discharged at the end of sections. *) Module Sections. #[local] Hint Constants Opaque : test. #[local] Hint Projections Opaque : test. Class C (u : unit) := {}. Definition i : C tt := Build_C _. #[global] Hint Resolve i : test. Section S. Context (P : Prop). (* Load bearing [Context] but content does not matter! *) #[projections(primitive)] Record r := R { v : unit; prf : P }. (* Load bearing use of the [Context] *) #[global] Hint Transparent v : test. Definition x (p: P) := {| v := tt; prf := p|}. #[global] Hint Transparent x : test. Print HintDb test. (* [v] is transparent *) Goal forall p, C (v (x p)). Proof. intros. typeclasses eauto with test. (* [i] is a candidate, [v] must be transparent *) Qed. End S. Print HintDb test. (* [v] is reportedly transparent *) Goal forall P (p : P), C (v P (x P p)). Proof. intros. typeclasses eauto with test. (* This will fail if [Hint Transparent v] is improperly discharged. *) Qed. End Sections. coq-8.20.0/test-suite/success/primitiveproj.v000066400000000000000000000146571466560755400212720ustar00rootroot00000000000000Set Primitive Projections. Set Nonrecursive Elimination Schemes. Module Prim. Record F := { a : nat; b : a = a }. Record G (A : Type) := { c : A; d : F }. Check c. End Prim. Module Univ. Set Universe Polymorphism. Set Implicit Arguments. Record Foo (A : Type) := { foo : A }. Record G (A : Type) := { c : A; d : c = c; e : Foo A }. Definition Foon : Foo nat := {| foo := 0 |}. Definition Foonp : nat := Foon.(foo). Definition Gt : G nat := {| c:= 0; d:=eq_refl; e:= Foon |}. Check (Gt.(e)). Section bla. Record bar := { baz : nat; def := 0; baz' : forall x, x = baz \/ x = def }. End bla. End Univ. Set Primitive Projections. Unset Elimination Schemes. Set Implicit Arguments. Check nat. Inductive X (U:Type) := { k : nat; a: k = k -> X U; b : let x := a eq_refl in X U }. Parameter x:X nat. Check (a x : forall _ : @eq nat (k x) (k x), X nat). Check (b x : X nat). Inductive Y := { next : option Y }. Check _.(next) : option Y. Lemma eta_ind (y : Y) : y = Build_Y y.(next). Proof. Fail reflexivity. Abort. Inductive Fdef := { Fa : nat ; Fb := Fa; Fc : Fdef }. Fail Scheme Fdef_rec := Induction for Fdef Sort Prop. (* Rules for parsing and printing of primitive projections and their eta expansions. If r : R A where R is a primitive record with implicit parameter A. If p : forall {A} (r : R A) {A : Set}, list (A * B). *) Record R {A : Type} := { p : forall {X : Set}, A * X }. Arguments R : clear implicits. Record R' {A : Type} := { p' : forall X : Set, A * X }. Arguments R' : clear implicits. Unset Printing All. Parameter r : R nat. Check (r.(p)). Set Printing Projections. Check (r.(p)). Unset Printing Projections. Set Printing All. Check (r.(p)). Unset Printing All. (* Check (r.(p)). Elaborates to a primitive application, X arg implicit. Of type nat * ?ex No Printing All: p r Set Printing Projections.: r.(p) Printing All: r.(@p) ?ex *) Check p r. Set Printing Projections. Check p r. Unset Printing Projections. Set Printing All. Check p r. Unset Printing All. Check p r (X:=nat). Set Printing Projections. Check p r (X:=nat). Unset Printing Projections. Set Printing All. Check p r (X:=nat). Unset Printing All. (* Same elaboration, printing for p r *) (** Explicit version of the primitive projection, under applied w.r.t implicit arguments can be printed only using projection notation. r.(@p) *) Check r.(@p _). Set Printing Projections. Check r.(@p _). Unset Printing Projections. Set Printing All. Check r.(@p _). Unset Printing All. (** Explicit version of the primitive projection, applied to its implicit arguments can be printed using application notation r.(p), r.(@p) in fully explicit form *) Check r.(@p _) nat. Set Printing Projections. Check r.(@p _) nat. Unset Printing Projections. Set Printing All. Check r.(@p _) nat. Unset Printing All. Parameter r' : R' nat. Check (r'.(p')). Set Printing Projections. Check (r'.(p')). Unset Printing Projections. Set Printing All. Check (r'.(p')). Unset Printing All. (* Check (r'.(p')). Elaborates to a primitive application, X arg explicit. Of type forall X : Set, nat * X No Printing All: p' r' Set Printing Projections.: r'.(p') Printing All: r'.(@p') *) Check p' r'. Set Printing Projections. Check p' r'. Unset Printing Projections. Set Printing All. Check p' r'. Unset Printing All. (* Same elaboration, printing for p r *) (** Explicit version of the primitive projection, under applied w.r.t implicit arguments can be printed only using projection notation. r.(@p) *) Check r'.(@p' _). Set Printing Projections. Check r'.(@p' _). Unset Printing Projections. Set Printing All. Check r'.(@p' _). Unset Printing All. (** Explicit version of the primitive projection, applied to its implicit arguments can be printed only using projection notation r.(p), r.(@p) in fully explicit form *) Check p' r' nat. Set Printing Projections. Check p' r' nat. Unset Printing Projections. Set Printing All. Check p' r' nat. Unset Printing All. Check (@p' nat). Check p'. Set Printing All. Check (@p' nat). Check p'. Unset Printing All. Record wrap (A : Type) := { unwrap : A; unwrap2 : A }. Definition term (x : wrap nat) := x.(unwrap). Definition term' (x : wrap nat) := let f := (@unwrap2 nat) in f x. Require Coq.extraction.Extraction. Recursive Extraction term term'. Extraction TestCompile term term'. (*Unset Printing Primitive Projection Parameters.*) (* Primitive projections in the presence of let-ins (was not failing in beta3)*) Set Primitive Projections. Record s (x:nat) (y:=S x) := {c:=x; d:x=c}. Lemma f : 0=1. Proof. Fail apply d. (* split. reflexivity. Qed. *) Abort. (* Primitive projection match compilation *) Set Primitive Projections. Record prod (A B : Type) := pair { fst : A ; snd : B }. Arguments pair {_ _} _ _. Definition snd' := @snd. (* a match which is just a projection doesn't produce a bunch of letins *) Goal True. assert (v : prod nat bool) by admit. let unfolded_snd := eval cbv beta delta [snd' snd] in (snd' v) in let matched_snd := constr:(let 'pair _ x := v in x) in constr_eq unfolded_snd matched_snd. Abort. Fixpoint split_at {A} (l : list A) (n : nat) : prod (list A) (list A) := match n with | 0 => pair nil l | S n => match l with | nil => pair nil nil | cons x l => let 'pair l1 l2 := split_at l n in pair (cons x l1) l2 end end. Section Repeat. Variable A : Type. Fixpoint repeat (x : A) (n: nat ) := match n with | O => nil | S k => cons x (repeat x k) end. End Repeat. Time Eval vm_compute in split_at (repeat 0 20) 10. (* Takes 0s *) Time Eval vm_compute in split_at (repeat 0 40) 20. (* Takes 0.001s *) Timeout 1 Time Eval vm_compute in split_at (repeat 0 60) 30. (* Used to take 60s, now takes 0.001s *) Check (@eq_refl _ 0 <: 0 = fst (pair 0 1)). Fail Check (@eq_refl _ 0 <: 0 = snd (pair 0 1)). Check (@eq_refl _ 0 <<: 0 = fst (pair 0 1)). Fail Check (@eq_refl _ 0 <<: 0 = snd (pair 0 1)). (* [unfold] tactic *) Module Unfold. Record rec (P: Prop) := REC { v: unit }. Set Printing All. Set Printing Unfolded Projection As Match. (* Testing that [unfold] can unfold compatibility constants. *) Goal forall r: rec True, @v True r = tt. Proof. intros. lazymatch goal with | |- context C [@v _ ?r] => (* Carefully construct a term that definitely contains the compatibility constant. *) let t := constr:(@v True) in let g := context C [t r] in change g end. progress unfold v. Abort. End Unfold. coq-8.20.0/test-suite/success/primproj_evarconv.v000066400000000000000000000013461466560755400221230ustar00rootroot00000000000000Module S. #[local] Set Printing Unfolded Projection As Match. #[projections(primitive=yes)] Record r (u : unit) := { r_car : Type }. Axiom u : unit. Definition rO : r u -> r u := fun o => {| r_car := option (r_car u o) |}. Goal forall o, exists M, M (r_car u o)= r_car u (rO o). Proof. intros. eexists _. Timeout 1 refine (eq_refl _). Qed. End S. Module T. #[local] Set Printing Unfolded Projection As Match. #[projections(primitive=yes)] Record r (u : unit) := { r_car : Type }. Axiom u : unit. Axiom v : forall i : nat, r u. Goal forall i, exists P, P (v i) = r_car u (v i). Proof. intros. eexists _. (* Unable to unify "r (v i)" with "?P (v i)". *) refine (eq_refl _). Qed. End T. coq-8.20.0/test-suite/success/primproj_ssreflect.v000066400000000000000000000025441466560755400222730ustar00rootroot00000000000000From Coq Require Import ssreflect. Module R. #[local] Set Printing Unfolded Projections As Match. Record seal {A : Type} (f : A) : Type := Build_seal { unseal : A; seal_eq : @eq A unseal f }. Global Arguments unseal {_ _} _ : assert. Global Arguments seal_eq {_ _} _ : assert. #[projections(primitive=yes)] Structure bi := Bi { bi_car :> Type; bi_forall : forall A : Type, (A -> bi_car) -> bi_car; }. Bind Scope bi_scope with bi_car. Global Arguments bi_car : simpl never. Global Arguments bi_forall {PROP _} _ : simpl never, rename. Record heapProp := HeapProp { heapProp_holds :> Prop }. Global Arguments heapProp_holds : simpl never. Definition heapProp_forall_def {A} (Ψ : A -> heapProp) : heapProp := {| heapProp_holds := forall a, Ψ a |}. Definition heapProp_forall_aux : seal (@heapProp_forall_def). Proof. by eexists. Qed. Definition heapProp_forall {A} := unseal heapProp_forall_aux A. Definition heapProp_forall_unseal : @heapProp_forall = @heapProp_forall_def := seal_eq heapProp_forall_aux. Definition heapPropI : bi := {| bi_car := heapProp; bi_forall := @heapProp_forall |}. Axiom P : heapPropI. Goal forall (A : Type) (φ : A -> Prop), (bi_forall (fun a : A => P)). Proof. intros A φ. Succeed (progress unfold bi_forall); (progress simpl). progress rewrite /bi_forall. Abort. End R. coq-8.20.0/test-suite/success/primproj_tactic_unif.v000066400000000000000000000057471466560755400226010ustar00rootroot00000000000000Module S. #[local] Set Printing Unfolded Projection As Match. #[projections(primitive=yes)] Record state (u : unit) := { p : nat -> nat }. Parameter (u : unit). Parameter (s1 s2 : state u). (* Unifying the compatibility constant with the primitive projection *) Goal exists n, ltac:(exact (p u)) s1 n = p _ s1 1. Proof. eexists _. (* Testing both orientations of the unification problem *) lazymatch goal with |- ?a = ?b => unify a b end. lazymatch goal with |- ?a = ?b => unify b a end. Succeed apply eq_refl. symmetry. apply eq_refl. Qed. (* Unifying primitive projections with [?h ?a1 .. ?aN] when [N] is bigger than the number of parameters plus 1. This must fail. *) Axiom H : forall (B : Type) (f : forall (_ : nat) (_ : nat) (_ : nat), B) (x1 y1 x2 y2 x3 y3 : nat), @eq B (f x1 x2 x3) (f y1 y2 y3). Goal p _ s1 = p _ s2. Proof. (* [apply H] never succeeds. The test below only makes sure that it does not loop endlessly or overflow the stack. *) Timeout 1 (first [apply H | idtac]). Abort. (* Unifying primitive projections with [?h ?a1 .. ?aN] when [N] is exactly the number of parameters plus 1. This must succeed. *) Goal exists (a : forall u, state u -> nat -> nat) (b : unit) c, a b c = p u s1. Proof. eexists _, _, _. (* Testing both orientations of the unification problem *) Succeed apply eq_refl. symmetry. apply eq_refl. Qed. (* Unifying primitive projections with [?h ?a1 .. ?aN] when [N] is exactly the number of parameters plus 1 plus the number of proper arguments to the projection. This must succeed. *) Goal exists (a : forall u, state u -> nat -> nat) (b : unit) c d, a b c d = p u s1 0. Proof. eexists _, _, _, _. (* Testing both orientations of the unification problem *) Succeed apply eq_refl. symmetry. apply eq_refl. Qed. (* Unifying primitive projections with [?h ?a1 .. ?aN] when [N] is less than the number of parameters plus 1 plus the number of proper arguments to the projection. The head evar [?h] is unified with a partial application of the projection. This must succeed. *) Goal exists (a : state u -> nat -> nat) (b : state u), a b = p u s1. Proof. eexists _, _. (* Testing both orientations of the unification problem *) Succeed apply eq_refl. symmetry. apply eq_refl. Qed. End S. Module I. #[local] Set Printing Unfolded Projection As Match. Record cmra := Cmra { cmra_car : Type }. Record ucmra := { ucmra_car : Type }. #[projections(primitive=yes)] Record ofe (n : nat) := Ofe { ofe_car : Type }. Axiom n : nat. Definition ucmra_ofeO := fun A : ucmra => @Ofe n (ucmra_car A). (* Canonical Structure cmra_ofeO := fun A : cmra => @Ofe n (cmra_car A). *) Canonical Structure ucmra_cmraR := fun A : ucmra => Cmra (ucmra_car A). Axiom A : ucmra. Axiom bla : forall (A : cmra), cmra_car A. Goal ofe_car n (ucmra_ofeO A). Proof. apply @bla. Qed. End I. coq-8.20.0/test-suite/success/private_univs.v000066400000000000000000000023161466560755400212520ustar00rootroot00000000000000Set Universe Polymorphism. Set Printing Universes. Definition internal_defined@{i j | i < j +} (A : Type@{i}) : Type@{j}. pose(foo:=Type). (* 1 universe for the let body + 1 for the type *) exact A. Fail Defined. Abort. Definition internal_defined@{i j +} (A : Type@{i}) : Type@{j}. pose(foo:=Type). exact A. Defined. Check internal_defined@{_ _ _ _}. Module M. Lemma internal_qed@{i j|i<=j} (A:Type@{i}) : Type@{j}. Proof. pose (foo := Type). exact A. Qed. Check internal_qed@{_ _}. End M. Include M. (* be careful to remove const_private_univs in Include! will be coqchk'd *) Unset Strict Universe Declaration. Lemma private_transitivity@{i j} (A:Type@{i}) : Type@{j}. Proof. pose (bar := Type : Type@{j}). pose (foo := Type@{i} : bar). exact bar. Qed. Definition private_transitivity'@{i j|i < j} := private_transitivity@{i j}. Fail Definition dummy@{i j|j <= i +} := private_transitivity@{i j}. Unset Private Polymorphic Universes. Lemma internal_noprivate_qed@{i j|i<=j} (A:Type@{i}) : Type@{j}. Proof. pose (foo := Type). exact A. Fail Qed. Abort. Lemma internal_noprivate_qed@{i j +} (A:Type@{i}) : Type@{j}. Proof. pose (foo := Type). exact A. Qed. Check internal_noprivate_qed@{_ _ _ _}. coq-8.20.0/test-suite/success/programequality.v000066400000000000000000000004131466560755400215750ustar00rootroot00000000000000Require Import Program. Axiom t : nat -> Set. Goal forall (x y : nat) (e : x = y) (e' : x = y) (P : t y -> x = y -> Type) (a : t x), P (eq_rect _ _ a _ e) e'. Proof. intros. pi_eq_proofs. clear e. destruct e'. simpl. change (P a eq_refl). Abort. coq-8.20.0/test-suite/success/proof_using.v000066400000000000000000000074361466560755400207160ustar00rootroot00000000000000Require Import TestSuite.admit. Section Foo. Variable a : nat. Lemma l1 : True. Fail Proof using non_existing. Proof using a. exact I. Qed. Lemma l2 : True. Proof using a. Admitted. Lemma l3 : True. Proof using a. admit. Qed. End Foo. Check (l1 3). Check (l2 3). Check (l3 3). Section Bar. Variable T : Type. Variable a b : T. Variable H : a = b. Lemma l4 : a = b. Proof using H. exact H. Qed. End Bar. Check (l4 _ 1 1 _ : 1 = 1). Section S1. Variable v1 : nat. Section S2. Variable v2 : nat. Lemma deep : v1 = v2. Proof using v1 v2. admit. Qed. Lemma deep2 : v1 = v2. Proof using v1 v2. Admitted. End S2. Check (deep 3 : v1 = 3). Check (deep2 3 : v1 = 3). End S1. Check (deep 3 4 : 3 = 4). Check (deep2 3 4 : 3 = 4). Section P1. Variable x : nat. Variable y : nat. Variable z : nat. Collection TOTO := x y. Collection TITI := TOTO - x. Lemma t1 : True. Proof using TOTO. trivial. Qed. Lemma t2 : True. Proof using TITI. trivial. Qed. Section P2. Collection TOTO := x. Lemma t3 : True. Proof using TOTO. trivial. Qed. End P2. Lemma t4 : True. Proof using TOTO. trivial. Qed. End P1. Lemma t5 : True. Fail Proof using TOTO. trivial. Qed. Check (t1 1 2 : True). Check (t2 1 : True). Check (t3 1 : True). Check (t4 1 2 : True). Section T1. Variable x : nat. Hypothesis px : 1 = x. Let w := x + 1. Set Suggest Proof Using. Set Default Proof Using "Type". Lemma bla : 2 = w. Proof. admit. Qed. End T1. Check (bla 7 : 2 = 8). Section A. Variable a : nat. Variable b : nat. Variable c : nat. Variable H1 : a = 3. Variable H2 : a = 3 -> b = 7. Variable H3 : c = 3. Lemma foo : a = a. Proof using Type*. pose H1 as e1. pose H2 as e2. reflexivity. Qed. Lemma bar : a = 3 -> b = 7. Proof using b*. exact H2. Qed. Lemma baz : c=3. Proof using c*. exact H3. Qed. Lemma baz2 : c=3. Proof using c* a. exact H3. Qed. End A. Check (foo 3 7 (refl_equal 3) (fun _ => refl_equal 7)). Check (bar 3 7 (refl_equal 3) (fun _ => refl_equal 7)). Check (baz2 99 3 (refl_equal 3)). Check (baz 3 (refl_equal 3)). Section Let. Variables a b : nat. Let pa : a = a. Proof. reflexivity. Qed. Unset Default Proof Using. Set Suggest Proof Using. Lemma test_let : a = a. Proof using a. exact pa. Qed. Let ppa : pa = pa. Proof. reflexivity. Qed. Lemma test_let2 : pa = pa. Proof using Type. exact ppa. Qed. End Let. Check (test_let 3). (* Disabled Section Clear. Variable a: nat. Hypotheses H : a = 4. Set Proof Using Clear Unused. Lemma test_clear : a = a. Proof using a. Fail rewrite H. trivial. Qed. End Clear. *) Module InteractiveUsing. Section S. Variable m : nat. Variable e : m = m. #[using="e"] Definition a := 0. #[using="e"] Definition a' : nat. exact 0. Defined. #[using="e"] Fixpoint f (n:nat) : nat := match n with 0 => 0 | S n => f n end. #[using="e"] Fixpoint f' (n:nat) : nat. exact (match n with 0 => 0 | S n => f n end). Defined. #[using="Type"] Fixpoint f1 (n:nat) : nat := match n with 0 => 0 | S n => match f2 n with eq_refl => n end end with f2 (n:nat) : m = m := match n with 0 => eq_refl | S n => match f1 n with 0 => eq_refl | S _ => eq_refl end end. #[using="Type"] Fixpoint f1' (n:nat) : nat with f2' (n:nat) : m = m. exact (match n with 0 => 0 | S n => match f2' n with eq_refl => n end end). exact (match n with 0 => eq_refl | S n => match f1' n with 0 => eq_refl | S _ => eq_refl end end). Defined. CoInductive Stream : Set := Cons : Stream -> Stream. #[using="e"] CoFixpoint g : Stream := Cons g. #[using="e"] CoFixpoint g' : Stream. exact (Cons g). Defined. End S. Check eq_refl : a 0 (eq_refl 0) = 0. Check eq_refl : a' 0 (eq_refl 0) = 0. Check eq_refl : f 10 (eq_refl 10) 2 = 0. Check eq_refl : f' 10 (eq_refl 10) 2 = 0. Check eq_refl : f1 10 2 = 1. Check eq_refl : f1' 10 2 = 1. Check g 0 eq_refl : Stream. Check g' 0 eq_refl : Stream. End InteractiveUsing. coq-8.20.0/test-suite/success/proof_using_noinit.v000066400000000000000000000002101466560755400222550ustar00rootroot00000000000000(* -*- coq-prog-args: ("-noinit"); -*- *) Section A. Variable A : Prop. Hypothesis a : A. Lemma b : A. Proof using a. Admitted. End A. coq-8.20.0/test-suite/success/rapply.v000066400000000000000000000015741466560755400176700ustar00rootroot00000000000000Require Import Coq.Program.Tactics. (** We make a version of [rapply] that takes [uconstr]; we do not currently test what scope [rapply] interprets terms in. *) Tactic Notation "urapply" uconstr(p) := rapply p. Ltac test n := (*let __ := match goal with _ => idtac n end in*) lazymatch n with | O => let __ := match goal with _ => assert True by urapply I; clear end in uconstr:(fun _ => I) | S ?n' => let lem := test n' in let __ := match goal with _ => assert True by (unshelve urapply lem; try exact I); clear end in uconstr:(fun _ : True => lem) end. Goal True. assert True by urapply I. assert True by (unshelve urapply (fun _ => I); try exact I). assert True by (unshelve urapply (fun _ _ => I); try exact I). assert True by (unshelve urapply (fun _ _ _ => I); try exact I). clear. Time let __ := test 50 in idtac. urapply I. Qed. coq-8.20.0/test-suite/success/record_syntax.v000066400000000000000000000016301466560755400212360ustar00rootroot00000000000000Module A. Record Foo := { foo : unit; bar : unit }. Definition foo_ := {| foo := tt; bar := tt |}. Definition foo0 (p : Foo) := match p with {| |} => tt end. Definition foo1 (p : Foo) := match p with {| foo := f |} => f end. Definition foo2 (p : Foo) := match p with {| foo := f; |} => f end. Definition foo3 (p : Foo) := match p with {| foo := f; bar := g |} => (f, g) end. Definition foo4 (p : Foo) := match p with {| foo := f; bar := g; |} => (f, g) end. End A. Module B. Record Foo := { }. End B. Module C. Record Foo := { foo : unit; bar : unit; }. Definition foo_ := {| foo := tt; bar := tt; |}. End C. Module D. Record Foo := { foo : unit }. Definition foo_ := {| foo := tt |}. End D. Module E. Record Foo := { foo : unit; }. Definition foo_ := {| foo := tt; |}. End E. Module F. Record Foo := { foo : nat * nat -> nat -> nat }. Definition foo_ := {| foo '(x,y) n := x+y+n |}. End F. coq-8.20.0/test-suite/success/refine.v000066400000000000000000000056601466560755400176310ustar00rootroot00000000000000 (* Refine and let-in's *) Goal exists x : nat, x = 0. refine (let y := 0 + 0 in _). exists y; auto. Save test1. Goal exists x : nat, x = 0. refine (let y := 0 + 0 in ex_intro _ (y + y) _). auto. Save test2. Goal nat. refine (let y := 0 in 0 + _). exact 1. Save test3. (* Example submitted by Yves on coqdev *) Require Import List. Goal forall l : list nat, l = l. Proof. refine (fun l => match l return (l = l) with | nil => _ | O :: l0 => _ | S _ :: l0 => _ end). Abort. (* Submitted by Roland Zumkeller (BZ#888) *) (* The Fix and CoFix rules expect a subgoal even for closed components of the (co-)fixpoint *) Goal nat -> nat. refine (fix f (n : nat) : nat := S _ with pred (n : nat) : nat := n for f). exact 0. Qed. (* Submitted by Roland Zumkeller (BZ#889) *) (* The types of metas were in metamap and they were not updated when passing through a binder *) Goal forall n : nat, nat -> n = 0. refine (fun n => fix f (i : nat) : n = 0 := match i with | O => _ | S _ => _ end). Abort. (* Submitted by Roland Zumkeller (BZ#931) *) (* Don't turn dependent evar into metas *) Goal (forall n : nat, n = 0 -> Prop) -> Prop. intro P. refine (P _ _). reflexivity. Abort. (* Submitted by Jacek Chrzaszcz (BZ#1102) *) (* le problème a été résolu ici par normalisation des evars présentes dans les types d'evars, mais le problème reste a priori ouvert dans le cas plus général d'evars non instanciées dans les types d'autres evars *) Goal exists n:nat, n=n. refine (ex_intro _ _ _). Abort. (* Used to failed with error not clean *) Definition div : forall x:nat, (forall y:nat, forall n:nat, {q:nat | y = q*n}) -> forall n:nat, {q:nat | x = q*n}. refine (fun m div_rec n => match div_rec m n with | exist _ _ _ => _ end). Abort. (* Use to fail because sigma was not propagated to get_type_of *) (* Revealed by r9310, fixed in r9359 *) Goal forall f : forall a (H:a=a), Prop, (forall a (H:a = a :> nat), f a H -> True /\ True) -> True. intros. refine (@proj1 _ _ (H 0 _ _)). Abort. (* Use to fail because let-in with metas in the body where rejected because a priori considered as dependent *) Require Import Peano_dec. Definition fact_F : forall (n:nat), (forall m, m nat) -> nat. refine (fun n fact_rec => if eq_nat_dec n 0 then 1 else let fn := fact_rec (n-1) _ in n * fn). Abort. (* Wish 1988: that fun forces unfold in refine *) Goal (forall A : Prop, A -> ~~A). Proof. refine(fun A a f => _). Abort. (* Checking beta-iota normalization of hypotheses in created evars *) Goal {x|x=0} -> True. refine (fun y => let (x,a) := y in _). match goal with a:_=0 |- _ => idtac end. Abort. Goal (forall P, {P 0}+{P 1}) -> True. refine (fun H => if H (fun x => x=x) then _ else _). match goal with _:0=0 |- _ => idtac end. Abort. coq-8.20.0/test-suite/success/remember.v000066400000000000000000000011621466560755400201500ustar00rootroot00000000000000(* Testing remember and co *) Lemma A : forall (P: forall X, X -> Prop), P nat 0 -> P nat 0. intros. Fail remember nat as X. Fail remember nat as X in H. (* This line used to succeed in 8.3 *) Fail remember nat as X. Abort. (* Testing Ltac interpretation of remember (was not working up to r16181) *) Goal (1 + 2 + 3 = 6). let name := fresh "fresh" in remember (1 + 2) as x eqn:name. rewrite fresh. Abort. (* An example which was working in 8.4 but failing in 8.5 and 8.5pl1 *) Module A. Axiom N : nat. End A. Module B. Include A. End B. Goal id A.N = B.N. reflexivity. Qed. coq-8.20.0/test-suite/success/replace.v000066400000000000000000000011731466560755400177670ustar00rootroot00000000000000Goal forall x, x = 0 -> S x = 7 -> x = 22 . Proof. replace 0 with 33. Undo. intros x H H0. replace x with 0. Undo. replace x with 0 in |- *. Undo. replace x with 1 in *. Undo. replace x with 0 in *|- *. Undo. replace x with 0 in *|-. Undo. replace x with 0 in H0 . Undo. replace x with 0 in H0 |- * . Undo. replace x with 0 in H,H0 |- * . Undo. Admitted. (* This failed at some point when "replace" started to support arguments with evars but "abstract" did not supported any evars even defined ones *) Class U. Lemma l (u : U) (f : U -> nat) (H : 0 = f u) : f u = 0. replace (f _) with 0 by abstract apply H. reflexivity. Qed. coq-8.20.0/test-suite/success/resolve_tc.v000066400000000000000000000007561466560755400205270ustar00rootroot00000000000000Class C := c {}. Local Existing Instance c. Require Ltac2.Ltac2. Ltac resolve_tc := ltac2:(x |- Std.resolve_tc (Option.get (Ltac1.to_constr x))). (* check that exact doesn't do the resolution *) Lemma bad : C. Proof. let x := open_constr:(_:C) in exact x. Fail Qed. Unshelve. exact _. Qed. Lemma foo : C. Proof. let x := open_constr:(_:C) in resolve_tc x; exact x. Qed. (* resolve_tc doesn't focus *) Lemma bar : C. Proof. let x := open_constr:(_:C) in exact x; resolve_tc x. Qed. coq-8.20.0/test-suite/success/reverse_coercions.v000066400000000000000000000067401466560755400221000ustar00rootroot00000000000000Module Test0. (* By default all coercions from a Structure/Record are also reversible, unless: Structure foo := { .. #[reversible=no] bla :> blu } is given *) (* Declaring/undeclaring a reverse coercion after the facts: #[reversible] Coercion sort. #[reversible=yes] Coercion sort. #[reversible=no] Coercion sort. *) Structure S := { ssort :> Type; sstuff : ssort; }. Definition test1 (s : S) (x : s) := sstuff s. Definition test2 (s : S) := sstuff s. Canonical Structure S_nat := {| ssort := nat; sstuff := 0; |}. Set Printing All. Check test1 _ (0 : nat). (* old hack *) Definition test' {s : S} (t : Type) (f : ssort s -> t) := sstuff s. Notation test t := (test' t (fun x => x)). Check test nat. (* new *) Check test2 (nat : Type). Definition nat' (x:unit) := nat. Arguments nat' &. (* checks that reapply_coercions gets the right trace *) Check test2 (nat' tt). Check (nat : S). Structure R := { rsort :> Type; rstuff : rsort; srstuff : rsort; }. Coercion RtoS (r : R) := {| ssort := rsort r ; sstuff := srstuff r|}. Canonical RtoS. Canonical Structure R_nat := {| rsort := nat; rstuff := 1; srstuff := 0 |}. Definition test3 (r : R) := rstuff r. Set Printing All. Check test3 nat. Check test3 S_nat. Structure T := { tsort :> Type; }. Canonical T_nat (x : unit) := {| tsort := nat |}. Check test2 (T_nat tt). Structure A := { }. Structure A' := { }. Structure B := { ba :> A; #[canonical=no] ba' :> A' }. Structure C := { ca :> A; #[canonical=no] ca' :> A' }. Axiom f : A -> A'. Coercion f : A >-> A'. Canonical b : B := {| ba := Build_A; ba' := Build_A' |}. Canonical c : C := {| ca := Build_A; ca' := Build_A' |}. Definition test4 (x : B) := 1. Check test4 c. (* ~~> test S_nat : S_nat.sort Type ==?== S : f : nat ---> S_nat sort : S >-> Type f := nat ----> ?x sort ?x ==?== nat *) End Test0. (* Test the reverse attribute *) Module Test1. Structure S := { ssort : Type; sstuff : ssort; }. #[reversible=no] Coercion ssort : S >-> Sortclass. Definition test2 (s : S) := sstuff s. Canonical Structure S_nat := {| ssort := nat; sstuff := 0; |}. Fail Check test2 (nat : Type). End Test1. (* Test the reverse attribute *) Module Test1'. Structure S := { ssort : Type; sstuff : ssort; }. Coercion ssort : S >-> Sortclass. Definition test2 (s : S) := sstuff s. Canonical Structure S_nat := {| ssort := nat; sstuff := 0; |}. Fail Check test2 (nat : Type). End Test1'. (* Test the reverse attribute *) Module Test2. Structure S := { #[reversible=no] ssort :> Type; sstuff : ssort; }. Definition test2 (s : S) := sstuff s. Canonical Structure S_nat := {| ssort := nat; sstuff := 0; |}. Fail Check test2 (nat : Type). End Test2. (* Test the reverse attribute *) Module Test3. Structure S := { #[reversible=no] ssort :> Type; sstuff : ssort; }. Definition test2 (s : S) := sstuff s. Canonical Structure S_nat := {| ssort := nat; sstuff := 0; |}. #[reversible] Coercion ssort. Check test2 (nat : Type). End Test3. (* Test the reverse attribute *) Module Test4. Structure S := { ssort :> Type; sstuff : ssort; }. Definition test2 (s : S) := sstuff s. Canonical Structure S_nat := {| ssort := nat; sstuff := 0; |}. #[reversible=no] Coercion ssort. Fail Check test2 (nat : Type). End Test4. coq-8.20.0/test-suite/success/reverse_coercions_ac.v000066400000000000000000000026031466560755400225350ustar00rootroot00000000000000Set Implicit Arguments. Class Inhab (A:Type) : Prop := { inhab: exists (x:A), True }. Record IType : Type := IType_make { IType_type :> Type; IType_inhab : Inhab IType_type }. Canonical default_IType t ct : IType := @IType_make t ct. Arguments IType_make IType_type {IType_inhab}. Global Instance Inhab_IType : forall (A:IType), Inhab A. Proof using. constructor. apply IType_inhab. Defined. Parameter P : Type -> Prop. (** A [IType] can be provided where an type [A] with a proof of [Inhab A] is expected. *) Parameter K : forall (A:Type) (IA:Inhab A), P A. Lemma testK : forall (A:IType), P A. Proof using. intros. eapply K. eauto with typeclass_instances. Qed. (** A type [A] can be provided where a [IType] is expected, by wrapping it with [IType_make]. *) Parameter T : forall (A:IType), P A. Lemma testT : forall (A:Type) (IA:Inhab A), P A. Proof using. intros. eapply (T A). Qed. (* Above, it would be nice to write [eapply (T A)], or just [eapply T]. For that, we'd need to coerce [A:Type] to the type [IType] by applying on-the-fly the operation [IType_make A _]. Thus, we need something like: [Coercion (fun (A:Type) => IType_make A _) : Sortclass >-> IType.] Would that be possible? I understand that [IType_type] is already a reverse coercion from [IType] to [Type], but I don't see why it would necessarily cause trouble to have cycles in the coercion graphs. *) coq-8.20.0/test-suite/success/reverse_coercions_typeclasses_and_canonical.v000066400000000000000000000016521466560755400273450ustar00rootroot00000000000000Set Primitive Projections. Class IsPointed (A : Type) := point : A. Record pType : Type := { pointed_type : Type ; ispointed_pointed_type : IsPointed pointed_type ; }. #[reversible] Coercion pointed_type : pType >-> Sortclass. Fail Canonical Build_pType. Canonical Structure Build_pType' (A : Type) (a : IsPointed A) := Build_pType A a. Axiom A : Type. #[export] Instance a : IsPointed A. Proof. Admitted. Axiom lemma_about_ptype : forall (X : pType), Type. Type (A : pType). Type (lemma_about_ptype A). (* Ok, so here is what happens: * you give `A : Type` where `?x : pType` is expected * no coercion `Sortclass >-> pType` but (according to `Print Graph`) we have `[pointed_type] : pType ↣ Sortclass (reversible)` * so reversible coercions look for `?x : pType` such that `pointed_type ?x = A` * and canonical structure mechanism infers `?x = Build_pType' A _` * finally, typeclass resolution fills the last `_` with `a` *) coq-8.20.0/test-suite/success/rewrite.v000066400000000000000000000103361466560755400200360ustar00rootroot00000000000000(* Check that dependent rewrite applies on arbitrary terms *) Inductive listn : nat -> Set := | niln : listn 0 | consn : forall n : nat, nat -> listn n -> listn (S n). Axiom ax : forall (n n' : nat) (l : listn (n + n')) (l' : listn (n' + n)), existT _ (n + n') l = existT _ (n' + n) l'. Lemma lem : forall (n n' : nat) (l : listn (n + n')) (l' : listn (n' + n)), n + n' = n' + n /\ existT _ (n + n') l = existT _ (n' + n) l'. Proof. intros n n' l l'. dependent rewrite (ax n n' l l'). split; reflexivity. Qed. (* Used to raise an anomaly instead of an error in 8.1 *) (* Submitted by Y. Makarov *) Parameter N : Set. Parameter E : N -> N -> Prop. Axiom e : forall (A : Set) (EA : A -> A -> Prop) (a : A), EA a a. Theorem th : forall x : N, E x x. intro x. try rewrite e. Abort. (* Behavior of rewrite wrt conversion *) Require Import Arith. Goal forall n, 0 + n = n -> True. intros n H. rewrite Nat.add_0_l in H. Abort. (* Rewrite dependent proofs from left-to-right *) Lemma l1 : forall x y (H:x = y:>nat) (P:forall x y, x=y -> Type), P x y H -> P x y H. intros x y H P H0. rewrite H. rewrite H in H0. assumption. Qed. (* Rewrite dependent proofs from right-to-left *) Lemma l2 : forall x y (H:x = y:>nat) (P:forall x y, x=y -> Type), P x y H -> P x y H. intros x y H P H0. rewrite <- H. rewrite <- H in H0. assumption. Qed. (* Check rewriting dependent proofs with non-symmetric equalities *) Lemma l3:forall x (H:eq_true x) (P:forall x, eq_true x -> Type), P x H -> P x H. intros x H P H0. rewrite H. rewrite H in H0. assumption. Qed. (* Dependent rewrite *) Require Import JMeq. Goal forall A B (a:A) (b:B), JMeq a b -> JMeq b a -> True. inversion 1; (* Goal is now [JMeq a a -> True] *) dependent rewrite H3. Undo. intros; inversion H; dependent rewrite H4 in H0. Undo. intros; inversion H; dependent rewrite <- H4 in H0. Abort. (* Test conversion between terms with evars that both occur in K-redexes and are elsewhere solvable. This is quite an artificial example, but it used to work in 8.2. Since rewrite supports conversion on terms without metas, it was successively unifying (id 0 ?y) and 0 where ?y was not a meta but, because coming from a "_", an evar. After commit r12440 which unified the treatment of metas and evars, it stopped to work. Chung-Kil Hur's Heq package used this feature. Solved in r13... *) Parameter g : nat -> nat -> nat. Definition K (x y:nat) := x. Goal (forall y, g y (K 0 y) = 0) -> g 0 0 = 0. intros. rewrite (H _). reflexivity. Qed. Goal (forall y, g (K 0 y) y = 0) -> g 0 0 = 0. intros. rewrite (H _). reflexivity. Qed. (* Example of rewriting of a degenerated pattern using the right-most argument of the goal. This is sometimes used in contribs, even if ad hoc. Here, we have the extra requirement that checking types needs delta-conversion *) Axiom s : forall (A B : Type) (p : A * B), p = (fst p, snd p). Definition P := (nat * nat)%type. Goal forall x:P, x = x. intros. rewrite s. Abort. (* Test second-order unification and failure of pattern-unification *) Goal forall (P: forall Y, Y -> Prop) Y a, Y = nat -> (True -> P Y a) -> False. intros. (* The next line used to succeed between June and November 2011 *) (* causing ill-typed rewriting *) Fail rewrite H in H0. Abort. (* Test subst in the presence of a dependent let-in *) (* Was not working prior to May 2014 *) Goal forall x y, x=y+0 -> let z := x+1 in x+1=y -> z=z -> z=x. intros. subst x. (* was failing *) subst z. rewrite H0. auto with arith. Qed. (* Check that evars are instantiated when the term to rewrite is closed, like in the case it is open *) Goal exists x, S 0 = 0 -> S x = 0. eexists. intro H. rewrite H. reflexivity. Abort. (* Check that rewriting within evars still work (was broken in 8.5beta1) *) Goal forall (a: unit) (H: a = tt), exists x y:nat, x = y. intros; eexists; eexists. rewrite H. Undo. subst. Abort. (* Check that iterated rewriting does not rewrite in the side conditions *) (* Example from Sigurd Schneider, extracted from contrib containers *) Lemma EQ : forall (e e' : nat), True -> e = e'. Admitted. Lemma test (v1 v2 v3: nat) (v' : v1 = v2) : v2 = v1. Proof. rewrite <- (EQ v1 v2) in *. exact v'. (* There should be only two side conditions *) exact I. exact I. Qed. coq-8.20.0/test-suite/success/rewrite_closed.v000066400000000000000000000023301466560755400213620ustar00rootroot00000000000000From Coq Require Import Setoid Morphisms. Axiom lattice_for : Type -> Type. Axiom constant : forall {T : Type}, T -> lattice_for T. Axiom lattice_for_rect : forall [T : Type] (P : Type), (forall t : T, P) -> forall l : lattice_for T, P. #[local] Declare Instance lattice_for_rect_Proper_85 : forall {A}, Proper (forall_relation (fun _ => eq) ==> eq ==> Basics.flip Basics.impl) (@lattice_for_rect A Prop) | 3. Axiom lattice_rewrite : forall (A T T' : Type) (x : T -> T') (c : A -> lattice_for T) (v : lattice_for A), lattice_for_rect T' x (lattice_for_rect (lattice_for T) c v) = lattice_for_rect T' (fun x0 : A => lattice_for_rect T' x (c x0)) v. Axiom collapse_might_be_empty : bool. Axiom PosSet : Type. Axiom PosSet_inter : PosSet -> PosSet -> PosSet. Goal forall (l2 : lattice_for PosSet) (l0 : lattice_for PosSet), lattice_for_rect Prop (fun x : PosSet => lattice_for_rect Prop (fun _ : PosSet => True) (lattice_for_rect (lattice_for PosSet) (fun y' : PosSet => constant (if collapse_might_be_empty then PosSet_inter x y' else y')) l0)) l2 . Proof. intros. (* This should not capture a variable *) Fail rewrite lattice_rewrite. Abort. coq-8.20.0/test-suite/success/rewrite_dep.v000066400000000000000000000016671466560755400206750ustar00rootroot00000000000000Require Import TestSuite.admit. Require Import Setoid. Require Import Morphisms. Require Vector. Notation vector := Vector.t. Notation Vcons n t := (@Vector.cons _ n _ t). Class Equiv A := equiv : A -> A -> Prop. Class Setoid A `{Equiv A} := setoid_equiv :: Equivalence (equiv). #[export] Instance vecequiv A `{Equiv A} n : Equiv (vector A n). admit. Qed. Global Instance vcons_proper A `{Equiv A} `{!Setoid A} : Proper (equiv ==> forall_relation (fun k => equiv ==> equiv)) (@Vector.cons A). Proof. Admitted. #[export] Instance vecseotid A `{Setoid A} n : Setoid (vector A n). Proof. Admitted. (* Instance equiv_setoid A {e : Equiv A} {s : @Setoid A e} : Equivalence e. *) (* apply setoid_equiv. *) (* Qed. *) (* Typeclasses Transparent Equiv. *) Goal forall A `{Equiv A} `{!Setoid A} (f : A -> A) (a b : A) (H : equiv a b) n (v : vector A n), equiv (Vcons a v) (Vcons b v). Proof. intros. rewrite H0. reflexivity. Qed. coq-8.20.0/test-suite/success/rewrite_evar.v000066400000000000000000000005771466560755400210610ustar00rootroot00000000000000Require Import Coq.Setoids.Setoid. Goal forall (T2 MT1 MT2 : Type) (x : T2) (M2 m2 : MT2) (M1 m1 : MT1) (F : T2 -> MT1 -> MT2 -> Prop), (forall (defaultB : T2) (m3 : MT1) (m4 : MT2), F defaultB m3 m4 <-> True) -> F x M1 M2 -> F x m1 m2. intros ????????? H' H. rewrite (H' _) in *. (** The above rewrite should also rewrite in H. *) Fail progress rewrite H' in H. Abort. coq-8.20.0/test-suite/success/rewrite_in.v000066400000000000000000000004341466560755400205220ustar00rootroot00000000000000Require Import Setoid. Goal forall (P Q : Prop) (f:P->Prop) (p:P), (P<->Q) -> f p -> True. intros P Q f p H. rewrite H in p || trivial. Qed. Goal 1 = 0 -> 0 = 1. intro H. Fail rewrite H at 1 2 3. (* bug #13566 *) Fail rewrite H at 0. rewrite H at 1. reflexivity. Qed. coq-8.20.0/test-suite/success/rewrite_iterated.v000066400000000000000000000010351466560755400217130ustar00rootroot00000000000000Require Import Arith Lia. Lemma test : forall p:nat, p<>0 -> p-1+1=p. Proof. intros; lia. Qed. (** Test of new syntax for rewrite : ! ? and so on... *) Lemma but : forall a b c, a<>0 -> b<>0 -> c<>0 -> (a-1+1)+(b-1+1)+(c-1+1)=a+b+c. Proof. intros. rewrite test. Undo. rewrite test,test. Undo. rewrite 2 test. (* or rewrite 2test or rewrite 2!test *) Undo. rewrite 2!test,2?test. Undo. (*rewrite 4!test. --> error *) rewrite 3!test. Undo. rewrite <- 3?test. Undo. (*rewrite <-?test. --> loops*) rewrite !test by auto. reflexivity. Qed. coq-8.20.0/test-suite/success/rewrite_strat.v000066400000000000000000000033001466560755400212440ustar00rootroot00000000000000Require Import Setoid. Parameter X : Set. Parameter f : X -> X. Parameter g : X -> X -> X. Parameter h : nat -> X -> X. Parameter lem0 : forall x, f (f x) = f x. Parameter lem1 : forall x, g x x = f x. Parameter lem2 : forall n x, h (S n) x = g (h n x) (h n x). Parameter lem3 : forall x, h 0 x = x. #[export] Hint Rewrite lem0 lem1 lem2 lem3 : rew. Goal forall x, h 10 x = f x. Proof. intros. Time autorewrite with rew. (* 0.586 *) reflexivity. Time Qed. (* 0.53 *) Goal forall x, h 6 x = f x. intros. Time rewrite_strat topdown lem2. Time rewrite_strat topdown lem1. Time rewrite_strat topdown lem0. Time rewrite_strat topdown lem3. reflexivity. Undo 5. Time rewrite_strat topdown (choice lem2 lem1). Time rewrite_strat topdown (choice lem0 lem3). reflexivity. Undo 3. Time rewrite_strat (topdown (choice lem2 lem1); topdown (choice lem0 lem3)). reflexivity. Undo 2. Time rewrite_strat (topdown (choice lem2 (choice lem1 (choice lem0 lem3)))). reflexivity. Undo 2. Time rewrite_strat (topdown (choice lem2 (choice lem1 (choice lem0 lem3)))). reflexivity. Undo 2. Time rewrite_strat (topdown (choice lem2 lem1 lem0 lem3)). reflexivity. Undo 2. Time rewrite_strat fix f := (choice lem2 lem1 lem0 lem3 (progress subterms f) ; try f). reflexivity. Qed. Goal forall x, h 10 x = f x. Proof. intros. Time rewrite_strat topdown (hints rew). (* 0.38 *) reflexivity. Time Qed. (* 0.06 s *) Set Printing All. Set Printing Depth 100000. Tactic Notation "my_rewrite_strat" constr(x) := rewrite_strat topdown x. Tactic Notation "my_rewrite_strat2" uconstr(x) := rewrite_strat topdown x. Goal (forall x, S x = 0) -> 1=0. intro H. my_rewrite_strat H. Undo. my_rewrite_strat2 H. Abort. coq-8.20.0/test-suite/success/rewrule.v000066400000000000000000000221741466560755400200450ustar00rootroot00000000000000(* -*- mode: coq; coq-prog-args: ("-allow-rewrite-rules") -*- *) (* Simple first example *) Symbol pplus : nat -> nat -> nat. Notation "a ++ b" := (pplus a b). Rewrite Rules plus_rew := | ?n ++ 0 => ?n | ?n ++ S ?n' => S (?n ++ ?n') | 0 ++ ?n => ?n | S ?n ++ ?n' => S (?n ++ ?n'). Check eq_refl : 5 ++ 10 = 15. Check (fun _ _ => eq_refl) : forall n n', 2 + n ++ 3 + n' = 5 + (n ++ n'). (* Test deep pattern matching *) Eval lazy in fun n n' => 2 + n ++ 3 + n'. Eval cbv in fun n n' => 2 + n ++ 3 + n'. Eval cbn in fun n n' => 2 + n ++ 3 + n'. Eval simpl in fun n n' => 2 + n ++ 3 + n'. (* Does not reduce *) (* Example with more pattern constructions and higher-order in patterns *) #[unfold_fix] Symbol raise : forall P: Type, P. Rewrite Rules raise_rew := raise (forall (x : ?A), ?P) => fun x => raise ?P | raise (?A * ?B) => (raise ?A, raise ?B) | raise unit => tt | match raise bool as b return ?P with true => _ | false => _ end => raise ?P@{b := raise bool} | match raise nat as n return ?P with 0 => ?p | S n => ?p' end => raise ?P@{n := raise nat} | match raise (@eq ?A ?a ?b) as e in _ = b return ?P with | eq_refl => _ end => raise ?P@{b := _; e := raise (?a = ?b)} | match raise (list ?A) as l return ?P with | nil => _ | cons _ _ => _ end => raise ?P@{l := raise (list ?A)} | match raise False as e return ?P with end => raise ?P@{e := raise False} | match raise (?A + ?B) as e return ?P with | inl _ => _ | inr _ => _ end => raise ?P@{e := raise (?A + ?B)}. (* There is currently no way to write these rules without the universe inconcistency *) Eval simpl in match raise bool with true | false => 0 end. (* Does not reduce *) Eval lazy in match (raise nat * 5 + 3 :: 0 :: nil)%list with cons 0 l => tt | _ => tt end. Eval lazy in raise nat + 5. Eval cbv in raise nat + 5. Eval cbn in raise nat + 5. Eval simpl in raise nat + 5. (* Does not reduce *) Set Primitive Projections. Record primprod (A B : Type) := { fst: A; snd: B }. (* Example with even more pattern constructions, mostly for terms *) Universe idu. #[unfold_fix, universes(polymorphic)] Symbol id@{q| |} : forall A : Type@{q|idu}, A -> A. Rewrite Rules id_rew := | @{q|u+|+} |- id _ Type@{q|u} => Type@{q|u} | @{q|u+|+} |- id Type@{q|u} (forall (x : ?A), ?P) => forall x, id Type@{q|u} ?P | id (forall (x : ?A), ?P) ?f => fun (x : ?A) => id ?P (?f x) | @{u+} |- id Type@{u} (?A * ?B)%type => (id Type@{u} ?A * id Type@{u} ?B)%type | id (?A * ?B) (?a, ?b) => (id _ ?a, id _ ?b) | id _ unit => unit | id _ tt => tt | id _ nat => nat | id _ 0 => 0 | id _ (S ?n) => S (id _ ?n) | id _ (fun (n : ?A) => S ?n) => fun n => S (id _ ?n) | id (primprod ?A ?B) {| fst := ?a; snd := ?b |} => {| fst := id _ ?a; snd := id _ ?b |}. Fail Rewrite Rule id_rew_fail := Datatypes.id _ ?x => ?x. (* Subterm not recognised as pattern: Datatypes.id *) Fail Rewrite Rule id_rew_fail := 0 => 0. (* Head head-pattern is not a symbol. *) Fail Rewrite Rule id_rew_fail := id _ (?x ?y) => ?x ?y. (* Subterm not recognised as pattern: ?x *) Fail Rewrite Rule id_rew_fail := id _ _ => ?x. (* Unknown existential variable. *) Fail Rewrite Rule id_rew_fail := @{u} |- id _ ?x => ?x. (* Not all universe level variables appear in the pattern. *) Fail Rewrite Rule id_rew_fail := id _ (?x, ?x) => ?x. (* Variable ?x is bound multiple times in the pattern (holes number 1 and 2). *) Fail Rewrite Rule id_rew_fail := @{u+} |- id _ (Type@{u}, Type@{u}) => ?x. (* Universe variable u is bound multiple times in the pattern (holes number 0 and 1). *) Fail Rewrite Rule id_rew_fail := id _ (?x, ?y) => (?x, ?y). (* The replacement term contains unresolved implicit arguments: (?x, ?y) *) Fail Rewrite Rule id_rew_fail := id _ Type => Type. (* Universe rewrule.xxx is unbound. *) Fail Rewrite Rule id_rew_fail := id _ (forall x, ?P) => ?P. (* Cannot interpret ?P in current context: no binding for x. *) Symbol idS : forall (A : SProp), A -> A. Inductive unitS : SProp := ttS. Rewrite Rule id_rew' := idS _ ttS => ttS. (* Warning: This subpattern is irrelevant and can never be matched against. *) Symbol vararity : forall n, (fix f n := match n with 0 => unit | S n => unit -> f n end) n. Check vararity (4 + _) tt tt tt _. Rewrite Rule vararity_rew := id _ (vararity _) => 0. (* Warning: This subpattern has a yet unknown type, which may be a product type, but pattern-matching is not done modulo eta, so this rule may not trigger at required times *) Module MLTTmap. Symbol map : forall A B, (A -> B) -> list A -> list B. Rewrite Rule map_rew := | map _ _ (fun x => x) ?l => ?l | map _ ?C ?f (map ?A _ ?g ?l) => map ?A ?C (fun x => ?f (?g x)) ?l | map ?A ?B ?f (@nil _) => @nil ?B | map ?A ?B ?f (@cons _ ?a ?l) => @cons ?B (?f ?a) (map _ _ ?f ?l). Definition idA {A: Type} := fun (x : A) => x. Eval lazy in fun l => (map _ _ idA l). Eval cbv in fun l => (map _ _ idA l). Eval cbn in fun l => (map _ _ idA l). Eval simpl in fun l => (map _ _ idA l). (* Does not reduce *) Eval lazy in fun l => (map _ _ (fun f x => f x) l). (* Does not reduce because there is no support for eta *) End MLTTmap. (* Example where ignore holes are necessary *) Symbol J : forall (A : Type) (a : A) (P : A -> Type), P a -> forall (a' : A), @eq A a a' -> P a'. Rewrite Rule a := J _ _ _ ?H _ (@eq_refl _ _) => ?H. Module omega. (* Example of a broken extension *) #[unfold_fix] Symbol omega : nat. Rewrite Rule omega_rew := match omega with S n => ?P | 0 => _ end => ?P@{n := omega}. Theorem omega_spec : S omega = omega. Proof. symmetry. change omega with (Nat.pred omega) at 2. remember omega as omeg eqn:e. destruct omeg. 2: reflexivity. apply (f_equal (fun n => match n with 0 => 0 | S _ => 1 end)) in e. apply e. Qed. Theorem omega_contradiction : False. Proof. assert (forall n, S n = n -> False) as X. 2: eapply X, omega_spec. induction n. 1: discriminate. now intros [=]. Qed. Fail Timeout 1 Eval lazy in omega + 0. End omega. Module stream. (* Subtle interaction between rewriting and the guard-checker *) Inductive stream := T (_ : stream). Fixpoint f s : False := f match s with T s' => s' end. Fixpoint g s : False := match s with T s' => g s' end. Rewrite Rule raise_rew_stream := | match raise _ as s return ?P with T _ => _ end => raise ?P@{s := raise _}. Goal forall s, f s = g s. unfold f, g. induction s. assumption. Defined. Eval lazy in g (raise _). Fail Timeout 1 Eval lazy in f (raise _). End stream. Module context. (* Test whether context extensions work correctly (here, with constructor arrguments)*) Symbol id : forall A, A -> A. Axioms (aa ee : nat). Inductive A := C (a := aa) (b : unit) (c := (a, b)) (d : True) (e := ee). Rewrite Rule raise_rew_C := match raise _ with C a b c d e => id (_ * _) ?P end => ?P@{a := _; b := raise _; c := _; d := raise _; e := _}. Eval lazy in match raise _ with C a b c d e => id _ (a, b, c, d, e) end. Eval cbv in match raise _ with C a b c d e => id _ (a, b, c, d, e) end. Eval cbn in match raise _ with C a b c d e => id _ (a, b, c, d, e) end. Eval simpl in match raise _ with C a b c d e => id _ (a, b, c, d, e) end. End context. (* Non-confluent rules prove False *) Symbol Devil : bool -> bool. Rewrite Rule devil := | Devil ?b => false | Devil true => true. Lemma Devil_false b : Devil b = false. Proof. reflexivity. Defined. Lemma Devil_true : Devil true = true. Proof. reflexivity. Defined. Lemma ministry_of_truth : true = false. Proof. transitivity (Devil true). - symmetry;exact Devil_true. - apply Devil_false. Defined. Corollary contradiction : False. Proof. pose proof ministry_of_truth; discriminate. Defined. Definition successor_of_nothing : nat := match ministry_of_truth in eq _ b return if b then bool else nat with eq_refl => false end. (* Such mistyped terms would break the VM, hence why it must be disabled *) Eval vm_compute in pred successor_of_nothing. Definition ignore {A} (x:A) := tt. Definition beginning_of_the_world : ignore (pred successor_of_nothing) = tt. Proof. lazy;reflexivity. Qed. Lemma end_of_the_world : tt = tt. Proof. vm_compute. exact beginning_of_the_world. Defined. (* This computation would run in the VM from the kernel, which is dangerous *) (* Having a common supertype is not enough to preserve SR *) Universe u. Symbol idTy@{i} : Type@{i} -> Type@{u}. Rewrite Rule idTy_id := idTy ?t => ?t. (* Warning: This rewrite rule breaks subject reduction (universe inconsistency). *) Definition U : Type@{u} := idTy Type@{u}. Check U : U. Definition id'@{i} : Type@{i} -> Type@{u} := fun (t: Type@{i}) => t. Fail Definition U' : Type@{u} := id' Type@{u}. Require Import Coq.Logic.Hurkens. Goal False. apply (TypeNeqSmallType.paradox U eq_refl). Defined. (* Test substitution on context extensions *) Definition a : 0 = 0. set (test := let n := 0 in @eq_trans _ n n n (raise _) (raise _)). lazy delta in test. lazy beta in test. set (test_lazy := test). lazy delta zeta in test_lazy. set (test_cbv := test). cbv delta zeta in test_cbv. set (test_cbn := test). cbn delta zeta in test_cbn. set (test_simpl := test). unfold test in test_simpl. simpl in test_simpl. Abort. Definition test_subst_context := Eval cbv delta zeta in let n := 0 in match raise (n = n) in (_ = a) return (n = a) with | eq_refl => raise _ end. coq-8.20.0/test-suite/success/rewrule_quality_match.v000066400000000000000000000013061466560755400227630ustar00rootroot00000000000000(* -*- mode: coq; coq-prog-args: ("-allow-rewrite-rules") -*- *) #[universes(polymorphic)] Symbol irrel@{q|u|} : forall {A : Type@{q|u}}, A -> bool. Rewrite Rule id_rew := | irrel@{SProp|_} _ => true | irrel@{Type|_} _ => false. Inductive STrue : SProp := SI. Goal True. let c := constr:((irrel SI, irrel tt)) in let cl := eval lazy in c in constr_eq cl (true, false). let c := constr:((irrel SI, irrel tt)) in let cl := eval cbv in c in constr_eq cl (true, false). let c := constr:((irrel SI, irrel tt)) in let cl := eval cbn in c in constr_eq cl (true, false). let c := constr:((irrel SI, irrel tt)) in let cl := eval simpl in c in constr_eq cl (true, false). exact I. Qed. coq-8.20.0/test-suite/success/search.v000066400000000000000000000014311466560755400176160ustar00rootroot00000000000000 (** Test of the different syntaxes of Search *) Search plus. Search plus mult. Search "plus_n". Search plus "plus_n". Search "*". Search "*" "+". Search plus inside Peano. Search plus mult in Peano. Search "plus_n" inside Peano. Search plus "plus_n" inside Peano. Search "*" inside Peano. Search "*" "+" inside Peano. Search plus outside Peano Logic. Search plus mult outside Peano Logic. Search "plus_n" outside Peano Logic. Search plus "plus_n" outside Peano Logic. Search "*" outside Peano Logic. Search "*" "+" outside Peano Logic. Search -"*" "+" outside Logic. Search -"*"%nat "+"%nat outside Logic. (** The example in the Reference Manual *) Require Import ZArith. Search Z.mul Z.add "distr". Search "+"%Z "*"%Z "distr" -positive -Prop. Search (?x * _ + ?x * _)%Z outside Lia. coq-8.20.0/test-suite/success/section_poly.v000066400000000000000000000025721466560755400210670ustar00rootroot00000000000000 Section Foo. Variable X : Type. Polymorphic Section Bar. Variable A : Type. Definition id (a:A) := a. End Bar. Check id@{_}. End Foo. Check id@{_}. Polymorphic Section Foo. Variable A : Type. Section Bar. Variable B : Type. Inductive prod := Prod : A -> B -> prod. End Bar. Check prod@{_}. End Foo. Check prod@{_ _}. Section Foo. Universe K. Inductive bla := Bla : Type@{K} -> bla. Polymorphic Definition bli@{j} := Type@{j} -> bla. Definition bloo := bli@{_}. Polymorphic Universe i. Fail Definition x := Type. Fail Inductive x : Type := . Polymorphic Definition x := Type. Polymorphic Inductive y : x := . Variable A : Type. (* adds a mono univ for the Type, which is unrelated to the others *) Fail Variable B : (y : Type@{i}). (* not allowed: mono constraint (about a fresh univ for y) regarding poly univ i *) Polymorphic Variable B : Type. (* new polymorphic stuff always OK *) Variable C : Type@{i}. (* no new univs so no problems *) Polymorphic Definition thing := bloo -> y -> A -> B. End Foo. Check bli@{_}. Check bloo@{}. Check thing@{_ _ _}. Section Foo. Polymorphic Universes i k. Universe j. Fail Constraint i < j. Fail Constraint i < k. (* referring to mono univs in poly constraints is OK. *) Polymorphic Constraint i < j. Polymorphic Constraint j < k. Polymorphic Definition foo := Type@{j}. End Foo. coq-8.20.0/test-suite/success/set.v000066400000000000000000000013451466560755400171500ustar00rootroot00000000000000(* This used to fail in 8.0pl1 *) Goal forall n, n+n=0->0=n+n. intros. set n in * |-. Abort. (* This works from 8.4pl1, since merging of different instances of the same metavariable in a pattern is done modulo conversion *) Notation "p .+1" := (S p) (at level 1, left associativity, format "p .+1"). Goal forall (f:forall n, n=0 -> Prop) n (H:(n+n).+1=0), f (n.+1+n) H. intros. set (f _ _). Abort. Module UsingSProp. Inductive STrue : SProp := I. Inductive SBool : SProp := T | F. Axiom f : forall {A B:SProp}, A -> B -> unit. Goal f (fun _ : nat => F) (fun _:nat => I) = f (fun _ : nat => F) (fun _:nat => I). set (x := fun _ => _). reflexivity. Qed. (* Was failing because all 4 "fun _ => ..." were identified *) End UsingSProp. coq-8.20.0/test-suite/success/setoid_ring_module.v000066400000000000000000000016321466560755400222270ustar00rootroot00000000000000Require Import Setoid Ring Ring_theory. Module abs_ring. Parameters (Coef:Set)(c0 c1 : Coef) (cadd cmul csub: Coef -> Coef -> Coef) (copp : Coef -> Coef) (ceq : Coef -> Coef -> Prop) (ceq_sym : forall x y, ceq x y -> ceq y x) (ceq_trans : forall x y z, ceq x y -> ceq y z -> ceq x z) (ceq_refl : forall x, ceq x x). Add Relation Coef ceq reflexivity proved by ceq_refl symmetry proved by ceq_sym transitivity proved by ceq_trans as ceq_relation. Add Morphism cadd with signature ceq ==> ceq ==> ceq as cadd_Morphism. Admitted. Add Morphism cmul with signature ceq ==> ceq ==> ceq as cmul_Morphism. Admitted. Add Morphism copp with signature ceq ==> ceq as copp_Morphism. Admitted. Definition cRth : ring_theory c0 c1 cadd cmul csub copp ceq. Admitted. Add Ring CoefRing : cRth. End abs_ring. Import abs_ring. Theorem check_setoid_ring_modules : forall a b, ceq (cadd a b) (cadd b a). intros. ring. Qed. coq-8.20.0/test-suite/success/setoid_test.v000066400000000000000000000205301466560755400207000ustar00rootroot00000000000000Require Import TestSuite.admit. Require Import Setoid. Parameter A : Set. Axiom eq_dec : forall a b : A, {a = b} + {a <> b}. Inductive set : Set := | Empty : set | Add : A -> set -> set. Fixpoint In (a : A) (s : set) {struct s} : Prop := match s with | Empty => False | Add b s' => a = b \/ In a s' end. Definition same (s t : set) : Prop := forall a : A, In a s <-> In a t. Lemma setoid_set : Setoid_Theory set same. unfold same; split ; red. red; auto. red. intros. elim (H a); auto. intros. elim (H a); elim (H0 a). split; auto. Qed. Add Setoid set same setoid_set as setsetoid. Add Morphism In with signature (eq ==> same ==> iff) as In_ext. Proof. unfold same; intros a s t H; elim (H a); auto. Qed. Lemma add_aux : forall s t : set, same s t -> forall a b : A, In a (Add b s) -> In a (Add b t). unfold same; simple induction 2; intros. rewrite H1. simpl; left; reflexivity. elim (H a). intros. simpl; right. apply (H2 H1). Qed. Add Morphism Add with signature (eq ==> same ==> same) as Add_ext. split; apply add_aux. assumption. rewrite H. reflexivity. Qed. Fixpoint remove (a : A) (s : set) {struct s} : set := match s with | Empty => Empty | Add b t => match eq_dec a b with | left _ => remove a t | right _ => Add b (remove a t) end end. Lemma in_rem_not : forall (a : A) (s : set), ~ In a (remove a (Add a Empty)). intros. setoid_replace (remove a (Add a Empty)) with Empty. auto. unfold same. split. simpl. case (eq_dec a a). intros e ff; elim ff. intros; absurd (a = a); trivial. simpl. intro H; elim H. Qed. Parameter P : set -> Prop. Parameter P_ext : forall s t : set, same s t -> P s -> P t. Add Morphism P with signature (same ==> iff) as P_extt. intros; split; apply P_ext; (assumption || apply (Seq_sym _ _ setoid_set); assumption). Qed. Lemma test_rewrite : forall (a : A) (s t : set), same s t -> P (Add a s) -> P (Add a t). intros. rewrite <- H. rewrite H. setoid_rewrite <- H. setoid_rewrite H. setoid_rewrite <- H. trivial. Qed. (* Unifying the domain up to delta-conversion (example from emakarov) *) Definition id: Set -> Set := fun A => A. Definition rel : forall A : Set, relation (id A) := @eq. Definition f: forall A : Set, A -> A := fun A x => x. Add Relation (id A) (rel A) as eq_rel. Add Morphism (@f A) with signature (eq ==> eq) as f_morph. Proof. unfold rel, f. trivial. Qed. (* Submitted by Nicolas Tabareau *) (* Needs unification.ml to support environments with de Bruijn *) Goal forall (f : Prop -> Prop) (Q : (nat -> Prop) -> Prop) (H : forall (h : nat -> Prop), Q (fun x : nat => f (h x)) <-> True) (h:nat -> Prop), Q (fun x : nat => f (Q (fun b : nat => f (h x)))) <-> True. intros f0 Q H. setoid_rewrite H. tauto. Qed. (** Check proper refreshing of the lemma application for multiple different instances in a single setoid rewrite. *) Section mult. Context (fold : forall {A} {B}, (A -> B) -> A -> B). Context (add : forall A, A -> A). Context (fold_lemma : forall {A B f} {eqA : relation B} x, eqA (fold A B f (add A x)) (fold _ _ f x)). Context (ab : forall B, A -> B). Context (anat : forall A, nat -> A). Goal forall x, (fold _ _ (fun x => ab A x) (add A x) = anat _ (fold _ _ (ab nat) (add _ x))). Proof. intros. setoid_rewrite fold_lemma. change (fold A A (fun x0 : A => ab A x0) x = anat A (fold A nat (ab nat) x)). Abort. End mult. (** Current semantics for rewriting with typeclass constraints in the lemma does not fix the instance at the first unification, use [at], or simply rewrite for this semantics. *) Parameter beq_nat : forall x y : nat, bool. Class Foo (A : Type) := {foo_neg : A -> A ; foo_prf : forall x : A, x = foo_neg x}. #[export] Instance: Foo nat. admit. Defined. #[export] Instance: Foo bool. admit. Defined. Goal forall (x : nat) (y : bool), beq_nat (foo_neg x) 0 = foo_neg y. Proof. intros. setoid_rewrite <- foo_prf. change (beq_nat x 0 = y). Abort. Goal forall (x : nat) (y : bool), beq_nat (foo_neg x) 0 = foo_neg y. Proof. intros. setoid_rewrite <- @foo_prf at 1. change (beq_nat x 0 = foo_neg y). Abort. (* This should not raise an anomaly as it did for some time in early 2016 *) Definition t := nat -> bool. Definition h (a b : t) := forall n, a n = b n. #[export] Instance subrelh : subrelation h (Morphisms.pointwise_relation nat eq). Proof. intros x y H; assumption. Qed. Goal forall a b, h a b -> a 0 = b 0. intros. setoid_rewrite H. (* Fallback on ordinary rewrite without anomaly *) reflexivity. Qed. Module InType. Require Import CRelationClasses CMorphisms. Inductive All {A : Type} (P : A -> Type) : list A -> Type := | All_nil : All P nil | All_cons x (px : P x) xs (pxs : All P xs) : All P (x :: xs). Lemma All_impl {A} (P Q : A -> Type) l : (forall x, P x -> Q x) -> All P l -> All Q l. Proof. intros HP. induction 1; constructor; eauto. Qed. Axiom add_0_r_peq : forall x : nat, eq (x + 0)%nat x. #[export] Instance All_proper {A} : CMorphisms.Proper ((pointwise_relation A iffT) ==> eq ==> iffT) All. Proof. intros f g Hfg x y e. destruct e. split; apply All_impl, Hfg. Qed. Lemma rewrite_all {l : list nat} (Q : nat -> Type) : All (fun x => Q x) l -> All (fun x => Q (x + 0)) l. Proof. intros a. setoid_rewrite add_0_r_peq. exact a. Qed. Lemma rewrite_all_in {l : list nat} (Q : nat -> Type) : All (fun x => Q (x + 0)) l -> All (fun x => Q x) l. Proof. intros a. setoid_rewrite add_0_r_peq in a. exact a. Qed. Lemma rewrite_all_in2 {l : list nat} (Q : nat -> Type) (R : nat -> Type) : All (fun x => prod (Q (x + 0)%nat) (R x))%type l -> All (fun x => prod (Q x) (R x))%type l. Proof. intros a. setoid_rewrite add_0_r_peq in a. exact a. Qed. End InType. Module Polymorphism. Require Import CRelationClasses CMorphisms. #[universes(polymorphic, cumulative)] Inductive plist@{i} (A : Type@{i}) : Type@{i} := | pnil : plist A | pcons : A -> plist A -> plist A. Arguments pnil {A}. Arguments pcons {A}. #[universes(polymorphic, cumulative)] Record pprod@{i j} (A : Type@{i}) (B : Type@{j}) : Type@{max(i, j)} := { pfst : A; psnd : B }. Arguments pfst {A B}. Arguments psnd {A B}. Notation "x :: xs" := (pcons x xs). #[universes(polymorphic)] Fixpoint All@{i j} {A : Type@{i}} (P : A -> Type@{j}) (l : plist A) : Type@{j} := match l with | pnil => unit | x :: xs => pprod (P x) (All P xs) end. (* #[universes(polymorphic, cumulative)] Inductive All {A : Type} (P : A -> Type) : list A -> Type := | All_nil : All P nil | All_cons x (px : P x) xs (pxs : All P xs) : All P (x :: xs). *) #[universes(polymorphic)] Lemma All_impl {A} (P Q : A -> Type) l : (forall x, P x -> Q x) -> All P l -> All Q l. Proof. intros HP. induction l; [intros|intros []]; constructor; eauto. Qed. Check pointwise_relation. #[universes(polymorphic)] Inductive peq@{i} (A : Type@{i}) (a : A) : A -> Type@{i} := peq_refl : peq A a a. Arguments peq {A}. Arguments peq_refl {A a}. #[universes(polymorphic)] Axiom add_0_r_peq : forall x : nat, peq (x + 0)%nat x. #[universes(polymorphic), export] Instance peq_left {A : Type} {B : Type} {R : crelation B} (f : A -> B) `{Reflexive B R} : Proper (peq ==> R) f. Admitted. #[export] Instance reflexive_eq_dom_reflexive@{i j jr mij mijr} {A : Type@{i}} {B : Type@{j}} (R : crelation@{j jr} B) : Reflexive@{j jr} R -> Reflexive@{mij mijr} (@peq A ==> R)%signatureT. Proof. intros hr x ? ? e. destruct e. apply hr. Qed. #[universes(polymorphic), export] Instance All_proper {A} : CMorphisms.Proper ((pointwise_relation A iffT) ==> peq ==> iffT) All. Proof. intros f g Hfg x y e. destruct e. split; apply All_impl, Hfg. Qed. #[universes(polymorphic), export] Instance eq_proper_proxy@{i} {A : Type@{i}} (x : A) : ProperProxy@{i i} peq x. Proof. red. exact peq_refl. Defined. #[universes(polymorphic), export] Instance peq_equiv {A} : Equivalence (@peq A). Proof. split. Admitted. Lemma rewrite_all {l : plist nat} (Q : nat -> Type) : All (fun x => Q x) l -> All (fun x => Q (x + 0)) l. Proof. intros a. setoid_rewrite add_0_r_peq. exact a. Qed. Lemma rewrite_all_in {l : plist nat} (Q : nat -> Type) : All (fun x => Q (x + 0)) l -> All (fun x => Q x) l. Proof. intros a. Show Universes. setoid_rewrite add_0_r_peq in a. exact a. Qed. Lemma rewrite_all_in2 {l : plist nat} (Q : nat -> Type) (R : nat -> Type) : All (fun x => pprod (Q (x + 0)%nat) (R x))%type l -> All (fun x => pprod (Q x) (R x))%type l. Proof. intros a. setoid_rewrite add_0_r_peq in a. exact a. Qed. End Polymorphism. coq-8.20.0/test-suite/success/setoid_test2.v000066400000000000000000000205671466560755400207740ustar00rootroot00000000000000Require Export Setoid. (* Testare: +1. due setoidi con ugualianza diversa sullo stesso tipo +2. due setoidi sulla stessa uguaglianza +3. due morfismi sulla stessa funzione ma setoidi diversi +4. due morfismi sulla stessa funzione e stessi setoidi +5. setoid_replace +6. solo cammini mal tipati +7. esempio (f (g (h E1))) dove h:(T1,=1) -> T2, g:T2->(T3,=3), f:(T3,=3)->Prop +8. test con occorrenze non lineari del pattern +9. test in cui setoid_replace fa direttamente fallback su replace 10. sezioni +11. goal con impl +12. testare *veramente* setoid_replace (ora testato solamente il caso di fallback su replace) Incompatibilita': 1. full_trivial in setoid_replace 2. "as ..." per "Add Setoid" 3. ipotesi permutate in lemma di "Add Morphism" 4. iff invece di if in "Add Morphism" nel caso di predicati 5. setoid_replace poteva riscrivere sia c1 in c2 che c2 in c1 (???? o poteva farlo da destra a sinitra o viceversa? ????) ### Come evitare di dover fare "Require Setoid" prima di usare la tattica? ??? scelta: quando ci sono piu' scelte dare un warning oppure fallire? difficile quando la tattica e' rewrite ed e' usata in tattiche automatiche ??? in test4.v il setoid_rewrite non si puo' sostituire con rewrite perche' questo ultimo fallisce per via dell'unificazione ??? ??? <-> non e' sottorelazione di ->. Quindi ora puo' capitare di non riuscire a provare goal del tipo A /\ B dove (A, <->) e (B, ->) (per esempio) ### Nota: il parsing e pretty printing delle relazioni non e' in synch! eq contro (ty,eq). Uniformare ### diminuire la taglia dei proof term ??? il messaggio di errore non e' assolutamente significativo quando nessuna marcatura viene trovata ### fare in modo che uscendo da una sezione vengano quantificate le relazioni e i morfismi. Hugo: paciugare nel discharge.ml ### implementare relazioni/morfismi quantificati con dei LetIn (che palle...) decompose_prod da far diventare simile a un Reduction.dest_arity? (ma senza riduzione??? e perche' li' c'e' riduzione?) Soluzione da struzzo: fare zeta-conversione. ### fare in modo che impl sia espanso nel lemma di compatibilita' del morfismo (richiesta di Marco per poter fare Add Hing) ??? snellire la sintassi omettendo "proved by" come proposto da Marco? ;-( ### non capisce piu' le riscritture con uguaglianze quantificate (almeno nell'esempio di Marco) ### Bas Spitters: poter dichiarare che ogni variabile nel contesto di tipo un setoid_function e' un morfismo ### unificare le varie check_... ### sostituire a Use_* una sola eccezione Optimize Implementare: -2. user-defined subrelations && user-proved subrelations -1. trucco di Bruno Sorgenti di inefficacia: 1. scelta del setoide di default per un sostegno: per farlo velocemente ci vorrebbe una tabella hash; attualmente viene fatta una ricerca lineare sul range della setoid_table Vantaggi rispetto alla vecchia tattica: 1. permette di avere setoidi differenti con lo stesso sostegno, ma equivalenza differente 2. accetta setoidi differenti con lo stesso sostegno e stessa equivalenza, scegliendo a caso quello da usare (proof irrelevance) 3. permette di avere morfismi differenti sulla stessa funzione se hanno dominio o codominio differenti 4. accetta di avere morfismi differenti sulla stessa funzione e con lo stesso dominio e codominio, scegliendo a caso quello da usare (proof irrelevance) 5. quando un morfismo viene definito, se la scelta del dominio o del codominio e' ambigua l'utente puo' esplicitamente disambiguare la scelta fornendo esplicitamente il "tipo" del morfismo 6. permette di gestire riscritture ove ad almeno una funzione venga associato piu' di un morfismo. Vengono automaticamente calcolate le scelte globali che rispettano il tipaggio. 7. se esistono piu' scelte globali che rispettano le regole di tipaggio l'utente puo' esplicitamente disambiguare la scelta globale fornendo esplicitamente la scelta delle side conditions generate. 8. nel caso in cui la setoid_replace sia stata invocata al posto della replace la setoid_replace invoca direttamente la replace. Stessa cosa per la setoid_rewrite. 9. permette di gestire termini in cui il prefisso iniziale dell'albero (fino a trovare il termine da riscrivere) non sia formato esclusivamente da morfismi il cui dominio e codominio sia un setoide. Ovvero ammette anche morfismi il cui dominio e/o codominio sia l'uguaglianza di Leibniz. (Se entrambi sono uguaglianze di Leibniz allora il setoide e' una semplice funzione). 10. [setoid_]rewrite ... in ... setoid_replace ... in ... [setoid_]reflexivity [setoid_]transitivity ... [setoid_]symmetry [setoid_]symmetry in ... 11. permette di dichiarare dei setoidi/relazioni/morfismi in un module type 12. relazioni, morfismi e setoidi quantificati *) Axiom S1: Set. Axiom eqS1: S1 -> S1 -> Prop. Axiom SetoidS1 : Setoid_Theory S1 eqS1. Add Setoid S1 eqS1 SetoidS1 as S1setoid. #[export] Instance eqS1_default : DefaultRelation eqS1 := {}. Axiom eqS1': S1 -> S1 -> Prop. Axiom SetoidS1' : Setoid_Theory S1 eqS1'. Axiom SetoidS1'_bis : Setoid_Theory S1 eqS1'. Add Setoid S1 eqS1' SetoidS1' as S1setoid'. Add Setoid S1 eqS1' SetoidS1'_bis as S1setoid''. Axiom S2: Set. Axiom eqS2: S2 -> S2 -> Prop. Axiom SetoidS2 : Setoid_Theory S2 eqS2. Add Setoid S2 eqS2 SetoidS2 as S2setoid. Axiom f : S1 -> nat -> S2. Add Morphism f with signature (eqS1 ==> eq ==> eqS2) as f_compat. Admitted. Add Morphism f with signature (eqS1 ==> eq ==> eqS2) as f_compat2. Admitted. Theorem test1: forall x y, (eqS1 x y) -> (eqS2 (f x 0) (f y 0)). intros. rewrite H. reflexivity. Qed. Theorem test1': forall x y, (eqS1 x y) -> (eqS2 (f x 0) (f y 0)). intros. setoid_replace x with y. reflexivity. assumption. Qed. Axiom g : S1 -> S2 -> nat. Add Morphism g with signature (eqS1 ==> eqS2 ==> eq) as g_compat. Admitted. Axiom P : nat -> Prop. Theorem test2: forall x x' y y', (eqS1 x x') -> (eqS2 y y') -> (P (g x' y')) -> (P (g x y)). intros. rewrite H. rewrite H0. assumption. Qed. Theorem test3: forall x x' y y', (eqS1 x x') -> (eqS2 y y') -> (P (S (g x' y'))) -> (P (S (g x y))). intros. rewrite H. rewrite H0. assumption. Qed. Theorem test4: forall x x' y y', (eqS1 x x') -> (eqS2 y y') -> (S (g x y)) = (S (g x' y')). intros. rewrite H. rewrite H0. reflexivity. Qed. Theorem test5: forall x x' y y', (eqS1 x x') -> (eqS2 y y') -> (S (g x y)) = (S (g x' y')). intros. setoid_replace (g x y) with (g x' y'). reflexivity. rewrite <- H0. rewrite H. reflexivity. Qed. Axiom f_test6 : S2 -> Prop. Add Morphism f_test6 with signature (eqS2 ==> iff) as f_test6_compat. Admitted. Axiom g_test6 : bool -> S2. Add Morphism g_test6 with signature (eq ==> eqS2) as g_test6_compat. Admitted. Axiom h_test6 : S1 -> bool. Add Morphism h_test6 with signature (eqS1 ==> eq) as h_test6_compat. Admitted. Theorem test6: forall E1 E2, (eqS1 E1 E2) -> (f_test6 (g_test6 (h_test6 E2))) -> (f_test6 (g_test6 (h_test6 E1))). intros. rewrite H. assumption. Qed. Theorem test7: forall E1 E2 y y', (eqS1 E1 E2) -> (eqS2 y y') -> (f_test6 (g_test6 (h_test6 E2))) -> (f_test6 (g_test6 (h_test6 E1))) /\ (S (g E1 y')) = (S (g E2 y')). intros. rewrite H. split; [assumption | reflexivity]. Qed. Axiom S1_test8: Set. Axiom eqS1_test8: S1_test8 -> S1_test8 -> Prop. Axiom SetoidS1_test8 : Setoid_Theory S1_test8 eqS1_test8. Add Setoid S1_test8 eqS1_test8 SetoidS1_test8 as S1_test8setoid. #[export] Instance eqS1_test8_default : DefaultRelation eqS1_test8 := {}. Axiom f_test8 : S2 -> S1_test8. Add Morphism f_test8 with signature (eqS2 ==> eqS1_test8) as f_compat_test8. Admitted. Axiom eqS1_test8': S1_test8 -> S1_test8 -> Prop. Axiom SetoidS1_test8' : Setoid_Theory S1_test8 eqS1_test8'. Add Setoid S1_test8 eqS1_test8' SetoidS1_test8' as S1_test8setoid'. (*CSC: for test8 to be significant I want to choose the setoid (S1_test8, eqS1_test8'). However this does not happen and there is still no syntax for it ;-( *) Axiom g_test8 : S1_test8 -> S2. Add Morphism g_test8 with signature (eqS1_test8 ==> eqS2) as g_compat_test8. Admitted. Theorem test8: forall x x': S2, (eqS2 x x') -> (eqS2 (g_test8 (f_test8 x)) (g_test8 (f_test8 x'))). intros. rewrite H. Abort. (*Print Setoids.*) coq-8.20.0/test-suite/success/setoid_test_function_space.v000066400000000000000000000021631466560755400237620ustar00rootroot00000000000000Require Export Setoid. Set Implicit Arguments. Section feq. Variables A B:Type. Definition feq (f g: A -> B):=forall a, (f a)=(g a). Infix "=f":= feq (at level 80, right associativity). Hint Unfold feq. Lemma feq_refl: forall f, f =f f. intuition. Qed. Lemma feq_sym: forall f g, f =f g-> g =f f. intuition. Qed. Lemma feq_trans: forall f g h, f =f g-> g =f h -> f =f h. unfold feq. intuition. rewrite H. auto. Qed. End feq. Infix "=f":= feq (at level 80, right associativity). #[export] Hint Unfold feq. #[export] Hint Resolve feq_refl feq_sym feq_trans. Parameter K:(nat -> nat)->Prop. Parameter K_ext:forall a b, (K a)->(a =f b)->(K b). Add Parametric Relation (A B : Type) : (A -> B) (@feq A B) reflexivity proved by (@feq_refl A B) symmetry proved by (@feq_sym A B) transitivity proved by (@feq_trans A B) as funsetoid. Add Morphism K with signature (@feq nat nat) ==> iff as K_ext1. intuition. apply (K_ext H0 H). intuition. assert (y =f x);auto. apply (K_ext H0 H1). Qed. Lemma three:forall n, forall a, (K a)->(a =f (fun m => (a (n+m))))-> (K (fun m => (a (n+m)))). intuition. setoid_rewrite <- H0. assumption. Qed. coq-8.20.0/test-suite/success/setoid_unif.v000066400000000000000000000016261466560755400206670ustar00rootroot00000000000000(* An example of unification in rewrite which uses eager substitution of metas (provided by Pierre-Marie). Put in the test suite as an indication of what the use metas eagerly flag provides, even though the concrete cases that use it are seldom. Today supported thanks to a new flag for using evars eagerly, after this variant of setoid rewrite started to use clause environments based on evars (fbbe491cfa157da627) *) Require Import Setoid. Parameter elt : Type. Parameter T : Type -> Type. Parameter empty : forall A, T A. Parameter MapsTo : forall A : Type, elt -> A -> T A -> Prop. (* Definition In A x t := exists e, MapsTo A x e t. *) Axiom In : forall A, A -> T A -> Prop. Axiom foo : forall A x, In A x (empty A) <-> False. Record R := { t : T unit; s : unit }. Definition Empty := {| t := empty unit; s := tt |}. Goal forall x, ~ In _ x (t Empty). Proof. intros x. rewrite foo. Abort. coq-8.20.0/test-suite/success/shrink_abstract.v000066400000000000000000000003061466560755400215320ustar00rootroot00000000000000Definition foo : forall (n m : nat), bool. Proof. pose (p := 0). intros n. pose (q := n). intros m. pose (r := m). abstract (destruct m; [left|right]). Defined. Check (foo_subproof : nat -> bool). coq-8.20.0/test-suite/success/shrink_obligations.v000066400000000000000000000011041466560755400222360ustar00rootroot00000000000000Require Program. Obligation Tactic := idtac. Program Definition foo (m : nat) (p := S m) (n : nat) (q := S n) : unit := let bar : {r | n < r} := _ in let qux : {r | p < r} := _ in let quz : m = n -> True := _ in tt. Next Obligation. intros m p n q. exists (S n); constructor. Qed. Next Obligation. intros m p n q. exists (S (S m)); constructor. Qed. Next Obligation. intros m p n q ? ? H. destruct H. constructor. Qed. Check (foo_obligation_1 : forall n, {r | n < r}). Check (foo_obligation_2 : forall m, {r | (S m) < r}). Check (foo_obligation_3 : forall m n, m = n -> True). coq-8.20.0/test-suite/success/sideff.v000066400000000000000000000004611466560755400176130ustar00rootroot00000000000000Definition idw (A : Type) := A. Lemma foobar : unit. Proof. Require Import Program. apply (const tt tt). Qed. Set Nested Proofs Allowed. Lemma foobar' : unit. Lemma aux : forall A : Type, A -> unit. Proof. intros. pose (foo := idw A). exact tt. Show Universes. Qed. apply (@aux unit tt). Qed. coq-8.20.0/test-suite/success/simpl.v000066400000000000000000000250621466560755400175030ustar00rootroot00000000000000Require Import TestSuite.admit. (* Check that inversion of names of mutual inductive fixpoints works *) (* (cf BZ#1031) *) Inductive tree : Set := | node : nat -> forest -> tree with forest : Set := | leaf : forest | cons : tree -> forest -> forest . Definition copy_of_compute_size_forest := fix copy_of_compute_size_forest (f:forest) : nat := match f with | leaf => 1 | cons t f0 => copy_of_compute_size_forest f0 + copy_of_compute_size_tree t end with copy_of_compute_size_tree (t:tree) : nat := match t with | node _ f => 1 + copy_of_compute_size_forest f end for copy_of_compute_size_forest . Eval simpl in (copy_of_compute_size_forest leaf). (* Another interesting case: Hrec has two occurrences: one cannot be folded back to f while the second can. *) Parameter g : (nat->nat)->nat->nat->nat. Definition f (n n':nat) := nat_rec (fun _ => nat -> nat) (fun x => x) (fun k Hrec => g Hrec (Hrec k)) n n'. Goal forall a b, f (S a) b = b. intros. simpl. match goal with [ |- g (f a) (f a a) b = b ] => idtac end. admit. Qed. (* Yet another example. *) Require Import List. Goal forall A B (a:A) l f (i:B), fold_right f i ((a :: l))=i. intros. simpl. match goal with [ |- f0 a (fold_right f0 i l) = i ] => idtac end. admit. Qed. (* Qed will fail if simplification is incorrect (de Bruijn!) *) (* Check that maximally inserted arguments do not break interpretation of references in simpl, vm_compute etc. *) Arguments fst {A} {B} p. Goal fst (0,0) = 0. simpl fst. Fail set (fst _). Abort. Goal fst (0,0) = 0. vm_compute fst. Fail set (fst _). Abort. Goal let f x := x + 0 in f 0 = 0. intro. vm_compute f. Fail set (f _). Abort. (* This is a change wrt 8.4 (waiting to know if it breaks script a lot or not)*) Goal 0+0=0. Fail simpl @eq. Abort. (* Check reference by notation in simpl *) Goal 0+0 = 0. simpl "+". Fail set (_ + _). Abort. (* Check occurrences *) Record box A := Box { unbox : A }. Goal unbox _ (unbox _ (unbox _ (Box _ (Box _ (Box _ True))))) = unbox _ (unbox _ (unbox _ (Box _ (Box _ (Box _ True))))). simpl (unbox _ (unbox _ _)) at 1. match goal with |- True = unbox _ (unbox _ (unbox _ (Box _ (Box _ (Box _ True))))) => idtac end. Undo 2. Fail simpl (unbox _ (unbox _ _)) at 5. simpl (unbox _ (unbox _ _)) at 1 4. match goal with |- True = unbox _ (Box _ True) => idtac end. Undo 2. Fail simpl (unbox _ (unbox _ _)) at 3 4. (* Nested and even overlapping *) simpl (unbox _ (unbox _ _)) at 2 4. match goal with |- unbox _ (Box _ True) = unbox _ (Box _ True) => idtac end. Abort. (* Check interpretation of ltac variables (was broken in 8.5 beta 1 and 2 *) Goal 2=1+1. match goal with |- (_ = ?c) => simpl c end. match goal with |- 2 = 2 => idtac end. (* Check that it reduced *) Abort. Module FurtherAppliedPrimitiveProjections. Set Primitive Projections. Record T := { u : nat -> nat }. Goal {| u:= fun x => x |}.(u) 0 = 0. simpl u. match goal with |- 0 = 0 => idtac end. (* Check that it reduced *) Abort. End FurtherAppliedPrimitiveProjections. Module BugUniverseMutualFix. Set Universe Polymorphism. Fixpoint foo1@{u v} (A : Type@{u}) n : Type@{v} := match n with 0 => A | S n => (foo2 A n * A)%type end with foo2@{u v} (A : Type@{u}) n : Type@{v} := match n with 0 => A | S n => (foo1 A n * A)%type end. Set Printing Universes. Definition bar@{u} (A : Type@{u}) n := foo1@{u u} A n. Goal forall n, bar unit (S n) = unit. simpl. Abort. End BugUniverseMutualFix. Module PolyUniverses. (* An example showing that the cache needs to take universes into account *) Set Universe Polymorphism. Record cell T S := Cell { hd : T; tl : S }. Arguments Cell {_ _}. Arguments hd {_ _}. Arguments tl {_ _}. Notation "x ::: y" := (Cell x y) (at level 60). Definition ilist T n := @Nat.iter n Type (cell T) unit. Fixpoint imap@{u u0 u1 u2} (T:Type@{u}) (S:Type@{u0}) (f : T -> S) n : ilist@{u2 u1} T n -> ilist@{u0 u1} S n := match n with | 0 => fun l => tt | S n => fun l => f l.(hd) ::: imap _ _ f _ l.(tl) end. Lemma imap_eq (T S : Type) (f g : T -> S) : forall n, forall x, @imap _ _ f n x = @imap _ _ g n x. induction n. intro; auto. intros []. Abort. End PolyUniverses. Module WithLet. Section S. Variable a : nat. Let b := 0. Variable c : nat. Fixpoint f n := match n with | 0 => a + b + c | S n => f n end. End S. Definition f' a c n := f a c n. Lemma L a c n : f' a c (S n) = f a c (S n). simpl. match goal with [ |- f' a c n = f a c n ] => idtac end. Abort. End WithLet. Module WithLetMutual. Section S. Context (a : nat) (b := 0) (c : nat). Fixpoint f n := match n with 0 => a + b + c | S n => g n end with g n := match n with 0 => a + b + c | S n => f n end. End S. Definition f' a c n := f a c n. Lemma L a c n : f' a c (S n) = f a c (S n). simpl. match goal with [ |- g a c n = g a c n ] => idtac end. Abort. End WithLetMutual. Module IotaTrigger1. Definition a x := match x with true => tt | false => tt end. Definition b x (y : unit) := a x. Definition c x := b x tt. Goal a true = tt. simpl. match goal with [ |- tt = tt ] => idtac end. Abort. Goal b true = fun _ => tt. simpl. match goal with [ |- b true = _ ] => idtac end. Abort. Goal c true = tt. simpl. match goal with [ |- tt = tt ] => idtac end. Abort. End IotaTrigger1. Module IotaTrigger2. Definition a x := match x with true => fun _ => tt | false => fun _ => tt end tt. Definition b x (y : unit) := a x. Definition c x := b x tt. Goal a true = tt. simpl. match goal with [ |- tt = tt ] => idtac end. Abort. Goal b true = fun _ => tt. simpl. match goal with [ |- b true = _ ] => idtac end. Abort. Goal c true = tt. simpl. match goal with [ |- tt = tt ] => idtac end. Abort. End IotaTrigger2. Module IotaTrigger3. Fixpoint f_fix_fun n := match n with 0 => fun _ : unit => true | S n => f_fix_fun n end. Definition test_fix_fun n := f_fix_fun n. Goal test_fix_fun 2 = fun _ => true. simpl. match goal with [ |- (fun _ => true) = _ ] => idtac end. Abort. Goal forall x, test_fix_fun (S x) = fun _ => true. intro. simpl. match goal with [ |- test_fix_fun x = _ ] => idtac end. Abort. (* REDUCED *) Definition test_fix_fun_partial n (x:unit) := f_fix_fun n. Goal test_fix_fun_partial 2 = fun _ _ => true. simpl. match goal with [ |- test_fix_fun_partial 2 = _ ] => idtac end. Abort. Goal forall x, test_fix_fun_partial (S x) = fun _ _ => true. intro. simpl. match goal with [ |- test_fix_fun_partial (S x) = _ ] => idtac end. Abort. (* NOT REDUCED: design choice that it is not enough fully applied to trigger the reduction *) (* remark: the presence of an inner "fun" does not matter *) Fixpoint f_fix n := match n with 0 => fun _ : unit => true | S n => f_fix n end. Definition test_fix n := f_fix n tt. Goal test_fix 2 = true. simpl. match goal with [ |- test_fix 2 = _ ] => idtac end. Abort. Goal forall x, test_fix (S x) = true. intro. simpl. match goal with [ |- test_fix (S x) = _ ] => idtac end. Abort. (* NOT REDUCED: design choice that we couldn't refold to test_fix after reduction *) Fixpoint f_mutual_fix n := match n with 0 => true | S n => g n end with g n := match n with 0 => true | S n => f_mutual_fix n end. Definition test_mutual_fix n := f_mutual_fix n. Goal test_mutual_fix 2 = true. simpl. match goal with [ |- true = _ ] => idtac end. Abort. Goal forall x, test_mutual_fix (S x) = true. intro. simpl. match goal with [ |- g x = _ ] => idtac end. Abort. (* REDUCED: design choice that mutual fixpoints refold to last encapsulating name *) Definition test_mutual_fix_partial n (x:unit) := f_mutual_fix n. Goal test_mutual_fix_partial 2 = fun _ => true. simpl. match goal with [ |- test_mutual_fix_partial 2 = _ ] => idtac end. Abort. Goal forall x, test_mutual_fix_partial (S x) = fun _ => true. intro. simpl. match goal with [ |- test_mutual_fix_partial (S x) = _ ] => idtac end. Abort. (* NOT REDUCED: design choice that it is not enough fully applied to trigger the reduction *) (* Moreover, was failing between #17993 and #18243 (see #18239) *) Fixpoint f_mutual_fix_cut n := match n with 0 => fun _ : unit => true | S n => g_cut n end with g_cut n := match n with 0 => fun _ : unit => true | S n => f_mutual_fix_cut n end. Definition test_mutual_fix_cut n := f_mutual_fix_cut n tt. Goal test_mutual_fix_cut 2 = true. simpl. match goal with [ |- true = _ ] => idtac end. Abort. Goal forall x, test_mutual_fix_cut (S x) = true. intro. simpl. match goal with [ |- g_cut x tt = _ ] => idtac end. Abort. (* REDUCED: by consistency with test_mutual_fix, which itself already differs from the case of a unary fix (new behavior from #18243) *) Definition test_mutual_fix_cut_partial n (x:unit) := f_mutual_fix_cut n x. Goal test_mutual_fix_cut_partial 2 = fun _ => true. simpl. match goal with [ |- test_mutual_fix_cut_partial 2 = _ ] => idtac end. Abort. Goal forall x, test_mutual_fix_cut_partial (S x) = fun _ => true. intro. simpl. match goal with [ |- test_mutual_fix_cut_partial (S x) = _ ] => idtac end. Abort. (* NOT REDUCED: by consistency with test_fix_fun_partial and test_mutual_fix_cut_partial *) (* Moreover was failing before #18243 (see #18239) *) Definition f_case n := match n with 0 => fun _ : unit => true | S n => fun _ => true end. Definition test_case n := f_case n tt. Goal test_case 2 = true. simpl. match goal with [ |- true = _ ] => idtac end. Abort. (* REDUCED *) End IotaTrigger3. Module Bug4056. CoInductive stream {A:Type} : Type := | scons: A->stream->stream. Definition stream_unfold {A} (s: @ stream A) := match s with | scons a s' => (a, scons a s') end. Section A. CoFixpoint inf_stream1 (x:nat) (n:nat) := scons n (inf_stream1 x (n+x)). End A. Section B. Variable (x:nat). CoFixpoint inf_stream2 (n:nat) := scons n (inf_stream2 (n+x)). End B. Goal (forall x n, stream_unfold (inf_stream1 x n) = stream_unfold (inf_stream2 x n)). (* simpl was exposing the cofix on the rhs but not the lhs *) intros. simpl. match goal with [ |- (n, scons n (inf_stream1 x (n + x))) = (n, scons n (inf_stream2 x (n + x))) ] => idtac end. Abort. Section C. Variable (x:nat). CoFixpoint mut_stream1 (n:nat) := scons n (mut_stream2 (n+x)) with mut_stream2 (n:nat) := scons n (mut_stream1 (n+x)). End C. Goal (forall x n, stream_unfold (mut_stream1 x n) = stream_unfold (mut_stream2 x n)). intros. simpl. match goal with [ |- (n, scons n (mut_stream2 x (n + x))) = (n, scons n (mut_stream1 x (n + x))) ] => idtac end. Abort. Definition inf_stream2_copy n := inf_stream2 n. (* inversible *) Definition mut_stream2_copy n := mut_stream2 n. (* inversible only towards mut_stream1/mut_stream2 *) Goal (forall x n, stream_unfold (inf_stream2_copy x n) = stream_unfold (mut_stream2_copy x n)). intros. simpl. match goal with [ |- (n, scons n (inf_stream2_copy x (n + x))) = (n, scons n (mut_stream1 x (n + x))) ] => idtac end. Abort. End Bug4056. coq-8.20.0/test-suite/success/simpl_tuning.v000066400000000000000000000074741466560755400210760ustar00rootroot00000000000000(* as it is dynamically inferred by simpl *) Arguments minus !n / m. Lemma foo x y : S (S x) - S y = 0. simpl. match goal with |- (match y with O => S x | S _ => _ end = 0) => idtac end. Abort. (* we avoid exposing a match *) Arguments minus n m : simpl nomatch. Lemma foo x : minus 0 x = 0. simpl. match goal with |- (0 = 0) => idtac end. Abort. Lemma foo x y : S (S x) - S y = 0. simpl. match goal with |- (S x - y = 0) => idtac end. Abort. Lemma foo x y : S (S x) - (S (match y with O => O | S z => S z end)) = 0. simpl. match goal with |-(S x - (match y with O => _ | S _ => _ end) = 0) => idtac end. Abort. (* we unfold as soon as we have 1 args, but we avoid exposing a match *) Arguments minus n / m : simpl nomatch. Lemma foo : minus 0 = fun x => 0. simpl. match goal with |- minus 0 = _ => idtac end. Abort. (* This does not work as one may expect. The point is that simpl is implemented as "strong (whd_simpl_state)" and after unfolding minus you have (fun m => match 0 => 0 | S n => ...) that is already in whd and exposes a match, that of course "strong" would reduce away but at that stage we don't know, and reducing by hand under the lambda is against whd *) (* extra tuning for the usual heuristic *) Arguments minus !n / m : simpl nomatch. Lemma foo x y : S (S x) - S y = 0. simpl. match goal with |- (S x - y = 0) => idtac end. Abort. Lemma foo x y : S (S x) - (S (match y with O => O | S z => S z end)) = 0. simpl. match goal with |-(S x - (match y with O => _ | S _ => _ end) = 0) => idtac end. Abort. (* full control *) Arguments minus !n !m /. Lemma foo x y : S (S x) - S y = 0. simpl. match goal with |- (S x - y = 0) => idtac end. Abort. Lemma foo x y : S (S x) - (S (match y with O => O | S z => S z end)) = 0. simpl. match goal with |-(S x - (match y with O => _ | S _ => _ end) = 0) => idtac end. Abort. (* omitting /, that being immediately after the last ! is irrelevant *) Arguments minus !n !m. Lemma foo x y : S (S x) - S y = 0. simpl. match goal with |- (S x - y = 0) => idtac end. Abort. Lemma foo x y : S (S x) - (S (match y with O => O | S z => S z end)) = 0. simpl. match goal with |-(S x - (match y with O => _ | S _ => _ end) = 0) => idtac end. Abort. Definition pf (D1 C1 : Type) (f : D1 -> C1) (D2 C2 : Type) (g : D2 -> C2) := fun x => (f (fst x), g (snd x)). Delimit Scope foo_scope with F. Notation "@@" := nat (only parsing) : foo_scope. Notation "@@" := (fun x => x) (only parsing). Arguments pf {D1%_F C1%_type} f [D2 C2] g x : simpl never. Lemma foo x : @pf @@ nat @@ nat nat @@ x = pf @@ @@ x. Abort. Definition fcomp A B C f (g : A -> B) (x : A) : C := f (g x). (* fcomp is unfolded if applied to 6 args *) Arguments fcomp {A B C}%_type f g x /. Notation "f \o g" := (fcomp f g) (at level 50). Lemma foo (f g h : nat -> nat) x : pf (f \o g) h x = pf f h (g (fst x), snd x). simpl. match goal with |- (pf (f \o g) h x = _) => idtac end. case x; intros x1 x2. simpl. match goal with |- (pf (f \o g) h _ = pf f h _) => idtac end. unfold pf; simpl. match goal with |- (f (g x1), h x2) = (f (g x1), h x2) => idtac end. Abort. Definition volatile := fun x : nat => x. Arguments volatile / _. Lemma foo : volatile = volatile. simpl. match goal with |- (fun _ => _) = _ => idtac end. Abort. Set Implicit Arguments. Section S1. Variable T1 : Type. Section S2. Variable T2 : Type. Fixpoint f (x : T1) (y : T2) n (v : unit) m {struct n} : nat := match n, m with | 0,_ => 0 | S _, 0 => n | S n', S m' => f x y n' v m' end. Global Arguments f x y !n !v !m. Lemma foo x y n m : f x y (S n) tt m = f x y (S n) tt (S m). simpl. match goal with |- (f _ _ _ _ _ = f _ _ _ _ _) => idtac end. Abort. End S2. Lemma foo T x y n m : @f T x y (S n) tt m = @f T x y (S n) tt (S m). simpl. match goal with |- (f _ _ _ _ _ = f _ _ _ _ _) => idtac end. Abort. End S1. Arguments f : clear implicits and scopes. coq-8.20.0/test-suite/success/simple_congruence.v000066400000000000000000000042161466560755400220560ustar00rootroot00000000000000Axiom P : Prop. Definition Q := True -> P. (* bug 13778, 5394 *) Goal Q -> Q. Proof. intro. Fail congruence. simple congruence. Qed. Goal (not P) -> P -> False. Proof. simple congruence. Qed. Goal (P -> False) -> not P. Proof. simple congruence. Qed. Fixpoint slow (n: nat): bool := match n with | O => true | S m => andb (slow m) (slow (pred m)) end. Parameter f: nat -> nat. Definition foo(n b: nat): Prop := if slow n then (forall a, f a = f b) else True. (* fail fast symbolically *) (* bug 13189 *) Goal forall a b, foo 27 b -> f a = f b. Proof. Timeout 1 Fail Time simple congruence. (* Fail Timeout 1 Time congruence. *) Admitted. (* succeed fast symbolically *) (* bug 13189 *) Goal forall a b, foo 29 b -> f b = f a -> f a = f b. Proof. (* Fail Timeout 1 Time congruence. *) Timeout 1 simple congruence. Qed. Goal True -> not True -> P. Proof. simple congruence. Qed. (* consider final not *) Goal False -> not True. Proof. simple congruence. Qed. (* consider final not *) Goal not (true = false). Proof. simple congruence. Qed. Fixpoint stupid (n : nat) : unit := match n with | 0 => tt | S n => let () := stupid n in let () := stupid n in tt end. (* do not try to unify 23 with stupid 23 *) Goal 23 = 23 -> stupid 23 = stupid 23. Proof. Timeout 1 simple congruence. Qed. Inductive Fin : nat -> Set := | F1 : forall n : nat, Fin (S n) | FS : forall n : nat, Fin n -> Fin (S n). (* indexed inductives *) Goal forall n (f : Fin n), FS n f = F1 n -> False. Proof. intros n f H. simple congruence. Qed. Axiom R : Prop. Axiom R' : Prop. Goal (not P) -> not P. Proof. simple congruence. Qed. Goal (P -> False) -> P -> False. Proof. simple congruence. Qed. Goal (not (true = true)) -> P. Proof. simple congruence. Qed. Goal Q -> (Q = R) -> R. Proof. simple congruence. Qed. (* unfortunately, common usecase *) Goal P -> Q. Proof. Fail simple congruence. repeat intro. simple congruence. Qed. (* bug 13778 *) Goal R -> (R = not P) -> not P. Proof. Fail congruence. simple congruence. Qed. Definition per_unit := forall u, match u with tt => True end. (* bug 5394 *) Goal per_unit -> per_unit. Proof. simple congruence. Qed. coq-8.20.0/test-suite/success/somatching.v000066400000000000000000000027761466560755400205220ustar00rootroot00000000000000Goal forall A B C (p : forall (x : A) (y : B), C x y) (x : A) (y : B), True. Proof. intros A B C p x y. match type of p with | forall x y, @?F x y => pose F as C1 end. match type of p with | forall x y, @?F y x => pose F as C2 end. assert (C1 x y) as ?. assert (C2 y x) as ?. Abort. Goal forall A B C D (p : forall (x : A) (y : B) (z : C), D x y) (x : A) (y : B), True. Proof. intros A B C D p x y. match type of p with | forall x y z, @?F x y => pose F as C1 end. assert (C1 x y) as ?. Abort. Goal forall A B C D (p : forall (z : C) (x : A) (y : B), D x y) (x : A) (y : B), True. Proof. intros A B C D p x y. match type of p with | forall z x y, @?F x y => pose F as C1 end. assert (C1 x y) as ?. Abort. (** Those should fail *) Goal forall A B C (p : forall (x : A) (y : B), C x y) (x : A) (y : B), True. Proof. intros A B C p x y. Fail match type of p with | forall x, @?F x y => pose F as C1 end. Fail match type of p with | forall x y, @?F x x y => pose F as C1 end. Fail match type of p with | forall x y, @?F x => pose F as C1 end. Abort. (** This one is badly typed *) Goal forall A (B : A -> Type) (C : forall x, B x -> Type), (forall x y, C x y) -> True. Proof. intros A B C p. Fail match type of p with | forall x y, @?F y x => idtac end. Abort. Goal forall A (B : A -> Type) (C : Type) (D : forall x, B x -> Type), (forall x (z : C) y, D x y) -> True. Proof. intros A B C D p. match type of p with | forall x z y, @?F x y => idtac end. Abort. coq-8.20.0/test-suite/success/sort_poly.v000066400000000000000000000210771466560755400204130ustar00rootroot00000000000000Set Universe Polymorphism. Module Syntax. Fail Definition foo@{| Set < Set } := Set. Definition foo@{u| Set < u} := Type@{u}. Definition bar@{s | u | Set < u} := Type@{u}. Set Printing Universes. Print bar. Definition baz@{s | | } := Type@{s | Set}. Print baz. Definition potato@{s | + | } := Type. Check eq_refl : Prop = baz@{Prop | }. Inductive bob@{s| |} : Prop := . End Syntax. Module Reduction. Definition qsort@{s | u |} := Type@{s | u}. Monomorphic Universe U. Definition tU := Type@{U}. Definition qU := qsort@{Type | U}. Definition q1 := Eval lazy in qU. Check eq_refl : q1 = tU. Definition q2 := Eval vm_compute in qU. Check eq_refl : q2 = tU. Definition q3 := Eval native_compute in qU. Check eq_refl : q3 = tU. Definition exfalso@{s|u|} (A:Type@{s|u}) (H:False) : A := match H with end. Definition exfalsoVM := Eval vm_compute in exfalso@{Type|Set}. Definition exfalsoNative := Eval native_compute in exfalso@{Type|Set}. Fixpoint iter@{s|u|} (A:Type@{s|u}) (f:A -> A) n x := match n with | 0 => x | S k => iter A f k (f x) end. Definition iterType := Eval lazy in iter@{Type|_}. Definition iterSProp := Eval lazy in iter@{SProp|_}. End Reduction. Module Conversion. Inductive Box@{s|u|} (A:Type@{s|u}) := box (_:A). Definition t1@{s|u|} (A:Type@{s|u}) (x y : A) := box _ x. Definition t2@{s|u|} (A:Type@{s|u}) (x y : A) := box _ y. Definition t1'@{s|u|} (A:Type@{s|u}) (x y : A) := x. Definition t2'@{s|u|} (A:Type@{s|u}) (x y : A) := y. Fail Check eq_refl : t1 nat = t2 nat. Fail Check eq_refl : t1' nat = t2' nat. Check fun A:SProp => eq_refl : t1 A = t2 A. Check fun A:SProp => eq_refl : box _ (t1' A) = box _ (t2' A). Definition ignore@{s|u|} {A:Type@{s|u}} (x:A) := tt. Definition unfold_ignore@{s|u|} (A:Type@{s|u}) : ignore (t1 A) = ignore (t2 A) := eq_refl. Definition t (A:SProp) := Eval lazy in t1 A. Axiom v@{s| |} : forall (A:Type@{s|Set}), bool -> A. Fail Check fun P (x:P (v@{Type|} nat true)) => x : P (v nat false). Check fun (A:SProp) P (x:P (v A true)) => x : P (v A false). End Conversion. Module Inference. Definition zog@{s| |} (A:Type@{s|Set}) := A. (* implicit instance of zog gets a variable which then gets unified with s from the type of A *) Definition zag@{s| |} (A:Type@{s|Set}) := zog A. (* implicit type of A gets unified to Type@{s|Set} *) Definition zig@{s| |} A := zog@{s|} A. (* Unfortunately casting a hole to a sort (while typing A on the left of the arrow) produces a rigid univ level. It gets a constraint "= Set" but rigids don't get substituted away for (bad) reasons. This is why we need the 2 "+". *) Definition zig'@{s| + | +} A := A -> zog@{s|} A. (* different manually bound sort variables don't unify *) Fail Definition zog'@{s s'| |} (A:Type@{s|Set}) := zog@{s'|} A. End Inference. Module Inductives. Inductive foo1@{s| |} : Type@{s|Set} := . Fail Check foo1_sind. Fail Definition foo1_False@{s|+|+} (x:foo1@{s|}) : False := match x return False with end. (* XXX error message is bad *) Inductive foo2@{s| |} := Foo2 : Type@{s|Set} -> foo2. Check foo2_rect. Inductive foo3@{s| |} (A:Type@{s|Set}) := Foo3 : A -> foo3 A. Check foo3_rect. Fail Inductive foo4@{s|u v|v < u} : Type@{v} := C (_:Type@{s|u}). Inductive foo5@{s| |} (A:Type@{s|Set}) : Prop := Foo5 (_ : A). Definition foo5_ind'@{s| |} : forall (A : Type@{s|Set}) (P : Prop), (A -> P) -> foo5 A -> P := foo5_ind. (* TODO unify sort variable instead of failing *) Fail Definition foo5_Prop_rect (A:Prop) (P:foo5 A -> Type) (H : forall a, P (Foo5 A a)) (f : foo5 A) : P f := match f with Foo5 _ a => H a end. Definition foo5_Prop_rect (A:Prop) (P:foo5 A -> Type) (H : forall a, P (Foo5 A a)) (f : foo5@{Prop|} A) : P f := match f with Foo5 _ a => H a end. (* all sort poly output with nonzero contructors are squashed (avoid interfering with uip) *) Inductive foo6@{s| |} : Type@{s|Set} := Foo6. Fail Check foo6_sind. Fail Definition foo6_rect (P:foo6 -> Type) (H : P Foo6) (f : foo6) : P f := match f with Foo6 => H end. (* XXX error message is pretty bad *) Definition foo6_prop_rect (P:foo6 -> Type) (H : P Foo6) (f : foo6@{Prop|}) : P f := match f with Foo6 => H end. Definition foo6_type_rect (P:foo6 -> Type) (H : P Foo6) (f : foo6@{Type|}) : P f := match f with Foo6 => H end. Definition foo6_qsort_rect@{s|u|} (P:foo6 -> Type@{s|u}) (H : P Foo6) (f : foo6@{s|}) : P f := match f with Foo6 => H end. Fail Definition foo6_2qsort_rect@{s s'|u|} (P:foo6 -> Type@{s|u}) (H : P Foo6) (f : foo6@{s'|}) : P f := match f with Foo6 => H end. Inductive foo7@{s| |} : Type@{s|Set} := Foo7_1 | Foo7_2. Fail Check foo7_sind. Fail Check foo7_ind. Definition foo7_prop_ind (P:foo7 -> Prop) (H : P Foo7_1) (H' : P Foo7_2) (f : foo7@{Prop|}) : P f := match f with Foo7_1 => H | Foo7_2 => H' end. Fail Definition foo7_prop_rect (P:foo7 -> Type) (H : P Foo7_1) (H' : P Foo7_2) (f : foo7@{Prop|}) : P f := match f with Foo7_1 => H | Foo7_2 => H' end. Set Primitive Projections. Set Warnings "+records". (* the SProp instantiation may not be primitive so the whole thing must be nonprimitive *) Fail Record R1@{s| |} : Type@{s|Set} := {}. (* the Type instantiation may not be primitive *) Fail Record R2@{s| |} (A:SProp) : Type@{s|Set} := { R2f1 : A }. (* R3@{SProp Type|} may not be primitive *) Fail Record R3@{s s'| |} (A:Type@{s|Set}) : Type@{s'|Set} := { R3f1 : A }. Record R4@{s| |} (A:Type@{s|Set}) : Type@{s|Set} := { R4f1 : A}. (* non SProp instantiation must be squashed *) Fail Record R5@{s| |} (A:Type@{s|Set}) : SProp := { R5f1 : A}. Fail #[warnings="-non-primitive-record"] Record R5@{s| |} (A:Type@{s|Set}) : SProp := { R5f1 : A}. #[warnings="-non-primitive-record,-cannot-define-projection"] Record R5@{s| |} (A:Type@{s|Set}) : SProp := { R5f1 : A}. Fail Check R5f1. Definition R5f1_sprop (A:SProp) (r:R5 A) : A := let (f) := r in f. Fail Definition R5f1_prop (A:Prop) (r:R5 A) : A := let (f) := r in f. Record R6@{s| |} (A:Type@{s|Set}) := { R6f1 : A; R6f2 : nat }. Check fun (A:SProp) (x y : R6 A) => eq_refl : Conversion.box _ x.(R6f1 _) = Conversion.box _ y.(R6f1 _). Fail Check fun (A:Prop) (x y : R6 A) => eq_refl : Conversion.box _ x.(R6f1 _) = Conversion.box _ y.(R6f1 _). Fail Check fun (A:SProp) (x y : R6 A) => eq_refl : Conversion.box _ x.(R6f2 _) = Conversion.box _ y.(R6f2 _). #[projections(primitive=no)] Record R7@{s| |} (A:Type@{s|Set}) := { R7f1 : A; R7f2 : nat }. Check R7@{SProp|} : SProp -> Set. Check R7@{Type|} : Set -> Set. Inductive sigma@{s|u v|} (A:Type@{s|u}) (B:A -> Type@{s|v}) : Type@{s|max(u,v)} := pair : forall x : A, B x -> sigma A B. Definition sigma_srect@{s|k +|} A B (P : sigma@{s|_ _} A B -> Type@{s|k}) (H : forall x b, P (pair _ _ x b)) (s:sigma A B) : P s := match s with pair _ _ x b => H x b end. (* squashed because positive type with >0 constructors *) Fail Definition sigma_srect'@{s sk|k +|} A B (P : sigma@{s|_ _} A B -> Type@{sk|k}) (H : forall x b, P (pair _ _ x b)) (s:sigma A B) : P s := match s with pair _ _ x b => H x b end. (* even though it's squashed, we can still define the projections *) Definition pr1@{s|+|} {A B} (s:sigma@{s|_ _} A B) : A := match s with pair _ _ x _ => x end. Definition pr2@{s|+|} {A B} (s:sigma@{s|_ _} A B) : B (pr1 s) := match s with pair _ _ _ y => y end. (* but we can't prove eta *) Inductive seq@{s|u|} (A:Type@{s|u}) (a:A) : A -> Prop := seq_refl : seq A a a. Arguments seq_refl {_ _}. Definition eta@{s|+|+} A B (s:sigma@{s|_ _} A B) : seq _ s (pair A B (pr1 s) (pr2 s)). Proof. Fail destruct s. Abort. (* sigma as a primitive record works better *) Record Rsigma@{s|u v|} (A:Type@{s|u}) (B:A -> Type@{s|v}) : Type@{s|max(u,v)} := Rpair { Rpr1 : A; Rpr2 : B Rpr1 }. (* match desugared to primitive projections using definitional eta *) Definition Rsigma_srect@{s sk|k +|} A B (P : Rsigma@{s|_ _} A B -> Type@{sk|k}) (H : forall x b, P (Rpair _ _ x b)) (s:Rsigma A B) : P s := match s with Rpair _ _ x b => H x b end. (* sort polymorphic exists (we could also make B sort poly) can't be a primitive record since the first projection isn't defined at all sorts *) Inductive sexists@{s|u|} (A:Type@{s|u}) (B:A -> Prop) : Prop := sexist : forall a:A, B a -> sexists A B. (* we can eliminate to Prop *) Check sexists_ind. End Inductives. coq-8.20.0/test-suite/success/sort_poly_extraction.v000066400000000000000000000010261466560755400226430ustar00rootroot00000000000000Require Extraction. Set Universe Polymorphism. Definition foo@{s| |} := tt. Definition bar := foo@{Prop|}. Fail Extraction bar. (* the actual problem only appears once we have inductives with sort poly output: *) Inductive Pair@{s|u|} (A:Type@{s|u}) : Type@{s|u} := pair : A -> A -> Pair A. Definition use_pair@{s|+|} A (k:A->nat) (x:Pair@{s|_} A) := k (match x with pair _ x _ => x end). Definition make_pair := pair@{Prop|_} _ I I. Definition hell := use_pair True (fun _ => 0) make_pair. Fail Recursive Extraction hell. coq-8.20.0/test-suite/success/specialize.v000066400000000000000000000130521466560755400205030ustar00rootroot00000000000000 Goal forall a b c : nat, a = b -> b = c -> forall d, a+d=c+d. intros. (* "compatibility" mode: specializing a global name means a kind of generalize *) specialize eq_trans. intros _. specialize eq_trans with (1:=H)(2:=H0). intros _. specialize eq_trans with (x:=a)(y:=b)(z:=c). intros _. specialize eq_trans with (1:=H)(z:=c). intros _. specialize eq_trans with nat a b c. intros _. specialize (@eq_trans nat). intros _. specialize (@eq_trans _ a b c). intros _. specialize (eq_trans (x:=a)). intros _. specialize (eq_trans (x:=a)(y:=b)). intros _. specialize (eq_trans H H0). intros _. specialize (eq_trans H0 (z:=b)). intros _. (* incomplete bindings: y is left quantified and z is instantiated. *) specialize eq_trans with (x:=a)(z:=c). intro h. (* y can be instantiated now *) specialize h with (y:=b). (* z was instantiated above so this must fail. *) Fail specialize h with (z:=c). clear h. (* incomplete bindings: 1st dep hyp is instantiated thus A, x and y instantiated too. *) specialize eq_trans with (1:=H). intro h. (* 2nd dep hyp can be instantiated now, which instatiates z too. *) specialize h with (1:=H0). (* checking that there is no more products in h. *) match type of h with | _ = _ => idtac | _ => fail "specialize test failed: hypothesis h should be an equality at this point" end. clear h. (* local "in place" specialization *) assert (Eq:=eq_trans). specialize Eq. specialize Eq with (1:=H)(2:=H0). Undo. specialize Eq with (x:=a)(y:=b)(z:=c). Undo. specialize Eq with (1:=H)(z:=c). Undo. specialize Eq with nat a b c. Undo. specialize (Eq nat). Undo. specialize (Eq _ a b c). Undo. (* no implicit argument for Eq, hence no (Eq (x:=a)) *) specialize (Eq _ _ _ _ H H0). Undo. specialize (Eq _ _ _ b H0). Undo. (* incomplete binding *) specialize Eq with (y:=b). (* A and y have been instantiated so this works *) specialize (Eq _ _ H H0). Undo 2. (* incomplete binding (dependent) *) specialize Eq with (1:=H). (* A, x and y have been instantiated so this works *) specialize (Eq _ H0). Undo 2. (* incomplete binding (dependent) *) specialize Eq with (1:=H) (2:=H0). (* A, x and y have been instantiated so this works *) match type of Eq with | _ = _ => idtac | _ => fail "specialize test failed: hypothesis Eq should be an equality at this point" end. Undo 2. (* (** strange behavior to inspect more precisely *) (* 1) proof aspect : let H:= ... in (fun H => ..) H presque ok... *) (* 2) echoue moins lorsque zero premise de mangé *) specialize eq_trans with (1:=Eq). (* mal typé !! *) (* 3) Seems fixed.*) specialize eq_trans with _ a b c. intros _. (* Anomaly: Evar ?88 was not declared. Please report. *) *) Abort. (* Test use of pose proof and assert as a specialize *) Goal True -> (True -> 0=0) -> False -> 0=0. intros H0 H H1. pose proof (H I) as H. (* Check that the hypothesis is in 2nd position by removing the top one *) match goal with H:_ |- _ => clear H end. match goal with H:_ |- _ => exact H end. Qed. Goal True -> (True -> 0=0) -> False -> 0=0. intros H0 H H1. assert (H:=H I). (* Check that the hypothesis is in 2nd position by removing the top one *) match goal with H:_ |- _ => clear H end. match goal with H:_ |- _ => exact H end. Qed. (* let ins should be supported int he type of the specialized hypothesis *) Axiom foo: forall (m1:nat) (m2: nat), let n := 2 * m1 in (m1 = m2 -> False). Goal False. pose proof foo as P. assert (2 = 2) as A by reflexivity. (* specialize P with (m2:= 2). *) specialize P with (1 := A). match type of P with | let n := 2 * 2 in False => idtac | _ => fail "test failed" end. assumption. Qed. (* Another more subtle test on letins: they should not interfere with foralls. *) Goal forall (P: forall a c:nat, let b := c in let d := 1 in forall n : a = d, a = c+1), True. intros P. specialize P with (1:=eq_refl). match type of P with | forall c : nat, let f := c in let d := 1 in 1 = c + 1 => idtac | _ => fail "test failed" end. constructor. Qed. (* Test specialize as *) Goal (forall x, x=0) -> 1=0. intros. specialize (H 1) as ->. reflexivity. Qed. (* A test from corn *) Goal (forall x y, x=0 -> y=0 -> True) -> True. intros. specialize (fun z => H 0 z eq_refl). exact (H 0 eq_refl). Qed. Module bug_17322. Axiom key : Type. Axiom value : Type. Axiom eqb : key -> key -> bool. Axiom remove : list value -> key -> list value. Axiom sorted : list value -> bool. Axiom lookup : list value -> key -> value. Goal forall (l : list value) (k : key), (sorted l = true -> forall k' : key, eqb k k' = false -> lookup (remove l k') k = lookup l k) -> sorted l = true -> False . Proof. intros l k IHl ST. specialize IHl with (1 := ST). Abort. End bug_17322. Module bug_17322_2. Axiom tuple : Type. Axiom mem : Type. Axiom unchecked_store_bytes : tuple -> mem. Axiom load_bytes : mem -> Prop. Goal forall (IHn : forall (m' : mem) (w : tuple), unchecked_store_bytes w = m' -> load_bytes m' -> True), True. Proof. intros. Fail specialize IHn with (1 := eq_refl). (* After #17322 this fails with In environment IHn : forall (m' : mem) (w : tuple), unchecked_store_bytes w = m' -> load_bytes m' -> True m' : mem w : tuple Unable to unify "?t" with "w" (cannot instantiate "?t" because "w" is not in its scope: available arguments are "IHn"). Previously it was leaving w as an unresolved evar, producing the hypothesis IHn : load_bytes (unchecked_store_bytes ?w) -> True The correct behaviour should probably to requantify on w as IHn : forall w, load_bytes (unchecked_store_bytes w) -> True *) Abort. End bug_17322_2. coq-8.20.0/test-suite/success/sprop.v000066400000000000000000000126641466560755400175260ustar00rootroot00000000000000(* -*- mode: coq; coq-prog-args: ("-allow-sprop") -*- *) Set Primitive Projections. Set Warnings "+non-primitive-record". Set Warnings "+bad-relevance". Check SProp. Definition iUnit : SProp := forall A : SProp, A -> A. Definition itt : iUnit := fun A a => a. Definition iUnit_irr (P : iUnit -> Type) (x y : iUnit) : P x -> P y := fun v => v. Definition iSquash (A:Type) : SProp := forall P : SProp, (A -> P) -> P. Definition isquash A : A -> iSquash A := fun a P f => f a. Definition iSquash_rect A (P : iSquash A -> SProp) (H : forall x : A, P (isquash A x)) : forall x : iSquash A, P x := fun x => x (P x) (H : A -> P x). Fail Check (fun A : SProp => A : Type). Lemma foo : Prop. Proof. pose (fun A : SProp => ltac:(exact_no_check A): Type); exact True. Fail Qed. Abort. (* define evar as product *) Check (fun (f:(_:SProp)) => f _). Inductive sBox (A:SProp) : Prop := sbox : A -> sBox A. Definition uBox := sBox iUnit. Definition sBox_irr A (x y : sBox A) : x = y. Proof. Fail reflexivity. destruct x as [x], y as [y]. reflexivity. Defined. (* Primitive record with all fields in SProp has the eta property of SProp so must be SProp. *) Fail Record rBox (A:SProp) : Prop := rmkbox { runbox : A }. Section Opt. Local Unset Primitive Projections. Record rBox (A:SProp) : Prop := rmkbox { runbox : A }. End Opt. (* Check that defining as an emulated record worked *) Check runbox. (* Check that it doesn't have eta *) Fail Check (fun (A : SProp) (x : rBox A) => eq_refl : x = @rmkbox _ (@runbox _ x)). Inductive sEmpty : SProp := . Inductive sUnit : SProp := stt. Inductive BIG : SProp := foo | bar. Inductive Squash (A:Type) : SProp := squash : A -> Squash A. Definition BIG_flip : BIG -> BIG. Proof. intros [|]. exact bar. exact foo. Defined. Inductive pb : Prop := pt | pf. Definition pb_big : pb -> BIG. Proof. intros [|]. exact foo. exact bar. Defined. Fail Definition big_pb (b:BIG) : pb := match b return pb with foo => pt | bar => pf end. Inductive which_pb : pb -> SProp := | is_pt : which_pb pt | is_pf : which_pb pf. Fail Definition pb_which b (w:which_pb b) : bool := match w with | is_pt => true | is_pf => false end. (* Non primitive because no arguments, but maybe we should allow it for sprops? *) Fail Record UnitRecord : SProp := {}. Section Opt. Local Unset Primitive Projections. Record UnitRecord' : SProp := {}. End Opt. Fail Scheme Induction for UnitRecord' Sort Set. Record sProd (A B : SProp) : SProp := sPair { sFst : A; sSnd : B }. Scheme Induction for sProd Sort Set. Unset Primitive Projections. Record sProd' (A B : SProp) : SProp := sPair' { sFst' : A; sSnd' : B }. Set Primitive Projections. Fail Scheme Induction for sProd' Sort Set. Inductive Istrue : bool -> SProp := istrue : Istrue true. Definition Istrue_sym (b:bool) := if b then sUnit else sEmpty. Definition Istrue_to_sym b (i:Istrue b) : Istrue_sym b := match i with istrue => stt end. (* We don't need primitive elimination to relevant types for this *) Definition Istrue_rec (P:forall b, Istrue b -> Set) (H:P true istrue) b (i:Istrue b) : P b i. Proof. destruct b. - exact_no_check H. - apply sEmpty_rec. apply Istrue_to_sym in i. exact i. Defined. Check (fun P v (e:Istrue true) => eq_refl : Istrue_rec P v _ e = v). Record Truepack := truepack { trueval :> bool; trueprop : Istrue trueval }. Definition Truepack_eta (x : Truepack) (i : Istrue x) : x = truepack x i := @eq_refl Truepack x. Class emptyclass : SProp := emptyinstance : forall A:SProp, A. (** Sigma in SProp can be done through Squash and relevant sigma. *) Definition sSigma (A:SProp) (B:A -> SProp) : SProp := Squash (@sigT (rBox A) (fun x => rBox (B (runbox _ x)))). Definition spair (A:SProp) (B:A->SProp) (x:A) (y:B x) : sSigma A B := squash _ (existT _ (rmkbox _ x) (rmkbox _ y)). Definition spr1 (A:SProp) (B:A->SProp) (p:sSigma A B) : A := let 'squash _ (existT _ x y) := p in runbox _ x. Definition spr2 (A:SProp) (B:A->SProp) (p:sSigma A B) : B (spr1 A B p) := let 'squash _ (existT _ x y) := p return B (spr1 A B p) in runbox _ y. (* it's SProp so it computes properly *) (** Fixpoints on SProp values are only allowed to produce SProp results *) Inductive sAcc (x:nat) : SProp := sAcc_in : (forall y, y < x -> sAcc y) -> sAcc x. Definition sAcc_inv x (s:sAcc x) : forall y, y < x -> sAcc y. Proof. destruct s as [H]. exact H. Defined. Section sFix_fail. Variable P : nat -> Type. Variable F : forall x:nat, (forall y:nat, y < x -> P y) -> P x. Fail Fixpoint sFix (x:nat) (a:sAcc x) {struct a} : P x := F x (fun (y:nat) (h: y < x) => sFix y (sAcc_inv x a y h)). End sFix_fail. Section sFix. Variable P : nat -> SProp. Variable F : forall x:nat, (forall y:nat, y < x -> P y) -> P x. Fixpoint sFix (x:nat) (a:sAcc x) {struct a} : P x := F x (fun (y:nat) (h: y < x) => sFix y (sAcc_inv x a y h)). End sFix. (** Relevance repairs *) Definition fix_relevance : _ -> nat := fun _ : iUnit => 0. Definition relevance_unfixed := fun (A:SProp) (P:A -> Prop) x y (v:P x) => v : P y. (* The kernel is fine *) Definition relevance_unfixed_bypass := fun (A:SProp) (P:A -> Prop) x y (v:P x) => ltac:(exact_no_check v) : P y. (* Check that VM/native properly keep the relevance of the predicate in the case info (bad-relevance warning as error otherwise) *) Definition vm_rebuild_case := Eval vm_compute in eq_sind. Require Import ssreflect. Goal forall T : SProp, T -> True. Proof. move=> T +. intros X;exact I. Qed. coq-8.20.0/test-suite/success/sprop_fast.v000066400000000000000000000007701466560755400205360ustar00rootroot00000000000000Fixpoint big n : unit := match n with 0 => tt | S n => match big n with tt => big n end end. Inductive squash (A : Type) : SProp := Squash : A -> squash A. Inductive box (A : SProp) : Type := Box : A -> box A. (* If this is ever unfolded, this will explode *) Goal Box _ (Squash _ (big 50)) = Box _ (Squash _ tt). Proof. reflexivity. Qed. Definition SquashC := Squash. (* If this is ever unfolded, this will explode *) Goal Box _ (SquashC _ (big 50)) = Box _ (SquashC _ tt). Proof. reflexivity. Qed. coq-8.20.0/test-suite/success/sprop_hcons.v000066400000000000000000000025421466560755400207120ustar00rootroot00000000000000(* -*- coq-prog-args: ("-allow-sprop"); -*- *) (* A bug due to bad hashconsing of case info *) Inductive sBox (A : SProp) : Type := sbox : A -> sBox A. Definition ubox {A : SProp} (bA : sBox A) : A := match bA with sbox _ X => X end. Inductive sle : nat -> nat -> SProp := sle_0 : forall n, sle 0 n | sle_S : forall n m : nat, sle n m -> sle (S n) (S m). Definition sle_Sn (n : nat) : sle n (S n). Proof. induction n; constructor; auto. Defined. Definition sle_trans {n m p} (H : sle n m) (H': sle m p) : sle n p. Proof. revert H'. revert p. induction H. - intros p H'. apply sle_0. - intros p H'. inversion H'. apply ubox. subst. apply sbox. apply sle_S. apply IHsle;auto. Defined. Lemma sle_Sn_m {n m} : sle n m -> sle n (S m). Proof. intros H. destruct n. - constructor. - constructor;auto. assert (H1 : sle n (S n)) by apply sle_Sn. exact (sle_trans H1 H ). Defined. Definition sle_Sn_Sm {n m} : sle (S n) (S m) -> sle n m. Proof. intros H. inversion H. apply ubox. subst. apply sbox. exact H2. Qed. Notation "g ∘ f" := (sle_trans g f) (at level 40). Lemma bazz q0 m (f : sle (S q0) (S m)) : sbox _ (sle_Sn q0 ∘ f) = sbox _ (sle_Sn_m (sle_Sn_Sm f)). Proof. reflexivity. (* used to fail *) (* NB: exact eq_refl succeeded even with the bug so no guarantee that this test will continue to test the right thing. *) Qed. coq-8.20.0/test-suite/success/sprop_uip.v000066400000000000000000000101241466560755400203700ustar00rootroot00000000000000 Set Allow StrictProp. Set Definitional UIP. Set Warnings "+bad-relevance". (** Case inversion, conversion and universe polymorphism. *) Set Universe Polymorphism. Inductive IsTy@{i j} : Type@{j} -> SProp := isty : IsTy Type@{i}. Definition IsTy_rec_red@{i j+} (P:forall T : Type@{j}, IsTy@{i j} T -> Set) v (e:IsTy@{i j} Type@{i}) : IsTy_rec P v _ e = v := eq_refl. (** Identity! Currently we have UIP. *) Inductive seq {A} (a:A) : A -> SProp := srefl : seq a a. Definition transport {A} (P:A -> Type) {x y} (e:seq x y) (v:P x) : P y := match e with srefl _ => v end. Definition transport_refl {A} (P:A -> Type) {x} (e:seq x x) v : transport P e v = v := @eq_refl (P x) v. Definition id_unit (x : unit) := x. Definition transport_refl_id {A} (P : A -> Type) {x : A} (u : P x) : P (transport (fun _ => A) (srefl _ : seq (id_unit tt) tt) x) := u. (** We don't ALWAYS reduce (this uses a constant transport so that the equation is well-typed) *) Fail Definition transport_block A B (x y:A) (e:seq x y) v : transport (fun _ => B) e v = v := @eq_refl B v. Inductive sBox (A:SProp) : Prop := sbox : A -> sBox A. Definition transport_refl_box (A:SProp) P (x y:A) (e:seq (sbox A x) (sbox A y)) v : transport P e v = v := eq_refl. (** TODO? add tests for binders which aren't lambda. *) Definition transport_box := Eval lazy in (fun (A:SProp) P (x y:A) (e:seq (sbox A x) (sbox A y)) v => transport P e v). Lemma transport_box_ok : transport_box = fun A P x y e v => v. Proof. unfold transport_box. match goal with |- ?x = ?x => reflexivity end. Qed. (** Play with UIP *) Lemma of_seq {A:Type} {x y:A} (p:seq x y) : x = y. Proof. destruct p. reflexivity. Defined. Lemma to_seq {A:Type} {x y:A} (p: x = y) : seq x y. Proof. destruct p. reflexivity. Defined. Lemma eq_srec (A:Type) (x y:A) (P:x=y->Type) : (forall e : seq x y, P (of_seq e)) -> forall e, P e. Proof. intros H e. destruct e. apply (H (srefl _)). Defined. Lemma K : forall {A x} (p:x=x:>A), p = eq_refl. Proof. intros A x. apply eq_srec. intros;reflexivity. Defined. Definition K_refl : forall {A x}, @K A x eq_refl = eq_refl := fun A x => eq_refl. Section funext. Variable sfunext : forall {A B} (f g : A -> B), (forall x, seq (f x) (g x)) -> seq f g. Lemma funext {A B} (f g : A -> B) (H:forall x, (f x) = (g x)) : f = g. Proof. apply of_seq,sfunext;intros x;apply to_seq,H. Defined. Definition funext_refl A B (f : A -> B) : funext f f (fun x => eq_refl) = eq_refl := eq_refl. End funext. (* test reductions on inverted cases *) (* first check production of correct blocked cases *) Definition lazy_seq_rect := Eval lazy in seq_rect. Definition vseq_rect := Eval vm_compute in seq_rect. Definition native_seq_rect := Eval native_compute in seq_rect. Definition cbv_seq_rect := Eval cbv in seq_rect. (* check it reduces according to indices *) Ltac reset := match goal with H : _ |- _ => change (match H with srefl _ => False end) end. Ltac check := match goal with |- False => idtac end. Lemma foo (H:seq 0 0) : False. Proof. reset. Fail check. (* check that "reset" and "check" actually do something *) lazy; check; reset. (* TODO *) vm_compute. Fail check. native_compute. Fail check. cbv. Fail check. cbn. Fail check. simpl. Fail check. Abort. Module HoTTStyle. (* a small proof which tests destruct in a tricky case *) Definition ap {A B} (f:A -> B) {x y} (e : seq x y) : seq (f x) (f y). Proof. destruct e. reflexivity. Defined. Section S. Context (A : Type) (B : Type) (f : A -> B) (g : B -> A) (section : forall a, seq (g (f a)) a) (retraction : forall b, seq (f (g b)) b). Lemma bla (P : B -> Type) (a : A) (F : forall a, P (f a)) : seq_rect _ (f (g (f a))) (fun a _ => P a) (F (g (f a))) (f a) (retraction (f a)) = F a. Proof. lazy. change (retraction (f a)) with (ap f (section a)). destruct (section a). reflexivity. Qed. End S. End HoTTStyle. (* check that extraction doesn't fall apart on matches with special reduction *) Require Extraction. Extraction seq_rect. coq-8.20.0/test-suite/success/ssrpattern.v000066400000000000000000000010021466560755400205500ustar00rootroot00000000000000Require Import ssrmatching. (*Set Debug SsrMatching.*) Tactic Notation "at" "[" ssrpatternarg(pat) "]" tactic(t) := let name := fresh in let def_name := fresh in ssrpattern pat; intro name; pose proof (refl_equal name) as def_name; unfold name at 1 in def_name; t def_name; [ rewrite <- def_name | idtac.. ]; clear name def_name. Lemma test (H : True -> True -> 3 = 7) : 28 = 3 * 4. Proof. at [ X in X * 4 ] ltac:(fun place => rewrite -> H in place). - reflexivity. - trivial. - trivial. Qed. coq-8.20.0/test-suite/success/strategy.v000066400000000000000000000037151466560755400202220ustar00rootroot00000000000000Notation aid := (@id) (only parsing). Notation idn := id (only parsing). Ltac unfold_id := unfold id. Fixpoint fact (n : nat) := match n with | 0 => 1 | S n => (S n) * fact n end. Opaque id. Goal id (fact 100) = fact 100. Strategy expand [id]. Time Timeout 5 reflexivity. (* should be instant *) (* Finished transaction in 0. secs (0.u,0.s) (successful) *) Time Timeout 5 Defined. (* Finished transaction in 0.001 secs (0.u,0.s) (successful) *) Goal True. let x := smart_global:(id) in unfold x. let x := smart_global:(aid) in unfold x. let x := smart_global:(idn) in unfold x. Abort. Goal id 0 = 0. Opaque id. assert_fails unfold_id. Transparent id. assert_succeeds unfold_id. Opaque id. Strategy 0 [id]. assert_succeeds unfold_id. Strategy 1 [id]. assert_succeeds unfold_id. Strategy -1 [id]. assert_succeeds unfold_id. Strategy opaque [id]. assert_fails unfold_id. Strategy transparent [id]. assert_succeeds unfold_id. Opaque id. Strategy expand [id]. assert_succeeds unfold_id. reflexivity. Qed. Goal id 0 = 0. Opaque aid. assert_fails unfold_id. Transparent aid. assert_succeeds unfold_id. Opaque aid. Strategy 0 [aid]. assert_succeeds unfold_id. Strategy 1 [aid]. assert_succeeds unfold_id. Strategy -1 [aid]. assert_succeeds unfold_id. Strategy opaque [aid]. assert_fails unfold_id. Strategy transparent [aid]. assert_succeeds unfold_id. Opaque aid. Strategy expand [aid]. assert_succeeds unfold_id. reflexivity. Qed. Goal id 0 = 0. Opaque idn. assert_fails unfold_id. Transparent idn. assert_succeeds unfold_id. Opaque idn. Strategy 0 [idn]. assert_succeeds unfold_id. Strategy 1 [idn]. assert_succeeds unfold_id. Strategy -1 [idn]. assert_succeeds unfold_id. Strategy opaque [idn]. assert_fails unfold_id. Strategy transparent [idn]. assert_succeeds unfold_id. Opaque idn. Strategy expand [idn]. assert_succeeds unfold_id. reflexivity. Qed. coq-8.20.0/test-suite/success/strong_and_binary_induction.v000066400000000000000000000046611466560755400241370ustar00rootroot00000000000000(** This file is meant to test that the induction lemmas introduced in #18628: - [binary_induction] and [strong_induction_le] in PeanoNat - [strong_induction_le] in BinNat work with the [induction] tactic. *) From Coq.Arith Require Import PeanoNat. From Coq.NArith Require Import BinNat. Open Scope nat_scope. Lemma land_diag_binary_induction_test n : Nat.land n n = n. Proof. induction n as [| n IH | n IH] using Nat.binary_induction. - rewrite Nat.land_0_l; reflexivity. - rewrite Nat.land_even_l, Nat.div2_even, IH; reflexivity. - rewrite Nat.land_odd_l, Nat.odd_odd, Nat.div2_odd', IH; reflexivity. Qed. Lemma land_diag_strong_induction_test n : Nat.land n n = n. Proof. induction n as [| n IH] using Nat.strong_induction_le. - rewrite Nat.land_0_l; reflexivity. - destruct (Nat.Even_or_Odd n) as [[k ->] | [k ->]]. + rewrite <-Nat.add_1_r, Nat.land_odd_l, Nat.div2_odd', IH, Nat.odd_odd; [reflexivity |]. apply Nat.le_mul_l; discriminate. + replace (S (2 * k + 1)) with (2 * (k + 1)); cycle 1. { rewrite Nat.mul_add_distr_l, <-Nat.add_succ_r, Nat.mul_1_r; reflexivity. } rewrite Nat.land_even_l, Nat.div2_even, IH; [reflexivity |]. apply Nat.add_le_mono; [| exact (Nat.le_refl _)]. apply Nat.le_mul_l; discriminate. Qed. Close Scope nat_scope. Open Scope N_scope. (* Of course, this example is articifial in N. However, this shows that the previous proof with almost no modifications. *) Lemma land_diag_strong_induction_test_N n : N.land n n = n. Proof. induction n as [| n IH] using N.strong_induction_le. - rewrite N.land_0_l; reflexivity. - destruct (N.Even_or_Odd n) as [[k ->] | [k ->]]. + rewrite <-N.add_1_r, N.land_odd_l, N.div2_odd', IH, N.odd_odd; [reflexivity |]. apply N.le_mul_l; discriminate. + replace (N.succ (2 * k + 1)) with (2 * (k + 1)); cycle 1. { rewrite N.mul_add_distr_l, <-N.add_succ_r, N.mul_1_r; reflexivity. } rewrite N.land_even_l, N.div2_even, IH; [reflexivity |]. apply N.add_le_mono; [| exact (N.le_refl _)]. apply N.le_mul_l; discriminate. Qed. (* [binary_induction] is also available for [N] *) Lemma land_diag_binary_induction_test_N n : N.land n n = n. Proof. induction n as [| n IH | n IH] using N.binary_induction. - rewrite N.land_0_l; reflexivity. - rewrite N.land_even_l, N.div2_even, IH; reflexivity. - rewrite N.land_odd_l, N.odd_odd, N.div2_odd', IH; reflexivity. Qed. coq-8.20.0/test-suite/success/subprf_commands.v000066400000000000000000000003311466560755400215310ustar00rootroot00000000000000Check True. Goal True /\ True. Check True. 1:Check True. 1: idtac. 1:{ admit. } Abort. Require Import Ltac2.Ltac2. Check True. Goal True /\ True. Check True. 1:Check True. 1: (). 1:{ admit. } Abort. coq-8.20.0/test-suite/success/subst.v000066400000000000000000000017301466560755400175130ustar00rootroot00000000000000(* Test various subtleties of the "subst" tactics *) (* Should proceed from left to right (see #4222) *) Goal forall x y, x = y -> x = 3 -> y = 2 -> x = y. intros. subst. change (3 = 2) in H1. change (3 = 3). Abort. (* Should work with "x = y" and "x = t" equations (see #4214, failed in 8.4) *) Goal forall x y, x = y -> x = 3 -> x = y. intros. subst. change (3 = 3). Abort. (* Should substitute cycles once, until a recursive equation is obtained *) (* (failed in 8.4) *) Goal forall x y, x = S y -> y = S x -> x = y. intros. subst. change (y = S (S y)) in H0. change (S y = y). Abort. (* A bug revealed by OCaml 4.03 warnings *) (* fixes in 4e3d464 and 89ec88f for v8.5, 4e3d4646 and 89ec88f1e for v8.6 *) Goal forall y, let x:=0 in y=x -> y=y. intros * H; (* This worked as expected *) subst. Fail clear H. Abort. Goal forall y, let x:=0 in x=y -> y=y. intros * H; (* Before the fix, this unfolded x instead of substituting y and erasing H *) subst. Fail clear H. Abort. coq-8.20.0/test-suite/success/tac_wit_ref.v000066400000000000000000000001641466560755400206410ustar00rootroot00000000000000Tactic Notation "foo" reference(n) := idtac n. Goal forall n : nat, n = 0. Proof. intros n. foo nat. foo n. Abort. coq-8.20.0/test-suite/success/telescope_canonical.v000066400000000000000000000045311466560755400223470ustar00rootroot00000000000000Structure Inner := mkI { is :> Type }. Structure Outer := mkO { os :> Inner }. Canonical Structure natInner := mkI nat. Canonical Structure natOuter := mkO natInner. Definition hidden_nat := nat. Axiom P : forall S : Outer, is (os S) -> Prop. Lemma test1 (n : hidden_nat) : P _ n. Admitted. Structure Pnat := mkP { getp : nat }. Definition my_getp := getp. Axiom W : nat -> Prop. (* Fix *) Canonical Structure add1Pnat n := mkP (plus n 1). Definition test_fix n := (refl_equal _ : W (my_getp _) = W (n + 1)). (* Case *) Definition pred n := match n with 0 => 0 | S m => m end. Canonical Structure predSS n := mkP (pred n). Definition test_case x := (refl_equal _ : W (my_getp _) = W (pred x)). Fail Definition test_case' := (refl_equal _ : W (my_getp _) = W (pred 0)). Canonical Structure letPnat' := mkP 0. Definition letin := (let n := 0 in n). Definition test4 := (refl_equal _ : W (getp _) = W letin). Definition test41 := (refl_equal _ : W (my_getp _) = W letin). Definition letin2 (x : nat) := (let n := x in n). Canonical Structure letPnat'' x := mkP (letin2 x). Definition test42 x := (refl_equal _ : W (my_getp _) = W (letin2 x)). Fail Definition test42' x := (refl_equal _ : W (my_getp _) = W x). Structure Morph := mkM { f :> nat -> nat }. Definition my_f := f. Axiom Q : (nat -> nat) -> Prop. (* Lambda *) Canonical Structure addMorh x := mkM (plus x). Definition test_lam x := (refl_equal _ : Q (my_f _) = Q (plus x)). Definition test_lam' := (refl_equal _ : Q (my_f _) = Q (plus 0)). (* Simple tests to justify Sort and Prod as "named". They are already normal, so they cannot loose their names, but still... *) Structure Sot := mkS { T : Type }. Axiom R : Type -> Prop. Canonical Structure tsot := mkS (Type). Definition test_sort := (refl_equal _ : R (T _) = R Type). Canonical Structure tsot2 := mkS (nat -> nat). Definition test_prod := (refl_equal _ : R (T _) = R (nat -> nat)). (* Var *) Section Foo. Variable v : nat. Definition my_v := v. Canonical Structure vP := mkP my_v. Definition test_var := (refl_equal _ : W (getp _) = W my_v). Canonical Structure vP' := mkP v. Definition test_var' := (refl_equal _ : W (my_getp _) = W my_v). End Foo. (* Rel *) Definition test_rel v := (refl_equal _ : W (my_getp _) = W (my_v v)). Goal True. pose (x := test_rel 2). match goal with x := _ : W (my_getp (vP 2)) = _ |- _ => idtac end. apply I. Qed. coq-8.20.0/test-suite/success/transparent_abstract.v000066400000000000000000000014521466560755400226000ustar00rootroot00000000000000Class by_transparent_abstract {T} (x : T) := make_by_transparent_abstract : T. #[export] Hint Extern 0 (@by_transparent_abstract ?T ?x) => change T; transparent_abstract exact_no_check x : typeclass_instances. Goal True /\ True. Proof. split. transparent_abstract exact I using foo. let x := (eval hnf in foo) in constr_eq x I. let x := constr:(ltac:(constructor) : True) in let T := type of x in let x := constr:(_ : by_transparent_abstract x) in let x := (eval cbv delta [by_transparent_abstract] in (let y : T := x in y)) in pose x as x'. simpl in x'. let v := eval cbv [x'] in x' in tryif constr_eq v I then fail 0 else idtac. hnf in x'. let v := eval cbv [x'] in x' in tryif constr_eq v I then idtac else fail 0. exact x'. Defined. Check eq_refl : I = foo. Eval compute in foo. coq-8.20.0/test-suite/success/tryif.v000066400000000000000000000024631466560755400175140ustar00rootroot00000000000000Require Import TestSuite.admit. (** [not tac] is equivalent to [fail tac "succeeds"] if [tac] succeeds, and is equivalent to [idtac] if [tac] fails *) Tactic Notation "not" tactic3(tac) := (tryif tac then fail 0 tac "succeeds" else idtac); (* error if the tactic solved all goals *) []. (** Test if a tactic succeeds, but always roll-back the results *) Tactic Notation "test" tactic3(tac) := tryif not tac then fail 0 tac "fails" else idtac. Goal Set. Proof. not fail. not not idtac. not fail 0. (** Would be nice if we could get [not fail 1] to pass, maybe *) not not admit. not not test admit. not progress test admit. (* test grouping *) not (not idtac; fail). assert True. all:not fail. 2:not fail. all:admit. Defined. Goal Set. Proof. test idtac. test try fail. test admit. test match goal with |- Set => idtac end. test (idtac; match goal with |- Set => idtac end). (* test grouping *) first [ (test idtac; fail); fail 1 | idtac ]. try test fail. try test test fail. test test idtac. test test admit. Fail test fail. test (idtac; []). test (assert True; [|]). (* would be nice, perhaps, if we could catch [fail 1] and not just [fail 0] this *) try ((test fail); fail 1). assert True. all:test idtac. all:test admit. 2:test admit. all:admit. Defined. coq-8.20.0/test-suite/success/typing_flags.v000066400000000000000000000051761466560755400210510ustar00rootroot00000000000000From Coq Require Import Program.Tactics. (* Part using attributes *) #[bypass_check(guard)] Fixpoint att_f' (n : nat) : nat := att_f' n. #[bypass_check(guard)] Program Fixpoint p_att_f' (n : nat) : nat := p_att_f' n. #[bypass_check(universes)] Definition att_T := let t := Type in (t : t). #[bypass_check(universes)] Program Definition p_att_T := let t := Type in (t : t). #[bypass_check(positivity)] Inductive att_Cor := | att_Over : att_Cor | att_Next : ((att_Cor -> list nat) -> list nat) -> att_Cor. Fail #[bypass_check(guard=no)] Fixpoint f_att_f' (n : nat) : nat := f_att_f' n. Fail #[bypass_check(universes=no)] Definition f_att_T := let t := Type in (t : t). Fail #[bypass_check(positivity=no)] Inductive f_att_Cor := | f_att_Over : f_att_Cor | f_att_Next : ((f_att_Cor -> list nat) -> list nat) -> f_att_Cor. Print Assumptions att_f'. Print Assumptions att_T. Print Assumptions att_Cor. (* Interactive + atts *) #[bypass_check(universes=yes)] Definition i_att_T' : Type. Proof. exact (let t := Type in (t : t)). Defined. #[bypass_check(universes=yes)] Definition d_att_T' : Type. Proof. exact (let t := Type in (t : t)). Qed. #[bypass_check(universes=yes)] Program Definition pi_att_T' : Type. Proof. exact (let t := Type in (t : t)). Qed. (* Note: be aware of tactics invoking [Global.env()] if this test fails. *) #[bypass_check(guard=yes)] Fixpoint i_att_f' (n : nat) : nat. Proof. exact (i_att_f' n). Defined. #[bypass_check(guard=yes)] Fixpoint d_att_f' (n : nat) : nat. Proof. exact (d_att_f' n). Qed. (* check regular mode is still safe *) Fail Fixpoint f_att_f' (n : nat) : nat := f_att_f' n. Fail Definition f_att_T := let t := Type in (t : t). Fail Inductive f_att_Cor := | f_att_Over : f_att_Cor | f_att_Next : ((f_att_Cor -> list nat) -> list nat) -> f_att_Cor. (* Part using Set/Unset *) Print Typing Flags. Unset Guard Checking. Fixpoint f' (n : nat) : nat := f' n. Fixpoint f (n : nat) : nat. Proof. exact (f n). Defined. Fixpoint bla (A:Type) (n:nat) := match n with 0 =>0 | S n => n end. Print Typing Flags. Set Guard Checking. Print Assumptions f. Unset Universe Checking. Definition T := Type. Fixpoint g (n : nat) : T := T. Print Typing Flags. Set Universe Checking. Fail Definition g2 (n : nat) : T := T. Fail Definition e := fix e (n : nat) : nat := e n. Unset Positivity Checking. Inductive Cor := | Over : Cor | Next : ((Cor -> list nat) -> list nat) -> Cor. Set Positivity Checking. Print Assumptions Cor. Inductive Box := | box : forall n, f n = n -> g 2 -> Box. Print Assumptions Box. (** CoFixpoint *) CoInductive Stream : Type := Cons : nat -> Stream -> Stream. #[bypass_check(guard)] CoFixpoint f2 : Stream := f2. coq-8.20.0/test-suite/success/unfold.v000066400000000000000000000040551466560755400176450ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* 0 | S _ => 1 end = 0. N.f. match goal with |- 0=0 => idtac end. Abort. End B. Module C. (* We reject inductive types and constructors *) Fail Ltac g := unfold nat. Fail Ltac g := unfold S. End C. Module D. (* In interactive mode, we delay the interpretation of short names *) Notation x := Nat.add. Goal let x := 0 in x = 0+0. unfold x. match goal with |- 0 = 0 => idtac end. Abort. Goal let x := 0 in x = 0+0. intro; unfold x. (* dynamic binding (but is it really the most natural?) *) match goal with |- 0 = 0+0 => idtac end. Abort. Goal let fst := 0 in fst = Datatypes.fst (0,0). unfold fst. match goal with |- 0 = 0 => idtac end. Abort. Goal let fst := 0 in fst = Datatypes.fst (0,0). intro; unfold fst. (* dynamic binding *) match goal with |- 0 = Datatypes.fst (0,0) => idtac end. Abort. End D. coq-8.20.0/test-suite/success/unicode_utf8.v000066400000000000000000000042501466560755400207470ustar00rootroot00000000000000(** PARSER TESTS *) (** Check correct separation of identifiers followed by unicode symbols *) Notation "x ⊕ w" := (plus x w) (at level 30). Check fun x => x⊕x. (** Check Greek letters *) Definition test_greek : nat -> nat := fun Δ => Δ. Parameter ℝ : Set. Parameter π : ℝ. (** Check indices *) Definition test_indices : nat -> nat := fun x₁ => x₁. Definition π₂ := @snd. (** More unicode in identifiers *) Definition αβ_áà_אב := 0. Notation "C 'ᵒᵖ'" := C (at level 30). (** UNICODE IN STRINGS *) Require Import List Ascii String. Open Scope string_scope. Definition test_string := "azertyαβ∀ééé". Eval compute in length test_string. (** last six "chars" are unicode, hence represented by 2 bytes, except the forall which is 3 bytes *) Fixpoint string_to_list s := match s with | EmptyString => nil | String c s => c :: string_to_list s end. Eval compute in (string_to_list test_string). (** for instance, α is \206\177 whereas ∀ is \226\136\128 *) Close Scope string_scope. (** INTERFACE TESTS *) Require Import Utf8. (** Printing of unicode notation, in *goals* *) Lemma test : forall A:Prop, A -> A. Proof. auto. Qed. (** Parsing of unicode notation, in *goals* *) Lemma test2 : ∀A:Prop, A → A. Proof. intro. intro. auto. Qed. (** Printing of unicode notation, in *response* *) Check fun (X:Type)(x:X) => x. (** Parsing of unicode notation, in *response* *) Check ∀Δ, Δ → Δ. Check ∀x, x=0 ∨ x=0 → x=0. (** ISSUES: *) Notation "x ≠ y" := (x<>y) (at level 70). Notation "x ≤ y" := (x<=y) (at level 70, no associativity). (** First Issue : ≤ is attached to "le" of nat, not to notation <= *) Require Import ZArith. Open Scope Z_scope. Locate "≤". (* still le, not Z.le *) Notation "x ≤ y" := (x<=y) (at level 70, no associativity). Locate "≤". Close Scope Z_scope. (** ==> How to proceed modularly ? *) (** Second Issue : notation for -> generates useless parenthesis if followed by a binder *) Check 0≠0 → ∀x:nat,x=x. (** Example of real situation : *) Definition pred : ∀x, x≠0 → ∃y, x = S y. Proof. destruct x. destruct 1; auto. intros _. exists x; auto. Defined. Print pred. coq-8.20.0/test-suite/success/unidecls.v000066400000000000000000000043261466560755400201650ustar00rootroot00000000000000(* -*- coq-prog-args: ("-top" "unidecls"); -*- *) Set Printing Universes. Module decls. Universes a b. End decls. Universe a. Constraint a < decls.a. Print Universes. (** These are different universes *) Check Type@{a}. Check Type@{decls.a}. Check Type@{decls.b}. Fail Check Type@{decls.c}. Fail Check Type@{i}. Universe foo. Module Foo. (** Already declared globaly: but universe names are scoped at the module level *) Universe foo. Universe bar. Check Type@{Foo.foo}. Definition bar := 0. End Foo. (** Already declared in the module *) Universe bar. (** Accessible outside the module: universe declarations are global *) Check Type@{bar}. Check Type@{Foo.bar}. Check Type@{Foo.foo}. (** The same *) Check Type@{foo}. Check Type@{unidecls.foo}. Universe secfoo. Section Foo'. Fail Universe secfoo. Universe secfoo2. Fail Check Type@{Foo'.secfoo2}. Check Type@{secfoo2}. Constraint secfoo2 < a. End Foo'. Check Type@{secfoo2}. Fail Check eq_refl : Type@{secfoo2} = Type@{a}. (** Below, u and v are global, fixed universes *) Module Type Arg. Universe u. Parameter T: Type@{u}. End Arg. Module Fn(A : Arg). Universes v. Check Type@{A.u}. Constraint A.u < v. Definition foo : Type@{v} := nat. Definition bar : Type@{A.u} := nat. Fail Definition foo(A : Type@{v}) : Type@{A.u} := A. End Fn. Module ArgImpl : Arg. Definition T := nat. End ArgImpl. Module ArgImpl2 : Arg. Definition T := bool. End ArgImpl2. (** Two applications of the functor result in the exact same universes *) Module FnApp := Fn(ArgImpl). Check Type@{FnApp.v}. Check FnApp.foo. Check FnApp.bar. Check (eq_refl : Type@{ArgImpl.u} = Type@{ArgImpl2.u}). Module FnApp2 := Fn(ArgImpl). Check Type@{FnApp2.v}. Check FnApp2.foo. Check FnApp2.bar. Import ArgImpl2. (** Now u refers to ArgImpl.u and ArgImpl2.u *) Check FnApp2.bar. (** It can be shadowed *) Universe u. (** This refers to the qualified name *) Check FnApp2.bar. Constraint u = ArgImpl.u. Print Universes. Set Universe Polymorphism. Section PS. Universe poly. Definition id (A : Type@{poly}) (a : A) : A := a. End PS. (** The universe is polymorphic and discharged, does not persist *) Fail Check Type@{poly}. Print Universes. Check id nat. Check id@{Set}. coq-8.20.0/test-suite/success/unification.v000066400000000000000000000144331466560755400206670ustar00rootroot00000000000000#[local] Definition test_stack_unification_interaction_with_delta A : (if negb _ then true else false) = if orb false (negb A) then true else false := eq_refl. (* Test patterns unification *) Lemma l1 : (forall P, (exists x:nat, P x) -> False) -> forall P, (exists x:nat, P x /\ P x) -> False. Proof. intros; apply (H _ H0). Qed. Lemma l2 : forall A:Set, forall Q:A->Set, (forall (P: forall x:A, Q x -> Prop), (exists x:A, exists y:Q x, P x y) -> False) -> forall (P: forall x:A, Q x -> Prop), (exists x:A, exists y:Q x, P x y /\ P x y) -> False. Proof. intros; apply (H _ H0). Qed. Lemma l3 : (forall P, ~(exists x:nat, P x)) -> forall P:nat->Prop, ~(exists x:nat, P x -> P x). Proof. intros; apply H. Qed. (* Feature introduced June 2011 *) Lemma l7 : forall x (P:nat->Prop), (forall f, P (f x)) -> P (x+x). Proof. intros x P H; apply H. Qed. (* Example submitted for Zenon *) Axiom zenon_noteq : forall T : Type, forall t : T, ((t <> t) -> False). Axiom zenon_notall : forall T : Type, forall P : T -> Prop, (forall z : T, (~(P z) -> False)) -> (~(forall x : T, (P x)) -> False). (* Must infer "P := fun x => x=x" in zenon_notall *) Check (fun _h1 => (zenon_notall nat _ (fun _T_0 => (fun _h2 => (zenon_noteq _ _T_0 _h2))) _h1)). (* Core of an example submitted by Ralph Matthes (BZ#849) It used to fail because of the K-variable x in the type of "sum_rec ..." which was not in the scope of the evar ?B. Solved by a head beta-reduction of the type "(fun _ : unit + unit => L unit) x" of "sum_rec ...". Shall we used more reduction when solving evars (in real_clean)?? Is there a risk of starting too long reductions? Note that the example originally came from a non re-typable pretty-printed term (the checked term is actually re-printed the same form it is checked). *) Set Implicit Arguments. Inductive L (A:Set) : Set := c : A -> L A. Parameter f: forall (A:Set)(B:Set), (A->B) -> L A -> L B. Parameter t: L (unit + unit). Check (f (fun x : unit + unit => sum_rec (fun _ : unit + unit => L unit) (fun y => c y) (fun y => c y) x) t). (* Test patterns unification in apply *) Require Import Arith. Parameter x y : nat. Parameter G:x=y->x=y->Prop. Parameter K:x<>y->x<>y->Prop. Lemma l4 : (forall f:x=y->Prop, forall g:x<>y->Prop, match eq_nat_dec x y with left a => f a | right a => g a end) -> match eq_nat_dec x y with left a => G a a | right a => K a a end. Proof. intros. apply H. Qed. (* Test unification modulo eta-expansion (if possible) *) (* In this example, two instances for ?P (argument of hypothesis H) can be inferred (one is by unifying the type [Q true] and [?P true] of the goal and type of [H]; the other is by unifying the argument of [f]); we need to unify both instances up to allowed eta-expansions of the instances (eta is allowed if the meta was applied to arguments) This used to fail before revision 9389 in trunk *) Lemma l5 : forall f : (forall P, P true), (forall P, f P = f P) -> forall Q, f (fun x => Q x) = f (fun x => Q x). Proof. intros. apply H. Qed. (* Feature deactivated in commit 14189 (see commit log) (* Test instantiation of evars by unification *) Goal (forall x, 0 + x = 0 -> True) -> True. intros; eapply H. rewrite <- plus_n_Sm. (* should refine ?x with S ?x' *) Abort. *) (* Check handling of identity equation between evars *) (* The example failed to pass until revision 10623 *) Lemma l6 : (forall y, (forall x, (forall z, y = 0 -> y + z = 0) -> y + x = 0) -> True) -> True. intros. eapply H. intros. apply H0. (* Check that equation ?n[H] = ?n[H] is correctly considered true *) reflexivity. Qed. (* Check treatment of metas erased by K-redexes at the time of turning them to evas *) Inductive nonemptyT (t : Type) : Prop := nonemptyT_intro : t -> nonemptyT t. Goal True. try case nonemptyT_intro. (* check that it fails w/o anomaly *) Abort. (* Test handling of return type and when it is decided to make the predicate dependent or not - see "bug" BZ#1851 *) Goal forall X (a:X) (f':nat -> X), (exists f : nat -> X, True). intros. exists (fun n => match n with O => a | S n' => f' n' end). constructor. Qed. (* Check use of types in unification (see Andrej Bauer's mail on coq-club, June 1 2009; it did not work in 8.2, probably started to work after Sozeau improved support for the use of types in unification) *) Goal (forall (A B : Set) (f : A -> B), (fun x => f x) = f) -> forall (A B C : Set) (g : (A -> B) -> C) (f : A -> B), g (fun x => f x) = g f. Proof. intros. rewrite H with (f:=f0). Abort. (* Three tests provided by Dan Grayson as part of a custom patch he made for a more powerful "destruct" for handling Voevodsky's Univalent Foundations. The test checks if second-order matching in tactic unification is able to guess by itself on which dependent terms to abstract so that the elimination predicate is well-typed *) Definition test1 (X : Type) (x : X) (fxe : forall x1 : X, identity x1 x1) : identity (fxe x) (fxe x). Proof. destruct (fxe x). apply identity_refl. Defined. (* a harder example *) Definition UU := Type . Inductive paths {T:Type}(t:T): T -> UU := idpath: paths t t. Inductive foo (X0:UU) (x0:X0) : forall (X:UU)(x:X), UU := newfoo : foo x0 x0. Definition idonfoo {X0:UU} {x0:X0} {X1:UU} {x1:X1} : foo x0 x1 -> foo x0 x1. Proof. intros t. exact t. Defined. Lemma test2 (T:UU) (t:T) (k : foo t t) : paths k (idonfoo k). Proof. destruct k. apply idpath. Defined. (* an example with two constructors *) Inductive foo' (X0:UU) (x0:X0) : forall (X:UU)(x:X), UU := | newfoo1 : foo' x0 x0 | newfoo2 : foo' x0 x0 . Definition idonfoo' {X0:UU} {x0:X0} {X1:UU} {x1:X1} : foo' x0 x1 -> foo' x0 x1. Proof. intros t. exact t. Defined. Lemma test3 (T:UU) (t:T) (k : foo' t t) : paths k (idonfoo' k). Proof. destruct k. apply idpath. apply idpath. Defined. (* An example where it is necessary to evar-normalize the instance of an evar to evaluate if it is a pattern *) Check let a := ?[P] in fun (H : forall y (P : nat -> Prop), y = 0 -> P y) x (p:x=0) => H ?[y] a p : x = 0. (* We have to solve "?P ?y[x] == x = 0" knowing from "p : (x=0) == (?y[x] = 0)" that "?y := x" *) (* An example involving SProp *) Check fun (A:SProp) (f g:A->A) (P:A->Type) a (x : P (f a)) => x : P (g _). coq-8.20.0/test-suite/success/unification_delta.v000066400000000000000000000021521466560755400220330ustar00rootroot00000000000000Require Import Coq.Classes.Equivalence. Require Import Coq.Program.Program. Import Relation_Definitions. Import Morphisms. Require Setoid. Obligation Tactic := program_simpl ; simpl_relation. Generalizable Variables A eqA. Lemma bla : forall `{ ! @Equivalence A (eqA : relation A) } x y, eqA x y -> eqA y x. Proof. intros. rewrite H0. reflexivity. Defined. Lemma bla' : forall `{ ! @Equivalence A (eqA : relation A) } x y, eqA x y -> eqA y x. Proof. intros. (* Need delta on [relation] to unify with the right lemmas. *) rewrite <- H0. reflexivity. Qed. Axiom euclid : nat -> { x : nat | x > 0 } -> nat. Definition eq_proj {A} {s : A -> Prop} : relation (sig s) := fun x y => `x = `y. #[export] Program Instance foo {A : Type} {s : A -> Prop} : @Equivalence (sig s) eq_proj. Next Obligation. Proof. cbv in *;congruence. Qed. #[export] Instance bar : Proper (eq ==> eq_proj ==> eq) euclid. Proof. Admitted. Goal forall (x : nat) (y : nat | y > 0) (z : nat | z > 0), eq_proj y z -> euclid x y = euclid x z. Proof. intros. (* Breaks if too much delta in unification *) rewrite H. reflexivity. Qed. coq-8.20.0/test-suite/success/uniform_inductive_parameters.v000066400000000000000000000012251466560755400243260ustar00rootroot00000000000000Set Uniform Inductive Parameters. Inductive list (A : Type) := | nil : list | cons : A -> list -> list. Check (list : Type -> Type). Check (cons : forall A, A -> list A -> list A). Inductive list2 (A : Type) (A' := prod A A) := | nil2 : list2 | cons2 : A' -> list2 -> list2. Check (list2 : Type -> Type). Check (cons2 : forall A (A' := prod A A), A' -> list2 A -> list2 A). Inductive list3 | A := nil3 | cons3 : A -> list3 (A * A)%type -> list3 A. Unset Uniform Inductive Parameters. Inductive list4 A | := nil4 | cons4 : A -> list4 -> list4. Inductive Acc {A:Type} (R:A->A->Prop) | (x:A) : Prop := Acc_in : (forall y, R y x -> Acc y) -> Acc x. coq-8.20.0/test-suite/success/univers.v000066400000000000000000000036271466560755400200550ustar00rootroot00000000000000(* This requires cumulativity *) Definition Type2 := Type. Definition Type1 : Type2 := Type. Lemma lem1 : (True -> Type1) -> Type2. intro H. apply H. exact I. Qed. Lemma lem2 : forall (A : Type) (P : A -> Type) (x : A), (forall y : A, x = y -> P y) -> P x. auto. Qed. Lemma lem3 : forall P : Prop, P. intro P; pattern P. apply lem2. Abort. (* Check managing of universe constraints in inversion (BZ#855) *) Inductive dep_eq : forall X : Type, X -> X -> Prop := | intro_eq : forall (X : Type) (f : X), dep_eq X f f | intro_feq : forall (A : Type) (B : A -> Type), let T := forall x : A, B x in forall (f g : T) (x : A), dep_eq (B x) (f x) (g x) -> dep_eq T f g. Require Import Relations. Theorem dep_eq_trans : forall X : Type, transitive X (dep_eq X). Proof. unfold transitive. intros X f g h H1 H2. inversion H1. Abort. (* Submitted by Bas Spitters (BZ#935) *) (* This is a problem with the status of the type in LetIn: is it a user-provided one or an inferred one? At the current time, the kernel type-check the type in LetIn, which means that it must be considered as user-provided when calling the kernel. However, in practice it is inferred so that a universe refresh is needed to set its status as "user-provided". Especially, universe refreshing was not done for "set/pose" *) Lemma ind_unsec : forall Q : nat -> Type, True. intro. set (C := forall m, Q m -> Q m). exact I. Qed. (* Submitted by Danko Ilik (bug report #1507); related to LetIn *) Record U : Type := { A:=Type; a:A }. (** Check assignment of sorts to inductives and records. *) Parameter sh : list nat. Definition is_box_in_shape (b :nat * nat) := True. Definition myType := Type. Module Ind. Inductive box_in : myType := myBox (coord : nat * nat) (_ : is_box_in_shape coord) : box_in. End Ind. Module Rec. Record box_in : myType := BoxIn { coord :> nat * nat; _ : is_box_in_shape coord }. End Rec. coq-8.20.0/test-suite/success/universes_coercion.v000066400000000000000000000016221466560755400222570ustar00rootroot00000000000000(* This example used to emphasize the absence of LEGO-style universe polymorphism; Matthieu's improvements of typing on 2011/3/11 now makes (apparently) that Amokrane's automatic eta-expansion in the coercion mechanism works; this makes its illustration as a "weakness" of universe polymorphism obsolete (example submitted by Randy Pollack). Note that this example is not an evidence that the current non-kernel eta-expansion behavior is the most expected one. *) Parameter K : forall T : Type, T -> T. Check (K (forall T : Type, T -> T) K). (* note that the inferred term is "(K (forall T (* u1 *) : Type, T -> T) (fun T:Type (* u1 *) => K T))" which is not eta-equivalent to "(K (forall T : Type, T -> T) K" because the eta-expansion of the latter "(K (forall T : Type, T -> T) (fun T:Type (* u2 *) => K T)" assuming K of type "forall T (* u2 *) : Type, T -> T" *) coq-8.20.0/test-suite/success/univnames.v000066400000000000000000000016461466560755400203660ustar00rootroot00000000000000Set Universe Polymorphism. Definition foo@{i j} (A : Type@{i}) (B : Type@{j}) := A. Set Printing Universes. Fail Definition bar@{i} (A : Type@{i}) (B : Type) := A. Definition baz@{i j} (A : Type@{i}) (B : Type@{j}) := (A * B)%type. Fail Definition bad@{i j} (A : Type@{i}) (B : Type@{j}) : Type := (A * B)%type. Fail Definition bad@{i} (A : Type@{i}) (B : Type@{j}) : Type := (A * B)%type. Definition shuffle@{i j} (A : Type@{j}) (B : Type@{i}) := (A * B)%type. Definition nothing (A : Type) := A. Inductive bla@{l k} : Type@{k} := blaI : Type@{l} -> bla. Inductive blacopy@{k l} : Type@{k} := blacopyI : Type@{l} -> blacopy. Class Wrap A := wrap : A. Fail #[export] Instance bad@{} : Wrap Type := Type. #[export] Instance bad@{} : Wrap Type. Fail Proof Type. Abort. #[export] Instance bar@{u} : Wrap@{u} Set. Proof nat. Monomorphic Universe g. Inductive blacopy'@{l} : Type@{g} := blacopy'I : Type@{l} -> blacopy'. coq-8.20.0/test-suite/success/univscompute.v000066400000000000000000000013211466560755400211100ustar00rootroot00000000000000Set Universe Polymorphism. Polymorphic Definition id {A : Type} (a : A) := a. Eval vm_compute in id 1. Polymorphic Inductive ind (A : Type) := cons : A -> ind A. Eval vm_compute in ind unit. Check ind unit. Eval vm_compute in ind unit. Definition bar := Eval vm_compute in ind unit. Definition bar' := Eval vm_compute in id (cons _ tt). Definition bar'' := Eval native_compute in id 1. Definition bar''' := Eval native_compute in id (cons _ tt). Definition barty := Eval native_compute in id (cons _ Set). Definition one := @id. Monomorphic Definition sec := one. Eval native_compute in sec. Definition sec' := Eval native_compute in sec. Eval vm_compute in sec. Definition sec'' := Eval vm_compute in sec. coq-8.20.0/test-suite/success/unknown_warning.v000066400000000000000000000010141466560755400215720ustar00rootroot00000000000000Set Warnings "+unknown-warning". Set Warnings "-foo". Fail Set Warnings "foo". Fail Set Warnings "+foo". #[warnings="-foo"] Check True. Fail #[warnings="foo"] Check True. (* debatable: even though "all" overrides "+foo" we still warn *) Fail Set Warnings "+foo,-all". (* debatable: changing unknown-warning has no effect for the current check *) Fail Set Warnings "-unknown-warning,foo". Fail #[warnings="-unknown-warning,foo"] Check True. Set Warnings "-unknown-warning". #[warnings="+unknown-warning,foo"] Check True. coq-8.20.0/test-suite/success/unshelve.v000066400000000000000000000014341466560755400202050ustar00rootroot00000000000000Axiom F : forall (b : bool), b = true -> forall (i : unit), i = i -> True. Goal True. Proof. unshelve (refine (F _ _ _ _)). + exact true. + exact tt. + exact (@eq_refl bool true). + exact (@eq_refl unit tt). Qed. (* This was failing in 8.6, because of ?a:nat being wrongly duplicated *) Goal (forall a : nat, a = 0 -> True) -> True. intros F. unshelve (eapply (F _);clear F). 2:reflexivity. Qed. (* same think but using Ltac2 refine *) Require Import Ltac2.Ltac2. Goal True. Proof. (* Ltac2 refine is more like simple_refine *) unshelve (refine '(F _ _ _ _); Control.shelve_unifiable ()). + exact true. + exact tt. + exact (@eq_refl bool true). + exact (@eq_refl unit tt). Qed. Goal (forall a : nat, a = 0 -> True) -> True. intros F. unshelve (eapply (&F _);clear F). 2:reflexivity. Qed. coq-8.20.0/test-suite/success/vm_evars.v000066400000000000000000000005341466560755400201760ustar00rootroot00000000000000Fixpoint iter {A} (n : nat) (f : A -> A) (x : A) := match n with | 0 => x | S n => iter n f (f x) end. Goal nat -> True. Proof. intros n. evar (f : nat -> nat). cut (iter 10 f 0 = 0). vm_compute. intros; constructor. instantiate (f := (fun x => x)). reflexivity. Qed. Goal exists x, x = 5 + 5. Proof. eexists. vm_compute. reflexivity. Qed. coq-8.20.0/test-suite/success/vm_norm_records.v000066400000000000000000000022551466560755400215540ustar00rootroot00000000000000Set Primitive Projections. (** Variant of VM conversion that exercises the reification part of the VM *) Ltac norm := match goal with [ |- ?P ] => let Q := eval vm_compute in P in change Q end. Module T. Record prod (A : Type) (B : A -> Type) := pair { fst : A; snd : B fst }. Arguments fst {_ _}. Arguments snd {_ _}. Goal forall (p : prod nat (fun n => n = 0)), fst p = 0. Proof. intros p. norm. apply (snd p). Qed. End T. Module M. CoInductive foo := Foo { foo0 : foo; foo1 : bar; } with bar := Bar { bar0 : foo; bar1 : bar; }. CoFixpoint f : foo := Foo f g with g : bar := Bar f g. Goal f.(foo0).(foo0) = g.(bar0). Proof. norm. match goal with [ |- ?t = ?t ] => idtac end. reflexivity. Qed. Goal g.(bar1).(bar0).(foo1) = g. Proof. norm. match goal with [ |- ?t = ?t ] => idtac end. reflexivity. Qed. End M. Module N. Inductive foo := Foo { foo0 : option foo; foo1 : list bar; } with bar := Bar { bar0 : option bar; bar1 : list foo; }. Definition f_0 := Foo None nil. Definition g_0 := Bar None nil. Definition f := Foo (Some f_0) (cons g_0 nil). Goal f.(foo1) = cons g_0 nil. Proof. norm. match goal with [ |- ?t = ?t ] => idtac end. reflexivity. Qed. End N. coq-8.20.0/test-suite/success/vm_records.v000066400000000000000000000011731466560755400205170ustar00rootroot00000000000000Set Primitive Projections. Module M. CoInductive foo := Foo { foo0 : foo; foo1 : bar; } with bar := Bar { bar0 : foo; bar1 : bar; }. CoFixpoint f : foo := Foo f g with g : bar := Bar f g. Check (@eq_refl _ g.(bar0) <: f.(foo0).(foo0) = g.(bar0)). Check (@eq_refl _ g <: g.(bar1).(bar0).(foo1) = g). End M. Module N. Inductive foo := Foo { foo0 : option foo; foo1 : list bar; } with bar := Bar { bar0 : option bar; bar1 : list foo; }. Definition f_0 := Foo None nil. Definition g_0 := Bar None nil. Definition f := Foo (Some f_0) (cons g_0 nil). Check (@eq_refl _ f.(foo1) <: f.(foo1) = cons g_0 nil). End N. coq-8.20.0/test-suite/success/vm_univ_poly.v000066400000000000000000000101421466560755400210760ustar00rootroot00000000000000(* Basic tests *) Polymorphic Definition pid {T : Type} (x : T) : T := x. (* Definition _1 : pid true = true := @eq_refl _ true <: pid true = true. Polymorphic Definition a_type := Type. Definition _2 : a_type@{i} = Type@{i} := @eq_refl _ Type@{i} <: a_type@{i} = Type@{i}. Polymorphic Definition FORALL (T : Type) (P : T -> Prop) : Prop := forall x : T, P x. Polymorphic Axiom todo : forall {T:Type}, T -> T. Polymorphic Definition todo' (T : Type) := @todo T. Definition _3 : @todo'@{Set} = @todo@{Set} := @eq_refl _ (@todo@{Set}) <: @todo'@{Set} = @todo@{Set}. *) (* Inductive Types *) Inductive sumbool (A B : Prop) : Set := | left : A -> sumbool A B | right : B -> sumbool A B. Definition x : sumbool True False := left _ _ I. Definition sumbool_copy {A B : Prop} (H : sumbool A B) : sumbool A B := match H with | left _ _ x => left _ _ x | right _ _ x => right _ _ x end. Definition _4 : sumbool_copy x = x := @eq_refl _ x <: sumbool_copy x = x. (* Polymorphic Inductive Types *) Polymorphic Inductive poption@{i} (T : Type@{i}) : Type@{i} := | PSome : T -> poption T | PNone : poption T. Polymorphic Definition poption_default@{i} {T : Type@{i}} (p : poption@{i} T) (x : T) : T := match p with | @PSome _ y => y | @PNone _ => x end. Polymorphic Inductive plist@{i} (T : Type@{i}) : Type@{i} := | pnil | pcons : T -> plist T -> plist T. Arguments pnil {_}. Arguments pcons {_} _ _. Polymorphic Definition pmap@{i j} {T : Type@{i}} {U : Type@{j}} (f : T -> U) := fix pmap (ls : plist@{i} T) : plist@{j} U := match ls with | @pnil _ => @pnil _ | @pcons _ l ls => @pcons@{j} U (f l) (pmap ls) end. Universe Ubool. Inductive tbool : Type@{Ubool} := ttrue | tfalse. Eval vm_compute in pmap pid (pcons true (pcons false pnil)). Eval vm_compute in pmap (fun x => match x with | pnil => true | pcons _ _ => false end) (pcons pnil (pcons (pcons false pnil) pnil)). Eval vm_compute in pmap (fun x => x -> Type) (pcons tbool (pcons (plist tbool) pnil)). Polymorphic Inductive Tree@{i} (T : Type@{i}) : Type@{i} := | Empty | Branch : plist@{i} (Tree T) -> Tree T. Polymorphic Definition pfold@{i u} {T : Type@{i}} {U : Type@{u}} (f : T -> U -> U) := fix pfold (acc : U) (ls : plist@{i} T) : U := match ls with | pnil => acc | pcons a b => pfold (f a acc) b end. Polymorphic Inductive nat@{i} : Type@{i} := | O | S : nat -> nat. Polymorphic Fixpoint nat_max@{i} (a b : nat@{i}) : nat@{i} := match a , b with | O , b => b | a , O => a | S a , S b => S (nat_max a b) end. Polymorphic Fixpoint height@{i} {T : Type@{i}} (t : Tree@{i} T) : nat@{i} := match t return nat@{i} with | Empty _ => O | Branch _ ls => S@{i} (pfold@{i i} nat_max O (pmap height ls)) end. Polymorphic Fixpoint repeat@{i} {T : Type@{i}} (n : nat@{i}) (v : T) : plist@{i} T := match n return plist@{i} T with | O => pnil | S n => pcons@{i} v (repeat n v) end. Polymorphic Fixpoint big_tree@{i} (n : nat@{i}) : Tree@{i} nat@{i} := match n with | O => @Empty nat@{i} | S n' => Branch@{i} nat@{i} (repeat@{i} n' (big_tree n')) end. Eval compute in height (big_tree (S (S (S O)))). #[local] Definition big := S (S (S (S (S O)))). Polymorphic Definition really_big@{i} := (S@{i} (S (S (S (S (S (S (S (S (S O)))))))))). Time Definition _5 : height (@Empty nat) = O := @eq_refl nat O <: height (@Empty nat) = O. Time Definition _6 : height@{Set} (@Branch nat pnil) = S O := @eq_refl nat@{Set} (S@{Set} O@{Set}) <: @eq nat@{Set} (height@{Set} (@Branch@{Set} nat@{Set} (@pnil@{Set} (Tree@{Set} nat@{Set})))) (S@{Set} O@{Set}). Time Definition _7 : height (big_tree big) = big := @eq_refl nat big <: height (big_tree big) = big. Time Definition _8 : height (big_tree really_big) = really_big := @eq_refl nat@{Set} (S@{Set} (S@{Set} (S@{Set} (S@{Set} (S@{Set} (S@{Set} (S@{Set} (S@{Set} (S@{Set} (S@{Set} O@{Set})))))))))) <: @eq nat@{Set} (@height nat@{Set} (big_tree really_big@{Set})) really_big@{Set}. coq-8.20.0/test-suite/success/vm_univ_poly_match.v000066400000000000000000000011361466560755400222550ustar00rootroot00000000000000Set Dump Bytecode. Set Printing Universes. Set Printing All. Polymorphic Class Applicative@{d c} (T : Type@{d} -> Type@{c}) := { pure : forall {A : Type@{d}}, A -> T A ; ap : forall {A B : Type@{d}}, T (A -> B) -> T A -> T B }. Universes Uo Ua. Eval compute in @pure@{Uo Ua}. Global Instance Applicative_option : Applicative@{Uo Ua} option := {| pure := @Some ; ap := fun _ _ f x => match f , x with | Some f , Some x => Some (f x) | _ , _ => None end |}. Definition foo := ap (ap (pure plus) (pure 1)) (pure 1). Print foo. Eval vm_compute in foo. coq-8.20.0/test-suite/success/warnings_attribute.v000066400000000000000000000002611466560755400222640ustar00rootroot00000000000000 Set Primitive Projections. Fail #[warnings="+non-primitive-record"] Record foo : Prop := { _ : nat }. #[warnings="-non-primitive-record"] Record foo : Prop := { _ : nat }. coq-8.20.0/test-suite/success/with_strategy.v000066400000000000000000000545731466560755400212650ustar00rootroot00000000000000Notation aid := (@id) (only parsing). Notation idn := id (only parsing). Ltac unfold_id := unfold id. Fixpoint fact (n : nat) := match n with | 0 => 1 | S n => (S n) * fact n end. Opaque id. Goal id 0 = 0. with_strategy opaque [id] (with_strategy opaque [id id] (assert_fails unfold_id; with_strategy transparent [id] (assert_succeeds unfold_id; with_strategy opaque [id] (with_strategy 0 [id] (assert_succeeds unfold_id; with_strategy 1 [id] (assert_succeeds unfold_id; with_strategy -1 [id] (assert_succeeds unfold_id; with_strategy opaque [id] (assert_fails unfold_id; with_strategy transparent [id] (assert_succeeds unfold_id; with_strategy opaque [id] (with_strategy expand [id] (assert_succeeds unfold_id; let l := strategy_level:(expand) in with_strategy l [id] (let idx := smart_global:(id) in cbv [idx]; (* This should succeed, but doesn't, basically due to https://github.com/coq/coq/issues/11202 *) assert_fails (let idx := smart_global:(id) in with_strategy expand [idx] idtac); reflexivity)))))))))))). Qed. Goal id 0 = 0. with_strategy opaque [aid] (assert_fails unfold_id; with_strategy transparent [aid] (assert_succeeds unfold_id; with_strategy opaque [aid] (with_strategy 0 [aid] (assert_succeeds unfold_id; with_strategy 1 [aid] (assert_succeeds unfold_id; with_strategy -1 [aid] (assert_succeeds unfold_id; with_strategy opaque [aid] (assert_fails unfold_id; with_strategy transparent [aid] (assert_succeeds unfold_id; with_strategy opaque [aid] (with_strategy expand [aid] (assert_succeeds unfold_id; reflexivity)))))))))). Qed. Goal id 0 = 0. with_strategy opaque [idn] (assert_fails unfold_id; with_strategy transparent [idn] (assert_succeeds unfold_id; with_strategy opaque [idn] (with_strategy 0 [idn] (assert_succeeds unfold_id; with_strategy 1 [idn] (assert_succeeds unfold_id; with_strategy -1 [idn] (assert_succeeds unfold_id; with_strategy opaque [idn] (assert_fails unfold_id; with_strategy transparent [idn] (assert_succeeds unfold_id; with_strategy opaque [idn] (with_strategy expand [idn] (assert_succeeds unfold_id; reflexivity)))))))))). Qed. (* test that strategy tactic does not persist after the execution of the tactic *) Opaque id. Goal id 0 = 0. assert_fails unfold_id; (with_strategy transparent [id] assert_succeeds unfold_id); assert_fails unfold_id. assert_fails unfold_id. with_strategy transparent [id] assert_succeeds unfold_id. assert_fails unfold_id. reflexivity. Qed. (* test that the strategy tactic does persist through abstract *) Opaque id. Goal id 0 = 0. Time Timeout 5 with_strategy expand [id] assert (id (fact 100) = fact 100) by abstract reflexivity. reflexivity. Time Timeout 5 Defined. (* test that it works even with [Qed] *) Goal id 0 = 0. Proof using Type. Time Timeout 5 abstract (with_strategy expand [id] assert (id (fact 100) = fact 100) by abstract reflexivity; reflexivity). Time Timeout 5 Qed. (* test that the strategy is correctly reverted after closing the goal completely *) Goal id 0 = 0. assert (id 0 = 0) by with_strategy expand [id] reflexivity. Fail unfold id. reflexivity. Qed. (* test that the strategy is correctly reverted after failure *) Goal id 0 = 0. let id' := id in (try with_strategy expand [id] fail); assert_fails unfold id'. Fail unfold id. (* a more complicated test involving a success and then a failure after backtracking *) let id' := id in ((with_strategy expand [id] (unfold id' + fail)) + idtac); lazymatch goal with |- id 0 = 0 => idtac end; assert_fails unfold id'. Fail unfold id. reflexivity. Qed. (* test multi-success *) Goal id (fact 100) = fact 100. Timeout 1 (with_strategy -1 [id] (((idtac + (abstract reflexivity))); fail)). Undo. Timeout 1 let id' := id in (with_strategy -1 [id] (((idtac + (unfold id'; reflexivity))); fail)). Undo. Timeout 1 (with_strategy -1 [id] (idtac + (abstract reflexivity))); fail. (* should not time out *) Undo. with_strategy -1 [id] abstract reflexivity. Defined. (* check that module substitutions happen correctly *) Module F. Definition id {T} := @id T. Opaque id. Ltac with_transparent_id tac := with_strategy transparent [id] tac. End F. Opaque F.id. Goal F.id 0 = F.id 0. Fail unfold F.id. F.with_transparent_id ltac:(progress unfold F.id). Undo. F.with_transparent_id ltac:(let x := constr:(@F.id) in progress unfold x). Abort. Module Type Empty. End Empty. Module E. End E. Module F2F (E : Empty). Definition id {T} := @id T. Opaque id. Ltac with_transparent_id tac := with_strategy transparent [id] tac. End F2F. Module F2 := F2F E. Opaque F2.id. Goal F2.id 0 = F2.id 0. Fail unfold F2.id. F2.with_transparent_id ltac:(progress unfold F2.id). Undo. F2.with_transparent_id ltac:(let x := constr:(@F2.id) in progress unfold x). Abort. (* test the tactic notation entries *) Tactic Notation "with_strategy0" strategy_level(l) "[" ne_smart_global_list(v) "]" tactic3(tac) := with_strategy l [ v ] tac. Tactic Notation "with_strategy1" strategy_level_or_var(l) "[" ne_smart_global_list(v) "]" tactic3(tac) := with_strategy l [ v ] tac. Tactic Notation "with_strategy2" strategy_level(l) "[" constr(v) "]" tactic3(tac) := with_strategy l [ v ] tac. Tactic Notation "with_strategy3" strategy_level_or_var(l) "[" constr(v) "]" tactic3(tac) := with_strategy l [ v ] tac. (* [with_strategy0] should work, but it doesn't, due to a combination of https://github.com/coq/coq/issues/11202 and https://github.com/coq/coq/issues/11209 *) Opaque id. Goal id 0 = 0. Fail (* should work, not Fail *) with_strategy0 opaque [id] idtac. Fail (* should work, not Fail *) with_strategy0 opaque [id id] idtac. assert_fails unfold_id. Fail (* should work, not Fail *) with_strategy0 transparent [id] idtac. Fail (* should work, not Fail *) assert_succeeds unfold_id idtac. Fail (* should work, not Fail *) with_strategy0 opaque [id] idtac. Fail (* should work, not Fail *) with_strategy0 0 [id] idtac. Fail (* should work, not Fail *) assert_succeeds unfold_id idtac. Fail (* should work, not Fail *) with_strategy0 1 [id] idtac. Fail (* should work, not Fail *) assert_succeeds unfold_id idtac. Fail (* should work, not Fail *) with_strategy0 -1 [id] idtac. Fail (* should work, not Fail *) assert_succeeds unfold_id idtac. Fail (* should work, not Fail *) with_strategy0 opaque [id] idtac. assert_fails unfold_id. Fail (* should work, not Fail *) with_strategy0 transparent [id] idtac. Fail (* should work, not Fail *) assert_succeeds unfold_id idtac. Fail (* should work, not Fail *) with_strategy0 opaque [id] idtac. Fail (* should work, not Fail *) with_strategy0 expand [id] idtac. Fail (* should work, not Fail *) assert_succeeds unfold_id idtac. (* This should succeed, but doesn't, basically due to https://github.com/coq/coq/issues/11202 *) Fail let idx := smart_global:(id) in with_strategy0 expand [idx] idtac. reflexivity. Qed. Goal id 0 = 0. Fail (* should work, not Fail *) with_strategy0 opaque [aid] idtac. assert_fails unfold_id. Fail (* should work, not Fail *) with_strategy0 transparent [aid] idtac. Fail (* should work, not Fail *) assert_succeeds unfold_id idtac. Fail (* should work, not Fail *) with_strategy0 opaque [aid] idtac. Fail (* should work, not Fail *) with_strategy0 0 [aid] idtac. Fail (* should work, not Fail *) assert_succeeds unfold_id idtac. Fail (* should work, not Fail *) with_strategy0 1 [aid] idtac. Fail (* should work, not Fail *) assert_succeeds unfold_id idtac. Fail (* should work, not Fail *) with_strategy0 -1 [aid] idtac. Fail (* should work, not Fail *) assert_succeeds unfold_id idtac. Fail (* should work, not Fail *) with_strategy0 opaque [aid] idtac. assert_fails unfold_id. Fail (* should work, not Fail *) with_strategy0 transparent [aid] idtac. Fail (* should work, not Fail *) assert_succeeds unfold_id idtac. Fail (* should work, not Fail *) with_strategy0 opaque [aid] idtac. Fail (* should work, not Fail *) with_strategy0 expand [aid] idtac. Fail (* should work, not Fail *) assert_succeeds unfold_id idtac. reflexivity. Qed. Goal id 0 = 0. Fail (* should work, not Fail *) with_strategy0 opaque [idn] idtac. assert_fails unfold_id. Fail (* should work, not Fail *) with_strategy0 transparent [idn] idtac. Fail (* should work, not Fail *) assert_succeeds unfold_id idtac. Fail (* should work, not Fail *) with_strategy0 opaque [idn] idtac. Fail (* should work, not Fail *) with_strategy0 0 [idn] idtac. Fail (* should work, not Fail *) assert_succeeds unfold_id idtac. Fail (* should work, not Fail *) with_strategy0 1 [idn] idtac. Fail (* should work, not Fail *) assert_succeeds unfold_id idtac. Fail (* should work, not Fail *) with_strategy0 -1 [idn] idtac. Fail (* should work, not Fail *) assert_succeeds unfold_id idtac. Fail (* should work, not Fail *) with_strategy0 opaque [idn] idtac. assert_fails unfold_id. Fail (* should work, not Fail *) with_strategy0 transparent [idn] idtac. Fail (* should work, not Fail *) assert_succeeds unfold_id idtac. Fail (* should work, not Fail *) with_strategy0 opaque [idn] idtac. Fail (* should work, not Fail *) with_strategy0 expand [idn] idtac. Fail (* should work, not Fail *) assert_succeeds unfold_id idtac. reflexivity. Qed. (* [with_strategy1] should work, but it doesn't, due to a combination of https://github.com/coq/coq/issues/11202 and https://github.com/coq/coq/issues/11209 *) Opaque id. Goal id 0 = 0. Fail (* should work, not Fail *) with_strategy1 opaque [id] idtac. Fail (* should work, not Fail *) with_strategy1 opaque [id id] idtac. assert_fails unfold_id. Fail (* should work, not Fail *) with_strategy1 transparent [id] idtac. Fail (* should work, not Fail *) assert_succeeds unfold_id idtac. Fail (* should work, not Fail *) with_strategy1 opaque [id] idtac. Fail (* should work, not Fail *) with_strategy1 0 [id] idtac. Fail (* should work, not Fail *) assert_succeeds unfold_id idtac. Fail (* should work, not Fail *) with_strategy1 1 [id] idtac. Fail (* should work, not Fail *) assert_succeeds unfold_id idtac. Fail (* should work, not Fail *) with_strategy1 -1 [id] idtac. Fail (* should work, not Fail *) assert_succeeds unfold_id idtac. Fail (* should work, not Fail *) with_strategy1 opaque [id] idtac. assert_fails unfold_id. Fail (* should work, not Fail *) with_strategy1 transparent [id] idtac. Fail (* should work, not Fail *) assert_succeeds unfold_id idtac. Fail (* should work, not Fail *) with_strategy1 opaque [id] idtac. Fail (* should work, not Fail *) with_strategy1 expand [id] idtac. Fail (* should work, not Fail *) assert_succeeds unfold_id idtac. Fail (* should work, not Fail *) let l := strategy_level:(expand) in with_strategy1 l [id] idtac. (* This should succeed, but doesn't, basically due to https://github idtac.com/coq/coq/issues/11202 *) Fail let idx := smart_global:(id) in with_strategy1 expand [idx] idtac. reflexivity. Qed. Goal id 0 = 0. Fail (* should work, not Fail *) with_strategy1 opaque [aid] idtac. assert_fails unfold_id. Fail (* should work, not Fail *) with_strategy1 transparent [aid] idtac. Fail (* should work, not Fail *) assert_succeeds unfold_id idtac. Fail (* should work, not Fail *) with_strategy1 opaque [aid] idtac. Fail (* should work, not Fail *) with_strategy1 0 [aid] idtac. Fail (* should work, not Fail *) assert_succeeds unfold_id idtac. Fail (* should work, not Fail *) with_strategy1 1 [aid] idtac. Fail (* should work, not Fail *) assert_succeeds unfold_id idtac. Fail (* should work, not Fail *) with_strategy1 -1 [aid] idtac. Fail (* should work, not Fail *) assert_succeeds unfold_id idtac. Fail (* should work, not Fail *) with_strategy1 opaque [aid] idtac. assert_fails unfold_id. Fail (* should work, not Fail *) with_strategy1 transparent [aid] idtac. Fail (* should work, not Fail *) assert_succeeds unfold_id idtac. Fail (* should work, not Fail *) with_strategy1 opaque [aid] idtac. Fail (* should work, not Fail *) with_strategy1 expand [aid] idtac. Fail (* should work, not Fail *) assert_succeeds unfold_id idtac. reflexivity. Qed. Goal id 0 = 0. Fail (* should work, not Fail *) with_strategy1 opaque [idn] idtac. assert_fails unfold_id. Fail (* should work, not Fail *) with_strategy1 transparent [idn] idtac. Fail (* should work, not Fail *) assert_succeeds unfold_id idtac. Fail (* should work, not Fail *) with_strategy1 opaque [idn] idtac. Fail (* should work, not Fail *) with_strategy1 0 [idn] idtac. Fail (* should work, not Fail *) assert_succeeds unfold_id idtac. Fail (* should work, not Fail *) with_strategy1 1 [idn] idtac. Fail (* should work, not Fail *) assert_succeeds unfold_id idtac. Fail (* should work, not Fail *) with_strategy1 -1 [idn] idtac. Fail (* should work, not Fail *) assert_succeeds unfold_id idtac. Fail (* should work, not Fail *) with_strategy1 opaque [idn] idtac. assert_fails unfold_id. Fail (* should work, not Fail *) with_strategy1 transparent [idn] idtac. Fail (* should work, not Fail *) assert_succeeds unfold_id idtac. Fail (* should work, not Fail *) with_strategy1 opaque [idn] idtac. Fail (* should work, not Fail *) with_strategy1 expand [idn] idtac. Fail (* should work, not Fail *) assert_succeeds unfold_id idtac. reflexivity. Qed. Opaque id. Goal id 0 = 0. with_strategy2 opaque [id] (with_strategy2 opaque [id] (assert_fails unfold_id; with_strategy2 transparent [id] (assert_succeeds unfold_id; with_strategy2 opaque [id] (with_strategy2 0 [id] (assert_succeeds unfold_id; with_strategy2 1 [id] (assert_succeeds unfold_id; with_strategy2 -1 [id] (assert_succeeds unfold_id; with_strategy2 opaque [id] (assert_fails unfold_id; with_strategy2 transparent [id] (assert_succeeds unfold_id; with_strategy2 opaque [id] (with_strategy2 expand [id] (assert_succeeds unfold_id))))))))))). (* This should succeed, but doesn't, basically due to https://github.com/coq/coq/issues/11202 *) Fail let idx := smart_global:(id) in with_strategy2 expand [idx] idtac. reflexivity. Qed. Goal id 0 = 0. with_strategy2 opaque [aid] (with_strategy2 opaque [aid] (assert_fails unfold_id; with_strategy2 transparent [aid] (assert_succeeds unfold_id; with_strategy2 opaque [aid] (with_strategy2 0 [aid] (assert_succeeds unfold_id; with_strategy2 1 [aid] (assert_succeeds unfold_id; with_strategy2 -1 [aid] (assert_succeeds unfold_id; with_strategy2 opaque [aid] (assert_fails unfold_id; with_strategy2 transparent [aid] (assert_succeeds unfold_id; with_strategy2 opaque [aid] (with_strategy2 expand [aid] (assert_succeeds unfold_id))))))))))). reflexivity. Qed. Goal id 0 = 0. with_strategy2 opaque [idn] (with_strategy2 opaque [idn] (assert_fails unfold_id; with_strategy2 transparent [idn] (assert_succeeds unfold_id; with_strategy2 opaque [idn] (with_strategy2 0 [idn] (assert_succeeds unfold_id; with_strategy2 1 [idn] (assert_succeeds unfold_id; with_strategy2 -1 [idn] (assert_succeeds unfold_id; with_strategy2 opaque [idn] (assert_fails unfold_id; with_strategy2 transparent [idn] (assert_succeeds unfold_id; with_strategy2 opaque [idn] (with_strategy2 expand [idn] (assert_succeeds unfold_id))))))))))). reflexivity. Qed. Opaque id. Goal id 0 = 0. with_strategy3 opaque [id] (with_strategy3 opaque [id] (assert_fails unfold_id; with_strategy3 transparent [id] (assert_succeeds unfold_id; with_strategy3 opaque [id] (with_strategy3 0 [id] (assert_succeeds unfold_id; with_strategy3 1 [id] (assert_succeeds unfold_id; with_strategy3 -1 [id] (assert_succeeds unfold_id; with_strategy3 opaque [id] (assert_fails unfold_id; with_strategy3 transparent [id] (assert_succeeds unfold_id; with_strategy3 opaque [id] (with_strategy3 expand [id] (assert_succeeds unfold_id))))))))))). (* This should succeed, but doesn't, basically due to https://github.com/coq/coq/issues/11202 *) Fail let idx := smart_global:(id) in with_strategy3 expand [idx] idtac. reflexivity. Qed. Goal id 0 = 0. with_strategy3 opaque [aid] (with_strategy3 opaque [aid] (assert_fails unfold_id; with_strategy3 transparent [aid] (assert_succeeds unfold_id; with_strategy3 opaque [aid] (with_strategy3 0 [aid] (assert_succeeds unfold_id; with_strategy3 1 [aid] (assert_succeeds unfold_id; with_strategy3 -1 [aid] (assert_succeeds unfold_id; with_strategy3 opaque [aid] (assert_fails unfold_id; with_strategy3 transparent [aid] (assert_succeeds unfold_id; with_strategy3 opaque [aid] (with_strategy3 expand [aid] (assert_succeeds unfold_id))))))))))). reflexivity. Qed. Goal id 0 = 0. with_strategy3 opaque [idn] (with_strategy3 opaque [idn] (assert_fails unfold_id; with_strategy3 transparent [idn] (assert_succeeds unfold_id; with_strategy3 opaque [idn] (with_strategy3 0 [idn] (assert_succeeds unfold_id; with_strategy3 1 [idn] (assert_succeeds unfold_id; with_strategy3 -1 [idn] (assert_succeeds unfold_id; with_strategy3 opaque [idn] (assert_fails unfold_id; with_strategy3 transparent [idn] (assert_succeeds unfold_id; with_strategy3 opaque [idn] (with_strategy3 expand [idn] (assert_succeeds unfold_id))))))))))). reflexivity. Qed. (* Fake out coqchk to work around what is essentially COQBUG(https://github.com/coq/coq/issues/12200) *) Reset Initial. coq-8.20.0/test-suite/tools/000077500000000000000000000000001466560755400156535ustar00rootroot00000000000000coq-8.20.0/test-suite/tools/coq_config_to_make.ml000066400000000000000000000034621466560755400220200ustar00rootroot00000000000000(* Flags used to compile Coq but _not_ plugins (via coq_makefile) *) module Prefs = struct type t = { warn_error : bool } let default = { warn_error = true } end (** This Makefile is only used in the test-suite now, remove eventually. *) let write_makefile coqprefix coqlibinstall best_compiler ocamlfind caml_flags coq_caml_flags o () = let pr s = Format.fprintf o s in pr "###### Coq Test suite configuration ##############################\n"; pr "# #\n"; pr "# This file is generated by the script \"coq_config_to_make\" #\n"; pr "# DO NOT EDIT IT !! DO NOT EDIT IT !! DO NOT EDIT IT !! #\n"; pr "# #\n"; pr "##################################################################\n\n"; pr "# Paths where Coq is installed\n"; pr "COQPREFIX=%s\n" coqprefix; pr "COQLIBINSTALL=%s\n\n" coqlibinstall; pr "# The best compiler: native (=opt) or bytecode (=byte)\n"; pr "BEST=%s\n\n" best_compiler; pr "# Findlib command\n"; pr "OCAMLFIND=%S\n" ocamlfind; pr "# Caml flags\n"; pr "CAMLFLAGS=%s %s\n" caml_flags coq_caml_flags; () let coq_warn_error (prefs : Prefs.t) = if prefs.warn_error then "-warn-error +a" else "" let main () = let prefs = Prefs.default in let coqprefix = Coq_config.install_prefix in let coqlibinstall = Coq_config.coqlib in (* EJGA: Good enough approximation *) let best_compiler = if Coq_config.has_natdynlink then "opt" else "byte" in let ocamlfind = Coq_config.ocamlfind in let caml_flags = Coq_config.caml_flags in let coq_caml_flags = coq_warn_error prefs in Format.printf "@[%a@]@\n%!" (write_makefile coqprefix coqlibinstall best_compiler ocamlfind caml_flags coq_caml_flags) (); () let () = main () coq-8.20.0/test-suite/tools/coq_config_to_make.mli000066400000000000000000000000001466560755400221520ustar00rootroot00000000000000coq-8.20.0/test-suite/tools/dune000066400000000000000000000001051466560755400165250ustar00rootroot00000000000000(executable (name coq_config_to_make) (libraries coq-core.config)) coq-8.20.0/test-suite/tools/update-compat/000077500000000000000000000000001466560755400204165ustar00rootroot00000000000000coq-8.20.0/test-suite/tools/update-compat/run.sh000077500000000000000000000006171466560755400215650ustar00rootroot00000000000000#!/usr/bin/env bash # allow running this script from any directory by basing things on where the script lives SCRIPT_DIR="$( cd "$( dirname "${BASH_SOURCE[0]}" )" >/dev/null && pwd )" # we assume that the script lives in test-suite/tools/update-compat/, # and that update-compat.py lives in dev/tools/ cd "${SCRIPT_DIR}/../../.." dev/tools/update-compat.py --assert-unchanged --release || exit $? coq-8.20.0/test-suite/unit-tests/000077500000000000000000000000001466560755400166325ustar00rootroot00000000000000coq-8.20.0/test-suite/unit-tests/.merlin.in000066400000000000000000000000331466560755400205220ustar00rootroot00000000000000REC S ** B ** PKG ounit2 coq-8.20.0/test-suite/unit-tests/clib/000077500000000000000000000000001466560755400175435ustar00rootroot00000000000000coq-8.20.0/test-suite/unit-tests/clib/clist.ml000066400000000000000000000031141466560755400212120ustar00rootroot00000000000000open Utest let log_out_ch = open_log_out_ch __FILE__ let reference_filter = let rec filter f = function | [] -> [] | x :: tl as l -> if f x then let tl' = filter f tl in if tl == tl' then l else x :: tl' else filter f tl in filter let () = let () = Random.self_init () in let seed = Random.bits() in Printf.fprintf log_out_ch "seed = %d\n" seed; Random.init seed let lists = List.init 100 (fun _ -> let len = Random.int 100 in List.init len (fun _ -> let b = Random.bool() in let v = Random.bits() in b,v)) let t1 = mk_bool_test "clib-clist0" "filter produces correct values" (List.for_all (fun l -> let expected : (bool * int) list = reference_filter fst l in let generated = CList.filter fst l in expected = generated) lists) let lists' = List.init 100 (fun _ -> let len = Random.int 100 in let keepafter = if len = 0 then 0 else Random.int len in let l = List.init len (fun i -> let b = i >= keepafter || Random.bool () in let v = Random.bits() in b, v) in keepafter, l) let t2 = mk_bool_test "clib-clist1" "filter correctly preserves physical equality of tails" (List.for_all (fun (keepafter,l) -> flush log_out_ch; let generated = CList.filter fst l in let tl = CList.skipn keepafter l in let generated_tl = CList.lastn (List.length tl) generated in tl == generated_tl) lists') let tests = [ t1; t2 ] let _ = run_tests __FILE__ log_out_ch tests coq-8.20.0/test-suite/unit-tests/clib/inteq.ml000066400000000000000000000005031466560755400212130ustar00rootroot00000000000000open Utest let log_out_ch = open_log_out_ch __FILE__ let eq0 = mk_bool_test "clib-inteq0" "Int.equal on 0" (Int.equal 0 0) let eq42 = mk_bool_test "clib-inteq42" "Int.equal on 42" (Int.equal 42 42) let tests = [ eq0; eq42 ] let _ = run_tests __FILE__ log_out_ch tests coq-8.20.0/test-suite/unit-tests/clib/unicode_tests.ml000066400000000000000000000010271466560755400227450ustar00rootroot00000000000000open Utest let log_out_ch = open_log_out_ch __FILE__ let unicode0 = mk_eq_test "clib-unicode0" "split_at_first_letter, first letter is character" None (Unicode.split_at_first_letter "ident") let unicode1 = mk_eq_test "clib-unicode1" "split_at_first_letter, first letter not character" (Some ("__","ident")) (Unicode.split_at_first_letter "__ident") let tests = [ unicode0; unicode1 ] let _ = run_tests __FILE__ log_out_ch tests coq-8.20.0/test-suite/unit-tests/lib/000077500000000000000000000000001466560755400174005ustar00rootroot00000000000000coq-8.20.0/test-suite/unit-tests/lib/coqProject.ml000066400000000000000000000035601466560755400220470ustar00rootroot00000000000000open OUnit open Utest open CoqProject_file let tests = ref [] let add_test name test = tests := (mk_test name (TestCase test)) :: !tests let sourced_file x = { thing = x; source = ProjectFile } (* Implicit argument for `read_project_file` *) let warning_fn _ = () let t () = let project_file_contents = "" in bracket_tmpfile (fun (project_file_path, project_file_channel) -> output_string project_file_channel project_file_contents; flush project_file_channel; let expected : unit project = { project_file = Some project_file_path; makefile = None; native_compiler = None; docroot = None; files = []; cmd_line_files = []; meta_file = Absent; ml_includes = []; r_includes = []; q_includes = []; extra_args = []; defs = []; extra_data = (); } in assert_equal expected (read_project_file ~warning_fn project_file_path) ) () let _ = add_test "empty file" t let t () = let project_file_contents = "-arg \"-w default\" -arg -w -arg foo -arg \"-set 'Default Goal Selector=!'\"" in bracket_tmpfile (fun (project_file_path, project_file_channel) -> output_string project_file_channel project_file_contents; flush project_file_channel; let expected : unit project = { project_file = Some project_file_path; makefile = None; native_compiler = None; docroot = None; files = []; cmd_line_files = []; meta_file = Absent; ml_includes = []; r_includes = []; q_includes = []; extra_args = List.map sourced_file ["-w"; "default"; "-w"; "foo"; "-set"; "Default Goal Selector=!"]; defs = []; extra_data = (); } in assert_equal expected (read_project_file ~warning_fn project_file_path) ) () let _ = add_test "-arg separation" t let _ = run_tests __FILE__ (open_log_out_ch __FILE__) (List.rev !tests) coq-8.20.0/test-suite/unit-tests/lib/pp_big_vect.ml000066400000000000000000000005321466560755400222130ustar00rootroot00000000000000open OUnit open Pp let pr_big_vect = let n = "pr_big_vect" in n >:: (fun () -> let v = Array.make (1 lsl 20) () in let pp = prvecti_with_sep spc (fun _ _ -> str"x") v in let str = string_of_ppcmds pp in ignore(str)) let tests = [pr_big_vect] let () = Utest.run_tests __FILE__ (Utest.open_log_out_ch __FILE__) tests coq-8.20.0/test-suite/unit-tests/parsing/000077500000000000000000000000001466560755400202755ustar00rootroot00000000000000coq-8.20.0/test-suite/unit-tests/parsing/lexer_recovery.ml000066400000000000000000000037151466560755400236720ustar00rootroot00000000000000(* The idea of this test is to have the lexer crash at a new line, with the ∀ symbol in line 2; then we test that we can recover correctly. *) let doc = "Definition map_union_weak `{β A, Insert K A (M A), ∀ A, Empty (M A), ∀ A, Lookup K A (M A), ∀ A, FinMapToList K A (M A)} {A} (m1 m2 : M A) := map_imap (λ l v, Some (default v (m1 !! l))) m2." let parse pa n = let entry = Pvernac.Vernac_.main_entry in let rec loop res n = if n = 0 then res else match Pcoq.Entry.parse entry pa with | None -> res | Some r -> loop (r :: res) (n-1) in loop [] n |> List.rev let raw_pr_loc fmt (l : Loc.t) = let { Loc.fname=_; line_nb; bol_pos; line_nb_last; bol_pos_last; bp; ep } = l in Format.fprintf fmt "| line_nb: %d | bol_pos: %d | line_nb_last: %d | bol_pos_last: %d | bp: %d | ep: %d |" line_nb bol_pos line_nb_last bol_pos_last bp ep let print_locs fmt { CAst.loc; _ } = Option.iter (Format.fprintf fmt "@[%a@]" raw_pr_loc) loc let setup_pa () = let text = doc in Pcoq.Parsable.make (Gramlib.Stream.of_string text) let parse_whole pa = parse pa 10 (* Use junk *) let log_file = __FILE__ ^ ".log" let main () = let pa = setup_pa () in let res, loc = try let _ = parse_whole pa in false, Pcoq.Parsable.loc pa with (* should be `E Undefined_token` but type is private *) | CLexer.Error.E _ -> (* We now consume a single token and check that the location is correct for "A" *) let () = Pcoq.Parsable.consume pa 1 in let loc = Pcoq.Parsable.loc pa in let res = (loc.line_nb = 2) && (loc.bol_pos = 52) && (loc.bp = 58) && (loc.ep = 59) in res, loc | _ -> false, Pcoq.Parsable.loc pa in let oc = Stdlib.open_out log_file in let outf = Format.formatter_of_out_channel oc in Format.fprintf outf "fail lexer test passed: %a@\n%!" raw_pr_loc loc; Format.pp_print_flush outf (); Stdlib.close_out oc; if res then exit 0 else exit 1 let () = main () coq-8.20.0/test-suite/unit-tests/parsing/resumption.ml000066400000000000000000000045321466560755400230400ustar00rootroot00000000000000let doc = "Definition a := Type. Definition b := Prop. Definition c := b. Definition d := c. (* this is a comment *) Definition m := forall (x : Type), x. " let parse pa n = let entry = Pvernac.Vernac_.main_entry in let rec loop res n = if n = 0 then res else match Pcoq.Entry.parse entry pa with | None -> res | Some r -> loop (r :: res) (n-1) in loop [] n |> List.rev let raw_pr_loc fmt (l : Loc.t) = let { Loc.fname=_; line_nb; bol_pos; line_nb_last; bol_pos_last; bp; ep } = l in Format.fprintf fmt "| line_nb: %d | bol_pos: %d | line_nb_last: %d | bol_pos_last: %d | bp: %d | ep: %d |" line_nb bol_pos line_nb_last bol_pos_last bp ep let print_locs fmt { CAst.loc; _ } = Option.iter (Format.fprintf fmt "@[%a@]" raw_pr_loc) loc let parse_whole () = let text = doc in let pa = Pcoq.Parsable.make (Gramlib.Stream.of_string text) in parse pa 10 (* Use junk *) let parse_n n = let pa = Pcoq.Parsable.make (Gramlib.Stream.of_string doc) in let res1 = parse pa n in let loc = Pcoq.Parsable.loc pa |> CLexer.after in let str = Gramlib.Stream.of_string doc in Gramlib.Stream.njunk () loc.bp str; let pa = Pcoq.Parsable.make ~loc str in let res2 = parse pa 10 in res1 @ res2 (* Use offset to set count and avoid the junk *) let parse_n_offset n = let pa = Pcoq.Parsable.make (Gramlib.Stream.of_string doc) in let res1 = parse pa n in let loc = Pcoq.Parsable.loc pa |> CLexer.after in let doc = String.sub doc loc.bp (String.length doc - loc.bp) in let str = Gramlib.Stream.of_string ~offset:loc.bp doc in let pa = Pcoq.Parsable.make ~loc str in let res2 = parse pa 10 in res1 @ res2 let log_file = __FILE__ ^ ".log" let main () = let reference = parse_whole () in let test1 = [parse_n 1; parse_n 2; parse_n 3; parse_n 4; parse_n 5] in let test2 = [parse_n_offset 1; parse_n_offset 2; parse_n_offset 3; parse_n_offset 4; parse_n_offset 5] in let tests = test1 @ test2 in let res = List.for_all (fun t -> t = reference) tests in let oc = Stdlib.open_out log_file in let outf = Format.formatter_of_out_channel oc in Format.fprintf outf "split parsing test passed: %b@\n%!" res; List.iter (Format.fprintf outf "locs@\n@[%a@]@\n@\n" (Format.pp_print_list print_locs)) tests; Format.pp_print_flush outf (); Stdlib.close_out oc; if res then exit 0 else exit 1 let () = main () coq-8.20.0/test-suite/unit-tests/printing/000077500000000000000000000000001466560755400204645ustar00rootroot00000000000000coq-8.20.0/test-suite/unit-tests/printing/proof_diffs_test.ml000066400000000000000000000350431466560755400243620ustar00rootroot00000000000000open OUnit open Utest open Pp_diff open Proof_diffs (* Needed to be able to set through goptions *) let () = let open Names in Lib.start_compilation DirPath.dummy (ModPath.MPfile DirPath.dummy) let tokenize_string = Proof_diffs.tokenize_string let diff_pp = diff_pp ~tokenize_string let diff_str = diff_str ~tokenize_string let tests = ref [] let add_test name test = tests := (mk_test name (TestCase test)) :: !tests let log_out_ch = open_log_out_ch __FILE__ let cfprintf oc = Printf.(kfprintf (fun oc -> fprintf oc "") oc) let cprintf s = cfprintf log_out_ch s let _ = Proof_diffs.log_out_ch := log_out_ch let string_of_string s : string = "\"" ^ s ^ "\"" (* todo: OCaml: why can't the body of the test function be given in the add_test line? *) let t () = let expected : diff_list = [] in let diffs = diff_str "" " " in assert_equal ~msg:"empty" ~printer:string_of_diffs expected diffs; let (has_added, has_removed) = has_changes diffs in assert_equal ~msg:"has `Added" ~printer:string_of_bool false has_added; assert_equal ~msg:"has `Removed" ~printer:string_of_bool false has_removed let _ = add_test "diff_str empty" t let t () = let expected : diff_list = [ `Common (0, 0, "a"); `Common (1, 1, "b"); `Common (2, 2, "c")] in let diffs = diff_str "a b c" " a b\t c\n" in assert_equal ~msg:"white space" ~printer:string_of_diffs expected diffs; let (has_added, has_removed) = has_changes diffs in assert_equal ~msg:"no `Added" ~printer:string_of_bool false has_added; assert_equal ~msg:"no `Removed" ~printer:string_of_bool false has_removed let _ = add_test "diff_str white space" t let t () = let expected : diff_list = [ `Removed (0, "a"); `Added (0, "b")] in let diffs = diff_str "a" "b" in assert_equal ~msg:"add/remove" ~printer:string_of_diffs expected diffs; let (has_added, has_removed) = has_changes diffs in assert_equal ~msg:"has `Added" ~printer:string_of_bool true has_added; assert_equal ~msg:"has `Removed" ~printer:string_of_bool true has_removed let _ = add_test "diff_str add/remove" t (* lexer tweaks: comments are lexed as multiple tokens strings tokens include begin/end quotes and embedded "" single multibyte characters returned even if they're not keywords inputs that give a lexer failure (but no use case needs them yet): ".12" unterminated string invalid UTF-8 sequences *) let t () = let str = "(* comment.field *) ?id () \"str\"\"ing\" \\ := Ж > ∃ 'c' xx" in let toks = tokenize_string str in (*List.iter (fun x -> cprintf "'%s' " x) toks;*) (*cprintf "\n";*) let str_no_white = String.concat "" (String.split_on_char ' ' str) in assert_equal ~printer:(fun x -> x) str_no_white (String.concat "" toks); List.iter (fun s -> assert_equal ~msg:("'" ^ s ^ "' is a single token") ~printer:string_of_bool true (List.mem s toks)) [ "(*"; "()"; ":="] let _ = add_test "tokenize_string/diff_mode in lexer" t open Pp let write_diffs_option s = Goptions.set_string_option_value Proof_diffs.opt_name s (* example that was failing from #8922 *) let t () = write_diffs_option "removed"; ignore (diff_str "X : ?Goal" "X : forall x : ?Goal0, ?Goal1"); write_diffs_option "on" let _ = add_test "shorten_diff_span failure from #8922" t (* note pp_to_string concatenates adjacent strings, could become one token, e.g. str " a" ++ str "b " will give a token "ab" *) (* checks background is present and correct *) let t () = let o_pp = str "a" ++ str "!" ++ str "c" in let n_pp = str "a" ++ str "?" ++ str "c" in let (o_exp, n_exp) = (wrap_in_bg "diff.removed" (str "a" ++ (tag "diff.removed" (str "!")) ++ str "c"), wrap_in_bg "diff.added" (str "a" ++ (tag "diff.added" (str "?")) ++ str "c")) in let (o_diff, n_diff) = diff_pp o_pp n_pp in assert_equal ~msg:"removed" ~printer:db_string_of_pp o_exp o_diff; assert_equal ~msg:"added" ~printer:db_string_of_pp n_exp n_diff let _ = add_test "diff_pp/add_diff_tags add/remove" t let t () = (*Printf.printf "%s\n" (string_of_diffs (diff_str "a d" "a b c d"));*) let o_pp = str "a" ++ str " d" in let n_pp = str "a" ++ str " b " ++ str " c " ++ str "d" ++ str " e " in let n_exp = flatten (wrap_in_bg "diff.added" (seq [ str "a"; str " "; (tag "start.diff.added" (str "b ")); (tag "end.diff.added" (str " c")); str " "; (str "d"); str " "; (tag "diff.added" (str "e")); str " " ])) in let (_, n_diff) = diff_pp o_pp n_pp in assert_equal ~msg:"added" ~printer:db_string_of_pp n_exp (flatten n_diff) let _ = add_test "diff_pp/add_diff_tags a span with spaces" t let t () = let o_pp = str " " in let n_pp = tag "sometag" (str "a") in let n_exp = flatten (wrap_in_bg "diff.added" (tag "diff.added" (tag "sometag" (str "a")))) in let (_, n_diff) = diff_pp o_pp n_pp in assert_equal ~msg:"added" ~printer:db_string_of_pp n_exp (flatten n_diff) let _ = add_test "diff_pp/add_diff_tags diff tags outside existing tags" t let t () = let o_pp = str " " in let n_pp = seq [(tag "sometag" (str " a ")); str "b"] in let n_exp = flatten (wrap_in_bg "diff.added" (seq [tag "sometag" (str " "); (tag "start.diff.added" (tag "sometag" (str "a "))); (tag "end.diff.added" (str "b"))]) ) in let (_, n_diff) = diff_pp o_pp n_pp in assert_equal ~msg:"added" ~printer:db_string_of_pp n_exp (flatten n_diff) let _ = add_test "diff_pp/add_diff_tags existing tagged values with spaces" t let t () = let o_pp = str " " in let n_pp = str " a b " in let n_exp = flatten (wrap_in_bg "diff.added" (seq [str " "; tag "diff.added" (str "a b"); str " "])) in let (_, n_diff) = diff_pp o_pp n_pp in assert_equal ~msg:"added" ~printer:db_string_of_pp n_exp (flatten n_diff) let _ = add_test "diff_pp/add_diff_tags multiple tokens in pp" t let t () = let o_pp = str "a d" in let n_pp = seq [str "a b"; str "c d"] in let n_exp = flatten (wrap_in_bg "diff.added" (seq [str "a "; tag "start.diff.added" (str "b"); tag "end.diff.added" (str "c"); str " d"])) in let (_, n_diff) = diff_pp o_pp n_pp in assert_equal ~msg:"added" ~printer:db_string_of_pp n_exp (flatten n_diff) let _ = add_test "diff_pp/add_diff_tags token spanning multiple Ppcmd_strs" t let t () = let o_pp = seq [str ""; str "a"] in let n_pp = seq [str ""; str "a b"] in let n_exp = flatten (wrap_in_bg "diff.added" (seq [str ""; str "a "; tag "diff.added" (str "b")])) in let (_, n_diff) = diff_pp o_pp n_pp in assert_equal ~msg:"added" ~printer:db_string_of_pp n_exp (flatten n_diff) let _ = add_test "diff_pp/add_diff_tags empty string preserved" t (* todo: awaiting a change in the lexer to return the quotes of the string token *) let t () = let s = "\"a b\"" in let o_pp = seq [str s] in let n_pp = seq [str "\"a b\" "] in cprintf "ppcmds: %s\n" (string_of_ppcmds n_pp); let n_exp = flatten (wrap_in_bg "diff.added" (seq [str ""; str "a "; tag "diff.added" (str "b")])) in let (_, n_diff) = diff_pp o_pp n_pp in assert_equal ~msg:"string" ~printer:string_of_string "a b" (List.hd (tokenize_string s)); assert_equal ~msg:"added" ~printer:db_string_of_pp n_exp (flatten n_diff) let _ = if false then add_test "diff_pp/add_diff_tags token containing white space" t let add_entries map idents rhs_pp = let make_entry() = { idents; rhs_pp } in List.iter (fun ident -> map := CString.Map.add ident (make_entry ()) !map) idents let print_list hyps = List.iter (fun x -> cprintf "%s\n" (string_of_ppcmds (flatten x))) hyps let db_print_list hyps = List.iter (fun x -> cprintf "%s\n" (db_string_of_pp (flatten x))) hyps (* a : uint b : int car -> b : car a : uint int DIFFS b : car (remove int) b : car (added bg only) a: uint int (add int) *) let t () = write_diffs_option "removed"; (* turn on "removed" option *) let o_line_idents = [ ["a"]; ["b"]] in let o_hyp_map = ref CString.Map.empty in add_entries o_hyp_map ["a"] (str " : uint"); add_entries o_hyp_map ["b"] (str " : int car"); let n_line_idents = [ ["b"]; ["a"]] in let n_hyp_map = ref CString.Map.empty in add_entries n_hyp_map ["b"] (str " : car"); add_entries n_hyp_map ["a"] (str " : uint int"); let expected = [flatten (wrap_in_bg "diff.removed" (seq [str "b"; str " : "; (tag "diff.removed" (str "int")); str " car" ])); flatten (wrap_in_bg "diff.added" (seq [str "b"; str " : car"])); flatten (wrap_in_bg "diff.added" (seq [str "a"; str " : uint "; (tag "diff.added" (str "int")) ])) ] in let hyps_diff_list = diff_hyps o_line_idents !o_hyp_map n_line_idents !n_hyp_map in (*print_list hyps_diff_list;*) (*db_print_list hyps_diff_list;*) List.iter2 (fun exp act -> assert_equal ~msg:"added" ~printer:db_string_of_pp exp (flatten act)) expected hyps_diff_list let _ = add_test "diff_hyps simple diffs" t (* a : nat c, d : int -> a, b : nat d : int DIFFS c, d : int (remove c,) a, b : nat (add ,b) d : int *) let t () = write_diffs_option "removed"; (* turn on "removed" option *) let o_line_idents = [ ["a"]; ["c"; "d"]] in let o_hyp_map = ref CString.Map.empty in add_entries o_hyp_map ["a"] (str " : nat"); add_entries o_hyp_map ["c"; "d"] (str " : int"); let n_line_idents = [ ["a"; "b"]; ["d"]] in let n_hyp_map = ref CString.Map.empty in add_entries n_hyp_map ["a"; "b"] (str " : nat"); add_entries n_hyp_map ["d"] (str " : int"); let expected = [flatten (wrap_in_bg "diff.added" (seq [str "a"; (tag "start.diff.added" (str ", ")); (tag "end.diff.added" (str "b")); str " : nat" ])); flatten (wrap_in_bg "diff.removed" (seq [(tag "start.diff.removed" (str "c")); (tag "end.diff.removed" (str ",")); str " "; str "d"; str " : int" ])); flatten (seq [str "d"; str " : int" ]) ] in let hyps_diff_list = diff_hyps o_line_idents !o_hyp_map n_line_idents !n_hyp_map in (*print_list hyps_diff_list;*) (*print_list expected;*) (*db_print_list hyps_diff_list;*) (*db_print_list expected;*) List.iter2 (fun exp act -> assert_equal ~msg:"added" ~printer:db_string_of_pp exp (flatten act)) expected hyps_diff_list let _ = add_test "diff_hyps compacted" t (* a : uint b : int c : nat -> b, a, c : nat DIFFS a : uint (remove) b : int (remove) b, a, c : nat (add b, a,) is this a realistic use case? *) let t () = write_diffs_option "removed"; (* turn on "removed" option *) let o_line_idents = [ ["a"]; ["b"]; ["c"]] in let o_hyp_map = ref CString.Map.empty in add_entries o_hyp_map ["a"] (str " : uint"); add_entries o_hyp_map ["b"] (str " : int"); add_entries o_hyp_map ["c"] (str " : nat"); let n_line_idents = [ ["b"; "a"; "c"] ] in let n_hyp_map = ref CString.Map.empty in add_entries n_hyp_map ["b"; "a"; "c"] (str " : nat"); let expected = [flatten (wrap_in_bg "diff.removed" (seq [str "a"; str " : "; (tag "diff.removed" (str "uint"))])); flatten (wrap_in_bg "diff.removed" (seq [str "b"; str " : "; (tag "diff.removed" (str "int"))])); flatten (wrap_in_bg "diff.added" (seq [(tag "start.diff.added" (str "b")); str ", "; str "a"; (tag "end.diff.added" (str ",")); str " "; str "c"; str " : nat"])) ] in let hyps_diff_list = diff_hyps o_line_idents !o_hyp_map n_line_idents !n_hyp_map in (*print_list hyps_diff_list;*) (*db_print_list hyps_diff_list;*) List.iter2 (fun exp act -> assert_equal ~msg:"added" ~printer:db_string_of_pp exp (flatten act)) expected hyps_diff_list let _ = add_test "diff_hyps compacted with join" t (* b, a, c : nat -> a : uint b : int c : nat DIFFS b, a, c : nat (remove b,a,) a : uint (add uint) b : int (add int) c : nat is this a realistic use case? *) let t () = write_diffs_option "removed"; (* turn on "removed" option *) let o_line_idents = [ ["b"; "a"; "c"] ] in let o_hyp_map = ref CString.Map.empty in add_entries o_hyp_map ["b"; "a"; "c"] (str " : nat"); let n_line_idents = [ ["a"]; ["b"]; ["c"]] in let n_hyp_map = ref CString.Map.empty in add_entries n_hyp_map ["a"] (str " : uint"); add_entries n_hyp_map ["b"] (str " : int"); add_entries n_hyp_map ["c"] (str " : nat"); let expected = [flatten (wrap_in_bg "diff.removed" (seq [(tag "start.diff.removed" (str "b")); str ", "; str "a"; (tag "end.diff.removed" (str ",")); str " "; str "c"; str " : nat"])); flatten (wrap_in_bg "diff.added" (seq [str "a"; str " : "; (tag "diff.added" (str "uint"))])); flatten (wrap_in_bg "diff.added" (seq [str "b"; str " : "; (tag "diff.added" (str "int"))])); flatten (seq [str "c"; str " : nat"]) ] in let hyps_diff_list = diff_hyps o_line_idents !o_hyp_map n_line_idents !n_hyp_map in (*print_list hyps_diff_list;*) (*db_print_list hyps_diff_list;*) List.iter2 (fun exp act -> assert_equal ~msg:"added" ~printer:db_string_of_pp exp (flatten act)) expected hyps_diff_list let _ = add_test "diff_hyps compacted with split" t (* i : nat b : bool j : nat -> i, j : nat DIFFS b : bool (removed) i, j : nat *) let t () = write_diffs_option "removed"; (* turn on "removed" option *) let o_line_idents = [ ["i"]; ["b"]; ["j"] ] in let o_hyp_map = ref CString.Map.empty in add_entries o_hyp_map ["i"] (str " : nat"); add_entries o_hyp_map ["b"] (str " : bool"); add_entries o_hyp_map ["j"] (str " : nat"); let n_line_idents = [ ["i"; "j"]] in let n_hyp_map = ref CString.Map.empty in add_entries n_hyp_map ["i"; "j"] (str " : nat"); let expected = [flatten (wrap_in_bg "diff.removed" (seq [tag "start.diff.removed" (str "b"); tag "end.diff.removed" (str " : bool")])); flatten (seq [str "i"; str ", "; str "j"; str " : nat"]) ] in let hyps_diff_list = diff_hyps o_line_idents !o_hyp_map n_line_idents !n_hyp_map in (* print_list hyps_diff_list; *) (* db_print_list hyps_diff_list; *) List.iter2 (fun exp act -> assert_equal ~msg:"added" ~printer:db_string_of_pp exp (flatten act)) expected hyps_diff_list let _ = add_test "diff_hyps removal causes compaction from #14577" t (* other potential tests coqtop/terminal formatting BLOCKED: CAN'T GET TAGS IN FORMATTER white space at end of line spanning diffs shorten_diff_span MAYBE NOT WORTH IT diff_pp/add_diff_tags add/remove - show it preserves, recurs and processes: nested in boxes breaks, etc. preserved diff_pp_combined with/without removed *) let _ = run_tests __FILE__ log_out_ch (List.rev !tests) coq-8.20.0/test-suite/unit-tests/printing/proof_diffs_test_cases.v000066400000000000000000000016001466560755400253650ustar00rootroot00000000000000(* additional test cases for manual testing *) Goal 1 + 1 = 3 -> False -> True. intro. clear H; intro. Abort. Goal nat -> bool -> nat -> True. intros i b j. revert b. cbn. Abort. Require Import Coq.Init.Number. Goal int -> uint -> nat -> nat -> nat -> nat ->True. intros a b c. clear a b c; intros b a c. Abort. Goal int -> nat -> uint -> nat -> nat -> nat -> True. intros a b c. clear a b c; intros c a b. Abort. Goal uint -> int -> nat -> nat -> nat -> nat -> True. intros a b c. clear a b c; intros b a c. Abort. Goal nat -> int -> int -> nat -> nat -> int -> True. intros a c d. clear a c d; intros a b d. Abort. Goal 1 = 0 -> True -> False -> True. intros X H. clear H; intro. Abort. Goal True -> True -> False -> False -> True. intros H H0. clear H H0; intros H H0. Abort. Goal True -> True -> False -> False -> False -> True. intros H H0. clear H H0; intros H H0 H1. Abort. coq-8.20.0/test-suite/unit-tests/src/000077500000000000000000000000001466560755400174215ustar00rootroot00000000000000coq-8.20.0/test-suite/unit-tests/src/utest.ml000066400000000000000000000044241466560755400211230ustar00rootroot00000000000000open OUnit (* general case to build a test *) let mk_test nm test = nm >: test (* common cases for building tests *) let mk_eq_test nm descr expected actual = mk_test nm (TestCase (fun _ -> assert_equal ~msg:descr expected actual)) let mk_bool_test nm descr actual = mk_test nm (TestCase (fun _ -> assert_bool descr actual)) let cfprintf oc = Printf.(kfprintf (fun oc -> fprintf oc "\n%!") oc) (* given test result, print message, return success boolean *) let logger out_ch result = let cprintf s = cfprintf out_ch s in match result with | RSuccess path -> cprintf "TEST SUCCEEDED: %s" (string_of_path path); true | RError (path,msg) | RFailure (path,msg) -> cprintf "TEST FAILED: %s (%s)" (string_of_path path) msg; false | RSkip (path,msg) | RTodo (path,msg) -> cprintf "TEST DID NOT SUCCEED: %s (%s)" (string_of_path path) msg; false (* run one OUnit test case, return successes, no. of tests *) (* notionally one test, which might be a TestList *) let run_one logit test = let rec process_results rs = match rs with [] -> (0,0) | (r::rest) -> let succ = if logit r then 1 else 0 in let succ_results,tot_results = process_results rest in (succ + succ_results,tot_results + 1) in let results = perform_test (fun _ -> ()) test in process_results results let open_log_out_ch ml_fn = let log_fn = ml_fn ^ ".log" in open_out log_fn (* run list of OUnit test cases, log results *) let run_tests ml_fn out_ch tests = let cprintf s = cfprintf out_ch s in let ceprintf s = cfprintf stderr s in let logit = logger out_ch in let rec run_some tests succ tot = match tests with [] -> (succ,tot) | (t::ts) -> let succ_one,tot_one = run_one logit t in run_some ts (succ + succ_one) (tot + tot_one) in (* format for test-suite summary to find status success if all tests succeeded, else failure *) let succ,tot = run_some tests 0 0 in cprintf "*** Ran %d tests, with %d successes and %d failures ***" tot succ (tot - succ); if succ = tot then cprintf "==========> SUCCESS <==========\n %s...Ok" ml_fn else begin cprintf "==========> FAILURE <==========\n %s...Error!" ml_fn; ceprintf "FAILED %s.log" ml_fn end; close_out out_ch coq-8.20.0/test-suite/unit-tests/src/utest.mli000066400000000000000000000012171466560755400212710ustar00rootroot00000000000000(** give a name to a unit test *) val mk_test : string -> OUnit.test -> OUnit.test (** simple ways to build a test *) val mk_eq_test : string -> string -> 'a -> 'a -> OUnit.test val mk_bool_test : string -> string -> bool -> OUnit.test (** run unit tests *) (* the string argument should be the name of the .ml file containing the tests; use __FILE__ for that purpose. *) val run_tests : string -> out_channel -> OUnit.test list -> unit (** open output channel for the test log file *) (* the string argument should be the name of the .ml file containing the tests; use __FILE__ for that purpose. *) val open_log_out_ch : string -> out_channel coq-8.20.0/theories/000077500000000000000000000000001466560755400142275ustar00rootroot00000000000000coq-8.20.0/theories/Arith/000077500000000000000000000000001466560755400152765ustar00rootroot00000000000000coq-8.20.0/theories/Arith/Arith.v000066400000000000000000000013311466560755400165320ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* eq_sym (proj1 (Nat.le_0_r n) Hle). Opaque le_n_0_eq_stt. Add Search Blacklist "Coq.Arith.Arith_base.le_n_0_eq_stt". #[global] Hint Immediate le_n_0_eq_stt Nat.lt_le_incl Peano.le_S_n : arith. (* Le.le_n_0_eq Le.le_Sn_le Le.le_S_n *) #[global] Hint Resolve Nat.le_pred_l: arith. (* Le.le_pred_n *) #[global] Hint Resolve Nat.lt_irrefl: arith. (* Lt.lt_irrefl *) #[local] Definition lt_le_S_stt := fun n m => (proj2 (Nat.le_succ_l n m)). Opaque lt_le_S_stt. Add Search Blacklist "Coq.Arith.Arith_base.lt_le_S_stt". #[global] Hint Immediate lt_le_S_stt: arith. (* Lt.lt_le_S *) #[local] Definition lt_n_Sm_le_stt := fun n m => (proj1 (Nat.lt_succ_r n m)). Opaque lt_n_Sm_le_stt. Add Search Blacklist "Coq.Arith.Arith_base.lt_n_Sm_le_stt". #[global] Hint Immediate lt_n_Sm_le_stt: arith. (* Lt.lt_n_Sm_le *) #[local] Definition le_lt_n_Sm_stt := fun n m => (proj2 (Nat.lt_succ_r n m)). Opaque le_lt_n_Sm_stt. Add Search Blacklist "Coq.Arith.Arith_base.le_lt_n_Sm_stt". #[global] Hint Immediate le_lt_n_Sm_stt: arith. (* Lt.le_lt_n_Sm *) #[local] Definition le_not_lt_stt := fun n m => (proj1 (Nat.le_ngt n m)). Opaque le_not_lt_stt. Add Search Blacklist "Coq.Arith.Arith_base.le_not_lt_stt". #[global] Hint Immediate le_not_lt_stt: arith. (* Lt.le_not_lt *) #[local] Definition lt_not_le_stt := fun n m => (proj1 (Nat.lt_nge n m)). Opaque lt_not_le_stt. Add Search Blacklist "Coq.Arith.Arith_base.lt_not_le_stt". #[global] Hint Immediate lt_not_le_stt: arith. (* Lt.lt_not_le *) #[global] Hint Resolve Nat.lt_0_succ Nat.nlt_0_r: arith. (* Lt.lt_0_Sn Lt.lt_n_0 *) #[local] Definition neq_0_lt_stt := fun n Hn => proj1 (Nat.neq_0_lt_0 n) (Nat.neq_sym 0 n Hn). Opaque neq_0_lt_stt. Add Search Blacklist "Coq.Arith.Arith_base.neq_0_lt_stt". #[local] Definition lt_0_neq_stt := fun n Hlt => Nat.neq_sym n 0 (proj2 (Nat.neq_0_lt_0 n) Hlt). Opaque lt_0_neq_stt. Add Search Blacklist "Coq.Arith.Arith_base.lt_0_neq_stt". #[global] Hint Immediate neq_0_lt_stt lt_0_neq_stt: arith. (* Lt.neq_0_lt Lt.lt_0_neq *) #[global] Hint Resolve Nat.lt_succ_diag_r Nat.lt_lt_succ_r: arith. (* Lt.lt_n_Sn Lt.lt_S *) #[local] Definition lt_n_S_stt := fun n m => (proj1 (Nat.succ_lt_mono n m)). Opaque lt_n_S_stt. Add Search Blacklist "Coq.Arith.Arith_base.lt_n_S_stt". #[global] Hint Resolve lt_n_S_stt: arith. (* Lt.lt_n_S *) #[local] Definition lt_S_n_stt := fun n m => (proj2 (Nat.succ_lt_mono n m)). Opaque lt_S_n_stt. Add Search Blacklist "Coq.Arith.Arith_base.lt_S_n_stt". #[global] Hint Immediate lt_S_n_stt: arith. (* Lt.lt_S_n *) #[local] Definition lt_pred_stt := fun n m => proj1 (Nat.lt_succ_lt_pred n m). Opaque lt_pred_stt. Add Search Blacklist "Coq.Arith.Arith_base.lt_pred_stt". #[global] Hint Immediate lt_pred_stt: arith. (* Lt.lt_pred *) #[local] Definition lt_pred_n_n_stt := fun n Hlt => Nat.lt_pred_l n (proj2 (Nat.neq_0_lt_0 n) Hlt). Opaque lt_pred_n_n_stt. Add Search Blacklist "Coq.Arith.Arith_base.lt_pred_n_n_stt". #[global] Hint Resolve lt_pred_n_n_stt: arith. (* Lt.lt_pred_n_n *) #[global] Hint Resolve Nat.lt_trans Nat.lt_le_trans Nat.le_lt_trans: arith. (* Lt.lt_trans Lt.lt_le_trans Lt.le_lt_trans *) #[global] Hint Immediate Nat.lt_le_incl: arith. (* Lt.lt_le_weak *) #[local] Definition gt_Sn_O_stt : forall n, S n > 0 := Nat.lt_0_succ. Opaque gt_Sn_O_stt. Add Search Blacklist "Coq.Arith.Arith_base.gt_Sn_O_stt". #[global] Hint Resolve gt_Sn_O_stt: arith. (* Gt.gt_Sn_O *) #[local] Definition gt_Sn_n_stt : forall n, S n > n := Nat.lt_succ_diag_r. Opaque gt_Sn_n_stt. Add Search Blacklist "Coq.Arith.Arith_base.gt_Sn_n_stt". #[global] Hint Resolve gt_Sn_n_stt: arith. (* Gt.gt_Sn_n *) #[local] Definition gt_n_S_stt : forall n m, n > m -> S n > S m := fun n m Hgt => proj1 (Nat.succ_lt_mono m n) Hgt. Opaque gt_n_S_stt. Add Search Blacklist "Coq.Arith.Arith_base.gt_n_S_stt". #[global] Hint Resolve gt_n_S_stt: arith. (* Gt.gt_n_S *) #[local] Definition gt_S_n_stt : forall n m, S m > S n -> m > n := fun n m Hgt => proj2 (Nat.succ_lt_mono n m) Hgt. Opaque gt_S_n_stt. Add Search Blacklist "Coq.Arith.Arith_base.gt_S_n_stt". #[global] Hint Immediate gt_S_n_stt: arith. (* Gt.gt_S_n *) #[local] Definition gt_pred_stt : forall n m, m > S n -> pred m > n := fun n m Hgt => proj1 (Nat.lt_succ_lt_pred n m) Hgt. Opaque gt_pred_stt. Add Search Blacklist "Coq.Arith.Arith_base.gt_pred_stt". #[global] Hint Immediate gt_pred_stt: arith. (* Gt.gt_pred *) #[local] Definition gt_irrefl_stt : forall n, ~ n > n := Nat.lt_irrefl. Opaque gt_irrefl_stt. Add Search Blacklist "Coq.Arith.Arith_base.gt_irrefl_stt". #[global] Hint Resolve gt_irrefl_stt: arith. (* Gt.gt_irrefl *) #[local] Definition gt_asym_stt : forall n m, n > m -> ~ m > n := fun n m => Nat.lt_asymm m n. Opaque gt_asym_stt. Add Search Blacklist "Coq.Arith.Arith_base.gt_asym_stt". #[global] Hint Resolve gt_asym_stt: arith. (* Gt.gt_asym *) #[local] Definition le_not_gt_stt : forall n m, n <= m -> ~ n > m := fun n m => proj1 (Nat.le_ngt n m). Opaque le_not_gt_stt. Add Search Blacklist "Coq.Arith.Arith_base.le_not_gt_stt". #[global] Hint Resolve le_not_gt_stt: arith. (* Gt.le_not_gt *) #[local] Definition gt_not_le_stt: forall n m, n > m -> ~ n <= m := fun n m => proj1 (Nat.lt_nge m n). Opaque gt_not_le_stt. Add Search Blacklist "Coq.Arith.Arith_base.gt_not_le_stt". #[global] Hint Resolve gt_not_le_stt: arith. (* Gt.gt_not_le *) #[local] Definition le_S_gt_stt: forall n m, S n <= m -> m > n := fun n m => proj1 (Nat.le_succ_l n m). Opaque le_S_gt_stt. Add Search Blacklist "Coq.Arith.Arith_base.le_S_gt_stt". #[global] Hint Immediate le_S_gt_stt:arith. (* Gt.le_S_gt *) #[local] Definition gt_S_le_stt : forall n m, S m > n -> n <= m := fun n m => proj2 (Nat.succ_le_mono n m). Opaque gt_S_le_stt. Add Search Blacklist "Coq.Arith.Arith_base.gt_S_le_stt". #[global] Hint Immediate gt_S_le_stt:arith. (* Gt.gt_S_le *) #[local] Definition gt_le_S_stt : forall n m, m > n -> S n <= m := fun n m => proj2 (Nat.le_succ_l n m). Opaque gt_le_S_stt. Add Search Blacklist "Coq.Arith.Arith_base.gt_le_S_stt". #[global] Hint Resolve gt_le_S_stt:arith. (* Gt.gt_le_S *) #[local] Definition le_gt_S_stt : forall n m, n <= m -> S m > n := fun n m => proj1 (Nat.succ_le_mono n m). Opaque le_gt_S_stt. Add Search Blacklist "Coq.Arith.Arith_base.le_gt_S_stt". #[global] Hint Resolve le_gt_S_stt:arith. (* Gt.le_gt_S *) #[local] Definition gt_trans_S_stt : forall n m p, S n > m -> m > p -> n > p := fun n m p Hgt1 Hgt2 => Nat.lt_le_trans p m n Hgt2 (proj2 (Nat.succ_le_mono _ _) Hgt1). Opaque gt_trans_S_stt. Add Search Blacklist "Coq.Arith.Arith_base.gt_trans_S_stt". #[global] Hint Resolve gt_trans_S_stt:arith. (* Gt.gt_trans_S *) #[local] Definition le_gt_trans_stt : forall n m p, m <= n -> m > p -> n > p := fun n m p Hle Hgt => Nat.lt_le_trans p m n Hgt Hle. Opaque le_gt_trans_stt. Add Search Blacklist "Coq.Arith.Arith_base.le_gt_trans_stt". #[global] Hint Resolve le_gt_trans_stt:arith. (* Gt.le_gt_trans *) #[local] Definition gt_le_trans_stt : forall n m p, n > m -> p <= m -> n > p := fun n m p Hgt Hle => Nat.le_lt_trans p m n Hle Hgt. Opaque gt_le_trans_stt. Add Search Blacklist "Coq.Arith.Arith_base.gt_le_trans_stt". #[global] Hint Resolve gt_le_trans_stt:arith. (* Gt.gt_le_trans *) #[local] Definition plus_gt_compat_l_stt : forall n m p, n > m -> p + n > p + m := fun n m p Hgt => proj1 (Nat.add_lt_mono_l m n p) Hgt. Opaque plus_gt_compat_l_stt. Add Search Blacklist "Coq.Arith.Arith_base.plus_gt_compat_l_stt". #[global] Hint Resolve plus_gt_compat_l_stt:arith. (* Gt.plus_gt_compat_l *) (* ** [add] *) #[global] Hint Immediate Nat.add_comm : arith. (* Plus.plus_comm *) #[global] Hint Resolve Nat.add_assoc : arith. (* Plus.plus_assoc *) #[local] Definition plus_assoc_reverse_stt := fun n m p => eq_sym (Nat.add_assoc n m p). Opaque plus_assoc_reverse_stt. Add Search Blacklist "Coq.Arith.Arith_base.plus_assoc_reverse_stt". #[global] Hint Resolve plus_assoc_reverse_stt : arith. (* Plus.plus_assoc_reverse *) #[global] Hint Resolve -> Nat.add_le_mono_l : arith. (* Plus.plus_le_compat_l *) #[global] Hint Resolve -> Nat.add_le_mono_r : arith. (* Plus.plus_le_compat_r *) #[local] Definition le_plus_r_stt := (fun n m => Nat.le_add_l m n). #[local] Definition le_plus_trans_stt := (fun n m p Hle => Nat.le_trans n _ _ Hle (Nat.le_add_r m p)). Opaque le_plus_r_stt le_plus_trans_stt. Add Search Blacklist "Coq.Arith.Arith_base.le_plus_r_stt". Add Search Blacklist "Coq.Arith.Arith_base.le_plus_trans_stt". #[global] Hint Resolve Nat.le_add_r le_plus_r_stt le_plus_trans_stt : arith. (* Plus.le_plus_l Plus.le_plus_r_stt Plus.le_plus_trans_stt *) #[local] Definition lt_plus_trans_stt := (fun n m p Hlt => Nat.lt_le_trans n _ _ Hlt (Nat.le_add_r m p)). Opaque lt_plus_trans_stt. Add Search Blacklist "Coq.Arith.Arith_base.lt_plus_trans_stt". #[global] Hint Immediate lt_plus_trans_stt : arith. (* Plus.lt_plus_trans_stt *) #[global] Hint Resolve -> Nat.add_lt_mono_l : arith. (* Plus_lt_compat_l *) #[global] Hint Resolve -> Nat.add_lt_mono_r : arith. (* Plus_lt_compat_r *) (* ** [sub] *) #[local] Definition minus_n_O_stt := fun n => eq_sym (Nat.sub_0_r n). Opaque minus_n_O_stt. Add Search Blacklist "Coq.Arith.Arith_base.minus_n_O_stt". #[global] Hint Resolve minus_n_O_stt: arith. (* Minus.minus_n_O *) #[local] Definition minus_Sn_m_stt := fun n m Hle => eq_sym (Nat.sub_succ_l m n Hle). Opaque minus_Sn_m_stt. Add Search Blacklist "Coq.Arith.Arith_base.minus_Sn_m_stt". #[global] Hint Resolve minus_Sn_m_stt: arith. (* Minus.minus_Sn_m *) #[local] Definition minus_diag_reverse_stt := fun n => eq_sym (Nat.sub_diag n). Opaque minus_diag_reverse_stt. Add Search Blacklist "Coq.Arith.Arith_base.minus_diag_reverse_stt". #[global] Hint Resolve minus_diag_reverse_stt: arith. (* Minus.minus_diag_reverse *) #[local] Definition minus_plus_simpl_l_reverse_stt n m p : n - m = p + n - (p + m). Proof. now rewrite Nat.sub_add_distr, Nat.add_comm, Nat.add_sub. Qed. Add Search Blacklist "Coq.Arith.Arith_base.minus_plus_simpl_l_reverse_stt". #[global] Hint Resolve minus_plus_simpl_l_reverse_stt: arith. (* Minus.minus_plus_simpl_l_reverse *) #[local] Definition plus_minus_stt := fun n m p Heq => eq_sym (Nat.add_sub_eq_l n m p (eq_sym Heq)). Opaque plus_minus_stt. Add Search Blacklist "Coq.Arith.Arith_base.plus_minus_stt". #[global] Hint Immediate plus_minus_stt: arith. (* Minus.plus_minus *) #[local] Definition minus_plus_stt := (fun n m => eq_ind _ (fun x => x - n = m) (Nat.add_sub m n) _ (Nat.add_comm _ _)). Opaque minus_plus_stt. Add Search Blacklist "Coq.Arith.Arith_base.minus_plus_stt". #[global] Hint Resolve minus_plus_stt: arith. (* Minus.minus_plus *) #[local] Definition le_plus_minus_stt := fun n m Hle => eq_sym (eq_trans (Nat.add_comm _ _) (Nat.sub_add n m Hle)). Opaque le_plus_minus_stt. Add Search Blacklist "Coq.Arith.Arith_base.le_plus_minus_stt". #[global] Hint Resolve le_plus_minus_stt: arith. (* Minus.le_plus_minus *) #[local] Definition le_plus_minus_r_stt := fun n m Hle => eq_trans (Nat.add_comm _ _) (Nat.sub_add n m Hle). Opaque le_plus_minus_r_stt. Add Search Blacklist "Coq.Arith.Arith_base.le_plus_minus_r_stt". #[global] Hint Resolve le_plus_minus_r_stt: arith. (* Minus.le_plus_minus_r *) #[global] Hint Resolve Nat.sub_lt: arith. (* Minus.lt_minus *) #[local] Definition lt_O_minus_lt_stt : forall n m, 0 < n - m -> m < n := fun n m => proj2 (Nat.lt_add_lt_sub_r 0 n m). Opaque lt_O_minus_lt_stt. Add Search Blacklist "Coq.Arith.Arith_base.lt_O_minus_lt_stt". #[global] Hint Immediate lt_O_minus_lt_stt: arith. (* Minus.lt_O_minus_lt *) (* ** [mul] *) #[global] Hint Resolve Nat.mul_1_l Nat.mul_1_r: arith. (* Mult.mult_1_l Mult.mult_1_r *) #[global] Hint Resolve Nat.mul_comm: arith. (* Mult.mult_comm *) #[global] Hint Resolve Nat.mul_add_distr_r: arith. (* Mult.mult_plus_distr_r *) #[global] Hint Resolve Nat.mul_sub_distr_r: arith. (* Mult.mult_minus_distr_r *) #[global] Hint Resolve Nat.mul_sub_distr_l: arith. (* Mult.mult_minus_distr_l *) #[local] Definition mult_assoc_reverse_stt := fun n m p => eq_sym (Nat.mul_assoc n m p). Opaque mult_assoc_reverse_stt. Add Search Blacklist "Coq.Arith.Arith_base.mult_assoc_reverse_stt". #[global] Hint Resolve mult_assoc_reverse_stt Nat.mul_assoc: arith. (* Mult.mult_assoc_reverse Mult.mult_assoc *) #[local] Definition mult_O_le_stt n m : m = 0 \/ n <= m * n. Proof. destruct m; [left|right]; simpl; trivial using Nat.le_add_r. Qed. Add Search Blacklist "Coq.Arith.Arith_base.mult_O_le_stt". #[global] Hint Resolve mult_O_le_stt: arith. (* Mult.mult_O_le *) #[global] Hint Resolve Nat.mul_le_mono_l: arith. (* Mult.mult_le_compat_l *) #[local] Definition mult_S_lt_compat_l_stt := (fun n m p Hlt => proj1 (Nat.mul_lt_mono_pos_l (S n) m p (Nat.lt_0_succ n)) Hlt). Opaque mult_S_lt_compat_l_stt. Add Search Blacklist "Coq.Arith.Arith_base.mult_S_lt_compat_l_stt". #[global] Hint Resolve mult_S_lt_compat_l_stt: arith. (* Mult.mult_S_lt_compat_l *) (* ** [min] and [max] *) #[global] Hint Resolve Nat.max_l Nat.max_r Nat.le_max_l Nat.le_max_r: arith. #[global] Hint Resolve Nat.min_l Nat.min_r Nat.le_min_l Nat.le_min_r: arith. (* ** [Even_alt] and [Odd_alt] *) #[global] Hint Constructors Nat.Even_alt: arith. #[global] Hint Constructors Nat.Odd_alt: arith. coq-8.20.0/theories/Arith/Between.v000066400000000000000000000134251466560755400170630ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* Prop. (** The [between] type expresses the concept [forall i: nat, k <= i < l -> P i.]. *) Inductive between k : nat -> Prop := | bet_emp : between k k | bet_S : forall l, between k l -> P l -> between k (S l). #[local] Hint Constructors between: core. Lemma bet_eq : forall k l, l = k -> between k l. Proof. intros * ->; constructor. Qed. #[local] Hint Resolve bet_eq: core. Lemma between_le : forall k l, between k l -> k <= l. Proof. induction 1; auto. Qed. #[local] Hint Immediate between_le: core. Lemma between_Sk_l : forall k l, between k l -> S k <= l -> between (S k) l. Proof. induction 1 as [|* [|]]; auto. - intros Hle; exfalso; apply (Nat.nle_succ_diag_l _ Hle). - intros Hle; inversion Hle; constructor; auto. Qed. #[local] Hint Resolve between_Sk_l: core. Lemma between_restr : forall k l (m:nat), k <= l -> l <= m -> between k m -> between l m. Proof. induction 1; auto. intros; auto. apply between_Sk_l; auto. apply IHle; auto. transitivity (S m0); auto. Qed. (** The [exists_between] type expresses the concept [exists i: nat, k <= i < l /\ Q i]. *) Inductive exists_between k : nat -> Prop := | exists_S : forall l, exists_between k l -> exists_between k (S l) | exists_le : forall l, k <= l -> Q l -> exists_between k (S l). #[local] Hint Constructors exists_between: core. Lemma exists_le_S : forall k l, exists_between k l -> S k <= l. Proof. induction 1; auto. apply -> Nat.succ_le_mono; assumption. Qed. Lemma exists_lt : forall k l, exists_between k l -> k < l. Proof exists_le_S. #[local] Hint Immediate exists_le_S exists_lt: core. Lemma exists_S_le : forall k l, exists_between k (S l) -> k <= l. Proof. intros; apply le_S_n; auto. Qed. #[local] Hint Immediate exists_S_le: core. Definition in_int p q r := p <= r /\ r < q. Lemma in_int_intro : forall p q r, p <= r -> r < q -> in_int p q r. Proof. split; assumption. Qed. #[local] Hint Resolve in_int_intro: core. Lemma in_int_lt : forall p q r, in_int p q r -> p < q. Proof. intros * []. eapply Nat.le_lt_trans; eassumption. Qed. Lemma in_int_p_Sq : forall p q r, in_int p (S q) r -> in_int p q r \/ r = q. Proof. intros p q r []. destruct (proj1 (Nat.lt_eq_cases r q)); auto. apply Nat.lt_succ_r; assumption. Qed. Lemma in_int_S : forall p q r, in_int p q r -> in_int p (S q) r. Proof. intros * []; auto. Qed. #[local] Hint Resolve in_int_S: core. Lemma in_int_Sp_q : forall p q r, in_int (S p) q r -> in_int p q r. Proof. intros * []; auto. apply in_int_intro; auto. transitivity (S p); auto. Qed. #[local] Hint Immediate in_int_Sp_q: core. Lemma between_in_int : forall k l, between k l -> forall r, in_int k l r -> P r. Proof. intro k; induction 1 as [|l]; intros r ?. - absurd (k < k). { apply Nat.lt_irrefl. } eapply in_int_lt; eassumption. - destruct (in_int_p_Sq k l r) as [| ->]; auto. Qed. Lemma in_int_between : forall k l, k <= l -> (forall r, in_int k l r -> P r) -> between k l. Proof. induction 1; auto. Qed. Lemma exists_in_int : forall k l, exists_between k l -> exists2 m : nat, in_int k l m & Q m. Proof. induction 1 as [* ? (p, ?, ?)|l]. - exists p; auto. - exists l; auto. Qed. Lemma in_int_exists : forall k l r, in_int k l r -> Q r -> exists_between k l. Proof. intros * (?, lt_r_l) ?. induction lt_r_l; auto. Qed. Lemma between_or_exists : forall k l, k <= l -> (forall n:nat, in_int k l n -> P n \/ Q n) -> between k l \/ exists_between k l. Proof. induction 1 as [|m ? IHle]. - auto. - intros P_or_Q. destruct IHle; auto. destruct (P_or_Q m); auto. Qed. Lemma between_not_exists : forall k l, between k l -> (forall n:nat, in_int k l n -> P n -> ~ Q n) -> ~ exists_between k l. Proof. intro k; induction 1 as [|l]; red; intros. - absurd (k < k). { apply Nat.lt_irrefl. } auto. - absurd (Q l). { auto. } destruct (exists_in_int k (S l)) as (l',[],?). + auto. + replace l with l'. { trivial. } destruct (proj1 (Nat.lt_eq_cases l' l)); auto. * apply Nat.lt_succ_r; assumption. * absurd (exists_between k l). { auto. } apply in_int_exists with l'; auto. Qed. Inductive P_nth (init:nat) : nat -> nat -> Prop := | nth_O : P_nth init init 0 | nth_S : forall k l (n:nat), P_nth init k n -> between (S k) l -> Q l -> P_nth init l (S n). Lemma nth_le : forall (init:nat) l (n:nat), P_nth init l n -> init <= l. Proof. induction 1 as [|a b c H0 H1 H2 H3]. - auto. - eapply Nat.le_trans; eauto. apply between_le in H2. transitivity (S a); auto. Qed. Definition eventually (n:nat) := exists2 k : nat, k <= n & Q k. Lemma event_O : eventually 0 -> Q 0. Proof. intros (x, ?, ?). replace 0 with x; auto. apply Nat.le_0_r; assumption. Qed. End Between. coq-8.20.0/theories/Arith/Bool_nat.v000066400000000000000000000046511466560755400172300ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* = y} := fun n m => sumbool_not _ _ (le_lt_dec m n). #[deprecated(since="8.20", note="Use PeanoNat.Nat.ltb instead")] Definition nat_lt_ge_bool x y := bool_of_sumbool (lt_ge_dec x y). #[deprecated(since="8.20", note="Use PeanoNat.Nat.leb instead")] Definition nat_ge_lt_bool x y := bool_of_sumbool (sumbool_not _ _ (lt_ge_dec x y)). #[deprecated(since="8.20", note="Use PeanoNat.Nat.leb instead")] Definition nat_le_gt_bool x y := bool_of_sumbool (le_gt_dec x y). #[deprecated(since="8.20", note="Use PeanoNat.Nat.ltb instead")] Definition nat_gt_le_bool x y := bool_of_sumbool (sumbool_not _ _ (le_gt_dec x y)). #[deprecated(since="8.20", note="Use PeanoNat.Nat.eqb instead")] Definition nat_eq_bool x y := bool_of_sumbool (eq_nat_dec x y). #[deprecated(since="8.20", note="Use PeanoNat.Nat.eqb instead")] Definition nat_noteq_bool x y := bool_of_sumbool (sumbool_not _ _ (eq_nat_dec x y)). #[deprecated(since="8.20", note="Use Coq.Arith.Compare_dec.zerop instead")] Definition zerop_bool x := bool_of_sumbool (zerop x). #[deprecated(since="8.20", note="Use Coq.Arith.Compare_dec.zerop instead")] Definition notzerop_bool x := bool_of_sumbool (notzerop x). coq-8.20.0/theories/Arith/Cantor.v000066400000000000000000000054671466560755400167270ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* (S i) + m) (y + x)). (** Cantor pairing inverse [of_nat] *) Definition of_nat (n : nat) : nat * nat := nat_rec _ (0, 0) (fun _ '(x, y) => match x with | S x => (x, S y) | _ => (S y, 0) end) n. (** [of_nat] is the left inverse for [to_nat] *) Lemma cancel_of_to p : of_nat (to_nat p) = p. Proof. enough (H : forall n p, to_nat p = n -> of_nat n = p) by now apply H. intro n. induction n as [|n IHn]. - now intros [[|?] [|?]]. - intros [x [|y]]. + destruct x as [|x]; [discriminate|]. intros [=H]. cbn. fold (of_nat n). rewrite (IHn (0, x)); [reflexivity|]. rewrite <- H. cbn. now rewrite PeanoNat.Nat.add_0_r. + intros [=H]. cbn. fold (of_nat n). rewrite (IHn (S x, y)); [reflexivity|]. rewrite <- H. cbn. now rewrite Nat.add_succ_r. Qed. (** [to_nat] is injective *) Corollary to_nat_inj p q : to_nat p = to_nat q -> p = q. Proof. intros H %(f_equal of_nat). now rewrite ?cancel_of_to in H. Qed. (** [to_nat] is the left inverse for [of_nat] *) Lemma cancel_to_of n : to_nat (of_nat n) = n. Proof. induction n as [|n IHn]; [reflexivity|]. cbn. fold (of_nat n). destruct (of_nat n) as [[|x] y]. - rewrite <- IHn. cbn. now rewrite PeanoNat.Nat.add_0_r. - rewrite <- IHn. cbn. now rewrite (Nat.add_succ_r y x). Qed. (** [of_nat] is injective *) Corollary of_nat_inj n m : of_nat n = of_nat m -> n = m. Proof. intros H %(f_equal to_nat). now rewrite ?cancel_to_of in H. Qed. (** Polynomial specifications of [to_nat] *) Lemma to_nat_spec x y : to_nat (x, y) * 2 = y * 2 + (y + x) * S (y + x). Proof. cbn. induction (y + x) as [|n IHn]; cbn; lia. Qed. Lemma to_nat_spec2 x y : to_nat (x, y) = y + (y + x) * S (y + x) / 2. Proof. now rewrite <- Nat.div_add_l, <- to_nat_spec, Nat.div_mul. Qed. (** [to_nat] is non-decreasing in (the sum of) pair components *) Lemma to_nat_non_decreasing x y : y + x <= to_nat (x, y). Proof. pose proof (to_nat_spec x y). nia. Qed. coq-8.20.0/theories/Arith/Compare.v000066400000000000000000000037271466560755400170640ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* n} + {n = m}. Lemma le_decide : forall n m, n <= m -> lt_or_eq n m. Proof le_lt_eq_dec. Lemma le_le_S_eq : forall n m, n <= m -> S n <= m \/ n = m. Proof (fun n m Hle => proj1 (Nat.lt_eq_cases n m) Hle). (* By special request of G. Kahn - Used in Group Theory *) Lemma discrete_nat : forall n m, n < m -> S n = m \/ (exists r : nat, m = S (S (n + r))). Proof. intros m n H. lapply (proj1 (Nat.le_succ_l m n)); auto. intro H'; lapply (proj1 (Nat.lt_eq_cases (S m) n)); auto. induction 1; auto. right; exists (n - S (S m)); simpl. rewrite (Nat.add_comm m (n - S (S m))). rewrite (plus_n_Sm (n - S (S m)) m). rewrite (plus_n_Sm (n - S (S m)) (S m)). rewrite (Nat.add_comm (n - S (S m)) (S (S m))). rewrite Nat.add_sub_assoc; [ | assumption ]. rewrite Nat.add_comm. rewrite <- Nat.add_sub_assoc; [ | reflexivity ]. rewrite Nat.sub_diag. symmetry; apply Nat.add_0_r. Qed. Require Export Wf_nat. coq-8.20.0/theories/Arith/Compare_dec.v000066400000000000000000000135471466560755400177000ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* n} + {n = m} + {n > m}. Proof. now apply lt_eq_lt_dec. Defined. Definition le_lt_dec n m : {n <= m} + {m < n}. Proof. induction n as [|n IHn] in m |- *. - left; apply Nat.le_0_l. - destruct m as [|m]. + right; apply Nat.lt_0_succ. + elim (IHn m); intros H; [left|right]. * now apply Nat.succ_le_mono in H. * now apply Nat.succ_lt_mono in H. Defined. Definition le_le_S_dec n m : {n <= m} + {S m <= n}. Proof. exact (le_lt_dec n m). Defined. Definition le_ge_dec n m : {n <= m} + {n >= m}. Proof. elim (le_lt_dec n m); auto. intros Hlt; right; apply Nat.lt_le_incl; assumption. Defined. Definition le_gt_dec n m : {n <= m} + {n > m}. Proof. exact (le_lt_dec n m). Defined. Definition le_lt_eq_dec n m : n <= m -> {n < m} + {n = m}. Proof. intros; destruct (lt_eq_lt_dec n m); auto. exfalso. apply (Nat.lt_irrefl n), (Nat.le_lt_trans n m); assumption. Defined. Theorem le_dec n m : {n <= m} + {~ n <= m}. Proof. destruct (le_gt_dec n m). - now left. - right; intros Hle. apply (Nat.lt_irrefl n), (Nat.le_lt_trans n m); assumption. Defined. Theorem lt_dec n m : {n < m} + {~ n < m}. Proof. apply le_dec. Defined. Theorem gt_dec n m : {n > m} + {~ n > m}. Proof. apply lt_dec. Defined. Theorem ge_dec n m : {n >= m} + {~ n >= m}. Proof. apply le_dec. Defined. Register le_gt_dec as num.nat.le_gt_dec. (** Proofs of decidability *) Theorem dec_le n m : decidable (n <= m). Proof. apply Nat.le_decidable. Qed. Theorem dec_lt n m : decidable (n < m). Proof. apply Nat.lt_decidable. Qed. Theorem dec_gt n m : decidable (n > m). Proof. apply Nat.lt_decidable. Qed. Theorem dec_ge n m : decidable (n >= m). Proof. apply Nat.le_decidable. Qed. Theorem not_eq n m : n <> m -> n < m \/ m < n. Proof. apply Nat.lt_gt_cases. Qed. Theorem not_le n m : ~ n <= m -> n > m. Proof. apply Nat.nle_gt. Qed. Theorem not_gt n m : ~ n > m -> n <= m. Proof. apply Nat.nlt_ge. Qed. Theorem not_ge n m : ~ n >= m -> n < m. Proof. apply Nat.nle_gt. Qed. Theorem not_lt n m : ~ n < m -> n >= m. Proof. apply Nat.nlt_ge. Qed. Register dec_le as num.nat.dec_le. Register dec_lt as num.nat.dec_lt. Register dec_ge as num.nat.dec_ge. Register dec_gt as num.nat.dec_gt. Register not_eq as num.nat.not_eq. Register not_le as num.nat.not_le. Register not_lt as num.nat.not_lt. Register not_ge as num.nat.not_ge. Register not_gt as num.nat.not_gt. (** A ternary comparison function in the spirit of [Z.compare]. See now [Nat.compare] and its properties. In scope [nat_scope], the notation for [Nat.compare] is "?=" *) Notation nat_compare_S := Nat.compare_succ (only parsing). Lemma nat_compare_lt n m : n (n ?= m) = Lt. Proof. symmetry. apply Nat.compare_lt_iff. Qed. Lemma nat_compare_gt n m : n>m <-> (n ?= m) = Gt. Proof. symmetry. apply Nat.compare_gt_iff. Qed. Lemma nat_compare_le n m : n<=m <-> (n ?= m) <> Gt. Proof. symmetry. apply Nat.compare_le_iff. Qed. Lemma nat_compare_ge n m : n>=m <-> (n ?= m) <> Lt. Proof. symmetry. apply Nat.compare_ge_iff. Qed. (** Some projections of the above equivalences. *) Lemma nat_compare_eq n m : (n ?= m) = Eq -> n = m. Proof. apply Nat.compare_eq_iff. Qed. Lemma nat_compare_Lt_lt n m : (n ?= m) = Lt -> n n>m. Proof. apply Nat.compare_gt_iff. Qed. (** A previous definition of [nat_compare] in terms of [lt_eq_lt_dec]. The new version avoids the creation of proof parts. *) Definition nat_compare_alt (n m:nat) := match lt_eq_lt_dec n m with | inleft (left _) => Lt | inleft (right _) => Eq | inright _ => Gt end. Lemma nat_compare_equiv n m : (n ?= m) = nat_compare_alt n m. Proof. unfold nat_compare_alt; destruct lt_eq_lt_dec as [[|]|]. - now apply Nat.compare_lt_iff. - now apply Nat.compare_eq_iff. - now apply Nat.compare_gt_iff. Qed. (** A boolean version of [le] over [nat]. See now [Nat.leb] and its properties. In scope [nat_scope], the notation for [Nat.leb] is "<=?" *) Notation leb := Nat.leb (only parsing). Notation leb_iff := Nat.leb_le (only parsing). Lemma leb_iff_conv m n : (n <=? m) = false <-> m < n. Proof. rewrite Nat.leb_nle. apply Nat.nle_gt. Qed. Lemma leb_correct m n : m <= n -> (m <=? n) = true. Proof. apply Nat.leb_le. Qed. Lemma leb_complete m n : (m <=? n) = true -> m <= n. Proof. apply Nat.leb_le. Qed. Lemma leb_correct_conv m n : m < n -> (n <=? m) = false. Proof. apply leb_iff_conv. Qed. Lemma leb_complete_conv m n : (n <=? m) = false -> m < n. Proof. apply leb_iff_conv. Qed. Lemma leb_compare n m : (n <=? m) = true <-> (n ?= m) <> Gt. Proof. rewrite Nat.compare_le_iff. apply Nat.leb_le. Qed. coq-8.20.0/theories/Arith/EqNat.v000066400000000000000000000034521466560755400165010ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* True | O, S _ => False | S _, O => False | S n1, S m1 => eq_nat n1 m1 end. Theorem eq_nat_refl n : eq_nat n n. Proof. induction n; simpl; auto. Qed. (** [eq] restricted to [nat] and [eq_nat] are equivalent *) Theorem eq_nat_is_eq n m : eq_nat n m <-> n = m. Proof. split. - revert m; induction n; intro m; destruct m; simpl; contradiction || auto. - intros <-; apply eq_nat_refl. Qed. Lemma eq_eq_nat n m : n = m -> eq_nat n m. Proof. apply eq_nat_is_eq. Qed. Lemma eq_nat_eq n m : eq_nat n m -> n = m. Proof. apply eq_nat_is_eq. Qed. Theorem eq_nat_elim : forall n (P:nat -> Prop), P n -> forall m, eq_nat n m -> P m. Proof. intros n P ? m ?; replace m with n; [ | apply eq_nat_eq ]; assumption. Qed. Theorem eq_nat_decide : forall n m, {eq_nat n m} + {~ eq_nat n m}. Proof. intro n; induction n as [|n IHn]; intro m; destruct m; simpl. - left; trivial. - right; intro; trivial. - right; intro; trivial. - apply IHn. Defined. coq-8.20.0/theories/Arith/Euclid.v000066400000000000000000000044041466560755400166740ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* r -> a = q * b + r -> diveucl a b. Lemma eucl_dev : forall n, n > 0 -> forall m:nat, diveucl m n. Proof. intros n H m; induction m as (m,H0) using gt_wf_rec. destruct (le_gt_dec n m) as [Hlebn|Hgtbn]. - destruct (H0 (m - n)) as (q,r,Hge0,Heq); [ apply Nat.sub_lt; auto | ]. apply divex with (S q) r; trivial. simpl; rewrite <- Nat.add_assoc, <- Heq, Nat.add_comm, Nat.sub_add; trivial. - apply divex with 0 m; simpl; trivial. Defined. Lemma quotient : forall n, n > 0 -> forall m:nat, {q : nat | exists r : nat, m = q * n + r /\ n > r}. Proof. intros n H m; induction m as (m,H0) using gt_wf_rec. destruct (le_gt_dec n m) as [Hlebn|Hgtbn]. - destruct (H0 (m - n)) as (q & Hq); [ apply Nat.sub_lt; auto | ]. exists (S q); destruct Hq as (r & Heq & Hgt); exists r; split; trivial. simpl; rewrite <- Nat.add_assoc, <- Heq, Nat.add_comm, Nat.sub_add; trivial. - exists 0; exists m; simpl; auto. Defined. Lemma modulo : forall n, n > 0 -> forall m:nat, {r : nat | exists q : nat, m = q * n + r /\ n > r}. Proof. intros n H m; induction m as (m,H0) using gt_wf_rec. destruct (le_gt_dec n m) as [Hlebn|Hgtbn]. - destruct (H0 (m - n)) as (r & Hr); [ apply Nat.sub_lt; auto | ]. exists r; destruct Hr as (q & Heq & Hgt); exists (S q); split; trivial. simpl; rewrite <- Nat.add_assoc, <- Heq, Nat.add_comm, Nat.sub_add; trivial. - exists m; exists 0; simpl; auto. Defined. coq-8.20.0/theories/Arith/Factorial.v000066400000000000000000000023201466560755400173660ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* 1 | S n => S n * fact n end. Arguments fact n%_nat. Lemma lt_O_fact n : 0 < fact n. Proof. induction n; simpl; auto. apply Nat.lt_lt_add_r; assumption. Qed. Lemma fact_neq_0 n : fact n <> 0. Proof. apply Nat.neq_0_lt_0, lt_O_fact. Qed. Lemma fact_le n m : n <= m -> fact n <= fact m. Proof. induction 1 as [|m ?]. - apply le_n. - simpl. transitivity (fact m). + trivial. + apply Nat.le_add_r. Qed. coq-8.20.0/theories/Arith/PeanoNat.v000066400000000000000000001207271466560755400172030ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* eq) S. #[global] Program Instance pred_wd : Proper (eq==>eq) pred. #[global] Program Instance add_wd : Proper (eq==>eq==>eq) plus. #[global] Program Instance sub_wd : Proper (eq==>eq==>eq) minus. #[global] Program Instance mul_wd : Proper (eq==>eq==>eq) mult. #[global] Program Instance pow_wd : Proper (eq==>eq==>eq) pow. #[global] Program Instance div_wd : Proper (eq==>eq==>eq) div. #[global] Program Instance mod_wd : Proper (eq==>eq==>eq) modulo. #[global] Program Instance lt_wd : Proper (eq==>eq==>iff) lt. #[global] Program Instance testbit_wd : Proper (eq==>eq==>eq) testbit. (** Bi-directional induction. *) Theorem bi_induction : forall A : nat -> Prop, Proper (eq==>iff) A -> A 0 -> (forall n : nat, A n <-> A (S n)) -> forall n : nat, A n. Proof. intros A A_wd A0 AS; apply nat_ind. - assumption. - intros; now apply -> AS. Qed. (** Recursion function *) Definition recursion {A} : A -> (nat -> A -> A) -> nat -> A := nat_rect (fun _ => A). #[global] Instance recursion_wd {A} (Aeq : relation A) : Proper (Aeq ==> (eq==>Aeq==>Aeq) ==> eq ==> Aeq) recursion. Proof. intros a a' Ha f f' Hf n n' <-. induction n; simpl; auto. apply Hf; auto. Qed. Theorem recursion_0 : forall {A} (a : A) (f : nat -> A -> A), recursion a f 0 = a. Proof. reflexivity. Qed. Theorem recursion_succ : forall {A} (Aeq : relation A) (a : A) (f : nat -> A -> A), Aeq a a -> Proper (eq==>Aeq==>Aeq) f -> forall n : nat, Aeq (recursion a f (S n)) (f n (recursion a f n)). Proof. unfold Proper, respectful in *. intros A Aeq a f ? ? n. induction n; simpl; auto. Qed. (** ** Remaining constants not defined in Coq.Init.Nat *) (** NB: Aliasing [le] is mandatory, since only a Definition can implement an interface Parameter... *) Definition eq := @Logic.eq nat. Definition le := Peano.le. Definition lt := Peano.lt. (** ** Basic specifications : pred add sub mul *) Lemma pred_succ n : pred (S n) = n. Proof. reflexivity. Qed. Lemma pred_0 : pred 0 = 0. Proof. reflexivity. Qed. Lemma one_succ : 1 = S 0. Proof. reflexivity. Qed. Lemma two_succ : 2 = S 1. Proof. reflexivity. Qed. Lemma add_0_l n : 0 + n = n. Proof. reflexivity. Qed. Lemma add_succ_l n m : (S n) + m = S (n + m). Proof. reflexivity. Qed. Lemma sub_0_r n : n - 0 = n. Proof. now destruct n. Qed. Lemma sub_succ_r n m : n - (S m) = pred (n - m). Proof. revert m; induction n; intro m; destruct m; simpl; auto. apply sub_0_r. Qed. Lemma mul_0_l n : 0 * n = 0. Proof. reflexivity. Qed. Lemma mul_succ_l n m : S n * m = n * m + m. Proof. assert (succ_r : forall x y, x+S y = S(x+y)) by now intro x; induction x. assert (comm : forall x y, x+y = y+x). { intro x; induction x; simpl; auto. intros; rewrite succ_r; now f_equal. } now rewrite comm. Qed. Lemma lt_succ_r n m : n < S m <-> n <= m. Proof. split. - apply Peano.le_S_n. - induction 1; auto. Qed. (** ** Boolean comparisons *) Lemma eqb_eq n m : eqb n m = true <-> n = m. Proof. revert m. induction n as [|n IHn]; intro m; destruct m; simpl; rewrite ?IHn; split; try easy. - now intros ->. - now injection 1. Qed. #[global] Instance Decidable_eq_nat : forall (x y : nat), Decidable (eq x y) := { Decidable_spec := Nat.eqb_eq x y }. Lemma leb_le n m : (n <=? m) = true <-> n <= m. Proof. revert m. induction n as [|n IHn]; intro m; destruct m; simpl. - now split. - split; trivial. intros; apply Peano.le_0_n. - now split. - rewrite IHn; split. + apply Peano.le_n_S. + apply Peano.le_S_n. Qed. #[global] Instance Decidable_le_nat : forall (x y : nat), Decidable (x <= y) := { Decidable_spec := Nat.leb_le x y }. Lemma ltb_lt n m : (n n < m. Proof. apply leb_le. Qed. (* Note: Decidable_lt_nat, Decidable_ge_nat, Decidable_gt_nat are not required, because lt, ge and gt are defined based on le in a way which type class resolution seems to understand. *) (** ** Decidability of equality over [nat]. *) Lemma eq_dec : forall n m : nat, {n = m} + {n <> m}. Proof. intro n; induction n as [|n IHn]; intro m; destruct m as [|m]. - now left. - now right. - now right. - destruct (IHn m); [left|right]; auto. Defined. (** ** Ternary comparison *) (** With [nat], it would be easier to prove first [compare_spec], then the properties below. But then we wouldn't be able to benefit from functor [BoolOrderFacts] *) Lemma compare_eq_iff n m : (n ?= m) = Eq <-> n = m. Proof. revert m; induction n as [|n IHn]; intro m; destruct m; simpl; rewrite ?IHn; split; auto; easy. Qed. Lemma compare_lt_iff n m : (n ?= m) = Lt <-> n < m. Proof. revert m; induction n as [|n IHn]; intro m; destruct m; simpl; rewrite ?IHn; split; try easy. - intros _; apply Peano.le_n_S, Peano.le_0_n. - apply Peano.le_n_S. - apply Peano.le_S_n. Qed. Lemma compare_le_iff n m : (n ?= m) <> Gt <-> n <= m. Proof. revert m; induction n as [|n IHn]; intro m; destruct m; simpl; rewrite ?IHn. - now split. - split; intros. + apply Peano.le_0_n. + easy. - split. + now destruct 1. + inversion 1. - split; intros. + now apply Peano.le_n_S. + now apply Peano.le_S_n. Qed. Lemma compare_antisym n m : (m ?= n) = CompOpp (n ?= m). Proof. revert m; induction n; intro m; destruct m; simpl; trivial. Qed. Lemma compare_succ n m : (S n ?= S m) = (n ?= m). Proof. reflexivity. Qed. (** ** Minimum, maximum *) Lemma max_l : forall n m, m <= n -> max n m = n. Proof. exact Peano.max_l. Qed. Lemma max_r : forall n m, n <= m -> max n m = m. Proof. exact Peano.max_r. Qed. Lemma min_l : forall n m, n <= m -> min n m = n. Proof. exact Peano.min_l. Qed. Lemma min_r : forall n m, m <= n -> min n m = m. Proof. exact Peano.min_r. Qed. (** Some more advanced properties of comparison and orders, including [compare_spec] and [lt_irrefl] and [lt_eq_cases]. *) Include BoolOrderFacts. (** We can now derive all properties of basic functions and orders, and use these properties for proving the specs of more advanced functions. *) Include NBasicProp <+ UsualMinMaxLogicalProperties <+ UsualMinMaxDecProperties. Lemma strong_induction_le (A : nat -> Prop) : A 0 -> (forall n, (forall m, m <= n -> A m) -> A (S n)) -> forall n, A n. Proof. apply Private_strong_induction_le; intros x y ->; reflexivity. Qed. (** ** Power *) Lemma pow_neg_r a b : b<0 -> a^b = 0. Proof. inversion 1. Qed. Lemma pow_0_r a : a^0 = 1. Proof. reflexivity. Qed. Lemma pow_succ_r a b : 0<=b -> a^(S b) = a * a^b. Proof. reflexivity. Qed. (** ** Square *) Lemma square_spec n : square n = n * n. Proof. reflexivity. Qed. (** ** Parity *) Definition Even n := exists m, n = 2*m. Definition Odd n := exists m, n = 2*m+1. Module Private_Parity. Lemma Even_0 : Even 0. Proof. exists 0; reflexivity. Qed. Lemma Even_1 : ~ Even 1. Proof. intros ([|], H); try discriminate. simpl in H. now rewrite <- plus_n_Sm in H. Qed. Lemma Even_2 n : Even n <-> Even (S (S n)). Proof. split; intros (m,H). - exists (S m). rewrite H; simpl. now rewrite plus_n_Sm. - destruct m as [|m]; try discriminate. exists m. simpl in H; rewrite <- plus_n_Sm in H. now inversion H. Qed. Lemma Odd_0 : ~ Odd 0. Proof. now intros ([|], H). Qed. Lemma Odd_1 : Odd 1. Proof. exists 0; reflexivity. Qed. Lemma Odd_2 n : Odd n <-> Odd (S (S n)). Proof. split; intros (m,H). - exists (S m). rewrite H. simpl. now rewrite <- (plus_n_Sm m). - destruct m as [|m]; try discriminate. exists m. simpl in H; rewrite <- plus_n_Sm in H. inversion H; simpl. now rewrite <- !plus_n_Sm, <- !plus_n_O. Qed. End Private_Parity. Import Private_Parity. Lemma even_spec : forall n, even n = true <-> Even n. Proof. fix even_spec 1. intro n; destruct n as [|[|n]]; simpl. - split; [ intros; apply Even_0 | trivial ]. - split; [ discriminate | intro H; elim (Even_1 H) ]. - rewrite even_spec. apply Even_2. Qed. Lemma odd_spec : forall n, odd n = true <-> Odd n. Proof. unfold odd. fix odd_spec 1. intro n; destruct n as [|[|n]]; simpl. - split; [ discriminate | intro H; elim (Odd_0 H) ]. - split; [ intros; apply Odd_1 | trivial ]. - rewrite odd_spec. apply Odd_2. Qed. (** ** Division *) Lemma divmod_spec : forall x y q u, u <= y -> let (q',u') := divmod x y q u in x + (S y)*q + (y-u) = (S y)*q' + (y-u') /\ u' <= y. Proof. intro x; induction x as [|x IHx]. - simpl; intuition. - intros y q u H. destruct u as [|u]; simpl divmod. + generalize (IHx y (S q) y (le_n y)). destruct divmod as (q',u'). intros (EQ,LE); split; trivial. rewrite <- EQ, sub_0_r, sub_diag, add_0_r. now rewrite !add_succ_l, <- add_succ_r, <- add_assoc, mul_succ_r. + assert (H' : u <= y). { apply le_trans with (S u); trivial. do 2 constructor. } generalize (IHx y q u H'). destruct divmod as (q',u'). intros (EQ,LE); split; trivial. rewrite <- EQ, !add_succ_l, <- add_succ_r; f_equal. now rewrite <- sub_succ_l. Qed. Lemma div_mod_eq x y : x = y*(x/y) + x mod y. Proof. destruct y as [|y]; [reflexivity | ]. unfold div, modulo. generalize (divmod_spec x y 0 y (le_n y)). destruct divmod as (q,u). intros (U,V). simpl in *. now rewrite mul_0_r, sub_diag, !add_0_r in U. Qed. (** The [y <> 0] hypothesis is needed to fit in [NAxiomsSig]. *) Lemma div_mod x y : y <> 0 -> x = y*(x/y) + x mod y. Proof. intros _; apply div_mod_eq. Qed. Lemma mod_bound_pos x y : 0<=x -> 0 0 <= x mod y < y. Proof. intros Hx Hy. split. - apply le_0_l. - destruct y; [ now elim Hy | clear Hy ]. unfold modulo. apply lt_succ_r, le_sub_l. Qed. (** ** Square root *) Lemma sqrt_iter_spec : forall k p q r, q = p+p -> r<=q -> let s := sqrt_iter k p q r in s*s <= k + p*p + (q - r) < (S s)*(S s). Proof. intro k; induction k as [|k IHk]. - (* k = 0 *) simpl; intros p q r Hq Hr. split. + apply le_add_r. + apply lt_succ_r. rewrite mul_succ_r, add_assoc, (add_comm p), <- add_assoc. apply add_le_mono_l. rewrite <- Hq. apply le_sub_l. - (* k = S k' *) intros p q r; destruct r as [|r]. + (* r = 0 *) intros Hq _. replace (S k + p*p + (q-0)) with (k + (S p)*(S p) + (S (S q) - S (S q))). 2:{ rewrite sub_diag, sub_0_r, add_0_r. simpl. rewrite add_succ_r; f_equal. rewrite <- add_assoc; f_equal. rewrite mul_succ_r, (add_comm p), <- add_assoc. now f_equal. } apply IHk; simpl. * now rewrite add_succ_r, Hq. * apply le_n. + (* r = S r' *) intros Hq Hr. replace (S k + p*p + (q-S r)) with (k + p*p + (q - r)) by (simpl; rewrite <- add_succ_r; f_equal; rewrite <- sub_succ_l; trivial). apply IHk; trivial. apply le_trans with (S r); trivial. do 2 constructor. Qed. Lemma sqrt_specif n : (sqrt n)*(sqrt n) <= n < S (sqrt n) * S (sqrt n). Proof. set (s:=sqrt n). replace n with (n + 0*0 + (0-0)). - apply sqrt_iter_spec; auto. - simpl. now rewrite !add_0_r. Qed. Definition sqrt_spec a (Ha:0<=a) := sqrt_specif a. Lemma sqrt_neg a : a<0 -> sqrt a = 0. Proof. inversion 1. Qed. (** ** Logarithm *) Lemma log2_iter_spec : forall k p q r, 2^(S p) = q + S r -> r < 2^p -> let s := log2_iter k p q r in 2^s <= k + q < 2^(S s). Proof. intro k; induction k as [|k IHk]. - (* k = 0 *) intros p q r EQ LT. simpl log2_iter; cbv zeta. split. + rewrite add_0_l, (add_le_mono_l _ _ (2^p)). simpl pow in EQ. rewrite add_0_r in EQ; rewrite EQ, add_comm. apply add_le_mono_r, LT. + rewrite EQ, add_comm. apply add_lt_mono_l. apply lt_succ_r, le_0_l. - (* k = S k' *) intros p q r EQ LT. destruct r as [|r]. + (* r = 0 *) rewrite add_succ_r, add_0_r in EQ. rewrite add_succ_l, <- add_succ_r. apply IHk. * rewrite <- EQ. remember (S p) as p'; simpl. now rewrite add_0_r. * rewrite EQ; constructor. + (* r = S r' *) rewrite add_succ_l, <- add_succ_r. apply IHk. * now rewrite add_succ_l, <- add_succ_r. * apply le_lt_trans with (S r); trivial. do 2 constructor. Qed. Lemma log2_spec n : 0 2^(log2 n) <= n < 2^(S (log2 n)). Proof. intros. set (s:=log2 n). replace n with (pred n + 1). - apply log2_iter_spec; auto. - rewrite add_1_r. apply succ_pred. now apply neq_sym, lt_neq. Qed. Lemma log2_nonpos n : n<=0 -> log2 n = 0. Proof. inversion 1; now subst. Qed. (** ** Properties of [iter] *) Lemma iter_swap_gen A B (f:A -> B) (g:A -> A) (h:B -> B) : (forall a, f (g a) = h (f a)) -> forall n a, f (iter n g a) = iter n h (f a). Proof. intros H n a. induction n as [|n Hn]. - reflexivity. - simpl. rewrite H, Hn. reflexivity. Qed. Lemma iter_swap : forall n (A:Type) (f:A -> A) (x:A), iter n f (f x) = f (iter n f x). Proof. intros. symmetry. now apply iter_swap_gen. Qed. Lemma iter_succ : forall n (A:Type) (f:A -> A) (x:A), iter (S n) f x = f (iter n f x). Proof. reflexivity. Qed. Lemma iter_succ_r : forall n (A:Type) (f:A -> A) (x:A), iter (S n) f x = iter n f (f x). Proof. intros; now rewrite iter_succ, iter_swap. Qed. Lemma iter_add : forall p q (A:Type) (f:A -> A) (x:A), iter (p+q) f x = iter p f (iter q f x). Proof. intro p. induction p as [|p IHp]. - reflexivity. - intros q A f x. simpl. now rewrite IHp. Qed. Lemma iter_ind (A:Type) (f:A -> A) (a:A) (P:nat -> A -> Prop) : P 0 a -> (forall n a', P n a' -> P (S n) (f a')) -> forall n, P n (iter n f a). Proof. intros H0 HS n. induction n as [|n Hn]. - exact H0. - apply HS. exact Hn. Qed. Lemma iter_rect (A:Type) (f:A -> A) (a:A) (P:nat -> A -> Type) : P 0 a -> (forall n a', P n a' -> P (S n) (f a')) -> forall n, P n (iter n f a). Proof. intros H0 HS n. induction n as [|n Hn]. - exact H0. - apply HS. exact Hn. Defined. Lemma iter_invariant : forall (n:nat) (A:Type) (f:A -> A) (Inv:A -> Prop), (forall x:A, Inv x -> Inv (f x)) -> forall x:A, Inv x -> Inv (iter n f x). Proof. intros; apply iter_ind; trivial. Qed. (** ** Gcd *) Definition divide x y := exists z, y=z*x. Notation "( x | y )" := (divide x y) (at level 0) : nat_scope. Lemma gcd_divide : forall a b, (gcd a b | a) /\ (gcd a b | b). Proof. fix gcd_divide 1. intros [|a] b; simpl. - split. + now exists 0. + exists 1; simpl. now rewrite <- plus_n_O. - fold (b mod (S a)). destruct (gcd_divide (b mod (S a)) (S a)) as (H,H'). set (a':=S a) in *. split; auto. rewrite (div_mod_eq b a') at 2. destruct H as (u,Hu), H' as (v,Hv). rewrite mul_comm. exists ((b/a')*v + u). rewrite mul_add_distr_r. now rewrite <- mul_assoc, <- Hv, <- Hu. Qed. Lemma gcd_divide_l : forall a b, (gcd a b | a). Proof. apply gcd_divide. Qed. Lemma gcd_divide_r : forall a b, (gcd a b | b). Proof. apply gcd_divide. Qed. Lemma gcd_greatest : forall a b c, (c|a) -> (c|b) -> (c|gcd a b). Proof. fix gcd_greatest 1. intros [|a] b; simpl; auto. fold (b mod (S a)). intros c H H'. apply gcd_greatest; auto. set (a':=S a) in *. rewrite (div_mod_eq b a') in H'. destruct H as (u,Hu), H' as (v,Hv). exists (v - (b/a')*u). rewrite mul_comm in Hv. rewrite mul_sub_distr_r, <- Hv, <- mul_assoc, <-Hu. now rewrite add_comm, add_sub. Qed. Lemma gcd_nonneg a b : 0<=gcd a b. Proof. apply le_0_l. Qed. (** ** Bitwise operations *) Definition double_S : forall n, double (S n) = S (S (double n)) := fun n => add_succ_r (S n) n. Definition double_add : forall n m, double (n + m) = double n + double m := fun n m => add_shuffle1 n m n m. Lemma double_twice : forall n, double n = 2*n. Proof. simpl; intros; now rewrite add_0_r. Qed. (* We use a Module Type to hide intermediate lemmas we will get from Natural anyway. *) Module Type PrivateBitwiseSpec. (* needed to implement Numbers.NatInt.NZBitsSpec *) Parameter testbit_odd_0 : forall a : nat, testbit (add (mul 2 a) 1) 0 = true. Parameter testbit_even_0 : forall a : nat, testbit (mul 2 a) 0 = false. Parameter testbit_odd_succ : forall a n : nat, le 0 n -> testbit (add (mul 2 a) 1) (succ n) = testbit a n. Parameter testbit_even_succ : forall a n : nat, le 0 n -> testbit (mul 2 a) (succ n) = testbit a n. Parameter testbit_neg_r : forall a n : nat, lt n 0 -> testbit a n = false. Parameter shiftr_spec : forall a n m : nat, le 0 m -> testbit (shiftr a n) m = testbit a (add m n). Parameter shiftl_spec_high : forall a n m : nat, le 0 m -> le n m -> testbit (shiftl a n) m = testbit a (sub m n). Parameter shiftl_spec_low : forall a n m : nat, lt m n -> testbit (shiftl a n) m = false. Parameter land_spec : forall a b n : nat, testbit (land a b) n = testbit a n && testbit b n. Parameter lor_spec : forall a b n : nat, testbit (lor a b) n = testbit a n || testbit b n. Parameter ldiff_spec : forall a b n : nat, testbit (ldiff a b) n = testbit a n && negb (testbit b n). Parameter lxor_spec : forall a b n : nat, testbit (lxor a b) n = xorb (testbit a n) (testbit b n). Parameter div2_spec : forall a : nat, eq (div2 a) (shiftr a 1). (* not yet generalized to Numbers.Natural.Abstract *) Parameter div2_double : forall n, div2 (2*n) = n. Parameter div2_succ_double : forall n, div2 (S (2*n)) = n. Parameter div2_bitwise : forall op n a b, div2 (bitwise op (S n) a b) = bitwise op n (div2 a) (div2 b). Parameter odd_bitwise : forall op n a b, odd (bitwise op (S n) a b) = op (odd a) (odd b). Parameter testbit_bitwise_1 : forall op, (forall b, op false b = false) -> forall n m a b, a<=n -> testbit (bitwise op n a b) m = op (testbit a m) (testbit b m). Parameter testbit_bitwise_2 : forall op, op false false = false -> forall n m a b, a<=n -> b<=n -> testbit (bitwise op n a b) m = op (testbit a m) (testbit b m). End PrivateBitwiseSpec. (* The following module has to be included (it semmes that importing it is not enough to implement NZBitsSpec), therefore it has to be "Private", otherwise, its lemmas will appear twice in [Search]es *) Module PrivateImplementsBitwiseSpec : PrivateBitwiseSpec. Lemma div2_double n : div2 (2*n) = n. Proof. induction n; trivial. simpl mul. rewrite add_succ_r; simpl. now f_equal. Qed. Lemma div2_succ_double n : div2 (S (2*n)) = n. Proof. induction n; trivial. simpl; f_equal. now rewrite add_succ_r. Qed. Lemma le_div2 n : div2 (S n) <= n. Proof. revert n. fix le_div2 1. intro n; destruct n as [|n]; simpl; trivial. apply lt_succ_r. destruct n; [simpl|]; trivial. now constructor. Qed. Lemma lt_div2 n : 0 < n -> div2 n < n. Proof. destruct n. - inversion 1. - intros _; apply lt_succ_r, le_div2. Qed. Lemma div2_decr a n : a <= S n -> div2 a <= n. Proof. destruct a as [|a]; intros H. - simpl; apply le_0_l. - apply succ_le_mono in H. apply le_trans with a; [ apply le_div2 | trivial ]. Qed. (* needed to implement Coq.Numbers.NatInt.NZBitsSpec *) Lemma testbit_0_l : forall n, testbit 0 n = false. Proof. now intro n; induction n. Qed. (* needed to implement Coq.Numbers.NatInt.NZBitsSpec *) Lemma testbit_odd_0 a : testbit (2*a+1) 0 = true. Proof. unfold testbit; rewrite odd_spec; now exists a. Qed. (* needed to implement Coq.Numbers.NatInt.NZBitsSpec *) Lemma testbit_even_0 a : testbit (2*a) 0 = false. Proof. unfold testbit, odd. rewrite (proj2 (even_spec _)); trivial. now exists a. Qed. Lemma testbit_odd_succ' a n : testbit (2*a+1) (S n) = testbit a n. Proof. unfold testbit; fold testbit. rewrite add_1_r; f_equal. apply div2_succ_double. Qed. Lemma testbit_even_succ' a n : testbit (2*a) (S n) = testbit a n. Proof. unfold testbit; fold testbit; f_equal; apply div2_double. Qed. Lemma shiftr_specif : forall a n m, testbit (shiftr a n) m = testbit a (m+n). Proof. intros a n; induction n as [|n IHn]; intros m. - now rewrite add_0_r. - now rewrite add_succ_r, <- add_succ_l, <- IHn. Qed. Lemma shiftl_specif_high : forall a n m, n<=m -> testbit (shiftl a n) m = testbit a (m-n). Proof. intros a n; induction n as [|n IHn]; intros m H; [ trivial | ]. - now rewrite sub_0_r. - destruct m; [ inversion H | ]. simpl; apply succ_le_mono in H. change (shiftl a (S n)) with (double (shiftl a n)). rewrite double_twice, div2_double. now apply IHn. Qed. (* needed to implement Coq.Numbers.NatInt.NZBitsSpec *) Lemma shiftl_spec_low : forall a n m, m testbit (shiftl a n) m = false. Proof. intros a n; induction n as [|n IHn]; intros m H; [ inversion H | ]. change (shiftl a (S n)) with (double (shiftl a n)). destruct m; simpl. - unfold odd; apply negb_false_iff. apply even_spec. exists (shiftl a n). apply double_twice. - rewrite double_twice, div2_double. apply IHn. now apply succ_le_mono. Qed. (* not yet generalized, part of the interface at this point *) Lemma div2_bitwise : forall op n a b, div2 (bitwise op (S n) a b) = bitwise op n (div2 a) (div2 b). Proof. intros op n a b; unfold bitwise; fold bitwise. destruct (op (odd a) (odd b)). - now rewrite div2_succ_double. - now rewrite add_0_l, div2_double. Qed. (* not yet generalized, part of the interface at this point *) Lemma odd_bitwise : forall op n a b, odd (bitwise op (S n) a b) = op (odd a) (odd b). Proof. intros op n a b; unfold bitwise; fold bitwise. destruct (op (odd a) (odd b)). - apply odd_spec. rewrite add_comm; eexists; eauto. - unfold odd; apply negb_false_iff. apply even_spec. rewrite add_0_l; eexists; eauto. Qed. (* not yet generalized, part of the interface at this point *) Lemma testbit_bitwise_1 : forall op, (forall b, op false b = false) -> forall n m a b, a<=n -> testbit (bitwise op n a b) m = op (testbit a m) (testbit b m). Proof. intros op Hop. intro n; induction n as [|n IHn]; intros m a b Ha. - simpl; inversion Ha; subst. now rewrite testbit_0_l. - destruct m. + apply odd_bitwise. + unfold testbit; fold testbit; rewrite div2_bitwise. apply IHn; now apply div2_decr. Qed. (* not yet generalized, part of the interface at this point *) Lemma testbit_bitwise_2 : forall op, op false false = false -> forall n m a b, a<=n -> b<=n -> testbit (bitwise op n a b) m = op (testbit a m) (testbit b m). Proof. intros op Hop. intro n; induction n as [|n IHn]; intros m a b Ha Hb. - simpl; inversion Ha; inversion Hb; subst. now rewrite testbit_0_l. - destruct m. + apply odd_bitwise. + unfold testbit; fold testbit; rewrite div2_bitwise. apply IHn; now apply div2_decr. Qed. (* needed to implement Coq.Numbers.NatInt.NZBitsSpec *) Lemma land_spec a b n : testbit (land a b) n = testbit a n && testbit b n. Proof. unfold land; apply testbit_bitwise_1; trivial. Qed. (* needed to implement Coq.Numbers.NatInt.NZBitsSpec *) Lemma ldiff_spec a b n : testbit (ldiff a b) n = testbit a n && negb (testbit b n). Proof. unfold ldiff; apply testbit_bitwise_1; trivial. Qed. (* needed to implement Coq.Numbers.NatInt.NZBitsSpec *) Lemma lor_spec a b n : testbit (lor a b) n = testbit a n || testbit b n. Proof. unfold lor; apply testbit_bitwise_2. - trivial. - destruct (compare_spec a b) as [H|H|H]. + rewrite max_l; subst; trivial. + now apply lt_le_incl in H; rewrite max_r. + now apply lt_le_incl in H; rewrite max_l. - destruct (compare_spec a b) as [H|H|H]. + rewrite max_r; subst; trivial. + now apply lt_le_incl in H; rewrite max_r. + now apply lt_le_incl in H; rewrite max_l. Qed. (* needed to implement Coq.Numbers.NatInt.NZBitsSpec *) Lemma lxor_spec a b n : testbit (lxor a b) n = xorb (testbit a n) (testbit b n). Proof. unfold lxor; apply testbit_bitwise_2. - trivial. - destruct (compare_spec a b) as [H|H|H]. + rewrite max_l; subst; trivial. + now apply lt_le_incl in H; rewrite max_r. + now apply lt_le_incl in H; rewrite max_l. - destruct (compare_spec a b) as [H|H|H]. + rewrite max_r; subst; trivial. + now apply lt_le_incl in H; rewrite max_r. + now apply lt_le_incl in H; rewrite max_l. Qed. (* needed to implement Coq.Numbers.NatInt.NZBitsSpec *) Lemma div2_spec a : div2 a = shiftr a 1. Proof. reflexivity. Qed. (** Aliases with extra dummy hypothesis, to fulfil the interface *) (* needed to implement Coq.Numbers.NatInt.NZBitsSpec *) Definition testbit_odd_succ a n (_:0<=n) := testbit_odd_succ' a n. (* needed to implement Coq.Numbers.NatInt.NZBitsSpec *) Definition testbit_even_succ a n (_:0<=n) := testbit_even_succ' a n. (* needed to implement Coq.Numbers.NatInt.NZBitsSpec *) Lemma testbit_neg_r a n (H:n<0) : testbit a n = false. Proof. inversion H. Qed. (* needed to implement Coq.Numbers.NatInt.NZBitsSpec *) Definition shiftl_spec_high a n m (_:0<=m) := shiftl_specif_high a n m. (* needed to implement Coq.Numbers.NatInt.NZBitsSpec *) Definition shiftr_spec a n m (_:0<=m) := shiftr_specif a n m. End PrivateImplementsBitwiseSpec. Include PrivateImplementsBitwiseSpec. Lemma div_0_r a : a / 0 = 0. Proof. reflexivity. Qed. Lemma mod_0_r a : a mod 0 = a. Proof. reflexivity. Qed. (** Properties of advanced functions (pow, sqrt, log2, ...) *) Include NExtraPreProp <+ NExtraProp0. Lemma binary_induction (A : nat -> Prop) : A 0 -> (forall n, A n -> A (2 * n)) -> (forall n, A n -> A (2 * n + 1)) -> forall n, A n. Proof. apply Private_binary_induction; intros x y ->; reflexivity. Qed. (** Properties of tail-recursive addition and multiplication *) Lemma tail_add_spec n m : tail_add n m = n + m. Proof. revert m; induction n as [|n IH]; simpl; trivial; intros. now rewrite IH, add_succ_r. Qed. Lemma tail_addmul_spec r n m : tail_addmul r n m = r + n * m. Proof. revert m r; induction n as [| n IH]; simpl; trivial; intros. rewrite IH, tail_add_spec. rewrite add_assoc. f_equal; apply add_comm. Qed. Lemma tail_mul_spec n m : tail_mul n m = n * m. Proof. unfold tail_mul; now rewrite tail_addmul_spec. Qed. (** Additional results about [Even] and [Odd] *) Definition Even_Odd_dec n : {Even n} + {Odd n}. Proof. induction n as [|n IHn]. - left; apply Even_0. - elim IHn; intros. + right; apply Even_succ, Even_succ_succ; assumption. + left; apply Odd_succ, Odd_succ_succ; assumption. Defined. Definition Even_add_split n m : Even (n + m) -> Even n /\ Even m \/ Odd n /\ Odd m. Proof. rewrite <- ? even_spec, <- ? odd_spec, even_add; unfold odd; do 2 destruct even; auto. Qed. Definition Odd_add_split n m : Odd (n + m) -> Odd n /\ Even m \/ Even n /\ Odd m. Proof. rewrite <- ? even_spec, <- ? odd_spec, odd_add; unfold odd; do 2 destruct even; auto. Qed. Definition Even_Even_add n m: Even n -> Even m -> Even (n + m). Proof. rewrite <- ? even_spec, even_add; do 2 destruct even; auto. Qed. Definition Odd_add_l n m : Odd n -> Even m -> Odd (n + m). Proof. rewrite <- ? even_spec, <- ? odd_spec, odd_add; unfold odd; do 2 destruct even; auto. Qed. Definition Odd_add_r n m : Even n -> Odd m -> Odd (n + m). Proof. rewrite <- ? even_spec, <- ? odd_spec, odd_add; unfold odd; do 2 destruct even; auto. Qed. Definition Odd_Odd_add n m : Odd n -> Odd m -> Even (n + m). Proof. rewrite <- ? even_spec, <- ? odd_spec, even_add; unfold odd; do 2 destruct even; auto. Qed. Definition Even_add_aux n m : (Odd (n + m) <-> Odd n /\ Even m \/ Even n /\ Odd m) /\ (Even (n + m) <-> Even n /\ Even m \/ Odd n /\ Odd m). Proof. split; split. - apply Odd_add_split. - intros [[HO HE]|[HE HO]]; [ apply Odd_add_l | apply Odd_add_r ]; assumption. - apply Even_add_split. - intros [[HO HE]|[HE HO]]; [ apply Even_Even_add | apply Odd_Odd_add ]; assumption. Qed. Definition Even_add_Even_inv_r n m : Even (n + m) -> Even n -> Even m. Proof. rewrite <- ? even_spec, even_add; do 2 destruct even; auto. Qed. Definition Even_add_Even_inv_l n m : Even (n + m) -> Even m -> Even n. Proof. rewrite <- ? even_spec, even_add; do 2 destruct even; auto. Qed. Definition Even_add_Odd_inv_r n m : Even (n + m) -> Odd n -> Odd m. Proof. rewrite <- ? even_spec, <- ? odd_spec, even_add; unfold odd; do 2 destruct even; auto. Qed. Definition Even_add_Odd_inv_l n m : Even (n + m) -> Odd m -> Odd n. Proof. rewrite <- ? even_spec, <- ? odd_spec, even_add; unfold odd; do 2 destruct even; auto. Qed. Definition Odd_add_Even_inv_l n m : Odd (n + m) -> Odd m -> Even n. Proof. rewrite <- ? even_spec, <- ? odd_spec, odd_add; unfold odd; do 2 destruct even; auto. Qed. Definition Odd_add_Even_inv_r n m : Odd (n + m) -> Odd n -> Even m. Proof. rewrite <- ? even_spec, <- ? odd_spec, odd_add; unfold odd; do 2 destruct even; auto. Qed. Definition Odd_add_Odd_inv_l n m : Odd (n + m) -> Even m -> Odd n. Proof. rewrite <- ? even_spec, <- ? odd_spec, odd_add; unfold odd; do 2 destruct even; auto. Qed. Definition Odd_add_Odd_inv_r n m : Odd (n + m) -> Even n -> Odd m. Proof. rewrite <- ? even_spec, <- ? odd_spec, odd_add; unfold odd; do 2 destruct even; auto. Qed. Definition Even_mul_aux n m : (Odd (n * m) <-> Odd n /\ Odd m) /\ (Even (n * m) <-> Even n \/ Even m). Proof. rewrite <- ? even_spec, <- ? odd_spec, odd_mul, even_mul; unfold odd; do 2 destruct even; tauto. Qed. Definition Even_mul_l n m : Even n -> Even (n * m). Proof. rewrite <- ? even_spec, even_mul; do 2 destruct even; auto. Qed. Definition Even_mul_r n m : Even m -> Even (n * m). Proof. rewrite <- ? even_spec, even_mul; do 2 destruct even; auto. Qed. Definition Even_mul_inv_r n m : Even (n * m) -> Odd n -> Even m. Proof. rewrite <- ? even_spec, <- ? odd_spec, even_mul; unfold odd; do 2 destruct even; auto. Qed. Definition Even_mul_inv_l n m : Even (n * m) -> Odd m -> Even n. Proof. rewrite <- ? even_spec, <- ? odd_spec, even_mul; unfold odd; do 2 destruct even; auto. Qed. Definition Odd_mul n m : Odd n -> Odd m -> Odd (n * m). Proof. rewrite <- ? odd_spec, odd_mul; unfold odd; do 2 destruct even; auto. Qed. Definition Odd_mul_inv_l n m : Odd (n * m) -> Odd n. Proof. rewrite <- ? odd_spec, odd_mul; unfold odd; do 2 destruct even; auto. Qed. Definition Odd_mul_inv_r n m : Odd (n * m) -> Odd m. Proof. rewrite <- ? odd_spec, odd_mul; unfold odd; do 2 destruct even; auto. Qed. Definition Even_div2 n : Even n -> div2 n = div2 (S n). Proof. intros [p ->]; rewrite div2_succ_double; apply div2_double. Qed. Definition Odd_div2 n : Odd n -> S (div2 n) = div2 (S n). Proof. intros [p ->]; rewrite add_1_r, div2_succ_double; cbn. f_equal; symmetry; apply div2_double. Qed. Definition div2_Even n : div2 n = div2 (S n) -> Even n. Proof. destruct (Even_or_Odd n) as [Ev|Od]; trivial. apply Odd_div2 in Od; rewrite <- Od. intro Od'; destruct (neq_succ_diag_r _ Od'). Qed. Definition div2_Odd n : S (div2 n) = div2 (S n) -> Odd n. Proof. destruct (Even_or_Odd n) as [Ev|Od]; trivial. apply Even_div2 in Ev; rewrite <- Ev. intro Ev'; symmetry in Ev'; destruct (neq_succ_diag_r _ Ev'). Qed. Definition Even_Odd_div2 n : (Even n <-> div2 n = div2 (S n)) /\ (Odd n <-> S (div2 n) = div2 (S n)). Proof. split; split; [ apply Even_div2 | apply div2_Even | apply Odd_div2 | apply div2_Odd ]. Qed. Definition Even_Odd_double n : (Even n <-> n = double (div2 n)) /\ (Odd n <-> n = S (double (div2 n))). Proof. revert n. fix Even_Odd_double 1. intros n; destruct n as [|[|n]]. - (* n = 0 *) split; split; intros H; [ reflexivity | apply Even_0 | apply Odd_0 in H as [] | inversion H ]. - (* n = 1 *) split; split; intros H; [ apply Even_1 in H as [] | inversion H | reflexivity | apply Odd_1 ]. - (* n = (S (S n')) *) destruct (Even_Odd_double n) as ((Ev,Ev'),(Od,Od')). split; split; simpl div2; rewrite ? double_S, ? Even_succ_succ, ? Odd_succ_succ. + intros; do 2 f_equal; auto. + injection 1; auto. + intros; do 2 f_equal; auto. + injection 1; auto. Qed. Definition Even_double n : Even n -> n = double (div2 n). Proof proj1 (proj1 (Even_Odd_double n)). Definition double_Even n : n = double (div2 n) -> Even n. Proof proj2 (proj1 (Even_Odd_double n)). Definition Odd_double n : Odd n -> n = S (double (div2 n)). Proof proj1 (proj2 (Even_Odd_double n)). Definition double_Odd n : n = S (double (div2 n)) -> Odd n. Proof proj2 (proj2 (Even_Odd_double n)). (** Inductive definition of even and odd *) Inductive Even_alt : nat -> Prop := | Even_alt_O : Even_alt 0 | Even_alt_S : forall n, Odd_alt n -> Even_alt (S n) with Odd_alt : nat -> Prop := | Odd_alt_S : forall n, Even_alt n -> Odd_alt (S n). Definition Even_alt_Even : forall n, Even_alt n <-> Even n. Proof. fix Even_alt_Even 1. intros n; destruct n as [|[|n]]; simpl. - split; [now exists 0 | constructor]. - split. + inversion_clear 1 as [|? H0]. inversion_clear H0. + now rewrite <- Nat.even_spec. - rewrite Nat.Even_succ_succ, <- Even_alt_Even. split. + inversion_clear 1 as [|? H0]. now inversion_clear H0. + now do 2 constructor. Qed. Definition Odd_alt_Odd : forall n, Odd_alt n <-> Odd n. Proof. fix Odd_alt_Odd 1. intros n; destruct n as [|[|n]]; simpl. - split. + inversion_clear 1. + now rewrite <- Nat.odd_spec. - split; [ now exists 0 | do 2 constructor ]. - rewrite Nat.Odd_succ_succ, <- Odd_alt_Odd. split. + inversion_clear 1 as [? H0]. now inversion_clear H0. + now do 2 constructor. Qed. Scheme Odd_alt_Even_alt_ind := Minimality for Odd_alt Sort Prop with Even_alt_Odd_alt_ind := Minimality for Even_alt Sort Prop. Lemma Odd_Even_ind (P Q : nat -> Prop) : (forall n, Even n -> Q n -> P (S n)) -> Q 0 -> (forall n, Odd n -> P n -> Q (S n)) -> forall n, Odd n -> P n. Proof. intros HSE H0 HSO n HO%Odd_alt_Odd. apply Odd_alt_Even_alt_ind with Q; try assumption. - intros m HSE'%Even_alt_Even; auto. - intros m HSO'%Odd_alt_Odd; auto. Qed. Lemma Even_Odd_ind (P Q : nat -> Prop) : (forall n, Even n -> Q n -> P (S n)) -> Q 0 -> (forall n, Odd n -> P n -> Q (S n)) -> forall n, Even n -> Q n. Proof. intros HSE H0 HSO n HE%Even_alt_Even. apply Even_alt_Odd_alt_ind with P; try assumption. - intros m HSE'%Even_alt_Even; auto. - intros m HSO'%Odd_alt_Odd; auto. Qed. (* Anomaly see Issue #15413 Combined Scheme Even_Odd_mutind from Even_Odd_ind, Odd_Even_ind. *) Scheme Odd_alt_Even_alt_sind := Minimality for Odd_alt Sort SProp with Even_alt_Odd_alt_sind := Minimality for Even_alt Sort SProp. Lemma Odd_Even_sind (P Q : nat -> SProp) : (forall n, Even n -> Q n -> P (S n)) -> Q 0 -> (forall n, Odd n -> P n -> Q (S n)) -> forall n, Odd n -> P n. Proof. intros HSE H0 HSO n HO%Odd_alt_Odd. apply Odd_alt_Even_alt_sind with Q; try assumption. - intros m HSE'%Even_alt_Even; auto. - intros m HSO'%Odd_alt_Odd; auto. Qed. Lemma Even_Odd_sind (P Q : nat -> SProp) : (forall n, Even n -> Q n -> P (S n)) -> Q 0 -> (forall n, Odd n -> P n -> Q (S n)) -> forall n, Even n -> Q n. Proof. intros HSE H0 HSO n HE%Even_alt_Even. apply Even_alt_Odd_alt_sind with P; try assumption. - intros m HSE'%Even_alt_Even; auto. - intros m HSO'%Odd_alt_Odd; auto. Qed. (* Anomaly see Issue #15413 Combined Scheme Even_Odd_mutsind from Even_Odd_sind, Odd_Even_sind. *) (** additional versions of parity predicates in [Type] useful for eliminating into [Type], but still with opaque proofs *) Definition EvenT n := { m | n = 2 * m }. Definition OddT n := { m | n = 2 * m + 1 }. Lemma EvenT_0 : EvenT 0. Proof. exists 0; reflexivity. Qed. Lemma EvenT_2 n : EvenT n -> EvenT (S (S n)). Proof. intros [m H]; exists (S m); rewrite H. cbn; rewrite add_succ_r; reflexivity. Qed. Lemma OddT_1 : OddT 1. Proof. exists 0; reflexivity. Qed. Lemma OddT_2 n : OddT n -> OddT (S (S n)). Proof. intros [m H]; exists (S m). rewrite H, ? mul_succ_r, <- ? add_1_r, add_assoc; reflexivity. Qed. Lemma EvenT_S_OddT n : EvenT (S n) -> OddT n. Proof. intros [[|k] HE]; inversion HE. exists k; rewrite add_succ_r, add_1_r; reflexivity. Qed. Lemma OddT_S_EvenT n : OddT (S n) -> EvenT n. Proof. intros [k HO]; rewrite add_1_r in HO; injection HO; intros ->. exists k; reflexivity. Qed. Lemma even_EvenT : forall n, even n = true -> EvenT n. Proof. fix even_specT 1. intro n; destruct n as [|[|n]]; simpl. - intros; apply EvenT_0. - intros H; discriminate. - intros He%even_specT; apply EvenT_2; assumption. Qed. Lemma odd_OddT : forall n, odd n = true -> OddT n. Proof. unfold odd. fix odd_specT 1. intro n; destruct n as [|[|n]]; simpl. - intro H; discriminate. - intros; apply OddT_1. - intros He%odd_specT; apply OddT_2; assumption. Qed. Lemma EvenT_Even n : EvenT n -> Even n. Proof. intros [k ?]; exists k; assumption. Qed. Lemma OddT_Odd n : OddT n -> Odd n. Proof. intros [k ?]; exists k; assumption. Qed. Lemma Even_EvenT n : Even n -> EvenT n. Proof. intros; apply even_EvenT, even_spec; assumption. Qed. Lemma Odd_OddT n : Odd n -> OddT n. Proof. intros; apply odd_OddT, odd_spec; assumption. Qed. Lemma EvenT_even n : EvenT n -> even n = true. Proof. intros; apply even_spec, EvenT_Even; assumption. Qed. Lemma OddT_odd n : OddT n -> odd n = true. Proof. intros; apply odd_spec, OddT_Odd; assumption. Qed. Lemma EvenT_OddT_dec n : EvenT n + OddT n. Proof. case_eq (even n); intros Hp. - left; apply even_EvenT; assumption. - right; apply odd_OddT. unfold odd; rewrite Hp; reflexivity. Qed. Lemma OddT_EvenT_rect (P Q : nat -> Type) : (forall n, EvenT n -> Q n -> P (S n)) -> Q 0 -> (forall n, OddT n -> P n -> Q (S n)) -> forall n, OddT n -> P n. Proof. intros HQP HQ0 HPQ. fix OddT_EvenT_rect 1. intros [|[|n]]. - intros [[|k] H0]; inversion H0. - intros _; apply (HQP _ EvenT_0 HQ0). - intros HOSS. assert (EvenT (S n)) as HES by apply (OddT_S_EvenT _ HOSS). assert (OddT n) as HO by apply (EvenT_S_OddT _ HES). apply (HQP _ HES (HPQ _ HO (OddT_EvenT_rect _ HO))). Qed. Lemma EvenT_OddT_rect (P Q : nat -> Type) : (forall n, EvenT n -> Q n -> P (S n)) -> Q 0 -> (forall n, OddT n -> P n -> Q (S n)) -> forall n, EvenT n -> Q n. Proof. intros HQP HQ0 HPQ [|n] HES; [ assumption | ]. assert (OddT n) as HO by apply (EvenT_S_OddT _ HES). apply HPQ, (OddT_EvenT_rect P Q); assumption. Qed. (* Anomaly see Issue #15413 Combined Scheme EvenT_OddT_mutrect from EvenT_OddT_rect, OddT_EvenT_rect. *) End Nat. (** Re-export notations that should be available even when the [Nat] module is not imported. *) Bind Scope nat_scope with Nat.t nat. Infix "^" := Nat.pow : nat_scope. Infix "=?" := Nat.eqb (at level 70) : nat_scope. Infix "<=?" := Nat.leb (at level 70) : nat_scope. Infix " (proj1 (Nat.lt_succ_r n m))). Register lt_n_Sm_le as num.nat.lt_n_Sm_le. #[local] Definition le_lt_n_Sm := (fun n m => (proj2 (Nat.lt_succ_r n m))). Register le_lt_n_Sm as num.nat.le_lt_n_Sm. #[local] Definition lt_S_n := (fun n m => (proj2 (Nat.succ_lt_mono n m))). Register lt_S_n as num.nat.lt_S_n. Register Nat.le_lt_trans as num.nat.le_lt_trans. #[local] Definition pred_of_minus := (fun n => eq_sym (Nat.sub_1_r n)). Register pred_of_minus as num.nat.pred_of_minus. Register Nat.le_trans as num.nat.le_trans. Register Nat.nlt_0_r as num.nat.nlt_0_r. (** [Nat] contains an [order] tactic for natural numbers *) (** Note that [Nat.order] is domain-agnostic: it will not prove [1<=2] or [x<=x+x], but rather things like [x<=y -> y<=x -> x=y]. *) Section TestOrder. Let test : forall x y, x<=y -> y<=x -> x=y. Proof. Nat.order. Defined. End TestOrder. coq-8.20.0/theories/Arith/Peano_dec.v000066400000000000000000000042121466560755400173410ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* ]. rewrite (UIP_nat _ _ def_n0 eq_refl); simpl. assert (H : le_mn1 = le_mn2). * now apply IHn0. * now rewrite H. Qed. coq-8.20.0/theories/Arith/Wf_nat.v000066400000000000000000000201041466560755400167000ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* nat. Definition ltof (a b:A) := f a < f b. Definition gtof (a b:A) := f b > f a. Theorem well_founded_ltof : well_founded ltof. Proof. assert (H : forall n (a:A), f a < n -> Acc ltof a). { intro n; induction n as [|n IHn]. - intros a Ha; absurd (f a < 0); auto. apply Nat.nlt_0_r. - intros a Ha. apply Acc_intro. unfold ltof at 1. intros b Hb. apply IHn. apply Nat.lt_le_trans with (f a); auto. now apply Nat.succ_le_mono. } intros a. apply (H (S (f a))). apply Nat.lt_succ_diag_r. Defined. Register well_founded_ltof as num.nat.well_founded_ltof. Theorem well_founded_gtof : well_founded gtof. Proof. exact well_founded_ltof. Defined. (** It is possible to directly prove the induction principle going back to primitive recursion on natural numbers ([induction_ltof1]) or to use the previous lemmas to extract a program with a fixpoint ([induction_ltof2]) the ML-like program for [induction_ltof1] is : [[ let induction_ltof1 f F a = let rec indrec n k = match n with | O -> error | S m -> F k (indrec m) in indrec (f a + 1) a ]] the ML-like program for [induction_ltof2] is : [[ let induction_ltof2 F a = indrec a where rec indrec a = F a indrec;; ]] *) Theorem induction_ltof1 : forall P:A -> Type, (forall x:A, (forall y:A, ltof y x -> P y) -> P x) -> forall a:A, P a. Proof. intros P F. assert (H : forall n (a:A), f a < n -> P a). { intro n; induction n as [|n IHn]. - intros a Ha; absurd (f a < 0); auto. apply Nat.nlt_0_r. - intros a Ha. apply F. unfold ltof. intros b Hb. apply IHn. apply Nat.lt_le_trans with (f a); auto. now apply Nat.succ_le_mono. } intros a. apply (H (S (f a))). apply Nat.lt_succ_diag_r. Defined. Theorem induction_gtof1 : forall P:A -> Type, (forall x:A, (forall y:A, gtof y x -> P y) -> P x) -> forall a:A, P a. Proof. exact induction_ltof1. Defined. Theorem induction_ltof2 : forall P:A -> Type, (forall x:A, (forall y:A, ltof y x -> P y) -> P x) -> forall a:A, P a. Proof. exact (well_founded_induction_type well_founded_ltof). Defined. Theorem induction_gtof2 : forall P:A -> Type, (forall x:A, (forall y:A, gtof y x -> P y) -> P x) -> forall a:A, P a. Proof. exact induction_ltof2. Defined. (** If a relation [R] is compatible with [lt] i.e. if [x R y => f(x) < f(y)] then [R] is well-founded. *) Variable R : A -> A -> Prop. Hypothesis H_compat : forall x y:A, R x y -> f x < f y. Theorem well_founded_lt_compat : well_founded R. Proof. assert (H : forall n (a:A), f a < n -> Acc R a). { intro n; induction n as [|n IHn]. - intros a Ha; absurd (f a < 0); auto. apply Nat.nlt_0_r. - intros a Ha. apply Acc_intro. intros b Hb. apply IHn. apply Nat.lt_le_trans with (f a); auto. now apply Nat.succ_le_mono. } intros a. apply (H (S (f a))). apply Nat.lt_succ_diag_r. Defined. End Well_founded_Nat. Lemma lt_wf : well_founded lt. Proof. exact (well_founded_ltof nat (fun m => m)). Defined. Lemma lt_wf_rect1 : forall n (P:nat -> Type), (forall n, (forall m, m < n -> P m) -> P n) -> P n. Proof. exact (fun p P F => induction_ltof1 nat (fun m => m) P F p). Defined. Lemma lt_wf_rect : forall n (P:nat -> Type), (forall n, (forall m, m < n -> P m) -> P n) -> P n. Proof. exact (fun p P F => induction_ltof2 nat (fun m => m) P F p). Defined. Lemma lt_wf_rec1 : forall n (P:nat -> Set), (forall n, (forall m, m < n -> P m) -> P n) -> P n. Proof. exact (fun p P F => induction_ltof1 nat (fun m => m) P F p). Defined. Lemma lt_wf_rec : forall n (P:nat -> Set), (forall n, (forall m, m < n -> P m) -> P n) -> P n. Proof. exact (fun p P F => induction_ltof2 nat (fun m => m) P F p). Defined. Lemma lt_wf_ind : forall n (P:nat -> Prop), (forall n, (forall m, m < n -> P m) -> P n) -> P n. Proof. intro p; intros; elim (lt_wf p); auto. Qed. Lemma gt_wf_rect : forall n (P:nat -> Type), (forall n, (forall m, n > m -> P m) -> P n) -> P n. Proof. exact lt_wf_rect. Defined. Lemma gt_wf_rec : forall n (P:nat -> Set), (forall n, (forall m, n > m -> P m) -> P n) -> P n. Proof. exact lt_wf_rec. Defined. Lemma gt_wf_ind : forall n (P:nat -> Prop), (forall n, (forall m, n > m -> P m) -> P n) -> P n. Proof lt_wf_ind. Lemma lt_wf_double_rect : forall P:nat -> nat -> Type, (forall n m, (forall p q, p < n -> P p q) -> (forall p, p < m -> P n p) -> P n m) -> forall n m, P n m. Proof. intros P Hrec p; pattern p; apply lt_wf_rect. intros n H q; pattern q; apply lt_wf_rect; auto. Defined. Lemma lt_wf_double_rec : forall P:nat -> nat -> Set, (forall n m, (forall p q, p < n -> P p q) -> (forall p, p < m -> P n p) -> P n m) -> forall n m, P n m. Proof. intros P Hrec p; pattern p; apply lt_wf_rec. intros n H q; pattern q; apply lt_wf_rec; auto. Defined. Lemma lt_wf_double_ind : forall P:nat -> nat -> Prop, (forall n m, (forall p (q:nat), p < n -> P p q) -> (forall p, p < m -> P n p) -> P n m) -> forall n m, P n m. Proof. intros P Hrec p; pattern p; apply lt_wf_ind. intros n H q; pattern q; apply lt_wf_ind; auto. Qed. #[global] Hint Resolve lt_wf: arith. #[global] Hint Resolve well_founded_lt_compat: arith. Section LT_WF_REL. Variable A : Set. Variable R : A -> A -> Prop. (* Relational form of inversion *) Variable F : A -> nat -> Prop. Definition inv_lt_rel x y := exists2 n, F x n & (forall m, F y m -> n < m). Hypothesis F_compat : forall x y:A, R x y -> inv_lt_rel x y. Remark acc_lt_rel : forall x:A, (exists n, F x n) -> Acc R x. Proof. intros x [n fxn]; generalize dependent x. pattern n; apply lt_wf_ind; intros n0 H x fxn. constructor; intros y H0. destruct (F_compat y x) as (x0,H1,H2); trivial. apply (H x0); auto. Qed. Theorem well_founded_inv_lt_rel_compat : well_founded R. Proof. intro a; constructor; intros y H. case (F_compat y a); trivial; intros x **. apply acc_lt_rel; trivial. exists x; trivial. Qed. End LT_WF_REL. Lemma well_founded_inv_rel_inv_lt_rel (A:Set) (F:A -> nat -> Prop) : well_founded (inv_lt_rel A F). Proof. apply (well_founded_inv_lt_rel_compat A (inv_lt_rel A F) F); trivial. Qed. (** A constructive proof that any non empty decidable subset of natural numbers has a least element *) Set Implicit Arguments. Require Import Compare_dec. Require Import Decidable. Definition has_unique_least_element (A:Type) (R:A->A->Prop) (P:A->Prop) := exists! x, P x /\ forall x', P x' -> R x x'. Lemma dec_inh_nat_subset_has_unique_least_element : forall P:nat->Prop, (forall n, P n \/ ~ P n) -> (exists n, P n) -> has_unique_least_element le P. Proof. intros P Pdec (n0,HPn0). assert (forall n, (exists n', n' n'<=n'') \/ (forall n', P n' -> n<=n')) as H. { intro n; induction n as [|n IHn]. - right. intros. apply Nat.le_0_l. - destruct IHn as [(n' & IH1 & IH2)|IH]. + left. exists n'; auto. + destruct (Pdec n) as [HP|HP]. * left. exists n; auto. * right. intros n' Hn'. apply Nat.le_neq; split; auto. intros <-. auto. } destruct (H n0) as [(n & H1 & H2 & H3)|H0]; [exists n | exists n0]; repeat split; trivial; intros n' (HPn',Hn'); apply Nat.le_antisymm; auto. Qed. Unset Implicit Arguments. Notation iter_nat n A f x := (nat_rect (fun _ => A) x (fun _ => f) n) (only parsing). coq-8.20.0/theories/Array/000077500000000000000000000000001466560755400153055ustar00rootroot00000000000000coq-8.20.0/theories/Array/PArray.v000066400000000000000000000063431466560755400167000ustar00rootroot00000000000000Require Import Uint63. Set Universe Polymorphism. Primitive array := #array_type. Primitive make : forall A, int -> A -> array A := #array_make. Arguments make {_} _ _. Primitive get : forall A, array A -> int -> A := #array_get. Arguments get {_} _ _. Primitive default : forall A, array A -> A:= #array_default. Arguments default {_} _. Primitive set : forall A, array A -> int -> A -> array A := #array_set. Arguments set {_} _ _ _. Primitive length : forall A, array A -> int := #array_length. Arguments length {_} _. Primitive copy : forall A, array A -> array A := #array_copy. Arguments copy {_} _. Module Export PArrayNotations. Declare Scope array_scope. Delimit Scope array_scope with array. Notation "t .[ i ]" := (get t i) (at level 2, left associativity, format "t .[ i ]"). Notation "t .[ i <- a ]" := (set t i a) (at level 2, left associativity, format "t .[ i <- a ]"). End PArrayNotations. Local Open Scope uint63_scope. Local Open Scope array_scope. Primitive max_length := #array_max_length. (** Axioms *) Axiom get_out_of_bounds : forall A (t:array A) i, (i t.[i] = default t. Axiom get_set_same : forall A t i (a:A), (i t.[i<-a].[i] = a. Axiom get_set_other : forall A t i j (a:A), i <> j -> t.[i<-a].[j] = t.[j]. Axiom default_set : forall A t i (a:A), default t.[i<-a] = default t. Axiom get_make : forall A (a:A) size i, (make size a).[i] = a. Axiom leb_length : forall A (t:array A), length t <=? max_length = true. Axiom length_make : forall A size (a:A), length (make size a) = if size <=? max_length then size else max_length. Axiom length_set : forall A t i (a:A), length t.[i<-a] = length t. 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 array_ext : forall A (t1 t2:array A), length t1 = length t2 -> (forall i, i t1.[i] = t2.[i]) -> default t1 = default t2 -> t1 = t2. (* Lemmas *) Lemma default_copy A (t:array A) : default (copy t) = default t. Proof. assert (irr_lt : length t default t -> (x True | false => False end. (*******************) (** * Decidability *) (*******************) Lemma bool_dec : forall b1 b2 : bool, {b1 = b2} + {b1 <> b2}. Proof. decide equality. Defined. (*********************) (** * Discrimination *) (*********************) Lemma diff_true_false : true <> false. Proof. discriminate. Qed. #[global] Hint Resolve diff_true_false : bool. Lemma diff_false_true : false <> true. Proof. discriminate. Qed. #[global] Hint Resolve diff_false_true : bool. #[global] Hint Extern 1 (false <> true) => exact diff_false_true : core. Lemma eq_true_false_abs : forall b:bool, b = true -> b = false -> False. Proof. destr_bool. Qed. Lemma not_true_is_false : forall b:bool, b <> true -> b = false. Proof. destr_bool; intuition. Qed. Lemma not_false_is_true : forall b:bool, b <> false -> b = true. Proof. destr_bool; intuition. Qed. Lemma not_true_iff_false : forall b, b <> true <-> b = false. Proof. destr_bool; intuition. Qed. Lemma not_false_iff_true : forall b, b <> false <-> b = true. Proof. destr_bool; intuition. Qed. (************************) (** * Order on booleans *) (************************) #[ local ] Definition le (b1 b2:bool) := match b1 with | true => b2 = true | false => True end. #[global] Hint Unfold le: bool. Lemma le_implb : forall b1 b2, le b1 b2 <-> implb b1 b2 = true. Proof. destr_bool; intuition. Qed. #[ local ] Definition lt (b1 b2:bool) := match b1 with | true => False | false => b2 = true end. #[global] Hint Unfold lt: bool. #[ local ] Definition compare (b1 b2 : bool) := match b1, b2 with | false, true => Lt | true, false => Gt | _, _ => Eq end. Lemma compare_spec : forall b1 b2, CompareSpec (b1 = b2) (lt b1 b2) (lt b2 b1) (compare b1 b2). Proof. destr_bool; auto. Qed. (***************) (** * Equality *) (***************) Definition eqb (b1 b2:bool) : bool := match b1, b2 with | true, true => true | true, false => false | false, true => false | false, false => true end. Register eqb as core.bool.eqb. Lemma eqb_subst : forall (P:bool -> Prop) (b1 b2:bool), eqb b1 b2 = true -> P b1 -> P b2. Proof. destr_bool. Qed. Lemma eqb_reflx : forall b:bool, eqb b b = true. Proof. destr_bool. Qed. Lemma eqb_prop : forall a b:bool, eqb a b = true -> a = b. Proof. destr_bool. Qed. Lemma eqb_true_iff : forall a b:bool, eqb a b = true <-> a = b. Proof. destr_bool; intuition. Qed. #[global] Instance Decidable_eq_bool : forall (x y : bool), Decidable (eq x y) := { Decidable_spec := eqb_true_iff x y }. Lemma eqb_false_iff : forall a b:bool, eqb a b = false <-> a <> b. Proof. destr_bool; intuition. Qed. (**********************************) (** * A synonym of [if] on [bool] *) (**********************************) Definition ifb (b1 b2 b3:bool) : bool := match b1 with | true => b2 | false => b3 end. Open Scope bool_scope. (*********************) (** * De Morgan laws *) (*********************) Lemma negb_orb : forall b1 b2:bool, negb (b1 || b2) = negb b1 && negb b2. Proof. destr_bool. Qed. Lemma negb_andb : forall b1 b2:bool, negb (b1 && b2) = negb b1 || negb b2. Proof. destr_bool. Qed. (***************************) (** * Properties of [negb] *) (***************************) Lemma negb_involutive : forall b:bool, negb (negb b) = b. Proof. destr_bool. Qed. Lemma negb_involutive_reverse : forall b:bool, b = negb (negb b). Proof. destr_bool. Qed. Notation negb_elim := negb_involutive (only parsing). Notation negb_intro := negb_involutive_reverse (only parsing). Lemma negb_sym : forall b b':bool, b' = negb b -> b = negb b'. Proof. destr_bool. Qed. Lemma no_fixpoint_negb : forall b:bool, negb b <> b. Proof. destr_bool. Qed. Lemma eqb_negb1 : forall b:bool, eqb (negb b) b = false. Proof. destr_bool. Qed. Lemma eqb_negb2 : forall b:bool, eqb b (negb b) = false. Proof. destr_bool. Qed. Lemma if_negb : forall (A:Type) (b:bool) (x y:A), (if negb b then x else y) = (if b then y else x). Proof. destr_bool. Qed. Lemma negb_true_iff : forall b, negb b = true <-> b = false. Proof. destr_bool; intuition. Qed. Lemma negb_false_iff : forall b, negb b = false <-> b = true. Proof. destr_bool; intuition. Qed. (**************************) (** * Properties of [orb] *) (**************************) Lemma orb_true_iff : forall b1 b2, b1 || b2 = true <-> b1 = true \/ b2 = true. Proof. destr_bool; intuition. Qed. Lemma orb_false_iff : forall b1 b2, b1 || b2 = false <-> b1 = false /\ b2 = false. Proof. destr_bool; intuition. Qed. Lemma orb_true_elim : forall b1 b2:bool, b1 || b2 = true -> {b1 = true} + {b2 = true}. Proof. intro b1; destruct b1; simpl; auto. Defined. Lemma orb_prop : forall a b:bool, a || b = true -> a = true \/ b = true. Proof. intros; apply orb_true_iff; trivial. Qed. Lemma orb_true_intro : forall b1 b2:bool, b1 = true \/ b2 = true -> b1 || b2 = true. Proof. intros; apply orb_true_iff; trivial. Qed. #[global] Hint Resolve orb_true_intro: bool. Lemma orb_false_intro : forall b1 b2:bool, b1 = false -> b2 = false -> b1 || b2 = false. Proof. intros. subst. reflexivity. Qed. #[global] Hint Resolve orb_false_intro: bool. Lemma orb_false_elim : forall b1 b2:bool, b1 || b2 = false -> b1 = false /\ b2 = false. Proof. intros. apply orb_false_iff; trivial. Qed. Lemma orb_diag : forall b, b || b = b. Proof. destr_bool. Qed. (** [true] is a zero for [orb] *) Lemma orb_true_r : forall b:bool, b || true = true. Proof. destr_bool. Qed. #[global] Hint Resolve orb_true_r: bool. Lemma orb_true_l : forall b:bool, true || b = true. Proof. reflexivity. Qed. Notation orb_b_true := orb_true_r (only parsing). Notation orb_true_b := orb_true_l (only parsing). (** [false] is neutral for [orb] *) Lemma orb_false_r : forall b:bool, b || false = b. Proof. destr_bool. Qed. #[global] Hint Resolve orb_false_r: bool. Lemma orb_false_l : forall b:bool, false || b = b. Proof. destr_bool. Qed. #[global] Hint Resolve orb_false_l: bool. Notation orb_b_false := orb_false_r (only parsing). Notation orb_false_b := orb_false_l (only parsing). (** Complementation *) Lemma orb_negb_r : forall b:bool, b || negb b = true. Proof. destr_bool. Qed. #[global] Hint Resolve orb_negb_r: bool. Lemma orb_negb_l : forall b:bool, negb b || b = true. Proof. destr_bool. Qed. Notation orb_neg_b := orb_negb_r (only parsing). (** Commutativity *) Lemma orb_comm : forall b1 b2:bool, b1 || b2 = b2 || b1. Proof. destr_bool. Qed. (** Associativity *) Lemma orb_assoc : forall b1 b2 b3:bool, b1 || (b2 || b3) = b1 || b2 || b3. Proof. destr_bool. Qed. #[global] Hint Resolve orb_comm orb_assoc: bool. (***************************) (** * Properties of [andb] *) (***************************) Lemma andb_true_iff : forall b1 b2:bool, b1 && b2 = true <-> b1 = true /\ b2 = true. Proof. destr_bool; intuition. Qed. Lemma andb_false_iff : forall b1 b2:bool, b1 && b2 = false <-> b1 = false \/ b2 = false. Proof. destr_bool; intuition. Qed. Lemma andb_true_eq : forall a b:bool, true = a && b -> true = a /\ true = b. Proof. destr_bool. auto. Defined. Lemma andb_false_intro1 : forall b1 b2:bool, b1 = false -> b1 && b2 = false. Proof. intros. apply andb_false_iff. auto. Qed. Lemma andb_false_intro2 : forall b1 b2:bool, b2 = false -> b1 && b2 = false. Proof. intros. apply andb_false_iff. auto. Qed. (** [false] is a zero for [andb] *) Lemma andb_false_r : forall b:bool, b && false = false. Proof. destr_bool. Qed. Lemma andb_false_l : forall b:bool, false && b = false. Proof. reflexivity. Qed. Notation andb_b_false := andb_false_r (only parsing). Notation andb_false_b := andb_false_l (only parsing). Lemma andb_diag : forall b, b && b = b. Proof. destr_bool. Qed. (** [true] is neutral for [andb] *) Lemma andb_true_r : forall b:bool, b && true = b. Proof. destr_bool. Qed. Lemma andb_true_l : forall b:bool, true && b = b. Proof. reflexivity. Qed. Notation andb_b_true := andb_true_r (only parsing). Notation andb_true_b := andb_true_l (only parsing). Lemma andb_false_elim : forall b1 b2:bool, b1 && b2 = false -> {b1 = false} + {b2 = false}. Proof. intro b1; destruct b1; simpl; auto. Defined. #[global] Hint Resolve andb_false_elim: bool. (** Complementation *) Lemma andb_negb_r : forall b:bool, b && negb b = false. Proof. destr_bool. Qed. #[global] Hint Resolve andb_negb_r: bool. Lemma andb_negb_l : forall b:bool, negb b && b = false. Proof. destr_bool. Qed. Notation andb_neg_b := andb_negb_r (only parsing). (** Commutativity *) Lemma andb_comm : forall b1 b2:bool, b1 && b2 = b2 && b1. Proof. destr_bool. Qed. (** Associativity *) Lemma andb_assoc : forall b1 b2 b3:bool, b1 && (b2 && b3) = b1 && b2 && b3. Proof. destr_bool. Qed. #[global] Hint Resolve andb_comm andb_assoc: bool. (*****************************************) (** * Properties mixing [andb] and [orb] *) (*****************************************) (** Distributivity *) Lemma andb_orb_distrib_r : forall b1 b2 b3:bool, b1 && (b2 || b3) = b1 && b2 || b1 && b3. Proof. destr_bool. Qed. Lemma andb_orb_distrib_l : forall b1 b2 b3:bool, (b1 || b2) && b3 = b1 && b3 || b2 && b3. Proof. destr_bool. Qed. Lemma orb_andb_distrib_r : forall b1 b2 b3:bool, b1 || b2 && b3 = (b1 || b2) && (b1 || b3). Proof. destr_bool. Qed. Lemma orb_andb_distrib_l : forall b1 b2 b3:bool, b1 && b2 || b3 = (b1 || b3) && (b2 || b3). Proof. destr_bool. Qed. (* Compatibility *) Notation demorgan1 := andb_orb_distrib_r (only parsing). Notation demorgan2 := andb_orb_distrib_l (only parsing). Notation demorgan3 := orb_andb_distrib_r (only parsing). Notation demorgan4 := orb_andb_distrib_l (only parsing). (** Absorption *) Lemma absorption_andb : forall b1 b2:bool, b1 && (b1 || b2) = b1. Proof. destr_bool. Qed. Lemma absorption_orb : forall b1 b2:bool, b1 || b1 && b2 = b1. Proof. destr_bool. Qed. (* begin hide *) (* Compatibility *) Notation absoption_andb := absorption_andb (only parsing). Notation absoption_orb := absorption_orb (only parsing). (* end hide *) (****************************) (** * Properties of [implb] *) (****************************) Lemma implb_true_iff : forall b1 b2:bool, implb b1 b2 = true <-> (b1 = true -> b2 = true). Proof. destr_bool; intuition. Qed. Lemma implb_false_iff : forall b1 b2:bool, implb b1 b2 = false <-> (b1 = true /\ b2 = false). Proof. destr_bool; intuition. Qed. Lemma implb_orb : forall b1 b2:bool, implb b1 b2 = negb b1 || b2. Proof. destr_bool. Qed. Lemma implb_negb_orb : forall b1 b2:bool, implb (negb b1) b2 = b1 || b2. Proof. destr_bool. Qed. Lemma implb_true_r : forall b:bool, implb b true = true. Proof. destr_bool. Qed. Lemma implb_false_r : forall b:bool, implb b false = negb b. Proof. destr_bool. Qed. Lemma implb_true_l : forall b:bool, implb true b = b. Proof. destr_bool. Qed. Lemma implb_false_l : forall b:bool, implb false b = true. Proof. destr_bool. Qed. Lemma implb_same : forall b:bool, implb b b = true. Proof. destr_bool. Qed. Lemma implb_contrapositive : forall b1 b2:bool, implb (negb b1) (negb b2) = implb b2 b1. Proof. destr_bool. Qed. Lemma implb_negb : forall b1 b2:bool, implb (negb b1) b2 = implb (negb b2) b1. Proof. destr_bool. Qed. Lemma implb_curry : forall b1 b2 b3:bool, implb (b1 && b2) b3 = implb b1 (implb b2 b3). Proof. destr_bool. Qed. Lemma implb_andb_distrib_r : forall b1 b2 b3:bool, implb b1 (b2 && b3) = implb b1 b2 && implb b1 b3. Proof. destr_bool. Qed. Lemma implb_orb_distrib_r : forall b1 b2 b3:bool, implb b1 (b2 || b3) = implb b1 b2 || implb b1 b3. Proof. destr_bool. Qed. Lemma implb_orb_distrib_l : forall b1 b2 b3:bool, implb (b1 || b2) b3 = implb b1 b3 && implb b2 b3. Proof. destr_bool. Qed. (***************************) (** * Properties of [xorb] *) (***************************) (** [false] is neutral for [xorb] *) Lemma xorb_false_r : forall b:bool, xorb b false = b. Proof. destr_bool. Qed. Lemma xorb_false_l : forall b:bool, xorb false b = b. Proof. destr_bool. Qed. Notation xorb_false := xorb_false_r (only parsing). Notation false_xorb := xorb_false_l (only parsing). (** [true] is "complementing" for [xorb] *) Lemma xorb_true_r : forall b:bool, xorb b true = negb b. Proof. reflexivity. Qed. Lemma xorb_true_l : forall b:bool, xorb true b = negb b. Proof. reflexivity. Qed. Notation xorb_true := xorb_true_r (only parsing). Notation true_xorb := xorb_true_l (only parsing). (** Nilpotency (alternatively: identity is a inverse for [xorb]) *) Lemma xorb_nilpotent : forall b:bool, xorb b b = false. Proof. destr_bool. Qed. (** Commutativity *) Lemma xorb_comm : forall b b':bool, xorb b b' = xorb b' b. Proof. destr_bool. Qed. (** Associativity *) Lemma xorb_assoc_reverse : forall b b' b'':bool, xorb (xorb b b') b'' = xorb b (xorb b' b''). Proof. destr_bool. Qed. Notation xorb_assoc := xorb_assoc_reverse (only parsing). (* Compatibility *) Lemma xorb_eq : forall b b':bool, xorb b b' = false -> b = b'. Proof. destr_bool. Qed. Lemma xorb_move_l_r_1 : forall b b' b'':bool, xorb b b' = b'' -> b' = xorb b b''. Proof. destr_bool. Qed. Lemma xorb_move_l_r_2 : forall b b' b'':bool, xorb b b' = b'' -> b = xorb b'' b'. Proof. destr_bool. Qed. Lemma xorb_move_r_l_1 : forall b b' b'':bool, b = xorb b' b'' -> xorb b' b = b''. Proof. destr_bool. Qed. Lemma xorb_move_r_l_2 : forall b b' b'':bool, b = xorb b' b'' -> xorb b b'' = b'. Proof. destr_bool. Qed. Lemma negb_xorb a b : negb (xorb a b) = Bool.eqb a b. Proof. destruct a, b; trivial. Qed. Lemma negb_xorb_l : forall b b', negb (xorb b b') = xorb (negb b) b'. Proof. intros b b'; destruct b,b'; trivial. Qed. Lemma negb_xorb_r : forall b b', negb (xorb b b') = xorb b (negb b'). Proof. intros b b'; destruct b,b'; trivial. Qed. Lemma xorb_negb_negb : forall b b', xorb (negb b) (negb b') = xorb b b'. Proof. intros b b'; destruct b,b'; trivial. Qed. (** Lemmas about the [b = true] embedding of [bool] to [Prop] *) Lemma eq_iff_eq_true : forall b1 b2, b1 = b2 <-> (b1 = true <-> b2 = true). Proof. destr_bool; intuition. Qed. Lemma eq_true_iff_eq : forall b1 b2, (b1 = true <-> b2 = true) -> b1 = b2. Proof. apply eq_iff_eq_true. Qed. Notation bool_1 := eq_true_iff_eq (only parsing). (* Compatibility *) Lemma eq_true_negb_classical : forall b:bool, negb b <> true -> b = true. Proof. destr_bool; intuition. Qed. Notation bool_3 := eq_true_negb_classical (only parsing). (* Compatibility *) Lemma eq_true_negb_classical_iff : forall b:bool, negb b <> true <-> b = true. Proof. destr_bool; intuition. Qed. Lemma eq_true_not_negb : forall b:bool, b <> true -> negb b = true. Proof. destr_bool; intuition. Qed. Lemma eq_true_not_negb_iff : forall b:bool, b <> true <-> negb b = true. Proof. destr_bool; intuition. Qed. Notation bool_6 := eq_true_not_negb (only parsing). (* Compatibility *) #[global] Hint Resolve eq_true_not_negb : bool. (* An interesting lemma for auto but too strong to keep compatibility *) Lemma absurd_eq_bool : forall b b':bool, False -> b = b'. Proof. contradiction. Qed. (* A more specific one that preserves compatibility with old hint bool_3 *) Lemma absurd_eq_true : forall b, False -> b = true. Proof. contradiction. Qed. #[global] Hint Resolve absurd_eq_true : core. (* A specific instance of eq_trans that preserves compatibility with old hint bool_2 *) Lemma trans_eq_bool : forall x y z:bool, x = y -> y = z -> x = z. Proof. apply eq_trans. Qed. #[global] Hint Resolve trans_eq_bool : core. (***************************************) (** * Reflection of [bool] into [Prop] *) (***************************************) (** [Is_true] and equality *) #[global] Hint Unfold Is_true: bool. Lemma Is_true_eq_true : forall x:bool, Is_true x -> x = true. Proof. destr_bool; tauto. Qed. Lemma Is_true_eq_left : forall x:bool, x = true -> Is_true x. Proof. intros; subst; auto with bool. Qed. Lemma Is_true_eq_right : forall x:bool, true = x -> Is_true x. Proof. intros; subst; auto with bool. Qed. Notation Is_true_eq_true2 := Is_true_eq_right (only parsing). #[global] Hint Immediate Is_true_eq_right Is_true_eq_left: bool. Lemma eqb_refl : forall x:bool, Is_true (eqb x x). Proof. destr_bool. Qed. Lemma eqb_eq : forall x y:bool, Is_true (eqb x y) -> x = y. Proof. destr_bool; tauto. Qed. (** [Is_true] and connectives *) Lemma orb_prop_elim : forall a b:bool, Is_true (a || b) -> Is_true a \/ Is_true b. Proof. destr_bool; tauto. Qed. Notation orb_prop2 := orb_prop_elim (only parsing). Lemma orb_prop_intro : forall a b:bool, Is_true a \/ Is_true b -> Is_true (a || b). Proof. destr_bool; tauto. Qed. Lemma andb_prop_intro : forall b1 b2:bool, Is_true b1 /\ Is_true b2 -> Is_true (b1 && b2). Proof. destr_bool; tauto. Qed. #[global] Hint Resolve andb_prop_intro: bool. Notation andb_true_intro2 := (fun b1 b2 H1 H2 => andb_prop_intro b1 b2 (conj H1 H2)) (only parsing). Lemma andb_prop_elim : forall a b:bool, Is_true (a && b) -> Is_true a /\ Is_true b. Proof. destr_bool; auto. Qed. #[global] Hint Resolve andb_prop_elim: bool. Notation andb_prop2 := andb_prop_elim (only parsing). Lemma eq_bool_prop_intro : forall b1 b2, (Is_true b1 <-> Is_true b2) -> b1 = b2. Proof. destr_bool; tauto. Qed. Lemma eq_bool_prop_elim : forall b1 b2, b1 = b2 -> (Is_true b1 <-> Is_true b2). Proof. destr_bool; tauto. Qed. Lemma negb_prop_elim : forall b, Is_true (negb b) -> ~ Is_true b. Proof. destr_bool; tauto. Qed. Lemma negb_prop_intro : forall b, ~ Is_true b -> Is_true (negb b). Proof. destr_bool; tauto. Qed. Lemma negb_prop_classical : forall b, ~ Is_true (negb b) -> Is_true b. Proof. destr_bool; tauto. Qed. Lemma negb_prop_involutive : forall b, Is_true b -> ~ Is_true (negb b). Proof. destr_bool; tauto. Qed. (** Rewrite rules about andb, orb and if (used in romega) *) Lemma andb_if : forall (A:Type)(a a':A)(b b' : bool), (if b && b' then a else a') = (if b then if b' then a else a' else a'). Proof. destr_bool. Qed. Lemma negb_if : forall (A:Type)(a a':A)(b:bool), (if negb b then a else a') = (if b then a' else a). Proof. destr_bool. Qed. (***********************************************) (** * Alternative versions of [andb] and [orb] with lazy behavior (for vm_compute) *) (***********************************************) Declare Scope lazy_bool_scope. Notation "a &&& b" := (if a then b else false) (at level 40, left associativity) : lazy_bool_scope. Notation "a ||| b" := (if a then true else b) (at level 50, left associativity) : lazy_bool_scope. Local Open Scope lazy_bool_scope. Lemma andb_lazy_alt : forall a b : bool, a && b = a &&& b. Proof. reflexivity. Qed. Lemma orb_lazy_alt : forall a b : bool, a || b = a ||| b. Proof. reflexivity. Qed. (************************************************) (** * Reflect: a specialized inductive type for relating propositions and booleans, as popularized by the Ssreflect library. *) (************************************************) Inductive reflect (P : Prop) : bool -> Set := | ReflectT : P -> reflect P true | ReflectF : ~ P -> reflect P false. #[global] Hint Constructors reflect : bool. (** Interest: a case on a reflect lemma or hyp performs clever unification, and leave the goal in a convenient shape (a bit like case_eq). *) (** Relation with iff : *) Lemma reflect_iff : forall P b, reflect P b -> (P<->b=true). Proof. destruct 1; intuition; discriminate. Qed. Lemma iff_reflect : forall P b, (P<->b=true) -> reflect P b. Proof. destr_bool; intuition. Defined. (** It would be nice to join [reflect_iff] and [iff_reflect] in a unique [iff] statement, but this isn't allowed since [iff] is in Prop. *) (** Reflect implies decidability of the proposition *) Lemma reflect_dec : forall P b, reflect P b -> {P}+{~P}. Proof. destruct 1; auto. Defined. (** Reciprocally, from a decidability, we could state a [reflect] as soon as we have a [bool_of_sumbool]. *) (** For instance, we could state the correctness of [Bool.eqb] via [reflect]: *) Lemma eqb_spec (b b' : bool) : reflect (b = b') (eqb b b'). Proof. destruct b, b'; now constructor. Defined. (** Notations *) Module BoolNotations. Infix "<=" := le : bool_scope. Infix "<" := lt : bool_scope. Infix "?=" := compare (at level 70) : bool_scope. Infix "=?" := eqb (at level 70) : bool_scope. End BoolNotations. coq-8.20.0/theories/Bool/BoolEq.v000066400000000000000000000040421466560755400164720ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* A -> bool. Variable beq_refl : forall x:A, true = beq x x. Variable beq_eq : forall x y:A, true = beq x y -> x = y. Definition beq_eq_true : forall x y:A, x = y -> true = beq x y. Proof. intros x y H. case H. apply beq_refl. Defined. Definition beq_eq_not_false : forall x y:A, x = y -> false <> beq x y. Proof. intros x y e. rewrite <- beq_eq_true; trivial; discriminate. Defined. Definition beq_false_not_eq : forall x y:A, false = beq x y -> x <> y. Proof. exact (fun (x y:A) (H:false = beq x y) (e:x = y) => beq_eq_not_false x y e H). Defined. Definition exists_beq_eq : forall x y:A, {b : bool | b = beq x y}. Proof. intros x y. exists (beq x y). constructor. Defined. Definition not_eq_false_beq : forall x y:A, x <> y -> false = beq x y. Proof. intros x y H. symmetry . apply not_true_is_false. intro. apply H. apply beq_eq. symmetry . assumption. Defined. Definition eq_dec : forall x y:A, {x = y} + {x <> y}. Proof. intros x y; case (exists_beq_eq x y). intros b; case b; intro H. - left; apply beq_eq; assumption. - right; apply beq_false_not_eq; assumption. Defined. End Bool_eq_dec. coq-8.20.0/theories/Bool/BoolOrder.v000066400000000000000000000061201466560755400171770ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* b2 <= b3 -> b1 <= b3. Proof. destr_bool. Qed. Lemma le_true : forall b, b <= true. Proof. destr_bool. Qed. Lemma false_le : forall b, false <= b. Proof. intros; constructor. Qed. #[global] Instance le_compat : Proper (eq ==> eq ==> iff) Bool.le. Proof. intuition. Qed. (** * Strict order [lt] *) Lemma lt_irrefl : forall b, ~ b < b. Proof. destr_bool; auto. Qed. Lemma lt_trans : forall b1 b2 b3, b1 < b2 -> b2 < b3 -> b1 < b3. Proof. destr_bool; auto. Qed. #[global] Instance lt_compat : Proper (eq ==> eq ==> iff) Bool.lt. Proof. intuition. Qed. Lemma lt_trichotomy : forall b1 b2, { b1 < b2 } + { b1 = b2 } + { b2 < b1 }. Proof. destr_bool; auto. Qed. Lemma lt_total : forall b1 b2, b1 < b2 \/ b1 = b2 \/ b2 < b1. Proof. destr_bool; auto. Qed. Lemma lt_le_incl : forall b1 b2, b1 < b2 -> b1 <= b2. Proof. destr_bool; auto. Qed. Lemma le_lteq_dec : forall b1 b2, b1 <= b2 -> { b1 < b2 } + { b1 = b2 }. Proof. destr_bool; auto. Qed. Lemma le_lteq : forall b1 b2, b1 <= b2 <-> b1 < b2 \/ b1 = b2. Proof. destr_bool; intuition. Qed. (** * Order structures *) (* Class structure *) #[global] Instance le_preorder : PreOrder Bool.le. Proof. split. - intros b; apply le_refl. - intros b1 b2 b3; apply le_trans. Qed. #[global] Instance lt_strorder : StrictOrder Bool.lt. Proof. split. - intros b; apply lt_irrefl. - intros b1 b2 b3; apply lt_trans. Qed. (* Module structure *) Module BoolOrd <: UsualDecidableTypeFull <: OrderedTypeFull <: TotalOrder. Definition t := bool. Definition eq := @eq bool. Definition eq_equiv := @eq_equivalence bool. Definition lt := Bool.lt. Definition lt_strorder := lt_strorder. Definition lt_compat := lt_compat. Definition le := Bool.le. Definition le_lteq := le_lteq. Definition lt_total := lt_total. Definition compare := Bool.compare. Definition compare_spec := compare_spec. Definition eq_dec := bool_dec. Definition eq_refl := @eq_Reflexive bool. Definition eq_sym := @eq_Symmetric bool. Definition eq_trans := @eq_Transitive bool. Definition eqb := eqb. Definition eqb_eq := eqb_true_iff. End BoolOrd. coq-8.20.0/theories/Bool/Bvector.v000066400000000000000000000225201466560755400167160ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* . *) Attributes deprecated(since="8.20", note="Consider [list bool] instead. See for details. Please open an issue if you would like to keep using Bvector."). Local Set Warnings "-deprecated". (** Bit vectors. Contribution by Jean Duprat (ENS Lyon). *) Require Export Bool Sumbool. #[local] Set Warnings "-stdlib-vector". Require Vector. Export Vector.VectorNotations. Local Open Scope nat_scope. (** We build bit vectors in the spirit of List.v. The size of the vector is a parameter which is too important to be accessible only via function "length". The first idea is to build a record with both the list and the length. Unfortunately, this a posteriori verification leads to numerous lemmas for handling lengths. The second idea is to use a dependent type in which the length is a building parameter. This leads to structural induction that are slightly more complex and in some cases we will use a proof-term as definition, since the type inference mechanism for pattern-matching is sometimes weaker that the one implemented for elimination tactiques. *) Section BOOLEAN_VECTORS. (** A bit vector is a vector over booleans. Notice that the LEAST significant bit comes first (little-endian representation). We extract the least significant bit (head) and the rest of the vector (tail). We compute bitwise operation on vector: negation, and, or, xor. We compute size-preserving shifts: to the left (towards most significant bits, we hence use Vshiftout) and to the right (towards least significant bits, we use Vshiftin) by inserting a 'carry' bit (logical shift) or by repeating the most significant bit (arithmetical shift). NOTA BENE: all shift operations expect predecessor of size as parameter (they only work on non-empty vectors). *) #[deprecated(since="8.20", note="Consider [list bool] instead. Please open an issue if you would like to keep using Bvector.")] Definition Bvector := Vector.t bool. #[deprecated(since="8.20", note="Consider [list bool] instead. See for details. Please open an issue if you would like to keep using Bvector.")] Definition Bnil := @Vector.nil bool. #[deprecated(since="8.20", note="Consider [list bool] instead. See for details. Please open an issue if you would like to keep using Bvector.")] Definition Bcons := @Vector.cons bool. #[deprecated(since="8.20", note="Consider [list bool] instead. See for details. Please open an issue if you would like to keep using Bvector.")] Definition Bvect_true := Vector.const true. #[deprecated(since="8.20", note="Consider [list bool] instead. See for details. Please open an issue if you would like to keep using Bvector.")] Definition Bvect_false := Vector.const false. #[deprecated(since="8.20", note="Consider [list bool] instead. See for details. Please open an issue if you would like to keep using Bvector.")] Definition Blow := @Vector.hd bool. #[deprecated(since="8.20", note="Consider [list bool] instead. See for details. Please open an issue if you would like to keep using Bvector.")] Definition Bhigh := @Vector.tl bool. #[deprecated(since="8.20", note="Consider [list bool] instead. See for details. Please open an issue if you would like to keep using Bvector.")] Definition Bsign := @Vector.last bool. #[deprecated(since="8.20", note="Consider [list bool] instead. See for details. Please open an issue if you would like to keep using Bvector.")] Definition Bneg := @Vector.map _ _ negb. #[deprecated(since="8.20", note="Consider [list bool] instead. See for details. Please open an issue if you would like to keep using Bvector.")] Definition BVand := @Vector.map2 _ _ _ andb. #[deprecated(since="8.20", note="Consider [list bool] instead. See for details. Please open an issue if you would like to keep using Bvector.")] Definition BVor := @Vector.map2 _ _ _ orb. #[deprecated(since="8.20", note="Consider [list bool] instead. See for details. Please open an issue if you would like to keep using Bvector.")] Definition BVxor := @Vector.map2 _ _ _ xorb. #[deprecated(since="8.20", note="Consider [list bool] instead. See for details. Please open an issue if you would like to keep using Bvector.")] Definition BVeq m n := @Vector.eqb bool eqb m n. #[deprecated(since="8.20", note="Consider [list bool] instead. See for details. Please open an issue if you would like to keep using Bvector.")] Definition BshiftL (n:nat) (bv:Bvector (S n)) (carry:bool) := Bcons carry n (Vector.shiftout bv). #[deprecated(since="8.20", note="Consider [list bool] instead. See for details. Please open an issue if you would like to keep using Bvector.")] Definition BshiftRl (n:nat) (bv:Bvector (S n)) (carry:bool) := Bhigh (S n) (Vector.shiftin carry bv). #[deprecated(since="8.20", note="Consider [list bool] instead. See for details. Please open an issue if you would like to keep using Bvector.")] Definition BshiftRa (n:nat) (bv:Bvector (S n)) := Bhigh (S n) (Vector.shiftrepeat bv). #[deprecated(since="8.20", note="Consider [list bool] instead. See for details. Please open an issue if you would like to keep using Bvector.")] Fixpoint BshiftL_iter (n:nat) (bv:Bvector (S n)) (p:nat) : Bvector (S n) := match p with | O => bv | S p' => BshiftL n (BshiftL_iter n bv p') false end. #[deprecated(since="8.20", note="Consider [list bool] instead. See for details. Please open an issue if you would like to keep using Bvector.")] Fixpoint BshiftRl_iter (n:nat) (bv:Bvector (S n)) (p:nat) : Bvector (S n) := match p with | O => bv | S p' => BshiftRl n (BshiftRl_iter n bv p') false end. #[deprecated(since="8.20", note="Consider [list bool] instead. See for details. Please open an issue if you would like to keep using Bvector.")] Fixpoint BshiftRa_iter (n:nat) (bv:Bvector (S n)) (p:nat) : Bvector (S n) := match p with | O => bv | S p' => BshiftRa n (BshiftRa_iter n bv p') end. End BOOLEAN_VECTORS. Module BvectorNotations. Declare Scope Bvector_scope. Delimit Scope Bvector_scope with Bvector. #[deprecated(since="8.20", note="Consider [list bool] instead. See for details. Please open an issue if you would like to keep using Bvector.")] Notation "^~ x" := (Bneg _ x) (at level 35, right associativity) : Bvector_scope. #[deprecated(since="8.20", note="Consider [list bool] instead. See for details. Please open an issue if you would like to keep using Bvector.")] Infix "^&" := (BVand _) (at level 40, left associativity) : Bvector_scope. #[deprecated(since="8.20", note="Consider [list bool] instead. See for details. Please open an issue if you would like to keep using Bvector.")] Infix "^⊕" := (BVxor _) (at level 45, left associativity) : Bvector_scope. #[deprecated(since="8.20", note="Consider [list bool] instead. See for details. Please open an issue if you would like to keep using Bvector.")] Infix "^|" := (BVor _) (at level 50, left associativity) : Bvector_scope. #[deprecated(since="8.20", note="Consider [list bool] instead. See for details. Please open an issue if you would like to keep using Bvector.")] Infix "=?" := (BVeq _ _) (at level 70, no associativity) : Bvector_scope. Open Scope Bvector_scope. End BvectorNotations. coq-8.20.0/theories/Bool/DecBool.v000066400000000000000000000022361466560755400166230ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* forall x y:C, ifdec H x y = x. Proof. intros A B C H **; case H; auto. intro; absurd B; trivial. Qed. Theorem ifdec_right : forall (A B:Prop) (C:Set) (H:{A} + {B}), ~ A -> forall x y:C, ifdec H x y = y. Proof. intros A B C H **; case H; auto. intro; absurd A; trivial. Qed. Unset Implicit Arguments. coq-8.20.0/theories/Bool/IfProp.v000066400000000000000000000032271466560755400165140ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* Prop := | Iftrue : A -> IfProp A B true | Iffalse : B -> IfProp A B false. #[global] Hint Resolve Iftrue Iffalse: bool. Lemma Iftrue_inv : forall (A B:Prop) (b:bool), IfProp A B b -> b = true -> A. destruct 1; intros; auto with bool. case diff_true_false; auto with bool. Qed. Lemma Iffalse_inv : forall (A B:Prop) (b:bool), IfProp A B b -> b = false -> B. destruct 1; intros; auto with bool. case diff_true_false; trivial with bool. Qed. Lemma IfProp_true : forall A B:Prop, IfProp A B true -> A. intros A B H. inversion H. assumption. Qed. Lemma IfProp_false : forall A B:Prop, IfProp A B false -> B. intros A B H. inversion H. assumption. Qed. Lemma IfProp_or : forall (A B:Prop) (b:bool), IfProp A B b -> A \/ B. destruct 1; auto with bool. Qed. Lemma IfProp_sum : forall (A B:Prop) (b:bool), IfProp A B b -> {A} + {B}. intros A B b; destruct b; intro H. - left; inversion H; auto with bool. - right; inversion H; auto with bool. Qed. coq-8.20.0/theories/Bool/Sumbool.v000066400000000000000000000045101466560755400167310ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* Set), (b = true -> P true) -> (b = false -> P false) -> P b. intros b; destruct b; auto. Defined. Definition bool_eq_ind : forall (b:bool) (P:bool -> Prop), (b = true -> P true) -> (b = false -> P false) -> P b. intros b; destruct b; auto. Defined. (** Logic connectives on type [sumbool] *) Section connectives. Variables A B C D : Prop. Hypothesis H1 : {A} + {B}. Hypothesis H2 : {C} + {D}. Definition sumbool_and : {A /\ C} + {B \/ D}. case H1; case H2; auto. Defined. Definition sumbool_or : {A \/ C} + {B /\ D}. case H1; case H2; auto. Defined. Definition sumbool_not : {B} + {A}. case H1; auto. Defined. End connectives. #[global] Hint Resolve sumbool_and sumbool_or: core. #[global] Hint Immediate sumbool_not : core. (** Any decidability function in type [sumbool] can be turned into a function returning a boolean with the corresponding specification: *) Definition bool_of_sumbool : forall A B:Prop, {A} + {B} -> {b : bool | if b then A else B}. intros A B H. elim H; intro; [exists true | exists false]; assumption. Defined. Arguments bool_of_sumbool : default implicits. coq-8.20.0/theories/Bool/Zerob.v000066400000000000000000000026501466560755400163750ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* true | S _ => false end. Lemma zerob_true_intro (n : nat) : n = 0 -> zerob n = true. Proof. destruct n; [ trivial with bool | inversion 1 ]. Qed. #[global] Hint Resolve zerob_true_intro: bool. Lemma zerob_true_elim (n : nat) : zerob n = true -> n = 0. Proof. destruct n; [ trivial with bool | inversion 1 ]. Qed. Lemma zerob_false_intro (n : nat) : n <> 0 -> zerob n = false. Proof. destruct n; [ destruct 1; auto with bool | trivial with bool ]. Qed. #[global] Hint Resolve zerob_false_intro: bool. Lemma zerob_false_elim (n : nat) : zerob n = false -> n <> 0. Proof. destruct n; [ inversion 1 | auto with bool ]. Qed. coq-8.20.0/theories/Classes/000077500000000000000000000000001466560755400156245ustar00rootroot00000000000000coq-8.20.0/theories/Classes/CEquivalence.v000066400000000000000000000117141466560755400203630ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* substitute H ; clear H x end. Ltac setoid_subst_nofail := match goal with | [ H : ?x === ?y |- _ ] => setoid_subst H ; setoid_subst_nofail | _ => idtac end. (** [subst*] will try its best at substituting every equality in the goal. *) Tactic Notation "subst" "*" := subst_no_fail ; setoid_subst_nofail. (** Simplify the goal w.r.t. equivalence. *) Ltac equiv_simplify_one := match goal with | [ H : ?x === ?x |- _ ] => clear H | [ H : ?x === ?y |- _ ] => setoid_subst H | [ |- ?x =/= ?y ] => let name:=fresh "Hneq" in intro name | [ |- ~ ?x === ?y ] => let name:=fresh "Hneq" in intro name end. Ltac equiv_simplify := repeat equiv_simplify_one. (** "reify" relations which are equivalences to applications of the overloaded [equiv] method for easy recognition in tactics. *) Ltac equivify_tac := match goal with | [ s : Equivalence ?A ?R, H : ?R ?x ?y |- _ ] => change R with (@equiv A R s) in H | [ s : Equivalence ?A ?R |- context C [ ?R ?x ?y ] ] => change (R x y) with (@equiv A R s x y) end. Ltac equivify := repeat equivify_tac. Section Respecting. (** Here we build an equivalence instance for functions which relates respectful ones only, we do not export it. *) Definition respecting `(eqa : Equivalence A (R : crelation A), eqb : Equivalence B (R' : crelation B)) : Type := { morph : A -> B & respectful R R' morph morph }. Program Instance respecting_equiv `(eqa : Equivalence A R, eqb : Equivalence B R') : Equivalence (fun (f g : respecting eqa eqb) => forall (x y : A), R x y -> R' (projT1 f x) (projT1 g y)). Solve Obligations with unfold respecting in * ; simpl_crelation ; program_simpl. Next Obligation. Proof. intros. intros f g h H H' x y Rxy. unfold respecting in *. program_simpl. transitivity (g y); auto. firstorder. Qed. End Respecting. (** The default equivalence on function spaces, with higher-priority than [eq]. *) #[global] Instance pointwise_reflexive {A} `(reflb : Reflexive B eqB) : Reflexive (pointwise_relation A eqB) | 9. Proof. firstorder. Qed. #[global] Instance pointwise_symmetric {A} `(symb : Symmetric B eqB) : Symmetric (pointwise_relation A eqB) | 9. Proof. firstorder. Qed. #[global] Instance pointwise_transitive {A} `(transb : Transitive B eqB) : Transitive (pointwise_relation A eqB) | 9. Proof. firstorder. Qed. #[global] Instance pointwise_equivalence {A} `(eqb : Equivalence B eqB) : Equivalence (pointwise_relation A eqB) | 9. Proof. split; apply _. Qed. coq-8.20.0/theories/Classes/CMorphisms.v000066400000000000000000000565131466560755400201110ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* B) _ _] goal, making proof-search much slower. A cleaner solution would be to be able to set different priorities in different hint bases and select a particular hint database for resolution of a type class constraint. *) Class ProperProxy (R : crelation A) (m : A) := proper_proxy : R m m. Lemma eq_proper_proxy (x : A) : ProperProxy (@eq A) x. Proof. firstorder. Qed. Lemma reflexive_proper_proxy `(Reflexive A R) (x : A) : ProperProxy R x. Proof. firstorder. Qed. Lemma proper_proper_proxy x `(Proper R x) : ProperProxy R x. Proof. firstorder. Qed. (** Respectful morphisms. *) (** The fully dependent version, not used yet. *) Definition respectful_hetero (A B : Type) (C : A -> Type) (D : B -> Type) (R : A -> B -> Type) (R' : forall (x : A) (y : B), C x -> D y -> Type) : (forall x : A, C x) -> (forall x : B, D x) -> Type := fun f g => forall x y, R x y -> R' x y (f x) (g y). (** The non-dependent version is an instance where we forget dependencies. *) Definition respectful {B} (R : crelation A) (R' : crelation B) : crelation (A -> B) := Eval compute in @respectful_hetero A A (fun _ => B) (fun _ => B) R (fun _ _ => R'). End Proper. (** We favor the use of Leibniz equality or a declared reflexive crelation when resolving [ProperProxy], otherwise, if the crelation is given (not an evar), we fall back to [Proper]. *) #[global] Hint Extern 1 (ProperProxy _ _) => class_apply @eq_proper_proxy || class_apply @reflexive_proper_proxy : typeclass_instances. #[global] Hint Extern 2 (ProperProxy ?R _) => not_evar R; class_apply @proper_proper_proxy : typeclass_instances. (** Notations reminiscent of the old syntax for declaring morphisms. *) Declare Scope signatureT_scope. Delimit Scope signatureT_scope with signatureT. Module ProperNotations. Notation " R ++> R' " := (@respectful _ _ (R%signatureT) (R'%signatureT)) (right associativity, at level 55) : signatureT_scope. Notation " R ==> R' " := (@respectful _ _ (R%signatureT) (R'%signatureT)) (right associativity, at level 55) : signatureT_scope. Notation " R --> R' " := (@respectful _ _ (flip (R%signatureT)) (R'%signatureT)) (right associativity, at level 55) : signatureT_scope. End ProperNotations. Arguments Proper {A}%_type R%_signatureT m. Arguments respectful {A B}%_type (R R')%_signatureT _ _. Export ProperNotations. Local Open Scope signatureT_scope. (** [solve_proper] try to solve the goal [Proper (?==> ... ==>?) f] by repeated introductions and setoid rewrites. It should work fine when [f] is a combination of already known morphisms and quantifiers. *) Ltac solve_respectful t := match goal with | |- respectful _ _ _ _ => let H := fresh "H" in intros ? ? H; solve_respectful ltac:(setoid_rewrite H; t) | _ => t; reflexivity end. Ltac solve_proper := unfold Proper; solve_respectful ltac:(idtac). (** [f_equiv] is a clone of [f_equal] that handles setoid equivalences. For example, if we know that [f] is a morphism for [E1==>E2==>E], then the goal [E (f x y) (f x' y')] will be transformed by [f_equiv] into the subgoals [E1 x x'] and [E2 y y']. *) Ltac f_equiv := match goal with | |- ?R (?f ?x) (?f' _) => let T := type of x in let Rx := fresh "R" in evar (Rx : crelation T); let H := fresh in assert (H : (Rx==>R)%signatureT f f'); unfold Rx in *; clear Rx; [ f_equiv | apply H; clear H; try reflexivity ] | |- ?R ?f ?f' => solve [change (Proper R f); eauto with typeclass_instances | reflexivity ] | _ => idtac end. Section Relations. Context {A : Type}. (** [forall_def] reifies the dependent product as a definition. *) Definition forall_def (P : A -> Type) : Type := forall x : A, P x. (** Dependent pointwise lifting of a crelation on the range. *) Definition forall_relation (P : A -> Type) (sig : forall a, crelation (P a)) : crelation (forall x, P x) := fun f g => forall a, sig a (f a) (g a). (** Non-dependent pointwise lifting *) Definition pointwise_relation {B} (R : crelation B) : crelation (A -> B) := fun f g => forall a, R (f a) (g a). Lemma pointwise_pointwise {B} (R : crelation B) : relation_equivalence (pointwise_relation R) (@eq A ==> R). Proof. intros. split. - simpl_crelation. - firstorder. Qed. (** Subcrelations induce a morphism on the identity. *) Global Instance subrelation_id_proper `(subrelation A RA RA') : Proper (RA ==> RA') id. Proof. firstorder. Qed. (** The subrelation property goes through products as usual. *) Lemma subrelation_respectful `(subl : subrelation A RA' RA, subr : subrelation B RB RB') : subrelation (RA ==> RB) (RA' ==> RB'). Proof. simpl_crelation. Qed. (** And of course it is reflexive. *) Lemma subrelation_refl R : @subrelation A R R. Proof. simpl_crelation. Qed. (** [Proper] is itself a covariant morphism for [subrelation]. We use an unconvertible premise to avoid looping. *) Lemma subrelation_proper `(mor : Proper A R' m) `(unc : Unconvertible (crelation A) R R') `(sub : subrelation A R' R) : Proper R m. Proof. intros. apply sub. apply mor. Qed. Global Instance proper_subrelation_proper_arrow : Proper (subrelation ++> eq ==> arrow) (@Proper A). Proof. reduce. subst. firstorder. Qed. Global Instance pointwise_subrelation `(sub : subrelation B R R') : subrelation (pointwise_relation R) (pointwise_relation R') | 4. Proof. reduce. unfold pointwise_relation in *. apply sub. auto. Qed. (** For dependent function types. *) Lemma forall_subrelation (P : A -> Type) (R S : forall x : A, crelation (P x)) : (forall a, subrelation (R a) (S a)) -> subrelation (forall_relation P R) (forall_relation P S). Proof. reduce. firstorder. Qed. End Relations. Global Typeclasses Opaque respectful pointwise_relation forall_relation. Arguments forall_relation {A P}%_type sig%_signatureT _ _. Arguments pointwise_relation A%_type {B}%_type R%_signatureT _ _. #[global] Hint Unfold Reflexive : core. #[global] Hint Unfold Symmetric : core. #[global] Hint Unfold Transitive : core. (** Resolution with subrelation: favor decomposing products over applying reflexivity for unconstrained goals. *) Ltac subrelation_tac T U := (is_ground T ; is_ground U ; class_apply @subrelation_refl) || class_apply @subrelation_respectful || class_apply @subrelation_refl. #[global] Hint Extern 3 (@subrelation _ ?T ?U) => subrelation_tac T U : typeclass_instances. CoInductive apply_subrelation : Prop := do_subrelation. Ltac proper_subrelation := match goal with [ H : apply_subrelation |- _ ] => clear H ; class_apply @subrelation_proper end. #[global] Hint Extern 5 (@Proper _ ?H _) => proper_subrelation : typeclass_instances. (** Essential subrelation instances for [iff], [impl] and [pointwise_relation]. *) #[global] Instance iff_impl_subrelation : subrelation iff impl | 2. Proof. firstorder. Qed. #[global] Instance iff_flip_impl_subrelation : subrelation iff (flip impl) | 2. Proof. firstorder. Qed. (** Essential subrelation instances for [iffT] and [arrow]. *) #[global] Instance iffT_arrow_subrelation : subrelation iffT arrow | 2. Proof. firstorder. Qed. #[global] Instance iffT_flip_arrow_subrelation : subrelation iffT (flip arrow) | 2. Proof. firstorder. Qed. (** We use an extern hint to help unification. *) #[global] Hint Extern 4 (subrelation (@forall_relation ?A ?B ?R) (@forall_relation _ _ ?S)) => apply (@forall_subrelation A B R S) ; intro : typeclass_instances. Section GenericInstances. (* Share universes *) Implicit Types A B C : Type. (** We can build a PER on the Coq function space if we have PERs on the domain and codomain. *) Program Instance respectful_per `(PER A R, PER B R') : PER (R ==> R'). Next Obligation. Proof with auto. intros A R H B R' H0 x y z X X0 x0 y0 X1. assert(R x0 x0). - eapply transitivity with y0... now apply symmetry. - eapply transitivity with (y x0)... Qed. Unset Strict Universe Declaration. (** The complement of a crelation conserves its proper elements. *) (** The [flip] too, actually the [flip] instance is a bit more general. *) Program Definition flip_proper `(mor : Proper (A -> B -> C) (RA ==> RB ==> RC) f) : Proper (RB ==> RA ==> RC) (flip f) := _. Next Obligation. Proof. intros A B C RA RB RC f mor x y X x0 y0 X0. apply mor ; auto. Qed. (** Every Transitive crelation gives rise to a binary morphism on [impl], contravariant in the first argument, covariant in the second. *) Global Program Instance trans_contra_co_type_morphism `(Transitive A R) : Proper (R --> R ++> arrow) R. Next Obligation. Proof with auto. intros A R H x y X x0 y0 X0 X1. apply transitivity with x... apply transitivity with x0... Qed. (** Proper declarations for partial applications. *) Global Program Instance trans_contra_inv_impl_type_morphism `(Transitive A R) {x} : Proper (R --> flip arrow) (R x) | 3. Next Obligation. Proof with auto. intros A R H x x0 y X X0. apply transitivity with y... Qed. Global Program Instance trans_co_impl_type_morphism `(Transitive A R) {x} : Proper (R ++> arrow) (R x) | 3. Next Obligation. Proof with auto. intros A R H x x0 y X X0. apply transitivity with x0... Qed. Global Program Instance trans_sym_co_inv_impl_type_morphism `(PER A R) {x} : Proper (R ++> flip arrow) (R x) | 3. Next Obligation. Proof with auto. intros A R H x x0 y X X0. apply transitivity with y... apply symmetry... Qed. Global Program Instance trans_sym_contra_arrow_morphism `(PER A R) {x} : Proper (R --> arrow) (R x) | 3. Next Obligation. Proof with auto. intros A R H x x0 y X X0. apply transitivity with x0... apply symmetry... Qed. Global Program Instance per_partial_app_type_morphism `(PER A R) {x} : Proper (R ==> iffT) (R x) | 2. Next Obligation. Proof with auto. intros A R H x x0 y X. split. - intros ; apply transitivity with x0... - intros. apply transitivity with y... apply symmetry... Qed. (** Every Transitive crelation induces a morphism by "pushing" an [R x y] on the left of an [R x z] proof to get an [R y z] goal. *) Global Program Instance trans_co_eq_inv_arrow_morphism `(Transitive A R) : Proper (R ==> (@eq A) ==> flip arrow) R | 2. Next Obligation. Proof with auto. intros A R H x y X y0 y1 e X0; destruct e. apply transitivity with y... Qed. (** Every Symmetric and Transitive crelation gives rise to an equivariant morphism. *) Global Program Instance PER_type_morphism `(PER A R) : Proper (R ==> R ==> iffT) R | 1. Next Obligation. Proof with auto. intros A R H x y X x0 y0 X0. split ; intros. - apply transitivity with x0... apply transitivity with x... apply symmetry... - apply transitivity with y... apply transitivity with y0... apply symmetry... Qed. Lemma symmetric_equiv_flip `(Symmetric A R) : relation_equivalence R (flip R). Proof. firstorder. Qed. Global Program Instance compose_proper A B C RA RB RC : Proper ((RB ==> RC) ==> (RA ==> RB) ==> (RA ==> RC)) (@compose A B C). Next Obligation. Proof. simpl_crelation. unfold compose. firstorder. Qed. (** Coq functions are morphisms for Leibniz equality, applied only if really needed. *) Global Instance reflexive_eq_dom_reflexive `(Reflexive B R') {A} : Reflexive (@Logic.eq A ==> R'). Proof. simpl_crelation. Qed. (** [respectful] is a morphism for crelation equivalence . *) Global Instance respectful_morphism {A B} : Proper (relation_equivalence ++> relation_equivalence ++> relation_equivalence) (@respectful A B). Proof. intros R R' HRR' S S' HSS' f g. unfold respectful , relation_equivalence in *; simpl in *. split ; intros H x y Hxy. - apply (fst (HSS' _ _)). apply H. now apply (snd (HRR' _ _)). - apply (snd (HSS' _ _)). apply H. now apply (fst (HRR' _ _)). Qed. (** [R] is Reflexive, hence we can build the needed proof. *) Lemma Reflexive_partial_app_morphism `(Proper (A -> B) (R ==> R') m, ProperProxy A R x) : Proper R' (m x). Proof. simpl_crelation. Qed. Class Params {A} (of : A) (arity : nat). Lemma flip_respectful {A B} (R : crelation A) (R' : crelation B) : relation_equivalence (flip (R ==> R')) (flip R ==> flip R'). Proof. intros. unfold flip, respectful. split ; intros ; intuition. Qed. (** Treating flip: can't make them direct instances as we need at least a [flip] present in the goal. *) Lemma flip1 `(subrelation A R' R) : subrelation (flip (flip R')) R. Proof. firstorder. Qed. Lemma flip2 `(subrelation A R R') : subrelation R (flip (flip R')). Proof. firstorder. Qed. (** That's if and only if *) Lemma eq_subrelation `(Reflexive A R) : subrelation (@eq A) R. Proof. simpl_crelation. Qed. (** Once we have normalized, we will apply this instance to simplify the problem. *) Definition proper_flip_proper `(mor : Proper A R m) : Proper (flip R) m := mor. (** Every reflexive crelation gives rise to a morphism, only for immediately solving goals without variables. *) Lemma reflexive_proper `{Reflexive A R} (x : A) : Proper R x. Proof. firstorder. Qed. Lemma proper_eq {A} (x : A) : Proper (@eq A) x. Proof. intros. apply reflexive_proper. Qed. End GenericInstances. Class PartialApplication. CoInductive normalization_done : Prop := did_normalization. Ltac partial_application_tactic := let rec do_partial_apps H m cont := match m with | ?m' ?x => class_apply @Reflexive_partial_app_morphism ; [(do_partial_apps H m' ltac:(idtac))|clear H] | _ => cont end in let rec do_partial H ar m := match ar with | 0%nat => do_partial_apps H m ltac:(fail 1) | S ?n' => match m with ?m' ?x => do_partial H n' m' end end in let params m sk fk := (let m' := fresh in head_of_constr m' m ; let n := fresh in evar (n:nat) ; let v := eval compute in n in clear n ; let H := fresh in assert(H:Params m' v) by typeclasses eauto ; let v' := eval compute in v in subst m'; (sk H v' || fail 1)) || fk in let on_morphism m cont := params m ltac:(fun H n => do_partial H n m) ltac:(cont) in match goal with | [ _ : normalization_done |- _ ] => fail 1 | [ _ : @Params _ _ _ |- _ ] => fail 1 | [ |- @Proper ?T _ (?m ?x) ] => match goal with | [ H : PartialApplication |- _ ] => class_apply @Reflexive_partial_app_morphism; [|clear H] | _ => on_morphism (m x) ltac:(class_apply @Reflexive_partial_app_morphism) end end. (** Bootstrap !!! *) #[global] Instance proper_proper {A} : Proper (relation_equivalence ==> eq ==> iffT) (@Proper A). Proof. intros R R' HRR' x y <-. red in HRR'. split ; red ; intros. - now apply (fst (HRR' _ _)). - now apply (snd (HRR' _ _)). Qed. Ltac proper_reflexive := match goal with | [ _ : normalization_done |- _ ] => fail 1 | _ => class_apply proper_eq || class_apply @reflexive_proper end. #[global] Hint Extern 1 (subrelation (flip _) _) => class_apply @flip1 : typeclass_instances. #[global] Hint Extern 1 (subrelation _ (flip _)) => class_apply @flip2 : typeclass_instances. (* Hint Extern 1 (Proper _ (complement _)) => apply @complement_proper *) (* : typeclass_instances. *) #[global] Hint Extern 1 (Proper _ (flip _)) => apply @flip_proper : typeclass_instances. #[global] Hint Extern 2 (@Proper _ (flip _) _) => class_apply @proper_flip_proper : typeclass_instances. #[global] Hint Extern 4 (@Proper _ _ _) => partial_application_tactic : typeclass_instances. #[global] Hint Extern 7 (@Proper _ _ _) => proper_reflexive : typeclass_instances. (** Special-purpose class to do normalization of signatures w.r.t. flip. *) Section Normalize. Context (A : Type). Class Normalizes (m : crelation A) (m' : crelation A) := normalizes : relation_equivalence m m'. (** Current strategy: add [flip] everywhere and reduce using [subrelation] afterwards. *) Lemma proper_normalizes_proper `(Normalizes R0 R1, Proper A R1 m) : Proper R0 m. Proof. apply (_ : Normalizes R0 R1). assumption. Qed. Lemma flip_atom R : Normalizes R (flip (flip R)). Proof. firstorder. Qed. End Normalize. Lemma flip_arrow `(NA : Normalizes A R (flip R'''), NB : Normalizes B R' (flip R'')) : Normalizes (A -> B) (R ==> R') (flip (R''' ==> R'')%signatureT). Proof. unfold Normalizes in *. intros. eapply transitivity; [|eapply symmetry, flip_respectful]. now apply respectful_morphism. Qed. Ltac normalizes := match goal with | [ |- Normalizes _ (respectful _ _) _ ] => class_apply @flip_arrow | _ => class_apply @flip_atom end. Ltac proper_normalization := match goal with | [ _ : normalization_done |- _ ] => fail 1 | [ _ : apply_subrelation |- @Proper _ ?R _ ] => let H := fresh "H" in set(H:=did_normalization) ; class_apply @proper_normalizes_proper end. #[global] Hint Extern 1 (Normalizes _ _ _) => normalizes : typeclass_instances. #[global] Hint Extern 6 (@Proper _ _ _) => proper_normalization : typeclass_instances. (** When the crelation on the domain is symmetric, we can flip the crelation on the codomain. Same for binary functions. *) Lemma proper_sym_flip : forall `(Symmetric A R1)`(Proper (A->B) (R1==>R2) f), Proper (R1==>flip R2) f. Proof. intros A R1 Sym B R2 f Hf. intros x x' Hxx'. apply Hf, Sym, Hxx'. Qed. Lemma proper_sym_flip_2 : forall `(Symmetric A R1)`(Symmetric B R2)`(Proper (A->B->C) (R1==>R2==>R3) f), Proper (R1==>R2==>flip R3) f. Proof. intros A R1 Sym1 B R2 Sym2 C R3 f Hf. intros x x' Hxx' y y' Hyy'. apply Hf; auto. Qed. (** When the crelation on the domain is symmetric, a predicate is compatible with [iff] as soon as it is compatible with [impl]. Same with a binary crelation. *) Lemma proper_sym_impl_iff : forall `(Symmetric A R)`(Proper _ (R==>impl) f), Proper (R==>iff) f. Proof. intros A R Sym f Hf x x' Hxx'. repeat red in Hf. split; eauto. Qed. Lemma proper_sym_arrow_iffT : forall `(Symmetric A R)`(Proper _ (R==>arrow) f), Proper (R==>iffT) f. Proof. intros A R Sym f Hf x x' Hxx'. repeat red in Hf. split; eauto. Qed. Lemma proper_sym_impl_iff_2 : forall `(Symmetric A R)`(Symmetric B R')`(Proper _ (R==>R'==>impl) f), Proper (R==>R'==>iff) f. Proof. intros A R Sym B R' Sym' f Hf x x' Hxx' y y' Hyy'. repeat red in Hf. split; eauto. Qed. Lemma proper_sym_arrow_iffT_2 : forall `(Symmetric A R)`(Symmetric B R')`(Proper _ (R==>R'==>arrow) f), Proper (R==>R'==>iffT) f. Proof. intros A R Sym B R' Sym' f Hf x x' Hxx' y y' Hyy'. repeat red in Hf. split; eauto. Qed. (** A [PartialOrder] is compatible with its underlying equivalence. *) Require Import Relation_Definitions. #[global] Instance PartialOrder_proper_type `(PartialOrder A eqA R) : Proper (eqA==>eqA==>iffT) R. Proof. intros. apply proper_sym_arrow_iffT_2. 1-2: typeclasses eauto. intros x x' Hx y y' Hy Hr. apply transitivity with x. - generalize (partial_order_equivalence x x'); compute; intuition. - apply transitivity with y; auto. generalize (partial_order_equivalence y y'); compute; intuition. Qed. (** From a [PartialOrder] to the corresponding [StrictOrder]: [lt = le /\ ~eq]. If the order is total, we could also say [gt = ~le]. *) Lemma PartialOrder_StrictOrder `(PartialOrder A eqA R) : StrictOrder (relation_conjunction R (complement eqA)). Proof. split; compute. - intros x (_,Hx). apply Hx, Equivalence_Reflexive. - intros x y z (Hxy,Hxy') (Hyz,Hyz'). split. + apply PreOrder_Transitive with y; assumption. + intro Hxz. apply Hxy'. apply partial_order_antisym; auto. apply transitivity with z; [assumption|]. now apply H. Qed. (** From a [StrictOrder] to the corresponding [PartialOrder]: [le = lt \/ eq]. If the order is total, we could also say [ge = ~lt]. *) Lemma StrictOrder_PreOrder `(Equivalence A eqA, StrictOrder A R, Proper _ (eqA==>eqA==>iffT) R) : PreOrder (relation_disjunction R eqA). Proof. split. - intros x. right. apply reflexivity. - intros x y z [Hxy|Hxy] [Hyz|Hyz]. + left. apply transitivity with y; auto. + left. eapply H1; try eassumption. apply reflexivity. now apply symmetry. + left. eapply H1; [eassumption|apply reflexivity|eassumption]. + right. apply transitivity with y; auto. Qed. #[global] Hint Extern 4 (PreOrder (relation_disjunction _ _)) => class_apply StrictOrder_PreOrder : typeclass_instances. Lemma StrictOrder_PartialOrder `(Equivalence A eqA, StrictOrder A R, Proper _ (eqA==>eqA==>iffT) R) : PartialOrder eqA (relation_disjunction R eqA). Proof. intros. intros x y. compute. intuition auto. - right; now apply symmetry. - elim (StrictOrder_Irreflexive x). eapply transitivity with y; eauto. - now apply symmetry. Qed. #[global] Hint Extern 4 (StrictOrder (relation_conjunction _ _)) => class_apply PartialOrder_StrictOrder : typeclass_instances. #[global] Hint Extern 4 (PartialOrder _ (relation_disjunction _ _)) => class_apply StrictOrder_PartialOrder : typeclass_instances. (* Register bindings for the generalized rewriting tactic *) Register forall_relation as rewrite.type.forall_relation. Register pointwise_relation as rewrite.type.pointwise_relation. Register respectful as rewrite.type.respectful. Register forall_def as rewrite.type.forall_def. Register do_subrelation as rewrite.type.do_subrelation. Register apply_subrelation as rewrite.type.apply_subrelation. Register Proper as rewrite.type.Proper. Register ProperProxy as rewrite.type.ProperProxy. coq-8.20.0/theories/Classes/CRelationClasses.v000066400000000000000000000324301466560755400212130ustar00rootroot00000000000000(* -*- coding: utf-8 -*- *) (************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* A -> Type. Definition arrow (A B : Type) := A -> B. Definition flip {A B C : Type} (f : A -> B -> C) := fun x y => f y x. Definition iffT (A B : Type) := ((A -> B) * (B -> A))%type. Global Typeclasses Opaque flip arrow iffT. (** We allow to unfold the [crelation] definition while doing morphism search. *) Section Defs. Context {A : Type}. (** We rebind crelational properties in separate classes to be able to overload each proof. *) Class Reflexive (R : crelation A) := reflexivity : forall x : A, R x x. Definition complement (R : crelation A) : crelation A := fun x y => R x y -> False. (** Opaque for proof-search. *) Typeclasses Opaque complement iffT. (** These are convertible. *) Lemma complement_inverse R : complement (flip R) = flip (complement R). Proof. reflexivity. Qed. Class Irreflexive (R : crelation A) := irreflexivity : Reflexive (complement R). Class Symmetric (R : crelation A) := symmetry : forall {x y}, R x y -> R y x. Class Asymmetric (R : crelation A) := asymmetry : forall {x y}, R x y -> (complement R y x : Type). Class Transitive (R : crelation A) := transitivity : forall {x y z}, R x y -> R y z -> R x z. (** Various combinations of reflexivity, symmetry and transitivity. *) (** A [PreOrder] is both Reflexive and Transitive. *) Class PreOrder (R : crelation A) := { #[global] PreOrder_Reflexive :: Reflexive R | 2 ; #[global] PreOrder_Transitive :: Transitive R | 2 }. (** A [StrictOrder] is both Irreflexive and Transitive. *) Class StrictOrder (R : crelation A) := { #[global] StrictOrder_Irreflexive :: Irreflexive R ; #[global] StrictOrder_Transitive :: Transitive R }. (** By definition, a strict order is also asymmetric *) Global Instance StrictOrder_Asymmetric `(StrictOrder R) : Asymmetric R. Proof. firstorder. Qed. (** A partial equivalence crelation is Symmetric and Transitive. *) Class PER (R : crelation A) := { #[global] PER_Symmetric :: Symmetric R | 3 ; #[global] PER_Transitive :: Transitive R | 3 }. (** Equivalence crelations. *) Class Equivalence (R : crelation A) := { #[global] Equivalence_Reflexive :: Reflexive R ; #[global] Equivalence_Symmetric :: Symmetric R ; #[global] Equivalence_Transitive :: Transitive R }. (** An Equivalence is a PER plus reflexivity. *) Global Instance Equivalence_PER {R} `(Equivalence R) : PER R | 10 := { PER_Symmetric := Equivalence_Symmetric ; PER_Transitive := Equivalence_Transitive }. (** We can now define antisymmetry w.r.t. an equivalence crelation on the carrier. *) Class Antisymmetric eqA `{equ : Equivalence eqA} (R : crelation A) := antisymmetry : forall {x y}, R x y -> R y x -> eqA x y. Class subrelation (R R' : crelation A) := is_subrelation : forall {x y}, R x y -> R' x y. (** Any symmetric crelation is equal to its inverse. *) Lemma subrelation_symmetric R `(Symmetric R) : subrelation (flip R) R. Proof. hnf. intros x y H'. red in H'. apply symmetry. assumption. Qed. Section flip. Lemma flip_Reflexive `{Reflexive R} : Reflexive (flip R). Proof. tauto. Qed. Program Definition flip_Irreflexive `(Irreflexive R) : Irreflexive (flip R) := irreflexivity (R:=R). Program Definition flip_Symmetric `(Symmetric R) : Symmetric (flip R) := fun x y H => symmetry (R:=R) H. Program Definition flip_Asymmetric `(Asymmetric R) : Asymmetric (flip R) := fun x y H H' => asymmetry (R:=R) H H'. Program Definition flip_Transitive `(Transitive R) : Transitive (flip R) := fun x y z H H' => transitivity (R:=R) H' H. Program Definition flip_Antisymmetric `(Antisymmetric eqA R) : Antisymmetric eqA (flip R). Proof. firstorder. Qed. (** Inversing the larger structures *) Lemma flip_PreOrder `(PreOrder R) : PreOrder (flip R). Proof. firstorder. Qed. Lemma flip_StrictOrder `(StrictOrder R) : StrictOrder (flip R). Proof. firstorder. Qed. Lemma flip_PER `(PER R) : PER (flip R). Proof. firstorder. Qed. Lemma flip_Equivalence `(Equivalence R) : Equivalence (flip R). Proof. firstorder. Qed. End flip. Section complement. Definition complement_Irreflexive `(Reflexive R) : Irreflexive (complement R). Proof. firstorder. Qed. Definition complement_Symmetric `(Symmetric R) : Symmetric (complement R). Proof. firstorder. Qed. End complement. (** Rewrite crelation on a given support: declares a crelation as a rewrite crelation for use by the generalized rewriting tactic. It helps choosing if a rewrite should be handled by the generalized or the regular rewriting tactic using leibniz equality. Users can declare an [RewriteRelation A RA] anywhere to declare default crelations. This is also done automatically by the [Declare Relation A RA] commands. *) Class RewriteRelation (RA : crelation A). (** Any [Equivalence] declared in the context is automatically considered a rewrite crelation. *) Global Instance equivalence_rewrite_crelation `(Equivalence eqA) : RewriteRelation eqA. Defined. (** Leibniz equality. *) Section Leibniz. Global Instance eq_Reflexive : Reflexive (@eq A) := @eq_refl A. Global Instance eq_Symmetric : Symmetric (@eq A) := @eq_sym A. Global Instance eq_Transitive : Transitive (@eq A) := @eq_trans A. (** Leibinz equality [eq] is an equivalence crelation. The instance has low priority as it is always applicable if only the type is constrained. *) Global Program Instance eq_equivalence : Equivalence (@eq A) | 10. End Leibniz. End Defs. (** Default rewrite crelations handled by [setoid_rewrite]. *) #[global] Instance: RewriteRelation impl. Defined. #[global] Instance: RewriteRelation iff. Defined. (** Hints to drive the typeclass resolution avoiding loops due to the use of full unification. *) #[global] Hint Extern 1 (Reflexive (complement _)) => class_apply @irreflexivity : typeclass_instances. #[global] Hint Extern 3 (Symmetric (complement _)) => class_apply complement_Symmetric : typeclass_instances. #[global] Hint Extern 3 (Irreflexive (complement _)) => class_apply complement_Irreflexive : typeclass_instances. #[global] Hint Extern 3 (Reflexive (flip _)) => apply flip_Reflexive : typeclass_instances. #[global] Hint Extern 3 (Irreflexive (flip _)) => class_apply flip_Irreflexive : typeclass_instances. #[global] Hint Extern 3 (Symmetric (flip _)) => class_apply flip_Symmetric : typeclass_instances. #[global] Hint Extern 3 (Asymmetric (flip _)) => class_apply flip_Asymmetric : typeclass_instances. #[global] Hint Extern 3 (Antisymmetric (flip _)) => class_apply flip_Antisymmetric : typeclass_instances. #[global] Hint Extern 3 (Transitive (flip _)) => class_apply flip_Transitive : typeclass_instances. #[global] Hint Extern 3 (StrictOrder (flip _)) => class_apply flip_StrictOrder : typeclass_instances. #[global] Hint Extern 3 (PreOrder (flip _)) => class_apply flip_PreOrder : typeclass_instances. #[global] Hint Extern 4 (subrelation (flip _) _) => class_apply @subrelation_symmetric : typeclass_instances. #[global] Hint Resolve irreflexivity : ord. Unset Implicit Arguments. Ltac solve_crelation := match goal with | [ |- ?R ?x ?x ] => reflexivity | [ H : ?R ?x ?y |- ?R ?y ?x ] => symmetry ; exact H end. #[global] Hint Extern 4 => solve_crelation : crelations. (** We can already dualize all these properties. *) (** * Standard instances. *) Ltac reduce_hyp H := match type of H with | context [ _ <-> _ ] => fail 1 | _ => red in H ; try reduce_hyp H end. Ltac reduce_goal := match goal with | [ |- _ <-> _ ] => fail 1 | _ => red ; intros ; try reduce_goal end. Tactic Notation "reduce" "in" hyp(Hid) := reduce_hyp Hid. Ltac reduce := reduce_goal. Tactic Notation "apply" "*" constr(t) := first [ refine t | refine (t _) | refine (t _ _) | refine (t _ _ _) | refine (t _ _ _ _) | refine (t _ _ _ _ _) | refine (t _ _ _ _ _ _) | refine (t _ _ _ _ _ _ _) ]. Ltac simpl_crelation := unfold flip, impl, arrow ; try reduce ; program_simpl ; try ( solve [ dintuition auto with crelations ]). Local Obligation Tactic := simpl_crelation. (** Logical implication. *) #[global] Program Instance impl_Reflexive : Reflexive impl. #[global] Program Instance impl_Transitive : Transitive impl. (** Logical equivalence. *) #[global] Instance iff_Reflexive : Reflexive iff := iff_refl. #[global] Instance iff_Symmetric : Symmetric iff := iff_sym. #[global] Instance iff_Transitive : Transitive iff := iff_trans. (** Logical equivalence [iff] is an equivalence crelation. *) #[global] Program Instance iff_equivalence : Equivalence iff. #[global] Program Instance arrow_Reflexive : Reflexive arrow. #[global] Program Instance arrow_Transitive : Transitive arrow. #[global] Instance iffT_Reflexive : Reflexive iffT. Proof. firstorder. Defined. #[global] Instance iffT_Symmetric : Symmetric iffT. Proof. firstorder. Defined. #[global] Instance iffT_Transitive : Transitive iffT. Proof. firstorder. Defined. (** We now develop a generalization of results on crelations for arbitrary predicates. The resulting theory can be applied to homogeneous binary crelations but also to arbitrary n-ary predicates. *) Local Open Scope list_scope. (** A compact representation of non-dependent arities, with the codomain singled-out. *) (** We define the various operations which define the algebra on binary crelations *) Section Binary. Context {A : Type}. Definition relation_equivalence : crelation (crelation A) := fun R R' => forall x y, iffT (R x y) (R' x y). Global Instance: RewriteRelation relation_equivalence. Defined. Definition relation_conjunction (R : crelation A) (R' : crelation A) : crelation A := fun x y => prod (R x y) (R' x y). Definition relation_disjunction (R : crelation A) (R' : crelation A) : crelation A := fun x y => sum (R x y) (R' x y). (** Relation equivalence is an equivalence, and subrelation defines a partial order. *) Global Instance relation_equivalence_equivalence : Equivalence relation_equivalence. Proof. split; red; unfold relation_equivalence, iffT. - firstorder. - firstorder. - intros x y z X X0 x0 y0. specialize (X x0 y0). specialize (X0 x0 y0). firstorder. Qed. Global Instance relation_implication_preorder : PreOrder (@subrelation A). Proof. firstorder. Qed. (** *** Partial Order. A partial order is a preorder which is additionally antisymmetric. We give an equivalent definition, up-to an equivalence crelation on the carrier. *) Class PartialOrder eqA `{equ : Equivalence A eqA} R `{preo : PreOrder A R} := partial_order_equivalence : relation_equivalence eqA (relation_conjunction R (flip R)). (** The equivalence proof is sufficient for proving that [R] must be a morphism for equivalence (see Morphisms). It is also sufficient to show that [R] is antisymmetric w.r.t. [eqA] *) Global Instance partial_order_antisym `(PartialOrder eqA R) : Antisymmetric eqA R. Proof with auto. reduce_goal. firstorder. Qed. Lemma PartialOrder_inverse `(PartialOrder eqA R) : PartialOrder eqA (flip R). Proof. firstorder. Qed. End Binary. #[global] Hint Extern 3 (PartialOrder (flip _)) => class_apply PartialOrder_inverse : typeclass_instances. (** The partial order defined by subrelation and crelation equivalence. *) (* Program Instance subrelation_partial_order : *) (* ! PartialOrder (crelation A) relation_equivalence subrelation. *) (* Obligation Tactic := idtac. *) (* Next Obligation. *) (* Proof. *) (* intros x. refine (fun x => x). *) (* Qed. *) Global Typeclasses Opaque relation_equivalence. (* Register bindings for the generalized rewriting tactic *) Register arrow as rewrite.type.arrow. Register flip as rewrite.type.flip. Register crelation as rewrite.type.relation. Register subrelation as rewrite.type.subrelation. Register Reflexive as rewrite.type.Reflexive. Register reflexivity as rewrite.type.reflexivity. Register Symmetric as rewrite.type.Symmetric. Register symmetry as rewrite.type.symmetry. Register Transitive as rewrite.type.Transitive. Register transitivity as rewrite.type.transitivity. Register RewriteRelation as rewrite.type.RewriteRelation. coq-8.20.0/theories/Classes/DecidableClass.v000066400000000000000000000045541466560755400206450ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* P }. (** Alternative ways of specifying the reflection property. *) Lemma Decidable_sound : forall P (H : Decidable P), Decidable_witness = true -> P. Proof. intros P H Hp; apply -> Decidable_spec; assumption. Qed. Lemma Decidable_complete : forall P (H : Decidable P), P -> Decidable_witness = true. Proof. intros P H Hp; apply <- Decidable_spec; assumption. Qed. Lemma Decidable_sound_alt : forall P (H : Decidable P), ~ P -> Decidable_witness = false. Proof. intros P [wit spec] Hd; simpl; destruct wit; tauto. Qed. Lemma Decidable_complete_alt : forall P (H : Decidable P), Decidable_witness = false -> ~ P. Proof. intros P [wit spec] Hd Hc; simpl in *; intuition congruence. Qed. (** The generic function that should be used to program, together with some useful tactics. *) Definition decide P {H : Decidable P} := @Decidable_witness _ H. Ltac _decide_ P H := let b := fresh "b" in set (b := decide P) in *; assert (H : decide P = b) by reflexivity; clearbody b; destruct b; [apply Decidable_sound in H|apply Decidable_complete_alt in H]. Tactic Notation "decide" constr(P) "as" ident(H) := _decide_ P H. Tactic Notation "decide" constr(P) := let H := fresh "H" in _decide_ P H. (** Some usual instances. *) #[global,refine] Instance Decidable_not {P} `{Decidable P} : Decidable (~ P) := { Decidable_witness := negb Decidable_witness }. Proof. abstract (specialize Decidable_spec; case Decidable_witness; intuition discriminate). Defined. coq-8.20.0/theories/Classes/EquivDec.v000066400000000000000000000113441466560755400175230ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* @right _ _ H | right H => @left _ _ H end. Local Open Scope program_scope. (** Invert the branches. *) Program Definition nequiv_dec `{EqDec A} (x y : A) : { x =/= y } + { x === y } := swap_sumbool (x == y). (** Overloaded notation for inequality. *) Infix "<>" := nequiv_dec (no associativity, at level 70) : equiv_scope. (** Define boolean versions, losing the logical information. *) Definition equiv_decb `{EqDec A} (x y : A) : bool := if x == y then true else false. Definition nequiv_decb `{EqDec A} (x y : A) : bool := negb (equiv_decb x y). Infix "==b" := equiv_decb (no associativity, at level 70). Infix "<>b" := nequiv_decb (no associativity, at level 70). (** Decidable leibniz equality instances. *) (** The equiv is buried inside the setoid, but we can recover it by specifying which setoid we're talking about. *) #[global] Program Instance nat_eq_eqdec : EqDec nat eq := eq_nat_dec. #[global] Program Instance bool_eqdec : EqDec bool eq := bool_dec. #[global] Program Instance unit_eqdec : EqDec unit eq := fun x y => in_left. Next Obligation. Proof. do 2 match goal with [ x : () |- _ ] => destruct x end. reflexivity. Qed. #[global] Obligation Tactic := unfold complement, equiv ; program_simpl. #[export] Obligation Tactic := unfold complement, equiv ; program_simpl. #[global] Program Instance prod_eqdec `(EqDec A eq, EqDec B eq) : EqDec (prod A B) eq := { equiv_dec x y := let '(x1, x2) := x in let '(y1, y2) := y in if x1 == y1 then if x2 == y2 then in_left else in_right else in_right }. #[global] Program Instance sum_eqdec `(EqDec A eq, EqDec B eq) : EqDec (sum A B) eq := { equiv_dec x y := match x, y with | inl a, inl b => if a == b then in_left else in_right | inr a, inr b => if a == b then in_left else in_right | inl _, inr _ | inr _, inl _ => in_right end }. (** Objects of function spaces with countable domains like bool have decidable equality. Proving the reflection requires functional extensionality though. *) #[global] Program Instance bool_function_eqdec `(EqDec A eq) : EqDec (bool -> A) eq := { equiv_dec f g := if f true == g true then if f false == g false then in_left else in_right else in_right }. Next Obligation. Proof. extensionality x. destruct x ; auto. Qed. Require Import List. #[global] Program Instance list_eqdec `(eqa : EqDec A eq) : EqDec (list A) eq := { equiv_dec := fix aux (x y : list A) := match x, y with | nil, nil => in_left | cons hd tl, cons hd' tl' => if hd == hd' then if aux tl tl' then in_left else in_right else in_right | _, _ => in_right end }. Next Obligation. match goal with y : list _ |- _ => destruct y end ; unfold not in *; eauto. Defined. Solve Obligations with unfold equiv, complement in * ; program_simpl ; intuition (discriminate || eauto). coq-8.20.0/theories/Classes/Equivalence.v000066400000000000000000000117251466560755400202620ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* substitute H ; clear H x end. Ltac setoid_subst_nofail := match goal with | [ H : ?x === ?y |- _ ] => setoid_subst H ; setoid_subst_nofail | _ => idtac end. (** [subst*] will try its best at substituting every equality in the goal. *) Tactic Notation "subst" "*" := subst_no_fail ; setoid_subst_nofail. (** Simplify the goal w.r.t. equivalence. *) Ltac equiv_simplify_one := match goal with | [ H : ?x === ?x |- _ ] => clear H | [ H : ?x === ?y |- _ ] => setoid_subst H | [ |- ?x =/= ?y ] => let name:=fresh "Hneq" in intro name | [ |- ~ ?x === ?y ] => let name:=fresh "Hneq" in intro name end. Ltac equiv_simplify := repeat equiv_simplify_one. (** "reify" relations which are equivalences to applications of the overloaded [equiv] method for easy recognition in tactics. *) Ltac equivify_tac := match goal with | [ s : Equivalence ?A ?R, H : ?R ?x ?y |- _ ] => change R with (@equiv A R s) in H | [ s : Equivalence ?A ?R |- context C [ ?R ?x ?y ] ] => change (R x y) with (@equiv A R s x y) end. Ltac equivify := repeat equivify_tac. Section Respecting. (** Here we build an equivalence instance for functions which relates respectful ones only, we do not export it. *) Definition respecting `(eqa : Equivalence A (R : relation A), eqb : Equivalence B (R' : relation B)) : Type := { morph : A -> B | respectful R R' morph morph }. Program Instance respecting_equiv `(eqa : Equivalence A R, eqb : Equivalence B R') : Equivalence (fun (f g : respecting eqa eqb) => forall (x y : A), R x y -> R' (proj1_sig f x) (proj1_sig g y)). Solve Obligations with unfold respecting in * ; simpl_relation ; program_simpl. Next Obligation. Proof. intros. intros f g h H H' x y Rxy. unfold respecting in *. program_simpl. transitivity (g y); auto. firstorder. Qed. End Respecting. (** The default equivalence on function spaces, with higher priority than [eq]. *) #[global] Instance pointwise_reflexive {A} `(reflb : Reflexive B eqB) : Reflexive (pointwise_relation A eqB) | 9. Proof. firstorder. Qed. #[global] Instance pointwise_symmetric {A} `(symb : Symmetric B eqB) : Symmetric (pointwise_relation A eqB) | 9. Proof. firstorder. Qed. #[global] Instance pointwise_transitive {A} `(transb : Transitive B eqB) : Transitive (pointwise_relation A eqB) | 9. Proof. firstorder. Qed. #[global] Instance pointwise_equivalence {A} `(eqb : Equivalence B eqB) : Equivalence (pointwise_relation A eqB) | 9. Proof. split; apply _. Qed. coq-8.20.0/theories/Classes/Init.v000066400000000000000000000031501466560755400167150ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* unify x y with typeclass_instances ; fail 1 "Convertible" | |- _ => exact tt end. #[global] Hint Extern 0 (@Unconvertible _ _ _) => unconvertible : typeclass_instances. coq-8.20.0/theories/Classes/Morphisms.v000066400000000000000000000630061466560755400200010ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* B) _ _] goal, making proof-search much slower. A cleaner solution would be to be able to set different priorities in different hint bases and select a particular hint database for resolution of a type class constraint. *) Class ProperProxy (R : relation A) (m : A) : Prop := proper_proxy : R m m. Class ReflexiveProxy (R : relation A) : Prop := reflexive_proxy : forall x, R x x. Lemma eq_proper_proxy (x : A) : ProperProxy (@eq A) x. Proof. firstorder. Qed. (** Every reflexive relation gives rise to a morphism. If the relation is not determined (is an evar), then we restrict the solutions to predefined ones (equality, or iff on Prop), using ground instances. If the relation is determined then [ReflexiveProxy] calls back to [Reflexive]. *) Lemma reflexive_proper `{ReflexiveProxy R} (x : A) : Proper R x. Proof. firstorder. Qed. Lemma reflexive_proper_proxy `(ReflexiveProxy R) (x : A) : ProperProxy R x. Proof. firstorder. Qed. Lemma proper_proper_proxy x `(Proper R x) : ProperProxy R x. Proof. firstorder. Qed. Lemma reflexive_reflexive_proxy `(Reflexive A R) : ReflexiveProxy R. Proof. firstorder. Qed. (** Respectful morphisms. *) (** The fully dependent version, not used yet. *) Definition respectful_hetero (A B : Type) (C : A -> Type) (D : B -> Type) (R : A -> B -> Prop) (R' : forall (x : A) (y : B), C x -> D y -> Prop) : (forall x : A, C x) -> (forall x : B, D x) -> Prop := fun f g => forall x y, R x y -> R' x y (f x) (g y). (** The non-dependent version is an instance where we forget dependencies. *) Definition respectful (R : relation A) (R' : relation B) : relation (A -> B) := Eval compute in @respectful_hetero A A (fun _ => B) (fun _ => B) R (fun _ _ => R'). End Proper. (** Non-dependent pointwise lifting *) Definition pointwise_relation A {B} (R : relation B) : relation (A -> B) := fun f g => forall a, R (f a) (g a). (** We let Coq infer these relations when a default relation should be found on the function space. *) Lemma rewrite_relation_pointwise {A B R} `{RewriteRelation B R}: RewriteRelation (@pointwise_relation A B R). Proof. split. Qed. Lemma rewrite_relation_eq_dom {A B R} `{RewriteRelation B R}: RewriteRelation (respectful (@Logic.eq A) R). Proof. split. Qed. (** Pointwise reflexive *) Ltac rewrite_relation_fun := (* If we're looking for a default rewrite relation on a function type, we favor pointwise equality *) class_apply @rewrite_relation_pointwise || (* The relation might be already determined to be (eq ==> _) instead of a pointwise equality, but we want to treat them the same. No point in backtracking on the previous instance though *) class_apply @rewrite_relation_eq_dom. Global Hint Extern 2 (@RewriteRelation (_ -> _) _) => rewrite_relation_fun : typeclass_instances. Lemma eq_rewrite_relation {A} : RewriteRelation (@eq A). Proof. split. Qed. Ltac eq_rewrite_relation A := solve [unshelve class_apply @eq_rewrite_relation]. Global Hint Extern 100 (@RewriteRelation ?A _) => eq_rewrite_relation A : typeclass_instances. (** We favor the use of Leibniz equality or a declared reflexive relation when resolving [ProperProxy], otherwise, if the relation is given (not an evar), we fall back to [Proper]. *) #[global] Hint Extern 1 (ProperProxy _ _) => class_apply @eq_proper_proxy || class_apply @reflexive_proper_proxy : typeclass_instances. #[global] Hint Extern 2 (ProperProxy ?R _) => not_evar R; class_apply @proper_proper_proxy : typeclass_instances. (* This tactics takes a type and (partially defined) relation and tries to find all instances matching it which completely determine the relation, feeding them to kont. *) Ltac find_rewrite_relation A R kont := assert (@RewriteRelation A R); [solve [unshelve typeclasses eauto]|]; kont R. (** This hint helps infer "generic" reflexive relations, based only on the type of the carrier, when the relation is only partially defined (contains evars). *) Ltac reflexive_proxy_tac A R := tryif has_evar R then (* If the user declared a specific rewrite relation on the type, we favor it. By default, [iff] and and [impl] are favored for Prop, pointwise equality for function types and finally leibniz equality. *) find_rewrite_relation A R ltac:(fun RA => class_apply (@reflexive_reflexive_proxy A RA)) (* The [Reflexive] subgoal produced here will need no backtracking, being a Prop goal without existential variables, but we don't have `cut` to explicitely say it. *) else (* If the relation is determined then we look for a relexivity proof on it *) class_apply @reflexive_reflexive_proxy. #[global] Hint Extern 1 (@ReflexiveProxy ?A ?R) => reflexive_proxy_tac A R : typeclass_instances. (** Notations reminiscent of the old syntax for declaring morphisms. *) Declare Scope signature_scope. Delimit Scope signature_scope with signature. Module ProperNotations. Notation " R ++> R' " := (@respectful _ _ (R%signature) (R'%signature)) (right associativity, at level 55) : signature_scope. Notation " R ==> R' " := (@respectful _ _ (R%signature) (R'%signature)) (right associativity, at level 55) : signature_scope. Notation " R --> R' " := (@respectful _ _ (flip (R%signature)) (R'%signature)) (right associativity, at level 55) : signature_scope. End ProperNotations. Arguments Proper {A}%_type R%_signature m. Arguments respectful {A B}%_type (R R')%_signature _ _. Export ProperNotations. Local Open Scope signature_scope. (** [solve_proper] try to solve the goal [Proper (?==> ... ==>?) f] by repeated introductions and setoid rewrites. It should work fine when [f] is a combination of already known morphisms and quantifiers. *) Ltac solve_respectful t := match goal with | |- respectful _ _ _ _ => let H := fresh "H" in intros ? ? H; solve_respectful ltac:(setoid_rewrite H; t) | _ => t; reflexivity end. Ltac solve_proper := unfold Proper; solve_respectful ltac:(idtac). (** [f_equiv] is a clone of [f_equal] that handles setoid equivalences. For example, if we know that [f] is a morphism for [E1==>E2==>E], then the goal [E (f x y) (f x' y')] will be transformed by [f_equiv] into the subgoals [E1 x x'] and [E2 y y']. *) Ltac f_equiv := match goal with | |- ?R (?f ?x) (?f' _) => let T := type of x in let Rx := fresh "R" in evar (Rx : relation T); let H := fresh in assert (H : (Rx==>R)%signature f f'); unfold Rx in *; clear Rx; [ f_equiv | apply H; clear H; try reflexivity ] | |- ?R ?f ?f' => solve [change (Proper R f); eauto with typeclass_instances | reflexivity ] | _ => idtac end. Section Relations. Let U := Type. Context {A B : U} (P : A -> U). (** [forall_def] reifies the dependent product as a definition. *) Definition forall_def : Type := forall x : A, P x. (** Dependent pointwise lifting of a relation on the range. *) Definition forall_relation (sig : forall a, relation (P a)) : relation (forall x, P x) := fun f g => forall a, sig a (f a) (g a). Lemma pointwise_pointwise (R : relation B) : relation_equivalence (pointwise_relation A R) (@eq A ==> R). Proof. intros. split; reduce; subst; firstorder. Qed. (** Subrelations induce a morphism on the identity. *) Global Instance subrelation_id_proper `(subrelation A RA RA') : Proper (RA ==> RA') id. Proof. firstorder. Qed. (** The subrelation property goes through products as usual. *) Lemma subrelation_respectful `(subl : subrelation A RA' RA, subr : subrelation B RB RB') : subrelation (RA ==> RB) (RA' ==> RB'). Proof. unfold subrelation in *; firstorder. Qed. (** And of course it is reflexive. *) Lemma subrelation_refl R : @subrelation A R R. Proof. unfold subrelation; firstorder. Qed. (** [Proper] is itself a covariant morphism for [subrelation]. We use an unconvertible premise to avoid looping. *) Lemma subrelation_proper `(mor : Proper A R' m) `(unc : Unconvertible (relation A) R R') `(sub : subrelation A R' R) : Proper R m. Proof. intros. apply sub. apply mor. Qed. Global Instance proper_subrelation_proper : Proper (subrelation ++> eq ==> impl) (@Proper A). Proof. reduce. subst. firstorder. Qed. Global Instance pointwise_subrelation `(sub : subrelation B R R') : subrelation (pointwise_relation A R) (pointwise_relation A R') | 4. Proof. intros x y H a. unfold pointwise_relation in *. apply sub. apply H. Qed. (** For dependent function types. *) Lemma forall_subrelation (R S : forall x : A, relation (P x)) : (forall a, subrelation (R a) (S a)) -> subrelation (forall_relation R) (forall_relation S). Proof. intros H x y H0 a. apply H. apply H0. Qed. End Relations. Global Typeclasses Opaque respectful pointwise_relation forall_relation. Arguments forall_relation {A P}%_type sig%_signature _ _. Arguments pointwise_relation A%_type {B}%_type R%_signature _ _. #[global] Hint Unfold Reflexive : core. #[global] Hint Unfold Symmetric : core. #[global] Hint Unfold Transitive : core. (** Resolution with subrelation: favor decomposing products over applying reflexivity for unconstrained goals. *) Ltac subrelation_tac T U := (is_ground T ; is_ground U ; class_apply @subrelation_refl) || class_apply @subrelation_respectful || class_apply @subrelation_refl. #[global] Hint Extern 3 (@subrelation _ ?T ?U) => subrelation_tac T U : typeclass_instances. CoInductive apply_subrelation : Prop := do_subrelation. Ltac proper_subrelation := match goal with [ H : apply_subrelation |- _ ] => clear H ; class_apply @subrelation_proper end. #[global] Hint Extern 5 (@Proper _ ?H _) => proper_subrelation : typeclass_instances. (** Essential subrelation instances for [iff], [impl] and [pointwise_relation]. *) #[global] Instance iff_impl_subrelation : subrelation iff impl | 2. Proof. firstorder. Qed. #[global] Instance iff_flip_impl_subrelation : subrelation iff (flip impl) | 2. Proof. firstorder. Qed. (** We use an extern hint to help unification. *) #[global] Hint Extern 4 (subrelation (@forall_relation ?A ?B ?R) (@forall_relation _ _ ?S)) => apply (@forall_subrelation A B R S) ; intro : typeclass_instances. Section GenericInstances. (* Share universes *) Let U := Type. Context {A B C : U}. (** We can build a PER on the Coq function space if we have PERs on the domain and codomain. *) Program Instance respectful_per `(PER A R, PER B R') : PER (R ==> R'). Next Obligation. Proof with auto. intros R H R' H0 x y z H1 H2 x0 y0 H3. assert(R x0 x0). - transitivity y0... symmetry... - transitivity (y x0)... Qed. (** The complement of a relation conserves its proper elements. *) Program Definition complement_proper `(mR : Proper (A -> A -> Prop) (RA ==> RA ==> iff) R) : Proper (RA ==> RA ==> iff) (complement R) := _. Next Obligation. Proof. intros RA R mR x y H x0 y0 H0. unfold complement. pose (mR x y H x0 y0 H0). intuition. Qed. (** The [flip] too, actually the [flip] instance is a bit more general. *) Program Definition flip_proper `(mor : Proper (A -> B -> C) (RA ==> RB ==> RC) f) : Proper (RB ==> RA ==> RC) (flip f) := _. Next Obligation. Proof. intros RA RB RC f mor x y H x0 y0 H0; apply mor ; auto. Qed. (** Every Transitive relation gives rise to a binary morphism on [impl], contravariant in the first argument, covariant in the second. *) Global Program Instance trans_contra_co_morphism `(Transitive A R) : Proper (R --> R ++> impl) R. Next Obligation. Proof with auto. intros R H x y H0 x0 y0 H1 H2. transitivity x... transitivity x0... Qed. (** Proper declarations for partial applications. *) Global Program Instance trans_contra_inv_impl_morphism `(Transitive A R) {x} : Proper (R --> flip impl) (R x) | 3. Next Obligation. Proof with auto. intros R H x x0 y H0 H1. transitivity y... Qed. Global Program Instance trans_co_impl_morphism `(Transitive A R) {x} : Proper (R ++> impl) (R x) | 3. Next Obligation. Proof with auto. intros R H x x0 y H0 H1. transitivity x0... Qed. Global Program Instance trans_sym_co_inv_impl_morphism `(PER A R) {x} : Proper (R ++> flip impl) (R x) | 3. Next Obligation. Proof with auto. intros R H x x0 y H0 H1. transitivity y... symmetry... Qed. Global Program Instance trans_sym_contra_impl_morphism `(PER A R) {x} : Proper (R --> impl) (R x) | 3. Next Obligation. Proof with auto. intros R H x x0 y H0 H1. transitivity x0... symmetry... Qed. Global Program Instance per_partial_app_morphism `(PER A R) {x} : Proper (R ==> iff) (R x) | 2. Next Obligation. Proof with auto. intros R H x x0 y H0. split. - intros ; transitivity x0... - intros. transitivity y... symmetry... Qed. (** Every Transitive relation induces a morphism by "pushing" an [R x y] on the left of an [R x z] proof to get an [R y z] goal. *) Global Program Instance trans_co_eq_inv_impl_morphism `(Transitive A R) : Proper (R ==> (@eq A) ==> flip impl) R | 2. Next Obligation. Proof with auto. intros R H x y H0 y0 y1 e H2; destruct e. transitivity y... Qed. (** Every Symmetric and Transitive relation gives rise to an equivariant morphism. *) Global Program Instance PER_morphism `(PER A R) : Proper (R ==> R ==> iff) R | 1. Next Obligation. Proof with auto. intros R H x y H0 x0 y0 H1. split ; intros. - transitivity x0... transitivity x... symmetry... - transitivity y... transitivity y0... symmetry... Qed. Lemma symmetric_equiv_flip `(Symmetric A R) : relation_equivalence R (flip R). Proof. firstorder. Qed. Global Program Instance compose_proper RA RB RC : Proper ((RB ==> RC) ==> (RA ==> RB) ==> (RA ==> RC)) (@compose A B C). Next Obligation. Proof. intros RA RB RC x y H x0 y0 H0 x1 y1 H1. unfold compose. apply H. apply H0. apply H1. Qed. Global Instance reflexive_eq_dom_reflexive `{Reflexive B R'}: Reflexive (respectful (@Logic.eq A) R'). Proof. simpl_relation. Qed. (** [respectful] is a morphism for relation equivalence. *) Global Instance respectful_morphism : Proper (relation_equivalence ++> relation_equivalence ++> relation_equivalence) (@respectful A B). Proof. intros x y H x0 y0 H0 x1 x2. unfold respectful, relation_equivalence, predicate_equivalence in * ; simpl in *. split ; intros H1 x3 y1 H2. - now apply H0, H1, H. - now apply H0, H1, H. Qed. (** [R] is Reflexive, hence we can build the needed proof. *) Lemma Reflexive_partial_app_morphism `(Proper (A -> B) (R ==> R') m, ProperProxy A R x) : Proper R' (m x). Proof. simpl_relation. Qed. Lemma flip_respectful (R : relation A) (R' : relation B) : relation_equivalence (flip (R ==> R')) (flip R ==> flip R'). Proof. intros. unfold flip, respectful. split ; intros ; intuition. Qed. (** Treating flip: can't make them direct instances as we need at least a [flip] present in the goal. *) Lemma flip1 `(subrelation A R' R) : subrelation (flip (flip R')) R. Proof. firstorder. Qed. Lemma flip2 `(subrelation A R R') : subrelation R (flip (flip R')). Proof. firstorder. Qed. (** That's if and only if *) Lemma eq_subrelation `(Reflexive A R) : subrelation (@eq A) R. Proof. simpl_relation. Qed. (** Once we have normalized, we will apply this instance to simplify the problem. *) Definition proper_flip_proper `(mor : Proper A R m) : Proper (flip R) m := mor. Lemma proper_eq (x : A) : Proper (@eq A) x. Proof. intros. reflexivity. Qed. End GenericInstances. Class PartialApplication. CoInductive normalization_done : Prop := did_normalization. Class Params {A : Type} (of : A) (arity : nat). #[global] Instance eq_pars : Params (@eq) 1 := {}. #[global] Instance iff_pars : Params (@iff) 0 := {}. #[global] Instance impl_pars : Params (@impl) 0 := {}. #[global] Instance flip_pars : Params (@flip) 4 := {}. Ltac partial_application_tactic := let rec do_partial_apps H m cont := match m with | ?m' ?x => class_apply @Reflexive_partial_app_morphism ; [(do_partial_apps H m' ltac:(idtac))|clear H] | _ => cont end in let rec do_partial H ar m := lazymatch ar with | 0%nat => do_partial_apps H m ltac:(fail 1) | S ?n' => match m with ?m' ?x => do_partial H n' m' end end in let params m sk fk := (let m' := fresh in head_of_constr m' m ; let n := fresh in evar (n:nat) ; let v := eval compute in n in clear n ; let H := fresh in assert(H:Params m' v) by (subst m'; once typeclasses eauto) ; let v' := eval compute in v in subst m'; (sk H v' || fail 1)) || fk in let on_morphism m cont := params m ltac:(fun H n => do_partial H n m) ltac:(cont) in match goal with | [ _ : normalization_done |- _ ] => fail 1 | [ _ : @Params _ _ _ |- _ ] => fail 1 | [ |- @Proper ?T _ (?m ?x) ] => match goal with | [ H : PartialApplication |- _ ] => class_apply @Reflexive_partial_app_morphism; [|clear H] | _ => on_morphism (m x) ltac:(class_apply @Reflexive_partial_app_morphism) end end. (** Bootstrap !!! *) #[global] Instance proper_proper {A} : Proper (relation_equivalence ==> eq ==> iff) (@Proper A). Proof. intros x y H y0 y1 e; destruct e. reduce in H. split ; red ; intros H0. - apply H, H0. - apply H, H0. Qed. Ltac proper_reflexive := match goal with | [ _ : normalization_done |- _ ] => fail 1 | _ => class_apply proper_eq || class_apply @reflexive_proper end. #[global] Hint Extern 1 (subrelation (flip _) _) => class_apply @flip1 : typeclass_instances. #[global] Hint Extern 1 (subrelation _ (flip _)) => class_apply @flip2 : typeclass_instances. #[global] Hint Extern 1 (Proper _ (complement _)) => apply @complement_proper : typeclass_instances. #[global] Hint Extern 1 (Proper _ (flip _)) => apply @flip_proper : typeclass_instances. #[global] Hint Extern 2 (@Proper _ (flip _) _) => class_apply @proper_flip_proper : typeclass_instances. #[global] Hint Extern 4 (@Proper _ _ _) => partial_application_tactic : typeclass_instances. #[global] Hint Extern 7 (@Proper _ _ _) => proper_reflexive : typeclass_instances. (** Special-purpose class to do normalization of signatures w.r.t. flip. *) Section Normalize. Context (A : Type). Class Normalizes (m : relation A) (m' : relation A) : Prop := normalizes : relation_equivalence m m'. (** Current strategy: add [flip] everywhere and reduce using [subrelation] afterwards. *) Lemma proper_normalizes_proper `(Normalizes R0 R1, Proper A R1 m) : Proper R0 m. Proof. eapply proper_proper; eauto. Qed. Lemma flip_atom R : Normalizes R (flip (flip R)). Proof. firstorder. Qed. End Normalize. Lemma flip_arrow {A : Type} {B : Type} `(NA : Normalizes A R (flip R'''), NB : Normalizes B R' (flip R'')) : Normalizes (A -> B) (R ==> R') (flip (R''' ==> R'')%signature). Proof. unfold Normalizes in *. unfold relation_equivalence in *. unfold predicate_equivalence in *. simpl in *. unfold respectful. unfold flip in *. intros x x0; split; intros H x1 y H0. - apply NB. apply H. apply NA. apply H0. - apply NB. apply H. apply NA. apply H0. Qed. Ltac normalizes := match goal with | [ |- Normalizes _ (respectful _ _) _ ] => class_apply @flip_arrow | _ => class_apply @flip_atom end. Ltac proper_normalization := match goal with | [ _ : normalization_done |- _ ] => fail 1 | [ _ : apply_subrelation |- @Proper _ ?R _ ] => let H := fresh "H" in set(H:=did_normalization) ; class_apply @proper_normalizes_proper end. #[global] Hint Extern 1 (Normalizes _ _ _) => normalizes : typeclass_instances. #[global] Hint Extern 6 (@Proper _ _ _) => proper_normalization : typeclass_instances. (** When the relation on the domain is symmetric, we can flip the relation on the codomain. Same for binary functions. *) Lemma proper_sym_flip : forall `(Symmetric A R1)`(Proper (A->B) (R1==>R2) f), Proper (R1==>flip R2) f. Proof. intros A R1 Sym B R2 f Hf. intros x x' Hxx'. apply Hf, Sym, Hxx'. Qed. Lemma proper_sym_flip_2 : forall `(Symmetric A R1)`(Symmetric B R2)`(Proper (A->B->C) (R1==>R2==>R3) f), Proper (R1==>R2==>flip R3) f. Proof. intros A R1 Sym1 B R2 Sym2 C R3 f Hf. intros x x' Hxx' y y' Hyy'. apply Hf; auto. Qed. (** When the relation on the domain is symmetric, a predicate is compatible with [iff] as soon as it is compatible with [impl]. Same with a binary relation. *) Lemma proper_sym_impl_iff : forall `(Symmetric A R)`(Proper _ (R==>impl) f), Proper (R==>iff) f. Proof. intros A R Sym f Hf x x' Hxx'. repeat red in Hf. split; eauto. Qed. Lemma proper_sym_impl_iff_2 : forall `(Symmetric A R)`(Symmetric B R')`(Proper _ (R==>R'==>impl) f), Proper (R==>R'==>iff) f. Proof. intros A R Sym B R' Sym' f Hf x x' Hxx' y y' Hyy'. repeat red in Hf. split; eauto. Qed. (** A [PartialOrder] is compatible with its underlying equivalence. *) #[global] Instance PartialOrder_proper `(PartialOrder A eqA R) : Proper (eqA==>eqA==>iff) R. Proof. intros. apply proper_sym_impl_iff_2. 1-2: auto with relations. intros x x' Hx y y' Hy Hr. transitivity x. - generalize (partial_order_equivalence x x'); compute; intuition. - transitivity y; auto. generalize (partial_order_equivalence y y'); compute; intuition. Qed. (** From a [PartialOrder] to the corresponding [StrictOrder]: [lt = le /\ ~eq]. If the order is total, we could also say [gt = ~le]. *) Lemma PartialOrder_StrictOrder `(PartialOrder A eqA R) : StrictOrder (relation_conjunction R (complement eqA)). Proof. split; compute. - intros x (_,Hx). apply Hx, Equivalence_Reflexive. - intros x y z (Hxy,Hxy') (Hyz,Hyz'). split. + apply PreOrder_Transitive with y; assumption. + intro Hxz. apply Hxy'. apply partial_order_antisym; auto. eapply PartialOrder_proper; eauto. apply reflexivity. Qed. (** From a [StrictOrder] to the corresponding [PartialOrder]: [le = lt \/ eq]. If the order is total, we could also say [ge = ~lt]. *) Lemma StrictOrder_PreOrder `(Equivalence A eqA, StrictOrder A R, Proper _ (eqA==>eqA==>iff) R) : PreOrder (relation_disjunction R eqA). Proof. split. - intros x. right. reflexivity. - intros x y z [Hxy|Hxy] [Hyz|Hyz]. + left. transitivity y; auto. + left. eapply H1; eauto. * apply reflexivity. * now apply symmetry. + left. eapply H1; try eassumption. now apply reflexivity. + right. transitivity y; auto. Qed. #[global] Hint Extern 4 (PreOrder (relation_disjunction _ _)) => class_apply StrictOrder_PreOrder : typeclass_instances. Lemma StrictOrder_PartialOrder `(Equivalence A eqA, StrictOrder A R, Proper _ (eqA==>eqA==>iff) R) : PartialOrder eqA (relation_disjunction R eqA). Proof. intros. intros x y. compute. intuition auto with relations. elim (StrictOrder_Irreflexive x). transitivity y; auto. Qed. #[global] Hint Extern 4 (StrictOrder (relation_conjunction _ _)) => class_apply PartialOrder_StrictOrder : typeclass_instances. #[global] Hint Extern 4 (PartialOrder _ (relation_disjunction _ _)) => class_apply StrictOrder_PartialOrder : typeclass_instances. (* Register bindings for the generalized rewriting tactic *) Register forall_relation as rewrite.prop.forall_relation. Register pointwise_relation as rewrite.prop.pointwise_relation. Register respectful as rewrite.prop.respectful. Register forall_def as rewrite.prop.forall_def. Register do_subrelation as rewrite.prop.do_subrelation. Register apply_subrelation as rewrite.prop.apply_subrelation. Register RewriteRelation as rewrite.prop.RewriteRelation. Register Proper as rewrite.prop.Proper. Register ProperProxy as rewrite.prop.ProperProxy. coq-8.20.0/theories/Classes/Morphisms_Prop.v000066400000000000000000000067421466560755400210050ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* impl) not | 1. #[global] Program Instance not_iff_morphism : Proper (iff ++> iff) not. (** Logical conjunction. *) #[global] Program Instance and_impl_morphism : Proper (impl ==> impl ==> impl) and | 1. #[global] Program Instance and_iff_morphism : Proper (iff ==> iff ==> iff) and. (** Logical disjunction. *) #[global] Program Instance or_impl_morphism : Proper (impl ==> impl ==> impl) or | 1. #[global] Program Instance or_iff_morphism : Proper (iff ==> iff ==> iff) or. (** Logical implication [impl] is a morphism for logical equivalence. *) #[global] Program Instance iff_iff_iff_impl_morphism : Proper (iff ==> iff ==> iff) impl. (** Morphisms for quantifiers *) #[global] Program Instance ex_iff_morphism {A : Type} : Proper (pointwise_relation A iff ==> iff) (@ex A). #[global] Program Instance ex_impl_morphism {A : Type} : Proper (pointwise_relation A impl ==> impl) (@ex A) | 1. #[global] Program Instance ex_flip_impl_morphism {A : Type} : Proper (pointwise_relation A (flip impl) ==> flip impl) (@ex A) | 1. #[global] Program Instance all_iff_morphism {A : Type} : Proper (pointwise_relation A iff ==> iff) (@all A). #[global] Program Instance all_impl_morphism {A : Type} : Proper (pointwise_relation A impl ==> impl) (@all A) | 1. #[global] Program Instance all_flip_impl_morphism {A : Type} : Proper (pointwise_relation A (flip impl) ==> flip impl) (@all A) | 1. (** Equivalent points are simultaneously accessible or not *) #[global] Instance Acc_pt_morphism {A:Type}(E R : A->A->Prop) `(Equivalence _ E) `(Proper _ (E==>E==>iff) R) : Proper (E==>iff) (Acc R). Proof. apply proper_sym_impl_iff. - auto with relations. - intros x y EQ WF. apply Acc_intro; intros z Hz. rewrite <- EQ in Hz. now apply Acc_inv with x. Qed. (** Equivalent relations have the same accessible points *) #[global] Instance Acc_rel_morphism {A:Type} : Proper (relation_equivalence ==> Logic.eq ==> iff) (@Acc A). Proof. apply proper_sym_impl_iff_2. - red; now symmetry. - red; now symmetry. - intros R R' EQ a a' Ha WF. subst a'. induction WF as [x _ WF']. constructor. intros y Ryx. now apply WF', EQ. Qed. (** Equivalent relations are simultaneously well-founded or not *) #[global] Instance well_founded_morphism {A : Type} : Proper (relation_equivalence ==> iff) (@well_founded A). Proof. unfold well_founded. solve_proper. Qed. coq-8.20.0/theories/Classes/Morphisms_Relations.v000066400000000000000000000050321466560755400220140ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* relation_equivalence ==> relation_equivalence) relation_conjunction. Proof. firstorder. Qed. #[global] Instance relation_disjunction_morphism {A} : Proper (relation_equivalence (A:=A) ==> relation_equivalence ==> relation_equivalence) relation_disjunction. Proof. firstorder. Qed. (* Predicate equivalence is exactly the same as the pointwise lifting of [iff]. *) Lemma predicate_equivalence_pointwise (l : Tlist) : Proper (@predicate_equivalence l ==> pointwise_lifting iff l) id. Proof. do 2 red. unfold predicate_equivalence. auto. Qed. Lemma predicate_implication_pointwise (l : Tlist) : Proper (@predicate_implication l ==> pointwise_lifting impl l) id. Proof. do 2 red. unfold predicate_implication. auto. Qed. (** The instantiation at relation allows rewriting applications of relations [R x y] to [R' x y] when [R] and [R'] are in [relation_equivalence]. *) #[global] Instance relation_equivalence_pointwise {A} : Proper (relation_equivalence ==> pointwise_relation A (pointwise_relation A iff)) id. Proof. intro. apply (predicate_equivalence_pointwise (Tcons A (Tcons A Tnil))). Qed. #[global] Instance subrelation_pointwise {A} : Proper (subrelation ==> pointwise_relation A (pointwise_relation A impl)) id. Proof. intro. apply (predicate_implication_pointwise (Tcons A (Tcons A Tnil))). Qed. Lemma flip_pointwise_relation A (R : relation A) : relation_equivalence (pointwise_relation A (flip R)) (flip (pointwise_relation A R)). Proof. intros. split; firstorder. Qed. coq-8.20.0/theories/Classes/RelationClasses.v000066400000000000000000000443571466560755400211230ustar00rootroot00000000000000(* -*- coding: utf-8 -*- *) (************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* R x y -> False. (** Opaque for proof-search. *) Typeclasses Opaque complement. (** These are convertible. *) Lemma complement_inverse R : complement (flip R) = flip (complement R). Proof. reflexivity. Qed. Class Irreflexive (R : relation A) := irreflexivity : Reflexive (complement R). Class Symmetric (R : relation A) := symmetry : forall {x y}, R x y -> R y x. Class Asymmetric (R : relation A) := asymmetry : forall {x y}, R x y -> R y x -> False. Class Transitive (R : relation A) := transitivity : forall {x y z}, R x y -> R y z -> R x z. (** Various combinations of reflexivity, symmetry and transitivity. *) (** A [PreOrder] is both Reflexive and Transitive. *) Class PreOrder (R : relation A) : Prop := { #[global] PreOrder_Reflexive :: Reflexive R | 2 ; #[global] PreOrder_Transitive :: Transitive R | 2 }. (** A [StrictOrder] is both Irreflexive and Transitive. *) Class StrictOrder (R : relation A) : Prop := { #[global] StrictOrder_Irreflexive :: Irreflexive R ; #[global] StrictOrder_Transitive :: Transitive R }. (** By definition, a strict order is also asymmetric *) Global Instance StrictOrder_Asymmetric `(StrictOrder R) : Asymmetric R. Proof. firstorder. Qed. (** A partial equivalence relation is Symmetric and Transitive. *) Class PER (R : relation A) : Prop := { #[global] PER_Symmetric :: Symmetric R | 3 ; #[global] PER_Transitive :: Transitive R | 3 }. (** Equivalence relations. *) Class Equivalence (R : relation A) : Prop := { #[global] Equivalence_Reflexive :: Reflexive R ; #[global] Equivalence_Symmetric :: Symmetric R ; #[global] Equivalence_Transitive :: Transitive R }. (** An Equivalence is a PER plus reflexivity. *) Global Instance Equivalence_PER {R} `(E:Equivalence R) : PER R | 10 := { }. (** An Equivalence is a PreOrder plus symmetry. *) Global Instance Equivalence_PreOrder {R} `(E:Equivalence R) : PreOrder R | 10 := { }. (** We can now define antisymmetry w.r.t. an equivalence relation on the carrier. *) Class Antisymmetric eqA `{equ : Equivalence eqA} (R : relation A) := antisymmetry : forall {x y}, R x y -> R y x -> eqA x y. Class subrelation (R R' : relation A) : Prop := is_subrelation : forall {x y}, R x y -> R' x y. (** Any symmetric relation is equal to its inverse. *) Lemma subrelation_symmetric R `(Symmetric R) : subrelation (flip R) R. Proof. hnf. intros x y H0. red in H0. apply symmetry. assumption. Qed. Section flip. Lemma flip_Reflexive `{Reflexive R} : Reflexive (flip R). Proof. tauto. Qed. Program Definition flip_Irreflexive `(Irreflexive R) : Irreflexive (flip R) := irreflexivity (R:=R). Program Definition flip_Symmetric `(Symmetric R) : Symmetric (flip R) := fun x y H => symmetry (R:=R) H. Program Definition flip_Asymmetric `(Asymmetric R) : Asymmetric (flip R) := fun x y H H' => asymmetry (R:=R) H H'. Program Definition flip_Transitive `(Transitive R) : Transitive (flip R) := fun x y z H H' => transitivity (R:=R) H' H. Program Definition flip_Antisymmetric `(Antisymmetric eqA R) : Antisymmetric eqA (flip R). Proof. firstorder. Qed. (** Inversing the larger structures *) Lemma flip_PreOrder `(PreOrder R) : PreOrder (flip R). Proof. firstorder. Qed. Lemma flip_StrictOrder `(StrictOrder R) : StrictOrder (flip R). Proof. firstorder. Qed. Lemma flip_PER `(PER R) : PER (flip R). Proof. firstorder. Qed. Lemma flip_Equivalence `(Equivalence R) : Equivalence (flip R). Proof. firstorder. Qed. End flip. Section complement. Definition complement_Irreflexive `(Reflexive R) : Irreflexive (complement R). Proof. firstorder. Qed. Definition complement_Symmetric `(Symmetric R) : Symmetric (complement R). Proof. firstorder. Qed. End complement. (** Rewrite relation on a given support: declares a relation as a rewrite relation for use by the generalized rewriting tactic. It helps choosing if a rewrite should be handled by the generalized or the regular rewriting tactic using leibniz equality. Users can declare an [RewriteRelation A RA] anywhere to declare default relations on a given type `A`. This is also done automatically by the [Declare Relation A RA] commands. It has no mode declaration: it will assign `?A := Prop, ?R := iff` on an entirely unspecified query `RewriteRelation ?A ?R`, or any prefered rewrite relation of priority < 2. *) Class RewriteRelation (RA : relation A). (** Leibniz equality. *) Section Leibniz. Global Instance eq_Reflexive : Reflexive (@eq A) := @eq_refl A. Global Instance eq_Symmetric : Symmetric (@eq A) := @eq_sym A. Global Instance eq_Transitive : Transitive (@eq A) := @eq_trans A. (** Leibinz equality [eq] is an equivalence relation. The instance has low priority as it is always applicable if only the type is constrained. *) Global Program Instance eq_equivalence : Equivalence (@eq A) | 10. End Leibniz. (** Leibniz disequality. *) Section LeibnizNot. (** Disequality is symmetric. *) Global Instance neq_Symmetric : Symmetric (fun x y : A => x <> y) := (@not_eq_sym A). End LeibnizNot. End Defs. (** Default rewrite relations handled by [setoid_rewrite] on Prop. *) #[global] Instance inverse_impl_rewrite_relation : RewriteRelation (flip impl) | 3 := {}. #[global] Instance impl_rewrite_relation : RewriteRelation impl | 3 := {}. #[global] Instance iff_rewrite_relation : RewriteRelation iff | 2 := {}. (** Any [Equivalence] declared in the context is automatically considered a rewrite relation. This only applies if the relation is at least partially defined: setoid_rewrite won't try to infer arbitrary user rewrite relations. *) Definition equivalence_rewrite_relation `(eqa : Equivalence A eqA) : RewriteRelation eqA := Build_RewriteRelation _. Ltac equiv_rewrite_relation R := tryif is_evar R then fail else class_apply equivalence_rewrite_relation. #[global] Hint Extern 10 (@RewriteRelation ?A ?R) => equiv_rewrite_relation R : typeclass_instances. (** Hints to drive the typeclass resolution avoiding loops due to the use of full unification. *) #[global] Hint Extern 1 (Reflexive (complement _)) => class_apply @irreflexivity : typeclass_instances. #[global] Hint Extern 3 (Symmetric (complement _)) => class_apply complement_Symmetric : typeclass_instances. #[global] Hint Extern 3 (Irreflexive (complement _)) => class_apply complement_Irreflexive : typeclass_instances. #[global] Hint Extern 3 (Reflexive (flip _)) => apply flip_Reflexive : typeclass_instances. #[global] Hint Extern 3 (Irreflexive (flip _)) => class_apply flip_Irreflexive : typeclass_instances. #[global] Hint Extern 3 (Symmetric (flip _)) => class_apply flip_Symmetric : typeclass_instances. #[global] Hint Extern 3 (Asymmetric (flip _)) => class_apply flip_Asymmetric : typeclass_instances. #[global] Hint Extern 3 (Antisymmetric (flip _)) => class_apply flip_Antisymmetric : typeclass_instances. #[global] Hint Extern 3 (Transitive (flip _)) => class_apply flip_Transitive : typeclass_instances. #[global] Hint Extern 3 (StrictOrder (flip _)) => class_apply flip_StrictOrder : typeclass_instances. #[global] Hint Extern 3 (PreOrder (flip _)) => class_apply flip_PreOrder : typeclass_instances. #[global] Hint Extern 4 (subrelation (flip _) _) => class_apply @subrelation_symmetric : typeclass_instances. Arguments irreflexivity {A R Irreflexive} [x] _ : rename. Arguments symmetry {A} {R} {_} [x] [y] _. Arguments asymmetry {A} {R} {_} [x] [y] _ _. Arguments transitivity {A} {R} {_} [x] [y] [z] _ _. Arguments Antisymmetric A eqA {_} _. #[global] Hint Resolve irreflexivity : ord. Unset Implicit Arguments. Ltac solve_relation := match goal with | [ |- ?R ?x ?x ] => reflexivity | [ H : ?R ?x ?y |- ?R ?y ?x ] => symmetry ; exact H end. #[global] Hint Extern 4 => solve_relation : relations. (** We can already dualize all these properties. *) (** * Standard instances. *) Ltac reduce_hyp H := match type of H with | context [ _ <-> _ ] => fail 1 | _ => red in H ; try reduce_hyp H end. Ltac reduce_goal := match goal with | [ |- _ <-> _ ] => fail 1 | _ => red ; intros ; try reduce_goal end. Tactic Notation "reduce" "in" hyp(Hid) := reduce_hyp Hid. Ltac reduce := reduce_goal. Tactic Notation "apply" "*" constr(t) := first [ refine t | refine (t _) | refine (t _ _) | refine (t _ _ _) | refine (t _ _ _ _) | refine (t _ _ _ _ _) | refine (t _ _ _ _ _ _) | refine (t _ _ _ _ _ _ _) ]. Ltac simpl_relation := unfold flip, impl, arrow ; try reduce ; program_simpl ; try ( solve [ dintuition auto with relations ]). Local Obligation Tactic := try solve [ simpl_relation ]. (** Logical implication. *) #[global] Program Instance impl_Reflexive : Reflexive impl. #[global] Program Instance impl_Transitive : Transitive impl. (** Logical equivalence. *) #[global] Instance iff_Reflexive : Reflexive iff := iff_refl. #[global] Instance iff_Symmetric : Symmetric iff := iff_sym. #[global] Instance iff_Transitive : Transitive iff := iff_trans. (** Logical equivalence [iff] is an equivalence relation. *) #[global] Program Instance iff_equivalence : Equivalence iff. (** We now develop a generalization of results on relations for arbitrary predicates. The resulting theory can be applied to homogeneous binary relations but also to arbitrary n-ary predicates. *) Local Open Scope list_scope. (** A compact representation of non-dependent arities, with the codomain singled-out. *) (* Note, we do not use [list Type] because it imposes unnecessary universe constraints *) Inductive Tlist : Type := Tnil : Tlist | Tcons : Type -> Tlist -> Tlist. Local Infix "::" := Tcons. Fixpoint arrows (l : Tlist) (r : Type) : Type := match l with | Tnil => r | A :: l' => A -> arrows l' r end. (** We can define abbreviations for operation and relation types based on [arrows]. *) Definition unary_operation A := arrows (A::Tnil) A. Definition binary_operation A := arrows (A::A::Tnil) A. Definition ternary_operation A := arrows (A::A::A::Tnil) A. (** We define n-ary [predicate]s as functions into [Prop]. *) Notation predicate l := (arrows l Prop). (** Unary predicates, or sets. *) Definition unary_predicate A := predicate (A::Tnil). (** Homogeneous binary relations, equivalent to [relation A]. *) Definition binary_relation A := predicate (A::A::Tnil). (** We can close a predicate by universal or existential quantification. *) Fixpoint predicate_all (l : Tlist) : predicate l -> Prop := match l with | Tnil => fun f => f | A :: tl => fun f => forall x : A, predicate_all tl (f x) end. Fixpoint predicate_exists (l : Tlist) : predicate l -> Prop := match l with | Tnil => fun f => f | A :: tl => fun f => exists x : A, predicate_exists tl (f x) end. (** Pointwise extension of a binary operation on [T] to a binary operation on functions whose codomain is [T]. For an operator on [Prop] this lifts the operator to a binary operation. *) Fixpoint pointwise_extension {T : Type} (op : binary_operation T) (l : Tlist) : binary_operation (arrows l T) := match l with | Tnil => fun R R' => op R R' | A :: tl => fun R R' => fun x => pointwise_extension op tl (R x) (R' x) end. (** Pointwise lifting, equivalent to doing [pointwise_extension] and closing using [predicate_all]. *) Fixpoint pointwise_lifting (op : binary_relation Prop) (l : Tlist) : binary_relation (predicate l) := match l with | Tnil => fun R R' => op R R' | A :: tl => fun R R' => forall x, pointwise_lifting op tl (R x) (R' x) end. (** The n-ary equivalence relation, defined by lifting the 0-ary [iff] relation. *) Definition predicate_equivalence {l : Tlist} : binary_relation (predicate l) := pointwise_lifting iff l. (** The n-ary implication relation, defined by lifting the 0-ary [impl] relation. *) Definition predicate_implication {l : Tlist} := pointwise_lifting impl l. (** Notations for pointwise equivalence and implication of predicates. *) Declare Scope predicate_scope. Infix "<∙>" := predicate_equivalence (at level 95, no associativity) : predicate_scope. Infix "-∙>" := predicate_implication (at level 70, right associativity) : predicate_scope. Local Open Scope predicate_scope. (** The pointwise liftings of conjunction and disjunctions. Note that these are [binary_operation]s, building new relations out of old ones. *) Definition predicate_intersection := pointwise_extension and. Definition predicate_union := pointwise_extension or. Infix "/∙\" := predicate_intersection (at level 80, right associativity) : predicate_scope. Infix "\∙/" := predicate_union (at level 85, right associativity) : predicate_scope. (** The always [True] and always [False] predicates. *) Fixpoint true_predicate {l : Tlist} : predicate l := match l with | Tnil => True | A :: tl => fun _ => @true_predicate tl end. Fixpoint false_predicate {l : Tlist} : predicate l := match l with | Tnil => False | A :: tl => fun _ => @false_predicate tl end. Notation "∙⊤∙" := true_predicate : predicate_scope. Notation "∙⊥∙" := false_predicate : predicate_scope. (** Predicate equivalence is an equivalence, and predicate implication defines a preorder. *) #[global] Program Instance predicate_equivalence_equivalence {l} : Equivalence (@predicate_equivalence l). Next Obligation. intro l; induction l ; firstorder. Qed. Next Obligation. intro l; induction l ; firstorder. Qed. Next Obligation. intro l. fold pointwise_lifting. induction l as [|T l IHl]. - firstorder. - intros x y z H H0 x0. pose (IHl (x x0) (y x0) (z x0)). firstorder. Qed. #[global] Program Instance predicate_implication_preorder {l} : PreOrder (@predicate_implication l). Next Obligation. intro l; induction l ; firstorder. Qed. Next Obligation. intro l. induction l as [|T l IHl]. - firstorder. - intros x y z H H0 x0. pose (IHl (x x0) (y x0) (z x0)). firstorder. Qed. (** We define the various operations which define the algebra on binary relations, from the general ones. *) Section Binary. Context {A : Type}. Definition relation_equivalence : relation (relation A) := @predicate_equivalence (_::_::Tnil). Global Instance relation_equivalence_rewrite_relation: RewriteRelation relation_equivalence := {}. Definition relation_conjunction (R : relation A) (R' : relation A) : relation A := @predicate_intersection (A::A::Tnil) R R'. Definition relation_disjunction (R : relation A) (R' : relation A) : relation A := @predicate_union (A::A::Tnil) R R'. (** Relation equivalence is an equivalence, and subrelation defines a partial order. *) Global Instance relation_equivalence_equivalence : Equivalence relation_equivalence. Proof. exact (@predicate_equivalence_equivalence (A::A::Tnil)). Qed. Global Instance relation_implication_preorder : PreOrder (@subrelation A). Proof. exact (@predicate_implication_preorder (A::A::Tnil)). Qed. (** *** Partial Order. A partial order is a preorder which is additionally antisymmetric. We give an equivalent definition, up-to an equivalence relation on the carrier. *) Class PartialOrder eqA `{equ : Equivalence A eqA} R `{preo : PreOrder A R} := partial_order_equivalence : relation_equivalence eqA (relation_conjunction R (flip R)). (** The equivalence proof is sufficient for proving that [R] must be a morphism for equivalence (see Morphisms). It is also sufficient to show that [R] is antisymmetric w.r.t. [eqA] *) Global Instance partial_order_antisym `(PartialOrder eqA R) : Antisymmetric A eqA R. Proof with auto. reduce_goal. pose proof partial_order_equivalence as poe. do 3 red in poe. apply <- poe. firstorder. Qed. Lemma PartialOrder_inverse `(PartialOrder eqA R) : PartialOrder eqA (flip R). Proof. firstorder. Qed. End Binary. #[global] Hint Extern 3 (PartialOrder (flip _)) => class_apply PartialOrder_inverse : typeclass_instances. (** The partial order defined by subrelation and relation equivalence. *) #[global] Program Instance subrelation_partial_order {A} : PartialOrder (@relation_equivalence A) subrelation. Next Obligation. Proof. unfold relation_equivalence in *. compute; firstorder. Qed. Global Typeclasses Opaque arrows predicate_implication predicate_equivalence relation_equivalence pointwise_lifting. (* Register bindings for the generalized rewriting tactic *) Register relation as rewrite.prop.relation. Register subrelation as rewrite.prop.subrelation. Register Reflexive as rewrite.prop.Reflexive. Register reflexivity as rewrite.prop.reflexivity. Register Symmetric as rewrite.prop.Symmetric. Register symmetry as rewrite.prop.symmetry. Register Transitive as rewrite.prop.Transitive. Register transitivity as rewrite.prop.transitivity. coq-8.20.0/theories/Classes/RelationPairs.v000066400000000000000000000145301466560755400205720ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* B) : relation A := fun a a' => R (f a) (f a'). (** Instances on RelCompFun must match syntactically *) Global Typeclasses Opaque RelCompFun. Infix "@@" := RelCompFun (at level 30, right associativity) : signature_scope. Notation "R @@1" := (R @@ Fst)%signature (at level 30) : signature_scope. Notation "R @@2" := (R @@ Snd)%signature (at level 30) : signature_scope. (** We declare measures to the system using the [Measure] class. Otherwise the instances would easily introduce loops, never instantiating the [f] function. *) Class Measure {A B} (f : A -> B). (** Standard measures. *) #[global] Instance fst_measure {A B} : @Measure (A * B) A Fst := {}. #[global] Instance snd_measure {A B} : @Measure (A * B) B Snd := {}. (** We define a product relation over [A*B]: each components should satisfy the corresponding initial relation. *) Definition RelProd {A : Type} {B : Type} (RA:relation A)(RB:relation B) : relation (A*B) := relation_conjunction (@RelCompFun (A * B) A RA fst) (RB @@2). Global Typeclasses Opaque RelProd. Infix "*" := RelProd : signature_scope. Section RelCompFun_Instances. Context {A : Type} {B : Type} (R : relation B). Global Instance RelCompFun_Reflexive `(Measure A B f, Reflexive _ R) : Reflexive (R@@f). Proof. firstorder. Qed. Global Instance RelCompFun_Symmetric `(Measure A B f, Symmetric _ R) : Symmetric (R@@f). Proof. firstorder. Qed. Global Instance RelCompFun_Transitive `(Measure A B f, Transitive _ R) : Transitive (R@@f). Proof. firstorder. Qed. Global Instance RelCompFun_Irreflexive `(Measure A B f, Irreflexive _ R) : Irreflexive (R@@f). Proof. firstorder. Qed. Global Instance RelCompFun_Equivalence `(Measure A B f, Equivalence _ R) : Equivalence (R@@f) := {}. Global Instance RelCompFun_StrictOrder `(Measure A B f, StrictOrder _ R) : StrictOrder (R@@f) := {}. End RelCompFun_Instances. Section RelProd_Instances. Context {A : Type} {B : Type} (RA : relation A) (RB : relation B). Global Instance RelProd_Reflexive `(Reflexive _ RA, Reflexive _ RB) : Reflexive (RA*RB). Proof. firstorder. Qed. Global Instance RelProd_Symmetric `(Symmetric _ RA, Symmetric _ RB) : Symmetric (RA*RB). Proof. firstorder. Qed. Global Instance RelProd_Transitive `(Transitive _ RA, Transitive _ RB) : Transitive (RA*RB). Proof. firstorder. Qed. Global Program Instance RelProd_Equivalence `(Equivalence _ RA, Equivalence _ RB) : Equivalence (RA*RB). Lemma FstRel_ProdRel : relation_equivalence (RA @@1) (RA*(fun _ _ : B => True)). Proof. firstorder. Qed. Lemma SndRel_ProdRel : relation_equivalence (RB @@2) ((fun _ _ : A =>True) * RB). Proof. firstorder. Qed. Global Instance FstRel_sub : subrelation (RA*RB) (RA @@1). Proof. firstorder. Qed. Global Instance SndRel_sub : subrelation (RA*RB) (RB @@2). Proof. firstorder. Qed. Global Instance pair_compat : Proper (RA==>RB==> RA*RB) (@pair _ _). Proof. firstorder. Qed. Global Instance fst_compat : Proper (RA*RB ==> RA) Fst. Proof. intros (x,y) (x',y') (Hx,Hy); compute in *; auto. Qed. Global Instance snd_compat : Proper (RA*RB ==> RB) Snd. Proof. intros (x,y) (x',y') (Hx,Hy); compute in *; auto. Qed. Global Instance RelCompFun_compat (f:A->B) `(Proper _ (Ri==>Ri==>Ro) RB) : Proper (Ri@@f==>Ri@@f==>Ro) (RB@@f)%signature. Proof. unfold RelCompFun; firstorder. Qed. End RelProd_Instances. #[global] Hint Unfold RelProd RelCompFun : core. #[global] Hint Extern 2 (RelProd _ _ _ _) => split : core. #[export] Instance Proper_RelProd_flip_impl: forall A B RA1 RA2 RB1 RB2 (RA : relation A) (RB : relation B), Proper (RA1 ==> RA2 ==> Basics.flip Basics.impl) RA -> Proper (RB1 ==> RB2 ==> Basics.flip Basics.impl) RB -> Proper (RA1 * RB1 ==> RA2 * RB2 ==> Basics.flip Basics.impl) (RA * RB)%signature. Proof. cbv; intuition eauto. Qed. #[export] Instance Proper_RelProd_impl: forall A B RA1 RA2 RB1 RB2 (RA : relation A) (RB : relation B), Proper (RA1 ==> RA2 ==> Basics.impl) RA -> Proper (RB1 ==> RB2 ==> Basics.impl) RB -> Proper (RA1 * RB1 ==> RA2 * RB2 ==> Basics.impl) (RA * RB)%signature. Proof. cbv; intuition eauto. Qed. #[export] Instance Proper_RelProd_iff: forall A B RA1 RA2 RB1 RB2 (RA : relation A) (RB : relation B), Proper (RA1 ==> RA2 ==> iff) RA -> Proper (RB1 ==> RB2 ==> iff) RB -> Proper (RA1 * RB1 ==> RA2 * RB2 ==> iff) (RA * RB)%signature. Proof. intros A B RA1 RA2 RB1 RB2 RA RB H H0. cbv in *. intros x y H1 x0 y0 H2. intuition eauto; destruct x as [a b], y as [a0 b0], x0 as [a1 b1], y0 as [a2 b2]; destruct H with a a0 a1 a2; destruct H0 with b b0 b1 b2; eauto. Qed. coq-8.20.0/theories/Classes/SetoidClass.v000066400000000000000000000113201466560755400202250ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* *) (* equivalence_setoid : Setoid A := *) (* equiv := eqA ; setoid_equiv := eqa. *) (** Shortcuts to make proof search easier. *) Definition setoid_refl `(sa : Setoid A) : Reflexive equiv. Proof. typeclasses eauto. Qed. Definition setoid_sym `(sa : Setoid A) : Symmetric equiv. Proof. typeclasses eauto. Qed. Definition setoid_trans `(sa : Setoid A) : Transitive equiv. Proof. typeclasses eauto. Qed. #[global] Existing Instance setoid_refl. #[global] Existing Instance setoid_sym. #[global] Existing Instance setoid_trans. (** Standard setoids. *) (* Program Instance eq_setoid : Setoid A := *) (* equiv := eq ; setoid_equiv := eq_equivalence. *) #[global] Program Instance iff_setoid : Setoid Prop := { equiv := iff ; setoid_equiv := iff_equivalence }. (** Overloaded notations for setoid equivalence and inequivalence. Not to be confused with [eq] and [=]. *) (** Subset objects should be first coerced to their underlying type, but that notation doesn't work in the standard case then. *) (* Notation " x == y " := (equiv (x :>) (y :>)) (at level 70, no associativity) : type_scope. *) Notation " x == y " := (equiv x y) (at level 70, no associativity) : type_scope. Notation " x =/= y " := (complement equiv x y) (at level 70, no associativity) : type_scope. (** Use the [clsubstitute] command which substitutes an equality in every hypothesis. *) Ltac clsubst H := lazymatch type of H with ?x == ?y => substitute H ; clear H x end. Ltac clsubst_nofail := match goal with | [ H : ?x == ?y |- _ ] => clsubst H ; clsubst_nofail | _ => idtac end. (** [subst*] will try its best at substituting every equality in the goal. *) Tactic Notation "clsubst" "*" := clsubst_nofail. Lemma nequiv_equiv_trans : forall `{Setoid A} (x y z : A), x =/= y -> y == z -> x =/= z. Proof with auto. intros A ? x y z H H0 H1. assert(z == y) by (symmetry ; auto). assert(x == y) by (transitivity z ; eauto). contradiction. Qed. Lemma equiv_nequiv_trans : forall `{Setoid A} (x y z : A), x == y -> y =/= z -> x =/= z. Proof. intros A ? x y z **; intro. assert(y == x) by (symmetry ; auto). assert(y == z) by (transitivity x ; eauto). contradiction. Qed. Ltac setoid_simplify_one := match goal with | [ H : (?x == ?x)%type |- _ ] => clear H | [ H : (?x == ?y)%type |- _ ] => clsubst H | [ |- (?x =/= ?y)%type ] => let name:=fresh "Hneq" in intro name end. Ltac setoid_simplify := repeat setoid_simplify_one. Ltac setoidify_tac := match goal with | [ s : Setoid ?A, H : ?R ?x ?y |- _ ] => change R with (@equiv A R s) in H | [ s : Setoid ?A |- context C [ ?R ?x ?y ] ] => change (R x y) with (@equiv A R s x y) end. Ltac setoidify := repeat setoidify_tac. (** Every setoid relation gives rise to a morphism, in fact every partial setoid does. *) #[global] Program Instance setoid_morphism `(sa : Setoid A) : Proper (equiv ++> equiv ++> iff) equiv := proper_prf. #[global] Program Instance setoid_partial_app_morphism `(sa : Setoid A) (x : A) : Proper (equiv ++> iff) (equiv x) := proper_prf. (** Partial setoids don't require reflexivity so we can build a partial setoid on the function space. *) Class PartialSetoid (A : Type) := { pequiv : relation A ; #[global] pequiv_prf :: PER pequiv }. (** Overloaded notation for partial setoid equivalence. *) Infix "=~=" := pequiv (at level 70, no associativity) : type_scope. (** Reset the default Program tactic. *) #[global] Obligation Tactic := program_simpl. #[export] Obligation Tactic := program_simpl. coq-8.20.0/theories/Classes/SetoidDec.v000066400000000000000000000076431466560755400176700ustar00rootroot00000000000000(* -*- coding: utf-8 -*- *) (************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* @right _ _ H | right H => @left _ _ H end. Require Import Coq.Program.Program. Local Open Scope program_scope. (** Invert the branches. *) Program Definition nequiv_dec `{EqDec A} (x y : A) : { x =/= y } + { x == y } := swap_sumbool (x == y). (** Overloaded notation for inequality. *) Infix "=/=" := nequiv_dec (no associativity, at level 70). (** Define boolean versions, losing the logical information. *) Definition equiv_decb `{EqDec A} (x y : A) : bool := if x == y then true else false. Definition nequiv_decb `{EqDec A} (x y : A) : bool := negb (equiv_decb x y). Infix "==b" := equiv_decb (no associativity, at level 70). Infix "<>b" := nequiv_decb (no associativity, at level 70). (** Decidable leibniz equality instances. *) Require Import Coq.Arith.Arith. (** The equiv is buried inside the setoid, but we can recover it by specifying which setoid we're talking about. *) #[global] Program Instance eq_setoid A : Setoid A | 10 := { equiv := eq ; setoid_equiv := eq_equivalence }. #[global] Program Instance nat_eq_eqdec : EqDec (eq_setoid nat) := eq_nat_dec. Require Import Coq.Bool.Bool. #[global] Program Instance bool_eqdec : EqDec (eq_setoid bool) := bool_dec. #[global] Program Instance unit_eqdec : EqDec (eq_setoid unit) := fun x y => in_left. Next Obligation. Proof. do 2 match goal with x : () |- _ => destruct x end. reflexivity. Qed. #[global] Program Instance prod_eqdec `(! EqDec (eq_setoid A), ! EqDec (eq_setoid B)) : EqDec (eq_setoid (prod A B)) := fun x y => let '(x1, x2) := x in let '(y1, y2) := y in if x1 == y1 then if x2 == y2 then in_left else in_right else in_right. Solve Obligations with unfold complement ; program_simpl. (** Objects of function spaces with countable domains like bool have decidable equality. *) #[global] Program Instance bool_function_eqdec `(! EqDec (eq_setoid A)) : EqDec (eq_setoid (bool -> A)) := fun f g => if f true == g true then if f false == g false then in_left else in_right else in_right. Solve Obligations with try red ; unfold complement ; program_simpl. Next Obligation. Proof. extensionality x. destruct x ; auto. Qed. coq-8.20.0/theories/Classes/SetoidTactics.v000066400000000000000000000145631466560755400205660ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* ?R' => red ; intros ; subst ; red_subst_eq_morphism R' | ?R ==> ?R' => red ; intros ; red_subst_eq_morphism R' | _ => idtac end. Ltac destruct_proper := match goal with | [ |- @Proper ?A ?R ?m ] => red end. Ltac reverse_arrows x := match x with | @Logic.eq ?A ==> ?R' => revert_last ; reverse_arrows R' | ?R ==> ?R' => do 3 revert_last ; reverse_arrows R' | _ => idtac end. Ltac default_add_morphism_tactic := unfold flip ; intros ; (try destruct_proper) ; match goal with | [ |- (?x ==> ?y) _ _ ] => red_subst_eq_morphism (x ==> y) ; reverse_arrows (x ==> y) end. Ltac add_morphism_tactic := default_add_morphism_tactic. #[global] Obligation Tactic := program_simpl. #[export] Obligation Tactic := program_simpl. (* Notation "'Morphism' s t " := (@Proper _ (s%signature) t) (at level 10, s at next level, t at next level). *) coq-8.20.0/theories/Compat/000077500000000000000000000000001466560755400154525ustar00rootroot00000000000000coq-8.20.0/theories/Compat/AdmitAxiom.v000066400000000000000000000017701466560755400177020ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* _ |- _ ] => specialize (H eq_refl) | [ H : ?x <> ?x -> _ |- _ ] => clear H | [ H : ?x < ?x -> _ |- _ ] => clear H | [ H : ?T -> _, H' : ?T |- _ ] => specialize (H H') | [ H : ?T -> _, H' : ~?T |- _ ] => clear H | [ H : ~?T -> _, H' : ?T |- _ ] => clear H | [ H : ?A -> ?x = ?x -> _ |- _ ] => specialize (fun a => H a eq_refl) | [ H : ?A -> ?x <> ?x -> _ |- _ ] => clear H | [ H : ?A -> ?x < ?x -> _ |- _ ] => clear H | [ H : ?A -> ?B -> _, H' : ?B |- _ ] => specialize (fun a => H a H') | [ H : ?A -> ?B -> _, H' : ~?B |- _ ] => clear H | [ H : ?A -> ~?B -> _, H' : ?B |- _ ] => clear H | [ H : 0 < ?x -> _, H' : ?x < 0 |- _ ] => clear H | [ H : ?x < 0 -> _, H' : 0 < ?x |- _ ] => clear H | [ H : ?A -> 0 < ?x -> _, H' : ?x < 0 |- _ ] => clear H | [ H : ?A -> ?x < 0 -> _, H' : 0 < ?x |- _ ] => clear H | [ H : 0 <= ?x -> _, H' : ?x < 0 |- _ ] => clear H | [ H : ?x <= 0 -> _, H' : 0 < ?x |- _ ] => clear H | [ H : ?A -> 0 <= ?x -> _, H' : ?x < 0 |- _ ] => clear H | [ H : ?A -> ?x <= 0 -> _, H' : 0 < ?x |- _ ] => clear H | [ H : 0 < ?x -> _, H' : ?x <= 0 |- _ ] => clear H | [ H : ?x < 0 -> _, H' : 0 <= ?x |- _ ] => clear H | [ H : ?A -> 0 < ?x -> _, H' : ?x <= 0 |- _ ] => clear H | [ H : ?A -> ?x < 0 -> _, H' : 0 <= ?x |- _ ] => clear H | [ H : 0 <= ?x -> _, H' : ?x <= 0 |- _ ] => specialize (fun pf => H (@Z.eq_le_incl 0 x (eq_sym pf))) | [ H : ?A -> 0 <= ?x -> _, H' : ?x <= 0 |- _ ] => specialize (fun a pf => H a (@Z.eq_le_incl 0 x (eq_sym pf))) | [ H : ?x <= 0 -> _, H' : 0 <= ?x |- _ ] => specialize (fun pf => H (@Z.eq_le_incl 0 x pf)) | [ H : ?A -> ?x <= 0 -> _, H' : 0 <= ?x |- _ ] => specialize (fun a pf => H a (@Z.eq_le_incl x 0 pf)) | [ H : ?x < ?y -> _, H' : ?x = ?y |- _ ] => clear H | [ H : ?x < ?y -> _, H' : ?y = ?x |- _ ] => clear H | [ H : ?A -> ?x < ?y -> _, H' : ?x = ?y |- _ ] => clear H | [ H : ?A -> ?x < ?y -> _, H' : ?y = ?x |- _ ] => clear H | [ H : ?x = ?y -> _, H' : ?x < ?y |- _ ] => clear H | [ H : ?x = ?y -> _, H' : ?y < ?x |- _ ] => clear H | [ H : ?A -> ?x = ?y -> _, H' : ?x < ?y |- _ ] => clear H | [ H : ?A -> ?x = ?y -> _, H' : ?y < ?x |- _ ] => clear H end. coq-8.20.0/theories/Compat/Coq819.v000066400000000000000000000014111466560755400166220ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* key -> elt -> tree -> int -> tree. Arguments tree : clear implicits. Section Elt. Variable elt : Type. Notation t := (tree elt). Implicit Types m : t. (** * Basic functions on trees: height and cardinal *) Definition height (m : t) : int := match m with | Leaf => 0 | Node _ _ _ _ h => h end. Fixpoint cardinal (m : t) : nat := match m with | Leaf => 0%nat | Node l _ _ r _ => S (cardinal l + cardinal r) end. (** * Empty Map *) Definition empty : t := Leaf. (** * Emptyness test *) Definition is_empty m := match m with Leaf => true | _ => false end. (** * Membership *) (** The [mem] function is deciding membership. It exploits the [bst] property to achieve logarithmic complexity. *) Fixpoint mem x m : bool := match m with | Leaf => false | Node l y _ r _ => match X.compare x y with | LT _ => mem x l | EQ _ => true | GT _ => mem x r end end. Fixpoint find x m : option elt := match m with | Leaf => None | Node l y d r _ => match X.compare x y with | LT _ => find x l | EQ _ => Some d | GT _ => find x r end end. (** * Helper functions *) (** [create l x r] creates a node, assuming [l] and [r] to be balanced and [|height l - height r| <= 2]. *) Definition create l x e r := Node l x e r (max (height l) (height r) + 1). (** [bal l x e r] acts as [create], but performs one step of rebalancing if necessary, i.e. assumes [|height l - height r| <= 3]. *) Definition assert_false := create. Definition bal l x d r := let hl := height l in let hr := height r in if gt_le_dec hl (hr+2) then match l with | Leaf => assert_false l x d r | Node ll lx ld lr _ => if ge_lt_dec (height ll) (height lr) then create ll lx ld (create lr x d r) else match lr with | Leaf => assert_false l x d r | Node lrl lrx lrd lrr _ => create (create ll lx ld lrl) lrx lrd (create lrr x d r) end end else if gt_le_dec hr (hl+2) then match r with | Leaf => assert_false l x d r | Node rl rx rd rr _ => if ge_lt_dec (height rr) (height rl) then create (create l x d rl) rx rd rr else match rl with | Leaf => assert_false l x d r | Node rll rlx rld rlr _ => create (create l x d rll) rlx rld (create rlr rx rd rr) end end else create l x d r. (** * Insertion *) Fixpoint add x d m := match m with | Leaf => Node Leaf x d Leaf 1 | Node l y d' r h => match X.compare x y with | LT _ => bal (add x d l) y d' r | EQ _ => Node l y d r h | GT _ => bal l y d' (add x d r) end end. (** * Extraction of minimum binding Morally, [remove_min] is to be applied to a non-empty tree [t = Node l x e r h]. Since we can't deal here with [assert false] for [t=Leaf], we pre-unpack [t] (and forget about [h]). *) Fixpoint remove_min l x d r : t*(key*elt) := match l with | Leaf => (r,(x,d)) | Node ll lx ld lr lh => let (l',m) := remove_min ll lx ld lr in (bal l' x d r, m) end. (** * Merging two trees [merge t1 t2] builds the union of [t1] and [t2] assuming all elements of [t1] to be smaller than all elements of [t2], and [|height t1 - height t2| <= 2]. *) Definition merge s1 s2 := match s1,s2 with | Leaf, _ => s2 | _, Leaf => s1 | _, Node l2 x2 d2 r2 h2 => match remove_min l2 x2 d2 r2 with (s2',(x,d)) => bal s1 x d s2' end end. (** * Deletion *) Fixpoint remove x m := match m with | Leaf => Leaf | Node l y d r h => match X.compare x y with | LT _ => bal (remove x l) y d r | EQ _ => merge l r | GT _ => bal l y d (remove x r) end end. (** * join Same as [bal] but does not assume anything regarding heights of [l] and [r]. *) Fixpoint join l : key -> elt -> t -> t := match l with | Leaf => add | Node ll lx ld lr lh => fun x d => fix join_aux (r:t) : t := match r with | Leaf => add x d l | Node rl rx rd rr rh => if gt_le_dec lh (rh+2) then bal ll lx ld (join lr x d r) else if gt_le_dec rh (lh+2) then bal (join_aux rl) rx rd rr else create l x d r end end. (** * Splitting [split x m] returns a triple [(l, o, r)] where - [l] is the set of elements of [m] that are [< x] - [r] is the set of elements of [m] that are [> x] - [o] is the result of [find x m]. *) Record triple := mktriple { t_left:t; t_opt:option elt; t_right:t }. Notation "<< l , b , r >>" := (mktriple l b r) (at level 9). Fixpoint split x m : triple := match m with | Leaf => << Leaf, None, Leaf >> | Node l y d r h => match X.compare x y with | LT _ => let (ll,o,rl) := split x l in << ll, o, join rl y d r >> | EQ _ => << l, Some d, r >> | GT _ => let (rl,o,rr) := split x r in << join l y d rl, o, rr >> end end. (** * Concatenation Same as [merge] but does not assume anything about heights. *) Definition concat m1 m2 := match m1, m2 with | Leaf, _ => m2 | _ , Leaf => m1 | _, Node l2 x2 d2 r2 _ => let (m2',xd) := remove_min l2 x2 d2 r2 in join m1 xd#1 xd#2 m2' end. (** * Elements *) (** [elements_tree_aux acc t] catenates the elements of [t] in infix order to the list [acc] *) Fixpoint elements_aux (acc : list (key*elt)) m : list (key*elt) := match m with | Leaf => acc | Node l x d r _ => elements_aux ((x,d) :: elements_aux acc r) l end. (** then [elements] is an instantiation with an empty [acc] *) Definition elements := elements_aux nil. (** * Fold *) Fixpoint fold (A : Type) (f : key -> elt -> A -> A) (m : t) : A -> A := fun a => match m with | Leaf => a | Node l x d r _ => fold f r (f x d (fold f l a)) end. (** * Comparison *) Variable cmp : elt->elt->bool. (** ** Enumeration of the elements of a tree *) Inductive enumeration := | End : enumeration | More : key -> elt -> t -> enumeration -> enumeration. (** [cons m e] adds the elements of tree [m] on the head of enumeration [e]. *) Fixpoint cons m e : enumeration := match m with | Leaf => e | Node l x d r h => cons l (More x d r e) end. (** One step of comparison of elements *) Definition equal_more x1 d1 (cont:enumeration->bool) e2 := match e2 with | End => false | More x2 d2 r2 e2 => match X.compare x1 x2 with | EQ _ => cmp d1 d2 &&& cont (cons r2 e2) | _ => false end end. (** Comparison of left tree, middle element, then right tree *) Fixpoint equal_cont m1 (cont:enumeration->bool) e2 := match m1 with | Leaf => cont e2 | Node l1 x1 d1 r1 _ => equal_cont l1 (equal_more x1 d1 (equal_cont r1 cont)) e2 end. (** Initial continuation *) Definition equal_end e2 := match e2 with End => true | _ => false end. (** The complete comparison *) Definition equal m1 m2 := equal_cont m1 equal_end (cons m2 End). End Elt. Notation t := tree. Arguments Leaf : clear implicits. Arguments Node [elt]. Notation "<< l , b , r >>" := (mktriple l b r) (at level 9). Notation "t #l" := (t_left t) (at level 9, format "t '#l'"). Notation "t #o" := (t_opt t) (at level 9, format "t '#o'"). Notation "t #r" := (t_right t) (at level 9, format "t '#r'"). (** * Map *) Fixpoint map (elt elt' : Type)(f : elt -> elt')(m : t elt) : t elt' := match m with | Leaf _ => Leaf _ | Node l x d r h => Node (map f l) x (f d) (map f r) h end. (* * Mapi *) Fixpoint mapi (elt elt' : Type)(f : key -> elt -> elt')(m : t elt) : t elt' := match m with | Leaf _ => Leaf _ | Node l x d r h => Node (mapi f l) x (f x d) (mapi f r) h end. (** * Map with removal *) Fixpoint map_option (elt elt' : Type)(f : key -> elt -> option elt')(m : t elt) : t elt' := match m with | Leaf _ => Leaf _ | Node l x d r h => match f x d with | Some d' => join (map_option f l) x d' (map_option f r) | None => concat (map_option f l) (map_option f r) end end. (** * Optimized map2 Suggestion by B. Gregoire: a [map2] function with specialized arguments that allows bypassing some tree traversal. Instead of one [f0] of type [key -> option elt -> option elt' -> option elt''], we ask here for: - [f] which is a specialisation of [f0] when first option isn't [None] - [mapl] treats a [tree elt] with [f0] when second option is [None] - [mapr] treats a [tree elt'] with [f0] when first option is [None] The idea is that [mapl] and [mapr] can be instantaneous (e.g. the identity or some constant function). *) Section Map2_opt. Variable elt elt' elt'' : Type. Variable f : key -> elt -> option elt' -> option elt''. Variable mapl : t elt -> t elt''. Variable mapr : t elt' -> t elt''. Fixpoint map2_opt m1 m2 := match m1, m2 with | Leaf _, _ => mapr m2 | _, Leaf _ => mapl m1 | Node l1 x1 d1 r1 h1, _ => let (l2',o2,r2') := split x1 m2 in match f x1 d1 o2 with | Some e => join (map2_opt l1 l2') x1 e (map2_opt r1 r2') | None => concat (map2_opt l1 l2') (map2_opt r1 r2') end end. End Map2_opt. (** * Map2 The [map2] function of the Map interface can be implemented via [map2_opt] and [map_option]. *) Section Map2. Variable elt elt' elt'' : Type. Variable f : option elt -> option elt' -> option elt''. Definition map2 : t elt -> t elt' -> t elt'' := map2_opt (fun _ d o => f (Some d) o) (map_option (fun _ d => f (Some d) None)) (map_option (fun _ d' => f None (Some d'))). End Map2. (** * Invariants *) Section Invariants. Variable elt : Type. (** ** Occurrence in a tree *) Inductive MapsTo (x : key)(e : elt) : t elt -> Prop := | MapsRoot : forall l r h y, X.eq x y -> MapsTo x e (Node l y e r h) | MapsLeft : forall l r h y e', MapsTo x e l -> MapsTo x e (Node l y e' r h) | MapsRight : forall l r h y e', MapsTo x e r -> MapsTo x e (Node l y e' r h). Inductive In (x : key) : t elt -> Prop := | InRoot : forall l r h y e, X.eq x y -> In x (Node l y e r h) | InLeft : forall l r h y e', In x l -> In x (Node l y e' r h) | InRight : forall l r h y e', In x r -> In x (Node l y e' r h). Definition In0 k m := exists e:elt, MapsTo k e m. (** ** Binary search trees *) (** [lt_tree x s]: all elements in [s] are smaller than [x] (resp. greater for [gt_tree]) *) Definition lt_tree x m := forall y, In y m -> X.lt y x. Definition gt_tree x m := forall y, In y m -> X.lt x y. (** [bst t] : [t] is a binary search tree *) Inductive bst : t elt -> Prop := | BSLeaf : bst (Leaf _) | BSNode : forall x e l r h, bst l -> bst r -> lt_tree x l -> gt_tree x r -> bst (Node l x e r h). End Invariants. (** * Correctness proofs, isolated in a sub-module *) Module Proofs. Module MX := OrderedTypeFacts X. Module PX := KeyOrderedType X. Module L := FMapList.Raw X. Functional Scheme mem_ind := Induction for mem Sort Prop. Functional Scheme find_ind := Induction for find Sort Prop. Functional Scheme bal_ind := Induction for bal Sort Prop. Functional Scheme add_ind := Induction for add Sort Prop. Functional Scheme remove_min_ind := Induction for remove_min Sort Prop. Functional Scheme merge_ind := Induction for merge Sort Prop. Functional Scheme remove_ind := Induction for remove Sort Prop. Functional Scheme concat_ind := Induction for concat Sort Prop. Functional Scheme split_ind := Induction for split Sort Prop. Functional Scheme map_option_ind := Induction for map_option Sort Prop. Functional Scheme map2_opt_ind := Induction for map2_opt Sort Prop. (** * Automation and dedicated tactics. *) #[global] Hint Constructors tree MapsTo In bst : core. #[global] Hint Unfold lt_tree gt_tree : core. Tactic Notation "factornode" ident(l) ident(x) ident(d) ident(r) ident(h) "as" ident(s) := set (s:=Node l x d r h) in *; clearbody s; clear l x d r h. (** A tactic for cleaning hypothesis after use of functional induction. *) Ltac clearf := match goal with | H := _ |- _ => subst; subst H; clearf | H : (@Logic.eq (Compare _ _ _ _) _ _) |- _ => clear H; clearf | H : (@Logic.eq (sumbool _ _) _ _) |- _ => clear H; clearf | _ => idtac end. (** A tactic to repeat [inversion_clear] on all hyps of the form [(f (Node ...))] *) Ltac inv f := match goal with | H:f (Leaf _) |- _ => inversion_clear H; inv f | H:f _ (Leaf _) |- _ => inversion_clear H; inv f | H:f _ _ (Leaf _) |- _ => inversion_clear H; inv f | H:f _ _ _ (Leaf _) |- _ => inversion_clear H; inv f | H:f (Node _ _ _ _ _) |- _ => inversion_clear H; inv f | H:f _ (Node _ _ _ _ _) |- _ => inversion_clear H; inv f | H:f _ _ (Node _ _ _ _ _) |- _ => inversion_clear H; inv f | H:f _ _ _ (Node _ _ _ _ _) |- _ => inversion_clear H; inv f | _ => idtac end. Ltac inv_all f := match goal with | H: f _ |- _ => inversion_clear H; inv f | H: f _ _ |- _ => inversion_clear H; inv f | H: f _ _ _ |- _ => inversion_clear H; inv f | H: f _ _ _ _ |- _ => inversion_clear H; inv f | _ => idtac end. (** Helper tactic concerning order of elements. *) Ltac order := match goal with | U: lt_tree _ ?s, V: In _ ?s |- _ => generalize (U _ V); clear U; order | U: gt_tree _ ?s, V: In _ ?s |- _ => generalize (U _ V); clear U; order | _ => MX.order end. Ltac intuition_in := repeat (intuition auto; inv In; inv MapsTo). (* Function/Functional Scheme can't deal with internal fix. Let's do its job by hand: *) Ltac join_tac := intros ?l; induction l as [| ?ll _ ?lx ?ld ?lr ?Hlr ?lh]; [ | intros ?x ?d ?r; induction r as [| ?rl ?Hrl ?rx ?rd ?rr _ ?rh]; unfold join; [ | destruct (gt_le_dec lh (rh+2)) as [?GT|?LE]; [ match goal with |- context [ bal ?u ?v ?w ?z ] => replace (bal u v w z) with (bal ll lx ld (join lr x d (Node rl rx rd rr rh))); [ | auto] end | destruct (gt_le_dec rh (lh+2)) as [?GT'|?LE']; [ match goal with |- context [ bal ?u ?v ?w ?z ] => replace (bal u v w z) with (bal (join (Node ll lx ld lr lh) x d rl) rx rd rr); [ | auto] end | ] ] ] ]; intros. Section Elt. Variable elt:Type. Implicit Types m r : t elt. (** * Basic results about [MapsTo], [In], [lt_tree], [gt_tree], [height] *) (** Facts about [MapsTo] and [In]. *) Lemma MapsTo_In : forall k e m, MapsTo k e m -> In k m. Proof. induction 1; auto. Qed. #[local] Hint Resolve MapsTo_In : core. Lemma In_MapsTo : forall k m, In k m -> exists e, MapsTo k e m. Proof. induction 1; try destruct IHIn as (e,He); exists e; auto. Qed. Lemma In_alt : forall k m, In0 k m <-> In k m. Proof. split. - intros (e,H); eauto. - unfold In0; apply In_MapsTo; auto. Qed. Lemma MapsTo_1 : forall m x y e, X.eq x y -> MapsTo x e m -> MapsTo y e m. Proof. induction m; simpl; intuition_in; eauto with ordered_type. Qed. #[local] Hint Immediate MapsTo_1 : core. Lemma In_1 : forall m x y, X.eq x y -> In x m -> In y m. Proof. intros m x y; induction m; simpl; intuition_in; eauto with ordered_type. Qed. Lemma In_node_iff : forall l x e r h y, In y (Node l x e r h) <-> In y l \/ X.eq y x \/ In y r. Proof. intuition_in. Qed. (** Results about [lt_tree] and [gt_tree] *) Lemma lt_leaf : forall x, lt_tree x (Leaf elt). Proof. unfold lt_tree; intros; intuition_in. Qed. Lemma gt_leaf : forall x, gt_tree x (Leaf elt). Proof. unfold gt_tree; intros; intuition_in. Qed. Lemma lt_tree_node : forall x y l r e h, lt_tree x l -> lt_tree x r -> X.lt y x -> lt_tree x (Node l y e r h). Proof. unfold lt_tree in *; intuition_in; order. Qed. Lemma gt_tree_node : forall x y l r e h, gt_tree x l -> gt_tree x r -> X.lt x y -> gt_tree x (Node l y e r h). Proof. unfold gt_tree in *; intuition_in; order. Qed. #[local] Hint Resolve lt_leaf gt_leaf lt_tree_node gt_tree_node : core. Lemma lt_left : forall x y l r e h, lt_tree x (Node l y e r h) -> lt_tree x l. Proof. intuition_in. Qed. Lemma lt_right : forall x y l r e h, lt_tree x (Node l y e r h) -> lt_tree x r. Proof. intuition_in. Qed. Lemma gt_left : forall x y l r e h, gt_tree x (Node l y e r h) -> gt_tree x l. Proof. intuition_in. Qed. Lemma gt_right : forall x y l r e h, gt_tree x (Node l y e r h) -> gt_tree x r. Proof. intuition_in. Qed. #[local] Hint Resolve lt_left lt_right gt_left gt_right : core. Lemma lt_tree_not_in : forall x m, lt_tree x m -> ~ In x m. Proof. intros; intro; generalize (H _ H0); order. Qed. Lemma lt_tree_trans : forall x y, X.lt x y -> forall m, lt_tree x m -> lt_tree y m. Proof. eauto with ordered_type. Qed. Lemma gt_tree_not_in : forall x m, gt_tree x m -> ~ In x m. Proof. intros; intro; generalize (H _ H0); order. Qed. Lemma gt_tree_trans : forall x y, X.lt y x -> forall m, gt_tree x m -> gt_tree y m. Proof. eauto with ordered_type. Qed. #[local] Hint Resolve lt_tree_not_in lt_tree_trans gt_tree_not_in gt_tree_trans : core. (** * Empty map *) Definition Empty m := forall (a:key)(e:elt) , ~ MapsTo a e m. Lemma empty_bst : bst (empty elt). Proof. unfold empty; auto. Qed. Lemma empty_1 : Empty (empty elt). Proof. unfold empty, Empty; intuition_in. Qed. (** * Emptyness test *) Lemma is_empty_1 : forall m, Empty m -> is_empty m = true. Proof. destruct m as [|r x e l h]; simpl; auto. intro H; elim (H x e); auto with ordered_type. Qed. Lemma is_empty_2 : forall m, is_empty m = true -> Empty m. Proof. destruct m; simpl; intros; try discriminate; red; intuition_in. Qed. (** * Membership *) Lemma mem_1 : forall m x, bst m -> In x m -> mem x m = true. Proof. intros m x; induction elt, x, m, (mem x m) using mem_ind; auto; intros; clearf; inv bst; intuition_in; order. Qed. Lemma mem_2 : forall m x, mem x m = true -> In x m. Proof. intros m x; induction elt, x, m, (mem x m) using mem_ind; auto; intros; discriminate. Qed. Lemma find_1 : forall m x e, bst m -> MapsTo x e m -> find x m = Some e. Proof. intros m x; induction elt, x, m, (find x m) using find_ind; auto; intros; clearf; inv bst; intuition_in; simpl; auto; try solve [order | absurd (X.lt x y); eauto with ordered_type | absurd (X.lt y x); eauto with ordered_type]. Qed. Lemma find_2 : forall m x e, find x m = Some e -> MapsTo x e m. Proof. intros m x; induction elt, x, m, (find x m) using find_ind; subst; intros; clearf; try discriminate. - constructor 2; auto. - inversion H; auto. - constructor 3; auto. Qed. Lemma find_iff : forall m x e, bst m -> (find x m = Some e <-> MapsTo x e m). Proof. split; auto using find_1, find_2. Qed. Lemma find_in : forall m x, find x m <> None -> In x m. Proof. intros. case_eq (find x m); [intros|congruence]. apply MapsTo_In with e; apply find_2; auto. Qed. Lemma in_find : forall m x, bst m -> In x m -> find x m <> None. Proof. intros. destruct (In_MapsTo H0) as (d,Hd). rewrite (find_1 H Hd); discriminate. Qed. Lemma find_in_iff : forall m x, bst m -> (find x m <> None <-> In x m). Proof. split; auto using find_in, in_find. Qed. Lemma not_find_iff : forall m x, bst m -> (find x m = None <-> ~In x m). Proof. split; intros. - red; intros. elim (in_find H H1 H0). - case_eq (find x m); [ intros | auto ]. elim H0; apply find_in; congruence. Qed. Lemma find_find : forall m m' x, find x m = find x m' <-> (forall d, find x m = Some d <-> find x m' = Some d). Proof. intros; destruct (find x m); destruct (find x m'); split; intros; try split; try congruence. - rewrite H; auto. - symmetry; rewrite <- H; auto. - rewrite H; auto. Qed. Lemma find_mapsto_equiv : forall m m' x, bst m -> bst m' -> (find x m = find x m' <-> (forall d, MapsTo x d m <-> MapsTo x d m')). Proof. intros m m' x Hm Hm'. rewrite find_find. split; intros H d; specialize H with d. - rewrite <- 2 find_iff; auto. - rewrite 2 find_iff; auto. Qed. Lemma find_in_equiv : forall m m' x, bst m -> bst m' -> find x m = find x m' -> (In x m <-> In x m'). Proof. split; intros; apply find_in; [ rewrite <- H1 | rewrite H1 ]; apply in_find; auto. Qed. (** * Helper functions *) Lemma create_bst : forall l x e r, bst l -> bst r -> lt_tree x l -> gt_tree x r -> bst (create l x e r). Proof. unfold create; auto. Qed. #[local] Hint Resolve create_bst : core. Lemma create_in : forall l x e r y, In y (create l x e r) <-> X.eq y x \/ In y l \/ In y r. Proof. unfold create; split; [ inversion_clear 1 | ]; intuition. Qed. Lemma bal_bst : forall l x e r, bst l -> bst r -> lt_tree x l -> gt_tree x r -> bst (bal l x e r). Proof. intros l x e r; induction elt, l, x, e, r, (bal l x e r) using bal_ind; subst; intros; clearf; inv bst; repeat apply create_bst; auto; unfold create; try constructor; (apply lt_tree_node || apply gt_tree_node); auto with ordered_type; (eapply lt_tree_trans || eapply gt_tree_trans); eauto with ordered_type. Qed. #[local] Hint Resolve bal_bst : core. Lemma bal_in : forall l x e r y, In y (bal l x e r) <-> X.eq y x \/ In y l \/ In y r. Proof. intros l x e r; induction elt, l, x, e, r, (bal l x e r) using bal_ind; subst; intros; clearf; rewrite !create_in; intuition_in. Qed. Lemma bal_mapsto : forall l x e r y e', MapsTo y e' (bal l x e r) <-> MapsTo y e' (create l x e r). Proof. intros l x e r; induction elt, l, x, e, r, (bal l x e r) using bal_ind; subst; intros; clearf; unfold assert_false, create; intuition_in. Qed. Lemma bal_find : forall l x e r y, bst l -> bst r -> lt_tree x l -> gt_tree x r -> find y (bal l x e r) = find y (create l x e r). Proof. intros; rewrite find_mapsto_equiv; auto; intros; apply bal_mapsto. Qed. (** * Insertion *) Lemma add_in : forall m x y e, In y (add x e m) <-> X.eq y x \/ In y m. Proof. intros m x y e; induction elt, x, e, m, (add x e m) using add_ind; clearf; auto; intros; try (rewrite bal_in, IHt); intuition_in. apply In_1 with x; auto with ordered_type. Qed. Lemma add_bst : forall m x e, bst m -> bst (add x e m). Proof. intros m x e; induction elt, x, e, m, (add x e m) using add_ind; clearf; intros; inv bst; try apply bal_bst; auto; intro z; rewrite add_in; intuition. - apply MX.eq_lt with x; auto. - apply MX.lt_eq with x; auto with ordered_type. Qed. #[local] Hint Resolve add_bst : core. Lemma add_1 : forall m x y e, X.eq x y -> MapsTo y e (add x e m). Proof. intros m x y e; induction elt, x, e, m, (add x e m) using add_ind; clearf; intros; inv bst; try rewrite bal_mapsto; unfold create; eauto with ordered_type. Qed. Lemma add_2 : forall m x y e e', ~X.eq x y -> MapsTo y e m -> MapsTo y e (add x e' m). Proof. intros m x y e e'; induction m; simpl; auto. destruct (X.compare x k); intros; inv bst; try rewrite bal_mapsto; unfold create; auto; inv MapsTo; auto; order. Qed. Lemma add_3 : forall m x y e e', ~X.eq x y -> MapsTo y e (add x e' m) -> MapsTo y e m. Proof. intros m x y e e'; induction m; simpl; auto. - intros; inv MapsTo; auto; order. - destruct (X.compare x k); intro; try rewrite bal_mapsto; auto; unfold create; intros; inv MapsTo; auto; order. Qed. Lemma add_find : forall m x y e, bst m -> find y (add x e m) = match X.compare y x with EQ _ => Some e | _ => find y m end. Proof. intros. assert (~X.eq x y -> find y (add x e m) = find y m). - intros; rewrite find_mapsto_equiv; auto. split; eauto using add_2, add_3. - destruct X.compare; try (apply H0; order). auto using find_1, add_1 with ordered_type. Qed. (** * Extraction of minimum binding *) Lemma remove_min_in : forall l x e r h y, In y (Node l x e r h) <-> X.eq y (remove_min l x e r)#2#1 \/ In y (remove_min l x e r)#1. Proof. intros l x e r; induction elt, l, x, e, r, (remove_min l x e r) using remove_min_ind; clearf; simpl in *; intros. - intuition_in. - rewrite e0 in *; simpl; intros. rewrite bal_in, In_node_iff, IHp; intuition. Qed. Lemma remove_min_mapsto : forall l x e r h y e', MapsTo y e' (Node l x e r h) <-> ((X.eq y (remove_min l x e r)#2#1) /\ e' = (remove_min l x e r)#2#2) \/ MapsTo y e' (remove_min l x e r)#1. Proof. intros l x e r; induction elt, l, x, e, r, (remove_min l x e r) using remove_min_ind; clearf; simpl in *; intros. - intuition_in; subst; auto. - rewrite e0 in *; simpl; intros. rewrite bal_mapsto; auto; unfold create. simpl in *;destruct (IHp _x y e'). intuition. + inversion_clear H1; intuition. + inversion_clear H3; intuition. Qed. Lemma remove_min_bst : forall l x e r h, bst (Node l x e r h) -> bst (remove_min l x e r)#1. Proof. intros l x e r; induction elt, l, x, e, r, (remove_min l x e r) using remove_min_ind; clearf; simpl in *; intros. - inv bst; auto. - inversion_clear H; inversion_clear H0. apply bal_bst; auto. + rewrite e0 in *; simpl in *; apply (IHp _x); auto. + intro; intros. generalize (remove_min_in ll lx ld lr _x y). rewrite e0; simpl in *. destruct 1. apply H2; intuition. Qed. #[local] Hint Resolve remove_min_bst : core. Lemma remove_min_gt_tree : forall l x e r h, bst (Node l x e r h) -> gt_tree (remove_min l x e r)#2#1 (remove_min l x e r)#1. Proof. intros l x e r; induction elt, l, x, e, r, (remove_min l x e r) using remove_min_ind; clearf; simpl in *; intros. - inv bst; auto. - inversion_clear H. intro; intro. rewrite e0 in *;simpl in *. generalize (IHp _x H0). generalize (remove_min_in ll lx ld lr _x m#1). rewrite e0; simpl; intros. rewrite (bal_in l' x d r y) in H. assert (In m#1 (Node ll lx ld lr _x)) by (rewrite H4; auto with ordered_type); clear H4. assert (X.lt m#1 x) by order. decompose [or] H; order. Qed. #[local] Hint Resolve remove_min_gt_tree : core. Lemma remove_min_find : forall l x e r h y, bst (Node l x e r h) -> find y (Node l x e r h) = match X.compare y (remove_min l x e r)#2#1 with | LT _ => None | EQ _ => Some (remove_min l x e r)#2#2 | GT _ => find y (remove_min l x e r)#1 end. Proof. intros. destruct X.compare. - rewrite not_find_iff; auto. rewrite remove_min_in; red; destruct 1 as [H'|H']; [ order | ]. generalize (remove_min_gt_tree H H'); order. - apply find_1; auto. rewrite remove_min_mapsto; auto. - rewrite find_mapsto_equiv; eauto; intros. rewrite remove_min_mapsto; intuition; order. Qed. (** * Merging two trees *) Lemma merge_in : forall m1 m2 y, bst m1 -> bst m2 -> (In y (merge m1 m2) <-> In y m1 \/ In y m2). Proof. intros m1 m2; induction elt, m1, m2, (merge m1 m2) using merge_ind; clearf; intros; try factornode _x _x0 _x1 _x2 _x3 as m1. - intuition_in. - intuition_in. - rewrite bal_in, remove_min_in, e1; simpl; intuition. Qed. Lemma merge_mapsto : forall m1 m2 y e, bst m1 -> bst m2 -> (MapsTo y e (merge m1 m2) <-> MapsTo y e m1 \/ MapsTo y e m2). Proof. intros m1 m2; induction elt, m1, m2, (merge m1 m2) using merge_ind; clearf; intros; try factornode _x _x0 _x1 _x2 _x3 as m1. - intuition_in. - intuition_in. - rewrite bal_mapsto, remove_min_mapsto, e1; simpl; auto. unfold create. intuition; subst; auto. inversion_clear H1; intuition. Qed. Lemma merge_bst : forall m1 m2, bst m1 -> bst m2 -> (forall y1 y2 : key, In y1 m1 -> In y2 m2 -> X.lt y1 y2) -> bst (merge m1 m2). Proof. intros m1 m2; induction elt, m1, m2, (merge m1 m2) using merge_ind; clearf; intros; auto; try factornode _x _x0 _x1 _x2 _x3 as m1. apply bal_bst; auto. - generalize (remove_min_bst H0); rewrite e1; simpl in *; auto. - intro; intro. apply H1; auto. generalize (remove_min_in l2 x2 d2 r2 _x4 x); rewrite e1; simpl; intuition auto with relations. - generalize (remove_min_gt_tree H0); rewrite e1; simpl; auto. Qed. (** * Deletion *) Lemma remove_in : forall m x y, bst m -> (In y (remove x m) <-> ~ X.eq y x /\ In y m). Proof. intros m x; induction elt, x, m, (remove x m) using remove_ind; subst T; simpl; intros. - intuition_in. - (* LT *) inv bst; clear e0. rewrite bal_in; auto. generalize (IHt y0 H0); intuition; [ order | order | intuition_in ]. - (* EQ *) inv bst; clear e0. rewrite merge_in; intuition; [ order | order | intuition_in ]. elim H4; eauto with ordered_type. - (* GT *) inv bst; clear e0. rewrite bal_in; auto. generalize (IHt y0 H1); intuition; [ order | order | intuition_in ]. Qed. Lemma remove_bst : forall m x, bst m -> bst (remove x m). Proof. intros m x; induction elt, x, m, (remove x m) using remove_ind; subst T; simpl; intros. - auto. - (* LT *) inv bst. apply bal_bst; auto. intro; intro. rewrite (remove_in x y0 H0) in H; auto. destruct H; eauto. - (* EQ *) inv bst. apply merge_bst; eauto with ordered_type. - (* GT *) inv bst. apply bal_bst; auto. intro; intro. rewrite (remove_in x y0 H1) in H; auto. destruct H; eauto. Qed. Lemma remove_1 : forall m x y, bst m -> X.eq x y -> ~ In y (remove x m). Proof. intros; rewrite remove_in; intuition auto with relations. Qed. Lemma remove_2 : forall m x y e, bst m -> ~X.eq x y -> MapsTo y e m -> MapsTo y e (remove x m). Proof. intros m x y e; induction m; simpl; auto. destruct (X.compare x k); intros; inv bst; try rewrite bal_mapsto; unfold create; auto; try solve [inv MapsTo; auto]. rewrite merge_mapsto; auto. inv MapsTo; auto; order. Qed. Lemma remove_3 : forall m x y e, bst m -> MapsTo y e (remove x m) -> MapsTo y e m. Proof. intros m x y e; induction m; simpl; auto. destruct (X.compare x k); intros Bs; inv bst; try rewrite bal_mapsto; auto; unfold create. - intros; inv MapsTo; auto. - rewrite merge_mapsto; intuition. - intros; inv MapsTo; auto. Qed. (** * join *) Lemma join_in : forall l x d r y, In y (join l x d r) <-> X.eq y x \/ In y l \/ In y r. Proof. join_tac. - simpl. rewrite add_in; intuition_in. - rewrite add_in; intuition_in. - rewrite bal_in, Hlr; clear Hlr Hrl; intuition_in. - rewrite bal_in, Hrl; clear Hlr Hrl; intuition_in. - apply create_in. Qed. Lemma join_bst : forall l x d r, bst l -> bst r -> lt_tree x l -> gt_tree x r -> bst (join l x d r). Proof. join_tac; auto; try (simpl; auto; fail); inv bst; apply bal_bst; auto; clear Hrl Hlr; intro; intros; rewrite join_in in *. - intuition; [ apply MX.lt_eq with x | ]; eauto with ordered_type. - intuition; [ apply MX.eq_lt with x | ]; eauto with ordered_type. Qed. #[local] Hint Resolve join_bst : core. Lemma join_find : forall l x d r y, bst l -> bst r -> lt_tree x l -> gt_tree x r -> find y (join l x d r) = find y (create l x d r). Proof. join_tac; auto; inv bst; simpl (join (Leaf elt)); try (assert (X.lt lx x) by auto with ordered_type); try (assert (X.lt x rx) by auto with ordered_type); rewrite ?add_find, ?bal_find; auto. - simpl; destruct X.compare; auto. rewrite not_find_iff; auto; intro; order. - simpl; repeat (destruct X.compare; auto); try (order; fail). rewrite not_find_iff by auto; intro. assert (X.lt y x) by auto; order. - simpl; rewrite Hlr; simpl; auto. repeat (destruct X.compare; auto); order. - intros u Hu; rewrite join_in in Hu. destruct Hu as [Hu|[Hu|Hu]]; try generalize (H2 _ Hu); order. - simpl; rewrite Hrl; simpl; auto. repeat (destruct X.compare; auto); order. - intros u Hu; rewrite join_in in Hu. destruct Hu as [Hu|[Hu|Hu]]; order. Qed. (** * split *) Lemma split_in_1 : forall m x, bst m -> forall y, (In y (split x m)#l <-> In y m /\ X.lt y x). Proof. intros m x; induction elt, x, m, (split x m) using split_ind; clearf; simpl; intros; inv bst; try clear e0. - intuition_in. - rewrite e1 in IHt; simpl in IHt; rewrite IHt; intuition_in; order. - intuition_in; order. - rewrite join_in. rewrite e1 in IHt; simpl in IHt; rewrite IHt; intuition_in; order. Qed. Lemma split_in_2 : forall m x, bst m -> forall y, (In y (split x m)#r <-> In y m /\ X.lt x y). Proof. intros m x; induction elt, x, m, (split x m) using split_ind; clearf; subst; simpl; intros; inv bst; try clear e0. - intuition_in. - rewrite join_in. rewrite e1 in IHt; simpl in IHt; rewrite IHt; intuition_in; order. - intuition_in; order. - rewrite e1 in IHt; simpl in IHt; rewrite IHt; intuition_in; order. Qed. Lemma split_in_3 : forall m x, bst m -> (split x m)#o = find x m. Proof. intros m x; induction elt, x, m, (split x m) using split_ind; clearf; subst; simpl; auto; intros; inv bst; try clear e0; destruct X.compare; try order; trivial; rewrite <- IHt, e1; auto. Qed. Lemma split_bst : forall m x, bst m -> bst (split x m)#l /\ bst (split x m)#r. Proof. intros m x; induction elt, x, m, (split x m) using split_ind; clearf; subst; simpl; intros; inv bst; try clear e0; try rewrite e1 in *; simpl in *; intuition; apply join_bst; auto. - intros y0. generalize (split_in_2 x H0 y0); rewrite e1; simpl; intuition. - intros y0. generalize (split_in_1 x H1 y0); rewrite e1; simpl; intuition. Qed. Lemma split_lt_tree : forall m x, bst m -> lt_tree x (split x m)#l. Proof. intros m x B y Hy; rewrite split_in_1 in Hy; intuition. Qed. Lemma split_gt_tree : forall m x, bst m -> gt_tree x (split x m)#r. Proof. intros m x B y Hy; rewrite split_in_2 in Hy; intuition. Qed. Lemma split_find : forall m x y, bst m -> find y m = match X.compare y x with | LT _ => find y (split x m)#l | EQ _ => (split x m)#o | GT _ => find y (split x m)#r end. Proof. intros m x; induction elt, x, m, (split x m) using split_ind; clearf; subst; simpl; intros; inv bst; try clear e0; try rewrite e1 in *; simpl in *; [ destruct X.compare; auto | .. ]; try match goal with E:split ?x ?t = _, B:bst ?t |- _ => generalize (split_in_1 x B)(split_in_2 x B)(split_bst x B); rewrite E; simpl; destruct 3 end. - rewrite join_find, IHt; auto; clear IHt; simpl. + repeat (destruct X.compare; auto); order. + intro y1; rewrite H4; intuition. - repeat (destruct X.compare; auto); order. - rewrite join_find, IHt; auto; clear IHt; simpl. + repeat (destruct X.compare; auto); order. + intros y1; rewrite H; intuition. Qed. (** * Concatenation *) Lemma concat_in : forall m1 m2 y, In y (concat m1 m2) <-> In y m1 \/ In y m2. Proof. intros m1 m2; induction elt, m1, m2, (concat m1 m2) using concat_ind; clearf; intros; try factornode _x _x0 _x1 _x2 _x3 as m1. - intuition_in. - intuition_in. - rewrite join_in, remove_min_in, e1; simpl; intuition. Qed. Lemma concat_bst : forall m1 m2, bst m1 -> bst m2 -> (forall y1 y2, In y1 m1 -> In y2 m2 -> X.lt y1 y2) -> bst (concat m1 m2). Proof. intros m1 m2; induction elt, m1, m2, (concat m1 m2) using concat_ind; clearf; intros; auto; try factornode _x _x0 _x1 _x2 _x3 as m1. apply join_bst; auto. - change (bst (m2',xd)#1). rewrite <-e1; eauto. - intros y Hy. apply H1; auto. rewrite remove_min_in, e1; simpl; auto with ordered_type. - change (gt_tree (m2',xd)#2#1 (m2',xd)#1). rewrite <-e1; eauto. Qed. #[local] Hint Resolve concat_bst : core. Lemma concat_find : forall m1 m2 y, bst m1 -> bst m2 -> (forall y1 y2, In y1 m1 -> In y2 m2 -> X.lt y1 y2) -> find y (concat m1 m2) = match find y m2 with Some d => Some d | None => find y m1 end. Proof. intros m1 m2; induction elt, m1, m2, (concat m1 m2) using concat_ind; clearf; intros; auto; try factornode _x _x0 _x1 _x2 _x3 as m1. - simpl; destruct (find y m2); auto. - generalize (remove_min_find y H0)(remove_min_in l2 x2 d2 r2 _x4) (remove_min_bst H0)(remove_min_gt_tree H0); rewrite e1; simpl fst; simpl snd; intros. inv bst. rewrite H2, join_find; auto; clear H2. + simpl; destruct X.compare as [Hlt| |Hlt]; simpl; auto. destruct (find y m2'); auto. symmetry; rewrite not_find_iff; auto; intro. apply (MX.lt_not_gt Hlt); apply H1; auto; rewrite H3; auto with ordered_type. + intros z Hz; apply H1; auto; rewrite H3; auto with ordered_type. Qed. (** * Elements *) Notation eqk := (PX.eqk (elt:= elt)). Notation eqke := (PX.eqke (elt:= elt)). Notation ltk := (PX.ltk (elt:= elt)). Lemma elements_aux_mapsto : forall (s:t elt) acc x e, InA eqke (x,e) (elements_aux acc s) <-> MapsTo x e s \/ InA eqke (x,e) acc. Proof. induction s as [ | l Hl x e r Hr h ]; simpl; auto. - intuition. inversion H0. - intros. rewrite Hl. destruct (Hr acc x0 e0); clear Hl Hr. intuition; inversion_clear H3; intuition auto with ordered_type. destruct H0; simpl in *; subst; intuition. Qed. Lemma elements_mapsto : forall (s:t elt) x e, InA eqke (x,e) (elements s) <-> MapsTo x e s. Proof. intros; generalize (elements_aux_mapsto s nil x e); intuition. inversion_clear H0. Qed. Lemma elements_in : forall (s:t elt) x, L.PX.In x (elements s) <-> In x s. Proof. intros. unfold L.PX.In. rewrite <- In_alt; unfold In0. firstorder. - exists x0. rewrite <- elements_mapsto; auto. - exists x0. unfold L.PX.MapsTo; rewrite elements_mapsto; auto. Qed. Lemma elements_aux_sort : forall (s:t elt) acc, bst s -> sort ltk acc -> (forall x e y, InA eqke (x,e) acc -> In y s -> X.lt y x) -> sort ltk (elements_aux acc s). Proof. induction s as [ | l Hl y e r Hr h]; simpl; intuition. inv bst. apply Hl; auto. - constructor. + apply Hr; eauto. + apply InA_InfA with (eqA:=eqke). * auto with typeclass_instances. * intros (y',e') H6. destruct (elements_aux_mapsto r acc y' e'); intuition. -- red; simpl; eauto. -- red; simpl; eauto with ordered_type. - intros x e0 y0 H H6. inversion_clear H. + destruct H7; simpl in *. order. + destruct (elements_aux_mapsto r acc x e0); intuition eauto with ordered_type. Qed. Lemma elements_sort : forall s : t elt, bst s -> sort ltk (elements s). Proof. intros; unfold elements; apply elements_aux_sort; auto. intros; inversion H0. Qed. #[local] Hint Resolve elements_sort : core. Lemma elements_nodup : forall s : t elt, bst s -> NoDupA eqk (elements s). Proof. intros; apply PX.Sort_NoDupA; auto. Qed. Lemma elements_aux_cardinal : forall (m:t elt) acc, (length acc + cardinal m)%nat = length (elements_aux acc m). Proof. simple induction m; simpl; intuition. rewrite <- H; simpl. rewrite <- H0, Nat.add_succ_r, (Nat.add_comm (cardinal t)), Nat.add_assoc. reflexivity. Qed. Lemma elements_cardinal : forall (m:t elt), cardinal m = length (elements m). Proof. exact (fun m => elements_aux_cardinal m nil). Qed. Lemma elements_app : forall (s:t elt) acc, elements_aux acc s = elements s ++ acc. Proof. induction s; simpl; intros; auto. rewrite IHs1, IHs2. unfold elements; simpl. rewrite 2 IHs1, IHs2, !app_nil_r, <- !app_assoc; auto. Qed. Lemma elements_node : forall (t1 t2:t elt) x e z l, elements t1 ++ (x,e) :: elements t2 ++ l = elements (Node t1 x e t2 z) ++ l. Proof. unfold elements; simpl; intros. rewrite !elements_app, !app_nil_r, <- !app_assoc; auto. Qed. (** * Fold *) Definition fold' (A : Type) (f : key -> elt -> A -> A)(s : t elt) := L.fold f (elements s). Lemma fold_equiv_aux : forall (A : Type) (s : t elt) (f : key -> elt -> A -> A) (a : A) acc, L.fold f (elements_aux acc s) a = L.fold f acc (fold f s a). Proof. simple induction s. - simpl; intuition. - simpl; intros. rewrite H. simpl. apply H0. Qed. Lemma fold_equiv : forall (A : Type) (s : t elt) (f : key -> elt -> A -> A) (a : A), fold f s a = fold' f s a. Proof. unfold fold', elements. simple induction s; simpl; auto; intros. rewrite fold_equiv_aux. rewrite H0. simpl; auto. Qed. Lemma fold_1 : forall (s:t elt)(Hs:bst s)(A : Type)(i:A)(f : key -> elt -> A -> A), fold f s i = fold_left (fun a p => f p#1 p#2 a) (elements s) i. Proof. intros. rewrite fold_equiv. unfold fold'. rewrite L.fold_1. unfold L.elements; auto. Qed. (** * Comparison *) (** [flatten_e e] returns the list of elements of the enumeration [e] i.e. the list of elements actually compared *) Fixpoint flatten_e (e : enumeration elt) : list (key*elt) := match e with | End _ => nil | More x e t r => (x,e) :: elements t ++ flatten_e r end. Lemma flatten_e_elements : forall (l:t elt) r x d z e, elements l ++ flatten_e (More x d r e) = elements (Node l x d r z) ++ flatten_e e. Proof. intros; apply elements_node. Qed. Lemma cons_1 : forall (s:t elt) e, flatten_e (cons s e) = elements s ++ flatten_e e. Proof. induction s; auto; intros. simpl flatten_e; rewrite IHs1; apply flatten_e_elements; auto. Qed. (** Proof of correction for the comparison *) Variable cmp : elt->elt->bool. Definition IfEq b l1 l2 := L.equal cmp l1 l2 = b. Lemma cons_IfEq : forall b x1 x2 d1 d2 l1 l2, X.eq x1 x2 -> cmp d1 d2 = true -> IfEq b l1 l2 -> IfEq b ((x1,d1)::l1) ((x2,d2)::l2). Proof. unfold IfEq; destruct b; simpl; intros; destruct X.compare; simpl; try rewrite H0; auto; order. Qed. Lemma equal_end_IfEq : forall e2, IfEq (equal_end e2) nil (flatten_e e2). Proof. destruct e2; red; auto. Qed. Lemma equal_more_IfEq : forall x1 d1 (cont:enumeration elt -> bool) x2 d2 r2 e2 l, IfEq (cont (cons r2 e2)) l (elements r2 ++ flatten_e e2) -> IfEq (equal_more cmp x1 d1 cont (More x2 d2 r2 e2)) ((x1,d1)::l) (flatten_e (More x2 d2 r2 e2)). Proof. unfold IfEq; simpl; intros; destruct X.compare; simpl; auto. rewrite <-andb_lazy_alt; f_equal; auto. Qed. Lemma equal_cont_IfEq : forall m1 cont e2 l, (forall e, IfEq (cont e) l (flatten_e e)) -> IfEq (equal_cont cmp m1 cont e2) (elements m1 ++ l) (flatten_e e2). Proof. induction m1 as [|l1 Hl1 x1 d1 r1 Hr1 h1]; intros; auto. rewrite <- elements_node; simpl. apply Hl1; auto. clear e2; intros [|x2 d2 r2 e2]. - simpl; red; auto. - apply equal_more_IfEq. rewrite <- cons_1; auto. Qed. Lemma equal_IfEq : forall (m1 m2:t elt), IfEq (equal cmp m1 m2) (elements m1) (elements m2). Proof. intros; unfold equal. rewrite <- (app_nil_r (elements m1)). replace (elements m2) with (flatten_e (cons m2 (End _))) by (rewrite cons_1; simpl; rewrite app_nil_r; auto). apply equal_cont_IfEq. intros. apply equal_end_IfEq; auto. Qed. Definition Equivb m m' := (forall k, In k m <-> In k m') /\ (forall k e e', MapsTo k e m -> MapsTo k e' m' -> cmp e e' = true). Lemma Equivb_elements : forall s s', Equivb s s' <-> L.Equivb cmp (elements s) (elements s'). Proof. unfold Equivb, L.Equivb; split; split; intros. - do 2 rewrite elements_in; firstorder. - destruct H. apply (H2 k); rewrite <- elements_mapsto; auto. - do 2 rewrite <- elements_in; firstorder. - destruct H. apply (H2 k); unfold L.PX.MapsTo; rewrite elements_mapsto; auto. Qed. Lemma equal_Equivb : forall (s s': t elt), bst s -> bst s' -> (equal cmp s s' = true <-> Equivb s s'). Proof. intros s s' B B'. rewrite Equivb_elements, <- equal_IfEq. split; [apply L.equal_2|apply L.equal_1]; auto. Qed. End Elt. Section Map. Variable elt elt' : Type. Variable f : elt -> elt'. Lemma map_1 : forall (m: t elt)(x:key)(e:elt), MapsTo x e m -> MapsTo x (f e) (map f m). Proof. induction m; simpl; inversion_clear 1; auto. Qed. Lemma map_2 : forall (m: t elt)(x:key), In x (map f m) -> In x m. Proof. induction m; simpl; inversion_clear 1; auto. Qed. Lemma map_bst : forall m, bst m -> bst (map f m). Proof. induction m; simpl; auto. inversion_clear 1; constructor; auto; red; auto using map_2. Qed. End Map. Section Mapi. Variable elt elt' : Type. Variable f : key -> elt -> elt'. Lemma mapi_1 : forall (m: tree elt)(x:key)(e:elt), MapsTo x e m -> exists y, X.eq y x /\ MapsTo x (f y e) (mapi f m). Proof. induction m; simpl; inversion_clear 1; auto. - exists k; auto with ordered_type. - destruct (IHm1 _ _ H0). exists x0; intuition. - destruct (IHm2 _ _ H0). exists x0; intuition. Qed. Lemma mapi_2 : forall (m: t elt)(x:key), In x (mapi f m) -> In x m. Proof. induction m; simpl; inversion_clear 1; auto. Qed. Lemma mapi_bst : forall m, bst m -> bst (mapi f m). Proof. induction m; simpl; auto. inversion_clear 1; constructor; auto; red; auto using mapi_2. Qed. End Mapi. Section Map_option. Variable elt elt' : Type. Variable f : key -> elt -> option elt'. Hypothesis f_compat : forall x x' d, X.eq x x' -> f x d = f x' d. Lemma map_option_2 : forall (m:t elt)(x:key), In x (map_option f m) -> exists d, MapsTo x d m /\ f x d <> None. Proof. intros m; induction elt, elt', f, m, (map_option f m) using map_option_ind; clearf; simpl; auto; intros. - inversion H. - rewrite join_in in H; destruct H as [H|[H|H]]. + exists d; split; auto; rewrite (f_compat d H), e0; discriminate. + destruct (IHt _ H) as (d0 & ? & ?); exists d0; auto. + destruct (IHt0 _ H) as (d0 & ? & ?); exists d0; auto. - rewrite concat_in in H; destruct H as [H|H]. + destruct (IHt _ H) as (d0 & ? & ?); exists d0; auto. + destruct (IHt0 _ H) as (d0 & ? & ?); exists d0; auto. Qed. Lemma map_option_bst : forall m, bst m -> bst (map_option f m). Proof. intros m; induction elt, elt', f, m, (map_option f m) using map_option_ind; clearf; simpl; auto; intros; inv bst. - apply join_bst; auto; intros y H; destruct (map_option_2 H) as (d0 & ? & ?); eauto using MapsTo_In. - apply concat_bst; auto; intros y y' H H'. destruct (map_option_2 H) as (d0 & ? & ?). destruct (map_option_2 H') as (d0' & ? & ?). eapply X.lt_trans with x; eauto using MapsTo_In. Qed. #[local] Hint Resolve map_option_bst : core. Ltac nonify e := replace e with (@None elt) by (symmetry; rewrite not_find_iff; auto; intro; order). Lemma map_option_find : forall (m:t elt)(x:key), bst m -> find x (map_option f m) = match (find x m) with Some d => f x d | None => None end. Proof. intros m; induction elt, elt', f, m, (map_option f m) using map_option_ind; clearf; simpl; auto; intros; inv bst; rewrite join_find || rewrite concat_find; auto; simpl; try destruct X.compare as [Hlt|Heq|Hlt]; simpl; auto. - rewrite (f_compat d Heq); auto. - intros y H; destruct (map_option_2 H) as (? & ? & ?); eauto using MapsTo_In. - intros y H; destruct (map_option_2 H) as (? & ? & ?); eauto using MapsTo_In. - rewrite <- IHt, IHt0; auto; nonify (find x0 r); auto. - rewrite IHt, IHt0; auto; nonify (find x0 r); nonify (find x0 l); auto. rewrite (f_compat d Heq); auto. - rewrite <- IHt0, IHt; auto; nonify (find x0 l); auto. destruct (find x0 (map_option f r)); auto. - intros y y' H H'. destruct (map_option_2 H) as (? & ? & ?). destruct (map_option_2 H') as (? & ? & ?). eapply X.lt_trans with x; eauto using MapsTo_In. Qed. End Map_option. Section Map2_opt. Variable elt elt' elt'' : Type. Variable f0 : key -> option elt -> option elt' -> option elt''. Variable f : key -> elt -> option elt' -> option elt''. Variable mapl : t elt -> t elt''. Variable mapr : t elt' -> t elt''. Hypothesis f0_f : forall x d o, f x d o = f0 x (Some d) o. Hypothesis mapl_bst : forall m, bst m -> bst (mapl m). Hypothesis mapr_bst : forall m', bst m' -> bst (mapr m'). Hypothesis mapl_f0 : forall x m, bst m -> find x (mapl m) = match find x m with Some d => f0 x (Some d) None | None => None end. Hypothesis mapr_f0 : forall x m', bst m' -> find x (mapr m') = match find x m' with Some d' => f0 x None (Some d') | None => None end. Hypothesis f0_compat : forall x x' o o', X.eq x x' -> f0 x o o' = f0 x' o o'. Notation map2_opt := (map2_opt f mapl mapr). Lemma map2_opt_2 : forall m m' y, bst m -> bst m' -> In y (map2_opt m m') -> In y m \/ In y m'. Proof. intros m m'; induction elt, elt', elt'', f, mapl, mapr, m, m', (map2_opt m m') using map2_opt_ind; clearf; intros; auto; try factornode _x0 _x1 _x2 _x3 _x4 as m2; try (generalize (split_in_1 x1 H0 y)(split_in_2 x1 H0 y) (split_bst x1 H0); rewrite e1; simpl; destruct 3; inv bst). - right; apply find_in. generalize (in_find (mapr_bst H0) H1); rewrite mapr_f0; auto. destruct (find y m2); auto; intros; discriminate. - factornode l1 x1 d1 r1 _x as m1. left; apply find_in. generalize (in_find (mapl_bst H) H1); rewrite mapl_f0; auto. destruct (find y m1); auto; intros; discriminate. - rewrite join_in in H1; destruct H1 as [H'|[H'|H']]; auto. + destruct (IHt1 y H6 H4 H'); intuition. + destruct (IHt0 y H7 H5 H'); intuition. - rewrite concat_in in H1; destruct H1 as [H'|H']; auto. + destruct (IHt1 y H6 H4 H'); intuition. + destruct (IHt0 y H7 H5 H'); intuition. Qed. Lemma map2_opt_bst : forall m m', bst m -> bst m' -> bst (map2_opt m m'). Proof. intros m m'; induction elt, elt', elt'', f, mapl, mapr, m, m', (map2_opt m m') using map2_opt_ind; clearf; intros; auto; try factornode _x0 _x1 _x2 _x3 _x4 as m2; inv bst; generalize (split_in_1 x1 H0)(split_in_2 x1 H0)(split_bst x1 H0); rewrite e1; simpl in *; destruct 3. - apply join_bst; auto. + intros y Hy; specialize H with y. destruct (map2_opt_2 H1 H6 Hy); intuition. + intros y Hy; specialize H5 with y. destruct (map2_opt_2 H2 H7 Hy); intuition. - apply concat_bst; auto. intros y y' Hy Hy'; specialize H with y; specialize H5 with y'. apply X.lt_trans with x1. + destruct (map2_opt_2 H1 H6 Hy); intuition. + destruct (map2_opt_2 H2 H7 Hy'); intuition. Qed. #[local] Hint Resolve map2_opt_bst : core. Ltac map2_aux := match goal with | H : In ?x _ \/ In ?x ?m, H' : find ?x ?m = find ?x ?m', B:bst ?m, B':bst ?m' |- _ => destruct H; [ intuition_in; order | rewrite <-(find_in_equiv B B' H'); auto ] end. Ltac nonify t := match t with (find ?y (map2_opt ?m ?m')) => replace t with (@None elt''); [ | symmetry; rewrite not_find_iff; auto; intro; destruct (@map2_opt_2 m m' y); auto; order ] end. Lemma map2_opt_1 : forall m m' y, bst m -> bst m' -> In y m \/ In y m' -> find y (map2_opt m m') = f0 y (find y m) (find y m'). Proof. intros m m'; induction elt, elt', elt'', f, mapl, mapr, m, m', (map2_opt m m') using map2_opt_ind; clearf; intros; auto; try factornode _x0 _x1 _x2 _x3 _x4 as m2; try (generalize (split_in_1 x1 H0)(split_in_2 x1 H0) (split_in_3 x1 H0)(split_bst x1 H0)(split_find x1 y H0) (split_lt_tree (x:=x1) H0)(split_gt_tree (x:=x1) H0); rewrite e1; simpl in *; destruct 4; intros; inv bst; subst o2; rewrite H7, ?join_find, ?concat_find; auto). - simpl; destruct H1; [ inversion_clear H1 | ]. rewrite mapr_f0; auto. generalize (in_find H0 H1); destruct (find y m2); intuition. - factornode l1 x1 d1 r1 _x as m1. destruct H1; [ | inversion_clear H1 ]. rewrite mapl_f0; auto. generalize (in_find H H1); destruct (find y m1); intuition. - simpl; destruct X.compare; auto. + apply IHt1; auto; map2_aux. + rewrite (@f0_compat y x1), <- f0_f; auto. + apply IHt0; auto; map2_aux. - intros z Hz; destruct (@map2_opt_2 l1 l2' z); auto. - intros z Hz; destruct (@map2_opt_2 r1 r2' z); auto. - destruct X.compare. + nonify (find y (map2_opt r1 r2')). apply IHt1; auto; map2_aux. + nonify (find y (map2_opt r1 r2')). nonify (find y (map2_opt l1 l2')). rewrite (@f0_compat y x1), <- f0_f; auto. + nonify (find y (map2_opt l1 l2')). rewrite IHt0; auto; [ | map2_aux ]. destruct (f0 y (find y r1) (find y r2')); auto. - intros y1 y2 Hy1 Hy2; apply X.lt_trans with x1. + destruct (@map2_opt_2 l1 l2' y1); auto. + destruct (@map2_opt_2 r1 r2' y2); auto. Qed. End Map2_opt. Section Map2. Variable elt elt' elt'' : Type. Variable f : option elt -> option elt' -> option elt''. Lemma map2_bst : forall m m', bst m -> bst m' -> bst (map2 f m m'). Proof. unfold map2; intros. apply map2_opt_bst with (fun _ => f); auto using map_option_bst; intros; rewrite map_option_find; auto. Qed. Lemma map2_1 : forall m m' y, bst m -> bst m' -> In y m \/ In y m' -> find y (map2 f m m') = f (find y m) (find y m'). Proof. unfold map2; intros. rewrite (map2_opt_1 (f0:=fun _ => f)); auto using map_option_bst; intros; rewrite map_option_find; auto. Qed. Lemma map2_2 : forall m m' y, bst m -> bst m' -> In y (map2 f m m') -> In y m \/ In y m'. Proof. unfold map2; intros. eapply map2_opt_2 with (f0:=fun _ => f); try eassumption; trivial; intros. - apply map_option_bst; auto. - apply map_option_bst; auto. - rewrite map_option_find; auto. - rewrite map_option_find; auto. Qed. End Map2. End Proofs. End Raw. (** * Encapsulation Now, in order to really provide a functor implementing [S], we need to encapsulate everything into a type of balanced binary search trees. *) Module IntMake (I:Int)(X: OrderedType) <: S with Module E := X. Module E := X. Module Raw := Raw I X. Import Raw.Proofs. #[universes(template)] Record bst (elt:Type) := Bst {this :> Raw.tree elt; is_bst : Raw.bst this}. Definition t := bst. Definition key := E.t. Section Elt. Variable elt elt' elt'': Type. Implicit Types m : t elt. Implicit Types x y : key. Implicit Types e : elt. Definition empty : t elt := Bst (empty_bst elt). Definition is_empty m : bool := Raw.is_empty (this m). Definition add x e m : t elt := Bst (add_bst x e (is_bst m)). Definition remove x m : t elt := Bst (remove_bst x (is_bst m)). Definition mem x m : bool := Raw.mem x (this m). Definition find x m : option elt := Raw.find x (this m). Definition map f m : t elt' := Bst (map_bst f (is_bst m)). Definition mapi (f:key->elt->elt') m : t elt' := Bst (mapi_bst f (is_bst m)). Definition map2 f m (m':t elt') : t elt'' := Bst (map2_bst f (is_bst m) (is_bst m')). Definition elements m : list (key*elt) := Raw.elements (this m). Definition cardinal m := Raw.cardinal (this m). Definition fold (A:Type) (f:key->elt->A->A) m i := Raw.fold (A:=A) f (this m) i. Definition equal cmp m m' : bool := Raw.equal cmp (this m) (this m'). Definition MapsTo x e m : Prop := Raw.MapsTo x e (this m). Definition In x m : Prop := Raw.In0 x (this m). Definition Empty m : Prop := Empty (this m). Definition eq_key : (key*elt) -> (key*elt) -> Prop := @PX.eqk elt. Definition eq_key_elt : (key*elt) -> (key*elt) -> Prop := @PX.eqke elt. Definition lt_key : (key*elt) -> (key*elt) -> Prop := @PX.ltk elt. Lemma MapsTo_1 : forall m x y e, E.eq x y -> MapsTo x e m -> MapsTo y e m. Proof. intros m; exact (@MapsTo_1 _ (this m)). Qed. Lemma mem_1 : forall m x, In x m -> mem x m = true. Proof. unfold In, mem; intros m x; rewrite In_alt; simpl; apply mem_1; auto. apply (is_bst m). Qed. Lemma mem_2 : forall m x, mem x m = true -> In x m. Proof. unfold In, mem; intros m x; rewrite In_alt; simpl; apply mem_2; auto. Qed. Lemma empty_1 : Empty empty. Proof. exact (@empty_1 elt). Qed. Lemma is_empty_1 : forall m, Empty m -> is_empty m = true. Proof. intros m; exact (@is_empty_1 _ (this m)). Qed. Lemma is_empty_2 : forall m, is_empty m = true -> Empty m. Proof. intros m; exact (@is_empty_2 _ (this m)). Qed. Lemma add_1 : forall m x y e, E.eq x y -> MapsTo y e (add x e m). Proof. intros m x y e; exact (@add_1 elt _ x y e). Qed. Lemma add_2 : forall m x y e e', ~ E.eq x y -> MapsTo y e m -> MapsTo y e (add x e' m). Proof. intros m x y e e'; exact (@add_2 elt _ x y e e'). Qed. Lemma add_3 : forall m x y e e', ~ E.eq x y -> MapsTo y e (add x e' m) -> MapsTo y e m. Proof. intros m x y e e'; exact (@add_3 elt _ x y e e'). Qed. Lemma remove_1 : forall m x y, E.eq x y -> ~ In y (remove x m). Proof. unfold In, remove; intros m x y; rewrite In_alt; simpl; apply remove_1; auto. apply (is_bst m). Qed. Lemma remove_2 : forall m x y e, ~ E.eq x y -> MapsTo y e m -> MapsTo y e (remove x m). Proof. intros m x y e; exact (@remove_2 elt _ x y e (is_bst m)). Qed. Lemma remove_3 : forall m x y e, MapsTo y e (remove x m) -> MapsTo y e m. Proof. intros m x y e; exact (@remove_3 elt _ x y e (is_bst m)). Qed. Lemma find_1 : forall m x e, MapsTo x e m -> find x m = Some e. Proof. intros m x e; exact (@find_1 elt _ x e (is_bst m)). Qed. Lemma find_2 : forall m x e, find x m = Some e -> MapsTo x e m. Proof. intros m; exact (@find_2 elt (this m)). Qed. Lemma fold_1 : forall m (A : Type) (i : A) (f : key -> elt -> A -> A), fold f m i = fold_left (fun a p => f (fst p) (snd p) a) (elements m) i. Proof. intros m; exact (@fold_1 elt (this m) (is_bst m)). Qed. Lemma elements_1 : forall m x e, MapsTo x e m -> InA eq_key_elt (x,e) (elements m). Proof. intros; unfold elements, MapsTo, eq_key_elt; rewrite elements_mapsto; auto. Qed. Lemma elements_2 : forall m x e, InA eq_key_elt (x,e) (elements m) -> MapsTo x e m. Proof. intros; unfold elements, MapsTo, eq_key_elt; rewrite <- elements_mapsto; auto. Qed. Lemma elements_3 : forall m, sort lt_key (elements m). Proof. intros m; exact (@elements_sort elt (this m) (is_bst m)). Qed. Lemma elements_3w : forall m, NoDupA eq_key (elements m). Proof. intros m; exact (@elements_nodup elt (this m) (is_bst m)). Qed. Lemma cardinal_1 : forall m, cardinal m = length (elements m). Proof. intro m; exact (@elements_cardinal elt (this m)). Qed. Definition Equal m m' := forall y, find y m = find y m'. Definition Equiv (eq_elt:elt->elt->Prop) m m' := (forall k, In k m <-> In k m') /\ (forall k e e', MapsTo k e m -> MapsTo k e' m' -> eq_elt e e'). Definition Equivb cmp := Equiv (Cmp cmp). Lemma Equivb_Equivb : forall cmp m m', Equivb cmp m m' <-> Raw.Proofs.Equivb cmp m m'. Proof. intros; unfold Equivb, Equiv, Raw.Proofs.Equivb, In. intuition. - generalize (H0 k); do 2 rewrite In_alt; intuition. - generalize (H0 k); do 2 rewrite In_alt; intuition. - generalize (H0 k); do 2 rewrite <- In_alt; intuition. - generalize (H0 k); do 2 rewrite <- In_alt; intuition. Qed. Lemma equal_1 : forall m m' cmp, Equivb cmp m m' -> equal cmp m m' = true. Proof. unfold equal; intros (m,b) (m',b') cmp; rewrite Equivb_Equivb; intros; simpl in *; rewrite equal_Equivb; auto. Qed. Lemma equal_2 : forall m m' cmp, equal cmp m m' = true -> Equivb cmp m m'. Proof. unfold equal; intros (m,b) (m',b') cmp; rewrite Equivb_Equivb; intros; simpl in *; rewrite <-equal_Equivb; auto. Qed. End Elt. Lemma map_1 : forall (elt elt':Type)(m: t elt)(x:key)(e:elt)(f:elt->elt'), MapsTo x e m -> MapsTo x (f e) (map f m). Proof. intros elt elt' m x e f; exact (@map_1 elt elt' f (this m) x e). Qed. Lemma map_2 : forall (elt elt':Type)(m:t elt)(x:key)(f:elt->elt'), In x (map f m) -> In x m. Proof. intros elt elt' m x f; do 2 unfold In in *; do 2 rewrite In_alt; simpl. apply map_2; auto. Qed. Lemma mapi_1 : forall (elt elt':Type)(m: t elt)(x:key)(e:elt) (f:key->elt->elt'), MapsTo x e m -> exists y, E.eq y x /\ MapsTo x (f y e) (mapi f m). Proof. intros elt elt' m x e f; exact (@mapi_1 elt elt' f (this m) x e). Qed. Lemma mapi_2 : forall (elt elt':Type)(m: t elt)(x:key) (f:key->elt->elt'), In x (mapi f m) -> In x m. Proof. intros elt elt' m x f; unfold In in *; do 2 rewrite In_alt; simpl; apply mapi_2; auto. Qed. Lemma map2_1 : forall (elt elt' elt'':Type)(m: t elt)(m': t elt') (x:key)(f:option elt->option elt'->option elt''), In x m \/ In x m' -> find x (map2 f m m') = f (find x m) (find x m'). Proof. unfold find, map2, In; intros elt elt' elt'' m m' x f. do 2 rewrite In_alt; intros; simpl; apply map2_1; auto. - apply (is_bst m). - apply (is_bst m'). Qed. Lemma map2_2 : forall (elt elt' elt'':Type)(m: t elt)(m': t elt') (x:key)(f:option elt->option elt'->option elt''), In x (map2 f m m') -> In x m \/ In x m'. Proof. unfold In, map2; intros elt elt' elt'' m m' x f. do 3 rewrite In_alt; intros; simpl in *; eapply map2_2; eauto. - apply (is_bst m). - apply (is_bst m'). Qed. End IntMake. Module IntMake_ord (I:Int)(X: OrderedType)(D : OrderedType) <: Sord with Module Data := D with Module MapS.E := X. Module Data := D. Module Import MapS := IntMake(I)(X). Module LO := FMapList.Make_ord(X)(D). Module R := Raw. Module P := Raw.Proofs. Definition t := MapS.t D.t. Definition cmp e e' := match D.compare e e' with EQ _ => true | _ => false end. (** One step of comparison of elements *) Definition compare_more x1 d1 (cont:R.enumeration D.t -> comparison) e2 := match e2 with | R.End _ => Gt | R.More x2 d2 r2 e2 => match X.compare x1 x2 with | EQ _ => match D.compare d1 d2 with | EQ _ => cont (R.cons r2 e2) | LT _ => Lt | GT _ => Gt end | LT _ => Lt | GT _ => Gt end end. (** Comparison of left tree, middle element, then right tree *) Fixpoint compare_cont s1 (cont:R.enumeration D.t -> comparison) e2 := match s1 with | R.Leaf _ => cont e2 | R.Node l1 x1 d1 r1 _ => compare_cont l1 (compare_more x1 d1 (compare_cont r1 cont)) e2 end. (** Initial continuation *) Definition compare_end (e2:R.enumeration D.t) := match e2 with R.End _ => Eq | _ => Lt end. (** The complete comparison *) Definition compare_pure s1 s2 := compare_cont s1 compare_end (R.cons s2 (Raw.End _)). (** Correctness of this comparison *) Definition Cmp c := match c with | Eq => LO.eq_list | Lt => LO.lt_list | Gt => (fun l1 l2 => LO.lt_list l2 l1) end. Lemma cons_Cmp : forall c x1 x2 d1 d2 l1 l2, X.eq x1 x2 -> D.eq d1 d2 -> Cmp c l1 l2 -> Cmp c ((x1,d1)::l1) ((x2,d2)::l2). Proof. destruct c; simpl; intros; P.MX.elim_comp; auto with ordered_type. Qed. #[global] Hint Resolve cons_Cmp : core. Lemma compare_end_Cmp : forall e2, Cmp (compare_end e2) nil (P.flatten_e e2). Proof. destruct e2; simpl; auto. Qed. Lemma compare_more_Cmp : forall x1 d1 cont x2 d2 r2 e2 l, Cmp (cont (R.cons r2 e2)) l (R.elements r2 ++ P.flatten_e e2) -> Cmp (compare_more x1 d1 cont (R.More x2 d2 r2 e2)) ((x1,d1)::l) (P.flatten_e (R.More x2 d2 r2 e2)). Proof. simpl; intros; destruct X.compare; simpl; try destruct D.compare; simpl; auto; P.MX.elim_comp; auto. Qed. Lemma compare_cont_Cmp : forall s1 cont e2 l, (forall e, Cmp (cont e) l (P.flatten_e e)) -> Cmp (compare_cont s1 cont e2) (R.elements s1 ++ l) (P.flatten_e e2). Proof. induction s1 as [|l1 Hl1 x1 d1 r1 Hr1 h1]; intros; auto. rewrite <- P.elements_node; simpl. apply Hl1; auto. clear e2. intros [|x2 d2 r2 e2]. - simpl; auto. - apply compare_more_Cmp. rewrite <- P.cons_1; auto. Qed. Lemma compare_Cmp : forall s1 s2, Cmp (compare_pure s1 s2) (R.elements s1) (R.elements s2). Proof. intros; unfold compare_pure. rewrite <- (app_nil_r (R.elements s1)). replace (R.elements s2) with (P.flatten_e (R.cons s2 (R.End _))) by (rewrite P.cons_1; simpl; rewrite app_nil_r; auto). auto using compare_cont_Cmp, compare_end_Cmp. Qed. (** The dependent-style [compare] *) Definition eq (m1 m2 : t) := LO.eq_list (elements m1) (elements m2). Definition lt (m1 m2 : t) := LO.lt_list (elements m1) (elements m2). Definition compare (s s':t) : Compare lt eq s s'. Proof. destruct s as (s,b), s' as (s',b'). generalize (compare_Cmp s s'). destruct compare_pure; intros; [apply EQ|apply LT|apply GT]; red; auto. Defined. (* Proofs about [eq] and [lt] *) Definition selements (m1 : t) := LO.MapS.Build_slist (P.elements_sort (is_bst m1)). Definition seq (m1 m2 : t) := LO.eq (selements m1) (selements m2). Definition slt (m1 m2 : t) := LO.lt (selements m1) (selements m2). Lemma eq_seq : forall m1 m2, eq m1 m2 <-> seq m1 m2. Proof. unfold eq, seq, selements, elements, LO.eq; intuition. Qed. Lemma lt_slt : forall m1 m2, lt m1 m2 <-> slt m1 m2. Proof. unfold lt, slt, selements, elements, LO.lt; intuition. Qed. Lemma eq_1 : forall (m m' : t), Equivb cmp m m' -> eq m m'. Proof. intros m m'. rewrite eq_seq; unfold seq. rewrite Equivb_Equivb. rewrite P.Equivb_elements. auto using LO.eq_1. Qed. Lemma eq_2 : forall m m', eq m m' -> Equivb cmp m m'. Proof. intros m m'. rewrite eq_seq; unfold seq. rewrite Equivb_Equivb. rewrite P.Equivb_elements. intros. generalize (LO.eq_2 H). auto. Qed. Lemma eq_refl : forall m : t, eq m m. Proof. intros; rewrite eq_seq; unfold seq; intros; apply LO.eq_refl. Qed. Lemma eq_sym : forall m1 m2 : t, eq m1 m2 -> eq m2 m1. Proof. intros m1 m2; rewrite 2 eq_seq; unfold seq; intros; apply LO.eq_sym; auto. Qed. Lemma eq_trans : forall m1 m2 m3 : t, eq m1 m2 -> eq m2 m3 -> eq m1 m3. Proof. intros m1 m2 M3; rewrite 3 eq_seq; unfold seq. intros; eapply LO.eq_trans; eauto. Qed. Lemma lt_trans : forall m1 m2 m3 : t, lt m1 m2 -> lt m2 m3 -> lt m1 m3. Proof. intros m1 m2 m3; rewrite 3 lt_slt; unfold slt; intros; eapply LO.lt_trans; eauto. Qed. Lemma lt_not_eq : forall m1 m2 : t, lt m1 m2 -> ~ eq m1 m2. Proof. intros m1 m2; rewrite lt_slt, eq_seq; unfold slt, seq; intros; apply LO.lt_not_eq; auto. Qed. End IntMake_ord. (* For concrete use inside Coq, we propose an instantiation of [Int] by [Z]. *) Module Make (X: OrderedType) <: S with Module E := X :=IntMake(Z_as_Int)(X). Module Make_ord (X: OrderedType)(D: OrderedType) <: Sord with Module Data := D with Module MapS.E := X :=IntMake_ord(Z_as_Int)(X)(D). coq-8.20.0/theories/FSets/FMapFacts.v000066400000000000000000002144021466560755400172510ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* constructor; congruence : core. (** * Facts about weak maps *) Module WFacts_fun (E:DecidableType)(Import M:WSfun E). Notation eq_dec := E.eq_dec. Definition eqb x y := if eq_dec x y then true else false. Lemma eq_bool_alt : forall b b', b=b' <-> (b=true <-> b'=true). Proof. destruct b; destruct b'; intuition. Qed. Lemma eq_option_alt : forall (elt:Type)(o o':option elt), o=o' <-> (forall e, o=Some e <-> o'=Some e). Proof. split; intros. - subst; split; auto. - destruct o; destruct o'; try rewrite H; auto. symmetry; rewrite <- H; auto. Qed. Lemma MapsTo_fun : forall (elt:Type) m x (e e':elt), MapsTo x e m -> MapsTo x e' m -> e=e'. Proof. intros. generalize (find_1 H) (find_1 H0); clear H H0. intros; rewrite H in H0; injection H0; auto. Qed. (** ** Specifications written using equivalences *) Section IffSpec. Variable elt elt' elt'': Type. Implicit Type m: t elt. Implicit Type x y z: key. Implicit Type e: elt. Lemma In_iff : forall m x y, E.eq x y -> (In x m <-> In y m). Proof. unfold In. split; intros (e0,H0); exists e0. - apply (MapsTo_1 H H0); auto. - apply (MapsTo_1 (E.eq_sym H) H0); auto. Qed. Lemma MapsTo_iff : forall m x y e, E.eq x y -> (MapsTo x e m <-> MapsTo y e m). Proof. split; apply MapsTo_1; auto. Qed. Lemma mem_in_iff : forall m x, In x m <-> mem x m = true. Proof. split; [apply mem_1|apply mem_2]. Qed. Lemma not_mem_in_iff : forall m x, ~In x m <-> mem x m = false. Proof. intros; rewrite mem_in_iff; destruct (mem x m); intuition. Qed. Lemma In_dec : forall m x, { In x m } + { ~ In x m }. Proof. intros. generalize (mem_in_iff m x). destruct (mem x m); [left|right]; intuition. Qed. Lemma find_mapsto_iff : forall m x e, MapsTo x e m <-> find x m = Some e. Proof. split; [apply find_1|apply find_2]. Qed. Lemma not_find_in_iff : forall m x, ~In x m <-> find x m = None. Proof. split; intros. - rewrite eq_option_alt. intro e. rewrite <- find_mapsto_iff. split; try discriminate. intro H'; elim H; exists e; auto. - intros (e,He); rewrite find_mapsto_iff,H in He; discriminate. Qed. Lemma in_find_iff : forall m x, In x m <-> find x m <> None. Proof. intros; rewrite <- not_find_in_iff, mem_in_iff. destruct mem; intuition. Qed. Lemma equal_iff : forall m m' cmp, Equivb cmp m m' <-> equal cmp m m' = true. Proof. split; [apply equal_1|apply equal_2]. Qed. Lemma empty_mapsto_iff : forall x e, MapsTo x e (empty elt) <-> False. Proof. intuition; apply (empty_1 H). Qed. Lemma empty_in_iff : forall x, In x (empty elt) <-> False. Proof. unfold In. split; [intros (e,H); rewrite empty_mapsto_iff in H|]; intuition. Qed. Lemma is_empty_iff : forall m, Empty m <-> is_empty m = true. Proof. split; [apply is_empty_1|apply is_empty_2]. Qed. Lemma add_mapsto_iff : forall m x y e e', MapsTo y e' (add x e m) <-> (E.eq x y /\ e=e') \/ (~E.eq x y /\ MapsTo y e' m). Proof. intros. intuition. - destruct (eq_dec x y); [left|right]. + split; auto. symmetry; apply (MapsTo_fun (e':=e) H); auto with map. + split; auto; apply add_3 with x e; auto. - subst; auto with map. Qed. Lemma add_in_iff : forall m x y e, In y (add x e m) <-> E.eq x y \/ In y m. Proof. unfold In; split. - intros (e',H). destruct (eq_dec x y) as [E|E]; auto. right; exists e'; auto. apply (add_3 E H). - destruct (eq_dec x y) as [E|E]; auto. + intros. exists e; apply add_1; auto. + intros [H|(e',H)]. * destruct E; auto. * exists e'; apply add_2; auto. Qed. Lemma add_neq_mapsto_iff : forall m x y e e', ~ E.eq x y -> (MapsTo y e' (add x e m) <-> MapsTo y e' m). Proof. split; [apply add_3|apply add_2]; auto. Qed. Lemma add_neq_in_iff : forall m x y e, ~ E.eq x y -> (In y (add x e m) <-> In y m). Proof. split; intros (e',H0); exists e'. - apply (add_3 H H0). - apply add_2; auto. Qed. Lemma remove_mapsto_iff : forall m x y e, MapsTo y e (remove x m) <-> ~E.eq x y /\ MapsTo y e m. Proof. intros. split; intros. - split. + assert (In y (remove x m)) by (exists e; auto). intro H1; apply (remove_1 H1 H0). + apply remove_3 with x; auto. - apply remove_2; intuition. Qed. Lemma remove_in_iff : forall m x y, In y (remove x m) <-> ~E.eq x y /\ In y m. Proof. unfold In; split. - intros (e,H). split. + assert (In y (remove x m)) by (exists e; auto). intro H1; apply (remove_1 H1 H0). + exists e; apply remove_3 with x; auto. - intros (H,(e,H0)); exists e; apply remove_2; auto. Qed. Lemma remove_neq_mapsto_iff : forall m x y e, ~ E.eq x y -> (MapsTo y e (remove x m) <-> MapsTo y e m). Proof. split; [apply remove_3|apply remove_2]; auto. Qed. Lemma remove_neq_in_iff : forall m x y, ~ E.eq x y -> (In y (remove x m) <-> In y m). Proof. split; intros (e',H0); exists e'. - apply (remove_3 H0). - apply remove_2; auto. Qed. Lemma elements_mapsto_iff : forall m x e, MapsTo x e m <-> InA (@eq_key_elt _) (x,e) (elements m). Proof. split; [apply elements_1 | apply elements_2]. Qed. Lemma elements_in_iff : forall m x, In x m <-> exists e, InA (@eq_key_elt _) (x,e) (elements m). Proof. unfold In; split; intros (e,H); exists e; [apply elements_1 | apply elements_2]; auto. Qed. Lemma map_mapsto_iff : forall m x b (f : elt -> elt'), MapsTo x b (map f m) <-> exists a, b = f a /\ MapsTo x a m. Proof. split. - case_eq (find x m); intros. + exists e. split. * apply (MapsTo_fun (m:=map f m) (x:=x)); auto with map. * apply find_2; auto with map. + assert (In x (map f m)) by (exists b; auto). destruct (map_2 H1) as (a,H2). rewrite (find_1 H2) in H; discriminate. - intros (a,(H,H0)). subst b; auto with map. Qed. Lemma map_in_iff : forall m x (f : elt -> elt'), In x (map f m) <-> In x m. Proof. split; intros; eauto with map. destruct H as (a,H). exists (f a); auto with map. Qed. Lemma mapi_in_iff : forall m x (f:key->elt->elt'), In x (mapi f m) <-> In x m. Proof. split; intros; eauto with map. destruct H as (a,H). destruct (mapi_1 f H) as (y,(H0,H1)). exists (f y a); auto. Qed. (** Unfortunately, we don't have simple equivalences for [mapi] and [MapsTo]. The only correct one needs compatibility of [f]. *) Lemma mapi_inv : forall m x b (f : key -> elt -> elt'), MapsTo x b (mapi f m) -> exists a y, E.eq y x /\ b = f y a /\ MapsTo x a m. Proof. intros; case_eq (find x m); intros. - exists e. destruct (@mapi_1 _ _ m x e f) as (y,(H1,H2)). + apply find_2; auto with map. + exists y; repeat split; auto with map. apply (MapsTo_fun (m:=mapi f m) (x:=x)); auto with map. - assert (In x (mapi f m)) by (exists b; auto). destruct (mapi_2 H1) as (a,H2). rewrite (find_1 H2) in H0; discriminate. Qed. Lemma mapi_1bis : forall m x e (f:key->elt->elt'), (forall x y e, E.eq x y -> f x e = f y e) -> MapsTo x e m -> MapsTo x (f x e) (mapi f m). Proof. intros. destruct (mapi_1 f H0) as (y,(H1,H2)). replace (f x e) with (f y e) by auto. auto. Qed. Lemma mapi_mapsto_iff : forall m x b (f:key->elt->elt'), (forall x y e, E.eq x y -> f x e = f y e) -> (MapsTo x b (mapi f m) <-> exists a, b = f x a /\ MapsTo x a m). Proof. split. - intros. destruct (mapi_inv H0) as (a,(y,(H1,(H2,H3)))). exists a; split; auto. subst b; auto. - intros (a,(H0,H1)). subst b. apply mapi_1bis; auto. Qed. (** Things are even worse for [map2] : we don't try to state any equivalence, see instead boolean results below. *) End IffSpec. (** Useful tactic for simplifying expressions like [In y (add x e (remove z m))] *) Ltac map_iff := repeat (progress ( rewrite add_mapsto_iff || rewrite add_in_iff || rewrite remove_mapsto_iff || rewrite remove_in_iff || rewrite empty_mapsto_iff || rewrite empty_in_iff || rewrite map_mapsto_iff || rewrite map_in_iff || rewrite mapi_in_iff)). (** ** Specifications written using boolean predicates *) Section BoolSpec. Lemma mem_find_b : forall (elt:Type)(m:t elt)(x:key), mem x m = if find x m then true else false. Proof. intros. generalize (find_mapsto_iff m x)(mem_in_iff m x); unfold In. destruct (find x m); destruct (mem x m); auto. - intros. rewrite <- H0; exists e; rewrite H; auto. - intuition. destruct H0 as (e,H0). destruct (H e); intuition discriminate. Qed. Variable elt elt' elt'' : Type. Implicit Types m : t elt. Implicit Types x y z : key. Implicit Types e : elt. Lemma mem_b : forall m x y, E.eq x y -> mem x m = mem y m. Proof. intros. generalize (mem_in_iff m x) (mem_in_iff m y)(In_iff m H). destruct (mem x m); destruct (mem y m); intuition. Qed. Lemma find_o : forall m x y, E.eq x y -> find x m = find y m. Proof. intros. rewrite eq_option_alt. intro e. rewrite <- 2 find_mapsto_iff. apply MapsTo_iff; auto. Qed. Lemma empty_o : forall x, find x (empty elt) = None. Proof. intros. rewrite eq_option_alt. intro e. rewrite <- find_mapsto_iff, empty_mapsto_iff; now intuition. Qed. Lemma empty_a : forall x, mem x (empty elt) = false. Proof. intros. case_eq (mem x (empty elt)); intros; auto. generalize (mem_2 H). rewrite empty_in_iff; intuition. Qed. Lemma add_eq_o : forall m x y e, E.eq x y -> find y (add x e m) = Some e. Proof. auto with map. Qed. Lemma add_neq_o : forall m x y e, ~ E.eq x y -> find y (add x e m) = find y m. Proof. intros. rewrite eq_option_alt. intro e'. rewrite <- 2 find_mapsto_iff. apply add_neq_mapsto_iff; auto. Qed. #[local] Hint Resolve add_neq_o : map. Lemma add_o : forall m x y e, find y (add x e m) = if eq_dec x y then Some e else find y m. Proof. intros; destruct (eq_dec x y); auto with map. Qed. Lemma add_eq_b : forall m x y e, E.eq x y -> mem y (add x e m) = true. Proof. intros; rewrite mem_find_b; rewrite add_eq_o; auto. Qed. Lemma add_neq_b : forall m x y e, ~E.eq x y -> mem y (add x e m) = mem y m. Proof. intros; do 2 rewrite mem_find_b; rewrite add_neq_o; auto. Qed. Lemma add_b : forall m x y e, mem y (add x e m) = eqb x y || mem y m. Proof. intros; do 2 rewrite mem_find_b; rewrite add_o; unfold eqb. destruct (eq_dec x y); simpl; auto. Qed. Lemma remove_eq_o : forall m x y, E.eq x y -> find y (remove x m) = None. Proof. intros. rewrite eq_option_alt. intro e. rewrite <- find_mapsto_iff, remove_mapsto_iff; now intuition. Qed. #[local] Hint Resolve remove_eq_o : map. Lemma remove_neq_o : forall m x y, ~ E.eq x y -> find y (remove x m) = find y m. Proof. intros. rewrite eq_option_alt. intro e. rewrite <- find_mapsto_iff, remove_neq_mapsto_iff; now intuition. Qed. #[local] Hint Resolve remove_neq_o : map. Lemma remove_o : forall m x y, find y (remove x m) = if eq_dec x y then None else find y m. Proof. intros; destruct (eq_dec x y); auto with map. Qed. Lemma remove_eq_b : forall m x y, E.eq x y -> mem y (remove x m) = false. Proof. intros; rewrite mem_find_b; rewrite remove_eq_o; auto. Qed. Lemma remove_neq_b : forall m x y, ~ E.eq x y -> mem y (remove x m) = mem y m. Proof. intros; do 2 rewrite mem_find_b; rewrite remove_neq_o; auto. Qed. Lemma remove_b : forall m x y, mem y (remove x m) = negb (eqb x y) && mem y m. Proof. intros; do 2 rewrite mem_find_b; rewrite remove_o; unfold eqb. destruct (eq_dec x y); auto. Qed. Lemma map_o : forall m x (f:elt->elt'), find x (map f m) = Datatypes.option_map f (find x m). Proof. intros. generalize (find_mapsto_iff (map f m) x) (find_mapsto_iff m x) (fun b => map_mapsto_iff m x b f). destruct (find x (map f m)); destruct (find x m); simpl; auto; intros. - rewrite <- H; rewrite H1; exists e0; rewrite H0; auto. - destruct (H e) as [_ H2]. rewrite H1 in H2. destruct H2 as (a,(_,H2)); auto. rewrite H0 in H2; discriminate. - rewrite <- H; rewrite H1; exists e; rewrite H0; auto. Qed. Lemma map_b : forall m x (f:elt->elt'), mem x (map f m) = mem x m. Proof. intros; do 2 rewrite mem_find_b; rewrite map_o. destruct (find x m); simpl; auto. Qed. Lemma mapi_b : forall m x (f:key->elt->elt'), mem x (mapi f m) = mem x m. Proof. intros. generalize (mem_in_iff (mapi f m) x) (mem_in_iff m x) (mapi_in_iff m x f). destruct (mem x (mapi f m)); destruct (mem x m); simpl; auto; intros. - symmetry; rewrite <- H0; rewrite <- H1; rewrite H; auto. - rewrite <- H; rewrite H1; rewrite H0; auto. Qed. Lemma mapi_o : forall m x (f:key->elt->elt'), (forall x y e, E.eq x y -> f x e = f y e) -> find x (mapi f m) = Datatypes.option_map (f x) (find x m). Proof. intros. generalize (find_mapsto_iff (mapi f m) x) (find_mapsto_iff m x) (fun b => mapi_mapsto_iff m x b H). destruct (find x (mapi f m)); destruct (find x m); simpl; auto; intros. - rewrite <- H0; rewrite H2; exists e0; rewrite H1; auto. - destruct (H0 e) as [_ H3]. rewrite H2 in H3. destruct H3 as (a,(_,H3)); auto. rewrite H1 in H3; discriminate. - rewrite <- H0; rewrite H2; exists e; rewrite H1; auto. Qed. Lemma map2_1bis : forall (m: t elt)(m': t elt') x (f:option elt->option elt'->option elt''), f None None = None -> find x (map2 f m m') = f (find x m) (find x m'). Proof. intros. case_eq (find x m); intros. - rewrite <- H0. apply map2_1; auto with map. left; exists e; auto with map. - case_eq (find x m'); intros. + rewrite <- H0; rewrite <- H1. apply map2_1; auto. right; exists e; auto with map. + rewrite H. case_eq (find x (map2 f m m')); intros; auto with map. assert (In x (map2 f m m')) by (exists e; auto with map). destruct (map2_2 H3) as [(e0,H4)|(e0,H4)]. * rewrite (find_1 H4) in H0; discriminate. * rewrite (find_1 H4) in H1; discriminate. Qed. Lemma elements_o : forall m x, find x m = findA (eqb x) (elements m). Proof. intros. rewrite eq_option_alt. intro e. rewrite <- find_mapsto_iff, elements_mapsto_iff. unfold eqb. rewrite <- findA_NoDupA; dintuition; try apply elements_3w; eauto. Qed. Lemma elements_b : forall m x, mem x m = existsb (fun p => eqb x (fst p)) (elements m). Proof. intros. generalize (mem_in_iff m x)(elements_in_iff m x) (existsb_exists (fun p => eqb x (fst p)) (elements m)). destruct (mem x m); destruct (existsb (fun p => eqb x (fst p)) (elements m)); auto; intros. - symmetry; rewrite H1. destruct H0 as (H0,_). destruct H0 as (e,He); [ intuition |]. rewrite InA_alt in He. destruct He as ((y,e'),(Ha1,Ha2)). compute in Ha1; destruct Ha1; subst e'. exists (y,e); split; simpl; auto. unfold eqb; destruct (eq_dec x y); intuition. - rewrite <- H; rewrite H0. destruct H1 as (H1,_). destruct H1 as ((y,e),(Ha1,Ha2)); [intuition|]. simpl in Ha2. unfold eqb in *; destruct (eq_dec x y); auto; try discriminate. exists e; rewrite InA_alt. exists (y,e); intuition. compute; auto. Qed. End BoolSpec. Section Equalities. Variable elt:Type. (** Another characterisation of [Equal] *) Lemma Equal_mapsto_iff : forall m1 m2 : t elt, Equal m1 m2 <-> (forall k e, MapsTo k e m1 <-> MapsTo k e m2). Proof. intros m1 m2. split; [intros Heq k e|intros Hiff]. - rewrite 2 find_mapsto_iff, Heq. split; auto. - intro k. rewrite eq_option_alt. intro e. rewrite <- 2 find_mapsto_iff; auto. Qed. (** * Relations between [Equal], [Equiv] and [Equivb]. *) (** First, [Equal] is [Equiv] with Leibniz on elements. *) Lemma Equal_Equiv : forall (m m' : t elt), Equal m m' <-> Equiv Logic.eq m m'. Proof. intros. rewrite Equal_mapsto_iff. split; intros. - split. + split; intros (e,Hin); exists e; [rewrite <- H|rewrite H]; auto. + intros; apply MapsTo_fun with m k; auto; rewrite H; auto. - split; intros H'. + destruct H. assert (Hin : In k m') by (rewrite <- H; exists e; auto). destruct Hin as (e',He'). rewrite (H0 k e e'); auto. + destruct H. assert (Hin : In k m) by (rewrite H; exists e; auto). destruct Hin as (e',He'). rewrite <- (H0 k e' e); auto. Qed. (** [Equivb] and [Equiv] and equivalent when [eq_elt] and [cmp] are related. *) Section Cmp. Variable eq_elt : elt->elt->Prop. Variable cmp : elt->elt->bool. Definition compat_cmp := forall e e', cmp e e' = true <-> eq_elt e e'. Lemma Equiv_Equivb : compat_cmp -> forall m m', Equiv eq_elt m m' <-> Equivb cmp m m'. Proof. unfold Equivb, Equiv, Cmp; intuition. - red in H; rewrite H; eauto. - red in H; rewrite <-H; eauto. Qed. End Cmp. (** Composition of the two last results: relation between [Equal] and [Equivb]. *) Lemma Equal_Equivb : forall cmp, (forall e e', cmp e e' = true <-> e = e') -> forall (m m':t elt), Equal m m' <-> Equivb cmp m m'. Proof. intros; rewrite Equal_Equiv. apply Equiv_Equivb; auto. Qed. Lemma Equal_Equivb_eqdec : forall eq_elt_dec : (forall e e', { e = e' } + { e <> e' }), let cmp := fun e e' => if eq_elt_dec e e' then true else false in forall (m m':t elt), Equal m m' <-> Equivb cmp m m'. Proof. intros; apply Equal_Equivb. unfold cmp; clear cmp; intros. destruct eq_elt_dec; now intuition. Qed. End Equalities. (** * [Equal] is a setoid equality. *) Lemma Equal_refl : forall (elt:Type)(m : t elt), Equal m m. Proof. red; reflexivity. Qed. Lemma Equal_sym : forall (elt:Type)(m m' : t elt), Equal m m' -> Equal m' m. Proof. unfold Equal; auto. Qed. Lemma Equal_trans : forall (elt:Type)(m m' m'' : t elt), Equal m m' -> Equal m' m'' -> Equal m m''. Proof. unfold Equal; congruence. Qed. Definition Equal_ST : forall elt:Type, Equivalence (@Equal elt). Proof. constructor; red; [apply Equal_refl | apply Equal_sym | apply Equal_trans]. Qed. Add Relation key E.eq reflexivity proved by E.eq_refl symmetry proved by E.eq_sym transitivity proved by E.eq_trans as KeySetoid. Arguments Equal {elt} m m'. Add Parametric Relation (elt : Type) : (t elt) Equal reflexivity proved by (@Equal_refl elt) symmetry proved by (@Equal_sym elt) transitivity proved by (@Equal_trans elt) as EqualSetoid. Add Parametric Morphism elt : (@In elt) with signature E.eq ==> Equal ==> iff as In_m. Proof. unfold Equal; intros k k' Hk m m' Hm. rewrite (In_iff m Hk), in_find_iff, in_find_iff, Hm; intuition. Qed. Add Parametric Morphism elt : (@MapsTo elt) with signature E.eq ==> eq ==> Equal ==> iff as MapsTo_m. Proof. unfold Equal; intros k k' Hk e m m' Hm. rewrite (MapsTo_iff m e Hk), find_mapsto_iff, find_mapsto_iff, Hm; intuition. Qed. Add Parametric Morphism elt : (@Empty elt) with signature Equal ==> iff as Empty_m. Proof. unfold Empty; intros m m' Hm. split; intros; intro. - rewrite <-Hm in H0; eapply H, H0. - rewrite Hm in H0; eapply H, H0. Qed. Add Parametric Morphism elt : (@is_empty elt) with signature Equal ==> eq as is_empty_m. Proof. intros m m' Hm. rewrite eq_bool_alt, <-is_empty_iff, <-is_empty_iff, Hm; intuition. Qed. Add Parametric Morphism elt : (@mem elt) with signature E.eq ==> Equal ==> eq as mem_m. Proof. intros k k' Hk m m' Hm. rewrite eq_bool_alt, <- mem_in_iff, <-mem_in_iff, Hk, Hm; intuition. Qed. Add Parametric Morphism elt : (@find elt) with signature E.eq ==> Equal ==> eq as find_m. Proof. intros k k' Hk m m' Hm. rewrite eq_option_alt. intro e. rewrite <- 2 find_mapsto_iff, Hk, Hm. split; auto. Qed. Add Parametric Morphism elt : (@add elt) with signature E.eq ==> eq ==> Equal ==> Equal as add_m. Proof. intros k k' Hk e m m' Hm y. rewrite add_o, add_o; do 2 destruct eq_dec as [|?Hnot]; auto. - elim Hnot; rewrite <-Hk; auto. - elim Hnot; rewrite Hk; auto. Qed. Add Parametric Morphism elt : (@remove elt) with signature E.eq ==> Equal ==> Equal as remove_m. Proof. intros k k' Hk m m' Hm y. rewrite remove_o, remove_o; do 2 destruct eq_dec as [|?Hnot]; auto. - elim Hnot; rewrite <-Hk; auto. - elim Hnot; rewrite Hk; auto. Qed. Add Parametric Morphism elt elt' : (@map elt elt') with signature eq ==> Equal ==> Equal as map_m. Proof. intros f m m' Hm y. rewrite map_o, map_o, Hm; auto. Qed. (* Later: Add Morphism cardinal *) (* old name: *) Notation not_find_mapsto_iff := not_find_in_iff. End WFacts_fun. (** * Same facts for self-contained weak sets and for full maps *) Module WFacts (M:WS) := WFacts_fun M.E M. Module Facts := WFacts. (** * Additional Properties for weak maps Results about [fold], [elements], induction principles... *) Module WProperties_fun (E:DecidableType)(M:WSfun E). Module Import F:=WFacts_fun E M. Import M. Section Elt. Variable elt:Type. Definition Add x (e:elt) m m' := forall y, find y m' = find y (add x e m). Lemma Add_transpose_neqkey : forall k1 k2 e1 e2 m1 m2 m3, ~ E.eq k1 k2 -> Add k1 e1 m1 m2 -> Add k2 e2 m2 m3 -> { m | Add k2 e2 m1 m /\ Add k1 e1 m m3 }. Proof. intros. exists (add k2 e2 m1). split. easy. unfold Add; intros. rewrite H1. destruct (E.eq_dec k1 y). - assert (~ E.eq k2 y). contradict H. apply E.eq_trans with (y:=y); auto. now rewrite add_neq_o, add_eq_o, H0, add_eq_o by assumption. - destruct (E.eq_dec k2 y). + now rewrite add_eq_o, add_neq_o, add_eq_o by assumption. + now rewrite add_neq_o, H0, add_neq_o, add_neq_o, add_neq_o by assumption. Qed. Notation eqke := (@eq_key_elt elt). Notation eqk := (@eq_key elt). Instance eqk_equiv : Equivalence eqk. Proof. unfold eq_key; split; eauto. Qed. Instance eqke_equiv : Equivalence eqke. Proof. unfold eq_key_elt; split; repeat red; firstorder. - eauto. - congruence. Qed. (** Complements about InA, NoDupA and findA *) Lemma InA_eqke_eqk : forall k1 k2 e1 e2 l, E.eq k1 k2 -> InA eqke (k1,e1) l -> InA eqk (k2,e2) l. Proof. intros k1 k2 e1 e2 l Hk. rewrite 2 InA_alt. intros ((k',e') & (Hk',He') & H); simpl in *. exists (k',e'); split; auto. red; simpl; eauto. Qed. Lemma NoDupA_eqk_eqke : forall l, NoDupA eqk l -> NoDupA eqke l. Proof. induction 1; auto. constructor; auto. destruct x as (k,e). eauto using InA_eqke_eqk. Qed. Lemma findA_rev : forall l k, NoDupA eqk l -> findA (eqb k) l = findA (eqb k) (rev l). Proof. intros. case_eq (findA (eqb k) l). - intros. symmetry. unfold eqb. rewrite <- findA_NoDupA, InA_rev, findA_NoDupA by (eauto using NoDupA_rev with *); eauto. - case_eq (findA (eqb k) (rev l)); auto. intros e. unfold eqb. rewrite <- findA_NoDupA, InA_rev, findA_NoDupA by (eauto using NoDupA_rev with *). intro Eq; rewrite Eq; auto. Qed. (** * Elements *) Lemma elements_Empty : forall m:t elt, Empty m <-> elements m = nil. Proof. intros. unfold Empty. split; intros. - assert (forall a, ~ List.In a (elements m)). { red; intros. apply (H (fst a) (snd a)). rewrite elements_mapsto_iff. rewrite InA_alt; exists a; auto. split; auto; split; auto. } destruct (elements m); auto. elim (H0 p); simpl; auto. - red; intros. rewrite elements_mapsto_iff in H0. rewrite InA_alt in H0; destruct H0. rewrite H in H0; destruct H0 as (_,H0); inversion H0. Qed. Lemma elements_empty : elements (@empty elt) = nil. Proof. rewrite <-elements_Empty; apply empty_1. Qed. (** * Conversions between maps and association lists. *) Definition uncurry {U V W : Type} (f : U -> V -> W) : U*V -> W := fun p => f (fst p) (snd p). Definition of_list := List.fold_right (uncurry (@add _)) (empty elt). Definition to_list := elements. Lemma of_list_1 : forall l k e, NoDupA eqk l -> (MapsTo k e (of_list l) <-> InA eqke (k,e) l). Proof. induction l as [|(k',e') l IH]; simpl; intros k e Hnodup. - rewrite empty_mapsto_iff, InA_nil; intuition. - unfold uncurry; simpl. inversion_clear Hnodup as [| ? ? Hnotin Hnodup']. specialize (IH k e Hnodup'); clear Hnodup'. rewrite add_mapsto_iff, InA_cons, <- IH. unfold eq_key_elt at 1; simpl. split; destruct 1 as [H|H]; try (intuition;fail). destruct (eq_dec k k'); [left|right]; split; auto. contradict Hnotin. apply InA_eqke_eqk with k e; intuition. Qed. Lemma of_list_1b : forall l k, NoDupA eqk l -> find k (of_list l) = findA (eqb k) l. Proof. induction l as [|(k',e') l IH]; simpl; intros k Hnodup. - apply empty_o. - unfold uncurry; simpl. inversion_clear Hnodup as [| ? ? Hnotin Hnodup']. specialize (IH k Hnodup'); clear Hnodup'. rewrite add_o, IH. unfold eqb; do 2 destruct eq_dec as [|?Hnot]; auto; elim Hnot; eauto. Qed. Lemma of_list_2 : forall l, NoDupA eqk l -> equivlistA eqke l (to_list (of_list l)). Proof. intros l Hnodup (k,e). rewrite <- elements_mapsto_iff, of_list_1; intuition. Qed. Lemma of_list_3 : forall s, Equal (of_list (to_list s)) s. Proof. intros s k. rewrite of_list_1b, elements_o; auto. apply elements_3w. Qed. (** * Fold *) (** Alternative specification via [fold_right] *) Lemma fold_spec_right m (A:Type)(i:A)(f : key -> elt -> A -> A) : fold f m i = List.fold_right (uncurry f) i (rev (elements m)). Proof. rewrite fold_1. symmetry. apply fold_left_rev_right. Qed. (** ** Induction principles about fold contributed by S. Lescuyer *) (** In the following lemma, the step hypothesis is deliberately restricted to the precise map m we are considering. *) Lemma fold_rec : forall (A:Type)(P : t elt -> A -> Type)(f : key -> elt -> A -> A), forall (i:A)(m:t elt), (forall m, Empty m -> P m i) -> (forall k e a m' m'', MapsTo k e m -> ~In k m' -> Add k e m' m'' -> P m' a -> P m'' (f k e a)) -> P m (fold f m i). Proof. intros A P f i m Hempty Hstep. rewrite fold_spec_right. set (F:=uncurry f). set (l:=rev (elements m)). assert (Hstep' : forall k e a m' m'', InA eqke (k,e) l -> ~In k m' -> Add k e m' m'' -> P m' a -> P m'' (F (k,e) a)). { intros k e a m' m'' H ? ? ?; eapply Hstep; eauto. revert H; unfold l; rewrite InA_rev, elements_mapsto_iff. auto. } assert (Hdup : NoDupA eqk l). { unfold l. apply NoDupA_rev; try red; unfold eq_key. - auto with typeclass_instances. - apply elements_3w. } assert (Hsame : forall k, find k m = findA (eqb k) l). { intros k. unfold l. rewrite elements_o, findA_rev; auto. apply elements_3w. } clearbody l. clearbody F. clear Hstep f. revert m Hsame. induction l. - (* empty *) intros m Hsame; simpl. apply Hempty. intros k e. rewrite find_mapsto_iff, Hsame; simpl; discriminate. - (* step *) intros m Hsame; destruct a as (k,e); simpl. apply Hstep' with (of_list l); auto. + rewrite InA_cons; left; red; auto. + inversion_clear Hdup. contradict H. destruct H as (e',He'). apply InA_eqke_eqk with k e'; auto. rewrite <- of_list_1; auto. + intro k'. rewrite Hsame, add_o, of_list_1b. * simpl. unfold eqb. do 2 destruct eq_dec as [|?Hnot]; auto; elim Hnot; eauto. * inversion_clear Hdup; auto. + apply IHl. * intros; eapply Hstep'; eauto. * inversion_clear Hdup; auto. * intros; apply of_list_1b. inversion_clear Hdup; auto. Qed. (** Same, with [empty] and [add] instead of [Empty] and [Add]. In this case, [P] must be compatible with equality of sets *) Theorem fold_rec_bis : forall (A:Type)(P : t elt -> A -> Type)(f : key -> elt -> A -> A), forall (i:A)(m:t elt), (forall m m' a, Equal m m' -> P m a -> P m' a) -> (P (empty _) i) -> (forall k e a m', MapsTo k e m -> ~In k m' -> P m' a -> P (add k e m') (f k e a)) -> P m (fold f m i). Proof. intros A P f i m Pmorphism Pempty Pstep. apply fold_rec; intros. - apply Pmorphism with (empty _); auto. intro k. rewrite empty_o. case_eq (find k m0); auto; intros e'; rewrite <- find_mapsto_iff. intro H'; elim (H k e'); auto. - apply Pmorphism with (add k e m'); try intro; auto. Qed. Lemma fold_rec_nodep : forall (A:Type)(P : A -> Type)(f : key -> elt -> A -> A)(i:A)(m:t elt), P i -> (forall k e a, MapsTo k e m -> P a -> P (f k e a)) -> P (fold f m i). Proof. intros; apply fold_rec_bis with (P:=fun _ => P); auto. Qed. (** [fold_rec_weak] is a weaker principle than [fold_rec_bis] : the step hypothesis must here be applicable anywhere. At the same time, it looks more like an induction principle, and hence can be easier to use. *) Lemma fold_rec_weak : forall (A:Type)(P : t elt -> A -> Type)(f : key -> elt -> A -> A)(i:A), (forall m m' a, Equal m m' -> P m a -> P m' a) -> P (empty _) i -> (forall k e a m, ~In k m -> P m a -> P (add k e m) (f k e a)) -> forall m, P m (fold f m i). Proof. intros; apply fold_rec_bis; auto. Qed. Lemma fold_rel : forall (A B:Type)(R : A -> B -> Type) (f : key -> elt -> A -> A)(g : key -> elt -> B -> B)(i : A)(j : B) (m : t elt), R i j -> (forall k e a b, MapsTo k e m -> R a b -> R (f k e a) (g k e b)) -> R (fold f m i) (fold g m j). Proof. intros A B R f g i j m Rempty Rstep. rewrite 2 fold_spec_right. set (l:=rev (elements m)). assert (Rstep' : forall k e a b, InA eqke (k,e) l -> R a b -> R (f k e a) (g k e b)) by (intros; apply Rstep; auto; rewrite elements_mapsto_iff, <- InA_rev; assumption). clearbody l; clear Rstep m. induction l; simpl; auto. apply Rstep'; auto. destruct a; simpl; rewrite InA_cons; left; red; auto. Qed. (** From the induction principle on [fold], we can deduce some general induction principles on maps. *) Lemma map_induction : forall P : t elt -> Type, (forall m, Empty m -> P m) -> (forall m m', P m -> forall x e, ~In x m -> Add x e m m' -> P m') -> forall m, P m. Proof. intros. apply (@fold_rec _ (fun s _ => P s) (fun _ _ _ => tt) tt m); eauto. Qed. Lemma map_induction_bis : forall P : t elt -> Type, (forall m m', Equal m m' -> P m -> P m') -> P (empty _) -> (forall x e m, ~In x m -> P m -> P (add x e m)) -> forall m, P m. Proof. intros. apply (@fold_rec_bis _ (fun s _ => P s) (fun _ _ _ => tt) tt m); eauto. Qed. (** [fold] can be used to reconstruct the same initial set. *) Lemma fold_identity : forall m : t elt, Equal (fold (@add _) m (empty _)) m. Proof. intros. apply fold_rec with (P:=fun m acc => Equal acc m); auto with map. - intros m' Heq k'. rewrite empty_o. case_eq (find k' m'); auto; intros e'; rewrite <- find_mapsto_iff. intro; elim (Heq k' e'); auto. - intros k e a m' m'' _ _ Hadd Heq k'. red in Heq. rewrite Hadd, 2 add_o, Heq; auto. Qed. Section Fold_More. (** ** Additional properties of fold *) (** When a function [f] is compatible and allows transpositions, we can compute [fold f] in any order. *) Variables (A:Type)(eqA:A->A->Prop)(st:Equivalence eqA)(f:key->elt->A->A). (** This is more convenient than a [compat_op eqke ...]. In fact, every [compat_op], [compat_bool], etc, should become a [Proper] someday. *) Hypothesis Comp : Proper (E.eq==>eq==>eqA==>eqA) f. Lemma fold_init : forall m i i', eqA i i' -> eqA (fold f m i) (fold f m i'). Proof. intros. apply fold_rel with (R:=eqA); auto. intros. apply Comp; auto. Qed. Lemma fold_Empty : forall m i, Empty m -> eqA (fold f m i) i. Proof. intros. apply fold_rec_nodep with (P:=fun a => eqA a i). - reflexivity. - intros. elim (H k e); auto. Qed. (** As noticed by P. Casteran, asking for the general [SetoidList.transpose] here is too restrictive. Think for instance of [f] being [M.add] : in general, [M.add k e (M.add k e' m)] is not equivalent to [M.add k e' (M.add k e m)]. Fortunately, we will never encounter this situation during a real [fold], since the keys received by this [fold] are unique. Hence we can ask the transposition property to hold only for non-equal keys. This idea could be push slightly further, by asking the transposition property to hold only for (non-equal) keys living in the map given to [fold]. Please contact us if you need such a version. FSets could also benefit from a restricted [transpose], but for this case the gain is unclear. *) Definition transpose_neqkey := forall k k' e e' a, ~E.eq k k' -> eqA (f k e (f k' e' a)) (f k' e' (f k e a)). Hypothesis Tra : transpose_neqkey. Lemma fold_commutes : forall i m k e, ~In k m -> eqA (fold f m (f k e i)) (f k e (fold f m i)). Proof. intros i m k e Hnotin. apply fold_rel with (R:= fun a b => eqA a (f k e b)); auto. - reflexivity. - intros. transitivity (f k0 e0 (f k e b)). + apply Comp; auto. + apply Tra; auto. contradict Hnotin; rewrite <- Hnotin; exists e0; auto. Qed. #[local] Hint Resolve NoDupA_eqk_eqke NoDupA_rev elements_3w : map. Lemma fold_Equal : forall m1 m2 i, Equal m1 m2 -> eqA (fold f m1 i) (fold f m2 i). Proof. intros. rewrite 2 fold_spec_right. assert (NoDupA eqk (rev (elements m1))) by auto with map typeclass_instances. assert (NoDupA eqk (rev (elements m2))) by auto with map typeclass_instances. apply fold_right_equivlistA_restr with (R:=complement eqk)(eqA:=eqke). 1:auto with typeclass_instances. 1:auto. 2: auto with crelations. 4, 5: auto with map. - intros (k1,e1) (k2,e2) (Hk,He) a1 a2 Ha; simpl in *; apply Comp; auto. - unfold complement, eq_key, eq_key_elt; repeat red. intuition eauto. - intros (k,e) (k',e'); unfold eq_key, uncurry; simpl; auto. - rewrite <- NoDupA_altdef; auto. - intros (k,e). rewrite 2 InA_rev, <- 2 elements_mapsto_iff, 2 find_mapsto_iff, H. auto with crelations. Qed. Lemma fold_Equal2 : forall m1 m2 i j, Equal m1 m2 -> eqA i j -> eqA (fold f m1 i) (fold f m2 j). Proof. intros. rewrite 2 fold_spec_right. assert (NoDupA eqk (rev (elements m1))) by auto with map typeclass_instances. assert (NoDupA eqk (rev (elements m2))) by auto with map typeclass_instances. apply fold_right_equivlistA_restr2 with (R:=complement eqk)(eqA:=eqke). 1:auto with typeclass_instances. 1, 10: auto. 2: auto with crelations. 4, 5: auto with map. - intros (k1,e1) (k2,e2) (Hk,He) a1 a2 Ha; simpl in *; apply Comp; auto. - unfold complement, eq_key, eq_key_elt; repeat red. intuition eauto. - intros (k,e) (k',e') z z' h h'; unfold eq_key, uncurry;simpl; auto. rewrite h'. auto. - rewrite <- NoDupA_altdef; auto. - intros (k,e). rewrite 2 InA_rev, <- 2 elements_mapsto_iff, 2 find_mapsto_iff, H. auto with crelations. Qed. Lemma fold_Add : forall m1 m2 k e i, ~In k m1 -> Add k e m1 m2 -> eqA (fold f m2 i) (f k e (fold f m1 i)). Proof. intros. rewrite 2 fold_spec_right. set (f':=uncurry f). change (f k e (fold_right f' i (rev (elements m1)))) with (f' (k,e) (fold_right f' i (rev (elements m1)))). assert (NoDupA eqk (rev (elements m1))) by auto with map typeclass_instances. assert (NoDupA eqk (rev (elements m2))) by auto with map typeclass_instances. apply fold_right_add_restr with (R:=complement eqk)(eqA:=eqke)(eqB:=eqA). 1:auto with typeclass_instances. 1:auto. 2: auto with crelations. 4, 5: auto with map. - intros (k1,e1) (k2,e2) (Hk,He) a a' Ha; unfold f'; simpl in *. apply Comp; auto. - unfold complement, eq_key_elt, eq_key; repeat red; intuition eauto. - unfold f'; intros (k1,e1) (k2,e2); unfold eq_key, uncurry; simpl; auto. - rewrite <- NoDupA_altdef; auto. - rewrite InA_rev, <- elements_mapsto_iff. firstorder. - intros (a,b). rewrite InA_cons, 2 InA_rev, <- 2 elements_mapsto_iff, 2 find_mapsto_iff. unfold eq_key_elt; simpl. rewrite H0. rewrite add_o. destruct (eq_dec k a) as [EQ|NEQ]; split; auto. + intros EQ'; inversion EQ'; auto. + intuition; subst; auto. elim H. exists b; rewrite EQ; auto with map. + intuition. elim NEQ; auto. Qed. Lemma fold_add : forall m k e i, ~In k m -> eqA (fold f (add k e m) i) (f k e (fold f m i)). Proof. intros. apply fold_Add; try red; auto. Qed. End Fold_More. (** * Cardinal *) Lemma cardinal_fold : forall m : t elt, cardinal m = fold (fun _ _ => S) m 0. Proof. intros; rewrite cardinal_1, fold_1. symmetry; apply fold_left_S_O; auto. Qed. Lemma cardinal_Empty : forall m : t elt, Empty m <-> cardinal m = 0. Proof. intros. rewrite cardinal_1, elements_Empty. destruct (elements m); intuition; discriminate. Qed. Lemma Equal_cardinal : forall m m' : t elt, Equal m m' -> cardinal m = cardinal m'. Proof. intros; do 2 rewrite cardinal_fold. apply fold_Equal with (eqA:=eq); compute; auto. Qed. Lemma cardinal_1 : forall m : t elt, Empty m -> cardinal m = 0. Proof. intros; rewrite <- cardinal_Empty; auto. Qed. Lemma cardinal_2 : forall m m' x e, ~ In x m -> Add x e m m' -> cardinal m' = S (cardinal m). Proof. intros; do 2 rewrite cardinal_fold. change S with ((fun _ _ => S) x e). apply fold_Add with (eqA:=eq); compute; auto. Qed. Lemma cardinal_Add_In: forall m m' x e, In x m -> Add x e m m' -> cardinal m' = cardinal m. Proof. assert (forall k e m, MapsTo k e m -> Add k e (remove k m) m) as remove_In_Add. { intros. unfold Add. intros. rewrite F.add_o. destruct (F.eq_dec k y). - apply find_1. rewrite <-MapsTo_m; [exact H|assumption|reflexivity|reflexivity]. - rewrite F.remove_neq_o by assumption. reflexivity. } intros. assert (Equal (remove x m) (remove x m')). { intros y. rewrite 2!F.remove_o. destruct (F.eq_dec x y). reflexivity. unfold Add in H0. rewrite H0. rewrite F.add_neq_o by assumption. reflexivity. } apply Equal_cardinal in H1. rewrite 2!cardinal_fold. destruct H as (e' & H). rewrite fold_Add with (eqA:=eq) (m1:=remove x m) (m2:=m) (k:=x) (e:=e'); try now (compute; auto). rewrite fold_Add with (eqA:=eq) (m1:=remove x m') (m2:=m') (k:=x) (e:=e); try now (compute; auto). rewrite <- 2!cardinal_fold. congruence. apply remove_1. reflexivity. apply remove_In_Add. apply find_2. unfold Add in H0. rewrite H0. rewrite F.add_eq_o; reflexivity. apply remove_1. reflexivity. apply remove_In_Add. assumption. Qed. Lemma cardinal_inv_1 : forall m : t elt, cardinal m = 0 -> Empty m. Proof. intros; rewrite cardinal_Empty; auto. Qed. #[local] Hint Resolve cardinal_inv_1 : map. Lemma cardinal_inv_2 : forall m n, cardinal m = S n -> { p : key*elt | MapsTo (fst p) (snd p) m }. Proof. intros; rewrite M.cardinal_1 in *. generalize (elements_mapsto_iff m). destruct (elements m); try discriminate. exists p; auto. rewrite H0; destruct p; simpl; auto. constructor; red; auto. Qed. Lemma cardinal_inv_2b : forall m, cardinal m <> 0 -> { p : key*elt | MapsTo (fst p) (snd p) m }. Proof. intros. generalize (@cardinal_inv_2 m); destruct cardinal. - elim H;auto. - eauto. Qed. (** * Additional notions over maps *) Definition Disjoint (m m' : t elt) := forall k, ~(In k m /\ In k m'). Definition Partition (m m1 m2 : t elt) := Disjoint m1 m2 /\ (forall k e, MapsTo k e m <-> MapsTo k e m1 \/ MapsTo k e m2). (** * Emulation of some functions lacking in the interface *) Definition filter (f : key -> elt -> bool)(m : t elt) := fold (fun k e m => if f k e then add k e m else m) m (empty _). Definition for_all (f : key -> elt -> bool)(m : t elt) := fold (fun k e b => if f k e then b else false) m true. Definition exists_ (f : key -> elt -> bool)(m : t elt) := fold (fun k e b => if f k e then true else b) m false. Definition partition (f : key -> elt -> bool)(m : t elt) := (filter f m, filter (fun k e => negb (f k e)) m). (** [update] adds to [m1] all the bindings of [m2]. It can be seen as an [union] operator which gives priority to its 2nd argument in case of binding conflit. *) Definition update (m1 m2 : t elt) := fold (@add _) m2 m1. (** [restrict] keeps from [m1] only the bindings whose key is in [m2]. It can be seen as an [inter] operator, with priority to its 1st argument in case of binding conflit. *) Definition restrict (m1 m2 : t elt) := filter (fun k _ => mem k m2) m1. (** [diff] erases from [m1] all bindings whose key is in [m2]. *) Definition diff (m1 m2 : t elt) := filter (fun k _ => negb (mem k m2)) m1. Section Specs. Variable f : key -> elt -> bool. Hypothesis Hf : Proper (E.eq==>eq==>eq) f. Lemma filter_iff : forall m k e, MapsTo k e (filter f m) <-> MapsTo k e m /\ f k e = true. Proof. unfold filter. set (f':=fun k e m => if f k e then add k e m else m). intro m. pattern m, (fold f' m (empty _)). apply fold_rec. - intros m' Hm' k e. rewrite empty_mapsto_iff. intuition. elim (Hm' k e); auto. - intros k e acc m1 m2 Hke Hn Hadd IH k' e'. change (Equal m2 (add k e m1)) in Hadd; rewrite Hadd. unfold f'; simpl. case_eq (f k e); intros Hfke; simpl; rewrite !add_mapsto_iff, IH; clear IH; intuition. + rewrite <- Hfke; apply Hf; auto. + destruct (eq_dec k k') as [Hk|Hk]; [left|right]; auto. elim Hn; exists e'; rewrite Hk; auto. + assert (f k e = f k' e') by (apply Hf; auto). congruence. Qed. Lemma for_all_iff : forall m, for_all f m = true <-> (forall k e, MapsTo k e m -> f k e = true). Proof. unfold for_all. set (f':=fun k e b => if f k e then b else false). intro m. pattern m, (fold f' m true). apply fold_rec. - intros m' Hm'. split; auto. intros _ k e Hke. elim (Hm' k e); auto. - intros k e b m1 m2 _ Hn Hadd IH. clear m. change (Equal m2 (add k e m1)) in Hadd. unfold f'; simpl. case_eq (f k e); intros Hfke. (* f k e = true *) + rewrite IH. clear IH. split; intros Hmapsto k' e' Hke'. * rewrite Hadd, add_mapsto_iff in Hke'. destruct Hke' as [(?,?)|(?,?)]; auto. rewrite <- Hfke; apply Hf; auto. * apply Hmapsto. rewrite Hadd, add_mapsto_iff; right; split; auto. contradict Hn; exists e'; rewrite Hn; auto. (* f k e = false *) + split; try discriminate. intros Hmapsto. rewrite <- Hfke. apply Hmapsto. rewrite Hadd, add_mapsto_iff; auto. Qed. Lemma exists_iff : forall m, exists_ f m = true <-> (exists p, MapsTo (fst p) (snd p) m /\ f (fst p) (snd p) = true). Proof. unfold exists_. set (f':=fun k e b => if f k e then true else b). intro m. pattern m, (fold f' m false). apply fold_rec. - intros m' Hm'. split; try discriminate. intros ((k,e),(Hke,_)); simpl in *. elim (Hm' k e); auto. - intros k e b m1 m2 _ Hn Hadd IH. clear m. change (Equal m2 (add k e m1)) in Hadd. unfold f'; simpl. case_eq (f k e); intros Hfke. (* f k e = true *) + split; [intros _|auto]. exists (k,e); simpl; split; auto. rewrite Hadd, add_mapsto_iff; auto. (* f k e = false *) + rewrite IH. clear IH. split; intros ((k',e'),(Hke1,Hke2)); simpl in *. * exists (k',e'); simpl; split; auto. rewrite Hadd, add_mapsto_iff; right; split; auto. contradict Hn. exists e'; rewrite Hn; auto. * rewrite Hadd, add_mapsto_iff in Hke1. destruct Hke1 as [(?,?)|(?,?)]. -- assert (f k' e' = f k e) by (apply Hf; auto). congruence. -- exists (k',e'); auto. Qed. End Specs. Lemma Disjoint_alt : forall m m', Disjoint m m' <-> (forall k e e', MapsTo k e m -> MapsTo k e' m' -> False). Proof. unfold Disjoint; split. - intros H k v v' H1 H2. apply H with k; split. + exists v; trivial. + exists v'; trivial. - intros H k ((v,Hv),(v',Hv')). eapply H; eauto. Qed. Section Partition. Variable f : key -> elt -> bool. Hypothesis Hf : Proper (E.eq==>eq==>eq) f. Lemma partition_iff_1 : forall m m1 k e, m1 = fst (partition f m) -> (MapsTo k e m1 <-> MapsTo k e m /\ f k e = true). Proof. unfold partition; simpl; intros. subst m1. apply filter_iff; auto. Qed. Lemma partition_iff_2 : forall m m2 k e, m2 = snd (partition f m) -> (MapsTo k e m2 <-> MapsTo k e m /\ f k e = false). Proof. unfold partition; simpl; intros. subst m2. rewrite filter_iff. - split; intros (H,H'); split; auto. + destruct (f k e); simpl in *; auto. + rewrite H'; auto. - repeat red; intros. f_equal. apply Hf; auto. Qed. Lemma partition_Partition : forall m m1 m2, partition f m = (m1,m2) -> Partition m m1 m2. Proof. intros. split. - rewrite Disjoint_alt. intros k e e'. rewrite (@partition_iff_1 m m1), (@partition_iff_2 m m2) by (rewrite H; auto). intros (U,V) (W,Z). rewrite <- (MapsTo_fun U W) in Z; congruence. - intros k e. rewrite (@partition_iff_1 m m1), (@partition_iff_2 m m2) by (rewrite H; auto). destruct (f k e); intuition. Qed. End Partition. Lemma Partition_In : forall m m1 m2 k, Partition m m1 m2 -> In k m -> {In k m1}+{In k m2}. Proof. intros m m1 m2 k Hm Hk. destruct (In_dec m1 k) as [H|H]; [left|right]; auto. destruct Hm as (Hm,Hm'). destruct Hk as (e,He); rewrite Hm' in He; destruct He. - elim H; exists e; auto. - exists e; auto. Defined. Lemma Disjoint_sym : forall m1 m2, Disjoint m1 m2 -> Disjoint m2 m1. Proof. intros m1 m2 H k (H1,H2). elim (H k); auto. Qed. Lemma Partition_sym : forall m m1 m2, Partition m m1 m2 -> Partition m m2 m1. Proof. intros m m1 m2 (H,H'); split. - apply Disjoint_sym; auto. - intros; rewrite H'; intuition. Qed. Lemma Partition_Empty : forall m m1 m2, Partition m m1 m2 -> (Empty m <-> (Empty m1 /\ Empty m2)). Proof. intros m m1 m2 (Hdisj,Heq). split. - intro He. split; intros k e Hke; elim (He k e); rewrite Heq; auto. - intros (He1,He2) k e Hke. rewrite Heq in Hke. destruct Hke. + elim (He1 k e); auto. + elim (He2 k e); auto. Qed. Lemma Partition_Add : forall m m' x e , ~In x m -> Add x e m m' -> forall m1 m2, Partition m' m1 m2 -> exists m3, (Add x e m3 m1 /\ Partition m m3 m2 \/ Add x e m3 m2 /\ Partition m m1 m3). Proof. unfold Partition. intros m m' x e Hn Hadd m1 m2 (Hdisj,Hor). assert (Heq : Equal m (remove x m')). { change (Equal m' (add x e m)) in Hadd. rewrite Hadd. intro k. rewrite remove_o, add_o. destruct eq_dec as [He|Hne]; auto. rewrite <- He, <- not_find_in_iff; auto. } assert (H : MapsTo x e m'). { change (Equal m' (add x e m)) in Hadd; rewrite Hadd. apply add_1; auto. } rewrite Hor in H; destruct H. - (* first case : x in m1 *) exists (remove x m1); left. split; [|split]. + (* add *) change (Equal m1 (add x e (remove x m1))). intro k. rewrite add_o, remove_o. destruct eq_dec as [He|Hne]; auto. rewrite <- He; apply find_1; auto. + (* disjoint *) intros k (H1,H2). elim (Hdisj k). split; auto. rewrite remove_in_iff in H1; destruct H1; auto. + (* mapsto *) intros k' e'. rewrite Heq, 2 remove_mapsto_iff, Hor. intuition. elim (Hdisj x); split; [exists e|exists e']; auto. apply MapsTo_1 with k'; auto. - (* second case : x in m2 *) exists (remove x m2); right. split; [|split]. + (* add *) change (Equal m2 (add x e (remove x m2))). intro k. rewrite add_o, remove_o. destruct eq_dec as [He|Hne]; auto. rewrite <- He; apply find_1; auto. + (* disjoint *) intros k (H1,H2). elim (Hdisj k). split; auto. rewrite remove_in_iff in H2; destruct H2; auto. + (* mapsto *) intros k' e'. rewrite Heq, 2 remove_mapsto_iff, Hor. intuition. elim (Hdisj x); split; [exists e'|exists e]; auto. apply MapsTo_1 with k'; auto. Qed. Lemma Partition_fold : forall (A:Type)(eqA:A->A->Prop)(st:Equivalence eqA)(f:key->elt->A->A), Proper (E.eq==>eq==>eqA==>eqA) f -> transpose_neqkey eqA f -> forall m m1 m2 i, Partition m m1 m2 -> eqA (fold f m i) (fold f m1 (fold f m2 i)). Proof. intros A eqA st f Comp Tra. induction m as [m Hm|m m' IH k e Hn Hadd] using map_induction. - intros m1 m2 i Hp. rewrite (fold_Empty (eqA:=eqA)); auto. rewrite (Partition_Empty Hp) in Hm. destruct Hm. rewrite 2 (fold_Empty (eqA:=eqA)); auto. reflexivity. - intros m1 m2 i Hp. destruct (Partition_Add Hn Hadd Hp) as (m3,[(Hadd',Hp')|(Hadd',Hp')]). + (* fst case: m3 is (k,e)::m1 *) assert (~In k m3). { contradict Hn. destruct Hn as (e',He'). destruct Hp' as (Hp1,Hp2). exists e'. rewrite Hp2; auto. } transitivity (f k e (fold f m i)). * apply fold_Add with (eqA:=eqA); auto. * symmetry. transitivity (f k e (fold f m3 (fold f m2 i))). -- apply fold_Add with (eqA:=eqA); auto. -- apply Comp; auto. symmetry; apply IH; auto. + (* snd case: m3 is (k,e)::m2 *) assert (~In k m3). { contradict Hn. destruct Hn as (e',He'). destruct Hp' as (Hp1,Hp2). exists e'. rewrite Hp2; auto. } assert (~In k m1). { contradict Hn. destruct Hn as (e',He'). destruct Hp' as (Hp1,Hp2). exists e'. rewrite Hp2; auto. } transitivity (f k e (fold f m i)). * apply fold_Add with (eqA:=eqA); auto. * transitivity (f k e (fold f m1 (fold f m3 i))). -- apply Comp; auto using IH. -- transitivity (fold f m1 (f k e (fold f m3 i))). ++ symmetry. apply fold_commutes with (eqA:=eqA); auto. ++ apply fold_init with (eqA:=eqA); auto. symmetry. apply fold_Add with (eqA:=eqA); auto. Qed. Lemma Partition_cardinal : forall m m1 m2, Partition m m1 m2 -> cardinal m = cardinal m1 + cardinal m2. Proof. intros. rewrite (cardinal_fold m), (cardinal_fold m1). set (f:=fun (_:key)(_:elt)=>S). setoid_replace (fold f m 0) with (fold f m1 (fold f m2 0)). - rewrite <- cardinal_fold. apply fold_rel with (R:=fun u v => u = v + cardinal m2); simpl; auto. - apply Partition_fold with (eqA:=eq); repeat red; auto. Qed. Lemma Partition_partition : forall m m1 m2, Partition m m1 m2 -> let f := fun k (_:elt) => mem k m1 in Equal m1 (fst (partition f m)) /\ Equal m2 (snd (partition f m)). Proof. intros m m1 m2 Hm f. assert (Hf : Proper (E.eq==>eq==>eq) f). { intros k k' Hk e e' _; unfold f; rewrite Hk; auto. } set (m1':= fst (partition f m)). set (m2':= snd (partition f m)). split; rewrite Equal_mapsto_iff; intros k e. - rewrite (@partition_iff_1 f Hf m m1') by auto. unfold f. rewrite <- mem_in_iff. destruct Hm as (Hm,Hm'). rewrite Hm'. intuition. + exists e; auto. + elim (Hm k); split; auto; exists e; auto. - rewrite (@partition_iff_2 f Hf m m2') by auto. unfold f. rewrite <- not_mem_in_iff. destruct Hm as (Hm,Hm'). rewrite Hm'. intuition. + elim (Hm k); split; auto; exists e; auto. + elim H1; exists e; auto. Qed. Lemma update_mapsto_iff : forall m m' k e, MapsTo k e (update m m') <-> (MapsTo k e m' \/ (MapsTo k e m /\ ~In k m')). Proof. unfold update. intros m m'. pattern m', (fold (@add _) m' m). apply fold_rec. - intros m0 Hm0 k e. assert (~In k m0) by (intros (e0,He0); apply (Hm0 k e0); auto). intuition. elim (Hm0 k e); auto. - intros k e m0 m1 m2 _ Hn Hadd IH k' e'. change (Equal m2 (add k e m1)) in Hadd. rewrite Hadd, 2 add_mapsto_iff, IH, add_in_iff. clear IH. intuition. Qed. Lemma update_dec : forall m m' k e, MapsTo k e (update m m') -> { MapsTo k e m' } + { MapsTo k e m /\ ~In k m'}. Proof. intros m m' k e H. rewrite update_mapsto_iff in H. destruct (In_dec m' k) as [H'|H']; [left|right]; intuition. elim H'; exists e; auto. Defined. Lemma update_in_iff : forall m m' k, In k (update m m') <-> In k m \/ In k m'. Proof. intros m m' k. split. - intros (e,H); rewrite update_mapsto_iff in H. destruct H; [right|left]; exists e; intuition. - destruct (In_dec m' k) as [H|H]. + destruct H as (e,H). intros _; exists e. rewrite update_mapsto_iff; left; auto. + destruct 1 as [H'|H']; [|elim H; auto]. destruct H' as (e,H'). exists e. rewrite update_mapsto_iff; right; auto. Qed. Lemma diff_mapsto_iff : forall m m' k e, MapsTo k e (diff m m') <-> MapsTo k e m /\ ~In k m'. Proof. intros m m' k e. unfold diff. rewrite filter_iff. - intuition. rewrite mem_1 in *; auto; discriminate. - intros ? ? Hk _ _ _; rewrite Hk; auto. Qed. Lemma diff_in_iff : forall m m' k, In k (diff m m') <-> In k m /\ ~In k m'. Proof. intros m m' k. split. - intros (e,H); rewrite diff_mapsto_iff in H. destruct H; split; auto. exists e; auto. - intros ((e,H),H'); exists e; rewrite diff_mapsto_iff; auto. Qed. Lemma restrict_mapsto_iff : forall m m' k e, MapsTo k e (restrict m m') <-> MapsTo k e m /\ In k m'. Proof. intros m m' k e. unfold restrict. rewrite filter_iff. - intuition. - intros ? ? Hk _ _ _; rewrite Hk; auto. Qed. Lemma restrict_in_iff : forall m m' k, In k (restrict m m') <-> In k m /\ In k m'. Proof. intros m m' k. split. - intros (e,H); rewrite restrict_mapsto_iff in H. destruct H; split; auto. exists e; auto. - intros ((e,H),H'); exists e; rewrite restrict_mapsto_iff; auto. Qed. (** specialized versions analyzing only keys (resp. elements) *) Definition filter_dom (f : key -> bool) := filter (fun k _ => f k). Definition filter_range (f : elt -> bool) := filter (fun _ => f). Definition for_all_dom (f : key -> bool) := for_all (fun k _ => f k). Definition for_all_range (f : elt -> bool) := for_all (fun _ => f). Definition exists_dom (f : key -> bool) := exists_ (fun k _ => f k). Definition exists_range (f : elt -> bool) := exists_ (fun _ => f). Definition partition_dom (f : key -> bool) := partition (fun k _ => f k). Definition partition_range (f : elt -> bool) := partition (fun _ => f). End Elt. Add Parametric Morphism elt : (@cardinal elt) with signature Equal ==> eq as cardinal_m. Proof. intros; apply Equal_cardinal; auto. Qed. Add Parametric Morphism elt : (@Disjoint elt) with signature Equal ==> Equal ==> iff as Disjoint_m. Proof. intros m1 m1' Hm1 m2 m2' Hm2. unfold Disjoint. split; intros. - rewrite <- Hm1, <- Hm2; auto. - rewrite Hm1, Hm2; auto. Qed. Add Parametric Morphism elt : (@Partition elt) with signature Equal ==> Equal ==> Equal ==> iff as Partition_m. Proof. intros m1 m1' Hm1 m2 m2' Hm2 m3 m3' Hm3. unfold Partition. rewrite <- Hm2, <- Hm3. split; intros (H,H'); split; auto; intros. - rewrite <- Hm1, <- Hm2, <- Hm3; auto. - rewrite Hm1, Hm2, Hm3; auto. Qed. Add Parametric Morphism elt : (@update elt) with signature Equal ==> Equal ==> Equal as update_m. Proof. intros m1 m1' Hm1 m2 m2' Hm2. setoid_replace (update m1 m2) with (update m1' m2); unfold update. - apply fold_Equal with (eqA:=Equal); auto. + intros k k' Hk e e' He m m' Hm; rewrite Hk,He,Hm; red; auto. + intros k k' e e' i Hneq x. rewrite !add_o; do 2 destruct eq_dec; auto. elim Hneq; eauto. - apply fold_init with (eqA:=Equal); auto. intros k k' Hk e e' He m m' Hm; rewrite Hk,He,Hm; red; auto. Qed. Add Parametric Morphism elt : (@restrict elt) with signature Equal ==> Equal ==> Equal as restrict_m. Proof. intros m1 m1' Hm1 m2 m2' Hm2. setoid_replace (restrict m1 m2) with (restrict m1' m2); unfold restrict, filter. - apply fold_rel with (R:=Equal); try red; auto. intros k e i i' H Hii' x. pattern (mem k m2); rewrite Hm2. (* UGLY, see with Matthieu *) destruct mem; rewrite Hii'; auto. - apply fold_Equal with (eqA:=Equal); auto. + intros k k' Hk e e' He m m' Hm; simpl in *. pattern (mem k m2); rewrite Hk. (* idem *) destruct mem; rewrite ?Hk,?He,Hm; red; auto. + intros k k' e e' i Hneq x. case_eq (mem k m2); case_eq (mem k' m2); intros; auto. rewrite !add_o; do 2 destruct eq_dec; auto. elim Hneq; eauto. Qed. Add Parametric Morphism elt : (@diff elt) with signature Equal ==> Equal ==> Equal as diff_m. Proof. intros m1 m1' Hm1 m2 m2' Hm2. setoid_replace (diff m1 m2) with (diff m1' m2); unfold diff, filter. - apply fold_rel with (R:=Equal); try red; auto. intros k e i i' H Hii' x. pattern (mem k m2); rewrite Hm2. (* idem *) destruct mem; simpl; rewrite Hii'; auto. - apply fold_Equal with (eqA:=Equal); auto. + intros k k' Hk e e' He m m' Hm; simpl in *. pattern (mem k m2); rewrite Hk. (* idem *) destruct mem; simpl; rewrite ?Hk,?He,Hm; red; auto. + intros k k' e e' i Hneq x. case_eq (mem k m2); case_eq (mem k' m2); intros; simpl; auto. rewrite !add_o; do 2 destruct eq_dec; auto. elim Hneq; eauto. Qed. End WProperties_fun. (** * Same Properties for self-contained weak maps and for full maps *) Module WProperties (M:WS) := WProperties_fun M.E M. Module Properties := WProperties. (** * Properties specific to maps with ordered keys *) Module OrdProperties (M:S). Module Import ME := OrderedTypeFacts M.E. Module Import O:=KeyOrderedType M.E. Module Import P:=Properties M. Import F. Import M. Section Elt. Variable elt:Type. Notation eqke := (@eqke elt). Notation eqk := (@eqk elt). Notation ltk := (@ltk elt). Notation cardinal := (@cardinal elt). Notation Equal := (@Equal elt). Notation Add := (@Add elt). Definition Above x (m:t elt) := forall y, In y m -> E.lt y x. Definition Below x (m:t elt) := forall y, In y m -> E.lt x y. Section Elements. Lemma sort_equivlistA_eqlistA : forall l l' : list (key*elt), sort ltk l -> sort ltk l' -> equivlistA eqke l l' -> eqlistA eqke l l'. Proof. apply SortA_equivlistA_eqlistA; auto with typeclass_instances. Qed. Ltac clean_eauto := unfold O.eqke, O.ltk; simpl; intuition; eauto. Definition gtb (p p':key*elt) := match E.compare (fst p) (fst p') with GT _ => true | _ => false end. Definition leb p := fun p' => negb (gtb p p'). Definition elements_lt p m := List.filter (gtb p) (elements m). Definition elements_ge p m := List.filter (leb p) (elements m). Lemma gtb_1 : forall p p', gtb p p' = true <-> ltk p' p. Proof. intros (x,e) (y,e'); unfold gtb, O.ltk; simpl. destruct (E.compare x y); intuition; try discriminate; ME.order. Qed. Lemma leb_1 : forall p p', leb p p' = true <-> ~ltk p' p. Proof. intros (x,e) (y,e'); unfold leb, gtb, O.ltk; simpl. destruct (E.compare x y); intuition; try discriminate; ME.order. Qed. Lemma gtb_compat : forall p, Proper (eqke==>eq) (gtb p). Proof. red; intros (x,e) (a,e') (b,e'') H; red in H; simpl in *; destruct H. generalize (gtb_1 (x,e) (a,e'))(gtb_1 (x,e) (b,e'')); destruct (gtb (x,e) (a,e')); destruct (gtb (x,e) (b,e'')); auto. - unfold O.ltk in *; simpl in *; intros. symmetry; rewrite H2. apply ME.eq_lt with a; auto with ordered_type. rewrite <- H1; auto. - unfold O.ltk in *; simpl in *; intros. rewrite H1. apply ME.eq_lt with b; auto. rewrite <- H2; auto. Qed. Lemma leb_compat : forall p, Proper (eqke==>eq) (leb p). Proof. red; intros x a b H. unfold leb; f_equal; apply gtb_compat; auto. Qed. #[local] Hint Resolve gtb_compat leb_compat elements_3 : map. Lemma elements_split : forall p m, elements m = elements_lt p m ++ elements_ge p m. Proof. unfold elements_lt, elements_ge, leb; intros. apply filter_split with (eqA:=eqk) (ltA:=ltk). 1-3: auto with typeclass_instances. 2: auto with map. intros; destruct x; destruct y; destruct p. rewrite gtb_1 in H; unfold O.ltk in H; simpl in *. assert (~ltk (t1,e0) (k,e1)). - unfold gtb, O.ltk in *; simpl in *. destruct (E.compare k t1); intuition; try discriminate; ME.order. - unfold O.ltk in *; simpl in *; ME.order. Qed. Lemma elements_Add : forall m m' x e, ~In x m -> Add x e m m' -> eqlistA eqke (elements m') (elements_lt (x,e) m ++ (x,e):: elements_ge (x,e) m). Proof. intros; unfold elements_lt, elements_ge. apply sort_equivlistA_eqlistA. - auto with map. - apply (@SortA_app _ eqke). + auto with typeclass_instances. + apply (@filter_sort _ eqke). 1-3: auto with typeclass_instances. auto with map. + constructor; auto with map. * apply (@filter_sort _ eqke). 1-3: auto with typeclass_instances. auto with map. * rewrite (@InfA_alt _ eqke). 2-4: auto with typeclass_instances. -- intros. rewrite filter_InA in H1 by auto with map. destruct H1. rewrite leb_1 in H2. destruct y; unfold O.ltk in *; simpl in *. rewrite <- elements_mapsto_iff in H1. assert (~E.eq x t0). ++ contradict H. exists e0; apply MapsTo_1 with t0; auto with ordered_type. ++ ME.order. -- apply (@filter_sort _ eqke). 1-3: auto with typeclass_instances. auto with map. + intros. rewrite filter_InA in H1 by auto with map. destruct H1. rewrite gtb_1 in H3. destruct y; destruct x0; unfold O.ltk in *; simpl in *. inversion_clear H2. * red in H4; simpl in *; destruct H4. ME.order. * rewrite filter_InA in H4 by auto with map. destruct H4. rewrite leb_1 in H4. unfold O.ltk in *; simpl in *; ME.order. - red; intros a; destruct a. rewrite InA_app_iff, InA_cons, 2 filter_InA, <-2 elements_mapsto_iff, leb_1, gtb_1, find_mapsto_iff, (H0 t0), <- find_mapsto_iff, add_mapsto_iff by auto with map. unfold O.eqke, O.ltk; simpl. destruct (E.compare t0 x); intuition; try fold (~E.eq x t0); auto with ordered_type. + elim H; exists e0; apply MapsTo_1 with t0; auto. + fold (~E.lt t0 x); auto with ordered_type. Qed. Lemma elements_Add_Above : forall m m' x e, Above x m -> Add x e m m' -> eqlistA eqke (elements m') (elements m ++ (x,e)::nil). Proof. intros. apply sort_equivlistA_eqlistA. - auto with map. - apply (@SortA_app _ eqke). + auto with typeclass_instances. + auto with map. + auto. + intros. inversion_clear H2. * destruct x0; destruct y. rewrite <- elements_mapsto_iff in H1. unfold O.eqke, O.ltk in *; simpl in *; destruct H3. apply ME.lt_eq with x; auto with ordered_type. apply H; firstorder. * inversion H3. - red; intros a; destruct a. rewrite InA_app_iff, InA_cons, InA_nil, <- 2 elements_mapsto_iff, find_mapsto_iff, (H0 t0), <- find_mapsto_iff, add_mapsto_iff. unfold O.eqke; simpl. intuition auto with relations. destruct (E.eq_dec x t0) as [Heq|Hneq]; auto. exfalso. assert (In t0 m). + exists e0; auto. + generalize (H t0 H1). ME.order. Qed. Lemma elements_Add_Below : forall m m' x e, Below x m -> Add x e m m' -> eqlistA eqke (elements m') ((x,e)::elements m). Proof. intros. apply sort_equivlistA_eqlistA. - auto with map. - change (sort ltk (((x,e)::nil) ++ elements m)). apply (@SortA_app _ eqke). + auto with typeclass_instances. + auto. + auto with map. + intros. inversion_clear H1. * destruct y; destruct x0. rewrite <- elements_mapsto_iff in H2. unfold O.eqke, O.ltk in *; simpl in *; destruct H3. apply ME.eq_lt with x; auto. apply H; firstorder. * inversion H3. - red; intros a; destruct a. rewrite InA_cons, <- 2 elements_mapsto_iff, find_mapsto_iff, (H0 t0), <- find_mapsto_iff, add_mapsto_iff. unfold O.eqke; simpl. intuition auto with relations. destruct (E.eq_dec x t0) as [Heq|Hneq]; auto. exfalso. assert (In t0 m) by (exists e0; auto). generalize (H t0 H1). ME.order. Qed. Lemma elements_Equal_eqlistA : forall (m m': t elt), Equal m m' -> eqlistA eqke (elements m) (elements m'). Proof. intros. apply sort_equivlistA_eqlistA. 1-2: auto with map. red; intros. destruct x; do 2 rewrite <- elements_mapsto_iff. do 2 rewrite find_mapsto_iff; rewrite H; split; auto. Qed. End Elements. Section Min_Max_Elt. (** We emulate two [max_elt] and [min_elt] functions. *) Fixpoint max_elt_aux (l:list (key*elt)) := match l with | nil => None | (x,e)::nil => Some (x,e) | (x,e)::l => max_elt_aux l end. Definition max_elt m := max_elt_aux (elements m). Lemma max_elt_Above : forall m x e, max_elt m = Some (x,e) -> Above x (remove x m). Proof. red; intros. rewrite remove_in_iff in H0. destruct H0. rewrite elements_in_iff in H1. destruct H1. unfold max_elt in *. generalize (elements_3 m). revert x e H y x0 H0 H1. induction (elements m). - simpl; intros; try discriminate. - intros. destruct a; destruct l; simpl in *. + injection H as [= -> ->]. inversion_clear H1. * red in H; simpl in *; intuition. elim H0; eauto with ordered_type. * inversion H. + change (max_elt_aux (p::l) = Some (x,e)) in H. generalize (IHl x e H); clear IHl; intros IHl. inversion_clear H1; [ | inversion_clear H2; eauto ]. red in H3; simpl in H3; destruct H3. destruct p as (p1,p2). destruct (E.eq_dec p1 x) as [Heq|Hneq]. * apply ME.lt_eq with p1; auto. inversion_clear H2. inversion_clear H5. red in H2; simpl in H2; ME.order. * apply E.lt_trans with p1; auto. -- inversion_clear H2. inversion_clear H5. red in H2; simpl in H2; ME.order. -- eapply IHl; eauto with ordered_type. ++ econstructor; eauto. red; eauto with ordered_type. ++ inversion H2; auto. Qed. Lemma max_elt_MapsTo : forall m x e, max_elt m = Some (x,e) -> MapsTo x e m. Proof. intros. unfold max_elt in *. rewrite elements_mapsto_iff. induction (elements m). - simpl; try discriminate. - destruct a; destruct l; simpl in *. + injection H; intros; subst; constructor; red; auto with ordered_type. + constructor 2; auto. Qed. Lemma max_elt_Empty : forall m, max_elt m = None -> Empty m. Proof. intros. unfold max_elt in *. rewrite elements_Empty. induction (elements m); auto. destruct a; destruct l; simpl in *; try discriminate. assert (H':=IHl H); discriminate. Qed. Definition min_elt m : option (key*elt) := match elements m with | nil => None | (x,e)::_ => Some (x,e) end. Lemma min_elt_Below : forall m x e, min_elt m = Some (x,e) -> Below x (remove x m). Proof. unfold min_elt, Below; intros. rewrite remove_in_iff in H0; destruct H0. rewrite elements_in_iff in H1. destruct H1. generalize (elements_3 m). destruct (elements m). - try discriminate. - destruct p; injection H as [= -> ->]; intros H4. inversion_clear H1 as [? ? H2|? ? H2]. + red in H2; destruct H2; simpl in *; ME.order. + inversion_clear H4. rename H1 into H3. rewrite (@InfA_alt _ eqke) in H3 by auto with typeclass_instances. apply (H3 (y,x0)); auto. Qed. Lemma min_elt_MapsTo : forall m x e, min_elt m = Some (x,e) -> MapsTo x e m. Proof. intros. unfold min_elt in *. rewrite elements_mapsto_iff. destruct (elements m). - simpl; try discriminate. - destruct p; simpl in *. injection H; intros; subst; constructor; red; auto with ordered_type. Qed. Lemma min_elt_Empty : forall m, min_elt m = None -> Empty m. Proof. intros. unfold min_elt in *. rewrite elements_Empty. destruct (elements m); auto. destruct p; simpl in *; discriminate. Qed. End Min_Max_Elt. Section Induction_Principles. Lemma map_induction_max : forall P : t elt -> Type, (forall m, Empty m -> P m) -> (forall m m', P m -> forall x e, Above x m -> Add x e m m' -> P m') -> forall m, P m. Proof. intros; remember (cardinal m) as n; revert m Heqn; induction n; intros. - apply X; apply cardinal_inv_1; auto. - case_eq (max_elt m); intros. + destruct p. assert (Add k e (remove k m) m). * red; intros. rewrite add_o; rewrite remove_o; destruct (eq_dec k y); eauto. apply find_1; apply MapsTo_1 with k; auto. apply max_elt_MapsTo; auto. * apply X0 with (remove k m) k e; auto with map. -- apply IHn. assert (S n = S (cardinal (remove k m))). ++ rewrite Heqn. eapply cardinal_2; eauto with map ordered_type. ++ inversion H1; auto. -- eapply max_elt_Above; eauto. + apply X; apply max_elt_Empty; auto. Qed. Lemma map_induction_min : forall P : t elt -> Type, (forall m, Empty m -> P m) -> (forall m m', P m -> forall x e, Below x m -> Add x e m m' -> P m') -> forall m, P m. Proof. intros; remember (cardinal m) as n; revert m Heqn; induction n; intros. - apply X; apply cardinal_inv_1; auto. - case_eq (min_elt m); intros. + destruct p. assert (Add k e (remove k m) m). * red; intros. rewrite add_o; rewrite remove_o; destruct (eq_dec k y); eauto. apply find_1; apply MapsTo_1 with k; auto. apply min_elt_MapsTo; auto. * apply X0 with (remove k m) k e; auto. -- apply IHn. assert (S n = S (cardinal (remove k m))). ++ rewrite Heqn. eapply cardinal_2; eauto with map ordered_type. ++ inversion H1; auto. -- eapply min_elt_Below; eauto. + apply X; apply min_elt_Empty; auto. Qed. End Induction_Principles. Section Fold_properties. (** The following lemma has already been proved on Weak Maps, but with one additional hypothesis (some [transpose] fact). *) Lemma fold_Equal : forall m1 m2 (A:Type)(eqA:A->A->Prop)(st:Equivalence eqA) (f:key->elt->A->A)(i:A), Proper (E.eq==>eq==>eqA==>eqA) f -> Equal m1 m2 -> eqA (fold f m1 i) (fold f m2 i). Proof. intros m1 m2 A eqA st f i Hf Heq. rewrite 2 fold_spec_right. apply fold_right_eqlistA with (eqA:=eqke) (eqB:=eqA); auto. - intros (k,e) (k',e') (Hk,He) a a' Ha; simpl in *; apply Hf; auto. - apply eqlistA_rev. apply elements_Equal_eqlistA. auto. Qed. Lemma fold_Add_Above : forall m1 m2 x e (A:Type)(eqA:A->A->Prop)(st:Equivalence eqA) (f:key->elt->A->A)(i:A) (P:Proper (E.eq==>eq==>eqA==>eqA) f), Above x m1 -> Add x e m1 m2 -> eqA (fold f m2 i) (f x e (fold f m1 i)). Proof. intros. rewrite 2 fold_spec_right. set (f':=uncurry f). transitivity (fold_right f' i (rev (elements m1 ++ (x,e)::nil))). - apply fold_right_eqlistA with (eqA:=eqke) (eqB:=eqA); auto. + intros (k1,e1) (k2,e2) (Hk,He) a1 a2 Ha; unfold f'; simpl in *. apply P; auto. + apply eqlistA_rev. apply elements_Add_Above; auto. - rewrite distr_rev; simpl. reflexivity. Qed. Lemma fold_Add_Below : forall m1 m2 x e (A:Type)(eqA:A->A->Prop)(st:Equivalence eqA) (f:key->elt->A->A)(i:A) (P:Proper (E.eq==>eq==>eqA==>eqA) f), Below x m1 -> Add x e m1 m2 -> eqA (fold f m2 i) (fold f m1 (f x e i)). Proof. intros. rewrite 2 fold_spec_right. set (f':=uncurry f). transitivity (fold_right f' i (rev (((x,e)::nil)++elements m1))). - apply fold_right_eqlistA with (eqA:=eqke) (eqB:=eqA); auto. + intros (k1,e1) (k2,e2) (Hk,He) a1 a2 Ha; unfold f'; simpl in *; apply P; auto. + apply eqlistA_rev. simpl; apply elements_Add_Below; auto. - rewrite distr_rev; simpl. rewrite fold_right_app. reflexivity. Qed. End Fold_properties. End Elt. End OrdProperties. coq-8.20.0/theories/FSets/FMapFullAVL.v000066400000000000000000000606051466560755400174620ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* Prop := | RBLeaf : avl (Leaf _) | RBNode : forall x e l r h, avl l -> avl r -> -(2) <= height l - height r <= 2 -> h = max (height l) (height r) + 1 -> avl (Node l x e r h). (** * Automation and dedicated tactics about [avl]. *) #[local] Hint Constructors avl : core. Lemma height_non_negative : forall (s : t elt), avl s -> height s >= 0. Proof. induction s; simpl; intros. - now apply Z.le_ge. - inv avl; intuition; omega_max. Qed. Ltac avl_nn_hyp H := let nz := fresh "nz" in assert (nz := height_non_negative H). Ltac avl_nn h := let t := type of h in match type of t with | Prop => avl_nn_hyp h | _ => match goal with H : avl h |- _ => avl_nn_hyp H end end. (* Repeat the previous tactic. Drawback: need to clear the [avl _] hyps ... Thank you Ltac *) Ltac avl_nns := match goal with | H:avl _ |- _ => avl_nn_hyp H; clear H; avl_nns | _ => idtac end. (** * Basic results about [avl], [height] *) Lemma avl_node : forall x e l r, avl l -> avl r -> -(2) <= height l - height r <= 2 -> avl (Node l x e r (max (height l) (height r) + 1)). Proof. intros; auto. Qed. #[local] Hint Resolve avl_node : core. (** Results about [height] *) Lemma height_0 : forall l, avl l -> height l = 0 -> l = Leaf _. Proof. destruct 1; intuition; simpl in *. avl_nns; simpl in *; exfalso; omega_max. Qed. (** * Empty map *) Lemma empty_avl : avl (empty elt). Proof. unfold empty; auto. Qed. (** * Helper functions *) Lemma create_avl : forall l x e r, avl l -> avl r -> -(2) <= height l - height r <= 2 -> avl (create l x e r). Proof. unfold create; auto. Qed. Lemma create_height : forall l x e r, avl l -> avl r -> -(2) <= height l - height r <= 2 -> height (create l x e r) = max (height l) (height r) + 1. Proof. unfold create; intros; auto. Qed. Lemma bal_avl : forall l x e r, avl l -> avl r -> -(3) <= height l - height r <= 3 -> avl (bal l x e r). Proof. intros l x e r; induction elt, l, x, e, r, (bal l x e r) using bal_ind; intros; clearf; inv avl; simpl in *; match goal with |- avl (assert_false _ _ _ _) => avl_nns | _ => repeat apply create_avl; simpl in *; auto end; omega_max. Qed. Lemma bal_height_1 : forall l x e r, avl l -> avl r -> -(3) <= height l - height r <= 3 -> 0 <= height (bal l x e r) - max (height l) (height r) <= 1. Proof. intros l x e r; induction elt, l, x, e, r, (bal l x e r) using bal_ind; intros; clearf; inv avl; avl_nns; simpl in *; omega_max. Qed. Lemma bal_height_2 : forall l x e r, avl l -> avl r -> -(2) <= height l - height r <= 2 -> height (bal l x e r) == max (height l) (height r) +1. Proof. intros l x e r; induction elt, l, x, e, r, (bal l x e r) using bal_ind; intros; clearf; inv avl; avl_nns; simpl in *; omega_max. Qed. Ltac omega_bal := match goal with | H:avl ?l, H':avl ?r |- context [ bal ?l ?x ?e ?r ] => generalize (bal_height_1 x e H H') (bal_height_2 x e H H'); omega_max end. (** * Insertion *) Lemma add_avl_1 : forall m x e, avl m -> avl (add x e m) /\ 0 <= height (add x e m) - height m <= 1. Proof. intros m x e; induction elt, x, e, m, (add x e m) using add_ind; clearf; intros; inv avl; simpl in *. - intuition; try constructor; simpl; auto; try omega_max. - (* LT *) destruct IHt; auto. split. + apply bal_avl; auto; omega_max. + omega_bal. - (* EQ *) intuition; omega_max. - (* GT *) destruct IHt; auto. split. + apply bal_avl; auto; omega_max. + omega_bal. Qed. Lemma add_avl : forall m x e, avl m -> avl (add x e m). Proof. intros; generalize (add_avl_1 x e H); intuition. Qed. #[local] Hint Resolve add_avl : core. (** * Extraction of minimum binding *) Lemma remove_min_avl_1 : forall l x e r h, avl (Node l x e r h) -> avl (remove_min l x e r)#1 /\ 0 <= height (Node l x e r h) - height (remove_min l x e r)#1 <= 1. Proof. intros l x e r; induction elt, l, x, e, r, (remove_min l x e r) using remove_min_ind; clearf; simpl in *; intros. - inv avl; simpl in *; split; auto. avl_nns; omega_max. - inversion_clear H. rewrite e0 in IHp;simpl in IHp;destruct (IHp _x); auto. split; simpl in *. + apply bal_avl; auto; omega_max. + omega_bal. Qed. Lemma remove_min_avl : forall l x e r h, avl (Node l x e r h) -> avl (remove_min l x e r)#1. Proof. intros; generalize (remove_min_avl_1 H); intuition. Qed. (** * Merging two trees *) Lemma merge_avl_1 : forall m1 m2, avl m1 -> avl m2 -> -(2) <= height m1 - height m2 <= 2 -> avl (merge m1 m2) /\ 0<= height (merge m1 m2) - max (height m1) (height m2) <=1. Proof. intros m1 m2; induction elt, m1, m2, (merge m1 m2) using merge_ind; clearf; intros; try factornode _x _x0 _x1 _x2 _x3 as m1. - simpl; split; auto; avl_nns; omega_max. - simpl; split; auto; avl_nns; omega_max. - generalize (remove_min_avl_1 H0). rewrite e1; destruct 1. split. + apply bal_avl; auto. omega_max. + omega_bal. Qed. Lemma merge_avl : forall m1 m2, avl m1 -> avl m2 -> -(2) <= height m1 - height m2 <= 2 -> avl (merge m1 m2). Proof. intros; generalize (merge_avl_1 H H0 H1); intuition. Qed. (** * Deletion *) Lemma remove_avl_1 : forall m x, avl m -> avl (remove x m) /\ 0 <= height m - height (remove x m) <= 1. Proof. intros m x; induction elt, x, m, (remove x m) using remove_ind; clearf; intros. - split; auto; omega_max. - (* LT *) inv avl. destruct (IHt H0). split. + apply bal_avl; auto. omega_max. + omega_bal. - (* EQ *) inv avl. generalize (merge_avl_1 H0 H1 H2). intuition omega_max. - (* GT *) inv avl. destruct (IHt H1). split. + apply bal_avl; auto. omega_max. + omega_bal. Qed. Lemma remove_avl : forall m x, avl m -> avl (remove x m). Proof. intros; generalize (remove_avl_1 x H); intuition. Qed. #[local] Hint Resolve remove_avl : core. (** * Join *) Lemma join_avl_1 : forall l x d r, avl l -> avl r -> avl (join l x d r) /\ 0<= height (join l x d r) - max (height l) (height r) <= 1. Proof. join_tac. - split; simpl; auto. destruct (add_avl_1 x d H0). avl_nns; omega_max. - set (l:=Node ll lx ld lr lh) in *. split; auto. destruct (add_avl_1 x d H). simpl (height (Leaf elt)). avl_nns; omega_max. - inversion_clear H. assert (height (Node rl rx rd rr rh) = rh); auto. set (r := Node rl rx rd rr rh) in *; clearbody r. destruct (Hlr x d r H2 H0); clear Hrl Hlr. set (j := join lr x d r) in *; clearbody j. simpl. assert (-(3) <= height ll - height j <= 3) by omega_max. split. + apply bal_avl; auto. + omega_bal. - inversion_clear H0. assert (height (Node ll lx ld lr lh) = lh); auto. set (l := Node ll lx ld lr lh) in *; clearbody l. destruct (Hrl H H1); clear Hrl Hlr. set (j := join l x d rl) in *; clearbody j. simpl. assert (-(3) <= height j - height rr <= 3) by omega_max. split. + apply bal_avl; auto. + omega_bal. - clear Hrl Hlr. assert (height (Node ll lx ld lr lh) = lh); auto. assert (height (Node rl rx rd rr rh) = rh); auto. set (l := Node ll lx ld lr lh) in *; clearbody l. set (r := Node rl rx rd rr rh) in *; clearbody r. assert (-(2) <= height l - height r <= 2) by omega_max. split. + apply create_avl; auto. + rewrite create_height; auto; omega_max. Qed. Lemma join_avl : forall l x d r, avl l -> avl r -> avl (join l x d r). Proof. intros; destruct (join_avl_1 x d H H0); auto. Qed. #[local] Hint Resolve join_avl : core. (** concat *) Lemma concat_avl : forall m1 m2, avl m1 -> avl m2 -> avl (concat m1 m2). Proof. intros m1 m2; induction elt, m1, m2, (concat m1 m2) using concat_ind; clearf; auto. intros; apply join_avl; auto. generalize (remove_min_avl H0); rewrite e1; simpl; auto. Qed. #[local] Hint Resolve concat_avl : core. (** split *) Lemma split_avl : forall m x, avl m -> avl (split x m)#l /\ avl (split x m)#r. Proof. intros m x; induction elt, x, m, (split x m) using split_ind; clearf; simpl; auto. - rewrite e1 in IHt;simpl in IHt;inversion_clear 1; intuition. - simpl; inversion_clear 1; auto. - rewrite e1 in IHt;simpl in IHt;inversion_clear 1; intuition. Qed. End Elt. #[global] Hint Constructors avl : core. Section Map. Variable elt elt' : Type. Variable f : elt -> elt'. Lemma map_height : forall m, height (map f m) = height m. Proof. destruct m; simpl; auto. Qed. Lemma map_avl : forall m, avl m -> avl (map f m). Proof. induction m; simpl; auto. inversion_clear 1; constructor; auto; do 2 rewrite map_height; auto. Qed. End Map. Section Mapi. Variable elt elt' : Type. Variable f : key -> elt -> elt'. Lemma mapi_height : forall m, height (mapi f m) = height m. Proof. destruct m; simpl; auto. Qed. Lemma mapi_avl : forall m, avl m -> avl (mapi f m). Proof. induction m; simpl; auto. inversion_clear 1; constructor; auto; do 2 rewrite mapi_height; auto. Qed. End Mapi. Section Map_option. Variable elt elt' : Type. Variable f : key -> elt -> option elt'. Lemma map_option_avl : forall m, avl m -> avl (map_option f m). Proof. induction m; simpl; auto; intros. inv avl; destruct (f k e); auto using join_avl, concat_avl. Qed. End Map_option. Section Map2_opt. Variable elt elt' elt'' : Type. Variable f : key -> elt -> option elt' -> option elt''. Variable mapl : t elt -> t elt''. Variable mapr : t elt' -> t elt''. Hypothesis mapl_avl : forall m, avl m -> avl (mapl m). Hypothesis mapr_avl : forall m', avl m' -> avl (mapr m'). Notation map2_opt := (map2_opt f mapl mapr). Lemma map2_opt_avl : forall m1 m2, avl m1 -> avl m2 -> avl (map2_opt m1 m2). Proof. intros m1 m2; induction elt, elt', elt'', f, mapl, mapr, m1, m2, (map2_opt m1 m2) using map2_opt_ind; clearf; auto; factornode _x0 _x1 _x2 _x3 _x4 as r2; intros; destruct (split_avl x1 H0); rewrite e1 in *; simpl in *; inv avl; auto using join_avl, concat_avl. Qed. End Map2_opt. Section Map2. Variable elt elt' elt'' : Type. Variable f : option elt -> option elt' -> option elt''. Lemma map2_avl : forall m1 m2, avl m1 -> avl m2 -> avl (map2 f m1 m2). Proof. unfold map2; auto using map2_opt_avl, map_option_avl. Qed. End Map2. End AvlProofs. (** * Encapsulation We can implement [S] with balanced binary search trees. When compared to [FMapAVL], we maintain here two invariants (bst and avl) instead of only bst, which is enough for fulfilling the FMap interface. *) Module IntMake (I:Int)(X: OrderedType) <: S with Module E := X. Module E := X. Module Import AvlProofs := AvlProofs I X. Import Raw. Import Raw.Proofs. #[universes(template)] Record bbst (elt:Type) := Bbst {this :> tree elt; is_bst : bst this; is_avl: avl this}. Definition t := bbst. Definition key := E.t. Section Elt. Variable elt elt' elt'': Type. Implicit Types m : t elt. Implicit Types x y : key. Implicit Types e : elt. Definition empty : t elt := Bbst (empty_bst elt) (empty_avl elt). Definition is_empty m : bool := is_empty (this m). Definition add x e m : t elt := Bbst (add_bst x e (is_bst m)) (add_avl x e (is_avl m)). Definition remove x m : t elt := Bbst (remove_bst x (is_bst m)) (remove_avl x (is_avl m)). Definition mem x m : bool := mem x (this m). Definition find x m : option elt := find x (this m). Definition map f m : t elt' := Bbst (map_bst f (is_bst m)) (map_avl f (is_avl m)). Definition mapi (f:key->elt->elt') m : t elt' := Bbst (mapi_bst f (is_bst m)) (mapi_avl f (is_avl m)). Definition map2 f m (m':t elt') : t elt'' := Bbst (map2_bst f (is_bst m) (is_bst m')) (map2_avl f (is_avl m) (is_avl m')). Definition elements m : list (key*elt) := elements (this m). Definition cardinal m := cardinal (this m). Definition fold (A:Type) (f:key->elt->A->A) m i := fold (A:=A) f (this m) i. Definition equal cmp m m' : bool := equal cmp (this m) (this m'). Definition MapsTo x e m : Prop := MapsTo x e (this m). Definition In x m : Prop := In0 x (this m). Definition Empty m : Prop := Empty (this m). Definition eq_key : (key*elt) -> (key*elt) -> Prop := @PX.eqk elt. Definition eq_key_elt : (key*elt) -> (key*elt) -> Prop := @PX.eqke elt. Definition lt_key : (key*elt) -> (key*elt) -> Prop := @PX.ltk elt. Lemma MapsTo_1 : forall m x y e, E.eq x y -> MapsTo x e m -> MapsTo y e m. Proof. intros m; exact (@MapsTo_1 _ (this m)). Qed. Lemma mem_1 : forall m x, In x m -> mem x m = true. Proof. unfold In, mem; intros m x; rewrite In_alt; simpl; apply mem_1; auto. apply (is_bst m). Qed. Lemma mem_2 : forall m x, mem x m = true -> In x m. Proof. unfold In, mem; intros m x; rewrite In_alt; simpl; apply mem_2; auto. Qed. Lemma empty_1 : Empty empty. Proof. exact (@empty_1 elt). Qed. Lemma is_empty_1 : forall m, Empty m -> is_empty m = true. Proof. intros m; exact (@is_empty_1 _ (this m)). Qed. Lemma is_empty_2 : forall m, is_empty m = true -> Empty m. Proof. intros m; exact (@is_empty_2 _ (this m)). Qed. Lemma add_1 : forall m x y e, E.eq x y -> MapsTo y e (add x e m). Proof. intros m x y e; exact (@add_1 elt _ x y e). Qed. Lemma add_2 : forall m x y e e', ~ E.eq x y -> MapsTo y e m -> MapsTo y e (add x e' m). Proof. intros m x y e e'; exact (@add_2 elt _ x y e e'). Qed. Lemma add_3 : forall m x y e e', ~ E.eq x y -> MapsTo y e (add x e' m) -> MapsTo y e m. Proof. intros m x y e e'; exact (@add_3 elt _ x y e e'). Qed. Lemma remove_1 : forall m x y, E.eq x y -> ~ In y (remove x m). Proof. unfold In, remove; intros m x y; rewrite In_alt; simpl; apply remove_1; auto. apply (is_bst m). Qed. Lemma remove_2 : forall m x y e, ~ E.eq x y -> MapsTo y e m -> MapsTo y e (remove x m). Proof. intros m x y e; exact (@remove_2 elt _ x y e (is_bst m)). Qed. Lemma remove_3 : forall m x y e, MapsTo y e (remove x m) -> MapsTo y e m. Proof. intros m x y e; exact (@remove_3 elt _ x y e (is_bst m)). Qed. Lemma find_1 : forall m x e, MapsTo x e m -> find x m = Some e. Proof. intros m x e; exact (@find_1 elt _ x e (is_bst m)). Qed. Lemma find_2 : forall m x e, find x m = Some e -> MapsTo x e m. Proof. intros m; exact (@find_2 elt (this m)). Qed. Lemma fold_1 : forall m (A : Type) (i : A) (f : key -> elt -> A -> A), fold f m i = fold_left (fun a p => f (fst p) (snd p) a) (elements m) i. Proof. intros m; exact (@fold_1 elt (this m) (is_bst m)). Qed. Lemma elements_1 : forall m x e, MapsTo x e m -> InA eq_key_elt (x,e) (elements m). Proof. intros; unfold elements, MapsTo, eq_key_elt; rewrite elements_mapsto; auto. Qed. Lemma elements_2 : forall m x e, InA eq_key_elt (x,e) (elements m) -> MapsTo x e m. Proof. intros; unfold elements, MapsTo, eq_key_elt; rewrite <- elements_mapsto; auto. Qed. Lemma elements_3 : forall m, sort lt_key (elements m). Proof. intros m; exact (@elements_sort elt (this m) (is_bst m)). Qed. Lemma elements_3w : forall m, NoDupA eq_key (elements m). Proof. intros m; exact (@elements_nodup elt (this m) (is_bst m)). Qed. Lemma cardinal_1 : forall m, cardinal m = length (elements m). Proof. intro m; exact (@elements_cardinal elt (this m)). Qed. Definition Equal m m' := forall y, find y m = find y m'. Definition Equiv (eq_elt:elt->elt->Prop) m m' := (forall k, In k m <-> In k m') /\ (forall k e e', MapsTo k e m -> MapsTo k e' m' -> eq_elt e e'). Definition Equivb cmp := Equiv (Cmp cmp). Lemma Equivb_Equivb : forall cmp m m', Equivb cmp m m' <-> Raw.Proofs.Equivb cmp m m'. Proof. intros; unfold Equivb, Equiv, Raw.Proofs.Equivb, In; intuition. - generalize (H0 k); do 2 rewrite In_alt; intuition. - generalize (H0 k); do 2 rewrite In_alt; intuition. - generalize (H0 k); do 2 rewrite <- In_alt; intuition. - generalize (H0 k); do 2 rewrite <- In_alt; intuition. Qed. Lemma equal_1 : forall m m' cmp, Equivb cmp m m' -> equal cmp m m' = true. Proof. unfold equal; intros (m,b,a) (m',b',a') cmp; rewrite Equivb_Equivb; intros; simpl in *; rewrite equal_Equivb; auto. Qed. Lemma equal_2 : forall m m' cmp, equal cmp m m' = true -> Equivb cmp m m'. Proof. unfold equal; intros (m,b,a) (m',b',a') cmp; rewrite Equivb_Equivb; intros; simpl in *; rewrite <-equal_Equivb; auto. Qed. End Elt. Lemma map_1 : forall (elt elt':Type)(m: t elt)(x:key)(e:elt)(f:elt->elt'), MapsTo x e m -> MapsTo x (f e) (map f m). Proof. intros elt elt' m x e f; exact (@map_1 elt elt' f (this m) x e). Qed. Lemma map_2 : forall (elt elt':Type)(m:t elt)(x:key)(f:elt->elt'), In x (map f m) -> In x m. Proof. intros elt elt' m x f; do 2 unfold In in *; do 2 rewrite In_alt; simpl. apply map_2; auto. Qed. Lemma mapi_1 : forall (elt elt':Type)(m: t elt)(x:key)(e:elt) (f:key->elt->elt'), MapsTo x e m -> exists y, E.eq y x /\ MapsTo x (f y e) (mapi f m). Proof. intros elt elt' m x e f; exact (@mapi_1 elt elt' f (this m) x e). Qed. Lemma mapi_2 : forall (elt elt':Type)(m: t elt)(x:key) (f:key->elt->elt'), In x (mapi f m) -> In x m. Proof. intros elt elt' m x f; unfold In in *; do 2 rewrite In_alt; simpl; apply mapi_2; auto. Qed. Lemma map2_1 : forall (elt elt' elt'':Type)(m: t elt)(m': t elt') (x:key)(f:option elt->option elt'->option elt''), In x m \/ In x m' -> find x (map2 f m m') = f (find x m) (find x m'). Proof. unfold find, map2, In; intros elt elt' elt'' m m' x f. do 2 rewrite In_alt; intros; simpl; apply map2_1; auto. - apply (is_bst m). - apply (is_bst m'). Qed. Lemma map2_2 : forall (elt elt' elt'':Type)(m: t elt)(m': t elt') (x:key)(f:option elt->option elt'->option elt''), In x (map2 f m m') -> In x m \/ In x m'. Proof. unfold In, map2; intros elt elt' elt'' m m' x f. do 3 rewrite In_alt; intros; simpl in *; eapply map2_2; eauto. - apply (is_bst m). - apply (is_bst m'). Qed. End IntMake. Module IntMake_ord (I:Int)(X: OrderedType)(D : OrderedType) <: Sord with Module Data := D with Module MapS.E := X. Module Data := D. Module Import MapS := IntMake(I)(X). Import AvlProofs. Import Raw.Proofs. Module Import MD := OrderedTypeFacts(D). Module LO := FMapList.Make_ord(X)(D). Definition t := MapS.t D.t. Definition cmp e e' := match D.compare e e' with EQ _ => true | _ => false end. Definition elements (m:t) := LO.MapS.Build_slist (Raw.Proofs.elements_sort (is_bst m)). (** * As comparison function, we propose here a non-structural version faithful to the code of Ocaml's Map library, instead of the structural version of FMapAVL *) Fixpoint cardinal_e (e:Raw.enumeration D.t) := match e with | Raw.End _ => 0%nat | Raw.More _ _ r e => S (Raw.cardinal r + cardinal_e e) end. Lemma cons_cardinal_e : forall m e, cardinal_e (Raw.cons m e) = (Raw.cardinal m + cardinal_e e)%nat. Proof. induction m; simpl; intros; auto. rewrite IHm1; simpl; rewrite <- plus_n_Sm; auto with arith. Qed. Definition cardinal_e_2 ee := (cardinal_e (fst ee) + cardinal_e (snd ee))%nat. Local Unset Keyed Unification. Function compare_aux (ee:Raw.enumeration D.t * Raw.enumeration D.t) { measure cardinal_e_2 ee } : comparison := match ee with | (Raw.End _, Raw.End _) => Eq | (Raw.End _, Raw.More _ _ _ _) => Lt | (Raw.More _ _ _ _, Raw.End _) => Gt | (Raw.More x1 d1 r1 e1, Raw.More x2 d2 r2 e2) => match X.compare x1 x2 with | EQ _ => match D.compare d1 d2 with | EQ _ => compare_aux (Raw.cons r1 e1, Raw.cons r2 e2) | LT _ => Lt | GT _ => Gt end | LT _ => Lt | GT _ => Gt end end. Proof. intros; unfold cardinal_e_2; simpl; abstract (do 2 rewrite cons_cardinal_e; lia ). Defined. Definition Cmp c := match c with | Eq => LO.eq_list | Lt => LO.lt_list | Gt => (fun l1 l2 => LO.lt_list l2 l1) end. Lemma cons_Cmp : forall c x1 x2 d1 d2 l1 l2, X.eq x1 x2 -> D.eq d1 d2 -> Cmp c l1 l2 -> Cmp c ((x1,d1)::l1) ((x2,d2)::l2). Proof. destruct c; simpl; intros; MX.elim_comp; auto with ordered_type. Qed. #[global] Hint Resolve cons_Cmp : core. Lemma compare_aux_Cmp : forall e, Cmp (compare_aux e) (flatten_e (fst e)) (flatten_e (snd e)). Proof. intros e; induction e, (compare_aux e) using compare_aux_ind; clearf; simpl in *; auto; intros; try clear e0; try clear e3; try MX.elim_comp; auto. rewrite 2 cons_1 in IHc; auto. Qed. Lemma compare_Cmp : forall m1 m2, Cmp (compare_aux (Raw.cons m1 (Raw.End _), Raw.cons m2 (Raw.End _))) (Raw.elements m1) (Raw.elements m2). Proof. intros. assert (H1:=cons_1 m1 (Raw.End _)). assert (H2:=cons_1 m2 (Raw.End _)). simpl in *; rewrite app_nil_r in *; rewrite <-H1,<-H2. apply (@compare_aux_Cmp (Raw.cons m1 (Raw.End _), Raw.cons m2 (Raw.End _))). Qed. Definition eq (m1 m2 : t) := LO.eq_list (Raw.elements m1) (Raw.elements m2). Definition lt (m1 m2 : t) := LO.lt_list (Raw.elements m1) (Raw.elements m2). Definition compare (s s':t) : Compare lt eq s s'. Proof. destruct s as (s,b,a), s' as (s',b',a'). generalize (compare_Cmp s s'). destruct compare_aux; intros; [apply EQ|apply LT|apply GT]; red; auto. Defined. (* Proofs about [eq] and [lt] *) Definition selements (m1 : t) := LO.MapS.Build_slist (elements_sort (is_bst m1)). Definition seq (m1 m2 : t) := LO.eq (selements m1) (selements m2). Definition slt (m1 m2 : t) := LO.lt (selements m1) (selements m2). Lemma eq_seq : forall m1 m2, eq m1 m2 <-> seq m1 m2. Proof. unfold eq, seq, selements, elements, LO.eq; intuition. Qed. Lemma lt_slt : forall m1 m2, lt m1 m2 <-> slt m1 m2. Proof. unfold lt, slt, selements, elements, LO.lt; intuition. Qed. Lemma eq_1 : forall (m m' : t), MapS.Equivb cmp m m' -> eq m m'. Proof. intros m m'. rewrite eq_seq; unfold seq. rewrite Equivb_Equivb. rewrite Equivb_elements. auto using LO.eq_1. Qed. Lemma eq_2 : forall m m', eq m m' -> MapS.Equivb cmp m m'. Proof. intros m m'. rewrite eq_seq; unfold seq. rewrite Equivb_Equivb. rewrite Equivb_elements. intros. generalize (LO.eq_2 H). auto. Qed. Lemma eq_refl : forall m : t, eq m m. Proof. intros; rewrite eq_seq; unfold seq; intros; apply LO.eq_refl. Qed. Lemma eq_sym : forall m1 m2 : t, eq m1 m2 -> eq m2 m1. Proof. intros m1 m2; rewrite 2 eq_seq; unfold seq; intros; apply LO.eq_sym; auto. Qed. Lemma eq_trans : forall m1 m2 m3 : t, eq m1 m2 -> eq m2 m3 -> eq m1 m3. Proof. intros m1 m2 M3; rewrite 3 eq_seq; unfold seq. intros; eapply LO.eq_trans; eauto. Qed. Lemma lt_trans : forall m1 m2 m3 : t, lt m1 m2 -> lt m2 m3 -> lt m1 m3. Proof. intros m1 m2 m3; rewrite 3 lt_slt; unfold slt; intros; eapply LO.lt_trans; eauto. Qed. Lemma lt_not_eq : forall m1 m2 : t, lt m1 m2 -> ~ eq m1 m2. Proof. intros m1 m2; rewrite lt_slt, eq_seq; unfold slt, seq; intros; apply LO.lt_not_eq; auto. Qed. End IntMake_ord. (* For concrete use inside Coq, we propose an instantiation of [Int] by [Z]. *) Module Make (X: OrderedType) <: S with Module E := X :=IntMake(Z_as_Int)(X). Module Make_ord (X: OrderedType)(D: OrderedType) <: Sord with Module Data := D with Module MapS.E := X :=IntMake_ord(Z_as_Int)(X)(D). coq-8.20.0/theories/FSets/FMapInterface.v000066400000000000000000000275661466560755400201260ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* elt->bool) e1 e2 := cmp e1 e2 = true. (** ** Weak signature for maps No requirements for an ordering on keys nor elements, only decidability of equality on keys. First, a functorial signature: *) Module Type WSfun (E : DecidableType). Definition key := E.t. #[global] Hint Transparent key : core. Parameter t : Type -> Type. (** the abstract type of maps *) Section Types. Variable elt:Type. Parameter empty : t elt. (** The empty map. *) Parameter is_empty : t elt -> bool. (** Test whether a map is empty or not. *) Parameter add : key -> elt -> t elt -> t elt. (** [add x y m] returns a map containing the same bindings as [m], plus a binding of [x] to [y]. If [x] was already bound in [m], its previous binding disappears. *) Parameter find : key -> t elt -> option elt. (** [find x m] returns the current binding of [x] in [m], or [None] if no such binding exists. *) Parameter remove : key -> t elt -> t elt. (** [remove x m] returns a map containing the same bindings as [m], except for [x] which is unbound in the returned map. *) Parameter mem : key -> t elt -> bool. (** [mem x m] returns [true] if [m] contains a binding for [x], and [false] otherwise. *) Variable elt' elt'' : Type. Parameter map : (elt -> elt') -> t elt -> t elt'. (** [map f m] returns a map with same domain as [m], where the associated value a of all bindings of [m] has been replaced by the result of the application of [f] to [a]. Since Coq is purely functional, the order in which the bindings are passed to [f] is irrelevant. *) Parameter mapi : (key -> elt -> elt') -> t elt -> t elt'. (** Same as [map], but the function receives as arguments both the key and the associated value for each binding of the map. *) Parameter map2 : (option elt -> option elt' -> option elt'') -> t elt -> t elt' -> t elt''. (** [map2 f m m'] creates a new map whose bindings belong to the ones of either [m] or [m']. The presence and value for a key [k] is determined by [f e e'] where [e] and [e'] are the (optional) bindings of [k] in [m] and [m']. *) Parameter elements : t elt -> list (key*elt). (** [elements m] returns an assoc list corresponding to the bindings of [m], in any order. *) Parameter cardinal : t elt -> nat. (** [cardinal m] returns the number of bindings in [m]. *) Parameter fold : forall A: Type, (key -> elt -> A -> A) -> t elt -> A -> A. (** [fold f m a] computes [(f kN dN ... (f k1 d1 a)...)], where [k1] ... [kN] are the keys of all bindings in [m] (in any order), and [d1] ... [dN] are the associated data. *) Parameter equal : (elt -> elt -> bool) -> t elt -> t elt -> bool. (** [equal cmp m1 m2] tests whether the maps [m1] and [m2] are equal, that is, contain equal keys and associate them with equal data. [cmp] is the equality predicate used to compare the data associated with the keys. *) Section Spec. Variable m m' m'' : t elt. Variable x y z : key. Variable e e' : elt. Parameter MapsTo : key -> elt -> t elt -> Prop. Definition In (k:key)(m: t elt) : Prop := exists e:elt, MapsTo k e m. Definition Empty m := forall (a : key)(e:elt) , ~ MapsTo a e m. Definition eq_key (p p':key*elt) := E.eq (fst p) (fst p'). Definition eq_key_elt (p p':key*elt) := E.eq (fst p) (fst p') /\ (snd p) = (snd p'). (** Specification of [MapsTo] *) Parameter MapsTo_1 : E.eq x y -> MapsTo x e m -> MapsTo y e m. (** Specification of [mem] *) Parameter mem_1 : In x m -> mem x m = true. Parameter mem_2 : mem x m = true -> In x m. (** Specification of [empty] *) Parameter empty_1 : Empty empty. (** Specification of [is_empty] *) Parameter is_empty_1 : Empty m -> is_empty m = true. Parameter is_empty_2 : is_empty m = true -> Empty m. (** Specification of [add] *) Parameter add_1 : E.eq x y -> MapsTo y e (add x e m). Parameter add_2 : ~ E.eq x y -> MapsTo y e m -> MapsTo y e (add x e' m). Parameter add_3 : ~ E.eq x y -> MapsTo y e (add x e' m) -> MapsTo y e m. (** Specification of [remove] *) Parameter remove_1 : E.eq x y -> ~ In y (remove x m). Parameter remove_2 : ~ E.eq x y -> MapsTo y e m -> MapsTo y e (remove x m). Parameter remove_3 : MapsTo y e (remove x m) -> MapsTo y e m. (** Specification of [find] *) Parameter find_1 : MapsTo x e m -> find x m = Some e. Parameter find_2 : find x m = Some e -> MapsTo x e m. (** Specification of [elements] *) Parameter elements_1 : MapsTo x e m -> InA eq_key_elt (x,e) (elements m). Parameter elements_2 : InA eq_key_elt (x,e) (elements m) -> MapsTo x e m. (** When compared with ordered maps, here comes the only property that is really weaker: *) Parameter elements_3w : NoDupA eq_key (elements m). (** Specification of [cardinal] *) Parameter cardinal_1 : cardinal m = length (elements m). (** Specification of [fold] *) Parameter fold_1 : forall (A : Type) (i : A) (f : key -> elt -> A -> A), fold f m i = fold_left (fun a p => f (fst p) (snd p) a) (elements m) i. (** Equality of maps *) (** Caveat: there are at least three distinct equality predicates on maps. - The simplest (and maybe most natural) way is to consider keys up to their equivalence [E.eq], but elements up to Leibniz equality, in the spirit of [eq_key_elt] above. This leads to predicate [Equal]. - Unfortunately, this [Equal] predicate can't be used to describe the [equal] function, since this function (for compatibility with ocaml) expects a boolean comparison [cmp] that may identify more elements than Leibniz. So logical specification of [equal] is done via another predicate [Equivb] - This predicate [Equivb] is quite ad-hoc with its boolean [cmp], it can be generalized in a [Equiv] expecting a more general (possibly non-decidable) equality predicate on elements *) Definition Equal m m' := forall y, find y m = find y m'. Definition Equiv (eq_elt:elt->elt->Prop) m m' := (forall k, In k m <-> In k m') /\ (forall k e e', MapsTo k e m -> MapsTo k e' m' -> eq_elt e e'). Definition Equivb (cmp: elt->elt->bool) := Equiv (Cmp cmp). (** Specification of [equal] *) Variable cmp : elt -> elt -> bool. Parameter equal_1 : Equivb cmp m m' -> equal cmp m m' = true. Parameter equal_2 : equal cmp m m' = true -> Equivb cmp m m'. End Spec. End Types. (** Specification of [map] *) Parameter map_1 : forall (elt elt':Type)(m: t elt)(x:key)(e:elt)(f:elt->elt'), MapsTo x e m -> MapsTo x (f e) (map f m). Parameter map_2 : forall (elt elt':Type)(m: t elt)(x:key)(f:elt->elt'), In x (map f m) -> In x m. (** Specification of [mapi] *) Parameter mapi_1 : forall (elt elt':Type)(m: t elt)(x:key)(e:elt) (f:key->elt->elt'), MapsTo x e m -> exists y, E.eq y x /\ MapsTo x (f y e) (mapi f m). Parameter mapi_2 : forall (elt elt':Type)(m: t elt)(x:key) (f:key->elt->elt'), In x (mapi f m) -> In x m. (** Specification of [map2] *) Parameter map2_1 : forall (elt elt' elt'':Type)(m: t elt)(m': t elt') (x:key)(f:option elt->option elt'->option elt''), In x m \/ In x m' -> find x (map2 f m m') = f (find x m) (find x m'). Parameter map2_2 : forall (elt elt' elt'':Type)(m: t elt)(m': t elt') (x:key)(f:option elt->option elt'->option elt''), In x (map2 f m m') -> In x m \/ In x m'. #[global] Hint Immediate MapsTo_1 mem_2 is_empty_2 map_2 mapi_2 add_3 remove_3 find_2 : map. #[global] Hint Resolve mem_1 is_empty_1 is_empty_2 add_1 add_2 remove_1 remove_2 find_1 fold_1 map_1 mapi_1 mapi_2 : map. End WSfun. (** ** Static signature for Weak Maps Similar to [WSfun] but expressed in a self-contained way. *) Module Type WS. Declare Module E : DecidableType. Include WSfun E. End WS. (** ** Maps on ordered keys, functorial signature *) Module Type Sfun (E : OrderedType). Include WSfun E. Section elt. Variable elt:Type. Definition lt_key (p p':key*elt) := E.lt (fst p) (fst p'). (* Additional specification of [elements] *) Parameter elements_3 : forall m, sort lt_key (elements m). (** Remark: since [fold] is specified via [elements], this stronger specification of [elements] has an indirect impact on [fold], which can now be proved to receive elements in increasing order. *) End elt. End Sfun. (** ** Maps on ordered keys, self-contained signature *) Module Type S. Declare Module E : OrderedType. Include Sfun E. End S. (** ** Maps with ordering both on keys and datas *) Module Type Sord. Declare Module Data : OrderedType. Declare Module MapS : S. Import MapS. Definition t := MapS.t Data.t. Parameter eq : t -> t -> Prop. Parameter lt : t -> t -> Prop. Axiom eq_refl : forall m : t, eq m m. Axiom eq_sym : forall m1 m2 : t, eq m1 m2 -> eq m2 m1. Axiom eq_trans : forall m1 m2 m3 : t, eq m1 m2 -> eq m2 m3 -> eq m1 m3. Axiom lt_trans : forall m1 m2 m3 : t, lt m1 m2 -> lt m2 m3 -> lt m1 m3. Axiom lt_not_eq : forall m1 m2 : t, lt m1 m2 -> ~ eq m1 m2. Definition cmp e e' := match Data.compare e e' with EQ _ => true | _ => false end. Parameter eq_1 : forall m m', Equivb cmp m m' -> eq m m'. Parameter eq_2 : forall m m', eq m m' -> Equivb cmp m m'. Parameter compare : forall m1 m2, Compare lt eq m1 m2. (** Total ordering between maps. [Data.compare] is a total ordering used to compare data associated with equal keys in the two maps. *) End Sord. coq-8.20.0/theories/FSets/FMapList.v000066400000000000000000001174171466560755400171340ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* is_empty m = true. Proof. unfold Empty, PX.MapsTo. intros m. case m;auto. intros (k,e) l inlist. absurd (InA eqke (k, e) ((k, e) :: l)); auto with ordered_type. Qed. Lemma is_empty_2 : forall m, is_empty m = true -> Empty m. Proof. intros m. case m;auto. intros p l abs. inversion abs. Qed. (** * [mem] *) Fixpoint mem (k : key) (s : t elt) {struct s} : bool := match s with | nil => false | (k',_) :: l => match X.compare k k' with | LT _ => false | EQ _ => true | GT _ => mem k l end end. Lemma mem_1 : forall m (Hm:Sort m) x, In x m -> mem x m = true. Proof. intros m Hm; induction m as [|[a m]]; intros x H; simpl in *. - destruct H as [? H]; inversion H. - apply In_inv in H; destruct H as [H|H]. + destruct (elim_compare_eq H) as [? Hr]; rewrite Hr; reflexivity. + destruct (X.compare x a); [|reflexivity|apply IHm; inversion_clear Hm; auto]. absurd (In x ((a, m) :: m0)); [|destruct H as [y v]; exists y; constructor 2; auto]. apply Sort_Inf_NotIn with m; [inversion_clear Hm; auto|]. constructor; apply l. Qed. Lemma mem_2 : forall m (Hm:Sort m) x, mem x m = true -> In x m. Proof. intros m Hm; induction m as [|[a m]]; intros x H; simpl in *. - discriminate. - destruct X.compare; [discriminate| |]. + exists m; apply InA_cons_hd; split; auto. + inversion_clear Hm; destruct IHm with x as [e He]; auto. exists e; apply InA_cons_tl; auto. Qed. (** * [find] *) Fixpoint find (k:key) (s: t elt) {struct s} : option elt := match s with | nil => None | (k',x)::s' => match X.compare k k' with | LT _ => None | EQ _ => Some x | GT _ => find k s' end end. Lemma find_2 : forall m x e, find x m = Some e -> MapsTo x e m. Proof. induction m as [|[a m]]; intros x e H; simpl in *; [congruence|]. destruct X.compare; [congruence| |]. - apply InA_cons_hd; split; compute; congruence. - apply InA_cons_tl; apply IHm; auto. Qed. Lemma find_1 : forall m (Hm:Sort m) x e, MapsTo x e m -> find x m = Some e. Proof. intros m Hm; induction Hm as [|[a m] l Hm IHHm Hr]; intros x e H; simpl in *. - inversion H. - apply InA_cons in H; destruct H as [H|H]. * unfold eqke in H; simpl in H. destruct elim_compare_eq with x a as [H' r]; [tauto|]. rewrite r; f_equal; symmetry; tauto. * destruct elim_compare_gt with x a as [H' r]; [|rewrite r; apply IHHm, H]. apply InA_eqke_eqk in H. apply (Sort_Inf_In Hm Hr H). Qed. (** * [add] *) Fixpoint add (k : key) (x : elt) (s : t elt) {struct s} : t elt := match s with | nil => (k,x) :: nil | (k',y) :: l => match X.compare k k' with | LT _ => (k,x)::s | EQ _ => (k,x)::l | GT _ => (k',y) :: add k x l end end. Lemma add_1 : forall m x y e, X.eq x y -> MapsTo y e (add x e m). Proof. intros m x y e; generalize y; clear y. unfold PX.MapsTo. induction m as [|[y e'] m IHm]; simpl. - auto with ordered_type. - intros; destruct X.compare; auto with ordered_type. Qed. Lemma add_2 : forall m x y e e', ~ X.eq x y -> MapsTo y e m -> MapsTo y e (add x e' m). Proof. intros m x y e e' He H; unfold PX.MapsTo in *. induction m as [|[z e''] m IHm]; simpl. - auto. - destruct X.compare as [Hlt|Heq|Hgt]; simpl. + auto with ordered_type. + apply InA_cons_tl; apply InA_cons in H; destruct H; [|assumption]. compute in H; intuition order. + apply InA_cons in H; destruct H; [now auto with ordered_type|]. apply InA_cons_tl; apply IHm, H. Qed. Lemma add_3 : forall m x y e e', ~ X.eq x y -> MapsTo y e (add x e' m) -> MapsTo y e m. Proof. intros m x y e e' He H; unfold PX.MapsTo in *. induction m as [|[z e''] m IHm]; simpl in *. - apply (In_inv_3 H); auto with ordered_type. - destruct X.compare as [Hlt|Heq|Hgt]; simpl. + apply (In_inv_3 H); auto with ordered_type. + constructor 2; apply (In_inv_3 H); auto with ordered_type. + inversion_clear H; auto. Qed. Lemma add_Inf : forall (m:t elt)(x x':key)(e e':elt), Inf (x',e') m -> ltk (x',e') (x,e) -> Inf (x',e') (add x e m). Proof. induction m. - simpl; intuition. - intros. destruct a as (x'',e''). inversion_clear H. compute in H0,H1. simpl; case (X.compare x x''); intuition. Qed. #[local] Hint Resolve add_Inf : core. Lemma add_sorted : forall m (Hm:Sort m) x e, Sort (add x e m). Proof. induction m. - simpl; intuition. - intros. destruct a as (x',e'). simpl; case (X.compare x x'); intuition; inversion_clear Hm; auto. constructor; auto. apply Inf_eq with (x',e'); auto. Qed. (** * [remove] *) Fixpoint remove (k : key) (s : t elt) {struct s} : t elt := match s with | nil => nil | (k',x) :: l => match X.compare k k' with | LT _ => s | EQ _ => l | GT _ => (k',x) :: remove k l end end. Lemma remove_1 : forall m (Hm:Sort m) x y, X.eq x y -> ~ In y (remove x m). Proof. intros m Hm x y He [e H]; revert e H. induction Hm as [|[a m] l Hm IHHm Hr]; simpl in *; intros e H. - now inversion H. - destruct X.compare as [Hlt|Heq|Hgt]. + apply InA_cons in H; destruct H; [compute in H; destruct H; order|]. apply InA_eqke_eqk in H; apply (Sort_Inf_In Hm Hr) in H. compute in H; order. + apply InA_eqke_eqk in H; apply (Sort_Inf_In Hm Hr) in H. compute in H; order. + apply InA_cons in H; destruct H; [compute in H; destruct H; order|]. apply (IHHm e), H. Qed. Lemma remove_2 : forall m (Hm:Sort m) x y e, ~ X.eq x y -> MapsTo y e m -> MapsTo y e (remove x m). Proof. intros m Hm x y e He H. induction Hm as [|[a m] l Hm IHHm Hr]; simpl in *. - now inversion H. - destruct X.compare as [Hlt|Heq|Hgt]. + assumption. + apply InA_cons in H; destruct H; [compute in H; destruct H; order|]. apply H. + apply InA_cons in H; destruct H. * apply InA_cons_hd; assumption. * apply InA_cons_tl, IHHm, H. Qed. Lemma remove_3 : forall m (Hm:Sort m) x y e, MapsTo y e (remove x m) -> MapsTo y e m. Proof. intros m Hm x y e H. induction Hm as [|[a m] l Hm IHHm Hr]; simpl in *. - now inversion H. - destruct X.compare as [Hlt|Heq|Hgt]. + assumption. + apply InA_cons_tl, H. + apply InA_cons in H; destruct H. * apply InA_cons_hd; assumption. * apply InA_cons_tl, IHHm, H. Qed. Lemma remove_Inf : forall (m:t elt)(Hm : Sort m)(x x':key)(e':elt), Inf (x',e') m -> Inf (x',e') (remove x m). Proof. induction m. - simpl; intuition. - intros. destruct a as (x'',e''). inversion_clear H. compute in H0. simpl; case (X.compare x x''); intuition. inversion_clear Hm. apply Inf_lt with (x'',e''); auto. Qed. #[local] Hint Resolve remove_Inf : core. Lemma remove_sorted : forall m (Hm:Sort m) x, Sort (remove x m). Proof. induction m. - simpl; intuition. - intros. destruct a as (x',e'). simpl; case (X.compare x x'); intuition; inversion_clear Hm; auto. Qed. (** * [elements] *) Definition elements (m: t elt) := m. Lemma elements_1 : forall m x e, MapsTo x e m -> InA eqke (x,e) (elements m). Proof. auto. Qed. Lemma elements_2 : forall m x e, InA eqke (x,e) (elements m) -> MapsTo x e m. Proof. auto. Qed. Lemma elements_3 : forall m (Hm:Sort m), sort ltk (elements m). Proof. auto. Qed. Lemma elements_3w : forall m (Hm:Sort m), NoDupA eqk (elements m). Proof. intros. apply Sort_NoDupA. apply elements_3; auto. Qed. (** * [fold] *) Fixpoint fold (A:Type)(f:key->elt->A->A)(m:t elt) (acc:A) {struct m} : A := match m with | nil => acc | (k,e)::m' => fold f m' (f k e acc) end. Lemma fold_1 : forall m (A:Type)(i:A)(f:key->elt->A->A), fold f m i = fold_left (fun a p => f (fst p) (snd p) a) (elements m) i. Proof. induction m as [|[k e] m]; simpl; auto. Qed. (** * [equal] *) Fixpoint equal (cmp:elt->elt->bool)(m m' : t elt) {struct m} : bool := match m, m' with | nil, nil => true | (x,e)::l, (x',e')::l' => match X.compare x x' with | EQ _ => cmp e e' && equal cmp l l' | _ => false end | _, _ => false end. Definition Equivb cmp m m' := (forall k, In k m <-> In k m') /\ (forall k e e', MapsTo k e m -> MapsTo k e' m' -> cmp e e' = true). Lemma equal_1 : forall m (Hm:Sort m) m' (Hm': Sort m') cmp, Equivb cmp m m' -> equal cmp m m' = true. Proof. intros m Hm m' Hm' cmp; revert m' Hm'. induction Hm as [|[a e] m Hm IHHm Hr]; simpl in *; intros [|[a' e'] m'] Hm' H. + reflexivity. + destruct H as [H _]; specialize (H a') as [_ H]. destruct H; [exists e'; constructor; reflexivity|inversion H]. + destruct H as [H _]; specialize (H a) as [H _]. destruct H; [exists e; constructor; reflexivity|inversion H]. + apply Sorted_inv in Hm'; destruct Hm' as [Hm' Hr']. destruct (X.compare a a') as [Hlt|Heq|Hgt]; [exfalso| |exfalso]. - destruct H as [H _]; specialize (H a) as [H _]. destruct H as [e'' H]; [eexists; constructor; reflexivity|]. apply InA_cons in H; destruct H as [H|H]. * apply (gt_not_eq Hlt); symmetry; apply H. * apply InA_eqke_eqk, (Sort_Inf_In Hm' Hr') in H. compute in H; order. - apply andb_true_iff; split. * destruct H as [_ H]; apply H with a. { apply InA_cons_hd; reflexivity. } { apply InA_cons_hd; auto with ordered_type. } * apply IHHm; [assumption|]; split. { intros k; destruct H as [H _]; specialize (H k). split; intros [e'' Hk]. + destruct H as [H _]; destruct H as [e''' H]. - exists e''; apply InA_cons_tl; apply Hk. - apply InA_cons in H; destruct H as [[H _]|H]. * assert (Hs := Sort_Inf_In Hm Hr (InA_eqke_eqk Hk)). elim (gt_not_eq Hs); simpl; etransitivity; [eassumption|symmetry; assumption]. * exists e'''; assumption. + destruct H as [_ H]; destruct H as [e''' H]. - exists e''; apply InA_cons_tl; apply Hk. - apply InA_cons in H; destruct H as [[H _]|H]. * assert (Hs := Sort_Inf_In Hm' Hr' (InA_eqke_eqk Hk)). elim (gt_not_eq Hs); simpl; etransitivity; eassumption. * exists e'''; assumption. } { intros; destruct H as [_ H]; apply H with k; apply InA_cons_tl; assumption. } - destruct H as [H _]; specialize (H a') as [_ H]. destruct H as [e'' H]; [eexists; constructor; reflexivity|]. apply InA_cons in H; destruct H as [H|H]. * apply (gt_not_eq Hgt); symmetry; apply H. * apply InA_eqke_eqk, (Sort_Inf_In Hm Hr) in H. compute in H; order. Qed. Lemma equal_2 : forall m (Hm:Sort m) m' (Hm:Sort m') cmp, equal cmp m m' = true -> Equivb cmp m m'. Proof with auto with ordered_type. intros m Hm m' Hm' cmp; revert m' Hm'. induction Hm as [|[a e] m Hm IHHm Hr]; simpl in *; intros [|[a' e'] m'] Hm' H; try congruence. + split; [tauto|inversion 1]. + destruct X.compare as [?|Heq|?]; try congruence. apply Sorted_inv in Hm'; destruct Hm' as [Hm' Hr']. apply andb_true_iff in H; destruct H as [Hc He]; split. - intros k; split; intros [v Hk]; apply InA_cons in Hk; destruct Hk as [Hk|Hk]. * exists e'; apply InA_cons_hd; split; [|reflexivity]. transitivity a; [apply Hk|apply Heq]. * assert (Hi : In k m'). { apply (IHHm m' Hm' He); exists v; apply Hk. } destruct Hi as [w Hw]; exists w; apply InA_cons_tl, Hw. * exists e; apply InA_cons_hd; split; [|reflexivity]. transitivity a'; [apply Hk|symmetry; apply Heq]. * assert (Hi : In k m). { apply (IHHm m' Hm' He); exists v; apply Hk. } destruct Hi as [w Hw]; exists w; apply InA_cons_tl, Hw. - intros k e1 e2 He1 He2. apply InA_cons in He1, He2. destruct He1 as [He1|He1]; destruct He2 as [He2|He2]. * replace e1 with e by (symmetry; apply He1). replace e2 with e' by (symmetry; apply He2). apply Hc. * assert (Hi : In k m). { apply (IHHm m' Hm' He); exists e2; apply He2. } destruct Hi as [w Hw]. apply InA_eqke_eqk, (Sort_Inf_In Hm Hr) in Hw. destruct He1 as [He1 _]. elim (eq_not_gt He1); apply Hw. * assert (Hi : In k m'). { apply (IHHm m' Hm' He); exists e1; apply He1. } destruct Hi as [w Hw]. apply InA_eqke_eqk, (Sort_Inf_In Hm' Hr') in Hw. destruct He2 as [He2 _]. elim (eq_not_gt He2); apply Hw. * destruct (IHHm m' Hm' He) as [_ IH]. apply (IH k e1 e2 He1 He2). Qed. (** This lemma isn't part of the spec of [Equivb], but is used in [FMapAVL] *) Lemma equal_cons : forall cmp l1 l2 x y, Sort (x::l1) -> Sort (y::l2) -> eqk x y -> cmp (snd x) (snd y) = true -> (Equivb cmp l1 l2 <-> Equivb cmp (x :: l1) (y :: l2)). Proof. intros. inversion H; subst. inversion H0; subst. destruct x; destruct y; compute in H1, H2. split; intros. - apply equal_2; auto. simpl. elim_comp. rewrite H2; simpl. apply equal_1; auto. - apply equal_2; auto. generalize (equal_1 H H0 H3). simpl. elim_comp. rewrite H2; simpl; auto. Qed. Variable elt':Type. (** * [map] and [mapi] *) Fixpoint map (f:elt -> elt') (m:t elt) : t elt' := match m with | nil => nil | (k,e)::m' => (k,f e) :: map f m' end. Fixpoint mapi (f: key -> elt -> elt') (m:t elt) : t elt' := match m with | nil => nil | (k,e)::m' => (k,f k e) :: mapi f m' end. End Elt. Section Elt2. (* A new section is necessary for previous definitions to work with different [elt], especially [MapsTo]... *) Variable elt elt' : Type. (** Specification of [map] *) Lemma map_1 : forall (m:t elt)(x:key)(e:elt)(f:elt->elt'), MapsTo x e m -> MapsTo x (f e) (map f m). Proof. intros m x e f. induction m. - inversion 1. - destruct a as (x',e'). simpl. inversion_clear 1. + constructor 1. unfold eqke in *; simpl in *; intuition congruence. + unfold MapsTo in *; auto. Qed. Lemma map_2 : forall (m:t elt)(x:key)(f:elt->elt'), In x (map f m) -> In x m. Proof. intros m x f. induction m; simpl. - intros (e,abs). inversion abs. - destruct a as (x',e). intros hyp. inversion hyp. clear hyp. inversion H; subst; rename x0 into e'. + exists e; constructor. unfold eqke in *; simpl in *; intuition. + destruct IHm as (e'',hyp). * exists e'; auto. * exists e''. constructor 2; auto. Qed. Lemma map_lelistA : forall (m: t elt)(x:key)(e:elt)(e':elt')(f:elt->elt'), lelistA (@ltk elt) (x,e) m -> lelistA (@ltk elt') (x,e') (map f m). Proof. induction m; simpl; auto. intros. destruct a as (x0,e0). inversion_clear H; auto. Qed. #[local] Hint Resolve map_lelistA : core. Lemma map_sorted : forall (m: t elt)(Hm : sort (@ltk elt) m)(f:elt -> elt'), sort (@ltk elt') (map f m). Proof. induction m; simpl; auto. intros. destruct a as (x',e'). inversion_clear Hm. constructor; auto. exact (map_lelistA _ _ H0). Qed. (** Specification of [mapi] *) Lemma mapi_1 : forall (m:t elt)(x:key)(e:elt)(f:key->elt->elt'), MapsTo x e m -> exists y, X.eq y x /\ MapsTo x (f y e) (mapi f m). Proof. intros m x e f. induction m. - inversion 1. - destruct a as (x',e'). simpl. inversion_clear 1. + exists x'. destruct H0; simpl in *. split. * auto with ordered_type. * constructor 1. unfold eqke in *; simpl in *; intuition congruence. + destruct IHm as (y, hyp); auto. exists y; intuition auto with ordered_type. Qed. Lemma mapi_2 : forall (m:t elt)(x:key)(f:key->elt->elt'), In x (mapi f m) -> In x m. Proof. intros m x f. induction m; simpl. - intros (e,abs). inversion abs. - destruct a as (x',e). intros hyp. inversion hyp. clear hyp. inversion H; subst; rename x0 into e'. + exists e; constructor. unfold eqke in *; simpl in *; intuition. + destruct IHm as (e'',hyp). * exists e'; auto. * exists e''. constructor 2; auto. Qed. Lemma mapi_lelistA : forall (m: t elt)(x:key)(e:elt)(f:key->elt->elt'), lelistA (@ltk elt) (x,e) m -> lelistA (@ltk elt') (x,f x e) (mapi f m). Proof. induction m; simpl; auto. intros. destruct a as (x',e'). inversion_clear H; auto. Qed. #[local] Hint Resolve mapi_lelistA : core. Lemma mapi_sorted : forall m (Hm : sort (@ltk elt) m)(f: key ->elt -> elt'), sort (@ltk elt') (mapi f m). Proof. induction m; simpl; auto. intros. destruct a as (x',e'). inversion_clear Hm; auto. Qed. End Elt2. Section Elt3. (** * [map2] *) Variable elt elt' elt'' : Type. Variable f : option elt -> option elt' -> option elt''. Definition option_cons (A:Type)(k:key)(o:option A)(l:list (key*A)) := match o with | Some e => (k,e)::l | None => l end. Fixpoint map2_l (m : t elt) : t elt'' := match m with | nil => nil | (k,e)::l => option_cons k (f (Some e) None) (map2_l l) end. Fixpoint map2_r (m' : t elt') : t elt'' := match m' with | nil => nil | (k,e')::l' => option_cons k (f None (Some e')) (map2_r l') end. Fixpoint map2 (m : t elt) : t elt' -> t elt'' := match m with | nil => map2_r | (k,e) :: l => fix map2_aux (m' : t elt') : t elt'' := match m' with | nil => map2_l m | (k',e') :: l' => match X.compare k k' with | LT _ => option_cons k (f (Some e) None) (map2 l m') | EQ _ => option_cons k (f (Some e) (Some e')) (map2 l l') | GT _ => option_cons k' (f None (Some e')) (map2_aux l') end end end. Notation oee' := (option elt * option elt')%type. Fixpoint combine (m : t elt) : t elt' -> t oee' := match m with | nil => map (fun e' => (None,Some e')) | (k,e) :: l => fix combine_aux (m':t elt') : list (key * oee') := match m' with | nil => map (fun e => (Some e,None)) m | (k',e') :: l' => match X.compare k k' with | LT _ => (k,(Some e, None))::combine l m' | EQ _ => (k,(Some e, Some e'))::combine l l' | GT _ => (k',(None,Some e'))::combine_aux l' end end end. Definition fold_right_pair (A B C:Type)(f: A->B->C->C)(l:list (A*B))(i:C) := List.fold_right (fun p => f (fst p) (snd p)) i l. Definition map2_alt m m' := let m0 : t oee' := combine m m' in let m1 : t (option elt'') := map (fun p => f (fst p) (snd p)) m0 in fold_right_pair (option_cons (A:=elt'')) m1 nil. Lemma map2_alt_equiv : forall m m', map2_alt m m' = map2 m m'. Proof. unfold map2_alt. induction m. - simpl; auto; intros. (* map2_r *) induction m'; try destruct a; simpl; auto. rewrite IHm'; auto. (* fin map2_r *) - induction m'; destruct a. + simpl; f_equal. (* map2_l *) clear IHm. induction m; try destruct a; simpl; auto. rewrite IHm; auto. (* fin map2_l *) + destruct a0. simpl. destruct (X.compare t0 t1); simpl; f_equal. * apply IHm. * apply IHm. * apply IHm'. Qed. Lemma combine_lelistA : forall m m' (x:key)(e:elt)(e':elt')(e'':oee'), lelistA (@ltk elt) (x,e) m -> lelistA (@ltk elt') (x,e') m' -> lelistA (@ltk oee') (x,e'') (combine m m'). Proof. induction m. - intros. simpl. exact (map_lelistA _ _ H0). - induction m'. + intros. destruct a. replace (combine ((t0, e0) :: m) nil) with (map (fun e => (Some e,None (A:=elt'))) ((t0,e0)::m)); auto. exact (map_lelistA _ _ H). + intros. simpl. destruct a as (k,e0); destruct a0 as (k',e0'). destruct (X.compare k k'). * inversion_clear H; auto. * inversion_clear H; auto. * inversion_clear H0; auto. Qed. #[local] Hint Resolve combine_lelistA : core. Lemma combine_sorted : forall m (Hm : sort (@ltk elt) m) m' (Hm' : sort (@ltk elt') m'), sort (@ltk oee') (combine m m'). Proof. induction m. - intros; clear Hm. simpl. apply map_sorted; auto. - induction m'. + intros; clear Hm'. destruct a. replace (combine ((t0, e) :: m) nil) with (map (fun e => (Some e,None (A:=elt'))) ((t0,e)::m)); auto. apply map_sorted; auto. + intros. simpl. destruct a as (k,e); destruct a0 as (k',e'). destruct (X.compare k k') as [Hlt|Heq|Hlt]. * inversion_clear Hm. constructor; auto. assert (lelistA (ltk (elt:=elt')) (k, e') ((k',e')::m')) by auto. exact (combine_lelistA _ H0 H1). * inversion_clear Hm; inversion_clear Hm'. constructor; auto. assert (lelistA (ltk (elt:=elt')) (k, e') m') by (apply Inf_eq with (k',e'); auto). exact (combine_lelistA _ H0 H3). * inversion_clear Hm; inversion_clear Hm'. constructor; auto. change (lelistA (ltk (elt:=oee')) (k', (None, Some e')) (combine ((k,e)::m) m')). assert (lelistA (ltk (elt:=elt)) (k', e) ((k,e)::m)) by auto. exact (combine_lelistA _ H3 H2). Qed. Lemma map2_sorted : forall m (Hm : sort (@ltk elt) m) m' (Hm' : sort (@ltk elt') m'), sort (@ltk elt'') (map2 m m'). Proof. intros. rewrite <- map2_alt_equiv. unfold map2_alt. assert (H0:=combine_sorted Hm Hm'). set (l0:=combine m m') in *; clearbody l0. set (f':= fun p : oee' => f (fst p) (snd p)). assert (H1:=map_sorted (elt' := option elt'') H0 f'). set (l1:=map f' l0) in *; clearbody l1. clear f' f H0 l0 Hm Hm' m m'. induction l1. - simpl; auto. - inversion_clear H1. destruct a; destruct o; auto. simpl. constructor; auto. clear IHl1. induction l1. + simpl; auto. + destruct a; destruct o; simpl; auto. * inversion_clear H0; auto. * inversion_clear H0. red in H1; simpl in H1. inversion_clear H. apply IHl1; auto. apply Inf_lt with (t1, None (A:=elt'')); auto. Qed. Definition at_least_one (o:option elt)(o':option elt') := match o, o' with | None, None => None | _, _ => Some (o,o') end. Lemma combine_1 : forall m (Hm : sort (@ltk elt) m) m' (Hm' : sort (@ltk elt') m') (x:key), find x (combine m m') = at_least_one (find x m) (find x m'). Proof. induction m. - intros. simpl. induction m'. + intros; simpl; auto. + simpl; destruct a. simpl; destruct (X.compare x t0); simpl; auto. inversion_clear Hm'; auto. - induction m'. + (* m' = nil *) intros; destruct a; simpl. destruct (X.compare x t0) as [Hlt| |Hlt]; simpl; auto. inversion_clear Hm; clear H0 Hlt Hm' IHm t0. induction m; simpl; auto. inversion_clear H. destruct a. simpl; destruct (X.compare x t0); simpl; auto. + (* m' <> nil *) intros. destruct a as (k,e); destruct a0 as (k',e'); simpl. inversion Hm; inversion Hm'; subst. destruct (X.compare k k'); simpl; destruct (X.compare x k); elim_comp || destruct (X.compare x k'); simpl; auto. * rewrite IHm; auto; simpl; elim_comp; auto. * rewrite IHm; auto; simpl; elim_comp; auto. * rewrite IHm; auto; simpl; elim_comp; auto. * change (find x (combine ((k, e) :: m) m') = at_least_one None (find x m')). rewrite IHm'; auto. simpl find; elim_comp; auto. * change (find x (combine ((k, e) :: m) m') = Some (Some e, find x m')). rewrite IHm'; auto. simpl find; elim_comp; auto. * change (find x (combine ((k, e) :: m) m') = at_least_one (find x m) (find x m')). rewrite IHm'; auto. simpl find; elim_comp; auto. Qed. Definition at_least_one_then_f (o:option elt)(o':option elt') := match o, o' with | None, None => None | _, _ => f o o' end. Lemma map2_0 : forall m (Hm : sort (@ltk elt) m) m' (Hm' : sort (@ltk elt') m') (x:key), find x (map2 m m') = at_least_one_then_f (find x m) (find x m'). Proof. intros. rewrite <- map2_alt_equiv. unfold map2_alt. assert (H:=combine_1 Hm Hm' x). assert (H2:=combine_sorted Hm Hm'). set (f':= fun p : oee' => f (fst p) (snd p)). set (m0 := combine m m') in *; clearbody m0. set (o:=find x m) in *; clearbody o. set (o':=find x m') in *; clearbody o'. clear Hm Hm' m m'. generalize H; clear H. match goal with |- ?m=?n -> ?p=?q => assert ((m=n->p=q)/\(m=None -> p=None)); [|intuition] end. induction m0; simpl in *; intuition. - destruct o; destruct o'; simpl in *; try discriminate; auto. - destruct a as (k,(oo,oo')); simpl in *. inversion_clear H2. destruct (X.compare x k) as [Hlt|Heq|Hlt]; simpl in *. + (* x < k *) destruct (f' (oo,oo')); simpl. * elim_comp. destruct o; destruct o'; simpl in *; try discriminate; auto. * destruct (IHm0 H0) as (H2,_); apply H2; auto. rewrite <- H. case_eq (find x m0); intros; auto. assert (ltk (elt:=oee') (x,(oo,oo')) (k,(oo,oo'))). -- red; auto. -- destruct (Sort_Inf_NotIn H0 (Inf_lt H4 H1)). exists p; apply find_2; auto. + (* x = k *) assert (at_least_one_then_f o o' = f oo oo'). * destruct o; destruct o'; simpl in *; inversion_clear H; auto. * rewrite H2. unfold f'; simpl. destruct (f oo oo'); simpl. -- elim_comp; auto. -- destruct (IHm0 H0) as (_,H4); apply H4; auto. case_eq (find x m0); intros; auto. assert (eqk (elt:=oee') (k,(oo,oo')) (x,(oo,oo'))). ++ red; auto with ordered_type. ++ destruct (Sort_Inf_NotIn H0 (Inf_eq (eqk_sym H5) H1)). exists p; apply find_2; auto. + (* k < x *) unfold f'; simpl. destruct (f oo oo'); simpl. * elim_comp; auto. destruct (IHm0 H0) as (H3,_); apply H3; auto. * destruct (IHm0 H0) as (H3,_); apply H3; auto. - (* None -> None *) destruct a as (k,(oo,oo')). simpl. inversion_clear H2. destruct (X.compare x k) as [Hlt|Heq|Hlt]. + (* x < k *) unfold f'; simpl. destruct (f oo oo'); simpl. * elim_comp; auto. * destruct (IHm0 H0) as (_,H4); apply H4; auto. case_eq (find x m0); intros; auto. assert (ltk (elt:=oee') (x,(oo,oo')) (k,(oo,oo'))). -- red; auto. -- destruct (Sort_Inf_NotIn H0 (Inf_lt H3 H1)). exists p; apply find_2; auto. + (* x = k *) discriminate. + (* k < x *) unfold f'; simpl. destruct (f oo oo'); simpl. * elim_comp; auto. destruct (IHm0 H0) as (_,H4); apply H4; auto. * destruct (IHm0 H0) as (_,H4); apply H4; auto. Qed. (** Specification of [map2] *) Lemma map2_1 : forall m (Hm : sort (@ltk elt) m) m' (Hm' : sort (@ltk elt') m')(x:key), In x m \/ In x m' -> find x (map2 m m') = f (find x m) (find x m'). Proof. intros. rewrite map2_0; auto. destruct H as [(e,H)|(e,H)]. - rewrite (find_1 Hm H). destruct (find x m'); simpl; auto. - rewrite (find_1 Hm' H). destruct (find x m); simpl; auto. Qed. Lemma map2_2 : forall m (Hm : sort (@ltk elt) m) m' (Hm' : sort (@ltk elt') m')(x:key), In x (map2 m m') -> In x m \/ In x m'. Proof. intros. destruct H as (e,H). generalize (map2_0 Hm Hm' x). rewrite (find_1 (map2_sorted Hm Hm') H). generalize (@find_2 _ m x). generalize (@find_2 _ m' x). destruct (find x m); destruct (find x m'); simpl; intros. - left; exists e0; auto. - left; exists e0; auto. - right; exists e0; auto. - discriminate. Qed. End Elt3. End Raw. Module Make (X: OrderedType) <: S with Module E := X. Module Raw := Raw X. Module E := X. Definition key := E.t. Record slist (elt:Type) := {this :> Raw.t elt; sorted : sort (@Raw.PX.ltk elt) this}. Definition t (elt:Type) : Type := slist elt. Section Elt. Variable elt elt' elt'':Type. Implicit Types m : t elt. Implicit Types x y : key. Implicit Types e : elt. Definition empty : t elt := Build_slist (Raw.empty_sorted elt). Definition is_empty m : bool := Raw.is_empty (this m). Definition add x e m : t elt := Build_slist (Raw.add_sorted (sorted m) x e). Definition find x m : option elt := Raw.find x (this m). Definition remove x m : t elt := Build_slist (Raw.remove_sorted (sorted m) x). Definition mem x m : bool := Raw.mem x (this m). Definition map f m : t elt' := Build_slist (Raw.map_sorted (sorted m) f). Definition mapi (f:key->elt->elt') m : t elt' := Build_slist (Raw.mapi_sorted (sorted m) f). Definition map2 f m (m':t elt') : t elt'' := Build_slist (Raw.map2_sorted f (sorted m) (sorted m')). Definition elements m : list (key*elt) := @Raw.elements elt (this m). Definition cardinal m := length (this m). Definition fold (A:Type)(f:key->elt->A->A) m (i:A) : A := @Raw.fold elt A f (this m) i. Definition equal cmp m m' : bool := @Raw.equal elt cmp (this m) (this m'). Definition MapsTo x e m : Prop := Raw.PX.MapsTo x e (this m). Definition In x m : Prop := Raw.PX.In x (this m). Definition Empty m : Prop := Raw.Empty (this m). Definition Equal m m' := forall y, find y m = find y m'. Definition Equiv (eq_elt:elt->elt->Prop) m m' := (forall k, In k m <-> In k m') /\ (forall k e e', MapsTo k e m -> MapsTo k e' m' -> eq_elt e e'). Definition Equivb cmp m m' : Prop := @Raw.Equivb elt cmp (this m) (this m'). Definition eq_key : (key*elt) -> (key*elt) -> Prop := @Raw.PX.eqk elt. Definition eq_key_elt : (key*elt) -> (key*elt) -> Prop:= @Raw.PX.eqke elt. Definition lt_key : (key*elt) -> (key*elt) -> Prop := @Raw.PX.ltk elt. Lemma MapsTo_1 : forall m x y e, E.eq x y -> MapsTo x e m -> MapsTo y e m. Proof. intros m; exact (@Raw.PX.MapsTo_eq elt (this m)). Qed. Lemma mem_1 : forall m x, In x m -> mem x m = true. Proof. intros m; exact (@Raw.mem_1 elt (this m) (sorted m)). Qed. Lemma mem_2 : forall m x, mem x m = true -> In x m. Proof. intros m; exact (@Raw.mem_2 elt (this m) (sorted m)). Qed. Lemma empty_1 : Empty empty. Proof. exact (@Raw.empty_1 elt). Qed. Lemma is_empty_1 : forall m, Empty m -> is_empty m = true. Proof. intros m; exact (@Raw.is_empty_1 elt (this m)). Qed. Lemma is_empty_2 : forall m, is_empty m = true -> Empty m. Proof. intros m; exact (@Raw.is_empty_2 elt (this m)). Qed. Lemma add_1 : forall m x y e, E.eq x y -> MapsTo y e (add x e m). Proof. intros m; exact (@Raw.add_1 elt (this m)). Qed. Lemma add_2 : forall m x y e e', ~ E.eq x y -> MapsTo y e m -> MapsTo y e (add x e' m). Proof. intros m; exact (@Raw.add_2 elt (this m)). Qed. Lemma add_3 : forall m x y e e', ~ E.eq x y -> MapsTo y e (add x e' m) -> MapsTo y e m. Proof. intros m; exact (@Raw.add_3 elt (this m)). Qed. Lemma remove_1 : forall m x y, E.eq x y -> ~ In y (remove x m). Proof. intros m; exact (@Raw.remove_1 elt (this m) (sorted m)). Qed. Lemma remove_2 : forall m x y e, ~ E.eq x y -> MapsTo y e m -> MapsTo y e (remove x m). Proof. intros m; exact (@Raw.remove_2 elt (this m) (sorted m)). Qed. Lemma remove_3 : forall m x y e, MapsTo y e (remove x m) -> MapsTo y e m. Proof. intros m; exact (@Raw.remove_3 elt (this m) (sorted m)). Qed. Lemma find_1 : forall m x e, MapsTo x e m -> find x m = Some e. Proof. intros m; exact (@Raw.find_1 elt (this m) (sorted m)). Qed. Lemma find_2 : forall m x e, find x m = Some e -> MapsTo x e m. Proof. intros m; exact (@Raw.find_2 elt (this m)). Qed. Lemma elements_1 : forall m x e, MapsTo x e m -> InA eq_key_elt (x,e) (elements m). Proof. intros m; exact (@Raw.elements_1 elt (this m)). Qed. Lemma elements_2 : forall m x e, InA eq_key_elt (x,e) (elements m) -> MapsTo x e m. Proof. intros m; exact (@Raw.elements_2 elt (this m)). Qed. Lemma elements_3 : forall m, sort lt_key (elements m). Proof. intros m; exact (@Raw.elements_3 elt (this m) (sorted m)). Qed. Lemma elements_3w : forall m, NoDupA eq_key (elements m). Proof. intros m; exact (@Raw.elements_3w elt (this m) (sorted m)). Qed. Lemma cardinal_1 : forall m, cardinal m = length (elements m). Proof. intros; reflexivity. Qed. Lemma fold_1 : forall m (A : Type) (i : A) (f : key -> elt -> A -> A), fold f m i = fold_left (fun a p => f (fst p) (snd p) a) (elements m) i. Proof. intros m; exact (@Raw.fold_1 elt (this m)). Qed. Lemma equal_1 : forall m m' cmp, Equivb cmp m m' -> equal cmp m m' = true. Proof. intros m m'; exact (@Raw.equal_1 elt (this m) (sorted m) (this m') (sorted m')). Qed. Lemma equal_2 : forall m m' cmp, equal cmp m m' = true -> Equivb cmp m m'. Proof. intros m m'; exact (@Raw.equal_2 elt (this m) (sorted m) (this m') (sorted m')). Qed. End Elt. Lemma map_1 : forall (elt elt':Type)(m: t elt)(x:key)(e:elt)(f:elt->elt'), MapsTo x e m -> MapsTo x (f e) (map f m). Proof. intros elt elt' m; exact (@Raw.map_1 elt elt' (this m)). Qed. Lemma map_2 : forall (elt elt':Type)(m: t elt)(x:key)(f:elt->elt'), In x (map f m) -> In x m. Proof. intros elt elt' m; exact (@Raw.map_2 elt elt' (this m)). Qed. Lemma mapi_1 : forall (elt elt':Type)(m: t elt)(x:key)(e:elt) (f:key->elt->elt'), MapsTo x e m -> exists y, E.eq y x /\ MapsTo x (f y e) (mapi f m). Proof. intros elt elt' m; exact (@Raw.mapi_1 elt elt' (this m)). Qed. Lemma mapi_2 : forall (elt elt':Type)(m: t elt)(x:key) (f:key->elt->elt'), In x (mapi f m) -> In x m. Proof. intros elt elt' m; exact (@Raw.mapi_2 elt elt' (this m)). Qed. Lemma map2_1 : forall (elt elt' elt'':Type)(m: t elt)(m': t elt') (x:key)(f:option elt->option elt'->option elt''), In x m \/ In x m' -> find x (map2 f m m') = f (find x m) (find x m'). Proof. intros elt elt' elt'' m m' x f; exact (@Raw.map2_1 elt elt' elt'' f (this m) (sorted m) (this m') (sorted m') x). Qed. Lemma map2_2 : forall (elt elt' elt'':Type)(m: t elt)(m': t elt') (x:key)(f:option elt->option elt'->option elt''), In x (map2 f m m') -> In x m \/ In x m'. Proof. intros elt elt' elt'' m m' x f; exact (@Raw.map2_2 elt elt' elt'' f (this m) (sorted m) (this m') (sorted m') x). Qed. End Make. Module Make_ord (X: OrderedType)(D : OrderedType) <: Sord with Module Data := D with Module MapS.E := X. Module Data := D. Module MapS := Make(X). Import MapS. Module MD := OrderedTypeFacts(D). Import MD. Definition t := MapS.t D.t. Definition cmp e e' := match D.compare e e' with EQ _ => true | _ => false end. Fixpoint eq_list (m m' : list (X.t * D.t)) : Prop := match m, m' with | nil, nil => True | (x,e)::l, (x',e')::l' => match X.compare x x' with | EQ _ => D.eq e e' /\ eq_list l l' | _ => False end | _, _ => False end. Definition eq m m' := eq_list (this m) (this m'). Fixpoint lt_list (m m' : list (X.t * D.t)) : Prop := match m, m' with | nil, nil => False | nil, _ => True | _, nil => False | (x,e)::l, (x',e')::l' => match X.compare x x' with | LT _ => True | GT _ => False | EQ _ => D.lt e e' \/ (D.eq e e' /\ lt_list l l') end end. Definition lt m m' := lt_list (this m) (this m'). Lemma eq_equal : forall m m', eq m m' <-> equal cmp m m' = true. Proof. intros (l,Hl); induction l. - intros (l',Hl'); unfold eq; simpl. destruct l'; unfold equal; simpl; intuition auto with bool. - intros (l',Hl'); unfold eq. destruct l'. + destruct a; unfold equal; simpl; intuition auto with bool. + destruct a as (x,e). destruct p as (x',e'). unfold equal; simpl. destruct (X.compare x x') as [Hlt|Heq|Hlt]; simpl; intuition auto with bool. * unfold cmp at 1. MD.elim_comp; clear H; simpl. inversion_clear Hl. inversion_clear Hl'. destruct (IHl H (Build_slist H3)). unfold equal, eq in H5; simpl in H5; auto. * destruct (andb_prop _ _ H); clear H. generalize H0; unfold cmp. MD.elim_comp; auto; intro; discriminate. * destruct (andb_prop _ _ H); clear H. inversion_clear Hl. inversion_clear Hl'. destruct (IHl H (Build_slist H3)). unfold equal, eq in H6; simpl in H6; auto. Qed. Lemma eq_1 : forall m m', Equivb cmp m m' -> eq m m'. Proof. intros. generalize (@equal_1 D.t m m' cmp). generalize (@eq_equal m m'). intuition. Qed. Lemma eq_2 : forall m m', eq m m' -> Equivb cmp m m'. Proof. intros. generalize (@equal_2 D.t m m' cmp). generalize (@eq_equal m m'). intuition. Qed. Lemma eq_refl : forall m : t, eq m m. Proof. intros (m,Hm); induction m; unfold eq; simpl; auto. destruct a. destruct (X.compare t0 t0) as [Hlt|Heq|Hlt]; auto. - apply (MapS.Raw.MX.lt_antirefl Hlt); auto. - split. + apply D.eq_refl. + inversion_clear Hm. apply (IHm H). - apply (MapS.Raw.MX.lt_antirefl Hlt); auto. Qed. Lemma eq_sym : forall m1 m2 : t, eq m1 m2 -> eq m2 m1. Proof. intros (m,Hm); induction m; intros (m', Hm'); destruct m'; unfold eq; simpl; try destruct a as (x,e); try destruct p as (x',e'); auto. destruct (X.compare x x') as [Hlt|Heq|Hlt]; MapS.Raw.MX.elim_comp; intuition auto with ordered_type. inversion_clear Hm; inversion_clear Hm'. apply (IHm H0 (Build_slist H4)); auto. Qed. Lemma eq_trans : forall m1 m2 m3 : t, eq m1 m2 -> eq m2 m3 -> eq m1 m3. Proof. intros (m1,Hm1); induction m1; intros (m2, Hm2); destruct m2; intros (m3, Hm3); destruct m3; unfold eq; simpl; try destruct a as (x,e); try destruct p as (x',e'); try destruct p0 as (x'',e''); try contradiction; auto. destruct (X.compare x x') as [Hlt|Heq|Hlt]; destruct (X.compare x' x'') as [Hlt'|Heq'|Hlt']; MapS.Raw.MX.elim_comp; intuition. - apply D.eq_trans with e'; auto. - inversion_clear Hm1; inversion_clear Hm2; inversion_clear Hm3. apply (IHm1 H1 (Build_slist H6) (Build_slist H8)); intuition. Qed. Lemma lt_trans : forall m1 m2 m3 : t, lt m1 m2 -> lt m2 m3 -> lt m1 m3. Proof. intros (m1,Hm1); induction m1; intros (m2, Hm2); destruct m2; intros (m3, Hm3); destruct m3; unfold lt; simpl; try destruct a as (x,e); try destruct p as (x',e'); try destruct p0 as (x'',e''); try contradiction; auto. destruct (X.compare x x') as [Hlt|Heq|Hlt]; destruct (X.compare x' x'') as [Hlt'|Heq'|Hlt']; MapS.Raw.MX.elim_comp; intuition. - left; apply D.lt_trans with e'; auto. - left; apply lt_eq with e'; auto. - left; apply eq_lt with e'; auto. - right. split. + apply D.eq_trans with e'; auto. + inversion_clear Hm1; inversion_clear Hm2; inversion_clear Hm3. apply (IHm1 H2 (Build_slist H6) (Build_slist H8)); intuition. Qed. Lemma lt_not_eq : forall m1 m2 : t, lt m1 m2 -> ~ eq m1 m2. Proof. intros (m1,Hm1); induction m1; intros (m2, Hm2); destruct m2; unfold eq, lt; simpl; try destruct a as (x,e); try destruct p as (x',e'); try contradiction; auto. destruct (X.compare x x') as [Hlt|Heq|Hlt]; auto. intuition. - exact (D.lt_not_eq H0 H1). - inversion_clear Hm1; inversion_clear Hm2. apply (IHm1 H0 (Build_slist H5)); intuition. Qed. Ltac cmp_solve := unfold eq, lt; simpl; try Raw.MX.elim_comp; auto with ordered_type. Definition compare : forall m1 m2, Compare lt eq m1 m2. Proof. intros (m1,Hm1); induction m1; intros (m2, Hm2); destruct m2; [ apply EQ | apply LT | apply GT | ]; cmp_solve. destruct a as (x,e); destruct p as (x',e'). destruct (X.compare x x'); [ apply LT | | apply GT ]; cmp_solve. destruct (D.compare e e'); [ apply LT | | apply GT ]; cmp_solve. assert (Hm11 : sort (Raw.PX.ltk (elt:=D.t)) m1). - inversion_clear Hm1; auto. - assert (Hm22 : sort (Raw.PX.ltk (elt:=D.t)) m2). { inversion_clear Hm2; auto. } destruct (IHm1 Hm11 (Build_slist Hm22)); [ apply LT | apply EQ | apply GT ]; cmp_solve. Qed. End Make_ord. coq-8.20.0/theories/FSets/FMapPositive.v000066400000000000000000001017771466560755400200250ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* j | xI ii => xI (append ii j) | xO ii => xO (append ii j) end. Lemma append_assoc_0 : forall (i j : positive), append i (xO j) = append (append i (xO xH)) j. Proof. induction i; intros; destruct j; simpl; try rewrite (IHi (xI j)); try rewrite (IHi (xO j)); try rewrite <- (IHi xH); auto. Qed. Lemma append_assoc_1 : forall (i j : positive), append i (xI j) = append (append i (xI xH)) j. Proof. induction i; intros; destruct j; simpl; try rewrite (IHi (xI j)); try rewrite (IHi (xO j)); try rewrite <- (IHi xH); auto. Qed. Lemma append_neutral_r : forall (i : positive), append i xH = i. Proof. induction i; simpl; congruence. Qed. Lemma append_neutral_l : forall (i : positive), append xH i = i. Proof. simpl; auto. Qed. (** The module of maps over positive keys *) Module PositiveMap <: S with Module E:=PositiveOrderedTypeBits. Module E:=PositiveOrderedTypeBits. Module ME:=KeyOrderedType E. Definition key := positive : Type. #[universes(template)] Inductive tree (A : Type) := | Leaf : tree A | Node : tree A -> option A -> tree A -> tree A. Scheme tree_ind := Induction for tree Sort Prop. Definition t := tree. Section A. Variable A:Type. Arguments Leaf {A}. Definition empty : t A := Leaf. Fixpoint is_empty (m : t A) : bool := match m with | Leaf => true | Node l None r => (is_empty l) && (is_empty r) | _ => false end. Fixpoint find (i : key) (m : t A) : option A := match m with | Leaf => None | Node l o r => match i with | xH => o | xO ii => find ii l | xI ii => find ii r end end. Fixpoint mem (i : key) (m : t A) : bool := match m with | Leaf => false | Node l o r => match i with | xH => match o with None => false | _ => true end | xO ii => mem ii l | xI ii => mem ii r end end. Fixpoint add (i : key) (v : A) (m : t A) : t A := match m with | Leaf => match i with | xH => Node Leaf (Some v) Leaf | xO ii => Node (add ii v Leaf) None Leaf | xI ii => Node Leaf None (add ii v Leaf) end | Node l o r => match i with | xH => Node l (Some v) r | xO ii => Node (add ii v l) o r | xI ii => Node l o (add ii v r) end end. Fixpoint remove (i : key) (m : t A) : t A := match i with | xH => match m with | Leaf => Leaf | Node Leaf _ Leaf => Leaf | Node l _ r => Node l None r end | xO ii => match m with | Leaf => Leaf | Node l None Leaf => match remove ii l with | Leaf => Leaf | mm => Node mm None Leaf end | Node l o r => Node (remove ii l) o r end | xI ii => match m with | Leaf => Leaf | Node Leaf None r => match remove ii r with | Leaf => Leaf | mm => Node Leaf None mm end | Node l o r => Node l o (remove ii r) end end. (** [elements] *) Fixpoint xelements (m : t A) (i : key) : list (key * A) := match m with | Leaf => nil | Node l None r => (xelements l (append i (xO xH))) ++ (xelements r (append i (xI xH))) | Node l (Some x) r => (xelements l (append i (xO xH))) ++ ((i, x) :: xelements r (append i (xI xH))) end. (* Note: function [xelements] above is inefficient. We should apply deforestation to it, but that makes the proofs even harder. *) Definition elements (m : t A) := xelements m xH. (** [cardinal] *) Fixpoint cardinal (m : t A) : nat := match m with | Leaf => 0%nat | Node l None r => (cardinal l + cardinal r)%nat | Node l (Some _) r => S (cardinal l + cardinal r) end. Section CompcertSpec. Theorem gempty: forall (i: key), find i empty = None. Proof. destruct i; simpl; auto. Qed. Theorem gss: forall (i: key) (x: A) (m: t A), find i (add i x m) = Some x. Proof. induction i; destruct m; simpl; auto. Qed. Lemma gleaf : forall (i : key), find i (Leaf : t A) = None. Proof. exact gempty. Qed. Theorem gso: forall (i j: key) (x: A) (m: t A), i <> j -> find i (add j x m) = find i m. Proof. induction i; intros; destruct j; destruct m; simpl; try rewrite <- (gleaf i); auto; try apply IHi; congruence. Qed. Lemma rleaf : forall (i : key), remove i Leaf = Leaf. Proof. destruct i; simpl; auto. Qed. Theorem grs: forall (i: key) (m: t A), find i (remove i m) = None. Proof. induction i; destruct m. - simpl; auto. - destruct m1; destruct o; destruct m2 as [ | ll oo rr]; simpl; auto. + rewrite (rleaf i); auto. + cut (find i (remove i (Node ll oo rr)) = None). * destruct (remove i (Node ll oo rr)); auto; apply IHi. * apply IHi. - simpl; auto. - destruct m1 as [ | ll oo rr]; destruct o; destruct m2; simpl; auto. + rewrite (rleaf i); auto. + cut (find i (remove i (Node ll oo rr)) = None). * destruct (remove i (Node ll oo rr)); auto; apply IHi. * apply IHi. - simpl; auto. - destruct m1; destruct m2; simpl; auto. Qed. Theorem gro: forall (i j: key) (m: t A), i <> j -> find i (remove j m) = find i m. Proof. induction i; intros; destruct j; destruct m; try rewrite (rleaf (xI j)); try rewrite (rleaf (xO j)); try rewrite (rleaf 1); auto; destruct m1; destruct o; destruct m2; simpl; try apply IHi; try congruence; try rewrite (rleaf j); auto; try rewrite (gleaf i); auto. - cut (find i (remove j (Node m2_1 o m2_2)) = find i (Node m2_1 o m2_2)); [ destruct (remove j (Node m2_1 o m2_2)); try rewrite (gleaf i); auto | apply IHi; congruence ]. - destruct (remove j (Node m1_1 o0 m1_2)); simpl; try rewrite (gleaf i); auto. - destruct (remove j (Node m2_1 o m2_2)); simpl; try rewrite (gleaf i); auto. - cut (find i (remove j (Node m1_1 o0 m1_2)) = find i (Node m1_1 o0 m1_2)); [ destruct (remove j (Node m1_1 o0 m1_2)); try rewrite (gleaf i); auto | apply IHi; congruence ]. - destruct (remove j (Node m2_1 o m2_2)); simpl; try rewrite (gleaf i); auto. - destruct (remove j (Node m1_1 o0 m1_2)); simpl; try rewrite (gleaf i); auto. Qed. Lemma xelements_correct: forall (m: t A) (i j : key) (v: A), find i m = Some v -> List.In (append j i, v) (xelements m j). Proof. induction m; intros. - rewrite (gleaf i) in H; discriminate. - destruct o; destruct i; simpl; simpl in H. + rewrite append_assoc_1; apply in_or_app; right; apply in_cons; apply IHm2; auto. + rewrite append_assoc_0; apply in_or_app; left; apply IHm1; auto. + rewrite append_neutral_r; apply in_or_app; injection H as [= ->]; right; apply in_eq. + rewrite append_assoc_1; apply in_or_app; right; apply IHm2; auto. + rewrite append_assoc_0; apply in_or_app; left; apply IHm1; auto. + congruence. Qed. Theorem elements_correct: forall (m: t A) (i: key) (v: A), find i m = Some v -> List.In (i, v) (elements m). Proof. intros m i v H. exact (xelements_correct m i xH H). Qed. Fixpoint xfind (i j : key) (m : t A) : option A := match i, j with | _, xH => find i m | xO ii, xO jj => xfind ii jj m | xI ii, xI jj => xfind ii jj m | _, _ => None end. Lemma xfind_left : forall (j i : key) (m1 m2 : t A) (o : option A) (v : A), xfind i (append j (xO xH)) m1 = Some v -> xfind i j (Node m1 o m2) = Some v. Proof. induction j; intros; destruct i; simpl; simpl in H; auto; try congruence. destruct i; simpl in *; auto. Qed. Lemma xelements_ii : forall (m: t A) (i j : key) (v: A), List.In (xI i, v) (xelements m (xI j)) -> List.In (i, v) (xelements m j). Proof. induction m. - simpl; auto. - intros; destruct o; simpl; simpl in H; destruct (in_app_or _ _ _ H); apply in_or_app. + left; apply IHm1; auto. + right; destruct (in_inv H0). * injection H1 as [= -> ->]; apply in_eq. * apply in_cons; apply IHm2; auto. + left; apply IHm1; auto. + right; apply IHm2; auto. Qed. Lemma xelements_io : forall (m: t A) (i j : key) (v: A), ~List.In (xI i, v) (xelements m (xO j)). Proof. induction m. - simpl; auto. - intros; destruct o; simpl; intro H; destruct (in_app_or _ _ _ H). + apply (IHm1 _ _ _ H0). + destruct (in_inv H0). * congruence. * apply (IHm2 _ _ _ H1). + apply (IHm1 _ _ _ H0). + apply (IHm2 _ _ _ H0). Qed. Lemma xelements_oo : forall (m: t A) (i j : key) (v: A), List.In (xO i, v) (xelements m (xO j)) -> List.In (i, v) (xelements m j). Proof. induction m. - simpl; auto. - intros; destruct o; simpl; simpl in H; destruct (in_app_or _ _ _ H); apply in_or_app. + left; apply IHm1; auto. + right; destruct (in_inv H0). * injection H1 as [= -> ->]; apply in_eq. * apply in_cons; apply IHm2; auto. + left; apply IHm1; auto. + right; apply IHm2; auto. Qed. Lemma xelements_oi : forall (m: t A) (i j : key) (v: A), ~List.In (xO i, v) (xelements m (xI j)). Proof. induction m. - simpl; auto. - intros; destruct o; simpl; intro H; destruct (in_app_or _ _ _ H). + apply (IHm1 _ _ _ H0). + destruct (in_inv H0). * congruence. * apply (IHm2 _ _ _ H1). + apply (IHm1 _ _ _ H0). + apply (IHm2 _ _ _ H0). Qed. Lemma xelements_ih : forall (m1 m2: t A) (o: option A) (i : key) (v: A), List.In (xI i, v) (xelements (Node m1 o m2) xH) -> List.In (i, v) (xelements m2 xH). Proof. destruct o; simpl; intros; destruct (in_app_or _ _ _ H). - absurd (List.In (xI i, v) (xelements m1 2)); auto; apply xelements_io; auto. - destruct (in_inv H0). + congruence. + apply xelements_ii; auto. - absurd (List.In (xI i, v) (xelements m1 2)); auto; apply xelements_io; auto. - apply xelements_ii; auto. Qed. Lemma xelements_oh : forall (m1 m2: t A) (o: option A) (i : key) (v: A), List.In (xO i, v) (xelements (Node m1 o m2) xH) -> List.In (i, v) (xelements m1 xH). Proof. destruct o; simpl; intros; destruct (in_app_or _ _ _ H). - apply xelements_oo; auto. - destruct (in_inv H0). + congruence. + absurd (List.In (xO i, v) (xelements m2 3)); auto; apply xelements_oi; auto. - apply xelements_oo; auto. - absurd (List.In (xO i, v) (xelements m2 3)); auto; apply xelements_oi; auto. Qed. Lemma xelements_hi : forall (m: t A) (i : key) (v: A), ~List.In (xH, v) (xelements m (xI i)). Proof. induction m; intros. - simpl; auto. - destruct o; simpl; intro H; destruct (in_app_or _ _ _ H). + generalize H0; apply IHm1; auto. + destruct (in_inv H0). * congruence. * generalize H1; apply IHm2; auto. + generalize H0; apply IHm1; auto. + generalize H0; apply IHm2; auto. Qed. Lemma xelements_ho : forall (m: t A) (i : key) (v: A), ~List.In (xH, v) (xelements m (xO i)). Proof. induction m; intros. - simpl; auto. - destruct o; simpl; intro H; destruct (in_app_or _ _ _ H). + generalize H0; apply IHm1; auto. + destruct (in_inv H0). * congruence. * generalize H1; apply IHm2; auto. + generalize H0; apply IHm1; auto. + generalize H0; apply IHm2; auto. Qed. Lemma find_xfind_h : forall (m: t A) (i: key), find i m = xfind i xH m. Proof. destruct i; simpl; auto. Qed. Lemma xelements_complete: forall (i j : key) (m: t A) (v: A), List.In (i, v) (xelements m j) -> xfind i j m = Some v. Proof. induction i; simpl; intros; destruct j; simpl. - apply IHi; apply xelements_ii; auto. - absurd (List.In (xI i, v) (xelements m (xO j))); auto; apply xelements_io. - destruct m. + simpl in H; tauto. + rewrite find_xfind_h. apply IHi. apply (xelements_ih _ _ _ _ _ H). - absurd (List.In (xO i, v) (xelements m (xI j))); auto; apply xelements_oi. - apply IHi; apply xelements_oo; auto. - destruct m. + simpl in H; tauto. + rewrite find_xfind_h. apply IHi. apply (xelements_oh _ _ _ _ _ H). - absurd (List.In (xH, v) (xelements m (xI j))); auto; apply xelements_hi. - absurd (List.In (xH, v) (xelements m (xO j))); auto; apply xelements_ho. - destruct m. + simpl in H; tauto. + destruct o; simpl in H; destruct (in_app_or _ _ _ H). * absurd (List.In (xH, v) (xelements m1 (xO xH))); auto; apply xelements_ho. * destruct (in_inv H0). -- congruence. -- absurd (List.In (xH, v) (xelements m2 (xI xH))); auto; apply xelements_hi. * absurd (List.In (xH, v) (xelements m1 (xO xH))); auto; apply xelements_ho. * absurd (List.In (xH, v) (xelements m2 (xI xH))); auto; apply xelements_hi. Qed. Theorem elements_complete: forall (m: t A) (i: key) (v: A), List.In (i, v) (elements m) -> find i m = Some v. Proof. intros m i v H. unfold elements in H. rewrite find_xfind_h. exact (xelements_complete i xH m v H). Qed. Lemma cardinal_1 : forall (m: t A), cardinal m = length (elements m). Proof. unfold elements. intros m; set (p:=1); clearbody p; revert m p. induction m; simpl; auto; intros. rewrite (IHm1 (append p 2)), (IHm2 (append p 3)). destruct o; rewrite length_app; simpl; auto. Qed. End CompcertSpec. Definition MapsTo (i:key)(v:A)(m:t A) := find i m = Some v. Definition In (i:key)(m:t A) := exists e:A, MapsTo i e m. Definition Empty m := forall (a : key)(e:A) , ~ MapsTo a e m. Definition eq_key (p p':key*A) := E.eq (fst p) (fst p'). Definition eq_key_elt (p p':key*A) := E.eq (fst p) (fst p') /\ (snd p) = (snd p'). Definition lt_key (p p':key*A) := E.lt (fst p) (fst p'). Global Instance eqk_equiv : Equivalence eq_key := _. Global Instance eqke_equiv : Equivalence eq_key_elt := _. Global Instance ltk_strorder : StrictOrder lt_key := _. Lemma mem_find : forall m x, mem x m = match find x m with None => false | _ => true end. Proof. induction m; destruct x; simpl; auto. Qed. Lemma Empty_alt : forall m, Empty m <-> forall a, find a m = None. Proof. unfold Empty, MapsTo. intuition. - generalize (H a). destruct (find a m); intuition. elim (H0 a0); auto. - rewrite H in H0; discriminate. Qed. Lemma Empty_Node : forall l o r, Empty (Node l o r) <-> o=None /\ Empty l /\ Empty r. Proof. intros l o r. split. - rewrite Empty_alt. split. + destruct o; auto. generalize (H 1); simpl; auto. + split; rewrite Empty_alt; intros. * generalize (H (xO a)); auto. * generalize (H (xI a)); auto. - intros (H,(H0,H1)). subst. rewrite Empty_alt; intros. destruct a; auto. + simpl; generalize H1; rewrite Empty_alt; auto. + simpl; generalize H0; rewrite Empty_alt; auto. Qed. Section FMapSpec. Lemma mem_1 : forall m x, In x m -> mem x m = true. Proof. unfold In, MapsTo; intros m x; rewrite mem_find. destruct 1 as (e0,H0); rewrite H0; auto. Qed. Lemma mem_2 : forall m x, mem x m = true -> In x m. Proof. unfold In, MapsTo; intros m x; rewrite mem_find. destruct (find x m). - exists a; auto. - intros; discriminate. Qed. Variable m m' m'' : t A. Variable x y z : key. Variable e e' : A. Lemma MapsTo_1 : E.eq x y -> MapsTo x e m -> MapsTo y e m. Proof. intros; rewrite <- H; auto. Qed. Lemma find_1 : MapsTo x e m -> find x m = Some e. Proof. unfold MapsTo; auto. Qed. Lemma find_2 : find x m = Some e -> MapsTo x e m. Proof. red; auto. Qed. Lemma empty_1 : Empty empty. Proof. rewrite Empty_alt; apply gempty. Qed. Lemma is_empty_1 : Empty m -> is_empty m = true. Proof. induction m; simpl; auto. rewrite Empty_Node. intros (H,(H0,H1)). subst; simpl. rewrite IHt0_1; simpl; auto. Qed. Lemma is_empty_2 : is_empty m = true -> Empty m. Proof. induction m; simpl; auto. - rewrite Empty_alt. intros _; exact gempty. - rewrite Empty_Node. destruct o. + intros; discriminate. + intro H; destruct (andb_prop _ _ H); intuition. Qed. Lemma add_1 : E.eq x y -> MapsTo y e (add x e m). Proof. unfold MapsTo. intro H; rewrite H; clear H. apply gss. Qed. Lemma add_2 : ~ E.eq x y -> MapsTo y e m -> MapsTo y e (add x e' m). Proof. unfold MapsTo. intros; rewrite gso; auto. Qed. Lemma add_3 : ~ E.eq x y -> MapsTo y e (add x e' m) -> MapsTo y e m. Proof. unfold MapsTo. intro H; rewrite gso; auto. Qed. Lemma remove_1 : E.eq x y -> ~ In y (remove x m). Proof. intros; intro. generalize (mem_1 H0). rewrite mem_find. red in H. rewrite H. rewrite grs. intros; discriminate. Qed. Lemma remove_2 : ~ E.eq x y -> MapsTo y e m -> MapsTo y e (remove x m). Proof. unfold MapsTo. intro H; rewrite gro; auto. Qed. Lemma remove_3 : MapsTo y e (remove x m) -> MapsTo y e m. Proof. unfold MapsTo. destruct (E.eq_dec x y). - subst. rewrite grs; intros; discriminate. - rewrite gro; auto. Qed. Lemma elements_1 : MapsTo x e m -> InA eq_key_elt (x,e) (elements m). Proof. unfold MapsTo. rewrite InA_alt. intro H. exists (x,e). split. - red; simpl; unfold E.eq; auto. - apply elements_correct; auto. Qed. Lemma elements_2 : InA eq_key_elt (x,e) (elements m) -> MapsTo x e m. Proof. unfold MapsTo. rewrite InA_alt. intros ((e0,a),(H,H0)). red in H; simpl in H; unfold E.eq in H; destruct H; subst. apply elements_complete; auto. Qed. Lemma xelements_bits_lt_1 : forall p p0 q m v, List.In (p0,v) (xelements m (append p (xO q))) -> E.bits_lt p0 p. Proof using. intros. generalize (xelements_complete _ _ _ _ H); clear H; intros. revert p0 H. induction p; destruct p0; simpl; intros; eauto; try discriminate. Qed. Lemma xelements_bits_lt_2 : forall p p0 q m v, List.In (p0,v) (xelements m (append p (xI q))) -> E.bits_lt p p0. Proof using. intros. generalize (xelements_complete _ _ _ _ H); clear H; intros. revert p0 H. induction p; destruct p0; simpl; intros; eauto; try discriminate. Qed. Lemma xelements_sort : forall p, sort lt_key (xelements m p). Proof. induction m. - simpl; auto. - destruct o; simpl; intros. + (* Some *) apply (SortA_app (eqA:=eq_key_elt)). 1-2: auto with typeclass_instances. * constructor; auto. apply In_InfA; intros. destruct y0. red; red; simpl. eapply xelements_bits_lt_2; eauto. * intros x0 y0. do 2 rewrite InA_alt. intros (y1,(Hy1,H)) (y2,(Hy2,H0)). destruct y1; destruct x0; compute in Hy1; destruct Hy1; subst. destruct y2; destruct y0; compute in Hy2; destruct Hy2; subst. red; red; simpl. destruct H0. -- injection H0 as [= H0 _]; subst. eapply xelements_bits_lt_1; eauto. -- apply E.bits_lt_trans with p. ++ eapply xelements_bits_lt_1; eauto. ++ eapply xelements_bits_lt_2; eauto. + (* None *) apply (SortA_app (eqA:=eq_key_elt)). { auto with typeclass_instances. } 1-2: auto. intros x0 y0. do 2 rewrite InA_alt. intros (y1,(Hy1,H)) (y2,(Hy2,H0)). destruct y1; destruct x0; compute in Hy1; destruct Hy1; subst. destruct y2; destruct y0; compute in Hy2; destruct Hy2; subst. red; red; simpl. apply E.bits_lt_trans with p. * eapply xelements_bits_lt_1; eauto. * eapply xelements_bits_lt_2; eauto. Qed. Lemma elements_3 : sort lt_key (elements m). Proof. unfold elements. apply xelements_sort; auto. Qed. Lemma elements_3w : NoDupA eq_key (elements m). Proof. apply ME.Sort_NoDupA. apply elements_3. Qed. End FMapSpec. (** [map] and [mapi] *) Variable B : Type. Section Mapi. Variable f : key -> A -> B. Fixpoint xmapi (m : t A) (i : key) : t B := match m with | Leaf => @Leaf B | Node l o r => Node (xmapi l (append i (xO xH))) (option_map (f i) o) (xmapi r (append i (xI xH))) end. Definition mapi m := xmapi m xH. End Mapi. Definition map (f : A -> B) m := mapi (fun _ => f) m. End A. Lemma xgmapi: forall (A B: Type) (f: key -> A -> B) (i j : key) (m: t A), find i (xmapi f m j) = option_map (f (append j i)) (find i m). Proof. induction i; intros; destruct m; simpl; auto. - rewrite (append_assoc_1 j i); apply IHi. - rewrite (append_assoc_0 j i); apply IHi. - rewrite (append_neutral_r j); auto. Qed. Theorem gmapi: forall (A B: Type) (f: key -> A -> B) (i: key) (m: t A), find i (mapi f m) = option_map (f i) (find i m). Proof. intros. unfold mapi. replace (f i) with (f (append xH i)). - apply xgmapi. - rewrite append_neutral_l; auto. Qed. Lemma mapi_1 : forall (elt elt':Type)(m: t elt)(x:key)(e:elt)(f:key->elt->elt'), MapsTo x e m -> exists y, E.eq y x /\ MapsTo x (f y e) (mapi f m). Proof. intros. exists x. split; [red; auto|]. apply find_2. generalize (find_1 H); clear H; intros. rewrite gmapi. rewrite H. simpl; auto. Qed. Lemma mapi_2 : forall (elt elt':Type)(m: t elt)(x:key)(f:key->elt->elt'), In x (mapi f m) -> In x m. Proof. intros. apply mem_2. rewrite mem_find. destruct H as (v,H). generalize (find_1 H); clear H; intros. rewrite gmapi in H. destruct (find x m); auto. simpl in *; discriminate. Qed. Lemma map_1 : forall (elt elt':Type)(m: t elt)(x:key)(e:elt)(f:elt->elt'), MapsTo x e m -> MapsTo x (f e) (map f m). Proof. intros; unfold map. destruct (mapi_1 (fun _ => f) H); intuition. Qed. Lemma map_2 : forall (elt elt':Type)(m: t elt)(x:key)(f:elt->elt'), In x (map f m) -> In x m. Proof. intros; unfold map in *; eapply mapi_2; eauto. Qed. Section map2. Variable A B C : Type. Variable f : option A -> option B -> option C. Arguments Leaf {A}. Fixpoint xmap2_l (m : t A) : t C := match m with | Leaf => Leaf | Node l o r => Node (xmap2_l l) (f o None) (xmap2_l r) end. Lemma xgmap2_l : forall (i : key) (m : t A), f None None = None -> find i (xmap2_l m) = f (find i m) None. Proof. induction i; intros; destruct m; simpl; auto. Qed. Fixpoint xmap2_r (m : t B) : t C := match m with | Leaf => Leaf | Node l o r => Node (xmap2_r l) (f None o) (xmap2_r r) end. Lemma xgmap2_r : forall (i : key) (m : t B), f None None = None -> find i (xmap2_r m) = f None (find i m). Proof. induction i; intros; destruct m; simpl; auto. Qed. Fixpoint _map2 (m1 : t A)(m2 : t B) : t C := match m1 with | Leaf => xmap2_r m2 | Node l1 o1 r1 => match m2 with | Leaf => xmap2_l m1 | Node l2 o2 r2 => Node (_map2 l1 l2) (f o1 o2) (_map2 r1 r2) end end. Lemma gmap2: forall (i: key)(m1:t A)(m2: t B), f None None = None -> find i (_map2 m1 m2) = f (find i m1) (find i m2). Proof. induction i; intros; destruct m1; destruct m2; simpl; auto; try apply xgmap2_r; try apply xgmap2_l; auto. Qed. End map2. Definition map2 (elt elt' elt'':Type)(f:option elt->option elt'->option elt'') := _map2 (fun o1 o2 => match o1,o2 with None,None => None | _, _ => f o1 o2 end). Lemma map2_1 : forall (elt elt' elt'':Type)(m: t elt)(m': t elt') (x:key)(f:option elt->option elt'->option elt''), In x m \/ In x m' -> find x (map2 f m m') = f (find x m) (find x m'). Proof. intros. unfold map2. rewrite gmap2; auto. generalize (@mem_1 _ m x) (@mem_1 _ m' x). do 2 rewrite mem_find. destruct (find x m); simpl; auto. destruct (find x m'); simpl; auto. intros. destruct H; intuition; try discriminate. Qed. Lemma map2_2 : forall (elt elt' elt'':Type)(m: t elt)(m': t elt') (x:key)(f:option elt->option elt'->option elt''), In x (map2 f m m') -> In x m \/ In x m'. Proof. intros. generalize (mem_1 H); clear H; intros. rewrite mem_find in H. unfold map2 in H. rewrite gmap2 in H; auto. generalize (@mem_2 _ m x) (@mem_2 _ m' x). do 2 rewrite mem_find. destruct (find x m); simpl in *; auto. destruct (find x m'); simpl in *; auto. Qed. Section Fold. Variables A B : Type. Variable f : key -> A -> B -> B. Fixpoint xfoldi (m : t A) (v : B) (i : key) := match m with | Leaf _ => v | Node l (Some x) r => xfoldi r (f i x (xfoldi l v (append i 2))) (append i 3) | Node l None r => xfoldi r (xfoldi l v (append i 2)) (append i 3) end. Lemma xfoldi_1 : forall m v i, xfoldi m v i = fold_left (fun a p => f (fst p) (snd p) a) (xelements m i) v. Proof. set (F := fun a p => f (fst p) (snd p) a). induction m; intros; simpl; auto. destruct o. - rewrite fold_left_app; simpl. rewrite <- IHm1. rewrite <- IHm2. unfold F; simpl; reflexivity. - rewrite fold_left_app; simpl. rewrite <- IHm1. rewrite <- IHm2. reflexivity. Qed. Definition fold m i := xfoldi m i 1. End Fold. Lemma fold_1 : forall (A:Type)(m:t A)(B:Type)(i : B) (f : key -> A -> B -> B), fold f m i = fold_left (fun a p => f (fst p) (snd p) a) (elements m) i. Proof. intros; unfold fold, elements. rewrite xfoldi_1; reflexivity. Qed. Fixpoint equal (A:Type)(cmp : A -> A -> bool)(m1 m2 : t A) : bool := match m1, m2 with | Leaf _, _ => is_empty m2 | _, Leaf _ => is_empty m1 | Node l1 o1 r1, Node l2 o2 r2 => (match o1, o2 with | None, None => true | Some v1, Some v2 => cmp v1 v2 | _, _ => false end) && equal cmp l1 l2 && equal cmp r1 r2 end. Definition Equal (A:Type)(m m':t A) := forall y, find y m = find y m'. Definition Equiv (A:Type)(eq_elt:A->A->Prop) m m' := (forall k, In k m <-> In k m') /\ (forall k e e', MapsTo k e m -> MapsTo k e' m' -> eq_elt e e'). Definition Equivb (A:Type)(cmp: A->A->bool) := Equiv (Cmp cmp). Lemma equal_1 : forall (A:Type)(m m':t A)(cmp:A->A->bool), Equivb cmp m m' -> equal cmp m m' = true. Proof. induction m. - (* m = Leaf *) destruct 1. simpl. apply is_empty_1. red; red; intros. assert (In a (Leaf A)). + rewrite H. exists e; auto. + destruct H2; red in H2. destruct a; simpl in *; discriminate. - (* m = Node *) destruct m'. + (* m' = Leaf *) destruct 1. simpl. destruct o. * assert (In xH (Leaf A)). { rewrite <- H. exists a; red; auto. } destruct H1; red in H1; simpl in H1; discriminate. * apply andb_true_intro; split; apply is_empty_1; red; red; intros. -- assert (In (xO a) (Leaf A)). { rewrite <- H. exists e; auto. } destruct H2; red in H2; simpl in H2; discriminate. -- assert (In (xI a) (Leaf A)). { rewrite <- H. exists e; auto. } destruct H2; red in H2; simpl in H2; discriminate. + (* m' = Node *) destruct 1. assert (Equivb cmp m1 m'1). { split. - intros k; generalize (H (xO k)); unfold In, MapsTo; simpl; auto. - intros k e e'; generalize (H0 (xO k) e e'); unfold In, MapsTo; simpl; auto. } assert (Equivb cmp m2 m'2). { split. - intros k; generalize (H (xI k)); unfold In, MapsTo; simpl; auto. - intros k e e'; generalize (H0 (xI k) e e'); unfold In, MapsTo; simpl; auto. } simpl. destruct o; destruct o0; simpl. * repeat (apply andb_true_intro; split); auto. apply (H0 xH); red; auto. * generalize (H xH); unfold In, MapsTo; simpl; intuition. destruct H4; try discriminate; eauto. * generalize (H xH); unfold In, MapsTo; simpl; intuition. destruct H5; try discriminate; eauto. * apply andb_true_intro; split; auto. Qed. Lemma equal_2 : forall (A:Type)(m m':t A)(cmp:A->A->bool), equal cmp m m' = true -> Equivb cmp m m'. Proof. induction m. - (* m = Leaf *) simpl. split; intros. + split. * destruct 1; red in H0; destruct k; discriminate. * destruct 1; elim (is_empty_2 H H0). + red in H0; destruct k; discriminate. - (* m = Node *) destruct m'. + (* m' = Leaf *) simpl. destruct o; intros; try discriminate. destruct (andb_prop _ _ H); clear H. split; intros. * split; unfold In, MapsTo; destruct 1. -- destruct k; simpl in *; try discriminate. ++ destruct (is_empty_2 H1 (find_2 _ _ H)). ++ destruct (is_empty_2 H0 (find_2 _ _ H)). -- destruct k; simpl in *; discriminate. * unfold In, MapsTo; destruct k; simpl in *; discriminate. + (* m' = Node *) destruct o; destruct o0; simpl; intros; try discriminate. * destruct (andb_prop _ _ H); clear H. destruct (andb_prop _ _ H0); clear H0. destruct (IHm1 _ _ H2); clear H2 IHm1. destruct (IHm2 _ _ H1); clear H1 IHm2. split; intros. -- destruct k; unfold In, MapsTo in *; simpl; auto. split; eauto. -- destruct k; unfold In, MapsTo in *; simpl in *. ++ eapply H4; eauto. ++ eapply H3; eauto. ++ congruence. * destruct (andb_prop _ _ H); clear H. destruct (IHm1 _ _ H0); clear H0 IHm1. destruct (IHm2 _ _ H1); clear H1 IHm2. split; intros. -- destruct k; unfold In, MapsTo in *; simpl; auto. split; eauto. -- destruct k; unfold In, MapsTo in *; simpl in *. ++ eapply H3; eauto. ++ eapply H2; eauto. ++ try discriminate. Qed. End PositiveMap. (** Here come some additional facts about this implementation. Most are facts that cannot be derivable from the general interface. *) Module PositiveMapAdditionalFacts. Import PositiveMap. (* Derivable from the Map interface *) Theorem gsspec: forall (A:Type)(i j: key) (x: A) (m: t A), find i (add j x m) = if E.eq_dec i j then Some x else find i m. Proof. intros. destruct (E.eq_dec i j) as [ ->|]; [ apply gss | apply gso; auto ]. Qed. (* Not derivable from the Map interface *) Theorem gsident: forall (A:Type)(i: key) (m: t A) (v: A), find i m = Some v -> add i v m = m. Proof. induction i; intros; destruct m; simpl; simpl in H; try congruence. - rewrite (IHi m2 v H); congruence. - rewrite (IHi m1 v H); congruence. Qed. Lemma xmap2_lr : forall (A B : Type)(f g: option A -> option A -> option B)(m : t A), (forall (i j : option A), f i j = g j i) -> xmap2_l f m = xmap2_r g m. Proof. induction m; intros; simpl; auto. rewrite IHm1; auto. rewrite IHm2; auto. rewrite H; auto. Qed. Theorem map2_commut: forall (A B: Type) (f g: option A -> option A -> option B), (forall (i j: option A), f i j = g j i) -> forall (m1 m2: t A), _map2 f m1 m2 = _map2 g m2 m1. Proof. intros A B f g Eq1. assert (Eq2: forall (i j: option A), g i j = f j i). { intros; auto. } induction m1; intros; destruct m2; simpl; try rewrite Eq1; repeat rewrite (xmap2_lr f g); repeat rewrite (xmap2_lr g f); auto. rewrite IHm1_1. rewrite IHm1_2. auto. Qed. End PositiveMapAdditionalFacts. coq-8.20.0/theories/FSets/FMapWeakList.v000066400000000000000000000742151466560755400177420ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* is_empty m = true. Proof. unfold Empty, PX.MapsTo. intros m. case m;auto. intros p l inlist. destruct p. absurd (InA eqke (t0, e) ((t0, e) :: l));auto. Qed. Lemma is_empty_2 : forall m, is_empty m = true -> Empty m. Proof. intros m. case m;auto. intros p l abs. inversion abs. Qed. (** * [mem] *) Fixpoint mem (k : key) (s : t elt) {struct s} : bool := match s with | nil => false | (k',_) :: l => if X.eq_dec k k' then true else mem k l end. Lemma mem_1 : forall m (Hm:NoDupA m) x, In x m -> mem x m = true. Proof. intros m Hm x; generalize Hm; clear Hm. induction m; simpl; intros NoDup belong1. - inversion belong1. inversion H. - destruct a; destruct X.eq_dec; [reflexivity|]; apply IHm. + inversion_clear NoDup; assumption. + inversion_clear belong1; inversion_clear H; [elim n; apply H0|exists x0; auto]. Qed. Lemma mem_2 : forall m (Hm:NoDupA m) x, mem x m = true -> In x m. Proof. intros m Hm x; generalize Hm; clear Hm; unfold PX.In,PX.MapsTo. induction m; intros NoDup hyp; try discriminate; simpl in *. destruct a, X.eq_dec. + exists e; constructor; split; [assumption|reflexivity]. + destruct IHm as [e' He']. - inversion_clear NoDup; assumption. - assumption. - exists e'; auto. Qed. (** * [find] *) Fixpoint find (k:key) (s: t elt) {struct s} : option elt := match s with | nil => None | (k',x)::s' => if X.eq_dec k k' then Some x else find k s' end. Lemma find_2 : forall m x e, find x m = Some e -> MapsTo x e m. Proof. intros m x. unfold PX.MapsTo. induction m; simpl;intros e' eqfind; inversion eqfind; auto. destruct a, X.eq_dec. + constructor; split; simpl; congruence. + constructor 2; apply IHm; assumption. Qed. Lemma find_1 : forall m (Hm:NoDupA m) x e, MapsTo x e m -> find x m = Some e. Proof. intros m; induction m as [|[a e]]; simpl; intros Hdup x e' Hm. - inversion Hm. - inversion_clear Hdup. inversion_clear Hm; destruct X.eq_dec. + destruct H1; simpl in *; congruence. + elim n; apply H1. + elim H; apply InA_eqk with (x,e'); auto. + apply IHm; auto. Qed. (* Not part of the exported specifications, used later for [combine]. *) Lemma find_eq : forall m (Hm:NoDupA m) x x', X.eq x x' -> find x m = find x' m. Proof. induction m; simpl; auto; destruct a; intros. inversion_clear Hm. rewrite (IHm H1 x x'); auto. destruct (X.eq_dec x t0) as [|Hneq]; destruct (X.eq_dec x' t0) as [|?Hneq']; trivial. - elim Hneq'; apply X.eq_trans with x; auto. - elim Hneq; apply X.eq_trans with x'; auto. Qed. (** * [add] *) Fixpoint add (k : key) (x : elt) (s : t elt) {struct s} : t elt := match s with | nil => (k,x) :: nil | (k',y) :: l => if X.eq_dec k k' then (k,x)::l else (k',y)::add k x l end. Lemma add_1 : forall m x y e, X.eq x y -> MapsTo y e (add x e m). Proof. induction m as [|[a m]]; intros x y e He; simpl in *; auto. destruct X.eq_dec; [now auto|]. apply InA_cons_tl, IHm, He. Qed. Lemma add_2 : forall m x y e e', ~ X.eq x y -> MapsTo y e m -> MapsTo y e (add x e' m). Proof. induction m as [|[a m]]; intros x y e e' H Hm; simpl in *. - inversion_clear Hm. - inversion_clear Hm; destruct X.eq_dec. + elim H; apply X.eq_trans with a; [auto|apply X.eq_sym; apply H0]. + apply InA_cons_hd; apply H0. + apply InA_cons_tl; assumption. + apply InA_cons_tl; apply IHm; auto. Qed. Lemma add_3 : forall m x y e e', ~ X.eq x y -> MapsTo y e (add x e' m) -> MapsTo y e m. Proof. induction m as [|[a m]]; intros x y e e' H Hm. - exfalso; inversion_clear Hm. + elim H; apply X.eq_sym; apply H0. + inversion_clear H0. - simpl in Hm; destruct X.eq_dec. + apply InA_cons_tl; apply InA_cons in Hm; destruct Hm; [|now auto]. elim H; apply X.eq_sym; apply H0. + apply InA_cons in Hm; destruct Hm. * apply InA_cons_hd; auto. * apply InA_cons_tl; eapply IHm; eauto. Qed. Lemma add_3' : forall m x y e e', ~ X.eq x y -> InA eqk (y,e) (add x e' m) -> InA eqk (y,e) m. Proof. induction m as [|[a m]]; intros x y e e' H Hm; simpl in *. - inversion_clear Hm; [|now auto]. compute in H0; elim H; auto. - destruct X.eq_dec; simpl in *. + apply InA_cons in Hm; destruct Hm; [elim H; apply X.eq_sym; apply H0|]. apply InA_cons_tl; auto. + apply InA_cons in Hm; destruct Hm; [apply InA_cons_hd; auto|]. apply InA_cons_tl; eapply IHm; eauto. Qed. Lemma add_NoDup : forall m (Hm:NoDupA m) x e, NoDupA (add x e m). Proof. induction m. - simpl; constructor; auto; red; inversion 1. - intros. destruct a as (x',e'). simpl; case (X.eq_dec x x'); inversion_clear Hm; auto. + constructor; auto. contradict H. apply InA_eqk with (x,e); auto. + constructor; auto. contradict H; apply add_3' with x e; auto. Qed. (* Not part of the exported specifications, used later for [combine]. *) Lemma add_eq : forall m (Hm:NoDupA m) x a e, X.eq x a -> find x (add a e m) = Some e. Proof. intros. apply find_1; auto. - apply add_NoDup; auto. - apply add_1; auto. Qed. Lemma add_not_eq : forall m (Hm:NoDupA m) x a e, ~X.eq x a -> find x (add a e m) = find x m. Proof. intros. case_eq (find x m); intros. - apply find_1; auto. + apply add_NoDup; auto. + apply add_2; auto. apply find_2; auto. - case_eq (find x (add a e m)); intros; auto. rewrite <- H0; symmetry. apply find_1; auto. apply add_3 with a e; auto. apply find_2; auto. Qed. (** * [remove] *) Fixpoint remove (k : key) (s : t elt) {struct s} : t elt := match s with | nil => nil | (k',x) :: l => if X.eq_dec k k' then l else (k',x) :: remove k l end. Lemma remove_1 : forall m (Hm:NoDupA m) x y, X.eq x y -> ~ In y (remove x m). Proof. induction m as [|[a m]]; intros Hm x y H; simpl in *. - inversion 1; inversion H1. - inversion_clear Hm. destruct X.eq_dec. + intros [e' ?]; elim H0. apply InA_eqk with (y, e'). * apply X.eq_trans with x; [|auto]. apply X.eq_sym; auto. * apply InA_eqke_eqk; auto. + intros [e' H2]; apply InA_cons in H2; destruct H2. * elim n; apply X.eq_trans with y; [auto|apply H2]. * elim IHm with x y; auto. exists e'; auto. Qed. Lemma remove_2 : forall m (Hm:NoDupA m) x y e, ~ X.eq x y -> MapsTo y e m -> MapsTo y e (remove x m). Proof. induction m as [|[a m]]; intros Hm x y e H He; simpl in *. + inversion_clear He. + apply InA_cons in He; destruct He, X.eq_dec. - elim H; apply X.eq_trans with a; [auto|]; apply X.eq_sym; apply H0. - inversion_clear Hm; apply InA_cons_hd; assumption. - apply H0. - inversion_clear Hm. apply InA_cons; destruct (X.eq_dec y a). * elim H1; apply InA_eqk with (y, e); [assumption|]; apply InA_eqke_eqk; auto. * right; apply IHm; auto. Qed. Lemma remove_3 : forall m (Hm:NoDupA m) x y e, MapsTo y e (remove x m) -> MapsTo y e m. Proof. induction m as [|[a m]]; intros Hm x y e H; unfold PX.MapsTo; simpl in *; auto. destruct X.eq_dec. - apply InA_cons_tl; apply H. - inversion_clear Hm; apply InA_cons in H; destruct H; [apply InA_cons_hd; auto|]. apply InA_cons_tl; apply IHm with x; auto. Qed. Lemma remove_3' : forall m (Hm:NoDupA m) x y e, InA eqk (y,e) (remove x m) -> InA eqk (y,e) m. Proof. induction m as [|[a m]]; intros Hm x y e H; unfold PX.MapsTo; simpl in *. - inversion_clear H. - destruct X.eq_dec. + apply InA_cons_tl; auto. + apply InA_cons in H; destruct H; [apply InA_cons_hd; auto|]. inversion_clear Hm; apply InA_cons_tl; apply IHm with x; auto. Qed. Lemma remove_NoDup : forall m (Hm:NoDupA m) x, NoDupA (remove x m). Proof. induction m. - simpl; intuition. - intros. inversion_clear Hm. destruct a as (x',e'). simpl; case (X.eq_dec x x'); auto. constructor; auto. contradict H; apply remove_3' with x; auto. Qed. (** * [elements] *) Definition elements (m: t elt) := m. Lemma elements_1 : forall m x e, MapsTo x e m -> InA eqke (x,e) (elements m). Proof. auto. Qed. Lemma elements_2 : forall m x e, InA eqke (x,e) (elements m) -> MapsTo x e m. Proof. auto. Qed. Lemma elements_3w : forall m (Hm:NoDupA m), NoDupA (elements m). Proof. auto. Qed. (** * [fold] *) Fixpoint fold (A:Type)(f:key->elt->A->A)(m:t elt) (acc : A) {struct m} : A := match m with | nil => acc | (k,e)::m' => fold f m' (f k e acc) end. Lemma fold_1 : forall m (A:Type)(i:A)(f:key->elt->A->A), fold f m i = fold_left (fun a p => f (fst p) (snd p) a) (elements m) i. Proof. induction m as [|[a m]]; intros A i f; simpl; auto. Qed. (** * [equal] *) Definition check (cmp : elt -> elt -> bool)(k:key)(e:elt)(m': t elt) := match find k m' with | None => false | Some e' => cmp e e' end. Definition submap (cmp : elt -> elt -> bool)(m m' : t elt) : bool := fold (fun k e b => andb (check cmp k e m') b) m true. Definition equal (cmp : elt -> elt -> bool)(m m' : t elt) : bool := andb (submap cmp m m') (submap (fun e' e => cmp e e') m' m). Definition Submap cmp m m' := (forall k, In k m -> In k m') /\ (forall k e e', MapsTo k e m -> MapsTo k e' m' -> cmp e e' = true). Definition Equivb cmp m m' := (forall k, In k m <-> In k m') /\ (forall k e e', MapsTo k e m -> MapsTo k e' m' -> cmp e e' = true). Lemma submap_1 : forall m (Hm:NoDupA m) m' (Hm': NoDupA m') cmp, Submap cmp m m' -> submap cmp m m' = true. Proof. unfold Submap, submap. induction m. - simpl; auto. - destruct a; simpl; intros. destruct H. inversion_clear Hm. assert (H3 : In t0 m'). + apply H; exists e; auto. + destruct H3 as (e', H3). unfold check at 2; rewrite (find_1 Hm' H3). rewrite (H0 t0); simpl; auto. eapply IHm; auto. split; intuition. * apply H. destruct H5 as (e'',H5); exists e''; auto. * apply H0 with k; auto. Qed. Lemma submap_2 : forall m (Hm:NoDupA m) m' (Hm': NoDupA m') cmp, submap cmp m m' = true -> Submap cmp m m'. Proof. unfold Submap, submap. induction m. - simpl; auto. intuition. + destruct H0; inversion H0. + inversion H0. - destruct a; simpl; intros. inversion_clear Hm. rewrite andb_b_true in H. assert (check cmp t0 e m' = true). + clear H1 H0 Hm' IHm. set (b:=check cmp t0 e m') in *. generalize H; clear H; generalize b; clear b. induction m; simpl; auto; intros. destruct a; simpl in *. destruct (andb_prop _ _ (IHm _ H)); auto. + rewrite H2 in H. destruct (IHm H1 m' Hm' cmp H); auto. unfold check in H2. case_eq (find t0 m'); [intros e' H5 | intros H5]; rewrite H5 in H2; try discriminate. split; intros. * destruct H6 as (e0,H6); inversion_clear H6. -- compute in H7; destruct H7; subst. exists e'. apply PX.MapsTo_eq with t0; auto. apply find_2; auto. -- apply H3. exists e0; auto. * inversion_clear H6. -- compute in H8; destruct H8; subst. rewrite (find_1 Hm' (PX.MapsTo_eq H6 H7)) in H5; congruence. -- apply H4 with k; auto. Qed. (** Specification of [equal] *) Lemma equal_1 : forall m (Hm:NoDupA m) m' (Hm': NoDupA m') cmp, Equivb cmp m m' -> equal cmp m m' = true. Proof. unfold Equivb, equal. intuition. apply andb_true_intro; split; apply submap_1; unfold Submap; firstorder. Qed. Lemma equal_2 : forall m (Hm:NoDupA m) m' (Hm':NoDupA m') cmp, equal cmp m m' = true -> Equivb cmp m m'. Proof. unfold Equivb, equal. intros. destruct (andb_prop _ _ H); clear H. generalize (submap_2 Hm Hm' H0). generalize (submap_2 Hm' Hm H1). firstorder. Qed. Variable elt':Type. (** * [map] and [mapi] *) Fixpoint map (f:elt -> elt') (m:t elt) : t elt' := match m with | nil => nil | (k,e)::m' => (k,f e) :: map f m' end. Fixpoint mapi (f: key -> elt -> elt') (m:t elt) : t elt' := match m with | nil => nil | (k,e)::m' => (k,f k e) :: mapi f m' end. End Elt. Section Elt2. (* A new section is necessary for previous definitions to work with different [elt], especially [MapsTo]... *) Variable elt elt' : Type. (** Specification of [map] *) Lemma map_1 : forall (m:t elt)(x:key)(e:elt)(f:elt->elt'), MapsTo x e m -> MapsTo x (f e) (map f m). Proof. intros m x e f. (* functional induction map elt elt' f m. *) (* Marche pas ??? *) induction m. - inversion 1. - destruct a as (x',e'). simpl. inversion_clear 1. + constructor 1. unfold eqke in *; simpl in *; intuition congruence. + constructor 2. unfold MapsTo in *; auto. Qed. Lemma map_2 : forall (m:t elt)(x:key)(f:elt->elt'), In x (map f m) -> In x m. Proof. intros m x f. (* functional induction map elt elt' f m. *) (* Marche pas ??? *) induction m; simpl. - intros (e,abs). inversion abs. - destruct a as (x',e). intros hyp. inversion hyp. clear hyp. inversion H; subst; rename x0 into e'. + exists e; constructor. unfold eqke in *; simpl in *; intuition. + destruct IHm as (e'',hyp). * exists e'; auto. * exists e''. constructor 2; auto. Qed. Lemma map_NoDup : forall m (Hm : NoDupA (@eqk elt) m)(f:elt->elt'), NoDupA (@eqk elt') (map f m). Proof. induction m; simpl; auto. intros. destruct a as (x',e'). inversion_clear Hm. constructor; auto. contradict H. (* il faut un map_1 avec eqk au lieu de eqke *) clear IHm H0. induction m; simpl in *; auto. - inversion H. - destruct a; inversion H; auto. Qed. (** Specification of [mapi] *) Lemma mapi_1 : forall (m:t elt)(x:key)(e:elt)(f:key->elt->elt'), MapsTo x e m -> exists y, X.eq y x /\ MapsTo x (f y e) (mapi f m). Proof. intros m x e f. (* functional induction mapi elt elt' f m. *) (* Marche pas ??? *) induction m. - inversion 1. - destruct a as (x',e'). simpl. inversion_clear 1. + exists x'. destruct H0; simpl in *. split; auto. constructor 1. unfold eqke in *; simpl in *; intuition congruence. + destruct IHm as (y, hyp); auto. exists y; intuition. Qed. Lemma mapi_2 : forall (m:t elt)(x:key)(f:key->elt->elt'), In x (mapi f m) -> In x m. Proof. intros m x f. (* functional induction mapi elt elt' f m. *) (* Marche pas ??? *) induction m; simpl. - intros (e,abs). inversion abs. - destruct a as (x',e). intros hyp. inversion hyp. clear hyp. inversion H; subst; rename x0 into e'. + exists e; constructor. unfold eqke in *; simpl in *; intuition. + destruct IHm as (e'',hyp). * exists e'; auto. * exists e''. constructor 2; auto. Qed. Lemma mapi_NoDup : forall m (Hm : NoDupA (@eqk elt) m)(f: key->elt->elt'), NoDupA (@eqk elt') (mapi f m). Proof. induction m; simpl; auto. intros. destruct a as (x',e'). inversion_clear Hm; auto. constructor; auto. contradict H. clear IHm H0. induction m; simpl in *; auto. - inversion_clear H. - destruct a; inversion_clear H; auto. Qed. End Elt2. Section Elt3. Variable elt elt' elt'' : Type. Notation oee' := (option elt * option elt')%type. Definition combine_l (m:t elt)(m':t elt') : t oee' := mapi (fun k e => (Some e, find k m')) m. Definition combine_r (m:t elt)(m':t elt') : t oee' := mapi (fun k e' => (find k m, Some e')) m'. Definition fold_right_pair (A B C:Type)(f:A->B->C->C) := List.fold_right (fun p => f (fst p) (snd p)). Definition combine (m:t elt)(m':t elt') : t oee' := let l := combine_l m m' in let r := combine_r m m' in fold_right_pair (add (elt:=oee')) r l. Lemma fold_right_pair_NoDup : forall l r (Hl: NoDupA (eqk (elt:=oee')) l) (Hl: NoDupA (eqk (elt:=oee')) r), NoDupA (eqk (elt:=oee')) (fold_right_pair (add (elt:=oee')) r l). Proof. induction l; simpl; auto. destruct a; simpl; auto. inversion_clear 1. intros; apply add_NoDup; auto. Qed. #[local] Hint Resolve fold_right_pair_NoDup : core. Lemma combine_NoDup : forall m (Hm:NoDupA (@eqk elt) m) m' (Hm':NoDupA (@eqk elt') m'), NoDupA (@eqk oee') (combine m m'). Proof. unfold combine, combine_r, combine_l. intros. set (f1 := fun (k : key) (e : elt) => (Some e, find k m')). set (f2 := fun (k : key) (e' : elt') => (find k m, Some e')). generalize (mapi_NoDup Hm f1). generalize (mapi_NoDup Hm' f2). set (l := mapi f1 m); clearbody l. set (r := mapi f2 m'); clearbody r. auto. Qed. Definition at_least_left (o:option elt)(o':option elt') := match o with | None => None | _ => Some (o,o') end. Definition at_least_right (o:option elt)(o':option elt') := match o' with | None => None | _ => Some (o,o') end. Lemma combine_l_1 : forall m (Hm:NoDupA (@eqk elt) m) m' (Hm':NoDupA (@eqk elt') m')(x:key), find x (combine_l m m') = at_least_left (find x m) (find x m'). Proof. unfold combine_l. intros. case_eq (find x m); intros. - simpl. apply find_1. + apply mapi_NoDup; auto. + destruct (mapi_1 (fun k e => (Some e, find k m')) (find_2 H)) as (y,(H0,H1)). rewrite (find_eq Hm' (X.eq_sym H0)); auto. - simpl. case_eq (find x (mapi (fun k e => (Some e, find k m')) m)); intros; auto. destruct (@mapi_2 _ _ m x (fun k e => (Some e, find k m'))). + exists p; apply find_2; auto. + rewrite (find_1 Hm H1) in H; discriminate. Qed. Lemma combine_r_1 : forall m (Hm:NoDupA (@eqk elt) m) m' (Hm':NoDupA (@eqk elt') m')(x:key), find x (combine_r m m') = at_least_right (find x m) (find x m'). Proof. unfold combine_r. intros. case_eq (find x m'); intros. - simpl. apply find_1. + apply mapi_NoDup; auto. + destruct (mapi_1 (fun k e => (find k m, Some e)) (find_2 H)) as (y,(H0,H1)). rewrite (find_eq Hm (X.eq_sym H0)); auto. - simpl. case_eq (find x (mapi (fun k e' => (find k m, Some e')) m')); intros; auto. destruct (@mapi_2 _ _ m' x (fun k e' => (find k m, Some e'))). + exists p; apply find_2; auto. + rewrite (find_1 Hm' H1) in H; discriminate. Qed. Definition at_least_one (o:option elt)(o':option elt') := match o, o' with | None, None => None | _, _ => Some (o,o') end. Lemma combine_1 : forall m (Hm:NoDupA (@eqk elt) m) m' (Hm':NoDupA (@eqk elt') m')(x:key), find x (combine m m') = at_least_one (find x m) (find x m'). Proof. unfold combine. intros. generalize (combine_r_1 Hm Hm' x). generalize (combine_l_1 Hm Hm' x). assert (NoDupA (eqk (elt:=oee')) (combine_l m m')). { unfold combine_l; apply mapi_NoDup; auto. } assert (NoDupA (eqk (elt:=oee')) (combine_r m m')). { unfold combine_r; apply mapi_NoDup; auto. } set (l := combine_l m m') in *; clearbody l. set (r := combine_r m m') in *; clearbody r. set (o := find x m); clearbody o. set (o' := find x m'); clearbody o'. clear Hm' Hm m m'. induction l. - destruct o; destruct o'; simpl; intros; discriminate || auto. - destruct a; simpl in *; intros. destruct (X.eq_dec x t0); simpl in *. + unfold at_least_left in H1. destruct o; simpl in *; try discriminate. inversion H1; subst. apply add_eq; auto. inversion_clear H; auto. + inversion_clear H. rewrite <- IHl; auto. apply add_not_eq; auto. Qed. Variable f : option elt -> option elt' -> option elt''. Definition option_cons (A:Type)(k:key)(o:option A)(l:list (key*A)) := match o with | Some e => (k,e)::l | None => l end. Definition map2 m m' := let m0 : t oee' := combine m m' in let m1 : t (option elt'') := map (fun p => f (fst p) (snd p)) m0 in fold_right_pair (option_cons (A:=elt'')) nil m1. Lemma map2_NoDup : forall m (Hm:NoDupA (@eqk elt) m) m' (Hm':NoDupA (@eqk elt') m'), NoDupA (@eqk elt'') (map2 m m'). Proof. intros. unfold map2. assert (H0:=combine_NoDup Hm Hm'). set (l0:=combine m m') in *; clearbody l0. set (f':= fun p : oee' => f (fst p) (snd p)). assert (H1:=map_NoDup (elt' := option elt'') H0 f'). set (l1:=map f' l0) in *; clearbody l1. clear f' f H0 l0 Hm Hm' m m'. induction l1. - simpl; auto. - inversion_clear H1. destruct a; destruct o; simpl; auto. constructor; auto. contradict H. clear IHl1. induction l1. + inversion H. + inversion_clear H0. destruct a; destruct o; simpl in *; auto. inversion_clear H; auto. Qed. Definition at_least_one_then_f (o:option elt)(o':option elt') := match o, o' with | None, None => None | _, _ => f o o' end. Lemma map2_0 : forall m (Hm:NoDupA (@eqk elt) m) m' (Hm':NoDupA (@eqk elt') m')(x:key), find x (map2 m m') = at_least_one_then_f (find x m) (find x m'). Proof. intros. unfold map2. assert (H:=combine_1 Hm Hm' x). assert (H2:=combine_NoDup Hm Hm'). set (f':= fun p : oee' => f (fst p) (snd p)). set (m0 := combine m m') in *; clearbody m0. set (o:=find x m) in *; clearbody o. set (o':=find x m') in *; clearbody o'. clear Hm Hm' m m'. generalize H; clear H. match goal with |- ?m=?n -> ?p=?q => assert ((m=n->p=q)/\(m=None -> p=None)); [|intuition] end. induction m0; simpl in *; intuition. - destruct o; destruct o'; simpl in *; try discriminate; auto. - destruct a as (k,(oo,oo')); simpl in *. inversion_clear H2. destruct (X.eq_dec x k) as [|Hneq]; simpl in *. + (* x = k *) assert (at_least_one_then_f o o' = f oo oo'). * destruct o; destruct o'; simpl in *; inversion_clear H; auto. * rewrite H2. unfold f'; simpl. destruct (f oo oo'); simpl. -- destruct (X.eq_dec x k) as [|Hneq]; try contradict Hneq; auto. -- destruct (IHm0 H1) as (_,H4); apply H4; auto. case_eq (find x m0); intros; auto. elim H0. apply InA_eqk with (x,p); auto. apply InA_eqke_eqk. exact (find_2 H3). + (* k < x *) unfold f'; simpl. destruct (f oo oo'); simpl. * destruct (X.eq_dec x k); [ contradict Hneq; auto | auto]. destruct (IHm0 H1) as (H3,_); apply H3; auto. * destruct (IHm0 H1) as (H3,_); apply H3; auto. - (* None -> None *) destruct a as (k,(oo,oo')). simpl. inversion_clear H2. destruct (X.eq_dec x k) as [|Hneq]. + (* x = k *) discriminate. + (* k < x *) unfold f'; simpl. destruct (f oo oo'); simpl. * destruct (X.eq_dec x k); [ contradict Hneq; auto | auto]. destruct (IHm0 H1) as (_,H4); apply H4; auto. * destruct (IHm0 H1) as (_,H4); apply H4; auto. Qed. (** Specification of [map2] *) Lemma map2_1 : forall m (Hm:NoDupA (@eqk elt) m) m' (Hm':NoDupA (@eqk elt') m')(x:key), In x m \/ In x m' -> find x (map2 m m') = f (find x m) (find x m'). Proof. intros. rewrite map2_0; auto. destruct H as [(e,H)|(e,H)]. - rewrite (find_1 Hm H). destruct (find x m'); simpl; auto. - rewrite (find_1 Hm' H). destruct (find x m); simpl; auto. Qed. Lemma map2_2 : forall m (Hm:NoDupA (@eqk elt) m) m' (Hm':NoDupA (@eqk elt') m')(x:key), In x (map2 m m') -> In x m \/ In x m'. Proof. intros. destruct H as (e,H). generalize (map2_0 Hm Hm' x). rewrite (find_1 (map2_NoDup Hm Hm') H). generalize (@find_2 _ m x). generalize (@find_2 _ m' x). destruct (find x m); destruct (find x m'); simpl; intros. - left; exists e0; auto. - left; exists e0; auto. - right; exists e0; auto. - discriminate. Qed. End Elt3. End Raw. Module Make (X: DecidableType) <: WS with Module E:=X. Module Raw := Raw X. Module E := X. Definition key := E.t. Record slist (elt:Type) := {this :> Raw.t elt; NoDup : NoDupA (@Raw.PX.eqk elt) this}. Definition t (elt:Type) := slist elt. Section Elt. Variable elt elt' elt'':Type. Implicit Types m : t elt. Implicit Types x y : key. Implicit Types e : elt. Definition empty : t elt := Build_slist (Raw.empty_NoDup elt). Definition is_empty m : bool := Raw.is_empty (this m). Definition add x e m : t elt := Build_slist (Raw.add_NoDup (NoDup m) x e). Definition find x m : option elt := Raw.find x (this m). Definition remove x m : t elt := Build_slist (Raw.remove_NoDup (NoDup m) x). Definition mem x m : bool := Raw.mem x (this m). Definition map f m : t elt' := Build_slist (Raw.map_NoDup (NoDup m) f). Definition mapi (f:key->elt->elt') m : t elt' := Build_slist (Raw.mapi_NoDup (NoDup m) f). Definition map2 f m (m':t elt') : t elt'' := Build_slist (Raw.map2_NoDup f (NoDup m) (NoDup m')). Definition elements m : list (key*elt) := @Raw.elements elt (this m). Definition cardinal m := length (this m). Definition fold (A:Type)(f:key->elt->A->A) m (i:A) : A := @Raw.fold elt A f (this m) i. Definition equal cmp m m' : bool := @Raw.equal elt cmp (this m) (this m'). Definition MapsTo x e m : Prop := Raw.PX.MapsTo x e (this m). Definition In x m : Prop := Raw.PX.In x (this m). Definition Empty m : Prop := Raw.Empty (this m). Definition Equal m m' := forall y, find y m = find y m'. Definition Equiv (eq_elt:elt->elt->Prop) m m' := (forall k, In k m <-> In k m') /\ (forall k e e', MapsTo k e m -> MapsTo k e' m' -> eq_elt e e'). Definition Equivb cmp m m' : Prop := @Raw.Equivb elt cmp (this m) (this m'). Definition eq_key : (key*elt) -> (key*elt) -> Prop := @Raw.PX.eqk elt. Definition eq_key_elt : (key*elt) -> (key*elt) -> Prop:= @Raw.PX.eqke elt. Lemma MapsTo_1 : forall m x y e, E.eq x y -> MapsTo x e m -> MapsTo y e m. Proof. intros m; exact (@Raw.PX.MapsTo_eq elt (this m)). Qed. Lemma mem_1 : forall m x, In x m -> mem x m = true. Proof. intros m; exact (@Raw.mem_1 elt (this m) (NoDup m)). Qed. Lemma mem_2 : forall m x, mem x m = true -> In x m. Proof. intros m; exact (@Raw.mem_2 elt (this m) (NoDup m)). Qed. Lemma empty_1 : Empty empty. Proof. exact (@Raw.empty_1 elt). Qed. Lemma is_empty_1 : forall m, Empty m -> is_empty m = true. Proof. intros m; exact (@Raw.is_empty_1 elt (this m)). Qed. Lemma is_empty_2 : forall m, is_empty m = true -> Empty m. Proof. intros m; exact (@Raw.is_empty_2 elt (this m)). Qed. Lemma add_1 : forall m x y e, E.eq x y -> MapsTo y e (add x e m). Proof. intros m; exact (@Raw.add_1 elt (this m)). Qed. Lemma add_2 : forall m x y e e', ~ E.eq x y -> MapsTo y e m -> MapsTo y e (add x e' m). Proof. intros m; exact (@Raw.add_2 elt (this m)). Qed. Lemma add_3 : forall m x y e e', ~ E.eq x y -> MapsTo y e (add x e' m) -> MapsTo y e m. Proof. intros m; exact (@Raw.add_3 elt (this m)). Qed. Lemma remove_1 : forall m x y, E.eq x y -> ~ In y (remove x m). Proof. intros m; exact (@Raw.remove_1 elt (this m) (NoDup m)). Qed. Lemma remove_2 : forall m x y e, ~ E.eq x y -> MapsTo y e m -> MapsTo y e (remove x m). Proof. intros m; exact (@Raw.remove_2 elt (this m) (NoDup m)). Qed. Lemma remove_3 : forall m x y e, MapsTo y e (remove x m) -> MapsTo y e m. Proof. intros m; exact (@Raw.remove_3 elt (this m) (NoDup m)). Qed. Lemma find_1 : forall m x e, MapsTo x e m -> find x m = Some e. Proof. intros m; exact (@Raw.find_1 elt (this m) (NoDup m)). Qed. Lemma find_2 : forall m x e, find x m = Some e -> MapsTo x e m. Proof. intros m; exact (@Raw.find_2 elt (this m)). Qed. Lemma elements_1 : forall m x e, MapsTo x e m -> InA eq_key_elt (x,e) (elements m). Proof. intros m; exact (@Raw.elements_1 elt (this m)). Qed. Lemma elements_2 : forall m x e, InA eq_key_elt (x,e) (elements m) -> MapsTo x e m. Proof. intros m; exact (@Raw.elements_2 elt (this m)). Qed. Lemma elements_3w : forall m, NoDupA eq_key (elements m). Proof. intros m; exact (@Raw.elements_3w elt (this m) (NoDup m)). Qed. Lemma cardinal_1 : forall m, cardinal m = length (elements m). Proof. intros; reflexivity. Qed. Lemma fold_1 : forall m (A : Type) (i : A) (f : key -> elt -> A -> A), fold f m i = fold_left (fun a p => f (fst p) (snd p) a) (elements m) i. Proof. intros m; exact (@Raw.fold_1 elt (this m)). Qed. Lemma equal_1 : forall m m' cmp, Equivb cmp m m' -> equal cmp m m' = true. Proof. intros m m'; exact (@Raw.equal_1 elt (this m) (NoDup m) (this m') (NoDup m')). Qed. Lemma equal_2 : forall m m' cmp, equal cmp m m' = true -> Equivb cmp m m'. Proof. intros m m'; exact (@Raw.equal_2 elt (this m) (NoDup m) (this m') (NoDup m')). Qed. End Elt. Lemma map_1 : forall (elt elt':Type)(m: t elt)(x:key)(e:elt)(f:elt->elt'), MapsTo x e m -> MapsTo x (f e) (map f m). Proof. intros elt elt' m; exact (@Raw.map_1 elt elt' (this m)). Qed. Lemma map_2 : forall (elt elt':Type)(m: t elt)(x:key)(f:elt->elt'), In x (map f m) -> In x m. Proof. intros elt elt' m; exact (@Raw.map_2 elt elt' (this m)). Qed. Lemma mapi_1 : forall (elt elt':Type)(m: t elt)(x:key)(e:elt) (f:key->elt->elt'), MapsTo x e m -> exists y, E.eq y x /\ MapsTo x (f y e) (mapi f m). Proof. intros elt elt' m; exact (@Raw.mapi_1 elt elt' (this m)). Qed. Lemma mapi_2 : forall (elt elt':Type)(m: t elt)(x:key) (f:key->elt->elt'), In x (mapi f m) -> In x m. Proof. intros elt elt' m; exact (@Raw.mapi_2 elt elt' (this m)). Qed. Lemma map2_1 : forall (elt elt' elt'':Type)(m: t elt)(m': t elt') (x:key)(f:option elt->option elt'->option elt''), In x m \/ In x m' -> find x (map2 f m m') = f (find x m) (find x m'). Proof. intros elt elt' elt'' m m' x f; exact (@Raw.map2_1 elt elt' elt'' f (this m) (NoDup m) (this m') (NoDup m') x). Qed. Lemma map2_2 : forall (elt elt' elt'':Type)(m: t elt)(m': t elt') (x:key)(f:option elt->option elt'->option elt''), In x (map2 f m m') -> In x m \/ In x m'. Proof. intros elt elt' elt'' m m' x f; exact (@Raw.map2_2 elt elt' elt'' f (this m) (NoDup m) (this m') (NoDup m') x). Qed. End Make. coq-8.20.0/theories/FSets/FMaps.v000066400000000000000000000016271466560755400164560ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* E.eq x y \/ In y s. Definition add : forall (x : elt) (s : t), {s' : t | Add x s s'}. Proof. intros; exists (add x s); auto. unfold Add; intuition. elim (E.eq_dec x y); auto. intros; right. eapply add_3; eauto. Qed. Definition singleton : forall x : elt, {s : t | forall y : elt, In y s <-> E.eq x y}. Proof. intros; exists (singleton x); intuition. Qed. Definition remove : forall (x : elt) (s : t), {s' : t | forall y : elt, In y s' <-> ~ E.eq x y /\ In y s}. Proof. intros; exists (remove x s); intuition. - absurd (In x (remove x s)); auto with set ordered_type. apply In_1 with y; auto with ordered_type. - elim (E.eq_dec x y); intros; auto. + absurd (In x (remove x s)); auto with set ordered_type. apply In_1 with y; auto with ordered_type. + eauto with set. Qed. Definition union : forall s s' : t, {s'' : t | forall x : elt, In x s'' <-> In x s \/ In x s'}. Proof. intros; exists (union s s'); intuition. Qed. Definition inter : forall s s' : t, {s'' : t | forall x : elt, In x s'' <-> In x s /\ In x s'}. Proof. intros; exists (inter s s'); intuition; eauto with set. Qed. Definition diff : forall s s' : t, {s'' : t | forall x : elt, In x s'' <-> In x s /\ ~ In x s'}. Proof. intros; exists (diff s s'); intuition; eauto with set. absurd (In x s'); eauto with set. Qed. Definition equal : forall s s' : t, {Equal s s'} + {~ Equal s s'}. Proof. intros. generalize (equal_1 (s:=s) (s':=s')) (equal_2 (s:=s) (s':=s')). case (equal s s'); intuition. Qed. Definition subset : forall s s' : t, {Subset s s'} + {~Subset s s'}. Proof. intros. generalize (subset_1 (s:=s) (s':=s')) (subset_2 (s:=s) (s':=s')). case (subset s s'); intuition. Qed. Definition elements : forall s : t, {l : list elt | sort E.lt l /\ (forall x : elt, In x s <-> InA E.eq x l)}. Proof. intros; exists (elements s); intuition. Defined. Definition fold : forall (A : Type) (f : elt -> A -> A) (s : t) (i : A), {r : A | let (l,_) := elements s in r = fold_left (fun a e => f e a) l i}. Proof. intros; exists (fold (A:=A) f s i); exact (fold_1 s i f). Qed. Definition cardinal : forall s : t, {r : nat | let (l,_) := elements s in r = length l }. Proof. intros; exists (cardinal s); exact (cardinal_1 s). Qed. Definition fdec (P : elt -> Prop) (Pdec : forall x : elt, {P x} + {~ P x}) (x : elt) := if Pdec x then true else false. Lemma compat_P_aux : forall (P : elt -> Prop) (Pdec : forall x : elt, {P x} + {~ P x}), compat_P E.eq P -> compat_bool E.eq (fdec Pdec). Proof. unfold compat_P, compat_bool, Proper, respectful, fdec; intros. generalize (E.eq_sym H0); case (Pdec x); case (Pdec y); firstorder. Qed. #[global] Hint Resolve compat_P_aux : core. Definition filter : forall (P : elt -> Prop) (Pdec : forall x : elt, {P x} + {~ P x}) (s : t), {s' : t | compat_P E.eq P -> forall x : elt, In x s' <-> In x s /\ P x}. Proof. intros. exists (filter (fdec Pdec) s). intro H; assert (compat_bool E.eq (fdec Pdec)); auto. intuition. - eauto with set. - generalize (filter_2 H0 H1). unfold fdec. case (Pdec x); intuition. inversion H2. - apply filter_3; auto. unfold fdec; simpl. case (Pdec x); intuition. Qed. Definition for_all : forall (P : elt -> Prop) (Pdec : forall x : elt, {P x} + {~ P x}) (s : t), {compat_P E.eq P -> For_all P s} + {compat_P E.eq P -> ~ For_all P s}. Proof. intros. generalize (for_all_1 (s:=s) (f:=fdec Pdec)) (for_all_2 (s:=s) (f:=fdec Pdec)). case (for_all (fdec Pdec) s); unfold For_all; [ left | right ]; intros. - assert (compat_bool E.eq (fdec Pdec)); auto. generalize (H0 H3 Logic.eq_refl _ H2). unfold fdec. case (Pdec x); intuition. inversion H4. - intuition. absurd (false = true); [ auto with bool | apply H; auto ]. intro. unfold fdec. case (Pdec x); intuition. Qed. Definition exists_ : forall (P : elt -> Prop) (Pdec : forall x : elt, {P x} + {~ P x}) (s : t), {compat_P E.eq P -> Exists P s} + {compat_P E.eq P -> ~ Exists P s}. Proof. intros. generalize (exists_1 (s:=s) (f:=fdec Pdec)) (exists_2 (s:=s) (f:=fdec Pdec)). case (exists_ (fdec Pdec) s); unfold Exists; [ left | right ]; intros. - elim H0; auto; intros. exists x; intuition. generalize H4. unfold fdec. case (Pdec x); intuition. inversion H2. - intuition. elim H2; intros. absurd (false = true); [ auto with bool | apply H; auto ]. exists x; intuition. unfold fdec. case (Pdec x); intuition. Qed. Definition partition : forall (P : elt -> Prop) (Pdec : forall x : elt, {P x} + {~ P x}) (s : t), {partition : t * t | let (s1, s2) := partition in compat_P E.eq P -> For_all P s1 /\ For_all (fun x => ~ P x) s2 /\ (forall x : elt, In x s <-> In x s1 \/ In x s2)}. Proof. intros. exists (partition (fdec Pdec) s). generalize (partition_1 s (f:=fdec Pdec)) (partition_2 s (f:=fdec Pdec)). case (partition (fdec Pdec) s). intros s1 s2; simpl. intros; assert (compat_bool E.eq (fdec Pdec)); auto. intros; assert (compat_bool E.eq (fun x => negb (fdec Pdec x))). { generalize H2; unfold compat_bool, Proper, respectful; intuition; apply (f_equal negb); auto. } intuition. - generalize H4; unfold For_all, Equal; intuition. elim (H0 x); intros. assert (fdec Pdec x = true). { eapply filter_2; eauto with set. } generalize H8; unfold fdec; case (Pdec x); intuition. inversion H9. - generalize H; unfold For_all, Equal; intuition. elim (H0 x); intros. cut ((fun x => negb (fdec Pdec x)) x = true). { unfold fdec; case (Pdec x); intuition. } change ((fun x => negb (fdec Pdec x)) x = true). apply (filter_2 (s:=s) (x:=x)); auto. - set (b := fdec Pdec x) in *; generalize (Logic.eq_refl b); pattern b at -1; case b; unfold b; [ left | right ]. + elim (H4 x); intros _ B; apply B; auto with set. + elim (H x); intros _ B; apply B; auto with set. apply filter_3; auto. rewrite H5; auto. - eapply (filter_1 (s:=s) (x:=x) H2); elim (H4 x); intros B _; apply B; auto. - eapply (filter_1 (s:=s) (x:=x) H3); elim (H x); intros B _; apply B; auto. Qed. Definition choose_aux: forall s : t, { x : elt | M.choose s = Some x } + { M.choose s = None }. Proof. intros. destruct (M.choose s); [left | right]; auto. exists e; auto. Qed. Definition choose : forall s : t, {x : elt | In x s} + {Empty s}. Proof. intros; destruct (choose_aux s) as [(x,Hx)|H]. - left; exists x; apply choose_1; auto. - right; apply choose_2; auto. Defined. Lemma choose_ok1 : forall s x, M.choose s = Some x <-> exists H:In x s, choose s = inleft _ (exist (fun x => In x s) x H). Proof. intros s x. unfold choose; split; intros. - destruct (choose_aux s) as [(y,Hy)|H']; try congruence. replace x with y in * by congruence. exists (choose_1 Hy); auto. - destruct H. destruct (choose_aux s) as [(y,Hy)|H']; congruence. Qed. Lemma choose_ok2 : forall s, M.choose s = None <-> exists H:Empty s, choose s = inright _ H. Proof. intros s. unfold choose; split; intros. - destruct (choose_aux s) as [(y,Hy)|H']; try congruence. exists (choose_2 H'); auto. - destruct H. destruct (choose_aux s) as [(y,Hy)|H']; congruence. Qed. Lemma choose_equal : forall s s', Equal s s' -> match choose s, choose s' with | inleft (exist _ x _), inleft (exist _ x' _) => E.eq x x' | inright _, inright _ => True | _, _ => False end. Proof. intros. generalize (@M.choose_1 s)(@M.choose_2 s) (@M.choose_1 s')(@M.choose_2 s')(@M.choose_3 s s') (choose_ok1 s)(choose_ok2 s)(choose_ok1 s')(choose_ok2 s'). destruct (choose s) as [(x,Hx)|Hx]; destruct (choose s') as [(x',Hx')|Hx']; auto; intros. - apply H4; auto. + rewrite H5; exists Hx; auto. + rewrite H7; exists Hx'; auto. - apply Hx' with x; unfold Equal in H; rewrite <-H; auto. - apply Hx with x'; unfold Equal in H; rewrite H; auto. Qed. Definition min_elt : forall s : t, {x : elt | In x s /\ For_all (fun y => ~ E.lt y x) s} + {Empty s}. Proof. intros; generalize (min_elt_1 (s:=s)) (min_elt_2 (s:=s)) (min_elt_3 (s:=s)). case (min_elt s); [ left | right ]; auto. exists e; unfold For_all; eauto. Qed. Definition max_elt : forall s : t, {x : elt | In x s /\ For_all (fun y => ~ E.lt x y) s} + {Empty s}. Proof. intros; generalize (max_elt_1 (s:=s)) (max_elt_2 (s:=s)) (max_elt_3 (s:=s)). case (max_elt s); [ left | right ]; auto. exists e; unfold For_all; eauto. Qed. Definition elt := elt. Definition t := t. Definition In := In. Definition Equal s s' := forall a : elt, In a s <-> In a s'. Definition Subset s s' := forall a : elt, In a s -> In a s'. Definition Empty s := forall a : elt, ~ In a s. Definition For_all (P : elt -> Prop) (s : t) := forall x : elt, In x s -> P x. Definition Exists (P : elt -> Prop) (s : t) := exists x : elt, In x s /\ P x. Definition eq_In := In_1. Definition eq := Equal. Definition lt := lt. Definition eq_refl := eq_refl. Definition eq_sym := eq_sym. Definition eq_trans := eq_trans. Definition lt_trans := lt_trans. Definition lt_not_eq := lt_not_eq. Definition compare := compare. Module E := E. End DepOfNodep. (** * From dependent signature [Sdep] to non-dependent signature [S]. *) Module NodepOfDep (M: Sdep) <: S with Module E := M.E. Import M. Module ME := OrderedTypeFacts E. Definition empty : t := let (s, _) := empty in s. Lemma empty_1 : Empty empty. Proof. unfold empty; case M.empty; auto. Qed. Definition is_empty (s : t) : bool := if is_empty s then true else false. Lemma is_empty_1 : forall s : t, Empty s -> is_empty s = true. Proof. intros; unfold is_empty; case (M.is_empty s); auto. Qed. Lemma is_empty_2 : forall s : t, is_empty s = true -> Empty s. Proof. intro s; unfold is_empty; case (M.is_empty s); auto. intros; discriminate H. Qed. Definition mem (x : elt) (s : t) : bool := if mem x s then true else false. Lemma mem_1 : forall (s : t) (x : elt), In x s -> mem x s = true. Proof. intros; unfold mem; case (M.mem x s); auto. Qed. Lemma mem_2 : forall (s : t) (x : elt), mem x s = true -> In x s. Proof. intros s x; unfold mem; case (M.mem x s); auto. intros; discriminate H. Qed. Definition eq_dec := equal. Definition equal (s s' : t) : bool := if equal s s' then true else false. Lemma equal_1 : forall s s' : t, Equal s s' -> equal s s' = true. Proof. intros; unfold equal; case M.equal; intuition. Qed. Lemma equal_2 : forall s s' : t, equal s s' = true -> Equal s s'. Proof. intros s s'; unfold equal; case (M.equal s s'); intuition; inversion H. Qed. Definition subset (s s' : t) : bool := if subset s s' then true else false. Lemma subset_1 : forall s s' : t, Subset s s' -> subset s s' = true. Proof. intros; unfold subset; case M.subset; intuition. Qed. Lemma subset_2 : forall s s' : t, subset s s' = true -> Subset s s'. Proof. intros s s'; unfold subset; case (M.subset s s'); intuition; inversion H. Qed. Definition choose (s : t) : option elt := match choose s with | inleft (exist _ x _) => Some x | inright _ => None end. Lemma choose_1 : forall (s : t) (x : elt), choose s = Some x -> In x s. Proof. intros s x; unfold choose; case (M.choose s). - simple destruct s0; intros; injection H; intros; subst; auto. - intros; discriminate H. Qed. Lemma choose_2 : forall s : t, choose s = None -> Empty s. Proof. intro s; unfold choose; case (M.choose s); auto. simple destruct s0; intros; discriminate H. Qed. Lemma choose_3 : forall s s' x x', choose s = Some x -> choose s' = Some x' -> Equal s s' -> E.eq x x'. Proof. unfold choose; intros. generalize (M.choose_equal H1); clear H1. destruct (M.choose s) as [(?,?)|?]; destruct (M.choose s') as [(?,?)|?]; simpl; auto; congruence. Qed. Definition elements (s : t) : list elt := let (l, _) := elements s in l. Lemma elements_1 : forall (s : t) (x : elt), In x s -> InA E.eq x (elements s). Proof. intros; unfold elements; case (M.elements s); firstorder. Qed. Lemma elements_2 : forall (s : t) (x : elt), InA E.eq x (elements s) -> In x s. Proof. intros s x; unfold elements; case (M.elements s); firstorder. Qed. Lemma elements_3 : forall s : t, sort E.lt (elements s). Proof. intros; unfold elements; case (M.elements s); firstorder. Qed. #[global] Hint Resolve elements_3 : core. Lemma elements_3w : forall s : t, NoDupA E.eq (elements s). Proof. auto with ordered_type. Qed. Definition min_elt (s : t) : option elt := match min_elt s with | inleft (exist _ x _) => Some x | inright _ => None end. Lemma min_elt_1 : forall (s : t) (x : elt), min_elt s = Some x -> In x s. Proof. intros s x; unfold min_elt; case (M.min_elt s). - simple destruct s0; intros; injection H; intros; subst; intuition. - intros; discriminate H. Qed. Lemma min_elt_2 : forall (s : t) (x y : elt), min_elt s = Some x -> In y s -> ~ E.lt y x. Proof. intros s x y; unfold min_elt; case (M.min_elt s). - unfold For_all; simple destruct s0; intros; injection H; intros; subst; firstorder. - intros; discriminate H. Qed. Lemma min_elt_3 : forall s : t, min_elt s = None -> Empty s. Proof. intros s; unfold min_elt; case (M.min_elt s); auto. simple destruct s0; intros; discriminate H. Qed. Definition max_elt (s : t) : option elt := match max_elt s with | inleft (exist _ x _) => Some x | inright _ => None end. Lemma max_elt_1 : forall (s : t) (x : elt), max_elt s = Some x -> In x s. Proof. intros s x; unfold max_elt; case (M.max_elt s). - simple destruct s0; intros; injection H; intros; subst; intuition. - intros; discriminate H. Qed. Lemma max_elt_2 : forall (s : t) (x y : elt), max_elt s = Some x -> In y s -> ~ E.lt x y. Proof. intros s x y; unfold max_elt; case (M.max_elt s). - unfold For_all; simple destruct s0; intros; injection H; intros; subst; firstorder. - intros; discriminate H. Qed. Lemma max_elt_3 : forall s : t, max_elt s = None -> Empty s. Proof. intros s; unfold max_elt; case (M.max_elt s); auto. simple destruct s0; intros; discriminate H. Qed. Definition add (x : elt) (s : t) : t := let (s', _) := add x s in s'. Lemma add_1 : forall (s : t) (x y : elt), E.eq x y -> In y (add x s). Proof. intros; unfold add; case (M.add x s); unfold Add; firstorder. Qed. Lemma add_2 : forall (s : t) (x y : elt), In y s -> In y (add x s). Proof. intros; unfold add; case (M.add x s); unfold Add; firstorder. Qed. Lemma add_3 : forall (s : t) (x y : elt), ~ E.eq x y -> In y (add x s) -> In y s. Proof. intros s x y; unfold add; case (M.add x s); unfold Add; firstorder. Qed. Definition remove (x : elt) (s : t) : t := let (s', _) := remove x s in s'. Lemma remove_1 : forall (s : t) (x y : elt), E.eq x y -> ~ In y (remove x s). Proof. intros; unfold remove; case (M.remove x s); firstorder. Qed. Lemma remove_2 : forall (s : t) (x y : elt), ~ E.eq x y -> In y s -> In y (remove x s). Proof. intros; unfold remove; case (M.remove x s); firstorder. Qed. Lemma remove_3 : forall (s : t) (x y : elt), In y (remove x s) -> In y s. Proof. intros s x y; unfold remove; case (M.remove x s); firstorder. Qed. Definition singleton (x : elt) : t := let (s, _) := singleton x in s. Lemma singleton_1 : forall x y : elt, In y (singleton x) -> E.eq x y. Proof. intros x y; unfold singleton; case (M.singleton x); firstorder. Qed. Lemma singleton_2 : forall x y : elt, E.eq x y -> In y (singleton x). Proof. intros x y; unfold singleton; case (M.singleton x); firstorder. Qed. Definition union (s s' : t) : t := let (s'', _) := union s s' in s''. Lemma union_1 : forall (s s' : t) (x : elt), In x (union s s') -> In x s \/ In x s'. Proof. intros s s' x; unfold union; case (M.union s s'); firstorder. Qed. Lemma union_2 : forall (s s' : t) (x : elt), In x s -> In x (union s s'). Proof. intros s s' x; unfold union; case (M.union s s'); firstorder. Qed. Lemma union_3 : forall (s s' : t) (x : elt), In x s' -> In x (union s s'). Proof. intros s s' x; unfold union; case (M.union s s'); firstorder. Qed. Definition inter (s s' : t) : t := let (s'', _) := inter s s' in s''. Lemma inter_1 : forall (s s' : t) (x : elt), In x (inter s s') -> In x s. Proof. intros s s' x; unfold inter; case (M.inter s s'); firstorder. Qed. Lemma inter_2 : forall (s s' : t) (x : elt), In x (inter s s') -> In x s'. Proof. intros s s' x; unfold inter; case (M.inter s s'); firstorder. Qed. Lemma inter_3 : forall (s s' : t) (x : elt), In x s -> In x s' -> In x (inter s s'). Proof. intros s s' x; unfold inter; case (M.inter s s'); firstorder. Qed. Definition diff (s s' : t) : t := let (s'', _) := diff s s' in s''. Lemma diff_1 : forall (s s' : t) (x : elt), In x (diff s s') -> In x s. Proof. intros s s' x; unfold diff; case (M.diff s s'); firstorder. Qed. Lemma diff_2 : forall (s s' : t) (x : elt), In x (diff s s') -> ~ In x s'. Proof. intros s s' x; unfold diff; case (M.diff s s'); firstorder. Qed. Lemma diff_3 : forall (s s' : t) (x : elt), In x s -> ~ In x s' -> In x (diff s s'). Proof. intros s s' x; unfold diff; case (M.diff s s'); firstorder. Qed. Definition cardinal (s : t) : nat := let (f, _) := cardinal s in f. Lemma cardinal_1 : forall s, cardinal s = length (elements s). Proof. intros; unfold cardinal; case (M.cardinal s); unfold elements in *; destruct (M.elements s); auto. Qed. Definition fold (B : Type) (f : elt -> B -> B) (i : t) (s : B) : B := let (fold, _) := fold f i s in fold. Lemma fold_1 : forall (s : t) (A : Type) (i : A) (f : elt -> A -> A), fold f s i = fold_left (fun a e => f e a) (elements s) i. Proof. intros; unfold fold; case (M.fold f s i); unfold elements in *; destruct (M.elements s); auto. Qed. Definition f_dec : forall (f : elt -> bool) (x : elt), {f x = true} + {f x <> true}. Proof. intros; case (f x); auto with bool. Defined. Lemma compat_P_aux : forall f : elt -> bool, compat_bool E.eq f -> compat_P E.eq (fun x => f x = true). Proof. unfold compat_bool, compat_P, Proper, respectful, impl; intros; rewrite <- H1; firstorder. Qed. #[global] Hint Resolve compat_P_aux : core. Definition filter (f : elt -> bool) (s : t) : t := let (s', _) := filter (P:=fun x => f x = true) (f_dec f) s in s'. Lemma filter_1 : forall (s : t) (x : elt) (f : elt -> bool), compat_bool E.eq f -> In x (filter f s) -> In x s. Proof. intros s x f; unfold filter; case M.filter as (x0,Hiff); intuition. generalize (Hiff (compat_P_aux H)); firstorder. Qed. Lemma filter_2 : forall (s : t) (x : elt) (f : elt -> bool), compat_bool E.eq f -> In x (filter f s) -> f x = true. Proof. intros s x f; unfold filter; case M.filter as (x0,Hiff); intuition. generalize (Hiff (compat_P_aux H)); firstorder. Qed. Lemma filter_3 : forall (s : t) (x : elt) (f : elt -> bool), compat_bool E.eq f -> In x s -> f x = true -> In x (filter f s). Proof. intros s x f; unfold filter; case M.filter as (x0,Hiff); intuition. generalize (Hiff (compat_P_aux H)); firstorder. Qed. Definition for_all (f : elt -> bool) (s : t) : bool := if for_all (P:=fun x => f x = true) (f_dec f) s then true else false. Lemma for_all_1 : forall (s : t) (f : elt -> bool), compat_bool E.eq f -> For_all (fun x => f x = true) s -> for_all f s = true. Proof. intros s f; unfold for_all; case M.for_all; intuition; elim n; auto. Qed. Lemma for_all_2 : forall (s : t) (f : elt -> bool), compat_bool E.eq f -> for_all f s = true -> For_all (fun x => f x = true) s. Proof. intros s f; unfold for_all; case M.for_all; intuition; inversion H0. Qed. Definition exists_ (f : elt -> bool) (s : t) : bool := if exists_ (P:=fun x => f x = true) (f_dec f) s then true else false. Lemma exists_1 : forall (s : t) (f : elt -> bool), compat_bool E.eq f -> Exists (fun x => f x = true) s -> exists_ f s = true. Proof. intros s f; unfold exists_; case M.exists_; intuition; elim n; auto. Qed. Lemma exists_2 : forall (s : t) (f : elt -> bool), compat_bool E.eq f -> exists_ f s = true -> Exists (fun x => f x = true) s. Proof. intros s f; unfold exists_; case M.exists_; intuition; inversion H0. Qed. Definition partition (f : elt -> bool) (s : t) : t * t := let (p, _) := partition (P:=fun x => f x = true) (f_dec f) s in p. Lemma partition_1 : forall (s : t) (f : elt -> bool), compat_bool E.eq f -> Equal (fst (partition f s)) (filter f s). Proof. intros s f; unfold partition; case M.partition. intro p; case p; clear p; intros s1 s2 H C. generalize (H (compat_P_aux C)); clear H; intro H. simpl; unfold Equal; intuition. - apply filter_3; firstorder. - elim (H2 a); intros. assert (In a s). + eapply filter_1; eauto. + elim H3; intros; auto. absurd (f a = true). * exact (H a H6). * eapply filter_2; eauto. Qed. Lemma partition_2 : forall (s : t) (f : elt -> bool), compat_bool E.eq f -> Equal (snd (partition f s)) (filter (fun x => negb (f x)) s). Proof. intros s f; unfold partition; case M.partition. intro p; case p; clear p; intros s1 s2 H C. generalize (H (compat_P_aux C)); clear H; intro H. assert (D : compat_bool E.eq (fun x => negb (f x))). { generalize C; unfold compat_bool, Proper, respectful; intros; apply (f_equal negb); auto. } simpl; unfold Equal; intuition. - apply filter_3; firstorder with bool. - elim (H2 a); intros. assert (In a s). { eapply filter_1; eauto. } elim H3; intros; auto. absurd (f a = true). + intro. generalize (filter_2 D H1). rewrite H7; intros H8; inversion H8. + exact (H0 a H6). Qed. Definition elt := elt. Definition t := t. Definition In := In. Definition Equal s s' := forall a : elt, In a s <-> In a s'. Definition Subset s s' := forall a : elt, In a s -> In a s'. Definition Add (x : elt) (s s' : t) := forall y : elt, In y s' <-> E.eq y x \/ In y s. Definition Empty s := forall a : elt, ~ In a s. Definition For_all (P : elt -> Prop) (s : t) := forall x : elt, In x s -> P x. Definition Exists (P : elt -> Prop) (s : t) := exists x : elt, In x s /\ P x. Definition In_1 := eq_In. Definition eq := Equal. Definition lt := lt. Definition eq_refl := eq_refl. Definition eq_sym := eq_sym. Definition eq_trans := eq_trans. Definition lt_trans := lt_trans. Definition lt_not_eq := lt_not_eq. Definition compare := compare. Module E := E. End NodepOfDep. coq-8.20.0/theories/FSets/FSetCompat.v000066400000000000000000000367231466560755400174620ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* bool. Definition In : elt -> t -> Prop := M.In. Definition Equal s s' := forall a : elt, In a s <-> In a s'. Definition Subset s s' := forall a : elt, In a s -> In a s'. Definition Empty s := forall a : elt, ~ In a s. Definition For_all (P : elt -> Prop) s := forall x, In x s -> P x. Definition Exists (P : elt -> Prop) s := exists x, In x s /\ P x. Definition empty : t := M.empty. Definition is_empty : t -> bool := M.is_empty. Definition mem : elt -> t -> bool := M.mem. Definition add : elt -> t -> t := M.add. Definition singleton : elt -> t := M.singleton. Definition remove : elt -> t -> t := M.remove. Definition union : t -> t -> t := M.union. Definition inter : t -> t -> t := M.inter. Definition diff : t -> t -> t := M.diff. Definition eq : t -> t -> Prop := M.eq. Definition eq_dec : forall s s', {eq s s'}+{~eq s s'}:= M.eq_dec. Definition equal : t -> t -> bool := M.equal. Definition subset : t -> t -> bool := M.subset. Definition fold : forall A : Type, (elt -> A -> A) -> t -> A -> A := M.fold. Definition for_all : (elt -> bool) -> t -> bool := M.for_all. Definition exists_ : (elt -> bool) -> t -> bool := M.exists_. Definition filter : (elt -> bool) -> t -> t := M.filter. Definition partition : (elt -> bool) -> t -> t * t:= M.partition. Definition cardinal : t -> nat := M.cardinal. Definition elements : t -> list elt := M.elements. Definition choose : t -> option elt := M.choose. Module MF := MSetFacts.WFacts M. Definition In_1 : forall s x y, E.eq x y -> In x s -> In y s := MF.In_1. Definition eq_refl : forall s, eq s s := @Equivalence_Reflexive _ _ M.eq_equiv. Definition eq_sym : forall s s', eq s s' -> eq s' s := @Equivalence_Symmetric _ _ M.eq_equiv. Definition eq_trans : forall s s' s'', eq s s' -> eq s' s'' -> eq s s'' := @Equivalence_Transitive _ _ M.eq_equiv. Definition mem_1 : forall s x, In x s -> mem x s = true := MF.mem_1. Definition mem_2 : forall s x, mem x s = true -> In x s := MF.mem_2. Definition equal_1 : forall s s', Equal s s' -> equal s s' = true := MF.equal_1. Definition equal_2 : forall s s', equal s s' = true -> Equal s s' := MF.equal_2. Definition subset_1 : forall s s', Subset s s' -> subset s s' = true := MF.subset_1. Definition subset_2 : forall s s', subset s s' = true -> Subset s s' := MF.subset_2. Definition empty_1 : Empty empty := MF.empty_1. Definition is_empty_1 : forall s, Empty s -> is_empty s = true := MF.is_empty_1. Definition is_empty_2 : forall s, is_empty s = true -> Empty s := MF.is_empty_2. Definition add_1 : forall s x y, E.eq x y -> In y (add x s) := MF.add_1. Definition add_2 : forall s x y, In y s -> In y (add x s) := MF.add_2. Definition add_3 : forall s x y, ~ E.eq x y -> In y (add x s) -> In y s := MF.add_3. Definition remove_1 : forall s x y, E.eq x y -> ~ In y (remove x s) := MF.remove_1. Definition remove_2 : forall s x y, ~ E.eq x y -> In y s -> In y (remove x s) := MF.remove_2. Definition remove_3 : forall s x y, In y (remove x s) -> In y s := MF.remove_3. Definition union_1 : forall s s' x, In x (union s s') -> In x s \/ In x s' := MF.union_1. Definition union_2 : forall s s' x, In x s -> In x (union s s') := MF.union_2. Definition union_3 : forall s s' x, In x s' -> In x (union s s') := MF.union_3. Definition inter_1 : forall s s' x, In x (inter s s') -> In x s := MF.inter_1. Definition inter_2 : forall s s' x, In x (inter s s') -> In x s' := MF.inter_2. Definition inter_3 : forall s s' x, In x s -> In x s' -> In x (inter s s') := MF.inter_3. Definition diff_1 : forall s s' x, In x (diff s s') -> In x s := MF.diff_1. Definition diff_2 : forall s s' x, In x (diff s s') -> ~ In x s' := MF.diff_2. Definition diff_3 : forall s s' x, In x s -> ~ In x s' -> In x (diff s s') := MF.diff_3. Definition singleton_1 : forall x y, In y (singleton x) -> E.eq x y := MF.singleton_1. Definition singleton_2 : forall x y, E.eq x y -> In y (singleton x) := MF.singleton_2. Definition fold_1 : forall s (A : Type) (i : A) (f : elt -> A -> A), fold f s i = fold_left (fun a e => f e a) (elements s) i := MF.fold_1. Definition cardinal_1 : forall s, cardinal s = length (elements s) := MF.cardinal_1. Definition filter_1 : forall s x f, compat_bool E.eq f -> In x (filter f s) -> In x s := MF.filter_1. Definition filter_2 : forall s x f, compat_bool E.eq f -> In x (filter f s) -> f x = true := MF.filter_2. Definition filter_3 : forall s x f, compat_bool E.eq f -> In x s -> f x = true -> In x (filter f s) := MF.filter_3. Definition for_all_1 : forall s f, compat_bool E.eq f -> For_all (fun x => f x = true) s -> for_all f s = true := MF.for_all_1. Definition for_all_2 : forall s f, compat_bool E.eq f -> for_all f s = true -> For_all (fun x => f x = true) s := MF.for_all_2. Definition exists_1 : forall s f, compat_bool E.eq f -> Exists (fun x => f x = true) s -> exists_ f s = true := MF.exists_1. Definition exists_2 : forall s f, compat_bool E.eq f -> exists_ f s = true -> Exists (fun x => f x = true) s := MF.exists_2. Definition partition_1 : forall s f, compat_bool E.eq f -> Equal (fst (partition f s)) (filter f s) := MF.partition_1. Definition partition_2 : forall s f, compat_bool E.eq f -> Equal (snd (partition f s)) (filter (fun x => negb (f x)) s) := MF.partition_2. Definition choose_1 : forall s x, choose s = Some x -> In x s := MF.choose_1. Definition choose_2 : forall s, choose s = None -> Empty s := MF.choose_2. Definition elements_1 : forall s x, In x s -> InA E.eq x (elements s) := MF.elements_1. Definition elements_2 : forall s x, InA E.eq x (elements s) -> In x s := MF.elements_2. Definition elements_3w : forall s, NoDupA E.eq (elements s) := MF.elements_3w. End Backport_WSets. (** * From new Sets to new ones *) Module Backport_Sets (O:OrderedType.OrderedType) (M:MSetInterface.Sets with Definition E.t := O.t with Definition E.eq := O.eq with Definition E.lt := O.lt) <: FSetInterface.S with Module E:=O. Include Backport_WSets O M. Implicit Type s : t. Implicit Type x y : elt. Definition lt : t -> t -> Prop := M.lt. Definition min_elt : t -> option elt := M.min_elt. Definition max_elt : t -> option elt := M.max_elt. Definition min_elt_1 : forall s x, min_elt s = Some x -> In x s := M.min_elt_spec1. Definition min_elt_2 : forall s x y, min_elt s = Some x -> In y s -> ~ O.lt y x := M.min_elt_spec2. Definition min_elt_3 : forall s, min_elt s = None -> Empty s := M.min_elt_spec3. Definition max_elt_1 : forall s x, max_elt s = Some x -> In x s := M.max_elt_spec1. Definition max_elt_2 : forall s x y, max_elt s = Some x -> In y s -> ~ O.lt x y := M.max_elt_spec2. Definition max_elt_3 : forall s, max_elt s = None -> Empty s := M.max_elt_spec3. Definition elements_3 : forall s, sort O.lt (elements s) := M.elements_spec2. Definition choose_3 : forall s s' x y, choose s = Some x -> choose s' = Some y -> Equal s s' -> O.eq x y := M.choose_spec3. Definition lt_trans : forall s s' s'', lt s s' -> lt s' s'' -> lt s s'' := @StrictOrder_Transitive _ _ M.lt_strorder. Lemma lt_not_eq : forall s s', lt s s' -> ~ eq s s'. Proof. unfold lt, eq. intros s s' Hlt Heq. rewrite Heq in Hlt. apply (StrictOrder_Irreflexive s'); auto. Qed. Definition compare : forall s s', Compare lt eq s s'. Proof. intros s s'; destruct (CompSpec2Type (M.compare_spec s s')); [ apply EQ | apply LT | apply GT ]; auto. Defined. Module E := O. End Backport_Sets. (** * From old Weak Sets to new ones. *) Module Update_WSets (E:Equalities.DecidableType) (M:FSetInterface.WS with Definition E.t := E.t with Definition E.eq := E.eq) <: MSetInterface.WSetsOn E. Definition elt := E.t. Definition t := M.t. Implicit Type s : t. Implicit Type x y : elt. Implicit Type f : elt -> bool. Definition In : elt -> t -> Prop := M.In. Definition Equal s s' := forall a : elt, In a s <-> In a s'. Definition Subset s s' := forall a : elt, In a s -> In a s'. Definition Empty s := forall a : elt, ~ In a s. Definition For_all (P : elt -> Prop) s := forall x, In x s -> P x. Definition Exists (P : elt -> Prop) s := exists x, In x s /\ P x. Definition empty : t := M.empty. Definition is_empty : t -> bool := M.is_empty. Definition mem : elt -> t -> bool := M.mem. Definition add : elt -> t -> t := M.add. Definition singleton : elt -> t := M.singleton. Definition remove : elt -> t -> t := M.remove. Definition union : t -> t -> t := M.union. Definition inter : t -> t -> t := M.inter. Definition diff : t -> t -> t := M.diff. Definition eq : t -> t -> Prop := M.eq. Definition eq_dec : forall s s', {eq s s'}+{~eq s s'}:= M.eq_dec. Definition equal : t -> t -> bool := M.equal. Definition subset : t -> t -> bool := M.subset. Definition fold : forall A : Type, (elt -> A -> A) -> t -> A -> A := M.fold. Definition for_all : (elt -> bool) -> t -> bool := M.for_all. Definition exists_ : (elt -> bool) -> t -> bool := M.exists_. Definition filter : (elt -> bool) -> t -> t := M.filter. Definition partition : (elt -> bool) -> t -> t * t:= M.partition. Definition cardinal : t -> nat := M.cardinal. Definition elements : t -> list elt := M.elements. Definition choose : t -> option elt := M.choose. Module MF := FSetFacts.WFacts M. #[global] Instance In_compat : Proper (E.eq==>Logic.eq==>iff) In. Proof. intros x x' Hx s s' Hs. subst. apply MF.In_eq_iff; auto. Qed. #[global] Instance eq_equiv : Equivalence eq := _. Section Spec. Variable s s': t. Variable x y : elt. Lemma mem_spec : mem x s = true <-> In x s. Proof. intros; symmetry; apply MF.mem_iff. Qed. Lemma equal_spec : equal s s' = true <-> Equal s s'. Proof. intros; symmetry; apply MF.equal_iff. Qed. Lemma subset_spec : subset s s' = true <-> Subset s s'. Proof. intros; symmetry; apply MF.subset_iff. Qed. Definition empty_spec : Empty empty := M.empty_1. Lemma is_empty_spec : is_empty s = true <-> Empty s. Proof. intros; symmetry; apply MF.is_empty_iff. Qed. Declare Equivalent Keys In M.In. Lemma add_spec : In y (add x s) <-> E.eq y x \/ In y s. Proof. intros. rewrite MF.add_iff. intuition. Qed. Lemma remove_spec : In y (remove x s) <-> In y s /\ ~E.eq y x. Proof. intros. rewrite MF.remove_iff. intuition. Qed. Lemma singleton_spec : In y (singleton x) <-> E.eq y x. Proof. intros; rewrite MF.singleton_iff. intuition. Qed. Definition union_spec : In x (union s s') <-> In x s \/ In x s' := @MF.union_iff s s' x. Definition inter_spec : In x (inter s s') <-> In x s /\ In x s' := @MF.inter_iff s s' x. Definition diff_spec : In x (diff s s') <-> In x s /\ ~In x s' := @MF.diff_iff s s' x. Definition fold_spec : forall (A : Type) (i : A) (f : elt -> A -> A), fold f s i = fold_left (flip f) (elements s) i := @M.fold_1 s. Definition cardinal_spec : cardinal s = length (elements s) := @M.cardinal_1 s. Lemma elements_spec1 : InA E.eq x (elements s) <-> In x s. Proof. intros; symmetry; apply MF.elements_iff. Qed. Definition elements_spec2w : NoDupA E.eq (elements s) := @M.elements_3w s. Definition choose_spec1 : choose s = Some x -> In x s := @M.choose_1 s x. Definition choose_spec2 : choose s = None -> Empty s := @M.choose_2 s. Definition filter_spec : forall f, Proper (E.eq==>Logic.eq) f -> (In x (filter f s) <-> In x s /\ f x = true) := @MF.filter_iff s x. Definition partition_spec1 : forall f, Proper (E.eq==>Logic.eq) f -> Equal (fst (partition f s)) (filter f s) := @M.partition_1 s. Definition partition_spec2 : forall f, Proper (E.eq==>Logic.eq) f -> Equal (snd (partition f s)) (filter (fun x => negb (f x)) s) := @M.partition_2 s. Lemma for_all_spec : forall f, Proper (E.eq==>Logic.eq) f -> (for_all f s = true <-> For_all (fun x => f x = true) s). Proof. intros; symmetry; apply MF.for_all_iff; auto. Qed. Lemma exists_spec : forall f, Proper (E.eq==>Logic.eq) f -> (exists_ f s = true <-> Exists (fun x => f x = true) s). Proof. intros; symmetry; apply MF.exists_iff; auto. Qed. End Spec. End Update_WSets. (** * From old Sets to new ones. *) Module Update_Sets (O:Orders.OrderedType) (M:FSetInterface.S with Definition E.t := O.t with Definition E.eq := O.eq with Definition E.lt := O.lt) <: MSetInterface.Sets with Module E:=O. Include Update_WSets O M. Implicit Type s : t. Implicit Type x y : elt. Definition lt : t -> t -> Prop := M.lt. Definition min_elt : t -> option elt := M.min_elt. Definition max_elt : t -> option elt := M.max_elt. Definition min_elt_spec1 : forall s x, min_elt s = Some x -> In x s := M.min_elt_1. Definition min_elt_spec2 : forall s x y, min_elt s = Some x -> In y s -> ~ O.lt y x := M.min_elt_2. Definition min_elt_spec3 : forall s, min_elt s = None -> Empty s := M.min_elt_3. Definition max_elt_spec1 : forall s x, max_elt s = Some x -> In x s := M.max_elt_1. Definition max_elt_spec2 : forall s x y, max_elt s = Some x -> In y s -> ~ O.lt x y := M.max_elt_2. Definition max_elt_spec3 : forall s, max_elt s = None -> Empty s := M.max_elt_3. Definition elements_spec2 : forall s, sort O.lt (elements s) := M.elements_3. Definition choose_spec3 : forall s s' x y, choose s = Some x -> choose s' = Some y -> Equal s s' -> O.eq x y := M.choose_3. #[global] Instance lt_strorder : StrictOrder lt. Proof. split. - intros x Hx. apply (M.lt_not_eq Hx). auto with crelations. - exact M.lt_trans. Qed. #[global] Instance lt_compat : Proper (eq==>eq==>iff) lt. Proof. apply proper_sym_impl_iff_2. 1-2: auto with crelations. intros s s' Hs u u' Hu H. assert (H0 : lt s' u). { destruct (M.compare s' u) as [H'|H'|H']; auto. - elim (M.lt_not_eq H). transitivity s'; auto. - elim (M.lt_not_eq (M.lt_trans H H')); auto. } destruct (M.compare s' u') as [H'|H'|H']; auto. - elim (M.lt_not_eq H). transitivity u'. 2: auto with crelations. transitivity s'; auto. - elim (M.lt_not_eq (M.lt_trans H' H0)); auto with crelations. Qed. Definition compare s s' := match M.compare s s' with | EQ _ => Eq | LT _ => Lt | GT _ => Gt end. Lemma compare_spec : forall s s', CompSpec eq lt s s' (compare s s'). Proof. intros; unfold compare; destruct M.compare; auto. Qed. Module E := O. End Update_Sets. coq-8.20.0/theories/FSets/FSetDecide.v000066400000000000000000000745211466560755400174120ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* ... -> Pk -> P >> where [P]'s are defined by the grammar: << P ::= | Q | Empty F | Subset F F' | Equal F F' Q ::= | E.eq X X' | In X F | Q /\ Q' | Q \/ Q' | Q -> Q' | Q <-> Q' | ~ Q | True | False F ::= | S | empty | singleton X | add X F | remove X F | union F F' | inter F F' | diff F F' X ::= x1 | ... | xm S ::= s1 | ... | sn >> The tactic will also work on some goals that vary slightly from the above form: - The variables and hypotheses may be mixed in any order and may have already been introduced into the context. Moreover, there may be additional, unrelated hypotheses mixed in (these will be ignored). - A conjunction of hypotheses will be handled as easily as separate hypotheses, i.e., [P1 /\ P2 -> P] can be solved iff [P1 -> P2 -> P] can be solved. - [fsetdec] should solve any goal if the FSet-related hypotheses are contradictory. - [fsetdec] will first perform any necessary zeta and beta reductions and will invoke [subst] to eliminate any Coq equalities between finite sets or their elements. - If [E.eq] is convertible with Coq's equality, it will not matter which one is used in the hypotheses or conclusion. - The tactic can solve goals where the finite sets or set elements are expressed by Coq terms that are more complicated than variables. However, non-local definitions are not expanded, and Coq equalities between non-variable terms are not used. For example, this goal will be solved: << forall (f : t -> t), forall (g : elt -> elt), forall (s1 s2 : t), forall (x1 x2 : elt), Equal s1 (f s2) -> E.eq x1 (g (g x2)) -> In x1 s1 -> In (g (g x2)) (f s2) >> This one will not be solved: << forall (f : t -> t), forall (g : elt -> elt), forall (s1 s2 : t), forall (x1 x2 : elt), Equal s1 (f s2) -> E.eq x1 (g x2) -> In x1 s1 -> g x2 = g (g x2) -> In (g (g x2)) (f s2) >> *) (** * Facts and Tactics for Propositional Logic These lemmas and tactics are in a module so that they do not affect the namespace if you import the enclosing module [Decide]. *) Module FSetLogicalFacts. Export Decidable. Export Setoid. (** ** Lemmas and Tactics About Decidable Propositions *) (** ** Propositional Equivalences Involving Negation These are all written with the unfolded form of negation, since I am not sure if setoid rewriting will always perform conversion. *) (** ** Tactics for Negations *) Tactic Notation "fold" "any" "not" := repeat ( match goal with | H: context [?P -> False] |- _ => fold (~ P) in H | |- context [?P -> False] => fold (~ P) end). (** [push not using db] will pushes all negations to the leaves of propositions in the goal, using the lemmas in [db] to assist in checking the decidability of the propositions involved. If [using db] is omitted, then [core] will be used. Additional versions are provided to manipulate the hypotheses or the hypotheses and goal together. XXX: This tactic and the similar subsequent ones should have been defined using [autorewrite]. However, dealing with multiples rewrite sites and side-conditions is done more cleverly with the following explicit analysis of goals. *) Ltac or_not_l_iff P Q tac := (rewrite (or_not_l_iff_1 P Q) by tac) || (rewrite (or_not_l_iff_2 P Q) by tac). Ltac or_not_r_iff P Q tac := (rewrite (or_not_r_iff_1 P Q) by tac) || (rewrite (or_not_r_iff_2 P Q) by tac). Ltac or_not_l_iff_in P Q H tac := (rewrite (or_not_l_iff_1 P Q) in H by tac) || (rewrite (or_not_l_iff_2 P Q) in H by tac). Ltac or_not_r_iff_in P Q H tac := (rewrite (or_not_r_iff_1 P Q) in H by tac) || (rewrite (or_not_r_iff_2 P Q) in H by tac). Tactic Notation "push" "not" "using" ident(db) := let dec := solve_decidable using db in unfold not, iff; repeat ( match goal with | |- context [True -> False] => rewrite not_true_iff | |- context [False -> False] => rewrite not_false_iff | |- context [(?P -> False) -> False] => rewrite (not_not_iff P) by dec | |- context [(?P -> False) -> (?Q -> False)] => rewrite (contrapositive P Q) by dec | |- context [(?P -> False) \/ ?Q] => or_not_l_iff P Q dec | |- context [?P \/ (?Q -> False)] => or_not_r_iff P Q dec | |- context [(?P -> False) -> ?Q] => rewrite (imp_not_l P Q) by dec | |- context [?P \/ ?Q -> False] => rewrite (not_or_iff P Q) | |- context [?P /\ ?Q -> False] => rewrite (not_and_iff P Q) | |- context [(?P -> ?Q) -> False] => rewrite (not_imp_iff P Q) by dec end); fold any not. Tactic Notation "push" "not" := push not using core. Tactic Notation "push" "not" "in" "*" "|-" "using" ident(db) := let dec := solve_decidable using db in unfold not, iff in * |-; repeat ( match goal with | H: context [True -> False] |- _ => rewrite not_true_iff in H | H: context [False -> False] |- _ => rewrite not_false_iff in H | H: context [(?P -> False) -> False] |- _ => rewrite (not_not_iff P) in H by dec | H: context [(?P -> False) -> (?Q -> False)] |- _ => rewrite (contrapositive P Q) in H by dec | H: context [(?P -> False) \/ ?Q] |- _ => or_not_l_iff_in P Q H dec | H: context [?P \/ (?Q -> False)] |- _ => or_not_r_iff_in P Q H dec | H: context [(?P -> False) -> ?Q] |- _ => rewrite (imp_not_l P Q) in H by dec | H: context [?P \/ ?Q -> False] |- _ => rewrite (not_or_iff P Q) in H | H: context [?P /\ ?Q -> False] |- _ => rewrite (not_and_iff P Q) in H | H: context [(?P -> ?Q) -> False] |- _ => rewrite (not_imp_iff P Q) in H by dec end); fold any not. Tactic Notation "push" "not" "in" "*" "|-" := push not in * |- using core. Tactic Notation "push" "not" "in" "*" "using" ident(db) := push not using db; push not in * |- using db. Tactic Notation "push" "not" "in" "*" := push not in * using core. (** A simple test case to see how this works. *) Lemma test_push : forall P Q R : Prop, decidable P -> decidable Q -> (~ True) -> (~ False) -> (~ ~ P) -> (~ (P /\ Q) -> ~ R) -> ((P /\ Q) \/ ~ R) -> (~ (P /\ Q) \/ R) -> (R \/ ~ (P /\ Q)) -> (~ R \/ (P /\ Q)) -> (~ P -> R) -> (~ ((R -> P) \/ (Q -> R))) -> (~ (P /\ R)) -> (~ (P -> R)) -> True. Proof. intros. push not in *. (* note that ~(R->P) remains (since R isn't decidable) *) tauto. Qed. (** [pull not using db] will pull as many negations as possible toward the top of the propositions in the goal, using the lemmas in [db] to assist in checking the decidability of the propositions involved. If [using db] is omitted, then [core] will be used. Additional versions are provided to manipulate the hypotheses or the hypotheses and goal together. *) Tactic Notation "pull" "not" "using" ident(db) := let dec := solve_decidable using db in unfold not, iff; repeat ( match goal with | |- context [True -> False] => rewrite not_true_iff | |- context [False -> False] => rewrite not_false_iff | |- context [(?P -> False) -> False] => rewrite (not_not_iff P) by dec | |- context [(?P -> False) -> (?Q -> False)] => rewrite (contrapositive P Q) by dec | |- context [(?P -> False) \/ ?Q] => or_not_l_iff P Q dec | |- context [?P \/ (?Q -> False)] => or_not_r_iff P Q dec | |- context [(?P -> False) -> ?Q] => rewrite (imp_not_l P Q) by dec | |- context [(?P -> False) /\ (?Q -> False)] => rewrite <- (not_or_iff P Q) | |- context [?P -> ?Q -> False] => rewrite <- (not_and_iff P Q) | |- context [?P /\ (?Q -> False)] => rewrite <- (not_imp_iff P Q) by dec | |- context [(?Q -> False) /\ ?P] => rewrite <- (not_imp_rev_iff P Q) by dec end); fold any not. Tactic Notation "pull" "not" := pull not using core. Tactic Notation "pull" "not" "in" "*" "|-" "using" ident(db) := let dec := solve_decidable using db in unfold not, iff in * |-; repeat ( match goal with | H: context [True -> False] |- _ => rewrite not_true_iff in H | H: context [False -> False] |- _ => rewrite not_false_iff in H | H: context [(?P -> False) -> False] |- _ => rewrite (not_not_iff P) in H by dec | H: context [(?P -> False) -> (?Q -> False)] |- _ => rewrite (contrapositive P Q) in H by dec | H: context [(?P -> False) \/ ?Q] |- _ => or_not_l_iff_in P Q H dec | H: context [?P \/ (?Q -> False)] |- _ => or_not_r_iff_in P Q H dec | H: context [(?P -> False) -> ?Q] |- _ => rewrite (imp_not_l P Q) in H by dec | H: context [(?P -> False) /\ (?Q -> False)] |- _ => rewrite <- (not_or_iff P Q) in H | H: context [?P -> ?Q -> False] |- _ => rewrite <- (not_and_iff P Q) in H | H: context [?P /\ (?Q -> False)] |- _ => rewrite <- (not_imp_iff P Q) in H by dec | H: context [(?Q -> False) /\ ?P] |- _ => rewrite <- (not_imp_rev_iff P Q) in H by dec end); fold any not. Tactic Notation "pull" "not" "in" "*" "|-" := pull not in * |- using core. Tactic Notation "pull" "not" "in" "*" "using" ident(db) := pull not using db; pull not in * |- using db. Tactic Notation "pull" "not" "in" "*" := pull not in * using core. (** A simple test case to see how this works. *) Lemma test_pull : forall P Q R : Prop, decidable P -> decidable Q -> (~ True) -> (~ False) -> (~ ~ P) -> (~ (P /\ Q) -> ~ R) -> ((P /\ Q) \/ ~ R) -> (~ (P /\ Q) \/ R) -> (R \/ ~ (P /\ Q)) -> (~ R \/ (P /\ Q)) -> (~ P -> R) -> (~ (R -> P) /\ ~ (Q -> R)) -> (~ P \/ ~ R) -> (P /\ ~ R) -> (~ R /\ P) -> True. Proof. intros. pull not in *. tauto. Qed. End FSetLogicalFacts. Import FSetLogicalFacts. (** * Auxiliary Tactics Again, these lemmas and tactics are in a module so that they do not affect the namespace if you import the enclosing module [Decide]. *) Module FSetDecideAuxiliary. (** ** Generic Tactics We begin by defining a few generic, useful tactics. *) (** remove logical hypothesis inter-dependencies (fix #2136). *) Ltac no_logical_interdep := match goal with | H : ?P |- _ => match type of P with | Prop => match goal with H' : context [ H ] |- _ => clear dependent H' end | _ => fail end; no_logical_interdep | _ => idtac end. Ltac abstract_term t := tryif (is_var t) then fail "no need to abstract a variable" else (let x := fresh "x" in set (x := t) in *; try clearbody x). Ltac abstract_elements := repeat (match goal with | |- context [ singleton ?t ] => abstract_term t | _ : context [ singleton ?t ] |- _ => abstract_term t | |- context [ add ?t _ ] => abstract_term t | _ : context [ add ?t _ ] |- _ => abstract_term t | |- context [ remove ?t _ ] => abstract_term t | _ : context [ remove ?t _ ] |- _ => abstract_term t | |- context [ In ?t _ ] => abstract_term t | _ : context [ In ?t _ ] |- _ => abstract_term t end). (** [prop P holds by t] succeeds (but does not modify the goal or context) if the proposition [P] can be proved by [t] in the current context. Otherwise, the tactic fails. *) Tactic Notation "prop" constr(P) "holds" "by" tactic(t) := let H := fresh in assert P as H by t; clear H. (** This tactic acts just like [assert ... by ...] but will fail if the context already contains the proposition. *) Tactic Notation "assert" "new" constr(e) "by" tactic(t) := match goal with | H: e |- _ => fail 1 | _ => assert e by t end. (** [subst++] is similar to [subst] except that - it never fails (as [subst] does on recursive equations), - it substitutes locally defined variable for their definitions, - it performs beta reductions everywhere, which may arise after substituting a locally defined function for its definition. *) Tactic Notation "subst" "++" := repeat ( match goal with | x : _ |- _ => subst x end); cbv zeta beta in *. (** [decompose records] calls [decompose record H] on every relevant hypothesis [H]. *) Tactic Notation "decompose" "records" := repeat ( match goal with | H: _ |- _ => progress (decompose record H); clear H end). (** ** Discarding Irrelevant Hypotheses We will want to clear the context of any non-FSet-related hypotheses in order to increase the speed of the tactic. To do this, we will need to be able to decide which are relevant. We do this by making a simple inductive definition classifying the propositions of interest. *) Inductive FSet_elt_Prop : Prop -> Prop := | eq_Prop : forall (S : Type) (x y : S), FSet_elt_Prop (x = y) | eq_elt_prop : forall x y, FSet_elt_Prop (E.eq x y) | In_elt_prop : forall x s, FSet_elt_Prop (In x s) | True_elt_prop : FSet_elt_Prop True | False_elt_prop : FSet_elt_Prop False | conj_elt_prop : forall P Q, FSet_elt_Prop P -> FSet_elt_Prop Q -> FSet_elt_Prop (P /\ Q) | disj_elt_prop : forall P Q, FSet_elt_Prop P -> FSet_elt_Prop Q -> FSet_elt_Prop (P \/ Q) | impl_elt_prop : forall P Q, FSet_elt_Prop P -> FSet_elt_Prop Q -> FSet_elt_Prop (P -> Q) | not_elt_prop : forall P, FSet_elt_Prop P -> FSet_elt_Prop (~ P). Inductive FSet_Prop : Prop -> Prop := | elt_FSet_Prop : forall P, FSet_elt_Prop P -> FSet_Prop P | Empty_FSet_Prop : forall s, FSet_Prop (Empty s) | Subset_FSet_Prop : forall s1 s2, FSet_Prop (Subset s1 s2) | Equal_FSet_Prop : forall s1 s2, FSet_Prop (Equal s1 s2). (** Here is the tactic that will throw away hypotheses that are not useful (for the intended scope of the [fsetdec] tactic). *) #[global] Hint Constructors FSet_elt_Prop FSet_Prop : FSet_Prop. Ltac discard_nonFSet := repeat ( match goal with | H : context [ @Logic.eq ?T ?x ?y ] |- _ => tryif (change T with E.t in H) then fail else tryif (change T with t in H) then fail else clear H | H : ?P |- _ => tryif prop (FSet_Prop P) holds by (auto 100 with FSet_Prop) then fail else clear H end). (** ** Turning Set Operators into Propositional Connectives The lemmas from [FSetFacts] will be used to break down set operations into propositional formulas built over the predicates [In] and [E.eq] applied only to variables. We are going to use them with [autorewrite]. *) Global Hint Rewrite F.empty_iff F.singleton_iff F.add_iff F.remove_iff F.union_iff F.inter_iff F.diff_iff : set_simpl. Lemma eq_refl_iff (x : E.t) : E.eq x x <-> True. Proof. now split. Qed. Global Hint Rewrite eq_refl_iff : set_eq_simpl. (** ** Decidability of FSet Propositions *) (** [In] is decidable. *) Lemma dec_In : forall x s, decidable (In x s). Proof. red; intros; generalize (F.mem_iff s x); case (mem x s); intuition auto with bool. Qed. (** [E.eq] is decidable. *) Lemma dec_eq : forall (x y : E.t), decidable (E.eq x y). Proof. red; intros x y; destruct (E.eq_dec x y); auto. Qed. (** The hint database [FSet_decidability] will be given to the [push_neg] tactic from the module [Negation]. *) #[global] Hint Resolve dec_In dec_eq : FSet_decidability. (** ** Normalizing Propositions About Equality We have to deal with the fact that [E.eq] may be convertible with Coq's equality. Thus, we will find the following tactics useful to replace one form with the other everywhere. *) (** The next tactic, [Logic_eq_to_E_eq], mentions the term [E.t]; thus, we must ensure that [E.t] is used in favor of any other convertible but syntactically distinct term. *) Ltac change_to_E_t := repeat ( match goal with | H : ?T |- _ => progress (change T with E.t in H); repeat ( match goal with | J : _ |- _ => progress (change T with E.t in J) | |- _ => progress (change T with E.t) end ) | H : forall x : ?T, _ |- _ => progress (change T with E.t in H); repeat ( match goal with | J : _ |- _ => progress (change T with E.t in J) | |- _ => progress (change T with E.t) end ) end). (** These two tactics take us from Coq's built-in equality to [E.eq] (and vice versa) when possible. *) Ltac Logic_eq_to_E_eq := repeat ( match goal with | H: _ |- _ => progress (change (@Logic.eq E.t) with E.eq in H) | |- _ => progress (change (@Logic.eq E.t) with E.eq) end). Ltac E_eq_to_Logic_eq := repeat ( match goal with | H: _ |- _ => progress (change E.eq with (@Logic.eq E.t) in H) | |- _ => progress (change E.eq with (@Logic.eq E.t)) end). (** This tactic works like the built-in tactic [subst], but at the level of set element equality (which may not be the convertible with Coq's equality). *) Ltac substFSet := repeat ( match goal with | H: E.eq ?x ?x |- _ => clear H | H: E.eq ?x ?y |- _ => rewrite H in *; clear H end); autorewrite with set_eq_simpl in *. (** ** Considering Decidability of Base Propositions This tactic adds assertions about the decidability of [E.eq] and [In] to the context. This is necessary for the completeness of the [fsetdec] tactic. However, in order to minimize the cost of proof search, we should be careful to not add more than we need. Once negations have been pushed to the leaves of the propositions, we only need to worry about decidability for those base propositions that appear in a negated form. *) Ltac assert_decidability := (** We actually don't want these rules to fire if the syntactic context in the patterns below is trivially empty, but we'll just do some clean-up at the afterward. *) repeat ( match goal with | H: context [~ E.eq ?x ?y] |- _ => assert new (E.eq x y \/ ~ E.eq x y) by (apply dec_eq) | H: context [~ In ?x ?s] |- _ => assert new (In x s \/ ~ In x s) by (apply dec_In) | |- context [~ E.eq ?x ?y] => assert new (E.eq x y \/ ~ E.eq x y) by (apply dec_eq) | |- context [~ In ?x ?s] => assert new (In x s \/ ~ In x s) by (apply dec_In) end); (** Now we eliminate the useless facts we added (because they would likely be very harmful to performance). *) repeat ( match goal with | _: ~ ?P, H : ?P \/ ~ ?P |- _ => clear H end). (** ** Handling [Empty], [Subset], and [Equal] This tactic instantiates universally quantified hypotheses (which arise from the unfolding of [Empty], [Subset], and [Equal]) for each of the set element expressions that is involved in some membership or equality fact. Then it throws away those hypotheses, which should no longer be needed. *) Ltac inst_FSet_hypotheses := repeat ( match goal with | H : forall a : E.t, _, _ : context [ In ?x _ ] |- _ => let P := type of (H x) in assert new P by (exact (H x)) | H : forall a : E.t, _ |- context [ In ?x _ ] => let P := type of (H x) in assert new P by (exact (H x)) | H : forall a : E.t, _, _ : context [ E.eq ?x _ ] |- _ => let P := type of (H x) in assert new P by (exact (H x)) | H : forall a : E.t, _ |- context [ E.eq ?x _ ] => let P := type of (H x) in assert new P by (exact (H x)) | H : forall a : E.t, _, _ : context [ E.eq _ ?x ] |- _ => let P := type of (H x) in assert new P by (exact (H x)) | H : forall a : E.t, _ |- context [ E.eq _ ?x ] => let P := type of (H x) in assert new P by (exact (H x)) end); repeat ( match goal with | H : forall a : E.t, _ |- _ => clear H end). (** ** The Core [fsetdec] Auxiliary Tactics *) (** Here is the crux of the proof search. Recursion through [intuition]! (This will terminate if I correctly understand the behavior of [intuition].) *) Ltac fsetdec_rec := progress substFSet; intuition fsetdec_rec. (** If we add [unfold Empty, Subset, Equal in *; intros;] to the beginning of this tactic, it will satisfy the same specification as the [fsetdec] tactic; however, it will be much slower than necessary without the pre-processing done by the wrapper tactic [fsetdec]. *) Ltac fsetdec_body := autorewrite with set_eq_simpl in *; inst_FSet_hypotheses; autorewrite with set_simpl set_eq_simpl in *; push not in * using FSet_decidability; substFSet; assert_decidability; auto; (intuition fsetdec_rec) || fail 1 "because the goal is beyond the scope of this tactic". End FSetDecideAuxiliary. Import FSetDecideAuxiliary. (** * The [fsetdec] Tactic Here is the top-level tactic (the only one intended for clients of this library). It's specification is given at the top of the file. *) Ltac fsetdec := (** We first unfold any occurrences of [iff]. *) unfold iff in *; (** We fold occurrences of [not] because it is better for [intros] to leave us with a goal of [~ P] than a goal of [False]. *) fold any not; intros; (** We don't care about the value of elements : complex ones are abstracted as new variables (avoiding potential dependencies, see bug #2464) *) abstract_elements; (** We remove dependencies to logical hypothesis. This way, later "clear" will work nicely (see bug #2136) *) no_logical_interdep; (** Now we decompose conjunctions, which will allow the [discard_nonFSet] and [assert_decidability] tactics to do a much better job. *) decompose records; discard_nonFSet; (** We unfold these defined propositions on finite sets. If our goal was one of them, then have one more item to introduce now. *) unfold Empty, Subset, Equal in *; intros; (** We now want to get rid of all uses of [=] in favor of [E.eq]. However, the best way to eliminate a [=] is in the context is with [subst], so we will try that first. In fact, we may as well convert uses of [E.eq] into [=] when possible before we do [subst] so that we can even more mileage out of it. Then we will convert all remaining uses of [=] back to [E.eq] when possible. We use [change_to_E_t] to ensure that we have a canonical name for set elements, so that [Logic_eq_to_E_eq] will work properly. *) change_to_E_t; E_eq_to_Logic_eq; subst++; Logic_eq_to_E_eq; (** The next optimization is to swap a negated goal with a negated hypothesis when possible. Any swap will improve performance by eliminating the total number of negations, but we will get the maximum benefit if we swap the goal with a hypotheses mentioning the same set element, so we try that first. If we reach the fourth branch below, we attempt any swap. However, to maintain completeness of this tactic, we can only perform such a swap with a decidable proposition; hence, we first test whether the hypothesis is an [FSet_elt_Prop], noting that any [FSet_elt_Prop] is decidable. *) pull not using FSet_decidability; unfold not in *; match goal with | H: (In ?x ?r) -> False |- (In ?x ?s) -> False => contradict H; fsetdec_body | H: (In ?x ?r) -> False |- (E.eq ?x ?y) -> False => contradict H; fsetdec_body | H: (In ?x ?r) -> False |- (E.eq ?y ?x) -> False => contradict H; fsetdec_body | H: ?P -> False |- ?Q -> False => tryif prop (FSet_elt_Prop P) holds by (auto 100 with FSet_Prop) then (contradict H; fsetdec_body) else fsetdec_body | |- _ => fsetdec_body end. (** * Examples *) Module FSetDecideTestCases. Lemma test_eq_trans_1 : forall x y z s, E.eq x y -> ~ ~ E.eq z y -> In x s -> In z s. Proof. fsetdec. Qed. Lemma test_eq_trans_2 : forall x y z r s, In x (singleton y) -> ~ In z r -> ~ ~ In z (add y r) -> In x s -> In z s. Proof. fsetdec. Qed. Lemma test_eq_neq_trans_1 : forall w x y z s, E.eq x w -> ~ ~ E.eq x y -> ~ E.eq y z -> In w s -> In w (remove z s). Proof. fsetdec. Qed. Lemma test_eq_neq_trans_2 : forall w x y z r1 r2 s, In x (singleton w) -> ~ In x r1 -> In x (add y r1) -> In y r2 -> In y (remove z r2) -> In w s -> In w (remove z s). Proof. fsetdec. Qed. Lemma test_In_singleton : forall x, In x (singleton x). Proof. fsetdec. Qed. Lemma test_add_In : forall x y s, In x (add y s) -> ~ E.eq x y -> In x s. Proof. fsetdec. Qed. Lemma test_Subset_add_remove : forall x s, s [<=] (add x (remove x s)). Proof. fsetdec. Qed. Lemma test_eq_disjunction : forall w x y z, In w (add x (add y (singleton z))) -> E.eq w x \/ E.eq w y \/ E.eq w z. Proof. fsetdec. Qed. Lemma test_not_In_disj : forall x y s1 s2 s3 s4, ~ In x (union s1 (union s2 (union s3 (add y s4)))) -> ~ (In x s1 \/ In x s4 \/ E.eq y x). Proof. fsetdec. Qed. Lemma test_not_In_conj : forall x y s1 s2 s3 s4, ~ In x (union s1 (union s2 (union s3 (add y s4)))) -> ~ In x s1 /\ ~ In x s4 /\ ~ E.eq y x. Proof. fsetdec. Qed. Lemma test_iff_conj : forall a x s s', (In a s' <-> E.eq x a \/ In a s) -> (In a s' <-> In a (add x s)). Proof. fsetdec. Qed. Lemma test_set_ops_1 : forall x q r s, (singleton x) [<=] s -> Empty (union q r) -> Empty (inter (diff s q) (diff s r)) -> ~ In x s. Proof. fsetdec. Qed. Lemma eq_chain_test : forall x1 x2 x3 x4 s1 s2 s3 s4, Empty s1 -> In x2 (add x1 s1) -> In x3 s2 -> ~ In x3 (remove x2 s2) -> ~ In x4 s3 -> In x4 (add x3 s3) -> In x1 s4 -> Subset (add x4 s4) s4. Proof. fsetdec. Qed. Lemma test_too_complex : forall x y z r s, E.eq x y -> (In x (singleton y) -> r [<=] s) -> In z r -> In z s. Proof. (** [fsetdec] is not intended to solve this directly. *) intros until s; intros Heq H Hr; lapply H; fsetdec. Qed. Lemma function_test_1 : forall (f : t -> t), forall (g : elt -> elt), forall (s1 s2 : t), forall (x1 x2 : elt), Equal s1 (f s2) -> E.eq x1 (g (g x2)) -> In x1 s1 -> In (g (g x2)) (f s2). Proof. fsetdec. Qed. Lemma function_test_2 : forall (f : t -> t), forall (g : elt -> elt), forall (s1 s2 : t), forall (x1 x2 : elt), Equal s1 (f s2) -> E.eq x1 (g x2) -> In x1 s1 -> g x2 = g (g x2) -> In (g (g x2)) (f s2). Proof. (** [fsetdec] is not intended to solve this directly. *) intros until 3. intros g_eq. rewrite <- g_eq. fsetdec. Qed. Lemma test_baydemir : forall (f : t -> t), forall (s : t), forall (x y : elt), In x (add y (f s)) -> ~ E.eq x y -> In x (f s). Proof. fsetdec. Qed. End FSetDecideTestCases. End WDecide_fun. Require Import FSetInterface. (** Now comes variants for self-contained weak sets and for full sets. For these variants, only one argument is necessary. Thanks to the subtyping [WS<=S], the [Decide] functor which is meant to be used on modules [(M:S)] can simply be an alias of [WDecide]. *) Module WDecide (M:WS) := !WDecide_fun M.E M. Module Decide := WDecide. coq-8.20.0/theories/FSets/FSetEqProperties.v000066400000000000000000000566521466560755400206640ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* mem x s=mem y s. Proof. intro H; rewrite H; auto. Qed. Lemma equal_mem_1: (forall a, mem a s=mem a s') -> equal s s'=true. Proof. intros; apply equal_1; unfold Equal; intros. do 2 rewrite mem_iff; rewrite H; tauto. Qed. Lemma equal_mem_2: equal s s'=true -> forall a, mem a s=mem a s'. Proof. intros; rewrite (equal_2 H); auto. Qed. Lemma subset_mem_1: (forall a, mem a s=true->mem a s'=true) -> subset s s'=true. Proof. intros; apply subset_1; unfold Subset; intros a. do 2 rewrite mem_iff; auto. Qed. Lemma subset_mem_2: subset s s'=true -> forall a, mem a s=true -> mem a s'=true. Proof. intros H a; do 2 rewrite <- mem_iff; apply subset_2; auto. Qed. Lemma empty_mem: mem x empty=false. Proof. rewrite <- not_mem_iff; auto with set. Qed. Lemma is_empty_equal_empty: is_empty s = equal s empty. Proof. apply bool_1; split; intros. - auto with set. - rewrite <- is_empty_iff; auto with set. Qed. Lemma choose_mem_1: choose s=Some x -> mem x s=true. Proof. auto with set. Qed. Lemma choose_mem_2: choose s=None -> is_empty s=true. Proof. auto with set. Qed. Lemma add_mem_1: mem x (add x s)=true. Proof. auto with set. Qed. Lemma add_mem_2: ~E.eq x y -> mem y (add x s)=mem y s. Proof. apply add_neq_b. Qed. Lemma remove_mem_1: mem x (remove x s)=false. Proof. rewrite <- not_mem_iff; auto with set. Qed. Lemma remove_mem_2: ~E.eq x y -> mem y (remove x s)=mem y s. Proof. apply remove_neq_b. Qed. Lemma singleton_equal_add: equal (singleton x) (add x empty)=true. Proof. rewrite (singleton_equal_add x); auto with set. Qed. Lemma union_mem: mem x (union s s')=mem x s || mem x s'. Proof. apply union_b. Qed. Lemma inter_mem: mem x (inter s s')=mem x s && mem x s'. Proof. apply inter_b. Qed. Lemma diff_mem: mem x (diff s s')=mem x s && negb (mem x s'). Proof. apply diff_b. Qed. (** properties of [mem] *) Lemma mem_3 : ~In x s -> mem x s=false. Proof. intros; rewrite <- not_mem_iff; auto. Qed. Lemma mem_4 : mem x s=false -> ~In x s. Proof. intros; rewrite not_mem_iff; auto. Qed. (** Properties of [equal] *) Lemma equal_refl: equal s s=true. Proof. auto with set. Qed. Lemma equal_sym: equal s s'=equal s' s. Proof. intros; apply bool_1; do 2 rewrite <- equal_iff; intuition auto with relations. Qed. Lemma equal_trans: equal s s'=true -> equal s' s''=true -> equal s s''=true. Proof. intros; rewrite (equal_2 H); auto. Qed. Lemma equal_equal: equal s s'=true -> equal s s''=equal s' s''. Proof. intros; rewrite (equal_2 H); auto. Qed. Lemma equal_cardinal: equal s s'=true -> cardinal s=cardinal s'. Proof. auto with set fset. Qed. (* Properties of [subset] *) Lemma subset_refl: subset s s=true. Proof. auto with set. Qed. Lemma subset_antisym: subset s s'=true -> subset s' s=true -> equal s s'=true. Proof. auto with set. Qed. Lemma subset_trans: subset s s'=true -> subset s' s''=true -> subset s s''=true. Proof. do 3 rewrite <- subset_iff; intros. apply subset_trans with s'; auto. Qed. Lemma subset_equal: equal s s'=true -> subset s s'=true. Proof. auto with set. Qed. (** Properties of [choose] *) Lemma choose_mem_3: is_empty s=false -> {x:elt|choose s=Some x /\ mem x s=true}. Proof. intros. generalize (@choose_1 s) (@choose_2 s). destruct (choose s);intros. - exists e;auto with set. - generalize (H1 Logic.eq_refl); clear H1. intros; rewrite (is_empty_1 H1) in H; discriminate. Qed. Lemma choose_mem_4: choose empty=None. Proof. generalize (@choose_1 empty). case (@choose empty);intros;auto. elim (@empty_1 e); auto. Qed. (** Properties of [add] *) Lemma add_mem_3: mem y s=true -> mem y (add x s)=true. Proof. auto with set. Qed. Lemma add_equal: mem x s=true -> equal (add x s) s=true. Proof. auto with set. Qed. (** Properties of [remove] *) Lemma remove_mem_3: mem y (remove x s)=true -> mem y s=true. Proof. rewrite remove_b; intros H;destruct (andb_prop _ _ H); auto. Qed. Lemma remove_equal: mem x s=false -> equal (remove x s) s=true. Proof. intros; apply equal_1; apply remove_equal. rewrite not_mem_iff; auto. Qed. Lemma add_remove: mem x s=true -> equal (add x (remove x s)) s=true. Proof. intros; apply equal_1; apply add_remove; auto with set. Qed. Lemma remove_add: mem x s=false -> equal (remove x (add x s)) s=true. Proof. intros; apply equal_1; apply remove_add; auto. rewrite not_mem_iff; auto. Qed. (** Properties of [is_empty] *) Lemma is_empty_cardinal: is_empty s = zerob (cardinal s). Proof. intros; apply bool_1; split; intros. - rewrite MP.cardinal_1; simpl; auto with set. - assert (cardinal s = 0) by (apply zerob_true_elim; auto). auto with set fset. Qed. (** Properties of [singleton] *) Lemma singleton_mem_1: mem x (singleton x)=true. Proof. auto with set. Qed. Lemma singleton_mem_2: ~E.eq x y -> mem y (singleton x)=false. Proof. intros; rewrite singleton_b. unfold eqb; destruct (E.eq_dec x y); intuition. Qed. Lemma singleton_mem_3: mem y (singleton x)=true -> E.eq x y. Proof. intros; apply singleton_1; auto with set. Qed. (** Properties of [union] *) Lemma union_sym: equal (union s s') (union s' s)=true. Proof. auto with set. Qed. Lemma union_subset_equal: subset s s'=true -> equal (union s s') s'=true. Proof. auto with set. Qed. Lemma union_equal_1: equal s s'=true-> equal (union s s'') (union s' s'')=true. Proof. auto with set. Qed. Lemma union_equal_2: equal s' s''=true-> equal (union s s') (union s s'')=true. Proof. auto with set. Qed. Lemma union_assoc: equal (union (union s s') s'') (union s (union s' s''))=true. Proof. auto with set. Qed. Lemma add_union_singleton: equal (add x s) (union (singleton x) s)=true. Proof. auto with set. Qed. Lemma union_add: equal (union (add x s) s') (add x (union s s'))=true. Proof. auto with set. Qed. (* characterisation of [union] via [subset] *) Lemma union_subset_1: subset s (union s s')=true. Proof. auto with set. Qed. Lemma union_subset_2: subset s' (union s s')=true. Proof. auto with set. Qed. Lemma union_subset_3: subset s s''=true -> subset s' s''=true -> subset (union s s') s''=true. Proof. intros; apply subset_1; apply union_subset_3; auto with set. Qed. (** Properties of [inter] *) Lemma inter_sym: equal (inter s s') (inter s' s)=true. Proof. auto with set. Qed. Lemma inter_subset_equal: subset s s'=true -> equal (inter s s') s=true. Proof. auto with set. Qed. Lemma inter_equal_1: equal s s'=true -> equal (inter s s'') (inter s' s'')=true. Proof. auto with set. Qed. Lemma inter_equal_2: equal s' s''=true -> equal (inter s s') (inter s s'')=true. Proof. auto with set. Qed. Lemma inter_assoc: equal (inter (inter s s') s'') (inter s (inter s' s''))=true. Proof. auto with set. Qed. Lemma union_inter_1: equal (inter (union s s') s'') (union (inter s s'') (inter s' s''))=true. Proof. auto with set. Qed. Lemma union_inter_2: equal (union (inter s s') s'') (inter (union s s'') (union s' s''))=true. Proof. auto with set. Qed. Lemma inter_add_1: mem x s'=true -> equal (inter (add x s) s') (add x (inter s s'))=true. Proof. auto with set. Qed. Lemma inter_add_2: mem x s'=false -> equal (inter (add x s) s') (inter s s')=true. Proof. intros; apply equal_1; apply inter_add_2. rewrite not_mem_iff; auto. Qed. (* characterisation of [union] via [subset] *) Lemma inter_subset_1: subset (inter s s') s=true. Proof. auto with set. Qed. Lemma inter_subset_2: subset (inter s s') s'=true. Proof. auto with set. Qed. Lemma inter_subset_3: subset s'' s=true -> subset s'' s'=true -> subset s'' (inter s s')=true. Proof. intros; apply subset_1; apply inter_subset_3; auto with set. Qed. (** Properties of [diff] *) Lemma diff_subset: subset (diff s s') s=true. Proof. auto with set. Qed. Lemma diff_subset_equal: subset s s'=true -> equal (diff s s') empty=true. Proof. auto with set. Qed. Lemma remove_inter_singleton: equal (remove x s) (diff s (singleton x))=true. Proof. auto with set. Qed. Lemma diff_inter_empty: equal (inter (diff s s') (inter s s')) empty=true. Proof. auto with set. Qed. Lemma diff_inter_all: equal (union (diff s s') (inter s s')) s=true. Proof. auto with set. Qed. End BasicProperties. #[global] Hint Immediate empty_mem is_empty_equal_empty add_mem_1 remove_mem_1 singleton_equal_add union_mem inter_mem diff_mem equal_sym add_remove remove_add : set. #[global] Hint Resolve equal_mem_1 subset_mem_1 choose_mem_1 choose_mem_2 add_mem_2 remove_mem_2 equal_refl equal_equal subset_refl subset_equal subset_antisym add_mem_3 add_equal remove_mem_3 remove_equal : set. (** General recursion principle *) Lemma set_rec: forall (P:t->Type), (forall s s', equal s s'=true -> P s -> P s') -> (forall s x, mem x s=false -> P s -> P (add x s)) -> P empty -> forall s, P s. Proof. intros. apply set_induction; auto; intros. - apply X with empty; auto with set. - apply X with (add x s0); auto with set. + apply equal_1; intro a; rewrite add_iff; rewrite (H0 a); tauto. + apply X0; auto with set; apply mem_3; auto. Qed. (** Properties of [fold] *) Lemma exclusive_set : forall s s' x, ~(In x s/\In x s') <-> mem x s && mem x s'=false. Proof. intros; do 2 rewrite mem_iff. destruct (mem x s); destruct (mem x s'); intuition auto with bool. Qed. Section Fold. Variables (A:Type)(eqA:A->A->Prop)(st:Equivalence eqA). Variables (f:elt->A->A)(Comp:compat_op E.eq eqA f)(Ass:transpose eqA f). Variables (i:A). Variables (s s':t)(x:elt). Lemma fold_empty: (fold f empty i) = i. Proof. apply fold_empty; auto. Qed. Lemma fold_equal: equal s s'=true -> eqA (fold f s i) (fold f s' i). Proof. intros; apply fold_equal with (eqA:=eqA); auto with set. Qed. Lemma fold_add: mem x s=false -> eqA (fold f (add x s) i) (f x (fold f s i)). Proof. intros; apply fold_add with (eqA:=eqA); auto. rewrite not_mem_iff; auto. Qed. Lemma add_fold: mem x s=true -> eqA (fold f (add x s) i) (fold f s i). Proof. intros; apply add_fold with (eqA:=eqA); auto with set. Qed. Lemma remove_fold_1: mem x s=true -> eqA (f x (fold f (remove x s) i)) (fold f s i). Proof. intros; apply remove_fold_1 with (eqA:=eqA); auto with set. Qed. Lemma remove_fold_2: mem x s=false -> eqA (fold f (remove x s) i) (fold f s i). Proof. intros; apply remove_fold_2 with (eqA:=eqA); auto. rewrite not_mem_iff; auto. Qed. Lemma fold_union: (forall x, mem x s && mem x s'=false) -> eqA (fold f (union s s') i) (fold f s (fold f s' i)). Proof. intros; apply fold_union with (eqA:=eqA); auto. intros; rewrite exclusive_set; auto. Qed. End Fold. (** Properties of [cardinal] *) Lemma add_cardinal_1: forall s x, mem x s=true -> cardinal (add x s)=cardinal s. Proof. auto with set fset. Qed. Lemma add_cardinal_2: forall s x, mem x s=false -> cardinal (add x s)=S (cardinal s). Proof. intros; apply add_cardinal_2; auto. rewrite not_mem_iff; auto. Qed. Lemma remove_cardinal_1: forall s x, mem x s=true -> S (cardinal (remove x s))=cardinal s. Proof. intros; apply remove_cardinal_1; auto with set. Qed. Lemma remove_cardinal_2: forall s x, mem x s=false -> cardinal (remove x s)=cardinal s. Proof. intros; apply Equal_cardinal; apply equal_2; auto with set. Qed. Lemma union_cardinal: forall s s', (forall x, mem x s && mem x s'=false) -> cardinal (union s s')=cardinal s+cardinal s'. Proof. intros; apply union_cardinal; auto; intros. rewrite exclusive_set; auto. Qed. Lemma subset_cardinal: forall s s', subset s s'=true -> cardinal s<=cardinal s'. Proof. intros; apply subset_cardinal; auto with set. Qed. Section Bool. (** Properties of [filter] *) Variable f:elt->bool. Variable Comp: Proper (E.eq==>Logic.eq) f. Local Definition Comp' : Proper (E.eq==>Logic.eq) (fun x =>negb (f x)). Proof. repeat red; intros; f_equal; auto. Defined. Local Hint Resolve Comp' : core. Local Hint Unfold compat_bool : core. Lemma filter_mem: forall s x, mem x (filter f s)=mem x s && f x. Proof. intros; apply filter_b; auto. Qed. Lemma for_all_filter: forall s, for_all f s=is_empty (filter (fun x => negb (f x)) s). Proof. intros; apply bool_1; split; intros. - apply is_empty_1. unfold Empty; intros. rewrite filter_iff; auto. red; destruct 1. rewrite <- (@for_all_iff s f) in H; auto. rewrite (H a H0) in H1; discriminate. - apply for_all_1; auto; red; intros. revert H; rewrite <- is_empty_iff. unfold Empty; intro H; generalize (H x); clear H. rewrite filter_iff; auto. destruct (f x); auto. Qed. Lemma exists_filter : forall s, exists_ f s=negb (is_empty (filter f s)). Proof. intros; apply bool_1; split; intros. - destruct (exists_2 Comp H) as (a,(Ha1,Ha2)). apply bool_6. red; intros; apply (@is_empty_2 _ H0 a); auto with set. - generalize (@choose_1 (filter f s)) (@choose_2 (filter f s)). destruct (choose (filter f s)). + intros H0 _; apply exists_1; auto. exists e; generalize (H0 e); rewrite filter_iff; auto. + intros _ H0. rewrite (is_empty_1 (H0 Logic.eq_refl)) in H; auto; discriminate. Qed. Lemma partition_filter_1: forall s, equal (fst (partition f s)) (filter f s)=true. Proof. auto with set. Qed. Lemma partition_filter_2: forall s, equal (snd (partition f s)) (filter (fun x => negb (f x)) s)=true. Proof. auto with set. Qed. Lemma filter_add_1 : forall s x, f x = true -> filter f (add x s) [=] add x (filter f s). Proof. red; intros; set_iff; do 2 (rewrite filter_iff; auto); set_iff. intuition. rewrite <- H; apply Comp; auto. Qed. Lemma filter_add_2 : forall s x, f x = false -> filter f (add x s) [=] filter f s. Proof. red; intros; do 2 (rewrite filter_iff; auto); set_iff. intuition. assert (f x = f a) by (apply Comp; auto). rewrite H in H1; rewrite H2 in H1; discriminate. Qed. Lemma add_filter_1 : forall s s' x, f x=true -> (Add x s s') -> (Add x (filter f s) (filter f s')). Proof. unfold Add, MP.Add; intros. repeat rewrite filter_iff; auto. rewrite H0; clear H0. assert (E.eq x y -> f y = true) by (intro H0; rewrite <- (Comp _ _ H0); auto). tauto. Qed. Lemma add_filter_2 : forall s s' x, f x=false -> (Add x s s') -> filter f s [=] filter f s'. Proof. unfold Add, MP.Add, Equal; intros. repeat rewrite filter_iff; auto. rewrite H0; clear H0. assert (f a = true -> ~E.eq x a). - intros H0 H1. rewrite (Comp _ _ H1) in H. rewrite H in H0; discriminate. - tauto. Qed. Lemma union_filter: forall f g, (compat_bool E.eq f) -> (compat_bool E.eq g) -> forall s, union (filter f s) (filter g s) [=] filter (fun x=>orb (f x) (g x)) s. Proof. clear Comp f. intros. assert (compat_bool E.eq (fun x => orb (f x) (g x))). - unfold compat_bool, Proper, respectful; intros. rewrite (H x y H1); rewrite (H0 x y H1); auto. - unfold Equal; intros; set_iff; repeat rewrite filter_iff; auto. assert (f a || g a = true <-> f a = true \/ g a = true). + split; auto with bool. intro H3; destruct (orb_prop _ _ H3); auto. + tauto. Qed. Lemma filter_union: forall s s', filter f (union s s') [=] union (filter f s) (filter f s'). Proof. unfold Equal; intros; set_iff; repeat rewrite filter_iff; auto; set_iff; tauto. Qed. (** Properties of [for_all] *) Lemma for_all_mem_1: forall s, (forall x, (mem x s)=true->(f x)=true) -> (for_all f s)=true. Proof. intros. rewrite for_all_filter; auto. rewrite is_empty_equal_empty. apply equal_mem_1;intros. rewrite filter_b; auto. rewrite empty_mem. generalize (H a); case (mem a s);intros;auto. rewrite H0;auto. Qed. Lemma for_all_mem_2: forall s, (for_all f s)=true -> forall x,(mem x s)=true -> (f x)=true. Proof. intros. rewrite for_all_filter in H; auto. rewrite is_empty_equal_empty in H. generalize (equal_mem_2 _ _ H x). rewrite filter_b; auto. rewrite empty_mem. rewrite H0; simpl;intros. rewrite <- negb_false_iff; auto. Qed. Lemma for_all_mem_3: forall s x,(mem x s)=true -> (f x)=false -> (for_all f s)=false. Proof. intros. apply (bool_eq_ind (for_all f s));intros;auto. rewrite for_all_filter in H1; auto. rewrite is_empty_equal_empty in H1. generalize (equal_mem_2 _ _ H1 x). rewrite filter_b; auto. rewrite empty_mem. rewrite H. rewrite H0. simpl;auto. Qed. Lemma for_all_mem_4: forall s, for_all f s=false -> {x:elt | mem x s=true /\ f x=false}. Proof. intros. rewrite for_all_filter in H; auto. destruct (choose_mem_3 _ H) as (x,(H0,H1));intros. exists x. rewrite filter_b in H1; auto. elim (andb_prop _ _ H1). split;auto. rewrite <- negb_true_iff; auto. Qed. (** Properties of [exists] *) Lemma for_all_exists: forall s, exists_ f s = negb (for_all (fun x =>negb (f x)) s). Proof. intros. rewrite for_all_b; auto. rewrite exists_b; auto. induction (elements s); simpl; auto. destruct (f a); simpl; auto. Qed. End Bool. Section Bool'. Variable f:elt->bool. Variable Comp: compat_bool E.eq f. Hint Resolve Comp' : core. Lemma exists_mem_1: forall s, (forall x, mem x s=true->f x=false) -> exists_ f s=false. Proof. intros. rewrite for_all_exists; auto. rewrite for_all_mem_1;auto with bool. intros;generalize (H x H0);intros. rewrite negb_true_iff; auto. Qed. Lemma exists_mem_2: forall s, exists_ f s=false -> forall x, mem x s=true -> f x=false. Proof. intros. rewrite for_all_exists in H; auto. rewrite negb_false_iff in H. rewrite <- negb_true_iff. apply for_all_mem_2 with (2:=H); auto. Qed. Lemma exists_mem_3: forall s x, mem x s=true -> f x=true -> exists_ f s=true. Proof. intros. rewrite for_all_exists; auto. rewrite negb_true_iff. apply for_all_mem_3 with x;auto. rewrite negb_false_iff; auto. Qed. Lemma exists_mem_4: forall s, exists_ f s=true -> {x:elt | (mem x s)=true /\ (f x)=true}. Proof. intros. rewrite for_all_exists in H; auto. rewrite negb_true_iff in H. destruct (for_all_mem_4 (fun x =>negb (f x)) (Comp' f Comp) s) as (x,p); auto. elim p;intros. exists x;split;auto. rewrite <-negb_false_iff; auto. Qed. End Bool'. Section Sum. (** Adding a valuation function on all elements of a set. *) Definition sum (f:elt -> nat)(s:t) := fold (fun x => plus (f x)) s 0. Notation compat_opL := (compat_op E.eq Logic.eq). Notation transposeL := (transpose Logic.eq). Lemma sum_plus : forall f g, Proper (E.eq==>Logic.eq) f -> Proper (E.eq==>Logic.eq) g -> forall s, sum (fun x =>f x+g x) s = sum f s + sum g s. Proof. unfold sum. intros f g Hf Hg. assert (fc : compat_opL (fun x:elt =>plus (f x))). { red; auto with fset. } assert (ft : transposeL (fun x:elt =>plus (f x))). { red; intros x y z. rewrite !PeanoNat.Nat.add_assoc, (PeanoNat.Nat.add_comm (f x) (f y)); reflexivity. } assert (gc : compat_opL (fun x:elt => plus (g x))). { red; auto with fset. } assert (gt : transposeL (fun x:elt =>plus (g x))). { red; intros x y z. rewrite !PeanoNat.Nat.add_assoc, (PeanoNat.Nat.add_comm (g x) (g y)); reflexivity. } assert (fgc : compat_opL (fun x:elt =>plus ((f x)+(g x)))). { repeat red; auto. } assert (fgt : transposeL (fun x:elt=>plus ((f x)+(g x)))). { red; intros x y z. set (u := (f x + g x)); set (v := (f y + g y)). rewrite !PeanoNat.Nat.add_assoc, (PeanoNat.Nat.add_comm u). reflexivity. } assert (st : Equivalence (@Logic.eq nat)) by (split; congruence). intros s;pattern s; apply set_rec. - intros. rewrite <- (fold_equal _ _ st _ fc ft 0 _ _ H). rewrite <- (fold_equal _ _ st _ gc gt 0 _ _ H). rewrite <- (fold_equal _ _ st _ fgc fgt 0 _ _ H); auto. - intros; do 3 (rewrite (fold_add _ _ st);auto). rewrite H0;simpl. rewrite <- !(PeanoNat.Nat.add_assoc (f x)); f_equal. rewrite !PeanoNat.Nat.add_assoc. f_equal. apply PeanoNat.Nat.add_comm. - do 3 rewrite fold_empty;auto. Qed. Lemma sum_filter : forall f, (compat_bool E.eq f) -> forall s, (sum (fun x => if f x then 1 else 0) s) = (cardinal (filter f s)). Proof. unfold sum; intros f Hf. assert (st : Equivalence (@Logic.eq nat)) by (split; congruence). assert (cc : compat_opL (fun x => plus (if f x then 1 else 0))). { repeat red; intros. rewrite (Hf _ _ H); auto. } assert (ct : transposeL (fun x => plus (if f x then 1 else 0))). { red; intros. set (a := if f x then _ else _). rewrite PeanoNat.Nat.add_comm. rewrite <- !PeanoNat.Nat.add_assoc. f_equal. apply PeanoNat.Nat.add_comm. } intros s;pattern s; apply set_rec. - intros. change elt with E.t. rewrite <- (fold_equal _ _ st _ cc ct 0 _ _ H). rewrite <- (MP.Equal_cardinal (filter_equal Hf (equal_2 H))); auto. - intros; rewrite (fold_add _ _ st _ cc ct); auto. generalize (@add_filter_1 f Hf s0 (add x s0) x) (@add_filter_2 f Hf s0 (add x s0) x) . assert (~ In x (filter f s0)). + intro H1; rewrite (mem_1 (filter_1 Hf H1)) in H; discriminate H. + case (f x); simpl; intros. * rewrite (MP.cardinal_2 H1 (H2 Logic.eq_refl (MP.Add_add s0 x))); auto. * rewrite <- (MP.Equal_cardinal (H3 Logic.eq_refl (MP.Add_add s0 x))); auto. - intros; rewrite fold_empty;auto. rewrite MP.cardinal_1; auto. unfold Empty; intros. rewrite filter_iff; auto; set_iff; tauto. Qed. Lemma fold_compat : forall (A:Type)(eqA:A->A->Prop)(st:Equivalence eqA) (f g:elt->A->A), (compat_op E.eq eqA f) -> (transpose eqA f) -> (compat_op E.eq eqA g) -> (transpose eqA g) -> forall (i:A)(s:t),(forall x:elt, (In x s) -> forall y, (eqA (f x y) (g x y))) -> (eqA (fold f s i) (fold g s i)). Proof. intros A eqA st f g fc ft gc gt i. intro s; pattern s; apply set_rec; intros. - transitivity (fold f s0 i). + apply fold_equal with (eqA:=eqA); auto. rewrite equal_sym; auto. + transitivity (fold g s0 i). * apply H0; intros; apply H1; auto with set. elim (equal_2 H x); auto with set; intros. * apply fold_equal with (eqA:=eqA); auto with set. - transitivity (f x (fold f s0 i)). + apply fold_add with (eqA:=eqA); auto with set. + transitivity (g x (fold f s0 i)); auto with set. transitivity (g x (fold g s0 i)); auto with set. * apply gc; auto with set. * symmetry; apply fold_add with (eqA:=eqA); auto. - do 2 rewrite fold_empty; reflexivity. Qed. Lemma sum_compat : forall f g, Proper (E.eq==>Logic.eq) f -> Proper (E.eq==>Logic.eq) g -> forall s, (forall x, In x s -> f x=g x) -> sum f s=sum g s. intros. unfold sum; apply (fold_compat _ (@Logic.eq nat)); auto with fset. - intros x x' Hx y y' Hy. rewrite Hx, Hy; auto. - intros x y z; rewrite !PeanoNat.Nat.add_assoc; f_equal; apply PeanoNat.Nat.add_comm. - intros x x' Hx y y' Hy. rewrite Hx, Hy; auto. - intros x y z; rewrite !PeanoNat.Nat.add_assoc; f_equal; apply PeanoNat.Nat.add_comm. Qed. End Sum. End WEqProperties_fun. (** Now comes variants for self-contained weak sets and for full sets. For these variants, only one argument is necessary. Thanks to the subtyping [WS<=S], the [EqProperties] functor which is meant to be used on modules [(M:S)] can simply be an alias of [WEqProperties]. *) Module WEqProperties (M:WS) := WEqProperties_fun M.E M. Module EqProperties := WEqProperties. coq-8.20.0/theories/FSets/FSetFacts.v000066400000000000000000000344351466560755400172750ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* (In x s <-> In y s). Proof. split; apply In_1; auto. Qed. Lemma mem_iff : In x s <-> mem x s = true. Proof. split; [apply mem_1|apply mem_2]. Qed. Lemma not_mem_iff : ~In x s <-> mem x s = false. Proof. rewrite mem_iff; destruct (mem x s); intuition auto with bool. Qed. Lemma equal_iff : s[=]s' <-> equal s s' = true. Proof. split; [apply equal_1|apply equal_2]. Qed. Lemma subset_iff : s[<=]s' <-> subset s s' = true. Proof. split; [apply subset_1|apply subset_2]. Qed. Lemma empty_iff : In x empty <-> False. Proof. intuition; apply (empty_1 H). Qed. Lemma is_empty_iff : Empty s <-> is_empty s = true. Proof. split; [apply is_empty_1|apply is_empty_2]. Qed. Lemma singleton_iff : In y (singleton x) <-> E.eq x y. Proof. split; [apply singleton_1|apply singleton_2]. Qed. Lemma add_iff : In y (add x s) <-> E.eq x y \/ In y s. Proof. split; [ | destruct 1; [apply add_1|apply add_2]]; auto. destruct (eq_dec x y) as [E|E]; auto. intro H; right; exact (add_3 E H). Qed. Lemma add_neq_iff : ~ E.eq x y -> (In y (add x s) <-> In y s). Proof. split; [apply add_3|apply add_2]; auto. Qed. Lemma remove_iff : In y (remove x s) <-> In y s /\ ~E.eq x y. Proof. split; [split; [apply remove_3 with x |] | destruct 1; apply remove_2]; auto. intro. apply (remove_1 H0 H). Qed. Lemma remove_neq_iff : ~ E.eq x y -> (In y (remove x s) <-> In y s). Proof. split; [apply remove_3|apply remove_2]; auto. Qed. Lemma union_iff : In x (union s s') <-> In x s \/ In x s'. Proof. split; [apply union_1 | destruct 1; [apply union_2|apply union_3]]; auto. Qed. Lemma inter_iff : In x (inter s s') <-> In x s /\ In x s'. Proof. split; [split; [apply inter_1 with s' | apply inter_2 with s] | destruct 1; apply inter_3]; auto. Qed. Lemma diff_iff : In x (diff s s') <-> In x s /\ ~ In x s'. Proof. split; [split; [apply diff_1 with s' | apply diff_2 with s] | destruct 1; apply diff_3]; auto. Qed. Variable f : elt->bool. Lemma filter_iff : compat_bool E.eq f -> (In x (filter f s) <-> In x s /\ f x = true). Proof. split; [split; [apply filter_1 with f | apply filter_2 with s] | destruct 1; apply filter_3]; auto. Qed. Lemma for_all_iff : compat_bool E.eq f -> (For_all (fun x => f x = true) s <-> for_all f s = true). Proof. split; [apply for_all_1 | apply for_all_2]; auto. Qed. Lemma exists_iff : compat_bool E.eq f -> (Exists (fun x => f x = true) s <-> exists_ f s = true). Proof. split; [apply exists_1 | apply exists_2]; auto. Qed. Lemma elements_iff : In x s <-> InA E.eq x (elements s). Proof. split; [apply elements_1 | apply elements_2]. Qed. End IffSpec. (** Useful tactic for simplifying expressions like [In y (add x (union s s'))] *) Ltac set_iff := repeat (progress ( rewrite add_iff || rewrite remove_iff || rewrite singleton_iff || rewrite union_iff || rewrite inter_iff || rewrite diff_iff || rewrite empty_iff)). (** * Specifications written using boolean predicates *) Section BoolSpec. Variable s s' s'' : t. Variable x y z : elt. Lemma mem_b : E.eq x y -> mem x s = mem y s. Proof. intros. generalize (mem_iff s x) (mem_iff s y)(In_eq_iff s H). destruct (mem x s); destruct (mem y s); intuition. Qed. Lemma empty_b : mem y empty = false. Proof. generalize (empty_iff y)(mem_iff empty y). destruct (mem y empty); intuition. Qed. Lemma add_b : mem y (add x s) = eqb x y || mem y s. Proof. generalize (mem_iff (add x s) y)(mem_iff s y)(add_iff s x y); unfold eqb. destruct (eq_dec x y); destruct (mem y s); destruct (mem y (add x s)); intuition. Qed. Lemma add_neq_b : ~ E.eq x y -> mem y (add x s) = mem y s. Proof. intros; generalize (mem_iff (add x s) y)(mem_iff s y)(add_neq_iff s H). destruct (mem y s); destruct (mem y (add x s)); intuition. Qed. Lemma remove_b : mem y (remove x s) = mem y s && negb (eqb x y). Proof. generalize (mem_iff (remove x s) y)(mem_iff s y)(remove_iff s x y); unfold eqb. destruct (eq_dec x y); destruct (mem y s); destruct (mem y (remove x s)); simpl; intuition. Qed. Lemma remove_neq_b : ~ E.eq x y -> mem y (remove x s) = mem y s. Proof. intros; generalize (mem_iff (remove x s) y)(mem_iff s y)(remove_neq_iff s H). destruct (mem y s); destruct (mem y (remove x s)); intuition. Qed. Lemma singleton_b : mem y (singleton x) = eqb x y. Proof. generalize (mem_iff (singleton x) y)(singleton_iff x y); unfold eqb. destruct (eq_dec x y); destruct (mem y (singleton x)); intuition. Qed. Lemma union_b : mem x (union s s') = mem x s || mem x s'. Proof. generalize (mem_iff (union s s') x)(mem_iff s x)(mem_iff s' x)(union_iff s s' x). destruct (mem x s); destruct (mem x s'); destruct (mem x (union s s')); intuition. Qed. Lemma inter_b : mem x (inter s s') = mem x s && mem x s'. Proof. generalize (mem_iff (inter s s') x)(mem_iff s x)(mem_iff s' x)(inter_iff s s' x). destruct (mem x s); destruct (mem x s'); destruct (mem x (inter s s')); intuition. Qed. Lemma diff_b : mem x (diff s s') = mem x s && negb (mem x s'). Proof. generalize (mem_iff (diff s s') x)(mem_iff s x)(mem_iff s' x)(diff_iff s s' x). destruct (mem x s); destruct (mem x s'); destruct (mem x (diff s s')); simpl; intuition. Qed. Lemma elements_b : mem x s = existsb (eqb x) (elements s). Proof. generalize (mem_iff s x)(elements_iff s x)(existsb_exists (eqb x) (elements s)). rewrite InA_alt. destruct (mem x s); destruct (existsb (eqb x) (elements s)); auto; intros. - symmetry. rewrite H1. destruct H0 as (H0,_). destruct H0 as (a,(Ha1,Ha2)); [ intuition |]. exists a; intuition. unfold eqb; destruct (eq_dec x a); auto. - rewrite <- H. rewrite H0. destruct H1 as (H1,_). destruct H1 as (a,(Ha1,Ha2)); [intuition|]. exists a; intuition. unfold eqb in *; destruct (eq_dec x a); auto; discriminate. Qed. Variable f : elt->bool. Lemma filter_b : compat_bool E.eq f -> mem x (filter f s) = mem x s && f x. Proof. intros. generalize (mem_iff (filter f s) x)(mem_iff s x)(filter_iff s x H). destruct (mem x s); destruct (mem x (filter f s)); destruct (f x); simpl; intuition. Qed. Lemma for_all_b : compat_bool E.eq f -> for_all f s = forallb f (elements s). Proof. intros. generalize (forallb_forall f (elements s))(for_all_iff s H)(elements_iff s). unfold For_all. destruct (forallb f (elements s)); destruct (for_all f s); auto; intros. - rewrite <- H1; intros. destruct H0 as (H0,_). rewrite (H2 x0) in H3. rewrite (InA_alt E.eq x0 (elements s)) in H3. destruct H3 as (a,(Ha1,Ha2)). rewrite (H _ _ Ha1). apply H0; auto. - symmetry. rewrite H0; intros. destruct H1 as (_,H1). apply H1; auto. rewrite H2. rewrite InA_alt; eauto. Qed. Lemma exists_b : compat_bool E.eq f -> exists_ f s = existsb f (elements s). Proof. intros. generalize (existsb_exists f (elements s))(exists_iff s H)(elements_iff s). unfold Exists. destruct (existsb f (elements s)); destruct (exists_ f s); auto; intros. - rewrite <- H1; intros. destruct H0 as (H0,_). destruct H0 as (a,(Ha1,Ha2)); auto. exists a; split; auto. rewrite H2; rewrite InA_alt; eauto. - symmetry. rewrite H0. destruct H1 as (_,H1). destruct H1 as (a,(Ha1,Ha2)); auto. rewrite (H2 a) in Ha1. rewrite (InA_alt E.eq a (elements s)) in Ha1. destruct Ha1 as (b,(Hb1,Hb2)). exists b; auto. rewrite <- (H _ _ Hb1); auto. Qed. End BoolSpec. (** * [E.eq] and [Equal] are setoid equalities *) #[global] Instance E_ST : Equivalence E.eq. Proof. constructor ; red; [apply E.eq_refl|apply E.eq_sym|apply E.eq_trans]. Qed. #[global] Instance Equal_ST : Equivalence Equal. Proof. constructor ; red; [apply eq_refl | apply eq_sym | apply eq_trans]. Qed. #[global] Instance In_m : Proper (E.eq ==> Equal ==> iff) In. Proof. unfold Equal; intros x y H s s' H0. rewrite (In_eq_iff s H); auto. Qed. #[global] Instance is_empty_m : Proper (Equal==> Logic.eq) is_empty. Proof. unfold Equal; intros s s' H. generalize (is_empty_iff s)(is_empty_iff s'). destruct (is_empty s); destruct (is_empty s'); unfold Empty; auto; intros. - symmetry. rewrite <- H1; intros a Ha. rewrite <- (H a) in Ha. destruct H0 as (_,H0). exact (H0 Logic.eq_refl _ Ha). - rewrite <- H0; intros a Ha. rewrite (H a) in Ha. destruct H1 as (_,H1). exact (H1 Logic.eq_refl _ Ha). Qed. #[global] Instance Empty_m : Proper (Equal ==> iff) Empty. Proof. repeat red; intros; do 2 rewrite is_empty_iff; rewrite H; intuition. Qed. #[global] Instance mem_m : Proper (E.eq ==> Equal ==> Logic.eq) mem. Proof. unfold Equal; intros x y H s s' H0. generalize (H0 x); clear H0; rewrite (In_eq_iff s' H). generalize (mem_iff s x)(mem_iff s' y). destruct (mem x s); destruct (mem y s'); intuition. Qed. #[global] Instance singleton_m : Proper (E.eq ==> Equal) singleton. Proof. unfold Equal; intros x y H a. do 2 rewrite singleton_iff; split; intros. - apply E.eq_trans with x; auto. - apply E.eq_trans with y; auto. Qed. #[global] Instance add_m : Proper (E.eq==>Equal==>Equal) add. Proof. unfold Equal; intros x y H s s' H0 a. do 2 rewrite add_iff; rewrite H; rewrite H0; intuition. Qed. #[global] Instance remove_m : Proper (E.eq==>Equal==>Equal) remove. Proof. unfold Equal; intros x y H s s' H0 a. do 2 rewrite remove_iff; rewrite H; rewrite H0; intuition. Qed. #[global] Instance union_m : Proper (Equal==>Equal==>Equal) union. Proof. unfold Equal; intros s s' H s'' s''' H0 a. do 2 rewrite union_iff; rewrite H; rewrite H0; intuition. Qed. #[global] Instance inter_m : Proper (Equal==>Equal==>Equal) inter. Proof. unfold Equal; intros s s' H s'' s''' H0 a. do 2 rewrite inter_iff; rewrite H; rewrite H0; intuition. Qed. #[global] Instance diff_m : Proper (Equal==>Equal==>Equal) diff. Proof. unfold Equal; intros s s' H s'' s''' H0 a. do 2 rewrite diff_iff; rewrite H; rewrite H0; intuition. Qed. #[global] Instance Subset_m : Proper (Equal==>Equal==>iff) Subset. Proof. unfold Equal, Subset; firstorder. Qed. #[global] Instance subset_m : Proper (Equal ==> Equal ==> Logic.eq) subset. Proof. intros s s' H s'' s''' H0. generalize (subset_iff s s'') (subset_iff s' s'''). destruct (subset s s''); destruct (subset s' s'''); auto; intros. - rewrite H in H1; rewrite H0 in H1; intuition. - rewrite H in H1; rewrite H0 in H1; intuition. Qed. #[global] Instance equal_m : Proper (Equal ==> Equal ==> Logic.eq) equal. Proof. intros s s' H s'' s''' H0. generalize (equal_iff s s'') (equal_iff s' s'''). destruct (equal s s''); destruct (equal s' s'''); auto; intros. - rewrite H in H1; rewrite H0 in H1; intuition. - rewrite H in H1; rewrite H0 in H1; intuition. Qed. (* [Subset] is a setoid order *) Lemma Subset_refl : forall s, s[<=]s. Proof. red; auto. Qed. Lemma Subset_trans : forall s s' s'', s[<=]s'->s'[<=]s''->s[<=]s''. Proof. unfold Subset; eauto. Qed. Add Relation t Subset reflexivity proved by Subset_refl transitivity proved by Subset_trans as SubsetSetoid. #[global] Instance In_s_m : Morphisms.Proper (E.eq ==> Subset ++> Basics.impl) In | 1. Proof. simpl_relation. eauto with set. Qed. Add Morphism Empty with signature Subset --> Basics.impl as Empty_s_m. Proof. unfold Subset, Empty, Basics.impl; firstorder. Qed. Add Morphism add with signature E.eq ==> Subset ++> Subset as add_s_m. Proof. unfold Subset; intros x y H s s' H0 a. do 2 rewrite add_iff; rewrite H; intuition. Qed. Add Morphism remove with signature E.eq ==> Subset ++> Subset as remove_s_m. Proof. unfold Subset; intros x y H s s' H0 a. do 2 rewrite remove_iff; rewrite H; intuition. Qed. Add Morphism union with signature Subset ++> Subset ++> Subset as union_s_m. Proof. unfold Equal; intros s s' H s'' s''' H0 a. do 2 rewrite union_iff; intuition. Qed. Add Morphism inter with signature Subset ++> Subset ++> Subset as inter_s_m. Proof. unfold Equal; intros s s' H s'' s''' H0 a. do 2 rewrite inter_iff; intuition. Qed. Add Morphism diff with signature Subset ++> Subset --> Subset as diff_s_m. Proof. unfold Subset; intros s s' H s'' s''' H0 a. do 2 rewrite diff_iff; intuition. Qed. (* [fold], [filter], [for_all], [exists_] and [partition] cannot be proved morphism without additional hypothesis on [f]. For instance: *) Lemma filter_equal : forall f, compat_bool E.eq f -> forall s s', s[=]s' -> filter f s [=] filter f s'. Proof. unfold Equal; intros; repeat rewrite filter_iff; auto; rewrite H0; tauto. Qed. Lemma filter_ext : forall f f', compat_bool E.eq f -> (forall x, f x = f' x) -> forall s s', s[=]s' -> filter f s [=] filter f' s'. Proof. intros f f' Hf Hff' s s' Hss' x. do 2 (rewrite filter_iff; auto). - rewrite Hff', Hss'; intuition. - repeat red; intros; rewrite <- 2 Hff'; auto. Qed. Lemma filter_subset : forall f, compat_bool E.eq f -> forall s s', s[<=]s' -> filter f s [<=] filter f s'. Proof. unfold Subset; intros; rewrite filter_iff in *; intuition. Qed. (* For [elements], [min_elt], [max_elt] and [choose], we would need setoid structures on [list elt] and [option elt]. *) (* Later: Add Morphism cardinal ; cardinal_m. *) End WFacts_fun. (** Now comes variants for self-contained weak sets and for full sets. For these variants, only one argument is necessary. Thanks to the subtyping [WS<=S], the [Facts] functor which is meant to be used on modules [(M:S)] can simply be an alias of [WFacts]. *) Module WFacts (M:WS) := WFacts_fun M.E M. Module Facts := WFacts. coq-8.20.0/theories/FSets/FSetInterface.v000066400000000000000000000402261466560755400201300ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* t -> Prop. Definition Equal s s' := forall a : elt, In a s <-> In a s'. Definition Subset s s' := forall a : elt, In a s -> In a s'. Definition Empty s := forall a : elt, ~ In a s. Definition For_all (P : elt -> Prop) s := forall x, In x s -> P x. Definition Exists (P : elt -> Prop) s := exists x, In x s /\ P x. Notation "s [=] t" := (Equal s t) (at level 70, no associativity). Notation "s [<=] t" := (Subset s t) (at level 70, no associativity). Parameter empty : t. (** The empty set. *) Parameter is_empty : t -> bool. (** Test whether a set is empty or not. *) Parameter mem : elt -> t -> bool. (** [mem x s] tests whether [x] belongs to the set [s]. *) Parameter add : elt -> t -> t. (** [add x s] returns a set containing all elements of [s], plus [x]. If [x] was already in [s], [s] is returned unchanged. *) Parameter singleton : elt -> t. (** [singleton x] returns the one-element set containing only [x]. *) Parameter remove : elt -> t -> t. (** [remove x s] returns a set containing all elements of [s], except [x]. If [x] was not in [s], [s] is returned unchanged. *) Parameter union : t -> t -> t. (** Set union. *) Parameter inter : t -> t -> t. (** Set intersection. *) Parameter diff : t -> t -> t. (** Set difference. *) Definition eq : t -> t -> Prop := Equal. Parameter eq_dec : forall s s', { eq s s' } + { ~ eq s s' }. Parameter equal : t -> t -> bool. (** [equal s1 s2] tests whether the sets [s1] and [s2] are equal, that is, contain equal elements. *) Parameter subset : t -> t -> bool. (** [subset s1 s2] tests whether the set [s1] is a subset of the set [s2]. *) Parameter fold : forall A : Type, (elt -> A -> A) -> t -> A -> A. (** [fold f s a] computes [(f xN ... (f x2 (f x1 a))...)], where [x1 ... xN] are the elements of [s]. The order in which elements of [s] are presented to [f] is unspecified. *) Parameter for_all : (elt -> bool) -> t -> bool. (** [for_all p s] checks if all elements of the set satisfy the predicate [p]. *) Parameter exists_ : (elt -> bool) -> t -> bool. (** [exists p s] checks if at least one element of the set satisfies the predicate [p]. *) Parameter filter : (elt -> bool) -> t -> t. (** [filter p s] returns the set of all elements in [s] that satisfy predicate [p]. *) Parameter partition : (elt -> bool) -> t -> t * t. (** [partition p s] returns a pair of sets [(s1, s2)], where [s1] is the set of all the elements of [s] that satisfy the predicate [p], and [s2] is the set of all the elements of [s] that do not satisfy [p]. *) Parameter cardinal : t -> nat. (** Return the number of elements of a set. *) Parameter elements : t -> list elt. (** Return the list of all elements of the given set, in any order. *) Parameter choose : t -> option elt. (** Return one element of the given set, or [None] if the set is empty. Which element is chosen is unspecified. Equal sets could return different elements. *) Section Spec. Variable s s' s'': t. Variable x y : elt. (** Specification of [In] *) Parameter In_1 : E.eq x y -> In x s -> In y s. (** Specification of [eq] *) Parameter eq_refl : eq s s. Parameter eq_sym : eq s s' -> eq s' s. Parameter eq_trans : eq s s' -> eq s' s'' -> eq s s''. (** Specification of [mem] *) Parameter mem_1 : In x s -> mem x s = true. Parameter mem_2 : mem x s = true -> In x s. (** Specification of [equal] *) Parameter equal_1 : Equal s s' -> equal s s' = true. Parameter equal_2 : equal s s' = true -> Equal s s'. (** Specification of [subset] *) Parameter subset_1 : Subset s s' -> subset s s' = true. Parameter subset_2 : subset s s' = true -> Subset s s'. (** Specification of [empty] *) Parameter empty_1 : Empty empty. (** Specification of [is_empty] *) Parameter is_empty_1 : Empty s -> is_empty s = true. Parameter is_empty_2 : is_empty s = true -> Empty s. (** Specification of [add] *) Parameter add_1 : E.eq x y -> In y (add x s). Parameter add_2 : In y s -> In y (add x s). Parameter add_3 : ~ E.eq x y -> In y (add x s) -> In y s. (** Specification of [remove] *) Parameter remove_1 : E.eq x y -> ~ In y (remove x s). Parameter remove_2 : ~ E.eq x y -> In y s -> In y (remove x s). Parameter remove_3 : In y (remove x s) -> In y s. (** Specification of [singleton] *) Parameter singleton_1 : In y (singleton x) -> E.eq x y. Parameter singleton_2 : E.eq x y -> In y (singleton x). (** Specification of [union] *) Parameter union_1 : In x (union s s') -> In x s \/ In x s'. Parameter union_2 : In x s -> In x (union s s'). Parameter union_3 : In x s' -> In x (union s s'). (** Specification of [inter] *) Parameter inter_1 : In x (inter s s') -> In x s. Parameter inter_2 : In x (inter s s') -> In x s'. Parameter inter_3 : In x s -> In x s' -> In x (inter s s'). (** Specification of [diff] *) Parameter diff_1 : In x (diff s s') -> In x s. Parameter diff_2 : In x (diff s s') -> ~ In x s'. Parameter diff_3 : In x s -> ~ In x s' -> In x (diff s s'). (** Specification of [fold] *) Parameter fold_1 : forall (A : Type) (i : A) (f : elt -> A -> A), fold f s i = fold_left (fun a e => f e a) (elements s) i. (** Specification of [cardinal] *) Parameter cardinal_1 : cardinal s = length (elements s). Section Filter. Variable f : elt -> bool. (** Specification of [filter] *) Parameter filter_1 : compat_bool E.eq f -> In x (filter f s) -> In x s. Parameter filter_2 : compat_bool E.eq f -> In x (filter f s) -> f x = true. Parameter filter_3 : compat_bool E.eq f -> In x s -> f x = true -> In x (filter f s). (** Specification of [for_all] *) Parameter for_all_1 : compat_bool E.eq f -> For_all (fun x => f x = true) s -> for_all f s = true. Parameter for_all_2 : compat_bool E.eq f -> for_all f s = true -> For_all (fun x => f x = true) s. (** Specification of [exists] *) Parameter exists_1 : compat_bool E.eq f -> Exists (fun x => f x = true) s -> exists_ f s = true. Parameter exists_2 : compat_bool E.eq f -> exists_ f s = true -> Exists (fun x => f x = true) s. (** Specification of [partition] *) Parameter partition_1 : compat_bool E.eq f -> Equal (fst (partition f s)) (filter f s). Parameter partition_2 : compat_bool E.eq f -> Equal (snd (partition f s)) (filter (fun x => negb (f x)) s). End Filter. (** Specification of [elements] *) Parameter elements_1 : In x s -> InA E.eq x (elements s). Parameter elements_2 : InA E.eq x (elements s) -> In x s. (** When compared with ordered sets, here comes the only property that is really weaker: *) Parameter elements_3w : NoDupA E.eq (elements s). (** Specification of [choose] *) Parameter choose_1 : choose s = Some x -> In x s. Parameter choose_2 : choose s = None -> Empty s. End Spec. #[global] Hint Transparent elt : core. #[global] Hint Resolve mem_1 equal_1 subset_1 empty_1 is_empty_1 choose_1 choose_2 add_1 add_2 remove_1 remove_2 singleton_2 union_1 union_2 union_3 inter_3 diff_3 fold_1 filter_3 for_all_1 exists_1 partition_1 partition_2 elements_1 elements_3w : set. #[global] Hint Immediate In_1 mem_2 equal_2 subset_2 is_empty_2 add_3 remove_3 singleton_1 inter_1 inter_2 diff_1 diff_2 filter_1 filter_2 for_all_2 exists_2 elements_2 : set. End WSfun. (** ** Static signature for weak sets Similar to the functorial signature [SW], except that the module [E] of base elements is incorporated in the signature. *) Module Type WS. Declare Module E : DecidableType. Include WSfun E. End WS. (** ** Functorial signature for sets on ordered elements Based on [WSfun], plus ordering on sets and [min_elt] and [max_elt] and some stronger specifications for other functions. *) Module Type Sfun (E : OrderedType). Include WSfun E. Parameter lt : t -> t -> Prop. Parameter compare : forall s s' : t, Compare lt eq s s'. (** Total ordering between sets. Can be used as the ordering function for doing sets of sets. *) Parameter min_elt : t -> option elt. (** Return the smallest element of the given set (with respect to the [E.compare] ordering), or [None] if the set is empty. *) Parameter max_elt : t -> option elt. (** Same as [min_elt], but returns the largest element of the given set. *) Section Spec. Variable s s' s'' : t. Variable x y : elt. (** Specification of [lt] *) Parameter lt_trans : lt s s' -> lt s' s'' -> lt s s''. Parameter lt_not_eq : lt s s' -> ~ eq s s'. (** Additional specification of [elements] *) Parameter elements_3 : sort E.lt (elements s). (** Remark: since [fold] is specified via [elements], this stronger specification of [elements] has an indirect impact on [fold], which can now be proved to receive elements in increasing order. *) (** Specification of [min_elt] *) Parameter min_elt_1 : min_elt s = Some x -> In x s. Parameter min_elt_2 : min_elt s = Some x -> In y s -> ~ E.lt y x. Parameter min_elt_3 : min_elt s = None -> Empty s. (** Specification of [max_elt] *) Parameter max_elt_1 : max_elt s = Some x -> In x s. Parameter max_elt_2 : max_elt s = Some x -> In y s -> ~ E.lt x y. Parameter max_elt_3 : max_elt s = None -> Empty s. (** Additional specification of [choose] *) Parameter choose_3 : choose s = Some x -> choose s' = Some y -> Equal s s' -> E.eq x y. End Spec. #[global] Hint Resolve elements_3 : set. #[global] Hint Immediate min_elt_1 min_elt_2 min_elt_3 max_elt_1 max_elt_2 max_elt_3 : set. End Sfun. (** ** Static signature for sets on ordered elements Similar to the functorial signature [Sfun], except that the module [E] of base elements is incorporated in the signature. *) Module Type S. Declare Module E : OrderedType. Include Sfun E. End S. (** ** Some subtyping tests << WSfun ---> WS | | | | V V Sfun ---> S Module S_WS (M : S) <: WS := M. Module Sfun_WSfun (E:OrderedType)(M : Sfun E) <: WSfun E := M. Module S_Sfun (M : S) <: Sfun M.E := M. Module WS_WSfun (M : WS) <: WSfun M.E := M. >> *) (** * Dependent signature Signature [Sdep] presents ordered sets using dependent types *) Module Type Sdep. Declare Module E : OrderedType. Definition elt := E.t. Parameter t : Type. Parameter In : elt -> t -> Prop. Definition Equal s s' := forall a : elt, In a s <-> In a s'. Definition Subset s s' := forall a : elt, In a s -> In a s'. Definition Add x s s' := forall y, In y s' <-> E.eq x y \/ In y s. Definition Empty s := forall a : elt, ~ In a s. Definition For_all (P : elt -> Prop) s := forall x, In x s -> P x. Definition Exists (P : elt -> Prop) s := exists x, In x s /\ P x. Notation "s [=] t" := (Equal s t) (at level 70, no associativity). Definition eq : t -> t -> Prop := Equal. Parameter lt : t -> t -> Prop. Parameter compare : forall s s' : t, Compare lt eq s s'. Parameter eq_refl : forall s : t, eq s s. Parameter eq_sym : forall s s' : t, eq s s' -> eq s' s. Parameter eq_trans : forall s s' s'' : t, eq s s' -> eq s' s'' -> eq s s''. Parameter lt_trans : forall s s' s'' : t, lt s s' -> lt s' s'' -> lt s s''. Parameter lt_not_eq : forall s s' : t, lt s s' -> ~ eq s s'. Parameter eq_In : forall (s : t) (x y : elt), E.eq x y -> In x s -> In y s. Parameter empty : {s : t | Empty s}. Parameter is_empty : forall s : t, {Empty s} + {~ Empty s}. Parameter mem : forall (x : elt) (s : t), {In x s} + {~ In x s}. Parameter add : forall (x : elt) (s : t), {s' : t | Add x s s'}. Parameter singleton : forall x : elt, {s : t | forall y : elt, In y s <-> E.eq x y}. Parameter remove : forall (x : elt) (s : t), {s' : t | forall y : elt, In y s' <-> ~ E.eq x y /\ In y s}. Parameter union : forall s s' : t, {s'' : t | forall x : elt, In x s'' <-> In x s \/ In x s'}. Parameter inter : forall s s' : t, {s'' : t | forall x : elt, In x s'' <-> In x s /\ In x s'}. Parameter diff : forall s s' : t, {s'' : t | forall x : elt, In x s'' <-> In x s /\ ~ In x s'}. Parameter equal : forall s s' : t, {s[=]s'} + {~ s[=]s'}. Parameter subset : forall s s' : t, {Subset s s'} + {~ Subset s s'}. Parameter filter : forall (P : elt -> Prop) (Pdec : forall x : elt, {P x} + {~ P x}) (s : t), {s' : t | compat_P E.eq P -> forall x : elt, In x s' <-> In x s /\ P x}. Parameter for_all : forall (P : elt -> Prop) (Pdec : forall x : elt, {P x} + {~ P x}) (s : t), {compat_P E.eq P -> For_all P s} + {compat_P E.eq P -> ~ For_all P s}. Parameter exists_ : forall (P : elt -> Prop) (Pdec : forall x : elt, {P x} + {~ P x}) (s : t), {compat_P E.eq P -> Exists P s} + {compat_P E.eq P -> ~ Exists P s}. Parameter partition : forall (P : elt -> Prop) (Pdec : forall x : elt, {P x} + {~ P x}) (s : t), {partition : t * t | let (s1, s2) := partition in compat_P E.eq P -> For_all P s1 /\ For_all (fun x => ~ P x) s2 /\ (forall x : elt, In x s <-> In x s1 \/ In x s2)}. Parameter elements : forall s : t, {l : list elt | sort E.lt l /\ (forall x : elt, In x s <-> InA E.eq x l)}. Parameter fold : forall (A : Type) (f : elt -> A -> A) (s : t) (i : A), {r : A | let (l,_) := elements s in r = fold_left (fun a e => f e a) l i}. Parameter cardinal : forall s : t, {r : nat | let (l,_) := elements s in r = length l }. Parameter min_elt : forall s : t, {x : elt | In x s /\ For_all (fun y => ~ E.lt y x) s} + {Empty s}. Parameter max_elt : forall s : t, {x : elt | In x s /\ For_all (fun y => ~ E.lt x y) s} + {Empty s}. Parameter choose : forall s : t, {x : elt | In x s} + {Empty s}. (** The [choose_3] specification of [S] cannot be packed in the dependent version of [choose], so we leave it separate. *) Parameter choose_equal : forall s s', Equal s s' -> match choose s, choose s' with | inleft (exist _ x _), inleft (exist _ x' _) => E.eq x x' | inright _, inright _ => True | _, _ => False end. End Sdep. coq-8.20.0/theories/FSets/FSetList.v000066400000000000000000000023141466560755400171370ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* bool -> tree -> tree. Scheme tree_ind := Induction for tree Sort Prop. Definition t := tree : Type. Definition empty : t := Leaf. Fixpoint is_empty (m : t) : bool := match m with | Leaf => true | Node l b r => negb b &&& is_empty l &&& is_empty r end. Fixpoint mem (i : elt) (m : t) {struct m} : bool := match m with | Leaf => false | Node l o r => match i with | 1 => o | i~0 => mem i l | i~1 => mem i r end end. Fixpoint add (i : elt) (m : t) : t := match m with | Leaf => match i with | 1 => Node Leaf true Leaf | i~0 => Node (add i Leaf) false Leaf | i~1 => Node Leaf false (add i Leaf) end | Node l o r => match i with | 1 => Node l true r | i~0 => Node (add i l) o r | i~1 => Node l o (add i r) end end. Definition singleton i := add i empty. (** helper function to avoid creating empty trees that are not leaves *) Definition node (l : t) (b: bool) (r : t) : t := if b then Node l b r else match l,r with | Leaf,Leaf => Leaf | _,_ => Node l false r end. Fixpoint remove (i : elt) (m : t) {struct m} : t := match m with | Leaf => Leaf | Node l o r => match i with | 1 => node l false r | i~0 => node (remove i l) o r | i~1 => node l o (remove i r) end end. Fixpoint union (m m': t) : t := match m with | Leaf => m' | Node l o r => match m' with | Leaf => m | Node l' o' r' => Node (union l l') (o||o') (union r r') end end. Fixpoint inter (m m': t) : t := match m with | Leaf => Leaf | Node l o r => match m' with | Leaf => Leaf | Node l' o' r' => node (inter l l') (o&&o') (inter r r') end end. Fixpoint diff (m m': t) : t := match m with | Leaf => Leaf | Node l o r => match m' with | Leaf => m | Node l' o' r' => node (diff l l') (o&&negb o') (diff r r') end end. Fixpoint equal (m m': t): bool := match m with | Leaf => is_empty m' | Node l o r => match m' with | Leaf => is_empty m | Node l' o' r' => eqb o o' &&& equal l l' &&& equal r r' end end. Fixpoint subset (m m': t): bool := match m with | Leaf => true | Node l o r => match m' with | Leaf => is_empty m | Node l' o' r' => (negb o ||| o') &&& subset l l' &&& subset r r' end end. (** reverses [y] and concatenate it with [x] *) Fixpoint rev_append (y x : elt) : elt := match y with | 1 => x | y~1 => rev_append y x~1 | y~0 => rev_append y x~0 end. Infix "@" := rev_append (at level 60). Definition rev x := x@1. Section Fold. Variable B : Type. Variable f : elt -> B -> B. (** the additional argument, [i], records the current path, in reverse order (this should be more efficient: we reverse this argument only at present nodes only, rather than at each node of the tree). we also use this convention in all functions below *) Fixpoint xfold (m : t) (v : B) (i : elt) := match m with | Leaf => v | Node l true r => xfold r (f (rev i) (xfold l v i~0)) i~1 | Node l false r => xfold r (xfold l v i~0) i~1 end. Definition fold m i := xfold m i 1. End Fold. Section Quantifiers. Variable f : elt -> bool. Fixpoint xforall (m : t) (i : elt) := match m with | Leaf => true | Node l o r => (negb o ||| f (rev i)) &&& xforall r i~1 &&& xforall l i~0 end. Definition for_all m := xforall m 1. Fixpoint xexists (m : t) (i : elt) := match m with | Leaf => false | Node l o r => (o &&& f (rev i)) ||| xexists r i~1 ||| xexists l i~0 end. Definition exists_ m := xexists m 1. Fixpoint xfilter (m : t) (i : elt) : t := match m with | Leaf => Leaf | Node l o r => node (xfilter l i~0) (o &&& f (rev i)) (xfilter r i~1) end. Definition filter m := xfilter m 1. Fixpoint xpartition (m : t) (i : elt) : t * t := match m with | Leaf => (Leaf,Leaf) | Node l o r => let (lt,lf) := xpartition l i~0 in let (rt,rf) := xpartition r i~1 in if o then let fi := f (rev i) in (node lt fi rt, node lf (negb fi) rf) else (node lt false rt, node lf false rf) end. Definition partition m := xpartition m 1. End Quantifiers. (** uses [a] to accumulate values rather than doing a lot of concatenations *) Fixpoint xelements (m : t) (i : elt) (a: list elt) := match m with | Leaf => a | Node l false r => xelements l i~0 (xelements r i~1 a) | Node l true r => xelements l i~0 (rev i :: xelements r i~1 a) end. Definition elements (m : t) := xelements m 1 nil. Fixpoint cardinal (m : t) : nat := match m with | Leaf => O | Node l false r => (cardinal l + cardinal r)%nat | Node l true r => S (cardinal l + cardinal r) end. Definition omap (f: elt -> elt) x := match x with | None => None | Some i => Some (f i) end. (** would it be more efficient to use a path like in the above functions ? *) Fixpoint choose (m: t) : option elt := match m with | Leaf => None | Node l o r => if o then Some 1 else match choose l with | None => omap xI (choose r) | Some i => Some i~0 end end. Fixpoint min_elt (m: t) : option elt := match m with | Leaf => None | Node l o r => match min_elt l with | None => if o then Some 1 else omap xI (min_elt r) | Some i => Some i~0 end end. Fixpoint max_elt (m: t) : option elt := match m with | Leaf => None | Node l o r => match max_elt r with | None => if o then Some 1 else omap xO (max_elt l) | Some i => Some i~1 end end. (** lexicographic product, defined using a notation to keep things lazy *) Notation lex u v := match u with Eq => v | Lt => Lt | Gt => Gt end. Definition compare_bool a b := match a,b with | false, true => Lt | true, false => Gt | _,_ => Eq end. Fixpoint compare_fun (m m': t): comparison := match m,m' with | Leaf,_ => if is_empty m' then Eq else Lt | _,Leaf => if is_empty m then Eq else Gt | Node l o r,Node l' o' r' => lex (compare_bool o o') (lex (compare_fun l l') (compare_fun r r')) end. Definition In i t := mem i t = true. Definition Equal s s' := forall a : elt, In a s <-> In a s'. Definition Subset s s' := forall a : elt, In a s -> In a s'. Definition Empty s := forall a : elt, ~ In a s. Definition For_all (P : elt -> Prop) s := forall x, In x s -> P x. Definition Exists (P : elt -> Prop) s := exists x, In x s /\ P x. Notation "s [=] t" := (Equal s t) (at level 70, no associativity). Notation "s [<=] t" := (Subset s t) (at level 70, no associativity). Definition eq := Equal. Declare Equivalent Keys Equal eq. Definition lt m m' := compare_fun m m' = Lt. (** Specification of [In] *) Lemma In_1: forall s x y, E.eq x y -> In x s -> In y s. Proof. intros s x y ->. trivial. Qed. (** Specification of [eq] *) Lemma eq_refl: forall s, eq s s. Proof. unfold eq, Equal. reflexivity. Qed. Lemma eq_sym: forall s s', eq s s' -> eq s' s. Proof. unfold eq, Equal. intros. symmetry. trivial. Qed. Lemma eq_trans: forall s s' s'', eq s s' -> eq s' s'' -> eq s s''. Proof. unfold eq, Equal. intros ? ? ? H ? ?. rewrite H. trivial. Qed. (** Specification of [mem] *) Lemma mem_1: forall s x, In x s -> mem x s = true. Proof. unfold In. trivial. Qed. Lemma mem_2: forall s x, mem x s = true -> In x s. Proof. unfold In. trivial. Qed. (** Additional lemmas for mem *) Lemma mem_Leaf: forall x, mem x Leaf = false. Proof. destruct x; trivial. Qed. (** Specification of [empty] *) Lemma empty_1 : Empty empty. Proof. unfold Empty, In. intro. rewrite mem_Leaf. discriminate. Qed. (** Specification of node *) Lemma mem_node: forall x l o r, mem x (node l o r) = mem x (Node l o r). Proof. intros x l o r. case o; trivial. destruct l; trivial. destruct r; trivial. now destruct x. Qed. Local Opaque node. (** Specification of [is_empty] *) Lemma is_empty_spec: forall s, Empty s <-> is_empty s = true. Proof. unfold Empty, In. induction s as [|l IHl o r IHr]; simpl. - now split. - rewrite <- 2andb_lazy_alt, 2andb_true_iff, <- IHl, <- IHr. clear IHl IHr. destruct o; simpl; split. + intro H. elim (H 1). reflexivity. + intuition discriminate. + intro H. split. * split. -- reflexivity. -- intro a. apply (H a~0). * intro a. apply (H a~1). + intros H [a|a|]; apply H || intro; discriminate. Qed. Lemma is_empty_1: forall s, Empty s -> is_empty s = true. Proof. intro. rewrite is_empty_spec. trivial. Qed. Lemma is_empty_2: forall s, is_empty s = true -> Empty s. Proof. intro. rewrite is_empty_spec. trivial. Qed. (** Specification of [subset] *) Lemma subset_Leaf_s: forall s, Leaf [<=] s. Proof. intros s i Hi. elim (empty_1 Hi). Qed. Lemma subset_spec: forall s s', s [<=] s' <-> subset s s' = true. Proof. induction s as [|l IHl o r IHr]; intros [|l' o' r']; simpl. - split; intros. + reflexivity. + apply subset_Leaf_s. - split; intros. + reflexivity. + apply subset_Leaf_s. - rewrite <- 2andb_lazy_alt, 2andb_true_iff, <- 2is_empty_spec. destruct o; simpl. + split. * intro H. elim (@empty_1 1). apply H. reflexivity. * intuition discriminate. + split; intro H. * split. -- split. ++ reflexivity. ++ unfold Empty. intros a H1. apply (@empty_1 (a~0)). apply H. assumption. -- unfold Empty. intros a H1. apply (@empty_1 (a~1)). apply H. assumption. * destruct H as [[_ Hl] Hr]. intros [i|i|] Hi. -- elim (Hr i Hi). -- elim (Hl i Hi). -- discriminate. - rewrite <- 2andb_lazy_alt, 2andb_true_iff, <- IHl, <- IHr. clear. destruct o; simpl. + split; intro H. * split. -- split. ++ destruct o'; trivial. specialize (H 1). unfold In in H. simpl in H. apply H. reflexivity. ++ intros i Hi. apply (H i~0). apply Hi. -- intros i Hi. apply (H i~1). apply Hi. * destruct H as [[Ho' Hl] Hr]. rewrite Ho'. intros i Hi. destruct i. -- apply (Hr i). assumption. -- apply (Hl i). assumption. -- assumption. + split; intros. * split. -- split. ++ reflexivity. ++ intros i Hi. apply (H i~0). apply Hi. -- intros i Hi. apply (H i~1). apply Hi. * intros i Hi. destruct i; destruct H as [[H Hl] Hr]. -- apply (Hr i). assumption. -- apply (Hl i). assumption. -- discriminate Hi. Qed. Lemma subset_1: forall s s', Subset s s' -> subset s s' = true. Proof. intros s s'. apply -> subset_spec; trivial. Qed. Lemma subset_2: forall s s', subset s s' = true -> Subset s s'. Proof. intros s s'. apply <- subset_spec; trivial. Qed. (** Specification of [equal] (via subset) *) Lemma equal_subset: forall s s', equal s s' = subset s s' && subset s' s. Proof. induction s as [|l IHl o r IHr]; intros [|l' o' r']; simpl; trivial. - destruct o. + reflexivity. + rewrite andb_comm. reflexivity. - rewrite <- 6andb_lazy_alt. rewrite eq_iff_eq_true. rewrite 7andb_true_iff, eqb_true_iff. rewrite IHl, IHr, 2andb_true_iff. clear IHl IHr. intuition subst. + destruct o'; reflexivity. + destruct o'; reflexivity. + destruct o; auto. destruct o'; trivial. Qed. Lemma equal_spec: forall s s', Equal s s' <-> equal s s' = true. Proof. intros. rewrite equal_subset. rewrite andb_true_iff. rewrite <- 2subset_spec. unfold Equal, Subset. firstorder. Qed. Lemma equal_1: forall s s', Equal s s' -> equal s s' = true. Proof. intros s s'. apply -> equal_spec; trivial. Qed. Lemma equal_2: forall s s', equal s s' = true -> Equal s s'. Proof. intros s s'. apply <- equal_spec; trivial. Qed. Lemma eq_dec : forall s s', { eq s s' } + { ~ eq s s' }. Proof. unfold eq. intros. case_eq (equal s s'); intro H. - left. apply equal_2, H. - right. abstract (intro H'; rewrite (equal_1 H') in H; discriminate). Defined. (** (Specified) definition of [compare] *) Lemma lex_Opp: forall u v u' v', u = CompOpp u' -> v = CompOpp v' -> lex u v = CompOpp (lex u' v'). Proof. intros ? ? u' ? -> ->. case u'; reflexivity. Qed. Lemma compare_bool_inv: forall b b', compare_bool b b' = CompOpp (compare_bool b' b). Proof. intros [|] [|]; reflexivity. Qed. Lemma compare_inv: forall s s', compare_fun s s' = CompOpp (compare_fun s' s). Proof. induction s as [|l IHl o r IHr]; destruct s' as [|l' o' r']; trivial. - unfold compare_fun. case is_empty; reflexivity. - unfold compare_fun. case is_empty; reflexivity. - simpl. rewrite compare_bool_inv. case compare_bool; simpl; trivial; apply lex_Opp; auto. Qed. Lemma lex_Eq: forall u v, lex u v = Eq <-> u=Eq /\ v=Eq. Proof. intros u v; destruct u; intuition discriminate. Qed. Lemma compare_bool_Eq: forall b1 b2, compare_bool b1 b2 = Eq <-> eqb b1 b2 = true. Proof. intros [|] [|]; intuition discriminate. Qed. Lemma compare_equal: forall s s', compare_fun s s' = Eq <-> equal s s' = true. Proof. induction s as [|l IHl o r IHr]; destruct s' as [|l' o' r']. - simpl. tauto. - unfold compare_fun, equal. case is_empty; intuition discriminate. - unfold compare_fun, equal. case is_empty; intuition discriminate. - simpl. rewrite <- 2andb_lazy_alt, 2andb_true_iff. rewrite <- IHl, <- IHr, <- compare_bool_Eq. clear IHl IHr. rewrite and_assoc. rewrite <- 2lex_Eq. reflexivity. Qed. Lemma compare_gt: forall s s', compare_fun s s' = Gt -> lt s' s. Proof. unfold lt. intros s s'. rewrite compare_inv. case compare_fun; trivial; intros; discriminate. Qed. Lemma compare_eq: forall s s', compare_fun s s' = Eq -> eq s s'. Proof. unfold eq. intros s s'. rewrite compare_equal, equal_spec. trivial. Qed. Lemma compare : forall s s' : t, Compare lt eq s s'. Proof. intros. case_eq (compare_fun s s'); intro H. - apply EQ. apply compare_eq, H. - apply LT. assumption. - apply GT. apply compare_gt, H. Defined. Section lt_spec. Inductive ct: comparison -> comparison -> comparison -> Prop := | ct_xxx: forall x, ct x x x | ct_xex: forall x, ct x Eq x | ct_exx: forall x, ct Eq x x | ct_glx: forall x, ct Gt Lt x | ct_lgx: forall x, ct Lt Gt x. Lemma ct_cxe: forall x, ct (CompOpp x) x Eq. Proof. destruct x; constructor. Qed. Lemma ct_xce: forall x, ct x (CompOpp x) Eq. Proof. destruct x; constructor. Qed. Lemma ct_lxl: forall x, ct Lt x Lt. Proof. destruct x; constructor. Qed. Lemma ct_gxg: forall x, ct Gt x Gt. Proof. destruct x; constructor. Qed. Lemma ct_xll: forall x, ct x Lt Lt. Proof. destruct x; constructor. Qed. Lemma ct_xgg: forall x, ct x Gt Gt. Proof. destruct x; constructor. Qed. Local Hint Constructors ct: ct. Local Hint Resolve ct_cxe ct_xce ct_lxl ct_xll ct_gxg ct_xgg: ct. Ltac ct := trivial with ct. Lemma ct_lex: forall u v w u' v' w', ct u v w -> ct u' v' w' -> ct (lex u u') (lex v v') (lex w w'). Proof. intros u v w u' v' w' H H'. inversion_clear H; inversion_clear H'; ct; destruct w; ct; destruct w'; ct. Qed. Lemma ct_compare_bool: forall a b c, ct (compare_bool a b) (compare_bool b c) (compare_bool a c). Proof. intros [|] [|] [|]; constructor. Qed. Lemma compare_x_Leaf: forall s, compare_fun s Leaf = if is_empty s then Eq else Gt. Proof. intros. rewrite compare_inv. simpl. case (is_empty s); reflexivity. Qed. Lemma compare_empty_x: forall a, is_empty a = true -> forall b, compare_fun a b = if is_empty b then Eq else Lt. Proof. induction a as [|l IHl o r IHr]; trivial. destruct o. - intro; discriminate. - simpl is_empty. rewrite <- andb_lazy_alt, andb_true_iff. intros [Hl Hr]. destruct b as [|l' [|] r']; simpl compare_fun; trivial. + rewrite Hl, Hr. trivial. + rewrite (IHl Hl), (IHr Hr). simpl. case (is_empty l'); case (is_empty r'); trivial. Qed. Lemma compare_x_empty: forall a, is_empty a = true -> forall b, compare_fun b a = if is_empty b then Eq else Gt. Proof. setoid_rewrite <- compare_x_Leaf. intros. rewrite 2(compare_inv b), (compare_empty_x _ H). reflexivity. Qed. Lemma ct_compare_fun: forall a b c, ct (compare_fun a b) (compare_fun b c) (compare_fun a c). Proof. induction a as [|l IHl o r IHr]; intros s' s''. - destruct s' as [|l' o' r']; destruct s'' as [|l'' o'' r'']; ct. + rewrite compare_inv. ct. + unfold compare_fun at 1. case_eq (is_empty (Node l' o' r')); intro H'. * rewrite (compare_empty_x _ H'). ct. * unfold compare_fun at 2. case_eq (is_empty (Node l'' o'' r'')); intro H''. -- rewrite (compare_x_empty _ H''), H'. ct. -- ct. - destruct s' as [|l' o' r']; destruct s'' as [|l'' o'' r'']. + ct. + unfold compare_fun at 2. rewrite compare_x_Leaf. case_eq (is_empty (Node l o r)); intro H. * rewrite (compare_empty_x _ H). ct. * case_eq (is_empty (Node l'' o'' r'')); intro H''. -- rewrite (compare_x_empty _ H''), H. ct. -- ct. + rewrite 2 compare_x_Leaf. case_eq (is_empty (Node l o r)); intro H. * rewrite compare_inv, (compare_x_empty _ H). ct. * case_eq (is_empty (Node l' o' r')); intro H'. -- rewrite (compare_x_empty _ H'), H. ct. -- ct. + simpl compare_fun. apply ct_lex. * apply ct_compare_bool. * apply ct_lex; trivial. Qed. End lt_spec. Lemma lt_trans: forall s s' s'', lt s s' -> lt s' s'' -> lt s s''. Proof. unfold lt. intros a b c. assert (H := ct_compare_fun a b c). inversion_clear H; trivial; intros; discriminate. Qed. Lemma lt_not_eq: forall s s', lt s s' -> ~ eq s s'. Proof. unfold lt, eq. intros s s' H H'. rewrite equal_spec, <- compare_equal in H'. congruence. Qed. (** Specification of [add] *) Lemma add_spec: forall x y s, In y (add x s) <-> x=y \/ In y s. Proof. unfold In. induction x; intros [y|y|] [|l o r]; simpl mem; try (rewrite IHx; clear IHx); rewrite ?mem_Leaf; intuition congruence. Qed. Lemma add_1: forall s x y, x = y -> In y (add x s). Proof. intros. apply <- add_spec. left. assumption. Qed. Lemma add_2: forall s x y, In y s -> In y (add x s). Proof. intros. apply <- add_spec. right. assumption. Qed. Lemma add_3: forall s x y, x<>y -> In y (add x s) -> In y s. Proof. intros s x y H. rewrite add_spec. intros [->|?]; trivial. elim H; trivial. Qed. (** Specification of [remove] *) Lemma remove_spec: forall x y s, In y (remove x s) <-> x<>y /\ In y s. Proof. unfold In. induction x; intros [y|y|] [|l o r]; simpl remove; rewrite ?mem_node; simpl mem; try (rewrite IHx; clear IHx); rewrite ?mem_Leaf; intuition congruence. Qed. Lemma remove_1: forall s x y, x=y -> ~ In y (remove x s). Proof. intros. rewrite remove_spec. tauto. Qed. Lemma remove_2: forall s x y, x<>y -> In y s -> In y (remove x s). Proof. intros. rewrite remove_spec. split; assumption. Qed. Lemma remove_3: forall s x y, In y (remove x s) -> In y s. Proof. intros s x y. rewrite remove_spec. tauto. Qed. (** Specification of [singleton] *) Lemma singleton_1: forall x y, In y (singleton x) -> x=y. Proof. unfold singleton. intros x y. rewrite add_spec. unfold In. rewrite mem_Leaf. intuition discriminate. Qed. Lemma singleton_2: forall x y, x = y -> In y (singleton x). Proof. unfold singleton. intros. apply add_1. assumption. Qed. (** Specification of [union] *) Lemma union_spec: forall x s s', In x (union s s') <-> In x s \/ In x s'. Proof. unfold In. induction x; destruct s; destruct s'; simpl union; simpl mem; try (rewrite IHx; clear IHx); try intuition congruence. apply orb_true_iff. Qed. Lemma union_1: forall s s' x, In x (union s s') -> In x s \/ In x s'. Proof. intros. apply -> union_spec. assumption. Qed. Lemma union_2: forall s s' x, In x s -> In x (union s s'). Proof. intros. apply <- union_spec. left. assumption. Qed. Lemma union_3: forall s s' x, In x s' -> In x (union s s'). Proof. intros. apply <- union_spec. right. assumption. Qed. (** Specification of [inter] *) Lemma inter_spec: forall x s s', In x (inter s s') <-> In x s /\ In x s'. Proof. unfold In. induction x; destruct s; destruct s'; simpl inter; rewrite ?mem_node; simpl mem; try (rewrite IHx; clear IHx); try intuition congruence. apply andb_true_iff. Qed. Lemma inter_1: forall s s' x, In x (inter s s') -> In x s. Proof. intros s s' x. rewrite inter_spec. tauto. Qed. Lemma inter_2: forall s s' x, In x (inter s s') -> In x s'. Proof. intros s s' x. rewrite inter_spec. tauto. Qed. Lemma inter_3: forall s s' x, In x s -> In x s' -> In x (inter s s'). Proof. intros. rewrite inter_spec. split; assumption. Qed. (** Specification of [diff] *) Lemma diff_spec: forall x s s', In x (diff s s') <-> In x s /\ ~ In x s'. Proof. unfold In. induction x; destruct s; destruct s' as [|l' o' r']; simpl diff; rewrite ?mem_node; simpl mem; try (rewrite IHx; clear IHx); try intuition congruence. rewrite andb_true_iff. destruct o'; intuition discriminate. Qed. Lemma diff_1: forall s s' x, In x (diff s s') -> In x s. Proof. intros s s' x. rewrite diff_spec. tauto. Qed. Lemma diff_2: forall s s' x, In x (diff s s') -> ~ In x s'. Proof. intros s s' x. rewrite diff_spec. tauto. Qed. Lemma diff_3: forall s s' x, In x s -> ~ In x s' -> In x (diff s s'). Proof. intros. rewrite diff_spec. split; assumption. Qed. (** Specification of [fold] *) Lemma fold_1: forall s (A : Type) (i : A) (f : elt -> A -> A), fold f s i = fold_left (fun a e => f e a) (elements s) i. Proof. unfold fold, elements. intros s A i f. revert s i. set (f' := fun a e => f e a). assert (H: forall s i j acc, fold_left f' acc (xfold f s i j) = fold_left f' (xelements s j acc) i). - induction s as [|l IHl o r IHr]; intros; trivial. destruct o; simpl xelements; simpl xfold. + rewrite IHr, <- IHl. reflexivity. + rewrite IHr. apply IHl. - intros. exact (H s i 1 nil). Qed. (** Specification of [cardinal] *) Lemma cardinal_1: forall s, cardinal s = length (elements s). Proof. unfold elements. assert (H: forall s j acc, (cardinal s + length acc)%nat = length (xelements s j acc)). - induction s as [|l IHl b r IHr]; intros j acc; simpl; trivial. destruct b. + rewrite <- IHl. simpl. rewrite <- IHr. rewrite <- plus_n_Sm, Nat.add_assoc. reflexivity. + rewrite <- IHl, <- IHr. rewrite Nat.add_assoc. reflexivity. - intros. rewrite <- H. simpl. rewrite Nat.add_comm. reflexivity. Qed. (** Specification of [filter] *) Lemma xfilter_spec: forall f s x i, In x (xfilter f s i) <-> In x s /\ f (i@x) = true. Proof. intro f. unfold In. induction s as [|l IHl o r IHr]; intros x i; simpl xfilter. - rewrite mem_Leaf. intuition discriminate. - rewrite mem_node. destruct x; simpl. + rewrite IHr. reflexivity. + rewrite IHl. reflexivity. + rewrite <- andb_lazy_alt. apply andb_true_iff. Qed. Lemma filter_1 : forall s x f, @compat_bool elt E.eq f -> In x (filter f s) -> In x s. Proof. unfold filter. intros s x f _. rewrite xfilter_spec. tauto. Qed. Lemma filter_2 : forall s x f, @compat_bool elt E.eq f -> In x (filter f s) -> f x = true. Proof. unfold filter. intros s x f _. rewrite xfilter_spec. tauto. Qed. Lemma filter_3 : forall s x f, @compat_bool elt E.eq f -> In x s -> f x = true -> In x (filter f s). Proof. unfold filter. intros s x f _. rewrite xfilter_spec. tauto. Qed. (** Specification of [for_all] *) Lemma xforall_spec: forall f s i, xforall f s i = true <-> For_all (fun x => f (i@x) = true) s. Proof. unfold For_all, In. intro f. induction s as [|l IHl o r IHr]; intros i; simpl. - now split. - rewrite <- 2andb_lazy_alt, <- orb_lazy_alt, 2 andb_true_iff. rewrite IHl, IHr. clear IHl IHr. split. + intros [[Hi Hr] Hl] x. destruct x; simpl; intro H. * apply Hr, H. * apply Hl, H. * rewrite H in Hi. assumption. + intro H; intuition. * specialize (H 1). destruct o. -- apply H. reflexivity. -- reflexivity. * apply H. assumption. * apply H. assumption. Qed. Lemma for_all_1 : forall s f, @compat_bool elt E.eq f -> For_all (fun x => f x = true) s -> for_all f s = true. Proof. intros s f _. unfold for_all. rewrite xforall_spec. trivial. Qed. Lemma for_all_2 : forall s f, @compat_bool elt E.eq f -> for_all f s = true -> For_all (fun x => f x = true) s. Proof. intros s f _. unfold for_all. rewrite xforall_spec. trivial. Qed. (** Specification of [exists] *) Lemma xexists_spec: forall f s i, xexists f s i = true <-> Exists (fun x => f (i@x) = true) s. Proof. unfold Exists, In. intro f. induction s as [|l IHl o r IHr]; intros i; simpl. - split; [ discriminate | now intros [ _ [? _]]]. - rewrite <- 2orb_lazy_alt, 2orb_true_iff, <- andb_lazy_alt, andb_true_iff. rewrite IHl, IHr. clear IHl IHr. split. + intros [[Hi|[x Hr]]|[x Hl]]. * exists 1. exact Hi. * exists x~1. exact Hr. * exists x~0. exact Hl. + intros [[x|x|] H]; eauto. Qed. Lemma exists_1 : forall s f, @compat_bool elt E.eq f -> Exists (fun x => f x = true) s -> exists_ f s = true. Proof. intros s f _. unfold exists_. rewrite xexists_spec. trivial. Qed. Lemma exists_2 : forall s f, @compat_bool elt E.eq f -> exists_ f s = true -> Exists (fun x => f x = true) s. Proof. intros s f _. unfold exists_. rewrite xexists_spec. trivial. Qed. (** Specification of [partition] *) Lemma partition_filter : forall s f, partition f s = (filter f s, filter (fun x => negb (f x)) s). Proof. unfold partition, filter. intros s f. generalize 1 as j. induction s as [|l IHl o r IHr]; intro j. - reflexivity. - destruct o; simpl; rewrite IHl, IHr; reflexivity. Qed. Lemma partition_1 : forall s f, @compat_bool elt E.eq f -> Equal (fst (partition f s)) (filter f s). Proof. intros. rewrite partition_filter. apply eq_refl. Qed. Lemma partition_2 : forall s f, @compat_bool elt E.eq f -> Equal (snd (partition f s)) (filter (fun x => negb (f x)) s). Proof. intros. rewrite partition_filter. apply eq_refl. Qed. (** Specification of [elements] *) Notation InL := (InA E.eq). Lemma xelements_spec: forall s j acc y, InL y (xelements s j acc) <-> InL y acc \/ exists x, y=(j@x) /\ mem x s = true. Proof. induction s as [|l IHl o r IHr]; simpl. - intros. split; intro H. + left. assumption. + destruct H as [H|[x [Hx Hx']]]. * assumption. * discriminate. - intros j acc y. case o. + rewrite IHl. rewrite InA_cons. rewrite IHr. clear IHl IHr. split. * intros [[H|[H|[x [-> H]]]]|[x [-> H]]]; eauto. -- right. exists x~1. auto. -- right. exists x~0. auto. * intros [H|[x [-> H]]]. -- eauto. -- destruct x. ++ left. right. right. exists x; auto. ++ right. exists x; auto. ++ left. left. reflexivity. + rewrite IHl, IHr. clear IHl IHr. split. * intros [[H|[x [-> H]]]|[x [-> H]]]. -- eauto. -- right. exists x~1. auto. -- right. exists x~0. auto. * intros [H|[x [-> H]]]. -- eauto. -- destruct x. ++ left. right. exists x; auto. ++ right. exists x; auto. ++ discriminate. Qed. Lemma elements_1: forall s x, In x s -> InL x (elements s). Proof. unfold elements, In. intros. rewrite xelements_spec. right. exists x. auto. Qed. Lemma elements_2: forall s x, InL x (elements s) -> In x s. Proof. unfold elements, In. intros s x H. rewrite xelements_spec in H. destruct H as [H|[y [H H']]]. - inversion_clear H. - rewrite H. assumption. Qed. Lemma lt_rev_append: forall j x y, E.lt x y -> E.lt (j@x) (j@y). Proof. induction j; intros; simpl; auto. Qed. Lemma elements_3: forall s, sort E.lt (elements s). Proof. unfold elements. assert (H: forall s j acc, sort E.lt acc -> (forall x y, In x s -> InL y acc -> E.lt (j@x) y) -> sort E.lt (xelements s j acc)). { induction s as [|l IHl o r IHr]; simpl; trivial. intros j acc Hacc Hsacc. destruct o. - apply IHl. + constructor. * apply IHr. -- apply Hacc. -- intros x y Hx Hy. apply Hsacc; assumption. * case_eq (xelements r j~1 acc). -- constructor. -- intros z q H. constructor. assert (H': InL z (xelements r j~1 acc)). { rewrite H. constructor. reflexivity. } clear H q. rewrite xelements_spec in H'. destruct H' as [Hy|[x [-> Hx]]]. ++ apply (Hsacc 1 z); trivial. reflexivity. ++ simpl. apply lt_rev_append. exact I. + intros x y Hx Hy. inversion_clear Hy. * rewrite H. simpl. apply lt_rev_append. exact I. * rewrite xelements_spec in H. destruct H as [Hy|[z [-> Hy]]]. -- apply Hsacc; assumption. -- simpl. apply lt_rev_append. exact I. - apply IHl. + apply IHr. * apply Hacc. * intros x y Hx Hy. apply Hsacc; assumption. + intros x y Hx Hy. rewrite xelements_spec in Hy. destruct Hy as [Hy|[z [-> Hy]]]. * apply Hsacc; assumption. * simpl. apply lt_rev_append. exact I. } intros. apply H. - constructor. - intros x y _ H'. inversion H'. Qed. Lemma elements_3w: forall s, NoDupA E.eq (elements s). Proof. intro. apply SortA_NoDupA with E.lt. - constructor. + intro. apply E.eq_refl. + intro. apply E.eq_sym. + intro. apply E.eq_trans. - constructor. + intros x H. apply E.lt_not_eq in H. apply H. reflexivity. + intro. apply E.lt_trans. - solve_proper. - apply elements_3. Qed. (** Specification of [choose] *) Lemma choose_1: forall s x, choose s = Some x -> In x s. Proof. induction s as [| l IHl o r IHr]; simpl. - intros. discriminate. - destruct o. + intros x H. injection H; intros; subst. reflexivity. + revert IHl. case choose. * intros p Hp x [= <-]. apply Hp. reflexivity. * intros _ x. revert IHr. case choose. -- intros p Hp [= <-]. apply Hp. reflexivity. -- intros. discriminate. Qed. Lemma choose_2: forall s, choose s = None -> Empty s. Proof. unfold Empty, In. intros s H. induction s as [|l IHl o r IHr]. - intro. apply empty_1. - destruct o. + discriminate. + simpl in H. destruct (choose l). * discriminate. * destruct (choose r). -- discriminate. -- intros [a|a|]. ++ apply IHr. reflexivity. ++ apply IHl. reflexivity. ++ discriminate. Qed. Lemma choose_empty: forall s, is_empty s = true -> choose s = None. Proof. intros s Hs. case_eq (choose s); trivial. intros p Hp. apply choose_1 in Hp. apply is_empty_2 in Hs. elim (Hs _ Hp). Qed. Lemma choose_3': forall s s', Equal s s' -> choose s = choose s'. Proof. setoid_rewrite equal_spec. induction s as [|l IHl o r IHr]. - intros. symmetry. apply choose_empty. assumption. - destruct s' as [|l' o' r']. + generalize (Node l o r) as s. simpl. intros. apply choose_empty. rewrite <- equal_spec in H. apply eq_sym in H. rewrite equal_spec in H. assumption. + simpl. rewrite <- 2andb_lazy_alt, 2andb_true_iff, eqb_true_iff. intros [[<- Hl] Hr]. rewrite (IHl _ Hl), (IHr _ Hr). reflexivity. Qed. Lemma choose_3: forall s s' x y, choose s = Some x -> choose s' = Some y -> Equal s s' -> E.eq x y. Proof. intros s s' x y Hx Hy H. apply choose_3' in H. congruence. Qed. (** Specification of [min_elt] *) Lemma min_elt_1: forall s x, min_elt s = Some x -> In x s. Proof. unfold In. induction s as [| l IHl o r IHr]; simpl. - intros. discriminate. - intros x. destruct (min_elt l); intros. + injection H as [= <-]. apply IHl. reflexivity. + destruct o; simpl. * injection H as [= <-]. reflexivity. * destruct (min_elt r); simpl in *. -- injection H as [= <-]. apply IHr. reflexivity. -- discriminate. Qed. Lemma min_elt_3: forall s, min_elt s = None -> Empty s. Proof. unfold Empty, In. intros s H. induction s as [|l IHl o r IHr]. - intro. apply empty_1. - intros [a|a|]. + apply IHr. revert H. clear. simpl. destruct (min_elt r); trivial. case min_elt; intros; try discriminate. destruct o; discriminate. + apply IHl. revert H. clear. simpl. destruct (min_elt l); trivial. intro; discriminate. + revert H. clear. simpl. case min_elt; intros; try discriminate. destruct o; discriminate. Qed. Lemma min_elt_2: forall s x y, min_elt s = Some x -> In y s -> ~ E.lt y x. Proof. unfold In. induction s as [|l IHl o r IHr]; intros x y H H'. - discriminate. - simpl in H. case_eq (min_elt l). + intros p Hp. rewrite Hp in H. injection H as [= <-]. destruct y as [z|z|]; simpl; intro; trivial. apply (IHl p z); trivial. + intro Hp; rewrite Hp in H. apply min_elt_3 in Hp. destruct o. * injection H as [= <-]. intros Hl. destruct y as [z|z|]; simpl; trivial. elim (Hp _ H'). * destruct (min_elt r). -- injection H as [= <-]. destruct y as [z|z|]. ++ apply (IHr e z); trivial. ++ elim (Hp _ H'). ++ discriminate. -- discriminate. Qed. (** Specification of [max_elt] *) Lemma max_elt_1: forall s x, max_elt s = Some x -> In x s. Proof. unfold In. induction s as [| l IHl o r IHr]; simpl. - intros. discriminate. - intros x. destruct (max_elt r); intros. + injection H as [= <-]. apply IHr. reflexivity. + destruct o; simpl. * injection H as [= <-]. reflexivity. * destruct (max_elt l); simpl in *. -- injection H as [= <-]. apply IHl. reflexivity. -- discriminate. Qed. Lemma max_elt_3: forall s, max_elt s = None -> Empty s. Proof. unfold Empty, In. intros s H. induction s as [|l IHl o r IHr]. - intro. apply empty_1. - intros [a|a|]. + apply IHr. revert H. clear. simpl. destruct (max_elt r); trivial. intro; discriminate. + apply IHl. revert H. clear. simpl. destruct (max_elt l); trivial. case max_elt; intros; try discriminate. destruct o; discriminate. + revert H. clear. simpl. case max_elt; intros; try discriminate. destruct o; discriminate. Qed. Lemma max_elt_2: forall s x y, max_elt s = Some x -> In y s -> ~ E.lt x y. Proof. unfold In. induction s as [|l IHl o r IHr]; intros x y H H'. - discriminate. - simpl in H. case_eq (max_elt r). + intros p Hp. rewrite Hp in H. injection H as [= <-]. destruct y as [z|z|]; simpl; intro; trivial. apply (IHr p z); trivial. + intro Hp; rewrite Hp in H. apply max_elt_3 in Hp. destruct o. * injection H as [= <-]. intros Hl. destruct y as [z|z|]; simpl; trivial. elim (Hp _ H'). * destruct (max_elt l). -- injection H as [= <-]. destruct y as [z|z|]. ++ elim (Hp _ H'). ++ apply (IHl e z); trivial. ++ discriminate. -- discriminate. Qed. End PositiveSet. coq-8.20.0/theories/FSets/FSetProperties.v000066400000000000000000001076311466560755400203700ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* constructor; congruence : fset. (** First, a functor for Weak Sets in functorial version. *) Module WProperties_fun (Import E : DecidableType)(M : WSfun E). Module Import Dec := WDecide_fun E M. Module Import FM := Dec.F (* FSetFacts.WFacts_fun E M *). Import M. Lemma In_dec : forall x s, {In x s} + {~ In x s}. Proof. intros; generalize (mem_iff s x); case (mem x s); intuition auto with bool. Qed. Definition Add x s s' := forall y, In y s' <-> E.eq x y \/ In y s. Lemma Add_Equal : forall x s s', Add x s s' <-> s' [=] add x s. Proof. unfold Add. split; intros. - red; intros. rewrite H; clear H. fsetdec. - fsetdec. Qed. Ltac expAdd := repeat rewrite Add_Equal. Section BasicProperties. Variable s s' s'' s1 s2 s3 : t. Variable x x' : elt. Lemma equal_refl : s[=]s. Proof. fsetdec. Qed. Lemma equal_sym : s[=]s' -> s'[=]s. Proof. fsetdec. Qed. Lemma equal_trans : s1[=]s2 -> s2[=]s3 -> s1[=]s3. Proof. fsetdec. Qed. Lemma subset_refl : s[<=]s. Proof. fsetdec. Qed. Lemma subset_trans : s1[<=]s2 -> s2[<=]s3 -> s1[<=]s3. Proof. fsetdec. Qed. Lemma subset_antisym : s[<=]s' -> s'[<=]s -> s[=]s'. Proof. fsetdec. Qed. Lemma subset_equal : s[=]s' -> s[<=]s'. Proof. fsetdec. Qed. Lemma subset_empty : empty[<=]s. Proof. fsetdec. Qed. Lemma subset_remove_3 : s1[<=]s2 -> remove x s1 [<=] s2. Proof. fsetdec. Qed. Lemma subset_diff : s1[<=]s3 -> diff s1 s2 [<=] s3. Proof. fsetdec. Qed. Lemma subset_add_3 : In x s2 -> s1[<=]s2 -> add x s1 [<=] s2. Proof. fsetdec. Qed. Lemma subset_add_2 : s1[<=]s2 -> s1[<=] add x s2. Proof. fsetdec. Qed. Lemma in_subset : In x s1 -> s1[<=]s2 -> In x s2. Proof. fsetdec. Qed. Lemma double_inclusion : s1[=]s2 <-> s1[<=]s2 /\ s2[<=]s1. Proof. intuition fsetdec. Qed. Lemma empty_is_empty_1 : Empty s -> s[=]empty. Proof. fsetdec. Qed. Lemma empty_is_empty_2 : s[=]empty -> Empty s. Proof. fsetdec. Qed. Lemma add_equal : In x s -> add x s [=] s. Proof. fsetdec. Qed. Lemma add_add : add x (add x' s) [=] add x' (add x s). Proof. fsetdec. Qed. Lemma remove_equal : ~ In x s -> remove x s [=] s. Proof. fsetdec. Qed. Lemma Equal_remove : s[=]s' -> remove x s [=] remove x s'. Proof. fsetdec. Qed. Lemma add_remove : In x s -> add x (remove x s) [=] s. Proof. fsetdec. Qed. Lemma remove_add : ~In x s -> remove x (add x s) [=] s. Proof. fsetdec. Qed. Lemma singleton_equal_add : singleton x [=] add x empty. Proof. fsetdec. Qed. Lemma remove_singleton_empty : In x s -> remove x s [=] empty -> singleton x [=] s. Proof. fsetdec. Qed. Lemma union_sym : union s s' [=] union s' s. Proof. fsetdec. Qed. Lemma union_subset_equal : s[<=]s' -> union s s' [=] s'. Proof. fsetdec. Qed. Lemma union_equal_1 : s[=]s' -> union s s'' [=] union s' s''. Proof. fsetdec. Qed. Lemma union_equal_2 : s'[=]s'' -> union s s' [=] union s s''. Proof. fsetdec. Qed. Lemma union_assoc : union (union s s') s'' [=] union s (union s' s''). Proof. fsetdec. Qed. Lemma add_union_singleton : add x s [=] union (singleton x) s. Proof. fsetdec. Qed. Lemma union_add : union (add x s) s' [=] add x (union s s'). Proof. fsetdec. Qed. Lemma union_remove_add_1 : union (remove x s) (add x s') [=] union (add x s) (remove x s'). Proof. fsetdec. Qed. Lemma union_remove_add_2 : In x s -> union (remove x s) (add x s') [=] union s s'. Proof. fsetdec. Qed. Lemma union_subset_1 : s [<=] union s s'. Proof. fsetdec. Qed. Lemma union_subset_2 : s' [<=] union s s'. Proof. fsetdec. Qed. Lemma union_subset_3 : s[<=]s'' -> s'[<=]s'' -> union s s' [<=] s''. Proof. fsetdec. Qed. Lemma union_subset_4 : s[<=]s' -> union s s'' [<=] union s' s''. Proof. fsetdec. Qed. Lemma union_subset_5 : s[<=]s' -> union s'' s [<=] union s'' s'. Proof. fsetdec. Qed. Lemma empty_union_1 : Empty s -> union s s' [=] s'. Proof. fsetdec. Qed. Lemma empty_union_2 : Empty s -> union s' s [=] s'. Proof. fsetdec. Qed. Lemma not_in_union : ~In x s -> ~In x s' -> ~In x (union s s'). Proof. fsetdec. Qed. Lemma inter_sym : inter s s' [=] inter s' s. Proof. fsetdec. Qed. Lemma inter_subset_equal : s[<=]s' -> inter s s' [=] s. Proof. fsetdec. Qed. Lemma inter_equal_1 : s[=]s' -> inter s s'' [=] inter s' s''. Proof. fsetdec. Qed. Lemma inter_equal_2 : s'[=]s'' -> inter s s' [=] inter s s''. Proof. fsetdec. Qed. Lemma inter_assoc : inter (inter s s') s'' [=] inter s (inter s' s''). Proof. fsetdec. Qed. Lemma union_inter_1 : inter (union s s') s'' [=] union (inter s s'') (inter s' s''). Proof. fsetdec. Qed. Lemma union_inter_2 : union (inter s s') s'' [=] inter (union s s'') (union s' s''). Proof. fsetdec. Qed. Lemma inter_add_1 : In x s' -> inter (add x s) s' [=] add x (inter s s'). Proof. fsetdec. Qed. Lemma inter_add_2 : ~ In x s' -> inter (add x s) s' [=] inter s s'. Proof. fsetdec. Qed. Lemma empty_inter_1 : Empty s -> Empty (inter s s'). Proof. fsetdec. Qed. Lemma empty_inter_2 : Empty s' -> Empty (inter s s'). Proof. fsetdec. Qed. Lemma inter_subset_1 : inter s s' [<=] s. Proof. fsetdec. Qed. Lemma inter_subset_2 : inter s s' [<=] s'. Proof. fsetdec. Qed. Lemma inter_subset_3 : s''[<=]s -> s''[<=]s' -> s''[<=] inter s s'. Proof. fsetdec. Qed. Lemma empty_diff_1 : Empty s -> Empty (diff s s'). Proof. fsetdec. Qed. Lemma empty_diff_2 : Empty s -> diff s' s [=] s'. Proof. fsetdec. Qed. Lemma diff_subset : diff s s' [<=] s. Proof. fsetdec. Qed. Lemma diff_subset_equal : s[<=]s' -> diff s s' [=] empty. Proof. fsetdec. Qed. Lemma remove_diff_singleton : remove x s [=] diff s (singleton x). Proof. fsetdec. Qed. Lemma diff_inter_empty : inter (diff s s') (inter s s') [=] empty. Proof. fsetdec. Qed. Lemma diff_inter_all : union (diff s s') (inter s s') [=] s. Proof. fsetdec. Qed. Lemma Add_add : Add x s (add x s). Proof. expAdd; fsetdec. Qed. Lemma Add_remove : In x s -> Add x (remove x s) s. Proof. expAdd; fsetdec. Qed. Lemma union_Add : Add x s s' -> Add x (union s s'') (union s' s''). Proof. expAdd; fsetdec. Qed. Lemma inter_Add : In x s'' -> Add x s s' -> Add x (inter s s'') (inter s' s''). Proof. expAdd; fsetdec. Qed. Lemma union_Equal : In x s'' -> Add x s s' -> union s s'' [=] union s' s''. Proof. expAdd; fsetdec. Qed. Lemma inter_Add_2 : ~In x s'' -> Add x s s' -> inter s s'' [=] inter s' s''. Proof. expAdd; fsetdec. Qed. End BasicProperties. #[global] Hint Immediate equal_sym add_remove remove_add union_sym inter_sym: set. #[global] Hint Resolve equal_refl equal_trans subset_refl subset_equal subset_antisym subset_trans subset_empty subset_remove_3 subset_diff subset_add_3 subset_add_2 in_subset empty_is_empty_1 empty_is_empty_2 add_equal remove_equal singleton_equal_add union_subset_equal union_equal_1 union_equal_2 union_assoc add_union_singleton union_add union_subset_1 union_subset_2 union_subset_3 inter_subset_equal inter_equal_1 inter_equal_2 inter_assoc union_inter_1 union_inter_2 inter_add_1 inter_add_2 empty_inter_1 empty_inter_2 empty_union_1 empty_union_2 empty_diff_1 empty_diff_2 union_Add inter_Add union_Equal inter_Add_2 not_in_union inter_subset_1 inter_subset_2 inter_subset_3 diff_subset diff_subset_equal remove_diff_singleton diff_inter_empty diff_inter_all Add_add Add_remove Equal_remove add_add : set. (** * Properties of elements *) Lemma elements_Empty : forall s, Empty s <-> elements s = nil. Proof. intros. unfold Empty. split; intros. - assert (forall a, ~ List.In a (elements s)). { red; intros. apply (H a). rewrite elements_iff. rewrite InA_alt; exists a; auto. } destruct (elements s); auto. elim (H0 e); simpl; auto. - red; intros. rewrite elements_iff in H0. rewrite InA_alt in H0; destruct H0. rewrite H in H0; destruct H0 as (_,H0); inversion H0. Qed. Lemma elements_empty : elements empty = nil. Proof. rewrite <-elements_Empty; auto with set. Qed. (** * Conversions between lists and sets *) Definition of_list (l : list elt) := List.fold_right add empty l. Definition to_list := elements. Lemma of_list_1 : forall l x, In x (of_list l) <-> InA E.eq x l. Proof. induction l; simpl; intro x. - rewrite empty_iff, InA_nil. intuition. - rewrite add_iff, InA_cons, IHl. intuition. Qed. Lemma of_list_2 : forall l, equivlistA E.eq (to_list (of_list l)) l. Proof. unfold to_list; red; intros. rewrite <- elements_iff; apply of_list_1. Qed. Lemma of_list_3 : forall s, of_list (to_list s) [=] s. Proof. unfold to_list; red; intros. rewrite of_list_1; symmetry; apply elements_iff. Qed. (** * Fold *) Section Fold. (** Alternative specification via [fold_right] *) Lemma fold_spec_right (s:t)(A:Type)(i:A)(f : elt -> A -> A) : fold f s i = List.fold_right f i (rev (elements s)). Proof. rewrite fold_1. symmetry. apply fold_left_rev_right. Qed. Notation NoDup := (NoDupA E.eq). Notation InA := (InA E.eq). (** ** Induction principles for fold (contributed by S. Lescuyer) *) (** In the following lemma, the step hypothesis is deliberately restricted to the precise set s we are considering. *) Theorem fold_rec : forall (A:Type)(P : t -> A -> Type)(f : elt -> A -> A)(i:A)(s:t), (forall s', Empty s' -> P s' i) -> (forall x a s' s'', In x s -> ~In x s' -> Add x s' s'' -> P s' a -> P s'' (f x a)) -> P s (fold f s i). Proof. intros A P f i s Pempty Pstep. rewrite fold_spec_right. set (l:=rev (elements s)). assert (Pstep' : forall x a s' s'', InA x l -> ~In x s' -> Add x s' s'' -> P s' a -> P s'' (f x a)). { intros; eapply Pstep; eauto. rewrite elements_iff, <- InA_rev; auto. } assert (Hdup : NoDup l) by (unfold l; eauto using elements_3w, NoDupA_rev with *). assert (Hsame : forall x, In x s <-> InA x l) by (unfold l; intros; rewrite elements_iff, InA_rev; intuition). clear Pstep; clearbody l; revert s Hsame; induction l. - (* empty *) intros s Hsame; simpl. apply Pempty. intro x. rewrite Hsame, InA_nil; intuition. - (* step *) intros s Hsame; simpl. apply Pstep' with (of_list l); auto. + inversion_clear Hdup; rewrite of_list_1; auto. + red. intros. rewrite Hsame, of_list_1, InA_cons; intuition. + apply IHl. * intros; eapply Pstep'; eauto. * inversion_clear Hdup; auto. * exact (of_list_1 l). Qed. (** Same, with [empty] and [add] instead of [Empty] and [Add]. In this case, [P] must be compatible with equality of sets *) Theorem fold_rec_bis : forall (A:Type)(P : t -> A -> Type)(f : elt -> A -> A)(i:A)(s:t), (forall s s' a, s[=]s' -> P s a -> P s' a) -> (P empty i) -> (forall x a s', In x s -> ~In x s' -> P s' a -> P (add x s') (f x a)) -> P s (fold f s i). Proof. intros A P f i s Pmorphism Pempty Pstep. apply fold_rec; intros. - apply Pmorphism with empty; auto with set. - rewrite Add_Equal in H1; auto with set. apply Pmorphism with (add x s'); auto with set. Qed. Lemma fold_rec_nodep : forall (A:Type)(P : A -> Type)(f : elt -> A -> A)(i:A)(s:t), P i -> (forall x a, In x s -> P a -> P (f x a)) -> P (fold f s i). Proof. intros; apply fold_rec_bis with (P:=fun _ => P); auto. Qed. (** [fold_rec_weak] is a weaker principle than [fold_rec_bis] : the step hypothesis must here be applicable to any [x]. At the same time, it looks more like an induction principle, and hence can be easier to use. *) Lemma fold_rec_weak : forall (A:Type)(P : t -> A -> Type)(f : elt -> A -> A)(i:A), (forall s s' a, s[=]s' -> P s a -> P s' a) -> P empty i -> (forall x a s, ~In x s -> P s a -> P (add x s) (f x a)) -> forall s, P s (fold f s i). Proof. intros; apply fold_rec_bis; auto. Qed. Lemma fold_rel : forall (A B:Type)(R : A -> B -> Type) (f : elt -> A -> A)(g : elt -> B -> B)(i : A)(j : B)(s : t), R i j -> (forall x a b, In x s -> R a b -> R (f x a) (g x b)) -> R (fold f s i) (fold g s j). Proof. intros A B R f g i j s Rempty Rstep. rewrite 2 fold_spec_right. set (l:=rev (elements s)). assert (Rstep' : forall x a b, InA x l -> R a b -> R (f x a) (g x b)) by (intros; apply Rstep; auto; rewrite elements_iff, <- InA_rev; auto). clearbody l; clear Rstep s. induction l; simpl; auto. Qed. (** From the induction principle on [fold], we can deduce some general induction principles on sets. *) Lemma set_induction : forall P : t -> Type, (forall s, Empty s -> P s) -> (forall s s', P s -> forall x, ~In x s -> Add x s s' -> P s') -> forall s, P s. Proof. intros. apply (@fold_rec _ (fun s _ => P s) (fun _ _ => tt) tt s); eauto. Qed. Lemma set_induction_bis : forall P : t -> Type, (forall s s', s [=] s' -> P s -> P s') -> P empty -> (forall x s, ~In x s -> P s -> P (add x s)) -> forall s, P s. Proof. intros. apply (@fold_rec_bis _ (fun s _ => P s) (fun _ _ => tt) tt s); eauto. Qed. (** [fold] can be used to reconstruct the same initial set. *) Lemma fold_identity : forall s, fold add s empty [=] s. Proof. intros. apply fold_rec with (P:=fun s acc => acc[=]s); auto with set. intros. rewrite H2; rewrite Add_Equal in H1; auto with set. Qed. (** ** Alternative (weaker) specifications for [fold] *) (** When [FSets] was first designed, the order in which Ocaml's [Set.fold] takes the set elements was unspecified. This specification reflects this fact: *) Lemma fold_0 : forall s (A : Type) (i : A) (f : elt -> A -> A), exists l : list elt, NoDup l /\ (forall x : elt, In x s <-> InA x l) /\ fold f s i = fold_right f i l. Proof. intros; exists (rev (elements s)); split. - apply NoDupA_rev. + auto with typeclass_instances. + auto with set. - split; intros. + rewrite elements_iff; do 2 rewrite InA_alt. split; destruct 1; generalize (In_rev (elements s) x0); exists x0; intuition. + apply fold_spec_right. Qed. (** An alternate (and previous) specification for [fold] was based on the recursive structure of a set. It is now lemmas [fold_1] and [fold_2]. *) Lemma fold_1 : forall s (A : Type) (eqA : A -> A -> Prop) (st : Equivalence eqA) (i : A) (f : elt -> A -> A), Empty s -> eqA (fold f s i) i. Proof. unfold Empty; intros; destruct (fold_0 s i f) as (l,(H1, (H2, H3))). rewrite H3; clear H3. generalize H H2; clear H H2; case l; simpl; intros. - reflexivity. - elim (H e). elim (H2 e); intuition. Qed. Lemma fold_2 : forall s s' x (A : Type) (eqA : A -> A -> Prop) (st : Equivalence eqA) (i : A) (f : elt -> A -> A), compat_op E.eq eqA f -> transpose eqA f -> ~ In x s -> Add x s s' -> eqA (fold f s' i) (f x (fold f s i)). Proof. intros; destruct (fold_0 s i f) as (l,(Hl, (Hl1, Hl2))); destruct (fold_0 s' i f) as (l',(Hl', (Hl'1, Hl'2))). rewrite Hl2; rewrite Hl'2; clear Hl2 Hl'2. apply fold_right_add with (eqA:=E.eq)(eqB:=eqA). { auto with typeclass_instances. } 1-5: auto. - rewrite <- Hl1; auto. - intros a; rewrite InA_cons; rewrite <- Hl1; rewrite <- Hl'1; rewrite (H2 a); intuition. Qed. (** In fact, [fold] on empty sets is more than equivalent to the initial element, it is Leibniz-equal to it. *) Lemma fold_1b : forall s (A : Type)(i : A) (f : elt -> A -> A), Empty s -> (fold f s i) = i. Proof. intros. rewrite M.fold_1. rewrite elements_Empty in H; rewrite H; simpl; auto. Qed. Section Fold_More. Variables (A:Type)(eqA:A->A->Prop)(st:Equivalence eqA). Variables (f:elt->A->A)(Comp:compat_op E.eq eqA f)(Ass:transpose eqA f). Lemma fold_commutes : forall i s x, eqA (fold f s (f x i)) (f x (fold f s i)). Proof. intros. apply fold_rel with (R:=fun u v => eqA u (f x v)); intros. - reflexivity. - transitivity (f x0 (f x b)); auto. apply Comp; auto. Qed. (** ** Fold is a morphism *) Lemma fold_init : forall i i' s, eqA i i' -> eqA (fold f s i) (fold f s i'). Proof. intros. apply fold_rel with (R:=eqA); auto. intros; apply Comp; auto. Qed. Lemma fold_equal : forall i s s', s[=]s' -> eqA (fold f s i) (fold f s' i). Proof. intros i s; pattern s; apply set_induction; clear s; intros. - transitivity i. + apply fold_1; auto. + symmetry; apply fold_1; auto. rewrite <- H0; auto. - transitivity (f x (fold f s i)). + apply fold_2 with (eqA := eqA); auto. + symmetry; apply fold_2 with (eqA := eqA); auto. unfold Add in *; intros. rewrite <- H2; auto. Qed. (** ** Fold and other set operators *) Lemma fold_empty : forall i, fold f empty i = i. Proof. intros i; apply fold_1b; auto with set. Qed. Lemma fold_add : forall i s x, ~In x s -> eqA (fold f (add x s) i) (f x (fold f s i)). Proof. intros; apply fold_2 with (eqA := eqA); auto with set. Qed. Lemma add_fold : forall i s x, In x s -> eqA (fold f (add x s) i) (fold f s i). Proof. intros; apply fold_equal; auto with set. Qed. Lemma remove_fold_1: forall i s x, In x s -> eqA (f x (fold f (remove x s) i)) (fold f s i). Proof. intros. symmetry. apply fold_2 with (eqA:=eqA); auto with set. Qed. Lemma remove_fold_2: forall i s x, ~In x s -> eqA (fold f (remove x s) i) (fold f s i). Proof. intros. apply fold_equal; auto with set. Qed. Lemma fold_union_inter : forall i s s', eqA (fold f (union s s') (fold f (inter s s') i)) (fold f s (fold f s' i)). Proof. intros; pattern s; apply set_induction; clear s; intros. - transitivity (fold f s' (fold f (inter s s') i)). { apply fold_equal; auto with set. } transitivity (fold f s' i). + apply fold_init; auto. apply fold_1; auto with set. + symmetry; apply fold_1; auto. - rename s'0 into s''. destruct (In_dec x s'). + (* In x s' *) transitivity (fold f (union s'' s') (f x (fold f (inter s s') i))); auto with set. * apply fold_init; auto. apply fold_2 with (eqA:=eqA); auto with set. rewrite inter_iff; intuition. * transitivity (f x (fold f s (fold f s' i))). 1:transitivity (fold f (union s s') (f x (fold f (inter s s') i))). -- apply fold_equal; auto. apply equal_sym; apply union_Equal with x; auto with set. -- transitivity (f x (fold f (union s s') (fold f (inter s s') i))). { apply fold_commutes; auto. } apply Comp; auto. -- symmetry; apply fold_2 with (eqA:=eqA); auto. + (* ~(In x s') *) transitivity (f x (fold f (union s s') (fold f (inter s'' s') i))). { apply fold_2 with (eqA:=eqA); auto with set. } transitivity (f x (fold f (union s s') (fold f (inter s s') i))). * apply Comp;auto. apply fold_init;auto. apply fold_equal;auto. apply equal_sym; apply inter_Add_2 with x; auto with set. * transitivity (f x (fold f s (fold f s' i))). -- apply Comp; auto. -- symmetry; apply fold_2 with (eqA:=eqA); auto. Qed. Lemma fold_diff_inter : forall i s s', eqA (fold f (diff s s') (fold f (inter s s') i)) (fold f s i). Proof. intros. transitivity (fold f (union (diff s s') (inter s s')) (fold f (inter (diff s s') (inter s s')) i)). { symmetry; apply fold_union_inter; auto. } transitivity (fold f s (fold f (inter (diff s s') (inter s s')) i)). { apply fold_equal; auto with set. } apply fold_init; auto. apply fold_1; auto with set. Qed. Lemma fold_union: forall i s s', (forall x, ~(In x s/\In x s')) -> eqA (fold f (union s s') i) (fold f s (fold f s' i)). Proof. intros. transitivity (fold f (union s s') (fold f (inter s s') i)). { apply fold_init; auto. symmetry; apply fold_1; auto with set. unfold Empty; intro a; generalize (H a); set_iff; tauto. } apply fold_union_inter; auto. Qed. End Fold_More. Lemma fold_plus : forall s p, fold (fun _ => S) s p = fold (fun _ => S) s 0 + p. Proof. intros. apply fold_rel with (R:=fun u v => u = v + p); simpl; auto. Qed. End Fold. (** * Cardinal *) (** ** Characterization of cardinal in terms of fold *) Lemma cardinal_fold : forall s, cardinal s = fold (fun _ => S) s 0. Proof. intros; rewrite cardinal_1; rewrite M.fold_1. symmetry; apply fold_left_S_O; auto. Qed. (** ** Old specifications for [cardinal]. *) Lemma cardinal_0 : forall s, exists l : list elt, NoDupA E.eq l /\ (forall x : elt, In x s <-> InA E.eq x l) /\ cardinal s = length l. Proof. intros; exists (elements s); intuition auto with set; apply cardinal_1. Qed. Lemma cardinal_1 : forall s, Empty s -> cardinal s = 0. Proof. intros; rewrite cardinal_fold; apply fold_1; auto with fset. Qed. Lemma cardinal_2 : forall s s' x, ~ In x s -> Add x s s' -> cardinal s' = S (cardinal s). Proof. intros; do 2 rewrite cardinal_fold. change S with ((fun _ => S) x). apply fold_2; auto with fset. Qed. (** ** Cardinal and (non-)emptiness *) Lemma cardinal_Empty : forall s, Empty s <-> cardinal s = 0. Proof. intros. rewrite elements_Empty, M.cardinal_1. destruct (elements s); intuition; discriminate. Qed. Lemma cardinal_inv_1 : forall s, cardinal s = 0 -> Empty s. Proof. intros; rewrite cardinal_Empty; auto. Qed. #[global] Hint Resolve cardinal_inv_1 : fset. Lemma cardinal_inv_2 : forall s n, cardinal s = S n -> { x : elt | In x s }. Proof. intros; rewrite M.cardinal_1 in H. generalize (elements_2 (s:=s)). destruct (elements s); try discriminate. exists e; auto. Qed. Lemma cardinal_inv_2b : forall s, cardinal s <> 0 -> { x : elt | In x s }. Proof. intro; generalize (@cardinal_inv_2 s); destruct cardinal; [intuition|eauto]. Qed. (** ** Cardinal is a morphism *) Lemma Equal_cardinal : forall s s', s[=]s' -> cardinal s = cardinal s'. Proof. symmetry. remember (cardinal s) as n; symmetry in Heqn; revert s s' Heqn H. induction n; intros. - apply cardinal_1; rewrite <- H; auto with fset. - destruct (cardinal_inv_2 Heqn) as (x,H2). revert Heqn. rewrite (cardinal_2 (s:=remove x s) (s':=s) (x:=x)); auto with set. rewrite (cardinal_2 (s:=remove x s') (s':=s') (x:=x)); eauto with set. Qed. Add Morphism cardinal with signature (Equal ==> Logic.eq) as cardinal_m. Proof. exact Equal_cardinal. Qed. #[global] Hint Resolve Add_add Add_remove Equal_remove cardinal_inv_1 Equal_cardinal : fset. (** ** Cardinal and set operators *) Lemma empty_cardinal : cardinal empty = 0. Proof. rewrite cardinal_fold; apply fold_1; auto with set fset. Qed. #[global] Hint Immediate empty_cardinal cardinal_1 : set. Lemma singleton_cardinal : forall x, cardinal (singleton x) = 1. Proof. intros. rewrite (singleton_equal_add x). replace 0 with (cardinal empty); auto with set. apply cardinal_2 with x; auto with set. Qed. #[global] Hint Resolve singleton_cardinal: set. Lemma diff_inter_cardinal : forall s s', cardinal (diff s s') + cardinal (inter s s') = cardinal s . Proof. intros; do 3 rewrite cardinal_fold. rewrite <- fold_plus. apply fold_diff_inter with (eqA:=@Logic.eq nat); auto with fset. Qed. Lemma union_cardinal: forall s s', (forall x, ~(In x s/\In x s')) -> cardinal (union s s')=cardinal s+cardinal s'. Proof. intros; do 3 rewrite cardinal_fold. rewrite <- fold_plus. apply fold_union; auto with fset. Qed. Lemma subset_cardinal : forall s s', s[<=]s' -> cardinal s <= cardinal s' . Proof. intros. rewrite <- (diff_inter_cardinal s' s). rewrite (inter_sym s' s). rewrite (inter_subset_equal H). apply Nat.le_add_l. Qed. Lemma subset_cardinal_lt : forall s s' x, s[<=]s' -> In x s' -> ~In x s -> cardinal s < cardinal s'. Proof. intros. rewrite <- (diff_inter_cardinal s' s). rewrite (inter_sym s' s). rewrite (inter_subset_equal H). generalize (@cardinal_inv_1 (diff s' s)). destruct (cardinal (diff s' s)). - intro H2; destruct (H2 Logic.eq_refl x). set_iff; auto. - intros _. change (0 + cardinal s < S n + cardinal s). apply Nat.add_lt_le_mono; [ apply Nat.lt_0_succ | reflexivity ]. Qed. Theorem union_inter_cardinal : forall s s', cardinal (union s s') + cardinal (inter s s') = cardinal s + cardinal s' . Proof. intros. do 4 rewrite cardinal_fold. do 2 rewrite <- fold_plus. apply fold_union_inter with (eqA:=@Logic.eq nat); auto with fset. Qed. Lemma union_cardinal_inter : forall s s', cardinal (union s s') = cardinal s + cardinal s' - cardinal (inter s s'). Proof. intros. rewrite <- union_inter_cardinal, Nat.add_sub. reflexivity. Qed. Lemma union_cardinal_le : forall s s', cardinal (union s s') <= cardinal s + cardinal s'. Proof. intros; generalize (union_inter_cardinal s s'). intros; rewrite <- H; auto with arith. Qed. Lemma add_cardinal_1 : forall s x, In x s -> cardinal (add x s) = cardinal s. Proof. auto with set fset. Qed. Lemma add_cardinal_2 : forall s x, ~In x s -> cardinal (add x s) = S (cardinal s). Proof. intros. do 2 rewrite cardinal_fold. change S with ((fun _ => S) x); apply fold_add with (eqA:=@Logic.eq nat); auto with fset. Qed. Lemma remove_cardinal_1 : forall s x, In x s -> S (cardinal (remove x s)) = cardinal s. Proof. intros. do 2 rewrite cardinal_fold. change S with ((fun _ =>S) x). apply remove_fold_1 with (eqA:=@Logic.eq nat); auto with fset. Qed. Lemma remove_cardinal_2 : forall s x, ~In x s -> cardinal (remove x s) = cardinal s. Proof. auto with set fset. Qed. #[global] Hint Resolve subset_cardinal union_cardinal add_cardinal_1 add_cardinal_2 : fset. End WProperties_fun. (** Now comes variants for self-contained weak sets and for full sets. For these variants, only one argument is necessary. Thanks to the subtyping [WS<=S], the [Properties] functor which is meant to be used on modules [(M:S)] can simply be an alias of [WProperties]. *) Module WProperties (M:WS) := WProperties_fun M.E M. Module Properties := WProperties. (** Now comes some properties specific to the element ordering, invalid for Weak Sets. *) Module OrdProperties (M:S). Module ME:=OrderedTypeFacts(M.E). Module Import P := Properties M. Import FM. Import M.E. Import M. (** First, a specialized version of SortA_equivlistA_eqlistA: *) Lemma sort_equivlistA_eqlistA : forall l l' : list elt, sort E.lt l -> sort E.lt l' -> equivlistA E.eq l l' -> eqlistA E.eq l l'. Proof. apply SortA_equivlistA_eqlistA; auto with typeclass_instances. Qed. Definition gtb x y := match E.compare x y with GT _ => true | _ => false end. Definition leb x := fun y => negb (gtb x y). Definition elements_lt x s := List.filter (gtb x) (elements s). Definition elements_ge x s := List.filter (leb x) (elements s). Lemma gtb_1 : forall x y, gtb x y = true <-> E.lt y x. Proof. intros; unfold gtb; destruct (E.compare x y); intuition; try discriminate; ME.order. Qed. Lemma leb_1 : forall x y, leb x y = true <-> ~E.lt y x. Proof. intros; unfold leb, gtb; destruct (E.compare x y); intuition try discriminate; ME.order. Qed. Lemma gtb_compat : forall x, Proper (E.eq==>Logic.eq) (gtb x). Proof. red; intros x a b H. generalize (gtb_1 x a)(gtb_1 x b); destruct (gtb x a); destruct (gtb x b); auto. - intros. symmetry; rewrite H1. apply ME.eq_lt with a; auto with ordered_type. rewrite <- H0; auto. - intros. rewrite H0. apply ME.eq_lt with b; auto. rewrite <- H1; auto. Qed. Lemma leb_compat : forall x, Proper (E.eq==>Logic.eq) (leb x). Proof. red; intros x a b H; unfold leb. f_equal; apply gtb_compat; auto. Qed. #[global] Hint Resolve gtb_compat leb_compat : fset. Lemma elements_split : forall x s, elements s = elements_lt x s ++ elements_ge x s. Proof. unfold elements_lt, elements_ge, leb; intros. eapply (@filter_split _ E.eq _ E.lt). 1-2: auto with typeclass_instances. 2: auto with set. intros. rewrite gtb_1 in H. assert (~E.lt y x). { unfold gtb in *; destruct (E.compare x y); intuition try discriminate; ME.order. } ME.order. Qed. Lemma elements_Add : forall s s' x, ~In x s -> Add x s s' -> eqlistA E.eq (elements s') (elements_lt x s ++ x :: elements_ge x s). Proof. intros; unfold elements_ge, elements_lt. apply sort_equivlistA_eqlistA; auto with set. - apply (@SortA_app _ E.eq). { auto with typeclass_instances. } + apply (@filter_sort _ E.eq). 1-3: auto with typeclass_instances. auto with set. + constructor; auto. * apply (@filter_sort _ E.eq). 1-3: auto with typeclass_instances. auto with set. * rewrite ME.Inf_alt by (apply (@filter_sort _ E.eq); auto with set typeclass_instances). intros. rewrite filter_InA in H1 by auto with fset. destruct H1. rewrite leb_1 in H2. rewrite <- elements_iff in H1. assert (~E.eq x y). { contradict H; rewrite H; auto. } ME.order. + intros. rewrite filter_InA in H1 by auto with fset. destruct H1. rewrite gtb_1 in H3. inversion_clear H2. * ME.order. * rewrite filter_InA in H4 by auto with fset. destruct H4. rewrite leb_1 in H4. ME.order. - red; intros a. rewrite InA_app_iff, InA_cons, !filter_InA, <-elements_iff, leb_1, gtb_1, (H0 a) by auto with fset. intuition auto with relations set. destruct (E.compare a x); intuition auto with set. fold (~E.lt a x); auto with ordered_type set. Qed. Definition Above x s := forall y, In y s -> E.lt y x. Definition Below x s := forall y, In y s -> E.lt x y. Lemma elements_Add_Above : forall s s' x, Above x s -> Add x s s' -> eqlistA E.eq (elements s') (elements s ++ x::nil). Proof. intros. apply sort_equivlistA_eqlistA. { auto with set. } - apply (@SortA_app _ E.eq). + auto with typeclass_instances. + auto with set. + auto. + intros. inversion_clear H2. * rewrite <- elements_iff in H1. apply ME.lt_eq with x; auto with ordered_type. * inversion H3. - red; intros a. rewrite InA_app_iff, InA_cons, InA_nil. do 2 rewrite <- elements_iff; rewrite (H0 a); intuition auto with relations. Qed. Lemma elements_Add_Below : forall s s' x, Below x s -> Add x s s' -> eqlistA E.eq (elements s') (x::elements s). Proof. intros. apply sort_equivlistA_eqlistA. - auto with set. - change (sort E.lt ((x::nil) ++ elements s)). apply (@SortA_app _ E.eq). + auto with typeclass_instances. + auto. + auto with set. + intros. inversion_clear H1. * rewrite <- elements_iff in H2. apply ME.eq_lt with x; auto. * inversion H3. - red; intros a. rewrite InA_cons. do 2 rewrite <- elements_iff; rewrite (H0 a); intuition auto with relations. Qed. (** Two other induction principles on sets: we can be more restrictive on the element we add at each step. *) Lemma set_induction_max : forall P : t -> Type, (forall s : t, Empty s -> P s) -> (forall s s', P s -> forall x, Above x s -> Add x s s' -> P s') -> forall s : t, P s. Proof. intros; remember (cardinal s) as n; revert s Heqn; induction n; intros; auto with fset. case_eq (max_elt s); intros. - apply X0 with (remove e s) e; auto with set. + apply IHn. assert (S n = S (cardinal (remove e s))). { rewrite Heqn; apply cardinal_2 with e; auto with set ordered_type. } inversion H0; auto. + red; intros. rewrite remove_iff in H0; destruct H0. generalize (@max_elt_2 s e y H H0); ME.order. - assert (H0:=max_elt_3 H). rewrite cardinal_Empty in H0; rewrite H0 in Heqn; inversion Heqn. Qed. Lemma set_induction_min : forall P : t -> Type, (forall s : t, Empty s -> P s) -> (forall s s', P s -> forall x, Below x s -> Add x s s' -> P s') -> forall s : t, P s. Proof. intros; remember (cardinal s) as n; revert s Heqn; induction n; intros; auto with fset. case_eq (min_elt s); intros. - apply X0 with (remove e s) e; auto with set. + apply IHn. assert (S n = S (cardinal (remove e s))). { rewrite Heqn; apply cardinal_2 with e; auto with set ordered_type. } inversion H0; auto. + red; intros. rewrite remove_iff in H0; destruct H0. generalize (@min_elt_2 s e y H H0); ME.order. - assert (H0:=min_elt_3 H). rewrite cardinal_Empty in H0; auto; rewrite H0 in Heqn; inversion Heqn. Qed. (** More properties of [fold] : behavior with respect to Above/Below *) Lemma fold_3 : forall s s' x (A : Type) (eqA : A -> A -> Prop) (st : Equivalence eqA) (i : A) (f : elt -> A -> A), compat_op E.eq eqA f -> Above x s -> Add x s s' -> eqA (fold f s' i) (f x (fold f s i)). Proof. intros. rewrite 2 fold_spec_right. change (f x (fold_right f i (rev (elements s)))) with (fold_right f i (rev (x::nil)++rev (elements s))). apply (@fold_right_eqlistA E.t E.eq A eqA st); auto. rewrite <- distr_rev. apply eqlistA_rev. apply elements_Add_Above; auto. Qed. Lemma fold_4 : forall s s' x (A : Type) (eqA : A -> A -> Prop) (st : Equivalence eqA) (i : A) (f : elt -> A -> A), compat_op E.eq eqA f -> Below x s -> Add x s s' -> eqA (fold f s' i) (fold f s (f x i)). Proof. intros. rewrite 2 M.fold_1. set (g:=fun (a : A) (e : elt) => f e a). change (eqA (fold_left g (elements s') i) (fold_left g (x::elements s) i)). unfold g. rewrite <- 2 fold_left_rev_right. apply (@fold_right_eqlistA E.t E.eq A eqA st); auto. apply eqlistA_rev. apply elements_Add_Below; auto. Qed. (** The following results have already been proved earlier, but we can now prove them with one hypothesis less: no need for [(transpose eqA f)]. *) Section FoldOpt. Variables (A:Type)(eqA:A->A->Prop)(st:Equivalence eqA). Variables (f:elt->A->A)(Comp:compat_op E.eq eqA f). Lemma fold_equal : forall i s s', s[=]s' -> eqA (fold f s i) (fold f s' i). Proof. intros. rewrite 2 fold_spec_right. apply (@fold_right_eqlistA E.t E.eq A eqA st); auto. apply eqlistA_rev. apply sort_equivlistA_eqlistA; auto with set. red; intro a; do 2 rewrite <- elements_iff; auto. Qed. Lemma add_fold : forall i s x, In x s -> eqA (fold f (add x s) i) (fold f s i). Proof. intros; apply fold_equal; auto with set. Qed. Lemma remove_fold_2: forall i s x, ~In x s -> eqA (fold f (remove x s) i) (fold f s i). Proof. intros. apply fold_equal; auto with set. Qed. End FoldOpt. (** An alternative version of [choose_3] *) Lemma choose_equal : forall s s', Equal s s' -> match choose s, choose s' with | Some x, Some x' => E.eq x x' | None, None => True | _, _ => False end. Proof. intros s s' H; generalize (@choose_1 s)(@choose_2 s) (@choose_1 s')(@choose_2 s')(@choose_3 s s'); destruct (choose s); destruct (choose s'); simpl; intuition. - apply H5 with e; rewrite <-H; auto. - apply H5 with e; rewrite H; auto. Qed. End OrdProperties. coq-8.20.0/theories/FSets/FSetToFiniteSet.v000066400000000000000000000113251466560755400204230ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* Ensemble M.elt := fun s x => M.In x s. Notation " !! " := mkEns. Lemma In_In : forall s x, M.In x s <-> In _ (!!s) x. Proof. unfold In; compute; auto with extcore. Qed. Lemma Subset_Included : forall s s', s[<=]s' <-> Included _ (!!s) (!!s'). Proof. unfold Subset, Included, In, mkEns; intuition. Qed. Notation " a === b " := (Same_set M.elt a b) (at level 70, no associativity). Lemma Equal_Same_set : forall s s', s[=]s' <-> !!s === !!s'. Proof. intros. rewrite double_inclusion. unfold Subset, Included, Same_set, In, mkEns; intuition. Qed. Lemma empty_Empty_Set : !!M.empty === Empty_set _. Proof. unfold Same_set, Included, mkEns, In. split; intro; set_iff; inversion 1. Qed. Lemma Empty_Empty_set : forall s, Empty s -> !!s === Empty_set _. Proof. unfold Same_set, Included, mkEns, In. split; intros. - destruct(H x H0). - inversion H0. Qed. Lemma singleton_Singleton : forall x, !!(M.singleton x) === Singleton _ x . Proof. unfold Same_set, Included, mkEns, In. split; intro; set_iff; inversion 1; try constructor; auto. Qed. Lemma union_Union : forall s s', !!(union s s') === Union _ (!!s) (!!s'). Proof. unfold Same_set, Included, mkEns, In. split; intro; set_iff; inversion 1; [ constructor 1 | constructor 2 | | ]; auto. Qed. Lemma inter_Intersection : forall s s', !!(inter s s') === Intersection _ (!!s) (!!s'). Proof. unfold Same_set, Included, mkEns, In. split; intro; set_iff; inversion 1; try constructor; auto. Qed. Lemma add_Add : forall x s, !!(add x s) === Add _ (!!s) x. Proof. unfold Same_set, Included, mkEns, In. split; intro; set_iff; inversion 1; auto with sets. - inversion H0. constructor 2; constructor. - constructor 1; auto. Qed. Lemma Add_Add : forall x s s', MP.Add x s s' -> !!s' === Add _ (!!s) x. Proof. unfold Same_set, Included, mkEns, In. split; intros. - red in H; rewrite H in H0. destruct H0. + inversion H0. constructor 2; constructor. + constructor 1; auto. - red in H; rewrite H. inversion H0; auto. inversion H1; auto. Qed. Lemma remove_Subtract : forall x s, !!(remove x s) === Subtract _ (!!s) x. Proof. unfold Same_set, Included, mkEns, In. split; intro; set_iff; inversion 1; auto with sets. split; auto. contradict H1. inversion H1; auto. Qed. Lemma mkEns_Finite : forall s, Finite _ (!!s). Proof. intro s; pattern s; apply set_induction; clear s; intros. - intros; replace (!!s) with (Empty_set elt); auto with sets. symmetry; apply Extensionality_Ensembles. apply Empty_Empty_set; auto. - replace (!!s') with (Add _ (!!s) x). + constructor 2; auto. + symmetry; apply Extensionality_Ensembles. apply Add_Add; auto. Qed. Lemma mkEns_cardinal : forall s, cardinal _ (!!s) (M.cardinal s). Proof. intro s; pattern s; apply set_induction; clear s; intros. - intros; replace (!!s) with (Empty_set elt); auto with sets. + rewrite cardinal_1; auto with sets. + symmetry; apply Extensionality_Ensembles. apply Empty_Empty_set; auto. - replace (!!s') with (Add _ (!!s) x). + rewrite (cardinal_2 H0 H1); auto with sets. + symmetry; apply Extensionality_Ensembles. apply Add_Add; auto. Qed. (** we can even build a function from Finite Ensemble to FSet ... at least in Prop. *) Lemma Ens_to_FSet : forall e : Ensemble M.elt, Finite _ e -> exists s:M.t, !!s === e. Proof. induction 1. - exists M.empty. apply empty_Empty_Set. - destruct IHFinite as (s,Hs). exists (M.add x s). apply Extensionality_Ensembles in Hs. rewrite <- Hs. apply add_Add. Qed. End WS_to_Finite_set. Module S_to_Finite_set (U:UsualOrderedType)(M: Sfun U) := WS_to_Finite_set U M. coq-8.20.0/theories/FSets/FSetWeakList.v000066400000000000000000000023531466560755400177520ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* Prim2SF (SF2Prim x) = x. Theorem Prim2SF_inj : forall x y, Prim2SF x = Prim2SF y -> x = y. intros. rewrite <- SF2Prim_Prim2SF. symmetry. rewrite <- SF2Prim_Prim2SF. now rewrite H. Qed. Theorem SF2Prim_inj : forall x y, SF2Prim x = SF2Prim y -> valid_binary x = true -> valid_binary y = true -> x = y. intros. rewrite <- Prim2SF_SF2Prim by assumption. symmetry. rewrite <- Prim2SF_SF2Prim by assumption. rewrite H. reflexivity. Qed. Axiom opp_spec : forall x, Prim2SF (-x)%float = SFopp (Prim2SF x). Axiom abs_spec : forall x, Prim2SF (abs x) = SFabs (Prim2SF x). Axiom eqb_spec : forall x y, (x =? y)%float = SFeqb (Prim2SF x) (Prim2SF y). Axiom ltb_spec : forall x y, (x FNotComparable | Some Eq => FEq | Some Lt => FLt | Some Gt => FGt end. Axiom compare_spec : forall x y, (x ?= y)%float = flatten_cmp_opt (SFcompare (Prim2SF x) (Prim2SF y)). Module Leibniz. Axiom eqb_spec : forall x y, Leibniz.eqb x y = true <-> x = y. End Leibniz. Axiom classify_spec : forall x, classify x = SF64classify (Prim2SF x). Axiom mul_spec : forall x y, Prim2SF (x * y)%float = SF64mul (Prim2SF x) (Prim2SF y). Axiom add_spec : forall x y, Prim2SF (x + y)%float = SF64add (Prim2SF x) (Prim2SF y). Axiom sub_spec : forall x y, Prim2SF (x - y)%float = SF64sub (Prim2SF x) (Prim2SF y). Axiom div_spec : forall x y, Prim2SF (x / y)%float = SF64div (Prim2SF x) (Prim2SF y). Axiom sqrt_spec : forall x, Prim2SF (sqrt x) = SF64sqrt (Prim2SF x). Axiom of_uint63_spec : forall n, Prim2SF (of_uint63 n) = binary_normalize prec emax (to_Z n) 0%Z false. Axiom normfr_mantissa_spec : forall f, to_Z (normfr_mantissa f) = Z.of_N (SFnormfr_mantissa prec (Prim2SF f)). Axiom frshiftexp_spec : forall f, let (m,e) := frshiftexp f in (Prim2SF m, ((to_Z e) - shift)%Z) = SFfrexp prec emax (Prim2SF f). Axiom ldshiftexp_spec : forall f e, Prim2SF (ldshiftexp f e) = SFldexp prec emax (Prim2SF f) ((to_Z e) - shift). Axiom next_up_spec : forall x, Prim2SF (next_up x) = SF64succ (Prim2SF x). Axiom next_down_spec : forall x, Prim2SF (next_down x) = SF64pred (Prim2SF x). coq-8.20.0/theories/Floats/FloatClass.v000066400000000000000000000014141466560755400177010ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* z = 0%Z). { intro z. unfold Zdigits2. now destruct z. } assert (Hshr_p0 : forall p0, (prec < Z.pos p0)%Z -> shr_m (iter_pos shr_1 p0 {| shr_m := Z.pos m; shr_r := false; shr_s := false |}) = Z0). { intros p0 Hp0. apply Hd0. rewrite Hshr. rewrite Z.max_l; [ reflexivity | ]. unfold shr_m. unfold Zdigits2. lia. } assert (Hshr_p0_r : forall p0, (prec < Z.pos p0)%Z -> shr_r (iter_pos shr_1 p0 {| shr_m := Z.pos m; shr_r := false; shr_s := false |}) = false). { intros p0 Hp0. assert (Hshr_p0m1 : shr_m (iter_pos shr_1 (p0-1) {| shr_m := Z.pos m; shr_r := false; shr_s := false |}) = Z0). { apply Hd0. rewrite Hshr. rewrite Z.max_l; [ reflexivity | ]. unfold shr_m. unfold Zdigits2. lia. } assert (Hiter_pos : forall A (f : A -> A) p e, iter_pos f (p + 1) e = f (iter_pos f p e)). { assert (Hiter_pos' : forall A (f : A -> A) p e, iter_pos f p (f e) = f (iter_pos f p e)). { intros A f'. induction p. - intro e'. simpl. now do 2 rewrite IHp. - intro e'. simpl. now do 2 rewrite IHp. - intro e'. now simpl. } intros A f'. induction p. - intros. simpl. rewrite <- Pos.add_1_r. do 2 rewrite IHp. now do 3 rewrite Hiter_pos'. - intros. simpl. now do 2 rewrite Hiter_pos'. - intros. now simpl. } replace p0 with (p0 - 1 + 1)%positive. - rewrite Hiter_pos. unfold shr_1 at 1. remember (iter_pos _ _ _) as shr_p0m1. destruct shr_p0m1. unfold SpecFloat.shr_m in Hshr_p0m1. now rewrite Hshr_p0m1. - rewrite Pos.add_1_r. rewrite Pos.sub_1_r. apply Pos.succ_pred. lia. } rewrite Z.leb_le in H2. destruct (Z.max_spec (Z.pos (digits2_pos m) + (e0 + (emin - emax - 1)) - prec) emin) as [ (H, Hm) | (H, Hm) ]. + rewrite Hm. replace (_ - _)%Z with (emax - e0 + 1)%Z by ring. remember (emax - e0 + 1)%Z as z'. destruct z'; [ exfalso; lia | | exfalso; lia ]. unfold binary_round_aux. unfold shr_fexp, fexp. unfold shr, shr_record_of_loc. unfold Zdigits2. rewrite Hm. replace (_ - _)%Z with (Z.pos p) by (rewrite Heqz'; ring). set (rne := round_nearest_even _ _). assert (rne = 0%Z). { unfold rne. unfold round_nearest_even. assert (Hp0 : (prec < Z.pos p)%Z) by lia. unfold loc_of_shr_record. specialize (Hshr_p0_r _ Hp0). specialize (Hshr_p0 _ Hp0). revert Hshr_p0_r Hshr_p0. set (shr_p0 := iter_pos shr_1 _ _). destruct shr_p0. unfold SpecFloat.shr_r, SpecFloat.shr_m. intros Hshr_r Hshr_m. rewrite Hshr_r, Hshr_m. now destruct shr_s. } rewrite H0. rewrite Z.max_r by (rewrite Heqz'; unfold prec; lia). replace (_ - _)%Z with 0%Z by lia. unfold shr_m. rewrite Z.max_r by lia. remember (emin - (e0 + e))%Z as eminmze. destruct eminmze; [ exfalso; lia | | exfalso; lia ]. rewrite Z.max_r by lia. rewrite <- Heqeminmze. set (rne' := round_nearest_even _ _). assert (Hrne'0 : rne' = 0%Z). { unfold rne'. unfold round_nearest_even. assert (Hp1 : (prec < Z.pos p0)%Z) by lia. unfold loc_of_shr_record. specialize (Hshr_p0_r _ Hp1). specialize (Hshr_p0 _ Hp1). revert Hshr_p0_r Hshr_p0. set (shr_p1 := iter_pos shr_1 _ _). destruct shr_p1. unfold SpecFloat.shr_r, SpecFloat.shr_m. intros Hshr_r Hshr_m. rewrite Hshr_r, Hshr_m. now destruct shr_s. } rewrite Hrne'0. rewrite Z.max_r by (rewrite Heqeminmze; unfold prec; lia). replace (_ - _)%Z with 0%Z by lia. reflexivity. + exfalso; lia. Qed. coq-8.20.0/theories/Floats/FloatOps.v000066400000000000000000000043511466560755400174000ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* S754_finite (get_sign f) p e' | Zneg _ | Z0 => S754_zero false (* must never occur *) end. Definition SF2Prim ef := match ef with | S754_nan => nan | S754_zero false => zero | S754_zero true => neg_zero | S754_infinity false => infinity | S754_infinity true => neg_infinity | S754_finite s m e => let pm := of_uint63 (of_Z (Zpos m)) in let f := Z.ldexp pm e in if s then (-f)%float else f end. coq-8.20.0/theories/Floats/Floats.v000066400000000000000000000032041466560755400170750ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* xH | xO p => Pos.succ (digits2_pos p) | xI p => Pos.succ (digits2_pos p) end. Definition Zdigits2 n := match n with | Z0 => n | Zpos p => Zpos (digits2_pos p) | Zneg p => Zpos (digits2_pos p) end. End Zdigits2. Section ValidBinary. Definition canonical_mantissa m e := Zeq_bool (fexp (Zpos (digits2_pos m) + e)) e. Definition bounded m e := andb (canonical_mantissa m e) (Zle_bool e (emax - prec)). Definition valid_binary x := match x with | S754_finite _ m e => bounded m e | _ => true end. End ValidBinary. Section Iter. Context {A : Type}. Variable (f : A -> A). Fixpoint iter_pos (n : positive) (x : A) {struct n} : A := match n with | xI n' => iter_pos n' (iter_pos n' (f x)) | xO n' => iter_pos n' (iter_pos n' x) | xH => f x end. End Iter. Section Rounding. Inductive location := loc_Exact | loc_Inexact : comparison -> location. Record shr_record := { shr_m : Z ; shr_r : bool ; shr_s : bool }. Definition shr_1 mrs := let '(Build_shr_record m r s) := mrs in let s := orb r s in match m with | Z0 => Build_shr_record Z0 false s | Zpos xH => Build_shr_record Z0 true s | Zpos (xO p) => Build_shr_record (Zpos p) false s | Zpos (xI p) => Build_shr_record (Zpos p) true s | Zneg xH => Build_shr_record Z0 true s | Zneg (xO p) => Build_shr_record (Zneg p) false s | Zneg (xI p) => Build_shr_record (Zneg p) true s end. Definition loc_of_shr_record mrs := match mrs with | Build_shr_record _ false false => loc_Exact | Build_shr_record _ false true => loc_Inexact Lt | Build_shr_record _ true false => loc_Inexact Eq | Build_shr_record _ true true => loc_Inexact Gt end. Definition shr_record_of_loc m l := match l with | loc_Exact => Build_shr_record m false false | loc_Inexact Lt => Build_shr_record m false true | loc_Inexact Eq => Build_shr_record m true false | loc_Inexact Gt => Build_shr_record m true true end. Definition shr mrs e n := match n with | Zpos p => (iter_pos shr_1 p mrs, (e + n)%Z) | _ => (mrs, e) end. Definition shr_fexp m e l := shr (shr_record_of_loc m l) e (fexp (Zdigits2 m + e) - e). Definition round_nearest_even mx lx := match lx with | loc_Exact => mx | loc_Inexact Lt => mx | loc_Inexact Eq => if Z.even mx then mx else (mx + 1)%Z | loc_Inexact Gt => (mx + 1)%Z end. Definition binary_round_aux sx mx ex lx := let '(mrs', e') := shr_fexp mx ex lx in let '(mrs'', e'') := shr_fexp (round_nearest_even (shr_m mrs') (loc_of_shr_record mrs')) e' loc_Exact in match shr_m mrs'' with | Z0 => S754_zero sx | Zpos m => if Zle_bool e'' (emax - prec) then S754_finite sx m e'' else S754_infinity sx | _ => S754_nan end. Definition shl_align mx ex ex' := match (ex' - ex)%Z with | Zneg d => (shift_pos d mx, ex') | _ => (mx, ex) end. Definition binary_round sx mx ex := let '(mz, ez) := shl_align mx ex (fexp (Zpos (digits2_pos mx) + ex))in binary_round_aux sx (Zpos mz) ez loc_Exact. Definition binary_normalize m e szero := match m with | Z0 => S754_zero szero | Zpos m => binary_round false m e | Zneg m => binary_round true m e end. End Rounding. (** ** Define operations *) Definition SFopp x := match x with | S754_nan => S754_nan | S754_infinity sx => S754_infinity (negb sx) | S754_finite sx mx ex => S754_finite (negb sx) mx ex | S754_zero sx => S754_zero (negb sx) end. Definition SFabs x := match x with | S754_nan => S754_nan | S754_infinity sx => S754_infinity false | S754_finite sx mx ex => S754_finite false mx ex | S754_zero sx => S754_zero false end. Definition SFcompare f1 f2 := match f1, f2 with | S754_nan , _ | _, S754_nan => None | S754_infinity s1, S754_infinity s2 => Some match s1, s2 with | true, true => Eq | false, false => Eq | true, false => Lt | false, true => Gt end | S754_infinity s, _ => Some (if s then Lt else Gt) | _, S754_infinity s => Some (if s then Gt else Lt) | S754_finite s _ _, S754_zero _ => Some (if s then Lt else Gt) | S754_zero _, S754_finite s _ _ => Some (if s then Gt else Lt) | S754_zero _, S754_zero _ => Some Eq | S754_finite s1 m1 e1, S754_finite s2 m2 e2 => Some match s1, s2 with | true, false => Lt | false, true => Gt | false, false => match Z.compare e1 e2 with | Lt => Lt | Gt => Gt | Eq => Pcompare m1 m2 Eq end | true, true => match Z.compare e1 e2 with | Lt => Gt | Gt => Lt | Eq => CompOpp (Pcompare m1 m2 Eq) end end end. Definition SFeqb f1 f2 := match SFcompare f1 f2 with | Some Eq => true | _ => false end. Definition SFltb f1 f2 := match SFcompare f1 f2 with | Some Lt => true | _ => false end. Definition SFleb f1 f2 := match SFcompare f1 f2 with | Some (Lt | Eq) => true | _ => false end. Definition SFclassify f := match f with | S754_nan => NaN | S754_infinity false => PInf | S754_infinity true => NInf | S754_zero false => PZero | S754_zero true => NZero | S754_finite false m _ => if (digits2_pos m =? Z.to_pos prec)%positive then PNormal else PSubn | S754_finite true m _ => if (digits2_pos m =? Z.to_pos prec)%positive then NNormal else NSubn end. Definition SFmul x y := match x, y with | S754_nan, _ | _, S754_nan => S754_nan | S754_infinity sx, S754_infinity sy => S754_infinity (xorb sx sy) | S754_infinity sx, S754_finite sy _ _ => S754_infinity (xorb sx sy) | S754_finite sx _ _, S754_infinity sy => S754_infinity (xorb sx sy) | S754_infinity _, S754_zero _ => S754_nan | S754_zero _, S754_infinity _ => S754_nan | S754_finite sx _ _, S754_zero sy => S754_zero (xorb sx sy) | S754_zero sx, S754_finite sy _ _ => S754_zero (xorb sx sy) | S754_zero sx, S754_zero sy => S754_zero (xorb sx sy) | S754_finite sx mx ex, S754_finite sy my ey => binary_round_aux (xorb sx sy) (Zpos (mx * my)) (ex + ey) loc_Exact end. Definition cond_Zopp (b : bool) m := if b then Z.opp m else m. Definition SFadd x y := match x, y with | S754_nan, _ | _, S754_nan => S754_nan | S754_infinity sx, S754_infinity sy => if Bool.eqb sx sy then x else S754_nan | S754_infinity _, _ => x | _, S754_infinity _ => y | S754_zero sx, S754_zero sy => if Bool.eqb sx sy then x else S754_zero false | S754_zero _, _ => y | _, S754_zero _ => x | S754_finite sx mx ex, S754_finite sy my ey => let ez := Z.min ex ey in binary_normalize (Zplus (cond_Zopp sx (Zpos (fst (shl_align mx ex ez)))) (cond_Zopp sy (Zpos (fst (shl_align my ey ez))))) ez false end. Definition SFsub x y := match x, y with | S754_nan, _ | _, S754_nan => S754_nan | S754_infinity sx, S754_infinity sy => if Bool.eqb sx (negb sy) then x else S754_nan | S754_infinity _, _ => x | _, S754_infinity sy => S754_infinity (negb sy) | S754_zero sx, S754_zero sy => if Bool.eqb sx (negb sy) then x else S754_zero false | S754_zero _, S754_finite sy my ey => S754_finite (negb sy) my ey | _, S754_zero _ => x | S754_finite sx mx ex, S754_finite sy my ey => let ez := Z.min ex ey in binary_normalize (Zminus (cond_Zopp sx (Zpos (fst (shl_align mx ex ez)))) (cond_Zopp sy (Zpos (fst (shl_align my ey ez))))) ez false end. Definition new_location_even nb_steps k := if Zeq_bool k 0 then loc_Exact else loc_Inexact (Z.compare (2 * k) nb_steps). Definition new_location_odd nb_steps k := if Zeq_bool k 0 then loc_Exact else loc_Inexact match Z.compare (2 * k + 1) nb_steps with | Lt => Lt | Eq => Lt | Gt => Gt end. Definition new_location nb_steps := if Z.even nb_steps then new_location_even nb_steps else new_location_odd nb_steps. Definition SFdiv_core_binary m1 e1 m2 e2 := let d1 := Zdigits2 m1 in let d2 := Zdigits2 m2 in let e' := Z.min (fexp (d1 + e1 - (d2 + e2))) (e1 - e2) in let s := (e1 - e2 - e')%Z in let m' := match s with | Zpos _ => Z.shiftl m1 s | Z0 => m1 | Zneg _ => Z0 end in let '(q, r) := Z.div_eucl m' m2 in (q, e', new_location m2 r). Definition SFdiv x y := match x, y with | S754_nan, _ | _, S754_nan => S754_nan | S754_infinity sx, S754_infinity sy => S754_nan | S754_infinity sx, S754_finite sy _ _ => S754_infinity (xorb sx sy) | S754_finite sx _ _, S754_infinity sy => S754_zero (xorb sx sy) | S754_infinity sx, S754_zero sy => S754_infinity (xorb sx sy) | S754_zero sx, S754_infinity sy => S754_zero (xorb sx sy) | S754_finite sx _ _, S754_zero sy => S754_infinity (xorb sx sy) | S754_zero sx, S754_finite sy _ _ => S754_zero (xorb sx sy) | S754_zero sx, S754_zero sy => S754_nan | S754_finite sx mx ex, S754_finite sy my ey => let '(mz, ez, lz) := SFdiv_core_binary (Zpos mx) ex (Zpos my) ey in binary_round_aux (xorb sx sy) mz ez lz end. Definition SFsqrt_core_binary m e := let d := Zdigits2 m in let e' := Z.min (fexp (Z.div2 (d + e + 1))) (Z.div2 e) in let s := (e - 2 * e')%Z in let m' := match s with | Zpos p => Z.shiftl m s | Z0 => m | Zneg _ => Z0 end in let (q, r) := Z.sqrtrem m' in let l := if Zeq_bool r 0 then loc_Exact else loc_Inexact (if Zle_bool r q then Lt else Gt) in (q, e', l). Definition SFsqrt x := match x with | S754_nan => S754_nan | S754_infinity false => x | S754_infinity true => S754_nan | S754_finite true _ _ => S754_nan | S754_zero _ => x | S754_finite false mx ex => let '(mz, ez, lz) := SFsqrt_core_binary (Zpos mx) ex in binary_round_aux false mz ez lz end. Definition SFnormfr_mantissa f := match f with | S754_finite _ mx ex => if Z.eqb ex (-prec) then Npos mx else 0%N | _ => 0%N end. Definition SFldexp f e := match f with | S754_finite sx mx ex => binary_round sx mx (ex+e) | _ => f end. Definition SFfrexp f := match f with | S754_finite sx mx ex => if (Z.to_pos prec <=? digits2_pos mx)%positive then (S754_finite sx mx (-prec), (ex+prec)%Z) else let d := (prec - Z.pos (digits2_pos mx))%Z in (S754_finite sx (shift_pos (Z.to_pos d) mx) (-prec), (ex+prec-d)%Z) | _ => (f, (-2*emax-prec)%Z) end. Definition SFone := binary_round false 1 0. Definition SFulp x := SFldexp SFone (fexp (snd (SFfrexp x))). Definition SFpred_pos x := match x with | S754_finite _ mx _ => let d := if (mx~0 =? shift_pos (Z.to_pos prec) 1)%positive then SFldexp SFone (fexp (snd (SFfrexp x) - 1)) else SFulp x in SFsub x d | _ => x end. Definition SFmax_float := S754_finite false (shift_pos (Z.to_pos prec) 1 - 1) (emax - prec). Definition SFsucc x := match x with | S754_zero _ => SFldexp SFone emin | S754_infinity false => x | S754_infinity true => SFopp SFmax_float | S754_nan => x | S754_finite false _ _ => SFadd x (SFulp x) | S754_finite true _ _ => SFopp (SFpred_pos (SFopp x)) end. Definition SFpred f := SFopp (SFsucc (SFopp f)). End FloatOps. coq-8.20.0/theories/Init/000077500000000000000000000000001466560755400151325ustar00rootroot00000000000000coq-8.20.0/theories/Init/Byte.v000066400000000000000000000631141466560755400162310ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* x00 | (1,(0,(0,(0,(0,(0,(0,0))))))) => x01 | (0,(1,(0,(0,(0,(0,(0,0))))))) => x02 | (1,(1,(0,(0,(0,(0,(0,0))))))) => x03 | (0,(0,(1,(0,(0,(0,(0,0))))))) => x04 | (1,(0,(1,(0,(0,(0,(0,0))))))) => x05 | (0,(1,(1,(0,(0,(0,(0,0))))))) => x06 | (1,(1,(1,(0,(0,(0,(0,0))))))) => x07 | (0,(0,(0,(1,(0,(0,(0,0))))))) => x08 | (1,(0,(0,(1,(0,(0,(0,0))))))) => x09 | (0,(1,(0,(1,(0,(0,(0,0))))))) => x0a | (1,(1,(0,(1,(0,(0,(0,0))))))) => x0b | (0,(0,(1,(1,(0,(0,(0,0))))))) => x0c | (1,(0,(1,(1,(0,(0,(0,0))))))) => x0d | (0,(1,(1,(1,(0,(0,(0,0))))))) => x0e | (1,(1,(1,(1,(0,(0,(0,0))))))) => x0f | (0,(0,(0,(0,(1,(0,(0,0))))))) => x10 | (1,(0,(0,(0,(1,(0,(0,0))))))) => x11 | (0,(1,(0,(0,(1,(0,(0,0))))))) => x12 | (1,(1,(0,(0,(1,(0,(0,0))))))) => x13 | (0,(0,(1,(0,(1,(0,(0,0))))))) => x14 | (1,(0,(1,(0,(1,(0,(0,0))))))) => x15 | (0,(1,(1,(0,(1,(0,(0,0))))))) => x16 | (1,(1,(1,(0,(1,(0,(0,0))))))) => x17 | (0,(0,(0,(1,(1,(0,(0,0))))))) => x18 | (1,(0,(0,(1,(1,(0,(0,0))))))) => x19 | (0,(1,(0,(1,(1,(0,(0,0))))))) => x1a | (1,(1,(0,(1,(1,(0,(0,0))))))) => x1b | (0,(0,(1,(1,(1,(0,(0,0))))))) => x1c | (1,(0,(1,(1,(1,(0,(0,0))))))) => x1d | (0,(1,(1,(1,(1,(0,(0,0))))))) => x1e | (1,(1,(1,(1,(1,(0,(0,0))))))) => x1f | (0,(0,(0,(0,(0,(1,(0,0))))))) => x20 | (1,(0,(0,(0,(0,(1,(0,0))))))) => x21 | (0,(1,(0,(0,(0,(1,(0,0))))))) => x22 | (1,(1,(0,(0,(0,(1,(0,0))))))) => x23 | (0,(0,(1,(0,(0,(1,(0,0))))))) => x24 | (1,(0,(1,(0,(0,(1,(0,0))))))) => x25 | (0,(1,(1,(0,(0,(1,(0,0))))))) => x26 | (1,(1,(1,(0,(0,(1,(0,0))))))) => x27 | (0,(0,(0,(1,(0,(1,(0,0))))))) => x28 | (1,(0,(0,(1,(0,(1,(0,0))))))) => x29 | (0,(1,(0,(1,(0,(1,(0,0))))))) => x2a | (1,(1,(0,(1,(0,(1,(0,0))))))) => x2b | (0,(0,(1,(1,(0,(1,(0,0))))))) => x2c | (1,(0,(1,(1,(0,(1,(0,0))))))) => x2d | (0,(1,(1,(1,(0,(1,(0,0))))))) => x2e | (1,(1,(1,(1,(0,(1,(0,0))))))) => x2f | (0,(0,(0,(0,(1,(1,(0,0))))))) => x30 | (1,(0,(0,(0,(1,(1,(0,0))))))) => x31 | (0,(1,(0,(0,(1,(1,(0,0))))))) => x32 | (1,(1,(0,(0,(1,(1,(0,0))))))) => x33 | (0,(0,(1,(0,(1,(1,(0,0))))))) => x34 | (1,(0,(1,(0,(1,(1,(0,0))))))) => x35 | (0,(1,(1,(0,(1,(1,(0,0))))))) => x36 | (1,(1,(1,(0,(1,(1,(0,0))))))) => x37 | (0,(0,(0,(1,(1,(1,(0,0))))))) => x38 | (1,(0,(0,(1,(1,(1,(0,0))))))) => x39 | (0,(1,(0,(1,(1,(1,(0,0))))))) => x3a | (1,(1,(0,(1,(1,(1,(0,0))))))) => x3b | (0,(0,(1,(1,(1,(1,(0,0))))))) => x3c | (1,(0,(1,(1,(1,(1,(0,0))))))) => x3d | (0,(1,(1,(1,(1,(1,(0,0))))))) => x3e | (1,(1,(1,(1,(1,(1,(0,0))))))) => x3f | (0,(0,(0,(0,(0,(0,(1,0))))))) => x40 | (1,(0,(0,(0,(0,(0,(1,0))))))) => x41 | (0,(1,(0,(0,(0,(0,(1,0))))))) => x42 | (1,(1,(0,(0,(0,(0,(1,0))))))) => x43 | (0,(0,(1,(0,(0,(0,(1,0))))))) => x44 | (1,(0,(1,(0,(0,(0,(1,0))))))) => x45 | (0,(1,(1,(0,(0,(0,(1,0))))))) => x46 | (1,(1,(1,(0,(0,(0,(1,0))))))) => x47 | (0,(0,(0,(1,(0,(0,(1,0))))))) => x48 | (1,(0,(0,(1,(0,(0,(1,0))))))) => x49 | (0,(1,(0,(1,(0,(0,(1,0))))))) => x4a | (1,(1,(0,(1,(0,(0,(1,0))))))) => x4b | (0,(0,(1,(1,(0,(0,(1,0))))))) => x4c | (1,(0,(1,(1,(0,(0,(1,0))))))) => x4d | (0,(1,(1,(1,(0,(0,(1,0))))))) => x4e | (1,(1,(1,(1,(0,(0,(1,0))))))) => x4f | (0,(0,(0,(0,(1,(0,(1,0))))))) => x50 | (1,(0,(0,(0,(1,(0,(1,0))))))) => x51 | (0,(1,(0,(0,(1,(0,(1,0))))))) => x52 | (1,(1,(0,(0,(1,(0,(1,0))))))) => x53 | (0,(0,(1,(0,(1,(0,(1,0))))))) => x54 | (1,(0,(1,(0,(1,(0,(1,0))))))) => x55 | (0,(1,(1,(0,(1,(0,(1,0))))))) => x56 | (1,(1,(1,(0,(1,(0,(1,0))))))) => x57 | (0,(0,(0,(1,(1,(0,(1,0))))))) => x58 | (1,(0,(0,(1,(1,(0,(1,0))))))) => x59 | (0,(1,(0,(1,(1,(0,(1,0))))))) => x5a | (1,(1,(0,(1,(1,(0,(1,0))))))) => x5b | (0,(0,(1,(1,(1,(0,(1,0))))))) => x5c | (1,(0,(1,(1,(1,(0,(1,0))))))) => x5d | (0,(1,(1,(1,(1,(0,(1,0))))))) => x5e | (1,(1,(1,(1,(1,(0,(1,0))))))) => x5f | (0,(0,(0,(0,(0,(1,(1,0))))))) => x60 | (1,(0,(0,(0,(0,(1,(1,0))))))) => x61 | (0,(1,(0,(0,(0,(1,(1,0))))))) => x62 | (1,(1,(0,(0,(0,(1,(1,0))))))) => x63 | (0,(0,(1,(0,(0,(1,(1,0))))))) => x64 | (1,(0,(1,(0,(0,(1,(1,0))))))) => x65 | (0,(1,(1,(0,(0,(1,(1,0))))))) => x66 | (1,(1,(1,(0,(0,(1,(1,0))))))) => x67 | (0,(0,(0,(1,(0,(1,(1,0))))))) => x68 | (1,(0,(0,(1,(0,(1,(1,0))))))) => x69 | (0,(1,(0,(1,(0,(1,(1,0))))))) => x6a | (1,(1,(0,(1,(0,(1,(1,0))))))) => x6b | (0,(0,(1,(1,(0,(1,(1,0))))))) => x6c | (1,(0,(1,(1,(0,(1,(1,0))))))) => x6d | (0,(1,(1,(1,(0,(1,(1,0))))))) => x6e | (1,(1,(1,(1,(0,(1,(1,0))))))) => x6f | (0,(0,(0,(0,(1,(1,(1,0))))))) => x70 | (1,(0,(0,(0,(1,(1,(1,0))))))) => x71 | (0,(1,(0,(0,(1,(1,(1,0))))))) => x72 | (1,(1,(0,(0,(1,(1,(1,0))))))) => x73 | (0,(0,(1,(0,(1,(1,(1,0))))))) => x74 | (1,(0,(1,(0,(1,(1,(1,0))))))) => x75 | (0,(1,(1,(0,(1,(1,(1,0))))))) => x76 | (1,(1,(1,(0,(1,(1,(1,0))))))) => x77 | (0,(0,(0,(1,(1,(1,(1,0))))))) => x78 | (1,(0,(0,(1,(1,(1,(1,0))))))) => x79 | (0,(1,(0,(1,(1,(1,(1,0))))))) => x7a | (1,(1,(0,(1,(1,(1,(1,0))))))) => x7b | (0,(0,(1,(1,(1,(1,(1,0))))))) => x7c | (1,(0,(1,(1,(1,(1,(1,0))))))) => x7d | (0,(1,(1,(1,(1,(1,(1,0))))))) => x7e | (1,(1,(1,(1,(1,(1,(1,0))))))) => x7f | (0,(0,(0,(0,(0,(0,(0,1))))))) => x80 | (1,(0,(0,(0,(0,(0,(0,1))))))) => x81 | (0,(1,(0,(0,(0,(0,(0,1))))))) => x82 | (1,(1,(0,(0,(0,(0,(0,1))))))) => x83 | (0,(0,(1,(0,(0,(0,(0,1))))))) => x84 | (1,(0,(1,(0,(0,(0,(0,1))))))) => x85 | (0,(1,(1,(0,(0,(0,(0,1))))))) => x86 | (1,(1,(1,(0,(0,(0,(0,1))))))) => x87 | (0,(0,(0,(1,(0,(0,(0,1))))))) => x88 | (1,(0,(0,(1,(0,(0,(0,1))))))) => x89 | (0,(1,(0,(1,(0,(0,(0,1))))))) => x8a | (1,(1,(0,(1,(0,(0,(0,1))))))) => x8b | (0,(0,(1,(1,(0,(0,(0,1))))))) => x8c | (1,(0,(1,(1,(0,(0,(0,1))))))) => x8d | (0,(1,(1,(1,(0,(0,(0,1))))))) => x8e | (1,(1,(1,(1,(0,(0,(0,1))))))) => x8f | (0,(0,(0,(0,(1,(0,(0,1))))))) => x90 | (1,(0,(0,(0,(1,(0,(0,1))))))) => x91 | (0,(1,(0,(0,(1,(0,(0,1))))))) => x92 | (1,(1,(0,(0,(1,(0,(0,1))))))) => x93 | (0,(0,(1,(0,(1,(0,(0,1))))))) => x94 | (1,(0,(1,(0,(1,(0,(0,1))))))) => x95 | (0,(1,(1,(0,(1,(0,(0,1))))))) => x96 | (1,(1,(1,(0,(1,(0,(0,1))))))) => x97 | (0,(0,(0,(1,(1,(0,(0,1))))))) => x98 | (1,(0,(0,(1,(1,(0,(0,1))))))) => x99 | (0,(1,(0,(1,(1,(0,(0,1))))))) => x9a | (1,(1,(0,(1,(1,(0,(0,1))))))) => x9b | (0,(0,(1,(1,(1,(0,(0,1))))))) => x9c | (1,(0,(1,(1,(1,(0,(0,1))))))) => x9d | (0,(1,(1,(1,(1,(0,(0,1))))))) => x9e | (1,(1,(1,(1,(1,(0,(0,1))))))) => x9f | (0,(0,(0,(0,(0,(1,(0,1))))))) => xa0 | (1,(0,(0,(0,(0,(1,(0,1))))))) => xa1 | (0,(1,(0,(0,(0,(1,(0,1))))))) => xa2 | (1,(1,(0,(0,(0,(1,(0,1))))))) => xa3 | (0,(0,(1,(0,(0,(1,(0,1))))))) => xa4 | (1,(0,(1,(0,(0,(1,(0,1))))))) => xa5 | (0,(1,(1,(0,(0,(1,(0,1))))))) => xa6 | (1,(1,(1,(0,(0,(1,(0,1))))))) => xa7 | (0,(0,(0,(1,(0,(1,(0,1))))))) => xa8 | (1,(0,(0,(1,(0,(1,(0,1))))))) => xa9 | (0,(1,(0,(1,(0,(1,(0,1))))))) => xaa | (1,(1,(0,(1,(0,(1,(0,1))))))) => xab | (0,(0,(1,(1,(0,(1,(0,1))))))) => xac | (1,(0,(1,(1,(0,(1,(0,1))))))) => xad | (0,(1,(1,(1,(0,(1,(0,1))))))) => xae | (1,(1,(1,(1,(0,(1,(0,1))))))) => xaf | (0,(0,(0,(0,(1,(1,(0,1))))))) => xb0 | (1,(0,(0,(0,(1,(1,(0,1))))))) => xb1 | (0,(1,(0,(0,(1,(1,(0,1))))))) => xb2 | (1,(1,(0,(0,(1,(1,(0,1))))))) => xb3 | (0,(0,(1,(0,(1,(1,(0,1))))))) => xb4 | (1,(0,(1,(0,(1,(1,(0,1))))))) => xb5 | (0,(1,(1,(0,(1,(1,(0,1))))))) => xb6 | (1,(1,(1,(0,(1,(1,(0,1))))))) => xb7 | (0,(0,(0,(1,(1,(1,(0,1))))))) => xb8 | (1,(0,(0,(1,(1,(1,(0,1))))))) => xb9 | (0,(1,(0,(1,(1,(1,(0,1))))))) => xba | (1,(1,(0,(1,(1,(1,(0,1))))))) => xbb | (0,(0,(1,(1,(1,(1,(0,1))))))) => xbc | (1,(0,(1,(1,(1,(1,(0,1))))))) => xbd | (0,(1,(1,(1,(1,(1,(0,1))))))) => xbe | (1,(1,(1,(1,(1,(1,(0,1))))))) => xbf | (0,(0,(0,(0,(0,(0,(1,1))))))) => xc0 | (1,(0,(0,(0,(0,(0,(1,1))))))) => xc1 | (0,(1,(0,(0,(0,(0,(1,1))))))) => xc2 | (1,(1,(0,(0,(0,(0,(1,1))))))) => xc3 | (0,(0,(1,(0,(0,(0,(1,1))))))) => xc4 | (1,(0,(1,(0,(0,(0,(1,1))))))) => xc5 | (0,(1,(1,(0,(0,(0,(1,1))))))) => xc6 | (1,(1,(1,(0,(0,(0,(1,1))))))) => xc7 | (0,(0,(0,(1,(0,(0,(1,1))))))) => xc8 | (1,(0,(0,(1,(0,(0,(1,1))))))) => xc9 | (0,(1,(0,(1,(0,(0,(1,1))))))) => xca | (1,(1,(0,(1,(0,(0,(1,1))))))) => xcb | (0,(0,(1,(1,(0,(0,(1,1))))))) => xcc | (1,(0,(1,(1,(0,(0,(1,1))))))) => xcd | (0,(1,(1,(1,(0,(0,(1,1))))))) => xce | (1,(1,(1,(1,(0,(0,(1,1))))))) => xcf | (0,(0,(0,(0,(1,(0,(1,1))))))) => xd0 | (1,(0,(0,(0,(1,(0,(1,1))))))) => xd1 | (0,(1,(0,(0,(1,(0,(1,1))))))) => xd2 | (1,(1,(0,(0,(1,(0,(1,1))))))) => xd3 | (0,(0,(1,(0,(1,(0,(1,1))))))) => xd4 | (1,(0,(1,(0,(1,(0,(1,1))))))) => xd5 | (0,(1,(1,(0,(1,(0,(1,1))))))) => xd6 | (1,(1,(1,(0,(1,(0,(1,1))))))) => xd7 | (0,(0,(0,(1,(1,(0,(1,1))))))) => xd8 | (1,(0,(0,(1,(1,(0,(1,1))))))) => xd9 | (0,(1,(0,(1,(1,(0,(1,1))))))) => xda | (1,(1,(0,(1,(1,(0,(1,1))))))) => xdb | (0,(0,(1,(1,(1,(0,(1,1))))))) => xdc | (1,(0,(1,(1,(1,(0,(1,1))))))) => xdd | (0,(1,(1,(1,(1,(0,(1,1))))))) => xde | (1,(1,(1,(1,(1,(0,(1,1))))))) => xdf | (0,(0,(0,(0,(0,(1,(1,1))))))) => xe0 | (1,(0,(0,(0,(0,(1,(1,1))))))) => xe1 | (0,(1,(0,(0,(0,(1,(1,1))))))) => xe2 | (1,(1,(0,(0,(0,(1,(1,1))))))) => xe3 | (0,(0,(1,(0,(0,(1,(1,1))))))) => xe4 | (1,(0,(1,(0,(0,(1,(1,1))))))) => xe5 | (0,(1,(1,(0,(0,(1,(1,1))))))) => xe6 | (1,(1,(1,(0,(0,(1,(1,1))))))) => xe7 | (0,(0,(0,(1,(0,(1,(1,1))))))) => xe8 | (1,(0,(0,(1,(0,(1,(1,1))))))) => xe9 | (0,(1,(0,(1,(0,(1,(1,1))))))) => xea | (1,(1,(0,(1,(0,(1,(1,1))))))) => xeb | (0,(0,(1,(1,(0,(1,(1,1))))))) => xec | (1,(0,(1,(1,(0,(1,(1,1))))))) => xed | (0,(1,(1,(1,(0,(1,(1,1))))))) => xee | (1,(1,(1,(1,(0,(1,(1,1))))))) => xef | (0,(0,(0,(0,(1,(1,(1,1))))))) => xf0 | (1,(0,(0,(0,(1,(1,(1,1))))))) => xf1 | (0,(1,(0,(0,(1,(1,(1,1))))))) => xf2 | (1,(1,(0,(0,(1,(1,(1,1))))))) => xf3 | (0,(0,(1,(0,(1,(1,(1,1))))))) => xf4 | (1,(0,(1,(0,(1,(1,(1,1))))))) => xf5 | (0,(1,(1,(0,(1,(1,(1,1))))))) => xf6 | (1,(1,(1,(0,(1,(1,(1,1))))))) => xf7 | (0,(0,(0,(1,(1,(1,(1,1))))))) => xf8 | (1,(0,(0,(1,(1,(1,(1,1))))))) => xf9 | (0,(1,(0,(1,(1,(1,(1,1))))))) => xfa | (1,(1,(0,(1,(1,(1,(1,1))))))) => xfb | (0,(0,(1,(1,(1,(1,(1,1))))))) => xfc | (1,(0,(1,(1,(1,(1,(1,1))))))) => xfd | (0,(1,(1,(1,(1,(1,(1,1))))))) => xfe | (1,(1,(1,(1,(1,(1,(1,1))))))) => xff end. Definition to_bits (b : byte) : bool * (bool * (bool * (bool * (bool * (bool * (bool * bool)))))) := match b with | x00 => (0,(0,(0,(0,(0,(0,(0,0))))))) | x01 => (1,(0,(0,(0,(0,(0,(0,0))))))) | x02 => (0,(1,(0,(0,(0,(0,(0,0))))))) | x03 => (1,(1,(0,(0,(0,(0,(0,0))))))) | x04 => (0,(0,(1,(0,(0,(0,(0,0))))))) | x05 => (1,(0,(1,(0,(0,(0,(0,0))))))) | x06 => (0,(1,(1,(0,(0,(0,(0,0))))))) | x07 => (1,(1,(1,(0,(0,(0,(0,0))))))) | x08 => (0,(0,(0,(1,(0,(0,(0,0))))))) | x09 => (1,(0,(0,(1,(0,(0,(0,0))))))) | x0a => (0,(1,(0,(1,(0,(0,(0,0))))))) | x0b => (1,(1,(0,(1,(0,(0,(0,0))))))) | x0c => (0,(0,(1,(1,(0,(0,(0,0))))))) | x0d => (1,(0,(1,(1,(0,(0,(0,0))))))) | x0e => (0,(1,(1,(1,(0,(0,(0,0))))))) | x0f => (1,(1,(1,(1,(0,(0,(0,0))))))) | x10 => (0,(0,(0,(0,(1,(0,(0,0))))))) | x11 => (1,(0,(0,(0,(1,(0,(0,0))))))) | x12 => (0,(1,(0,(0,(1,(0,(0,0))))))) | x13 => (1,(1,(0,(0,(1,(0,(0,0))))))) | x14 => (0,(0,(1,(0,(1,(0,(0,0))))))) | x15 => (1,(0,(1,(0,(1,(0,(0,0))))))) | x16 => (0,(1,(1,(0,(1,(0,(0,0))))))) | x17 => (1,(1,(1,(0,(1,(0,(0,0))))))) | x18 => (0,(0,(0,(1,(1,(0,(0,0))))))) | x19 => (1,(0,(0,(1,(1,(0,(0,0))))))) | x1a => (0,(1,(0,(1,(1,(0,(0,0))))))) | x1b => (1,(1,(0,(1,(1,(0,(0,0))))))) | x1c => (0,(0,(1,(1,(1,(0,(0,0))))))) | x1d => (1,(0,(1,(1,(1,(0,(0,0))))))) | x1e => (0,(1,(1,(1,(1,(0,(0,0))))))) | x1f => (1,(1,(1,(1,(1,(0,(0,0))))))) | x20 => (0,(0,(0,(0,(0,(1,(0,0))))))) | x21 => (1,(0,(0,(0,(0,(1,(0,0))))))) | x22 => (0,(1,(0,(0,(0,(1,(0,0))))))) | x23 => (1,(1,(0,(0,(0,(1,(0,0))))))) | x24 => (0,(0,(1,(0,(0,(1,(0,0))))))) | x25 => (1,(0,(1,(0,(0,(1,(0,0))))))) | x26 => (0,(1,(1,(0,(0,(1,(0,0))))))) | x27 => (1,(1,(1,(0,(0,(1,(0,0))))))) | x28 => (0,(0,(0,(1,(0,(1,(0,0))))))) | x29 => (1,(0,(0,(1,(0,(1,(0,0))))))) | x2a => (0,(1,(0,(1,(0,(1,(0,0))))))) | x2b => (1,(1,(0,(1,(0,(1,(0,0))))))) | x2c => (0,(0,(1,(1,(0,(1,(0,0))))))) | x2d => (1,(0,(1,(1,(0,(1,(0,0))))))) | x2e => (0,(1,(1,(1,(0,(1,(0,0))))))) | x2f => (1,(1,(1,(1,(0,(1,(0,0))))))) | x30 => (0,(0,(0,(0,(1,(1,(0,0))))))) | x31 => (1,(0,(0,(0,(1,(1,(0,0))))))) | x32 => (0,(1,(0,(0,(1,(1,(0,0))))))) | x33 => (1,(1,(0,(0,(1,(1,(0,0))))))) | x34 => (0,(0,(1,(0,(1,(1,(0,0))))))) | x35 => (1,(0,(1,(0,(1,(1,(0,0))))))) | x36 => (0,(1,(1,(0,(1,(1,(0,0))))))) | x37 => (1,(1,(1,(0,(1,(1,(0,0))))))) | x38 => (0,(0,(0,(1,(1,(1,(0,0))))))) | x39 => (1,(0,(0,(1,(1,(1,(0,0))))))) | x3a => (0,(1,(0,(1,(1,(1,(0,0))))))) | x3b => (1,(1,(0,(1,(1,(1,(0,0))))))) | x3c => (0,(0,(1,(1,(1,(1,(0,0))))))) | x3d => (1,(0,(1,(1,(1,(1,(0,0))))))) | x3e => (0,(1,(1,(1,(1,(1,(0,0))))))) | x3f => (1,(1,(1,(1,(1,(1,(0,0))))))) | x40 => (0,(0,(0,(0,(0,(0,(1,0))))))) | x41 => (1,(0,(0,(0,(0,(0,(1,0))))))) | x42 => (0,(1,(0,(0,(0,(0,(1,0))))))) | x43 => (1,(1,(0,(0,(0,(0,(1,0))))))) | x44 => (0,(0,(1,(0,(0,(0,(1,0))))))) | x45 => (1,(0,(1,(0,(0,(0,(1,0))))))) | x46 => (0,(1,(1,(0,(0,(0,(1,0))))))) | x47 => (1,(1,(1,(0,(0,(0,(1,0))))))) | x48 => (0,(0,(0,(1,(0,(0,(1,0))))))) | x49 => (1,(0,(0,(1,(0,(0,(1,0))))))) | x4a => (0,(1,(0,(1,(0,(0,(1,0))))))) | x4b => (1,(1,(0,(1,(0,(0,(1,0))))))) | x4c => (0,(0,(1,(1,(0,(0,(1,0))))))) | x4d => (1,(0,(1,(1,(0,(0,(1,0))))))) | x4e => (0,(1,(1,(1,(0,(0,(1,0))))))) | x4f => (1,(1,(1,(1,(0,(0,(1,0))))))) | x50 => (0,(0,(0,(0,(1,(0,(1,0))))))) | x51 => (1,(0,(0,(0,(1,(0,(1,0))))))) | x52 => (0,(1,(0,(0,(1,(0,(1,0))))))) | x53 => (1,(1,(0,(0,(1,(0,(1,0))))))) | x54 => (0,(0,(1,(0,(1,(0,(1,0))))))) | x55 => (1,(0,(1,(0,(1,(0,(1,0))))))) | x56 => (0,(1,(1,(0,(1,(0,(1,0))))))) | x57 => (1,(1,(1,(0,(1,(0,(1,0))))))) | x58 => (0,(0,(0,(1,(1,(0,(1,0))))))) | x59 => (1,(0,(0,(1,(1,(0,(1,0))))))) | x5a => (0,(1,(0,(1,(1,(0,(1,0))))))) | x5b => (1,(1,(0,(1,(1,(0,(1,0))))))) | x5c => (0,(0,(1,(1,(1,(0,(1,0))))))) | x5d => (1,(0,(1,(1,(1,(0,(1,0))))))) | x5e => (0,(1,(1,(1,(1,(0,(1,0))))))) | x5f => (1,(1,(1,(1,(1,(0,(1,0))))))) | x60 => (0,(0,(0,(0,(0,(1,(1,0))))))) | x61 => (1,(0,(0,(0,(0,(1,(1,0))))))) | x62 => (0,(1,(0,(0,(0,(1,(1,0))))))) | x63 => (1,(1,(0,(0,(0,(1,(1,0))))))) | x64 => (0,(0,(1,(0,(0,(1,(1,0))))))) | x65 => (1,(0,(1,(0,(0,(1,(1,0))))))) | x66 => (0,(1,(1,(0,(0,(1,(1,0))))))) | x67 => (1,(1,(1,(0,(0,(1,(1,0))))))) | x68 => (0,(0,(0,(1,(0,(1,(1,0))))))) | x69 => (1,(0,(0,(1,(0,(1,(1,0))))))) | x6a => (0,(1,(0,(1,(0,(1,(1,0))))))) | x6b => (1,(1,(0,(1,(0,(1,(1,0))))))) | x6c => (0,(0,(1,(1,(0,(1,(1,0))))))) | x6d => (1,(0,(1,(1,(0,(1,(1,0))))))) | x6e => (0,(1,(1,(1,(0,(1,(1,0))))))) | x6f => (1,(1,(1,(1,(0,(1,(1,0))))))) | x70 => (0,(0,(0,(0,(1,(1,(1,0))))))) | x71 => (1,(0,(0,(0,(1,(1,(1,0))))))) | x72 => (0,(1,(0,(0,(1,(1,(1,0))))))) | x73 => (1,(1,(0,(0,(1,(1,(1,0))))))) | x74 => (0,(0,(1,(0,(1,(1,(1,0))))))) | x75 => (1,(0,(1,(0,(1,(1,(1,0))))))) | x76 => (0,(1,(1,(0,(1,(1,(1,0))))))) | x77 => (1,(1,(1,(0,(1,(1,(1,0))))))) | x78 => (0,(0,(0,(1,(1,(1,(1,0))))))) | x79 => (1,(0,(0,(1,(1,(1,(1,0))))))) | x7a => (0,(1,(0,(1,(1,(1,(1,0))))))) | x7b => (1,(1,(0,(1,(1,(1,(1,0))))))) | x7c => (0,(0,(1,(1,(1,(1,(1,0))))))) | x7d => (1,(0,(1,(1,(1,(1,(1,0))))))) | x7e => (0,(1,(1,(1,(1,(1,(1,0))))))) | x7f => (1,(1,(1,(1,(1,(1,(1,0))))))) | x80 => (0,(0,(0,(0,(0,(0,(0,1))))))) | x81 => (1,(0,(0,(0,(0,(0,(0,1))))))) | x82 => (0,(1,(0,(0,(0,(0,(0,1))))))) | x83 => (1,(1,(0,(0,(0,(0,(0,1))))))) | x84 => (0,(0,(1,(0,(0,(0,(0,1))))))) | x85 => (1,(0,(1,(0,(0,(0,(0,1))))))) | x86 => (0,(1,(1,(0,(0,(0,(0,1))))))) | x87 => (1,(1,(1,(0,(0,(0,(0,1))))))) | x88 => (0,(0,(0,(1,(0,(0,(0,1))))))) | x89 => (1,(0,(0,(1,(0,(0,(0,1))))))) | x8a => (0,(1,(0,(1,(0,(0,(0,1))))))) | x8b => (1,(1,(0,(1,(0,(0,(0,1))))))) | x8c => (0,(0,(1,(1,(0,(0,(0,1))))))) | x8d => (1,(0,(1,(1,(0,(0,(0,1))))))) | x8e => (0,(1,(1,(1,(0,(0,(0,1))))))) | x8f => (1,(1,(1,(1,(0,(0,(0,1))))))) | x90 => (0,(0,(0,(0,(1,(0,(0,1))))))) | x91 => (1,(0,(0,(0,(1,(0,(0,1))))))) | x92 => (0,(1,(0,(0,(1,(0,(0,1))))))) | x93 => (1,(1,(0,(0,(1,(0,(0,1))))))) | x94 => (0,(0,(1,(0,(1,(0,(0,1))))))) | x95 => (1,(0,(1,(0,(1,(0,(0,1))))))) | x96 => (0,(1,(1,(0,(1,(0,(0,1))))))) | x97 => (1,(1,(1,(0,(1,(0,(0,1))))))) | x98 => (0,(0,(0,(1,(1,(0,(0,1))))))) | x99 => (1,(0,(0,(1,(1,(0,(0,1))))))) | x9a => (0,(1,(0,(1,(1,(0,(0,1))))))) | x9b => (1,(1,(0,(1,(1,(0,(0,1))))))) | x9c => (0,(0,(1,(1,(1,(0,(0,1))))))) | x9d => (1,(0,(1,(1,(1,(0,(0,1))))))) | x9e => (0,(1,(1,(1,(1,(0,(0,1))))))) | x9f => (1,(1,(1,(1,(1,(0,(0,1))))))) | xa0 => (0,(0,(0,(0,(0,(1,(0,1))))))) | xa1 => (1,(0,(0,(0,(0,(1,(0,1))))))) | xa2 => (0,(1,(0,(0,(0,(1,(0,1))))))) | xa3 => (1,(1,(0,(0,(0,(1,(0,1))))))) | xa4 => (0,(0,(1,(0,(0,(1,(0,1))))))) | xa5 => (1,(0,(1,(0,(0,(1,(0,1))))))) | xa6 => (0,(1,(1,(0,(0,(1,(0,1))))))) | xa7 => (1,(1,(1,(0,(0,(1,(0,1))))))) | xa8 => (0,(0,(0,(1,(0,(1,(0,1))))))) | xa9 => (1,(0,(0,(1,(0,(1,(0,1))))))) | xaa => (0,(1,(0,(1,(0,(1,(0,1))))))) | xab => (1,(1,(0,(1,(0,(1,(0,1))))))) | xac => (0,(0,(1,(1,(0,(1,(0,1))))))) | xad => (1,(0,(1,(1,(0,(1,(0,1))))))) | xae => (0,(1,(1,(1,(0,(1,(0,1))))))) | xaf => (1,(1,(1,(1,(0,(1,(0,1))))))) | xb0 => (0,(0,(0,(0,(1,(1,(0,1))))))) | xb1 => (1,(0,(0,(0,(1,(1,(0,1))))))) | xb2 => (0,(1,(0,(0,(1,(1,(0,1))))))) | xb3 => (1,(1,(0,(0,(1,(1,(0,1))))))) | xb4 => (0,(0,(1,(0,(1,(1,(0,1))))))) | xb5 => (1,(0,(1,(0,(1,(1,(0,1))))))) | xb6 => (0,(1,(1,(0,(1,(1,(0,1))))))) | xb7 => (1,(1,(1,(0,(1,(1,(0,1))))))) | xb8 => (0,(0,(0,(1,(1,(1,(0,1))))))) | xb9 => (1,(0,(0,(1,(1,(1,(0,1))))))) | xba => (0,(1,(0,(1,(1,(1,(0,1))))))) | xbb => (1,(1,(0,(1,(1,(1,(0,1))))))) | xbc => (0,(0,(1,(1,(1,(1,(0,1))))))) | xbd => (1,(0,(1,(1,(1,(1,(0,1))))))) | xbe => (0,(1,(1,(1,(1,(1,(0,1))))))) | xbf => (1,(1,(1,(1,(1,(1,(0,1))))))) | xc0 => (0,(0,(0,(0,(0,(0,(1,1))))))) | xc1 => (1,(0,(0,(0,(0,(0,(1,1))))))) | xc2 => (0,(1,(0,(0,(0,(0,(1,1))))))) | xc3 => (1,(1,(0,(0,(0,(0,(1,1))))))) | xc4 => (0,(0,(1,(0,(0,(0,(1,1))))))) | xc5 => (1,(0,(1,(0,(0,(0,(1,1))))))) | xc6 => (0,(1,(1,(0,(0,(0,(1,1))))))) | xc7 => (1,(1,(1,(0,(0,(0,(1,1))))))) | xc8 => (0,(0,(0,(1,(0,(0,(1,1))))))) | xc9 => (1,(0,(0,(1,(0,(0,(1,1))))))) | xca => (0,(1,(0,(1,(0,(0,(1,1))))))) | xcb => (1,(1,(0,(1,(0,(0,(1,1))))))) | xcc => (0,(0,(1,(1,(0,(0,(1,1))))))) | xcd => (1,(0,(1,(1,(0,(0,(1,1))))))) | xce => (0,(1,(1,(1,(0,(0,(1,1))))))) | xcf => (1,(1,(1,(1,(0,(0,(1,1))))))) | xd0 => (0,(0,(0,(0,(1,(0,(1,1))))))) | xd1 => (1,(0,(0,(0,(1,(0,(1,1))))))) | xd2 => (0,(1,(0,(0,(1,(0,(1,1))))))) | xd3 => (1,(1,(0,(0,(1,(0,(1,1))))))) | xd4 => (0,(0,(1,(0,(1,(0,(1,1))))))) | xd5 => (1,(0,(1,(0,(1,(0,(1,1))))))) | xd6 => (0,(1,(1,(0,(1,(0,(1,1))))))) | xd7 => (1,(1,(1,(0,(1,(0,(1,1))))))) | xd8 => (0,(0,(0,(1,(1,(0,(1,1))))))) | xd9 => (1,(0,(0,(1,(1,(0,(1,1))))))) | xda => (0,(1,(0,(1,(1,(0,(1,1))))))) | xdb => (1,(1,(0,(1,(1,(0,(1,1))))))) | xdc => (0,(0,(1,(1,(1,(0,(1,1))))))) | xdd => (1,(0,(1,(1,(1,(0,(1,1))))))) | xde => (0,(1,(1,(1,(1,(0,(1,1))))))) | xdf => (1,(1,(1,(1,(1,(0,(1,1))))))) | xe0 => (0,(0,(0,(0,(0,(1,(1,1))))))) | xe1 => (1,(0,(0,(0,(0,(1,(1,1))))))) | xe2 => (0,(1,(0,(0,(0,(1,(1,1))))))) | xe3 => (1,(1,(0,(0,(0,(1,(1,1))))))) | xe4 => (0,(0,(1,(0,(0,(1,(1,1))))))) | xe5 => (1,(0,(1,(0,(0,(1,(1,1))))))) | xe6 => (0,(1,(1,(0,(0,(1,(1,1))))))) | xe7 => (1,(1,(1,(0,(0,(1,(1,1))))))) | xe8 => (0,(0,(0,(1,(0,(1,(1,1))))))) | xe9 => (1,(0,(0,(1,(0,(1,(1,1))))))) | xea => (0,(1,(0,(1,(0,(1,(1,1))))))) | xeb => (1,(1,(0,(1,(0,(1,(1,1))))))) | xec => (0,(0,(1,(1,(0,(1,(1,1))))))) | xed => (1,(0,(1,(1,(0,(1,(1,1))))))) | xee => (0,(1,(1,(1,(0,(1,(1,1))))))) | xef => (1,(1,(1,(1,(0,(1,(1,1))))))) | xf0 => (0,(0,(0,(0,(1,(1,(1,1))))))) | xf1 => (1,(0,(0,(0,(1,(1,(1,1))))))) | xf2 => (0,(1,(0,(0,(1,(1,(1,1))))))) | xf3 => (1,(1,(0,(0,(1,(1,(1,1))))))) | xf4 => (0,(0,(1,(0,(1,(1,(1,1))))))) | xf5 => (1,(0,(1,(0,(1,(1,(1,1))))))) | xf6 => (0,(1,(1,(0,(1,(1,(1,1))))))) | xf7 => (1,(1,(1,(0,(1,(1,(1,1))))))) | xf8 => (0,(0,(0,(1,(1,(1,(1,1))))))) | xf9 => (1,(0,(0,(1,(1,(1,(1,1))))))) | xfa => (0,(1,(0,(1,(1,(1,(1,1))))))) | xfb => (1,(1,(0,(1,(1,(1,(1,1))))))) | xfc => (0,(0,(1,(1,(1,(1,(1,1))))))) | xfd => (1,(0,(1,(1,(1,(1,(1,1))))))) | xfe => (0,(1,(1,(1,(1,(1,(1,1))))))) | xff => (1,(1,(1,(1,(1,(1,(1,1))))))) end. Lemma of_bits_to_bits (b : byte) : of_bits (to_bits b) = b. Proof. destruct b; exact eq_refl. Qed. Lemma to_bits_of_bits (b : _) : to_bits (of_bits b) = b. Proof. repeat match goal with | p : prod _ _ |- _ => destruct p | b : bool |- _ => destruct b end; exact eq_refl. Qed. Definition byte_of_byte (b : byte) : byte := b. Module Export ByteSyntaxNotations. String Notation byte byte_of_byte byte_of_byte : byte_scope. End ByteSyntaxNotations. coq-8.20.0/theories/Init/Datatypes.v000066400000000000000000000345571466560755400172750ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* a = true /\ b = true. Proof. destruct a, b; repeat split; assumption. Qed. #[global] Hint Resolve andb_prop: bool. Register andb_prop as core.bool.andb_prop. Lemma andb_true_intro (b1 b2:bool) : b1 = true /\ b2 = true -> andb b1 b2 = true. Proof. destruct b1; destruct b2; simpl; intros [? ?]; assumption. Qed. #[global] Hint Resolve andb_true_intro: bool. Register andb_true_intro as core.bool.andb_true_intro. (** Interpretation of booleans as propositions *) Inductive eq_true : bool -> Prop := is_eq_true : eq_true true. #[global] Hint Constructors eq_true : eq_true. Register eq_true as core.eq_true.type. (** Another way of interpreting booleans as propositions *) Definition is_true b := b = true. (** [is_true] can be activated as a coercion by ([Local]) [Coercion is_true : bool >-> Sortclass]. *) (** Additional rewriting lemmas about [eq_true] *) Lemma eq_true_ind_r : forall (P : bool -> Prop) (b : bool), P b -> eq_true b -> P true. Proof. intros P b H H0; destruct H0 in H; assumption. Defined. Lemma eq_true_rec_r : forall (P : bool -> Set) (b : bool), P b -> eq_true b -> P true. Proof. intros P b H H0; destruct H0 in H; assumption. Defined. Lemma eq_true_rect_r : forall (P : bool -> Type) (b : bool), P b -> eq_true b -> P true. Proof. intros P b H H0; destruct H0 in H; assumption. Defined. (** The [BoolSpec] inductive will be used to relate a [boolean] value and two propositions corresponding respectively to the [true] case and the [false] case. Interest: [BoolSpec] behave nicely with [case] and [destruct]. See also [Bool.reflect] when [Q = ~P]. *) Inductive BoolSpec (P Q : Prop) : bool -> Prop := | BoolSpecT : P -> BoolSpec P Q true | BoolSpecF : Q -> BoolSpec P Q false. #[global] Hint Constructors BoolSpec : core. Register BoolSpec as core.BoolSpec.type. Register BoolSpecT as core.BoolSpec.BoolSpecT. Register BoolSpecF as core.BoolSpec.BoolSpecF. (********************************************************************) (** * Peano natural numbers *) (** [nat] is the datatype of natural numbers built from [O] and successor [S]; note that the constructor name is the letter O. Numbers in [nat] can be denoted using a decimal notation; e.g. [3%nat] abbreviates [S (S (S O))] *) Inductive nat : Set := | O : nat | S : nat -> nat. Declare Scope hex_nat_scope. Delimit Scope hex_nat_scope with xnat. Declare Scope nat_scope. Delimit Scope nat_scope with nat. Bind Scope nat_scope with nat. Arguments S _%_nat. Register nat as num.nat.type. Register O as num.nat.O. Register S as num.nat.S. (********************************************************************) (** * Container datatypes *) (* Set Universe Polymorphism. *) (** [option A] is the extension of [A] with an extra element [None] *) #[universes(template)] Inductive option (A:Type) : Type := | Some : A -> option A | None : option A. Arguments Some {A} a. Arguments None {A}. Register option as core.option.type. Register Some as core.option.Some. Register None as core.option.None. Definition option_map (A B:Type) (f:A->B) (o : option A) : option B := match o with | Some a => @Some B (f a) | None => @None B end. (** [sum A B], written [A + B], is the disjoint sum of [A] and [B] *) #[universes(template)] Inductive sum (A B:Type) : Type := | inl : A -> sum A B | inr : B -> sum A B. Notation "x + y" := (sum x y) : type_scope. Arguments inl {A B} _ , [A] B _. Arguments inr {A B} _ , A [B] _. Register sum as core.sum.type. Register inl as core.sum.inl. Register inr as core.sum.inr. (** [prod A B], written [A * B], is the product of [A] and [B]; the pair [pair A B a b] of [a] and [b] is abbreviated [(a,b)] *) #[universes(template)] Inductive prod (A B:Type) : Type := pair : A -> B -> A * B where "x * y" := (prod x y) : type_scope. Add Printing Let prod. Notation "( x , y , .. , z )" := (pair .. (pair x y) .. z) : core_scope. Arguments pair {A B} _ _. Register prod as core.prod.type. Register pair as core.prod.intro. Register prod_rect as core.prod.rect. Section projections. Context {A : Type} {B : Type}. Definition fst (p:A * B) := match p with (x, y) => x end. Definition snd (p:A * B) := match p with (x, y) => y end. Register fst as core.prod.proj1. Register snd as core.prod.proj2. End projections. #[global] Hint Resolve pair inl inr: core. Lemma surjective_pairing (A B:Type) (p:A * B) : p = (fst p, snd p). Proof. destruct p; reflexivity. Qed. Lemma injective_projections (A B:Type) (p1 p2:A * B) : fst p1 = fst p2 -> snd p1 = snd p2 -> p1 = p2. Proof. destruct p1; destruct p2; simpl; intros Hfst Hsnd. rewrite Hfst; rewrite Hsnd; reflexivity. Qed. Lemma pair_equal_spec (A B : Type) (a1 a2 : A) (b1 b2 : B) : (a1, b1) = (a2, b2) <-> a1 = a2 /\ b1 = b2. Proof with auto. split; intro H. - split. + replace a1 with (fst (a1, b1)); replace a2 with (fst (a2, b2))... rewrite H... + replace b1 with (snd (a1, b1)); replace b2 with (snd (a2, b2))... rewrite H... - destruct H; subst... Qed. Definition curry {A B C:Type} (f:A * B -> C) (x:A) (y:B) : C := f (x,y). Definition uncurry {A B C:Type} (f:A -> B -> C) (p:A * B) : C := match p with (x, y) => f x y end. Import EqNotations. Lemma rew_pair A (P Q : A->Type) x1 x2 (y1:P x1) (y2:Q x1) (H:x1=x2) : (rew H in y1, rew H in y2) = rew [fun x => (P x * Q x)%type] H in (y1,y2). Proof. destruct H. reflexivity. Defined. (** Polymorphic lists and some operations *) #[universes(template)] Inductive list (A : Type) : Type := | nil : list A | cons : A -> list A -> list A. Arguments nil {A}. Arguments cons {A} a l. Declare Scope list_scope. Delimit Scope list_scope with list. Bind Scope list_scope with list. Infix "::" := cons (at level 60, right associativity) : list_scope. Register list as core.list.type. Register nil as core.list.nil. Register cons as core.list.cons. Local Open Scope list_scope. Definition length (A : Type) : list A -> nat := fix length l := match l with | nil => O | _ :: l' => S (length l') end. (** Concatenation of two lists *) Definition app (A : Type) : list A -> list A -> list A := fix app l m := match l with | nil => m | a :: l1 => a :: app l1 m end. Infix "++" := app (right associativity, at level 60) : list_scope. (* Unset Universe Polymorphism. *) (********************************************************************) (** * The comparison datatype *) Inductive comparison : Set := | Eq : comparison | Lt : comparison | Gt : comparison. Register comparison as core.comparison.type. Register Eq as core.comparison.Eq. Register Lt as core.comparison.Lt. Register Gt as core.comparison.Gt. Lemma comparison_eq_stable (c c' : comparison) : ~~ c = c' -> c = c'. Proof. destruct c, c'; intro H; reflexivity || destruct H; discriminate. Qed. Definition CompOpp (r:comparison) := match r with | Eq => Eq | Lt => Gt | Gt => Lt end. Lemma CompOpp_involutive c : CompOpp (CompOpp c) = c. Proof. destruct c; reflexivity. Qed. Lemma CompOpp_inj c c' : CompOpp c = CompOpp c' -> c = c'. Proof. destruct c; destruct c'; auto; discriminate. Qed. Lemma CompOpp_iff : forall c c', CompOpp c = c' <-> c = CompOpp c'. Proof. split; intros; apply CompOpp_inj; rewrite CompOpp_involutive; auto. Qed. (** The [CompareSpec] inductive relates a [comparison] value with three propositions, one for each possible case. Typically, it can be used to specify a comparison function via some equality and order predicates. Interest: [CompareSpec] behave nicely with [case] and [destruct]. *) Inductive CompareSpec (Peq Plt Pgt : Prop) : comparison -> Prop := | CompEq : Peq -> CompareSpec Peq Plt Pgt Eq | CompLt : Plt -> CompareSpec Peq Plt Pgt Lt | CompGt : Pgt -> CompareSpec Peq Plt Pgt Gt. #[global] Hint Constructors CompareSpec : core. Register CompareSpec as core.CompareSpec.type. Register CompEq as core.CompareSpec.CompEq. Register CompLt as core.CompareSpec.CompLt. Register CompGt as core.CompareSpec.CompGt. (** For having clean interfaces after extraction, [CompareSpec] is declared in Prop. For some situations, it is nonetheless useful to have a version in Type. Interestingly, these two versions are equivalent. *) Inductive CompareSpecT (Peq Plt Pgt : Prop) : comparison -> Type := | CompEqT : Peq -> CompareSpecT Peq Plt Pgt Eq | CompLtT : Plt -> CompareSpecT Peq Plt Pgt Lt | CompGtT : Pgt -> CompareSpecT Peq Plt Pgt Gt. #[global] Hint Constructors CompareSpecT : core. Register CompareSpecT as core.CompareSpecT.type. Register CompEqT as core.CompareSpecT.CompEqT. Register CompLtT as core.CompareSpecT.CompLtT. Register CompGtT as core.CompareSpecT.CompGtT. Lemma CompareSpec2Type Peq Plt Pgt c : CompareSpec Peq Plt Pgt c -> CompareSpecT Peq Plt Pgt c. Proof. destruct c; intros H; constructor; inversion_clear H; auto. Defined. (** As an alternate formulation, one may also directly refer to predicates [eq] and [lt] for specifying a comparison, rather that fully-applied propositions. This [CompSpec] is now a particular case of [CompareSpec]. *) Definition CompSpec {A} (eq lt : A->A->Prop)(x y:A) : comparison -> Prop := CompareSpec (eq x y) (lt x y) (lt y x). Definition CompSpecT {A} (eq lt : A->A->Prop)(x y:A) : comparison -> Type := CompareSpecT (eq x y) (lt x y) (lt y x). #[global] Hint Unfold CompSpec CompSpecT : core. Lemma CompSpec2Type : forall A (eq lt:A->A->Prop) x y c, CompSpec eq lt x y c -> CompSpecT eq lt x y c. Proof. intros. apply CompareSpec2Type; assumption. Defined. (******************************************************************) (** * Misc Other Datatypes *) (** [identity A a] is the family of datatypes on [A] whose sole non-empty member is the singleton datatype [identity A a a] whose sole inhabitant is denoted [identity_refl A a] *) #[deprecated(since="8.16",note="Use eq instead")] Notation identity := eq (only parsing). #[deprecated(since="8.16",note="Use eq_refl instead")] Notation identity_refl := eq_refl (only parsing). #[deprecated(since="8.16",note="Use eq_ind instead")] Notation identity_ind := eq_ind (only parsing). #[deprecated(since="8.16",note="Use eq_rec instead")] Notation identity_rec := eq_rec (only parsing). #[deprecated(since="8.16",note="Use eq_rect instead")] Notation identity_rect := eq_rect (only parsing). #[deprecated(since="8.16",note="Use eq_sym instead")] Notation identity_sym := eq_sym (only parsing). #[deprecated(since="8.16",note="Use eq_trans instead")] Notation identity_trans := eq_trans (only parsing). #[deprecated(since="8.16",note="Use f_equal instead")] Notation identity_congr := f_equal (only parsing). #[deprecated(since="8.16",note="Use not_eq_sym instead")] Notation not_identity_sym := not_eq_sym (only parsing). #[deprecated(since="8.16",note="Use eq_ind_r instead")] Notation identity_ind_r := eq_ind_r (only parsing). #[deprecated(since="8.16",note="Use eq_rec_r instead")] Notation identity_rec_r := eq_rec_r (only parsing). #[deprecated(since="8.16",note="Use eq_rect_r instead")] Notation identity_rect_r := eq_rect_r (only parsing). Register eq as core.identity.type. Register eq_refl as core.identity.refl. Register eq_ind as core.identity.ind. Register eq_sym as core.identity.sym. Register eq_trans as core.identity.trans. Register f_equal as core.identity.congr. #[deprecated(since="8.16",note="Use eq_refl instead")] Notation refl_id := eq_refl (only parsing). #[deprecated(since="8.16",note="Use eq_sym instead")] Notation sym_id := eq_sym (only parsing). #[deprecated(since="8.16",note="Use eq_trans instead")] Notation trans_id := eq_trans (only parsing). #[deprecated(since="8.16",note="Use not_eq_sym instead")] Notation sym_not_id := not_eq_sym (only parsing). (** Identity type *) Definition ID := forall A:Type, A -> A. Definition id : ID := fun A x => x. Definition IDProp := forall A:Prop, A -> A. Definition idProp : IDProp := fun A x => x. Register idProp as core.IDProp.idProp. (* begin hide *) (* Compatibility *) Notation prodT := prod (only parsing). Notation pairT := pair (only parsing). Notation prodT_rect := prod_rect (only parsing). Notation prodT_rec := prod_rec (only parsing). Notation prodT_ind := prod_ind (only parsing). Notation fstT := fst (only parsing). Notation sndT := snd (only parsing). (* end hide *) coq-8.20.0/theories/Init/Decimal.v000066400000000000000000000153301466560755400166610ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* O | D0 d | D1 d | D2 d | D3 d | D4 d | D5 d | D6 d | D7 d | D8 d | D9 d => S (nb_digits d) end. (** This representation favors simplicity over canonicity. For normalizing numbers, we need to remove head zero digits, and choose our canonical representation of 0 (here [D0 Nil] for unsigned numbers and [Pos (D0 Nil)] for signed numbers). *) (** [nzhead] removes all head zero digits *) Fixpoint nzhead d := match d with | D0 d => nzhead d | _ => d end. (** [unorm] : normalization of unsigned integers *) Definition unorm d := match nzhead d with | Nil => zero | d => d end. (** [norm] : normalization of signed integers *) Definition norm d := match d with | Pos d => Pos (unorm d) | Neg d => match nzhead d with | Nil => Pos zero | d => Neg d end end. (** A few easy operations. For more advanced computations, use the conversions with other Coq numeral datatypes (e.g. Z) and the operations on them. *) Definition opp (d:int) := match d with | Pos d => Neg d | Neg d => Pos d end. Definition abs (d:int) : uint := match d with | Pos d => d | Neg d => d end. (** For conversions with binary numbers, it is easier to operate on little-endian numbers. *) Fixpoint revapp (d d' : uint) := match d with | Nil => d' | D0 d => revapp d (D0 d') | D1 d => revapp d (D1 d') | D2 d => revapp d (D2 d') | D3 d => revapp d (D3 d') | D4 d => revapp d (D4 d') | D5 d => revapp d (D5 d') | D6 d => revapp d (D6 d') | D7 d => revapp d (D7 d') | D8 d => revapp d (D8 d') | D9 d => revapp d (D9 d') end. Definition rev d := revapp d Nil. Definition app d d' := revapp (rev d) d'. Definition app_int d1 d2 := match d1 with Pos d1 => Pos (app d1 d2) | Neg d1 => Neg (app d1 d2) end. (** [nztail] removes all trailing zero digits and return both the result and the number of removed digits. *) Definition nztail d := let fix aux d_rev := match d_rev with | D0 d_rev => let (r, n) := aux d_rev in pair r (S n) | _ => pair d_rev O end in let (r, n) := aux (rev d) in pair (rev r) n. Definition nztail_int d := match d with | Pos d => let (r, n) := nztail d in pair (Pos r) n | Neg d => let (r, n) := nztail d in pair (Neg r) n end. (** [del_head n d] removes [n] digits at beginning of [d] or returns [zero] if [d] has less than [n] digits. *) Fixpoint del_head n d := match n with | O => d | S n => match d with | Nil => zero | D0 d | D1 d | D2 d | D3 d | D4 d | D5 d | D6 d | D7 d | D8 d | D9 d => del_head n d end end. Definition del_head_int n d := match d with | Pos d => del_head n d | Neg d => del_head n d end. (** [del_tail n d] removes [n] digits at end of [d] or returns [zero] if [d] has less than [n] digits. *) Definition del_tail n d := rev (del_head n (rev d)). Definition del_tail_int n d := match d with | Pos d => Pos (del_tail n d) | Neg d => Neg (del_tail n d) end. Module Little. (** Successor of little-endian numbers *) Fixpoint succ d := match d with | Nil => D1 Nil | D0 d => D1 d | D1 d => D2 d | D2 d => D3 d | D3 d => D4 d | D4 d => D5 d | D5 d => D6 d | D6 d => D7 d | D7 d => D8 d | D8 d => D9 d | D9 d => D0 (succ d) end. (** Doubling little-endian numbers *) Fixpoint double d := match d with | Nil => Nil | D0 d => D0 (double d) | D1 d => D2 (double d) | D2 d => D4 (double d) | D3 d => D6 (double d) | D4 d => D8 (double d) | D5 d => D0 (succ_double d) | D6 d => D2 (succ_double d) | D7 d => D4 (succ_double d) | D8 d => D6 (succ_double d) | D9 d => D8 (succ_double d) end with succ_double d := match d with | Nil => D1 Nil | D0 d => D1 (double d) | D1 d => D3 (double d) | D2 d => D5 (double d) | D3 d => D7 (double d) | D4 d => D9 (double d) | D5 d => D1 (succ_double d) | D6 d => D3 (succ_double d) | D7 d => D5 (succ_double d) | D8 d => D7 (succ_double d) | D9 d => D9 (succ_double d) end. End Little. (** Pseudo-conversion functions used when declaring Number Notations on [uint] and [int]. *) Definition uint_of_uint (i:uint) := i. Definition int_of_int (i:int) := i. coq-8.20.0/theories/Init/Hexadecimal.v000066400000000000000000000166401466560755400175340ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* O | D0 d | D1 d | D2 d | D3 d | D4 d | D5 d | D6 d | D7 d | D8 d | D9 d | Da d | Db d | Dc d | Dd d | De d | Df d => S (nb_digits d) end. (** This representation favors simplicity over canonicity. For normalizing numbers, we need to remove head zero digits, and choose our canonical representation of 0 (here [D0 Nil] for unsigned numbers and [Pos (D0 Nil)] for signed numbers). *) (** [nzhead] removes all head zero digits *) Fixpoint nzhead d := match d with | D0 d => nzhead d | _ => d end. (** [unorm] : normalization of unsigned integers *) Definition unorm d := match nzhead d with | Nil => zero | d => d end. (** [norm] : normalization of signed integers *) Definition norm d := match d with | Pos d => Pos (unorm d) | Neg d => match nzhead d with | Nil => Pos zero | d => Neg d end end. (** A few easy operations. For more advanced computations, use the conversions with other Coq numeral datatypes (e.g. Z) and the operations on them. *) Definition opp (d:int) := match d with | Pos d => Neg d | Neg d => Pos d end. Definition abs (d:int) : uint := match d with | Pos d => d | Neg d => d end. (** For conversions with binary numbers, it is easier to operate on little-endian numbers. *) Fixpoint revapp (d d' : uint) := match d with | Nil => d' | D0 d => revapp d (D0 d') | D1 d => revapp d (D1 d') | D2 d => revapp d (D2 d') | D3 d => revapp d (D3 d') | D4 d => revapp d (D4 d') | D5 d => revapp d (D5 d') | D6 d => revapp d (D6 d') | D7 d => revapp d (D7 d') | D8 d => revapp d (D8 d') | D9 d => revapp d (D9 d') | Da d => revapp d (Da d') | Db d => revapp d (Db d') | Dc d => revapp d (Dc d') | Dd d => revapp d (Dd d') | De d => revapp d (De d') | Df d => revapp d (Df d') end. Definition rev d := revapp d Nil. Definition app d d' := revapp (rev d) d'. Definition app_int d1 d2 := match d1 with Pos d1 => Pos (app d1 d2) | Neg d1 => Neg (app d1 d2) end. (** [nztail] removes all trailing zero digits and return both the result and the number of removed digits. *) Definition nztail d := let fix aux d_rev := match d_rev with | D0 d_rev => let (r, n) := aux d_rev in pair r (S n) | _ => pair d_rev O end in let (r, n) := aux (rev d) in pair (rev r) n. Definition nztail_int d := match d with | Pos d => let (r, n) := nztail d in pair (Pos r) n | Neg d => let (r, n) := nztail d in pair (Neg r) n end. (** [del_head n d] removes [n] digits at beginning of [d] or returns [zero] if [d] has less than [n] digits. *) Fixpoint del_head n d := match n with | O => d | S n => match d with | Nil => zero | D0 d | D1 d | D2 d | D3 d | D4 d | D5 d | D6 d | D7 d | D8 d | D9 d | Da d | Db d | Dc d | Dd d | De d | Df d => del_head n d end end. Definition del_head_int n d := match d with | Pos d => del_head n d | Neg d => del_head n d end. (** [del_tail n d] removes [n] digits at end of [d] or returns [zero] if [d] has less than [n] digits. *) Definition del_tail n d := rev (del_head n (rev d)). Definition del_tail_int n d := match d with | Pos d => Pos (del_tail n d) | Neg d => Neg (del_tail n d) end. Module Little. (** Successor of little-endian numbers *) Fixpoint succ d := match d with | Nil => D1 Nil | D0 d => D1 d | D1 d => D2 d | D2 d => D3 d | D3 d => D4 d | D4 d => D5 d | D5 d => D6 d | D6 d => D7 d | D7 d => D8 d | D8 d => D9 d | D9 d => Da d | Da d => Db d | Db d => Dc d | Dc d => Dd d | Dd d => De d | De d => Df d | Df d => D0 (succ d) end. (** Doubling little-endian numbers *) Fixpoint double d := match d with | Nil => Nil | D0 d => D0 (double d) | D1 d => D2 (double d) | D2 d => D4 (double d) | D3 d => D6 (double d) | D4 d => D8 (double d) | D5 d => Da (double d) | D6 d => Dc (double d) | D7 d => De (double d) | D8 d => D0 (succ_double d) | D9 d => D2 (succ_double d) | Da d => D4 (succ_double d) | Db d => D6 (succ_double d) | Dc d => D8 (succ_double d) | Dd d => Da (succ_double d) | De d => Dc (succ_double d) | Df d => De (succ_double d) end with succ_double d := match d with | Nil => D1 Nil | D0 d => D1 (double d) | D1 d => D3 (double d) | D2 d => D5 (double d) | D3 d => D7 (double d) | D4 d => D9 (double d) | D5 d => Db (double d) | D6 d => Dd (double d) | D7 d => Df (double d) | D8 d => D1 (succ_double d) | D9 d => D3 (succ_double d) | Da d => D5 (succ_double d) | Db d => D7 (succ_double d) | Dc d => D9 (succ_double d) | Dd d => Db (succ_double d) | De d => Dd (succ_double d) | Df d => Df (succ_double d) end. End Little. coq-8.20.0/theories/Init/Logic.v000066400000000000000000001211311466560755400163550ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* B" := (forall (_ : A), B) : type_scope. (** * Propositional connectives *) (** [True] is the always true proposition *) Inductive True : Prop := I : True. Register True as core.True.type. Register I as core.True.I. (** [False] is the always false proposition *) Inductive False : Prop :=. Register False as core.False.type. (** [not A], written [~A], is the negation of [A] *) Definition not (A:Prop) := A -> False. Notation "~ x" := (not x) : type_scope. Register not as core.not.type. (** Negation of a type in [Type] *) Definition notT (A:Type) := A -> False. (** Create the "core" hint database, and set its transparent state for variables and constants explicitly. *) Create HintDb core. #[global] Hint Variables Opaque : core. #[global] Hint Constants Opaque : core. #[global] Hint Unfold not: core. (** [and A B], written [A /\ B], is the conjunction of [A] and [B] [conj p q] is a proof of [A /\ B] as soon as [p] is a proof of [A] and [q] a proof of [B] [proj1] and [proj2] are first and second projections of a conjunction *) Inductive and (A B:Prop) : Prop := conj : A -> B -> A /\ B where "A /\ B" := (and A B) : type_scope. Register and as core.and.type. Register conj as core.and.conj. Section Conjunction. Variables A B : Prop. Theorem proj1 : A /\ B -> A. Proof. destruct 1; trivial. Qed. Theorem proj2 : A /\ B -> B. Proof. destruct 1; trivial. Qed. End Conjunction. (** [or A B], written [A \/ B], is the disjunction of [A] and [B] *) Inductive or (A B:Prop) : Prop := | or_introl : A -> A \/ B | or_intror : B -> A \/ B where "A \/ B" := (or A B) : type_scope. Arguments or_introl [A B] _, [A] B _. Arguments or_intror [A B] _, A [B] _. Register or as core.or.type. (** [iff A B], written [A <-> B], expresses the equivalence of [A] and [B] *) Definition iff (A B:Prop) := (A -> B) /\ (B -> A). Notation "A <-> B" := (iff A B) : type_scope. Register iff as core.iff.type. Register proj1 as core.iff.proj1. Register proj2 as core.iff.proj2. Section Equivalence. Theorem iff_refl : forall A:Prop, A <-> A. Proof. split; auto. Qed. Theorem iff_trans : forall A B C:Prop, (A <-> B) -> (B <-> C) -> (A <-> C). Proof. intros A B C [H1 H2] [H3 H4]; split; auto. Qed. Theorem iff_sym : forall A B:Prop, (A <-> B) -> (B <-> A). Proof. intros A B [H1 H2]; split; auto. Qed. End Equivalence. #[global] Hint Unfold iff: extcore. (** Backward direction of the equivalences above does not need assumptions *) Theorem and_iff_compat_l : forall A B C : Prop, (B <-> C) -> (A /\ B <-> A /\ C). Proof. intros ? ? ? [Hl Hr]; split; intros [? ?]; (split; [ assumption | ]); [apply Hl | apply Hr]; assumption. Qed. Theorem and_iff_compat_r : forall A B C : Prop, (B <-> C) -> (B /\ A <-> C /\ A). Proof. intros ? ? ? [Hl Hr]; split; intros [? ?]; (split; [ | assumption ]); [apply Hl | apply Hr]; assumption. Qed. Theorem or_iff_compat_l : forall A B C : Prop, (B <-> C) -> (A \/ B <-> A \/ C). Proof. intros ? ? ? [Hl Hr]; split; (intros [?|?]; [left; assumption| right]); [apply Hl | apply Hr]; assumption. Qed. Theorem or_iff_compat_r : forall A B C : Prop, (B <-> C) -> (B \/ A <-> C \/ A). Proof. intros ? ? ? [Hl Hr]; split; (intros [?|?]; [left| right; assumption]); [apply Hl | apply Hr]; assumption. Qed. Theorem imp_iff_compat_l : forall A B C : Prop, (B <-> C) -> ((A -> B) <-> (A -> C)). Proof. intros ? ? ? [Hl Hr]; split; intros H ?; [apply Hl | apply Hr]; apply H; assumption. Qed. Theorem imp_iff_compat_r : forall A B C : Prop, (B <-> C) -> ((B -> A) <-> (C -> A)). Proof. intros ? ? ? [Hl Hr]; split; intros H ?; [apply H, Hr | apply H, Hl]; assumption. Qed. Theorem not_iff_compat : forall A B : Prop, (A <-> B) -> (~ A <-> ~B). Proof. intros; apply imp_iff_compat_r; assumption. Qed. (** Some equivalences *) Theorem neg_false : forall A : Prop, ~ A <-> (A <-> False). Proof. intro A; unfold not; split. - intro H; split; [exact H | intro H1; elim H1]. - intros [H _]; exact H. Qed. Theorem and_cancel_l : forall A B C : Prop, (B -> A) -> (C -> A) -> ((A /\ B <-> A /\ C) <-> (B <-> C)). Proof. intros A B C Hl Hr. split; [ | apply and_iff_compat_l]; intros [HypL HypR]; split; intros. + apply HypL; split; [apply Hl | ]; assumption. + apply HypR; split; [apply Hr | ]; assumption. Qed. Theorem and_cancel_r : forall A B C : Prop, (B -> A) -> (C -> A) -> ((B /\ A <-> C /\ A) <-> (B <-> C)). Proof. intros A B C Hl Hr. split; [ | apply and_iff_compat_r]; intros [HypL HypR]; split; intros. + apply HypL; split; [ | apply Hl ]; assumption. + apply HypR; split; [ | apply Hr ]; assumption. Qed. Theorem and_comm : forall A B : Prop, A /\ B <-> B /\ A. Proof. intros; split; intros [? ?]; split; assumption. Qed. Theorem and_assoc : forall A B C : Prop, (A /\ B) /\ C <-> A /\ B /\ C. Proof. intros; split; [ intros [[? ?] ?]| intros [? [? ?]]]; repeat split; assumption. Qed. Theorem or_cancel_l : forall A B C : Prop, (B -> ~ A) -> (C -> ~ A) -> ((A \/ B <-> A \/ C) <-> (B <-> C)). Proof. intros ? ? ? Fl Fr; split; [ | apply or_iff_compat_l]; intros [Hl Hr]; split; intros. { destruct Hl; [ right | destruct Fl | ]; assumption. } { destruct Hr; [ right | destruct Fr | ]; assumption. } Qed. Theorem or_cancel_r : forall A B C : Prop, (B -> ~ A) -> (C -> ~ A) -> ((B \/ A <-> C \/ A) <-> (B <-> C)). Proof. intros ? ? ? Fl Fr; split; [ | apply or_iff_compat_r]; intros [Hl Hr]; split; intros. { destruct Hl; [ left | | destruct Fl ]; assumption. } { destruct Hr; [ left | | destruct Fr ]; assumption. } Qed. Theorem or_comm : forall A B : Prop, (A \/ B) <-> (B \/ A). Proof. intros; split; (intros [? | ?]; [ right | left ]; assumption). Qed. Theorem or_assoc : forall A B C : Prop, (A \/ B) \/ C <-> A \/ B \/ C. Proof. intros; split; [ intros [[?|?]|?]| intros [?|[?|?]]]. + left; assumption. + right; left; assumption. + right; right; assumption. + left; left; assumption. + left; right; assumption. + right; assumption. Qed. Lemma iff_and : forall A B : Prop, (A <-> B) -> (A -> B) /\ (B -> A). Proof. intros A B []; split; trivial. Qed. Lemma iff_to_and : forall A B : Prop, (A <-> B) <-> (A -> B) /\ (B -> A). Proof. intros; split; intros [Hl Hr]; (split; intros; [ apply Hl | apply Hr]); assumption. Qed. (** * First-order quantifiers *) (** [ex P], or simply [exists x, P x], or also [exists x:A, P x], expresses the existence of an [x] of some type [A] in [Set] which satisfies the predicate [P]. This is existential quantification. [ex2 P Q], or simply [exists2 x, P x & Q x], or also [exists2 x:A, P x & Q x], expresses the existence of an [x] of type [A] which satisfies both predicates [P] and [Q]. Universal quantification is primitively written [forall x:A, Q]. By symmetry with existential quantification, the construction [all P] is provided too. *) Inductive ex (A:Type) (P:A -> Prop) : Prop := ex_intro : forall x:A, P x -> ex (A:=A) P. Register ex as core.ex.type. Register ex_intro as core.ex.intro. Section Projections. Variables (A:Prop) (P:A->Prop). Definition ex_proj1 (x:ex P) : A := match x with ex_intro _ a _ => a end. Definition ex_proj2 (x:ex P) : P (ex_proj1 x) := match x with ex_intro _ _ b => b end. Register ex_proj1 as core.ex.proj1. Register ex_proj2 as core.ex.proj2. End Projections. Inductive ex2 (A:Type) (P Q:A -> Prop) : Prop := ex_intro2 : forall x:A, P x -> Q x -> ex2 (A:=A) P Q. (** [ex2] of a predicate can be projected to an [ex]. This allows [ex_proj1] and [ex_proj2] to be usable with [ex2]. We have two choices here: either we can set up the definition so that [ex_proj1] of a coerced [X : ex2 P Q] will unify with [let (a, _, _) := X in a] by restricting the first argument of [ex2] to be a [Prop], or we can define a more general [ex_of_ex2] which does not satisfy this conversion rule. We choose the former, under the assumption that there is no reason to turn an [ex2] into an [ex] unless it is to project out the components. *) Definition ex_of_ex2 (A : Prop) (P Q : A -> Prop) (X : ex2 P Q) : ex P := ex_intro P (let (a, _, _) := X in a) (let (x, p, _) as s return (P (let (a, _, _) := s in a)) := X in p). Section ex2_Projections. Variables (A:Prop) (P Q:A->Prop). Definition ex_proj3 (x:ex2 P Q) : Q (ex_proj1 (ex_of_ex2 x)) := match x with ex_intro2 _ _ _ _ b => b end. End ex2_Projections. Definition all (A:Type) (P:A -> Prop) := forall x:A, P x. Register all as core.all. (* Rule order is important to give printing priority to fully typed exists *) Notation "'exists' x .. y , p" := (ex (fun x => .. (ex (fun y => p)) ..)) (at level 200, x binder, right associativity, format "'[' 'exists' '/ ' x .. y , '/ ' p ']'") : type_scope. Notation "'exists2' x , p & q" := (ex2 (fun x => p) (fun x => q)) (at level 200, x name, p at level 200, right associativity) : type_scope. Notation "'exists2' x : A , p & q" := (ex2 (A:=A) (fun x => p) (fun x => q)) (at level 200, x name, A at level 200, p at level 200, right associativity, format "'[' 'exists2' '/ ' x : A , '/ ' '[' p & '/' q ']' ']'") : type_scope. Notation "'exists2' ' x , p & q" := (ex2 (fun x => p) (fun x => q)) (at level 200, x strict pattern, p at level 200, right associativity) : type_scope. Notation "'exists2' ' x : A , p & q" := (ex2 (A:=A) (fun x => p) (fun x => q)) (at level 200, x strict pattern, A at level 200, p at level 200, right associativity, format "'[' 'exists2' '/ ' ' x : A , '/ ' '[' p & '/' q ']' ']'") : type_scope. (** Derived rules for universal quantification *) Section universal_quantification. Variable A : Type. Variable P : A -> Prop. Theorem inst : forall x:A, all (fun x => P x) -> P x. Proof. unfold all; auto. Qed. Theorem gen : forall (B:Prop) (f:forall y:A, B -> P y), B -> all P. Proof. red; auto. Qed. End universal_quantification. (** * Equality *) (** [eq x y], or simply [x=y] expresses the equality of [x] and [y]. Both [x] and [y] must belong to the same type [A]. The definition is inductive and states the reflexivity of the equality. The others properties (symmetry, transitivity, replacement of equals by equals) are proved below. The type of [x] and [y] can be made explicit using the notation [x = y :> A]. This is Leibniz equality as it expresses that [x] and [y] are equal iff every property on [A] which is true of [x] is also true of [y] *) Inductive eq (A:Type) (x:A) : A -> Prop := eq_refl : x = x :>A where "x = y :> A" := (@eq A x y) : type_scope. Arguments eq {A} x _. Arguments eq_refl {A x} , [A] x. Arguments eq_ind [A] x P _ y _ : rename. Arguments eq_rec [A] x P _ y _ : rename. Arguments eq_rect [A] x P _ y _ : rename. Notation "x = y" := (eq x y) : type_scope. Notation "x <> y :> T" := (~ x = y :>T) : type_scope. Notation "x <> y" := (~ (x = y)) : type_scope. #[global] Hint Resolve I conj or_introl or_intror : core. #[global] Hint Resolve eq_refl: core. #[global] Hint Resolve ex_intro ex_intro2: core. Register eq as core.eq.type. Register eq_refl as core.eq.refl. Register eq_ind as core.eq.ind. Register eq_rect as core.eq.rect. Section Logic_lemmas. Theorem absurd : forall A C:Prop, A -> ~ A -> C. Proof. unfold not; intros A C h1 h2. destruct (h2 h1). Qed. Section equality. Variables A B : Type. Variable f : A -> B. Variables x y z : A. Theorem eq_sym : x = y -> y = x. Proof. destruct 1; trivial. Defined. Register eq_sym as core.eq.sym. Theorem eq_trans : x = y -> y = z -> x = z. Proof. destruct 2; trivial. Defined. Register eq_trans as core.eq.trans. Theorem eq_trans_r : x = y -> z = y -> x = z. Proof. destruct 2; trivial. Defined. Theorem f_equal : x = y -> f x = f y. Proof. destruct 1; trivial. Defined. Register f_equal as core.eq.congr. Theorem not_eq_sym : x <> y -> y <> x. Proof. red; intros h1 h2; apply h1; destruct h2; trivial. Qed. End equality. Definition eq_sind_r : forall (A:Type) (x:A) (P:A -> SProp), P x -> forall y:A, y = x -> P y. Proof. intros A x P H y H0. elim eq_sym with (1 := H0); assumption. Defined. Definition eq_ind_r : forall (A:Type) (x:A) (P:A -> Prop), P x -> forall y:A, y = x -> P y. intros A x P H y H0. elim eq_sym with (1 := H0); assumption. Defined. Register eq_ind_r as core.eq.ind_r. Definition eq_rec_r : forall (A:Type) (x:A) (P:A -> Set), P x -> forall y:A, y = x -> P y. intros A x P H y H0; elim eq_sym with (1 := H0); assumption. Defined. Definition eq_rect_r : forall (A:Type) (x:A) (P:A -> Type), P x -> forall y:A, y = x -> P y. intros A x P H y H0; elim eq_sym with (1 := H0); assumption. Defined. End Logic_lemmas. Module EqNotations. Notation "'rew' H 'in' H'" := (eq_rect _ _ H' _ H) (at level 10, H' at level 10, format "'[' 'rew' H in '/' H' ']'"). Notation "'rew' [ P ] H 'in' H'" := (eq_rect _ P H' _ H) (at level 10, H' at level 10, format "'[' 'rew' [ P ] '/ ' H in '/' H' ']'"). Notation "'rew' <- H 'in' H'" := (eq_rect_r _ H' H) (at level 10, H' at level 10, format "'[' 'rew' <- H in '/' H' ']'"). Notation "'rew' <- [ P ] H 'in' H'" := (eq_rect_r P H' H) (at level 10, H' at level 10, format "'[' 'rew' <- [ P ] '/ ' H in '/' H' ']'"). Notation "'rew' -> H 'in' H'" := (eq_rect _ _ H' _ H) (at level 10, H' at level 10, only parsing). Notation "'rew' -> [ P ] H 'in' H'" := (eq_rect _ P H' _ H) (at level 10, H' at level 10, only parsing). Notation "'rew' 'dependent' H 'in' H'" := (match H with | eq_refl => H' end) (at level 10, H' at level 10, format "'[' 'rew' 'dependent' '/ ' H in '/' H' ']'"). Notation "'rew' 'dependent' -> H 'in' H'" := (match H with | eq_refl => H' end) (at level 10, H' at level 10, only parsing). Notation "'rew' 'dependent' <- H 'in' H'" := (match eq_sym H with | eq_refl => H' end) (at level 10, H' at level 10, format "'[' 'rew' 'dependent' <- '/ ' H in '/' H' ']'"). Notation "'rew' 'dependent' [ 'fun' y p => P ] H 'in' H'" := (match H as p in (_ = y) return P with | eq_refl => H' end) (at level 10, H' at level 10, y name, p name, format "'[' 'rew' 'dependent' [ 'fun' y p => P ] '/ ' H in '/' H' ']'"). Notation "'rew' 'dependent' -> [ 'fun' y p => P ] H 'in' H'" := (match H as p in (_ = y) return P with | eq_refl => H' end) (at level 10, H' at level 10, y name, p name, only parsing). Notation "'rew' 'dependent' <- [ 'fun' y p => P ] H 'in' H'" := (match eq_sym H as p in (_ = y) return P with | eq_refl => H' end) (at level 10, H' at level 10, y name, p name, format "'[' 'rew' 'dependent' <- [ 'fun' y p => P ] '/ ' H in '/' H' ']'"). Notation "'rew' 'dependent' [ P ] H 'in' H'" := (match H as p in (_ = y) return P y p with | eq_refl => H' end) (at level 10, H' at level 10, format "'[' 'rew' 'dependent' [ P ] '/ ' H in '/' H' ']'"). Notation "'rew' 'dependent' -> [ P ] H 'in' H'" := (match H as p in (_ = y) return P y p with | eq_refl => H' end) (at level 10, H' at level 10, only parsing). Notation "'rew' 'dependent' <- [ P ] H 'in' H'" := (match eq_sym H as p in (_ = y) return P y p with | eq_refl => H' end) (at level 10, H' at level 10, format "'[' 'rew' 'dependent' <- [ P ] '/ ' H in '/' H' ']'"). End EqNotations. Import EqNotations. Section equality_dep. Variable A : Type. Variable B : A -> Type. Variable f : forall x, B x. Variables x y : A. Theorem f_equal_dep (H: x = y) : rew H in f x = f y. Proof. destruct H; reflexivity. Defined. End equality_dep. Lemma f_equal_dep2 {A A' B B'} (f : A -> A') (g : forall a:A, B a -> B' (f a)) {x1 x2 : A} {y1 : B x1} {y2 : B x2} (H : x1 = x2) : rew H in y1 = y2 -> rew f_equal f H in g x1 y1 = g x2 y2. Proof. destruct H, 1. reflexivity. Defined. Lemma rew_opp_r A (P:A->Type) (x y:A) (H:x=y) (a:P y) : rew H in rew <- H in a = a. Proof. destruct H. reflexivity. Defined. Lemma rew_opp_l A (P:A->Type) (x y:A) (H:x=y) (a:P x) : rew <- H in rew H in a = a. Proof. destruct H. reflexivity. Defined. Theorem f_equal2 : forall (A1 A2 B:Type) (f:A1 -> A2 -> B) (x1 y1:A1) (x2 y2:A2), x1 = y1 -> x2 = y2 -> f x1 x2 = f y1 y2. Proof. destruct 1; destruct 1; reflexivity. Qed. Register f_equal2 as core.eq.congr2. Theorem f_equal3 : forall (A1 A2 A3 B:Type) (f:A1 -> A2 -> A3 -> B) (x1 y1:A1) (x2 y2:A2) (x3 y3:A3), x1 = y1 -> x2 = y2 -> x3 = y3 -> f x1 x2 x3 = f y1 y2 y3. Proof. destruct 1; destruct 1; destruct 1; reflexivity. Qed. Theorem f_equal4 : forall (A1 A2 A3 A4 B:Type) (f:A1 -> A2 -> A3 -> A4 -> B) (x1 y1:A1) (x2 y2:A2) (x3 y3:A3) (x4 y4:A4), x1 = y1 -> x2 = y2 -> x3 = y3 -> x4 = y4 -> f x1 x2 x3 x4 = f y1 y2 y3 y4. Proof. destruct 1; destruct 1; destruct 1; destruct 1; reflexivity. Qed. Theorem f_equal5 : forall (A1 A2 A3 A4 A5 B:Type) (f:A1 -> A2 -> A3 -> A4 -> A5 -> B) (x1 y1:A1) (x2 y2:A2) (x3 y3:A3) (x4 y4:A4) (x5 y5:A5), x1 = y1 -> x2 = y2 -> x3 = y3 -> x4 = y4 -> x5 = y5 -> f x1 x2 x3 x4 x5 = f y1 y2 y3 y4 y5. Proof. destruct 1; destruct 1; destruct 1; destruct 1; destruct 1; reflexivity. Qed. Theorem f_equal_compose A B C (a b:A) (f:A->B) (g:B->C) (e:a=b) : f_equal g (f_equal f e) = f_equal (fun a => g (f a)) e. Proof. destruct e. reflexivity. Defined. (** The groupoid structure of equality *) Theorem eq_trans_refl_l A (x y:A) (e:x=y) : eq_trans eq_refl e = e. Proof. destruct e. reflexivity. Defined. Theorem eq_trans_refl_r A (x y:A) (e:x=y) : eq_trans e eq_refl = e. Proof. destruct e. reflexivity. Defined. Theorem eq_sym_involutive A (x y:A) (e:x=y) : eq_sym (eq_sym e) = e. Proof. destruct e; reflexivity. Defined. Theorem eq_trans_sym_inv_l A (x y:A) (e:x=y) : eq_trans (eq_sym e) e = eq_refl. Proof. destruct e; reflexivity. Defined. Theorem eq_trans_sym_inv_r A (x y:A) (e:x=y) : eq_trans e (eq_sym e) = eq_refl. Proof. destruct e; reflexivity. Defined. Theorem eq_trans_assoc A (x y z t:A) (e:x=y) (e':y=z) (e'':z=t) : eq_trans e (eq_trans e' e'') = eq_trans (eq_trans e e') e''. Proof. destruct e''; reflexivity. Defined. Theorem rew_map A B (P:B->Type) (f:A->B) x1 x2 (H:x1=x2) (y:P (f x1)) : rew [fun x => P (f x)] H in y = rew f_equal f H in y. Proof. destruct H; reflexivity. Defined. Theorem eq_trans_map {A B} {x1 x2 x3:A} {y1:B x1} {y2:B x2} {y3:B x3} (H1:x1=x2) (H2:x2=x3) (H1': rew H1 in y1 = y2) (H2': rew H2 in y2 = y3) : rew eq_trans H1 H2 in y1 = y3. Proof. destruct H2. exact (eq_trans H1' H2'). Defined. Lemma map_subst {A} {P Q:A->Type} (f : forall x, P x -> Q x) {x y} (H:x=y) (z:P x) : rew H in f x z = f y (rew H in z). Proof. destruct H. reflexivity. Defined. Lemma map_subst_map {A B} {P:A->Type} {Q:B->Type} (f:A->B) (g : forall x, P x -> Q (f x)) {x y} (H:x=y) (z:P x) : rew f_equal f H in g x z = g y (rew H in z). Proof. destruct H. reflexivity. Defined. Lemma rew_swap A (P:A->Type) x1 x2 (H:x1=x2) (y1:P x1) (y2:P x2) : rew H in y1 = y2 -> y1 = rew <- H in y2. Proof. destruct H. trivial. Defined. Lemma rew_compose A (P:A->Type) x1 x2 x3 (H1:x1=x2) (H2:x2=x3) (y:P x1) : rew H2 in rew H1 in y = rew (eq_trans H1 H2) in y. Proof. destruct H2. reflexivity. Defined. (** Extra properties of equality *) Theorem eq_id_comm_l A (f:A->A) (Hf:forall a, a = f a) a : f_equal f (Hf a) = Hf (f a). Proof. unfold f_equal. rewrite <- (eq_trans_sym_inv_l (Hf a)). destruct (Hf a) at 1 2. destruct (Hf a). reflexivity. Defined. Theorem eq_id_comm_r A (f:A->A) (Hf:forall a, f a = a) a : f_equal f (Hf a) = Hf (f a). Proof. unfold f_equal. rewrite <- (eq_trans_sym_inv_l (Hf (f (f a)))). set (Hfsymf := fun a => eq_sym (Hf a)). change (eq_sym (Hf (f (f a)))) with (Hfsymf (f (f a))). pattern (Hfsymf (f (f a))). destruct (eq_id_comm_l f Hfsymf (f a)). destruct (eq_id_comm_l f Hfsymf a). unfold Hfsymf. destruct (Hf a). simpl. rewrite eq_trans_refl_l. reflexivity. Defined. Lemma eq_refl_map_distr A B x (f:A->B) : f_equal f (eq_refl x) = eq_refl (f x). Proof. reflexivity. Qed. Lemma eq_trans_map_distr A B x y z (f:A->B) (e:x=y) (e':y=z) : f_equal f (eq_trans e e') = eq_trans (f_equal f e) (f_equal f e'). Proof. destruct e'. reflexivity. Defined. Lemma eq_sym_map_distr A B (x y:A) (f:A->B) (e:x=y) : eq_sym (f_equal f e) = f_equal f (eq_sym e). Proof. destruct e. reflexivity. Defined. Lemma eq_trans_sym_distr A (x y z:A) (e:x=y) (e':y=z) : eq_sym (eq_trans e e') = eq_trans (eq_sym e') (eq_sym e). Proof. destruct e, e'. reflexivity. Defined. Lemma eq_trans_rew_distr A (P:A -> Type) (x y z:A) (e:x=y) (e':y=z) (k:P x) : rew (eq_trans e e') in k = rew e' in rew e in k. Proof. destruct e, e'; reflexivity. Qed. Lemma rew_const A P (x y:A) (e:x=y) (k:P) : rew [fun _ => P] e in k = k. Proof. destruct e; reflexivity. Qed. (* Aliases *) Notation sym_eq := eq_sym (only parsing). Notation trans_eq := eq_trans (only parsing). Notation sym_not_eq := not_eq_sym (only parsing). Notation refl_equal := eq_refl (only parsing). Notation sym_equal := eq_sym (only parsing). Notation trans_equal := eq_trans (only parsing). Notation sym_not_equal := not_eq_sym (only parsing). #[global] Hint Immediate eq_sym not_eq_sym: core. (** Basic definitions about relations and properties *) Definition subrelation (A B : Type) (R R' : A->B->Prop) := forall x y, R x y -> R' x y. Definition unique (A : Type) (P : A->Prop) (x:A) := P x /\ forall (x':A), P x' -> x=x'. Definition uniqueness (A:Type) (P:A->Prop) := forall x y, P x -> P y -> x = y. (** Unique existence *) Notation "'exists' ! x .. y , p" := (ex (unique (fun x => .. (ex (unique (fun y => p))) ..))) (at level 200, x binder, right associativity, format "'[' 'exists' ! '/ ' x .. y , '/ ' p ']'") : type_scope. Lemma unique_existence : forall (A:Type) (P:A->Prop), ((exists x, P x) /\ uniqueness P) <-> (exists! x, P x). Proof. intros A P; split. - intros ((x,Hx),Huni); exists x; red; auto. - intros (x,(Hx,Huni)); split. + exists x; assumption. + intros x' x'' Hx' Hx''; transitivity x. * symmetry; auto. * auto. Qed. Lemma forall_exists_unique_domain_coincide : forall A (P:A->Prop), (exists! x, P x) -> forall Q:A->Prop, (forall x, P x -> Q x) <-> (exists x, P x /\ Q x). Proof. intros A P (x & Hp & Huniq); split. - intro; exists x; auto. - intros (x0 & HPx0 & HQx0) x1 HPx1. assert (H : x0 = x1) by (transitivity x; [symmetry|]; auto). destruct H. assumption. Qed. Lemma forall_exists_coincide_unique_domain : forall A (P:A->Prop), (forall Q:A->Prop, (forall x, P x -> Q x) <-> (exists x, P x /\ Q x)) -> (exists! x, P x). Proof. intros A P H. destruct (H P) as ((x & Hx & _),_); [trivial|]. exists x. split; [trivial|]. destruct (H (fun x'=>x=x')) as (_,Huniq). apply Huniq. exists x; auto. Qed. (** * Being inhabited *) (** The predicate [inhabited] can be used in different contexts. If [A] is thought as a type, [inhabited A] states that [A] is inhabited. If [A] is thought as a computationally relevant proposition, then [inhabited A] weakens [A] so as to hide its computational meaning. The so-weakened proof remains computationally relevant but only in a propositional context. *) Inductive inhabited (A:Type) : Prop := inhabits : A -> inhabited A. #[global] Hint Resolve inhabits: core. Lemma exists_inhabited : forall (A:Type) (P:A->Prop), (exists x, P x) -> inhabited A. Proof. destruct 1; auto. Qed. Lemma inhabited_covariant (A B : Type) : (A -> B) -> inhabited A -> inhabited B. Proof. intros f [x];exact (inhabits (f x)). Qed. (** Declaration of stepl and stepr for eq and iff *) Lemma eq_stepl : forall (A : Type) (x y z : A), x = y -> x = z -> z = y. Proof. intros A x y z H1 H2. rewrite <- H2; exact H1. Qed. Declare Left Step eq_stepl. Declare Right Step eq_trans. Lemma iff_stepl : forall A B C : Prop, (A <-> B) -> (A <-> C) -> (C <-> B). Proof. intros ? ? ? [? ?] [? ?]; split; intros; auto. Qed. Declare Left Step iff_stepl. Declare Right Step iff_trans. (** More properties of [ex] and [ex2] that rely on equality being present *) (** We define restricted versions of [ex_rect] and [ex_rec] which allow elimination into non-Prop sorts when the inductive is not informative *) (** η Principles *) Definition ex_eta {A : Prop} {P} (p : exists a : A, P a) : p = ex_intro _ (ex_proj1 p) (ex_proj2 p). Proof. destruct p; reflexivity. Defined. Definition ex2_eta {A : Prop} {P Q} (p : exists2 a : A, P a & Q a) : p = ex_intro2 _ _ (ex_proj1 (ex_of_ex2 p)) (ex_proj2 (ex_of_ex2 p)) (ex_proj3 p). Proof. destruct p; reflexivity. Defined. Section ex_Prop. Variables (A:Prop) (P:A->Prop). Definition ex_rect (P0 : ex P -> Type) (f : forall x p, P0 (ex_intro P x p)) : forall e, P0 e := fun e => rew <- ex_eta e in f _ _. Definition ex_rec : forall (P0 : ex P -> Set) (f : forall x p, P0 (ex_intro P x p)), forall e, P0 e := ex_rect. End ex_Prop. (** Equality for [ex] *) Section ex. Local Unset Implicit Arguments. (** Projecting an equality of a pair to equality of the first components *) Definition ex_proj1_eq {A : Prop} {P : A -> Prop} {u v : exists a : A, P a} (p : u = v) : ex_proj1 u = ex_proj1 v := f_equal (@ex_proj1 _ _) p. (** Projecting an equality of a pair to equality of the second components *) Definition ex_proj2_eq {A : Prop} {P : A -> Prop} {u v : exists a : A, P a} (p : u = v) : rew ex_proj1_eq p in ex_proj2 u = ex_proj2 v := rew dependent p in eq_refl. (** Equality of [ex] is itself a [ex] (forwards-reasoning version) *) Definition eq_ex_intro_uncurried {A : Type} {P : A -> Prop} {u1 v1 : A} {u2 : P u1} {v2 : P v1} (pq : exists p : u1 = v1, rew p in u2 = v2) : ex_intro _ u1 u2 = ex_intro _ v1 v2. Proof. destruct pq as [p q]. destruct q; simpl in *. destruct p; reflexivity. Defined. (** Equality of [ex] is itself a [ex] (backwards-reasoning version) *) Definition eq_ex_uncurried {A : Prop} {P : A -> Prop} (u v : exists a : A, P a) (pq : exists p : ex_proj1 u = ex_proj1 v, rew p in ex_proj2 u = ex_proj2 v) : u = v. Proof. destruct u as [u1 u2], v as [v1 v2]; simpl in *. apply eq_ex_intro_uncurried; exact pq. Defined. (** Curried version of proving equality of [ex] types *) Definition eq_ex_intro {A : Type} {P : A -> Prop} {u1 v1 : A} {u2 : P u1} {v2 : P v1} (p : u1 = v1) (q : rew p in u2 = v2) : ex_intro _ u1 u2 = ex_intro _ v1 v2 := eq_ex_intro_uncurried (ex_intro _ p q). (** Curried version of proving equality of [ex] types *) Definition eq_ex {A : Prop} {P : A -> Prop} (u v : exists a : A, P a) (p : ex_proj1 u = ex_proj1 v) (q : rew p in ex_proj2 u = ex_proj2 v) : u = v := eq_ex_uncurried u v (ex_intro _ p q). (** In order to have a performant [inversion_sigma], we define specialized versions for when we have constructors on one or both sides of the equality *) Definition eq_ex_intro_l {A : Prop} {P : A -> Prop} u1 u2 (v : exists a : A, P a) (p : u1 = ex_proj1 v) (q : rew p in u2 = ex_proj2 v) : ex_intro P u1 u2 = v := eq_ex (ex_intro P u1 u2) v p q. Definition eq_ex_intro_r {A : Prop} {P : A -> Prop} (u : exists a : A, P a) v1 v2 (p : ex_proj1 u = v1) (q : rew p in ex_proj2 u = v2) : u = ex_intro P v1 v2 := eq_ex u (ex_intro P v1 v2) p q. (** Induction principle for [@eq (ex _)] *) Definition eq_ex_eta {A : Prop} {P : A -> Prop} {u v : exists a : A, P a} (p : u = v) : p = eq_ex u v (ex_proj1_eq p) (ex_proj2_eq p). Proof. destruct p, u; reflexivity. Defined. Definition eq_ex_rect {A : Prop} {P : A -> Prop} {u v : exists a : A, P a} (Q : u = v -> Type) (f : forall p q, Q (eq_ex u v p q)) : forall p, Q p := fun p => rew <- eq_ex_eta p in f _ _. Definition eq_ex_rec {A : Prop} {P : A -> Prop} {u v} (Q : u = v :> (exists a : A, P a) -> Set) := eq_ex_rect Q. Definition eq_ex_ind {A : Prop} {P : A -> Prop} {u v} (Q : u = v :> (exists a : A, P a) -> Prop) := eq_ex_rec Q. (** In order to have a performant [inversion_sigma], we define specialized versions for when we have constructors on one or both sides of the equality *) Definition eq_ex_rect_ex_intro_l {A : Prop} {P : A -> Prop} {u1 u2 v} (Q : _ -> Type) (f : forall p q, Q (eq_ex_intro_l (P:=P) u1 u2 v p q)) : forall p, Q p := eq_ex_rect Q f. Definition eq_ex_rect_ex_intro_r {A : Prop} {P : A -> Prop} {u v1 v2} (Q : _ -> Type) (f : forall p q, Q (eq_ex_intro_r (P:=P) u v1 v2 p q)) : forall p, Q p := eq_ex_rect Q f. Definition eq_ex_rect_ex_intro {A : Prop} {P : A -> Prop} {u1 u2 v1 v2} (Q : _ -> Type) (f : forall p q, Q (@eq_ex_intro A P u1 v1 u2 v2 p q)) : forall p, Q p := eq_ex_rect Q f. Definition eq_ex_rect_uncurried {A : Prop} {P : A -> Prop} {u v : exists a : A, P a} (Q : u = v -> Type) (f : forall pq, Q (eq_ex u v (ex_proj1 pq) (ex_proj2 pq))) : forall p, Q p := eq_ex_rect Q (fun p q => f (ex_intro _ p q)). Definition eq_ex_rec_uncurried {A : Prop} {P : A -> Prop} {u v} (Q : u = v :> (exists a : A, P a) -> Set) := eq_ex_rect_uncurried Q. Definition eq_ex_ind_uncurried {A : Prop} {P : A -> Prop} {u v} (Q : u = v :> (exists a : A, P a) -> Prop) := eq_ex_rec_uncurried Q. (** Equality of [ex] when the property is an hProp *) Definition eq_ex_hprop {A : Prop} {P : A -> Prop} (P_hprop : forall (x : A) (p q : P x), p = q) (u v : exists a : A, P a) (p : ex_proj1 u = ex_proj1 v) : u = v := eq_ex u v p (P_hprop _ _ _). Definition eq_ex_intro_hprop {A : Type} {P : A -> Prop} (P_hprop : forall (x : A) (p q : P x), p = q) {u1 v1 : A} {u2 : P u1} {v2 : P v1} (p : u1 = v1) : ex_intro P u1 u2 = ex_intro P v1 v2 := eq_ex_intro p (P_hprop _ _ _). (** Equivalence of equality of [ex] with a [ex] of equality *) (** We could actually prove an isomorphism here, and not just [<->], but for simplicity, we don't. *) Definition eq_ex_uncurried_iff {A : Prop} {P : A -> Prop} (u v : exists a : A, P a) : u = v <-> exists p : ex_proj1 u = ex_proj1 v, rew p in ex_proj2 u = ex_proj2 v. Proof. split; [ intro; subst; exists eq_refl; reflexivity | apply eq_ex_uncurried ]. Defined. (** Equivalence of equality of [ex] involving hProps with equality of the first components *) Definition eq_ex_hprop_iff {A : Prop} {P : A -> Prop} (P_hprop : forall (x : A) (p q : P x), p = q) (u v : exists a : A, P a) : u = v <-> (ex_proj1 u = ex_proj1 v) := conj (fun p => f_equal (@ex_proj1 _ _) p) (eq_ex_hprop P_hprop u v). Lemma rew_ex {A' : Type} {x} {P : A' -> Prop} (Q : forall a, P a -> Prop) (u : exists p : P x, Q x p) {y} (H : x = y) : rew [fun a => exists p : P a, Q a p] H in u = ex_intro (Q y) (rew H in ex_proj1 u) (rew dependent H in ex_proj2 u). Proof. destruct H, u; reflexivity. Defined. End ex. Global Arguments eq_ex_intro A P _ _ _ _ !p !q / . Section ex2_Prop. Variables (A:Prop) (P Q:A->Prop). Definition ex2_rect (P0 : ex2 P Q -> Type) (f : forall x p q, P0 (ex_intro2 P Q x p q)) : forall e, P0 e := fun e => rew <- ex2_eta e in f _ _ _. Definition ex2_rec : forall (P0 : ex2 P Q -> Set) (f : forall x p q, P0 (ex_intro2 P Q x p q)), forall e, P0 e := ex2_rect. End ex2_Prop. (** Equality for [ex2] *) Section ex2. (* We make [ex_of_ex2] a coercion so we can use [proj1], [proj2] on [ex2] *) Local Coercion ex_of_ex2 : ex2 >-> ex. Local Unset Implicit Arguments. (** Projecting an equality of a pair to equality of the first components *) Definition ex_of_ex2_eq {A : Prop} {P Q : A -> Prop} {u v : exists2 a : A, P a & Q a} (p : u = v) : u = v :> exists a : A, P a := f_equal _ p. Definition ex_proj1_of_ex2_eq {A : Prop} {P Q : A -> Prop} {u v : exists2 a : A, P a & Q a} (p : u = v) : ex_proj1 u = ex_proj1 v := ex_proj1_eq (ex_of_ex2_eq p). (** Projecting an equality of a pair to equality of the second components *) Definition ex_proj2_of_ex2_eq {A : Prop} {P Q : A -> Prop} {u v : exists2 a : A, P a & Q a} (p : u = v) : rew ex_proj1_of_ex2_eq p in ex_proj2 u = ex_proj2 v := rew dependent p in eq_refl. (** Projecting an equality of a pair to equality of the third components *) Definition ex_proj3_eq {A : Prop} {P Q : A -> Prop} {u v : exists2 a : A, P a & Q a} (p : u = v) : rew ex_proj1_of_ex2_eq p in ex_proj3 u = ex_proj3 v := rew dependent p in eq_refl. (** Equality of [ex2] is itself a [ex2] (fowards-reasoning version) *) Definition eq_ex_intro2_uncurried {A : Type} {P Q : A -> Prop} {u1 v1 : A} {u2 : P u1} {v2 : P v1} {u3 : Q u1} {v3 : Q v1} (pqr : exists2 p : u1 = v1, rew p in u2 = v2 & rew p in u3 = v3) : ex_intro2 _ _ u1 u2 u3 = ex_intro2 _ _ v1 v2 v3. Proof. destruct pqr as [p q r]. destruct r, q, p; simpl. reflexivity. Defined. (** Equality of [ex2] is itself a [ex2] (backwards-reasoning version) *) Definition eq_ex2_uncurried {A : Prop} {P Q : A -> Prop} (u v : exists2 a : A, P a & Q a) (pqr : exists2 p : ex_proj1 u = ex_proj1 v, rew p in ex_proj2 u = ex_proj2 v & rew p in ex_proj3 u = ex_proj3 v) : u = v. Proof. destruct u as [u1 u2 u3], v as [v1 v2 v3]; simpl in *. apply eq_ex_intro2_uncurried; exact pqr. Defined. (** Curried version of proving equality of [ex] types *) Definition eq_ex2 {A : Prop} {P Q : A -> Prop} (u v : exists2 a : A, P a & Q a) (p : ex_proj1 u = ex_proj1 v) (q : rew p in ex_proj2 u = ex_proj2 v) (r : rew p in ex_proj3 u = ex_proj3 v) : u = v := eq_ex2_uncurried u v (ex_intro2 _ _ p q r). Definition eq_ex_intro2 {A : Type} {P Q : A -> Prop} {u1 v1 : A} {u2 : P u1} {v2 : P v1} {u3 : Q u1} {v3 : Q v1} (p : u1 = v1) (q : rew p in u2 = v2) (r : rew p in u3 = v3) : ex_intro2 P Q u1 u2 u3 = ex_intro2 P Q v1 v2 v3 := eq_ex_intro2_uncurried (ex_intro2 _ _ p q r). (** In order to have a performant [inversion_sigma], we define specialized versions for when we have constructors on one or both sides of the equality *) Definition eq_ex_intro2_l {A : Prop} {P Q : A -> Prop} u1 u2 u3 (v : exists2 a : A, P a & Q a) (p : u1 = ex_proj1 v) (q : rew p in u2 = ex_proj2 v) (r : rew p in u3 = ex_proj3 v) : ex_intro2 P Q u1 u2 u3 = v := eq_ex2 (ex_intro2 P Q u1 u2 u3) v p q r. Definition eq_ex_intro2_r {A : Prop} {P Q : A -> Prop} (u : exists2 a : A, P a & Q a) v1 v2 v3 (p : ex_proj1 u = v1) (q : rew p in ex_proj2 u = v2) (r : rew p in ex_proj3 u = v3) : u = ex_intro2 P Q v1 v2 v3 := eq_ex2 u (ex_intro2 P Q v1 v2 v3) p q r. (** Equality of [ex2] when the second property is an hProp *) Definition eq_ex2_hprop {A : Prop} {P Q : A -> Prop} (Q_hprop : forall (x : A) (p q : Q x), p = q) (u v : exists2 a : A, P a & Q a) (p : u = v :> exists a : A, P a) : u = v := eq_ex2 u v (ex_proj1_eq p) (ex_proj2_eq p) (Q_hprop _ _ _). Definition eq_ex_intro2_hprop_nondep {A : Type} {P : A -> Prop} {Q : Prop} (Q_hprop : forall (p q : Q), p = q) {u1 v1 : A} {u2 : P u1} {v2 : P v1} {u3 v3 : Q} (p : ex_intro _ u1 u2 = ex_intro _ v1 v2) : ex_intro2 _ _ u1 u2 u3 = ex_intro2 _ _ v1 v2 v3 := rew [fun v3 => _ = ex_intro2 _ _ _ _ v3] (Q_hprop u3 v3) in f_equal (fun u => match u with ex_intro _ u1 u2 => ex_intro2 _ _ u1 u2 u3 end) p. Definition eq_ex_intro2_hprop {A : Type} {P Q : A -> Prop} (P_hprop : forall x (p q : P x), p = q) (Q_hprop : forall x (p q : Q x), p = q) {u1 v1 : A} {u2 : P u1} {v2 : P v1} {u3 : Q u1} {v3 : Q v1} (p : u1 = v1) : ex_intro2 P Q u1 u2 u3 = ex_intro2 P Q v1 v2 v3 := eq_ex_intro2 p (P_hprop _ _ _) (Q_hprop _ _ _). (** Equivalence of equality of [ex2] with a [ex2] of equality *) (** We could actually prove an isomorphism here, and not just [<->], but for simplicity, we don't. *) Definition eq_ex2_uncurried_iff {A : Prop} {P Q : A -> Prop} (u v : exists2 a : A, P a & Q a) : u = v <-> exists2 p : ex_proj1 u = ex_proj1 v, rew p in ex_proj2 u = ex_proj2 v & rew p in ex_proj3 u = ex_proj3 v. Proof. split; [ intro; subst; exists eq_refl; reflexivity | apply eq_ex2_uncurried ]. Defined. (** Induction principle for [@eq (ex2 _ _)] *) Definition eq_ex2_eta {A : Prop} {P Q : A -> Prop} {u v : exists2 a : A, P a & Q a} (p : u = v) : p = eq_ex2 u v (ex_proj1_of_ex2_eq p) (ex_proj2_of_ex2_eq p) (ex_proj3_eq p). Proof. destruct p, u; reflexivity. Defined. Definition eq_ex2_rect {A : Prop} {P Q : A -> Prop} {u v : exists2 a : A, P a & Q a} (R : u = v -> Type) (f : forall p q r, R (eq_ex2 u v p q r)) : forall p, R p := fun p => rew <- eq_ex2_eta p in f _ _ _. Definition eq_ex2_rec {A : Prop} {P Q : A -> Prop} {u v} (R : u = v :> (exists2 a : A, P a & Q a) -> Set) := eq_ex2_rect R. Definition eq_ex2_ind {A : Prop} {P Q : A -> Prop} {u v} (R : u = v :> (exists2 a : A, P a & Q a) -> Prop) := eq_ex2_rec R. (** In order to have a performant [inversion_sigma], we define specialized versions for when we have constructors on one or both sides of the equality *) Definition eq_ex2_rect_ex_intro2_l {A : Prop} {P Q : A -> Prop} {u1 u2 u3 v} (R : _ -> Type) (f : forall p q r, R (eq_ex_intro2_l (P:=P) (Q:=Q) u1 u2 u3 v p q r)) : forall p, R p := eq_ex2_rect R f. Definition eq_ex2_rect_ex_intro2_r {A : Prop} {P Q : A -> Prop} {u v1 v2 v3} (R : _ -> Type) (f : forall p q r, R (eq_ex_intro2_r (P:=P) (Q:=Q) u v1 v2 v3 p q r)) : forall p, R p := eq_ex2_rect R f. Definition eq_ex2_rect_ex_intro2 {A : Prop} {P Q : A -> Prop} {u1 u2 u3 v1 v2 v3} (R : _ -> Type) (f : forall p q r, R (@eq_ex_intro2 A P Q u1 v1 u2 v2 u3 v3 p q r)) : forall p, R p := eq_ex2_rect R f. Definition eq_ex2_rect_uncurried {A : Prop} {P Q : A -> Prop} {u v : exists2 a : A, P a & Q a} (R : u = v -> Type) (f : forall pqr : exists2 p : _ = _, _ & _, R (eq_ex2 u v (ex_proj1 pqr) (ex_proj2 pqr) (ex_proj3 pqr))) : forall p, R p := eq_ex2_rect R (fun p q r => f (ex_intro2 _ _ p q r)). Definition eq_ex2_rec_uncurried {A : Prop} {P Q : A -> Prop} {u v} (R : u = v :> (exists2 a : A, P a & Q a) -> Set) := eq_ex2_rect_uncurried R. Definition eq_ex2_ind_uncurried {A : Prop} {P Q : A -> Prop} {u v} (R : u = v :> (exists2 a : A, P a & Q a) -> Prop) := eq_ex2_rec_uncurried R. (** Equivalence of equality of [ex2] involving hProps with equality of the first components *) Definition eq_ex2_hprop_iff {A : Prop} {P Q : A -> Prop} (Q_hprop : forall (x : A) (p q : Q x), p = q) (u v : exists2 a : A, P a & Q a) : u = v <-> (u = v :> exists a : A, P a) := conj (fun p => f_equal (@ex_of_ex2 _ _ _) p) (eq_ex2_hprop Q_hprop u v). (** Non-dependent classification of equality of [ex] *) Definition eq_ex2_nondep {A : Prop} {B C : Prop} (u v : @ex2 A (fun _ => B) (fun _ => C)) (p : ex_proj1 u = ex_proj1 v) (q : ex_proj2 u = ex_proj2 v) (r : ex_proj3 u = ex_proj3 v) : u = v := @eq_ex2 _ _ _ u v p (eq_trans (rew_const _ _) q) (eq_trans (rew_const _ _) r). (** Classification of transporting across an equality of [ex2]s *) Lemma rew_ex2 {A' : Type} {x} {P : A' -> Prop} (Q R : forall a, P a -> Prop) (u : exists2 p : P x, Q x p & R x p) {y} (H : x = y) : rew [fun a => exists2 p : P a, Q a p & R a p] H in u = ex_intro2 (Q y) (R y) (rew H in ex_proj1 u) (rew dependent H in ex_proj2 u) (rew dependent H in ex_proj3 u). Proof. destruct H, u; reflexivity. Defined. End ex2. Global Arguments eq_ex_intro2 A P Q _ _ _ _ _ _ !p !q !r / . coq-8.20.0/theories/Init/Ltac.v000066400000000000000000000014101466560755400162000ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* n | S u => u end. Register pred as num.nat.pred. Fixpoint add n m := match n with | 0 => m | S p => S (p + m) end where "n + m" := (add n m) : nat_scope. Register add as num.nat.add. Definition double n := n + n. Fixpoint mul n m := match n with | 0 => 0 | S p => m + p * m end where "n * m" := (mul n m) : nat_scope. Register mul as num.nat.mul. (** Truncated subtraction: [n-m] is [0] if [n<=m] *) Fixpoint sub n m := match n, m with | S k, S l => k - l | _, _ => n end where "n - m" := (sub n m) : nat_scope. Register sub as num.nat.sub. (** ** Comparisons *) Fixpoint eqb n m : bool := match n, m with | 0, 0 => true | 0, S _ => false | S _, 0 => false | S n', S m' => eqb n' m' end. Fixpoint leb n m : bool := match n, m with | 0, _ => true | _, 0 => false | S n', S m' => leb n' m' end. Definition ltb n m := leb (S n) m. Infix "=?" := eqb (at level 70) : nat_scope. Infix "<=?" := leb (at level 70) : nat_scope. Infix " Eq | 0, S _ => Lt | S _, 0 => Gt | S n', S m' => compare n' m' end. Infix "?=" := compare (at level 70) : nat_scope. (** ** Minimum, maximum *) Fixpoint max n m := match n, m with | 0, _ => m | S n', 0 => n | S n', S m' => S (max n' m') end. Fixpoint min n m := match n, m with | 0, _ => 0 | S n', 0 => 0 | S n', S m' => S (min n' m') end. (** ** Parity tests *) Fixpoint even n : bool := match n with | 0 => true | 1 => false | S (S n') => even n' end. Definition odd n := negb (even n). (** ** Power *) Fixpoint pow n m := match m with | 0 => 1 | S m => n * (n^m) end where "n ^ m" := (pow n m) : nat_scope. (** ** Tail-recursive versions of [add] and [mul] *) Fixpoint tail_add n m := match n with | O => m | S n => tail_add n (S m) end. (** [tail_addmul r n m] is [r + n * m]. *) Fixpoint tail_addmul r n m := match n with | O => r | S n => tail_addmul (tail_add m r) n m end. Definition tail_mul n m := tail_addmul 0 n m. (** ** Conversion with a decimal representation for printing/parsing *) Local Notation ten := (S (S (S (S (S (S (S (S (S (S O)))))))))). Fixpoint of_uint_acc (d:Decimal.uint)(acc:nat) := match d with | Decimal.Nil => acc | Decimal.D0 d => of_uint_acc d (tail_mul ten acc) | Decimal.D1 d => of_uint_acc d (S (tail_mul ten acc)) | Decimal.D2 d => of_uint_acc d (S (S (tail_mul ten acc))) | Decimal.D3 d => of_uint_acc d (S (S (S (tail_mul ten acc)))) | Decimal.D4 d => of_uint_acc d (S (S (S (S (tail_mul ten acc))))) | Decimal.D5 d => of_uint_acc d (S (S (S (S (S (tail_mul ten acc)))))) | Decimal.D6 d => of_uint_acc d (S (S (S (S (S (S (tail_mul ten acc))))))) | Decimal.D7 d => of_uint_acc d (S (S (S (S (S (S (S (tail_mul ten acc)))))))) | Decimal.D8 d => of_uint_acc d (S (S (S (S (S (S (S (S (tail_mul ten acc))))))))) | Decimal.D9 d => of_uint_acc d (S (S (S (S (S (S (S (S (S (tail_mul ten acc)))))))))) end. Definition of_uint (d:Decimal.uint) := of_uint_acc d O. Local Notation sixteen := (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S O)))))))))))))))). Fixpoint of_hex_uint_acc (d:Hexadecimal.uint)(acc:nat) := match d with | Hexadecimal.Nil => acc | Hexadecimal.D0 d => of_hex_uint_acc d (tail_mul sixteen acc) | Hexadecimal.D1 d => of_hex_uint_acc d (S (tail_mul sixteen acc)) | Hexadecimal.D2 d => of_hex_uint_acc d (S (S (tail_mul sixteen acc))) | Hexadecimal.D3 d => of_hex_uint_acc d (S (S (S (tail_mul sixteen acc)))) | Hexadecimal.D4 d => of_hex_uint_acc d (S (S (S (S (tail_mul sixteen acc))))) | Hexadecimal.D5 d => of_hex_uint_acc d (S (S (S (S (S (tail_mul sixteen acc)))))) | Hexadecimal.D6 d => of_hex_uint_acc d (S (S (S (S (S (S (tail_mul sixteen acc))))))) | Hexadecimal.D7 d => of_hex_uint_acc d (S (S (S (S (S (S (S (tail_mul sixteen acc)))))))) | Hexadecimal.D8 d => of_hex_uint_acc d (S (S (S (S (S (S (S (S (tail_mul sixteen acc))))))))) | Hexadecimal.D9 d => of_hex_uint_acc d (S (S (S (S (S (S (S (S (S (tail_mul sixteen acc)))))))))) | Hexadecimal.Da d => of_hex_uint_acc d (S (S (S (S (S (S (S (S (S (S (tail_mul sixteen acc))))))))))) | Hexadecimal.Db d => of_hex_uint_acc d (S (S (S (S (S (S (S (S (S (S (S (tail_mul sixteen acc)))))))))))) | Hexadecimal.Dc d => of_hex_uint_acc d (S (S (S (S (S (S (S (S (S (S (S (S (tail_mul sixteen acc))))))))))))) | Hexadecimal.Dd d => of_hex_uint_acc d (S (S (S (S (S (S (S (S (S (S (S (S (S (tail_mul sixteen acc)))))))))))))) | Hexadecimal.De d => of_hex_uint_acc d (S (S (S (S (S (S (S (S (S (S (S (S (S (S (tail_mul sixteen acc))))))))))))))) | Hexadecimal.Df d => of_hex_uint_acc d (S (S (S (S (S (S (S (S (S (S (S (S (S (S (S (tail_mul sixteen acc)))))))))))))))) end. Definition of_hex_uint (d:Hexadecimal.uint) := of_hex_uint_acc d O. Definition of_num_uint (d:Number.uint) := match d with | Number.UIntDecimal d => of_uint d | Number.UIntHexadecimal d => of_hex_uint d end. Fixpoint to_little_uint n acc := match n with | O => acc | S n => to_little_uint n (Decimal.Little.succ acc) end. Definition to_uint n := Decimal.rev (to_little_uint n Decimal.zero). Fixpoint to_little_hex_uint n acc := match n with | O => acc | S n => to_little_hex_uint n (Hexadecimal.Little.succ acc) end. Definition to_hex_uint n := Hexadecimal.rev (to_little_hex_uint n Hexadecimal.zero). Definition to_num_uint n := Number.UIntDecimal (to_uint n). Definition to_num_hex_uint n := Number.UIntHexadecimal (to_hex_uint n). Definition of_int (d:Decimal.int) : option nat := match Decimal.norm d with | Decimal.Pos u => Some (of_uint u) | _ => None end. Definition of_hex_int (d:Hexadecimal.int) : option nat := match Hexadecimal.norm d with | Hexadecimal.Pos u => Some (of_hex_uint u) | _ => None end. Definition of_num_int (d:Number.int) : option nat := match d with | Number.IntDecimal d => of_int d | Number.IntHexadecimal d => of_hex_int d end. Definition to_int n := Decimal.Pos (to_uint n). Definition to_hex_int n := Hexadecimal.Pos (to_hex_uint n). Definition to_num_int n := Number.IntDecimal (to_int n). (** ** Euclidean division *) (** This division is linear and tail-recursive. In [divmod], [y] is the predecessor of the actual divisor, and [u] is [y] minus the real remainder *) Fixpoint divmod x y q u := match x with | 0 => (q,u) | S x' => match u with | 0 => divmod x' y (S q) y | S u' => divmod x' y q u' end end. Definition div x y := match y with | 0 => y | S y' => fst (divmod x y' 0 y') end. Definition modulo x y := match y with | 0 => x | S y' => y' - snd (divmod x y' 0 y') end. Infix "/" := div : nat_scope. Infix "mod" := modulo (at level 40, no associativity) : nat_scope. (** ** Greatest common divisor *) (** We use Euclid algorithm, which is normally not structural, but Coq is now clever enough to accept this (behind modulo there is a subtraction, which now preserves being a subterm) *) Fixpoint gcd a b := match a with | O => b | S a' => gcd (b mod (S a')) (S a') end. (** ** Square *) Definition square n := n * n. (** ** Square root *) (** The following square root function is linear (and tail-recursive). With Peano representation, we can't do better. For faster algorithm, see Psqrt/Zsqrt/Nsqrt... We search the square root of n = k + p^2 + (q - r) with q = 2p and 0<=r<=q. We start with p=q=r=0, hence looking for the square root of n = k. Then we progressively decrease k and r. When k = S k' and r=0, it means we can use (S p) as new sqrt candidate, since (S k')+p^2+2p = k'+(S p)^2. When k reaches 0, we have found the biggest p^2 square contained in n, hence the square root of n is p. *) Fixpoint sqrt_iter k p q r := match k with | O => p | S k' => match r with | O => sqrt_iter k' (S p) (S (S q)) (S (S q)) | S r' => sqrt_iter k' p q r' end end. Definition sqrt n := sqrt_iter n 0 0 0. (** ** Log2 *) (** This base-2 logarithm is linear and tail-recursive. In [log2_iter], we maintain the logarithm [p] of the counter [q], while [r] is the distance between [q] and the next power of 2, more precisely [q + S r = 2^(S p)] and [r<2^p]. At each recursive call, [q] goes up while [r] goes down. When [r] is 0, we know that [q] has almost reached a power of 2, and we increase [p] at the next call, while resetting [r] to [q]. Graphically (numbers are [q], stars are [r]) : << 10 9 8 7 * 6 * 5 ... 4 3 * 2 * 1 * * 0 * * * >> We stop when [k], the global downward counter reaches 0. At that moment, [q] is the number we're considering (since [k+q] is invariant), and [p] its logarithm. *) Fixpoint log2_iter k p q r := match k with | O => p | S k' => match r with | O => log2_iter k' (S p) (S q) q | S r' => log2_iter k' p (S q) r' end end. Definition log2 n := log2_iter (pred n) 0 1 0. (** Iterator on natural numbers *) Definition iter (n:nat) {A} (f:A->A) (x:A) : A := nat_rect (fun _ => A) x (fun _ => f) n. (** Bitwise operations *) (** We provide here some bitwise operations for unary numbers. Some might be really naive, they are just there for fulfilling the same interface as other for natural representations. As soon as binary representations such as NArith are available, it is clearly better to convert to/from them and use their ops. *) Fixpoint div2 n := match n with | 0 => 0 | S 0 => 0 | S (S n') => S (div2 n') end. Fixpoint testbit a n : bool := match n with | 0 => odd a | S n => testbit (div2 a) n end. Definition shiftl a := nat_rect _ a (fun _ => double). Definition shiftr a := nat_rect _ a (fun _ => div2). Fixpoint bitwise (op:bool->bool->bool) n a b := match n with | 0 => 0 | S n' => (if op (odd a) (odd b) then 1 else 0) + 2*(bitwise op n' (div2 a) (div2 b)) end. Definition land a b := bitwise andb a a b. Definition lor a b := bitwise orb (max a b) a b. Definition ldiff a b := bitwise (fun b b' => andb b (negb b')) a a b. Definition lxor a b := bitwise xorb (max a b) a b. coq-8.20.0/theories/Init/Notations.v000066400000000000000000000126601466560755400173040ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* y" (at level 99, right associativity, y at level 200). Reserved Notation "x <-> y" (at level 95, no associativity). Reserved Notation "x /\ y" (at level 80, right associativity). Reserved Notation "x \/ y" (at level 85, right associativity). Reserved Notation "~ x" (at level 75, right associativity). (** Notations for equality and inequalities *) Reserved Notation "x = y :> T" (at level 70, y at next level, no associativity). Reserved Notation "x = y" (at level 70, no associativity). Reserved Notation "x = y = z" (at level 70, no associativity, y at next level). Reserved Notation "x <> y :> T" (at level 70, y at next level, no associativity). Reserved Notation "x <> y" (at level 70, no associativity). Reserved Notation "x <= y" (at level 70, no associativity). Reserved Notation "x < y" (at level 70, no associativity). Reserved Notation "x >= y" (at level 70, no associativity). Reserved Notation "x > y" (at level 70, no associativity). Reserved Notation "x <= y <= z" (at level 70, y at next level). Reserved Notation "x <= y < z" (at level 70, y at next level). Reserved Notation "x < y < z" (at level 70, y at next level). Reserved Notation "x < y <= z" (at level 70, y at next level). (** Arithmetical notations (also used for type constructors) *) Reserved Notation "x + y" (at level 50, left associativity). Reserved Notation "x - y" (at level 50, left associativity). Reserved Notation "x * y" (at level 40, left associativity). Reserved Notation "x / y" (at level 40, left associativity). Reserved Notation "- x" (at level 35, right associativity). Reserved Notation "/ x" (at level 35, right associativity). Reserved Notation "x ^ y" (at level 30, right associativity). (** Notations for booleans *) Reserved Notation "x || y" (at level 50, left associativity). Reserved Notation "x && y" (at level 40, left associativity). (** Notations for pairs *) Reserved Notation "( x , y , .. , z )" (at level 0, format "( '[' x , '/' y , '/' .. , '/' z ']' )"). (** Notation "{ x }" is reserved and has a special status as component of other notations such as "{ A } + { B }" and "A + { B }" (which are at the same level as "x + y"); "{ x }" is at level 0 to factor with "{ x : A | P }" *) Reserved Notation "{ x }" (at level 0, x at level 99). (** Notations for sigma-types or subsets *) #[warning="-closed-notation-not-level-0"] Reserved Notation "{ A } + { B }" (at level 50, left associativity). #[warning="-postfix-notation-not-level-1"] Reserved Notation "A + { B }" (at level 50, left associativity). Reserved Notation "{ x | P }" (at level 0, x at level 99). Reserved Notation "{ x | P & Q }" (at level 0, x at level 99). Reserved Notation "{ x : A | P }" (at level 0, x at level 99). Reserved Notation "{ x : A | P & Q }" (at level 0, x at level 99). Reserved Notation "{ x & P }" (at level 0, x at level 99). Reserved Notation "{ x & P & Q }" (at level 0, x at level 99). Reserved Notation "{ x : A & P }" (at level 0, x at level 99). Reserved Notation "{ x : A & P & Q }" (at level 0, x at level 99). Reserved Notation "{ ' pat | P }" (at level 0, pat strict pattern, format "{ ' pat | P }"). Reserved Notation "{ ' pat | P & Q }" (at level 0, pat strict pattern, format "{ ' pat | P & Q }"). Reserved Notation "{ ' pat : A | P }" (at level 0, pat strict pattern, format "{ ' pat : A | P }"). Reserved Notation "{ ' pat : A | P & Q }" (at level 0, pat strict pattern, format "{ ' pat : A | P & Q }"). Reserved Notation "{ ' pat & P }" (at level 0, pat strict pattern, format "{ ' pat & P }"). Reserved Notation "{ ' pat & P & Q }" (at level 0, pat strict pattern, format "{ ' pat & P & Q }"). Reserved Notation "{ ' pat : A & P }" (at level 0, pat strict pattern, format "{ ' pat : A & P }"). Reserved Notation "{ ' pat : A & P & Q }" (at level 0, pat strict pattern, format "{ ' pat : A & P & Q }"). (** Support for Gonthier-Ssreflect's "if c is pat then u else v" *) Module IfNotations. Notation "'if' c 'is' p 'then' u 'else' v" := (match c with p => u | _ => v end) (at level 200, p pattern at level 100). End IfNotations. (** Notations for first and second projections *) Reserved Notation "p .1" (at level 1, left associativity, format "p .1"). Reserved Notation "p .2" (at level 1, left associativity, format "p .2"). (** Scopes *) Declare Scope core_scope. Delimit Scope core_scope with core. Declare Scope function_scope. Delimit Scope function_scope with function. Bind Scope function_scope with Funclass. Declare Scope type_scope. Delimit Scope type_scope with type. Bind Scope type_scope with Sortclass. Open Scope core_scope. Open Scope function_scope. Open Scope type_scope. coq-8.20.0/theories/Init/Number.v000066400000000000000000000031041466560755400165470ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* m -> S n <> S m. Proof. red; auto. Qed. #[global] Hint Resolve not_eq_S: core. Definition IsSucc (n:nat) : Prop := match n with | O => False | S p => True end. (** Zero is not the successor of a number *) Theorem O_S : forall n:nat, 0 <> S n. Proof. discriminate. Qed. #[global] Hint Resolve O_S: core. Theorem n_Sn : forall n:nat, n <> S n. Proof. intro n; induction n; auto. Qed. #[global] Hint Resolve n_Sn: core. (** Addition *) Notation plus := Nat.add (only parsing). Infix "+" := Nat.add : nat_scope. Definition f_equal2_plus := f_equal2 plus. Definition f_equal2_nat := f_equal2 (A1:=nat) (A2:=nat). #[global] Hint Resolve f_equal2_nat: core. Lemma plus_n_O : forall n:nat, n = n + 0. Proof. intro n; induction n; simpl; auto. Qed. #[global] Remove Hints eq_refl : core. #[global] Hint Resolve plus_n_O eq_refl: core. (* We want eq_refl to have higher priority than plus_n_O *) Lemma plus_O_n : forall n:nat, 0 + n = n. Proof. reflexivity. Qed. Lemma plus_n_Sm : forall n m:nat, S (n + m) = n + S m. Proof. intros n m; induction n; simpl; auto. Qed. #[global] Hint Resolve plus_n_Sm: core. Lemma plus_Sn_m : forall n m:nat, S n + m = S (n + m). Proof. reflexivity. Qed. (** Standard associated names *) Notation plus_0_r_reverse := plus_n_O (only parsing). Notation plus_succ_r_reverse := plus_n_Sm (only parsing). (** Multiplication *) Notation mult := Nat.mul (only parsing). Infix "*" := Nat.mul : nat_scope. Definition f_equal2_mult := f_equal2 mult. #[global] Hint Resolve f_equal2_mult: core. Lemma mult_n_O : forall n:nat, 0 = n * 0. Proof. intro n; induction n; simpl; auto. Qed. #[global] Hint Resolve mult_n_O: core. Lemma mult_n_Sm : forall n m:nat, n * m + n = n * S m. Proof. intros n m; induction n as [| p H]; simpl; auto. destruct H; rewrite <- plus_n_Sm; apply eq_S. pattern m at 1 3; elim m; simpl; auto. Qed. #[global] Hint Resolve mult_n_Sm: core. (** Standard associated names *) Notation mult_0_r_reverse := mult_n_O (only parsing). Notation mult_succ_r_reverse := mult_n_Sm (only parsing). (** Truncated subtraction: [m-n] is [0] if [n>=m] *) Notation minus := Nat.sub (only parsing). Infix "-" := Nat.sub : nat_scope. (** Definition of the usual orders, the basic properties of [le] and [lt] can be found in files Le and Lt *) Inductive le (n:nat) : nat -> Prop := | le_n : n <= n | le_S : forall m:nat, n <= m -> n <= S m where "n <= m" := (le n m) : nat_scope. Register le_n as num.nat.le_n. #[global] Hint Constructors le: core. (*i equivalent to : "Hints Resolve le_n le_S : core." i*) Definition lt (n m:nat) := S n <= m. #[global] Hint Unfold lt: core. Infix "<" := lt : nat_scope. Definition ge (n m:nat) := m <= n. #[global] Hint Unfold ge: core. Infix ">=" := ge : nat_scope. Definition gt (n m:nat) := m < n. #[global] Hint Unfold gt: core. Infix ">" := gt : nat_scope. Notation "x <= y <= z" := (x <= y /\ y <= z) : nat_scope. Notation "x <= y < z" := (x <= y /\ y < z) : nat_scope. Notation "x < y < z" := (x < y /\ y < z) : nat_scope. Notation "x < y <= z" := (x < y /\ y <= z) : nat_scope. Register le as num.nat.le. Register lt as num.nat.lt. Register ge as num.nat.ge. Register gt as num.nat.gt. Theorem le_pred : forall n m, n <= m -> pred n <= pred m. Proof. induction 1 as [|m _]; auto. destruct m; simpl; auto. Qed. Theorem le_S_n : forall n m, S n <= S m -> n <= m. Proof. intros n m. exact (le_pred (S n) (S m)). Qed. Theorem le_0_n : forall n, 0 <= n. Proof. intro n; induction n; constructor; trivial. Qed. Theorem le_n_S : forall n m, n <= m -> S n <= S m. Proof. induction 1; constructor; trivial. Qed. (** Case analysis *) Theorem nat_case : forall (n:nat) (P:nat -> Prop), P 0 -> (forall m:nat, P (S m)) -> P n. Proof. intros n P IH0 IHS; case n; auto. Qed. (** Principle of double induction *) Theorem nat_double_ind : forall R:nat -> nat -> Prop, (forall n:nat, R 0 n) -> (forall n:nat, R (S n) 0) -> (forall n m:nat, R n m -> R (S n) (S m)) -> forall n m:nat, R n m. Proof. intros R ? ? ? n. induction n; auto. intro m; destruct m; auto. Qed. (** Maximum and minimum : definitions and specifications *) Notation max := Nat.max (only parsing). Notation min := Nat.min (only parsing). Lemma max_l n m : m <= n -> Nat.max n m = n. Proof. revert m; induction n as [|n IHn]; intro m; destruct m; simpl; trivial. - inversion 1. - intros. apply f_equal, IHn, le_S_n; trivial. Qed. Lemma max_r n m : n <= m -> Nat.max n m = m. Proof. revert m; induction n as [|n IHn]; intro m; destruct m; simpl; trivial. - inversion 1. - intros. apply f_equal, IHn, le_S_n; trivial. Qed. Lemma min_l n m : n <= m -> Nat.min n m = n. Proof. revert m; induction n as [|n IHn]; intro m; destruct m; simpl; trivial. - inversion 1. - intros. apply f_equal, IHn, le_S_n; trivial. Qed. Lemma min_r n m : m <= n -> Nat.min n m = m. Proof. revert m; induction n as [|n IHn]; intro m; destruct m; simpl; trivial. - inversion 1. - intros. apply f_equal, IHn, le_S_n; trivial. Qed. Lemma nat_rect_succ_r {A} (f: A -> A) (x:A) n : nat_rect (fun _ => A) x (fun _ => f) (S n) = nat_rect (fun _ => A) (f x) (fun _ => f) n. Proof. induction n as [|n IHn]; intros; simpl; rewrite <- ?IHn; trivial. Qed. Theorem nat_rect_plus : forall (n m:nat) {A} (f:A -> A) (x:A), nat_rect (fun _ => A) x (fun _ => f) (n + m) = nat_rect (fun _ => A) (nat_rect (fun _ => A) x (fun _ => f) m) (fun _ => f) n. Proof. intro n; induction n as [|n IHn]; intros; simpl; rewrite ?IHn; trivial. Qed. coq-8.20.0/theories/Init/Prelude.v000066400000000000000000000055751466560755400167350ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* Prop) : Type := exist : forall x:A, P x -> sig P. Register sig as core.sig.type. Register exist as core.sig.intro. Register sig_rect as core.sig.rect. #[universes(template)] Inductive sig2 (A:Type) (P Q:A -> Prop) : Type := exist2 : forall x:A, P x -> Q x -> sig2 P Q. (** [(sigT A P)], or more suggestively [{x:A & (P x)}] is a Sigma-type. Similarly for [(sigT2 A P Q)], also written [{x:A & (P x) & (Q x)}]. *) #[universes(template)] Inductive sigT (A:Type) (P:A -> Type) : Type := existT : forall x:A, P x -> sigT P. Register sigT as core.sigT.type. Register existT as core.sigT.intro. Register sigT_rect as core.sigT.rect. #[universes(template)] Inductive sigT2 (A:Type) (P Q:A -> Type) : Type := existT2 : forall x:A, P x -> Q x -> sigT2 P Q. (* Notations *) Arguments sig (A P)%_type. Arguments sig2 (A P Q)%_type. Arguments sigT (A P)%_type. Arguments sigT2 (A P Q)%_type. Notation "{ x | P }" := (sig (fun x => P)) : type_scope. Notation "{ x | P & Q }" := (sig2 (fun x => P) (fun x => Q)) : type_scope. Notation "{ x : A | P }" := (sig (A:=A) (fun x => P)) : type_scope. Notation "{ x : A | P & Q }" := (sig2 (A:=A) (fun x => P) (fun x => Q)) : type_scope. Notation "{ x & P }" := (sigT (fun x => P)) : type_scope. Notation "{ x & P & Q }" := (sigT2 (fun x => P) (fun x => Q)) : type_scope. Notation "{ x : A & P }" := (sigT (A:=A) (fun x => P)) : type_scope. Notation "{ x : A & P & Q }" := (sigT2 (A:=A) (fun x => P) (fun x => Q)) : type_scope. Notation "{ ' pat | P }" := (sig (fun pat => P)) : type_scope. Notation "{ ' pat | P & Q }" := (sig2 (fun pat => P) (fun pat => Q)) : type_scope. Notation "{ ' pat : A | P }" := (sig (A:=A) (fun pat => P)) : type_scope. Notation "{ ' pat : A | P & Q }" := (sig2 (A:=A) (fun pat => P) (fun pat => Q)) : type_scope. Notation "{ ' pat & P }" := (sigT (fun pat => P)) : type_scope. Notation "{ ' pat & P & Q }" := (sigT2 (fun pat => P) (fun pat => Q)) : type_scope. Notation "{ ' pat : A & P }" := (sigT (A:=A) (fun pat => P)) : type_scope. Notation "{ ' pat : A & P & Q }" := (sigT2 (A:=A) (fun pat => P) (fun pat => Q)) : type_scope. Add Printing Let sig. Add Printing Let sig2. Add Printing Let sigT. Add Printing Let sigT2. (** Projections of [sig] An element [y] of a subset [{x:A | (P x)}] is the pair of an [a] of type [A] and of a proof [h] that [a] satisfies [P]. Then [(proj1_sig y)] is the witness [a] and [(proj2_sig y)] is the proof of [(P a)] *) (* Set Universe Polymorphism. *) Section Subset_projections. Variable A : Type. Variable P : A -> Prop. Definition proj1_sig (e:sig P) := match e with | exist _ a b => a end. Definition proj2_sig (e:sig P) := match e return P (proj1_sig e) with | exist _ a b => b end. Register proj1_sig as core.sig.proj1. Register proj2_sig as core.sig.proj2. End Subset_projections. (** [sig2] of a predicate can be projected to a [sig]. This allows [proj1_sig] and [proj2_sig] to be usable with [sig2]. The [let] statements occur in the body of the [exist] so that [proj1_sig] of a coerced [X : sig2 P Q] will unify with [let (a, _, _) := X in a] *) Definition sig_of_sig2 (A : Type) (P Q : A -> Prop) (X : sig2 P Q) : sig P := exist P (let (a, _, _) := X in a) (let (x, p, _) as s return (P (let (a, _, _) := s in a)) := X in p). (** Projections of [sig2] An element [y] of a subset [{x:A | (P x) & (Q x)}] is the triple of an [a] of type [A], a of a proof [h] that [a] satisfies [P], and a proof [h'] that [a] satisfies [Q]. Then [(proj1_sig (sig_of_sig2 y))] is the witness [a], [(proj2_sig (sig_of_sig2 y))] is the proof of [(P a)], and [(proj3_sig y)] is the proof of [(Q a)]. *) Section Subset_projections2. Variable A : Type. Variables P Q : A -> Prop. Definition proj3_sig (e : sig2 P Q) := let (a, b, c) return Q (proj1_sig (sig_of_sig2 e)) := e in c. End Subset_projections2. (** Projections of [sigT] An element [x] of a sigma-type [{y:A & P y}] is a dependent pair made of an [a] of type [A] and an [h] of type [P a]. Then, [(projT1 x)] is the first projection and [(projT2 x)] is the second projection, the type of which depends on the [projT1]. *) Section Projections. Variable A : Type. Variable P : A -> Type. Definition projT1 (x:sigT P) : A := match x with | existT _ a _ => a end. Definition projT2 (x:sigT P) : P (projT1 x) := match x return P (projT1 x) with | existT _ _ h => h end. Register projT1 as core.sigT.proj1. Register projT2 as core.sigT.proj2. End Projections. Module SigTNotations. Notation "( x ; y )" := (existT _ x y) (at level 0, format "( x ; '/ ' y )"). Notation "x .1" := (projT1 x) (at level 1, left associativity, format "x .1"). Notation "x .2" := (projT2 x) (at level 1, left associativity, format "x .2"). End SigTNotations. Import SigTNotations. (** [sigT2] of a predicate can be projected to a [sigT]. This allows [projT1] and [projT2] to be usable with [sigT2]. The [let] statements occur in the body of the [existT] so that [projT1] of a coerced [X : sigT2 P Q] will unify with [let (a, _, _) := X in a] *) Definition sigT_of_sigT2 (A : Type) (P Q : A -> Type) (X : sigT2 P Q) : sigT P := existT P (let (a, _, _) := X in a) (let (x, p, _) as s return (P (let (a, _, _) := s in a)) := X in p). (** Projections of [sigT2] An element [x] of a sigma-type [{y:A & P y & Q y}] is a dependent pair made of an [a] of type [A], an [h] of type [P a], and an [h'] of type [Q a]. Then, [(projT1 (sigT_of_sigT2 x))] is the first projection, [(projT2 (sigT_of_sigT2 x))] is the second projection, and [(projT3 x)] is the third projection, the types of which depends on the [projT1]. *) Section Projections2. Variable A : Type. Variables P Q : A -> Type. Definition projT3 (e : sigT2 P Q) := let (a, b, c) return Q (projT1 (sigT_of_sigT2 e)) := e in c. End Projections2. Local Notation "x .3" := (projT3 x) (at level 1, left associativity, format "x .3"). (** [sigT] of a predicate is equivalent to [sig] *) Definition sig_of_sigT (A : Type) (P : A -> Prop) (X : sigT P) : sig P := exist P (projT1 X) (projT2 X). Definition sigT_of_sig (A : Type) (P : A -> Prop) (X : sig P) : sigT P := existT P (proj1_sig X) (proj2_sig X). (** [sigT2] of a predicate is equivalent to [sig2] *) Definition sig2_of_sigT2 (A : Type) (P Q : A -> Prop) (X : sigT2 P Q) : sig2 P Q := exist2 P Q (projT1 (sigT_of_sigT2 X)) (projT2 (sigT_of_sigT2 X)) (projT3 X). Definition sigT2_of_sig2 (A : Type) (P Q : A -> Prop) (X : sig2 P Q) : sigT2 P Q := existT2 P Q (proj1_sig (sig_of_sig2 X)) (proj2_sig (sig_of_sig2 X)) (proj3_sig X). (** [sig] of a predicate on [Prop]s can be turned into [ex] *) Definition ex_of_sig (A : Type) (P : A -> Prop) (X : sig P) : ex P := ex_intro P (proj1_sig X) (proj2_sig X). (** [sigT] of a predicate on [Prop]s can be turned into [ex] *) Definition ex_of_sigT (A : Type) (P : A -> Prop) (X : sigT P) : ex P := ex_of_sig (sig_of_sigT X). (** [sig2] of a predicate on [Prop]s can be turned into [ex2] *) Definition ex2_of_sig2 (A : Type) (P Q : A -> Prop) (X : sig2 P Q) : ex2 P Q := ex_intro2 P Q (proj1_sig (sig_of_sig2 X)) (proj2_sig (sig_of_sig2 X)) (proj3_sig X). (** [sigT2] of a predicate on [Prop]s can be turned into [ex2] *) Definition ex2_of_sigT2 (A : Type) (P Q : A -> Prop) (X : sigT2 P Q) : ex2 P Q := ex2_of_sig2 (sig2_of_sigT2 X). (** η Principles *) Definition sigT_eta {A P} (p : { a : A & P a }) : p = existT _ (projT1 p) (projT2 p). Proof. destruct p; reflexivity. Defined. Definition sig_eta {A P} (p : { a : A | P a }) : p = exist _ (proj1_sig p) (proj2_sig p). Proof. destruct p; reflexivity. Defined. Definition sigT2_eta {A P Q} (p : { a : A & P a & Q a }) : p = existT2 _ _ (projT1 (sigT_of_sigT2 p)) (projT2 (sigT_of_sigT2 p)) (projT3 p). Proof. destruct p; reflexivity. Defined. Definition sig2_eta {A P Q} (p : { a : A | P a & Q a }) : p = exist2 _ _ (proj1_sig (sig_of_sig2 p)) (proj2_sig (sig_of_sig2 p)) (proj3_sig p). Proof. destruct p; reflexivity. Defined. (** [exists x : A, B] is equivalent to [inhabited {x : A | B}] *) Lemma exists_to_inhabited_sig {A P} : (exists x : A, P x) -> inhabited {x : A | P x}. Proof. intros [x y]. exact (inhabits (exist _ x y)). Qed. Lemma inhabited_sig_to_exists {A P} : inhabited {x : A | P x} -> exists x : A, P x. Proof. intros [[x y]];exists x;exact y. Qed. (** Subtyping for prod *) Section ProdSigT. Variable A B : Type. Definition sigT_of_prod (p : A * B) := (fst p; snd p). Definition prod_of_sigT (s : { _ : A & B }) := (s.1, s.2). Lemma sigT_prod_sigT p : sigT_of_prod (prod_of_sigT p) = p. Proof. destruct p; reflexivity. Qed. Lemma prod_sigT_prod s : prod_of_sigT (sigT_of_prod s) = s. Proof. destruct s; reflexivity. Qed. End ProdSigT. (** Equality of sigma types *) Import EqNotations. (** Equality for [sigT] *) Section sigT. Local Unset Implicit Arguments. (** Projecting an equality of a pair to equality of the first components *) Definition projT1_eq {A} {P : A -> Type} {u v : { a : A & P a }} (p : u = v) : u.1 = v.1 := f_equal (fun x => x.1) p. (** Projecting an equality of a pair to equality of the second components *) Definition projT2_eq {A} {P : A -> Type} {u v : { a : A & P a }} (p : u = v) : rew projT1_eq p in u.2 = v.2 := rew dependent p in eq_refl. (** Equality of [sigT] is itself a [sigT] (forwards-reasoning version) *) Definition eq_existT_uncurried {A : Type} {P : A -> Type} {u1 v1 : A} {u2 : P u1} {v2 : P v1} (pq : { p : u1 = v1 & rew p in u2 = v2 }) : (u1; u2) = (v1; v2). Proof. destruct pq as [p q]. destruct q; simpl in *. destruct p; reflexivity. Defined. (** Equality of [sigT] is itself a [sigT] (backwards-reasoning version) *) Definition eq_sigT_uncurried {A : Type} {P : A -> Type} (u v : { a : A & P a }) (pq : { p : u.1 = v.1 & rew p in u.2 = v.2 }) : u = v. Proof. destruct u as [u1 u2], v as [v1 v2]; simpl in *. apply eq_existT_uncurried; exact pq. Defined. Lemma eq_existT_curried {A : Type} {P : A -> Type} {u1 v1 : A} {u2 : P u1} {v2 : P v1} (p : u1 = v1) (q : rew p in u2 = v2) : (u1; u2) = (v1; v2). Proof. apply eq_sigT_uncurried; exists p; exact q. Defined. Local Notation "(= u ; v )" := (eq_existT_curried u v) (at level 0, format "(= u ; '/ ' v )"). Lemma eq_existT_curried_map {A A' P P'} (f:A -> A') (g:forall u:A, P u -> P' (f u)) {u1 v1 : A} {u2 : P u1} {v2 : P v1} (p : u1 = v1) (q : rew p in u2 = v2) : f_equal (fun x => (f x.1; g x.1 x.2)) (= p; q) = (= f_equal f p; f_equal_dep2 f g p q). Proof. destruct p, q. reflexivity. Defined. Lemma eq_existT_curried_trans {A P} {u1 v1 w1 : A} {u2 : P u1} {v2 : P v1} {w2 : P w1} (p : u1 = v1) (q : rew p in u2 = v2) (p' : v1 = w1) (q': rew p' in v2 = w2) : eq_trans (= p; q) (= p'; q') = (= eq_trans p p'; eq_trans_map p p' q q'). Proof. destruct p', q'. reflexivity. Defined. Theorem eq_existT_curried_congr {A P} {u1 v1 : A} {u2 : P u1} {v2 : P v1} {p p' : u1 = v1} {q : rew p in u2 = v2} {q': rew p' in u2 = v2} (r : p = p') : rew [fun H => rew H in u2 = v2] r in q = q' -> (= p; q) = (= p'; q'). Proof. destruct r, 1. reflexivity. Qed. (** Curried version of proving equality of sigma types *) Definition eq_sigT {A : Type} {P : A -> Type} (u v : { a : A & P a }) (p : u.1 = v.1) (q : rew p in u.2 = v.2) : u = v := eq_sigT_uncurried u v (existT _ p q). (** In order to have a performant [inversion_sigma], we define specialized versions for when we have constructors on one or both sides of the equality *) Definition eq_existT_l {A : Type} {P : A -> Type} {u1 : A} {u2 : P u1} {v : { a : A & P a }} (p : u1 = v.1) (q : rew p in u2 = v.2) : (u1; u2) = v := eq_sigT (u1; u2) v p q. Definition eq_existT_r {A : Type} {P : A -> Type} {u : { a : A & P a }} {v1 : A} {v2 : P v1} (p : u.1 = v1) (q : rew p in u.2 = v2) : u = (v1; v2) := eq_sigT u (v1; v2) p q. (** Equality of [sigT] when the property is an hProp *) Definition eq_sigT_hprop {A P} (P_hprop : forall (x : A) (p q : P x), p = q) (u v : { a : A & P a }) (p : u.1 = v.1) : u = v := eq_sigT u v p (P_hprop _ _ _). (** Equivalence of equality of [sigT] with a [sigT] of equality *) (** We could actually prove an isomorphism here, and not just [<->], but for simplicity, we don't. *) Definition eq_sigT_uncurried_iff {A P} (u v : { a : A & P a }) : u = v <-> { p : u.1 = v.1 & rew p in u.2 = v.2 }. Proof. split; [ intro; subst; exists eq_refl; reflexivity | apply eq_sigT_uncurried ]. Defined. (** Induction principle for [@eq (sigT _)] *) Definition eq_sigT_rect {A P} {u v : { a : A & P a }} (Q : u = v -> Type) (f : forall p q, Q (eq_sigT u v p q)) : forall p, Q p. Proof. intro p; specialize (f (projT1_eq p) (projT2_eq p)); destruct u, p; exact f. Defined. Definition eq_sigT_rec {A P u v} (Q : u = v :> { a : A & P a } -> Set) := eq_sigT_rect Q. Definition eq_sigT_ind {A P u v} (Q : u = v :> { a : A & P a } -> Prop) := eq_sigT_rec Q. (** In order to have a performant [inversion_sigma], we define specialized versions for when we have constructors on one or both sides of the equality *) Definition eq_sigT_rect_existT_l {A P} {u1 u2 v} (Q : _ -> Type) (f : forall p q, Q (@eq_existT_l A P u1 u2 v p q)) : forall p, Q p := eq_sigT_rect Q f. Definition eq_sigT_rect_existT_r {A P} {u v1 v2} (Q : _ -> Type) (f : forall p q, Q (@eq_existT_r A P u v1 v2 p q)) : forall p, Q p := eq_sigT_rect Q f. Definition eq_sigT_rect_existT {A P} {u1 u2 v1 v2} (Q : _ -> Type) (f : forall p q, Q (@eq_existT_curried A P u1 v1 u2 v2 p q)) : forall p, Q p := eq_sigT_rect Q f. (** We want uncurried versions so [inversion_sigma] can accept intropatterns, but we use [ex] types for the induction hypothesis to avoid extraction errors about informative inductive types having Prop instances *) Definition eq_sigT_rect_uncurried {A P} {u v : { a : A & P a }} (Q : u = v -> Type) (f : forall pq : exists p : u.1 = v.1, _, Q (eq_sigT u v (ex_proj1 pq) (ex_proj2 pq))) : forall p, Q p := eq_sigT_rect Q (fun p q => f (ex_intro _ p q)). Definition eq_sigT_rec_uncurried {A P u v} (Q : u = v :> { a : A & P a } -> Set) := eq_sigT_rect_uncurried Q. Definition eq_sigT_ind_uncurried {A P u v} (Q : u = v :> { a : A & P a } -> Prop) := eq_sigT_rec_uncurried Q. (** Equivalence of equality of [sigT] involving hProps with equality of the first components *) Definition eq_sigT_hprop_iff {A P} (P_hprop : forall (x : A) (p q : P x), p = q) (u v : { a : A & P a }) : u = v <-> (u.1 = v.1) := conj (fun p => f_equal (@projT1 _ _) p) (eq_sigT_hprop P_hprop u v). (** Non-dependent classification of equality of [sigT] *) Definition eq_sigT_nondep {A B : Type} (u v : { a : A & B }) (p : u.1 = v.1) (q : u.2 = v.2) : u = v := @eq_sigT _ _ u v p (eq_trans (rew_const _ _) q). (** Classification of transporting across an equality of [sigT]s *) Lemma rew_sigT {A x} {P : A -> Type} (Q : forall a, P a -> Prop) (u : { p : P x & Q x p }) {y} (H : x = y) : rew [fun a => { p : P a & Q a p }] H in u = existT (Q y) (rew H in u.1) (rew dependent H in (u.2)). Proof. destruct H, u; reflexivity. Defined. End sigT. Global Arguments eq_existT_curried A P _ _ _ _ !p !q / . (** Equality for [sig] *) Section sig. (** We define this as a [Let] rather than a [Definition] to avoid extraction errors about informative inductive types having Prop instances *) Local Unset Implicit Arguments. (** Projecting an equality of a pair to equality of the first components *) Definition proj1_sig_eq {A} {P : A -> Prop} {u v : { a : A | P a }} (p : u = v) : proj1_sig u = proj1_sig v := f_equal (@proj1_sig _ _) p. (** Projecting an equality of a pair to equality of the second components *) Definition proj2_sig_eq {A} {P : A -> Prop} {u v : { a : A | P a }} (p : u = v) : rew proj1_sig_eq p in proj2_sig u = proj2_sig v := rew dependent p in eq_refl. (** Equality of [sig] is itself a [sig] (forwards-reasoning version) *) Definition eq_exist_uncurried {A : Type} {P : A -> Prop} {u1 v1 : A} {u2 : P u1} {v2 : P v1} (pq : { p : u1 = v1 | rew p in u2 = v2 }) : exist _ u1 u2 = exist _ v1 v2. Proof. destruct pq as [p q]. destruct q; simpl in *. destruct p; reflexivity. Defined. (** Equality of [sig] is itself a [sig] (backwards-reasoning version) *) Definition eq_sig_uncurried {A : Type} {P : A -> Prop} (u v : { a : A | P a }) (pq : { p : proj1_sig u = proj1_sig v | rew p in proj2_sig u = proj2_sig v }) : u = v. Proof. destruct u as [u1 u2], v as [v1 v2]; simpl in *. apply eq_exist_uncurried; exact pq. Defined. Lemma eq_exist_curried {A : Type} {P : A -> Prop} {u1 v1 : A} {u2 : P u1} {v2 : P v1} (p : u1 = v1) (q : rew p in u2 = v2) : exist P u1 u2 = exist P v1 v2. Proof. apply eq_sig_uncurried; exists p; exact q. Defined. (** Curried version of proving equality of sigma types *) Definition eq_sig {A : Type} {P : A -> Prop} (u v : { a : A | P a }) (p : proj1_sig u = proj1_sig v) (q : rew p in proj2_sig u = proj2_sig v) : u = v := eq_sig_uncurried u v (exist _ p q). (** In order to have a performant [inversion_sigma], we define specialized versions for when we have constructors on one or both sides of the equality *) Definition eq_exist_l {A : Type} {P : A -> Prop} {u1 : A} {u2 : P u1} {v : { a : A | P a }} (p : u1 = proj1_sig v) (q : rew p in u2 = proj2_sig v) : exist _ u1 u2 = v := eq_sig (exist _ u1 u2) v p q. Definition eq_exist_r {A : Type} {P : A -> Prop} {u : { a : A | P a }} {v1 : A} {v2 : P v1} (p : proj1_sig u = v1) (q : rew p in proj2_sig u = v2) : u = exist _ v1 v2 := eq_sig u (exist _ v1 v2) p q. (** Induction principle for [@eq (sig _)] *) Definition eq_sig_rect {A P} {u v : { a : A | P a }} (Q : u = v -> Type) (f : forall p q, Q (eq_sig u v p q)) : forall p, Q p. Proof. intro p; specialize (f (proj1_sig_eq p) (proj2_sig_eq p)); destruct u, p; exact f. Defined. Definition eq_sig_rec {A P u v} (Q : u = v :> { a : A | P a } -> Set) := eq_sig_rect Q. Definition eq_sig_ind {A P u v} (Q : u = v :> { a : A | P a } -> Prop) := eq_sig_rec Q. (** In order to have a performant [inversion_sigma], we define specialized versions for when we have constructors on one or both sides of the equality *) Definition eq_sig_rect_exist_l {A P} {u1 u2 v} (Q : _ -> Type) (f : forall p q, Q (@eq_exist_l A P u1 u2 v p q)) : forall p, Q p := eq_sig_rect Q f. Definition eq_sig_rect_exist_r {A P} {u v1 v2} (Q : _ -> Type) (f : forall p q, Q (@eq_exist_r A P u v1 v2 p q)) : forall p, Q p := eq_sig_rect Q f. Definition eq_sig_rect_exist {A P} {u1 u2 v1 v2} (Q : _ -> Type) (f : forall p q, Q (@eq_exist_curried A P u1 v1 u2 v2 p q)) : forall p, Q p := eq_sig_rect Q f. (** We want uncurried versions so [inversion_sigma] can accept intropatterns, but we use [ex] types for the induction hypothesis to avoid extraction errors about informative inductive types having Prop instances *) Definition eq_sig_rect_uncurried {A P} {u v : { a : A | P a }} (Q : u = v -> Type) (f : forall pq : exists p : proj1_sig u = proj1_sig v, _, Q (eq_sig u v (ex_proj1 pq) (ex_proj2 pq))) : forall p, Q p := eq_sig_rect Q (fun p q => f (ex_intro _ p q)). Definition eq_sig_rec_uncurried {A P u v} (Q : u = v :> { a : A | P a } -> Set) := eq_sig_rect_uncurried Q. Definition eq_sig_ind_uncurried {A P u v} (Q : u = v :> { a : A | P a } -> Prop) := eq_sig_rec_uncurried Q. (** Equality of [sig] when the property is an hProp *) Definition eq_sig_hprop {A} {P : A -> Prop} (P_hprop : forall (x : A) (p q : P x), p = q) (u v : { a : A | P a }) (p : proj1_sig u = proj1_sig v) : u = v := eq_sig u v p (P_hprop _ _ _). (** Equivalence of equality of [sig] with a [sig] of equality *) (** We could actually prove an isomorphism here, and not just [<->], but for simplicity, we don't. *) Definition eq_sig_uncurried_iff {A} {P : A -> Prop} (u v : { a : A | P a }) : u = v <-> { p : proj1_sig u = proj1_sig v | rew p in proj2_sig u = proj2_sig v }. Proof. split; [ intro; subst; exists eq_refl; reflexivity | apply eq_sig_uncurried ]. Defined. (** Equivalence of equality of [sig] involving hProps with equality of the first components *) Definition eq_sig_hprop_iff {A} {P : A -> Prop} (P_hprop : forall (x : A) (p q : P x), p = q) (u v : { a : A | P a }) : u = v <-> (proj1_sig u = proj1_sig v) := conj (fun p => f_equal (@proj1_sig _ _) p) (eq_sig_hprop P_hprop u v). Lemma rew_sig {A x} {P : A -> Type} (Q : forall a, P a -> Prop) (u : { p : P x | Q x p }) {y} (H : x = y) : rew [fun a => { p : P a | Q a p }] H in u = exist (Q y) (rew H in proj1_sig u) (rew dependent H in proj2_sig u). Proof. destruct H, u; reflexivity. Defined. End sig. Global Arguments eq_exist_curried A P _ _ _ _ !p !q / . (** Equality for [sigT2] *) Section sigT2. (* We make [sigT_of_sigT2] a coercion so we can use [projT1], [projT2] on [sigT2] *) Local Coercion sigT_of_sigT2 : sigT2 >-> sigT. Local Coercion ex_of_ex2 : ex2 >-> ex. Local Unset Implicit Arguments. (** Projecting an equality of a pair to equality of the first components *) Definition sigT_of_sigT2_eq {A} {P Q : A -> Type} {u v : { a : A & P a & Q a }} (p : u = v) : u = v :> { a : A & P a } := f_equal _ p. Definition projT1_of_sigT2_eq {A} {P Q : A -> Type} {u v : { a : A & P a & Q a }} (p : u = v) : u.1 = v.1 := projT1_eq (sigT_of_sigT2_eq p). (** Projecting an equality of a pair to equality of the second components *) Definition projT2_of_sigT2_eq {A} {P Q : A -> Type} {u v : { a : A & P a & Q a }} (p : u = v) : rew projT1_of_sigT2_eq p in u.2 = v.2 := rew dependent p in eq_refl. (** Projecting an equality of a pair to equality of the third components *) Definition projT3_eq {A} {P Q : A -> Type} {u v : { a : A & P a & Q a }} (p : u = v) : rew projT1_of_sigT2_eq p in u.3 = v.3 := rew dependent p in eq_refl. (** Equality of [sigT2] is itself a [sigT2] (forwards-reasoning version) *) Definition eq_existT2_uncurried {A : Type} {P Q : A -> Type} {u1 v1 : A} {u2 : P u1} {v2 : P v1} {u3 : Q u1} {v3 : Q v1} (pqr : { p : u1 = v1 & rew p in u2 = v2 & rew p in u3 = v3 }) : existT2 _ _ u1 u2 u3 = existT2 _ _ v1 v2 v3. Proof. destruct pqr as [p q r]. destruct r, q, p; simpl. reflexivity. Defined. (** Equality of [sigT2] is itself a [sigT2] (backwards-reasoning version) *) Definition eq_sigT2_uncurried {A : Type} {P Q : A -> Type} (u v : { a : A & P a & Q a }) (pqr : { p : u.1 = v.1 & rew p in u.2 = v.2 & rew p in u.3 = v.3 }) : u = v. Proof. destruct u as [u1 u2 u3], v as [v1 v2 v3]; simpl in *. apply eq_existT2_uncurried; exact pqr. Defined. Lemma eq_existT2_curried {A : Type} {P Q : A -> Type} {u1 v1 : A} {u2 : P u1} {v2 : P v1} {u3 : Q u1} {v3 : Q v1} (p : u1 = v1) (q : rew p in u2 = v2) (r : rew p in u3 = v3) : existT2 P Q u1 u2 u3 = existT2 P Q v1 v2 v3. Proof. apply eq_sigT2_uncurried; exists p; exact q + exact r. Defined. (** Curried version of proving equality of sigma types *) Definition eq_sigT2 {A : Type} {P Q : A -> Type} (u v : { a : A & P a & Q a }) (p : u.1 = v.1) (q : rew p in u.2 = v.2) (r : rew p in u.3 = v.3) : u = v := eq_sigT2_uncurried u v (existT2 _ _ p q r). (** In order to have a performant [inversion_sigma], we define specialized versions for when we have constructors on one or both sides of the equality *) Definition eq_existT2_l {A : Type} {P Q : A -> Type} {u1 : A} {u2 : P u1} {u3 : Q u1} {v : { a : A & P a & Q a }} (p : u1 = v.1) (q : rew p in u2 = v.2) (r : rew p in u3 = v.3) : existT2 P Q u1 u2 u3 = v := eq_sigT2 (existT2 P Q u1 u2 u3) v p q r. Definition eq_existT2_r {A : Type} {P Q : A -> Type} {u : { a : A & P a & Q a }} {v1 : A} {v2 : P v1} {v3 : Q v1} (p : u.1 = v1) (q : rew p in u.2 = v2) (r : rew p in u.3 = v3) : u = existT2 P Q v1 v2 v3 := eq_sigT2 u (existT2 P Q v1 v2 v3) p q r. (** Equality of [sigT2] when the second property is an hProp *) Definition eq_sigT2_hprop {A P Q} (Q_hprop : forall (x : A) (p q : Q x), p = q) (u v : { a : A & P a & Q a }) (p : u = v :> { a : A & P a }) : u = v := eq_sigT2 u v (projT1_eq p) (projT2_eq p) (Q_hprop _ _ _). (** Equivalence of equality of [sigT2] with a [sigT2] of equality *) (** We could actually prove an isomorphism here, and not just [<->], but for simplicity, we don't. *) Definition eq_sigT2_uncurried_iff {A P Q} (u v : { a : A & P a & Q a }) : u = v <-> { p : u.1 = v.1 & rew p in u.2 = v.2 & rew p in u.3 = v.3 }. Proof. split; [ intro; subst; exists eq_refl; reflexivity | apply eq_sigT2_uncurried ]. Defined. (** Induction principle for [@eq (sigT2 _ _)] *) Definition eq_sigT2_rect {A P Q} {u v : { a : A & P a & Q a }} (R : u = v -> Type) (f : forall p q r, R (eq_sigT2 u v p q r)) : forall p, R p. Proof. intro p. specialize (f (projT1_of_sigT2_eq p) (projT2_of_sigT2_eq p) (projT3_eq p)). destruct u, p; exact f. Defined. Definition eq_sigT2_rec {A P Q u v} (R : u = v :> { a : A & P a & Q a } -> Set) := eq_sigT2_rect R. Definition eq_sigT2_ind {A P Q u v} (R : u = v :> { a : A & P a & Q a } -> Prop) := eq_sigT2_rec R. (** In order to have a performant [inversion_sigma], we define specialized versions for when we have constructors on one or both sides of the equality *) Definition eq_sigT2_rect_existT2_l {A P Q} {u1 u2 u3 v} (R : _ -> Type) (f : forall p q r, R (@eq_existT2_l A P Q u1 u2 u3 v p q r)) : forall p, R p := eq_sigT2_rect R f. Definition eq_sigT2_rect_existT2_r {A P Q} {u v1 v2 v3} (R : _ -> Type) (f : forall p q r, R (@eq_existT2_r A P Q u v1 v2 v3 p q r)) : forall p, R p := eq_sigT2_rect R f. Definition eq_sigT2_rect_existT2 {A P Q} {u1 u2 u3 v1 v2 v3} (R : _ -> Type) (f : forall p q r, R (@eq_existT2_curried A P Q u1 v1 u2 v2 u3 v3 p q r)) : forall p, R p := eq_sigT2_rect R f. (** We want uncurried versions so [inversion_sigma] can accept intropatterns, but we use [ex2] types for the induction hypothesis to avoid extraction errors about informative inductive types having Prop instances *) Definition eq_sigT2_rect_uncurried {A P Q} {u v : { a : A & P a & Q a }} (R : u = v -> Type) (f : forall pqr : exists2 p : u.1 = v.1, _ & _, R (eq_sigT2 u v (ex_proj1 pqr) (ex_proj2 pqr) (ex_proj3 pqr))) : forall p, R p := eq_sigT2_rect R (fun p q r => f (ex_intro2 _ _ p q r)). Definition eq_sigT2_rec_uncurried {A P Q u v} (R : u = v :> { a : A & P a & Q a } -> Set) := eq_sigT2_rect_uncurried R. Definition eq_sigT2_ind_uncurried {A P Q u v} (R : u = v :> { a : A & P a & Q a } -> Prop) := eq_sigT2_rec_uncurried R. (** Equivalence of equality of [sigT2] involving hProps with equality of the first components *) Definition eq_sigT2_hprop_iff {A P Q} (Q_hprop : forall (x : A) (p q : Q x), p = q) (u v : { a : A & P a & Q a }) : u = v <-> (u = v :> { a : A & P a }) := conj (fun p => f_equal (@sigT_of_sigT2 _ _ _) p) (eq_sigT2_hprop Q_hprop u v). (** Non-dependent classification of equality of [sigT] *) Definition eq_sigT2_nondep {A B C : Type} (u v : { a : A & B & C }) (p : u.1 = v.1) (q : u.2 = v.2) (r : u.3 = v.3) : u = v := @eq_sigT2 _ _ _ u v p (eq_trans (rew_const _ _) q) (eq_trans (rew_const _ _) r). (** Classification of transporting across an equality of [sigT2]s *) Lemma rew_sigT2 {A x} {P : A -> Type} (Q R : forall a, P a -> Prop) (u : { p : P x & Q x p & R x p }) {y} (H : x = y) : rew [fun a => { p : P a & Q a p & R a p }] H in u = existT2 (Q y) (R y) (rew H in u.1) (rew dependent H in u.2) (rew dependent H in u.3). Proof. destruct H, u; reflexivity. Defined. End sigT2. Global Arguments eq_existT2_curried A P Q _ _ _ _ _ _ !p !q !r / . (** Equality for [sig2] *) Section sig2. (* We make [sig_of_sig2] a coercion so we can use [proj1], [proj2] on [sig2] *) Local Coercion sig_of_sig2 : sig2 >-> sig. Local Coercion ex_of_ex2 : ex2 >-> ex. Local Unset Implicit Arguments. (** Projecting an equality of a pair to equality of the first components *) Definition sig_of_sig2_eq {A} {P Q : A -> Prop} {u v : { a : A | P a & Q a }} (p : u = v) : u = v :> { a : A | P a } := f_equal _ p. Definition proj1_sig_of_sig2_eq {A} {P Q : A -> Prop} {u v : { a : A | P a & Q a }} (p : u = v) : proj1_sig u = proj1_sig v := proj1_sig_eq (sig_of_sig2_eq p). (** Projecting an equality of a pair to equality of the second components *) Definition proj2_sig_of_sig2_eq {A} {P Q : A -> Prop} {u v : { a : A | P a & Q a }} (p : u = v) : rew proj1_sig_of_sig2_eq p in proj2_sig u = proj2_sig v := rew dependent p in eq_refl. (** Projecting an equality of a pair to equality of the third components *) Definition proj3_sig_eq {A} {P Q : A -> Prop} {u v : { a : A | P a & Q a }} (p : u = v) : rew proj1_sig_of_sig2_eq p in proj3_sig u = proj3_sig v := rew dependent p in eq_refl. (** Equality of [sig2] is itself a [sig2] (fowards-reasoning version) *) Definition eq_exist2_uncurried {A} {P Q : A -> Prop} {u1 v1 : A} {u2 : P u1} {v2 : P v1} {u3 : Q u1} {v3 : Q v1} (pqr : { p : u1 = v1 | rew p in u2 = v2 & rew p in u3 = v3 }) : exist2 _ _ u1 u2 u3 = exist2 _ _ v1 v2 v3. Proof. destruct pqr as [p q r]. destruct r, q, p; simpl. reflexivity. Defined. (** Equality of [sig2] is itself a [sig2] (backwards-reasoning version) *) Definition eq_sig2_uncurried {A} {P Q : A -> Prop} (u v : { a : A | P a & Q a }) (pqr : { p : proj1_sig u = proj1_sig v | rew p in proj2_sig u = proj2_sig v & rew p in proj3_sig u = proj3_sig v }) : u = v. Proof. destruct u as [u1 u2 u3], v as [v1 v2 v3]; simpl in *. apply eq_exist2_uncurried; exact pqr. Defined. Lemma eq_exist2_curried {A : Type} {P Q : A -> Prop} {u1 v1 : A} {u2 : P u1} {v2 : P v1} {u3 : Q u1} {v3 : Q v1} (p : u1 = v1) (q : rew p in u2 = v2) (r : rew p in u3 = v3) : exist2 P Q u1 u2 u3 = exist2 P Q v1 v2 v3. Proof. apply eq_sig2_uncurried; exists p; exact q + exact r. Defined. (** Curried version of proving equality of sigma types *) Definition eq_sig2 {A} {P Q : A -> Prop} (u v : { a : A | P a & Q a }) (p : proj1_sig u = proj1_sig v) (q : rew p in proj2_sig u = proj2_sig v) (r : rew p in proj3_sig u = proj3_sig v) : u = v := eq_sig2_uncurried u v (exist2 _ _ p q r). (** In order to have a performant [inversion_sigma], we define specialized versions for when we have constructors on one or both sides of the equality *) Definition eq_exist2_l {A : Type} {P Q : A -> Prop} {u1 : A} {u2 : P u1} {u3 : Q u1} {v : { a : A | P a & Q a }} (p : u1 = proj1_sig v) (q : rew p in u2 = proj2_sig v) (r : rew p in u3 = proj3_sig v) : exist2 P Q u1 u2 u3 = v := eq_sig2 (exist2 P Q u1 u2 u3) v p q r. Definition eq_exist2_r {A : Type} {P Q : A -> Prop} {u : { a : A | P a & Q a }} {v1 : A} {v2 : P v1} {v3 : Q v1} (p : proj1_sig u = v1) (q : rew p in proj2_sig u = v2) (r : rew p in proj3_sig u = v3) : u = exist2 P Q v1 v2 v3 := eq_sig2 u (exist2 P Q v1 v2 v3) p q r. (** Equality of [sig2] when the second property is an hProp *) Definition eq_sig2_hprop {A} {P Q : A -> Prop} (Q_hprop : forall (x : A) (p q : Q x), p = q) (u v : { a : A | P a & Q a }) (p : u = v :> { a : A | P a }) : u = v := eq_sig2 u v (proj1_sig_eq p) (proj2_sig_eq p) (Q_hprop _ _ _). (** Equivalence of equality of [sig2] with a [sig2] of equality *) (** We could actually prove an isomorphism here, and not just [<->], but for simplicity, we don't. *) Definition eq_sig2_uncurried_iff {A P Q} (u v : { a : A | P a & Q a }) : u = v <-> { p : proj1_sig u = proj1_sig v | rew p in proj2_sig u = proj2_sig v & rew p in proj3_sig u = proj3_sig v }. Proof. split; [ intro; subst; exists eq_refl; reflexivity | apply eq_sig2_uncurried ]. Defined. (** Induction principle for [@eq (sig2 _ _)] *) Definition eq_sig2_rect {A P Q} {u v : { a : A | P a & Q a }} (R : u = v -> Type) (f : forall p q r, R (eq_sig2 u v p q r)) : forall p, R p. Proof. intro p. specialize (f (proj1_sig_of_sig2_eq p) (proj2_sig_of_sig2_eq p) (proj3_sig_eq p)). destruct u, p; exact f. Defined. Definition eq_sig2_rec {A P Q u v} (R : u = v :> { a : A | P a & Q a } -> Set) := eq_sig2_rect R. Definition eq_sig2_ind {A P Q u v} (R : u = v :> { a : A | P a & Q a } -> Prop) := eq_sig2_rec R. (** In order to have a performant [inversion_sigma], we define specialized versions for when we have constructors on one or both sides of the equality *) Definition eq_sig2_rect_exist2_l {A P Q} {u1 u2 u3 v} (R : _ -> Type) (f : forall p q r, R (@eq_exist2_l A P Q u1 u2 u3 v p q r)) : forall p, R p := eq_sig2_rect R f. Definition eq_sig2_rect_exist2_r {A P Q} {u v1 v2 v3} (R : _ -> Type) (f : forall p q r, R (@eq_exist2_r A P Q u v1 v2 v3 p q r)) : forall p, R p := eq_sig2_rect R f. Definition eq_sig2_rect_exist2 {A P Q} {u1 u2 u3 v1 v2 v3} (R : _ -> Type) (f : forall p q r, R (@eq_exist2_curried A P Q u1 v1 u2 v2 u3 v3 p q r)) : forall p, R p := eq_sig2_rect R f. (** We want uncurried versions so [inversion_sigma] can accept intropatterns, but we use [ex2] types for the induction hypothesis to avoid extraction errors about informative inductive types having Prop instances *) Definition eq_sig2_rect_uncurried {A P Q} {u v : { a : A | P a & Q a }} (R : u = v -> Type) (f : forall pqr : exists2 p : proj1_sig u = proj1_sig v, _ & _, R (eq_sig2 u v (ex_proj1 pqr) (ex_proj2 pqr) (ex_proj3 pqr))) : forall p, R p := eq_sig2_rect R (fun p q r => f (ex_intro2 _ _ p q r)). Definition eq_sig2_rec_uncurried {A P Q u v} (R : u = v :> { a : A | P a & Q a } -> Set) := eq_sig2_rect_uncurried R. Definition eq_sig2_ind_uncurried {A P Q u v} (R : u = v :> { a : A | P a & Q a } -> Prop) := eq_sig2_rec_uncurried R. (** Equivalence of equality of [sig2] involving hProps with equality of the first components *) Definition eq_sig2_hprop_iff {A} {P Q : A -> Prop} (Q_hprop : forall (x : A) (p q : Q x), p = q) (u v : { a : A | P a & Q a }) : u = v <-> (u = v :> { a : A | P a }) := conj (fun p => f_equal (@sig_of_sig2 _ _ _) p) (eq_sig2_hprop Q_hprop u v). (** Non-dependent classification of equality of [sig] *) Definition eq_sig2_nondep {A} {B C : Prop} (u v : @sig2 A (fun _ => B) (fun _ => C)) (p : proj1_sig u = proj1_sig v) (q : proj2_sig u = proj2_sig v) (r : proj3_sig u = proj3_sig v) : u = v := @eq_sig2 _ _ _ u v p (eq_trans (rew_const _ _) q) (eq_trans (rew_const _ _) r). (** Classification of transporting across an equality of [sig2]s *) Lemma rew_sig2 {A x} {P : A -> Type} (Q R : forall a, P a -> Prop) (u : { p : P x | Q x p & R x p }) {y} (H : x = y) : rew [fun a => { p : P a | Q a p & R a p }] H in u = exist2 (Q y) (R y) (rew H in proj1_sig u) (rew dependent H in proj2_sig u) (rew dependent H in proj3_sig u). Proof. destruct H, u; reflexivity. Defined. End sig2. Global Arguments eq_exist2_curried A P Q _ _ _ _ _ _ !p !q !r / . (** [sumbool] is a boolean type equipped with the justification of their value *) Inductive sumbool (A B:Prop) : Set := | left : A -> {A} + {B} | right : B -> {A} + {B} where "{ A } + { B }" := (sumbool A B) : type_scope. Add Printing If sumbool. Arguments left {A B} _, [A] B _. Arguments right {A B} _ , A [B] _. Register sumbool as core.sumbool.type. (** [sumor] is an option type equipped with the justification of why it may not be a regular value *) #[universes(template)] Inductive sumor (A:Type) (B:Prop) : Type := | inleft : A -> A + {B} | inright : B -> A + {B} where "A + { B }" := (sumor A B) : type_scope. Add Printing If sumor. Arguments inleft {A B} _ , [A] B _. Arguments inright {A B} _ , A [B] _. (* Unset Universe Polymorphism. *) (** Various forms of the axiom of choice for specifications *) Section Choice_lemmas. Variables S S' : Set. Variable R : S -> S' -> Prop. Variable R' : S -> S' -> Set. Variables R1 R2 : S -> Prop. Lemma Choice : (forall x:S, {y:S' | R x y}) -> {f:S -> S' | forall z:S, R z (f z)}. Proof. intro H. exists (fun z => proj1_sig (H z)). intro z; destruct (H z); assumption. Defined. Lemma Choice2 : (forall x:S, {y:S' & R' x y}) -> {f:S -> S' & forall z:S, R' z (f z)}. Proof. intro H. exists (fun z => projT1 (H z)). intro z; destruct (H z); assumption. Defined. Lemma bool_choice : (forall x:S, {R1 x} + {R2 x}) -> {f:S -> bool | forall x:S, f x = true /\ R1 x \/ f x = false /\ R2 x}. Proof. intro H. exists (fun z:S => if H z then true else false). intro z; destruct (H z); auto. Defined. End Choice_lemmas. Section Dependent_choice_lemmas. Variable X : Type. Variable R : X -> X -> Prop. Lemma dependent_choice : (forall x:X, {y | R x y}) -> forall x0, {f : nat -> X | f O = x0 /\ forall n, R (f n) (f (S n))}. Proof. intros H x0. set (f:=fix f n := match n with O => x0 | S n' => proj1_sig (H (f n')) end). exists f. split. - reflexivity. - intro n; induction n; simpl; apply proj2_sig. Defined. End Dependent_choice_lemmas. (** A result of type [(Exc A)] is either a normal value of type [A] or an [error] : [Inductive Exc [A:Type] : Type := value : A->(Exc A) | error : (Exc A)]. It is implemented using the option type. *) Section Exc. Variable A : Type. Definition Exc := option A. Definition value := @Some A. Definition error := @None A. End Exc. Arguments error {A}. Definition except := False_rec. (* for compatibility with previous versions *) Arguments except [P] _. Theorem absurd_set : forall (A:Prop) (C:Set), A -> ~ A -> C. Proof. intros A C h1 h2. apply False_rec. apply (h2 h1). Defined. #[global] Hint Resolve left right inleft inright: core. #[global] Hint Resolve exist exist2 existT existT2: core. coq-8.20.0/theories/Init/Tactics.v000066400000000000000000000277471466560755400167340ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* negneg H | |- (_->False) => negneg H | |- _ => negpos H end in let pos H := match goal with | |- (~_) => posneg H | |- (_->False) => posneg H | |- _ => pospos H end in match type of H with | (~_) => neg H | (_->False) => neg H | _ => (elim H;fail) || pos H end. (* A useful complement to contradict. Here H:A while G allows concluding ~A *) Ltac false_hyp H G := let T := type of H in absurd T; [ apply G | assumption ]. (* A case with no loss of information. *) Ltac case_eq x := generalize (eq_refl x); pattern x at -1; case x. (* use either discriminate or injection on a hypothesis *) Ltac destr_eq H := discriminate H || (try (injection H as [= H])). (* Similar variants of destruct *) Tactic Notation "destruct_with_eqn" constr(x) := destruct x eqn:?. Tactic Notation "destruct_with_eqn" ident(n) := try intros until n; destruct n eqn:?. Tactic Notation "destruct_with_eqn" ":" ident(H) constr(x) := destruct x eqn:H. Tactic Notation "destruct_with_eqn" ":" ident(H) ident(n) := try intros until n; destruct n eqn:H. (** Break every hypothesis of a certain type *) Ltac destruct_all t := match goal with | x : t |- _ => destruct x; destruct_all t | _ => idtac end. (* Rewriting in all hypothesis several times everywhere *) Tactic Notation "rewrite_all" constr(eq) := repeat rewrite eq in *. Tactic Notation "rewrite_all" "<-" constr(eq) := repeat rewrite <- eq in *. (** Tactics for applying equivalences. The following code provides tactics "apply -> t", "apply <- t", "apply -> t in H" and "apply <- t in H". Here t is a term whose type consists of nested dependent and nondependent products with an equivalence A <-> B as the conclusion. The tactics with "->" in their names apply A -> B while those with "<-" in the name apply B -> A. *) (* The idea of the tactics is to first provide a term in the context whose type is the implication (in one of the directions), and then apply it. The first idea is to produce a statement "forall ..., A -> B" (call this type T) and then do "assert (H : T)" for a fresh H. Thus, T can be proved from the original equivalence and then used to perform the application. However, currently in Ltac it is difficult to produce such T from the original formula. Therefore, we first pose the original equivalence as H. If the type of H is a dependent product, we create an existential variable and apply H to this variable. If the type of H has the form C -> D, then we do a cut on C. Once we eliminate all products, we split (i.e., destruct) the conjunction into two parts and apply the relevant one. *) Ltac find_equiv H := let T := type of H in lazymatch T with | ?A -> ?B => let H1 := fresh in let H2 := fresh in cut A; [intro H1; pose proof (H H1) as H2; clear H H1; rename H2 into H; find_equiv H | clear H] | forall x : ?t, _ => let a := fresh "a" in let H1 := fresh "H" in evar (a : t); pose proof (H a) as H1; unfold a in H1; clear a; clear H; rename H1 into H; find_equiv H | ?A <-> ?B => idtac | _ => fail "The given statement does not seem to end with an equivalence." end. Ltac bapply lemma todo := let H := fresh in pose proof lemma as H; find_equiv H; [todo H; clear H | .. ]. Tactic Notation "apply" "->" constr(lemma) := bapply lemma ltac:(fun H => destruct H as [H _]; apply H). Tactic Notation "apply" "<-" constr(lemma) := bapply lemma ltac:(fun H => destruct H as [_ H]; apply H). Tactic Notation "apply" "->" constr(lemma) "in" hyp(J) := bapply lemma ltac:(fun H => destruct H as [H _]; apply H in J). Tactic Notation "apply" "<-" constr(lemma) "in" hyp(J) := bapply lemma ltac:(fun H => destruct H as [_ H]; apply H in J). (** An experimental tactic simpler than auto that is useful for ending proofs "in one step" *) Ltac easy := let rec use_hyp H := match type of H with | _ /\ _ => exact H || destruct_hyp H | _ => try solve [inversion H] end with do_intro := let H := fresh in intro H; use_hyp H with destruct_hyp H := case H; clear H; do_intro; do_intro in let rec use_hyps := match goal with | H : _ /\ _ |- _ => exact H || (destruct_hyp H; use_hyps) | H : _ |- _ => solve [inversion H] | _ => idtac end in let do_atom := solve [ trivial with eq_true | reflexivity | symmetry; trivial | contradiction ] in let rec do_ccl := try do_atom; repeat (do_intro; try do_atom); solve [ split; do_ccl ] in solve [ do_atom | use_hyps; do_ccl ] || fail "Cannot solve this goal". Tactic Notation "now" tactic(t) := t; easy. (** Slightly more than [easy]*) Ltac easy' := repeat split; simpl; easy || now destruct 1. (** A tactic to document or check what is proved at some point of a script *) Ltac now_show c := change c. (** Support for rewriting decidability statements *) Set Implicit Arguments. Lemma decide_left : forall (C:Prop) (decide:{C}+{~C}), C -> forall P:{C}+{~C}->Prop, (forall H:C, P (left _ H)) -> P decide. Proof. intros C decide H P H0; destruct decide. - apply H0. - contradiction. Qed. Lemma decide_right : forall (C:Prop) (decide:{C}+{~C}), ~C -> forall P:{C}+{~C}->Prop, (forall H:~C, P (right _ H)) -> P decide. Proof. intros C decide H P H0; destruct decide. - contradiction. - apply H0. Qed. Tactic Notation "decide" constr(lemma) "with" constr(H) := let try_to_merge_hyps H := try (clear H; intro H) || (let H' := fresh H "bis" in intro H'; try clear H') || (let H' := fresh in intro H'; try clear H') in match type of H with | ~ ?C => apply (decide_right lemma H); try_to_merge_hyps H | ?C -> False => apply (decide_right lemma H); try_to_merge_hyps H | _ => apply (decide_left lemma H); try_to_merge_hyps H end. (** Clear an hypothesis and its dependencies *) Tactic Notation "clear" "dependent" hyp(h) := let rec depclear h := clear h || lazymatch goal with | H : context [ h ] |- _ => depclear H; depclear h | H := context [ h ] |- _ => depclear H; depclear h end || fail "hypothesis to clear is used in the conclusion (maybe indirectly)" in depclear h. (** Revert an hypothesis and its dependencies : this is actually generalize dependent... *) #[deprecated(note="Use ""generalize dependent"" instead (""revert dependent"" is currently an alias)", since="8.18")] Tactic Notation "revert" "dependent" hyp(h) := generalize dependent h. (** 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 otherwise simplifies, [inversion_sigma] is useful; it will replace the equality of pairs with a pair of equalities, one involving a term casted along the other. This might also prove useful for writing a version of [inversion] / [dependent destruction] which does not lose information, i.e., does not turn a goal which is provable into one which requires axiom K / UIP. *) Ltac lookup_inversion_sigma_rect H := lazymatch type of H with | ex_intro _ _ _ = ex_intro _ _ _ => uconstr:(eq_ex_rect_ex_intro) | exist _ _ _ = exist _ _ _ => uconstr:(eq_sig_rect_exist) | existT _ _ _ = existT _ _ _ => uconstr:(eq_sigT_rect_existT) | _ = ex_intro _ _ _ => uconstr:(eq_ex_rect_ex_intro_r) | _ = exist _ _ _ => uconstr:(eq_sig_rect_exist_r) | _ = existT _ _ _ => uconstr:(eq_sigT_rect_existT_r) | ex_intro _ _ _ = _ => uconstr:(eq_ex_rect_ex_intro_l) | exist _ _ _ = _ => uconstr:(eq_sig_rect_exist_l) | existT _ _ _ = _ => uconstr:(eq_sigT_rect_existT_l) | ex_intro2 _ _ _ _ _ = ex_intro2 _ _ _ _ _ => uconstr:(eq_ex2_rect_ex_intro2) | exist2 _ _ _ _ _ = exist2 _ _ _ _ _ => uconstr:(eq_sig2_rect_exist2) | existT2 _ _ _ _ _ = existT2 _ _ _ _ _ => uconstr:(eq_sigT2_rect_existT2) | _ = ex_intro2 _ _ _ _ _ => uconstr:(eq_ex2_rect_ex_intro2_r) | _ = exist2 _ _ _ _ _ => uconstr:(eq_sig2_rect_exist2_r) | _ = existT2 _ _ _ _ _ => uconstr:(eq_sigT2_rect_existT2_r) | ex_intro2 _ _ _ _ _ = _ => uconstr:(eq_ex2_rect_ex_intro2_l) | exist2 _ _ _ _ _ = _ => uconstr:(eq_sig2_rect_exist2_l) | existT2 _ _ _ _ _ = _ => uconstr:(eq_sigT2_rect_existT2_l) | _ = _ :> ?T => let sig := uconstr:(@sig) in let sig2 := uconstr:(@sig2) in let sigT := uconstr:(@sigT) in let sigT2 := uconstr:(@sigT2) in let ex := uconstr:(@ex) in let ex2 := uconstr:(@ex2) in fail 0 "Type" "of" H "is" "not" "an" "equality" "of" "recognized" "Σ" "types:" "expected" "one" "of" sig sig2 sigT sigT2 ex "or" ex2 "but" "got" T | _ => fail 0 H "is" "not" "an" "equality" "of" "Σ" "types" end. Ltac inversion_sigma_on_as H ip := let rect := lookup_inversion_sigma_rect H in induction H as ip using rect. Ltac inversion_sigma_on H := inversion_sigma_on_as H ipattern:([]). Ltac inversion_sigma_step := match goal with | [ H : _ |- _ ] => inversion_sigma_on H end. Ltac inversion_sigma := repeat inversion_sigma_step. Tactic Notation "inversion_sigma" := inversion_sigma. Tactic Notation "inversion_sigma" hyp(H) := inversion_sigma_on H. Tactic Notation "inversion_sigma" hyp(H) "as" simple_intropattern(ip) := inversion_sigma_on_as H ip. (** A version of [time] that works for constrs *) Ltac time_constr tac := let eval_early := match goal with _ => restart_timer end in let ret := tac () in let eval_early := match goal with _ => finish_timing ( "Tactic evaluation" ) end in ret. (** Useful combinators *) Ltac assert_fails tac := tryif (once tac) then gfail 0 tac "succeeds" else idtac. Tactic Notation "assert_fails" tactic3(tac) := assert_fails tac. Create HintDb rewrite discriminated. #[global] Hint Variables Opaque : rewrite. Create HintDb typeclass_instances discriminated. (** A variant of [apply] using [refine], doing as much conversion as necessary. *) Ltac rapply p := (** before we try to add more underscores, first ensure that adding such underscores is valid *) (assert_succeeds (idtac; let __ := open_constr:(p _) in idtac); rapply uconstr:(p _)) || refine p. coq-8.20.0/theories/Init/Tauto.v000066400000000000000000000114031466560755400164140ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* intro | |- (Coq.Init.Logic.not _) => unfold Coq.Init.Logic.not at 1; intro end. Local Ltac axioms flags := match reverse goal with | |- ?X1 => is_unit_or_eq flags X1; constructor 1 | H:?X1 |- _ => is_empty flags X1; elim H | _ => assumption end. Local Ltac simplif flags := not_dep_intros; repeat (match reverse goal with | id: ?X1 |- _ => is_conj flags X1; elim id; do 2 intro; clear id | id: (Coq.Init.Logic.iff _ _) |- _ => elim id; do 2 intro; clear id | id: (Coq.Init.Logic.not _) |- _ => red in id | id: ?X1 |- _ => is_disj flags X1; elim id; intro; clear id | _ => (* behaves as matching [ id0: ?X1 -> ?X2, id1: ?X1 |- _ ] with universe-aware conversion *) find_cut ltac:(fun id0 id1 X2 => (* generalize (id0 id1); intro; clear id0 does not work (see Marco Maggiesi's BZ#301) so we instead use Assert and exact. *) assert X2; [exact (id0 id1) | clear id0] ) | id: forall (_ : ?X1), ?X2|- _ => is_unit_or_eq flags X1; cut X2; [ intro; clear id | (* id : forall (_: ?X1), ?X2 |- ?X2 *) cut X1; [exact id| constructor 1; fail] ] | id: forall (_ : ?X1), ?X2|- _ => flatten_contravariant_conj flags X1 X2 id (* moved from "id:(?A/\?B)->?X2|-" to "?A->?B->?X2|-" *) | id: forall (_: Coq.Init.Logic.iff ?X1 ?X2), ?X3|- _ => assert (forall (_: forall _:X1, X2), forall (_: forall _: X2, X1), X3) by (do 2 intro; apply id; split; assumption); clear id | id: forall (_:?X1), ?X2|- _ => flatten_contravariant_disj flags X1 X2 id (* moved from "id:(?A\/?B)->?X2|-" to "?A->?X2,?B->?X2|-" *) | |- ?X1 => is_conj flags X1; split | |- (Coq.Init.Logic.iff _ _) => split | |- (Coq.Init.Logic.not _) => red end; not_dep_intros). Local Ltac tauto_intuit flags t_reduce t_solver := let rec t_tauto_intuit := (simplif flags; axioms flags || match reverse goal with | id:forall(_: forall (_: ?X1), ?X2), ?X3|- _ => cut X3; [ intro; clear id; t_tauto_intuit | cut (forall (_: X1), X2); [ exact id | generalize (fun y:X2 => id (fun x:X1 => y)); intro; clear id; solve [ t_tauto_intuit ]]] | id:forall (_:not ?X1), ?X3|- _ => cut X3; [ intro; clear id; t_tauto_intuit | cut (not X1); [ exact id | clear id; intro; solve [t_tauto_intuit ]]] | |- ?X1 => is_disj flags X1; solve [left;t_tauto_intuit | right;t_tauto_intuit] end || (* NB: [|- _ -> _] matches any product *) match goal with | |- forall (_ : _), _ => intro; t_tauto_intuit | |- _ => t_reduce;t_solver end || t_solver ) in t_tauto_intuit. Local Ltac intuition_gen flags solver := tauto_intuit flags reduction_not_iff solver. Local Ltac tauto_intuitionistic flags := intuition_gen flags fail || fail "tauto failed". Local Ltac tauto_classical flags := (apply_nnpp || fail "tauto failed"); (tauto_intuitionistic flags || fail "Classical tauto failed"). Local Ltac tauto_gen flags := tauto_intuitionistic flags || tauto_classical flags. Ltac tauto := with_uniform_flags ltac:(fun flags => tauto_gen flags). Ltac dtauto := with_power_flags ltac:(fun flags => tauto_gen flags). Ltac intuition_solver := first [solve [auto] | tryif solve [auto with *] then warn_auto_with_star else idtac]. Local Ltac intuition_then tac := with_uniform_flags ltac:(fun flags => intuition_gen flags tac). Ltac intuition := intuition_then ltac:(idtac;intuition_solver). Local Ltac dintuition_then tac := with_power_flags ltac:(fun flags => intuition_gen flags tac). Ltac dintuition := dintuition_then ltac:(idtac;intuition_solver). Tactic Notation "intuition" := intuition. Tactic Notation "intuition" tactic(t) := intuition_then t. Tactic Notation "dintuition" := dintuition. Tactic Notation "dintuition" tactic(t) := dintuition_then t. coq-8.20.0/theories/Init/Wf.v000066400000000000000000000120301466560755400156710ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* A -> Prop. (** The accessibility predicate is defined to be non-informative *) (** (Acc_rect is automatically defined because Acc is a singleton type) *) Inductive Acc (x: A) : Prop := Acc_intro : (forall y:A, R y x -> Acc y) -> Acc x. Register Acc as core.wf.acc. Lemma Acc_inv : forall x:A, Acc x -> forall y:A, R y x -> Acc y. destruct 1; trivial. Defined. Global Arguments Acc_inv [x] _ [y] _, [x] _ y _. Register Acc_inv as core.wf.acc_inv. (** A relation is well-founded if every element is accessible *) Definition well_founded := forall a:A, Acc a. Register well_founded as core.wf.well_founded. (** Well-founded induction on [Set] and [Prop] *) Hypothesis Rwf : well_founded. Theorem well_founded_induction_type : forall P:A -> Type, (forall x:A, (forall y:A, R y x -> P y) -> P x) -> forall a:A, P a. Proof. intros; apply Acc_rect; auto. Defined. Theorem well_founded_induction : forall P:A -> Set, (forall x:A, (forall y:A, R y x -> P y) -> P x) -> forall a:A, P a. Proof. exact (fun P:A -> Set => well_founded_induction_type P). Defined. Theorem well_founded_ind : forall P:A -> Prop, (forall x:A, (forall y:A, R y x -> P y) -> P x) -> forall a:A, P a. Proof. exact (fun P:A -> Prop => well_founded_induction_type P). Defined. (** Well-founded fixpoints *) Section FixPoint. Variable P : A -> Type. Variable F : forall x:A, (forall y:A, R y x -> P y) -> P x. Fixpoint Fix_F (x:A) (a:Acc x) : P x := F (fun (y:A) (h:R y x) => Fix_F (Acc_inv a h)). Scheme Acc_inv_dep := Induction for Acc Sort Prop. Lemma Fix_F_eq (x:A) (r:Acc x) : F (fun (y:A) (p:R y x) => Fix_F (x:=y) (Acc_inv r p)) = Fix_F (x:=x) r. Proof. destruct r using Acc_inv_dep; auto. Qed. Definition Fix (x:A) := Fix_F (Rwf x). (** Proof that [well_founded_induction] satisfies the fixpoint equation. It requires an extra property of the functional *) Hypothesis F_ext : forall (x:A) (f g:forall y:A, R y x -> P y), (forall (y:A) (p:R y x), f y p = g y p) -> F f = F g. Lemma Fix_F_inv : forall (x:A) (r s:Acc x), Fix_F r = Fix_F s. Proof. intro x; induction (Rwf x); intros r s. rewrite <- (Fix_F_eq r); rewrite <- (Fix_F_eq s); intros. apply F_ext; auto. Qed. Lemma Fix_eq : forall x:A, Fix x = F (fun (y:A) (p:R y x) => Fix y). Proof. intro x; unfold Fix. rewrite <- Fix_F_eq. apply F_ext; intros. apply Fix_F_inv. Qed. End FixPoint. End Well_founded. (** Well-founded fixpoints over pairs *) Section Well_founded_2. Variables A B : Type. Variable R : A * B -> A * B -> Prop. Variable P : A -> B -> Type. Section FixPoint_2. Variable F : forall (x:A) (x':B), (forall (y:A) (y':B), R (y, y') (x, x') -> P y y') -> P x x'. Fixpoint Fix_F_2 (x:A) (x':B) (a:Acc R (x, x')) : P x x' := F (fun (y:A) (y':B) (h:R (y, y') (x, x')) => Fix_F_2 (x:=y) (x':=y') (Acc_inv a (y,y') h)). End FixPoint_2. Hypothesis Rwf : well_founded R. Theorem well_founded_induction_type_2 : (forall (x:A) (x':B), (forall (y:A) (y':B), R (y, y') (x, x') -> P y y') -> P x x') -> forall (a:A) (b:B), P a b. Proof. intros; apply Fix_F_2; auto. Defined. End Well_founded_2. Notation Acc_iter := Fix_F (only parsing). (* compatibility *) Notation Acc_iter_2 := Fix_F_2 (only parsing). (* compatibility *) (* Added by Julien Forest on 13/11/20 This construction is originally by Georges Gonthier, see https://sympa.inria.fr/sympa/arc/coq-club/2007-07/msg00013.html *) Section Acc_generator. Variable A : Type. Variable R : A -> A -> Prop. (* *Lazily* add 2^n - 1 Acc_intro on top of wf. Needed for fast reductions using Function and Program Fixpoint and probably using Fix and Fix_F_2 *) Fixpoint Acc_intro_generator n (wf : well_founded R) := match n with | O => wf | S n => fun x => Acc_intro x (fun y _ => Acc_intro_generator n (Acc_intro_generator n wf) y) end. End Acc_generator. coq-8.20.0/theories/Init/_CoqProject000066400000000000000000000000271466560755400172640ustar00rootroot00000000000000-R .. Coq -arg -noinit coq-8.20.0/theories/Lists/000077500000000000000000000000001466560755400153255ustar00rootroot00000000000000coq-8.20.0/theories/Lists/List.v000066400000000000000000003563221466560755400164420ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* default | x :: _ => x end. Definition hd_error (l:list A) := match l with | [] => None | x :: _ => Some x end. Definition tl (l:list A) := match l with | [] => nil | a :: m => m end. (** The [In] predicate *) Fixpoint In (a:A) (l:list A) : Prop := match l with | [] => False | b :: m => b = a \/ In a m end. End Lists. Section Facts. Variable A : Type. (** *** Generic facts *) (** Discrimination *) Theorem nil_cons (x:A) (l:list A) : [] <> x :: l. Proof. discriminate. Qed. (** Destruction *) Theorem destruct_list (l : list A) : {x:A & {tl:list A | l = x::tl}}+{l = []}. Proof. induction l as [|a tail]. - right; reflexivity. - left; exists a, tail; reflexivity. Qed. Lemma hd_error_tl_repr l (a:A) r : hd_error l = Some a /\ tl l = r <-> l = a :: r. Proof. destruct l as [|x xs]; [easy|cbn;split]. - now intros [[= ->] ->]. - now intros [= -> ->]. Qed. Lemma hd_error_some_nil l (a:A) : hd_error l = Some a -> l <> nil. Proof. unfold hd_error. destruct l; now discriminate. Qed. Theorem length_zero_iff_nil (l : list A): length l = 0 <-> l = []. Proof. split; [now destruct l | now intros ->]. Qed. (** *** Head and tail *) Theorem hd_error_nil : hd_error (@nil A) = None. Proof. reflexivity. Qed. Theorem hd_error_cons (l : list A) (x : A) : hd_error (x::l) = Some x. Proof. reflexivity. Qed. (**************************) (** *** Facts about [app] *) (**************************) (** Discrimination *) Theorem app_cons_not_nil (x y:list A) (a:A) : [] <> x ++ a :: y. Proof. now destruct x. Qed. (** Concat with [nil] *) Theorem app_nil_l (l:list A) : [] ++ l = l. Proof. reflexivity. Qed. Theorem app_nil_r (l:list A) : l ++ [] = l. Proof. induction l; simpl; f_equal; auto. Qed. (* begin hide *) (* Deprecated since 8.3 but attribute added in 8.18 *) Theorem app_nil_end_deprecated (l:list A) : l = l ++ []. Proof. symmetry; apply app_nil_r. Qed. (* end hide *) (** [app] is associative *) Theorem app_assoc (l m n:list A) : l ++ m ++ n = (l ++ m) ++ n. Proof. induction l; simpl; f_equal; auto. Qed. (* begin hide *) (* Deprecated since 8.3 but attribute added in 8.18 *) Theorem app_assoc_reverse_deprecated (l m n:list A) : (l ++ m) ++ n = l ++ m ++ n. Proof. symmetry; apply app_assoc. Qed. (* end hide *) (** [app] commutes with [cons] *) Theorem app_comm_cons (x y:list A) (a:A) : a :: (x ++ y) = (a :: x) ++ y. Proof. reflexivity. Qed. (** Facts deduced from the result of a concatenation *) Theorem app_eq_nil (l l':list A) : l ++ l' = [] -> l = [] /\ l' = []. Proof. now destruct l, l'. Qed. Lemma app_eq_cons x y z (a : A): x ++ y = a :: z -> (x = nil /\ y = a :: z) \/ exists x', x = a :: x' /\ z = x' ++ y. Proof. intro H. destruct x as [|b x]. - now left. - right. injection H as ->. now exists x. Qed. Theorem app_eq_unit (x y:list A) (a:A) : x ++ y = [a] -> x = [] /\ y = [a] \/ x = [a] /\ y = []. Proof. destruct x; cbn. - intros ->. now left. - intros [= -> [-> ->] %app_eq_nil]. now right. Qed. Lemma elt_eq_unit l1 l2 (a b : A) : l1 ++ a :: l2 = [b] -> a = b /\ l1 = [] /\ l2 = []. Proof. intros Heq. apply app_eq_unit in Heq. now destruct Heq as [[Heq1 Heq2]|[Heq1 Heq2]]; inversion_clear Heq2. Qed. Theorem app_eq_app X (x1 x2 y1 y2: list X) : x1++x2 = y1++y2 -> exists l, (x1 = y1++l /\ y2 = l++x2) \/ (y1 = x1++l /\ x2 = l++y2). Proof. revert y1. induction x1 as [|a x1 IH]. - cbn. intros y1 ->. exists y1. now right. - intros [|b y1]; cbn. + intros <-. exists (a :: x1). now left. + intros [=-> [l Hl] %IH]. exists l. now destruct Hl as [[-> ->]|[-> ->]]; [left|right]. Qed. Lemma app_inj_tail : forall (x y:list A) (a b:A), x ++ [a] = y ++ [b] -> x = y /\ a = b. Proof. intros x y a b [l [[-> Hl %eq_sym]|[-> Hl %eq_sym]]] %app_eq_app; apply elt_eq_unit in Hl as [? [-> ?]]; now rewrite app_nil_r. Qed. Lemma app_inj_tail_iff : forall (x y:list A) (a b:A), x ++ [a] = y ++ [b] <-> x = y /\ a = b. Proof. intros. now split; [apply app_inj_tail|intros [-> ->]]. Qed. (** Compatibility with other operations *) Lemma length_app : forall l l' : list A, length (l++l') = length l + length l'. Proof. intro l; induction l; simpl; auto. Qed. Lemma last_length : forall (l : list A) a, length (l ++ a :: nil) = S (length l). Proof. intros ; rewrite length_app ; simpl. rewrite Nat.add_succ_r, Nat.add_0_r; reflexivity. Qed. Lemma app_inv_head_iff: forall l l1 l2 : list A, l ++ l1 = l ++ l2 <-> l1 = l2. Proof. intro l; induction l as [|? l IHl]; split; intros H; simpl; auto. - apply IHl. inversion H. auto. - subst. auto. Qed. Lemma app_inv_head: forall l l1 l2 : list A, l ++ l1 = l ++ l2 -> l1 = l2. Proof. apply app_inv_head_iff. Qed. Lemma app_inv_tail: forall l l1 l2 : list A, l1 ++ l = l2 ++ l -> l1 = l2. Proof. intros l. induction l as [|a l IHl]. - intros ? ?. now rewrite !app_nil_r. - intros ? ?. change (a :: l) with ([a] ++ l). rewrite !app_assoc. now intros [? ?] %IHl %app_inj_tail_iff. Qed. Lemma app_inv_tail_iff: forall l l1 l2 : list A, l1 ++ l = l2 ++ l <-> l1 = l2. Proof. split; [apply app_inv_tail | now intros ->]. Qed. (************************) (** *** Facts about [In] *) (************************) (** Characterization of [In] *) Theorem in_eq : forall (a:A) (l:list A), In a (a :: l). Proof. simpl; auto. Qed. Theorem in_cons : forall (a b:A) (l:list A), In b l -> In b (a :: l). Proof. simpl; auto. Qed. Theorem not_in_cons (x a : A) (l : list A): ~ In x (a::l) <-> x<>a /\ ~ In x l. Proof. simpl. intuition. Qed. Theorem in_nil : forall a:A, ~ In a []. Proof. unfold not; intros a H; inversion_clear H. Qed. Lemma in_app_or : forall (l m:list A) (a:A), In a (l ++ m) -> In a l \/ In a m. Proof. intros l m a. induction l; cbn; tauto. Qed. Lemma in_or_app : forall (l m:list A) (a:A), In a l \/ In a m -> In a (l ++ m). Proof. intros l m a. induction l; cbn; tauto. Qed. Lemma in_app_iff : forall l l' (a:A), In a (l++l') <-> In a l \/ In a l'. Proof. split; auto using in_app_or, in_or_app. Qed. Theorem in_split : forall x (l:list A), In x l -> exists l1 l2, l = l1++x::l2. Proof. intros x l; induction l as [|a l IHl]; simpl; [destruct 1|destruct 1 as [?|H]]. - subst a; auto. exists [], l; auto. - destruct (IHl H) as (l1,(l2,H0)). exists (a::l1), l2; simpl. apply f_equal. auto. Qed. Lemma in_elt : forall (x:A) l1 l2, In x (l1 ++ x :: l2). Proof. intros. apply in_or_app. right; left; reflexivity. Qed. Lemma in_elt_inv : forall (x y : A) l1 l2, In x (l1 ++ y :: l2) -> x = y \/ In x (l1 ++ l2). Proof. intros x y l1 l2 Hin. apply in_app_or in Hin. destruct Hin as [Hin|[Hin|Hin]]; [right|left|right]; try apply in_or_app; intuition. Qed. Lemma app_inj_pivot x1 x2 y1 y2 (a : A): x1 ++ a :: x2 = y1 ++ a :: y2 -> ((In a x1 /\ In a y2) \/ (In a x2 /\ In a y1)) \/ (x1 = y1 /\ x2 = y2). Proof. induction y1 as [|b y1 IHy] in x1 |- *; intros [[-> H]|[x' [-> H]]]%app_eq_cons. - right. now injection H. - subst y2. left; left. split; [apply in_eq | apply in_elt]. - injection H as -> ->. left; right. split; [ apply in_elt | apply in_eq ]. - symmetry in H. apply IHy in H as [[[]|[]]|[]]. + left; left. split; [apply in_cons|]; assumption. + left; right. split; [|apply in_cons]; assumption. + right. split; congruence. Qed. (** Inversion *) Lemma in_inv : forall (a b:A) (l:list A), In b (a :: l) -> a = b \/ In b l. Proof. easy. Qed. (** Decidability of [In] *) Theorem in_dec : (forall x y:A, {x = y} + {x <> y}) -> forall (a:A) (l:list A), {In a l} + {~ In a l}. Proof. intros H a l; induction l as [| a0 l IHl]. - right; apply in_nil. - destruct (H a0 a); simpl; auto. destruct IHl; simpl; auto. right; unfold not; intros [Hc1| Hc2]; auto. Defined. End Facts. #[global] Hint Resolve app_assoc app_assoc_reverse_deprecated: datatypes. #[global] Hint Resolve app_comm_cons app_cons_not_nil: datatypes. #[global] Hint Immediate app_eq_nil: datatypes. #[global] Hint Resolve app_eq_unit app_inj_tail: datatypes. #[global] Hint Resolve in_eq in_cons in_inv in_nil in_app_or in_or_app: datatypes. (* XXX declare datatypes db and move to top of file *) Local Ltac Tauto.intuition_solver ::= auto with datatypes. (*******************************************) (** * Operations on the elements of a list *) (*******************************************) Section Elts. Variable A : Type. (*****************************) (** ** Nth element of a list *) (*****************************) Fixpoint nth (n:nat) (l:list A) (default:A) {struct l} : A := match n, l with | O, x :: l' => x | O, [] => default | S m, [] => default | S m, x :: t => nth m t default end. Fixpoint nth_ok (n:nat) (l:list A) (default:A) {struct l} : bool := match n, l with | O, x :: l' => true | O, [] => false | S m, [] => false | S m, x :: t => nth_ok m t default end. Lemma nth_in_or_default : forall (n:nat) (l:list A) (d:A), {In (nth n l d) l} + {nth n l d = d}. Proof. intros n l d; revert n; induction l as [|? ? IHl]. - intro n; right; destruct n; trivial. - intros [|n]; simpl. * left; auto. * destruct (IHl n); auto. Qed. Lemma nth_S_cons : forall (n:nat) (l:list A) (d a:A), In (nth n l d) l -> In (nth (S n) (a :: l) d) (a :: l). Proof. simpl; auto. Qed. Fixpoint nth_error (l:list A) (n:nat) {struct n} : option A := match n, l with | O, x :: _ => Some x | S n, _ :: l => nth_error l n | _, _ => None end. Definition nth_default (default:A) (l:list A) (n:nat) : A := match nth_error l n with | Some x => x | None => default end. Lemma nth_default_eq : forall n l (d:A), nth_default d l n = nth n l d. Proof. unfold nth_default; intro n; induction n; intros [ | ] ?; simpl; auto. Qed. (** Results about [nth] *) Lemma nth_In : forall (n:nat) (l:list A) (d:A), n < length l -> In (nth n l d) l. Proof. unfold lt; intro n; induction n as [| n hn]; simpl; intro l. - destruct l; simpl; [ inversion 2 | auto ]. - destruct l; simpl. * inversion 2. * intros d ie; right; apply hn. now apply Nat.succ_le_mono. Qed. Lemma In_nth l x d : In x l -> exists n, n < length l /\ nth n l d = x. Proof. induction l as [|a l IH]. - easy. - intros [H|H]. * subst; exists 0; simpl; auto using Nat.lt_0_succ. * destruct (IH H) as (n & Hn & Hn'). apply Nat.succ_lt_mono in Hn. now exists (S n). Qed. Lemma nth_overflow : forall l n d, length l <= n -> nth n l d = d. Proof. intro l; induction l as [|? ? IHl]; intro n; destruct n; simpl; intros d H; auto. - inversion H. - apply IHl. now apply Nat.succ_le_mono. Qed. Lemma nth_indep : forall l n d d', n < length l -> nth n l d = nth n l d'. Proof. intro l; induction l as [|? ? IHl]. - inversion 1. - intros [|n] d d'; [intros; reflexivity|]. intros H. apply IHl. now apply Nat.succ_lt_mono. Qed. Lemma app_nth1 : forall l l' d n, n < length l -> nth n (l++l') d = nth n l d. Proof. intro l; induction l as [|? ? IHl]. - inversion 1. - intros l' d [|n]; simpl; [intros; reflexivity|]. intros H. apply IHl. now apply Nat.succ_lt_mono. Qed. Lemma app_nth2 : forall l l' d n, n >= length l -> nth n (l++l') d = nth (n-length l) l' d. Proof. intro l; induction l as [|? ? IHl]; intros l' d [|n]; auto. - inversion 1. - intros; simpl; rewrite IHl; [reflexivity|now apply Nat.succ_le_mono]. Qed. Lemma app_nth2_plus : forall l l' d n, nth (length l + n) (l ++ l') d = nth n l' d. Proof. intros. now rewrite app_nth2, Nat.add_comm, Nat.add_sub; [|apply Nat.le_add_r]. Qed. Lemma nth_middle : forall l l' a d, nth (length l) (l ++ a :: l') d = a. Proof. intros. rewrite <- Nat.add_0_r at 1. apply app_nth2_plus. Qed. Lemma nth_split n l d : n < length l -> exists l1, exists l2, l = l1 ++ nth n l d :: l2 /\ length l1 = n. Proof. revert l. induction n as [|n IH]; intros [|a l] H; try easy. - exists nil; exists l; now simpl. - destruct (IH l) as (l1 & l2 & Hl & Hl1); [now apply Nat.succ_lt_mono|]. exists (a::l1); exists l2; simpl; split; now f_equal. Qed. Lemma nth_ext : forall l l' d d', length l = length l' -> (forall n, n < length l -> nth n l d = nth n l' d') -> l = l'. Proof. intro l; induction l as [|a l IHl]; intros l' d d' Hlen Hnth; destruct l' as [| b l']. - reflexivity. - inversion Hlen. - inversion Hlen. - change a with (nth 0 (a :: l) d). change b with (nth 0 (b :: l') d'). rewrite Hnth; f_equal. + apply IHl with d d'; [ now inversion Hlen | ]. intros n Hlen'; apply (Hnth (S n)). now apply (Nat.succ_lt_mono n (length l)). + simpl; apply Nat.lt_0_succ. Qed. (** Results about [nth_error] *) Lemma nth_error_In l n x : nth_error l n = Some x -> In x l. Proof. revert n. induction l as [|a l IH]; intros [|n]; simpl; try easy. - injection 1; auto. - eauto. Qed. Lemma In_nth_error l x : In x l -> exists n, nth_error l n = Some x. Proof. induction l as [|a l IH]. - easy. - intros [H|[n ?] %IH]. + subst; now exists 0. + now exists (S n). Qed. Lemma In_iff_nth_error l x : In x l <-> exists n, nth_error l n = Some x. Proof. firstorder eauto using In_nth_error, nth_error_In. Qed. Lemma nth_error_None l n : nth_error l n = None <-> length l <= n. Proof. revert n. induction l as [|? ? IHl]; intro n; destruct n; simpl. - split; auto. - now split; intros; [apply Nat.le_0_l|]. - now split; [|intros ? %Nat.nle_succ_0]. - now rewrite IHl, Nat.succ_le_mono. Qed. Lemma nth_error_Some l n : nth_error l n <> None <-> n < length l. Proof. revert n. induction l as [|? ? IHl]; intro n; destruct n; simpl. - split; [now destruct 1 | inversion 1]. - split; [now destruct 1 | inversion 1]. - now split; intros; [apply Nat.lt_0_succ|]. - now rewrite IHl, Nat.succ_lt_mono. Qed. Lemma nth_error_split l n a : nth_error l n = Some a -> exists l1, exists l2, l = l1 ++ a :: l2 /\ length l1 = n. Proof. revert l. induction n as [|n IH]; intros [|x l] H; [easy| |easy|]. - exists nil; exists l. now injection H as [= ->]. - destruct (IH _ H) as (l1 & l2 & H1 & H2). exists (x::l1); exists l2; simpl; split; now f_equal. Qed. Lemma nth_error_app1 l l' n : n < length l -> nth_error (l++l') n = nth_error l n. Proof. revert l. induction n as [|n IHn]; intros [|a l] H; [easy ..|]. cbn. now apply IHn, Nat.succ_le_mono. Qed. Lemma nth_error_app2 l l' n : length l <= n -> nth_error (l++l') n = nth_error l' (n-length l). Proof. revert l. induction n as [|n IHn]; intros [|a l] H; [easy ..|]. cbn. now apply IHn, Nat.succ_le_mono. Qed. Lemma nth_error_app l l' n : nth_error (l ++ l') n = if Nat.ltb n (length l) then nth_error l n else nth_error l' (n - length l). Proof. case (Nat.ltb_spec n (length l)) as []. - rewrite nth_error_app1; trivial. - rewrite nth_error_app2; trivial. Qed. Lemma nth_error_ext l l': (forall n, nth_error l n = nth_error l' n) -> l = l'. Proof. revert l'. induction l as [|a l IHl]; intros l' Hnth; destruct l'. - reflexivity. - discriminate (Hnth 0). - discriminate (Hnth 0). - injection (Hnth 0) as ->. f_equal. apply IHl. intro n. exact (Hnth (S n)). Qed. Lemma unfold_nth_error l n : nth_error l n = match n, l with | O, x :: _ => Some x | S n, _ :: l => nth_error l n | _, _ => None end. Proof. destruct n; reflexivity. Qed. Lemma nth_error_nil n : nth_error nil n = None. Proof. destruct n; reflexivity. Qed. Lemma nth_error_cons x xs n : nth_error (x :: xs) n = match n with | O => Some x | S n => nth_error xs n end. Proof. apply unfold_nth_error. Qed. Lemma nth_error_O l : nth_error l O = hd_error l. Proof. destruct l; reflexivity. Qed. Lemma nth_error_S l n : nth_error l (S n) = nth_error (tl l) n. Proof. destruct l; rewrite ?nth_error_nil; reflexivity. Qed. Lemma nth_error_cons_0 x l : nth_error (cons x l) 0 = Some x. Proof. trivial. Qed. Lemma nth_error_cons_succ x l n : nth_error (cons x l) (S n) = nth_error l n. Proof. trivial. Qed. (** Results directly relating [nth] and [nth_error] *) Lemma nth_error_nth : forall (l : list A) (n : nat) (x d : A), nth_error l n = Some x -> nth n l d = x. Proof. intros l n x d H. apply nth_error_split in H. destruct H as [l1 [l2 [H H']]]. subst. rewrite app_nth2; [|auto]. rewrite Nat.sub_diag. reflexivity. Qed. Lemma nth_error_nth' : forall (l : list A) (n : nat) (d : A), n < length l -> nth_error l n = Some (nth n l d). Proof. intros l n d H. apply (nth_split _ d) in H. destruct H as [l1 [l2 [H H']]]. subst. rewrite H. rewrite nth_error_app2; [|auto]. rewrite app_nth2; [| auto]. repeat (rewrite Nat.sub_diag). reflexivity. Qed. Lemma nth_error_nth_None (l : list A) (n : nat) (d : A) : nth_error l n = None -> nth n l d = d. Proof. intros H%nth_error_None. apply nth_overflow. assumption. Qed. (******************************) (** ** Last element of a list *) (******************************) (** [last l d] returns the last element of the list [l], or the default value [d] if [l] is empty. *) Fixpoint last (l:list A) (d:A) : A := match l with | [] => d | [a] => a | a :: l => last l d end. Lemma last_last : forall l a d, last (l ++ [a]) d = a. Proof. intro l; induction l as [|? l IHl]; intros; [ reflexivity | ]. simpl; rewrite IHl. destruct l; reflexivity. Qed. (** [removelast l] remove the last element of [l] *) Fixpoint removelast (l:list A) : list A := match l with | [] => [] | [a] => [] | a :: l => a :: removelast l end. Lemma app_removelast_last : forall l d, l <> [] -> l = removelast l ++ [last l d]. Proof. intro l; induction l as [|? l IHl]. - destruct 1; auto. - intros d _. destruct l as [|a0 l]; auto. pattern (a0::l) at 1; rewrite IHl with d; auto; discriminate. Qed. Lemma exists_last : forall l, l <> [] -> { l' : (list A) & { a : A | l = l' ++ [a]}}. Proof. intro l; induction l as [|a l IHl]. - destruct 1; auto. - intros _. destruct l. + exists [], a; auto. + destruct IHl as [l' (a',H)]; try discriminate. rewrite H. exists (a::l'), a'; auto. Qed. Lemma removelast_app : forall l l', l' <> [] -> removelast (l++l') = l ++ removelast l'. Proof. intro l; induction l as [|? l IHl]; [easy|]. intros l' H. cbn. rewrite <- IHl by assumption. now destruct l, l'. Qed. Lemma removelast_last : forall l a, removelast (l ++ [a]) = l. Proof. intros. rewrite removelast_app. - apply app_nil_r. - intros Heq; inversion Heq. Qed. (*****************) (** ** Remove *) (*****************) Hypothesis eq_dec : forall x y : A, {x = y}+{x <> y}. Fixpoint remove (x : A) (l : list A) : list A := match l with | [] => [] | y::tl => if (eq_dec x y) then remove x tl else y::(remove x tl) end. Lemma remove_cons : forall x l, remove x (x :: l) = remove x l. Proof. intros x l; simpl; destruct (eq_dec x x); [ reflexivity | now exfalso ]. Qed. Lemma remove_app : forall x l1 l2, remove x (l1 ++ l2) = remove x l1 ++ remove x l2. Proof. intros x l1; induction l1 as [|a l1 IHl1]; intros l2; simpl. - reflexivity. - destruct (eq_dec x a). + apply IHl1. + rewrite <- app_comm_cons; f_equal. apply IHl1. Qed. Theorem remove_In : forall (l : list A) (x : A), ~ In x (remove x l). Proof. intro l; induction l as [|x l IHl]; auto. intro y; simpl; destruct (eq_dec y x) as [yeqx | yneqx]. - apply IHl. - unfold not; intro HF; simpl in HF; destruct HF; auto. apply (IHl y); assumption. Qed. Lemma notin_remove: forall l x, ~ In x l -> remove x l = l. Proof. intros l x; induction l as [|y l IHl]; simpl; intros Hnin. - reflexivity. - destruct (eq_dec x y); [subst|f_equal]; tauto. Qed. Lemma in_remove: forall l x y, In x (remove y l) -> In x l /\ x <> y. Proof. intro l; induction l as [|z l IHl]; intros x y Hin. - inversion Hin. - simpl in Hin. destruct (eq_dec y z) as [Heq|Hneq]; subst; split. + right; now apply IHl with z. + intros Heq; revert Hin; subst; apply remove_In. + inversion Hin; subst; [left; reflexivity|right]. now apply IHl with y. + destruct Hin as [Hin|Hin]; subst. * now intros Heq; apply Hneq. * intros Heq; revert Hin; subst; apply remove_In. Qed. Lemma in_in_remove : forall l x y, x <> y -> In x l -> In x (remove y l). Proof. intro l; induction l as [|z l IHl]; simpl; intros x y Hneq Hin. - apply Hin. - destruct (eq_dec y z); subst. + destruct Hin. * exfalso; now apply Hneq. * now apply IHl. + simpl; destruct Hin; [now left|right]. now apply IHl. Qed. Lemma remove_remove_comm : forall l x y, remove x (remove y l) = remove y (remove x l). Proof. intro l; induction l as [| z l IHl]; simpl; intros x y. - reflexivity. - destruct (eq_dec y z); simpl; destruct (eq_dec x z); try rewrite IHl; auto. + subst; symmetry; apply remove_cons. + simpl; destruct (eq_dec y z); tauto. Qed. Lemma remove_remove_eq : forall l x, remove x (remove x l) = remove x l. Proof. intros l x; now rewrite (notin_remove _ _ (remove_In l x)). Qed. Lemma remove_length_le : forall l x, length (remove x l) <= length l. Proof. intro l; induction l as [|y l IHl]; simpl; intros x; trivial. destruct (eq_dec x y); simpl. - rewrite IHl; constructor; reflexivity. - apply (proj1 (Nat.succ_le_mono _ _) (IHl x)). Qed. Lemma remove_length_lt : forall l x, In x l -> length (remove x l) < length l. Proof. intro l; induction l as [|y l IHl]; simpl; intros x Hin. - contradiction Hin. - destruct Hin as [-> | Hin]. + destruct (eq_dec x x); [|easy]. apply Nat.lt_succ_r, remove_length_le. + specialize (IHl _ Hin); destruct (eq_dec x y); simpl; auto. now apply Nat.succ_lt_mono in IHl. Qed. (******************************************) (** ** Counting occurrences of an element *) (******************************************) Fixpoint count_occ (l : list A) (x : A) : nat := match l with | [] => 0 | y :: tl => let n := count_occ tl x in if eq_dec y x then S n else n end. (** Compatibility of count_occ with operations on list *) Theorem count_occ_In l x : In x l <-> count_occ l x > 0. Proof. induction l as [|y l IHl]; simpl. - split; [destruct 1 | apply Nat.nlt_0_r]. - destruct eq_dec as [->|Hneq]; rewrite IHl; intuition (apply Nat.lt_0_succ). Qed. Theorem count_occ_not_In l x : ~ In x l <-> count_occ l x = 0. Proof. rewrite count_occ_In. unfold gt. now rewrite Nat.nlt_ge, Nat.le_0_r. Qed. Lemma count_occ_nil x : count_occ [] x = 0. Proof. reflexivity. Qed. Theorem count_occ_inv_nil l : (forall x:A, count_occ l x = 0) <-> l = []. Proof. split. - induction l as [|x l]; trivial. intros H. specialize (H x). simpl in H. destruct eq_dec as [_|NEQ]; [discriminate|now elim NEQ]. - now intros ->. Qed. Lemma count_occ_cons_eq l x y : x = y -> count_occ (x::l) y = S (count_occ l y). Proof. intros H. simpl. now destruct (eq_dec x y). Qed. Lemma count_occ_cons_neq l x y : x <> y -> count_occ (x::l) y = count_occ l y. Proof. intros H. simpl. now destruct (eq_dec x y). Qed. Lemma count_occ_app l1 l2 x : count_occ (l1 ++ l2) x = count_occ l1 x + count_occ l2 x. Proof. induction l1 as [ | h l1 IHl1]; cbn; trivial. now destruct (eq_dec h x); [ rewrite IHl1 | ]. Qed. Lemma count_occ_elt_eq l1 l2 x y : x = y -> count_occ (l1 ++ x :: l2) y = S (count_occ (l1 ++ l2) y). Proof. intros ->. rewrite ? count_occ_app; cbn. destruct (eq_dec y y) as [Heq | Hneq]; [ apply Nat.add_succ_r | now contradiction Hneq ]. Qed. Lemma count_occ_elt_neq l1 l2 x y : x <> y -> count_occ (l1 ++ x :: l2) y = count_occ (l1 ++ l2) y. Proof. intros Hxy. rewrite ? count_occ_app; cbn. now destruct (eq_dec x y) as [Heq | Hneq]; [ contradiction Hxy | ]. Qed. Lemma count_occ_bound x l : count_occ l x <= length l. Proof. induction l as [|h l]; cbn; auto. destruct (eq_dec h x); [ apply (proj1 (Nat.succ_le_mono _ _)) | ]; intuition. Qed. End Elts. (*******************************) (** * Manipulating whole lists *) (*******************************) Section ListOps. Variable A : Type. (*************************) (** ** Reverse *) (*************************) Fixpoint rev (l:list A) : list A := match l with | [] => [] | x :: l' => rev l' ++ [x] end. Lemma rev_app_distr : forall x y:list A, rev (x ++ y) = rev y ++ rev x. Proof. intros x y; induction x as [| a l IHl]; cbn. - now rewrite app_nil_r. - now rewrite IHl, app_assoc. Qed. Remark rev_unit : forall (l:list A) (a:A), rev (l ++ [a]) = a :: rev l. Proof. intros l a. apply rev_app_distr. Qed. Lemma rev_involutive : forall l:list A, rev (rev l) = l. Proof. intro l; induction l as [| a l IHl]. - reflexivity. - cbn. now rewrite rev_unit, IHl. Qed. Lemma rev_inj (l1 l2: list A): rev l1 = rev l2 -> l1 = l2. Proof. intro H. apply (f_equal rev) in H. rewrite !rev_involutive in H. assumption. Qed. Lemma rev_eq_app : forall l l1 l2, rev l = l1 ++ l2 -> l = rev l2 ++ rev l1. Proof. intros l l1 l2 Heq. rewrite <- (rev_involutive l), Heq. apply rev_app_distr. Qed. (*********************************************) (** Reverse Induction Principle on Lists *) (*********************************************) Lemma rev_list_ind : forall P:list A-> Prop, P [] -> (forall (a:A) (l:list A), P (rev l) -> P (rev (a :: l))) -> forall l:list A, P (rev l). Proof. intros P ? ? l; induction l; auto. Qed. Theorem rev_ind : forall P:list A -> Prop, P [] -> (forall (x:A) (l:list A), P l -> P (l ++ [x])) -> forall l:list A, P l. Proof. intros P ? ? l. rewrite <- (rev_involutive l). apply (rev_list_ind P); cbn; auto. Qed. (** Compatibility with other operations *) Lemma in_rev : forall l x, In x l <-> In x (rev l). Proof. intro l; induction l as [|? ? IHl]; [easy|]. intros. cbn. rewrite in_app_iff, IHl. cbn. tauto. Qed. Lemma length_rev : forall l, length (rev l) = length l. Proof. intro l; induction l as [|? l IHl];simpl; auto. now rewrite length_app, IHl, Nat.add_comm. Qed. Lemma rev_nth : forall l d n, n < length l -> nth n (rev l) d = nth (length l - S n) l d. Proof. intros l d; induction l as [|a l IHl] using rev_ind; [easy|]. rewrite rev_app_distr, length_app, Nat.add_comm. cbn. intros [|n]. - now rewrite Nat.sub_0_r, nth_middle. - intros Hn %Nat.succ_lt_mono. rewrite (IHl _ Hn), app_nth1; [reflexivity|]. apply Nat.sub_lt; [assumption|apply Nat.lt_0_succ]. Qed. Lemma nth_error_rev n l : nth_error (rev l) n = if Nat.ltb n (length l) then nth_error l (length l - S n) else None. Proof. case (Nat.ltb_spec n (length l)) as []; cycle 1. { apply nth_error_None; rewrite ?length_rev; trivial. } destruct l as [|x l']; [inversion H|]; set (x::l') as l in *. rewrite 2 nth_error_nth' with (d:=x), rev_nth; rewrite ?length_rev; auto using Nat.lt_0_succ, Nat.sub_lt. Qed. (** An alternative tail-recursive definition for reverse *) Fixpoint rev_append (l l': list A) : list A := match l with | [] => l' | a::l => rev_append l (a::l') end. Definition rev' l : list A := rev_append l []. Lemma rev_append_rev : forall l l', rev_append l l' = rev l ++ l'. Proof. intro l; induction l; simpl; auto; intros. rewrite <- app_assoc; firstorder. Qed. Lemma rev_alt : forall l, rev l = rev_append l []. Proof. intros; rewrite rev_append_rev. rewrite app_nil_r; trivial. Qed. (*************************) (** ** Concatenation *) (*************************) Fixpoint concat (l : list (list A)) : list A := match l with | nil => nil | cons x l => x ++ concat l end. Lemma concat_nil : concat nil = nil. Proof. reflexivity. Qed. Lemma concat_cons : forall x l, concat (cons x l) = x ++ concat l. Proof. reflexivity. Qed. Lemma concat_app : forall l1 l2, concat (l1 ++ l2) = concat l1 ++ concat l2. Proof. intros l1; induction l1 as [|x l1 IH]; intros l2; simpl. - reflexivity. - rewrite IH; apply app_assoc. Qed. Lemma in_concat : forall l y, In y (concat l) <-> exists x, In x l /\ In y x. Proof. intro l; induction l as [|a l IHl]; simpl; intro y; split; intros H. - contradiction. - destruct H as (x,(H,_)); contradiction. - destruct (in_app_or _ _ _ H) as [H0|H0]. + exists a; auto. + destruct (IHl y) as (H1,_); destruct (H1 H0) as (x,(H2,H3)). exists x; auto. - apply in_or_app. destruct H as (x,(H0,H1)); destruct H0. + subst; auto. + right; destruct (IHl y) as (_,H2); apply H2. exists x; auto. Qed. (***********************************) (** ** Decidable equality on lists *) (***********************************) Hypothesis eq_dec : forall (x y : A), {x = y}+{x <> y}. Lemma list_eq_dec : forall l l':list A, {l = l'} + {l <> l'}. Proof. decide equality. Defined. Lemma count_occ_rev l x : count_occ eq_dec (rev l) x = count_occ eq_dec l x. Proof. induction l as [|a l IHl]; trivial. cbn; rewrite count_occ_app, IHl; cbn. destruct (eq_dec a x); rewrite Nat.add_comm; reflexivity. Qed. End ListOps. (***************************************************) (** * Applying functions to the elements of a list *) (***************************************************) (************) (** ** Map *) (************) Section Map. Variables (A : Type) (B : Type). Variable f : A -> B. Fixpoint map (l:list A) : list B := match l with | [] => [] | a :: t => (f a) :: (map t) end. Lemma map_cons (x:A)(l:list A) : map (x::l) = (f x) :: (map l). Proof. reflexivity. Qed. Lemma in_map : forall (l:list A) (x:A), In x l -> In (f x) (map l). Proof. intro l; induction l; firstorder (subst; auto). Qed. Lemma in_map_iff : forall l y, In y (map l) <-> exists x, f x = y /\ In x l. Proof. intro l; induction l; firstorder (subst; auto). Qed. Lemma length_map : forall l, length (map l) = length l. Proof. intro l; induction l; simpl; auto. Qed. Lemma map_nth : forall l d n, nth n (map l) (f d) = f (nth n l d). Proof. intro l; induction l; simpl map; intros d n; destruct n; firstorder. Qed. Lemma nth_error_map : forall n l, nth_error (map l) n = option_map f (nth_error l n). Proof. intro n. induction n as [|n IHn]; intro l. - now destruct l. - destruct l as [|? l]; [reflexivity|exact (IHn l)]. Qed. Lemma map_nth_error : forall n l d, nth_error l n = Some d -> nth_error (map l) n = Some (f d). Proof. intros n l d H. now rewrite nth_error_map, H. Qed. Lemma map_app : forall l l', map (l++l') = (map l)++(map l'). Proof. intro l; induction l as [|a l IHl]; simpl; auto. intros; rewrite IHl; auto. Qed. Lemma map_last : forall l a, map (l ++ [a]) = (map l) ++ [f a]. Proof. intro l; induction l as [|a l IHl]; intros; [ reflexivity | ]. simpl; rewrite IHl; reflexivity. Qed. Lemma map_rev : forall l, map (rev l) = rev (map l). Proof. intro l; induction l as [|a l IHl]; simpl; auto. rewrite map_app. rewrite IHl; auto. Qed. Lemma map_eq_nil : forall l, map l = [] -> l = []. Proof. intro l; destruct l; simpl; reflexivity || discriminate. Qed. Lemma map_eq_cons : forall l l' b, map l = b :: l' -> exists a tl, l = a :: tl /\ f a = b /\ map tl = l'. Proof. intros l l' b Heq. destruct l as [|a l]; inversion_clear Heq. exists a, l; repeat split. Qed. Lemma map_eq_app : forall l l1 l2, map l = l1 ++ l2 -> exists l1' l2', l = l1' ++ l2' /\ map l1' = l1 /\ map l2' = l2. Proof. intro l; induction l as [|a l IHl]; simpl; intros l1 l2 Heq. - symmetry in Heq; apply app_eq_nil in Heq; destruct Heq; subst. exists nil, nil; repeat split. - destruct l1; simpl in Heq; inversion Heq as [[Heq2 Htl]]. + exists nil, (a :: l); repeat split. + destruct (IHl _ _ Htl) as (l1' & l2' & ? & ? & ?); subst. exists (a :: l1'), l2'; repeat split. Qed. (** [map] and count of occurrences *) Hypothesis decA: forall x1 x2 : A, {x1 = x2} + {x1 <> x2}. Hypothesis decB: forall y1 y2 : B, {y1 = y2} + {y1 <> y2}. Hypothesis Hfinjective: forall x1 x2: A, (f x1) = (f x2) -> x1 = x2. Theorem count_occ_map x l: count_occ decA l x = count_occ decB (map l) (f x). Proof. revert x. induction l as [| a l' Hrec]; intro x; simpl. - reflexivity. - specialize (Hrec x). destruct (decA a x) as [H1|H1], (decB (f a) (f x)) as [H2|H2]. + rewrite Hrec. reflexivity. + contradiction H2. rewrite H1. reflexivity. + specialize (Hfinjective H2). contradiction H1. + assumption. Qed. End Map. (*****************) (** ** Flat Map *) (*****************) Section FlatMap. Variables (A : Type) (B : Type). Variable f : A -> list B. (** [flat_map] *) Definition flat_map := fix flat_map (l:list A) : list B := match l with | nil => nil | cons x t => (f x)++(flat_map t) end. Lemma flat_map_concat_map l : flat_map l = concat (map f l). Proof. induction l as [|x l IH]; simpl. - reflexivity. - rewrite IH; reflexivity. Qed. Lemma flat_map_app l1 l2 : flat_map (l1 ++ l2) = flat_map l1 ++ flat_map l2. Proof. now rewrite !flat_map_concat_map, map_app, concat_app. Qed. Lemma in_flat_map l y : In y (flat_map l) <-> exists x, In x l /\ In y (f x). Proof. rewrite flat_map_concat_map, in_concat. split. - intros [l' [[x [<- ?]] %in_map_iff ?]]. now exists x. - intros [x [? ?]]. exists (f x). now split; [apply in_map|]. Qed. End FlatMap. Lemma concat_map : forall A B (f : A -> B) l, map f (concat l) = concat (map (map f) l). Proof. intros A B f l; induction l as [|x l IH]; simpl. - reflexivity. - rewrite map_app, IH; reflexivity. Qed. Lemma remove_concat A (eq_dec : forall x y : A, {x = y}+{x <> y}) : forall l x, remove eq_dec x (concat l) = flat_map (remove eq_dec x) l. Proof. intros l x; induction l as [|? ? IHl]; [ reflexivity | simpl ]. rewrite remove_app, IHl; reflexivity. Qed. Lemma map_id : forall (A :Type) (l : list A), map (fun x => x) l = l. Proof. intros A l; induction l as [|? ? IHl]; simpl; auto; rewrite IHl; auto. Qed. Lemma map_map : forall (A B C:Type)(f:A->B)(g:B->C) l, map g (map f l) = map (fun x => g (f x)) l. Proof. intros A B C f g l; induction l as [|? ? IHl]; simpl; auto. rewrite IHl; auto. Qed. Lemma map_ext_in : forall (A B : Type)(f g:A->B) l, (forall a, In a l -> f a = g a) -> map f l = map g l. Proof. intros A B f g l; induction l as [|? ? IHl]; simpl; auto. intros H; rewrite H by intuition; rewrite IHl; auto. Qed. Lemma ext_in_map : forall (A B : Type)(f g:A->B) l, map f l = map g l -> forall a, In a l -> f a = g a. Proof. intros A B f g l; induction l; intros [=] ? []; subst; auto. Qed. Arguments ext_in_map [A B f g l]. Lemma map_ext_in_iff : forall (A B : Type)(f g:A->B) l, map f l = map g l <-> forall a, In a l -> f a = g a. Proof. split; [apply ext_in_map | apply map_ext_in]. Qed. Arguments map_ext_in_iff {A B f g l}. Lemma map_ext : forall (A B : Type)(f g:A->B), (forall a, f a = g a) -> forall l, map f l = map g l. Proof. intros; apply map_ext_in; auto. Qed. Lemma flat_map_ext : forall (A B : Type)(f g : A -> list B), (forall a, f a = g a) -> forall l, flat_map f l = flat_map g l. Proof. intros A B f g Hext l. rewrite 2 flat_map_concat_map. now rewrite (map_ext _ g). Qed. Lemma nth_nth_nth_map A : forall (l : list A) n d ln dn, n < length ln \/ length l <= dn -> nth (nth n ln dn) l d = nth n (map (fun x => nth x l d) ln) d. Proof. intros l n d ln dn Hlen. rewrite <- (map_nth (fun m => nth m l d)). destruct Hlen. - apply nth_indep. now rewrite length_map. - now rewrite (nth_overflow l). Qed. (************************************) (** Left-to-right iterator on lists *) (************************************) Section Fold_Left_Recursor. Variables (A : Type) (B : Type). Variable f : A -> B -> A. Fixpoint fold_left (l:list B) (a0:A) : A := match l with | nil => a0 | cons b t => fold_left t (f a0 b) end. Lemma fold_left_app : forall (l l':list B)(i:A), fold_left (l++l') i = fold_left l' (fold_left l i). Proof. now intro l; induction l; cbn. Qed. End Fold_Left_Recursor. Lemma fold_left_S_O : forall (A:Type)(l:list A), fold_left (fun x _ => S x) l 0 = length l. Proof. intros A l. induction l as [|? ? IH] using rev_ind; [reflexivity|]. now rewrite fold_left_app, length_app, IH, Nat.add_comm. Qed. (************************************) (** Right-to-left iterator on lists *) (************************************) Section Fold_Right_Recursor. Variables (A : Type) (B : Type). Variable f : B -> A -> A. Variable a0 : A. Fixpoint fold_right (l:list B) : A := match l with | nil => a0 | cons b t => f b (fold_right t) end. End Fold_Right_Recursor. Lemma fold_right_app : forall (A B:Type)(f:A->B->B) l l' i, fold_right f i (l++l') = fold_right f (fold_right f i l') l. Proof. intros A B f l; induction l. - simpl; auto. - simpl; intros. f_equal; auto. Qed. Lemma fold_left_rev_right : forall (A B:Type)(f:A->B->B) l i, fold_right f i (rev l) = fold_left (fun x y => f y x) l i. Proof. intros A B f l; induction l. - simpl; auto. - intros. simpl. rewrite fold_right_app; simpl; auto. Qed. Theorem fold_symmetric : forall (A : Type) (f : A -> A -> A), (forall x y z : A, f x (f y z) = f (f x y) z) -> forall (a0 : A), (forall y : A, f a0 y = f y a0) -> forall (l : list A), fold_left f l a0 = fold_right f a0 l. Proof. intros A f assoc a0 comma0 l. induction l as [ | a1 l IHl]; [ simpl; reflexivity | ]. simpl. rewrite <- IHl. clear IHl. revert a1. induction l as [|? ? IHl]; [ auto | ]. simpl. intro. rewrite <- assoc. rewrite IHl. rewrite IHl. auto. Qed. (** [(list_power x y)] is [y^x], or the set of sequences of elts of [y] indexed by elts of [x], sorted in lexicographic order. *) Fixpoint list_power (A B:Type)(l:list A) (l':list B) : list (list (A * B)) := match l with | nil => cons nil nil | cons x t => flat_map (fun f:list (A * B) => map (fun y:B => cons (x, y) f) l') (list_power t l') end. (*************************************) (** ** Boolean operations over lists *) (*************************************) Section Bool. Variable A : Type. Variable f : A -> bool. (** find whether a boolean function can be satisfied by an elements of the list. *) Fixpoint existsb (l:list A) : bool := match l with | nil => false | a::l => f a || existsb l end. Lemma existsb_exists : forall l, existsb l = true <-> exists x, In x l /\ f x = true. Proof. intro l; induction l as [ | a m IH ]; split; simpl. - easy. - intros [x [[]]]. - destruct (f a) eqn:Ha. + intros _. exists a. tauto. + intros [x [? ?]] %IH. exists x. tauto. - intros [ x [ [ Hax | Hxm ] Hfx ] ]. + now rewrite Hax, Hfx. + destruct IH as [ _ -> ]; eauto with bool. Qed. Lemma existsb_nth : forall l n d, n < length l -> existsb l = false -> f (nth n l d) = false. Proof. intro l; induction l as [|a ? IHl]; [easy|]. cbn. intros [|n]; [now destruct (f a)|]. intros d ? %Nat.succ_lt_mono. now destruct (f a); [|apply IHl]. Qed. Lemma existsb_app : forall l1 l2, existsb (l1++l2) = existsb l1 || existsb l2. Proof. intro l1; induction l1 as [|a ? ?]; intros l2; simpl. - auto. - case (f a); simpl; solve[auto]. Qed. (** find whether a boolean function is satisfied by all the elements of a list. *) Fixpoint forallb (l:list A) : bool := match l with | nil => true | a::l => f a && forallb l end. Lemma forallb_forall : forall l, forallb l = true <-> (forall x, In x l -> f x = true). Proof. intro l; induction l as [|a l IHl]; simpl; [ tauto | split; intro H ]. + destruct (andb_prop _ _ H); intros a' [?|?]. - congruence. - apply IHl; assumption. + apply andb_true_intro; split. - apply H; left; reflexivity. - apply IHl; intros; apply H; right; assumption. Qed. Lemma forallb_app : forall l1 l2, forallb (l1++l2) = forallb l1 && forallb l2. Proof. intro l1; induction l1 as [|a ? ?]; simpl. - auto. - case (f a); simpl; solve[auto]. Qed. (** [filter] *) Fixpoint filter (l:list A) : list A := match l with | nil => nil | x :: l => if f x then x::(filter l) else filter l end. Lemma filter_In : forall x l, In x (filter l) <-> In x l /\ f x = true. Proof. intros x l; induction l as [|a ? ?]; simpl. - tauto. - intros. case_eq (f a); intros; simpl; intuition congruence. Qed. Lemma filter_app (l l':list A) : filter (l ++ l') = filter l ++ filter l'. Proof. induction l as [|x l IH]; simpl; trivial. destruct (f x); simpl; now rewrite IH. Qed. Lemma concat_filter_map : forall (l : list (list A)), concat (map filter l) = filter (concat l). Proof. intro l; induction l as [| v l IHl]; [auto|]. simpl. rewrite IHl. rewrite filter_app. reflexivity. Qed. Lemma forallb_filter l: forallb (filter l) = true. Proof. induction l as [|x l IH]; [reflexivity|]. cbn. remember (f x) as y. destruct y. - apply andb_true_intro. auto. - exact IH. Qed. Lemma forallb_filter_id l: forallb l = true -> filter l = l. Proof. induction l as [|x l IH]; [easy|]. cbn. intro H. destruct (f x). - f_equal. apply IH, H. - discriminate H. Qed. (** [find] *) Fixpoint find (l:list A) : option A := match l with | nil => None | x :: tl => if f x then Some x else find tl end. Lemma find_some l x : find l = Some x -> In x l /\ f x = true. Proof. induction l as [|a l IH]; simpl; [easy| ]. case_eq (f a); intros Ha Eq. * injection Eq as [= ->]; auto. * destruct (IH Eq); auto. Qed. Lemma find_none l : find l = None -> forall x, In x l -> f x = false. Proof. induction l as [|a l IH]; simpl; [easy|]. case_eq (f a); intros Ha Eq x IN; [easy|]. destruct IN as [<-|IN]; auto. Qed. (** [partition] *) Fixpoint partition (l:list A) : list A * list A := match l with | nil => (nil, nil) | x :: tl => let (g,d) := partition tl in if f x then (x::g,d) else (g,x::d) end. Theorem partition_cons1 a l l1 l2: partition l = (l1, l2) -> f a = true -> partition (a::l) = (a::l1, l2). Proof. simpl. now intros -> ->. Qed. Theorem partition_cons2 a l l1 l2: partition l = (l1, l2) -> f a=false -> partition (a::l) = (l1, a::l2). Proof. simpl. now intros -> ->. Qed. Theorem partition_length l l1 l2: partition l = (l1, l2) -> length l = length l1 + length l2. Proof. revert l1 l2. induction l as [ | a l' Hrec]; intros l1 l2. - now intros [= <- <- ]. - simpl. destruct (f a), (partition l') as (left, right); intros [= <- <- ]; simpl; rewrite (Hrec left right); auto. Qed. Theorem partition_inv_nil (l : list A): partition l = ([], []) <-> l = []. Proof. split. - destruct l as [|a l']. * intuition. * simpl. destruct (f a), (partition l'); now intros [= -> ->]. - now intros ->. Qed. Theorem elements_in_partition l l1 l2: partition l = (l1, l2) -> forall x:A, In x l <-> In x l1 \/ In x l2. Proof. revert l1 l2. induction l as [| a l' Hrec]; simpl; intros l1 l2 Eq x. - injection Eq as [= <- <-]. tauto. - destruct (partition l') as (left, right). specialize (Hrec left right eq_refl x). destruct (f a); injection Eq as [= <- <-]; simpl; tauto. Qed. End Bool. (*******************************) (** ** Further filtering facts *) (*******************************) Section Filtering. Variables (A : Type). Lemma filter_ext_in : forall (f g : A -> bool) (l : list A), (forall a, In a l -> f a = g a) -> filter f l = filter g l. Proof. intros f g l. induction l as [| a l IHl]; [easy|cbn]. intros H. rewrite (H a) by (now left). destruct (g a); [f_equal|]; apply IHl; intros; apply H; now right. Qed. Lemma ext_in_filter : forall (f g : A -> bool) (l : list A), filter f l = filter g l -> (forall a, In a l -> f a = g a). Proof. intros f g l. induction l as [| a l IHl]; [easy|cbn]. intros H. assert (Ha : f a = g a). - pose proof (Hf := proj1 (filter_In f a l)). pose proof (Hg := proj1 (filter_In g a l)). destruct (f a), (g a); [reflexivity| | |reflexivity]. + symmetry. apply Hg. rewrite <- H. now left. + apply Hf. rewrite H. now left. - intros b [<-|Hbl]; [assumption|]. apply IHl; [|assumption]. destruct (f a), (g a); congruence. Qed. Lemma filter_ext_in_iff : forall (f g : A -> bool) (l : list A), filter f l = filter g l <-> (forall a, In a l -> f a = g a). Proof. split; [apply ext_in_filter | apply filter_ext_in]. Qed. Lemma filter_map : forall (f g : A -> bool) (l : list A), filter f l = filter g l <-> map f l = map g l. Proof. intros f g l. now rewrite filter_ext_in_iff, map_ext_in_iff. Qed. Lemma filter_ext : forall (f g : A -> bool), (forall a, f a = g a) -> forall l, filter f l = filter g l. Proof. intros f g H l. rewrite filter_map. apply map_ext. assumption. Qed. Lemma partition_as_filter f (l : list A) : partition f l = (filter f l, filter (fun x => negb (f x)) l). Proof. induction l as [|x l IH]. - reflexivity. - cbn. rewrite IH. destruct (f x); reflexivity. Qed. Corollary filter_length f (l : list A) : length (filter f l) + length (filter (fun x => negb (f x)) l) = length l. Proof. symmetry. apply (partition_length f), partition_as_filter. Qed. Corollary filter_length_le f (l : list A): length (filter f l) <= length l. Proof. rewrite <- (filter_length f l). apply Nat.le_add_r. Qed. Lemma filter_length_forallb f (l : list A): length (filter f l) = length l -> forallb f l = true. Proof. intro H. induction l as [|x l IH]; [reflexivity |]. cbn in *. destruct (f x). - apply IH. now injection H. - exfalso. assert (length l < length (filter f l)) as E. + symmetry in H. apply Nat.eq_le_incl in H. exact H. + eapply Nat.le_ngt; [apply filter_length_le | exact E]. Qed. (** Remove by filtering *) Hypothesis eq_dec : forall x y : A, {x = y}+{x <> y}. Definition remove' (x : A) : list A -> list A := filter (fun y => if eq_dec x y then false else true). Lemma remove_alt (x : A) (l : list A) : remove' x l = remove eq_dec x l. Proof. induction l; [reflexivity|]. simpl. now destruct eq_dec; [|f_equal]. Qed. (** Counting occurrences by filtering *) Definition count_occ' (l : list A) (x : A) : nat := length (filter (fun y => if eq_dec y x then true else false) l). Lemma count_occ_alt (l : list A) (x : A) : count_occ' l x = count_occ eq_dec l x. Proof. unfold count_occ'. induction l; [reflexivity|]. simpl. now destruct eq_dec; simpl; [f_equal|]. Qed. End Filtering. (******************************************************) (** ** Operations on lists of pairs or lists of lists *) (******************************************************) Section ListPairs. Variables (A : Type) (B : Type). (** [split] derives two lists from a list of pairs *) Fixpoint split (l:list (A*B)) : list A * list B := match l with | [] => ([], []) | (x,y) :: tl => let (left,right) := split tl in (x::left, y::right) end. Lemma in_split_l : forall (l:list (A*B))(p:A*B), In p l -> In (fst p) (fst (split l)). Proof. intro l. induction l as [|[? ?] l IHl]; [easy|]. intros [? ?]. cbn. now intros [[=]|? %IHl]; destruct (split l); [left|right]. Qed. Lemma in_split_r : forall (l:list (A*B))(p:A*B), In p l -> In (snd p) (snd (split l)). Proof. intro l. induction l as [|[? ?] l IHl]; [easy|]. intros [? ?]. cbn. now intros [[=]|? %IHl]; destruct (split l); [left|right]. Qed. Lemma split_nth : forall (l:list (A*B))(n:nat)(d:A*B), nth n l d = (nth n (fst (split l)) (fst d), nth n (snd (split l)) (snd d)). Proof. intro l; induction l as [|a l IHl]. - intros n d; destruct n; destruct d; simpl; auto. - intros n d; destruct n; destruct d; simpl; auto. + destruct a; destruct (split l); simpl; auto. + destruct a; destruct (split l); simpl in *; auto. Qed. Lemma length_fst_split : forall (l:list (A*B)), length (fst (split l)) = length l. Proof. intro l; induction l as [|a l IHl]; simpl; auto. destruct a; destruct (split l); simpl; auto. Qed. Lemma length_snd_split : forall (l:list (A*B)), length (snd (split l)) = length l. Proof. intro l; induction l as [|a l IHl]; simpl; auto. destruct a; destruct (split l); simpl; auto. Qed. (** [combine] is the opposite of [split]. Lists given to [combine] are meant to be of same length. If not, [combine] stops on the shorter list *) Fixpoint combine (l : list A) (l' : list B) : list (A*B) := match l,l' with | x::tl, y::tl' => (x,y)::(combine tl tl') | _, _ => nil end. Lemma split_combine : forall (l: list (A*B)), forall l1 l2, split l = (l1, l2) -> combine l1 l2 = l. Proof. intro l; induction l as [|a l IHl]. 1: simpl; auto. all: intuition; inversion H; auto. destruct (split l); simpl in *. inversion H1; subst; simpl. f_equal; auto. Qed. Lemma combine_split : forall (l:list A)(l':list B), length l = length l' -> split (combine l l') = (l,l'). Proof. intro l; induction l as [|a l IHl]; intro l'; destruct l'; simpl; trivial; try discriminate. now intros [= ->%IHl]. Qed. Lemma in_combine_l : forall (l:list A)(l':list B)(x:A)(y:B), In (x,y) (combine l l') -> In x l. Proof. intro l; induction l as [|a l IHl]. - simpl; auto. - intro l'; destruct l' as [|a0 l']; simpl; auto; intros x y H. + contradiction. + destruct H as [H|H]. * injection H; auto. * right; apply IHl with l' y; auto. Qed. Lemma in_combine_r : forall (l:list A)(l':list B)(x:A)(y:B), In (x,y) (combine l l') -> In y l'. Proof. intro l; induction l as [|? ? IHl]. - simpl; intros; contradiction. - intro l'; destruct l'; simpl; auto; intros x y H. destruct H as [H|H]. + injection H; auto. + right; apply IHl with x; auto. Qed. Lemma length_combine : forall (l:list A)(l':list B), length (combine l l') = min (length l) (length l'). Proof. intro l; induction l. - simpl; auto. - intro l'; destruct l'; simpl; auto. Qed. Lemma combine_nth : forall (l:list A)(l':list B)(n:nat)(x:A)(y:B), length l = length l' -> nth n (combine l l') (x,y) = (nth n l x, nth n l' y). Proof. intro l; induction l; intro l'; destruct l'; intros n x y; try discriminate. - destruct n; simpl; auto. - destruct n; simpl in *; auto. Qed. (** [list_prod] has the same signature as [combine], but unlike [combine], it adds every possible pairs, not only those at the same position. *) Fixpoint list_prod (l:list A) (l':list B) : list (A * B) := match l with | nil => nil | cons x t => (map (fun y:B => (x, y)) l')++(list_prod t l') end. Lemma in_prod_aux : forall (x:A) (y:B) (l:list B), In y l -> In (x, y) (map (fun y0:B => (x, y0)) l). Proof. intros x y l; induction l; [ simpl; auto | simpl; destruct 1 as [H1| ]; [ left; rewrite H1; trivial | right; auto ] ]. Qed. Lemma in_prod : forall (l:list A) (l':list B) (x:A) (y:B), In x l -> In y l' -> In (x, y) (list_prod l l'). Proof. intro l; induction l; [ simpl; tauto | simpl; intros l' x y H H0; apply in_or_app; destruct H as [H|H]; [ left; rewrite H; apply in_prod_aux; assumption | right; auto ] ]. Qed. Lemma in_prod_iff : forall (l:list A)(l':list B)(x:A)(y:B), In (x,y) (list_prod l l') <-> In x l /\ In y l'. Proof. intros l l' x y; split; [ | intros H; now apply in_prod ]. induction l as [|a l IHl]; cbn; [easy|]. intros [[? [[= -> ->] ?]] %in_map_iff|] %in_app_or; tauto. Qed. Lemma length_prod : forall (l:list A)(l':list B), length (list_prod l l') = (length l) * (length l'). Proof. intro l; induction l as [|? ? IHl]; simpl; [easy|]. intros. now rewrite length_app, length_map, IHl. Qed. End ListPairs. (*****************************************) (** * Miscellaneous operations on lists *) (*****************************************) (******************************) (** ** Length order of lists *) (******************************) Section length_order. Variable A : Type. Definition lel (l m:list A) := length l <= length m. Variables a b : A. Variables l m n : list A. Lemma lel_refl : lel l l. Proof. now apply Nat.le_refl. Qed. Lemma lel_trans : lel l m -> lel m n -> lel l n. Proof. unfold lel; intros. now_show (length l <= length n). now apply Nat.le_trans with (length m). Qed. Lemma lel_cons_cons : lel l m -> lel (a :: l) (b :: m). Proof. now intros ? %Nat.succ_le_mono. Qed. Lemma lel_cons : lel l m -> lel l (b :: m). Proof. intros. now apply Nat.le_le_succ_r. Qed. Lemma lel_tail : lel (a :: l) (b :: m) -> lel l m. Proof. intros. now apply Nat.succ_le_mono. Qed. Lemma lel_nil : forall l':list A, lel l' nil -> nil = l'. Proof. intro l'; elim l'; [now intros|]. now intros a' y H H0 %Nat.nle_succ_0. Qed. End length_order. #[global] Hint Resolve lel_refl lel_cons_cons lel_cons lel_nil lel_nil nil_cons: datatypes. (******************************) (** ** Set inclusion on list *) (******************************) Section SetIncl. Variable A : Type. Definition incl (l m:list A) := forall a:A, In a l -> In a m. #[local] Hint Unfold incl : core. Lemma incl_nil_l : forall l, incl nil l. Proof. intros l a Hin; inversion Hin. Qed. Lemma incl_l_nil : forall l, incl l nil -> l = nil. Proof. intro l; destruct l as [|a l]; intros Hincl. - reflexivity. - exfalso; apply Hincl with a; simpl; auto. Qed. Lemma incl_refl : forall l:list A, incl l l. Proof. auto. Qed. #[local] Hint Resolve incl_refl : core. Lemma incl_tl : forall (a:A) (l m:list A), incl l m -> incl l (a :: m). Proof. auto with datatypes. Qed. #[local] Hint Immediate incl_tl : core. Lemma incl_tran : forall l m n:list A, incl l m -> incl m n -> incl l n. Proof. auto. Qed. Lemma incl_appl : forall l m n:list A, incl l n -> incl l (n ++ m). Proof. auto with datatypes. Qed. #[local] Hint Immediate incl_appl : core. Lemma incl_appr : forall l m n:list A, incl l n -> incl l (m ++ n). Proof. auto with datatypes. Qed. #[local] Hint Immediate incl_appr : core. Lemma incl_cons : forall (a:A) (l m:list A), In a m -> incl l m -> incl (a :: l) m. Proof. now intros a l m ? H b [<-|]; [|apply H]. Qed. #[local] Hint Resolve incl_cons : core. Lemma incl_cons_inv : forall (a:A) (l m:list A), incl (a :: l) m -> In a m /\ incl l m. Proof. intros a l m Hi. split; [ | intros ? ? ]; apply Hi; simpl; auto. Qed. Lemma incl_app : forall l m n:list A, incl l n -> incl m n -> incl (l ++ m) n. Proof. unfold incl; simpl; intros l m n H H0 a H1. now_show (In a n). elim (in_app_or _ _ _ H1); auto. Qed. #[local] Hint Resolve incl_app : core. Lemma incl_app_app : forall l1 l2 m1 m2:list A, incl l1 m1 -> incl l2 m2 -> incl (l1 ++ l2) (m1 ++ m2). Proof. intros. apply incl_app; [ apply incl_appl | apply incl_appr]; assumption. Qed. Lemma incl_app_inv : forall l1 l2 m : list A, incl (l1 ++ l2) m -> incl l1 m /\ incl l2 m. Proof. intro l1; induction l1 as [|a l1 IHl1]; intros l2 m Hin; split; auto. - apply incl_nil_l. - intros b Hb; inversion_clear Hb; subst; apply Hin. + now constructor. + simpl; apply in_cons. apply incl_appl with l1; [ apply incl_refl | assumption ]. - apply IHl1. now apply incl_cons_inv in Hin. Qed. Lemma incl_filter f l : incl (filter f l) l. Proof. intros x Hin; now apply filter_In in Hin. Qed. Lemma remove_incl (eq_dec : forall x y : A, {x = y} + {x <> y}) : forall l1 l2 x, incl l1 l2 -> incl (remove eq_dec x l1) (remove eq_dec x l2). Proof. intros l1 l2 x Hincl y Hin. apply in_remove in Hin; destruct Hin as [Hin Hneq]. apply in_in_remove; intuition. Qed. End SetIncl. Lemma incl_map A B (f : A -> B) l1 l2 : incl l1 l2 -> incl (map f l1) (map f l2). Proof. intros Hincl x Hinx. destruct (proj1 (in_map_iff _ _ _) Hinx) as [y [<- Hiny]]. now apply in_map, Hincl. Qed. #[global] Hint Resolve incl_refl incl_tl incl_tran incl_appl incl_appr incl_cons incl_app incl_map: datatypes. (**************************************) (** * Cutting a list at some position *) (**************************************) Section Cutting. Variable A : Type. Fixpoint firstn (n:nat)(l:list A) : list A := match n with | 0 => nil | S n => match l with | nil => nil | a::l => a::(firstn n l) end end. Lemma firstn_nil n: firstn n [] = []. Proof. induction n; now simpl. Qed. Lemma firstn_cons n a l: firstn (S n) (a::l) = a :: (firstn n l). Proof. now simpl. Qed. Lemma nth_error_firstn n l i : nth_error (firstn n l) i = if Nat.ltb i n then nth_error l i else None. Proof. revert l i; induction n, l, i; cbn [firstn nth_error]; trivial. case Nat.ltb; trivial. Qed. Lemma nth_firstn (n : nat) (l : list A) (i : nat) (d : A) : nth i (firstn n l) d = if i firstn n l = l. Proof. induction n as [|k iHk]. - intro l. inversion 1 as [H1|?]. rewrite (length_zero_iff_nil l) in H1. subst. now simpl. - intro l; destruct l as [|x xs]; simpl. * now reflexivity. * simpl. intro H. f_equal. apply iHk. now apply Nat.succ_le_mono. Qed. Lemma firstn_O l: firstn 0 l = []. Proof. now simpl. Qed. Lemma firstn_le_length n: forall l:list A, length (firstn n l) <= n. Proof. induction n as [|k iHk]; simpl; [auto | intro l; destruct l as [|x xs]; simpl]. - now apply Nat.le_0_l. - now rewrite <- Nat.succ_le_mono. Qed. Lemma firstn_length_le: forall l:list A, forall n:nat, n <= length l -> length (firstn n l) = n. Proof. intro l; induction l as [|x xs Hrec]. - simpl. intros n H. apply Nat.le_0_r in H. now subst. - intro n; destruct n as [|n]. * now simpl. * simpl. intro H. f_equal. apply Hrec. now apply Nat.succ_le_mono. Qed. Lemma firstn_app n: forall l1 l2, firstn n (l1 ++ l2) = (firstn n l1) ++ (firstn (n - length l1) l2). Proof. induction n as [|k iHk]; intros l1 l2. - now simpl. - destruct l1 as [|x xs]. * reflexivity. * rewrite <- app_comm_cons. simpl. f_equal. apply iHk. Qed. Lemma firstn_app_2 n: forall l1 l2, firstn ((length l1) + n) (l1 ++ l2) = l1 ++ firstn n l2. Proof. induction n as [| k iHk];intros l1 l2. - unfold firstn at 2. rewrite Nat.add_0_r, app_nil_r. rewrite firstn_app. rewrite Nat.sub_diag. unfold firstn at 2. rewrite app_nil_r. apply firstn_all. - destruct l2 as [|x xs]. * simpl. rewrite app_nil_r. apply firstn_all2. now apply Nat.le_add_r. * rewrite firstn_app. assert (H0 : (length l1 + S k - length l1) = S k). 1:now rewrite Nat.add_comm, Nat.add_sub. rewrite H0, firstn_all2; [reflexivity | now apply Nat.le_add_r]. Qed. Lemma firstn_firstn: forall l:list A, forall i j : nat, firstn i (firstn j l) = firstn (min i j) l. Proof. intro l; induction l as [|x xs Hl]. - intros. simpl. now rewrite ?firstn_nil. - intros [|i]; [easy|]. intros [|j]; [easy|]. cbn. f_equal. apply Hl. Qed. Fixpoint skipn (n:nat)(l:list A) : list A := match n with | 0 => l | S n => match l with | nil => nil | a::l => skipn n l end end. Lemma nth_error_skipn n l i : nth_error (skipn n l) i = nth_error l (n + i). Proof. revert l; induction n, l; cbn [nth_error skipn]; rewrite ?nth_error_nil; trivial. Qed. Lemma nth_skipn n l i d : nth i (skipn n l) d = nth (n + i) l d. Proof. revert l; induction n, l; cbn [nth skipn]; rewrite ?nth_error_nil; destruct i; trivial. Qed. Lemma hd_error_skipn n l : hd_error (skipn n l) = nth_error l n. Proof. rewrite <-nth_error_O, nth_error_skipn, Nat.add_0_r; trivial. Qed. Lemma firstn_skipn_comm : forall m n l, firstn m (skipn n l) = skipn n (firstn (n + m) l). Proof. now intros m n; induction n; intros []; simpl; destruct m. Qed. Lemma skipn_firstn_comm : forall m n l, skipn m (firstn n l) = firstn (n - m) (skipn m l). Proof. now intro m; induction m; intros [] []; simpl; rewrite ?firstn_nil. Qed. Lemma skipn_O : forall l, skipn 0 l = l. Proof. reflexivity. Qed. Lemma skipn_nil : forall n, skipn n ([] : list A) = []. Proof. now intros []. Qed. Lemma skipn_cons n a l: skipn (S n) (a::l) = skipn n l. Proof. reflexivity. Qed. Lemma skipn_all : forall l, skipn (length l) l = nil. Proof. now intro l; induction l. Qed. Lemma skipn_all2 n: forall l, length l <= n -> skipn n l = []. Proof. intros l L%Nat.sub_0_le; rewrite <-(firstn_all l) at 1. now rewrite skipn_firstn_comm, L. Qed. Lemma skipn_all_iff n l : length l <= n <-> skipn n l = nil. Proof. split; [apply skipn_all2|]. revert l; induction n as [|n IH]; intros l. - destruct l; simpl; [reflexivity|discriminate]. - destruct l; simpl. + intros _. apply Nat.le_0_l. + intros H%IH. apply le_n_S. exact H. Qed. Lemma skipn_skipn : forall x y l, skipn x (skipn y l) = skipn (x + y) l. Proof. intros x y. rewrite Nat.add_comm. induction y as [|y IHy]. - reflexivity. - intros [|]. + now rewrite skipn_nil. + now rewrite skipn_cons, IHy. Qed. Lemma firstn_skipn : forall n l, firstn n l ++ skipn n l = l. Proof. intro n; induction n. - simpl; auto. - intro l; destruct l; simpl; auto. f_equal; auto. Qed. Lemma firstn_skipn_middle n l x : nth_error l n = Some x -> firstn n l ++ x :: skipn (S n) l = l. Proof. revert l x; induction n as [|n IH]; intros [|y l] x. - discriminate. - injection 1. intros ->. reflexivity. - discriminate. - simpl. intros H. f_equal. apply IH. exact H. Qed. Lemma length_firstn : forall n l, length (firstn n l) = min n (length l). Proof. intro n; induction n; intro l; destruct l; simpl; auto. Qed. Lemma length_skipn n : forall l, length (skipn n l) = length l - n. Proof. induction n. - intros l; simpl; rewrite Nat.sub_0_r; reflexivity. - intro l; destruct l; simpl; auto. Qed. Lemma skipn_app n : forall l1 l2, skipn n (l1 ++ l2) = (skipn n l1) ++ (skipn (n - length l1) l2). Proof. induction n; auto; intros [|]; simpl; auto. Qed. Lemma firstn_skipn_rev: forall x l, firstn x l = rev (skipn (length l - x) (rev l)). Proof. intros x l; rewrite <-(firstn_skipn x l) at 3. rewrite rev_app_distr, skipn_app, rev_app_distr, length_rev, length_skipn, Nat.sub_diag; simpl; rewrite rev_involutive. rewrite <-app_nil_r at 1; f_equal; symmetry; apply length_zero_iff_nil. repeat rewrite length_rev, length_skipn; apply Nat.sub_diag. Qed. Lemma firstn_rev: forall x l, firstn x (rev l) = rev (skipn (length l - x) l). Proof. now intros x l; rewrite firstn_skipn_rev, rev_involutive, length_rev. Qed. Lemma skipn_rev: forall x l, skipn x (rev l) = rev (firstn (length l - x) l). Proof. intros x l; rewrite firstn_skipn_rev, rev_involutive, <-length_rev. destruct (Nat.le_ge_cases (length (rev l)) x) as [L | L]. - rewrite skipn_all2; [apply Nat.sub_0_le in L | trivial]. now rewrite L, Nat.sub_0_r, skipn_all. - f_equal. now apply Nat.eq_sym, Nat.add_sub_eq_l, Nat.sub_add. Qed. Lemma removelast_firstn : forall n l, n < length l -> removelast (firstn (S n) l) = firstn n l. Proof. intro n; induction n as [|n IHn]; intros [|? l]; [easy ..|]. cbn [length firstn]. destruct l. - now intros ? %Nat.succ_lt_mono. - now intros <- %Nat.succ_lt_mono %IHn. Qed. Lemma removelast_firstn_len : forall l, removelast l = firstn (pred (length l)) l. Proof. intro l; induction l as [|a l IHl]; [ reflexivity | simpl ]. destruct l; [ | rewrite IHl ]; reflexivity. Qed. Lemma firstn_removelast : forall n l, n < length l -> firstn n (removelast l) = firstn n l. Proof. intro n; induction n as [|n IHn]; intros [|? l]; [easy ..|]. cbn [length firstn]. destruct l. - now intros ? %Nat.succ_lt_mono. - now intros <- %Nat.succ_lt_mono %IHn. Qed. End Cutting. Section CuttingMap. Variables A B : Type. Variable f : A -> B. Lemma firstn_map : forall n l, firstn n (map f l) = map f (firstn n l). Proof. intro n; induction n; intros []; simpl; f_equal; trivial. Qed. Lemma skipn_map : forall n l, skipn n (map f l) = map f (skipn n l). Proof. intro n; induction n; intros []; simpl; trivial. Qed. End CuttingMap. (**************************************************************) (** ** Combining pairs of lists of possibly-different lengths *) (**************************************************************) Section Combining. Variables (A B : Type). Lemma combine_nil : forall (l : list A), combine l (@nil B) = @nil (A*B). Proof. intros l. apply length_zero_iff_nil. rewrite length_combine. simpl. rewrite Nat.min_0_r. reflexivity. Qed. Lemma combine_firstn_l : forall (l : list A) (l' : list B), combine l l' = combine l (firstn (length l) l'). Proof. intro l; induction l as [| x l IHl]; intros l'; [reflexivity|]. destruct l' as [| x' l']; [reflexivity|]. simpl. specialize IHl with l'. rewrite <- IHl. reflexivity. Qed. Lemma combine_firstn_r : forall (l : list A) (l' : list B), combine l l' = combine (firstn (length l') l) l'. Proof. intros l l'. generalize dependent l. induction l' as [| x' l' IHl']; intros l. - simpl. apply combine_nil. - destruct l as [| x l]; [reflexivity|]. simpl. specialize IHl' with l. rewrite <- IHl'. reflexivity. Qed. Lemma combine_firstn : forall (l : list A) (l' : list B) (n : nat), firstn n (combine l l') = combine (firstn n l) (firstn n l'). Proof. intro l; induction l as [| x l IHl]; intros l' n. - simpl. repeat (rewrite firstn_nil). reflexivity. - destruct l' as [| x' l']. + simpl. repeat (rewrite firstn_nil). rewrite combine_nil. reflexivity. + simpl. destruct n as [| n]; [reflexivity|]. repeat (rewrite firstn_cons). simpl. rewrite IHl. reflexivity. Qed. End Combining. (**********************************************************************) (** ** Predicate for List addition/removal (no need for decidability) *) (**********************************************************************) Section Add. Variable A : Type. (* [Add a l l'] means that [l'] is exactly [l], with [a] added once somewhere *) Inductive Add (a:A) : list A -> list A -> Prop := | Add_head l : Add a l (a::l) | Add_cons x l l' : Add a l l' -> Add a (x::l) (x::l'). Lemma Add_app a l1 l2 : Add a (l1++l2) (l1++a::l2). Proof. induction l1; simpl; now constructor. Qed. Lemma Add_split a l l' : Add a l l' -> exists l1 l2, l = l1++l2 /\ l' = l1++a::l2. Proof. induction 1 as [l|x ? ? ? IHAdd]. - exists nil; exists l; split; trivial. - destruct IHAdd as (l1 & l2 & Hl & Hl'). exists (x::l1); exists l2; split; simpl; f_equal; trivial. Qed. Lemma Add_in a l l' : Add a l l' -> forall x, In x l' <-> In x (a::l). Proof. induction 1 as [|? ? ? ? IHAdd]; intros; simpl in *; rewrite ?IHAdd; tauto. Qed. Lemma Add_length a l l' : Add a l l' -> length l' = S (length l). Proof. induction 1; simpl; now auto. Qed. Lemma Add_inv a l : In a l -> exists l', Add a l' l. Proof. intro Ha. destruct (in_split _ _ Ha) as (l1 & l2 & ->). exists (l1 ++ l2). apply Add_app. Qed. Lemma incl_Add_inv a l u v : ~In a l -> incl (a::l) v -> Add a u v -> incl l u. Proof. intros Ha H AD y Hy. assert (Hy' : In y (a::u)). { rewrite <- (Add_in AD). apply H; simpl; auto. } destruct Hy'; [ subst; now elim Ha | trivial ]. Qed. End Add. (********************************) (** ** Lists without redundancy *) (********************************) Section ReDun. Variable A : Type. Inductive NoDup : list A -> Prop := | NoDup_nil : NoDup nil | NoDup_cons : forall x l, ~ In x l -> NoDup l -> NoDup (x::l). Lemma NoDup_Add a l l' : Add a l l' -> (NoDup l' <-> NoDup l /\ ~In a l). Proof. induction 1 as [l|x l l' AD IH]. - split; [ inversion_clear 1; now split | now constructor ]. - split. + inversion_clear 1. rewrite IH in *. rewrite (Add_in AD) in *. simpl in *; split; try constructor; intuition. + intros (N,IN). inversion_clear N. constructor. * rewrite (Add_in AD); simpl in *; intuition. * apply IH. split; trivial. simpl in *; intuition. Qed. Lemma NoDup_remove l l' a : NoDup (l++a::l') -> NoDup (l++l') /\ ~In a (l++l'). Proof. apply NoDup_Add. apply Add_app. Qed. Lemma NoDup_remove_1 l l' a : NoDup (l++a::l') -> NoDup (l++l'). Proof. intros. now apply NoDup_remove with a. Qed. Lemma NoDup_remove_2 l l' a : NoDup (l++a::l') -> ~In a (l++l'). Proof. intros. now apply NoDup_remove. Qed. Theorem NoDup_cons_iff a l: NoDup (a::l) <-> ~ In a l /\ NoDup l. Proof. split. + inversion_clear 1. now split. + now constructor. Qed. Lemma NoDup_app (l1 l2 : list A): NoDup l1 -> NoDup l2 -> (forall a, In a l1 -> ~ In a l2) -> NoDup (l1 ++ l2). Proof. intros H1 H2 H. induction l1 as [|a l1 IHl1]; [assumption|]. apply NoDup_cons_iff in H1 as []. cbn. constructor. - intros H3%in_app_or. destruct H3. + contradiction. + apply (H a); [apply in_eq|assumption]. - apply IHl1; [assumption|]. intros. apply H, in_cons. assumption. Qed. Lemma NoDup_app_remove_l l l' : NoDup (l++l') -> NoDup l'. Proof. induction l as [|a l IHl]; intro H. - exact H. - apply IHl, (NoDup_remove_1 nil _ _ H). Qed. Lemma NoDup_app_remove_r l l' : NoDup (l++l') -> NoDup l. Proof. induction l' as [|a l' IHl']; intro H. - now rewrite app_nil_r in H. - apply IHl', (NoDup_remove_1 _ _ _ H). Qed. Lemma NoDup_rev l : NoDup l -> NoDup (rev l). Proof. induction l as [|a l IHl]; simpl; intros Hnd; [ constructor | ]. inversion_clear Hnd as [ | ? ? Hnin Hndl ]. assert (Add a (rev l) (rev l ++ a :: nil)) as Hadd by (rewrite <- (app_nil_r (rev l)) at 1; apply Add_app). apply NoDup_Add in Hadd; apply Hadd; intuition. now apply Hnin, in_rev. Qed. Lemma NoDup_filter f l : NoDup l -> NoDup (filter f l). Proof. induction l as [|a l IHl]; simpl; intros Hnd; auto. apply NoDup_cons_iff in Hnd. destruct (f a); [ | intuition ]. apply NoDup_cons_iff; split; [intro H|]; intuition. apply filter_In in H; intuition. Qed. (** Effective computation of a list without duplicates *) Hypothesis decA: forall x y : A, {x = y} + {x <> y}. Fixpoint nodup (l : list A) : list A := match l with | [] => [] | x::xs => if in_dec decA x xs then nodup xs else x::(nodup xs) end. Lemma nodup_fixed_point (l : list A) : NoDup l -> nodup l = l. Proof. induction l as [| x l IHl]; [auto|]. intros H. simpl. destruct (in_dec decA x l) as [Hx | Hx]; rewrite NoDup_cons_iff in H. - destruct H as [H' _]. contradiction. - destruct H as [_ H']. apply IHl in H'. rewrite -> H'. reflexivity. Qed. Lemma nodup_In l x : In x (nodup l) <-> In x l. Proof. induction l as [|a l' Hrec]; simpl. - reflexivity. - destruct (in_dec decA a l'); simpl; rewrite Hrec. * now intuition subst. * reflexivity. Qed. Lemma nodup_incl l1 l2 : incl l1 (nodup l2) <-> incl l1 l2. Proof. split; intros Hincl a Ha; apply nodup_In; intuition. Qed. Lemma NoDup_nodup l: NoDup (nodup l). Proof. induction l as [|a l' Hrec]; simpl. - constructor. - destruct (in_dec decA a l'); simpl. * assumption. * constructor; [ now rewrite nodup_In | assumption]. Qed. Lemma nodup_inv k l a : nodup k = a :: l -> ~ In a l. Proof. intros H. assert (H' : NoDup (a::l)). { rewrite <- H. apply NoDup_nodup. } now inversion_clear H'. Qed. Theorem NoDup_count_occ l: NoDup l <-> (forall x:A, count_occ decA l x <= 1). Proof. induction l as [| a l' Hrec]. - simpl; split; auto. constructor. - rewrite NoDup_cons_iff, Hrec, (count_occ_not_In decA). clear Hrec. split. + intros (Ha, H) x. simpl. destruct (decA a x); auto. subst; now rewrite Ha. + intro H; split. * specialize (H a). rewrite count_occ_cons_eq in H; trivial. now inversion H. * intros x. specialize (H x). simpl in *. destruct (decA a x); auto. now apply Nat.lt_le_incl. Qed. Theorem NoDup_count_occ' l: NoDup l <-> (forall x:A, In x l -> count_occ decA l x = 1). Proof. rewrite NoDup_count_occ. setoid_rewrite (count_occ_In decA). unfold gt, lt in *. split; intros H x; specialize (H x); set (n := count_occ decA l x) in *; clearbody n. (* the rest would be solved by omega if we had it here... *) - now apply Nat.le_antisymm. - destruct (Nat.le_gt_cases 1 n); trivial. + rewrite H; trivial. + now apply Nat.lt_le_incl. Qed. (** Alternative characterisations of being without duplicates, thanks to [nth_error] and [nth] *) Lemma NoDup_nth_error l : NoDup l <-> (forall i j, i nth_error l i = nth_error l j -> i = j). Proof. split. { intros H; induction H as [|a l Hal Hl IH]; intros i j Hi E. - inversion Hi. - destruct i, j; simpl in *; auto. * elim Hal. eapply nth_error_In; eauto. * elim Hal. eapply nth_error_In; eauto. * f_equal. now apply IH;[apply Nat.succ_lt_mono|]. } { induction l as [|a l IHl]; intros H; constructor. * intro Ha. apply In_nth_error in Ha. destruct Ha as (n,Hn). assert (n < length l) by (now rewrite <- nth_error_Some, Hn). specialize (H 0 (S n)). simpl in H. now discriminate H; [apply Nat.lt_0_succ|]. * apply IHl. intros i j Hi %Nat.succ_lt_mono E. now apply eq_add_S, H. } Qed. Lemma NoDup_nth l d : NoDup l <-> (forall i j, i j nth i l d = nth j l d -> i = j). Proof. rewrite NoDup_nth_error. split. - intros H i j ? ? E. apply H; [assumption|]. now rewrite !(nth_error_nth' l d), E. - intros H i j ? E. assert (j < length l). { apply nth_error_Some. rewrite <- E. now apply nth_error_Some. } apply H; [assumption ..|]. rewrite !(nth_error_nth' l d) in E; congruence. Qed. (** Having [NoDup] hypotheses bring more precise facts about [incl]. *) Lemma NoDup_incl_length l l' : NoDup l -> incl l l' -> length l <= length l'. Proof. intros N. revert l'. induction N as [|a l Hal N IH]; simpl. - intros. now apply Nat.le_0_l. - intros l' H. destruct (Add_inv a l') as (l'', AD). { apply H; simpl; auto. } rewrite (Add_length AD). apply le_n_S. apply IH. now apply incl_Add_inv with a l'. Qed. Lemma NoDup_length_incl l l' : NoDup l -> length l' <= length l -> incl l l' -> incl l' l. Proof. intros N. revert l'. induction N as [|a l Hal N IH]. - intro l'; destruct l'; easy. - intros l' E H x Hx. destruct (Add_inv a l') as (l'', AD). { apply H; simpl; auto. } rewrite (Add_in AD) in Hx. simpl in Hx. destruct Hx as [Hx|Hx]; [left; trivial|right]. revert x Hx. apply (IH l''); trivial. * apply Nat.succ_le_mono. now rewrite <- (Add_length AD). * now apply incl_Add_inv with a l'. Qed. Lemma NoDup_incl_NoDup (l l' : list A) : NoDup l -> length l' <= length l -> incl l l' -> NoDup l'. Proof. revert l'; induction l as [|a l IHl]; simpl; intros l' Hnd Hlen Hincl. - now destruct l'; inversion Hlen. - assert (In a l') as Ha by now apply Hincl; left. apply in_split in Ha as [l1' [l2' ->]]. inversion_clear Hnd as [|? ? Hnin Hnd']. apply (NoDup_Add (Add_app a l1' l2')); split. + apply IHl; auto. * rewrite length_app. rewrite length_app in Hlen; simpl in Hlen; rewrite Nat.add_succ_r in Hlen. now apply Nat.succ_le_mono. * apply (incl_Add_inv (u:= l1' ++ l2')) in Hincl; auto. apply Add_app. + intros Hnin'. assert (incl (a :: l) (l1' ++ l2')) as Hincl''. { apply incl_tran with (l1' ++ a :: l2'); auto. intros x Hin. apply in_app_or in Hin as [Hin|[->|Hin]]; intuition. } apply NoDup_incl_length in Hincl''; [ | now constructor ]. apply (Nat.nle_succ_diag_l (length l1' + length l2')). rewrite_all length_app. simpl in Hlen; rewrite Nat.add_succ_r in Hlen. now transitivity (S (length l)). Qed. End ReDun. (** NoDup and map *) (** NB: the reciprocal result holds only for injective functions, see FinFun.v *) Lemma NoDup_map_inv A B (f:A->B) l : NoDup (map f l) -> NoDup l. Proof. induction l; simpl; inversion_clear 1; subst; constructor; auto. intro H. now apply (in_map f) in H. Qed. (***********************************) (** ** Sequence of natural numbers *) (***********************************) Section NatSeq. (** [seq] computes the sequence of [len] contiguous integers that starts at [start]. For instance, [seq 2 3] is [2::3::4::nil]. *) Fixpoint seq (start len:nat) : list nat := match len with | 0 => nil | S len => start :: seq (S start) len end. Lemma cons_seq : forall len start, start :: seq (S start) len = seq start (S len). Proof. reflexivity. Qed. Lemma length_seq : forall len start, length (seq start len) = len. Proof. intro len; induction len; simpl; auto. Qed. Lemma seq_nth : forall len start n d, n < len -> nth n (seq start len) d = start+n. Proof. intro len; induction len as [|len IHlen]; intros start n d H. - inversion H. - simpl seq. destruct n; simpl. + now rewrite Nat.add_0_r. + now rewrite IHlen; [rewrite Nat.add_succ_r|apply Nat.succ_lt_mono]. Qed. Lemma seq_shift : forall len start, map S (seq start len) = seq (S start) len. Proof. intro len; induction len as [|len IHlen]; simpl; auto. intros. now rewrite IHlen. Qed. Lemma in_seq len start n : In n (seq start len) <-> start <= n < start+len. Proof. revert start. induction len as [|len IHlen]; simpl; intros start. - rewrite Nat.add_0_r. split;[easy|]. intros (H,H'). apply (Nat.lt_irrefl start). eapply Nat.le_lt_trans; eassumption. - rewrite IHlen, Nat.add_succ_r; simpl; split. + intros [H|H]; subst; intuition. * apply -> Nat.succ_le_mono. apply Nat.le_add_r. * now apply Nat.lt_le_incl. + intros (H,H'). inversion H. * now left. * right. subst. now split; [apply -> Nat.succ_le_mono|]. Qed. Lemma seq_NoDup len start : NoDup (seq start len). Proof. revert start; induction len as [|len IH]; intros start; simpl; constructor; trivial. rewrite in_seq. intros (H,_). now apply (Nat.lt_irrefl start). Qed. Lemma seq_app : forall len1 len2 start, seq start (len1 + len2) = seq start len1 ++ seq (start + len1) len2. Proof. intro len1; induction len1 as [|len1' IHlen]; intros; simpl in *. - now rewrite Nat.add_0_r. - now rewrite Nat.add_succ_r, IHlen. Qed. Lemma seq_S : forall len start, seq start (S len) = seq start len ++ [start + len]. Proof. intros len start. change [start + len] with (seq (start + len) 1). rewrite <- seq_app. rewrite Nat.add_succ_r, Nat.add_0_r; reflexivity. Qed. Lemma nth_error_seq start len n : nth_error (seq start len) n = if Nat.ltb n len then Some (start + n) else None. Proof. revert len; revert start; induction n, len; cbn [nth_error seq]; rewrite ?Nat.add_0_r; trivial. rewrite <-seq_shift, nth_error_map, IHn. cbn [Nat.ltb Nat.leb]; case len, Nat.leb; trivial. cbn [option_map]; rewrite ?plus_n_Sm; trivial. Qed. End NatSeq. (***********************) (** ** List comparison *) (***********************) Section Compare. Variable A : Type. Variable cmp : A -> A -> comparison. Fixpoint list_compare (xs ys : list A) : comparison := match xs, ys with | nil , nil => Eq | nil , _ => Lt | _ , nil => Gt | x :: xs, y :: ys => match cmp x y with | Eq => list_compare xs ys | c => c end end%list. Section Lemmas. Variable Hcmp : forall x y, cmp x y = Eq <-> x = y. Lemma list_compare_cons (x : A) (xs ys : list A) : list_compare (x :: xs) (x :: ys) = list_compare xs ys. Proof. simpl. rewrite (proj2 (Hcmp x x) eq_refl). reflexivity. Qed. Lemma list_compare_app (xs ys zs : list A) : list_compare (xs ++ ys) (xs ++ zs) = list_compare ys zs. Proof. induction xs as [|x xs IH]; [reflexivity|]. rewrite <-!app_comm_cons, list_compare_cons. exact IH. Qed. Lemma prefix_eq {prefix1 prefix2 xs1 xs2 ys1 ys2 : list A} {x1 x2 y1 y2 : A} : prefix1 ++ x1 :: xs1 = prefix2 ++ x2 :: xs2 -> prefix1 ++ y1 :: ys1 = prefix2 ++ y2 :: ys2 -> x1 <> y1 -> x2 <> y2 -> prefix1 = prefix2. Proof. clear Hcmp cmp. intros Heq1 Heq2 Hne1 Hne2. revert prefix2 xs1 xs2 ys1 ys2 Heq1 Heq2. induction prefix1 as [|z prefix1 IH]; intros prefix2 xs1 xs2 ys1 ys2. - destruct prefix2; [reflexivity|]. simpl. intros H1 H2. injection H1; clear H1; intros ??; subst. injection H2; clear H2; intros ??; subst. exfalso. apply Hne1. reflexivity. - destruct prefix2. + simpl. intros H1 H2. injection H1; clear H1; intros ??; subst. injection H2; clear H2; intros ??; subst. exfalso. apply Hne2. reflexivity. + simpl. intros H1 H2. injection H1; clear H1; intros ??; subst. injection H2; clear H2; intros ?; subst. intros. f_equal. eapply IH; eassumption. Qed. #[local] Ltac list_auto := repeat lazymatch goal with | |- ?x = ?x => reflexivity | H : ?xs = ?xs ++ _ |- _ => rewrite <-(app_nil_r xs) in H at 1 | H : ?xs ++ _ = ?xs |- _ => symmetry in H | H : ?xs ++ _ = ?xs ++ _ |- _ => apply app_inv_head in H | H : _ :: _ = _ :: _ |- _ => injection H; intros; clear H; subst | H : [] = _ :: _ |- _ => inversion H | H : cmp ?x ?x = Lt |- _ => rewrite (proj2 (Hcmp _ _) eq_refl) in H; discriminate | H : cmp ?x ?x = Gt |- _ => rewrite (proj2 (Hcmp _ _) eq_refl) in H; discriminate | H1 : ?p1 ++ _ :: _ = ?p2 ++ _ :: _, H2 : ?p2 ++ _ :: _ = ?p1 ++ _ :: _ |- _ => symmetry in H2 | H1 : ?p1 ++ ?x1 :: ?xs1 = ?p2 ++ ?x2 :: ?xs2, H2 : ?p1 ++ ?y1 :: ?ys1 = ?p2 ++ ?y2 :: ?ys2 |- _ => assert (p1 = p2) as Hp; [ eapply (prefix_eq H1 H2); intros Heq; subst | subst; apply app_inv_head in H1, H2 ] | H : cmp ?x ?x = _ |- _ => rewrite (proj2 (Hcmp _ _) eq_refl) in H; try discriminate H | H1 : cmp ?x1 ?x2 = _, H2 : cmp ?x1 ?x2 = _ |- _ => rewrite H1 in H2; discriminate H2 | Htrans : forall (x y z : A) (c : comparison), cmp x y = c -> cmp y z = c -> cmp x z = c, H1 : cmp ?x1 ?x2 = ?c, H2 : cmp ?x2 ?x3 = ?c |- _ => pose proof (Htrans x1 x2 x3 c H1 H2); clear H1 H2 | Hcmp_opp : (forall x y, cmp y x = CompOpp (cmp x y)), H1 : cmp ?x1 ?x2 = ?c, H2 : cmp ?x2 ?x1 = ?c |- _ => rewrite Hcmp_opp, H2 in H1; simpl in H1; discriminate H1 end. Inductive ListCompareSpec (xs ys : list A) : forall (c : comparison), Prop := | ListCompareEq : xs = ys -> ListCompareSpec xs ys Eq | ListCompareShorter y ys' : ys = xs ++ y :: ys' -> ListCompareSpec xs ys Lt | ListCompareLonger x xs' : xs = ys ++ x :: xs' -> ListCompareSpec xs ys Gt | ListCompareLt prefix x xs' y ys' : xs = prefix ++ x :: xs' -> ys = prefix ++ y :: ys' -> cmp x y = Lt -> ListCompareSpec xs ys Lt | ListCompareGt prefix x xs' y ys' : xs = prefix ++ x :: xs' -> ys = prefix ++ y :: ys' -> cmp x y = Gt -> ListCompareSpec xs ys Gt. Lemma list_compareP (xs ys : list A) : ListCompareSpec xs ys (list_compare xs ys). Proof. assert (xs = nil ++ xs) as Hxs by reflexivity. assert (ys = nil ++ ys) as Hys by reflexivity. revert Hxs Hys. generalize (@nil A) as prefix. generalize ys at 2 4. generalize xs at 2 4. intros xs'; induction xs' as [|x xs' IH]; intros ys' prefix -> ->. - destruct ys' as [|y ys']; rewrite app_nil_r; simpl. + apply ListCompareEq. reflexivity. + eapply ListCompareShorter; reflexivity. - destruct ys' as [|y ys']; rewrite ?app_nil_r; simpl. + eapply ListCompareLonger; reflexivity. + destruct (cmp x y) eqn:Hxy. * apply Hcmp in Hxy; subst y. apply (IH ys' (prefix ++ [x])); rewrite <-app_assoc; reflexivity. * eapply ListCompareLt; [reflexivity|reflexivity|exact Hxy]. * eapply ListCompareGt; [reflexivity|reflexivity|exact Hxy]. Qed. Lemma list_compare_refl (xs ys : list A) : list_compare xs ys = Eq <-> xs = ys. Proof. destruct (list_compareP xs ys); subst; split; intros. all: first [discriminate | list_auto]. Qed. Lemma list_compare_antisym (xs ys : list A) : (forall x y, cmp y x = CompOpp (cmp x y)) -> list_compare ys xs = CompOpp (list_compare xs ys). Proof. intros Hcmp_opp. destruct (list_compareP xs ys), (list_compareP ys xs); subst. all: repeat rewrite <-app_assoc in *; simpl in *; list_auto. Qed. Lemma list_compare_trans (xs ys zs : list A) (c : comparison) : (forall x y z c, cmp x y = c -> cmp y z = c -> cmp x z = c) -> (forall x y, cmp y x = CompOpp (cmp x y)) -> list_compare xs ys = c -> list_compare ys zs = c -> list_compare xs zs = c. Proof. intros Hcmp_trans Hcmp_opp. destruct (list_compareP xs ys) as [?|???|???|p1 x1 xs1 y1 ys1 Hxy1 Hxy2 Hlt1|p1 x1 xs1 y1 ys1 Hxy1 Hxy2 Hgt1], (list_compareP ys zs) as [?|???|???|p2 y2 ys2 z2 zs2 Hyz1 Hyz2 Hlt2|p2 y2 ys2 z2 zs2 Hyz1 Hyz2 Hgt2], (list_compareP xs zs) as [?|???|???|p3 x3 xs3 z3 zs3 Hxz1 Hxz2 Hlt3|p3 x3 xs3 z3 zs3 Hxz1 Hxz2 Hgt3]. all: intros <-; try discriminate; intros _; try reflexivity; exfalso. all: try (subst; rewrite <-?app_assoc in *; simpl in *; list_auto; fail). all: rewrite Hxy1 in Hxz1; rewrite Hxy2 in Hyz1; rewrite Hyz2 in Hxz2; clear Hxy1 Hxy2 Hyz2. all: revert p2 p3 xs1 ys1 ys2 zs2 xs3 zs3 Hyz1 Hxz1 Hxz2. all: induction p1 as [|h1 p1 IH]; intros; destruct p2 as [|h2 p2]; destruct p3 as [|h3 p3]. all: simpl in *; list_auto. all: eapply IH; eassumption. Qed. Lemma list_compare_spec_complete (xs ys : list A) (c : comparison) : ListCompareSpec xs ys c -> list_compare xs ys = c. Proof. intros [->|??->|??->|?????->->Heq|?????->->Heq]. - apply list_compare_refl. reflexivity. - rewrite <-(app_nil_r xs) at 1. apply list_compare_app. - rewrite <-(app_nil_r ys) at 2. apply list_compare_app. - rewrite list_compare_app. simpl. rewrite Heq. reflexivity. - rewrite list_compare_app. simpl. rewrite Heq. reflexivity. Qed. End Lemmas. End Compare. Section Exists_Forall. (** * Existential and universal predicates over lists *) Variable A:Type. Section One_predicate. Variable P:A->Prop. Inductive Exists : list A -> Prop := | Exists_cons_hd : forall x l, P x -> Exists (x::l) | Exists_cons_tl : forall x l, Exists l -> Exists (x::l). #[local] Hint Constructors Exists : core. Lemma Exists_exists (l:list A) : Exists l <-> (exists x, In x l /\ P x). Proof. split. - induction 1; firstorder. - induction l; firstorder (subst; auto). Qed. Lemma Exists_nth l : Exists l <-> exists i d, i < length l /\ P (nth i l d). Proof. split. - intros HE; apply Exists_exists in HE. destruct HE as [a [Hin HP]]. apply (In_nth _ _ a) in Hin; destruct Hin as [i [Hl Heq]]. rewrite <- Heq in HP. now exists i; exists a. - intros [i [d [Hl HP]]]. apply Exists_exists; exists (nth i l d); split. + apply nth_In; assumption. + assumption. Qed. Lemma Exists_nil : Exists nil <-> False. Proof. split; inversion 1. Qed. Lemma Exists_cons x l: Exists (x::l) <-> P x \/ Exists l. Proof. split; inversion 1; auto. Qed. Lemma Exists_app l1 l2 : Exists (l1 ++ l2) <-> Exists l1 \/ Exists l2. Proof. induction l1; simpl; split; intros HE; try now intuition. - inversion_clear HE; intuition. - destruct HE as [HE|HE]; intuition. inversion_clear HE; intuition. Qed. Lemma Exists_rev l : Exists l -> Exists (rev l). Proof. induction l; intros HE; intuition. inversion_clear HE; simpl; apply Exists_app; intuition. Qed. Lemma Exists_dec l: (forall x:A, {P x} + { ~ P x }) -> {Exists l} + {~ Exists l}. Proof. intro Pdec. induction l as [|a l' Hrec]. - right. abstract now rewrite Exists_nil. - destruct Hrec as [Hl'|Hl']. + left. now apply Exists_cons_tl. + destruct (Pdec a) as [Ha|Ha]. * left. now apply Exists_cons_hd. * right. abstract now inversion 1. Defined. Lemma Exists_fold_right l : Exists l <-> fold_right (fun x => or (P x)) False l. Proof. induction l; simpl; split; intros HE; try now inversion HE; intuition. Qed. Lemma incl_Exists l1 l2 : incl l1 l2 -> Exists l1 -> Exists l2. Proof. intros Hincl HE. apply Exists_exists in HE; destruct HE as [a [Hin HP]]. apply Exists_exists; exists a; intuition. Qed. Inductive Forall : list A -> Prop := | Forall_nil : Forall nil | Forall_cons : forall x l, P x -> Forall l -> Forall (x::l). #[local] Hint Constructors Forall : core. Lemma Forall_inv : forall (a:A) l, Forall (a :: l) -> P a. Proof. intros a l H; inversion H; trivial. Qed. Theorem Forall_inv_tail : forall (a:A) l, Forall (a :: l) -> Forall l. Proof. intros a l H; inversion H; trivial. Qed. Lemma Forall_nil_iff : Forall [] <-> True. Proof. easy. Qed. Lemma Forall_cons_iff : forall (a:A) l, Forall (a :: l) <-> P a /\ Forall l. Proof. intros. now split; [intro H; inversion H|constructor]. Qed. Lemma Forall_forall (l:list A): Forall l <-> (forall x, In x l -> P x). Proof. split. - induction 1; firstorder (subst; auto). - induction l; firstorder auto with datatypes. Qed. Lemma Forall_nth l : Forall l <-> forall i d, i < length l -> P (nth i l d). Proof. split. - intros HF i d Hl. apply (Forall_forall l). + assumption. + apply nth_In; assumption. - intros HF. apply Forall_forall; intros a Hin. apply (In_nth _ _ a) in Hin; destruct Hin as [i [Hl Heq]]. rewrite <- Heq; intuition. Qed. Lemma Forall_app l1 l2 : Forall (l1 ++ l2) <-> Forall l1 /\ Forall l2. Proof. induction l1 as [|a l1 IH]; cbn. - now rewrite Forall_nil_iff. - now rewrite !Forall_cons_iff, IH, and_assoc. Qed. Lemma Forall_elt a l1 l2 : Forall (l1 ++ a :: l2) -> P a. Proof. intros HF; apply Forall_app in HF; destruct HF as [HF1 HF2]; now inversion HF2. Qed. Lemma Forall_rev l : Forall l -> Forall (rev l). Proof. induction l; intros HF; [assumption|]. inversion_clear HF; simpl; apply Forall_app; intuition. Qed. Lemma Forall_rect : forall (Q : list A -> Type), Q [] -> (forall b l, P b -> Q (b :: l)) -> forall l, Forall l -> Q l. Proof. intros Q H H' l; induction l; intro; [|eapply H', Forall_inv]; eassumption. Qed. Lemma Forall_dec : (forall x:A, {P x} + { ~ P x }) -> forall l:list A, {Forall l} + {~ Forall l}. Proof. intros Pdec l. induction l as [|a l' Hrec]. - left. apply Forall_nil. - destruct Hrec as [Hl'|Hl']. + destruct (Pdec a) as [Ha|Ha]. * left. now apply Forall_cons. * right. abstract now inversion 1. + right. abstract now inversion 1. Defined. Lemma Forall_fold_right l : Forall l <-> fold_right (fun x => and (P x)) True l. Proof. induction l; simpl; split; intros HF; try now inversion HF; intuition. Qed. Lemma incl_Forall l1 l2 : incl l2 l1 -> Forall l1 -> Forall l2. Proof. intros Hincl HF. apply Forall_forall; intros a Ha. apply (Forall_forall l1); intuition. Qed. End One_predicate. Lemma map_ext_Forall B : forall (f g : A -> B) l, Forall (fun x => f x = g x) l -> map f l = map g l. Proof. intros; apply map_ext_in, Forall_forall; assumption. Qed. Theorem Exists_impl : forall (P Q : A -> Prop), (forall a : A, P a -> Q a) -> forall l, Exists P l -> Exists Q l. Proof. intros P Q H l H0. induction H0 as [x l H0|x l H0 IHExists]. - apply (Exists_cons_hd Q x l (H x H0)). - apply (Exists_cons_tl x IHExists). Qed. Lemma Exists_or : forall (P Q : A -> Prop) l, Exists P l \/ Exists Q l -> Exists (fun x => P x \/ Q x) l. Proof. intros P Q l; induction l as [|a l IHl]; intros [H | H]; inversion H; subst. 1,3: apply Exists_cons_hd; auto. all: apply Exists_cons_tl, IHl; auto. Qed. Lemma Exists_or_inv : forall (P Q : A -> Prop) l, Exists (fun x => P x \/ Q x) l -> Exists P l \/ Exists Q l. Proof. intros P Q l; induction l as [|a l IHl]; intro Hl; inversion Hl as [ ? ? H | ? ? H ]; subst. - inversion H; now repeat constructor. - destruct (IHl H); now repeat constructor. Qed. Lemma Forall_impl : forall (P Q : A -> Prop), (forall a, P a -> Q a) -> forall l, Forall P l -> Forall Q l. Proof. intros P Q H l. rewrite !Forall_forall. firstorder. Qed. Lemma Forall_and : forall (P Q : A -> Prop) l, Forall P l -> Forall Q l -> Forall (fun x => P x /\ Q x) l. Proof. intros P Q l; induction l; intros HP HQ; constructor; inversion HP; inversion HQ; auto. Qed. Lemma Forall_and_inv : forall (P Q : A -> Prop) l, Forall (fun x => P x /\ Q x) l -> Forall P l /\ Forall Q l. Proof. intros P Q l; induction l; intro Hl; split; constructor; inversion Hl; firstorder. Qed. Lemma Forall_Exists_neg (P:A->Prop)(l:list A) : Forall (fun x => ~ P x) l <-> ~(Exists P l). Proof. rewrite Forall_forall, Exists_exists. firstorder. Qed. Lemma Exists_Forall_neg (P:A->Prop)(l:list A) : (forall x, P x \/ ~P x) -> Exists (fun x => ~ P x) l <-> ~(Forall P l). Proof. intro Dec. split. - rewrite Forall_forall, Exists_exists; firstorder. - intros NF. induction l as [|a l IH]. + destruct NF. constructor. + destruct (Dec a) as [Ha|Ha]. * apply Exists_cons_tl, IH. contradict NF. now constructor. * now apply Exists_cons_hd. Qed. Lemma neg_Forall_Exists_neg (P:A->Prop) (l:list A) : (forall x:A, {P x} + { ~ P x }) -> ~ Forall P l -> Exists (fun x => ~ P x) l. Proof. intro Dec. apply Exists_Forall_neg; intros x. destruct (Dec x); auto. Qed. Lemma Forall_Exists_dec (P:A->Prop) : (forall x:A, {P x} + { ~ P x }) -> forall l:list A, {Forall P l} + {Exists (fun x => ~ P x) l}. Proof. intros Pdec l. destruct (Forall_dec P Pdec l); [left|right]; trivial. now apply neg_Forall_Exists_neg. Defined. Lemma incl_Forall_in_iff l l' : incl l l' <-> Forall (fun x => In x l') l. Proof. now rewrite Forall_forall; split. Qed. End Exists_Forall. #[global] Hint Constructors Exists : core. #[global] Hint Constructors Forall : core. Lemma Exists_map A B (f : A -> B) P l : Exists P (map f l) <-> Exists (fun x => P (f x)) l. Proof. induction l as [|a l IHl]. - cbn. now rewrite Exists_nil. - cbn. now rewrite ?Exists_cons, IHl. Qed. Lemma Exists_concat A P (ls : list (list A)) : Exists P (concat ls) <-> Exists (Exists P) ls. Proof. induction ls as [|l ls IHls]. - cbn. now rewrite Exists_nil. - cbn. now rewrite Exists_app, Exists_cons, IHls. Qed. Lemma Exists_flat_map A B P ls (f : A -> list B) : Exists P (flat_map f ls) <-> Exists (fun d => Exists P (f d)) ls. Proof. now rewrite flat_map_concat_map, Exists_concat, Exists_map. Qed. Lemma Forall_map A B (f : A -> B) P l : Forall P (map f l) <-> Forall (fun x => P (f x)) l. Proof. induction l as [|a l IHl]; cbn. - now rewrite !Forall_nil_iff. - now rewrite !Forall_cons_iff, IHl. Qed. Lemma Forall_concat A P (ls : list (list A)) : Forall P (concat ls) <-> Forall (Forall P) ls. Proof. induction ls as [|l ls IHls]; cbn. - now rewrite !Forall_nil_iff. - now rewrite Forall_app, Forall_cons_iff, IHls. Qed. Lemma Forall_flat_map A B P ls (f : A -> list B) : Forall P (flat_map f ls) <-> Forall (fun d => Forall P (f d)) ls. Proof. now rewrite flat_map_concat_map, Forall_concat, Forall_map. Qed. Lemma exists_Forall A B : forall (P : A -> B -> Prop) l, (exists k, Forall (P k) l) -> Forall (fun x => exists k, P k x) l. Proof. intros P l; induction l as [|a l IHl]; intros [k HF]; constructor; inversion_clear HF. - now exists k. - now apply IHl; exists k. Qed. Lemma Forall_image A B : forall (f : A -> B) l, Forall (fun y => exists x, y = f x) l <-> exists l', l = map f l'. Proof. intros f l; induction l as [|a l IHl]; split; intros HF. - exists nil; reflexivity. - constructor. - apply Forall_cons_iff in HF as [[x ->] [l' ->] %IHl]. now exists (x :: l'). - destruct HF as [l' Heq]. symmetry in Heq; apply map_eq_cons in Heq. destruct Heq as (x & tl & ? & ? & ?); subst. constructor. + now exists x. + now apply IHl; exists tl. Qed. Lemma concat_nil_Forall A : forall (l : list (list A)), concat l = nil <-> Forall (fun x => x = nil) l. Proof. intro l; induction l as [|a l IHl]; simpl; split; intros Hc; auto. - apply app_eq_nil in Hc. constructor; firstorder. - inversion Hc; subst; simpl. now apply IHl. Qed. Lemma in_flat_map_Exists A B : forall (f : A -> list B) x l, In x (flat_map f l) <-> Exists (fun y => In x (f y)) l. Proof. intros f x l; rewrite in_flat_map. split; apply Exists_exists. Qed. Lemma notin_flat_map_Forall A B : forall (f : A -> list B) x l, ~ In x (flat_map f l) <-> Forall (fun y => ~ In x (f y)) l. Proof. intros f x l; rewrite Forall_Exists_neg. apply not_iff_compat, in_flat_map_Exists. Qed. Section Forall2. (** [Forall2]: stating that elements of two lists are pairwise related. *) Variables A B : Type. Variable R : A -> B -> Prop. Inductive Forall2 : list A -> list B -> Prop := | Forall2_nil : Forall2 [] [] | Forall2_cons : forall x y l l', R x y -> Forall2 l l' -> Forall2 (x::l) (y::l'). #[local] Hint Constructors Forall2 : core. (* NB: when deprecation phase ends, instead of removing prove "Reflexive R -> Reflexive Forall2" and close #6131 *) #[deprecated(since = "8.18", note = "Use Forall2_nil instead.")] Theorem Forall2_refl : Forall2 [] []. Proof. intros; apply Forall2_nil. Qed. Theorem Forall2_cons_iff : forall x y l l', Forall2 (x :: l) (y :: l') <-> R x y /\ Forall2 l l'. Proof. intros x y l l'. split. - intros H. now inversion H. - intros [? ?]. now constructor. Qed. Theorem Forall2_length : forall l l', Forall2 l l' -> length l = length l'. Proof. intros l. induction l as [|x l IH]; intros l' Hl'; inversion Hl'. - reflexivity. - cbn. f_equal. now apply IH. Qed. Theorem Forall2_app_inv_l : forall l1 l2 l', Forall2 (l1 ++ l2) l' -> exists l1' l2', Forall2 l1 l1' /\ Forall2 l2 l2' /\ l' = l1' ++ l2'. Proof. intro l1; induction l1 as [|a l1 IHl1]; intros l2 l' H. - exists [], l'; auto. - simpl in H; inversion H as [|? y ? ? ? H4]; subst; clear H. apply IHl1 in H4 as (l1' & l2' & Hl1 & Hl2 & ->). exists (y::l1'), l2'; simpl; auto. Qed. Theorem Forall2_app_inv_r : forall l1' l2' l, Forall2 l (l1' ++ l2') -> exists l1 l2, Forall2 l1 l1' /\ Forall2 l2 l2' /\ l = l1 ++ l2. Proof. intro l1'; induction l1' as [|a l1' IHl1']; intros l2' l H. - exists [], l; auto. - simpl in H; inversion H as [|x ? ? ? ? H4]; subst; clear H. apply IHl1' in H4 as (l1 & l2 & Hl1 & Hl2 & ->). exists (x::l1), l2; simpl; auto. Qed. Theorem Forall2_app : forall l1 l2 l1' l2', Forall2 l1 l1' -> Forall2 l2 l2' -> Forall2 (l1 ++ l2) (l1' ++ l2'). Proof. intros l1 l2 l1' l2' H H0. induction l1 in l1', H, H0 |- *; inversion H; subst; simpl; auto. Qed. Theorem Forall_Exists_exists_Forall2 l1 l2 : Forall (fun a => Exists (R a) l2) l1 -> exists l2', Forall2 l1 l2' /\ incl l2' l2. Proof. induction l1 as [|a l1 IH]. - intros _. now exists []. - intros [[b [Hb Hab]] %Exists_exists Hl1l2] %Forall_cons_iff. destruct (IH Hl1l2) as [l2' [Hl1l2' Hl2'l2]]. exists (b :: l2'). now eauto using incl_cons. Qed. End Forall2. Lemma Forall2_impl (A B : Type) (R1 R2 : A -> B -> Prop) : (forall a b, R1 a b -> R2 a b) -> forall l1 l2, Forall2 R1 l1 l2 -> Forall2 R2 l1 l2. Proof. intros HPQ l1 l2 HPl1l2. induction HPl1l2; now eauto using Forall2. Qed. Lemma Forall2_flip (A B : Type) (R : A -> B -> Prop) l1 l2 : Forall2 R l1 l2 -> Forall2 (fun b a => R a b) l2 l1. Proof. intros HPl1l2. induction HPl1l2; now eauto using Forall2. Qed. #[global] Hint Constructors Forall2 : core. Section ForallPairs. (** [ForallPairs] : specifies that a certain relation should always hold when inspecting all possible pairs of elements of a list. *) Variable A : Type. Variable R : A -> A -> Prop. Definition ForallPairs l := forall a b, In a l -> In b l -> R a b. (** [ForallOrdPairs] : we still check a relation over all pairs of elements of a list, but now the order of elements matters. *) Inductive ForallOrdPairs : list A -> Prop := | FOP_nil : ForallOrdPairs nil | FOP_cons : forall a l, Forall (R a) l -> ForallOrdPairs l -> ForallOrdPairs (a::l). #[local] Hint Constructors ForallOrdPairs : core. Lemma ForallOrdPairs_In : forall l, ForallOrdPairs l -> forall x y, In x l -> In y l -> x=y \/ R x y \/ R y x. Proof. induction 1. - inversion 1. - simpl; destruct 1; destruct 1; subst; auto. + right; left. apply -> Forall_forall; eauto. + right; right. apply -> Forall_forall; eauto. Qed. (** [ForallPairs] implies [ForallOrdPairs]. The reverse implication is true only when [R] is symmetric and reflexive. *) Lemma ForallPairs_ForallOrdPairs l: ForallPairs l -> ForallOrdPairs l. Proof. induction l as [|a l IHl]; [easy|]. intros H. constructor. - rewrite Forall_forall. intros; apply H; simpl; auto. - apply IHl. red; intros; apply H; simpl; auto. Qed. Lemma ForallOrdPairs_ForallPairs : (forall x, R x x) -> (forall x y, R x y -> R y x) -> forall l, ForallOrdPairs l -> ForallPairs l. Proof. intros Refl Sym l Hl x y Hx Hy. destruct (ForallOrdPairs_In Hl _ _ Hx Hy); subst; intuition. Qed. End ForallPairs. Lemma NoDup_iff_ForallOrdPairs [A] (l: list A): NoDup l <-> ForallOrdPairs (fun a b => a <> b) l. Proof. split; intro H. - induction H; constructor. + apply Forall_forall. intros y Hy ->. contradiction. + assumption. - induction H as [|a l H1 H2]; constructor. + rewrite Forall_forall in H1. intro E. contradiction (H1 a E). reflexivity. + assumption. Qed. Lemma NoDup_map_NoDup_ForallPairs [A B] (f: A->B) (l: list A) : ForallPairs (fun x y => f x = f y -> x = y) l -> NoDup l -> NoDup (map f l). Proof. intros Hinj Hl. induction Hl as [|x ?? _ IH]; cbn; constructor. - intros [y [??]]%in_map_iff. destruct (Hinj y x); cbn; auto. - apply IH. intros x' y' Hx' Hy'. now apply Hinj; right. Qed. Lemma NoDup_concat [A] (L: list (list A)): Forall (@NoDup A) L -> ForallOrdPairs (fun l1 l2 => forall a, In a l1 -> ~ In a l2) L -> NoDup (concat L). Proof. intros H1 H2. induction L as [|l1 L IHL]; [constructor|]. cbn. apply NoDup_app. - apply Forall_inv in H1. assumption. - apply IHL. + apply Forall_inv_tail in H1. assumption. + inversion H2. assumption. - intros a aInl1 ainL%in_concat. destruct ainL as [l2 [l2inL ainL2]]. inversion H2 as [|l L' H3]. rewrite Forall_forall in H3. apply (H3 _ l2inL _ aInl1). assumption. Qed. Section Repeat. Variable A : Type. Fixpoint repeat (x : A) (n: nat ) := match n with | O => [] | S k => x::(repeat x k) end. Theorem repeat_length x n: length (repeat x n) = n. Proof. induction n as [| k Hrec]; simpl; rewrite ?Hrec; reflexivity. Qed. Theorem repeat_spec n x y: In y (repeat x n) -> y=x. Proof. induction n as [|k Hrec]; simpl; destruct 1; auto. Qed. Lemma repeat_cons n a : a :: repeat a n = repeat a n ++ (a :: nil). Proof. induction n as [|n IHn]; simpl. - reflexivity. - f_equal; apply IHn. Qed. Lemma repeat_app x n m : repeat x (n + m) = repeat x n ++ repeat x m. Proof. induction n as [|n IHn]; simpl; auto. now rewrite IHn. Qed. Lemma repeat_eq_app x n l1 l2 : repeat x n = l1 ++ l2 -> repeat x (length l1) = l1 /\ repeat x (length l2) = l2. Proof. revert n; induction l1 as [|a l1 IHl1]; simpl; intros n Hr; subst. - repeat split; now rewrite repeat_length. - destruct n; inversion Hr as [ [Heq Hr0] ]; subst. now apply IHl1 in Hr0 as [-> ->]. Qed. Lemma repeat_eq_cons x y n l : repeat x n = y :: l -> x = y /\ repeat x (pred n) = l. Proof. intros Hr. destruct n; inversion_clear Hr; auto. Qed. Lemma repeat_eq_elt x y n l1 l2 : repeat x n = l1 ++ y :: l2 -> x = y /\ repeat x (length l1) = l1 /\ repeat x (length l2) = l2. Proof. intros Hr; apply repeat_eq_app in Hr as [Hr1 Hr2]; subst. apply repeat_eq_cons in Hr2; intuition. Qed. Lemma Forall_eq_repeat x l : Forall (eq x) l -> l = repeat x (length l). Proof. induction l as [|a l IHl]; simpl; intros HF; auto. inversion_clear HF as [ | ? ? ? HF']; subst. now rewrite (IHl HF') at 1. Qed. Hypothesis decA : forall x y : A, {x = y}+{x <> y}. Lemma count_occ_repeat_eq x y n : x = y -> count_occ decA (repeat y n) x = n. Proof. intros ->. induction n; cbn; auto. destruct (decA y y); auto. exfalso; intuition. Qed. Lemma count_occ_repeat_neq x y n : x <> y -> count_occ decA (repeat y n) x = 0. Proof. intros Hneq. induction n; cbn; auto. destruct (decA y x); auto. exfalso; intuition. Qed. Lemma count_occ_unique x l : count_occ decA l x = length l -> l = repeat x (length l). Proof. induction l as [|h l]; cbn; intros Hocc; auto. destruct (decA h x). - f_equal; intuition. - assert (Hb := count_occ_bound decA x l). rewrite Hocc in Hb. exfalso; apply (Nat.nle_succ_diag_l _ Hb). Qed. Lemma count_occ_repeat_excl x l : (forall y, y <> x -> count_occ decA l y = 0) -> l = repeat x (length l). Proof. intros Hocc. apply Forall_eq_repeat, Forall_forall; intros z Hin. destruct (decA z x) as [Heq|Hneq]; auto. apply Hocc, count_occ_not_In in Hneq; intuition. Qed. Lemma count_occ_sgt l x : l = x :: nil <-> count_occ decA l x = 1 /\ forall y, y <> x -> count_occ decA l y = 0. Proof. split. - intros ->; cbn; split; intros; destruct decA; subst; intuition. - intros [Heq Hneq]. apply count_occ_repeat_excl in Hneq. rewrite Hneq, count_occ_repeat_eq in Heq; trivial. now rewrite Heq in Hneq. Qed. Lemma nth_repeat a m n : nth n (repeat a m) a = a. Proof. revert n. induction m as [|m IHm]. - now intros [|n]. - intros [|n]; [reflexivity|exact (IHm n)]. Qed. Lemma nth_repeat_lt a m n d : n < m -> nth n (repeat a m) d = a. Proof. revert n. induction m as [|m IHm]. - now intros [|n]. - intros [|n]; [reflexivity|]. intros Hlt%Nat.succ_lt_mono. apply (IHm _ Hlt). Qed. Lemma nth_error_repeat a m n : n < m -> nth_error (repeat a m) n = Some a. Proof. intro Hnm. rewrite (nth_error_nth' _ a). - now rewrite nth_repeat. - now rewrite repeat_length. Qed. End Repeat. Lemma repeat_to_concat A n (a:A) : repeat a n = concat (repeat [a] n). Proof. induction n as [|n IHn]; simpl. - reflexivity. - f_equal; apply IHn. Qed. Lemma map_repeat A B (a:A) n (f : A -> B): map f (repeat a n) = repeat (f a) n. Proof. induction n as [|n IHn]. - reflexivity. - cbn. f_equal. exact IHn. Qed. Lemma rev_repeat A n (a:A): rev (repeat a n) = repeat a n. Proof. induction n as [|n IHn]. - reflexivity. - cbn. rewrite IHn. symmetry. apply repeat_cons. Qed. (** Sum of elements of a list of [nat]: [list_sum] *) Definition list_sum l := fold_right plus 0 l. Lemma list_sum_app : forall l1 l2, list_sum (l1 ++ l2) = list_sum l1 + list_sum l2. Proof. intro l1; induction l1 as [|a l1 IHl1]; intros l2; [ reflexivity | ]. simpl; rewrite IHl1. apply Nat.add_assoc. Qed. Lemma length_concat A l: length (concat l) = list_sum (map (@length A) l). Proof. induction l; [reflexivity|]. simpl. rewrite length_app. f_equal. assumption. Qed. Lemma length_flat_map A B (f: A -> list B) l: length (flat_map f l) = list_sum (map (fun x => length (f x)) l). Proof. rewrite flat_map_concat_map, length_concat, map_map. reflexivity. Qed. Corollary flat_map_constant_length A B c (f: A -> list B) l: (forall x, In x l -> length (f x) = c) -> length (flat_map f l) = (length l) * c. Proof. intro H. rewrite length_flat_map. induction l as [ | a l IHl ]; [reflexivity|]. simpl. rewrite IHl, H; [reflexivity | left; reflexivity | ]. intros x Hx. apply H. right. assumption. Qed. Lemma length_list_power (A B:Type)(l:list A) (l':list B): length (list_power l l') = (length l')^(length l). Proof. induction l as [ | a m IH ]; [reflexivity|]. cbn. rewrite flat_map_constant_length with (c := length l'). - rewrite IH. apply Nat.mul_comm. - intros x H. apply length_map. Qed. (** Max of elements of a list of [nat]: [list_max] *) Definition list_max l := fold_right max 0 l. Lemma list_max_app : forall l1 l2, list_max (l1 ++ l2) = max (list_max l1) (list_max l2). Proof. intro l1; induction l1 as [|a l1 IHl1]; intros l2; [ reflexivity | ]. now simpl; rewrite IHl1, Nat.max_assoc. Qed. Lemma list_max_le : forall l n, list_max l <= n <-> Forall (fun k => k <= n) l. Proof. intro l; induction l as [|a l IHl]; simpl; intros n; split. - now intros. - intros. now apply Nat.le_0_l. - intros [? ?] %Nat.max_lub_iff. now constructor; [|apply IHl]. - now rewrite Forall_cons_iff, <- IHl, Nat.max_lub_iff. Qed. Lemma list_max_lt : forall l n, l <> nil -> list_max l < n <-> Forall (fun k => k < n) l. Proof. intro l; induction l as [|a l IHl]; simpl; intros n Hnil; split; intros H; intuition. - destruct l. + repeat constructor. now simpl in H; rewrite Nat.max_0_r in H. + apply Nat.max_lub_lt_iff in H. now constructor; [ | apply IHl ]. - destruct l; inversion_clear H as [ | ? ? Hlt HF ]. + now simpl; rewrite Nat.max_0_r. + apply IHl in HF. * now apply Nat.max_lub_lt_iff. * intros Heq; inversion Heq. Qed. (** * Inversion of predicates over lists based on head symbol *) Ltac is_list_constr c := match c with | nil => idtac | (_::_) => idtac | _ => fail end. Ltac invlist f := match goal with | H:f ?l |- _ => is_list_constr l; inversion_clear H; invlist f | H:f _ ?l |- _ => is_list_constr l; inversion_clear H; invlist f | H:f _ _ ?l |- _ => is_list_constr l; inversion_clear H; invlist f | H:f _ _ _ ?l |- _ => is_list_constr l; inversion_clear H; invlist f | H:f _ _ _ _ ?l |- _ => is_list_constr l; inversion_clear H; invlist f | _ => idtac end. (** * Exporting hints and tactics *) Global Hint Rewrite rev_involutive (* rev (rev l) = l *) rev_unit (* rev (l ++ a :: nil) = a :: rev l *) map_nth (* nth n (map f l) (f d) = f (nth n l d) *) length_map (* length (map f l) = length l *) length_seq (* length (seq start len) = len *) length_app (* length (l ++ l') = length l + length l' *) length_rev (* length (rev l) = length l *) app_nil_r (* l ++ nil = l *) : list. Ltac simpl_list := autorewrite with list. Ltac ssimpl_list := autorewrite with list using simpl. (* begin hide *) (* Compatibility notations after the migration of [list] to [Datatypes] *) Notation list := list (only parsing). Notation list_rect := list_rect (only parsing). Notation list_rec := list_rec (only parsing). Notation list_ind := list_ind (only parsing). Notation nil := nil (only parsing). Notation cons := cons (only parsing). Notation length := length (only parsing). Notation app := app (only parsing). (* Compatibility Names *) Notation tail := tl (only parsing). Notation head := hd_error (only parsing). Notation head_nil := hd_error_nil (only parsing). Notation head_cons := hd_error_cons (only parsing). #[deprecated(since = "8.18", note = "Use app_assoc instead.")] Notation ass_app := app_assoc (only parsing). #[deprecated(since = "8.18", note = "Use app_assoc instead.")] Notation app_ass := app_assoc_reverse_deprecated (only parsing). Notation In_split := in_split (only parsing). Notation In_rev := in_rev (only parsing). Notation In_dec := in_dec (only parsing). Notation distr_rev := rev_app_distr (only parsing). Notation rev_acc := rev_append (only parsing). Notation rev_acc_rev := rev_append_rev (only parsing). Notation AllS := Forall (only parsing). (* was formerly in TheoryList *) #[deprecated(since = "8.18", note = "Use app_nil_r instead.")] Notation app_nil_end := app_nil_end_deprecated (only parsing). #[deprecated(since = "8.18", note = "Use app_assoc instead.")] Notation app_assoc_reverse := app_assoc_reverse_deprecated (only parsing). #[deprecated(since = "8.20", note = "Use nth_error_cons_succ instead.")] Notation nth_error_cons_S := nth_error_cons_succ. #[global] Hint Resolve app_nil_end_deprecated : datatypes. #[deprecated(since = "8.20", note = "Use length_app instead.")] Notation app_length := length_app (only parsing). #[deprecated(since = "8.20", note = "Use length_rev instead.")] Notation rev_length := length_rev (only parsing). #[deprecated(since = "8.20", note = "Use length_map instead.")] Notation map_length := length_map (only parsing). #[deprecated(since = "8.20", note = "Use fold_left_S_O instead.")] Notation fold_left_length := fold_left_S_O (only parsing). #[deprecated(since = "8.20", note = "Use length_fst_split instead.")] Notation split_length_l := length_fst_split (only parsing). #[deprecated(since = "8.20", note = "Use length_snd_split instead.")] Notation split_length_r := length_snd_split (only parsing). #[deprecated(since = "8.20", note = "Use length_combine instead.")] Notation combine_length := length_combine (only parsing). #[deprecated(since = "8.20", note = "Use length_prod instead.")] Notation prod_length := length_prod (only parsing). #[deprecated(since = "8.20", note = "Use length_firstn instead.")] Notation firstn_length := length_firstn (only parsing). #[deprecated(since = "8.20", note = "Use length_skipn instead.")] Notation skipn_length := length_skipn (only parsing). #[deprecated(since = "8.20", note = "Use length_seq instead.")] Notation seq_length := length_seq (only parsing). #[deprecated(since = "8.20", note = "Use length_concat instead.")] Notation concat_length := length_concat (only parsing). #[deprecated(since = "8.20", note = "Use length_flat_map instead.")] Notation flat_map_length := length_flat_map (only parsing). #[deprecated(since = "8.20", note = "Use length_list_power instead.")] Notation list_power_length := length_list_power (only parsing). (* end hide *) (* Unset Universe Polymorphism. *) coq-8.20.0/theories/Lists/ListDec.v000066400000000000000000000077001466560755400170470ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* exists a l1 l2 l3, l = l1++a::l2++a::l3. Proof using A dec. intro H0. induction l as [|a l IHl]. - contradiction H0; constructor. - destruct (NoDup_decidable l) as [H1|H1]. + destruct (In_decidable a l) as [H2|H2]. * destruct (in_split _ _ H2) as (l1 & l2 & ->). now exists a, nil, l1, l2. * now contradiction H0; constructor. + destruct (IHl H1) as (b & l1 & l2 & l3 & ->). now exists b, (a::l1), l2, l3. Qed. Lemma NoDup_list_decidable (l:list A) : NoDup l -> forall x y:A, In x l -> In y l -> decidable (x=y). Proof using A. clear dec; intros Hl; induction Hl; firstorder congruence. Qed. End Dec_in_Prop. Section Dec_in_Type. Variables (A:Type)(dec : forall x y:A, {x=y}+{x<>y}). Definition In_dec := List.In_dec dec. (* Already in List.v *) Lemma incl_dec (l l':list A) : {incl l l'}+{~incl l l'}. Proof using A dec. induction l as [|a l IH]. - left. inversion 1. - destruct (In_dec a l') as [IN|IN]. + destruct IH as [IC|IC]. * left. destruct 1; subst; auto. * right. contradict IC. intros x H. apply IC; now right. + right. contradict IN. apply IN; now left. Qed. Lemma NoDup_dec (l:list A) : {NoDup l}+{~NoDup l}. Proof using A dec. induction l as [|a l IH]. - left; now constructor. - destruct (In_dec a l). + right. inversion_clear 1. tauto. + destruct IH. * left. now constructor. * right. inversion_clear 1. tauto. Qed. End Dec_in_Type. (** An extra result: thanks to decidability, a list can be purged from redundancies. *) Lemma uniquify_map A B (d:decidable_eq B)(f:A->B)(l:list A) : exists l', NoDup (map f l') /\ incl (map f l) (map f l'). Proof. induction l as [|a l IHl]. - exists nil. simpl. split; [now constructor | red; trivial]. - destruct IHl as (l' & N & I). destruct (In_decidable d (f a) (map f l')). + exists l'; simpl; split; trivial. intros x [Hx|Hx]. * now subst. * now apply I. + exists (a::l'); simpl; split. * now constructor. * intros x [Hx|Hx]. -- subst; now left. -- right; now apply I. Qed. Lemma uniquify A (d:decidable_eq A)(l:list A) : exists l', NoDup l' /\ incl l l'. Proof. destruct (uniquify_map d id l) as (l',H). exists l'. now rewrite !map_id in H. Qed. coq-8.20.0/theories/Lists/ListSet.v000066400000000000000000000335751466560755400171200ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* y}. Definition set := list A. Definition empty_set : set := nil. Fixpoint set_add (a:A) (x:set) : set := match x with | nil => a :: nil | a1 :: x1 => match Aeq_dec a a1 with | left _ => a1 :: x1 | right _ => a1 :: set_add a x1 end end. Fixpoint set_mem (a:A) (x:set) : bool := match x with | nil => false | a1 :: x1 => match Aeq_dec a a1 with | left _ => true | right _ => set_mem a x1 end end. (** If [a] belongs to [x], removes [a] from [x]. If not, does nothing. Invariant: any element should occur at most once in [x], see for instance [set_add]. We hence remove here only the first occurrence of [a] in [x]. *) Fixpoint set_remove (a:A) (x:set) : set := match x with | nil => empty_set | a1 :: x1 => match Aeq_dec a a1 with | left _ => x1 | right _ => a1 :: set_remove a x1 end end. Fixpoint set_inter (x:set) : set -> set := match x with | nil => fun y => nil | a1 :: x1 => fun y => if set_mem a1 y then a1 :: set_inter x1 y else set_inter x1 y end. Fixpoint set_union (x y:set) : set := match y with | nil => x | a1 :: y1 => set_add a1 (set_union x y1) end. (** returns the set of all els of [x] that does not belong to [y] *) Fixpoint set_diff (x y:set) : set := match x with | nil => nil | a1 :: x1 => if set_mem a1 y then set_diff x1 y else set_add a1 (set_diff x1 y) end. Definition set_In : A -> set -> Prop := In (A:=A). Lemma set_In_dec : forall (a:A) (x:set), {set_In a x} + {~ set_In a x}. Proof. exact (List.In_dec Aeq_dec). Qed. Lemma set_mem_ind : forall (B:Type) (P:B -> Prop) (y z:B) (a:A) (x:set), (set_In a x -> P y) -> P z -> P (if set_mem a x then y else z). Proof. simple induction x; simpl; intros. - assumption. - elim (Aeq_dec a a0); auto with datatypes. Qed. Lemma set_mem_ind2 : forall (B:Type) (P:B -> Prop) (y z:B) (a:A) (x:set), (set_In a x -> P y) -> (~ set_In a x -> P z) -> P (if set_mem a x then y else z). Proof. simple induction x; simpl; intros. - apply H0; red; trivial. - case (Aeq_dec a a0); auto with datatypes. intro Hneg; apply H; intros; auto. apply H1; red; intro. case H3; auto. Qed. Lemma set_mem_correct1 : forall (a:A) (x:set), set_mem a x = true -> set_In a x. Proof. simple induction x; simpl. - discriminate. - intros a0 l; elim (Aeq_dec a a0); auto with datatypes. Qed. Lemma set_mem_correct2 : forall (a:A) (x:set), set_In a x -> set_mem a x = true. Proof. simple induction x; simpl. - intro Ha; elim Ha. - intros a0 l; elim (Aeq_dec a a0); auto with datatypes. intros H1 H2 [H3| H4]. + absurd (a0 = a); auto with datatypes. + auto with datatypes. Qed. Lemma set_mem_complete1 : forall (a:A) (x:set), set_mem a x = false -> ~ set_In a x. Proof. simple induction x; simpl. - tauto. - intros a0 l; elim (Aeq_dec a a0). + intros _ _ [=]. + unfold not; intros H H0 H1 [|]; auto with datatypes. Qed. Lemma set_mem_complete2 : forall (a:A) (x:set), ~ set_In a x -> set_mem a x = false. Proof. simple induction x; simpl. - tauto. - intros a0 l; elim (Aeq_dec a a0). + intros H H0 []; auto with datatypes. + tauto. Qed. Lemma set_add_intro1 : forall (a b:A) (x:set), set_In a x -> set_In a (set_add b x). Proof. unfold set_In; simple induction x; simpl. - auto with datatypes. - intros a0 l H [Ha0a| Hal]. + elim (Aeq_dec b a0); left; assumption. + elim (Aeq_dec b a0); right; [ assumption | auto with datatypes ]. Qed. Lemma set_add_intro2 : forall (a b:A) (x:set), a = b -> set_In a (set_add b x). Proof. unfold set_In; simple induction x; simpl. - auto with datatypes. - intros a0 l H Hab. elim (Aeq_dec b a0); [ rewrite Hab; intro Hba0; rewrite Hba0; simpl; auto with datatypes | auto with datatypes ]. Qed. #[local] Hint Resolve set_add_intro1 set_add_intro2 : core. Lemma set_add_intro : forall (a b:A) (x:set), a = b \/ set_In a x -> set_In a (set_add b x). Proof. intros a b x [H1| H2]; auto with datatypes. Qed. Lemma set_add_elim : forall (a b:A) (x:set), set_In a (set_add b x) -> a = b \/ set_In a x. Proof. unfold set_In. simple induction x. - simpl; intros [H1| H2]; auto with datatypes. - simpl; do 3 intro. elim (Aeq_dec b a0). + simpl; tauto. + simpl; intros H0 [|]. * trivial with datatypes. tauto. * tauto. Qed. Lemma set_add_elim2 : forall (a b:A) (x:set), set_In a (set_add b x) -> a <> b -> set_In a x. intros a b x H; case (set_add_elim _ _ _ H); intros; trivial. case H1; trivial. Qed. #[local] Hint Resolve set_add_intro set_add_elim set_add_elim2 : core. Lemma set_add_not_empty : forall (a:A) (x:set), set_add a x <> empty_set. Proof. simple induction x; simpl. - discriminate. - intros; elim (Aeq_dec a a0); intros; discriminate. Qed. Lemma set_add_iff a b l : In a (set_add b l) <-> a = b \/ In a l. Proof. split. - apply set_add_elim. - apply set_add_intro. Qed. Lemma set_add_nodup a l : NoDup l -> NoDup (set_add a l). Proof. induction 1 as [|x l H H' IH]; simpl. - constructor; [ tauto | constructor ]. - destruct (Aeq_dec a x) as [<-|Hax]; constructor; trivial. rewrite set_add_iff. intuition. Qed. Lemma set_remove_1 (a b : A) (l : set) : In a (set_remove b l) -> In a l. Proof. induction l as [|x xs Hrec]. - intros. auto. - simpl. destruct (Aeq_dec b x). * tauto. * intro H. destruct H. + rewrite H. apply in_eq. + apply in_cons. apply Hrec. assumption. Qed. Lemma set_remove_2 (a b:A) (l : set) : NoDup l -> In a (set_remove b l) -> a <> b. Proof. induction l as [|x l IH]; intro ND; simpl. - tauto. - inversion_clear ND. destruct (Aeq_dec b x) as [<-|Hbx]. + congruence. + destruct 1; subst; auto. Qed. Lemma set_remove_3 (a b : A) (l : set) : In a l -> a <> b -> In a (set_remove b l). Proof. induction l as [|x xs Hrec]. - now simpl. - simpl. destruct (Aeq_dec b x) as [<-|Hbx]; simpl; intuition. congruence. Qed. Lemma set_remove_iff (a b : A) (l : set) : NoDup l -> (In a (set_remove b l) <-> In a l /\ a <> b). Proof. split; try split. - eapply set_remove_1; eauto. - eapply set_remove_2; eauto. - destruct 1; apply set_remove_3; auto. Qed. Lemma set_remove_nodup a l : NoDup l -> NoDup (set_remove a l). Proof. induction 1 as [|x l H H' IH]; simpl. - constructor. - destruct (Aeq_dec a x) as [<-|Hax]; trivial. constructor; trivial. rewrite set_remove_iff; trivial. intuition. Qed. Lemma set_union_intro1 : forall (a:A) (x y:set), set_In a x -> set_In a (set_union x y). Proof. simple induction y; simpl; auto with datatypes. Qed. Lemma set_union_intro2 : forall (a:A) (x y:set), set_In a y -> set_In a (set_union x y). Proof. simple induction y; simpl. - tauto. - intros; elim H0; auto with datatypes. Qed. #[local] Hint Resolve set_union_intro2 set_union_intro1 : core. Lemma set_union_intro : forall (a:A) (x y:set), set_In a x \/ set_In a y -> set_In a (set_union x y). Proof. intros; elim H; auto with datatypes. Qed. Lemma set_union_elim : forall (a:A) (x y:set), set_In a (set_union x y) -> set_In a x \/ set_In a y. Proof. simple induction y; simpl. - auto with datatypes. - intros. generalize (set_add_elim _ _ _ H0). intros [H1| H1]. + auto with datatypes. + tauto. Qed. Lemma set_union_iff a l l': In a (set_union l l') <-> In a l \/ In a l'. Proof. split. - apply set_union_elim. - apply set_union_intro. Qed. Lemma set_union_nodup l l' : NoDup l -> NoDup l' -> NoDup (set_union l l'). Proof. induction 2 as [|x' l' ? ? IH]; simpl; trivial. now apply set_add_nodup. Qed. Lemma set_union_emptyL : forall (a:A) (x:set), set_In a (set_union empty_set x) -> set_In a x. intros a x H; case (set_union_elim _ _ _ H); auto || contradiction. Qed. Lemma set_union_emptyR : forall (a:A) (x:set), set_In a (set_union x empty_set) -> set_In a x. intros a x H; case (set_union_elim _ _ _ H); auto || contradiction. Qed. Lemma set_inter_intro : forall (a:A) (x y:set), set_In a x -> set_In a y -> set_In a (set_inter x y). Proof. simple induction x. - auto with datatypes. - simpl; intros a0 l Hrec y [Ha0a| Hal] Hy. + simpl; rewrite Ha0a. generalize (set_mem_correct1 a y). generalize (set_mem_complete1 a y). elim (set_mem a y); simpl; intros. * auto with datatypes. * absurd (set_In a y); auto with datatypes. + elim (set_mem a0 y); [ right; auto with datatypes | auto with datatypes ]. Qed. Lemma set_inter_elim1 : forall (a:A) (x y:set), set_In a (set_inter x y) -> set_In a x. Proof. simple induction x. - auto with datatypes. - simpl; intros a0 l Hrec y. generalize (set_mem_correct1 a0 y). elim (set_mem a0 y); simpl; intros. + elim H0; eauto with datatypes. + eauto with datatypes. Qed. Lemma set_inter_elim2 : forall (a:A) (x y:set), set_In a (set_inter x y) -> set_In a y. Proof. simple induction x. - simpl; tauto. - simpl; intros a0 l Hrec y. generalize (set_mem_correct1 a0 y). elim (set_mem a0 y); simpl; intros. + elim H0; [ intro Hr; rewrite <- Hr; eauto with datatypes | eauto with datatypes ]. + eauto with datatypes. Qed. #[local] Hint Resolve set_inter_elim1 set_inter_elim2 : core. Lemma set_inter_elim : forall (a:A) (x y:set), set_In a (set_inter x y) -> set_In a x /\ set_In a y. Proof. eauto with datatypes. Qed. Lemma set_inter_iff a l l' : In a (set_inter l l') <-> In a l /\ In a l'. Proof. split. - apply set_inter_elim. - destruct 1. now apply set_inter_intro. Qed. Lemma set_inter_nodup l l' : NoDup l -> NoDup l' -> NoDup (set_inter l l'). Proof. induction 1 as [|x l H H' IH]; intro Hl'; simpl. - constructor. - destruct (set_mem x l'); auto. constructor; auto. rewrite set_inter_iff; tauto. Qed. Lemma set_diff_intro : forall (a:A) (x y:set), set_In a x -> ~ set_In a y -> set_In a (set_diff x y). Proof. simple induction x. - simpl; tauto. - simpl; intros a0 l Hrec y [Ha0a| Hal] Hay. + rewrite Ha0a; generalize (set_mem_complete2 _ _ Hay). elim (set_mem a y); [ intro Habs; discriminate Habs | auto with datatypes ]. + elim (set_mem a0 y); auto with datatypes. Qed. Lemma set_diff_elim1 : forall (a:A) (x y:set), set_In a (set_diff x y) -> set_In a x. Proof. simple induction x. - simpl; tauto. - simpl; intros a0 l Hrec y; elim (set_mem a0 y). + eauto with datatypes. + intro; generalize (set_add_elim _ _ _ H). intros [H1| H2]; eauto with datatypes. Qed. Lemma set_diff_elim2 : forall (a:A) (x y:set), set_In a (set_diff x y) -> ~ set_In a y. intros a x y; elim x; simpl. - intros; contradiction. - intros a0 l Hrec. apply set_mem_ind2; auto. intros H1 H2; case (set_add_elim _ _ _ H2); intros; auto. rewrite H; trivial. Qed. Lemma set_diff_iff a l l' : In a (set_diff l l') <-> In a l /\ ~In a l'. Proof. split. - split; [eapply set_diff_elim1 | eapply set_diff_elim2]; eauto. - destruct 1. now apply set_diff_intro. Qed. Lemma set_diff_nodup l l' : NoDup l -> NoDup (set_diff l l'). Proof. induction 1 as [|x l H IH]; simpl. - constructor. - destruct (set_mem x l'); auto using set_add_nodup. Qed. Lemma set_diff_trivial : forall (a:A) (x:set), ~ set_In a (set_diff x x). red; intros a x H. apply (set_diff_elim2 _ _ _ H). apply (set_diff_elim1 _ _ _ H). Qed. #[local] Hint Resolve set_diff_intro set_diff_trivial : core. End first_definitions. Section other_definitions. Definition set_prod : forall {A B:Type}, set A -> set B -> set (A * B) := list_prod. (** [B^A], set of applications from [A] to [B] *) Definition set_power : forall {A B:Type}, set A -> set B -> set (set (A * B)) := list_power. Definition set_fold_left {A B:Type} : (B -> A -> B) -> set A -> B -> B := fold_left (A:=B) (B:=A). Definition set_fold_right {A B:Type} (f:A -> B -> B) (x:set A) (b:B) : B := fold_right f b x. Definition set_map {A B:Type} (Aeq_dec : forall x y:B, {x = y} + {x <> y}) (f : A -> B) (x : set A) : set B := set_fold_right (fun a => set_add Aeq_dec (f a)) x (empty_set B). End other_definitions. Unset Implicit Arguments. coq-8.20.0/theories/Lists/ListTactics.v000066400000000000000000000043351466560755400177470ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* fcons x ltac:(list_fold_right fcons fnil tl) | nil => fnil end. (* A variant of list_fold_right, to prevent the match of list_fold_right from catching errors raised by fcons. *) Ltac lazy_list_fold_right fcons fnil l := let f := match l with | ?x :: ?tl => fun _ => fcons x ltac:(fun _ => lazy_list_fold_right fcons fnil tl) | nil => fun _ => fnil() end in f(). Ltac list_fold_left fcons fnil l := match l with | ?x :: ?tl => list_fold_left fcons ltac:(fcons x fnil) tl | nil => fnil end. Ltac list_iter f l := match l with | ?x :: ?tl => f x; list_iter f tl | nil => idtac end. Ltac list_iter_gen seq f l := match l with | ?x :: ?tl => let t1 _ := f x in let t2 _ := list_iter_gen seq f tl in seq t1 t2 | nil => idtac end. Ltac AddFvTail a l := match l with | nil => constr:(a::nil) | a :: _ => l | ?x :: ?l => let l' := AddFvTail a l in constr:(x::l') end. Ltac Find_at a l := let rec find n l := match l with | nil => fail 100 "anomaly: Find_at" | a :: _ => eval compute in n | _ :: ?l => find (Pos.succ n) l end in find 1%positive l. Ltac check_is_list t := match t with | _ :: ?l => check_is_list l | nil => idtac | _ => fail 100 "anomaly: failed to build a canonical list" end. Ltac check_fv l := check_is_list l; match type of l with | list _ => idtac | _ => fail 100 "anomaly: built an ill-typed list" end. coq-8.20.0/theories/Lists/SetoidList.v000066400000000000000000000766221466560755400176140ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* A -> Prop. (** Being in a list modulo an equality relation over type [A]. *) Inductive InA (x : A) : list A -> Prop := | InA_cons_hd : forall y l, eqA x y -> InA x (y :: l) | InA_cons_tl : forall y l, InA x l -> InA x (y :: l). #[local] Hint Constructors InA : core. (** TODO: it would be nice to have a generic definition instead of the previous one. Having [InA = Exists eqA] raises too many compatibility issues. For now, we only state the equivalence: *) Lemma InA_altdef : forall x l, InA x l <-> Exists (eqA x) l. Proof. split; induction 1; auto. Qed. Lemma InA_cons : forall x y l, InA x (y::l) <-> eqA x y \/ InA x l. Proof. intuition. invlist InA; auto. Qed. Lemma InA_nil : forall x, InA x nil <-> False. Proof. intuition. invlist InA. Qed. (** An alternative definition of [InA]. *) Lemma InA_alt : forall x l, InA x l <-> exists y, eqA x y /\ In y l. Proof. intros; rewrite InA_altdef, Exists_exists; firstorder. Qed. (** A list without redundancy modulo the equality over [A]. *) Inductive NoDupA : list A -> Prop := | NoDupA_nil : NoDupA nil | NoDupA_cons : forall x l, ~ InA x l -> NoDupA l -> NoDupA (x::l). #[local] Hint Constructors NoDupA : core. (** An alternative definition of [NoDupA] based on [ForallOrdPairs] *) Lemma NoDupA_altdef : forall l, NoDupA l <-> ForallOrdPairs (complement eqA) l. Proof. split; induction 1 as [|a l H rest]; constructor; auto. - rewrite Forall_forall. intros b Hb. intro Eq; elim H. rewrite InA_alt. exists b; auto. - rewrite InA_alt; intros (a' & Haa' & Ha'). rewrite Forall_forall in H. exact (H a' Ha' Haa'). Qed. (** lists with same elements modulo [eqA] *) Definition inclA l l' := forall x, InA x l -> InA x l'. Definition equivlistA l l' := forall x, InA x l <-> InA x l'. Lemma incl_nil l : inclA nil l. Proof. intros a H. inversion H. Qed. #[local] Hint Resolve incl_nil : list. (** lists with same elements modulo [eqA] at the same place *) Inductive eqlistA : list A -> list A -> Prop := | eqlistA_nil : eqlistA nil nil | eqlistA_cons : forall x x' l l', eqA x x' -> eqlistA l l' -> eqlistA (x::l) (x'::l'). #[local] Hint Constructors eqlistA : core. (** We could also have written [eqlistA = Forall2 eqA]. *) Lemma eqlistA_altdef : forall l l', eqlistA l l' <-> Forall2 eqA l l'. Proof. split; induction 1; auto. Qed. (** Results concerning lists modulo [eqA] *) Hypothesis eqA_equiv : Equivalence eqA. Definition eqarefl := (@Equivalence_Reflexive _ _ eqA_equiv). Definition eqatrans := (@Equivalence_Transitive _ _ eqA_equiv). Definition eqasym := (@Equivalence_Symmetric _ _ eqA_equiv). #[local] Hint Resolve eqarefl eqatrans : core. #[local] Hint Immediate eqasym : core. Ltac inv := invlist InA; invlist sort; invlist lelistA; invlist NoDupA. (** First, the two notions [equivlistA] and [eqlistA] are indeed equivlances *) Global Instance equivlist_equiv : Equivalence equivlistA. Proof. firstorder. Qed. Global Instance eqlistA_equiv : Equivalence eqlistA. Proof. constructor; red. - intros x; induction x; auto. - induction 1; auto. - intros x y z H; revert z; induction H; auto. inversion 1; subst; auto. invlist eqlistA; eauto with *. Qed. (** Moreover, [eqlistA] implies [equivlistA]. A reverse result will be proved later for sorted list without duplicates. *) Global Instance eqlistA_equivlistA : subrelation eqlistA equivlistA. Proof. intros x x' H. induction H as [|? ? ? ? H ? IHeqlistA]. - intuition auto with relations. - red; intros x0. rewrite 2 InA_cons. rewrite (IHeqlistA x0), H; intuition. Qed. (** InA is compatible with eqA (for its first arg) and with equivlistA (and hence eqlistA) for its second arg *) Global Instance InA_compat : Proper (eqA==>equivlistA==>iff) InA. Proof. intros x x' Hxx' l l' Hll'. rewrite (Hll' x). rewrite 2 InA_alt; firstorder. Qed. (** For compatibility, an immediate consequence of [InA_compat] *) Lemma InA_eqA : forall l x y, eqA x y -> InA x l -> InA y l. Proof. intros l x y H H'. rewrite <- H. auto. Qed. #[local] Hint Immediate InA_eqA : core. Lemma In_InA : forall l x, In x l -> InA x l. Proof. intros l; induction l; simpl; intuition. subst; auto. Qed. #[local] Hint Resolve In_InA : core. Lemma InA_split : forall l x, InA x l -> exists l1 y l2, eqA x y /\ l = l1++y::l2. Proof. intros l; induction l as [|a l IHl]; intros x H; inv. - exists (@nil A); exists a; exists l; auto. - match goal with H' : InA x l |- _ => rename H' into H0 end. destruct (IHl x H0) as (l1,(y,(l2,(H1,H2)))). exists (a::l1); exists y; exists l2; auto. split; simpl; f_equal; auto. Qed. Lemma InA_app : forall l1 l2 x, InA x (l1 ++ l2) -> InA x l1 \/ InA x l2. Proof. intros l1; induction l1 as [|a l1 IHl1]; simpl in *; intuition. inv; auto. match goal with H0' : InA _ (l1 ++ _) |- _ => rename H0' into H0 end. elim (IHl1 _ _ H0); auto. Qed. Lemma InA_app_iff : forall l1 l2 x, InA x (l1 ++ l2) <-> InA x l1 \/ InA x l2. Proof. split. - apply InA_app. - destruct 1 as [H|H]; generalize H; do 2 rewrite InA_alt. + destruct 1 as (y,(H1,H2)); exists y; split; auto. apply in_or_app; auto. + destruct 1 as (y,(H1,H2)); exists y; split; auto. apply in_or_app; auto. Qed. Lemma InA_rev : forall p m, InA p (rev m) <-> InA p m. Proof. intros; do 2 rewrite InA_alt. split; intros (y,H); exists y; intuition. - rewrite In_rev; auto. - rewrite <- In_rev; auto. Qed. (** Some more facts about InA *) Lemma InA_singleton x y : InA x (y::nil) <-> eqA x y. Proof. rewrite InA_cons, InA_nil; tauto. Qed. Lemma InA_double_head x y l : InA x (y :: y :: l) <-> InA x (y :: l). Proof. rewrite !InA_cons; tauto. Qed. Lemma InA_permute_heads x y z l : InA x (y :: z :: l) <-> InA x (z :: y :: l). Proof. rewrite !InA_cons; tauto. Qed. Lemma InA_app_idem x l : InA x (l ++ l) <-> InA x l. Proof. rewrite InA_app_iff; tauto. Qed. Section NoDupA. Lemma NoDupA_app : forall l l', NoDupA l -> NoDupA l' -> (forall x, InA x l -> InA x l' -> False) -> NoDupA (l++l'). Proof. intros l; induction l as [|a l IHl]; simpl; auto; intros l' H H0 H1. inv. constructor. - rewrite InA_alt; intros (y,(H4,H5)). destruct (in_app_or _ _ _ H5). + match goal with H2' : ~ InA a l |- _ => rename H2' into H2 end. elim H2. rewrite InA_alt. exists y; auto. + apply (H1 a). * auto. * rewrite InA_alt. exists y; auto. - apply IHl; auto. intros x ? ?. apply (H1 x); auto. Qed. Lemma NoDupA_rev : forall l, NoDupA l -> NoDupA (rev l). Proof. intros l; induction l. - simpl; auto. - simpl; intros. inv. apply NoDupA_app; auto. + constructor; auto. intro; inv. + intros x. rewrite InA_alt. intros (x1,(H2,H3)). intro; inv. match goal with H0 : ~ InA _ _ |- _ => destruct H0 end. match goal with H4 : eqA x ?x' |- InA ?x' _ => rewrite <- H4, H2 end. apply In_InA. rewrite In_rev; auto. Qed. Lemma NoDupA_split : forall l l' x, NoDupA (l++x::l') -> NoDupA (l++l'). Proof. intros l; induction l; simpl in *; intros; inv; auto. constructor; eauto. match goal with H0 : ~ InA _ _ |- _ => contradict H0 end. rewrite InA_app_iff in *. rewrite InA_cons. intuition. Qed. Lemma NoDupA_swap : forall l l' x, NoDupA (l++x::l') -> NoDupA (x::l++l'). Proof. intros l; induction l as [|a l IHl]; simpl in *; intros l' x H; inv; auto. constructor; eauto. - match goal with H1 : NoDupA (l ++ x :: l') |- _ => assert (H2:=IHl _ _ H1) end. inv. rewrite InA_cons. red; destruct 1. + match goal with H0 : ~ InA a (l ++ x :: l') |- _ => apply H0 end. rewrite InA_app_iff in *; rewrite InA_cons; auto. + auto. - constructor. + match goal with H0 : ~ InA a (l ++ x :: l') |- _ => contradict H0 end. rewrite InA_app_iff in *; rewrite InA_cons; intuition. + eapply NoDupA_split; eauto. Qed. Lemma NoDupA_singleton x : NoDupA (x::nil). Proof. repeat constructor. inversion 1. Qed. End NoDupA. Section EquivlistA. Global Instance equivlistA_cons_proper: Proper (eqA ==> equivlistA ==> equivlistA) (@cons A). Proof. intros ? ? E1 ? ? E2 ?; now rewrite !InA_cons, E1, E2. Qed. Global Instance equivlistA_app_proper: Proper (equivlistA ==> equivlistA ==> equivlistA) (@app A). Proof. intros ? ? E1 ? ? E2 ?. now rewrite !InA_app_iff, E1, E2. Qed. Lemma equivlistA_cons_nil x l : ~ equivlistA (x :: l) nil. Proof. intros E. now eapply InA_nil, E, InA_cons_hd. Qed. Lemma equivlistA_nil_eq l : equivlistA l nil -> l = nil. Proof. destruct l. - trivial. - intros H. now apply equivlistA_cons_nil in H. Qed. Lemma equivlistA_double_head x l : equivlistA (x :: x :: l) (x :: l). Proof. intro. apply InA_double_head. Qed. Lemma equivlistA_permute_heads x y l : equivlistA (x :: y :: l) (y :: x :: l). Proof. intro. apply InA_permute_heads. Qed. Lemma equivlistA_app_idem l : equivlistA (l ++ l) l. Proof. intro. apply InA_app_idem. Qed. Lemma equivlistA_NoDupA_split l l1 l2 x y : eqA x y -> NoDupA (x::l) -> NoDupA (l1++y::l2) -> equivlistA (x::l) (l1++y::l2) -> equivlistA l (l1++l2). Proof. intros H H0 H1 H2; intro a. generalize (H2 a). rewrite !InA_app_iff, !InA_cons. inv. assert (SW:=NoDupA_swap H1). inv. rewrite InA_app_iff in *. split; intros. - match goal with H3 : ~ InA x l |- _ => assert (~eqA a x) by (contradict H3; rewrite <- H3; auto) end. assert (~eqA a y) by (rewrite <- H; auto). tauto. - assert (OR : eqA a x \/ InA a l) by intuition. destruct OR as [EQN|INA]; auto. match goal with H0 : ~ (InA y l1 \/ InA y l2) |- _ => elim H0 end. rewrite <-H,<-EQN; auto. Qed. End EquivlistA. Section Fold. Variable B:Type. Variable eqB:B->B->Prop. Variable st:Equivalence eqB. Variable f:A->B->B. Variable i:B. Variable Comp:Proper (eqA==>eqB==>eqB) f. Lemma fold_right_eqlistA : forall s s', eqlistA s s' -> eqB (fold_right f i s) (fold_right f i s'). Proof. induction 1; simpl; auto with relations. apply Comp; auto. Qed. (** Fold with restricted [transpose] hypothesis. *) Section Fold_With_Restriction. Variable R : A -> A -> Prop. Hypothesis R_sym : Symmetric R. Hypothesis R_compat : Proper (eqA==>eqA==>iff) R. (* (** [ForallOrdPairs R] is compatible with [equivlistA] over the lists without duplicates, as long as the relation [R] is symmetric and compatible with [eqA]. To prove this fact, we use an auxiliary notion: "forall distinct pairs, ...". *) Definition ForallNeqPairs := ForallPairs (fun a b => ~eqA a b -> R a b). (** [ForallOrdPairs] and [ForallNeqPairs] are related, but not completely equivalent. For proving one implication, we need to know that the list has no duplicated elements... *) Lemma ForallNeqPairs_ForallOrdPairs : forall l, NoDupA l -> ForallNeqPairs l -> ForallOrdPairs R l. Proof. induction l; auto. constructor. inv. rewrite Forall_forall; intros b Hb. apply H0; simpl; auto. contradict H1; rewrite H1; auto. apply IHl. inv; auto. intros b c Hb Hc Hneq. apply H0; simpl; auto. Qed. (** ... and for proving the other implication, we need to be able to reverse relation [R]. *) Lemma ForallOrdPairs_ForallNeqPairs : forall l, ForallOrdPairs R l -> ForallNeqPairs l. Proof. intros l Hl x y Hx Hy N. destruct (ForallOrdPairs_In Hl x y Hx Hy) as [H|[H|H]]. subst; elim N; auto. assumption. apply R_sym; assumption. Qed. *) (** Compatibility of [ForallOrdPairs] with respect to [inclA]. *) Lemma ForallOrdPairs_inclA : forall l l', NoDupA l' -> inclA l' l -> ForallOrdPairs R l -> ForallOrdPairs R l'. Proof. intros l l'. induction l' as [|x l' IH]. - constructor. - intros ND Incl FOP. apply FOP_cons; inv; unfold inclA in *; auto. rewrite Forall_forall; intros y Hy. assert (Ix : InA x (x::l')) by (rewrite InA_cons; auto). apply Incl in Ix. rewrite InA_alt in Ix. destruct Ix as (x' & Hxx' & Hx'). assert (Iy : InA y (x::l')) by (apply In_InA; simpl; auto). apply Incl in Iy. rewrite InA_alt in Iy. destruct Iy as (y' & Hyy' & Hy'). rewrite Hxx', Hyy'. destruct (ForallOrdPairs_In FOP x' y' Hx' Hy') as [E|[?|?]]; auto. absurd (InA x l'); auto. rewrite Hxx', E, <- Hyy'; auto. Qed. (** Two-argument functions that allow to reorder their arguments. *) Definition transpose (f : A -> B -> B) := forall (x y : A) (z : B), eqB (f x (f y z)) (f y (f x z)). (** A version of transpose with restriction on where it should hold *) Definition transpose_restr (R : A -> A -> Prop)(f : A -> B -> B) := forall (x y : A) (z : B), R x y -> eqB (f x (f y z)) (f y (f x z)). Variable TraR :transpose_restr R f. Lemma fold_right_commutes_restr : forall s1 s2 x, ForallOrdPairs R (s1++x::s2) -> eqB (fold_right f i (s1++x::s2)) (f x (fold_right f i (s1++s2))). Proof. intros s1; induction s1 as [|a s1 IHs1]; simpl; auto; intros s2 x H. - reflexivity. - transitivity (f a (f x (fold_right f i (s1++s2)))). + apply Comp; auto. apply IHs1. invlist ForallOrdPairs; auto. + apply TraR. invlist ForallOrdPairs; auto. match goal with H0 : Forall (R a) (s1 ++ x :: s2) |- R a x => rewrite Forall_forall in H0; apply H0 end. apply in_or_app; simpl; auto. Qed. Lemma fold_right_equivlistA_restr : forall s s', NoDupA s -> NoDupA s' -> ForallOrdPairs R s -> equivlistA s s' -> eqB (fold_right f i s) (fold_right f i s'). Proof. intros s; induction s as [|x l Hrec]. - intros s'; destruct s' as [|a s']; simpl. + intros; reflexivity. + unfold equivlistA; intros H H0 H1 H2. destruct (H2 a). assert (InA a nil) by auto; inv. - intros s' N N' F E; simpl in *. assert (InA x s') as H by (rewrite <- (E x); auto). destruct (InA_split H) as (s1,(y,(s2,(H1,H2)))). subst s'. transitivity (f x (fold_right f i (s1++s2))). + apply Comp; auto. apply Hrec; auto. * inv; auto. * eapply NoDupA_split; eauto. * invlist ForallOrdPairs; auto. * eapply equivlistA_NoDupA_split; eauto. + transitivity (f y (fold_right f i (s1++s2))). * apply Comp; auto. reflexivity. * symmetry; apply fold_right_commutes_restr. apply ForallOrdPairs_inclA with (x::l); auto. red; intros; rewrite E; auto. Qed. Lemma fold_right_add_restr : forall s' s x, NoDupA s -> NoDupA s' -> ForallOrdPairs R s' -> ~ InA x s -> equivlistA s' (x::s) -> eqB (fold_right f i s') (f x (fold_right f i s)). Proof. intros s' s x **; apply (@fold_right_equivlistA_restr s' (x::s)); auto. Qed. End Fold_With_Restriction. (** we now state similar results, but without restriction on transpose. *) Variable Tra :transpose f. Lemma fold_right_commutes : forall s1 s2 x, eqB (fold_right f i (s1++x::s2)) (f x (fold_right f i (s1++s2))). Proof. intros s1; induction s1 as [|a s1 IHs1]; simpl; auto; intros s2 x. - reflexivity. - transitivity (f a (f x (fold_right f i (s1++s2)))); auto. apply Comp; auto. Qed. Lemma fold_right_equivlistA : forall s s', NoDupA s -> NoDupA s' -> equivlistA s s' -> eqB (fold_right f i s) (fold_right f i s'). Proof. intros; apply (fold_right_equivlistA_restr (R:=fun _ _ => True)); repeat red; auto. apply ForallPairs_ForallOrdPairs; try red; auto. Qed. Lemma fold_right_add : forall s' s x, NoDupA s -> NoDupA s' -> ~ InA x s -> equivlistA s' (x::s) -> eqB (fold_right f i s') (f x (fold_right f i s)). Proof. intros s' s x **; apply (@fold_right_equivlistA s' (x::s)); auto. Qed. End Fold. Section Fold2. Variable B:Type. Variable eqB:B->B->Prop. Variable st:Equivalence eqB. Variable f:A->B->B. Variable Comp:Proper (eqA==>eqB==>eqB) f. Lemma fold_right_eqlistA2 : forall s s' (i j:B) (heqij: eqB i j) (heqss': eqlistA s s'), eqB (fold_right f i s) (fold_right f j s'). Proof. intros s. induction s as [|a s IHs];intros s' i j heqij heqss'. - inversion heqss'. subst. simpl. assumption. - inversion heqss'. subst. simpl. apply Comp. + assumption. + apply IHs;assumption. Qed. Section Fold2_With_Restriction. Variable R : A -> A -> Prop. Hypothesis R_sym : Symmetric R. Hypothesis R_compat : Proper (eqA==>eqA==>iff) R. (** Two-argument functions that allow to reorder their arguments. *) Definition transpose2 (f : A -> B -> B) := forall (x y : A) (z z': B), eqB z z' -> eqB (f x (f y z)) (f y (f x z')). (** A version of transpose with restriction on where it should hold *) Definition transpose_restr2 (R : A -> A -> Prop)(f : A -> B -> B) := forall (x y : A) (z z': B), R x y -> eqB z z' -> eqB (f x (f y z)) (f y (f x z')). Variable TraR :transpose_restr2 R f. Lemma fold_right_commutes_restr2 : forall s1 s2 x (i j:B) (heqij: eqB i j), ForallOrdPairs R (s1++x::s2) -> eqB (fold_right f i (s1++x::s2)) (f x (fold_right f j (s1++s2))). Proof. intros s1; induction s1 as [|a s1 IHs1]; simpl; auto; intros s2 x i j heqij ?. - apply Comp. + destruct eqA_equiv. apply Equivalence_Reflexive. + eapply fold_right_eqlistA2. * assumption. * reflexivity. - transitivity (f a (f x (fold_right f j (s1++s2)))). + apply Comp; auto. eapply IHs1. * assumption. * invlist ForallOrdPairs; auto. + apply TraR. * invlist ForallOrdPairs; auto. match goal with H0 : Forall (R a) (s1 ++ x :: s2) |- _ => rewrite Forall_forall in H0; apply H0 end. apply in_or_app; simpl; auto. * reflexivity. Qed. Lemma fold_right_equivlistA_restr2 : forall s s' i j, NoDupA s -> NoDupA s' -> ForallOrdPairs R s -> equivlistA s s' -> eqB i j -> eqB (fold_right f i s) (fold_right f j s'). Proof. intros s; induction s as [|x l Hrec]. { intros s'; destruct s' as [|a s']; simpl. - intros. assumption. - unfold equivlistA; intros ? ? H H0 H1 H2 **. destruct (H2 a). assert (InA a nil) by auto; inv. } intros s' i j N N' F E eqij; simpl in *. assert (InA x s') as H by (rewrite <- (E x); auto). destruct (InA_split H) as (s1,(y,(s2,(H1,H2)))). subst s'. transitivity (f x (fold_right f j (s1++s2))). - apply Comp; auto. apply Hrec; auto. + inv; auto. + eapply NoDupA_split; eauto. + invlist ForallOrdPairs; auto. + eapply equivlistA_NoDupA_split; eauto. - transitivity (f y (fold_right f i (s1++s2))). + apply Comp; auto. symmetry. apply fold_right_eqlistA2. * assumption. * reflexivity. + symmetry. apply fold_right_commutes_restr2. * symmetry. assumption. * apply ForallOrdPairs_inclA with (x::l); auto. red; intros; rewrite E; auto. Qed. Lemma fold_right_add_restr2 : forall s' s i j x, NoDupA s -> NoDupA s' -> eqB i j -> ForallOrdPairs R s' -> ~ InA x s -> equivlistA s' (x::s) -> eqB (fold_right f i s') (f x (fold_right f j s)). Proof. intros s' s i j x **; apply (@fold_right_equivlistA_restr2 s' (x::s) i j); auto. Qed. End Fold2_With_Restriction. Variable Tra :transpose2 f. Lemma fold_right_commutes2 : forall s1 s2 i x x', eqA x x' -> eqB (fold_right f i (s1++x::s2)) (f x' (fold_right f i (s1++s2))). Proof. intros s1; induction s1 as [|a s1 IHs1];simpl;intros s2 i x x' H. - apply Comp;auto. reflexivity. - transitivity (f a (f x' (fold_right f i (s1++s2)))); auto. + apply Comp;auto. + apply Tra. reflexivity. Qed. Lemma fold_right_equivlistA2 : forall s s' i j, NoDupA s -> NoDupA s' -> eqB i j -> equivlistA s s' -> eqB (fold_right f i s) (fold_right f j s'). Proof. red in Tra. intros; apply (fold_right_equivlistA_restr2 (R:=fun _ _ => True)); repeat red; auto. apply ForallPairs_ForallOrdPairs; try red; auto. Qed. Lemma fold_right_add2 : forall s' s i j x, NoDupA s -> NoDupA s' -> eqB i j -> ~ InA x s -> equivlistA s' (x::s) -> eqB (fold_right f i s') (f x (fold_right f j s)). Proof. intros s' s i j x **. replace (f x (fold_right f j s)) with (fold_right f j (x::s)) by auto. eapply fold_right_equivlistA2;auto. Qed. End Fold2. Section Remove. Hypothesis eqA_dec : forall x y : A, {eqA x y}+{~(eqA x y)}. Lemma InA_dec : forall x l, { InA x l } + { ~ InA x l }. Proof. intros x l; induction l as [|a l IHl]. - right; auto. intro; inv. - destruct (eqA_dec x a). + left; auto. + destruct IHl. * left; auto. * right; intro; inv; contradiction. Defined. Fixpoint removeA (x : A) (l : list A) : list A := match l with | nil => nil | y::tl => if (eqA_dec x y) then removeA x tl else y::(removeA x tl) end. Lemma removeA_filter : forall x l, removeA x l = filter (fun y => if eqA_dec x y then false else true) l. Proof. intros x l; induction l as [|a l IHl]; simpl; auto. destruct (eqA_dec x a); auto. rewrite IHl; auto. Qed. Lemma removeA_InA : forall l x y, InA y (removeA x l) <-> InA y l /\ ~eqA x y. Proof. intros l; induction l as [|a l IHl]; simpl; auto. - intros x y; split. + intro; inv. + destruct 1; inv. - intros x y. destruct (eqA_dec x a) as [Heq|Hnot]; simpl; auto. + rewrite IHl; split; destruct 1; split; auto. inv; auto. match goal with H0 : ~ eqA x y |- _ => destruct H0 end; transitivity a; auto. + split. * intro; inv. -- split; auto. contradict Hnot. transitivity y; auto. -- match goal with H0 : InA y (removeA x l) |- _ => rewrite (IHl x y) in H0; destruct H0; auto end. * destruct 1; inv; auto. right; rewrite IHl; auto. Qed. Lemma removeA_NoDupA : forall s x, NoDupA s -> NoDupA (removeA x s). Proof. intros s; induction s as [|a s IHs]; simpl; intros x ?. - auto. - inv. destruct (eqA_dec x a); simpl; auto. constructor; auto. rewrite removeA_InA. intuition. Qed. Lemma removeA_equivlistA : forall l l' x, ~InA x l -> equivlistA (x :: l) l' -> equivlistA l (removeA x l'). Proof. unfold equivlistA; intros l l' x H H0 x0. rewrite removeA_InA. split; intros H1. - rewrite <- H0; split; auto. contradict H. apply InA_eqA with x0; auto. - rewrite <- (H0 x0) in H1. destruct H1. inv; auto. match goal with H2 : ~ eqA x x0 |- _ => elim H2; auto end. Qed. End Remove. (** Results concerning lists modulo [eqA] and [ltA] *) Variable ltA : A -> A -> Prop. Hypothesis ltA_strorder : StrictOrder ltA. Hypothesis ltA_compat : Proper (eqA==>eqA==>iff) ltA. Let sotrans := (@StrictOrder_Transitive _ _ ltA_strorder). #[local] Hint Resolve sotrans : core. Notation InfA:=(lelistA ltA). Notation SortA:=(sort ltA). #[local] Hint Constructors lelistA sort : core. Lemma InfA_ltA : forall l x y, ltA x y -> InfA y l -> InfA x l. Proof. intros l; destruct l; constructor. inv; eauto. Qed. Global Instance InfA_compat : Proper (eqA==>eqlistA==>iff) InfA. Proof using eqA_equiv ltA_compat. (* and not ltA_strorder *) intros x x' Hxx' l l' Hll'. inversion_clear Hll'. - intuition. - split; intro; inv; constructor. + match goal with H : eqA _ _ |- _ => rewrite <- Hxx', <- H; auto end. + match goal with H : eqA _ _ |- _ => rewrite Hxx', H; auto end. Qed. (** For compatibility, can be deduced from [InfA_compat] *) Lemma InfA_eqA l x y : eqA x y -> InfA y l -> InfA x l. Proof using eqA_equiv ltA_compat. intros H; now rewrite H. Qed. #[local] Hint Immediate InfA_ltA InfA_eqA : core. Lemma SortA_InfA_InA : forall l x a, SortA l -> InfA a l -> InA x l -> ltA a x. Proof. intros l; induction l as [|a l IHl]. - intros x a **. inv. - intros x a0 **. inv. + setoid_replace x with a; auto. + eauto. Qed. Lemma In_InfA : forall l x, (forall y, In y l -> ltA x y) -> InfA x l. Proof. intros l; induction l; simpl; intros; constructor; auto. Qed. Lemma InA_InfA : forall l x, (forall y, InA y l -> ltA x y) -> InfA x l. Proof. intros l; induction l; simpl; intros; constructor; auto. Qed. (* In fact, this may be used as an alternative definition for InfA: *) Lemma InfA_alt : forall l x, SortA l -> (InfA x l <-> (forall y, InA y l -> ltA x y)). Proof. split. - intros; eapply SortA_InfA_InA; eauto. - apply InA_InfA. Qed. Lemma InfA_app : forall l1 l2 a, InfA a l1 -> InfA a l2 -> InfA a (l1++l2). Proof. intros l1; induction l1; simpl; auto. intros; inv; auto. Qed. Lemma SortA_app : forall l1 l2, SortA l1 -> SortA l2 -> (forall x y, InA x l1 -> InA y l2 -> ltA x y) -> SortA (l1 ++ l2). Proof. intros l1; induction l1; intros l2; simpl in *; intuition. inv. constructor; auto. apply InfA_app; auto. destruct l2; auto. Qed. Lemma SortA_NoDupA : forall l, SortA l -> NoDupA l. Proof. intros l; induction l as [|x l' H]; auto. intros H0. inv. constructor; auto. intro. apply (StrictOrder_Irreflexive x). eapply SortA_InfA_InA; eauto. Qed. (** Some results about [eqlistA] *) Section EqlistA. Lemma eqlistA_length : forall l l', eqlistA l l' -> length l = length l'. Proof. induction 1; auto; simpl; congruence. Qed. Global Instance app_eqlistA_compat : Proper (eqlistA==>eqlistA==>eqlistA) (@app A). Proof. repeat red; induction 1; simpl; auto. Qed. (** For compatibility, can be deduced from app_eqlistA_compat **) Lemma eqlistA_app : forall l1 l1' l2 l2', eqlistA l1 l1' -> eqlistA l2 l2' -> eqlistA (l1++l2) (l1'++l2'). Proof. intros l1 l1' l2 l2' H H'; rewrite H, H'; reflexivity. Qed. Lemma eqlistA_rev_app : forall l1 l1', eqlistA l1 l1' -> forall l2 l2', eqlistA l2 l2' -> eqlistA ((rev l1)++l2) ((rev l1')++l2'). Proof. induction 1; auto. simpl; intros. do 2 rewrite <- app_assoc; simpl; auto. Qed. Global Instance rev_eqlistA_compat : Proper (eqlistA==>eqlistA) (@rev A). Proof. repeat red. intros x y ?. rewrite <- (app_nil_r (rev x)), <- (app_nil_r (rev y)). apply eqlistA_rev_app; auto. Qed. Lemma eqlistA_rev : forall l1 l1', eqlistA l1 l1' -> eqlistA (rev l1) (rev l1'). Proof. apply rev_eqlistA_compat. Qed. Lemma SortA_equivlistA_eqlistA : forall l l', SortA l -> SortA l' -> equivlistA l l' -> eqlistA l l'. Proof. intros l; induction l as [|a l IHl]; intros l'; destruct l' as [|a0 l']; simpl; intros H H0 H1; auto. - destruct (H1 a0); assert (InA a0 nil) by auto; inv. - destruct (H1 a); assert (InA a nil) by auto; inv. - inv. assert (forall y, InA y l -> ltA a y) by (intros; eapply (SortA_InfA_InA (l:=l)); eauto). assert (forall y, InA y l' -> ltA a0 y) by (intros; eapply (SortA_InfA_InA (l:=l')); eauto). do 2 match goal with H : InfA _ _ |- _ => clear H end. assert (eqA a a0). + destruct (H1 a). destruct (H1 a0). assert (InA a (a0::l')) by auto. inv; auto. assert (InA a0 (a::l)) by auto. inv; auto. elim (StrictOrder_Irreflexive a); eauto. + constructor; auto. apply IHl; auto. intros x; split; intros. * destruct (H1 x). assert (InA x (a0::l')) by auto. inv; auto. match goal with H3 : eqA a a0, H4 : InA x l, H9 : eqA x a0 |- InA x l' => rewrite H9,<-H3 in H4 end. elim (StrictOrder_Irreflexive a); eauto. * destruct (H1 x). assert (InA x (a::l)) by auto. inv; auto. match goal with H3 : eqA a a0, H4 : InA x l', H9 : eqA x a |- InA x l => rewrite H9,H3 in H4 end. elim (StrictOrder_Irreflexive a0); eauto. Qed. End EqlistA. (** A few things about [filter] *) Section Filter. Lemma filter_sort : forall f l, SortA l -> SortA (List.filter f l). Proof. intros f l; induction l as [|a l IHl]; simpl; auto. intros; inv; auto. destruct (f a); auto. constructor; auto. apply In_InfA; auto. intros y H. rewrite filter_In in H; destruct H. eapply SortA_InfA_InA; eauto. Qed. Arguments eq {A} x _. Lemma filter_InA : forall f, Proper (eqA==>eq) f -> forall l x, InA x (List.filter f l) <-> InA x l /\ f x = true. Proof. (* Unset Mangle Names. *) clear sotrans ltA ltA_strorder ltA_compat. intros f H l x; do 2 rewrite InA_alt; intuition; match goal with Hex' : exists _, _ |- _ => rename Hex' into Hex end. - destruct Hex as (y,(H0,H1)); rewrite filter_In in H1; exists y; intuition. - destruct Hex as (y,(H0,H1)); rewrite filter_In in H1; intuition. rewrite (H _ _ H0); auto. - destruct Hex as (y,(H0,H1)); exists y; rewrite filter_In; intuition. rewrite <- (H _ _ H0); auto. Qed. Lemma filter_split : forall f, (forall x y, f x = true -> f y = false -> ltA x y) -> forall l, SortA l -> l = filter f l ++ filter (fun x=>negb (f x)) l. Proof. intros f H l; induction l as [|a l IHl]; simpl; intros H0; auto. inv. match goal with H1' : SortA l, H2' : InfA a l |- _ => rename H1' into H1, H2' into H2 end. rewrite IHl at 1; auto. case_eq (f a); simpl; intros; auto. assert (forall e, In e l -> f e = false) as H3. { intros e H3. assert (H4:=SortA_InfA_InA H1 H2 (In_InA H3)). case_eq (f e); simpl; intros; auto. elim (StrictOrder_Irreflexive e). transitivity a; auto. } replace (List.filter f l) with (@nil A); auto. generalize H3; clear; induction l as [|a l IHl]; simpl; auto. case_eq (f a); auto; intros H H3. rewrite H3 in H; auto; try discriminate. Qed. End Filter. End Type_with_equality. #[global] Hint Constructors InA eqlistA NoDupA sort lelistA : core. Arguments equivlistA_cons_nil {A} eqA {eqA_equiv} x l _. Arguments equivlistA_nil_eq {A} eqA {eqA_equiv} l _. Section Find. Variable A B : Type. Variable eqA : A -> A -> Prop. Hypothesis eqA_equiv : Equivalence eqA. Hypothesis eqA_dec : forall x y : A, {eqA x y}+{~(eqA x y)}. Fixpoint findA (f : A -> bool) (l:list (A*B)) : option B := match l with | nil => None | (a,b)::l => if f a then Some b else findA f l end. Lemma findA_NoDupA : forall l a b, NoDupA (fun p p' => eqA (fst p) (fst p')) l -> (InA (fun p p' => eqA (fst p) (fst p') /\ snd p = snd p') (a,b) l <-> findA (fun a' => if eqA_dec a a' then true else false) l = Some b). Proof. set (eqk := fun p p' : A*B => eqA (fst p) (fst p')). set (eqke := fun p p' : A*B => eqA (fst p) (fst p') /\ snd p = snd p'). intros l; induction l as [|a l IHl]; intros a0 b H; simpl. - split; intros H0; try discriminate. invlist InA. - destruct a as (a',b'); rename a0 into a. invlist NoDupA. split; intros. + invlist InA. * match goal with H2 : eqke (a, b) (a', b') |- _ => compute in H2; destruct H2 end. subst b'. destruct (eqA_dec a a'); intuition. * destruct (eqA_dec a a') as [HeqA|]; simpl. -- match goal with H0 : ~ InA eqk (a', b') l |- _ => contradict H0 end. match goal with H2 : InA eqke (a, b) l |- _ => revert HeqA H2; clear - eqA_equiv end. induction l. ++ intros; invlist InA. ++ intros; invlist InA; auto. match goal with |- InA eqk _ (?p :: _) => destruct p as [a0 b0] end. match goal with H : eqke (a, b) (a0, b0) |- _ => compute in H; destruct H end. subst b. left; auto. compute. transitivity a; auto. symmetry; auto. -- rewrite <- IHl; auto. + destruct (eqA_dec a a'); simpl in *. * left; split; simpl; congruence. * right. rewrite IHl; auto. Qed. End Find. (** Compatibility aliases. [Proper] is rather to be used directly now.*) Definition compat_bool {A} (eqA:A->A->Prop)(f:A->bool) := Proper (eqA==>Logic.eq) f. Definition compat_nat {A} (eqA:A->A->Prop)(f:A->nat) := Proper (eqA==>Logic.eq) f. Definition compat_P {A} (eqA:A->A->Prop)(P:A->Prop) := Proper (eqA==>impl) P. Definition compat_op {A B} (eqA:A->A->Prop)(eqB:B->B->Prop)(f:A->B->B) := Proper (eqA==>eqB==>eqB) f. coq-8.20.0/theories/Lists/SetoidPermutation.v000066400000000000000000000145611466560755400212020ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* list A -> Prop := | permA_nil: PermutationA nil nil | permA_skip x₁ x₂ l₁ l₂ : eqA x₁ x₂ -> PermutationA l₁ l₂ -> PermutationA (x₁ :: l₁) (x₂ :: l₂) | permA_swap x y l : PermutationA (y :: x :: l) (x :: y :: l) | permA_trans l₁ l₂ l₃ : PermutationA l₁ l₂ -> PermutationA l₂ l₃ -> PermutationA l₁ l₃. Local Hint Constructors PermutationA : core. Global Instance: Equivalence PermutationA. Proof. constructor. - intro l. induction l; intuition. - intros l₁ l₂. induction 1; eauto. apply permA_skip; intuition. - exact permA_trans. Qed. Global Instance PermutationA_cons : Proper (eqA ==> PermutationA ==> PermutationA) (@cons A). Proof. repeat intro. now apply permA_skip. Qed. Lemma PermutationA_app_head l₁ l₂ l : PermutationA l₁ l₂ -> PermutationA (l ++ l₁) (l ++ l₂). Proof. induction l; trivial; intros. apply permA_skip; intuition. Qed. Global Instance PermutationA_app : Proper (PermutationA ==> PermutationA ==> PermutationA) (@app A). Proof. intros l₁ l₂ Pl k₁ k₂ Pk. induction Pl. - easy. - now apply permA_skip. - etransitivity. * rewrite <-!app_comm_cons. now apply permA_swap. * rewrite !app_comm_cons. now apply PermutationA_app_head. - do 2 (etransitivity; try eassumption). apply PermutationA_app_head. now symmetry. Qed. Lemma PermutationA_app_tail l₁ l₂ l : PermutationA l₁ l₂ -> PermutationA (l₁ ++ l) (l₂ ++ l). Proof. intros E. now rewrite E. Qed. Lemma PermutationA_cons_append l x : PermutationA (x :: l) (l ++ x :: nil). Proof. induction l. - easy. - simpl. rewrite <-IHl. intuition. Qed. Lemma PermutationA_app_comm l₁ l₂ : PermutationA (l₁ ++ l₂) (l₂ ++ l₁). Proof. induction l₁. - now rewrite app_nil_r. - rewrite <-app_comm_cons, IHl₁, app_comm_cons. now rewrite PermutationA_cons_append, <-app_assoc. Qed. Lemma PermutationA_cons_app l l₁ l₂ x : PermutationA l (l₁ ++ l₂) -> PermutationA (x :: l) (l₁ ++ x :: l₂). Proof. intros E. rewrite E. now rewrite app_comm_cons, (PermutationA_cons_append l₁ x), <- app_assoc. Qed. Lemma PermutationA_middle l₁ l₂ x : PermutationA (x :: l₁ ++ l₂) (l₁ ++ x :: l₂). Proof. now apply PermutationA_cons_app. Qed. Lemma PermutationA_equivlistA l₁ l₂ : PermutationA l₁ l₂ -> equivlistA eqA l₁ l₂. Proof. induction 1. - reflexivity. - now apply equivlistA_cons_proper. - now apply equivlistA_permute_heads. - etransitivity; eassumption. Qed. Lemma NoDupA_equivlistA_PermutationA l₁ l₂ : NoDupA eqA l₁ -> NoDupA eqA l₂ -> equivlistA eqA l₁ l₂ -> PermutationA l₁ l₂. Proof. intros Pl₁. revert l₂. induction Pl₁ as [|x l₁ E1]. - intros l₂ _ H₂. symmetry in H₂. now rewrite (equivlistA_nil_eq eqA). - intros l₂ Pl₂ E2. destruct (@InA_split _ eqA l₂ x) as [l₂h [y [l₂t [E3 ?]]]]. { rewrite <-E2. intuition. } subst. transitivity (y :: l₁); [intuition |]. apply PermutationA_cons_app, IHPl₁. + now apply NoDupA_split with y. + apply equivlistA_NoDupA_split with x y; intuition. Qed. Lemma Permutation_eqlistA_commute l₁ l₂ l₃ : eqlistA eqA l₁ l₂ -> Permutation l₂ l₃ -> exists l₂', Permutation l₁ l₂' /\ eqlistA eqA l₂' l₃. Proof. intros E P. revert l₁ E. induction P; intros. - inversion_clear E. now exists nil. - inversion_clear E. destruct (IHP l0) as (l0',(P',E')); trivial. clear IHP. exists (x0::l0'). split; auto. - inversion_clear E. inversion_clear H0. exists (x1::x0::l1). now repeat constructor. - clear P1 P2. destruct (IHP1 _ E) as (l₁',(P₁,E₁)). destruct (IHP2 _ E₁) as (l₂',(P₂,E₂)). exists l₂'. split; trivial. econstructor; eauto. Qed. Lemma PermutationA_decompose l₁ l₂ : PermutationA l₁ l₂ -> exists l, Permutation l₁ l /\ eqlistA eqA l l₂. Proof. induction 1. - now exists nil. - destruct IHPermutationA as (l,(P,E)). exists (x₁::l); auto. - exists (x::y::l). split. + constructor. + reflexivity. - destruct IHPermutationA1 as (l₁',(P,E)). destruct IHPermutationA2 as (l₂',(P',E')). destruct (@Permutation_eqlistA_commute l₁' l₂ l₂') as (l₁'',(P'',E'')); trivial. exists l₁''. split. + now transitivity l₁'. + now transitivity l₂'. Qed. Lemma Permutation_PermutationA l₁ l₂ : Permutation l₁ l₂ -> PermutationA l₁ l₂. Proof. induction 1. - constructor. - now constructor. - apply permA_swap. - econstructor; eauto. Qed. Lemma eqlistA_PermutationA l₁ l₂ : eqlistA eqA l₁ l₂ -> PermutationA l₁ l₂. Proof. induction 1; now constructor. Qed. Lemma NoDupA_equivlistA_decompose l1 l2 : NoDupA eqA l1 -> NoDupA eqA l2 -> equivlistA eqA l1 l2 -> exists l, Permutation l1 l /\ eqlistA eqA l l2. Proof. intros. apply PermutationA_decompose. now apply NoDupA_equivlistA_PermutationA. Qed. Lemma PermutationA_preserves_NoDupA l₁ l₂ : PermutationA l₁ l₂ -> NoDupA eqA l₁ -> NoDupA eqA l₂. Proof. induction 1; trivial. - inversion_clear 1; constructor; auto. apply PermutationA_equivlistA in H0. contradict H2. now rewrite H, H0. - inversion_clear 1. inversion_clear H1. constructor. + contradict H. inversion_clear H; trivial. elim H0. now constructor. + constructor; trivial. contradict H0. now apply InA_cons_tl. - eauto. Qed. End Permutation. coq-8.20.0/theories/Lists/StreamMemo.v000066400000000000000000000133001466560755400175620ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* A. CoFixpoint memo_make (n:nat) : Stream A := Cons (f n) (memo_make (S n)). Definition memo_list := memo_make 0. Fixpoint memo_get (n:nat) (l:Stream A) : A := match n with | O => hd l | S n1 => memo_get n1 (tl l) end. Theorem memo_get_correct: forall n, memo_get n memo_list = f n. Proof. assert (F1: forall n m, memo_get n (memo_make m) = f (n + m)). { induction n as [| n Hrec]; try (intros m; reflexivity). intros m; simpl; rewrite Hrec. rewrite plus_n_Sm; auto. } intros n; transitivity (f (n + 0)); try exact (F1 n 0). rewrite <- plus_n_O; auto. Qed. (** Building with possible sharing using a iterator [g] : We now suppose in addition that [f n] is in fact the [n]-th iterate of a function [g]. *) Variable g: A -> A. Hypothesis Hg_correct: forall n, f (S n) = g (f n). CoFixpoint imemo_make (fn:A) : Stream A := let fn1 := g fn in Cons fn1 (imemo_make fn1). Definition imemo_list := let f0 := f 0 in Cons f0 (imemo_make f0). Theorem imemo_get_correct: forall n, memo_get n imemo_list = f n. Proof. assert (F1: forall n m, memo_get n (imemo_make (f m)) = f (S (n + m))). { induction n as [| n Hrec]; try (intros m; exact (eq_sym (Hg_correct m))). simpl; intros m; rewrite <- Hg_correct, Hrec, <- plus_n_Sm; auto. } destruct n as [| n]; try reflexivity. unfold imemo_list; simpl; rewrite F1. rewrite <- plus_n_O; auto. Qed. End MemoFunction. (** For a dependent function, the previous solution is reused thanks to a temporary hiding of the dependency in a "container" [memo_val]. *) #[universes(template)] Inductive memo_val {A : nat -> Type} : Type := memo_mval: forall n, A n -> memo_val. Arguments memo_val : clear implicits. Section DependentMemoFunction. Variable A: nat -> Type. Variable f: forall n, A n. Notation memo_val := (memo_val A). Fixpoint is_eq (n m : nat) : {n = m} + {True} := match n, m return {n = m} + {True} with | 0, 0 =>left True (eq_refl 0) | 0, S m1 => right (0 = S m1) I | S n1, 0 => right (S n1 = 0) I | S n1, S m1 => match is_eq n1 m1 with | left H => left True (f_equal S H) | right _ => right (S n1 = S m1) I end end. Definition memo_get_val n (v: memo_val): A n := match v with | memo_mval m x => match is_eq n m with | left H => match H in (eq _ y) return (A y -> A n) with | eq_refl => fun v1 : A n => v1 end | right _ => fun _ : A m => f n end x end. Let mf n := memo_mval n (f n). Definition dmemo_list := memo_list _ mf. Definition dmemo_get n l := memo_get_val n (memo_get _ n l). Theorem dmemo_get_correct: forall n, dmemo_get n dmemo_list = f n. Proof. intros n; unfold dmemo_get, dmemo_list. rewrite (memo_get_correct memo_val mf n); simpl. case (is_eq n n); simpl; auto; intros e. assert (e = eq_refl n). - apply eq_proofs_unicity. induction x as [| x Hx]; destruct y as [| y]. + left; auto. + right; intros HH; discriminate HH. + right; intros HH; discriminate HH. + case (Hx y). * intros HH; left; case HH; auto. * intros HH; right; intros HH1; case HH. injection HH1; auto. - rewrite H; auto. Qed. (** Finally, a version with both dependency and iterator *) Variable g: forall n, A n -> A (S n). Hypothesis Hg_correct: forall n, f (S n) = g n (f n). Let mg v := match v with memo_mval n1 v1 => memo_mval (S n1) (g n1 v1) end. Definition dimemo_list := imemo_list _ mf mg. Theorem dimemo_get_correct: forall n, dmemo_get n dimemo_list = f n. Proof. intros n; unfold dmemo_get, dimemo_list. rewrite (imemo_get_correct memo_val mf mg); simpl. - case (is_eq n n); simpl; auto; intros e. assert (e = eq_refl n). + apply eq_proofs_unicity. induction x as [| x Hx]; destruct y as [| y]. * left; auto. * right; intros HH; discriminate HH. * right; intros HH; discriminate HH. * case (Hx y). -- intros HH; left; case HH; auto. -- intros HH; right; intros HH1; case HH. injection HH1; auto. + rewrite H; auto. - intros n1; unfold mf; rewrite Hg_correct; auto. Qed. End DependentMemoFunction. (** An example with the memo function on factorial *) (* Require Import ZArith. Open Scope Z_scope. Fixpoint tfact (n: nat) := match n with | O => 1 | S n1 => Z.of_nat n * tfact n1 end. Definition lfact_list := dimemo_list _ tfact (fun n z => (Z.of_nat (S n) * z)). Definition lfact n := dmemo_get _ tfact n lfact_list. Theorem lfact_correct n: lfact n = tfact n. Proof. intros n; unfold lfact, lfact_list. rewrite dimemo_get_correct; auto. Qed. Fixpoint nop p := match p with | xH => 0 | xI p1 => nop p1 | xO p1 => nop p1 end. Fixpoint test z := match z with | Z0 => 0 | Zpos p1 => nop p1 | Zneg p1 => nop p1 end. Time Eval vm_compute in test (lfact 2000). Time Eval vm_compute in test (lfact 2000). Time Eval vm_compute in test (lfact 1500). Time Eval vm_compute in (lfact 1500). *) coq-8.20.0/theories/Lists/Streams.v000066400000000000000000000137561466560755400171460ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* Stream A -> Stream A. Section Streams. Variable A : Type. Notation Stream := (Stream A). Definition hd (x:Stream) := match x with | Cons a _ => a end. Definition tl (x:Stream) := match x with | Cons _ s => s end. Fixpoint Str_nth_tl (n:nat) (s:Stream) : Stream := match n with | O => s | S m => Str_nth_tl m (tl s) end. Definition Str_nth (n:nat) (s:Stream) : A := hd (Str_nth_tl n s). Lemma unfold_Stream : forall x:Stream, x = match x with | Cons a s => Cons a s end. Proof. intro x. case x. trivial. Qed. Lemma tl_nth_tl : forall (n:nat) (s:Stream), tl (Str_nth_tl n s) = Str_nth_tl n (tl s). Proof. simple induction n; simpl; auto. Qed. #[local] Hint Resolve tl_nth_tl: datatypes. Lemma Str_nth_tl_plus : forall (n m:nat) (s:Stream), Str_nth_tl n (Str_nth_tl m s) = Str_nth_tl (n + m) s. simple induction n; simpl; intros; auto with datatypes. rewrite <- H. rewrite tl_nth_tl; trivial with datatypes. Qed. Lemma Str_nth_plus : forall (n m:nat) (s:Stream), Str_nth n (Str_nth_tl m s) = Str_nth (n + m) s. intros; unfold Str_nth; rewrite Str_nth_tl_plus; trivial with datatypes. Qed. (** Extensional Equality between two streams *) CoInductive EqSt (s1 s2: Stream) : Prop := eqst : hd s1 = hd s2 -> EqSt (tl s1) (tl s2) -> EqSt s1 s2. (** A coinduction principle *) Ltac coinduction proof := cofix proof; intros; constructor; [ clear proof | try (apply proof; clear proof) ]. (** Extensional equality is an equivalence relation *) Theorem EqSt_reflex : forall s:Stream, EqSt s s. coinduction EqSt_reflex. reflexivity. Qed. Theorem sym_EqSt : forall s1 s2:Stream, EqSt s1 s2 -> EqSt s2 s1. coinduction Eq_sym. + case H; intros; symmetry ; assumption. + case H; intros; assumption. Qed. Theorem trans_EqSt : forall s1 s2 s3:Stream, EqSt s1 s2 -> EqSt s2 s3 -> EqSt s1 s3. coinduction Eq_trans. - transitivity (hd s2). + case H; intros; assumption. + case H0; intros; assumption. - apply (Eq_trans (tl s1) (tl s2) (tl s3)). + case H; trivial with datatypes. + case H0; trivial with datatypes. Qed. (** The definition given is equivalent to require the elements at each position to be equal *) Theorem eqst_ntheq : forall (n:nat) (s1 s2:Stream), EqSt s1 s2 -> Str_nth n s1 = Str_nth n s2. unfold Str_nth; simple induction n. - intros s1 s2 H; case H; trivial with datatypes. - intros m hypind. simpl. intros s1 s2 H. apply hypind. case H; trivial with datatypes. Qed. Theorem ntheq_eqst : forall s1 s2:Stream, (forall n:nat, Str_nth n s1 = Str_nth n s2) -> EqSt s1 s2. coinduction Equiv2. - apply (H 0). - intros n; apply (H (S n)). Qed. Section Stream_Properties. Variable P : Stream -> Prop. (*i Inductive Exists : Stream -> Prop := | Here : forall x:Stream, P x -> Exists x | Further : forall x:Stream, ~ P x -> Exists (tl x) -> Exists x. i*) Inductive Exists ( x: Stream ) : Prop := | Here : P x -> Exists x | Further : Exists (tl x) -> Exists x. CoInductive ForAll (x: Stream) : Prop := HereAndFurther : P x -> ForAll (tl x) -> ForAll x. Lemma ForAll_Str_nth_tl : forall m x, ForAll x -> ForAll (Str_nth_tl m x). Proof. induction m. - tauto. - intros x [_ H]. simpl. apply IHm. assumption. Qed. Section Co_Induction_ForAll. Variable Inv : Stream -> Prop. Hypothesis InvThenP : forall x:Stream, Inv x -> P x. Hypothesis InvIsStable : forall x:Stream, Inv x -> Inv (tl x). Theorem ForAll_coind : forall x:Stream, Inv x -> ForAll x. coinduction ForAll_coind; auto. Qed. End Co_Induction_ForAll. End Stream_Properties. End Streams. Section Map. Variables A B : Type. Variable f : A -> B. CoFixpoint map (s:Stream A) : Stream B := Cons (f (hd s)) (map (tl s)). Lemma Str_nth_tl_map : forall n s, Str_nth_tl n (map s)= map (Str_nth_tl n s). Proof. induction n. - reflexivity. - simpl. intros s. apply IHn. Qed. Lemma Str_nth_map : forall n s, Str_nth n (map s)= f (Str_nth n s). Proof. intros n s. unfold Str_nth. rewrite Str_nth_tl_map. reflexivity. Qed. Lemma ForAll_map : forall (P:Stream B -> Prop) (S:Stream A), ForAll (fun s => P (map s)) S <-> ForAll P (map S). Proof. intros P S. split; generalize S; clear S; cofix ForAll_map; intros S; constructor; destruct H as [H0 H]; firstorder. Qed. Lemma Exists_map : forall (P:Stream B -> Prop) (S:Stream A), Exists (fun s => P (map s)) S -> Exists P (map S). Proof. intros P S H. (induction H;[left|right]); firstorder. Defined. End Map. Section Constant_Stream. Variable A : Type. Variable a : A. CoFixpoint const : Stream A := Cons a const. End Constant_Stream. Section Zip. Variable A B C : Type. Variable f: A -> B -> C. CoFixpoint zipWith (a:Stream A) (b:Stream B) : Stream C := Cons (f (hd a) (hd b)) (zipWith (tl a) (tl b)). Lemma Str_nth_tl_zipWith : forall n (a:Stream A) (b:Stream B), Str_nth_tl n (zipWith a b)= zipWith (Str_nth_tl n a) (Str_nth_tl n b). Proof. induction n. - reflexivity. - intros [x xs] [y ys]. unfold Str_nth in *. simpl in *. apply IHn. Qed. Lemma Str_nth_zipWith : forall n (a:Stream A) (b:Stream B), Str_nth n (zipWith a b)= f (Str_nth n a) (Str_nth n b). Proof. intros. unfold Str_nth. rewrite Str_nth_tl_zipWith. reflexivity. Qed. End Zip. Unset Implicit Arguments. coq-8.20.0/theories/Logic/000077500000000000000000000000001466560755400152645ustar00rootroot00000000000000coq-8.20.0/theories/Logic/Adjointification.v000066400000000000000000000105221466560755400207310ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* A} (H : forall a, f a = a) {x y : A} (p : x = y) : eq_trans (H x) p = eq_trans (f_equal f p) (H y) := match p in (_ = y) return eq_trans (H x) p = eq_trans (f_equal f p) (H y) with eq_refl => eq_sym (eq_trans_refl_l (H x)) end. End lemmas. Section adjointify. Context {A B} (f : A -> B) (g : B -> A). (** One adjoint equation implies the other *) Section g_adjoint. Context (gf_id : forall a, g (f a) = a) (fg_id : forall b, f (g b) = b). Definition f_adjoint_gives_g_adjoint_pointwise (b : B) (f_adjoint_at_gb : fg_id (f (g b)) = f_equal f (gf_id (g b))) : gf_id (g b) = f_equal g (fg_id b) := let precomposed_eq : eq_trans (f_equal (fun a => g (f a)) (f_equal g (fg_id b))) (gf_id (g b)) = eq_trans (f_equal g (f_equal (fun b => f (g b)) (fg_id b))) (f_equal g (fg_id b)) := eq_trans (eq_sym (commute_homotopy_id gf_id (f_equal g (fg_id b)))) (eq_rect (f_equal g (fg_id (f (g b)))) (fun p => eq_trans p _ = _) (eq_trans (eq_trans (eq_sym (eq_trans_map_distr g _ _)) (f_equal (fun p => f_equal g p) (commute_homotopy_id fg_id (fg_id b)))) (eq_trans_map_distr g _ _)) _ (eq_trans (eq_trans (f_equal (fun p => f_equal g p) f_adjoint_at_gb) (f_equal_compose f g _)) (eq_id_comm_r _ gf_id (g b)))) in match fg_id b as p return forall p1 p2, eq_trans (f_equal _ (f_equal g p)) p1 = eq_trans (f_equal g (f_equal _ p)) p2 -> p1 = p2 with eq_refl => fun p1 p2 eq => eq_trans (eq_trans (eq_sym (eq_trans_refl_l _)) eq) (eq_trans_refl_l _) end (gf_id (g b)) (f_equal g (fg_id b)) precomposed_eq. (** We can flip an adjoint equivalence around without changing the proofs. *) Definition f_adjoint_gives_g_adjoint (f_adjoint : forall a, fg_id (f a) = f_equal f (gf_id a)) (b : B) : gf_id (g b) = f_equal g (fg_id b) := f_adjoint_gives_g_adjoint_pointwise b (f_adjoint (g b)). End g_adjoint. Section correction. Context (gf_id : forall a, g (f a) = a) (fg_id : forall b, f (g b) = b). (** Modifies the proof of (f (g b) = b) to be adjoint *) Definition fg_id' b : f (g b) = b := eq_trans (eq_sym (fg_id (f (g b)))) (eq_trans (f_equal f (gf_id (g b))) (fg_id b)). (** The main lemma: *) Definition f_adjoint a : fg_id' (f a) = f_equal f (gf_id a) := let symmetric_eq : eq_trans (f_equal f (gf_id (g (f a)))) (fg_id (f a)) = eq_trans (fg_id (f (g (f a)))) (f_equal f (gf_id a)) := eq_trans (eq_trans (f_equal (fun H => eq_trans (f_equal f H) (fg_id (f a))) (eq_sym (eq_id_comm_r _ gf_id a))) (f_equal (fun p => eq_trans p _) (eq_trans (f_equal_compose (fun a => g (f a)) f _) (eq_sym (f_equal_compose f (fun b => f (g b)) _))))) (eq_sym (commute_homotopy_id fg_id (f_equal f (gf_id a)))) in match fg_id (f (g (f a))) as p return forall p', _ = eq_trans p p' -> eq_trans (eq_sym p) _ = p' with eq_refl => fun p' eq => eq_trans (eq_trans_refl_l _) (eq_trans eq (eq_trans_refl_l _)) end _ symmetric_eq. (** And the symmetric version. Note that we use the same proofs of inverse. *) Definition g_adjoint : forall b, gf_id (g b) = f_equal g (fg_id' b) := f_adjoint_gives_g_adjoint gf_id fg_id' f_adjoint. End correction. End adjointify. coq-8.20.0/theories/Logic/Berardi.v000066400000000000000000000105301466560755400170220ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* > *) Set Implicit Arguments. Section Berardis_paradox. (** Excluded middle *) Hypothesis EM : forall P:Prop, P \/ ~ P. (** Conditional on any proposition. *) Definition IFProp (P B:Prop) (e1 e2:P) := match EM B with | or_introl _ => e1 | or_intror _ => e2 end. (** Axiom of choice applied to disjunction. Provable in Coq because of dependent elimination. *) Lemma AC_IF : forall (P B:Prop) (e1 e2:P) (Q:P -> Prop), (B -> Q e1) -> (~ B -> Q e2) -> Q (IFProp B e1 e2). Proof. intros P B e1 e2 Q p1 p2. unfold IFProp. case (EM B); assumption. Qed. (** We assume a type with two elements. They play the role of booleans. The main theorem under the current assumptions is that [T=F] *) Variable Bool : Prop. Variable T : Bool. Variable F : Bool. (** The powerset operator *) Definition pow (P:Prop) := P -> Bool. (** A piece of theory about retracts *) Section Retracts. Variables A B : Prop. Record retract : Prop := {i : A -> B; j : B -> A; inv : forall a:A, j (i a) = a}. Record retract_cond : Prop := {i2 : A -> B; j2 : B -> A; inv2 : retract -> forall a:A, j2 (i2 a) = a}. (** The dependent elimination above implies the axiom of choice: *) Lemma AC : forall r:retract_cond, retract -> forall a:A, j2 r (i2 r a) = a. Proof. intros r. exact (inv2 r). Qed. End Retracts. (** This lemma is basically a commutation of implication and existential quantification: (EX x | A -> P(x)) <=> (A -> EX x | P(x)) which is provable in classical logic ( => is already provable in intuitionistic logic). *) Lemma L1 : forall A B:Prop, retract_cond (pow A) (pow B). Proof. intros A B. destruct (EM (retract (pow A) (pow B))) as [(f0,g0,e) | hf]. - exists f0 g0; trivial. - exists (fun (x:pow A) (y:B) => F) (fun (x:pow B) (y:A) => F); intros; destruct hf; auto. Qed. (** The paradoxical set *) Definition U := forall P:Prop, pow P. (** Bijection between [U] and [(pow U)] *) Definition f (u:U) : pow U := u U. Definition g (h:pow U) : U := fun X => let lX := j2 (L1 X U) in let rU := i2 (L1 U U) in lX (rU h). (** We deduce that the powerset of [U] is a retract of [U]. This lemma is stated in Berardi's article, but is not used afterwards. *) Lemma retract_pow_U_U : retract (pow U) U. Proof. exists g f. intro a. unfold f, g; simpl. apply AC. exists (fun x:pow U => x) (fun x:pow U => x). trivial. Qed. (** Encoding of Russel's paradox *) (** The boolean negation. *) Definition Not_b (b:Bool) := IFProp (b = T) F T. (** the set of elements not belonging to itself *) Definition R : U := g (fun u:U => Not_b (u U u)). Lemma not_has_fixpoint : R R = Not_b (R R). Proof. unfold R at 1. unfold g. rewrite AC. - trivial. - exists (fun x:pow U => x) (fun x:pow U => x). trivial. Qed. Theorem classical_proof_irrelevance : T = F. Proof. generalize not_has_fixpoint. unfold Not_b. apply AC_IF. - intros is_true is_false. elim is_true; elim is_false; trivial. - intros not_true is_true. elim not_true; trivial. Qed. #[deprecated(since = "8.8", note = "Use classical_proof_irrelevance instead.")] Notation classical_proof_irrelevence := classical_proof_irrelevance. End Berardis_paradox. coq-8.20.0/theories/Logic/ChoiceFacts.v000066400000000000000000001373031466560755400176350ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* Prop. (** ** Constructive choice and description *) (** AC_rel = relational form of the (non extensional) axiom of choice (a "set-theoretic" axiom of choice) *) Definition RelationalChoice_on := forall R:A->B->Prop, (forall x : A, exists y : B, R x y) -> (exists R' : A->B->Prop, subrelation R' R /\ forall x, exists! y, R' x y). (** AC_fun = functional form of the (non extensional) axiom of choice (a "type-theoretic" axiom of choice) *) (* Note: This is called Type-Theoretic Description Axiom (TTDA) in [[Werner97]] (using a non-standard meaning of "description"). This is called intensional axiom of choice (AC_int) in [[Carlström04]] *) Definition FunctionalChoice_on_rel (R:A->B->Prop) := (forall x:A, exists y : B, R x y) -> exists f : A -> B, (forall x:A, R x (f x)). Definition FunctionalChoice_on := forall R:A->B->Prop, (forall x : A, exists y : B, R x y) -> (exists f : A->B, forall x : A, R x (f x)). (** AC_fun_dep = functional form of the (non extensional) axiom of choice, with dependent functions *) Definition DependentFunctionalChoice_on (A:Type) (B:A -> Type) := forall R:forall x:A, B x -> Prop, (forall x:A, exists y : B x, R x y) -> (exists f : (forall x:A, B x), forall x:A, R x (f x)). (** AC_trunc = axiom of choice for propositional truncations (truncation and quantification commute) *) Definition InhabitedForallCommute_on (A : Type) (B : A -> Type) := (forall x, inhabited (B x)) -> inhabited (forall x, B x). (** DC_fun = functional form of the dependent axiom of choice *) Definition FunctionalDependentChoice_on := forall (R:A->A->Prop), (forall x, exists y, R x y) -> forall x0, (exists f : nat -> A, f 0 = x0 /\ forall n, R (f n) (f (S n))). (** ACw_fun = functional form of the countable axiom of choice *) Definition FunctionalCountableChoice_on := forall (R:nat->A->Prop), (forall n, exists y, R n y) -> (exists f : nat -> A, forall n, R n (f n)). (** AC! = functional relation reification (known as axiom of unique choice in topos theory, sometimes called principle of definite description in the context of constructive type theory, sometimes called axiom of no choice) *) Definition FunctionalRelReification_on := forall R:A->B->Prop, (forall x : A, exists! y : B, R x y) -> (exists f : A->B, forall x : A, R x (f x)). (** AC_dep! = functional relation reification, with dependent functions see AC! *) Definition DependentFunctionalRelReification_on (A:Type) (B:A -> Type) := forall (R:forall x:A, B x -> Prop), (forall x:A, exists! y : B x, R x y) -> (exists f : (forall x:A, B x), forall x:A, R x (f x)). (** AC_fun_repr = functional choice of a representative in an equivalence class *) (* Note: This is called Type-Theoretic Choice Axiom (TTCA) in [[Werner97]] (by reference to the extensional set-theoretic formulation of choice); Note also a typo in its intended formulation in [[Werner97]]. *) Definition RepresentativeFunctionalChoice_on := forall R:A->A->Prop, (Equivalence R) -> (exists f : A->A, forall x : A, (R x (f x)) /\ forall x', R x x' -> f x = f x'). (** AC_fun_setoid = functional form of the (so-called extensional) axiom of choice from setoids *) Definition SetoidFunctionalChoice_on := forall R : A -> A -> Prop, forall T : A -> B -> Prop, Equivalence R -> (forall x x' y, R x x' -> T x y -> T x' y) -> (forall x, exists y, T x y) -> exists f : A -> B, forall x : A, T x (f x) /\ (forall x' : A, R x x' -> f x = f x'). (** AC_fun_setoid_gen = functional form of the general form of the (so-called extensional) axiom of choice over setoids *) (* Note: This is called extensional axiom of choice (AC_ext) in [[Carlström04]]. *) Definition GeneralizedSetoidFunctionalChoice_on := forall R : A -> A -> Prop, forall S : B -> B -> Prop, forall T : A -> B -> Prop, Equivalence R -> Equivalence S -> (forall x x' y y', R x x' -> S y y' -> T x y -> T x' y') -> (forall x, exists y, T x y) -> exists f : A -> B, forall x : A, T x (f x) /\ (forall x' : A, R x x' -> S (f x) (f x')). (** AC_fun_setoid_simple = functional form of the (so-called extensional) axiom of choice from setoids on locally compatible relations *) Definition SimpleSetoidFunctionalChoice_on A B := forall R : A -> A -> Prop, forall T : A -> B -> Prop, Equivalence R -> (forall x, exists y, forall x', R x x' -> T x' y) -> exists f : A -> B, forall x : A, T x (f x) /\ (forall x' : A, R x x' -> f x = f x'). (** ID_epsilon = constructive version of indefinite description; combined with proof-irrelevance, it may be connected to Carlström's type theory with a constructive indefinite description operator *) Definition ConstructiveIndefiniteDescription_on := forall P:A->Prop, (exists x, P x) -> { x:A | P x }. (** ID_iota = constructive version of definite description; combined with proof-irrelevance, it may be connected to Carlström's and Stenlund's type theory with a constructive definite description operator) *) Definition ConstructiveDefiniteDescription_on := forall P:A->Prop, (exists! x, P x) -> { x:A | P x }. (** ** Weakly classical choice and description *) (** GAC_rel = guarded relational form of the (non extensional) axiom of choice *) Definition GuardedRelationalChoice_on := forall P : A->Prop, forall R : A->B->Prop, (forall x : A, P x -> exists y : B, R x y) -> (exists R' : A->B->Prop, subrelation R' R /\ forall x, P x -> exists! y, R' x y). (** GAC_fun = guarded functional form of the (non extensional) axiom of choice *) Definition GuardedFunctionalChoice_on := forall P : A->Prop, forall R : A->B->Prop, inhabited B -> (forall x : A, P x -> exists y : B, R x y) -> (exists f : A->B, forall x, P x -> R x (f x)). (** GAC! = guarded functional relation reification *) Definition GuardedFunctionalRelReification_on := forall P : A->Prop, forall R : A->B->Prop, inhabited B -> (forall x : A, P x -> exists! y : B, R x y) -> (exists f : A->B, forall x : A, P x -> R x (f x)). (** OAC_rel = "omniscient" relational form of the (non extensional) axiom of choice *) Definition OmniscientRelationalChoice_on := forall R : A->B->Prop, exists R' : A->B->Prop, subrelation R' R /\ forall x : A, (exists y : B, R x y) -> exists! y, R' x y. (** OAC_fun = "omniscient" functional form of the (non extensional) axiom of choice (called AC* in Bell [[Bell]]) *) Definition OmniscientFunctionalChoice_on := forall R : A->B->Prop, inhabited B -> exists f : A->B, forall x : A, (exists y : B, R x y) -> R x (f x). (** D_epsilon = (weakly classical) indefinite description principle *) Definition EpsilonStatement_on := forall P:A->Prop, inhabited A -> { x:A | (exists x, P x) -> P x }. (** D_iota = (weakly classical) definite description principle *) Definition IotaStatement_on := forall P:A->Prop, inhabited A -> { x:A | (exists! x, P x) -> P x }. End ChoiceSchemes. (** Generalized schemes *) Notation RelationalChoice := (forall A B : Type, RelationalChoice_on A B). Notation FunctionalChoice := (forall A B : Type, FunctionalChoice_on A B). Notation DependentFunctionalChoice := (forall A (B:A->Type), DependentFunctionalChoice_on B). Notation InhabitedForallCommute := (forall A (B : A -> Type), InhabitedForallCommute_on B). Notation FunctionalDependentChoice := (forall A : Type, FunctionalDependentChoice_on A). Notation FunctionalCountableChoice := (forall A : Type, FunctionalCountableChoice_on A). Notation FunctionalChoiceOnInhabitedSet := (forall A B : Type, inhabited B -> FunctionalChoice_on A B). Notation FunctionalRelReification := (forall A B : Type, FunctionalRelReification_on A B). Notation DependentFunctionalRelReification := (forall A (B:A->Type), DependentFunctionalRelReification_on B). Notation RepresentativeFunctionalChoice := (forall A : Type, RepresentativeFunctionalChoice_on A). Notation SetoidFunctionalChoice := (forall A B: Type, SetoidFunctionalChoice_on A B). Notation GeneralizedSetoidFunctionalChoice := (forall A B : Type, GeneralizedSetoidFunctionalChoice_on A B). Notation SimpleSetoidFunctionalChoice := (forall A B : Type, SimpleSetoidFunctionalChoice_on A B). Notation GuardedRelationalChoice := (forall A B : Type, GuardedRelationalChoice_on A B). Notation GuardedFunctionalChoice := (forall A B : Type, GuardedFunctionalChoice_on A B). Notation GuardedFunctionalRelReification := (forall A B : Type, GuardedFunctionalRelReification_on A B). Notation OmniscientRelationalChoice := (forall A B : Type, OmniscientRelationalChoice_on A B). Notation OmniscientFunctionalChoice := (forall A B : Type, OmniscientFunctionalChoice_on A B). Notation ConstructiveDefiniteDescription := (forall A : Type, ConstructiveDefiniteDescription_on A). Notation ConstructiveIndefiniteDescription := (forall A : Type, ConstructiveIndefiniteDescription_on A). Notation IotaStatement := (forall A : Type, IotaStatement_on A). Notation EpsilonStatement := (forall A : Type, EpsilonStatement_on A). (** Subclassical schemes *) (** PI = proof irrelevance *) Definition ProofIrrelevance := forall (A:Prop) (a1 a2:A), a1 = a2. (** IGP = independence of general premises (an unconstrained generalisation of the constructive principle of independence of premises) *) Definition IndependenceOfGeneralPremises := forall (A:Type) (P:A -> Prop) (Q:Prop), inhabited A -> (Q -> exists x, P x) -> exists x, Q -> P x. (** Drinker = drinker's paradox (small form) (called Ex in Bell [[Bell]]) *) Definition SmallDrinker'sParadox := forall (A:Type) (P:A -> Prop), inhabited A -> exists x, (exists x, P x) -> P x. (** EM = excluded-middle *) Definition ExcludedMiddle := forall P:Prop, P \/ ~ P. (** Extensional schemes *) (** Ext_prop_repr = choice of a representative among extensional propositions *) Local Notation ExtensionalPropositionRepresentative := (forall (A:Type), exists h : Prop -> Prop, forall P : Prop, (P <-> h P) /\ forall Q, (P <-> Q) -> h P = h Q). (** Ext_pred_repr = choice of a representative among extensional predicates *) Local Notation ExtensionalPredicateRepresentative := (forall (A:Type), exists h : (A->Prop) -> (A->Prop), forall (P : A -> Prop), (forall x, P x <-> h P x) /\ forall Q, (forall x, P x <-> Q x) -> h P = h Q). (** Ext_fun_repr = choice of a representative among extensional functions *) Local Notation ExtensionalFunctionRepresentative := (forall (A B:Type), exists h : (A->B) -> (A->B), forall (f : A -> B), (forall x, f x = h f x) /\ forall g, (forall x, f x = g x) -> h f = h g). (** We let also - IPL_2 = 2nd-order impredicative minimal predicate logic (with ex. quant.) - IPL^2 = 2nd-order functional minimal predicate logic (with ex. quant.) - IPL_2^2 = 2nd-order impredicative, 2nd-order functional minimal pred. logic (with ex. quant.) with no prerequisite on the non-emptiness of domains *) (**********************************************************************) (** * Table of contents *) (* This is very fragile. *) (** 1. Definitions 2. IPL_2^2 |- AC_rel + AC! = AC_fun 3.1. typed IPL_2 + Sigma-types + PI |- AC_rel = GAC_rel and IPL_2 |- AC_rel + IGP -> GAC_rel and IPL_2 |- GAC_rel = OAC_rel 3.2. IPL^2 |- AC_fun + IGP = GAC_fun = OAC_fun = AC_fun + Drinker 3.3. D_iota -> ID_iota and D_epsilon <-> ID_epsilon + Drinker 4. Derivability of choice for decidable relations with well-ordered codomain 5. AC_fun = AC_fun_dep = AC_trunc 6. Non contradiction of constructive descriptions wrt functional choices 7. Definite description transports classical logic to the computational world 8. Choice -> Dependent choice -> Countable choice 9.1. AC_fun_setoid = AC_fun + Ext_fun_repr + EM 9.2. AC_fun_setoid = AC_fun + Ext_pred_repr + PI *) (**********************************************************************) (** * AC_rel + AC! = AC_fun We show that the functional formulation of the axiom of Choice (usual formulation in type theory) is equivalent to its relational formulation (only formulation of set theory) + functional relation reification (aka axiom of unique choice, or, principle of (parametric) definite descriptions) *) (** This shows that the axiom of choice can be assumed (under its relational formulation) without known inconsistency with classical logic, though functional relation reification conflicts with classical logic *) Lemma functional_rel_reification_and_rel_choice_imp_fun_choice : forall A B : Type, FunctionalRelReification_on A B -> RelationalChoice_on A B -> FunctionalChoice_on A B. Proof. intros A B Descr RelCh R H. destruct (RelCh R H) as (R',(HR'R,H0)). destruct (Descr R') as (f,Hf). - firstorder. - exists f; intro x. destruct (H0 x) as (y,(HR'xy,Huniq)). rewrite <- (Huniq (f x) (Hf x)). apply HR'R; assumption. Qed. Lemma fun_choice_imp_rel_choice : forall A B : Type, FunctionalChoice_on A B -> RelationalChoice_on A B. Proof. intros A B FunCh R H. destruct (FunCh R H) as (f,H0). exists (fun x y => f x = y). split. - intros x y Heq; rewrite <- Heq; trivial. - intro x; exists (f x); split. + reflexivity. + trivial. Qed. Lemma fun_choice_imp_functional_rel_reification : forall A B : Type, FunctionalChoice_on A B -> FunctionalRelReification_on A B. Proof. intros A B FunCh R H. destruct (FunCh R) as [f H0]. - (* 1 *) intro x. destruct (H x) as (y,(HRxy,_)). exists y; exact HRxy. - (* 2 *) exists f; exact H0. Qed. Corollary fun_choice_iff_rel_choice_and_functional_rel_reification : forall A B : Type, FunctionalChoice_on A B <-> RelationalChoice_on A B /\ FunctionalRelReification_on A B. Proof. intros A B. split. - intro H; split; [ exact (fun_choice_imp_rel_choice H) | exact (fun_choice_imp_functional_rel_reification H) ]. - intros [H H0]; exact (functional_rel_reification_and_rel_choice_imp_fun_choice H0 H). Qed. (**********************************************************************) (** * Connection between the guarded, non guarded and omniscient choices *) (** We show that the guarded formulations of the axiom of choice are equivalent to their "omniscient" variant and comes from the non guarded formulation in presence either of the independence of general premises or subset types (themselves derivable from subtypes thanks to proof- irrelevance) *) (**********************************************************************) (** ** AC_rel + PI -> GAC_rel and AC_rel + IGP -> GAC_rel and GAC_rel = OAC_rel *) Lemma rel_choice_and_proof_irrel_imp_guarded_rel_choice : RelationalChoice -> ProofIrrelevance -> GuardedRelationalChoice. Proof. intros rel_choice proof_irrel. red; intros A B P R H. destruct (rel_choice _ _ (fun (x:sigT P) (y:B) => R (projT1 x) y)) as (R',(HR'R,H0)). - intros (x,HPx). destruct (H x HPx) as (y,HRxy). exists y; exact HRxy. - set (R'' := fun (x:A) (y:B) => exists H : P x, R' (existT P x H) y). exists R''; split. + intros x y (HPx,HR'xy). change x with (projT1 (existT P x HPx)); apply HR'R; exact HR'xy. + intros x HPx. destruct (H0 (existT P x HPx)) as (y,(HR'xy,Huniq)). exists y; split. * exists HPx; exact HR'xy. * intros y' (H'Px,HR'xy'). apply Huniq. rewrite proof_irrel with (a1 := HPx) (a2 := H'Px); exact HR'xy'. Qed. Lemma rel_choice_indep_of_general_premises_imp_guarded_rel_choice : forall A B : Type, inhabited B -> RelationalChoice_on A B -> IndependenceOfGeneralPremises -> GuardedRelationalChoice_on A B. Proof. intros A B Inh AC_rel IndPrem P R H. destruct (AC_rel (fun x y => P x -> R x y)) as (R',(HR'R,H0)). - intro x. apply IndPrem. + exact Inh. + intro Hx. apply H; assumption. - exists (fun x y => P x /\ R' x y). firstorder. Qed. Lemma guarded_rel_choice_imp_rel_choice : forall A B : Type, GuardedRelationalChoice_on A B -> RelationalChoice_on A B. Proof. intros A B GAC_rel R H. destruct (GAC_rel (fun _ => True) R) as (R',(HR'R,H0)). - firstorder. - exists R'; firstorder. Qed. Lemma subset_types_imp_guarded_rel_choice_iff_rel_choice : ProofIrrelevance -> (GuardedRelationalChoice <-> RelationalChoice). Proof. intuition auto using guarded_rel_choice_imp_rel_choice, rel_choice_and_proof_irrel_imp_guarded_rel_choice. Qed. (** OAC_rel = GAC_rel *) Corollary guarded_iff_omniscient_rel_choice : GuardedRelationalChoice <-> OmniscientRelationalChoice. Proof. split. - intros GAC_rel A B R. apply (GAC_rel A B (fun x => exists y, R x y) R); auto. - intros OAC_rel A B P R H. destruct (OAC_rel A B R) as (f,Hf); exists f; firstorder. Qed. (**********************************************************************) (** ** AC_fun + IGP = GAC_fun = OAC_fun = AC_fun + Drinker *) (** AC_fun + IGP = GAC_fun *) Lemma guarded_fun_choice_imp_indep_of_general_premises : GuardedFunctionalChoice -> IndependenceOfGeneralPremises. Proof. intros GAC_fun A P Q Inh H. destruct (GAC_fun unit A (fun _ => Q) (fun _ => P) Inh) as (f,Hf). - tauto. - exists (f tt); auto. Qed. Lemma guarded_fun_choice_imp_fun_choice : GuardedFunctionalChoice -> FunctionalChoiceOnInhabitedSet. Proof. intros GAC_fun A B Inh R H. destruct (GAC_fun A B (fun _ => True) R Inh) as (f,Hf). - firstorder. - exists f; auto. Qed. Lemma fun_choice_and_indep_general_prem_imp_guarded_fun_choice : FunctionalChoiceOnInhabitedSet -> IndependenceOfGeneralPremises -> GuardedFunctionalChoice. Proof. intros AC_fun IndPrem A B P R Inh H. apply (AC_fun A B Inh (fun x y => P x -> R x y)). intro x; apply IndPrem; eauto. Qed. Corollary fun_choice_and_indep_general_prem_iff_guarded_fun_choice : FunctionalChoiceOnInhabitedSet /\ IndependenceOfGeneralPremises <-> GuardedFunctionalChoice. Proof. intuition auto using guarded_fun_choice_imp_indep_of_general_premises, guarded_fun_choice_imp_fun_choice, fun_choice_and_indep_general_prem_imp_guarded_fun_choice. Qed. (** AC_fun + Drinker = OAC_fun *) (** This was already observed by Bell [[Bell]] *) Lemma omniscient_fun_choice_imp_small_drinker : OmniscientFunctionalChoice -> SmallDrinker'sParadox. Proof. intros OAC_fun A P Inh. destruct (OAC_fun unit A (fun _ => P)) as (f,Hf). - auto. - exists (f tt); firstorder. Qed. Lemma omniscient_fun_choice_imp_fun_choice : OmniscientFunctionalChoice -> FunctionalChoiceOnInhabitedSet. Proof. intros OAC_fun A B Inh R H. destruct (OAC_fun A B R Inh) as (f,Hf). exists f; firstorder. Qed. Lemma fun_choice_and_small_drinker_imp_omniscient_fun_choice : FunctionalChoiceOnInhabitedSet -> SmallDrinker'sParadox -> OmniscientFunctionalChoice. Proof. intros AC_fun Drinker A B R Inh. destruct (AC_fun A B Inh (fun x y => (exists y, R x y) -> R x y)) as (f,Hf). - intro x; apply (Drinker B (R x) Inh). - exists f; assumption. Qed. Corollary fun_choice_and_small_drinker_iff_omniscient_fun_choice : FunctionalChoiceOnInhabitedSet /\ SmallDrinker'sParadox <-> OmniscientFunctionalChoice. Proof. intuition auto using omniscient_fun_choice_imp_small_drinker, omniscient_fun_choice_imp_fun_choice, fun_choice_and_small_drinker_imp_omniscient_fun_choice. Qed. (** OAC_fun = GAC_fun *) (** This is derivable from the intuitionistic equivalence between IGP and Drinker but we give a direct proof *) Theorem guarded_iff_omniscient_fun_choice : GuardedFunctionalChoice <-> OmniscientFunctionalChoice. Proof. split. - intros GAC_fun A B R Inh. apply (GAC_fun A B (fun x => exists y, R x y) R); auto. - intros OAC_fun A B P R Inh H. destruct (OAC_fun A B R Inh) as (f,Hf). exists f; firstorder. Qed. (**********************************************************************) (** ** D_iota -> ID_iota and D_epsilon <-> ID_epsilon + Drinker *) (** D_iota -> ID_iota *) Lemma iota_imp_constructive_definite_description : IotaStatement -> ConstructiveDefiniteDescription. Proof. intros D_iota A P H. destruct D_iota with (P:=P) as (x,H1). - destruct H; red in H; auto. - exists x; apply H1; assumption. Qed. (** ID_epsilon + Drinker <-> D_epsilon *) Lemma epsilon_imp_constructive_indefinite_description: EpsilonStatement -> ConstructiveIndefiniteDescription. Proof. intros D_epsilon A P H. destruct D_epsilon with (P:=P) as (x,H1). - destruct H; auto. - exists x; apply H1; assumption. Qed. Lemma constructive_indefinite_description_and_small_drinker_imp_epsilon : SmallDrinker'sParadox -> ConstructiveIndefiniteDescription -> EpsilonStatement. Proof. intros Drinkers D_epsilon A P Inh; apply D_epsilon; apply Drinkers; assumption. Qed. Lemma epsilon_imp_small_drinker : EpsilonStatement -> SmallDrinker'sParadox. Proof. intros D_epsilon A P Inh; edestruct D_epsilon; eauto. Qed. Theorem constructive_indefinite_description_and_small_drinker_iff_epsilon : (SmallDrinker'sParadox * ConstructiveIndefiniteDescription -> EpsilonStatement) * (EpsilonStatement -> SmallDrinker'sParadox * ConstructiveIndefiniteDescription). Proof. intuition auto using epsilon_imp_constructive_indefinite_description, constructive_indefinite_description_and_small_drinker_imp_epsilon, epsilon_imp_small_drinker. Qed. (**********************************************************************) (** * Derivability of choice for decidable relations with well-ordered codomain *) (** Countable codomains, such as [nat], can be equipped with a well-order, which implies the existence of a least element on inhabited decidable subsets. As a consequence, the relational form of the axiom of choice is derivable on [nat] for decidable relations. We show instead that functional relation reification and the functional form of the axiom of choice are equivalent on decidable relations with [nat] as codomain. *) Require Import Wf_nat. Require Import Decidable. Lemma classical_denumerable_description_imp_fun_choice : forall A:Type, FunctionalRelReification_on A nat -> forall R:A->nat->Prop, (forall x y, decidable (R x y)) -> FunctionalChoice_on_rel R. Proof. intros A Descr. red; intros R Rdec H. set (R':= fun x y => R x y /\ forall y', R x y' -> y <= y'). destruct (Descr R') as (f,Hf). - intro x. apply (dec_inh_nat_subset_has_unique_least_element (R x)). + apply Rdec. + apply (H x). - exists f. intros x. destruct (Hf x) as (Hfx,_). assumption. Qed. (**********************************************************************) (** * AC_fun = AC_fun_dep = AC_trunc *) (** ** Choice on dependent and non dependent function types are equivalent *) (** The easy part *) Theorem dep_non_dep_functional_choice : DependentFunctionalChoice -> FunctionalChoice. Proof. intros AC_depfun A B R H. destruct (AC_depfun A (fun _ => B) R H) as (f,Hf). exists f; trivial. Qed. (** Deriving choice on product types requires some computation on singleton propositional types, so we need computational conjunction projections and dependent elimination of conjunction and equality *) Scheme and_indd := Induction for and Sort Prop. Scheme eq_indd := Induction for eq Sort Prop. Definition proj1_inf (A B:Prop) (p : A/\B) := let (a,b) := p in a. Theorem non_dep_dep_functional_choice : FunctionalChoice -> DependentFunctionalChoice. Proof. intros AC_fun A B R H. pose (B' := { x:A & B x }). pose (R' := fun (x:A) (y:B') => projT1 y = x /\ R (projT1 y) (projT2 y)). destruct (AC_fun A B' R') as (f,Hf). - intros x. destruct (H x) as (y,Hy). exists (existT (fun x => B x) x y). split; trivial. - exists (fun x => eq_rect _ _ (projT2 (f x)) _ (proj1_inf (Hf x))). intro x; destruct (Hf x) as (Heq,HR) using and_indd. destruct (f x); simpl in *. destruct Heq using eq_indd; trivial. Qed. (** ** Functional choice and truncation choice are equivalent *) Theorem functional_choice_to_inhabited_forall_commute : FunctionalChoice -> InhabitedForallCommute. Proof. intros choose0 A B Hinhab. pose proof (non_dep_dep_functional_choice choose0) as choose;clear choose0. assert (Hexists : forall x, exists _ : B x, True). { intros x;apply inhabited_sig_to_exists. refine (inhabited_covariant _ (Hinhab x)). intros y;exists y;exact I. } apply choose in Hexists. destruct Hexists as [f _]. exact (inhabits f). Qed. Theorem inhabited_forall_commute_to_functional_choice : InhabitedForallCommute -> FunctionalChoice. Proof. intros choose A B R Hexists. assert (Hinhab : forall x, inhabited {y : B | R x y}). { intros x;apply exists_to_inhabited_sig;trivial. } apply choose in Hinhab. destruct Hinhab as [f]. exists (fun x => proj1_sig (f x)). exact (fun x => proj2_sig (f x)). Qed. (** ** Reification of dependent and non dependent functional relation are equivalent *) (** The easy part *) Theorem dep_non_dep_functional_rel_reification : DependentFunctionalRelReification -> FunctionalRelReification. Proof. intros DepFunReify A B R H. destruct (DepFunReify A (fun _ => B) R H) as (f,Hf). exists f; trivial. Qed. (** Deriving choice on product types requires some computation on singleton propositional types, so we need computational conjunction projections and dependent elimination of conjunction and equality *) Theorem non_dep_dep_functional_rel_reification : FunctionalRelReification -> DependentFunctionalRelReification. Proof. intros AC_fun A B R H. pose (B' := { x:A & B x }). pose (R' := fun (x:A) (y:B') => projT1 y = x /\ R (projT1 y) (projT2 y)). destruct (AC_fun A B' R') as (f,Hf). - intros x. destruct (H x) as (y,(Hy,Huni)). exists (existT (fun x => B x) x y). repeat split; trivial. intros (x',y') (Heqx',Hy'). simpl in *. destruct Heqx'. rewrite (Huni y'); trivial. - exists (fun x => eq_rect _ _ (projT2 (f x)) _ (proj1_inf (Hf x))). intro x; destruct (Hf x) as (Heq,HR) using and_indd. destruct (f x); simpl in *. destruct Heq using eq_indd; trivial. Qed. Corollary dep_iff_non_dep_functional_rel_reification : FunctionalRelReification <-> DependentFunctionalRelReification. Proof. intuition auto using non_dep_dep_functional_rel_reification, dep_non_dep_functional_rel_reification. Qed. (**********************************************************************) (** * Non contradiction of constructive descriptions wrt functional axioms of choice *) (** ** Non contradiction of indefinite description *) Lemma relative_non_contradiction_of_indefinite_descr : forall C:Prop, (ConstructiveIndefiniteDescription -> C) -> (FunctionalChoice -> C). Proof. intros C H AC_fun. assert (AC_depfun := non_dep_dep_functional_choice AC_fun). pose (A0 := { A:Type & { P:A->Prop & exists x, P x }}). pose (B0 := fun x:A0 => projT1 x). pose (R0 := fun x:A0 => fun y:B0 x => projT1 (projT2 x) y). pose (H0 := fun x:A0 => projT2 (projT2 x)). destruct (AC_depfun A0 B0 R0 H0) as (f, Hf). apply H. intros A P H'. exists (f (existT _ A (existT _ P H'))). pose (Hf' := Hf (existT _ A (existT _ P H'))). assumption. Qed. Lemma constructive_indefinite_descr_fun_choice : ConstructiveIndefiniteDescription -> FunctionalChoice. Proof. intros IndefDescr A B R H. exists (fun x => proj1_sig (IndefDescr B (R x) (H x))). intro x. apply (proj2_sig (IndefDescr B (R x) (H x))). Qed. (** ** Non contradiction of definite description *) Lemma relative_non_contradiction_of_definite_descr : forall C:Prop, (ConstructiveDefiniteDescription -> C) -> (FunctionalRelReification -> C). Proof. intros C H FunReify. assert (DepFunReify := non_dep_dep_functional_rel_reification FunReify). pose (A0 := { A:Type & { P:A->Prop & exists! x, P x }}). pose (B0 := fun x:A0 => projT1 x). pose (R0 := fun x:A0 => fun y:B0 x => projT1 (projT2 x) y). pose (H0 := fun x:A0 => projT2 (projT2 x)). destruct (DepFunReify A0 B0 R0 H0) as (f, Hf). apply H. intros A P H'. exists (f (existT _ A (existT _ P H'))). pose (Hf' := Hf (existT _ A (existT _ P H'))). assumption. Qed. Lemma constructive_definite_descr_fun_reification : ConstructiveDefiniteDescription -> FunctionalRelReification. Proof. intros DefDescr A B R H. exists (fun x => proj1_sig (DefDescr B (R x) (H x))). intro x. apply (proj2_sig (DefDescr B (R x) (H x))). Qed. (** Remark, the following corollaries morally hold: Definition In_propositional_context (A:Type) := forall C:Prop, (A -> C) -> C. Corollary constructive_definite_descr_in_prop_context_iff_fun_reification : In_propositional_context ConstructiveIndefiniteDescription <-> FunctionalChoice. Corollary constructive_definite_descr_in_prop_context_iff_fun_reification : In_propositional_context ConstructiveDefiniteDescription <-> FunctionalRelReification. but expecting [FunctionalChoice] (resp. [FunctionalRelReification]) to be applied on the same Type universes on both sides of the first (resp. second) equivalence breaks the stratification of universes. *) (**********************************************************************) (** * Excluded-middle + definite description => computational excluded-middle *) (** The idea for the following proof comes from [[ChicliPottierSimpson02]] *) (** Classical logic and axiom of unique choice (i.e. functional relation reification), as shown in [[ChicliPottierSimpson02]], implies the double-negation of excluded-middle in [Set] (which is incompatible with the impredicativity of [Set]). We adapt the proof to show that constructive definite description transports excluded-middle from [Prop] to [Set]. [[ChicliPottierSimpson02]] Laurent Chicli, Loïc Pottier, Carlos Simpson, Mathematical Quotients and Quotient Types in Coq, Proceedings of TYPES 2002, Lecture Notes in Computer Science 2646, Springer Verlag. *) Require Import Setoid. Theorem constructive_definite_descr_excluded_middle : (forall A : Type, ConstructiveDefiniteDescription_on A) -> (forall P:Prop, P \/ ~ P) -> (forall P:Prop, {P} + {~ P}). Proof. intros Descr EM P. pose (select := fun b:bool => if b then P else ~P). assert { b:bool | select b } as ([|],HP). - red in Descr. apply Descr. rewrite <- unique_existence; split. + destruct (EM P). * exists true; trivial. * exists false; trivial. + intros [|] [|] H1 H2; simpl in *; reflexivity || contradiction. - left; trivial. - right; trivial. Qed. Corollary fun_reification_descr_computational_excluded_middle_in_prop_context : FunctionalRelReification -> (forall P:Prop, P \/ ~ P) -> forall C:Prop, ((forall P:Prop, {P} + {~ P}) -> C) -> C. Proof. intros FunReify EM C H. pose proof relative_non_contradiction_of_definite_descr (C:=C); intuition auto using constructive_definite_descr_excluded_middle. Qed. (**********************************************************************) (** * Choice => Dependent choice => Countable choice *) (* The implications below are standard *) Require Import Arith. Theorem functional_choice_imp_functional_dependent_choice : FunctionalChoice -> FunctionalDependentChoice. Proof. intros FunChoice A R HRfun x0. apply FunChoice in HRfun as (g,Rg). set (f:=fix f n := match n with 0 => x0 | S n' => g (f n') end). exists f; firstorder. Qed. Theorem functional_dependent_choice_imp_functional_countable_choice : FunctionalDependentChoice -> FunctionalCountableChoice. Proof. intros H A R H0. set (R' (p q:nat*A) := fst q = S (fst p) /\ R (fst p) (snd q)). destruct (H0 0) as (y0,Hy0). destruct H with (R:=R') (x0:=(0,y0)) as (f,(Hf0,HfS)). - intro x; destruct (H0 (fst x)) as (y,Hy). exists (S (fst x),y). red. auto. - assert (Heq:forall n, fst (f n) = n). + induction n. * rewrite Hf0; reflexivity. * specialize HfS with n; destruct HfS as (->,_); congruence. + exists (fun n => snd (f (S n))). intro n'. specialize HfS with n'. destruct HfS as (_,HR). rewrite Heq in HR. assumption. Qed. (**********************************************************************) (** * About the axiom of choice over setoids *) Require Import ClassicalFacts PropExtensionalityFacts. (**********************************************************************) (** ** Consequences of the choice of a representative in an equivalence class *) Theorem repr_fun_choice_imp_ext_prop_repr : RepresentativeFunctionalChoice -> ExtensionalPropositionRepresentative. Proof. intros ReprFunChoice A. pose (R P Q := P <-> Q). assert (Hequiv:Equivalence R) by (split; firstorder). apply (ReprFunChoice _ R Hequiv). Qed. Theorem repr_fun_choice_imp_ext_pred_repr : RepresentativeFunctionalChoice -> ExtensionalPredicateRepresentative. Proof. intros ReprFunChoice A. pose (R P Q := forall x : A, P x <-> Q x). assert (Hequiv:Equivalence R) by (split; firstorder). apply (ReprFunChoice _ R Hequiv). Qed. Theorem repr_fun_choice_imp_ext_function_repr : RepresentativeFunctionalChoice -> ExtensionalFunctionRepresentative. Proof. intros ReprFunChoice A B. pose (R (f g : A -> B) := forall x : A, f x = g x). assert (Hequiv:Equivalence R). { split; try easy. firstorder using eq_trans. } apply (ReprFunChoice _ R Hequiv). Qed. (** *** This is a variant of Diaconescu and Goodman-Myhill theorems *) Theorem repr_fun_choice_imp_excluded_middle : RepresentativeFunctionalChoice -> ExcludedMiddle. Proof. intros ReprFunChoice. apply representative_boolean_partition_imp_excluded_middle, ReprFunChoice. Qed. Theorem repr_fun_choice_imp_relational_choice : RepresentativeFunctionalChoice -> RelationalChoice. Proof. intros ReprFunChoice A B T Hexists. pose (D := (A*B)%type). pose (R (z z':D) := let x := fst z in let x' := fst z' in let y := snd z in let y' := snd z' in x = x' /\ (T x y -> y = y' \/ T x y') /\ (T x y' -> y = y' \/ T x y)). assert (Hequiv : Equivalence R). { split. - split. + easy. + firstorder. - intros (x,y) (x',y') (H1,(H2,H2')). split. + easy. + simpl fst in *. simpl snd in *. subst x'. split; intro H. * destruct (H2' H); firstorder. * destruct (H2 H); firstorder. - intros (x,y) (x',y') (x'',y'') (H1,(H2,H2')) (H3,(H4,H4')). simpl fst in *. simpl snd in *. subst x'' x'. split. { easy. } split; intro H. + simpl fst in *. simpl snd in *. destruct (H2 H) as [<-|H0]. * destruct (H4 H); firstorder. * destruct (H2' H0), (H4 H0); try subst y'; try subst y''; try firstorder. + simpl fst in *. simpl snd in *. destruct (H4' H) as [<-|H0]. * destruct (H2' H); firstorder. * destruct (H2' H0), (H4 H0); try subst y'; try subst y''; try firstorder. } destruct (ReprFunChoice D R Hequiv) as (g,Hg). set (T' x y := T x y /\ exists y', T x y' /\ g (x,y') = (x,y)). exists T'. split. - intros x y (H,_); easy. - intro x. destruct (Hexists x) as (y,Hy). exists (snd (g (x,y))). destruct (Hg (x,y)) as ((Heq1,(H',H'')),Hgxyuniq); clear Hg. destruct (H' Hy) as [Heq2|Hgy]; clear H'. + split;[split|]. * rewrite <- Heq2. assumption. * exists y. destruct (g (x,y)) as (x',y'). simpl in Heq1, Heq2. subst; easy. * intros y' (Hy',(y'',(Hy'',Heq))). rewrite (Hgxyuniq (x,y'')), Heq. { easy. } split. { easy. } split; right; easy. + split;[split|]. * assumption. * exists y. destruct (g (x,y)) as (x',y'). simpl in Heq1. subst x'; easy. * intros y' (Hy',(y'',(Hy'',Heq))). rewrite (Hgxyuniq (x,y'')), Heq. { easy. } split. { easy. } split; right; easy. Qed. (**********************************************************************) (** ** AC_fun_setoid = AC_fun_setoid_gen = AC_fun_setoid_simple *) Theorem gen_setoid_fun_choice_imp_setoid_fun_choice : forall A B, GeneralizedSetoidFunctionalChoice_on A B -> SetoidFunctionalChoice_on A B. Proof. intros A B GenSetoidFunChoice R T Hequiv Hcompat Hex. apply GenSetoidFunChoice; try easy. - apply eq_equivalence. - intros * H <-. firstorder. Qed. Theorem setoid_fun_choice_imp_gen_setoid_fun_choice : forall A B, SetoidFunctionalChoice_on A B -> GeneralizedSetoidFunctionalChoice_on A B. Proof. intros A B SetoidFunChoice R S T HequivR HequivS Hcompat Hex. destruct SetoidFunChoice with (R:=R) (T:=T) as (f,Hf); try easy. { intros; apply (Hcompat x x' y y); try easy. } exists f. intros x; specialize Hf with x as (Hf,Huniq). intuition. now erewrite Huniq. Qed. Corollary setoid_fun_choice_iff_gen_setoid_fun_choice : forall A B, SetoidFunctionalChoice_on A B <-> GeneralizedSetoidFunctionalChoice_on A B. Proof. split; auto using gen_setoid_fun_choice_imp_setoid_fun_choice, setoid_fun_choice_imp_gen_setoid_fun_choice. Qed. Theorem setoid_fun_choice_imp_simple_setoid_fun_choice : forall A B, SetoidFunctionalChoice_on A B -> SimpleSetoidFunctionalChoice_on A B. Proof. intros A B SetoidFunChoice R T Hequiv Hexists. pose (T' x y := forall x', R x x' -> T x' y). assert (Hcompat : forall (x x' : A) (y : B), R x x' -> T' x y -> T' x' y) by firstorder. destruct (SetoidFunChoice R T' Hequiv Hcompat Hexists) as (f,Hf). exists f. firstorder. Qed. Theorem simple_setoid_fun_choice_imp_setoid_fun_choice : forall A B, SimpleSetoidFunctionalChoice_on A B -> SetoidFunctionalChoice_on A B. Proof. intros A B SimpleSetoidFunChoice R T Hequiv Hcompat Hexists. destruct (SimpleSetoidFunChoice R T Hequiv) as (f,Hf); firstorder. Qed. Corollary setoid_fun_choice_iff_simple_setoid_fun_choice : forall A B, SetoidFunctionalChoice_on A B <-> SimpleSetoidFunctionalChoice_on A B. Proof. split; auto using simple_setoid_fun_choice_imp_setoid_fun_choice, setoid_fun_choice_imp_simple_setoid_fun_choice. Qed. (**********************************************************************) (** ** AC_fun_setoid = AC! + AC_fun_repr *) Theorem setoid_fun_choice_imp_fun_choice : forall A B, SetoidFunctionalChoice_on A B -> FunctionalChoice_on A B. Proof. intros A B SetoidFunChoice T Hexists. destruct SetoidFunChoice with (R:=@eq A) (T:=T) as (f,Hf). - apply eq_equivalence. - now intros * ->. - assumption. - exists f. firstorder. Qed. Corollary setoid_fun_choice_imp_functional_rel_reification : forall A B, SetoidFunctionalChoice_on A B -> FunctionalRelReification_on A B. Proof. intros A B SetoidFunChoice. apply fun_choice_imp_functional_rel_reification. now apply setoid_fun_choice_imp_fun_choice. Qed. Theorem setoid_fun_choice_imp_repr_fun_choice : SetoidFunctionalChoice -> RepresentativeFunctionalChoice . Proof. intros SetoidFunChoice A R Hequiv. apply SetoidFunChoice; firstorder. Qed. Theorem functional_rel_reification_and_repr_fun_choice_imp_setoid_fun_choice : FunctionalRelReification -> RepresentativeFunctionalChoice -> SetoidFunctionalChoice. Proof. intros FunRelReify ReprFunChoice A B R T Hequiv Hcompat Hexists. assert (FunChoice : FunctionalChoice). { intros A' B'. apply functional_rel_reification_and_rel_choice_imp_fun_choice. - apply FunRelReify. - now apply repr_fun_choice_imp_relational_choice. } destruct (FunChoice _ _ T Hexists) as (f,Hf). destruct (ReprFunChoice A R Hequiv) as (g,Hg). exists (fun a => f (g a)). intro x. destruct (Hg x) as (Hgx,HRuniq). split. - eapply Hcompat. + symmetry. apply Hgx. + apply Hf. - intros y Hxy. f_equal. auto. Qed. Theorem functional_rel_reification_and_repr_fun_choice_iff_setoid_fun_choice : FunctionalRelReification /\ RepresentativeFunctionalChoice <-> SetoidFunctionalChoice. Proof. split; intros. - now apply functional_rel_reification_and_repr_fun_choice_imp_setoid_fun_choice. - split. + now intros A B; apply setoid_fun_choice_imp_functional_rel_reification. + now apply setoid_fun_choice_imp_repr_fun_choice. Qed. (** Note: What characterization to give of RepresentativeFunctionalChoice? A formulation of it as a functional relation would certainly be equivalent to the formulation of SetoidFunctionalChoice as a functional relation, but in their functional forms, SetoidFunctionalChoice seems strictly stronger *) (**********************************************************************) (** * AC_fun_setoid = AC_fun + Ext_fun_repr + EM *) Import EqNotations. (** ** This is the main theorem in [[Carlström04]] *) (** Note: all ingredients have a computational meaning when taken in separation. However, to compute with the functional choice, existential quantification has to be thought as a strong existential, which is incompatible with the computational content of excluded-middle *) Theorem fun_choice_and_ext_functions_repr_and_excluded_middle_imp_setoid_fun_choice : FunctionalChoice -> ExtensionalFunctionRepresentative -> ExcludedMiddle -> RepresentativeFunctionalChoice. Proof. intros FunChoice SetoidFunRepr EM A R (Hrefl,Hsym,Htrans). assert (H:forall P:Prop, exists b, b = true <-> P). { intros P. destruct (EM P). - exists true; firstorder. - exists false; easy. } destruct (FunChoice _ _ _ H) as (c,Hc). pose (class_of a y := c (R a y)). pose (isclass f := exists x:A, f x = true). pose (class := {f:A -> bool | isclass f}). pose (contains (c:class) (a:A) := proj1_sig c a = true). destruct (FunChoice class A contains) as (f,Hf). - intros f. destruct (proj2_sig f) as (x,Hx). exists x. easy. - destruct (SetoidFunRepr A bool) as (h,Hh). assert (Hisclass:forall a, isclass (h (class_of a))). { intro a. exists a. destruct (Hh (class_of a)) as (Ha,Huniqa). rewrite <- Ha. apply Hc. apply Hrefl. } pose (f':= fun a => exist _ (h (class_of a)) (Hisclass a) : class). exists (fun a => f (f' a)). intros x. destruct (Hh (class_of x)) as (Hx,Huniqx). split. + specialize Hf with (f' x). unfold contains in Hf. simpl in Hf. rewrite <- Hx in Hf. apply Hc. assumption. + intros y Hxy. f_equal. assert (Heq1: h (class_of x) = h (class_of y)). { apply Huniqx. intro z. unfold class_of. destruct (c (R x z)) eqn:Hxz. - symmetry. apply Hc. apply -> Hc in Hxz. firstorder. - destruct (c (R y z)) eqn:Hyz. + apply -> Hc in Hyz. rewrite <- Hxz. apply Hc. firstorder. + easy. } assert (Heq2:rew Heq1 in Hisclass x = Hisclass y). { apply proof_irrelevance_cci, EM. } unfold f'. rewrite <- Heq2. rewrite <- Heq1. reflexivity. Qed. Theorem setoid_functional_choice_first_characterization : FunctionalChoice /\ ExtensionalFunctionRepresentative /\ ExcludedMiddle <-> SetoidFunctionalChoice. Proof. split. - intros (FunChoice & SetoidFunRepr & EM). apply functional_rel_reification_and_repr_fun_choice_imp_setoid_fun_choice. + intros A B. apply fun_choice_imp_functional_rel_reification, FunChoice. + now apply fun_choice_and_ext_functions_repr_and_excluded_middle_imp_setoid_fun_choice. - intro SetoidFunChoice. repeat split. + now intros A B; apply setoid_fun_choice_imp_fun_choice. + apply repr_fun_choice_imp_ext_function_repr. now apply setoid_fun_choice_imp_repr_fun_choice. + apply repr_fun_choice_imp_excluded_middle. now apply setoid_fun_choice_imp_repr_fun_choice. Qed. (**********************************************************************) (** ** AC_fun_setoid = AC_fun + Ext_pred_repr + PI *) (** Note: all ingredients have a computational meaning when taken in separation. However, to compute with the functional choice, existential quantification has to be thought as a strong existential, which is incompatible with proof-irrelevance which requires existential quantification to be truncated *) Theorem fun_choice_and_ext_pred_ext_and_proof_irrel_imp_setoid_fun_choice : FunctionalChoice -> ExtensionalPredicateRepresentative -> ProofIrrelevance -> RepresentativeFunctionalChoice. Proof. intros FunChoice PredExtRepr PI A R (Hrefl,Hsym,Htrans). pose (isclass P := exists x:A, P x). pose (class := {P:A -> Prop | isclass P}). pose (contains (c:class) (a:A) := proj1_sig c a). pose (class_of a := R a). destruct (FunChoice class A contains) as (f,Hf). - intros c. apply proj2_sig. - destruct (PredExtRepr A) as (h,Hh). assert (Hisclass:forall a, isclass (h (class_of a))). { intro a. exists a. destruct (Hh (class_of a)) as (Ha,Huniqa). rewrite <- Ha; apply Hrefl. } pose (f':= fun a => exist _ (h (class_of a)) (Hisclass a) : class). exists (fun a => f (f' a)). intros x. destruct (Hh (class_of x)) as (Hx,Huniqx). split. + specialize Hf with (f' x). simpl in Hf. rewrite <- Hx in Hf. assumption. + intros y Hxy. f_equal. assert (Heq1: h (class_of x) = h (class_of y)). { apply Huniqx. intro z. unfold class_of. firstorder. } assert (Heq2:rew Heq1 in Hisclass x = Hisclass y). { apply PI. } unfold f'. rewrite <- Heq2. rewrite <- Heq1. reflexivity. Qed. Theorem setoid_functional_choice_second_characterization : FunctionalChoice /\ ExtensionalPredicateRepresentative /\ ProofIrrelevance <-> SetoidFunctionalChoice. Proof. split. - intros (FunChoice & ExtPredRepr & PI). apply functional_rel_reification_and_repr_fun_choice_imp_setoid_fun_choice. + intros A B. now apply fun_choice_imp_functional_rel_reification. + now apply fun_choice_and_ext_pred_ext_and_proof_irrel_imp_setoid_fun_choice. - intro SetoidFunChoice. repeat split. + now intros A B; apply setoid_fun_choice_imp_fun_choice. + apply repr_fun_choice_imp_ext_pred_repr. now apply setoid_fun_choice_imp_repr_fun_choice. + red. apply proof_irrelevance_cci. apply repr_fun_choice_imp_excluded_middle. now apply setoid_fun_choice_imp_repr_fun_choice. Qed. (**********************************************************************) (** * Compatibility notations *) Notation description_rel_choice_imp_funct_choice := functional_rel_reification_and_rel_choice_imp_fun_choice (only parsing). Notation funct_choice_imp_rel_choice := fun_choice_imp_rel_choice (only parsing). Notation FunChoice_Equiv_RelChoice_and_ParamDefinDescr := fun_choice_iff_rel_choice_and_functional_rel_reification (only parsing). Notation funct_choice_imp_description := fun_choice_imp_functional_rel_reification (only parsing). coq-8.20.0/theories/Logic/Classical.v000066400000000000000000000014601466560755400173520ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* false] in [Set]. *) Require Export ClassicalUniqueChoice. Require Export RelationalChoice. Require Import ChoiceFacts. Set Implicit Arguments. Definition subset (U:Type) (P Q:U->Prop) : Prop := forall x, P x -> Q x. Theorem singleton_choice : forall (A : Type) (P : A->Prop), (exists x : A, P x) -> exists P' : A->Prop, subset P' P /\ exists! x, P' x. Proof. intros A P H. destruct (relational_choice unit A (fun _ => P) (fun _ => H)) as (R',(Hsub,HR')). exists (R' tt); firstorder. Qed. Theorem choice : forall (A B : Type) (R : A->B->Prop), (forall x : A, exists y : B, R x y) -> exists f : A->B, (forall x : A, R x (f x)). Proof. intros A B. apply description_rel_choice_imp_funct_choice. - exact (unique_choice A B). - exact (relational_choice A B). Qed. coq-8.20.0/theories/Logic/ClassicalDescription.v000066400000000000000000000062141466560755400215600ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* Prop), inhabited A -> { x : A | (exists! x : A, P x) -> P x }. Proof. intros A P i. destruct (excluded_middle_informative (exists! x, P x)) as [Hex|HnonP]. - apply constructive_definite_description with (P:= fun x => (exists! x : A, P x) -> P x). destruct Hex as (x,(Hx,Huni)). exists x; split. + intros _; exact Hx. + firstorder. - exists i; tauto. Qed. (** Church's iota operator *) Definition iota (A : Type) (i:inhabited A) (P : A->Prop) : A := proj1_sig (classical_definite_description P i). Definition iota_spec (A : Type) (i:inhabited A) (P : A->Prop) : (exists! x:A, P x) -> P (iota i P) := proj2_sig (classical_definite_description P i). (** Axiom of unique "choice" (functional reification of functional relations) *) Theorem dependent_unique_choice : forall (A:Type) (B:A -> Type) (R:forall x:A, B x -> Prop), (forall x:A, exists! y : B x, R x y) -> (exists f : (forall x:A, B x), forall x:A, R x (f x)). Proof. intros A B R H. assert (Hexuni:forall x, exists! y, R x y). - intro x. apply H. - exists (fun x => proj1_sig (constructive_definite_description (R x) (Hexuni x))). intro x. apply (proj2_sig (constructive_definite_description (R x) (Hexuni x))). Qed. Theorem unique_choice : forall (A B:Type) (R:A -> B -> Prop), (forall x:A, exists! y : B, R x y) -> (exists f : A -> B, forall x:A, R x (f x)). Proof. intros A B. apply dependent_unique_choice with (B:=fun _:A => B). Qed. (** Compatibility lemmas *) Unset Implicit Arguments. Definition dependent_description := dependent_unique_choice. Definition description := unique_choice. coq-8.20.0/theories/Logic/ClassicalEpsilon.v000066400000000000000000000074021466560755400207060ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* Prop), (exists x, P x) -> { x : A | P x }. Lemma constructive_definite_description : forall (A : Type) (P : A->Prop), (exists! x, P x) -> { x : A | P x }. Proof. intros; apply constructive_indefinite_description; firstorder. Qed. Theorem excluded_middle_informative : forall P:Prop, {P} + {~ P}. Proof. apply (constructive_definite_descr_excluded_middle constructive_definite_description classic). Qed. Theorem classical_indefinite_description : forall (A : Type) (P : A->Prop), inhabited A -> { x : A | (exists x, P x) -> P x }. Proof. intros A P i. destruct (excluded_middle_informative (exists x, P x)) as [Hex|HnonP]. - apply constructive_indefinite_description with (P:= fun x => (exists x, P x) -> P x). destruct Hex as (x,Hx). exists x; intros _; exact Hx. - assert {x : A | True} as (a,_). { apply constructive_indefinite_description with (P := fun _ : A => True). destruct i as (a); firstorder. } firstorder. Defined. (** Hilbert's epsilon operator *) Definition epsilon (A : Type) (i:inhabited A) (P : A->Prop) : A := proj1_sig (classical_indefinite_description P i). Definition epsilon_spec (A : Type) (i:inhabited A) (P : A->Prop) : (exists x, P x) -> P (epsilon i P) := proj2_sig (classical_indefinite_description P i). (** Open question: is classical_indefinite_description constructively provable from [relational_choice] and [constructive_definite_description] (at least, using the fact that [functional_choice] is provable from [relational_choice] and [unique_choice], we know that the double negation of [classical_indefinite_description] is provable (see [relative_non_contradiction_of_indefinite_desc]). *) (** A proof that if [P] is inhabited, [epsilon a P] does not depend on the actual proof that the domain of [P] is inhabited (proof idea kindly provided by Pierre Castéran) *) Lemma epsilon_inh_irrelevance : forall (A:Type) (i j : inhabited A) (P:A->Prop), (exists x, P x) -> epsilon i P = epsilon j P. Proof. intros. unfold epsilon, classical_indefinite_description. destruct (excluded_middle_informative (exists x : A, P x)) as [|[]]; trivial. Qed. Opaque epsilon. (** *** Weaker lemmas (compatibility lemmas) *) Theorem choice : forall (A B : Type) (R : A->B->Prop), (forall x : A, exists y : B, R x y) -> (exists f : A->B, forall x : A, R x (f x)). Proof. intros A B R H. exists (fun x => proj1_sig (constructive_indefinite_description _ (H x))). intro x. apply (proj2_sig (constructive_indefinite_description _ (H x))). Qed. coq-8.20.0/theories/Logic/ClassicalFacts.v000066400000000000000000000653461466560755400203500ustar00rootroot00000000000000(* -*- coding: utf-8 -*- *) (************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* (A = A->A) -> A has fixpoint 2.2. CC |- prop. ext. + dep elim on bool -> proof-irrelevance 2.3. CIC |- prop. ext. -> proof-irrelevance 2.4. CC |- excluded-middle + dep elim on bool -> proof-irrelevance 2.5. CIC |- excluded-middle -> proof-irrelevance 3. Weak classical axioms 3.1. Weak excluded middle and classical de Morgan law 3.2. Gödel-Dummett axiom and right distributivity of implication over disjunction 3 3. Independence of general premises and drinker's paradox 4. Principles equivalent to classical logic 4.1 Classical logic = principle of unrestricted minimization 4.2 Classical logic = choice of representatives in a partition of bool *) (************************************************************************) (** * Prop degeneracy = excluded-middle + prop extensionality *) (** i.e. [(forall A, A=True \/ A=False) <-> (forall A, A\/~A) /\ (forall A B, (A<->B) -> A=B)] *) (** [prop_degeneracy] (also referred to as propositional completeness) asserts (up to consistency) that there are only two distinct formulas *) Definition prop_degeneracy := forall A:Prop, A = True \/ A = False. (** [prop_extensionality] asserts that equivalent formulas are equal *) Definition prop_extensionality := forall A B:Prop, (A <-> B) -> A = B. (** [excluded_middle] asserts that we can reason by case on the truth or falsity of any formula *) Definition excluded_middle := forall A:Prop, A \/ ~ A. (** We show [prop_degeneracy <-> (prop_extensionality /\ excluded_middle)] *) Lemma prop_degen_ext : prop_degeneracy -> prop_extensionality. Proof. intros H A B [Hab Hba]. destruct (H A); destruct (H B). - rewrite H1; exact H0. - absurd B. + rewrite H1; exact (fun H => H). + apply Hab; rewrite H0; exact I. - absurd A. + rewrite H0; exact (fun H => H). + apply Hba; rewrite H1; exact I. - rewrite H1; exact H0. Qed. Lemma prop_degen_em : prop_degeneracy -> excluded_middle. Proof. intros H A. destruct (H A). - left; rewrite H0; exact I. - right; rewrite H0; exact (fun x => x). Qed. Lemma prop_ext_em_degen : prop_extensionality -> excluded_middle -> prop_degeneracy. Proof. intros Ext EM A. destruct (EM A). - left; apply (Ext A True); split; [ exact (fun _ => I) | exact (fun _ => H) ]. - right; apply (Ext A False); split; [ exact H | apply False_ind ]. Qed. (** A weakest form of propositional extensionality: extensionality for provable propositions only *) Require Import PropExtensionalityFacts. Definition provable_prop_extensionality := forall A:Prop, A -> A = True. Lemma provable_prop_ext : prop_extensionality -> provable_prop_extensionality. Proof. exact PropExt_imp_ProvPropExt. Qed. (************************************************************************) (** * Classical logic and proof-irrelevance *) (************************************************************************) (** ** CC |- prop ext + A inhabited -> (A = A->A) -> A has fixpoint *) (** We successively show that: [prop_extensionality] implies equality of [A] and [A->A] for inhabited [A], which implies the existence of a (trivial) retract from [A->A] to [A] (just take the identity), which implies the existence of a fixpoint operator in [A] (e.g. take the Y combinator of lambda-calculus) *) Local Notation inhabited A := A (only parsing). Lemma prop_ext_A_eq_A_imp_A : prop_extensionality -> forall A:Prop, inhabited A -> (A -> A) = A. Proof. intros Ext A a. apply (Ext (A -> A) A); split; [ exact (fun _ => a) | exact (fun _ _ => a) ]. Qed. Record retract (A B:Prop) : Prop := {f1 : A -> B; f2 : B -> A; f1_o_f2 : forall x:B, f1 (f2 x) = x}. Lemma prop_ext_retract_A_A_imp_A : prop_extensionality -> forall A:Prop, inhabited A -> retract A (A -> A). Proof. intros Ext A a. rewrite (prop_ext_A_eq_A_imp_A Ext A a). exists (fun x:A => x) (fun x:A => x). reflexivity. Qed. Record has_fixpoint (A:Prop) : Prop := {F : (A -> A) -> A; Fix : forall f:A -> A, F f = f (F f)}. Lemma ext_prop_fixpoint : prop_extensionality -> forall A:Prop, inhabited A -> has_fixpoint A. Proof. intros Ext A a. case (prop_ext_retract_A_A_imp_A Ext A a); intros g1 g2 g1_o_g2. exists (fun f => (fun x:A => f (g1 x x)) (g2 (fun x => f (g1 x x)))). intro f. pattern (g1 (g2 (fun x:A => f (g1 x x)))) at 1. rewrite (g1_o_g2 (fun x:A => f (g1 x x))). reflexivity. Qed. (** Remark: [prop_extensionality] can be replaced in lemma [ext_prop_fixpoint] by the weakest property [provable_prop_extensionality]. *) (************************************************************************) (** ** CC |- prop_ext /\ dep elim on bool -> proof-irrelevance *) (** [proof_irrelevance] asserts equality of all proofs of a given formula *) Definition proof_irrelevance := forall (A:Prop) (a1 a2:A), a1 = a2. (** Assume that we have booleans with the property that there is at most 2 booleans (which is equivalent to dependent case analysis). Consider the fixpoint of the negation function: it is either true or false by dependent case analysis, but also the opposite by fixpoint. Hence proof-irrelevance. We then map equality of boolean proofs to proof irrelevance in all propositions. *) Section Proof_irrelevance_gen. Variable bool : Prop. Variable true : bool. Variable false : bool. Hypothesis bool_elim : forall C:Prop, C -> C -> bool -> C. Hypothesis bool_elim_redl : forall (C:Prop) (c1 c2:C), c1 = bool_elim C c1 c2 true. Hypothesis bool_elim_redr : forall (C:Prop) (c1 c2:C), c2 = bool_elim C c1 c2 false. Let bool_dep_induction := forall P:bool -> Prop, P true -> P false -> forall b:bool, P b. Lemma aux : prop_extensionality -> bool_dep_induction -> true = false. Proof. intros Ext Ind. case (ext_prop_fixpoint Ext bool true); intros G Gfix. set (neg := fun b:bool => bool_elim bool false true b). generalize (eq_refl (G neg)). pattern (G neg) at 1. apply Ind with (b := G neg); intro Heq. - rewrite (bool_elim_redl bool false true). change (true = neg true); rewrite Heq; apply Gfix. - rewrite (bool_elim_redr bool false true). change (neg false = false); rewrite Heq; symmetry ; apply Gfix. Qed. Lemma ext_prop_dep_proof_irrel_gen : prop_extensionality -> bool_dep_induction -> proof_irrelevance. Proof. intros Ext Ind A a1 a2. set (f := fun b:bool => bool_elim A a1 a2 b). rewrite (bool_elim_redl A a1 a2). change (f true = a2). rewrite (bool_elim_redr A a1 a2). change (f true = f false). rewrite (aux Ext Ind). reflexivity. Qed. End Proof_irrelevance_gen. (** In the pure Calculus of Constructions, we can define the boolean proposition bool = (C:Prop)C->C->C but we cannot prove that it has at most 2 elements. *) Section Proof_irrelevance_Prop_Ext_CC. Definition BoolP := forall C:Prop, C -> C -> C. Definition TrueP : BoolP := fun C c1 c2 => c1. Definition FalseP : BoolP := fun C c1 c2 => c2. Definition BoolP_elim C c1 c2 (b:BoolP) := b C c1 c2. Definition BoolP_elim_redl (C:Prop) (c1 c2:C) : c1 = BoolP_elim C c1 c2 TrueP := eq_refl c1. Definition BoolP_elim_redr (C:Prop) (c1 c2:C) : c2 = BoolP_elim C c1 c2 FalseP := eq_refl c2. Definition BoolP_dep_induction := forall P:BoolP -> Prop, P TrueP -> P FalseP -> forall b:BoolP, P b. Lemma ext_prop_dep_proof_irrel_cc : prop_extensionality -> BoolP_dep_induction -> proof_irrelevance. Proof. exact (ext_prop_dep_proof_irrel_gen BoolP TrueP FalseP BoolP_elim BoolP_elim_redl BoolP_elim_redr). Qed. End Proof_irrelevance_Prop_Ext_CC. (** Remark: [prop_extensionality] can be replaced in lemma [ext_prop_dep_proof_irrel_gen] by the weakest property [provable_prop_extensionality]. *) (************************************************************************) (** ** CIC |- prop. ext. -> proof-irrelevance *) (** In the Calculus of Inductive Constructions, inductively defined booleans enjoy dependent case analysis, hence directly proof-irrelevance from propositional extensionality. *) Section Proof_irrelevance_CIC. Inductive boolP : Prop := | trueP : boolP | falseP : boolP. Definition boolP_elim_redl (C:Prop) (c1 c2:C) : c1 = boolP_ind C c1 c2 trueP := eq_refl c1. Definition boolP_elim_redr (C:Prop) (c1 c2:C) : c2 = boolP_ind C c1 c2 falseP := eq_refl c2. Scheme boolP_indd := Induction for boolP Sort Prop. Lemma ext_prop_dep_proof_irrel_cic : prop_extensionality -> proof_irrelevance. Proof. exact (fun pe => ext_prop_dep_proof_irrel_gen boolP trueP falseP boolP_ind boolP_elim_redl boolP_elim_redr pe boolP_indd). Qed. End Proof_irrelevance_CIC. (** Can we state proof irrelevance from propositional degeneracy (i.e. propositional extensionality + excluded middle) without dependent case analysis ? Berardi [[Berardi90]] built a model of CC interpreting inhabited types by the set of all untyped lambda-terms. This model satisfies propositional degeneracy without satisfying proof-irrelevance (nor dependent case analysis). This implies that the previous results cannot be refined. [[Berardi90]] Stefano Berardi, "Type dependence and constructive mathematics", Ph. D. thesis, Dipartimento Matematica, Università di Torino, 1990. *) (************************************************************************) (** ** CC |- excluded-middle + dep elim on bool -> proof-irrelevance *) (** This is a proof in the pure Calculus of Construction that classical logic in [Prop] + dependent elimination of disjunction entails proof-irrelevance. Reference: [[Coquand90]] T. Coquand, "Metamathematical Investigations of a Calculus of Constructions", Proceedings of Logic in Computer Science (LICS'90), 1990. Proof skeleton: classical logic + dependent elimination of disjunction + discrimination of proofs implies the existence of a retract from [Prop] into [bool], hence inconsistency by encoding any paradox of system U- (e.g. Hurkens' paradox). *) Require Import Hurkens. Section Proof_irrelevance_EM_CC. Variable or : Prop -> Prop -> Prop. Variable or_introl : forall A B:Prop, A -> or A B. Variable or_intror : forall A B:Prop, B -> or A B. Hypothesis or_elim : forall A B C:Prop, (A -> C) -> (B -> C) -> or A B -> C. Hypothesis or_elim_redl : forall (A B C:Prop) (f:A -> C) (g:B -> C) (a:A), f a = or_elim A B C f g (or_introl A B a). Hypothesis or_elim_redr : forall (A B C:Prop) (f:A -> C) (g:B -> C) (b:B), g b = or_elim A B C f g (or_intror A B b). Hypothesis or_dep_elim : forall (A B:Prop) (P:or A B -> Prop), (forall a:A, P (or_introl A B a)) -> (forall b:B, P (or_intror A B b)) -> forall b:or A B, P b. Hypothesis em : forall A:Prop, or A (~ A). Variable B : Prop. Variables b1 b2 : B. (** [p2b] and [b2p] form a retract if [~b1=b2] *) Let p2b A := or_elim A (~ A) B (fun _ => b1) (fun _ => b2) (em A). Let b2p b := b1 = b. Lemma p2p1 : forall A:Prop, A -> b2p (p2b A). Proof. unfold p2b; intro A; apply or_dep_elim with (b := em A); unfold b2p; intros. - apply (or_elim_redl A (~ A) B (fun _ => b1) (fun _ => b2)). - destruct (b H). Qed. Lemma p2p2 : b1 <> b2 -> forall A:Prop, b2p (p2b A) -> A. Proof. intro not_eq_b1_b2. unfold p2b; intro A; apply or_dep_elim with (b := em A); unfold b2p; intros. - assumption. - destruct not_eq_b1_b2. rewrite <- (or_elim_redr A (~ A) B (fun _ => b1) (fun _ => b2)) in H. assumption. Qed. (** Using excluded-middle a second time, we get proof-irrelevance *) Theorem proof_irrelevance_cc : b1 = b2. Proof. refine (or_elim _ _ _ _ _ (em (b1 = b2))); intro H. - trivial. - apply (NoRetractFromSmallPropositionToProp.paradox B p2b b2p (p2p2 H) p2p1). Qed. End Proof_irrelevance_EM_CC. (** Hurkens' paradox still holds with a retract from the _negative_ fragment of [Prop] into [bool], hence weak classical logic, i.e. [forall A, ~A\/~~A], is enough for deriving a weak version of proof-irrelevance. This is enough to derive a contradiction from a [Set]-bound weak excluded middle with an impredicative [Set] universe. *) Section Proof_irrelevance_WEM_CC. Variable or : Prop -> Prop -> Prop. Variable or_introl : forall A B:Prop, A -> or A B. Variable or_intror : forall A B:Prop, B -> or A B. Hypothesis or_elim : forall A B C:Prop, (A -> C) -> (B -> C) -> or A B -> C. Hypothesis or_elim_redl : forall (A B C:Prop) (f:A -> C) (g:B -> C) (a:A), f a = or_elim A B C f g (or_introl A B a). Hypothesis or_elim_redr : forall (A B C:Prop) (f:A -> C) (g:B -> C) (b:B), g b = or_elim A B C f g (or_intror A B b). Hypothesis or_dep_elim : forall (A B:Prop) (P:or A B -> Prop), (forall a:A, P (or_introl A B a)) -> (forall b:B, P (or_intror A B b)) -> forall b:or A B, P b. Hypothesis wem : forall A:Prop, or (~~A) (~ A). Local Notation NProp := NoRetractToNegativeProp.NProp. Local Notation El := NoRetractToNegativeProp.El. Variable B : Prop. Variables b1 b2 : B. (** [p2b] and [b2p] form a retract if [~b1=b2] *) Let p2b (A:NProp) := or_elim (~~El A) (~El A) B (fun _ => b1) (fun _ => b2) (wem (El A)). Let b2p b : NProp := exist (fun P=>~~P -> P) (~~(b1 = b)) (fun h x => h (fun k => k x)). Lemma wp2p1 : forall A:NProp, El A -> El (b2p (p2b A)). Proof. intros A. unfold p2b. apply or_dep_elim with (b := wem (El A)). + intros nna a. rewrite <- or_elim_redl. cbn. auto. + intros n x. destruct (n x). Qed. Lemma wp2p2 : b1 <> b2 -> forall A:NProp, El (b2p (p2b A)) -> El A. Proof. intro not_eq_b1_b2. intros A. unfold p2b. apply or_dep_elim with (b := wem (El A)). + cbn. intros x _. destruct A. cbn in x |- *. auto. + intros na. rewrite <- or_elim_redr. cbn. intros h. destruct (h not_eq_b1_b2). Qed. (** By Hurkens's paradox, we get a weak form of proof irrelevance. *) Theorem wproof_irrelevance_cc : ~~(b1 = b2). Proof. intros h. unshelve (refine (let NB := exist (fun P=>~~P -> P) B _ in _)). { exact (fun _ => b1). } pose proof (NoRetractToNegativeProp.paradox NB p2b b2p (wp2p2 h) wp2p1) as paradox. unshelve (refine (let F := exist (fun P=>~~P->P) False _ in _)). { auto. } exact (paradox F). Qed. End Proof_irrelevance_WEM_CC. (************************************************************************) (** ** CIC |- excluded-middle -> proof-irrelevance *) (** Since, dependent elimination is derivable in the Calculus of Inductive Constructions (CCI), we get proof-irrelevance from classical logic in the CCI. *) Section Proof_irrelevance_CCI. Hypothesis em : forall A:Prop, A \/ ~ A. Definition or_elim_redl (A B C:Prop) (f:A -> C) (g:B -> C) (a:A) : f a = or_ind f g (or_introl B a) := eq_refl (f a). Definition or_elim_redr (A B C:Prop) (f:A -> C) (g:B -> C) (b:B) : g b = or_ind f g (or_intror A b) := eq_refl (g b). Scheme or_indd := Induction for or Sort Prop. Theorem proof_irrelevance_cci : forall (B:Prop) (b1 b2:B), b1 = b2. Proof. exact (proof_irrelevance_cc or or_introl or_intror or_ind or_elim_redl or_elim_redr or_indd em). Qed. End Proof_irrelevance_CCI. (** The same holds with weak excluded middle. The proof is a little more involved, however. *) Section Weak_proof_irrelevance_CCI. Hypothesis wem : forall A:Prop, ~~A \/ ~ A. Theorem wem_proof_irrelevance_cci : forall (B:Prop) (b1 b2:B), ~~b1 = b2. Proof. exact (wproof_irrelevance_cc or or_introl or_intror or_ind or_elim_redl or_elim_redr or_indd wem). Qed. End Weak_proof_irrelevance_CCI. (** Remark: in the Set-impredicative CCI, Hurkens' paradox still holds with [bool] in [Set] and since [~true=false] for [true] and [false] in [bool] from [Set], we get the inconsistency of [em : forall A:Prop, {A}+{~A}] in the Set-impredicative CCI. *) (** * Weak classical axioms *) (** We show the following increasing in the strength of axioms: - weak excluded-middle and classical De Morgan's law - right distributivity of implication over disjunction and Gödel-Dummett axiom - independence of general premises and drinker's paradox - excluded-middle *) (** ** Weak excluded-middle *) (** The weak classical logic based on [~~A \/ ~A] is referred to with name KC in [[ChagrovZakharyaschev97]]. See [[SorbiTerwijn11]] for a short survey. [[ChagrovZakharyaschev97]] Alexander Chagrov and Michael Zakharyaschev, "Modal Logic", Clarendon Press, 1997. [[SorbiTerwijn11]] Andrea Sorbi and Sebastiaan A. Terwijn, "Generalizations of the weak law of the excluded-middle", Notre Dame J. Formal Logic, vol 56(2), pp 321-331, 2015. *) Definition weak_excluded_middle := forall A:Prop, ~~A \/ ~A. (** The interest in the equivalent variant [weak_generalized_excluded_middle] is that it holds even in logic without a primitive [False] connective (like Gödel-Dummett axiom) *) Definition weak_generalized_excluded_middle := forall A B:Prop, ((A -> B) -> B) \/ (A -> B). (** Classical De Morgan's law *) Definition classical_de_morgan_law := forall A B:Prop, ~(A /\ B) -> ~A \/ ~B. (** ** Gödel-Dummett axiom *) (** [(A->B) \/ (B->A)] is studied in [[Dummett59]] and is based on [[Gödel33]]. [[Dummett59]] Michael A. E. Dummett. "A Propositional Calculus with a Denumerable Matrix", In the Journal of Symbolic Logic, vol 24(2), pp 97-103, 1959. [[Gödel33]] Kurt Gödel. "Zum intuitionistischen Aussagenkalkül", Ergeb. Math. Koll. 4, pp. 34-38, 1933. *) Definition GodelDummett := forall A B:Prop, (A -> B) \/ (B -> A). Lemma excluded_middle_Godel_Dummett : excluded_middle -> GodelDummett. Proof. intros EM A B. destruct (EM B) as [HB|HnotB]. - left; intros _; exact HB. - right; intros HB; destruct (HnotB HB). Qed. (** [(A->B) \/ (B->A)] is equivalent to [(C -> A\/B) -> (C->A) \/ (C->B)] (proof from [[Dummett59]]) *) Definition RightDistributivityImplicationOverDisjunction := forall A B C:Prop, (C -> A\/B) -> (C->A) \/ (C->B). Lemma Godel_Dummett_iff_right_distr_implication_over_disjunction : GodelDummett <-> RightDistributivityImplicationOverDisjunction. Proof. split. - intros GD A B C HCAB. destruct (GD B A) as [HBA|HAB]; [left|right]; intro HC; destruct (HCAB HC) as [HA|HB]; [ | apply HBA | apply HAB | ]; assumption. - intros Distr A B. destruct (Distr A B (A\/B)) as [HABA|HABB]. + intro HAB; exact HAB. + right; intro HB; apply HABA; right; assumption. + left; intro HA; apply HABB; left; assumption. Qed. (** [(A->B) \/ (B->A)] is stronger than the weak excluded middle *) Lemma Godel_Dummett_weak_excluded_middle : GodelDummett -> weak_excluded_middle. Proof. intros GD A. destruct (GD (~A) A) as [HnotAA|HAnotA]. - left; intro HnotA; apply (HnotA (HnotAA HnotA)). - right; intro HA; apply (HAnotA HA HA). Qed. (** The weak excluded middle is equivalent to the classical De Morgan's law *) Lemma weak_excluded_middle_iff_classical_de_morgan_law : weak_excluded_middle <-> classical_de_morgan_law. Proof. split; [intro WEM|intro CDML]; intros A *. - destruct (WEM A); tauto. - destruct (CDML A (~A)); tauto. Qed. (** ** Independence of general premises and drinker's paradox *) (** Independence of general premises is the unconstrained, non constructive, version of the Independence of Premises as considered in [[Troelstra73]]. It is a generalization to predicate logic of the right distributivity of implication over disjunction (hence of Gödel-Dummett axiom) whose own constructive form (obtained by a restricting the third formula to be negative) is called Kreisel-Putnam principle [[KreiselPutnam57]]. [[KreiselPutnam57]], Georg Kreisel and Hilary Putnam. "Eine Unableitsbarkeitsbeweismethode für den intuitionistischen Aussagenkalkül". Archiv für Mathematische Logik und Graundlagenforschung, 3:74- 78, 1957. [[Troelstra73]], Anne Troelstra, editor. Metamathematical Investigation of Intuitionistic Arithmetic and Analysis, volume 344 of Lecture Notes in Mathematics, Springer-Verlag, 1973. *) Definition IndependenceOfGeneralPremises := forall (A:Type) (P:A -> Prop) (Q:Prop), inhabited A -> (Q -> exists x, P x) -> exists x, Q -> P x. Lemma independence_general_premises_right_distr_implication_over_disjunction : IndependenceOfGeneralPremises -> RightDistributivityImplicationOverDisjunction. Proof. intros IP A B C HCAB. destruct (IP bool (fun b => if b then A else B) C true) as ([|],H). - intro HC; destruct (HCAB HC); [exists true|exists false]; assumption. - left; assumption. - right; assumption. Qed. Lemma independence_general_premises_Godel_Dummett : IndependenceOfGeneralPremises -> GodelDummett. Proof. destruct Godel_Dummett_iff_right_distr_implication_over_disjunction. auto using independence_general_premises_right_distr_implication_over_disjunction. Qed. (** Independence of general premises is equivalent to the drinker's paradox *) Definition DrinkerParadox := forall (A:Type) (P:A -> Prop), inhabited A -> exists x, (exists x, P x) -> P x. Lemma independence_general_premises_drinker : IndependenceOfGeneralPremises <-> DrinkerParadox. Proof. split. - intros IP A P InhA; apply (IP A P (exists x, P x) InhA); intro Hx; exact Hx. - intros Drinker A P Q InhA H; destruct (Drinker A P InhA) as (x,Hx). exists x; intro HQ; apply (Hx (H HQ)). Qed. (** Independence of general premises is weaker than (generalized) excluded middle Remark: generalized excluded middle is preferred here to avoid relying on the "ex falso quodlibet" property (i.e. [False -> forall A, A]) *) Definition generalized_excluded_middle := forall A B:Prop, A \/ (A -> B). Lemma excluded_middle_independence_general_premises : generalized_excluded_middle -> DrinkerParadox. Proof. intros GEM A P x0. destruct (GEM (exists x, P x) (P x0)) as [(x,Hx)|Hnot]. - exists x; intro; exact Hx. - exists x0; exact Hnot. Qed. (** * Axioms equivalent to classical logic *) (** ** Principle of unrestricted minimization *) Require Import Coq.Arith.PeanoNat. Definition Minimal (P:nat -> Prop) (n:nat) : Prop := P n /\ forall k, P k -> n<=k. Definition Minimization_Property (P : nat -> Prop) : Prop := forall n, P n -> exists m, Minimal P m. Section Unrestricted_minimization_entails_excluded_middle. Hypothesis unrestricted_minimization: forall P, Minimization_Property P. Theorem unrestricted_minimization_entails_excluded_middle : forall A, A\/~A. Proof. intros A. pose (P := fun n:nat => n=0/\A \/ n=1). assert (P 1) as h. { unfold P. intuition. } assert (P 0 <-> A) as p₀. { split. + intros [[_ h₀]|[=]]. assumption. + unfold P. tauto. } apply unrestricted_minimization in h as ([|[|m]] & hm & hmm). + intuition. + right. intros HA. apply p₀, hmm, PeanoNat.Nat.nle_succ_0 in HA. assumption. + destruct hm as [([=],_) | [=] ]. Qed. End Unrestricted_minimization_entails_excluded_middle. Require Import Wf_nat. Section Excluded_middle_entails_unrestricted_minimization. Hypothesis em : forall A, A\/~A. Theorem excluded_middle_entails_unrestricted_minimization : forall P, Minimization_Property P. Proof. intros P n HPn. assert (dec : forall n, P n \/ ~ P n) by auto using em. assert (ex : exists n, P n) by (exists n; assumption). destruct (dec_inh_nat_subset_has_unique_least_element P dec ex) as (n' & HPn' & _). exists n'. assumption. Qed. End Excluded_middle_entails_unrestricted_minimization. (** However, minimization for a given predicate does not necessarily imply decidability of this predicate *) Section Example_of_undecidable_predicate_with_the_minimization_property. Variable s : nat -> bool. Let P n := exists k, n<=k /\ s k = true. Example undecidable_predicate_with_the_minimization_property : Minimization_Property P. Proof. unfold Minimization_Property. intros h hn. exists 0. split. + unfold P in *. destruct hn as (k&hk₁&hk₂). exists k. split. * rewrite <- hk₁. apply PeanoNat.Nat.le_0_l. * assumption. + intros **. apply PeanoNat.Nat.le_0_l. Qed. End Example_of_undecidable_predicate_with_the_minimization_property. (** ** Choice of representatives in a partition of bool *) (** This is similar to Bell's "weak extensional selection principle" in [[Bell]] [[Bell]] John L. Bell, Choice principles in intuitionistic set theory, unpublished. *) Require Import RelationClasses. Local Notation representative_boolean_partition := (forall R:bool->bool->Prop, Equivalence R -> exists f, forall x, R x (f x) /\ forall y, R x y -> f x = f y). Theorem representative_boolean_partition_imp_excluded_middle : representative_boolean_partition -> excluded_middle. Proof. intros ReprFunChoice P. pose (R (b1 b2 : bool) := b1 = b2 \/ P). assert (Equivalence R). { split. - now left. - destruct 1. + now left. + now right. - destruct 1, 1; try now right. left; now transitivity y. } destruct (ReprFunChoice R H) as (f,Hf). clear H. destruct (Bool.bool_dec (f true) (f false)) as [Heq|Hneq]. + left. destruct (Hf false) as ([Hfalse|HP],_); try easy. destruct (Hf true) as ([Htrue|HP],_); try easy. congruence. + right. intro HP. destruct (Hf true) as (_,H). apply Hneq, H. now right. Qed. Theorem excluded_middle_imp_representative_boolean_partition : excluded_middle -> representative_boolean_partition. Proof. intros EM R H. destruct (EM (R true false)). - exists (fun _ => true). intros []; firstorder. - exists (fun b => b). intro b. split. + reflexivity. + destruct b, y; intros HR; easy || now symmetry in HR. Qed. Theorem excluded_middle_iff_representative_boolean_partition : excluded_middle <-> representative_boolean_partition. Proof. split; auto using excluded_middle_imp_representative_boolean_partition, representative_boolean_partition_imp_excluded_middle. Qed. coq-8.20.0/theories/Logic/ClassicalUniqueChoice.v000066400000000000000000000063151466560755400216600ustar00rootroot00000000000000(* -*- coding: utf-8 -*- *) (************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* Type) (R:forall x:A, B x -> Prop), (forall x : A, exists! y : B x, R x y) -> (exists f : (forall x:A, B x), forall x:A, R x (f x)). (** Unique choice reifies functional relations into functions *) Theorem unique_choice : forall (A B:Type) (R:A -> B -> Prop), (forall x:A, exists! y : B, R x y) -> (exists f:A->B, forall x:A, R x (f x)). Proof. intros A B. apply (dependent_unique_choice A (fun _ => B)). Qed. (** The following proof comes from [[ChicliPottierSimpson02]] *) Require Import Setoid. Theorem classic_set_in_prop_context : forall C:Prop, ((forall P:Prop, {P} + {~ P}) -> C) -> C. Proof. intros C HnotEM. set (R := fun A b => A /\ true = b \/ ~ A /\ false = b). assert (H : exists f : Prop -> bool, (forall A:Prop, R A (f A))). { apply unique_choice. intro A. destruct (classic A) as [Ha| Hnota]. - exists true; split. + left; split; [ assumption | reflexivity ]. + intros y [[_ Hy]| [Hna _]]. * assumption. * contradiction. - exists false; split. + right; split; [ assumption | reflexivity ]. + intros y [[Ha _]| [_ Hy]]. * contradiction. * assumption. } destruct H as [f Hf]. apply HnotEM. intro P. assert (HfP := Hf P). (* Elimination from Hf to Set is not allowed but from f to Set yes ! *) destruct (f P). - left. destruct HfP as [[Ha _]| [_ Hfalse]]. + assumption. + discriminate. - right. destruct HfP as [[_ Hfalse]| [Hna _]]. + discriminate. + assumption. Qed. Corollary not_not_classic_set : ((forall P:Prop, {P} + {~ P}) -> False) -> False. Proof. apply classic_set_in_prop_context. Qed. (* Compatibility *) Notation classic_set := not_not_classic_set (only parsing). coq-8.20.0/theories/Logic/Classical_Pred_Type.v000066400000000000000000000041011466560755400213200ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* Prop, ~ (forall n:U, ~ P n) -> exists n : U, P n. Proof. intros P notall. apply NNPP. intro abs. apply notall. intros n H. apply abs; exists n; exact H. Qed. Lemma not_all_ex_not : forall P:U -> Prop, ~ (forall n:U, P n) -> exists n : U, ~ P n. Proof. intros P notall. apply not_all_not_ex with (P:=fun x => ~ P x). intro all; apply notall. intro n; apply NNPP. apply all. Qed. Lemma not_ex_all_not : forall P:U -> Prop, ~ (exists n : U, P n) -> forall n:U, ~ P n. Proof. (* Intuitionistic *) unfold not; intros P notex n abs. apply notex. exists n; trivial. Qed. Lemma not_ex_not_all : forall P:U -> Prop, ~ (exists n : U, ~ P n) -> forall n:U, P n. Proof. intros P H n. apply NNPP. red; intro K; apply H; exists n; trivial. Qed. Lemma ex_not_not_all : forall P:U -> Prop, (exists n : U, ~ P n) -> ~ (forall n:U, P n). Proof. (* Intuitionistic *) unfold not; intros P exnot allP. elim exnot; auto. Qed. Lemma all_not_not_ex : forall P:U -> Prop, (forall n:U, ~ P n) -> ~ (exists n : U, P n). Proof. (* Intuitionistic *) unfold not; intros P allnot exP; elim exP; intros n p. apply allnot with n; auto. Qed. End Generic. coq-8.20.0/theories/Logic/Classical_Prop.v000066400000000000000000000065741466560755400203650ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* p. Proof. unfold not; intros; elim (classic p); auto. intro NP; elim (H NP). Qed. Register NNPP as core.nnpp.type. (** Peirce's law states [forall P Q:Prop, ((P -> Q) -> P) -> P]. Thanks to [forall P, False -> P], it is equivalent to the following form *) Lemma Peirce : forall P:Prop, ((P -> False) -> P) -> P. Proof. intros P H; destruct (classic P); auto. Qed. Lemma not_imply_elim : forall P Q:Prop, ~ (P -> Q) -> P. Proof. intros; apply NNPP; red. intro; apply H; intro; absurd P; trivial. Qed. Lemma not_imply_elim2 : forall P Q:Prop, ~ (P -> Q) -> ~ Q. Proof. (* Intuitionistic *) tauto. Qed. Lemma imply_to_or : forall P Q:Prop, (P -> Q) -> ~ P \/ Q. Proof. intros; elim (classic P); auto. Qed. Lemma imply_to_and : forall P Q:Prop, ~ (P -> Q) -> P /\ ~ Q. Proof. intros; split. - apply not_imply_elim with Q; trivial. - apply not_imply_elim2 with P; trivial. Qed. Lemma or_to_imply : forall P Q:Prop, ~ P \/ Q -> P -> Q. Proof. (* Intuitionistic *) tauto. Qed. Lemma not_and_or : forall P Q:Prop, ~ (P /\ Q) -> ~ P \/ ~ Q. Proof. intros; elim (classic P); auto. Qed. Lemma or_not_and : forall P Q:Prop, ~ P \/ ~ Q -> ~ (P /\ Q). Proof. simple induction 1; red; simple induction 2; auto. Qed. Lemma not_or_and : forall P Q:Prop, ~ (P \/ Q) -> ~ P /\ ~ Q. Proof. (* Intuitionistic *) tauto. Qed. Lemma and_not_or : forall P Q:Prop, ~ P /\ ~ Q -> ~ (P \/ Q). Proof. (* Intuitionistic *) tauto. Qed. Lemma imply_and_or : forall P Q:Prop, (P -> Q) -> P \/ Q -> Q. Proof. (* Intuitionistic *) tauto. Qed. Lemma imply_and_or2 : forall P Q R:Prop, (P -> Q) -> P \/ R -> Q \/ R. Proof. (* Intuitionistic *) tauto. Qed. Lemma proof_irrelevance : forall (P:Prop) (p1 p2:P), p1 = p2. Proof proof_irrelevance_cci classic. (* classical_left transforms |- A \/ B into ~B |- A *) (* classical_right transforms |- A \/ B into ~A |- B *) Ltac classical_right := match goal with |- ?X \/ _ => (elim (classic X);intro;[left;trivial|right]) end. Ltac classical_left := match goal with |- _ \/ ?X => (elim (classic X);intro;[right;trivial|left]) end. Require Export EqdepFacts. Module Eq_rect_eq. Lemma eq_rect_eq : forall (U:Type) (p:U) (Q:U -> Type) (x:Q p) (h:p = p), x = eq_rect p Q x p h. Proof. intros; rewrite proof_irrelevance with (p1:=h) (p2:=eq_refl p); reflexivity. Qed. End Eq_rect_eq. Module EqdepTheory := EqdepTheory(Eq_rect_eq). Export EqdepTheory. coq-8.20.0/theories/Logic/ConstructiveEpsilon.v000066400000000000000000000431531466560755400215030ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* Prop. Hypothesis P_dec : forall n, {P n}+{~(P n)}. (** The termination argument is [before_witness n], which says that any number before any witness (not necessarily the [x] of [exists x :A, P x]) makes the search eventually stops. *) Inductive before_witness (n:nat) : Prop := | stop : P n -> before_witness n | next : before_witness (S n) -> before_witness n. (* Computation of the initial termination certificate *) Fixpoint O_witness (n : nat) : before_witness n -> before_witness 0 := match n return (before_witness n -> before_witness 0) with | 0 => fun b => b | S n => fun b => O_witness n (next n b) end. (* Inversion of [inv_before_witness n] in a way such that the result is structurally smaller even in the [stop] case. *) Definition inv_before_witness : forall n, before_witness n -> ~(P n) -> before_witness (S n) := fun n b not_p => match b with | stop _ p => match not_p p with end | next _ b => b end. (** Basic program *) Fixpoint prog_linear_search start (b : before_witness start) : nat := match P_dec start with | left yes => start | right no => prog_linear_search (S start) (inv_before_witness start b no) end. (** rel_ls = relational version of linear search *) Inductive rel_ls : nat -> nat -> Prop := | Rstop : forall {found}, P found -> rel_ls found found | Rnext : forall {start found}, ~(P start) -> rel_ls (S start) found -> rel_ls start found. (** Following the Braga method, the output is packed with a proof of its conformity wrt rel_ls *) Definition linear_search_conform start (b : before_witness start) : {n : nat | rel_ls start n}. revert start b. refine (fix loop start b := match P_dec start with | left yes => exist _ start _ | right no => let (n, r) := loop (S start) (inv_before_witness start b no) in exist _ n _ end). - apply (Rstop yes). - apply (Rnext no r). Defined. (** A variant where the computational contents is closer to [prog_linear_search] (no deconstruction/reconstruction of the result), using a suitable abstraction of the postcondition. The predicate [rel_ls start] is abstracted into [Q], with an additional implication [rq] they are equivalent (but only one direction is needed); and as linear search is tail recursive, [Q] can be fixed (but [rq] varies, behaving like a logical continuation). *) Definition linear_search_conform_alt start (b : before_witness start) : {n : nat | rel_ls start n}. refine ((fun Q: nat -> Prop => _ : (forall y, rel_ls start y -> Q y) -> {n | Q n}) (rel_ls start) (fun y r => r)). revert start b. refine (fix loop start b := fun rq => match P_dec start with | left yes => exist _ start _ | right no => loop (S start) (inv_before_witness start b no) _ end). - apply rq, (Rstop yes). - intros y r. apply rq, (Rnext no r). Defined. (** Start at 0 *) Definition linear_search_from_0_conform (e : exists n, P n) : {n:nat | rel_ls 0 n} := let b := let (n, p) := e in O_witness n (stop n p) in linear_search_conform 0 b. (** Partial correctness properties *) (** rel_ls entails P on the output *) Theorem rel_ls_post : forall {start found}, rel_ls start found -> P found. Proof. intros * rls. induction rls as [x p | x y b rls IHrls]. - exact p. - exact IHrls. Qed. (** rel_ls entails minimality of the output *) Lemma rel_ls_lower_bound {found start} : rel_ls start found -> forall {k}, P k -> start <= k -> found <= k. Proof. induction 1 as [x p | x y no _ IH]; intros k pk greater. - exact greater. - destruct greater as [ | k greater]. + case (no pk). + apply (IH _ pk), le_n_S, greater. Qed. (** For compatibility with previous version *) Definition linear_search start (b : before_witness start) : {n : nat | P n} := let (n, p) := linear_search_conform start b in exist _ n (rel_ls_post p). (** Main definitions *) Definition constructive_indefinite_ground_description_nat : (exists n, P n) -> {n:nat | P n}. Proof. intro e; destruct (linear_search_from_0_conform e) as [found r]; exists found. apply (rel_ls_post r). Defined. Definition epsilon_smallest : (exists n : nat, P n) -> { n : nat | P n /\ forall k, P k -> n <= k }. Proof. intro e; destruct (linear_search_from_0_conform e) as [found r]; exists found. split. - apply (rel_ls_post r). - intros k pk. apply (rel_ls_lower_bound r pk), Nat.le_0_l. Defined. (** NB. The previous version used a negative formulation: [forall k, k < n -> ~P k] Lemmas [le_not_lt] and [lt_not_le] can help if needed. *) (************************************************************************) (** In simple situations like here, a direct proof that [prog_linear_search] satisfies [rel_ls] can be provided. On the computational side of the proof, the fixpoint (coming from [before_witness_dep_ind]) has to come first, before the pattern matching on [P_dec], so we get a slight mismatch between the program [prog_linear_search] and the proof; in particular, there is a duplication for [Rstop]. *) Scheme before_witness_dep_ind := Induction for before_witness Sort Prop. Lemma linear_search_rel : forall start b, rel_ls start (prog_linear_search start b). Proof. intros start b. induction b as [n p | n b IHb] using before_witness_dep_ind; unfold prog_linear_search; destruct (P_dec n) as [yes | no]; fold prog_linear_search. - apply Rstop, yes. - case (no p). - apply Rstop, yes. - apply (Rnext no), IHb. Qed. (** Start at 0 *) Definition linear_search_from_0 (e : exists n, P n) : nat := let b := let (n, p) := e in O_witness n (stop n p) in prog_linear_search 0 b. Lemma linear_search_from_0_rel (e : exists n, P n) : rel_ls 0 (linear_search_from_0 e). Proof. apply linear_search_rel. Qed. (** Main definitions *) Definition constructive_indefinite_ground_description_nat_direct : (exists n, P n) -> {n:nat | P n}. Proof. intro e. exists (linear_search_from_0 e). apply (rel_ls_post (linear_search_from_0_rel e)). Defined. Definition epsilon_smallest_direct : (exists n : nat, P n) -> { n : nat | P n /\ forall k, P k -> n <= k }. Proof. intro e. exists (linear_search_from_0 e). split. - apply (rel_ls_post (linear_search_from_0_rel e)). - intros k pk. apply (@rel_ls_lower_bound _ 0 (linear_search_from_0_rel e) k pk), Nat.le_0_l. Defined. End ConstructiveIndefiniteGroundDescription_Direct. (************************************************************************) (* Version using the predicate [Acc] *) Section ConstructiveIndefiniteGroundDescription_Acc. Variable P : nat -> Prop. Hypothesis P_decidable : forall n : nat, {P n} + {~ P n}. (** The predicate [Acc] delineates elements that are accessible via a given relation [R]. An element is accessible if there are no infinite [R]-descending chains starting from it. To use [Fix_F], we define a relation R and prove that if [exists n, P n] then 0 is accessible with respect to R. Then, by induction on the definition of [Acc R 0], we show [{n : nat | P n}]. The relation [R] describes the connection between the two successive numbers we try. Namely, [y] is [R]-less then [x] if we try [y] after [x], i.e., [y = S x] and [P x] is false. Then the absence of an infinite [R]-descending chain from 0 is equivalent to the termination of our searching algorithm. *) Let R (x y : nat) : Prop := x = S y /\ ~ P y. Local Notation acc x := (Acc R x). Lemma P_implies_acc : forall x : nat, P x -> acc x. Proof. intros x H. constructor. intros y [_ not_Px]. absurd (P x); assumption. Qed. Lemma P_eventually_implies_acc : forall (x : nat) (n : nat), P (n + x) -> acc x. Proof. intros x n; generalize x; clear x; induction n as [|n IH]; simpl. - apply P_implies_acc. - intros x H. constructor. intros y [fxy _]. apply IH. rewrite fxy. replace (n + S x) with (S (n + x)); auto with arith. Defined. Corollary P_eventually_implies_acc_ex : (exists n : nat, P n) -> acc 0. Proof. intros H; elim H. intros x Px. apply P_eventually_implies_acc with (n := x). replace (x + 0) with x; auto with arith. Defined. (** In the following statement, we use the trick with recursion on [Acc]. This is also where decidability of [P] is used. *) Theorem acc_implies_P_eventually : acc 0 -> {n : nat | P n}. Proof. intros Acc_0. pattern 0. apply Fix_F with (R := R); [| assumption]. clear Acc_0; intros x IH. destruct (P_decidable x) as [Px | not_Px]. - exists x; simpl; assumption. - set (y := S x). assert (Ryx : R y x). + unfold R; split; auto. + destruct (IH y Ryx) as [n Hn]. exists n; assumption. Defined. Theorem constructive_indefinite_ground_description_nat_Acc : (exists n : nat, P n) -> {n : nat | P n}. Proof. intros H; apply acc_implies_P_eventually. apply P_eventually_implies_acc_ex; assumption. Defined. End ConstructiveIndefiniteGroundDescription_Acc. (************************************************************************) Section ConstructiveGroundEpsilon_nat. Variable P : nat -> Prop. Hypothesis P_decidable : forall x : nat, {P x} + {~ P x}. Definition constructive_ground_epsilon_nat (E : exists n : nat, P n) : nat := proj1_sig (constructive_indefinite_ground_description_nat P P_decidable E). Definition constructive_ground_epsilon_spec_nat (E : (exists n, P n)) : P (constructive_ground_epsilon_nat E) := proj2_sig (constructive_indefinite_ground_description_nat P P_decidable E). End ConstructiveGroundEpsilon_nat. (************************************************************************) Section ConstructiveGroundEpsilon. (** For the current purpose, we say that a set [A] is countable if there are functions [f : A -> nat] and [g : nat -> A] such that [g] is a left inverse of [f]. *) Variable A : Type. Variable f : A -> nat. Variable g : nat -> A. Hypothesis gof_eq_id : forall x : A, g (f x) = x. Variable P : A -> Prop. Hypothesis P_decidable : forall x : A, {P x} + {~ P x}. Definition P' (x : nat) : Prop := P (g x). Lemma P'_decidable : forall n : nat, {P' n} + {~ P' n}. Proof. intro n; unfold P'; destruct (P_decidable (g n)); auto. Defined. Lemma constructive_indefinite_ground_description : (exists x : A, P x) -> {x : A | P x}. Proof. intro H. assert (H1 : exists n : nat, P' n). { destruct H as [x Hx]. exists (f x); unfold P'. rewrite gof_eq_id; assumption. } apply (constructive_indefinite_ground_description_nat P' P'_decidable) in H1. destruct H1 as [n Hn]. exists (g n); unfold P' in Hn; assumption. Defined. Lemma constructive_definite_ground_description : (exists! x : A, P x) -> {x : A | P x}. Proof. intros; apply constructive_indefinite_ground_description; firstorder. Defined. Definition constructive_ground_epsilon (E : exists x : A, P x) : A := proj1_sig (constructive_indefinite_ground_description E). Definition constructive_ground_epsilon_spec (E : (exists x, P x)) : P (constructive_ground_epsilon E) := proj2_sig (constructive_indefinite_ground_description E). End ConstructiveGroundEpsilon. (* begin hide *) (* Compatibility: the qualificative "ground" was absent from the initial names of the results in this file but this had introduced confusion with the similarly named statement in Description.v *) Notation constructive_indefinite_description_nat := constructive_indefinite_ground_description_nat (only parsing). Notation constructive_epsilon_spec_nat := constructive_ground_epsilon_spec_nat (only parsing). Notation constructive_epsilon_nat := constructive_ground_epsilon_nat (only parsing). Notation constructive_indefinite_description := constructive_indefinite_ground_description (only parsing). Notation constructive_definite_description := constructive_definite_ground_description (only parsing). Notation constructive_epsilon_spec := constructive_ground_epsilon_spec (only parsing). Notation constructive_epsilon := constructive_ground_epsilon (only parsing). (* end hide *) coq-8.20.0/theories/Logic/Decidable.v000066400000000000000000000150211466560755400173060ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* (~ P -> False) -> P. Proof. unfold decidable; tauto. Qed. Theorem dec_True : decidable True. Proof. unfold decidable; auto. Qed. Theorem dec_False : decidable False. Proof. unfold decidable, not; auto. Qed. Theorem dec_or : forall A B:Prop, decidable A -> decidable B -> decidable (A \/ B). Proof. unfold decidable; tauto. Qed. Theorem dec_and : forall A B:Prop, decidable A -> decidable B -> decidable (A /\ B). Proof. unfold decidable; tauto. Qed. Theorem dec_not : forall A:Prop, decidable A -> decidable (~ A). Proof. unfold decidable; tauto. Qed. Theorem dec_imp : forall A B:Prop, decidable A -> decidable B -> decidable (A -> B). Proof. unfold decidable; tauto. Qed. Theorem dec_iff : forall A B:Prop, decidable A -> decidable B -> decidable (A<->B). Proof. unfold decidable. tauto. Qed. Theorem not_not : forall P:Prop, decidable P -> ~ ~ P -> P. Proof. unfold decidable; tauto. Qed. Theorem not_or : forall A B:Prop, ~ (A \/ B) -> ~ A /\ ~ B. Proof. tauto. Qed. Theorem not_and : forall A B:Prop, decidable A -> ~ (A /\ B) -> ~ A \/ ~ B. Proof. unfold decidable; tauto. Qed. Theorem not_imp : forall A B:Prop, decidable A -> ~ (A -> B) -> A /\ ~ B. Proof. unfold decidable; tauto. Qed. Theorem imp_simp : forall A B:Prop, decidable A -> (A -> B) -> ~ A \/ B. Proof. unfold decidable; tauto. Qed. Theorem not_iff : forall A B:Prop, decidable A -> decidable B -> ~ (A <-> B) -> (A /\ ~ B) \/ (~ A /\ B). Proof. unfold decidable; tauto. Qed. Register dec_True as core.dec.True. Register dec_False as core.dec.False. Register dec_or as core.dec.or. Register dec_and as core.dec.and. Register dec_not as core.dec.not. Register dec_imp as core.dec.imp. Register dec_iff as core.dec.iff. Register dec_not_not as core.dec.not_not. Register not_not as core.dec.dec_not_not. Register not_or as core.dec.not_or. Register not_and as core.dec.not_and. Register not_imp as core.dec.not_imp. Register imp_simp as core.dec.imp_simp. Register not_iff as core.dec.not_iff. (** Results formulated with iff, used in FSetDecide. Negation are expanded since it is unclear whether setoid rewrite will always perform conversion. *) (** We begin with lemmas that, when read from left to right, can be understood as ways to eliminate uses of [not]. *) Theorem not_true_iff : (True -> False) <-> False. Proof. tauto. Qed. Theorem not_false_iff : (False -> False) <-> True. Proof. tauto. Qed. Theorem not_not_iff : forall A:Prop, decidable A -> (((A -> False) -> False) <-> A). Proof. unfold decidable; tauto. Qed. Theorem contrapositive : forall A B:Prop, decidable A -> (((A -> False) -> (B -> False)) <-> (B -> A)). Proof. unfold decidable; tauto. Qed. Lemma or_not_l_iff_1 : forall A B: Prop, decidable A -> ((A -> False) \/ B <-> (A -> B)). Proof. unfold decidable. tauto. Qed. Lemma or_not_l_iff_2 : forall A B: Prop, decidable B -> ((A -> False) \/ B <-> (A -> B)). Proof. unfold decidable. tauto. Qed. Lemma or_not_r_iff_1 : forall A B: Prop, decidable A -> (A \/ (B -> False) <-> (B -> A)). Proof. unfold decidable. tauto. Qed. Lemma or_not_r_iff_2 : forall A B: Prop, decidable B -> (A \/ (B -> False) <-> (B -> A)). Proof. unfold decidable. tauto. Qed. Lemma imp_not_l : forall A B: Prop, decidable A -> (((A -> False) -> B) <-> (A \/ B)). Proof. unfold decidable. tauto. Qed. (** Moving Negations Around: We have four lemmas that, when read from left to right, describe how to push negations toward the leaves of a proposition and, when read from right to left, describe how to pull negations toward the top of a proposition. *) Theorem not_or_iff : forall A B:Prop, (A \/ B -> False) <-> (A -> False) /\ (B -> False). Proof. tauto. Qed. Lemma not_and_iff : forall A B:Prop, (A /\ B -> False) <-> (A -> B -> False). Proof. tauto. Qed. Lemma not_imp_iff : forall A B:Prop, decidable A -> (((A -> B) -> False) <-> A /\ (B -> False)). Proof. unfold decidable. tauto. Qed. Lemma not_imp_rev_iff : forall A B : Prop, decidable A -> (((A -> B) -> False) <-> (B -> False) /\ A). Proof. unfold decidable. tauto. Qed. (* Functional relations on decidable co-domains are decidable *) Theorem dec_functional_relation : forall (X Y : Type) (A:X->Y->Prop), (forall y y' : Y, decidable (y=y')) -> (forall x, exists! y, A x y) -> forall x y, decidable (A x y). Proof. intros X Y A Hdec H x y. destruct (H x) as (y',(Hex,Huniq)). destruct (Hdec y y') as [->|Hnot]; firstorder. Qed. (** With the following hint database, we can leverage [auto] to check decidability of propositions. *) #[global] Hint Resolve dec_True dec_False dec_or dec_and dec_imp dec_not dec_iff : decidable_prop. (** [solve_decidable using lib] will solve goals about the decidability of a proposition, assisted by an auxiliary database of lemmas. The database is intended to contain lemmas stating the decidability of base propositions, (e.g., the decidability of equality on a particular inductive type). *) Tactic Notation "solve_decidable" "using" ident(db) := match goal with | |- decidable _ => solve [ auto 100 with decidable_prop db ] end. Tactic Notation "solve_decidable" := solve_decidable using core. coq-8.20.0/theories/Logic/Description.v000066400000000000000000000020321466560755400177330ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* Prop), (exists! x, P x) -> { x : A | P x }. coq-8.20.0/theories/Logic/Diaconescu.v000066400000000000000000000241621466560755400175350ustar00rootroot00000000000000(* -*- coding: utf-8 -*- *) (************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* Excluded-Middle *) Section PredExt_RelChoice_imp_EM. (** The axiom of extensionality for predicates *) Definition PredicateExtensionality := forall P Q:bool -> Prop, (forall b:bool, P b <-> Q b) -> P = Q. (** From predicate extensionality we get propositional extensionality hence proof-irrelevance *) Import ClassicalFacts. Variable pred_extensionality : PredicateExtensionality. Lemma prop_ext : forall A B:Prop, (A <-> B) -> A = B. Proof. intros A B H. change ((fun _ => A) true = (fun _ => B) true). rewrite pred_extensionality with (P := fun _:bool => A) (Q := fun _:bool => B). - reflexivity. - intros _; exact H. Qed. Lemma proof_irrel : forall (A:Prop) (a1 a2:A), a1 = a2. Proof. apply (ext_prop_dep_proof_irrel_cic prop_ext). Qed. (** From proof-irrelevance and relational choice, we get guarded relational choice *) Import ChoiceFacts. Variable rel_choice : RelationalChoice. Lemma guarded_rel_choice : GuardedRelationalChoice. Proof. apply (rel_choice_and_proof_irrel_imp_guarded_rel_choice rel_choice proof_irrel). Qed. (** The form of choice we need: there is a functional relation which chooses an element in any non empty subset of bool *) Import Bool. Lemma AC_bool_subset_to_bool : exists R : (bool -> Prop) -> bool -> Prop, (forall P:bool -> Prop, (exists b : bool, P b) -> exists b : bool, P b /\ R P b /\ (forall b':bool, R P b' -> b = b')). Proof. destruct (guarded_rel_choice _ _ (fun Q:bool -> Prop => exists y : _, Q y) (fun (Q:bool -> Prop) (y:bool) => Q y)) as (R,(HRsub,HR)). - exact (fun _ H => H). - exists R; intros P HP. destruct (HR P HP) as (y,(Hy,Huni)). exists y; firstorder. Qed. (** The proof of the excluded middle *) (** Remark: P could have been in Set or Type *) Theorem pred_ext_and_rel_choice_imp_EM : forall P:Prop, P \/ ~ P. Proof. intro P. (* first we exhibit the choice functional relation R *) destruct AC_bool_subset_to_bool as [R H]. set (class_of_true := fun b => b = true \/ P). set (class_of_false := fun b => b = false \/ P). (* the actual "decision": is (R class_of_true) = true or false? *) destruct (H class_of_true) as [b0 [H0 [H0' H0'']]]. - exists true; left; reflexivity. - destruct H0. (* the actual "decision": is (R class_of_false) = true or false? *) + destruct (H class_of_false) as [b1 [H1 [H1' H1'']]]. * exists false; left; reflexivity. * destruct H1. -- (* case where P is false: (R class_of_true)=true /\ (R class_of_false)=false *) right. intro HP. assert (Hequiv : forall b:bool, class_of_true b <-> class_of_false b). ++ intro b; split. ** unfold class_of_false; right; assumption. ** unfold class_of_true; right; assumption. ++ assert (Heq : class_of_true = class_of_false). ** apply pred_extensionality with (1 := Hequiv). ** apply diff_true_false. rewrite <- H0. rewrite <- H1. rewrite <- H0''. { reflexivity. } rewrite Heq. assumption. -- (* cases where P is true *) left; assumption. + left; assumption. Qed. End PredExt_RelChoice_imp_EM. (**********************************************************************) (** * Proof-Irrel. + Rel. Axiom of Choice -> Excl.-Middle for Equality *) (** This is an adaptation of Diaconescu's theorem, exploiting the form of extensionality provided by proof-irrelevance *) Section ProofIrrel_RelChoice_imp_EqEM. Import ChoiceFacts. Variable rel_choice : RelationalChoice. Variable proof_irrelevance : forall P:Prop , forall x y:P, x=y. (** Let [a1] and [a2] be two elements in some type [A] *) Variable A :Type. Variables a1 a2 : A. (** We build the subset [A'] of [A] made of [a1] and [a2] *) Definition A' := @sigT A (fun x => x=a1 \/ x=a2). Definition a1':A'. exists a1 ; auto. Defined. Definition a2':A'. exists a2 ; auto. Defined. (** By proof-irrelevance, projection is a retraction *) Lemma projT1_injective : a1=a2 -> a1'=a2'. Proof. intro Heq ; unfold a1', a2', A'. rewrite Heq. replace (or_introl (a2=a2) (eq_refl a2)) with (or_intror (a2=a2) (eq_refl a2)). - reflexivity. - apply proof_irrelevance. Qed. (** But from the actual proofs of being in [A'], we can assert in the proof-irrelevant world the existence of relevant boolean witnesses *) Lemma decide : forall x:A', exists y:bool , (projT1 x = a1 /\ y = true ) \/ (projT1 x = a2 /\ y = false). Proof. intros [a [Ha1|Ha2]]; [exists true | exists false]; auto. Qed. (** Thanks to the axiom of choice, the boolean witnesses move from the propositional world to the relevant world *) Theorem proof_irrel_rel_choice_imp_eq_dec : a1=a2 \/ ~a1=a2. Proof. destruct (rel_choice A' bool (fun x y => projT1 x = a1 /\ y = true \/ projT1 x = a2 /\ y = false)) as (R,(HRsub,HR)). - apply decide. - destruct (HR a1') as (b1,(Ha1'b1,_Huni1)). destruct (HRsub a1' b1 Ha1'b1) as [(_, Hb1true)|(Ha1a2, _Hb1false)]. + destruct (HR a2') as (b2,(Ha2'b2,Huni2)). destruct (HRsub a2' b2 Ha2'b2) as [(Ha2a1, _Hb2true)|(_, Hb2false)]. * left; symmetry; assumption. * right; intro H. subst b1; subst b2. rewrite (projT1_injective H) in Ha1'b1. assert (false = true) by auto using Huni2. discriminate. + left; assumption. Qed. (** An alternative more concise proof can be done by directly using the guarded relational choice *) Lemma proof_irrel_rel_choice_imp_eq_dec' : a1=a2 \/ ~a1=a2. Proof. assert (decide: forall x:A, x=a1 \/ x=a2 -> exists y:bool, x=a1 /\ y=true \/ x=a2 /\ y=false). - intros a [Ha1|Ha2]; [exists true | exists false]; auto. - assert (guarded_rel_choice := rel_choice_and_proof_irrel_imp_guarded_rel_choice rel_choice proof_irrelevance). destruct (guarded_rel_choice A bool (fun x => x=a1 \/ x=a2) (fun x y => x=a1 /\ y=true \/ x=a2 /\ y=false)) as (R,(HRsub,HR)). + apply decide. + destruct (HR a1) as (b1,(Ha1b1,_Huni1)). * left; reflexivity. * destruct (HRsub a1 b1 Ha1b1) as [(_, Hb1true)|(Ha1a2, _Hb1false)]. -- destruct (HR a2) as (b2,(Ha2b2,Huni2)). ++ right; reflexivity. ++ destruct (HRsub a2 b2 Ha2b2) as [(Ha2a1, _Hb2true)|(_, Hb2false)]. ** left; symmetry; assumption. ** right; intro H. subst b1; subst b2; subst a1. assert (false = true) by auto using Huni2, Ha1b1. discriminate. -- left; assumption. Qed. End ProofIrrel_RelChoice_imp_EqEM. (**********************************************************************) (** * Extensional Hilbert's epsilon description operator -> Excluded-Middle *) (** Proof sketch from Bell [[Bell93]] (with thanks to P. Castéran) *) Local Notation inhabited A := A (only parsing). Section ExtensionalEpsilon_imp_EM. Variable epsilon : forall A : Type, inhabited A -> (A -> Prop) -> A. Hypothesis epsilon_spec : forall (A:Type) (i:inhabited A) (P:A->Prop), (exists x, P x) -> P (epsilon A i P). Hypothesis epsilon_extensionality : forall (A:Type) (i:inhabited A) (P Q:A->Prop), (forall a, P a <-> Q a) -> epsilon A i P = epsilon A i Q. Local Notation eps := (epsilon bool true) (only parsing). Theorem extensional_epsilon_imp_EM : forall P:Prop, P \/ ~ P. Proof. intro P. pose (B := fun y => y=false \/ P). pose (C := fun y => y=true \/ P). assert (B (eps B)) as [Hfalse|HP] by (apply epsilon_spec; exists false; left; reflexivity). - assert (C (eps C)) as [Htrue|HP] by (apply epsilon_spec; exists true; left; reflexivity). + right; intro HP. assert (forall y, B y <-> C y) by (intro y; split; intro; right; assumption). rewrite epsilon_extensionality with (1:=H) in Hfalse. rewrite Htrue in Hfalse. discriminate. + auto. - auto. Qed. End ExtensionalEpsilon_imp_EM. coq-8.20.0/theories/Logic/Epsilon.v000066400000000000000000000046351466560755400170740ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* Prop), inhabited A -> { x : A | (exists x, P x) -> P x }. Lemma constructive_indefinite_description : forall (A : Type) (P : A->Prop), (exists x, P x) -> { x : A | P x }. Proof. apply epsilon_imp_constructive_indefinite_description. exact epsilon_statement. Qed. Lemma small_drinkers'_paradox : forall (A:Type) (P:A -> Prop), inhabited A -> exists x, (exists x, P x) -> P x. Proof. apply epsilon_imp_small_drinker. exact epsilon_statement. Qed. Theorem iota_statement : forall (A : Type) (P : A->Prop), inhabited A -> { x : A | (exists! x : A, P x) -> P x }. Proof. intros; destruct epsilon_statement with (P:=P); firstorder. Qed. Lemma constructive_definite_description : forall (A : Type) (P : A->Prop), (exists! x, P x) -> { x : A | P x }. Proof. apply iota_imp_constructive_definite_description. exact iota_statement. Qed. (** Hilbert's epsilon operator and its specification *) Definition epsilon (A : Type) (i:inhabited A) (P : A->Prop) : A := proj1_sig (epsilon_statement P i). Definition epsilon_spec (A : Type) (i:inhabited A) (P : A->Prop) : (exists x, P x) -> P (epsilon i P) := proj2_sig (epsilon_statement P i). (** Church's iota operator and its specification *) Definition iota (A : Type) (i:inhabited A) (P : A->Prop) : A := proj1_sig (iota_statement P i). Definition iota_spec (A : Type) (i:inhabited A) (P : A->Prop) : (exists! x:A, P x) -> P (iota i P) := proj2_sig (iota_statement P i). coq-8.20.0/theories/Logic/Eqdep.v000066400000000000000000000030671466560755400165170ustar00rootroot00000000000000(* -*- coding: utf-8 -*- *) (************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* Type) (x:Q p) (h:p = p), x = eq_rect p Q x p h. End Eq_rect_eq. Module EqdepTheory := EqdepTheory(Eq_rect_eq). Export EqdepTheory. (** Exported hints *) #[global] Hint Resolve eq_dep_eq: eqdep. #[global] Hint Resolve inj_pair2 inj_pairT2: eqdep. coq-8.20.0/theories/Logic/EqdepFacts.v000066400000000000000000000364011466560755400174760ustar00rootroot00000000000000(* -*- coding: utf-8 -*- *) (************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* Eq_dep_eq <-> UIP <-> UIP_refl <-> K 3. Definition of the functor that builds properties of dependent equalities assuming axiom eq_rect_eq *) (************************************************************************) (** * Definition of dependent equality and equivalence with equality of dependent pairs *) Import EqNotations. (* Set Universe Polymorphism. *) Section Dependent_Equality. Variable U : Type. Variable P : U -> Type. (** Dependent equality *) Inductive eq_dep (p:U) (x:P p) : forall q:U, P q -> Prop := eq_dep_intro : eq_dep p x p x. #[local] Hint Constructors eq_dep: core. Lemma eq_dep_refl : forall (p:U) (x:P p), eq_dep p x p x. Proof eq_dep_intro. Lemma eq_dep_sym : forall (p q:U) (x:P p) (y:P q), eq_dep p x q y -> eq_dep q y p x. Proof. destruct 1; auto. Qed. #[local] Hint Immediate eq_dep_sym: core. Lemma eq_dep_trans : forall (p q r:U) (x:P p) (y:P q) (z:P r), eq_dep p x q y -> eq_dep q y r z -> eq_dep p x r z. Proof. destruct 1; auto. Qed. Scheme eq_indd := Induction for eq Sort Prop. (** Equivalent definition of dependent equality as a dependent pair of equalities *) Inductive eq_dep1 (p:U) (x:P p) (q:U) (y:P q) : Prop := eq_dep1_intro : forall h:q = p, x = rew h in y -> eq_dep1 p x q y. Lemma eq_dep1_dep : forall (p:U) (x:P p) (q:U) (y:P q), eq_dep1 p x q y -> eq_dep p x q y. Proof. destruct 1 as (eq_qp, H). destruct eq_qp using eq_indd. rewrite H. apply eq_dep_intro. Qed. Lemma eq_dep_dep1 : forall (p q:U) (x:P p) (y:P q), eq_dep p x q y -> eq_dep1 p x q y. Proof. intros p; destruct 1. apply eq_dep1_intro with (eq_refl p). simpl; trivial. Qed. End Dependent_Equality. Arguments eq_dep [U P] p x q _. Arguments eq_dep1 [U P] p x q y. (** Dependent equality is equivalent to equality on dependent pairs *) Lemma eq_sigT_eq_dep : forall (U:Type) (P:U -> Type) (p q:U) (x:P p) (y:P q), existT P p x = existT P q y -> eq_dep p x q y. Proof. intros * H. dependent rewrite H. apply eq_dep_intro. Qed. Lemma eq_dep_eq_sigT : forall (U:Type) (P:U -> Type) (p q:U) (x:P p) (y:P q), eq_dep p x q y -> existT P p x = existT P q y. Proof. destruct 1; reflexivity. Qed. Lemma eq_sigT_iff_eq_dep : forall (U:Type) (P:U -> Type) (p q:U) (x:P p) (y:P q), existT P p x = existT P q y <-> eq_dep p x q y. Proof. split; auto using eq_sigT_eq_dep, eq_dep_eq_sigT. Qed. Notation equiv_eqex_eqdep := eq_sigT_iff_eq_dep (only parsing). (* Compat *) Lemma eq_sig_eq_dep : forall (U:Type) (P:U -> Prop) (p q:U) (x:P p) (y:P q), exist P p x = exist P q y -> eq_dep p x q y. Proof. intros * H. dependent rewrite H. apply eq_dep_intro. Qed. Lemma eq_dep_eq_sig : forall (U:Type) (P:U -> Prop) (p q:U) (x:P p) (y:P q), eq_dep p x q y -> exist P p x = exist P q y. Proof. destruct 1; reflexivity. Qed. Lemma eq_sig_iff_eq_dep : forall (U:Type) (P:U -> Prop) (p q:U) (x:P p) (y:P q), exist P p x = exist P q y <-> eq_dep p x q y. Proof. split; auto using eq_sig_eq_dep, eq_dep_eq_sig. Qed. (** Dependent equality is equivalent to a dependent pair of equalities *) Set Implicit Arguments. Lemma eq_sigT_sig_eq X P (x1 x2:X) H1 H2 : existT P x1 H1 = existT P x2 H2 <-> {H:x1=x2 | rew H in H1 = H2}. Proof. split; intro H. - change x2 with (projT1 (existT P x2 H2)). change H2 with (projT2 (existT P x2 H2)) at 5. destruct H. simpl. exists eq_refl. reflexivity. - destruct H as (->,<-). reflexivity. Defined. Lemma eq_sigT_fst X P (x1 x2:X) H1 H2 (H:existT P x1 H1 = existT P x2 H2) : x1 = x2. Proof. change x2 with (projT1 (existT P x2 H2)). destruct H. reflexivity. Defined. Lemma eq_sigT_snd X P (x1 x2:X) H1 H2 (H:existT P x1 H1 = existT P x2 H2) : rew (eq_sigT_fst H) in H1 = H2. Proof. unfold eq_sigT_fst. change x2 with (projT1 (existT P x2 H2)). change H2 with (projT2 (existT P x2 H2)) at 3. destruct H. reflexivity. Defined. Lemma eq_sig_fst X P (x1 x2:X) H1 H2 (H:exist P x1 H1 = exist P x2 H2) : x1 = x2. Proof. change x2 with (proj1_sig (exist P x2 H2)). destruct H. reflexivity. Defined. Lemma eq_sig_snd X P (x1 x2:X) H1 H2 (H:exist P x1 H1 = exist P x2 H2) : rew (eq_sig_fst H) in H1 = H2. Proof. unfold eq_sig_fst, eq_ind. change x2 with (proj1_sig (exist P x2 H2)). change H2 with (proj2_sig (exist P x2 H2)) at 3. destruct H. reflexivity. Defined. Unset Implicit Arguments. (** Exported hints *) #[global] Hint Resolve eq_dep_intro: core. #[global] Hint Immediate eq_dep_sym: core. (************************************************************************) (** * Eq_rect_eq <-> Eq_dep_eq <-> UIP <-> UIP_refl <-> K *) Section Equivalences. Variable U:Type. (** Invariance by Substitution of Reflexive Equality Proofs *) Definition Eq_rect_eq_on (p : U) (Q : U -> Type) (x : Q p) := forall (h : p = p), x = eq_rect p Q x p h. Definition Eq_rect_eq := forall p Q x, Eq_rect_eq_on p Q x. (** Injectivity of Dependent Equality *) Definition Eq_dep_eq_on (P : U -> Type) (p : U) (x : P p) := forall (y : P p), eq_dep p x p y -> x = y. Definition Eq_dep_eq := forall P p x, Eq_dep_eq_on P p x. (** Uniqueness of Identity Proofs (UIP) *) Definition UIP_on_ (x y : U) (p1 : x = y) := forall (p2 : x = y), p1 = p2. Definition UIP_ := forall x y p1, UIP_on_ x y p1. (** Uniqueness of Reflexive Identity Proofs *) Definition UIP_refl_on_ (x : U) := forall (p : x = x), p = eq_refl x. Definition UIP_refl_ := forall x, UIP_refl_on_ x. (** Streicher's axiom K *) Definition Streicher_K_on_ (x : U) (P : x = x -> Prop) := P (eq_refl x) -> forall p : x = x, P p. Definition Streicher_K_ := forall x P, Streicher_K_on_ x P. (** Injectivity of Dependent Equality is a consequence of *) (** Invariance by Substitution of Reflexive Equality Proof *) Lemma eq_rect_eq_on__eq_dep1_eq_on (p : U) (P : U -> Type) (y : P p) : Eq_rect_eq_on p P y -> forall (x : P p), eq_dep1 p x p y -> x = y. Proof. intro eq_rect_eq. simple destruct 1; intro. rewrite <- eq_rect_eq; auto. Qed. Lemma eq_rect_eq__eq_dep1_eq : Eq_rect_eq -> forall (P:U->Type) (p:U) (x y:P p), eq_dep1 p x p y -> x = y. Proof (fun eq_rect_eq P p y x => @eq_rect_eq_on__eq_dep1_eq_on p P x (eq_rect_eq p P x) y). Lemma eq_rect_eq_on__eq_dep_eq_on (p : U) (P : U -> Type) (x : P p) : Eq_rect_eq_on p P x -> Eq_dep_eq_on P p x. Proof. intros eq_rect_eq; red; intros y H. symmetry; apply (eq_rect_eq_on__eq_dep1_eq_on _ _ _ eq_rect_eq). apply eq_dep_sym in H; apply eq_dep_dep1; trivial. Qed. Lemma eq_rect_eq__eq_dep_eq : Eq_rect_eq -> Eq_dep_eq. Proof (fun eq_rect_eq P p x y => @eq_rect_eq_on__eq_dep_eq_on p P x (eq_rect_eq p P x) y). (** Uniqueness of Identity Proofs (UIP) is a consequence of *) (** Injectivity of Dependent Equality *) Lemma eq_dep_eq_on__UIP_on (x y : U) (p1 : x = y) : Eq_dep_eq_on (fun y => x = y) x eq_refl -> UIP_on_ x y p1. Proof. intro eq_dep_eq; red. elim p1 using eq_indd. intros p2; apply eq_dep_eq. elim p2 using eq_indd. apply eq_dep_intro. Qed. Lemma eq_dep_eq__UIP : Eq_dep_eq -> UIP_. Proof (fun eq_dep_eq x y p1 => @eq_dep_eq_on__UIP_on x y p1 (eq_dep_eq _ _ _)). (** Uniqueness of Reflexive Identity Proofs is a direct instance of UIP *) Lemma UIP_on__UIP_refl_on (x : U) : UIP_on_ x x eq_refl -> UIP_refl_on_ x. Proof. intro UIP; red; intros; symmetry; apply UIP. Qed. Lemma UIP__UIP_refl : UIP_ -> UIP_refl_. Proof (fun UIP x p => @UIP_on__UIP_refl_on x (UIP x x eq_refl) p). (** Streicher's axiom K is a direct consequence of Uniqueness of Reflexive Identity Proofs *) Lemma UIP_refl_on__Streicher_K_on (x : U) (P : x = x -> Prop) : UIP_refl_on_ x -> Streicher_K_on_ x P. Proof. intro UIP_refl; red; intros; rewrite UIP_refl; assumption. Qed. Lemma UIP_refl__Streicher_K : UIP_refl_ -> Streicher_K_. Proof (fun UIP_refl x P => @UIP_refl_on__Streicher_K_on x P (UIP_refl x)). (** We finally recover from K the Invariance by Substitution of Reflexive Equality Proofs *) Lemma Streicher_K_on__eq_rect_eq_on (p : U) (P : U -> Type) (x : P p) : Streicher_K_on_ p (fun h => x = rew -> [P] h in x) -> Eq_rect_eq_on p P x. Proof. intro Streicher_K; red; intros. apply Streicher_K. reflexivity. Qed. Lemma Streicher_K__eq_rect_eq : Streicher_K_ -> Eq_rect_eq. Proof (fun Streicher_K p P x => @Streicher_K_on__eq_rect_eq_on p P x (Streicher_K p _)). (** Remark: It is reasonable to think that [eq_rect_eq] is strictly stronger than [eq_rec_eq] (which is [eq_rect_eq] restricted on [Set]): [Definition Eq_rec_eq := forall (P:U -> Set) (p:U) (x:P p) (h:p = p), x = eq_rec p P x p h.] Typically, [eq_rect_eq] allows proving UIP and Streicher's K what does not seem possible with [eq_rec_eq]. In particular, the proof of [UIP] requires to use [eq_rect_eq] on [fun y -> x=y] which is in [Type] but not in [Set]. *) End Equivalences. (** UIP_refl is downward closed (a short proof of the key lemma of Voevodsky's proof of inclusion of h-level n into h-level n+1; see hlevelntosn in https://github.com/vladimirias/Foundations.git). *) Theorem UIP_shift_on (X : Type) (x : X) : UIP_refl_on_ X x -> forall y : x = x, UIP_refl_on_ (x = x) y. Proof. intros UIP_refl y. rewrite (UIP_refl y). intros z. assert (UIP:forall y' y'' : x = x, y' = y''). { intros. apply eq_trans_r with (eq_refl x); apply UIP_refl. } transitivity (eq_trans (eq_trans (UIP (eq_refl x) (eq_refl x)) z) (eq_sym (UIP (eq_refl x) (eq_refl x)))). - destruct z. destruct (UIP _ _). reflexivity. - change (match eq_refl x as y' in _ = x' return y' = y' -> Prop with | eq_refl => fun z => z = (eq_refl (eq_refl x)) end (eq_trans (eq_trans (UIP (eq_refl x) (eq_refl x)) z) (eq_sym (UIP (eq_refl x) (eq_refl x))))). destruct z. destruct (UIP _ _). reflexivity. Qed. Theorem UIP_shift : forall U, UIP_refl_ U -> forall x:U, UIP_refl_ (x = x). Proof (fun U UIP_refl x => @UIP_shift_on U x (UIP_refl x)). Section Corollaries. Variable U:Type. (** UIP implies the injectivity of equality on dependent pairs in Type *) Definition Inj_dep_pair_on (P : U -> Type) (p : U) (x : P p) := forall (y : P p), existT P p x = existT P p y -> x = y. Definition Inj_dep_pair := forall P p x, Inj_dep_pair_on P p x. Lemma eq_dep_eq_on__inj_pair2_on (P : U -> Type) (p : U) (x : P p) : Eq_dep_eq_on U P p x -> Inj_dep_pair_on P p x. Proof. intro eq_dep_eq; red; intros. apply eq_dep_eq. apply eq_sigT_eq_dep. assumption. Qed. Lemma eq_dep_eq__inj_pair2 : Eq_dep_eq U -> Inj_dep_pair. Proof (fun eq_dep_eq P p x => @eq_dep_eq_on__inj_pair2_on P p x (eq_dep_eq P p x)). End Corollaries. Notation Inj_dep_pairS := Inj_dep_pair. Notation Inj_dep_pairT := Inj_dep_pair. Notation eq_dep_eq__inj_pairT2 := eq_dep_eq__inj_pair2. (************************************************************************) (** * Definition of the functor that builds properties of dependent equalities assuming axiom eq_rect_eq *) Module Type EqdepElimination. Axiom eq_rect_eq : forall (U:Type) (p:U) (Q:U -> Type) (x:Q p) (h:p = p), x = eq_rect p Q x p h. End EqdepElimination. Module EqdepTheory (M:EqdepElimination). Section Axioms. Variable U:Type. (** Invariance by Substitution of Reflexive Equality Proofs *) Lemma eq_rect_eq : forall (p:U) (Q:U -> Type) (x:Q p) (h:p = p), x = eq_rect p Q x p h. Proof M.eq_rect_eq U. Lemma eq_rec_eq : forall (p:U) (Q:U -> Set) (x:Q p) (h:p = p), x = eq_rec p Q x p h. Proof (fun p Q => M.eq_rect_eq U p Q). (** Injectivity of Dependent Equality *) Lemma eq_dep_eq : forall (P:U->Type) (p:U) (x y:P p), eq_dep p x p y -> x = y. Proof (eq_rect_eq__eq_dep_eq U eq_rect_eq). (** Uniqueness of Identity Proofs (UIP) is a consequence of *) (** Injectivity of Dependent Equality *) Lemma UIP : forall (x y:U) (p1 p2:x = y), p1 = p2. Proof (eq_dep_eq__UIP U eq_dep_eq). (** Uniqueness of Reflexive Identity Proofs is a direct instance of UIP *) Lemma UIP_refl : forall (x:U) (p:x = x), p = eq_refl x. Proof (UIP__UIP_refl U UIP). (** Streicher's axiom K is a direct consequence of Uniqueness of Reflexive Identity Proofs *) Lemma Streicher_K : forall (x:U) (P:x = x -> Prop), P (eq_refl x) -> forall p:x = x, P p. Proof (UIP_refl__Streicher_K U UIP_refl). End Axioms. (** UIP implies the injectivity of equality on dependent pairs in Type *) Lemma inj_pair2 : forall (U:Type) (P:U -> Type) (p:U) (x y:P p), existT P p x = existT P p y -> x = y. Proof (fun U => eq_dep_eq__inj_pair2 U (eq_dep_eq U)). Notation inj_pairT2 := inj_pair2. End EqdepTheory. (** Basic facts about eq_dep *) Lemma f_eq_dep : forall U (P:U->Type) R p q x y (f:forall p, P p -> R p), eq_dep p x q y -> eq_dep p (f p x) q (f q y). Proof. intros * []. reflexivity. Qed. Lemma eq_dep_non_dep : forall U P p q x y, @eq_dep U (fun _ => P) p x q y -> x = y. Proof. intros * []. reflexivity. Qed. Lemma f_eq_dep_non_dep : forall U (P:U->Type) R p q x y (f:forall p, P p -> R), eq_dep p x q y -> f p x = f q y. Proof. intros * []. reflexivity. Qed. Arguments eq_dep U P p x q _ : clear implicits. Arguments eq_dep1 U P p x q y : clear implicits. coq-8.20.0/theories/Logic/Eqdep_dec.v000066400000000000000000000266271466560755400173410ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* | in Lego adapted to Coq by B. Barras Credit: Proofs up to [K_dec] follow an outline by Michael Hedberg Table of contents: 1. Streicher's K and injectivity of dependent pair hold on decidable types 1.1. Definition of the functor that builds properties of dependent equalities from a proof of decidability of equality for a set in Type 1.2. Definition of the functor that builds properties of dependent equalities from a proof of decidability of equality for a set in Set *) (************************************************************************) (** * Streicher's K and injectivity of dependent pair hold on decidable types *) Set Implicit Arguments. (* Set Universe Polymorphism. *) Section EqdepDec. Variable A : Type. Let comp (x y y':A) (eq1:x = y) (eq2:x = y') : y = y' := eq_ind _ (fun a => a = y') eq2 _ eq1. Remark trans_sym_eq (x y:A) (u:x = y) : comp u u = eq_refl y. Proof. case u; trivial. Qed. Variable x : A. Variable eq_dec : forall y:A, x = y \/ x <> y. Let nu (y:A) (u:x = y) : x = y := match eq_dec y with | or_introl eqxy => eqxy | or_intror neqxy => False_ind _ (neqxy u) end. Local Definition nu_constant (y:A) (u v:x = y) : nu u = nu v. unfold nu. destruct (eq_dec y) as [Heq|Hneq]. - reflexivity. - case Hneq; trivial. Qed. Let nu_inv (y:A) (v:x = y) : x = y := comp (nu (eq_refl x)) v. Remark nu_left_inv_on (y:A) (u:x = y) : nu_inv (nu u) = u. Proof. case u; unfold nu_inv. apply trans_sym_eq. Qed. Theorem eq_proofs_unicity_on (y:A) (p1 p2:x = y) : p1 = p2. Proof. elim (nu_left_inv_on p1). elim (nu_left_inv_on p2). elim nu_constant with y p1 p2. reflexivity. Qed. Theorem K_dec_on (P:x = x -> Prop) (H:P (eq_refl x)) (p:x = x) : P p. Proof. elim eq_proofs_unicity_on with x (eq_refl x) p. trivial. Qed. (** The corollary *) Let proj (P:A -> Prop) (exP:ex P) (def:P x) : P x := match exP with | ex_intro _ x' prf => match eq_dec x' with | or_introl eqprf => eq_ind x' P prf x (eq_sym eqprf) | _ => def end end. Theorem inj_right_pair_on (P:A -> Prop) (y y':P x) : ex_intro P x y = ex_intro P x y' -> y = y'. Proof. intros H. cut (proj (ex_intro P x y) y = proj (ex_intro P x y') y). - simpl. destruct (eq_dec x) as [Heq|Hneq]. + elim Heq using K_dec_on; trivial. + intros. case Hneq; trivial. - case H. reflexivity. Qed. End EqdepDec. (** Now we prove the versions that require decidable equality for the entire type rather than just on the given element. The rest of the file uses this total decidable equality. We could do everything using decidable equality at a point (because the induction rule for [eq] is really an induction rule for [{ y : A | x = y }]), but we don't currently, because changing everything would break backward compatibility and no-one has yet taken the time to define the pointed versions, and then re-define the non-pointed versions in terms of those. *) Theorem eq_proofs_unicity A (eq_dec : forall x y : A, x = y \/ x <> y) (x : A) : forall (y:A) (p1 p2:x = y), p1 = p2. Proof (@eq_proofs_unicity_on A x (eq_dec x)). Theorem K_dec A (eq_dec : forall x y : A, x = y \/ x <> y) (x : A) : forall P:x = x -> Prop, P (eq_refl x) -> forall p:x = x, P p. Proof (@K_dec_on A x (eq_dec x)). Theorem inj_right_pair A (eq_dec : forall x y : A, x = y \/ x <> y) (x : A) : forall (P:A -> Prop) (y y':P x), ex_intro P x y = ex_intro P x y' -> y = y'. Proof (@inj_right_pair_on A x (eq_dec x)). Require Import EqdepFacts. (** We deduce axiom [K] for (decidable) types *) Theorem K_dec_type (A:Type) (eq_dec:forall x y:A, {x = y} + {x <> y}) (x:A) (P:x = x -> Prop) (H:P (eq_refl x)) (p:x = x) : P p. Proof. elim p using K_dec. - intros x0 y; case (eq_dec x0 y); [left|right]; assumption. - trivial. Qed. Theorem K_dec_set : forall A:Set, (forall x y:A, {x = y} + {x <> y}) -> forall (x:A) (P:x = x -> Prop), P (eq_refl x) -> forall p:x = x, P p. Proof fun A => K_dec_type (A:=A). (** We deduce the [eq_rect_eq] axiom for (decidable) types *) Theorem eq_rect_eq_dec : forall A:Type, (forall x y:A, {x = y} + {x <> y}) -> forall (p:A) (Q:A -> Type) (x:Q p) (h:p = p), x = eq_rect p Q x p h. Proof. intros A eq_dec. apply (Streicher_K__eq_rect_eq A (K_dec_type eq_dec)). Qed. (** We deduce the injectivity of dependent equality for decidable types *) Theorem eq_dep_eq_dec : forall A:Type, (forall x y:A, {x = y} + {x <> y}) -> forall (P:A->Type) (p:A) (x y:P p), eq_dep A P p x p y -> x = y. Proof (fun A eq_dec => eq_rect_eq__eq_dep_eq A (eq_rect_eq_dec eq_dec)). Theorem UIP_dec : forall (A:Type), (forall x y:A, {x = y} + {x <> y}) -> forall (x y:A) (p1 p2:x = y), p1 = p2. Proof (fun A eq_dec => eq_dep_eq__UIP A (eq_dep_eq_dec eq_dec)). Unset Implicit Arguments. (************************************************************************) (** ** Definition of the functor that builds properties of dependent equalities on decidable sets in Type *) (** The signature of decidable sets in [Type] *) Module Type DecidableType. Monomorphic Parameter U:Type. Axiom eq_dec : forall x y:U, {x = y} + {x <> y}. End DecidableType. (** The module [DecidableEqDep] collects equality properties for decidable set in [Type] *) Module DecidableEqDep (M:DecidableType). Import M. (** Invariance by Substitution of Reflexive Equality Proofs *) Lemma eq_rect_eq : forall (p:U) (Q:U -> Type) (x:Q p) (h:p = p), x = eq_rect p Q x p h. Proof eq_rect_eq_dec eq_dec. (** Injectivity of Dependent Equality *) Theorem eq_dep_eq : forall (P:U->Type) (p:U) (x y:P p), eq_dep U P p x p y -> x = y. Proof (eq_rect_eq__eq_dep_eq U eq_rect_eq). (** Uniqueness of Identity Proofs (UIP) *) Lemma UIP : forall (x y:U) (p1 p2:x = y), p1 = p2. Proof (eq_dep_eq__UIP U eq_dep_eq). (** Uniqueness of Reflexive Identity Proofs *) Lemma UIP_refl : forall (x:U) (p:x = x), p = eq_refl x. Proof (UIP__UIP_refl U UIP). (** Streicher's axiom K *) Lemma Streicher_K : forall (x:U) (P:x = x -> Prop), P (eq_refl x) -> forall p:x = x, P p. Proof (K_dec_type eq_dec). (** Injectivity of equality on dependent pairs in [Type] *) Lemma inj_pairT2 : forall (P:U -> Type) (p:U) (x y:P p), existT P p x = existT P p y -> x = y. Proof eq_dep_eq__inj_pairT2 U eq_dep_eq. (** Proof-irrelevance on subsets of decidable sets *) Lemma inj_pairP2 : forall (P:U -> Prop) (x:U) (p q:P x), ex_intro P x p = ex_intro P x q -> p = q. Proof. intros. apply inj_right_pair. - intros x0 y0; case (eq_dec x0 y0); [left|right]; assumption. - assumption. Qed. End DecidableEqDep. (************************************************************************) (** ** Definition of the functor that builds properties of dependent equalities on decidable sets in Set *) (** The signature of decidable sets in [Set] *) Module Type DecidableSet. Parameter U:Set. Axiom eq_dec : forall x y:U, {x = y} + {x <> y}. End DecidableSet. (** The module [DecidableEqDepSet] collects equality properties for decidable set in [Set] *) Module DecidableEqDepSet (M:DecidableSet). Import M. Module N:=DecidableEqDep(M). (** Invariance by Substitution of Reflexive Equality Proofs *) Lemma eq_rect_eq : forall (p:U) (Q:U -> Type) (x:Q p) (h:p = p), x = eq_rect p Q x p h. Proof eq_rect_eq_dec eq_dec. (** Injectivity of Dependent Equality *) Theorem eq_dep_eq : forall (P:U->Type) (p:U) (x y:P p), eq_dep U P p x p y -> x = y. Proof (eq_rect_eq__eq_dep_eq U eq_rect_eq). (** Uniqueness of Identity Proofs (UIP) *) Lemma UIP : forall (x y:U) (p1 p2:x = y), p1 = p2. Proof (eq_dep_eq__UIP U eq_dep_eq). (** Uniqueness of Reflexive Identity Proofs *) Lemma UIP_refl : forall (x:U) (p:x = x), p = eq_refl x. Proof (UIP__UIP_refl U UIP). (** Streicher's axiom K *) Lemma Streicher_K : forall (x:U) (P:x = x -> Prop), P (eq_refl x) -> forall p:x = x, P p. Proof (K_dec_type eq_dec). (** Proof-irrelevance on subsets of decidable sets *) Lemma inj_pairP2 : forall (P:U -> Prop) (x:U) (p q:P x), ex_intro P x p = ex_intro P x q -> p = q. Proof N.inj_pairP2. (** Injectivity of equality on dependent pairs in [Type] *) Lemma inj_pair2 : forall (P:U -> Type) (p:U) (x y:P p), existT P p x = existT P p y -> x = y. Proof eq_dep_eq__inj_pair2 U N.eq_dep_eq. (** Injectivity of equality on dependent pairs with second component in [Type] *) Notation inj_pairT2 := inj_pair2. End DecidableEqDepSet. (** From decidability to inj_pair2 **) Lemma inj_pair2_eq_dec : forall A:Type, (forall x y:A, {x=y}+{x<>y}) -> ( forall (P:A -> Type) (p:A) (x y:P p), existT P p x = existT P p y -> x = y ). Proof. intros A eq_dec. apply eq_dep_eq__inj_pair2. apply eq_rect_eq__eq_dep_eq. unfold Eq_rect_eq, Eq_rect_eq_on. intros; apply eq_rect_eq_dec. apply eq_dec. Qed. Register inj_pair2_eq_dec as core.eqdep_dec.inj_pair2. (** Examples of short direct proofs of unicity of reflexivity proofs on specific domains *) Lemma UIP_refl_unit (x : tt = tt) : x = eq_refl tt. Proof. change (match tt as b return tt = b -> Prop with | tt => fun x => x = eq_refl tt end x). destruct x; reflexivity. Defined. Lemma UIP_refl_bool (b:bool) (x : b = b) : x = eq_refl. Proof. destruct b. - change (match true as b return true=b -> Prop with | true => fun x => x = eq_refl | _ => fun _ => True end x). destruct x; reflexivity. - change (match false as b return false=b -> Prop with | false => fun x => x = eq_refl | _ => fun _ => True end x). destruct x; reflexivity. Defined. Lemma UIP_refl_nat (n:nat) (x : n = n) : x = eq_refl. Proof. induction n as [|n IHn]. - change (match 0 as n return 0=n -> Prop with | 0 => fun x => x = eq_refl | _ => fun _ => True end x). destruct x; reflexivity. - specialize IHn with (f_equal pred x). change eq_refl with (f_equal S (@eq_refl _ n)). rewrite <- IHn; clear IHn. change (match S n as n' return S n = n' -> Prop with | 0 => fun _ => True | S n' => fun x => x = f_equal S (f_equal pred x) end x). pattern (S n) at 2 3, x. destruct x; reflexivity. Defined. coq-8.20.0/theories/Logic/ExtensionalFunctionRepresentative.v000066400000000000000000000025261466560755400244000ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* B), (forall x, f x = repr f x) /\ (forall g, (forall x, f x = g x) -> repr f = repr g). coq-8.20.0/theories/Logic/ExtensionalityFacts.v000066400000000000000000000111051466560755400214510ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* Equality of projections from diagonal 3. Functional extensionality <-> Unicity of inverse bijections 4. Functional extensionality <-> Bijectivity of bijective composition *) Set Implicit Arguments. (**********************************************************************) (** * Definitions *) (** Being an inverse *) Definition is_inverse A B f g := (forall a:A, g (f a) = a) /\ (forall b:B, f (g b) = b). (** The diagonal over A and the one-one correspondence with A *) #[universes(template)] Record Delta A := { pi1:A; pi2:A; eq:pi1=pi2 }. Definition delta {A} (a:A) := {| pi1 := a; pi2 := a; eq := eq_refl a |}. Arguments pi1 {A} _. Arguments pi2 {A} _. Lemma diagonal_projs_same_behavior : forall A (x:Delta A), pi1 x = pi2 x. Proof. destruct x as (a1,a2,Heq); assumption. Qed. Lemma diagonal_inverse1 : forall A, is_inverse (A:=A) delta pi1. Proof. split; [trivial|]; destruct b as (a1,a2,[]); reflexivity. Qed. Lemma diagonal_inverse2 : forall A, is_inverse (A:=A) delta pi2. Proof. split; [trivial|]; destruct b as (a1,a2,[]); reflexivity. Qed. (** Functional extensionality *) Local Notation FunctionalExtensionality := (forall A B (f g : A -> B), (forall x, f x = g x) -> f = g). (** Equality of projections from diagonal *) Local Notation EqDeltaProjs := (forall A, pi1 = pi2 :> (Delta A -> A)). (** Unicity of bijection inverse *) Local Notation UniqueInverse := (forall A B (f:A->B) g1 g2, is_inverse f g1 -> is_inverse f g2 -> g1 = g2). (** Bijectivity of bijective composition *) Definition action A B C (f:A->B) := (fun h:B->C => fun x => h (f x)). Local Notation BijectivityBijectiveComp := (forall A B C (f:A->B) g, is_inverse f g -> is_inverse (A:=B->C) (action f) (action g)). (**********************************************************************) (** * Functional extensionality <-> Equality of projections from diagonal *) Theorem FunctExt_iff_EqDeltaProjs : FunctionalExtensionality <-> EqDeltaProjs. Proof. split. - intros FunExt *; apply FunExt, diagonal_projs_same_behavior. - intros EqProjs **; change f with (fun x => pi1 {|pi1:=f x; pi2:=g x; eq:=H x|}). rewrite EqProjs; reflexivity. Qed. (**********************************************************************) (** * Functional extensionality <-> Unicity of bijection inverse *) Lemma FunctExt_UniqInverse : FunctionalExtensionality -> UniqueInverse. Proof. intros FunExt * (Hg1f,Hfg1) (Hg2f,Hfg2). apply FunExt. intros; congruence. Qed. Lemma UniqInverse_EqDeltaProjs : UniqueInverse -> EqDeltaProjs. Proof. intros UniqInv *. apply UniqInv with delta; [apply diagonal_inverse1 | apply diagonal_inverse2]. Qed. Theorem FunctExt_iff_UniqInverse : FunctionalExtensionality <-> UniqueInverse. Proof. split. - apply FunctExt_UniqInverse. - intro; apply FunctExt_iff_EqDeltaProjs, UniqInverse_EqDeltaProjs; trivial. Qed. (**********************************************************************) (** * Functional extensionality <-> Bijectivity of bijective composition *) Lemma FunctExt_BijComp : FunctionalExtensionality -> BijectivityBijectiveComp. Proof. intros FunExt * (Hgf,Hfg). split; unfold action. - intros h; apply FunExt; intro b; rewrite Hfg; reflexivity. - intros h; apply FunExt; intro a; rewrite Hgf; reflexivity. Qed. Lemma BijComp_FunctExt : BijectivityBijectiveComp -> FunctionalExtensionality. Proof. intros BijComp. apply FunctExt_iff_UniqInverse. intros * H1 H2. destruct BijComp with (C:=A) (1:=H2) as (Hg2f,_). destruct BijComp with (C:=A) (1:=H1) as (_,Hfg1). rewrite <- (Hg2f g1). change g1 with (action g1 (fun x => x)). rewrite -> (Hfg1 (fun x => x)). reflexivity. Qed. coq-8.20.0/theories/Logic/FinFun.v000066400000000000000000000320731466560755400166450ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* A] with finite [A], f injective <-> f bijective <-> f surjective. *) #[local] Set Warnings "-stdlib-vector". Require Import List PeanoNat Compare_dec EqNat Decidable ListDec. Require Fin. Set Implicit Arguments. (** General definitions *) Definition Injective {A B} (f : A->B) := forall x y, f x = f y -> x = y. Definition Surjective {A B} (f : A->B) := forall y, exists x, f x = y. Definition Bijective {A B} (f : A->B) := exists g:B->A, (forall x, g (f x) = x) /\ (forall y, f (g y) = y). (** Finiteness is defined here via exhaustive list enumeration *) Definition Full {A:Type} (l:list A) := forall a:A, In a l. Definition Finite (A:Type) := exists (l:list A), Full l. (** In many of the following proofs, it will be convenient to have list enumerations without duplicates. As soon as we have decidability of equality (in Prop), this is equivalent to the previous notion (s. lemma Finite_dec). *) Definition Listing {A:Type} (l:list A) := NoDup l /\ Full l. Definition Finite' (A:Type) := exists (l:list A), Listing l. Lemma Listing_decidable_eq {A:Type} (l:list A): Listing l -> decidable_eq A. Proof. intros (Hnodup & Hfull) a a'. now apply (NoDup_list_decidable Hnodup). Qed. Lemma Finite_dec {A:Type}: Finite A /\ decidable_eq A <-> Finite' A. Proof. split. - intros ((l, Hfull) & Hdec). destruct (uniquify Hdec l) as (l' & H_nodup & H_inc). exists l'. split; trivial. intros a. apply H_inc. apply Hfull. - intros (l & Hlist). apply Listing_decidable_eq in Hlist as Heqdec. destruct Hlist as (Hnodup & Hfull). split; [ exists l | ]; assumption. Qed. (* Finite_alt is a weaker version of Finite_dec and has been deprecated. *) Lemma Finite_alt_deprecated A (d:decidable_eq A) : Finite A <-> Finite' A. Proof. split. - intros F. now apply Finite_dec. - intros (l & _ & F). now exists l. Qed. #[deprecated(since="8.17", note="Use Finite_dec instead.")] Notation Finite_alt := Finite_alt_deprecated. (** Injections characterized in term of lists *) Lemma Injective_map_NoDup A B (f:A->B) (l:list A) : Injective f -> NoDup l -> NoDup (map f l). Proof. intros Ij. induction 1 as [|x l X N IH]; simpl; constructor; trivial. rewrite in_map_iff. intros (y & E & Y). apply Ij in E. now subst. Qed. Lemma Injective_list_carac A B (d:decidable_eq A)(f:A->B) : Injective f <-> (forall l, NoDup l -> NoDup (map f l)). Proof. split. - intros. now apply Injective_map_NoDup. - intros H x y E. destruct (d x y); trivial. assert (N : NoDup (x::y::nil)). { repeat constructor; simpl; intuition. } specialize (H _ N). simpl in H. rewrite E in H. inversion_clear H; simpl in *; intuition. Qed. Lemma Injective_carac A B (l:list A) : Listing l -> forall (f:A->B), Injective f <-> NoDup (map f l). Proof. intros L f. split. - intros Ij. apply Injective_map_NoDup; trivial. apply L. - intros N x y E. assert (X : In x l) by apply L. assert (Y : In y l) by apply L. apply In_nth_error in X. destruct X as (i,X). apply In_nth_error in Y. destruct Y as (j,Y). assert (X' := map_nth_error f _ _ X). assert (Y' := map_nth_error f _ _ Y). assert (i = j). { rewrite NoDup_nth_error in N. apply N. - rewrite <- nth_error_Some. now rewrite X'. - rewrite X', Y'. now f_equal. } subst j. rewrite Y in X. now injection X. Qed. (** Surjection characterized in term of lists *) Lemma Surjective_list_carac A B (f:A->B): Surjective f <-> (forall lB, exists lA, incl lB (map f lA)). Proof. split. - intros Su lB. induction lB as [|b lB IH]. + now exists nil. + destruct (Su b) as (a,E). destruct IH as (lA,IC). exists (a::lA). simpl. rewrite E. intros x [X|X]; simpl; intuition. - intros H y. destruct (H (y::nil)) as (lA,IC). assert (IN : In y (map f lA)) by (apply (IC y); now left). rewrite in_map_iff in IN. destruct IN as (x & E & _). now exists x. Qed. Lemma Surjective_carac A B : Finite B -> decidable_eq B -> forall f:A->B, Surjective f <-> (exists lA, Listing (map f lA)). Proof. intros (lB,FB) d f. split. - rewrite Surjective_list_carac. intros Su. destruct (Su lB) as (lA,IC). destruct (uniquify_map d f lA) as (lA' & N & IC'). exists lA'. split; trivial. intro x. apply IC', IC, FB. - intros (lA & N & FA) y. generalize (FA y). rewrite in_map_iff. intros (x & E & _). now exists x. Qed. (** Main result : *) Lemma Endo_Injective_Surjective : forall A, Finite A -> decidable_eq A -> forall f:A->A, Injective f <-> Surjective f. Proof. intros A F d f. rewrite (Surjective_carac F d). split. - assert (Finite' A) as (l, L) by (now apply Finite_dec); clear F. rewrite (Injective_carac L); intros. exists l; split; trivial. destruct L as (N,F). assert (I : incl l (map f l)). { apply NoDup_length_incl; trivial. - now rewrite length_map. - intros x _. apply F. } intros x. apply I, F. - clear F d. intros (l,L). assert (N : NoDup l). { apply (NoDup_map_inv f), L. } assert (I : incl (map f l) l). { apply NoDup_length_incl; trivial. - now rewrite length_map. - intros x _. apply L. } assert (L' : Listing l). { split; trivial. intro x. apply I, L. } apply (Injective_carac L'), L. Qed. (** An injective and surjective function is bijective. We need here stronger hypothesis : decidability of equality in Type. *) Definition EqDec (A:Type) := forall x y:A, {x=y}+{x<>y}. (** First, we show that a surjective f has an inverse function g such that f.g = id. *) (* NB: instead of (Finite A), we could ask for (RecEnum A) with: Definition RecEnum A := exists h:nat->A, surjective h. *) Lemma Finite_Empty_or_not A : Finite A -> (A->False) \/ exists a:A,True. Proof. intros (l,F). destruct l as [|a l]. - left; exact F. - right; now exists a. Qed. Lemma Surjective_inverse : forall A B, Finite A -> EqDec B -> forall f:A->B, Surjective f -> exists g:B->A, forall x, f (g x) = x. Proof. intros A B F d f Su. destruct (Finite_Empty_or_not F) as [noA | (a,_)]. - (* A is empty : g is obtained via False_rect *) assert (noB : B -> False). { intros y. now destruct (Su y). } exists (fun y => False_rect _ (noB y)). intro y. destruct (noB y). - (* A is inhabited by a : we use it in Option.get *) destruct F as (l,F). set (h := fun x k => if d (f k) x then true else false). set (get := fun o => match o with Some y => y | None => a end). exists (fun x => get (List.find (h x) l)). intros x. case_eq (find (h x) l); simpl; clear get; [intros y H|intros H]. * apply find_some in H. destruct H as (_,H). unfold h in H. now destruct (d (f y) x) in H. * exfalso. destruct (Su x) as (y & Y). generalize (find_none _ l H y (F y)). unfold h. now destruct (d (f y) x). Qed. (** Same, with more knowledge on the inverse function: g.f = f.g = id *) Lemma Injective_Surjective_Bijective : forall A B, Finite A -> EqDec B -> forall f:A->B, Injective f -> Surjective f -> Bijective f. Proof. intros A B F d f Ij Su. destruct (Surjective_inverse F d Su) as (g, E). exists g. split; trivial. intros y. apply Ij. now rewrite E. Qed. (** An example of finite type : [Fin.t] *) Lemma Fin_Finite n : Finite (Fin.t n). Proof. induction n as [|n IHn]. - exists nil. red;inversion 1. - destruct IHn as (l,Hl). exists (Fin.F1 :: map Fin.FS l). intros a. revert n a l Hl. refine (@Fin.caseS _ _ _); intros. + now left. + right. now apply in_map. Qed. (** Instead of working on a finite subset of nat, another solution is to use restricted [nat->nat] functions, and to consider them only below a certain bound [n]. *) Definition bFun n (f:nat->nat) := forall x, x < n -> f x < n. Definition bInjective n (f:nat->nat) := forall x y, x < n -> y < n -> f x = f y -> x = y. Definition bSurjective n (f:nat->nat) := forall y, y < n -> exists x, x < n /\ f x = y. (** We show that this is equivalent to the use of [Fin.t n]. *) Module Fin2Restrict. Notation n2f := Fin.of_nat_lt. Definition f2n {n} (x:Fin.t n) := proj1_sig (Fin.to_nat x). Definition f2n_ok n (x:Fin.t n) : f2n x < n := proj2_sig (Fin.to_nat x). Definition n2f_f2n : forall n x, n2f (f2n_ok x) = x := @Fin.of_nat_to_nat_inv. Definition f2n_n2f x n h : f2n (n2f h) = x := f_equal (@proj1_sig _ _) (@Fin.to_nat_of_nat x n h). Definition n2f_ext : forall x n h h', n2f h = n2f h' := @Fin.of_nat_ext. Definition f2n_inj : forall n x y, f2n x = f2n y -> x = y := @Fin.to_nat_inj. Definition extend n (f:Fin.t n -> Fin.t n) : (nat->nat) := fun x => match le_lt_dec n x with | left _ => 0 | right h => f2n (f (n2f h)) end. Definition restrict n (f:nat->nat)(hf : bFun n f) : (Fin.t n -> Fin.t n) := fun x => let (x',h) := Fin.to_nat x in n2f (hf _ h). Ltac break_dec H := let H' := fresh "H" in destruct le_lt_dec as [H'|H']; [elim (proj1 (Nat.le_ngt _ _) H' H) |try rewrite (n2f_ext H' H) in *; try clear H']. Lemma extend_ok n f : bFun n (@extend n f). Proof. intros x h. unfold extend. break_dec h. apply f2n_ok. Qed. Lemma extend_f2n n f (x:Fin.t n) : extend f (f2n x) = f2n (f x). Proof. generalize (n2f_f2n x). unfold extend, f2n, f2n_ok. destruct (Fin.to_nat x) as (x',h); simpl. break_dec h. now intros ->. Qed. Lemma extend_n2f n f x (h:x. now apply n2f_ext. Qed. Lemma extend_surjective n f : bSurjective n (@extend n f) <-> Surjective f. Proof. split. - intros hf y. destruct (hf _ (f2n_ok y)) as (x & h & Eq). exists (n2f h). apply f2n_inj. now rewrite <- Eq, <- extend_f2n, f2n_n2f. - intros hf y hy. destruct (hf (n2f hy)) as (x,Eq). exists (f2n x). split. + apply f2n_ok. + rewrite extend_f2n, Eq. apply f2n_n2f. Qed. Lemma extend_injective n f : bInjective n (@extend n f) <-> Injective f. Proof. split. - intros hf x y Eq. apply f2n_inj. apply hf; try apply f2n_ok. now rewrite 2 extend_f2n, Eq. - intros hf x y hx hy Eq. rewrite <- (f2n_n2f hx), <- (f2n_n2f hy). f_equal. apply hf. rewrite <- 2 extend_n2f. generalize (extend_ok f hx) (extend_ok f hy). rewrite Eq. apply n2f_ext. Qed. Lemma restrict_surjective n f h : Surjective (@restrict n f h) <-> bSurjective n f. Proof. split. - intros hf y hy. destruct (hf (n2f hy)) as (x,Eq). exists (f2n x). split. + apply f2n_ok. + rewrite <- (restrict_f2n h), Eq. apply f2n_n2f. - intros hf y. destruct (hf _ (f2n_ok y)) as (x & hx & Eq). exists (n2f hx). apply f2n_inj. now rewrite restrict_f2n, f2n_n2f. Qed. Lemma restrict_injective n f h : Injective (@restrict n f h) <-> bInjective n f. Proof. split. - intros hf x y hx hy Eq. rewrite <- (f2n_n2f hx), <- (f2n_n2f hy). f_equal. apply hf. rewrite 2 restrict_n2f. generalize (h x hx) (h y hy). rewrite Eq. apply n2f_ext. - intros hf x y Eq. apply f2n_inj. apply hf; try apply f2n_ok. now rewrite <- 2 (restrict_f2n h), Eq. Qed. End Fin2Restrict. Import Fin2Restrict. (** We can now use Proof via the equivalence ... *) Lemma bInjective_bSurjective n (f:nat->nat) : bFun n f -> (bInjective n f <-> bSurjective n f). Proof. intros h. rewrite <- (restrict_injective h), <- (restrict_surjective h). apply Endo_Injective_Surjective. - apply Fin_Finite. - intros x y. destruct (Fin.eq_dec x y); [left|right]; trivial. Qed. Lemma bSurjective_bBijective n (f:nat->nat) : bFun n f -> bSurjective n f -> exists g, bFun n g /\ forall x, x < n -> g (f x) = x /\ f (g x) = x. Proof. intro hf. rewrite <- (restrict_surjective hf). intros Su. assert (Ij : Injective (restrict hf)). { apply Endo_Injective_Surjective; trivial. - apply Fin_Finite. - intros x y. destruct (Fin.eq_dec x y); [left|right]; trivial. } assert (Bi : Bijective (restrict hf)). { apply Injective_Surjective_Bijective; trivial. - apply Fin_Finite. - exact Fin.eq_dec. } destruct Bi as (g & Hg & Hg'). exists (extend g). split. - apply extend_ok. - intros x Hx. split. + now rewrite <- (f2n_n2f Hx), <- (restrict_f2n hf), extend_f2n, Hg. + now rewrite <- (f2n_n2f Hx), extend_f2n, <- (restrict_f2n hf), Hg'. Qed. coq-8.20.0/theories/Logic/FunctionalExtensionality.v000066400000000000000000000237111466560755400225210ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* B} : f = g -> forall x, f x = g x := fun H x => f_equal (fun h => h x) H. Definition equal_f_dep {A B} {f g : forall (x : A), B x} : f = g -> forall x, f x = g x := fun H x => f_equal (fun h => h x) H. (** Statements of functional extensionality for simple and dependent functions. *) Axiom functional_extensionality_dep : forall {A} {B : A -> Type}, forall (f g : forall x : A, B x), (forall x, f x = g x) -> f = g. Lemma functional_extensionality {A B} (f g : A -> B) : (forall x, f x = g x) -> f = g. Proof. intros ; eauto using @functional_extensionality_dep. Qed. (** Extensionality of [forall]s follows from functional extensionality. *) Lemma forall_extensionality {A} {B C : A -> Type} (H : forall x : A, B x = C x) : (forall x, B x) = (forall x, C x). Proof. apply functional_extensionality in H. destruct H. reflexivity. Defined. Lemma forall_extensionalityP {A} {B C : A -> Prop} (H : forall x : A, B x = C x) : (forall x, B x) = (forall x, C x). Proof. apply functional_extensionality in H. destruct H. reflexivity. Defined. Lemma forall_extensionalityS {A} {B C : A -> Set} (H : forall x : A, B x = C x) : (forall x, B x) = (forall x, C x). Proof. apply functional_extensionality in H. destruct H. reflexivity. Defined. (** A version of [functional_extensionality_dep] which is provably equal to [eq_refl] on [fun _ => eq_refl] *) Definition functional_extensionality_dep_good {A} {B : A -> Type} (f g : forall x : A, B x) (H : forall x, f x = g x) : f = g := eq_trans (eq_sym (functional_extensionality_dep f f (fun _ => eq_refl))) (functional_extensionality_dep f g H). Lemma functional_extensionality_dep_good_refl {A B} f : @functional_extensionality_dep_good A B f f (fun _ => eq_refl) = eq_refl. Proof. unfold functional_extensionality_dep_good; edestruct functional_extensionality_dep; reflexivity. Defined. Opaque functional_extensionality_dep_good. Lemma forall_sig_eq_rect {A B} (f : forall a : A, B a) (P : { g : _ | (forall a, f a = g a) } -> Type) (k : P (exist (fun g => forall a, f a = g a) f (fun a => eq_refl))) g : P g. Proof. destruct g as [g1 g2]. set (g' := fun x => (exist _ (g1 x) (g2 x))). change g2 with (fun x => proj2_sig (g' x)). change g1 with (fun x => proj1_sig (g' x)). clearbody g'; clear g1 g2. cut (forall x, (exist _ (f x) eq_refl) = g' x). { intro H'. apply functional_extensionality_dep_good in H'. destruct H'. exact k. } { intro x. destruct (g' x) as [g'x1 g'x2]. destruct g'x2. reflexivity. } Defined. Definition forall_eq_rect {A B} (f : forall a : A, B a) (P : forall g, (forall a, f a = g a) -> Type) (k : P f (fun a => eq_refl)) g H : P g H := @forall_sig_eq_rect A B f (fun g => P (proj1_sig g) (proj2_sig g)) k (exist _ g H). Definition forall_eq_rect_comp {A B} f P k : @forall_eq_rect A B f P k f (fun _ => eq_refl) = k. Proof. unfold forall_eq_rect, forall_sig_eq_rect; simpl. rewrite functional_extensionality_dep_good_refl; reflexivity. Qed. Definition f_equal__functional_extensionality_dep_good {A B f g} H a : f_equal (fun h => h a) (@functional_extensionality_dep_good A B f g H) = H a. Proof. apply (fun P k => forall_eq_rect _ P k _ H); clear H g. change (eq_refl (f a)) with (f_equal (fun h => h a) (eq_refl f)). apply f_equal, functional_extensionality_dep_good_refl. Defined. Definition f_equal__functional_extensionality_dep_good__fun {A B f g} H : (fun a => f_equal (fun h => h a) (@functional_extensionality_dep_good A B f g H)) = H. Proof. apply functional_extensionality_dep_good; intro a; apply f_equal__functional_extensionality_dep_good. Defined. (* Expressing that [equal_f_dep] and [functional_extensionality_dep_good] form an equivalence *) Definition equal_f_dep__functional_extensionality_dep_good {A B} {f g : forall x : A, B x} (H : forall x, f x = g x) : equal_f_dep (functional_extensionality_dep_good f g H) = H. Proof. apply f_equal__functional_extensionality_dep_good__fun. Defined. Definition equal_f__functional_extensionality_dep_good {A B} {f g : A -> B} (H : forall x, f x = g x) : equal_f (functional_extensionality_dep_good f g H) = H. Proof. apply f_equal__functional_extensionality_dep_good__fun. Defined. Lemma functional_extensionality_dep_good__equal_f_dep {A B} {f g : forall x : A, B x} (H : f = g) : functional_extensionality_dep_good _ _ (equal_f_dep H) = H. Proof. destruct H; simpl; apply functional_extensionality_dep_good_refl. Defined. Lemma functional_extensionality_dep_good__equal_f {A B} {f g : A -> B} (H : f = g) : functional_extensionality_dep_good _ _ (equal_f H) = H. Proof. destruct H; simpl; apply functional_extensionality_dep_good_refl. Defined. (** Apply [functional_extensionality], introducing variable x. *) Tactic Notation "extensionality" ident(x) := match goal with [ |- ?X = ?Y ] => (apply (@functional_extensionality _ _ X Y) || apply (@functional_extensionality_dep _ _ X Y) || apply forall_extensionalityP || apply forall_extensionalityS || apply forall_extensionality) ; intro x end. (** Iteratively apply [functional_extensionality] on an hypothesis until finding an equality statement *) (* Note that you can write [Ltac extensionality_in_checker tac ::= tac tt.] to get a more informative error message. *) Ltac extensionality_in_checker tac := first [ tac tt | fail 1 "Anomaly: Unexpected error in extensionality tactic. Please report." ]. Tactic Notation "extensionality" "in" hyp(H) := let rec check_is_extensional_equality H := lazymatch type of H with | _ = _ => constr:(Prop) | forall a : ?A, ?T => let Ha := fresh in constr:(forall a : A, match H a with Ha => ltac:(let v := check_is_extensional_equality Ha in exact v) end) end in let assert_is_extensional_equality H := first [ let dummy := check_is_extensional_equality H in idtac | fail 1 "Not an extensional equality" ] in let assert_not_intensional_equality H := lazymatch type of H with | _ = _ => fail "Already an intensional equality" | _ => idtac end in let enforce_no_body H := (tryif (let dummy := (eval unfold H in H) in idtac) then clearbody H else idtac) in let rec extensionality_step_make_type H := lazymatch type of H with | forall a : ?A, ?f = ?g => constr:({ H' | (fun a => f_equal (fun h => h a) H') = H }) | forall a : ?A, _ => let H' := fresh in constr:(forall a : A, match H a with H' => ltac:(let ret := extensionality_step_make_type H' in exact ret) end) end in let rec eta_contract T := lazymatch (eval cbv beta in T) with | context T'[fun a : ?A => ?f a] => let T'' := context T'[f] in eta_contract T'' | ?T => T end in let rec lift_sig_extensionality H := lazymatch type of H with | sig _ => H | forall a : ?A, _ => let Ha := fresh in let ret := constr:(fun a : A => match H a with Ha => ltac:(let v := lift_sig_extensionality Ha in exact v) end) in lazymatch type of ret with | forall a : ?A, sig (fun b : ?B => @?f a b = @?g a b) => eta_contract (exist (fun b : (forall a : A, B) => (fun a : A => f a (b a)) = (fun a : A => g a (b a))) (fun a : A => proj1_sig (ret a)) (@functional_extensionality_dep_good _ _ _ _ (fun a : A => proj2_sig (ret a)))) end end in let extensionality_pre_step H H_out Heq := let T := extensionality_step_make_type H in let H' := fresh in assert (H' : T) by (intros; eexists; apply f_equal__functional_extensionality_dep_good__fun); let H''b := lift_sig_extensionality H' in case H''b; clear H'; intros H_out Heq in let rec extensionality_rec H H_out Heq := lazymatch type of H with | forall a, _ = _ => extensionality_pre_step H H_out Heq | _ => let pre_H_out' := fresh H_out in let H_out' := fresh pre_H_out' in extensionality_pre_step H H_out' Heq; let Heq' := fresh Heq in extensionality_rec H_out' H_out Heq'; subst H_out' end in first [ assert_is_extensional_equality H | fail 1 "Not an extensional equality" ]; first [ assert_not_intensional_equality H | fail 1 "Already an intensional equality" ]; (tryif enforce_no_body H then idtac else clearbody H); let H_out := fresh in let Heq := fresh "Heq" in extensionality_in_checker ltac:(fun tt => extensionality_rec H H_out Heq); (* If we [subst H], things break if we already have another equation of the form [_ = H] *) destruct Heq; rename H_out into H. (** Eta expansion is built into Coq. *) Lemma eta_expansion_dep {A} {B : A -> Type} (f : forall x : A, B x) : f = fun x => f x. Proof. intros. reflexivity. Qed. Lemma eta_expansion {A B} (f : A -> B) : f = fun x => f x. Proof. apply (eta_expansion_dep f). Qed. coq-8.20.0/theories/Logic/HLevels.v000066400000000000000000000121511466560755400170150ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* Prop), (forall x:A, IsHProp (P x)) -> IsHProp (forall x:A, P x). Proof. intros A P H p q. apply functional_extensionality_dep. intro x. apply H. Qed. (* Homotopy propositions are stable by conjunction, but not by disjunction, which can have a proof by the left and another proof by the right. *) Lemma and_hprop : forall P Q : Prop, IsHProp P -> IsHProp Q -> IsHProp (P /\ Q). Proof. intros. intros p q. destruct p,q. replace p0 with p. - replace q0 with q. + reflexivity. + apply H0. - apply H. Qed. Lemma impl_hprop : forall P Q : Prop, IsHProp Q -> IsHProp (P -> Q). Proof. intros P Q H p q. apply functional_extensionality. intros. apply H. Qed. Lemma false_hprop : IsHProp False. Proof. intros p q. contradiction. Qed. Lemma true_hprop : IsHProp True. Proof. intros p q. destruct p,q. reflexivity. Qed. (* All negations are homotopy propositions. *) Lemma not_hprop : forall P : Type, IsHProp (P -> False). Proof. intros P p q. apply functional_extensionality. intros. contradiction. Qed. (* Homotopy propositions are included in homotopy sets. They are the first 2 levels of a cumulative hierarchy of types indexed by the natural numbers. In homotopy type theory, homotopy propositions are call (-1)-types and homotopy sets 0-types. *) Lemma hset_hprop : forall X : Type, IsHProp X -> IsHSet X. Proof. intros X H. assert (forall (x y z:X) (p : y = z), eq_trans (H x y) p = H x z). { intros. unfold eq_trans, eq_ind. destruct p. reflexivity. } assert (forall (x y z:X) (p : y = z), p = eq_trans (eq_sym (H x y)) (H x z)). { intros. rewrite <- (H0 x y z p). unfold eq_trans, eq_sym, eq_ind. destruct p, (H x y). reflexivity. } intros x y p q. rewrite (H1 x x y p), (H1 x x y q). reflexivity. Qed. Lemma eq_trans_cancel : forall {X : Type} {x y z : X} (p : x = y) (q r : y = z), (eq_trans p q = eq_trans p r) -> q = r. Proof. intros. destruct p. simpl in H. destruct r. simpl in H. rewrite eq_trans_refl_l in H. exact H. Qed. Lemma hset_hOneType : forall X : Type, IsHSet X -> IsHOneType X. Proof. intros X f x y p q. pose (fun a => f x y p a) as g. assert (forall a (r : q = a), eq_trans (g q) r = g a). { intros. destruct a. subst q. reflexivity. } intros r s. pose proof (H p (eq_sym r)). pose proof (H p (eq_sym s)). rewrite <- H1 in H0. apply eq_trans_cancel in H0. rewrite <- eq_sym_involutive. rewrite <- (eq_sym_involutive r). rewrite H0. reflexivity. Qed. (* "IsHProp X" sounds like a proposition, because it asserts a property of the type X. And indeed: *) Lemma hprop_hprop : forall X : Type, IsHProp (IsHProp X). Proof. intros X p q. apply forall_hprop. intro x. apply forall_hprop. intro y. intros f g. apply (hset_hprop X p). Qed. Lemma hprop_hset : forall X : Type, IsHProp (IsHSet X). Proof. intros X f g. apply functional_extensionality_dep. intro x. apply functional_extensionality_dep. intro y. apply functional_extensionality_dep. intro a. apply functional_extensionality_dep. intro b. apply (hset_hOneType). exact f. Qed. coq-8.20.0/theories/Logic/Hurkens.v000066400000000000000000000547111466560755400171020ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* A]) cannot be a retract of a modal proposition. It is an example of use of the paradox where the universes of system U- are not mapped to universes of Coq. - The [NoRetractToNegativeProp] module is the specialisation of the [NoRetractFromSmallPropositionToProp] module where the modality is double-negation. This result implies that the principle of weak excluded middle ([forall A, ~~A\/~A]) implies a weak variant of proof irrelevance. - The [NoRetractFromTypeToProp] module proves that [Prop] cannot be a retract of a larger type. - The [TypeNeqSmallType] module proves that [Type] is different from any smaller type. - The [PropNeqType] module proves that [Prop] is different from any larger [Type]. It is an instance of the previous result. References: - [[Coquand90]] T. Coquand, "Metamathematical Investigations of a Calculus of Constructions", Proceedings of Logic in Computer Science (LICS'90), 1990. - [[Hurkens95]] A. J. Hurkens, "A simplification of Girard's paradox", Proceedings of the 2nd international conference Typed Lambda-Calculi and Applications (TLCA'95), 1995. - [[Geuvers01]] H. Geuvers, "Inconsistency of Classical Logic in Type Theory", 2001, revised 2007 (see external link {{http://www.cs.ru.nl/~herman/PUBS/newnote.ps.gz}}). *) Set Universe Polymorphism. (* begin show *) (** * A modular proof of Hurkens's paradox. *) (** It relies on an axiomatisation of a shallow embedding of system U- (i.e. types of U- are interpreted by types of Coq). The universes are encoded in a style, due to Martin-Löf, where they are given by a set of names and a family [El:Name->Type] which interprets each name into a type. This allows the encoding of universe to be decoupled from Coq's universes. Dependent products and abstractions are similarly postulated rather than encoded as Coq's dependent products and abstractions. *) Module Generic. (* begin hide *) (* Notations used in the proof. Hidden in coqdoc. *) Reserved Notation "'∀₁' x : A , B" (at level 200, x name, A at level 200,right associativity). Reserved Notation "A '⟶₁' B" (at level 99, right associativity, B at level 200). Reserved Notation "'λ₁' x , u" (at level 200, x name, right associativity). Reserved Notation "f '·₁' x" (at level 5, left associativity). Reserved Notation "'∀₂' A , F" (at level 200, A name, right associativity). Reserved Notation "'λ₂' x , u" (at level 200, x name, right associativity). #[warning="-postfix-notation-not-level-1"] Reserved Notation "f '·₁' [ A ]" (at level 5, left associativity). Reserved Notation "'∀₀' x : A , B" (at level 200, x name, A at level 200,right associativity). Reserved Notation "A '⟶₀' B" (at level 99, right associativity, B at level 200). Reserved Notation "'λ₀' x , u" (at level 200, x name, right associativity). Reserved Notation "f '·₀' x" (at level 5, left associativity). Reserved Notation "'∀₀¹' A : U , F" (at level 200, A name, right associativity). Reserved Notation "'λ₀¹' x , u" (at level 200, x name, right associativity). #[warning="-postfix-notation-not-level-1"] Reserved Notation "f '·₀' [ A ]" (at level 5, left associativity). (* end hide *) Section Paradox. (** ** Axiomatisation of impredicative universes in a Martin-Löf style *) (** System U- has two impredicative universes. In the proof of the paradox they are slightly asymmetric (in particular the reduction rules of the small universe are not needed). Therefore, the axioms are duplicated allowing for a weaker requirement than the actual system U-. *) (** *** Large universe *) Variable U1 : Type. Variable El1 : U1 -> Type. (** **** Closure by small product *) Variable Forall1 : forall u:U1, (El1 u -> U1) -> U1. Notation "'∀₁' x : A , B" := (Forall1 A (fun x => B)). Notation "A '⟶₁' B" := (Forall1 A (fun _ => B)). Variable lam1 : forall u B, (forall x:El1 u, El1 (B x)) -> El1 (∀₁ x:u, B x). Notation "'λ₁' x , u" := (lam1 _ _ (fun x => u)). Variable app1 : forall u B (f:El1 (Forall1 u B)) (x:El1 u), El1 (B x). Notation "f '·₁' x" := (app1 _ _ f x). Variable beta1 : forall u B (f:forall x:El1 u, El1 (B x)) x, (λ₁ y, f y) ·₁ x = f x. (** **** Closure by large products *) (** [U1] only needs to quantify over itself. *) Variable ForallU1 : (U1->U1) -> U1. Notation "'∀₂' A , F" := (ForallU1 (fun A => F)). Variable lamU1 : forall F, (forall A:U1, El1 (F A)) -> El1 (∀₂ A, F A). Notation "'λ₂' x , u" := (lamU1 _ (fun x => u)). Variable appU1 : forall F (f:El1(∀₂ A,F A)) (A:U1), El1 (F A). Notation "f '·₁' [ A ]" := (appU1 _ f A). Variable betaU1 : forall F (f:forall A:U1, El1 (F A)) A, (λ₂ x, f x) ·₁ [ A ] = f A. (** *** Small universe *) (** The small universe is an element of the large one. *) Variable u0 : U1. Notation U0 := (El1 u0). Variable El0 : U0 -> Type. (** **** Closure by small product *) (** [U0] does not need reduction rules *) Variable Forall0 : forall u:U0, (El0 u -> U0) -> U0. Notation "'∀₀' x : A , B" := (Forall0 A (fun x => B)). Notation "A '⟶₀' B" := (Forall0 A (fun _ => B)). Variable lam0 : forall u B, (forall x:El0 u, El0 (B x)) -> El0 (∀₀ x:u, B x). Notation "'λ₀' x , u" := (lam0 _ _ (fun x => u)). Variable app0 : forall u B (f:El0 (Forall0 u B)) (x:El0 u), El0 (B x). Notation "f '·₀' x" := (app0 _ _ f x). (** **** Closure by large products *) Variable ForallU0 : forall u:U1, (El1 u->U0) -> U0. Notation "'∀₀¹' A : U , F" := (ForallU0 U (fun A => F)). Variable lamU0 : forall U F, (forall A:El1 U, El0 (F A)) -> El0 (∀₀¹ A:U, F A). Notation "'λ₀¹' x , u" := (lamU0 _ _ (fun x => u)). Variable appU0 : forall U F (f:El0(∀₀¹ A:U,F A)) (A:El1 U), El0 (F A). Notation "f '·₀' [ A ]" := (appU0 _ _ f A). (** ** Automating the rewrite rules of our encoding. *) Local Ltac simplify := (* spiwack: ideally we could use [rewrite_strategy] here, but I am a tad scared of the idea of depending on setoid rewrite in such a simple file. *) (repeat rewrite ?beta1, ?betaU1); lazy beta. Local Ltac simplify_in h := (repeat rewrite ?beta1, ?betaU1 in h); lazy beta in h. (** ** Hurkens's paradox. *) (** An inhabitant of [U0] standing for [False]. *) Variable F:U0. (** *** Preliminary definitions *) Definition V : U1 := ∀₂ A, ((A ⟶₁ u0) ⟶₁ A ⟶₁ u0) ⟶₁ A ⟶₁ u0. Definition U : U1 := V ⟶₁ u0. Definition sb (z:El1 V) : El1 V := λ₂ A, λ₁ r, λ₁ a, r ·₁ (z·₁[A]·₁r) ·₁ a. Definition le (i:El1 (U⟶₁u0)) (x:El1 U) : U0 := x ·₁ (λ₂ A, λ₁ r, λ₁ a, i ·₁ (λ₁ v, (sb v) ·₁ [A] ·₁ r ·₁ a)). Definition le' : El1 ((U⟶₁u0) ⟶₁ U ⟶₁ u0) := λ₁ i, λ₁ x, le i x. Definition induct (i:El1 (U⟶₁u0)) : U0 := ∀₀¹ x:U, le i x ⟶₀ i ·₁ x. Definition WF : El1 U := λ₁ z, (induct (z·₁[U] ·₁ le')). Definition I (x:El1 U) : U0 := (∀₀¹ i:U⟶₁u0, le i x ⟶₀ i ·₁ (λ₁ v, (sb v) ·₁ [U] ·₁ le' ·₁ x)) ⟶₀ F . (** *** Proof *) Lemma Omega : El0 (∀₀¹ i:U⟶₁u0, induct i ⟶₀ i ·₁ WF). Proof. refine (λ₀¹ i, λ₀ y, _). refine (y·₀[_]·₀_). unfold le,WF,induct. simplify. refine (λ₀¹ x, λ₀ h0, _). simplify. refine (y·₀[_]·₀_). unfold le. simplify. unfold sb at 1. simplify. unfold le' at 1. simplify. exact h0. Qed. Lemma lemma1 : El0 (induct (λ₁ u, I u)). Proof. unfold induct. refine (λ₀¹ x, λ₀ p, _). simplify. refine (λ₀ q,_). assert (El0 (I (λ₁ v, (sb v)·₁[U]·₁le'·₁x))) as h. { generalize (q·₀[λ₁ u, I u]·₀p). simplify. intros q'. exact q'. } refine (h·₀_). refine (λ₀¹ i,_). refine (λ₀ h', _). generalize (q·₀[λ₁ y, i ·₁ (λ₁ v, (sb v)·₁[U] ·₁ le' ·₁ y)]). simplify. intros q'. refine (q'·₀_). clear q'. unfold le at 1 in h'. simplify_in h'. unfold sb at 1 in h'. simplify_in h'. unfold le' at 1 in h'. simplify_in h'. exact h'. Qed. Lemma lemma2 : El0 ((∀₀¹i:U⟶₁u0, induct i ⟶₀ i·₁WF) ⟶₀ F). Proof. refine (λ₀ x, _). assert (El0 (I WF)) as h. { generalize (x·₀[λ₁ u, I u]·₀lemma1). simplify. intros q. exact q. } refine (h·₀_). clear h. refine (λ₀¹ i, λ₀ h0, _). generalize (x·₀[λ₁ y, i·₁(λ₁ v, (sb v)·₁[U]·₁le'·₁y)]). simplify. intros q. refine (q·₀_). clear q. unfold le in h0. simplify_in h0. unfold WF in h0. simplify_in h0. exact h0. Qed. Theorem paradox : El0 F. Proof. exact (lemma2·₀Omega). Qed. End Paradox. (** The [paradox] tactic can be called as a shortcut to use the paradox. *) Ltac paradox h := unshelve (refine ((fun h => _) (paradox _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ ))). End Generic. (** * Impredicative universes are not retracts. *) (** There can be no retract to an impredicative Coq universe from a smaller type. In this version of the proof, the impredicativity of the universe is postulated with a pair of functions from the universe to its type and back which commute with dependent product in an appropriate way. *) Module NoRetractToImpredicativeUniverse. Section Paradox. Let U2 := Type. Let U1:U2 := Type. Variable U0:U1. (** *** [U1] is impredicative *) Variable u22u1 : U2 -> U1. Hypothesis u22u1_unit : forall (c:U2), c -> u22u1 c. (** [u22u1_counit] and [u22u1_coherent] only apply to dependent product so that the equations happen in the smaller [U1] rather than [U2]. Indeed, it is not generally the case that one can project from a large universe to an impredicative universe and then get back the original type again. It would be too strong a hypothesis to require (in particular, it is not true of [Prop]). The formulation is reminiscent of the monadic characteristic of the projection from a large type to [Prop].*) Hypothesis u22u1_counit : forall (F:U1->U1), u22u1 (forall A,F A) -> (forall A,F A). Hypothesis u22u1_coherent : forall (F:U1 -> U1) (f:forall x:U1, F x) (x:U1), u22u1_counit _ (u22u1_unit _ f) x = f x. (** *** [U0] is a retract of [U1] *) Variable u02u1 : U0 -> U1. Variable u12u0 : U1 -> U0. Hypothesis u12u0_unit : forall (b:U1), b -> u02u1 (u12u0 b). Hypothesis u12u0_counit : forall (b:U1), u02u1 (u12u0 b) -> b. (** ** Paradox *) Theorem paradox : forall F:U1, F. Proof. intros F. Generic.paradox h. (** Large universe *) + exact U1. + exact (fun X => X). + cbn. exact (fun u F => forall x:u, F x). + cbn. exact (fun _ _ x => x). + cbn. exact (fun _ _ x => x). + cbn. exact (fun F => u22u1 (forall x, F x)). + cbn. exact (fun _ x => u22u1_unit _ x). + cbn. exact (fun _ x => u22u1_counit _ x). (** Small universe *) + exact U0. (** The interpretation of the small universe is the image of [U0] in [U1]. *) + cbn. exact (fun X => u02u1 X). + cbn. exact (fun u F => u12u0 (forall x:(u02u1 u), u02u1 (F x))). + cbn. exact (fun u F => u12u0 (forall x:u, u02u1 (F x))). + cbn. exact (u12u0 F). + cbn in h. exact (u12u0_counit _ h). + cbn. easy. + cbn. intros **. now rewrite u22u1_coherent. + cbn. intros * x. exact (u12u0_unit _ x). + cbn. intros * x. exact (u12u0_counit _ x). + cbn. intros * x. exact (u12u0_unit _ x). + cbn. intros * x. exact (u12u0_counit _ x). Qed. End Paradox. End NoRetractToImpredicativeUniverse. (** * Modal fragments of [Prop] are not retracts *) (** In presence of a a monadic modality on [Prop], we can define a subset of [Prop] of modal propositions which is also a complete Heyting algebra. These cannot be a retract of a modal proposition. This is a case where the universe in system U- are not encoded as Coq universes. *) Module NoRetractToModalProposition. (** ** Monadic modality *) Section Paradox. Variable M : Prop -> Prop. Hypothesis incr : forall A B:Prop, (A->B) -> M A -> M B. Lemma strength: forall A (P:A->Prop), M(forall x:A,P x) -> forall x:A,M(P x). Proof. intros A P h x. eapply incr in h; eauto. Qed. (** ** The universe of modal propositions *) Definition MProp := { P:Prop | M P -> P }. Definition El : MProp -> Prop := @proj1_sig _ _. Lemma modal : forall P:MProp, M(El P) -> El P. Proof. intros [P m]. cbn. exact m. Qed. Definition Forall {A:Type} (P:A->MProp) : MProp. Proof. unshelve (refine (exist _ _ _)). + exact (forall x:A, El (P x)). + intros h x. eapply strength in h. eauto using modal. Defined. (** ** Retract of the modal fragment of [Prop] in a small type *) (** The retract is axiomatized using logical equivalence as the equality on propositions. *) Variable bool : MProp. Variable p2b : MProp -> El bool. Variable b2p : El bool -> MProp. Hypothesis p2p1 : forall A:MProp, El (b2p (p2b A)) -> El A. Hypothesis p2p2 : forall A:MProp, El A -> El (b2p (p2b A)). (** ** Paradox *) Theorem paradox : forall B:MProp, El B. Proof. intros B. Generic.paradox h. (** Large universe *) + exact MProp. + exact El. + exact (fun _ => Forall). + cbn. exact (fun _ _ f => f). + cbn. exact (fun _ _ f => f). + exact Forall. + cbn. exact (fun _ f => f). + cbn. exact (fun _ f => f). (** Small universe *) + exact bool. + exact (fun b => El (b2p b)). + cbn. exact (fun _ F => p2b (Forall (fun x => b2p (F x)))). + exact (fun _ F => p2b (Forall (fun x => b2p (F x)))). + apply p2b. exact B. + cbn in h. auto. + cbn. easy. + cbn. easy. + cbn. auto. + cbn. intros * f. apply p2p1 in f. cbn in f. exact f. + cbn. auto. + cbn. intros * f. apply p2p1 in f. cbn in f. exact f. Qed. End Paradox. End NoRetractToModalProposition. (** * The negative fragment of [Prop] is not a retract *) (** The existence in the pure Calculus of Constructions of a retract from the negative fragment of [Prop] into a negative proposition is inconsistent. This is an instance of the previous result. *) Module NoRetractToNegativeProp. (** ** The universe of negative propositions. *) Definition NProp := { P:Prop | ~~P -> P }. Definition El : NProp -> Prop := @proj1_sig _ _. Section Paradox. (** ** Retract of the negative fragment of [Prop] in a small type *) (** The retract is axiomatized using logical equivalence as the equality on propositions. *) Variable bool : NProp. Variable p2b : NProp -> El bool. Variable b2p : El bool -> NProp. Hypothesis p2p1 : forall A:NProp, El (b2p (p2b A)) -> El A. Hypothesis p2p2 : forall A:NProp, El A -> El (b2p (p2b A)). (** ** Paradox *) Theorem paradox : forall B:NProp, El B. Proof. intros B. unshelve (refine ((fun h => _) (NoRetractToModalProposition.paradox _ _ _ _ _ _ _ _))). + exact (fun P => ~~P). + exact bool. + exact p2b. + exact b2p. + exact B. + exact h. + cbn. auto. + cbn. auto. + cbn. auto. Qed. End Paradox. End NoRetractToNegativeProp. (** * Prop is not a retract *) (** The existence in the pure Calculus of Constructions of a retract from [Prop] into a small type of [Prop] is inconsistent. This is a special case of the previous result. *) Module NoRetractFromSmallPropositionToProp. (** ** The universe of propositions. *) Definition NProp := { P:Prop | P -> P}. Definition El : NProp -> Prop := @proj1_sig _ _. Section MParadox. (** ** Retract of [Prop] in a small type, using the identity modality. *) Variable bool : NProp. Variable p2b : NProp -> El bool. Variable b2p : El bool -> NProp. Hypothesis p2p1 : forall A:NProp, El (b2p (p2b A)) -> El A. Hypothesis p2p2 : forall A:NProp, El A -> El (b2p (p2b A)). (** ** Paradox *) Theorem mparadox : forall B:NProp, El B. Proof. intros B. unshelve (refine ((fun h => _) (NoRetractToModalProposition.paradox _ _ _ _ _ _ _ _))). + exact (fun P => P). + exact bool. + exact p2b. + exact b2p. + exact B. + exact h. + cbn. auto. + cbn. auto. + cbn. auto. Qed. End MParadox. Section Paradox. (** ** Retract of [Prop] in a small type *) (** The retract is axiomatized using logical equivalence as the equality on propositions. *) Variable bool : Prop. Variable p2b : Prop -> bool. Variable b2p : bool -> Prop. Hypothesis p2p1 : forall A:Prop, b2p (p2b A) -> A. Hypothesis p2p2 : forall A:Prop, A -> b2p (p2b A). (** ** Paradox *) Theorem paradox : forall B:Prop, B. Proof. intros B. unshelve (refine (mparadox (exist _ bool (fun x => x)) _ _ _ _ (exist _ B (fun x => x)))). + intros p. red. red. exact (p2b (El p)). + cbn. intros b. red. exists (b2p b). exact (fun x => x). + cbn. intros [A H]. cbn. apply p2p1. + cbn. intros [A H]. cbn. apply p2p2. Qed. End Paradox. End NoRetractFromSmallPropositionToProp. (** * Large universes are not retracts of [Prop]. *) (** The existence in the Calculus of Constructions with universes of a retract from some [Type] universe into [Prop] is inconsistent. *) (* Note: Assuming the context [down:Type->Prop; up:Prop->Type; forth: forall (A:Type), A -> up (down A); back: forall (A:Type), up (down A) -> A; H: forall (A:Type) (P:A->Type) (a:A), P (back A (forth A a)) -> P a] is probably enough. *) Module NoRetractFromTypeToProp. Definition Type2 := Type. Definition Type1 := Type : Type2. Section Paradox. (** ** Assumption of a retract from Type into Prop *) Variable down : Type1 -> Prop. Variable up : Prop -> Type1. Hypothesis up_down : forall (A:Type1), up (down A) = A :> Type1. (** ** Paradox *) Theorem paradox : forall P:Prop, P. Proof. intros P. Generic.paradox h. (** Large universe. *) + exact Type1. + exact (fun X => X). + cbn. exact (fun u F => forall x, F x). + cbn. exact (fun _ _ x => x). + cbn. exact (fun _ _ x => x). + exact (fun F => forall A:Prop, F(up A)). + cbn. exact (fun F f A => f (up A)). + cbn. intros F f A. specialize (f (down A)). rewrite up_down in f. exact f. + exact Prop. + cbn. exact (fun X => X). + cbn. exact (fun A P => forall x:A, P x). + cbn. exact (fun A P => forall x:A, P x). + cbn. exact P. + exact h. + cbn. easy. + cbn. intros F f A. destruct (up_down A). cbn. reflexivity. + cbn. exact (fun _ _ x => x). + cbn. exact (fun _ _ x => x). + cbn. exact (fun _ _ x => x). + cbn. exact (fun _ _ x => x). Qed. End Paradox. End NoRetractFromTypeToProp. (** * [A<>Type] *) (** No Coq universe can be equal to one of its elements. *) Module TypeNeqSmallType. Unset Universe Polymorphism. Section Paradox. (** ** Universe [U] is equal to one of its elements. *) Let U := Type. Variable A:U. Hypothesis h : U=A. (** ** Universe [U] is a retract of [A] *) (** The following context is actually sufficient for the paradox to hold. The hypothesis [h:U=A] is only used to define [down], [up] and [up_down]. *) Let down (X:U) : A := @eq_rect _ _ (fun X => X) X _ h. Let up (X:A) : U := @eq_rect_r _ _ (fun X => X) X _ h. Lemma up_down : forall (X:U), up (down X) = X. Proof. unfold up,down. rewrite <- h. reflexivity. Qed. Theorem paradox : False. Proof. Generic.paradox p. (** Large universe *) + exact U. + exact (fun X=>X). + cbn. exact (fun X F => forall x:X, F x). + cbn. exact (fun _ _ x => x). + cbn. exact (fun _ _ x => x). + exact (fun F => forall x:A, F (up x)). + cbn. exact (fun _ f => fun x:A => f (up x)). + cbn. intros * f X. specialize (f (down X)). rewrite up_down in f. exact f. (** Small universe *) + exact A. (** The interpretation of [A] as a universe is [U]. *) + cbn. exact up. + cbn. exact (fun _ F => down (forall x, up (F x))). + cbn. exact (fun _ F => down (forall x, up (F x))). + cbn. exact (down False). + rewrite up_down in p. exact p. + cbn. easy. + cbn. intros ? f X. destruct (up_down X). cbn. reflexivity. + cbn. intros ? ? f. rewrite up_down. exact f. + cbn. intros ? ? f. rewrite up_down in f. exact f. + cbn. intros ? ? f. rewrite up_down. exact f. + cbn. intros ? ? f. rewrite up_down in f. exact f. Qed. End Paradox. End TypeNeqSmallType. (** * [Prop<>Type]. *) (** Special case of [TypeNeqSmallType]. *) Module PropNeqType. Theorem paradox : Prop <> Type. Proof. intros h. unshelve (refine (TypeNeqSmallType.paradox _ _)). + exact Prop. + easy. Qed. End PropNeqType. (* end show *) coq-8.20.0/theories/Logic/IndefiniteDescription.v000066400000000000000000000031341466560755400217360ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* Prop), (exists x, P x) -> { x : A | P x }. Lemma constructive_definite_description : forall (A : Type) (P : A->Prop), (exists! x, P x) -> { x : A | P x }. Proof. intros; apply constructive_indefinite_description; firstorder. Qed. Lemma functional_choice : forall (A B : Type) (R:A->B->Prop), (forall x : A, exists y : B, R x y) -> (exists f : A->B, forall x : A, R x (f x)). Proof. apply constructive_indefinite_descr_fun_choice. exact constructive_indefinite_description. Qed. coq-8.20.0/theories/Logic/JMeq.v000066400000000000000000000103651466560755400163140ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* Prop := JMeq_refl : JMeq x x. Set Elimination Schemes. Arguments JMeq_refl {A x} , [A] x. Register JMeq as core.JMeq.type. Register JMeq_refl as core.JMeq.refl. #[global] Hint Resolve JMeq_refl : core. Definition JMeq_hom {A : Type} (x y : A) := JMeq x y. Register JMeq_hom as core.JMeq.hom. Lemma JMeq_sym : forall (A B:Type) (x:A) (y:B), JMeq x y -> JMeq y x. Proof. intros A B x y H; destruct H; trivial. Qed. #[global] Hint Immediate JMeq_sym : core. Register JMeq_sym as core.JMeq.sym. Lemma JMeq_trans : forall (A B C:Type) (x:A) (y:B) (z:C), JMeq x y -> JMeq y z -> JMeq x z. Proof. destruct 2; trivial. Qed. Register JMeq_trans as core.JMeq.trans. Theorem JMeq_eq : forall (A:Type) (x y:A), JMeq x y -> x = y. Proof. intros A x y Heq. inversion Heq. now apply (inj_pairT2 _ _ A x y). Qed. Lemma JMeq_ind : forall (A:Type) (x:A) (P:A -> Prop), P x -> forall y, JMeq x y -> P y. Proof. intros A x P H y H'; case JMeq_eq with (1 := H'); trivial. Qed. Register JMeq_ind as core.JMeq.ind. Lemma JMeq_rec : forall (A:Type) (x:A) (P:A -> Set), P x -> forall y, JMeq x y -> P y. Proof. intros A x P H y H'; case JMeq_eq with (1 := H'); trivial. Qed. Lemma JMeq_rect : forall (A:Type) (x:A) (P:A->Type), P x -> forall y, JMeq x y -> P y. Proof. intros A x P H y H'; case JMeq_eq with (1 := H'); trivial. Qed. Lemma JMeq_ind_r : forall (A:Type) (x:A) (P:A -> Prop), P x -> forall y, JMeq y x -> P y. Proof. intros A x P H y H'; case JMeq_eq with (1 := JMeq_sym H'); trivial. Qed. Lemma JMeq_rec_r : forall (A:Type) (x:A) (P:A -> Set), P x -> forall y, JMeq y x -> P y. Proof. intros A x P H y H'; case JMeq_eq with (1 := JMeq_sym H'); trivial. Qed. Lemma JMeq_rect_r : forall (A:Type) (x:A) (P:A -> Type), P x -> forall y, JMeq y x -> P y. Proof. intros A x P H y H'; case JMeq_eq with (1 := JMeq_sym H'); trivial. Qed. Lemma JMeq_congr : forall (A:Type) (x:A) (B:Type) (f:A->B) (y:A), JMeq x y -> f x = f y. Proof. intros A x B f y H; case JMeq_eq with (1 := H); trivial. Qed. Register JMeq_congr as core.JMeq.congr. (** [JMeq] is equivalent to [eq_dep Type (fun X => X)] *) Require Import Eqdep. Lemma JMeq_eq_dep_id : forall (A B:Type) (x:A) (y:B), JMeq x y -> eq_dep Type (fun X => X) A x B y. Proof. destruct 1. apply eq_dep_intro. Qed. Lemma eq_dep_id_JMeq : forall (A B:Type) (x:A) (y:B), eq_dep Type (fun X => X) A x B y -> JMeq x y. Proof. destruct 1. apply JMeq_refl. Qed. (** [eq_dep U P p x q y] is strictly finer than [JMeq (P p) x (P q) y] *) Lemma eq_dep_JMeq : forall U P p x q y, eq_dep U P p x q y -> JMeq x y. Proof. destruct 1. apply JMeq_refl. Qed. Lemma eq_dep_strictly_stronger_JMeq : exists U P p q x y, JMeq x y /\ ~ eq_dep U P p x q y. Proof. exists bool. exists (fun _ => True). exists true. exists false. exists I. exists I. split. - trivial. - intro H. assert (true=false) by (destruct H; reflexivity). discriminate. Qed. (** However, when the dependencies are equal, [JMeq (P p) x (P q) y] is as strong as [eq_dep U P p x q y] (this uses [JMeq_eq]) *) Lemma JMeq_eq_dep : forall U (P:U->Type) p q (x:P p) (y:P q), p = q -> JMeq x y -> eq_dep U P p x q y. Proof. intros U P p q x y H H0. destruct H. apply JMeq_eq in H0 as ->. reflexivity. Qed. (* Compatibility *) Notation sym_JMeq := JMeq_sym (only parsing). Notation trans_JMeq := JMeq_trans (only parsing). coq-8.20.0/theories/Logic/ProofIrrelevance.v000066400000000000000000000020621466560755400207200ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* Type) (x:Q p) (h:p = p), x = eq_rect p Q x p h. Proof. intros U p Q x h; rewrite (M.proof_irrelevance _ h (eq_refl p)). reflexivity. Qed. End Eq_rect_eq. (** Export the theory of injective dependent elimination *) Module EqdepTheory := EqdepTheory(Eq_rect_eq). Export EqdepTheory. Scheme eq_indd := Induction for eq Sort Prop. (** We derive the irrelevance of the membership property for subsets *) Lemma subset_eq_compat : forall (U:Type) (P:U->Prop) (x y:U) (p:P x) (q:P y), x = y -> exist P x p = exist P y q. Proof. intros U P x y p q H. rewrite (M.proof_irrelevance _ q (eq_rect x P p y H)). elim H using eq_indd. reflexivity. Qed. Lemma subsetT_eq_compat : forall (U:Type) (P:U->Prop) (x y:U) (p:P x) (q:P y), x = y -> existT P x p = existT P y q. Proof. intros U P x y p q H. rewrite (M.proof_irrelevance _ q (eq_rect x P p y H)). elim H using eq_indd. reflexivity. Qed. End ProofIrrelevanceTheory. coq-8.20.0/theories/Logic/PropExtensionality.v000066400000000000000000000020071466560755400213320ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* Q) -> P = Q. Require Import ClassicalFacts. Theorem proof_irrelevance : forall (P:Prop) (p1 p2:P), p1 = p2. Proof. apply ext_prop_dep_proof_irrel_cic. exact propositional_extensionality. Qed. coq-8.20.0/theories/Logic/PropExtensionalityFacts.v000066400000000000000000000100161466560755400223120ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* Proposition extensionality + Propositional functional extensionality 2.2 Propositional extensionality -> Provable propositional extensionality 2.3 Propositional extensionality -> Refutable propositional extensionality *) Set Implicit Arguments. (**********************************************************************) (** * Definitions *) (** Propositional extensionality *) Local Notation PropositionalExtensionality := (forall A B : Prop, (A <-> B) -> A = B). (** Provable-proposition extensionality *) Local Notation ProvablePropositionExtensionality := (forall A:Prop, A -> A = True). (** Refutable-proposition extensionality *) Local Notation RefutablePropositionExtensionality := (forall A:Prop, ~A -> A = False). (** Predicate extensionality *) Local Notation PredicateExtensionality := (forall (A:Type) (P Q : A -> Prop), (forall x, P x <-> Q x) -> P = Q). (** Propositional functional extensionality *) Local Notation PropositionalFunctionalExtensionality := (forall (A:Type) (P Q : A -> Prop), (forall x, P x = Q x) -> P = Q). (**********************************************************************) (** * Propositional and predicate extensionality *) (**********************************************************************) (** ** Predicate extensionality <-> Propositional extensionality + Propositional functional extensionality *) Lemma PredExt_imp_PropExt : PredicateExtensionality -> PropositionalExtensionality. Proof. intros Ext A B Equiv. change A with ((fun _ => A) I). now rewrite Ext with (P := fun _ : True =>A) (Q := fun _ => B). Qed. Lemma PredExt_imp_PropFunExt : PredicateExtensionality -> PropositionalFunctionalExtensionality. Proof. intros Ext A P Q Eq. apply Ext. intros x. now rewrite (Eq x). Qed. Lemma PropExt_and_PropFunExt_imp_PredExt : PropositionalExtensionality -> PropositionalFunctionalExtensionality -> PredicateExtensionality. Proof. intros Ext FunExt A P Q Equiv. apply FunExt. intros x. now apply Ext. Qed. Theorem PropExt_and_PropFunExt_iff_PredExt : PropositionalExtensionality /\ PropositionalFunctionalExtensionality <-> PredicateExtensionality. Proof. firstorder using PredExt_imp_PropExt, PredExt_imp_PropFunExt, PropExt_and_PropFunExt_imp_PredExt. Qed. (**********************************************************************) (** ** Propositional extensionality and provable proposition extensionality *) Lemma PropExt_imp_ProvPropExt : PropositionalExtensionality -> ProvablePropositionExtensionality. Proof. intros Ext A Ha; apply Ext; split; trivial. Qed. (**********************************************************************) (** ** Propositional extensionality and refutable proposition extensionality *) Lemma PropExt_imp_RefutPropExt : PropositionalExtensionality -> RefutablePropositionExtensionality. Proof. intros Ext A Ha; apply Ext; split; easy. Qed. coq-8.20.0/theories/Logic/PropFacts.v000066400000000000000000000034631466560755400173620ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* Prop) (inj : forall A B, (f A <-> f B) -> (A <-> B)) (ext : forall A B, A <-> B -> f A <-> f B) : forall A, f (f A) <-> A. Proof. intros. enough (f (f (f A)) <-> f A) by (apply inj; assumption). split; intro H. - now_show (f A). enough (f A <-> True) by firstorder. enough (f (f A) <-> f True) by (apply inj; assumption). split; intro H'. + now_show (f True). enough (f (f (f A)) <-> f True) by firstorder. apply ext; firstorder. + now_show (f (f A)). enough (f (f A) <-> True) by firstorder. apply inj; firstorder. - now_show (f (f (f A))). enough (f A <-> f (f (f A))) by firstorder. apply ext. split; intro H'. + now_show (f (f A)). enough (f A <-> f (f A)) by firstorder. apply ext; firstorder. + now_show A. enough (f A <-> A) by firstorder. apply inj; firstorder. Defined. coq-8.20.0/theories/Logic/RelationalChoice.v000066400000000000000000000016661466560755400206710ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* B->Prop), (forall x : A, exists y : B, R x y) -> exists R' : A->B->Prop, subrelation R' R /\ forall x : A, exists! y : B, R' x y. coq-8.20.0/theories/Logic/SetIsType.v000066400000000000000000000021231466560755400173420ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* A -> Prop, forall T : A -> B -> Prop, Equivalence R -> (forall x x' y, R x x' -> T x y -> T x' y) -> (forall x, exists y, T x y) -> exists f : A -> B, forall x : A, T x (f x) /\ (forall x' : A, R x x' -> f x = f x'). Proof. apply setoid_functional_choice_first_characterization. split; [|split]. - exact choice. - exact extensional_function_representative. - exact classic. Qed. Theorem representative_choice : forall A (R:A->A->Prop), (Equivalence R) -> exists f : A->A, forall x : A, R x (f x) /\ forall x', R x x' -> f x = f x'. Proof. apply setoid_fun_choice_imp_repr_fun_choice. exact setoid_choice. Qed. coq-8.20.0/theories/Logic/StrictProp.v000066400000000000000000000024761466560755400175750ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* Squash A. Arguments squash {_} _. Inductive sEmpty : SProp :=. Inductive sUnit : SProp := stt. Set Primitive Projections. Record Ssig {A:Type} (P:A->SProp) := Sexists { Spr1 : A; Spr2 : P Spr1 }. Arguments Sexists {_} _ _ _. Arguments Spr1 {_ _} _. Arguments Spr2 {_ _} _. Lemma Spr1_inj {A P} {a b : @Ssig A P} (e : Spr1 a = Spr1 b) : a = b. Proof. destruct a,b;simpl in e. destruct e. reflexivity. Defined. coq-8.20.0/theories/Logic/WKL.v000066400000000000000000000230271466560755400161140ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* Prop) : nat -> list bool -> Prop := | here l : ~ P l -> is_path_from P 0 l | next_left l n : ~ P l -> is_path_from P n (true::l) -> is_path_from P (S n) l | next_right l n : ~ P l -> is_path_from P n (false::l) -> is_path_from P (S n) l. (** We give the characterization of is_path_from in terms of a more common arithmetical formula *) Proposition is_path_from_characterization P n l : is_path_from P n l <-> exists l', length l' = n /\ forall n', n'<=n -> ~ P (rev (firstn n' l') ++ l). Proof. intros. split. - induction 1 as [|* HP _ (l'&Hl'&HPl')|* HP _ (l'&Hl'&HPl')]. + exists []. split. * reflexivity. * intros n ->%Nat.le_0_r. assumption. + exists (true :: l'). split. * apply eq_S, Hl'. * intros [|] H. -- assumption. -- simpl. rewrite <- app_assoc. apply HPl', le_S_n, H. + exists (false :: l'). split. * apply eq_S, Hl'. * intros [|] H. -- assumption. -- simpl. rewrite <- app_assoc. apply HPl', le_S_n, H. - intros (l'& <- &HPl'). induction l' as [|[|]] in l, HPl' |- *. + constructor. apply (HPl' 0). apply Nat.le_0_l. + eapply next_left. * apply (HPl' 0), Nat.le_0_l. * fold (length l'). apply IHl'. intros n' H%le_n_S. apply HPl' in H. simpl in H. rewrite <- app_assoc in H. assumption. + apply next_right. * apply (HPl' 0), Nat.le_0_l. * fold (length l'). apply IHl'. intros n' H%le_n_S. apply HPl' in H. simpl in H. rewrite <- app_assoc in H. assumption. Qed. (** [infinite_from P l] means that we can find arbitrary long paths along which [P] does not hold above [l] *) Definition infinite_from (P:list bool -> Prop) l := forall n, is_path_from P n l. (** [has_infinite_path P] means that there is an infinite path (represented as a predicate) along which [P] does not hold at all *) Definition has_infinite_path (P:list bool -> Prop) := exists (X:nat -> Prop), forall l, approx X l -> ~ P l. (** [inductively_barred_at P n l] means that [P] eventually holds above [l] after at most [n] steps upwards *) Inductive inductively_barred_at (P:list bool -> Prop) : nat -> list bool -> Prop := | now_at l n : P l -> inductively_barred_at P n l | propagate_at l n : inductively_barred_at P n (true::l) -> inductively_barred_at P n (false::l) -> inductively_barred_at P (S n) l. (** The proof proceeds by building a set [Y] of finite paths approximating either the smallest unbarred infinite path in [P], if there is one (taking [true]>[false]), or the path true::true::... if [P] happens to be inductively_barred *) Fixpoint Y P (l:list bool) := match l with | [] => True | b::l => Y P l /\ if b then exists n, inductively_barred_at P n (false::l) else infinite_from P (false::l) end. Require Import Compare_dec. Lemma is_path_from_restrict : forall P n n' l, n <= n' -> is_path_from P n' l -> is_path_from P n l. Proof. intros * Hle H; induction H in n, Hle, H |- * ; intros. - apply Nat.le_0_r in Hle as ->. apply here. assumption. - destruct n. + apply here. assumption. + apply Nat.succ_le_mono in Hle. apply next_left; auto. - destruct n. + apply here. assumption. + apply Nat.succ_le_mono in Hle. apply next_right; auto. Qed. Lemma inductively_barred_at_monotone : forall P l n n', n' <= n -> inductively_barred_at P n' l -> inductively_barred_at P n l. Proof. intros * Hle Hbar. induction Hbar in n, l, Hle, Hbar |- *. - apply now_at; auto. - destruct n; [apply Nat.nle_succ_0 in Hle; contradiction|]. apply Nat.succ_le_mono in Hle. apply propagate_at; auto. Qed. Definition demorgan_or (P:list bool -> Prop) l l' := ~ (P l /\ P l') -> ~ P l \/ ~ P l'. Definition demorgan_inductively_barred_at P := forall n l, demorgan_or (inductively_barred_at P n) (true::l) (false::l). Lemma inductively_barred_at_imp_is_path_from : forall P, demorgan_inductively_barred_at P -> forall n l, ~ inductively_barred_at P n l -> is_path_from P n l. Proof. intros P Hdemorgan; induction n; intros l H. - apply here. intro. apply H. apply now_at. auto. - assert (H0:~ (inductively_barred_at P n (true::l) /\ inductively_barred_at P n (false::l))) by firstorder using inductively_barred_at. assert (HnP:~ P l) by firstorder using inductively_barred_at. apply Hdemorgan in H0 as [H0|H0]; apply IHn in H0; auto using is_path_from. Qed. Lemma is_path_from_imp_inductively_barred_at : forall P n l, is_path_from P n l -> inductively_barred_at P n l -> False. Proof. intros P; induction n; intros l H1 H2. - inversion_clear H1. inversion_clear H2. auto. - inversion_clear H1. + inversion_clear H2. * auto. * apply IHn with (true::l); auto. + inversion_clear H2. * auto. * apply IHn with (false::l); auto. Qed. Lemma find_left_path : forall P l n, is_path_from P (S n) l -> inductively_barred_at P n (false :: l) -> is_path_from P n (true :: l). Proof. inversion 1; subst; intros. - auto. - exfalso. eauto using is_path_from_imp_inductively_barred_at. Qed. Lemma Y_unique : forall P, demorgan_inductively_barred_at P -> forall l1 l2, length l1 = length l2 -> Y P l1 -> Y P l2 -> l1 = l2. Proof. intros * DeMorgan. induction l1, l2. - trivial. - discriminate. - discriminate. - intros [= H] (HY1,H1) (HY2,H2). pose proof (IHl1 l2 H HY1 HY2). clear HY1 HY2 H IHl1. subst l1. f_equal. destruct a, b; try reflexivity. + destruct H1 as (n,Hbar). destruct (is_path_from_imp_inductively_barred_at _ _ _ (H2 n) Hbar). + destruct H2 as (n,Hbar). destruct (is_path_from_imp_inductively_barred_at _ _ _ (H1 n) Hbar). Qed. (** [X] is the translation of [Y] as a predicate *) Definition X P n := exists l, length l = n /\ Y P (true::l). Lemma Y_approx : forall P, demorgan_inductively_barred_at P -> forall l, approx (X P) l -> Y P l. Proof. intros P DeMorgan. induction l. - trivial. - intros (H,Hb). split. + auto. + unfold X in Hb. destruct a. * destruct Hb as (l',(Hl',(HYl',HY))). rewrite <- (Y_unique P DeMorgan l' l Hl'); auto. * intro n. apply inductively_barred_at_imp_is_path_from. -- assumption. -- firstorder. Qed. (** Main theorem *) Theorem PreWeakKonigsLemma : forall P, demorgan_inductively_barred_at P -> infinite_from P [] -> has_infinite_path P. Proof. intros P DeMorgan Hinf. exists (X P). intros l Hl. assert (infinite_from P l). { induction l. - assumption. - destruct Hl as (Hl,Ha). intros n. pose proof (IHl Hl) as IHl'. clear IHl. apply Y_approx in Hl; [|assumption]. destruct a. + destruct Ha as (l'&Hl'&HY'&n'&Hbar). rewrite (Y_unique _ DeMorgan _ _ Hl' HY' Hl) in Hbar. destruct (le_lt_dec n n') as [Hle|Hlt]. * specialize (IHl' (S n')). apply is_path_from_restrict with n'; [assumption|]. apply find_left_path; trivial. * specialize (IHl' (S n)). apply inductively_barred_at_monotone with (n:=n) in Hbar; [|apply Nat.lt_le_incl, Hlt]. apply find_left_path; trivial. + apply inductively_barred_at_imp_is_path_from; firstorder. } specialize (H 0). inversion H. assumption. Qed. Lemma inductively_barred_at_decidable : forall P, (forall l, P l \/ ~ P l) -> forall n l, inductively_barred_at P n l \/ ~ inductively_barred_at P n l. Proof. intros P HP. induction n; intros. - destruct (HP l). + left. apply now_at, H. + right. inversion 1. auto. - destruct (HP l). + left. apply now_at, H. + destruct (IHn (true::l)). * destruct (IHn (false::l)). { left. apply propagate_at; assumption. } { right. inversion_clear 1; auto. } * right. inversion_clear 1; auto. Qed. Lemma inductively_barred_at_is_path_from_decidable : forall P, (forall l, P l \/ ~ P l) -> demorgan_inductively_barred_at P. Proof. intros P Hdec n l H. destruct (inductively_barred_at_decidable P Hdec n (true::l)). - destruct (inductively_barred_at_decidable P Hdec n (false::l)). + auto. + auto. - auto. Qed. (** Main corollary *) Corollary WeakKonigsLemma : forall P, (forall l, P l \/ ~ P l) -> infinite_from P [] -> has_infinite_path P. Proof. intros P Hdec Hinf. apply inductively_barred_at_is_path_from_decidable in Hdec. apply PreWeakKonigsLemma; assumption. Qed. coq-8.20.0/theories/Logic/WeakFan.v000066400000000000000000000066701466560755400170000ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* Prop := | now l : P l -> inductively_barred P l | propagate l : inductively_barred P (true::l) -> inductively_barred P (false::l) -> inductively_barred P l. (** [approx X l] says that [l] is a boolean representation of a prefix of [X] *) Fixpoint approx X (l:list bool) := match l with | [] => True | b::l => approx X l /\ (if b then X (length l) else ~ X (length l)) end. (** [barred P] means that for any infinite path represented as a predicate, the property [P] holds for some prefix of the path *) Definition barred P := forall (X:nat -> Prop), exists l, approx X l /\ P l. (** The proof proceeds by building a set [Y] of finite paths approximating either the smallest unbarred infinite path in [P], if there is one (taking [true]>[false]), or the path [true::true::...] if [P] happens to be inductively_barred *) Fixpoint Y P (l:list bool) := match l with | [] => True | b::l => Y P l /\ if b then inductively_barred P (false::l) else ~ inductively_barred P (false::l) end. Lemma Y_unique : forall P l1 l2, length l1 = length l2 -> Y P l1 -> Y P l2 -> l1 = l2. Proof. induction l1, l2. - trivial. - discriminate. - discriminate. - intros H (HY1,H1) (HY2,H2). injection H as [= H]. pose proof (IHl1 l2 H HY1 HY2). clear HY1 HY2 H IHl1. subst l1. f_equal. destruct a, b; firstorder. Qed. (** [X] is the translation of [Y] as a predicate *) Definition X P n := exists l, length l = n /\ Y P (true::l). Lemma Y_approx : forall P l, approx (X P) l -> Y P l. Proof. induction l. - trivial. - intros (H,Hb). split. + auto. + unfold X in Hb. destruct a. * destruct Hb as (l',(Hl',(HYl',HY))). rewrite <- (Y_unique P l' l Hl'); auto. * firstorder. Qed. Theorem WeakFanTheorem : forall P, barred P -> inductively_barred P []. Proof. intros P Hbar. destruct Hbar with (X P) as (l,(Hd%Y_approx,HP)). assert (inductively_barred P l) by (apply (now P l), HP). clear Hbar HP. induction l as [|a l]. - assumption. - destruct Hd as (Hd,HX). apply (IHl Hd). clear IHl. destruct a; unfold X in HX; simpl in HX. + apply propagate; assumption. + exfalso; destruct (HX H). Qed. coq-8.20.0/theories/MSets/000077500000000000000000000000001466560755400152625ustar00rootroot00000000000000coq-8.20.0/theories/MSets/MSetAVL.v000066400000000000000000000623551466560755400166770ustar00rootroot00000000000000(* -*- coding: utf-8 -*- *) (************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* 0 | Node h _ _ _ => h end. (** ** Singleton set *) Definition singleton x := Node 1 Leaf x Leaf. (** ** Helper functions *) (** [create l x r] creates a node, assuming [l] and [r] to be balanced and [|height l - height r| <= 2]. *) Definition create l x r := Node (max (height l) (height r) + 1) l x r. (** [bal l x r] acts as [create], but performs one step of rebalancing if necessary, i.e. assumes [|height l - height r| <= 3]. *) Definition assert_false := create. Definition bal l x r := let hl := height l in let hr := height r in if (hr+2) assert_false l x r | Node _ ll lx lr => if (height lr) <=? (height ll) then create ll lx (create lr x r) else match lr with | Leaf => assert_false l x r | Node _ lrl lrx lrr => create (create ll lx lrl) lrx (create lrr x r) end end else if (hl+2) assert_false l x r | Node _ rl rx rr => if (height rl) <=? (height rr) then create (create l x rl) rx rr else match rl with | Leaf => assert_false l x r | Node _ rll rlx rlr => create (create l x rll) rlx (create rlr rx rr) end end else create l x r. (** ** Insertion *) Fixpoint add x s := match s with | Leaf => Node 1 Leaf x Leaf | Node h l y r => match X.compare x y with | Lt => bal (add x l) y r | Eq => Node h l y r | Gt => bal l y (add x r) end end. (** ** Join Same as [bal] but does not assume anything regarding heights of [l] and [r]. *) Fixpoint join l : elt -> t -> t := match l with | Leaf => add | Node lh ll lx lr => fun x => fix join_aux (r:t) : t := match r with | Leaf => add x l | Node rh rl rx rr => if (rh+2) (r,x) | Node lh ll lx lr => let (l',m) := remove_min ll lx lr in (bal l' x r, m) end. (** ** Merging two trees [merge t1 t2] builds the union of [t1] and [t2] assuming all elements of [t1] to be smaller than all elements of [t2], and [|height t1 - height t2| <= 2]. *) Definition merge s1 s2 := match s1,s2 with | Leaf, _ => s2 | _, Leaf => s1 | _, Node _ l2 x2 r2 => let (s2',m) := remove_min l2 x2 r2 in bal s1 m s2' end. (** ** Deletion *) Fixpoint remove x s := match s with | Leaf => Leaf | Node _ l y r => match X.compare x y with | Lt => bal (remove x l) y r | Eq => merge l r | Gt => bal l y (remove x r) end end. (** ** Concatenation Same as [merge] but does not assume anything about heights. *) Definition concat s1 s2 := match s1, s2 with | Leaf, _ => s2 | _, Leaf => s1 | _, Node _ l2 x2 r2 => let (s2',m) := remove_min l2 x2 r2 in join s1 m s2' end. (** ** Splitting [split x s] returns a triple [(l, present, r)] where - [l] is the set of elements of [s] that are [< x] - [r] is the set of elements of [s] that are [> x] - [present] is [true] if and only if [s] contains [x]. *) Record triple := mktriple { t_left:t; t_in:bool; t_right:t }. Notation "<< l , b , r >>" := (mktriple l b r) (at level 9). Fixpoint split x s : triple := match s with | Leaf => << Leaf, false, Leaf >> | Node _ l y r => match X.compare x y with | Lt => let (ll,b,rl) := split x l in << ll, b, join rl y r >> | Eq => << l, true, r >> | Gt => let (rl,b,rr) := split x r in << join l y rl, b, rr >> end end. (** ** Intersection *) Fixpoint inter s1 s2 := match s1, s2 with | Leaf, _ => Leaf | _, Leaf => Leaf | Node _ l1 x1 r1, _ => let (l2',pres,r2') := split x1 s2 in if pres then join (inter l1 l2') x1 (inter r1 r2') else concat (inter l1 l2') (inter r1 r2') end. (** ** Difference *) Fixpoint diff s1 s2 := match s1, s2 with | Leaf, _ => Leaf | _, Leaf => s1 | Node _ l1 x1 r1, _ => let (l2',pres,r2') := split x1 s2 in if pres then concat (diff l1 l2') (diff r1 r2') else join (diff l1 l2') x1 (diff r1 r2') end. (** ** Union *) (** In ocaml, heights of [s1] and [s2] are compared each time in order to recursively perform the split on the smaller set. Unfortunately, this leads to a non-structural algorithm. The following code is a simplification of the ocaml version: no comparison of heights. It might be slightly slower, but experimentally all the tests I've made in ocaml have shown this potential slowdown to be non-significant. Anyway, the exact code of ocaml has also been formalized thanks to Function+measure, see [ocaml_union] in [MSetFullAVL]. *) Fixpoint union s1 s2 := match s1, s2 with | Leaf, _ => s2 | _, Leaf => s1 | Node _ l1 x1 r1, _ => let (l2',_,r2') := split x1 s2 in join (union l1 l2') x1 (union r1 r2') end. (** ** Filter *) Fixpoint filter (f:elt->bool) s := match s with | Leaf => Leaf | Node _ l x r => let l' := filter f l in let r' := filter f r in if f x then join l' x r' else concat l' r' end. (** ** Partition *) Fixpoint partition (f:elt->bool)(s : t) : t*t := match s with | Leaf => (Leaf, Leaf) | Node _ l x r => let (l1,l2) := partition f l in let (r1,r2) := partition f r in if f x then (join l1 x r1, concat l2 r2) else (concat l1 r1, join l2 x r2) end. End Ops. (** * MakeRaw Functor of pure functions + a posteriori proofs of invariant preservation *) Module MakeRaw (Import I:Int)(X:OrderedType) <: RawSets X. Include Ops I X. (** Generic definition of binary-search-trees and proofs of specifications for generic functions such as mem or fold. *) Include MSetGenTree.Props X I. (** Automation and dedicated tactics *) Local Hint Immediate MX.eq_sym : core. Local Hint Unfold In lt_tree gt_tree Ok : core. Local Hint Constructors InT bst : core. Local Hint Resolve MX.eq_refl MX.eq_trans MX.lt_trans ok : core. Local Hint Resolve lt_leaf gt_leaf lt_tree_node gt_tree_node : core. Local Hint Resolve lt_tree_not_in lt_tree_trans gt_tree_not_in gt_tree_trans : core. Local Hint Resolve elements_spec2 : core. (* Sometimes functional induction will expose too much of a tree structure. The following tactic allows factoring back a Node whose internal parts occurs nowhere else. *) (* TODO: why Ltac instead of Tactic Notation don't work ? why clear ? *) Tactic Notation "factornode" ident(s) := try clear s; match goal with | |- context [Node ?l ?x ?r ?h] => set (s:=Node l x r h) in *; clearbody s; clear l x r h | _ : context [Node ?l ?x ?r ?h] |- _ => set (s:=Node l x r h) in *; clearbody s; clear l x r h end. (** Inductions principles for some of the set operators *) Functional Scheme bal_ind := Induction for bal Sort Prop. Functional Scheme remove_min_ind := Induction for remove_min Sort Prop. Functional Scheme merge_ind := Induction for merge Sort Prop. Functional Scheme concat_ind := Induction for concat Sort Prop. Functional Scheme inter_ind := Induction for inter Sort Prop. Functional Scheme diff_ind := Induction for diff Sort Prop. Functional Scheme union_ind := Induction for union Sort Prop. (** Notations and helper lemma about pairs and triples *) Declare Scope pair_scope. Notation "s #1" := (fst s) (at level 9, format "s '#1'") : pair_scope. Notation "s #2" := (snd s) (at level 9, format "s '#2'") : pair_scope. Notation "t #l" := (t_left t) (at level 9, format "t '#l'") : pair_scope. Notation "t #b" := (t_in t) (at level 9, format "t '#b'") : pair_scope. Notation "t #r" := (t_right t) (at level 9, format "t '#r'") : pair_scope. Local Open Scope pair_scope. (** ** Singleton set *) Lemma singleton_spec : forall x y, InT y (singleton x) <-> X.eq y x. Proof. unfold singleton; intuition_in. Qed. #[global] Instance singleton_ok x : Ok (singleton x). Proof. unfold singleton; auto. Qed. (** ** Helper functions *) Lemma create_spec : forall l x r y, InT y (create l x r) <-> X.eq y x \/ InT y l \/ InT y r. Proof. unfold create; split; [ inversion_clear 1 | ]; intuition. Qed. #[global] Instance create_ok l x r `(Ok l, Ok r, lt_tree x l, gt_tree x r) : Ok (create l x r). Proof. unfold create; auto. Qed. Lemma bal_spec : forall l x r y, InT y (bal l x r) <-> X.eq y x \/ InT y l \/ InT y r. Proof. intros l x r; induction l, x, r, (bal l x r) using bal_ind; subst; intros; try clear e0; rewrite !create_spec; intuition_in. Qed. #[global] Instance bal_ok l x r `(Ok l, Ok r, lt_tree x l, gt_tree x r) : Ok (bal l x r). Proof. induction l, x, r, (bal l x r) using bal_ind; subst; intros; inv; repeat apply create_ok; auto; unfold create; (apply lt_tree_node || apply gt_tree_node); auto; (eapply lt_tree_trans || eapply gt_tree_trans); eauto. Qed. (** ** Insertion *) Lemma add_spec' : forall s x y, InT y (add x s) <-> X.eq y x \/ InT y s. Proof. induct s x; try rewrite ?bal_spec, ?IHl, ?IHr; intuition_in. setoid_replace y with x'; eauto. Qed. Lemma add_spec : forall s x y `{Ok s}, InT y (add x s) <-> X.eq y x \/ InT y s. Proof. intros; apply add_spec'. Qed. #[global] Instance add_ok s x `(Ok s) : Ok (add x s). Proof. induct s x; auto; apply bal_ok; auto; intros y; rewrite add_spec'; intuition; order. Qed. Local Open Scope Int_scope. (** ** Join *) (** Function/Functional Scheme can't deal with internal fix. Let's do its job by hand: *) Ltac join_tac := let l := fresh "l" in intro l; induction l as [| lh ll _ lx lr Hlr]; [ | intros x r; induction r as [| rh rl Hrl rx rr _]; unfold join; [ | destruct ((rh+2) replace (bal a b c) with (bal ll lx (join lr x (Node rh rl rx rr))); [ | auto] end | destruct ((lh+2) replace (bal a b c) with (bal (join (Node lh ll lx lr) x rl) rx rr); [ | auto] end | ] ] ] ]; intros. Lemma join_spec : forall l x r y, InT y (join l x r) <-> X.eq y x \/ InT y l \/ InT y r. Proof. join_tac. - simpl. rewrite add_spec'; intuition_in. - rewrite add_spec'; intuition_in. - rewrite bal_spec, Hlr; clear Hlr Hrl; intuition_in. - rewrite bal_spec, Hrl; clear Hlr Hrl; intuition_in. - apply create_spec. Qed. #[global] Instance join_ok : forall l x r `(Ok l, Ok r, lt_tree x l, gt_tree x r), Ok (join l x r). Proof. join_tac; auto with *; inv; apply bal_ok; auto; clear Hrl Hlr; intro; intros; rewrite join_spec in *. - intuition; [ setoid_replace y with x | ]; eauto. - intuition; [ setoid_replace y with x | ]; eauto. Qed. (** ** Extraction of minimum element *) Lemma remove_min_spec : forall l x r y h, InT y (Node h l x r) <-> X.eq y (remove_min l x r)#2 \/ InT y (remove_min l x r)#1. Proof. intros l x r; induction l, x, r, (remove_min l x r) using remove_min_ind; subst; simpl in *; intros. - intuition_in. - rewrite bal_spec, In_node_iff, IHp, e0; simpl; intuition. Qed. #[global] Instance remove_min_ok l x r : forall h `(Ok (Node h l x r)), Ok (remove_min l x r)#1. Proof. induction l, x, r, (remove_min l x r) using remove_min_ind; subst; simpl; intros. - inv; auto. - assert (O : Ok (Node _x ll lx lr)) by (inv; auto). assert (L : lt_tree x (Node _x ll lx lr)) by (inv; auto). specialize IHp with (1:=O); rewrite e0 in IHp; auto; simpl in *. apply bal_ok; auto. + inv; auto. + intro y; specialize (L y). rewrite remove_min_spec, e0 in L; simpl in L; intuition. + inv; auto. Qed. Lemma remove_min_gt_tree : forall l x r h `{Ok (Node h l x r)}, gt_tree (remove_min l x r)#2 (remove_min l x r)#1. Proof. intros l x r; induction l, x, r, (remove_min l x r) using remove_min_ind; subst; simpl; intros. - inv; auto. - assert (O : Ok (Node _x ll lx lr)) by (inv; auto). assert (L : lt_tree x (Node _x ll lx lr)) by (inv; auto). specialize IHp with (1:=O); rewrite e0 in IHp; simpl in IHp. intro y; rewrite bal_spec; intuition; specialize (L m); rewrite remove_min_spec, e0 in L; simpl in L; [setoid_replace y with x|inv]; eauto. Qed. Local Hint Resolve remove_min_gt_tree : core. (** ** Merging two trees *) Lemma merge_spec : forall s1 s2 y, InT y (merge s1 s2) <-> InT y s1 \/ InT y s2. Proof. intros s1 s2; induction s1, s2, (merge s1 s2) using merge_ind; subst; intros; try factornode s1. - intuition_in. - intuition_in. - rewrite bal_spec, remove_min_spec, e1; simpl; intuition. Qed. #[global] Instance merge_ok s1 s2 : forall `(Ok s1, Ok s2) `(forall y1 y2 : elt, InT y1 s1 -> InT y2 s2 -> X.lt y1 y2), Ok (merge s1 s2). Proof. induction s1, s2, (merge s1 s2) using merge_ind; subst; intros; auto; try factornode s1. apply bal_ok; auto. - change s2' with ((s2',m)#1); rewrite <-e1; eauto with *. - intros y Hy. apply H1; auto. rewrite remove_min_spec, e1; simpl; auto. - change (gt_tree (s2',m)#2 (s2',m)#1); rewrite <-e1; eauto. Qed. (** ** Deletion *) Lemma remove_spec : forall s x y `{Ok s}, (InT y (remove x s) <-> InT y s /\ ~ X.eq y x). Proof. induct s x. - intuition_in. - rewrite merge_spec; intuition; [order|order|intuition_in]. elim H2; eauto. - rewrite bal_spec, IHl; clear IHl IHr; intuition; [order|order|intuition_in]. - rewrite bal_spec, IHr; clear IHl IHr; intuition; [order|order|intuition_in]. Qed. #[global] Instance remove_ok s x `(Ok s) : Ok (remove x s). Proof. induct s x. - auto. - (* EQ *) apply merge_ok; eauto. - (* LT *) apply bal_ok; auto. intro z; rewrite remove_spec; auto; destruct 1; eauto. - (* GT *) apply bal_ok; auto. intro z; rewrite remove_spec; auto; destruct 1; eauto. Qed. (** ** Concatenation *) Lemma concat_spec : forall s1 s2 y, InT y (concat s1 s2) <-> InT y s1 \/ InT y s2. Proof. intros s1 s2; induction s1, s2, (concat s1 s2) using concat_ind; subst; intros; try factornode s1. - intuition_in. - intuition_in. - rewrite join_spec, remove_min_spec, e1; simpl; intuition. Qed. #[global] Instance concat_ok s1 s2 : forall `(Ok s1, Ok s2) `(forall y1 y2 : elt, InT y1 s1 -> InT y2 s2 -> X.lt y1 y2), Ok (concat s1 s2). Proof. induction s1, s2, (concat s1 s2) using concat_ind; subst; intros; auto; try factornode s1. apply join_ok; auto. - change (Ok (s2',m)#1); rewrite <-e1; eauto with *. - intros y Hy. apply H1; auto. rewrite remove_min_spec, e1; simpl; auto. - change (gt_tree (s2',m)#2 (s2',m)#1); rewrite <-e1; eauto. Qed. (** ** Splitting *) Lemma split_spec1 : forall s x y `{Ok s}, (InT y (split x s)#l <-> InT y s /\ X.lt y x). Proof. induct s x. - intuition_in. - intuition_in; order. - specialize (IHl x y). destruct (split x l); simpl in *. rewrite IHl; intuition_in; order. - specialize (IHr x y). destruct (split x r); simpl in *. rewrite join_spec, IHr; intuition_in; order. Qed. Lemma split_spec2 : forall s x y `{Ok s}, (InT y (split x s)#r <-> InT y s /\ X.lt x y). Proof. induct s x. - intuition_in. - intuition_in; order. - specialize (IHl x y). destruct (split x l); simpl in *. rewrite join_spec, IHl; intuition_in; order. - specialize (IHr x y). destruct (split x r); simpl in *. rewrite IHr; intuition_in; order. Qed. Lemma split_spec3 : forall s x `{Ok s}, ((split x s)#b = true <-> InT x s). Proof. induct s x. - intuition_in; try discriminate. - intuition. - specialize (IHl x). destruct (split x l); simpl in *. rewrite IHl; intuition_in; order. - specialize (IHr x). destruct (split x r); simpl in *. rewrite IHr; intuition_in; order. Qed. Lemma split_ok : forall s x `{Ok s}, Ok (split x s)#l /\ Ok (split x s)#r. Proof. induct s x; simpl; auto. - specialize (IHl x). generalize (fun y => @split_spec2 l x y _). destruct (split x l); simpl in *; intuition. apply join_ok; auto. intros y; rewrite H; intuition. - specialize (IHr x). generalize (fun y => @split_spec1 r x y _). destruct (split x r); simpl in *; intuition. apply join_ok; auto. intros y; rewrite H; intuition. Qed. #[global] Instance split_ok1 s x `(Ok s) : Ok (split x s)#l. Proof. intros; destruct (@split_ok s x); auto. Qed. #[global] Instance split_ok2 s x `(Ok s) : Ok (split x s)#r. Proof. intros; destruct (@split_ok s x); auto. Qed. (** ** Intersection *) Ltac destruct_split := match goal with | H : split ?x ?s = << ?u, ?v, ?w >> |- _ => assert ((split x s)#l = u) by (rewrite H; auto); assert ((split x s)#b = v) by (rewrite H; auto); assert ((split x s)#r = w) by (rewrite H; auto); clear H; subst u w end. Lemma inter_spec_ok : forall s1 s2 `{Ok s1, Ok s2}, Ok (inter s1 s2) /\ (forall y, InT y (inter s1 s2) <-> InT y s1 /\ InT y s2). Proof. intros s1 s2; induction s1, s2, (inter s1 s2) using inter_ind; subst; intros B1 B2; [intuition_in|intuition_in | | ]; factornode s2; destruct_split; inv; destruct IHt0 as (IHo1,IHi1), IHt1 as (IHo2,IHi2); auto with *; split; intros. - (* Ok join *) apply join_ok; auto with *; intro y; rewrite ?IHi1, ?IHi2; intuition. - (* InT join *) rewrite join_spec, IHi1, IHi2, split_spec1, split_spec2; intuition_in. setoid_replace y with x1; auto. rewrite <- split_spec3; auto. - (* Ok concat *) apply concat_ok; auto with *; intros y1 y2; rewrite IHi1, IHi2; intuition; order. - (* InT concat *) rewrite concat_spec, IHi1, IHi2, split_spec1, split_spec2; auto. intuition_in. absurd (InT x1 s2). + rewrite <- split_spec3; auto; congruence. + setoid_replace x1 with y; auto. Qed. Lemma inter_spec : forall s1 s2 y `{Ok s1, Ok s2}, (InT y (inter s1 s2) <-> InT y s1 /\ InT y s2). Proof. intros; destruct (@inter_spec_ok s1 s2); auto. Qed. #[global] Instance inter_ok s1 s2 `(Ok s1, Ok s2) : Ok (inter s1 s2). Proof. intros; destruct (@inter_spec_ok s1 s2); auto. Qed. (** ** Difference *) Lemma diff_spec_ok : forall s1 s2 `{Ok s1, Ok s2}, Ok (diff s1 s2) /\ (forall y, InT y (diff s1 s2) <-> InT y s1 /\ ~InT y s2). Proof. intros s1 s2; induction s1, s2, (diff s1 s2) using diff_ind; subst; intros B1 B2; [intuition_in|intuition_in | | ]; factornode s2; destruct_split; inv; destruct IHt0 as (IHb1,IHi1), IHt1 as (IHb2,IHi2); auto with *; split; intros. - (* Ok concat *) apply concat_ok; auto; intros y1 y2; rewrite IHi1, IHi2; intuition; order. - (* InT concat *) rewrite concat_spec, IHi1, IHi2, split_spec1, split_spec2; intuition_in. absurd (InT x1 s2). + setoid_replace x1 with y; auto. + rewrite <- split_spec3; auto; congruence. - (* Ok join *) apply join_ok; auto; intro y; rewrite ?IHi1, ?IHi2; intuition. - (* InT join *) rewrite join_spec, IHi1, IHi2, split_spec1, split_spec2; auto with *. intuition_in. absurd (InT x1 s2); auto. * rewrite <- split_spec3; auto; congruence. * setoid_replace x1 with y; auto. Qed. Lemma diff_spec : forall s1 s2 y `{Ok s1, Ok s2}, (InT y (diff s1 s2) <-> InT y s1 /\ ~InT y s2). Proof. intros; destruct (@diff_spec_ok s1 s2); auto. Qed. #[global] Instance diff_ok s1 s2 `(Ok s1, Ok s2) : Ok (diff s1 s2). Proof. intros; destruct (@diff_spec_ok s1 s2); auto. Qed. (** ** Union *) Lemma union_spec : forall s1 s2 y `{Ok s1, Ok s2}, (InT y (union s1 s2) <-> InT y s1 \/ InT y s2). Proof. intros s1 s2; induction s1, s2, (union s1 s2) using union_ind; subst; intros y B1 B2. - intuition_in. - intuition_in. - factornode s2; destruct_split; inv. rewrite join_spec, IHt0, IHt1, split_spec1, split_spec2; auto with *. destruct (X.compare_spec y x1); intuition_in. Qed. #[global] Instance union_ok s1 s2 : forall `(Ok s1, Ok s2), Ok (union s1 s2). Proof. induction s1, s2, (union s1 s2) using union_ind; subst; intros B1 B2; auto. factornode s2; destruct_split; inv. apply join_ok; auto with *. - intro y; rewrite union_spec, split_spec1; intuition_in; exact _. - intro y; rewrite union_spec, split_spec2; intuition_in; exact _. Qed. (** * Filter *) Lemma filter_spec : forall s x f, Proper (X.eq==>Logic.eq) f -> (InT x (filter f s) <-> InT x s /\ f x = true). Proof. induction s as [ |h l Hl x0 r Hr]; intros x f Hf; simpl. - intuition_in. - case_eq (f x0); intros Hx0. * rewrite join_spec, Hl, Hr; intuition_in. now setoid_replace x with x0. * rewrite concat_spec, Hl, Hr; intuition_in. assert (f x = f x0) by auto. congruence. Qed. Lemma filter_weak_spec : forall s x f, InT x (filter f s) -> InT x s. Proof. induction s as [ |h l Hl x0 r Hr]; intros x f; simpl. - trivial. - destruct (f x0). * rewrite join_spec; intuition_in; eauto. * rewrite concat_spec; intuition_in; eauto. Qed. #[global] Instance filter_ok s f `(H : Ok s) : Ok (filter f s). Proof. induction H as [ | h x l r Hl Hfl Hr Hfr Hlt Hgt ]. - constructor. - simpl. assert (lt_tree x (filter f l)) by (eauto using filter_weak_spec). assert (gt_tree x (filter f r)) by (eauto using filter_weak_spec). destruct (f x); eauto using concat_ok, join_ok. Qed. (** * Partition *) Lemma partition_spec1' s f : (partition f s)#1 = filter f s. Proof. induction s as [ | h l Hl x r Hr ]; simpl. - trivial. - rewrite <- Hl, <- Hr. now destruct (partition f l), (partition f r), (f x). Qed. Lemma partition_spec2' s f : (partition f s)#2 = filter (fun x => negb (f x)) s. Proof. induction s as [ | h l Hl x r Hr ]; simpl. - trivial. - rewrite <- Hl, <- Hr. now destruct (partition f l), (partition f r), (f x). Qed. Lemma partition_spec1 s f : Proper (X.eq==>Logic.eq) f -> Equal (partition f s)#1 (filter f s). Proof. now rewrite partition_spec1'. Qed. Lemma partition_spec2 s f : Proper (X.eq==>Logic.eq) f -> Equal (partition f s)#2 (filter (fun x => negb (f x)) s). Proof. now rewrite partition_spec2'. Qed. #[global] Instance partition_ok1 s f `(Ok s) : Ok (partition f s)#1. Proof. rewrite partition_spec1'; now apply filter_ok. Qed. #[global] Instance partition_ok2 s f `(Ok s) : Ok (partition f s)#2. Proof. rewrite partition_spec2'; now apply filter_ok. Qed. End MakeRaw. (** * Encapsulation Now, in order to really provide a functor implementing [S], we need to encapsulate everything into a type of binary search trees. They also happen to be well-balanced, but this has no influence on the correctness of operations, so we won't state this here, see [MSetFullAVL] if you need more than just the MSet interface. *) Module IntMake (I:Int)(X: OrderedType) <: S with Module E := X. Module Raw := MakeRaw I X. Include Raw2Sets X Raw. End IntMake. (* For concrete use inside Coq, we propose an instantiation of [Int] by [Z]. *) Module Make (X: OrderedType) <: S with Module E := X :=IntMake(Z_as_Int)(X). coq-8.20.0/theories/MSets/MSetDecide.v000066400000000000000000000745161466560755400174340ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* ... -> Pk -> P >> where [P]'s are defined by the grammar: << P ::= | Q | Empty F | Subset F F' | Equal F F' Q ::= | E.eq X X' | In X F | Q /\ Q' | Q \/ Q' | Q -> Q' | Q <-> Q' | ~ Q | True | False F ::= | S | empty | singleton X | add X F | remove X F | union F F' | inter F F' | diff F F' X ::= x1 | ... | xm S ::= s1 | ... | sn >> The tactic will also work on some goals that vary slightly from the above form: - The variables and hypotheses may be mixed in any order and may have already been introduced into the context. Moreover, there may be additional, unrelated hypotheses mixed in (these will be ignored). - A conjunction of hypotheses will be handled as easily as separate hypotheses, i.e., [P1 /\ P2 -> P] can be solved iff [P1 -> P2 -> P] can be solved. - [fsetdec] should solve any goal if the MSet-related hypotheses are contradictory. - [fsetdec] will first perform any necessary zeta and beta reductions and will invoke [subst] to eliminate any Coq equalities between finite sets or their elements. - If [E.eq] is convertible with Coq's equality, it will not matter which one is used in the hypotheses or conclusion. - The tactic can solve goals where the finite sets or set elements are expressed by Coq terms that are more complicated than variables. However, non-local definitions are not expanded, and Coq equalities between non-variable terms are not used. For example, this goal will be solved: << forall (f : t -> t), forall (g : elt -> elt), forall (s1 s2 : t), forall (x1 x2 : elt), Equal s1 (f s2) -> E.eq x1 (g (g x2)) -> In x1 s1 -> In (g (g x2)) (f s2) >> This one will not be solved: << forall (f : t -> t), forall (g : elt -> elt), forall (s1 s2 : t), forall (x1 x2 : elt), Equal s1 (f s2) -> E.eq x1 (g x2) -> In x1 s1 -> g x2 = g (g x2) -> In (g (g x2)) (f s2) >> *) (** * Facts and Tactics for Propositional Logic These lemmas and tactics are in a module so that they do not affect the namespace if you import the enclosing module [Decide]. *) Module MSetLogicalFacts. Export Decidable. Export Setoid. (** ** Lemmas and Tactics About Decidable Propositions *) (** ** Propositional Equivalences Involving Negation These are all written with the unfolded form of negation, since I am not sure if setoid rewriting will always perform conversion. *) (** ** Tactics for Negations *) Tactic Notation "fold" "any" "not" := repeat ( match goal with | H: context [?P -> False] |- _ => fold (~ P) in H | |- context [?P -> False] => fold (~ P) end). (** [push not using db] will pushes all negations to the leaves of propositions in the goal, using the lemmas in [db] to assist in checking the decidability of the propositions involved. If [using db] is omitted, then [core] will be used. Additional versions are provided to manipulate the hypotheses or the hypotheses and goal together. XXX: This tactic and the similar subsequent ones should have been defined using [autorewrite]. However, dealing with multiples rewrite sites and side-conditions is done more cleverly with the following explicit analysis of goals. *) Ltac or_not_l_iff P Q tac := (rewrite (or_not_l_iff_1 P Q) by tac) || (rewrite (or_not_l_iff_2 P Q) by tac). Ltac or_not_r_iff P Q tac := (rewrite (or_not_r_iff_1 P Q) by tac) || (rewrite (or_not_r_iff_2 P Q) by tac). Ltac or_not_l_iff_in P Q H tac := (rewrite (or_not_l_iff_1 P Q) in H by tac) || (rewrite (or_not_l_iff_2 P Q) in H by tac). Ltac or_not_r_iff_in P Q H tac := (rewrite (or_not_r_iff_1 P Q) in H by tac) || (rewrite (or_not_r_iff_2 P Q) in H by tac). Tactic Notation "push" "not" "using" ident(db) := let dec := solve_decidable using db in unfold not, iff; repeat ( match goal with | |- context [True -> False] => rewrite not_true_iff | |- context [False -> False] => rewrite not_false_iff | |- context [(?P -> False) -> False] => rewrite (not_not_iff P) by dec | |- context [(?P -> False) -> (?Q -> False)] => rewrite (contrapositive P Q) by dec | |- context [(?P -> False) \/ ?Q] => or_not_l_iff P Q dec | |- context [?P \/ (?Q -> False)] => or_not_r_iff P Q dec | |- context [(?P -> False) -> ?Q] => rewrite (imp_not_l P Q) by dec | |- context [?P \/ ?Q -> False] => rewrite (not_or_iff P Q) | |- context [?P /\ ?Q -> False] => rewrite (not_and_iff P Q) | |- context [(?P -> ?Q) -> False] => rewrite (not_imp_iff P Q) by dec end); fold any not. Tactic Notation "push" "not" := push not using core. Tactic Notation "push" "not" "in" "*" "|-" "using" ident(db) := let dec := solve_decidable using db in unfold not, iff in * |-; repeat ( match goal with | H: context [True -> False] |- _ => rewrite not_true_iff in H | H: context [False -> False] |- _ => rewrite not_false_iff in H | H: context [(?P -> False) -> False] |- _ => rewrite (not_not_iff P) in H by dec | H: context [(?P -> False) -> (?Q -> False)] |- _ => rewrite (contrapositive P Q) in H by dec | H: context [(?P -> False) \/ ?Q] |- _ => or_not_l_iff_in P Q H dec | H: context [?P \/ (?Q -> False)] |- _ => or_not_r_iff_in P Q H dec | H: context [(?P -> False) -> ?Q] |- _ => rewrite (imp_not_l P Q) in H by dec | H: context [?P \/ ?Q -> False] |- _ => rewrite (not_or_iff P Q) in H | H: context [?P /\ ?Q -> False] |- _ => rewrite (not_and_iff P Q) in H | H: context [(?P -> ?Q) -> False] |- _ => rewrite (not_imp_iff P Q) in H by dec end); fold any not. Tactic Notation "push" "not" "in" "*" "|-" := push not in * |- using core. Tactic Notation "push" "not" "in" "*" "using" ident(db) := push not using db; push not in * |- using db. Tactic Notation "push" "not" "in" "*" := push not in * using core. (** A simple test case to see how this works. *) Lemma test_push : forall P Q R : Prop, decidable P -> decidable Q -> (~ True) -> (~ False) -> (~ ~ P) -> (~ (P /\ Q) -> ~ R) -> ((P /\ Q) \/ ~ R) -> (~ (P /\ Q) \/ R) -> (R \/ ~ (P /\ Q)) -> (~ R \/ (P /\ Q)) -> (~ P -> R) -> (~ ((R -> P) \/ (Q -> R))) -> (~ (P /\ R)) -> (~ (P -> R)) -> True. Proof. intros. push not in *. (* note that ~(R->P) remains (since R isn't decidable) *) tauto. Qed. (** [pull not using db] will pull as many negations as possible toward the top of the propositions in the goal, using the lemmas in [db] to assist in checking the decidability of the propositions involved. If [using db] is omitted, then [core] will be used. Additional versions are provided to manipulate the hypotheses or the hypotheses and goal together. *) Tactic Notation "pull" "not" "using" ident(db) := let dec := solve_decidable using db in unfold not, iff; repeat ( match goal with | |- context [True -> False] => rewrite not_true_iff | |- context [False -> False] => rewrite not_false_iff | |- context [(?P -> False) -> False] => rewrite (not_not_iff P) by dec | |- context [(?P -> False) -> (?Q -> False)] => rewrite (contrapositive P Q) by dec | |- context [(?P -> False) \/ ?Q] => or_not_l_iff P Q dec | |- context [?P \/ (?Q -> False)] => or_not_r_iff P Q dec | |- context [(?P -> False) -> ?Q] => rewrite (imp_not_l P Q) by dec | |- context [(?P -> False) /\ (?Q -> False)] => rewrite <- (not_or_iff P Q) | |- context [?P -> ?Q -> False] => rewrite <- (not_and_iff P Q) | |- context [?P /\ (?Q -> False)] => rewrite <- (not_imp_iff P Q) by dec | |- context [(?Q -> False) /\ ?P] => rewrite <- (not_imp_rev_iff P Q) by dec end); fold any not. Tactic Notation "pull" "not" := pull not using core. Tactic Notation "pull" "not" "in" "*" "|-" "using" ident(db) := let dec := solve_decidable using db in unfold not, iff in * |-; repeat ( match goal with | H: context [True -> False] |- _ => rewrite not_true_iff in H | H: context [False -> False] |- _ => rewrite not_false_iff in H | H: context [(?P -> False) -> False] |- _ => rewrite (not_not_iff P) in H by dec | H: context [(?P -> False) -> (?Q -> False)] |- _ => rewrite (contrapositive P Q) in H by dec | H: context [(?P -> False) \/ ?Q] |- _ => or_not_l_iff_in P Q H dec | H: context [?P \/ (?Q -> False)] |- _ => or_not_r_iff_in P Q H dec | H: context [(?P -> False) -> ?Q] |- _ => rewrite (imp_not_l P Q) in H by dec | H: context [(?P -> False) /\ (?Q -> False)] |- _ => rewrite <- (not_or_iff P Q) in H | H: context [?P -> ?Q -> False] |- _ => rewrite <- (not_and_iff P Q) in H | H: context [?P /\ (?Q -> False)] |- _ => rewrite <- (not_imp_iff P Q) in H by dec | H: context [(?Q -> False) /\ ?P] |- _ => rewrite <- (not_imp_rev_iff P Q) in H by dec end); fold any not. Tactic Notation "pull" "not" "in" "*" "|-" := pull not in * |- using core. Tactic Notation "pull" "not" "in" "*" "using" ident(db) := pull not using db; pull not in * |- using db. Tactic Notation "pull" "not" "in" "*" := pull not in * using core. (** A simple test case to see how this works. *) Lemma test_pull : forall P Q R : Prop, decidable P -> decidable Q -> (~ True) -> (~ False) -> (~ ~ P) -> (~ (P /\ Q) -> ~ R) -> ((P /\ Q) \/ ~ R) -> (~ (P /\ Q) \/ R) -> (R \/ ~ (P /\ Q)) -> (~ R \/ (P /\ Q)) -> (~ P -> R) -> (~ (R -> P) /\ ~ (Q -> R)) -> (~ P \/ ~ R) -> (P /\ ~ R) -> (~ R /\ P) -> True. Proof. intros. pull not in *. tauto. Qed. End MSetLogicalFacts. Import MSetLogicalFacts. (** * Auxiliary Tactics Again, these lemmas and tactics are in a module so that they do not affect the namespace if you import the enclosing module [Decide]. *) Module MSetDecideAuxiliary. (** ** Generic Tactics We begin by defining a few generic, useful tactics. *) (** remove logical hypothesis inter-dependencies (fix #2136). *) Ltac no_logical_interdep := match goal with | H : ?P |- _ => match type of P with | Prop => match goal with H' : context [ H ] |- _ => clear dependent H' end | _ => fail end; no_logical_interdep | _ => idtac end. Ltac abstract_term t := tryif (is_var t) then fail "no need to abstract a variable" else (let x := fresh "x" in set (x := t) in *; try clearbody x). Ltac abstract_elements := repeat (match goal with | |- context [ singleton ?t ] => abstract_term t | _ : context [ singleton ?t ] |- _ => abstract_term t | |- context [ add ?t _ ] => abstract_term t | _ : context [ add ?t _ ] |- _ => abstract_term t | |- context [ remove ?t _ ] => abstract_term t | _ : context [ remove ?t _ ] |- _ => abstract_term t | |- context [ In ?t _ ] => abstract_term t | _ : context [ In ?t _ ] |- _ => abstract_term t end). (** [prop P holds by t] succeeds (but does not modify the goal or context) if the proposition [P] can be proved by [t] in the current context. Otherwise, the tactic fails. *) Tactic Notation "prop" constr(P) "holds" "by" tactic(t) := let H := fresh in assert P as H by t; clear H. (** This tactic acts just like [assert ... by ...] but will fail if the context already contains the proposition. *) Tactic Notation "assert" "new" constr(e) "by" tactic(t) := match goal with | H: e |- _ => fail 1 | _ => assert e by t end. (** [subst++] is similar to [subst] except that - it never fails (as [subst] does on recursive equations), - it substitutes locally defined variable for their definitions, - it performs beta reductions everywhere, which may arise after substituting a locally defined function for its definition. *) Tactic Notation "subst" "++" := repeat ( match goal with | x : _ |- _ => subst x end); cbv zeta beta in *. (** [decompose records] calls [decompose record H] on every relevant hypothesis [H]. *) Tactic Notation "decompose" "records" := repeat ( match goal with | H: _ |- _ => progress (decompose record H); clear H end). (** ** Discarding Irrelevant Hypotheses We will want to clear the context of any non-MSet-related hypotheses in order to increase the speed of the tactic. To do this, we will need to be able to decide which are relevant. We do this by making a simple inductive definition classifying the propositions of interest. *) Inductive MSet_elt_Prop : Prop -> Prop := | eq_Prop : forall (S : Type) (x y : S), MSet_elt_Prop (x = y) | eq_elt_prop : forall x y, MSet_elt_Prop (E.eq x y) | In_elt_prop : forall x s, MSet_elt_Prop (In x s) | True_elt_prop : MSet_elt_Prop True | False_elt_prop : MSet_elt_Prop False | conj_elt_prop : forall P Q, MSet_elt_Prop P -> MSet_elt_Prop Q -> MSet_elt_Prop (P /\ Q) | disj_elt_prop : forall P Q, MSet_elt_Prop P -> MSet_elt_Prop Q -> MSet_elt_Prop (P \/ Q) | impl_elt_prop : forall P Q, MSet_elt_Prop P -> MSet_elt_Prop Q -> MSet_elt_Prop (P -> Q) | not_elt_prop : forall P, MSet_elt_Prop P -> MSet_elt_Prop (~ P). Inductive MSet_Prop : Prop -> Prop := | elt_MSet_Prop : forall P, MSet_elt_Prop P -> MSet_Prop P | Empty_MSet_Prop : forall s, MSet_Prop (Empty s) | Subset_MSet_Prop : forall s1 s2, MSet_Prop (Subset s1 s2) | Equal_MSet_Prop : forall s1 s2, MSet_Prop (Equal s1 s2). (** Here is the tactic that will throw away hypotheses that are not useful (for the intended scope of the [fsetdec] tactic). *) #[global] Hint Constructors MSet_elt_Prop MSet_Prop : MSet_Prop. Ltac discard_nonMSet := repeat ( match goal with | H : context [ @Logic.eq ?T ?x ?y ] |- _ => tryif (change T with E.t in H) then fail else tryif (change T with t in H) then fail else clear H | H : ?P |- _ => tryif prop (MSet_Prop P) holds by (auto 100 with MSet_Prop) then fail else clear H end). (** ** Turning Set Operators into Propositional Connectives The lemmas from [MSetFacts] will be used to break down set operations into propositional formulas built over the predicates [In] and [E.eq] applied only to variables. We are going to use them with [autorewrite]. *) Global Hint Rewrite F.empty_iff F.singleton_iff F.add_iff F.remove_iff F.union_iff F.inter_iff F.diff_iff : set_simpl. Lemma eq_refl_iff (x : E.t) : E.eq x x <-> True. Proof. now split. Qed. Global Hint Rewrite eq_refl_iff : set_eq_simpl. (** ** Decidability of MSet Propositions *) (** [In] is decidable. *) Lemma dec_In : forall x s, decidable (In x s). Proof. red; intros; generalize (F.mem_iff s x); case (mem x s); intuition auto with bool. Qed. (** [E.eq] is decidable. *) Lemma dec_eq : forall (x y : E.t), decidable (E.eq x y). Proof. red; intros x y; destruct (E.eq_dec x y); auto. Qed. (** The hint database [MSet_decidability] will be given to the [push_neg] tactic from the module [Negation]. *) #[global] Hint Resolve dec_In dec_eq : MSet_decidability. (** ** Normalizing Propositions About Equality We have to deal with the fact that [E.eq] may be convertible with Coq's equality. Thus, we will find the following tactics useful to replace one form with the other everywhere. *) (** The next tactic, [Logic_eq_to_E_eq], mentions the term [E.t]; thus, we must ensure that [E.t] is used in favor of any other convertible but syntactically distinct term. *) Ltac change_to_E_t := repeat ( match goal with | H : ?T |- _ => progress (change T with E.t in H); repeat ( match goal with | J : _ |- _ => progress (change T with E.t in J) | |- _ => progress (change T with E.t) end ) | H : forall x : ?T, _ |- _ => progress (change T with E.t in H); repeat ( match goal with | J : _ |- _ => progress (change T with E.t in J) | |- _ => progress (change T with E.t) end ) end). (** These two tactics take us from Coq's built-in equality to [E.eq] (and vice versa) when possible. *) Ltac Logic_eq_to_E_eq := repeat ( match goal with | H: _ |- _ => progress (change (@Logic.eq E.t) with E.eq in H) | |- _ => progress (change (@Logic.eq E.t) with E.eq) end). Ltac E_eq_to_Logic_eq := repeat ( match goal with | H: _ |- _ => progress (change E.eq with (@Logic.eq E.t) in H) | |- _ => progress (change E.eq with (@Logic.eq E.t)) end). (** This tactic works like the built-in tactic [subst], but at the level of set element equality (which may not be the convertible with Coq's equality). *) Ltac substMSet := repeat ( match goal with | H: E.eq ?x ?x |- _ => clear H | H: E.eq ?x ?y |- _ => rewrite H in *; clear H end); autorewrite with set_eq_simpl in *. (** ** Considering Decidability of Base Propositions This tactic adds assertions about the decidability of [E.eq] and [In] to the context. This is necessary for the completeness of the [fsetdec] tactic. However, in order to minimize the cost of proof search, we should be careful to not add more than we need. Once negations have been pushed to the leaves of the propositions, we only need to worry about decidability for those base propositions that appear in a negated form. *) Ltac assert_decidability := (** We actually don't want these rules to fire if the syntactic context in the patterns below is trivially empty, but we'll just do some clean-up at the afterward. *) repeat ( match goal with | H: context [~ E.eq ?x ?y] |- _ => assert new (E.eq x y \/ ~ E.eq x y) by (apply dec_eq) | H: context [~ In ?x ?s] |- _ => assert new (In x s \/ ~ In x s) by (apply dec_In) | |- context [~ E.eq ?x ?y] => assert new (E.eq x y \/ ~ E.eq x y) by (apply dec_eq) | |- context [~ In ?x ?s] => assert new (In x s \/ ~ In x s) by (apply dec_In) end); (** Now we eliminate the useless facts we added (because they would likely be very harmful to performance). *) repeat ( match goal with | _: ~ ?P, H : ?P \/ ~ ?P |- _ => clear H end). (** ** Handling [Empty], [Subset], and [Equal] This tactic instantiates universally quantified hypotheses (which arise from the unfolding of [Empty], [Subset], and [Equal]) for each of the set element expressions that is involved in some membership or equality fact. Then it throws away those hypotheses, which should no longer be needed. *) Ltac inst_MSet_hypotheses := repeat ( match goal with | H : forall a : E.t, _, _ : context [ In ?x _ ] |- _ => let P := type of (H x) in assert new P by (exact (H x)) | H : forall a : E.t, _ |- context [ In ?x _ ] => let P := type of (H x) in assert new P by (exact (H x)) | H : forall a : E.t, _, _ : context [ E.eq ?x _ ] |- _ => let P := type of (H x) in assert new P by (exact (H x)) | H : forall a : E.t, _ |- context [ E.eq ?x _ ] => let P := type of (H x) in assert new P by (exact (H x)) | H : forall a : E.t, _, _ : context [ E.eq _ ?x ] |- _ => let P := type of (H x) in assert new P by (exact (H x)) | H : forall a : E.t, _ |- context [ E.eq _ ?x ] => let P := type of (H x) in assert new P by (exact (H x)) end); repeat ( match goal with | H : forall a : E.t, _ |- _ => clear H end). (** ** The Core [fsetdec] Auxiliary Tactics *) (** Here is the crux of the proof search. Recursion through [intuition]! (This will terminate if I correctly understand the behavior of [intuition].) *) Ltac fsetdec_rec := progress substMSet; intuition fsetdec_rec. (** If we add [unfold Empty, Subset, Equal in *; intros;] to the beginning of this tactic, it will satisfy the same specification as the [fsetdec] tactic; however, it will be much slower than necessary without the pre-processing done by the wrapper tactic [fsetdec]. *) Ltac fsetdec_body := autorewrite with set_eq_simpl in *; inst_MSet_hypotheses; autorewrite with set_simpl set_eq_simpl in *; push not in * using MSet_decidability; substMSet; assert_decidability; auto; (intuition fsetdec_rec) || fail 1 "because the goal is beyond the scope of this tactic". End MSetDecideAuxiliary. Import MSetDecideAuxiliary. (** * The [fsetdec] Tactic Here is the top-level tactic (the only one intended for clients of this library). It's specification is given at the top of the file. *) Ltac fsetdec := (** We first unfold any occurrences of [iff]. *) unfold iff in *; (** We fold occurrences of [not] because it is better for [intros] to leave us with a goal of [~ P] than a goal of [False]. *) fold any not; intros; (** We don't care about the value of elements : complex ones are abstracted as new variables (avoiding potential dependencies, see bug #2464) *) abstract_elements; (** We remove dependencies to logical hypothesis. This way, later "clear" will work nicely (see bug #2136) *) no_logical_interdep; (** Now we decompose conjunctions, which will allow the [discard_nonMSet] and [assert_decidability] tactics to do a much better job. *) decompose records; discard_nonMSet; (** We unfold these defined propositions on finite sets. If our goal was one of them, then have one more item to introduce now. *) unfold Empty, Subset, Equal in *; intros; (** We now want to get rid of all uses of [=] in favor of [E.eq]. However, the best way to eliminate a [=] is in the context is with [subst], so we will try that first. In fact, we may as well convert uses of [E.eq] into [=] when possible before we do [subst] so that we can even more mileage out of it. Then we will convert all remaining uses of [=] back to [E.eq] when possible. We use [change_to_E_t] to ensure that we have a canonical name for set elements, so that [Logic_eq_to_E_eq] will work properly. *) change_to_E_t; E_eq_to_Logic_eq; subst++; Logic_eq_to_E_eq; (** The next optimization is to swap a negated goal with a negated hypothesis when possible. Any swap will improve performance by eliminating the total number of negations, but we will get the maximum benefit if we swap the goal with a hypotheses mentioning the same set element, so we try that first. If we reach the fourth branch below, we attempt any swap. However, to maintain completeness of this tactic, we can only perform such a swap with a decidable proposition; hence, we first test whether the hypothesis is an [MSet_elt_Prop], noting that any [MSet_elt_Prop] is decidable. *) pull not using MSet_decidability; unfold not in *; match goal with | H: (In ?x ?r) -> False |- (In ?x ?s) -> False => contradict H; fsetdec_body | H: (In ?x ?r) -> False |- (E.eq ?x ?y) -> False => contradict H; fsetdec_body | H: (In ?x ?r) -> False |- (E.eq ?y ?x) -> False => contradict H; fsetdec_body | H: ?P -> False |- ?Q -> False => tryif prop (MSet_elt_Prop P) holds by (auto 100 with MSet_Prop) then (contradict H; fsetdec_body) else fsetdec_body | |- _ => fsetdec_body end. (** * Examples *) Module MSetDecideTestCases. Lemma test_eq_trans_1 : forall x y z s, E.eq x y -> ~ ~ E.eq z y -> In x s -> In z s. Proof. fsetdec. Qed. Lemma test_eq_trans_2 : forall x y z r s, In x (singleton y) -> ~ In z r -> ~ ~ In z (add y r) -> In x s -> In z s. Proof. fsetdec. Qed. Lemma test_eq_neq_trans_1 : forall w x y z s, E.eq x w -> ~ ~ E.eq x y -> ~ E.eq y z -> In w s -> In w (remove z s). Proof. fsetdec. Qed. Lemma test_eq_neq_trans_2 : forall w x y z r1 r2 s, In x (singleton w) -> ~ In x r1 -> In x (add y r1) -> In y r2 -> In y (remove z r2) -> In w s -> In w (remove z s). Proof. fsetdec. Qed. Lemma test_In_singleton : forall x, In x (singleton x). Proof. fsetdec. Qed. Lemma test_add_In : forall x y s, In x (add y s) -> ~ E.eq x y -> In x s. Proof. fsetdec. Qed. Lemma test_Subset_add_remove : forall x s, s [<=] (add x (remove x s)). Proof. fsetdec. Qed. Lemma test_eq_disjunction : forall w x y z, In w (add x (add y (singleton z))) -> E.eq w x \/ E.eq w y \/ E.eq w z. Proof. fsetdec. Qed. Lemma test_not_In_disj : forall x y s1 s2 s3 s4, ~ In x (union s1 (union s2 (union s3 (add y s4)))) -> ~ (In x s1 \/ In x s4 \/ E.eq y x). Proof. fsetdec. Qed. Lemma test_not_In_conj : forall x y s1 s2 s3 s4, ~ In x (union s1 (union s2 (union s3 (add y s4)))) -> ~ In x s1 /\ ~ In x s4 /\ ~ E.eq y x. Proof. fsetdec. Qed. Lemma test_iff_conj : forall a x s s', (In a s' <-> E.eq x a \/ In a s) -> (In a s' <-> In a (add x s)). Proof. fsetdec. Qed. Lemma test_set_ops_1 : forall x q r s, (singleton x) [<=] s -> Empty (union q r) -> Empty (inter (diff s q) (diff s r)) -> ~ In x s. Proof. fsetdec. Qed. Lemma eq_chain_test : forall x1 x2 x3 x4 s1 s2 s3 s4, Empty s1 -> In x2 (add x1 s1) -> In x3 s2 -> ~ In x3 (remove x2 s2) -> ~ In x4 s3 -> In x4 (add x3 s3) -> In x1 s4 -> Subset (add x4 s4) s4. Proof. fsetdec. Qed. Lemma test_too_complex : forall x y z r s, E.eq x y -> (In x (singleton y) -> r [<=] s) -> In z r -> In z s. Proof. (** [fsetdec] is not intended to solve this directly. *) intros until s; intros Heq H Hr; lapply H; fsetdec. Qed. Lemma function_test_1 : forall (f : t -> t), forall (g : elt -> elt), forall (s1 s2 : t), forall (x1 x2 : elt), Equal s1 (f s2) -> E.eq x1 (g (g x2)) -> In x1 s1 -> In (g (g x2)) (f s2). Proof. fsetdec. Qed. Lemma function_test_2 : forall (f : t -> t), forall (g : elt -> elt), forall (s1 s2 : t), forall (x1 x2 : elt), Equal s1 (f s2) -> E.eq x1 (g x2) -> In x1 s1 -> g x2 = g (g x2) -> In (g (g x2)) (f s2). Proof. (** [fsetdec] is not intended to solve this directly. *) intros until 3. intros g_eq. rewrite <- g_eq. fsetdec. Qed. Lemma test_baydemir : forall (f : t -> t), forall (s : t), forall (x y : elt), In x (add y (f s)) -> ~ E.eq x y -> In x (f s). Proof. fsetdec. Qed. End MSetDecideTestCases. End WDecideOn. Require Import MSetInterface. (** Now comes variants for self-contained weak sets and for full sets. For these variants, only one argument is necessary. Thanks to the subtyping [WS<=S], the [Decide] functor which is meant to be used on modules [(M:S)] can simply be an alias of [WDecide]. *) Module WDecide (M:WSets) := !WDecideOn M.E M. Module Decide := WDecide. coq-8.20.0/theories/MSets/MSetEqProperties.v000066400000000000000000000552231466560755400206730ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* mem x s=mem y s. Proof. intro H; rewrite H; auto. Qed. Lemma equal_mem_1: (forall a, mem a s=mem a s') -> equal s s'=true. Proof. intros; apply equal_1; unfold Equal; intros. do 2 rewrite mem_iff; rewrite H; tauto. Qed. Lemma equal_mem_2: equal s s'=true -> forall a, mem a s=mem a s'. Proof. intros; rewrite (equal_2 H); auto. Qed. Lemma subset_mem_1: (forall a, mem a s=true->mem a s'=true) -> subset s s'=true. Proof. intros; apply subset_1; unfold Subset; intros a. do 2 rewrite mem_iff; auto. Qed. Lemma subset_mem_2: subset s s'=true -> forall a, mem a s=true -> mem a s'=true. Proof. intros H a; do 2 rewrite <- mem_iff; apply subset_2; auto. Qed. Lemma empty_mem: mem x empty=false. Proof. rewrite <- not_mem_iff; auto with set. Qed. Lemma is_empty_equal_empty: is_empty s = equal s empty. Proof. apply bool_1; split; intros. - auto with set. - rewrite <- is_empty_iff; auto with set. Qed. Lemma choose_mem_1: choose s=Some x -> mem x s=true. Proof. auto with set. Qed. Lemma choose_mem_2: choose s=None -> is_empty s=true. Proof. auto with set. Qed. Lemma add_mem_1: mem x (add x s)=true. Proof. auto with set relations. Qed. Lemma add_mem_2: ~E.eq x y -> mem y (add x s)=mem y s. Proof. apply add_neq_b. Qed. Lemma remove_mem_1: mem x (remove x s)=false. Proof. rewrite <- not_mem_iff; auto with set relations. Qed. Lemma remove_mem_2: ~E.eq x y -> mem y (remove x s)=mem y s. Proof. apply remove_neq_b. Qed. Lemma singleton_equal_add: equal (singleton x) (add x empty)=true. Proof. rewrite (singleton_equal_add x); auto with set. Qed. Lemma union_mem: mem x (union s s')=mem x s || mem x s'. Proof. apply union_b. Qed. Lemma inter_mem: mem x (inter s s')=mem x s && mem x s'. Proof. apply inter_b. Qed. Lemma diff_mem: mem x (diff s s')=mem x s && negb (mem x s'). Proof. apply diff_b. Qed. (** properties of [mem] *) Lemma mem_3 : ~In x s -> mem x s=false. Proof. intros; rewrite <- not_mem_iff; auto. Qed. Lemma mem_4 : mem x s=false -> ~In x s. Proof. intros; rewrite not_mem_iff; auto. Qed. (** Properties of [equal] *) Lemma equal_refl: equal s s=true. Proof. auto with set. Qed. Lemma equal_sym: equal s s'=equal s' s. Proof. intros; apply bool_1; do 2 rewrite <- equal_iff; intuition auto with relations. Qed. Lemma equal_trans: equal s s'=true -> equal s' s''=true -> equal s s''=true. Proof. intros; rewrite (equal_2 H); auto. Qed. Lemma equal_equal: equal s s'=true -> equal s s''=equal s' s''. Proof. intros; rewrite (equal_2 H); auto. Qed. Lemma equal_cardinal: equal s s'=true -> cardinal s=cardinal s'. Proof. auto with set. Qed. (* Properties of [subset] *) Lemma subset_refl: subset s s=true. Proof. auto with set. Qed. Lemma subset_antisym: subset s s'=true -> subset s' s=true -> equal s s'=true. Proof. auto with set. Qed. Lemma subset_trans: subset s s'=true -> subset s' s''=true -> subset s s''=true. Proof. do 3 rewrite <- subset_iff; intros. apply subset_trans with s'; auto. Qed. Lemma subset_equal: equal s s'=true -> subset s s'=true. Proof. auto with set. Qed. (** Properties of [choose] *) Lemma choose_mem_3: is_empty s=false -> {x:elt|choose s=Some x /\ mem x s=true}. Proof. intros. generalize (@choose_1 s) (@choose_2 s). destruct (choose s);intros. - exists e;auto with set. - generalize (H1 (eq_refl None)); clear H1. intros; rewrite (is_empty_1 H1) in H; discriminate. Qed. Lemma choose_mem_4: choose empty=None. Proof. generalize (@choose_1 empty). case (@choose empty);intros;auto. elim (@empty_1 e); auto. Qed. (** Properties of [add] *) Lemma add_mem_3: mem y s=true -> mem y (add x s)=true. Proof. auto with set. Qed. Lemma add_equal: mem x s=true -> equal (add x s) s=true. Proof. auto with set. Qed. (** Properties of [remove] *) Lemma remove_mem_3: mem y (remove x s)=true -> mem y s=true. Proof. rewrite remove_b; intros H;destruct (andb_prop _ _ H); auto. Qed. Lemma remove_equal: mem x s=false -> equal (remove x s) s=true. Proof. intros; apply equal_1; apply remove_equal. rewrite not_mem_iff; auto. Qed. Lemma add_remove: mem x s=true -> equal (add x (remove x s)) s=true. Proof. intros; apply equal_1; apply add_remove; auto with set. Qed. Lemma remove_add: mem x s=false -> equal (remove x (add x s)) s=true. Proof. intros; apply equal_1; apply remove_add; auto. rewrite not_mem_iff; auto. Qed. (** Properties of [is_empty] *) Lemma is_empty_cardinal: is_empty s = zerob (cardinal s). Proof. intros; apply bool_1; split; intros. - rewrite MP.cardinal_1; simpl; auto with set. - assert (cardinal s = 0) by (apply zerob_true_elim; auto). auto with set. Qed. (** Properties of [singleton] *) Lemma singleton_mem_1: mem x (singleton x)=true. Proof. auto with set relations. Qed. Lemma singleton_mem_2: ~E.eq x y -> mem y (singleton x)=false. Proof. intros; rewrite singleton_b. unfold eqb; destruct (E.eq_dec x y); intuition. Qed. Lemma singleton_mem_3: mem y (singleton x)=true -> E.eq x y. Proof. intros; apply singleton_1; auto with set. Qed. (** Properties of [union] *) Lemma union_sym: equal (union s s') (union s' s)=true. Proof. auto with set. Qed. Lemma union_subset_equal: subset s s'=true -> equal (union s s') s'=true. Proof. auto with set. Qed. Lemma union_equal_1: equal s s'=true-> equal (union s s'') (union s' s'')=true. Proof. auto with set. Qed. Lemma union_equal_2: equal s' s''=true-> equal (union s s') (union s s'')=true. Proof. auto with set. Qed. Lemma union_assoc: equal (union (union s s') s'') (union s (union s' s''))=true. Proof. auto with set. Qed. Lemma add_union_singleton: equal (add x s) (union (singleton x) s)=true. Proof. auto with set. Qed. Lemma union_add: equal (union (add x s) s') (add x (union s s'))=true. Proof. auto with set. Qed. (* characterisation of [union] via [subset] *) Lemma union_subset_1: subset s (union s s')=true. Proof. auto with set. Qed. Lemma union_subset_2: subset s' (union s s')=true. Proof. auto with set. Qed. Lemma union_subset_3: subset s s''=true -> subset s' s''=true -> subset (union s s') s''=true. Proof. intros; apply subset_1; apply union_subset_3; auto with set. Qed. (** Properties of [inter] *) Lemma inter_sym: equal (inter s s') (inter s' s)=true. Proof. auto with set. Qed. Lemma inter_subset_equal: subset s s'=true -> equal (inter s s') s=true. Proof. auto with set. Qed. Lemma inter_equal_1: equal s s'=true -> equal (inter s s'') (inter s' s'')=true. Proof. auto with set. Qed. Lemma inter_equal_2: equal s' s''=true -> equal (inter s s') (inter s s'')=true. Proof. auto with set. Qed. Lemma inter_assoc: equal (inter (inter s s') s'') (inter s (inter s' s''))=true. Proof. auto with set. Qed. Lemma union_inter_1: equal (inter (union s s') s'') (union (inter s s'') (inter s' s''))=true. Proof. auto with set. Qed. Lemma union_inter_2: equal (union (inter s s') s'') (inter (union s s'') (union s' s''))=true. Proof. auto with set. Qed. Lemma inter_add_1: mem x s'=true -> equal (inter (add x s) s') (add x (inter s s'))=true. Proof. auto with set. Qed. Lemma inter_add_2: mem x s'=false -> equal (inter (add x s) s') (inter s s')=true. Proof. intros; apply equal_1; apply inter_add_2. rewrite not_mem_iff; auto. Qed. (* characterisation of [union] via [subset] *) Lemma inter_subset_1: subset (inter s s') s=true. Proof. auto with set. Qed. Lemma inter_subset_2: subset (inter s s') s'=true. Proof. auto with set. Qed. Lemma inter_subset_3: subset s'' s=true -> subset s'' s'=true -> subset s'' (inter s s')=true. Proof. intros; apply subset_1; apply inter_subset_3; auto with set. Qed. (** Properties of [diff] *) Lemma diff_subset: subset (diff s s') s=true. Proof. auto with set. Qed. Lemma diff_subset_equal: subset s s'=true -> equal (diff s s') empty=true. Proof. auto with set. Qed. Lemma remove_inter_singleton: equal (remove x s) (diff s (singleton x))=true. Proof. auto with set. Qed. Lemma diff_inter_empty: equal (inter (diff s s') (inter s s')) empty=true. Proof. auto with set. Qed. Lemma diff_inter_all: equal (union (diff s s') (inter s s')) s=true. Proof. auto with set. Qed. End BasicProperties. #[global] Hint Immediate empty_mem is_empty_equal_empty add_mem_1 remove_mem_1 singleton_equal_add union_mem inter_mem diff_mem equal_sym add_remove remove_add : set. #[global] Hint Resolve equal_mem_1 subset_mem_1 choose_mem_1 choose_mem_2 add_mem_2 remove_mem_2 equal_refl equal_equal subset_refl subset_equal subset_antisym add_mem_3 add_equal remove_mem_3 remove_equal : set. (** General recursion principle *) Lemma set_rec: forall (P:t->Type), (forall s s', equal s s'=true -> P s -> P s') -> (forall s x, mem x s=false -> P s -> P (add x s)) -> P empty -> forall s, P s. Proof. intros. apply set_induction; auto; intros. - apply X with empty; auto with set. - apply X with (add x s0); auto with set. + apply equal_1; intro a; rewrite add_iff; rewrite (H0 a); tauto. + apply X0; auto with set; apply mem_3; auto. Qed. (** Properties of [fold] *) Lemma exclusive_set : forall s s' x, ~(In x s/\In x s') <-> mem x s && mem x s'=false. Proof. intros; do 2 rewrite mem_iff. destruct (mem x s); destruct (mem x s'); intuition auto with bool. Qed. Section Fold. Variables (A:Type)(eqA:A->A->Prop)(st:Equivalence eqA). Variables (f:elt->A->A)(Comp:Proper (E.eq==>eqA==>eqA) f)(Ass:transpose eqA f). Variables (i:A). Variables (s s':t)(x:elt). Lemma fold_empty: (fold f empty i) = i. Proof. apply fold_empty; auto. Qed. Lemma fold_equal: equal s s'=true -> eqA (fold f s i) (fold f s' i). Proof. intros; apply fold_equal with (eqA:=eqA); auto with set. Qed. Lemma fold_add: mem x s=false -> eqA (fold f (add x s) i) (f x (fold f s i)). Proof. intros; apply fold_add with (eqA:=eqA); auto. rewrite not_mem_iff; auto. Qed. Lemma add_fold: mem x s=true -> eqA (fold f (add x s) i) (fold f s i). Proof. intros; apply add_fold with (eqA:=eqA); auto with set. Qed. Lemma remove_fold_1: mem x s=true -> eqA (f x (fold f (remove x s) i)) (fold f s i). Proof. intros; apply remove_fold_1 with (eqA:=eqA); auto with set. Qed. Lemma remove_fold_2: mem x s=false -> eqA (fold f (remove x s) i) (fold f s i). Proof. intros; apply remove_fold_2 with (eqA:=eqA); auto. rewrite not_mem_iff; auto. Qed. Lemma fold_union: (forall x, mem x s && mem x s'=false) -> eqA (fold f (union s s') i) (fold f s (fold f s' i)). Proof. intros; apply fold_union with (eqA:=eqA); auto. intros; rewrite exclusive_set; auto. Qed. End Fold. (** Properties of [cardinal] *) Lemma add_cardinal_1: forall s x, mem x s=true -> cardinal (add x s)=cardinal s. Proof. auto with set. Qed. Lemma add_cardinal_2: forall s x, mem x s=false -> cardinal (add x s)=S (cardinal s). Proof. intros; apply add_cardinal_2; auto. rewrite not_mem_iff; auto. Qed. Lemma remove_cardinal_1: forall s x, mem x s=true -> S (cardinal (remove x s))=cardinal s. Proof. intros; apply remove_cardinal_1; auto with set. Qed. Lemma remove_cardinal_2: forall s x, mem x s=false -> cardinal (remove x s)=cardinal s. Proof. intros; apply Equal_cardinal; apply equal_2; auto with set. Qed. Lemma union_cardinal: forall s s', (forall x, mem x s && mem x s'=false) -> cardinal (union s s')=cardinal s+cardinal s'. Proof. intros; apply union_cardinal; auto; intros. rewrite exclusive_set; auto. Qed. Lemma subset_cardinal: forall s s', subset s s'=true -> cardinal s<=cardinal s'. Proof. intros; apply subset_cardinal; auto with set. Qed. Section Bool. (** Properties of [filter] *) Variable f:elt->bool. Variable Comp: Proper (E.eq==>Logic.eq) f. Let Comp' : Proper (E.eq==>Logic.eq) (fun x =>negb (f x)). Proof. repeat red; intros; f_equal; auto. Defined. Lemma filter_mem: forall s x, mem x (filter f s)=mem x s && f x. Proof. intros; apply filter_b; auto. Qed. Lemma for_all_filter: forall s, for_all f s=is_empty (filter (fun x => negb (f x)) s). Proof. intros; apply bool_1; split; intros. - apply is_empty_1. unfold Empty; intros. rewrite filter_iff; auto. red; destruct 1. rewrite <- (@for_all_iff s f) in H; auto. rewrite (H a H0) in H1; discriminate. - apply for_all_1; auto; red; intros. revert H; rewrite <- is_empty_iff. unfold Empty; intro H; generalize (H x); clear H. rewrite filter_iff; auto. destruct (f x); auto. Qed. Lemma exists_filter : forall s, exists_ f s=negb (is_empty (filter f s)). Proof. intros; apply bool_1; split; intros. - destruct (exists_2 Comp H) as (a,(Ha1,Ha2)). apply bool_6. red; intros; apply (@is_empty_2 _ H0 a); auto with set. - generalize (@choose_1 (filter f s)) (@choose_2 (filter f s)). destruct (choose (filter f s)). + intros H0 _; apply exists_1; auto. exists e; generalize (H0 e); rewrite filter_iff; auto. + intros _ H0. rewrite (is_empty_1 (H0 (eq_refl None))) in H; auto; discriminate. Qed. Lemma partition_filter_1: forall s, equal (fst (partition f s)) (filter f s)=true. Proof. auto with set. Qed. Lemma partition_filter_2: forall s, equal (snd (partition f s)) (filter (fun x => negb (f x)) s)=true. Proof. auto with set. Qed. Lemma filter_add_1 : forall s x, f x = true -> filter f (add x s) [=] add x (filter f s). Proof. red; intros; set_iff; do 2 (rewrite filter_iff; auto); set_iff. intuition. rewrite <- H; apply Comp; auto with relations. Qed. Lemma filter_add_2 : forall s x, f x = false -> filter f (add x s) [=] filter f s. Proof. red; intros; do 2 (rewrite filter_iff; auto); set_iff. intuition. assert (f x = f a) by (apply Comp; auto). rewrite H in H1; rewrite H2 in H1; discriminate. Qed. Lemma add_filter_1 : forall s s' x, f x=true -> (Add x s s') -> (Add x (filter f s) (filter f s')). Proof. unfold Add, MP.Add; intros. repeat rewrite filter_iff; auto. rewrite H0; clear H0. intuition. setoid_replace y with x; auto with relations. Qed. Lemma add_filter_2 : forall s s' x, f x=false -> (Add x s s') -> filter f s [=] filter f s'. Proof. unfold Add, MP.Add, Equal; intros. repeat rewrite filter_iff; auto. rewrite H0; clear H0. intuition. setoid_replace x with a in H; auto. congruence. Qed. Lemma union_filter: forall f g, Proper (E.eq==>Logic.eq) f -> Proper (E.eq==>Logic.eq) g -> forall s, union (filter f s) (filter g s) [=] filter (fun x=>orb (f x) (g x)) s. Proof. clear Comp' Comp f. intros. assert (Proper (E.eq==>Logic.eq) (fun x => orb (f x) (g x))). - repeat red; intros. rewrite (H x y H1); rewrite (H0 x y H1); auto. - unfold Equal; intros; set_iff; repeat rewrite filter_iff; auto. assert (f a || g a = true <-> f a = true \/ g a = true). + split; auto with bool. intro H3; destruct (orb_prop _ _ H3); auto. + tauto. Qed. Lemma filter_union: forall s s', filter f (union s s') [=] union (filter f s) (filter f s'). Proof. unfold Equal; intros; set_iff; repeat rewrite filter_iff; auto; set_iff; tauto. Qed. (** Properties of [for_all] *) Lemma for_all_mem_1: forall s, (forall x, (mem x s)=true->(f x)=true) -> (for_all f s)=true. Proof. intros. rewrite for_all_filter; auto. rewrite is_empty_equal_empty. apply equal_mem_1;intros. rewrite filter_b; auto. rewrite empty_mem. generalize (H a); case (mem a s);intros;auto. rewrite H0;auto. Qed. Lemma for_all_mem_2: forall s, (for_all f s)=true -> forall x,(mem x s)=true -> (f x)=true. Proof. intros. rewrite for_all_filter in H; auto. rewrite is_empty_equal_empty in H. generalize (equal_mem_2 _ _ H x). rewrite filter_b; auto. rewrite empty_mem. rewrite H0; simpl;intros. rewrite <- negb_false_iff; auto. Qed. Lemma for_all_mem_3: forall s x,(mem x s)=true -> (f x)=false -> (for_all f s)=false. Proof. intros. apply (bool_eq_ind (for_all f s));intros;auto. rewrite for_all_filter in H1; auto. rewrite is_empty_equal_empty in H1. generalize (equal_mem_2 _ _ H1 x). rewrite filter_b; auto. rewrite empty_mem. rewrite H. rewrite H0. simpl;auto. Qed. Lemma for_all_mem_4: forall s, for_all f s=false -> {x:elt | mem x s=true /\ f x=false}. Proof. intros. rewrite for_all_filter in H; auto. destruct (choose_mem_3 _ H) as (x,(H0,H1));intros. exists x. rewrite filter_b in H1; auto. elim (andb_prop _ _ H1). split;auto. rewrite <- negb_true_iff; auto. Qed. (** Properties of [exists] *) Lemma for_all_exists: forall s, exists_ f s = negb (for_all (fun x =>negb (f x)) s). Proof. intros. rewrite for_all_b; auto. rewrite exists_b; auto. induction (elements s); simpl; auto. destruct (f a); simpl; auto. Qed. End Bool. Section Bool'. Variable f:elt->bool. Variable Comp: Proper (E.eq==>Logic.eq) f. Local Definition Comp' : Proper (E.eq==>Logic.eq) (fun x => negb (f x)). Proof. repeat red; intros; f_equal; auto. Defined. Local Hint Resolve Comp' : core. Lemma exists_mem_1: forall s, (forall x, mem x s=true->f x=false) -> exists_ f s=false. Proof. intros. rewrite for_all_exists; auto. rewrite for_all_mem_1;auto with bool. intros;generalize (H x H0);intros. rewrite negb_true_iff; auto. Qed. Lemma exists_mem_2: forall s, exists_ f s=false -> forall x, mem x s=true -> f x=false. Proof. intros. rewrite for_all_exists in H; auto. rewrite negb_false_iff in H. rewrite <- negb_true_iff. apply for_all_mem_2 with (2:=H); auto. Qed. Lemma exists_mem_3: forall s x, mem x s=true -> f x=true -> exists_ f s=true. Proof. intros. rewrite for_all_exists; auto. rewrite negb_true_iff. apply for_all_mem_3 with x;auto. rewrite negb_false_iff; auto. Qed. Lemma exists_mem_4: forall s, exists_ f s=true -> {x:elt | (mem x s)=true /\ (f x)=true}. Proof. intros. rewrite for_all_exists in H; auto. rewrite negb_true_iff in H. destruct (@for_all_mem_4 (fun x =>negb (f x)) Comp' s) as (x,[]); auto. exists x;split;auto. rewrite <-negb_false_iff; auto. Qed. End Bool'. Section Sum. (** Adding a valuation function on all elements of a set. *) Definition sum (f:elt -> nat)(s:t) := fold (fun x => plus (f x)) s 0. Notation compat_opL := (Proper (E.eq==>Logic.eq==>Logic.eq)). Notation transposeL := (transpose Logic.eq). Lemma sum_plus : forall f g, Proper (E.eq==>Logic.eq) f -> Proper (E.eq==>Logic.eq) g -> forall s, sum (fun x =>f x+g x) s = sum f s + sum g s. Proof. unfold sum. intros f g Hf Hg. assert (fc : compat_opL (fun x:elt =>plus (f x))) by (repeat red; intros; rewrite Hf; auto). assert (ft : transposeL (fun x:elt =>plus (f x))) by (red; intros; lia). assert (gc : compat_opL (fun x:elt => plus (g x))) by (repeat red; intros; rewrite Hg; auto). assert (gt : transposeL (fun x:elt =>plus (g x))) by (red; intros; lia). assert (fgc : compat_opL (fun x:elt =>plus ((f x)+(g x)))) by (repeat red; intros; rewrite Hf,Hg; auto). assert (fgt : transposeL (fun x:elt=>plus ((f x)+(g x)))) by (red; intros; lia). intros s;pattern s; apply set_rec. - intros. rewrite <- (fold_equal _ _ _ _ fc ft 0 _ _ H). rewrite <- (fold_equal _ _ _ _ gc gt 0 _ _ H). rewrite <- (fold_equal _ _ _ _ fgc fgt 0 _ _ H); auto. - intros. do 3 (rewrite fold_add by auto with fset). lia. - do 3 rewrite fold_empty;auto. Qed. Lemma sum_filter : forall f : elt -> bool, Proper (E.eq==>Logic.eq) f -> forall s, (sum (fun x => if f x then 1 else 0) s) = (cardinal (filter f s)). Proof. unfold sum; intros f Hf. assert (st : Equivalence (@Logic.eq nat)) by (split; congruence). assert (cc : compat_opL (fun x => plus (if f x then 1 else 0))) by (repeat red; intros; rewrite Hf; auto). assert (ct : transposeL (fun x => plus (if f x then 1 else 0))) by (red; intros; lia). intros s;pattern s; apply set_rec. - intros. change elt with E.t. rewrite <- (fold_equal _ _ st _ cc ct 0 _ _ H). apply equal_2 in H; rewrite <- H, <-H0; auto. - intros; rewrite (fold_add _ _ st _ cc ct); auto. generalize (@add_filter_1 f Hf s0 (add x s0) x) (@add_filter_2 f Hf s0 (add x s0) x) . assert (~ In x (filter f s0)). + intro H1; rewrite (mem_1 (filter_1 Hf H1)) in H; discriminate H. + case (f x); simpl; intros. * rewrite (MP.cardinal_2 H1 (H2 (eq_refl true) (MP.Add_add s0 x))); auto. * rewrite <- (MP.Equal_cardinal (H3 (eq_refl false) (MP.Add_add s0 x))); auto. - intros; rewrite fold_empty;auto. rewrite MP.cardinal_1; auto. unfold Empty; intros. rewrite filter_iff; auto; set_iff; tauto. Qed. Lemma fold_compat : forall (A:Type)(eqA:A->A->Prop)(st:Equivalence eqA) (f g:elt->A->A), Proper (E.eq==>eqA==>eqA) f -> transpose eqA f -> Proper (E.eq==>eqA==>eqA) g -> transpose eqA g -> forall (i:A)(s:t),(forall x:elt, (In x s) -> forall y, (eqA (f x y) (g x y))) -> (eqA (fold f s i) (fold g s i)). Proof. intros A eqA st f g fc ft gc gt i. intro s; pattern s; apply set_rec; intros. - transitivity (fold f s0 i). + apply fold_equal with (eqA:=eqA); auto. rewrite equal_sym; auto. + transitivity (fold g s0 i). * apply H0; intros; apply H1; auto with set. elim (equal_2 H x); auto with set; intros. * apply fold_equal with (eqA:=eqA); auto with set. - transitivity (f x (fold f s0 i)). + apply fold_add with (eqA:=eqA); auto with set. + transitivity (g x (fold f s0 i)); auto with set relations. transitivity (g x (fold g s0 i)); auto with set relations. * apply gc; auto with set relations. * symmetry; apply fold_add with (eqA:=eqA); auto. - do 2 rewrite fold_empty; reflexivity. Qed. Lemma sum_compat : forall f g, Proper (E.eq==>Logic.eq) f -> Proper (E.eq==>Logic.eq) g -> forall s, (forall x, In x s -> f x=g x) -> sum f s=sum g s. intros. unfold sum; apply (@fold_compat _ (@Logic.eq nat)); repeat red; auto with *; lia. Qed. End Sum. End WEqPropertiesOn. (** Now comes variants for self-contained weak sets and for full sets. For these variants, only one argument is necessary. Thanks to the subtyping [WS<=S], the [EqProperties] functor which is meant to be used on modules [(M:S)] can simply be an alias of [WEqProperties]. *) Module WEqProperties (M:WSets) := WEqPropertiesOn M.E M. Module EqProperties := WEqProperties. coq-8.20.0/theories/MSets/MSetFacts.v000066400000000000000000000425271466560755400173140ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* In x s -> In y s. Proof. intros E; rewrite E; auto. Qed. Lemma mem_1 : In x s -> mem x s = true. Proof. intros; apply <- mem_spec; auto. Qed. Lemma mem_2 : mem x s = true -> In x s. Proof. intros; apply -> mem_spec; auto. Qed. Lemma equal_1 : Equal s s' -> equal s s' = true. Proof. intros; apply <- equal_spec; auto. Qed. Lemma equal_2 : equal s s' = true -> Equal s s'. Proof. intros; apply -> equal_spec; auto. Qed. Lemma subset_1 : Subset s s' -> subset s s' = true. Proof. intros; apply <- subset_spec; auto. Qed. Lemma subset_2 : subset s s' = true -> Subset s s'. Proof. intros; apply -> subset_spec; auto. Qed. Lemma is_empty_1 : Empty s -> is_empty s = true. Proof. intros; apply <- is_empty_spec; auto. Qed. Lemma is_empty_2 : is_empty s = true -> Empty s. Proof. intros; apply -> is_empty_spec; auto. Qed. Lemma add_1 : E.eq x y -> In y (add x s). Proof. intros; apply <- add_spec. auto with relations. Qed. Lemma add_2 : In y s -> In y (add x s). Proof. intros; apply <- add_spec; auto. Qed. Lemma add_3 : ~ E.eq x y -> In y (add x s) -> In y s. Proof. rewrite add_spec. intros H [H'|H']; auto. elim H; auto with relations. Qed. Lemma remove_1 : E.eq x y -> ~ In y (remove x s). Proof. intros; rewrite remove_spec; intuition. Qed. Lemma remove_2 : ~ E.eq x y -> In y s -> In y (remove x s). Proof. intros; apply <- remove_spec; auto with relations. Qed. Lemma remove_3 : In y (remove x s) -> In y s. Proof. rewrite remove_spec; intuition. Qed. Lemma singleton_1 : In y (singleton x) -> E.eq x y. Proof. rewrite singleton_spec; auto with relations. Qed. Lemma singleton_2 : E.eq x y -> In y (singleton x). Proof. rewrite singleton_spec; auto with relations. Qed. Lemma union_1 : In x (union s s') -> In x s \/ In x s'. Proof. rewrite union_spec; auto. Qed. Lemma union_2 : In x s -> In x (union s s'). Proof. rewrite union_spec; auto. Qed. Lemma union_3 : In x s' -> In x (union s s'). Proof. rewrite union_spec; auto. Qed. Lemma inter_1 : In x (inter s s') -> In x s. Proof. rewrite inter_spec; intuition. Qed. Lemma inter_2 : In x (inter s s') -> In x s'. Proof. rewrite inter_spec; intuition. Qed. Lemma inter_3 : In x s -> In x s' -> In x (inter s s'). Proof. rewrite inter_spec; intuition. Qed. Lemma diff_1 : In x (diff s s') -> In x s. Proof. rewrite diff_spec; intuition. Qed. Lemma diff_2 : In x (diff s s') -> ~ In x s'. Proof. rewrite diff_spec; intuition. Qed. Lemma diff_3 : In x s -> ~ In x s' -> In x (diff s s'). Proof. rewrite diff_spec; auto. Qed. Variable f : elt -> bool. Notation compatb := (Proper (E.eq==>Logic.eq)) (only parsing). Lemma filter_1 : compatb f -> In x (filter f s) -> In x s. Proof. intros P; rewrite filter_spec; intuition. Qed. Lemma filter_2 : compatb f -> In x (filter f s) -> f x = true. Proof. intros P; rewrite filter_spec; intuition. Qed. Lemma filter_3 : compatb f -> In x s -> f x = true -> In x (filter f s). Proof. intros P; rewrite filter_spec; intuition. Qed. Lemma for_all_1 : compatb f -> For_all (fun x => f x = true) s -> for_all f s = true. Proof. intros; apply <- for_all_spec; auto. Qed. Lemma for_all_2 : compatb f -> for_all f s = true -> For_all (fun x => f x = true) s. Proof. intros; apply -> for_all_spec; auto. Qed. Lemma exists_1 : compatb f -> Exists (fun x => f x = true) s -> exists_ f s = true. Proof. intros; apply <- exists_spec; auto. Qed. Lemma exists_2 : compatb f -> exists_ f s = true -> Exists (fun x => f x = true) s. Proof. intros; apply -> exists_spec; auto. Qed. Lemma elements_1 : In x s -> InA E.eq x (elements s). Proof. intros; apply <- elements_spec1; auto. Qed. Lemma elements_2 : InA E.eq x (elements s) -> In x s. Proof. intros; apply -> elements_spec1; auto. Qed. End ImplSpec. Notation empty_1 := empty_spec (only parsing). Notation fold_1 := fold_spec (only parsing). Notation cardinal_1 := cardinal_spec (only parsing). Notation partition_1 := partition_spec1 (only parsing). Notation partition_2 := partition_spec2 (only parsing). Notation choose_1 := choose_spec1 (only parsing). Notation choose_2 := choose_spec2 (only parsing). Notation elements_3w := elements_spec2w (only parsing). #[global] Hint Resolve mem_1 equal_1 subset_1 empty_1 is_empty_1 choose_1 choose_2 add_1 add_2 remove_1 remove_2 singleton_2 union_1 union_2 union_3 inter_3 diff_3 fold_1 filter_3 for_all_1 exists_1 partition_1 partition_2 elements_1 elements_3w : set. #[global] Hint Immediate In_1 mem_2 equal_2 subset_2 is_empty_2 add_3 remove_3 singleton_1 inter_1 inter_2 diff_1 diff_2 filter_1 filter_2 for_all_2 exists_2 elements_2 : set. (** * Specifications written using equivalences : this is now provided by the default interface. *) Section IffSpec. Variable s s' s'' : t. Variable x y z : elt. Lemma In_eq_iff : E.eq x y -> (In x s <-> In y s). Proof. intros E; rewrite E; intuition. Qed. Lemma mem_iff : In x s <-> mem x s = true. Proof. apply iff_sym, mem_spec. Qed. Lemma not_mem_iff : ~In x s <-> mem x s = false. Proof. rewrite <-mem_spec; destruct (mem x s); intuition auto with bool. Qed. Lemma equal_iff : s[=]s' <-> equal s s' = true. Proof. apply iff_sym, equal_spec. Qed. Lemma subset_iff : s[<=]s' <-> subset s s' = true. Proof. apply iff_sym, subset_spec. Qed. Lemma empty_iff : In x empty <-> False. Proof. intuition; apply (empty_spec H). Qed. Lemma is_empty_iff : Empty s <-> is_empty s = true. Proof. apply iff_sym, is_empty_spec. Qed. Lemma singleton_iff : In y (singleton x) <-> E.eq x y. Proof. rewrite singleton_spec; intuition. Qed. Lemma add_iff : In y (add x s) <-> E.eq x y \/ In y s. Proof. rewrite add_spec; intuition. Qed. Lemma add_neq_iff : ~ E.eq x y -> (In y (add x s) <-> In y s). Proof. rewrite add_spec; intuition. elim H; auto with relations. Qed. Lemma remove_iff : In y (remove x s) <-> In y s /\ ~E.eq x y. Proof. rewrite remove_spec; intuition. Qed. Lemma remove_neq_iff : ~ E.eq x y -> (In y (remove x s) <-> In y s). Proof. rewrite remove_spec; intuition. Qed. Variable f : elt -> bool. Lemma for_all_iff : Proper (E.eq==>Logic.eq) f -> (For_all (fun x => f x = true) s <-> for_all f s = true). Proof. intros; apply iff_sym, for_all_spec; auto. Qed. Lemma exists_iff : Proper (E.eq==>Logic.eq) f -> (Exists (fun x => f x = true) s <-> exists_ f s = true). Proof. intros; apply iff_sym, exists_spec; auto. Qed. Lemma elements_iff : In x s <-> InA E.eq x (elements s). Proof. apply iff_sym, elements_spec1. Qed. End IffSpec. Notation union_iff := union_spec (only parsing). Notation inter_iff := inter_spec (only parsing). Notation diff_iff := diff_spec (only parsing). Notation filter_iff := filter_spec (only parsing). (** Useful tactic for simplifying expressions like [In y (add x (union s s'))] *) Ltac set_iff := repeat (progress ( rewrite add_iff || rewrite remove_iff || rewrite singleton_iff || rewrite union_iff || rewrite inter_iff || rewrite diff_iff || rewrite empty_iff)). (** * Specifications written using boolean predicates *) Section BoolSpec. Variable s s' s'' : t. Variable x y z : elt. Lemma mem_b : E.eq x y -> mem x s = mem y s. Proof. intros. generalize (mem_iff s x) (mem_iff s y)(In_eq_iff s H). destruct (mem x s); destruct (mem y s); intuition. Qed. Lemma empty_b : mem y empty = false. Proof. generalize (empty_iff y)(mem_iff empty y). destruct (mem y empty); intuition. Qed. Lemma add_b : mem y (add x s) = eqb x y || mem y s. Proof. generalize (mem_iff (add x s) y)(mem_iff s y)(add_iff s x y); unfold eqb. destruct (eq_dec x y); destruct (mem y s); destruct (mem y (add x s)); intuition. Qed. Lemma add_neq_b : ~ E.eq x y -> mem y (add x s) = mem y s. Proof. intros; generalize (mem_iff (add x s) y)(mem_iff s y)(add_neq_iff s H). destruct (mem y s); destruct (mem y (add x s)); intuition. Qed. Lemma remove_b : mem y (remove x s) = mem y s && negb (eqb x y). Proof. generalize (mem_iff (remove x s) y)(mem_iff s y)(remove_iff s x y); unfold eqb. destruct (eq_dec x y); destruct (mem y s); destruct (mem y (remove x s)); simpl; intuition. Qed. Lemma remove_neq_b : ~ E.eq x y -> mem y (remove x s) = mem y s. Proof. intros; generalize (mem_iff (remove x s) y)(mem_iff s y)(remove_neq_iff s H). destruct (mem y s); destruct (mem y (remove x s)); intuition. Qed. Lemma singleton_b : mem y (singleton x) = eqb x y. Proof. generalize (mem_iff (singleton x) y)(singleton_iff x y); unfold eqb. destruct (eq_dec x y); destruct (mem y (singleton x)); intuition. Qed. Lemma union_b : mem x (union s s') = mem x s || mem x s'. Proof. generalize (mem_iff (union s s') x)(mem_iff s x)(mem_iff s' x)(union_iff s s' x). destruct (mem x s); destruct (mem x s'); destruct (mem x (union s s')); intuition. Qed. Lemma inter_b : mem x (inter s s') = mem x s && mem x s'. Proof. generalize (mem_iff (inter s s') x)(mem_iff s x)(mem_iff s' x)(inter_iff s s' x). destruct (mem x s); destruct (mem x s'); destruct (mem x (inter s s')); intuition. Qed. Lemma diff_b : mem x (diff s s') = mem x s && negb (mem x s'). Proof. generalize (mem_iff (diff s s') x)(mem_iff s x)(mem_iff s' x)(diff_iff s s' x). destruct (mem x s); destruct (mem x s'); destruct (mem x (diff s s')); simpl; intuition. Qed. Lemma elements_b : mem x s = existsb (eqb x) (elements s). Proof. generalize (mem_iff s x)(elements_iff s x)(existsb_exists (eqb x) (elements s)). rewrite InA_alt. destruct (mem x s); destruct (existsb (eqb x) (elements s)); auto; intros. - symmetry. rewrite H1. destruct H0 as (H0,_). destruct H0 as (a,(Ha1,Ha2)); [ intuition |]. exists a; intuition. unfold eqb; destruct (eq_dec x a); auto. - rewrite <- H. rewrite H0. destruct H1 as (H1,_). destruct H1 as (a,(Ha1,Ha2)); [intuition|]. exists a; intuition. unfold eqb in *; destruct (eq_dec x a); auto; discriminate. Qed. Variable f : elt->bool. Lemma filter_b : Proper (E.eq==>Logic.eq) f -> mem x (filter f s) = mem x s && f x. Proof. intros. generalize (mem_iff (filter f s) x)(mem_iff s x)(filter_iff s x H). destruct (mem x s); destruct (mem x (filter f s)); destruct (f x); simpl; intuition. Qed. Lemma for_all_b : Proper (E.eq==>Logic.eq) f -> for_all f s = forallb f (elements s). Proof. intros. generalize (forallb_forall f (elements s))(for_all_iff s H)(elements_iff s). unfold For_all. destruct (forallb f (elements s)); destruct (for_all f s); auto; intros. - rewrite <- H1; intros. destruct H0 as (H0,_). rewrite (H2 x0) in H3. rewrite (InA_alt E.eq x0 (elements s)) in H3. destruct H3 as (a,(Ha1,Ha2)). rewrite (H _ _ Ha1). apply H0; auto. - symmetry. rewrite H0; intros. destruct H1 as (_,H1). apply H1; auto. rewrite H2. rewrite InA_alt. exists x0; split; auto with relations. Qed. Lemma exists_b : Proper (E.eq==>Logic.eq) f -> exists_ f s = existsb f (elements s). Proof. intros. generalize (existsb_exists f (elements s))(exists_iff s H)(elements_iff s). unfold Exists. destruct (existsb f (elements s)); destruct (exists_ f s); auto; intros. - rewrite <- H1; intros. destruct H0 as (H0,_). destruct H0 as (a,(Ha1,Ha2)); auto. exists a; split; auto. rewrite H2; rewrite InA_alt; exists a; auto with relations. - symmetry. rewrite H0. destruct H1 as (_,H1). destruct H1 as (a,(Ha1,Ha2)); auto. rewrite (H2 a) in Ha1. rewrite (InA_alt E.eq a (elements s)) in Ha1. destruct Ha1 as (b,(Hb1,Hb2)). exists b; auto. rewrite <- (H _ _ Hb1); auto. Qed. End BoolSpec. (** * Declarations of morphisms with respects to [E.eq] and [Equal] *) #[global] Instance In_m : Proper (E.eq==>Equal==>iff) In. Proof. unfold Equal; intros x y H s s' H0. rewrite (In_eq_iff s H); auto. Qed. #[global] Instance Empty_m : Proper (Equal==>iff) Empty. Proof. repeat red; unfold Empty; intros s s' E. setoid_rewrite E; auto. Qed. #[global] Instance is_empty_m : Proper (Equal==>Logic.eq) is_empty. Proof. intros s s' H. generalize (is_empty_iff s). rewrite H at 1. rewrite is_empty_iff. destruct (is_empty s); destruct (is_empty s'); intuition. Qed. #[global] Instance mem_m : Proper (E.eq==>Equal==>Logic.eq) mem. Proof. intros x x' Hx s s' Hs. generalize (mem_iff s x). rewrite Hs, Hx at 1; rewrite mem_iff. destruct (mem x s), (mem x' s'); intuition. Qed. #[global] Instance singleton_m : Proper (E.eq==>Equal) singleton. Proof. intros x y H a. rewrite !singleton_iff, H; intuition. Qed. #[global] Instance add_m : Proper (E.eq==>Equal==>Equal) add. Proof. intros x x' Hx s s' Hs a. rewrite !add_iff, Hx, Hs; intuition. Qed. #[global] Instance remove_m : Proper (E.eq==>Equal==>Equal) remove. Proof. intros x x' Hx s s' Hs a. rewrite !remove_iff, Hx, Hs; intuition. Qed. #[global] Instance union_m : Proper (Equal==>Equal==>Equal) union. Proof. intros s1 s1' Hs1 s2 s2' Hs2 a. rewrite !union_iff, Hs1, Hs2; intuition. Qed. #[global] Instance inter_m : Proper (Equal==>Equal==>Equal) inter. Proof. intros s1 s1' Hs1 s2 s2' Hs2 a. rewrite !inter_iff, Hs1, Hs2; intuition. Qed. #[global] Instance diff_m : Proper (Equal==>Equal==>Equal) diff. Proof. intros s1 s1' Hs1 s2 s2' Hs2 a. rewrite !diff_iff, Hs1, Hs2; intuition. Qed. #[global] Instance Subset_m : Proper (Equal==>Equal==>iff) Subset. Proof. unfold Equal, Subset; firstorder. Qed. #[global] Instance subset_m : Proper (Equal==>Equal==>Logic.eq) subset. Proof. intros s1 s1' Hs1 s2 s2' Hs2. generalize (subset_iff s1 s2). rewrite Hs1, Hs2 at 1. rewrite subset_iff. destruct (subset s1 s2); destruct (subset s1' s2'); intuition. Qed. #[global] Instance equal_m : Proper (Equal==>Equal==>Logic.eq) equal. Proof. intros s1 s1' Hs1 s2 s2' Hs2. generalize (equal_iff s1 s2). rewrite Hs1,Hs2 at 1. rewrite equal_iff. destruct (equal s1 s2); destruct (equal s1' s2'); intuition. Qed. #[global] Instance SubsetSetoid : PreOrder Subset. (* reflexive + transitive *) Proof. firstorder. Qed. Definition Subset_refl := @PreOrder_Reflexive _ _ SubsetSetoid. Definition Subset_trans := @PreOrder_Transitive _ _ SubsetSetoid. #[global] Instance In_s_m : Morphisms.Proper (E.eq ==> Subset ++> impl) In | 1. Proof. simpl_relation. eauto with set. Qed. #[global] Instance Empty_s_m : Proper (Subset-->impl) Empty. Proof. firstorder. Qed. #[global] Instance add_s_m : Proper (E.eq==>Subset++>Subset) add. Proof. intros x x' Hx s s' Hs a. rewrite !add_iff, Hx; intuition. Qed. #[global] Instance remove_s_m : Proper (E.eq==>Subset++>Subset) remove. Proof. intros x x' Hx s s' Hs a. rewrite !remove_iff, Hx; intuition. Qed. #[global] Instance union_s_m : Proper (Subset++>Subset++>Subset) union. Proof. intros s1 s1' Hs1 s2 s2' Hs2 a. rewrite !union_iff, Hs1, Hs2; intuition. Qed. #[global] Instance inter_s_m : Proper (Subset++>Subset++>Subset) inter. Proof. intros s1 s1' Hs1 s2 s2' Hs2 a. rewrite !inter_iff, Hs1, Hs2; intuition. Qed. #[global] Instance diff_s_m : Proper (Subset++>Subset-->Subset) diff. Proof. intros s1 s1' Hs1 s2 s2' Hs2 a. rewrite !diff_iff, Hs1, Hs2; intuition. Qed. (* [fold], [filter], [for_all], [exists_] and [partition] requires some knowledge on [f] in order to be known as morphisms. *) Generalizable Variables f. #[global] Instance filter_equal : forall `(Proper _ (E.eq==>Logic.eq) f), Proper (Equal==>Equal) (filter f). Proof. intros f Hf s s' Hs a. rewrite !filter_iff, Hs by auto; intuition. Qed. #[global] Instance filter_subset : forall `(Proper _ (E.eq==>Logic.eq) f), Proper (Subset==>Subset) (filter f). Proof. intros f Hf s s' Hs a. rewrite !filter_iff, Hs by auto; intuition. Qed. Lemma filter_ext : forall f f', Proper (E.eq==>Logic.eq) f -> (forall x, f x = f' x) -> forall s s', s[=]s' -> filter f s [=] filter f' s'. Proof. intros f f' Hf Hff' s s' Hss' x. rewrite 2 filter_iff; auto. - rewrite Hff', Hss'; intuition. - red; red; intros; rewrite <- 2 Hff'; auto. Qed. (* For [elements], [min_elt], [max_elt] and [choose], we would need setoid structures on [list elt] and [option elt]. *) (* Later: Add Morphism cardinal ; cardinal_m. *) End WFactsOn. (** Now comes variants for self-contained weak sets and for full sets. For these variants, only one argument is necessary. Thanks to the subtyping [WS<=S], the [Facts] functor which is meant to be used on modules [(M:S)] can simply be an alias of [WFacts]. *) Module WFacts (M:WSets) := WFactsOn M.E M. Module Facts := WFacts. coq-8.20.0/theories/MSets/MSetGenTree.v000066400000000000000000001003171466560755400175750ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* tree -> X.t -> tree -> tree. (** ** The empty set and emptyness test *) Definition empty := Leaf. Definition is_empty t := match t with | Leaf => true | _ => false end. (** ** Membership test *) (** The [mem] function is deciding membership. It exploits the binary search tree invariant to achieve logarithmic complexity. *) Fixpoint mem x t := match t with | Leaf => false | Node _ l k r => match X.compare x k with | Lt => mem x l | Eq => true | Gt => mem x r end end. (** ** Minimal, maximal, arbitrary elements *) Fixpoint min_elt (t : tree) : option elt := match t with | Leaf => None | Node _ Leaf x r => Some x | Node _ l x r => min_elt l end. Fixpoint max_elt (t : tree) : option elt := match t with | Leaf => None | Node _ l x Leaf => Some x | Node _ l x r => max_elt r end. Definition choose := min_elt. (** ** Iteration on elements *) Fixpoint fold {A: Type} (f: elt -> A -> A) (t: tree) (base: A) : A := match t with | Leaf => base | Node _ l x r => fold f r (f x (fold f l base)) end. Fixpoint elements_aux acc s := match s with | Leaf => acc | Node _ l x r => elements_aux (x :: elements_aux acc r) l end. Definition elements := elements_aux nil. Fixpoint rev_elements_aux acc s := match s with | Leaf => acc | Node _ l x r => rev_elements_aux (x :: rev_elements_aux acc l) r end. Definition rev_elements := rev_elements_aux nil. Fixpoint cardinal (s : tree) : nat := match s with | Leaf => 0 | Node _ l _ r => S (cardinal l + cardinal r) end. Fixpoint maxdepth s := match s with | Leaf => 0 | Node _ l _ r => S (max (maxdepth l) (maxdepth r)) end. Fixpoint mindepth s := match s with | Leaf => 0 | Node _ l _ r => S (min (mindepth l) (mindepth r)) end. (** ** Testing universal or existential properties. *) (** We do not use the standard boolean operators of Coq, but lazy ones. *) Fixpoint for_all (f:elt->bool) s := match s with | Leaf => true | Node _ l x r => f x &&& for_all f l &&& for_all f r end. Fixpoint exists_ (f:elt->bool) s := match s with | Leaf => false | Node _ l x r => f x ||| exists_ f l ||| exists_ f r end. (** ** Comparison of trees *) (** The algorithm here has been suggested by Xavier Leroy, and transformed into c.p.s. by Benjamin Grégoire. The original ocaml code (with non-structural recursive calls) has also been formalized (thanks to Function+measure), see [ocaml_compare] in [MSetFullAVL]. The following code with continuations computes dramatically faster in Coq, and should be almost as efficient after extraction. *) (** Enumeration of the elements of a tree. This corresponds to the "samefringe" notion in the literature. *) Inductive enumeration := | End : enumeration | More : elt -> tree -> enumeration -> enumeration. (** [cons t e] adds the elements of tree [t] on the head of enumeration [e]. *) Fixpoint cons s e : enumeration := match s with | Leaf => e | Node _ l x r => cons l (More x r e) end. (** One step of comparison of elements *) Definition compare_more x1 (cont:enumeration->comparison) e2 := match e2 with | End => Gt | More x2 r2 e2 => match X.compare x1 x2 with | Eq => cont (cons r2 e2) | Lt => Lt | Gt => Gt end end. (** Comparison of left tree, middle element, then right tree *) Fixpoint compare_cont s1 (cont:enumeration->comparison) e2 := match s1 with | Leaf => cont e2 | Node _ l1 x1 r1 => compare_cont l1 (compare_more x1 (compare_cont r1 cont)) e2 end. (** Initial continuation *) Definition compare_end e2 := match e2 with End => Eq | _ => Lt end. (** The complete comparison *) Definition compare s1 s2 := compare_cont s1 compare_end (cons s2 End). Definition equal s1 s2 := match compare s1 s2 with Eq => true | _ => false end. (** ** Subset test *) (** In ocaml, recursive calls are made on "half-trees" such as (Node _ l1 x1 Leaf) and (Node _ Leaf x1 r1). Instead of these non-structural calls, we propose here two specialized functions for these situations. This version should be almost as efficient as the one of ocaml (closures as arguments may slow things a bit), it is simply less compact. The exact ocaml version has also been formalized (thanks to Function+measure), see [ocaml_subset] in [MSetFullAVL]. *) Fixpoint subsetl (subset_l1 : tree -> bool) x1 s2 : bool := match s2 with | Leaf => false | Node _ l2 x2 r2 => match X.compare x1 x2 with | Eq => subset_l1 l2 | Lt => subsetl subset_l1 x1 l2 | Gt => mem x1 r2 &&& subset_l1 s2 end end. Fixpoint subsetr (subset_r1 : tree -> bool) x1 s2 : bool := match s2 with | Leaf => false | Node _ l2 x2 r2 => match X.compare x1 x2 with | Eq => subset_r1 r2 | Lt => mem x1 l2 &&& subset_r1 s2 | Gt => subsetr subset_r1 x1 r2 end end. Fixpoint subset s1 s2 : bool := match s1, s2 with | Leaf, _ => true | Node _ _ _ _, Leaf => false | Node _ l1 x1 r1, Node _ l2 x2 r2 => match X.compare x1 x2 with | Eq => subset l1 l2 &&& subset r1 r2 | Lt => subsetl (subset l1) x1 l2 &&& subset r1 s2 | Gt => subsetr (subset r1) x1 r2 &&& subset l1 s2 end end. End Ops. (** * Props : correctness proofs of these generic operations *) Module Type Props (X:OrderedType)(Info:InfoTyp)(Import M:Ops X Info). (** ** Occurrence in a tree *) Inductive InT (x : elt) : tree -> Prop := | IsRoot : forall c l r y, X.eq x y -> InT x (Node c l y r) | InLeft : forall c l r y, InT x l -> InT x (Node c l y r) | InRight : forall c l r y, InT x r -> InT x (Node c l y r). Definition In := InT. (** ** Some shortcuts *) Definition Equal s s' := forall a : elt, InT a s <-> InT a s'. Definition Subset s s' := forall a : elt, InT a s -> InT a s'. Definition Empty s := forall a : elt, ~ InT a s. Definition For_all (P : elt -> Prop) s := forall x, InT x s -> P x. Definition Exists (P : elt -> Prop) s := exists x, InT x s /\ P x. (** ** Binary search trees *) (** [lt_tree x s]: all elements in [s] are smaller than [x] (resp. greater for [gt_tree]) *) Definition lt_tree x s := forall y, InT y s -> X.lt y x. Definition gt_tree x s := forall y, InT y s -> X.lt x y. (** [bst t] : [t] is a binary search tree *) Inductive bst : tree -> Prop := | BSLeaf : bst Leaf | BSNode : forall c x l r, bst l -> bst r -> lt_tree x l -> gt_tree x r -> bst (Node c l x r). (** [bst] is the (decidable) invariant our trees will have to satisfy. *) Definition IsOk := bst. Class Ok (s:tree) : Prop := ok : bst s. #[global] Instance bst_Ok s (Hs : bst s) : Ok s := { ok := Hs }. Fixpoint ltb_tree x s := match s with | Leaf => true | Node _ l y r => match X.compare x y with | Gt => ltb_tree x l && ltb_tree x r | _ => false end end. Fixpoint gtb_tree x s := match s with | Leaf => true | Node _ l y r => match X.compare x y with | Lt => gtb_tree x l && gtb_tree x r | _ => false end end. Fixpoint isok s := match s with | Leaf => true | Node _ l x r => isok l && isok r && ltb_tree x l && gtb_tree x r end. (** ** Known facts about ordered types *) Module Import MX := OrderedTypeFacts X. (** ** Automation and dedicated tactics *) Scheme tree_ind := Induction for tree Sort Prop. Scheme bst_ind := Induction for bst Sort Prop. Local Hint Resolve MX.eq_refl MX.eq_trans MX.lt_trans ok : core. Local Hint Immediate MX.eq_sym : core. Local Hint Unfold In lt_tree gt_tree : core. Local Hint Constructors InT bst : core. Local Hint Unfold Ok : core. (** Automatic treatment of [Ok] hypothesis *) Ltac clear_inversion H := inversion H; clear H; subst. Ltac inv_ok := match goal with | H:Ok (Node _ _ _ _) |- _ => clear_inversion H; inv_ok | H:Ok Leaf |- _ => clear H; inv_ok | H:bst ?x |- _ => change (Ok x) in H; inv_ok | _ => idtac end. (** A tactic to repeat [inversion_clear] on all hyps of the form [(f (Node _ _ _ _))] *) Ltac is_tree_constr c := match c with | Leaf => idtac | Node _ _ _ _ => idtac | _ => fail end. Ltac invtree f := match goal with | H:f ?s |- _ => is_tree_constr s; clear_inversion H; invtree f | H:f _ ?s |- _ => is_tree_constr s; clear_inversion H; invtree f | H:f _ _ ?s |- _ => is_tree_constr s; clear_inversion H; invtree f | _ => idtac end. Ltac inv := inv_ok; invtree InT. Ltac intuition_in := repeat (intuition auto; inv). (** Helper tactic concerning order of elements. *) Ltac order := match goal with | U: lt_tree _ ?s, V: InT _ ?s |- _ => generalize (U _ V); clear U; order | U: gt_tree _ ?s, V: InT _ ?s |- _ => generalize (U _ V); clear U; order | _ => MX.order end. (** [isok] is indeed a decision procedure for [Ok] *) Lemma ltb_tree_iff : forall x s, lt_tree x s <-> ltb_tree x s = true. Proof. induction s as [|c l IHl y r IHr]; simpl. - unfold lt_tree; intuition_in. - elim_compare x y. + split; intros; try discriminate. assert (X.lt y x) by auto. order. + split; intros; try discriminate. assert (X.lt y x) by auto. order. + rewrite !andb_true_iff, <-IHl, <-IHr. unfold lt_tree; intuition_in; order. Qed. Lemma gtb_tree_iff : forall x s, gt_tree x s <-> gtb_tree x s = true. Proof. induction s as [|c l IHl y r IHr]; simpl. - unfold gt_tree; intuition_in. - elim_compare x y. + split; intros; try discriminate. assert (X.lt x y) by auto. order. + rewrite !andb_true_iff, <-IHl, <-IHr. unfold gt_tree; intuition_in; order. + split; intros; try discriminate. assert (X.lt x y) by auto. order. Qed. Lemma isok_iff : forall s, Ok s <-> isok s = true. Proof. induction s as [|c l IHl y r IHr]; simpl. - intuition_in. - rewrite !andb_true_iff, <- IHl, <-IHr, <- ltb_tree_iff, <- gtb_tree_iff. intuition_in. Qed. #[global] Instance isok_Ok s : isok s = true -> Ok s | 10. Proof. intros; apply <- isok_iff; auto. Qed. (** ** Basic results about [In] *) Lemma In_1 : forall s x y, X.eq x y -> InT x s -> InT y s. Proof. induction s; simpl; intuition_in; eauto. Qed. Local Hint Immediate In_1 : core. #[global] Instance In_compat : Proper (X.eq==>eq==>iff) InT. Proof. apply proper_sym_impl_iff_2; auto with *. repeat red; intros; subst. apply In_1 with x; auto. Qed. Lemma In_node_iff : forall c l x r y, InT y (Node c l x r) <-> InT y l \/ X.eq y x \/ InT y r. Proof. intuition_in. Qed. Lemma In_leaf_iff : forall x, InT x Leaf <-> False. Proof. intuition_in. Qed. (** Results about [lt_tree] and [gt_tree] *) Lemma lt_leaf : forall x : elt, lt_tree x Leaf. Proof. red; inversion 1. Qed. Lemma gt_leaf : forall x : elt, gt_tree x Leaf. Proof. red; inversion 1. Qed. Lemma lt_tree_node : forall (x y : elt) (l r : tree) (i : Info.t), lt_tree x l -> lt_tree x r -> X.lt y x -> lt_tree x (Node i l y r). Proof. unfold lt_tree; intuition_in; order. Qed. Lemma gt_tree_node : forall (x y : elt) (l r : tree) (i : Info.t), gt_tree x l -> gt_tree x r -> X.lt x y -> gt_tree x (Node i l y r). Proof. unfold gt_tree; intuition_in; order. Qed. Local Hint Resolve lt_leaf gt_leaf lt_tree_node gt_tree_node : core. Lemma lt_tree_not_in : forall (x : elt) (t : tree), lt_tree x t -> ~ InT x t. Proof. intros; intro; order. Qed. Lemma lt_tree_trans : forall x y, X.lt x y -> forall t, lt_tree x t -> lt_tree y t. Proof. eauto. Qed. Lemma gt_tree_not_in : forall (x : elt) (t : tree), gt_tree x t -> ~ InT x t. Proof. intros; intro; order. Qed. Lemma gt_tree_trans : forall x y, X.lt y x -> forall t, gt_tree x t -> gt_tree y t. Proof. eauto. Qed. #[global] Instance lt_tree_compat : Proper (X.eq ==> Logic.eq ==> iff) lt_tree. Proof. apply proper_sym_impl_iff_2; auto. intros x x' Hx s s' Hs H y Hy. subst. setoid_rewrite <- Hx; auto. Qed. #[global] Instance gt_tree_compat : Proper (X.eq ==> Logic.eq ==> iff) gt_tree. Proof. apply proper_sym_impl_iff_2; auto. intros x x' Hx s s' Hs H y Hy. subst. setoid_rewrite <- Hx; auto. Qed. Local Hint Resolve lt_tree_not_in lt_tree_trans gt_tree_not_in gt_tree_trans : core. Ltac induct s x := induction s as [|i l IHl x' r IHr]; simpl; intros; [|elim_compare x x'; intros; inv]. Ltac auto_tc := auto with typeclass_instances. Ltac ok := inv; change bst with Ok in *; match goal with | |- Ok (Node _ _ _ _) => constructor; auto_tc; ok | |- lt_tree _ (Node _ _ _ _) => apply lt_tree_node; ok | |- gt_tree _ (Node _ _ _ _) => apply gt_tree_node; ok | _ => eauto with typeclass_instances end. (** ** Empty set *) Lemma empty_spec : Empty empty. Proof. intros x H. inversion H. Qed. #[global] Instance empty_ok : Ok empty. Proof. auto. Qed. (** ** Emptyness test *) Lemma is_empty_spec : forall s, is_empty s = true <-> Empty s. Proof. destruct s as [|c r x l]; simpl; auto. - split; auto. intros _ x H. inv. - split; auto. + try discriminate. + intro H; elim (H x); auto. Qed. (** ** Membership *) Lemma mem_spec : forall s x `{Ok s}, mem x s = true <-> InT x s. Proof. split. - induct s x; now auto. - induct s x; intuition_in; order. Qed. (** ** Minimal and maximal elements *) Lemma min_elt_spec1 s x : min_elt s = Some x -> InT x s. Proof. induction s as [|t1 [|] IHs1 y s2 IHs2]; simpl; auto; inversion 1; auto. Qed. Lemma min_elt_spec2 s x y `{Ok s} : min_elt s = Some x -> InT y s -> ~ X.lt y x. Proof. revert x y; induction H as [|? z l r Hl IHl Hr IHr Hlt Hgt]; simpl in *; [discriminate|]. intros x y He Hi; apply In_node_iff in Hi. destruct l as [|t l1 w l2]. + intros; replace z with x in * by congruence. destruct Hi as [Hi|[Hi|Hi]]; try order. apply In_leaf_iff in Hi; contradiction. + destruct Hi as [Hi|[Hi|Hi]]. - apply IHl; assumption. - intros H; eapply lt_tree_trans in Hlt; [|rewrite <- Hi; eassumption]. apply min_elt_spec1 in He; apply lt_tree_not_in in Hlt; contradiction. - intros H. apply min_elt_spec1, Hlt in He. elim (gt_tree_not_in y r); [|assumption]. eapply gt_tree_trans; [|exact Hgt]; order. Qed. Lemma min_elt_spec3 s : min_elt s = None -> Empty s. Proof. induction s as [|t1 s1 IHs1 x s2 IHs2]; simpl in *; intros H. + inversion 1. + destruct s1 as [|? ? y]; [congruence|]. destruct (IHs1 H y); auto. Qed. Lemma max_elt_spec1 s x : max_elt s = Some x -> InT x s. Proof. induction s as [|t1 s1 IHs1 y [|] IHs2]; simpl in *; intros H; [congruence| |auto]. replace y with x by congruence; auto. Qed. Lemma max_elt_spec2 s x y `{Ok s} : max_elt s = Some x -> InT y s -> ~ X.lt x y. Proof. revert x y; induction H as [|? z l r Hl IHl Hr IHr Hlt Hgt]; simpl in *; [discriminate|]. intros x y He Hi; apply In_node_iff in Hi. destruct r as [|t l1 w l2]. + intros; replace z with x in * by congruence. destruct Hi as [Hi|[Hi|Hi]]; try order. apply In_leaf_iff in Hi; contradiction. + destruct Hi as [Hi|[Hi|Hi]]. - intros H. apply max_elt_spec1, Hgt in He. elim (lt_tree_not_in y l); [|assumption]. eapply lt_tree_trans; [|exact Hlt]; order. - intros H; eapply gt_tree_trans in Hgt; [|rewrite <- Hi; eassumption]. apply max_elt_spec1 in He; apply gt_tree_not_in in Hgt; contradiction. - apply IHr; assumption. Qed. Lemma max_elt_spec3 s : max_elt s = None -> Empty s. Proof. induction s as [|t1 s1 IHs1 x s2 IHs2]; simpl in *; intros H. + inversion 1. + destruct s2 as [|? ? y]; [congruence|]. destruct (IHs2 H y); auto. Qed. Lemma choose_spec1 : forall s x, choose s = Some x -> InT x s. Proof. exact min_elt_spec1. Qed. Lemma choose_spec2 : forall s, choose s = None -> Empty s. Proof. exact min_elt_spec3. Qed. Lemma choose_spec3 : forall s s' x x' `{Ok s, Ok s'}, choose s = Some x -> choose s' = Some x' -> Equal s s' -> X.eq x x'. Proof. unfold choose, Equal; intros s s' x x' Hb Hb' Hx Hx' H. assert (~X.lt x x'). { apply min_elt_spec2 with s'; auto. rewrite <-H; auto using min_elt_spec1. } assert (~X.lt x' x). { apply min_elt_spec2 with s; auto. rewrite H; auto using min_elt_spec1. } elim_compare x x'; intuition. Qed. (** ** Elements *) Lemma elements_spec1' : forall s acc x, InA X.eq x (elements_aux acc s) <-> InT x s \/ InA X.eq x acc. Proof. induction s as [ | c l Hl x r Hr ]; simpl; auto. - intuition. inversion H0. - intros. rewrite Hl. destruct (Hr acc x0); clear Hl Hr. intuition; inversion_clear H3; intuition. Qed. Lemma elements_spec1 : forall s x, InA X.eq x (elements s) <-> InT x s. Proof. intros; generalize (elements_spec1' s nil x); intuition. inversion_clear H0. Qed. Lemma elements_spec2' : forall s acc `{Ok s}, sort X.lt acc -> (forall x y : elt, InA X.eq x acc -> InT y s -> X.lt y x) -> sort X.lt (elements_aux acc s). Proof. induction s as [ | c l Hl y r Hr]; simpl; intuition. inv. apply Hl; auto. - constructor. + apply Hr; auto. + eapply InA_InfA; eauto with *. intros. destruct (elements_spec1' r acc y0); intuition. - intros. inversion_clear H. + order. + destruct (elements_spec1' r acc x); intuition eauto. Qed. Lemma elements_spec2 : forall s `(Ok s), sort X.lt (elements s). Proof. intros; unfold elements; apply elements_spec2'; auto. intros; inversion H0. Qed. Local Hint Resolve elements_spec2 : core. Lemma elements_spec2w : forall s `(Ok s), NoDupA X.eq (elements s). Proof. intros. eapply SortA_NoDupA; eauto with *. Qed. Lemma elements_aux_cardinal : forall s acc, (length acc + cardinal s)%nat = length (elements_aux acc s). Proof. simple induction s; simpl; intuition. rewrite <- H. simpl. rewrite <- H0. rewrite (Nat.add_comm (cardinal t0)). now rewrite <- Nat.add_succ_r, Nat.add_assoc. Qed. Lemma elements_cardinal : forall s : tree, cardinal s = length (elements s). Proof. exact (fun s => elements_aux_cardinal s nil). Qed. Definition cardinal_spec (s:tree)(Hs:Ok s) := elements_cardinal s. Lemma elements_app : forall s acc, elements_aux acc s = elements s ++ acc. Proof. induction s; simpl; intros; auto. rewrite IHs1, IHs2. unfold elements; simpl. rewrite 2 IHs1, IHs2, !app_nil_r, <- !app_assoc; auto. Qed. Lemma elements_node c l x r : elements (Node c l x r) = elements l ++ x :: elements r. Proof. unfold elements; simpl. now rewrite !elements_app, !app_nil_r. Qed. Lemma rev_elements_app : forall s acc, rev_elements_aux acc s = rev_elements s ++ acc. Proof. induction s; simpl; intros; auto. rewrite IHs1, IHs2. unfold rev_elements; simpl. rewrite IHs1, 2 IHs2, !app_nil_r, <- !app_assoc; auto. Qed. Lemma rev_elements_node c l x r : rev_elements (Node c l x r) = rev_elements r ++ x :: rev_elements l. Proof. unfold rev_elements; simpl. now rewrite !rev_elements_app, !app_nil_r. Qed. Lemma rev_elements_rev s : rev_elements s = rev (elements s). Proof. induction s as [|c l IHl x r IHr]; trivial. rewrite elements_node, rev_elements_node, IHl, IHr, rev_app_distr. simpl. now rewrite <- !app_assoc. Qed. (** The converse of [elements_spec2], used in MSetRBT *) (* TODO: TO MIGRATE ELSEWHERE... *) Lemma sorted_app_inv l1 l2 : sort X.lt (l1++l2) -> sort X.lt l1 /\ sort X.lt l2 /\ forall x1 x2, InA X.eq x1 l1 -> InA X.eq x2 l2 -> X.lt x1 x2. Proof. induction l1 as [|a1 l1 IHl1]. - simpl; repeat split; auto. intros. now rewrite InA_nil in *. - simpl. inversion_clear 1 as [ | ? ? Hs Hhd ]. destruct (IHl1 Hs) as (H1 & H2 & H3). repeat split. * constructor; auto. destruct l1; simpl in *; auto; inversion_clear Hhd; auto. * trivial. * intros x1 x2 Hx1 Hx2. rewrite InA_cons in Hx1. destruct Hx1. + rewrite H. apply SortA_InfA_InA with (eqA:=X.eq)(l:=l1++l2); auto_tc. rewrite InA_app_iff; auto_tc. + auto. Qed. Lemma elements_sort_ok s : sort X.lt (elements s) -> Ok s. Proof. induction s as [|c l IHl x r IHr]. - auto. - rewrite elements_node. intros H. destruct (sorted_app_inv _ _ H) as (H1 & H2 & H3). inversion_clear H2. constructor; ok. * intros y Hy. apply H3. + now rewrite elements_spec1. + rewrite InA_cons. now left. * intros y Hy. apply SortA_InfA_InA with (eqA:=X.eq)(l:=elements r); auto_tc. now rewrite elements_spec1. Qed. (** ** [for_all] and [exists] *) Lemma for_all_spec s f : Proper (X.eq==>eq) f -> (for_all f s = true <-> For_all (fun x => f x = true) s). Proof. intros Hf; unfold For_all. induction s as [|i l IHl x r IHr]; simpl; auto. - split; intros; inv; auto. - rewrite <- !andb_lazy_alt, !andb_true_iff, IHl, IHr. clear IHl IHr. intuition_in. eauto. Qed. Lemma exists_spec s f : Proper (X.eq==>eq) f -> (exists_ f s = true <-> Exists (fun x => f x = true) s). Proof. intros Hf; unfold Exists. induction s as [|i l IHl x r IHr]; simpl; auto. - split. * discriminate. * intros (y,(H,_)); inv. - rewrite <- !orb_lazy_alt, !orb_true_iff, IHl, IHr. clear IHl IHr. split; [intros [[H|(y,(H,H'))]|(y,(H,H'))]|intros (y,(H,H'))]. * exists x; auto. * exists y; auto. * exists y; auto. * inv; [left;left|left;right|right]; try (exists y); eauto. Qed. (** ** Fold *) Lemma fold_spec' {A} (f : elt -> A -> A) (s : tree) (i : A) (acc : list elt) : fold_left (flip f) (elements_aux acc s) i = fold_left (flip f) acc (fold f s i). Proof. revert i acc. induction s as [|c l IHl x r IHr]; simpl; intros; auto. rewrite IHl. simpl. unfold flip at 2. apply IHr. Qed. Lemma fold_spec (s:tree) {A} (i : A) (f : elt -> A -> A) : fold f s i = fold_left (flip f) (elements s) i. Proof. revert i. unfold elements. induction s as [|c l IHl x r IHr]; simpl; intros; auto. rewrite fold_spec'. rewrite IHr. simpl; auto. Qed. (** ** Subset *) Lemma subsetl_spec : forall subset_l1 l1 x1 c1 s2 `{Ok (Node c1 l1 x1 Leaf), Ok s2}, (forall s `{Ok s}, (subset_l1 s = true <-> Subset l1 s)) -> (subsetl subset_l1 x1 s2 = true <-> Subset (Node c1 l1 x1 Leaf) s2 ). Proof. induction s2 as [|c2 l2 IHl2 x2 r2 IHr2]; simpl; intros. - unfold Subset; intuition; try discriminate. assert (H': InT x1 Leaf) by auto; inversion H'. - specialize (IHl2 H). specialize (IHr2 H). inv. elim_compare x1 x2. + rewrite H1 by auto; clear H1 IHl2 IHr2. unfold Subset. intuition_in. * assert (X.eq a x2) by order; intuition_in. * assert (InT a (Node c2 l2 x2 r2)) by auto; intuition_in; order. + rewrite IHl2 by auto; clear H1 IHl2 IHr2. unfold Subset. intuition_in. * assert (InT a (Node c2 l2 x2 r2)) by auto; intuition_in; order. * assert (InT a (Node c2 l2 x2 r2)) by auto; intuition_in; order. + rewrite <-andb_lazy_alt, andb_true_iff, H1 by auto; clear H1 IHl2 IHr2. unfold Subset. intuition_in. * constructor 3. setoid_replace a with x1; auto. rewrite <- mem_spec; auto. * rewrite mem_spec; auto. assert (InT x1 (Node c2 l2 x2 r2)) by auto; intuition_in; order. Qed. Lemma subsetr_spec : forall subset_r1 r1 x1 c1 s2, bst (Node c1 Leaf x1 r1) -> bst s2 -> (forall s, bst s -> (subset_r1 s = true <-> Subset r1 s)) -> (subsetr subset_r1 x1 s2 = true <-> Subset (Node c1 Leaf x1 r1) s2). Proof. induction s2 as [|c2 l2 IHl2 x2 r2 IHr2]; simpl; intros. - unfold Subset; intuition; try discriminate. assert (H': InT x1 Leaf) by auto; inversion H'. - specialize (IHl2 H). specialize (IHr2 H). inv. elim_compare x1 x2. + rewrite H1 by auto; clear H1 IHl2 IHr2. unfold Subset. intuition_in. * assert (X.eq a x2) by order; intuition_in. * assert (InT a (Node c2 l2 x2 r2)) by auto; intuition_in; order. + rewrite <-andb_lazy_alt, andb_true_iff, H1 by auto; clear H1 IHl2 IHr2. unfold Subset. intuition_in. * constructor 2. setoid_replace a with x1; auto. rewrite <- mem_spec; auto. * rewrite mem_spec; auto. assert (InT x1 (Node c2 l2 x2 r2)) by auto; intuition_in; order. + rewrite IHr2 by auto; clear H1 IHl2 IHr2. unfold Subset. intuition_in. * assert (InT a (Node c2 l2 x2 r2)) by auto; intuition_in; order. * assert (InT a (Node c2 l2 x2 r2)) by auto; intuition_in; order. Qed. Lemma subset_spec : forall s1 s2 `{Ok s1, Ok s2}, (subset s1 s2 = true <-> Subset s1 s2). Proof. induction s1 as [|c1 l1 IHl1 x1 r1 IHr1]; simpl; intros. - unfold Subset; intuition_in. - destruct s2 as [|c2 l2 x2 r2]; simpl; intros. + unfold Subset; intuition_in; try discriminate. assert (H': InT x1 Leaf) by auto; inversion H'. + inv. elim_compare x1 x2. * rewrite <-andb_lazy_alt, andb_true_iff, IHl1, IHr1 by auto. clear IHl1 IHr1. unfold Subset; intuition_in. -- assert (X.eq a x2) by order; intuition_in. -- assert (InT a (Node c2 l2 x2 r2)) by auto; intuition_in; order. -- assert (InT a (Node c2 l2 x2 r2)) by auto; intuition_in; order. * rewrite <-andb_lazy_alt, andb_true_iff, IHr1 by auto. rewrite (@subsetl_spec (subset l1) l1 x1 c1) by auto. clear IHl1 IHr1. unfold Subset; intuition_in. -- assert (InT a (Node c2 l2 x2 r2)) by auto; intuition_in; order. -- assert (InT a (Node c2 l2 x2 r2)) by auto; intuition_in; order. * rewrite <-andb_lazy_alt, andb_true_iff, IHl1 by auto. rewrite (@subsetr_spec (subset r1) r1 x1 c1) by auto. clear IHl1 IHr1. unfold Subset; intuition_in. -- assert (InT a (Node c2 l2 x2 r2)) by auto; intuition_in; order. -- assert (InT a (Node c2 l2 x2 r2)) by auto; intuition_in; order. Qed. (** ** Comparison *) (** Relations [eq] and [lt] over trees *) Module L := MSetInterface.MakeListOrdering X. Definition eq := Equal. #[global] Instance eq_equiv : Equivalence eq. Proof. firstorder. Qed. Lemma eq_Leq : forall s s', eq s s' <-> L.eq (elements s) (elements s'). Proof. unfold eq, Equal, L.eq; intros. setoid_rewrite elements_spec1. firstorder. Qed. Definition lt (s1 s2 : tree) : Prop := exists s1' s2', Ok s1' /\ Ok s2' /\ eq s1 s1' /\ eq s2 s2' /\ L.lt (elements s1') (elements s2'). Declare Equivalent Keys L.eq equivlistA. #[global] Instance lt_strorder : StrictOrder lt. Proof. split. - intros s (s1 & s2 & B1 & B2 & E1 & E2 & L). assert (eqlistA X.eq (elements s1) (elements s2)). + apply SortA_equivlistA_eqlistA with (ltA:=X.lt); auto with *. rewrite <- eq_Leq. transitivity s; auto. symmetry; auto. + rewrite H in L. apply (StrictOrder_Irreflexive (elements s2)); auto. - intros s1 s2 s3 (s1' & s2' & B1 & B2 & E1 & E2 & L12) (s2'' & s3' & B2' & B3 & E2' & E3 & L23). exists s1', s3'; do 4 (split; trivial). assert (eqlistA X.eq (elements s2') (elements s2'')). + apply SortA_equivlistA_eqlistA with (ltA:=X.lt); auto with *. rewrite <- eq_Leq. transitivity s2; auto. symmetry; auto. + transitivity (elements s2'); auto. rewrite H; auto. Qed. #[global] Instance lt_compat : Proper (eq==>eq==>iff) lt. Proof. intros s1 s2 E12 s3 s4 E34. split. - intros (s1' & s3' & B1 & B3 & E1 & E3 & LT). exists s1', s3'; do 2 (split; trivial). split. + transitivity s1; auto. symmetry; auto. + split; auto. transitivity s3; auto. symmetry; auto. - intros (s1' & s3' & B1 & B3 & E1 & E3 & LT). exists s1', s3'; do 2 (split; trivial). split. + transitivity s2; auto. + split; auto. transitivity s4; auto. Qed. (** Proof of the comparison algorithm *) (** [flatten_e e] returns the list of elements of [e] i.e. the list of elements actually compared *) Fixpoint flatten_e (e : enumeration) : list elt := match e with | End => nil | More x t r => x :: elements t ++ flatten_e r end. Lemma flatten_e_elements : forall l x r c e, elements l ++ flatten_e (More x r e) = elements (Node c l x r) ++ flatten_e e. Proof. intros. now rewrite elements_node, <- app_assoc. Qed. Lemma cons_1 : forall s e, flatten_e (cons s e) = elements s ++ flatten_e e. Proof. induction s; simpl; auto; intros. rewrite IHs1; apply flatten_e_elements. Qed. (** Correctness of this comparison *) Definition Cmp c x y := CompSpec L.eq L.lt x y c. Local Hint Unfold Cmp flip : core. Lemma compare_end_Cmp : forall e2, Cmp (compare_end e2) nil (flatten_e e2). Proof. destruct e2; simpl; constructor; auto. reflexivity. Qed. Lemma compare_more_Cmp : forall x1 cont x2 r2 e2 l, Cmp (cont (cons r2 e2)) l (elements r2 ++ flatten_e e2) -> Cmp (compare_more x1 cont (More x2 r2 e2)) (x1::l) (flatten_e (More x2 r2 e2)). Proof. simpl; intros; elim_compare x1 x2; simpl; red; auto. Qed. Lemma compare_cont_Cmp : forall s1 cont e2 l, (forall e, Cmp (cont e) l (flatten_e e)) -> Cmp (compare_cont s1 cont e2) (elements s1 ++ l) (flatten_e e2). Proof. induction s1 as [|c1 l1 Hl1 x1 r1 Hr1]; intros; auto. rewrite elements_node, <- app_assoc; simpl. apply Hl1; auto. clear e2. intros [|x2 r2 e2]. - simpl; auto. - apply compare_more_Cmp. rewrite <- cons_1; auto. Qed. Lemma compare_Cmp : forall s1 s2, Cmp (compare s1 s2) (elements s1) (elements s2). Proof. intros; unfold compare. rewrite <- (app_nil_r (elements s1)). replace (elements s2) with (flatten_e (cons s2 End)) by (rewrite cons_1; simpl; rewrite app_nil_r; auto). apply compare_cont_Cmp; auto. intros. apply compare_end_Cmp; auto. Qed. Lemma compare_spec : forall s1 s2 `{Ok s1, Ok s2}, CompSpec eq lt s1 s2 (compare s1 s2). Proof. intros. destruct (compare_Cmp s1 s2); constructor. - rewrite eq_Leq; auto. - intros; exists s1, s2; repeat split; auto. - intros; exists s2, s1; repeat split; auto. Qed. (** ** Equality test *) Lemma equal_spec : forall s1 s2 `{Ok s1, Ok s2}, equal s1 s2 = true <-> eq s1 s2. Proof. unfold equal; intros s1 s2 B1 B2. destruct (@compare_spec s1 s2 B1 B2) as [H|H|H]; split; intros H'; auto; try discriminate. - rewrite H' in H. elim (StrictOrder_Irreflexive s2); auto. - rewrite H' in H. elim (StrictOrder_Irreflexive s2); auto. Qed. (** ** A few results about [mindepth] and [maxdepth] *) Lemma mindepth_maxdepth s : mindepth s <= maxdepth s. Proof. induction s; simpl; auto. rewrite <- Nat.succ_le_mono. transitivity (mindepth s1). - apply Nat.le_min_l. - transitivity (maxdepth s1). + trivial. + apply Nat.le_max_l. Qed. Lemma maxdepth_cardinal s : cardinal s < 2^(maxdepth s). Proof. unfold Peano.lt. induction s as [|c l IHl x r IHr]. - auto. - simpl. rewrite <- Nat.add_succ_r, <- Nat.add_succ_l, Nat.add_0_r. apply Nat.add_le_mono; etransitivity; try apply IHl; try apply IHr; apply Nat.pow_le_mono; auto. * apply Nat.le_max_l. * apply Nat.le_max_r. Qed. Lemma mindepth_cardinal s : 2^(mindepth s) <= S (cardinal s). Proof. unfold Peano.lt. induction s as [|c l IHl x r IHr]. - auto. - simpl. rewrite <- Nat.add_succ_r, <- Nat.add_succ_l, Nat.add_0_r. apply Nat.add_le_mono; etransitivity; try apply IHl; try apply IHr; apply Nat.pow_le_mono; auto. * apply Nat.le_min_l. * apply Nat.le_min_r. Qed. Lemma maxdepth_log_cardinal s : s <> Leaf -> Nat.log2 (cardinal s) < maxdepth s. Proof. intros H. apply Nat.log2_lt_pow2. - destruct s; simpl; intuition auto with arith. - apply maxdepth_cardinal. Qed. Lemma mindepth_log_cardinal s : mindepth s <= Nat.log2 (S (cardinal s)). Proof. apply Nat.log2_le_pow2. - auto with arith. - apply mindepth_cardinal. Qed. End Props. coq-8.20.0/theories/MSets/MSetInterface.v000066400000000000000000001030341466560755400201430ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* bool. (** Test whether a set is empty or not. *) Parameter mem : elt -> t -> bool. (** [mem x s] tests whether [x] belongs to the set [s]. *) Parameter add : elt -> t -> t. (** [add x s] returns a set containing all elements of [s], plus [x]. If [x] was already in [s], [s] is returned unchanged. *) Parameter singleton : elt -> t. (** [singleton x] returns the one-element set containing only [x]. *) Parameter remove : elt -> t -> t. (** [remove x s] returns a set containing all elements of [s], except [x]. If [x] was not in [s], [s] is returned unchanged. *) Parameter union : t -> t -> t. (** Set union. *) Parameter inter : t -> t -> t. (** Set intersection. *) Parameter diff : t -> t -> t. (** Set difference. *) Parameter equal : t -> t -> bool. (** [equal s1 s2] tests whether the sets [s1] and [s2] are equal, that is, contain equal elements. *) Parameter subset : t -> t -> bool. (** [subset s1 s2] tests whether the set [s1] is a subset of the set [s2]. *) Parameter fold : forall A : Type, (elt -> A -> A) -> t -> A -> A. (** [fold f s a] computes [(f xN ... (f x2 (f x1 a))...)], where [x1 ... xN] are the elements of [s]. The order in which elements of [s] are presented to [f] is unspecified. *) Parameter for_all : (elt -> bool) -> t -> bool. (** [for_all p s] checks if all elements of the set satisfy the predicate [p]. *) Parameter exists_ : (elt -> bool) -> t -> bool. (** [exists p s] checks if at least one element of the set satisfies the predicate [p]. *) Parameter filter : (elt -> bool) -> t -> t. (** [filter p s] returns the set of all elements in [s] that satisfy predicate [p]. *) Parameter partition : (elt -> bool) -> t -> t * t. (** [partition p s] returns a pair of sets [(s1, s2)], where [s1] is the set of all the elements of [s] that satisfy the predicate [p], and [s2] is the set of all the elements of [s] that do not satisfy [p]. *) Parameter cardinal : t -> nat. (** Return the number of elements of a set. *) Parameter elements : t -> list elt. (** Return the list of all elements of the given set, in any order. *) Parameter choose : t -> option elt. (** Return one element of the given set, or [None] if the set is empty. Which element is chosen is unspecified. Equal sets could return different elements. *) End HasWOps. Module Type WOps (E : DecidableType). Definition elt := E.t. Parameter t : Type. (** the abstract type of sets *) Include HasWOps. End WOps. (** ** Functorial signature for weak sets Weak sets are sets without ordering on base elements, only a decidable equality. *) Module Type WSetsOn (E : DecidableType). (** First, we ask for all the functions *) Include WOps E. (** Logical predicates *) Parameter In : elt -> t -> Prop. #[global] Declare Instance In_compat : Proper (E.eq==>eq==>iff) In. Definition Equal s s' := forall a : elt, In a s <-> In a s'. Definition Subset s s' := forall a : elt, In a s -> In a s'. Definition Empty s := forall a : elt, ~ In a s. Definition For_all (P : elt -> Prop) s := forall x, In x s -> P x. Definition Exists (P : elt -> Prop) s := exists x, In x s /\ P x. Notation "s [=] t" := (Equal s t) (at level 70, no associativity). Notation "s [<=] t" := (Subset s t) (at level 70, no associativity). Definition eq : t -> t -> Prop := Equal. Include IsEq. (** [eq] is obviously an equivalence, for subtyping only *) Include HasEqDec. (** Specifications of set operators *) Section Spec. Variable s s': t. Variable x y : elt. Variable f : elt -> bool. Notation compatb := (Proper (E.eq==>Logic.eq)) (only parsing). Parameter mem_spec : mem x s = true <-> In x s. Parameter equal_spec : equal s s' = true <-> s[=]s'. Parameter subset_spec : subset s s' = true <-> s[<=]s'. Parameter empty_spec : Empty empty. Parameter is_empty_spec : is_empty s = true <-> Empty s. Parameter add_spec : In y (add x s) <-> E.eq y x \/ In y s. Parameter remove_spec : In y (remove x s) <-> In y s /\ ~E.eq y x. Parameter singleton_spec : In y (singleton x) <-> E.eq y x. Parameter union_spec : In x (union s s') <-> In x s \/ In x s'. Parameter inter_spec : In x (inter s s') <-> In x s /\ In x s'. Parameter diff_spec : In x (diff s s') <-> In x s /\ ~In x s'. Parameter fold_spec : forall (A : Type) (i : A) (f : elt -> A -> A), fold f s i = fold_left (flip f) (elements s) i. Parameter cardinal_spec : cardinal s = length (elements s). Parameter filter_spec : compatb f -> (In x (filter f s) <-> In x s /\ f x = true). Parameter for_all_spec : compatb f -> (for_all f s = true <-> For_all (fun x => f x = true) s). Parameter exists_spec : compatb f -> (exists_ f s = true <-> Exists (fun x => f x = true) s). Parameter partition_spec1 : compatb f -> fst (partition f s) [=] filter f s. Parameter partition_spec2 : compatb f -> snd (partition f s) [=] filter (fun x => negb (f x)) s. Parameter elements_spec1 : InA E.eq x (elements s) <-> In x s. (** When compared with ordered sets, here comes the only property that is really weaker: *) Parameter elements_spec2w : NoDupA E.eq (elements s). Parameter choose_spec1 : choose s = Some x -> In x s. Parameter choose_spec2 : choose s = None -> Empty s. End Spec. End WSetsOn. (** ** Static signature for weak sets Similar to the functorial signature [WSetsOn], except that the module [E] of base elements is incorporated in the signature. *) Module Type WSets. Declare Module E : DecidableType. Include WSetsOn E. End WSets. (** ** Functorial signature for sets on ordered elements Based on [WSetsOn], plus ordering on sets and [min_elt] and [max_elt] and some stronger specifications for other functions. *) Module Type HasOrdOps (Import T:TypElt). Parameter compare : t -> t -> comparison. (** Total ordering between sets. Can be used as the ordering function for doing sets of sets. *) Parameter min_elt : t -> option elt. (** Return the smallest element of the given set (with respect to the [E.compare] ordering), or [None] if the set is empty. *) Parameter max_elt : t -> option elt. (** Same as [min_elt], but returns the largest element of the given set. *) End HasOrdOps. Module Type Ops (E : OrderedType) := WOps E <+ HasOrdOps. Module Type SetsOn (E : OrderedType). Include WSetsOn E <+ HasOrdOps <+ HasLt <+ IsStrOrder. Section Spec. Variable s s': t. Variable x y : elt. Parameter compare_spec : CompSpec eq lt s s' (compare s s'). (** Additional specification of [elements] *) Parameter elements_spec2 : sort E.lt (elements s). (** Remark: since [fold] is specified via [elements], this stronger specification of [elements] has an indirect impact on [fold], which can now be proved to receive elements in increasing order. *) Parameter min_elt_spec1 : min_elt s = Some x -> In x s. Parameter min_elt_spec2 : min_elt s = Some x -> In y s -> ~ E.lt y x. Parameter min_elt_spec3 : min_elt s = None -> Empty s. Parameter max_elt_spec1 : max_elt s = Some x -> In x s. Parameter max_elt_spec2 : max_elt s = Some x -> In y s -> ~ E.lt x y. Parameter max_elt_spec3 : max_elt s = None -> Empty s. (** Additional specification of [choose] *) Parameter choose_spec3 : choose s = Some x -> choose s' = Some y -> Equal s s' -> E.eq x y. End Spec. End SetsOn. (** ** Static signature for sets on ordered elements Similar to the functorial signature [SetsOn], except that the module [E] of base elements is incorporated in the signature. *) Module Type Sets. Declare Module E : OrderedType. Include SetsOn E. End Sets. Module Type S := Sets. (** ** Some subtyping tests << WSetsOn ---> WSets | | | | V V SetsOn ---> Sets Module S_WS (M : Sets) <: WSets := M. Module Sfun_WSfun (E:OrderedType)(M : SetsOn E) <: WSetsOn E := M. Module S_Sfun (M : Sets) <: SetsOn M.E := M. Module WS_WSfun (M : WSets) <: WSetsOn M.E := M. >> *) (** ** Signatures for set representations with ill-formed values. Motivation: For many implementation of finite sets (AVL trees, sorted lists, lists without duplicates), we use the same two-layer approach: - A first module deals with the datatype (eg. list or tree) without any restriction on the values we consider. In this module (named "Raw" in the past), some results are stated under the assumption that some invariant (e.g. sortedness) holds for the input sets. We also prove that this invariant is preserved by set operators. - A second module implements the exact Sets interface by using a subtype, for instance [{ l : list A | sorted l }]. This module is a mere wrapper around the first Raw module. With the interfaces below, we give some respectability to the "Raw" modules. This allows the interested users to directly access them via the interfaces. Even better, we can build once and for all a functor doing the transition between Raw and usual Sets. Description: The type [t] of sets may contain ill-formed values on which our set operators may give wrong answers. In particular, [mem] may not see a element in a ill-formed set (think for instance of a unsorted list being given to an optimized [mem] that stops its search as soon as a strictly larger element is encountered). Unlike optimized operators, the [In] predicate is supposed to always be correct, even on ill-formed sets. Same for [Equal] and other logical predicates. A predicate parameter [Ok] is used to discriminate between well-formed and ill-formed values. Some lemmas hold only on sets validating [Ok]. This predicate [Ok] is required to be preserved by set operators. Moreover, a boolean function [isok] should exist for identifying (at least some of) the well-formed sets. *) Module Type WRawSets (E : DecidableType). (** First, we ask for all the functions *) Include WOps E. (** Is a set well-formed or ill-formed ? *) Parameter IsOk : t -> Prop. Class Ok (s:t) : Prop := ok : IsOk s. (** In order to be able to validate (at least some) particular sets as well-formed, we ask for a boolean function for (semi-)deciding predicate [Ok]. If [Ok] isn't decidable, [isok] may be the always-false function. *) Parameter isok : t -> bool. (** MS: Dangerous instance, the [isok s = true] hypothesis cannot be discharged with typeclass resolution. Is it really an instance? *) #[global] Declare Instance isok_Ok s `(isok s = true) : Ok s | 10. (** Logical predicates *) Parameter In : elt -> t -> Prop. #[global] Declare Instance In_compat : Proper (E.eq==>eq==>iff) In. Definition Equal s s' := forall a : elt, In a s <-> In a s'. Definition Subset s s' := forall a : elt, In a s -> In a s'. Definition Empty s := forall a : elt, ~ In a s. Definition For_all (P : elt -> Prop) s := forall x, In x s -> P x. Definition Exists (P : elt -> Prop) s := exists x, In x s /\ P x. Notation "s [=] t" := (Equal s t) (at level 70, no associativity). Notation "s [<=] t" := (Subset s t) (at level 70, no associativity). Definition eq : t -> t -> Prop := Equal. #[global] Declare Instance eq_equiv : Equivalence eq. (** First, all operations are compatible with the well-formed predicate. *) #[global] Declare Instance empty_ok : Ok empty. #[global] Declare Instance add_ok s x `(Ok s) : Ok (add x s). #[global] Declare Instance remove_ok s x `(Ok s) : Ok (remove x s). #[global] Declare Instance singleton_ok x : Ok (singleton x). #[global] Declare Instance union_ok s s' `(Ok s, Ok s') : Ok (union s s'). #[global] Declare Instance inter_ok s s' `(Ok s, Ok s') : Ok (inter s s'). #[global] Declare Instance diff_ok s s' `(Ok s, Ok s') : Ok (diff s s'). #[global] Declare Instance filter_ok s f `(Ok s) : Ok (filter f s). #[global] Declare Instance partition_ok1 s f `(Ok s) : Ok (fst (partition f s)). #[global] Declare Instance partition_ok2 s f `(Ok s) : Ok (snd (partition f s)). (** Now, the specifications, with constraints on the input sets. *) Section Spec. Variable s s': t. Variable x y : elt. Variable f : elt -> bool. Notation compatb := (Proper (E.eq==>Logic.eq)) (only parsing). Parameter mem_spec : forall `{Ok s}, mem x s = true <-> In x s. Parameter equal_spec : forall `{Ok s, Ok s'}, equal s s' = true <-> s[=]s'. Parameter subset_spec : forall `{Ok s, Ok s'}, subset s s' = true <-> s[<=]s'. Parameter empty_spec : Empty empty. Parameter is_empty_spec : is_empty s = true <-> Empty s. Parameter add_spec : forall `{Ok s}, In y (add x s) <-> E.eq y x \/ In y s. Parameter remove_spec : forall `{Ok s}, In y (remove x s) <-> In y s /\ ~E.eq y x. Parameter singleton_spec : In y (singleton x) <-> E.eq y x. Parameter union_spec : forall `{Ok s, Ok s'}, In x (union s s') <-> In x s \/ In x s'. Parameter inter_spec : forall `{Ok s, Ok s'}, In x (inter s s') <-> In x s /\ In x s'. Parameter diff_spec : forall `{Ok s, Ok s'}, In x (diff s s') <-> In x s /\ ~In x s'. Parameter fold_spec : forall (A : Type) (i : A) (f : elt -> A -> A), fold f s i = fold_left (flip f) (elements s) i. Parameter cardinal_spec : forall `{Ok s}, cardinal s = length (elements s). Parameter filter_spec : compatb f -> (In x (filter f s) <-> In x s /\ f x = true). Parameter for_all_spec : compatb f -> (for_all f s = true <-> For_all (fun x => f x = true) s). Parameter exists_spec : compatb f -> (exists_ f s = true <-> Exists (fun x => f x = true) s). Parameter partition_spec1 : compatb f -> fst (partition f s) [=] filter f s. Parameter partition_spec2 : compatb f -> snd (partition f s) [=] filter (fun x => negb (f x)) s. Parameter elements_spec1 : InA E.eq x (elements s) <-> In x s. Parameter elements_spec2w : forall `{Ok s}, NoDupA E.eq (elements s). Parameter choose_spec1 : choose s = Some x -> In x s. Parameter choose_spec2 : choose s = None -> Empty s. End Spec. End WRawSets. (** From weak raw sets to weak usual sets *) Module WRaw2SetsOn (E:DecidableType)(M:WRawSets E) <: WSetsOn E. (** We avoid creating induction principles for the Record *) Local Unset Elimination Schemes. Definition elt := E.t. Record t_ := Mkt {this :> M.t; is_ok : M.Ok this}. Definition t := t_. Arguments Mkt this {is_ok}. #[global] Hint Resolve is_ok : typeclass_instances. Definition In (x : elt)(s : t) := M.In x (this s). Definition Equal (s s' : t) := forall a : elt, In a s <-> In a s'. Definition Subset (s s' : t) := forall a : elt, In a s -> In a s'. Definition Empty (s : t) := forall a : elt, ~ In a s. Definition For_all (P : elt -> Prop)(s : t) := forall x, In x s -> P x. Definition Exists (P : elt -> Prop)(s : t) := exists x, In x s /\ P x. Definition mem (x : elt)(s : t) := M.mem x s. Definition add (x : elt)(s : t) : t := Mkt (M.add x s). Definition remove (x : elt)(s : t) : t := Mkt (M.remove x s). Definition singleton (x : elt) : t := Mkt (M.singleton x). Definition union (s s' : t) : t := Mkt (M.union s s'). Definition inter (s s' : t) : t := Mkt (M.inter s s'). Definition diff (s s' : t) : t := Mkt (M.diff s s'). Definition equal (s s' : t) := M.equal s s'. Definition subset (s s' : t) := M.subset s s'. Definition empty : t := Mkt M.empty. Definition is_empty (s : t) := M.is_empty s. Definition elements (s : t) : list elt := M.elements s. Definition choose (s : t) : option elt := M.choose s. Definition fold (A : Type)(f : elt -> A -> A)(s : t) : A -> A := M.fold f s. Definition cardinal (s : t) := M.cardinal s. Definition filter (f : elt -> bool)(s : t) : t := Mkt (M.filter f s). Definition for_all (f : elt -> bool)(s : t) := M.for_all f s. Definition exists_ (f : elt -> bool)(s : t) := M.exists_ f s. Definition partition (f : elt -> bool)(s : t) : t * t := let p := M.partition f s in (Mkt (fst p), Mkt (snd p)). #[global] Instance In_compat : Proper (E.eq==>eq==>iff) In. Proof. repeat red. intros; apply M.In_compat; congruence. Qed. Definition eq : t -> t -> Prop := Equal. #[global] Instance eq_equiv : Equivalence eq. Proof. firstorder. Qed. Definition eq_dec : forall (s s':t), { eq s s' }+{ ~eq s s' }. Proof. intros (s,Hs) (s',Hs'). change ({M.Equal s s'}+{~M.Equal s s'}). destruct (M.equal s s') eqn:H; [left|right]; rewrite <- M.equal_spec; congruence. Defined. Section Spec. Variable s s' : t. Variable x y : elt. Variable f : elt -> bool. Notation compatb := (Proper (E.eq==>Logic.eq)) (only parsing). Lemma mem_spec : mem x s = true <-> In x s. Proof. exact (@M.mem_spec _ _ _). Qed. Lemma equal_spec : equal s s' = true <-> Equal s s'. Proof. exact (@M.equal_spec _ _ _ _). Qed. Lemma subset_spec : subset s s' = true <-> Subset s s'. Proof. exact (@M.subset_spec _ _ _ _). Qed. Lemma empty_spec : Empty empty. Proof. exact M.empty_spec. Qed. Lemma is_empty_spec : is_empty s = true <-> Empty s. Proof. exact (@M.is_empty_spec _). Qed. Lemma add_spec : In y (add x s) <-> E.eq y x \/ In y s. Proof. exact (@M.add_spec _ _ _ _). Qed. Lemma remove_spec : In y (remove x s) <-> In y s /\ ~E.eq y x. Proof. exact (@M.remove_spec _ _ _ _). Qed. Lemma singleton_spec : In y (singleton x) <-> E.eq y x. Proof. exact (@M.singleton_spec _ _). Qed. Lemma union_spec : In x (union s s') <-> In x s \/ In x s'. Proof. exact (@M.union_spec _ _ _ _ _). Qed. Lemma inter_spec : In x (inter s s') <-> In x s /\ In x s'. Proof. exact (@M.inter_spec _ _ _ _ _). Qed. Lemma diff_spec : In x (diff s s') <-> In x s /\ ~In x s'. Proof. exact (@M.diff_spec _ _ _ _ _). Qed. Lemma fold_spec : forall (A : Type) (i : A) (f : elt -> A -> A), fold f s i = fold_left (fun a e => f e a) (elements s) i. Proof. exact (@M.fold_spec _). Qed. Lemma cardinal_spec : cardinal s = length (elements s). Proof. exact (@M.cardinal_spec s _). Qed. Lemma filter_spec : compatb f -> (In x (filter f s) <-> In x s /\ f x = true). Proof. exact (@M.filter_spec _ _ _). Qed. Lemma for_all_spec : compatb f -> (for_all f s = true <-> For_all (fun x => f x = true) s). Proof. exact (@M.for_all_spec _ _). Qed. Lemma exists_spec : compatb f -> (exists_ f s = true <-> Exists (fun x => f x = true) s). Proof. exact (@M.exists_spec _ _). Qed. Lemma partition_spec1 : compatb f -> Equal (fst (partition f s)) (filter f s). Proof. exact (@M.partition_spec1 _ _). Qed. Lemma partition_spec2 : compatb f -> Equal (snd (partition f s)) (filter (fun x => negb (f x)) s). Proof. exact (@M.partition_spec2 _ _). Qed. Lemma elements_spec1 : InA E.eq x (elements s) <-> In x s. Proof. exact (@M.elements_spec1 _ _). Qed. Lemma elements_spec2w : NoDupA E.eq (elements s). Proof. exact (@M.elements_spec2w _ _). Qed. Lemma choose_spec1 : choose s = Some x -> In x s. Proof. exact (@M.choose_spec1 _ _). Qed. Lemma choose_spec2 : choose s = None -> Empty s. Proof. exact (@M.choose_spec2 _). Qed. End Spec. End WRaw2SetsOn. Module WRaw2Sets (D:DecidableType)(M:WRawSets D) <: WSets with Module E := D. Module E := D. Include WRaw2SetsOn D M. End WRaw2Sets. (** Same approach for ordered sets *) Module Type RawSets (E : OrderedType). Include WRawSets E <+ HasOrdOps <+ HasLt <+ IsStrOrder. Section Spec. Variable s s': t. Variable x y : elt. (** Specification of [compare] *) Parameter compare_spec : forall `{Ok s, Ok s'}, CompSpec eq lt s s' (compare s s'). (** Additional specification of [elements] *) Parameter elements_spec2 : forall `{Ok s}, sort E.lt (elements s). (** Specification of [min_elt] *) Parameter min_elt_spec1 : min_elt s = Some x -> In x s. Parameter min_elt_spec2 : forall `{Ok s}, min_elt s = Some x -> In y s -> ~ E.lt y x. Parameter min_elt_spec3 : min_elt s = None -> Empty s. (** Specification of [max_elt] *) Parameter max_elt_spec1 : max_elt s = Some x -> In x s. Parameter max_elt_spec2 : forall `{Ok s}, max_elt s = Some x -> In y s -> ~ E.lt x y. Parameter max_elt_spec3 : max_elt s = None -> Empty s. (** Additional specification of [choose] *) Parameter choose_spec3 : forall `{Ok s, Ok s'}, choose s = Some x -> choose s' = Some y -> Equal s s' -> E.eq x y. End Spec. End RawSets. (** From Raw to usual sets *) Module Raw2SetsOn (O:OrderedType)(M:RawSets O) <: SetsOn O. Include WRaw2SetsOn O M. Definition compare (s s':t) := M.compare s s'. Definition min_elt (s:t) : option elt := M.min_elt s. Definition max_elt (s:t) : option elt := M.max_elt s. Definition lt (s s':t) := M.lt s s'. (** Specification of [lt] *) #[global] Instance lt_strorder : StrictOrder lt. Proof. constructor ; unfold lt; red. - unfold complement. red. intros. apply (irreflexivity H). - intros. transitivity y; auto. Qed. #[global] Instance lt_compat : Proper (eq==>eq==>iff) lt. Proof. repeat red. unfold eq, lt. intros (s1,p1) (s2,p2) E (s1',p1') (s2',p2') E'; simpl. change (M.eq s1 s2) in E. change (M.eq s1' s2') in E'. rewrite E,E'; intuition. Qed. Section Spec. Variable s s' s'' : t. Variable x y : elt. Lemma compare_spec : CompSpec eq lt s s' (compare s s'). Proof. unfold compare; destruct (@M.compare_spec s s' _ _); auto. Qed. (** Additional specification of [elements] *) Lemma elements_spec2 : sort O.lt (elements s). Proof. exact (@M.elements_spec2 _ _). Qed. (** Specification of [min_elt] *) Lemma min_elt_spec1 : min_elt s = Some x -> In x s. Proof. exact (@M.min_elt_spec1 _ _). Qed. Lemma min_elt_spec2 : min_elt s = Some x -> In y s -> ~ O.lt y x. Proof. exact (@M.min_elt_spec2 _ _ _ _). Qed. Lemma min_elt_spec3 : min_elt s = None -> Empty s. Proof. exact (@M.min_elt_spec3 _). Qed. (** Specification of [max_elt] *) Lemma max_elt_spec1 : max_elt s = Some x -> In x s. Proof. exact (@M.max_elt_spec1 _ _). Qed. Lemma max_elt_spec2 : max_elt s = Some x -> In y s -> ~ O.lt x y. Proof. exact (@M.max_elt_spec2 _ _ _ _). Qed. Lemma max_elt_spec3 : max_elt s = None -> Empty s. Proof. exact (@M.max_elt_spec3 _). Qed. (** Additional specification of [choose] *) Lemma choose_spec3 : choose s = Some x -> choose s' = Some y -> Equal s s' -> O.eq x y. Proof. exact (@M.choose_spec3 _ _ _ _ _ _). Qed. End Spec. End Raw2SetsOn. Module Raw2Sets (O:OrderedType)(M:RawSets O) <: Sets with Module E := O. Module E := O. Include Raw2SetsOn O M. End Raw2Sets. (** It is in fact possible to provide an ordering on sets with very little information on them (more or less only the [In] predicate). This generic build of ordering is in fact not used for the moment, we rather use a simpler version dedicated to sets-as-sorted-lists, see [MakeListOrdering]. *) Module Type IN (O:OrderedType). Parameter Inline t : Type. Parameter Inline In : O.t -> t -> Prop. #[global] Declare Instance In_compat : Proper (O.eq==>eq==>iff) In. Definition Equal s s' := forall x, In x s <-> In x s'. Definition Empty s := forall x, ~In x s. End IN. Module MakeSetOrdering (O:OrderedType)(Import M:IN O). Module Import MO := OrderedTypeFacts O. Definition eq : t -> t -> Prop := Equal. #[global] Instance eq_equiv : Equivalence eq. Proof. firstorder. Qed. #[global] Instance : Proper (O.eq==>eq==>iff) In. Proof. intros x x' Ex s s' Es. rewrite Ex. apply Es. Qed. Definition Below x s := forall y, In y s -> O.lt y x. Definition Above x s := forall y, In y s -> O.lt x y. Definition EquivBefore x s s' := forall y, O.lt y x -> (In y s <-> In y s'). Definition EmptyBetween x y s := forall z, In z s -> O.lt z y -> O.lt z x. Definition lt s s' := exists x, EquivBefore x s s' /\ ((In x s' /\ Below x s) \/ (In x s /\ exists y, In y s' /\ O.lt x y /\ EmptyBetween x y s')). #[global] Instance : Proper (O.eq==>eq==>eq==>iff) EquivBefore. Proof. unfold EquivBefore. intros x x' E s1 s1' E1 s2 s2' E2. setoid_rewrite E; setoid_rewrite E1; setoid_rewrite E2; intuition. Qed. #[global] Instance : Proper (O.eq==>eq==>iff) Below. Proof. unfold Below. intros x x' Ex s s' Es. setoid_rewrite Ex; setoid_rewrite Es; intuition. Qed. #[global] Instance : Proper (O.eq==>eq==>iff) Above. Proof. unfold Above. intros x x' Ex s s' Es. setoid_rewrite Ex; setoid_rewrite Es; intuition. Qed. #[global] Instance : Proper (O.eq==>O.eq==>eq==>iff) EmptyBetween. Proof. unfold EmptyBetween. intros x x' Ex y y' Ey s s' Es. setoid_rewrite Ex; setoid_rewrite Ey; setoid_rewrite Es; intuition. Qed. #[global] Instance lt_compat : Proper (eq==>eq==>iff) lt. Proof. unfold lt. intros s1 s1' E1 s2 s2' E2. setoid_rewrite E1; setoid_rewrite E2; intuition. Qed. #[global] Instance lt_strorder : StrictOrder lt. Proof. split. - (* irreflexive *) intros s (x & _ & [(IN,Em)|(IN & y & IN' & LT & Be)]). + specialize (Em x IN); order. + specialize (Be x IN LT); order. - (* transitive *) intros s1 s2 s3 (x & EQ & [(IN,Pre)|(IN,Lex)]) (x' & EQ' & [(IN',Pre')|(IN',Lex')]). + (* 1) Pre / Pre --> Pre *) assert (O.lt x x') by (specialize (Pre' x IN); auto). exists x; split. * intros y Hy; rewrite <- (EQ' y); auto; order. * left; split; auto. rewrite <- (EQ' x); auto. + (* 2) Pre / Lex *) elim_compare x x'. * (* 2a) x=x' --> Pre *) destruct Lex' as (y & INy & LT & Be). exists y; split. -- intros z Hz. split; intros INz. ++ specialize (Pre z INz). rewrite <- (EQ' z), <- (EQ z); auto; order. ++ specialize (Be z INz Hz). rewrite (EQ z), (EQ' z); auto; order. -- left; split; auto. intros z Hz. transitivity x; auto; order. * (* 2b) x Pre *) exists x; split. -- intros z Hz. rewrite <- (EQ' z) by order; auto. -- left; split; auto. rewrite <- (EQ' x); auto. * (* 2c) x>x' --> Lex *) exists x'; split. -- intros z Hz. rewrite (EQ z) by order; auto. -- right; split; auto. rewrite (EQ x'); auto. + (* 3) Lex / Pre --> Lex *) destruct Lex as (y & INy & LT & Be). specialize (Pre' y INy). exists x; split. * intros z Hz. rewrite <- (EQ' z) by order; auto. * right; split; auto. exists y; repeat split; auto. -- rewrite <- (EQ' y); auto. -- intros z Hz LTz; apply Be; auto. rewrite (EQ' z); auto; order. + (* 4) Lex / Lex *) elim_compare x x'. * (* 4a) x=x' --> impossible *) destruct Lex as (y & INy & LT & Be). setoid_replace x with x' in LT; auto. specialize (Be x' IN' LT); order. * (* 4b) x Lex *) exists x; split. -- intros z Hz. rewrite <- (EQ' z) by order; auto. -- right; split; auto. destruct Lex as (y & INy & LT & Be). elim_compare y x'. ++ (* 4ba *) destruct Lex' as (y' & Iny' & LT' & Be'). exists y'; repeat split; auto. ** order. ** intros z Hz LTz. specialize (Be' z Hz LTz). rewrite <- (EQ' z) in Hz by order. apply Be; auto. order. ++ (* 4bb *) exists y; repeat split; auto. ** rewrite <- (EQ' y); auto. ** intros z Hz LTz. apply Be; auto. rewrite (EQ' z); auto; order. ++ (* 4bc*) assert (O.lt x' x) by auto. order. * (* 4c) x>x' --> Lex *) exists x'; split. -- intros z Hz. rewrite (EQ z) by order; auto. -- right; split; auto. rewrite (EQ x'); auto. Qed. Lemma lt_empty_r : forall s s', Empty s' -> ~ lt s s'. Proof. intros s s' Hs' (x & _ & [(IN,_)|(_ & y & IN & _)]). - elim (Hs' x IN). - elim (Hs' y IN). Qed. Definition Add x s s' := forall y, In y s' <-> O.eq x y \/ In y s. Lemma lt_empty_l : forall x s1 s2 s2', Empty s1 -> Above x s2 -> Add x s2 s2' -> lt s1 s2'. Proof. intros x s1 s2 s2' Em Ab Ad. exists x; split. - intros y Hy; split; intros IN. + elim (Em y IN). + rewrite (Ad y) in IN; destruct IN as [EQ|IN]. * order. * specialize (Ab y IN). order. - left; split. + rewrite (Ad x). now left. + intros y Hy. elim (Em y Hy). Qed. Lemma lt_add_lt : forall x1 x2 s1 s1' s2 s2', Above x1 s1 -> Above x2 s2 -> Add x1 s1 s1' -> Add x2 s2 s2' -> O.lt x1 x2 -> lt s1' s2'. Proof. intros x1 x2 s1 s1' s2 s2' Ab1 Ab2 Ad1 Ad2 LT. exists x1; split; [ | right; split]; auto. - intros y Hy. rewrite (Ad1 y), (Ad2 y). split; intros [U|U]; try order. + specialize (Ab1 y U). order. + specialize (Ab2 y U). order. - rewrite (Ad1 x1); auto with *. - exists x2; repeat split; auto. + rewrite (Ad2 x2); now left. + intros y. rewrite (Ad2 y). intros [U|U]. * order. * specialize (Ab2 y U). order. Qed. Lemma lt_add_eq : forall x1 x2 s1 s1' s2 s2', Above x1 s1 -> Above x2 s2 -> Add x1 s1 s1' -> Add x2 s2 s2' -> O.eq x1 x2 -> lt s1 s2 -> lt s1' s2'. Proof. intros x1 x2 s1 s1' s2 s2' Ab1 Ab2 Ad1 Ad2 Hx (x & EQ & Disj). assert (O.lt x1 x). - destruct Disj as [(IN,_)|(IN,_)]; auto. rewrite Hx; auto. - exists x; split. + intros z Hz. rewrite (Ad1 z), (Ad2 z). split; intros [U|U]; try (left; order); right. * rewrite <- (EQ z); auto. * rewrite (EQ z); auto. + destruct Disj as [(IN,Em)|(IN & y & INy & LTy & Be)]. * left; split; auto. -- rewrite (Ad2 x); auto. -- intros z. rewrite (Ad1 z); intros [U|U]; try specialize (Ab1 z U); auto; order. * right; split; auto. -- rewrite (Ad1 x); auto. -- exists y; repeat split; auto. ++ rewrite (Ad2 y); auto. ++ intros z. rewrite (Ad2 z). intros [U|U]; try specialize (Ab2 z U); auto; order. Qed. End MakeSetOrdering. Module MakeListOrdering (O:OrderedType). Module MO:=OrderedTypeFacts O. Local Notation t := (list O.t). Local Notation In := (InA O.eq). Definition eq s s' := forall x, In x s <-> In x s'. #[global] Instance eq_equiv : Equivalence eq := _. Inductive lt_list : t -> t -> Prop := | lt_nil : forall x s, lt_list nil (x :: s) | lt_cons_lt : forall x y s s', O.lt x y -> lt_list (x :: s) (y :: s') | lt_cons_eq : forall x y s s', O.eq x y -> lt_list s s' -> lt_list (x :: s) (y :: s'). #[global] Hint Constructors lt_list : core. Definition lt := lt_list. #[global] Hint Unfold lt : core. #[global] Instance lt_strorder : StrictOrder lt. Proof. split. - (* irreflexive *) assert (forall s s', s=s' -> ~lt s s'). { red; induction 2. - discriminate. - inversion H; subst. apply (StrictOrder_Irreflexive y); auto. - inversion H; subst; auto. } intros s Hs; exact (H s s (eq_refl s) Hs). - (* transitive *) intros s s' s'' H; generalize s''; clear s''; elim H. + intros x l s'' H'; inversion_clear H'; auto. + intros x x' l l' E s'' H'; inversion_clear H'; auto. * constructor 2. transitivity x'; auto. * constructor 2. rewrite <- H0; auto. + intros. inversion_clear H3. * constructor 2. rewrite H0; auto. * constructor 3; auto. -- transitivity y; auto. -- unfold lt in *; auto. Qed. #[global] Instance lt_compat' : Proper (eqlistA O.eq==>eqlistA O.eq==>iff) lt. Proof. apply proper_sym_impl_iff_2; auto with *. intros s1 s1' E1 s2 s2' E2 H. revert s1' E1 s2' E2. induction H; intros; inversion_clear E1; inversion_clear E2. - constructor 1. - constructor 2. MO.order. - constructor 3. + MO.order. + unfold lt in *; auto. Qed. Lemma eq_cons : forall l1 l2 x y, O.eq x y -> eq l1 l2 -> eq (x :: l1) (y :: l2). Proof. unfold eq; intros l1 l2 x y Exy E12 z. split; inversion_clear 1. - left; MO.order. - right; rewrite <- E12; auto. - left; MO.order. - right; rewrite E12; auto. Qed. #[global] Hint Resolve eq_cons : core. Lemma cons_CompSpec : forall c x1 x2 l1 l2, O.eq x1 x2 -> CompSpec eq lt l1 l2 c -> CompSpec eq lt (x1::l1) (x2::l2) c. Proof. destruct c; simpl; inversion_clear 2; auto with relations. Qed. #[global] Hint Resolve cons_CompSpec : core. End MakeListOrdering. coq-8.20.0/theories/MSets/MSetList.v000066400000000000000000000621121466560755400171570ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* false | y :: l => match X.compare x y with | Lt => false | Eq => true | Gt => mem x l end end. Fixpoint add x s := match s with | nil => x :: nil | y :: l => match X.compare x y with | Lt => x :: s | Eq => s | Gt => y :: add x l end end. Definition singleton (x : elt) := x :: nil. Fixpoint remove x s : t := match s with | nil => nil | y :: l => match X.compare x y with | Lt => s | Eq => l | Gt => y :: remove x l end end. Fixpoint union (s : t) : t -> t := match s with | nil => fun s' => s' | x :: l => (fix union_aux (s' : t) : t := match s' with | nil => s | x' :: l' => match X.compare x x' with | Lt => x :: union l s' | Eq => x :: union l l' | Gt => x' :: union_aux l' end end) end. Fixpoint inter (s : t) : t -> t := match s with | nil => fun _ => nil | x :: l => (fix inter_aux (s' : t) : t := match s' with | nil => nil | x' :: l' => match X.compare x x' with | Lt => inter l s' | Eq => x :: inter l l' | Gt => inter_aux l' end end) end. Fixpoint diff (s : t) : t -> t := match s with | nil => fun _ => nil | x :: l => (fix diff_aux (s' : t) : t := match s' with | nil => s | x' :: l' => match X.compare x x' with | Lt => x :: diff l s' | Eq => diff l l' | Gt => diff_aux l' end end) end. Fixpoint equal (s : t) : t -> bool := fun s' : t => match s, s' with | nil, nil => true | x :: l, x' :: l' => match X.compare x x' with | Eq => equal l l' | _ => false end | _, _ => false end. Fixpoint subset s s' := match s, s' with | nil, _ => true | x :: l, x' :: l' => match X.compare x x' with | Lt => false | Eq => subset l l' | Gt => subset s l' end | _, _ => false end. Definition fold (B : Type) (f : elt -> B -> B) (s : t) (i : B) : B := fold_left (flip f) s i. Fixpoint filter (f : elt -> bool) (s : t) : t := match s with | nil => nil | x :: l => if f x then x :: filter f l else filter f l end. Fixpoint for_all (f : elt -> bool) (s : t) : bool := match s with | nil => true | x :: l => if f x then for_all f l else false end. Fixpoint exists_ (f : elt -> bool) (s : t) : bool := match s with | nil => false | x :: l => if f x then true else exists_ f l end. Fixpoint partition (f : elt -> bool) (s : t) : t * t := match s with | nil => (nil, nil) | x :: l => let (s1, s2) := partition f l in if f x then (x :: s1, s2) else (s1, x :: s2) end. Definition cardinal (s : t) : nat := length s. Definition elements (x : t) : list elt := x. Definition min_elt (s : t) : option elt := match s with | nil => None | x :: _ => Some x end. Fixpoint max_elt (s : t) : option elt := match s with | nil => None | x :: nil => Some x | _ :: l => max_elt l end. Definition choose := min_elt. Fixpoint compare s s' := match s, s' with | nil, nil => Eq | nil, _ => Lt | _, nil => Gt | x::s, x'::s' => match X.compare x x' with | Eq => compare s s' | Lt => Lt | Gt => Gt end end. End Ops. Module MakeRaw (X: OrderedType) <: RawSets X. Module Import MX := OrderedTypeFacts X. Module Import ML := OrderedTypeLists X. Include Ops X. (** ** Proofs of set operation specifications. *) Section ForNotations. Definition inf x l := match l with | nil => true | y::_ => match X.compare x y with Lt => true | _ => false end end. Fixpoint isok l := match l with | nil => true | x::l => inf x l && isok l end. Notation Sort l := (isok l = true). Notation Inf := (lelistA X.lt). Notation In := (InA X.eq). Existing Instance X.eq_equiv. #[local] Hint Extern 20 => solve [order] : core. Definition IsOk s := Sort s. Class Ok (s:t) : Prop := ok : Sort s. #[local] Hint Resolve ok : core. #[local] Hint Unfold Ok : core. Instance Sort_Ok s `(Hs : Sort s) : Ok s := { ok := Hs }. Lemma inf_iff : forall x l, Inf x l <-> inf x l = true. Proof. intros x l; split; intro H. - (* -> *) destruct H; simpl in *. + reflexivity. + rewrite <- compare_lt_iff in H; rewrite H; reflexivity. - (* <- *) destruct l as [|y ys]; simpl in *. + constructor; fail. + revert H; case_eq (X.compare x y); try discriminate; []. intros Ha _. rewrite compare_lt_iff in Ha. constructor; assumption. Qed. Lemma isok_iff : forall l, sort X.lt l <-> Ok l. Proof. intro l; split; intro H. - (* -> *) elim H. + constructor; fail. + intros y ys Ha Hb Hc. change (inf y ys && isok ys = true). rewrite inf_iff in Hc. rewrite andb_true_iff; tauto. - (* <- *) induction l as [|x xs]. + constructor. + change (inf x xs && isok xs = true) in H. rewrite andb_true_iff, <- inf_iff in H. destruct H; constructor; tauto. Qed. #[local] Hint Extern 1 (Ok _) => rewrite <- isok_iff : core. Ltac inv_ok := match goal with | H:sort X.lt (_ :: _) |- _ => inversion_clear H; inv_ok | H:sort X.lt nil |- _ => clear H; inv_ok | H:sort X.lt ?l |- _ => change (Ok l) in H; inv_ok | H:Ok _ |- _ => rewrite <- isok_iff in H; inv_ok | |- Ok _ => rewrite <- isok_iff | _ => idtac end. Ltac inv := invlist InA; inv_ok; invlist lelistA. Ltac constructors := repeat constructor. Ltac sort_inf_in := match goal with | H:Inf ?x ?l, H':In ?y ?l |- _ => cut (X.lt x y); [ intro | apply Sort_Inf_In with l; auto] | _ => fail end. Global Instance isok_Ok s `(isok s = true) : Ok s | 10. Proof. intros. assumption. Qed. Definition Equal s s' := forall a : elt, In a s <-> In a s'. Definition Subset s s' := forall a : elt, In a s -> In a s'. Definition Empty s := forall a : elt, ~ In a s. Definition For_all (P : elt -> Prop) s := forall x, In x s -> P x. Definition Exists (P : elt -> Prop) (s : t) := exists x, In x s /\ P x. Lemma mem_spec : forall (s : t) (x : elt) (Hs : Ok s), mem x s = true <-> In x s. Proof. induction s; intros x Hs; inv; simpl. - intuition. + discriminate. + inv. - elim_compare x a; rewrite InA_cons; intuition; try order. + discriminate. + sort_inf_in. order. + rewrite <- IHs; auto. + rewrite IHs; auto. Qed. Lemma add_inf : forall (s : t) (x a : elt), Inf a s -> X.lt a x -> Inf a (add x s). Proof. simple induction s; simpl. - intuition. - intros; elim_compare x a; inv; intuition. Qed. #[local] Hint Resolve add_inf : core. Global Instance add_ok s x : forall `(Ok s), Ok (add x s). Proof. repeat rewrite <- isok_iff; revert s x. simple induction s; simpl. - intuition. - intros; elim_compare x a; inv; auto. Qed. Lemma add_spec : forall (s : t) (x y : elt) (Hs : Ok s), In y (add x s) <-> X.eq y x \/ In y s. Proof. induction s; simpl; intros. - intuition. inv; auto. - elim_compare x a; inv; rewrite !InA_cons, ?IHs; intuition. Qed. Lemma remove_inf : forall (s : t) (x a : elt) (Hs : Ok s), Inf a s -> Inf a (remove x s). Proof. induction s; simpl. - intuition. - intros; elim_compare x a; inv; auto. apply Inf_lt with a; auto. Qed. #[local] Hint Resolve remove_inf : core. Global Instance remove_ok s x : forall `(Ok s), Ok (remove x s). Proof. repeat rewrite <- isok_iff; revert s x. induction s; simpl. - intuition. - intros; elim_compare x a; inv; auto. Qed. Lemma remove_spec : forall (s : t) (x y : elt) (Hs : Ok s), In y (remove x s) <-> In y s /\ ~X.eq y x. Proof. induction s; simpl; intros. - intuition; inv; auto. - elim_compare x a; inv; rewrite !InA_cons, ?IHs; intuition; try sort_inf_in; try order. Qed. Global Instance singleton_ok x : Ok (singleton x). Proof. unfold singleton; simpl; auto. Qed. Lemma singleton_spec : forall x y : elt, In y (singleton x) <-> X.eq y x. Proof. unfold singleton; simpl; split; intros; inv; auto. Qed. Ltac induction2 := simple induction s; [ simpl; auto; try solve [ intros; inv ] | intros x l Hrec; simple induction s'; [ simpl; auto; try solve [ intros; inv ] | intros x' l' Hrec'; simpl; elim_compare x x'; intros; inv; auto ]]. Lemma union_inf : forall (s s' : t) (a : elt) (Hs : Ok s) (Hs' : Ok s'), Inf a s -> Inf a s' -> Inf a (union s s'). Proof. induction2. Qed. #[local] Hint Resolve union_inf : core. Global Instance union_ok s s' : forall `(Ok s, Ok s'), Ok (union s s'). Proof. repeat rewrite <- isok_iff; revert s s'. induction2; constructors; try apply @ok; auto. - apply Inf_eq with x'; auto; apply union_inf; auto; apply Inf_eq with x; auto; order. - change (Inf x' (union (x :: l) l')); auto. Qed. Lemma union_spec : forall (s s' : t) (x : elt) (Hs : Ok s) (Hs' : Ok s'), In x (union s s') <-> In x s \/ In x s'. Proof. induction2; try rewrite ?InA_cons, ?Hrec, ?Hrec'; intuition; inv; auto. Qed. Lemma inter_inf : forall (s s' : t) (a : elt) (Hs : Ok s) (Hs' : Ok s'), Inf a s -> Inf a s' -> Inf a (inter s s'). Proof. induction2. - apply Inf_lt with x; auto. - apply Hrec'; auto. apply Inf_lt with x'; auto. Qed. #[local] Hint Resolve inter_inf : core. Global Instance inter_ok s s' : forall `(Ok s, Ok s'), Ok (inter s s'). Proof. repeat rewrite <- isok_iff; revert s s'. induction2. constructors; auto. apply Inf_eq with x'; auto; apply inter_inf; auto; apply Inf_eq with x; auto. Qed. Lemma inter_spec : forall (s s' : t) (x : elt) (Hs : Ok s) (Hs' : Ok s'), In x (inter s s') <-> In x s /\ In x s'. Proof. induction2; try rewrite ?InA_cons, ?Hrec, ?Hrec'; intuition; inv; auto; try sort_inf_in; try order. Qed. Lemma diff_inf : forall (s s' : t) (Hs : Ok s) (Hs' : Ok s') (a : elt), Inf a s -> Inf a s' -> Inf a (diff s s'). Proof. intros s s'; repeat rewrite <- isok_iff; revert s s'. induction2. - apply Hrec; trivial. + apply Inf_lt with x; auto. + apply Inf_lt with x'; auto. - apply Hrec'; auto. apply Inf_lt with x'; auto. Qed. #[local] Hint Resolve diff_inf : core. Global Instance diff_ok s s' : forall `(Ok s, Ok s'), Ok (diff s s'). Proof. repeat rewrite <- isok_iff; revert s s'. induction2. Qed. Lemma diff_spec : forall (s s' : t) (x : elt) (Hs : Ok s) (Hs' : Ok s'), In x (diff s s') <-> In x s /\ ~In x s'. Proof. induction2; try rewrite ?InA_cons, ?Hrec, ?Hrec'; intuition; inv; auto; try sort_inf_in; try order. right; intuition; inv; auto. Qed. Lemma equal_spec : forall (s s' : t) (Hs : Ok s) (Hs' : Ok s'), equal s s' = true <-> Equal s s'. Proof. induction s as [ | x s IH]; intros [ | x' s'] Hs Hs'; simpl. - intuition reflexivity. - split; intros H. + discriminate. + assert (In x' nil) by (rewrite H; auto). inv. - split; intros H. + discriminate. + assert (In x nil) by (rewrite <-H; auto). inv. - inv. elim_compare x x' as C; try discriminate. + (* x=x' *) rewrite IH; auto. split; intros E y; specialize (E y). * rewrite !InA_cons, E, C; intuition. * rewrite !InA_cons, C in E. intuition; try sort_inf_in; order. + (* xx' *) split; intros E. * discriminate. * assert (In x' (x::s)) by (rewrite E; auto). inv; try sort_inf_in; order. Qed. Lemma subset_spec : forall (s s' : t) (Hs : Ok s) (Hs' : Ok s'), subset s s' = true <-> Subset s s'. Proof. intros s s'; revert s. induction s' as [ | x' s' IH]; intros [ | x s] Hs Hs'; simpl; auto. - split; try red; intros; auto. - split; intros H. + discriminate. + assert (In x nil) by (apply H; auto). inv. - split; try red; intros; auto. inv. - inv. elim_compare x x' as C. + (* x=x' *) rewrite IH; auto. split; intros S y; specialize (S y). * rewrite !InA_cons, C. intuition. * rewrite !InA_cons, C in S. intuition; try sort_inf_in; order. + (* xx' *) rewrite IH; auto. split; intros S y; specialize (S y). * rewrite !InA_cons. intuition. * rewrite !InA_cons in S. rewrite !InA_cons. intuition; try sort_inf_in; order. Qed. Global Instance empty_ok : Ok empty. Proof. constructors. Qed. Lemma empty_spec : Empty empty. Proof. unfold Empty, empty; intuition; inv. Qed. Lemma is_empty_spec : forall s : t, is_empty s = true <-> Empty s. Proof. intros [ | x s]; simpl. - split; auto. intros _ x H. inv. - split. + discriminate. + intros H. elim (H x); auto. Qed. Lemma elements_spec1 : forall (s : t) (x : elt), In x (elements s) <-> In x s. Proof. intuition. Qed. Lemma elements_spec2 : forall (s : t) (Hs : Ok s), sort X.lt (elements s). Proof. intro s; repeat rewrite <- isok_iff; auto. Qed. Lemma elements_spec2w : forall (s : t) (Hs : Ok s), NoDupA X.eq (elements s). Proof. intro s; repeat rewrite <- isok_iff; auto. Qed. Lemma min_elt_spec1 : forall (s : t) (x : elt), min_elt s = Some x -> In x s. Proof. destruct s; simpl; inversion 1; auto. Qed. Lemma min_elt_spec2 : forall (s : t) (x y : elt) (Hs : Ok s), min_elt s = Some x -> In y s -> ~ X.lt y x. Proof. induction s as [ | x s IH]; simpl; inversion 2; subst. intros; inv; try sort_inf_in; order. Qed. Lemma min_elt_spec3 : forall s : t, min_elt s = None -> Empty s. Proof. destruct s; simpl; red; intuition. - inv. - discriminate. Qed. Lemma max_elt_spec1 : forall (s : t) (x : elt), max_elt s = Some x -> In x s. Proof. induction s as [ | x s IH]. - inversion 1. - destruct s as [ | y s]. + simpl. inversion 1; subst; auto. + right; apply IH; auto. Qed. Lemma max_elt_spec2 : forall (s : t) (x y : elt) (Hs : Ok s), max_elt s = Some x -> In y s -> ~ X.lt x y. Proof. induction s as [ | a s IH]. - inversion 2. - destruct s as [ | b s]. + inversion 2; subst. intros; inv; order. + intros. inv; auto. assert (~X.lt x b) by (apply IH; auto). assert (X.lt a b) by auto. order. Qed. Lemma max_elt_spec3 : forall s : t, max_elt s = None -> Empty s. Proof. induction s as [ | a s IH]. - red; intuition; inv. - destruct s as [ | b s]. + inversion 1. + intros; elim IH with b; auto. Qed. Definition choose_spec1 : forall (s : t) (x : elt), choose s = Some x -> In x s := min_elt_spec1. Definition choose_spec2 : forall s : t, choose s = None -> Empty s := min_elt_spec3. Lemma choose_spec3: forall s s' x x', Ok s -> Ok s' -> choose s = Some x -> choose s' = Some x' -> Equal s s' -> X.eq x x'. Proof. unfold choose; intros s s' x x' Hs Hs' Hx Hx' H. assert (~X.lt x x'). { apply min_elt_spec2 with s'; auto. rewrite <-H; auto using min_elt_spec1. } assert (~X.lt x' x). { apply min_elt_spec2 with s; auto. rewrite H; auto using min_elt_spec1. } order. Qed. Lemma fold_spec : forall (s : t) (A : Type) (i : A) (f : elt -> A -> A), fold f s i = fold_left (flip f) (elements s) i. Proof. reflexivity. Qed. Lemma cardinal_spec : forall (s : t) (Hs : Ok s), cardinal s = length (elements s). Proof. auto. Qed. Lemma filter_inf : forall (s : t) (x : elt) (f : elt -> bool) (Hs : Ok s), Inf x s -> Inf x (filter f s). Proof. simple induction s; simpl. - intuition. - intros x l Hrec a f Hs Ha; inv. case (f x); auto. apply Hrec; auto. apply Inf_lt with x; auto. Qed. Global Instance filter_ok s f : forall `(Ok s), Ok (filter f s). Proof. repeat rewrite <- isok_iff; revert s f. simple induction s; simpl. - auto. - intros x l Hrec f Hs; inv. case (f x); auto. constructors; auto. apply filter_inf; auto. Qed. Lemma filter_spec : forall (s : t) (x : elt) (f : elt -> bool), Proper (X.eq==>eq) f -> (In x (filter f s) <-> In x s /\ f x = true). Proof. induction s; simpl; intros. - split; intuition; inv. - destruct (f a) eqn:F; rewrite !InA_cons, ?IHs; intuition. + setoid_replace x with a; auto. + setoid_replace a with x in F; auto; congruence. Qed. Lemma for_all_spec : forall (s : t) (f : elt -> bool), Proper (X.eq==>eq) f -> (for_all f s = true <-> For_all (fun x => f x = true) s). Proof. unfold For_all; induction s; simpl; intros. - split; intros; auto. inv. - destruct (f a) eqn:F. + rewrite IHs; auto. firstorder. inv; auto. setoid_replace x with a; auto. + split; intros H'. * discriminate. * rewrite H' in F; auto. Qed. Lemma exists_spec : forall (s : t) (f : elt -> bool), Proper (X.eq==>eq) f -> (exists_ f s = true <-> Exists (fun x => f x = true) s). Proof. unfold Exists; induction s; simpl; intros. - firstorder. + discriminate. + inv. - destruct (f a) eqn:F. + firstorder. + rewrite IHs; auto. firstorder. inv. * setoid_replace a with x in F; auto; congruence. * exists x; auto. Qed. Lemma partition_inf1 : forall (s : t) (f : elt -> bool) (x : elt) (Hs : Ok s), Inf x s -> Inf x (fst (partition f s)). Proof. intros s f x; repeat rewrite <- isok_iff; revert s f x. simple induction s; simpl. - intuition. - intros x l Hrec f a Hs Ha; inv. generalize (Hrec f a H). case (f x); case (partition f l); simpl. + auto. + intros; apply H2; apply Inf_lt with x; auto. Qed. Lemma partition_inf2 : forall (s : t) (f : elt -> bool) (x : elt) (Hs : Ok s), Inf x s -> Inf x (snd (partition f s)). Proof. intros s f x; repeat rewrite <- isok_iff; revert s f x. simple induction s; simpl. - intuition. - intros x l Hrec f a Hs Ha; inv. generalize (Hrec f a H). case (f x); case (partition f l); simpl. + intros; apply H2; apply Inf_lt with x; auto. + auto. Qed. Global Instance partition_ok1 s f : forall `(Ok s), Ok (fst (partition f s)). Proof. repeat rewrite <- isok_iff; revert s f. simple induction s; simpl. - auto. - intros x l Hrec f Hs; inv. generalize (Hrec f H); generalize (@partition_inf1 l f x). case (f x); case (partition f l); simpl; auto. Qed. Global Instance partition_ok2 s f : forall `(Ok s), Ok (snd (partition f s)). Proof. repeat rewrite <- isok_iff; revert s f. simple induction s; simpl. - auto. - intros x l Hrec f Hs; inv. generalize (Hrec f H); generalize (@partition_inf2 l f x). case (f x); case (partition f l); simpl; auto. Qed. Lemma partition_spec1 : forall (s : t) (f : elt -> bool), Proper (X.eq==>eq) f -> Equal (fst (partition f s)) (filter f s). Proof. simple induction s; simpl; auto; unfold Equal. - split; auto. - intros x l Hrec f Hf. generalize (Hrec f Hf); clear Hrec. destruct (partition f l) as [s1 s2]; simpl; intros. case (f x); simpl; auto. split; inversion_clear 1; auto. + constructor 2; rewrite <- H; auto. + constructor 2; rewrite H; auto. Qed. Lemma partition_spec2 : forall (s : t) (f : elt -> bool), Proper (X.eq==>eq) f -> Equal (snd (partition f s)) (filter (fun x => negb (f x)) s). Proof. simple induction s; simpl; auto; unfold Equal. - split; auto. - intros x l Hrec f Hf. generalize (Hrec f Hf); clear Hrec. destruct (partition f l) as [s1 s2]; simpl; intros. case (f x); simpl; auto. split; inversion_clear 1; auto. + constructor 2; rewrite <- H; auto. + constructor 2; rewrite H; auto. Qed. End ForNotations. Definition In := InA X.eq. #[global] Instance In_compat : Proper (X.eq==>eq==> iff) In. Proof. repeat red; intros; rewrite H, H0; auto. Qed. Module L := MakeListOrdering X. Definition eq := L.eq. Definition eq_equiv := L.eq_equiv. Definition lt l1 l2 := exists l1' l2', Ok l1' /\ Ok l2' /\ eq l1 l1' /\ eq l2 l2' /\ L.lt l1' l2'. #[global] Instance lt_strorder : StrictOrder lt. Proof. split. - intros s (s1 & s2 & B1 & B2 & E1 & E2 & L). repeat rewrite <- isok_iff in *. assert (eqlistA X.eq s1 s2). { apply SortA_equivlistA_eqlistA with (ltA:=X.lt); auto using @ok with *. transitivity s; auto. symmetry; auto. } rewrite H in L. apply (StrictOrder_Irreflexive s2); auto. - intros s1 s2 s3 (s1' & s2' & B1 & B2 & E1 & E2 & L12) (s2'' & s3' & B2' & B3 & E2' & E3 & L23). exists s1', s3'. repeat rewrite <- isok_iff in *. do 4 (split; trivial). assert (eqlistA X.eq s2' s2''). + apply SortA_equivlistA_eqlistA with (ltA:=X.lt); auto using @ok with *. transitivity s2; auto. symmetry; auto. + transitivity s2'; auto. rewrite H; auto. Qed. #[global] Instance lt_compat : Proper (eq==>eq==>iff) lt. Proof. intros s1 s2 E12 s3 s4 E34. split. - intros (s1' & s3' & B1 & B3 & E1 & E3 & LT). exists s1', s3'; do 2 (split; trivial). split. + transitivity s1; auto. symmetry; auto. + split; auto. transitivity s3; auto. symmetry; auto. - intros (s1' & s3' & B1 & B3 & E1 & E3 & LT). exists s1', s3'; do 2 (split; trivial). split. + transitivity s2; auto. + split; auto. transitivity s4; auto. Qed. Lemma compare_spec_aux : forall s s', CompSpec eq L.lt s s' (compare s s'). Proof. induction s as [|x s IH]; intros [|x' s']; simpl; intuition auto with relations. elim_compare x x'; auto. Qed. Lemma compare_spec : forall s s', Ok s -> Ok s' -> CompSpec eq lt s s' (compare s s'). Proof. intros s s' Hs Hs'. destruct (compare_spec_aux s s'); constructor; auto. - exists s, s'; repeat split; auto using @ok. - exists s', s; repeat split; auto using @ok. Qed. End MakeRaw. (** * Encapsulation Now, in order to really provide a functor implementing [S], we need to encapsulate everything into a type of strictly ordered lists. *) Module Make (X: OrderedType) <: S with Module E := X. Module Raw := MakeRaw X. Include Raw2Sets X Raw. End Make. (** For this specific implementation, eq coincides with Leibniz equality *) Require Eqdep_dec. Module Type OrderedTypeWithLeibniz. Include OrderedType. Parameter eq_leibniz : forall x y, eq x y -> x = y. End OrderedTypeWithLeibniz. Module Type SWithLeibniz. Declare Module E : OrderedTypeWithLeibniz. Include SetsOn E. Parameter eq_leibniz : forall x y, eq x y -> x = y. End SWithLeibniz. Module MakeWithLeibniz (X: OrderedTypeWithLeibniz) <: SWithLeibniz with Module E := X. Module E := X. Module Raw := MakeRaw X. Include Raw2SetsOn X Raw. Lemma eq_leibniz_list : forall xs ys, eqlistA X.eq xs ys -> xs = ys. Proof. induction xs as [|x xs]; intros [|y ys] H; inversion H; [ | ]. - reflexivity. - f_equal. + apply X.eq_leibniz; congruence. + apply IHxs; subst; assumption. Qed. Lemma eq_leibniz : forall s s', eq s s' -> s = s'. Proof. intros [xs Hxs] [ys Hys] Heq. change (equivlistA X.eq xs ys) in Heq. assert (H : eqlistA X.eq xs ys). { rewrite <- Raw.isok_iff in Hxs, Hys. apply SortA_equivlistA_eqlistA with X.lt; auto with *. } apply eq_leibniz_list in H. subst ys. f_equal. apply Eqdep_dec.eq_proofs_unicity. intros x y; destruct (bool_dec x y); tauto. Qed. End MakeWithLeibniz. coq-8.20.0/theories/MSets/MSetPositive.v000066400000000000000000001041401466560755400200440ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* bool -> tree -> tree. Scheme tree_ind := Induction for tree Sort Prop. Definition t := tree : Type. Definition empty : t := Leaf. Fixpoint is_empty (m : t) : bool := match m with | Leaf => true | Node l b r => negb b &&& is_empty l &&& is_empty r end. Fixpoint mem (i : positive) (m : t) {struct m} : bool := match m with | Leaf => false | Node l o r => match i with | 1 => o | i~0 => mem i l | i~1 => mem i r end end. Fixpoint add (i : positive) (m : t) : t := match m with | Leaf => match i with | 1 => Node Leaf true Leaf | i~0 => Node (add i Leaf) false Leaf | i~1 => Node Leaf false (add i Leaf) end | Node l o r => match i with | 1 => Node l true r | i~0 => Node (add i l) o r | i~1 => Node l o (add i r) end end. Definition singleton i := add i empty. (** helper function to avoid creating empty trees that are not leaves *) Definition node (l : t) (b: bool) (r : t) : t := if b then Node l b r else match l,r with | Leaf,Leaf => Leaf | _,_ => Node l false r end. Fixpoint remove (i : positive) (m : t) {struct m} : t := match m with | Leaf => Leaf | Node l o r => match i with | 1 => node l false r | i~0 => node (remove i l) o r | i~1 => node l o (remove i r) end end. Fixpoint union (m m': t) : t := match m with | Leaf => m' | Node l o r => match m' with | Leaf => m | Node l' o' r' => Node (union l l') (o||o') (union r r') end end. Fixpoint inter (m m': t) : t := match m with | Leaf => Leaf | Node l o r => match m' with | Leaf => Leaf | Node l' o' r' => node (inter l l') (o&&o') (inter r r') end end. Fixpoint diff (m m': t) : t := match m with | Leaf => Leaf | Node l o r => match m' with | Leaf => m | Node l' o' r' => node (diff l l') (o&&negb o') (diff r r') end end. Fixpoint equal (m m': t): bool := match m with | Leaf => is_empty m' | Node l o r => match m' with | Leaf => is_empty m | Node l' o' r' => eqb o o' &&& equal l l' &&& equal r r' end end. Fixpoint subset (m m': t): bool := match m with | Leaf => true | Node l o r => match m' with | Leaf => is_empty m | Node l' o' r' => (negb o ||| o') &&& subset l l' &&& subset r r' end end. (** reverses [y] and concatenate it with [x] *) Fixpoint rev_append (y x : elt) : elt := match y with | 1 => x | y~1 => rev_append y x~1 | y~0 => rev_append y x~0 end. Infix "@" := rev_append (at level 60). Definition rev x := x@1. Section Fold. Variables B : Type. Variable f : positive -> B -> B. (** the additional argument, [i], records the current path, in reverse order (this should be more efficient: we reverse this argument only at present nodes only, rather than at each node of the tree). we also use this convention in all functions below *) Fixpoint xfold (m : t) (v : B) (i : positive) := match m with | Leaf => v | Node l true r => xfold r (f (rev i) (xfold l v i~0)) i~1 | Node l false r => xfold r (xfold l v i~0) i~1 end. Definition fold m i := xfold m i 1. End Fold. Section Quantifiers. Variable f : positive -> bool. Fixpoint xforall (m : t) (i : positive) := match m with | Leaf => true | Node l o r => (negb o ||| f (rev i)) &&& xforall r i~1 &&& xforall l i~0 end. Definition for_all m := xforall m 1. Fixpoint xexists (m : t) (i : positive) := match m with | Leaf => false | Node l o r => (o &&& f (rev i)) ||| xexists r i~1 ||| xexists l i~0 end. Definition exists_ m := xexists m 1. Fixpoint xfilter (m : t) (i : positive) : t := match m with | Leaf => Leaf | Node l o r => node (xfilter l i~0) (o &&& f (rev i)) (xfilter r i~1) end. Definition filter m := xfilter m 1. Fixpoint xpartition (m : t) (i : positive) : t * t := match m with | Leaf => (Leaf,Leaf) | Node l o r => let (lt,lf) := xpartition l i~0 in let (rt,rf) := xpartition r i~1 in if o then let fi := f (rev i) in (node lt fi rt, node lf (negb fi) rf) else (node lt false rt, node lf false rf) end. Definition partition m := xpartition m 1. End Quantifiers. (** uses [a] to accumulate values rather than doing a lot of concatenations *) Fixpoint xelements (m : t) (i : positive) (a: list positive) := match m with | Leaf => a | Node l false r => xelements l i~0 (xelements r i~1 a) | Node l true r => xelements l i~0 (rev i :: xelements r i~1 a) end. Definition elements (m : t) := xelements m 1 nil. Fixpoint cardinal (m : t) : nat := match m with | Leaf => O | Node l false r => (cardinal l + cardinal r)%nat | Node l true r => S (cardinal l + cardinal r) end. (** would it be more efficient to use a path like in the above functions ? *) Fixpoint choose (m: t) : option elt := match m with | Leaf => None | Node l o r => if o then Some 1 else match choose l with | None => option_map xI (choose r) | Some i => Some i~0 end end. Fixpoint min_elt (m: t) : option elt := match m with | Leaf => None | Node l o r => match min_elt l with | None => if o then Some 1 else option_map xI (min_elt r) | Some i => Some i~0 end end. Fixpoint max_elt (m: t) : option elt := match m with | Leaf => None | Node l o r => match max_elt r with | None => if o then Some 1 else option_map xO (max_elt l) | Some i => Some i~1 end end. (** lexicographic product, defined using a notation to keep things lazy *) Notation lex u v := match u with Eq => v | Lt => Lt | Gt => Gt end. Definition compare_bool a b := match a,b with | false, true => Lt | true, false => Gt | _,_ => Eq end. Fixpoint compare (m m': t): comparison := match m,m' with | Leaf,_ => if is_empty m' then Eq else Lt | _,Leaf => if is_empty m then Eq else Gt | Node l o r,Node l' o' r' => lex (compare_bool o o') (lex (compare l l') (compare r r')) end. Definition In i t := mem i t = true. Definition Equal s s' := forall a : elt, In a s <-> In a s'. Definition Subset s s' := forall a : elt, In a s -> In a s'. Definition Empty s := forall a : elt, ~ In a s. Definition For_all (P : elt -> Prop) s := forall x, In x s -> P x. Definition Exists (P : elt -> Prop) s := exists x, In x s /\ P x. Notation "s [=] t" := (Equal s t) (at level 70, no associativity). Notation "s [<=] t" := (Subset s t) (at level 70, no associativity). Definition eq := Equal. Definition lt m m' := compare m m' = Lt. (** Specification of [In] *) #[global] Instance In_compat : Proper (E.eq==>Logic.eq==>iff) In. Proof. intros s s' Hs x x' Hx. rewrite Hs, Hx; intuition. Qed. (** Specification of [eq] *) Local Instance eq_equiv : Equivalence eq. Proof. firstorder. Qed. (** Specification of [mem] *) Lemma mem_spec: forall s x, mem x s = true <-> In x s. Proof. unfold In. intuition. Qed. (** Additional lemmas for mem *) Lemma mem_Leaf: forall x, mem x Leaf = false. Proof. destruct x; trivial. Qed. (** Specification of [empty] *) Lemma empty_spec : Empty empty. Proof. unfold Empty, In. intro. rewrite mem_Leaf. discriminate. Qed. (** Specification of node *) Lemma mem_node: forall x l o r, mem x (node l o r) = mem x (Node l o r). Proof. intros x l o r. case o; trivial. destruct l; trivial. destruct r; trivial. destruct x; reflexivity. Qed. Local Opaque node. (** Specification of [is_empty] *) Lemma is_empty_spec: forall s, is_empty s = true <-> Empty s. Proof. unfold Empty, In. induction s as [|l IHl o r IHr]; simpl. - firstorder. - rewrite <- 2andb_lazy_alt, 2andb_true_iff, IHl, IHr. clear IHl IHr. destruct o; simpl; split. + intuition discriminate. + intro H. elim (H 1). reflexivity. + intros H [a|a|]; apply H || intro; discriminate. + intro H. split. * split. -- reflexivity. -- intro a. apply (H a~0). * intro a. apply (H a~1). Qed. (** Specification of [subset] *) Lemma subset_Leaf_s: forall s, Leaf [<=] s. Proof. intros s i Hi. apply empty_spec in Hi. elim Hi. Qed. Lemma subset_spec: forall s s', subset s s' = true <-> s [<=] s'. Proof. induction s as [|l IHl o r IHr]; intros [|l' o' r']; simpl. - split; intros. + apply subset_Leaf_s. + reflexivity. - split; intros. + apply subset_Leaf_s. + reflexivity. - rewrite <- 2andb_lazy_alt, 2andb_true_iff, 2is_empty_spec. destruct o; simpl. + split. * intuition discriminate. * intro H. elim (@empty_spec 1). apply H. reflexivity. + split; intro H. * destruct H as [[_ Hl] Hr]. intros [i|i|] Hi. -- elim (Hr i Hi). -- elim (Hl i Hi). -- discriminate. * split. -- split. ++ reflexivity. ++ unfold Empty. intros a H1. apply (@empty_spec (a~0)), H. assumption. -- unfold Empty. intros a H1. apply (@empty_spec (a~1)), H. assumption. - rewrite <- 2andb_lazy_alt, 2andb_true_iff, IHl, IHr. clear. destruct o; simpl. + split; intro H. * destruct H as [[Ho' Hl] Hr]. rewrite Ho'. intros i Hi. destruct i. -- apply (Hr i). assumption. -- apply (Hl i). assumption. -- assumption. * split. -- split. ++ destruct o'; trivial. specialize (H 1). unfold In in H. simpl in H. apply H. reflexivity. ++ intros i Hi. apply (H i~0). apply Hi. -- intros i Hi. apply (H i~1). apply Hi. + split; intros. * intros i Hi. destruct i; destruct H as [[H Hl] Hr]. -- apply (Hr i). assumption. -- apply (Hl i). assumption. -- discriminate Hi. * split. -- split. ++ reflexivity. ++ intros i Hi. apply (H i~0). apply Hi. -- intros i Hi. apply (H i~1). apply Hi. Qed. (** Specification of [equal] (via subset) *) Lemma equal_subset: forall s s', equal s s' = subset s s' && subset s' s. Proof. induction s as [|l IHl o r IHr]; intros [|l' o' r']; simpl; trivial. - destruct o. + reflexivity. + rewrite andb_comm. reflexivity. - rewrite <- 6andb_lazy_alt. rewrite eq_iff_eq_true. rewrite 7andb_true_iff, eqb_true_iff. rewrite IHl, IHr, 2andb_true_iff. clear IHl IHr. intuition subst. + destruct o'; reflexivity. + destruct o'; reflexivity. + destruct o; auto. destruct o'; trivial. Qed. Lemma equal_spec: forall s s', equal s s' = true <-> Equal s s'. Proof. intros. rewrite equal_subset. rewrite andb_true_iff. rewrite 2subset_spec. unfold Equal, Subset. firstorder. Qed. Lemma eq_dec : forall s s', { eq s s' } + { ~ eq s s' }. Proof. unfold eq. intros. case_eq (equal s s'); intro H. - left. apply equal_spec, H. - right. rewrite <- equal_spec. congruence. Defined. (** (Specified) definition of [compare] *) Lemma lex_Opp: forall u v u' v', u = CompOpp u' -> v = CompOpp v' -> lex u v = CompOpp (lex u' v'). Proof. intros ? ? u' ? -> ->. case u'; reflexivity. Qed. Lemma compare_bool_inv: forall b b', compare_bool b b' = CompOpp (compare_bool b' b). Proof. intros [|] [|]; reflexivity. Qed. Lemma compare_inv: forall s s', compare s s' = CompOpp (compare s' s). Proof. induction s as [|l IHl o r IHr]; destruct s' as [|l' o' r']; trivial. - unfold compare. case is_empty; reflexivity. - unfold compare. case is_empty; reflexivity. - simpl. rewrite compare_bool_inv. case compare_bool; simpl; trivial; apply lex_Opp; auto. Qed. Lemma lex_Eq: forall u v, lex u v = Eq <-> u=Eq /\ v=Eq. Proof. intros u v; destruct u; intuition discriminate. Qed. Lemma compare_bool_Eq: forall b1 b2, compare_bool b1 b2 = Eq <-> eqb b1 b2 = true. Proof. intros [|] [|]; intuition discriminate. Qed. Lemma compare_equal: forall s s', compare s s' = Eq <-> equal s s' = true. Proof. induction s as [|l IHl o r IHr]; destruct s' as [|l' o' r']. - simpl. tauto. - unfold compare, equal. case is_empty; intuition discriminate. - unfold compare, equal. case is_empty; intuition discriminate. - simpl. rewrite <- 2andb_lazy_alt, 2andb_true_iff. rewrite <- IHl, <- IHr, <- compare_bool_Eq. clear IHl IHr. rewrite and_assoc. rewrite <- 2lex_Eq. reflexivity. Qed. Lemma compare_gt: forall s s', compare s s' = Gt -> lt s' s. Proof. unfold lt. intros s s'. rewrite compare_inv. case compare; trivial; intros; discriminate. Qed. Lemma compare_eq: forall s s', compare s s' = Eq -> eq s s'. Proof. unfold eq. intros s s'. rewrite compare_equal, equal_spec. trivial. Qed. Lemma compare_spec : forall s s' : t, CompSpec eq lt s s' (compare s s'). Proof. intros. case_eq (compare s s'); intro H; constructor. - apply compare_eq, H. - assumption. - apply compare_gt, H. Qed. Section lt_spec. Inductive ct: comparison -> comparison -> comparison -> Prop := | ct_xxx: forall x, ct x x x | ct_xex: forall x, ct x Eq x | ct_exx: forall x, ct Eq x x | ct_glx: forall x, ct Gt Lt x | ct_lgx: forall x, ct Lt Gt x. Lemma ct_cxe: forall x, ct (CompOpp x) x Eq. Proof. destruct x; constructor. Qed. Lemma ct_xce: forall x, ct x (CompOpp x) Eq. Proof. destruct x; constructor. Qed. Lemma ct_lxl: forall x, ct Lt x Lt. Proof. destruct x; constructor. Qed. Lemma ct_gxg: forall x, ct Gt x Gt. Proof. destruct x; constructor. Qed. Lemma ct_xll: forall x, ct x Lt Lt. Proof. destruct x; constructor. Qed. Lemma ct_xgg: forall x, ct x Gt Gt. Proof. destruct x; constructor. Qed. Local Hint Constructors ct: ct. Local Hint Resolve ct_cxe ct_xce ct_lxl ct_xll ct_gxg ct_xgg: ct. Ltac ct := trivial with ct. Lemma ct_lex: forall u v w u' v' w', ct u v w -> ct u' v' w' -> ct (lex u u') (lex v v') (lex w w'). Proof. intros u v w u' v' w' H H'. inversion_clear H; inversion_clear H'; ct; destruct w; ct; destruct w'; ct. Qed. Lemma ct_compare_bool: forall a b c, ct (compare_bool a b) (compare_bool b c) (compare_bool a c). Proof. intros [|] [|] [|]; constructor. Qed. Lemma compare_x_Leaf: forall s, compare s Leaf = if is_empty s then Eq else Gt. Proof. intros. rewrite compare_inv. simpl. case (is_empty s); reflexivity. Qed. Lemma compare_empty_x: forall a, is_empty a = true -> forall b, compare a b = if is_empty b then Eq else Lt. Proof. induction a as [|l IHl o r IHr]; trivial. destruct o. - intro; discriminate. - simpl is_empty. rewrite <- andb_lazy_alt, andb_true_iff. intros [Hl Hr]. destruct b as [|l' [|] r']; simpl compare; trivial. + rewrite Hl, Hr. trivial. + rewrite (IHl Hl), (IHr Hr). simpl. case (is_empty l'); case (is_empty r'); trivial. Qed. Lemma compare_x_empty: forall a, is_empty a = true -> forall b, compare b a = if is_empty b then Eq else Gt. Proof. setoid_rewrite <- compare_x_Leaf. intros. rewrite 2(compare_inv b), (compare_empty_x _ H). reflexivity. Qed. Lemma ct_compare: forall a b c, ct (compare a b) (compare b c) (compare a c). Proof. induction a as [|l IHl o r IHr]; intros s' s''. - destruct s' as [|l' o' r']; destruct s'' as [|l'' o'' r'']; ct. + rewrite compare_inv. ct. + unfold compare at 1. case_eq (is_empty (Node l' o' r')); intro H'. * rewrite (compare_empty_x _ H'). ct. * unfold compare at 2. case_eq (is_empty (Node l'' o'' r'')); intro H''. -- rewrite (compare_x_empty _ H''), H'. ct. -- ct. - destruct s' as [|l' o' r']; destruct s'' as [|l'' o'' r'']. + ct. + unfold compare at 2. rewrite compare_x_Leaf. case_eq (is_empty (Node l o r)); intro H. * rewrite (compare_empty_x _ H). ct. * case_eq (is_empty (Node l'' o'' r'')); intro H''. -- rewrite (compare_x_empty _ H''), H. ct. -- ct. + rewrite 2 compare_x_Leaf. case_eq (is_empty (Node l o r)); intro H. * rewrite compare_inv, (compare_x_empty _ H). ct. * case_eq (is_empty (Node l' o' r')); intro H'. -- rewrite (compare_x_empty _ H'), H. ct. -- ct. + simpl compare. apply ct_lex. * apply ct_compare_bool. * apply ct_lex; trivial. Qed. End lt_spec. #[global] Instance lt_strorder : StrictOrder lt. Proof. unfold lt. split. - intros x H. assert (compare x x = Eq). + apply compare_equal, equal_spec. reflexivity. + congruence. - intros a b c. assert (H := ct_compare a b c). inversion_clear H; trivial; intros; discriminate. Qed. Local Instance compare_compat_1 : Proper (eq==>Logic.eq==>Logic.eq) compare. Proof. intros x x' Hx y y' Hy. subst y'. unfold eq in *. rewrite <- equal_spec, <- compare_equal in *. assert (C:=ct_compare x x' y). rewrite Hx in C. inversion C; auto. Qed. #[global] Instance compare_compat : Proper (eq==>eq==>Logic.eq) compare. Proof. intros x x' Hx y y' Hy. rewrite Hx. rewrite compare_inv, Hy, <- compare_inv. reflexivity. Qed. Local Instance lt_compat : Proper (eq==>eq==>iff) lt. Proof. intros x x' Hx y y' Hy. unfold lt. rewrite Hx, Hy. intuition. Qed. (** Specification of [add] *) Lemma add_spec: forall s x y, In y (add x s) <-> y=x \/ In y s. Proof. unfold In. intros s x y; revert x y s. induction x; intros [y|y|] [|l o r]; simpl mem; try (rewrite IHx; clear IHx); rewrite ?mem_Leaf; intuition congruence. Qed. (** Specification of [remove] *) Lemma remove_spec: forall s x y, In y (remove x s) <-> In y s /\ y<>x. Proof. unfold In. intros s x y; revert x y s. induction x; intros [y|y|] [|l o r]; simpl remove; rewrite ?mem_node; simpl mem; try (rewrite IHx; clear IHx); rewrite ?mem_Leaf; intuition congruence. Qed. (** Specification of [singleton] *) Lemma singleton_spec : forall x y, In y (singleton x) <-> y=x. Proof. unfold singleton. intros x y. rewrite add_spec. intuition. unfold In in *. rewrite mem_Leaf in *. discriminate. Qed. (** Specification of [union] *) Lemma union_spec: forall s s' x, In x (union s s') <-> In x s \/ In x s'. Proof. unfold In. intros s s' x; revert x s s'. induction x; destruct s; destruct s'; simpl union; simpl mem; try (rewrite IHx; clear IHx); try intuition congruence. apply orb_true_iff. Qed. (** Specification of [inter] *) Lemma inter_spec: forall s s' x, In x (inter s s') <-> In x s /\ In x s'. Proof. unfold In. intros s s' x; revert x s s'. induction x; destruct s; destruct s'; simpl inter; rewrite ?mem_node; simpl mem; try (rewrite IHx; clear IHx); try intuition congruence. apply andb_true_iff. Qed. (** Specification of [diff] *) Lemma diff_spec: forall s s' x, In x (diff s s') <-> In x s /\ ~ In x s'. Proof. unfold In. intros s s' x; revert x s s'. induction x; destruct s; destruct s' as [|l' o' r']; simpl diff; rewrite ?mem_node; simpl mem; try (rewrite IHx; clear IHx); try intuition congruence. rewrite andb_true_iff. destruct o'; intuition discriminate. Qed. (** Specification of [fold] *) Lemma fold_spec: forall s (A : Type) (i : A) (f : elt -> A -> A), fold f s i = fold_left (fun a e => f e a) (elements s) i. Proof. unfold fold, elements. intros s A i f. revert s i. set (f' := fun a e => f e a). assert (H: forall s i j acc, fold_left f' acc (xfold f s i j) = fold_left f' (xelements s j acc) i). - induction s as [|l IHl o r IHr]; intros; trivial. destruct o; simpl xelements; simpl xfold. + rewrite IHr, <- IHl. reflexivity. + rewrite IHr. apply IHl. - intros. exact (H s i 1 nil). Qed. (** Specification of [cardinal] *) Lemma cardinal_spec: forall s, cardinal s = length (elements s). Proof. unfold elements. assert (H: forall s j acc, (cardinal s + length acc)%nat = length (xelements s j acc)). - induction s as [|l IHl b r IHr]; intros j acc; simpl; trivial. destruct b. + rewrite <- IHl. simpl. rewrite <- IHr. rewrite <- plus_n_Sm, Nat.add_assoc. reflexivity. + rewrite <- IHl, <- IHr. rewrite Nat.add_assoc. reflexivity. - intros. rewrite <- H. simpl. rewrite Nat.add_comm. reflexivity. Qed. (** Specification of [filter] *) Lemma xfilter_spec: forall f s x i, In x (xfilter f s i) <-> In x s /\ f (i@x) = true. Proof. intro f. unfold In. induction s as [|l IHl o r IHr]; intros x i; simpl xfilter. - rewrite mem_Leaf. intuition discriminate. - rewrite mem_node. destruct x; simpl. + rewrite IHr. reflexivity. + rewrite IHl. reflexivity. + rewrite <- andb_lazy_alt. apply andb_true_iff. Qed. Lemma filter_spec: forall s x f, @compat_bool elt E.eq f -> (In x (filter f s) <-> In x s /\ f x = true). Proof. intros. apply xfilter_spec. Qed. (** Specification of [for_all] *) Lemma xforall_spec: forall f s i, xforall f s i = true <-> For_all (fun x => f (i@x) = true) s. Proof. unfold For_all, In. intro f. induction s as [|l IHl o r IHr]; intros i; simpl. - intuition discriminate. - rewrite <- 2andb_lazy_alt, <- orb_lazy_alt, 2 andb_true_iff. rewrite IHl, IHr. clear IHl IHr. split. + intros [[Hi Hr] Hl] x. destruct x; simpl; intro H. * apply Hr, H. * apply Hl, H. * rewrite H in Hi. assumption. + intro H; intuition. * specialize (H 1). destruct o. -- apply H. reflexivity. -- reflexivity. * apply H. assumption. * apply H. assumption. Qed. Lemma for_all_spec: forall s f, @compat_bool elt E.eq f -> (for_all f s = true <-> For_all (fun x => f x = true) s). Proof. intros. apply xforall_spec. Qed. (** Specification of [exists] *) Lemma xexists_spec: forall f s i, xexists f s i = true <-> Exists (fun x => f (i@x) = true) s. Proof. unfold Exists, In. intro f. induction s as [|l IHl o r IHr]; intros i; simpl. - firstorder with bool. - rewrite <- 2orb_lazy_alt, 2orb_true_iff, <- andb_lazy_alt, andb_true_iff. rewrite IHl, IHr. clear IHl IHr. split. + intros [[Hi|[x Hr]]|[x Hl]]. * exists 1. exact Hi. * exists x~1. exact Hr. * exists x~0. exact Hl. + intros [[x|x|] H]; eauto. Qed. Lemma exists_spec : forall s f, @compat_bool elt E.eq f -> (exists_ f s = true <-> Exists (fun x => f x = true) s). Proof. intros. apply xexists_spec. Qed. (** Specification of [partition] *) Lemma partition_filter : forall s f, partition f s = (filter f s, filter (fun x => negb (f x)) s). Proof. unfold partition, filter. intros s f. generalize 1 as j. induction s as [|l IHl o r IHr]; intro j. - reflexivity. - destruct o; simpl; rewrite IHl, IHr; reflexivity. Qed. Lemma partition_spec1 : forall s f, @compat_bool elt E.eq f -> Equal (fst (partition f s)) (filter f s). Proof. intros. rewrite partition_filter. reflexivity. Qed. Lemma partition_spec2 : forall s f, @compat_bool elt E.eq f -> Equal (snd (partition f s)) (filter (fun x => negb (f x)) s). Proof. intros. rewrite partition_filter. reflexivity. Qed. (** Specification of [elements] *) Notation InL := (InA E.eq). Lemma xelements_spec: forall s j acc y, InL y (xelements s j acc) <-> InL y acc \/ exists x, y=(j@x) /\ mem x s = true. Proof. induction s as [|l IHl o r IHr]; simpl. - intros. split; intro H. + left. assumption. + destruct H as [H|[x [Hx Hx']]]. * assumption. * discriminate. - intros j acc y. case o. + rewrite IHl. rewrite InA_cons. rewrite IHr. clear IHl IHr. split. * intros [[H|[H|[x [-> H]]]]|[x [-> H]]]; eauto. -- right. exists x~1. auto. -- right. exists x~0. auto. * intros [H|[x [-> H]]]. -- eauto. -- destruct x. ++ left. right. right. exists x; auto. ++ right. exists x; auto. ++ left. left. reflexivity. + rewrite IHl, IHr. clear IHl IHr. split. * intros [[H|[x [-> H]]]|[x [-> H]]]. -- eauto. -- right. exists x~1. auto. -- right. exists x~0. auto. * intros [H|[x [-> H]]]. -- eauto. -- destruct x. ++ left. right. exists x; auto. ++ right. exists x; auto. ++ discriminate. Qed. Lemma elements_spec1: forall s x, InL x (elements s) <-> In x s. Proof. unfold elements. intros. rewrite xelements_spec. split; [ intros [A|(y & B & C)] | intros IN ]. - inversion A. - simpl in *. congruence. - right. exists x. auto. Qed. Lemma lt_rev_append: forall j x y, E.lt x y -> E.lt (j@x) (j@y). Proof. induction j; intros; simpl; auto. Qed. Lemma elements_spec2: forall s, sort E.lt (elements s). Proof. unfold elements. assert (H: forall s j acc, sort E.lt acc -> (forall x y, In x s -> InL y acc -> E.lt (j@x) y) -> sort E.lt (xelements s j acc)). - induction s as [|l IHl o r IHr]; simpl; trivial. intros j acc Hacc Hsacc. destruct o. + apply IHl. * constructor. -- apply IHr. ++ apply Hacc. ++ intros x y Hx Hy. apply Hsacc; assumption. -- case_eq (xelements r j~1 acc). ++ constructor. ++ intros z q H. constructor. assert (H': InL z (xelements r j~1 acc)). ** rewrite H. constructor. reflexivity. ** { clear H q. rewrite xelements_spec in H'. destruct H' as [Hy|[x [-> Hx]]]. - apply (Hsacc 1 z); trivial. reflexivity. - simpl. apply lt_rev_append. exact I. } * intros x y Hx Hy. inversion_clear Hy. -- rewrite H. simpl. apply lt_rev_append. exact I. -- rewrite xelements_spec in H. destruct H as [Hy|[z [-> Hy]]]. ++ apply Hsacc; assumption. ++ simpl. apply lt_rev_append. exact I. + apply IHl. * apply IHr. -- apply Hacc. -- intros x y Hx Hy. apply Hsacc; assumption. * intros x y Hx Hy. rewrite xelements_spec in Hy. destruct Hy as [Hy|[z [-> Hy]]]. -- apply Hsacc; assumption. -- simpl. apply lt_rev_append. exact I. - intros. apply H. + constructor. + intros x y _ H'. inversion H'. Qed. Lemma elements_spec2w: forall s, NoDupA E.eq (elements s). Proof. intro. apply SortA_NoDupA with E.lt; auto with *. apply elements_spec2. Qed. (** Specification of [choose] *) Lemma choose_spec1: forall s x, choose s = Some x -> In x s. Proof. induction s as [| l IHl o r IHr]; simpl. - intros. discriminate. - destruct o. + intros x H. injection H; intros; subst. reflexivity. + revert IHl. case choose. * intros p Hp x [= <-]. apply Hp. reflexivity. * intros _ x. revert IHr. case choose. -- intros p Hp [= <-]. apply Hp. reflexivity. -- intros. discriminate. Qed. Lemma choose_spec2: forall s, choose s = None -> Empty s. Proof. unfold Empty, In. intros s H. induction s as [|l IHl o r IHr]. - intro. apply empty_spec. - destruct o. + discriminate. + simpl in H. destruct (choose l). * discriminate. * destruct (choose r). -- discriminate. -- intros [a|a|]. ++ apply IHr. reflexivity. ++ apply IHl. reflexivity. ++ discriminate. Qed. Lemma choose_empty: forall s, is_empty s = true -> choose s = None. Proof. intros s Hs. case_eq (choose s); trivial. intros p Hp. apply choose_spec1 in Hp. apply is_empty_spec in Hs. elim (Hs _ Hp). Qed. Lemma choose_spec3': forall s s', Equal s s' -> choose s = choose s'. Proof. setoid_rewrite <- equal_spec. induction s as [|l IHl o r IHr]. - intros. symmetry. apply choose_empty. assumption. - destruct s' as [|l' o' r']. + generalize (Node l o r) as s. simpl. intros. apply choose_empty. rewrite equal_spec in H. symmetry in H. rewrite <- equal_spec in H. assumption. + simpl. rewrite <- 2andb_lazy_alt, 2andb_true_iff, eqb_true_iff. intros [[<- Hl] Hr]. rewrite (IHl _ Hl), (IHr _ Hr). reflexivity. Qed. Lemma choose_spec3: forall s s' x y, choose s = Some x -> choose s' = Some y -> Equal s s' -> E.eq x y. Proof. intros s s' x y Hx Hy H. apply choose_spec3' in H. congruence. Qed. (** Specification of [min_elt] *) Lemma min_elt_spec1: forall s x, min_elt s = Some x -> In x s. Proof. unfold In. induction s as [| l IHl o r IHr]; simpl. - intros. discriminate. - intros x. destruct (min_elt l); intros. + injection H as [= <-]. apply IHl. reflexivity. + destruct o; simpl. * injection H as [= <-]. reflexivity. * destruct (min_elt r); simpl in *. -- injection H as [= <-]. apply IHr. reflexivity. -- discriminate. Qed. Lemma min_elt_spec3: forall s, min_elt s = None -> Empty s. Proof. unfold Empty, In. intros s H. induction s as [|l IHl o r IHr]. - intro. apply empty_spec. - intros [a|a|]. + apply IHr. revert H. clear. simpl. destruct (min_elt r); trivial. case min_elt; intros; try discriminate. destruct o; discriminate. + apply IHl. revert H. clear. simpl. destruct (min_elt l); trivial. intro; discriminate. + revert H. clear. simpl. case min_elt; intros; try discriminate. destruct o; discriminate. Qed. Lemma min_elt_spec2: forall s x y, min_elt s = Some x -> In y s -> ~ E.lt y x. Proof. unfold In. induction s as [|l IHl o r IHr]; intros x y H H'. - discriminate. - simpl in H. case_eq (min_elt l). + intros p Hp. rewrite Hp in H. injection H as [= <-]. destruct y as [z|z|]; simpl; intro; trivial. apply (IHl p z); trivial. + intro Hp; rewrite Hp in H. apply min_elt_spec3 in Hp. destruct o. * injection H as [= <-]. intros Hl. destruct y as [z|z|]; simpl; trivial. elim (Hp _ H'). * destruct (min_elt r). -- injection H as [= <-]. destruct y as [z|z|]. ++ apply (IHr e z); trivial. ++ elim (Hp _ H'). ++ discriminate. -- discriminate. Qed. (** Specification of [max_elt] *) Lemma max_elt_spec1: forall s x, max_elt s = Some x -> In x s. Proof. unfold In. induction s as [| l IHl o r IHr]; simpl. - intros. discriminate. - intros x. destruct (max_elt r); intros. + injection H as [= <-]. apply IHr. reflexivity. + destruct o; simpl. * injection H as [= <-]. reflexivity. * destruct (max_elt l); simpl in *. -- injection H as [= <-]. apply IHl. reflexivity. -- discriminate. Qed. Lemma max_elt_spec3: forall s, max_elt s = None -> Empty s. Proof. unfold Empty, In. intros s H. induction s as [|l IHl o r IHr]. - intro. apply empty_spec. - intros [a|a|]. + apply IHr. revert H. clear. simpl. destruct (max_elt r); trivial. intro; discriminate. + apply IHl. revert H. clear. simpl. destruct (max_elt l); trivial. case max_elt; intros; try discriminate. destruct o; discriminate. + revert H. clear. simpl. case max_elt; intros; try discriminate. destruct o; discriminate. Qed. Lemma max_elt_spec2: forall s x y, max_elt s = Some x -> In y s -> ~ E.lt x y. Proof. unfold In. induction s as [|l IHl o r IHr]; intros x y H H'. - discriminate. - simpl in H. case_eq (max_elt r). + intros p Hp. rewrite Hp in H. injection H as [= <-]. destruct y as [z|z|]; simpl; intro; trivial. apply (IHr p z); trivial. + intro Hp; rewrite Hp in H. apply max_elt_spec3 in Hp. destruct o. * injection H as [= <-]. intros Hl. destruct y as [z|z|]; simpl; trivial. elim (Hp _ H'). * destruct (max_elt l). -- injection H as [= <-]. destruct y as [z|z|]. ++ elim (Hp _ H'). ++ apply (IHl e z); trivial. ++ discriminate. -- discriminate. Qed. End PositiveSet. coq-8.20.0/theories/MSets/MSetProperties.v000066400000000000000000001070241466560755400204020ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* E.eq x y \/ In y s. Lemma Add_Equal : forall x s s', Add x s s' <-> s' [=] add x s. Proof. unfold Add. split; intros. - red; intros. rewrite H; clear H. fsetdec. - fsetdec. Qed. Ltac expAdd := repeat rewrite Add_Equal. Section BasicProperties. Variable s s' s'' s1 s2 s3 : t. Variable x x' : elt. Lemma equal_refl : s[=]s. Proof. fsetdec. Qed. Lemma equal_sym : s[=]s' -> s'[=]s. Proof. fsetdec. Qed. Lemma equal_trans : s1[=]s2 -> s2[=]s3 -> s1[=]s3. Proof. fsetdec. Qed. Lemma subset_refl : s[<=]s. Proof. fsetdec. Qed. Lemma subset_trans : s1[<=]s2 -> s2[<=]s3 -> s1[<=]s3. Proof. fsetdec. Qed. Lemma subset_antisym : s[<=]s' -> s'[<=]s -> s[=]s'. Proof. fsetdec. Qed. Lemma subset_equal : s[=]s' -> s[<=]s'. Proof. fsetdec. Qed. Lemma subset_empty : empty[<=]s. Proof. fsetdec. Qed. Lemma subset_remove_3 : s1[<=]s2 -> remove x s1 [<=] s2. Proof. fsetdec. Qed. Lemma subset_diff : s1[<=]s3 -> diff s1 s2 [<=] s3. Proof. fsetdec. Qed. Lemma subset_add_3 : In x s2 -> s1[<=]s2 -> add x s1 [<=] s2. Proof. fsetdec. Qed. Lemma subset_add_2 : s1[<=]s2 -> s1[<=] add x s2. Proof. fsetdec. Qed. Lemma in_subset : In x s1 -> s1[<=]s2 -> In x s2. Proof. fsetdec. Qed. Lemma double_inclusion : s1[=]s2 <-> s1[<=]s2 /\ s2[<=]s1. Proof. intuition fsetdec. Qed. Lemma empty_is_empty_1 : Empty s -> s[=]empty. Proof. fsetdec. Qed. Lemma empty_is_empty_2 : s[=]empty -> Empty s. Proof. fsetdec. Qed. Lemma add_equal : In x s -> add x s [=] s. Proof. fsetdec. Qed. Lemma add_add : add x (add x' s) [=] add x' (add x s). Proof. fsetdec. Qed. Lemma remove_equal : ~ In x s -> remove x s [=] s. Proof. fsetdec. Qed. Lemma Equal_remove : s[=]s' -> remove x s [=] remove x s'. Proof. fsetdec. Qed. Lemma add_remove : In x s -> add x (remove x s) [=] s. Proof. fsetdec. Qed. Lemma remove_add : ~In x s -> remove x (add x s) [=] s. Proof. fsetdec. Qed. Lemma singleton_equal_add : singleton x [=] add x empty. Proof. fsetdec. Qed. Lemma remove_singleton_empty : In x s -> remove x s [=] empty -> singleton x [=] s. Proof. fsetdec. Qed. Lemma union_sym : union s s' [=] union s' s. Proof. fsetdec. Qed. Lemma union_subset_equal : s[<=]s' -> union s s' [=] s'. Proof. fsetdec. Qed. Lemma union_equal_1 : s[=]s' -> union s s'' [=] union s' s''. Proof. fsetdec. Qed. Lemma union_equal_2 : s'[=]s'' -> union s s' [=] union s s''. Proof. fsetdec. Qed. Lemma union_assoc : union (union s s') s'' [=] union s (union s' s''). Proof. fsetdec. Qed. Lemma add_union_singleton : add x s [=] union (singleton x) s. Proof. fsetdec. Qed. Lemma union_add : union (add x s) s' [=] add x (union s s'). Proof. fsetdec. Qed. Lemma union_remove_add_1 : union (remove x s) (add x s') [=] union (add x s) (remove x s'). Proof. fsetdec. Qed. Lemma union_remove_add_2 : In x s -> union (remove x s) (add x s') [=] union s s'. Proof. fsetdec. Qed. Lemma union_subset_1 : s [<=] union s s'. Proof. fsetdec. Qed. Lemma union_subset_2 : s' [<=] union s s'. Proof. fsetdec. Qed. Lemma union_subset_3 : s[<=]s'' -> s'[<=]s'' -> union s s' [<=] s''. Proof. fsetdec. Qed. Lemma union_subset_4 : s[<=]s' -> union s s'' [<=] union s' s''. Proof. fsetdec. Qed. Lemma union_subset_5 : s[<=]s' -> union s'' s [<=] union s'' s'. Proof. fsetdec. Qed. Lemma empty_union_1 : Empty s -> union s s' [=] s'. Proof. fsetdec. Qed. Lemma empty_union_2 : Empty s -> union s' s [=] s'. Proof. fsetdec. Qed. Lemma not_in_union : ~In x s -> ~In x s' -> ~In x (union s s'). Proof. fsetdec. Qed. Lemma inter_sym : inter s s' [=] inter s' s. Proof. fsetdec. Qed. Lemma inter_subset_equal : s[<=]s' -> inter s s' [=] s. Proof. fsetdec. Qed. Lemma inter_equal_1 : s[=]s' -> inter s s'' [=] inter s' s''. Proof. fsetdec. Qed. Lemma inter_equal_2 : s'[=]s'' -> inter s s' [=] inter s s''. Proof. fsetdec. Qed. Lemma inter_assoc : inter (inter s s') s'' [=] inter s (inter s' s''). Proof. fsetdec. Qed. Lemma union_inter_1 : inter (union s s') s'' [=] union (inter s s'') (inter s' s''). Proof. fsetdec. Qed. Lemma union_inter_2 : union (inter s s') s'' [=] inter (union s s'') (union s' s''). Proof. fsetdec. Qed. Lemma inter_add_1 : In x s' -> inter (add x s) s' [=] add x (inter s s'). Proof. fsetdec. Qed. Lemma inter_add_2 : ~ In x s' -> inter (add x s) s' [=] inter s s'. Proof. fsetdec. Qed. Lemma empty_inter_1 : Empty s -> Empty (inter s s'). Proof. fsetdec. Qed. Lemma empty_inter_2 : Empty s' -> Empty (inter s s'). Proof. fsetdec. Qed. Lemma inter_subset_1 : inter s s' [<=] s. Proof. fsetdec. Qed. Lemma inter_subset_2 : inter s s' [<=] s'. Proof. fsetdec. Qed. Lemma inter_subset_3 : s''[<=]s -> s''[<=]s' -> s''[<=] inter s s'. Proof. fsetdec. Qed. Lemma empty_diff_1 : Empty s -> Empty (diff s s'). Proof. fsetdec. Qed. Lemma empty_diff_2 : Empty s -> diff s' s [=] s'. Proof. fsetdec. Qed. Lemma diff_subset : diff s s' [<=] s. Proof. fsetdec. Qed. Lemma diff_subset_equal : s[<=]s' -> diff s s' [=] empty. Proof. fsetdec. Qed. Lemma remove_diff_singleton : remove x s [=] diff s (singleton x). Proof. fsetdec. Qed. Lemma diff_inter_empty : inter (diff s s') (inter s s') [=] empty. Proof. fsetdec. Qed. Lemma diff_inter_all : union (diff s s') (inter s s') [=] s. Proof. fsetdec. Qed. Lemma Add_add : Add x s (add x s). Proof. expAdd; fsetdec. Qed. Lemma Add_remove : In x s -> Add x (remove x s) s. Proof. expAdd; fsetdec. Qed. Lemma union_Add : Add x s s' -> Add x (union s s'') (union s' s''). Proof. expAdd; fsetdec. Qed. Lemma inter_Add : In x s'' -> Add x s s' -> Add x (inter s s'') (inter s' s''). Proof. expAdd; fsetdec. Qed. Lemma union_Equal : In x s'' -> Add x s s' -> union s s'' [=] union s' s''. Proof. expAdd; fsetdec. Qed. Lemma inter_Add_2 : ~In x s'' -> Add x s s' -> inter s s'' [=] inter s' s''. Proof. expAdd; fsetdec. Qed. End BasicProperties. #[global] Hint Immediate equal_sym add_remove remove_add union_sym inter_sym: set. #[global] Hint Resolve equal_refl equal_trans subset_refl subset_equal subset_antisym subset_trans subset_empty subset_remove_3 subset_diff subset_add_3 subset_add_2 in_subset empty_is_empty_1 empty_is_empty_2 add_equal remove_equal singleton_equal_add union_subset_equal union_equal_1 union_equal_2 union_assoc add_union_singleton union_add union_subset_1 union_subset_2 union_subset_3 inter_subset_equal inter_equal_1 inter_equal_2 inter_assoc union_inter_1 union_inter_2 inter_add_1 inter_add_2 empty_inter_1 empty_inter_2 empty_union_1 empty_union_2 empty_diff_1 empty_diff_2 union_Add inter_Add union_Equal inter_Add_2 not_in_union inter_subset_1 inter_subset_2 inter_subset_3 diff_subset diff_subset_equal remove_diff_singleton diff_inter_empty diff_inter_all Add_add Add_remove Equal_remove add_add : set. (** * Properties of elements *) Lemma elements_Empty : forall s, Empty s <-> elements s = nil. Proof. intros. unfold Empty. split; intros. - assert (forall a, ~ List.In a (elements s)). { red; intros. apply (H a). rewrite elements_iff. rewrite InA_alt; exists a; auto with relations. } destruct (elements s); auto. elim (H0 e); simpl; auto. - red; intros. rewrite elements_iff in H0. rewrite InA_alt in H0; destruct H0. rewrite H in H0; destruct H0 as (_,H0); inversion H0. Qed. Lemma elements_empty : elements empty = nil. Proof. rewrite <-elements_Empty; auto with set. Qed. (** * Conversions between lists and sets *) Definition of_list (l : list elt) := List.fold_right add empty l. Definition to_list := elements. Lemma of_list_1 : forall l x, In x (of_list l) <-> InA E.eq x l. Proof. induction l; simpl; intro x. - rewrite empty_iff, InA_nil. intuition. - rewrite add_iff, InA_cons, IHl. intuition. Qed. Lemma of_list_2 : forall l, equivlistA E.eq (to_list (of_list l)) l. Proof. unfold to_list; red; intros. rewrite <- elements_iff; apply of_list_1. Qed. Lemma of_list_3 : forall s, of_list (to_list s) [=] s. Proof. unfold to_list; red; intros. rewrite of_list_1; symmetry; apply elements_iff. Qed. (** * Fold *) Section Fold. Notation NoDup := (NoDupA E.eq). Notation InA := (InA E.eq). (** Alternative specification via [fold_right] *) Lemma fold_spec_right (s:t)(A:Type)(i:A)(f : elt -> A -> A) : fold f s i = List.fold_right f i (rev (elements s)). Proof. rewrite fold_spec. symmetry. apply fold_left_rev_right. Qed. (** ** Induction principles for fold (contributed by S. Lescuyer) *) (** In the following lemma, the step hypothesis is deliberately restricted to the precise set s we are considering. *) Theorem fold_rec : forall (A:Type)(P : t -> A -> Type)(f : elt -> A -> A)(i:A)(s:t), (forall s', Empty s' -> P s' i) -> (forall x a s' s'', In x s -> ~In x s' -> Add x s' s'' -> P s' a -> P s'' (f x a)) -> P s (fold f s i). Proof. intros A P f i s Pempty Pstep. rewrite fold_spec_right. set (l:=rev (elements s)). assert (Pstep' : forall x a s' s'', InA x l -> ~In x s' -> Add x s' s'' -> P s' a -> P s'' (f x a)). { intros; eapply Pstep; eauto. rewrite elements_iff, <- InA_rev; auto with *. } assert (Hdup : NoDup l) by (unfold l; eauto using elements_3w, NoDupA_rev with *). assert (Hsame : forall x, In x s <-> InA x l) by (unfold l; intros; rewrite elements_iff, InA_rev; intuition). clear Pstep; clearbody l; revert s Hsame; induction l. - (* empty *) intros s Hsame; simpl. apply Pempty. intro x. rewrite Hsame, InA_nil; intuition. - (* step *) intros s Hsame; simpl. apply Pstep' with (of_list l); auto with relations. + inversion_clear Hdup; rewrite of_list_1; auto. + red. intros. rewrite Hsame, of_list_1, InA_cons; intuition. + apply IHl. * intros; eapply Pstep'; eauto. * inversion_clear Hdup; auto. * exact (of_list_1 l). Qed. (** Same, with [empty] and [add] instead of [Empty] and [Add]. In this case, [P] must be compatible with equality of sets *) Theorem fold_rec_bis : forall (A:Type)(P : t -> A -> Type)(f : elt -> A -> A)(i:A)(s:t), (forall s s' a, s[=]s' -> P s a -> P s' a) -> (P empty i) -> (forall x a s', In x s -> ~In x s' -> P s' a -> P (add x s') (f x a)) -> P s (fold f s i). Proof. intros A P f i s Pmorphism Pempty Pstep. apply fold_rec; intros. - apply Pmorphism with empty; auto with set. - rewrite Add_Equal in H1; auto with set. apply Pmorphism with (add x s'); auto with set. Qed. Lemma fold_rec_nodep : forall (A:Type)(P : A -> Type)(f : elt -> A -> A)(i:A)(s:t), P i -> (forall x a, In x s -> P a -> P (f x a)) -> P (fold f s i). Proof. intros; apply fold_rec_bis with (P:=fun _ => P); auto. Qed. (** [fold_rec_weak] is a weaker principle than [fold_rec_bis] : the step hypothesis must here be applicable to any [x]. At the same time, it looks more like an induction principle, and hence can be easier to use. *) Lemma fold_rec_weak : forall (A:Type)(P : t -> A -> Type)(f : elt -> A -> A)(i:A), (forall s s' a, s[=]s' -> P s a -> P s' a) -> P empty i -> (forall x a s, ~In x s -> P s a -> P (add x s) (f x a)) -> forall s, P s (fold f s i). Proof. intros; apply fold_rec_bis; auto. Qed. Lemma fold_rel : forall (A B:Type)(R : A -> B -> Type) (f : elt -> A -> A)(g : elt -> B -> B)(i : A)(j : B)(s : t), R i j -> (forall x a b, In x s -> R a b -> R (f x a) (g x b)) -> R (fold f s i) (fold g s j). Proof. intros A B R f g i j s Rempty Rstep. rewrite 2 fold_spec_right. set (l:=rev (elements s)). assert (Rstep' : forall x a b, InA x l -> R a b -> R (f x a) (g x b)) by (intros; apply Rstep; auto; rewrite elements_iff, <- InA_rev; auto with *). clearbody l; clear Rstep s. induction l; simpl; auto with relations. Qed. (** From the induction principle on [fold], we can deduce some general induction principles on sets. *) Lemma set_induction : forall P : t -> Type, (forall s, Empty s -> P s) -> (forall s s', P s -> forall x, ~In x s -> Add x s s' -> P s') -> forall s, P s. Proof. intros. apply (@fold_rec _ (fun s _ => P s) (fun _ _ => tt) tt s); eauto. Qed. Lemma set_induction_bis : forall P : t -> Type, (forall s s', s [=] s' -> P s -> P s') -> P empty -> (forall x s, ~In x s -> P s -> P (add x s)) -> forall s, P s. Proof. intros. apply (@fold_rec_bis _ (fun s _ => P s) (fun _ _ => tt) tt s); eauto. Qed. (** [fold] can be used to reconstruct the same initial set. *) Lemma fold_identity : forall s, fold add s empty [=] s. Proof. intros. apply fold_rec with (P:=fun s acc => acc[=]s); auto with set. intros. rewrite H2; rewrite Add_Equal in H1; auto with set. Qed. (** ** Alternative (weaker) specifications for [fold] *) (** When [MSets] was first designed, the order in which Ocaml's [Set.fold] takes the set elements was unspecified. This specification reflects this fact: *) Lemma fold_0 : forall s (A : Type) (i : A) (f : elt -> A -> A), exists l : list elt, NoDup l /\ (forall x : elt, In x s <-> InA x l) /\ fold f s i = fold_right f i l. Proof. intros; exists (rev (elements s)); split. - apply NoDupA_rev; auto with *. - split; intros. + rewrite elements_iff; do 2 rewrite InA_alt. split; destruct 1; generalize (In_rev (elements s) x0); exists x0; intuition. + apply fold_spec_right. Qed. (** An alternate (and previous) specification for [fold] was based on the recursive structure of a set. It is now lemmas [fold_1] and [fold_2]. *) Lemma fold_1 : forall s (A : Type) (eqA : A -> A -> Prop) (st : Equivalence eqA) (i : A) (f : elt -> A -> A), Empty s -> eqA (fold f s i) i. Proof. unfold Empty; intros; destruct (fold_0 s i f) as (l,(H1, (H2, H3))). rewrite H3; clear H3. generalize H H2; clear H H2; case l; simpl; intros. - reflexivity. - elim (H e). elim (H2 e); intuition. Qed. Lemma fold_2 : forall s s' x (A : Type) (eqA : A -> A -> Prop) (st : Equivalence eqA) (i : A) (f : elt -> A -> A), Proper (E.eq==>eqA==>eqA) f -> transpose eqA f -> ~ In x s -> Add x s s' -> eqA (fold f s' i) (f x (fold f s i)). Proof. intros; destruct (fold_0 s i f) as (l,(Hl, (Hl1, Hl2))); destruct (fold_0 s' i f) as (l',(Hl', (Hl'1, Hl'2))). rewrite Hl2; rewrite Hl'2; clear Hl2 Hl'2. apply fold_right_add with (eqA:=E.eq)(eqB:=eqA); auto. - eauto with *. - rewrite <- Hl1; auto. - intros a; rewrite InA_cons; rewrite <- Hl1; rewrite <- Hl'1; rewrite (H2 a); intuition. Qed. (** In fact, [fold] on empty sets is more than equivalent to the initial element, it is Leibniz-equal to it. *) Lemma fold_1b : forall s (A : Type)(i : A) (f : elt -> A -> A), Empty s -> (fold f s i) = i. Proof. intros. rewrite FM.fold_1. rewrite elements_Empty in H; rewrite H; simpl; auto. Qed. Section Fold_More. Variables (A:Type)(eqA:A->A->Prop)(st:Equivalence eqA). Variables (f:elt->A->A)(Comp:Proper (E.eq==>eqA==>eqA) f)(Ass:transpose eqA f). Lemma fold_commutes : forall i s x, eqA (fold f s (f x i)) (f x (fold f s i)). Proof. intros. apply fold_rel with (R:=fun u v => eqA u (f x v)); intros. - reflexivity. - transitivity (f x0 (f x b)); auto. apply Comp; auto with relations. Qed. (** ** Fold is a morphism *) Lemma fold_init : forall i i' s, eqA i i' -> eqA (fold f s i) (fold f s i'). Proof. intros. apply fold_rel with (R:=eqA); auto. intros; apply Comp; auto with relations. Qed. Lemma fold_equal : forall i s s', s[=]s' -> eqA (fold f s i) (fold f s' i). Proof. intros i s; pattern s; apply set_induction; clear s; intros. - transitivity i. + apply fold_1; auto. + symmetry; apply fold_1; auto. rewrite <- H0; auto. - transitivity (f x (fold f s i)). + apply fold_2 with (eqA := eqA); auto. + symmetry; apply fold_2 with (eqA := eqA); auto. unfold Add in *; intros. rewrite <- H2; auto. Qed. (** ** Fold and other set operators *) Lemma fold_empty : forall i, fold f empty i = i. Proof. intros i; apply fold_1b; auto with set. Qed. Lemma fold_add : forall i s x, ~In x s -> eqA (fold f (add x s) i) (f x (fold f s i)). Proof. intros; apply fold_2 with (eqA := eqA); auto with set. Qed. Lemma add_fold : forall i s x, In x s -> eqA (fold f (add x s) i) (fold f s i). Proof. intros; apply fold_equal; auto with set. Qed. Lemma remove_fold_1: forall i s x, In x s -> eqA (f x (fold f (remove x s) i)) (fold f s i). Proof. intros. symmetry. apply fold_2 with (eqA:=eqA); auto with set relations. Qed. Lemma remove_fold_2: forall i s x, ~In x s -> eqA (fold f (remove x s) i) (fold f s i). Proof. intros. apply fold_equal; auto with set. Qed. Lemma fold_union_inter : forall i s s', eqA (fold f (union s s') (fold f (inter s s') i)) (fold f s (fold f s' i)). Proof. intros; pattern s; apply set_induction; clear s; intros. - transitivity (fold f s' (fold f (inter s s') i)). { apply fold_equal; auto with set. } transitivity (fold f s' i). { apply fold_init; auto. apply fold_1; auto with set. } symmetry; apply fold_1; auto. - rename s'0 into s''. destruct (In_dec x s'). + (* In x s' *) transitivity (fold f (union s'' s') (f x (fold f (inter s s') i))); auto with set. { apply fold_init; auto. apply fold_2 with (eqA:=eqA); auto with set. rewrite inter_iff; intuition. } transitivity (f x (fold f s (fold f s' i))). 1:transitivity (fold f (union s s') (f x (fold f (inter s s') i))). 2:transitivity (f x (fold f (union s s') (fold f (inter s s') i))). * apply fold_equal; auto. apply equal_sym; apply union_Equal with x; auto with set. * apply fold_commutes; auto. * apply Comp; auto with relations. * symmetry; apply fold_2 with (eqA:=eqA); auto. + (* ~(In x s') *) transitivity (f x (fold f (union s s') (fold f (inter s'' s') i))). { apply fold_2 with (eqA:=eqA); auto with set. } transitivity (f x (fold f (union s s') (fold f (inter s s') i))). { apply Comp;auto with relations. apply fold_init;auto. apply fold_equal;auto. apply equal_sym; apply inter_Add_2 with x; auto with set. } transitivity (f x (fold f s (fold f s' i))). * apply Comp; auto with relations. * symmetry; apply fold_2 with (eqA:=eqA); auto. Qed. Lemma fold_diff_inter : forall i s s', eqA (fold f (diff s s') (fold f (inter s s') i)) (fold f s i). Proof. intros. transitivity (fold f (union (diff s s') (inter s s')) (fold f (inter (diff s s') (inter s s')) i)). 1:symmetry; apply fold_union_inter; auto. transitivity (fold f s (fold f (inter (diff s s') (inter s s')) i)). - apply fold_equal; auto with set. - apply fold_init; auto. apply fold_1; auto with set. Qed. Lemma fold_union: forall i s s', (forall x, ~(In x s/\In x s')) -> eqA (fold f (union s s') i) (fold f s (fold f s' i)). Proof. intros. transitivity (fold f (union s s') (fold f (inter s s') i)). { apply fold_init; auto. symmetry; apply fold_1; auto with set. unfold Empty; intro a; generalize (H a); set_iff; tauto. } apply fold_union_inter; auto. Qed. End Fold_More. Lemma fold_plus : forall s p, fold (fun _ => S) s p = fold (fun _ => S) s 0 + p. Proof. intros. apply fold_rel with (R:=fun u v => u = v + p); simpl; auto. Qed. End Fold. (** * Cardinal *) (** ** Characterization of cardinal in terms of fold *) Lemma cardinal_fold : forall s, cardinal s = fold (fun _ => S) s 0. Proof. intros; rewrite cardinal_1; rewrite FM.fold_1. symmetry; apply fold_left_S_O; auto. Qed. (** ** Old specifications for [cardinal]. *) Lemma cardinal_0 : forall s, exists l : list elt, NoDupA E.eq l /\ (forall x : elt, In x s <-> InA E.eq x l) /\ cardinal s = length l. Proof. intros; exists (elements s); intuition auto with set; apply cardinal_1. Qed. Lemma cardinal_1 : forall s, Empty s -> cardinal s = 0. Proof. intros; rewrite cardinal_fold; apply fold_1; auto with *. Qed. Lemma cardinal_2 : forall s s' x, ~ In x s -> Add x s s' -> cardinal s' = S (cardinal s). Proof. intros; do 2 rewrite cardinal_fold. change S with ((fun _ => S) x). apply fold_2; auto. - split; congruence. - congruence. Qed. (** ** Cardinal and (non-)emptiness *) Lemma cardinal_Empty : forall s, Empty s <-> cardinal s = 0. Proof. intros. rewrite elements_Empty, FM.cardinal_1. destruct (elements s); intuition; discriminate. Qed. Lemma cardinal_inv_1 : forall s, cardinal s = 0 -> Empty s. Proof. intros; rewrite cardinal_Empty; auto. Qed. #[global] Hint Resolve cardinal_inv_1 : core. Lemma cardinal_inv_2 : forall s n, cardinal s = S n -> { x : elt | In x s }. Proof. intros; rewrite FM.cardinal_1 in H. generalize (elements_2 (s:=s)). destruct (elements s); try discriminate. exists e; auto with relations. Qed. Lemma cardinal_inv_2b : forall s, cardinal s <> 0 -> { x : elt | In x s }. Proof. intro; generalize (@cardinal_inv_2 s); destruct cardinal; [intuition|eauto]. Qed. (** ** Cardinal is a morphism *) Lemma Equal_cardinal : forall s s', s[=]s' -> cardinal s = cardinal s'. Proof. symmetry. remember (cardinal s) as n; symmetry in Heqn; revert s s' Heqn H. induction n; intros. - apply cardinal_1; rewrite <- H; auto. - destruct (cardinal_inv_2 Heqn) as (x,H2). revert Heqn. rewrite (cardinal_2 (s:=remove x s) (s':=s) (x:=x)); auto with set relations. rewrite (cardinal_2 (s:=remove x s') (s':=s') (x:=x)); eauto with set relations. Qed. #[global] Instance cardinal_m : Proper (Equal==>Logic.eq) cardinal. Proof. exact Equal_cardinal. Qed. #[global] Hint Resolve Add_add Add_remove Equal_remove cardinal_inv_1 Equal_cardinal : core. (** ** Cardinal and set operators *) Lemma empty_cardinal : cardinal empty = 0. Proof. rewrite cardinal_fold; apply fold_1; auto with *. Qed. #[global] Hint Immediate empty_cardinal cardinal_1 : set. Lemma singleton_cardinal : forall x, cardinal (singleton x) = 1. Proof. intros. rewrite (singleton_equal_add x). replace 0 with (cardinal empty); auto with set. apply cardinal_2 with x; auto with set. Qed. #[global] Hint Resolve singleton_cardinal: set. Lemma diff_inter_cardinal : forall s s', cardinal (diff s s') + cardinal (inter s s') = cardinal s . Proof. intros; do 3 rewrite cardinal_fold. rewrite <- fold_plus. apply fold_diff_inter with (eqA:=@Logic.eq nat); auto with *. congruence. Qed. Lemma union_cardinal: forall s s', (forall x, ~(In x s/\In x s')) -> cardinal (union s s')=cardinal s+cardinal s'. Proof. intros; do 3 rewrite cardinal_fold. rewrite <- fold_plus. apply fold_union; auto. - split; congruence. - congruence. Qed. Lemma subset_cardinal : forall s s', s[<=]s' -> cardinal s <= cardinal s' . Proof. intros. rewrite <- (diff_inter_cardinal s' s). rewrite (inter_sym s' s). rewrite (inter_subset_equal H). apply Nat.le_add_l. Qed. Lemma subset_cardinal_lt : forall s s' x, s[<=]s' -> In x s' -> ~In x s -> cardinal s < cardinal s'. Proof. intros. rewrite <- (diff_inter_cardinal s' s). rewrite (inter_sym s' s). rewrite (inter_subset_equal H). generalize (@cardinal_inv_1 (diff s' s)). destruct (cardinal (diff s' s)). - intro H2; destruct (H2 (eq_refl _) x). set_iff; auto. - intros _. change (0 + cardinal s < S n + cardinal s). apply Nat.add_lt_le_mono; [ apply Nat.lt_0_succ | reflexivity ]. Qed. Theorem union_inter_cardinal : forall s s', cardinal (union s s') + cardinal (inter s s') = cardinal s + cardinal s' . Proof. intros. do 4 rewrite cardinal_fold. do 2 rewrite <- fold_plus. apply fold_union_inter with (eqA:=@Logic.eq nat); auto with *. congruence. Qed. Lemma union_cardinal_inter : forall s s', cardinal (union s s') = cardinal s + cardinal s' - cardinal (inter s s'). Proof. intros. rewrite <- union_inter_cardinal, Nat.add_sub. reflexivity. Qed. Lemma union_cardinal_le : forall s s', cardinal (union s s') <= cardinal s + cardinal s'. Proof. intros; generalize (union_inter_cardinal s s'). intros; rewrite <- H; auto with arith. Qed. Lemma add_cardinal_1 : forall s x, In x s -> cardinal (add x s) = cardinal s. Proof. auto with set. Qed. Lemma add_cardinal_2 : forall s x, ~In x s -> cardinal (add x s) = S (cardinal s). Proof. intros. do 2 rewrite cardinal_fold. change S with ((fun _ => S) x); apply fold_add with (eqA:=@Logic.eq nat); auto with *. congruence. Qed. Lemma remove_cardinal_1 : forall s x, In x s -> S (cardinal (remove x s)) = cardinal s. Proof. intros. do 2 rewrite cardinal_fold. change S with ((fun _ =>S) x). apply remove_fold_1 with (eqA:=@Logic.eq nat); auto with *. congruence. Qed. Lemma remove_cardinal_2 : forall s x, ~In x s -> cardinal (remove x s) = cardinal s. Proof. auto with set. Qed. #[global] Hint Resolve subset_cardinal union_cardinal add_cardinal_1 add_cardinal_2 : core. End WPropertiesOn. (** Now comes variants for self-contained weak sets and for full sets. For these variants, only one argument is necessary. Thanks to the subtyping [WS<=S], the [Properties] functor which is meant to be used on modules [(M:S)] can simply be an alias of [WProperties]. *) Module WProperties (M:WSets) := WPropertiesOn M.E M. Module Properties := WProperties. (** Now comes some properties specific to the element ordering, invalid for Weak Sets. *) Module OrdProperties (M:Sets). Module Import ME:=OrderedTypeFacts(M.E). Module Import ML:=OrderedTypeLists(M.E). Module Import P := Properties M. Import FM. Import M.E. Import M. #[global] Hint Resolve elements_spec2 : core. #[global] Hint Immediate min_elt_spec1 min_elt_spec2 min_elt_spec3 max_elt_spec1 max_elt_spec2 max_elt_spec3 : set. (** First, a specialized version of SortA_equivlistA_eqlistA: *) Lemma sort_equivlistA_eqlistA : forall l l' : list elt, sort E.lt l -> sort E.lt l' -> equivlistA E.eq l l' -> eqlistA E.eq l l'. Proof. apply SortA_equivlistA_eqlistA; eauto with *. Qed. Definition gtb x y := match E.compare x y with Gt => true | _ => false end. Definition leb x := fun y => negb (gtb x y). Definition elements_lt x s := List.filter (gtb x) (elements s). Definition elements_ge x s := List.filter (leb x) (elements s). Lemma gtb_1 : forall x y, gtb x y = true <-> E.lt y x. Proof. intros; rewrite <- compare_gt_iff. unfold gtb. destruct E.compare; intuition; try discriminate. Qed. Lemma leb_1 : forall x y, leb x y = true <-> ~E.lt y x. Proof. intros; rewrite <- compare_gt_iff. unfold leb, gtb. destruct E.compare; intuition; try discriminate. Qed. #[global] Instance gtb_compat x : Proper (E.eq==>Logic.eq) (gtb x). Proof. intros a b H. unfold gtb. rewrite H; auto. Qed. #[global] Instance leb_compat x : Proper (E.eq==>Logic.eq) (leb x). Proof. intros a b H; unfold leb. rewrite H; auto. Qed. #[global] Hint Resolve gtb_compat leb_compat : core. Lemma elements_split : forall x s, elements s = elements_lt x s ++ elements_ge x s. Proof. unfold elements_lt, elements_ge, leb; intros. eapply (@filter_split _ E.eq); eauto with *. intros. rewrite gtb_1 in H. assert (~E.lt y x). { unfold gtb in *; elim_compare x y; intuition; try discriminate; order. } order. Qed. Lemma elements_Add : forall s s' x, ~In x s -> Add x s s' -> eqlistA E.eq (elements s') (elements_lt x s ++ x :: elements_ge x s). Proof. intros; unfold elements_ge, elements_lt. apply sort_equivlistA_eqlistA; auto with set. - apply (@SortA_app _ E.eq); auto with *. + apply (@filter_sort _ E.eq); auto with *; eauto with *. + constructor; auto. * apply (@filter_sort _ E.eq); auto with *; eauto with *. * rewrite Inf_alt by (apply (@filter_sort _ E.eq); eauto with *). intros. rewrite filter_InA in H1; auto with *; destruct H1. rewrite leb_1 in H2. rewrite <- elements_iff in H1. assert (~E.eq x y). { contradict H; rewrite H; auto. } order. + intros. rewrite filter_InA in H1; auto with *; destruct H1. rewrite gtb_1 in H3. inversion_clear H2. * order. * rewrite filter_InA in H4; auto with *; destruct H4. rewrite leb_1 in H4. order. - red; intros a. rewrite InA_app_iff, InA_cons, !filter_InA, <-!elements_iff, leb_1, gtb_1, (H0 a) by (auto with *). intuition. elim_compare a x; intuition. right; right; split; auto. order. Qed. Definition Above x s := forall y, In y s -> E.lt y x. Definition Below x s := forall y, In y s -> E.lt x y. Lemma elements_Add_Above : forall s s' x, Above x s -> Add x s s' -> eqlistA E.eq (elements s') (elements s ++ x::nil). Proof. intros. apply sort_equivlistA_eqlistA; auto with set. - apply (@SortA_app _ E.eq); auto with *. intros. invlist InA. rewrite <- elements_iff in H1. setoid_replace y with x; auto. - red; intros a. rewrite InA_app_iff, InA_cons, InA_nil, <-!elements_iff, (H0 a) by (auto with *). intuition. Qed. Lemma elements_Add_Below : forall s s' x, Below x s -> Add x s s' -> eqlistA E.eq (elements s') (x::elements s). Proof. intros. apply sort_equivlistA_eqlistA; auto with set. - change (sort E.lt ((x::nil) ++ elements s)). apply (@SortA_app _ E.eq); auto with *. intros. invlist InA. rewrite <- elements_iff in H2. setoid_replace x0 with x; auto. - red; intros a. rewrite InA_cons, <- !elements_iff, (H0 a); intuition. Qed. (** Two other induction principles on sets: we can be more restrictive on the element we add at each step. *) Lemma set_induction_max : forall P : t -> Type, (forall s : t, Empty s -> P s) -> (forall s s', P s -> forall x, Above x s -> Add x s s' -> P s') -> forall s : t, P s. Proof. intros; remember (cardinal s) as n; revert s Heqn; induction n; intros; auto. case_eq (max_elt s); intros. - apply X0 with (remove e s) e; auto with set. + apply IHn. assert (S n = S (cardinal (remove e s))). { rewrite Heqn; apply cardinal_2 with e; auto with set relations. } inversion H0; auto. + red; intros. rewrite remove_iff in H0; destruct H0. generalize (@max_elt_spec2 s e y H H0); order. - assert (H0:=max_elt_spec3 H). rewrite cardinal_Empty in H0; rewrite H0 in Heqn; inversion Heqn. Qed. Lemma set_induction_min : forall P : t -> Type, (forall s : t, Empty s -> P s) -> (forall s s', P s -> forall x, Below x s -> Add x s s' -> P s') -> forall s : t, P s. Proof. intros; remember (cardinal s) as n; revert s Heqn; induction n; intros; auto. case_eq (min_elt s); intros. - apply X0 with (remove e s) e; auto with set. + apply IHn. assert (S n = S (cardinal (remove e s))). { rewrite Heqn; apply cardinal_2 with e; auto with set relations. } inversion H0; auto. + red; intros. rewrite remove_iff in H0; destruct H0. generalize (@min_elt_spec2 s e y H H0); order. - assert (H0:=min_elt_spec3 H). rewrite cardinal_Empty in H0; auto; rewrite H0 in Heqn; inversion Heqn. Qed. (** More properties of [fold] : behavior with respect to Above/Below *) Lemma fold_3 : forall s s' x (A : Type) (eqA : A -> A -> Prop) (st : Equivalence eqA) (i : A) (f : elt -> A -> A), Proper (E.eq==>eqA==>eqA) f -> Above x s -> Add x s s' -> eqA (fold f s' i) (f x (fold f s i)). Proof. intros. rewrite 2 fold_spec_right. change (f x (fold_right f i (rev (elements s)))) with (fold_right f i (rev (x::nil)++rev (elements s))). apply (@fold_right_eqlistA E.t E.eq A eqA st); auto with *. rewrite <- distr_rev. apply eqlistA_rev. apply elements_Add_Above; auto. Qed. Lemma fold_4 : forall s s' x (A : Type) (eqA : A -> A -> Prop) (st : Equivalence eqA) (i : A) (f : elt -> A -> A), Proper (E.eq==>eqA==>eqA) f -> Below x s -> Add x s s' -> eqA (fold f s' i) (fold f s (f x i)). Proof. intros. rewrite !fold_spec. change (eqA (fold_left (flip f) (elements s') i) (fold_left (flip f) (x::elements s) i)). unfold flip; rewrite <-!fold_left_rev_right. apply (@fold_right_eqlistA E.t E.eq A eqA st); auto. apply eqlistA_rev. apply elements_Add_Below; auto. Qed. (** The following results have already been proved earlier, but we can now prove them with one hypothesis less: no need for [(transpose eqA f)]. *) Section FoldOpt. Variables (A:Type)(eqA:A->A->Prop)(st:Equivalence eqA). Variables (f:elt->A->A)(Comp:Proper (E.eq==>eqA==>eqA) f). Lemma fold_equal : forall i s s', s[=]s' -> eqA (fold f s i) (fold f s' i). Proof. intros. rewrite 2 fold_spec_right. apply (@fold_right_eqlistA E.t E.eq A eqA st); auto. apply eqlistA_rev. apply sort_equivlistA_eqlistA; auto with set. red; intro a; do 2 rewrite <- elements_iff; auto. Qed. Lemma add_fold : forall i s x, In x s -> eqA (fold f (add x s) i) (fold f s i). Proof. intros; apply fold_equal; auto with set. Qed. Lemma remove_fold_2: forall i s x, ~In x s -> eqA (fold f (remove x s) i) (fold f s i). Proof. intros. apply fold_equal; auto with set. Qed. End FoldOpt. (** An alternative version of [choose_3] *) Lemma choose_equal : forall s s', Equal s s' -> match choose s, choose s' with | Some x, Some x' => E.eq x x' | None, None => True | _, _ => False end. Proof. intros s s' H; generalize (@choose_spec1 s)(@choose_spec2 s) (@choose_spec1 s')(@choose_spec2 s')(@choose_spec3 s s'); destruct (choose s); destruct (choose s'); simpl; intuition. - apply H5 with e; rewrite <-H; auto. - apply H5 with e; rewrite H; auto. Qed. End OrdProperties. coq-8.20.0/theories/MSets/MSetRBT.v000066400000000000000000001530151466560755400166760ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* option (elt * t). Axiom remove_min_spec1 : forall s k s', remove_min s = Some (k,s') -> min_elt s = Some k /\ remove k s [=] s'. Axiom remove_min_spec2 : forall s, remove_min s = None -> Empty s. End MSetRemoveMin. (** The type of color annotation. *) Inductive color := Red | Black. Module Color. Definition t := color. End Color. (** * Ops : the pure functions *) Module Ops (X:Orders.OrderedType) <: MSetInterface.Ops X. (** ** Generic trees instantiated with color *) (** We reuse a generic definition of trees where the information parameter is a color. Functions like mem or fold are also provided by this generic functor. *) Include MSetGenTree.Ops X Color. Definition t := tree. Local Notation Rd := (Node Red). Local Notation Bk := (Node Black). (** ** Basic tree *) Definition singleton (k: elt) : tree := Bk Leaf k Leaf. (** ** Changing root color *) Definition makeBlack t := match t with | Leaf => Leaf | Node _ a x b => Bk a x b end. Definition makeRed t := match t with | Leaf => Leaf | Node _ a x b => Rd a x b end. (** ** Balancing *) (** We adapt when one side is not a true red-black tree. Both sides have the same black depth. *) Definition lbal l k r := match l with | Rd (Rd a x b) y c => Rd (Bk a x b) y (Bk c k r) | Rd a x (Rd b y c) => Rd (Bk a x b) y (Bk c k r) | _ => Bk l k r end. Definition rbal l k r := match r with | Rd (Rd b y c) z d => Rd (Bk l k b) y (Bk c z d) | Rd b y (Rd c z d) => Rd (Bk l k b) y (Bk c z d) | _ => Bk l k r end. (** A variant of [rbal], with reverse pattern order. Is it really useful ? Should we always use it ? *) Definition rbal' l k r := match r with | Rd b y (Rd c z d) => Rd (Bk l k b) y (Bk c z d) | Rd (Rd b y c) z d => Rd (Bk l k b) y (Bk c z d) | _ => Bk l k r end. (** Balancing with different black depth. One side is almost a red-black tree, while the other is a true red-black tree, but with black depth + 1. Used in deletion. *) Definition lbalS l k r := match l with | Rd a x b => Rd (Bk a x b) k r | _ => match r with | Bk a y b => rbal' l k (Rd a y b) | Rd (Bk a y b) z c => Rd (Bk l k a) y (rbal' b z (makeRed c)) | _ => Rd l k r (* impossible *) end end. Definition rbalS l k r := match r with | Rd b y c => Rd l k (Bk b y c) | _ => match l with | Bk a x b => lbal (Rd a x b) k r | Rd a x (Bk b y c) => Rd (lbal (makeRed a) x b) y (Bk c k r) | _ => Rd l k r (* impossible *) end end. (** ** Insertion *) Fixpoint ins x s := match s with | Leaf => Rd Leaf x Leaf | Node c l y r => match X.compare x y with | Eq => s | Lt => match c with | Red => Rd (ins x l) y r | Black => lbal (ins x l) y r end | Gt => match c with | Red => Rd l y (ins x r) | Black => rbal l y (ins x r) end end end. Definition add x s := makeBlack (ins x s). (** ** Deletion *) Fixpoint append (l:tree) : tree -> tree := match l with | Leaf => fun r => r | Node lc ll lx lr => fix append_l (r:tree) : tree := match r with | Leaf => l | Node rc rl rx rr => match lc, rc with | Red, Red => let lrl := append lr rl in match lrl with | Rd lr' x rl' => Rd (Rd ll lx lr') x (Rd rl' rx rr) | _ => Rd ll lx (Rd lrl rx rr) end | Black, Black => let lrl := append lr rl in match lrl with | Rd lr' x rl' => Rd (Bk ll lx lr') x (Bk rl' rx rr) | _ => lbalS ll lx (Bk lrl rx rr) end | Black, Red => Rd (append_l rl) rx rr | Red, Black => Rd ll lx (append lr r) end end end. Fixpoint del x t := match t with | Leaf => Leaf | Node _ a y b => match X.compare x y with | Eq => append a b | Lt => match a with | Bk _ _ _ => lbalS (del x a) y b | _ => Rd (del x a) y b end | Gt => match b with | Bk _ _ _ => rbalS a y (del x b) | _ => Rd a y (del x b) end end end. Definition remove x t := makeBlack (del x t). (** ** Removing minimal element *) Fixpoint delmin l x r : (elt * tree) := match l with | Leaf => (x,r) | Node lc ll lx lr => let (k,l') := delmin ll lx lr in match lc with | Black => (k, lbalS l' x r) | Red => (k, Rd l' x r) end end. Definition remove_min t : option (elt * tree) := match t with | Leaf => None | Node _ l x r => let (k,t) := delmin l x r in Some (k, makeBlack t) end. (** ** Tree-ification We rebuild a tree of size [if pred then n-1 else n] as soon as the list [l] has enough elements *) Definition bogus : tree * list elt := (Leaf, nil). Notation treeify_t := (list elt -> tree * list elt). Definition treeify_zero : treeify_t := fun acc => (Leaf,acc). Definition treeify_one : treeify_t := fun acc => match acc with | x::acc => (Rd Leaf x Leaf, acc) | _ => bogus end. Definition treeify_cont (f g : treeify_t) : treeify_t := fun acc => match f acc with | (l, x::acc) => match g acc with | (r, acc) => (Bk l x r, acc) end | _ => bogus end. Fixpoint treeify_aux (pred:bool)(n: positive) : treeify_t := match n with | xH => if pred then treeify_zero else treeify_one | xO n => treeify_cont (treeify_aux pred n) (treeify_aux true n) | xI n => treeify_cont (treeify_aux false n) (treeify_aux pred n) end. Fixpoint plength_aux (l:list elt)(p:positive) := match l with | nil => p | _::l => plength_aux l (Pos.succ p) end. Definition plength l := plength_aux l 1. Definition treeify (l:list elt) := fst (treeify_aux true (plength l) l). (** ** Filtering *) Fixpoint filter_aux (f: elt -> bool) s acc := match s with | Leaf => acc | Node _ l k r => let acc := filter_aux f r acc in if f k then filter_aux f l (k::acc) else filter_aux f l acc end. Definition filter (f: elt -> bool) (s: t) : t := treeify (filter_aux f s nil). Fixpoint partition_aux (f: elt -> bool) s acc1 acc2 := match s with | Leaf => (acc1,acc2) | Node _ sl k sr => let (acc1, acc2) := partition_aux f sr acc1 acc2 in if f k then partition_aux f sl (k::acc1) acc2 else partition_aux f sl acc1 (k::acc2) end. Definition partition (f: elt -> bool) (s:t) : t*t := let (ok,ko) := partition_aux f s nil nil in (treeify ok, treeify ko). (** ** Union, intersection, difference *) (** union of the elements of [l1] and [l2] into a third [acc] list. *) Fixpoint union_list l1 : list elt -> list elt -> list elt := match l1 with | nil => @rev_append _ | x::l1' => fix union_l1 l2 acc := match l2 with | nil => rev_append l1 acc | y::l2' => match X.compare x y with | Eq => union_list l1' l2' (x::acc) | Lt => union_l1 l2' (y::acc) | Gt => union_list l1' l2 (x::acc) end end end. Definition linear_union s1 s2 := treeify (union_list (rev_elements s1) (rev_elements s2) nil). Fixpoint inter_list l1 : list elt -> list elt -> list elt := match l1 with | nil => fun _ acc => acc | x::l1' => fix inter_l1 l2 acc := match l2 with | nil => acc | y::l2' => match X.compare x y with | Eq => inter_list l1' l2' (x::acc) | Lt => inter_l1 l2' acc | Gt => inter_list l1' l2 acc end end end. Definition linear_inter s1 s2 := treeify (inter_list (rev_elements s1) (rev_elements s2) nil). Fixpoint diff_list l1 : list elt -> list elt -> list elt := match l1 with | nil => fun _ acc => acc | x::l1' => fix diff_l1 l2 acc := match l2 with | nil => rev_append l1 acc | y::l2' => match X.compare x y with | Eq => diff_list l1' l2' acc | Lt => diff_l1 l2' acc | Gt => diff_list l1' l2 (x::acc) end end end. Definition linear_diff s1 s2 := treeify (diff_list (rev_elements s1) (rev_elements s2) nil). (** [compare_height] returns: - [Lt] if [height s2] is at least twice [height s1]; - [Gt] if [height s1] is at least twice [height s2]; - [Eq] if heights are approximately equal. Warning: this is not an equivalence relation! but who cares.... *) Definition skip_red t := match t with | Rd t' _ _ => t' | _ => t end. Definition skip_black t := match skip_red t with | Bk t' _ _ => t' | t' => t' end. Fixpoint compare_height (s1x s1 s2 s2x: tree) : comparison := match skip_red s1x, skip_red s1, skip_red s2, skip_red s2x with | Node _ s1x' _ _, Node _ s1' _ _, Node _ s2' _ _, Node _ s2x' _ _ => compare_height (skip_black s1x') s1' s2' (skip_black s2x') | _, Leaf, _, Node _ _ _ _ => Lt | Node _ _ _ _, _, Leaf, _ => Gt | Node _ s1x' _ _, Node _ s1' _ _, Node _ s2' _ _, Leaf => compare_height (skip_black s1x') s1' s2' Leaf | Leaf, Node _ s1' _ _, Node _ s2' _ _, Node _ s2x' _ _ => compare_height Leaf s1' s2' (skip_black s2x') | _, _, _, _ => Eq end. (** When one tree is quite smaller than the other, we simply adds repeatively all its elements in the big one. For trees of comparable height, we rather use [linear_union]. *) Definition union (t1 t2: t) : t := match compare_height t1 t1 t2 t2 with | Lt => fold add t1 t2 | Gt => fold add t2 t1 | Eq => linear_union t1 t2 end. Definition diff (t1 t2: t) : t := match compare_height t1 t1 t2 t2 with | Lt => filter (fun k => negb (mem k t2)) t1 | Gt => fold remove t2 t1 | Eq => linear_diff t1 t2 end. Definition inter (t1 t2: t) : t := match compare_height t1 t1 t2 t2 with | Lt => filter (fun k => mem k t2) t1 | Gt => filter (fun k => mem k t1) t2 | Eq => linear_inter t1 t2 end. End Ops. (** * MakeRaw : the pure functions and their specifications *) Module Type MakeRaw (X:Orders.OrderedType) <: MSetInterface.RawSets X. Include Ops X. (** Generic definition of binary-search-trees and proofs of specifications for generic functions such as mem or fold. *) Include MSetGenTree.Props X Color. Local Notation Rd := (Node Red). Local Notation Bk := (Node Black). Local Hint Immediate MX.eq_sym : core. Local Hint Unfold In lt_tree gt_tree Ok : core. Local Hint Constructors InT bst : core. Local Hint Resolve MX.eq_refl MX.eq_trans MX.lt_trans ok : core. Local Hint Resolve lt_leaf gt_leaf lt_tree_node gt_tree_node : core. Local Hint Resolve lt_tree_not_in lt_tree_trans gt_tree_not_in gt_tree_trans : core. Local Hint Resolve elements_spec2 : core. (** ** Singleton set *) Lemma singleton_spec x y : InT y (singleton x) <-> X.eq y x. Proof. unfold singleton; intuition_in. Qed. #[global] Instance singleton_ok x : Ok (singleton x). Proof. unfold singleton; auto. Qed. (** ** makeBlack, MakeRed *) Lemma makeBlack_spec s x : InT x (makeBlack s) <-> InT x s. Proof. destruct s; simpl; intuition_in. Qed. Lemma makeRed_spec s x : InT x (makeRed s) <-> InT x s. Proof. destruct s; simpl; intuition_in. Qed. #[global] Instance makeBlack_ok s `{Ok s} : Ok (makeBlack s). Proof. destruct s; simpl; ok. Qed. #[global] Instance makeRed_ok s `{Ok s} : Ok (makeRed s). Proof. destruct s; simpl; ok. Qed. (** ** Generic handling for red-matching and red-red-matching *) Definition isblack t := match t with Bk _ _ _ => True | _ => False end. Definition notblack t := match t with Bk _ _ _ => False | _ => True end. Definition notred t := match t with Rd _ _ _ => False | _ => True end. Definition rcase {A} f g t : A := match t with | Rd a x b => f a x b | _ => g t end. Inductive rspec {A} f g : tree -> A -> Prop := | rred a x b : rspec f g (Rd a x b) (f a x b) | relse t : notred t -> rspec f g t (g t). Fact rmatch {A} f g t : rspec (A:=A) f g t (rcase f g t). Proof. destruct t as [|[|] l x r]; simpl; now constructor. Qed. Definition rrcase {A} f g t : A := match t with | Rd (Rd a x b) y c => f a x b y c | Rd a x (Rd b y c) => f a x b y c | _ => g t end. Notation notredred := (rrcase (fun _ _ _ _ _ => False) (fun _ => True)). Inductive rrspec {A} f g : tree -> A -> Prop := | rrleft a x b y c : rrspec f g (Rd (Rd a x b) y c) (f a x b y c) | rrright a x b y c : rrspec f g (Rd a x (Rd b y c)) (f a x b y c) | rrelse t : notredred t -> rrspec f g t (g t). Fact rrmatch {A} f g t : rrspec (A:=A) f g t (rrcase f g t). Proof. destruct t as [|[|] l x r]; simpl; try now constructor. destruct l as [|[|] ll lx lr], r as [|[|] rl rx rr]; now constructor. Qed. Definition rrcase' {A} f g t : A := match t with | Rd a x (Rd b y c) => f a x b y c | Rd (Rd a x b) y c => f a x b y c | _ => g t end. Fact rrmatch' {A} f g t : rrspec (A:=A) f g t (rrcase' f g t). Proof. destruct t as [|[|] l x r]; simpl; try now constructor. destruct l as [|[|] ll lx lr], r as [|[|] rl rx rr]; now constructor. Qed. (** Balancing operations are instances of generic match *) Fact lbal_match l k r : rrspec (fun a x b y c => Rd (Bk a x b) y (Bk c k r)) (fun l => Bk l k r) l (lbal l k r). Proof. exact (rrmatch _ _ _). Qed. Fact rbal_match l k r : rrspec (fun a x b y c => Rd (Bk l k a) x (Bk b y c)) (fun r => Bk l k r) r (rbal l k r). Proof. exact (rrmatch _ _ _). Qed. Fact rbal'_match l k r : rrspec (fun a x b y c => Rd (Bk l k a) x (Bk b y c)) (fun r => Bk l k r) r (rbal' l k r). Proof. exact (rrmatch' _ _ _). Qed. Fact lbalS_match l x r : rspec (fun a y b => Rd (Bk a y b) x r) (fun l => match r with | Bk a y b => rbal' l x (Rd a y b) | Rd (Bk a y b) z c => Rd (Bk l x a) y (rbal' b z (makeRed c)) | _ => Rd l x r end) l (lbalS l x r). Proof. exact (rmatch _ _ _). Qed. Fact rbalS_match l x r : rspec (fun a y b => Rd l x (Bk a y b)) (fun r => match l with | Bk a y b => lbal (Rd a y b) x r | Rd a y (Bk b z c) => Rd (lbal (makeRed a) y b) z (Bk c x r) | _ => Rd l x r end) r (rbalS l x r). Proof. exact (rmatch _ _ _). Qed. (** ** Balancing for insertion *) Lemma lbal_spec l x r y : InT y (lbal l x r) <-> X.eq y x \/ InT y l \/ InT y r. Proof. case lbal_match; intuition_in. Qed. #[global] Instance lbal_ok l x r `(Ok l, Ok r, lt_tree x l, gt_tree x r) : Ok (lbal l x r). Proof. destruct (lbal_match l x r); ok. Qed. Lemma rbal_spec l x r y : InT y (rbal l x r) <-> X.eq y x \/ InT y l \/ InT y r. Proof. case rbal_match; intuition_in. Qed. #[global] Instance rbal_ok l x r `(Ok l, Ok r, lt_tree x l, gt_tree x r) : Ok (rbal l x r). Proof. destruct (rbal_match l x r); ok. Qed. Lemma rbal'_spec l x r y : InT y (rbal' l x r) <-> X.eq y x \/ InT y l \/ InT y r. Proof. case rbal'_match; intuition_in. Qed. #[global] Instance rbal'_ok l x r `(Ok l, Ok r, lt_tree x l, gt_tree x r) : Ok (rbal' l x r). Proof. destruct (rbal'_match l x r); ok. Qed. Global Hint Rewrite In_node_iff In_leaf_iff makeRed_spec makeBlack_spec lbal_spec rbal_spec rbal'_spec : rb. Ltac descolor := destruct_all Color.t. Ltac destree t := destruct t as [|[|] ? ? ?]. Ltac autorew := autorewrite with rb. Tactic Notation "autorew" "in" ident(H) := autorewrite with rb in H. (** ** Insertion *) Lemma ins_spec : forall s x y, InT y (ins x s) <-> X.eq y x \/ InT y s. Proof. induct s x. - intuition_in. - intuition_in. setoid_replace y with x; eauto. - descolor; autorew; rewrite IHl; intuition_in. - descolor; autorew; rewrite IHr; intuition_in. Qed. Global Hint Rewrite ins_spec : rb. #[global] Instance ins_ok s x `{Ok s} : Ok (ins x s). Proof. induct s x; auto; descolor; (apply lbal_ok || apply rbal_ok || ok); auto; intros y; autorew; intuition; order. Qed. Lemma add_spec' s x y : InT y (add x s) <-> X.eq y x \/ InT y s. Proof. unfold add. now autorew. Qed. Global Hint Rewrite add_spec' : rb. Lemma add_spec s x y `{Ok s} : InT y (add x s) <-> X.eq y x \/ InT y s. Proof. apply add_spec'. Qed. #[global] Instance add_ok s x `{Ok s} : Ok (add x s). Proof. unfold add; auto_tc. Qed. (** ** Balancing for deletion *) Lemma lbalS_spec l x r y : InT y (lbalS l x r) <-> X.eq y x \/ InT y l \/ InT y r. Proof. case lbalS_match. - intros; autorew; intuition_in. - clear l. intros l _. destruct r as [|[|] rl rx rr]. * autorew. intuition_in. * destree rl; autorew; intuition_in. * autorew. intuition_in. Qed. #[global] Instance lbalS_ok l x r : forall `(Ok l, Ok r, lt_tree x l, gt_tree x r), Ok (lbalS l x r). Proof. case lbalS_match; intros. - ok. - destruct r as [|[|] rl rx rr]. * ok. * destruct rl as [|[|] rll rlx rlr]; intros; ok. + apply rbal'_ok; ok. intros w; autorew; auto. + intros w; autorew. destruct 1 as [Hw|[Hw|Hw]]; try rewrite Hw; eauto. * ok. autorew. apply rbal'_ok; ok. Qed. Lemma rbalS_spec l x r y : InT y (rbalS l x r) <-> X.eq y x \/ InT y l \/ InT y r. Proof. case rbalS_match. - intros; autorew; intuition_in. - intros t _. destruct l as [|[|] ll lx lr]. * autorew. intuition_in. * destruct lr as [|[|] lrl lrx lrr]; autorew; intuition_in. * autorew. intuition_in. Qed. #[global] Instance rbalS_ok l x r : forall `(Ok l, Ok r, lt_tree x l, gt_tree x r), Ok (rbalS l x r). Proof. case rbalS_match; intros. - ok. - destruct l as [|[|] ll lx lr]. * ok. * destruct lr as [|[|] lrl lrx lrr]; intros; ok. + apply lbal_ok; ok. intros w; autorew; auto. + intros w; autorew. destruct 1 as [Hw|[Hw|Hw]]; try rewrite Hw; eauto. * ok. apply lbal_ok; ok. Qed. Global Hint Rewrite lbalS_spec rbalS_spec : rb. (** ** Append for deletion *) Ltac append_tac l r := induction l as [| lc ll _ lx lr IHlr]; [intro r; simpl |induction r as [| rc rl IHrl rx rr _]; [simpl |destruct lc, rc; [specialize (IHlr rl); clear IHrl |simpl; assert (Hr:notred (Bk rl rx rr)) by (simpl; trivial); set (r:=Bk rl rx rr) in *; clearbody r; clear IHrl rl rx rr; specialize (IHlr r) |change (append _ _) with (Rd (append (Bk ll lx lr) rl) rx rr); assert (Hl:notred (Bk ll lx lr)) by (simpl; trivial); set (l:=Bk ll lx lr) in *; clearbody l; clear IHlr ll lx lr |specialize (IHlr rl); clear IHrl]]]. Fact append_rr_match ll lx lr rl rx rr : rspec (fun a x b => Rd (Rd ll lx a) x (Rd b rx rr)) (fun t => Rd ll lx (Rd t rx rr)) (append lr rl) (append (Rd ll lx lr) (Rd rl rx rr)). Proof. exact (rmatch _ _ _). Qed. Fact append_bb_match ll lx lr rl rx rr : rspec (fun a x b => Rd (Bk ll lx a) x (Bk b rx rr)) (fun t => lbalS ll lx (Bk t rx rr)) (append lr rl) (append (Bk ll lx lr) (Bk rl rx rr)). Proof. exact (rmatch _ _ _). Qed. Lemma append_spec l r x : InT x (append l r) <-> InT x l \/ InT x r. Proof. revert r. append_tac l r; autorew; try tauto. - (* Red / Red *) revert IHlr; case append_rr_match; [intros a y b | intros t Ht]; autorew; tauto. - (* Black / Black *) revert IHlr; case append_bb_match; [intros a y b | intros t Ht]; autorew; tauto. Qed. Global Hint Rewrite append_spec : rb. Lemma append_ok : forall x l r `{Ok l, Ok r}, lt_tree x l -> gt_tree x r -> Ok (append l r). Proof. append_tac l r. - (* Leaf / _ *) trivial. - (* _ / Leaf *) trivial. - (* Red / Red *) intros; inv. assert (IH : Ok (append lr rl)) by (apply IHlr; eauto). clear IHlr. assert (X.lt lx rx) by (transitivity x; eauto). assert (G : gt_tree lx (append lr rl)). { intros w. autorew. destruct 1; [|transitivity x]; eauto. } assert (L : lt_tree rx (append lr rl)). { intros w. autorew. destruct 1; [transitivity x|]; eauto. } revert IH G L; case append_rr_match; intros; ok. - (* Red / Black *) intros; ok. intros w; autorew; destruct 1; eauto. - (* Black / Red *) intros; ok. intros w; autorew; destruct 1; eauto. - (* Black / Black *) intros; inv. assert (IH : Ok (append lr rl)) by (apply IHlr; eauto). clear IHlr. assert (X.lt lx rx) by (transitivity x; eauto). assert (G : gt_tree lx (append lr rl)). { intros w. autorew. destruct 1; [|transitivity x]; eauto. } assert (L : lt_tree rx (append lr rl)). { intros w. autorew. destruct 1; [transitivity x|]; eauto. } revert IH G L; case append_bb_match; intros; ok. apply lbalS_ok; ok. Qed. (** ** Deletion *) Lemma del_spec : forall s x y `{Ok s}, InT y (del x s) <-> InT y s /\ ~X.eq y x. Proof. induct s x. - intuition_in. - autorew; intuition_in. + assert (X.lt y x') by eauto. order. + assert (X.lt x' y) by eauto. order. + order. - destruct l as [|[|] ll lx lr]; autorew; rewrite ?IHl by trivial; intuition_in; order. - destruct r as [|[|] rl rx rr]; autorew; rewrite ?IHr by trivial; intuition_in; order. Qed. Global Hint Rewrite del_spec : rb. #[global] Instance del_ok s x `{Ok s} : Ok (del x s). Proof. induct s x. - trivial. - eapply append_ok; eauto. - assert (lt_tree x' (del x l)). { intro w. autorew; trivial. destruct 1. eauto. } destruct l as [|[|] ll lx lr]; auto_tc. - assert (gt_tree x' (del x r)). { intro w. autorew; trivial. destruct 1. eauto. } destruct r as [|[|] rl rx rr]; auto_tc. Qed. Lemma remove_spec s x y `{Ok s} : InT y (remove x s) <-> InT y s /\ ~X.eq y x. Proof. unfold remove. now autorew. Qed. Global Hint Rewrite remove_spec : rb. #[global] Instance remove_ok s x `{Ok s} : Ok (remove x s). Proof. unfold remove; auto_tc. Qed. (** ** Removing the minimal element *) Lemma delmin_spec l y r c x s' `{O : Ok (Node c l y r)} : delmin l y r = (x,s') -> min_elt (Node c l y r) = Some x /\ del x (Node c l y r) = s'. Proof. revert y r c x s' O. induction l as [|lc ll IH ly lr _]. - simpl. intros y r _ x s' _. injection 1; intros; subst. now rewrite MX.compare_refl. - intros y r c x s' O. simpl delmin. specialize (IH ly lr). destruct delmin as (x0,s0). destruct (IH lc x0 s0); clear IH; [ok|trivial|]. remember (Node lc ll ly lr) as l. simpl min_elt in *. intros E. replace x0 with x in * by (destruct lc; now injection E). split. * subst l; intuition. * assert (X.lt x y). { inversion_clear O. assert (InT x l) by now apply min_elt_spec1. auto. } simpl. case X.compare_spec; try order. destruct lc; injection E; subst l s0; auto. Qed. Lemma remove_min_spec1 s x s' `{Ok s}: remove_min s = Some (x,s') -> min_elt s = Some x /\ remove x s = s'. Proof. unfold remove_min. destruct s as [|c l y r]; try easy. generalize (delmin_spec l y r c). destruct delmin as (x0,s0). intros D. destruct (D x0 s0) as (->,<-); auto. fold (remove x0 (Node c l y r)). inversion_clear 1; auto. Qed. Lemma remove_min_spec2 s : remove_min s = None -> Empty s. Proof. unfold remove_min. destruct s as [|c l y r]. - easy. - now destruct delmin. Qed. Lemma remove_min_ok (s:t) `{Ok s}: match remove_min s with | Some (_,s') => Ok s' | None => True end. Proof. generalize (remove_min_spec1 s). destruct remove_min as [(x0,s0)|]; auto. intros R. destruct (R x0 s0); auto. subst s0. auto_tc. Qed. (** ** Treeify *) Notation ifpred p n := (if p then pred n else n%nat). Definition treeify_invariant size (f:treeify_t) := forall acc, size <= length acc -> let (t,acc') := f acc in cardinal t = size /\ acc = elements t ++ acc'. Lemma treeify_zero_spec : treeify_invariant 0 treeify_zero. Proof. intro. simpl. auto. Qed. Lemma treeify_one_spec : treeify_invariant 1 treeify_one. Proof. intros [|x acc]; simpl; auto; inversion 1. Qed. Lemma treeify_cont_spec f g size1 size2 size : treeify_invariant size1 f -> treeify_invariant size2 g -> size = S (size1 + size2) -> treeify_invariant size (treeify_cont f g). Proof. intros Hf Hg EQ acc LE. unfold treeify_cont. specialize (Hf acc). destruct (f acc) as (t1,acc1). destruct Hf as (Hf1,Hf2). { transitivity size; trivial. subst. rewrite <- Nat.add_succ_r. apply Nat.le_add_r. } destruct acc1 as [|x acc1]. { exfalso. revert LE. apply Nat.lt_nge. subst. rewrite app_nil_r, <- elements_cardinal. apply (Nat.succ_le_mono (cardinal t1)), Nat.le_add_r. } specialize (Hg acc1). destruct (g acc1) as (t2,acc2). destruct Hg as (Hg1,Hg2). { revert LE. subst. rewrite length_app, <- elements_cardinal. simpl. rewrite Nat.add_succ_r, <- Nat.succ_le_mono. apply Nat.add_le_mono_l. } rewrite elements_node, <- app_assoc. now subst. Qed. Lemma treeify_aux_spec n (p:bool) : treeify_invariant (ifpred p (Pos.to_nat n)) (treeify_aux p n). Proof. revert p. induction n as [n|n|]; intros p; simpl treeify_aux. - eapply treeify_cont_spec; [ apply (IHn false) | apply (IHn p) | ]. rewrite Pos2Nat.inj_xI. assert (H := Pos2Nat.is_pos n). apply Nat.neq_0_lt_0 in H. destruct p; simpl; intros; rewrite Nat.add_0_r; trivial. now rewrite <- Nat.add_succ_r, Nat.succ_pred; trivial. - eapply treeify_cont_spec; [ apply (IHn p) | apply (IHn true) | ]. rewrite Pos2Nat.inj_xO. assert (H := Pos2Nat.is_pos n). apply Nat.neq_0_lt_0 in H. rewrite <- Nat.add_succ_r, Nat.succ_pred by trivial. destruct p; simpl; intros; rewrite Nat.add_0_r; trivial. symmetry. now apply Nat.add_pred_l. - destruct p; [ apply treeify_zero_spec | apply treeify_one_spec ]. Qed. Lemma plength_aux_spec l p : Pos.to_nat (plength_aux l p) = length l + Pos.to_nat p. Proof. revert p. induction l; trivial. simpl plength_aux. intros. now rewrite IHl, Pos2Nat.inj_succ, Nat.add_succ_r. Qed. Lemma plength_spec l : Pos.to_nat (plength l) = S (length l). Proof. unfold plength. rewrite plength_aux_spec. apply Nat.add_1_r. Qed. Lemma treeify_elements l : elements (treeify l) = l. Proof. assert (H := treeify_aux_spec (plength l) true l). unfold treeify. destruct treeify_aux as (t,acc); simpl in *. destruct H as (H,H'). { now rewrite plength_spec. } subst l. rewrite plength_spec, length_app, <- elements_cardinal in *. destruct acc. * now rewrite app_nil_r. * exfalso. revert H. simpl. rewrite Nat.add_succ_r, Nat.add_comm. apply Nat.succ_add_discr. Qed. Lemma treeify_spec x l : InT x (treeify l) <-> InA X.eq x l. Proof. intros. now rewrite <- elements_spec1, treeify_elements. Qed. Lemma treeify_ok l : sort X.lt l -> Ok (treeify l). Proof. intros. apply elements_sort_ok. rewrite treeify_elements; auto. Qed. (** ** Filter *) Lemma filter_aux_elements s f acc : filter_aux f s acc = List.filter f (elements s) ++ acc. Proof. revert acc. induction s as [|c l IHl x r IHr]; trivial. intros acc. rewrite elements_node, List.filter_app. simpl. destruct (f x); now rewrite IHl, IHr, <- app_assoc. Qed. Lemma filter_elements s f : elements (filter f s) = List.filter f (elements s). Proof. unfold filter. now rewrite treeify_elements, filter_aux_elements, app_nil_r. Qed. Lemma filter_spec s x f : Proper (X.eq==>Logic.eq) f -> (InT x (filter f s) <-> InT x s /\ f x = true). Proof. intros Hf. rewrite <- elements_spec1, filter_elements, filter_InA, elements_spec1; now auto_tc. Qed. #[global] Instance filter_ok s f `(Ok s) : Ok (filter f s). Proof. apply elements_sort_ok. rewrite filter_elements. apply filter_sort with X.eq; auto_tc. Qed. (** ** Partition *) Lemma partition_aux_spec s f acc1 acc2 : partition_aux f s acc1 acc2 = (filter_aux f s acc1, filter_aux (fun x => negb (f x)) s acc2). Proof. revert acc1 acc2. induction s as [ | c l Hl x r Hr ]; simpl. - trivial. - intros acc1 acc2. destruct (f x); simpl; now rewrite Hr, Hl. Qed. Lemma partition_spec s f : partition f s = (filter f s, filter (fun x => negb (f x)) s). Proof. unfold partition, filter. now rewrite partition_aux_spec. Qed. Lemma partition_spec1 s f : Proper (X.eq==>Logic.eq) f -> Equal (fst (partition f s)) (filter f s). Proof. now rewrite partition_spec. Qed. Lemma partition_spec2 s f : Proper (X.eq==>Logic.eq) f -> Equal (snd (partition f s)) (filter (fun x => negb (f x)) s). Proof. now rewrite partition_spec. Qed. #[global] Instance partition_ok1 s f `(Ok s) : Ok (fst (partition f s)). Proof. rewrite partition_spec; now apply filter_ok. Qed. #[global] Instance partition_ok2 s f `(Ok s) : Ok (snd (partition f s)). Proof. rewrite partition_spec; now apply filter_ok. Qed. (** ** An invariant for binary list functions with accumulator. *) Ltac inA := rewrite ?InA_app_iff, ?InA_cons, ?InA_nil, ?InA_rev in *; auto_tc. Record INV l1 l2 acc : Prop := { l1_sorted : sort X.lt (rev l1); l2_sorted : sort X.lt (rev l2); acc_sorted : sort X.lt acc; l1_lt_acc x y : InA X.eq x l1 -> InA X.eq y acc -> X.lt x y; l2_lt_acc x y : InA X.eq x l2 -> InA X.eq y acc -> X.lt x y}. Local Hint Resolve l1_sorted l2_sorted acc_sorted : core. Lemma INV_init s1 s2 `(Ok s1, Ok s2) : INV (rev_elements s1) (rev_elements s2) nil. Proof. rewrite !rev_elements_rev. split; rewrite ?rev_involutive; auto; intros; now inA. Qed. Lemma INV_sym l1 l2 acc : INV l1 l2 acc -> INV l2 l1 acc. Proof. destruct 1; now split. Qed. Lemma INV_drop x1 l1 l2 acc : INV (x1 :: l1) l2 acc -> INV l1 l2 acc. Proof. intros (l1s,l2s,accs,l1a,l2a). simpl in *. destruct (sorted_app_inv _ _ l1s) as (U & V & W); auto. split; auto. Qed. Lemma INV_eq x1 x2 l1 l2 acc : INV (x1 :: l1) (x2 :: l2) acc -> X.eq x1 x2 -> INV l1 l2 (x1 :: acc). Proof. intros (U,V,W,X,Y) EQ. simpl in *. destruct (sorted_app_inv _ _ U) as (U1 & U2 & U3); auto. destruct (sorted_app_inv _ _ V) as (V1 & V2 & V3); auto. split; auto. - constructor; auto. apply InA_InfA with X.eq; auto_tc. - intros x y; inA; intros Hx [Hy|Hy]. + apply U3; inA. + apply X; inA. - intros x y; inA; intros Hx [Hy|Hy]. + rewrite Hy, EQ; apply V3; inA. + apply Y; inA. Qed. Lemma INV_lt x1 x2 l1 l2 acc : INV (x1 :: l1) (x2 :: l2) acc -> X.lt x1 x2 -> INV (x1 :: l1) l2 (x2 :: acc). Proof. intros (U,V,W,X,Y) EQ. simpl in *. destruct (sorted_app_inv _ _ U) as (U1 & U2 & U3); auto. destruct (sorted_app_inv _ _ V) as (V1 & V2 & V3); auto. split; auto. - constructor; auto. apply InA_InfA with X.eq; auto_tc. - intros x y; inA; intros Hx [Hy|Hy]. + rewrite Hy; clear Hy. destruct Hx; [order|]. transitivity x1; auto. apply U3; inA. + apply X; inA. - intros x y; inA; intros Hx [Hy|Hy]. + rewrite Hy. apply V3; inA. + apply Y; inA. Qed. Lemma INV_rev l1 l2 acc : INV l1 l2 acc -> Sorted X.lt (rev_append l1 acc). Proof. intros. rewrite rev_append_rev. apply SortA_app with X.eq; eauto with *. intros x y. inA. eapply @l1_lt_acc; eauto. Qed. (** ** union *) Lemma union_list_ok l1 l2 acc : INV l1 l2 acc -> sort X.lt (union_list l1 l2 acc). Proof. revert l2 acc. induction l1 as [|x1 l1 IH1]; [intro l2|induction l2 as [|x2 l2 IH2]]; intros acc inv. - eapply INV_rev, INV_sym; eauto. - eapply INV_rev; eauto. - simpl. case X.compare_spec; intro C. * apply IH1. eapply INV_eq; eauto. * apply (IH2 (x2::acc)). eapply INV_lt; eauto. * apply IH1. eapply INV_sym, INV_lt; eauto. now apply INV_sym. Qed. #[global] Instance linear_union_ok s1 s2 `(Ok s1, Ok s2) : Ok (linear_union s1 s2). Proof. unfold linear_union. now apply treeify_ok, union_list_ok, INV_init. Qed. #[global] Instance fold_add_ok s1 s2 `(Ok s1, Ok s2) : Ok (fold add s1 s2). Proof. rewrite fold_spec, <- fold_left_rev_right. unfold elt in *. induction (rev (elements s1)); simpl; unfold flip in *; auto_tc. Qed. #[global] Instance union_ok s1 s2 `(Ok s1, Ok s2) : Ok (union s1 s2). Proof. unfold union. destruct compare_height; auto_tc. Qed. Lemma union_list_spec x l1 l2 acc : InA X.eq x (union_list l1 l2 acc) <-> InA X.eq x l1 \/ InA X.eq x l2 \/ InA X.eq x acc. Proof. revert l2 acc. induction l1 as [|x1 l1 IH1]. - intros l2 acc; simpl. rewrite rev_append_rev. inA. tauto. - induction l2 as [|x2 l2 IH2]; intros acc; simpl. * rewrite rev_append_rev. inA. tauto. * case X.compare_spec; intro C. + rewrite IH1, !InA_cons, C; tauto. + rewrite (IH2 (x2::acc)), !InA_cons. tauto. + rewrite IH1, !InA_cons; tauto. Qed. Lemma linear_union_spec s1 s2 x : InT x (linear_union s1 s2) <-> InT x s1 \/ InT x s2. Proof. unfold linear_union. rewrite treeify_spec, union_list_spec, !rev_elements_rev. rewrite !InA_rev, InA_nil, !elements_spec1 by auto_tc. tauto. Qed. Lemma fold_add_spec s1 s2 x : InT x (fold add s1 s2) <-> InT x s1 \/ InT x s2. Proof. rewrite fold_spec, <- fold_left_rev_right. rewrite <- (elements_spec1 s1), <- InA_rev by auto_tc. unfold elt in *. induction (rev (elements s1)); simpl. - rewrite InA_nil. tauto. - unfold flip. rewrite add_spec', IHl, InA_cons. tauto. Qed. Lemma union_spec' s1 s2 x : InT x (union s1 s2) <-> InT x s1 \/ InT x s2. Proof. unfold union. destruct compare_height. - apply linear_union_spec. - apply fold_add_spec. - rewrite fold_add_spec. tauto. Qed. Lemma union_spec : forall s1 s2 y `{Ok s1, Ok s2}, (InT y (union s1 s2) <-> InT y s1 \/ InT y s2). Proof. intros; apply union_spec'. Qed. (** ** inter *) Lemma inter_list_ok l1 l2 acc : INV l1 l2 acc -> sort X.lt (inter_list l1 l2 acc). Proof. revert l2 acc. induction l1 as [|x1 l1 IH1]; [|induction l2 as [|x2 l2 IH2]]; simpl. - eauto. - eauto. - intros acc inv. case X.compare_spec; intro C. * apply IH1. eapply INV_eq; eauto. * apply (IH2 acc). eapply INV_sym, INV_drop, INV_sym; eauto. * apply IH1. eapply INV_drop; eauto. Qed. #[global] Instance linear_inter_ok s1 s2 `(Ok s1, Ok s2) : Ok (linear_inter s1 s2). Proof. unfold linear_inter. now apply treeify_ok, inter_list_ok, INV_init. Qed. #[global] Instance inter_ok s1 s2 `(Ok s1, Ok s2) : Ok (inter s1 s2). Proof. unfold inter. destruct compare_height; auto_tc. Qed. Lemma inter_list_spec x l1 l2 acc : sort X.lt (rev l1) -> sort X.lt (rev l2) -> (InA X.eq x (inter_list l1 l2 acc) <-> (InA X.eq x l1 /\ InA X.eq x l2) \/ InA X.eq x acc). Proof. revert l2 acc. induction l1 as [|x1 l1 IH1]. - intros l2 acc; simpl. inA. tauto. - induction l2 as [|x2 l2 IH2]; intros acc. * simpl. inA. tauto. * simpl. intros U V. destruct (sorted_app_inv _ _ U) as (U1 & U2 & U3); auto. destruct (sorted_app_inv _ _ V) as (V1 & V2 & V3); auto. case X.compare_spec; intro C. + rewrite IH1, !InA_cons, C; tauto. + rewrite (IH2 acc); auto. inA. intuition; try order. assert (X.lt x x1) by (apply U3; inA). order. + rewrite IH1; auto. inA. intuition; try order. assert (X.lt x x2) by (apply V3; inA). order. Qed. Lemma linear_inter_spec s1 s2 x `(Ok s1, Ok s2) : InT x (linear_inter s1 s2) <-> InT x s1 /\ InT x s2. Proof. unfold linear_inter. rewrite !rev_elements_rev, treeify_spec, inter_list_spec by (rewrite rev_involutive; auto_tc). rewrite !InA_rev, InA_nil, !elements_spec1 by auto_tc. tauto. Qed. Local Instance mem_proper s `(Ok s) : Proper (X.eq ==> Logic.eq) (fun k => mem k s). Proof. intros x y EQ. apply Bool.eq_iff_eq_true; rewrite !mem_spec; auto. now rewrite EQ. Qed. Lemma inter_spec s1 s2 y `{Ok s1, Ok s2} : InT y (inter s1 s2) <-> InT y s1 /\ InT y s2. Proof. unfold inter. destruct compare_height. - now apply linear_inter_spec. - rewrite filter_spec, mem_spec by auto_tc; tauto. - rewrite filter_spec, mem_spec by auto_tc; tauto. Qed. (** ** difference *) Lemma diff_list_ok l1 l2 acc : INV l1 l2 acc -> sort X.lt (diff_list l1 l2 acc). Proof. revert l2 acc. induction l1 as [|x1 l1 IH1]; [intro l2|induction l2 as [|x2 l2 IH2]]; intros acc inv. - eauto. - unfold diff_list. eapply INV_rev; eauto. - simpl. case X.compare_spec; intro C. * apply IH1. eapply INV_drop, INV_sym, INV_drop, INV_sym; eauto. * apply (IH2 acc). eapply INV_sym, INV_drop, INV_sym; eauto. * apply IH1. eapply INV_sym, INV_lt; eauto. now apply INV_sym. Qed. #[global] Instance diff_inter_ok s1 s2 `(Ok s1, Ok s2) : Ok (linear_diff s1 s2). Proof. unfold linear_inter. now apply treeify_ok, diff_list_ok, INV_init. Qed. #[global] Instance fold_remove_ok s1 s2 `(Ok s2) : Ok (fold remove s1 s2). Proof. rewrite fold_spec, <- fold_left_rev_right. unfold elt in *. induction (rev (elements s1)); simpl; unfold flip in *; auto_tc. Qed. #[global] Instance diff_ok s1 s2 `(Ok s1, Ok s2) : Ok (diff s1 s2). Proof. unfold diff. destruct compare_height; auto_tc. Qed. Lemma diff_list_spec x l1 l2 acc : sort X.lt (rev l1) -> sort X.lt (rev l2) -> (InA X.eq x (diff_list l1 l2 acc) <-> (InA X.eq x l1 /\ ~InA X.eq x l2) \/ InA X.eq x acc). Proof. revert l2 acc. induction l1 as [|x1 l1 IH1]. - intros l2 acc; simpl. inA. tauto. - induction l2 as [|x2 l2 IH2]; intros acc. + intros; simpl. rewrite rev_append_rev. inA. tauto. + simpl. intros U V. destruct (sorted_app_inv _ _ U) as (U1 & U2 & U3); auto. destruct (sorted_app_inv _ _ V) as (V1 & V2 & V3); auto. case X.compare_spec; intro C. * rewrite IH1; auto. f_equiv. inA. intuition; try order. assert (X.lt x x1) by (apply U3; inA). order. * rewrite (IH2 acc); auto. f_equiv. inA. intuition; try order. assert (X.lt x x1) by (apply U3; inA). order. * rewrite IH1; auto. inA. intuition; try order. left; split; auto. destruct 1. -- order. -- assert (X.lt x x2) by (apply V3; inA). order. Qed. Lemma linear_diff_spec s1 s2 x `(Ok s1, Ok s2) : InT x (linear_diff s1 s2) <-> InT x s1 /\ ~InT x s2. Proof. unfold linear_diff. rewrite !rev_elements_rev, treeify_spec, diff_list_spec by (rewrite rev_involutive; auto_tc). rewrite !InA_rev, InA_nil, !elements_spec1 by auto_tc. tauto. Qed. Lemma fold_remove_spec s1 s2 x `(Ok s2) : InT x (fold remove s1 s2) <-> InT x s2 /\ ~InT x s1. Proof. rewrite fold_spec, <- fold_left_rev_right. rewrite <- (elements_spec1 s1), <- InA_rev by auto_tc. unfold elt in *. induction (rev (elements s1)); simpl; intros. - rewrite InA_nil. intuition. - unfold flip in *. rewrite remove_spec, IHl, InA_cons. + tauto. + clear IHl. induction l; simpl; auto_tc. Qed. Lemma diff_spec s1 s2 y `{Ok s1, Ok s2} : InT y (diff s1 s2) <-> InT y s1 /\ ~InT y s2. Proof. unfold diff. destruct compare_height. - now apply linear_diff_spec. - rewrite filter_spec, Bool.negb_true_iff, <- Bool.not_true_iff_false, mem_spec; intuition. intros x1 x2 EQ. f_equal. now apply mem_proper. - now apply fold_remove_spec. Qed. End MakeRaw. (** * Balancing properties We now prove that all operations preserve a red-black invariant, and that trees have hence a logarithmic depth. *) Module BalanceProps(X:Orders.OrderedType)(Import M : MakeRaw X). Local Notation Rd := (Node Red). Local Notation Bk := (Node Black). Import M.MX. (** ** Red-Black invariants *) (** In a red-black tree : - a red node has no red children - the black depth at each node is the same along all paths. The black depth is here an argument of the predicate. *) Inductive rbt : nat -> tree -> Prop := | RB_Leaf : rbt 0 Leaf | RB_Rd n l k r : notred l -> notred r -> rbt n l -> rbt n r -> rbt n (Rd l k r) | RB_Bk n l k r : rbt n l -> rbt n r -> rbt (S n) (Bk l k r). (** A red-red tree is almost a red-black tree, except that it has a _red_ root node which _may_ have red children. Note that a red-red tree is hence non-empty, and all its strict subtrees are red-black. *) Inductive rrt (n:nat) : tree -> Prop := | RR_Rd l k r : rbt n l -> rbt n r -> rrt n (Rd l k r). (** An almost-red-black tree is almost a red-black tree, except that it's permitted to have two red nodes in a row at the very root (only). We implement this notion by saying that a quasi-red-black tree is either a red-black tree or a red-red tree. *) Inductive arbt (n:nat)(t:tree) : Prop := | ARB_RB : rbt n t -> arbt n t | ARB_RR : rrt n t -> arbt n t. (** The main exported invariant : being a red-black tree for some black depth. *) Class Rbt (t:tree) := RBT : exists d, rbt d t. (** ** Basic tactics and results about red-black *) Scheme rbt_ind := Induction for rbt Sort Prop. Local Hint Constructors rbt rrt arbt : core. Local Hint Extern 0 (notred _) => (exact I) : core. Ltac invrb := intros; invtree rrt; invtree rbt; try contradiction. Ltac desarb := match goal with H:arbt _ _ |- _ => destruct H end. Ltac nonzero n := destruct n as [|n]; [try split; invrb|]. Lemma rr_nrr_rb n t : rrt n t -> notredred t -> rbt n t. Proof. destruct 1 as [l x r Hl Hr]. destruct l, r; descolor; invrb; auto. Qed. Local Hint Resolve rr_nrr_rb : core. Lemma arb_nrr_rb n t : arbt n t -> notredred t -> rbt n t. Proof. destruct 1; auto. Qed. Lemma arb_nr_rb n t : arbt n t -> notred t -> rbt n t. Proof. destruct 1; destruct t; descolor; invrb; auto. Qed. Local Hint Resolve arb_nrr_rb arb_nr_rb : core. (** ** A Red-Black tree has indeed a logarithmic depth *) Definition redcarac s := rcase (fun _ _ _ => 1) (fun _ => 0) s. Lemma rb_maxdepth s n : rbt n s -> maxdepth s <= 2*n + redcarac s. Proof. induction 1. - simpl; auto. - replace (redcarac l) with 0 in * by now destree l. replace (redcarac r) with 0 in * by now destree r. simpl maxdepth. simpl redcarac. rewrite Nat.add_succ_r, <- Nat.succ_le_mono. now apply Nat.max_lub. - simpl. rewrite <- Nat.succ_le_mono. apply Nat.max_lub; eapply Nat.le_trans; eauto; [destree l | destree r]; simpl; rewrite !Nat.add_0_r, ?Nat.add_1_r, ?Nat.add_succ_r; auto. Qed. Lemma rb_mindepth s n : rbt n s -> n + redcarac s <= mindepth s. Proof. induction 1; simpl. - trivial. - rewrite Nat.add_succ_r. apply -> Nat.succ_le_mono. replace (redcarac l) with 0 in * by now destree l. replace (redcarac r) with 0 in * by now destree r. now apply Nat.min_glb. - apply -> Nat.succ_le_mono. rewrite Nat.add_0_r. apply Nat.min_glb. + refine (Nat.le_trans _ _ _ _ IHrbt1). apply Nat.le_add_r. + refine (Nat.le_trans _ _ _ _ IHrbt2). apply Nat.le_add_r. Qed. Lemma maxdepth_upperbound s : Rbt s -> maxdepth s <= 2 * Nat.log2 (S (cardinal s)). Proof. intros (n,H). eapply Nat.le_trans; [eapply rb_maxdepth; eauto|]. transitivity (2*(n+redcarac s)). - rewrite Nat.mul_add_distr_l. apply Nat.add_le_mono_l. rewrite <- Nat.mul_1_l at 1. apply Nat.mul_le_mono_r. auto. - apply Nat.mul_le_mono_l. transitivity (mindepth s). + now apply rb_mindepth. + apply mindepth_log_cardinal. Qed. Lemma maxdepth_lowerbound s : s<>Leaf -> Nat.log2 (cardinal s) < maxdepth s. Proof. apply maxdepth_log_cardinal. Qed. (** ** Singleton *) Lemma singleton_rb x : Rbt (singleton x). Proof. unfold singleton. exists 1; auto. Qed. (** ** [makeBlack] and [makeRed] *) Lemma makeBlack_rb n t : arbt n t -> Rbt (makeBlack t). Proof. destruct t as [|[|] l x r]. - exists 0; auto. - destruct 1; invrb; exists (S n); simpl; auto. - exists n; auto. Qed. Lemma makeRed_rr t n : rbt (S n) t -> notred t -> rrt n (makeRed t). Proof. destruct t as [|[|] l x r]; invrb; simpl; auto. Qed. (** ** Balancing *) Lemma lbal_rb n l k r : arbt n l -> rbt n r -> rbt (S n) (lbal l k r). Proof. case lbal_match; intros; desarb; invrb; auto. Qed. Lemma rbal_rb n l k r : rbt n l -> arbt n r -> rbt (S n) (rbal l k r). Proof. case rbal_match; intros; desarb; invrb; auto. Qed. Lemma rbal'_rb n l k r : rbt n l -> arbt n r -> rbt (S n) (rbal' l k r). Proof. case rbal'_match; intros; desarb; invrb; auto. Qed. Lemma lbalS_rb n l x r : arbt n l -> rbt (S n) r -> notred r -> rbt (S n) (lbalS l x r). Proof. intros Hl Hr Hr'. destruct r as [|[|] rl rx rr]; invrb. clear Hr'. revert Hl. case lbalS_match. - destruct 1; invrb; auto. - intros. apply rbal'_rb; auto. Qed. Lemma lbalS_arb n l x r : arbt n l -> rbt (S n) r -> arbt (S n) (lbalS l x r). Proof. case lbalS_match. - destruct 1; invrb; auto. - clear l. intros l Hl Hl' Hr. destruct r as [|[|] rl rx rr]; invrb. * destruct rl as [|[|] rll rlx rlr]; invrb. right; auto using rbal'_rb, makeRed_rr. * left; apply rbal'_rb; auto. Qed. Lemma rbalS_rb n l x r : rbt (S n) l -> notred l -> arbt n r -> rbt (S n) (rbalS l x r). Proof. intros Hl Hl' Hr. destruct l as [|[|] ll lx lr]; invrb. clear Hl'. revert Hr. case rbalS_match. - destruct 1; invrb; auto. - intros. apply lbal_rb; auto. Qed. Lemma rbalS_arb n l x r : rbt (S n) l -> arbt n r -> arbt (S n) (rbalS l x r). Proof. case rbalS_match. - destruct 2; invrb; auto. - clear r. intros r Hr Hr' Hl. destruct l as [|[|] ll lx lr]; invrb. * destruct lr as [|[|] lrl lrx lrr]; invrb. right; auto using lbal_rb, makeRed_rr. * left; apply lbal_rb; auto. Qed. (** ** Insertion *) (** The next lemmas combine simultaneous results about rbt and arbt. A first solution here: statement with [if ... then ... else] *) Definition ifred s (A B:Prop) := rcase (fun _ _ _ => A) (fun _ => B) s. Lemma ifred_notred s A B : notred s -> (ifred s A B <-> B). Proof. destruct s; descolor; simpl; intuition. Qed. Lemma ifred_or s A B : ifred s A B -> A\/B. Proof. destruct s; descolor; simpl; intuition. Qed. Lemma ins_rr_rb x s n : rbt n s -> ifred s (rrt n (ins x s)) (rbt n (ins x s)). Proof. induction 1 as [ | n l k r | n l k r Hl IHl Hr IHr ]. - simpl; auto. - simpl. rewrite ifred_notred in * by trivial. elim_compare x k; auto. - rewrite ifred_notred by trivial. unfold ins; fold ins. (* simpl is too much here ... *) elim_compare x k. * auto. * apply lbal_rb; trivial. apply ifred_or in IHl; intuition. * apply rbal_rb; trivial. apply ifred_or in IHr; intuition. Qed. Lemma ins_arb x s n : rbt n s -> arbt n (ins x s). Proof. intros H. apply (ins_rr_rb x), ifred_or in H. intuition. Qed. #[global] Instance add_rb x s : Rbt s -> Rbt (add x s). Proof. intros (n,H). unfold add. now apply (makeBlack_rb n), ins_arb. Qed. (** ** Deletion *) (** A second approach here: statement with ... /\ ... *) Lemma append_arb_rb n l r : rbt n l -> rbt n r -> (arbt n (append l r)) /\ (notred l -> notred r -> rbt n (append l r)). Proof. revert r n. append_tac l r. - split; auto. - split; auto. - (* Red / Red *) intros n. invrb. case (IHlr n); auto; clear IHlr. case append_rr_match. + intros a x b _ H; split; invrb. assert (rbt n (Rd a x b)) by auto. invrb. auto. + split; invrb; auto. - (* Red / Black *) split; invrb. destruct (IHlr n) as (_,IH); auto. - (* Black / Red *) split; invrb. destruct (IHrl n) as (_,IH); auto. - (* Black / Black *) nonzero n. invrb. destruct (IHlr n) as (IH,_); auto; clear IHlr. revert IH. case append_bb_match. + intros a x b IH; split; destruct IH; invrb; auto. + split; [left | invrb]; auto using lbalS_rb. Qed. (** A third approach : Lemma ... with ... *) Lemma del_arb s x n : rbt (S n) s -> isblack s -> arbt n (del x s) with del_rb s x n : rbt n s -> notblack s -> rbt n (del x s). Proof. { revert n. induct s x; try destruct c; try contradiction; invrb. - apply append_arb_rb; assumption. - assert (IHl' := del_rb l x). clear IHr del_arb del_rb. destruct l as [|[|] ll lx lr]; auto. nonzero n. apply lbalS_arb; auto. - assert (IHr' := del_rb r x). clear IHl del_arb del_rb. destruct r as [|[|] rl rx rr]; auto. nonzero n. apply rbalS_arb; auto. } { revert n. induct s x; try assumption; try destruct c; try contradiction; invrb. - apply append_arb_rb; assumption. - assert (IHl' := del_arb l x). clear IHr del_arb del_rb. destruct l as [|[|] ll lx lr]; auto. nonzero n. destruct n as [|n]; [invrb|]; apply lbalS_rb; auto. - assert (IHr' := del_arb r x). clear IHl del_arb del_rb. destruct r as [|[|] rl rx rr]; auto. nonzero n. apply rbalS_rb; auto. } Qed. #[global] Instance remove_rb s x : Rbt s -> Rbt (remove x s). Proof. intros (n,H). unfold remove. destruct s as [|[|] l y r]. - apply (makeBlack_rb n). auto. - apply (makeBlack_rb n). left. apply del_rb; simpl; auto. - nonzero n. apply (makeBlack_rb n). apply del_arb; simpl; auto. Qed. (** ** Treeify *) Definition treeify_rb_invariant size depth (f:treeify_t) := forall acc, size <= length acc -> rbt depth (fst (f acc)) /\ size + length (snd (f acc)) = length acc. Lemma treeify_zero_rb : treeify_rb_invariant 0 0 treeify_zero. Proof. intros acc _; simpl; auto. Qed. Lemma treeify_one_rb : treeify_rb_invariant 1 0 treeify_one. Proof. intros [|x acc]; simpl; auto; inversion 1. Qed. Lemma treeify_cont_rb f g size1 size2 size d : treeify_rb_invariant size1 d f -> treeify_rb_invariant size2 d g -> size = S (size1 + size2) -> treeify_rb_invariant size (S d) (treeify_cont f g). Proof. intros Hf Hg H acc Hacc. unfold treeify_cont. specialize (Hf acc). destruct (f acc) as (l, acc1). simpl in *. destruct Hf as (Hf1, Hf2). { subst. refine (Nat.le_trans _ _ _ _ Hacc). rewrite <- Nat.add_succ_r. apply Nat.le_add_r. } destruct acc1 as [|x acc2]; simpl in *. - exfalso. revert Hacc. apply Nat.lt_nge. rewrite H, <- Hf2. rewrite Nat.add_0_r. apply (Nat.succ_le_mono size1), Nat.le_add_r. - specialize (Hg acc2). destruct (g acc2) as (r, acc3). simpl in *. destruct Hg as (Hg1, Hg2). { revert Hacc. rewrite H, <- Hf2, Nat.add_succ_r, <- Nat.succ_le_mono. apply Nat.add_le_mono_l. } split; auto. now rewrite H, <- Hf2, <- Hg2, Nat.add_succ_r, Nat.add_assoc. Qed. Lemma treeify_aux_rb n : exists d, forall (b:bool), treeify_rb_invariant (ifpred b (Pos.to_nat n)) d (treeify_aux b n). Proof. induction n as [n (d,IHn)|n (d,IHn)| ]. - exists (S d). intros b. eapply treeify_cont_rb; [ apply (IHn false) | apply (IHn b) | ]. rewrite Pos2Nat.inj_xI. assert (H := Pos2Nat.is_pos n). apply Nat.neq_0_lt_0 in H. destruct b; simpl; intros; rewrite Nat.add_0_r; trivial. now rewrite <- Nat.add_succ_r, Nat.succ_pred; trivial. - exists (S d). intros b. eapply treeify_cont_rb; [ apply (IHn b) | apply (IHn true) | ]. rewrite Pos2Nat.inj_xO. assert (H := Pos2Nat.is_pos n). apply Nat.neq_0_lt_0 in H. rewrite <- Nat.add_succ_r, Nat.succ_pred by trivial. destruct b; simpl; intros; rewrite Nat.add_0_r; trivial. symmetry. now apply Nat.add_pred_l. - exists 0; destruct b; [ apply treeify_zero_rb | apply treeify_one_rb ]. Qed. (** The black depth of [treeify l] is actually a log2, but we don't need to mention that. *) #[global] Instance treeify_rb l : Rbt (treeify l). Proof. unfold treeify. destruct (treeify_aux_rb (plength l)) as (d,H). exists d. apply H. now rewrite plength_spec. Qed. (** ** Filtering *) #[global] Instance filter_rb f s : Rbt (filter f s). Proof. unfold filter; auto_tc. Qed. #[global] Instance partition_rb1 f s : Rbt (fst (partition f s)). Proof. unfold partition. destruct partition_aux. simpl. auto_tc. Qed. #[global] Instance partition_rb2 f s : Rbt (snd (partition f s)). Proof. unfold partition. destruct partition_aux. simpl. auto_tc. Qed. (** ** Union, intersection, difference *) #[global] Instance fold_add_rb s1 s2 : Rbt s2 -> Rbt (fold add s1 s2). Proof. intros. rewrite fold_spec, <- fold_left_rev_right. unfold elt in *. induction (rev (elements s1)); simpl; unfold flip in *; auto_tc. Qed. #[global] Instance fold_remove_rb s1 s2 : Rbt s2 -> Rbt (fold remove s1 s2). Proof. intros. rewrite fold_spec, <- fold_left_rev_right. unfold elt in *. induction (rev (elements s1)); simpl; unfold flip in *; auto_tc. Qed. Lemma union_rb s1 s2 : Rbt s1 -> Rbt s2 -> Rbt (union s1 s2). Proof. intros. unfold union, linear_union. destruct compare_height; auto_tc. Qed. Lemma inter_rb s1 s2 : Rbt s1 -> Rbt s2 -> Rbt (inter s1 s2). Proof. intros. unfold inter, linear_inter. destruct compare_height; auto_tc. Qed. Lemma diff_rb s1 s2 : Rbt s1 -> Rbt s2 -> Rbt (diff s1 s2). Proof. intros. unfold diff, linear_diff. destruct compare_height; auto_tc. Qed. End BalanceProps. (** * Final Encapsulation Now, in order to really provide a functor implementing [S], we need to encapsulate everything into a type of binary search trees. They also happen to be well-balanced, but this has no influence on the correctness of operations, so we won't state this here, see [BalanceProps] if you need more than just the MSet interface. *) Module Type MSetInterface_S_Ext := MSetInterface.S <+ MSetRemoveMin. Module Make (X: Orders.OrderedType) <: MSetInterface_S_Ext with Module E := X. Module Raw. Include MakeRaw X. End Raw. Include MSetInterface.Raw2Sets X Raw. Definition opt_ok (x:option (elt * Raw.t)) := match x with Some (_,s) => Raw.Ok s | None => True end. Definition mk_opt_t (x: option (elt * Raw.t))(P: opt_ok x) : option (elt * t) := match x as o return opt_ok o -> option (elt * t) with | Some (k,s') => fun P : Raw.Ok s' => Some (k, Mkt s') | None => fun _ => None end P. Definition remove_min s : option (elt * t) := mk_opt_t (Raw.remove_min (this s)) (Raw.remove_min_ok s). Lemma remove_min_spec1 s x s' : remove_min s = Some (x,s') -> min_elt s = Some x /\ Equal (remove x s) s'. Proof. destruct s as (s,Hs). unfold remove_min, mk_opt_t, min_elt, remove, Equal, In; simpl. generalize (fun x s' => @Raw.remove_min_spec1 s x s' Hs). set (P := Raw.remove_min_ok s). clearbody P. destruct (Raw.remove_min s) as [(x0,s0)|]; try easy. intros H [= -> <-]. simpl. destruct (H x s0); auto. subst; intuition. Qed. Lemma remove_min_spec2 s : remove_min s = None -> Empty s. Proof. destruct s as (s,Hs). unfold remove_min, mk_opt_t, Empty, In; simpl. generalize (Raw.remove_min_spec2 s). set (P := Raw.remove_min_ok s). clearbody P. destruct (Raw.remove_min s) as [(x0,s0)|]; now intuition. Qed. End Make. coq-8.20.0/theories/MSets/MSetToFiniteSet.v000066400000000000000000000113051466560755400204370ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* Ensemble M.elt := fun s x => M.In x s. Notation " !! " := mkEns. Lemma In_In : forall s x, M.In x s <-> In _ (!!s) x. Proof. unfold In; compute; auto with extcore. Qed. Lemma Subset_Included : forall s s', s[<=]s' <-> Included _ (!!s) (!!s'). Proof. unfold Subset, Included, In, mkEns; intuition. Qed. Notation " a === b " := (Same_set M.elt a b) (at level 70, no associativity). Lemma Equal_Same_set : forall s s', s[=]s' <-> !!s === !!s'. Proof. intros. rewrite double_inclusion. unfold Subset, Included, Same_set, In, mkEns; intuition. Qed. Lemma empty_Empty_Set : !!M.empty === Empty_set _. Proof. unfold Same_set, Included, mkEns, In. split; intro; set_iff; inversion 1. Qed. Lemma Empty_Empty_set : forall s, Empty s -> !!s === Empty_set _. Proof. unfold Same_set, Included, mkEns, In. split; intros. - destruct(H x H0). - inversion H0. Qed. Lemma singleton_Singleton : forall x, !!(M.singleton x) === Singleton _ x . Proof. unfold Same_set, Included, mkEns, In. split; intro; set_iff; inversion 1; try constructor; auto. Qed. Lemma union_Union : forall s s', !!(union s s') === Union _ (!!s) (!!s'). Proof. unfold Same_set, Included, mkEns, In. split; intro; set_iff; inversion 1; [ constructor 1 | constructor 2 | | ]; auto. Qed. Lemma inter_Intersection : forall s s', !!(inter s s') === Intersection _ (!!s) (!!s'). Proof. unfold Same_set, Included, mkEns, In. split; intro; set_iff; inversion 1; try constructor; auto. Qed. Lemma add_Add : forall x s, !!(add x s) === Add _ (!!s) x. Proof. unfold Same_set, Included, mkEns, In. split; intro; set_iff; inversion 1; auto with sets. - inversion H0. constructor 2; constructor. - constructor 1; auto. Qed. Lemma Add_Add : forall x s s', MP.Add x s s' -> !!s' === Add _ (!!s) x. Proof. unfold Same_set, Included, mkEns, In. split; intros. - red in H; rewrite H in H0. destruct H0. + inversion H0. constructor 2; constructor. + constructor 1; auto. - red in H; rewrite H. inversion H0; auto. inversion H1; auto. Qed. Lemma remove_Subtract : forall x s, !!(remove x s) === Subtract _ (!!s) x. Proof. unfold Same_set, Included, mkEns, In. split; intro; set_iff; inversion 1; auto with sets. split; auto. contradict H1. inversion H1; auto. Qed. Lemma mkEns_Finite : forall s, Finite _ (!!s). Proof. intro s; pattern s; apply set_induction; clear s; intros. - intros; replace (!!s) with (Empty_set elt); auto with sets. symmetry; apply Extensionality_Ensembles. apply Empty_Empty_set; auto. - replace (!!s') with (Add _ (!!s) x). + constructor 2; auto. + symmetry; apply Extensionality_Ensembles. apply Add_Add; auto. Qed. Lemma mkEns_cardinal : forall s, cardinal _ (!!s) (M.cardinal s). Proof. intro s; pattern s; apply set_induction; clear s; intros. - intros; replace (!!s) with (Empty_set elt); auto with sets. + rewrite MP.cardinal_1; auto with sets. + symmetry; apply Extensionality_Ensembles. apply Empty_Empty_set; auto. - replace (!!s') with (Add _ (!!s) x). + rewrite (cardinal_2 H0 H1); auto with sets. + symmetry; apply Extensionality_Ensembles. apply Add_Add; auto. Qed. (** we can even build a function from Finite Ensemble to MSet ... at least in Prop. *) Lemma Ens_to_MSet : forall e : Ensemble M.elt, Finite _ e -> exists s:M.t, !!s === e. Proof. induction 1. - exists M.empty. apply empty_Empty_Set. - destruct IHFinite as (s,Hs). exists (M.add x s). apply Extensionality_Ensembles in Hs. rewrite <- Hs. apply add_Add. Qed. End WS_to_Finite_set. Module S_to_Finite_set (U:UsualOrderedType)(M: SetsOn U) := WS_to_Finite_set U M. coq-8.20.0/theories/MSets/MSetWeakList.v000066400000000000000000000353141466560755400177730ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* false | y :: l => if X.eq_dec x y then true else mem x l end. Fixpoint add (x : elt) (s : t) : t := match s with | nil => x :: nil | y :: l => if X.eq_dec x y then s else y :: add x l end. Definition singleton (x : elt) : t := x :: nil. Fixpoint remove (x : elt) (s : t) : t := match s with | nil => nil | y :: l => if X.eq_dec x y then l else y :: remove x l end. Definition fold (B : Type) (f : elt -> B -> B) : t -> B -> B := fold_left (flip f). Definition union (s : t) : t -> t := fold add s. Definition diff (s s' : t) : t := fold remove s' s. Definition inter (s s': t) : t := fold (fun x s => if mem x s' then add x s else s) s nil. Definition subset (s s' : t) : bool := is_empty (diff s s'). Definition equal (s s' : t) : bool := andb (subset s s') (subset s' s). Fixpoint filter (f : elt -> bool) (s : t) : t := match s with | nil => nil | x :: l => if f x then x :: filter f l else filter f l end. Fixpoint for_all (f : elt -> bool) (s : t) : bool := match s with | nil => true | x :: l => if f x then for_all f l else false end. Fixpoint exists_ (f : elt -> bool) (s : t) : bool := match s with | nil => false | x :: l => if f x then true else exists_ f l end. Fixpoint partition (f : elt -> bool) (s : t) : t * t := match s with | nil => (nil, nil) | x :: l => let (s1, s2) := partition f l in if f x then (x :: s1, s2) else (s1, x :: s2) end. Definition cardinal (s : t) : nat := length s. Definition elements (s : t) : list elt := s. Definition choose (s : t) : option elt := match s with | nil => None | x::_ => Some x end. End Ops. (** ** Proofs of set operation specifications. *) Module MakeRaw (X:DecidableType) <: WRawSets X. Include Ops X. Section ForNotations. Notation NoDup := (NoDupA X.eq). Notation In := (InA X.eq). (* TODO: modify proofs in order to avoid these hints *) Let eqr:= (@Equivalence_Reflexive _ _ X.eq_equiv). Let eqsym:= (@Equivalence_Symmetric _ _ X.eq_equiv). Let eqtrans:= (@Equivalence_Transitive _ _ X.eq_equiv). #[local] Hint Resolve eqr eqtrans : core. #[local] Hint Immediate eqsym : core. Definition IsOk := NoDup. Class Ok (s:t) : Prop := ok : NoDup s. #[local] Hint Unfold Ok : core. #[local] Hint Resolve ok : core. Instance NoDup_Ok s (nd : NoDup s) : Ok s := { ok := nd }. Ltac inv_ok := match goal with | H:Ok (_ :: _) |- _ => inversion_clear H; inv_ok | H:Ok nil |- _ => clear H; inv_ok | H:NoDup ?l |- _ => change (Ok l) in H; inv_ok | _ => idtac end. Ltac inv := invlist InA; inv_ok. Ltac constructors := repeat constructor. Fixpoint isok l := match l with | nil => true | a::l => negb (mem a l) && isok l end. Definition Equal s s' := forall a : elt, In a s <-> In a s'. Definition Subset s s' := forall a : elt, In a s -> In a s'. Definition Empty s := forall a : elt, ~ In a s. Definition For_all (P : elt -> Prop) s := forall x, In x s -> P x. Definition Exists (P : elt -> Prop) s := exists x, In x s /\ P x. Lemma In_compat : Proper (X.eq==>eq==>iff) In. Proof. repeat red; intros. subst. rewrite H; auto. Qed. Lemma mem_spec : forall s x `{Ok s}, mem x s = true <-> In x s. Proof. induction s; intros. - split; intros; inv. discriminate. - simpl; destruct (X.eq_dec x a); split; intros; inv; auto. + right; rewrite <- IHs; auto. + rewrite IHs; auto. Qed. Lemma isok_iff : forall l, Ok l <-> isok l = true. Proof. induction l. - intuition. - simpl. rewrite andb_true_iff. rewrite negb_true_iff. rewrite <- IHl. split; intros H. + inv. split; auto. apply not_true_is_false. rewrite mem_spec; auto. + destruct H; constructors; auto. rewrite <- mem_spec; auto; congruence. Qed. Global Instance isok_Ok l : isok l = true -> Ok l | 10. Proof. intros. apply <- isok_iff; auto. Qed. Lemma add_spec : forall (s : t) (x y : elt) {Hs : Ok s}, In y (add x s) <-> X.eq y x \/ In y s. Proof. induction s; simpl; intros. - intuition; inv; auto. - destruct X.eq_dec; inv; rewrite InA_cons, ?IHs; intuition. + left; eauto. + inv; auto. Qed. Global Instance add_ok s x `(Ok s) : Ok (add x s). Proof. induction s. - simpl; intuition. - intros; inv. simpl. destruct X.eq_dec; auto. constructors; auto. intro; inv; auto. rewrite add_spec in *; intuition. Qed. Lemma remove_spec : forall (s : t) (x y : elt) {Hs : Ok s}, In y (remove x s) <-> In y s /\ ~X.eq y x. Proof. induction s; simpl; intros. - intuition; inv; auto. - destruct X.eq_dec as [|Hnot]; inv; rewrite !InA_cons, ?IHs; intuition. + elim H. setoid_replace a with y; eauto. + elim H3. setoid_replace x with y; eauto. + elim Hnot. eauto. Qed. Global Instance remove_ok s x `(Ok s) : Ok (remove x s). Proof. induction s; simpl; intros. - auto. - destruct X.eq_dec; inv; auto. constructors; auto. rewrite remove_spec; intuition. Qed. Lemma singleton_ok : forall x : elt, Ok (singleton x). Proof. unfold singleton; simpl; constructors; auto. intro; inv. Qed. Lemma singleton_spec : forall x y : elt, In y (singleton x) <-> X.eq y x. Proof. unfold singleton; simpl; split; intros. - inv; auto. - left; auto. Qed. Lemma empty_ok : Ok empty. Proof. unfold empty; constructors. Qed. Lemma empty_spec : Empty empty. Proof. unfold Empty, empty; red; intros; inv. Qed. Lemma is_empty_spec : forall s : t, is_empty s = true <-> Empty s. Proof. unfold Empty; destruct s; simpl; split; intros; auto. - intro; inv. - discriminate. - elim (H e); auto. Qed. Lemma elements_spec1 : forall (s : t) (x : elt), In x (elements s) <-> In x s. Proof. unfold elements; intuition. Qed. Lemma elements_spec2w : forall (s : t) {Hs : Ok s}, NoDup (elements s). Proof. unfold elements; auto. Qed. Lemma fold_spec : forall (s : t) (A : Type) (i : A) (f : elt -> A -> A), fold f s i = fold_left (flip f) (elements s) i. Proof. reflexivity. Qed. Global Instance union_ok : forall s s' `(Ok s, Ok s'), Ok (union s s'). Proof. induction s; simpl; auto; intros; inv; unfold flip; auto with *. Qed. Lemma union_spec : forall (s s' : t) (x : elt) {Hs : Ok s} {Hs' : Ok s'}, In x (union s s') <-> In x s \/ In x s'. Proof. induction s; simpl in *; unfold flip; intros; auto; inv. - intuition; inv. - rewrite IHs, add_spec, InA_cons; intuition. Qed. Global Instance inter_ok s s' `(Ok s, Ok s') : Ok (inter s s'). Proof. unfold inter, fold, flip. set (acc := nil (A:=elt)). assert (Hacc : Ok acc) by constructors. clearbody acc; revert acc Hacc. induction s; simpl; auto; intros. inv. apply IHs; auto. destruct (mem a s'); auto with *. Qed. Lemma inter_spec : forall (s s' : t) (x : elt) {Hs : Ok s} {Hs' : Ok s'}, In x (inter s s') <-> In x s /\ In x s'. Proof. unfold inter, fold, flip; intros. set (acc := nil (A:=elt)) in *. assert (Hacc : Ok acc) by constructors. assert (IFF : (In x s /\ In x s') <-> (In x s /\ In x s') \/ In x acc). { intuition; unfold acc in *; inv. } rewrite IFF; clear IFF. clearbody acc. revert acc Hacc x s' Hs Hs'. induction s; simpl; intros. - intuition; inv. - inv. case_eq (mem a s'); intros Hm. + rewrite IHs, add_spec, InA_cons; intuition. rewrite mem_spec in Hm; auto. left; split; auto. rewrite H1; auto. + rewrite IHs, InA_cons; intuition. rewrite H2, <- mem_spec in H3; auto. congruence. Qed. Global Instance diff_ok : forall s s' `(Ok s, Ok s'), Ok (diff s s'). Proof. unfold diff; intros s s'; revert s. induction s'; simpl; unfold flip; auto; intros. inv; auto with *. Qed. Lemma diff_spec : forall (s s' : t) (x : elt) {Hs : Ok s} {Hs' : Ok s'}, In x (diff s s') <-> In x s /\ ~In x s'. Proof. unfold diff; intros s s'; revert s. induction s'; simpl; unfold flip. - intuition; inv. - intros. inv. rewrite IHs', remove_spec, InA_cons; intuition. Qed. Lemma subset_spec : forall (s s' : t) {Hs : Ok s} {Hs' : Ok s'}, subset s s' = true <-> Subset s s'. Proof. unfold subset, Subset; intros. rewrite is_empty_spec. unfold Empty; intros. intuition. - specialize (H a). rewrite diff_spec in H; intuition. rewrite <- (mem_spec a) in H |- *. destruct (mem a s'); intuition auto with bool. - rewrite diff_spec in H0; intuition. Qed. Lemma equal_spec : forall (s s' : t) {Hs : Ok s} {Hs' : Ok s'}, equal s s' = true <-> Equal s s'. Proof. unfold Equal, equal; intros. rewrite andb_true_iff, !subset_spec. unfold Subset; intuition. - rewrite <- H; auto. - rewrite H; auto. Qed. Definition choose_spec1 : forall (s : t) (x : elt), choose s = Some x -> In x s. Proof. destruct s; simpl; intros; inversion H; auto. Qed. Definition choose_spec2 : forall s : t, choose s = None -> Empty s. Proof. destruct s; simpl; intros. - intros x H0; inversion H0. - inversion H. Qed. Lemma cardinal_spec : forall (s : t) {Hs : Ok s}, cardinal s = length (elements s). Proof. auto. Qed. Lemma filter_spec' : forall s x f, In x (filter f s) -> In x s. Proof. induction s; simpl. - intuition; inv. - intros; destruct (f a); inv; intuition; right; eauto. Qed. Lemma filter_spec : forall (s : t) (x : elt) (f : elt -> bool), Proper (X.eq==>eq) f -> (In x (filter f s) <-> In x s /\ f x = true). Proof. induction s; simpl. - intuition; inv. - intros. destruct (f a) eqn:E; rewrite ?InA_cons, IHs; intuition. + setoid_replace x with a; auto. + setoid_replace a with x in E; auto. congruence. Qed. Global Instance filter_ok s f `(Ok s) : Ok (filter f s). Proof. induction s; simpl. - auto. - intros; inv. case (f a); auto. constructors; auto. contradict H0. eapply filter_spec'; eauto. Qed. Lemma for_all_spec : forall (s : t) (f : elt -> bool), Proper (X.eq==>eq) f -> (for_all f s = true <-> For_all (fun x => f x = true) s). Proof. unfold For_all; induction s; simpl. - intuition. inv. - intros; inv. destruct (f a) eqn:F. + rewrite IHs; intuition. inv; auto. setoid_replace x with a; auto. + split; intros H'; try discriminate. intros. rewrite <- F, <- (H' a); auto. Qed. Lemma exists_spec : forall (s : t) (f : elt -> bool), Proper (X.eq==>eq) f -> (exists_ f s = true <-> Exists (fun x => f x = true) s). Proof. unfold Exists; induction s; simpl. - split; [discriminate| intros (x & Hx & _); inv]. - intros. destruct (f a) eqn:F. + split; auto. exists a; auto. + rewrite IHs; firstorder. inv. * setoid_replace a with x in F; auto; congruence. * exists x; auto. Qed. Lemma partition_spec1 : forall (s : t) (f : elt -> bool), Proper (X.eq==>eq) f -> Equal (fst (partition f s)) (filter f s). Proof. simple induction s; simpl; auto; unfold Equal. - firstorder. - intros x l Hrec f Hf. generalize (Hrec f Hf); clear Hrec. case (partition f l); intros s1 s2; simpl; intros. case (f x); simpl; firstorder; inversion H0; intros; firstorder. Qed. Lemma partition_spec2 : forall (s : t) (f : elt -> bool), Proper (X.eq==>eq) f -> Equal (snd (partition f s)) (filter (fun x => negb (f x)) s). Proof. simple induction s; simpl; auto; unfold Equal. - firstorder. - intros x l Hrec f Hf. generalize (Hrec f Hf); clear Hrec. case (partition f l); intros s1 s2; simpl; intros. case (f x); simpl; firstorder; inversion H0; intros; firstorder. Qed. Lemma partition_ok1' : forall (s : t) {Hs : Ok s} (f : elt -> bool)(x:elt), In x (fst (partition f s)) -> In x s. Proof. induction s; simpl; auto; intros. inv. generalize (IHs H1 f x). destruct (f a); destruct (partition f s); simpl in *; auto. inversion_clear H; auto. Qed. Lemma partition_ok2' : forall (s : t) {Hs : Ok s} (f : elt -> bool)(x:elt), In x (snd (partition f s)) -> In x s. Proof. induction s; simpl; auto; intros. inv. generalize (IHs H1 f x). destruct (f a); destruct (partition f s); simpl in *; auto. inversion_clear H; auto. Qed. Global Instance partition_ok1 : forall s f `(Ok s), Ok (fst (partition f s)). Proof. simple induction s; simpl. - auto. - intros x l Hrec f Hs; inv. generalize (@partition_ok1' _ _ f x). generalize (Hrec f H0). case (f x); case (partition f l); simpl; constructors; auto. Qed. Global Instance partition_ok2 : forall s f `(Ok s), Ok (snd (partition f s)). Proof. simple induction s; simpl. - auto. - intros x l Hrec f Hs; inv. generalize (@partition_ok2' _ _ f x). generalize (Hrec f H0). case (f x); case (partition f l); simpl; constructors; auto. Qed. End ForNotations. Definition In := InA X.eq. Definition eq := Equal. #[global] Instance eq_equiv : Equivalence eq := _. End MakeRaw. (** * Encapsulation Now, in order to really provide a functor implementing [S], we need to encapsulate everything into a type of lists without redundancy. *) Module Make (X: DecidableType) <: WSets with Module E := X. Module Raw := MakeRaw X. Include WRaw2Sets X Raw. End Make. coq-8.20.0/theories/MSets/MSets.v000066400000000000000000000020071466560755400165030ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* Gt. Definition ge x y := (x ?= y) <> Lt. Infix "<=" := le : N_scope. Infix "<" := lt : N_scope. Infix ">=" := ge : N_scope. Infix ">" := gt : N_scope. Notation "x <= y <= z" := (x <= y /\ y <= z) : N_scope. Notation "x <= y < z" := (x <= y /\ y < z) : N_scope. Notation "x < y < z" := (x < y /\ y < z) : N_scope. Notation "x < y <= z" := (x < y /\ y <= z) : N_scope. Definition divide p q := exists r, q = r*p. Notation "( p | q )" := (divide p q) (at level 0) : N_scope. Definition Even n := exists m, n = 2*m. Definition Odd n := exists m, n = 2*m+1. (** Proofs of morphisms, obvious since eq is Leibniz *) Local Obligation Tactic := simpl_relation. Program Definition succ_wd : Proper (eq==>eq) succ := _. Program Definition pred_wd : Proper (eq==>eq) pred := _. Program Definition add_wd : Proper (eq==>eq==>eq) add := _. Program Definition sub_wd : Proper (eq==>eq==>eq) sub := _. Program Definition mul_wd : Proper (eq==>eq==>eq) mul := _. Program Definition lt_wd : Proper (eq==>eq==>iff) lt := _. Program Definition div_wd : Proper (eq==>eq==>eq) div := _. Program Definition mod_wd : Proper (eq==>eq==>eq) modulo := _. Program Definition pow_wd : Proper (eq==>eq==>eq) pow := _. Program Definition testbit_wd : Proper (eq==>eq==>Logic.eq) testbit := _. (** Decidability of equality. *) Definition eq_dec : forall n m : N, { n = m } + { n <> m }. Proof. decide equality. apply Pos.eq_dec. Defined. (** Discrimination principle *) Definition discr n : { p:positive | n = pos p } + { n = 0 }. Proof. destruct n as [|p]; auto. left; exists p; auto. Defined. (** Convenient induction principles *) Definition binary_rect (P:N -> Type) (f0 : P 0) (f2 : forall n, P n -> P (double n)) (fS2 : forall n, P n -> P (succ_double n)) (n : N) : P n := let P' p := P (pos p) in let f2' p := f2 (pos p) in let fS2' p := fS2 (pos p) in match n with | 0 => f0 | pos p => positive_rect P' fS2' f2' (fS2 0 f0) p end. Definition binary_rec (P:N -> Set) := binary_rect P. Definition binary_ind (P:N -> Prop) := binary_rect P. (** Peano induction on binary natural numbers *) Definition peano_rect (P : N -> Type) (f0 : P 0) (f : forall n : N, P n -> P (succ n)) (n : N) : P n := let P' p := P (pos p) in let f' p := f (pos p) in match n with | 0 => f0 | pos p => Pos.peano_rect P' (f 0 f0) f' p end. Theorem peano_rect_base P a f : peano_rect P a f 0 = a. Proof. reflexivity. Qed. Theorem peano_rect_succ P a f n : peano_rect P a f (succ n) = f n (peano_rect P a f n). Proof. destruct n; simpl. - trivial. - now rewrite Pos.peano_rect_succ. Qed. Definition peano_ind (P : N -> Prop) := peano_rect P. Definition peano_rec (P : N -> Set) := peano_rect P. Theorem peano_rec_base P a f : peano_rec P a f 0 = a. Proof. apply peano_rect_base. Qed. Theorem peano_rec_succ P a f n : peano_rec P a f (succ n) = f n (peano_rec P a f n). Proof. apply peano_rect_succ. Qed. (** Generic induction / recursion *) Theorem bi_induction : forall A : N -> Prop, Proper (Logic.eq==>iff) A -> A 0 -> (forall n, A n <-> A (succ n)) -> forall n : N, A n. Proof. intros A A_wd A0 AS. apply peano_rect. - assumption. - intros; now apply -> AS. Qed. Definition recursion {A} : A -> (N -> A -> A) -> N -> A := peano_rect (fun _ => A). #[global] Instance recursion_wd {A} (Aeq : relation A) : Proper (Aeq==>(Logic.eq==>Aeq==>Aeq)==>Logic.eq==>Aeq) recursion. Proof. intros a a' Ea f f' Ef x x' Ex. subst x'. induction x using peano_ind. - trivial. - unfold recursion in *. rewrite 2 peano_rect_succ. now apply Ef. Qed. Theorem recursion_0 {A} (a:A) (f:N->A->A) : recursion a f 0 = a. Proof. reflexivity. Qed. Theorem recursion_succ {A} (Aeq : relation A) (a : A) (f : N -> A -> A): Aeq a a -> Proper (Logic.eq==>Aeq==>Aeq) f -> forall n : N, Aeq (recursion a f (succ n)) (f n (recursion a f n)). Proof. unfold recursion; intros a_wd f_wd n. induction n using peano_ind. - rewrite peano_rect_succ. now apply f_wd. - rewrite !peano_rect_succ in *. now apply f_wd. Qed. (** Specification of constants *) Lemma one_succ : 1 = succ 0. Proof. reflexivity. Qed. Lemma two_succ : 2 = succ 1. Proof. reflexivity. Qed. Definition pred_0 : pred 0 = 0. Proof. reflexivity. Qed. (** Properties of mixed successor and predecessor. *) Lemma pos_pred_spec p : Pos.pred_N p = pred (pos p). Proof. now destruct p. Qed. Lemma succ_pos_spec n : pos (succ_pos n) = succ n. Proof. now destruct n. Qed. Lemma pos_pred_succ n : Pos.pred_N (succ_pos n) = n. Proof. destruct n. - trivial. - apply Pos.pred_N_succ. Qed. Lemma succ_pos_pred p : succ (Pos.pred_N p) = pos p. Proof. destruct p; simpl; trivial. f_equal. apply Pos.succ_pred_double. Qed. (** Properties of successor and predecessor *) Theorem pred_succ n : pred (succ n) = n. Proof. destruct n; trivial. simpl. apply Pos.pred_N_succ. Qed. Theorem pred_sub n : pred n = sub n 1. Proof. now destruct n as [|[p|p|]]. Qed. Theorem succ_0_discr n : succ n <> 0. Proof. now destruct n. Qed. (** Specification of addition *) Theorem add_0_l n : 0 + n = n. Proof. reflexivity. Qed. Theorem add_succ_l n m : succ n + m = succ (n + m). Proof. destruct n, m; unfold succ, add; now rewrite ?Pos.add_1_l, ?Pos.add_succ_l. Qed. (** Specification of subtraction. *) Theorem sub_0_r n : n - 0 = n. Proof. now destruct n. Qed. Theorem sub_succ_r n m : n - succ m = pred (n - m). Proof. destruct n as [|p], m as [|q]; trivial. - now destruct p. - simpl. rewrite Pos.sub_mask_succ_r, Pos.sub_mask_carry_spec. now destruct (Pos.sub_mask p q) as [|[r|r|]|]. Qed. (** Specification of multiplication *) Theorem mul_0_l n : 0 * n = 0. Proof. reflexivity. Qed. Theorem mul_succ_l n m : (succ n) * m = n * m + m. Proof. destruct n, m; simpl; trivial. f_equal. rewrite Pos.add_comm. apply Pos.mul_succ_l. Qed. (** Specification of boolean comparisons. *) Lemma eqb_eq n m : eqb n m = true <-> n=m. Proof. destruct n as [|n], m as [|m]; simpl; try easy'. rewrite Pos.eqb_eq. split; intro H. - now subst. - now destr_eq H. Qed. Lemma ltb_lt n m : (n n < m. Proof. unfold ltb, lt. destruct compare; easy'. Qed. Lemma leb_le n m : (n <=? m) = true <-> n <= m. Proof. unfold leb, le. destruct compare; easy'. Qed. (** Basic properties of comparison *) Theorem compare_eq_iff n m : (n ?= m) = Eq <-> n = m. Proof. destruct n, m; simpl; rewrite ?Pos.compare_eq_iff; split; congruence. Qed. Theorem compare_lt_iff n m : (n ?= m) = Lt <-> n < m. Proof. reflexivity. Qed. Theorem compare_le_iff n m : (n ?= m) <> Gt <-> n <= m. Proof. reflexivity. Qed. Theorem compare_antisym n m : (m ?= n) = CompOpp (n ?= m). Proof. destruct n, m; simpl; trivial. apply Pos.compare_antisym. Qed. (** Some more advanced properties of comparison and orders, including [compare_spec] and [lt_irrefl] and [lt_eq_cases]. *) Include BoolOrderFacts. (** Specification of minimum and maximum *) Theorem min_l n m : n <= m -> min n m = n. Proof. unfold min, le. case compare; trivial. now destruct 1. Qed. Theorem min_r n m : m <= n -> min n m = m. Proof. unfold min, le. rewrite compare_antisym. case compare_spec; trivial. now destruct 2. Qed. Theorem max_l n m : m <= n -> max n m = n. Proof. unfold max, le. rewrite compare_antisym. case compare_spec; auto. now destruct 2. Qed. Theorem max_r n m : n <= m -> max n m = m. Proof. unfold max, le. case compare; trivial. now destruct 1. Qed. (** Specification of lt and le. *) Lemma lt_succ_r n m : n < succ m <-> n<=m. Proof. destruct n as [|p], m as [|q]; simpl; try easy'. - split. + now destruct p. + now destruct 1. - apply Pos.lt_succ_r. Qed. (** We can now derive all properties of basic functions and orders, and use these properties for proving the specs of more advanced functions. *) Include NBasicProp <+ UsualMinMaxLogicalProperties <+ UsualMinMaxDecProperties. Lemma strong_induction_le (A : N -> Prop) : A 0 -> (forall n, (forall m, m <= n -> A m) -> A (succ n)) -> forall n, A n. Proof. apply Private_strong_induction_le; intros x y ->; reflexivity. Qed. (** Properties of [double] and [succ_double] *) Lemma double_spec n : double n = 2 * n. Proof. reflexivity. Qed. Lemma succ_double_spec n : succ_double n = 2 * n + 1. Proof. now destruct n. Qed. Lemma double_add n m : double (n+m) = double n + double m. Proof. now destruct n, m. Qed. Lemma succ_double_add n m : succ_double (n+m) = double n + succ_double m. Proof. now destruct n, m. Qed. Lemma double_mul n m : double (n*m) = double n * m. Proof. now destruct n, m. Qed. Lemma succ_double_mul n m : succ_double n * m = double n * m + m. Proof. destruct n; simpl; destruct m; trivial. now rewrite Pos.add_comm. Qed. Lemma div2_double n : div2 (double n) = n. Proof. now destruct n. Qed. Lemma div2_succ_double n : div2 (succ_double n) = n. Proof. now destruct n. Qed. Lemma double_inj n m : double n = double m -> n = m. Proof. intro H. rewrite <- (div2_double n), H. apply div2_double. Qed. Lemma succ_double_inj n m : succ_double n = succ_double m -> n = m. Proof. intro H. rewrite <- (div2_succ_double n), H. apply div2_succ_double. Qed. Lemma succ_double_lt n m : n succ_double n < double m. Proof. destruct n as [|n], m as [|m]; intros H; try easy. unfold lt in *; simpl in *. now rewrite Pos.compare_xI_xO, H. Qed. Lemma double_lt_mono n m : n < m -> double n < double m. Proof. destruct n as [|n], m as [|m]; intros H; try easy. Qed. Lemma double_le_mono n m : n <= m -> double n <= double m. Proof. destruct n as [|n], m as [|m]; intros H; try easy. Qed. Lemma succ_double_lt_mono n m : n < m -> succ_double n < succ_double m. Proof. destruct n as [|n], m as [|m]; intros H; try easy. Qed. Lemma succ_double_le_mono n m : n <= m -> succ_double n <= succ_double m. Proof. destruct n as [|n], m as [|m]; intros H; try easy. Qed. (** 0 is the least natural number *) Theorem compare_0_r n : (n ?= 0) <> Lt. Proof. now destruct n. Qed. (** Specifications of power *) Lemma pow_0_r n : n ^ 0 = 1. Proof. reflexivity. Qed. Lemma pow_succ_r n p : 0<=p -> n^(succ p) = n * n^p. Proof. intros _. destruct n, p; simpl; trivial; f_equal. apply Pos.pow_succ_r. Qed. Lemma pow_neg_r n p : p<0 -> n^p = 0. Proof. now destruct p. Qed. (** Specification of square *) Lemma square_spec n : square n = n * n. Proof. destruct n; trivial. simpl. f_equal. apply Pos.square_spec. Qed. (** Specification of Base-2 logarithm *) Lemma size_log2 n : n<>0 -> size n = succ (log2 n). Proof. destruct n as [|[n|n| ]]; trivial. now destruct 1. Qed. Lemma size_gt n : n < 2^(size n). Proof. destruct n. - reflexivity. - simpl. apply Pos.size_gt. Qed. Lemma size_le n : 2^(size n) <= succ_double n. Proof. destruct n as [|p]. - discriminate. - simpl. change (2^Pos.size p <= Pos.succ (p~0))%positive. apply Pos.lt_le_incl, Pos.lt_succ_r, Pos.size_le. Qed. Lemma log2_spec n : 0 < n -> 2^(log2 n) <= n < 2^(succ (log2 n)). Proof. destruct n as [|[p|p|]]; discriminate || intros _; simpl; split. - apply (size_le (pos p)). - apply Pos.size_gt. - apply Pos.size_le. - apply Pos.size_gt. - discriminate. - reflexivity. Qed. Lemma log2_nonpos n : n<=0 -> log2 n = 0. Proof. destruct n; intros Hn. - reflexivity. - now destruct Hn. Qed. (** Specification of parity functions *) Lemma even_spec n : even n = true <-> Even n. Proof. destruct n as [|p]. - split. + now exists 0. + trivial. - destruct p as [p|p|]; simpl; split; try easy. + intros (m,H). now destruct m. + now exists (pos p). + intros (m,H). now destruct m. Qed. Lemma odd_spec n : odd n = true <-> Odd n. Proof. destruct n as [|p]. - split. + discriminate. + intros (m,H). now destruct m. - destruct p as [p|p|]; simpl; split; try easy. + now exists (pos p). + intros (m,H). now destruct m. + now exists 0. Qed. (** Specification of the euclidean division *) Theorem pos_div_eucl_spec (a:positive)(b:N) : let (q,r) := pos_div_eucl a b in pos a = q * b + r. Proof. induction a as [a IHa|a IHa|]; cbv beta iota delta [pos_div_eucl]; fold pos_div_eucl; cbv zeta. - (* a~1 *) destruct pos_div_eucl as (q,r). change (pos a~1) with (succ_double (pos a)). rewrite IHa, succ_double_add, double_mul. case leb_spec; intros H; trivial. rewrite succ_double_mul, <- add_assoc. f_equal. now rewrite (add_comm b), sub_add. - (* a~0 *) destruct pos_div_eucl as (q,r). change (pos a~0) with (double (pos a)). rewrite IHa, double_add, double_mul. case leb_spec; intros H; trivial. rewrite succ_double_mul, <- add_assoc. f_equal. now rewrite (add_comm b), sub_add. - (* 1 *) now destruct b as [|[ | | ]]. Qed. Theorem div_eucl_spec a b : let (q,r) := div_eucl a b in a = b * q + r. Proof. destruct a as [|a], b as [|b]; unfold div_eucl; trivial. generalize (pos_div_eucl_spec a (pos b)). destruct pos_div_eucl. now rewrite mul_comm. Qed. Theorem div_mod' a b : a = b * (a/b) + (a mod b). Proof. generalize (div_eucl_spec a b). unfold div, modulo. now destruct div_eucl. Qed. Definition div_mod a b : b<>0 -> a = b * (a/b) + (a mod b). Proof. intros _. apply div_mod'. Qed. Theorem pos_div_eucl_remainder (a:positive) (b:N) : b<>0 -> snd (pos_div_eucl a b) < b. Proof. intros Hb. induction a as [a IHa|a IHa|]; cbv beta iota delta [pos_div_eucl]; fold pos_div_eucl; cbv zeta. - (* a~1 *) destruct pos_div_eucl as (q,r); simpl in *. case leb_spec; intros H; simpl; trivial. apply add_lt_mono_l with b. rewrite add_comm, sub_add by trivial. destruct b as [|b]; [now destruct Hb| simpl; rewrite Pos.add_diag ]. apply (succ_double_lt _ _ IHa). - (* a~0 *) destruct pos_div_eucl as (q,r); simpl in *. case leb_spec; intros H; simpl; trivial. apply add_lt_mono_l with b. rewrite add_comm, sub_add by trivial. destruct b as [|b]; [now destruct Hb| simpl; rewrite Pos.add_diag ]. now destruct r. - (* 1 *) destruct b as [|[ | | ]]; easy || (now destruct Hb). Qed. Theorem mod_lt a b : b<>0 -> a mod b < b. Proof. destruct b as [ |b]. { now destruct 1. } destruct a as [ |a]. { reflexivity. } unfold modulo. simpl. apply pos_div_eucl_remainder. Qed. Theorem mod_bound_pos a b : 0<=a -> 0 0 <= a mod b < b. Proof. intros _ H. split. - apply le_0_l. - apply mod_lt. now destruct b. Qed. (** Specification of square root *) Lemma sqrtrem_sqrt n : fst (sqrtrem n) = sqrt n. Proof. destruct n as [|p]. - reflexivity. - unfold sqrtrem, sqrt, Pos.sqrt. destruct (Pos.sqrtrem p) as (s,r). now destruct r. Qed. Lemma sqrtrem_spec n : let (s,r) := sqrtrem n in n = s*s + r /\ r <= 2*s. Proof. destruct n as [|p]. - now split. - generalize (Pos.sqrtrem_spec p). simpl. destruct 1; simpl; subst; now split. Qed. Lemma sqrt_spec n : 0<=n -> let s := sqrt n in s*s <= n < (succ s)*(succ s). Proof. intros _. destruct n as [|p]. - now split. - apply (Pos.sqrt_spec p). Qed. Lemma sqrt_neg n : n<0 -> sqrt n = 0. Proof. now destruct n. Qed. (** Specification of gcd *) (** The first component of ggcd is gcd *) Lemma ggcd_gcd a b : fst (ggcd a b) = gcd a b. Proof. destruct a as [|p], b as [|q]; simpl; auto. assert (H := Pos.ggcd_gcd p q). destruct Pos.ggcd as (g,(aa,bb)); simpl; now f_equal. Qed. (** The other components of ggcd are indeed the correct factors. *) Lemma ggcd_correct_divisors a b : let '(g,(aa,bb)) := ggcd a b in a=g*aa /\ b=g*bb. Proof. destruct a as [|p], b as [|q]; simpl; auto. - now rewrite Pos.mul_1_r. - now rewrite Pos.mul_1_r. - generalize (Pos.ggcd_correct_divisors p q). destruct Pos.ggcd as (g,(aa,bb)); simpl. destruct 1; split; now f_equal. Qed. (** We can use this fact to prove a part of the gcd correctness *) Lemma gcd_divide_l a b : (gcd a b | a). Proof. rewrite <- ggcd_gcd. generalize (ggcd_correct_divisors a b). destruct ggcd as (g,(aa,bb)); simpl. intros (H,_). exists aa. now rewrite mul_comm. Qed. Lemma gcd_divide_r a b : (gcd a b | b). Proof. rewrite <- ggcd_gcd. generalize (ggcd_correct_divisors a b). destruct ggcd as (g,(aa,bb)); simpl. intros (_,H). exists bb. now rewrite mul_comm. Qed. (** We now prove directly that gcd is the greatest amongst common divisors *) Lemma gcd_greatest a b c : (c|a) -> (c|b) -> (c|gcd a b). Proof. destruct a as [ |p], b as [ |q]; simpl; trivial. destruct c as [ |r]. - intros (s,H). destruct s; discriminate. - intros ([ |s],Hs) ([ |t],Ht); try discriminate; simpl in *. destruct (Pos.gcd_greatest p q r) as (u,H). + exists s. now inversion Hs. + exists t. now inversion Ht. + exists (pos u). simpl; now f_equal. Qed. Lemma gcd_nonneg a b : 0 <= gcd a b. Proof. apply le_0_l. Qed. (** Specification of bitwise functions *) (** Correctness proofs for [testbit]. *) Lemma testbit_even_0 a : testbit (2*a) 0 = false. Proof. now destruct a. Qed. Lemma testbit_odd_0 a : testbit (2*a+1) 0 = true. Proof. now destruct a. Qed. Lemma testbit_succ_r_div2 a n : 0<=n -> testbit a (succ n) = testbit (div2 a) n. Proof. intros _. destruct a as [|[a|a| ]], n as [|n]; simpl; trivial; f_equal; apply Pos.pred_N_succ. Qed. Lemma testbit_odd_succ a n : 0<=n -> testbit (2*a+1) (succ n) = testbit a n. Proof. intros H. rewrite testbit_succ_r_div2 by trivial. f_equal. now destruct a. Qed. Lemma testbit_even_succ a n : 0<=n -> testbit (2*a) (succ n) = testbit a n. Proof. intros H. rewrite testbit_succ_r_div2 by trivial. f_equal. now destruct a. Qed. Lemma testbit_neg_r a n : n<0 -> testbit a n = false. Proof. now destruct n. Qed. (** Correctness proofs for shifts *) Lemma shiftr_succ_r a n : shiftr a (succ n) = div2 (shiftr a n). Proof. destruct n; simpl; trivial. apply Pos.iter_succ. Qed. Lemma shiftl_succ_r a n : shiftl a (succ n) = double (shiftl a n). Proof. destruct n, a; simpl; trivial. f_equal. apply Pos.iter_succ. Qed. Lemma shiftr_spec a n m : 0<=m -> testbit (shiftr a n) m = testbit a (m+n). Proof. intros _. revert a m. induction n as [|n IHn] using peano_ind; intros a m. - now rewrite add_0_r. - rewrite add_comm, add_succ_l, add_comm, <- add_succ_l. now rewrite <- IHn, testbit_succ_r_div2, shiftr_succ_r by apply le_0_l. Qed. Lemma shiftl_spec_high a n m : 0<=m -> n<=m -> testbit (shiftl a n) m = testbit a (m-n). Proof. intros _ H. rewrite <- (sub_add n m H) at 1. set (m' := m-n). clearbody m'. clear H m. revert a m'. induction n using peano_ind; intros a m. - rewrite add_0_r; now destruct a. - rewrite shiftl_succ_r. rewrite add_comm, add_succ_l, add_comm. now rewrite testbit_succ_r_div2, div2_double by apply le_0_l. Qed. Lemma shiftl_spec_low a n m : m testbit (shiftl a n) m = false. Proof. revert a m. induction n as [|n IHn] using peano_ind; intros a m H. - elim (le_0_l m). now rewrite compare_antisym, H. - rewrite shiftl_succ_r. destruct m as [|p]. + now destruct (shiftl a n). + rewrite <- (succ_pos_pred p), testbit_succ_r_div2, div2_double by apply le_0_l. apply IHn. apply add_lt_mono_l with 1. rewrite 2 (add_succ_l 0). simpl. now rewrite succ_pos_pred. Qed. Definition div2_spec a : div2 a = shiftr a 1. Proof. reflexivity. Qed. (** Semantics of bitwise operations *) Lemma pos_lxor_spec p p' n : testbit (Pos.lxor p p') n = xorb (Pos.testbit p n) (Pos.testbit p' n). Proof. revert p' n. induction p as [p IH|p IH|]; intros [p'|p'|] [|n]; trivial; simpl; (specialize (IH p'); destruct Pos.lxor; trivial; now rewrite <-IH) || (now destruct Pos.testbit). Qed. Lemma lxor_spec a a' n : testbit (lxor a a') n = xorb (testbit a n) (testbit a' n). Proof. destruct a, a'; simpl; trivial. - now destruct Pos.testbit. - apply pos_lxor_spec. Qed. Lemma pos_lor_spec p p' n : Pos.testbit (Pos.lor p p') n = (Pos.testbit p n) || (Pos.testbit p' n). Proof. revert p' n. induction p as [p IH|p IH|]; intros [p'|p'|] [|n]; trivial; simpl; apply IH || now rewrite orb_false_r. Qed. Lemma lor_spec a a' n : testbit (lor a a') n = (testbit a n) || (testbit a' n). Proof. destruct a, a'; simpl; trivial. - now rewrite orb_false_r. - apply pos_lor_spec. Qed. Lemma pos_land_spec p p' n : testbit (Pos.land p p') n = (Pos.testbit p n) && (Pos.testbit p' n). Proof. revert p' n. induction p as [p IH|p IH|]; intros [p'|p'|] [|n]; trivial; simpl; (specialize (IH p'); destruct Pos.land; trivial; now rewrite <-IH) || (now rewrite andb_false_r). Qed. Lemma land_spec a a' n : testbit (land a a') n = (testbit a n) && (testbit a' n). Proof. destruct a, a'; simpl; trivial. - now rewrite andb_false_r. - apply pos_land_spec. Qed. Lemma pos_ldiff_spec p p' n : testbit (Pos.ldiff p p') n = (Pos.testbit p n) && negb (Pos.testbit p' n). Proof. revert p' n. induction p as [p IH|p IH|]; intros [p'|p'|] [|n]; trivial; simpl; (specialize (IH p'); destruct Pos.ldiff; trivial; now rewrite <-IH) || (now rewrite andb_true_r). Qed. Lemma ldiff_spec a a' n : testbit (ldiff a a') n = (testbit a n) && negb (testbit a' n). Proof. destruct a, a'; simpl; trivial. - now rewrite andb_true_r. - apply pos_ldiff_spec. Qed. Lemma div_0_r a : a / 0 = 0. Proof. now destruct a. Qed. Lemma mod_0_r a : a mod 0 = a. Proof. now destruct a. Qed. (** Instantiation of generic properties of advanced functions (pow, sqrt, log2, div, gcd, ...) *) Include NExtraPreProp <+ NExtraProp0. Lemma binary_induction (A : N -> Prop) : A 0 -> (forall n, A n -> A (2 * n)) -> (forall n, A n -> A (2 * n + 1)) -> forall n, A n. Proof. apply Private_binary_induction; intros x y ->; reflexivity. Qed. (** In generic statements, the predicates [lt] and [le] have been favored, whereas [gt] and [ge] don't even exist in the abstract layers. The use of [gt] and [ge] is hence not recommended. We provide here the bare minimal results to related them with [lt] and [le]. *) Lemma gt_lt_iff n m : n > m <-> m < n. Proof. unfold lt, gt. now rewrite compare_antisym, CompOpp_iff. Qed. Lemma gt_lt n m : n > m -> m < n. Proof. apply gt_lt_iff. Qed. Lemma lt_gt n m : n < m -> m > n. Proof. apply gt_lt_iff. Qed. Lemma ge_le_iff n m : n >= m <-> m <= n. Proof. unfold le, ge. now rewrite compare_antisym, CompOpp_iff. Qed. Lemma ge_le n m : n >= m -> m <= n. Proof. apply ge_le_iff. Qed. Lemma le_ge n m : n <= m -> m >= n. Proof. apply ge_le_iff. Qed. (** Auxiliary results about right shift on positive numbers, used in BinInt *) Lemma pos_pred_shiftl_low : forall p n m, m testbit (Pos.pred_N (Pos.shiftl p n)) m = true. Proof. intros p n; induction n as [|n IHn] using peano_ind. - now intro m; destruct m. - intros m H. unfold Pos.shiftl. destruct n as [|n]; simpl in *. + destruct m. * now destruct p. * elim (Pos.nlt_1_r _ H). + rewrite Pos.iter_succ. simpl. set (u:=Pos.iter xO p n) in *; clearbody u. destruct m as [|m]. * now destruct u. * rewrite <- (IHn (Pos.pred_N m)). -- rewrite <- (testbit_odd_succ _ (Pos.pred_N m)). ++ rewrite succ_pos_pred. now destruct u. ++ apply le_0_l. -- apply succ_lt_mono. now rewrite succ_pos_pred. Qed. Lemma pos_pred_shiftl_high : forall p n m, n<=m -> testbit (Pos.pred_N (Pos.shiftl p n)) m = testbit (shiftl (Pos.pred_N p) n) m. Proof. intros p n; induction n as [|n IHn] using peano_ind; intros m H. - unfold shiftl. simpl. now destruct (Pos.pred_N p). - rewrite shiftl_succ_r. destruct n as [|n]. + destruct m as [|m]. * now destruct H. * now destruct p. + destruct m as [|m]. * now destruct H. * rewrite <- (succ_pos_pred m). rewrite double_spec, testbit_even_succ by apply le_0_l. rewrite <- IHn. -- rewrite testbit_succ_r_div2 by apply le_0_l. f_equal. simpl. rewrite Pos.iter_succ. now destruct (Pos.iter xO p n). -- apply succ_le_mono. now rewrite succ_pos_pred. Qed. Lemma pred_div2_up p : Pos.pred_N (Pos.div2_up p) = div2 (Pos.pred_N p). Proof. destruct p as [p|p| ]; trivial. - simpl. apply Pos.pred_N_succ. - destruct p; simpl; trivial. Qed. (** ** Properties of [iter] *) Lemma iter_swap_gen A B (f:A -> B) (g:A -> A) (h:B -> B) : (forall a, f (g a) = h (f a)) -> forall n a, f (iter n g a) = iter n h (f a). Proof. intros H n; destruct n; simpl; intros; rewrite ?H; trivial. now apply Pos.iter_swap_gen. Qed. Theorem iter_swap : forall n (A:Type) (f:A -> A) (x:A), iter n f (f x) = f (iter n f x). Proof. intros. symmetry. now apply iter_swap_gen. Qed. Theorem iter_succ : forall n (A:Type) (f:A -> A) (x:A), iter (succ n) f x = f (iter n f x). Proof. intro n; destruct n; intros; simpl; trivial. now apply Pos.iter_succ. Qed. Theorem iter_succ_r : forall n (A:Type) (f:A -> A) (x:A), iter (succ n) f x = iter n f (f x). Proof. intros; now rewrite iter_succ, iter_swap. Qed. Theorem iter_add : forall p q (A:Type) (f:A -> A) (x:A), iter (p+q) f x = iter p f (iter q f x). Proof. intro p; induction p as [|p IHp] using peano_ind; intros; trivial. now rewrite add_succ_l, !iter_succ, IHp. Qed. Theorem iter_ind (A:Type) (f:A -> A) (a:A) (P:N -> A -> Prop) : P 0 a -> (forall n a', P n a' -> P (succ n) (f a')) -> forall n, P n (iter n f a). Proof. intros ? ? n; induction n using peano_ind; trivial. rewrite iter_succ; auto. Qed. Theorem iter_invariant : forall (n:N) (A:Type) (f:A -> A) (Inv:A -> Prop), (forall x:A, Inv x -> Inv (f x)) -> forall x:A, Inv x -> Inv (iter n f x). Proof. intros; apply iter_ind; trivial. Qed. End N. Bind Scope N_scope with N.t N. (** Exportation of notations *) Number Notation N N.of_num_uint N.to_num_uint : N_scope. Infix "+" := N.add : N_scope. Infix "-" := N.sub : N_scope. Infix "*" := N.mul : N_scope. Infix "^" := N.pow : N_scope. Infix "?=" := N.compare (at level 70, no associativity) : N_scope. Infix "<=" := N.le : N_scope. Infix "<" := N.lt : N_scope. Infix ">=" := N.ge : N_scope. Infix ">" := N.gt : N_scope. Notation "x <= y <= z" := (x <= y /\ y <= z) : N_scope. Notation "x <= y < z" := (x <= y /\ y < z) : N_scope. Notation "x < y < z" := (x < y /\ y < z) : N_scope. Notation "x < y <= z" := (x < y /\ y <= z) : N_scope. Infix "=?" := N.eqb (at level 70, no associativity) : N_scope. Infix "<=?" := N.leb (at level 70, no associativity) : N_scope. Infix " m = p. Proof (proj1 (N.add_cancel_l m p n)). Lemma Nmult_Sn_m n m : N.succ n * m = m + n * m. Proof (eq_trans (N.mul_succ_l n m) (N.add_comm _ _)). Lemma Nmult_plus_distr_l n m p : p * (n + m) = p * n + p * m. Proof (N.mul_add_distr_l p n m). Lemma Nmult_reg_r n m p : p <> 0 -> n * p = m * p -> n = m. Proof (fun H => proj1 (N.mul_cancel_r n m p H)). Lemma Ncompare_antisym n m : CompOpp (n ?= m) = (m ?= n). Proof (eq_sym (N.compare_antisym n m)). Definition N_ind_double a P f0 f2 fS2 := N.binary_ind P f0 f2 fS2 a. Definition N_rec_double a P f0 f2 fS2 := N.binary_rec P f0 f2 fS2 a. (** Not kept : Ncompare_n_Sm Nplus_lt_cancel_l *) (** Re-export the notation for those who just [Import BinNat] *) Number Notation N N.of_num_uint N.to_num_hex_uint : hex_N_scope. Number Notation N N.of_num_uint N.to_num_uint : N_scope. coq-8.20.0/theories/NArith/BinNatDef.v000066400000000000000000000214651466560755400174050ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* 2*x+1] *) Definition succ_double x := match x with | 0 => 1 | pos p => pos p~1 end. (** ** Operation [x -> 2*x] *) Definition double n := match n with | 0 => 0 | pos p => pos p~0 end. (** ** Successor *) Definition succ n := match n with | 0 => 1 | pos p => pos (Pos.succ p) end. (** ** Predecessor *) Definition pred n := match n with | 0 => 0 | pos p => Pos.pred_N p end. (** ** The successor of a [N] can be seen as a [positive] *) Definition succ_pos (n : N) : positive := match n with | 0 => 1%positive | pos p => Pos.succ p end. (** ** Addition *) Definition add n m := match n, m with | 0, _ => m | _, 0 => n | pos p, pos q => pos (p + q) end. Infix "+" := add : N_scope. (** Subtraction *) Definition sub n m := match n, m with | 0, _ => 0 | n, 0 => n | pos n', pos m' => match Pos.sub_mask n' m' with | IsPos p => pos p | _ => 0 end end. Infix "-" := sub : N_scope. (** Multiplication *) Definition mul n m := match n, m with | 0, _ => 0 | _, 0 => 0 | pos p, pos q => pos (p * q) end. Infix "*" := mul : N_scope. (** Order *) Definition compare n m := match n, m with | 0, 0 => Eq | 0, pos m' => Lt | pos n', 0 => Gt | pos n', pos m' => (n' ?= m')%positive end. Infix "?=" := compare (at level 70, no associativity) : N_scope. (** Boolean equality and comparison *) Definition eqb n m := match n, m with | 0, 0 => true | pos p, pos q => Pos.eqb p q | _, _ => false end. Definition leb x y := match x ?= y with Gt => false | _ => true end. Definition ltb x y := match x ?= y with Lt => true | _ => false end. Infix "=?" := eqb (at level 70, no associativity) : N_scope. Infix "<=?" := leb (at level 70, no associativity) : N_scope. Infix " n | Gt => n' end. Definition max n n' := match n ?= n' with | Lt | Eq => n' | Gt => n end. (** Dividing by 2 *) Definition div2 n := match n with | 0 => 0 | 1 => 0 | pos (p~0) => pos p | pos (p~1) => pos p end. (** Parity *) Definition even n := match n with | 0 => true | pos (xO _) => true | _ => false end. Definition odd n := negb (even n). (** Power *) Definition pow n p := match p, n with | 0, _ => 1 | _, 0 => 0 | pos p, pos q => pos (q^p) end. Infix "^" := pow : N_scope. (** Square *) Definition square n := match n with | 0 => 0 | pos p => pos (Pos.square p) end. (** Base-2 logarithm *) Definition log2 n := match n with | 0 => 0 | 1 => 0 | pos (p~0) => pos (Pos.size p) | pos (p~1) => pos (Pos.size p) end. (** How many digits in a number ? Number 0 is said to have no digits at all. *) Definition size n := match n with | 0 => 0 | pos p => pos (Pos.size p) end. Definition size_nat n := match n with | 0 => O | pos p => Pos.size_nat p end. (** Euclidean division *) Fixpoint pos_div_eucl (a:positive)(b:N) : N * N := match a with | xH => match b with 1 => (1,0) | _ => (0,1) end | xO a' => let (q, r) := pos_div_eucl a' b in let r' := double r in if b <=? r' then (succ_double q, r' - b) else (double q, r') | xI a' => let (q, r) := pos_div_eucl a' b in let r' := succ_double r in if b <=? r' then (succ_double q, r' - b) else (double q, r') end. Definition div_eucl (a b:N) : N * N := match a, b with | 0, _ => (0, 0) | _, 0 => (0, a) | pos na, _ => pos_div_eucl na b end. Definition div a b := fst (div_eucl a b). Definition modulo a b := snd (div_eucl a b). Infix "/" := div : N_scope. Infix "mod" := modulo (at level 40, no associativity) : N_scope. (** Greatest common divisor *) Definition gcd a b := match a, b with | 0, _ => b | _, 0 => a | pos p, pos q => pos (Pos.gcd p q) end. (** Generalized Gcd, also computing rests of [a] and [b] after division by gcd. *) Definition ggcd a b := match a, b with | 0, _ => (b,(0,1)) | _, 0 => (a,(1,0)) | pos p, pos q => let '(g,(aa,bb)) := Pos.ggcd p q in (pos g, (pos aa, pos bb)) end. (** Square root *) Definition sqrtrem n := match n with | 0 => (0, 0) | pos p => match Pos.sqrtrem p with | (s, IsPos r) => (pos s, pos r) | (s, _) => (pos s, 0) end end. Definition sqrt n := match n with | 0 => 0 | pos p => pos (Pos.sqrt p) end. (** Operation over bits of a [N] number. *) (** Logical [or] *) Definition lor n m := match n, m with | 0, _ => m | _, 0 => n | pos p, pos q => pos (Pos.lor p q) end. (** Logical [and] *) Definition land n m := match n, m with | 0, _ => 0 | _, 0 => 0 | pos p, pos q => Pos.land p q end. (** Logical [diff] *) Definition ldiff n m := match n, m with | 0, _ => 0 | _, 0 => n | pos p, pos q => Pos.ldiff p q end. (** [xor] *) Definition lxor n m := match n, m with | 0, _ => m | _, 0 => n | pos p, pos q => Pos.lxor p q end. (** Shifts *) Definition shiftl_nat (a:N) := nat_rect _ a (fun _ => double). Definition shiftr_nat (a:N) := nat_rect _ a (fun _ => div2). Definition shiftl a n := match a with | 0 => 0 | pos a => pos (Pos.shiftl a n) end. Definition shiftr a n := match n with | 0 => a | pos p => Pos.iter div2 a p end. (** Checking whether a particular bit is set or not *) Definition testbit_nat (a:N) := match a with | 0 => fun _ => false | pos p => Pos.testbit_nat p end. (** Same, but with index in N *) Definition testbit a n := match a with | 0 => false | pos p => Pos.testbit p n end. (** Translation from [N] to [nat] and back. *) Definition to_nat (a:N) := match a with | 0 => O | pos p => Pos.to_nat p end. Definition of_nat (n:nat) := match n with | O => 0 | S n' => pos (Pos.of_succ_nat n') end. (** Iteration of a function *) Definition iter (n:N) {A} (f:A->A) (x:A) : A := match n with | 0 => x | pos p => Pos.iter f x p end. (** Conversion with a decimal representation for printing/parsing *) Definition of_uint (d:Decimal.uint) := Pos.of_uint d. Definition of_hex_uint (d:Hexadecimal.uint) := Pos.of_hex_uint d. Definition of_num_uint (d:Number.uint) := match d with | Number.UIntDecimal d => of_uint d | Number.UIntHexadecimal d => of_hex_uint d end. Definition of_int (d:Decimal.int) := match Decimal.norm d with | Decimal.Pos d => Some (Pos.of_uint d) | Decimal.Neg _ => None end. Definition of_hex_int (d:Hexadecimal.int) := match Hexadecimal.norm d with | Hexadecimal.Pos d => Some (Pos.of_hex_uint d) | Hexadecimal.Neg _ => None end. Definition of_num_int (d:Number.int) := match d with | Number.IntDecimal d => of_int d | Number.IntHexadecimal d => of_hex_int d end. Definition to_uint n := match n with | 0 => Decimal.zero | pos p => Pos.to_uint p end. Definition to_hex_uint n := match n with | 0 => Hexadecimal.zero | pos p => Pos.to_hex_uint p end. Definition to_num_uint n := Number.UIntDecimal (to_uint n). Definition to_num_hex_uint n := Number.UIntHexadecimal (to_hex_uint n). Definition to_int n := Decimal.Pos (to_uint n). Definition to_hex_int n := Hexadecimal.Pos (to_hex_uint n). Definition to_num_int n := Number.IntDecimal (to_int n). Definition to_num_hex_int n := Number.IntHexadecimal (to_hex_int n). Number Notation N of_num_uint to_num_hex_uint : hex_N_scope. Number Notation N of_num_uint to_num_uint : N_scope. End N. (** Re-export the notation for those who just [Import NatIntDef] *) Number Notation N N.of_num_uint N.to_num_hex_uint : hex_N_scope. Number Notation N N.of_num_uint N.to_num_uint : N_scope. coq-8.20.0/theories/NArith/NArith.v000066400000000000000000000023331466560755400167710ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* y<=x -> x=y]. *) Local Open Scope N_scope. Section TestOrder. Let test : forall x y, x<=y -> y<=x -> x=y. Proof. N.order. Defined. End TestOrder. coq-8.20.0/theories/NArith/Ndec.v000066400000000000000000000227701466560755400164640ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* p = p'. Proof. now apply Pos.eqb_eq. Qed. Lemma Peqb_Pcompare p p' : Pos.eqb p p' = true -> Pos.compare p p' = Eq. Proof. now rewrite Pos.compare_eq_iff, <- Pos.eqb_eq. Qed. Lemma Pcompare_Peqb p p' : Pos.compare p p' = Eq -> Pos.eqb p p' = true. Proof. now rewrite Pos.eqb_eq, <- Pos.compare_eq_iff. Qed. Lemma Neqb_Ncompare n n' : N.eqb n n' = true -> N.compare n n' = Eq. Proof. now rewrite N.compare_eq_iff, <- N.eqb_eq. Qed. Lemma Ncompare_Neqb n n' : N.compare n n' = Eq -> N.eqb n n' = true. Proof. now rewrite N.eqb_eq, <- N.compare_eq_iff. Qed. Lemma Neqb_complete n n' : N.eqb n n' = true -> n = n'. Proof. now apply N.eqb_eq. Qed. Lemma Nxor_eq_true n n' : N.lxor n n' = 0 -> N.eqb n n' = true. Proof. intro H. apply N.lxor_eq in H. subst. apply N.eqb_refl. Qed. Ltac eqb2eq := rewrite <- ?not_true_iff_false in *; rewrite ?N.eqb_eq in *. Lemma Nxor_eq_false n n' p : N.lxor n n' = N.pos p -> N.eqb n n' = false. Proof. intros. eqb2eq. intro. subst. now rewrite N.lxor_nilpotent in *. Qed. Lemma Nodd_not_double a : N.odd a = true -> forall a0, N.eqb (N.double a0) a = false. Proof. intros H **; eqb2eq. rewrite N.double_spec; intro; subst. rewrite N.odd_mul, N.odd_2 in *; discriminate. Qed. Lemma Nnot_div2_not_double a a0 : N.eqb (N.div2 a) a0 = false -> N.eqb a (N.double a0) = false. Proof. intros H. eqb2eq. contradict H. subst. apply N.div2_double. Qed. Lemma Neven_not_double_plus_one a : N.even a = true -> forall a0, N.eqb (N.succ_double a0) a = false. Proof. intros H **; eqb2eq. rewrite N.succ_double_spec; intro; subst. rewrite N.add_comm, N.even_add_mul_2 in *; discriminate. Qed. Lemma Nnot_div2_not_double_plus_one a a0 : N.eqb (N.div2 a) a0 = false -> N.eqb (N.succ_double a0) a = false. Proof. intros H. eqb2eq. contradict H. subst. apply N.div2_succ_double. Qed. Lemma Nbit0_neq a a' : N.odd a = false -> N.odd a' = true -> N.eqb a a' = false. Proof. intros. eqb2eq. now intros <-. Qed. Lemma Ndiv2_eq a a' : N.eqb a a' = true -> N.eqb (N.div2 a) (N.div2 a') = true. Proof. intros. eqb2eq. now subst. Qed. Lemma Ndiv2_neq a a' : N.eqb (N.div2 a) (N.div2 a') = false -> N.eqb a a' = false. Proof. intros H. eqb2eq. contradict H. now subst. Qed. Lemma Ndiv2_bit_eq a a' : N.odd a = N.odd a' -> N.div2 a = N.div2 a' -> a = a'. Proof. intros H H'; now rewrite (N.div2_odd a), (N.div2_odd a'), H, H'. Qed. Lemma Ndiv2_bit_neq a a' : N.eqb a a' = false -> N.odd a = N.odd a' -> N.eqb (N.div2 a) (N.div2 a') = false. Proof. intros H H'. eqb2eq. contradict H. now apply Ndiv2_bit_eq. Qed. Lemma Nneq_elim a a' : N.eqb a a' = false -> N.odd a = negb (N.odd a') \/ N.eqb (N.div2 a) (N.div2 a') = false. Proof. intros. enough (N.odd a = N.odd a' \/ N.odd a = negb (N.odd a')) as []. - right. apply Ndiv2_bit_neq; assumption. - left. assumption. - case (N.odd a), (N.odd a'); auto. Qed. Lemma Ndouble_or_double_plus_un a : {a0 : N | a = N.double a0} + {a1 : N | a = N.succ_double a1}. Proof. elim (sumbool_of_bool (N.odd a)); intros H; [right|left]; exists (N.div2 a); symmetry; rewrite ?N.succ_double_spec, ?N.double_spec, N.div2_odd, H, ?N.add_0_r; trivial. Qed. (** An inefficient boolean order on [N]. Please use [N.leb] instead now. *) Definition Nleb (a b:N) := leb (N.to_nat a) (N.to_nat b). Lemma Nleb_alt a b : Nleb a b = N.leb a b. Proof. unfold Nleb. now rewrite eq_iff_eq_true, N.leb_le, leb_compare, <- N2Nat.inj_compare. Qed. Lemma Nleb_Nle a b : Nleb a b = true <-> a <= b. Proof. now rewrite Nleb_alt, N.leb_le. Qed. Lemma Nleb_refl a : Nleb a a = true. Proof. rewrite Nleb_Nle; apply N.le_refl. Qed. Lemma Nleb_antisym a b : Nleb a b = true -> Nleb b a = true -> a = b. Proof. rewrite !Nleb_Nle. apply N.le_antisymm. Qed. Lemma Nleb_trans a b c : Nleb a b = true -> Nleb b c = true -> Nleb a c = true. Proof. rewrite !Nleb_Nle. apply N.le_trans. Qed. Lemma Nleb_ltb_trans a b c : Nleb a b = true -> Nleb c b = false -> Nleb c a = false. Proof. unfold Nleb. intros. apply leb_correct_conv. apply Nat.le_lt_trans with (m := N.to_nat b). - apply leb_complete. assumption. - apply leb_complete_conv. assumption. Qed. Lemma Nltb_leb_trans a b c : Nleb b a = false -> Nleb b c = true -> Nleb c a = false. Proof. unfold Nleb. intros. apply leb_correct_conv. apply Nat.lt_le_trans with (m := N.to_nat b). - apply leb_complete_conv. assumption. - apply leb_complete. assumption. Qed. Lemma Nltb_trans a b c : Nleb b a = false -> Nleb c b = false -> Nleb c a = false. Proof. unfold Nleb. intros. apply leb_correct_conv. apply Nat.lt_trans with (m := N.to_nat b). - apply leb_complete_conv. assumption. - apply leb_complete_conv. assumption. Qed. Lemma Nltb_leb_weak a b : Nleb b a = false -> Nleb a b = true. Proof. unfold Nleb. intros. apply leb_correct. apply Nat.lt_le_incl. apply leb_complete_conv. assumption. Qed. Lemma Nleb_double_mono a b : Nleb a b = true -> Nleb (N.double a) (N.double b) = true. Proof. unfold Nleb. intros. rewrite !N2Nat.inj_double. apply leb_correct. apply Nat.mul_le_mono_l. now apply leb_complete. Qed. Lemma Nleb_double_plus_one_mono a b : Nleb a b = true -> Nleb (N.succ_double a) (N.succ_double b) = true. Proof. unfold Nleb. intros. rewrite !N2Nat.inj_succ_double. apply leb_correct. apply le_n_S, Nat.mul_le_mono_l. now apply leb_complete. Qed. Lemma Nleb_double_mono_conv a b : Nleb (N.double a) (N.double b) = true -> Nleb a b = true. Proof. unfold Nleb. rewrite !N2Nat.inj_double. intro. apply leb_correct. apply <- (Nat.mul_le_mono_pos_l (N.to_nat a) (N.to_nat b) 2); auto. now apply leb_complete. Qed. Lemma Nleb_double_plus_one_mono_conv a b : Nleb (N.succ_double a) (N.succ_double b) = true -> Nleb a b = true. Proof. unfold Nleb. rewrite !N2Nat.inj_succ_double. intro. apply leb_correct. apply <- (Nat.mul_le_mono_pos_l (N.to_nat a) (N.to_nat b) 2); auto. now apply leb_complete. Qed. Lemma Nltb_double_mono a b : Nleb a b = false -> Nleb (N.double a) (N.double b) = false. Proof. intros. elim (sumbool_of_bool (Nleb (N.double a) (N.double b))). - intro H0. rewrite (Nleb_double_mono_conv _ _ H0) in H. discriminate H. - trivial. Qed. Lemma Nltb_double_plus_one_mono a b : Nleb a b = false -> Nleb (N.succ_double a) (N.succ_double b) = false. Proof. intros. elim (sumbool_of_bool (Nleb (N.succ_double a) (N.succ_double b))). - intro H0. rewrite (Nleb_double_plus_one_mono_conv _ _ H0) in H. discriminate H. - trivial. Qed. Lemma Nltb_double_mono_conv a b : Nleb (N.double a) (N.double b) = false -> Nleb a b = false. Proof. intros. elim (sumbool_of_bool (Nleb a b)). - intro H0. rewrite (Nleb_double_mono _ _ H0) in H. discriminate H. - trivial. Qed. Lemma Nltb_double_plus_one_mono_conv a b : Nleb (N.succ_double a) (N.succ_double b) = false -> Nleb a b = false. Proof. intros. elim (sumbool_of_bool (Nleb a b)). - intro H0. rewrite (Nleb_double_plus_one_mono _ _ H0) in H. discriminate H. - trivial. Qed. (* Nleb and N.compare *) (* NB: No need to prove that Nleb a b = true <-> N.compare a b <> Gt, this statement is in fact Nleb_Nle! *) Lemma Nltb_Ncompare a b : Nleb a b = false <-> N.compare a b = Gt. Proof. now rewrite N.compare_nle_iff, <- Nleb_Nle, not_true_iff_false. Qed. Lemma Ncompare_Gt_Nltb a b : N.compare a b = Gt -> Nleb a b = false. Proof. apply <- Nltb_Ncompare; auto. Qed. Lemma Ncompare_Lt_Nltb a b : N.compare a b = Lt -> Nleb b a = false. Proof. intros H. rewrite Nltb_Ncompare, N.compare_antisym, H; auto. Qed. (* Old results about [N.min] *) Notation Nmin_choice := N.min_dec (only parsing). Lemma Nmin_le_1 a b : Nleb (N.min a b) a = true. Proof. rewrite Nleb_Nle. apply N.le_min_l. Qed. Lemma Nmin_le_2 a b : Nleb (N.min a b) b = true. Proof. rewrite Nleb_Nle. apply N.le_min_r. Qed. Lemma Nmin_le_3 a b c : Nleb a (N.min b c) = true -> Nleb a b = true. Proof. rewrite !Nleb_Nle. apply N.min_glb_l. Qed. Lemma Nmin_le_4 a b c : Nleb a (N.min b c) = true -> Nleb a c = true. Proof. rewrite !Nleb_Nle. apply N.min_glb_r. Qed. Lemma Nmin_le_5 a b c : Nleb a b = true -> Nleb a c = true -> Nleb a (N.min b c) = true. Proof. rewrite !Nleb_Nle. apply N.min_glb. Qed. Lemma Nmin_lt_3 a b c : Nleb (N.min b c) a = false -> Nleb b a = false. Proof. rewrite <- !not_true_iff_false, !Nleb_Nle. rewrite N.min_le_iff; auto. Qed. Lemma Nmin_lt_4 a b c : Nleb (N.min b c) a = false -> Nleb c a = false. Proof. rewrite <- !not_true_iff_false, !Nleb_Nle. rewrite N.min_le_iff; auto. Qed. coq-8.20.0/theories/NArith/Ndiv_def.v000066400000000000000000000023771466560755400173320ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* a = a'. Proof. intro H. rewrite <- (id a), <- (id a'). now f_equal. Qed. Lemma inj_iff a a' : N.to_nat a = N.to_nat a' <-> a = a'. Proof. split. - apply inj. - intros; now subst. Qed. (** Interaction of this translation and usual operations. *) Lemma inj_0 : N.to_nat 0 = 0. Proof. reflexivity. Qed. Lemma inj_double a : N.to_nat (N.double a) = 2*(N.to_nat a). Proof. destruct a; simpl N.to_nat; trivial. apply Pos2Nat.inj_xO. Qed. Lemma inj_succ_double a : N.to_nat (N.succ_double a) = S (2*(N.to_nat a)). Proof. destruct a; simpl N.to_nat; trivial. apply Pos2Nat.inj_xI. Qed. Lemma inj_succ a : N.to_nat (N.succ a) = S (N.to_nat a). Proof. destruct a; simpl; trivial. apply Pos2Nat.inj_succ. Qed. Lemma inj_add a a' : N.to_nat (a + a') = N.to_nat a + N.to_nat a'. Proof. destruct a, a'; simpl; trivial. apply Pos2Nat.inj_add. Qed. Lemma inj_mul a a' : N.to_nat (a * a') = N.to_nat a * N.to_nat a'. Proof. destruct a, a'; simpl; trivial. apply Pos2Nat.inj_mul. Qed. Lemma inj_sub a a' : N.to_nat (a - a') = N.to_nat a - N.to_nat a'. Proof. destruct a as [|a], a' as [|a']; simpl; rewrite ?Nat.sub_0_r; trivial. destruct (Pos.compare_spec a a') as [H|H|H]. - subst. now rewrite Pos.sub_mask_diag, Nat.sub_diag. - rewrite Pos.sub_mask_neg; trivial. apply Pos2Nat.inj_lt in H. simpl; symmetry; apply Nat.sub_0_le. now apply Nat.lt_le_incl. - destruct (Pos.sub_mask_pos' _ _ H) as (q & -> & Hq). simpl; symmetry; apply Nat.add_sub_eq_l. now rewrite <- Hq, Pos2Nat.inj_add. Qed. Lemma inj_pred a : N.to_nat (N.pred a) = Nat.pred (N.to_nat a). Proof. rewrite <- Nat.sub_1_r, N.pred_sub. apply inj_sub. Qed. Lemma inj_div2 a : N.to_nat (N.div2 a) = Nat.div2 (N.to_nat a). Proof. destruct a as [|[p|p| ]]; trivial. - unfold N.div2, N.to_nat. now rewrite Pos2Nat.inj_xI, Nat.div2_succ_double. - unfold N.div2, N.to_nat. now rewrite Pos2Nat.inj_xO, Nat.div2_double. Qed. Lemma inj_compare a a' : (a ?= a')%N = (N.to_nat a ?= N.to_nat a'). Proof. destruct a as [|p], a' as [|p']; simpl; trivial. - now destruct (Pos2Nat.is_succ p') as (n,->). - now destruct (Pos2Nat.is_succ p) as (n,->). - apply Pos2Nat.inj_compare. Qed. Lemma inj_div n m : N.to_nat (n / m) = N.to_nat n / N.to_nat m. Proof. destruct m as [|m]; [now destruct n|]. apply Nat.div_unique with (N.to_nat (n mod (N.pos m))). - apply Nat.compare_lt_iff. rewrite <- inj_compare. now apply N.mod_lt. - now rewrite <- inj_mul, <- inj_add, <- N.div_mod. Qed. Lemma inj_mod a a' : N.to_nat (a mod a') = N.to_nat a mod N.to_nat a'. Proof. destruct a' as [|a']; [now destruct a|]. apply Nat.mod_unique with (N.to_nat (a / (N.pos a'))). - apply Nat.compare_lt_iff. rewrite <- inj_compare. now apply N.mod_lt. - now rewrite <- inj_mul, <- inj_add, <- N.div_mod. Qed. Lemma inj_pow a a' : N.to_nat (a ^ a') = N.to_nat a ^ N.to_nat a'. Proof. destruct a, a'; [easy| |easy|apply Pos2Nat.inj_pow]. now rewrite N.pow_0_l, Nat.pow_0_l; [|rewrite <- inj_0; intros ? %inj|]. Qed. Lemma inj_max a a' : N.to_nat (N.max a a') = Nat.max (N.to_nat a) (N.to_nat a'). Proof. unfold N.max. rewrite inj_compare; symmetry. case Nat.compare_spec; intros. - now apply Nat.max_r, Nat.eq_le_incl. - now apply Nat.max_r, Nat.lt_le_incl. - now apply Nat.max_l, Nat.lt_le_incl. Qed. Lemma inj_min a a' : N.to_nat (N.min a a') = Nat.min (N.to_nat a) (N.to_nat a'). Proof. unfold N.min; rewrite inj_compare. symmetry. case Nat.compare_spec; intros. - now apply Nat.min_l, Nat.eq_le_incl. - now apply Nat.min_l, Nat.lt_le_incl. - now apply Nat.min_r, Nat.lt_le_incl. Qed. Lemma inj_iter a {A} (f:A->A) (x:A) : N.iter a f x = Nat.iter (N.to_nat a) f x. Proof. destruct a as [|a]. - trivial. - apply Pos2Nat.inj_iter. Qed. End N2Nat. Global Hint Rewrite N2Nat.inj_div N2Nat.inj_mod N2Nat.inj_pow N2Nat.inj_double N2Nat.inj_succ_double N2Nat.inj_succ N2Nat.inj_add N2Nat.inj_mul N2Nat.inj_sub N2Nat.inj_pred N2Nat.inj_div2 N2Nat.inj_max N2Nat.inj_min N2Nat.id : Nnat. (** * Conversions from [nat] to [N] *) Module Nat2N. (** [N.of_nat] is an bijection between [nat] and [N], with [N.to_nat] as reciprocal. See [N2Nat.id] above for the dual equation. *) Lemma id n : N.to_nat (N.of_nat n) = n. Proof. induction n; simpl; trivial. apply SuccNat2Pos.id_succ. Qed. Global Hint Rewrite id : Nnat. Ltac nat2N := apply N2Nat.inj; now autorewrite with Nnat. (** [N.of_nat] is hence injective *) Lemma inj n n' : N.of_nat n = N.of_nat n' -> n = n'. Proof. intros H. rewrite <- (id n), <- (id n'). now f_equal. Qed. Lemma inj_iff n n' : N.of_nat n = N.of_nat n' <-> n = n'. Proof. split. - apply inj. - intros; now subst. Qed. (** Interaction of this translation and usual operations. *) Lemma inj_double n : N.of_nat (2*n) = N.double (N.of_nat n). Proof. nat2N. Qed. Lemma inj_succ_double n : N.of_nat (S (2*n)) = N.succ_double (N.of_nat n). Proof. nat2N. Qed. Lemma inj_succ n : N.of_nat (S n) = N.succ (N.of_nat n). Proof. nat2N. Qed. Lemma inj_pred n : N.of_nat (Nat.pred n) = N.pred (N.of_nat n). Proof. nat2N. Qed. Lemma inj_add n n' : N.of_nat (n+n') = (N.of_nat n + N.of_nat n')%N. Proof. nat2N. Qed. Lemma inj_sub n n' : N.of_nat (n-n') = (N.of_nat n - N.of_nat n')%N. Proof. nat2N. Qed. Lemma inj_mul n n' : N.of_nat (n*n') = (N.of_nat n * N.of_nat n')%N. Proof. nat2N. Qed. Lemma inj_div2 n : N.of_nat (Nat.div2 n) = N.div2 (N.of_nat n). Proof. nat2N. Qed. Lemma inj_compare n n' : (n ?= n') = (N.of_nat n ?= N.of_nat n')%N. Proof. now rewrite N2Nat.inj_compare, !id. Qed. Lemma inj_div n n' : N.of_nat (n / n') = (N.of_nat n / N.of_nat n')%N. Proof. nat2N. Qed. Lemma inj_mod n n' : N.of_nat (n mod n') = (N.of_nat n mod N.of_nat n')%N. Proof. nat2N. Qed. Lemma inj_pow n n' : N.of_nat (n ^ n') = (N.of_nat n ^ N.of_nat n')%N. Proof. nat2N. Qed. Lemma inj_min n n' : N.of_nat (Nat.min n n') = N.min (N.of_nat n) (N.of_nat n'). Proof. nat2N. Qed. Lemma inj_max n n' : N.of_nat (Nat.max n n') = N.max (N.of_nat n) (N.of_nat n'). Proof. nat2N. Qed. Lemma inj_iter n {A} (f:A->A) (x:A) : Nat.iter n f x = N.iter (N.of_nat n) f x. Proof. now rewrite N2Nat.inj_iter, !id. Qed. End Nat2N. Global Hint Rewrite Nat2N.id : Nnat. (** Compatibility notations *) Notation nat_of_N_inj := N2Nat.inj (only parsing). Notation N_of_nat_of_N := N2Nat.id (only parsing). Notation nat_of_Ndouble := N2Nat.inj_double (only parsing). Notation nat_of_Ndouble_plus_one := N2Nat.inj_succ_double (only parsing). Notation nat_of_Nsucc := N2Nat.inj_succ (only parsing). Notation nat_of_Nplus := N2Nat.inj_add (only parsing). Notation nat_of_Nmult := N2Nat.inj_mul (only parsing). Notation nat_of_Nminus := N2Nat.inj_sub (only parsing). Notation nat_of_Npred := N2Nat.inj_pred (only parsing). Notation nat_of_Ndiv2 := N2Nat.inj_div2 (only parsing). Notation nat_of_Ncompare := N2Nat.inj_compare (only parsing). Notation nat_of_Ndiv := N2Nat.inj_div (only parsing). Notation nat_of_Nmod := N2Nat.inj_mod (only parsing). Notation nat_of_Npow := N2Nat.inj_pow (only parsing). Notation nat_of_Nmax := N2Nat.inj_max (only parsing). Notation nat_of_Nmin := N2Nat.inj_min (only parsing). Notation nat_of_N_of_nat := Nat2N.id (only parsing). Notation N_of_nat_inj := Nat2N.inj (only parsing). Notation N_of_double := Nat2N.inj_double (only parsing). Notation N_of_double_plus_one := Nat2N.inj_succ_double (only parsing). Notation N_of_S := Nat2N.inj_succ (only parsing). Notation N_of_pred := Nat2N.inj_pred (only parsing). Notation N_of_plus := Nat2N.inj_add (only parsing). Notation N_of_minus := Nat2N.inj_sub (only parsing). Notation N_of_mult := Nat2N.inj_mul (only parsing). Notation N_of_div2 := Nat2N.inj_div2 (only parsing). Notation N_of_nat_compare := Nat2N.inj_compare (only parsing). Notation N_of_nat_div := Nat2N.inj_div (only parsing). Notation N_of_nat_mod := Nat2N.inj_mod (only parsing). Notation N_of_nat_pow := Nat2N.inj_pow (only parsing). Notation N_of_min := Nat2N.inj_min (only parsing). Notation N_of_max := Nat2N.inj_max (only parsing). coq-8.20.0/theories/NArith/Nsqrt_def.v000066400000000000000000000015401466560755400175300ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* N.sqrt_spec n (N.le_0_l n)) (only parsing). coq-8.20.0/theories/Numbers/000077500000000000000000000000001466560755400156425ustar00rootroot00000000000000coq-8.20.0/theories/Numbers/AltBinNotations.v000066400000000000000000000045751466560755400211140ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* Some p | _ => None end. Definition pos_to_z p := Zpos p. Number Notation positive pos_of_z pos_to_z : positive_scope. (** [N] *) Definition n_of_z z := match z with | Z0 => Some N0 | Zpos p => Some (Npos p) | Zneg _ => None end. Definition n_to_z n := match n with | N0 => Z0 | Npos p => Zpos p end. Number Notation N n_of_z n_to_z : N_scope. (** [Z] *) Definition z_of_z (z:Z) := z. Number Notation Z z_of_z z_of_z : Z_scope. coq-8.20.0/theories/Numbers/BinNums.v000066400000000000000000000054611466560755400174120ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* positive | xO : positive -> positive | xH : positive. Declare Scope positive_scope. Delimit Scope positive_scope with positive. Bind Scope positive_scope with positive. Arguments xO _%_positive. Arguments xI _%_positive. Declare Scope hex_positive_scope. Delimit Scope hex_positive_scope with xpositive. Register positive as num.pos.type. Register xI as num.pos.xI. Register xO as num.pos.xO. Register xH as num.pos.xH. (** [N] is a datatype representing natural numbers in a binary way, by extending the [positive] datatype with a zero. Numbers in [N] will also be denoted using a decimal notation; e.g. [6%N] will abbreviate [Npos (xO (xI xH))] *) Inductive N : Set := | N0 : N | Npos : positive -> N. Declare Scope N_scope. Delimit Scope N_scope with N. Bind Scope N_scope with N. Arguments Npos _%_positive. Declare Scope hex_N_scope. Delimit Scope hex_N_scope with xN. Register N as num.N.type. Register N0 as num.N.N0. Register Npos as num.N.Npos. (** [Z] is a datatype representing the integers in a binary way. An integer is either zero or a strictly positive number (coded as a [positive]) or a strictly negative number (whose opposite is stored as a [positive] value). Numbers in [Z] will also be denoted using a decimal notation; e.g. [(-6)%Z] will abbreviate [Zneg (xO (xI xH))] *) Inductive Z : Set := | Z0 : Z | Zpos : positive -> Z | Zneg : positive -> Z. Declare Scope Z_scope. Delimit Scope Z_scope with Z. Bind Scope Z_scope with Z. Arguments Zpos _%_positive. Arguments Zneg _%_positive. Declare Scope hex_Z_scope. Delimit Scope hex_Z_scope with xZ. Register Z as num.Z.type. Register Z0 as num.Z.Z0. Register Zpos as num.Z.Zpos. Register Zneg as num.Z.Zneg. coq-8.20.0/theories/Numbers/Cyclic/000077500000000000000000000000001466560755400170505ustar00rootroot00000000000000coq-8.20.0/theories/Numbers/Cyclic/Abstract/000077500000000000000000000000001466560755400206135ustar00rootroot00000000000000coq-8.20.0/theories/Numbers/Cyclic/Abstract/CarryType.v000066400000000000000000000016571466560755400227350ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* carry A | C1 : A -> carry A. coq-8.20.0/theories/Numbers/Cyclic/Abstract/CyclicAxioms.v000066400000000000000000000313441466560755400233760ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* Z; of_pos : positive -> N * t; (* Euclidean division by [2^digits] *) head0 : t -> t; (* number of digits 0 in front of the number *) tail0 : t -> t; (* number of digits 0 at the bottom of the number *) (* Basic numbers *) zero : t; one : t; minus_one : t; (* [2^digits-1], which is equivalent to [-1] *) (* Comparison *) compare : t -> t -> comparison; eq0 : t -> bool; (* Basic arithmetic operations *) opp_c : t -> carry t; opp : t -> t; opp_carry : t -> t; (* the carry is known to be -1 *) succ_c : t -> carry t; add_c : t -> t -> carry t; add_carry_c : t -> t -> carry t; succ : t -> t; add : t -> t -> t; add_carry : t -> t -> t; pred_c : t -> carry t; sub_c : t -> t -> carry t; sub_carry_c : t -> t -> carry t; pred : t -> t; sub : t -> t -> t; sub_carry : t -> t -> t; mul_c : t -> t -> zn2z t; mul : t -> t -> t; square_c : t -> zn2z t; (* Special divisions operations *) div21 : t -> t -> t -> t*t; div_gt : t -> t -> t * t; (* specialized version of [div] *) div : t -> t -> t * t; modulo_gt : t -> t -> t; (* specialized version of [mod] *) modulo : t -> t -> t; gcd_gt : t -> t -> t; (* specialized version of [gcd] *) gcd : t -> t -> t; (* [add_mul_div p i j] is a combination of the [(digits-p)] low bits of [i] above the [p] high bits of [j]: [add_mul_div p i j = i*2^p+j/2^(digits-p)] *) add_mul_div : t -> t -> t -> t; (* [pos_mod p i] is [i mod 2^p] *) pos_mod : t -> t -> t; is_even : t -> bool; (* square root *) sqrt2 : t -> t -> t * carry t; sqrt : t -> t; (* bitwise operations *) lor : t -> t -> t; land : t -> t -> t; lxor : t -> t -> t }. Section Specs. Context {t : Set}{ops : Ops t}. Notation "[| x |]" := (to_Z x) (at level 0, x at level 99). Let wB := base digits. Notation "[+| c |]" := (interp_carry 1 wB to_Z c) (at level 0, c at level 99). Notation "[-| c |]" := (interp_carry (-1) wB to_Z c) (at level 0, c at level 99). Notation "[|| x ||]" := (zn2z_to_Z wB to_Z x) (at level 0, x at level 99). Class Specs := MkSpecs { (* Conversion functions with Z *) spec_to_Z : forall x, 0 <= [| x |] < wB; spec_of_pos : forall p, Zpos p = (Z.of_N (fst (of_pos p)))*wB + [|(snd (of_pos p))|]; spec_zdigits : [| zdigits |] = Zpos digits; spec_more_than_1_digit: 1 < Zpos digits; (* Basic numbers *) spec_0 : [|zero|] = 0; spec_1 : [|one|] = 1; spec_m1 : [|minus_one|] = wB - 1; (* Comparison *) spec_compare : forall x y, compare x y = ([|x|] ?= [|y|]); (* NB: the spec of [eq0] is deliberately partial, see DoubleCyclic where [eq0 x = true <-> x = W0] *) spec_eq0 : forall x, eq0 x = true -> [|x|] = 0; (* Basic arithmetic operations *) spec_opp_c : forall x, [-|opp_c x|] = -[|x|]; spec_opp : forall x, [|opp x|] = (-[|x|]) mod wB; spec_opp_carry : forall x, [|opp_carry x|] = wB - [|x|] - 1; spec_succ_c : forall x, [+|succ_c x|] = [|x|] + 1; spec_add_c : forall x y, [+|add_c x y|] = [|x|] + [|y|]; spec_add_carry_c : forall x y, [+|add_carry_c x y|] = [|x|] + [|y|] + 1; spec_succ : forall x, [|succ x|] = ([|x|] + 1) mod wB; spec_add : forall x y, [|add x y|] = ([|x|] + [|y|]) mod wB; spec_add_carry : forall x y, [|add_carry x y|] = ([|x|] + [|y|] + 1) mod wB; spec_pred_c : forall x, [-|pred_c x|] = [|x|] - 1; spec_sub_c : forall x y, [-|sub_c x y|] = [|x|] - [|y|]; spec_sub_carry_c : forall x y, [-|sub_carry_c x y|] = [|x|] - [|y|] - 1; spec_pred : forall x, [|pred x|] = ([|x|] - 1) mod wB; spec_sub : forall x y, [|sub x y|] = ([|x|] - [|y|]) mod wB; spec_sub_carry : forall x y, [|sub_carry x y|] = ([|x|] - [|y|] - 1) mod wB; spec_mul_c : forall x y, [|| mul_c x y ||] = [|x|] * [|y|]; spec_mul : forall x y, [|mul x y|] = ([|x|] * [|y|]) mod wB; spec_square_c : forall x, [|| square_c x||] = [|x|] * [|x|]; (* Special divisions operations *) spec_div21 : forall a1 a2 b, wB/2 <= [|b|] -> [|a1|] < [|b|] -> let (q,r) := div21 a1 a2 b in [|a1|] *wB+ [|a2|] = [|q|] * [|b|] + [|r|] /\ 0 <= [|r|] < [|b|]; spec_div_gt : forall a b, [|a|] > [|b|] -> 0 < [|b|] -> let (q,r) := div_gt a b in [|a|] = [|q|] * [|b|] + [|r|] /\ 0 <= [|r|] < [|b|]; spec_div : forall a b, 0 < [|b|] -> let (q,r) := div a b in [|a|] = [|q|] * [|b|] + [|r|] /\ 0 <= [|r|] < [|b|]; spec_modulo_gt : forall a b, [|a|] > [|b|] -> 0 < [|b|] -> [|modulo_gt a b|] = [|a|] mod [|b|]; spec_modulo : forall a b, 0 < [|b|] -> [|modulo a b|] = [|a|] mod [|b|]; spec_gcd_gt : forall a b, [|a|] > [|b|] -> Zis_gcd [|a|] [|b|] [|gcd_gt a b|]; spec_gcd : forall a b, Zis_gcd [|a|] [|b|] [|gcd a b|]; (* shift operations *) spec_head00: forall x, [|x|] = 0 -> [|head0 x|] = Zpos digits; spec_head0 : forall x, 0 < [|x|] -> wB/ 2 <= 2 ^ ([|head0 x|]) * [|x|] < wB; spec_tail00: forall x, [|x|] = 0 -> [|tail0 x|] = Zpos digits; spec_tail0 : forall x, 0 < [|x|] -> exists y, 0 <= y /\ [|x|] = (2 * y + 1) * (2 ^ [|tail0 x|]) ; spec_add_mul_div : forall x y p, [|p|] <= Zpos digits -> [| add_mul_div p x y |] = ([|x|] * (2 ^ [|p|]) + [|y|] / (2 ^ ((Zpos digits) - [|p|]))) mod wB; spec_pos_mod : forall w p, [|pos_mod p w|] = [|w|] mod (2 ^ [|p|]); (* sqrt *) spec_is_even : forall x, if is_even x then [|x|] mod 2 = 0 else [|x|] mod 2 = 1; spec_sqrt2 : forall x y, wB/ 4 <= [|x|] -> let (s,r) := sqrt2 x y in [||WW x y||] = [|s|] ^ 2 + [+|r|] /\ [+|r|] <= 2 * [|s|]; spec_sqrt : forall x, [|sqrt x|] ^ 2 <= [|x|] < ([|sqrt x|] + 1) ^ 2; spec_lor : forall x y, [|lor x y|] = Z.lor [|x|] [|y|]; spec_land : forall x y, [|land x y|] = Z.land [|x|] [|y|]; spec_lxor : forall x y, [|lxor x y|] = Z.lxor [|x|] [|y|] }. End Specs. Arguments Specs {t} ops. (** Generic construction of double words *) Section WW. Context {t : Set}{ops : Ops t}{specs : Specs ops}. Let wB := base digits. Definition WO' (eq0:t->bool) zero h := if eq0 h then W0 else WW h zero. Definition WO := Eval lazy beta delta [WO'] in let eq0 := ZnZ.eq0 in let zero := ZnZ.zero in WO' eq0 zero. Definition OW' (eq0:t->bool) zero l := if eq0 l then W0 else WW zero l. Definition OW := Eval lazy beta delta [OW'] in let eq0 := ZnZ.eq0 in let zero := ZnZ.zero in OW' eq0 zero. Definition WW' (eq0:t->bool) zero h l := if eq0 h then OW' eq0 zero l else WW h l. Definition WW := Eval lazy beta delta [WW' OW'] in let eq0 := ZnZ.eq0 in let zero := ZnZ.zero in WW' eq0 zero. Lemma spec_WO : forall h, zn2z_to_Z wB to_Z (WO h) = (to_Z h)*wB. Proof. unfold zn2z_to_Z, WO; simpl; intros. case_eq (eq0 h); intros. - rewrite (spec_eq0 _ H); auto. - rewrite spec_0; auto with zarith. Qed. Lemma spec_OW : forall l, zn2z_to_Z wB to_Z (OW l) = to_Z l. Proof. unfold zn2z_to_Z, OW; simpl; intros. case_eq (eq0 l); intros. - rewrite (spec_eq0 _ H); auto. - rewrite spec_0; auto with zarith. Qed. Lemma spec_WW : forall h l, zn2z_to_Z wB to_Z (WW h l) = (to_Z h)*wB + to_Z l. Proof. unfold WW; simpl; intros. case_eq (eq0 h); intros. - rewrite (spec_eq0 _ H); auto. fold (OW l). rewrite spec_OW; auto. - simpl; auto. Qed. End WW. (** Injecting [Z] numbers into a cyclic structure *) Section Of_Z. Context {t : Set}{ops : Ops t}{specs : Specs ops}. Notation "[| x |]" := (to_Z x) (at level 0, x at level 99). Theorem of_pos_correct: forall p, Zpos p < base digits -> [|(snd (of_pos p))|] = Zpos p. Proof. intros p Hp. generalize (spec_of_pos p). case (of_pos p); intros n w1; simpl. case n; auto with zarith. intros p1 Hp1; contradict Hp; apply Z.le_ngt. replace (base digits) with (1 * base digits + 0) by ring. rewrite Hp1. apply Z.add_le_mono. - apply Z.mul_le_mono_nonneg. 1-2, 4: lia. unfold base; auto with zarith. - case (spec_to_Z w1); auto with zarith. Qed. Definition of_Z z := match z with | Zpos p => snd (of_pos p) | _ => zero end. Theorem of_Z_correct: forall p, 0 <= p < base digits -> [|of_Z p|] = p. Proof. intros p; case p; simpl; try rewrite spec_0; auto. - intros; rewrite of_pos_correct; lia. - intros p1 (H1, _); contradict H1; apply Z.lt_nge; red; simpl; auto. Qed. End Of_Z. End ZnZ. (** A modular specification grouping the earlier records. *) Module Type CyclicType. Parameter t : Set. #[global] Declare Instance ops : ZnZ.Ops t. #[global] Declare Instance specs : ZnZ.Specs ops. End CyclicType. (** A Cyclic structure can be seen as a ring *) Module CyclicRing (Import Cyclic : CyclicType). Local Notation "[| x |]" := (ZnZ.to_Z x) (at level 0, x at level 99). Definition eq (n m : t) := [| n |] = [| m |]. Local Infix "==" := eq (at level 70). Local Notation "0" := ZnZ.zero. Local Notation "1" := ZnZ.one. Local Infix "+" := ZnZ.add. Local Infix "-" := ZnZ.sub. Local Notation "- x" := (ZnZ.opp x). Local Infix "*" := ZnZ.mul. Local Notation wB := (base ZnZ.digits). Global Hint Rewrite ZnZ.spec_0 ZnZ.spec_1 ZnZ.spec_add ZnZ.spec_mul ZnZ.spec_opp ZnZ.spec_sub : cyclic. Ltac zify := unfold eq in *; autorewrite with cyclic. Lemma add_0_l : forall x, 0 + x == x. Proof. intros. zify. rewrite Z.add_0_l. apply Zmod_small. apply ZnZ.spec_to_Z. Qed. Lemma add_comm : forall x y, x + y == y + x. Proof. intros. zify. now rewrite Z.add_comm. Qed. Lemma add_assoc : forall x y z, x + (y + z) == x + y + z. Proof. intros. zify. now rewrite Zplus_mod_idemp_r, Zplus_mod_idemp_l, Z.add_assoc. Qed. Lemma mul_1_l : forall x, 1 * x == x. Proof. intros. zify. rewrite Z.mul_1_l. apply Zmod_small. apply ZnZ.spec_to_Z. Qed. Lemma mul_comm : forall x y, x * y == y * x. Proof. intros. zify. now rewrite Z.mul_comm. Qed. Lemma mul_assoc : forall x y z, x * (y * z) == x * y * z. Proof. intros. zify. now rewrite Zmult_mod_idemp_r, Zmult_mod_idemp_l, Z.mul_assoc. Qed. Lemma mul_add_distr_r : forall x y z, (x+y)*z == x*z + y*z. Proof. intros. zify. now rewrite <- Zplus_mod, Zmult_mod_idemp_l, Z.mul_add_distr_r. Qed. Lemma add_opp_r : forall x y, x + - y == x-y. Proof. intros. zify. rewrite <- Zminus_mod_idemp_r. unfold Z.sub. destruct (Z.eq_dec ([|y|] mod wB) 0) as [EQ|NEQ]. - rewrite Z_mod_zero_opp_full, EQ, 2 Z.add_0_r; auto. - rewrite Z_mod_nz_opp_full by auto. rewrite <- Zplus_mod_idemp_r, <- Zminus_mod_idemp_l. rewrite Z_mod_same_full. simpl. now rewrite Zplus_mod_idemp_r. Qed. Lemma add_opp_diag_r : forall x, x + - x == 0. Proof. intros. red. rewrite add_opp_r. zify. now rewrite Z.sub_diag, Zmod_0_l. Qed. Lemma CyclicRing : ring_theory 0 1 ZnZ.add ZnZ.mul ZnZ.sub ZnZ.opp eq. Proof. constructor. - exact add_0_l. - exact add_comm. - exact add_assoc. - exact mul_1_l. - exact mul_comm. - exact mul_assoc. - exact mul_add_distr_r. - symmetry. apply add_opp_r. - exact add_opp_diag_r. Qed. Definition eqb x y := match ZnZ.compare x y with Eq => true | _ => false end. Lemma eqb_eq : forall x y, eqb x y = true <-> x == y. Proof. intros. unfold eqb, eq. rewrite ZnZ.spec_compare. case Z.compare_spec; split; (easy || lia). Qed. Lemma eqb_correct : forall x y, eqb x y = true -> x==y. Proof. now apply eqb_eq. Qed. End CyclicRing. coq-8.20.0/theories/Numbers/Cyclic/Abstract/DoubleType.v000066400000000000000000000040441466560755400230600ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* Z) c := match c with | C0 x => interp x | C1 x => sign*B + interp x end. (** From a type [znz] representing a cyclic structure Z/nZ, we produce a representation of Z/2nZ by pairs of elements of [znz] (plus a special case for zero). High half of the new number comes first. *) #[universes(template)] Variant zn2z {znz : Type} := | W0 : zn2z | WW : znz -> znz -> zn2z. Arguments zn2z : clear implicits. Definition zn2z_to_Z znz (wB:Z) (w_to_Z:znz->Z) (x:zn2z znz) := match x with | W0 => 0 | WW xh xl => w_to_Z xh * wB + w_to_Z xl end. Arguments W0 {znz}. (** From a cyclic representation [w], we iterate the [zn2z] construct [n] times, gaining the type of binary trees of depth at most [n], whose leafs are either W0 (if depth < n) or elements of w (if depth = n). *) Fixpoint word (w:Set) (n:nat) : Set := match n with | O => w | S n => zn2z (word w n) end. coq-8.20.0/theories/Numbers/Cyclic/Abstract/NZCyclic.v000066400000000000000000000145411466560755400224650ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* eq) succ. #[global] Program Instance pred_wd : Proper (eq ==> eq) pred. #[global] Program Instance add_wd : Proper (eq ==> eq ==> eq) add. #[global] Program Instance sub_wd : Proper (eq ==> eq ==> eq) sub. #[global] Program Instance mul_wd : Proper (eq ==> eq ==> eq) mul. Theorem gt_wB_1 : 1 < wB. Proof. unfold base. apply Zpower_gt_1; unfold Z.lt; auto with zarith. Qed. Theorem gt_wB_0 : 0 < wB. Proof. pose proof gt_wB_1; lia. Qed. Lemma one_mod_wB : 1 mod wB = 1. Proof. rewrite Zmod_small. - reflexivity. - split. + auto with zarith. + apply gt_wB_1. Qed. Lemma succ_mod_wB : forall n : Z, (n + 1) mod wB = ((n mod wB) + 1) mod wB. Proof. intro n. rewrite <- one_mod_wB at 2. now rewrite <- Zplus_mod. Qed. Lemma pred_mod_wB : forall n : Z, (n - 1) mod wB = ((n mod wB) - 1) mod wB. Proof. intro n. rewrite <- one_mod_wB at 2. now rewrite Zminus_mod. Qed. Lemma NZ_to_Z_mod : forall n, [| n |] mod wB = [| n |]. Proof. intro n; rewrite Zmod_small. - reflexivity. - apply ZnZ.spec_to_Z. Qed. Theorem pred_succ : forall n, P (S n) == n. Proof. intro n. zify. rewrite <- pred_mod_wB. replace ([| n |] + 1 - 1)%Z with [| n |] by ring. apply NZ_to_Z_mod. Qed. Theorem one_succ : one == succ zero. Proof. zify; simpl Z.add. now rewrite one_mod_wB. Qed. Theorem two_succ : two == succ one. Proof. reflexivity. Qed. Section Induction. Variable A : t -> Prop. Hypothesis A_wd : Proper (eq ==> iff) A. Hypothesis A0 : A 0. Hypothesis AS : forall n, A n <-> A (S n). (* Below, we use only -> direction *) Let B (n : Z) := A (ZnZ.of_Z n). Lemma B0 : B 0. Proof. unfold B. apply A0. Qed. Lemma BS : forall n : Z, 0 <= n -> n < wB - 1 -> B n -> B (n + 1). Proof. intros n H1 H2 H3. unfold B in *. apply AS in H3. setoid_replace (ZnZ.of_Z (n + 1)) with (S (ZnZ.of_Z n)). - assumption. - zify. rewrite 2 ZnZ.of_Z_correct. 2-3: lia. symmetry; apply Zmod_small; lia. Qed. Theorem Zbounded_induction : (forall Q : Z -> Prop, forall b : Z, Q 0 -> (forall n, 0 <= n -> n < b - 1 -> Q n -> Q (n + 1)) -> forall n, 0 <= n -> n < b -> Q n)%Z. Proof. intros Q b Q0 QS. set (Q' := fun n => (n < b /\ Q n) \/ (b <= n)). assert (H : forall n, 0 <= n -> Q' n). - apply natlike_rec2; unfold Q'. + destruct (Z.le_gt_cases b 0) as [H | H]. * now right. * left; now split. + intros n H IH. destruct IH as [[IH1 IH2] | IH]. * destruct (Z.le_gt_cases (b - 1) n) as [H1 | H1]. -- right; lia. -- left. split; [ lia | now apply (QS n)]. * right; auto with zarith. - unfold Q' in *; intros n H1 H2. destruct (H n H1) as [[H3 H4] | H3]. + assumption. + now apply Z.le_ngt in H3. Qed. Lemma B_holds : forall n : Z, 0 <= n < wB -> B n. Proof. intros n [H1 H2]. apply Zbounded_induction with wB. - apply B0. - apply BS. - assumption. - assumption. Qed. Theorem bi_induction : forall n, A n. Proof. intro n. setoid_replace n with (ZnZ.of_Z (ZnZ.to_Z n)). - apply B_holds. apply ZnZ.spec_to_Z. - red. symmetry. apply ZnZ.of_Z_correct. apply ZnZ.spec_to_Z. Qed. End Induction. Theorem add_0_l : forall n, 0 + n == n. Proof. intro n. zify. rewrite Z.add_0_l. apply Zmod_small. apply ZnZ.spec_to_Z. Qed. Theorem add_succ_l : forall n m, (S n) + m == S (n + m). Proof. intros n m. zify. rewrite succ_mod_wB. repeat rewrite Zplus_mod_idemp_l; try apply gt_wB_0. rewrite <- (Z.add_assoc ([| n |] mod wB) 1 [| m |]). rewrite Zplus_mod_idemp_l. rewrite (Z.add_comm 1 [| m |]); now rewrite Z.add_assoc. Qed. Theorem sub_0_r : forall n, n - 0 == n. Proof. intro n. zify. rewrite Z.sub_0_r. apply NZ_to_Z_mod. Qed. Theorem sub_succ_r : forall n m, n - (S m) == P (n - m). Proof. intros n m. zify. rewrite Zminus_mod_idemp_r, Zminus_mod_idemp_l. now replace ([|n|] - ([|m|] + 1))%Z with ([|n|] - [|m|] - 1)%Z by ring. Qed. Theorem mul_0_l : forall n, 0 * n == 0. Proof. intro n. now zify. Qed. Theorem mul_succ_l : forall n m, (S n) * m == n * m + m. Proof. intros n m. zify. rewrite Zplus_mod_idemp_l, Zmult_mod_idemp_l. now rewrite Z.mul_add_distr_r, Z.mul_1_l. Qed. Definition t := t. End NZCyclicAxiomsMod. coq-8.20.0/theories/Numbers/Cyclic/Int63/000077500000000000000000000000001466560755400177535ustar00rootroot00000000000000coq-8.20.0/theories/Numbers/Cyclic/Int63/Cyclic63.v000066400000000000000000000247571466560755400215400ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* (Npos p, 0) | S n, xH => (0%N, 1) | S n, xO p => let (N,i) := positive_to_int_rec n p in (N, i << 1) | S n, xI p => let (N,i) := positive_to_int_rec n p in (N, (i << 1) + 1) end. Definition positive_to_int := positive_to_int_rec size. Definition mulc_WW x y := let (h, l) := mulc x y in if is_zero h then if is_zero l then W0 else WW h l else WW h l. Notation "n '*c' m" := (mulc_WW n m) (at level 40, no associativity) : uint63_scope. Definition pos_mod p x := if p <=? digits then let p := digits - p in (x << p) >> p else x. Notation pos_mod_int := pos_mod. Import ZnZ. #[global] Instance int_ops : ZnZ.Ops int := {| digits := Pdigits; (* number of digits *) zdigits := Uint63.digits; (* number of digits *) to_Z := Uint63.to_Z; (* conversion to Z *) of_pos := positive_to_int; (* positive -> N*int63 : p => N,i where p = N*2^31+phi i *) head0 := Uint63.head0; (* number of head 0 *) tail0 := Uint63.tail0; (* number of tail 0 *) zero := 0; one := 1; minus_one := Uint63.max_int; compare := Uint63.compare; eq0 := Uint63.is_zero; opp_c := Uint63.oppc; opp := Uint63.opp; opp_carry := Uint63.oppcarry; succ_c := Uint63.succc; add_c := Uint63.addc; add_carry_c := Uint63.addcarryc; succ := Uint63.succ; add := Uint63.add; add_carry := Uint63.addcarry; pred_c := Uint63.predc; sub_c := Uint63.subc; sub_carry_c := Uint63.subcarryc; pred := Uint63.pred; sub := Uint63.sub; sub_carry := Uint63.subcarry; mul_c := mulc_WW; mul := Uint63.mul; square_c := fun x => mulc_WW x x; div21 := diveucl_21; div_gt := diveucl; (* this is supposed to be the special case of division a/b where a > b *) div := diveucl; modulo_gt := Uint63.mod; modulo := Uint63.mod; gcd_gt := Uint63.gcd; gcd := Uint63.gcd; add_mul_div := Uint63.addmuldiv; pos_mod := pos_mod_int; is_even := Uint63.is_even; sqrt2 := Uint63.sqrt2; sqrt := Uint63.sqrt; ZnZ.lor := Uint63.lor; ZnZ.land := Uint63.land; ZnZ.lxor := Uint63.lxor |}. Local Open Scope Z_scope. Lemma is_zero_spec_aux : forall x : int, is_zero x = true -> φ x = 0%Z. Proof. intros x;rewrite is_zero_spec;intros H;rewrite H;trivial. Qed. Lemma positive_to_int_spec : forall p : positive, Zpos p = Z_of_N (fst (positive_to_int p)) * wB + to_Z (snd (positive_to_int p)). Proof. assert (H: (wB <= wB) -> forall p : positive, Zpos p = Z_of_N (fst (positive_to_int p)) * wB + φ (snd (positive_to_int p)) /\ φ (snd (positive_to_int p)) < wB). 2: intros p; case (H (Z.le_refl wB) p); auto. unfold positive_to_int, wB at 1 3 4. elim size. - intros _ p; simpl; rewrite to_Z_0, Pmult_1_r; split; auto with zarith; apply refl_equal. - intros n; rewrite inj_S; unfold Z.succ; rewrite Zpower_exp, Z.pow_1_r; auto with zarith. intros IH Hle p. assert (F1: 2 ^ Z_of_nat n <= wB); auto with zarith. assert (0 <= 2 ^ Z_of_nat n); auto with zarith. case p; simpl. + intros p1. generalize (IH F1 p1); case positive_to_int_rec; simpl. intros n1 i (H1,H2). rewrite Zpos_xI, H1. replace (φ (i << 1 + 1)) with (φ i * 2 + 1). * split; auto with zarith; ring. * rewrite add_spec, lsl_spec, Zplus_mod_idemp_l, to_Z_1, Z.pow_1_r, Zmod_small; auto. case (to_Z_bounded i); split; auto with zarith. + intros p1. generalize (IH F1 p1); case positive_to_int_rec; simpl. intros n1 i (H1,H2). rewrite Zpos_xO, H1. replace (φ (i << 1)) with (φ i * 2). * split; auto with zarith; ring. * rewrite lsl_spec, to_Z_1, Z.pow_1_r, Zmod_small; auto. case (to_Z_bounded i); split; auto with zarith. + rewrite to_Z_1; assert (0 < 2^ Z_of_nat n); auto with zarith. Qed. Lemma mulc_WW_spec : forall x y, Φ ( x *c y ) = φ x * φ y. Proof. intros x y;unfold mulc_WW. generalize (mulc_spec x y);destruct (mulc x y);simpl;intros Heq;rewrite Heq. case_eq (is_zero i);intros;trivial. apply is_zero_spec in H;rewrite H, to_Z_0. case_eq (is_zero i0);intros;trivial. apply is_zero_spec in H0;rewrite H0, to_Z_0, Zmult_comm;trivial. Qed. Lemma squarec_spec : forall x, Φ(x *c x) = φ x * φ x. Proof (fun x => mulc_WW_spec x x). Lemma diveucl_spec_aux : forall a b, 0 < φ b -> let (q,r) := diveucl a b in φ a = φ q * φ b + φ r /\ 0 <= φ r < φ b. Proof. intros a b H;assert (W:= diveucl_spec a b). assert (φ b>0) by (auto with zarith). generalize (Z_div_mod φ a φ b H0). destruct (diveucl a b);destruct (Z.div_eucl φ a φ b). inversion W;rewrite Zmult_comm;trivial. Qed. Lemma shift_unshift_mod_2 : forall n p a, 0 <= p <= n -> ((a * 2 ^ (n - p)) mod (2^n) / 2 ^ (n - p)) mod (2^n) = a mod 2 ^ p. Proof. intros n p a H. rewrite Zmod_small. - rewrite Zmod_eq by auto with zarith. unfold Zminus at 1. rewrite Zdiv.Z_div_plus_full_l by auto with zarith. replace (2 ^ n) with (2 ^ (n - p) * 2 ^ p) by (rewrite <- Zpower_exp; [ f_equal | | ]; lia). rewrite <- Zdiv_Zdiv, Z_div_mult by auto with zarith. rewrite (Zmult_comm (2^(n-p))), Zmult_assoc. rewrite Zopp_mult_distr_l. rewrite Z_div_mult by auto with zarith. symmetry; apply Zmod_eq; auto with zarith. - remember (a * 2 ^ (n - p)) as b. destruct (Z_mod_lt b (2^n)); auto with zarith. split. + apply Z_div_pos; auto with zarith. + apply Zdiv_lt_upper_bound; auto with zarith. apply Z.lt_le_trans with (2^n); auto with zarith. generalize (pow2_pos (n - p)); nia. Qed. Lemma div_le_0 : forall p x, 0 <= x -> 0 <= x / 2 ^ p. Proof. intros p x Hle;destruct (Z_le_gt_dec 0 p). - apply Zdiv_le_lower_bound;auto with zarith. - replace (2^p) with 0. + destruct x;compute;intro;discriminate. + destruct p;trivial;discriminate. Qed. Lemma div_lt : forall p x y, 0 <= x < y -> x / 2^p < y. Proof. intros p x y H;destruct (Z_le_gt_dec 0 p). - apply Zdiv_lt_upper_bound;auto with zarith. apply Z.lt_le_trans with y;auto with zarith. rewrite <- (Zmult_1_r y);apply Zmult_le_compat;auto with zarith. - replace (2^p) with 0. + destruct x;change (0 (a * 2 ^ (n - p)) mod 2 ^ n / 2 ^ (n - p) = a mod 2 ^ p. Proof. intros;rewrite <- (shift_unshift_mod_2 n p a);[ | auto with zarith]. symmetry;apply Zmod_small. generalize (a * 2 ^ (n - p));intros w. generalize (2 ^ (n - p)) (pow2_pos (n - p)); intros x; apply P. - lia. - intros hx. generalize (2 ^ n) (pow2_pos n); intros y; apply P. + lia. + intros hy. elim_div. intros q r. apply P. * lia. * elim_div. intros z t. refine (P _ _ _ _ _). -- lia. -- intros [ ? [ ht | ] ]; [ | lia ]; subst w. intros [ ? [ hr | ] ]; [ | lia ]; subst t. nia. Qed. Lemma pos_mod_spec w p : φ(pos_mod p w) = φ(w) mod (2 ^ φ(p)). Proof. simpl. unfold pos_mod_int. assert (W:=to_Z_bounded p);assert (W':=to_Z_bounded Uint63.digits);assert (W'' := to_Z_bounded w). case lebP; intros hle. 2: { symmetry; apply Zmod_small. assert (2 ^ φ Uint63.digits < 2 ^ φ p); [ apply Zpower_lt_monotone; auto with zarith | ]. change wB with (2 ^ φ Uint63.digits) in *; auto with zarith. } rewrite <- (shift_unshift_mod_3 φ Uint63.digits φ p φ w) by auto with zarith. replace (φ Uint63.digits - φ p) with (φ (Uint63.digits - p)) by (rewrite sub_spec, Zmod_small; auto with zarith). rewrite lsr_spec, lsl_spec; reflexivity. Qed. (** {2 Specification and proof} **) Global Instance int_specs : ZnZ.Specs int_ops := { spec_to_Z := to_Z_bounded; spec_of_pos := positive_to_int_spec; spec_zdigits := refl_equal _; spec_more_than_1_digit:= refl_equal _; spec_0 := to_Z_0; spec_1 := to_Z_1; spec_m1 := refl_equal _; spec_compare := compare_spec; spec_eq0 := is_zero_spec_aux; spec_opp_c := oppc_spec; spec_opp := opp_spec; spec_opp_carry := oppcarry_spec; spec_succ_c := succc_spec; spec_add_c := addc_spec; spec_add_carry_c := addcarryc_spec; spec_succ := succ_spec; spec_add := add_spec; spec_add_carry := addcarry_spec; spec_pred_c := predc_spec; spec_sub_c := subc_spec; spec_sub_carry_c := subcarryc_spec; spec_pred := pred_spec; spec_sub := sub_spec; spec_sub_carry := subcarry_spec; spec_mul_c := mulc_WW_spec; spec_mul := mul_spec; spec_square_c := squarec_spec; spec_div21 := diveucl_21_spec_aux; spec_div_gt := fun a b _ => diveucl_spec_aux a b; spec_div := diveucl_spec_aux; spec_modulo_gt := fun a b _ _ => mod_spec a b; spec_modulo := fun a b _ => mod_spec a b; spec_gcd_gt := fun a b _ => gcd_spec a b; spec_gcd := gcd_spec; spec_head00 := head00_spec; spec_head0 := head0_spec; spec_tail00 := tail00_spec; spec_tail0 := tail0_spec; spec_add_mul_div := addmuldiv_spec; spec_pos_mod := pos_mod_spec; spec_is_even := is_even_spec; spec_sqrt2 := sqrt2_spec; spec_sqrt := sqrt_spec; spec_land := land_spec'; spec_lor := lor_spec'; spec_lxor := lxor_spec' }. Module Uint63Cyclic <: CyclicType. Definition t := int. Definition ops := int_ops. Definition specs := int_specs. End Uint63Cyclic. coq-8.20.0/theories/Numbers/Cyclic/Int63/PrimInt63.v000066400000000000000000000060361466560755400217020ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* int := fun x => x. Record int_wrapper := wrap_int {int_wrap : int}. Register int_wrapper as num.int63.int_wrapper. Register wrap_int as num.int63.wrap_int. Definition printer (x : int_wrapper) : pos_neg_int63 := Pos (int_wrap x). Definition parser (x : pos_neg_int63) : option int := match x with | Pos p => Some p | Neg _ => None end. Declare Scope int63_scope. Module Import Int63NotationsInternalA. Delimit Scope int63_scope with int63. End Int63NotationsInternalA. Number Notation int parser printer : int63_scope. Module Import Uint63NotationsInternalA. Delimit Scope uint63_scope with uint63. Bind Scope uint63_scope with int. End Uint63NotationsInternalA. Number Notation int parser printer : uint63_scope. (* Logical operations *) Primitive lsl := #int63_lsl. Primitive lsr := #int63_lsr. Primitive land := #int63_land. Primitive lor := #int63_lor. Primitive lxor := #int63_lxor. Primitive asr := #int63_asr. (* Arithmetic modulo operations *) Primitive add := #int63_add. Primitive sub := #int63_sub. Primitive mul := #int63_mul. Primitive mulc := #int63_mulc. Primitive div := #int63_div. Primitive mod := #int63_mod. Primitive divs := #int63_divs. Primitive mods := #int63_mods. (* Comparisons *) Primitive eqb := #int63_eq. Register eqb as num.int63.eqb. Primitive ltb := #int63_lt. Primitive leb := #int63_le. Primitive ltsb := #int63_lts. Primitive lesb := #int63_les. (** Exact arithmetic operations *) Primitive addc := #int63_addc. Primitive addcarryc := #int63_addcarryc. Primitive subc := #int63_subc. Primitive subcarryc := #int63_subcarryc. Primitive diveucl := #int63_diveucl. Primitive diveucl_21 := #int63_div21. Primitive addmuldiv := #int63_addmuldiv. (** Comparison *) Primitive compare := #int63_compare. Primitive compares := #int63_compares. (** Exotic operations *) Primitive head0 := #int63_head0. Primitive tail0 := #int63_tail0. Module Export PrimInt63Notations. Export Int63NotationsInternalA. Export Uint63NotationsInternalA. End PrimInt63Notations. coq-8.20.0/theories/Numbers/Cyclic/Int63/Ring63.v000066400000000000000000000042351466560755400212160ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* constr:(false) | _ => constr:(true) end. Ltac Uint63cst t := match eval lazy delta [add] in (t + 1)%uint63 with | add _ _ => constr:(NotConstant) | _ => constr:(t) end. (** The generic ring structure inferred from the Cyclic structure *) Module Uint63ring := CyclicRing Uint63Cyclic. (** Unlike in the generic [CyclicRing], we can use Leibniz here. *) Lemma Uint63_canonic : forall x y, to_Z x = to_Z y -> x = y. Proof to_Z_inj. Lemma ring_theory_switch_eq : forall A (R R':A->A->Prop) zero one add mul sub opp, (forall x y : A, R x y -> R' x y) -> ring_theory zero one add mul sub opp R -> ring_theory zero one add mul sub opp R'. Proof. intros A R R' zero one add mul sub opp Impl Ring. constructor; intros; apply Impl; apply Ring. Qed. Lemma Uint63Ring : ring_theory 0 1 add mul sub opp Logic.eq. Proof. exact (ring_theory_switch_eq _ _ _ _ _ _ _ _ _ Uint63_canonic Uint63ring.CyclicRing). Qed. Lemma eq31_correct : forall x y, eqb x y = true -> x=y. Proof. now apply eqb_spec. Qed. Add Ring Uint63Ring : Uint63Ring (decidable eq31_correct, constants [Uint63cst]). Section TestRing. Let test : forall x y, 1 + x*y + x*x + 1 = 1*1 + 1 + y*x + 1*x*x. intros. ring. Defined. End TestRing. coq-8.20.0/theories/Numbers/Cyclic/Int63/Sint63.v000066400000000000000000000342641466560755400212410ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* if (p if (n <=? 4611686018427387904)%uint63 then Some ((n - 1) lxor max_int)%uint63 else None end. Number Notation int parser printer : sint63_scope. Module Import Sint63NotationsInternalA. Delimit Scope sint63_scope with sint63. Bind Scope sint63_scope with int. End Sint63NotationsInternalA. Module Import Sint63NotationsInternalB. Infix "<<" := PrimInt63.lsl (at level 30, no associativity) : sint63_scope. (* TODO do we want >> to be asr or lsr? And is there a notation for the other one? *) Infix ">>" := asr (at level 30, no associativity) : sint63_scope. Infix "land" := PrimInt63.land (at level 40, left associativity) : sint63_scope. Infix "lor" := PrimInt63.lor (at level 40, left associativity) : sint63_scope. Infix "lxor" := PrimInt63.lxor (at level 40, left associativity) : sint63_scope. Infix "+" := PrimInt63.add : sint63_scope. Infix "-" := PrimInt63.sub : sint63_scope. Infix "*" := PrimInt63.mul : sint63_scope. Infix "/" := divs : sint63_scope. Infix "mod" := mods (at level 40, no associativity) : sint63_scope. Infix "=?" := PrimInt63.eqb (at level 70, no associativity) : sint63_scope. Infix " lia | intros _]. case (ltbP max_int); [> intros _ | now intros H; exfalso; apply H]. rewrite opp_spec. rewrite Z_mod_nz_opp_full by easy. rewrite Z.mod_small by apply Uint63.to_Z_bounded. case ltbP. - intros ltxmin; split. + now transitivity 0%Z; [>| now apply Uint63.to_Z_bounded]. + replace (φ min_int%uint63) with (φ max_int%uint63 + 1)%Z in ltxmin. * lia. * now compute. - rewrite Z.nlt_ge; intros leminx. rewrite opp_spec. rewrite Z_mod_nz_opp_full. + rewrite Z.mod_small by apply Uint63.to_Z_bounded. split. * rewrite <- Z.opp_le_mono. now rewrite <- Z.sub_le_mono_l. * transitivity 0%Z; [>| now apply Uint63.to_Z_bounded]. rewrite Z.opp_nonpos_nonneg. apply Zle_minus_le_0. apply Z.lt_le_incl. now apply Uint63.to_Z_bounded. + rewrite Z.mod_small by apply Uint63.to_Z_bounded. now intros eqx0; rewrite eqx0 in leminx. Qed. Lemma of_to_Z : forall x, of_Z (to_Z x) = x. Proof. unfold to_Z, of_Z. intros x. generalize (Uint63.to_Z_bounded x). case ltbP. - intros ltxmin [leq0x _]. generalize (Uint63.of_to_Z x). destruct (φ x%uint63). + now intros <-. + now intros <-; unfold Uint63.of_Z. + now intros _. - intros nltxmin leq0xltwB. rewrite (opp_spec x). rewrite Z_mod_nz_opp_full. + rewrite Zmod_small by easy. destruct (wB - φ x%uint63) eqn: iswbmx. * lia. * simpl. apply to_Z_inj. rewrite opp_spec. generalize (of_Z_spec (Z.pos p)). simpl Uint63.of_Z; intros ->. rewrite <- iswbmx. rewrite <- Z.sub_0_l. rewrite <- (Zmod_0_l wB). rewrite <- Zminus_mod. replace (0 - _) with (φ x%uint63 - wB) by ring. rewrite <- Zminus_mod_idemp_r. rewrite Z_mod_same_full. rewrite Z.sub_0_r. now rewrite Z.mod_small. * lia. + rewrite Z.mod_small by easy. intros eqx0; revert nltxmin; rewrite eqx0. now compute. Qed. Lemma to_Z_inj (x y : int) : to_Z x = to_Z y -> x = y. Proof. exact (fun e => can_inj of_to_Z e). Qed. Lemma to_Z_mod_Uint63to_Z (x : int) : to_Z x mod wB = φ x%uint63. Proof. unfold to_Z. case ltbP; [> now rewrite Z.mod_small by now apply Uint63.to_Z_bounded |]. rewrite Z.nlt_ge; intros gexmin. rewrite opp_to_Z_opp; rewrite Z.mod_small by now apply Uint63.to_Z_bounded. - easy. - now intros neqx0; rewrite neqx0 in gexmin. Qed. (** Centered modulo *) Definition cmod (x d : Z) : Z := (x + d / 2) mod d - (d / 2). Lemma cmod_mod (x d : Z) : cmod (x mod d) d = cmod x d. Proof. now unfold cmod; rewrite Zplus_mod_idemp_l. Qed. Lemma cmod_small (x d : Z) : - (d / 2) <= x < d / 2 -> cmod x d = x. Proof. intros bound. unfold cmod. rewrite Zmod_small; [> lia |]. split; [> lia |]. rewrite Z.lt_add_lt_sub_r. apply (Z.lt_le_trans _ (d / 2)); [> easy |]. now rewrite <- Z.le_add_le_sub_r, Z.add_diag, Z.mul_div_le. Qed. Lemma to_Z_cmodwB (x : int) : to_Z x = cmod (φ x%uint63) wB. Proof. unfold to_Z, cmod. case ltbP; change φ (min_int)%uint63 with (wB / 2). - intros ltxmin. rewrite Z.mod_small; [> lia |]. split. + now apply Z.add_nonneg_nonneg; try apply Uint63.to_Z_bounded. + change wB with (wB / 2 + wB / 2) at 2; lia. - rewrite Z.nlt_ge; intros gexmin. rewrite Uint63.opp_spec. rewrite Z_mod_nz_opp_full. + rewrite Z.mod_small by apply Uint63.to_Z_bounded. rewrite <- (Z_mod_plus_full _ (-1)). change (-1 * wB) with (- (wB / 2) - wB / 2). rewrite <- Z.add_assoc, Zplus_minus. rewrite Z.mod_small. * change wB with (wB / 2 + wB / 2) at 1; lia. * split; [> lia |]. apply Z.lt_sub_lt_add_r. transitivity wB; [>| easy]. now apply Uint63.to_Z_bounded. + rewrite Z.mod_small by now apply Uint63.to_Z_bounded. now intros not0; rewrite not0 in gexmin. Qed. Lemma of_Z_spec (z : Z) : to_Z (of_Z z) = cmod z wB. Proof. now rewrite to_Z_cmodwB, Uint63.of_Z_spec, cmod_mod. Qed. Lemma of_Z_cmod (z : Z) : of_Z (cmod z wB) = of_Z z. Proof. now rewrite <- of_Z_spec, of_to_Z. Qed. Lemma is_int (z : Z) : to_Z min_int <= z <= to_Z max_int -> z = to_Z (of_Z z). Proof. rewrite to_Z_min, to_Z_max. intros bound; rewrite of_Z_spec, cmod_small; lia. Qed. Lemma of_pos_spec (p : positive) : to_Z (of_pos p) = cmod (Zpos p) wB. Proof. rewrite <- of_Z_spec; simpl; reflexivity. Qed. (** Specification of operations that differ on signed and unsigned ints *) Axiom asr_spec : forall x p, to_Z (x >> p) = (to_Z x) / 2 ^ (to_Z p). Axiom div_spec : forall x y, to_Z x <> to_Z min_int \/ to_Z y <> (-1)%Z -> to_Z (x / y) = Z.quot (to_Z x) (to_Z y). Axiom mod_spec : forall x y, to_Z (x mod y) = Z.rem (to_Z x) (to_Z y). Axiom ltb_spec : forall x y, (x to_Z x < to_Z y. Axiom leb_spec : forall x y, (x <=? y)%sint63 = true <-> to_Z x <= to_Z y. Axiom compare_spec : forall x y, (x ?= y)%sint63 = (to_Z x ?= to_Z y). (** Specification of operations that coincide on signed and unsigned ints *) Lemma add_spec (x y : int) : to_Z (x + y)%sint63 = cmod (to_Z x + to_Z y) wB. Proof. rewrite to_Z_cmodwB, Uint63.add_spec. rewrite <- 2!to_Z_mod_Uint63to_Z, <- Z.add_mod by easy. now rewrite cmod_mod. Qed. Lemma sub_spec (x y : int) : to_Z (x - y)%sint63 = cmod (to_Z x - to_Z y) wB. Proof. rewrite to_Z_cmodwB, Uint63.sub_spec. rewrite <- 2!to_Z_mod_Uint63to_Z, <- Zminus_mod by easy. now rewrite cmod_mod. Qed. Lemma mul_spec (x y : int) : to_Z (x * y)%sint63 = cmod (to_Z x * to_Z y) wB. Proof. rewrite to_Z_cmodwB, Uint63.mul_spec. rewrite <- 2!to_Z_mod_Uint63to_Z, <- Zmult_mod by easy. now rewrite cmod_mod. Qed. Lemma succ_spec (x : int) : to_Z (succ x)%sint63 = cmod (to_Z x + 1) wB. Proof. now unfold succ; rewrite add_spec. Qed. Lemma pred_spec (x : int) : to_Z (pred x)%sint63 = cmod (to_Z x - 1) wB. Proof. now unfold pred; rewrite sub_spec. Qed. Lemma opp_spec (x : int) : to_Z (- x)%sint63 = cmod (- to_Z x) wB. Proof. rewrite to_Z_cmodwB, Uint63.opp_spec. rewrite <- Z.sub_0_l, <- to_Z_mod_Uint63to_Z, Zminus_mod_idemp_r. now rewrite cmod_mod. Qed. (** Behaviour when there is no under or overflow *) Lemma to_Z_add (x y : int) : to_Z min_int <= to_Z x + to_Z y <= to_Z max_int -> to_Z (x + y) = to_Z x + to_Z y. Proof. rewrite to_Z_min, to_Z_max; intros bound. now rewrite add_spec, cmod_small; [>| lia]. Qed. Lemma to_Z_sub (x y : int) : to_Z min_int <= to_Z x - to_Z y <= to_Z max_int -> to_Z (x - y) = to_Z x - to_Z y. Proof. rewrite to_Z_min, to_Z_max; intros bound. now rewrite sub_spec, cmod_small; [>| lia]. Qed. Lemma to_Z_mul (x y : int) : to_Z min_int <= to_Z x * to_Z y <= to_Z max_int -> to_Z (x * y) = to_Z x * to_Z y. Proof. rewrite to_Z_min, to_Z_max; intros bound. now rewrite mul_spec, cmod_small; [>| lia]. Qed. Lemma to_Z_succ (x : int) : x <> max_int -> to_Z (succ x) = to_Z x + 1. Proof. intros neq_x_max. rewrite succ_spec, cmod_small; [> easy |]. assert (to_Z x <> to_Z max_int) by now intros ?; apply neq_x_max, to_Z_inj. rewrite <- to_Z_min; change (wB / 2) with (to_Z max_int + 1). generalize (to_Z_bounded x); lia. Qed. Lemma to_Z_pred (x : int) : x <> min_int -> to_Z (pred x) = to_Z x - 1. Proof. intros neq_x_min. rewrite pred_spec, cmod_small; [> easy |]. assert (to_Z x <> to_Z min_int) by now intros ?; apply neq_x_min, to_Z_inj. rewrite <- to_Z_min; change (wB / 2) with (to_Z max_int + 1). generalize (to_Z_bounded x); lia. Qed. Lemma to_Z_opp (x : int) : x <> min_int -> to_Z (- x) = - to_Z x. Proof. intros neq_x_min. rewrite opp_spec, cmod_small; [> easy |]. rewrite <- to_Z_min; change (wB / 2) with (to_Z max_int + 1). pose proof (to_Z_bounded x) as bound. split. - now rewrite Z.opp_le_mono, Z.opp_involutive; transitivity (to_Z max_int). - rewrite Z.opp_lt_mono, Z.opp_involutive. assert (to_Z x <> to_Z min_int) by now intros ?; apply neq_x_min, to_Z_inj. change (- (to_Z max_int + 1)) with (to_Z min_int); lia. Qed. (** Relationship with of_Z *) Lemma add_of_Z (x y : int) : (x + y)%sint63 = of_Z (to_Z x + to_Z y). Proof. now rewrite <- of_Z_cmod, <- add_spec, of_to_Z. Qed. Lemma sub_of_Z (x y : int) : (x - y)%sint63 = of_Z (to_Z x - to_Z y). Proof. now rewrite <- of_Z_cmod, <- sub_spec, of_to_Z. Qed. Lemma mul_of_Z (x y : int) : (x * y)%sint63 = of_Z (to_Z x * to_Z y). Proof. now rewrite <- of_Z_cmod, <- mul_spec, of_to_Z. Qed. Lemma succ_of_Z (x : int) : (succ x)%sint63 = of_Z (to_Z x + 1). Proof. now rewrite <- of_Z_cmod, <- succ_spec, of_to_Z. Qed. Lemma pred_of_Z (x : int) : (pred x)%sint63 = of_Z (to_Z x - 1). Proof. now rewrite <- of_Z_cmod, <- pred_spec, of_to_Z. Qed. Lemma opp_of_Z (x : int) : (- x)%sint63 = of_Z (- to_Z x). Proof. now rewrite <- of_Z_cmod, <- opp_spec, of_to_Z. Qed. (** Comparison *) Import Bool. Lemma eqbP x y : reflect (to_Z x = to_Z y) (x =? y)%sint63. Proof. apply iff_reflect; rewrite Uint63.eqb_spec. now split; [> apply to_Z_inj | apply f_equal]. Qed. Lemma ltbP x y : reflect (to_Z x < to_Z y) (x min_int -> to_Z (abs x) = Z.abs (to_Z x). Proof. intros neq_x_min. unfold abs; case lebP. - now intros leq_0_x; rewrite Z.abs_eq. - rewrite to_Z_opp by easy. intros nleq_0_x; rewrite Z.abs_neq; [> easy |]. change 0 with (to_Z 0); lia. Qed. Remark abs_min_int : abs min_int = min_int. Proof. easy. Qed. Lemma abs_of_Z (x : int) : abs x = of_Z (Z.abs (to_Z x)). Proof. now rewrite <- of_Z_cmod, <- abs_spec, of_to_Z. Qed. (** ASR *) Lemma asr_0 (i : int) : (0 >> i)%sint63 = 0%sint63. Proof. now apply to_Z_inj; rewrite asr_spec. Qed. Lemma asr_0_r (i : int) : (i >> 0)%sint63 = i. Proof. now apply to_Z_inj; rewrite asr_spec, Zdiv_1_r. Qed. Lemma asr_neg_r (i n : int) : to_Z n < 0 -> (i >> n)%sint63 = 0%sint63. Proof. intros ltn0. apply to_Z_inj. rewrite asr_spec, Z.pow_neg_r by assumption. now rewrite Zdiv_0_r. Qed. Lemma asr_1 (n : int) : (1 >> n)%sint63 = (n =? 0)%sint63. Proof. apply to_Z_inj; rewrite asr_spec. case eqbP; [> now intros -> | intros neqn0]. case (lebP 0 n). - intros le0n. apply Z.div_1_l; apply Z.pow_gt_1; [> easy |]. rewrite to_Z_0 in *; lia. - rewrite Z.nle_gt; intros ltn0. now rewrite Z.pow_neg_r. Qed. Notation asr := asr (only parsing). Notation div := divs (only parsing). Notation rem := mods (only parsing). Notation ltb := ltsb (only parsing). Notation leb := lesb (only parsing). Notation compare := compares (only parsing). Module Export Sint63Notations. Export Sint63NotationsInternalA. Export Sint63NotationsInternalB. End Sint63Notations. coq-8.20.0/theories/Numbers/Cyclic/Int63/Uint63.v000066400000000000000000002110411466560755400212310ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* >" := lsr (at level 30, no associativity) : uint63_scope. Infix "land" := land (at level 40, left associativity) : uint63_scope. Infix "lor" := lor (at level 40, left associativity) : uint63_scope. Infix "lxor" := lxor (at level 40, left associativity) : uint63_scope. Infix "+" := add : uint63_scope. Infix "-" := sub : uint63_scope. Infix "*" := mul : uint63_scope. Infix "/" := div : uint63_scope. Infix "mod" := mod (at level 40, no associativity) : uint63_scope. Infix "=?" := eqb (at level 70, no associativity) : uint63_scope. Infix "> n) << (digits - 1))). (* Register bit as PrimInline. *) (** Extra modulo operations *) Definition opp (i:int) := 0 - i. Register Inline opp. Definition oppcarry i := max_int - i. Register Inline oppcarry. Definition succ i := i + 1. Register Inline succ. Definition pred i := i - 1. Register Inline pred. Definition addcarry i j := i + j + 1. Register Inline addcarry. Definition subcarry i j := i - j - 1. Register Inline subcarry. (** Exact arithmetic operations *) Definition addc_def x y := let r := x + y in if r > (digits - p)). Notation addmuldiv := addmuldiv (only parsing). Module Import Uint63NotationsInternalC. Notation "- x" := (opp x) : uint63_scope. Notation "n '+c' m" := (addc n m) (at level 50, no associativity) : uint63_scope. Notation "n '-c' m" := (subc n m) (at level 50, no associativity) : uint63_scope. End Uint63NotationsInternalC. Definition oppc (i:int) := 0 -c i. Register Inline oppc. Definition succc i := i +c 1. Register Inline succc. Definition predc i := i -c 1. Register Inline predc. (** Comparison *) Definition compare_def x y := if x 0%Z | S n => (if is_even i then Z.double else Zdouble_plus_one) (to_Z_rec n (i >> 1)) end. Definition to_Z := to_Z_rec size. Fixpoint of_pos_rec (n:nat) (p:positive) {struct p} := match n, p with | O, _ => 0 | S n, xH => 1 | S n, xO p => (of_pos_rec n p) << 1 | S n, xI p => (of_pos_rec n p) << 1 lor 1 end. Definition of_pos := of_pos_rec size. Definition of_Z z := match z with | Zpos p => of_pos p | Z0 => 0 | Zneg p => - (of_pos p) end. Definition wB := (2 ^ (Z.of_nat size))%Z. Notation to_nat i := (Z.to_nat (to_Z i)). Notation of_nat n := (of_Z (Z.of_nat n)). Module Import Uint63NotationsInternalD. Notation "n ?= m" := (compare n m) (at level 70, no associativity) : uint63_scope. Notation "'φ' x" := (to_Z x) (at level 0) : uint63_scope. Notation "'Φ' x" := (zn2z_to_Z wB to_Z x) (at level 0) : uint63_scope. End Uint63NotationsInternalD. Lemma to_Z_rec_bounded size : forall x, (0 <= to_Z_rec size x < 2 ^ Z.of_nat size)%Z. Proof. elim size. - simpl; auto with zarith. - intros n ih x; rewrite inj_S; simpl; assert (W := ih (x >> 1)%uint63). rewrite Z.pow_succ_r; auto with zarith. destruct (is_even x). + rewrite Zdouble_mult; auto with zarith. + rewrite Zdouble_plus_one_mult; auto with zarith. Qed. Corollary to_Z_bounded : forall x, (0 <= φ x < wB)%Z. Proof. apply to_Z_rec_bounded. Qed. (* =================================================== *) Local Open Scope Z_scope. (* General arithmetic results *) Theorem Zmod_distr: forall a b r t, 0 <= a <= b -> 0 <= r -> 0 <= t < 2 ^a -> (2 ^a * r + t) mod (2 ^ b) = (2 ^a * r) mod (2 ^ b) + t. Proof. intros a b r t ? ? ?. replace (2^b) with (2^a * 2^(b-a)) by (rewrite <-Zpower_exp; [f_equal| |]; lia). assert (0 < 2 ^ (b - a)) by (apply Z.pow_pos_nonneg; lia). rewrite Z.add_mul_mod_distr_l, <- Z.mul_mod_distr_l; lia. Qed. (* Results about pow2 *) Lemma pow2_pos n : 0 <= n → 2 ^ n > 0. Proof. intros h; apply Z.lt_gt, Zpower_gt_0; lia. Qed. Lemma pow2_nz n : 0 <= n → 2 ^ n ≠ 0. Proof. intros h; generalize (pow2_pos _ h); lia. Qed. #[global] Hint Resolve pow2_pos pow2_nz : zarith. (* =================================================== *) (** Trivial lemmas without axiom *) Lemma wB_diff_0 : wB <> 0. Proof. exact (fun x => let 'eq_refl := x in idProp). Qed. Lemma wB_pos : 0 < wB. Proof. reflexivity. Qed. Lemma to_Z_0 : φ 0 = 0. Proof. reflexivity. Qed. Lemma to_Z_1 : φ 1 = 1. Proof. reflexivity. Qed. (* Notations *) Local Open Scope Z_scope. Local Notation "[+| c |]" := (interp_carry 1 wB to_Z c) (at level 0, c at level 99) : uint63_scope. Local Notation "[-| c |]" := (interp_carry (-1) wB to_Z c) (at level 0, c at level 99) : uint63_scope. (* Bijection : uint63 <-> Bvector size *) Axiom of_to_Z : forall x, of_Z φ x = x. Lemma can_inj {rT aT} {f: aT -> rT} {g: rT -> aT} (K: forall a, g (f a) = a) {a a'} (e: f a = f a') : a = a'. Proof. generalize (K a) (K a'). congruence. Qed. Lemma to_Z_inj x y : φ x = φ y → x = y. Proof. exact (λ e, can_inj of_to_Z e). Qed. (** Specification of logical operations *) Local Open Scope Z_scope. Axiom lsl_spec : forall x p, φ (x << p) = φ x * 2 ^ φ p mod wB. Axiom lsr_spec : forall x p, φ (x >> p) = φ x / 2 ^ φ p. Axiom land_spec: forall x y i , bit (x land y) i = bit x i && bit y i. Axiom lor_spec: forall x y i, bit (x lor y) i = bit x i || bit y i. Axiom lxor_spec: forall x y i, bit (x lxor y) i = xorb (bit x i) (bit y i). (** Specification of basic opetations *) (* Arithmetic modulo operations *) (* Remarque : les axiomes seraient plus simple si on utilise of_Z a la place : exemple : add_spec : forall x y, of_Z (x + y) = of_Z x + of_Z y. *) Axiom add_spec : forall x y, φ (x + y) = (φ x + φ y) mod wB. Axiom sub_spec : forall x y, φ (x - y) = (φ x - φ y) mod wB. Axiom mul_spec : forall x y, φ (x * y) = φ x * φ y mod wB. Axiom mulc_spec : forall x y, φ x * φ y = φ (fst (mulc x y)) * wB + φ (snd (mulc x y)). Axiom div_spec : forall x y, φ (x / y) = φ x / φ y. Axiom mod_spec : forall x y, φ (x mod y) = φ x mod φ y. (* Comparisons *) Axiom eqb_correct : forall i j, (i =? j)%uint63 = true -> i = j. Axiom eqb_refl : forall x, (x =? x)%uint63 = true. Axiom ltb_spec : forall x y, (x φ x < φ y. Axiom leb_spec : forall x y, (x <=? y)%uint63 = true <-> φ x <= φ y. (** Exotic operations *) (** I should add the definition (like for compare) *) Notation head0 := head0 (only parsing). Notation tail0 := tail0 (only parsing). (** Axioms on operations which are just short cut *) Axiom compare_def_spec : forall x y, compare x y = compare_def x y. Axiom head0_spec : forall x, 0 < φ x -> wB/ 2 <= 2 ^ (φ (head0 x)) * φ x < wB. Axiom tail0_spec : forall x, 0 < φ x -> (exists y, 0 <= y /\ φ x = (2 * y + 1) * (2 ^ φ (tail0 x)))%Z. Axiom addc_def_spec : forall x y, (x +c y)%uint63 = addc_def x y. Axiom addcarryc_def_spec : forall x y, addcarryc x y = addcarryc_def x y. Axiom subc_def_spec : forall x y, (x -c y)%uint63 = subc_def x y. Axiom subcarryc_def_spec : forall x y, subcarryc x y = subcarryc_def x y. Axiom diveucl_def_spec : forall x y, diveucl x y = diveucl_def x y. Axiom diveucl_21_spec : forall a1 a2 b, let (q,r) := diveucl_21 a1 a2 b in let (q',r') := Z.div_eucl (φ a1 * wB + φ a2) φ b in φ a1 < φ b -> φ q = q' /\ φ r = r'. Axiom addmuldiv_def_spec : forall p x y, addmuldiv p x y = addmuldiv_def p x y. (** Square root functions using newton iteration **) Local Open Scope uint63_scope. Definition sqrt_step (rec: int -> int -> int) (i j: int) := let quo := i / j in if quo > 1) else j. Definition iter_sqrt := Eval lazy beta delta [sqrt_step] in fix iter_sqrt (n: nat) (rec: int -> int -> int) (i j: int) {struct n} : int := sqrt_step (fun i j => match n with O => rec i j | S n => (iter_sqrt n (iter_sqrt n rec)) i j end) i j. Definition sqrt i := match compare 1 i with Gt => 0 | Eq => 1 | Lt => iter_sqrt size (fun i j => j) i (i >> 1) end. Definition high_bit := 1 << (digits - 1). Definition sqrt2_step (rec: int -> int -> int -> int) (ih il j: int) := if ih rec ih il (m1 >> 1) | C1 m1 => rec ih il ((m1 >> 1) + high_bit) end else j else j. Definition iter2_sqrt := Eval lazy beta delta [sqrt2_step] in fix iter2_sqrt (n: nat) (rec: int -> int -> int -> int) (ih il j: int) {struct n} : int := sqrt2_step (fun ih il j => match n with | O => rec ih il j | S n => (iter2_sqrt n (iter2_sqrt n rec)) ih il j end) ih il j. Definition sqrt2 ih il := let s := iter2_sqrt size (fun ih il j => j) ih il max_int in let (ih1, il1) := mulc s s in match il -c il1 with | C0 il2 => if ih1 if ih1 1 | S p => if j =? 0 then i else gcd_rec p j (i mod j) end. Definition gcd := gcd_rec (2*size). (** equality *) Lemma eqb_complete : forall x y, x = y -> (x =? y) = true. Proof. intros x y H; rewrite -> H, eqb_refl;trivial. Qed. Lemma eqb_spec : forall x y, (x =? y) = true <-> x = y. Proof. split;auto using eqb_correct, eqb_complete. Qed. Lemma eqb_false_spec : forall x y, (x =? y) = false <-> x <> y. Proof. intros;rewrite <- not_true_iff_false, eqb_spec;split;trivial. Qed. Lemma eqb_false_complete : forall x y, x <> y -> (x =? y) = false. Proof. intros x y;rewrite eqb_false_spec;trivial. Qed. Lemma eqb_false_correct : forall x y, (x =? y) = false -> x <> y. Proof. intros x y;rewrite eqb_false_spec;trivial. Qed. Definition eqs (i j : int) : {i = j} + { i <> j } := (if i =? j as b return ((b = true -> i = j) -> (b = false -> i <> j) -> {i=j} + {i <> j} ) then fun (Heq : true = true -> i = j) _ => left _ (Heq (eq_refl true)) else fun _ (Hdiff : false = false -> i <> j) => right _ (Hdiff (eq_refl false))) (eqb_correct i j) (eqb_false_correct i j). Lemma eq_dec : forall i j:int, i = j \/ i <> j. Proof. intros i j;destruct (eqs i j);auto. Qed. (* Extra function on equality *) Definition cast i j := (if i =? j as b return ((b = true -> i = j) -> option (forall P : int -> Type, P i -> P j)) then fun Heq : true = true -> i = j => Some (fun (P : int -> Type) (Hi : P i) => match Heq (eq_refl true) in (_ = y) return (P y) with | eq_refl => Hi end) else fun _ : false = true -> i = j => None) (eqb_correct i j). Lemma cast_refl : forall i, cast i i = Some (fun P H => H). Proof. unfold cast;intros i. generalize (eqb_correct i i). rewrite eqb_refl;intros e. rewrite (Eqdep_dec.eq_proofs_unicity eq_dec (e (eq_refl true)) (eq_refl i));trivial. Qed. Lemma cast_diff : forall i j, i =? j = false -> cast i j = None. Proof. intros i j H;unfold cast;intros; generalize (eqb_correct i j). rewrite H;trivial. Qed. Definition eqo i j := (if i =? j as b return ((b = true -> i = j) -> option (i=j)) then fun Heq : true = true -> i = j => Some (Heq (eq_refl true)) else fun _ : false = true -> i = j => None) (eqb_correct i j). Lemma eqo_refl : forall i, eqo i i = Some (eq_refl i). Proof. unfold eqo;intros i. generalize (eqb_correct i i). rewrite eqb_refl;intros e. rewrite (Eqdep_dec.eq_proofs_unicity eq_dec (e (eq_refl true)) (eq_refl i));trivial. Qed. Lemma eqo_diff : forall i j, i =? j = false -> eqo i j = None. Proof. unfold eqo;intros i j H; generalize (eqb_correct i j). rewrite H;trivial. Qed. (** Comparison *) Lemma eqbP x y : reflect (φ x = φ y ) (x =? y). Proof. apply iff_reflect; rewrite eqb_spec; split; [ apply to_Z_inj | apply f_equal ]. Qed. Lemma ltbP x y : reflect (φ x < φ y )%Z (x x = 0%uint63. Proof. apply eqb_spec. Qed. Lemma diveucl_spec x y : let (q,r) := diveucl x y in (φ q , φ r ) = Z.div_eucl φ x φ y . Proof. rewrite diveucl_def_spec; unfold diveucl_def; rewrite div_spec, mod_spec; unfold Z.div, Z.modulo. destruct (Z.div_eucl φ x φ y ); trivial. Qed. Local Open Scope Z_scope. (** Addition *) Lemma addc_spec x y : [+| x +c y |] = φ x + φ y . Proof. rewrite addc_def_spec; unfold addc_def, interp_carry. pose proof (to_Z_bounded x); pose proof (to_Z_bounded y). case ltbP; rewrite add_spec. - case (Z_lt_ge_dec (φ x + φ y ) wB). + intros k; rewrite Zmod_small; lia. + intros hge; rewrite <- (Zmod_unique _ _ 1 (φ x + φ y - wB)); lia. - case (Z_lt_ge_dec (φ x + φ y ) wB). + intros k; rewrite Zmod_small; lia. + intros hge; rewrite <- (Zmod_unique _ _ 1 (φ x + φ y - wB)); lia. Qed. Lemma succ_spec x : φ (succ x) = (φ x + 1) mod wB. Proof. apply add_spec. Qed. Lemma succc_spec x : [+| succc x |] = φ x + 1. Proof. apply addc_spec. Qed. Lemma addcarry_spec x y : φ (addcarry x y) = (φ x + φ y + 1) mod wB. Proof. unfold addcarry; rewrite -> !add_spec, Zplus_mod_idemp_l; trivial. Qed. Lemma addcarryc_spec x y : [+| addcarryc x y |] = φ x + φ y + 1. Proof. rewrite addcarryc_def_spec; unfold addcarryc_def, interp_carry. pose proof (to_Z_bounded x); pose proof (to_Z_bounded y). case lebP; rewrite addcarry_spec. - case (Z_lt_ge_dec (φ x + φ y + 1) wB). + intros hlt; rewrite Zmod_small; lia. + intros hge; rewrite <- (Zmod_unique _ _ 1 (φ x + φ y + 1 - wB)); lia. - case (Z_lt_ge_dec (φ x + φ y + 1) wB). + intros hlt; rewrite Zmod_small; lia. + intros hge; rewrite <- (Zmod_unique _ _ 1 (φ x + φ y + 1 - wB)); lia. Qed. (** Subtraction *) Lemma subc_spec x y : [-| x -c y |] = φ x - φ y . Proof. rewrite subc_def_spec; unfold subc_def; unfold interp_carry. pose proof (to_Z_bounded x); pose proof (to_Z_bounded y). case lebP. - intros hle; rewrite sub_spec, Z.mod_small; lia. - intros hgt; rewrite sub_spec, <- (Zmod_unique _ wB (-1) (φ x - φ y + wB)); lia. Qed. Lemma pred_spec x : φ (pred x) = (φ x - 1) mod wB. Proof. apply sub_spec. Qed. Lemma predc_spec x : [-| predc x |] = φ x - 1. Proof. apply subc_spec. Qed. Lemma oppc_spec x : [-| oppc x |] = - φ x . Proof. unfold oppc; rewrite -> subc_spec, to_Z_0; trivial. Qed. Lemma opp_spec x : φ (- x) = - φ x mod wB. Proof. unfold opp; rewrite -> sub_spec, to_Z_0; trivial. Qed. Lemma oppcarry_spec x : φ (oppcarry x) = wB - φ x - 1. Proof. unfold oppcarry; rewrite sub_spec. rewrite <- Zminus_plus_distr, Zplus_comm, Zminus_plus_distr. apply Zmod_small. generalize (to_Z_bounded x); auto with zarith. Qed. Lemma subcarry_spec x y : φ (subcarry x y) = (φ x - φ y - 1) mod wB. Proof. unfold subcarry; rewrite !sub_spec, Zminus_mod_idemp_l; trivial. Qed. Lemma subcarryc_spec x y : [-| subcarryc x y |] = φ x - φ y - 1. Proof. rewrite subcarryc_def_spec; unfold subcarryc_def, interp_carry; fold (subcarry x y). pose proof (to_Z_bounded x); pose proof (to_Z_bounded y). case ltbP; rewrite subcarry_spec. - intros hlt; rewrite Zmod_small; lia. - intros hge; rewrite <- (Zmod_unique _ _ (-1) (φ x - φ y - 1 + wB)); lia. Qed. (** GCD *) Lemma to_Z_gcd : forall i j, φ (gcd i j) = Zgcdn (2 * size) (φ j) (φ i). Proof. unfold gcd. elim (2*size)%nat. - reflexivity. - intros n ih i j; simpl. pose proof (to_Z_bounded j) as hj; pose proof (to_Z_bounded i). case eqbP; rewrite to_Z_0. + intros ->; rewrite Z.abs_eq; lia. + intros hne; rewrite ih; clear ih. rewrite <- mod_spec. revert hj hne; case φ j ; intros; lia. Qed. Lemma gcd_spec a b : Zis_gcd (φ a) (φ b) (φ (gcd a b)). Proof. rewrite to_Z_gcd. apply Zis_gcd_sym. apply Zgcdn_is_gcd. unfold Zgcd_bound. generalize (to_Z_bounded b). destruct φ b as [|p|p]. - unfold size; auto with zarith. - intros (_,H). cut (Psize p <= size)%nat; [ lia | rewrite <- Zpower2_Psize; auto]. - intros (H,_); compute in H; elim H; auto. Qed. (** Head0, Tail0 *) Lemma head00_spec x : φ x = 0 -> φ (head0 x) = φ digits . Proof. now intros h; rewrite (to_Z_inj _ 0 h). Qed. Lemma tail00_spec x : φ x = 0 -> φ (tail0 x) = φ digits. Proof. now intros h; rewrite (to_Z_inj _ 0 h). Qed. Infix "≡" := (eqm wB) (at level 70, no associativity) : uint63_scope. Lemma eqm_mod x y : x mod wB ≡ y mod wB → x ≡ y. Proof. intros h. eapply (eqm_trans). - apply eqm_sym; apply Zmod_eqm. - apply (eqm_trans _ _ _ _ h). apply Zmod_eqm. Qed. Lemma eqm_sub x y : x ≡ y → x - y ≡ 0. Proof. intros h; unfold eqm; rewrite Zminus_mod, h, Z.sub_diag; reflexivity. Qed. Lemma eqmE x y : x ≡ y → ∃ k, x - y = k * wB. Proof. intros h. exact (Zmod_divide (x - y) wB (λ e, let 'eq_refl := e in I) (eqm_sub _ _ h)). Qed. Lemma eqm_subE x y : x ≡ y ↔ x - y ≡ 0. Proof. split. - apply eqm_sub. - intros h; case (eqmE _ _ h); clear h; intros q h. assert (y = x - q * wB) by lia. clear h; subst y. unfold eqm; rewrite Zminus_mod, Z_mod_mult, Z.sub_0_r, Zmod_mod; reflexivity. Qed. Lemma int_eqm x y : x = y → φ x ≡ φ y. Proof. unfold eqm; intros ->; reflexivity. Qed. Lemma eqmI x y : φ x ≡ φ y → x = y. Proof. unfold eqm. repeat rewrite Zmod_small by apply to_Z_bounded. apply to_Z_inj. Qed. (* ADD *) Lemma add_assoc x y z: (x + (y + z) = (x + y) + z)%uint63. Proof. apply to_Z_inj; rewrite !add_spec. rewrite -> Zplus_mod_idemp_l, Zplus_mod_idemp_r, Zplus_assoc; auto. Qed. Lemma add_comm x y: (x + y = y + x)%uint63. Proof. apply to_Z_inj; rewrite -> !add_spec, Zplus_comm; auto. Qed. Lemma add_le_r m n: if (n <=? m + n)%uint63 then (φ m + φ n < wB)%Z else (wB <= φ m + φ n)%Z. Proof. case (to_Z_bounded m); intros H1m H2m. case (to_Z_bounded n); intros H1n H2n. case (Zle_or_lt wB (φ m + φ n)); intros H. - assert (H1: (φ (m + n) = φ m + φ n - wB)%Z). { rewrite add_spec. replace ((φ m + φ n) mod wB)%Z with ((((φ m + φ n) - wB) + wB) mod wB)%Z. - rewrite -> Zplus_mod, Z_mod_same_full, Zplus_0_r, !Zmod_small; auto with zarith. rewrite !Zmod_small; auto with zarith. - apply (f_equal2 Z.modulo); auto with zarith. } case_eq (n <=? m + n)%uint63; auto. rewrite leb_spec, H1; auto with zarith. - assert (H1: (φ (m + n) = φ m + φ n)%Z). { rewrite add_spec, Zmod_small; auto with zarith. } replace (n <=? m + n)%uint63 with true; auto. apply sym_equal; rewrite leb_spec, H1; auto with zarith. Qed. Lemma add_cancel_l x y z : (x + y = x + z)%uint63 -> y = z. Proof. intros h; apply int_eqm in h; rewrite !add_spec in h; apply eqm_mod, eqm_sub in h. replace (_ + _ - _) with (φ(y) - φ(z)) in h by lia. rewrite <- eqm_subE in h. apply eqmI, h. Qed. Lemma add_cancel_r x y z : (y + x = z + x)%uint63 -> y = z. Proof. rewrite !(fun t => add_comm t x); intros Hl; apply (add_cancel_l x); auto. Qed. Coercion b2i (b: bool) : int := if b then 1%uint63 else 0%uint63. (* LSR *) Lemma lsr0 i : 0 >> i = 0%uint63. Proof. apply to_Z_inj; rewrite lsr_spec; reflexivity. Qed. Lemma lsr_0_r i: i >> 0 = i. Proof. apply to_Z_inj; rewrite lsr_spec, Zdiv_1_r; exact eq_refl. Qed. Lemma lsr_1 n : 1 >> n = (n =? 0)%uint63. Proof. case eqbP. - intros h; rewrite (to_Z_inj _ _ h), lsr_0_r; reflexivity. - intros Hn. assert (H1n : (1 >> n = 0)%uint63); auto. apply to_Z_inj; rewrite lsr_spec. apply Zdiv_small; rewrite to_Z_1; split; auto with zarith. change 1%Z with (2^0)%Z. apply Zpower_lt_monotone; split; auto with zarith. rewrite to_Z_0 in Hn. generalize (to_Z_bounded n). lia. Qed. Lemma lsr_add i m n: ((i >> m) >> n = if n <=? m + n then i >> (m + n) else 0)%uint63. Proof. case (to_Z_bounded m); intros H1m H2m. case (to_Z_bounded n); intros H1n H2n. case (to_Z_bounded i); intros H1i H2i. generalize (add_le_r m n); case (n <=? m + n)%uint63; intros H. - apply to_Z_inj; rewrite -> !lsr_spec, Zdiv_Zdiv, <- Zpower_exp; auto with zarith. rewrite add_spec, Zmod_small; auto with zarith. - apply to_Z_inj; rewrite -> !lsr_spec, Zdiv_Zdiv, <- Zpower_exp; auto with zarith. apply Zdiv_small. split; [ auto with zarith | ]. eapply Z.lt_le_trans; [ | apply Zpower2_le_lin ]; auto with zarith. Qed. (* LSL *) Lemma lsl0 i: 0 << i = 0%uint63. Proof. apply to_Z_inj. generalize (lsl_spec 0 i). rewrite to_Z_0, Zmult_0_l, Zmod_0_l; auto. Qed. Lemma lsl0_r i : i << 0 = i. Proof. apply to_Z_inj. rewrite -> lsl_spec, to_Z_0, Z.mul_1_r. apply Zmod_small; apply (to_Z_bounded i). Qed. Lemma lsl_add_distr x y n: (x + y) << n = ((x << n) + (y << n))%uint63. Proof. apply to_Z_inj; rewrite -> !lsl_spec, !add_spec, Zmult_mod_idemp_l. rewrite -> !lsl_spec, <-Zplus_mod. apply (f_equal2 Z.modulo); auto with zarith. Qed. Lemma lsr_M_r x i (H: (digits <=? i = true)%uint63) : x >> i = 0%uint63. Proof. apply to_Z_inj. rewrite lsr_spec, to_Z_0. case (to_Z_bounded x); intros H1x H2x. case (to_Z_bounded digits); intros H1d H2d. rewrite -> leb_spec in H. apply Zdiv_small; split; [ auto | ]. apply (Z.lt_le_trans _ _ _ H2x). unfold wB; change (Z_of_nat size) with φ digits. apply Zpower_le_monotone; auto with zarith. Qed. (* BIT *) Lemma bit_0_spec i: φ (bit i 0) = φ i mod 2. Proof. unfold bit, is_zero. rewrite lsr_0_r. assert (Hbi: (φ i mod 2 < 2)%Z). { apply Z_mod_lt; auto with zarith. } case (to_Z_bounded i); intros H1i H2i. case (Z.mod_bound_pos_le (φ i) 2); auto with zarith; intros H3i H4i. assert (H2b: (0 < 2 ^ φ (digits - 1))%Z). { apply Zpower_gt_0; auto with zarith. case (to_Z_bounded (digits -1)); auto with zarith. } assert (H: φ (i << (digits -1)) = (φ i mod 2 * 2^ φ (digits -1))%Z). { rewrite lsl_spec. rewrite -> (Z_div_mod_eq_full φ i 2) at 1. rewrite -> Zmult_plus_distr_l, <-Zplus_mod_idemp_l. rewrite -> (Zmult_comm 2), <-Zmult_assoc. replace (2 * 2 ^ φ (digits - 1))%Z with wB; auto. rewrite Z_mod_mult, Zplus_0_l; apply Zmod_small. split; auto with zarith. replace wB with (2 * 2 ^ φ (digits -1))%Z; auto. apply Zmult_lt_compat_r; auto with zarith. } case (Zle_lt_or_eq 0 (φ i mod 2)); auto with zarith; intros Hi. 2: generalize H; rewrite <-Hi, Zmult_0_l. 2: replace 0%Z with φ 0; auto. 2: now case eqbP. generalize H; replace (φ i mod 2) with 1%Z; auto with zarith. rewrite Zmult_1_l. intros H1. assert (H2: φ (i << (digits - 1)) <> φ 0). { replace φ 0 with 0%Z; auto with zarith. } now case eqbP. Qed. Lemma bit_split i : ( i = (i >> 1 ) << 1 + bit i 0)%uint63. Proof. apply to_Z_inj. rewrite -> add_spec, lsl_spec, lsr_spec, bit_0_spec, Zplus_mod_idemp_l. replace (2 ^ φ 1) with 2%Z; auto with zarith. rewrite -> Zmult_comm, <-Z_div_mod_eq_full. rewrite Zmod_small; auto; case (to_Z_bounded i); auto. Qed. Lemma bit_lsr x i j : (bit (x >> i) j = if j <=? i + j then bit x (i + j) else false)%uint63. Proof. unfold bit; rewrite lsr_add; case (_ ≤? _); auto. Qed. Lemma bit_b2i (b: bool) i : bit b i = (i =? 0)%uint63 && b. Proof. case b; unfold bit; simpl b2i. - rewrite lsr_1; case (i =? 0)%uint63; auto. - rewrite lsr0, lsl0, andb_false_r; auto. Qed. Lemma bit_1 n : bit 1 n = (n =? 0)%uint63. Proof. unfold bit; rewrite lsr_1. case (_ =? _)%uint63; simpl; auto. Qed. Local Hint Resolve Z.lt_gt Z.div_pos : zarith. Lemma to_Z_split x : φ x = φ (x >> 1) * 2 + φ (bit x 0). Proof. case (to_Z_bounded x); intros H1x H2x. case (to_Z_bounded (bit x 0)); intros H1b H2b. assert (F1: 0 <= φ (x >> 1) < wB/2). { rewrite -> lsr_spec, to_Z_1, Z.pow_1_r. split; auto with zarith. apply Zdiv_lt_upper_bound; auto with zarith. } rewrite -> (bit_split x) at 1. rewrite -> add_spec, Zmod_small, lsl_spec, to_Z_1, Z.pow_1_r, Zmod_small; split; auto with zarith. - change wB with ((wB/2)*2); auto with zarith. - rewrite -> lsl_spec, to_Z_1, Z.pow_1_r, Zmod_small; auto with zarith. change wB with ((wB/2)*2); auto with zarith. - rewrite -> lsl_spec, to_Z_1, Z.pow_1_r, Zmod_small; auto with zarith. 2: change wB with ((wB/2)*2); auto with zarith. change wB with (((wB/2 - 1) * 2 + 1) + 1). assert (φ (bit x 0) <= 1); auto with zarith. case bit; discriminate. Qed. Lemma bit_M i n (H: (digits <=? n = true)%uint63): bit i n = false. Proof. unfold bit; rewrite lsr_M_r; auto. Qed. Lemma bit_half i n (H: (n >1) n = bit i (n+1). Proof. unfold bit. rewrite lsr_add. case_eq (n <=? (1 + n))%uint63. - replace (1+n)%uint63 with (n+1)%uint63; [auto|idtac]. apply to_Z_inj; rewrite !add_spec, Zplus_comm; auto. - intros H1; assert (H2: n = max_int). 2: generalize H; rewrite H2; discriminate. case (to_Z_bounded n); intros H1n H2n. case (Zle_lt_or_eq φ n (wB - 1)); auto with zarith; intros H2; apply to_Z_inj; auto. generalize (add_le_r 1 n); rewrite H1. change φ max_int with (wB - 1)%Z. replace φ 1 with 1%Z; auto with zarith. Qed. Lemma bit_ext i j : (forall n, bit i n = bit j n) -> i = j. Proof. case (to_Z_bounded j); case (to_Z_bounded i). unfold wB; revert i j; elim size. - simpl; intros i j ???? _; apply to_Z_inj; lia. - intros n ih i j. rewrite Nat2Z.inj_succ, Z.pow_succ_r by auto with zarith. intros hi1 hi2 hj1 hj2 hext. rewrite (bit_split i), (bit_split j), hext. do 2 f_equal; apply ih; clear ih. 1, 3: apply to_Z_bounded. 1, 2: now rewrite lsr_spec; apply Z.div_lt_upper_bound. intros b. case (Zle_or_lt φ digits φ b). + rewrite <- leb_spec; intros; rewrite !bit_M; auto. + rewrite <- ltb_spec; intros; rewrite !bit_half; auto. Qed. Lemma bit_lsl x i j : bit (x << i) j = (if (j = 0) by discriminate. case_eq (digits <=? j)%uint63; intros H. - rewrite orb_true_r, bit_M; auto. - set (d := φ digits). case (Zle_or_lt d (φ j)); intros H1. 1:case (leb_spec digits j); rewrite H; auto with zarith. 1:intros _ HH; generalize (HH H1); discriminate. clear H. generalize (ltb_spec j i); case ltb; intros H2; unfold bit; simpl. + change 62%uint63 with (digits - 1)%uint63. assert (F2: (φ j < φ i)%Z) by (case H2; auto); clear H2. replace (is_zero (((x << i) >> j) << (digits - 1))) with true; auto. case (to_Z_bounded j); intros H1j H2j. apply sym_equal; rewrite is_zero_spec; apply to_Z_inj. rewrite lsl_spec, lsr_spec, lsl_spec. replace wB with (2^d); auto. pattern d at 1; replace d with ((d - (φ j + 1)) + (φ j + 1))%Z by ring. rewrite Zpower_exp; auto with zarith. replace φ i with ((φ i - (φ j + 1)) + (φ j + 1))%Z by ring. rewrite -> Zpower_exp, Zmult_assoc; auto with zarith. rewrite Zmult_mod_distr_r. rewrite -> Zplus_comm, Zpower_exp, !Zmult_assoc; auto with zarith. rewrite -> Z_div_mult_full; auto with zarith. rewrite <-Zmult_assoc, <-Zpower_exp; auto with zarith. replace (1 + φ digits - 1)%Z with d; auto with zarith. rewrite Z_mod_mult; auto. + case H2; intros _ H3; case (Zle_or_lt φ i φ j); intros F2. 2: generalize (H3 F2); discriminate. clear H2 H3. apply (f_equal negb). apply (f_equal is_zero). apply to_Z_inj. rewrite -> !lsl_spec, !lsr_spec, !lsl_spec. pattern wB at 2 3; replace wB with (2^(1+ φ (digits - 1))); auto. rewrite -> Zpower_exp, Z.pow_1_r; auto with zarith. rewrite !Zmult_mod_distr_r. apply (f_equal2 Zmult); auto. replace wB with (2^ d); auto with zarith. replace d with ((d - φ i) + φ i)%Z by ring. case (to_Z_bounded i); intros H1i H2i. rewrite Zpower_exp; auto with zarith. rewrite Zmult_mod_distr_r. case (to_Z_bounded j); intros H1j H2j. replace φ (j - i) with (φ j - φ i)%Z. 2: rewrite sub_spec, Zmod_small; auto with zarith. set (d1 := (d - φ i)%Z). set (d2 := (φ j - φ i)%Z). pattern φ j at 1; replace φ j with (d2 + φ i)%Z. 2: unfold d2; ring. rewrite -> Zpower_exp; auto with zarith. rewrite -> Zdiv_mult_cancel_r. 2: generalize (Zpower2_lt_lin φ i H1i); auto with zarith. rewrite -> (Z_div_mod_eq_full φ x (2^d1)) at 2. pattern d1 at 2; replace d1 with (d2 + (1+ (d - φ j - 1)))%Z by (unfold d1, d2; ring). rewrite Zpower_exp; auto with zarith. rewrite <-Zmult_assoc, Zmult_comm. rewrite Zdiv.Z_div_plus_full_l; auto with zarith. rewrite Zpower_exp, Z.pow_1_r; auto with zarith. rewrite <-Zplus_mod_idemp_l. rewrite <-!Zmult_assoc, Zmult_comm, Z_mod_mult, Zplus_0_l; auto. Qed. (* LOR *) Lemma lor_lsr i1 i2 i: (i1 lor i2) >> i = (i1 >> i) lor (i2 >> i). Proof. apply bit_ext; intros n. rewrite -> lor_spec, !bit_lsr, lor_spec. case (_ <=? _)%uint63; auto. Qed. Lemma lor_le x y : (y <=? x lor y)%uint63 = true. Proof. generalize x y (to_Z_bounded x) (to_Z_bounded y); clear x y. unfold wB; elim size. - replace (2^Z_of_nat 0) with 1%Z; auto with zarith. intros x y Hx Hy; replace x with 0%uint63. + replace y with 0%uint63; auto. apply to_Z_inj; rewrite to_Z_0; auto with zarith. + apply to_Z_inj; rewrite to_Z_0; auto with zarith. - intros n IH x y; rewrite inj_S. unfold Z.succ; rewrite -> Zpower_exp, Z.pow_1_r; auto with zarith. intros Hx Hy. rewrite leb_spec. rewrite -> (to_Z_split y) at 1; rewrite (to_Z_split (x lor y)). assert (φ (y>>1) <= φ ((x lor y) >> 1)). + rewrite -> lor_lsr, <-leb_spec; apply IH. * rewrite -> lsr_spec, to_Z_1, Z.pow_1_r; split; auto with zarith. apply Zdiv_lt_upper_bound; auto with zarith. * rewrite -> lsr_spec, to_Z_1, Z.pow_1_r; split; auto with zarith. apply Zdiv_lt_upper_bound; auto with zarith. + assert (φ (bit y 0) <= φ (bit (x lor y) 0)); auto with zarith. rewrite lor_spec; do 2 case bit; try discriminate. Qed. Lemma bit_0 n : bit 0 n = false. Proof. unfold bit; rewrite lsr0; auto. Qed. Lemma bit_add_or x y: (forall n, bit x n = true -> bit y n = true -> False) <-> (x + y)%uint63= x lor y. Proof. generalize x y (to_Z_bounded x) (to_Z_bounded y); clear x y. unfold wB; elim size. - replace (2^Z_of_nat 0) with 1%Z; auto with zarith. intros x y Hx Hy; replace x with 0%uint63. + replace y with 0%uint63. { split; auto; intros _ n; rewrite !bit_0; discriminate. } apply to_Z_inj; rewrite to_Z_0; auto with zarith. + apply to_Z_inj; rewrite to_Z_0; auto with zarith. - intros n IH x y; rewrite inj_S. unfold Z.succ; rewrite Zpower_exp, Z.pow_1_r; auto with zarith. intros Hx Hy. split. + intros Hn. assert (F1: ((x >> 1) + (y >> 1))%uint63 = (x >> 1) lor (y >> 1)). { apply IH. - rewrite lsr_spec, Z.pow_1_r; split; auto with zarith. apply Zdiv_lt_upper_bound; auto with zarith. - rewrite lsr_spec, Z.pow_1_r; split; auto with zarith. apply Zdiv_lt_upper_bound; auto with zarith. - intros m H1 H2. case_eq (digits <=? m)%uint63; [idtac | rewrite <- not_true_iff_false]; intros Heq. + rewrite bit_M in H1; auto; discriminate. + rewrite leb_spec in Heq. apply (Hn (m + 1)%uint63); rewrite <-bit_half; auto; rewrite ltb_spec; auto with zarith. } rewrite (bit_split (x lor y)), lor_lsr, <- F1, lor_spec. replace (b2i (bit x 0 || bit y 0)) with (bit x 0 + bit y 0)%uint63. 2: generalize (Hn 0%uint63); do 2 case bit; auto; intros [ ]; auto. rewrite lsl_add_distr. rewrite (bit_split x) at 1; rewrite (bit_split y) at 1. rewrite <-!add_assoc; apply (f_equal2 add); auto. rewrite add_comm, <-!add_assoc; apply (f_equal2 add); auto. rewrite add_comm; auto. + intros Heq. generalize (add_le_r x y); rewrite Heq, lor_le; intro Hb. generalize Heq; rewrite (bit_split x) at 1; rewrite (bit_split y )at 1; clear Heq. rewrite (fun y => add_comm y (bit x 0)), <-!add_assoc, add_comm, <-!add_assoc, (add_comm (bit y 0)), add_assoc, <-lsl_add_distr. rewrite (bit_split (x lor y)), lor_spec. intros Heq. assert (F: (bit x 0 + bit y 0)%uint63 = (bit x 0 || bit y 0)). { assert (F1: (2 | wB)) by (apply Zpower_divide; apply refl_equal). assert (F2: 0 < wB) by (apply refl_equal). assert (F3: φ (bit x 0 + bit y 0) mod 2 = φ (bit x 0 || bit y 0) mod 2). { apply trans_equal with ((φ ((x>>1 + y>>1) << 1) + φ (bit x 0 + bit y 0)) mod 2). - rewrite lsl_spec, Zplus_mod, <-Zmod_div_mod; auto with zarith. rewrite Z.pow_1_r, Z_mod_mult, Zplus_0_l, Zmod_mod; auto with zarith. - rewrite (Zmod_div_mod 2 wB), <-add_spec, Heq; auto with zarith. rewrite add_spec, <-Zmod_div_mod; auto with zarith. rewrite lsl_spec, Zplus_mod, <-Zmod_div_mod; auto with zarith. rewrite Z.pow_1_r, Z_mod_mult, Zplus_0_l, Zmod_mod; auto with zarith. } generalize F3; do 2 case bit; try discriminate; auto. } case (IH (x >> 1) (y >> 1)). * rewrite lsr_spec, to_Z_1, Z.pow_1_r; split; auto with zarith. apply Zdiv_lt_upper_bound; auto with zarith. * rewrite lsr_spec, to_Z_1, Z.pow_1_r; split; auto with zarith. apply Zdiv_lt_upper_bound; auto with zarith. * intros _ HH m; case (to_Z_bounded m); intros H1m H2m. case_eq (digits <=? m)%uint63. -- intros Hlm; rewrite bit_M; auto; discriminate. -- rewrite <- not_true_iff_false, leb_spec; intros Hlm. case (Zle_lt_or_eq 0 φ m); auto; intros Hm. ++ replace m with ((m -1) + 1)%uint63. { rewrite <-(bit_half x), <-(bit_half y); auto with zarith. - apply HH. rewrite <-lor_lsr. assert (0 <= φ (bit (x lor y) 0) <= 1) by (case bit; split; discriminate). rewrite F in Heq; generalize (add_cancel_r _ _ _ Heq). intros Heq1; apply to_Z_inj. generalize (f_equal to_Z Heq1); rewrite lsl_spec, to_Z_1, Z.pow_1_r, Zmod_small. + rewrite lsl_spec, to_Z_1, Z.pow_1_r, Zmod_small; auto with zarith. case (to_Z_bounded (x lor y)); intros H1xy H2xy. rewrite lsr_spec, to_Z_1, Z.pow_1_r; auto with zarith. change wB with ((wB/2)*2); split; auto with zarith. assert (φ (x lor y) / 2 < wB / 2); auto with zarith. apply Zdiv_lt_upper_bound; auto with zarith. + split. * case (to_Z_bounded (x >> 1 + y >> 1)); auto with zarith. * rewrite add_spec. apply Z.le_lt_trans with ((φ (x >> 1) + φ (y >> 1)) * 2); auto with zarith. -- case (Z.mod_bound_pos_le (φ (x >> 1) + φ (y >> 1)) wB); auto with zarith. case (to_Z_bounded (x >> 1)); case (to_Z_bounded (y >> 1)); auto with zarith. -- generalize Hb; rewrite (to_Z_split x) at 1; rewrite (to_Z_split y) at 1. case (to_Z_bounded (bit x 0)); case (to_Z_bounded (bit y 0)); auto with zarith. - rewrite ltb_spec, sub_spec, to_Z_1, Zmod_small; auto with zarith. - rewrite ltb_spec, sub_spec, to_Z_1, Zmod_small; auto with zarith. } apply to_Z_inj. rewrite add_spec, sub_spec, Zplus_mod_idemp_l, to_Z_1, Zmod_small; auto with zarith. ++ pose proof (to_Z_inj 0 _ Hm); clear Hm; subst m. intros hx hy; revert F; rewrite hx, hy; intros F. generalize (f_equal to_Z F). vm_compute. lia. Qed. Lemma addmuldiv_spec x y p : φ p <= φ digits -> φ (addmuldiv p x y) = (φ x * (2 ^ φ p) + φ y / (2 ^ (φ digits - φ p))) mod wB. Proof. intros H. assert (Fp := to_Z_bounded p); assert (Fd := to_Z_bounded digits). rewrite addmuldiv_def_spec; unfold addmuldiv_def. case (bit_add_or (x << p) (y >> (digits - p))); intros HH _. rewrite <-HH, add_spec, lsl_spec, lsr_spec, Zplus_mod_idemp_l, sub_spec. - rewrite (fun x y => Zmod_small (x - y)); auto with zarith. - intros n; rewrite -> bit_lsl, bit_lsr. generalize (add_le_r (digits - p) n). case (_ ≤? _); try discriminate. rewrite -> sub_spec, Zmod_small; auto with zarith; intros H1. case_eq (n leb_spec, add_spec, Zmod_small, sub_spec, Zmod_small; auto with zarith. rewrite -> sub_spec, Zmod_small; auto with zarith. Qed. (* is_even *) Lemma is_even_bit i : is_even i = negb (bit i 0). Proof. unfold is_even. replace (i land 1) with (b2i (bit i 0)). - case bit; auto. - apply bit_ext; intros n. rewrite bit_b2i, land_spec, bit_1. generalize (eqb_spec n 0). case (n =? 0)%uint63; auto. + intros(H,_); rewrite andb_true_r, H; auto. + rewrite andb_false_r; auto. Qed. Lemma is_even_spec x : if is_even x then φ x mod 2 = 0 else φ x mod 2 = 1. Proof. rewrite is_even_bit. generalize (bit_0_spec x); case bit; simpl; auto. Qed. Lemma is_even_0 : is_even 0 = true. Proof. apply refl_equal. Qed. Lemma is_even_lsl_1 i : is_even (i << 1) = true. Proof. rewrite is_even_bit, bit_lsl; auto. Qed. (* Sqrt *) (* Direct transcription of an old proof of a fortran program in boyer-moore *) Ltac elim_div := unfold Z.div, Z.modulo; match goal with | H : context[ Z.div_eucl ?X ?Y ] |- _ => generalize dependent H; generalize (Z_div_mod_full X Y) ; case (Z.div_eucl X Y) | |- context[ Z.div_eucl ?X ?Y ] => generalize (Z_div_mod_full X Y) ; case (Z.div_eucl X Y) end; unfold Remainder. Lemma quotient_by_2 a: a - 1 <= (a/2) + (a/2). Proof. case (Z_mod_lt a 2); auto with zarith. intros H1; rewrite Zmod_eq_full; auto with zarith. Qed. Lemma sqrt_main_trick j k: 0 <= j -> 0 <= k -> (j * k) + j <= ((j + k)/2 + 1) ^ 2. Proof. intros Hj; generalize Hj k; pattern j; apply natlike_ind; auto; clear k j Hj. - intros _ k Hk; repeat rewrite Zplus_0_l. apply Zmult_le_0_compat; generalize (Z_div_pos k 2); auto with zarith. - intros j Hj Hrec _ k Hk; pattern k; apply natlike_ind; auto; clear k Hk. + rewrite -> Zmult_0_r, Zplus_0_r, Zplus_0_l. generalize (sqr_pos (Z.succ j / 2)) (quotient_by_2 (Z.succ j)); unfold Z.succ. rewrite Z.pow_2_r, Zmult_plus_distr_l; repeat rewrite Zmult_plus_distr_r. auto with zarith. + intros k Hk _. replace ((Z.succ j + Z.succ k) / 2) with ((j + k)/2 + 1). * generalize (Hrec Hj k Hk) (quotient_by_2 (j + k)). unfold Z.succ; repeat rewrite Z.pow_2_r; repeat rewrite Zmult_plus_distr_l; repeat rewrite Zmult_plus_distr_r. repeat rewrite Zmult_1_l; repeat rewrite Zmult_1_r. auto with zarith. * rewrite -> Zplus_comm, <- Z_div_plus_full_l; auto with zarith. apply f_equal2; auto with zarith. Qed. Lemma sqrt_main i j: 0 <= i -> 0 < j -> i < ((j + (i/j))/2 + 1) ^ 2. Proof. intros Hi Hj. assert (Hij: 0 <= i/j) by (apply Z_div_pos; auto with zarith). refine (Z.lt_le_trans _ _ _ _ (sqrt_main_trick _ _ (Zlt_le_weak _ _ Hj) Hij)). pattern i at 1; rewrite -> (Z_div_mod_eq_full i j); case (Z_mod_lt i j); auto with zarith. Qed. Lemma sqrt_test_false i j: 0 <= i -> 0 < j -> i/j < j -> (j + (i/j))/2 < j. Proof. intros Hi Hj; elim_div; intros q r [ ? hr ]; [ lia | subst i ]. elim_div; intros a b [ h [ hb | ] ]; lia. Qed. Lemma sqrt_test_true i j: 0 <= i -> 0 < j -> i/j >= j -> j ^ 2 <= i. Proof. intros Hi Hj Hd; rewrite Z.pow_2_r. apply Z.le_trans with (j * (i/j)); auto with zarith. apply Z_mult_div_ge; auto with zarith. Qed. Lemma sqrt_step_correct rec i j: 0 < φ i -> 0 < φ j -> φ i < (φ j + 1) ^ 2 -> 2 * φ j < wB -> (forall j1 : int, 0 < φ j1 < φ j -> φ i < (φ j1 + 1) ^ 2 -> φ (rec i j1) ^ 2 <= φ i < (φ (rec i j1) + 1) ^ 2) -> φ (sqrt_step rec i j) ^ 2 <= φ i < (φ (sqrt_step rec i j) + 1) ^ 2. Proof. assert (Hp2: 0 < φ 2) by exact (refl_equal Lt). intros Hi Hj Hij H31 Hrec. unfold sqrt_step. case ltbP; rewrite div_spec. - intros hlt. assert (φ (j + i / j) = φ j + φ i/φ j) as hj. { rewrite add_spec, Zmod_small;rewrite div_spec; auto with zarith. } apply Hrec; rewrite lsr_spec, hj, to_Z_1; change (2 ^ 1) with 2. + split; [ | apply sqrt_test_false;auto with zarith]. replace (φ j + φ i/φ j) with (1 * 2 + ((φ j - 2) + φ i / φ j)) by ring. rewrite Z_div_plus_full_l; auto with zarith. assert (0 <= φ i/ φ j) by (apply Z_div_pos; auto with zarith). assert (0 <= (φ j - 2 + φ i / φ j) / 2) ; auto with zarith. apply Z.div_pos; [ | lia ]. case (Zle_lt_or_eq 1 φ j); auto with zarith; intros Hj1. rewrite <- Hj1, Zdiv_1_r; lia. + apply sqrt_main;auto with zarith. - split;[apply sqrt_test_true | ];auto with zarith. Qed. Lemma iter_sqrt_correct n rec i j: 0 < φ i -> 0 < φ j -> φ i < (φ j + 1) ^ 2 -> 2 * φ j < wB -> (forall j1, 0 < φ j1 -> 2^(Z_of_nat n) + φ j1 <= φ j -> φ i < (φ j1 + 1) ^ 2 -> 2 * φ j1 < wB -> φ (rec i j1) ^ 2 <= φ i < (φ (rec i j1) + 1) ^ 2) -> φ (iter_sqrt n rec i j) ^ 2 <= φ i < (φ (iter_sqrt n rec i j) + 1) ^ 2. Proof. revert rec i j; elim n; unfold iter_sqrt; fold iter_sqrt; clear n. - intros rec i j Hi Hj Hij H31 Hrec; apply sqrt_step_correct. 1-4: lia. intros; apply Hrec; only 2: rewrite Zpower_0_r; auto with zarith. - intros n Hrec rec i j Hi Hj Hij H31 HHrec. apply sqrt_step_correct; auto. intros j1 Hj1 Hjp1; apply Hrec; auto with zarith. intros j2 Hj2 H2j2 Hjp2 Hj31; apply Hrec; auto with zarith. intros j3 Hj3 Hpj3. apply HHrec; auto. rewrite -> inj_S, Z.pow_succ_r. + apply Z.le_trans with (2 ^Z_of_nat n + φ j2); auto with zarith. + apply Zle_0_nat. Qed. Lemma sqrt_init i: 1 < i -> i < (i/2 + 1) ^ 2. Proof. intros Hi. assert (H1: 0 <= i - 2) by auto with zarith. assert (H2: 1 <= (i / 2) ^ 2); auto with zarith. { replace i with (1* 2 + (i - 2)); auto with zarith. rewrite Z.pow_2_r, Z_div_plus_full_l; [|auto with zarith]. generalize (sqr_pos ((i - 2)/ 2)) (Z_div_pos (i - 2) 2). rewrite Zmult_plus_distr_l; repeat rewrite Zmult_plus_distr_r. auto with zarith. } generalize (quotient_by_2 i). rewrite -> Z.pow_2_r in H2 |- *; repeat (rewrite Zmult_plus_distr_l || rewrite Zmult_plus_distr_r || rewrite Zmult_1_l || rewrite Zmult_1_r). auto with zarith. Qed. Lemma sqrt_spec : forall x, φ (sqrt x) ^ 2 <= φ x < (φ (sqrt x) + 1) ^ 2. Proof. intros i; unfold sqrt. rewrite compare_spec. case Z.compare_spec; rewrite to_Z_1; intros Hi. - lia. - apply iter_sqrt_correct; auto with zarith; rewrite lsr_spec, to_Z_1; change (2^1) with 2; auto with zarith. + replace φ i with (1 * 2 + (φ i - 2))%Z; try ring. assert (0 <= (φ i - 2)/2)%Z by (apply Z_div_pos; auto with zarith). rewrite Z_div_plus_full_l; auto with zarith. + apply sqrt_init; auto. + assert (W:= Z_mult_div_ge φ i 2);assert (W':= to_Z_bounded i);auto with zarith. + intros j2 H1 H2; contradict H2; apply Zlt_not_le. fold wB;assert (W:=to_Z_bounded i). apply Z.le_lt_trans with (φ i); auto with zarith. assert (0 <= φ i/2)%Z by (apply Z_div_pos; auto with zarith). apply Z.le_trans with (2 * (φ i/2)); auto with zarith. apply Z_mult_div_ge; auto with zarith. - case (to_Z_bounded i); repeat rewrite Z.pow_2_r; auto with zarith. Qed. (* sqrt2 *) Lemma sqrt2_step_def rec ih il j: sqrt2_step rec ih il j = if (ih m1 >> 1 | C1 m1 => (m1 >> 1 + 1 << (digits -1))%uint63 end in rec ih il m else j else j. Proof. unfold sqrt2_step; case diveucl_21; intros i j';simpl. case (j +c i);trivial. Qed. Lemma sqrt2_lower_bound ih il j: Φ (WW ih il) < (φ j + 1) ^ 2 -> φ ih <= φ j. Proof. intros H1. case (to_Z_bounded j); intros Hbj _. case (to_Z_bounded il); intros Hbil _. case (to_Z_bounded ih); intros Hbih Hbih1. assert ((φ ih < φ j + 1)%Z); auto with zarith. apply Zlt_square_simpl; auto with zarith. simpl zn2z_to_Z in H1. repeat rewrite <-Z.pow_2_r. refine (Z.le_lt_trans _ _ _ _ H1). apply Z.le_trans with (φ ih * wB)%Z;try rewrite Z.pow_2_r; auto with zarith. Qed. Lemma diveucl_21_spec_aux : forall a1 a2 b, wB/2 <= φ b -> φ a1 < φ b -> let (q,r) := diveucl_21 a1 a2 b in φ a1 *wB+ φ a2 = φ q * φ b + φ r /\ 0 <= φ r < φ b. Proof. intros a1 a2 b H1 H2;assert (W:= diveucl_21_spec a1 a2 b). assert (W1:= to_Z_bounded a1). assert (W2:= to_Z_bounded a2). assert (Wb:= to_Z_bounded b). assert (φ b>0) as H by (auto with zarith). generalize (Z_div_mod (φ a1*wB+φ a2) φ b H). revert W. destruct (diveucl_21 a1 a2 b); destruct (Z.div_eucl (φ a1*wB+φ a2) φ b). intros (H', H''); auto; rewrite H', H''; clear H' H''. intros (H', H''); split; [ |exact H'']. now rewrite H', Zmult_comm. Qed. Lemma div2_phi ih il j: (2^62 <= φ j -> φ ih < φ j -> φ (fst (diveucl_21 ih il j)) = Φ (WW ih il) / φ j)%Z. Proof. intros Hj Hj1. generalize (diveucl_21_spec_aux ih il j Hj Hj1). case diveucl_21; intros q r (Hq, Hr). apply Zdiv_unique with φ r; auto with zarith. simpl @fst; apply eq_trans with (1 := Hq); ring. Qed. Lemma sqrt2_step_correct rec ih il j: 2 ^ (Z_of_nat (size - 2)) <= φ ih -> 0 < φ j -> Φ (WW ih il) < (φ j + 1) ^ 2 -> (forall j1, 0 < φ j1 < φ j -> Φ (WW ih il) < (φ j1 + 1) ^ 2 -> φ (rec ih il j1) ^ 2 <= Φ (WW ih il) < (φ (rec ih il j1) + 1) ^ 2) -> φ (sqrt2_step rec ih il j) ^ 2 <= Φ (WW ih il) < (φ (sqrt2_step rec ih il j) + 1) ^ 2. Proof. assert (Hp2: (0 < φ 2)%Z) by exact (refl_equal Lt). intros Hih Hj Hij Hrec; rewrite sqrt2_step_def. assert (H1: (φ ih <= φ j)%Z) by (apply sqrt2_lower_bound with il; auto). case (to_Z_bounded ih); intros Hih1 _. case (to_Z_bounded il); intros Hil1 _. case (to_Z_bounded j); intros _ Hj1. assert (Hp3: (0 < Φ (WW ih il))). {simpl zn2z_to_Z;apply Z.lt_le_trans with (φ ih * wB)%Z; auto with zarith. apply Zmult_lt_0_compat; auto with zarith. } cbv zeta. case_eq (ih ltb_spec in Heq. case (Zle_or_lt (2^(Z_of_nat size -1)) φ j); intros Hjj. 1: case_eq (fst (diveucl_21 ih il j) ltb_spec, (div2_phi _ _ _ Hjj Heq) in Heq0. match goal with |- context[rec _ _ ?X] => set (u := X) end. assert (H: φ u = (φ j + (Φ (WW ih il))/(φ j))/2). { unfold u; generalize (addc_spec j (fst (diveucl_21 ih il j))); case addc;unfold interp_carry;rewrite (div2_phi _ _ _ Hjj Heq);simpl zn2z_to_Z. { intros i H;rewrite lsr_spec, H;trivial. } intros i H;rewrite <- H. case (to_Z_bounded i); intros H1i H2i. rewrite -> add_spec, Zmod_small, lsr_spec. { change (1 * wB) with (φ (1 << (digits -1)) * 2)%Z. rewrite Z_div_plus_full_l; auto with zarith. } change wB with (2 * (wB/2))%Z; auto. replace φ (1 << (digits - 1)) with (wB/2); auto. rewrite lsr_spec; auto. replace (2^φ 1) with 2%Z; auto. split; auto with zarith. assert (φ i/2 < wB/2); auto with zarith. apply Zdiv_lt_upper_bound; auto with zarith. } apply Hrec; rewrite H; clear u H. + assert (Hf1: 0 <= Φ (WW ih il) / φ j) by (apply Z_div_pos; auto with zarith). case (Zle_lt_or_eq 1 (φ j)); auto with zarith; intros Hf2. split. * replace (φ j + Φ (WW ih il) / φ j)%Z with (1 * 2 + ((φ j - 2) + Φ (WW ih il) / φ j)) by lia. rewrite Z_div_plus_full_l; auto with zarith. assert (0 <= (φ j - 2 + Φ (WW ih il) / φ j) / 2) ; auto with zarith. * apply sqrt_test_false; auto with zarith. + apply sqrt_main; auto with zarith. - contradict Hij; apply Zle_not_lt. assert ((1 + φ j) <= 2 ^ (Z_of_nat size - 1)); auto with zarith. apply Z.le_trans with ((2 ^ (Z_of_nat size - 1)) ^2); auto with zarith. + assert (0 <= 1 + φ j); auto with zarith. apply Zmult_le_compat; auto with zarith. + change ((2 ^ (Z_of_nat size - 1))^2) with (2 ^ (Z_of_nat size - 2) * wB). apply Z.le_trans with (φ ih * wB); auto with zarith. unfold zn2z_to_Z, wB; auto with zarith. Qed. Lemma iter2_sqrt_correct n rec ih il j: 2^(Z_of_nat (size - 2)) <= φ ih -> 0 < φ j -> Φ (WW ih il) < (φ j + 1) ^ 2 -> (forall j1, 0 < φ j1 -> 2^(Z_of_nat n) + φ j1 <= φ j -> Φ (WW ih il) < (φ j1 + 1) ^ 2 -> φ (rec ih il j1) ^ 2 <= Φ (WW ih il) < (φ (rec ih il j1) + 1) ^ 2) -> φ (iter2_sqrt n rec ih il j) ^ 2 <= Φ (WW ih il) < (φ (iter2_sqrt n rec ih il j) + 1) ^ 2. Proof. revert rec ih il j; elim n; unfold iter2_sqrt; fold iter2_sqrt; clear n. - intros rec ih il j Hi Hj Hij Hrec; apply sqrt2_step_correct. 1-3: lia. intros; apply Hrec; only 2: rewrite Zpower_0_r; auto with zarith. - intros n Hrec rec ih il j Hi Hj Hij HHrec. apply sqrt2_step_correct; auto. intros j1 Hj1 Hjp1; apply Hrec; auto with zarith. intros j2 Hj2 H2j2 Hjp2; apply Hrec; auto with zarith. intros j3 Hj3 Hpj3. apply HHrec; auto. rewrite -> inj_S, Z.pow_succ_r. + apply Z.le_trans with (2 ^Z_of_nat n + φ j2)%Z; auto with zarith. + apply Zle_0_nat. Qed. Lemma sqrt2_spec : forall x y, wB/ 4 <= φ x -> let (s,r) := sqrt2 x y in Φ (WW x y) = φ s ^ 2 + [+|r|] /\ [+|r|] <= 2 * φ s. Proof. intros ih il Hih; unfold sqrt2. change Φ (WW ih il) with (Φ(WW ih il)). assert (Hbin: forall s, s * s + 2* s + 1 = (s + 1) ^ 2) by (intros s; ring). assert (Hb: 0 <= wB) by (red; intros HH; discriminate). assert (Hi2: Φ(WW ih il ) < (φ max_int + 1) ^ 2). { apply Z.le_lt_trans with ((wB - 1) * wB + (wB - 1)); auto with zarith. case (to_Z_bounded ih); case (to_Z_bounded il); intros H1 H2 H3 H4. unfold zn2z_to_Z; auto with zarith. } case (iter2_sqrt_correct size (fun _ _ j => j) ih il max_int); auto with zarith. - apply refl_equal. - intros j1 _ HH; contradict HH. apply Zlt_not_le. case (to_Z_bounded j1); auto with zarith. change (2 ^ Z_of_nat size) with (φ max_int+1)%Z; auto with zarith. - set (s := iter2_sqrt size (fun _ _ j : int=> j) ih il max_int). intros Hs1 Hs2. generalize (mulc_spec s s); case mulc. simpl fst; simpl snd; intros ih1 il1 Hihl1. generalize (subc_spec il il1). case subc; intros il2 Hil2. + simpl interp_carry in Hil2. case_eq (ih1 Z.pow_2_r, Hihl1, Hil2. case (Zle_lt_or_eq (φ ih1 + 1) (φ ih)); auto with zarith. -- intros H2; contradict Hs2; apply Zle_not_lt. replace ((φ s + 1) ^ 2) with (Φ(WW ih1 il1) + 2 * φ s + 1). ++ unfold zn2z_to_Z. case (to_Z_bounded il); intros Hpil _. assert (Hl1l: φ il1 <= φ il). ** case (to_Z_bounded il2); rewrite Hil2; auto with zarith. ** enough (φ ih1 * wB + 2 * φ s + 1 <= φ ih * wB) by lia. case (to_Z_bounded s); intros _ Hps. case (to_Z_bounded ih1); intros Hpih1 _. apply Z.le_trans with ((φ ih1 + 2) * wB). { lia. } auto with zarith. ++ unfold zn2z_to_Z; rewrite <-Hihl1, Hbin; auto. -- intros H2; split. ++ unfold zn2z_to_Z; rewrite <- H2; ring. ++ replace (wB + (φ il - φ il1)) with (Φ(WW ih il) - (φ s * φ s)). { rewrite <-Hbin in Hs2; auto with zarith. } rewrite Hihl1; unfold zn2z_to_Z; rewrite <- H2; ring. * unfold interp_carry. case (Zle_lt_or_eq φ ih φ ih1); auto with zarith; intros H. -- contradict Hs1. apply Zlt_not_le; rewrite Z.pow_2_r, Hihl1. unfold zn2z_to_Z. case (to_Z_bounded il); intros _ H2. apply Z.lt_le_trans with ((φ ih + 1) * wB + 0). ++ rewrite Zmult_plus_distr_l, Zplus_0_r; auto with zarith. ++ case (to_Z_bounded il1); intros H3 _. apply Zplus_le_compat; auto with zarith. -- split. ++ rewrite Z.pow_2_r, Hihl1. unfold zn2z_to_Z; ring[Hil2 H]. ++ replace φ il2 with (Φ(WW ih il) - Φ(WW ih1 il1)). { unfold zn2z_to_Z at 2; rewrite <-Hihl1. rewrite <-Hbin in Hs2; auto with zarith. } unfold zn2z_to_Z; rewrite H, Hil2; ring. + unfold interp_carry in Hil2 |- *. assert (Hsih: φ (ih - 1) = φ ih - 1). { rewrite sub_spec, Zmod_small; auto; replace φ 1 with 1; auto. case (to_Z_bounded ih); intros H1 H2. split; auto with zarith. apply Z.le_trans with (wB/4 - 1); auto with zarith. } case_eq (ih1 ; auto; destruct 1; reflexivity. Qed. (* bit *) Lemma bitE i j : bit i j = Z.testbit φ(i) φ(j). Proof. symmetry; apply negb_sym; rewrite is_zeroE, lsl_spec, lsr_spec. generalize (φ i) (to_Z_bounded i) (φ j) (to_Z_bounded j); clear i j; intros i [hi hi'] j [hj hj']. rewrite Z.testbit_eqb by auto; rewrite <- Z_oddE, Z.negb_odd, Z_evenE. remember (i / 2 ^ j) as k. change wB with (2 * 2 ^ φ (digits - 1)). unfold Z.modulo at 2. generalize (Z_div_mod_full k 2 (λ k, let 'eq_refl := k in I)); unfold Remainder. destruct Z.div_eucl as [ p q ]; intros [hk [ hq | ]]. 2: lia. rewrite hk. remember φ (digits - 1) as m. replace ((_ + _) * _) with (q * 2 ^ m + p * (2 * 2 ^ m)) by ring. rewrite Z_mod_plus by (subst m; reflexivity). assert (q = 0 ∨ q = 1) as D by lia. destruct D; subst; reflexivity. Qed. (* land, lor, lxor *) Lemma lt_pow_lt_log d k n : 0 < d <= n → 0 <= k < 2 ^ d → Z.log2 k < n. Proof. intros [hd hdn] [hk hkd]. assert (k = 0 ∨ 0 < k) as D by lia. clear hk; destruct D as [ hk | hk ]. - subst k; simpl; lia. - apply Z.log2_lt_pow2. + lia. + eapply Z.lt_le_trans. * eassumption. * apply Z.pow_le_mono_r; lia. Qed. Lemma land_spec' x y : φ (x land y) = Z.land φ(x) φ(y). Proof. apply Z.bits_inj'; intros n hn. destruct (to_Z_bounded (x land y)) as [ hxy hxy' ]. destruct (to_Z_bounded x) as [ hx hx' ]. destruct (to_Z_bounded y) as [ hy hy' ]. case (Z_lt_le_dec n (φ digits)); intros hd. 2: { rewrite !Z.bits_above_log2; auto. - apply Z.land_nonneg; auto. - eapply Z.le_lt_trans. { apply Z.log2_land; assumption. } apply Z.min_lt_iff. left. apply (lt_pow_lt_log φ digits). + exact (conj eq_refl hd). + split; assumption. - apply (lt_pow_lt_log φ digits). + exact (conj eq_refl hd). + split; assumption. } rewrite (is_int n). { rewrite Z.land_spec, <- !bitE, land_spec; reflexivity. } apply (conj hn). apply (Z.lt_trans _ _ _ hd). apply Zpower2_lt_lin. lia. Qed. Lemma lor_spec' x y : φ (x lor y) = Z.lor φ(x) φ(y). Proof. apply Z.bits_inj'; intros n hn. destruct (to_Z_bounded (x lor y)) as [ hxy hxy' ]. destruct (to_Z_bounded x) as [ hx hx' ]. destruct (to_Z_bounded y) as [ hy hy' ]. case (Z_lt_le_dec n (φ digits)); intros hd. 2: { rewrite !Z.bits_above_log2; auto. - apply Z.lor_nonneg; auto. - rewrite Z.log2_lor by assumption. apply Z.max_lub_lt; apply (lt_pow_lt_log φ digits); split; assumption || reflexivity. - apply (lt_pow_lt_log φ digits); split; assumption || reflexivity. } rewrite (is_int n). { rewrite Z.lor_spec, <- !bitE, lor_spec; reflexivity. } apply (conj hn). apply (Z.lt_trans _ _ _ hd). apply Zpower2_lt_lin. lia. Qed. Lemma lxor_spec' x y : φ (x lxor y) = Z.lxor φ(x) φ(y). Proof. apply Z.bits_inj'; intros n hn. destruct (to_Z_bounded (x lxor y)) as [ hxy hxy' ]. destruct (to_Z_bounded x) as [ hx hx' ]. destruct (to_Z_bounded y) as [ hy hy' ]. case (Z_lt_le_dec n (φ digits)); intros hd. 2: { rewrite !Z.bits_above_log2; auto. - apply Z.lxor_nonneg; split; auto. - eapply Z.le_lt_trans. { apply Z.log2_lxor; assumption. } apply Z.max_lub_lt; apply (lt_pow_lt_log φ digits); split; assumption || reflexivity. - apply (lt_pow_lt_log φ digits); split; assumption || reflexivity. } rewrite (is_int n). { rewrite Z.lxor_spec, <- !bitE, lxor_spec; reflexivity. } apply (conj hn). apply (Z.lt_trans _ _ _ hd). apply Zpower2_lt_lin. lia. Qed. Lemma landC i j : i land j = j land i. Proof. apply bit_ext; intros n. rewrite !land_spec, andb_comm; auto. Qed. Lemma landA i j k : i land (j land k) = i land j land k. Proof. apply bit_ext; intros n. rewrite !land_spec, andb_assoc; auto. Qed. Lemma land0 i : 0 land i = 0%uint63. Proof. apply bit_ext; intros n. rewrite land_spec, bit_0; auto. Qed. Lemma land0_r i : i land 0 = 0%uint63. Proof. rewrite landC; exact (land0 i). Qed. Lemma lorC i j : i lor j = j lor i. Proof. apply bit_ext; intros n. rewrite !lor_spec, orb_comm; auto. Qed. Lemma lorA i j k : i lor (j lor k) = i lor j lor k. Proof. apply bit_ext; intros n. rewrite !lor_spec, orb_assoc; auto. Qed. Lemma lor0 i : 0 lor i = i. Proof. apply bit_ext; intros n. rewrite lor_spec, bit_0; auto. Qed. Lemma lor0_r i : i lor 0 = i. Proof. rewrite lorC; exact (lor0 i). Qed. Lemma lxorC i j : i lxor j = j lxor i. Proof. apply bit_ext; intros n. rewrite !lxor_spec, xorb_comm; auto. Qed. Lemma lxorA i j k : i lxor (j lxor k) = i lxor j lxor k. Proof. apply bit_ext; intros n. rewrite !lxor_spec, xorb_assoc; auto. Qed. Lemma lxor0 i : 0 lxor i = i. Proof. apply bit_ext; intros n. rewrite lxor_spec, bit_0, xorb_false_l; auto. Qed. Lemma lxor0_r i : i lxor 0 = i. Proof. rewrite lxorC; exact (lxor0 i). Qed. Lemma opp_to_Z_opp (x : int) : φ x mod wB <> 0 -> (- φ (- x)) mod wB = (φ x) mod wB. Proof. intros neqx0. rewrite opp_spec. rewrite (Z_mod_nz_opp_full (φ x%uint63)) by assumption. rewrite (Z.mod_small (φ x%uint63)) by apply to_Z_bounded. rewrite <- Z.add_opp_l. rewrite Z.opp_add_distr, Z.opp_involutive. replace (- wB) with (-1 * wB) by easy. rewrite Z_mod_plus by easy. now rewrite Z.mod_small by apply to_Z_bounded. Qed. (** Minimum / maximum *) Definition min (i1 i2 : int) := if (i1 <=? i2)%uint63 then i1 else i2. Definition max (i1 i2 : int) := if (i1 <=? i2)%uint63 then i2 else i1. Lemma min_spec (x y : int) : φ (min x y) = Z.min (φ x) (φ y). Proof. unfold min. destruct (lebP x y). - rewrite Z.min_l; [reflexivity | assumption]. - rewrite Z.min_r; [reflexivity | lia]. Qed. Lemma max_spec (x y : int) : φ (max x y) = Z.max (φ x) (φ y). Proof. unfold max. destruct (lebP x y). - rewrite Z.max_r; [reflexivity | assumption]. - rewrite Z.max_l; [reflexivity | lia]. Qed. Lemma min_add_min_n_same (m i1 i2 : int) : to_Z i1 + to_Z i2 < wB -> Uint63.min m (Uint63.min m i1 + i2) = Uint63.min m (i1 + i2). Proof. intros H. apply to_Z_inj. pose proof (to_Z_bounded m) as Hm. pose proof (to_Z_bounded i1) as Hi1. pose proof (to_Z_bounded i2) as Hi2. rewrite !min_spec, !add_spec, !min_spec, !Z.mod_small; lia. Qed. Lemma min_add_n_min_same (m i1 i2 : int) : to_Z i1 + to_Z i2 < wB -> Uint63.min m (i1 + Uint63.min m i2) = Uint63.min m (i1 + i2). Proof. intros H. apply to_Z_inj. pose proof (to_Z_bounded m) as Hm. pose proof (to_Z_bounded i1) as Hi1. pose proof (to_Z_bounded i2) as Hi2. rewrite !min_spec, !add_spec, !min_spec, !Z.mod_small; lia. Qed. Module Export Uint63Notations. Local Open Scope uint63_scope. Export Uint63NotationsInternalB. Export Uint63NotationsInternalC. Export Uint63NotationsInternalD. End Uint63Notations. coq-8.20.0/theories/Numbers/DecimalFacts.v000066400000000000000000000556441466560755400203660ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* nil | D0 u => cons d0 (to_list u) | D1 u => cons d1 (to_list u) | D2 u => cons d2 (to_list u) | D3 u => cons d3 (to_list u) | D4 u => cons d4 (to_list u) | D5 u => cons d5 (to_list u) | D6 u => cons d6 (to_list u) | D7 u => cons d7 (to_list u) | D8 u => cons d8 (to_list u) | D9 u => cons d9 (to_list u) end. Fixpoint of_list (l : list digits) : uint := match l with | nil => Nil | cons d0 l => D0 (of_list l) | cons d1 l => D1 (of_list l) | cons d2 l => D2 (of_list l) | cons d3 l => D3 (of_list l) | cons d4 l => D4 (of_list l) | cons d5 l => D5 (of_list l) | cons d6 l => D6 (of_list l) | cons d7 l => D7 (of_list l) | cons d8 l => D8 (of_list l) | cons d9 l => D9 (of_list l) end. Lemma of_list_to_list u : of_list (to_list u) = u. Proof. now induction u; [|simpl; rewrite IHu..]. Qed. Lemma to_list_of_list l : to_list (of_list l) = l. Proof. now induction l as [|h t IHl]; [|case h; simpl; rewrite IHl]. Qed. Lemma to_list_inj u u' : to_list u = to_list u' -> u = u'. Proof. now intro H; rewrite <-(of_list_to_list u), <-(of_list_to_list u'), H. Qed. Lemma of_list_inj u u' : of_list u = of_list u' -> u = u'. Proof. now intro H; rewrite <-(to_list_of_list u), <-(to_list_of_list u'), H. Qed. Lemma nb_digits_spec u : nb_digits u = length (to_list u). Proof. now induction u; [|simpl; rewrite IHu..]. Qed. Fixpoint lnzhead l := match l with | nil => nil | cons d l' => match d with | d0 => lnzhead l' | _ => l end end. Lemma nzhead_spec u : to_list (nzhead u) = lnzhead (to_list u). Proof. now induction u; [|simpl; rewrite IHu|..]. Qed. Definition lzero := cons d0 nil. Definition lunorm l := match lnzhead l with | nil => lzero | d => d end. Lemma unorm_spec u : to_list (unorm u) = lunorm (to_list u). Proof. now unfold unorm, lunorm; rewrite <-nzhead_spec; case (nzhead u). Qed. Lemma revapp_spec d d' : to_list (revapp d d') = List.rev_append (to_list d) (to_list d'). Proof. now revert d'; induction d; intro d'; [|simpl; rewrite IHd..]. Qed. Lemma rev_spec d : to_list (rev d) = List.rev (to_list d). Proof. now unfold rev; rewrite revapp_spec, List.rev_alt; simpl. Qed. Lemma app_spec d d' : to_list (app d d') = Datatypes.app (to_list d) (to_list d'). Proof. unfold app. now rewrite revapp_spec, List.rev_append_rev, rev_spec, List.rev_involutive. Qed. Definition lnztail l := let fix aux l_rev := match l_rev with | cons d0 l_rev => let (r, n) := aux l_rev in pair r (S n) | _ => pair l_rev O end in let (r, n) := aux (List.rev l) in pair (List.rev r) n. Lemma nztail_spec d : let (r, n) := nztail d in let (r', n') := lnztail (to_list d) in to_list r = r' /\ n = n'. Proof. unfold nztail, lnztail. set (f := fix aux d_rev := match d_rev with | D0 d_rev => let (r, n) := aux d_rev in (r, S n) | _ => (d_rev, 0) end). set (f' := fix aux (l_rev : list digits) : list digits * nat := match l_rev with | cons d0 l_rev => let (r, n) := aux l_rev in (r, S n) | _ => (l_rev, 0) end). rewrite <-(of_list_to_list (rev d)), rev_spec. induction (List.rev _) as [|h t IHl]; [now simpl|]. case h; simpl; [|now rewrite rev_spec; simpl; rewrite to_list_of_list..]. now revert IHl; case f; intros r n; case f'; intros r' n' [-> ->]. Qed. Lemma del_head_spec_0 d : del_head 0 d = d. Proof. now simpl. Qed. Lemma del_head_spec_small n d : n <= length (to_list d) -> to_list (del_head n d) = List.skipn n (to_list d). Proof. revert d; induction n as [|n IHn]; intro d; [now simpl|]. now case d; [|intros d' H; apply IHn, le_S_n..]. Qed. Lemma del_head_spec_large n d : length (to_list d) < n -> del_head n d = zero. Proof. revert d; induction n; intro d; [now case d|]. now case d; [|intro d'; simpl; intro H; rewrite (IHn _ (proj2 (Nat.succ_lt_mono _ _) H))..]. Qed. Lemma nb_digits_0 d : nb_digits d = 0 -> d = Nil. Proof. rewrite nb_digits_spec, <-(of_list_to_list d). now case (to_list d) as [|h t]; [|rewrite to_list_of_list]. Qed. Lemma nb_digits_n0 d : nb_digits d <> 0 -> d <> Nil. Proof. now case d; [|intros u _..]. Qed. Lemma nb_digits_iter_D0 n d : nb_digits (Nat.iter n D0 d) = n + nb_digits d. Proof. now induction n; simpl; [|rewrite IHn]. Qed. Lemma length_lnzhead l : length (lnzhead l) <= length l. Proof. now induction l as [|h t IHl]; [|case h; [apply le_S|..]]. Qed. Lemma nb_digits_nzhead u : nb_digits (nzhead u) <= nb_digits u. Proof. now induction u; [|apply le_S|..]. Qed. Lemma unorm_nzhead u : nzhead u <> Nil -> unorm u = nzhead u. Proof. now unfold unorm; case nzhead. Qed. Lemma nb_digits_unorm u : u <> Nil -> nb_digits (unorm u) <= nb_digits u. Proof. intro Hu; case (uint_eq_dec (nzhead u) Nil). { unfold unorm; intros ->; simpl. now revert Hu; case u; [|intros u' _; apply le_n_S, Nat.le_0_l..]. } intro H; rewrite (unorm_nzhead _ H); apply nb_digits_nzhead. Qed. Lemma nb_digits_rev d : nb_digits (rev d) = nb_digits d. Proof. now rewrite !nb_digits_spec, rev_spec, List.length_rev. Qed. Lemma nb_digits_del_head_sub d n : n <= nb_digits d -> nb_digits (del_head (nb_digits d - n) d) = n. Proof. rewrite !nb_digits_spec; intro Hn. rewrite del_head_spec_small; [|now apply Nat.le_sub_l]. rewrite List.length_skipn, <-(Nat2Z.id (_ - _)). rewrite Nat2Z.inj_sub; [|now apply Nat.le_sub_l]. rewrite (Nat2Z.inj_sub _ _ Hn). rewrite Z.sub_sub_distr, Z.sub_diag; apply Nat2Z.id. Qed. Lemma unorm_D0 u : unorm (D0 u) = unorm u. Proof. reflexivity. Qed. Lemma app_nil_l d : app Nil d = d. Proof. now simpl. Qed. Lemma app_nil_r d : app d Nil = d. Proof. now apply to_list_inj; rewrite app_spec, List.app_nil_r. Qed. Lemma abs_app_int d d' : abs (app_int d d') = app (abs d) d'. Proof. now case d. Qed. Lemma abs_norm d : abs (norm d) = unorm (abs d). Proof. now case d as [u|u]; [|simpl; unfold unorm; case nzhead]. Qed. Lemma iter_D0_nzhead d : Nat.iter (nb_digits d - nb_digits (nzhead d)) D0 (nzhead d) = d. Proof. induction d; [now simpl| |now rewrite Nat.sub_diag..]. simpl nzhead; simpl nb_digits. rewrite (Nat.sub_succ_l _ _ (nb_digits_nzhead _)). now rewrite <-IHd at 4. Qed. Lemma iter_D0_unorm d : d <> Nil -> Nat.iter (nb_digits d - nb_digits (unorm d)) D0 (unorm d) = d. Proof. case (uint_eq_dec (nzhead d) Nil); intro Hn. { unfold unorm; rewrite Hn; simpl; intro H. revert H Hn; induction d; [now simpl|intros _|now intros _..]. case (uint_eq_dec d Nil); simpl; intros H Hn; [now rewrite H|]. rewrite Nat.sub_0_r, <- (Nat.sub_add 1 (nb_digits d)), Nat.add_comm. { now simpl; rewrite IHd. } revert H; case d; [now simpl|intros u _; apply le_n_S, Nat.le_0_l..]. } intros _; rewrite (unorm_nzhead _ Hn); apply iter_D0_nzhead. Qed. Lemma nzhead_app_l d d' : nb_digits d' < nb_digits (nzhead (app d d')) -> nzhead (app d d') = app (nzhead d) d'. Proof. intro Hl; apply to_list_inj; revert Hl. rewrite !nb_digits_spec, app_spec, !nzhead_spec, app_spec. induction (to_list d) as [|h t IHl]. { now simpl; intro H; exfalso; revert H; apply Nat.le_ngt, length_lnzhead. } rewrite <-List.app_comm_cons. now case h; [simpl; intro Hl; apply IHl|..]. Qed. Lemma nzhead_app_r d d' : nb_digits (nzhead (app d d')) <= nb_digits d' -> nzhead (app d d') = nzhead d'. Proof. intro Hl; apply to_list_inj; revert Hl. rewrite !nb_digits_spec, !nzhead_spec, app_spec. induction (to_list d) as [|h t IHl]; [now simpl|]. rewrite <-List.app_comm_cons. now case h; [| simpl; rewrite List.length_app; intro Hl; exfalso; revert Hl; apply Nat.le_ngt, Nat.le_add_l..]. Qed. Lemma nzhead_app_nil_r d d' : nzhead (app d d') = Nil -> nzhead d' = Nil. Proof. now intro H; generalize H; rewrite nzhead_app_r; [|rewrite H; apply Nat.le_0_l]. Qed. Lemma nzhead_app_nil d d' : nb_digits (nzhead (app d d')) <= nb_digits d' -> nzhead d = Nil. Proof. intro H; apply to_list_inj; revert H. rewrite !nb_digits_spec, !nzhead_spec, app_spec. induction (to_list d) as [|h t IHl]; [now simpl|]. now case h; [now simpl|..]; simpl;intro H; exfalso; revert H; apply Nat.le_ngt; rewrite List.length_app; apply Nat.le_add_l. Qed. Lemma nzhead_app_nil_l d d' : nzhead (app d d') = Nil -> nzhead d = Nil. Proof. intro H; apply to_list_inj; generalize (f_equal to_list H); clear H. rewrite !nzhead_spec, app_spec. induction (to_list d) as [|h t IHl]; [now simpl|]. now rewrite <-List.app_comm_cons; case h. Qed. Lemma unorm_app_zero d d' : nb_digits (unorm (app d d')) <= nb_digits d' -> unorm d = zero. Proof. unfold unorm. case (uint_eq_dec (nzhead (app d d')) Nil). { now intro Hn; rewrite Hn, (nzhead_app_nil_l _ _ Hn). } intro H; fold (unorm (app d d')); rewrite (unorm_nzhead _ H); intro H'. case (uint_eq_dec (nzhead d) Nil); [now intros->|]. intro H''; fold (unorm d); rewrite (unorm_nzhead _ H''). exfalso; apply H''; revert H'; apply nzhead_app_nil. Qed. Lemma app_int_nil_r d : app_int d Nil = d. Proof. now case d; intro d'; simpl; rewrite <-(of_list_to_list (app _ _)), app_spec; rewrite List.app_nil_r, of_list_to_list. Qed. Lemma unorm_app_l d d' : nb_digits d' < nb_digits (unorm (app d d')) -> unorm (app d d') = app (unorm d) d'. Proof. case (uint_eq_dec d' Nil); [now intros->; rewrite !app_nil_r|intro Hd']. case (uint_eq_dec (nzhead (app d d')) Nil). { unfold unorm; intros->; simpl; intro H; exfalso; revert H; apply Nat.le_ngt. now revert Hd'; case d'; [|intros d'' _; apply le_n_S, Peano.le_0_n..]. } intro Ha; rewrite (unorm_nzhead _ Ha). intro Hn; generalize Hn; rewrite (nzhead_app_l _ _ Hn). rewrite !nb_digits_spec, app_spec, List.length_app. case (uint_eq_dec (nzhead d) Nil). { intros->; simpl; intro H; exfalso; revert H; apply Nat.lt_irrefl. } now intro H; rewrite (unorm_nzhead _ H). Qed. Lemma unorm_app_r d d' : nb_digits (unorm (app d d')) <= nb_digits d' -> unorm (app d d') = unorm d'. Proof. case (uint_eq_dec (nzhead (app d d')) Nil). { now unfold unorm; intro H; rewrite H, (nzhead_app_nil_r _ _ H). } intro Ha; rewrite (unorm_nzhead _ Ha). case (uint_eq_dec (nzhead d') Nil). { now intros H H'; exfalso; apply Ha; rewrite nzhead_app_r. } intro Hd'; rewrite (unorm_nzhead _ Hd'); apply nzhead_app_r. Qed. Lemma norm_app_int d d' : nb_digits d' < nb_digits (unorm (app (abs d) d')) -> norm (app_int d d') = app_int (norm d) d'. Proof. case (uint_eq_dec d' Nil); [now intros->; rewrite !app_int_nil_r|intro Hd']. case d as [d|d]; [now simpl; intro H; apply f_equal, unorm_app_l|]. simpl; unfold unorm. case (uint_eq_dec (nzhead (app d d')) Nil). { intros->; simpl; intro H; exfalso; revert H; apply Nat.le_ngt. now revert Hd'; case d'; [|intros d'' _; apply le_n_S, Nat.le_0_l..]. } set (m := match nzhead _ with Nil => _ | _ => _ end). intro Ha. replace m with (nzhead (app d d')). 2:{ now unfold m; revert Ha; case nzhead. } intro Hn; generalize Hn; rewrite (nzhead_app_l _ _ Hn). case (uint_eq_dec (app (nzhead d) d') Nil). { intros->; simpl; intro H; exfalso; revert H; apply Nat.le_ngt, Nat.le_0_l. } clear m; set (m := match app _ _ with Nil => _ | _ => _ end). intro Ha'. replace m with (Neg (app (nzhead d) d')); [|now unfold m; revert Ha'; case app]. case (uint_eq_dec (nzhead d) Nil). { intros->; simpl; intro H; exfalso; revert H; apply Nat.lt_irrefl. } clear m; set (m := match nzhead _ with Nil => _ | _ => _ end). intro Hd. now replace m with (Neg (nzhead d)); [|unfold m; revert Hd; case nzhead]. Qed. Lemma del_head_nb_digits d : del_head (nb_digits d) d = Nil. Proof. apply to_list_inj. rewrite nb_digits_spec, del_head_spec_small; [|now simpl]. now rewrite List.skipn_all. Qed. Lemma del_tail_nb_digits d : del_tail (nb_digits d) d = Nil. Proof. now unfold del_tail; rewrite <-nb_digits_rev, del_head_nb_digits. Qed. Lemma del_head_app n d d' : n <= nb_digits d -> del_head n (app d d') = app (del_head n d) d'. Proof. rewrite nb_digits_spec; intro Hn. apply to_list_inj. rewrite del_head_spec_small. 2:{ now rewrite app_spec, List.length_app, <- Nat.le_add_r. } rewrite !app_spec, (del_head_spec_small _ _ Hn). rewrite List.skipn_app. now rewrite (proj2 (Nat.sub_0_le _ _) Hn). Qed. Lemma del_tail_app n d d' : n <= nb_digits d' -> del_tail n (app d d') = app d (del_tail n d'). Proof. rewrite nb_digits_spec; intro Hn. unfold del_tail. rewrite <-(of_list_to_list (rev (app d d'))), rev_spec, app_spec. rewrite List.rev_app_distr, <-!rev_spec, <-app_spec, of_list_to_list. rewrite del_head_app; [|now rewrite nb_digits_spec, rev_spec, List.length_rev]. apply to_list_inj. rewrite rev_spec, !app_spec, !rev_spec. now rewrite List.rev_app_distr, List.rev_involutive. Qed. Lemma del_tail_app_int n d d' : n <= nb_digits d' -> del_tail_int n (app_int d d') = app_int d (del_tail n d'). Proof. now case d as [d|d]; simpl; intro H; rewrite del_tail_app. Qed. Lemma app_del_tail_head n (d:uint) : n <= nb_digits d -> app (del_tail n d) (del_head (nb_digits d - n) d) = d. Proof. rewrite nb_digits_spec; intro Hn; unfold del_tail. rewrite <-(of_list_to_list (app _ _)), app_spec, rev_spec. rewrite del_head_spec_small; [|now rewrite rev_spec, List.length_rev]. rewrite del_head_spec_small; [|now apply Nat.le_sub_l]. rewrite rev_spec. set (n' := _ - n). assert (Hn' : n = length (to_list d) - n'). { now rewrite <- (Nat.add_sub (length (to_list d)) n), Nat.add_comm, <- 2 Nat.add_sub_assoc, Nat.sub_diag; trivial. } now rewrite Hn', <-List.firstn_skipn_rev, List.firstn_skipn, of_list_to_list. Qed. Lemma app_int_del_tail_head n (d:int) : n <= nb_digits (abs d) -> app_int (del_tail_int n d) (del_head (nb_digits (abs d) - n) (abs d)) = d. Proof. now case d; clear d; simpl; intros u Hu; rewrite app_del_tail_head. Qed. Lemma del_head_app_int_exact i f : nb_digits f < nb_digits (unorm (app (abs i) f)) -> del_head (nb_digits (unorm (app (abs i) f)) - nb_digits f) (unorm (app (abs i) f)) = f. Proof. simpl; intro Hnb; generalize Hnb; rewrite (unorm_app_l _ _ Hnb); clear Hnb. replace (_ - _) with (nb_digits (unorm (abs i))). - now rewrite del_head_app; [rewrite del_head_nb_digits|]. - rewrite !nb_digits_spec, app_spec, List.length_app. symmetry; apply Nat.add_sub. Qed. Lemma del_tail_app_int_exact i f : nb_digits f < nb_digits (unorm (app (abs i) f)) -> del_tail_int (nb_digits f) (norm (app_int i f)) = norm i. Proof. simpl; intro Hnb. rewrite (norm_app_int _ _ Hnb). rewrite del_tail_app_int; [|now simpl]. now rewrite del_tail_nb_digits, app_int_nil_r. Qed. (** Normalization on little-endian numbers *) Fixpoint nztail d := match d with | Nil => Nil | D0 d => match nztail d with Nil => Nil | d' => D0 d' end | D1 d => D1 (nztail d) | D2 d => D2 (nztail d) | D3 d => D3 (nztail d) | D4 d => D4 (nztail d) | D5 d => D5 (nztail d) | D6 d => D6 (nztail d) | D7 d => D7 (nztail d) | D8 d => D8 (nztail d) | D9 d => D9 (nztail d) end. Definition lnorm d := match nztail d with | Nil => zero | d => d end. Lemma nzhead_revapp_0 d d' : nztail d = Nil -> nzhead (revapp d d') = nzhead d'. Proof. revert d'. induction d; intros d' [=]; simpl; trivial. destruct (nztail d); now rewrite IHd. Qed. Lemma nzhead_revapp d d' : nztail d <> Nil -> nzhead (revapp d d') = revapp (nztail d) d'. Proof. revert d'. induction d; intros d' H; simpl in *; try destruct (nztail d) eqn:E; (now rewrite ?nzhead_revapp_0) || (now rewrite IHd). Qed. Lemma nzhead_rev d : nztail d <> Nil -> nzhead (rev d) = rev (nztail d). Proof. apply nzhead_revapp. Qed. Lemma rev_rev d : rev (rev d) = d. Proof. now apply to_list_inj; rewrite !rev_spec, List.rev_involutive. Qed. Lemma rev_nztail_rev d : rev (nztail (rev d)) = nzhead d. Proof. destruct (uint_eq_dec (nztail (rev d)) Nil) as [H|H]. - rewrite H. unfold rev; simpl. rewrite <- (rev_rev d). symmetry. now apply nzhead_revapp_0. - now rewrite <- nzhead_rev, rev_rev. Qed. Lemma nzhead_D0 u : nzhead (D0 u) = nzhead u. Proof. reflexivity. Qed. Lemma nzhead_iter_D0 n u : nzhead (Nat.iter n D0 u) = nzhead u. Proof. now induction n. Qed. Lemma revapp_nil_inv d d' : revapp d d' = Nil -> d = Nil /\ d' = Nil. Proof. revert d'. induction d; simpl; intros d' H; auto; now apply IHd in H. Qed. Lemma rev_nil_inv d : rev d = Nil -> d = Nil. Proof. apply revapp_nil_inv. Qed. Lemma rev_lnorm_rev d : rev (lnorm (rev d)) = unorm d. Proof. unfold unorm, lnorm. rewrite <- rev_nztail_rev. destruct nztail; simpl; trivial; destruct rev eqn:E; trivial; now apply rev_nil_inv in E. Qed. Lemma nzhead_nonzero d d' : nzhead d <> D0 d'. Proof. induction d; easy. Qed. Lemma unorm_0 d : unorm d = zero <-> nzhead d = Nil. Proof. unfold unorm. split. - generalize (nzhead_nonzero d). destruct nzhead; intros H [=]; trivial. now destruct (H u). - now intros ->. Qed. Lemma unorm_nonnil d : unorm d <> Nil. Proof. unfold unorm. now destruct nzhead. Qed. Lemma unorm_iter_D0 n u : unorm (Nat.iter n D0 u) = unorm u. Proof. now induction n. Qed. Lemma del_head_nonnil n u : n < nb_digits u -> del_head n u <> Nil. Proof. now revert n; induction u; intro n; [|case n; [|intro n'; simpl; intro H; apply IHu, Nat.succ_lt_mono]..]. Qed. Lemma del_tail_nonnil n u : n < nb_digits u -> del_tail n u <> Nil. Proof. unfold del_tail. rewrite <-nb_digits_rev. generalize (rev u); clear u; intro u. intros Hu H. generalize (rev_nil_inv _ H); clear H. now apply del_head_nonnil. Qed. Lemma nzhead_involutive d : nzhead (nzhead d) = nzhead d. Proof. now induction d. Qed. Lemma nztail_involutive d : nztail (nztail d) = nztail d. Proof. rewrite <-(rev_rev (nztail _)), <-(rev_rev (nztail d)), <-(rev_rev d). now rewrite !rev_nztail_rev, nzhead_involutive. Qed. Lemma unorm_involutive d : unorm (unorm d) = unorm d. Proof. unfold unorm. destruct (nzhead d) eqn:E; trivial. destruct (nzhead_nonzero _ _ E). Qed. Lemma norm_involutive d : norm (norm d) = norm d. Proof. unfold norm. destruct d. - f_equal. apply unorm_involutive. - destruct (nzhead d) eqn:E; auto. destruct (nzhead_nonzero _ _ E). Qed. Lemma lnzhead_neq_d0_head l l' : ~(lnzhead l = cons d0 l'). Proof. now induction l as [|h t Il]; [|case h]. Qed. Lemma lnzhead_head_nd0 h t : h <> d0 -> lnzhead (cons h t) = cons h t. Proof. now case h. Qed. Lemma nzhead_del_tail_nzhead_eq n u : nzhead u = u -> n < nb_digits u -> nzhead (del_tail n u) = del_tail n u. Proof. rewrite nb_digits_spec, <-List.length_rev. intros Hu Hn. apply to_list_inj; unfold del_tail. rewrite nzhead_spec, rev_spec. rewrite del_head_spec_small; [|now rewrite rev_spec; apply Nat.lt_le_incl]. rewrite rev_spec. rewrite List.skipn_rev, List.rev_involutive. generalize (f_equal to_list Hu) Hn; rewrite nzhead_spec; intro Hu'. case (to_list u) as [|h t]. { simpl; intro H; exfalso; revert H; apply Nat.le_ngt, Nat.le_0_l. } intro Hn'; generalize (Nat.sub_gt _ _ Hn'); rewrite List.length_rev. case (_ - _); [now simpl|]; intros n' _. rewrite List.firstn_cons, lnzhead_head_nd0; [now simpl|]. intro Hh; revert Hu'; rewrite Hh; apply lnzhead_neq_d0_head. Qed. Lemma nzhead_del_tail_nzhead n u : n < nb_digits (nzhead u) -> nzhead (del_tail n (nzhead u)) = del_tail n (nzhead u). Proof. apply nzhead_del_tail_nzhead_eq, nzhead_involutive. Qed. Lemma unorm_del_tail_unorm n u : n < nb_digits (unorm u) -> unorm (del_tail n (unorm u)) = del_tail n (unorm u). Proof. case (uint_eq_dec (nzhead u) Nil). - unfold unorm; intros->; case n; [now simpl|]; intro n'. now simpl; intro H; exfalso; generalize (proj2 (Nat.succ_lt_mono _ _) H). - unfold unorm. set (m := match nzhead u with Nil => zero | _ => _ end). intros H. replace m with (nzhead u). + intros H'. rewrite (nzhead_del_tail_nzhead _ _ H'). now generalize (del_tail_nonnil _ _ H'); case del_tail. + now unfold m; revert H; case nzhead. Qed. Lemma norm_del_tail_int_norm n d : n < nb_digits (match norm d with Pos d | Neg d => d end) -> norm (del_tail_int n (norm d)) = del_tail_int n (norm d). Proof. case d; clear d; intros u; simpl. - now intro H; simpl; rewrite unorm_del_tail_unorm. - case (uint_eq_dec (nzhead u) Nil); intro Hu. + now rewrite Hu; case n; [|intros n' Hn'; generalize (proj2 (Nat.succ_lt_mono _ _) Hn')]. + set (m := match nzhead u with Nil => Pos zero | _ => _ end). replace m with (Neg (nzhead u)); [|now unfold m; revert Hu; case nzhead]. unfold del_tail_int. clear m Hu. simpl. intro H; generalize (del_tail_nonnil _ _ H). rewrite (nzhead_del_tail_nzhead _ _ H). now case del_tail. Qed. Lemma nzhead_app_nzhead d d' : nzhead (app (nzhead d) d') = nzhead (app d d'). Proof. unfold app. rewrite <-(rev_nztail_rev d), rev_rev. generalize (rev d); clear d; intro d. generalize (nzhead_revapp_0 d d'). generalize (nzhead_revapp d d'). generalize (nzhead_revapp_0 (nztail d) d'). generalize (nzhead_revapp (nztail d) d'). rewrite nztail_involutive. now case nztail; [intros _ H _ H'; rewrite (H eq_refl), (H' eq_refl) |intros d'' H _ H' _; rewrite H; [rewrite H'|]..]. Qed. Lemma unorm_app_unorm d d' : unorm (app (unorm d) d') = unorm (app d d'). Proof. unfold unorm. rewrite <-(nzhead_app_nzhead d d'). now case (nzhead d). Qed. Lemma norm_app_int_norm d d' : unorm d' = zero -> norm (app_int (norm d) d') = norm (app_int d d'). Proof. case d; clear d; intro d; simpl. - now rewrite unorm_app_unorm. - unfold app_int, app. rewrite unorm_0; intro Hd'. rewrite <-rev_nztail_rev. generalize (nzhead_revapp (rev d) d'). generalize (nzhead_revapp_0 (rev d) d'). now case_eq (nztail (rev d)); [intros Hd'' H _; rewrite (H eq_refl); simpl; unfold unorm; simpl; rewrite Hd' |intros d'' Hd'' _ H; rewrite H; clear H; [|now simpl]; set (r := rev _); set (m := match r with Nil => Pos zero | _ => _ end); assert (H' : m = Neg r); [now unfold m; case_eq r; unfold r; [intro H''; generalize (rev_nil_inv _ H'')|..] |rewrite H'; unfold r; clear m r H']; unfold norm; rewrite rev_rev, <-Hd''; rewrite nzhead_revapp; rewrite nztail_involutive; [|rewrite Hd'']..]. Qed. Lemma unorm_app_l_nil d d' : nzhead d = Nil -> unorm (app d d') = unorm d'. Proof. now unfold unorm; rewrite <-nzhead_app_nzhead; intros->; rewrite app_nil_l. Qed. coq-8.20.0/theories/Numbers/DecimalN.v000066400000000000000000000057131466560755400175130ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* n = n'. Proof. intros E. now rewrite <- (of_to n), <- (of_to n'), E. Qed. Lemma to_uint_surj d : exists p, N.to_uint p = unorm d. Proof. exists (N.of_uint d). apply to_of. Qed. Lemma of_uint_norm d : N.of_uint (unorm d) = N.of_uint d. Proof. now induction d. Qed. Lemma of_inj d d' : N.of_uint d = N.of_uint d' -> unorm d = unorm d'. Proof. intros. rewrite <- !to_of. now f_equal. Qed. Lemma of_iff d d' : N.of_uint d = N.of_uint d' <-> unorm d = unorm d'. Proof. split. - apply of_inj. - intros E. rewrite <- of_uint_norm, E. apply of_uint_norm. Qed. End Unsigned. (** Conversion from/to signed decimal numbers *) Module Signed. Lemma of_to (n:N) : N.of_int (N.to_int n) = Some n. Proof. unfold N.to_int, N.of_int, norm. f_equal. rewrite Unsigned.of_uint_norm. apply Unsigned.of_to. Qed. Lemma to_of (d:int)(n:N) : N.of_int d = Some n -> N.to_int n = norm d. Proof. unfold N.of_int. destruct (norm d) eqn:Hd; intros [= <-]. unfold N.to_int. rewrite Unsigned.to_of. f_equal. revert Hd; destruct d; simpl. - intros [= <-]. apply unorm_involutive. - destruct (nzhead d); now intros [= <-]. Qed. Lemma to_int_inj n n' : N.to_int n = N.to_int n' -> n = n'. Proof. intro E. assert (E' : Some n = Some n'). { now rewrite <- (of_to n), <- (of_to n'), E. } now injection E'. Qed. Lemma to_int_pos_surj d : exists n, N.to_int n = norm (Pos d). Proof. exists (N.of_uint d). unfold N.to_int. now rewrite Unsigned.to_of. Qed. Lemma of_int_norm d : N.of_int (norm d) = N.of_int d. Proof. unfold N.of_int. now rewrite norm_involutive. Qed. Lemma of_inj_pos d d' : N.of_int (Pos d) = N.of_int (Pos d') -> unorm d = unorm d'. Proof. unfold N.of_int. simpl. intros [= H]. apply Unsigned.of_inj. change Pos.of_uint with N.of_uint in H. now rewrite <- Unsigned.of_uint_norm, H, Unsigned.of_uint_norm. Qed. End Signed. coq-8.20.0/theories/Numbers/DecimalNat.v000066400000000000000000000166731466560755400200470ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* 0 | D0 _ => 0 | D1 _ => 1 | D2 _ => 2 | D3 _ => 3 | D4 _ => 4 | D5 _ => 5 | D6 _ => 6 | D7 _ => 7 | D8 _ => 8 | D9 _ => 9 end. Definition tl d := match d with | Nil => d | D0 d | D1 d | D2 d | D3 d | D4 d | D5 d | D6 d | D7 d | D8 d | D9 d => d end. Fixpoint usize (d:uint) : nat := match d with | Nil => 0 | D0 d => S (usize d) | D1 d => S (usize d) | D2 d => S (usize d) | D3 d => S (usize d) | D4 d => S (usize d) | D5 d => S (usize d) | D6 d => S (usize d) | D7 d => S (usize d) | D8 d => S (usize d) | D9 d => S (usize d) end. (** A direct version of [to_little_uint], not tail-recursive *) Fixpoint to_lu n := match n with | 0 => Decimal.zero | S n => Little.succ (to_lu n) end. (** A direct version of [of_little_uint] *) Fixpoint of_lu (d:uint) : nat := match d with | Nil => 0 | D0 d => 10 * of_lu d | D1 d => 1 + 10 * of_lu d | D2 d => 2 + 10 * of_lu d | D3 d => 3 + 10 * of_lu d | D4 d => 4 + 10 * of_lu d | D5 d => 5 + 10 * of_lu d | D6 d => 6 + 10 * of_lu d | D7 d => 7 + 10 * of_lu d | D8 d => 8 + 10 * of_lu d | D9 d => 9 + 10 * of_lu d end. (** Properties of [to_lu] *) Lemma to_lu_succ n : to_lu (S n) = Little.succ (to_lu n). Proof. reflexivity. Qed. Lemma to_little_uint_succ n d : Nat.to_little_uint n (Little.succ d) = Little.succ (Nat.to_little_uint n d). Proof. revert d; induction n; simpl; trivial. Qed. Lemma to_lu_equiv n : to_lu n = Nat.to_little_uint n zero. Proof. induction n; simpl; trivial. now rewrite IHn, <- to_little_uint_succ. Qed. Lemma to_uint_alt n : Nat.to_uint n = rev (to_lu n). Proof. unfold Nat.to_uint. f_equal. symmetry. apply to_lu_equiv. Qed. (** Properties of [of_lu] *) Lemma of_lu_eqn d : of_lu d = hd d + 10 * of_lu (tl d). Proof. induction d; simpl; trivial. Qed. Ltac simpl_of_lu := match goal with | |- context [ of_lu (?f ?x) ] => rewrite (of_lu_eqn (f x)); simpl hd; simpl tl end. Lemma of_lu_succ d : of_lu (Little.succ d) = S (of_lu d). Proof. induction d; trivial. simpl_of_lu. rewrite IHd. simpl_of_lu. now rewrite Nat.mul_succ_r, <- (Nat.add_comm 10). Qed. Lemma of_to_lu n : of_lu (to_lu n) = n. Proof. induction n; simpl; trivial. rewrite of_lu_succ. now f_equal. Qed. Lemma of_lu_revapp d d' : of_lu (revapp d d') = of_lu (rev d) + of_lu d' * 10^usize d. Proof. revert d'. induction d; intro d'; simpl usize; [ simpl; now rewrite Nat.mul_1_r | .. ]; unfold rev; simpl revapp; rewrite 2 IHd; rewrite <- Nat.add_assoc; f_equal; simpl_of_lu; simpl of_lu; rewrite Nat.pow_succ_r'; ring. Qed. Lemma of_uint_acc_spec n d : Nat.of_uint_acc d n = of_lu (rev d) + n * 10^usize d. Proof. revert n. induction d; intros; simpl Nat.of_uint_acc; rewrite ?Nat.tail_mul_spec, ?IHd; simpl rev; simpl usize; rewrite ?Nat.pow_succ_r'; [ simpl; now rewrite Nat.mul_1_r | .. ]; unfold rev at 2; simpl revapp; rewrite of_lu_revapp; simpl of_lu; ring. Qed. Lemma of_uint_alt d : Nat.of_uint d = of_lu (rev d). Proof. unfold Nat.of_uint. now rewrite of_uint_acc_spec. Qed. (** First main bijection result *) Lemma of_to (n:nat) : Nat.of_uint (Nat.to_uint n) = n. Proof. rewrite to_uint_alt, of_uint_alt, rev_rev. apply of_to_lu. Qed. (** The other direction *) Lemma to_lu_tenfold n : n<>0 -> to_lu (10 * n) = D0 (to_lu n). Proof. induction n. - simpl. now destruct 1. - intros _. destruct (Nat.eq_dec n 0) as [->|H]; simpl; trivial. rewrite !Nat.add_succ_r. simpl in *. rewrite (IHn H). now destruct (to_lu n). Qed. Lemma of_lu_0 d : of_lu d = 0 <-> nztail d = Nil. Proof. induction d; try simpl_of_lu; try easy. rewrite Nat.add_0_l. split; intros H. - apply Nat.eq_mul_0_r in H; auto. rewrite IHd in H. simpl. now rewrite H. - simpl in H. destruct (nztail d); try discriminate. now destruct IHd as [_ ->]. Qed. Lemma to_of_lu_tenfold d : to_lu (of_lu d) = lnorm d -> to_lu (10 * of_lu d) = lnorm (D0 d). Proof. intro IH. destruct (Nat.eq_dec (of_lu d) 0) as [H|H]. - rewrite H. simpl. rewrite of_lu_0 in H. unfold lnorm. simpl. now rewrite H. - rewrite (to_lu_tenfold _ H), IH. rewrite of_lu_0 in H. unfold lnorm. simpl. now destruct (nztail d). Qed. Lemma to_of_lu d : to_lu (of_lu d) = lnorm d. Proof. induction d; [ reflexivity | .. ]; simpl_of_lu; rewrite ?Nat.add_succ_l, Nat.add_0_l, ?to_lu_succ, to_of_lu_tenfold by assumption; unfold lnorm; simpl; now destruct nztail. Qed. (** Second bijection result *) Lemma to_of (d:uint) : Nat.to_uint (Nat.of_uint d) = unorm d. Proof. rewrite to_uint_alt, of_uint_alt, to_of_lu. apply rev_lnorm_rev. Qed. (** Some consequences *) Lemma to_uint_inj n n' : Nat.to_uint n = Nat.to_uint n' -> n = n'. Proof. intro EQ. now rewrite <- (of_to n), <- (of_to n'), EQ. Qed. Lemma to_uint_surj d : exists n, Nat.to_uint n = unorm d. Proof. exists (Nat.of_uint d). apply to_of. Qed. Lemma of_uint_norm d : Nat.of_uint (unorm d) = Nat.of_uint d. Proof. unfold Nat.of_uint. now induction d. Qed. Lemma of_inj d d' : Nat.of_uint d = Nat.of_uint d' -> unorm d = unorm d'. Proof. intros. rewrite <- !to_of. now f_equal. Qed. Lemma of_iff d d' : Nat.of_uint d = Nat.of_uint d' <-> unorm d = unorm d'. Proof. split. - apply of_inj. - intros E. rewrite <- of_uint_norm, E. apply of_uint_norm. Qed. End Unsigned. (** Conversion from/to signed decimal numbers *) Module Signed. Lemma of_to (n:nat) : Nat.of_int (Nat.to_int n) = Some n. Proof. unfold Nat.to_int, Nat.of_int, norm. f_equal. rewrite Unsigned.of_uint_norm. apply Unsigned.of_to. Qed. Lemma to_of (d:int)(n:nat) : Nat.of_int d = Some n -> Nat.to_int n = norm d. Proof. unfold Nat.of_int. destruct (norm d) eqn:Hd; intros [= <-]. unfold Nat.to_int. rewrite Unsigned.to_of. f_equal. revert Hd; destruct d; simpl. - intros [= <-]. apply unorm_involutive. - destruct (nzhead d); now intros [= <-]. Qed. Lemma to_int_inj n n' : Nat.to_int n = Nat.to_int n' -> n = n'. Proof. intro E. assert (E' : Some n = Some n'). { now rewrite <- (of_to n), <- (of_to n'), E. } now injection E'. Qed. Lemma to_int_pos_surj d : exists n, Nat.to_int n = norm (Pos d). Proof. exists (Nat.of_uint d). unfold Nat.to_int. now rewrite Unsigned.to_of. Qed. Lemma of_int_norm d : Nat.of_int (norm d) = Nat.of_int d. Proof. unfold Nat.of_int. now rewrite norm_involutive. Qed. Lemma of_inj_pos d d' : Nat.of_int (Pos d) = Nat.of_int (Pos d') -> unorm d = unorm d'. Proof. unfold Nat.of_int. simpl. intros [= H]. apply Unsigned.of_inj. now rewrite <- Unsigned.of_uint_norm, H, Unsigned.of_uint_norm. Qed. End Signed. coq-8.20.0/theories/Numbers/DecimalPos.v000066400000000000000000000243031466560755400200530ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* 0 | D0 d => 10 * of_lu d | D1 d => 1 + 10 * of_lu d | D2 d => 2 + 10 * of_lu d | D3 d => 3 + 10 * of_lu d | D4 d => 4 + 10 * of_lu d | D5 d => 5 + 10 * of_lu d | D6 d => 6 + 10 * of_lu d | D7 d => 7 + 10 * of_lu d | D8 d => 8 + 10 * of_lu d | D9 d => 9 + 10 * of_lu d end. Definition hd d := match d with | Nil => 0 | D0 _ => 0 | D1 _ => 1 | D2 _ => 2 | D3 _ => 3 | D4 _ => 4 | D5 _ => 5 | D6 _ => 6 | D7 _ => 7 | D8 _ => 8 | D9 _ => 9 end. Definition tl d := match d with | Nil => d | D0 d | D1 d | D2 d | D3 d | D4 d | D5 d | D6 d | D7 d | D8 d | D9 d => d end. Lemma of_lu_eqn d : of_lu d = hd d + 10 * (of_lu (tl d)). Proof. induction d; simpl; trivial. Qed. Ltac simpl_of_lu := match goal with | |- context [ of_lu (?f ?x) ] => rewrite (of_lu_eqn (f x)); simpl hd; simpl tl end. Fixpoint usize (d:uint) : N := match d with | Nil => 0 | D0 d => N.succ (usize d) | D1 d => N.succ (usize d) | D2 d => N.succ (usize d) | D3 d => N.succ (usize d) | D4 d => N.succ (usize d) | D5 d => N.succ (usize d) | D6 d => N.succ (usize d) | D7 d => N.succ (usize d) | D8 d => N.succ (usize d) | D9 d => N.succ (usize d) end. Lemma of_lu_revapp d d' : of_lu (revapp d d') = of_lu (rev d) + of_lu d' * 10^usize d. Proof. revert d'. induction d; simpl; intro d'; [ now rewrite N.mul_1_r | .. ]; unfold rev; simpl revapp; rewrite 2 IHd; rewrite <- N.add_assoc; f_equal; simpl_of_lu; simpl of_lu; rewrite N.pow_succ_r'; ring. Qed. Definition Nadd n p := match n with | N0 => p | Npos p0 => (p0+p)%positive end. Lemma Nadd_simpl n p q : Npos (Nadd n (p * q)) = n + Npos p * Npos q. Proof. now destruct n. Qed. Lemma of_uint_acc_eqn d acc : d<>Nil -> Pos.of_uint_acc d acc = Pos.of_uint_acc (tl d) (Nadd (hd d) (10*acc)). Proof. destruct d; simpl; trivial. now destruct 1. Qed. Lemma of_uint_acc_rev d acc : Npos (Pos.of_uint_acc d acc) = of_lu (rev d) + (Npos acc) * 10^usize d. Proof. revert acc. induction d; intros; simpl usize; [ simpl; now rewrite Pos.mul_1_r | .. ]; rewrite N.pow_succ_r'; unfold rev; simpl revapp; try rewrite of_lu_revapp; simpl of_lu; rewrite of_uint_acc_eqn by easy; simpl tl; simpl hd; rewrite IHd, Nadd_simpl; ring. Qed. Lemma of_uint_alt d : Pos.of_uint d = of_lu (rev d). Proof. induction d; simpl; trivial; unfold rev; simpl revapp; rewrite of_lu_revapp; simpl of_lu; try apply of_uint_acc_rev. rewrite IHd. ring. Qed. Lemma of_lu_rev d : Pos.of_uint (rev d) = of_lu d. Proof. rewrite of_uint_alt. now rewrite rev_rev. Qed. Lemma of_lu_double_gen d : of_lu (Little.double d) = N.double (of_lu d) /\ of_lu (Little.succ_double d) = N.succ_double (of_lu d). Proof. rewrite N.double_spec, N.succ_double_spec. induction d; try destruct IHd as (IH1,IH2); simpl Little.double; simpl Little.succ_double; repeat (simpl_of_lu; rewrite ?IH1, ?IH2); split; reflexivity || ring. Qed. Lemma of_lu_double d : of_lu (Little.double d) = N.double (of_lu d). Proof. apply of_lu_double_gen. Qed. Lemma of_lu_succ_double d : of_lu (Little.succ_double d) = N.succ_double (of_lu d). Proof. apply of_lu_double_gen. Qed. (** First bijection result *) Lemma of_to (p:positive) : Pos.of_uint (Pos.to_uint p) = Npos p. Proof. unfold Pos.to_uint. rewrite of_lu_rev. induction p; simpl; trivial. - now rewrite of_lu_succ_double, IHp. - now rewrite of_lu_double, IHp. Qed. (** The other direction *) Definition to_lu n := match n with | N0 => Decimal.zero | Npos p => Pos.to_little_uint p end. Lemma succ_double_alt d : Little.succ_double d = Little.succ (Little.double d). Proof. now induction d. Qed. Lemma double_succ d : Little.double (Little.succ d) = Little.succ (Little.succ_double d). Proof. induction d; simpl; f_equal; auto using succ_double_alt. Qed. Lemma to_lu_succ n : to_lu (N.succ n) = Little.succ (to_lu n). Proof. destruct n; simpl; trivial. induction p; simpl; rewrite ?IHp; auto using succ_double_alt, double_succ. Qed. Lemma nat_iter_S n {A} (f:A->A) i : Nat.iter (S n) f i = f (Nat.iter n f i). Proof. reflexivity. Qed. Lemma nat_iter_0 {A} (f:A->A) i : Nat.iter 0 f i = i. Proof. reflexivity. Qed. Lemma to_ldec_tenfold p : to_lu (10 * Npos p) = D0 (to_lu (Npos p)). Proof. induction p using Pos.peano_rect. - trivial. - change (N.pos (Pos.succ p)) with (N.succ (N.pos p)). rewrite N.mul_succ_r. change 10 with (Nat.iter 10%nat N.succ 0) at 2. rewrite ?nat_iter_S, nat_iter_0. rewrite !N.add_succ_r, N.add_0_r, !to_lu_succ, IHp. destruct (to_lu (N.pos p)); simpl; auto. Qed. Lemma of_lu_0 d : of_lu d = 0 <-> nztail d = Nil. Proof. induction d; try simpl_of_lu; split; trivial; try discriminate; try (intros H; now apply N.eq_add_0 in H). - rewrite N.add_0_l. intros H. apply N.eq_mul_0_r in H; [|easy]. rewrite IHd in H. simpl. now rewrite H. - simpl. destruct (nztail d); try discriminate. now destruct IHd as [_ ->]. Qed. Lemma to_of_lu_tenfold d : to_lu (of_lu d) = lnorm d -> to_lu (10 * of_lu d) = lnorm (D0 d). Proof. intro IH. destruct (N.eq_dec (of_lu d) 0) as [H|H]. - rewrite H. simpl. rewrite of_lu_0 in H. unfold lnorm. simpl. now rewrite H. - destruct (of_lu d) eqn:Eq; [easy| ]. rewrite to_ldec_tenfold; auto. rewrite IH. rewrite <- Eq in H. rewrite of_lu_0 in H. unfold lnorm. simpl. now destruct (nztail d). Qed. Lemma Nadd_alt n m : n + m = Nat.iter (N.to_nat n) N.succ m. Proof. destruct n. 1:trivial. induction p using Pos.peano_rect. - now rewrite N.add_1_l. - change (N.pos (Pos.succ p)) with (N.succ (N.pos p)). now rewrite N.add_succ_l, IHp, N2Nat.inj_succ. Qed. Ltac simpl_to_nat := simpl N.to_nat; unfold Pos.to_nat; simpl Pos.iter_op. Lemma to_of_lu d : to_lu (of_lu d) = lnorm d. Proof. induction d; [reflexivity|..]; simpl_of_lu; rewrite Nadd_alt; simpl_to_nat; rewrite ?nat_iter_S, nat_iter_0, ?to_lu_succ, to_of_lu_tenfold by assumption; unfold lnorm; simpl; destruct nztail; auto. Qed. (** Second bijection result *) Lemma to_of (d:uint) : N.to_uint (Pos.of_uint d) = unorm d. Proof. rewrite of_uint_alt. unfold N.to_uint, Pos.to_uint. destruct (of_lu (rev d)) eqn:H. - rewrite of_lu_0 in H. rewrite <- rev_lnorm_rev. unfold lnorm. now rewrite H. - change (Pos.to_little_uint p) with (to_lu (N.pos p)). rewrite <- H. rewrite to_of_lu. apply rev_lnorm_rev. Qed. (** Some consequences *) Lemma to_uint_nonzero p : Pos.to_uint p <> zero. Proof. intro E. generalize (of_to p). now rewrite E. Qed. Lemma to_uint_nonnil p : Pos.to_uint p <> Nil. Proof. intros E. generalize (of_to p). now rewrite E. Qed. Lemma to_uint_inj p p' : Pos.to_uint p = Pos.to_uint p' -> p = p'. Proof. intro E. assert (E' : N.pos p = N.pos p'). { now rewrite <- (of_to p), <- (of_to p'), E. } now injection E'. Qed. Lemma to_uint_pos_surj d : unorm d<>zero -> exists p, Pos.to_uint p = unorm d. Proof. intros. destruct (Pos.of_uint d) eqn:E. - destruct H. generalize (to_of d). now rewrite E. - exists p. generalize (to_of d). now rewrite E. Qed. Lemma of_uint_norm d : Pos.of_uint (unorm d) = Pos.of_uint d. Proof. now induction d. Qed. Lemma of_inj d d' : Pos.of_uint d = Pos.of_uint d' -> unorm d = unorm d'. Proof. intros. rewrite <- !to_of. now f_equal. Qed. Lemma of_iff d d' : Pos.of_uint d = Pos.of_uint d' <-> unorm d = unorm d'. Proof. split. - apply of_inj. - intros E. rewrite <- of_uint_norm, E. apply of_uint_norm. Qed. Lemma nztail_to_uint p : let (h, n) := Decimal.nztail (Pos.to_uint p) in Npos p = Pos.of_uint h * 10^(N.of_nat n). Proof. rewrite <-(of_to p), <-(rev_rev (Pos.to_uint p)), of_lu_rev. unfold Decimal.nztail. rewrite rev_rev. induction (rev (Pos.to_uint p)); [reflexivity| | now simpl N.of_nat; simpl N.pow; rewrite N.mul_1_r, of_lu_rev..]. revert IHu. set (t := _ u); case t; clear t; intros u0 n H. rewrite of_lu_eqn; unfold hd, tl. rewrite N.add_0_l, H, Nat2N.inj_succ, N.pow_succ_r'; ring. Qed. End Unsigned. (** Conversion from/to signed decimal numbers *) Module Signed. Lemma of_to (p:positive) : Pos.of_int (Pos.to_int p) = Some p. Proof. unfold Pos.to_int, Pos.of_int, norm. now rewrite Unsigned.of_to. Qed. Lemma to_of (d:int)(p:positive) : Pos.of_int d = Some p -> Pos.to_int p = norm d. Proof. unfold Pos.of_int. destruct d; [ | intros [=]]. simpl norm. rewrite <- Unsigned.to_of. destruct (Pos.of_uint d); now intros [= <-]. Qed. Lemma to_int_inj p p' : Pos.to_int p = Pos.to_int p' -> p = p'. Proof. intro E. assert (E' : Some p = Some p'). { now rewrite <- (of_to p), <- (of_to p'), E. } now injection E'. Qed. Lemma to_int_pos_surj d : unorm d <> zero -> exists p, Pos.to_int p = norm (Pos d). Proof. simpl. unfold Pos.to_int. intros H. destruct (Unsigned.to_uint_pos_surj d H) as (p,Hp). exists p. now f_equal. Qed. Lemma of_int_norm d : Pos.of_int (norm d) = Pos.of_int d. Proof. unfold Pos.of_int. destruct d. - simpl. now rewrite Unsigned.of_uint_norm. - simpl. now destruct (nzhead d) eqn:H. Qed. Lemma of_inj_pos d d' : Pos.of_int (Pos d) = Pos.of_int (Pos d') -> unorm d = unorm d'. Proof. unfold Pos.of_int. destruct (Pos.of_uint d) eqn:Hd, (Pos.of_uint d') eqn:Hd'; intros [=]. - apply Unsigned.of_inj; now rewrite Hd, Hd'. - apply Unsigned.of_inj; rewrite Hd, Hd'; now f_equal. Qed. End Signed. coq-8.20.0/theories/Numbers/DecimalQ.v000066400000000000000000000446071466560755400175230ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* True | Some (DecimalExp _ _ _) => False | Some (Decimal i f) => of_decimal (Decimal i f) = IQmake (IZ_of_Z num) den end. Proof. unfold IQmake_to_decimal. generalize (Unsigned.nztail_to_uint den). case Decimal.nztail; intros den' e_den'. case den'; [now simpl|now simpl| |now simpl..]; clear den'; intro den'. case den'; [ |now simpl..]; clear den'. case e_den' as [|e_den']; simpl; injection 1 as ->. { now unfold of_decimal; simpl; rewrite app_int_nil_r, DecimalZ.of_to. } replace (10 ^ _)%positive with (Nat.iter (S e_den') (Pos.mul 10) 1%positive). 2:{ induction e_den' as [|n IHn]; [now simpl| ]. now rewrite SuccNat2Pos.inj_succ, Pos.pow_succ_r, <-IHn. } case Nat.ltb_spec; intro He_den'. - unfold of_decimal; simpl. rewrite app_int_del_tail_head; [|now apply Nat.lt_le_incl]. rewrite DecimalZ.of_to. now rewrite nb_digits_del_head_sub; [|now apply Nat.lt_le_incl]. - unfold of_decimal; simpl. rewrite nb_digits_iter_D0. apply f_equal2. + apply f_equal, DecimalZ.to_int_inj. rewrite DecimalZ.to_of. rewrite <-(DecimalZ.of_to num), DecimalZ.to_of. case (Z.to_int num); clear He_den' num; intro num; simpl. * unfold app; simpl. now rewrite unorm_D0, unorm_iter_D0, unorm_involutive. * case (uint_eq_dec (nzhead num) Nil); [|intro Hn]. { intros->; simpl; unfold app; simpl. now rewrite unorm_D0, unorm_iter_D0. } replace (match nzhead num with Nil => _ | _ => _ end) with (Neg (nzhead num)); [|now revert Hn; case nzhead]. simpl. rewrite nzhead_iter_D0, nzhead_involutive. now revert Hn; case nzhead. + revert He_den'; case nb_digits as [|n]; [now simpl; rewrite Nat.add_0_r|]. intro Hn. rewrite Nat.add_succ_r, Nat.sub_add; [|apply le_S_n]; auto. Qed. Lemma IZ_of_Z_IZ_to_Z z z' : IZ_to_Z z = Some z' -> IZ_of_Z z' = z. Proof. now case z as [| |p|p]; [| injection 1 as <- ..]. Qed. Lemma of_IQmake_to_decimal' num den : match IQmake_to_decimal' num den with | None => True | Some (DecimalExp _ _ _) => False | Some (Decimal i f) => of_decimal (Decimal i f) = IQmake num den end. Proof. unfold IQmake_to_decimal'. case_eq (IZ_to_Z num); [intros num' Hnum'|now simpl]. generalize (of_IQmake_to_decimal num' den). case IQmake_to_decimal as [d|]; [|now simpl]. case d as [i f|]; [|now simpl]. now rewrite (IZ_of_Z_IZ_to_Z _ _ Hnum'). Qed. Lemma of_to (q:IQ) : forall d, to_decimal q = Some d -> of_decimal d = q. Proof. intro d. case q as [num den|q q'|q q']; simpl. - generalize (of_IQmake_to_decimal' num den). case IQmake_to_decimal' as [d'|]; [|now simpl]. case d' as [i f|]; [|now simpl]. now intros H; injection 1 as <-. - case q as [num den| |]; [|now simpl..]. case q' as [num' den'| |]; [|now simpl..]. case num' as [z p| | |]; [|now simpl..]. case (Z.eq_dec z 10); [intros->|]. 2:{ case z; [now simpl| |now simpl]; intro pz'. case pz'; [intros d0..| ]; [now simpl| |now simpl]. case d0; [intros d1..| ]; [ |now simpl..]. case d1; [intros d2..| ]; [now simpl| |now simpl]. now case d2. } case (Pos.eq_dec den' 1%positive); [intros->|now case den']. generalize (of_IQmake_to_decimal' num den). case IQmake_to_decimal' as [d'|]; [|now simpl]. case d' as [i f|]; [|now simpl]. intros <-; clear num den. injection 1 as <-. unfold of_decimal; simpl. now unfold Z.of_uint; rewrite DecimalPos.Unsigned.of_to; simpl. - case q as [num den| |]; [|now simpl..]. case q' as [num' den'| |]; [|now simpl..]. case num' as [z p| | |]; [|now simpl..]. case (Z.eq_dec z 10); [intros->|]. 2:{ case z; [now simpl| |now simpl]; intro pz'. case pz'; [intros d0..| ]; [now simpl| |now simpl]. case d0; [intros d1..| ]; [ |now simpl..]. case d1; [intros d2..| ]; [now simpl| |now simpl]. now case d2. } case (Pos.eq_dec den' 1%positive); [intros->|now case den']. generalize (of_IQmake_to_decimal' num den). case IQmake_to_decimal' as [d'|]; [|now simpl]. case d' as [i f|]; [|now simpl]. intros <-; clear num den. injection 1 as <-. unfold of_decimal; simpl. now unfold Z.of_uint; rewrite DecimalPos.Unsigned.of_to; simpl. Qed. Definition dnorm (d:decimal) : decimal := let norm_i i f := match i with | Pos i => Pos (unorm i) | Neg i => match nzhead (app i f) with Nil => Pos zero | _ => Neg (unorm i) end end in match d with | Decimal i f => Decimal (norm_i i f) f | DecimalExp i f e => match norm e with | Pos zero => Decimal (norm_i i f) f | e => DecimalExp (norm_i i f) f e end end. Lemma dnorm_spec_i d : let (i, f) := match d with Decimal i f => (i, f) | DecimalExp i f _ => (i, f) end in let i' := match dnorm d with Decimal i _ => i | DecimalExp i _ _ => i end in match i with | Pos i => i' = Pos (unorm i) | Neg i => (i' = Neg (unorm i) /\ (nzhead i <> Nil \/ nzhead f <> Nil)) \/ (i' = Pos zero /\ (nzhead i = Nil /\ nzhead f = Nil)) end. Proof. case d as [i f|i f e]; case i as [i|i]. - now simpl. - simpl; case (uint_eq_dec (nzhead (app i f)) Nil); intro Ha. + rewrite Ha; right; split; [now simpl|split]. * now unfold unorm; rewrite (nzhead_app_nil_l _ _ Ha). * now unfold unorm; rewrite (nzhead_app_nil_r _ _ Ha). + left; split; [now revert Ha; case nzhead|]. case (uint_eq_dec (nzhead i) Nil). * intro Hi; right; intro Hf; apply Ha. now rewrite <-nzhead_app_nzhead, Hi, app_nil_l. * now intro H; left. - simpl; case (norm e); clear e; intro e; [|now simpl]. now case e; clear e; [|intro e..]; [|case e|..]. - simpl. set (m := match nzhead _ with Nil => _ | _ => _ end). set (m' := match _ with Decimal _ _ => _ | _ => _ end). replace m' with m. 2:{ unfold m'; case (norm e); clear m' e; intro e; [|now simpl]. now case e; clear e; [|intro e..]; [|case e|..]. } unfold m; case (uint_eq_dec (nzhead (app i f)) Nil); intro Ha. + rewrite Ha; right; split; [now simpl|split]. * now unfold unorm; rewrite (nzhead_app_nil_l _ _ Ha). * now unfold unorm; rewrite (nzhead_app_nil_r _ _ Ha). + left; split; [now revert Ha; case nzhead|]. case (uint_eq_dec (nzhead i) Nil). * intro Hi; right; intro Hf; apply Ha. now rewrite <-nzhead_app_nzhead, Hi, app_nil_l. * now intro H; left. Qed. Lemma dnorm_spec_f d : let f := match d with Decimal _ f => f | DecimalExp _ f _ => f end in let f' := match dnorm d with Decimal _ f => f | DecimalExp _ f _ => f end in f' = f. Proof. case d as [i f|i f e]; [now simpl|]. simpl; case (int_eq_dec (norm e) (Pos zero)); [now intros->|intro He]. set (i' := match i with Pos _ => _ | _ => _ end). set (m := match norm e with Pos Nil => _ | _ => _ end). replace m with (DecimalExp i' f (norm e)); [now simpl|]. unfold m; revert He; case (norm e); clear m e; intro e; [|now simpl]. now case e; clear e; [|intro e; case e|..]. Qed. Lemma dnorm_spec_e d : match d, dnorm d with | Decimal _ _, Decimal _ _ => True | DecimalExp _ _ e, Decimal _ _ => norm e = Pos zero | DecimalExp _ _ e, DecimalExp _ _ e' => e' = norm e /\ e' <> Pos zero | Decimal _ _, DecimalExp _ _ _ => False end. Proof. case d as [i f|i f e]; [now simpl|]. simpl; case (int_eq_dec (norm e) (Pos zero)); [now intros->|intro He]. set (i' := match i with Pos _ => _ | _ => _ end). set (m := match norm e with Pos Nil => _ | _ => _ end). replace m with (DecimalExp i' f (norm e)); [now simpl|]. unfold m; revert He; case (norm e); clear m e; intro e; [|now simpl]. now case e; clear e; [|intro e; case e|..]. Qed. Lemma dnorm_involutive d : dnorm (dnorm d) = dnorm d. Proof. case d as [i f|i f e]; case i as [i|i]. - now simpl; rewrite unorm_involutive. - simpl; case (uint_eq_dec (nzhead (app i f)) Nil); [now intros->|intro Ha]. set (m := match nzhead _ with Nil =>_ | _ => _ end). replace m with (Neg (unorm i)). 2:{ now unfold m; revert Ha; case nzhead. } case (uint_eq_dec (nzhead i) Nil); intro Hi. + unfold unorm; rewrite Hi; simpl. case (uint_eq_dec (nzhead f) Nil). * intro Hf; exfalso; apply Ha. now rewrite <-nzhead_app_nzhead, Hi, app_nil_l. * now case nzhead. + rewrite unorm_involutive, (unorm_nzhead _ Hi), nzhead_app_nzhead. now revert Ha; case nzhead. - simpl; case (int_eq_dec (norm e) (Pos zero)); intro He. + now rewrite He; simpl; rewrite unorm_involutive. + set (m := match norm e with Pos Nil => _ | _ => _ end). replace m with (DecimalExp (Pos (unorm i)) f (norm e)). 2:{ unfold m; revert He; case (norm e); clear m e; intro e; [|now simpl]. now case e; clear e; [|intro e; case e|..]. } simpl; rewrite norm_involutive, unorm_involutive. revert He; case (norm e); clear m e; intro e; [|now simpl]. now case e; clear e; [|intro e; case e|..]. - simpl; case (int_eq_dec (norm e) (Pos zero)); intro He. + rewrite He; simpl. case (uint_eq_dec (nzhead (app i f)) Nil); [now intros->|intro Ha]. set (m := match nzhead _ with Nil =>_ | _ => _ end). replace m with (Neg (unorm i)). 2:{ now unfold m; revert Ha; case nzhead. } case (uint_eq_dec (nzhead i) Nil); intro Hi. * unfold unorm; rewrite Hi; simpl. case (uint_eq_dec (nzhead f) Nil). -- intro Hf; exfalso; apply Ha. now rewrite <-nzhead_app_nzhead, Hi, app_nil_l. -- now case nzhead. * rewrite unorm_involutive, (unorm_nzhead _ Hi), nzhead_app_nzhead. now revert Ha; case nzhead. + set (m := match norm e with Pos Nil => _ | _ => _ end). pose (i' := match nzhead (app i f) with Nil => Pos zero | _ => Neg (unorm i) end). replace m with (DecimalExp i' f (norm e)). 2:{ unfold m; revert He; case (norm e); clear m e; intro e; [|now simpl]. now case e; clear e; [|intro e; case e|..]. } simpl; rewrite norm_involutive. set (i'' := match i' with Pos _ => _ | _ => _ end). clear m; set (m := match norm e with Pos Nil => _ | _ => _ end). replace m with (DecimalExp i'' f (norm e)). 2:{ unfold m; revert He; case (norm e); clear m e; intro e; [|now simpl]. now case e; clear e; [|intro e; case e|..]. } unfold i'', i'. case (uint_eq_dec (nzhead (app i f)) Nil); [now intros->|intro Ha]. fold i'; replace i' with (Neg (unorm i)). 2:{ now unfold i'; revert Ha; case nzhead. } case (uint_eq_dec (nzhead i) Nil); intro Hi. * unfold unorm; rewrite Hi; simpl. case (uint_eq_dec (nzhead f) Nil). -- intro Hf; exfalso; apply Ha. now rewrite <-nzhead_app_nzhead, Hi, app_nil_l. -- now case nzhead. * rewrite unorm_involutive, (unorm_nzhead _ Hi), nzhead_app_nzhead. now revert Ha; case nzhead. Qed. Lemma IZ_to_Z_IZ_of_Z z : IZ_to_Z (IZ_of_Z z) = Some z. Proof. now case z. Qed. Lemma dnorm_i_exact i f : (nb_digits f < nb_digits (unorm (app (abs i) f)))%nat -> match i with | Pos i => Pos (unorm i) | Neg i => match nzhead (app i f) with | Nil => Pos zero | _ => Neg (unorm i) end end = norm i. Proof. case i as [ni|ni]; [now simpl|]; simpl. case (uint_eq_dec (nzhead (app ni f)) Nil); intro Ha. { now rewrite Ha, (nzhead_app_nil_l _ _ Ha). } rewrite (unorm_nzhead _ Ha). set (m := match nzhead _ with Nil => _ | _ => _ end). replace m with (Neg (unorm ni)); [|now unfold m; revert Ha; case nzhead]. case (uint_eq_dec (nzhead ni) Nil); intro Hni. { rewrite <-nzhead_app_nzhead, Hni, app_nil_l. intro H; exfalso; revert H; apply Nat.le_ngt, nb_digits_nzhead. } clear m; set (m := match nzhead ni with Nil => _ | _ => _ end). replace m with (Neg (nzhead ni)); [|now unfold m; revert Hni; case nzhead]. now rewrite (unorm_nzhead _ Hni). Qed. Lemma dnorm_i_exact' i f : (nb_digits (unorm (app (abs i) f)) <= nb_digits f)%nat -> match i with | Pos i => Pos (unorm i) | Neg i => match nzhead (app i f) with | Nil => Pos zero | _ => Neg (unorm i) end end = match norm (app_int i f) with | Pos _ => Pos zero | Neg _ => Neg zero end. Proof. case i as [ni|ni]; simpl. { now intro Hnb; rewrite (unorm_app_zero _ _ Hnb). } unfold unorm. case (uint_eq_dec (nzhead (app ni f)) Nil); intro Hn. { now rewrite Hn. } set (m := match nzhead _ with Nil => _ | _ => _ end). replace m with (nzhead (app ni f)). 2:{ now unfold m; revert Hn; case nzhead. } clear m; set (m := match nzhead _ with Nil => _ | _ => _ end). replace m with (Neg (unorm ni)). 2:{ now unfold m, unorm; revert Hn; case nzhead. } clear m; set (m := match nzhead _ with Nil => _ | _ => _ end). replace m with (Neg (nzhead (app ni f))). 2:{ now unfold m; revert Hn; case nzhead. } rewrite <-(unorm_nzhead _ Hn). now intro H; rewrite (unorm_app_zero _ _ H). Qed. Lemma to_of (d:decimal) : to_decimal (of_decimal d) = Some (dnorm d). Proof. case d as [i f|i f e]. - unfold of_decimal; simpl; unfold IQmake_to_decimal'. rewrite IZ_to_Z_IZ_of_Z. unfold IQmake_to_decimal; simpl. change (fun _ : positive => _) with (Pos.mul 10). rewrite nztail_to_uint_pow10, to_of. case_eq (nb_digits f); [|intro nb]; intro Hnb. + rewrite (nb_digits_0 _ Hnb), app_int_nil_r. case i as [ni|ni]; [now simpl|]. rewrite app_nil_r; simpl; unfold unorm. now case (nzhead ni). + rewrite <-Hnb. rewrite abs_norm, abs_app_int. case Nat.ltb_spec; intro Hnb'. * rewrite (del_tail_app_int_exact _ _ Hnb'). rewrite (del_head_app_int_exact _ _ Hnb'). now rewrite (dnorm_i_exact _ _ Hnb'). * rewrite (unorm_app_r _ _ Hnb'). rewrite iter_D0_unorm; [|now apply nb_digits_n0; rewrite Hnb]. now rewrite dnorm_i_exact'. - unfold of_decimal; simpl. rewrite <-to_of. case (Z.of_int e); clear e; [|intro e..]; simpl. + unfold IQmake_to_decimal'. rewrite IZ_to_Z_IZ_of_Z. unfold IQmake_to_decimal; simpl. change (fun _ : positive => _) with (Pos.mul 10). rewrite nztail_to_uint_pow10, to_of. case_eq (nb_digits f); [|intro nb]; intro Hnb. * rewrite (nb_digits_0 _ Hnb), app_int_nil_r. case i as [ni|ni]; [now simpl|]. rewrite app_nil_r; simpl; unfold unorm. now case (nzhead ni). * rewrite <-Hnb. rewrite abs_norm, abs_app_int. case Nat.ltb_spec; intro Hnb'. -- rewrite (del_tail_app_int_exact _ _ Hnb'). rewrite (del_head_app_int_exact _ _ Hnb'). now rewrite (dnorm_i_exact _ _ Hnb'). -- rewrite (unorm_app_r _ _ Hnb'). rewrite iter_D0_unorm; [|now apply nb_digits_n0; rewrite Hnb]. now rewrite dnorm_i_exact'. + unfold IQmake_to_decimal'. rewrite IZ_to_Z_IZ_of_Z. unfold IQmake_to_decimal; simpl. change (fun _ : positive => _) with (Pos.mul 10). rewrite nztail_to_uint_pow10, to_of. generalize (Unsigned.to_uint_nonzero e); intro He. set (dnorm_i := match i with Pos _ => _ | _ => _ end). set (m := match Pos.to_uint e with Nil => _ | _ => _ end). replace m with (DecimalExp dnorm_i f (Pos (Pos.to_uint e))). 2:{ now unfold m; revert He; case (Pos.to_uint e); [|intro u; case u|..]. } clear m; unfold dnorm_i. case_eq (nb_digits f); [|intro nb]; intro Hnb. * rewrite (nb_digits_0 _ Hnb), app_int_nil_r. case i as [ni|ni]; [now simpl|]. rewrite app_nil_r; simpl; unfold unorm. now case (nzhead ni). * rewrite <-Hnb. rewrite abs_norm, abs_app_int. case Nat.ltb_spec; intro Hnb'. -- rewrite (del_tail_app_int_exact _ _ Hnb'). rewrite (del_head_app_int_exact _ _ Hnb'). now rewrite (dnorm_i_exact _ _ Hnb'). -- rewrite (unorm_app_r _ _ Hnb'). rewrite iter_D0_unorm; [|now apply nb_digits_n0; rewrite Hnb]. now rewrite dnorm_i_exact'. + unfold IQmake_to_decimal'. rewrite IZ_to_Z_IZ_of_Z. unfold IQmake_to_decimal; simpl. change (fun _ : positive => _) with (Pos.mul 10). rewrite nztail_to_uint_pow10, to_of. case_eq (nb_digits f); [|intro nb]; intro Hnb. * rewrite (nb_digits_0 _ Hnb), app_int_nil_r. case i as [ni|ni]; [now simpl|]. rewrite app_nil_r; simpl; unfold unorm. now case (nzhead ni). * rewrite <-Hnb. rewrite abs_norm, abs_app_int. case Nat.ltb_spec; intro Hnb'. -- rewrite (del_tail_app_int_exact _ _ Hnb'). rewrite (del_head_app_int_exact _ _ Hnb'). now rewrite (dnorm_i_exact _ _ Hnb'). -- rewrite (unorm_app_r _ _ Hnb'). rewrite iter_D0_unorm; [|now apply nb_digits_n0; rewrite Hnb]. now rewrite dnorm_i_exact'. Qed. (** Some consequences *) Lemma to_decimal_inj q q' : to_decimal q <> None -> to_decimal q = to_decimal q' -> q = q'. Proof. intros Hnone EQ. generalize (of_to q) (of_to q'). rewrite <-EQ. revert Hnone; case to_decimal; [|now simpl]. now intros d _ H1 H2; rewrite <-(H1 d eq_refl), <-(H2 d eq_refl). Qed. Lemma to_decimal_surj d : exists q, to_decimal q = Some (dnorm d). Proof. exists (of_decimal d). apply to_of. Qed. Lemma of_decimal_dnorm d : of_decimal (dnorm d) = of_decimal d. Proof. now apply to_decimal_inj; rewrite !to_of; [|rewrite dnorm_involutive]. Qed. Lemma of_inj d d' : of_decimal d = of_decimal d' -> dnorm d = dnorm d'. Proof. intro H. apply (@f_equal _ _ (fun x => match x with Some x => x | _ => d end) (Some (dnorm d)) (Some (dnorm d'))). now rewrite <- !to_of, H. Qed. Lemma of_iff d d' : of_decimal d = of_decimal d' <-> dnorm d = dnorm d'. Proof. split. - apply of_inj. - intros E. rewrite <- of_decimal_dnorm, E. apply of_decimal_dnorm. Qed. coq-8.20.0/theories/Numbers/DecimalR.v000066400000000000000000000334361466560755400175220ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* True | Some (DecimalExp _ _ _) => False | Some (Decimal i f) => of_decimal (Decimal i f) = IRQ (QArith_base.Qmake num den) end. Proof. unfold IQmake_to_decimal. case (Pos.eq_dec den 1); [now intros->|intro Hden]. assert (Hf : match QArith_base.IQmake_to_decimal num den with | Some (Decimal i f) => f <> Nil | _ => True end). { unfold QArith_base.IQmake_to_decimal; simpl. generalize (Unsigned.nztail_to_uint den). case Decimal.nztail as [den' e_den']. case den'; [now simpl|now simpl| |now simpl..]; clear den'; intro den'. case den'; [ |now simpl..]; clear den'. case e_den' as [|e_den']; [now simpl; intros H _; apply Hden; injection H|]. intros _. case Nat.ltb_spec; intro He_den'. - apply del_head_nonnil. revert He_den'; case nb_digits as [|n]; [now simpl|]. now intro H; simpl; apply Nat.lt_succ_r, Nat.le_sub_l. - apply nb_digits_n0. now rewrite nb_digits_iter_D0, Nat.sub_add. } replace (match den with 1%positive => _ | _ => _ end) with (QArith_base.IQmake_to_decimal num den); [|now revert Hden; case den]. generalize (of_IQmake_to_decimal num den). case QArith_base.IQmake_to_decimal as [d'|]; [|now simpl]. case d' as [i f|]; [|now simpl]. unfold of_decimal; simpl. injection 1 as H <-. generalize (f_equal QArith_base.IZ_to_Z H); clear H. rewrite !IZ_to_Z_IZ_of_Z; injection 1 as <-. now revert Hf; case f. Qed. Lemma of_to (q:IR) : forall d, to_decimal q = Some d -> of_decimal d = q. Proof. intro d. case q as [z|q|r r'|r r']; simpl. - case z as [z p| |p|p]. + now simpl. + now simpl; injection 1 as <-. + simpl; injection 1 as <-. now unfold of_decimal; simpl; unfold Z.of_uint; rewrite Unsigned.of_to. + simpl; injection 1 as <-. now unfold of_decimal; simpl; unfold Z.of_uint; rewrite Unsigned.of_to. - case q as [num den]. generalize (of_IQmake_to_decimal num den). case IQmake_to_decimal as [d'|]; [|now simpl]. case d' as [i f|]; [|now simpl]. now intros H; injection 1 as <-. - case r as [z|q| |]; [|case q as[num den]|now simpl..]; (case r' as [z'| | |]; [|now simpl..]); (case z' as [p e| | |]; [|now simpl..]). + case (Z.eq_dec p 10); [intros->|intro Hp]. 2:{ revert Hp; case p; [now simpl|intro d0..]; (case d0; [intro d1..|]; [now simpl| |now simpl]; case d1; [intro d2..|]; [|now simpl..]; case d2; [intro d3..|]; [now simpl| |now simpl]; now case d3). } case z as [| |p|p]; [now simpl|..]; injection 1 as <-. * now unfold of_decimal; simpl; unfold Z.of_uint; rewrite Unsigned.of_to. * unfold of_decimal; simpl; unfold Z.of_uint; rewrite Unsigned.of_to; simpl. now rewrite Unsigned.of_to. * unfold of_decimal; simpl; unfold Z.of_uint; rewrite Unsigned.of_to; simpl. now rewrite Unsigned.of_to. + case (Z.eq_dec p 10); [intros->|intro Hp]. 2:{ revert Hp; case p; [now simpl|intro d0..]; (case d0; [intro d1..|]; [now simpl| |now simpl]; case d1; [intro d2..|]; [|now simpl..]; case d2; [intro d3..|]; [now simpl| |now simpl]; now case d3). } generalize (of_IQmake_to_decimal num den). case IQmake_to_decimal as [d'|]; [|now simpl]. case d' as [i f|]; [|now simpl]. intros H; injection 1 as <-. unfold of_decimal; simpl. change (match f with Nil => _ | _ => _ end) with (of_decimal (Decimal i f)). rewrite H; clear H. now unfold Z.of_uint; rewrite Unsigned.of_to. - case r as [z|q| |]; [|case q as[num den]|now simpl..]; (case r' as [z'| | |]; [|now simpl..]); (case z' as [p e| | |]; [|now simpl..]). + case (Z.eq_dec p 10); [intros->|intro Hp]. 2:{ revert Hp; case p; [now simpl|intro d0..]; (case d0; [intro d1..|]; [now simpl| |now simpl]; case d1; [intro d2..|]; [|now simpl..]; case d2; [intro d3..|]; [now simpl| |now simpl]; now case d3). } case z as [| |p|p]; [now simpl|..]; injection 1 as <-. * now unfold of_decimal; simpl; unfold Z.of_uint; rewrite Unsigned.of_to. * unfold of_decimal; simpl; unfold Z.of_uint; rewrite Unsigned.of_to; simpl. now rewrite Unsigned.of_to. * unfold of_decimal; simpl; unfold Z.of_uint; rewrite Unsigned.of_to; simpl. now rewrite Unsigned.of_to. + case (Z.eq_dec p 10); [intros->|intro Hp]. 2:{ revert Hp; case p; [now simpl|intro d0..]; (case d0; [intro d1..|]; [now simpl| |now simpl]; case d1; [intro d2..|]; [|now simpl..]; case d2; [intro d3..|]; [now simpl| |now simpl]; now case d3). } generalize (of_IQmake_to_decimal num den). case IQmake_to_decimal as [d'|]; [|now simpl]. case d' as [i f|]; [|now simpl]. intros H; injection 1 as <-. unfold of_decimal; simpl. change (match f with Nil => _ | _ => _ end) with (of_decimal (Decimal i f)). rewrite H; clear H. now unfold Z.of_uint; rewrite Unsigned.of_to. Qed. Lemma to_of (d:decimal) : to_decimal (of_decimal d) = Some (dnorm d). Proof. case d as [i f|i f e]. - unfold of_decimal; simpl. case (uint_eq_dec f Nil); intro Hf. + rewrite Hf; clear f Hf. unfold to_decimal; simpl. rewrite IZ_to_Z_IZ_of_Z, DecimalZ.to_of. case i as [i|i]; [now simpl|]; simpl. rewrite app_nil_r. case (uint_eq_dec (nzhead i) Nil); [now intros->|intro Hi]. now rewrite (unorm_nzhead _ Hi); revert Hi; case nzhead. + set (r := IRQ _). set (m := match f with Nil => _ | _ => _ end). replace m with r; [unfold r|now unfold m; revert Hf; case f]. unfold to_decimal; simpl. unfold IQmake_to_decimal; simpl. set (n := Nat.iter _ _ _). case (Pos.eq_dec n 1); intro Hn. { exfalso; apply Hf. now apply nb_digits_0; revert Hn; unfold n; case nb_digits. } clear m; set (m := match n with 1%positive | _ => _ end). replace m with (QArith_base.IQmake_to_decimal (Z.of_int (app_int i f)) n). 2:{ now unfold m; revert Hn; case n. } unfold QArith_base.IQmake_to_decimal, n; simpl. rewrite nztail_to_uint_pow10. clear r; set (r := if _ _ | _ => _ end). replace m with r; [unfold r|now unfold m; revert Hf; case f]. rewrite DecimalZ.to_of, abs_norm, abs_app_int. case Nat.ltb_spec; intro Hnf. * rewrite (del_tail_app_int_exact _ _ Hnf). rewrite (del_head_app_int_exact _ _ Hnf). now rewrite (dnorm_i_exact _ _ Hnf). * rewrite (unorm_app_r _ _ Hnf). rewrite (iter_D0_unorm _ Hf). now rewrite dnorm_i_exact'. - unfold of_decimal; simpl. rewrite <-(DecimalZ.to_of e). case (Z.of_int e); clear e; [|intro e..]; simpl. + case (uint_eq_dec f Nil); intro Hf. * rewrite Hf; clear f Hf. unfold to_decimal; simpl. rewrite IZ_to_Z_IZ_of_Z, DecimalZ.to_of. case i as [i|i]; [now simpl|]; simpl. rewrite app_nil_r. case (uint_eq_dec (nzhead i) Nil); [now intros->|intro Hi]. now rewrite (unorm_nzhead _ Hi); revert Hi; case nzhead. * set (r := IRQ _). set (m := match f with Nil => _ | _ => _ end). replace m with r; [unfold r|now unfold m; revert Hf; case f]. unfold to_decimal; simpl. unfold IQmake_to_decimal; simpl. set (n := Nat.iter _ _ _). case (Pos.eq_dec n 1); intro Hn. { exfalso; apply Hf. now apply nb_digits_0; revert Hn; unfold n; case nb_digits. } clear m; set (m := match n with 1%positive | _ => _ end). replace m with (QArith_base.IQmake_to_decimal (Z.of_int (app_int i f)) n). 2:{ now unfold m; revert Hn; case n. } unfold QArith_base.IQmake_to_decimal, n; simpl. rewrite nztail_to_uint_pow10. clear r; set (r := if _ _ | _ => _ end). replace m with r; [unfold r|now unfold m; revert Hf; case f]. rewrite DecimalZ.to_of, abs_norm, abs_app_int. case Nat.ltb_spec; intro Hnf. -- rewrite (del_tail_app_int_exact _ _ Hnf). rewrite (del_head_app_int_exact _ _ Hnf). now rewrite (dnorm_i_exact _ _ Hnf). -- rewrite (unorm_app_r _ _ Hnf). rewrite (iter_D0_unorm _ Hf). now rewrite dnorm_i_exact'. + set (i' := match i with Pos _ => _ | _ => _ end). set (m := match Pos.to_uint e with Nil => _ | _ => _ end). replace m with (DecimalExp i' f (Pos (Pos.to_uint e))). 2:{ unfold m; generalize (Unsigned.to_uint_nonzero e). now case Pos.to_uint; [|intro u; case u|..]. } unfold i'; clear i' m. case (uint_eq_dec f Nil); intro Hf. * rewrite Hf; clear f Hf. unfold to_decimal; simpl. rewrite IZ_to_Z_IZ_of_Z, DecimalZ.to_of. case i as [i|i]; [now simpl|]; simpl. rewrite app_nil_r. case (uint_eq_dec (nzhead i) Nil); [now intros->|intro Hi]. now rewrite (unorm_nzhead _ Hi); revert Hi; case nzhead. * set (r := IRQ _). set (m := match f with Nil => _ | _ => _ end). replace m with r; [unfold r|now unfold m; revert Hf; case f]. unfold to_decimal; simpl. unfold IQmake_to_decimal; simpl. set (n := Nat.iter _ _ _). case (Pos.eq_dec n 1); intro Hn. { exfalso; apply Hf. now apply nb_digits_0; revert Hn; unfold n; case nb_digits. } clear m; set (m := match n with 1%positive | _ => _ end). replace m with (QArith_base.IQmake_to_decimal (Z.of_int (app_int i f)) n). 2:{ now unfold m; revert Hn; case n. } unfold QArith_base.IQmake_to_decimal, n; simpl. rewrite nztail_to_uint_pow10. clear r; set (r := if _ _ | _ => _ end). replace m with r; [unfold r|now unfold m; revert Hf; case f]. rewrite DecimalZ.to_of, abs_norm, abs_app_int. case Nat.ltb_spec; intro Hnf. -- rewrite (del_tail_app_int_exact _ _ Hnf). rewrite (del_head_app_int_exact _ _ Hnf). now rewrite (dnorm_i_exact _ _ Hnf). -- rewrite (unorm_app_r _ _ Hnf). rewrite (iter_D0_unorm _ Hf). now rewrite dnorm_i_exact'. + case (uint_eq_dec f Nil); intro Hf. * rewrite Hf; clear f Hf. unfold to_decimal; simpl. rewrite IZ_to_Z_IZ_of_Z, DecimalZ.to_of. case i as [i|i]; [now simpl|]; simpl. rewrite app_nil_r. case (uint_eq_dec (nzhead i) Nil); [now intros->|intro Hi]. now rewrite (unorm_nzhead _ Hi); revert Hi; case nzhead. * set (r := IRQ _). set (m := match f with Nil => _ | _ => _ end). replace m with r; [unfold r|now unfold m; revert Hf; case f]. unfold to_decimal; simpl. unfold IQmake_to_decimal; simpl. set (n := Nat.iter _ _ _). case (Pos.eq_dec n 1); intro Hn. { exfalso; apply Hf. now apply nb_digits_0; revert Hn; unfold n; case nb_digits. } clear m; set (m := match n with 1%positive | _ => _ end). replace m with (QArith_base.IQmake_to_decimal (Z.of_int (app_int i f)) n). 2:{ now unfold m; revert Hn; case n. } unfold QArith_base.IQmake_to_decimal, n; simpl. rewrite nztail_to_uint_pow10. clear r; set (r := if _ _ | _ => _ end). replace m with r; [unfold r|now unfold m; revert Hf; case f]. rewrite DecimalZ.to_of, abs_norm, abs_app_int. case Nat.ltb_spec; intro Hnf. -- rewrite (del_tail_app_int_exact _ _ Hnf). rewrite (del_head_app_int_exact _ _ Hnf). now rewrite (dnorm_i_exact _ _ Hnf). -- rewrite (unorm_app_r _ _ Hnf). rewrite (iter_D0_unorm _ Hf). now rewrite dnorm_i_exact'. Qed. (** Some consequences *) Lemma to_decimal_inj q q' : to_decimal q <> None -> to_decimal q = to_decimal q' -> q = q'. Proof. intros Hnone EQ. generalize (of_to q) (of_to q'). rewrite <-EQ. revert Hnone; case to_decimal; [|now simpl]. now intros d _ H1 H2; rewrite <-(H1 d eq_refl), <-(H2 d eq_refl). Qed. Lemma to_decimal_surj d : exists q, to_decimal q = Some (dnorm d). Proof. exists (of_decimal d). apply to_of. Qed. Lemma of_decimal_dnorm d : of_decimal (dnorm d) = of_decimal d. Proof. now apply to_decimal_inj; rewrite !to_of; [|rewrite dnorm_involutive]. Qed. Lemma of_inj d d' : of_decimal d = of_decimal d' -> dnorm d = dnorm d'. Proof. intro H. apply (@f_equal _ _ (fun x => match x with Some x => x | _ => d end) (Some (dnorm d)) (Some (dnorm d'))). now rewrite <- !to_of, H. Qed. Lemma of_iff d d' : of_decimal d = of_decimal d' <-> dnorm d = dnorm d'. Proof. split. - apply of_inj. - intros E. rewrite <- of_decimal_dnorm, E. apply of_decimal_dnorm. Qed. coq-8.20.0/theories/Numbers/DecimalString.v000066400000000000000000000157651466560755400205740ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* None | Some d => match a with | "0" => Some (D0 d) | "1" => Some (D1 d) | "2" => Some (D2 d) | "3" => Some (D3 d) | "4" => Some (D4 d) | "5" => Some (D5 d) | "6" => Some (D6 d) | "7" => Some (D7 d) | "8" => Some (D8 d) | "9" => Some (D9 d) | _ => None end end%char. Lemma uint_of_char_spec c d d' : uint_of_char c (Some d) = Some d' -> (c = "0" /\ d' = D0 d \/ c = "1" /\ d' = D1 d \/ c = "2" /\ d' = D2 d \/ c = "3" /\ d' = D3 d \/ c = "4" /\ d' = D4 d \/ c = "5" /\ d' = D5 d \/ c = "6" /\ d' = D6 d \/ c = "7" /\ d' = D7 d \/ c = "8" /\ d' = D8 d \/ c = "9" /\ d' = D9 d)%char. Proof. destruct c as [[|] [|] [|] [|] [|] [|] [|] [|]]; intros [= <-]; intuition. Qed. (** Decimal/String conversion where [Nil] is [""] *) Module NilEmpty. Fixpoint string_of_uint (d:uint) := match d with | Nil => EmptyString | D0 d => String "0" (string_of_uint d) | D1 d => String "1" (string_of_uint d) | D2 d => String "2" (string_of_uint d) | D3 d => String "3" (string_of_uint d) | D4 d => String "4" (string_of_uint d) | D5 d => String "5" (string_of_uint d) | D6 d => String "6" (string_of_uint d) | D7 d => String "7" (string_of_uint d) | D8 d => String "8" (string_of_uint d) | D9 d => String "9" (string_of_uint d) end. Fixpoint uint_of_string s := match s with | EmptyString => Some Nil | String a s => uint_of_char a (uint_of_string s) end. Definition string_of_int (d:int) := match d with | Pos d => string_of_uint d | Neg d => String "-" (string_of_uint d) end. Definition int_of_string s := match s with | EmptyString => Some (Pos Nil) | String a s' => if Ascii.eqb a "-" then option_map Neg (uint_of_string s') else option_map Pos (uint_of_string s) end. (* NB: For the moment whitespace between - and digits are not accepted. And in this variant [int_of_string "-" = Some (Neg Nil)]. Compute int_of_string "-123456890123456890123456890123456890". Compute string_of_int (-123456890123456890123456890123456890). *) (** Corresponding proofs *) Lemma usu d : uint_of_string (string_of_uint d) = Some d. Proof. induction d; simpl; rewrite ?IHd; simpl; auto. Qed. Lemma sus s d : uint_of_string s = Some d -> string_of_uint d = s. Proof. revert d. induction s; simpl. - now intros d [= <-]. - intros d. destruct (uint_of_string s); [intros H | intros [=]]. apply uint_of_char_spec in H. intuition subst; simpl; f_equal; auto. Qed. Lemma isi d : int_of_string (string_of_int d) = Some d. Proof. destruct d; simpl. - unfold int_of_string. destruct (string_of_uint d) eqn:Hd. + now destruct d. + case Ascii.eqb_spec. * intros ->. now destruct d. * rewrite <- Hd, usu; auto. - rewrite usu; auto. Qed. Lemma sis s d : int_of_string s = Some d -> string_of_int d = s. Proof. destruct s; [intros [= <-]| ]; simpl; trivial. case Ascii.eqb_spec. - intros ->. destruct (uint_of_string s) eqn:Hs; simpl; intros [= <-]. simpl; f_equal. now apply sus. - destruct d; [ | now destruct uint_of_char]. simpl string_of_int. intros. apply sus; simpl. destruct uint_of_char; simpl in *; congruence. Qed. End NilEmpty. (** Decimal/String conversions where [Nil] is ["0"] *) Module NilZero. Definition string_of_uint (d:uint) := match d with | Nil => "0" | _ => NilEmpty.string_of_uint d end. Definition uint_of_string s := match s with | EmptyString => None | _ => NilEmpty.uint_of_string s end. Definition string_of_int (d:int) := match d with | Pos d => string_of_uint d | Neg d => String "-" (string_of_uint d) end. Definition int_of_string s := match s with | EmptyString => None | String a s' => if Ascii.eqb a "-" then option_map Neg (uint_of_string s') else option_map Pos (uint_of_string s) end. (** Corresponding proofs *) Lemma uint_of_string_nonnil s : uint_of_string s <> Some Nil. Proof. destruct s; simpl. - easy. - destruct (NilEmpty.uint_of_string s); [intros H | intros [=]]. apply uint_of_char_spec in H. now intuition subst. Qed. Lemma sus s d : uint_of_string s = Some d -> string_of_uint d = s. Proof. destruct s; [intros [=] | intros H]. apply NilEmpty.sus in H. now destruct d. Qed. Lemma usu d : d<>Nil -> uint_of_string (string_of_uint d) = Some d. Proof. destruct d; (now destruct 1) || (intros _; apply NilEmpty.usu). Qed. Lemma usu_nil : uint_of_string (string_of_uint Nil) = Some Decimal.zero. Proof. reflexivity. Qed. Lemma usu_gen d : uint_of_string (string_of_uint d) = Some d \/ uint_of_string (string_of_uint d) = Some Decimal.zero. Proof. destruct d; (now right) || (left; now apply usu). Qed. Lemma isi d : d<>Pos Nil -> d<>Neg Nil -> int_of_string (string_of_int d) = Some d. Proof. destruct d; simpl. - intros H _. unfold int_of_string. destruct (string_of_uint d) eqn:Hd. + now destruct d. + case Ascii.eqb_spec. * intros ->. now destruct d. * rewrite <- Hd, usu; auto. now intros ->. - intros _ H. rewrite usu; auto. now intros ->. Qed. Lemma isi_posnil : int_of_string (string_of_int (Pos Nil)) = Some (Pos Decimal.zero). Proof. reflexivity. Qed. (** Warning! (-0) won't parse (compatibility with the behavior of Z). *) Lemma isi_negnil : int_of_string (string_of_int (Neg Nil)) = Some (Neg (D0 Nil)). Proof. reflexivity. Qed. Lemma sis s d : int_of_string s = Some d -> string_of_int d = s. Proof. destruct s; [intros [=]| ]; simpl. case Ascii.eqb_spec. - intros ->. destruct (uint_of_string s) eqn:Hs; simpl; intros [= <-]. simpl; f_equal. now apply sus. - destruct d; [ | now destruct uint_of_char]. simpl string_of_int. intros. apply sus; simpl. destruct uint_of_char; simpl in *; congruence. Qed. End NilZero. coq-8.20.0/theories/Numbers/DecimalZ.v000066400000000000000000000104361466560755400175250ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* n = n'. Proof. intro EQ. now rewrite <- (of_to n), <- (of_to n'), EQ. Qed. Lemma to_int_surj d : exists n, Z.to_int n = norm d. Proof. exists (Z.of_int d). apply to_of. Qed. Lemma of_int_norm d : Z.of_int (norm d) = Z.of_int d. Proof. unfold Z.of_int, Z.of_uint. destruct d. - simpl. now rewrite DecimalPos.Unsigned.of_uint_norm. - simpl. destruct (nzhead d) eqn:H; [ induction d; simpl; auto; discriminate | destruct (nzhead_nonzero _ _ H) | .. ]; f_equal; f_equal; apply DecimalPos.Unsigned.of_iff; unfold unorm; now rewrite H. Qed. Lemma of_inj d d' : Z.of_int d = Z.of_int d' -> norm d = norm d'. Proof. intros. rewrite <- !to_of. now f_equal. Qed. Lemma of_iff d d' : Z.of_int d = Z.of_int d' <-> norm d = norm d'. Proof. split. - apply of_inj. - intros E. rewrite <- of_int_norm, E. apply of_int_norm. Qed. (** Various lemmas *) Lemma of_uint_iter_D0 d n : Z.of_uint (app d (Nat.iter n D0 Nil)) = Nat.iter n (Z.mul 10) (Z.of_uint d). Proof. rewrite <-(rev_rev (app _ _)), <-(of_list_to_list (rev (app _ _))). rewrite rev_spec, app_spec, List.rev_app_distr. rewrite <-!rev_spec, <-app_spec, of_list_to_list. unfold Z.of_uint; rewrite Unsigned.of_lu_rev. unfold app; rewrite Unsigned.of_lu_revapp, !rev_rev. rewrite <-!Unsigned.of_lu_rev, !rev_rev. assert (H' : Pos.of_uint (Nat.iter n D0 Nil) = 0%N). { now induction n; [|rewrite Unsigned.nat_iter_S]. } rewrite H', N.add_0_l; clear H'. induction n; [now simpl; rewrite N.mul_1_r|]. rewrite !Unsigned.nat_iter_S, <-IHn. simpl Unsigned.usize; rewrite N.pow_succ_r'. rewrite !N2Z.inj_mul; simpl Z.of_N; ring. Qed. Lemma of_int_iter_D0 d n : Z.of_int (app_int d (Nat.iter n D0 Nil)) = Nat.iter n (Z.mul 10) (Z.of_int d). Proof. case d; clear d; intro d; simpl. - now rewrite of_uint_iter_D0. - rewrite of_uint_iter_D0; induction n; [now simpl|]. rewrite !Unsigned.nat_iter_S, <-IHn; ring. Qed. Lemma nztail_to_uint_pow10 n : Decimal.nztail (Pos.to_uint (Nat.iter n (Pos.mul 10) 1%positive)) = (D1 Nil, n). Proof. case n as [|n]; [now simpl|]. rewrite <-(Nat2Pos.id (S n)); [|now simpl]. generalize (Pos.of_nat (S n)); clear n; intro p. induction (Pos.to_nat p); [now simpl|]. rewrite Unsigned.nat_iter_S. unfold Pos.to_uint. change (Pos.to_little_uint _) with (Unsigned.to_lu (10 * N.pos (Nat.iter n (Pos.mul 10) 1%positive))). rewrite Unsigned.to_ldec_tenfold. revert IHn; unfold Pos.to_uint. unfold Decimal.nztail; rewrite !rev_rev; simpl. set (f'' := _ (Pos.to_little_uint _)). now case f''; intros r n' H; inversion H. Qed. coq-8.20.0/theories/Numbers/HexadecimalFacts.v000066400000000000000000000565341466560755400212330ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* nil | D0 u => cons d0 (to_list u) | D1 u => cons d1 (to_list u) | D2 u => cons d2 (to_list u) | D3 u => cons d3 (to_list u) | D4 u => cons d4 (to_list u) | D5 u => cons d5 (to_list u) | D6 u => cons d6 (to_list u) | D7 u => cons d7 (to_list u) | D8 u => cons d8 (to_list u) | D9 u => cons d9 (to_list u) | Da u => cons da (to_list u) | Db u => cons db (to_list u) | Dc u => cons dc (to_list u) | Dd u => cons dd (to_list u) | De u => cons de (to_list u) | Df u => cons df (to_list u) end. Fixpoint of_list (l : list digits) : uint := match l with | nil => Nil | cons d0 l => D0 (of_list l) | cons d1 l => D1 (of_list l) | cons d2 l => D2 (of_list l) | cons d3 l => D3 (of_list l) | cons d4 l => D4 (of_list l) | cons d5 l => D5 (of_list l) | cons d6 l => D6 (of_list l) | cons d7 l => D7 (of_list l) | cons d8 l => D8 (of_list l) | cons d9 l => D9 (of_list l) | cons da l => Da (of_list l) | cons db l => Db (of_list l) | cons dc l => Dc (of_list l) | cons dd l => Dd (of_list l) | cons de l => De (of_list l) | cons df l => Df (of_list l) end. Lemma of_list_to_list u : of_list (to_list u) = u. Proof. now induction u; [|simpl; rewrite IHu..]. Qed. Lemma to_list_of_list l : to_list (of_list l) = l. Proof. now induction l as [|h t IHl]; [|case h; simpl; rewrite IHl]. Qed. Lemma to_list_inj u u' : to_list u = to_list u' -> u = u'. Proof. now intro H; rewrite <-(of_list_to_list u), <-(of_list_to_list u'), H. Qed. Lemma of_list_inj u u' : of_list u = of_list u' -> u = u'. Proof. now intro H; rewrite <-(to_list_of_list u), <-(to_list_of_list u'), H. Qed. Lemma nb_digits_spec u : nb_digits u = length (to_list u). Proof. now induction u; [|simpl; rewrite IHu..]. Qed. Fixpoint lnzhead l := match l with | nil => nil | cons d l' => match d with | d0 => lnzhead l' | _ => l end end. Lemma nzhead_spec u : to_list (nzhead u) = lnzhead (to_list u). Proof. now induction u; [|simpl; rewrite IHu|..]. Qed. Definition lzero := cons d0 nil. Definition lunorm l := match lnzhead l with | nil => lzero | d => d end. Lemma unorm_spec u : to_list (unorm u) = lunorm (to_list u). Proof. now unfold unorm, lunorm; rewrite <-nzhead_spec; case (nzhead u). Qed. Lemma revapp_spec d d' : to_list (revapp d d') = List.rev_append (to_list d) (to_list d'). Proof. now revert d'; induction d; intro d'; [|simpl; rewrite IHd..]. Qed. Lemma rev_spec d : to_list (rev d) = List.rev (to_list d). Proof. now unfold rev; rewrite revapp_spec, List.rev_alt; simpl. Qed. Lemma app_spec d d' : to_list (app d d') = Datatypes.app (to_list d) (to_list d'). Proof. unfold app. now rewrite revapp_spec, List.rev_append_rev, rev_spec, List.rev_involutive. Qed. Definition lnztail l := let fix aux l_rev := match l_rev with | cons d0 l_rev => let (r, n) := aux l_rev in pair r (S n) | _ => pair l_rev O end in let (r, n) := aux (List.rev l) in pair (List.rev r) n. Lemma nztail_spec d : let (r, n) := nztail d in let (r', n') := lnztail (to_list d) in to_list r = r' /\ n = n'. Proof. unfold nztail, lnztail. set (f := fix aux d_rev := match d_rev with | D0 d_rev => let (r, n) := aux d_rev in (r, S n) | _ => (d_rev, 0) end). set (f' := fix aux (l_rev : list digits) : list digits * nat := match l_rev with | cons d0 l_rev => let (r, n) := aux l_rev in (r, S n) | _ => (l_rev, 0) end). rewrite <-(of_list_to_list (rev d)), rev_spec. induction (List.rev _) as [|h t IHl]; [now simpl|]. case h; simpl; [|now rewrite rev_spec; simpl; rewrite to_list_of_list..]. now revert IHl; case f; intros r n; case f'; intros r' n' [-> ->]. Qed. Lemma del_head_spec_0 d : del_head 0 d = d. Proof. now simpl. Qed. Lemma del_head_spec_small n d : n <= length (to_list d) -> to_list (del_head n d) = List.skipn n (to_list d). Proof. revert d; induction n as [|n IHn]; intro d; [now simpl|]. now case d; [|intros d' H; apply IHn, le_S_n..]. Qed. Lemma del_head_spec_large n d : length (to_list d) < n -> del_head n d = zero. Proof. revert d; induction n; intro d; [now case d|]. now case d; [|intro d'; simpl; intro H; rewrite (IHn _ (proj2 (Nat.succ_lt_mono _ _) H))..]. Qed. Lemma nb_digits_0 d : nb_digits d = 0 -> d = Nil. Proof. rewrite nb_digits_spec, <-(of_list_to_list d). now case (to_list d) as [|h t]; [|rewrite to_list_of_list]. Qed. Lemma nb_digits_n0 d : nb_digits d <> 0 -> d <> Nil. Proof. now case d; [|intros u _..]. Qed. Lemma nb_digits_iter_D0 n d : nb_digits (Nat.iter n D0 d) = n + nb_digits d. Proof. now induction n; simpl; [|rewrite IHn]. Qed. Lemma length_lnzhead l : length (lnzhead l) <= length l. Proof. now induction l as [|h t IHl]; [|case h; [apply le_S|..]]. Qed. Lemma nb_digits_nzhead u : nb_digits (nzhead u) <= nb_digits u. Proof. now induction u; [|apply le_S|..]. Qed. Lemma unorm_nzhead u : nzhead u <> Nil -> unorm u = nzhead u. Proof. now unfold unorm; case nzhead. Qed. Lemma nb_digits_unorm u : u <> Nil -> nb_digits (unorm u) <= nb_digits u. Proof. intro Hu; case (uint_eq_dec (nzhead u) Nil). { unfold unorm; intros ->; simpl. now revert Hu; case u; [|intros u' _; apply le_n_S, Nat.le_0_l..]. } intro H; rewrite (unorm_nzhead _ H); apply nb_digits_nzhead. Qed. Lemma nb_digits_rev d : nb_digits (rev d) = nb_digits d. Proof. now rewrite !nb_digits_spec, rev_spec, List.length_rev. Qed. Lemma nb_digits_del_head_sub d n : n <= nb_digits d -> nb_digits (del_head (nb_digits d - n) d) = n. Proof. rewrite !nb_digits_spec; intro Hn. rewrite del_head_spec_small; [|now apply Nat.le_sub_l]. rewrite List.length_skipn, <-(Nat2Z.id (_ - _)). rewrite Nat2Z.inj_sub; [|now apply Nat.le_sub_l]. rewrite (Nat2Z.inj_sub _ _ Hn). rewrite Z.sub_sub_distr, Z.sub_diag; apply Nat2Z.id. Qed. Lemma unorm_D0 u : unorm (D0 u) = unorm u. Proof. reflexivity. Qed. Lemma app_nil_l d : app Nil d = d. Proof. now simpl. Qed. Lemma app_nil_r d : app d Nil = d. Proof. now apply to_list_inj; rewrite app_spec, List.app_nil_r. Qed. Lemma abs_app_int d d' : abs (app_int d d') = app (abs d) d'. Proof. now case d. Qed. Lemma abs_norm d : abs (norm d) = unorm (abs d). Proof. now case d as [u|u]; [|simpl; unfold unorm; case nzhead]. Qed. Lemma iter_D0_nzhead d : Nat.iter (nb_digits d - nb_digits (nzhead d)) D0 (nzhead d) = d. Proof. induction d; [now simpl| |now rewrite Nat.sub_diag..]. simpl nzhead; simpl nb_digits. rewrite (Nat.sub_succ_l _ _ (nb_digits_nzhead _)). now rewrite <-IHd at 4. Qed. Lemma iter_D0_unorm d : d <> Nil -> Nat.iter (nb_digits d - nb_digits (unorm d)) D0 (unorm d) = d. Proof. case (uint_eq_dec (nzhead d) Nil); intro Hn. { unfold unorm; rewrite Hn; simpl; intro H. revert H Hn; induction d; [now simpl|intros _|now intros _..]. case (uint_eq_dec d Nil); simpl; intros H Hn; [now rewrite H|]. rewrite Nat.sub_0_r, <- (Nat.sub_add 1 (nb_digits d)), Nat.add_comm. { now simpl; rewrite IHd. } revert H; case d; [now simpl|intros u _; apply le_n_S, Nat.le_0_l..]. } intros _; rewrite (unorm_nzhead _ Hn); apply iter_D0_nzhead. Qed. Lemma nzhead_app_l d d' : nb_digits d' < nb_digits (nzhead (app d d')) -> nzhead (app d d') = app (nzhead d) d'. Proof. intro Hl; apply to_list_inj; revert Hl. rewrite !nb_digits_spec, app_spec, !nzhead_spec, app_spec. induction (to_list d) as [|h t IHl]. { now simpl; intro H; exfalso; revert H; apply Nat.le_ngt, length_lnzhead. } rewrite <-List.app_comm_cons. now case h; [simpl; intro Hl; apply IHl|..]. Qed. Lemma nzhead_app_r d d' : nb_digits (nzhead (app d d')) <= nb_digits d' -> nzhead (app d d') = nzhead d'. Proof. intro Hl; apply to_list_inj; revert Hl. rewrite !nb_digits_spec, !nzhead_spec, app_spec. induction (to_list d) as [|h t IHl]; [now simpl|]. rewrite <-List.app_comm_cons. now case h; [| simpl; rewrite List.length_app; intro Hl; exfalso; revert Hl; apply Nat.le_ngt, Nat.le_add_l..]. Qed. Lemma nzhead_app_nil_r d d' : nzhead (app d d') = Nil -> nzhead d' = Nil. Proof. now intro H; generalize H; rewrite nzhead_app_r; [|rewrite H; apply Nat.le_0_l]. Qed. Lemma nzhead_app_nil d d' : nb_digits (nzhead (app d d')) <= nb_digits d' -> nzhead d = Nil. Proof. intro H; apply to_list_inj; revert H. rewrite !nb_digits_spec, !nzhead_spec, app_spec. induction (to_list d) as [|h t IHl]; [now simpl|]. now case h; [now simpl|..]; simpl;intro H; exfalso; revert H; apply Nat.le_ngt; rewrite List.length_app; apply Nat.le_add_l. Qed. Lemma nzhead_app_nil_l d d' : nzhead (app d d') = Nil -> nzhead d = Nil. Proof. intro H; apply to_list_inj; generalize (f_equal to_list H); clear H. rewrite !nzhead_spec, app_spec. induction (to_list d) as [|h t IHl]; [now simpl|]. now rewrite <-List.app_comm_cons; case h. Qed. Lemma unorm_app_zero d d' : nb_digits (unorm (app d d')) <= nb_digits d' -> unorm d = zero. Proof. unfold unorm. case (uint_eq_dec (nzhead (app d d')) Nil). { now intro Hn; rewrite Hn, (nzhead_app_nil_l _ _ Hn). } intro H; fold (unorm (app d d')); rewrite (unorm_nzhead _ H); intro H'. case (uint_eq_dec (nzhead d) Nil); [now intros->|]. intro H''; fold (unorm d); rewrite (unorm_nzhead _ H''). exfalso; apply H''; revert H'; apply nzhead_app_nil. Qed. Lemma app_int_nil_r d : app_int d Nil = d. Proof. now case d; intro d'; simpl; rewrite <-(of_list_to_list (app _ _)), app_spec; rewrite List.app_nil_r, of_list_to_list. Qed. Lemma unorm_app_l d d' : nb_digits d' < nb_digits (unorm (app d d')) -> unorm (app d d') = app (unorm d) d'. Proof. case (uint_eq_dec d' Nil); [now intros->; rewrite !app_nil_r|intro Hd']. case (uint_eq_dec (nzhead (app d d')) Nil). { unfold unorm; intros->; simpl; intro H; exfalso; revert H; apply Nat.le_ngt. now revert Hd'; case d'; [|intros d'' _; apply le_n_S, Peano.le_0_n..]. } intro Ha; rewrite (unorm_nzhead _ Ha). intro Hn; generalize Hn; rewrite (nzhead_app_l _ _ Hn). rewrite !nb_digits_spec, app_spec, List.length_app. case (uint_eq_dec (nzhead d) Nil). { intros->; simpl; intro H; exfalso; revert H; apply Nat.lt_irrefl. } now intro H; rewrite (unorm_nzhead _ H). Qed. Lemma unorm_app_r d d' : nb_digits (unorm (app d d')) <= nb_digits d' -> unorm (app d d') = unorm d'. Proof. case (uint_eq_dec (nzhead (app d d')) Nil). { now unfold unorm; intro H; rewrite H, (nzhead_app_nil_r _ _ H). } intro Ha; rewrite (unorm_nzhead _ Ha). case (uint_eq_dec (nzhead d') Nil). { now intros H H'; exfalso; apply Ha; rewrite nzhead_app_r. } intro Hd'; rewrite (unorm_nzhead _ Hd'); apply nzhead_app_r. Qed. Lemma norm_app_int d d' : nb_digits d' < nb_digits (unorm (app (abs d) d')) -> norm (app_int d d') = app_int (norm d) d'. Proof. case (uint_eq_dec d' Nil); [now intros->; rewrite !app_int_nil_r|intro Hd']. case d as [d|d]; [now simpl; intro H; apply f_equal, unorm_app_l|]. simpl; unfold unorm. case (uint_eq_dec (nzhead (app d d')) Nil). { intros->; simpl; intro H; exfalso; revert H; apply Nat.le_ngt. now revert Hd'; case d'; [|intros d'' _; apply -> Nat.succ_le_mono; apply Nat.le_0_l..]. } set (m := match nzhead _ with Nil => _ | _ => _ end). intro Ha. replace m with (nzhead (app d d')). 2:{ now unfold m; revert Ha; case nzhead. } intro Hn; generalize Hn; rewrite (nzhead_app_l _ _ Hn). case (uint_eq_dec (app (nzhead d) d') Nil). { intros->; simpl; intro H; exfalso; revert H; apply Nat.le_ngt, Nat.le_0_l. } clear m; set (m := match app _ _ with Nil => _ | _ => _ end). intro Ha'. replace m with (Neg (app (nzhead d) d')); [|now unfold m; revert Ha'; case app]. case (uint_eq_dec (nzhead d) Nil). { intros->; simpl; intro H; exfalso; revert H; apply Nat.lt_irrefl. } clear m; set (m := match nzhead _ with Nil => _ | _ => _ end). intro Hd. now replace m with (Neg (nzhead d)); [|unfold m; revert Hd; case nzhead]. Qed. Lemma del_head_nb_digits d : del_head (nb_digits d) d = Nil. Proof. apply to_list_inj. rewrite nb_digits_spec, del_head_spec_small; [|now simpl]. now rewrite List.skipn_all. Qed. Lemma del_tail_nb_digits d : del_tail (nb_digits d) d = Nil. Proof. now unfold del_tail; rewrite <-nb_digits_rev, del_head_nb_digits. Qed. Lemma del_head_app n d d' : n <= nb_digits d -> del_head n (app d d') = app (del_head n d) d'. Proof. rewrite nb_digits_spec; intro Hn. apply to_list_inj. rewrite del_head_spec_small. 2:{ now rewrite app_spec, List.length_app, <- Nat.le_add_r. } rewrite !app_spec, (del_head_spec_small _ _ Hn). rewrite List.skipn_app. now rewrite (proj2 (Nat.sub_0_le _ _) Hn). Qed. Lemma del_tail_app n d d' : n <= nb_digits d' -> del_tail n (app d d') = app d (del_tail n d'). Proof. rewrite nb_digits_spec; intro Hn. unfold del_tail. rewrite <-(of_list_to_list (rev (app d d'))), rev_spec, app_spec. rewrite List.rev_app_distr, <-!rev_spec, <-app_spec, of_list_to_list. rewrite del_head_app; [|now rewrite nb_digits_spec, rev_spec, List.length_rev]. apply to_list_inj. rewrite rev_spec, !app_spec, !rev_spec. now rewrite List.rev_app_distr, List.rev_involutive. Qed. Lemma del_tail_app_int n d d' : n <= nb_digits d' -> del_tail_int n (app_int d d') = app_int d (del_tail n d'). Proof. now case d as [d|d]; simpl; intro H; rewrite del_tail_app. Qed. Lemma app_del_tail_head n (d:uint) : n <= nb_digits d -> app (del_tail n d) (del_head (nb_digits d - n) d) = d. Proof. rewrite nb_digits_spec; intro Hn; unfold del_tail. rewrite <-(of_list_to_list (app _ _)), app_spec, rev_spec. rewrite del_head_spec_small; [|now rewrite rev_spec, List.length_rev]. rewrite del_head_spec_small; [|now apply Nat.le_sub_l]. rewrite rev_spec. set (n' := _ - n). assert (Hn' : n = length (to_list d) - n'). { now rewrite <- (Nat.add_sub (length (to_list d)) n), Nat.add_comm, <- 2 Nat.add_sub_assoc, Nat.sub_diag; trivial. } now rewrite Hn', <-List.firstn_skipn_rev, List.firstn_skipn, of_list_to_list. Qed. Lemma app_int_del_tail_head n (d:int) : n <= nb_digits (abs d) -> app_int (del_tail_int n d) (del_head (nb_digits (abs d) - n) (abs d)) = d. Proof. now case d; clear d; simpl; intros u Hu; rewrite app_del_tail_head. Qed. Lemma del_head_app_int_exact i f : nb_digits f < nb_digits (unorm (app (abs i) f)) -> del_head (nb_digits (unorm (app (abs i) f)) - nb_digits f) (unorm (app (abs i) f)) = f. Proof. simpl; intro Hnb; generalize Hnb; rewrite (unorm_app_l _ _ Hnb); clear Hnb. replace (_ - _) with (nb_digits (unorm (abs i))). - now rewrite del_head_app; [rewrite del_head_nb_digits|]. - rewrite !nb_digits_spec, app_spec, List.length_app. symmetry; apply Nat.add_sub. Qed. Lemma del_tail_app_int_exact i f : nb_digits f < nb_digits (unorm (app (abs i) f)) -> del_tail_int (nb_digits f) (norm (app_int i f)) = norm i. Proof. simpl; intro Hnb. rewrite (norm_app_int _ _ Hnb). rewrite del_tail_app_int; [|now simpl]. now rewrite del_tail_nb_digits, app_int_nil_r. Qed. (** Normalization on little-endian numbers *) Fixpoint nztail d := match d with | Nil => Nil | D0 d => match nztail d with Nil => Nil | d' => D0 d' end | D1 d => D1 (nztail d) | D2 d => D2 (nztail d) | D3 d => D3 (nztail d) | D4 d => D4 (nztail d) | D5 d => D5 (nztail d) | D6 d => D6 (nztail d) | D7 d => D7 (nztail d) | D8 d => D8 (nztail d) | D9 d => D9 (nztail d) | Da d => Da (nztail d) | Db d => Db (nztail d) | Dc d => Dc (nztail d) | Dd d => Dd (nztail d) | De d => De (nztail d) | Df d => Df (nztail d) end. Definition lnorm d := match nztail d with | Nil => zero | d => d end. Lemma nzhead_revapp_0 d d' : nztail d = Nil -> nzhead (revapp d d') = nzhead d'. Proof. revert d'. induction d; intros d' [=]; simpl; trivial. destruct (nztail d); now rewrite IHd. Qed. Lemma nzhead_revapp d d' : nztail d <> Nil -> nzhead (revapp d d') = revapp (nztail d) d'. Proof. revert d'. induction d; intros d' H; simpl in *; try destruct (nztail d) eqn:E; (now rewrite ?nzhead_revapp_0) || (now rewrite IHd). Qed. Lemma nzhead_rev d : nztail d <> Nil -> nzhead (rev d) = rev (nztail d). Proof. apply nzhead_revapp. Qed. Lemma rev_rev d : rev (rev d) = d. Proof. now apply to_list_inj; rewrite !rev_spec, List.rev_involutive. Qed. Lemma rev_nztail_rev d : rev (nztail (rev d)) = nzhead d. Proof. destruct (uint_eq_dec (nztail (rev d)) Nil) as [H|H]. - rewrite H. unfold rev; simpl. rewrite <- (rev_rev d). symmetry. now apply nzhead_revapp_0. - now rewrite <- nzhead_rev, rev_rev. Qed. Lemma nzhead_D0 u : nzhead (D0 u) = nzhead u. Proof. reflexivity. Qed. Lemma nzhead_iter_D0 n u : nzhead (Nat.iter n D0 u) = nzhead u. Proof. now induction n. Qed. Lemma revapp_nil_inv d d' : revapp d d' = Nil -> d = Nil /\ d' = Nil. Proof. revert d'. induction d; simpl; intros d' H; auto; now apply IHd in H. Qed. Lemma rev_nil_inv d : rev d = Nil -> d = Nil. Proof. apply revapp_nil_inv. Qed. Lemma rev_lnorm_rev d : rev (lnorm (rev d)) = unorm d. Proof. unfold unorm, lnorm. rewrite <- rev_nztail_rev. destruct nztail; simpl; trivial; destruct rev eqn:E; trivial; now apply rev_nil_inv in E. Qed. Lemma nzhead_nonzero d d' : nzhead d <> D0 d'. Proof. induction d; easy. Qed. Lemma unorm_0 d : unorm d = zero <-> nzhead d = Nil. Proof. unfold unorm. split. - generalize (nzhead_nonzero d). destruct nzhead; intros H [=]; trivial. now destruct (H u). - now intros ->. Qed. Lemma unorm_nonnil d : unorm d <> Nil. Proof. unfold unorm. now destruct nzhead. Qed. Lemma unorm_iter_D0 n u : unorm (Nat.iter n D0 u) = unorm u. Proof. now induction n. Qed. Lemma del_head_nonnil n u : n < nb_digits u -> del_head n u <> Nil. Proof. now revert n; induction u; intro n; [|case n; [|intro n'; simpl; intro H; apply IHu, Nat.succ_lt_mono]..]. Qed. Lemma del_tail_nonnil n u : n < nb_digits u -> del_tail n u <> Nil. Proof. unfold del_tail. rewrite <-nb_digits_rev. generalize (rev u); clear u; intro u. intros Hu H. generalize (rev_nil_inv _ H); clear H. now apply del_head_nonnil. Qed. Lemma nzhead_involutive d : nzhead (nzhead d) = nzhead d. Proof. now induction d. Qed. Lemma nztail_involutive d : nztail (nztail d) = nztail d. Proof. rewrite <-(rev_rev (nztail _)), <-(rev_rev (nztail d)), <-(rev_rev d). now rewrite !rev_nztail_rev, nzhead_involutive. Qed. Lemma unorm_involutive d : unorm (unorm d) = unorm d. Proof. unfold unorm. destruct (nzhead d) eqn:E; trivial. destruct (nzhead_nonzero _ _ E). Qed. Lemma norm_involutive d : norm (norm d) = norm d. Proof. unfold norm. destruct d. - f_equal. apply unorm_involutive. - destruct (nzhead d) eqn:E; auto. destruct (nzhead_nonzero _ _ E). Qed. Lemma lnzhead_neq_d0_head l l' : ~(lnzhead l = cons d0 l'). Proof. now induction l as [|h t Il]; [|case h]. Qed. Lemma lnzhead_head_nd0 h t : h <> d0 -> lnzhead (cons h t) = cons h t. Proof. now case h. Qed. Lemma nzhead_del_tail_nzhead_eq n u : nzhead u = u -> n < nb_digits u -> nzhead (del_tail n u) = del_tail n u. Proof. rewrite nb_digits_spec, <-List.length_rev. intros Hu Hn. apply to_list_inj; unfold del_tail. rewrite nzhead_spec, rev_spec. rewrite del_head_spec_small; [|now rewrite rev_spec; apply Nat.lt_le_incl]. rewrite rev_spec. rewrite List.skipn_rev, List.rev_involutive. generalize (f_equal to_list Hu) Hn; rewrite nzhead_spec; intro Hu'. case (to_list u) as [|h t]. { simpl; intro H; exfalso; revert H; apply Nat.le_ngt, Nat.le_0_l. } intro Hn'; generalize (Nat.sub_gt _ _ Hn'); rewrite List.length_rev. case (_ - _); [now simpl|]; intros n' _. rewrite List.firstn_cons, lnzhead_head_nd0; [now simpl|]. intro Hh; revert Hu'; rewrite Hh; apply lnzhead_neq_d0_head. Qed. Lemma nzhead_del_tail_nzhead n u : n < nb_digits (nzhead u) -> nzhead (del_tail n (nzhead u)) = del_tail n (nzhead u). Proof. apply nzhead_del_tail_nzhead_eq, nzhead_involutive. Qed. Lemma unorm_del_tail_unorm n u : n < nb_digits (unorm u) -> unorm (del_tail n (unorm u)) = del_tail n (unorm u). Proof. case (uint_eq_dec (nzhead u) Nil). - unfold unorm; intros->; case n; [now simpl|]; intro n'. now simpl; intro H; exfalso; generalize (proj2 (Nat.succ_lt_mono _ _) H). - unfold unorm. set (m := match nzhead u with Nil => zero | _ => _ end). intros H. replace m with (nzhead u). + intros H'. rewrite (nzhead_del_tail_nzhead _ _ H'). now generalize (del_tail_nonnil _ _ H'); case del_tail. + now unfold m; revert H; case nzhead. Qed. Lemma norm_del_tail_int_norm n d : n < nb_digits (match norm d with Pos d | Neg d => d end) -> norm (del_tail_int n (norm d)) = del_tail_int n (norm d). Proof. case d; clear d; intros u; simpl. - now intro H; simpl; rewrite unorm_del_tail_unorm. - case (uint_eq_dec (nzhead u) Nil); intro Hu. + now rewrite Hu; case n; [|intros n' Hn'; generalize (proj2 (Nat.succ_lt_mono _ _) Hn')]. + set (m := match nzhead u with Nil => Pos zero | _ => _ end). replace m with (Neg (nzhead u)); [|now unfold m; revert Hu; case nzhead]. unfold del_tail_int. clear m Hu. simpl. intro H; generalize (del_tail_nonnil _ _ H). rewrite (nzhead_del_tail_nzhead _ _ H). now case del_tail. Qed. Lemma nzhead_app_nzhead d d' : nzhead (app (nzhead d) d') = nzhead (app d d'). Proof. unfold app. rewrite <-(rev_nztail_rev d), rev_rev. generalize (rev d); clear d; intro d. generalize (nzhead_revapp_0 d d'). generalize (nzhead_revapp d d'). generalize (nzhead_revapp_0 (nztail d) d'). generalize (nzhead_revapp (nztail d) d'). rewrite nztail_involutive. now case nztail; [intros _ H _ H'; rewrite (H eq_refl), (H' eq_refl) |intros d'' H _ H' _; rewrite H; [rewrite H'|]..]. Qed. Lemma unorm_app_unorm d d' : unorm (app (unorm d) d') = unorm (app d d'). Proof. unfold unorm. rewrite <-(nzhead_app_nzhead d d'). now case (nzhead d). Qed. Lemma norm_app_int_norm d d' : unorm d' = zero -> norm (app_int (norm d) d') = norm (app_int d d'). Proof. case d; clear d; intro d; simpl. - now rewrite unorm_app_unorm. - unfold app_int, app. rewrite unorm_0; intro Hd'. rewrite <-rev_nztail_rev. generalize (nzhead_revapp (rev d) d'). generalize (nzhead_revapp_0 (rev d) d'). now case_eq (nztail (rev d)); [intros Hd'' H _; rewrite (H eq_refl); simpl; unfold unorm; simpl; rewrite Hd' |intros d'' Hd'' _ H; rewrite H; clear H; [|now simpl]; set (r := rev _); set (m := match r with Nil => Pos zero | _ => _ end); assert (H' : m = Neg r); [now unfold m; case_eq r; unfold r; [intro H''; generalize (rev_nil_inv _ H'')|..] |rewrite H'; unfold r; clear m r H']; unfold norm; rewrite rev_rev, <-Hd''; rewrite nzhead_revapp; rewrite nztail_involutive; [|rewrite Hd'']..]. Qed. coq-8.20.0/theories/Numbers/HexadecimalN.v000066400000000000000000000061701466560755400203570ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* n = n'. Proof. intros E. now rewrite <- (of_to n), <- (of_to n'), E. Qed. Lemma to_uint_surj d : exists p, N.to_hex_uint p = unorm d. Proof. exists (N.of_hex_uint d). apply to_of. Qed. Lemma of_uint_norm d : N.of_hex_uint (unorm d) = N.of_hex_uint d. Proof. now induction d. Qed. Lemma of_inj d d' : N.of_hex_uint d = N.of_hex_uint d' -> unorm d = unorm d'. Proof. intros. rewrite <- !to_of. now f_equal. Qed. Lemma of_iff d d' : N.of_hex_uint d = N.of_hex_uint d' <-> unorm d = unorm d'. Proof. split. - apply of_inj. - intros E. rewrite <- of_uint_norm, E. apply of_uint_norm. Qed. End Unsigned. (** Conversion from/to signed hexadecimal numbers *) Module Signed. Lemma of_to (n:N) : N.of_hex_int (N.to_hex_int n) = Some n. Proof. unfold N.to_hex_int, N.of_hex_int, norm. f_equal. rewrite Unsigned.of_uint_norm. apply Unsigned.of_to. Qed. Lemma to_of (d:int)(n:N) : N.of_hex_int d = Some n -> N.to_hex_int n = norm d. Proof. unfold N.of_hex_int. destruct (norm d) eqn:Hd; intros [= <-]. unfold N.to_hex_int. rewrite Unsigned.to_of. f_equal. revert Hd; destruct d; simpl. - intros [= <-]. apply unorm_involutive. - destruct (nzhead d); now intros [= <-]. Qed. Lemma to_int_inj n n' : N.to_hex_int n = N.to_hex_int n' -> n = n'. Proof. intro E. assert (E' : Some n = Some n'). { now rewrite <- (of_to n), <- (of_to n'), E. } now injection E'. Qed. Lemma to_int_pos_surj d : exists n, N.to_hex_int n = norm (Pos d). Proof. exists (N.of_hex_uint d). unfold N.to_hex_int. now rewrite Unsigned.to_of. Qed. Lemma of_int_norm d : N.of_hex_int (norm d) = N.of_hex_int d. Proof. unfold N.of_hex_int. now rewrite norm_involutive. Qed. Lemma of_inj_pos d d' : N.of_hex_int (Pos d) = N.of_hex_int (Pos d') -> unorm d = unorm d'. Proof. unfold N.of_hex_int. simpl. intros [= H]. apply Unsigned.of_inj. change Pos.of_hex_uint with N.of_hex_uint in H. now rewrite <- Unsigned.of_uint_norm, H, Unsigned.of_uint_norm. Qed. End Signed. coq-8.20.0/theories/Numbers/HexadecimalNat.v000066400000000000000000000202611466560755400207010ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* 0x0 | D0 _ => 0x0 | D1 _ => 0x1 | D2 _ => 0x2 | D3 _ => 0x3 | D4 _ => 0x4 | D5 _ => 0x5 | D6 _ => 0x6 | D7 _ => 0x7 | D8 _ => 0x8 | D9 _ => 0x9 | Da _ => 0xa | Db _ => 0xb | Dc _ => 0xc | Dd _ => 0xd | De _ => 0xe | Df _ => 0xf end. Definition tl d := match d with | Nil => d | D0 d | D1 d | D2 d | D3 d | D4 d | D5 d | D6 d | D7 d | D8 d | D9 d | Da d | Db d | Dc d | Dd d | De d | Df d => d end. Fixpoint usize (d:uint) : nat := match d with | Nil => 0 | D0 d => S (usize d) | D1 d => S (usize d) | D2 d => S (usize d) | D3 d => S (usize d) | D4 d => S (usize d) | D5 d => S (usize d) | D6 d => S (usize d) | D7 d => S (usize d) | D8 d => S (usize d) | D9 d => S (usize d) | Da d => S (usize d) | Db d => S (usize d) | Dc d => S (usize d) | Dd d => S (usize d) | De d => S (usize d) | Df d => S (usize d) end. (** A direct version of [to_little_uint], not tail-recursive *) Fixpoint to_lu n := match n with | 0 => Hexadecimal.zero | S n => Little.succ (to_lu n) end. (** A direct version of [of_little_uint] *) Fixpoint of_lu (d:uint) : nat := match d with | Nil => 0x0 | D0 d => 0x10 * of_lu d | D1 d => 0x1 + 0x10 * of_lu d | D2 d => 0x2 + 0x10 * of_lu d | D3 d => 0x3 + 0x10 * of_lu d | D4 d => 0x4 + 0x10 * of_lu d | D5 d => 0x5 + 0x10 * of_lu d | D6 d => 0x6 + 0x10 * of_lu d | D7 d => 0x7 + 0x10 * of_lu d | D8 d => 0x8 + 0x10 * of_lu d | D9 d => 0x9 + 0x10 * of_lu d | Da d => 0xa + 0x10 * of_lu d | Db d => 0xb + 0x10 * of_lu d | Dc d => 0xc + 0x10 * of_lu d | Dd d => 0xd + 0x10 * of_lu d | De d => 0xe + 0x10 * of_lu d | Df d => 0xf + 0x10 * of_lu d end. (** Properties of [to_lu] *) Lemma to_lu_succ n : to_lu (S n) = Little.succ (to_lu n). Proof. reflexivity. Qed. Lemma to_little_uint_succ n d : Nat.to_little_hex_uint n (Little.succ d) = Little.succ (Nat.to_little_hex_uint n d). Proof. revert d; induction n; simpl; trivial. Qed. Lemma to_lu_equiv n : to_lu n = Nat.to_little_hex_uint n zero. Proof. induction n; simpl; trivial. now rewrite IHn, <- to_little_uint_succ. Qed. Lemma to_uint_alt n : Nat.to_hex_uint n = rev (to_lu n). Proof. unfold Nat.to_hex_uint. f_equal. symmetry. apply to_lu_equiv. Qed. (** Properties of [of_lu] *) Lemma of_lu_eqn d : of_lu d = hd d + 0x10 * of_lu (tl d). Proof. induction d; simpl; trivial. Qed. Ltac simpl_of_lu := match goal with | |- context [ of_lu (?f ?x) ] => rewrite (of_lu_eqn (f x)); simpl hd; simpl tl end. Lemma of_lu_succ d : of_lu (Little.succ d) = S (of_lu d). Proof. induction d; trivial. simpl_of_lu. rewrite IHd. simpl_of_lu. now rewrite Nat.mul_succ_r, <- (Nat.add_comm 0x10). Qed. Lemma of_to_lu n : of_lu (to_lu n) = n. Proof. induction n; simpl; trivial. rewrite of_lu_succ. now f_equal. Qed. Lemma of_lu_revapp d d' : of_lu (revapp d d') = of_lu (rev d) + of_lu d' * 0x10^usize d. Proof. revert d'. induction d; intro d'; simpl usize; [ simpl; now rewrite Nat.mul_1_r | .. ]; unfold rev; simpl revapp; rewrite 2 IHd; rewrite <- Nat.add_assoc; f_equal; simpl_of_lu; simpl of_lu; rewrite Nat.pow_succ_r'; ring. Qed. Lemma of_uint_acc_spec n d : Nat.of_hex_uint_acc d n = of_lu (rev d) + n * 0x10^usize d. Proof. revert n. induction d; intros; simpl Nat.of_hex_uint_acc; rewrite ?Nat.tail_mul_spec, ?IHd; simpl rev; simpl usize; rewrite ?Nat.pow_succ_r'; [ simpl; now rewrite Nat.mul_1_r | .. ]; unfold rev at 2; simpl revapp; rewrite of_lu_revapp; simpl of_lu; ring. Qed. Lemma of_uint_alt d : Nat.of_hex_uint d = of_lu (rev d). Proof. unfold Nat.of_hex_uint. now rewrite of_uint_acc_spec. Qed. (** First main bijection result *) Lemma of_to (n:nat) : Nat.of_hex_uint (Nat.to_hex_uint n) = n. Proof. rewrite to_uint_alt, of_uint_alt, rev_rev. apply of_to_lu. Qed. (** The other direction *) Lemma to_lu_sixteenfold n : n<>0 -> to_lu (0x10 * n) = D0 (to_lu n). Proof. induction n. - simpl. now destruct 1. - intros _. destruct (Nat.eq_dec n 0) as [->|H]; simpl; trivial. rewrite !Nat.add_succ_r. simpl in *. rewrite (IHn H). now destruct (to_lu n). Qed. Lemma of_lu_0 d : of_lu d = 0 <-> nztail d = Nil. Proof. induction d; try simpl_of_lu; try easy. rewrite Nat.add_0_l. split; intros H. - apply Nat.eq_mul_0_r in H; auto. rewrite IHd in H. simpl. now rewrite H. - simpl in H. destruct (nztail d); try discriminate. now destruct IHd as [_ ->]. Qed. Lemma to_of_lu_sixteenfold d : to_lu (of_lu d) = lnorm d -> to_lu (0x10 * of_lu d) = lnorm (D0 d). Proof. intro IH. destruct (Nat.eq_dec (of_lu d) 0) as [H|H]. - rewrite H. simpl. rewrite of_lu_0 in H. unfold lnorm. simpl. now rewrite H. - rewrite (to_lu_sixteenfold _ H), IH. rewrite of_lu_0 in H. unfold lnorm. simpl. now destruct (nztail d). Qed. Lemma to_of_lu d : to_lu (of_lu d) = lnorm d. Proof. induction d; [ reflexivity | .. ]; simpl_of_lu; rewrite ?Nat.add_succ_l, Nat.add_0_l, ?to_lu_succ, to_of_lu_sixteenfold by assumption; unfold lnorm; cbn; now destruct nztail. Qed. (** Second bijection result *) Lemma to_of (d:uint) : Nat.to_hex_uint (Nat.of_hex_uint d) = unorm d. Proof. rewrite to_uint_alt, of_uint_alt, to_of_lu. apply rev_lnorm_rev. Qed. (** Some consequences *) Lemma to_uint_inj n n' : Nat.to_hex_uint n = Nat.to_hex_uint n' -> n = n'. Proof. intro EQ. now rewrite <- (of_to n), <- (of_to n'), EQ. Qed. Lemma to_uint_surj d : exists n, Nat.to_hex_uint n = unorm d. Proof. exists (Nat.of_hex_uint d). apply to_of. Qed. Lemma of_uint_norm d : Nat.of_hex_uint (unorm d) = Nat.of_hex_uint d. Proof. unfold Nat.of_hex_uint. now induction d. Qed. Lemma of_inj d d' : Nat.of_hex_uint d = Nat.of_hex_uint d' -> unorm d = unorm d'. Proof. intros. rewrite <- !to_of. now f_equal. Qed. Lemma of_iff d d' : Nat.of_hex_uint d = Nat.of_hex_uint d' <-> unorm d = unorm d'. Proof. split. - apply of_inj. - intros E. rewrite <- of_uint_norm, E. apply of_uint_norm. Qed. End Unsigned. (** Conversion from/to signed hexadecimal numbers *) Module Signed. Lemma of_to (n:nat) : Nat.of_hex_int (Nat.to_hex_int n) = Some n. Proof. unfold Nat.to_hex_int, Nat.of_hex_int, norm. f_equal. rewrite Unsigned.of_uint_norm. apply Unsigned.of_to. Qed. Lemma to_of (d:int)(n:nat) : Nat.of_hex_int d = Some n -> Nat.to_hex_int n = norm d. Proof. unfold Nat.of_hex_int. destruct (norm d) eqn:Hd; intros [= <-]. unfold Nat.to_hex_int. rewrite Unsigned.to_of. f_equal. revert Hd; destruct d; simpl. - intros [= <-]. apply unorm_involutive. - destruct (nzhead d); now intros [= <-]. Qed. Lemma to_int_inj n n' : Nat.to_hex_int n = Nat.to_hex_int n' -> n = n'. Proof. intro E. assert (E' : Some n = Some n'). { now rewrite <- (of_to n), <- (of_to n'), E. } now injection E'. Qed. Lemma to_int_pos_surj d : exists n, Nat.to_hex_int n = norm (Pos d). Proof. exists (Nat.of_hex_uint d). unfold Nat.to_hex_int. now rewrite Unsigned.to_of. Qed. Lemma of_int_norm d : Nat.of_hex_int (norm d) = Nat.of_hex_int d. Proof. unfold Nat.of_hex_int. now rewrite norm_involutive. Qed. Lemma of_inj_pos d d' : Nat.of_hex_int (Pos d) = Nat.of_hex_int (Pos d') -> unorm d = unorm d'. Proof. unfold Nat.of_hex_int. simpl. intros [= H]. apply Unsigned.of_inj. now rewrite <- Unsigned.of_uint_norm, H, Unsigned.of_uint_norm. Qed. End Signed. coq-8.20.0/theories/Numbers/HexadecimalPos.v000066400000000000000000000276031466560755400207270ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* 0 | D0 d => 0x10 * of_lu d | D1 d => 0x1 + 0x10 * of_lu d | D2 d => 0x2 + 0x10 * of_lu d | D3 d => 0x3 + 0x10 * of_lu d | D4 d => 0x4 + 0x10 * of_lu d | D5 d => 0x5 + 0x10 * of_lu d | D6 d => 0x6 + 0x10 * of_lu d | D7 d => 0x7 + 0x10 * of_lu d | D8 d => 0x8 + 0x10 * of_lu d | D9 d => 0x9 + 0x10 * of_lu d | Da d => 0xa + 0x10 * of_lu d | Db d => 0xb + 0x10 * of_lu d | Dc d => 0xc + 0x10 * of_lu d | Dd d => 0xd + 0x10 * of_lu d | De d => 0xe + 0x10 * of_lu d | Df d => 0xf + 0x10 * of_lu d end. Definition hd d := match d with | Nil => 0x0 | D0 _ => 0x0 | D1 _ => 0x1 | D2 _ => 0x2 | D3 _ => 0x3 | D4 _ => 0x4 | D5 _ => 0x5 | D6 _ => 0x6 | D7 _ => 0x7 | D8 _ => 0x8 | D9 _ => 0x9 | Da _ => 0xa | Db _ => 0xb | Dc _ => 0xc | Dd _ => 0xd | De _ => 0xe | Df _ => 0xf end. Definition tl d := match d with | Nil => d | D0 d | D1 d | D2 d | D3 d | D4 d | D5 d | D6 d | D7 d | D8 d | D9 d | Da d | Db d | Dc d | Dd d | De d | Df d => d end. Lemma of_lu_eqn d : of_lu d = hd d + 0x10 * (of_lu (tl d)). Proof. induction d; simpl; trivial. Qed. Ltac simpl_of_lu := match goal with | |- context [ of_lu (?f ?x) ] => rewrite (of_lu_eqn (f x)); simpl hd; simpl tl end. Fixpoint usize (d:uint) : N := match d with | Nil => 0 | D0 d => N.succ (usize d) | D1 d => N.succ (usize d) | D2 d => N.succ (usize d) | D3 d => N.succ (usize d) | D4 d => N.succ (usize d) | D5 d => N.succ (usize d) | D6 d => N.succ (usize d) | D7 d => N.succ (usize d) | D8 d => N.succ (usize d) | D9 d => N.succ (usize d) | Da d => N.succ (usize d) | Db d => N.succ (usize d) | Dc d => N.succ (usize d) | Dd d => N.succ (usize d) | De d => N.succ (usize d) | Df d => N.succ (usize d) end. Lemma of_lu_revapp d d' : of_lu (revapp d d') = of_lu (rev d) + of_lu d' * 0x10^usize d. Proof. revert d'. induction d; simpl; intro d'; [ now rewrite N.mul_1_r | .. ]; unfold rev; simpl revapp; rewrite 2 IHd; rewrite <- N.add_assoc; f_equal; simpl_of_lu; simpl of_lu; rewrite N.pow_succ_r'; ring. Qed. Definition Nadd n p := match n with | N0 => p | Npos p0 => (p0+p)%positive end. Lemma Nadd_simpl n p q : Npos (Nadd n (p * q)) = n + Npos p * Npos q. Proof. now destruct n. Qed. Lemma of_uint_acc_eqn d acc : d<>Nil -> Pos.of_hex_uint_acc d acc = Pos.of_hex_uint_acc (tl d) (Nadd (hd d) (0x10*acc)). Proof. destruct d; simpl; trivial. now destruct 1. Qed. Lemma of_uint_acc_rev d acc : Npos (Pos.of_hex_uint_acc d acc) = of_lu (rev d) + (Npos acc) * 0x10^usize d. Proof. revert acc. induction d; intros; simpl usize; [ simpl; now rewrite Pos.mul_1_r | .. ]; rewrite N.pow_succ_r'; unfold rev; simpl revapp; try rewrite of_lu_revapp; simpl of_lu; rewrite of_uint_acc_eqn by easy; simpl tl; simpl hd; rewrite IHd, Nadd_simpl; ring. Qed. Lemma of_uint_alt d : Pos.of_hex_uint d = of_lu (rev d). Proof. induction d; simpl; trivial; unfold rev; simpl revapp; rewrite of_lu_revapp; simpl of_lu; try apply of_uint_acc_rev. rewrite IHd. ring. Qed. Lemma of_lu_rev d : Pos.of_hex_uint (rev d) = of_lu d. Proof. rewrite of_uint_alt. now rewrite rev_rev. Qed. Lemma of_lu_double_gen d : of_lu (Little.double d) = N.double (of_lu d) /\ of_lu (Little.succ_double d) = N.succ_double (of_lu d). Proof. rewrite N.double_spec, N.succ_double_spec. induction d; try destruct IHd as (IH1,IH2); simpl Little.double; simpl Little.succ_double; repeat (simpl_of_lu; rewrite ?IH1, ?IH2); split; reflexivity || ring. Qed. Lemma of_lu_double d : of_lu (Little.double d) = N.double (of_lu d). Proof. apply of_lu_double_gen. Qed. Lemma of_lu_succ_double d : of_lu (Little.succ_double d) = N.succ_double (of_lu d). Proof. apply of_lu_double_gen. Qed. (** First bijection result *) Lemma of_to (p:positive) : Pos.of_hex_uint (Pos.to_hex_uint p) = Npos p. Proof. unfold Pos.to_hex_uint. rewrite of_lu_rev. induction p; simpl; trivial. - now rewrite of_lu_succ_double, IHp. - now rewrite of_lu_double, IHp. Qed. (** The other direction *) Definition to_lu n := match n with | N0 => Hexadecimal.zero | Npos p => Pos.to_little_hex_uint p end. Lemma succ_double_alt d : Little.succ_double d = Little.succ (Little.double d). Proof. now induction d. Qed. Lemma double_succ d : Little.double (Little.succ d) = Little.succ (Little.succ_double d). Proof. induction d; simpl; f_equal; auto using succ_double_alt. Qed. Lemma to_lu_succ n : to_lu (N.succ n) = Little.succ (to_lu n). Proof. destruct n; simpl; trivial. induction p; simpl; rewrite ?IHp; auto using succ_double_alt, double_succ. Qed. Lemma nat_iter_S n {A} (f:A->A) i : Nat.iter (S n) f i = f (Nat.iter n f i). Proof. reflexivity. Qed. Lemma nat_iter_0 {A} (f:A->A) i : Nat.iter 0 f i = i. Proof. reflexivity. Qed. Lemma to_lhex_tenfold p : to_lu (0x10 * Npos p) = D0 (to_lu (Npos p)). Proof. induction p using Pos.peano_rect. - trivial. - change (N.pos (Pos.succ p)) with (N.succ (N.pos p)). rewrite N.mul_succ_r. change 0x10 with (Nat.iter 0x10%nat N.succ 0) at 2. rewrite ?nat_iter_S, nat_iter_0. rewrite !N.add_succ_r, N.add_0_r, !to_lu_succ, IHp. destruct (to_lu (N.pos p)); simpl; auto. Qed. Lemma of_lu_0 d : of_lu d = 0 <-> nztail d = Nil. Proof. induction d; try simpl_of_lu; split; trivial; try discriminate; try (intros H; now apply N.eq_add_0 in H). - rewrite N.add_0_l. intros H. apply N.eq_mul_0_r in H; [|easy]. rewrite IHd in H. simpl. now rewrite H. - simpl. destruct (nztail d); try discriminate. now destruct IHd as [_ ->]. Qed. Lemma to_of_lu_tenfold d : to_lu (of_lu d) = lnorm d -> to_lu (0x10 * of_lu d) = lnorm (D0 d). Proof. intro IH. destruct (N.eq_dec (of_lu d) 0) as [H|H]. - rewrite H. simpl. rewrite of_lu_0 in H. unfold lnorm. simpl. now rewrite H. - destruct (of_lu d) eqn:Eq; [easy| ]. rewrite to_lhex_tenfold; auto. rewrite IH. rewrite <- Eq in H. rewrite of_lu_0 in H. unfold lnorm. simpl. now destruct (nztail d). Qed. Lemma Nadd_alt n m : n + m = Nat.iter (N.to_nat n) N.succ m. Proof. destruct n. 1:trivial. induction p using Pos.peano_rect. - now rewrite N.add_1_l. - change (N.pos (Pos.succ p)) with (N.succ (N.pos p)). now rewrite N.add_succ_l, IHp, N2Nat.inj_succ. Qed. Ltac simpl_to_nat := simpl N.to_nat; unfold Pos.to_nat; simpl Pos.iter_op. Lemma to_of_lu d : to_lu (of_lu d) = lnorm d. Proof. induction d; [reflexivity|..]; simpl_of_lu; rewrite Nadd_alt; simpl_to_nat; rewrite ?nat_iter_S, nat_iter_0, ?to_lu_succ, to_of_lu_tenfold by assumption; unfold lnorm; simpl nztail; destruct nztail; reflexivity. Qed. (** Second bijection result *) Lemma to_of (d:uint) : N.to_hex_uint (Pos.of_hex_uint d) = unorm d. Proof. rewrite of_uint_alt. unfold N.to_hex_uint, Pos.to_hex_uint. destruct (of_lu (rev d)) eqn:H. - rewrite of_lu_0 in H. rewrite <- rev_lnorm_rev. unfold lnorm. now rewrite H. - change (Pos.to_little_hex_uint p) with (to_lu (N.pos p)). rewrite <- H. rewrite to_of_lu. apply rev_lnorm_rev. Qed. (** Some consequences *) Lemma to_uint_nonzero p : Pos.to_hex_uint p <> zero. Proof. intro E. generalize (of_to p). now rewrite E. Qed. Lemma to_uint_nonnil p : Pos.to_hex_uint p <> Nil. Proof. intros E. generalize (of_to p). now rewrite E. Qed. Lemma to_uint_inj p p' : Pos.to_hex_uint p = Pos.to_hex_uint p' -> p = p'. Proof. intro E. assert (E' : N.pos p = N.pos p'). { now rewrite <- (of_to p), <- (of_to p'), E. } now injection E'. Qed. Lemma to_uint_pos_surj d : unorm d<>zero -> exists p, Pos.to_hex_uint p = unorm d. Proof. intros. destruct (Pos.of_hex_uint d) eqn:E. - destruct H. generalize (to_of d). now rewrite E. - exists p. generalize (to_of d). now rewrite E. Qed. Lemma of_uint_norm d : Pos.of_hex_uint (unorm d) = Pos.of_hex_uint d. Proof. now induction d. Qed. Lemma of_inj d d' : Pos.of_hex_uint d = Pos.of_hex_uint d' -> unorm d = unorm d'. Proof. intros. rewrite <- !to_of. now f_equal. Qed. Lemma of_iff d d' : Pos.of_hex_uint d = Pos.of_hex_uint d' <-> unorm d = unorm d'. Proof. split. - apply of_inj. - intros E. rewrite <- of_uint_norm, E. apply of_uint_norm. Qed. (* various lemmas *) Lemma nztail_to_hex_uint p : let (h, n) := Hexadecimal.nztail (Pos.to_hex_uint p) in Npos p = Pos.of_hex_uint h * 0x10^(N.of_nat n). Proof. rewrite <-(of_to p), <-(rev_rev (Pos.to_hex_uint p)), of_lu_rev. unfold Hexadecimal.nztail. rewrite rev_rev. induction (rev (Pos.to_hex_uint p)); [reflexivity| | now simpl N.of_nat; simpl N.pow; rewrite N.mul_1_r, of_lu_rev..]. revert IHu. set (t := _ u); case t; clear t; intros u0 n H. rewrite of_lu_eqn; unfold hd, tl. rewrite N.add_0_l, H, Nat2N.inj_succ, N.pow_succ_r'; ring. Qed. Definition double d := rev (Little.double (rev d)). Lemma double_unorm d : double (unorm d) = unorm (double d). Proof. unfold double. rewrite <-!rev_lnorm_rev, !rev_rev, <-!to_of_lu, of_lu_double. now case of_lu; [now simpl|]; intro p; induction p. Qed. Lemma double_nzhead d : double (nzhead d) = nzhead (double d). Proof. unfold double. rewrite <-!rev_nztail_rev, !rev_rev. apply f_equal; generalize (rev d); clear d; intro d. cut (Little.double (nztail d) = nztail (Little.double d) /\ Little.succ_double (nztail d) = nztail (Little.succ_double d)). { now simpl. } now induction d; [|split; simpl; rewrite <-?(proj1 IHd), <-?(proj2 IHd); case nztail..]. Qed. Lemma of_hex_uint_double d : Pos.of_hex_uint (double d) = N.double (Pos.of_hex_uint d). Proof. now unfold double; rewrite of_lu_rev, of_lu_double, <-of_lu_rev, rev_rev. Qed. End Unsigned. (** Conversion from/to signed decimal numbers *) Module Signed. Lemma of_to (p:positive) : Pos.of_hex_int (Pos.to_hex_int p) = Some p. Proof. unfold Pos.to_hex_int, Pos.of_hex_int, norm. now rewrite Unsigned.of_to. Qed. Lemma to_of (d:int)(p:positive) : Pos.of_hex_int d = Some p -> Pos.to_hex_int p = norm d. Proof. unfold Pos.of_hex_int. destruct d; [ | intros [=]]. simpl norm. rewrite <- Unsigned.to_of. destruct (Pos.of_hex_uint d); now intros [= <-]. Qed. Lemma to_int_inj p p' : Pos.to_hex_int p = Pos.to_hex_int p' -> p = p'. Proof. intro E. assert (E' : Some p = Some p'). { now rewrite <- (of_to p), <- (of_to p'), E. } now injection E'. Qed. Lemma to_int_pos_surj d : unorm d <> zero -> exists p, Pos.to_hex_int p = norm (Pos d). Proof. simpl. unfold Pos.to_hex_int. intros H. destruct (Unsigned.to_uint_pos_surj d H) as (p,Hp). exists p. now f_equal. Qed. Lemma of_int_norm d : Pos.of_hex_int (norm d) = Pos.of_hex_int d. Proof. unfold Pos.of_int. destruct d. - simpl. now rewrite Unsigned.of_uint_norm. - simpl. now destruct (nzhead d) eqn:H. Qed. Lemma of_inj_pos d d' : Pos.of_hex_int (Pos d) = Pos.of_hex_int (Pos d') -> unorm d = unorm d'. Proof. unfold Pos.of_hex_int. destruct (Pos.of_hex_uint d) eqn:Hd, (Pos.of_hex_uint d') eqn:Hd'; intros [=]. - apply Unsigned.of_inj; now rewrite Hd, Hd'. - apply Unsigned.of_inj; rewrite Hd, Hd'; now f_equal. Qed. End Signed. coq-8.20.0/theories/Numbers/HexadecimalQ.v000066400000000000000000000461541466560755400203700ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* True | Some (HexadecimalExp _ _ _) => False | Some (Hexadecimal i f) => of_hexadecimal (Hexadecimal i f) = IQmake (IZ_of_Z num) den end. Proof. unfold IQmake_to_hexadecimal. generalize (Unsigned.nztail_to_hex_uint den). case Hexadecimal.nztail; intros den' e_den'. case den'; [now simpl|now simpl| |now simpl..]; clear den'; intro den'. case den'; [ |now simpl..]; clear den'. case e_den' as [|e_den']; simpl; injection 1 as ->. { now unfold of_hexadecimal; simpl; rewrite app_int_nil_r, HexadecimalZ.of_to. } replace (16 ^ _)%positive with (Nat.iter (S e_den') (Pos.mul 16) 1%positive). 2:{ induction e_den' as [|n IHn]; [now simpl| ]. now rewrite SuccNat2Pos.inj_succ, Pos.pow_succ_r, <-IHn. } case Nat.ltb_spec; intro He_den'. - unfold of_hexadecimal; simpl. rewrite app_int_del_tail_head; [|now apply Nat.lt_le_incl]. rewrite HexadecimalZ.of_to. now rewrite nb_digits_del_head_sub; [|now apply Nat.lt_le_incl]. - unfold of_hexadecimal; simpl. rewrite nb_digits_iter_D0. apply f_equal2. + apply f_equal, HexadecimalZ.to_int_inj. rewrite HexadecimalZ.to_of. rewrite <-(HexadecimalZ.of_to num), HexadecimalZ.to_of. case (Z.to_hex_int num); clear He_den' num; intro num; simpl. * unfold app; simpl. now rewrite unorm_D0, unorm_iter_D0, unorm_involutive. * case (uint_eq_dec (nzhead num) Nil); [|intro Hn]. { intros->; simpl; unfold app; simpl. now rewrite unorm_D0, unorm_iter_D0. } replace (match nzhead num with Nil => _ | _ => _ end) with (Neg (nzhead num)); [|now revert Hn; case nzhead]. simpl. rewrite nzhead_iter_D0, nzhead_involutive. now revert Hn; case nzhead. + revert He_den'; case nb_digits as [|n]; [now simpl; rewrite Nat.add_0_r|]. intro Hn. rewrite Nat.add_succ_r, Nat.sub_add; [|apply le_S_n]; auto. Qed. Lemma IZ_of_Z_IZ_to_Z z z' : IZ_to_Z z = Some z' -> IZ_of_Z z' = z. Proof. now case z as [| |p|p]; [| injection 1 as <- ..]. Qed. Lemma of_IQmake_to_hexadecimal' num den : match IQmake_to_hexadecimal' num den with | None => True | Some (HexadecimalExp _ _ _) => False | Some (Hexadecimal i f) => of_hexadecimal (Hexadecimal i f) = IQmake num den end. Proof. unfold IQmake_to_hexadecimal'. case_eq (IZ_to_Z num); [intros num' Hnum'|now simpl]. generalize (of_IQmake_to_hexadecimal num' den). case IQmake_to_hexadecimal as [d|]; [|now simpl]. case d as [i f|]; [|now simpl]. now rewrite (IZ_of_Z_IZ_to_Z _ _ Hnum'). Qed. Lemma of_to (q:IQ) : forall d, to_hexadecimal q = Some d -> of_hexadecimal d = q. Proof. intro d. case q as [num den|q q'|q q']; simpl. - generalize (of_IQmake_to_hexadecimal' num den). case IQmake_to_hexadecimal' as [d'|]; [|now simpl]. case d' as [i f|]; [|now simpl]. now intros H; injection 1 as <-. - case q as [num den| |]; [|now simpl..]. case q' as [num' den'| |]; [|now simpl..]. case num' as [z p| | |]; [|now simpl..]. case (Z.eq_dec z 2); [intros->|]. 2:{ case z; [now simpl| |now simpl]; intro pz'. case pz'; [intros d0..| ]; [now simpl| |now simpl]. now case d0. } case (Pos.eq_dec den' 1%positive); [intros->|now case den']. generalize (of_IQmake_to_hexadecimal' num den). case IQmake_to_hexadecimal' as [d'|]; [|now simpl]. case d' as [i f|]; [|now simpl]. intros <-; clear num den. injection 1 as <-. unfold of_hexadecimal; simpl. now unfold Z.of_uint; rewrite DecimalPos.Unsigned.of_to; simpl. - case q as [num den| |]; [|now simpl..]. case q' as [num' den'| |]; [|now simpl..]. case num' as [z p| | |]; [|now simpl..]. case (Z.eq_dec z 2); [intros->|]. 2:{ case z; [now simpl| |now simpl]; intro pz'. case pz'; [intros d0..| ]; [now simpl| |now simpl]. now case d0. } case (Pos.eq_dec den' 1%positive); [intros->|now case den']. generalize (of_IQmake_to_hexadecimal' num den). case IQmake_to_hexadecimal' as [d'|]; [|now simpl]. case d' as [i f|]; [|now simpl]. intros <-; clear num den. injection 1 as <-. unfold of_hexadecimal; simpl. now unfold Z.of_uint; rewrite DecimalPos.Unsigned.of_to; simpl. Qed. Definition dnorm (d:hexadecimal) : hexadecimal := let norm_i i f := match i with | Pos i => Pos (unorm i) | Neg i => match nzhead (app i f) with Nil => Pos zero | _ => Neg (unorm i) end end in match d with | Hexadecimal i f => Hexadecimal (norm_i i f) f | HexadecimalExp i f e => match Decimal.norm e with | Decimal.Pos Decimal.zero => Hexadecimal (norm_i i f) f | e => HexadecimalExp (norm_i i f) f e end end. Lemma dnorm_spec_i d : let (i, f) := match d with Hexadecimal i f => (i, f) | HexadecimalExp i f _ => (i, f) end in let i' := match dnorm d with Hexadecimal i _ => i | HexadecimalExp i _ _ => i end in match i with | Pos i => i' = Pos (unorm i) | Neg i => (i' = Neg (unorm i) /\ (nzhead i <> Nil \/ nzhead f <> Nil)) \/ (i' = Pos zero /\ (nzhead i = Nil /\ nzhead f = Nil)) end. Proof. case d as [i f|i f e]; case i as [i|i]. - now simpl. - simpl; case (uint_eq_dec (nzhead (app i f)) Nil); intro Ha. + rewrite Ha; right; split; [now simpl|split]. * now unfold unorm; rewrite (nzhead_app_nil_l _ _ Ha). * now unfold unorm; rewrite (nzhead_app_nil_r _ _ Ha). + left; split; [now revert Ha; case nzhead|]. case (uint_eq_dec (nzhead i) Nil). * intro Hi; right; intro Hf; apply Ha. now rewrite <-nzhead_app_nzhead, Hi, app_nil_l. * now intro H; left. - simpl; case (Decimal.norm e); clear e; intro e; [|now simpl]. now case e; clear e; [|intro e..]; [|case e|..]. - simpl. set (m := match nzhead _ with Nil => _ | _ => _ end). set (m' := match _ with Hexadecimal _ _ => _ | _ => _ end). replace m' with m. 2:{ unfold m'; case (Decimal.norm e); clear m' e; intro e; [|now simpl]. now case e; clear e; [|intro e..]; [|case e|..]. } unfold m; case (uint_eq_dec (nzhead (app i f)) Nil); intro Ha. + rewrite Ha; right; split; [now simpl|split]. * now unfold unorm; rewrite (nzhead_app_nil_l _ _ Ha). * now unfold unorm; rewrite (nzhead_app_nil_r _ _ Ha). + left; split; [now revert Ha; case nzhead|]. case (uint_eq_dec (nzhead i) Nil). * intro Hi; right; intro Hf; apply Ha. now rewrite <-nzhead_app_nzhead, Hi, app_nil_l. * now intro H; left. Qed. Lemma dnorm_spec_f d : let f := match d with Hexadecimal _ f => f | HexadecimalExp _ f _ => f end in let f' := match dnorm d with Hexadecimal _ f => f | HexadecimalExp _ f _ => f end in f' = f. Proof. case d as [i f|i f e]; [now simpl|]. simpl; case (Decimal.int_eq_dec (Decimal.norm e) (Decimal.Pos Decimal.zero)); [now intros->|intro He]. set (i' := match i with Pos _ => _ | _ => _ end). set (m := match Decimal.norm e with Decimal.Pos _ => _ | _ => _ end). replace m with (HexadecimalExp i' f (Decimal.norm e)); [now simpl|]. unfold m; revert He; case (Decimal.norm e); clear m e; intro e; [|now simpl]. now case e; clear e; [|intro e; case e|..]. Qed. Lemma dnorm_spec_e d : match d, dnorm d with | Hexadecimal _ _, Hexadecimal _ _ => True | HexadecimalExp _ _ e, Hexadecimal _ _ => Decimal.norm e = Decimal.Pos Decimal.zero | HexadecimalExp _ _ e, HexadecimalExp _ _ e' => e' = Decimal.norm e /\ e' <> Decimal.Pos Decimal.zero | Hexadecimal _ _, HexadecimalExp _ _ _ => False end. Proof. case d as [i f|i f e]; [now simpl|]. simpl; case (Decimal.int_eq_dec (Decimal.norm e) (Decimal.Pos Decimal.zero)); [now intros->|intro He]. set (i' := match i with Pos _ => _ | _ => _ end). set (m := match Decimal.norm e with Decimal.Pos _ => _ | _ => _ end). replace m with (HexadecimalExp i' f (Decimal.norm e)); [now simpl|]. unfold m; revert He; case (Decimal.norm e); clear m e; intro e; [|now simpl]. now case e; clear e; [|intro e; case e|..]. Qed. Lemma dnorm_involutive d : dnorm (dnorm d) = dnorm d. Proof. case d as [i f|i f e]; case i as [i|i]. - now simpl; rewrite unorm_involutive. - simpl; case (uint_eq_dec (nzhead (app i f)) Nil); [now intros->|intro Ha]. set (m := match nzhead _ with Nil =>_ | _ => _ end). replace m with (Neg (unorm i)). 2:{ now unfold m; revert Ha; case nzhead. } case (uint_eq_dec (nzhead i) Nil); intro Hi. + unfold unorm; rewrite Hi; simpl. case (uint_eq_dec (nzhead f) Nil). * intro Hf; exfalso; apply Ha. now rewrite <-nzhead_app_nzhead, Hi, app_nil_l. * now case nzhead. + rewrite unorm_involutive, (unorm_nzhead _ Hi), nzhead_app_nzhead. now revert Ha; case nzhead. - simpl; case (Decimal.int_eq_dec (Decimal.norm e) (Decimal.Pos Decimal.zero)); intro He. + now rewrite He; simpl; rewrite unorm_involutive. + set (m := match Decimal.norm e with Decimal.Pos _ => _ | _ => _ end). replace m with (HexadecimalExp (Pos (unorm i)) f (Decimal.norm e)). 2:{ unfold m; revert He; case (Decimal.norm e); clear m e; intro e; [|now simpl]. now case e; clear e; [|intro e; case e|..]. } simpl; rewrite DecimalFacts.norm_involutive, unorm_involutive. revert He; case (Decimal.norm e); clear m e; intro e; [|now simpl]. now case e; clear e; [|intro e; case e|..]. - simpl; case (Decimal.int_eq_dec (Decimal.norm e) (Decimal.Pos Decimal.zero)); intro He. + rewrite He; simpl. case (uint_eq_dec (nzhead (app i f)) Nil); [now intros->|intro Ha]. set (m := match nzhead _ with Nil =>_ | _ => _ end). replace m with (Neg (unorm i)). 2:{ now unfold m; revert Ha; case nzhead. } case (uint_eq_dec (nzhead i) Nil); intro Hi. * unfold unorm; rewrite Hi; simpl. case (uint_eq_dec (nzhead f) Nil). -- intro Hf; exfalso; apply Ha. now rewrite <-nzhead_app_nzhead, Hi, app_nil_l. -- now case nzhead. * rewrite unorm_involutive, (unorm_nzhead _ Hi), nzhead_app_nzhead. now revert Ha; case nzhead. + set (m := match Decimal.norm e with Decimal.Pos _ => _ | _ => _ end). pose (i' := match nzhead (app i f) with Nil => Pos zero | _ => Neg (unorm i) end). replace m with (HexadecimalExp i' f (Decimal.norm e)). 2:{ unfold m; revert He; case (Decimal.norm e); clear m e; intro e; [|now simpl]. now case e; clear e; [|intro e; case e|..]. } simpl; rewrite DecimalFacts.norm_involutive. set (i'' := match i' with Pos _ => _ | _ => _ end). clear m; set (m := match Decimal.norm e with Decimal.Pos _ => _ | _ => _ end). replace m with (HexadecimalExp i'' f (Decimal.norm e)). 2:{ unfold m; revert He; case (Decimal.norm e); clear m e; intro e; [|now simpl]. now case e; clear e; [|intro e; case e|..]. } unfold i'', i'. case (uint_eq_dec (nzhead (app i f)) Nil); [now intros->|intro Ha]. fold i'; replace i' with (Neg (unorm i)). 2:{ now unfold i'; revert Ha; case nzhead. } case (uint_eq_dec (nzhead i) Nil); intro Hi. * unfold unorm; rewrite Hi; simpl. case (uint_eq_dec (nzhead f) Nil). -- intro Hf; exfalso; apply Ha. now rewrite <-nzhead_app_nzhead, Hi, app_nil_l. -- now case nzhead. * rewrite unorm_involutive, (unorm_nzhead _ Hi), nzhead_app_nzhead. now revert Ha; case nzhead. Qed. Lemma IZ_to_Z_IZ_of_Z z : IZ_to_Z (IZ_of_Z z) = Some z. Proof. now case z. Qed. Lemma dnorm_i_exact i f : (nb_digits f < nb_digits (unorm (app (abs i) f)))%nat -> match i with | Pos i => Pos (unorm i) | Neg i => match nzhead (app i f) with | Nil => Pos zero | _ => Neg (unorm i) end end = norm i. Proof. case i as [ni|ni]; [now simpl|]; simpl. case (uint_eq_dec (nzhead (app ni f)) Nil); intro Ha. { now rewrite Ha, (nzhead_app_nil_l _ _ Ha). } rewrite (unorm_nzhead _ Ha). set (m := match nzhead _ with Nil => _ | _ => _ end). replace m with (Neg (unorm ni)); [|now unfold m; revert Ha; case nzhead]. case (uint_eq_dec (nzhead ni) Nil); intro Hni. { rewrite <-nzhead_app_nzhead, Hni, app_nil_l. intro H; exfalso; revert H; apply Nat.le_ngt, nb_digits_nzhead. } clear m; set (m := match nzhead ni with Nil => _ | _ => _ end). replace m with (Neg (nzhead ni)); [|now unfold m; revert Hni; case nzhead]. now rewrite (unorm_nzhead _ Hni). Qed. Lemma dnorm_i_exact' i f : (nb_digits (unorm (app (abs i) f)) <= nb_digits f)%nat -> match i with | Pos i => Pos (unorm i) | Neg i => match nzhead (app i f) with | Nil => Pos zero | _ => Neg (unorm i) end end = match norm (app_int i f) with | Pos _ => Pos zero | Neg _ => Neg zero end. Proof. case i as [ni|ni]; simpl. { now intro Hnb; rewrite (unorm_app_zero _ _ Hnb). } unfold unorm. case (uint_eq_dec (nzhead (app ni f)) Nil); intro Hn. { now rewrite Hn. } set (m := match nzhead _ with Nil => _ | _ => _ end). replace m with (nzhead (app ni f)). 2:{ now unfold m; revert Hn; case nzhead. } clear m; set (m := match nzhead _ with Nil => _ | _ => _ end). replace m with (Neg (unorm ni)). 2:{ now unfold m, unorm; revert Hn; case nzhead. } clear m; set (m := match nzhead _ with Nil => _ | _ => _ end). replace m with (Neg (nzhead (app ni f))). 2:{ now unfold m; revert Hn; case nzhead. } rewrite <-(unorm_nzhead _ Hn). now intro H; rewrite (unorm_app_zero _ _ H). Qed. Lemma to_of (d:hexadecimal) : to_hexadecimal (of_hexadecimal d) = Some (dnorm d). Proof. case d as [i f|i f e]. - unfold of_hexadecimal; simpl; unfold IQmake_to_hexadecimal'. rewrite IZ_to_Z_IZ_of_Z. unfold IQmake_to_hexadecimal; simpl. change (fun _ : positive => _) with (Pos.mul 16). rewrite nztail_to_hex_uint_pow16, to_of. case_eq (nb_digits f); [|intro nb]; intro Hnb. + rewrite (nb_digits_0 _ Hnb), app_int_nil_r. case i as [ni|ni]; [now simpl|]. rewrite app_nil_r; simpl; unfold unorm. now case (nzhead ni). + rewrite <-Hnb. rewrite abs_norm, abs_app_int. case Nat.ltb_spec; intro Hnb'. * rewrite (del_tail_app_int_exact _ _ Hnb'). rewrite (del_head_app_int_exact _ _ Hnb'). now rewrite (dnorm_i_exact _ _ Hnb'). * rewrite (unorm_app_r _ _ Hnb'). rewrite iter_D0_unorm; [|now apply nb_digits_n0; rewrite Hnb]. now rewrite dnorm_i_exact'. - unfold of_hexadecimal; simpl. rewrite <-DecimalZ.to_of. case (Z.of_int e); clear e; [|intro e..]; simpl. + unfold IQmake_to_hexadecimal'. rewrite IZ_to_Z_IZ_of_Z. unfold IQmake_to_hexadecimal; simpl. change (fun _ : positive => _) with (Pos.mul 16). rewrite nztail_to_hex_uint_pow16, to_of. case_eq (nb_digits f); [|intro nb]; intro Hnb. * rewrite (nb_digits_0 _ Hnb), app_int_nil_r. case i as [ni|ni]; [now simpl|]. rewrite app_nil_r; simpl; unfold unorm. now case (nzhead ni). * rewrite <-Hnb. rewrite abs_norm, abs_app_int. case Nat.ltb_spec; intro Hnb'. -- rewrite (del_tail_app_int_exact _ _ Hnb'). rewrite (del_head_app_int_exact _ _ Hnb'). now rewrite (dnorm_i_exact _ _ Hnb'). -- rewrite (unorm_app_r _ _ Hnb'). rewrite iter_D0_unorm; [|now apply nb_digits_n0; rewrite Hnb]. now rewrite dnorm_i_exact'. + unfold IQmake_to_hexadecimal'. rewrite IZ_to_Z_IZ_of_Z. unfold IQmake_to_hexadecimal; simpl. change (fun _ : positive => _) with (Pos.mul 16). rewrite nztail_to_hex_uint_pow16, to_of. generalize (DecimalPos.Unsigned.to_uint_nonzero e); intro He. set (dnorm_i := match i with Pos _ => _ | _ => _ end). set (m := match Pos.to_uint e with Decimal.Nil => _ | _ => _ end). replace m with (HexadecimalExp dnorm_i f (Decimal.Pos (Pos.to_uint e))). 2:{ now unfold m; revert He; case (Pos.to_uint e); [|intro u; case u|..]. } clear m; unfold dnorm_i. case_eq (nb_digits f); [|intro nb]; intro Hnb. * rewrite (nb_digits_0 _ Hnb), app_int_nil_r. case i as [ni|ni]; [now simpl|]. rewrite app_nil_r; simpl; unfold unorm. now case (nzhead ni). * rewrite <-Hnb. rewrite abs_norm, abs_app_int. case Nat.ltb_spec; intro Hnb'. -- rewrite (del_tail_app_int_exact _ _ Hnb'). rewrite (del_head_app_int_exact _ _ Hnb'). now rewrite (dnorm_i_exact _ _ Hnb'). -- rewrite (unorm_app_r _ _ Hnb'). rewrite iter_D0_unorm; [|now apply nb_digits_n0; rewrite Hnb]. now rewrite dnorm_i_exact'. + unfold IQmake_to_hexadecimal'. rewrite IZ_to_Z_IZ_of_Z. unfold IQmake_to_hexadecimal; simpl. change (fun _ : positive => _) with (Pos.mul 16). rewrite nztail_to_hex_uint_pow16, to_of. case_eq (nb_digits f); [|intro nb]; intro Hnb. * rewrite (nb_digits_0 _ Hnb), app_int_nil_r. case i as [ni|ni]; [now simpl|]. rewrite app_nil_r; simpl; unfold unorm. now case (nzhead ni). * rewrite <-Hnb. rewrite abs_norm, abs_app_int. case Nat.ltb_spec; intro Hnb'. -- rewrite (del_tail_app_int_exact _ _ Hnb'). rewrite (del_head_app_int_exact _ _ Hnb'). now rewrite (dnorm_i_exact _ _ Hnb'). -- rewrite (unorm_app_r _ _ Hnb'). rewrite iter_D0_unorm; [|now apply nb_digits_n0; rewrite Hnb]. now rewrite dnorm_i_exact'. Qed. (** Some consequences *) Lemma to_hexadecimal_inj q q' : to_hexadecimal q <> None -> to_hexadecimal q = to_hexadecimal q' -> q = q'. Proof. intros Hnone EQ. generalize (of_to q) (of_to q'). rewrite <-EQ. revert Hnone; case to_hexadecimal; [|now simpl]. now intros d _ H1 H2; rewrite <-(H1 d eq_refl), <-(H2 d eq_refl). Qed. Lemma to_hexadecimal_surj d : exists q, to_hexadecimal q = Some (dnorm d). Proof. exists (of_hexadecimal d). apply to_of. Qed. Lemma of_hexadecimal_dnorm d : of_hexadecimal (dnorm d) = of_hexadecimal d. Proof. now apply to_hexadecimal_inj; rewrite !to_of; [|rewrite dnorm_involutive]. Qed. Lemma of_inj d d' : of_hexadecimal d = of_hexadecimal d' -> dnorm d = dnorm d'. Proof. intro H. apply (@f_equal _ _ (fun x => match x with Some x => x | _ => d end) (Some (dnorm d)) (Some (dnorm d'))). now rewrite <- !to_of, H. Qed. Lemma of_iff d d' : of_hexadecimal d = of_hexadecimal d' <-> dnorm d = dnorm d'. Proof. split. - apply of_inj. - intros E. rewrite <- of_hexadecimal_dnorm, E. apply of_hexadecimal_dnorm. Qed. coq-8.20.0/theories/Numbers/HexadecimalR.v000066400000000000000000000337521466560755400203710ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* True | Some (HexadecimalExp _ _ _) => False | Some (Hexadecimal i f) => of_hexadecimal (Hexadecimal i f) = IRQ (QArith_base.Qmake num den) end. Proof. unfold IQmake_to_hexadecimal. case (Pos.eq_dec den 1); [now intros->|intro Hden]. assert (Hf : match QArith_base.IQmake_to_hexadecimal num den with | Some (Hexadecimal i f) => f <> Nil | _ => True end). { unfold QArith_base.IQmake_to_hexadecimal; simpl. generalize (Unsigned.nztail_to_hex_uint den). case Hexadecimal.nztail as [den' e_den']. case den'; [now simpl|now simpl| |now simpl..]; clear den'; intro den'. case den'; [ |now simpl..]; clear den'. case e_den' as [|e_den']; [now simpl; intros H _; apply Hden; injection H|]. intros _. case Nat.ltb_spec; intro He_den'. - apply del_head_nonnil. revert He_den'; case nb_digits as [|n]; [now simpl|]. now intro H; simpl; apply Nat.lt_succ_r, Nat.le_sub_l. - apply nb_digits_n0. now rewrite nb_digits_iter_D0, Nat.sub_add. } replace (match den with 1%positive => _ | _ => _ end) with (QArith_base.IQmake_to_hexadecimal num den); [|now revert Hden; case den]. generalize (of_IQmake_to_hexadecimal num den). case QArith_base.IQmake_to_hexadecimal as [d'|]; [|now simpl]. case d' as [i f|]; [|now simpl]. unfold of_hexadecimal; simpl. injection 1 as H <-. generalize (f_equal QArith_base.IZ_to_Z H); clear H. rewrite !IZ_to_Z_IZ_of_Z; injection 1 as <-. now revert Hf; case f. Qed. Lemma of_to (q:IR) : forall d, to_hexadecimal q = Some d -> of_hexadecimal d = q. Proof. intro d. case q as [z|q|r r'|r r']; simpl. - case z as [z p| |p|p]. + now simpl. + now simpl; injection 1 as <-. + simpl; injection 1 as <-. now unfold of_hexadecimal; simpl; unfold Z.of_hex_uint; rewrite Unsigned.of_to. + simpl; injection 1 as <-. now unfold of_hexadecimal; simpl; unfold Z.of_hex_uint; rewrite Unsigned.of_to. - case q as [num den]. generalize (of_IQmake_to_hexadecimal num den). case IQmake_to_hexadecimal as [d'|]; [|now simpl]. case d' as [i f|]; [|now simpl]. now intros H; injection 1 as <-. - case r as [z|q| |]; [|case q as[num den]|now simpl..]; (case r' as [z'| | |]; [|now simpl..]); (case z' as [p e| | |]; [|now simpl..]). + case (Z.eq_dec p 2); [intros->|intro Hp]. 2:{ now revert Hp; case p; [|intro d0; case d0; [intro d1..|]; [|case d1|]..]. } case z as [| |p|p]; [now simpl|..]; injection 1 as <-. * now unfold of_hexadecimal; simpl; unfold Z.of_uint; rewrite DecimalPos.Unsigned.of_to. * unfold of_hexadecimal; simpl; unfold Z.of_uint; rewrite DecimalPos.Unsigned.of_to; simpl. now unfold Z.of_hex_uint; rewrite Unsigned.of_to. * unfold of_hexadecimal; simpl; unfold Z.of_uint; rewrite DecimalPos.Unsigned.of_to; simpl. now unfold Z.of_hex_uint; rewrite Unsigned.of_to. + case (Z.eq_dec p 2); [intros->|intro Hp]. 2:{ now revert Hp; case p; [|intro d0; case d0; [intro d1..|]; [|case d1|]..]. } generalize (of_IQmake_to_hexadecimal num den). case IQmake_to_hexadecimal as [d'|]; [|now simpl]. case d' as [i f|]; [|now simpl]. intros H; injection 1 as <-. unfold of_hexadecimal; simpl. change (match f with Nil => _ | _ => _ end) with (of_hexadecimal (Hexadecimal i f)). rewrite H; clear H. now unfold Z.of_uint; rewrite DecimalPos.Unsigned.of_to. - case r as [z|q| |]; [|case q as[num den]|now simpl..]; (case r' as [z'| | |]; [|now simpl..]); (case z' as [p e| | |]; [|now simpl..]). + case (Z.eq_dec p 2); [intros->|intro Hp]. 2:{ now revert Hp; case p; [|intro d0; case d0; [intro d1..|]; [|case d1|]..]. } case z as [| |p|p]; [now simpl|..]; injection 1 as <-. * now unfold of_hexadecimal; simpl; unfold Z.of_uint; rewrite DecimalPos.Unsigned.of_to. * unfold of_hexadecimal; simpl; unfold Z.of_uint; rewrite DecimalPos.Unsigned.of_to; simpl. now unfold Z.of_hex_uint; rewrite Unsigned.of_to. * unfold of_hexadecimal; simpl; unfold Z.of_uint; rewrite DecimalPos.Unsigned.of_to; simpl. now unfold Z.of_hex_uint; rewrite Unsigned.of_to. + case (Z.eq_dec p 2); [intros->|intro Hp]. 2:{ now revert Hp; case p; [|intro d0; case d0; [intro d1..|]; [|case d1|]..]. } generalize (of_IQmake_to_hexadecimal num den). case IQmake_to_hexadecimal as [d'|]; [|now simpl]. case d' as [i f|]; [|now simpl]. intros H; injection 1 as <-. unfold of_hexadecimal; simpl. change (match f with Nil => _ | _ => _ end) with (of_hexadecimal (Hexadecimal i f)). rewrite H; clear H. now unfold Z.of_uint; rewrite DecimalPos.Unsigned.of_to. Qed. Lemma to_of (d:hexadecimal) : to_hexadecimal (of_hexadecimal d) = Some (dnorm d). Proof. case d as [i f|i f e]. - unfold of_hexadecimal; simpl. case (uint_eq_dec f Nil); intro Hf. + rewrite Hf; clear f Hf. unfold to_hexadecimal; simpl. rewrite IZ_to_Z_IZ_of_Z, HexadecimalZ.to_of. case i as [i|i]; [now simpl|]; simpl. rewrite app_nil_r. case (uint_eq_dec (nzhead i) Nil); [now intros->|intro Hi]. now rewrite (unorm_nzhead _ Hi); revert Hi; case nzhead. + set (r := IRQ _). set (m := match f with Nil => _ | _ => _ end). replace m with r; [unfold r|now unfold m; revert Hf; case f]. unfold to_hexadecimal; simpl. unfold IQmake_to_hexadecimal; simpl. set (n := Nat.iter _ _ _). case (Pos.eq_dec n 1); intro Hn. * exfalso; apply Hf. { now apply nb_digits_0; revert Hn; unfold n; case nb_digits. } * clear m; set (m := match n with 1%positive | _ => _ end). replace m with (QArith_base.IQmake_to_hexadecimal (Z.of_hex_int (app_int i f)) n). 2:{ now unfold m; revert Hn; case n. } unfold QArith_base.IQmake_to_hexadecimal, n; simpl. rewrite nztail_to_hex_uint_pow16. clear r; set (r := if _ _ | _ => _ end). replace m with r; [unfold r|now unfold m; revert Hf; case f]. rewrite HexadecimalZ.to_of, abs_norm, abs_app_int. case Nat.ltb_spec; intro Hnf. -- rewrite (del_tail_app_int_exact _ _ Hnf). rewrite (del_head_app_int_exact _ _ Hnf). now rewrite (dnorm_i_exact _ _ Hnf). -- rewrite (unorm_app_r _ _ Hnf). rewrite (iter_D0_unorm _ Hf). now rewrite dnorm_i_exact'. - unfold of_hexadecimal; simpl. rewrite <-(DecimalZ.to_of e). case (Z.of_int e); clear e; [|intro e..]; simpl. + case (uint_eq_dec f Nil); intro Hf. * rewrite Hf; clear f Hf. unfold to_hexadecimal; simpl. rewrite IZ_to_Z_IZ_of_Z, HexadecimalZ.to_of. case i as [i|i]; [now simpl|]; simpl. rewrite app_nil_r. case (uint_eq_dec (nzhead i) Nil); [now intros->|intro Hi]. now rewrite (unorm_nzhead _ Hi); revert Hi; case nzhead. * set (r := IRQ _). set (m := match f with Nil => _ | _ => _ end). replace m with r; [unfold r|now unfold m; revert Hf; case f]. unfold to_hexadecimal; simpl. unfold IQmake_to_hexadecimal; simpl. set (n := Nat.iter _ _ _). case (Pos.eq_dec n 1); intro Hn. -- exfalso; apply Hf. { now apply nb_digits_0; revert Hn; unfold n; case nb_digits. } -- clear m; set (m := match n with 1%positive | _ => _ end). replace m with (QArith_base.IQmake_to_hexadecimal (Z.of_hex_int (app_int i f)) n). 2:{ now unfold m; revert Hn; case n. } unfold QArith_base.IQmake_to_hexadecimal, n; simpl. rewrite nztail_to_hex_uint_pow16. clear r; set (r := if _ _ | _ => _ end). replace m with r; [unfold r|now unfold m; revert Hf; case f]. rewrite HexadecimalZ.to_of, abs_norm, abs_app_int. case Nat.ltb_spec; intro Hnf. ++ rewrite (del_tail_app_int_exact _ _ Hnf). rewrite (del_head_app_int_exact _ _ Hnf). now rewrite (dnorm_i_exact _ _ Hnf). ++ rewrite (unorm_app_r _ _ Hnf). rewrite (iter_D0_unorm _ Hf). now rewrite dnorm_i_exact'. + set (i' := match i with Pos _ => _ | _ => _ end). set (m := match Pos.to_uint e with Decimal.Nil => _ | _ => _ end). replace m with (HexadecimalExp i' f (Decimal.Pos (Pos.to_uint e))). 2:{ unfold m; generalize (DecimalPos.Unsigned.to_uint_nonzero e). now case Pos.to_uint; [|intro u; case u|..]. } unfold i'; clear i' m. case (uint_eq_dec f Nil); intro Hf. * rewrite Hf; clear f Hf. unfold to_hexadecimal; simpl. rewrite IZ_to_Z_IZ_of_Z, HexadecimalZ.to_of. case i as [i|i]; [now simpl|]; simpl. rewrite app_nil_r. case (uint_eq_dec (nzhead i) Nil); [now intros->|intro Hi]. now rewrite (unorm_nzhead _ Hi); revert Hi; case nzhead. * set (r := IRQ _). set (m := match f with Nil => _ | _ => _ end). replace m with r; [unfold r|now unfold m; revert Hf; case f]. unfold to_hexadecimal; simpl. unfold IQmake_to_hexadecimal; simpl. set (n := Nat.iter _ _ _). case (Pos.eq_dec n 1); intro Hn. { exfalso; apply Hf. now apply nb_digits_0; revert Hn; unfold n; case nb_digits. } clear m; set (m := match n with 1%positive | _ => _ end). replace m with (QArith_base.IQmake_to_hexadecimal (Z.of_hex_int (app_int i f)) n). 2:{ now unfold m; revert Hn; case n. } unfold QArith_base.IQmake_to_hexadecimal, n; simpl. rewrite nztail_to_hex_uint_pow16. clear r; set (r := if _ _ | _ => _ end). replace m with r; [unfold r|now unfold m; revert Hf; case f]. rewrite HexadecimalZ.to_of, abs_norm, abs_app_int. case Nat.ltb_spec; intro Hnf. -- rewrite (del_tail_app_int_exact _ _ Hnf). rewrite (del_head_app_int_exact _ _ Hnf). now rewrite (dnorm_i_exact _ _ Hnf). -- rewrite (unorm_app_r _ _ Hnf). rewrite (iter_D0_unorm _ Hf). now rewrite dnorm_i_exact'. + case (uint_eq_dec f Nil); intro Hf. * rewrite Hf; clear f Hf. unfold to_hexadecimal; simpl. rewrite IZ_to_Z_IZ_of_Z, HexadecimalZ.to_of. case i as [i|i]; [now simpl|]; simpl. rewrite app_nil_r. case (uint_eq_dec (nzhead i) Nil); [now intros->|intro Hi]. now rewrite (unorm_nzhead _ Hi); revert Hi; case nzhead. * set (r := IRQ _). set (m := match f with Nil => _ | _ => _ end). replace m with r; [unfold r|now unfold m; revert Hf; case f]. unfold to_hexadecimal; simpl. unfold IQmake_to_hexadecimal; simpl. set (n := Nat.iter _ _ _). case (Pos.eq_dec n 1); intro Hn. { exfalso; apply Hf. now apply nb_digits_0; revert Hn; unfold n; case nb_digits. } clear m; set (m := match n with 1%positive | _ => _ end). replace m with (QArith_base.IQmake_to_hexadecimal (Z.of_hex_int (app_int i f)) n). 2:{ now unfold m; revert Hn; case n. } unfold QArith_base.IQmake_to_hexadecimal, n; simpl. rewrite nztail_to_hex_uint_pow16. clear r; set (r := if _ _ | _ => _ end). replace m with r; [unfold r|now unfold m; revert Hf; case f]. rewrite HexadecimalZ.to_of, abs_norm, abs_app_int. case Nat.ltb_spec; intro Hnf. -- rewrite (del_tail_app_int_exact _ _ Hnf). rewrite (del_head_app_int_exact _ _ Hnf). now rewrite (dnorm_i_exact _ _ Hnf). -- rewrite (unorm_app_r _ _ Hnf). rewrite (iter_D0_unorm _ Hf). now rewrite dnorm_i_exact'. Qed. (** Some consequences *) Lemma to_hexadecimal_inj q q' : to_hexadecimal q <> None -> to_hexadecimal q = to_hexadecimal q' -> q = q'. Proof. intros Hnone EQ. generalize (of_to q) (of_to q'). rewrite <-EQ. revert Hnone; case to_hexadecimal; [|now simpl]. now intros d _ H1 H2; rewrite <-(H1 d eq_refl), <-(H2 d eq_refl). Qed. Lemma to_hexadecimal_surj d : exists q, to_hexadecimal q = Some (dnorm d). Proof. exists (of_hexadecimal d). apply to_of. Qed. Lemma of_hexadecimal_dnorm d : of_hexadecimal (dnorm d) = of_hexadecimal d. Proof. now apply to_hexadecimal_inj; rewrite !to_of; [|rewrite dnorm_involutive]. Qed. Lemma of_inj d d' : of_hexadecimal d = of_hexadecimal d' -> dnorm d = dnorm d'. Proof. intro H. apply (@f_equal _ _ (fun x => match x with Some x => x | _ => d end) (Some (dnorm d)) (Some (dnorm d'))). now rewrite <- !to_of, H. Qed. Lemma of_iff d d' : of_hexadecimal d = of_hexadecimal d' <-> dnorm d = dnorm d'. Proof. split. - apply of_inj. - intros E. rewrite <- of_hexadecimal_dnorm, E. apply of_hexadecimal_dnorm. Qed. coq-8.20.0/theories/Numbers/HexadecimalString.v000066400000000000000000000173011466560755400214260ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* None | Some d => match a with | "0" => Some (D0 d) | "1" => Some (D1 d) | "2" => Some (D2 d) | "3" => Some (D3 d) | "4" => Some (D4 d) | "5" => Some (D5 d) | "6" => Some (D6 d) | "7" => Some (D7 d) | "8" => Some (D8 d) | "9" => Some (D9 d) | "a" => Some (Da d) | "b" => Some (Db d) | "c" => Some (Dc d) | "d" => Some (Dd d) | "e" => Some (De d) | "f" => Some (Df d) | _ => None end end%char. Lemma uint_of_char_spec c d d' : uint_of_char c (Some d) = Some d' -> (c = "0" /\ d' = D0 d \/ c = "1" /\ d' = D1 d \/ c = "2" /\ d' = D2 d \/ c = "3" /\ d' = D3 d \/ c = "4" /\ d' = D4 d \/ c = "5" /\ d' = D5 d \/ c = "6" /\ d' = D6 d \/ c = "7" /\ d' = D7 d \/ c = "8" /\ d' = D8 d \/ c = "9" /\ d' = D9 d \/ c = "a" /\ d' = Da d \/ c = "b" /\ d' = Db d \/ c = "c" /\ d' = Dc d \/ c = "d" /\ d' = Dd d \/ c = "e" /\ d' = De d \/ c = "f" /\ d' = Df d)%char. Proof. destruct c as [[|] [|] [|] [|] [|] [|] [|] [|]]; intros [= <-]; intuition. Qed. (** Hexadecimal/String conversion where [Nil] is [""] *) Module NilEmpty. Fixpoint string_of_uint (d:uint) := match d with | Nil => EmptyString | D0 d => String "0" (string_of_uint d) | D1 d => String "1" (string_of_uint d) | D2 d => String "2" (string_of_uint d) | D3 d => String "3" (string_of_uint d) | D4 d => String "4" (string_of_uint d) | D5 d => String "5" (string_of_uint d) | D6 d => String "6" (string_of_uint d) | D7 d => String "7" (string_of_uint d) | D8 d => String "8" (string_of_uint d) | D9 d => String "9" (string_of_uint d) | Da d => String "a" (string_of_uint d) | Db d => String "b" (string_of_uint d) | Dc d => String "c" (string_of_uint d) | Dd d => String "d" (string_of_uint d) | De d => String "e" (string_of_uint d) | Df d => String "f" (string_of_uint d) end. Fixpoint uint_of_string s := match s with | EmptyString => Some Nil | String a s => uint_of_char a (uint_of_string s) end. Definition string_of_int (d:int) := match d with | Pos d => string_of_uint d | Neg d => String "-" (string_of_uint d) end. Definition int_of_string s := match s with | EmptyString => Some (Pos Nil) | String a s' => if Ascii.eqb a "-" then option_map Neg (uint_of_string s') else option_map Pos (uint_of_string s) end. (* NB: For the moment whitespace between - and digits are not accepted. And in this variant [int_of_string "-" = Some (Neg Nil)]. Compute int_of_string "-123456890123456890123456890123456890". Compute string_of_int (-123456890123456890123456890123456890). *) (** Corresponding proofs *) Lemma usu d : uint_of_string (string_of_uint d) = Some d. Proof. induction d; simpl; rewrite ?IHd; simpl; auto. Qed. Lemma sus s d : uint_of_string s = Some d -> string_of_uint d = s. Proof. revert d. induction s; simpl. - now intros d [= <-]. - intros d. destruct (uint_of_string s); [intros H | intros [=]]. apply uint_of_char_spec in H. intuition subst; simpl; f_equal; auto. Qed. Lemma isi d : int_of_string (string_of_int d) = Some d. Proof. destruct d; simpl. - unfold int_of_string. destruct (string_of_uint d) eqn:Hd. + now destruct d. + case Ascii.eqb_spec. * intros ->. now destruct d. * rewrite <- Hd, usu; auto. - rewrite usu; auto. Qed. Lemma sis s d : int_of_string s = Some d -> string_of_int d = s. Proof. destruct s; [intros [= <-]| ]; simpl; trivial. case Ascii.eqb_spec. - intros ->. destruct (uint_of_string s) eqn:Hs; simpl; intros [= <-]. simpl; f_equal. now apply sus. - destruct d; [ | now destruct uint_of_char]. simpl string_of_int. intros. apply sus; simpl. destruct uint_of_char; simpl in *; congruence. Qed. End NilEmpty. (** Hexadecimal/String conversions where [Nil] is ["0"] *) Module NilZero. Definition string_of_uint (d:uint) := match d with | Nil => "0" | _ => NilEmpty.string_of_uint d end. Definition uint_of_string s := match s with | EmptyString => None | _ => NilEmpty.uint_of_string s end. Definition string_of_int (d:int) := match d with | Pos d => string_of_uint d | Neg d => String "-" (string_of_uint d) end. Definition int_of_string s := match s with | EmptyString => None | String a s' => if Ascii.eqb a "-" then option_map Neg (uint_of_string s') else option_map Pos (uint_of_string s) end. (** Corresponding proofs *) Lemma uint_of_string_nonnil s : uint_of_string s <> Some Nil. Proof. destruct s; simpl. - easy. - destruct (NilEmpty.uint_of_string s); [intros H | intros [=]]. apply uint_of_char_spec in H. now intuition subst. Qed. Lemma sus s d : uint_of_string s = Some d -> string_of_uint d = s. Proof. destruct s; [intros [=] | intros H]. apply NilEmpty.sus in H. now destruct d. Qed. Lemma usu d : d<>Nil -> uint_of_string (string_of_uint d) = Some d. Proof. destruct d; (now destruct 1) || (intros _; apply NilEmpty.usu). Qed. Lemma usu_nil : uint_of_string (string_of_uint Nil) = Some Hexadecimal.zero. Proof. reflexivity. Qed. Lemma usu_gen d : uint_of_string (string_of_uint d) = Some d \/ uint_of_string (string_of_uint d) = Some Hexadecimal.zero. Proof. destruct d; (now right) || (left; now apply usu). Qed. Lemma isi d : d<>Pos Nil -> d<>Neg Nil -> int_of_string (string_of_int d) = Some d. Proof. destruct d; simpl. - intros H _. unfold int_of_string. destruct (string_of_uint d) eqn:Hd. + now destruct d. + case Ascii.eqb_spec. * intros ->. now destruct d. * rewrite <- Hd, usu; auto. now intros ->. - intros _ H. rewrite usu; auto. now intros ->. Qed. Lemma isi_posnil : int_of_string (string_of_int (Pos Nil)) = Some (Pos Hexadecimal.zero). Proof. reflexivity. Qed. (** Warning! (-0) won't parse (compatibility with the behavior of Z). *) Lemma isi_negnil : int_of_string (string_of_int (Neg Nil)) = Some (Neg (D0 Nil)). Proof. reflexivity. Qed. Lemma sis s d : int_of_string s = Some d -> string_of_int d = s. Proof. destruct s; [intros [=]| ]; simpl. case Ascii.eqb_spec. - intros ->. destruct (uint_of_string s) eqn:Hs; simpl; intros [= <-]. simpl; f_equal. now apply sus. - destruct d; [ | now destruct uint_of_char]. simpl string_of_int. intros. apply sus; simpl. destruct uint_of_char; simpl in *; congruence. Qed. End NilZero. coq-8.20.0/theories/Numbers/HexadecimalZ.v000066400000000000000000000132761466560755400204000ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* n = n'. Proof. intro EQ. now rewrite <- (of_to n), <- (of_to n'), EQ. Qed. Lemma to_int_surj d : exists n, Z.to_hex_int n = norm d. Proof. exists (Z.of_hex_int d). apply to_of. Qed. Lemma of_int_norm d : Z.of_hex_int (norm d) = Z.of_hex_int d. Proof. unfold Z.of_hex_int, Z.of_hex_uint. destruct d. - simpl. now rewrite HexadecimalPos.Unsigned.of_uint_norm. - simpl. destruct (nzhead d) eqn:H; [ induction d; simpl; auto; discriminate | destruct (nzhead_nonzero _ _ H) | .. ]; f_equal; f_equal; apply HexadecimalPos.Unsigned.of_iff; unfold unorm; now rewrite H. Qed. Lemma of_inj d d' : Z.of_hex_int d = Z.of_hex_int d' -> norm d = norm d'. Proof. intros. rewrite <- !to_of. now f_equal. Qed. Lemma of_iff d d' : Z.of_hex_int d = Z.of_hex_int d' <-> norm d = norm d'. Proof. split. - apply of_inj. - intros E. rewrite <- of_int_norm, E. apply of_int_norm. Qed. (** Various lemmas *) Lemma of_hex_uint_iter_D0 d n : Z.of_hex_uint (app d (Nat.iter n D0 Nil)) = Nat.iter n (Z.mul 0x10) (Z.of_hex_uint d). Proof. rewrite <-(rev_rev (app _ _)), <-(of_list_to_list (rev (app _ _))). rewrite rev_spec, app_spec, List.rev_app_distr. rewrite <-!rev_spec, <-app_spec, of_list_to_list. unfold Z.of_hex_uint; rewrite Unsigned.of_lu_rev. unfold app; rewrite Unsigned.of_lu_revapp, !rev_rev. rewrite <-!Unsigned.of_lu_rev, !rev_rev. assert (H' : Pos.of_hex_uint (Nat.iter n D0 Nil) = 0%N). { now induction n; [|rewrite Unsigned.nat_iter_S]. } rewrite H', N.add_0_l; clear H'. induction n; [now simpl; rewrite N.mul_1_r|]. rewrite !Unsigned.nat_iter_S, <-IHn. simpl Unsigned.usize; rewrite N.pow_succ_r'. rewrite !N2Z.inj_mul; simpl Z.of_N; ring. Qed. Lemma of_hex_int_iter_D0 d n : Z.of_hex_int (app_int d (Nat.iter n D0 Nil)) = Nat.iter n (Z.mul 0x10) (Z.of_hex_int d). Proof. case d; clear d; intro d; simpl. - now rewrite of_hex_uint_iter_D0. - rewrite of_hex_uint_iter_D0; induction n; [now simpl|]. rewrite !Unsigned.nat_iter_S, <-IHn; ring. Qed. Definition double d := match d with | Pos u => Pos (Unsigned.double u) | Neg u => Neg (Unsigned.double u) end. Lemma double_norm d : double (norm d) = norm (double d). Proof. destruct d. - now simpl; rewrite Unsigned.double_unorm. - simpl; rewrite <-Unsigned.double_nzhead. case (uint_eq_dec (nzhead d) Nil); intro Hnzd. + now rewrite Hnzd. + assert (H : Unsigned.double (nzhead d) <> Nil). { unfold Unsigned.double. intro H; apply Hnzd, rev_nil_inv. now generalize (rev_nil_inv _ H); case rev. } revert H. set (r := Unsigned.double _). set (m := match r with Nil => Pos zero | _ => _ end). intro H. assert (H' : m = Neg r). { now unfold m; clear m; revert H; case r. } rewrite H'; unfold r; clear m r H H'. now revert Hnzd; case nzhead. Qed. Lemma of_hex_int_double d : Z.of_hex_int (double d) = Z.double (Z.of_hex_int d). Proof. now destruct d; simpl; unfold Z.of_hex_uint; rewrite Unsigned.of_hex_uint_double; case Pos.of_hex_uint. Qed. Lemma double_to_hex_int n : double (Z.to_hex_int n) = Z.to_hex_int (Z.double n). Proof. now rewrite <-(of_to n), <-of_hex_int_double, !to_of, double_norm. Qed. Lemma nztail_to_hex_uint_pow16 n : Hexadecimal.nztail (Pos.to_hex_uint (Nat.iter n (Pos.mul 16) 1%positive)) = (D1 Nil, n). Proof. case n as [|n]; [now simpl|]. rewrite <-(Nat2Pos.id (S n)); [|now simpl]. generalize (Pos.of_nat (S n)); clear n; intro p. induction (Pos.to_nat p); [now simpl|]. rewrite Unsigned.nat_iter_S. unfold Pos.to_hex_uint. change (Pos.to_little_hex_uint _) with (Unsigned.to_lu (16 * N.pos (Nat.iter n (Pos.mul 16) 1%positive))). rewrite Unsigned.to_lhex_tenfold. revert IHn; unfold Pos.to_hex_uint. unfold Hexadecimal.nztail; rewrite !rev_rev; simpl. set (f'' := _ (Pos.to_little_hex_uint _)). now case f''; intros r n' H; inversion H. Qed. coq-8.20.0/theories/Numbers/Integer/000077500000000000000000000000001466560755400172375ustar00rootroot00000000000000coq-8.20.0/theories/Numbers/Integer/Abstract/000077500000000000000000000000001466560755400210025ustar00rootroot00000000000000coq-8.20.0/theories/Numbers/Integer/Abstract/ZAdd.v000066400000000000000000000166051466560755400220230ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* n == m. Proof. intros H. apply opp_wd in H. now rewrite 2 opp_involutive in H. Qed. Theorem opp_inj_wd n m : - n == - m <-> n == m. Proof. split; [apply opp_inj | intros; now f_equiv]. Qed. Theorem eq_opp_l n m : - n == m <-> n == - m. Proof. now rewrite <- (opp_inj_wd (- n) m), opp_involutive. Qed. Theorem eq_opp_r n m : n == - m <-> - n == m. Proof. symmetry; apply eq_opp_l. Qed. Theorem sub_add_distr n m p : n - (m + p) == (n - m) - p. Proof. rewrite <- add_opp_r, opp_add_distr, add_assoc. now rewrite 2 add_opp_r. Qed. Theorem sub_sub_distr n m p : n - (m - p) == (n - m) + p. Proof. rewrite <- add_opp_r, opp_sub_distr, add_assoc. now rewrite add_opp_r. Qed. Theorem sub_opp_l n m : - n - m == - m - n. Proof. rewrite <- 2 add_opp_r. now rewrite add_comm. Qed. Theorem sub_opp_r n m : n - (- m) == n + m. Proof. rewrite <- add_opp_r; now rewrite opp_involutive. Qed. Theorem add_sub_swap n m p : n + m - p == n - p + m. Proof. rewrite <- add_sub_assoc, <- (add_opp_r n p), <- add_assoc. now rewrite add_opp_l. Qed. Theorem sub_cancel_l n m p : n - m == n - p <-> m == p. Proof. rewrite <- (add_cancel_l (n - m) (n - p) (- n)). rewrite 2 add_sub_assoc. rewrite add_opp_diag_l; rewrite 2 sub_0_l. apply opp_inj_wd. Qed. Theorem sub_cancel_r n m p : n - p == m - p <-> n == m. Proof. stepl (n - p + p == m - p + p) by apply add_cancel_r. now do 2 rewrite <- sub_sub_distr, sub_diag, sub_0_r. Qed. (** The next several theorems are devoted to moving terms from one side of an equation to the other. The name contains the operation in the original equation ([add] or [sub]) and the indication whether the left or right term is moved. *) Theorem add_move_l n m p : n + m == p <-> m == p - n. Proof. stepl (n + m - n == p - n) by apply sub_cancel_r. now rewrite add_comm, <- add_sub_assoc, sub_diag, add_0_r. Qed. Theorem add_move_r n m p : n + m == p <-> n == p - m. Proof. rewrite add_comm; now apply add_move_l. Qed. (** The two theorems above do not allow rewriting subformulas of the form [n - m == p] to [n == p + m] since subtraction is in the right-hand side of the equation. Hence the following two theorems. *) Theorem sub_move_l n m p : n - m == p <-> - m == p - n. Proof. rewrite <- (add_opp_r n m); apply add_move_l. Qed. Theorem sub_move_r n m p : n - m == p <-> n == p + m. Proof. rewrite <- (add_opp_r n m). now rewrite add_move_r, sub_opp_r. Qed. Theorem add_move_0_l n m : n + m == 0 <-> m == - n. Proof. now rewrite add_move_l, sub_0_l. Qed. Theorem add_move_0_r n m : n + m == 0 <-> n == - m. Proof. now rewrite add_move_r, sub_0_l. Qed. Theorem sub_move_0_l n m : n - m == 0 <-> - m == - n. Proof. now rewrite sub_move_l, sub_0_l. Qed. Theorem sub_move_0_r n m : n - m == 0 <-> n == m. Proof. now rewrite sub_move_r, add_0_l. Qed. (** The following section is devoted to cancellation of like terms. The name includes the first operator and the position of the term being canceled. *) Theorem add_simpl_l n m : n + m - n == m. Proof. now rewrite add_sub_swap, sub_diag, add_0_l. Qed. Theorem add_simpl_r n m : n + m - m == n. Proof. now rewrite <- add_sub_assoc, sub_diag, add_0_r. Qed. Theorem sub_simpl_l n m : - n - m + n == - m. Proof. now rewrite <- add_sub_swap, add_opp_diag_l, sub_0_l. Qed. Theorem sub_simpl_r n m : n - m + m == n. Proof. now rewrite <- sub_sub_distr, sub_diag, sub_0_r. Qed. Theorem sub_add n m : m - n + n == m. Proof. now rewrite <- add_sub_swap, add_simpl_r. Qed. (** Now we have two sums or differences; the name includes the two operators and the position of the terms being canceled *) Theorem add_add_simpl_l_l n m p : (n + m) - (n + p) == m - p. Proof. now rewrite (add_comm n m), <- add_sub_assoc, sub_add_distr, sub_diag, sub_0_l, add_opp_r. Qed. Theorem add_add_simpl_l_r n m p : (n + m) - (p + n) == m - p. Proof. rewrite (add_comm p n); apply add_add_simpl_l_l. Qed. Theorem add_add_simpl_r_l n m p : (n + m) - (m + p) == n - p. Proof. rewrite (add_comm n m); apply add_add_simpl_l_l. Qed. Theorem add_add_simpl_r_r n m p : (n + m) - (p + m) == n - p. Proof. rewrite (add_comm p m); apply add_add_simpl_r_l. Qed. Theorem sub_add_simpl_r_l n m p : (n - m) + (m + p) == n + p. Proof. now rewrite <- sub_sub_distr, sub_add_distr, sub_diag, sub_0_l, sub_opp_r. Qed. Theorem sub_add_simpl_r_r n m p : (n - m) + (p + m) == n + p. Proof. rewrite (add_comm p m); apply sub_add_simpl_r_l. Qed. (** Of course, there are many other variants *) End ZAddProp. coq-8.20.0/theories/Numbers/Integer/Abstract/ZAddOrder.v000066400000000000000000000177371466560755400230260ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* m < 0 -> n + m < 0. Proof. intros. rewrite <- (add_0_l 0). now apply add_lt_mono. Qed. Theorem add_neg_nonpos : forall n m, n < 0 -> m <= 0 -> n + m < 0. Proof. intros. rewrite <- (add_0_l 0). now apply add_lt_le_mono. Qed. Theorem add_nonpos_neg : forall n m, n <= 0 -> m < 0 -> n + m < 0. Proof. intros. rewrite <- (add_0_l 0). now apply add_le_lt_mono. Qed. Theorem add_nonpos_nonpos : forall n m, n <= 0 -> m <= 0 -> n + m <= 0. Proof. intros. rewrite <- (add_0_l 0). now apply add_le_mono. Qed. (** Sub and order *) Theorem lt_0_sub : forall n m, 0 < m - n <-> n < m. Proof. intros n m. now rewrite (add_lt_mono_r _ _ n), add_0_l, sub_simpl_r. Qed. Notation sub_pos := lt_0_sub (only parsing). Theorem le_0_sub : forall n m, 0 <= m - n <-> n <= m. Proof. intros n m. now rewrite (add_le_mono_r _ _ n), add_0_l, sub_simpl_r. Qed. Notation sub_nonneg := le_0_sub (only parsing). Theorem lt_sub_0 : forall n m, n - m < 0 <-> n < m. Proof. intros n m. now rewrite (add_lt_mono_r _ _ m), add_0_l, sub_simpl_r. Qed. Notation sub_neg := lt_sub_0 (only parsing). Theorem le_sub_0 : forall n m, n - m <= 0 <-> n <= m. Proof. intros n m. now rewrite (add_le_mono_r _ _ m), add_0_l, sub_simpl_r. Qed. Notation sub_nonpos := le_sub_0 (only parsing). Theorem opp_lt_mono : forall n m, n < m <-> - m < - n. Proof. intros n m. now rewrite <- lt_0_sub, <- add_opp_l, <- sub_opp_r, lt_0_sub. Qed. Theorem opp_le_mono : forall n m, n <= m <-> - m <= - n. Proof. intros n m. now rewrite <- le_0_sub, <- add_opp_l, <- sub_opp_r, le_0_sub. Qed. Theorem opp_pos_neg : forall n, 0 < - n <-> n < 0. Proof. intro n; now rewrite (opp_lt_mono n 0), opp_0. Qed. Theorem opp_neg_pos : forall n, - n < 0 <-> 0 < n. Proof. intro n. now rewrite (opp_lt_mono 0 n), opp_0. Qed. Theorem opp_nonneg_nonpos : forall n, 0 <= - n <-> n <= 0. Proof. intro n; now rewrite (opp_le_mono n 0), opp_0. Qed. Theorem opp_nonpos_nonneg : forall n, - n <= 0 <-> 0 <= n. Proof. intro n. now rewrite (opp_le_mono 0 n), opp_0. Qed. Theorem lt_m1_0 : -1 < 0. Proof. apply opp_neg_pos, lt_0_1. Qed. Theorem sub_lt_mono_l : forall n m p, n < m <-> p - m < p - n. Proof. intros. now rewrite <- 2 add_opp_r, <- add_lt_mono_l, opp_lt_mono. Qed. Theorem sub_lt_mono_r : forall n m p, n < m <-> n - p < m - p. Proof. intros. now rewrite <- 2 add_opp_r, add_lt_mono_r. Qed. Theorem sub_lt_mono : forall n m p q, n < m -> q < p -> n - p < m - q. Proof. intros n m p q H1 H2. apply lt_trans with (m - p); [now apply sub_lt_mono_r | now apply sub_lt_mono_l]. Qed. Theorem sub_le_mono_l : forall n m p, n <= m <-> p - m <= p - n. Proof. intros. now rewrite <- 2 add_opp_r, <- add_le_mono_l, opp_le_mono. Qed. Theorem sub_le_mono_r : forall n m p, n <= m <-> n - p <= m - p. Proof. intros. now rewrite <- 2 add_opp_r, add_le_mono_r. Qed. Theorem sub_le_mono : forall n m p q, n <= m -> q <= p -> n - p <= m - q. Proof. intros n m p q H1 H2. apply le_trans with (m - p); [now apply sub_le_mono_r | now apply sub_le_mono_l]. Qed. Theorem sub_lt_le_mono : forall n m p q, n < m -> q <= p -> n - p < m - q. Proof. intros n m p q H1 H2. apply lt_le_trans with (m - p); [now apply sub_lt_mono_r | now apply sub_le_mono_l]. Qed. Theorem sub_le_lt_mono : forall n m p q, n <= m -> q < p -> n - p < m - q. Proof. intros n m p q H1 H2. apply le_lt_trans with (m - p); [now apply sub_le_mono_r | now apply sub_lt_mono_l]. Qed. Theorem le_lt_sub_lt : forall n m p q, n <= m -> p - n < q - m -> p < q. Proof. intros n m p q H1 H2. apply (le_lt_add_lt (- m) (- n)); [now apply -> opp_le_mono | now rewrite 2 add_opp_r]. Qed. Theorem lt_le_sub_lt : forall n m p q, n < m -> p - n <= q - m -> p < q. Proof. intros n m p q H1 H2. apply (lt_le_add_lt (- m) (- n)); [now apply -> opp_lt_mono | now rewrite 2 add_opp_r]. Qed. Theorem le_le_sub_lt : forall n m p q, n <= m -> p - n <= q - m -> p <= q. Proof. intros n m p q H1 H2. apply (le_le_add_le (- m) (- n)); [now apply -> opp_le_mono | now rewrite 2 add_opp_r]. Qed. Theorem lt_add_lt_sub_r : forall n m p, n + p < m <-> n < m - p. Proof. intros n m p. now rewrite (sub_lt_mono_r _ _ p), add_simpl_r. Qed. Theorem le_add_le_sub_r : forall n m p, n + p <= m <-> n <= m - p. Proof. intros n m p. now rewrite (sub_le_mono_r _ _ p), add_simpl_r. Qed. Theorem lt_add_lt_sub_l : forall n m p, n + p < m <-> p < m - n. Proof. intros n m p. rewrite add_comm; apply lt_add_lt_sub_r. Qed. Theorem le_add_le_sub_l : forall n m p, n + p <= m <-> p <= m - n. Proof. intros n m p. rewrite add_comm; apply le_add_le_sub_r. Qed. Theorem lt_sub_lt_add_r : forall n m p, n - p < m <-> n < m + p. Proof. intros n m p. now rewrite (add_lt_mono_r _ _ p), sub_simpl_r. Qed. Theorem le_sub_le_add_r : forall n m p, n - p <= m <-> n <= m + p. Proof. intros n m p. now rewrite (add_le_mono_r _ _ p), sub_simpl_r. Qed. Theorem lt_sub_lt_add_l : forall n m p, n - m < p <-> n < m + p. Proof. intros n m p. rewrite add_comm; apply lt_sub_lt_add_r. Qed. Theorem le_sub_le_add_l : forall n m p, n - m <= p <-> n <= m + p. Proof. intros n m p. rewrite add_comm; apply le_sub_le_add_r. Qed. Theorem lt_sub_lt_add : forall n m p q, n - m < p - q <-> n + q < m + p. Proof. intros n m p q. now rewrite lt_sub_lt_add_l, add_sub_assoc, <- lt_add_lt_sub_r. Qed. Theorem le_sub_le_add : forall n m p q, n - m <= p - q <-> n + q <= m + p. Proof. intros n m p q. now rewrite le_sub_le_add_l, add_sub_assoc, <- le_add_le_sub_r. Qed. Theorem lt_sub_pos : forall n m, 0 < m <-> n - m < n. Proof. intros n m. now rewrite (sub_lt_mono_l _ _ n), sub_0_r. Qed. Theorem le_sub_nonneg : forall n m, 0 <= m <-> n - m <= n. Proof. intros n m. now rewrite (sub_le_mono_l _ _ n), sub_0_r. Qed. Theorem sub_lt_cases : forall n m p q, n - m < p - q -> n < m \/ q < p. Proof. intros. now apply add_lt_cases, lt_sub_lt_add. Qed. Theorem sub_le_cases : forall n m p q, n - m <= p - q -> n <= m \/ q <= p. Proof. intros. now apply add_le_cases, le_sub_le_add. Qed. Theorem sub_neg_cases : forall n m, n - m < 0 -> n < 0 \/ 0 < m. Proof. intros n m ?. rewrite <- (opp_neg_pos m). apply add_neg_cases. now rewrite add_opp_r. Qed. Theorem sub_pos_cases : forall n m, 0 < n - m -> 0 < n \/ m < 0. Proof. intros n m ?. rewrite <- (opp_pos_neg m). apply add_pos_cases. now rewrite add_opp_r. Qed. Theorem sub_nonpos_cases : forall n m, n - m <= 0 -> n <= 0 \/ 0 <= m. Proof. intros n m ?. rewrite <- (opp_nonpos_nonneg m). apply add_nonpos_cases. now rewrite add_opp_r. Qed. Theorem sub_nonneg_cases : forall n m, 0 <= n - m -> 0 <= n \/ m <= 0. Proof. intros n m ?. rewrite <- (opp_nonneg_nonpos m). apply add_nonneg_cases. now rewrite add_opp_r. Qed. Section PosNeg. Variable P : Z.t -> Prop. Hypothesis P_wd : Proper (eq ==> iff) P. Theorem zero_pos_neg : P 0 -> (forall n, 0 < n -> P n /\ P (- n)) -> forall n, P n. Proof. intros H1 H2 n. destruct (lt_trichotomy n 0) as [H3 | [H3 | H3]]. - apply opp_pos_neg, H2 in H3. destruct H3 as [_ H3]. now rewrite opp_involutive in H3. - now rewrite H3. - apply H2 in H3; now destruct H3. Qed. End PosNeg. Ltac zero_pos_neg n := induction_maker n ltac:(apply zero_pos_neg). End ZAddOrderProp. coq-8.20.0/theories/Numbers/Integer/Abstract/ZAxioms.v000066400000000000000000000111671466560755400225710ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* t. End Opp. Module Type OppNotation (T:Typ)(Import O : Opp T). Notation "- x" := (opp x) (at level 35, right associativity). End OppNotation. Module Type Opp' (T:Typ) := Opp T <+ OppNotation T. Module Type IsOpp (Import Z : NZAxiomsSig')(Import O : Opp' Z). #[global] Declare Instance opp_wd : Proper (eq==>eq) opp. Axiom opp_0 : - 0 == 0. Axiom opp_succ : forall n, - (S n) == P (- n). End IsOpp. Module Type OppCstNotation (Import A : NZAxiomsSig)(Import B : Opp A). Notation "- 1" := (opp one). Notation "- 2" := (opp two). End OppCstNotation. Module Type ZAxiomsMiniSig := NZOrdAxiomsSig <+ ZAxiom <+ Opp <+ IsOpp. Module Type ZAxiomsMiniSig' := NZOrdAxiomsSig' <+ ZAxiom <+ Opp' <+ IsOpp <+ OppCstNotation. (** Other functions and their specifications *) (** Absolute value *) Module Type HasAbs(Import Z : ZAxiomsMiniSig'). Parameter Inline abs : t -> t. Axiom abs_eq : forall n, 0<=n -> abs n == n. Axiom abs_neq : forall n, n<=0 -> abs n == -n. End HasAbs. (** A sign function *) Module Type HasSgn (Import Z : ZAxiomsMiniSig'). Parameter Inline sgn : t -> t. Axiom sgn_null : forall n, n==0 -> sgn n == 0. Axiom sgn_pos : forall n, 0 sgn n == 1. Axiom sgn_neg : forall n, n<0 -> sgn n == -1. End HasSgn. (** Divisions *) (** First, the usual Coq convention of Truncated-Toward-Bottom (a.k.a Floor). We simply extend the NZ signature. *) Module Type ZDivSpecific (Import A:ZAxiomsMiniSig')(Import B : DivMod' A). Axiom mod_pos_bound : forall a b, 0 < b -> 0 <= a mod b < b. Axiom mod_neg_bound : forall a b, b < 0 -> b < a mod b <= 0. End ZDivSpecific. Module Type ZDiv (Z:ZAxiomsMiniSig) := NZDiv.NZDiv Z <+ ZDivSpecific Z. Module Type ZDiv' (Z:ZAxiomsMiniSig) := NZDiv.NZDiv' Z <+ ZDivSpecific Z. (** Then, the Truncated-Toward-Zero convention. For not colliding with Floor operations, we use different names *) Module Type QuotRem (Import A : Typ). Parameters Inline quot rem : t -> t -> t. End QuotRem. Module Type QuotRemNotation (A : Typ)(Import B : QuotRem A). Infix "÷" := quot (at level 40, left associativity). Infix "rem" := rem (at level 40, no associativity). End QuotRemNotation. Module Type QuotRem' (A : Typ) := QuotRem A <+ QuotRemNotation A. Module Type QuotRemSpec (Import A : ZAxiomsMiniSig')(Import B : QuotRem' A). #[global] Declare Instance quot_wd : Proper (eq==>eq==>eq) quot. #[global] Declare Instance rem_wd : Proper (eq==>eq==>eq) B.rem. Axiom quot_rem : forall a b, b ~= 0 -> a == b*(a÷b) + (a rem b). Axiom rem_bound_pos : forall a b, 0<=a -> 0 0 <= a rem b < b. Axiom rem_opp_l : forall a b, b ~= 0 -> (-a) rem b == - (a rem b). Axiom rem_opp_r : forall a b, b ~= 0 -> a rem (-b) == a rem b. End QuotRemSpec. Module Type ZQuot (Z:ZAxiomsMiniSig) := QuotRem Z <+ QuotRemSpec Z. Module Type ZQuot' (Z:ZAxiomsMiniSig) := QuotRem' Z <+ QuotRemSpec Z. (** For all other functions, the NZ axiomatizations are enough. *) (** Let's group everything *) Module Type ZAxiomsSig := ZAxiomsMiniSig <+ OrderFunctions <+ HasAbs <+ HasSgn <+ NZParity.NZParity <+ NZPow.NZPow <+ NZSqrt.NZSqrt <+ NZLog.NZLog2 <+ NZGcd.NZGcd <+ ZDiv <+ ZQuot <+ NZBits.NZBits <+ NZSquare. Module Type ZAxiomsSig' := ZAxiomsMiniSig' <+ OrderFunctions' <+ HasAbs <+ HasSgn <+ NZParity.NZParity <+ NZPow.NZPow' <+ NZSqrt.NZSqrt' <+ NZLog.NZLog2 <+ NZGcd.NZGcd' <+ ZDiv' <+ ZQuot' <+ NZBits.NZBits' <+ NZSquare. coq-8.20.0/theories/Numbers/Integer/Abstract/ZBase.v000066400000000000000000000026211466560755400221760ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* n == m. Proof. intros n m H. apply succ_wd in H. now rewrite 2 succ_pred in H. Qed. Theorem pred_inj_wd : forall n1 n2, P n1 == P n2 <-> n1 == n2. Proof. intros n1 n2; split; [apply pred_inj | intros; now f_equiv]. Qed. Lemma succ_m1 : S (-1) == 0. Proof. now rewrite one_succ, opp_succ, opp_0, succ_pred. Qed. End ZBaseProp. coq-8.20.0/theories/Numbers/Integer/Abstract/ZBits.v000066400000000000000000001674221466560755400222400ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* 0<=c<=b -> a^(b-c) == a^b / a^c. Proof. intros a b c Ha (H,H'). rewrite <- (sub_simpl_r b c) at 2. rewrite pow_add_r; trivial. - rewrite div_mul. { reflexivity. } now apply pow_nonzero. - now apply le_0_sub. Qed. Lemma pow_div_l : forall a b c, b~=0 -> 0<=c -> a mod b == 0 -> (a/b)^c == a^c / b^c. Proof. intros a b c Hb Hc H. rewrite (div_mod a b Hb) at 2. rewrite H, add_0_r, pow_mul_l, mul_comm, div_mul. { reflexivity. } now apply pow_nonzero. Qed. (** An injection from bits [true] and [false] to numbers 1 and 0. We declare it as a (local) coercion for shorter statements. *) Definition b2z (b:bool) := if b then 1 else 0. Local Coercion b2z : bool >-> t. #[global] Instance b2z_wd : Proper (Logic.eq ==> eq) b2z := _. Lemma exists_div2 a : exists a' (b:bool), a == 2*a' + b. Proof. elim (Even_or_Odd a); [intros (a',H)| intros (a',H)]. - exists a'. exists false. now nzsimpl. - exists a'. exists true. now simpl. Qed. (** We can compact [testbit_odd_0] [testbit_even_0] [testbit_even_succ] [testbit_odd_succ] in only two lemmas. *) Lemma testbit_0_r a (b:bool) : testbit (2*a+b) 0 = b. Proof. destruct b; simpl; rewrite ?add_0_r. - apply testbit_odd_0. - apply testbit_even_0. Qed. Lemma testbit_succ_r a (b:bool) n : 0<=n -> testbit (2*a+b) (succ n) = testbit a n. Proof. destruct b; simpl; rewrite ?add_0_r. - now apply testbit_odd_succ. - now apply testbit_even_succ. Qed. (** Alternative characterisations of [testbit] *) (** This concise equation could have been taken as specification for testbit in the interface, but it would have been hard to implement with little initial knowledge about div and mod *) Lemma testbit_spec' a n : 0<=n -> a.[n] == (a / 2^n) mod 2. Proof. intro Hn. revert a. apply le_ind with (4:=Hn). - solve_proper. - intros a. nzsimpl. destruct (exists_div2 a) as (a' & b & H). rewrite H at 1. rewrite testbit_0_r. apply mod_unique with a'; trivial. left. destruct b; split; simpl; order'. - clear n Hn. intros n Hn IH a. destruct (exists_div2 a) as (a' & b & H). rewrite H at 1. rewrite testbit_succ_r, IH by trivial. f_equiv. rewrite pow_succ_r, <- div_div by order_pos. f_equiv. apply div_unique with b; trivial. left. destruct b; split; simpl; order'. Qed. (** This characterisation that uses only basic operations and power was initially taken as specification for testbit. We describe [a] as having a low part and a high part, with the corresponding bit in the middle. This characterisation is moderatly complex to implement, but also moderately usable... *) Lemma testbit_spec a n : 0<=n -> exists l h, 0<=l<2^n /\ a == l + (a.[n] + 2*h)*2^n. Proof. intro Hn. exists (a mod 2^n). exists (a / 2^n / 2). split. - apply mod_pos_bound; order_pos. - rewrite add_comm, mul_comm, (add_comm a.[n]). rewrite (div_mod a (2^n)) at 1 by order_nz. do 2 f_equiv. rewrite testbit_spec' by trivial. apply div_mod. order'. Qed. Lemma testbit_true : forall a n, 0<=n -> (a.[n] = true <-> (a / 2^n) mod 2 == 1). Proof. intros a n Hn. rewrite <- testbit_spec' by trivial. destruct a.[n]; split; simpl; now try order'. Qed. Lemma testbit_false : forall a n, 0<=n -> (a.[n] = false <-> (a / 2^n) mod 2 == 0). Proof. intros a n Hn. rewrite <- testbit_spec' by trivial. destruct a.[n]; split; simpl; now try order'. Qed. Lemma testbit_eqb : forall a n, 0<=n -> a.[n] = eqb ((a / 2^n) mod 2) 1. Proof. intros a n Hn. apply eq_true_iff_eq. now rewrite testbit_true, eqb_eq. Qed. (** Results about the injection [b2z] *) Lemma b2z_inj : forall (a0 b0:bool), a0 == b0 -> a0 = b0. Proof. intros [|] [|]; simpl; trivial; order'. Qed. Lemma add_b2z_double_div2 : forall (a0:bool) a, (a0+2*a)/2 == a. Proof. intros a0 a. rewrite mul_comm, div_add by order'. now rewrite div_small, add_0_l by (destruct a0; split; simpl; order'). Qed. Lemma add_b2z_double_bit0 : forall (a0:bool) a, (a0+2*a).[0] = a0. Proof. intros a0 a. apply b2z_inj. rewrite testbit_spec' by order. nzsimpl. rewrite mul_comm, mod_add by order'. now rewrite mod_small by (destruct a0; split; simpl; order'). Qed. Lemma b2z_div2 : forall (a0:bool), a0/2 == 0. Proof. intros a0. rewrite <- (add_b2z_double_div2 a0 0). now nzsimpl. Qed. Lemma b2z_bit0 : forall (a0:bool), a0.[0] = a0. Proof. intros a0. rewrite <- (add_b2z_double_bit0 a0 0) at 2. now nzsimpl. Qed. (** The specification of testbit by low and high parts is complete *) Lemma testbit_unique : forall a n (a0:bool) l h, 0<=l<2^n -> a == l + (a0 + 2*h)*2^n -> a.[n] = a0. Proof. intros a n a0 l h Hl EQ. assert (0<=n). { destruct (le_gt_cases 0 n) as [Hn|Hn]; trivial. rewrite pow_neg_r in Hl by trivial. destruct Hl; order. } apply b2z_inj. rewrite testbit_spec' by trivial. symmetry. apply mod_unique with h. - left; destruct a0; simpl; split; order'. - symmetry. apply div_unique with l. + now left. + now rewrite add_comm, (add_comm _ a0), mul_comm. Qed. (** All bits of number 0 are 0 *) Lemma bits_0 : forall n, 0.[n] = false. Proof. intros n. destruct (le_gt_cases 0 n). - apply testbit_false; trivial. nzsimpl; order_nz. - now apply testbit_neg_r. Qed. (** For negative numbers, we are actually doing two's complement *) Lemma bits_opp : forall a n, 0<=n -> (-a).[n] = negb (P a).[n]. Proof. intros a n Hn. destruct (testbit_spec (-a) n Hn) as (l & h & Hl & EQ). fold (b2z (-a).[n]) in EQ. apply negb_sym. apply testbit_unique with (2^n-l-1) (-h-1). - split. + apply lt_succ_r. rewrite sub_1_r, succ_pred. now apply lt_0_sub. + apply le_succ_l. rewrite sub_1_r, succ_pred. apply le_sub_le_add_r. rewrite <- (add_0_r (2^n)) at 1. now apply add_le_mono_l. - rewrite <- add_sub_swap, sub_1_r. f_equiv. apply opp_inj. rewrite opp_add_distr, opp_sub_distr. rewrite (add_comm _ l), <- add_assoc. rewrite EQ at 1. apply add_cancel_l. rewrite <- opp_add_distr. rewrite <- (mul_1_l (2^n)) at 2. rewrite <- mul_add_distr_r. rewrite <- mul_opp_l. f_equiv. rewrite !opp_add_distr. rewrite <- mul_opp_r. rewrite opp_sub_distr, opp_involutive. rewrite (add_comm h). rewrite mul_add_distr_l. rewrite !add_assoc. apply add_cancel_r. rewrite mul_1_r. rewrite add_comm, add_assoc, !add_opp_r, sub_1_r, two_succ, pred_succ. destruct (-a).[n]; simpl. + now rewrite sub_0_r. + now nzsimpl'. Qed. (** All bits of number (-1) are 1 *) Lemma bits_m1 : forall n, 0<=n -> (-1).[n] = true. Proof. intros. now rewrite bits_opp, one_succ, pred_succ, bits_0. Qed. (** Various ways to refer to the lowest bit of a number *) Lemma bit0_odd : forall a, a.[0] = odd a. Proof. intros a. symmetry. destruct (exists_div2 a) as (a' & b & EQ). rewrite EQ, testbit_0_r, add_comm, odd_add_mul_2. destruct b; simpl; apply odd_1 || apply odd_0. Qed. Lemma bit0_eqb : forall a, a.[0] = eqb (a mod 2) 1. Proof. intros a. rewrite testbit_eqb by order. now nzsimpl. Qed. Lemma bit0_mod : forall a, a.[0] == a mod 2. Proof. intros a. rewrite testbit_spec' by order. now nzsimpl. Qed. (** Hence testing a bit is equivalent to shifting and testing parity *) Lemma testbit_odd : forall a n, a.[n] = odd (a>>n). Proof. intros. now rewrite <- bit0_odd, shiftr_spec, add_0_l. Qed. (** [log2] gives the highest nonzero bit of positive numbers *) Lemma bit_log2 : forall a, 0 a.[log2 a] = true. Proof. intros a Ha. assert (Ha' := log2_nonneg a). destruct (log2_spec_alt a Ha) as (r & EQ & Hr). rewrite EQ at 1. rewrite testbit_true, add_comm by trivial. rewrite <- (mul_1_l (2^log2 a)) at 1. rewrite div_add by order_nz. rewrite div_small; trivial. rewrite add_0_l. apply mod_small. split; order'. Qed. Lemma bits_above_log2 : forall a n, 0<=a -> log2 a < n -> a.[n] = false. Proof. intros a n Ha H. assert (Hn : 0<=n). { transitivity (log2 a). - apply log2_nonneg. - order'. } rewrite testbit_false by trivial. rewrite div_small. { nzsimpl; order'. } split. - order. - apply log2_lt_cancel. now rewrite log2_pow2. Qed. (** Hence the number of bits of [a] is [1+log2 a] (see [Pos.size_nat] and [Pos.size]). *) (** For negative numbers, things are the other ways around: log2 gives the highest zero bit (for numbers below -1). *) Lemma bit_log2_neg : forall a, a < -1 -> a.[log2 (P (-a))] = false. Proof. intros a Ha. rewrite <- (opp_involutive a) at 1. rewrite bits_opp. - apply negb_false_iff. apply bit_log2. apply opp_lt_mono in Ha. rewrite opp_involutive in Ha. apply lt_succ_lt_pred. now rewrite <- one_succ. - apply log2_nonneg. Qed. Lemma bits_above_log2_neg : forall a n, a < 0 -> log2 (P (-a)) < n -> a.[n] = true. Proof. intros a n Ha H. assert (Hn : 0<=n). { transitivity (log2 (P (-a))). - apply log2_nonneg. - order'. } rewrite <- (opp_involutive a), bits_opp, negb_true_iff by trivial. apply bits_above_log2; trivial. now rewrite <- opp_succ, opp_nonneg_nonpos, le_succ_l. Qed. (** Accessing a high enough bit of a number gives its sign *) Lemma bits_iff_nonneg : forall a n, log2 (abs a) < n -> (0<=a <-> a.[n] = false). Proof. intros a n Hn. split; intros H. - rewrite abs_eq in Hn; trivial. now apply bits_above_log2. - destruct (le_gt_cases 0 a); trivial. rewrite abs_neq in Hn by order. rewrite bits_above_log2_neg in H; try easy. apply le_lt_trans with (log2 (-a)); trivial. apply log2_le_mono. apply le_pred_l. Qed. Lemma bits_iff_nonneg' : forall a, 0<=a <-> a.[S (log2 (abs a))] = false. Proof. intros. apply bits_iff_nonneg. apply lt_succ_diag_r. Qed. Lemma bits_iff_nonneg_ex : forall a, 0<=a <-> (exists k, forall m, k a.[m] = false). Proof. intros a. split. - intros Ha. exists (log2 a). intros m Hm. now apply bits_above_log2. - intros (k,Hk). destruct (le_gt_cases k (log2 (abs a))). + now apply bits_iff_nonneg', Hk, lt_succ_r. + apply (bits_iff_nonneg a (S k)). * now apply lt_succ_r, lt_le_incl. * apply Hk. apply lt_succ_diag_r. Qed. Lemma bits_iff_neg : forall a n, log2 (abs a) < n -> (a<0 <-> a.[n] = true). Proof. intros a n Hn. now rewrite lt_nge, <- not_false_iff_true, (bits_iff_nonneg a n). Qed. Lemma bits_iff_neg' : forall a, a<0 <-> a.[S (log2 (abs a))] = true. Proof. intros. apply bits_iff_neg. apply lt_succ_diag_r. Qed. Lemma bits_iff_neg_ex : forall a, a<0 <-> (exists k, forall m, k a.[m] = true). Proof. intros a. split. - intros Ha. exists (log2 (P (-a))). intros m Hm. now apply bits_above_log2_neg. - intros (k,Hk). destruct (le_gt_cases k (log2 (abs a))). + now apply bits_iff_neg', Hk, lt_succ_r. + apply (bits_iff_neg a (S k)). * now apply lt_succ_r, lt_le_incl. * apply Hk. apply lt_succ_diag_r. Qed. (** Testing bits after division or multiplication by a power of two *) Lemma div2_bits : forall a n, 0<=n -> (a/2).[n] = a.[S n]. Proof. intros a n Hn. apply eq_true_iff_eq. rewrite 2 testbit_true by order_pos. rewrite pow_succ_r by trivial. now rewrite div_div by order_pos. Qed. Lemma div_pow2_bits : forall a n m, 0<=n -> 0<=m -> (a/2^n).[m] = a.[m+n]. Proof. intros a n m Hn. revert a m. apply le_ind with (4:=Hn). - solve_proper. - intros a m Hm. now nzsimpl. - clear n Hn. intros n Hn IH a m Hm. nzsimpl; trivial. rewrite <- div_div by order_pos. now rewrite IH, div2_bits by order_pos. Qed. Lemma double_bits_succ : forall a n, (2*a).[S n] = a.[n]. Proof. intros a n. destruct (le_gt_cases 0 n) as [Hn|Hn]. - now rewrite <- div2_bits, mul_comm, div_mul by order'. - rewrite (testbit_neg_r a n Hn). apply le_succ_l in Hn. le_elim Hn. + now rewrite testbit_neg_r. + now rewrite Hn, bit0_odd, odd_mul, odd_2. Qed. Lemma double_bits : forall a n, (2*a).[n] = a.[P n]. Proof. intros a n. rewrite <- (succ_pred n) at 1. apply double_bits_succ. Qed. Lemma mul_pow2_bits_add : forall a n m, 0<=n -> (a*2^n).[n+m] = a.[m]. Proof. intros a n m Hn. revert a m. apply le_ind with (4:=Hn). - solve_proper. - intros a m. now nzsimpl. - clear n Hn. intros n Hn IH a m. nzsimpl; trivial. rewrite mul_assoc, (mul_comm _ 2), <- mul_assoc. now rewrite double_bits_succ. Qed. Lemma mul_pow2_bits : forall a n m, 0<=n -> (a*2^n).[m] = a.[m-n]. Proof. intros a n m ?. rewrite <- (add_simpl_r m n) at 1. rewrite add_sub_swap, add_comm. now apply mul_pow2_bits_add. Qed. Lemma mul_pow2_bits_low : forall a n m, m (a*2^n).[m] = false. Proof. intros a n m ?. destruct (le_gt_cases 0 n). - rewrite mul_pow2_bits by trivial. apply testbit_neg_r. now apply lt_sub_0. - now rewrite pow_neg_r, mul_0_r, bits_0. Qed. (** Selecting the low part of a number can be done by a modulo *) Lemma mod_pow2_bits_high : forall a n m, 0<=n<=m -> (a mod 2^n).[m] = false. Proof. intros a n m (Hn,H). destruct (mod_pos_bound a (2^n)) as [LE LT]. { order_pos. } le_elim LE. - apply bits_above_log2; try order. apply lt_le_trans with n; trivial. apply log2_lt_pow2; trivial. - now rewrite <- LE, bits_0. Qed. Lemma mod_pow2_bits_low : forall a n m, m (a mod 2^n).[m] = a.[m]. Proof. intros a n m H. destruct (le_gt_cases 0 m) as [Hm|Hm]; [|now rewrite !testbit_neg_r]. rewrite testbit_eqb; trivial. rewrite <- (mod_add _ (2^(P (n-m))*(a/2^n))) by order'. rewrite <- div_add by order_nz. rewrite (mul_comm _ 2), mul_assoc, <- pow_succ_r, succ_pred. - rewrite mul_comm, mul_assoc, <- pow_add_r, (add_comm m), sub_add; trivial. + rewrite add_comm, <- div_mod by order_nz. symmetry. apply testbit_eqb; trivial. + apply le_0_sub; order. - now apply lt_le_pred, lt_0_sub. Qed. (** We now prove that having the same bits implies equality. For that we use a notion of equality over functional streams of bits. *) Definition eqf (f g:t -> bool) := forall n:t, f n = g n. #[global] Instance eqf_equiv : Equivalence eqf. Proof. split; congruence. Qed. Local Infix "===" := eqf (at level 70, no associativity). #[global] Instance testbit_eqf : Proper (eq==>eqf) testbit. Proof. intros a a' Ha n. now rewrite Ha. Qed. (** Only zero corresponds to the always-false stream. *) Lemma bits_inj_0 : forall a, (forall n, a.[n] = false) -> a == 0. Proof. intros a H. destruct (lt_trichotomy a 0) as [Ha|[Ha|Ha]]; trivial. - apply (bits_above_log2_neg a (S (log2 (P (-a))))) in Ha. + now rewrite H in Ha. + apply lt_succ_diag_r. - apply bit_log2 in Ha. now rewrite H in Ha. Qed. (** If two numbers produce the same stream of bits, they are equal. *) Lemma bits_inj : forall a b, testbit a === testbit b -> a == b. Proof. assert (AUX : forall n, 0<=n -> forall a b, 0<=a<2^n -> testbit a === testbit b -> a == b). { intros n Hn. apply le_ind with (4:=Hn). - solve_proper. - intros a b Ha H. rewrite pow_0_r, one_succ, lt_succ_r in Ha. assert (Ha' : a == 0) by (destruct Ha; order). rewrite Ha' in *. symmetry. apply bits_inj_0. intros m. now rewrite <- H, bits_0. - clear n Hn. intros n Hn IH a b (Ha,Ha') H. rewrite (div_mod a 2), (div_mod b 2) by order'. f_equiv; [ | now rewrite <- 2 bit0_mod, H]. f_equiv. apply IH. + split. * apply div_pos; order'. * apply div_lt_upper_bound. { order'. } now rewrite <- pow_succ_r. + intros m. destruct (le_gt_cases 0 m). * rewrite 2 div2_bits by trivial. apply H. * now rewrite 2 testbit_neg_r. } intros a b H. destruct (le_gt_cases 0 a) as [Ha|Ha]. - apply (AUX a); trivial. split; trivial. apply pow_gt_lin_r; order'. - apply succ_inj, opp_inj. assert (0 <= - S a). { apply opp_le_mono. now rewrite opp_involutive, opp_0, le_succ_l. } apply (AUX (-(S a))); trivial. + split; trivial. apply pow_gt_lin_r; order'. + intros m. destruct (le_gt_cases 0 m). * now rewrite 2 bits_opp, 2 pred_succ, H. * now rewrite 2 testbit_neg_r. Qed. Lemma bits_inj_iff : forall a b, testbit a === testbit b <-> a == b. Proof. split. - apply bits_inj. - intros EQ; now rewrite EQ. Qed. (** In fact, checking the bits at positive indexes is enough. *) Lemma bits_inj' : forall a b, (forall n, 0<=n -> a.[n] = b.[n]) -> a == b. Proof. intros a b H. apply bits_inj. intros n. destruct (le_gt_cases 0 n). - now apply H. - now rewrite 2 testbit_neg_r. Qed. Lemma bits_inj_iff' : forall a b, (forall n, 0<=n -> a.[n] = b.[n]) <-> a == b. Proof. split. - apply bits_inj'. - intros EQ n Hn; now rewrite EQ. Qed. Tactic Notation "bitwise" "as" simple_intropattern(m) simple_intropattern(Hm) := apply bits_inj'; intros m Hm; autorewrite with bitwise. Ltac bitwise := bitwise as ?m ?Hm. Global Hint Rewrite lxor_spec lor_spec land_spec ldiff_spec bits_0 : bitwise. (** The streams of bits that correspond to a numbers are exactly the ones which are stationary after some point. *) Lemma are_bits : forall (f:t->bool), Proper (eq==>Logic.eq) f -> ((exists n, forall m, 0<=m -> f m = n.[m]) <-> (exists k, forall m, k<=m -> f m = f k)). Proof. intros f Hf. split. - intros (a,H). destruct (le_gt_cases 0 a). + exists (S (log2 a)). intros m Hm. apply le_succ_l in Hm. rewrite 2 H, 2 bits_above_log2; trivial using lt_succ_diag_r. { order_pos. } apply le_trans with (log2 a); order_pos. + exists (S (log2 (P (-a)))). intros m Hm. apply le_succ_l in Hm. rewrite 2 H, 2 bits_above_log2_neg; trivial using lt_succ_diag_r. { order_pos. } apply le_trans with (log2 (P (-a))); order_pos. - intros (k,Hk). destruct (lt_ge_cases k 0) as [LT|LE]. + case_eq (f 0); intros H0. * exists (-1). intros m Hm. rewrite bits_m1, Hk by order. symmetry; rewrite <- H0. apply Hk; order. * exists 0. intros m Hm. rewrite bits_0, Hk by order. symmetry; rewrite <- H0. apply Hk; order. + revert f Hf Hk. apply le_ind with (4:=LE). * (* compat : solve_proper fails here *) apply proper_sym_impl_iff. { exact eq_sym. } clear k LE. intros k k' Hk IH f Hf H. apply IH; trivial. now setoid_rewrite Hk. * (* /compat *) { intros f Hf H0. destruct (f 0). - exists (-1). intros m Hm. now rewrite bits_m1, H0. - exists 0. intros m Hm. now rewrite bits_0, H0. } * { clear k LE. intros k LE IH f Hf Hk. destruct (IH (fun m => f (S m))) as (n, Hn). - solve_proper. - intros m Hm. apply Hk. now rewrite <- succ_le_mono. - exists (f 0 + 2*n). intros m Hm. le_elim Hm. + rewrite <- (succ_pred m), Hn, <- div2_bits. * rewrite mul_comm, div_add, b2z_div2, add_0_l; trivial. order'. * now rewrite <- lt_succ_r, succ_pred. * now rewrite <- lt_succ_r, succ_pred. + rewrite <- Hm. symmetry. apply add_b2z_double_bit0. } Qed. (** * Properties of shifts *) (** First, a unified specification for [shiftl] : the [shiftl_spec] below (combined with [testbit_neg_r]) is equivalent to [shiftl_spec_low] and [shiftl_spec_high]. *) Lemma shiftl_spec : forall a n m, 0<=m -> (a << n).[m] = a.[m-n]. Proof. intros a n m ?. destruct (le_gt_cases n m). - now apply shiftl_spec_high. - rewrite shiftl_spec_low, testbit_neg_r; trivial. now apply lt_sub_0. Qed. (** A shiftl by a negative number is a shiftr, and vice-versa *) Lemma shiftr_opp_r : forall a n, a >> (-n) == a << n. Proof. intros. bitwise. now rewrite shiftr_spec, shiftl_spec, add_opp_r. Qed. Lemma shiftl_opp_r : forall a n, a << (-n) == a >> n. Proof. intros. bitwise. now rewrite shiftr_spec, shiftl_spec, sub_opp_r. Qed. (** Shifts correspond to multiplication or division by a power of two *) Lemma shiftr_div_pow2 : forall a n, 0<=n -> a >> n == a / 2^n. Proof. intros. bitwise. now rewrite shiftr_spec, div_pow2_bits. Qed. Lemma shiftr_mul_pow2 : forall a n, n<=0 -> a >> n == a * 2^(-n). Proof. intros. bitwise. rewrite shiftr_spec, mul_pow2_bits; trivial. - now rewrite sub_opp_r. - now apply opp_nonneg_nonpos. Qed. Lemma shiftl_mul_pow2 : forall a n, 0<=n -> a << n == a * 2^n. Proof. intros. bitwise. now rewrite shiftl_spec, mul_pow2_bits. Qed. Lemma shiftl_div_pow2 : forall a n, n<=0 -> a << n == a / 2^(-n). Proof. intros. bitwise. rewrite shiftl_spec, div_pow2_bits; trivial. - now rewrite add_opp_r. - now apply opp_nonneg_nonpos. Qed. (** Shifts are morphisms *) #[global] Instance shiftr_wd : Proper (eq==>eq==>eq) shiftr. Proof. intros a a' Ha n n' Hn. destruct (le_ge_cases n 0) as [H|H]; assert (H':=H); rewrite Hn in H'. - now rewrite 2 shiftr_mul_pow2, Ha, Hn. - now rewrite 2 shiftr_div_pow2, Ha, Hn. Qed. #[global] Instance shiftl_wd : Proper (eq==>eq==>eq) shiftl. Proof. intros a a' Ha n n' Hn. now rewrite <- 2 shiftr_opp_r, Ha, Hn. Qed. (** We could also have specified shiftl with an addition on the left. *) Lemma shiftl_spec_alt : forall a n m, 0<=n -> (a << n).[m+n] = a.[m]. Proof. intros. now rewrite shiftl_mul_pow2, mul_pow2_bits, add_simpl_r. Qed. (** Chaining several shifts. The only case for which there isn't any simple expression is a true shiftr followed by a true shiftl. *) Lemma shiftl_shiftl : forall a n m, 0<=n -> (a << n) << m == a << (n+m). Proof. intros a n p Hn. bitwise as m Hm. rewrite 2 (shiftl_spec _ _ m) by trivial. rewrite add_comm, sub_add_distr. destruct (le_gt_cases 0 (m-p)) as [H|H]. - now rewrite shiftl_spec. - rewrite 2 testbit_neg_r; trivial. apply lt_sub_0. now apply lt_le_trans with 0. Qed. Lemma shiftr_shiftl_l : forall a n m, 0<=n -> (a << n) >> m == a << (n-m). Proof. intros. now rewrite <- shiftl_opp_r, shiftl_shiftl, add_opp_r. Qed. Lemma shiftr_shiftl_r : forall a n m, 0<=n -> (a << n) >> m == a >> (m-n). Proof. intros. now rewrite <- 2 shiftl_opp_r, shiftl_shiftl, opp_sub_distr, add_comm. Qed. Lemma shiftr_shiftr : forall a n m, 0<=m -> (a >> n) >> m == a >> (n+m). Proof. intros a n p Hn. bitwise. rewrite 3 shiftr_spec; trivial. - now rewrite (add_comm n p), add_assoc. - now apply add_nonneg_nonneg. Qed. (** shifts and constants *) Lemma shiftl_1_l : forall n, 1 << n == 2^n. Proof. intros n. destruct (le_gt_cases 0 n). - now rewrite shiftl_mul_pow2, mul_1_l. - rewrite shiftl_div_pow2, div_1_l, pow_neg_r; try order. apply pow_gt_1. + order'. + now apply opp_pos_neg. Qed. Lemma shiftl_0_r : forall a, a << 0 == a. Proof. intros. rewrite shiftl_mul_pow2 by order. now nzsimpl. Qed. Lemma shiftr_0_r : forall a, a >> 0 == a. Proof. intros. now rewrite <- shiftl_opp_r, opp_0, shiftl_0_r. Qed. Lemma shiftl_0_l : forall n, 0 << n == 0. Proof. intros n. destruct (le_ge_cases 0 n) as [H|H]. - rewrite shiftl_mul_pow2 by trivial. now nzsimpl. - rewrite shiftl_div_pow2 by trivial. rewrite <- opp_nonneg_nonpos in H. nzsimpl; order_nz. Qed. Lemma shiftr_0_l : forall n, 0 >> n == 0. Proof. intros. now rewrite <- shiftl_opp_r, shiftl_0_l. Qed. Lemma shiftl_eq_0_iff : forall a n, 0<=n -> (a << n == 0 <-> a == 0). Proof. intros a n Hn. rewrite shiftl_mul_pow2 by trivial. rewrite eq_mul_0. split. - intros [H | H]; trivial. contradict H; order_nz. - intros H. now left. Qed. Lemma shiftr_eq_0_iff : forall a n, a >> n == 0 <-> a==0 \/ (0 log2 a < n -> a >> n == 0. Proof. intros a n Ha H. apply shiftr_eq_0_iff. le_elim Ha. - right. now split. - now left. Qed. (** Properties of [div2]. *) Lemma div2_div : forall a, div2 a == a/2. Proof. intros. rewrite div2_spec, shiftr_div_pow2. - now nzsimpl. - order'. Qed. #[global] Instance div2_wd : Proper (eq==>eq) div2. Proof. intros a a' Ha. now rewrite 2 div2_div, Ha. Qed. Lemma div2_odd : forall a, a == 2*(div2 a) + odd a. Proof. intros a. rewrite div2_div, <- bit0_odd, bit0_mod. apply div_mod. order'. Qed. (** Properties of [lxor] and others, directly deduced from properties of [xorb] and others. *) #[global] Instance lxor_wd : Proper (eq ==> eq ==> eq) lxor. Proof. intros a a' Ha b b' Hb. bitwise. now rewrite Ha, Hb. Qed. #[global] Instance land_wd : Proper (eq ==> eq ==> eq) land. Proof. intros a a' Ha b b' Hb. bitwise. now rewrite Ha, Hb. Qed. #[global] Instance lor_wd : Proper (eq ==> eq ==> eq) lor. Proof. intros a a' Ha b b' Hb. bitwise. now rewrite Ha, Hb. Qed. #[global] Instance ldiff_wd : Proper (eq ==> eq ==> eq) ldiff. Proof. intros a a' Ha b b' Hb. bitwise. now rewrite Ha, Hb. Qed. Lemma lxor_eq : forall a a', lxor a a' == 0 -> a == a'. Proof. intros a a' H. bitwise. apply xorb_eq. now rewrite <- lxor_spec, H, bits_0. Qed. Lemma lxor_nilpotent : forall a, lxor a a == 0. Proof. intros. bitwise. apply xorb_nilpotent. Qed. Lemma lxor_eq_0_iff : forall a a', lxor a a' == 0 <-> a == a'. Proof. split. - apply lxor_eq. - intros EQ; rewrite EQ; apply lxor_nilpotent. Qed. Lemma lxor_0_l : forall a, lxor 0 a == a. Proof. intros. bitwise. apply xorb_false_l. Qed. Lemma lxor_0_r : forall a, lxor a 0 == a. Proof. intros. bitwise. apply xorb_false_r. Qed. Lemma lxor_comm : forall a b, lxor a b == lxor b a. Proof. intros. bitwise. apply xorb_comm. Qed. Lemma lxor_assoc : forall a b c, lxor (lxor a b) c == lxor a (lxor b c). Proof. intros. bitwise. apply xorb_assoc. Qed. Lemma lor_0_l : forall a, lor 0 a == a. Proof. intros. bitwise. trivial. Qed. Lemma lor_0_r : forall a, lor a 0 == a. Proof. intros. bitwise. apply orb_false_r. Qed. Lemma lor_comm : forall a b, lor a b == lor b a. Proof. intros. bitwise. apply orb_comm. Qed. Lemma lor_assoc : forall a b c, lor a (lor b c) == lor (lor a b) c. Proof. intros. bitwise. apply orb_assoc. Qed. Lemma lor_diag : forall a, lor a a == a. Proof. intros. bitwise. apply orb_diag. Qed. Lemma lor_eq_0_l : forall a b, lor a b == 0 -> a == 0. Proof. intros a b H. bitwise as m ?. apply (orb_false_iff a.[m] b.[m]). now rewrite <- lor_spec, H, bits_0. Qed. Lemma lor_eq_0_iff : forall a b, lor a b == 0 <-> a == 0 /\ b == 0. Proof. intros a b. split. - intro H; split. + now apply lor_eq_0_l in H. + rewrite lor_comm in H. now apply lor_eq_0_l in H. - intros (EQ,EQ'). now rewrite EQ, lor_0_l. Qed. Lemma land_0_l : forall a, land 0 a == 0. Proof. intros. bitwise. trivial. Qed. Lemma land_0_r : forall a, land a 0 == 0. Proof. intros. bitwise. apply andb_false_r. Qed. Lemma land_comm : forall a b, land a b == land b a. Proof. intros. bitwise. apply andb_comm. Qed. Lemma land_assoc : forall a b c, land a (land b c) == land (land a b) c. Proof. intros. bitwise. apply andb_assoc. Qed. Lemma land_diag : forall a, land a a == a. Proof. intros. bitwise. apply andb_diag. Qed. Lemma ldiff_0_l : forall a, ldiff 0 a == 0. Proof. intros. bitwise. trivial. Qed. Lemma ldiff_0_r : forall a, ldiff a 0 == a. Proof. intros. bitwise. now rewrite andb_true_r. Qed. Lemma ldiff_diag : forall a, ldiff a a == 0. Proof. intros. bitwise. apply andb_negb_r. Qed. Lemma lor_land_distr_l : forall a b c, lor (land a b) c == land (lor a c) (lor b c). Proof. intros. bitwise. apply orb_andb_distrib_l. Qed. Lemma lor_land_distr_r : forall a b c, lor a (land b c) == land (lor a b) (lor a c). Proof. intros. bitwise. apply orb_andb_distrib_r. Qed. Lemma land_lor_distr_l : forall a b c, land (lor a b) c == lor (land a c) (land b c). Proof. intros. bitwise. apply andb_orb_distrib_l. Qed. Lemma land_lor_distr_r : forall a b c, land a (lor b c) == lor (land a b) (land a c). Proof. intros. bitwise. apply andb_orb_distrib_r. Qed. Lemma ldiff_ldiff_l : forall a b c, ldiff (ldiff a b) c == ldiff a (lor b c). Proof. intros. bitwise. now rewrite negb_orb, andb_assoc. Qed. Lemma lor_ldiff_and : forall a b, lor (ldiff a b) (land a b) == a. Proof. intros. bitwise. now rewrite <- andb_orb_distrib_r, orb_comm, orb_negb_r, andb_true_r. Qed. Lemma land_ldiff : forall a b, land (ldiff a b) b == 0. Proof. intros. bitwise. now rewrite <-andb_assoc, (andb_comm (negb _)), andb_negb_r, andb_false_r. Qed. (** Properties of [setbit] and [clearbit] *) Definition setbit a n := lor a (1 << n). Definition clearbit a n := ldiff a (1 << n). Lemma setbit_spec' : forall a n, setbit a n == lor a (2^n). Proof. intros. unfold setbit. now rewrite shiftl_1_l. Qed. Lemma clearbit_spec' : forall a n, clearbit a n == ldiff a (2^n). Proof. intros. unfold clearbit. now rewrite shiftl_1_l. Qed. #[global] Instance setbit_wd : Proper (eq==>eq==>eq) setbit. Proof. unfold setbit. solve_proper. Qed. #[global] Instance clearbit_wd : Proper (eq==>eq==>eq) clearbit. Proof. unfold clearbit. solve_proper. Qed. Lemma pow2_bits_true : forall n, 0<=n -> (2^n).[n] = true. Proof. intros n ?. rewrite <- (mul_1_l (2^n)). now rewrite mul_pow2_bits, sub_diag, bit0_odd, odd_1. Qed. Lemma pow2_bits_false : forall n m, n~=m -> (2^n).[m] = false. Proof. intros n m ?. destruct (le_gt_cases 0 n); [|now rewrite pow_neg_r, bits_0]. destruct (le_gt_cases n m). - rewrite <- (mul_1_l (2^n)), mul_pow2_bits; trivial. rewrite <- (succ_pred (m-n)), <- div2_bits. + now rewrite div_small, bits_0 by (split; order'). + rewrite <- lt_succ_r, succ_pred, lt_0_sub. order. - rewrite <- (mul_1_l (2^n)), mul_pow2_bits_low; trivial. Qed. Lemma pow2_bits_eqb : forall n m, 0<=n -> (2^n).[m] = eqb n m. Proof. intros n m Hn. apply eq_true_iff_eq. rewrite eqb_eq. split. - destruct (eq_decidable n m) as [H|H]. { trivial. } now rewrite (pow2_bits_false _ _ H). - intros EQ. rewrite EQ. apply pow2_bits_true; order. Qed. Lemma setbit_eqb : forall a n m, 0<=n -> (setbit a n).[m] = eqb n m || a.[m]. Proof. intros. now rewrite setbit_spec', lor_spec, pow2_bits_eqb, orb_comm. Qed. Lemma setbit_iff : forall a n m, 0<=n -> ((setbit a n).[m] = true <-> n==m \/ a.[m] = true). Proof. intros. now rewrite setbit_eqb, orb_true_iff, eqb_eq. Qed. Lemma setbit_eq : forall a n, 0<=n -> (setbit a n).[n] = true. Proof. intros. apply setbit_iff; trivial. now left. Qed. Lemma setbit_neq : forall a n m, 0<=n -> n~=m -> (setbit a n).[m] = a.[m]. Proof. intros a n m Hn H. rewrite setbit_eqb; trivial. rewrite <- eqb_eq in H. apply not_true_is_false in H. now rewrite H. Qed. Lemma clearbit_eqb : forall a n m, (clearbit a n).[m] = a.[m] && negb (eqb n m). Proof. intros a n m. destruct (le_gt_cases 0 m); [| now rewrite 2 testbit_neg_r]. rewrite clearbit_spec', ldiff_spec. f_equal. f_equal. destruct (le_gt_cases 0 n) as [Hn|Hn]. - now apply pow2_bits_eqb. - symmetry. rewrite pow_neg_r, bits_0, <- not_true_iff_false, eqb_eq; order. Qed. Lemma clearbit_iff : forall a n m, (clearbit a n).[m] = true <-> a.[m] = true /\ n~=m. Proof. intros. rewrite clearbit_eqb, andb_true_iff, <- eqb_eq. now rewrite negb_true_iff, not_true_iff_false. Qed. Lemma clearbit_eq : forall a n, (clearbit a n).[n] = false. Proof. intros a n. rewrite clearbit_eqb, (proj2 (eqb_eq _ _) (eq_refl n)). apply andb_false_r. Qed. Lemma clearbit_neq : forall a n m, n~=m -> (clearbit a n).[m] = a.[m]. Proof. intros a n m H. rewrite clearbit_eqb. rewrite <- eqb_eq in H. apply not_true_is_false in H. rewrite H. apply andb_true_r. Qed. (** Shifts of bitwise operations *) Lemma shiftl_lxor : forall a b n, (lxor a b) << n == lxor (a << n) (b << n). Proof. intros. bitwise. now rewrite !shiftl_spec, lxor_spec. Qed. Lemma shiftr_lxor : forall a b n, (lxor a b) >> n == lxor (a >> n) (b >> n). Proof. intros. bitwise. now rewrite !shiftr_spec, lxor_spec. Qed. Lemma shiftl_land : forall a b n, (land a b) << n == land (a << n) (b << n). Proof. intros. bitwise. now rewrite !shiftl_spec, land_spec. Qed. Lemma shiftr_land : forall a b n, (land a b) >> n == land (a >> n) (b >> n). Proof. intros. bitwise. now rewrite !shiftr_spec, land_spec. Qed. Lemma shiftl_lor : forall a b n, (lor a b) << n == lor (a << n) (b << n). Proof. intros. bitwise. now rewrite !shiftl_spec, lor_spec. Qed. Lemma shiftr_lor : forall a b n, (lor a b) >> n == lor (a >> n) (b >> n). Proof. intros. bitwise. now rewrite !shiftr_spec, lor_spec. Qed. Lemma shiftl_ldiff : forall a b n, (ldiff a b) << n == ldiff (a << n) (b << n). Proof. intros. bitwise. now rewrite !shiftl_spec, ldiff_spec. Qed. Lemma shiftr_ldiff : forall a b n, (ldiff a b) >> n == ldiff (a >> n) (b >> n). Proof. intros. bitwise. now rewrite !shiftr_spec, ldiff_spec. Qed. (** For integers, we do have a binary complement function *) Definition lnot a := P (-a). #[global] Instance lnot_wd : Proper (eq==>eq) lnot. Proof. unfold lnot. solve_proper. Qed. Lemma lnot_spec : forall a n, 0<=n -> (lnot a).[n] = negb a.[n]. Proof. intros a n ?. unfold lnot. rewrite <- (opp_involutive a) at 2. rewrite bits_opp, negb_involutive; trivial. Qed. Lemma lnot_involutive : forall a, lnot (lnot a) == a. Proof. intros a. bitwise. now rewrite 2 lnot_spec, negb_involutive. Qed. Lemma lnot_0 : lnot 0 == -1. Proof. unfold lnot. now rewrite opp_0, <- sub_1_r, sub_0_l. Qed. Lemma lnot_m1 : lnot (-1) == 0. Proof. unfold lnot. now rewrite opp_involutive, one_succ, pred_succ. Qed. (** Complement and other operations *) Lemma lor_m1_r : forall a, lor a (-1) == -1. Proof. intros. bitwise. now rewrite bits_m1, orb_true_r. Qed. Lemma lor_m1_l : forall a, lor (-1) a == -1. Proof. intros. now rewrite lor_comm, lor_m1_r. Qed. Lemma land_m1_r : forall a, land a (-1) == a. Proof. intros. bitwise. now rewrite bits_m1, andb_true_r. Qed. Lemma land_m1_l : forall a, land (-1) a == a. Proof. intros. now rewrite land_comm, land_m1_r. Qed. Lemma ldiff_m1_r : forall a, ldiff a (-1) == 0. Proof. intros. bitwise. now rewrite bits_m1, andb_false_r. Qed. Lemma ldiff_m1_l : forall a, ldiff (-1) a == lnot a. Proof. intros. bitwise. now rewrite lnot_spec, bits_m1. Qed. Lemma lor_lnot_diag : forall a, lor a (lnot a) == -1. Proof. intros a. bitwise as m ?. rewrite lnot_spec, bits_m1; trivial. now destruct a.[m]. Qed. Lemma add_lnot_diag : forall a, a + lnot a == -1. Proof. intros a. unfold lnot. now rewrite add_pred_r, add_opp_r, sub_diag, one_succ, opp_succ, opp_0. Qed. Lemma ldiff_land : forall a b, ldiff a b == land a (lnot b). Proof. intros. bitwise. now rewrite lnot_spec. Qed. Lemma land_lnot_diag : forall a, land a (lnot a) == 0. Proof. intros. now rewrite <- ldiff_land, ldiff_diag. Qed. Lemma lnot_lor : forall a b, lnot (lor a b) == land (lnot a) (lnot b). Proof. intros a b. bitwise. now rewrite !lnot_spec, lor_spec, negb_orb. Qed. Lemma lnot_land : forall a b, lnot (land a b) == lor (lnot a) (lnot b). Proof. intros a b. bitwise. now rewrite !lnot_spec, land_spec, negb_andb. Qed. Lemma lnot_ldiff : forall a b, lnot (ldiff a b) == lor (lnot a) b. Proof. intros a b. bitwise. now rewrite !lnot_spec, ldiff_spec, negb_andb, negb_involutive. Qed. Lemma lxor_lnot_lnot : forall a b, lxor (lnot a) (lnot b) == lxor a b. Proof. intros a b. bitwise. now rewrite !lnot_spec, xorb_negb_negb. Qed. Lemma lnot_lxor_l : forall a b, lnot (lxor a b) == lxor (lnot a) b. Proof. intros a b. bitwise. now rewrite !lnot_spec, !lxor_spec, negb_xorb_l. Qed. Lemma lnot_lxor_r : forall a b, lnot (lxor a b) == lxor a (lnot b). Proof. intros a b. bitwise. now rewrite !lnot_spec, !lxor_spec, negb_xorb_r. Qed. Lemma lxor_m1_r : forall a, lxor a (-1) == lnot a. Proof. intros a. now rewrite <- (lxor_0_r (lnot a)), <- lnot_m1, lxor_lnot_lnot. Qed. Lemma lxor_m1_l : forall a, lxor (-1) a == lnot a. Proof. intros. now rewrite lxor_comm, lxor_m1_r. Qed. Lemma lxor_lor : forall a b, land a b == 0 -> lxor a b == lor a b. Proof. intros a b H. bitwise as m ?. assert (a.[m] && b.[m] = false) by now rewrite <- land_spec, H, bits_0. now destruct a.[m], b.[m]. Qed. Lemma lnot_shiftr : forall a n, 0<=n -> lnot (a >> n) == (lnot a) >> n. Proof. intros a n Hn. bitwise. now rewrite lnot_spec, 2 shiftr_spec, lnot_spec by order_pos. Qed. (** [(ones n)] is [2^n-1], the number with [n] digits 1 *) Definition ones n := P (1<eq) ones. Proof. unfold ones. solve_proper. Qed. Lemma ones_equiv : forall n, ones n == P (2^n). Proof. intros n. unfold ones. destruct (le_gt_cases 0 n). - now rewrite shiftl_mul_pow2, mul_1_l. - f_equiv. rewrite pow_neg_r; trivial. rewrite <- shiftr_opp_r. apply shiftr_eq_0_iff. right; split. { order'. } rewrite log2_1. now apply opp_pos_neg. Qed. Lemma ones_add : forall n m, 0<=n -> 0<=m -> ones (m+n) == 2^m * ones n + ones m. Proof. intros n m Hn Hm. rewrite !ones_equiv. rewrite <- !sub_1_r, mul_sub_distr_l, mul_1_r, <- pow_add_r by trivial. rewrite add_sub_assoc, sub_add. reflexivity. Qed. Lemma ones_div_pow2 : forall n m, 0<=m<=n -> ones n / 2^m == ones (n-m). Proof. intros n m (Hm,H). symmetry. apply div_unique with (ones m). - left. rewrite ones_equiv. split. + rewrite <- lt_succ_r, succ_pred. order_pos. + now rewrite <- le_succ_l, succ_pred. - rewrite <- (sub_add m n) at 1. rewrite (add_comm _ m). apply ones_add; trivial. now apply le_0_sub. Qed. Lemma ones_mod_pow2 : forall n m, 0<=m<=n -> (ones n) mod (2^m) == ones m. Proof. intros n m (Hm,H). symmetry. apply mod_unique with (ones (n-m)). - left. rewrite ones_equiv. split. + rewrite <- lt_succ_r, succ_pred. order_pos. + now rewrite <- le_succ_l, succ_pred. - rewrite <- (sub_add m n) at 1. rewrite (add_comm _ m). apply ones_add; trivial. now apply le_0_sub. Qed. Lemma ones_spec_low : forall n m, 0<=m (ones n).[m] = true. Proof. intros n m (Hm,H). apply testbit_true; trivial. rewrite ones_div_pow2 by (split; order). rewrite <- (pow_1_r 2). rewrite ones_mod_pow2. - rewrite ones_equiv. now nzsimpl'. - split. { order'. } apply le_add_le_sub_r. nzsimpl. now apply le_succ_l. Qed. Lemma ones_spec_high : forall n m, 0<=n<=m -> (ones n).[m] = false. Proof. intros n m (Hn,H). le_elim Hn. - apply bits_above_log2; rewrite ones_equiv. + rewrite <-lt_succ_r, succ_pred; order_pos. + rewrite log2_pred_pow2; trivial. now rewrite <-le_succ_l, succ_pred. - rewrite ones_equiv. now rewrite <- Hn, pow_0_r, one_succ, pred_succ, bits_0. Qed. Lemma ones_spec_iff : forall n m, 0<=n -> ((ones n).[m] = true <-> 0<=m log2 a < n -> lor a (ones n) == ones n. Proof. intros a n Ha H. bitwise as m ?. destruct (le_gt_cases n m). - rewrite ones_spec_high, bits_above_log2; try split; trivial. + now apply lt_le_trans with n. + apply le_trans with (log2 a); order_pos. - rewrite ones_spec_low, orb_true_r; try split; trivial. Qed. Lemma land_ones : forall a n, 0<=n -> land a (ones n) == a mod 2^n. Proof. intros a n Hn. bitwise as m ?. destruct (le_gt_cases n m). - rewrite ones_spec_high, mod_pow2_bits_high, andb_false_r; try split; trivial. - rewrite ones_spec_low, mod_pow2_bits_low, andb_true_r; try split; trivial. Qed. Lemma land_ones_low : forall a n, 0<=a -> log2 a < n -> land a (ones n) == a. Proof. intros a n Ha H. assert (Hn : 0<=n) by (generalize (log2_nonneg a); order). rewrite land_ones; trivial. apply mod_small. split; trivial. apply log2_lt_cancel. now rewrite log2_pow2. Qed. Lemma ldiff_ones_r : forall a n, 0<=n -> ldiff a (ones n) == (a >> n) << n. Proof. intros a n Hn. bitwise as m ?. destruct (le_gt_cases n m). - rewrite ones_spec_high, shiftl_spec_high, shiftr_spec; trivial. + rewrite sub_add; trivial. apply andb_true_r. + now apply le_0_sub. + now split. - rewrite ones_spec_low, shiftl_spec_low, andb_false_r; try split; trivial. Qed. Lemma ldiff_ones_r_low : forall a n, 0<=a -> log2 a < n -> ldiff a (ones n) == 0. Proof. intros a n Ha H. bitwise as m ?. destruct (le_gt_cases n m). - rewrite ones_spec_high, bits_above_log2; trivial. + now apply lt_le_trans with n. + split; trivial. now apply le_trans with (log2 a); order_pos. - rewrite ones_spec_low, andb_false_r; try split; trivial. Qed. Lemma ldiff_ones_l_low : forall a n, 0<=a -> log2 a < n -> ldiff (ones n) a == lxor a (ones n). Proof. intros a n Ha H. bitwise as m ?. destruct (le_gt_cases n m). - rewrite ones_spec_high, bits_above_log2; trivial. + now apply lt_le_trans with n. + split; trivial. now apply le_trans with (log2 a); order_pos. - rewrite ones_spec_low, xorb_true_r; try split; trivial. Qed. (** Bitwise operations and sign *) Lemma shiftl_nonneg : forall a n, 0 <= (a << n) <-> 0 <= a. Proof. intros a n. destruct (le_ge_cases 0 n) as [Hn|Hn]. - (* 0<=n *) rewrite 2 bits_iff_nonneg_ex. split; intros (k,Hk). + exists (k-n). intros m Hm. destruct (le_gt_cases 0 m); [|now rewrite testbit_neg_r]. rewrite <- (add_simpl_r m n), <- (shiftl_spec a n) by order_pos. apply Hk. now apply lt_sub_lt_add_r. + exists (k+n). intros m Hm. destruct (le_gt_cases 0 m); [|now rewrite testbit_neg_r]. rewrite shiftl_spec by trivial. apply Hk. now apply lt_add_lt_sub_r. - (* n<=0*) rewrite <- shiftr_opp_r, 2 bits_iff_nonneg_ex. split; intros (k,Hk). + destruct (le_gt_cases 0 k). * exists (k-n). intros m Hm. apply lt_sub_lt_add_r in Hm. rewrite <- (add_simpl_r m n), <- add_opp_r, <- (shiftr_spec a (-n)) by order. now apply Hk. * assert (EQ : a >> (-n) == 0). { apply bits_inj'. intros m Hm. rewrite bits_0. apply Hk; order. } apply shiftr_eq_0_iff in EQ. rewrite <- bits_iff_nonneg_ex. destruct EQ as [EQ|[LT _]]; order. + exists (k+n). intros m Hm. destruct (le_gt_cases 0 m); [|now rewrite testbit_neg_r]. rewrite shiftr_spec by trivial. apply Hk. rewrite add_opp_r. now apply lt_add_lt_sub_r. Qed. Lemma shiftl_neg : forall a n, (a << n) < 0 <-> a < 0. Proof. intros a n. now rewrite 2 lt_nge, shiftl_nonneg. Qed. Lemma shiftr_nonneg : forall a n, 0 <= (a >> n) <-> 0 <= a. Proof. intros. rewrite <- shiftl_opp_r. apply shiftl_nonneg. Qed. Lemma shiftr_neg : forall a n, (a >> n) < 0 <-> a < 0. Proof. intros a n. now rewrite 2 lt_nge, shiftr_nonneg. Qed. Lemma div2_nonneg : forall a, 0 <= div2 a <-> 0 <= a. Proof. intros. rewrite div2_spec. apply shiftr_nonneg. Qed. Lemma div2_neg : forall a, div2 a < 0 <-> a < 0. Proof. intros a. now rewrite 2 lt_nge, div2_nonneg. Qed. Lemma lor_nonneg : forall a b, 0 <= lor a b <-> 0<=a /\ 0<=b. Proof. intros a b. rewrite 3 bits_iff_nonneg_ex. split. - intros (k,Hk). split; exists k; intros m Hm; apply (orb_false_elim a.[m] b.[m]); rewrite <- lor_spec; now apply Hk. - intros ((k,Hk),(k',Hk')). destruct (le_ge_cases k k'); [ exists k' | exists k ]; intros m Hm; rewrite lor_spec, Hk, Hk'; trivial; order. Qed. Lemma lor_neg : forall a b, lor a b < 0 <-> a < 0 \/ b < 0. Proof. intros a b. rewrite 3 lt_nge, lor_nonneg. split. - apply not_and. apply le_decidable. - now intros [H|H] (H',H''). Qed. Lemma lnot_nonneg : forall a, 0 <= lnot a <-> a < 0. Proof. intros a; unfold lnot. now rewrite <- opp_succ, opp_nonneg_nonpos, le_succ_l. Qed. Lemma lnot_neg : forall a, lnot a < 0 <-> 0 <= a. Proof. intros a. now rewrite le_ngt, lt_nge, lnot_nonneg. Qed. Lemma land_nonneg : forall a b, 0 <= land a b <-> 0<=a \/ 0<=b. Proof. intros a b. now rewrite <- (lnot_involutive (land a b)), lnot_land, lnot_nonneg, lor_neg, !lnot_neg. Qed. Lemma land_neg : forall a b, land a b < 0 <-> a < 0 /\ b < 0. Proof. intros a b. now rewrite <- (lnot_involutive (land a b)), lnot_land, lnot_neg, lor_nonneg, !lnot_nonneg. Qed. Lemma ldiff_nonneg : forall a b, 0 <= ldiff a b <-> 0<=a \/ b<0. Proof. intros. now rewrite ldiff_land, land_nonneg, lnot_nonneg. Qed. Lemma ldiff_neg : forall a b, ldiff a b < 0 <-> a<0 /\ 0<=b. Proof. intros. now rewrite ldiff_land, land_neg, lnot_neg. Qed. Lemma lxor_nonneg : forall a b, 0 <= lxor a b <-> (0<=a <-> 0<=b). Proof. assert (H : forall a b, 0<=a -> 0<=b -> 0<=lxor a b). { intros a b. rewrite 3 bits_iff_nonneg_ex. intros (k,Hk) (k', Hk'). destruct (le_ge_cases k k'); [ exists k' | exists k]; intros m Hm; rewrite lxor_spec, Hk, Hk'; trivial; order. } assert (H' : forall a b, 0<=a -> b<0 -> lxor a b<0). { intros a b. rewrite bits_iff_nonneg_ex, 2 bits_iff_neg_ex. intros (k,Hk) (k', Hk'). destruct (le_ge_cases k k'); [ exists k' | exists k]; intros m Hm; rewrite lxor_spec, Hk, Hk'; trivial; order. } intros a b. split. - intros Hab. split. + intros Ha. destruct (le_gt_cases 0 b) as [Hb|Hb]; trivial. generalize (H' _ _ Ha Hb). order. + intros Hb. destruct (le_gt_cases 0 a) as [Ha|Ha]; trivial. generalize (H' _ _ Hb Ha). rewrite lxor_comm. order. - intros E. destruct (le_gt_cases 0 a) as [Ha|Ha]. + apply H; trivial. apply E; trivial. + destruct (le_gt_cases 0 b) as [Hb|Hb]. * apply H; trivial. apply E; trivial. * rewrite <- lxor_lnot_lnot. apply H; now apply lnot_nonneg. Qed. (** Bitwise operations and log2 *) Lemma log2_bits_unique : forall a n, a.[n] = true -> (forall m, n a.[m] = false) -> log2 a == n. Proof. intros a n H H'. destruct (lt_trichotomy a 0) as [Ha|[Ha|Ha]]. - (* a < 0 *) destruct (proj1 (bits_iff_neg_ex a) Ha) as (k,Hk). destruct (le_gt_cases n k). + specialize (Hk (S k) (lt_succ_diag_r _)). rewrite H' in Hk. * discriminate. * apply lt_succ_r; order. + specialize (H' (S n) (lt_succ_diag_r _)). rewrite Hk in H'. * discriminate. * apply lt_succ_r; order. - (* a = 0 *) now rewrite Ha, bits_0 in H. - (* 0 < a *) apply le_antisymm; apply le_ngt; intros LT. + specialize (H' _ LT). now rewrite bit_log2 in H'. + now rewrite bits_above_log2 in H by order. Qed. Lemma log2_shiftr : forall a n, 0 log2 (a >> n) == max 0 (log2 a - n). Proof. intros a n Ha. destruct (le_gt_cases 0 (log2 a - n)) as [H|H]; [rewrite max_r | rewrite max_l]; try order. - apply log2_bits_unique. + now rewrite shiftr_spec, sub_add, bit_log2. + intros m Hm. destruct (le_gt_cases 0 m); [|now rewrite testbit_neg_r]. rewrite shiftr_spec; trivial. apply bits_above_log2; try order. now apply lt_sub_lt_add_r. - rewrite lt_sub_lt_add_r, add_0_l in H. apply log2_nonpos. apply le_lteq; right. apply shiftr_eq_0_iff. right. now split. Qed. Lemma log2_shiftl : forall a n, 0 0<=n -> log2 (a << n) == log2 a + n. Proof. intros a n Ha Hn. rewrite shiftl_mul_pow2, add_comm by trivial. now apply log2_mul_pow2. Qed. Lemma log2_shiftl' : forall a n, 0 log2 (a << n) == max 0 (log2 a + n). Proof. intros a n Ha. rewrite <- shiftr_opp_r, log2_shiftr by trivial. destruct (le_gt_cases 0 (log2 a + n)); [rewrite 2 max_r | rewrite 2 max_l]; rewrite ?sub_opp_r; try order. Qed. Lemma log2_lor : forall a b, 0<=a -> 0<=b -> log2 (lor a b) == max (log2 a) (log2 b). Proof. assert (AUX : forall a b, 0<=a -> a<=b -> log2 (lor a b) == log2 b). { intros a b Ha H. le_elim Ha; [|now rewrite <- Ha, lor_0_l]. apply log2_bits_unique. - now rewrite lor_spec, bit_log2, orb_true_r by order. - intros m Hm. assert (H' := log2_le_mono _ _ H). now rewrite lor_spec, 2 bits_above_log2 by order. } (* main *) intros a b Ha Hb. destruct (le_ge_cases a b) as [H|H]. - rewrite max_r by now apply log2_le_mono. now apply AUX. - rewrite max_l by now apply log2_le_mono. rewrite lor_comm. now apply AUX. Qed. Lemma log2_land : forall a b, 0<=a -> 0<=b -> log2 (land a b) <= min (log2 a) (log2 b). Proof. assert (AUX : forall a b, 0<=a -> a<=b -> log2 (land a b) <= log2 a). { intros a b Ha Hb. apply le_ngt. intros LT. assert (H : 0 <= land a b) by (apply land_nonneg; now left). le_elim H. - generalize (bit_log2 (land a b) H). now rewrite land_spec, bits_above_log2. - rewrite <- H in LT. apply log2_lt_cancel in LT; order. } (* main *) intros a b Ha Hb. destruct (le_ge_cases a b) as [H|H]. - rewrite min_l by now apply log2_le_mono. now apply AUX. - rewrite min_r by now apply log2_le_mono. rewrite land_comm. now apply AUX. Qed. Lemma log2_lxor : forall a b, 0<=a -> 0<=b -> log2 (lxor a b) <= max (log2 a) (log2 b). Proof. assert (AUX : forall a b, 0<=a -> a<=b -> log2 (lxor a b) <= log2 b). { intros a b Ha Hb. apply le_ngt. intros LT. assert (H : 0 <= lxor a b) by (apply lxor_nonneg; split; order). le_elim H. - generalize (bit_log2 (lxor a b) H). rewrite lxor_spec, 2 bits_above_log2; try order. + discriminate. + apply le_lt_trans with (log2 b); trivial. now apply log2_le_mono. - rewrite <- H in LT. apply log2_lt_cancel in LT; order. } (* main *) intros a b Ha Hb. destruct (le_ge_cases a b) as [H|H]. - rewrite max_r by now apply log2_le_mono. now apply AUX. - rewrite max_l by now apply log2_le_mono. rewrite lxor_comm. now apply AUX. Qed. (** Bitwise operations and arithmetical operations *) Local Notation xor3 a b c := (xorb (xorb a b) c). Local Notation lxor3 a b c := (lxor (lxor a b) c). Local Notation nextcarry a b c := ((a&&b) || (c && (a||b))). Local Notation lnextcarry a b c := (lor (land a b) (land c (lor a b))). Lemma add_bit0 : forall a b, (a+b).[0] = xorb a.[0] b.[0]. Proof. intros. now rewrite !bit0_odd, odd_add. Qed. Lemma add3_bit0 : forall a b c, (a+b+c).[0] = xor3 a.[0] b.[0] c.[0]. Proof. intros. now rewrite !add_bit0. Qed. Lemma add3_bits_div2 : forall (a0 b0 c0 : bool), (a0 + b0 + c0)/2 == nextcarry a0 b0 c0. Proof. assert (H : 1+1 == 2) by now nzsimpl'. intros [|] [|] [|]; simpl; rewrite ?add_0_l, ?add_0_r, ?H; (apply div_same; order') || (apply div_small; split; order') || idtac. symmetry. apply div_unique with 1. - left; split; order'. - now nzsimpl'. Qed. Lemma add_carry_div2 : forall a b (c0:bool), (a + b + c0)/2 == a/2 + b/2 + nextcarry a.[0] b.[0] c0. Proof. intros a b c0. rewrite <- add3_bits_div2. rewrite (add_comm ((a/2)+_)). rewrite <- div_add by order'. f_equiv. rewrite <- !div2_div, mul_comm, mul_add_distr_l. rewrite (div2_odd a), <- bit0_odd at 1. rewrite (div2_odd b), <- bit0_odd at 1. rewrite add_shuffle1. rewrite <-(add_assoc _ _ c0). apply add_comm. Qed. (** The main result concerning addition: we express the bits of the sum in term of bits of [a] and [b] and of some carry stream which is also recursively determined by another equation. *) Lemma add_carry_bits_aux : forall n, 0<=n -> forall a b (c0:bool), -(2^n) <= a < 2^n -> -(2^n) <= b < 2^n -> exists c, a+b+c0 == lxor3 a b c /\ c/2 == lnextcarry a b c /\ c.[0] = c0. Proof. intros n Hn. apply le_ind with (4:=Hn). - solve_proper. - (* base *) intros a b c0. rewrite !pow_0_r, !one_succ, !lt_succ_r, <- !one_succ. intros (Ha1,Ha2) (Hb1,Hb2). le_elim Ha1; rewrite <- ?le_succ_l, ?succ_m1 in Ha1; le_elim Hb1; rewrite <- ?le_succ_l, ?succ_m1 in Hb1. + (* base, a = 0, b = 0 *) exists c0. rewrite (le_antisymm _ _ Ha2 Ha1), (le_antisymm _ _ Hb2 Hb1). rewrite !add_0_l, !lxor_0_l, !lor_0_r, !land_0_r, !lor_0_r. rewrite b2z_div2, b2z_bit0; now repeat split. + (* base, a = 0, b = -1 *) exists (-c0). rewrite <- Hb1, (le_antisymm _ _ Ha2 Ha1). repeat split. * rewrite add_0_l, lxor_0_l, lxor_m1_l. unfold lnot. now rewrite opp_involutive, add_comm, add_opp_r, sub_1_r. * rewrite land_0_l, !lor_0_l, land_m1_r. symmetry. apply div_unique with c0. { left; destruct c0; simpl; split; order'. } now rewrite two_succ, mul_succ_l, mul_1_l, add_opp_r, sub_add. * rewrite bit0_odd, odd_opp; destruct c0; simpl; apply odd_1 || apply odd_0. + (* base, a = -1, b = 0 *) exists (-c0). rewrite <- Ha1, (le_antisymm _ _ Hb2 Hb1). repeat split. * rewrite add_0_r, lxor_0_r, lxor_m1_l. unfold lnot. now rewrite opp_involutive, add_comm, add_opp_r, sub_1_r. * rewrite land_0_r, lor_0_r, lor_0_l, land_m1_r. symmetry. apply div_unique with c0. { left; destruct c0; simpl; split; order'. } now rewrite two_succ, mul_succ_l, mul_1_l, add_opp_r, sub_add. * rewrite bit0_odd, odd_opp; destruct c0; simpl; apply odd_1 || apply odd_0. + (* base, a = -1, b = -1 *) exists (c0 + 2*(-1)). rewrite <- Ha1, <- Hb1. repeat split. * rewrite lxor_m1_l, lnot_m1, lxor_0_l. now rewrite two_succ, mul_succ_l, mul_1_l, add_comm, add_assoc. * rewrite land_m1_l, lor_m1_l. apply add_b2z_double_div2. * apply add_b2z_double_bit0. - (* step *) clear n Hn. intros n Hn IH a b c0 Ha Hb. set (c1:=nextcarry a.[0] b.[0] c0). destruct (IH (a/2) (b/2) c1) as (c & IH1 & IH2 & Hc); clear IH. + split. * apply div_le_lower_bound. { order'. } now rewrite mul_opp_r, <- pow_succ_r. * apply div_lt_upper_bound. { order'. } now rewrite <- pow_succ_r. + split. * apply div_le_lower_bound. { order'. } now rewrite mul_opp_r, <- pow_succ_r. * apply div_lt_upper_bound. { order'. } now rewrite <- pow_succ_r. + exists (c0 + 2*c). repeat split. * { (* step, add *) bitwise as m Hm. le_elim Hm. - rewrite <- (succ_pred m), lt_succ_r in Hm. rewrite <- (succ_pred m), <- !div2_bits, <- 2 lxor_spec by trivial. f_equiv. rewrite add_b2z_double_div2, <- IH1. apply add_carry_div2. - rewrite <- Hm. now rewrite add_b2z_double_bit0, add3_bit0, b2z_bit0. } * { (* step, carry *) rewrite add_b2z_double_div2. bitwise as m Hm. le_elim Hm. - rewrite <- (succ_pred m), lt_succ_r in Hm. rewrite <- (succ_pred m), <- !div2_bits, IH2 by trivial. autorewrite with bitwise. now rewrite add_b2z_double_div2. - rewrite <- Hm. now rewrite add_b2z_double_bit0. } * (* step, carry0 *) apply add_b2z_double_bit0. Qed. Lemma add_carry_bits : forall a b (c0:bool), exists c, a+b+c0 == lxor3 a b c /\ c/2 == lnextcarry a b c /\ c.[0] = c0. Proof. intros a b c0. set (n := max (abs a) (abs b)). apply (add_carry_bits_aux n). - (* positivity *) unfold n. destruct (le_ge_cases (abs a) (abs b)); [rewrite max_r|rewrite max_l]; order_pos'. - (* bound for a *) assert (Ha : abs a < 2^n). + apply lt_le_trans with (2^(abs a)). * apply pow_gt_lin_r; order_pos'. * apply pow_le_mono_r. { order'. } unfold n. destruct (le_ge_cases (abs a) (abs b)); [rewrite max_r|rewrite max_l]; try order. + apply abs_lt in Ha. destruct Ha; split; order. - (* bound for b *) assert (Hb : abs b < 2^n). { apply lt_le_trans with (2^(abs b)). - apply pow_gt_lin_r; order_pos'. - apply pow_le_mono_r. { order'. } unfold n. destruct (le_ge_cases (abs a) (abs b)); [rewrite max_r|rewrite max_l]; try order. } apply abs_lt in Hb. destruct Hb; split; order. Qed. (** Particular case : the second bit of an addition *) Lemma add_bit1 : forall a b, (a+b).[1] = xor3 a.[1] b.[1] (a.[0] && b.[0]). Proof. intros a b. destruct (add_carry_bits a b false) as (c & EQ1 & EQ2 & Hc). simpl in EQ1; rewrite add_0_r in EQ1. rewrite EQ1. autorewrite with bitwise. f_equal. rewrite one_succ, <- div2_bits, EQ2 by order. autorewrite with bitwise. rewrite Hc. simpl. apply orb_false_r. Qed. (** In an addition, there will be no carries iff there is no common bits in the numbers to add *) Lemma nocarry_equiv : forall a b c, c/2 == lnextcarry a b c -> c.[0] = false -> (c == 0 <-> land a b == 0). Proof. intros a b c H H'. split. - intros EQ; rewrite EQ in *. rewrite div_0_l in H by order'. symmetry in H. now apply lor_eq_0_l in H. - intros EQ. rewrite EQ, lor_0_l in H. apply bits_inj'. intros n Hn. rewrite bits_0. apply le_ind with (4:=Hn). + solve_proper. + trivial. + clear n Hn. intros n Hn IH. rewrite <- div2_bits, H; trivial. autorewrite with bitwise. now rewrite IH. Qed. (** When there is no common bits, the addition is just a xor *) Lemma add_nocarry_lxor : forall a b, land a b == 0 -> a+b == lxor a b. Proof. intros a b H. destruct (add_carry_bits a b false) as (c & EQ1 & EQ2 & Hc). simpl in EQ1; rewrite add_0_r in EQ1. rewrite EQ1. apply (nocarry_equiv a b c) in H; trivial. rewrite H. now rewrite lxor_0_r. Qed. (** A null [ldiff] implies being smaller *) Lemma ldiff_le : forall a b, 0<=b -> ldiff a b == 0 -> 0 <= a <= b. Proof. assert (AUX : forall n, 0<=n -> forall a b, 0 <= a < 2^n -> 0<=b -> ldiff a b == 0 -> a <= b). { intros n Hn. apply le_ind with (4:=Hn); clear n Hn. - solve_proper. - intros a b Ha Hb _. rewrite pow_0_r, one_succ, lt_succ_r in Ha. setoid_replace a with 0 by (destruct Ha; order'); trivial. - intros n Hn IH a b (Ha,Ha') Hb H. assert (NEQ : 2 ~= 0) by order'. rewrite (div_mod a 2 NEQ), (div_mod b 2 NEQ). apply add_le_mono. + apply mul_le_mono_pos_l; try order'. apply IH. * split. { apply div_pos; order'. } apply div_lt_upper_bound; try order'. now rewrite <- pow_succ_r. * apply div_pos; order'. * rewrite <- (pow_1_r 2), <- 2 shiftr_div_pow2 by order'. rewrite <- shiftr_ldiff, H, shiftr_div_pow2, pow_1_r, div_0_l; order'. + rewrite <- 2 bit0_mod. apply bits_inj_iff in H. specialize (H 0). rewrite ldiff_spec, bits_0 in H. destruct a.[0], b.[0]; try discriminate; simpl; order'. } (* main *) intros a b Hb Hd. assert (Ha : 0<=a). { apply le_ngt; intros Ha'. apply (lt_irrefl 0). rewrite <- Hd at 1. apply ldiff_neg. now split. } split; trivial. apply (AUX a); try split; trivial. apply pow_gt_lin_r; order'. Qed. (** Subtraction can be a ldiff when the opposite ldiff is null. *) Lemma sub_nocarry_ldiff : forall a b, ldiff b a == 0 -> a-b == ldiff a b. Proof. intros a b H. apply add_cancel_r with b. rewrite sub_add. symmetry. rewrite add_nocarry_lxor; trivial. - bitwise as m ?. apply bits_inj_iff in H. specialize (H m). rewrite ldiff_spec, bits_0 in H. now destruct a.[m], b.[m]. - apply land_ldiff. Qed. (** Adding numbers with no common bits cannot lead to a much bigger number *) Lemma add_nocarry_lt_pow2 : forall a b n, land a b == 0 -> a < 2^n -> b < 2^n -> a+b < 2^n. Proof. intros a b n H Ha Hb. destruct (le_gt_cases a 0) as [Ha'|Ha']. - apply le_lt_trans with (0+b). + now apply add_le_mono_r. + now nzsimpl. - destruct (le_gt_cases b 0) as [Hb'|Hb']. + apply le_lt_trans with (a+0). * now apply add_le_mono_l. * now nzsimpl. + rewrite add_nocarry_lxor by order. destruct (lt_ge_cases 0 (lxor a b)); [|apply le_lt_trans with 0; order_pos]. apply log2_lt_pow2; trivial. apply log2_lt_pow2 in Ha; trivial. apply log2_lt_pow2 in Hb; trivial. apply le_lt_trans with (max (log2 a) (log2 b)). * apply log2_lxor; order. * destruct (le_ge_cases (log2 a) (log2 b)); [rewrite max_r|rewrite max_l]; order. Qed. Lemma add_nocarry_mod_lt_pow2 : forall a b n, 0<=n -> land a b == 0 -> a mod 2^n + b mod 2^n < 2^n. Proof. intros a b n Hn H. apply add_nocarry_lt_pow2. - bitwise as m ?. destruct (le_gt_cases n m). + rewrite mod_pow2_bits_high; now split. + now rewrite !mod_pow2_bits_low, <- land_spec, H, bits_0. - apply mod_pos_bound; order_pos. - apply mod_pos_bound; order_pos. Qed. End ZBitsProp. coq-8.20.0/theories/Numbers/Integer/Abstract/ZDivEucl.v000066400000000000000000000433201466560755400226600ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* 0 -> exists r q, a = b*q+r /\ 0 <= r < |b| ] The outcome of the modulo function is hence always positive. This corresponds to convention "E" in the following paper: R. Boute, "The Euclidean definition of the functions div and mod", ACM Transactions on Programming Languages and Systems, Vol. 14, No.2, pp. 127-144, April 1992. See files [ZDivTrunc] and [ZDivFloor] for others conventions. We simply extend NZDiv with a bound for modulo that holds regardless of the sign of a and b. This new specification subsume mod_bound_pos, which nonetheless stays there for subtyping. Note also that ZAxiomSig now already contain a div and a modulo (that follow the Floor convention). We just ignore them here. *) Module Type EuclidSpec (Import A : ZAxiomsSig')(Import B : DivMod A). Axiom mod_always_pos : forall a b, b ~= 0 -> 0 <= B.modulo a b < abs b. End EuclidSpec. Module Type ZEuclid (Z:ZAxiomsSig) := NZDiv.NZDiv Z <+ EuclidSpec Z. Module ZEuclidProp (Import A : ZAxiomsSig') (Import B : ZMulOrderProp A) (Import C : ZSgnAbsProp A B) (Import D : ZEuclid A). (** We put notations in a scope, to avoid warnings about redefinitions of notations *) Declare Scope euclid. Infix "/" := D.div : euclid. Infix "mod" := D.modulo : euclid. Local Open Scope euclid. Module Import Private_NZDiv := Nop <+ NZDivProp A D B. (** Another formulation of the main equation *) Lemma mod_eq : forall a b, b~=0 -> a mod b == a - b*(a/b). Proof. intros. rewrite <- add_move_l. symmetry. now apply div_mod. Qed. Ltac pos_or_neg a := let LT := fresh "LT" in let LE := fresh "LE" in destruct (le_gt_cases 0 a) as [LE|LT]; [|rewrite <- opp_pos_neg in LT]. (** Uniqueness theorems *) Theorem div_mod_unique : forall b q1 q2 r1 r2 : t, 0<=r1 0<=r2 b*q1+r1 == b*q2+r2 -> q1 == q2 /\ r1 == r2. Proof. intros b q1 q2 r1 r2 Hr1 Hr2 EQ. pos_or_neg b. - rewrite abs_eq in * by trivial. apply div_mod_unique with b; trivial. - rewrite abs_neq' in * by auto using lt_le_incl. rewrite eq_sym_iff. apply div_mod_unique with (-b); trivial. rewrite 2 mul_opp_l. rewrite add_move_l, sub_opp_r. rewrite <-add_assoc. symmetry. rewrite add_move_l, sub_opp_r. now rewrite (add_comm r2), (add_comm r1). Qed. Theorem div_unique: forall a b q r, 0<=r a == b*q + r -> q == a/b. Proof. intros a b q r Hr EQ. assert (Hb : b~=0). { pos_or_neg b. - rewrite abs_eq in Hr; intuition; order. - rewrite <- opp_0, eq_opp_r. rewrite abs_neq' in Hr; intuition; order. } destruct (div_mod_unique b q (a/b) r (a mod b)); trivial. - now apply mod_always_pos. - now rewrite <- div_mod. Qed. Theorem mod_unique: forall a b q r, 0<=r a == b*q + r -> r == a mod b. Proof. intros a b q r Hr EQ. assert (Hb : b~=0). { pos_or_neg b. - rewrite abs_eq in Hr; intuition; order. - rewrite <- opp_0, eq_opp_r. rewrite abs_neq' in Hr; intuition; order. } destruct (div_mod_unique b q (a/b) r (a mod b)); trivial. - now apply mod_always_pos. - now rewrite <- div_mod. Qed. (** Sign rules *) Lemma div_opp_r : forall a b, b~=0 -> a/(-b) == -(a/b). Proof. intros. symmetry. apply div_unique with (a mod b). - rewrite abs_opp; now apply mod_always_pos. - rewrite mul_opp_opp; now apply div_mod. Qed. Lemma mod_opp_r : forall a b, b~=0 -> a mod (-b) == a mod b. Proof. intros. symmetry. apply mod_unique with (-(a/b)). - rewrite abs_opp; now apply mod_always_pos. - rewrite mul_opp_opp; now apply div_mod. Qed. Lemma div_opp_l_z : forall a b, b~=0 -> a mod b == 0 -> (-a)/b == -(a/b). Proof. intros a b Hb Hab. symmetry. apply div_unique with (-(a mod b)). - rewrite Hab, opp_0. split; [order|]. pos_or_neg b; [rewrite abs_eq | rewrite abs_neq']; order. - now rewrite mul_opp_r, <-opp_add_distr, <-div_mod. Qed. Lemma div_opp_l_nz : forall a b, b~=0 -> a mod b ~= 0 -> (-a)/b == -(a/b)-sgn b. Proof. intros a b Hb Hab. symmetry. apply div_unique with (abs b -(a mod b)). - rewrite lt_sub_lt_add_l. rewrite <- le_add_le_sub_l. nzsimpl. rewrite <- (add_0_l (abs b)) at 2. rewrite <- add_lt_mono_r. destruct (mod_always_pos a b); intuition order. - rewrite <- 2 add_opp_r, mul_add_distr_l, 2 mul_opp_r. rewrite sgn_abs. rewrite add_shuffle2, add_opp_diag_l; nzsimpl. rewrite <-opp_add_distr, <-div_mod; order. Qed. Lemma mod_opp_l_z : forall a b, b~=0 -> a mod b == 0 -> (-a) mod b == 0. Proof. intros a b Hb Hab. symmetry. apply mod_unique with (-(a/b)). - split; [order|now rewrite abs_pos]. - now rewrite <-opp_0, <-Hab, mul_opp_r, <-opp_add_distr, <-div_mod. Qed. Lemma mod_opp_l_nz : forall a b, b~=0 -> a mod b ~= 0 -> (-a) mod b == abs b - (a mod b). Proof. intros a b Hb Hab. symmetry. apply mod_unique with (-(a/b)-sgn b). - rewrite lt_sub_lt_add_l. rewrite <- le_add_le_sub_l. nzsimpl. rewrite <- (add_0_l (abs b)) at 2. rewrite <- add_lt_mono_r. destruct (mod_always_pos a b); intuition order. - rewrite <- 2 add_opp_r, mul_add_distr_l, 2 mul_opp_r. rewrite sgn_abs. rewrite add_shuffle2, add_opp_diag_l; nzsimpl. rewrite <-opp_add_distr, <-div_mod; order. Qed. Lemma div_opp_opp_z : forall a b, b~=0 -> a mod b == 0 -> (-a)/(-b) == a/b. Proof. intros. now rewrite div_opp_r, div_opp_l_z, opp_involutive. Qed. Lemma div_opp_opp_nz : forall a b, b~=0 -> a mod b ~= 0 -> (-a)/(-b) == a/b + sgn(b). Proof. intros. rewrite div_opp_r, div_opp_l_nz by trivial. now rewrite opp_sub_distr, opp_involutive. Qed. Lemma mod_opp_opp_z : forall a b, b~=0 -> a mod b == 0 -> (-a) mod (-b) == 0. Proof. intros. now rewrite mod_opp_r, mod_opp_l_z. Qed. Lemma mod_opp_opp_nz : forall a b, b~=0 -> a mod b ~= 0 -> (-a) mod (-b) == abs b - a mod b. Proof. intros. now rewrite mod_opp_r, mod_opp_l_nz. Qed. (** A division by itself returns 1 *) Lemma div_same : forall a, a~=0 -> a/a == 1. Proof. intros. symmetry. apply div_unique with 0. - split; [order|now rewrite abs_pos]. - now nzsimpl. Qed. Lemma mod_same : forall a, a~=0 -> a mod a == 0. Proof. intros. rewrite mod_eq, div_same by trivial. nzsimpl. apply sub_diag. Qed. (** A division of a small number by a bigger one yields zero. *) Theorem div_small: forall a b, 0<=a a/b == 0. Proof. exact div_small. Qed. (** Same situation, in term of modulo: *) Theorem mod_small: forall a b, 0<=a a mod b == a. Proof. exact mod_small. Qed. (** * Basic values of divisions and modulo. *) Lemma div_0_l: forall a, a~=0 -> 0/a == 0. Proof. intros. pos_or_neg a. - apply div_0_l; order. - apply opp_inj. rewrite <- div_opp_r, opp_0 by trivial. now apply div_0_l. Qed. Lemma mod_0_l: forall a, a~=0 -> 0 mod a == 0. Proof. intros; rewrite mod_eq, div_0_l; now nzsimpl. Qed. Lemma div_1_r: forall a, a/1 == a. Proof. intros. symmetry. apply div_unique with 0. - assert (H:=lt_0_1); rewrite abs_pos; intuition auto; order. - now nzsimpl. Qed. Lemma mod_1_r: forall a, a mod 1 == 0. Proof. intros. rewrite mod_eq, div_1_r; nzsimpl; auto using sub_diag. apply neq_sym, lt_neq; apply lt_0_1. Qed. Lemma div_1_l: forall a, 1 1/a == 0. Proof. exact div_1_l. Qed. Lemma mod_1_l: forall a, 1 1 mod a == 1. Proof. exact mod_1_l. Qed. Lemma div_mul : forall a b, b~=0 -> (a*b)/b == a. Proof. intros. symmetry. apply div_unique with 0. - split; [order|now rewrite abs_pos]. - nzsimpl; apply mul_comm. Qed. Lemma mod_mul : forall a b, b~=0 -> (a*b) mod b == 0. Proof. intros. rewrite mod_eq, div_mul by trivial. rewrite mul_comm; apply sub_diag. Qed. Theorem div_unique_exact a b q: b~=0 -> a == b*q -> q == a/b. Proof. intros Hb H. rewrite H, mul_comm. symmetry. now apply div_mul. Qed. (** * Order results about mod and div *) (** A modulo cannot grow beyond its starting point. *) Theorem mod_le: forall a b, 0<=a -> b~=0 -> a mod b <= a. Proof. intros. pos_or_neg b. - apply mod_le; order. - rewrite <- mod_opp_r by trivial. apply mod_le; order. Qed. Theorem div_pos : forall a b, 0<=a -> 0 0<= a/b. Proof. exact div_pos. Qed. Lemma div_str_pos : forall a b, 0 0 < a/b. Proof. exact div_str_pos. Qed. Lemma div_small_iff : forall a b, b~=0 -> (a/b==0 <-> 0<=a (a mod b == a <-> 0<=a 1 a/b < a. Proof. exact div_lt. Qed. (** [le] is compatible with a positive division. *) Lemma div_le_mono : forall a b c, 0 a<=b -> a/c <= b/c. Proof. intros a b c Hc Hab. rewrite lt_eq_cases in Hab. destruct Hab as [LT|EQ]; [|rewrite EQ; order]. rewrite <- lt_succ_r. rewrite (mul_lt_mono_pos_l c) by order. nzsimpl. rewrite (add_lt_mono_r _ _ (a mod c)). rewrite <- div_mod by order. apply lt_le_trans with b; trivial. rewrite (div_mod b c) at 1 by order. rewrite <- add_assoc, <- add_le_mono_l. apply le_trans with (c+0). - nzsimpl; destruct (mod_always_pos b c); try order. rewrite abs_eq in *; order. - rewrite <- add_le_mono_l. destruct (mod_always_pos a c); order. Qed. (** In this convention, [div] performs Rounding-Toward-Bottom when divisor is positive, and Rounding-Toward-Top otherwise. Since we cannot speak of rational values here, we express this fact by multiplying back by [b], and this leads to a nice unique statement. *) Lemma mul_div_le : forall a b, b~=0 -> b*(a/b) <= a. Proof. intros. rewrite (div_mod a b) at 2; trivial. rewrite <- (add_0_r (b*(a/b))) at 1. rewrite <- add_le_mono_l. now destruct (mod_always_pos a b). Qed. (** Giving a reversed bound is slightly more complex *) Lemma mul_succ_div_gt: forall a b, 0 a < b*(S (a/b)). Proof. intros. nzsimpl. rewrite (div_mod a b) at 1; try order. rewrite <- add_lt_mono_l. destruct (mod_always_pos a b). { order. } rewrite abs_eq in *; order. Qed. Lemma mul_pred_div_gt: forall a b, b<0 -> a < b*(P (a/b)). Proof. intros a b Hb. rewrite mul_pred_r, <- add_opp_r. rewrite (div_mod a b) at 1; try order. rewrite <- add_lt_mono_l. destruct (mod_always_pos a b). { order. } rewrite <- opp_pos_neg in Hb. rewrite abs_neq' in *; order. Qed. (** NB: The three previous properties could be used as specifications for [div]. *) (** Inequality [mul_div_le] is exact iff the modulo is zero. *) Lemma div_exact : forall a b, b~=0 -> (a == b*(a/b) <-> a mod b == 0). Proof. intros. rewrite (div_mod a b) at 1; try order. rewrite <- (add_0_r (b*(a/b))) at 2. apply add_cancel_l. Qed. (** Some additional inequalities about div. *) Theorem div_lt_upper_bound: forall a b q, 0 a < b*q -> a/b < q. Proof. intros. rewrite (mul_lt_mono_pos_l b) by trivial. apply le_lt_trans with a; trivial. apply mul_div_le; order. Qed. Theorem div_le_upper_bound: forall a b q, 0 a <= b*q -> a/b <= q. Proof. intros. rewrite <- (div_mul q b) by order. apply div_le_mono; trivial. now rewrite mul_comm. Qed. Theorem div_le_lower_bound: forall a b q, 0 b*q <= a -> q <= a/b. Proof. intros. rewrite <- (div_mul q b) by order. apply div_le_mono; trivial. now rewrite mul_comm. Qed. (** A division respects opposite monotonicity for the divisor *) Lemma div_le_compat_l: forall p q r, 0<=p -> 0 p/r <= p/q. Proof. exact div_le_compat_l. Qed. (** * Relations between usual operations and mod and div *) Lemma mod_add : forall a b c, c~=0 -> (a + b * c) mod c == a mod c. Proof. intros. symmetry. apply mod_unique with (a/c+b); trivial. - now apply mod_always_pos. - rewrite mul_add_distr_l, add_shuffle0, <- div_mod by order. now rewrite mul_comm. Qed. Lemma div_add : forall a b c, c~=0 -> (a + b * c) / c == a / c + b. Proof. intros. apply (mul_cancel_l _ _ c); try order. apply (add_cancel_r _ _ ((a+b*c) mod c)). rewrite <- div_mod, mod_add by order. rewrite mul_add_distr_l, add_shuffle0, <- div_mod by order. now rewrite mul_comm. Qed. Lemma div_add_l: forall a b c, b~=0 -> (a * b + c) / b == a + c / b. Proof. intros a b c. rewrite (add_comm _ c), (add_comm a). now apply div_add. Qed. (** Cancellations. *) (** With the current convention, the following isn't always true when [c<0]: [-3*-1 / -2*-1 = 3/2 = 1] while [-3/-2 = 2] *) Lemma div_mul_cancel_r : forall a b c, b~=0 -> 0 (a*c)/(b*c) == a/b. Proof. intros. symmetry. apply div_unique with ((a mod b)*c). - (* ineqs *) rewrite abs_mul, (abs_eq c) by order. rewrite <-(mul_0_l c), <-mul_lt_mono_pos_r, <-mul_le_mono_pos_r by trivial. now apply mod_always_pos. - (* equation *) rewrite (div_mod a b) at 1 by order. rewrite mul_add_distr_r. rewrite add_cancel_r. rewrite <- 2 mul_assoc. now rewrite (mul_comm c). Qed. Lemma div_mul_cancel_l : forall a b c, b~=0 -> 0 (c*a)/(c*b) == a/b. Proof. intros. rewrite !(mul_comm c); now apply div_mul_cancel_r. Qed. Lemma mul_mod_distr_l: forall a b c, b~=0 -> 0 (c*a) mod (c*b) == c * (a mod b). Proof. intros. rewrite <- (add_cancel_l _ _ ((c*b)* ((c*a)/(c*b)))). rewrite <- div_mod. - rewrite div_mul_cancel_l by trivial. rewrite <- mul_assoc, <- mul_add_distr_l, mul_cancel_l by order. apply div_mod; order. - rewrite <- neq_mul_0; intuition; order. Qed. Lemma mul_mod_distr_r: forall a b c, b~=0 -> 0 (a*c) mod (b*c) == (a mod b) * c. Proof. intros. rewrite !(mul_comm _ c); now rewrite mul_mod_distr_l. Qed. (** Operations modulo. *) Theorem mod_mod: forall a n, n~=0 -> (a mod n) mod n == a mod n. Proof. intros. rewrite mod_small_iff by trivial. now apply mod_always_pos. Qed. Lemma mul_mod_idemp_l : forall a b n, n~=0 -> ((a mod n)*b) mod n == (a*b) mod n. Proof. intros a b n Hn. symmetry. rewrite (div_mod a n) at 1 by order. rewrite add_comm, (mul_comm n), (mul_comm _ b). rewrite mul_add_distr_l, mul_assoc. rewrite mod_add by trivial. now rewrite mul_comm. Qed. Lemma mul_mod_idemp_r : forall a b n, n~=0 -> (a*(b mod n)) mod n == (a*b) mod n. Proof. intros. rewrite !(mul_comm a). now apply mul_mod_idemp_l. Qed. Theorem mul_mod: forall a b n, n~=0 -> (a * b) mod n == ((a mod n) * (b mod n)) mod n. Proof. intros. now rewrite mul_mod_idemp_l, mul_mod_idemp_r. Qed. Lemma add_mod_idemp_l : forall a b n, n~=0 -> ((a mod n)+b) mod n == (a+b) mod n. Proof. intros a b n Hn. symmetry. rewrite (div_mod a n) at 1 by order. rewrite <- add_assoc, add_comm, mul_comm. now rewrite mod_add. Qed. Lemma add_mod_idemp_r : forall a b n, n~=0 -> (a+(b mod n)) mod n == (a+b) mod n. Proof. intros. rewrite !(add_comm a). now apply add_mod_idemp_l. Qed. Theorem add_mod: forall a b n, n~=0 -> (a+b) mod n == (a mod n + b mod n) mod n. Proof. intros. now rewrite add_mod_idemp_l, add_mod_idemp_r. Qed. (** With the current convention, the following result isn't always true with a negative intermediate divisor. For instance [ 3/(-2)/(-2) = 1 <> 0 = 3 / (-2*-2) ] and [ 3/(-2)/2 = -1 <> 0 = 3 / (-2*2) ]. *) Lemma div_div : forall a b c, 0 c~=0 -> (a/b)/c == a/(b*c). Proof. intros a b c Hb Hc. apply div_unique with (b*((a/b) mod c) + a mod b). - (* begin 0<= ... c~=0 -> a mod (b*c) == a mod b + b*((a/b) mod c). Proof. intros a b c Hb Hc. apply add_cancel_l with (b*c*(a/(b*c))). rewrite <- div_mod by (apply neq_mul_0; split; order). rewrite <- div_div by trivial. rewrite add_assoc, add_shuffle0, <- mul_assoc, <- mul_add_distr_l. rewrite <- div_mod by order. apply div_mod; order. Qed. Lemma mod_div: forall a b, b~=0 -> a mod b / b == 0. Proof. intros a b Hb. rewrite div_small_iff by assumption. auto using mod_always_pos. Qed. (** A last inequality: *) Theorem div_mul_le: forall a b c, 0<=a -> 0 0<=c -> c*(a/b) <= (c*a)/b. Proof. exact div_mul_le. Qed. (** mod is related to divisibility *) Lemma mod_divides : forall a b, b~=0 -> (a mod b == 0 <-> (b|a)). Proof. intros a b Hb. split. - intros Hab. exists (a/b). rewrite mul_comm. rewrite (div_mod a b Hb) at 1. rewrite Hab; now nzsimpl. - intros (c,Hc). rewrite Hc. now apply mod_mul. Qed. End ZEuclidProp. coq-8.20.0/theories/Numbers/Integer/Abstract/ZDivFloor.v000066400000000000000000000501731466560755400230550ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* a mod b == a - b*(a/b). Proof. intros. rewrite <- add_move_l. symmetry. now apply div_mod. Qed. (** We have a general bound for absolute values *) Lemma mod_bound_abs : forall a b, b~=0 -> abs (a mod b) < abs b. Proof. intros a b **. destruct (abs_spec b) as [(LE,EQ)|(LE,EQ)]; rewrite EQ. - destruct (mod_pos_bound a b). + order. + now rewrite abs_eq. - destruct (mod_neg_bound a b). + order. + rewrite abs_neq; trivial. now rewrite <- opp_lt_mono. Qed. (** Uniqueness theorems *) Theorem div_mod_unique : forall b q1 q2 r1 r2 : t, (0<=r1 (0<=r2 b*q1+r1 == b*q2+r2 -> q1 == q2 /\ r1 == r2. Proof. intros b q1 q2 r1 r2 Hr1 Hr2 EQ. destruct Hr1; destruct Hr2; try (intuition; order). - apply div_mod_unique with b; trivial. - rewrite <- (opp_inj_wd r1 r2). apply div_mod_unique with (-b); trivial. + rewrite <- opp_lt_mono, opp_nonneg_nonpos; tauto. + rewrite <- opp_lt_mono, opp_nonneg_nonpos; tauto. + now rewrite 2 mul_opp_l, <- 2 opp_add_distr, opp_inj_wd. Qed. Theorem div_unique: forall a b q r, (0<=r a == b*q + r -> q == a/b. Proof. intros a b q r Hr EQ. assert (Hb : b~=0) by (destruct Hr; intuition; order). destruct (div_mod_unique b q (a/b) r (a mod b)); trivial. - destruct Hr; [left; apply mod_pos_bound|right; apply mod_neg_bound]; intuition order. - now rewrite <- div_mod. Qed. Theorem div_unique_pos: forall a b q r, 0<=r a == b*q + r -> q == a/b. Proof. intros a b q r **; apply div_unique with r; auto. Qed. Theorem div_unique_neg: forall a b q r, b a == b*q + r -> q == a/b. Proof. intros a b q r **; apply div_unique with r; auto. Qed. Theorem mod_unique: forall a b q r, (0<=r a == b*q + r -> r == a mod b. Proof. intros a b q r Hr EQ. assert (Hb : b~=0) by (destruct Hr; intuition; order). destruct (div_mod_unique b q (a/b) r (a mod b)); trivial. - destruct Hr; [left; apply mod_pos_bound|right; apply mod_neg_bound]; intuition order. - now rewrite <- div_mod. Qed. Theorem mod_unique_pos: forall a b q r, 0<=r a == b*q + r -> r == a mod b. Proof. intros a b q r **; apply mod_unique with q; auto. Qed. Theorem mod_unique_neg: forall a b q r, b a == b*q + r -> r == a mod b. Proof. intros a b q r **; apply mod_unique with q; auto. Qed. (** Sign rules *) Ltac pos_or_neg a := let LT := fresh "LT" in let LE := fresh "LE" in destruct (le_gt_cases 0 a) as [LE|LT]; [|rewrite <- opp_pos_neg in LT]. Fact mod_bound_or : forall a b, b~=0 -> 0<=a mod b 0 <= -(a mod b) < -b \/ -b < -(a mod b) <= 0. Proof. intros a b **. destruct (lt_ge_cases 0 b); [right|left]. - rewrite <- opp_lt_mono, opp_nonpos_nonneg. destruct (mod_pos_bound a b); intuition; order. - rewrite <- opp_lt_mono, opp_nonneg_nonpos. destruct (mod_neg_bound a b); intuition; order. Qed. Lemma div_opp_opp : forall a b, b~=0 -> -a/-b == a/b. Proof. intros a b **. symmetry. apply div_unique with (- (a mod b)). - now apply opp_mod_bound_or. - rewrite mul_opp_l, <- opp_add_distr, <- div_mod; order. Qed. Lemma mod_opp_opp : forall a b, b~=0 -> (-a) mod (-b) == - (a mod b). Proof. intros a b **. symmetry. apply mod_unique with (a/b). - now apply opp_mod_bound_or. - rewrite mul_opp_l, <- opp_add_distr, <- div_mod; order. Qed. (** With the current conventions, the other sign rules are rather complex. *) Lemma div_opp_l_z : forall a b, b~=0 -> a mod b == 0 -> (-a)/b == -(a/b). Proof. intros a b Hb H. symmetry. apply div_unique with 0. - destruct (lt_ge_cases 0 b); [left|right]; intuition auto; order. - rewrite <- opp_0, <- H. rewrite mul_opp_r, <- opp_add_distr, <- div_mod; order. Qed. Lemma div_opp_l_nz : forall a b, b~=0 -> a mod b ~= 0 -> (-a)/b == -(a/b)-1. Proof. intros a b Hb H. symmetry. apply div_unique with (b - a mod b). - destruct (lt_ge_cases 0 b); [left|right]. + rewrite le_0_sub. rewrite <- (sub_0_r b) at 5. rewrite <- sub_lt_mono_l. destruct (mod_pos_bound a b); intuition; order. + rewrite le_sub_0. rewrite <- (sub_0_r b) at 1. rewrite <- sub_lt_mono_l. destruct (mod_neg_bound a b); intuition; order. - rewrite <- (add_opp_r b), mul_sub_distr_l, mul_1_r, sub_add_simpl_r_l. rewrite mul_opp_r, <-opp_add_distr, <-div_mod; order. Qed. Lemma mod_opp_l_z : forall a b, b~=0 -> a mod b == 0 -> (-a) mod b == 0. Proof. intros a b Hb H. symmetry. apply mod_unique with (-(a/b)). - destruct (lt_ge_cases 0 b); [left|right]; intuition auto; order. - rewrite <- opp_0, <- H. rewrite mul_opp_r, <- opp_add_distr, <- div_mod; order. Qed. Lemma mod_opp_l_nz : forall a b, b~=0 -> a mod b ~= 0 -> (-a) mod b == b - a mod b. Proof. intros a b Hb H. symmetry. apply mod_unique with (-(a/b)-1). - destruct (lt_ge_cases 0 b); [left|right]. + rewrite le_0_sub. rewrite <- (sub_0_r b) at 5. rewrite <- sub_lt_mono_l. destruct (mod_pos_bound a b); intuition; order. + rewrite le_sub_0. rewrite <- (sub_0_r b) at 1. rewrite <- sub_lt_mono_l. destruct (mod_neg_bound a b); intuition; order. - rewrite <- (add_opp_r b), mul_sub_distr_l, mul_1_r, sub_add_simpl_r_l. rewrite mul_opp_r, <-opp_add_distr, <-div_mod; order. Qed. Lemma div_opp_r_z : forall a b, b~=0 -> a mod b == 0 -> a/(-b) == -(a/b). Proof. intros a b **. rewrite <- (opp_involutive a) at 1. rewrite div_opp_opp; auto using div_opp_l_z. Qed. Lemma div_opp_r_nz : forall a b, b~=0 -> a mod b ~= 0 -> a/(-b) == -(a/b)-1. Proof. intros a b **. rewrite <- (opp_involutive a) at 1. rewrite div_opp_opp; auto using div_opp_l_nz. Qed. Lemma mod_opp_r_z : forall a b, b~=0 -> a mod b == 0 -> a mod (-b) == 0. Proof. intros a b **. rewrite <- (opp_involutive a) at 1. now rewrite mod_opp_opp, mod_opp_l_z, opp_0. Qed. Lemma mod_opp_r_nz : forall a b, b~=0 -> a mod b ~= 0 -> a mod (-b) == (a mod b) - b. Proof. intros a b **. rewrite <- (opp_involutive a) at 1. rewrite mod_opp_opp, mod_opp_l_nz by trivial. now rewrite opp_sub_distr, add_comm, add_opp_r. Qed. (** The sign of [a mod b] is the one of [b] (when it isn't null) *) Lemma mod_sign_nz : forall a b, b~=0 -> a mod b ~= 0 -> sgn (a mod b) == sgn b. Proof. intros a b Hb H. destruct (lt_ge_cases 0 b) as [Hb'|Hb']. - destruct (mod_pos_bound a b Hb'). rewrite 2 sgn_pos; order. - destruct (mod_neg_bound a b). + order. + rewrite 2 sgn_neg; order. Qed. Lemma mod_sign : forall a b, b~=0 -> sgn (a mod b) ~= -sgn b. Proof. intros a b Hb H. destruct (eq_decidable (a mod b) 0) as [EQ|NEQ]. - apply Hb, sgn_null_iff, opp_inj. now rewrite <- H, opp_0, EQ, sgn_0. - apply Hb, sgn_null_iff. apply eq_mul_0_l with 2; try order'. nzsimpl'. apply add_move_0_l. rewrite <- H. symmetry. now apply mod_sign_nz. Qed. Lemma mod_sign_mul : forall a b, b~=0 -> 0 <= (a mod b) * b. Proof. intros a b **. destruct (lt_ge_cases 0 b). - apply mul_nonneg_nonneg; destruct (mod_pos_bound a b); order. - apply mul_nonpos_nonpos; destruct (mod_neg_bound a b); order. Qed. (** A division by itself returns 1 *) Lemma div_same : forall a, a~=0 -> a/a == 1. Proof. intros a ?. pos_or_neg a. - apply div_same; order. - rewrite <- div_opp_opp by trivial. now apply div_same. Qed. Lemma mod_same : forall a, a~=0 -> a mod a == 0. Proof. intros. rewrite mod_eq, div_same by trivial. nzsimpl. apply sub_diag. Qed. (** A division of a small number by a bigger one yields zero. *) Theorem div_small: forall a b, 0<=a a/b == 0. Proof. exact div_small. Qed. (** Same situation, in term of modulo: *) Theorem mod_small: forall a b, 0<=a a mod b == a. Proof. exact mod_small. Qed. (** * Basic values of divisions and modulo. *) Lemma div_0_l: forall a, a~=0 -> 0/a == 0. Proof. intros a ?. pos_or_neg a. - apply div_0_l; order. - rewrite <- div_opp_opp, opp_0 by trivial. now apply div_0_l. Qed. Lemma mod_0_l: forall a, a~=0 -> 0 mod a == 0. Proof. intros; rewrite mod_eq, div_0_l; now nzsimpl. Qed. Lemma div_1_r: forall a, a/1 == a. Proof. intros. symmetry. apply div_unique with 0. - left. split; order || apply lt_0_1. - now nzsimpl. Qed. Lemma mod_1_r: forall a, a mod 1 == 0. Proof. intros. rewrite mod_eq, div_1_r; nzsimpl; auto using sub_diag. intro EQ; symmetry in EQ; revert EQ; apply lt_neq; apply lt_0_1. Qed. Lemma div_1_l: forall a, 1 1/a == 0. Proof. exact div_1_l. Qed. Lemma mod_1_l: forall a, 1 1 mod a == 1. Proof. exact mod_1_l. Qed. Lemma div_mul : forall a b, b~=0 -> (a*b)/b == a. Proof. intros a b ?. symmetry. apply div_unique with 0. - destruct (lt_ge_cases 0 b); [left|right]; split; order. - nzsimpl; apply mul_comm. Qed. Lemma mod_mul : forall a b, b~=0 -> (a*b) mod b == 0. Proof. intros. rewrite mod_eq, div_mul by trivial. rewrite mul_comm; apply sub_diag. Qed. Theorem div_unique_exact a b q: b~=0 -> a == b*q -> q == a/b. Proof. intros Hb H. rewrite H, mul_comm. symmetry. now apply div_mul. Qed. (** * Order results about mod and div *) (** A modulo cannot grow beyond its starting point. *) Theorem mod_le: forall a b, 0<=a -> 0 a mod b <= a. Proof. exact mod_le. Qed. Theorem div_pos : forall a b, 0<=a -> 0 0<= a/b. Proof. exact div_pos. Qed. Lemma div_str_pos : forall a b, 0 0 < a/b. Proof. exact div_str_pos. Qed. Lemma div_small_iff : forall a b, b~=0 -> (a/b==0 <-> 0<=a (a mod b == a <-> 0<=a 1 a/b < a. Proof. exact div_lt. Qed. (** [le] is compatible with a positive division. *) Lemma div_le_mono : forall a b c, 0 a<=b -> a/c <= b/c. Proof. intros a b c Hc Hab. rewrite lt_eq_cases in Hab. destruct Hab as [LT|EQ]; [|rewrite EQ; order]. rewrite <- lt_succ_r. rewrite (mul_lt_mono_pos_l c) by order. nzsimpl. rewrite (add_lt_mono_r _ _ (a mod c)). rewrite <- div_mod by order. apply lt_le_trans with b; trivial. rewrite (div_mod b c) at 1 by order. rewrite <- add_assoc, <- add_le_mono_l. apply le_trans with (c+0). - nzsimpl; destruct (mod_pos_bound b c); order. - rewrite <- add_le_mono_l. destruct (mod_pos_bound a c); order. Qed. (** In this convention, [div] performs Rounding-Toward-Bottom. Since we cannot speak of rational values here, we express this fact by multiplying back by [b], and this leads to separates statements according to the sign of [b]. First, [a/b] is below the exact fraction ... *) Lemma mul_div_le : forall a b, 0 b*(a/b) <= a. Proof. intros a b **. rewrite (div_mod a b) at 2; try order. rewrite <- (add_0_r (b*(a/b))) at 1. rewrite <- add_le_mono_l. now destruct (mod_pos_bound a b). Qed. Lemma mul_div_ge : forall a b, b<0 -> a <= b*(a/b). Proof. intros. rewrite <- div_opp_opp, opp_le_mono, <-mul_opp_l by order. apply mul_div_le. now rewrite opp_pos_neg. Qed. (** ... and moreover it is the larger such integer, since [S(a/b)] is strictly above the exact fraction. *) Lemma mul_succ_div_gt: forall a b, 0 a < b*(S (a/b)). Proof. intros a b ?. nzsimpl. rewrite (div_mod a b) at 1; try order. rewrite <- add_lt_mono_l. destruct (mod_pos_bound a b); order. Qed. Lemma mul_succ_div_lt: forall a b, b<0 -> b*(S (a/b)) < a. Proof. intros. rewrite <- div_opp_opp, opp_lt_mono, <-mul_opp_l by order. apply mul_succ_div_gt. now rewrite opp_pos_neg. Qed. (** NB: The four previous properties could be used as specifications for [div]. *) (** Inequality [mul_div_le] is exact iff the modulo is zero. *) Lemma div_exact : forall a b, b~=0 -> (a == b*(a/b) <-> a mod b == 0). Proof. intros a b **. rewrite (div_mod a b) at 1; try order. rewrite <- (add_0_r (b*(a/b))) at 2. apply add_cancel_l. Qed. (** Some additional inequalities about div. *) Theorem div_lt_upper_bound: forall a b q, 0 a < b*q -> a/b < q. Proof. intros a b q **. rewrite (mul_lt_mono_pos_l b) by trivial. apply le_lt_trans with a; trivial. now apply mul_div_le. Qed. Theorem div_le_upper_bound: forall a b q, 0 a <= b*q -> a/b <= q. Proof. intros a b q **. rewrite <- (div_mul q b) by order. apply div_le_mono; trivial. now rewrite mul_comm. Qed. Theorem div_le_lower_bound: forall a b q, 0 b*q <= a -> q <= a/b. Proof. intros a b q **. rewrite <- (div_mul q b) by order. apply div_le_mono; trivial. now rewrite mul_comm. Qed. (** A division respects opposite monotonicity for the divisor *) Lemma div_le_compat_l: forall p q r, 0<=p -> 0 p/r <= p/q. Proof. exact div_le_compat_l. Qed. (** * Relations between usual operations and mod and div *) Lemma mod_add : forall a b c, c~=0 -> (a + b * c) mod c == a mod c. Proof. intros a b c **. symmetry. apply mod_unique with (a/c+b); trivial. - now apply mod_bound_or. - rewrite mul_add_distr_l, add_shuffle0, <- div_mod by order. now rewrite mul_comm. Qed. Lemma div_add : forall a b c, c~=0 -> (a + b * c) / c == a / c + b. Proof. intros a b c **. apply (mul_cancel_l _ _ c); try order. apply (add_cancel_r _ _ ((a+b*c) mod c)). rewrite <- div_mod, mod_add by order. rewrite mul_add_distr_l, add_shuffle0, <- div_mod by order. now rewrite mul_comm. Qed. Lemma div_add_l: forall a b c, b~=0 -> (a * b + c) / b == a + c / b. Proof. intros a b c. rewrite (add_comm _ c), (add_comm a). now apply div_add. Qed. (** Cancellations. *) Lemma div_mul_cancel_r : forall a b c, b~=0 -> c~=0 -> (a*c)/(b*c) == a/b. Proof. intros a b c **. symmetry. apply div_unique with ((a mod b)*c). - (* ineqs *) destruct (lt_ge_cases 0 c). + rewrite <-(mul_0_l c), <-2mul_lt_mono_pos_r, <-2mul_le_mono_pos_r by trivial. now apply mod_bound_or. + rewrite <-(mul_0_l c), <-2mul_lt_mono_neg_r, <-2mul_le_mono_neg_r by order. destruct (mod_bound_or a b); tauto. - (* equation *) rewrite (div_mod a b) at 1 by order. rewrite mul_add_distr_r. rewrite add_cancel_r. rewrite <- 2 mul_assoc. now rewrite (mul_comm c). Qed. Lemma div_mul_cancel_l : forall a b c, b~=0 -> c~=0 -> (c*a)/(c*b) == a/b. Proof. intros a b c **. rewrite !(mul_comm c); now apply div_mul_cancel_r. Qed. Lemma mul_mod_distr_l: forall a b c, b~=0 -> c~=0 -> (c*a) mod (c*b) == c * (a mod b). Proof. intros a b c **. rewrite <- (add_cancel_l _ _ ((c*b)* ((c*a)/(c*b)))). rewrite <- div_mod. - rewrite div_mul_cancel_l by trivial. rewrite <- mul_assoc, <- mul_add_distr_l, mul_cancel_l by order. apply div_mod; order. - rewrite <- neq_mul_0; auto. Qed. Lemma mul_mod_distr_r: forall a b c, b~=0 -> c~=0 -> (a*c) mod (b*c) == (a mod b) * c. Proof. intros a b c **. rewrite !(mul_comm _ c); now rewrite mul_mod_distr_l. Qed. (** Operations modulo. *) Theorem mod_mod: forall a n, n~=0 -> (a mod n) mod n == a mod n. Proof. intros. rewrite mod_small_iff by trivial. now apply mod_bound_or. Qed. Lemma mul_mod_idemp_l : forall a b n, n~=0 -> ((a mod n)*b) mod n == (a*b) mod n. Proof. intros a b n Hn. symmetry. rewrite (div_mod a n) at 1 by order. rewrite add_comm, (mul_comm n), (mul_comm _ b). rewrite mul_add_distr_l, mul_assoc. intros. rewrite mod_add by trivial. now rewrite mul_comm. Qed. Lemma mul_mod_idemp_r : forall a b n, n~=0 -> (a*(b mod n)) mod n == (a*b) mod n. Proof. intros a b n **. rewrite !(mul_comm a). now apply mul_mod_idemp_l. Qed. Theorem mul_mod: forall a b n, n~=0 -> (a * b) mod n == ((a mod n) * (b mod n)) mod n. Proof. intros. now rewrite mul_mod_idemp_l, mul_mod_idemp_r. Qed. Lemma add_mod_idemp_l : forall a b n, n~=0 -> ((a mod n)+b) mod n == (a+b) mod n. Proof. intros a b n Hn. symmetry. rewrite (div_mod a n) at 1 by order. rewrite <- add_assoc, add_comm, mul_comm. intros. now rewrite mod_add. Qed. Lemma add_mod_idemp_r : forall a b n, n~=0 -> (a+(b mod n)) mod n == (a+b) mod n. Proof. intros a b n **. rewrite !(add_comm a). now apply add_mod_idemp_l. Qed. Theorem add_mod: forall a b n, n~=0 -> (a+b) mod n == (a mod n + b mod n) mod n. Proof. intros. now rewrite add_mod_idemp_l, add_mod_idemp_r. Qed. (** With the current convention, the following result isn't always true with a negative last divisor. For instance [ 3/(-2)/(-2) = 1 <> 0 = 3 / (-2*-2) ], or [ 5/2/(-2) = -1 <> -2 = 5 / (2*-2) ]. *) Lemma div_div : forall a b c, b~=0 -> 0 (a/b)/c == a/(b*c). Proof. intros a b c Hb Hc. apply div_unique with (b*((a/b) mod c) + a mod b). - (* begin 0<= ... 0 a mod (b*c) == a mod b + b*((a/b) mod c). Proof. intros a b c Hb Hc. apply add_cancel_l with (b*c*(a/(b*c))). rewrite <- div_mod by (apply neq_mul_0; split; order). rewrite <- div_div by trivial. rewrite add_assoc, add_shuffle0, <- mul_assoc, <- mul_add_distr_l. rewrite <- div_mod by order. apply div_mod; order. Qed. Lemma mod_div: forall a b, b~=0 -> a mod b / b == 0. Proof. intros a b Hb. rewrite div_small_iff by assumption. auto using mod_bound_or. Qed. Lemma add_mul_mod_distr_l : forall a b c d, 0<=a -> 0 0<=d (c*a+d) mod (c*b) == c*(a mod b)+d. Proof. intros. apply add_mul_mod_distr_l; assumption. Qed. Lemma add_mul_mod_distr_r: forall a b c d, 0<=a -> 0 0<=d (a*c+d) mod (b*c) == (a mod b)*c+d. Proof. intros. apply add_mul_mod_distr_r; assumption. Qed. (** A last inequality: *) Theorem div_mul_le: forall a b c, 0<=a -> 0 0<=c -> c*(a/b) <= (c*a)/b. Proof. exact div_mul_le. Qed. End ZDivProp. coq-8.20.0/theories/Numbers/Integer/Abstract/ZDivTrunc.v000066400000000000000000000524631466560755400230730ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* a rem b == a - b*(a÷b). Proof. intros. rewrite <- add_move_l. symmetry. now apply quot_rem. Qed. (** A few sign rules (simple ones) *) Lemma rem_opp_opp : forall a b, b ~= 0 -> (-a) rem (-b) == - (a rem b). Proof. intros. now rewrite rem_opp_r, rem_opp_l. Qed. Lemma quot_opp_l : forall a b, b ~= 0 -> (-a)÷b == -(a÷b). Proof. intros a b ?. rewrite <- (mul_cancel_l _ _ b) by trivial. rewrite <- (add_cancel_r _ _ ((-a) rem b)). now rewrite <- quot_rem, rem_opp_l, mul_opp_r, <- opp_add_distr, <- quot_rem. Qed. Lemma quot_opp_r : forall a b, b ~= 0 -> a÷(-b) == -(a÷b). Proof. intros a b ?. assert (-b ~= 0) by (now rewrite eq_opp_l, opp_0). rewrite <- (mul_cancel_l _ _ (-b)) by trivial. rewrite <- (add_cancel_r _ _ (a rem (-b))). now rewrite <- quot_rem, rem_opp_r, mul_opp_opp, <- quot_rem. Qed. Lemma quot_opp_opp : forall a b, b ~= 0 -> (-a)÷(-b) == a÷b. Proof. intros. now rewrite quot_opp_r, quot_opp_l, opp_involutive. Qed. (** Uniqueness theorems *) Theorem quot_rem_unique : forall b q1 q2 r1 r2 : t, (0<=r1 (0<=r2 b*q1+r1 == b*q2+r2 -> q1 == q2 /\ r1 == r2. Proof. intros b q1 q2 r1 r2 Hr1 Hr2 EQ. destruct Hr1; destruct Hr2; try (intuition; order). - apply NZQuot.div_mod_unique with b; trivial. - rewrite <- (opp_inj_wd r1 r2). apply NZQuot.div_mod_unique with (-b); trivial. + rewrite <- opp_lt_mono, opp_nonneg_nonpos; tauto. + rewrite <- opp_lt_mono, opp_nonneg_nonpos; tauto. + now rewrite 2 mul_opp_l, <- 2 opp_add_distr, opp_inj_wd. Qed. Theorem quot_unique: forall a b q r, 0<=a -> 0<=r a == b*q + r -> q == a÷b. Proof. intros a b q r **; now apply NZQuot.div_unique with r. Qed. Theorem rem_unique: forall a b q r, 0<=a -> 0<=r a == b*q + r -> r == a rem b. Proof. intros a b q r **; now apply NZQuot.mod_unique with q. Qed. (** A division by itself returns 1 *) Lemma quot_same : forall a, a~=0 -> a÷a == 1. Proof. intros a ?. pos_or_neg a. - apply NZQuot.div_same; order. - rewrite <- quot_opp_opp by trivial. now apply NZQuot.div_same. Qed. Lemma rem_same : forall a, a~=0 -> a rem a == 0. Proof. intros. rewrite rem_eq, quot_same by trivial. nzsimpl. apply sub_diag. Qed. (** A division of a small number by a bigger one yields zero. *) Theorem quot_small: forall a b, 0<=a a÷b == 0. Proof. exact NZQuot.div_small. Qed. (** Same situation, in term of remulo: *) Theorem rem_small: forall a b, 0<=a a rem b == a. Proof. exact NZQuot.mod_small. Qed. (** * Basic values of divisions and modulo. *) Lemma quot_0_l: forall a, a~=0 -> 0÷a == 0. Proof. intros a ?. pos_or_neg a. - apply NZQuot.div_0_l; order. - rewrite <- quot_opp_opp, opp_0 by trivial. now apply NZQuot.div_0_l. Qed. Lemma rem_0_l: forall a, a~=0 -> 0 rem a == 0. Proof. intros; rewrite rem_eq, quot_0_l; now nzsimpl. Qed. Lemma quot_1_r: forall a, a÷1 == a. Proof. intros a. pos_or_neg a. - now apply NZQuot.div_1_r. - apply opp_inj. rewrite <- quot_opp_l. + apply NZQuot.div_1_r; order. + intro EQ; symmetry in EQ; revert EQ; apply lt_neq, lt_0_1. Qed. Lemma rem_1_r: forall a, a rem 1 == 0. Proof. intros. rewrite rem_eq, quot_1_r; nzsimpl; auto using sub_diag. intro EQ; symmetry in EQ; revert EQ; apply lt_neq; apply lt_0_1. Qed. Lemma quot_1_l: forall a, 1 1÷a == 0. Proof. exact NZQuot.div_1_l. Qed. Lemma rem_1_l: forall a, 1 1 rem a == 1. Proof. exact NZQuot.mod_1_l. Qed. Lemma quot_mul : forall a b, b~=0 -> (a*b)÷b == a. Proof. intros a b ?. pos_or_neg a; pos_or_neg b. - apply NZQuot.div_mul; order. - rewrite <- quot_opp_opp, <- mul_opp_r by order. apply NZQuot.div_mul; order. - rewrite <- opp_inj_wd, <- quot_opp_l, <- mul_opp_l by order. apply NZQuot.div_mul; order. - rewrite <- opp_inj_wd, <- quot_opp_r, <- mul_opp_opp by order. apply NZQuot.div_mul; order. Qed. Lemma rem_mul : forall a b, b~=0 -> (a*b) rem b == 0. Proof. intros. rewrite rem_eq, quot_mul by trivial. rewrite mul_comm; apply sub_diag. Qed. Theorem quot_unique_exact a b q: b~=0 -> a == b*q -> q == a÷b. Proof. intros Hb H. rewrite H, mul_comm. symmetry. now apply quot_mul. Qed. (** The sign of [a rem b] is the one of [a] (when it's not null) *) Lemma rem_nonneg : forall a b, b~=0 -> 0 <= a -> 0 <= a rem b. Proof. intros a b **. pos_or_neg b. - destruct (rem_bound_pos a b); order. - rewrite <- rem_opp_r; trivial. destruct (rem_bound_pos a (-b)); trivial. Qed. Lemma rem_nonpos : forall a b, b~=0 -> a <= 0 -> a rem b <= 0. Proof. intros a b Hb Ha. apply opp_nonneg_nonpos. apply opp_nonneg_nonpos in Ha. rewrite <- rem_opp_l by trivial. now apply rem_nonneg. Qed. Lemma rem_sign_mul : forall a b, b~=0 -> 0 <= (a rem b) * a. Proof. intros a b Hb. destruct (le_ge_cases 0 a). - apply mul_nonneg_nonneg; trivial. now apply rem_nonneg. - apply mul_nonpos_nonpos; trivial. now apply rem_nonpos. Qed. Lemma rem_sign_nz : forall a b, b~=0 -> a rem b ~= 0 -> sgn (a rem b) == sgn a. Proof. intros a b Hb H. destruct (lt_trichotomy 0 a) as [LT|[EQ|LT]]. - rewrite 2 sgn_pos; try easy. generalize (rem_nonneg a b Hb (lt_le_incl _ _ LT)). order. - now rewrite <- EQ, rem_0_l, sgn_0. - rewrite 2 sgn_neg; try easy. generalize (rem_nonpos a b Hb (lt_le_incl _ _ LT)). order. Qed. Lemma rem_sign : forall a b, a~=0 -> b~=0 -> sgn (a rem b) ~= -sgn a. Proof. intros a b Ha Hb H. destruct (eq_decidable (a rem b) 0) as [EQ|NEQ]. - apply Ha, sgn_null_iff, opp_inj. now rewrite <- H, opp_0, EQ, sgn_0. - apply Ha, sgn_null_iff. apply eq_mul_0_l with 2; try order'. nzsimpl'. apply add_move_0_l. rewrite <- H. symmetry. now apply rem_sign_nz. Qed. (** Operations and absolute value *) Lemma rem_abs_l : forall a b, b ~= 0 -> (abs a) rem b == abs (a rem b). Proof. intros a b Hb. destruct (le_ge_cases 0 a) as [LE|LE]. - rewrite 2 abs_eq; try easy. now apply rem_nonneg. - rewrite 2 abs_neq, rem_opp_l; try easy. now apply rem_nonpos. Qed. Lemma rem_abs_r : forall a b, b ~= 0 -> a rem (abs b) == a rem b. Proof. intros a b Hb. destruct (le_ge_cases 0 b). - now rewrite abs_eq. - now rewrite abs_neq, ?rem_opp_r. Qed. Lemma rem_abs : forall a b, b ~= 0 -> (abs a) rem (abs b) == abs (a rem b). Proof. intros. now rewrite rem_abs_r, rem_abs_l. Qed. Lemma quot_abs_l : forall a b, b ~= 0 -> (abs a)÷b == (sgn a)*(a÷b). Proof. intros a b Hb. destruct (lt_trichotomy 0 a) as [LT|[EQ|LT]]. - rewrite abs_eq, sgn_pos by order. now nzsimpl. - rewrite <- EQ, abs_0, quot_0_l; trivial. now nzsimpl. - rewrite abs_neq, quot_opp_l, sgn_neg by order. rewrite mul_opp_l. now nzsimpl. Qed. Lemma quot_abs_r : forall a b, b ~= 0 -> a÷(abs b) == (sgn b)*(a÷b). Proof. intros a b Hb. destruct (lt_trichotomy 0 b) as [LT|[EQ|LT]]. - rewrite abs_eq, sgn_pos by order. now nzsimpl. - order. - rewrite abs_neq, quot_opp_r, sgn_neg by order. rewrite mul_opp_l. now nzsimpl. Qed. Lemma quot_abs : forall a b, b ~= 0 -> (abs a)÷(abs b) == abs (a÷b). Proof. intros a b Hb. pos_or_neg a; [rewrite (abs_eq a)|rewrite (abs_neq a)]; try apply opp_nonneg_nonpos; try order. - pos_or_neg b; [rewrite (abs_eq b)|rewrite (abs_neq b)]; try apply opp_nonneg_nonpos; try order. + rewrite abs_eq; try easy. apply NZQuot.div_pos; order. + rewrite <- abs_opp, <- quot_opp_r, abs_eq; try easy. apply NZQuot.div_pos; order. - pos_or_neg b; [rewrite (abs_eq b)|rewrite (abs_neq b)]; try apply opp_nonneg_nonpos; try order. + rewrite <- (abs_opp (_÷_)), <- quot_opp_l, abs_eq; try easy. apply NZQuot.div_pos; order. + rewrite <- (quot_opp_opp a b), abs_eq; try easy. apply NZQuot.div_pos; order. Qed. (** We have a general bound for absolute values *) Lemma rem_bound_abs : forall a b, b~=0 -> abs (a rem b) < abs b. Proof. intros. rewrite <- rem_abs; trivial. apply rem_bound_pos. - apply abs_nonneg. - now apply abs_pos. Qed. (** * Order results about rem and quot *) (** A modulo cannot grow beyond its starting point. *) Theorem rem_le: forall a b, 0<=a -> 0 a rem b <= a. Proof. exact NZQuot.mod_le. Qed. Theorem quot_pos : forall a b, 0<=a -> 0 0<= a÷b. Proof. exact NZQuot.div_pos. Qed. Lemma quot_str_pos : forall a b, 0 0 < a÷b. Proof. exact NZQuot.div_str_pos. Qed. Lemma quot_small_iff : forall a b, b~=0 -> (a÷b==0 <-> abs a < abs b). Proof. intros a b ?. pos_or_neg a; pos_or_neg b. - rewrite NZQuot.div_small_iff; try order. rewrite 2 abs_eq; intuition; order. - rewrite <- opp_inj_wd, opp_0, <- quot_opp_r, NZQuot.div_small_iff by order. rewrite (abs_eq a), (abs_neq' b); intuition; order. - rewrite <- opp_inj_wd, opp_0, <- quot_opp_l, NZQuot.div_small_iff by order. rewrite (abs_neq' a), (abs_eq b); intuition; order. - rewrite <- quot_opp_opp, NZQuot.div_small_iff by order. rewrite (abs_neq' a), (abs_neq' b); intuition; order. Qed. Lemma rem_small_iff : forall a b, b~=0 -> (a rem b == a <-> abs a < abs b). Proof. intros a b ?. rewrite rem_eq, <- quot_small_iff by order. rewrite sub_move_r, <- (add_0_r a) at 1. rewrite add_cancel_l. rewrite eq_sym_iff, eq_mul_0. tauto. Qed. (** As soon as the divisor is strictly greater than 1, the division is strictly decreasing. *) Lemma quot_lt : forall a b, 0 1 a÷b < a. Proof. exact NZQuot.div_lt. Qed. (** [le] is compatible with a positive division. *) Lemma quot_le_mono : forall a b c, 0 a<=b -> a÷c <= b÷c. Proof. intros a b c **. pos_or_neg a. - apply NZQuot.div_le_mono; auto. - pos_or_neg b. + apply le_trans with 0. * rewrite <- opp_nonneg_nonpos, <- quot_opp_l by order. apply quot_pos; order. * apply quot_pos; order. + rewrite opp_le_mono in *. rewrite <- 2 quot_opp_l by order. apply NZQuot.div_le_mono; intuition; order. Qed. (** With this choice of division, rounding of quot is always done toward zero: *) Lemma mul_quot_le : forall a b, 0<=a -> b~=0 -> 0 <= b*(a÷b) <= a. Proof. intros a b **. pos_or_neg b. - split. + apply mul_nonneg_nonneg; [|apply quot_pos]; order. + apply NZQuot.mul_div_le; order. - rewrite <- mul_opp_opp, <- quot_opp_r by order. split. + apply mul_nonneg_nonneg; [|apply quot_pos]; order. + apply NZQuot.mul_div_le; order. Qed. Lemma mul_quot_ge : forall a b, a<=0 -> b~=0 -> a <= b*(a÷b) <= 0. Proof. intros a b **. rewrite <- opp_nonneg_nonpos, opp_le_mono, <-mul_opp_r, <-quot_opp_l by order. rewrite <- opp_nonneg_nonpos in *. destruct (mul_quot_le (-a) b); tauto. Qed. (** For positive numbers, considering [S (a÷b)] leads to an upper bound for [a] *) Lemma mul_succ_quot_gt: forall a b, 0<=a -> 0 a < b*(S (a÷b)). Proof. exact NZQuot.mul_succ_div_gt. Qed. (** Similar results with negative numbers *) Lemma mul_pred_quot_lt: forall a b, a<=0 -> 0 b*(P (a÷b)) < a. Proof. intros. rewrite opp_lt_mono, <- mul_opp_r, opp_pred, <- quot_opp_l by order. rewrite <- opp_nonneg_nonpos in *. now apply mul_succ_quot_gt. Qed. Lemma mul_pred_quot_gt: forall a b, 0<=a -> b<0 -> a < b*(P (a÷b)). Proof. intros. rewrite <- mul_opp_opp, opp_pred, <- quot_opp_r by order. rewrite <- opp_pos_neg in *. now apply mul_succ_quot_gt. Qed. Lemma mul_succ_quot_lt: forall a b, a<=0 -> b<0 -> b*(S (a÷b)) < a. Proof. intros. rewrite opp_lt_mono, <- mul_opp_l, <- quot_opp_opp by order. rewrite <- opp_nonneg_nonpos, <- opp_pos_neg in *. now apply mul_succ_quot_gt. Qed. (** Inequality [mul_quot_le] is exact iff the modulo is zero. *) Lemma quot_exact : forall a b, b~=0 -> (a == b*(a÷b) <-> a rem b == 0). Proof. intros. rewrite rem_eq by order. rewrite sub_move_r; nzsimpl; tauto. Qed. (** Some additional inequalities about quot. *) Theorem quot_lt_upper_bound: forall a b q, 0<=a -> 0 a < b*q -> a÷b < q. Proof. exact NZQuot.div_lt_upper_bound. Qed. Theorem quot_le_upper_bound: forall a b q, 0 a <= b*q -> a÷b <= q. Proof. intros a b q **. rewrite <- (quot_mul q b) by order. apply quot_le_mono; trivial. now rewrite mul_comm. Qed. Theorem quot_le_lower_bound: forall a b q, 0 b*q <= a -> q <= a÷b. Proof. intros a b q **. rewrite <- (quot_mul q b) by order. apply quot_le_mono; trivial. now rewrite mul_comm. Qed. (** A division respects opposite monotonicity for the divisor *) Lemma quot_le_compat_l: forall p q r, 0<=p -> 0 p÷r <= p÷q. Proof. exact NZQuot.div_le_compat_l. Qed. (** * Relations between usual operations and rem and quot *) (** Unlike with other division conventions, some results here aren't always valid, and need to be restricted. For instance [(a+b*c) rem c <> a rem c] for [a=9,b=-5,c=2] *) Lemma rem_add : forall a b c, c~=0 -> 0 <= (a+b*c)*a -> (a + b * c) rem c == a rem c. Proof. assert (forall a b c, c~=0 -> 0<=a -> 0<=a+b*c -> (a+b*c) rem c == a rem c). { intros a b c **. pos_or_neg c. - apply NZQuot.mod_add; order. - rewrite <- (rem_opp_r a), <- (rem_opp_r (a+b*c)) by order. rewrite <- mul_opp_opp in *. apply NZQuot.mod_add; order. } intros a b c Hc Habc. destruct (le_0_mul _ _ Habc) as [(Habc',Ha)|(Habc',Ha)]. { auto. } apply opp_inj. revert Ha Habc'. rewrite <- 2 opp_nonneg_nonpos. rewrite <- 2 rem_opp_l, opp_add_distr, <- mul_opp_l by order. auto. Qed. Lemma quot_add : forall a b c, c~=0 -> 0 <= (a+b*c)*a -> (a + b * c) ÷ c == a ÷ c + b. Proof. intros a b c **. rewrite <- (mul_cancel_l _ _ c) by trivial. rewrite <- (add_cancel_r _ _ ((a+b*c) rem c)). rewrite <- quot_rem, rem_add by trivial. now rewrite mul_add_distr_l, add_shuffle0, <-quot_rem, mul_comm. Qed. Lemma quot_add_l: forall a b c, b~=0 -> 0 <= (a*b+c)*c -> (a * b + c) ÷ b == a + c ÷ b. Proof. intros a b c. rewrite add_comm, (add_comm a). now apply quot_add. Qed. (** Cancellations. *) Lemma quot_mul_cancel_r : forall a b c, b~=0 -> c~=0 -> (a*c)÷(b*c) == a÷b. Proof. assert (Aux1 : forall a b c, 0<=a -> 0 c~=0 -> (a*c)÷(b*c) == a÷b). { intros a b c **. pos_or_neg c. - apply NZQuot.div_mul_cancel_r; order. - rewrite <- quot_opp_opp, <- 2 mul_opp_r. + apply NZQuot.div_mul_cancel_r; order. + rewrite <- neq_mul_0; intuition order. } assert (Aux2 : forall a b c, 0<=a -> b~=0 -> c~=0 -> (a*c)÷(b*c) == a÷b). { intros a b c **. pos_or_neg b. - apply Aux1; order. - apply opp_inj. rewrite <- 2 quot_opp_r, <- mul_opp_l; try order. + apply Aux1; order. + rewrite <- neq_mul_0; intuition order. } intros a b c **. pos_or_neg a. { apply Aux2; order. } apply opp_inj. rewrite <- 2 quot_opp_l, <- mul_opp_l; try order. { apply Aux2; order. } rewrite <- neq_mul_0; intuition order. Qed. Lemma quot_mul_cancel_l : forall a b c, b~=0 -> c~=0 -> (c*a)÷(c*b) == a÷b. Proof. intros a b c **. rewrite !(mul_comm c); now apply quot_mul_cancel_r. Qed. Lemma mul_rem_distr_r: forall a b c, b~=0 -> c~=0 -> (a*c) rem (b*c) == (a rem b) * c. Proof. intros a b c **. assert (b*c ~= 0) by (rewrite <- neq_mul_0; tauto). rewrite ! rem_eq by trivial. rewrite quot_mul_cancel_r by order. now rewrite mul_sub_distr_r, <- !mul_assoc, (mul_comm (a÷b) c). Qed. Lemma mul_rem_distr_l: forall a b c, b~=0 -> c~=0 -> (c*a) rem (c*b) == c * (a rem b). Proof. intros a b c **; rewrite !(mul_comm c); now apply mul_rem_distr_r. Qed. (** Operations modulo. *) Theorem rem_rem: forall a n, n~=0 -> (a rem n) rem n == a rem n. Proof. intros a n **. pos_or_neg a; pos_or_neg n. - apply NZQuot.mod_mod; order. - rewrite <- ! (rem_opp_r _ n) by trivial. apply NZQuot.mod_mod; order. - apply opp_inj. rewrite <- !rem_opp_l by order. apply NZQuot.mod_mod; order. - apply opp_inj. rewrite <- !rem_opp_opp by order. apply NZQuot.mod_mod; order. Qed. Lemma mul_rem_idemp_l : forall a b n, n~=0 -> ((a rem n)*b) rem n == (a*b) rem n. Proof. assert (Aux1 : forall a b n, 0<=a -> 0<=b -> n~=0 -> ((a rem n)*b) rem n == (a*b) rem n). { intros a b n **. pos_or_neg n. - apply NZQuot.mul_mod_idemp_l; order. - rewrite <- ! (rem_opp_r _ n) by order. apply NZQuot.mul_mod_idemp_l; order. } assert (Aux2 : forall a b n, 0<=a -> n~=0 -> ((a rem n)*b) rem n == (a*b) rem n). { intros a b n **. pos_or_neg b. - now apply Aux1. - apply opp_inj. rewrite <-2 rem_opp_l, <-2 mul_opp_r by order. apply Aux1; order. } intros a b n Hn. pos_or_neg a. { now apply Aux2. } apply opp_inj. rewrite <-2 rem_opp_l, <-2 mul_opp_l, <-rem_opp_l by order. apply Aux2; order. Qed. Lemma mul_rem_idemp_r : forall a b n, n~=0 -> (a*(b rem n)) rem n == (a*b) rem n. Proof. intros a b n **. rewrite !(mul_comm a). now apply mul_rem_idemp_l. Qed. Theorem mul_rem: forall a b n, n~=0 -> (a * b) rem n == ((a rem n) * (b rem n)) rem n. Proof. intros. now rewrite mul_rem_idemp_l, mul_rem_idemp_r. Qed. (** addition and modulo Generally speaking, unlike with other conventions, we don't have [(a+b) rem n = (a rem n + b rem n) rem n] for any a and b. For instance, take (8 + (-10)) rem 3 = -2 whereas (8 rem 3 + (-10 rem 3)) rem 3 = 1. *) Lemma add_rem_idemp_l : forall a b n, n~=0 -> 0 <= a*b -> ((a rem n)+b) rem n == (a+b) rem n. Proof. assert (Aux : forall a b n, 0<=a -> 0<=b -> n~=0 -> ((a rem n)+b) rem n == (a+b) rem n). { intros a b n **. pos_or_neg n. { apply NZQuot.add_mod_idemp_l; order. } rewrite <- ! (rem_opp_r _ n) by order. apply NZQuot.add_mod_idemp_l; order. } intros a b n Hn Hab. destruct (le_0_mul _ _ Hab) as [(Ha,Hb)|(Ha,Hb)]. { now apply Aux. } apply opp_inj. rewrite <-2 rem_opp_l, 2 opp_add_distr, <-rem_opp_l by order. rewrite <- opp_nonneg_nonpos in *. now apply Aux. Qed. Lemma add_rem_idemp_r : forall a b n, n~=0 -> 0 <= a*b -> (a+(b rem n)) rem n == (a+b) rem n. Proof. intros a b n **. rewrite !(add_comm a). apply add_rem_idemp_l; trivial. now rewrite mul_comm. Qed. Theorem add_rem: forall a b n, n~=0 -> 0 <= a*b -> (a+b) rem n == (a rem n + b rem n) rem n. Proof. intros a b n Hn Hab. rewrite add_rem_idemp_l, add_rem_idemp_r; trivial. - reflexivity. - destruct (le_0_mul _ _ Hab) as [(Ha,Hb)|(Ha,Hb)]; destruct (le_0_mul _ _ (rem_sign_mul b n Hn)) as [(Hb',Hm)|(Hb',Hm)]; auto using mul_nonneg_nonneg, mul_nonpos_nonpos. + setoid_replace b with 0 by order. rewrite rem_0_l by order. nzsimpl; order. + setoid_replace b with 0 by order. rewrite rem_0_l by order. nzsimpl; order. Qed. (** Conversely, the following results need less restrictions here. *) Lemma quot_quot : forall a b c, b~=0 -> c~=0 -> (a÷b)÷c == a÷(b*c). Proof. assert (Aux1 : forall a b c, 0<=a -> 0 c~=0 -> (a÷b)÷c == a÷(b*c)). { intros a b c **. pos_or_neg c. { apply NZQuot.div_div; order. } apply opp_inj. rewrite <- 2 quot_opp_r, <- mul_opp_r; trivial. { apply NZQuot.div_div; order. } rewrite <- neq_mul_0; intuition order. } assert (Aux2 : forall a b c, 0<=a -> b~=0 -> c~=0 -> (a÷b)÷c == a÷(b*c)). { intros a b c **. pos_or_neg b. { apply Aux1; order. } apply opp_inj. rewrite <- quot_opp_l, <- 2 quot_opp_r, <- mul_opp_l; trivial. { apply Aux1; trivial. } rewrite <- neq_mul_0; intuition order. } intros a b c **. pos_or_neg a. { apply Aux2; order. } apply opp_inj. rewrite <- 3 quot_opp_l; try order. { apply Aux2; order. } rewrite <- neq_mul_0. tauto. Qed. Lemma mod_mul_r : forall a b c, b~=0 -> c~=0 -> a rem (b*c) == a rem b + b*((a÷b) rem c). Proof. intros a b c Hb Hc. apply add_cancel_l with (b*c*(a÷(b*c))). rewrite <- quot_rem by (apply neq_mul_0; split; order). rewrite <- quot_quot by trivial. rewrite add_assoc, add_shuffle0, <- mul_assoc, <- mul_add_distr_l. rewrite <- quot_rem by order. apply quot_rem; order. Qed. Lemma rem_quot: forall a b, b~=0 -> a rem b ÷ b == 0. Proof. intros a b Hb. rewrite quot_small_iff by assumption. auto using rem_bound_abs. Qed. (** A last inequality: *) Theorem quot_mul_le: forall a b c, 0<=a -> 0 0<=c -> c*(a÷b) <= (c*a)÷b. Proof. exact NZQuot.div_mul_le. Qed. End ZQuotProp. coq-8.20.0/theories/Numbers/Integer/Abstract/ZGcd.v000066400000000000000000000220651466560755400220250ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* (n | m). Proof. intros n m. split; intros (p,Hp); exists (-p); rewrite Hp. - now rewrite mul_opp_l, mul_opp_r. - now rewrite mul_opp_opp. Qed. Lemma divide_opp_r : forall n m, (n | -m) <-> (n | m). Proof. intros n m. split; intros (p,Hp); exists (-p). - now rewrite mul_opp_l, <- Hp, opp_involutive. - now rewrite Hp, mul_opp_l. Qed. Lemma divide_abs_l : forall n m, (abs n | m) <-> (n | m). Proof. intros n m. destruct (abs_eq_or_opp n) as [H|H]; rewrite H. - easy. - apply divide_opp_l. Qed. Lemma divide_abs_r : forall n m, (n | abs m) <-> (n | m). Proof. intros n m. destruct (abs_eq_or_opp m) as [H|H]; rewrite H. - easy. - apply divide_opp_r. Qed. Lemma divide_1_r_abs : forall n, (n | 1) -> abs n == 1. Proof. intros n Hn. apply divide_1_r_nonneg. - apply abs_nonneg. - now apply divide_abs_l. Qed. Lemma divide_1_r : forall n, (n | 1) -> n==1 \/ n==-1. Proof. intros n (m,H). rewrite mul_comm in H. now apply eq_mul_1 with m. Qed. Lemma divide_antisym_abs : forall n m, (n | m) -> (m | n) -> abs n == abs m. Proof. intros. apply divide_antisym_nonneg; try apply abs_nonneg. - now apply divide_abs_l, divide_abs_r. - now apply divide_abs_l, divide_abs_r. Qed. Lemma divide_antisym : forall n m, (n | m) -> (m | n) -> n == m \/ n == -m. Proof. intros. now apply abs_eq_cases, divide_antisym_abs. Qed. Lemma divide_sub_r : forall n m p, (n | m) -> (n | p) -> (n | m - p). Proof. intros n m p H H'. rewrite <- add_opp_r. apply divide_add_r; trivial. now apply divide_opp_r. Qed. Lemma divide_add_cancel_r : forall n m p, (n | m) -> (n | m + p) -> (n | p). Proof. intros n m p H H'. rewrite <- (add_simpl_l m p). now apply divide_sub_r. Qed. (** Properties of gcd *) Lemma gcd_opp_l : forall n m, gcd (-n) m == gcd n m. Proof. intros. apply gcd_unique_alt; try apply gcd_nonneg. intros. rewrite divide_opp_r. apply gcd_divide_iff. Qed. Lemma gcd_opp_r : forall n m, gcd n (-m) == gcd n m. Proof. intros. now rewrite gcd_comm, gcd_opp_l, gcd_comm. Qed. Lemma gcd_abs_l : forall n m, gcd (abs n) m == gcd n m. Proof. intros n m. destruct (abs_eq_or_opp n) as [H|H]; rewrite H. - easy. - apply gcd_opp_l. Qed. Lemma gcd_abs_r : forall n m, gcd n (abs m) == gcd n m. Proof. intros. now rewrite gcd_comm, gcd_abs_l, gcd_comm. Qed. Lemma gcd_0_l : forall n, gcd 0 n == abs n. Proof. intros. rewrite <- gcd_abs_r. apply gcd_0_l_nonneg, abs_nonneg. Qed. Lemma gcd_0_r : forall n, gcd n 0 == abs n. Proof. intros. now rewrite gcd_comm, gcd_0_l. Qed. Lemma gcd_diag : forall n, gcd n n == abs n. Proof. intros. rewrite <- gcd_abs_l, <- gcd_abs_r. apply gcd_diag_nonneg, abs_nonneg. Qed. Lemma gcd_add_mult_diag_r : forall n m p, gcd n (m+p*n) == gcd n m. Proof. intros n m p. apply gcd_unique_alt; try apply gcd_nonneg. intros. rewrite gcd_divide_iff. split; intros (U,V); split; trivial. - apply divide_add_r; trivial. now apply divide_mul_r. - apply divide_add_cancel_r with (p*n); trivial. + now apply divide_mul_r. + now rewrite add_comm. Qed. Lemma gcd_add_diag_r : forall n m, gcd n (m+n) == gcd n m. Proof. intros n m. rewrite <- (mul_1_l n) at 2. apply gcd_add_mult_diag_r. Qed. Lemma gcd_sub_diag_r : forall n m, gcd n (m-n) == gcd n m. Proof. intros n m. rewrite <- (mul_1_l n) at 2. rewrite <- add_opp_r, <- mul_opp_l. apply gcd_add_mult_diag_r. Qed. Definition Bezout n m p := exists a b, a*n + b*m == p. #[global] Instance Bezout_wd : Proper (eq==>eq==>eq==>iff) Bezout. Proof. unfold Bezout. intros x x' Hx y y' Hy z z' Hz. setoid_rewrite Hx. setoid_rewrite Hy. now setoid_rewrite Hz. Qed. Lemma bezout_1_gcd : forall n m, Bezout n m 1 -> gcd n m == 1. Proof. intros n m (q & r & H). apply gcd_unique; trivial using divide_1_l, le_0_1. intros p Hn Hm. rewrite <- H. apply divide_add_r; now apply divide_mul_r. Qed. Lemma gcd_bezout : forall n m p, gcd n m == p -> Bezout n m p. Proof. (* First, a version restricted to natural numbers *) assert (aux : forall n, 0<=n -> forall m, 0<=m -> Bezout n m (gcd n m)). { intros n Hn; pattern n. apply (fun H => strong_right_induction H 0); trivial. clear n Hn. intros n Hn IHn. apply le_lteq in Hn; destruct Hn as [Hn|Hn]. - intros m Hm; pattern m. apply (fun H => strong_right_induction H 0); trivial. clear m Hm. intros m Hm IHm. destruct (lt_trichotomy n m) as [LT|[EQ|LT]]. + (* n < m *) destruct (IHm (m-n)) as (a & b & EQ). * apply sub_nonneg; order. * now apply lt_sub_pos. * exists (a-b). exists b. rewrite gcd_sub_diag_r in EQ. rewrite <- EQ. rewrite mul_sub_distr_r, mul_sub_distr_l. now rewrite add_sub_assoc, add_sub_swap. + (* n = m *) rewrite EQ. rewrite gcd_diag_nonneg; trivial. exists 1. exists 0. now nzsimpl. + (* m < n *) destruct (IHn m Hm LT n) as (a & b & EQ). { order. } exists b. exists a. now rewrite gcd_comm, <- EQ, add_comm. - (* n = 0 *) intros m Hm. rewrite <- Hn, gcd_0_l_nonneg; trivial. exists 0. exists 1. now nzsimpl. } (* Then we relax the positivity condition on n *) assert (aux' : forall n m, 0<=m -> Bezout n m (gcd n m)). { intros n m Hm. destruct (le_ge_cases 0 n). - now apply aux. - assert (Hn' : 0 <= -n) by now apply opp_nonneg_nonpos. destruct (aux (-n) Hn' m Hm) as (a & b & EQ). exists (-a). exists b. now rewrite <- gcd_opp_l, <- EQ, mul_opp_r, mul_opp_l. } (* And finally we do the same for m *) intros n m p Hp. rewrite <- Hp; clear Hp. destruct (le_ge_cases 0 m). - now apply aux'. - assert (Hm' : 0 <= -m) by now apply opp_nonneg_nonpos. destruct (aux' n (-m) Hm') as (a & b & EQ). exists a. exists (-b). now rewrite <- gcd_opp_r, <- EQ, mul_opp_r, mul_opp_l. Qed. Lemma gcd_mul_mono_l : forall n m p, gcd (p * n) (p * m) == abs p * gcd n m. Proof. intros n m p. apply gcd_unique. - apply mul_nonneg_nonneg; trivial using gcd_nonneg, abs_nonneg. - destruct (gcd_divide_l n m) as (q,Hq). rewrite Hq at 2. rewrite mul_assoc. apply mul_divide_mono_r. rewrite <- (abs_sgn p) at 2. rewrite <- mul_assoc. apply divide_factor_l. - destruct (gcd_divide_r n m) as (q,Hq). rewrite Hq at 2. rewrite mul_assoc. apply mul_divide_mono_r. rewrite <- (abs_sgn p) at 2. rewrite <- mul_assoc. apply divide_factor_l. - intros q H H'. destruct (gcd_bezout n m (gcd n m) (eq_refl _)) as (a & b & EQ). rewrite <- EQ, <- sgn_abs, mul_add_distr_l. apply divide_add_r. + rewrite mul_shuffle2. now apply divide_mul_l. + rewrite mul_shuffle2. now apply divide_mul_l. Qed. Lemma gcd_mul_mono_l_nonneg : forall n m p, 0<=p -> gcd (p*n) (p*m) == p * gcd n m. Proof. intros n m p ?. rewrite <- (abs_eq p) at 3; trivial. apply gcd_mul_mono_l. Qed. Lemma gcd_mul_mono_r : forall n m p, gcd (n * p) (m * p) == gcd n m * abs p. Proof. intros n m p. now rewrite !(mul_comm _ p), gcd_mul_mono_l, mul_comm. Qed. Lemma gcd_mul_mono_r_nonneg : forall n m p, 0<=p -> gcd (n*p) (m*p) == gcd n m * p. Proof. intros n m p ?. rewrite <- (abs_eq p) at 3; trivial. apply gcd_mul_mono_r. Qed. Lemma gauss : forall n m p, (n | m * p) -> gcd n m == 1 -> (n | p). Proof. intros n m p H G. destruct (gcd_bezout n m 1 G) as (a & b & EQ). rewrite <- (mul_1_l p), <- EQ, mul_add_distr_r. apply divide_add_r. - rewrite mul_shuffle0. apply divide_factor_r. - rewrite <- mul_assoc. now apply divide_mul_r. Qed. Lemma divide_mul_split : forall n m p, n ~= 0 -> (n | m * p) -> exists q r, n == q*r /\ (q | m) /\ (r | p). Proof. intros n m p Hn H. assert (G := gcd_nonneg n m). apply le_lteq in G; destruct G as [G|G]. - destruct (gcd_divide_l n m) as (q,Hq). exists (gcd n m). exists q. split. + now rewrite mul_comm. + split. * apply gcd_divide_r. * destruct (gcd_divide_r n m) as (r,Hr). rewrite Hr in H. rewrite Hq in H at 1. rewrite mul_shuffle0 in H. apply mul_divide_cancel_r in H; [|order]. apply gauss with r; trivial. apply mul_cancel_r with (gcd n m); [order|]. rewrite mul_1_l. rewrite <- gcd_mul_mono_r_nonneg, <- Hq, <- Hr; order. - symmetry in G. apply gcd_eq_0 in G. destruct G as (Hn',_); order. Qed. (** TODO : more about rel_prime (i.e. gcd == 1), about prime ... *) End ZGcdProp. coq-8.20.0/theories/Numbers/Integer/Abstract/ZLcm.v000066400000000000000000000346451466560755400220520ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* 0 a÷b == a/b. Proof. intros a b **. apply div_unique_pos with (a rem b). - now apply rem_bound_pos. - apply quot_rem. order. Qed. Lemma rem_mod_nonneg : forall a b, 0<=a -> 0 a rem b == a mod b. Proof. intros a b **. apply mod_unique_pos with (a÷b). - now apply rem_bound_pos. - apply quot_rem. order. Qed. (** We can use the sign rule to have an relation between divisions. *) Lemma quot_div : forall a b, b~=0 -> a÷b == (sgn a)*(sgn b)*(abs a / abs b). Proof. assert (AUX : forall a b, 0 a÷b == (sgn a)*(sgn b)*(abs a / abs b)). { intros a b Hb. rewrite (sgn_pos b), (abs_eq b), mul_1_r by order. destruct (lt_trichotomy 0 a) as [Ha|[Ha|Ha]]. - rewrite sgn_pos, abs_eq, mul_1_l, quot_div_nonneg; order. - rewrite <- Ha, abs_0, sgn_0, quot_0_l, div_0_l, mul_0_l; order. - rewrite sgn_neg, abs_neq, mul_opp_l, mul_1_l, eq_opp_r, <-quot_opp_l by order. apply quot_div_nonneg; trivial. apply opp_nonneg_nonpos; order. } (* main *) intros a b Hb. apply neg_pos_cases in Hb. destruct Hb as [Hb|Hb]; [|now apply AUX]. rewrite <- (opp_involutive b) at 1. rewrite quot_opp_r. - rewrite AUX, abs_opp, sgn_opp, mul_opp_r, mul_opp_l, opp_involutive. + reflexivity. + now apply opp_pos_neg. - rewrite eq_opp_l, opp_0; order. Qed. Lemma rem_mod : forall a b, b~=0 -> a rem b == (sgn a) * ((abs a) mod (abs b)). Proof. intros a b Hb. rewrite <- rem_abs_r by trivial. assert (Hb' := proj2 (abs_pos b) Hb). destruct (lt_trichotomy 0 a) as [Ha|[Ha|Ha]]. - rewrite (abs_eq a), sgn_pos, mul_1_l, rem_mod_nonneg; order. - rewrite <- Ha, abs_0, sgn_0, mod_0_l, rem_0_l, mul_0_l; order. - rewrite sgn_neg, (abs_neq a), mul_opp_l, mul_1_l, eq_opp_r, <-rem_opp_l by order. apply rem_mod_nonneg; trivial. apply opp_nonneg_nonpos; order. Qed. (** Modulo and remainder are null at the same place, and this correspond to the divisibility relation. *) Lemma mod_divide : forall a b, b~=0 -> (a mod b == 0 <-> (b|a)). Proof. intros a b Hb. split. - intros Hab. exists (a/b). rewrite mul_comm. rewrite (div_mod a b Hb) at 1. rewrite Hab; now nzsimpl. - intros (c,Hc). rewrite Hc. now apply mod_mul. Qed. Lemma rem_divide : forall a b, b~=0 -> (a rem b == 0 <-> (b|a)). Proof. intros a b Hb. split. - intros Hab. exists (a÷b). rewrite mul_comm. rewrite (quot_rem a b Hb) at 1. rewrite Hab; now nzsimpl. - intros (c,Hc). rewrite Hc. now apply rem_mul. Qed. Lemma rem_mod_eq_0 : forall a b, b~=0 -> (a rem b == 0 <-> a mod b == 0). Proof. intros a b Hb. now rewrite mod_divide, rem_divide. Qed. (** When division is exact, div and quot agree *) Lemma quot_div_exact : forall a b, b~=0 -> (b|a) -> a÷b == a/b. Proof. intros a b Hb H. apply mul_cancel_l with b; trivial. assert (H':=H). apply rem_divide, quot_exact in H; trivial. apply mod_divide, div_exact in H'; trivial. now rewrite <-H,<-H'. Qed. Lemma divide_div_mul_exact : forall a b c, b~=0 -> (b|a) -> (c*a)/b == c*(a/b). Proof. intros a b c Hb H. apply mul_cancel_l with b; trivial. rewrite mul_assoc, mul_shuffle0. assert (H':=H). apply mod_divide, div_exact in H'; trivial. rewrite <- H', (mul_comm a c). symmetry. apply div_exact; trivial. apply mod_divide; trivial. now apply divide_mul_r. Qed. Lemma divide_quot_mul_exact : forall a b c, b~=0 -> (b|a) -> (c*a)÷b == c*(a÷b). Proof. intros a b c Hb H. rewrite 2 quot_div_exact; trivial. - apply divide_div_mul_exact; trivial. - now apply divide_mul_r. Qed. (** Gcd of divided elements, for exact divisions *) Lemma gcd_div_factor : forall a b c, 0 (c|a) -> (c|b) -> gcd (a/c) (b/c) == (gcd a b)/c. Proof. intros a b c Hc Ha Hb. apply mul_cancel_l with c; try order. assert (H:=gcd_greatest _ _ _ Ha Hb). apply mod_divide, div_exact in H; try order. rewrite <- H. rewrite <- gcd_mul_mono_l_nonneg; try order. f_equiv; symmetry; apply div_exact; try order; apply mod_divide; trivial; try order. Qed. Lemma gcd_quot_factor : forall a b c, 0 (c|a) -> (c|b) -> gcd (a÷c) (b÷c) == (gcd a b)÷c. Proof. intros a b c Hc Ha Hb. rewrite !quot_div_exact; trivial; try order. - now apply gcd_div_factor. - now apply gcd_greatest. Qed. Lemma gcd_div_gcd : forall a b g, g~=0 -> g == gcd a b -> gcd (a/g) (b/g) == 1. Proof. intros a b g NZ EQ. rewrite gcd_div_factor. - now rewrite <- EQ, div_same. - generalize (gcd_nonneg a b); order. - rewrite EQ; apply gcd_divide_l. - rewrite EQ; apply gcd_divide_r. Qed. Lemma gcd_quot_gcd : forall a b g, g~=0 -> g == gcd a b -> gcd (a÷g) (b÷g) == 1. Proof. intros a b g NZ EQ. rewrite !quot_div_exact; trivial. - now apply gcd_div_gcd. - rewrite EQ; apply gcd_divide_r. - rewrite EQ; apply gcd_divide_l. Qed. (** The following equality is crucial for Euclid algorithm *) Lemma gcd_mod : forall a b, b~=0 -> gcd (a mod b) b == gcd b a. Proof. intros a b Hb. rewrite mod_eq; trivial. rewrite <- add_opp_r, mul_comm, <- mul_opp_l. rewrite (gcd_comm _ b). apply gcd_add_mult_diag_r. Qed. Lemma gcd_rem : forall a b, b~=0 -> gcd (a rem b) b == gcd b a. Proof. intros a b Hb. rewrite rem_eq; trivial. rewrite <- add_opp_r, mul_comm, <- mul_opp_l. rewrite (gcd_comm _ b). apply gcd_add_mult_diag_r. Qed. (** We now define lcm thanks to gcd: lcm a b = a * (b / gcd a b) = (a / gcd a b) * b = (a*b) / gcd a b We had an abs in order to have an always-nonnegative lcm, in the spirit of gcd. Nota: [lcm 0 0] should be 0, which isn't guarantee with the third equation above. *) Definition lcm a b := abs (a*(b/gcd a b)). #[global] Instance lcm_wd : Proper (eq==>eq==>eq) lcm. Proof. unfold lcm. solve_proper. Qed. Lemma lcm_equiv1 : forall a b, gcd a b ~= 0 -> a * (b / gcd a b) == (a*b)/gcd a b. Proof. intros a b H. rewrite divide_div_mul_exact; try easy. apply gcd_divide_r. Qed. Lemma lcm_equiv2 : forall a b, gcd a b ~= 0 -> (a / gcd a b) * b == (a*b)/gcd a b. Proof. intros a b H. rewrite 2 (mul_comm _ b). rewrite divide_div_mul_exact; try easy. apply gcd_divide_l. Qed. Lemma gcd_div_swap : forall a b, (a / gcd a b) * b == a * (b / gcd a b). Proof. intros a b. destruct (eq_decidable (gcd a b) 0) as [EQ|NEQ]. - apply gcd_eq_0 in EQ. destruct EQ as (EQ,EQ'). rewrite EQ, EQ'. now nzsimpl. - now rewrite lcm_equiv1, <-lcm_equiv2. Qed. Lemma divide_lcm_l : forall a b, (a | lcm a b). Proof. unfold lcm. intros a b. apply divide_abs_r, divide_factor_l. Qed. Lemma divide_lcm_r : forall a b, (b | lcm a b). Proof. unfold lcm. intros a b. apply divide_abs_r. rewrite <- gcd_div_swap. apply divide_factor_r. Qed. Lemma divide_div : forall a b c, a~=0 -> (a|b) -> (b|c) -> (b/a|c/a). Proof. intros a b c Ha Hb (c',Hc). exists c'. now rewrite <- divide_div_mul_exact, <- Hc. Qed. Lemma lcm_least : forall a b c, (a | c) -> (b | c) -> (lcm a b | c). Proof. intros a b c Ha Hb. unfold lcm. apply divide_abs_l. destruct (eq_decidable (gcd a b) 0) as [EQ|NEQ]. - apply gcd_eq_0 in EQ. destruct EQ as (EQ,EQ'). rewrite EQ in *. now nzsimpl. - assert (Ga := gcd_divide_l a b). assert (Gb := gcd_divide_r a b). set (g:=gcd a b) in *. assert (Ha' := divide_div g a c NEQ Ga Ha). assert (Hb' := divide_div g b c NEQ Gb Hb). destruct Ha' as (a',Ha'). rewrite Ha', mul_comm in Hb'. apply gauss in Hb'; [|apply gcd_div_gcd; unfold g; trivial using gcd_comm]. destruct Hb' as (b',Hb'). exists b'. rewrite mul_shuffle3, <- Hb'. rewrite (proj2 (div_exact c g NEQ)). + rewrite Ha', mul_shuffle3, (mul_comm a a'). f_equiv. symmetry. apply div_exact; trivial. apply mod_divide; trivial. + apply mod_divide; trivial. transitivity a; trivial. Qed. Lemma lcm_nonneg : forall a b, 0 <= lcm a b. Proof. intros a b. unfold lcm. apply abs_nonneg. Qed. Lemma lcm_comm : forall a b, lcm a b == lcm b a. Proof. intros a b. unfold lcm. rewrite (gcd_comm b), (mul_comm b). now rewrite <- gcd_div_swap. Qed. Lemma lcm_divide_iff : forall n m p, (lcm n m | p) <-> (n | p) /\ (m | p). Proof. intros n m p. split;[split|]. - transitivity (lcm n m); trivial using divide_lcm_l. - transitivity (lcm n m); trivial using divide_lcm_r. - intros (H,H'). now apply lcm_least. Qed. Lemma lcm_unique : forall n m p, 0<=p -> (n|p) -> (m|p) -> (forall q, (n|q) -> (m|q) -> (p|q)) -> lcm n m == p. Proof. intros n m p Hp Hn Hm H. apply divide_antisym_nonneg; trivial. - apply lcm_nonneg. - now apply lcm_least. - apply H. + apply divide_lcm_l. + apply divide_lcm_r. Qed. Lemma lcm_unique_alt : forall n m p, 0<=p -> (forall q, (p|q) <-> (n|q) /\ (m|q)) -> lcm n m == p. Proof. intros n m p Hp H. apply lcm_unique; trivial. - apply H, divide_refl. - apply H, divide_refl. - intros. apply H. now split. Qed. Lemma lcm_assoc : forall n m p, lcm n (lcm m p) == lcm (lcm n m) p. Proof. intros. apply lcm_unique_alt; try apply lcm_nonneg. intros. now rewrite !lcm_divide_iff, and_assoc. Qed. Lemma lcm_0_l : forall n, lcm 0 n == 0. Proof. intros. apply lcm_unique; trivial. - order. - apply divide_refl. - apply divide_0_r. Qed. Lemma lcm_0_r : forall n, lcm n 0 == 0. Proof. intros. now rewrite lcm_comm, lcm_0_l. Qed. Lemma lcm_1_l_nonneg : forall n, 0<=n -> lcm 1 n == n. Proof. intros. apply lcm_unique; trivial using divide_1_l, le_0_1, divide_refl. Qed. Lemma lcm_1_r_nonneg : forall n, 0<=n -> lcm n 1 == n. Proof. intros. now rewrite lcm_comm, lcm_1_l_nonneg. Qed. Lemma lcm_diag_nonneg : forall n, 0<=n -> lcm n n == n. Proof. intros. apply lcm_unique; trivial using divide_refl. Qed. Lemma lcm_eq_0 : forall n m, lcm n m == 0 <-> n == 0 \/ m == 0. Proof. intros. split. - intros EQ. apply eq_mul_0. apply divide_0_l. rewrite <- EQ. apply lcm_least. + apply divide_factor_l. + apply divide_factor_r. - destruct 1 as [EQ|EQ]; rewrite EQ. + apply lcm_0_l. + apply lcm_0_r. Qed. Lemma divide_lcm_eq_r : forall n m, 0<=m -> (n|m) -> lcm n m == m. Proof. intros n m Hm H. apply lcm_unique_alt; trivial. intros q. split. - split; trivial. now transitivity m. - now destruct 1. Qed. Lemma divide_lcm_iff : forall n m, 0<=m -> ((n|m) <-> lcm n m == m). Proof. intros n m Hn. split. - now apply divide_lcm_eq_r. - intros EQ. rewrite <- EQ. apply divide_lcm_l. Qed. Lemma lcm_opp_l : forall n m, lcm (-n) m == lcm n m. Proof. intros. apply lcm_unique_alt; try apply lcm_nonneg. intros. rewrite divide_opp_l. apply lcm_divide_iff. Qed. Lemma lcm_opp_r : forall n m, lcm n (-m) == lcm n m. Proof. intros. now rewrite lcm_comm, lcm_opp_l, lcm_comm. Qed. Lemma lcm_abs_l : forall n m, lcm (abs n) m == lcm n m. Proof. intros n m. destruct (abs_eq_or_opp n) as [H|H]; rewrite H. - easy. - apply lcm_opp_l. Qed. Lemma lcm_abs_r : forall n m, lcm n (abs m) == lcm n m. Proof. intros. now rewrite lcm_comm, lcm_abs_l, lcm_comm. Qed. Lemma lcm_1_l : forall n, lcm 1 n == abs n. Proof. intros. rewrite <- lcm_abs_r. apply lcm_1_l_nonneg, abs_nonneg. Qed. Lemma lcm_1_r : forall n, lcm n 1 == abs n. Proof. intros. now rewrite lcm_comm, lcm_1_l. Qed. Lemma lcm_diag : forall n, lcm n n == abs n. Proof. intros. rewrite <- lcm_abs_l, <- lcm_abs_r. apply lcm_diag_nonneg, abs_nonneg. Qed. Lemma lcm_mul_mono_l : forall n m p, lcm (p * n) (p * m) == abs p * lcm n m. Proof. intros n m p. destruct (eq_decidable p 0) as [Hp|Hp];[|destruct (eq_decidable (gcd n m) 0) as [Hg|Hg]]. - rewrite Hp. nzsimpl. rewrite lcm_0_l, abs_0. now nzsimpl. - apply gcd_eq_0 in Hg. destruct Hg as (Hn,Hm); rewrite Hn, Hm. nzsimpl. rewrite lcm_0_l. now nzsimpl. - unfold lcm. rewrite gcd_mul_mono_l. rewrite !abs_mul, mul_assoc. f_equiv. rewrite <- (abs_sgn p) at 1. rewrite <- mul_assoc. rewrite div_mul_cancel_l; trivial. + rewrite divide_div_mul_exact; trivial. * rewrite abs_mul. rewrite <- (sgn_abs (sgn p)), sgn_sgn. { destruct (sgn_spec p) as [(_,EQ)|[(EQ,_)|(_,EQ)]]. - rewrite EQ. now nzsimpl. - order. - rewrite EQ. rewrite mul_opp_l, mul_opp_r, opp_involutive. now nzsimpl. } * apply gcd_divide_r. + contradict Hp. now apply abs_0_iff. Qed. Lemma lcm_mul_mono_l_nonneg : forall n m p, 0<=p -> lcm (p*n) (p*m) == p * lcm n m. Proof. intros n m p ?. rewrite <- (abs_eq p) at 3; trivial. apply lcm_mul_mono_l. Qed. Lemma lcm_mul_mono_r : forall n m p, lcm (n * p) (m * p) == lcm n m * abs p. Proof. intros n m p. now rewrite !(mul_comm _ p), lcm_mul_mono_l, mul_comm. Qed. Lemma lcm_mul_mono_r_nonneg : forall n m p, 0<=p -> lcm (n*p) (m*p) == lcm n m * p. Proof. intros n m p ?. rewrite <- (abs_eq p) at 3; trivial. apply lcm_mul_mono_r. Qed. Lemma gcd_1_lcm_mul : forall n m, n~=0 -> m~=0 -> (gcd n m == 1 <-> lcm n m == abs (n*m)). Proof. intros n m Hn Hm. split; intros H. - unfold lcm. rewrite H. now rewrite div_1_r. - unfold lcm in *. rewrite !abs_mul in H. apply mul_cancel_l in H; [|now rewrite abs_0_iff]. assert (H' := gcd_divide_r n m). assert (Hg : gcd n m ~= 0) by (red; rewrite gcd_eq_0; destruct 1; order). apply mod_divide in H'; trivial. apply div_exact in H'; trivial. assert (m / gcd n m ~=0) by (contradict Hm; rewrite H', Hm; now nzsimpl). rewrite <- (mul_1_l (abs (_/_))) in H. rewrite H' in H at 3. rewrite abs_mul in H. apply mul_cancel_r in H; [|now rewrite abs_0_iff]. rewrite abs_eq in H. { order. } apply gcd_nonneg. Qed. End ZLcmProp. coq-8.20.0/theories/Numbers/Integer/Abstract/ZLt.v000066400000000000000000000071551466560755400217120ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* n < 0 \/ n > 0. Proof. intro; apply lt_gt_cases. Qed. Theorem nonpos_pos_cases : forall n, n <= 0 \/ n > 0. Proof. intro; apply le_gt_cases. Qed. Theorem neg_nonneg_cases : forall n, n < 0 \/ n >= 0. Proof. intro; apply lt_ge_cases. Qed. Theorem nonpos_nonneg_cases : forall n, n <= 0 \/ n >= 0. Proof. intro; apply le_ge_cases. Qed. Ltac zinduct n := induction_maker n ltac:(apply order_induction_0). (** Theorems that are either not valid on N or have different proofs on N and Z *) Theorem lt_pred_l : forall n, P n < n. Proof. intro n; rewrite <- (succ_pred n) at 2; apply lt_succ_diag_r. Qed. Theorem le_pred_l : forall n, P n <= n. Proof. intro; apply lt_le_incl; apply lt_pred_l. Qed. Theorem lt_le_pred : forall n m, n < m <-> n <= P m. Proof. intros n m; rewrite <- (succ_pred m); rewrite pred_succ. apply lt_succ_r. Qed. Theorem nle_pred_r : forall n, ~ n <= P n. Proof. intro; rewrite <- lt_le_pred; apply lt_irrefl. Qed. Theorem lt_pred_le : forall n m, P n < m <-> n <= m. Proof. intros n m; rewrite <- (succ_pred n) at 2. symmetry; apply le_succ_l. Qed. Theorem lt_lt_pred : forall n m, n < m -> P n < m. Proof. intros; apply lt_pred_le; now apply lt_le_incl. Qed. Theorem le_le_pred : forall n m, n <= m -> P n <= m. Proof. intros; apply lt_le_incl; now apply lt_pred_le. Qed. Theorem lt_pred_lt : forall n m, n < P m -> n < m. Proof. intros n m H; apply lt_trans with (P m); [assumption | apply lt_pred_l]. Qed. Theorem le_pred_lt : forall n m, n <= P m -> n <= m. Proof. intros; apply lt_le_incl; now apply lt_le_pred. Qed. Theorem pred_lt_mono : forall n m, n < m <-> P n < P m. Proof. intros; rewrite lt_le_pred; symmetry; apply lt_pred_le. Qed. Theorem pred_le_mono : forall n m, n <= m <-> P n <= P m. Proof. intros; rewrite <- lt_pred_le; now rewrite lt_le_pred. Qed. Theorem lt_succ_lt_pred : forall n m, S n < m <-> n < P m. Proof. intros n m; now rewrite (pred_lt_mono (S n) m), pred_succ. Qed. Theorem le_succ_le_pred : forall n m, S n <= m <-> n <= P m. Proof. intros n m; now rewrite (pred_le_mono (S n) m), pred_succ. Qed. Theorem lt_pred_lt_succ : forall n m, P n < m <-> n < S m. Proof. intros; rewrite lt_pred_le; symmetry; apply lt_succ_r. Qed. Theorem le_pred_lt_succ : forall n m, P n <= m <-> n <= S m. Proof. intros n m; now rewrite (pred_le_mono n (S m)), pred_succ. Qed. Theorem neq_pred_l : forall n, P n ~= n. Proof. intro; apply lt_neq; apply lt_pred_l. Qed. Theorem lt_m1_r : forall n m, n < m -> m < 0 -> n < -1. Proof. intros n m H1 H2. apply lt_le_pred in H2. setoid_replace (P 0) with (-1) in H2. - now apply lt_le_trans with m. - apply eq_opp_r. now rewrite one_succ, opp_pred, opp_0. Qed. End ZOrderProp. coq-8.20.0/theories/Numbers/Integer/Abstract/ZMaxMin.v000066400000000000000000000135171466560755400225230ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* max (p * n) (p * m) == p * max n m. Proof. intros. destruct (le_ge_cases n m); [rewrite 2 max_r | rewrite 2 max_l]; try order; now apply mul_le_mono_nonneg_l. Qed. Lemma mul_max_distr_nonneg_r n m p : 0 <= p -> max (n * p) (m * p) == max n m * p. Proof. intros. destruct (le_ge_cases n m); [rewrite 2 max_r | rewrite 2 max_l]; try order; now apply mul_le_mono_nonneg_r. Qed. Lemma mul_min_distr_nonneg_l n m p : 0 <= p -> min (p * n) (p * m) == p * min n m. Proof. intros. destruct (le_ge_cases n m); [rewrite 2 min_l | rewrite 2 min_r]; try order; now apply mul_le_mono_nonneg_l. Qed. Lemma mul_min_distr_nonneg_r n m p : 0 <= p -> min (n * p) (m * p) == min n m * p. Proof. intros. destruct (le_ge_cases n m); [rewrite 2 min_l | rewrite 2 min_r]; try order; now apply mul_le_mono_nonneg_r. Qed. Lemma mul_max_distr_nonpos_l n m p : p <= 0 -> max (p * n) (p * m) == p * min n m. Proof. intros. destruct (le_ge_cases n m). - rewrite min_l by trivial. rewrite max_l by now apply mul_le_mono_nonpos_l. reflexivity. - rewrite min_r by trivial. rewrite max_r by now apply mul_le_mono_nonpos_l. reflexivity. Qed. Lemma mul_max_distr_nonpos_r n m p : p <= 0 -> max (n * p) (m * p) == min n m * p. Proof. intros. destruct (le_ge_cases n m). - rewrite min_l by trivial. rewrite max_l by now apply mul_le_mono_nonpos_r. reflexivity. - rewrite min_r by trivial. rewrite max_r by now apply mul_le_mono_nonpos_r. reflexivity. Qed. Lemma mul_min_distr_nonpos_l n m p : p <= 0 -> min (p * n) (p * m) == p * max n m. Proof. intros. destruct (le_ge_cases n m). - rewrite max_r by trivial. rewrite min_r by now apply mul_le_mono_nonpos_l. reflexivity. - rewrite max_l by trivial. rewrite min_l by now apply mul_le_mono_nonpos_l. reflexivity. Qed. Lemma mul_min_distr_nonpos_r n m p : p <= 0 -> min (n * p) (m * p) == max n m * p. Proof. intros. destruct (le_ge_cases n m). - rewrite max_r by trivial. rewrite min_r by now apply mul_le_mono_nonpos_r. reflexivity. - rewrite max_l by trivial. rewrite min_l by now apply mul_le_mono_nonpos_r. reflexivity. Qed. End ZMaxMinProp. coq-8.20.0/theories/Numbers/Integer/Abstract/ZMul.v000066400000000000000000000052401466560755400220610ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* n < m -> q <= 0 -> p < q -> m * q < n * p. Proof. intros n m p q H1 H2 H3 H4. apply le_lt_trans with (m * p). - apply mul_le_mono_nonpos_l; [assumption | now apply lt_le_incl]. - apply -> mul_lt_mono_neg_r; [assumption | now apply lt_le_trans with q]. Qed. Theorem mul_le_mono_nonpos : forall n m p q, m <= 0 -> n <= m -> q <= 0 -> p <= q -> m * q <= n * p. Proof. intros n m p q H1 H2 H3 H4. apply le_trans with (m * p). - now apply mul_le_mono_nonpos_l. - apply mul_le_mono_nonpos_r; [now apply le_trans with q | assumption]. Qed. Theorem mul_nonpos_nonpos : forall n m, n <= 0 -> m <= 0 -> 0 <= n * m. Proof. intros n m H1 H2. rewrite <- (mul_0_l m). now apply mul_le_mono_nonpos_r. Qed. Theorem mul_nonneg_nonpos : forall n m, 0 <= n -> m <= 0 -> n * m <= 0. Proof. intros n m H1 H2. rewrite <- (mul_0_l m). now apply mul_le_mono_nonpos_r. Qed. Theorem mul_nonpos_nonneg : forall n m, n <= 0 -> 0 <= m -> n * m <= 0. Proof. intros; rewrite mul_comm; now apply mul_nonneg_nonpos. Qed. Notation mul_pos := lt_0_mul (only parsing). Theorem lt_mul_0 : forall n m, n * m < 0 <-> n < 0 /\ m > 0 \/ n > 0 /\ m < 0. Proof. intros n m; split; [intro H | intros [[H1 H2] | [H1 H2]]]. - destruct (lt_trichotomy n 0) as [H1 | [H1 | H1]]; [| rewrite H1 in H; rewrite mul_0_l in H; false_hyp H lt_irrefl |]; (destruct (lt_trichotomy m 0) as [H2 | [H2 | H2]]; [| rewrite H2 in H; rewrite mul_0_r in H; false_hyp H lt_irrefl |]); try (left; now split); try (right; now split). + assert (H3 : n * m > 0) by now apply mul_neg_neg. exfalso; now apply (lt_asymm (n * m) 0). + assert (H3 : n * m > 0) by now apply mul_pos_pos. exfalso; now apply (lt_asymm (n * m) 0). - now apply mul_neg_pos. - now apply mul_pos_neg. Qed. Notation mul_neg := lt_mul_0 (only parsing). Theorem le_0_mul : forall n m, 0 <= n * m -> 0 <= n /\ 0 <= m \/ n <= 0 /\ m <= 0. Proof. assert (R : forall n, 0 == n <-> n == 0) by (intros; split; apply eq_sym). intros n m. repeat rewrite lt_eq_cases. repeat rewrite R. rewrite lt_0_mul, eq_mul_0. pose proof (lt_trichotomy n 0); pose proof (lt_trichotomy m 0). tauto. Qed. Notation mul_nonneg := le_0_mul (only parsing). Theorem le_mul_0 : forall n m, n * m <= 0 -> 0 <= n /\ m <= 0 \/ n <= 0 /\ 0 <= m. Proof. assert (R : forall n, 0 == n <-> n == 0) by (intros; split; apply eq_sym). intros n m. repeat rewrite lt_eq_cases. repeat rewrite R. rewrite lt_mul_0, eq_mul_0. pose proof (lt_trichotomy n 0); pose proof (lt_trichotomy m 0). tauto. Qed. Notation mul_nonpos := le_mul_0 (only parsing). Notation le_0_square := square_nonneg (only parsing). Theorem nlt_square_0 : forall n, ~ n * n < 0. Proof. intros n H. apply lt_nge in H. apply H. apply square_nonneg. Qed. Theorem square_lt_mono_nonpos : forall n m, n <= 0 -> m < n -> n * n < m * m. Proof. intros n m H1 H2. now apply mul_lt_mono_nonpos. Qed. Theorem square_le_mono_nonpos : forall n m, n <= 0 -> m <= n -> n * n <= m * m. Proof. intros n m H1 H2. now apply mul_le_mono_nonpos. Qed. Theorem square_lt_simpl_nonpos : forall n m, m <= 0 -> n * n < m * m -> m < n. Proof. intros n m H1 H2. destruct (le_gt_cases n 0); [|order]. destruct (lt_ge_cases m n) as [LE|GT]; trivial. apply square_le_mono_nonpos in GT; order. Qed. Theorem square_le_simpl_nonpos : forall n m, m <= 0 -> n * n <= m * m -> m <= n. Proof. intros n m H1 H2. destruct (le_gt_cases n 0); [|order]. destruct (le_gt_cases m n) as [LE|GT]; trivial. apply square_lt_mono_nonpos in GT; order. Qed. Theorem lt_1_mul_neg : forall n m, n < -1 -> m < 0 -> 1 < n * m. Proof. intros n m H1 H2. apply (mul_lt_mono_neg_r m) in H1. - apply opp_pos_neg in H2. rewrite mul_opp_l, mul_1_l in H1. now apply lt_1_l with (- m). - assumption. Qed. Theorem lt_mul_m1_neg : forall n m, 1 < n -> m < 0 -> n * m < -1. Proof. intros n m H1 H2. apply (mul_lt_mono_neg_r m) in H1. - rewrite mul_1_l in H1. now apply lt_m1_r with m. - assumption. Qed. Theorem lt_mul_m1_pos : forall n m, n < -1 -> 0 < m -> n * m < -1. Proof. intros n m H1 H2. apply (mul_lt_mono_pos_r m) in H1. - rewrite mul_opp_l, mul_1_l in H1. apply opp_neg_pos in H2. now apply lt_m1_r with (- m). - assumption. Qed. Theorem lt_1_mul_l : forall n m, 1 < n -> n * m < -1 \/ n * m == 0 \/ 1 < n * m. Proof. intros n m H; destruct (lt_trichotomy m 0) as [H1 | [H1 | H1]]. - left. now apply lt_mul_m1_neg. - right; left; now rewrite H1, mul_0_r. - right; right; now apply lt_1_mul_pos. Qed. Theorem lt_m1_mul_r : forall n m, n < -1 -> n * m < -1 \/ n * m == 0 \/ 1 < n * m. Proof. intros n m H; destruct (lt_trichotomy m 0) as [H1 | [H1 | H1]]. - right; right. now apply lt_1_mul_neg. - right; left; now rewrite H1, mul_0_r. - left. now apply lt_mul_m1_pos. Qed. Theorem eq_mul_1 : forall n m, n * m == 1 -> n == 1 \/ n == -1. Proof. assert (F := lt_m1_0). intro n; zero_pos_neg n. - (* n = 0 *) intros m. nzsimpl. now left. - (* 0 < n, proving P n /\ P (-n) *) intros n Hn. rewrite <- le_succ_l, <- one_succ in Hn. le_elim Hn; split; intros m H. + destruct (lt_1_mul_l n m) as [|[|]]; order'. + rewrite mul_opp_l, eq_opp_l in H. destruct (lt_1_mul_l n m) as [|[|]]; order'. + now left. + intros; right. now f_equiv. Qed. Theorem lt_mul_diag_l : forall n m, n < 0 -> (1 < m <-> n * m < n). Proof. intros n m H. stepr (n * m < n * 1) by now rewrite mul_1_r. now apply mul_lt_mono_neg_l. Qed. Theorem lt_mul_diag_r : forall n m, 0 < n -> (1 < m <-> n < n * m). Proof. intros n m H. stepr (n * 1 < n * m) by now rewrite mul_1_r. now apply mul_lt_mono_pos_l. Qed. Theorem le_mul_diag_l : forall n m, n < 0 -> (1 <= m <-> n * m <= n). Proof. intros n m H. stepr (n * m <= n * 1) by now rewrite mul_1_r. now apply mul_le_mono_neg_l. Qed. Theorem le_mul_diag_r : forall n m, 0 < n -> (1 <= m <-> n <= n * m). Proof. intros n m H. stepr (n * 1 <= n * m) by now rewrite mul_1_r. now apply mul_le_mono_pos_l. Qed. Theorem lt_mul_r : forall n m p, 0 < n -> 1 < p -> n < m -> n < m * p. Proof. intros n m p **. stepl (n * 1) by now rewrite mul_1_r. apply mul_lt_mono_nonneg. - now apply lt_le_incl. - assumption. - apply le_0_1. - assumption. Qed. (** Alternative name : *) Definition mul_eq_1 := eq_mul_1. End ZMulOrderProp. coq-8.20.0/theories/Numbers/Integer/Abstract/ZParity.v000066400000000000000000000034601466560755400225760ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* Even (-n)). { intros n (m,H). exists (-m). rewrite mul_opp_r. now f_equiv. } intros n. rewrite eq_iff_eq_true, !even_spec. split. - rewrite <- (opp_involutive n) at 2. apply H. - apply H. Qed. Lemma odd_opp : forall n, odd (-n) = odd n. Proof. intros. rewrite <- !negb_even. now rewrite even_opp. Qed. Lemma even_sub : forall n m, even (n-m) = Bool.eqb (even n) (even m). Proof. intros. now rewrite <- add_opp_r, even_add, even_opp. Qed. Lemma odd_sub : forall n m, odd (n-m) = xorb (odd n) (odd m). Proof. intros. now rewrite <- add_opp_r, odd_add, odd_opp. Qed. End ZParityProp. coq-8.20.0/theories/Numbers/Integer/Abstract/ZPow.v000066400000000000000000000104701466560755400220720ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* even (a^b) = even a. Proof. intros a b Hb. apply lt_ind with (4:=Hb). - solve_proper. - now nzsimpl. - clear b Hb. intros b Hb IH. nzsimpl; [|order]. rewrite even_mul, IH. now destruct (even a). Qed. Lemma odd_pow : forall a b, 0 odd (a^b) = odd a. Proof. intros. now rewrite <- !negb_even, even_pow. Qed. (** Properties of power of negative numbers *) Lemma pow_opp_even : forall a b, Even b -> (-a)^b == a^b. Proof. intros a b (c,H). rewrite H. destruct (le_gt_cases 0 c). - rewrite 2 pow_mul_r by order'. rewrite 2 pow_2_r. now rewrite mul_opp_opp. - assert (2*c < 0) by (apply mul_pos_neg; order'). now rewrite !pow_neg_r. Qed. Lemma pow_opp_odd : forall a b, Odd b -> (-a)^b == -(a^b). Proof. intros a b (c,H). rewrite H. destruct (le_gt_cases 0 c) as [LE|GT]. - assert (0 <= 2*c) by (apply mul_nonneg_nonneg; order'). rewrite add_1_r, !pow_succ_r; trivial. rewrite pow_opp_even by (now exists c). apply mul_opp_l. - apply double_above in GT. rewrite mul_0_r in GT. rewrite !pow_neg_r by trivial. now rewrite opp_0. Qed. Lemma pow_even_abs : forall a b, Even b -> a^b == (abs a)^b. Proof. intros a b ?. destruct (abs_eq_or_opp a) as [EQ|EQ]; rewrite EQ. - reflexivity. - symmetry. now apply pow_opp_even. Qed. Lemma pow_even_nonneg : forall a b, Even b -> 0 <= a^b. Proof. intros. rewrite pow_even_abs by trivial. apply pow_nonneg, abs_nonneg. Qed. Lemma pow_odd_abs_sgn : forall a b, Odd b -> a^b == sgn a * (abs a)^b. Proof. intros a b H. destruct (sgn_spec a) as [(LT,EQ)|[(EQ',EQ)|(LT,EQ)]]; rewrite EQ. - nzsimpl. rewrite abs_eq; order. - rewrite <- EQ'. nzsimpl. destruct (le_gt_cases 0 b). + apply pow_0_l. assert (b~=0) by (contradict H; now rewrite H, <-odd_spec, odd_0). order. + now rewrite pow_neg_r. - rewrite abs_neq by order. rewrite pow_opp_odd; trivial. now rewrite mul_opp_opp, mul_1_l. Qed. Lemma pow_odd_sgn : forall a b, 0<=b -> Odd b -> sgn (a^b) == sgn a. Proof. intros a b Hb H. destruct (sgn_spec a) as [(LT,EQ)|[(EQ',EQ)|(LT,EQ)]]; rewrite EQ. - apply sgn_pos. apply pow_pos_nonneg; trivial. - rewrite <- EQ'. rewrite pow_0_l. + apply sgn_0. + assert (b~=0) by (contradict H; now rewrite H, <-odd_spec, odd_0). order. - apply sgn_neg. rewrite <- (opp_involutive a). rewrite pow_opp_odd by trivial. apply opp_neg_pos. apply pow_pos_nonneg; trivial. now apply opp_pos_neg. Qed. Lemma abs_pow : forall a b, abs (a^b) == (abs a)^b. Proof. intros a b. destruct (Even_or_Odd b) as [H|H]. - rewrite pow_even_abs by trivial. apply abs_eq, pow_nonneg, abs_nonneg. - rewrite pow_odd_abs_sgn by trivial. rewrite abs_mul. destruct (lt_trichotomy 0 a) as [Ha|[Ha|Ha]]. + rewrite (sgn_pos a), (abs_eq 1), mul_1_l by order'. apply abs_eq, pow_nonneg, abs_nonneg. + rewrite <- Ha, sgn_0, abs_0, mul_0_l. symmetry. apply pow_0_l'. intro Hb. rewrite Hb in H. apply (Even_Odd_False 0); trivial. exists 0; now nzsimpl. + rewrite (sgn_neg a), abs_opp, (abs_eq 1), mul_1_l by order'. apply abs_eq, pow_nonneg, abs_nonneg. Qed. End ZPowProp. coq-8.20.0/theories/Numbers/Integer/Abstract/ZProperties.v000066400000000000000000000027511466560755400234640ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* abs n == n. Proof. intros. unfold abs. apply max_l. apply le_trans with 0; auto. rewrite opp_nonpos_nonneg; auto. Qed. Lemma abs_neq : forall n, n<=0 -> abs n == -n. Proof. intros. unfold abs. apply max_r. apply le_trans with 0; auto. rewrite opp_nonneg_nonpos; auto. Qed. End GenericAbs. (** We can deduce a [sgn] function from a [compare] function *) Module Type ZDecAxiomsSig := ZAxiomsMiniSig <+ HasCompare. Module Type ZDecAxiomsSig' := ZAxiomsMiniSig' <+ HasCompare. Module Type GenericSgn (Import Z : ZDecAxiomsSig') (Import ZP : ZMulOrderProp Z) <: HasSgn Z. Definition sgn n := match compare 0 n with Eq => 0 | Lt => 1 | Gt => -1 end. Lemma sgn_null n : n==0 -> sgn n == 0. Proof. unfold sgn; intros. destruct (compare_spec 0 n); order. Qed. Lemma sgn_pos n : 0 sgn n == 1. Proof. unfold sgn; intros. destruct (compare_spec 0 n); order. Qed. Lemma sgn_neg n : n<0 -> sgn n == -1. Proof. unfold sgn; intros. destruct (compare_spec 0 n); order. Qed. End GenericSgn. (** Derived properties of [abs] and [sgn] *) Module Type ZSgnAbsProp (Import Z : ZAxiomsSig') (Import ZP : ZMulOrderProp Z). Ltac destruct_max n := destruct (le_ge_cases 0 n); [rewrite (abs_eq n) by auto | rewrite (abs_neq n) by auto]. #[global] Instance abs_wd : Proper (eq==>eq) abs. Proof. intros x y EQ. destruct_max x. - rewrite abs_eq; trivial. now rewrite <- EQ. - rewrite abs_neq; try order. now rewrite opp_inj_wd. Qed. Lemma abs_max : forall n, abs n == max n (-n). Proof. intros n. destruct_max n. - rewrite max_l; auto with relations. apply le_trans with 0; auto. rewrite opp_nonpos_nonneg; auto. - rewrite max_r; auto with relations. apply le_trans with 0; auto. rewrite opp_nonneg_nonpos; auto. Qed. Lemma abs_neq' : forall n, 0<=-n -> abs n == -n. Proof. intros. apply abs_neq. now rewrite <- opp_nonneg_nonpos. Qed. Lemma abs_nonneg : forall n, 0 <= abs n. Proof. intros n. destruct_max n; auto. now rewrite opp_nonneg_nonpos. Qed. Lemma abs_eq_iff : forall n, abs n == n <-> 0<=n. Proof. split; try apply abs_eq. intros EQ. rewrite <- EQ. apply abs_nonneg. Qed. Lemma abs_neq_iff : forall n, abs n == -n <-> n<=0. Proof. split; try apply abs_neq. intros EQ. rewrite <- opp_nonneg_nonpos, <- EQ. apply abs_nonneg. Qed. Lemma abs_opp : forall n, abs (-n) == abs n. Proof. intros n. destruct_max n. - rewrite (abs_neq (-n)), opp_involutive. + reflexivity. + now rewrite opp_nonpos_nonneg. - rewrite (abs_eq (-n)). + reflexivity. + now rewrite opp_nonneg_nonpos. Qed. Lemma abs_0 : abs 0 == 0. Proof. apply abs_eq. apply le_refl. Qed. Lemma abs_0_iff : forall n, abs n == 0 <-> n==0. Proof. intros n; split. - destruct_max n; auto. now rewrite eq_opp_l, opp_0. - intros EQ; rewrite EQ. rewrite abs_eq; auto using eq_refl, le_refl. Qed. Lemma abs_pos : forall n, 0 < abs n <-> n~=0. Proof. intros n. rewrite <- abs_0_iff. split; [intros LT| intros NEQ]. - intro EQ. rewrite EQ in LT. now elim (lt_irrefl 0). - assert (LE : 0 <= abs n) by apply abs_nonneg. rewrite lt_eq_cases in LE; destruct LE; auto. elim NEQ; auto with relations. Qed. Lemma abs_eq_or_opp : forall n, abs n == n \/ abs n == -n. Proof. intros n. destruct_max n; auto with relations. Qed. Lemma abs_or_opp_abs : forall n, n == abs n \/ n == - abs n. Proof. intros n. destruct_max n; rewrite ? opp_involutive; auto with relations. Qed. Lemma abs_idemp : forall n, abs (abs n) == abs n. Proof. intros. apply abs_eq. apply abs_nonneg. Qed. #[deprecated(since="8.19", note="Use abs_idemp")] Notation abs_involutive := abs_idemp. Lemma abs_spec : forall n, (0 <= n /\ abs n == n) \/ (n < 0 /\ abs n == -n). Proof. intros n. destruct (le_gt_cases 0 n). - left; split; auto. now apply abs_eq. - right; split; auto. apply abs_neq. now apply lt_le_incl. Qed. Lemma abs_case_strong : forall (P:t->Prop) n, Proper (eq==>iff) P -> (0<=n -> P n) -> (n<=0 -> P (-n)) -> P (abs n). Proof. intros P n **. destruct_max n; auto. Qed. Lemma abs_case : forall (P:t->Prop) n, Proper (eq==>iff) P -> P n -> P (-n) -> P (abs n). Proof. intros. now apply abs_case_strong. Qed. Lemma abs_eq_cases : forall n m, abs n == abs m -> n == m \/ n == - m. Proof. intros n m EQ. destruct (abs_or_opp_abs n) as [EQn|EQn]. - rewrite EQn, EQ. apply abs_eq_or_opp. - rewrite EQn, EQ, opp_inj_wd, eq_opp_l, or_comm. apply abs_eq_or_opp. Qed. Lemma abs_lt : forall a b, abs a < b <-> -b < a < b. Proof. intros a b. destruct (abs_spec a) as [[LE EQ]|[LT EQ]]; rewrite EQ; clear EQ. - split; try split; try destruct 1; try order. apply lt_le_trans with 0; trivial. apply opp_neg_pos; order. - rewrite opp_lt_mono, opp_involutive. split; try split; try destruct 1; try order. apply lt_le_trans with 0; trivial. apply opp_nonpos_nonneg; order. Qed. Lemma abs_le : forall a b, abs a <= b <-> -b <= a <= b. Proof. intros a b. destruct (abs_spec a) as [[LE EQ]|[LT EQ]]; rewrite EQ; clear EQ. - split; try split; try destruct 1; try order. apply le_trans with 0; trivial. apply opp_nonpos_nonneg; order. - rewrite opp_le_mono, opp_involutive. split; try split; try destruct 1; try order. apply le_trans with 0. + order. + apply opp_nonpos_nonneg; order. Qed. (** Triangular inequality *) Lemma abs_triangle : forall n m, abs (n + m) <= abs n + abs m. Proof. intros n m. destruct_max n; destruct_max m. - rewrite abs_eq. { apply le_refl. } now apply add_nonneg_nonneg. - destruct_max (n+m); try rewrite opp_add_distr; apply add_le_mono_l || apply add_le_mono_r. + apply le_trans with 0; auto. now rewrite opp_nonneg_nonpos. + apply le_trans with 0; auto. now rewrite opp_nonpos_nonneg. - destruct_max (n+m); try rewrite opp_add_distr; apply add_le_mono_l || apply add_le_mono_r. + apply le_trans with 0; auto. now rewrite opp_nonneg_nonpos. + apply le_trans with 0; auto. now rewrite opp_nonpos_nonneg. - rewrite abs_neq, opp_add_distr. { apply le_refl. } now apply add_nonpos_nonpos. Qed. Lemma abs_sub_triangle : forall n m, abs n - abs m <= abs (n-m). Proof. intros n m. rewrite le_sub_le_add_l, add_comm. rewrite <- (sub_simpl_r n m) at 1. apply abs_triangle. Qed. (** Absolute value and multiplication *) Lemma abs_mul : forall n m, abs (n * m) == abs n * abs m. Proof. assert (H : forall n m, 0<=n -> abs (n*m) == n * abs m). { intros n m ?. destruct_max m. - rewrite abs_eq. { apply eq_refl. } now apply mul_nonneg_nonneg. - rewrite abs_neq, mul_opp_r. { reflexivity. } now apply mul_nonneg_nonpos . } intros n m. destruct_max n. - now apply H. - rewrite <- mul_opp_opp, H, abs_opp. { reflexivity. } now apply opp_nonneg_nonpos. Qed. Lemma abs_square : forall n, abs n * abs n == n * n. Proof. intros. rewrite <- abs_mul. apply abs_eq. apply le_0_square. Qed. (** Some results about the sign function. *) Ltac destruct_sgn n := let LT := fresh "LT" in let EQ := fresh "EQ" in let GT := fresh "GT" in destruct (lt_trichotomy 0 n) as [LT|[EQ|GT]]; [rewrite (sgn_pos n) by auto| rewrite (sgn_null n) by auto with relations| rewrite (sgn_neg n) by auto]. #[global] Instance sgn_wd : Proper (eq==>eq) sgn. Proof. intros x y Hxy. destruct_sgn x. - rewrite sgn_pos; auto with relations. rewrite <- Hxy; auto. - rewrite sgn_null; auto with relations. rewrite <- Hxy; auto with relations. - rewrite sgn_neg; auto with relations. rewrite <- Hxy; auto. Qed. Lemma sgn_spec : forall n, 0 < n /\ sgn n == 1 \/ 0 == n /\ sgn n == 0 \/ 0 > n /\ sgn n == -1. Proof. intros n. destruct_sgn n; [left|right;left|right;right]; auto with relations. Qed. Lemma sgn_0 : sgn 0 == 0. Proof. now apply sgn_null. Qed. Lemma sgn_pos_iff : forall n, sgn n == 1 <-> 0 n==0. Proof. intros n; split; try apply sgn_null. destruct_sgn n; auto with relations. - intros. elim (lt_neq 0 1); auto with relations. apply lt_0_1. - intros. elim (lt_neq (-1) 0); auto. rewrite opp_neg_pos. apply lt_0_1. Qed. Lemma sgn_neg_iff : forall n, sgn n == -1 <-> n<0. Proof. intros n; split; try apply sgn_neg. destruct_sgn n; auto with relations. - intros. elim (lt_neq (-1) 1); auto with relations. apply lt_trans with 0. + rewrite opp_neg_pos. apply lt_0_1. + apply lt_0_1. - intros. elim (lt_neq (-1) 0); auto with relations. rewrite opp_neg_pos. apply lt_0_1. Qed. Lemma sgn_opp : forall n, sgn (-n) == - sgn n. Proof. intros n. destruct_sgn n. - apply sgn_neg. now rewrite opp_neg_pos. - setoid_replace n with 0 by auto with relations. rewrite opp_0. apply sgn_0. - rewrite opp_involutive. apply sgn_pos. now rewrite opp_pos_neg. Qed. Lemma sgn_nonneg : forall n, 0 <= sgn n <-> 0 <= n. Proof. intros n; split. - destruct_sgn n; intros. + now apply lt_le_incl. + order. + elim (lt_irrefl 0). apply lt_le_trans with 1; auto using lt_0_1. now rewrite <- opp_nonneg_nonpos. - rewrite lt_eq_cases; destruct 1. + rewrite sgn_pos by auto. apply lt_le_incl, lt_0_1. + rewrite sgn_null by auto with relations. apply le_refl. Qed. Lemma sgn_nonpos : forall n, sgn n <= 0 <-> n <= 0. Proof. intros. rewrite <- 2 opp_nonneg_nonpos, <- sgn_opp. apply sgn_nonneg. Qed. Lemma sgn_mul : forall n m, sgn (n*m) == sgn n * sgn m. Proof. intros n m. destruct_sgn n; nzsimpl. - destruct_sgn m. + apply sgn_pos. now apply mul_pos_pos. + apply sgn_null. rewrite eq_mul_0; auto with relations. + apply sgn_neg. now apply mul_pos_neg. - apply sgn_null. rewrite eq_mul_0; auto with relations. - destruct_sgn m; try rewrite mul_opp_opp; nzsimpl. + apply sgn_neg. now apply mul_neg_pos. + apply sgn_null. rewrite eq_mul_0; auto with relations. + apply sgn_pos. now apply mul_neg_neg. Qed. Lemma sgn_abs : forall n, n * sgn n == abs n. Proof. intros n. symmetry. destruct_sgn n; try rewrite mul_opp_r; nzsimpl. - apply abs_eq. now apply lt_le_incl. - rewrite abs_0_iff; auto with relations. - apply abs_neq. now apply lt_le_incl. Qed. Lemma abs_sgn : forall n, abs n * sgn n == n. Proof. intros n. destruct_sgn n; try rewrite mul_opp_r; nzsimpl; auto. - apply abs_eq. now apply lt_le_incl. - rewrite eq_opp_l. apply abs_neq. now apply lt_le_incl. Qed. Lemma sgn_sgn : forall x, sgn (sgn x) == sgn x. Proof. intros x. destruct (sgn_spec x) as [(LT,EQ)|[(EQ',EQ)|(LT,EQ)]]; rewrite EQ. - apply sgn_pos, lt_0_1. - now apply sgn_null. - apply sgn_neg. rewrite opp_neg_pos. apply lt_0_1. Qed. End ZSgnAbsProp. coq-8.20.0/theories/Numbers/Integer/Binary/000077500000000000000000000000001466560755400204635ustar00rootroot00000000000000coq-8.20.0/theories/Numbers/Integer/Binary/ZBinary.v000066400000000000000000000033411466560755400222310ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* y<=x -> x=y]. *) Section TestOrder. Let test : forall x y, x<=y -> y<=x -> x=y. Proof. z_order. Defined. End TestOrder. (** Z forms a ring *) (*Lemma Zring : ring_theory 0 1 NZadd NZmul NZsub Z.opp NZeq. Proof. constructor. exact Zadd_0_l. exact Zadd_comm. exact Zadd_assoc. exact Zmul_1_l. exact Zmul_comm. exact Zmul_assoc. exact Zmul_add_distr_r. intros; now rewrite Zadd_opp_minus. exact Zadd_opp_r. Qed. Add Ring ZR : Zring.*) coq-8.20.0/theories/Numbers/Integer/NatPairs/000077500000000000000000000000001466560755400207605ustar00rootroot00000000000000coq-8.20.0/theories/Numbers/Integer/NatPairs/ZNatPairs.v000066400000000000000000000250101466560755400230200ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* ... -> A -> B] with [n] occurrences of [A] in this type. *) #[deprecated(since="8.19", note="Please step up to maintain NaryFunctions.v if you need it.")] Fixpoint nfun A n B := match n with | O => B | S n => A -> (nfun A n B) end. #[deprecated(since="8.19", note="Please step up to maintain NaryFunctions.v if you need it.")] Notation " A ^^ n --> B " := (nfun A n B) (at level 50, n at next level) : type_scope. (** [napply_cst _ _ a n f] iterates [n] times the application of a particular constant [a] to the [n]-ary function [f]. *) #[deprecated(since="8.19", note="Please step up to maintain NaryFunctions.v if you need it.")] Fixpoint napply_cst (A B:Type)(a:A) n : (A^^n-->B) -> B := match n return (A^^n-->B) -> B with | O => fun x => x | S n => fun x => napply_cst _ _ a n (x a) end. (** A generic transformation from an n-ary function to another one.*) #[deprecated(since="8.19", note="Please step up to maintain NaryFunctions.v if you need it.")] Fixpoint nfun_to_nfun (A B C:Type)(f:B -> C) n : (A^^n-->B) -> (A^^n-->C) := match n return (A^^n-->B) -> (A^^n-->C) with | O => f | S n => fun g a => nfun_to_nfun _ _ _ f n (g a) end. (** [napply_except_last _ _ n f] expects [S n] arguments of type [A], applies [n] of them to [f] and discards the last one. *) #[deprecated(since="8.19", note="Please step up to maintain NaryFunctions.v if you need it.")] Fixpoint napply_except_last (A B:Type) (n : nat) (f : A^^n-->B) {struct n} : A^^S n-->B. Proof. destruct n. - exact (fun _ => f). - exact (fun arg => napply_except_last A B n (f arg)). Defined. (** [napply_then_last _ _ a n f] expects [n] arguments of type [A], applies them to [f] and then apply [a] to the result. *) #[deprecated(since="8.19", note="Please step up to maintain NaryFunctions.v if you need it.")] Definition napply_then_last (A B:Type)(a:A) := nfun_to_nfun A (A->B) B (fun fab => fab a). (** [napply_discard _ b n] expects [n] arguments, discards then, and returns [b]. *) #[deprecated(since="8.19", note="Please step up to maintain NaryFunctions.v if you need it.")] Fixpoint napply_discard (A B:Type)(b:B) n : A^^n-->B := match n return A^^n-->B with | O => b | S n => fun _ => napply_discard _ _ b n end. (** A fold function *) #[deprecated(since="8.19", note="Please step up to maintain NaryFunctions.v if you need it.")] Fixpoint nfold A B (f:A->B->B)(b:B) n : (A^^n-->B) := match n return (A^^n-->B) with | O => b | S n => fun a => (nfold _ _ f (f a b) n) end. (** [n]-ary products : [nprod A n] is [A*...*A*unit], with [n] occurrences of [A] in this type. *) #[deprecated(since="8.19", note="Please step up to maintain NaryFunctions.v if you need it.")] Fixpoint nprod A n : Type := match n with | O => unit | S n => (A * nprod A n)%type end. #[deprecated(since="8.19", note="Please step up to maintain NaryFunctions.v if you need it.")] Notation "A ^ n" := (nprod A n) : type_scope. (** [n]-ary curryfication / uncurryfication *) #[deprecated(since="8.19", note="Please step up to maintain NaryFunctions.v if you need it.")] Fixpoint ncurry (A B:Type) n : (A^n -> B) -> (A^^n-->B) := match n return (A^n -> B) -> (A^^n-->B) with | O => fun x => x tt | S n => fun f a => ncurry _ _ n (fun p => f (a,p)) end. #[deprecated(since="8.19", note="Please step up to maintain NaryFunctions.v if you need it.")] Fixpoint nuncurry (A B:Type) n : (A^^n-->B) -> (A^n -> B) := match n return (A^^n-->B) -> (A^n -> B) with | O => fun x _ => x | S n => fun f p => let (x,p) := p in nuncurry _ _ n (f x) p end. (** Earlier functions can also be defined via [ncurry/nuncurry]. For instance : *) #[deprecated(since="8.19", note="Please step up to maintain NaryFunctions.v if you need it.")] Definition nfun_to_nfun_bis A B C (f:B->C) n : (A^^n-->B) -> (A^^n-->C) := fun anb => ncurry _ _ n (fun an => f ((nuncurry _ _ n anb) an)). (** We can also us it to obtain another [fold] function, equivalent to the previous one, but with a nicer expansion (see for instance Int31.iszero). *) #[deprecated(since="8.19", note="Please step up to maintain NaryFunctions.v if you need it.")] Fixpoint nfold_bis A B (f:A->B->B)(b:B) n : (A^^n-->B) := match n return (A^^n-->B) with | O => b | S n => fun a => nfun_to_nfun_bis _ _ _ (f a) n (nfold_bis _ _ f b n) end. (** From [nprod] to [list] *) #[deprecated(since="8.19", note="Please step up to maintain NaryFunctions.v if you need it.")] Fixpoint nprod_to_list (A:Type) n : A^n -> list A := match n with | O => fun _ => nil | S n => fun p => let (x,p) := p in x::(nprod_to_list _ n p) end. (** From [list] to [nprod] *) #[deprecated(since="8.19", note="Please step up to maintain NaryFunctions.v if you need it.")] Fixpoint nprod_of_list (A:Type)(l:list A) : A^(length l) := match l return A^(length l) with | nil => tt | x::l => (x, nprod_of_list _ l) end. (** This gives an additional way to write the fold *) #[deprecated(since="8.19", note="Please step up to maintain NaryFunctions.v if you need it.")] Definition nfold_list (A B:Type)(f:A->B->B)(b:B) n : (A^^n-->B) := ncurry _ _ n (fun p => fold_right f b (nprod_to_list _ _ p)). coq-8.20.0/theories/Numbers/NatInt/000077500000000000000000000000001466560755400170375ustar00rootroot00000000000000coq-8.20.0/theories/Numbers/NatInt/NZAdd.v000066400000000000000000000071771466560755400202020ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* n == m. Proof. intros n m p; nzinduct p. - now nzsimpl. - intro p. nzsimpl. now rewrite succ_inj_wd. Qed. Theorem add_cancel_r : forall n m p, n + p == m + p <-> n == m. Proof. intros n m p. rewrite (add_comm n p), (add_comm m p). apply add_cancel_l. Qed. Theorem add_shuffle0 : forall n m p, n+m+p == n+p+m. Proof. intros n m p. rewrite <- 2 add_assoc, add_cancel_l. apply add_comm. Qed. Theorem add_shuffle1 : forall n m p q, (n + m) + (p + q) == (n + p) + (m + q). Proof. intros n m p q. rewrite 2 add_assoc, add_cancel_r. apply add_shuffle0. Qed. Theorem add_shuffle2 : forall n m p q, (n + m) + (p + q) == (n + q) + (m + p). Proof. intros n m p q. rewrite (add_comm p). apply add_shuffle1. Qed. Theorem add_shuffle3 : forall n m p, n + (m + p) == m + (n + p). Proof. intros n m p. now rewrite add_comm, <- add_assoc, (add_comm p). Qed. Theorem sub_1_r : forall n, n - 1 == P n. Proof. intro n; now nzsimpl'. Qed. Global Hint Rewrite sub_1_r : nz. End NZAddProp. coq-8.20.0/theories/Numbers/NatInt/NZAddOrder.v000066400000000000000000000132231466560755400211630ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* p + n < p + m. Proof. intros n m p; nzinduct p. - now nzsimpl. - intro p. nzsimpl. now rewrite <- succ_lt_mono. Qed. Theorem add_lt_mono_r : forall n m p, n < m <-> n + p < m + p. Proof. intros n m p. rewrite (add_comm n p), (add_comm m p); apply add_lt_mono_l. Qed. Theorem add_lt_mono : forall n m p q, n < m -> p < q -> n + p < m + q. Proof. intros n m p q H1 H2. apply lt_trans with (m + p); [now apply add_lt_mono_r | now apply add_lt_mono_l]. Qed. Theorem add_le_mono_l : forall n m p, n <= m <-> p + n <= p + m. Proof. intros n m p; nzinduct p. - now nzsimpl. - intro p. nzsimpl. now rewrite <- succ_le_mono. Qed. Theorem add_le_mono_r : forall n m p, n <= m <-> n + p <= m + p. Proof. intros n m p. rewrite (add_comm n p), (add_comm m p); apply add_le_mono_l. Qed. Theorem add_le_mono : forall n m p q, n <= m -> p <= q -> n + p <= m + q. Proof. intros n m p q H1 H2. apply le_trans with (m + p); [now apply add_le_mono_r | now apply add_le_mono_l]. Qed. Theorem add_lt_le_mono : forall n m p q, n < m -> p <= q -> n + p < m + q. Proof. intros n m p q H1 H2. apply lt_le_trans with (m + p); [now apply add_lt_mono_r | now apply add_le_mono_l]. Qed. Theorem add_le_lt_mono : forall n m p q, n <= m -> p < q -> n + p < m + q. Proof. intros n m p q H1 H2. apply le_lt_trans with (m + p); [now apply add_le_mono_r | now apply add_lt_mono_l]. Qed. Theorem add_pos_pos : forall n m, 0 < n -> 0 < m -> 0 < n + m. Proof. intros n m H1 H2. rewrite <- (add_0_l 0). now apply add_lt_mono. Qed. Theorem add_pos_nonneg : forall n m, 0 < n -> 0 <= m -> 0 < n + m. Proof. intros n m H1 H2. rewrite <- (add_0_l 0). now apply add_lt_le_mono. Qed. Theorem add_nonneg_pos : forall n m, 0 <= n -> 0 < m -> 0 < n + m. Proof. intros n m H1 H2. rewrite <- (add_0_l 0). now apply add_le_lt_mono. Qed. Theorem add_nonneg_nonneg : forall n m, 0 <= n -> 0 <= m -> 0 <= n + m. Proof. intros n m H1 H2. rewrite <- (add_0_l 0). now apply add_le_mono. Qed. Theorem lt_add_pos_l : forall n m, 0 < n -> m < n + m. Proof. intros n m. rewrite (add_lt_mono_r 0 n m). now nzsimpl. Qed. Theorem lt_add_pos_r : forall n m, 0 < n -> m < m + n. Proof. intros; rewrite add_comm; now apply lt_add_pos_l. Qed. Theorem le_lt_add_lt : forall n m p q, n <= m -> p + m < q + n -> p < q. Proof. intros n m p q H1 H2. destruct (le_gt_cases q p); [| assumption]. contradict H2. rewrite nlt_ge. now apply add_le_mono. Qed. Theorem lt_le_add_lt : forall n m p q, n < m -> p + m <= q + n -> p < q. Proof. intros n m p q H1 H2. destruct (le_gt_cases q p); [| assumption]. contradict H2. rewrite nle_gt. now apply add_le_lt_mono. Qed. Theorem le_le_add_le : forall n m p q, n <= m -> p + m <= q + n -> p <= q. Proof. intros n m p q H1 H2. destruct (le_gt_cases p q); [assumption |]. contradict H2. rewrite nle_gt. now apply add_lt_le_mono. Qed. Theorem add_lt_cases : forall n m p q, n + m < p + q -> n < p \/ m < q. Proof. intros n m p q H; destruct (le_gt_cases p n) as [H1 | H1]; [| now left]. destruct (le_gt_cases q m) as [H2 | H2]; [| now right]. contradict H; rewrite nlt_ge. now apply add_le_mono. Qed. Theorem add_le_cases : forall n m p q, n + m <= p + q -> n <= p \/ m <= q. Proof. intros n m p q H. destruct (le_gt_cases n p) as [H1 | H1]. - now left. - destruct (le_gt_cases m q) as [H2 | H2]. + now right. + contradict H; rewrite nle_gt. now apply add_lt_mono. Qed. Theorem add_neg_cases : forall n m, n + m < 0 -> n < 0 \/ m < 0. Proof. intros n m H; apply add_lt_cases; now nzsimpl. Qed. Theorem add_pos_cases : forall n m, 0 < n + m -> 0 < n \/ 0 < m. Proof. intros n m H; apply add_lt_cases; now nzsimpl. Qed. Theorem add_nonpos_cases : forall n m, n + m <= 0 -> n <= 0 \/ m <= 0. Proof. intros n m H; apply add_le_cases; now nzsimpl. Qed. Theorem add_nonneg_cases : forall n m, 0 <= n + m -> 0 <= n \/ 0 <= m. Proof. intros n m H; apply add_le_cases; now nzsimpl. Qed. (** Subtraction *) (** We can prove the existence of a subtraction of any number by a smaller one *) Lemma le_exists_sub : forall n m, n<=m -> exists p, m == p+n /\ 0<=p. Proof. intros n m H. apply le_ind with (4:=H). - solve_proper. - exists 0; nzsimpl; split; order. - clear m H. intros m H (p & EQ & LE). exists (S p). split. + nzsimpl. now f_equiv. + now apply le_le_succ_r. Qed. (** For the moment, it doesn't seem possible to relate this existing subtraction with [sub]. *) End NZAddOrderProp. coq-8.20.0/theories/Numbers/NatInt/NZAxioms.v000066400000000000000000000224321466560755400207410ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* t -> Prop. Parameter eq_equiv : Equivalence eq. Parameter zero : t. Parameter succ : t -> t. Parameter pred : t -> t. Parameter succ_wd : Proper (eq ==> eq) succ. Parameter pred_wd : Proper (eq ==> eq) pred. Parameter pred_succ : forall n : t, eq (pred (succ n)) n. Parameter bi_induction : forall A : t -> Prop, Proper (eq ==> iff) A -> A zero -> (forall n : t, A n <-> A (succ n)) -> forall n : t, A n. Parameter one : t. Parameter two : t. Parameter one_succ : eq one (succ zero). Parameter two_succ : eq two (succ one). Parameter lt : t -> t -> Prop. Parameter le : t -> t -> Prop. Parameter lt_wd : Proper (eq ==> eq ==> iff) lt. Parameter lt_eq_cases : forall n m : t, le n m <-> lt n m \/ eq n m. Parameter lt_irrefl : forall n : t, ~ lt n n. Parameter lt_succ_r : forall n m : t, lt n (succ m) <-> le n m. Parameter add : t -> t -> t. Parameter sub : t -> t -> t. Parameter mul : t -> t -> t. Parameter add_wd : Proper (eq ==> eq ==> eq) add. Parameter sub_wd : Proper (eq ==> eq ==> eq) sub. Parameter mul_wd : Proper (eq ==> eq ==> eq) mul. Parameter add_0_l : forall n : t, eq (add zero n) n. Parameter add_succ_l : forall n m : t, eq (add (succ n) m) (succ (add n m)). Parameter sub_0_r : forall n : t, eq (sub n zero) n. Parameter sub_succ_r : forall n m : t, eq (sub n (succ m)) (pred (sub n m)). Parameter mul_0_l : forall n : t, eq (mul zero n) zero. Parameter mul_succ_l : forall n m : t, eq (mul (succ n) m) (add (mul n m) m). Parameter max : t -> t -> t. Parameter max_l : forall x y : t, le y x -> eq (max x y) x. Parameter max_r : forall x y : t, le x y -> eq (max x y) y. Parameter min : t -> t -> t. Parameter min_l : forall x y : t, le x y -> eq (min x y) x. Parameter min_r : forall x y : t, le y x -> eq (min x y) y. Parameter compare : t -> t -> comparison. Parameter compare_spec : forall x y : t, CompareSpec (eq x y) (lt x y) (lt y x) (compare x y). End ]] *) (** ** Axiomatization of a domain with [zero], [succ], [pred] and a bi-directional induction principle. *) (* NB: This was Pierre Letouzey's conclusion in the (now deprecated) NZDomain file. *) (** We require [P (S n) = n] but not the other way around, since this domain is meant to be either N or Z. In fact it can be a few other things, S is always injective, P is always surjective (thanks to [pred_succ]). I) If S is not surjective, we have an initial point, which is unique. This bottom is below zero: we have N shifted (or not) to the left. P cannot be injective: P init = P (S (P init)). (P init) can be arbitrary. II) If S is surjective, we have [forall n, S (P n) = n], S and P are bijective and reciprocal. IIa) if [exists k<>O, 0 == S^k 0], then we have a cyclic structure Z/nZ IIb) otherwise, we have Z *) (** The [Typ] module type in [Equalities] only has a parameter [t : Type]. *) Module Type ZeroSuccPred (Import T:Typ). Parameter Inline(20) zero : t. Parameter Inline(50) succ : t -> t. Parameter Inline pred : t -> t. End ZeroSuccPred. Module Type ZeroSuccPredNotation (T:Typ)(Import NZ:ZeroSuccPred T). Notation "0" := zero. Notation S := succ. Notation P := pred. End ZeroSuccPredNotation. Module Type ZeroSuccPred' (T:Typ) := ZeroSuccPred T <+ ZeroSuccPredNotation T. (** The [Eq'] module type in [Equalities] is a [Type] [t] with a binary predicate [eq] denoted [==]. The negation of [==] is denoted [~=]. *) Module Type IsNZDomain (Import E:Eq')(Import NZ:ZeroSuccPred' E). #[global] Declare Instance succ_wd : Proper (eq ==> eq) S. #[global] Declare Instance pred_wd : Proper (eq ==> eq) P. Axiom pred_succ : forall n, P (S n) == n. Axiom bi_induction : forall A : t -> Prop, Proper (eq==>iff) A -> A 0 -> (forall n, A n <-> A (S n)) -> forall n, A n. End IsNZDomain. (** ** Axiomatization of some more constants *) (** Simply denoting "1" for (S 0) and so on works ok when implementing by [nat], but leaves some ([N.succ N0]) when implementing by [N]. *) Module Type OneTwo (Import T:Typ). Parameter Inline(20) one two : t. End OneTwo. Module Type OneTwoNotation (T:Typ)(Import NZ:OneTwo T). Notation "1" := one. Notation "2" := two. End OneTwoNotation. Module Type OneTwo' (T:Typ) := OneTwo T <+ OneTwoNotation T. Module Type IsOneTwo (E:Eq')(Z:ZeroSuccPred' E)(O:OneTwo' E). Import E Z O. Axiom one_succ : 1 == S 0. Axiom two_succ : 2 == S 1. End IsOneTwo. Module Type NZDomainSig := EqualityType <+ ZeroSuccPred <+ IsNZDomain <+ OneTwo <+ IsOneTwo. Module Type NZDomainSig' := EqualityType' <+ ZeroSuccPred' <+ IsNZDomain <+ OneTwo' <+ IsOneTwo. (** At this point, a module implementing [NZDomainSig] has : - two unary operators [pred] and [succ] such that [forall n, pred (succ n) = n]. - a bidirectional induction principle - three constants [0], [1 = S 0], [2 = S 1] *) (** ** Axiomatization of basic operations : [+] [-] [*] *) Module Type AddSubMul (Import T:Typ). Parameters Inline add sub mul : t -> t -> t. End AddSubMul. Module Type AddSubMulNotation (T:Typ)(Import NZ:AddSubMul T). Notation "x + y" := (add x y). Notation "x - y" := (sub x y). Notation "x * y" := (mul x y). End AddSubMulNotation. Module Type AddSubMul' (T:Typ) := AddSubMul T <+ AddSubMulNotation T. Module Type IsAddSubMul (Import E:NZDomainSig')(Import NZ:AddSubMul' E). #[global] Declare Instance add_wd : Proper (eq ==> eq ==> eq) add. #[global] Declare Instance sub_wd : Proper (eq ==> eq ==> eq) sub. #[global] Declare Instance mul_wd : Proper (eq ==> eq ==> eq) mul. Axiom add_0_l : forall n, 0 + n == n. Axiom add_succ_l : forall n m, (S n) + m == S (n + m). Axiom sub_0_r : forall n, n - 0 == n. Axiom sub_succ_r : forall n m, n - (S m) == P (n - m). Axiom mul_0_l : forall n, 0 * n == 0. Axiom mul_succ_l : forall n m, S n * m == n * m + m. End IsAddSubMul. Module Type NZBasicFunsSig := NZDomainSig <+ AddSubMul <+ IsAddSubMul. Module Type NZBasicFunsSig' := NZDomainSig' <+ AddSubMul' <+IsAddSubMul. (** Old name for the same interface: *) Module Type NZAxiomsSig := NZBasicFunsSig. Module Type NZAxiomsSig' := NZBasicFunsSig'. (** ** Axiomatization of order *) (** The module type [HasLt] (resp. [HasLe]) is just a type equipped with a relation [lt] (resp. [le]) in [Prop]. *) Module Type NZOrd := NZDomainSig <+ HasLt <+ HasLe. Module Type NZOrd' := NZDomainSig' <+ HasLt <+ HasLe <+ LtNotation <+ LeNotation <+ LtLeNotation. Module Type IsNZOrd (Import NZ : NZOrd'). #[global] Declare Instance lt_wd : Proper (eq ==> eq ==> iff) lt. Axiom lt_eq_cases : forall n m, n <= m <-> n < m \/ n == m. Axiom lt_irrefl : forall n, ~ (n < n). Axiom lt_succ_r : forall n m, n < S m <-> n <= m. End IsNZOrd. (** NB: the compatibility of [le] can be proved later from [lt_wd] and [lt_eq_cases] *) Module Type NZOrdSig := NZOrd <+ IsNZOrd. Module Type NZOrdSig' := NZOrd' <+ IsNZOrd. (** Everything together : *) (** The [HasMinMax] module type is a type with [min] and [max] operators consistent with [le]. *) Module Type NZOrdAxiomsSig <: NZBasicFunsSig <: NZOrdSig := NZOrdSig <+ AddSubMul <+ IsAddSubMul <+ HasMinMax. Module Type NZOrdAxiomsSig' <: NZOrdAxiomsSig := NZOrdSig' <+ AddSubMul' <+ IsAddSubMul <+ HasMinMax. (** Same, plus a comparison function. *) (** The [HasCompare] module type requires a comparison function in type [comparison] consistent with [eq] and [lt]. In particular, this imposes that the order is decidable. *) Module Type NZDecOrdSig := NZOrdSig <+ HasCompare. Module Type NZDecOrdSig' := NZOrdSig' <+ HasCompare. Module Type NZDecOrdAxiomsSig := NZOrdAxiomsSig <+ HasCompare. Module Type NZDecOrdAxiomsSig' := NZOrdAxiomsSig' <+ HasCompare. (** A square function *) (* TODO: why is this here? *) Module Type NZSquare (Import NZ : NZBasicFunsSig'). Parameter Inline square : t -> t. Axiom square_spec : forall n, square n == n * n. End NZSquare. coq-8.20.0/theories/Numbers/NatInt/NZBase.v000066400000000000000000000063721466560755400203600ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* y==x. Proof. intros; split; symmetry; auto. Qed. (* TODO: how register ~= (which is just a notation) as a Symmetric relation, hence allowing "symmetry" tac ? *) Theorem neq_sym : forall n m, n ~= m -> m ~= n. Proof. intros n m H1 H2; symmetry in H2; false_hyp H2 H1. Qed. (** We add entries in the [stepl] and [stepr] databases. *) Theorem eq_stepl : forall x y z, x == y -> x == z -> z == y. Proof. intros x y z H1 H2; now rewrite <- H1. Qed. Declare Left Step eq_stepl. (* The right step lemma is just the transitivity of eq *) Declare Right Step (@Equivalence_Transitive _ _ eq_equiv). Theorem succ_inj : forall n1 n2, S n1 == S n2 -> n1 == n2. Proof. intros n1 n2 H. apply pred_wd in H. now do 2 rewrite pred_succ in H. Qed. (* The following theorem is useful as an equivalence for proving bidirectional induction steps *) Theorem succ_inj_wd : forall n1 n2, S n1 == S n2 <-> n1 == n2. Proof. intros; split. - apply succ_inj. - intros. now f_equiv. Qed. Theorem succ_inj_wd_neg : forall n m, S n ~= S m <-> n ~= m. Proof. intros; now rewrite succ_inj_wd. Qed. (* We cannot prove that the predecessor is injective, nor that it is left-inverse to the successor at this point *) Section CentralInduction. Variable A : t -> Prop. Hypothesis A_wd : Proper (eq==>iff) A. Theorem central_induction : forall z, A z -> (forall n, A n <-> A (S n)) -> forall n, A n. Proof. intros z Base Step; revert Base; pattern z; apply bi_induction. - solve_proper. - intro; now apply bi_induction. - intro n; pose proof (Step n); tauto. Qed. End CentralInduction. Tactic Notation "nzinduct" ident(n) := induction_maker n ltac:(apply bi_induction). Tactic Notation "nzinduct" ident(n) constr(u) := induction_maker n ltac:(apply (fun A A_wd => central_induction A A_wd u)). End NZBaseProp. coq-8.20.0/theories/Numbers/NatInt/NZBits.v000066400000000000000000000057541466560755400204120ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* t -> bool. Parameters Inline shiftl shiftr land lor ldiff lxor : t -> t -> t. Parameter Inline div2 : t -> t. End Bits. Module Type BitsNotation (Import A : Typ)(Import B : Bits A). Notation "a .[ n ]" := (testbit a n) (at level 5, format "a .[ n ]"). Infix ">>" := shiftr (at level 30, no associativity). Infix "<<" := shiftl (at level 30, no associativity). End BitsNotation. Module Type Bits' (A:Typ) := Bits A <+ BitsNotation A. Module Type NZBitsSpec (Import A : NZOrdAxiomsSig')(Import B : Bits' A). #[global] Declare Instance testbit_wd : Proper (eq==>eq==>Logic.eq) testbit. Axiom testbit_odd_0 : forall a, (2*a+1).[0] = true. Axiom testbit_even_0 : forall a, (2*a).[0] = false. Axiom testbit_odd_succ : forall a n, 0<=n -> (2*a+1).[S n] = a.[n]. Axiom testbit_even_succ : forall a n, 0<=n -> (2*a).[S n] = a.[n]. Axiom testbit_neg_r : forall a n, n<0 -> a.[n] = false. Axiom shiftr_spec : forall a n m, 0<=m -> (a >> n).[m] = a.[m+n]. Axiom shiftl_spec_high : forall a n m, 0<=m -> n<=m -> (a << n).[m] = a.[m-n]. Axiom shiftl_spec_low : forall a n m, m (a << n).[m] = false. Axiom land_spec : forall a b n, (land a b).[n] = a.[n] && b.[n]. Axiom lor_spec : forall a b n, (lor a b).[n] = a.[n] || b.[n]. Axiom ldiff_spec : forall a b n, (ldiff a b).[n] = a.[n] && negb b.[n]. Axiom lxor_spec : forall a b n, (lxor a b).[n] = xorb a.[n] b.[n]. Axiom div2_spec : forall a, div2 a == a >> 1. End NZBitsSpec. Module Type NZBits (A:NZOrdAxiomsSig) := Bits A <+ NZBitsSpec A. Module Type NZBits' (A:NZOrdAxiomsSig) := Bits' A <+ NZBitsSpec A. (** In the functor of properties will also be defined: - [setbit : t -> t -> t ] defined as [lor a (1< t -> t ] defined as [ldiff a (1< t], the number with [n] initial true bits, corresponding to [2^n - 1]. - a logical complement [lnot]. For integer numbers it will be a [t->t], doing a swap of all bits, while on natural numbers, it will be a bounded complement [t->t->t], swapping only the first [n] bits. *) (** For the moment, no shared properties about NZ here, since properties and proofs for N and Z are quite different *) coq-8.20.0/theories/Numbers/NatInt/NZDiv.v000066400000000000000000000405071466560755400202260ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* t -> t. End DivMod. Module Type DivModNotation (A : Typ)(Import B : DivMod A). Infix "/" := div. Infix "mod" := modulo (at level 40, no associativity). End DivModNotation. Module Type DivMod' (A : Typ) := DivMod A <+ DivModNotation A. Module Type NZDivSpec (Import A : NZOrdAxiomsSig')(Import B : DivMod' A). #[global] Declare Instance div_wd : Proper (eq==>eq==>eq) div. #[global] Declare Instance mod_wd : Proper (eq==>eq==>eq) modulo. Axiom div_mod : forall a b, b ~= 0 -> a == b*(a/b) + (a mod b). Axiom mod_bound_pos : forall a b, 0<=a -> 0 0 <= a mod b < b. End NZDivSpec. (** Euclidean Division with a / 0 == 0 and a mod 0 == a *) Module Type NZDivSpec0 (Import A : Eq')(Import B : ZeroSuccPred' A)(Import C : DivMod' A). Axiom div_0_r : forall a, a / 0 == 0. Axiom mod_0_r : forall a, a mod 0 == a. End NZDivSpec0. (** The different divisions will only differ in the conditions they impose on [modulo]. For NZ, we have only described the behavior on positive numbers. *) Module Type NZDiv (A : NZOrdAxiomsSig) := DivMod A <+ NZDivSpec A. Module Type NZDiv' (A : NZOrdAxiomsSig) := NZDiv A <+ DivModNotation A. Module Type NZDivProp (Import A : NZOrdAxiomsSig') (Import B : NZDiv' A) (Import C : NZMulOrderProp A). (** Uniqueness theorems *) Theorem div_mod_unique : forall b q1 q2 r1 r2, 0<=r1 0<=r2 b*q1+r1 == b*q2+r2 -> q1 == q2 /\ r1 == r2. Proof. intros b. assert (U : forall q1 q2 r1 r2, b*q1+r1 == b*q2+r2 -> 0<=r1 0<=r2 -> q1 False). - intros q1 q2 r1 r2 EQ LT Hr1 Hr2. contradict EQ. apply lt_neq. apply lt_le_trans with (b*q1+b). + rewrite <- add_lt_mono_l. tauto. + apply le_trans with (b*q2). * rewrite mul_comm, <- mul_succ_l, mul_comm. apply mul_le_mono_nonneg_l; intuition; try order. rewrite le_succ_l; auto. * rewrite <- (add_0_r (b*q2)) at 1. rewrite <- add_le_mono_l. tauto. - intros q1 q2 r1 r2 Hr1 Hr2 EQ; destruct (lt_trichotomy q1 q2) as [LT|[EQ'|GT]]. + elim (U q1 q2 r1 r2); intuition. + split; auto. rewrite EQ' in EQ. rewrite add_cancel_l in EQ; auto. + elim (U q2 q1 r2 r1); intuition auto with relations. Qed. Theorem div_unique: forall a b q r, 0<=a -> 0<=r a == b*q + r -> q == a/b. Proof. intros a b q r Ha (Hb,Hr) EQ. destruct (div_mod_unique b q (a/b) r (a mod b)); auto. - apply mod_bound_pos; order. - rewrite <- div_mod; order. Qed. Theorem mod_unique: forall a b q r, 0<=a -> 0<=r a == b*q + r -> r == a mod b. Proof. intros a b q r Ha (Hb,Hr) EQ. destruct (div_mod_unique b q (a/b) r (a mod b)); auto. - apply mod_bound_pos; order. - rewrite <- div_mod; order. Qed. Theorem div_unique_exact a b q: 0<=a -> 0 a == b*q -> q == a/b. Proof. intros Ha Hb H. apply div_unique with 0; nzsimpl; now try split. Qed. (** A division by itself returns 1 *) Lemma div_same : forall a, 0 a/a == 1. Proof. intros. symmetry. apply div_unique_exact; nzsimpl; order. Qed. Lemma mod_same : forall a, 0 a mod a == 0. Proof. intros. symmetry. apply mod_unique with 1; intuition auto; try order. now nzsimpl. Qed. (** A division of a small number by a bigger one yields zero. *) Theorem div_small: forall a b, 0<=a a/b == 0. Proof. intros a b ?. symmetry. apply div_unique with a; intuition; try order. now nzsimpl. Qed. (** Same situation, in term of modulo: *) Theorem mod_small: forall a b, 0<=a a mod b == a. Proof. intros. symmetry. apply mod_unique with 0; intuition; try order. now nzsimpl. Qed. (** * Basic values of divisions and modulo. *) Lemma div_0_l: forall a, 0 0/a == 0. Proof. intros; apply div_small; split; order. Qed. Lemma mod_0_l: forall a, 0 0 mod a == 0. Proof. intros; apply mod_small; split; order. Qed. Lemma div_1_r: forall a, 0<=a -> a/1 == a. Proof. intros. symmetry. apply div_unique_exact; nzsimpl; order'. Qed. Lemma mod_1_r: forall a, 0<=a -> a mod 1 == 0. Proof. intros a ?. symmetry. apply mod_unique with a; try split; try order; try apply lt_0_1. now nzsimpl. Qed. Lemma div_1_l: forall a, 1 1/a == 0. Proof. intros; apply div_small; split; auto. apply le_0_1. Qed. Lemma mod_1_l: forall a, 1 1 mod a == 1. Proof. intros; apply mod_small; split; auto. apply le_0_1. Qed. Lemma div_mul : forall a b, 0<=a -> 0 (a*b)/b == a. Proof. intros; symmetry. apply div_unique_exact; trivial. - apply mul_nonneg_nonneg; order. - apply mul_comm. Qed. Lemma mod_mul : forall a b, 0<=a -> 0 (a*b) mod b == 0. Proof. intros a b ? ?; symmetry. apply mod_unique with a; try split; try order. - apply mul_nonneg_nonneg; order. - nzsimpl; apply mul_comm. Qed. (** * Order results about mod and div *) (** A modulo cannot grow beyond its starting point. *) Theorem mod_le: forall a b, 0<=a -> 0 a mod b <= a. Proof. intros a b ? ?. destruct (le_gt_cases b a). - apply le_trans with b; auto. apply lt_le_incl. destruct (mod_bound_pos a b); auto. - rewrite lt_eq_cases; right. apply mod_small; auto. Qed. (* Division of positive numbers is positive. *) Lemma div_pos: forall a b, 0<=a -> 0 0 <= a/b. Proof. intros a b ? ?. rewrite (mul_le_mono_pos_l _ _ b); auto; nzsimpl. rewrite (add_le_mono_r _ _ (a mod b)). rewrite <- div_mod by order. nzsimpl. apply mod_le; auto. Qed. Lemma div_str_pos : forall a b, 0 0 < a/b. Proof. intros a b (Hb,Hab). assert (LE : 0 <= a/b) by (apply div_pos; order). assert (MOD : a mod b < b) by (destruct (mod_bound_pos a b); order). rewrite lt_eq_cases in LE; destruct LE as [LT|EQ]; auto. exfalso; revert Hab. rewrite (div_mod a b), <-EQ; nzsimpl; order. Qed. Lemma div_small_iff : forall a b, 0<=a -> 0 (a/b==0 <-> a 0 (a mod b == a <-> a 0 (0 b<=a). Proof. intros a b Ha Hb; split; intros Hab. - destruct (lt_ge_cases a b) as [LT|LE]; auto. rewrite <- div_small_iff in LT; order. - apply div_str_pos; auto. Qed. (** As soon as the divisor is strictly greater than 1, the division is strictly decreasing. *) Lemma div_lt : forall a b, 0 1 a/b < a. Proof. intros a b ? ?. assert (0 < b) by (apply lt_trans with 1; auto using lt_0_1). destruct (lt_ge_cases a b). - rewrite div_small; try split; order. - rewrite (div_mod a b) at 2 by order. apply lt_le_trans with (b*(a/b)). + rewrite <- (mul_1_l (a/b)) at 1. rewrite <- mul_lt_mono_pos_r; auto. apply div_str_pos; auto. + rewrite <- (add_0_r (b*(a/b))) at 1. rewrite <- add_le_mono_l. destruct (mod_bound_pos a b); order. Qed. (** [le] is compatible with a positive division. *) Lemma div_le_mono : forall a b c, 0 0<=a<=b -> a/c <= b/c. Proof. intros a b c Hc (Ha,Hab). rewrite lt_eq_cases in Hab. destruct Hab as [LT|EQ]; [|rewrite EQ; order]. rewrite <- lt_succ_r. rewrite (mul_lt_mono_pos_l c) by order. nzsimpl. rewrite (add_lt_mono_r _ _ (a mod c)). rewrite <- div_mod by order. apply lt_le_trans with b; auto. rewrite (div_mod b c) at 1 by order. rewrite <- add_assoc, <- add_le_mono_l. apply le_trans with (c+0). - nzsimpl; destruct (mod_bound_pos b c); order. - rewrite <- add_le_mono_l. destruct (mod_bound_pos a c); order. Qed. (** The following two properties could be used as specification of div *) Lemma mul_div_le : forall a b, 0<=a -> 0 b*(a/b) <= a. Proof. intros a b ? ?. rewrite (add_le_mono_r _ _ (a mod b)), <- div_mod by order. rewrite <- (add_0_r a) at 1. rewrite <- add_le_mono_l. destruct (mod_bound_pos a b); order. Qed. Lemma mul_succ_div_gt : forall a b, 0<=a -> 0 a < b*(S (a/b)). Proof. intros a b ? ?. rewrite (div_mod a b) at 1 by order. rewrite (mul_succ_r). rewrite <- add_lt_mono_l. destruct (mod_bound_pos a b); auto. Qed. (** The previous inequality is exact iff the modulo is zero. *) Lemma div_exact : forall a b, 0<=a -> 0 (a == b*(a/b) <-> a mod b == 0). Proof. intros a b ? ?. rewrite (div_mod a b) at 1 by order. rewrite <- (add_0_r (b*(a/b))) at 2. apply add_cancel_l. Qed. (** Some additional inequalities about div. *) Theorem div_lt_upper_bound: forall a b q, 0<=a -> 0 a < b*q -> a/b < q. Proof. intros a b q ? ? ?. rewrite (mul_lt_mono_pos_l b) by order. apply le_lt_trans with a; auto. apply mul_div_le; auto. Qed. Theorem div_le_upper_bound: forall a b q, 0<=a -> 0 a <= b*q -> a/b <= q. Proof. intros a b q ? ? ?. rewrite (mul_le_mono_pos_l _ _ b) by order. apply le_trans with a; auto. apply mul_div_le; auto. Qed. Theorem div_le_lower_bound: forall a b q, 0<=a -> 0 b*q <= a -> q <= a/b. Proof. intros a b q Ha Hb H. destruct (lt_ge_cases 0 q). - rewrite <- (div_mul q b); try order. apply div_le_mono; auto. rewrite mul_comm; split; auto. apply lt_le_incl, mul_pos_pos; auto. - apply le_trans with 0; auto; apply div_pos; auto. Qed. (** A division respects opposite monotonicity for the divisor *) Lemma div_le_compat_l: forall p q r, 0<=p -> 0 p/r <= p/q. Proof. intros p q r Hp (Hq,Hqr). apply div_le_lower_bound; auto. rewrite (div_mod p r) at 2 by order. apply le_trans with (r*(p/r)). - apply mul_le_mono_nonneg_r; try order. apply div_pos; order. - rewrite <- (add_0_r (r*(p/r))) at 1. rewrite <- add_le_mono_l. destruct (mod_bound_pos p r); order. Qed. (** * Relations between usual operations and mod and div *) Lemma mod_add : forall a b c, 0<=a -> 0<=a+b*c -> 0 (a + b * c) mod c == a mod c. Proof. intros a b c ? ? ?. symmetry. apply mod_unique with (a/c+b); auto. - apply mod_bound_pos; auto. - rewrite mul_add_distr_l, add_shuffle0, <- div_mod by order. now rewrite mul_comm. Qed. Lemma div_add : forall a b c, 0<=a -> 0<=a+b*c -> 0 (a + b * c) / c == a / c + b. Proof. intros a b c ? ? ?. apply (mul_cancel_l _ _ c); try order. apply (add_cancel_r _ _ ((a+b*c) mod c)). rewrite <- div_mod, mod_add by order. rewrite mul_add_distr_l, add_shuffle0, <- div_mod by order. now rewrite mul_comm. Qed. Lemma div_add_l: forall a b c, 0<=c -> 0<=a*b+c -> 0 (a * b + c) / b == a + c / b. Proof. intros a b c. rewrite (add_comm _ c), (add_comm a). intros. apply div_add; auto. Qed. (** Cancellations. *) Lemma div_mul_cancel_r : forall a b c, 0<=a -> 0 0 (a*c)/(b*c) == a/b. Proof. intros a b c ? ? ?. symmetry. apply div_unique with ((a mod b)*c). - apply mul_nonneg_nonneg; order. - split. + apply mul_nonneg_nonneg; destruct (mod_bound_pos a b); order. + rewrite <- mul_lt_mono_pos_r; auto. destruct (mod_bound_pos a b); auto. - rewrite (div_mod a b) at 1 by order. rewrite mul_add_distr_r. rewrite add_cancel_r. rewrite <- 2 mul_assoc. now rewrite (mul_comm c). Qed. Lemma div_mul_cancel_l : forall a b c, 0<=a -> 0 0 (c*a)/(c*b) == a/b. Proof. intros a b c ? ? ?. rewrite !(mul_comm c); apply div_mul_cancel_r; auto. Qed. (** Operations modulo. *) Theorem mod_mod: forall a n, 0<=a -> 0 (a mod n) mod n == a mod n. Proof. intros a n ? ?. destruct (mod_bound_pos a n); auto. now rewrite mod_small_iff. Qed. Lemma mul_mod_idemp_l : forall a b n, 0<=a -> 0<=b -> 0 ((a mod n)*b) mod n == (a*b) mod n. Proof. intros a b n Ha Hb Hn. symmetry. generalize (mul_nonneg_nonneg _ _ Ha Hb). rewrite (div_mod a n) at 1 2 by order. rewrite add_comm, (mul_comm n), (mul_comm _ b). rewrite mul_add_distr_l, mul_assoc. intros. rewrite mod_add; auto. - now rewrite mul_comm. - apply mul_nonneg_nonneg; destruct (mod_bound_pos a n); auto. Qed. Lemma mul_mod_idemp_r : forall a b n, 0<=a -> 0<=b -> 0 (a*(b mod n)) mod n == (a*b) mod n. Proof. intros a b n ? ? ?. rewrite !(mul_comm a). apply mul_mod_idemp_l; auto. Qed. Theorem mul_mod: forall a b n, 0<=a -> 0<=b -> 0 (a * b) mod n == ((a mod n) * (b mod n)) mod n. Proof. intros a b n ? ? ?. rewrite mul_mod_idemp_l, mul_mod_idemp_r; trivial. - reflexivity. - now destruct (mod_bound_pos b n). Qed. Lemma add_mod_idemp_l : forall a b n, 0<=a -> 0<=b -> 0 ((a mod n)+b) mod n == (a+b) mod n. Proof. intros a b n Ha Hb Hn. symmetry. generalize (add_nonneg_nonneg _ _ Ha Hb). rewrite (div_mod a n) at 1 2 by order. rewrite <- add_assoc, add_comm, mul_comm. intros. rewrite mod_add; trivial. - reflexivity. - apply add_nonneg_nonneg; auto. destruct (mod_bound_pos a n); auto. Qed. Lemma add_mod_idemp_r : forall a b n, 0<=a -> 0<=b -> 0 (a+(b mod n)) mod n == (a+b) mod n. Proof. intros a b n ? ? ?. rewrite !(add_comm a). apply add_mod_idemp_l; auto. Qed. Theorem add_mod: forall a b n, 0<=a -> 0<=b -> 0 (a+b) mod n == (a mod n + b mod n) mod n. Proof. intros a b n ? ? ?. rewrite add_mod_idemp_l, add_mod_idemp_r; trivial. - reflexivity. - now destruct (mod_bound_pos b n). Qed. Lemma div_div : forall a b c, 0<=a -> 0 0 (a/b)/c == a/(b*c). Proof. intros a b c Ha Hb Hc. apply div_unique with (b*((a/b) mod c) + a mod b); trivial. (* begin 0<= ... 0 0 a mod (b*c) == a mod b + b*((a/b) mod c). Proof. intros a b c Ha Hb Hc. apply add_cancel_l with (b*c*(a/(b*c))). rewrite <- div_mod by (apply neq_mul_0; split; order). rewrite <- div_div by trivial. rewrite add_assoc, add_shuffle0, <- mul_assoc, <- mul_add_distr_l. rewrite <- div_mod by order. apply div_mod; order. Qed. Lemma add_mul_mod_distr_l: forall a b c d, 0<=a -> 0 0<=d (c*a+d) mod (c*b) == c*(a mod b)+d. Proof. intros a b c d ? ? [? ?]. assert (0 <= a*c) by (apply mul_nonneg_nonneg; order). assert (0 <= a*c+d) by (apply add_nonneg_nonneg; order). rewrite (mul_comm c a), mod_mul_r, add_mod, mod_mul, div_add_l; [|order ..]. now rewrite ? add_0_l, div_small, add_0_r, ? (mod_small d c), (add_comm d). Qed. Lemma add_mul_mod_distr_r: forall a b c d, 0<=a -> 0 0<=d (a*c+d) mod (b*c) == (a mod b)*c+d. Proof. intros a b c d ? ? ?. now rewrite !(mul_comm _ c), add_mul_mod_distr_l. Qed. Lemma mul_mod_distr_l: forall a b c, 0<=a -> 0 0 (c*a) mod (c*b) == c * (a mod b). Proof. intros a b c ? ? ?. pose proof (E := add_mul_mod_distr_l a b c 0). rewrite ? add_0_r in E. now apply E. Qed. Lemma mul_mod_distr_r: forall a b c, 0<=a -> 0 0 (a*c) mod (b*c) == (a mod b) * c. Proof. intros a b c ? ? ?. now rewrite !(mul_comm _ c), mul_mod_distr_l. Qed. (** A last inequality: *) Theorem div_mul_le: forall a b c, 0<=a -> 0 0<=c -> c*(a/b) <= (c*a)/b. Proof. intros a b c ? ? ?. apply div_le_lower_bound; auto. - apply mul_nonneg_nonneg; auto. - rewrite mul_assoc, (mul_comm b c), <- mul_assoc. apply mul_le_mono_nonneg_l; auto. apply mul_div_le; auto. Qed. (** mod is related to divisibility *) Lemma mod_divides : forall a b, 0<=a -> 0 (a mod b == 0 <-> exists c, a == b*c). Proof. intros a b ? ?; split. - intros. exists (a/b). rewrite div_exact; auto. - intros (c,Hc). rewrite Hc, mul_comm. apply mod_mul; auto. rewrite (mul_le_mono_pos_l _ _ b); auto. nzsimpl. order. Qed. End NZDivProp. coq-8.20.0/theories/Numbers/NatInt/NZDomain.v000066400000000000000000000253071466560755400207140ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* nat_rect _ x (fun _ => f) n). #[global] Instance nat_rect_wd n {A} (R:relation A) : Proper (R==>(R==>R)==>R) (fun x f => nat_rect (fun _ => _) x (fun _ => f) n). Proof. intros x y eq_xy f g eq_fg; induction n; [assumption | now apply eq_fg]. Qed. Module NZDomainProp (Import NZ:NZDomainSig'). Include NZBaseProp NZ. (** * Relationship between points thanks to [succ] and [pred]. *) (** For any two points, one is an iterated successor of the other. *) Lemma itersucc_or_itersucc n m : exists k, n == (S^k) m \/ m == (S^k) n. Proof. revert n. apply central_induction with (z:=m). { intros x y eq_xy; apply ex_iff_morphism. intros n; apply or_iff_morphism. + split; intros; etransitivity; try eassumption; now symmetry. + split; intros; (etransitivity; [eassumption|]); [|symmetry]; (eapply nat_rect_wd; [eassumption|apply succ_wd]). } - exists 0%nat. now left. - intros n. split; intros [k [L|R]]. + exists (Datatypes.S k). left. now apply succ_wd. + destruct k as [|k]. * simpl in R. exists 1%nat. left. now apply succ_wd. * rewrite nat_rect_succ_r in R. exists k. now right. + destruct k as [|k]; simpl in L. * exists 1%nat. now right. * apply succ_inj in L. exists k. now left. + exists (Datatypes.S k). right. now rewrite nat_rect_succ_r. Qed. (** Generalized version of [pred_succ] when iterating *) Lemma succ_swap_pred : forall k n m, n == (S^k) m -> m == (P^k) n. Proof. induction k. - simpl; auto with *. - simpl; intros. apply pred_wd in H. rewrite pred_succ in H. apply IHk in H; auto. rewrite <- nat_rect_succ_r in H; auto. Qed. (** From a given point, all others are iterated successors or iterated predecessors. *) Lemma itersucc_or_iterpred : forall n m, exists k, n == (S^k) m \/ n == (P^k) m. Proof. intros n m. destruct (itersucc_or_itersucc n m) as (k,[H|H]). - exists k; left; auto. - exists k; right. apply succ_swap_pred; auto. Qed. (** In particular, all points are either iterated successors of [0] or iterated predecessors of [0] (or both). *) Lemma itersucc0_or_iterpred0 : forall n, exists p:nat, n == (S^p) 0 \/ n == (P^p) 0. Proof. intros n. exact (itersucc_or_iterpred n 0). Qed. (** * Study of initial point w.r.t. [succ] (if any). *) Definition initial n := forall m, n ~= S m. Lemma initial_alt : forall n, initial n <-> S (P n) ~= n. Proof. split. - intros Bn EQ. symmetry in EQ. destruct (Bn _ EQ). - intros NEQ m EQ. apply NEQ. rewrite EQ, pred_succ; auto with *. Qed. Lemma initial_alt2 : forall n, initial n <-> ~exists m, n == S m. Proof. firstorder. Qed. (** First case: let's assume such an initial point exists (i.e. [S] isn't surjective)... *) Section InitialExists. Hypothesis init : t. Hypothesis Initial : initial init. (** ... then we have unicity of this initial point. *) Lemma initial_unique : forall m, initial m -> m == init. Proof. intros m Im. destruct (itersucc_or_itersucc init m) as (p,[H|H]). - destruct p. + now simpl in *. + destruct (Initial _ H). - destruct p. + now simpl in *. + destruct (Im _ H). Qed. (** ... then all other points are descendant of it. *) Lemma initial_ancestor : forall m, exists p, m == (S^p) init. Proof. intros m. destruct (itersucc_or_itersucc init m) as (p,[H|H]). - destruct p; simpl in *; auto. + exists O; auto with *. + destruct (Initial _ H). - exists p; auto. Qed. (** NB : We would like to have [pred n == n] for the initial element, but nothing forces that. For instance we can have -3 as initial point, and P(-3) = 2. A bit odd indeed, but legal according to [NZDomainSig]. We can hence have [n == (P^k) m] without [exists k', m == (S^k') n]. *) (** We need decidability of [eq] (or classical reasoning) for this: *) Section SuccPred. Hypothesis eq_decidable : forall n m, n==m \/ n~=m. Lemma succ_pred_approx : forall n, ~initial n -> S (P n) == n. Proof. intros n NB. rewrite initial_alt in NB. destruct (eq_decidable (S (P n)) n); auto. elim NB; auto. Qed. End SuccPred. End InitialExists. (** Second case : let's suppose now [S] surjective, i.e. no initial point. *) Section InitialDontExists. Hypothesis succ_onto : forall n, exists m, n == S m. Lemma succ_onto_gives_succ_pred : forall n, S (P n) == n. Proof. intros n. destruct (succ_onto n) as (m,H). rewrite H, pred_succ; auto with *. Qed. Lemma succ_onto_pred_injective : forall n m, P n == P m -> n == m. Proof. intros n m. intros H; apply succ_wd in H. rewrite !succ_onto_gives_succ_pred in H; auto. Qed. End InitialDontExists. (** To summarize: S is always injective, P is always surjective (thanks to [pred_succ]). I) If S is not surjective, we have an initial point, which is unique. This bottom is below zero: we have N shifted (or not) to the left. P cannot be injective: P init = P (S (P init)). (P init) can be arbitrary. II) If S is surjective, we have [forall n, S (P n) = n], S and P are bijective and reciprocal. IIa) if [exists k<>O, 0 == S^k 0], then we have a cyclic structure Z/nZ IIb) otherwise, we have Z *) (** * An alternative induction principle using [S] and [P]. *) (** It is weaker than [bi_induction]. For instance it cannot prove that we can go from one point by many [S] _or_ many [P], but only by many [S] mixed with many [P]. Think of a model with two copies of N: 0, 1=S 0, 2=S 1, ... 0', 1'=S 0', 2'=S 1', ... and P 0 = 0' and P 0' = 0. *) Lemma bi_induction_pred : forall A : t -> Prop, Proper (eq==>iff) A -> A 0 -> (forall n, A n -> A (S n)) -> (forall n, A n -> A (P n)) -> forall n, A n. Proof. intros. apply bi_induction; auto. clear n. intros n; split; auto. intros G; apply H2 in G. rewrite pred_succ in G; auto. Qed. Lemma central_induction_pred : forall A : t -> Prop, Proper (eq==>iff) A -> forall n0, A n0 -> (forall n, A n -> A (S n)) -> (forall n, A n -> A (P n)) -> forall n, A n. Proof. intros. assert (A 0). - destruct (itersucc_or_iterpred 0 n0) as (k,[Hk|Hk]); rewrite Hk; clear Hk. + clear H2. induction k; simpl in *; auto. + clear H1. induction k; simpl in *; auto. - apply bi_induction_pred; auto. Qed. End NZDomainProp. (** We now focus on the translation from [nat] into [NZ]. First, relationship with [0], [succ], [pred]. *) Module NZOfNat (Import NZ:NZDomainSig'). Definition ofnat (n : nat) : t := (S^n) 0. Declare Scope ofnat. Local Open Scope ofnat. Notation "[ n ]" := (ofnat n) (at level 7) : ofnat. Lemma ofnat_zero : [O] == 0. Proof. reflexivity. Qed. Lemma ofnat_succ : forall n, [Datatypes.S n] == succ [n]. Proof. now unfold ofnat. Qed. Lemma ofnat_pred : forall n, n<>O -> [Peano.pred n] == P [n]. Proof. unfold ofnat. destruct n. - destruct 1; auto. - intros _. simpl. symmetry. apply pred_succ. Qed. (** Since [P 0] can be anything in NZ (either [-1], [0], or even other numbers, we cannot state previous lemma for [n=O]. *) End NZOfNat. (** If we require in addition a strict order on NZ, we can prove that [ofnat] is injective, and hence that NZ is infinite (i.e. we ban Z/nZ models) *) Module NZOfNatOrd (Import NZ:NZOrdSig'). Include NZOfNat NZ. Include NZBaseProp NZ <+ NZOrderProp NZ. Local Open Scope ofnat. Theorem ofnat_S_gt_0 : forall n : nat, 0 < [Datatypes.S n]. Proof. unfold ofnat. intros n; induction n as [| n IH]; simpl in *. - apply lt_succ_diag_r. - apply lt_trans with (S 0). + apply lt_succ_diag_r. + now rewrite <- succ_lt_mono. Qed. Theorem ofnat_S_neq_0 : forall n : nat, 0 ~= [Datatypes.S n]. Proof. intros. apply lt_neq, ofnat_S_gt_0. Qed. Lemma ofnat_injective : forall n m, [n]==[m] -> n = m. Proof. induction n as [|n IH]; destruct m; auto. - intros H; elim (ofnat_S_neq_0 _ H). - intros H; symmetry in H; elim (ofnat_S_neq_0 _ H). - intros. f_equal. apply IH. now rewrite <- succ_inj_wd. Qed. Lemma ofnat_eq : forall n m, [n]==[m] <-> n = m. Proof. split. - apply ofnat_injective. - intros; now subst. Qed. (* In addition, we can prove that [ofnat] preserves order. *) Lemma ofnat_lt : forall n m : nat, [n]<[m] <-> (n (n<=m)%nat. Proof. intros. rewrite lt_eq_cases, ofnat_lt, ofnat_eq. split. - destruct 1; subst; auto. apply Nat.lt_le_incl; assumption. - apply Nat.lt_eq_cases. Qed. End NZOfNatOrd. (** For basic operations, we can prove correspondence with their counterpart in [nat]. *) Module NZOfNatOps (Import NZ:NZAxiomsSig'). Include NZOfNat NZ. Local Open Scope ofnat. Lemma ofnat_add_l : forall n m, [n]+m == (S^n) m. Proof. induction n; intros. - apply add_0_l. - rewrite ofnat_succ, add_succ_l. simpl. now f_equiv. Qed. Lemma ofnat_add : forall n m, [n+m] == [n]+[m]. Proof. intros. rewrite ofnat_add_l. induction n; simpl. - reflexivity. - now f_equiv. Qed. Lemma ofnat_mul : forall n m, [n*m] == [n]*[m]. Proof. induction n; simpl; intros. - symmetry. apply mul_0_l. - rewrite Nat.add_comm. rewrite ofnat_add, mul_succ_l. now f_equiv. Qed. Lemma ofnat_sub_r : forall n m, n-[m] == (P^m) n. Proof. induction m; simpl; intros. - apply sub_0_r. - rewrite sub_succ_r. now f_equiv. Qed. Lemma ofnat_sub : forall n m, m<=n -> [n-m] == [n]-[m]. Proof. intros n m H. rewrite ofnat_sub_r. revert n H. induction m. - intros. rewrite Nat.sub_0_r. now simpl. - intros. destruct n. + inversion H. + rewrite nat_rect_succ_r. simpl. etransitivity. * apply IHm; apply <- Nat.succ_le_mono; assumption. * eapply nat_rect_wd; [symmetry;apply pred_succ|apply pred_wd]. Qed. End NZOfNatOps. coq-8.20.0/theories/Numbers/NatInt/NZGcd.v000066400000000000000000000210301466560755400201670ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* t -> t. End Gcd. Module Type NZGcdSpec (A : NZOrdAxiomsSig')(B : Gcd A). Import A B. Definition divide n m := exists p, m == p*n. Local Notation "( n | m )" := (divide n m) (at level 0). Axiom gcd_divide_l : forall n m, (gcd n m | n). Axiom gcd_divide_r : forall n m, (gcd n m | m). Axiom gcd_greatest : forall n m p, (p | n) -> (p | m) -> (p | gcd n m). Axiom gcd_nonneg : forall n m, 0 <= gcd n m. End NZGcdSpec. Module Type DivideNotation (A:NZOrdAxiomsSig')(B:Gcd A)(C:NZGcdSpec A B). Import A B C. Notation "( n | m )" := (divide n m) (at level 0). End DivideNotation. Module Type NZGcd (A : NZOrdAxiomsSig) := Gcd A <+ NZGcdSpec A. Module Type NZGcd' (A : NZOrdAxiomsSig) := Gcd A <+ NZGcdSpec A <+ DivideNotation A. (** Derived properties of gcd *) Module NZGcdProp (Import A : NZOrdAxiomsSig') (Import B : NZGcd' A) (Import C : NZMulOrderProp A). (** Results concerning divisibility*) #[global] Instance divide_wd : Proper (eq==>eq==>iff) divide. Proof. unfold divide. intros x x' Hx y y' Hy. setoid_rewrite Hx. setoid_rewrite Hy. easy. Qed. Lemma divide_1_l : forall n, (1 | n). Proof. intros n. exists n. now nzsimpl. Qed. Lemma divide_0_r : forall n, (n | 0). Proof. intros n. exists 0. now nzsimpl. Qed. Lemma divide_0_l : forall n, (0 | n) -> n==0. Proof. intros n (m,Hm). revert Hm. now nzsimpl. Qed. Lemma eq_mul_1_nonneg : forall n m, 0<=n -> n*m == 1 -> n==1 /\ m==1. Proof. intros n m Hn H. le_elim Hn. - destruct (lt_ge_cases m 0) as [Hm|Hm]. + generalize (mul_pos_neg n m Hn Hm). order'. + le_elim Hm. * apply le_succ_l in Hn. rewrite <- one_succ in Hn. le_elim Hn. -- generalize (lt_1_mul_pos n m Hn Hm). order. -- rewrite <- Hn, mul_1_l in H. now split. * rewrite <- Hm, mul_0_r in H. order'. - rewrite <- Hn, mul_0_l in H. order'. Qed. Lemma eq_mul_1_nonneg' : forall n m, 0<=m -> n*m == 1 -> n==1 /\ m==1. Proof. intros n m Hm H. rewrite mul_comm in H. now apply and_comm, eq_mul_1_nonneg. Qed. Lemma divide_1_r_nonneg : forall n, 0<=n -> (n | 1) -> n==1. Proof. intros n Hn (m,Hm). symmetry in Hm. now apply (eq_mul_1_nonneg' m n). Qed. Lemma divide_refl : forall n, (n | n). Proof. intros n. exists 1. now nzsimpl. Qed. Lemma divide_trans : forall n m p, (n | m) -> (m | p) -> (n | p). Proof. intros n m p (q,Hq) (r,Hr). exists (r*q). now rewrite Hr, Hq, mul_assoc. Qed. #[global] Instance divide_reflexive : Reflexive divide | 5 := divide_refl. #[global] Instance divide_transitive : Transitive divide | 5 := divide_trans. (** Due to sign, no general antisymmetry result *) Lemma divide_antisym_nonneg : forall n m, 0<=n -> 0<=m -> (n | m) -> (m | n) -> n == m. Proof. intros n m Hn Hm (q,Hq) (r,Hr). le_elim Hn. - destruct (lt_ge_cases q 0) as [Hq'|Hq']. + generalize (mul_neg_pos q n Hq' Hn). order. + rewrite Hq, mul_assoc in Hr. symmetry in Hr. apply mul_id_l in Hr; [|order]. destruct (eq_mul_1_nonneg' r q) as [_ H]; trivial. now rewrite H, mul_1_l in Hq. - rewrite <- Hn, mul_0_r in Hq. now rewrite <- Hn. Qed. Lemma mul_divide_mono_l : forall n m p, (n | m) -> (p * n | p * m). Proof. intros n m p (q,Hq). exists q. now rewrite mul_shuffle3, Hq. Qed. Lemma mul_divide_mono_r : forall n m p, (n | m) -> (n * p | m * p). Proof. intros n m p (q,Hq). exists q. now rewrite mul_assoc, Hq. Qed. Lemma mul_divide_cancel_l : forall n m p, p ~= 0 -> ((p * n | p * m) <-> (n | m)). Proof. intros n m p Hp. split. - intros (q,Hq). exists q. now rewrite mul_shuffle3, mul_cancel_l in Hq. - apply mul_divide_mono_l. Qed. Lemma mul_divide_cancel_r : forall n m p, p ~= 0 -> ((n * p | m * p) <-> (n | m)). Proof. intros n m p ?. rewrite 2 (mul_comm _ p). now apply mul_divide_cancel_l. Qed. Lemma divide_add_r : forall n m p, (n | m) -> (n | p) -> (n | m + p). Proof. intros n m p (q,Hq) (r,Hr). exists (q+r). now rewrite mul_add_distr_r, Hq, Hr. Qed. Lemma divide_mul_l : forall n m p, (n | m) -> (n | m * p). Proof. intros n m p (q,Hq). exists (q*p). now rewrite mul_shuffle0, Hq. Qed. Lemma divide_mul_r : forall n m p, (n | p) -> (n | m * p). Proof. intros n m p. rewrite mul_comm. apply divide_mul_l. Qed. Lemma divide_factor_l : forall n m, (n | n * m). Proof. intros. apply divide_mul_l, divide_refl. Qed. Lemma divide_factor_r : forall n m, (n | m * n). Proof. intros. apply divide_mul_r, divide_refl. Qed. Lemma divide_pos_le : forall n m, 0 < m -> (n | m) -> n <= m. Proof. intros n m Hm (q,Hq). destruct (le_gt_cases n 0) as [Hn|Hn]. - order. - rewrite Hq. destruct (lt_ge_cases q 0) as [Hq'|Hq']. + generalize (mul_neg_pos q n Hq' Hn). order. + le_elim Hq'. * rewrite <- (mul_1_l n) at 1. apply mul_le_mono_pos_r; trivial. now rewrite one_succ, le_succ_l. * rewrite <- Hq', mul_0_l in Hq. order. Qed. (** Basic properties of gcd *) Lemma gcd_unique : forall n m p, 0<=p -> (p|n) -> (p|m) -> (forall q, (q|n) -> (q|m) -> (q|p)) -> gcd n m == p. Proof. intros n m p Hp Hn Hm H. apply divide_antisym_nonneg; trivial. - apply gcd_nonneg. - apply H. + apply gcd_divide_l. + apply gcd_divide_r. - now apply gcd_greatest. Qed. #[global] Instance gcd_wd : Proper (eq==>eq==>eq) gcd. Proof. intros x x' Hx y y' Hy. apply gcd_unique. - apply gcd_nonneg. - rewrite Hx. apply gcd_divide_l. - rewrite Hy. apply gcd_divide_r. - intro. rewrite Hx, Hy. apply gcd_greatest. Qed. Lemma gcd_divide_iff : forall n m p, (p | gcd n m) <-> (p | n) /\ (p | m). Proof. intros n m p. split. - split. + transitivity (gcd n m); trivial using gcd_divide_l. + transitivity (gcd n m); trivial using gcd_divide_r. - intros (H,H'). now apply gcd_greatest. Qed. Lemma gcd_unique_alt : forall n m p, 0<=p -> (forall q, (q|p) <-> (q|n) /\ (q|m)) -> gcd n m == p. Proof. intros n m p Hp H. apply gcd_unique; trivial. - apply H. apply divide_refl. - apply H. apply divide_refl. - intros. apply H. now split. Qed. Lemma gcd_comm : forall n m, gcd n m == gcd m n. Proof. intros. apply gcd_unique_alt; try apply gcd_nonneg. intros. rewrite and_comm. apply gcd_divide_iff. Qed. Lemma gcd_assoc : forall n m p, gcd n (gcd m p) == gcd (gcd n m) p. Proof. intros. apply gcd_unique_alt; try apply gcd_nonneg. intros. now rewrite !gcd_divide_iff, and_assoc. Qed. Lemma gcd_0_l_nonneg : forall n, 0<=n -> gcd 0 n == n. Proof. intros. apply gcd_unique; trivial. - apply divide_0_r. - apply divide_refl. Qed. Lemma gcd_0_r_nonneg : forall n, 0<=n -> gcd n 0 == n. Proof. intros. now rewrite gcd_comm, gcd_0_l_nonneg. Qed. Lemma gcd_1_l : forall n, gcd 1 n == 1. Proof. intros. apply gcd_unique; trivial using divide_1_l, le_0_1. Qed. Lemma gcd_1_r : forall n, gcd n 1 == 1. Proof. intros. now rewrite gcd_comm, gcd_1_l. Qed. Lemma gcd_diag_nonneg : forall n, 0<=n -> gcd n n == n. Proof. intros. apply gcd_unique; trivial using divide_refl. Qed. Lemma gcd_eq_0_l : forall n m, gcd n m == 0 -> n == 0. Proof. intros n m H. generalize (gcd_divide_l n m). rewrite H. apply divide_0_l. Qed. Lemma gcd_eq_0_r : forall n m, gcd n m == 0 -> m == 0. Proof. intros n m ?. apply gcd_eq_0_l with n. now rewrite gcd_comm. Qed. Lemma gcd_eq_0 : forall n m, gcd n m == 0 <-> n == 0 /\ m == 0. Proof. intros n m. split. - split. + now apply gcd_eq_0_l with m. + now apply gcd_eq_0_r with n. - intros (EQ,EQ'). rewrite EQ, EQ'. now apply gcd_0_r_nonneg. Qed. Lemma gcd_mul_diag_l : forall n m, 0<=n -> gcd n (n*m) == n. Proof. intros n m Hn. apply gcd_unique_alt; trivial. intros q. split. - split; trivial. now apply divide_mul_l. - now destruct 1. Qed. Lemma divide_gcd_iff : forall n m, 0<=n -> ((n|m) <-> gcd n m == n). Proof. intros n m Hn. split. - intros (q,Hq). rewrite Hq. rewrite mul_comm. now apply gcd_mul_diag_l. - intros EQ. rewrite <- EQ. apply gcd_divide_r. Qed. End NZGcdProp. coq-8.20.0/theories/Numbers/NatInt/NZLog.v000066400000000000000000000716111466560755400202250ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* t. End Log2. Module Type NZLog2Spec (A : NZOrdAxiomsSig')(B : Pow' A)(C : Log2 A). Import A B C. Axiom log2_spec : forall a, 0 2^(log2 a) <= a < 2^(S (log2 a)). Axiom log2_nonpos : forall a, a<=0 -> log2 a == 0. End NZLog2Spec. Module Type NZLog2 (A : NZOrdAxiomsSig)(B : Pow A) := Log2 A <+ NZLog2Spec A B. (** Derived properties of logarithm *) Module Type NZLog2Prop (Import A : NZOrdAxiomsSig') (Import B : NZPow' A) (Import C : NZLog2 A B) (Import D : NZMulOrderProp A) (Import E : NZPowProp A B D). (** log2 is always non-negative *) Lemma log2_nonneg : forall a, 0 <= log2 a. Proof. intros a. destruct (le_gt_cases a 0) as [Ha|Ha]. - now rewrite log2_nonpos. - destruct (log2_spec a Ha) as (_,LT). apply lt_succ_r, (pow_gt_1 2). + order'. + rewrite <- le_succ_l, <- one_succ in Ha. order. Qed. (** A tactic for proving positivity and non-negativity *) Ltac order_pos := ((apply add_pos_pos || apply add_nonneg_nonneg || apply mul_pos_pos || apply mul_nonneg_nonneg || apply pow_nonneg || apply pow_pos_nonneg || apply log2_nonneg || apply (le_le_succ_r 0)); order_pos) (* in case of success of an apply, we recurse *) || order'. (* otherwise *) (** The spec of log2 indeed determines it *) Lemma log2_unique : forall a b, 0<=b -> 2^b<=a<2^(S b) -> log2 a == b. Proof. intros a b Hb (LEb,LTb). assert (Ha : 0 < a). - apply lt_le_trans with (2^b); trivial. apply pow_pos_nonneg; order'. - assert (Hc := log2_nonneg a). destruct (log2_spec a Ha) as (LEc,LTc). assert (log2 a <= b). + apply lt_succ_r, (pow_lt_mono_r_iff 2); try order'. now apply le_le_succ_r. + assert (b <= log2 a). * apply lt_succ_r, (pow_lt_mono_r_iff 2); try order'. now apply le_le_succ_r. * order. Qed. (** Hence log2 is a morphism. *) #[global] Instance log2_wd : Proper (eq==>eq) log2. Proof. intros x x' Hx. destruct (le_gt_cases x 0). - rewrite 2 log2_nonpos; trivial. + reflexivity. + now rewrite <- Hx. - apply log2_unique. + apply log2_nonneg. + rewrite Hx in *. now apply log2_spec. Qed. (** An alternate specification *) Lemma log2_spec_alt : forall a, 0 exists r, a == 2^(log2 a) + r /\ 0 <= r < 2^(log2 a). Proof. intros a Ha. destruct (log2_spec _ Ha) as (LE,LT). destruct (le_exists_sub _ _ LE) as (r & Hr & Hr'). exists r. split. - now rewrite add_comm. - split. + trivial. + apply (add_lt_mono_r _ _ (2^log2 a)). rewrite <- Hr. generalize LT. rewrite pow_succ_r by order_pos. rewrite two_succ at 1. now nzsimpl. Qed. Lemma log2_unique' : forall a b c, 0<=b -> 0<=c<2^b -> a == 2^b + c -> log2 a == b. Proof. intros a b c Hb (Hc,H) EQ. apply log2_unique. - trivial. - rewrite EQ. split. + rewrite <- add_0_r at 1. now apply add_le_mono_l. + rewrite pow_succ_r by order. rewrite two_succ at 2. nzsimpl. now apply add_lt_mono_l. Qed. (** log2 is exact on powers of 2 *) Lemma log2_pow2 : forall a, 0<=a -> log2 (2^a) == a. Proof. intros a Ha. apply log2_unique' with 0; trivial. - split; order_pos. - now nzsimpl. Qed. (** log2 and predecessors of powers of 2 *) Lemma log2_pred_pow2 : forall a, 0 log2 (P (2^a)) == P a. Proof. intros a Ha. assert (Ha' : S (P a) == a) by (now rewrite lt_succ_pred with 0). apply log2_unique. - apply lt_succ_r; order. - rewrite <-le_succ_l, <-lt_succ_r, Ha'. rewrite lt_succ_pred with 0. + split; try easy. apply pow_lt_mono_r_iff; try order'. rewrite succ_lt_mono, Ha'. apply lt_succ_diag_r. + apply pow_pos_nonneg; order'. Qed. (** log2 and basic constants *) Lemma log2_1 : log2 1 == 0. Proof. rewrite <- (pow_0_r 2). now apply log2_pow2. Qed. Lemma log2_2 : log2 2 == 1. Proof. rewrite <- (pow_1_r 2). apply log2_pow2; order'. Qed. (** log2 n is strictly positive for 1 0 < log2 a. Proof. intros a Ha. assert (Ha' : 0 < a) by order'. assert (H := log2_nonneg a). le_elim H; trivial. generalize (log2_spec a Ha'). rewrite <- H in *. nzsimpl; try order. intros (_,H'). rewrite two_succ in H'. apply lt_succ_r in H'; order. Qed. (** Said otherwise, log2 is null only below 1 *) Lemma log2_null : forall a, log2 a == 0 <-> a <= 1. Proof. intros a. split; intros H. - destruct (le_gt_cases a 1) as [Ha|Ha]; trivial. generalize (log2_pos a Ha); order. - le_elim H. + apply log2_nonpos. apply lt_succ_r. now rewrite <- one_succ. + rewrite H. apply log2_1. Qed. (** log2 is a monotone function (but not a strict one) *) Lemma log2_le_mono : forall a b, a<=b -> log2 a <= log2 b. Proof. intros a b H. destruct (le_gt_cases a 0) as [Ha|Ha]. - rewrite log2_nonpos; order_pos. - assert (Hb : 0 < b) by order. destruct (log2_spec a Ha) as (LEa,_). destruct (log2_spec b Hb) as (_,LTb). apply lt_succ_r, (pow_lt_mono_r_iff 2); order_pos. Qed. (** No reverse result for <=, consider for instance log2 3 <= log2 2 *) Lemma log2_lt_cancel : forall a b, log2 a < log2 b -> a < b. Proof. intros a b H. destruct (le_gt_cases b 0) as [Hb|Hb]. - rewrite (log2_nonpos b) in H; trivial. generalize (log2_nonneg a); order. - destruct (le_gt_cases a 0) as [Ha|Ha]. + order. + destruct (log2_spec a Ha) as (_,LTa). destruct (log2_spec b Hb) as (LEb,_). apply le_succ_l in H. apply (pow_le_mono_r_iff 2) in H; order_pos. Qed. (** When left side is a power of 2, we have an equivalence for <= *) Lemma log2_le_pow2 : forall a b, 0 (2^b<=a <-> b <= log2 a). Proof. intros a b Ha. split; intros H. - destruct (lt_ge_cases b 0) as [Hb|Hb]. + generalize (log2_nonneg a); order. + rewrite <- (log2_pow2 b); trivial. now apply log2_le_mono. - transitivity (2^(log2 a)). + apply pow_le_mono_r; order'. + now destruct (log2_spec a Ha). Qed. (** When right side is a square, we have an equivalence for < *) Lemma log2_lt_pow2 : forall a b, 0 (a<2^b <-> log2 a < b). Proof. intros a b Ha. split; intros H. - destruct (lt_ge_cases b 0) as [Hb|Hb]. + rewrite pow_neg_r in H; order. + apply (pow_lt_mono_r_iff 2); try order_pos. apply le_lt_trans with a; trivial. now destruct (log2_spec a Ha). - destruct (lt_ge_cases b 0) as [Hb|Hb]. + generalize (log2_nonneg a); order. + apply log2_lt_cancel; try order. now rewrite log2_pow2. Qed. (** Comparing log2 and identity *) Lemma log2_lt_lin : forall a, 0 log2 a < a. Proof. intros a Ha. apply (pow_lt_mono_r_iff 2); try order_pos. apply le_lt_trans with a. - now destruct (log2_spec a Ha). - apply pow_gt_lin_r; order'. Qed. Lemma log2_le_lin : forall a, 0<=a -> log2 a <= a. Proof. intros a Ha. le_elim Ha. - now apply lt_le_incl, log2_lt_lin. - rewrite <- Ha, log2_nonpos; order. Qed. (** Log2 and multiplication. *) (** Due to rounding error, we don't have the usual [log2 (a*b) = log2 a + log2 b] but we may be off by 1 at most *) Lemma log2_mul_below : forall a b, 0 0 log2 a + log2 b <= log2 (a*b). Proof. intros a b Ha Hb. apply log2_le_pow2; try order_pos. rewrite pow_add_r by order_pos. apply mul_le_mono_nonneg; try apply log2_spec; order_pos. Qed. Lemma log2_mul_above : forall a b, 0<=a -> 0<=b -> log2 (a*b) <= log2 a + log2 b + 1. Proof. intros a b Ha Hb. le_elim Ha. - le_elim Hb. + apply lt_succ_r. rewrite add_1_r, <- add_succ_r, <- add_succ_l. apply log2_lt_pow2; try order_pos. rewrite pow_add_r by order_pos. apply mul_lt_mono_nonneg; try order; now apply log2_spec. + rewrite <- Hb. nzsimpl. rewrite log2_nonpos; order_pos. - rewrite <- Ha. nzsimpl. rewrite log2_nonpos; order_pos. Qed. (** And we can't find better approximations in general. - The lower bound is exact for powers of 2. - Concerning the upper bound, for any c>1, take a=b=2^c-1, then log2 (a*b) = c+c -1 while (log2 a) = (log2 b) = c-1 *) (** At least, we get back the usual equation when we multiply by 2 (or 2^k) *) Lemma log2_mul_pow2 : forall a b, 0 0<=b -> log2 (a*2^b) == b + log2 a. Proof. intros a b Ha Hb. apply log2_unique; try order_pos. split. - rewrite pow_add_r, mul_comm; try order_pos. apply mul_le_mono_nonneg_r. + order_pos. + now apply log2_spec. - rewrite <-add_succ_r, pow_add_r, mul_comm; try order_pos. apply mul_lt_mono_pos_l. + order_pos. + now apply log2_spec. Qed. Lemma log2_double : forall a, 0 log2 (2*a) == S (log2 a). Proof. intros a Ha. generalize (log2_mul_pow2 a 1 Ha le_0_1). now nzsimpl'. Qed. (** Two numbers with same log2 cannot be far away. *) Lemma log2_same : forall a b, 0 0 log2 a == log2 b -> a < 2*b. Proof. intros a b Ha Hb H. apply log2_lt_cancel. rewrite log2_double, H by trivial. apply lt_succ_diag_r. Qed. (** Log2 and successor : - the log2 function climbs by at most 1 at a time - otherwise it stays at the same value - the +1 steps occur for powers of two *) Lemma log2_succ_le : forall a, log2 (S a) <= S (log2 a). Proof. intros a. destruct (lt_trichotomy 0 a) as [LT|[EQ|LT]]. - apply (pow_le_mono_r_iff 2); try order_pos. transitivity (S a). + apply log2_spec. apply lt_succ_r; order. + now apply le_succ_l, log2_spec. - rewrite <- EQ, <- one_succ, log2_1; order_pos. - rewrite 2 log2_nonpos. + order_pos. + order'. + now rewrite le_succ_l. Qed. Lemma log2_succ_or : forall a, log2 (S a) == S (log2 a) \/ log2 (S a) == log2 a. Proof. intros a. destruct (le_gt_cases (log2 (S a)) (log2 a)) as [H|H]. - right. generalize (log2_le_mono _ _ (le_succ_diag_r a)); order. - left. apply le_succ_l in H. generalize (log2_succ_le a); order. Qed. Lemma log2_eq_succ_is_pow2 : forall a, log2 (S a) == S (log2 a) -> exists b, S a == 2^b. Proof. intros a H. destruct (le_gt_cases a 0) as [Ha|Ha]. - rewrite 2 (proj2 (log2_null _)) in H. + generalize (lt_succ_diag_r 0); order. + order'. + apply le_succ_l. order'. - assert (Ha' : 0 < S a) by (apply lt_succ_r; order). exists (log2 (S a)). generalize (proj1 (log2_spec (S a) Ha')) (proj2 (log2_spec a Ha)). rewrite <- le_succ_l, <- H. order. Qed. Lemma log2_eq_succ_iff_pow2 : forall a, 0 (log2 (S a) == S (log2 a) <-> exists b, S a == 2^b). Proof. intros a Ha. split. - apply log2_eq_succ_is_pow2. - intros (b,Hb). assert (Hb' : 0 < b). + apply (pow_gt_1 2); try order'; now rewrite <- Hb, one_succ, <- succ_lt_mono. + rewrite Hb, log2_pow2; try order'. setoid_replace a with (P (2^b)). * rewrite log2_pred_pow2; trivial. symmetry; now apply lt_succ_pred with 0. * apply succ_inj. rewrite Hb. symmetry. apply lt_succ_pred with 0. rewrite <- Hb, lt_succ_r; order. Qed. Lemma log2_succ_double : forall a, 0 log2 (2*a+1) == S (log2 a). Proof. intros a Ha. rewrite add_1_r. destruct (log2_succ_or (2*a)) as [H|H]; [exfalso|now rewrite H, log2_double]. apply log2_eq_succ_is_pow2 in H. destruct H as (b,H). destruct (lt_trichotomy b 0) as [LT|[EQ|LT]]. - rewrite pow_neg_r in H; trivial. apply (mul_pos_pos 2), succ_lt_mono in Ha; try order'. rewrite <- one_succ in Ha. order'. - rewrite EQ, pow_0_r in H. apply (mul_pos_pos 2), succ_lt_mono in Ha; try order'. rewrite <- one_succ in Ha. order'. - assert (EQ:=lt_succ_pred 0 b LT). rewrite <- EQ, pow_succ_r in H; [|now rewrite <- lt_succ_r, EQ]. destruct (lt_ge_cases a (2^(P b))) as [LT'|LE']. + generalize (mul_2_mono_l _ _ LT'). rewrite add_1_l. order. + rewrite (mul_le_mono_pos_l _ _ 2) in LE'; try order'. rewrite <- H in LE'. apply le_succ_l in LE'. order. Qed. (** Log2 and addition *) Lemma log2_add_le : forall a b, a~=1 -> b~=1 -> log2 (a+b) <= log2 a + log2 b. Proof. intros a b Ha Hb. destruct (lt_trichotomy a 1) as [Ha'|[Ha'|Ha']]; [|order|]. - rewrite one_succ, lt_succ_r in Ha'. rewrite (log2_nonpos a); trivial. nzsimpl. apply log2_le_mono. rewrite <- (add_0_l b) at 2. now apply add_le_mono. - destruct (lt_trichotomy b 1) as [Hb'|[Hb'|Hb']]; [|order|]. + rewrite one_succ, lt_succ_r in Hb'. rewrite (log2_nonpos b); trivial. nzsimpl. apply log2_le_mono. rewrite <- (add_0_r a) at 2. now apply add_le_mono. + clear Ha Hb. apply lt_succ_r. apply log2_lt_pow2; try order_pos. rewrite pow_succ_r by order_pos. rewrite two_succ, one_succ at 1. nzsimpl. apply add_lt_mono. * apply lt_le_trans with (2^(S (log2 a))). -- apply log2_spec; order'. -- apply pow_le_mono_r. ++ order'. ++ rewrite <- add_1_r. apply add_le_mono_l. rewrite one_succ; now apply le_succ_l, log2_pos. * apply lt_le_trans with (2^(S (log2 b))). -- apply log2_spec; order'. -- apply pow_le_mono_r. ++ order'. ++ rewrite <- add_1_l. apply add_le_mono_r. rewrite one_succ; now apply le_succ_l, log2_pos. Qed. (** The sum of two log2 is less than twice the log2 of the sum. The large inequality is obvious thanks to monotonicity. The strict one requires some more work. This is almost a convexity inequality for points [2a], [2b] and their middle [a+b] : ideally, we would have [2*log(a+b) >= log(2a)+log(2b) = 2+log a+log b]. Here, we cannot do better: consider for instance a=2 b=4, then 1+2<2*2 *) Lemma add_log2_lt : forall a b, 0 0 log2 a + log2 b < 2 * log2 (a+b). Proof. intros a b Ha Hb. nzsimpl'. assert (H : log2 a <= log2 (a+b)). - apply log2_le_mono. rewrite <- (add_0_r a) at 1. apply add_le_mono; order. - assert (H' : log2 b <= log2 (a+b)). + apply log2_le_mono. rewrite <- (add_0_l b) at 1. apply add_le_mono; order. + le_elim H. * apply lt_le_trans with (log2 (a+b) + log2 b). -- now apply add_lt_mono_r. -- now apply add_le_mono_l. * rewrite <- H at 1. apply add_lt_mono_l. le_elim H'; trivial. symmetry in H. apply log2_same in H; try order_pos. symmetry in H'. apply log2_same in H'; try order_pos. revert H H'. nzsimpl'. rewrite <- add_lt_mono_l, <- add_lt_mono_r; order. Qed. End NZLog2Prop. Module NZLog2UpProp (Import A : NZDecOrdAxiomsSig') (Import B : NZPow' A) (Import C : NZLog2 A B) (Import D : NZMulOrderProp A) (Import E : NZPowProp A B D) (Import F : NZLog2Prop A B C D E). (** * [log2_up] : a binary logarithm that rounds up instead of down *) (** For once, we define instead of axiomatizing, thanks to log2 *) Definition log2_up a := match compare 1 a with | Lt => S (log2 (P a)) | _ => 0 end. Lemma log2_up_eqn0 : forall a, a<=1 -> log2_up a == 0. Proof. intros a Ha. unfold log2_up. case compare_spec; try order. Qed. Lemma log2_up_eqn : forall a, 1 log2_up a == S (log2 (P a)). Proof. intros a Ha. unfold log2_up. case compare_spec; try order. Qed. Lemma log2_up_spec : forall a, 1 2^(P (log2_up a)) < a <= 2^(log2_up a). Proof. intros a Ha. rewrite log2_up_eqn; trivial. rewrite pred_succ. rewrite <- (lt_succ_pred 1 a Ha) at 2 3. rewrite lt_succ_r, le_succ_l. apply log2_spec. apply succ_lt_mono. now rewrite (lt_succ_pred 1 a Ha), <- one_succ. Qed. Lemma log2_up_nonpos : forall a, a<=0 -> log2_up a == 0. Proof. intros. apply log2_up_eqn0. order'. Qed. #[global] Instance log2_up_wd : Proper (eq==>eq) log2_up. Proof. assert (Proper (eq==>eq==>Logic.eq) compare). - repeat red; intros; do 2 case compare_spec; trivial; order. - intros a a' Ha. unfold log2_up. rewrite Ha at 1. case compare; now rewrite ?Ha. Qed. (** [log2_up] is always non-negative *) Lemma log2_up_nonneg : forall a, 0 <= log2_up a. Proof. intros a. unfold log2_up. case compare_spec; try order. intros. apply le_le_succ_r, log2_nonneg. Qed. (** The spec of [log2_up] indeed determines it *) Lemma log2_up_unique : forall a b, 0 2^(P b) log2_up a == b. Proof. intros a b Hb (LEb,LTb). assert (Ha : 1 < a). - apply le_lt_trans with (2^(P b)); trivial. rewrite one_succ. apply le_succ_l. apply pow_pos_nonneg. + order'. + apply lt_succ_r. now rewrite (lt_succ_pred 0 b Hb). - assert (Hc := log2_up_nonneg a). destruct (log2_up_spec a Ha) as (LTc,LEc). assert (b <= log2_up a). + apply lt_succ_r. rewrite <- (lt_succ_pred 0 b Hb). rewrite <- succ_lt_mono. apply (pow_lt_mono_r_iff 2); try order'. + assert (Hc' : 0 < log2_up a) by order. assert (log2_up a <= b). * apply lt_succ_r. rewrite <- (lt_succ_pred 0 _ Hc'). rewrite <- succ_lt_mono. apply (pow_lt_mono_r_iff 2); try order'. * order. Qed. (** [log2_up] is exact on powers of 2 *) Lemma log2_up_pow2 : forall a, 0<=a -> log2_up (2^a) == a. Proof. intros a Ha. le_elim Ha. - apply log2_up_unique; trivial. split; try order. apply pow_lt_mono_r; try order'. rewrite <- (lt_succ_pred 0 a Ha) at 2. now apply lt_succ_r. - now rewrite <- Ha, pow_0_r, log2_up_eqn0. Qed. (** [log2_up] and successors of powers of 2 *) Lemma log2_up_succ_pow2 : forall a, 0<=a -> log2_up (S (2^a)) == S a. Proof. intros a Ha. rewrite log2_up_eqn, pred_succ, log2_pow2; try easy. rewrite one_succ, <- succ_lt_mono. apply pow_pos_nonneg; order'. Qed. (** Basic constants *) Lemma log2_up_1 : log2_up 1 == 0. Proof. now apply log2_up_eqn0. Qed. Lemma log2_up_2 : log2_up 2 == 1. Proof. rewrite <- (pow_1_r 2). apply log2_up_pow2; order'. Qed. (** Links between log2 and [log2_up] *) Lemma le_log2_log2_up : forall a, log2 a <= log2_up a. Proof. intros a. unfold log2_up. case compare_spec; intros H. - rewrite <- H, log2_1. order. - rewrite <- (lt_succ_pred 1 a H) at 1. apply log2_succ_le. - rewrite log2_nonpos. + order. + now rewrite <-lt_succ_r, <-one_succ. Qed. Lemma le_log2_up_succ_log2 : forall a, log2_up a <= S (log2 a). Proof. intros a. unfold log2_up. case compare_spec; intros H; try order_pos. rewrite <- succ_le_mono. apply log2_le_mono. rewrite <- (lt_succ_pred 1 a H) at 2. apply le_succ_diag_r. Qed. Lemma log2_log2_up_spec : forall a, 0 2^log2 a <= a <= 2^log2_up a. Proof. intros a H. split. - now apply log2_spec. - rewrite <-le_succ_l, <-one_succ in H. le_elim H. + now apply log2_up_spec. + now rewrite <-H, log2_up_1, pow_0_r. Qed. Lemma log2_log2_up_exact : forall a, 0 (log2 a == log2_up a <-> exists b, a == 2^b). Proof. intros a Ha. split. - intros H. exists (log2 a). generalize (log2_log2_up_spec a Ha). rewrite <-H. destruct 1; order. - intros (b,Hb). rewrite Hb. destruct (le_gt_cases 0 b). + now rewrite log2_pow2, log2_up_pow2. + rewrite pow_neg_r; trivial. now rewrite log2_nonpos, log2_up_nonpos. Qed. (** [log2_up] n is strictly positive for 1 0 < log2_up a. Proof. intros. rewrite log2_up_eqn; trivial. apply lt_succ_r; order_pos. Qed. (** Said otherwise, [log2_up] is null only below 1 *) Lemma log2_up_null : forall a, log2_up a == 0 <-> a <= 1. Proof. intros a. split; intros H. - destruct (le_gt_cases a 1) as [Ha|Ha]; trivial. generalize (log2_up_pos a Ha); order. - now apply log2_up_eqn0. Qed. (** [log2_up] is a monotone function (but not a strict one) *) Lemma log2_up_le_mono : forall a b, a<=b -> log2_up a <= log2_up b. Proof. intros a b H. destruct (le_gt_cases a 1) as [Ha|Ha]. - rewrite log2_up_eqn0; trivial. apply log2_up_nonneg. - rewrite 2 log2_up_eqn; try order. rewrite <- succ_le_mono. apply log2_le_mono, succ_le_mono. rewrite 2 lt_succ_pred with 1; order. Qed. (** No reverse result for <=, consider for instance log2_up 4 <= log2_up 3 *) Lemma log2_up_lt_cancel : forall a b, log2_up a < log2_up b -> a < b. Proof. intros a b H. destruct (le_gt_cases b 1) as [Hb|Hb]. - rewrite (log2_up_eqn0 b) in H; trivial. generalize (log2_up_nonneg a); order. - destruct (le_gt_cases a 1) as [Ha|Ha]. + order. + rewrite 2 log2_up_eqn in H; try order. rewrite <- succ_lt_mono in H. apply log2_lt_cancel, succ_lt_mono in H. rewrite 2 lt_succ_pred with 1 in H; order. Qed. (** When left side is a power of 2, we have an equivalence for < *) Lemma log2_up_lt_pow2 : forall a b, 0 (2^b b < log2_up a). Proof. intros a b Ha. split; intros H. - destruct (lt_ge_cases b 0) as [Hb|Hb]. + generalize (log2_up_nonneg a); order. + apply (pow_lt_mono_r_iff 2). * order'. * apply log2_up_nonneg. * apply lt_le_trans with a; trivial. apply (log2_up_spec a). apply le_lt_trans with (2^b); trivial. rewrite one_succ, le_succ_l. apply pow_pos_nonneg; order'. - destruct (lt_ge_cases b 0) as [Hb|Hb]. + now rewrite pow_neg_r. + rewrite <- (log2_up_pow2 b) in H; trivial. now apply log2_up_lt_cancel. Qed. (** When right side is a square, we have an equivalence for <= *) Lemma log2_up_le_pow2 : forall a b, 0 (a<=2^b <-> log2_up a <= b). Proof. intros a b Ha. split; intros H. - destruct (lt_ge_cases b 0) as [Hb|Hb]. + rewrite pow_neg_r in H; order. + rewrite <- (log2_up_pow2 b); trivial. now apply log2_up_le_mono. - transitivity (2^(log2_up a)). + now apply log2_log2_up_spec. + apply pow_le_mono_r; order'. Qed. (** Comparing [log2_up] and identity *) Lemma log2_up_lt_lin : forall a, 0 log2_up a < a. Proof. intros a Ha. assert (H : S (P a) == a) by (now apply lt_succ_pred with 0). rewrite <- H at 2. apply lt_succ_r. apply log2_up_le_pow2; trivial. rewrite <- H at 1. apply le_succ_l. apply pow_gt_lin_r. - order'. - apply lt_succ_r; order. Qed. Lemma log2_up_le_lin : forall a, 0<=a -> log2_up a <= a. Proof. intros a Ha. le_elim Ha. - now apply lt_le_incl, log2_up_lt_lin. - rewrite <- Ha, log2_up_nonpos; order. Qed. (** [log2_up] and multiplication. *) (** Due to rounding error, we don't have the usual [log2_up (a*b) = log2_up a + log2_up b] but we may be off by 1 at most *) Lemma log2_up_mul_above : forall a b, 0<=a -> 0<=b -> log2_up (a*b) <= log2_up a + log2_up b. Proof. intros a b Ha Hb. assert (Ha':=log2_up_nonneg a). assert (Hb':=log2_up_nonneg b). le_elim Ha. - le_elim Hb. + apply log2_up_le_pow2; try order_pos. rewrite pow_add_r; trivial. apply mul_le_mono_nonneg; try apply log2_log2_up_spec; order'. + rewrite <- Hb. nzsimpl. rewrite log2_up_nonpos; order_pos. - rewrite <- Ha. nzsimpl. rewrite log2_up_nonpos; order_pos. Qed. Lemma log2_up_mul_below : forall a b, 0 0 log2_up a + log2_up b <= S (log2_up (a*b)). Proof. intros a b Ha Hb. rewrite <-le_succ_l, <-one_succ in Ha. le_elim Ha. - rewrite <-le_succ_l, <-one_succ in Hb. le_elim Hb. + assert (Ha' : 0 < log2_up a) by (apply log2_up_pos; trivial). assert (Hb' : 0 < log2_up b) by (apply log2_up_pos; trivial). rewrite <- (lt_succ_pred 0 (log2_up a)); trivial. rewrite <- (lt_succ_pred 0 (log2_up b)); trivial. nzsimpl. rewrite <- succ_le_mono, le_succ_l. apply (pow_lt_mono_r_iff 2). * order'. * apply log2_up_nonneg. * rewrite pow_add_r; try (apply lt_succ_r; rewrite (lt_succ_pred 0); trivial). apply lt_le_trans with (a*b). -- apply mul_lt_mono_nonneg; try order_pos; try now apply log2_up_spec. -- apply log2_up_spec. setoid_replace 1 with (1*1) by now nzsimpl. apply mul_lt_mono_nonneg; order'. + rewrite <- Hb, log2_up_1; nzsimpl. apply le_succ_diag_r. - rewrite <- Ha, log2_up_1; nzsimpl. apply le_succ_diag_r. Qed. (** And we can't find better approximations in general. - The upper bound is exact for powers of 2. - Concerning the lower bound, for any c>1, take a=b=2^c+1, then [log2_up (a*b) = c+c +1] while [(log2_up a) = (log2_up b) = c+1] *) (** At least, we get back the usual equation when we multiply by 2 (or 2^k) *) Lemma log2_up_mul_pow2 : forall a b, 0 0<=b -> log2_up (a*2^b) == b + log2_up a. Proof. intros a b Ha Hb. rewrite <- le_succ_l, <- one_succ in Ha; le_elim Ha. - apply log2_up_unique. + apply add_nonneg_pos; trivial. now apply log2_up_pos. + split. * assert (EQ := lt_succ_pred 0 _ (log2_up_pos _ Ha)). rewrite <- EQ. nzsimpl. rewrite pow_add_r, mul_comm; trivial. -- apply mul_lt_mono_pos_r. ++ order_pos. ++ now apply log2_up_spec. -- rewrite <- lt_succ_r, EQ. now apply log2_up_pos. * rewrite pow_add_r, mul_comm; trivial. -- apply mul_le_mono_nonneg_l. ++ order_pos. ++ now apply log2_up_spec. -- apply log2_up_nonneg. - now rewrite <- Ha, mul_1_l, log2_up_1, add_0_r, log2_up_pow2. Qed. Lemma log2_up_double : forall a, 0 log2_up (2*a) == S (log2_up a). Proof. intros a Ha. generalize (log2_up_mul_pow2 a 1 Ha le_0_1). now nzsimpl'. Qed. (** Two numbers with same [log2_up] cannot be far away. *) Lemma log2_up_same : forall a b, 0 0 log2_up a == log2_up b -> a < 2*b. Proof. intros a b Ha Hb H. apply log2_up_lt_cancel. rewrite log2_up_double, H by trivial. apply lt_succ_diag_r. Qed. (** [log2_up] and successor : - the [log2_up] function climbs by at most 1 at a time - otherwise it stays at the same value - the +1 steps occur after powers of two *) Lemma log2_up_succ_le : forall a, log2_up (S a) <= S (log2_up a). Proof. intros a. destruct (lt_trichotomy 1 a) as [LT|[EQ|LT]]. - rewrite 2 log2_up_eqn; trivial. + rewrite pred_succ, <- succ_le_mono. rewrite <-(lt_succ_pred 1 a LT) at 1. apply log2_succ_le. + apply lt_succ_r; order. - rewrite <- EQ, <- two_succ, log2_up_1, log2_up_2. now nzsimpl'. - rewrite 2 log2_up_eqn0. + order_pos. + order'. + now rewrite le_succ_l. Qed. Lemma log2_up_succ_or : forall a, log2_up (S a) == S (log2_up a) \/ log2_up (S a) == log2_up a. Proof. intros a. destruct (le_gt_cases (log2_up (S a)) (log2_up a)) as [H|H]. - right. generalize (log2_up_le_mono _ _ (le_succ_diag_r a)); order. - left. apply le_succ_l in H. generalize (log2_up_succ_le a); order. Qed. Lemma log2_up_eq_succ_is_pow2 : forall a, log2_up (S a) == S (log2_up a) -> exists b, a == 2^b. Proof. intros a H. destruct (le_gt_cases a 0) as [Ha|Ha]. - rewrite 2 (proj2 (log2_up_null _)) in H. + generalize (lt_succ_diag_r 0); order. + order'. + apply le_succ_l. order'. - assert (Ha' : 1 < S a) by (now rewrite one_succ, <- succ_lt_mono). exists (log2_up a). generalize (proj1 (log2_up_spec (S a) Ha')) (proj2 (log2_log2_up_spec a Ha)). rewrite H, pred_succ, lt_succ_r. order. Qed. Lemma log2_up_eq_succ_iff_pow2 : forall a, 0 (log2_up (S a) == S (log2_up a) <-> exists b, a == 2^b). Proof. intros a Ha. split. - apply log2_up_eq_succ_is_pow2. - intros (b,Hb). destruct (lt_ge_cases b 0) as [Hb'|Hb']. + rewrite pow_neg_r in Hb; order. + rewrite Hb, log2_up_pow2; try order'. now rewrite log2_up_succ_pow2. Qed. Lemma log2_up_succ_double : forall a, 0 log2_up (2*a+1) == 2 + log2 a. Proof. intros a Ha. rewrite log2_up_eqn. - rewrite add_1_r, pred_succ, log2_double; now nzsimpl'. - apply le_lt_trans with (0+1). + now nzsimpl'. + apply add_lt_mono_r. order_pos. Qed. (** [log2_up] and addition *) Lemma log2_up_add_le : forall a b, a~=1 -> b~=1 -> log2_up (a+b) <= log2_up a + log2_up b. Proof. intros a b Ha Hb. destruct (lt_trichotomy a 1) as [Ha'|[Ha'|Ha']]; [|order|]. - rewrite (log2_up_eqn0 a) by order. nzsimpl. apply log2_up_le_mono. rewrite one_succ, lt_succ_r in Ha'. rewrite <- (add_0_l b) at 2. now apply add_le_mono. - destruct (lt_trichotomy b 1) as [Hb'|[Hb'|Hb']]; [|order|]. + rewrite (log2_up_eqn0 b) by order. nzsimpl. apply log2_up_le_mono. rewrite one_succ, lt_succ_r in Hb'. rewrite <- (add_0_r a) at 2. now apply add_le_mono. + clear Ha Hb. transitivity (log2_up (a*b)). * now apply log2_up_le_mono, add_le_mul. * apply log2_up_mul_above; order'. Qed. (** The sum of two [log2_up] is less than twice the [log2_up] of the sum. The large inequality is obvious thanks to monotonicity. The strict one requires some more work. This is almost a convexity inequality for points [2a], [2b] and their middle [a+b] : ideally, we would have [2*log(a+b) >= log(2a)+log(2b) = 2+log a+log b]. Here, we cannot do better: consider for instance a=3 b=5, then 2+3<2*3 *) Lemma add_log2_up_lt : forall a b, 0 0 log2_up a + log2_up b < 2 * log2_up (a+b). Proof. intros a b Ha Hb. nzsimpl'. assert (H : log2_up a <= log2_up (a+b)). - apply log2_up_le_mono. rewrite <- (add_0_r a) at 1. apply add_le_mono; order. - assert (H' : log2_up b <= log2_up (a+b)). + apply log2_up_le_mono. rewrite <- (add_0_l b) at 1. apply add_le_mono; order. + le_elim H. * apply lt_le_trans with (log2_up (a+b) + log2_up b). -- now apply add_lt_mono_r. -- now apply add_le_mono_l. * rewrite <- H at 1. apply add_lt_mono_l. le_elim H'. -- trivial. -- symmetry in H. apply log2_up_same in H; try order_pos. symmetry in H'. apply log2_up_same in H'; try order_pos. revert H H'. nzsimpl'. rewrite <- add_lt_mono_l, <- add_lt_mono_r; order. Qed. End NZLog2UpProp. coq-8.20.0/theories/Numbers/NatInt/NZMul.v000066400000000000000000000066551466560755400202470ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* (p * n < p * m <-> q * n + m < q * m + n). Proof. intros p q n m H. rewrite <- H. nzsimpl. rewrite <- ! add_assoc, (add_comm n m). now rewrite <- add_lt_mono_r. Qed. Theorem mul_lt_mono_pos_l : forall p n m, 0 < p -> (n < m <-> p * n < p * m). Proof. intros p n m Hp. revert n m. apply lt_ind with (4:=Hp). - solve_proper. - intros. now nzsimpl. - clear p Hp. intros p Hp IH n m. nzsimpl. assert (LR : forall n m, n < m -> p * n + n < p * m + m) by (intros n1 m1 H; apply add_lt_mono; trivial; now rewrite <- IH). split; intros H. + now apply LR. + destruct (lt_trichotomy n m) as [LT|[EQ|GT]]; trivial. * rewrite EQ in H. order. * apply LR in GT. order. Qed. Theorem mul_lt_mono_pos_r : forall p n m, 0 < p -> (n < m <-> n * p < m * p). Proof. intros p n m. rewrite (mul_comm n p), (mul_comm m p). now apply mul_lt_mono_pos_l. Qed. Theorem mul_lt_mono_neg_l : forall p n m, p < 0 -> (n < m <-> p * m < p * n). Proof. intro p; nzord_induct p. - order. - intros p Hp _ n m Hp'. apply lt_succ_l in Hp'. order. - intros p Hp IH n m _. apply le_succ_l in Hp. le_elim Hp. + assert (LR : forall n m, n < m -> p * m < p * n). * intros n1 m1 H. apply (le_lt_add_lt n1 m1). -- now apply lt_le_incl. -- rewrite <- 2 mul_succ_l. now rewrite <- IH. * split; intros H. -- now apply LR. -- destruct (lt_trichotomy n m) as [LT|[EQ|GT]]; trivial. ++ rewrite EQ in H. order. ++ apply LR in GT. order. + rewrite (mul_lt_pred p (S p)), Hp; now nzsimpl. Qed. Theorem mul_lt_mono_neg_r : forall p n m, p < 0 -> (n < m <-> m * p < n * p). Proof. intros p n m. rewrite (mul_comm n p), (mul_comm m p). now apply mul_lt_mono_neg_l. Qed. Theorem mul_le_mono_nonneg_l : forall n m p, 0 <= p -> n <= m -> p * n <= p * m. Proof. intros n m p H1 H2. le_elim H1. - le_elim H2. + apply lt_le_incl. now apply mul_lt_mono_pos_l. + apply eq_le_incl; now rewrite H2. - apply eq_le_incl; rewrite <- H1; now do 2 rewrite mul_0_l. Qed. Theorem mul_le_mono_nonpos_l : forall n m p, p <= 0 -> n <= m -> p * m <= p * n. Proof. intros n m p H1 H2. le_elim H1. - le_elim H2. + apply lt_le_incl. now apply mul_lt_mono_neg_l. + apply eq_le_incl; now rewrite H2. - apply eq_le_incl; rewrite H1; now do 2 rewrite mul_0_l. Qed. Theorem mul_le_mono_nonneg_r : forall n m p, 0 <= p -> n <= m -> n * p <= m * p. Proof. intros n m p H1 H2; rewrite (mul_comm n p), (mul_comm m p); now apply mul_le_mono_nonneg_l. Qed. Theorem mul_le_mono_nonpos_r : forall n m p, p <= 0 -> n <= m -> m * p <= n * p. Proof. intros n m p H1 H2; rewrite (mul_comm n p), (mul_comm m p); now apply mul_le_mono_nonpos_l. Qed. Theorem mul_cancel_l : forall n m p, p ~= 0 -> (p * n == p * m <-> n == m). Proof. intros n m p Hp; split; intro H; [|now f_equiv]. apply lt_gt_cases in Hp; destruct Hp as [Hp|Hp]; destruct (lt_trichotomy n m) as [LT|[EQ|GT]]; trivial. - apply (mul_lt_mono_neg_l p) in LT; order. - apply (mul_lt_mono_neg_l p) in GT; order. - apply (mul_lt_mono_pos_l p) in LT; order. - apply (mul_lt_mono_pos_l p) in GT; order. Qed. Theorem mul_cancel_r : forall n m p, p ~= 0 -> (n * p == m * p <-> n == m). Proof. intros n m p. rewrite (mul_comm n p), (mul_comm m p); apply mul_cancel_l. Qed. Theorem mul_id_l : forall n m, m ~= 0 -> (n * m == m <-> n == 1). Proof. intros n m H. stepl (n * m == 1 * m) by now rewrite mul_1_l. now apply mul_cancel_r. Qed. Theorem mul_id_r : forall n m, n ~= 0 -> (n * m == n <-> m == 1). Proof. intros n m; rewrite mul_comm; apply mul_id_l. Qed. Theorem mul_le_mono_pos_l : forall n m p, 0 < p -> (n <= m <-> p * n <= p * m). Proof. intros n m p H; do 2 rewrite lt_eq_cases. rewrite (mul_lt_mono_pos_l p n m) by assumption. now rewrite -> (mul_cancel_l n m p) by (intro H1; rewrite H1 in H; false_hyp H lt_irrefl). Qed. Theorem mul_le_mono_pos_r : forall n m p, 0 < p -> (n <= m <-> n * p <= m * p). Proof. intros n m p. rewrite (mul_comm n p), (mul_comm m p); apply mul_le_mono_pos_l. Qed. Theorem mul_le_mono_neg_l : forall n m p, p < 0 -> (n <= m <-> p * m <= p * n). Proof. intros n m p H; do 2 rewrite lt_eq_cases. rewrite (mul_lt_mono_neg_l p n m); [| assumption]. rewrite -> (mul_cancel_l m n p) by (intro H1; rewrite H1 in H; false_hyp H lt_irrefl). now setoid_replace (n == m) with (m == n) by (split; now intro). Qed. Theorem mul_le_mono_neg_r : forall n m p, p < 0 -> (n <= m <-> m * p <= n * p). Proof. intros n m p. rewrite (mul_comm n p), (mul_comm m p); apply mul_le_mono_neg_l. Qed. Theorem mul_lt_mono_nonneg : forall n m p q, 0 <= n -> n < m -> 0 <= p -> p < q -> n * p < m * q. Proof. intros n m p q H1 H2 H3 H4. apply le_lt_trans with (m * p). - apply mul_le_mono_nonneg_r; [assumption | now apply lt_le_incl]. - apply -> mul_lt_mono_pos_l; [assumption | now apply le_lt_trans with n]. Qed. (* There are still many variants of the theorem above. One can assume 0 < n or 0 < p or n <= m or p <= q. *) Theorem mul_le_mono_nonneg : forall n m p q, 0 <= n -> n <= m -> 0 <= p -> p <= q -> n * p <= m * q. Proof. intros n m p q H1 H2 H3 H4. le_elim H2; le_elim H4. - apply lt_le_incl; now apply mul_lt_mono_nonneg. - rewrite <- H4; apply mul_le_mono_nonneg_r; [assumption | now apply lt_le_incl]. - rewrite <- H2; apply mul_le_mono_nonneg_l; [assumption | now apply lt_le_incl]. - rewrite H2; rewrite H4; now apply eq_le_incl. Qed. Theorem mul_pos_pos : forall n m, 0 < n -> 0 < m -> 0 < n * m. Proof. intros n m H1 H2. rewrite <- (mul_0_l m). now apply mul_lt_mono_pos_r. Qed. Theorem mul_neg_neg : forall n m, n < 0 -> m < 0 -> 0 < n * m. Proof. intros n m H1 H2. rewrite <- (mul_0_l m). now apply mul_lt_mono_neg_r. Qed. Theorem mul_pos_neg : forall n m, 0 < n -> m < 0 -> n * m < 0. Proof. intros n m H1 H2. rewrite <- (mul_0_l m). now apply mul_lt_mono_neg_r. Qed. Theorem mul_neg_pos : forall n m, n < 0 -> 0 < m -> n * m < 0. Proof. intros; rewrite mul_comm; now apply mul_pos_neg. Qed. Theorem mul_nonneg_nonneg : forall n m, 0 <= n -> 0 <= m -> 0 <= n*m. Proof. intros n m Hn Hm. rewrite <- (mul_0_l m). apply mul_le_mono_nonneg; order. Qed. Theorem mul_pos_cancel_l : forall n m, 0 < n -> (0 < n*m <-> 0 < m). Proof. intros n m Hn. rewrite <- (mul_0_r n) at 1. symmetry. now apply mul_lt_mono_pos_l. Qed. Theorem mul_pos_cancel_r : forall n m, 0 < m -> (0 < n*m <-> 0 < n). Proof. intros n m Hn. rewrite <- (mul_0_l m) at 1. symmetry. now apply mul_lt_mono_pos_r. Qed. Theorem mul_nonneg_cancel_l : forall n m, 0 < n -> (0 <= n*m <-> 0 <= m). Proof. intros n m Hn. rewrite <- (mul_0_r n) at 1. symmetry. now apply mul_le_mono_pos_l. Qed. Theorem mul_nonneg_cancel_r : forall n m, 0 < m -> (0 <= n*m <-> 0 <= n). Proof. intros n m Hn. rewrite <- (mul_0_l m) at 1. symmetry. now apply mul_le_mono_pos_r. Qed. Theorem lt_1_mul_pos : forall n m, 1 < n -> 0 < m -> 1 < n * m. Proof. intros n m H1 H2. apply (mul_lt_mono_pos_r m) in H1. - rewrite mul_1_l in H1. now apply lt_1_l with m. - assumption. Qed. Theorem eq_mul_0 : forall n m, n * m == 0 <-> n == 0 \/ m == 0. Proof. intros n m; split. - intro H; destruct (lt_trichotomy n 0) as [H1 | [H1 | H1]]; destruct (lt_trichotomy m 0) as [H2 | [H2 | H2]]; try (now right); try (now left). + exfalso; now apply (lt_neq 0 (n * m)); [apply mul_neg_neg |]. + exfalso; now apply (lt_neq (n * m) 0); [apply mul_neg_pos |]. + exfalso; now apply (lt_neq (n * m) 0); [apply mul_pos_neg |]. + exfalso; now apply (lt_neq 0 (n * m)); [apply mul_pos_pos |]. - intros [H | H]. + now rewrite H, mul_0_l. + now rewrite H, mul_0_r. Qed. Theorem neq_mul_0 : forall n m, n ~= 0 /\ m ~= 0 <-> n * m ~= 0. Proof. intros n m; split; intro H. - intro H1; apply eq_mul_0 in H1. tauto. - split; intro H1; rewrite H1 in H; (rewrite mul_0_l in H || rewrite mul_0_r in H); now apply H. Qed. Theorem eq_square_0 : forall n, n * n == 0 <-> n == 0. Proof. intro n; rewrite eq_mul_0; tauto. Qed. Theorem eq_mul_0_l : forall n m, n * m == 0 -> m ~= 0 -> n == 0. Proof. intros n m H1 H2. apply eq_mul_0 in H1. destruct H1 as [H1 | H1]. - assumption. - false_hyp H1 H2. Qed. Theorem eq_mul_0_r : forall n m, n * m == 0 -> n ~= 0 -> m == 0. Proof. intros n m H1 H2; apply eq_mul_0 in H1. destruct H1 as [H1 | H1]. - false_hyp H1 H2. - assumption. Qed. (* Some alternative names: *) Notation mul_eq_0 := eq_mul_0. Notation mul_eq_0_l := eq_mul_0_l. Notation mul_eq_0_r := eq_mul_0_r. Theorem lt_0_mul n m : 0 < n * m <-> (0 < n /\ 0 < m) \/ (m < 0 /\ n < 0). Proof. split; [intro H | intros [[H1 H2] | [H1 H2]]]. - destruct (lt_trichotomy n 0) as [H1 | [H1 | H1]]; [| rewrite H1 in H; rewrite mul_0_l in H; false_hyp H lt_irrefl |]; (destruct (lt_trichotomy m 0) as [H2 | [H2 | H2]]; [| rewrite H2 in H; rewrite mul_0_r in H; false_hyp H lt_irrefl |]); try (left; now split); try (right; now split). + assert (H3 : n * m < 0) by now apply mul_neg_pos. exfalso; now apply (lt_asymm (n * m) 0). + assert (H3 : n * m < 0) by now apply mul_pos_neg. exfalso; now apply (lt_asymm (n * m) 0). - now apply mul_pos_pos. - now apply mul_neg_neg. Qed. Theorem square_lt_mono_nonneg : forall n m, 0 <= n -> n < m -> n * n < m * m. Proof. intros n m H1 H2. now apply mul_lt_mono_nonneg. Qed. Theorem square_le_mono_nonneg : forall n m, 0 <= n -> n <= m -> n * n <= m * m. Proof. intros n m H1 H2. now apply mul_le_mono_nonneg. Qed. (* The converse theorems require nonnegativity (or nonpositivity) of the other variable *) Theorem square_lt_simpl_nonneg : forall n m, 0 <= m -> n * n < m * m -> n < m. Proof. intros n m H1 H2. destruct (lt_ge_cases n 0). - now apply lt_le_trans with 0. - destruct (lt_ge_cases n m) as [LT|LE]; trivial. apply square_le_mono_nonneg in LE; order. Qed. Theorem square_le_simpl_nonneg : forall n m, 0 <= m -> n * n <= m * m -> n <= m. Proof. intros n m H1 H2. destruct (lt_ge_cases n 0). - apply lt_le_incl; now apply lt_le_trans with 0. - destruct (le_gt_cases n m) as [LE|LT]; trivial. apply square_lt_mono_nonneg in LT; order. Qed. Theorem mul_2_mono_l : forall n m, n < m -> 1 + 2 * n < 2 * m. Proof. intros n m. rewrite <- le_succ_l, (mul_le_mono_pos_l (S n) m two). - rewrite two_succ. nzsimpl. now rewrite le_succ_l. - order'. Qed. Lemma add_le_mul : forall a b, 1 1 a+b <= a*b. Proof. assert (AUX : forall a b, 0 0 (S a)+(S b) <= (S a)*(S b)). - intros a b Ha Hb. nzsimpl. rewrite <- succ_le_mono. apply le_succ_l. rewrite <- add_assoc, <- (add_0_l (a+b)), (add_comm b). apply add_lt_mono_r. now apply mul_pos_pos. - intros a b Ha Hb. assert (Ha' := lt_succ_pred 1 a Ha). assert (Hb' := lt_succ_pred 1 b Hb). rewrite <- Ha', <- Hb'. apply AUX; rewrite succ_lt_mono, <- one_succ; order. Qed. (** A few results about squares *) Lemma square_nonneg : forall a, 0 <= a * a. Proof. intro a. rewrite <- (mul_0_r a). destruct (le_gt_cases a 0). - now apply mul_le_mono_nonpos_l. - apply mul_le_mono_nonneg_l; order. Qed. Lemma crossmul_le_addsquare : forall a b, 0<=a -> 0<=b -> b*a+a*b <= a*a+b*b. Proof. assert (AUX : forall a b, 0<=a<=b -> b*a+a*b <= a*a+b*b). - intros a b (Ha,H). destruct (le_exists_sub _ _ H) as (d & EQ & Hd). rewrite EQ. rewrite 2 mul_add_distr_r. rewrite !add_assoc. apply add_le_mono_r. rewrite add_comm. apply add_le_mono_l. apply mul_le_mono_nonneg_l; trivial. order. - intros a b Ha Hb. destruct (le_gt_cases a b). + apply AUX; split; order. + rewrite (add_comm (b*a)), (add_comm (a*a)). apply AUX; split; order. Qed. Lemma add_square_le : forall a b, 0<=a -> 0<=b -> a*a + b*b <= (a+b)*(a+b). Proof. intros a b Ha Hb. rewrite mul_add_distr_r, !mul_add_distr_l. rewrite add_assoc. apply add_le_mono_r. rewrite <- add_assoc. rewrite <- (add_0_r (a*a)) at 1. apply add_le_mono_l. apply add_nonneg_nonneg; now apply mul_nonneg_nonneg. Qed. Lemma square_add_le : forall a b, 0<=a -> 0<=b -> (a+b)*(a+b) <= 2*(a*a + b*b). Proof. intros a b Ha Hb. rewrite !mul_add_distr_l, !mul_add_distr_r. nzsimpl'. rewrite <- !add_assoc. apply add_le_mono_l. rewrite !add_assoc. apply add_le_mono_r. apply crossmul_le_addsquare; order. Qed. Lemma quadmul_le_squareadd : forall a b, 0<=a -> 0<=b -> 2*2*a*b <= (a+b)*(a+b). Proof. intros a b Ha Hb. nzsimpl'. rewrite !mul_add_distr_l, !mul_add_distr_r. rewrite (add_comm _ (b*b)), add_assoc. apply add_le_mono_r. rewrite (add_shuffle0 (a*a)), (mul_comm b a). apply add_le_mono_r. rewrite (mul_comm a b) at 1. now apply crossmul_le_addsquare. Qed. End NZMulOrderProp. coq-8.20.0/theories/Numbers/NatInt/NZOrder.v000066400000000000000000000451651466560755400205640ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* eq==>iff) le. Proof. intros n n' Hn m m' Hm. now rewrite <- !lt_succ_r, Hn, Hm. Qed. Ltac le_elim H := rewrite lt_eq_cases in H; destruct H as [H | H]. Theorem lt_le_incl : forall n m, n < m -> n <= m. Proof. intros. apply lt_eq_cases. now left. Qed. Theorem le_refl : forall n, n <= n. Proof. intro. apply lt_eq_cases. now right. Qed. Theorem lt_succ_diag_r : forall n, n < S n. Proof. intro n. rewrite lt_succ_r. apply le_refl. Qed. Theorem le_succ_diag_r : forall n, n <= S n. Proof. intro; apply lt_le_incl; apply lt_succ_diag_r. Qed. Theorem neq_succ_diag_l : forall n, S n ~= n. Proof. intros n H. apply (lt_irrefl n). rewrite <- H at 2. apply lt_succ_diag_r. Qed. Theorem neq_succ_diag_r : forall n, n ~= S n. Proof. intro n; apply neq_sym, neq_succ_diag_l. Qed. Theorem nlt_succ_diag_l : forall n, ~ S n < n. Proof. intros n H. apply (lt_irrefl (S n)). rewrite lt_succ_r. now apply lt_le_incl. Qed. Theorem nle_succ_diag_l : forall n, ~ S n <= n. Proof. intros n H; le_elim H. + false_hyp H nlt_succ_diag_l. + false_hyp H neq_succ_diag_l. Qed. Theorem le_succ_l : forall n m, S n <= m <-> n < m. Proof. intros n m; nzinduct m n. - split; intro H. + false_hyp H nle_succ_diag_l. + false_hyp H lt_irrefl. - intro m. rewrite (lt_eq_cases (S n) (S m)), !lt_succ_r, (lt_eq_cases n m), succ_inj_wd. rewrite or_cancel_r. + reflexivity. + intros LE EQ; rewrite EQ in LE; false_hyp LE nle_succ_diag_l. + intros LT EQ; rewrite EQ in LT; false_hyp LT lt_irrefl. Qed. (** Trichotomy *) Theorem le_gt_cases : forall n m, n <= m \/ n > m. Proof. intros n m; nzinduct n m. - left; apply le_refl. - intro n. rewrite lt_succ_r, le_succ_l, !lt_eq_cases. intuition auto with relations. Qed. Theorem lt_trichotomy : forall n m, n < m \/ n == m \/ m < n. Proof. intros n m. generalize (le_gt_cases n m); rewrite lt_eq_cases; tauto. Qed. Notation lt_eq_gt_cases := lt_trichotomy (only parsing). (** *** Asymmetry and transitivity. *) Theorem lt_asymm : forall n m, n < m -> ~ m < n. Proof. intros n m; nzinduct n m. - intros H; false_hyp H lt_irrefl. - intro n; split; intros H H1 H2. + apply lt_succ_r in H2. le_elim H2. * apply H; auto. apply le_succ_l. now apply lt_le_incl. * rewrite H2 in H1. false_hyp H1 nlt_succ_diag_l. + apply le_succ_l in H1. le_elim H1. * apply H; auto. rewrite lt_succ_r. now apply lt_le_incl. * rewrite <- H1 in H2. false_hyp H2 nlt_succ_diag_l. Qed. Notation lt_ngt := lt_asymm (only parsing). Theorem lt_trans : forall n m p, n < m -> m < p -> n < p. Proof. intros n m p; nzinduct p m. - intros _ H; false_hyp H lt_irrefl. - intro p. rewrite 2 lt_succ_r. split; intros H H1 H2. + apply lt_le_incl; le_elim H2; [now apply H | now rewrite H2 in H1]. + assert (n <= p) as H3 by (auto using lt_le_incl). le_elim H3. * assumption. * rewrite <- H3 in H2. elim (lt_asymm n m); auto. Qed. Theorem le_trans : forall n m p, n <= m -> m <= p -> n <= p. Proof. intros n m p. rewrite 3 lt_eq_cases. intros [LT|EQ] [LT'|EQ']; try rewrite EQ; try rewrite <- EQ'; generalize (lt_trans n m p); auto with relations. Qed. (** *** Some type classes about order *) #[global] Instance lt_strorder : StrictOrder lt. Proof. split. - exact lt_irrefl. - exact lt_trans. Qed. #[global] Instance le_preorder : PreOrder le. Proof. split. - exact le_refl. - exact le_trans. Qed. #[global] Instance le_partialorder : PartialOrder _ le. Proof. intros x y. compute. split. - intro EQ; now rewrite EQ. - rewrite 2 lt_eq_cases. intuition auto with relations. elim (lt_irrefl x). now transitivity y. Qed. (** *** Making the generic [order] tactic *) Definition lt_compat := lt_wd. Definition lt_total := lt_trichotomy. Definition le_lteq := lt_eq_cases. Module Private_OrderTac. Module IsTotal. Definition eq_equiv := eq_equiv. Definition lt_strorder := lt_strorder. Definition lt_compat := lt_compat. Definition lt_total := lt_total. Definition le_lteq := le_lteq. End IsTotal. Module Tac := !MakeOrderTac NZ IsTotal. End Private_OrderTac. Ltac order := Private_OrderTac.Tac.order. (** *** Some direct consequences of [order] *) Theorem lt_neq : forall n m, n < m -> n ~= m. Proof. order. Qed. Theorem le_neq : forall n m, n < m <-> n <= m /\ n ~= m. Proof. intuition order. Qed. Theorem eq_le_incl : forall n m, n == m -> n <= m. Proof. order. Qed. Lemma lt_stepl : forall x y z, x < y -> x == z -> z < y. Proof. order. Qed. Lemma lt_stepr : forall x y z, x < y -> y == z -> x < z. Proof. order. Qed. Lemma le_stepl : forall x y z, x <= y -> x == z -> z <= y. Proof. order. Qed. Lemma le_stepr : forall x y z, x <= y -> y == z -> x <= z. Proof. order. Qed. Declare Left Step lt_stepl. Declare Right Step lt_stepr. Declare Left Step le_stepl. Declare Right Step le_stepr. Theorem le_lt_trans : forall n m p, n <= m -> m < p -> n < p. Proof. order. Qed. Theorem lt_le_trans : forall n m p, n < m -> m <= p -> n < p. Proof. order. Qed. Theorem le_antisymm : forall n m, n <= m -> m <= n -> n == m. Proof. order. Qed. (** *** More properties of [<] and [<=] with respect to [S] and [0] *) Theorem le_succ_r : forall n m, n <= S m <-> n <= m \/ n == S m. Proof. intros n m; rewrite lt_eq_cases. now rewrite lt_succ_r. Qed. Theorem lt_succ_l : forall n m, S n < m -> n < m. Proof. intros n m H; apply le_succ_l; order. Qed. Theorem le_le_succ_r : forall n m, n <= m -> n <= S m. Proof. intros n m LE. apply lt_succ_r in LE. order. Qed. Theorem lt_lt_succ_r : forall n m, n < m -> n < S m. Proof. intros. rewrite lt_succ_r. order. Qed. Theorem succ_lt_mono : forall n m, n < m <-> S n < S m. Proof. intros n m. rewrite <- le_succ_l. symmetry. apply lt_succ_r. Qed. Theorem succ_le_mono : forall n m, n <= m <-> S n <= S m. Proof. intros n m. now rewrite 2 lt_eq_cases, <- succ_lt_mono, succ_inj_wd. Qed. Theorem lt_0_1 : 0 < 1. Proof. rewrite one_succ. apply lt_succ_diag_r. Qed. Theorem le_0_1 : 0 <= 1. Proof. apply lt_le_incl, lt_0_1. Qed. Theorem lt_1_2 : 1 < 2. Proof. rewrite two_succ. apply lt_succ_diag_r. Qed. Theorem lt_0_2 : 0 < 2. Proof. transitivity 1. - apply lt_0_1. - apply lt_1_2. Qed. Theorem le_0_2 : 0 <= 2. Proof. apply lt_le_incl, lt_0_2. Qed. (** The order tactic enriched with some knowledge of 0,1,2 *) Ltac order' := generalize lt_0_1 lt_1_2; order. Theorem lt_1_l : forall n m, 0 < n -> n < m -> 1 < m. Proof. intros n m H1 H2. rewrite <- le_succ_l, <- one_succ in H1. order. Qed. (** *** More Trichotomy, decidability and double negation elimination *) (** The following theorem is cleary redundant, but helps not to remember whether one has to say [le_gt_cases] or [lt_ge_cases]. *) Theorem lt_ge_cases : forall n m, n < m \/ n >= m. Proof. intros n m; destruct (le_gt_cases m n); intuition order. Qed. Theorem le_ge_cases : forall n m, n <= m \/ n >= m. Proof. intros n m; destruct (le_gt_cases n m); intuition order. Qed. Theorem lt_gt_cases : forall n m, n ~= m <-> n < m \/ n > m. Proof. intros n m; destruct (lt_trichotomy n m); intuition order. Qed. (** Decidability of equality, even though true in each finite ring, does not have a uniform proof. Otherwise, the proof for two fixed numbers would reduce to a normal form that will say if the numbers are equal or not, which cannot be true in all finite rings. Therefore, we prove decidability in the presence of order. *) Theorem eq_decidable : forall n m, decidable (n == m). Proof. intros n m; destruct (lt_trichotomy n m) as [ | [ | ]]; (right; order) || (left; order). Qed. (** DNE stands for double-negation elimination. *) Theorem eq_dne : forall n m, ~ ~ n == m <-> n == m. Proof. intros n m; split; intro H. - destruct (eq_decidable n m) as [H1 | H1]. + assumption. + false_hyp H1 H. - intro H1; now apply H1. Qed. Theorem le_ngt : forall n m, n <= m <-> ~ n > m. Proof. intuition order. Qed. (** Redundant but useful *) Theorem nlt_ge : forall n m, ~ n < m <-> n >= m. Proof. intuition order. Qed. Theorem lt_decidable : forall n m, decidable (n < m). Proof. intros n m; destruct (le_gt_cases m n); [right|left]; order. Qed. Theorem lt_dne : forall n m, ~ ~ n < m <-> n < m. Proof. intros n m; split; intro H. - destruct (lt_decidable n m) as [H1 | H1]; [assumption | false_hyp H1 H]. - intro H1; false_hyp H H1. Qed. Theorem nle_gt : forall n m, ~ n <= m <-> n > m. Proof. intuition order. Qed. (** Redundant but useful *) Theorem lt_nge : forall n m, n < m <-> ~ n >= m. Proof. intuition order. Qed. Theorem le_decidable : forall n m, decidable (n <= m). Proof. intros n m; destruct (le_gt_cases n m); [left|right]; order. Qed. Theorem le_dne : forall n m, ~ ~ n <= m <-> n <= m. Proof. intros n m; split; intro H. - destruct (le_decidable n m) as [H1 | H1]; [assumption | false_hyp H1 H]. - intro H1; false_hyp H H1. Qed. Theorem nlt_succ_r : forall n m, ~ m < S n <-> n < m. Proof. intros n m; rewrite lt_succ_r. intuition order. Qed. (** The difference between integers and natural numbers is that for every integer there is a predecessor, which is not true for natural numbers. However, for both classes, every number that is bigger than some other number has a predecessor. The proof of this fact by regular induction does not go through, so we need to use strong (course-of-value) induction. *) Theorem lt_exists_pred : forall z n, z < n -> exists k, n == S k /\ z <= k. Proof. intros z n Hzn. assert (exists m, n <= m) as [m Hnm] by now exists n. revert n Hzn Hnm. nzinduct m z. - order. - intro m; split; intros IH n H1 H2. + apply le_succ_r in H2. destruct H2 as [H2 | H2]. * now apply IH. * exists m. now split; [| rewrite <- lt_succ_r; rewrite <- H2]. + apply IH. * assumption. * now apply le_le_succ_r. Qed. Lemma lt_succ_pred : forall z n, z < n -> S (P n) == n. Proof. intros z n H. destruct (lt_exists_pred _ _ H) as (n' & EQ & LE). rewrite EQ. now rewrite pred_succ. Qed. (** ** Order-based induction principles *) Section WF. Variable z : t. Let Rlt (n m : t) := z <= n < m. Let Rgt (n m : t) := m < n <= z. Instance Rlt_wd : Proper (eq ==> eq ==> iff) Rlt. Proof. intros x1 x2 H1 x3 x4 H2; unfold Rlt. now rewrite H1, H2. Qed. Instance Rgt_wd : Proper (eq ==> eq ==> iff) Rgt. Proof. intros x1 x2 H1 x3 x4 H2; unfold Rgt; now rewrite H1, H2. Qed. Theorem lt_wf : well_founded Rlt. Proof. intros a. constructor. revert a. refine (central_induction _ _ z _ _). - solve_proper. - intros y [??]. order. - intros x. split. + intros IH y [? [? | ->]%lt_succ_r%lt_eq_cases]. * now apply IH. * now constructor. + intros IH y [? ?%lt_lt_succ_r]. now apply IH. Qed. Theorem gt_wf : well_founded Rgt. Proof. intros a. constructor. revert a. refine (central_induction _ _ z _ _). - solve_proper. - intros y [??]. order. - intros x. split. + intros IH y [?%lt_succ_l ?]. now apply IH. + intros IH y [[? | <-]%le_succ_l%lt_eq_cases ?]. * now apply IH. * now constructor. Qed. End WF. (** Stronger variant of induction with assumptions [n >= 0] ([n < 0]) in the induction step *) Section Induction. Variable A : t -> Prop. Hypothesis A_wd : Proper (eq==>iff) A. Section Center. Variable z : t. (* A z is the basis of induction *) Section RightInduction. Let A' (n : t) := forall m, z <= m -> m < n -> A m. Let right_step := forall n, z <= n -> A n -> A (S n). Let right_step' := forall n, z <= n -> A' n -> A n. Let right_step'' := forall n, A' n <-> A' (S n). Theorem strong_right_induction: right_step' -> forall n, z <= n -> A n. Proof. intros Hstep. refine (well_founded_induction (lt_wf z) _ _). intros x IH Hzx. apply Hstep; [trivial|]. intros y ??. apply IH; [split|]; order. Qed. Theorem right_induction : A z -> right_step -> forall n, z <= n -> A n. Proof. intros Az RS; apply strong_right_induction. intros n H1 H2. le_elim H1. - apply lt_exists_pred in H1. destruct H1 as [k [H3 H4]]. rewrite H3. apply RS; trivial. apply H2; trivial. rewrite H3; apply lt_succ_diag_r. - rewrite <- H1; apply Az. Qed. Theorem right_induction' : (forall n, n <= z -> A n) -> right_step -> forall n, A n. Proof. intros L R n. destruct (lt_trichotomy n z) as [H | [H | H]]. - apply L; now apply lt_le_incl. - apply L; now apply eq_le_incl. - apply right_induction. + apply L; now apply eq_le_incl. + assumption. + now apply lt_le_incl. Qed. Theorem strong_right_induction' : (forall n, n <= z -> A n) -> right_step' -> forall n, A n. Proof. intros L R n. destruct (lt_trichotomy n z) as [H | [H | H]]. - apply L; now apply lt_le_incl. - apply L; now apply eq_le_incl. - apply strong_right_induction. + assumption. + now apply lt_le_incl. Qed. End RightInduction. Section LeftInduction. Let A' (n : t) := forall m, m <= z -> n <= m -> A m. Let left_step := forall n, n < z -> A (S n) -> A n. Let left_step' := forall n, n <= z -> A' (S n) -> A n. Let left_step'' := forall n, A' n <-> A' (S n). Theorem strong_left_induction: left_step' -> forall n, n <= z -> A n. Proof. intros Hstep. refine (well_founded_induction (gt_wf z) _ _). intros x IH Hzx. apply Hstep; [trivial|]. intros y ? ?%le_succ_l. apply IH; [split|]; order. Qed. Theorem left_induction : A z -> left_step -> forall n, n <= z -> A n. Proof. intros Az LS; apply strong_left_induction. intros n H1 H2. le_elim H1. - apply LS; trivial. apply H2; [now apply le_succ_l | now apply eq_le_incl]. - rewrite H1; apply Az. Qed. Theorem left_induction' : (forall n, z <= n -> A n) -> left_step -> forall n, A n. Proof. intros R L n. destruct (lt_trichotomy n z) as [H | [H | H]]. - apply left_induction. + apply R. now apply eq_le_incl. + assumption. + now apply lt_le_incl. - rewrite H; apply R; now apply eq_le_incl. - apply R; now apply lt_le_incl. Qed. Theorem strong_left_induction' : (forall n, z <= n -> A n) -> left_step' -> forall n, A n. Proof. intros R L n. destruct (lt_trichotomy n z) as [H | [H | H]]. - apply strong_left_induction. + trivial. + now apply lt_le_incl. - rewrite H; apply R; now apply eq_le_incl. - apply R; now apply lt_le_incl. Qed. End LeftInduction. Theorem order_induction : A z -> (forall n, z <= n -> A n -> A (S n)) -> (forall n, n < z -> A (S n) -> A n) -> forall n, A n. Proof. intros Az RS LS n. destruct (lt_trichotomy n z) as [H | [H | H]]. - now apply left_induction; [| | apply lt_le_incl]. - now rewrite H. - now apply right_induction; [| | apply lt_le_incl]. Qed. Theorem order_induction' : A z -> (forall n, z <= n -> A n -> A (S n)) -> (forall n, n <= z -> A n -> A (P n)) -> forall n, A n. Proof. intros Az AS AP n; apply order_induction; try assumption. intros m H1 H2. apply AP in H2; [|now apply le_succ_l]. now rewrite pred_succ in H2. Qed. End Center. Theorem order_induction_0 : A 0 -> (forall n, 0 <= n -> A n -> A (S n)) -> (forall n, n < 0 -> A (S n) -> A n) -> forall n, A n. Proof. exact (order_induction 0). Qed. Theorem order_induction'_0 : A 0 -> (forall n, 0 <= n -> A n -> A (S n)) -> (forall n, n <= 0 -> A n -> A (P n)) -> forall n, A n. Proof. exact (order_induction' 0). Qed. (** Elimination principle for [<] *) Theorem lt_ind : forall (n : t), A (S n) -> (forall m, n < m -> A m -> A (S m)) -> forall m, n < m -> A m. Proof. intros n H1 H2 m H3. apply right_induction with (S n); [assumption | | now apply le_succ_l]. intros; apply H2; try assumption. now apply le_succ_l. Qed. (** Elimination principle for [<=] *) Theorem le_ind : forall (n : t), A n -> (forall m, n <= m -> A m -> A (S m)) -> forall m, n <= m -> A m. Proof. intros n H1 H2 m H3. now apply right_induction with n. Qed. End Induction. Tactic Notation "nzord_induct" ident(n) := induction_maker n ltac:(apply order_induction_0). Tactic Notation "nzord_induct" ident(n) constr(z) := induction_maker n ltac:(apply order_induction with z). (** Induction principles with respect to a measure *) Section MeasureInduction. Variable X : Type. Variable f : X -> t. Theorem measure_right_induction : forall (A : X -> Type) (z : t), (forall x, z <= f x -> (forall y, z <= f y < f x -> A y) -> A x) -> forall x, z <= f x -> A x. Proof. intros A z IH x Hx. enough (H : forall y, f y = f x -> A y) by now apply H. induction (lt_wf z (f x)) as [n _ IH']. intros y Hy. subst n. apply (IH y Hx). intros y' Hy'. now apply (IH' _ Hy'). Defined. Lemma measure_left_induction : forall (A : X -> Type) (z : t), (forall x, f x <= z -> (forall y, f x < f y <= z -> A y) -> A x) -> forall x, f x <= z -> A x. Proof. intros A z IH x Hx. enough (H : forall y, f y = f x -> A y) by now apply H. induction (gt_wf z (f x)) as [n _ IH']. intros y Hy. subst n. apply (IH y Hx). intros y' Hy'. now apply (IH' _ Hy'). Defined. End MeasureInduction. End NZOrderProp. (* If we have moreover a [compare] function, we can build an [OrderedType] structure. *) (* Temporary workaround for bug #2949: remove this problematic + unused functor Module NZOrderedType (NZ : NZDecOrdSig') <: DecidableTypeFull <: OrderedTypeFull := NZ <+ NZBaseProp <+ NZOrderProp <+ Compare2EqBool <+ HasEqBool2Dec. *) coq-8.20.0/theories/Numbers/NatInt/NZParity.v000066400000000000000000000175641466560755400207630ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* bool. Definition Even n := exists m, n == 2*m. Definition Odd n := exists m, n == 2*m+1. Axiom even_spec : forall n, even n = true <-> Even n. Axiom odd_spec : forall n, odd n = true <-> Odd n. End NZParity. Module Type NZParityProp (Import A : NZOrdAxiomsSig') (Import B : NZParity A) (Import C : NZMulOrderProp A). (** Morphisms *) #[global] Instance Even_wd : Proper (eq==>iff) Even. Proof. unfold Even. solve_proper. Qed. #[global] Instance Odd_wd : Proper (eq==>iff) Odd. Proof. unfold Odd. solve_proper. Qed. #[global] Instance even_wd : Proper (eq==>Logic.eq) even. Proof. intros x x' EQ. rewrite eq_iff_eq_true, 2 even_spec. now f_equiv. Qed. #[global] Instance odd_wd : Proper (eq==>Logic.eq) odd. Proof. intros x x' EQ. rewrite eq_iff_eq_true, 2 odd_spec. now f_equiv. Qed. (** Evenness and oddity are dual notions *) Lemma Even_or_Odd : forall x, Even x \/ Odd x. Proof. intro x; nzinduct x. - left. exists 0. now nzsimpl. - intros x. split; intros [(y,H)|(y,H)]. + right. exists y. rewrite H. now nzsimpl. + left. exists (S y). rewrite H. now nzsimpl'. + right. assert (LT : exists z, z 2*n < 2*m+1. Proof. intros. nzsimpl'. apply lt_succ_r. now apply add_le_mono. Qed. Lemma double_above : forall n m, n 2*n+1 < 2*m. Proof. intros. nzsimpl'. rewrite <- le_succ_l, <- add_succ_l, <- add_succ_r. apply add_le_mono; now apply le_succ_l. Qed. Lemma Even_Odd_False : forall x, Even x -> Odd x -> False. Proof. intros x (y,E) (z,O). rewrite O in E; clear O. destruct (le_gt_cases y z) as [LE|GT]. - generalize (double_below _ _ LE); order. - generalize (double_above _ _ GT); order. Qed. Lemma orb_even_odd : forall n, orb (even n) (odd n) = true. Proof. intros n. destruct (Even_or_Odd n) as [H|H]. - rewrite <- even_spec in H. now rewrite H. - rewrite <- odd_spec in H. now rewrite H, orb_true_r. Qed. Lemma negb_odd : forall n, negb (odd n) = even n. Proof. intros n. generalize (Even_or_Odd n) (Even_Odd_False n). rewrite <- even_spec, <- odd_spec. destruct (odd n), (even n) ; simpl; intuition. Qed. Lemma negb_even : forall n, negb (even n) = odd n. Proof. intros. rewrite <- negb_odd. apply negb_involutive. Qed. (** Constants *) Lemma even_0 : even 0 = true. Proof. rewrite even_spec. exists 0. now nzsimpl. Qed. Lemma odd_0 : odd 0 = false. Proof. now rewrite <- negb_even, even_0. Qed. Lemma odd_1 : odd 1 = true. Proof. rewrite odd_spec. exists 0. now nzsimpl'. Qed. Lemma even_1 : even 1 = false. Proof. now rewrite <- negb_odd, odd_1. Qed. Lemma even_2 : even 2 = true. Proof. rewrite even_spec. exists 1. now nzsimpl'. Qed. Lemma odd_2 : odd 2 = false. Proof. now rewrite <- negb_even, even_2. Qed. (** Parity and successor *) Lemma Odd_succ : forall n, Odd (S n) <-> Even n. Proof. split; intros (m,H). - exists m. apply succ_inj. now rewrite add_1_r in H. - exists m. rewrite add_1_r. now f_equiv. Qed. Lemma odd_succ : forall n, odd (S n) = even n. Proof. intros. apply eq_iff_eq_true. rewrite even_spec, odd_spec. apply Odd_succ. Qed. Lemma even_succ : forall n, even (S n) = odd n. Proof. intros. now rewrite <- negb_odd, odd_succ, negb_even. Qed. Lemma Even_succ : forall n, Even (S n) <-> Odd n. Proof. intros. now rewrite <- even_spec, even_succ, odd_spec. Qed. (** Parity and successor of successor *) Lemma Even_succ_succ : forall n, Even (S (S n)) <-> Even n. Proof. intros. now rewrite Even_succ, Odd_succ. Qed. Lemma Odd_succ_succ : forall n, Odd (S (S n)) <-> Odd n. Proof. intros. now rewrite Odd_succ, Even_succ. Qed. Lemma even_succ_succ : forall n, even (S (S n)) = even n. Proof. intros. now rewrite even_succ, odd_succ. Qed. Lemma odd_succ_succ : forall n, odd (S (S n)) = odd n. Proof. intros. now rewrite odd_succ, even_succ. Qed. (** Parity and addition *) Lemma even_add : forall n m, even (n+m) = Bool.eqb (even n) (even m). Proof. intros n m. case_eq (even n); case_eq (even m); rewrite <- ?negb_true_iff, ?negb_even, ?odd_spec, ?even_spec; intros (m',Hm) (n',Hn). - exists (n'+m'). now rewrite mul_add_distr_l, Hn, Hm. - exists (n'+m'). now rewrite mul_add_distr_l, Hn, Hm, add_assoc. - exists (n'+m'). now rewrite mul_add_distr_l, Hn, Hm, add_shuffle0. - exists (n'+m'+1). rewrite Hm,Hn. nzsimpl'. now rewrite add_shuffle1. Qed. Lemma odd_add : forall n m, odd (n+m) = xorb (odd n) (odd m). Proof. intros n m. rewrite <- !negb_even. rewrite even_add. now destruct (even n), (even m). Qed. (** Parity and multiplication *) Lemma even_mul : forall n m, even (mul n m) = even n || even m. Proof. intros n m. case_eq (even n); simpl; rewrite ?even_spec. - intros (n',Hn). exists (n'*m). now rewrite Hn, mul_assoc. - case_eq (even m); simpl; rewrite ?even_spec. + intros (m',Hm). exists (n*m'). now rewrite Hm, !mul_assoc, (mul_comm 2). (* odd / odd *) + rewrite <- !negb_true_iff, !negb_even, !odd_spec. intros (m',Hm) (n',Hn). exists (n'*2*m' +n'+m'). rewrite Hn,Hm, !mul_add_distr_l, !mul_add_distr_r, !mul_1_l, !mul_1_r. now rewrite add_shuffle1, add_assoc, !mul_assoc. Qed. Lemma odd_mul : forall n m, odd (mul n m) = odd n && odd m. Proof. intros n m. rewrite <- !negb_even. rewrite even_mul. now destruct (even n), (even m). Qed. (** A particular case : adding by an even number *) Lemma even_add_even : forall n m, Even m -> even (n+m) = even n. Proof. intros n m Hm. apply even_spec in Hm. rewrite even_add, Hm. now destruct (even n). Qed. Lemma odd_add_even : forall n m, Even m -> odd (n+m) = odd n. Proof. intros n m Hm. apply even_spec in Hm. rewrite odd_add, <- (negb_even m), Hm. now destruct (odd n). Qed. Lemma even_add_mul_even : forall n m p, Even m -> even (n+m*p) = even n. Proof. intros n m p Hm. apply even_spec in Hm. apply even_add_even. apply even_spec. now rewrite even_mul, Hm. Qed. Lemma odd_add_mul_even : forall n m p, Even m -> odd (n+m*p) = odd n. Proof. intros n m p Hm. apply even_spec in Hm. apply odd_add_even. apply even_spec. now rewrite even_mul, Hm. Qed. Lemma even_add_mul_2 : forall n m, even (n+2*m) = even n. Proof. intros. apply even_add_mul_even. apply even_spec, even_2. Qed. Lemma odd_add_mul_2 : forall n m, odd (n+2*m) = odd n. Proof. intros. apply odd_add_mul_even. apply even_spec, even_2. Qed. (** Parity of [2 * n] and [2 * n + 1] *) Lemma even_even : forall n, even (2 * n) = true. Proof. intros n; apply even_spec; exists n; reflexivity. Qed. Lemma odd_even : forall n, odd (2 * n) = false. Proof. intros n; rewrite <-(negb_even), even_even; reflexivity. Qed. Lemma odd_odd : forall n, odd (2 * n + 1) = true. Proof. intros n; rewrite odd_spec; exists n; reflexivity. Qed. Lemma even_odd : forall n, even (2 * n + 1) = false. Proof. intros n; rewrite <-(negb_odd), odd_odd; reflexivity. Qed. End NZParityProp. coq-8.20.0/theories/Numbers/NatInt/NZPow.v000066400000000000000000000306751466560755400202560ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* t -> t. End Pow. Module Type PowNotation (A : Typ)(Import B : Pow A). Infix "^" := pow. End PowNotation. Module Type Pow' (A : Typ) := Pow A <+ PowNotation A. Module Type NZPowSpec (Import A : NZOrdAxiomsSig')(Import B : Pow' A). #[global] Declare Instance pow_wd : Proper (eq==>eq==>eq) pow. Axiom pow_0_r : forall a, a^0 == 1. Axiom pow_succ_r : forall a b, 0<=b -> a^(succ b) == a * a^b. Axiom pow_neg_r : forall a b, b<0 -> a^b == 0. End NZPowSpec. (** The above [pow_neg_r] specification is useless (and trivially provable) for N. Having it here already allows deriving some slightly more general statements. *) Module Type NZPow (A : NZOrdAxiomsSig) := Pow A <+ NZPowSpec A. Module Type NZPow' (A : NZOrdAxiomsSig) := Pow' A <+ NZPowSpec A. (** Derived properties of power *) Module Type NZPowProp (Import A : NZOrdAxiomsSig') (Import B : NZPow' A) (Import C : NZMulOrderProp A). Global Hint Rewrite pow_0_r pow_succ_r : nz. (** Power and basic constants *) Lemma pow_0_l : forall a, 0 0^a == 0. Proof. intros a Ha. destruct (lt_exists_pred _ _ Ha) as (a' & EQ & Ha'). rewrite EQ. now nzsimpl. Qed. Lemma pow_0_l' : forall a, a~=0 -> 0^a == 0. Proof. intros a Ha. destruct (lt_trichotomy a 0) as [LT|[EQ|GT]]; try order. - now rewrite pow_neg_r. - now apply pow_0_l. Qed. Lemma pow_1_r : forall a, a^1 == a. Proof. intros. now nzsimpl'. Qed. Lemma pow_1_l : forall a, 0<=a -> 1^a == 1. Proof. apply le_ind; intros. - solve_proper. - now nzsimpl. - now nzsimpl. Qed. Global Hint Rewrite pow_1_r pow_1_l : nz. Lemma pow_2_r : forall a, a^2 == a*a. Proof. intros. rewrite two_succ. nzsimpl; order'. Qed. Global Hint Rewrite pow_2_r : nz. (** Power and nullity *) Lemma pow_eq_0 : forall a b, 0<=b -> a^b == 0 -> a == 0. Proof. intros a b Hb. apply le_ind with (4:=Hb). - solve_proper. - rewrite pow_0_r. order'. - clear b Hb. intros b Hb IH. rewrite pow_succ_r by trivial. intros H. apply eq_mul_0 in H. destruct H; trivial. now apply IH. Qed. Lemma pow_nonzero : forall a b, a~=0 -> 0<=b -> a^b ~= 0. Proof. intros a b Ha Hb. contradict Ha. now apply pow_eq_0 with b. Qed. Lemma pow_eq_0_iff : forall a b, a^b == 0 <-> b<0 \/ (0 0<=c -> a^(b+c) == a^b * a^c. Proof. intros a b c Hb. apply le_ind with (4:=Hb). - solve_proper. - now nzsimpl. - clear b Hb. intros b Hb IH Hc. nzsimpl; trivial. + rewrite IH; trivial. apply mul_assoc. + now apply add_nonneg_nonneg. Qed. Lemma pow_mul_l : forall a b c, (a*b)^c == a^c * b^c. Proof. intros a b c. destruct (lt_ge_cases c 0) as [Hc|Hc]. - rewrite !(pow_neg_r _ _ Hc). now nzsimpl. - apply le_ind with (4:=Hc). + solve_proper. + now nzsimpl. + clear c Hc. intros c Hc IH. nzsimpl; trivial. rewrite IH; trivial. apply mul_shuffle1. Qed. Lemma pow_mul_r : forall a b c, 0<=b -> 0<=c -> a^(b*c) == (a^b)^c. Proof. intros a b c Hb. apply le_ind with (4:=Hb). - solve_proper. - intros. now nzsimpl. - clear b Hb. intros b Hb IH Hc. nzsimpl; trivial. rewrite pow_add_r, IH, pow_mul_l; trivial. + apply mul_comm. + now apply mul_nonneg_nonneg. Qed. (** Positivity *) Lemma pow_nonneg : forall a b, 0<=a -> 0<=a^b. Proof. intros a b Ha. destruct (lt_ge_cases b 0) as [Hb|Hb]. - now rewrite !(pow_neg_r _ _ Hb). - apply le_ind with (4:=Hb). + solve_proper. + nzsimpl; order'. + clear b Hb. intros b Hb IH. nzsimpl; trivial. now apply mul_nonneg_nonneg. Qed. Lemma pow_pos_nonneg : forall a b, 0 0<=b -> 0 0<=a a^c < b^c. Proof. intros a b c Hc. apply lt_ind with (4:=Hc). - solve_proper. - intros (Ha,H). nzsimpl; trivial; order. - clear c Hc. intros c Hc IH (Ha,H). nzsimpl; try order. apply mul_lt_mono_nonneg; trivial. + apply pow_nonneg; try order. + apply IH. now split. Qed. Lemma pow_le_mono_l : forall a b c, 0<=a<=b -> a^c <= b^c. Proof. intros a b c (Ha,H). destruct (lt_trichotomy c 0) as [Hc|[Hc|Hc]]. - rewrite !(pow_neg_r _ _ Hc); now nzsimpl. - rewrite Hc; now nzsimpl. - apply lt_eq_cases in H. destruct H as [H|H]; [|now rewrite <- H]. apply lt_le_incl, pow_lt_mono_l; now try split. Qed. Lemma pow_gt_1 : forall a b, 1 (0 1 0<=c -> b a^b < a^c. Proof. intros a b c Ha Hc H. destruct (lt_ge_cases b 0) as [Hb|Hb]. - rewrite pow_neg_r by trivial. apply pow_pos_nonneg; order'. - assert (H' : b<=c) by order. destruct (le_exists_sub _ _ H') as (d & EQ & Hd). rewrite EQ, pow_add_r; trivial. rewrite <- (mul_1_l (a^b)) at 1. apply mul_lt_mono_pos_r. + apply pow_pos_nonneg; order'. + apply pow_gt_1; trivial. apply lt_eq_cases in Hd; destruct Hd as [LT|EQ']; trivial. rewrite <- EQ' in *. rewrite add_0_l in EQ. order. Qed. (** NB: since 0^0 > 0^1, the following result isn't valid with a=0 *) Lemma pow_le_mono_r : forall a b c, 0 b<=c -> a^b <= a^c. Proof. intros a b c Ha H. destruct (lt_ge_cases b 0) as [Hb|Hb]. - rewrite (pow_neg_r _ _ Hb). apply pow_nonneg; order. - apply le_succ_l in Ha; rewrite <- one_succ in Ha. apply lt_eq_cases in Ha; destruct Ha as [Ha|Ha]; [|rewrite <- Ha]. + apply lt_eq_cases in H; destruct H as [H|H]; [|now rewrite <- H]. apply lt_le_incl, pow_lt_mono_r; order. + nzsimpl; order. Qed. Lemma pow_le_mono : forall a b c d, 0 b<=d -> a^b <= c^d. Proof. intros a b c d ? ?. transitivity (a^d). - apply pow_le_mono_r; intuition order. - apply pow_le_mono_l; intuition order. Qed. Lemma pow_lt_mono : forall a b c d, 0 0 a^b < c^d. Proof. intros a b c d (Ha,Hac) (Hb,Hbd). apply le_succ_l in Ha; rewrite <- one_succ in Ha. apply lt_eq_cases in Ha; destruct Ha as [Ha|Ha]; [|rewrite <- Ha]. - transitivity (a^d). + apply pow_lt_mono_r; intuition order. + apply pow_lt_mono_l; try split; order'. - nzsimpl; try order. apply pow_gt_1; order. Qed. (** Injectivity *) Lemma pow_inj_l : forall a b c, 0<=a -> 0<=b -> 0 a^c == b^c -> a == b. Proof. intros a b c Ha Hb Hc EQ. destruct (lt_trichotomy a b) as [LT|[EQ'|GT]]; trivial. - assert (a^c < b^c) by (apply pow_lt_mono_l; try split; trivial). order. - assert (b^c < a^c) by (apply pow_lt_mono_l; try split; trivial). order. Qed. Lemma pow_inj_r : forall a b c, 1 0<=b -> 0<=c -> a^b == a^c -> b == c. Proof. intros a b c Ha Hb Hc EQ. destruct (lt_trichotomy b c) as [LT|[EQ'|GT]]; trivial. - assert (a^b < a^c) by (apply pow_lt_mono_r; try split; trivial). order. - assert (a^c < a^b) by (apply pow_lt_mono_r; try split; trivial). order. Qed. (** Monotonicity results, both ways *) Lemma pow_lt_mono_l_iff : forall a b c, 0<=a -> 0<=b -> 0 (a a^c < b^c). Proof. intros a b c Ha Hb Hc. split; intro LT. - apply pow_lt_mono_l; try split; trivial. - destruct (le_gt_cases b a) as [LE|GT]; trivial. assert (b^c <= a^c) by (apply pow_le_mono_l; try split; order). order. Qed. Lemma pow_le_mono_l_iff : forall a b c, 0<=a -> 0<=b -> 0 (a<=b <-> a^c <= b^c). Proof. intros a b c Ha Hb Hc. split; intro LE. - apply pow_le_mono_l; try split; trivial. - destruct (le_gt_cases a b) as [LE'|GT]; trivial. assert (b^c < a^c) by (apply pow_lt_mono_l; try split; trivial). order. Qed. Lemma pow_lt_mono_r_iff : forall a b c, 1 0<=c -> (b a^b < a^c). Proof. intros a b c Ha Hc. split; intro LT. - now apply pow_lt_mono_r. - destruct (le_gt_cases c b) as [LE|GT]; trivial. assert (a^c <= a^b) by (apply pow_le_mono_r; order'). order. Qed. Lemma pow_le_mono_r_iff : forall a b c, 1 0<=c -> (b<=c <-> a^b <= a^c). Proof. intros a b c Ha Hc. split; intro LE. - apply pow_le_mono_r; order'. - destruct (le_gt_cases b c) as [LE'|GT]; trivial. assert (a^c < a^b) by (apply pow_lt_mono_r; order'). order. Qed. (** For any a>1, the a^x function is above the identity function *) Lemma pow_gt_lin_r : forall a b, 1 0<=b -> b < a^b. Proof. intros a b Ha Hb. apply le_ind with (4:=Hb). - solve_proper. - nzsimpl. order'. - clear b Hb. intros b Hb IH. nzsimpl; trivial. rewrite <- !le_succ_l in *. rewrite <- two_succ in Ha. transitivity (2*(S b)). + nzsimpl'. rewrite <- 2 succ_le_mono. rewrite <- (add_0_l b) at 1. apply add_le_mono; order. + apply mul_le_mono_nonneg; trivial. * order'. * now apply lt_le_incl, lt_succ_r. Qed. (** Someday, we should say something about the full Newton formula. In the meantime, we can at least provide some inequalities about (a+b)^c. *) Lemma pow_add_lower : forall a b c, 0<=a -> 0<=b -> 0 a^c + b^c <= (a+b)^c. Proof. intros a b c Ha Hb Hc. apply lt_ind with (4:=Hc). - solve_proper. - nzsimpl; order. - clear c Hc. intros c Hc IH. assert (0<=c) by order'. nzsimpl; trivial. transitivity ((a+b)*(a^c + b^c)). + rewrite mul_add_distr_r, !mul_add_distr_l. apply add_le_mono. * rewrite <- add_0_r at 1. apply add_le_mono_l. apply mul_nonneg_nonneg; trivial. apply pow_nonneg; trivial. * rewrite <- add_0_l at 1. apply add_le_mono_r. apply mul_nonneg_nonneg; trivial. apply pow_nonneg; trivial. + apply mul_le_mono_nonneg_l; trivial. now apply add_nonneg_nonneg. Qed. (** This upper bound can also be seen as a convexity proof for x^c : image of (a+b)/2 is below the middle of the images of a and b *) Lemma pow_add_upper : forall a b c, 0<=a -> 0<=b -> 0 (a+b)^c <= 2^(pred c) * (a^c + b^c). Proof. assert (aux : forall a b c, 0<=a<=b -> 0 (a + b) * (a ^ c + b ^ c) <= 2 * (a * a ^ c + b * b ^ c)). (* begin *) - intros a b c (Ha,H) Hc. rewrite !mul_add_distr_l, !mul_add_distr_r. nzsimpl'. rewrite <- !add_assoc. apply add_le_mono_l. rewrite !add_assoc. apply add_le_mono_r. destruct (le_exists_sub _ _ H) as (d & EQ & Hd). rewrite EQ. rewrite 2 mul_add_distr_r. rewrite !add_assoc. apply add_le_mono_r. rewrite add_comm. apply add_le_mono_l. apply mul_le_mono_nonneg_l; trivial. apply pow_le_mono_l; try split; order. (* end *) - intros a b c Ha Hb Hc. apply lt_ind with (4:=Hc). + solve_proper. + nzsimpl; order. + clear c Hc. intros c Hc IH. assert (0<=c) by order. nzsimpl; trivial. transitivity ((a+b)*(2^(pred c) * (a^c + b^c))). * apply mul_le_mono_nonneg_l; trivial. now apply add_nonneg_nonneg. * rewrite mul_assoc. rewrite (mul_comm (a+b)). assert (EQ : S (P c) == c) by (apply lt_succ_pred with 0; order'). assert (LE : 0 <= P c) by (now rewrite succ_le_mono, EQ, le_succ_l). assert (EQ' : 2^c == 2^(P c) * 2) by (rewrite <- EQ at 1; nzsimpl'; order). rewrite EQ', <- !mul_assoc. apply mul_le_mono_nonneg_l. -- apply pow_nonneg; order'. -- destruct (le_gt_cases a b). ++ apply aux; try split; order'. ++ rewrite (add_comm a), (add_comm (a^c)), (add_comm (a*a^c)). apply aux; try split; order'. Qed. End NZPowProp. coq-8.20.0/theories/Numbers/NatInt/NZProperties.v000066400000000000000000000021611466560755400216320ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* t. End Sqrt. Module Type SqrtNotation (A : Typ)(Import B : Sqrt A). Notation "√ x" := (sqrt x) (at level 6). End SqrtNotation. Module Type Sqrt' (A : Typ) := Sqrt A <+ SqrtNotation A. Module Type NZSqrtSpec (Import A : NZOrdAxiomsSig')(Import B : Sqrt' A). Axiom sqrt_spec : forall a, 0<=a -> √a * √a <= a < S (√a) * S (√a). Axiom sqrt_neg : forall a, a<0 -> √a == 0. End NZSqrtSpec. Module Type NZSqrt (A : NZOrdAxiomsSig) := Sqrt A <+ NZSqrtSpec A. Module Type NZSqrt' (A : NZOrdAxiomsSig) := Sqrt' A <+ NZSqrtSpec A. (** Derived properties of power *) Module Type NZSqrtProp (Import A : NZOrdAxiomsSig') (Import B : NZSqrt' A) (Import C : NZMulOrderProp A). Local Notation "a ²" := (a*a) (at level 5, no associativity, format "a ²"). (** First, sqrt is non-negative *) Lemma sqrt_spec_nonneg : forall b, b² < (S b)² -> 0 <= b. Proof. intros b LT. destruct (le_gt_cases 0 b) as [Hb|Hb]; trivial. exfalso. assert ((S b)² < b²). - rewrite mul_succ_l, <- (add_0_r b²). apply add_lt_le_mono. + apply mul_lt_mono_neg_l; trivial. apply lt_succ_diag_r. + now apply le_succ_l. - order. Qed. Lemma sqrt_nonneg : forall a, 0<=√a. Proof. intros a. destruct (lt_ge_cases a 0) as [Ha|Ha]. - now rewrite (sqrt_neg _ Ha). - apply sqrt_spec_nonneg. destruct (sqrt_spec a Ha). order. Qed. (** The spec of sqrt indeed determines it *) Lemma sqrt_unique : forall a b, b² <= a < (S b)² -> √a == b. Proof. intros a b (LEb,LTb). assert (Ha : 0<=a) by (transitivity (b²); trivial using square_nonneg). assert (Hb : 0<=b) by (apply sqrt_spec_nonneg; order). assert (Ha': 0<=√a) by now apply sqrt_nonneg. destruct (sqrt_spec a Ha) as (LEa,LTa). assert (b <= √a). - apply lt_succ_r, square_lt_simpl_nonneg; [|order]. now apply lt_le_incl, lt_succ_r. - assert (√a <= b). + apply lt_succ_r, square_lt_simpl_nonneg; [|order]. now apply lt_le_incl, lt_succ_r. + order. Qed. (** Hence sqrt is a morphism *) #[global] Instance sqrt_wd : Proper (eq==>eq) sqrt. Proof. intros x x' Hx. destruct (lt_ge_cases x 0) as [H|H]. - rewrite 2 sqrt_neg; trivial. + reflexivity. + now rewrite <- Hx. - apply sqrt_unique. rewrite Hx in *. now apply sqrt_spec. Qed. (** An alternate specification *) Lemma sqrt_spec_alt : forall a, 0<=a -> exists r, a == (√a)² + r /\ 0 <= r <= 2*√a. Proof. intros a Ha. destruct (sqrt_spec _ Ha) as (LE,LT). destruct (le_exists_sub _ _ LE) as (r & Hr & Hr'). exists r. split. - now rewrite add_comm. - split. + trivial. + apply (add_le_mono_r _ _ (√a)²). rewrite <- Hr, add_comm. generalize LT. nzsimpl'. now rewrite lt_succ_r, add_assoc. Qed. Lemma sqrt_unique' : forall a b c, 0<=c<=2*b -> a == b² + c -> √a == b. Proof. intros a b c (Hc,H) EQ. apply sqrt_unique. rewrite EQ. split. - rewrite <- add_0_r at 1. now apply add_le_mono_l. - nzsimpl. apply lt_succ_r. rewrite <- add_assoc. apply add_le_mono_l. generalize H; now nzsimpl'. Qed. (** Sqrt is exact on squares *) Lemma sqrt_square : forall a, 0<=a -> √(a²) == a. Proof. intros a Ha. apply sqrt_unique' with 0. - split. + order. + apply mul_nonneg_nonneg; order'. - now nzsimpl. Qed. (** Sqrt and predecessors of squares *) Lemma sqrt_pred_square : forall a, 0 √(P a²) == P a. Proof. intros a Ha. apply sqrt_unique. assert (EQ := lt_succ_pred 0 a Ha). rewrite EQ. split. - apply lt_succ_r. rewrite (lt_succ_pred 0). + assert (0 <= P a) by (now rewrite <- lt_succ_r, EQ). assert (P a < a) by (now rewrite <- le_succ_l, EQ). apply mul_lt_mono_nonneg; trivial. + now apply mul_pos_pos. - apply le_succ_l. rewrite (lt_succ_pred 0). + reflexivity. + now apply mul_pos_pos. Qed. (** Sqrt is a monotone function (but not a strict one) *) Lemma sqrt_le_mono : forall a b, a <= b -> √a <= √b. Proof. intros a b Hab. destruct (lt_ge_cases a 0) as [Ha|Ha]. - rewrite (sqrt_neg _ Ha). apply sqrt_nonneg. - assert (Hb : 0 <= b) by order. destruct (sqrt_spec a Ha) as (LE,_). destruct (sqrt_spec b Hb) as (_,LT). apply lt_succ_r. apply square_lt_simpl_nonneg; try order. now apply lt_le_incl, lt_succ_r, sqrt_nonneg. Qed. (** No reverse result for <=, consider for instance √2 <= √1 *) Lemma sqrt_lt_cancel : forall a b, √a < √b -> a < b. Proof. intros a b H. destruct (lt_ge_cases b 0) as [Hb|Hb]. - rewrite (sqrt_neg b Hb) in H; generalize (sqrt_nonneg a); order. - destruct (lt_ge_cases a 0) as [Ha|Ha]; [order|]. destruct (sqrt_spec a Ha) as (_,LT). destruct (sqrt_spec b Hb) as (LE,_). apply le_succ_l in H. assert ((S (√a))² <= (√b)²). + apply mul_le_mono_nonneg; trivial. * now apply lt_le_incl, lt_succ_r, sqrt_nonneg. * now apply lt_le_incl, lt_succ_r, sqrt_nonneg. + order. Qed. (** When left side is a square, we have an equivalence for <= *) Lemma sqrt_le_square : forall a b, 0<=a -> 0<=b -> (b²<=a <-> b <= √a). Proof. intros a b Ha Hb. split; intros H. - rewrite <- (sqrt_square b); trivial. now apply sqrt_le_mono. - destruct (sqrt_spec a Ha) as (LE,LT). transitivity (√a)²; trivial. now apply mul_le_mono_nonneg. Qed. (** When right side is a square, we have an equivalence for < *) Lemma sqrt_lt_square : forall a b, 0<=a -> 0<=b -> (a √a < b). Proof. intros a b Ha Hb. split; intros H. - destruct (sqrt_spec a Ha) as (LE,_). apply square_lt_simpl_nonneg; try order. - rewrite <- (sqrt_square b Hb) in H. now apply sqrt_lt_cancel. Qed. (** Sqrt and basic constants *) Lemma sqrt_0 : √0 == 0. Proof. rewrite <- (mul_0_l 0) at 1. now apply sqrt_square. Qed. Lemma sqrt_1 : √1 == 1. Proof. rewrite <- (mul_1_l 1) at 1. apply sqrt_square. order'. Qed. Lemma sqrt_2 : √2 == 1. Proof. apply sqrt_unique' with 1. - nzsimpl; split; order'. - now nzsimpl'. Qed. Lemma sqrt_pos : forall a, 0 < √a <-> 0 < a. Proof. intros a. split; intros Ha. - apply sqrt_lt_cancel. now rewrite sqrt_0. - rewrite <- le_succ_l, <- one_succ, <- sqrt_1. apply sqrt_le_mono. now rewrite one_succ, le_succ_l. Qed. Lemma sqrt_lt_lin : forall a, 1 √a √a<=a. Proof. intros a Ha. destruct (le_gt_cases a 0) as [H|H]. - setoid_replace a with 0 by order. now rewrite sqrt_0. - destruct (le_gt_cases a 1) as [H'|H']. + rewrite <- le_succ_l, <- one_succ in H. setoid_replace a with 1 by order. now rewrite sqrt_1. + now apply lt_le_incl, sqrt_lt_lin. Qed. (** Sqrt and multiplication. *) (** Due to rounding error, we don't have the usual √(a*b) = √a*√b but only lower and upper bounds. *) Lemma sqrt_mul_below : forall a b, √a * √b <= √(a*b). Proof. intros a b. destruct (lt_ge_cases a 0) as [Ha|Ha]. - rewrite (sqrt_neg a Ha). nzsimpl. apply sqrt_nonneg. - destruct (lt_ge_cases b 0) as [Hb|Hb]. + rewrite (sqrt_neg b Hb). nzsimpl. apply sqrt_nonneg. + assert (Ha':=sqrt_nonneg a). assert (Hb':=sqrt_nonneg b). apply sqrt_le_square; try now apply mul_nonneg_nonneg. rewrite mul_shuffle1. apply mul_le_mono_nonneg; try now apply mul_nonneg_nonneg. * now apply sqrt_spec. * now apply sqrt_spec. Qed. Lemma sqrt_mul_above : forall a b, 0<=a -> 0<=b -> √(a*b) < S (√a) * S (√b). Proof. intros a b Ha Hb. apply sqrt_lt_square. - now apply mul_nonneg_nonneg. - apply mul_nonneg_nonneg. + now apply lt_le_incl, lt_succ_r, sqrt_nonneg. + now apply lt_le_incl, lt_succ_r, sqrt_nonneg. - rewrite mul_shuffle1. apply mul_lt_mono_nonneg; trivial; now apply sqrt_spec. Qed. (** And we can't find better approximations in general. - The lower bound is exact for squares - Concerning the upper bound, for any c>0, take a=b=c²-1, then √(a*b) = c² -1 while S √a = S √b = c *) (** Sqrt and successor : - the sqrt function climbs by at most 1 at a time - otherwise it stays at the same value - the +1 steps occur for squares *) Lemma sqrt_succ_le : forall a, 0<=a -> √(S a) <= S (√a). Proof. intros a Ha. apply lt_succ_r. apply sqrt_lt_square. - now apply le_le_succ_r. - apply le_le_succ_r, le_le_succ_r, sqrt_nonneg. - rewrite <- (add_1_l (S (√a))). apply lt_le_trans with (1²+(S (√a))²). + rewrite mul_1_l, add_1_l, <- succ_lt_mono. now apply sqrt_spec. + apply add_square_le. * order'. * apply le_le_succ_r, sqrt_nonneg. Qed. Lemma sqrt_succ_or : forall a, 0<=a -> √(S a) == S (√a) \/ √(S a) == √a. Proof. intros a Ha. destruct (le_gt_cases (√(S a)) (√a)) as [H|H]. - right. generalize (sqrt_le_mono _ _ (le_succ_diag_r a)); order. - left. apply le_succ_l in H. generalize (sqrt_succ_le a Ha); order. Qed. Lemma sqrt_eq_succ_iff_square : forall a, 0<=a -> (√(S a) == S (√a) <-> exists b, 0 √(a+b) <= √a + √b). - intros a b Ha. rewrite (sqrt_neg a Ha). nzsimpl. apply sqrt_le_mono. rewrite <- (add_0_l b) at 2. apply add_le_mono_r; order. - intros a b. destruct (lt_ge_cases a 0) as [Ha|Ha]. + now apply AUX. + destruct (lt_ge_cases b 0) as [Hb|Hb]. * rewrite (add_comm a), (add_comm (√a)); now apply AUX. * assert (Ha':=sqrt_nonneg a). assert (Hb':=sqrt_nonneg b). rewrite <- lt_succ_r. apply sqrt_lt_square. -- now apply add_nonneg_nonneg. -- now apply lt_le_incl, lt_succ_r, add_nonneg_nonneg. -- destruct (sqrt_spec a Ha) as (_,LTa). destruct (sqrt_spec b Hb) as (_,LTb). revert LTa LTb. nzsimpl. rewrite 3 lt_succ_r. intros LTa LTb. assert (H:=add_le_mono _ _ _ _ LTa LTb). etransitivity; [eexact H|]. clear LTa LTb H. rewrite <- (add_assoc _ (√a) (√a)). rewrite <- (add_assoc _ (√b) (√b)). rewrite add_shuffle1. rewrite <- (add_assoc _ (√a + √b)). rewrite (add_shuffle1 (√a) (√b)). apply add_le_mono_r. now apply add_square_le. Qed. (** convexity inequality for sqrt: sqrt of middle is above middle of square roots. *) Lemma add_sqrt_le : forall a b, 0<=a -> 0<=b -> √a + √b <= √(2*(a+b)). Proof. intros a b Ha Hb. assert (Ha':=sqrt_nonneg a). assert (Hb':=sqrt_nonneg b). apply sqrt_le_square. - apply mul_nonneg_nonneg. + order'. + now apply add_nonneg_nonneg. - now apply add_nonneg_nonneg. - transitivity (2*((√a)² + (√b)²)). + now apply square_add_le. + apply mul_le_mono_nonneg_l. * order'. * apply add_le_mono; now apply sqrt_spec. Qed. End NZSqrtProp. Module Type NZSqrtUpProp (Import A : NZDecOrdAxiomsSig') (Import B : NZSqrt' A) (Import C : NZMulOrderProp A) (Import D : NZSqrtProp A B C). (** * [sqrt_up] : a square root that rounds up instead of down *) Local Notation "a ²" := (a*a) (at level 5, no associativity, format "a ²"). (** For once, we define instead of axiomatizing, thanks to sqrt *) Definition sqrt_up a := match compare 0 a with | Lt => S √(P a) | _ => 0 end. Local Notation "√° a" := (sqrt_up a) (at level 6, no associativity). Lemma sqrt_up_eqn0 : forall a, a<=0 -> √°a == 0. Proof. intros a Ha. unfold sqrt_up. case compare_spec; try order. Qed. Lemma sqrt_up_eqn : forall a, 0 √°a == S √(P a). Proof. intros a Ha. unfold sqrt_up. case compare_spec; try order. Qed. Lemma sqrt_up_spec : forall a, 0 (P √°a)² < a <= (√°a)². Proof. intros a Ha. rewrite sqrt_up_eqn, pred_succ; trivial. assert (Ha' := lt_succ_pred 0 a Ha). rewrite <- Ha' at 3 4. rewrite le_succ_l, lt_succ_r. apply sqrt_spec. now rewrite <- lt_succ_r, Ha'. Qed. (** First, [sqrt_up] is non-negative *) Lemma sqrt_up_nonneg : forall a, 0<=√°a. Proof. intros a. destruct (le_gt_cases a 0) as [Ha|Ha]. - now rewrite sqrt_up_eqn0. - rewrite sqrt_up_eqn; trivial. apply le_le_succ_r, sqrt_nonneg. Qed. (** [sqrt_up] is a morphism *) #[global] Instance sqrt_up_wd : Proper (eq==>eq) sqrt_up. Proof. assert (Proper (eq==>eq==>Logic.eq) compare). - intros x x' Hx y y' Hy. do 2 case compare_spec; trivial; order. - intros x x' Hx; unfold sqrt_up; rewrite Hx; case compare; now rewrite ?Hx. Qed. (** The spec of [sqrt_up] indeed determines it *) Lemma sqrt_up_unique : forall a b, 0 (P b)² < a <= b² -> √°a == b. Proof. intros a b Hb (LEb,LTb). assert (Ha : 0 √°(a²) == a. Proof. intros a Ha. le_elim Ha. - rewrite sqrt_up_eqn by (now apply mul_pos_pos). rewrite sqrt_pred_square; trivial. apply (lt_succ_pred 0); trivial. - rewrite sqrt_up_eqn0; trivial. rewrite <- Ha. now nzsimpl. Qed. (** [sqrt_up] and successors of squares *) Lemma sqrt_up_succ_square : forall a, 0<=a -> √°(S a²) == S a. Proof. intros a Ha. rewrite sqrt_up_eqn by (now apply lt_succ_r, mul_nonneg_nonneg). now rewrite pred_succ, sqrt_square. Qed. (** Basic constants *) Lemma sqrt_up_0 : √°0 == 0. Proof. rewrite <- (mul_0_l 0) at 1. now apply sqrt_up_square. Qed. Lemma sqrt_up_1 : √°1 == 1. Proof. rewrite <- (mul_1_l 1) at 1. apply sqrt_up_square. order'. Qed. Lemma sqrt_up_2 : √°2 == 2. Proof. rewrite sqrt_up_eqn by order'. now rewrite two_succ, pred_succ, sqrt_1. Qed. (** Links between sqrt and [sqrt_up] *) Lemma le_sqrt_sqrt_up : forall a, √a <= √°a. Proof. intros a. unfold sqrt_up. case compare_spec; intros H. - rewrite <- H, sqrt_0. order. - rewrite <- (lt_succ_pred 0 a H) at 1. apply sqrt_succ_le. apply lt_succ_r. now rewrite (lt_succ_pred 0 a H). - now rewrite sqrt_neg. Qed. Lemma le_sqrt_up_succ_sqrt : forall a, √°a <= S (√a). Proof. intros a. unfold sqrt_up. case compare_spec; intros H; try apply le_le_succ_r, sqrt_nonneg. rewrite <- succ_le_mono. apply sqrt_le_mono. rewrite <- (lt_succ_pred 0 a H) at 2. apply le_succ_diag_r. Qed. Lemma sqrt_sqrt_up_spec : forall a, 0<=a -> (√a)² <= a <= (√°a)². Proof. intros a H. split. - now apply sqrt_spec. - le_elim H. + now apply sqrt_up_spec. + now rewrite <-H, sqrt_up_0, mul_0_l. Qed. Lemma sqrt_sqrt_up_exact : forall a, 0<=a -> (√a == √°a <-> exists b, 0<=b /\ a == b²). Proof. intros a Ha. split. - intros H. exists √a. split. + apply sqrt_nonneg. + generalize (sqrt_sqrt_up_spec a Ha). rewrite <-H. destruct 1; order. - intros (b & Hb & Hb'). rewrite Hb'. now rewrite sqrt_square, sqrt_up_square. Qed. (** [sqrt_up] is a monotone function (but not a strict one) *) Lemma sqrt_up_le_mono : forall a b, a <= b -> √°a <= √°b. Proof. intros a b H. destruct (le_gt_cases a 0) as [Ha|Ha]. - rewrite (sqrt_up_eqn0 _ Ha). apply sqrt_up_nonneg. - rewrite 2 sqrt_up_eqn by order. rewrite <- succ_le_mono. apply sqrt_le_mono, succ_le_mono. rewrite 2 (lt_succ_pred 0); order. Qed. (** No reverse result for <=, consider for instance √°3 <= √°2 *) Lemma sqrt_up_lt_cancel : forall a b, √°a < √°b -> a < b. Proof. intros a b H. destruct (le_gt_cases b 0) as [Hb|Hb]. - rewrite (sqrt_up_eqn0 _ Hb) in H; generalize (sqrt_up_nonneg a); order. - destruct (le_gt_cases a 0) as [Ha|Ha]; [order|]. rewrite <- (lt_succ_pred 0 a Ha), <- (lt_succ_pred 0 b Hb), <- succ_lt_mono. apply sqrt_lt_cancel, succ_lt_mono. now rewrite <- 2 sqrt_up_eqn. Qed. (** When left side is a square, we have an equivalence for < *) Lemma sqrt_up_lt_square : forall a b, 0<=a -> 0<=b -> (b² < a <-> b < √°a). Proof. intros a b Ha Hb. split; intros H. - destruct (sqrt_up_spec a) as (LE,LT). + apply le_lt_trans with b²; trivial using square_nonneg. + apply square_lt_simpl_nonneg; try order. apply sqrt_up_nonneg. - apply sqrt_up_lt_cancel. now rewrite sqrt_up_square. Qed. (** When right side is a square, we have an equivalence for <= *) Lemma sqrt_up_le_square : forall a b, 0<=a -> 0<=b -> (a <= b² <-> √°a <= b). Proof. intros a b Ha Hb. split; intros H. - rewrite <- (sqrt_up_square b Hb). now apply sqrt_up_le_mono. - apply square_le_mono_nonneg in H; [|now apply sqrt_up_nonneg]. transitivity (√°a)²; trivial. now apply sqrt_sqrt_up_spec. Qed. Lemma sqrt_up_pos : forall a, 0 < √°a <-> 0 < a. Proof. intros a. split; intros Ha. - apply sqrt_up_lt_cancel. now rewrite sqrt_up_0. - rewrite <- le_succ_l, <- one_succ, <- sqrt_up_1. apply sqrt_up_le_mono. now rewrite one_succ, le_succ_l. Qed. Lemma sqrt_up_lt_lin : forall a, 2 √°a < a. Proof. intros a Ha. rewrite sqrt_up_eqn by order'. assert (Ha' := lt_succ_pred 2 a Ha). rewrite <- Ha' at 2. rewrite <- succ_lt_mono. apply sqrt_lt_lin. rewrite succ_lt_mono. now rewrite Ha', <- two_succ. Qed. Lemma sqrt_up_le_lin : forall a, 0<=a -> √°a<=a. Proof. intros a Ha. le_elim Ha. - rewrite sqrt_up_eqn; trivial. apply le_succ_l. apply le_lt_trans with (P a). + apply sqrt_le_lin. now rewrite <- lt_succ_r, (lt_succ_pred 0). + rewrite <- (lt_succ_pred 0 a) at 2; trivial. apply lt_succ_diag_r. - now rewrite <- Ha, sqrt_up_0. Qed. (** [sqrt_up] and multiplication. *) (** Due to rounding error, we don't have the usual [√(a*b) = √a*√b] but only lower and upper bounds. *) Lemma sqrt_up_mul_above : forall a b, 0<=a -> 0<=b -> √°(a*b) <= √°a * √°b. Proof. intros a b Ha Hb. apply sqrt_up_le_square. - now apply mul_nonneg_nonneg. - apply mul_nonneg_nonneg; apply sqrt_up_nonneg. - rewrite mul_shuffle1. apply mul_le_mono_nonneg; trivial; now apply sqrt_sqrt_up_spec. Qed. Lemma sqrt_up_mul_below : forall a b, 0 0 (P √°a)*(P √°b) < √°(a*b). Proof. intros a b Ha Hb. apply sqrt_up_lt_square. - apply mul_nonneg_nonneg; order. - apply mul_nonneg_nonneg; apply lt_succ_r. + rewrite (lt_succ_pred 0); now rewrite sqrt_up_pos. + rewrite (lt_succ_pred 0); now rewrite sqrt_up_pos. - rewrite mul_shuffle1. apply mul_lt_mono_nonneg; trivial using square_nonneg; now apply sqrt_up_spec. Qed. (** And we can't find better approximations in general. - The upper bound is exact for squares - Concerning the lower bound, for any c>0, take [a=b=c²+1], then [√°(a*b) = c²+1] while [P √°a = P √°b = c] *) (** [sqrt_up] and successor : - the [sqrt_up] function climbs by at most 1 at a time - otherwise it stays at the same value - the +1 steps occur after squares *) Lemma sqrt_up_succ_le : forall a, 0<=a -> √°(S a) <= S (√°a). Proof. intros a Ha. apply sqrt_up_le_square. - now apply le_le_succ_r. - apply le_le_succ_r, sqrt_up_nonneg. - rewrite <- (add_1_l (√°a)). apply le_trans with (1²+(√°a)²). + rewrite mul_1_l, add_1_l, <- succ_le_mono. now apply sqrt_sqrt_up_spec. + apply add_square_le. * order'. * apply sqrt_up_nonneg. Qed. Lemma sqrt_up_succ_or : forall a, 0<=a -> √°(S a) == S (√°a) \/ √°(S a) == √°a. Proof. intros a Ha. destruct (le_gt_cases (√°(S a)) (√°a)) as [H|H]. - right. generalize (sqrt_up_le_mono _ _ (le_succ_diag_r a)); order. - left. apply le_succ_l in H. generalize (sqrt_up_succ_le a Ha); order. Qed. Lemma sqrt_up_eq_succ_iff_square : forall a, 0<=a -> (√°(S a) == S (√°a) <-> exists b, 0<=b /\ a == b²). Proof. intros a Ha. split. - intros EQ. le_elim Ha. + exists (√°a). split. * apply sqrt_up_nonneg. * generalize (proj2 (sqrt_up_spec a Ha)). assert (Ha' : 0 < S a) by (apply lt_succ_r; order'). generalize (proj1 (sqrt_up_spec (S a) Ha')). rewrite EQ, pred_succ, lt_succ_r. order. + exists 0. nzsimpl. now split. - intros (b & Hb & H). now rewrite H, sqrt_up_succ_square, sqrt_up_square. Qed. (** [sqrt_up] and addition *) Lemma sqrt_up_add_le : forall a b, √°(a+b) <= √°a + √°b. Proof. assert (AUX : forall a b, a<=0 -> √°(a+b) <= √°a + √°b). - intros a b Ha. rewrite (sqrt_up_eqn0 a Ha). nzsimpl. apply sqrt_up_le_mono. rewrite <- (add_0_l b) at 2. apply add_le_mono_r; order. - intros a b. destruct (le_gt_cases a 0) as [Ha|Ha]. + now apply AUX. + destruct (le_gt_cases b 0) as [Hb|Hb]. * rewrite (add_comm a), (add_comm (√°a)); now apply AUX. * rewrite 2 sqrt_up_eqn; trivial. -- nzsimpl. rewrite <- succ_le_mono. transitivity (√(P a) + √b). ++ rewrite <- (lt_succ_pred 0 a Ha) at 1. nzsimpl. apply sqrt_add_le. ++ apply add_le_mono_l. apply le_sqrt_sqrt_up. -- now apply add_pos_pos. Qed. (** Convexity-like inequality for [sqrt_up]: [sqrt_up] of middle is above middle of square roots. We cannot say more, for instance take a=b=2, then 2+2 <= S 3 *) Lemma add_sqrt_up_le : forall a b, 0<=a -> 0<=b -> √°a + √°b <= S √°(2*(a+b)). Proof. intros a b Ha Hb. le_elim Ha;[le_elim Hb|]. - rewrite 3 sqrt_up_eqn; trivial. + nzsimpl. rewrite <- 2 succ_le_mono. etransitivity; [eapply add_sqrt_le|]. * apply lt_succ_r. now rewrite (lt_succ_pred 0 a Ha). * apply lt_succ_r. now rewrite (lt_succ_pred 0 b Hb). * apply sqrt_le_mono. apply lt_succ_r. rewrite (lt_succ_pred 0). -- apply mul_lt_mono_pos_l. ++ order'. ++ apply add_lt_mono. ** apply le_succ_l. now rewrite (lt_succ_pred 0). ** apply le_succ_l. now rewrite (lt_succ_pred 0). -- apply mul_pos_pos. ++ order'. ++ now apply add_pos_pos. + apply mul_pos_pos. * order'. * now apply add_pos_pos. - rewrite <- Hb, sqrt_up_0. nzsimpl. apply le_le_succ_r, sqrt_up_le_mono. rewrite <- (mul_1_l a) at 1. apply mul_le_mono_nonneg_r; order'. - rewrite <- Ha, sqrt_up_0. nzsimpl. apply le_le_succ_r, sqrt_up_le_mono. rewrite <- (mul_1_l b) at 1. apply mul_le_mono_nonneg_r; order'. Qed. End NZSqrtUpProp. coq-8.20.0/theories/Numbers/Natural/000077500000000000000000000000001466560755400172505ustar00rootroot00000000000000coq-8.20.0/theories/Numbers/Natural/Abstract/000077500000000000000000000000001466560755400210135ustar00rootroot00000000000000coq-8.20.0/theories/Numbers/Natural/Abstract/NAdd.v000066400000000000000000000056621466560755400220210ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* n == 0 /\ m == 0. Proof. intros n m; induct n. - nzsimpl; intuition auto with relations. - intros n IH. nzsimpl. setoid_replace (S (n + m) == 0) with False by (apply neg_false; apply neq_succ_0). setoid_replace (S n == 0) with False by (apply neg_false; apply neq_succ_0). tauto. Qed. Theorem eq_add_succ : forall n m, (exists p, n + m == S p) <-> (exists n', n == S n') \/ (exists m', m == S m'). Proof. intros n m; cases n. - split; intro H. + destruct H as [p H]. rewrite add_0_l in H; right; now exists p. + destruct H as [[n' H] | [m' H]]. * symmetry in H; false_hyp H neq_succ_0. * exists m'; now rewrite add_0_l. - intro n; split; intro H. + left; now exists n. + exists (n + m); now rewrite add_succ_l. Qed. Theorem eq_add_1 : forall n m, n + m == 1 -> n == 1 /\ m == 0 \/ n == 0 /\ m == 1. Proof. intros n m. rewrite one_succ. intro H. assert (H1 : exists p, n + m == S p) by now exists 0. apply eq_add_succ in H1. destruct H1 as [[n' H1] | [m' H1]]. - left. rewrite H1 in H; rewrite add_succ_l in H; apply succ_inj in H. apply eq_add_0 in H. destruct H as [H2 H3]; rewrite H2 in H1; now split. - right. rewrite H1 in H; rewrite add_succ_r in H; apply succ_inj in H. apply eq_add_0 in H. destruct H as [H2 H3]; rewrite H3 in H1; now split. Qed. Theorem succ_add_discr : forall n m, m ~= S (n + m). Proof. intros n m; induct m. - apply neq_sym. apply neq_succ_0. - intros m IH H. apply succ_inj in H. rewrite add_succ_r in H. unfold not in IH; now apply IH. Qed. Theorem add_pred_l : forall n m, n ~= 0 -> P n + m == P (n + m). Proof. intros n m; cases n. - intro H; now elim H. - intros n IH; rewrite add_succ_l; now do 2 rewrite pred_succ. Qed. Theorem add_pred_r : forall n m, m ~= 0 -> n + P m == P (n + m). Proof. intros n m H; rewrite (add_comm n (P m)); rewrite (add_comm n m); now apply add_pred_l. Qed. End NAddProp. coq-8.20.0/theories/Numbers/Natural/Abstract/NAddOrder.v000066400000000000000000000034411466560755400230060ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* n < m + p. Proof. intros n m p H; rewrite <- (add_0_r n). apply add_lt_le_mono; [assumption | apply le_0_l]. Qed. Theorem lt_lt_add_l : forall n m p, n < m -> n < p + m. Proof. intros n m p; rewrite add_comm; apply lt_lt_add_r. Qed. Theorem add_pos_l : forall n m, 0 < n -> 0 < n + m. Proof. intros; apply add_pos_nonneg. - assumption. - apply le_0_l. Qed. Theorem add_pos_r : forall n m, 0 < m -> 0 < n + m. Proof. intros; apply add_nonneg_pos. - apply le_0_l. - assumption. Qed. End NAddOrderProp. coq-8.20.0/theories/Numbers/Natural/Abstract/NAxioms.v000066400000000000000000000055271466560755400225710ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* a mod b < b. End NDivSpecific. (** For all other functions, the NZ axiomatizations are enough. *) (** We now group everything together. *) Module Type NAxiomsSig := NAxiomsMiniSig <+ OrderFunctions <+ NZParity.NZParity <+ NZPow.NZPow <+ NZSqrt.NZSqrt <+ NZLog.NZLog2 <+ NZGcd.NZGcd <+ NZDiv.NZDiv <+ NZBits.NZBits <+ NZSquare. Module Type NAxiomsSig' := NAxiomsMiniSig' <+ OrderFunctions' <+ NZParity.NZParity <+ NZPow.NZPow' <+ NZSqrt.NZSqrt' <+ NZLog.NZLog2 <+ NZGcd.NZGcd' <+ NZDiv.NZDiv' <+ NZBits.NZBits' <+ NZSquare. (** It could also be interesting to have a constructive recursor function. *) Module Type NAxiomsRec (Import NZ : NZDomainSig'). Parameter Inline recursion : forall {A : Type}, A -> (t -> A -> A) -> t -> A. #[global] Declare Instance recursion_wd {A : Type} (Aeq : relation A) : Proper (Aeq ==> (eq==>Aeq==>Aeq) ==> eq ==> Aeq) recursion. Axiom recursion_0 : forall {A} (a : A) (f : t -> A -> A), recursion a f 0 = a. Axiom recursion_succ : forall {A} (Aeq : relation A) (a : A) (f : t -> A -> A), Aeq a a -> Proper (eq==>Aeq==>Aeq) f -> forall n, Aeq (recursion a f (S n)) (f n (recursion a f n)). End NAxiomsRec. Module Type NAxiomsRecSig := NAxiomsMiniSig <+ NAxiomsRec. Module Type NAxiomsRecSig' := NAxiomsMiniSig' <+ NAxiomsRec. Module Type NAxiomsFullSig := NAxiomsSig <+ NAxiomsRec. Module Type NAxiomsFullSig' := NAxiomsSig' <+ NAxiomsRec. coq-8.20.0/theories/Numbers/Natural/Abstract/NBase.v000066400000000000000000000124041466560755400221730ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* Prop, Proper (N.eq==>iff) A -> A 0 -> (forall n, A n -> A (S n)) -> forall n, A n. Proof. intros A A_wd A0 AS n; apply right_induction with 0; try assumption. - intros; auto; apply le_0_l. - apply le_0_l. Qed. (** The theorems [bi_induction], [central_induction] and the tactic [nzinduct] refer to bidirectional induction, which is not useful on natural numbers. Therefore, we define a new induction tactic for natural numbers. We do not have to call "Declare Left Step" and "Declare Right Step" commands again, since the data for stepl and stepr tactics is inherited from NZ. *) Ltac induct n := induction_maker n ltac:(apply induction). Theorem case_analysis : forall A : N.t -> Prop, Proper (N.eq==>iff) A -> A 0 -> (forall n, A (S n)) -> forall n, A n. Proof. intros; apply induction; auto. Qed. Ltac cases n := induction_maker n ltac:(apply case_analysis). Theorem neq_0 : ~ forall n, n == 0. Proof. intro H; apply (neq_succ_0 0). apply H. Qed. Theorem neq_0_r n : n ~= 0 <-> exists m, n == S m. Proof. cases n. - split; intro H;[now elim H | destruct H as [m H]; symmetry in H; false_hyp H neq_succ_0]. - intro n; split; intro H; [now exists n | apply neq_succ_0]. Qed. Theorem zero_or_succ n : n == 0 \/ exists m, n == S m. Proof. cases n. - now left. - intro n; right; now exists n. Qed. Theorem eq_pred_0 n : P n == 0 <-> n == 0 \/ n == 1. Proof. cases n. - rewrite pred_0. now split; [left|]. - intro n. rewrite pred_succ. split. + intros H; right. now rewrite H, one_succ. + intros [H|H]. * elim (neq_succ_0 _ H). * apply succ_inj_wd. now rewrite <- one_succ. Qed. Theorem succ_pred n : n ~= 0 -> S (P n) == n. Proof. cases n. - intro H; exfalso; now apply H. - intros; now rewrite pred_succ. Qed. Theorem pred_inj n m : n ~= 0 -> m ~= 0 -> P n == P m -> n == m. Proof. cases n. - intros H; exfalso; now apply H. - intros n _; cases m. + intros H; exfalso; now apply H. + intros m H2 H3. do 2 rewrite pred_succ in H3. now rewrite H3. Qed. (** The following induction principle is useful for reasoning about, e.g., Fibonacci numbers *) Section PairInduction. Variable A : N.t -> Prop. Hypothesis A_wd : Proper (N.eq==>iff) A. Theorem pair_induction : A 0 -> A 1 -> (forall n, A n -> A (S n) -> A (S (S n))) -> forall n, A n. Proof. rewrite one_succ. intros until 3. assert (D : forall n, A n /\ A (S n)); [ |intro n; exact (proj1 (D n))]. intro n; induct n; [ | intros n [IH1 IH2]]; auto. Qed. End PairInduction. (** The following is useful for reasoning about, e.g., Ackermann function *) Section TwoDimensionalInduction. Variable R : N.t -> N.t -> Prop. Hypothesis R_wd : Proper (N.eq==>N.eq==>iff) R. Theorem two_dim_induction : R 0 0 -> (forall n m, R n m -> R n (S m)) -> (forall n, (forall m, R n m) -> R (S n) 0) -> forall n m, R n m. Proof. intros H1 H2 H3. intro n; induct n. - intro m; induct m. + exact H1. + exact (H2 0). - intros n IH. intro m; induct m. + now apply H3. + exact (H2 (S n)). Qed. End TwoDimensionalInduction. Section DoubleInduction. Variable R : N.t -> N.t -> Prop. Hypothesis R_wd : Proper (N.eq==>N.eq==>iff) R. Theorem double_induction : (forall m, R 0 m) -> (forall n, R (S n) 0) -> (forall n m, R n m -> R (S n) (S m)) -> forall n m, R n m. Proof. intros H1 H2 H3 n; induct n; auto. intros n H m; cases m; auto. Qed. End DoubleInduction. Ltac double_induct n m := try intros until n; try intros until m; pattern n, m; apply double_induction; clear n m; [solve_proper | | | ]. End NBaseProp. coq-8.20.0/theories/Numbers/Natural/Abstract/NBits.v000066400000000000000000001472641466560755400222370ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* c<=b -> a^(b-c) == a^b / a^c. Proof. intros a b c Ha H. apply div_unique with 0. - generalize (pow_nonzero a c Ha) (le_0_l (a^c)); order'. - nzsimpl. now rewrite <- pow_add_r, add_comm, sub_add. Qed. Lemma pow_div_l : forall a b c, b~=0 -> a mod b == 0 -> (a/b)^c == a^c / b^c. Proof. intros a b c Hb H. apply div_unique with 0. - generalize (pow_nonzero b c Hb) (le_0_l (b^c)); order'. - nzsimpl. rewrite <- pow_mul_l. f_equiv. now apply div_exact. Qed. (** An injection from bits [true] and [false] to numbers 1 and 0. We declare it as a (local) coercion for shorter statements. *) Definition b2n (b:bool) := if b then 1 else 0. Local Coercion b2n : bool >-> t. #[global] Instance b2n_proper : Proper (Logic.eq ==> eq) b2n. Proof. solve_proper. Qed. Lemma b2n_le_1 (b : bool) : b <= 1. Proof. destruct b as [|]; [exact (le_refl _) | exact le_0_1]. Qed. Lemma exists_div2 a : exists a' (b:bool), a == 2*a' + b. Proof. elim (Even_or_Odd a); [intros (a',H)| intros (a',H)]. - exists a'. exists false. now nzsimpl. - exists a'. exists true. now simpl. Qed. (* This is kept private in order to drop the `Proper` condition in implementations. *) (* begin hide *) Lemma Private_binary_induction (A : t -> Prop) : (Proper (eq ==> iff) A) -> A 0 -> (forall n, A n -> A (2 * n)) -> (forall n, A n -> A (2 * n + 1)) -> (forall n, A n). Proof. intros H H0 I J. apply Private_strong_induction_le; [exact H | exact H0 |]; intros n Hm. pose proof (exists_div2 (S n)) as [m [[|] Hmb]]; simpl in Hmb; rewrite Hmb. - apply J, Hm. rewrite add_1_r in Hmb; apply succ_inj in Hmb; rewrite Hmb, two_succ. apply le_mul_l; exact (neq_succ_0 1). - rewrite add_0_r in *; apply I, Hm; apply <-succ_le_mono; rewrite Hmb. rewrite <-(add_1_r), two_succ, mul_succ_l, mul_1_l. apply add_le_mono_l, neq_0_le_1; intros C; rewrite C, mul_0_r in Hmb. exact (neq_succ_0 _ Hmb). Qed. (* end hide *) (** We can compact [testbit_odd_0] [testbit_even_0] [testbit_even_succ] [testbit_odd_succ] in only two lemmas. *) Lemma testbit_0_r a (b:bool) : testbit (2*a+b) 0 = b. Proof. destruct b; simpl; rewrite ?add_0_r. - apply testbit_odd_0. - apply testbit_even_0. Qed. Lemma testbit_succ_r a (b:bool) n : testbit (2*a+b) (succ n) = testbit a n. Proof. destruct b; simpl; rewrite ?add_0_r. - apply testbit_odd_succ, le_0_l. - apply testbit_even_succ, le_0_l. Qed. (** Specification without useless condition on the bit number *) Lemma testbit_odd_succ' a n : testbit (2*a+1) (S n) = testbit a n. Proof. apply testbit_odd_succ; exact (le_0_l n). Qed. Lemma testbit_even_succ' a n : testbit (2*a) (S n) = testbit a n. Proof. apply testbit_even_succ; exact (le_0_l n). Qed. (** Alternative characterisations of [testbit] *) (** This concise equation could have been taken as specification for testbit in the interface, but it would have been hard to implement with little initial knowledge about div and mod *) Lemma testbit_spec' a n : a.[n] == (a / 2^n) mod 2. Proof. revert a. induct n. - intros a. nzsimpl. destruct (exists_div2 a) as (a' & b & H). rewrite H at 1. rewrite testbit_0_r. apply mod_unique with a'; trivial. destruct b; order'. - intros n IH a. destruct (exists_div2 a) as (a' & b & H). rewrite H at 1. rewrite testbit_succ_r, IH. f_equiv. rewrite pow_succ_r', <- div_div by order_nz. f_equiv. apply div_unique with b; trivial. destruct b; order'. Qed. (** This characterisation that uses only basic operations and power was initially taken as specification for testbit. We describe [a] as having a low part and a high part, with the corresponding bit in the middle. This characterisation is moderatly complex to implement, but also moderately usable... *) Lemma testbit_spec a n : exists l h, 0<=l<2^n /\ a == l + (a.[n] + 2*h)*2^n. Proof. exists (a mod 2^n). exists (a / 2^n / 2). split. - split; [apply le_0_l | apply mod_upper_bound; order_nz]. - rewrite add_comm, mul_comm, (add_comm a.[n]). rewrite (div_mod a (2^n)) at 1 by order_nz. do 2 f_equiv. rewrite testbit_spec'. apply div_mod. order'. Qed. Lemma testbit_true : forall a n, a.[n] = true <-> (a / 2^n) mod 2 == 1. Proof. intros a n. rewrite <- testbit_spec'; destruct a.[n]; split; simpl; now try order'. Qed. Lemma testbit_false : forall a n, a.[n] = false <-> (a / 2^n) mod 2 == 0. Proof. intros a n. rewrite <- testbit_spec'; destruct a.[n]; split; simpl; now try order'. Qed. Lemma testbit_eqb : forall a n, a.[n] = eqb ((a / 2^n) mod 2) 1. Proof. intros a n. apply eq_true_iff_eq. now rewrite testbit_true, eqb_eq. Qed. (** Results about the injection [b2n] *) Lemma b2n_inj : forall (a0 b0:bool), a0 == b0 -> a0 = b0. Proof. intros [|] [|]; simpl; trivial; order'. Qed. Lemma add_b2n_double_div2 : forall (a0:bool) a, (a0+2*a)/2 == a. Proof. intros a0 a. rewrite mul_comm, div_add by order'. now rewrite div_small, add_0_l by (destruct a0; order'). Qed. Lemma add_b2n_double_bit0 : forall (a0:bool) a, (a0+2*a).[0] = a0. Proof. intros a0 a. apply b2n_inj. rewrite testbit_spec'. nzsimpl. rewrite mul_comm, mod_add by order'. now rewrite mod_small by (destruct a0; order'). Qed. Lemma b2n_div2 : forall (a0:bool), a0/2 == 0. Proof. intros a0. rewrite <- (add_b2n_double_div2 a0 0). now nzsimpl. Qed. Lemma b2n_bit0 : forall (a0:bool), a0.[0] = a0. Proof. intros a0. rewrite <- (add_b2n_double_bit0 a0 0) at 2. now nzsimpl. Qed. (** The specification of testbit by low and high parts is complete *) Lemma testbit_unique : forall a n (a0:bool) l h, l<2^n -> a == l + (a0 + 2*h)*2^n -> a.[n] = a0. Proof. intros a n a0 l h Hl EQ. apply b2n_inj. rewrite testbit_spec' by trivial. symmetry. apply mod_unique with h. - destruct a0; simpl; order'. - symmetry. apply div_unique with l; trivial. now rewrite add_comm, (add_comm _ a0), mul_comm. Qed. (** All bits of number 0 are 0 *) Lemma bits_0 : forall n, 0.[n] = false. Proof. intros n. apply testbit_false. nzsimpl; order_nz. Qed. (** Various ways to refer to the lowest bit of a number *) Lemma bit0_odd : forall a, a.[0] = odd a. Proof. intros a. symmetry. destruct (exists_div2 a) as (a' & b & EQ). rewrite EQ, testbit_0_r, add_comm, odd_add_mul_2. destruct b; simpl; apply odd_1 || apply odd_0. Qed. Lemma bit0_eqb : forall a, a.[0] = eqb (a mod 2) 1. Proof. intros a. rewrite testbit_eqb. now nzsimpl. Qed. Lemma bit0_mod : forall a, a.[0] == a mod 2. Proof. intros a. rewrite testbit_spec'. now nzsimpl. Qed. (** Hence testing a bit is equivalent to shifting and testing parity *) Lemma testbit_odd : forall a n, a.[n] = odd (a>>n). Proof. intros. now rewrite <- bit0_odd, shiftr_spec, add_0_l. Qed. (** [log2] gives the highest nonzero bit *) Lemma bit_log2 : forall a, a~=0 -> a.[log2 a] = true. Proof. intros a Ha. assert (Ha' : 0 < a) by (generalize (le_0_l a); order). destruct (log2_spec_alt a Ha') as (r & EQ & (_,Hr)). rewrite EQ at 1. rewrite testbit_true, add_comm. rewrite <- (mul_1_l (2^log2 a)) at 1. rewrite div_add by order_nz. rewrite div_small by trivial. rewrite add_0_l. apply mod_small. order'. Qed. Lemma bits_above_log2 : forall a n, log2 a < n -> a.[n] = false. Proof. intros a n H. rewrite testbit_false. rewrite div_small. - nzsimpl; order'. - apply log2_lt_cancel. rewrite log2_pow2; trivial using le_0_l. Qed. (** Hence the number of bits of [a] is [1+log2 a] (see [Pos.size_nat] and [Pos.size]). *) (** Testing bits after division or multiplication by a power of two *) Lemma testbit_div2 : forall a n, (div2 a).[n] = a.[S n]. Proof. intros a n; rewrite div2_spec, shiftr_spec, add_1_r by (exact (le_0_l _)); reflexivity. Qed. Lemma div2_bits : forall a n, (a/2).[n] = a.[S n]. Proof. intros. apply eq_true_iff_eq. rewrite 2 testbit_true. rewrite pow_succ_r by apply le_0_l. now rewrite div_div by order_nz. Qed. Lemma div_pow2_bits : forall a n m, (a/2^n).[m] = a.[m+n]. Proof. intros a n. revert a. induct n. - intros a m. now nzsimpl. - intros n IH a m. nzsimpl; try apply le_0_l. rewrite <- div_div by order_nz. now rewrite IH, div2_bits. Qed. Lemma double_bits_succ : forall a n, (2*a).[S n] = a.[n]. Proof. intros. rewrite <- div2_bits. now rewrite mul_comm, div_mul by order'. Qed. Lemma mul_pow2_bits_add : forall a n m, (a*2^n).[m+n] = a.[m]. Proof. intros. rewrite <- div_pow2_bits. now rewrite div_mul by order_nz. Qed. Lemma mul_pow2_bits_high : forall a n m, n<=m -> (a*2^n).[m] = a.[m-n]. Proof. intros a n m ?. rewrite <- (sub_add n m) at 1 by order'. now rewrite mul_pow2_bits_add. Qed. Lemma mul_pow2_bits_low : forall a n m, m (a*2^n).[m] = false. Proof. intros a n m H. apply testbit_false. rewrite <- (sub_add m n) by order'. rewrite pow_add_r, mul_assoc. rewrite div_mul by order_nz. rewrite <- (succ_pred (n-m)). - rewrite pow_succ_r. + now rewrite (mul_comm 2), mul_assoc, mod_mul by order'. + apply lt_le_pred. apply sub_gt in H. generalize (le_0_l (n-m)); order. - now apply sub_gt. Qed. (** Selecting the low part of a number can be done by a modulo *) Lemma mod_pow2_bits_high : forall a n m, n<=m -> (a mod 2^n).[m] = false. Proof. intros a n m H. destruct (eq_0_gt_0_cases (a mod 2^n)) as [EQ|LT]. - now rewrite EQ, bits_0. - apply bits_above_log2. apply lt_le_trans with n; trivial. apply log2_lt_pow2; trivial. apply mod_upper_bound; order_nz. Qed. Lemma mod_pow2_bits_low : forall a n m, m (a mod 2^n).[m] = a.[m]. Proof. intros a n m H. rewrite testbit_eqb. rewrite <- (mod_add _ (2^(P (n-m))*(a/2^n))) by order'. rewrite <- div_add by order_nz. rewrite (mul_comm _ 2), mul_assoc, <- pow_succ_r', succ_pred by now apply sub_gt. rewrite mul_comm, mul_assoc, <- pow_add_r, (add_comm m), sub_add by order. rewrite add_comm, <- div_mod by order_nz. symmetry. apply testbit_eqb. Qed. (** We now prove that having the same bits implies equality. For that we use a notion of equality over functional streams of bits. *) Definition eqf (f g:t -> bool) := forall n:t, f n = g n. #[global] Instance eqf_equiv : Equivalence eqf. Proof. split; congruence. Qed. Local Infix "===" := eqf (at level 70, no associativity). #[global] Instance testbit_eqf : Proper (eq==>eqf) testbit. Proof. intros a a' Ha n. now rewrite Ha. Qed. (** Only zero corresponds to the always-false stream. *) Lemma bits_inj_0 : forall a, (forall n, a.[n] = false) -> a == 0. Proof. intros a H. destruct (eq_decidable a 0) as [EQ|NEQ]; trivial. apply bit_log2 in NEQ. now rewrite H in NEQ. Qed. (** If two numbers produce the same stream of bits, they are equal. *) Lemma bits_inj : forall a b, testbit a === testbit b -> a == b. Proof. intros a. pattern a. apply strong_right_induction with 0;[clear a|apply le_0_l]. intros a _ IH b H. destruct (eq_0_gt_0_cases a) as [EQ|LT]. - rewrite EQ in H |- *. symmetry. apply bits_inj_0. intros n. now rewrite <- H, bits_0. - rewrite (div_mod a 2), (div_mod b 2) by order'. f_equiv; [ | now rewrite <- 2 bit0_mod, H]. f_equiv. apply IH; trivial using le_0_l. + apply div_lt; order'. + intro n. rewrite 2 div2_bits. apply H. Qed. Lemma bits_inj_iff : forall a b, testbit a === testbit b <-> a == b. Proof. split. - apply bits_inj. - intros EQ; now rewrite EQ. Qed. Global Hint Rewrite lxor_spec lor_spec land_spec ldiff_spec bits_0 : bitwise. Tactic Notation "bitwise" "as" simple_intropattern(m) := apply bits_inj; intros m; autorewrite with bitwise. Ltac bitwise := bitwise as ?m. (** The streams of bits that correspond to a natural numbers are exactly the ones that are always 0 after some point *) Lemma are_bits : forall (f:t->bool), Proper (eq==>Logic.eq) f -> ((exists n, f === testbit n) <-> (exists k, forall m, k<=m -> f m = false)). Proof. intros f Hf. split. - intros (a,H). exists (S (log2 a)). intros m Hm. apply le_succ_l in Hm. rewrite H, bits_above_log2; trivial using lt_succ_diag_r. - intros (k,Hk). revert f Hf Hk. induct k. + intros f Hf H0. exists 0. intros m. rewrite bits_0, H0; trivial. apply le_0_l. + intros k IH f Hf Hk. destruct (IH (fun m => f (S m))) as (n, Hn). * solve_proper. * intros m Hm. apply Hk. now rewrite <- succ_le_mono. * { exists (f 0 + 2*n). intros m. destruct (zero_or_succ m) as [Hm|(m', Hm)]; rewrite Hm. - symmetry. apply add_b2n_double_bit0. - rewrite Hn, <- div2_bits. rewrite mul_comm, div_add, b2n_div2, add_0_l; trivial. order'. } Qed. (** Properties of shifts *) Lemma shiftr_spec' : forall a n m, (a >> n).[m] = a.[m+n]. Proof. intros. apply shiftr_spec. apply le_0_l. Qed. Lemma shiftl_spec_high' : forall a n m, n<=m -> (a << n).[m] = a.[m-n]. Proof. intros. apply shiftl_spec_high; trivial. apply le_0_l. Qed. Lemma shiftr_div_pow2 : forall a n, a >> n == a / 2^n. Proof. intros. bitwise. rewrite shiftr_spec'. symmetry. apply div_pow2_bits. Qed. Lemma shiftl_mul_pow2 : forall a n, a << n == a * 2^n. Proof. intros a n. bitwise as m. destruct (le_gt_cases n m) as [H|H]. - now rewrite shiftl_spec_high', mul_pow2_bits_high. - now rewrite shiftl_spec_low, mul_pow2_bits_low. Qed. Lemma shiftl_spec_alt : forall a n m, (a << n).[m+n] = a.[m]. Proof. intros. now rewrite shiftl_mul_pow2, mul_pow2_bits_add. Qed. #[global] Instance shiftr_wd : Proper (eq==>eq==>eq) shiftr. Proof. intros a a' Ha b b' Hb. now rewrite 2 shiftr_div_pow2, Ha, Hb. Qed. #[global] Instance shiftl_wd : Proper (eq==>eq==>eq) shiftl. Proof. intros a a' Ha b b' Hb. now rewrite 2 shiftl_mul_pow2, Ha, Hb. Qed. Lemma shiftl_shiftl : forall a n m, (a << n) << m == a << (n+m). Proof. intros. now rewrite !shiftl_mul_pow2, pow_add_r, mul_assoc. Qed. Lemma shiftr_shiftr : forall a n m, (a >> n) >> m == a >> (n+m). Proof. intros. now rewrite !shiftr_div_pow2, pow_add_r, div_div by order_nz. Qed. Lemma shiftr_shiftl_l : forall a n m, m<=n -> (a << n) >> m == a << (n-m). Proof. intros a n m ?. rewrite shiftr_div_pow2, !shiftl_mul_pow2. rewrite <- (sub_add m n) at 1 by trivial. now rewrite pow_add_r, mul_assoc, div_mul by order_nz. Qed. Lemma shiftr_shiftl_r : forall a n m, n<=m -> (a << n) >> m == a >> (m-n). Proof. intros a n m ?. rewrite !shiftr_div_pow2, shiftl_mul_pow2. rewrite <- (sub_add n m) at 1 by trivial. rewrite pow_add_r, (mul_comm (2^(m-n))). now rewrite <- div_div, div_mul by order_nz. Qed. (** shifts and constants *) Lemma shiftl_1_l : forall n, 1 << n == 2^n. Proof. intros. now rewrite shiftl_mul_pow2, mul_1_l. Qed. Lemma shiftl_0_r : forall a, a << 0 == a. Proof. intros. rewrite shiftl_mul_pow2. now nzsimpl. Qed. Lemma shiftr_0_r : forall a, a >> 0 == a. Proof. intros. rewrite shiftr_div_pow2. now nzsimpl. Qed. Lemma shiftl_0_l : forall n, 0 << n == 0. Proof. intros. rewrite shiftl_mul_pow2. now nzsimpl. Qed. Lemma shiftr_0_l : forall n, 0 >> n == 0. Proof. intros. rewrite shiftr_div_pow2. nzsimpl; order_nz. Qed. Lemma shiftl_eq_0_iff : forall a n, a << n == 0 <-> a == 0. Proof. intros a n. rewrite shiftl_mul_pow2. rewrite eq_mul_0. split. - intros [H | H]; trivial. contradict H; order_nz. - intros H. now left. Qed. Lemma shiftr_eq_0_iff : forall a n, a >> n == 0 <-> a==0 \/ (0 a >> n == 0. Proof. intros a n H. rewrite shiftr_eq_0_iff. destruct (eq_0_gt_0_cases a) as [EQ|LT]. - now left. - right; now split. Qed. (** Properties of [div2]. *) Lemma div2_div : forall a, div2 a == a/2. Proof. intros. rewrite div2_spec, shiftr_div_pow2. now nzsimpl. Qed. Lemma div2_0 : div2 0 == 0. Proof. rewrite div2_div, div_0_l by (rewrite two_succ; exact (neq_succ_0 _)). reflexivity. Qed. Lemma div2_1 : div2 1 == 0. Proof. rewrite div2_div, div_small by (exact lt_1_2); reflexivity. Qed. Lemma div2_le_mono : forall a b, a <= b -> div2 a <= div2 b. Proof. intros a b H; rewrite 2!div2_div; apply div_le_mono; [| exact H]. rewrite two_succ; exact (neq_succ_0 1). Qed. #[global] Instance div2_wd : Proper (eq==>eq) div2. Proof. intros a a' Ha. now rewrite 2 div2_div, Ha. Qed. Lemma div2_odd : forall a, a == 2*(div2 a) + odd a. Proof. intros a. rewrite div2_div, <- bit0_odd, bit0_mod. apply div_mod. order'. Qed. Lemma div2_even : forall a, div2 (2 * a) == a. Proof. intros a; rewrite div2_div, mul_comm, div_mul by (rewrite two_succ; exact (neq_succ_0 _)); reflexivity. Qed. Lemma div2_odd' : forall a, div2 (2 * a + 1) == a. Proof. intros a; rewrite div2_div; symmetry; apply (div_unique _ _ _ 1); [exact lt_1_2 | reflexivity]. Qed. Lemma le_div2_diag_l a : div2 a <= a. Proof. rewrite (div2_odd a) at 2; rewrite <-(mul_1_l (div2 a)) at 1. apply (le_trans _ (2 * (div2 a))). - apply mul_le_mono_r, lt_le_incl; exact lt_1_2. - exact (le_add_r _ _). Qed. Lemma div2_le_upper_bound a q : a <= 2 * q -> div2 a <= q. Proof. rewrite div2_div, two_succ; apply div_le_upper_bound; exact (neq_succ_0 _). Qed. Lemma div2_le_lower_bound a q : 2 * q <= a -> q <= div2 a. Proof. rewrite div2_div, two_succ; apply div_le_lower_bound; exact (neq_succ_0 _). Qed. Lemma lt_div2_diag_l a : a ~= 0 -> div2 a < a. Proof. destruct (zero_or_succ a) as [| [b ->]]; [| clear a]. { intros H'; contradict H'; rewrite H; reflexivity. } destruct (zero_or_succ b) as [| [c ->]]; [| clear b]. { intros _; rewrite H, <-one_succ, div2_1; exact lt_0_1. } intros _; rewrite (div2_odd (S (S c))) at 2. rewrite <-(mul_1_l (div2 _)) at 1; apply lt_lt_add_r, mul_lt_mono_pos_r; [| exact lt_1_2]. apply lt_le_trans with (1 := lt_0_1). apply div2_le_lower_bound; rewrite mul_1_r, two_succ, one_succ. apply ->succ_le_mono; apply ->succ_le_mono; exact (le_0_l _). Qed. Lemma le_div2 n : div2 (S n) <= n. Proof. destruct (zero_or_succ n) as [-> | [k ->]]; [| clear n]. { rewrite <-one_succ, div2_1; exact (le_0_l 0). } apply div2_le_upper_bound. setoid_replace (2 * (S k)) with (S k + S k); cycle 1. { rewrite two_succ, <-(add_1_r 1), mul_add_distr_r, mul_1_l; reflexivity. } rewrite add_succ_r; apply ->succ_le_mono; exact (le_add_r _ _). Qed. Lemma lt_div2 n : 0 < n -> div2 n < n. Proof. intros H%lt_neq%neq_sym; exact (lt_div2_diag_l _ H). Qed. Lemma div2_decr a n : a <= S n -> div2 a <= n. Proof. destruct (zero_or_succ a) as [-> | [b ->]]; [intros _ | clear a]. { rewrite div2_0; exact (le_0_l _). } intros H%div2_le_mono; apply le_trans with (1 := H); exact (le_div2 n). Qed. (** Properties of [lxor] and others, directly deduced from properties of [xorb] and others. *) #[global] Instance lxor_wd : Proper (eq ==> eq ==> eq) lxor. Proof. intros a a' Ha b b' Hb. bitwise. now rewrite Ha, Hb. Qed. #[global] Instance land_wd : Proper (eq ==> eq ==> eq) land. Proof. intros a a' Ha b b' Hb. bitwise. now rewrite Ha, Hb. Qed. #[global] Instance lor_wd : Proper (eq ==> eq ==> eq) lor. Proof. intros a a' Ha b b' Hb. bitwise. now rewrite Ha, Hb. Qed. #[global] Instance ldiff_wd : Proper (eq ==> eq ==> eq) ldiff. Proof. intros a a' Ha b b' Hb. bitwise. now rewrite Ha, Hb. Qed. Lemma lxor_eq : forall a a', lxor a a' == 0 -> a == a'. Proof. intros a a' H. bitwise. apply xorb_eq. now rewrite <- lxor_spec, H, bits_0. Qed. Lemma lxor_nilpotent : forall a, lxor a a == 0. Proof. intros. bitwise. apply xorb_nilpotent. Qed. Lemma lxor_eq_0_iff : forall a a', lxor a a' == 0 <-> a == a'. Proof. split. - apply lxor_eq. - intros EQ; rewrite EQ; apply lxor_nilpotent. Qed. Lemma lxor_0_l : forall a, lxor 0 a == a. Proof. intros. bitwise. apply xorb_false_l. Qed. Lemma lxor_0_r : forall a, lxor a 0 == a. Proof. intros. bitwise. apply xorb_false_r. Qed. Lemma lxor_comm : forall a b, lxor a b == lxor b a. Proof. intros. bitwise. apply xorb_comm. Qed. Lemma lxor_assoc : forall a b c, lxor (lxor a b) c == lxor a (lxor b c). Proof. intros. bitwise. apply xorb_assoc. Qed. Lemma lor_0_l : forall a, lor 0 a == a. Proof. intros. bitwise. trivial. Qed. Lemma lor_0_r : forall a, lor a 0 == a. Proof. intros. bitwise. apply orb_false_r. Qed. Lemma lor_comm : forall a b, lor a b == lor b a. Proof. intros. bitwise. apply orb_comm. Qed. Lemma lor_assoc : forall a b c, lor a (lor b c) == lor (lor a b) c. Proof. intros. bitwise. apply orb_assoc. Qed. Lemma lor_diag : forall a, lor a a == a. Proof. intros. bitwise. apply orb_diag. Qed. Lemma lor_eq_0_l : forall a b, lor a b == 0 -> a == 0. Proof. intros a b H. bitwise as m. apply (orb_false_iff a.[m] b.[m]). now rewrite <- lor_spec, H, bits_0. Qed. Lemma lor_eq_0_iff : forall a b, lor a b == 0 <-> a == 0 /\ b == 0. Proof. intros a b. split. - intro H; split. + now apply lor_eq_0_l in H. + rewrite lor_comm in H. now apply lor_eq_0_l in H. - intros (EQ,EQ'). now rewrite EQ, lor_0_l. Qed. Lemma land_0_l : forall a, land 0 a == 0. Proof. intros. bitwise. trivial. Qed. Lemma land_0_r : forall a, land a 0 == 0. Proof. intros. bitwise. apply andb_false_r. Qed. Lemma land_comm : forall a b, land a b == land b a. Proof. intros. bitwise. apply andb_comm. Qed. Lemma land_assoc : forall a b c, land a (land b c) == land (land a b) c. Proof. intros. bitwise. apply andb_assoc. Qed. Lemma land_diag : forall a, land a a == a. Proof. intros. bitwise. apply andb_diag. Qed. Lemma land_even_l : forall a b, land (2 * a) b == 2 * (land a (div2 b)). Proof. intros a b; rewrite (div2_odd b) at 1; apply bits_inj; intros m. destruct (zero_or_succ m) as [-> | [m' ->]]; rewrite !land_spec. - rewrite 2!testbit_even_0; reflexivity. - rewrite 2!testbit_even_succ, testbit_succ_r, land_spec by exact (le_0_l _). reflexivity. Qed. Lemma land_even_r : forall a b, land a (2 * b) == 2 * (land (div2 a) b). Proof. intros a b; rewrite (land_comm a _), (land_comm _ b); exact (land_even_l _ _). Qed. Lemma land_odd_l : forall a b, land (2 * a + 1) b == 2 * (land a (div2 b)) + odd b. Proof. intros a b; rewrite (div2_odd b) at 1; apply bits_inj; intros m. destruct (zero_or_succ m) as [-> | [m' ->]]; rewrite !land_spec. - rewrite 2!testbit_0_r, testbit_odd_0; reflexivity. - rewrite 2!testbit_succ_r, land_spec, testbit_odd_succ by (exact (le_0_l _)). reflexivity. Qed. Lemma land_odd_r : forall a b, land a (2 * b + 1) == 2 * (land (div2 a) b) + odd a. Proof. intros a b; rewrite (land_comm a _), (land_comm _ b); exact (land_odd_l _ _). Qed. Lemma land_even_even : forall a b, land (2 * a) (2 * b) == 2 * land a b. Proof. intros a b; rewrite land_even_l, div2_even; reflexivity. Qed. Lemma land_odd_even : forall a b, land (2 * a + 1) (2 * b) == 2 * land a b. Proof. intros a b; rewrite land_even_r, div2_odd'; reflexivity. Qed. Lemma land_even_odd : forall a b, land (2 * a) (2 * b + 1) == 2 * land a b. Proof. intros a b; rewrite land_even_l, div2_odd'; reflexivity. Qed. Lemma land_odd_odd : forall a b, land (2 * a + 1) (2 * b + 1) == 2 * (land a b) + 1. Proof. intros a b; rewrite land_odd_l, div2_odd', odd_odd; reflexivity. Qed. Lemma land_le_l : forall a b, land a b <= a. Proof. apply (Private_binary_induction (fun a => forall b, _)); [| | intros a H b..]. - intros x y eq; split; intros H b; [rewrite <-eq | rewrite eq]; now apply H. - intros b; rewrite land_0_l; exact (le_refl _). - rewrite land_even_l; apply mul_le_mono_l; exact (H _). - rewrite land_odd_l; apply add_le_mono; [apply mul_le_mono_l; exact (H _) | exact (b2n_le_1 _)]. Qed. Lemma land_le_r : forall a b, land a b <= b. Proof. intros a b; rewrite land_comm; exact (land_le_l _ _). Qed. Lemma ldiff_0_l : forall a, ldiff 0 a == 0. Proof. intros. bitwise. trivial. Qed. Lemma ldiff_0_r : forall a, ldiff a 0 == a. Proof. intros. bitwise. now rewrite andb_true_r. Qed. Lemma ldiff_diag : forall a, ldiff a a == 0. Proof. intros. bitwise. apply andb_negb_r. Qed. Lemma ldiff_even_l : forall a b, ldiff (2 * a) b == 2 * ldiff a (div2 b). Proof. intros a b; apply bits_inj; intros m. destruct (zero_or_succ m) as [-> | [m' ->]]; rewrite ldiff_spec. - rewrite 2!testbit_even_0; reflexivity. - rewrite 2!testbit_even_succ, ldiff_spec, testbit_div2 by (exact (le_0_l _)); reflexivity. Qed. Lemma ldiff_odd_l : forall a b, ldiff (2 * a + 1) b == 2 * ldiff a (div2 b) + even b. Proof. intros a b; apply bits_inj; intros m. destruct (zero_or_succ m) as [-> | [m' ->]]; rewrite ldiff_spec. - rewrite testbit_odd_0, testbit_0_r, bit0_odd, negb_odd; reflexivity. - rewrite testbit_odd_succ, testbit_succ_r, ldiff_spec, testbit_div2 by (exact (le_0_l _)); reflexivity. Qed. Lemma ldiff_even_r : forall a b, ldiff a (2 * b) == 2 * ldiff (div2 a) b + odd a. Proof. intros a b; apply bits_inj; intros m. destruct (zero_or_succ m) as [-> | [m' ->]]; rewrite ldiff_spec. - rewrite testbit_0_r, testbit_even_0, bit0_odd; simpl; rewrite andb_true_r; reflexivity. - rewrite testbit_succ_r, testbit_even_succ, ldiff_spec, testbit_div2 by (exact (le_0_l _)); reflexivity. Qed. Lemma ldiff_odd_r : forall a b, ldiff a (2 * b + 1) == 2 * ldiff (div2 a) b. Proof. intros a b; apply bits_inj; intros m. destruct (zero_or_succ m) as [-> | [m' ->]]; rewrite ldiff_spec. - rewrite testbit_odd_0, testbit_even_0; simpl; rewrite andb_false_r; reflexivity. - rewrite testbit_odd_succ, testbit_even_succ, ldiff_spec, testbit_div2 by (exact (le_0_l _)); reflexivity. Qed. Lemma ldiff_even_even : forall a b, ldiff (2 * a) (2 * b) == 2 * ldiff a b. Proof. intros a b; rewrite ldiff_even_l, div2_even; reflexivity. Qed. Lemma ldiff_odd_even : forall a b, ldiff (2 * a + 1) (2 * b) == 2 * (ldiff a b) + 1. Proof. intros a b; rewrite ldiff_even_r, div2_odd', odd_odd; reflexivity. Qed. Lemma ldiff_even_odd : forall a b, ldiff (2 * a) (2 * b + 1) == 2 * ldiff a b. Proof. intros a b; rewrite ldiff_even_l, div2_odd'; reflexivity. Qed. Lemma ldiff_odd_odd : forall a b, ldiff (2 * a + 1) (2 * b + 1) == 2 * ldiff a b. Proof. intros a b; rewrite ldiff_odd_r, div2_odd'; reflexivity. Qed. Lemma ldiff_le_l : forall a b, ldiff a b <= a. Proof. apply (Private_binary_induction (fun a => forall b, _)); [| | intros a H b..]. - intros x y eq; split; intros H b; [rewrite <-eq | rewrite eq]; now apply H. - intros b; rewrite ldiff_0_l; exact (le_0_l _). - rewrite ldiff_even_l; apply mul_le_mono_l; exact (H _). - rewrite ldiff_odd_l; apply add_le_mono; [ apply mul_le_mono_l; exact (H _) | exact (b2n_le_1 _)]. Qed. Lemma lor_land_distr_l : forall a b c, lor (land a b) c == land (lor a c) (lor b c). Proof. intros. bitwise. apply orb_andb_distrib_l. Qed. Lemma lor_land_distr_r : forall a b c, lor a (land b c) == land (lor a b) (lor a c). Proof. intros. bitwise. apply orb_andb_distrib_r. Qed. Lemma land_lor_distr_l : forall a b c, land (lor a b) c == lor (land a c) (land b c). Proof. intros. bitwise. apply andb_orb_distrib_l. Qed. Lemma land_lor_distr_r : forall a b c, land a (lor b c) == lor (land a b) (land a c). Proof. intros. bitwise. apply andb_orb_distrib_r. Qed. Lemma ldiff_ldiff_l : forall a b c, ldiff (ldiff a b) c == ldiff a (lor b c). Proof. intros. bitwise. now rewrite negb_orb, andb_assoc. Qed. Lemma lor_ldiff_and : forall a b, lor (ldiff a b) (land a b) == a. Proof. intros. bitwise. now rewrite <- andb_orb_distrib_r, orb_comm, orb_negb_r, andb_true_r. Qed. Lemma land_ldiff : forall a b, land (ldiff a b) b == 0. Proof. intros. bitwise. now rewrite <-andb_assoc, (andb_comm (negb _)), andb_negb_r, andb_false_r. Qed. (** Properties of [setbit] and [clearbit] *) Definition setbit a n := lor a (1<eq==>eq) setbit. Proof. unfold setbit. solve_proper. Qed. #[global] Instance clearbit_wd : Proper (eq==>eq==>eq) clearbit. Proof. unfold clearbit. solve_proper. Qed. Lemma pow2_bits_true : forall n, (2^n).[n] = true. Proof. intros n. rewrite <- (mul_1_l (2^n)). rewrite <- (add_0_l n) at 2. now rewrite mul_pow2_bits_add, bit0_odd, odd_1. Qed. Lemma pow2_bits_false : forall n m, n~=m -> (2^n).[m] = false. Proof. intros n m ?. rewrite <- (mul_1_l (2^n)). destruct (le_gt_cases n m). - rewrite mul_pow2_bits_high; trivial. rewrite <- (succ_pred (m-n)) by (apply sub_gt; order). now rewrite <- div2_bits, div_small, bits_0 by order'. - rewrite mul_pow2_bits_low; trivial. Qed. Lemma pow2_bits_eqb : forall n m, (2^n).[m] = eqb n m. Proof. intros n m. apply eq_true_iff_eq. rewrite eqb_eq. split. - destruct (eq_decidable n m) as [H|H]. { trivial. } now rewrite (pow2_bits_false _ _ H). - intros EQ. rewrite EQ. apply pow2_bits_true. Qed. Lemma setbit_eqb : forall a n m, (setbit a n).[m] = eqb n m || a.[m]. Proof. intros. now rewrite setbit_spec', lor_spec, pow2_bits_eqb, orb_comm. Qed. Lemma setbit_iff : forall a n m, (setbit a n).[m] = true <-> n==m \/ a.[m] = true. Proof. intros. now rewrite setbit_eqb, orb_true_iff, eqb_eq. Qed. Lemma setbit_eq : forall a n, (setbit a n).[n] = true. Proof. intros. apply setbit_iff. now left. Qed. Lemma setbit_neq : forall a n m, n~=m -> (setbit a n).[m] = a.[m]. Proof. intros a n m H. rewrite setbit_eqb. rewrite <- eqb_eq in H. apply not_true_is_false in H. now rewrite H. Qed. Lemma clearbit_eqb : forall a n m, (clearbit a n).[m] = a.[m] && negb (eqb n m). Proof. intros. now rewrite clearbit_spec', ldiff_spec, pow2_bits_eqb. Qed. Lemma clearbit_iff : forall a n m, (clearbit a n).[m] = true <-> a.[m] = true /\ n~=m. Proof. intros. rewrite clearbit_eqb, andb_true_iff, <- eqb_eq. now rewrite negb_true_iff, not_true_iff_false. Qed. Lemma clearbit_eq : forall a n, (clearbit a n).[n] = false. Proof. intros a n. rewrite clearbit_eqb, (proj2 (eqb_eq _ _) (eq_refl n)). apply andb_false_r. Qed. Lemma clearbit_neq : forall a n m, n~=m -> (clearbit a n).[m] = a.[m]. Proof. intros a n m H. rewrite clearbit_eqb. rewrite <- eqb_eq in H. apply not_true_is_false in H. rewrite H. apply andb_true_r. Qed. (** Shifts of bitwise operations *) Lemma shiftl_lxor : forall a b n, (lxor a b) << n == lxor (a << n) (b << n). Proof. intros a b n. bitwise as m. destruct (le_gt_cases n m). - now rewrite !shiftl_spec_high', lxor_spec. - now rewrite !shiftl_spec_low. Qed. Lemma shiftr_lxor : forall a b n, (lxor a b) >> n == lxor (a >> n) (b >> n). Proof. intros. bitwise. now rewrite !shiftr_spec', lxor_spec. Qed. Lemma shiftl_land : forall a b n, (land a b) << n == land (a << n) (b << n). Proof. intros a b n. bitwise as m. destruct (le_gt_cases n m). - now rewrite !shiftl_spec_high', land_spec. - now rewrite !shiftl_spec_low. Qed. Lemma shiftr_land : forall a b n, (land a b) >> n == land (a >> n) (b >> n). Proof. intros. bitwise. now rewrite !shiftr_spec', land_spec. Qed. Lemma shiftl_lor : forall a b n, (lor a b) << n == lor (a << n) (b << n). Proof. intros a b n. bitwise as m. destruct (le_gt_cases n m). - now rewrite !shiftl_spec_high', lor_spec. - now rewrite !shiftl_spec_low. Qed. Lemma shiftr_lor : forall a b n, (lor a b) >> n == lor (a >> n) (b >> n). Proof. intros. bitwise. now rewrite !shiftr_spec', lor_spec. Qed. Lemma shiftl_ldiff : forall a b n, (ldiff a b) << n == ldiff (a << n) (b << n). Proof. intros a b n. bitwise as m. destruct (le_gt_cases n m). - now rewrite !shiftl_spec_high', ldiff_spec. - now rewrite !shiftl_spec_low. Qed. Lemma shiftr_ldiff : forall a b n, (ldiff a b) >> n == ldiff (a >> n) (b >> n). Proof. intros. bitwise. now rewrite !shiftr_spec', ldiff_spec. Qed. (** Shifts and order *) Lemma shiftl_lower_bound : forall a n, a <= a << n. Proof. intros a n; rewrite shiftl_mul_pow2, two_succ; rewrite <-(mul_1_r a) at 1. apply mul_le_mono_l, pow_lower_bound; exact (neq_succ_0 _). Qed. Lemma shiftr_upper_bound : forall a n, a >> n <= a. Proof. intros a n; rewrite shiftr_div_pow2, two_succ; apply div_le_upper_bound; [| apply le_mul_l]; apply pow_nonzero; exact (neq_succ_0 _). Qed. (** We cannot have a function complementing all bits of a number, otherwise it would have an infinity of bit 1. Nonetheless, we can design a bounded complement *) Definition ones n := P (1 << n). Definition lnot a n := lxor a (ones n). #[global] Instance ones_wd : Proper (eq==>eq) ones. Proof. unfold ones. solve_proper. Qed. #[global] Instance lnot_wd : Proper (eq==>eq==>eq) lnot. Proof. unfold lnot. solve_proper. Qed. Lemma ones_equiv : forall n, ones n == P (2^n). Proof. intros; unfold ones; now rewrite shiftl_1_l. Qed. Lemma ones_0 : ones 0 == 0. Proof. rewrite ones_equiv, pow_0_r, one_succ, pred_succ; reflexivity. Qed. Lemma ones_add : forall n m, ones (m+n) == 2^m * ones n + ones m. Proof. intros n m. rewrite !ones_equiv. rewrite <- !sub_1_r, mul_sub_distr_l, mul_1_r, <- pow_add_r. rewrite add_sub_assoc, sub_add. - reflexivity. - apply pow_le_mono_r. { order'. } rewrite <- (add_0_r m) at 1. apply add_le_mono_l, le_0_l. - rewrite <- (pow_0_r 2). apply pow_le_mono_r. { order'. } apply le_0_l. Qed. Lemma ones_div_pow2 : forall n m, m<=n -> ones n / 2^m == ones (n-m). Proof. intros n m H. symmetry. apply div_unique with (ones m). - rewrite ones_equiv. apply le_succ_l. rewrite succ_pred; order_nz. - rewrite <- (sub_add m n H) at 1. rewrite (add_comm _ m). apply ones_add. Qed. Lemma ones_mod_pow2 : forall n m, m<=n -> (ones n) mod (2^m) == ones m. Proof. intros n m H. symmetry. apply mod_unique with (ones (n-m)). - rewrite ones_equiv. apply le_succ_l. rewrite succ_pred; order_nz. - rewrite <- (sub_add m n H) at 1. rewrite (add_comm _ m). apply ones_add. Qed. Lemma ones_spec_low : forall n m, m (ones n).[m] = true. Proof. intros. apply testbit_true. rewrite ones_div_pow2 by order. rewrite <- (pow_1_r 2). rewrite ones_mod_pow2. - rewrite ones_equiv. now nzsimpl'. - apply le_add_le_sub_r. nzsimpl. now apply le_succ_l. Qed. Lemma ones_spec_high : forall n m, n<=m -> (ones n).[m] = false. Proof. intros n m ?. destruct (eq_0_gt_0_cases n) as [EQ|LT]; rewrite ones_equiv. - now rewrite EQ, pow_0_r, one_succ, pred_succ, bits_0. - apply bits_above_log2. rewrite log2_pred_pow2; trivial. rewrite <-le_succ_l, succ_pred; order. Qed. Lemma ones_spec_iff : forall n m, (ones n).[m] = true <-> m (lnot a n).[m] = negb a.[m]. Proof. intros. unfold lnot. now rewrite lxor_spec, ones_spec_low. Qed. Lemma lnot_spec_high : forall a n m, n<=m -> (lnot a n).[m] = a.[m]. Proof. intros. unfold lnot. now rewrite lxor_spec, ones_spec_high, xorb_false_r. Qed. Lemma lnot_involutive : forall a n, lnot (lnot a n) n == a. Proof. intros a n. bitwise as m. destruct (le_gt_cases n m). - now rewrite 2 lnot_spec_high. - now rewrite 2 lnot_spec_low, negb_involutive. Qed. Lemma lnot_0_l : forall n, lnot 0 n == ones n. Proof. intros. unfold lnot. apply lxor_0_l. Qed. Lemma lnot_ones : forall n, lnot (ones n) n == 0. Proof. intros. unfold lnot. apply lxor_nilpotent. Qed. Lemma ones_succ : forall n, ones (S n) == 2 * (ones n) + 1. Proof. intros n; rewrite 2!ones_equiv, <-2!sub_1_r, mul_sub_distr_l. rewrite mul_1_r, <-pow_succ_r, two_succ, one_succ by (exact (le_0_l _)). rewrite <-sub_sub_distr, sub_succ, sub_0_r; [reflexivity | |]. - apply ->succ_le_mono; exact (le_0_l _). - rewrite <-(pow_1_r (S (S 0))) at 1; apply pow_le_mono_r; [exact (neq_succ_0 _) | exact (le_1_succ _)]. Qed. (** Bounded complement and other operations *) Lemma lor_ones_low : forall a n, log2 a < n -> lor a (ones n) == ones n. Proof. intros a n H. bitwise as m. destruct (le_gt_cases n m). - rewrite ones_spec_high, bits_above_log2; trivial. now apply lt_le_trans with n. - now rewrite ones_spec_low, orb_true_r. Qed. Lemma land_ones : forall a n, land a (ones n) == a mod 2^n. Proof. intros a n. bitwise as m. destruct (le_gt_cases n m). - now rewrite ones_spec_high, mod_pow2_bits_high, andb_false_r. - now rewrite ones_spec_low, mod_pow2_bits_low, andb_true_r. Qed. Lemma land_ones_low : forall a n, log2 a < n -> land a (ones n) == a. Proof. intros; rewrite land_ones. apply mod_small. apply log2_lt_cancel. rewrite log2_pow2; trivial using le_0_l. Qed. Lemma ldiff_ones_r : forall a n, ldiff a (ones n) == (a >> n) << n. Proof. intros a n. bitwise as m. destruct (le_gt_cases n m). - rewrite ones_spec_high, shiftl_spec_high', shiftr_spec'; trivial. rewrite sub_add; trivial. apply andb_true_r. - now rewrite ones_spec_low, shiftl_spec_low, andb_false_r. Qed. Lemma ldiff_ones_r_low : forall a n, log2 a < n -> ldiff a (ones n) == 0. Proof. intros a n H. bitwise as m. destruct (le_gt_cases n m). - rewrite ones_spec_high, bits_above_log2; trivial. now apply lt_le_trans with n. - now rewrite ones_spec_low, andb_false_r. Qed. Lemma ldiff_ones_l_low : forall a n, log2 a < n -> ldiff (ones n) a == lnot a n. Proof. intros a n H. bitwise as m. destruct (le_gt_cases n m). - rewrite ones_spec_high, lnot_spec_high, bits_above_log2; trivial. now apply lt_le_trans with n. - now rewrite ones_spec_low, lnot_spec_low. Qed. Lemma lor_lnot_diag : forall a n, lor a (lnot a n) == lor a (ones n). Proof. intros a n. bitwise as m. destruct (le_gt_cases n m). - rewrite lnot_spec_high, ones_spec_high; trivial. now destruct a.[m]. - rewrite lnot_spec_low, ones_spec_low; trivial. now destruct a.[m]. Qed. Lemma lor_lnot_diag_low : forall a n, log2 a < n -> lor a (lnot a n) == ones n. Proof. intros a n H. now rewrite lor_lnot_diag, lor_ones_low. Qed. Lemma land_lnot_diag : forall a n, land a (lnot a n) == ldiff a (ones n). Proof. intros a n. bitwise as m. destruct (le_gt_cases n m). - rewrite lnot_spec_high, ones_spec_high; trivial. now destruct a.[m]. - rewrite lnot_spec_low, ones_spec_low; trivial. now destruct a.[m]. Qed. Lemma land_lnot_diag_low : forall a n, log2 a < n -> land a (lnot a n) == 0. Proof. intros. now rewrite land_lnot_diag, ldiff_ones_r_low. Qed. Lemma lnot_lor_low : forall a b n, log2 a < n -> log2 b < n -> lnot (lor a b) n == land (lnot a n) (lnot b n). Proof. intros a b n Ha Hb. bitwise as m. destruct (le_gt_cases n m). - rewrite !lnot_spec_high, lor_spec, !bits_above_log2; trivial. + now apply lt_le_trans with n. + now apply lt_le_trans with n. - now rewrite !lnot_spec_low, lor_spec, negb_orb. Qed. Lemma lnot_land_low : forall a b n, log2 a < n -> log2 b < n -> lnot (land a b) n == lor (lnot a n) (lnot b n). Proof. intros a b n Ha Hb. bitwise as m. destruct (le_gt_cases n m). - rewrite !lnot_spec_high, land_spec, !bits_above_log2; trivial. + now apply lt_le_trans with n. + now apply lt_le_trans with n. - now rewrite !lnot_spec_low, land_spec, negb_andb. Qed. Lemma ldiff_land_low : forall a b n, log2 a < n -> ldiff a b == land a (lnot b n). Proof. intros a b n Ha. bitwise as m. destruct (le_gt_cases n m). - rewrite (bits_above_log2 a m). + trivial. + now apply lt_le_trans with n. - rewrite !lnot_spec_low; trivial. Qed. Lemma lnot_ldiff_low : forall a b n, log2 a < n -> log2 b < n -> lnot (ldiff a b) n == lor (lnot a n) b. Proof. intros a b n Ha Hb. bitwise as m. destruct (le_gt_cases n m). - rewrite !lnot_spec_high, ldiff_spec, !bits_above_log2; trivial. + now apply lt_le_trans with n. + now apply lt_le_trans with n. - now rewrite !lnot_spec_low, ldiff_spec, negb_andb, negb_involutive. Qed. Lemma lxor_lnot_lnot : forall a b n, lxor (lnot a n) (lnot b n) == lxor a b. Proof. intros a b n. bitwise as m. destruct (le_gt_cases n m). - rewrite !lnot_spec_high; trivial. - rewrite !lnot_spec_low, xorb_negb_negb; trivial. Qed. Lemma lnot_lxor_l : forall a b n, lnot (lxor a b) n == lxor (lnot a n) b. Proof. intros a b n. bitwise as m. destruct (le_gt_cases n m). - rewrite !lnot_spec_high, lxor_spec; trivial. - rewrite !lnot_spec_low, lxor_spec, negb_xorb_l; trivial. Qed. Lemma lnot_lxor_r : forall a b n, lnot (lxor a b) n == lxor a (lnot b n). Proof. intros a b n. bitwise as m. destruct (le_gt_cases n m). - rewrite !lnot_spec_high, lxor_spec; trivial. - rewrite !lnot_spec_low, lxor_spec, negb_xorb_r; trivial. Qed. Lemma lxor_lor : forall a b, land a b == 0 -> lxor a b == lor a b. Proof. intros a b H. bitwise as m. assert (a.[m] && b.[m] = false) by now rewrite <- land_spec, H, bits_0. now destruct a.[m], b.[m]. Qed. (** Bitwise operations and log2 *) Lemma log2_bits_unique : forall a n, a.[n] = true -> (forall m, n a.[m] = false) -> log2 a == n. Proof. intros a n H H'. destruct (eq_0_gt_0_cases a) as [Ha|Ha]. - now rewrite Ha, bits_0 in H. - apply le_antisymm; apply le_ngt; intros LT. + specialize (H' _ LT). now rewrite bit_log2 in H' by order. + now rewrite bits_above_log2 in H by order. Qed. Lemma log2_shiftr : forall a n, log2 (a >> n) == log2 a - n. Proof. intros a n. destruct (eq_0_gt_0_cases a) as [Ha|Ha]. - now rewrite Ha, shiftr_0_l, log2_nonpos, sub_0_l by order. - destruct (lt_ge_cases (log2 a) n). + rewrite shiftr_eq_0, log2_nonpos by order. symmetry. rewrite sub_0_le; order. + apply log2_bits_unique. * now rewrite shiftr_spec', sub_add, bit_log2 by order. * intros m Hm. rewrite shiftr_spec'; trivial. apply bits_above_log2; try order. now apply lt_sub_lt_add_r. Qed. Lemma log2_shiftl : forall a n, a~=0 -> log2 (a << n) == log2 a + n. Proof. intros a n Ha. rewrite shiftl_mul_pow2, add_comm by trivial. apply log2_mul_pow2. - generalize (le_0_l a); order. - apply le_0_l. Qed. Lemma log2_lor : forall a b, log2 (lor a b) == max (log2 a) (log2 b). Proof. assert (AUX : forall a b, a<=b -> log2 (lor a b) == log2 b). { intros a b H. destruct (eq_0_gt_0_cases a) as [Ha|Ha]. - now rewrite Ha, lor_0_l. - apply log2_bits_unique. + now rewrite lor_spec, bit_log2, orb_true_r by order. + intros m Hm. assert (H' := log2_le_mono _ _ H). now rewrite lor_spec, 2 bits_above_log2 by order. } (* main *) intros a b. destruct (le_ge_cases a b) as [H|H]. - rewrite max_r by now apply log2_le_mono. now apply AUX. - rewrite max_l by now apply log2_le_mono. rewrite lor_comm. now apply AUX. Qed. Lemma log2_land : forall a b, log2 (land a b) <= min (log2 a) (log2 b). Proof. assert (AUX : forall a b, a<=b -> log2 (land a b) <= log2 a). { intros a b H. apply le_ngt. intros H'. destruct (eq_decidable (land a b) 0) as [EQ|NEQ]. - rewrite EQ in H'. apply log2_lt_cancel in H'. generalize (le_0_l a); order. - generalize (bit_log2 (land a b) NEQ). now rewrite land_spec, bits_above_log2. } (* main *) intros a b. destruct (le_ge_cases a b) as [H|H]. - rewrite min_l by now apply log2_le_mono. now apply AUX. - rewrite min_r by now apply log2_le_mono. rewrite land_comm. now apply AUX. Qed. Lemma log2_lxor : forall a b, log2 (lxor a b) <= max (log2 a) (log2 b). Proof. assert (AUX : forall a b, a<=b -> log2 (lxor a b) <= log2 b). { intros a b H. apply le_ngt. intros H'. destruct (eq_decidable (lxor a b) 0) as [EQ|NEQ]. - rewrite EQ in H'. apply log2_lt_cancel in H'. generalize (le_0_l a); order. - generalize (bit_log2 (lxor a b) NEQ). rewrite lxor_spec, 2 bits_above_log2; try order. + discriminate. + apply le_lt_trans with (log2 b); trivial. now apply log2_le_mono. } (* main *) intros a b. destruct (le_ge_cases a b) as [H|H]. - rewrite max_r by now apply log2_le_mono. now apply AUX. - rewrite max_l by now apply log2_le_mono. rewrite lxor_comm. now apply AUX. Qed. (** Bitwise operations and arithmetical operations *) Local Notation xor3 a b c := (xorb (xorb a b) c). Local Notation lxor3 a b c := (lxor (lxor a b) c). Local Notation nextcarry a b c := ((a&&b) || (c && (a||b))). Local Notation lnextcarry a b c := (lor (land a b) (land c (lor a b))). Lemma add_bit0 : forall a b, (a+b).[0] = xorb a.[0] b.[0]. Proof. intros. now rewrite !bit0_odd, odd_add. Qed. Lemma add3_bit0 : forall a b c, (a+b+c).[0] = xor3 a.[0] b.[0] c.[0]. Proof. intros. now rewrite !add_bit0. Qed. Lemma add3_bits_div2 : forall (a0 b0 c0 : bool), (a0 + b0 + c0)/2 == nextcarry a0 b0 c0. Proof. assert (H : 1+1 == 2) by now nzsimpl'. intros [|] [|] [|]; simpl; rewrite ?add_0_l, ?add_0_r, ?H; (apply div_same; order') || (apply div_small; order') || idtac. symmetry. apply div_unique with 1. { order'. } now nzsimpl'. Qed. Lemma add_carry_div2 : forall a b (c0:bool), (a + b + c0)/2 == a/2 + b/2 + nextcarry a.[0] b.[0] c0. Proof. intros a b c0. rewrite <- add3_bits_div2. rewrite (add_comm ((a/2)+_)). rewrite <- div_add by order'. f_equiv. rewrite <- !div2_div, mul_comm, mul_add_distr_l. rewrite (div2_odd a), <- bit0_odd at 1. fold (b2n a.[0]). rewrite (div2_odd b), <- bit0_odd at 1. fold (b2n b.[0]). rewrite add_shuffle1. rewrite <-(add_assoc _ _ c0). apply add_comm. Qed. (** The main result concerning addition: we express the bits of the sum in term of bits of [a] and [b] and of some carry stream which is also recursively determined by another equation. *) Lemma add_carry_bits : forall a b (c0:bool), exists c, a+b+c0 == lxor3 a b c /\ c/2 == lnextcarry a b c /\ c.[0] = c0. Proof. intros a b c0. (* induction over some n such that [a<2^n] and [b<2^n] *) set (n:=max a b). assert (Ha : a<2^n). { apply lt_le_trans with (2^a). - apply pow_gt_lin_r, lt_1_2. - apply pow_le_mono_r. { order'. } unfold n. destruct (le_ge_cases a b); [rewrite max_r|rewrite max_l]; order'. } assert (Hb : b<2^n). { apply lt_le_trans with (2^b). - apply pow_gt_lin_r, lt_1_2. - apply pow_le_mono_r. { order'. } unfold n. destruct (le_ge_cases a b); [rewrite max_r|rewrite max_l]; order'. } clearbody n. revert a b c0 Ha Hb. induct n. - (*base*) intros a b c0. rewrite !pow_0_r, !one_succ, !lt_succ_r. intros Ha Hb. exists c0. setoid_replace a with 0 by (generalize (le_0_l a); order'). setoid_replace b with 0 by (generalize (le_0_l b); order'). rewrite !add_0_l, !lxor_0_l, !lor_0_r, !land_0_r, !lor_0_r. rewrite b2n_div2, b2n_bit0; now repeat split. - (*step*) intros n IH a b c0 Ha Hb. set (c1:=nextcarry a.[0] b.[0] c0). destruct (IH (a/2) (b/2) c1) as (c & IH1 & IH2 & Hc); clear IH. + apply div_lt_upper_bound; trivial. { order'. } now rewrite <- pow_succ_r'. + apply div_lt_upper_bound; trivial. { order'. } now rewrite <- pow_succ_r'. + exists (c0 + 2*c). repeat split. * { (* - add *) bitwise as m. destruct (zero_or_succ m) as [EQ|[m' EQ]]; rewrite EQ; clear EQ. - now rewrite add_b2n_double_bit0, add3_bit0, b2n_bit0. - rewrite <- !div2_bits, <- 2 lxor_spec. f_equiv. rewrite add_b2n_double_div2, <- IH1. apply add_carry_div2. } * { (* - carry *) rewrite add_b2n_double_div2. bitwise as m. destruct (zero_or_succ m) as [EQ|[m' EQ]]; rewrite EQ; clear EQ. - now rewrite add_b2n_double_bit0. - rewrite <- !div2_bits, IH2. autorewrite with bitwise. now rewrite add_b2n_double_div2. } * (* - carry0 *) apply add_b2n_double_bit0. Qed. (** Particular case : the second bit of an addition *) Lemma add_bit1 : forall a b, (a+b).[1] = xor3 a.[1] b.[1] (a.[0] && b.[0]). Proof. intros a b. destruct (add_carry_bits a b false) as (c & EQ1 & EQ2 & Hc). simpl in EQ1; rewrite add_0_r in EQ1. rewrite EQ1. autorewrite with bitwise. f_equal. rewrite one_succ, <- div2_bits, EQ2. autorewrite with bitwise. rewrite Hc. simpl. apply orb_false_r. Qed. (** In an addition, there will be no carries iff there is no common bits in the numbers to add *) Lemma nocarry_equiv : forall a b c, c/2 == lnextcarry a b c -> c.[0] = false -> (c == 0 <-> land a b == 0). Proof. intros a b c H H'. split. - intros EQ; rewrite EQ in *. rewrite div_0_l in H by order'. symmetry in H. now apply lor_eq_0_l in H. - intros EQ. rewrite EQ, lor_0_l in H. apply bits_inj_0. intro n; induct n. + trivial. + intros n IH. rewrite <- div2_bits, H. autorewrite with bitwise. now rewrite IH. Qed. (** When there is no common bits, the addition is just a xor *) Lemma add_nocarry_lxor : forall a b, land a b == 0 -> a+b == lxor a b. Proof. intros a b H. destruct (add_carry_bits a b false) as (c & EQ1 & EQ2 & Hc). simpl in EQ1; rewrite add_0_r in EQ1. rewrite EQ1. apply (nocarry_equiv a b c) in H; trivial. rewrite H. now rewrite lxor_0_r. Qed. (** A null [ldiff] implies being smaller *) Lemma ldiff_le : forall a b, ldiff a b == 0 -> a <= b. Proof. cut (forall n a b, a < 2^n -> ldiff a b == 0 -> a <= b). { intros H a b. apply (H a), pow_gt_lin_r; order'. } intro n; induct n. - intros a b Ha _. rewrite pow_0_r, one_succ, lt_succ_r in Ha. assert (Ha' : a == 0) by (generalize (le_0_l a); order'). rewrite Ha'. apply le_0_l. - intros n IH a b Ha H. assert (NEQ : 2 ~= 0) by order'. rewrite (div_mod a 2 NEQ), (div_mod b 2 NEQ). apply add_le_mono. + apply mul_le_mono_l. apply IH. * apply div_lt_upper_bound; trivial. now rewrite <- pow_succ_r'. * rewrite <- (pow_1_r 2), <- 2 shiftr_div_pow2. now rewrite <- shiftr_ldiff, H, shiftr_div_pow2, pow_1_r, div_0_l. + rewrite <- 2 bit0_mod. apply bits_inj_iff in H. specialize (H 0). rewrite ldiff_spec, bits_0 in H. destruct a.[0], b.[0]; try discriminate; simpl; order'. Qed. (** Subtraction can be a ldiff when the opposite ldiff is null. *) Lemma sub_nocarry_ldiff : forall a b, ldiff b a == 0 -> a-b == ldiff a b. Proof. intros a b H. apply add_cancel_r with b. rewrite sub_add. - symmetry. rewrite add_nocarry_lxor. + bitwise as m. apply bits_inj_iff in H. specialize (H m). rewrite ldiff_spec, bits_0 in H. now destruct a.[m], b.[m]. + apply land_ldiff. - now apply ldiff_le. Qed. (** We can express lnot in term of subtraction *) Lemma add_lnot_diag_low : forall a n, log2 a < n -> a + lnot a n == ones n. Proof. intros a n H. assert (H' := land_lnot_diag_low a n H). rewrite add_nocarry_lxor, lxor_lor by trivial. now apply lor_lnot_diag_low. Qed. Lemma lnot_sub_low : forall a n, log2 a < n -> lnot a n == ones n - a. Proof. intros a n H. now rewrite <- (add_lnot_diag_low a n H), add_comm, add_sub. Qed. (** Adding numbers with no common bits cannot lead to a much bigger number *) Lemma add_nocarry_lt_pow2 : forall a b n, land a b == 0 -> a < 2^n -> b < 2^n -> a+b < 2^n. Proof. intros a b n H Ha Hb. rewrite add_nocarry_lxor by trivial. apply div_small_iff. { order_nz. } rewrite <- shiftr_div_pow2, shiftr_lxor, !shiftr_div_pow2. rewrite 2 div_small by trivial. apply lxor_0_l. Qed. Lemma add_nocarry_mod_lt_pow2 : forall a b n, land a b == 0 -> a mod 2^n + b mod 2^n < 2^n. Proof. intros a b n H. apply add_nocarry_lt_pow2. - bitwise as m. destruct (le_gt_cases n m). + now rewrite mod_pow2_bits_high. + now rewrite !mod_pow2_bits_low, <- land_spec, H, bits_0. - apply mod_upper_bound; order_nz. - apply mod_upper_bound; order_nz. Qed. End NBitsProp. coq-8.20.0/theories/Numbers/Natural/Abstract/NDefOps.v000066400000000000000000000300031466560755400224740ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* b) n. Arguments if_zero [A] a b n. #[global] Instance if_zero_wd (A : Type) : Proper (Logic.eq ==> Logic.eq ==> N.eq ==> Logic.eq) (@if_zero A). Proof. unfold if_zero. (* TODO : solve_proper : SLOW + BUG *) f_equiv'. Qed. Theorem if_zero_0 : forall (A : Type) (a b : A), if_zero a b 0 = a. Proof. unfold if_zero; intros; now rewrite recursion_0. Qed. Theorem if_zero_succ : forall (A : Type) (a b : A) (n : N.t), if_zero a b (S n) = b. Proof. intros; unfold if_zero. now rewrite recursion_succ. Qed. (*****************************************************) (** Addition *) Definition def_add (x y : N.t) := recursion y (fun _ => S) x. Local Infix "+++" := def_add (at level 50, left associativity). #[global] Instance def_add_wd : Proper (N.eq ==> N.eq ==> N.eq) def_add. Proof. unfold def_add. f_equiv'. Qed. Theorem def_add_0_l : forall y, 0 +++ y == y. Proof. intro y. unfold def_add. now rewrite recursion_0. Qed. Theorem def_add_succ_l : forall x y, S x +++ y == S (x +++ y). Proof. intros x y; unfold def_add. rewrite recursion_succ; f_equiv'. Qed. Theorem def_add_add : forall n m, n +++ m == n + m. Proof. intros n m; induct n. - now rewrite def_add_0_l, add_0_l. - intros n H. now rewrite def_add_succ_l, add_succ_l, H. Qed. (*****************************************************) (** Multiplication *) Definition def_mul (x y : N.t) := recursion 0 (fun _ p => p +++ x) y. Local Infix "**" := def_mul (at level 40, left associativity). #[global] Instance def_mul_wd : Proper (N.eq ==> N.eq ==> N.eq) def_mul. Proof. unfold def_mul. (* TODO : solve_proper SLOW + BUG *) f_equiv'. Qed. Theorem def_mul_0_r : forall x, x ** 0 == 0. Proof. intro. unfold def_mul. now rewrite recursion_0. Qed. Theorem def_mul_succ_r : forall x y, x ** S y == x ** y +++ x. Proof. intros x y; unfold def_mul. rewrite recursion_succ; auto with *. f_equiv'. Qed. Theorem def_mul_mul : forall n m, n ** m == n * m. Proof. intros n m; induct m. - now rewrite def_mul_0_r, mul_0_r. - intros m IH; now rewrite def_mul_succ_r, mul_succ_r, def_add_add, IH. Qed. (*****************************************************) (** Order *) Definition ltb (m : N.t) : N.t -> bool := recursion (if_zero false true) (fun _ f n => recursion false (fun n' _ => f n') n) m. Local Infix "<<" := ltb (at level 70, no associativity). #[global] Instance ltb_wd : Proper (N.eq ==> N.eq ==> Logic.eq) ltb. Proof. unfold ltb. f_equiv'. Qed. Theorem ltb_base : forall n, 0 << n = if_zero false true n. Proof. intro n; unfold ltb; now rewrite recursion_0. Qed. Theorem ltb_step : forall m n, S m << n = recursion false (fun n' _ => m << n') n. Proof. intros m n; unfold ltb at 1. f_equiv. rewrite recursion_succ; f_equiv'. Qed. (* Above, we rewrite applications of function. Is it possible to rewrite functions themselves, i.e., rewrite (recursion lt_base lt_step (S n)) to lt_step n (recursion lt_base lt_step n)? *) Theorem ltb_0 : forall n, n << 0 = false. Proof. cases n. - rewrite ltb_base; now rewrite if_zero_0. - intro n; rewrite ltb_step. now rewrite recursion_0. Qed. Theorem ltb_0_succ : forall n, 0 << S n = true. Proof. intro n; rewrite ltb_base; now rewrite if_zero_succ. Qed. Theorem succ_ltb_mono : forall n m, (S n << S m) = (n << m). Proof. intros n m. rewrite ltb_step. rewrite recursion_succ; f_equiv'. Qed. Theorem ltb_lt : forall n m, n << m = true <-> n < m. Proof. double_induct n m. - cases m. + rewrite ltb_0. split; intro H; [discriminate H | false_hyp H nlt_0_r]. + intro n. rewrite ltb_0_succ. split; intro; [apply lt_0_succ | reflexivity]. - intro n. rewrite ltb_0. split; intro H; [discriminate | false_hyp H nlt_0_r]. - intros n m. rewrite succ_ltb_mono. now rewrite <- succ_lt_mono. Qed. Theorem ltb_ge : forall n m, n << m = false <-> n >= m. Proof. intros. rewrite <- not_true_iff_false, ltb_lt. apply nlt_ge. Qed. (*****************************************************) (** Even *) Definition even (x : N.t) := recursion true (fun _ p => negb p) x. #[global] Instance even_wd : Proper (N.eq==>Logic.eq) even. Proof. unfold even. f_equiv'. Qed. Theorem even_0 : even 0 = true. Proof. unfold even. now rewrite recursion_0. Qed. Theorem even_succ : forall x, even (S x) = negb (even x). Proof. unfold even. intro x; rewrite recursion_succ; f_equiv'. Qed. (*****************************************************) (** Division by 2 *) Definition half_aux (x : N.t) : N.t * N.t := recursion (0, 0) (fun _ p => let (x1, x2) := p in (S x2, x1)) x. Definition half (x : N.t) := snd (half_aux x). #[global] Instance half_aux_wd : Proper (N.eq ==> N.eq*N.eq) half_aux. Proof. intros x x' Hx. unfold half_aux. f_equiv; trivial. intros y y' Hy (u,v) (u',v') (Hu,Hv). compute in *. rewrite Hu, Hv; auto with *. Qed. #[global] Instance half_wd : Proper (N.eq==>N.eq) half. Proof. unfold half. f_equiv'. Qed. Lemma half_aux_0 : half_aux 0 = (0,0). Proof. unfold half_aux. rewrite recursion_0; auto. Qed. Lemma half_aux_succ : forall x, half_aux (S x) = (S (snd (half_aux x)), fst (half_aux x)). Proof. intros. remember (half_aux x) as h. destruct h as (f,s); simpl in *. unfold half_aux in *. rewrite recursion_succ, <- Heqh; simpl; f_equiv'. Qed. Theorem half_aux_spec : forall n, n == fst (half_aux n) + snd (half_aux n). Proof. apply induction. - intros x x' Hx. setoid_rewrite Hx; auto with *. - rewrite half_aux_0; simpl; rewrite add_0_l; auto with *. - intros. rewrite half_aux_succ. simpl. rewrite add_succ_l, add_comm; auto. now f_equiv. Qed. Theorem half_aux_spec2 : forall n, fst (half_aux n) == snd (half_aux n) \/ fst (half_aux n) == S (snd (half_aux n)). Proof. apply induction. - intros x x' Hx. setoid_rewrite Hx; auto with *. - rewrite half_aux_0; simpl. auto with *. - intros. rewrite half_aux_succ; simpl. destruct H; auto with *. right; now f_equiv. Qed. Theorem half_0 : half 0 == 0. Proof. unfold half. rewrite half_aux_0; simpl; auto with *. Qed. Theorem half_1 : half 1 == 0. Proof. unfold half. rewrite one_succ, half_aux_succ, half_aux_0; simpl; auto with *. Qed. Theorem half_double : forall n, n == 2 * half n \/ n == 1 + 2 * half n. Proof. intros. unfold half. nzsimpl'. destruct (half_aux_spec2 n) as [H|H]; [left|right]. - rewrite <- H at 1. apply half_aux_spec. - rewrite <- add_succ_l. rewrite <- H at 1. apply half_aux_spec. Qed. Theorem half_upper_bound : forall n, 2 * half n <= n. Proof. intros. destruct (half_double n) as [E|E]; rewrite E at 2. - apply le_refl. - nzsimpl. apply le_le_succ_r, le_refl. Qed. Theorem half_lower_bound : forall n, n <= 1 + 2 * half n. Proof. intros. destruct (half_double n) as [E|E]; rewrite E at 1. - nzsimpl. apply le_le_succ_r, le_refl. - apply le_refl. Qed. Theorem half_nz : forall n, 1 < n -> 0 < half n. Proof. intros n LT. assert (LE : 0 <= half n) by apply le_0_l. le_elim LE; auto. destruct (half_double n) as [E|E]; rewrite <- LE, mul_0_r, ?add_0_r in E; rewrite E in LT. - order'. - order. Qed. Theorem half_decrease : forall n, 0 < n -> half n < n. Proof. intros n LT. destruct (half_double n) as [E|E]; rewrite E at 2; nzsimpl'. - rewrite <- add_0_l at 1. rewrite <- add_lt_mono_r. assert (LE : 0 <= half n) by apply le_0_l. le_elim LE; auto. rewrite <- LE, mul_0_r in E. rewrite E in LT. destruct (nlt_0_r _ LT). - rewrite <- add_succ_l. rewrite <- add_0_l at 1. rewrite <- add_lt_mono_r. apply lt_0_succ. Qed. (*****************************************************) (** Power *) Definition pow (n m : N.t) := recursion 1 (fun _ r => n*r) m. Local Infix "^^" := pow (at level 30, right associativity). #[global] Instance pow_wd : Proper (N.eq==>N.eq==>N.eq) pow. Proof. unfold pow. f_equiv'. Qed. Lemma pow_0 : forall n, n^^0 == 1. Proof. intros. unfold pow. rewrite recursion_0. auto with *. Qed. Lemma pow_succ : forall n m, n^^(S m) == n*(n^^m). Proof. intros. unfold pow. rewrite recursion_succ; f_equiv'. Qed. (*****************************************************) (** Logarithm for the base 2 *) Definition log (x : N.t) : N.t := strong_rec 0 (fun g x => if x << 2 then 0 else S (g (half x))) x. #[global] Instance log_prewd : Proper ((N.eq==>N.eq)==>N.eq==>N.eq) (fun g x => if x<<2 then 0 else S (g (half x))). Proof. intros g g' Hg n n' Hn. rewrite Hn. destruct (n' << 2); auto with *. f_equiv. apply Hg. now f_equiv. Qed. #[global] Instance log_wd : Proper (N.eq==>N.eq) log. Proof. intros x x' Exx'. unfold log. apply strong_rec_wd; f_equiv'. Qed. Lemma log_good_step : forall n h1 h2, (forall m, m < n -> h1 m == h2 m) -> (if n << 2 then 0 else S (h1 (half n))) == (if n << 2 then 0 else S (h2 (half n))). Proof. intros n h1 h2 E. destruct (n<<2) eqn:H. - auto with *. - f_equiv. apply E, half_decrease. rewrite two_succ, <- not_true_iff_false, ltb_lt, nlt_ge, le_succ_l in H. order'. Qed. #[global] Hint Resolve log_good_step : core. Theorem log_init : forall n, n < 2 -> log n == 0. Proof. intros n Hn. unfold log. rewrite strong_rec_fixpoint; auto with *. replace (n << 2) with true; auto with *. symmetry. now rewrite ltb_lt. Qed. Theorem log_step : forall n, 2 <= n -> log n == S (log (half n)). Proof. intros n Hn. unfold log. rewrite strong_rec_fixpoint; auto with *. replace (n << 2) with false; auto with *. symmetry. rewrite <- not_true_iff_false, ltb_lt, nlt_ge; auto. Qed. Theorem pow2_log : forall n, 0 < n -> half n < 2^^(log n) <= n. Proof. intro n; generalize (le_refl n). set (k:=n) at -2. clearbody k. revert k. pattern n. apply induction; clear n. - intros n n' Hn; setoid_rewrite Hn; auto with *. - intros k Hk1 Hk2. le_elim Hk1. + destruct (nlt_0_r _ Hk1). + rewrite Hk1 in Hk2. destruct (nlt_0_r _ Hk2). - intros n IH k Hk1 Hk2. destruct (lt_ge_cases k 2) as [LT|LE]. + (* base *) rewrite log_init, pow_0 by auto. rewrite <- le_succ_l, <- one_succ in Hk2. le_elim Hk2. * rewrite two_succ, <- nle_gt, le_succ_l in LT. destruct LT; auto. * rewrite <- Hk2. rewrite half_1; auto using lt_0_1, le_refl. + (* step *) rewrite log_step, pow_succ by auto. rewrite two_succ, le_succ_l in LE. destruct (IH (half k)) as (IH1,IH2). * rewrite <- lt_succ_r. apply lt_le_trans with k; auto. now apply half_decrease. * apply half_nz; auto. * set (K:=2^^log (half k)) in *; clearbody K. split. -- rewrite <- le_succ_l in IH1. apply mul_le_mono_l with (p:=2) in IH1. eapply lt_le_trans; eauto. nzsimpl'. rewrite lt_succ_r. eapply le_trans; [ eapply half_lower_bound | ]. nzsimpl'; apply le_refl. -- eapply le_trans; [ | eapply half_upper_bound ]. apply mul_le_mono_l; auto. Qed. End NdefOpsProp. coq-8.20.0/theories/Numbers/Natural/Abstract/NDiv.v000066400000000000000000000175431466560755400220540ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* a mod b < b. Proof. intros. apply mod_bound_pos; auto'. Qed. (** Another formulation of the main equation *) Lemma mod_eq : forall a b, b~=0 -> a mod b == a - b*(a/b). Proof. intros. symmetry. apply add_sub_eq_l. symmetry. now apply div_mod. Qed. (** Uniqueness theorems *) Theorem div_mod_unique : forall b q1 q2 r1 r2, r1 r2 b*q1+r1 == b*q2+r2 -> q1 == q2 /\ r1 == r2. Proof. intros b q1 q2 r1 r2 ? ? ?. apply div_mod_unique with b; auto'. Qed. Theorem div_unique: forall a b q r, r a == b*q + r -> q == a/b. Proof. intros a b q r ? ?; apply div_unique with r; auto'. Qed. Theorem mod_unique: forall a b q r, r a == b*q + r -> r == a mod b. Proof. intros a b q r ? ?. apply mod_unique with q; auto'. Qed. Theorem div_unique_exact: forall a b q, b~=0 -> a == b*q -> q == a/b. Proof. intros. apply div_unique_exact; auto'. Qed. (** A division by itself returns 1 *) Lemma div_same : forall a, a~=0 -> a/a == 1. Proof. intros. apply div_same; auto'. Qed. Lemma mod_same : forall a, a~=0 -> a mod a == 0. Proof. intros. apply mod_same; auto'. Qed. (** A division of a small number by a bigger one yields zero. *) Theorem div_small: forall a b, a a/b == 0. Proof. intros. apply div_small; auto'. Qed. (** Same situation, in term of modulo: *) Theorem mod_small: forall a b, a a mod b == a. Proof. intros. apply mod_small; auto'. Qed. (** * Basic values of divisions and modulo. *) Lemma div_0_l: forall a, a~=0 -> 0/a == 0. Proof. intros. apply div_0_l; auto'. Qed. Lemma mod_0_l: forall a, a~=0 -> 0 mod a == 0. Proof. intros. apply mod_0_l; auto'. Qed. Lemma div_1_r: forall a, a/1 == a. Proof. intros. apply div_1_r; auto'. Qed. Lemma mod_1_r: forall a, a mod 1 == 0. Proof. intros. apply mod_1_r; auto'. Qed. Lemma div_1_l: forall a, 1 1/a == 0. Proof. exact div_1_l. Qed. Lemma mod_1_l: forall a, 1 1 mod a == 1. Proof. exact mod_1_l. Qed. Lemma div_mul : forall a b, b~=0 -> (a*b)/b == a. Proof. intros. apply div_mul; auto'. Qed. Lemma mod_mul : forall a b, b~=0 -> (a*b) mod b == 0. Proof. intros. apply mod_mul; auto'. Qed. (** * Order results about mod and div *) (** A modulo cannot grow beyond its starting point. *) Theorem mod_le: forall a b, b~=0 -> a mod b <= a. Proof. intros. apply mod_le; auto'. Qed. Lemma div_str_pos : forall a b, 0 0 < a/b. Proof. exact div_str_pos. Qed. Lemma div_small_iff : forall a b, b~=0 -> (a/b==0 <-> a (a mod b == a <-> a (0 b<=a). Proof. intros. apply div_str_pos_iff; auto'. Qed. (** As soon as the divisor is strictly greater than 1, the division is strictly decreasing. *) Lemma div_lt : forall a b, 0 1 a/b < a. Proof. exact div_lt. Qed. (** [le] is compatible with a positive division. *) Lemma div_le_mono : forall a b c, c~=0 -> a<=b -> a/c <= b/c. Proof. intros. apply div_le_mono; auto'. Qed. Lemma mul_div_le : forall a b, b~=0 -> b*(a/b) <= a. Proof. intros. apply mul_div_le; auto'. Qed. Lemma mul_succ_div_gt: forall a b, b~=0 -> a < b*(S (a/b)). Proof. intros; apply mul_succ_div_gt; auto'. Qed. (** The previous inequality is exact iff the modulo is zero. *) Lemma div_exact : forall a b, b~=0 -> (a == b*(a/b) <-> a mod b == 0). Proof. intros. apply div_exact; auto'. Qed. (** Some additional inequalities about div. *) Theorem div_lt_upper_bound: forall a b q, b~=0 -> a < b*q -> a/b < q. Proof. intros. apply div_lt_upper_bound; auto'. Qed. Theorem div_le_upper_bound: forall a b q, b~=0 -> a <= b*q -> a/b <= q. Proof. intros; apply div_le_upper_bound; auto'. Qed. Theorem div_le_lower_bound: forall a b q, b~=0 -> b*q <= a -> q <= a/b. Proof. intros; apply div_le_lower_bound; auto'. Qed. (** A division respects opposite monotonicity for the divisor *) Lemma div_le_compat_l: forall p q r, 0 p/r <= p/q. Proof. intros. apply div_le_compat_l;[auto' | auto]. Qed. (** * Relations between usual operations and mod and div *) Lemma mod_add : forall a b c, c~=0 -> (a + b * c) mod c == a mod c. Proof. intros. apply mod_add; auto'. Qed. Lemma div_add : forall a b c, c~=0 -> (a + b * c) / c == a / c + b. Proof. intros. apply div_add; auto'. Qed. Lemma div_add_l: forall a b c, b~=0 -> (a * b + c) / b == a + c / b. Proof. intros. apply div_add_l; auto'. Qed. (** Cancellations. *) Lemma div_mul_cancel_r : forall a b c, b~=0 -> c~=0 -> (a*c)/(b*c) == a/b. Proof. intros. apply div_mul_cancel_r; auto'. Qed. Lemma div_mul_cancel_l : forall a b c, b~=0 -> c~=0 -> (c*a)/(c*b) == a/b. Proof. intros. apply div_mul_cancel_l; auto'. Qed. Lemma mul_mod_distr_r: forall a b c, b~=0 -> c~=0 -> (a*c) mod (b*c) == (a mod b) * c. Proof. intros. apply mul_mod_distr_r; auto'. Qed. Lemma mul_mod_distr_l: forall a b c, b~=0 -> c~=0 -> (c*a) mod (c*b) == c * (a mod b). Proof. intros. apply mul_mod_distr_l; auto'. Qed. (** Operations modulo. *) Theorem mod_mod: forall a n, n~=0 -> (a mod n) mod n == a mod n. Proof. intros. apply mod_mod; auto'. Qed. Lemma mul_mod_idemp_l : forall a b n, n~=0 -> ((a mod n)*b) mod n == (a*b) mod n. Proof. intros. apply mul_mod_idemp_l; auto'. Qed. Lemma mul_mod_idemp_r : forall a b n, n~=0 -> (a*(b mod n)) mod n == (a*b) mod n. Proof. intros. apply mul_mod_idemp_r; auto'. Qed. Theorem mul_mod: forall a b n, n~=0 -> (a * b) mod n == ((a mod n) * (b mod n)) mod n. Proof. intros. apply mul_mod; auto'. Qed. Lemma add_mod_idemp_l : forall a b n, n~=0 -> ((a mod n)+b) mod n == (a+b) mod n. Proof. intros. apply add_mod_idemp_l; auto'. Qed. Lemma add_mod_idemp_r : forall a b n, n~=0 -> (a+(b mod n)) mod n == (a+b) mod n. Proof. intros. apply add_mod_idemp_r; auto'. Qed. Theorem add_mod: forall a b n, n~=0 -> (a+b) mod n == (a mod n + b mod n) mod n. Proof. intros. apply add_mod; auto'. Qed. Lemma div_div : forall a b c, b~=0 -> c~=0 -> (a/b)/c == a/(b*c). Proof. intros. apply div_div; auto'. Qed. Lemma mod_mul_r : forall a b c, b~=0 -> c~=0 -> a mod (b*c) == a mod b + b*((a/b) mod c). Proof. intros. apply mod_mul_r; auto'. Qed. Lemma add_mul_mod_distr_l : forall a b c d, b~=0 -> 0<=d (c*a+d) mod (c*b) == c*(a mod b)+d. Proof. intros a b c d Hb ?. apply add_mul_mod_distr_l. - apply le_0_l. - assert (H'b := le_0_l b). order. - assumption. Qed. Lemma add_mul_mod_distr_r : forall a b c d, b~=0 -> 0<=d (a*c+d) mod (b*c) == (a mod b)*c+d. Proof. intros a b c d ? ?. now rewrite !(mul_comm _ c), add_mul_mod_distr_l. Qed. (** A last inequality: *) Theorem div_mul_le: forall a b c, b~=0 -> c*(a/b) <= (c*a)/b. Proof. intros. apply div_mul_le; auto'. Qed. (** mod is related to divisibility *) Lemma mod_divides : forall a b, b~=0 -> (a mod b == 0 <-> exists c, a == b*c). Proof. intros. apply mod_divides; auto'. Qed. End NDivProp. coq-8.20.0/theories/Numbers/Natural/Abstract/NDiv0.v000066400000000000000000000256711466560755400221350ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* |Ha]. - apply div_0_r. - now apply div_0_l. Qed. Lemma mod_0_l : forall a, 0 mod a == 0. Proof. intros a. destruct (eq_decidable a 0) as [->|Hb]. - apply mod_0_r. - now apply mod_0_l. Qed. #[local] Hint Rewrite div_0_l mod_0_l div_0_r mod_0_r : nz. Lemma div_mod : forall a b, a == b*(a/b) + (a mod b). Proof. intros a b. destruct (eq_decidable b 0) as [->|Hb]. - now nzsimpl. - now apply div_mod. Qed. Lemma mod_eq : forall a b, a mod b == a - b*(a/b). Proof. intros a b. destruct (eq_decidable b 0) as [->|Hb]. - now nzsimpl. - now apply mod_eq. Qed. Lemma mod_same : forall a, a mod a == 0. Proof. intros a. destruct (eq_decidable a 0) as [->|Ha]. - now nzsimpl. - now apply mod_same. Qed. Lemma mod_mul : forall a b, (a*b) mod b == 0. Proof. intros a b. destruct (eq_decidable b 0) as [->|Hb]. - now nzsimpl. - now apply mod_mul. Qed. Lemma mod_le : forall a b, a mod b <= a. Proof. intros a b. destruct (eq_decidable b 0) as [->|Hb]. - now nzsimpl. - now apply mod_le. Qed. Lemma div_le_mono : forall a b c, a<=b -> a/c <= b/c. Proof. intros a b c. destruct (eq_decidable c 0) as [->|Hc]. - now nzsimpl. - now apply div_le_mono. Qed. Lemma mul_div_le : forall a b, b*(a/b) <= a. Proof. intros a b. destruct (eq_decidable b 0) as [->|Hb]. - nzsimpl. apply le_0_l. - now apply mul_div_le. Qed. Lemma div_exact : forall a b, (a == b*(a/b) <-> a mod b == 0). Proof. intros a b. destruct (eq_decidable b 0) as [->|Hb]. - now nzsimpl. - now apply div_exact. Qed. Lemma div_lt_upper_bound : forall a b q, a < b*q -> a/b < q. Proof. intros a b q. destruct (eq_decidable b 0) as [->|Hb]. - nzsimpl. now intros ?%nlt_0_r. - now apply div_lt_upper_bound. Qed. Lemma div_le_upper_bound : forall a b q, a <= b*q -> a/b <= q. Proof. intros a b c. destruct (eq_decidable b 0) as [->|Hb]. - nzsimpl. intros. apply le_0_l. - now apply div_le_upper_bound. Qed. Lemma mod_add : forall a b c, (a + b * c) mod c == a mod c. Proof. intros a b c. destruct (eq_decidable c 0) as [->|Hc]. - now nzsimpl. - now apply mod_add. Qed. Lemma div_mul_cancel_r : forall a b c, c~=0 -> (a*c)/(b*c) == a/b. Proof. intros a b c. destruct (eq_decidable b 0) as [->|Hb]. - now nzsimpl. - now apply div_mul_cancel_r. Qed. Lemma div_mul_cancel_l : forall a b c, c~=0 -> (c*a)/(c*b) == a/b. Proof. intros a b c. destruct (eq_decidable b 0) as [->|Hb]. - now nzsimpl. - now apply div_mul_cancel_l. Qed. Lemma mul_mod_distr_r : forall a b c, (a*c) mod (b*c) == (a mod b) * c. Proof. intros a b c. destruct (eq_decidable b 0) as [->|Hb]. - now nzsimpl. - destruct (eq_decidable c 0) as [->|Hc]. + now nzsimpl. + now apply mul_mod_distr_r. Qed. Lemma mul_mod_distr_l : forall a b c, (c*a) mod (c*b) == c * (a mod b). Proof. intros a b c. destruct (eq_decidable b 0) as [->|Hb]. - now nzsimpl. - destruct (eq_decidable c 0) as [->|Hc]. + now nzsimpl. + now apply mul_mod_distr_l. Qed. Lemma mod_mod : forall a n, (a mod n) mod n == a mod n. Proof. intros a n. destruct (eq_decidable n 0) as [->|Hn]. - now nzsimpl. - now apply mod_mod. Qed. Lemma mul_mod_idemp_l : forall a b n, ((a mod n)*b) mod n == (a*b) mod n. Proof. intros a b n. destruct (eq_decidable n 0) as [->|Hn]. - now nzsimpl. - now apply mul_mod_idemp_l. Qed. Lemma mul_mod_idemp_r : forall a b n, (a*(b mod n)) mod n == (a*b) mod n. Proof. intros a b n. destruct (eq_decidable n 0) as [->|Hn]. - now nzsimpl. - now apply mul_mod_idemp_r. Qed. Lemma mul_mod : forall a b n, (a * b) mod n == ((a mod n) * (b mod n)) mod n. Proof. intros a b n. destruct (eq_decidable n 0) as [->|Hn]. - now nzsimpl. - now apply mul_mod. Qed. Lemma add_mod_idemp_l : forall a b n, ((a mod n)+b) mod n == (a+b) mod n. Proof. intros a b n. destruct (eq_decidable n 0) as [->|Hn]. - now nzsimpl. - now apply add_mod_idemp_l. Qed. Lemma add_mod_idemp_r : forall a b n, (a+(b mod n)) mod n == (a+b) mod n. Proof. intros a b n. destruct (eq_decidable n 0) as [->|Hn]. - now nzsimpl. - now apply add_mod_idemp_r. Qed. Lemma add_mod : forall a b n, (a+b) mod n == (a mod n + b mod n) mod n. Proof. intros a b n. destruct (eq_decidable n 0) as [->|Hn]. - now nzsimpl. - now apply add_mod. Qed. Lemma div_div : forall a b c, (a/b)/c == a/(b*c). Proof. intros a b c. destruct (eq_decidable b 0) as [->|Hb]. - now nzsimpl. - destruct (eq_decidable c 0) as [->|Hc]. + now nzsimpl. + now apply div_div. Qed. Lemma mod_mul_r : forall a b c, a mod (b*c) == a mod b + b*((a/b) mod c). Proof. intros a b c. destruct (eq_decidable b 0) as [->|Hb]. - now nzsimpl. - destruct (eq_decidable c 0) as [->|Hc]. + nzsimpl. rewrite add_comm. apply div_mod. + now apply mod_mul_r. Qed. Lemma add_mul_mod_distr_l : forall a b c d, d (c*a+d) mod (c*b) == c*(a mod b)+d. Proof. intros a b c d ?. destruct (eq_decidable b 0) as [->|Hb]. - now nzsimpl. - apply add_mul_mod_distr_l; intuition auto using le_0_l. Qed. Lemma add_mul_mod_distr_r : forall a b c d, d (a*c+d) mod (b*c) == (a mod b)*c+d. Proof. intros a b c d ?. destruct (eq_decidable b 0) as [->|Hb]. - now nzsimpl. - apply add_mul_mod_distr_r; intuition auto using le_0_l. Qed. Lemma div_mul_le : forall a b c, c*(a/b) <= (c*a)/b. Proof. intros a b c. destruct (eq_decidable b 0) as [->|Hb]. - now nzsimpl. - now apply div_mul_le. Qed. Lemma mod_divides : forall a b, (a mod b == 0 <-> exists c, a == b*c). Proof. intros a b. destruct (eq_decidable b 0) as [Hb|Hb]. - split. + intros Hab. exists 0. revert Hab. rewrite Hb. now nzsimpl. + intros [c Hc]. revert Hc. rewrite Hb. now nzsimpl. - now apply mod_divides. Qed. End Div0. (** Unchanged theorems. *) Definition mod_upper_bound := mod_upper_bound. Definition div_mod_unique := div_mod_unique. Definition div_unique := div_unique. Definition mod_unique := mod_unique. Definition div_unique_exact := div_unique_exact. Definition div_same := div_same. Definition div_small := div_small. Definition mod_small := mod_small. Definition div_1_r := div_1_r. Definition mod_1_r := mod_1_r. Definition div_1_l := div_1_l. Definition mod_1_l := mod_1_l. Definition div_mul := div_mul. Definition div_str_pos := div_str_pos. Definition div_small_iff := div_small_iff. Definition mod_small_iff := mod_small_iff. Definition div_str_pos_iff := div_str_pos_iff. Definition div_lt := div_lt. Definition mul_succ_div_gt := mul_succ_div_gt. Definition div_le_lower_bound := div_le_lower_bound. Definition div_le_compat_l := div_le_compat_l. Definition div_add := div_add. Definition div_add_l := div_add_l. (** Deprecation statements. After deprecation phase, remove statements below in favor of Div0 statements. *) #[deprecated(since="8.17",note="Use Div0.mod_eq instead.")] Notation mod_eq := mod_eq (only parsing). #[deprecated(since="8.17",note="Use Div0.mod_same instead.")] Notation mod_same := mod_same (only parsing). #[deprecated(since="8.17",note="Use Div0.div_0_l instead.")] Notation div_0_l := div_0_l (only parsing). #[deprecated(since="8.17",note="Use Div0.mod_0_l instead.")] Notation mod_0_l := mod_0_l (only parsing). #[deprecated(since="8.17",note="Use Div0.mod_mul instead.")] Notation mod_mul := mod_mul (only parsing). #[deprecated(since="8.17",note="Use Div0.mod_le instead.")] Notation mod_le := mod_le (only parsing). #[deprecated(since="8.17",note="Use Div0.div_le_mono instead.")] Notation div_le_mono := div_le_mono (only parsing). #[deprecated(since="8.17",note="Use Div0.mul_div_le instead.")] Notation mul_div_le := mul_div_le (only parsing). #[deprecated(since="8.17",note="Use Div0.div_exact instead.")] Notation div_exact := div_exact (only parsing). #[deprecated(since="8.17",note="Use Div0.div_lt_upper_bound instead.")] Notation div_lt_upper_bound := div_lt_upper_bound (only parsing). #[deprecated(since="8.17",note="Use Div0.div_le_upper_bound instead.")] Notation div_le_upper_bound := div_le_upper_bound (only parsing). #[deprecated(since="8.17",note="Use Div0.mod_add instead.")] Notation mod_add := mod_add (only parsing). #[deprecated(since="8.17",note="Use Div0.div_mul_cancel_r instead.")] Notation div_mul_cancel_r := div_mul_cancel_r (only parsing). #[deprecated(since="8.17",note="Use Div0.div_mul_cancel_l instead.")] Notation div_mul_cancel_l := div_mul_cancel_l (only parsing). #[deprecated(since="8.17",note="Use Div0.mul_mod_distr_r instead.")] Notation mul_mod_distr_r := mul_mod_distr_r (only parsing). #[deprecated(since="8.17",note="Use Div0.mul_mod_distr_l instead.")] Notation mul_mod_distr_l := mul_mod_distr_l (only parsing). #[deprecated(since="8.17",note="Use Div0.mod_mod instead.")] Notation mod_mod := mod_mod (only parsing). #[deprecated(since="8.17",note="Use Div0.mul_mod_idemp_l instead.")] Notation mul_mod_idemp_l := mul_mod_idemp_l (only parsing). #[deprecated(since="8.17",note="Use Div0.mul_mod_idemp_r instead.")] Notation mul_mod_idemp_r := mul_mod_idemp_r (only parsing). #[deprecated(since="8.17",note="Use Div0.mul_mod instead.")] Notation mul_mod := mul_mod (only parsing). #[deprecated(since="8.17",note="Use Div0.add_mod_idemp_l instead.")] Notation add_mod_idemp_l := add_mod_idemp_l (only parsing). #[deprecated(since="8.17",note="Use Div0.add_mod_idemp_r instead.")] Notation add_mod_idemp_r := add_mod_idemp_r (only parsing). #[deprecated(since="8.17",note="Use Div0.add_mod instead.")] Notation add_mod := add_mod (only parsing). #[deprecated(since="8.17",note="Use Div0.div_div instead.")] Notation div_div := div_div (only parsing). #[deprecated(since="8.17",note="Use Div0.mod_mul_r instead.")] Notation mod_mul_r := mod_mul_r (only parsing). #[deprecated(since="8.17",note="Use Div0.div_mul_le instead.")] Notation div_mul_le := div_mul_le (only parsing). #[deprecated(since="8.17",note="Use Div0.mod_divides instead.")] Notation mod_divides := mod_divides (only parsing). End NDivProp0. coq-8.20.0/theories/Numbers/Natural/Abstract/NGcd.v000066400000000000000000000233431466560755400220220ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* eq==>iff) divide := divide_wd. Definition divide_1_r n := divide_1_r_nonneg n (le_0_l n). Definition divide_1_l := divide_1_l. Definition divide_0_r := divide_0_r. Definition divide_0_l := divide_0_l. Definition divide_refl := divide_refl. Definition divide_trans := divide_trans. #[global] Instance divide_reflexive : Reflexive divide | 5 := divide_refl. #[global] Instance divide_transitive : Transitive divide | 5 := divide_trans. Definition divide_antisym n m := divide_antisym_nonneg n m (le_0_l n) (le_0_l m). Definition mul_divide_mono_l := mul_divide_mono_l. Definition mul_divide_mono_r := mul_divide_mono_r. Definition mul_divide_cancel_l := mul_divide_cancel_l. Definition mul_divide_cancel_r := mul_divide_cancel_r. Definition divide_add_r := divide_add_r. Definition divide_mul_l := divide_mul_l. Definition divide_mul_r := divide_mul_r. Definition divide_factor_l := divide_factor_l. Definition divide_factor_r := divide_factor_r. Definition divide_pos_le := divide_pos_le. (** Properties of gcd *) Definition gcd_0_l n : gcd 0 n == n := gcd_0_l_nonneg n (le_0_l n). Definition gcd_0_r n : gcd n 0 == n := gcd_0_r_nonneg n (le_0_l n). Definition gcd_diag n : gcd n n == n := gcd_diag_nonneg n (le_0_l n). Definition gcd_unique n m p := gcd_unique n m p (le_0_l p). Definition gcd_unique_alt n m p := gcd_unique_alt n m p (le_0_l p). Definition divide_gcd_iff n m := divide_gcd_iff n m (le_0_l n). #[global] Instance gcd_wd : Proper (eq==>eq==>eq) gcd := gcd_wd. Definition gcd_comm := gcd_comm. Definition gcd_assoc := gcd_assoc. Definition gcd_eq_0_l := gcd_eq_0_l. Definition gcd_eq_0_r := gcd_eq_0_r. Definition gcd_eq_0 := gcd_eq_0. Definition gcd_mul_diag_l n m := gcd_mul_diag_l n m (le_0_l n). #[deprecated(since="8.17",note="Use divide_antisym instead.")] Notation divide_antisym_nonneg := divide_antisym_nonneg (only parsing). #[deprecated(since="8.17",note="Use gcd_unique instead.")] Notation gcd_unique' n m p := gcd_unique (only parsing). #[deprecated(since="8.17",note="Use gcd_unique_alt instead.")] Notation gcd_unique_alt' := gcd_unique_alt. #[deprecated(since="8.17",note="Use divide_gcd_iff instead.")] Notation divide_gcd_iff' := divide_gcd_iff. Lemma divide_add_cancel_r : forall n m p, (n | m) -> (n | m + p) -> (n | p). Proof. intros n m p (q,Hq) (r,Hr). exists (r-q). rewrite mul_sub_distr_r, <- Hq, <- Hr. now rewrite add_comm, add_sub. Qed. Lemma divide_sub_r : forall n m p, (n | m) -> (n | p) -> (n | m - p). Proof. intros n m p H H'. destruct (le_ge_cases m p) as [LE|LE]. - apply sub_0_le in LE. rewrite LE. apply divide_0_r. - apply divide_add_cancel_r with p; trivial. now rewrite add_comm, sub_add. Qed. Lemma gcd_add_mult_diag_r : forall n m p, gcd n (m+p*n) == gcd n m. Proof. intros n m p. apply gcd_unique_alt. intros. rewrite gcd_divide_iff. split; intros (U,V); split; trivial. - apply divide_add_r; trivial. now apply divide_mul_r. - apply divide_add_cancel_r with (p*n); trivial. + now apply divide_mul_r. + now rewrite add_comm. Qed. Lemma gcd_add_diag_r : forall n m, gcd n (m+n) == gcd n m. Proof. intros n m. rewrite <- (mul_1_l n) at 2. apply gcd_add_mult_diag_r. Qed. Lemma gcd_sub_diag_r : forall n m, n<=m -> gcd n (m-n) == gcd n m. Proof. intros n m H. symmetry. rewrite <- (sub_add n m H) at 1. apply gcd_add_diag_r. Qed. (** On natural numbers, we should use a particular form for the Bezout identity, since we don't have full subtraction. *) Definition Bezout n m p := exists a b, a*n == p + b*m. #[global] Instance Bezout_wd : Proper (eq==>eq==>eq==>iff) Bezout. Proof. unfold Bezout. intros x x' Hx y y' Hy z z' Hz. setoid_rewrite Hx. setoid_rewrite Hy. now setoid_rewrite Hz. Qed. Lemma bezout_1_gcd : forall n m, Bezout n m 1 -> gcd n m == 1. Proof. intros n m (q & r & H). apply gcd_unique; trivial using divide_1_l, le_0_1. intros p Hn Hm. apply divide_add_cancel_r with (r*m). - now apply divide_mul_r. - rewrite add_comm, <- H. now apply divide_mul_r. Qed. (** Bezout on natural numbers commutes *) Theorem bezout_comm : forall a b g, b ~= 0 -> Bezout a b g -> Bezout b a g. Proof. intros a b g Hb [p [q Hpq]]. destruct (eq_decidable a 0) as [Ha|Ha]. { exists 0, 0. symmetry in Hpq. rewrite Ha, mul_0_r in Hpq. apply eq_add_0 in Hpq as [-> _]. now nzsimpl. } exists (a*(p+1)*(q+1)-q), (b*(p+1)*(q+1)-p). enough (E' : (a*(p+1)*(q+1)-q+q)*b == (b*(p+1)*(q+1)-p+p)*a). { rewrite (mul_add_distr_r _ _ a), (mul_add_distr_r _ _ b), Hpq in E'. rewrite add_assoc, (add_comm _ g) in E'. now apply add_cancel_r in E'. } rewrite !sub_add. - now rewrite !(mul_comm _ b), !mul_assoc, !(mul_comm _ a), !mul_assoc. - rewrite <- mul_1_r at 1. apply mul_le_mono; [|apply le_add_l]. rewrite <- mul_1_l at 1. apply mul_le_mono; [|apply le_add_r]. rewrite one_succ. apply le_succ_l. assert (H := le_0_l b). order. - rewrite <- mul_1_l at 1. apply mul_le_mono; [|apply le_add_r]. rewrite <- mul_1_l at 1. apply mul_le_mono; [|apply le_add_l]. rewrite one_succ. apply le_succ_l. assert (H := le_0_l a). order. Qed. Lemma gcd_bezout_pos : forall n m, 0 < n -> Bezout n m (gcd n m). Proof. enough (H : forall nm, 0 < fst nm -> Bezout (fst nm) (snd nm) (gcd (fst nm) (snd nm))). { intros n m. apply (H (n, m)). } intros nm. induction nm as [[n m] IH] using (measure_induction _ (fun '(n, m) => n + m)). enough (H : forall n' m', n+m == n'+m' -> 0 Bezout n' m' (gcd n' m')). { cbn. intros ?. destruct (lt_trichotomy n m) as [Hnm|[Hnm|Hnm]]. - now apply H. - exists 1, 0. now rewrite Hnm, mul_1_l, mul_0_l, add_0_r, gcd_diag. - destruct (eq_0_gt_0_cases m) as [->|?]. + exists 1, 0. now rewrite gcd_0_r, mul_1_l, mul_0_l, add_0_r. + apply bezout_comm; [order|]. rewrite gcd_comm. now apply H; [apply add_comm|]. } intros n' m' E' [Hn' Hn'm']. assert (Hlt : n' + (m' - n') < n + m). { rewrite (add_comm n'), E', sub_add by order. now apply lt_add_pos_l. } destruct (IH (n', m'-n') Hlt Hn') as [a [b Hab]]. cbn in Hab. exists (a+b), b. rewrite mul_add_distr_r, Hab, mul_sub_distr_l, gcd_sub_diag_r by order. now rewrite <- add_assoc, sub_add by (apply mul_le_mono_l; order). Qed. (** For strictly positive numbers, we have Bezout in the two directions. *) Lemma gcd_bezout_pos_pos : forall n, 0 forall m, 0 Bezout n m (gcd n m) /\ Bezout m n (gcd n m). Proof. intros ????. split; [|rewrite gcd_comm]; now apply gcd_bezout_pos. Qed. (** For arbitrary natural numbers, we could only say that at least one of the Bezout identities holds. *) Lemma gcd_bezout : forall n m, Bezout n m (gcd n m) \/ Bezout m n (gcd n m). Proof. intros n m. destruct (eq_0_gt_0_cases n) as [EQ|LT]. - right. rewrite EQ, gcd_0_l. exists 1. exists 0. now nzsimpl. - left. now apply gcd_bezout_pos. Qed. Lemma gcd_mul_mono_l : forall n m p, gcd (p * n) (p * m) == p * gcd n m. Proof. intros n m p. apply gcd_unique. - apply mul_divide_mono_l, gcd_divide_l. - apply mul_divide_mono_l, gcd_divide_r. - intros q H H'. destruct (eq_0_gt_0_cases n) as [EQ|LT]. + rewrite EQ in *. now rewrite gcd_0_l. + destruct (gcd_bezout_pos n m) as (a & b & EQ); trivial. apply divide_add_cancel_r with (p*m*b). * now apply divide_mul_l. * rewrite <- mul_assoc, <- mul_add_distr_l, add_comm, (mul_comm m), <- EQ. rewrite (mul_comm a), mul_assoc. now apply divide_mul_l. Qed. Lemma gcd_mul_mono_r : forall n m p, gcd (n*p) (m*p) == gcd n m * p. Proof. intros n m p. rewrite !(mul_comm _ p). apply gcd_mul_mono_l. Qed. Lemma gauss : forall n m p, (n | m * p) -> gcd n m == 1 -> (n | p). Proof. intros n m p H G. destruct (eq_0_gt_0_cases n) as [EQ|LT]. - rewrite EQ in *. rewrite gcd_0_l in G. now rewrite <- (mul_1_l p), <- G. - destruct (gcd_bezout_pos n m) as (a & b & EQ); trivial. rewrite G in EQ. apply divide_add_cancel_r with (m*p*b). + now apply divide_mul_l. + rewrite (mul_comm _ b), mul_assoc. rewrite <- (mul_1_l p) at 2. rewrite <- mul_add_distr_r, add_comm, <- EQ. now apply divide_mul_l, divide_factor_r. Qed. Lemma divide_mul_split : forall n m p, n ~= 0 -> (n | m * p) -> exists q r, n == q*r /\ (q | m) /\ (r | p). Proof. intros n m p Hn H. assert (G := gcd_nonneg n m). le_elim G. - destruct (gcd_divide_l n m) as (q,Hq). exists (gcd n m). exists q. split. + now rewrite mul_comm. + split. * apply gcd_divide_r. * destruct (gcd_divide_r n m) as (r,Hr). rewrite Hr in H. rewrite Hq in H at 1. rewrite mul_shuffle0 in H. apply mul_divide_cancel_r in H; [|order]. apply gauss with r; trivial. apply mul_cancel_r with (gcd n m); [order|]. rewrite mul_1_l. rewrite <- gcd_mul_mono_r, <- Hq, <- Hr; order. - symmetry in G. apply gcd_eq_0 in G. destruct G as (Hn',_); order. Qed. (** TODO : relation between gcd and division and modulo *) (** TODO : more about rel_prime (i.e. gcd == 1), about prime ... *) End NGcdProp. coq-8.20.0/theories/Numbers/Natural/Abstract/NIso.v000066400000000000000000000067261466560755400220650ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* N2.t) : Prop := f N1.zero == N2.zero /\ forall n, f (N1.succ n) == N2.succ (f n). Definition natural_isomorphism : N1.t -> N2.t := N1.recursion N2.zero (fun (n : N1.t) (p : N2.t) => N2.succ p). #[global] Instance natural_isomorphism_wd : Proper (N1.eq ==> N2.eq) natural_isomorphism. Proof. unfold natural_isomorphism. repeat red; intros. f_equiv; trivial. repeat red; intros. now f_equiv. Qed. Theorem natural_isomorphism_0 : natural_isomorphism N1.zero == N2.zero. Proof. unfold natural_isomorphism; now rewrite N1.recursion_0. Qed. Theorem natural_isomorphism_succ : forall n : N1.t, natural_isomorphism (N1.succ n) == N2.succ (natural_isomorphism n). Proof. unfold natural_isomorphism. intro n. rewrite N1.recursion_succ; auto with *. repeat red; intros. now f_equiv. Qed. Theorem hom_nat_iso : homomorphism natural_isomorphism. Proof. unfold homomorphism, natural_isomorphism; split; [exact natural_isomorphism_0 | exact natural_isomorphism_succ]. Qed. End Homomorphism. Module Inverse (N1 N2 : NAxiomsRecSig). Module Import NBasePropMod1 := NBaseProp N1. (* This makes the tactic induct available. Since it is taken from (NBasePropFunct NAxiomsMod1), it refers to induction on N1. *) Module Hom12 := Homomorphism N1 N2. Module Hom21 := Homomorphism N2 N1. Local Notation h12 := Hom12.natural_isomorphism. Local Notation h21 := Hom21.natural_isomorphism. Local Notation "n == m" := (N1.eq n m) (at level 70, no associativity). Lemma inverse_nat_iso : forall n : N1.t, h21 (h12 n) == n. Proof. induct n. - now rewrite Hom12.natural_isomorphism_0, Hom21.natural_isomorphism_0. - intros n IH. now rewrite Hom12.natural_isomorphism_succ, Hom21.natural_isomorphism_succ, IH. Qed. End Inverse. Module Isomorphism (N1 N2 : NAxiomsRecSig). Module Hom12 := Homomorphism N1 N2. Module Hom21 := Homomorphism N2 N1. Module Inverse12 := Inverse N1 N2. Module Inverse21 := Inverse N2 N1. Local Notation h12 := Hom12.natural_isomorphism. Local Notation h21 := Hom21.natural_isomorphism. Definition isomorphism (f1 : N1.t -> N2.t) (f2 : N2.t -> N1.t) : Prop := Hom12.homomorphism f1 /\ Hom21.homomorphism f2 /\ forall n, N1.eq (f2 (f1 n)) n /\ forall n, N2.eq (f1 (f2 n)) n. Theorem iso_nat_iso : isomorphism h12 h21. Proof. unfold isomorphism. split. { apply Hom12.hom_nat_iso. } split. { apply Hom21.hom_nat_iso. } split. { apply Inverse12.inverse_nat_iso. } apply Inverse21.inverse_nat_iso. Qed. End Isomorphism. coq-8.20.0/theories/Numbers/Natural/Abstract/NLcm.v000066400000000000000000000210021466560755400220260ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* (a mod b == 0 <-> (b|a)). Proof. intros a b Hb. split. - intros Hab. exists (a/b). rewrite mul_comm. rewrite (div_mod a b Hb) at 1. rewrite Hab; now nzsimpl. - intros (c,Hc). rewrite Hc. now apply mod_mul. Qed. Lemma divide_div_mul_exact : forall a b c, b~=0 -> (b|a) -> (c*a)/b == c*(a/b). Proof. intros a b c Hb H. apply mul_cancel_l with b; trivial. rewrite mul_assoc, mul_shuffle0. assert (H':=H). apply mod_divide, div_exact in H'; trivial. rewrite <- H', (mul_comm a c). symmetry. apply div_exact; trivial. apply mod_divide; trivial. now apply divide_mul_r. Qed. (** Gcd of divided elements, for exact divisions *) Lemma gcd_div_factor : forall a b c, c~=0 -> (c|a) -> (c|b) -> gcd (a/c) (b/c) == (gcd a b)/c. Proof. intros a b c Hc Ha Hb. apply mul_cancel_l with c; try order. assert (H:=gcd_greatest _ _ _ Ha Hb). apply mod_divide, div_exact in H; try order. rewrite <- H. rewrite <- gcd_mul_mono_l; try order. f_equiv; symmetry; apply div_exact; try order; apply mod_divide; trivial; try order. Qed. Lemma gcd_div_gcd : forall a b g, g~=0 -> g == gcd a b -> gcd (a/g) (b/g) == 1. Proof. intros a b g NZ EQ. rewrite gcd_div_factor. - now rewrite <- EQ, div_same. - generalize (gcd_nonneg a b); order. - rewrite EQ; apply gcd_divide_l. - rewrite EQ; apply gcd_divide_r. Qed. (** The following equality is crucial for Euclid algorithm *) Lemma gcd_mod : forall a b, b~=0 -> gcd (a mod b) b == gcd b a. Proof. intros a b Hb. rewrite (gcd_comm _ b). rewrite <- (gcd_add_mult_diag_r b (a mod b) (a/b)). now rewrite add_comm, mul_comm, <- div_mod. Qed. (** We now define lcm thanks to gcd: lcm a b = a * (b / gcd a b) = (a / gcd a b) * b = (a*b) / gcd a b Nota: [lcm 0 0] should be 0, which isn't guarantee with the third equation above. *) Definition lcm a b := a*(b/gcd a b). #[global] Instance lcm_wd : Proper (eq==>eq==>eq) lcm. Proof. unfold lcm. solve_proper. Qed. Lemma lcm_equiv1 : forall a b, gcd a b ~= 0 -> a * (b / gcd a b) == (a*b)/gcd a b. Proof. intros a b H. rewrite divide_div_mul_exact; try easy. apply gcd_divide_r. Qed. Lemma lcm_equiv2 : forall a b, gcd a b ~= 0 -> (a / gcd a b) * b == (a*b)/gcd a b. Proof. intros a b H. rewrite 2 (mul_comm _ b). rewrite divide_div_mul_exact; try easy. apply gcd_divide_l. Qed. Lemma gcd_div_swap : forall a b, (a / gcd a b) * b == a * (b / gcd a b). Proof. intros a b. destruct (eq_decidable (gcd a b) 0) as [EQ|NEQ]. - apply gcd_eq_0 in EQ. destruct EQ as (EQ,EQ'). rewrite EQ, EQ'. now nzsimpl. - now rewrite lcm_equiv1, <-lcm_equiv2. Qed. Lemma divide_lcm_l : forall a b, (a | lcm a b). Proof. unfold lcm. intros a b. apply divide_factor_l. Qed. Lemma divide_lcm_r : forall a b, (b | lcm a b). Proof. unfold lcm. intros a b. rewrite <- gcd_div_swap. apply divide_factor_r. Qed. Lemma divide_div : forall a b c, a~=0 -> (a|b) -> (b|c) -> (b/a|c/a). Proof. intros a b c Ha Hb (c',Hc). exists c'. now rewrite <- divide_div_mul_exact, Hc. Qed. Lemma lcm_least : forall a b c, (a | c) -> (b | c) -> (lcm a b | c). Proof. intros a b c Ha Hb. unfold lcm. destruct (eq_decidable (gcd a b) 0) as [EQ|NEQ]. - apply gcd_eq_0 in EQ. destruct EQ as (EQ,EQ'). rewrite EQ in *. now nzsimpl. - assert (Ga := gcd_divide_l a b). assert (Gb := gcd_divide_r a b). set (g:=gcd a b) in *. assert (Ha' := divide_div g a c NEQ Ga Ha). assert (Hb' := divide_div g b c NEQ Gb Hb). destruct Ha' as (a',Ha'). rewrite Ha', mul_comm in Hb'. apply gauss in Hb'; [|apply gcd_div_gcd; unfold g; trivial using gcd_comm]. destruct Hb' as (b',Hb'). exists b'. rewrite mul_shuffle3, <- Hb'. rewrite (proj2 (div_exact c g NEQ)). + rewrite Ha', mul_shuffle3, (mul_comm a a'). f_equiv. symmetry. apply div_exact; trivial. apply mod_divide; trivial. + apply mod_divide; trivial. transitivity a; trivial. Qed. Lemma lcm_comm : forall a b, lcm a b == lcm b a. Proof. intros a b. unfold lcm. rewrite (gcd_comm b), (mul_comm b). now rewrite <- gcd_div_swap. Qed. Lemma lcm_divide_iff : forall n m p, (lcm n m | p) <-> (n | p) /\ (m | p). Proof. intros n m p. split;[split|]. - transitivity (lcm n m); trivial using divide_lcm_l. - transitivity (lcm n m); trivial using divide_lcm_r. - intros (H,H'). now apply lcm_least. Qed. Lemma lcm_unique : forall n m p, 0<=p -> (n|p) -> (m|p) -> (forall q, (n|q) -> (m|q) -> (p|q)) -> lcm n m == p. Proof. intros n m p Hp Hn Hm H. apply divide_antisym; trivial. - now apply lcm_least. - apply H. + apply divide_lcm_l. + apply divide_lcm_r. Qed. Lemma lcm_unique_alt : forall n m p, 0<=p -> (forall q, (p|q) <-> (n|q) /\ (m|q)) -> lcm n m == p. Proof. intros n m p Hp H. apply lcm_unique; trivial. - apply H, divide_refl. - apply H, divide_refl. - intros. apply H. now split. Qed. Lemma lcm_assoc : forall n m p, lcm n (lcm m p) == lcm (lcm n m) p. Proof. intros. apply lcm_unique_alt. - apply le_0_l. - intros. now rewrite !lcm_divide_iff, and_assoc. Qed. Lemma lcm_0_l : forall n, lcm 0 n == 0. Proof. intros. apply lcm_unique; trivial. - order. - apply divide_refl. - apply divide_0_r. Qed. Lemma lcm_0_r : forall n, lcm n 0 == 0. Proof. intros. now rewrite lcm_comm, lcm_0_l. Qed. Lemma lcm_1_l : forall n, lcm 1 n == n. Proof. intros. apply lcm_unique; trivial using divide_1_l, le_0_l, divide_refl. Qed. Lemma lcm_1_r : forall n, lcm n 1 == n. Proof. intros. now rewrite lcm_comm, lcm_1_l. Qed. Lemma lcm_diag : forall n, lcm n n == n. Proof. intros. apply lcm_unique; trivial using divide_refl, le_0_l. Qed. Lemma lcm_eq_0 : forall n m, lcm n m == 0 <-> n == 0 \/ m == 0. Proof. intros. split. - intros EQ. apply eq_mul_0. apply divide_0_l. rewrite <- EQ. apply lcm_least. + apply divide_factor_l. + apply divide_factor_r. - destruct 1 as [EQ|EQ]; rewrite EQ. + apply lcm_0_l. + apply lcm_0_r. Qed. Lemma divide_lcm_eq_r : forall n m, (n|m) -> lcm n m == m. Proof. intros n m H. apply lcm_unique_alt; trivial using le_0_l. intros q. split. - split; trivial. now transitivity m. - now destruct 1. Qed. Lemma divide_lcm_iff : forall n m, (n|m) <-> lcm n m == m. Proof. intros n m. split. - now apply divide_lcm_eq_r. - intros EQ. rewrite <- EQ. apply divide_lcm_l. Qed. Lemma lcm_mul_mono_l : forall n m p, lcm (p * n) (p * m) == p * lcm n m. Proof. intros n m p. destruct (eq_decidable p 0) as [Hp|Hp]. - rewrite Hp. nzsimpl. rewrite lcm_0_l. now nzsimpl. - destruct (eq_decidable (gcd n m) 0) as [Hg|Hg]. + apply gcd_eq_0 in Hg. destruct Hg as (Hn,Hm); rewrite Hn, Hm. nzsimpl. rewrite lcm_0_l. now nzsimpl. + unfold lcm. rewrite gcd_mul_mono_l. rewrite mul_assoc. f_equiv. now rewrite div_mul_cancel_l. Qed. Lemma lcm_mul_mono_r : forall n m p, lcm (n * p) (m * p) == lcm n m * p. Proof. intros n m p. now rewrite !(mul_comm _ p), lcm_mul_mono_l, mul_comm. Qed. Lemma gcd_1_lcm_mul : forall n m, n~=0 -> m~=0 -> (gcd n m == 1 <-> lcm n m == n*m). Proof. intros n m Hn Hm. split; intros H. - unfold lcm. rewrite H. now rewrite div_1_r. - unfold lcm in *. apply mul_cancel_l in H; trivial. assert (Hg : gcd n m ~= 0) by (red; rewrite gcd_eq_0; destruct 1; order). assert (H' := gcd_divide_r n m). apply mod_divide in H'; trivial. apply div_exact in H'; trivial. rewrite H in H'. rewrite <- (mul_1_l m) in H' at 1. now apply mul_cancel_r in H'. Qed. End NLcmProp. coq-8.20.0/theories/Numbers/Natural/Abstract/NLcm0.v000066400000000000000000000134211466560755400221140ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* eq==>eq) lcm := lcm_wd. (* The types are restated to avoid [Private_NLcmProp.lcm] indirection. *) Definition gcd_div_gcd : forall a b g, g ~= 0 -> g == gcd a b -> gcd (a / g) (b / g) == 1 := gcd_div_gcd. Definition divide_lcm_l : forall a b, (a | lcm a b) := divide_lcm_l. Definition gcd_div_swap : forall a b, a / gcd a b * b == a * (b / gcd a b) := gcd_div_swap. Definition divide_lcm_r : forall a b, (b | lcm a b) := divide_lcm_r. Definition lcm_least : forall a b c, (a | c) -> (b | c) -> (lcm a b | c) := lcm_least. Definition lcm_comm : forall a b, lcm a b == lcm b a := lcm_comm. Definition lcm_divide_iff : forall n m p, (lcm n m | p) <-> (n | p) /\ (m | p) := lcm_divide_iff. Definition lcm_assoc : forall n m p, lcm n (lcm m p) == lcm (lcm n m) p := lcm_assoc. Definition lcm_0_l : forall n, lcm 0 n == 0 := lcm_0_l. Definition lcm_0_r : forall n, lcm n 0 == 0 := lcm_0_r. Definition lcm_1_l : forall n, lcm 1 n == n := lcm_1_l. Definition lcm_1_r : forall n, lcm n 1 == n := lcm_1_r. Definition lcm_diag : forall n : t, lcm n n == n := lcm_diag. Definition lcm_eq_0 : forall n m, lcm n m == 0 <-> n == 0 \/ m == 0 := lcm_eq_0. Definition divide_lcm_eq_r : forall n m, (n | m) -> lcm n m == m := divide_lcm_eq_r. Definition divide_lcm_iff : forall n m, (n | m) <-> lcm n m == m := divide_lcm_iff. Definition lcm_mul_mono_l : forall n m p, lcm (p * n) (p * m) == p * lcm n m := lcm_mul_mono_l. Definition lcm_mul_mono_r : forall n m p, lcm (n * p) (m * p) == lcm n m * p := lcm_mul_mono_r. Definition gcd_1_lcm_mul : forall n m, n ~= 0 -> m ~= 0 -> gcd n m == 1 <-> lcm n m == n * m := gcd_1_lcm_mul. Module Lcm0. #[local] Hint Rewrite div_0_l mod_0_l div_0_r mod_0_r gcd_0_l gcd_0_r : nz. Lemma mod_divide : forall a b, (a mod b == 0 <-> (b|a)). Proof. intros a b. destruct (eq_decidable b 0) as [Hb|Hb]. - split. + intros Hab. exists 0. revert Hab. rewrite Hb. now nzsimpl. + intros [c Hc]. revert Hc. rewrite Hb. now nzsimpl. - now apply mod_divide. Qed. Lemma divide_div_mul_exact : forall a b c, (b|a) -> (c*a)/b == c*(a/b). Proof. intros a b c. destruct (eq_decidable b 0) as [->|Hb]. - now nzsimpl. - now apply divide_div_mul_exact. Qed. Lemma gcd_div_factor : forall a b c, (c|a) -> (c|b) -> gcd (a/c) (b/c) == (gcd a b)/c. Proof. intros a b c. destruct (eq_decidable c 0) as [->|Hc]. - now nzsimpl. - now apply gcd_div_factor. Qed. Lemma gcd_mod : forall a b, gcd (a mod b) b == gcd b a. Proof. intros a b. destruct (eq_decidable b 0) as [->|Hb]. - now nzsimpl. - now apply gcd_mod. Qed. Lemma lcm_equiv1 : forall a b, a * (b / gcd a b) == (a*b)/gcd a b. Proof. intros a b. destruct (eq_decidable (gcd a b) 0) as [->|?]. - now nzsimpl. - now apply lcm_equiv1. Qed. Lemma lcm_equiv2 : forall a b, (a / gcd a b) * b == (a*b)/gcd a b. Proof. intros a b. destruct (eq_decidable (gcd a b) 0) as [->|?]. - now nzsimpl. - now apply lcm_equiv2. Qed. Lemma divide_div : forall a b c, (a|b) -> (b|c) -> (b/a|c/a). Proof. intros a b c. destruct (eq_decidable a 0) as [->|Ha]. - now nzsimpl. - now apply divide_div. Qed. Lemma lcm_unique : forall n m p, (n|p) -> (m|p) -> (forall q, (n|q) -> (m|q) -> (p|q)) -> lcm n m == p. Proof. intros n m p. apply lcm_unique, le_0_l. Qed. Lemma lcm_unique_alt : forall n m p, (forall q, (p|q) <-> (n|q) /\ (m|q)) -> lcm n m == p. Proof. intros n m p. apply lcm_unique_alt, le_0_l. Qed. End Lcm0. (** Deprecation statements. After deprecation phase, remove statements below in favor of Lcm0 statements. *) #[deprecated(since="8.17",note="Use Lcm0.mod_divide instead.")] Notation mod_divide := mod_divide (only parsing). #[deprecated(since="8.17",note="Use Lcm0.divide_div_mul_exact instead.")] Notation divide_div_mul_exact := divide_div_mul_exact (only parsing). #[deprecated(since="8.17",note="Use Lcm0.gcd_div_factor instead.")] Notation gcd_div_factor := gcd_div_factor (only parsing). #[deprecated(since="8.17",note="Use Lcm0.gcd_mod instead.")] Notation gcd_mod := gcd_mod (only parsing). #[deprecated(since="8.17",note="Use Lcm0.gcd_mod instead.")] Notation lcm_equiv1 := lcm_equiv1 (only parsing). #[deprecated(since="8.17",note="Use Lcm0.lcm_equiv2 instead.")] Notation lcm_equiv2 := lcm_equiv2 (only parsing). #[deprecated(since="8.17",note="Use Lcm0.divide_div instead.")] Notation divide_div := divide_div (only parsing). #[deprecated(since="8.17",note="Use Lcm0.lcm_unique instead.")] Notation lcm_unique := lcm_unique (only parsing). #[deprecated(since="8.17",note="Use Lcm0.lcm_unique_alt instead.")] Notation lcm_unique_alt := lcm_unique_alt (only parsing). End NLcmProp0. coq-8.20.0/theories/Numbers/Natural/Abstract/NLog.v000066400000000000000000000020031466560755400220340ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* n * n < m * m. Proof. intros n m; split; intro; [apply square_lt_mono_nonneg | apply square_lt_simpl_nonneg]; try assumption; apply le_0_l. Qed. Theorem square_le_mono : forall n m, n <= m <-> n * n <= m * m. Proof. intros n m; split; intro; [apply square_le_mono_nonneg | apply square_le_simpl_nonneg]; try assumption; apply le_0_l. Qed. Theorem mul_le_mono_l : forall n m p, n <= m -> p * n <= p * m. Proof. intros; apply mul_le_mono_nonneg_l. - apply le_0_l. - assumption. Qed. Theorem mul_le_mono_r : forall n m p, n <= m -> n * p <= m * p. Proof. intros; apply mul_le_mono_nonneg_r. - apply le_0_l. - assumption. Qed. Theorem le_mul_l : forall n m, m ~= 0 -> n <= m * n. Proof. intros n m D%neq_0_le_1; rewrite <-(mul_1_l n) at 1. apply mul_le_mono_r; exact D. Qed. Theorem le_mul_r : forall n m, m ~= 0 -> n <= n * m. Proof. intros n m; rewrite mul_comm; exact (le_mul_l _ _). Qed. Theorem mul_lt_mono : forall n m p q, n < m -> p < q -> n * p < m * q. Proof. intros; apply mul_lt_mono_nonneg; try assumption; apply le_0_l. Qed. Theorem mul_le_mono : forall n m p q, n <= m -> p <= q -> n * p <= m * q. Proof. intros; apply mul_le_mono_nonneg; try assumption; apply le_0_l. Qed. Theorem lt_0_mul' : forall n m, n * m > 0 <-> n > 0 /\ m > 0. Proof. intros n m; split; [intro H | intros [H1 H2]]. - apply lt_0_mul in H. destruct H as [[H1 H2] | [H1 H2]]. + now split. + false_hyp H1 nlt_0_r. - now apply mul_pos_pos. Qed. Notation mul_pos := lt_0_mul' (only parsing). Theorem eq_mul_1 : forall n m, n * m == 1 <-> n == 1 /\ m == 1. Proof. intros n m. split; [| intros [H1 H2]; now rewrite H1, H2, mul_1_l]. intro H; destruct (lt_trichotomy n 1) as [H1 | [H1 | H1]]. - apply lt_1_r in H1. rewrite H1, mul_0_l in H. order'. - rewrite H1, mul_1_l in H; now split. - destruct (eq_0_gt_0_cases m) as [H2 | H2]. + rewrite H2, mul_0_r in H. order'. + apply (mul_lt_mono_pos_r m) in H1; [| assumption]. rewrite mul_1_l in H1. assert (H3 : 1 < n * m) by now apply (lt_1_l m). rewrite H in H3; false_hyp H3 lt_irrefl. Qed. (** Alternative name : *) Definition mul_eq_1 := eq_mul_1. End NMulOrderProp. coq-8.20.0/theories/Numbers/Natural/Abstract/NOrder.v000066400000000000000000000203051466560755400223730ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* 0 <= n < m). - apply lt_wf. - intros x y; split. + intro H; split; [apply le_0_l | assumption]. + now intros [_ H]. Defined. (* "le_0_l : forall n : N, 0 <= n" was proved in NBase.v *) Theorem nlt_0_r : forall n, ~ n < 0. Proof. intro n; apply le_ngt. apply le_0_l. Qed. Theorem nle_succ_0 : forall n, ~ (S n <= 0). Proof. intros n H; apply le_succ_l in H; false_hyp H nlt_0_r. Qed. Theorem le_0_r : forall n, n <= 0 <-> n == 0. Proof. intros n; split; intro H. - le_elim H; [false_hyp H nlt_0_r | assumption]. - now apply eq_le_incl. Qed. Theorem lt_0_succ : forall n, 0 < S n. Proof. intro n; induct n; [apply lt_succ_diag_r | intros n H; now apply lt_lt_succ_r]. Qed. Theorem le_1_succ : forall n, 1 <= S n. Proof. intros n; rewrite one_succ; apply ->succ_le_mono; exact (le_0_l _). Qed. Theorem neq_0_lt_0 : forall n, n ~= 0 <-> 0 < n. Proof. intro n; cases n. - split; intro H; [now elim H | intro; now apply lt_irrefl with 0]. - intro n; split; intro H; [apply lt_0_succ | apply neq_succ_0]. Qed. Theorem neq_0_le_1 : forall n, n ~= 0 <-> 1 <= n. Proof. intros n; split. - intros <-%succ_pred; exact (le_1_succ _). - intros H E; rewrite E, one_succ in H; apply (nle_succ_0 0); exact H. Qed. Theorem eq_0_gt_0_cases : forall n, n == 0 \/ 0 < n. Proof. intro n; cases n. - now left. - intro; right; apply lt_0_succ. Qed. Theorem zero_one : forall n, n == 0 \/ n == 1 \/ 1 < n. Proof. setoid_rewrite one_succ. intro n; induct n. { now left. } intro n; cases n. { intros; right; now left. } intros n IH. destruct IH as [H | [H | H]]. - false_hyp H neq_succ_0. - right; right. rewrite H. apply lt_succ_diag_r. - right; right. now apply lt_lt_succ_r. Qed. Theorem lt_1_r : forall n, n < 1 <-> n == 0. Proof. setoid_rewrite one_succ. intro n; cases n. - split; intro; [reflexivity | apply lt_succ_diag_r]. - intros n. rewrite <- succ_lt_mono. split; intro H; [false_hyp H nlt_0_r | false_hyp H neq_succ_0]. Qed. Theorem le_1_r : forall n, n <= 1 <-> n == 0 \/ n == 1. Proof. setoid_rewrite one_succ. intro n; cases n. - split; intro; [now left | apply le_succ_diag_r]. - intro n. rewrite <- succ_le_mono, le_0_r, succ_inj_wd. split; [intro; now right | intros [H | H]; [false_hyp H neq_succ_0 | assumption]]. Qed. Theorem lt_lt_0 : forall n m, n < m -> 0 < m. Proof. intros n m; induct n. - trivial. - intros n IH H. apply IH; now apply lt_succ_l. Qed. Theorem lt_1_l' : forall n m p, n < m -> m < p -> 1 < p. Proof. intros n m p H H0. apply lt_1_l with m; auto. apply le_lt_trans with n; auto. now apply le_0_l. Qed. (** Elimination principlies for < and <= for relations *) Section RelElim. Variable R : relation N.t. Hypothesis R_wd : Proper (N.eq==>N.eq==>iff) R. Theorem le_ind_rel : (forall m, R 0 m) -> (forall n m, n <= m -> R n m -> R (S n) (S m)) -> forall n m, n <= m -> R n m. Proof. intros Base Step n; induct n. { intros; apply Base. } intros n IH m H. elim H using le_ind. - solve_proper. - apply Step; [| apply IH]; now apply eq_le_incl. - intros k H1 H2. apply le_succ_l in H1. apply lt_le_incl in H1. auto. Qed. Theorem lt_ind_rel : (forall m, R 0 (S m)) -> (forall n m, n < m -> R n m -> R (S n) (S m)) -> forall n m, n < m -> R n m. Proof. intros Base Step n; induct n. - intros m H. apply lt_exists_pred in H; destruct H as [m' [H _]]. rewrite H; apply Base. - intros n IH m H. elim H using lt_ind. + solve_proper. + apply Step; [| apply IH]; now apply lt_succ_diag_r. + intros k H1 H2. apply lt_succ_l in H1. auto. Qed. End RelElim. (** Predecessor and order *) Theorem succ_pred_pos : forall n, 0 < n -> S (P n) == n. Proof. intros n H; apply succ_pred; intro H1; rewrite H1 in H. false_hyp H lt_irrefl. Qed. Theorem le_pred_l : forall n, P n <= n. Proof. intro n; cases n. - rewrite pred_0; now apply eq_le_incl. - intros; rewrite pred_succ; apply le_succ_diag_r. Qed. Theorem lt_pred_l : forall n, n ~= 0 -> P n < n. Proof. intro n; cases n. - intro H; exfalso; now apply H. - intros; rewrite pred_succ; apply lt_succ_diag_r. Qed. Theorem le_le_pred : forall n m, n <= m -> P n <= m. Proof. intros n m H; apply le_trans with n. - apply le_pred_l. - assumption. Qed. Theorem lt_lt_pred : forall n m, n < m -> P n < m. Proof. intros n m H; apply le_lt_trans with n. - apply le_pred_l. - assumption. Qed. Theorem lt_le_pred : forall n m, n < m -> n <= P m. (* Converse is false for n == m == 0 *) Proof. intros n m; cases m. - intro H; false_hyp H nlt_0_r. - intros m IH. rewrite pred_succ; now apply lt_succ_r. Qed. Theorem lt_pred_le : forall n m, P n < m -> n <= m. (* Converse is false for n == m == 0 *) Proof. intros n m; cases n. - rewrite pred_0; intro H; now apply lt_le_incl. - intros n IH. rewrite pred_succ in IH. now apply le_succ_l. Qed. Theorem lt_pred_lt : forall n m, n < P m -> n < m. Proof. intros n m H; apply lt_le_trans with (P m); [assumption | apply le_pred_l]. Qed. Theorem le_pred_le : forall n m, n <= P m -> n <= m. Proof. intros n m H; apply le_trans with (P m); [assumption | apply le_pred_l]. Qed. Theorem pred_le_mono : forall n m, n <= m -> P n <= P m. (* Converse is false for n == 1, m == 0 *) Proof. intros n m H; elim H using le_ind_rel. - solve_proper. - intro; rewrite pred_0; apply le_0_l. - intros p q H1 _; now do 2 rewrite pred_succ. Qed. Theorem pred_lt_mono : forall n m, n ~= 0 -> (n < m <-> P n < P m). Proof. intros n m H1; split; intro H2. - assert (m ~= 0). { apply neq_0_lt_0. now apply lt_lt_0 with n. } now rewrite <- (succ_pred n) in H2; rewrite <- (succ_pred m) in H2 ; [apply succ_lt_mono | | |]. - assert (m ~= 0). { apply neq_0_lt_0. apply lt_lt_0 with (P n). apply lt_le_trans with (P m). - assumption. - apply le_pred_l. } apply succ_lt_mono in H2. now do 2 rewrite succ_pred in H2. Qed. Theorem lt_succ_lt_pred : forall n m, S n < m <-> n < P m. Proof. intros n m. rewrite pred_lt_mono by apply neq_succ_0. now rewrite pred_succ. Qed. Theorem le_succ_le_pred : forall n m, S n <= m -> n <= P m. (* Converse is false for n == m == 0 *) Proof. intros n m H. apply lt_le_pred. now apply le_succ_l. Qed. Theorem lt_pred_lt_succ : forall n m, P n < m -> n < S m. (* Converse is false for n == m == 0 *) Proof. intros n m H. apply lt_succ_r. now apply lt_pred_le. Qed. Theorem le_pred_le_succ : forall n m, P n <= m <-> n <= S m. Proof. intros n m; cases n. - rewrite pred_0. split; intro H; apply le_0_l. - intro n. rewrite pred_succ. apply succ_le_mono. Qed. Lemma measure_induction : forall (X : Type) (f : X -> t) (A : X -> Type), (forall x, (forall y, f y < f x -> A y) -> A x) -> forall x, A x. Proof. intros X f A IH x. apply (measure_right_induction X f A 0); [|apply le_0_l]. intros y _ IH'. apply IH. intros. apply IH'. now split; [apply le_0_l|]. Defined. (* This is kept private in order to drop the [Proper] condition in implementations. *) (* begin hide *) Theorem Private_strong_induction_le {A : t -> Prop} : Proper (eq ==> iff) A -> A 0 -> (forall n, ((forall m, m <= n -> A m) -> A (S n))) -> (forall n, A n). Proof. intros H H0 sIH n. enough (forall k, k <= n -> A k) as key. { apply key; exact (le_refl _). } induct n. - intros k ->%le_0_r; exact H0. - intros n I k [Hk%lt_succ_r%I | ->]%lt_eq_cases. + exact Hk. + apply sIH; exact I. Qed. (* end hide *) End NOrderProp. coq-8.20.0/theories/Numbers/Natural/Abstract/NParity.v000066400000000000000000000047101466560755400225720ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* odd (P n) = even n. Proof. intros. rewrite <- (succ_pred n) at 2 by trivial. symmetry. apply even_succ. Qed. Lemma even_pred n : n~=0 -> even (P n) = odd n. Proof. intros. rewrite <- (succ_pred n) at 2 by trivial. symmetry. apply odd_succ. Qed. Lemma even_sub n m : m<=n -> even (n-m) = Bool.eqb (even n) (even m). Proof. intros. case_eq (even n); case_eq (even m); rewrite <- ?negb_true_iff, ?negb_even, ?odd_spec, ?even_spec; intros (m',Hm) (n',Hn). - exists (n'-m'). now rewrite mul_sub_distr_l, Hn, Hm. - exists (n'-m'-1). rewrite !mul_sub_distr_l, Hn, Hm, sub_add_distr, mul_1_r. rewrite two_succ at 5. rewrite <- (add_1_l 1). rewrite sub_add_distr. symmetry. apply sub_add. apply le_add_le_sub_l. rewrite add_1_l, <- two_succ, <- (mul_1_r 2) at 1. rewrite <- mul_sub_distr_l. rewrite <- mul_le_mono_pos_l by order'. rewrite one_succ, le_succ_l. rewrite <- lt_add_lt_sub_l, add_0_r. destruct (le_gt_cases n' m') as [LE|GT]; trivial. generalize (double_below _ _ LE). order. - exists (n'-m'). rewrite mul_sub_distr_l, Hn, Hm. apply add_sub_swap. apply mul_le_mono_pos_l; try order'. destruct (le_gt_cases m' n') as [LE|GT]; trivial. generalize (double_above _ _ GT). order. - exists (n'-m'). rewrite Hm,Hn, mul_sub_distr_l. rewrite sub_add_distr. rewrite add_sub_swap. + apply add_sub. + apply succ_le_mono. rewrite add_1_r in Hm,Hn. order. Qed. Lemma odd_sub n m : m<=n -> odd (n-m) = xorb (odd n) (odd m). Proof. intros. rewrite <- !negb_even. rewrite even_sub by trivial. now destruct (even n), (even m). Qed. End NParityProp. coq-8.20.0/theories/Numbers/Natural/Abstract/NPow.v000066400000000000000000000115011466560755400220630ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* 0^a == 0. Proof. wrap pow_0_l. Qed. Definition pow_1_r : forall a, a^1 == a := pow_1_r. Lemma pow_1_l : forall a, 1^a == 1. Proof. wrap pow_1_l. Qed. Definition pow_2_r : forall a, a^2 == a*a := pow_2_r. (** Power and addition, multiplication *) Lemma pow_add_r : forall a b c, a^(b+c) == a^b * a^c. Proof. wrap pow_add_r. Qed. Lemma pow_mul_l : forall a b c, (a*b)^c == a^c * b^c. Proof. wrap pow_mul_l. Qed. Lemma pow_mul_r : forall a b c, a^(b*c) == (a^b)^c. Proof. wrap pow_mul_r. Qed. (** Power and nullity *) Lemma pow_eq_0 : forall a b, b~=0 -> a^b == 0 -> a == 0. Proof. intros a b ? ?. apply (pow_eq_0 a b); trivial. auto'. Qed. Lemma pow_nonzero : forall a b, a~=0 -> a^b ~= 0. Proof. wrap pow_nonzero. Qed. Lemma pow_eq_0_iff : forall a b, a^b == 0 <-> b~=0 /\ a==0. Proof. intros a b. split. - rewrite pow_eq_0_iff. intros [H |[H H']]. + generalize (le_0_l b); order. + split; order. - intros (Hb,Ha). rewrite Ha. now apply pow_0_l'. Qed. (** Monotonicity *) Lemma pow_lt_mono_l : forall a b c, c~=0 -> a a^c < b^c. Proof. wrap pow_lt_mono_l. Qed. Lemma pow_le_mono_l : forall a b c, a<=b -> a^c <= b^c. Proof. wrap pow_le_mono_l. Qed. Lemma pow_gt_1 : forall a b, 1 b~=0 -> 1 b a^b < a^c. Proof. wrap pow_lt_mono_r. Qed. (** NB: since 0^0 > 0^1, the following result isn't valid with a=0 *) Lemma pow_le_mono_r : forall a b c, a~=0 -> b<=c -> a^b <= a^c. Proof. wrap pow_le_mono_r. Qed. Lemma pow_le_mono : forall a b c d, a~=0 -> a<=c -> b<=d -> a^b <= c^d. Proof. wrap pow_le_mono. Qed. Definition pow_lt_mono : forall a b c d, 0 0 a^b < c^d := pow_lt_mono. (** Injectivity *) Lemma pow_inj_l : forall a b c, c~=0 -> a^c == b^c -> a == b. Proof. intros; eapply pow_inj_l; eauto; auto'. Qed. Lemma pow_inj_r : forall a b c, 1 a^b == a^c -> b == c. Proof. intros; eapply pow_inj_r; eauto; auto'. Qed. (** Monotonicity results, both ways *) Lemma pow_lt_mono_l_iff : forall a b c, c~=0 -> (a a^c < b^c). Proof. wrap pow_lt_mono_l_iff. Qed. Lemma pow_le_mono_l_iff : forall a b c, c~=0 -> (a<=b <-> a^c <= b^c). Proof. wrap pow_le_mono_l_iff. Qed. Lemma pow_lt_mono_r_iff : forall a b c, 1 (b a^b < a^c). Proof. wrap pow_lt_mono_r_iff. Qed. Lemma pow_le_mono_r_iff : forall a b c, 1 (b<=c <-> a^b <= a^c). Proof. wrap pow_le_mono_r_iff. Qed. Lemma pow_lower_bound : forall a b, a~= 0 -> 1 <= a ^ b. Proof. intros a b; rewrite <-(pow_0_r a); intros H. exact (pow_le_mono_r _ _ _ H (le_0_l _)). Qed. (** For any a>1, the a^x function is above the identity function *) Lemma pow_gt_lin_r : forall a b, 1 b < a^b. Proof. wrap pow_gt_lin_r. Qed. (** Someday, we should say something about the full Newton formula. In the meantime, we can at least provide some inequalities about (a+b)^c. *) Lemma pow_add_lower : forall a b c, c~=0 -> a^c + b^c <= (a+b)^c. Proof. wrap pow_add_lower. Qed. (** This upper bound can also be seen as a convexity proof for x^c : image of (a+b)/2 is below the middle of the images of a and b *) Lemma pow_add_upper : forall a b c, c~=0 -> (a+b)^c <= 2^(pred c) * (a^c + b^c). Proof. wrap pow_add_upper. Qed. (** Power and parity *) Lemma even_pow : forall a b, b~=0 -> even (a^b) = even a. Proof. intros a b Hb. rewrite neq_0_lt_0 in Hb. apply lt_ind with (4:=Hb). - solve_proper. - now nzsimpl. - clear b Hb. intros b Hb IH. rewrite pow_succ_r', even_mul, IH. now destruct (even a). Qed. Lemma odd_pow : forall a b, b~=0 -> odd (a^b) = odd a. Proof. intros. now rewrite <- !negb_even, even_pow. Qed. End NPowProp. coq-8.20.0/theories/Numbers/Natural/Abstract/NProperties.v000066400000000000000000000035641466560755400234640ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* √a == b := sqrt_unique. Lemma sqrt_square : forall a, √(a*a) == a. Proof. wrap sqrt_square. Qed. Definition sqrt_le_mono : forall a b, a<=b -> √a <= √b := sqrt_le_mono. Definition sqrt_lt_cancel : forall a b, √a < √b -> a < b := sqrt_lt_cancel. Lemma sqrt_le_square : forall a b, b*b<=a <-> b <= √a. Proof. wrap sqrt_le_square. Qed. Lemma sqrt_lt_square : forall a b, a √a < b. Proof. wrap sqrt_lt_square. Qed. Definition sqrt_0 := sqrt_0. Definition sqrt_1 := sqrt_1. Definition sqrt_2 := sqrt_2. Definition sqrt_lt_lin : forall a, 1 √aA)->N->A] is the step function: [F f n] should return [phi(n)] when [f] is a function that coincide with [phi] for numbers strictly less than [n]. *) Definition strong_rec (a : A) (f : (N.t -> A) -> N.t -> A) (n : N.t) : A := recursion (fun _ => a) (fun _ => f) (S n) n. (** For convenience, we use in proofs an intermediate definition between [recursion] and [strong_rec]. *) Definition strong_rec0 (a : A) (f : (N.t -> A) -> N.t -> A) : N.t -> N.t -> A := recursion (fun _ => a) (fun _ => f). Lemma strong_rec_alt : forall a f n, strong_rec a f n = strong_rec0 a f (S n) n. Proof. reflexivity. Qed. Instance strong_rec0_wd : Proper (Aeq ==> ((N.eq ==> Aeq) ==> N.eq ==> Aeq) ==> N.eq ==> N.eq ==> Aeq) strong_rec0. Proof. unfold strong_rec0; f_equiv'. Qed. Instance strong_rec_wd : Proper (Aeq ==> ((N.eq ==> Aeq) ==> N.eq ==> Aeq) ==> N.eq ==> Aeq) strong_rec. Proof. intros a a' Eaa' f f' Eff' n n' Enn'. rewrite !strong_rec_alt; f_equiv'. Qed. Section FixPoint. Variable f : (N.t -> A) -> N.t -> A. Variable f_wd : Proper ((N.eq==>Aeq)==>N.eq==>Aeq) f. Lemma strong_rec0_0 : forall a m, (strong_rec0 a f 0 m) = a. Proof. intros. unfold strong_rec0. rewrite recursion_0; auto. Qed. Lemma strong_rec0_succ : forall a n m, Aeq (strong_rec0 a f (S n) m) (f (strong_rec0 a f n) m). Proof. intros. unfold strong_rec0. f_equiv. rewrite recursion_succ; f_equiv'. Qed. Lemma strong_rec_0 : forall a, Aeq (strong_rec a f 0) (f (fun _ => a) 0). Proof. intros. rewrite strong_rec_alt, strong_rec0_succ; f_equiv'. rewrite strong_rec0_0. reflexivity. Qed. (* We need an assumption saying that for every n, the step function (f h n) calls h only on the segment [0 ... n - 1]. This means that if h1 and h2 coincide on values < n, then (f h1 n) coincides with (f h2 n) *) Hypothesis step_good : forall (n : N.t) (h1 h2 : N.t -> A), (forall m : N.t, m < n -> Aeq (h1 m) (h2 m)) -> Aeq (f h1 n) (f h2 n). Lemma strong_rec0_more_steps : forall a k n m, m < n -> Aeq (strong_rec0 a f n m) (strong_rec0 a f (n+k) m). Proof. intros a k n. pattern n. apply induction; clear n. - intros n n' Hn; setoid_rewrite Hn; auto with *. - intros m Hm. destruct (nlt_0_r _ Hm). - intros n IH m Hm. rewrite lt_succ_r in Hm. rewrite add_succ_l. rewrite 2 strong_rec0_succ. apply step_good. intros m' Hm'. apply IH. apply lt_le_trans with m; auto. Qed. Lemma strong_rec0_fixpoint : forall (a : A) (n : N.t), Aeq (strong_rec0 a f (S n) n) (f (fun n => strong_rec0 a f (S n) n) n). Proof. intros. rewrite strong_rec0_succ. apply step_good. intros m Hm. symmetry. setoid_replace n with (S m + (n - S m)). - apply strong_rec0_more_steps. apply lt_succ_diag_r. - rewrite add_comm. symmetry. apply sub_add. rewrite le_succ_l; auto. Qed. Theorem strong_rec_fixpoint : forall (a : A) (n : N.t), Aeq (strong_rec a f n) (f (strong_rec a f) n). Proof. intros. transitivity (f (fun n => strong_rec0 a f (S n) n) n). - rewrite strong_rec_alt. apply strong_rec0_fixpoint. - f_equiv. intros x x' Hx; rewrite strong_rec_alt, Hx; auto with *. Qed. (** NB: without the [step_good] hypothesis, we have proved that [strong_rec a f 0] is [f (fun _ => a) 0]. Now we can prove that the first argument of [f] is arbitrary in this case... *) Theorem strong_rec_0_any : forall (a : A)(any : N.t->A), Aeq (strong_rec a f 0) (f any 0). Proof. intros. rewrite strong_rec_fixpoint. apply step_good. intros m Hm. destruct (nlt_0_r _ Hm). Qed. (** ... and that first argument of [strong_rec] is always arbitrary. *) Lemma strong_rec_any_fst_arg : forall a a' n, Aeq (strong_rec a f n) (strong_rec a' f n). Proof. intros a a' n. generalize (le_refl n). set (k:=n) at -2. clearbody k. revert k. pattern n. apply induction; clear n. - (* compat *) intros n n' Hn. setoid_rewrite Hn; auto with *. - (* 0 *) intros k Hk. rewrite le_0_r in Hk. rewrite Hk, strong_rec_0. symmetry. apply strong_rec_0_any. - (* S *) intros n IH k Hk. rewrite 2 strong_rec_fixpoint. apply step_good. intros m Hm. apply IH. rewrite succ_le_mono. apply le_trans with k; auto. rewrite le_succ_l; auto. Qed. End FixPoint. End StrongRecursion. Arguments strong_rec [A] a f n. End NStrongRecProp. coq-8.20.0/theories/Numbers/Natural/Abstract/NSub.v000066400000000000000000000265211466560755400220570ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* m -> n - m ~= 0. Proof. intros n m H; elim H using lt_ind_rel; clear n m H. - solve_proper. - intro; rewrite sub_0_r; apply neq_succ_0. - intros; now rewrite sub_succ. Qed. Theorem add_sub_assoc : forall n m p, p <= m -> n + (m - p) == (n + m) - p. Proof. intros n m p; induct p. - intro; now do 2 rewrite sub_0_r. - intros p IH H. do 2 rewrite sub_succ_r. rewrite <- IH by (apply lt_le_incl; now apply le_succ_l). rewrite add_pred_r by (apply sub_gt; now apply le_succ_l). reflexivity. Qed. Theorem sub_succ_l : forall n m, n <= m -> S m - n == S (m - n). Proof. intros n m H. rewrite <- (add_1_l m). rewrite <- (add_1_l (m - n)). symmetry; now apply add_sub_assoc. Qed. Theorem add_sub : forall n m, (n + m) - m == n. Proof. intros n m. rewrite <- add_sub_assoc by (apply le_refl). rewrite sub_diag; now rewrite add_0_r. Qed. Theorem sub_add : forall n m, n <= m -> (m - n) + n == m. Proof. intros n m H. rewrite add_comm. rewrite add_sub_assoc by assumption. rewrite add_comm. apply add_sub. Qed. Theorem add_sub_eq_l : forall n m p, m + p == n -> n - m == p. Proof. intros n m p H. symmetry. assert (H1 : m + p - m == n - m) by now rewrite H. rewrite add_comm in H1. now rewrite add_sub in H1. Qed. Theorem add_sub_eq_r : forall n m p, m + p == n -> n - p == m. Proof. intros n m p H; rewrite add_comm in H; now apply add_sub_eq_l. Qed. (* This could be proved by adding m to both sides. Then the proof would use add_sub_assoc and sub_0_le, which is proven below. *) Theorem add_sub_eq_nz : forall n m p, p ~= 0 -> n - m == p -> m + p == n. Proof. intros n m p H; double_induct n m. - intros m H1; rewrite sub_0_l in H1. symmetry in H1; false_hyp H1 H. - intro n; rewrite sub_0_r; now rewrite add_0_l. - intros n m IH H1. rewrite sub_succ in H1. apply IH in H1. rewrite add_succ_l; now rewrite H1. Qed. Theorem sub_add_distr : forall n m p, n - (m + p) == (n - m) - p. Proof. intros n m p; induct p. - rewrite add_0_r; now rewrite sub_0_r. - intros p IH. rewrite add_succ_r; do 2 rewrite sub_succ_r. now rewrite IH. Qed. Theorem add_sub_swap : forall n m p, p <= n -> n + m - p == n - p + m. Proof. intros n m p H. rewrite (add_comm n m). rewrite <- add_sub_assoc by assumption. now rewrite (add_comm m (n - p)). Qed. (** Sub and order *) Theorem le_sub_l : forall n m, n - m <= n. Proof. intros n m; induct m. - rewrite sub_0_r; now apply eq_le_incl. - intros m IH. rewrite sub_succ_r. apply le_trans with (n - m); [apply le_pred_l | assumption]. Qed. Theorem sub_0_le : forall n m, n - m == 0 <-> n <= m. Proof. intros n m; double_induct n m. - intro m; split; intro; [apply le_0_l | apply sub_0_l]. - intro m; rewrite sub_0_r; split; intro H; [false_hyp H neq_succ_0 | false_hyp H nle_succ_0]. - intros n m H. rewrite <- succ_le_mono. now rewrite sub_succ. Qed. Theorem sub_pred_l : forall n m, P n - m == P (n - m). Proof. intros n m; destruct (zero_or_succ n) as [-> | [k ->]]. - rewrite pred_0, sub_0_l, pred_0; reflexivity. - rewrite pred_succ; destruct (lt_ge_cases k m) as [H | H]. + pose proof H as H'. apply lt_le_incl in H' as ->%sub_0_le. apply le_succ_l, sub_0_le in H as ->; rewrite pred_0; reflexivity. + rewrite sub_succ_l, pred_succ by (exact H); reflexivity. Qed. Theorem sub_pred_r : forall n m, m ~= 0 -> m <= n -> n - P m == S (n - m). Proof. intros n m H H'; destruct (zero_or_succ m) as [[]%H | [k Hk]]; rewrite Hk in *. rewrite pred_succ, sub_succ_r, succ_pred; [reflexivity |]. apply sub_gt, le_succ_l; exact H'. Qed. Theorem sub_add_le : forall n m, n <= n - m + m. Proof. intros n m. destruct (le_ge_cases n m) as [LE|GE]. - rewrite <- sub_0_le in LE. rewrite LE; nzsimpl. now rewrite <- sub_0_le. - rewrite sub_add by assumption. apply le_refl. Qed. Theorem le_sub_le_add_r : forall n m p, n - p <= m <-> n <= m + p. Proof. intros n m p. split; intros LE. - rewrite (add_le_mono_r _ _ p) in LE. apply le_trans with (n-p+p); auto using sub_add_le. - destruct (le_ge_cases n p) as [LE'|GE]. + rewrite <- sub_0_le in LE'. rewrite LE'. apply le_0_l. + rewrite (add_le_mono_r _ _ p). now rewrite sub_add. Qed. Theorem le_sub_le_add_l : forall n m p, n - m <= p <-> n <= m + p. Proof. intros n m p. rewrite add_comm; apply le_sub_le_add_r. Qed. Theorem lt_sub_lt_add_r : forall n m p, n - p < m -> n < m + p. Proof. intros n m p LT. rewrite (add_lt_mono_r _ _ p) in LT. apply le_lt_trans with (n-p+p); auto using sub_add_le. Qed. (** Unfortunately, we do not have [n < m + p -> n - p < m]. For instance [1<0+2] but not [1-2<0]. *) Theorem lt_sub_lt_add_l : forall n m p, n - m < p -> n < m + p. Proof. intros n m p. rewrite add_comm; apply lt_sub_lt_add_r. Qed. Theorem le_add_le_sub_r : forall n m p, n + p <= m -> n <= m - p. Proof. intros n m p LE. apply (add_le_mono_r _ _ p). rewrite sub_add. - assumption. - apply le_trans with (n+p); trivial. rewrite <- (add_0_l p) at 1. rewrite <- add_le_mono_r. apply le_0_l. Qed. (** Unfortunately, we do not have [n <= m - p -> n + p <= m]. For instance [0<=1-2] but not [2+0<=1]. *) Theorem le_add_le_sub_l : forall n m p, n + p <= m -> p <= m - n. Proof. intros n m p. rewrite add_comm; apply le_add_le_sub_r. Qed. Theorem lt_add_lt_sub_r : forall n m p, n + p < m <-> n < m - p. Proof. intros n m p. destruct (le_ge_cases p m) as [LE|GE]. - rewrite <- (sub_add p m) at 1 by assumption. now rewrite <- add_lt_mono_r. - assert (GE' := GE). rewrite <- sub_0_le in GE'; rewrite GE'. split; intros LT. + elim (lt_irrefl m). apply le_lt_trans with (n+p); trivial. rewrite <- (add_0_l m). apply add_le_mono. * apply le_0_l. * assumption. + now elim (nlt_0_r n). Qed. Theorem lt_add_lt_sub_l : forall n m p, n + p < m <-> p < m - n. Proof. intros n m p. rewrite add_comm; apply lt_add_lt_sub_r. Qed. Theorem sub_lt : forall n m, m <= n -> 0 < m -> n - m < n. Proof. intros n m LE LT. assert (LE' := le_sub_l n m). rewrite lt_eq_cases in LE'. destruct LE' as [LT'|EQ]. - assumption. - apply add_sub_eq_nz in EQ; [|order]. rewrite (add_lt_mono_r _ _ n), add_0_l in LT. order. Qed. Lemma sub_le_mono_r : forall n m p, n <= m -> n-p <= m-p. Proof. intros n m p. rewrite le_sub_le_add_r. transitivity m. - assumption. - apply sub_add_le. Qed. Lemma sub_le_mono_l : forall n m p, n <= m -> p-m <= p-n. Proof. intros n m p. rewrite le_sub_le_add_r. transitivity (p-n+n); [ apply sub_add_le | now apply add_le_mono_l]. Qed. Theorem sub_sub_distr : forall n m p, p <= m -> m <= n -> n - (m - p) == (n - m) + p. Proof. intros n m p; revert n m; induct p. - intros n m _ _; rewrite add_0_r, sub_0_r; reflexivity. - intros p IH n m H1 H2; rewrite add_succ_r. destruct (zero_or_succ m) as [Hm | [k Hk]]. + contradict H1; rewrite Hm; exact (nle_succ_0 _). + rewrite Hk in *; clear m Hk; rewrite sub_succ; apply <-succ_le_mono in H1. assert (n - k ~= 0) as ne by (apply sub_gt, le_succ_l; exact H2). rewrite sub_succ_r, add_pred_l by (exact ne). rewrite succ_pred by (intros [[]%ne _]%eq_add_0). apply IH with (1 := H1), le_trans with (2 := H2). exact (le_succ_diag_r _). Qed. (** Sub and mul *) Theorem mul_pred_r : forall n m, n * (P m) == n * m - n. Proof. intros n m; cases m. - now rewrite pred_0, mul_0_r, sub_0_l. - intro m; rewrite pred_succ, mul_succ_r, <- add_sub_assoc. + now rewrite sub_diag, add_0_r. + now apply eq_le_incl. Qed. Theorem mul_sub_distr_r : forall n m p, (n - m) * p == n * p - m * p. Proof. intros n m p; induct n. - now rewrite sub_0_l, mul_0_l, sub_0_l. - intros n IH. destruct (le_gt_cases m n) as [H | H]. + rewrite sub_succ_l by assumption. do 2 rewrite mul_succ_l. rewrite (add_comm ((n - m) * p) p), (add_comm (n * p) p). rewrite <- (add_sub_assoc p (n * p) (m * p)) by now apply mul_le_mono_r. now apply add_cancel_l. + assert (H1 : S n <= m) by now apply le_succ_l. setoid_replace (S n - m) with 0 by now apply sub_0_le. setoid_replace ((S n * p) - m * p) with 0 by (apply sub_0_le; now apply mul_le_mono_r). apply mul_0_l. Qed. Theorem mul_sub_distr_l : forall n m p, p * (n - m) == p * n - p * m. Proof. intros n m p; rewrite (mul_comm p (n - m)), (mul_comm p n), (mul_comm p m). apply mul_sub_distr_r. Qed. (** Alternative definitions of [<=] and [<] based on [+] *) Definition le_alt n m := exists p, p + n == m. Definition lt_alt n m := exists p, S p + n == m. Lemma le_equiv : forall n m, le_alt n m <-> n <= m. Proof. intros n m; split. - intros (p,H). rewrite <- H, add_comm. apply le_add_r. - intro H. exists (m-n). now apply sub_add. Qed. Lemma lt_equiv : forall n m, lt_alt n m <-> n < m. Proof. intros n m; split. - intros (p,H). rewrite <- H, add_succ_l, lt_succ_r, add_comm. apply le_add_r. - intro H. exists (m-S n). rewrite add_succ_l, <- add_succ_r. apply sub_add. now rewrite le_succ_l. Qed. #[global] Instance le_alt_wd : Proper (eq==>eq==>iff) le_alt. Proof. intros x x' Hx y y' Hy; unfold le_alt. setoid_rewrite Hx. setoid_rewrite Hy. auto with *. Qed. #[global] Instance lt_alt_wd : Proper (eq==>eq==>iff) lt_alt. Proof. intros x x' Hx y y' Hy; unfold lt_alt. setoid_rewrite Hx. setoid_rewrite Hy. auto with *. Qed. (** With these alternative definition, the dichotomy: [forall n m, n <= m \/ m <= n] becomes: [forall n m, (exists p, p + n == m) \/ (exists p, p + m == n)] We will need this in the proof of induction principle for integers constructed as pairs of natural numbers. This formula can be proved from know properties of [<=]. However, it can also be done directly. *) Theorem le_alt_dichotomy : forall n m, le_alt n m \/ le_alt m n. Proof. intros n m; induct n. - left; exists m; apply add_0_r. - intros n IH. destruct IH as [[p H] | [p H]]. + destruct (zero_or_succ p) as [H1 | [p' H1]]; rewrite H1 in H. * rewrite add_0_l in H. right; exists (S 0); rewrite H, add_succ_l; now rewrite add_0_l. * left; exists p'; rewrite add_succ_r; now rewrite add_succ_l in H. + right; exists (S p). rewrite add_succ_l; now rewrite H. Qed. Theorem add_dichotomy : forall n m, (exists p, p + n == m) \/ (exists p, p + m == n). Proof. exact le_alt_dichotomy. Qed. End NSubProp. coq-8.20.0/theories/Numbers/Natural/Binary/000077500000000000000000000000001466560755400204745ustar00rootroot00000000000000coq-8.20.0/theories/Numbers/Natural/Binary/NBinary.v000066400000000000000000000033271466560755400222320ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* 0 | xO p' => N.succ (binposlog p') | xI p' => N.succ (binposlog p') end. Definition binlog (n : N) : N := match n with | 0 => 0 | Npos p => binposlog p end. Time Eval vm_compute in (binlog 500000). (* 0 sec *) Time Eval vm_compute in (binlog 1000000000000000000000000000000). (* 0 sec *) *) coq-8.20.0/theories/Numbers/NumPrelude.v000066400000000000000000000024711466560755400201150ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* Gt. Definition ge x y := (x ?= y) <> Lt. Infix "<=" := le : positive_scope. Infix "<" := lt : positive_scope. Infix ">=" := ge : positive_scope. Infix ">" := gt : positive_scope. Notation "x <= y <= z" := (x <= y /\ y <= z) : positive_scope. Notation "x <= y < z" := (x <= y /\ y < z) : positive_scope. Notation "x < y < z" := (x < y /\ y < z) : positive_scope. Notation "x < y <= z" := (x < y /\ y <= z) : positive_scope. (**********************************************************************) (** * Properties of operations over positive numbers *) (** ** Decidability of equality on binary positive numbers *) Lemma eq_dec : forall x y:positive, {x = y} + {x <> y}. Proof. decide equality. Defined. (**********************************************************************) (** * Properties of successor on binary positive numbers *) (** ** Specification of [xI] in term of [succ] and [xO] *) Lemma xI_succ_xO p : p~1 = succ p~0. Proof. reflexivity. Qed. Lemma succ_discr p : p <> succ p. Proof. now destruct p. Qed. (** ** Successor and double *) Lemma pred_double_spec p : pred_double p = pred (p~0). Proof. reflexivity. Qed. Lemma succ_pred_double p : succ (pred_double p) = p~0. Proof. induction p; simpl; now f_equal. Qed. Lemma pred_double_succ p : pred_double (succ p) = p~1. Proof. induction p; simpl; now f_equal. Qed. Lemma double_succ p : (succ p)~0 = succ (succ p~0). Proof. now destruct p. Qed. Lemma pred_double_xO_discr p : pred_double p <> p~0. Proof. now destruct p. Qed. (** ** Successor and predecessor *) Lemma succ_not_1 p : succ p <> 1. Proof. now destruct p. Qed. Lemma pred_succ p : pred (succ p) = p. Proof. destruct p; simpl; trivial. apply pred_double_succ. Qed. Lemma succ_pred_or p : p = 1 \/ succ (pred p) = p. Proof. destruct p; simpl; auto. right; apply succ_pred_double. Qed. Lemma succ_pred p : p <> 1 -> succ (pred p) = p. Proof. destruct p; intros H; simpl; trivial. - apply succ_pred_double. - now destruct H. Qed. (** ** Injectivity of successor *) Lemma succ_inj p q : succ p = succ q -> p = q. Proof. revert q. induction p as [p|p|]; intros [q|q| ] H; simpl in H; destr_eq H; f_equal; auto. - elim (succ_not_1 p); auto. - elim (succ_not_1 q); auto. Qed. (** ** Predecessor to [N] *) Lemma pred_N_succ p : pred_N (succ p) = Npos p. Proof. destruct p; simpl; trivial. f_equal. apply pred_double_succ. Qed. (**********************************************************************) (** * Properties of addition on binary positive numbers *) (** ** Specification of [succ] in term of [add] *) Lemma add_1_r p : p + 1 = succ p. Proof. now destruct p. Qed. Lemma add_1_l p : 1 + p = succ p. Proof. now destruct p. Qed. (** ** Specification of [add_carry] *) Theorem add_carry_spec p q : add_carry p q = succ (p + q). Proof. revert q. induction p; intro q; destruct q; simpl; now f_equal. Qed. (** ** Commutativity *) Theorem add_comm p q : p + q = q + p. Proof. revert q. induction p; intro q; destruct q; simpl; f_equal; trivial. rewrite 2 add_carry_spec; now f_equal. Qed. (** ** Permutation of [add] and [succ] *) Theorem add_succ_r p q : p + succ q = succ (p + q). Proof. revert q. induction p; intro q; destruct q; simpl; f_equal; auto using add_1_r; rewrite add_carry_spec; auto. Qed. Theorem add_succ_l p q : succ p + q = succ (p + q). Proof. rewrite add_comm, (add_comm p). apply add_succ_r. Qed. (** ** No neutral elements for addition *) Lemma add_no_neutral p q : q + p <> p. Proof. revert q. induction p as [p IHp|p IHp| ]; intros [q|q| ] H; destr_eq H; apply (IHp q H). Qed. (** ** Simplification *) Lemma add_carry_add p q r s : add_carry p r = add_carry q s -> p + r = q + s. Proof. intros H; apply succ_inj; now rewrite <- 2 add_carry_spec. Qed. Lemma add_reg_r p q r : p + r = q + r -> p = q. Proof. revert p q. induction r. - intros [p|p| ] [q|q| ] H; simpl; destr_eq H; f_equal; auto using add_carry_add; contradict H; rewrite add_carry_spec, <- add_succ_r; auto using add_no_neutral. - intros [p|p| ] [q|q| ] H; simpl; destr_eq H; f_equal; auto; contradict H; auto using add_no_neutral. - intros p q H. apply succ_inj. now rewrite <- 2 add_1_r. Qed. Lemma add_reg_l p q r : p + q = p + r -> q = r. Proof. rewrite 2 (add_comm p). now apply add_reg_r. Qed. Lemma add_cancel_r p q r : p + r = q + r <-> p = q. Proof. split. - apply add_reg_r. - congruence. Qed. Lemma add_cancel_l p q r : r + p = r + q <-> p = q. Proof. split. - apply add_reg_l. - congruence. Qed. Lemma add_carry_reg_r p q r : add_carry p r = add_carry q r -> p = q. Proof. intros H. apply (add_reg_r _ _ r); now apply add_carry_add. Qed. Lemma add_carry_reg_l p q r : add_carry p q = add_carry p r -> q = r. Proof. intros H; apply (add_reg_r _ _ p); rewrite (add_comm r), (add_comm q); now apply add_carry_add. Qed. (** ** Addition is associative *) Theorem add_assoc p q r : p + (q + r) = p + q + r. Proof. revert q r. induction p. - intros [q|q| ] [r|r| ]; simpl; f_equal; trivial; rewrite ?add_carry_spec, ?add_succ_r, ?add_succ_l, ?add_1_r; f_equal; trivial. - intros [q|q| ] [r|r| ]; simpl; f_equal; trivial; rewrite ?add_carry_spec, ?add_succ_r, ?add_succ_l, ?add_1_r; f_equal; trivial. - intros q r; rewrite 2 add_1_l, add_succ_l; auto. Qed. (** ** Commutation of addition and double *) Lemma add_xO p q : (p + q)~0 = p~0 + q~0. Proof. now destruct p, q. Qed. Lemma add_xI_pred_double p q : (p + q)~0 = p~1 + pred_double q. Proof. change (p~1) with (p~0 + 1). now rewrite <- add_assoc, add_1_l, succ_pred_double. Qed. Lemma add_xO_pred_double p q : pred_double (p + q) = p~0 + pred_double q. Proof. revert q. induction p as [p IHp| p IHp| ]; intro q; destruct q; simpl; rewrite ?add_carry_spec, ?pred_double_succ, ?add_xI_pred_double; try reflexivity. - rewrite IHp; auto. - rewrite <- succ_pred_double, <- add_1_l. reflexivity. Qed. (** ** Miscellaneous *) Lemma add_diag p : p + p = p~0. Proof. induction p as [p IHp| p IHp| ]; simpl; now rewrite ?add_carry_spec, ?IHp. Qed. (**********************************************************************) (** * Peano induction and recursion on binary positive positive numbers *) (** The Peano-like recursor function for [positive] (due to Daniel Schepler) *) Fixpoint peano_rect (P:positive->Type) (a:P 1) (f: forall p:positive, P p -> P (succ p)) (p:positive) : P p := let f2 := peano_rect (fun p:positive => P (p~0)) (f _ a) (fun (p:positive) (x:P (p~0)) => f _ (f _ x)) in match p with | q~1 => f _ (f2 q) | q~0 => f2 q | 1 => a end. Theorem peano_rect_succ (P:positive->Type) (a:P 1) (f:forall p, P p -> P (succ p)) (p:positive) : peano_rect P a f (succ p) = f _ (peano_rect P a f p). Proof. revert P a f. induction p as [p IHp|p IHp|]; trivial. intros. simpl. now rewrite IHp. Qed. Theorem peano_rect_base (P:positive->Type) (a:P 1) (f:forall p, P p -> P (succ p)) : peano_rect P a f 1 = a. Proof. trivial. Qed. Definition peano_rec (P:positive->Set) := peano_rect P. (** Peano induction *) Definition peano_ind (P:positive->Prop) := peano_rect P. (** Peano case analysis *) Theorem peano_case : forall P:positive -> Prop, P 1 -> (forall n:positive, P (succ n)) -> forall p:positive, P p. Proof. intros; apply peano_ind; auto. Qed. (** Earlier, the Peano-like recursor was built and proved in a way due to Conor McBride, see "The view from the left" *) Inductive PeanoView : positive -> Type := | PeanoOne : PeanoView 1 | PeanoSucc : forall p, PeanoView p -> PeanoView (succ p). Fixpoint peanoView_xO p (q:PeanoView p) : PeanoView (p~0) := match q in PeanoView x return PeanoView (x~0) with | PeanoOne => PeanoSucc _ PeanoOne | PeanoSucc _ q => PeanoSucc _ (PeanoSucc _ (peanoView_xO _ q)) end. Fixpoint peanoView_xI p (q:PeanoView p) : PeanoView (p~1) := match q in PeanoView x return PeanoView (x~1) with | PeanoOne => PeanoSucc _ (PeanoSucc _ PeanoOne) | PeanoSucc _ q => PeanoSucc _ (PeanoSucc _ (peanoView_xI _ q)) end. Fixpoint peanoView p : PeanoView p := match p return PeanoView p with | 1 => PeanoOne | p~0 => peanoView_xO p (peanoView p) | p~1 => peanoView_xI p (peanoView p) end. Definition PeanoView_iter (P:positive->Type) (a:P 1) (f:forall p, P p -> P (succ p)) := (fix iter p (q:PeanoView p) : P p := match q in PeanoView p return P p with | PeanoOne => a | PeanoSucc _ q => f _ (iter _ q) end). Theorem eq_dep_eq_positive : forall (P:positive->Type) (p:positive) (x y:P p), eq_dep positive P p x p y -> x = y. Proof. apply eq_dep_eq_dec. decide equality. Qed. Theorem PeanoViewUnique : forall p (q q':PeanoView p), q = q'. Proof. intros p q q'. induction q as [ | p q IHq ]. - apply eq_dep_eq_positive. cut (1=1). + pattern 1 at 1 2 5, q'. destruct q' as [|p ?]. * trivial. * destruct p; intros; discriminate. + trivial. - apply eq_dep_eq_positive. cut (succ p=succ p). + pattern (succ p) at 1 2 5, q'. destruct q' as [|? q']. * intro. destruct p; discriminate. * intro H. apply succ_inj in H. generalize q'. rewrite H. intro q'0. rewrite (IHq q'0). trivial. + trivial. Qed. Lemma peano_equiv (P:positive->Type) (a:P 1) (f:forall p, P p -> P (succ p)) p : PeanoView_iter P a f p (peanoView p) = peano_rect P a f p. Proof. revert P a f. induction p as [|p IHp] using peano_rect. - trivial. - intros; simpl. rewrite peano_rect_succ. rewrite (PeanoViewUnique _ (peanoView (succ p)) (PeanoSucc _ (peanoView p))). simpl; now f_equal. Qed. (**********************************************************************) (** * Properties of multiplication on binary positive numbers *) (** ** One is neutral for multiplication *) Lemma mul_1_l p : 1 * p = p. Proof. reflexivity. Qed. Lemma mul_1_r p : p * 1 = p. Proof. induction p; simpl; now f_equal. Qed. (** ** Right reduction properties for multiplication *) Lemma mul_xO_r p q : p * q~0 = (p * q)~0. Proof. induction p; simpl; f_equal; f_equal; trivial. Qed. Lemma mul_xI_r p q : p * q~1 = p + (p * q)~0. Proof. induction p as [p IHp|p IHp| ]; simpl; f_equal; trivial. now rewrite IHp, 2 add_assoc, (add_comm p). Qed. (** ** Commutativity of multiplication *) Theorem mul_comm p q : p * q = q * p. Proof. induction q as [q IHq|q IHq| ]; simpl; rewrite <- ? IHq; auto using mul_xI_r, mul_xO_r, mul_1_r. Qed. (** ** Distributivity of multiplication over addition *) Theorem mul_add_distr_l p q r : p * (q + r) = p * q + p * r. Proof. induction p as [p IHp|p IHp| ]; simpl. - rewrite IHp. set (m:=(p*q)~0). set (n:=(p*r)~0). change ((p*q+p*r)~0) with (m+n). rewrite 2 add_assoc; f_equal. rewrite <- 2 add_assoc; f_equal. apply add_comm. - f_equal; auto. - reflexivity. Qed. Theorem mul_add_distr_r p q r : (p + q) * r = p * r + q * r. Proof. rewrite 3 (mul_comm _ r); apply mul_add_distr_l. Qed. (** ** Associativity of multiplication *) Theorem mul_assoc p q r : p * (q * r) = p * q * r. Proof. induction p as [p IHp| p IHp | ]; simpl; rewrite ?IHp; trivial. now rewrite mul_add_distr_r. Qed. (** ** Successor and multiplication *) Lemma mul_succ_l p q : (succ p) * q = q + p * q. Proof. induction p as [p IHp | p IHp | ]; simpl; trivial. - now rewrite IHp, add_assoc, add_diag, <-add_xO. - symmetry; apply add_diag. Qed. Lemma mul_succ_r p q : p * (succ q) = p + p * q. Proof. rewrite mul_comm, mul_succ_l. f_equal. apply mul_comm. Qed. (** ** Parity properties of multiplication *) Lemma mul_xI_mul_xO_discr p q r : p~1 * r <> q~0 * r. Proof. induction r; try discriminate. rewrite 2 mul_xO_r; intro H; destr_eq H; auto. Qed. Lemma mul_xO_discr p q : p~0 * q <> q. Proof. induction q; try discriminate. rewrite mul_xO_r; injection; auto. Qed. (** ** Simplification properties of multiplication *) Theorem mul_reg_r p q r : p * r = q * r -> p = q. Proof. revert q r. induction p as [p IHp| p IHp| ]; intros [q|q| ] r H; reflexivity || apply f_equal || exfalso. - apply IHp with (r~0). simpl in *. rewrite 2 mul_xO_r. apply add_reg_l with (1:=H). - contradict H. apply mul_xI_mul_xO_discr. - contradict H. simpl. rewrite add_comm. apply add_no_neutral. - symmetry in H. contradict H. apply mul_xI_mul_xO_discr. - apply IHp with (r~0). simpl. now rewrite 2 mul_xO_r. - contradict H. apply mul_xO_discr. - symmetry in H. contradict H. simpl. rewrite add_comm. apply add_no_neutral. - symmetry in H. contradict H. apply mul_xO_discr. Qed. Theorem mul_reg_l p q r : r * p = r * q -> p = q. Proof. rewrite 2 (mul_comm r). apply mul_reg_r. Qed. Lemma mul_cancel_r p q r : p * r = q * r <-> p = q. Proof. split. - apply mul_reg_r. - congruence. Qed. Lemma mul_cancel_l p q r : r * p = r * q <-> p = q. Proof. split. - apply mul_reg_l. - congruence. Qed. (** ** Inversion of multiplication *) Lemma mul_eq_1_l p q : p * q = 1 -> p = 1. Proof. now destruct p, q. Qed. Lemma mul_eq_1_r p q : p * q = 1 -> q = 1. Proof. now destruct p, q. Qed. Notation mul_eq_1 := mul_eq_1_l. (** ** Square *) Lemma square_xO p : p~0 * p~0 = (p*p)~0~0. Proof. simpl. now rewrite mul_comm. Qed. Lemma square_xI p : p~1 * p~1 = (p*p+p)~0~1. Proof. simpl. rewrite mul_comm. simpl. f_equal. rewrite add_assoc, add_diag. simpl. now rewrite add_comm. Qed. (** ** Properties of [iter] *) Lemma iter_swap_gen A B (f:A->B)(g:A->A)(h:B->B) : (forall a, f (g a) = h (f a)) -> forall p a, f (iter g a p) = iter h (f a) p. Proof. intros H p; induction p as [p IHp|p IHp|]; simpl; intros; now rewrite ?H, ?IHp. Qed. Theorem iter_swap : forall p (A:Type) (f:A -> A) (x:A), iter f (f x) p = f (iter f x p). Proof. intros. symmetry. now apply iter_swap_gen. Qed. Theorem iter_succ : forall p (A:Type) (f:A -> A) (x:A), iter f x (succ p) = f (iter f x p). Proof. intro p; induction p as [p IHp|p IHp|]; intros; simpl; trivial. now rewrite !IHp, iter_swap. Qed. Theorem iter_succ_r : forall p (A:Type) (f:A -> A) (x:A), iter f x (succ p) = iter f (f x) p. Proof. intros; now rewrite iter_succ, iter_swap. Qed. Theorem iter_add : forall p q (A:Type) (f:A -> A) (x:A), iter f x (p+q) = iter f (iter f x q) p. Proof. intro p; induction p as [|p IHp] using peano_ind; intros. - now rewrite add_1_l, iter_succ. - now rewrite add_succ_l, !iter_succ, IHp. Qed. Theorem iter_ind (A:Type) (f:A -> A) (a:A) (P:positive -> A -> Prop) : P 1 (f a) -> (forall p a', P p a' -> P (succ p) (f a')) -> forall p, P p (iter f a p). Proof. intros ? ? p; induction p as [|p IHp] using peano_ind; trivial. rewrite iter_succ; auto. Qed. Theorem iter_invariant : forall (p:positive) (A:Type) (f:A -> A) (Inv:A -> Prop), (forall x:A, Inv x -> Inv (f x)) -> forall x:A, Inv x -> Inv (iter f x p). Proof. intros; apply iter_ind; auto. Qed. (** ** Properties of power *) Lemma pow_1_r p : p^1 = p. Proof. unfold pow. simpl. now rewrite mul_comm. Qed. Lemma pow_succ_r p q : p^(succ q) = p * p^q. Proof. unfold pow. now rewrite iter_succ. Qed. (** ** Properties of square *) Lemma square_spec p : square p = p * p. Proof. induction p as [p IHp|p IHp|]. - rewrite square_xI. simpl. now rewrite IHp. - rewrite square_xO. simpl. now rewrite IHp. - trivial. Qed. (** ** Properties of [sub_mask] *) Lemma sub_mask_succ_r p q : sub_mask p (succ q) = sub_mask_carry p q. Proof. revert q. induction p as [p ?|p ?|]; intro q; destruct q; simpl; f_equal; trivial; now destruct p. Qed. Theorem sub_mask_carry_spec p q : sub_mask_carry p q = pred_mask (sub_mask p q). Proof. revert q. induction p as [p IHp|p IHp|]; intro q; destruct q as [q|q|]; simpl; try reflexivity; rewrite ?IHp; destruct (sub_mask p q) as [|[r|r| ]|] || destruct p; auto. Qed. Inductive SubMaskSpec (p q : positive) : mask -> Prop := | SubIsNul : p = q -> SubMaskSpec p q IsNul | SubIsPos : forall r, q + r = p -> SubMaskSpec p q (IsPos r) | SubIsNeg : forall r, p + r = q -> SubMaskSpec p q IsNeg. Theorem sub_mask_spec p q : SubMaskSpec p q (sub_mask p q). Proof. revert q. induction p as [p IHp|p IHp|]; intro q; destruct q as [q|q|]; simpl; try constructor; trivial. - (* p~1 q~1 *) destruct (IHp q) as [|r|r]; subst; try now constructor. now apply SubIsNeg with r~0. - (* p~1 q~0 *) destruct (IHp q) as [|r|r]; subst; try now constructor. apply SubIsNeg with (pred_double r). symmetry. apply add_xI_pred_double. - (* p~0 q~1 *) rewrite sub_mask_carry_spec. destruct (IHp q) as [|r|r]; subst; try constructor. + now apply SubIsNeg with 1. + destruct r; simpl; try constructor; simpl. * now rewrite add_carry_spec, <- add_succ_r. * now rewrite add_carry_spec, <- add_succ_r, succ_pred_double. * now rewrite add_1_r. + now apply SubIsNeg with r~1. - (* p~0 q~0 *) destruct (IHp q) as [|r|r]; subst; try now constructor. now apply SubIsNeg with r~0. - (* p~0 1 *) now rewrite add_1_l, succ_pred_double. - (* 1 q~1 *) now apply SubIsNeg with q~0. - (* 1 q~0 *) apply SubIsNeg with (pred_double q). now rewrite add_1_l, succ_pred_double. Qed. Theorem sub_mask_nul_iff p q : sub_mask p q = IsNul <-> p = q. Proof. split. - now case sub_mask_spec. - intros <-. induction p as [p IHp|p IHp|]; simpl; now rewrite ?IHp. Qed. Theorem sub_mask_diag p : sub_mask p p = IsNul. Proof. now apply sub_mask_nul_iff. Qed. Lemma sub_mask_add p q r : sub_mask p q = IsPos r -> q + r = p. Proof. case sub_mask_spec; congruence. Qed. Lemma sub_mask_add_diag_l p q : sub_mask (p+q) p = IsPos q. Proof. case sub_mask_spec. - intros H. rewrite add_comm in H. elim (add_no_neutral _ _ H). - intros r H. apply add_cancel_l in H. now f_equal. - intros r H. rewrite <- add_assoc, add_comm in H. elim (add_no_neutral _ _ H). Qed. Lemma sub_mask_pos_iff p q r : sub_mask p q = IsPos r <-> q + r = p. Proof. split. - apply sub_mask_add. - intros <-; apply sub_mask_add_diag_l. Qed. Lemma sub_mask_add_diag_r p q : sub_mask p (p+q) = IsNeg. Proof. case sub_mask_spec; trivial. - intros H. symmetry in H; rewrite add_comm in H. elim (add_no_neutral _ _ H). - intros r H. rewrite <- add_assoc, add_comm in H. elim (add_no_neutral _ _ H). Qed. Lemma sub_mask_neg_iff p q : sub_mask p q = IsNeg <-> exists r, p + r = q. Proof. split. - case sub_mask_spec; try discriminate. intros r Hr _; now exists r. - intros (r,<-). apply sub_mask_add_diag_r. Qed. (*********************************************************************) (** * Properties of boolean comparisons *) Theorem eqb_eq p q : (p =? q) = true <-> p=q. Proof. revert q. induction p as [p IHp|p IHp|]; intro q; destruct q; simpl; rewrite ?IHp; split; congruence. Qed. Theorem ltb_lt p q : (p p < q. Proof. unfold ltb, lt. destruct compare; easy'. Qed. Theorem leb_le p q : (p <=? q) = true <-> p <= q. Proof. unfold leb, le. destruct compare; easy'. Qed. (** More about [eqb] *) Include BoolEqualityFacts. (**********************************************************************) (** * Properties of comparison on binary positive numbers *) (** First, we express [compare_cont] in term of [compare] *) Definition switch_Eq c c' := match c' with | Eq => c | Lt => Lt | Gt => Gt end. Lemma compare_cont_spec p q c : compare_cont c p q = switch_Eq c (p ?= q). Proof. unfold compare. revert q c. induction p as [p IHp|p IHp|]; intro q; destruct q as [q|q|]; simpl; trivial. - intros c. rewrite 2 IHp. now destruct (compare_cont Eq p q). - intros c. rewrite 2 IHp. now destruct (compare_cont Eq p q). Qed. (** From this general result, we now describe particular cases of [compare_cont p q c = c'] : - When [c=Eq], this is directly [compare] - When [c<>Eq], we'll show first that [c'<>Eq] - That leaves only 4 lemmas for [c] and [c'] being [Lt] or [Gt] *) Theorem compare_cont_Eq p q c : compare_cont c p q = Eq -> c = Eq. Proof. rewrite compare_cont_spec. now destruct (p ?= q). Qed. Lemma compare_cont_Lt_Gt p q : compare_cont Lt p q = Gt <-> p > q. Proof. rewrite compare_cont_spec. unfold gt. destruct (p ?= q); now split. Qed. Lemma compare_cont_Lt_Lt p q : compare_cont Lt p q = Lt <-> p <= q. Proof. rewrite compare_cont_spec. unfold le. destruct (p ?= q); easy'. Qed. Lemma compare_cont_Gt_Lt p q : compare_cont Gt p q = Lt <-> p < q. Proof. rewrite compare_cont_spec. unfold lt. destruct (p ?= q); now split. Qed. Lemma compare_cont_Gt_Gt p q : compare_cont Gt p q = Gt <-> p >= q. Proof. rewrite compare_cont_spec. unfold ge. destruct (p ?= q); easy'. Qed. Lemma compare_cont_Lt_not_Lt p q : compare_cont Lt p q <> Lt <-> p > q. Proof. rewrite compare_cont_Lt_Lt. unfold gt, le, compare. now destruct compare_cont; split; try apply comparison_eq_stable. Qed. Lemma compare_cont_Lt_not_Gt p q : compare_cont Lt p q <> Gt <-> p <= q. Proof. apply not_iff_compat, compare_cont_Lt_Gt. Qed. Lemma compare_cont_Gt_not_Lt p q : compare_cont Gt p q <> Lt <-> p >= q. Proof. apply not_iff_compat, compare_cont_Gt_Lt. Qed. Lemma compare_cont_Gt_not_Gt p q : compare_cont Gt p q <> Gt <-> p < q. Proof. rewrite compare_cont_Gt_Gt. unfold ge, lt, compare. now destruct compare_cont; split; try apply comparison_eq_stable. Qed. (** We can express recursive equations for [compare] *) Lemma compare_xO_xO p q : (p~0 ?= q~0) = (p ?= q). Proof. reflexivity. Qed. Lemma compare_xI_xI p q : (p~1 ?= q~1) = (p ?= q). Proof. reflexivity. Qed. Lemma compare_xI_xO p q : (p~1 ?= q~0) = switch_Eq Gt (p ?= q). Proof. exact (compare_cont_spec p q Gt). Qed. Lemma compare_xO_xI p q : (p~0 ?= q~1) = switch_Eq Lt (p ?= q). Proof. exact (compare_cont_spec p q Lt). Qed. Global Hint Rewrite compare_xO_xO compare_xI_xI compare_xI_xO compare_xO_xI : compare. Ltac simpl_compare := autorewrite with compare. Ltac simpl_compare_in H := autorewrite with compare in H. (** Relation between [compare] and [sub_mask] *) Definition mask2cmp (p:mask) : comparison := match p with | IsNul => Eq | IsPos _ => Gt | IsNeg => Lt end. Lemma compare_sub_mask p q : (p ?= q) = mask2cmp (sub_mask p q). Proof. revert q. induction p as [p IHp| p IHp| ]; intros [q|q| ]; simpl; trivial; specialize (IHp q); rewrite ?sub_mask_carry_spec; destruct (sub_mask p q) as [|r|]; simpl in *; try clear r; try destruct r; simpl; trivial; simpl_compare; now rewrite IHp. Qed. (** Alternative characterisation of strict order in term of addition *) Lemma lt_iff_add p q : p < q <-> exists r, p + r = q. Proof. unfold "<". rewrite <- sub_mask_neg_iff, compare_sub_mask. destruct sub_mask; now split. Qed. Lemma gt_iff_add p q : p > q <-> exists r, q + r = p. Proof. unfold ">". rewrite compare_sub_mask. split. - case_eq (sub_mask p q); try discriminate; intros r Hr _. exists r. now apply sub_mask_pos_iff. - intros (r,Hr). apply sub_mask_pos_iff in Hr. now rewrite Hr. Qed. (** Basic facts about [compare_cont] *) Theorem compare_cont_refl p c : compare_cont c p p = c. Proof. now induction p. Qed. Lemma compare_cont_antisym p q c : CompOpp (compare_cont c p q) = compare_cont (CompOpp c) q p. Proof. revert q c. induction p as [p IHp|p IHp| ]; intros [q|q| ] c; simpl; trivial; apply IHp. Qed. (** Basic facts about [compare] *) Lemma compare_eq_iff p q : (p ?= q) = Eq <-> p = q. Proof. rewrite compare_sub_mask, <- sub_mask_nul_iff. destruct sub_mask; now split. Qed. Lemma compare_antisym p q : (q ?= p) = CompOpp (p ?= q). Proof. unfold compare. now rewrite compare_cont_antisym. Qed. Lemma compare_lt_iff p q : (p ?= q) = Lt <-> p < q. Proof. reflexivity. Qed. Lemma compare_le_iff p q : (p ?= q) <> Gt <-> p <= q. Proof. reflexivity. Qed. (** More properties about [compare] and boolean comparisons, including [compare_spec] and [lt_irrefl] and [lt_eq_cases]. *) Include BoolOrderFacts. Definition le_lteq := lt_eq_cases. (** ** Facts about [gt] and [ge] *) (** The predicates [lt] and [le] are now favored in the statements of theorems, the use of [gt] and [ge] is hence not recommended. We provide here the bare minimal results to related them with [lt] and [le]. *) Lemma gt_lt_iff p q : p > q <-> q < p. Proof. unfold lt, gt. now rewrite compare_antisym, CompOpp_iff. Qed. Lemma gt_lt p q : p > q -> q < p. Proof. apply gt_lt_iff. Qed. Lemma lt_gt p q : p < q -> q > p. Proof. apply gt_lt_iff. Qed. Lemma ge_le_iff p q : p >= q <-> q <= p. Proof. unfold le, ge. now rewrite compare_antisym, CompOpp_iff. Qed. Lemma ge_le p q : p >= q -> q <= p. Proof. apply ge_le_iff. Qed. Lemma le_ge p q : p <= q -> q >= p. Proof. apply ge_le_iff. Qed. (** ** Comparison and the successor *) Lemma compare_succ_r p q : switch_Eq Gt (p ?= succ q) = switch_Eq Lt (p ?= q). Proof. revert q. induction p as [p IH|p IH| ]; intros [q|q| ]; simpl; simpl_compare; rewrite ?IH; trivial; (now destruct compare) || (now destruct p). Qed. Lemma compare_succ_l p q : switch_Eq Lt (succ p ?= q) = switch_Eq Gt (p ?= q). Proof. rewrite 2 (compare_antisym q). generalize (compare_succ_r q p). now do 2 destruct compare. Qed. Theorem lt_succ_r p q : p < succ q <-> p <= q. Proof. unfold lt, le. generalize (compare_succ_r p q). do 2 destruct compare; try discriminate; now split. Qed. Lemma lt_succ_diag_r p : p < succ p. Proof. rewrite lt_iff_add. exists 1. apply add_1_r. Qed. Lemma compare_succ_succ p q : (succ p ?= succ q) = (p ?= q). Proof. revert q. induction p as [p|p|]; intro q; destruct q as [q|q|]; simpl; simpl_compare; trivial; apply compare_succ_l || apply compare_succ_r || (now destruct p) || (now destruct q). Qed. (** ** 1 is the least positive number *) Lemma le_1_l p : 1 <= p. Proof. now destruct p. Qed. Lemma nlt_1_r p : ~ p < 1. Proof. now destruct p. Qed. Lemma lt_1_succ p : 1 < succ p. Proof. apply lt_succ_r, le_1_l. Qed. (** ** Properties of the order *) Lemma le_nlt p q : p <= q <-> ~ q < p. Proof. now rewrite <- ge_le_iff. Qed. Lemma lt_nle p q : p < q <-> ~ q <= p. Proof. intros. unfold lt, le. rewrite compare_antisym. destruct compare; split; auto; easy'. Qed. Lemma lt_le_incl p q : p p<=q. Proof. intros. apply le_lteq. now left. Qed. Lemma lt_lt_succ n m : n < m -> n < succ m. Proof. intros. now apply lt_succ_r, lt_le_incl. Qed. Lemma succ_lt_mono n m : n < m <-> succ n < succ m. Proof. unfold lt. now rewrite compare_succ_succ. Qed. Lemma succ_le_mono n m : n <= m <-> succ n <= succ m. Proof. unfold le. now rewrite compare_succ_succ. Qed. Lemma lt_trans n m p : n < m -> m < p -> n < p. Proof. rewrite 3 lt_iff_add. intros (r,Hr) (s,Hs). exists (r+s). now rewrite add_assoc, Hr, Hs. Qed. Theorem lt_ind : forall (A : positive -> Prop) (n : positive), A (succ n) -> (forall m : positive, n < m -> A m -> A (succ m)) -> forall m : positive, n < m -> A m. Proof. intros A n AB AS m. induction m using peano_ind; intros H. - elim (nlt_1_r _ H). - apply lt_succ_r, le_lteq in H. destruct H as [H|H]; subst; auto. Qed. #[global] Instance lt_strorder : StrictOrder lt. Proof. split. - exact lt_irrefl. - exact lt_trans. Qed. #[global] Instance lt_compat : Proper (Logic.eq==>Logic.eq==>iff) lt. Proof. repeat red. intros. subst; auto. Qed. Lemma lt_total p q : p < q \/ p = q \/ q < p. Proof. case (compare_spec p q); intuition. Qed. Lemma le_refl p : p <= p. Proof. intros. unfold le. now rewrite compare_refl. Qed. Lemma le_lt_trans n m p : n <= m -> m < p -> n < p. Proof. intros H H'. apply le_lteq in H. destruct H. - now apply lt_trans with m. - now subst. Qed. Lemma lt_le_trans n m p : n < m -> m <= p -> n < p. Proof. intros H H'. apply le_lteq in H'. destruct H'. - now apply lt_trans with m. - now subst. Qed. Lemma le_trans n m p : n <= m -> m <= p -> n <= p. Proof. intros H H'. apply le_lteq in H. destruct H. - apply le_lteq; left. now apply lt_le_trans with m. - now subst. Qed. Lemma le_succ_l n m : succ n <= m <-> n < m. Proof. rewrite <- lt_succ_r. symmetry. apply succ_lt_mono. Qed. Lemma le_antisym p q : p <= q -> q <= p -> p = q. Proof. rewrite le_lteq; destruct 1; auto. rewrite le_lteq; destruct 1; auto. elim (lt_irrefl p). now transitivity q. Qed. #[global] Instance le_preorder : PreOrder le. Proof. split. - exact le_refl. - exact le_trans. Qed. #[global] Instance le_partorder : PartialOrder Logic.eq le. Proof. intros x y. change (x=y <-> x <= y <= x). split. - intros; now subst. - destruct 1; now apply le_antisym. Qed. (** ** Comparison and addition *) Lemma add_compare_mono_l p q r : (p+q ?= p+r) = (q ?= r). Proof. revert q r. induction p using peano_ind; intros q r. - rewrite 2 add_1_l. apply compare_succ_succ. - now rewrite 2 add_succ_l, compare_succ_succ. Qed. Lemma add_compare_mono_r p q r : (q+p ?= r+p) = (q ?= r). Proof. rewrite 2 (add_comm _ p). apply add_compare_mono_l. Qed. (** ** Order and addition *) Lemma lt_add_diag_r p q : p < p + q. Proof. rewrite lt_iff_add. now exists q. Qed. Lemma add_lt_mono_l p q r : q p+q < p+r. Proof. unfold lt. rewrite add_compare_mono_l. apply iff_refl. Qed. Lemma add_lt_mono_r p q r : q q+p < r+p. Proof. unfold lt. rewrite add_compare_mono_r. apply iff_refl. Qed. Lemma add_lt_mono p q r s : p r p+r p+q<=p+r. Proof. unfold le. rewrite add_compare_mono_l. apply iff_refl. Qed. Lemma add_le_mono_r p q r : q<=r <-> q+p<=r+p. Proof. unfold le. rewrite add_compare_mono_r. apply iff_refl. Qed. Lemma add_le_mono p q r s : p<=q -> r<=s -> p+r <= q+s. Proof. intros. apply le_trans with (p+s). - now apply add_le_mono_l. - now apply add_le_mono_r. Qed. (** ** Comparison and multiplication *) Lemma mul_compare_mono_l p q r : (p*q ?= p*r) = (q ?= r). Proof. revert q r. induction p as [p IHp|p IHp|]; simpl; trivial. intros q r. specialize (IHp q r). destruct (compare_spec q r). - subst. apply compare_refl. - now apply add_lt_mono. - now apply lt_gt, add_lt_mono, gt_lt. Qed. Lemma mul_compare_mono_r p q r : (q*p ?= r*p) = (q ?= r). Proof. rewrite 2 (mul_comm _ p). apply mul_compare_mono_l. Qed. (** ** Order and multiplication *) Lemma mul_lt_mono_l p q r : q p*q < p*r. Proof. unfold lt. rewrite mul_compare_mono_l. apply iff_refl. Qed. Lemma mul_lt_mono_r p q r : q q*p < r*p. Proof. unfold lt. rewrite mul_compare_mono_r. apply iff_refl. Qed. Lemma mul_lt_mono p q r s : p r p*r < q*s. Proof. intros. apply lt_trans with (p*s). - now apply mul_lt_mono_l. - now apply mul_lt_mono_r. Qed. Lemma mul_le_mono_l p q r : q<=r <-> p*q<=p*r. Proof. unfold le. rewrite mul_compare_mono_l. apply iff_refl. Qed. Lemma mul_le_mono_r p q r : q<=r <-> q*p<=r*p. Proof. unfold le. rewrite mul_compare_mono_r. apply iff_refl. Qed. Lemma mul_le_mono p q r s : p<=q -> r<=s -> p*r <= q*s. Proof. intros. apply le_trans with (p*s). - now apply mul_le_mono_l. - now apply mul_le_mono_r. Qed. Lemma lt_add_r p q : p < p+q. Proof. induction q as [|q] using peano_ind. - rewrite add_1_r. apply lt_succ_diag_r. - apply lt_trans with (p+q); auto. apply add_lt_mono_l, lt_succ_diag_r. Qed. Lemma lt_not_add_l p q : ~ p+q < p. Proof. intro H. elim (lt_irrefl p). apply lt_trans with (p+q); auto using lt_add_r. Qed. Lemma pow_gt_1 n p : 1 1 exists r, sub_mask p q = IsPos r /\ q + r = p. Proof. rewrite lt_iff_add. intros (r,Hr). exists r. split; trivial. now apply sub_mask_pos_iff. Qed. Lemma sub_mask_pos p q : q < p -> exists r, sub_mask p q = IsPos r. Proof. intros H. destruct (sub_mask_pos' p q H) as (r & Hr & _). now exists r. Qed. Theorem sub_add p q : q < p -> (p-q)+q = p. Proof. intros H. destruct (sub_mask_pos p q H) as (r,U). unfold sub. rewrite U. rewrite add_comm. now apply sub_mask_add. Qed. Lemma add_sub p q : (p+q)-q = p. Proof. intros. apply add_reg_r with q. rewrite sub_add; trivial. rewrite add_comm. apply lt_add_r. Qed. Lemma mul_sub_distr_l p q r : r p*(q-r) = p*q-p*r. Proof. intros H. apply add_reg_r with (p*r). rewrite <- mul_add_distr_l. rewrite sub_add; trivial. symmetry. apply sub_add; trivial. now apply mul_lt_mono_l. Qed. Lemma mul_sub_distr_r p q r : q

(p-q)*r = p*r-q*r. Proof. intros H. rewrite 3 (mul_comm _ r). now apply mul_sub_distr_l. Qed. Lemma sub_lt_mono_l p q r: q

p r-p < r-q. Proof. intros Hqp Hpr. apply (add_lt_mono_r p). rewrite sub_add by trivial. apply le_lt_trans with ((r-q)+q). - rewrite sub_add by (now apply lt_trans with p). apply le_refl. - now apply add_lt_mono_l. Qed. Lemma sub_compare_mono_l p q r : q

r

(p-q ?= p-r) = (r ?= q). Proof. intros Hqp Hrp. case (compare_spec r q); intros H. - subst. apply compare_refl. - apply sub_lt_mono_l; trivial. - apply lt_gt, sub_lt_mono_l; trivial. Qed. Lemma sub_compare_mono_r p q r : p p (q-p ?= r-p) = (q ?= r). Proof. intros. rewrite <- (add_compare_mono_r p), 2 sub_add; trivial. Qed. Lemma sub_lt_mono_r p q r : q

r q-r < p-r. Proof. intros. unfold lt. rewrite sub_compare_mono_r; trivial. now apply lt_trans with q. Qed. Lemma sub_decr n m : m n-m < n. Proof. intros. apply add_lt_mono_r with m. rewrite sub_add; trivial. apply lt_add_r. Qed. Lemma add_sub_assoc p q r : r p+(q-r) = p+q-r. Proof. intros. apply add_reg_r with r. rewrite <- add_assoc, !sub_add; trivial. rewrite add_comm. apply lt_trans with q; trivial using lt_add_r. Qed. Lemma sub_add_distr p q r : q+r < p -> p-(q+r) = p-q-r. Proof. intros. assert (q < p) by (apply lt_trans with (q+r); trivial using lt_add_r). rewrite (add_comm q r) in *. apply add_reg_r with (r+q). rewrite sub_add by trivial. rewrite add_assoc, !sub_add; trivial. apply (add_lt_mono_r q). rewrite sub_add; trivial. Qed. Lemma sub_sub_distr p q r : r q-r < p -> p-(q-r) = p+r-q. Proof. intros. apply add_reg_r with ((q-r)+r). rewrite add_assoc, !sub_add; trivial. rewrite <- (sub_add q r); trivial. now apply add_lt_mono_r. Qed. (** Recursive equations for [sub] *) Lemma sub_xO_xO n m : m n~0 - m~0 = (n-m)~0. Proof. intros H. unfold sub. simpl. now destruct (sub_mask_pos n m H) as (p, ->). Qed. Lemma sub_xI_xI n m : m n~1 - m~1 = (n-m)~0. Proof. intros H. unfold sub. simpl. now destruct (sub_mask_pos n m H) as (p, ->). Qed. Lemma sub_xI_xO n m : m n~1 - m~0 = (n-m)~1. Proof. intros H. unfold sub. simpl. now destruct (sub_mask_pos n m) as (p, ->). Qed. Lemma sub_xO_xI n m : n~0 - m~1 = pred_double (n-m). Proof. unfold sub. simpl. rewrite sub_mask_carry_spec. now destruct (sub_mask n m) as [|[r|r|]|]. Qed. (** Properties of subtraction with underflow *) Lemma sub_mask_neg_iff' p q : sub_mask p q = IsNeg <-> p < q. Proof. rewrite lt_iff_add. apply sub_mask_neg_iff. Qed. Lemma sub_mask_neg p q : p sub_mask p q = IsNeg. Proof. apply sub_mask_neg_iff'. Qed. Lemma sub_le p q : p<=q -> p-q = 1. Proof. unfold le, sub. rewrite compare_sub_mask. destruct sub_mask; easy'. Qed. Lemma sub_lt p q : p p-q = 1. Proof. intros. now apply sub_le, lt_le_incl. Qed. Lemma sub_diag p : p-p = 1. Proof. unfold sub. now rewrite sub_mask_diag. Qed. (** ** Results concerning [size] and [size_nat] *) Lemma size_nat_monotone p q : p (size_nat p <= size_nat q)%nat. Proof. assert (le0 : forall n, (0<=n)%nat) by (intro n; induction n; auto). assert (leS : forall n m, (n<=m -> S n <= S m)%nat) by (induction 1; auto). revert q. induction p as [p IHp|p IHp|]; intro q; destruct q as [q|q|]; simpl; intros H; auto; easy || apply leS; red in H; simpl_compare_in H. - apply IHp. red. now destruct (p?=q). - destruct (compare_spec p q); subst; now auto. Qed. Lemma size_gt p : p < 2^(size p). Proof. induction p as [p IHp|p IHp|]; simpl; try rewrite pow_succ_r; try easy. apply le_succ_l in IHp. now apply le_succ_l. Qed. Lemma size_le p : 2^(size p) <= p~0. Proof. induction p as [p IHp|p IHp|]; simpl; try rewrite pow_succ_r; try easy. apply mul_le_mono_l. apply le_lteq; left. rewrite xI_succ_xO. apply lt_succ_r, IHp. Qed. (** ** Properties of [min] and [max] *) (** First, the specification *) Lemma max_l : forall x y, y<=x -> max x y = x. Proof. intros x y H. unfold max. case compare_spec; auto. intros H'. apply le_nlt in H. now elim H. Qed. Lemma max_r : forall x y, x<=y -> max x y = y. Proof. unfold le, max. intros x y. destruct compare; easy'. Qed. Lemma min_l : forall x y, x<=y -> min x y = x. Proof. unfold le, min. intros x y. destruct compare; easy'. Qed. Lemma min_r : forall x y, y<=x -> min x y = y. Proof. intros x y H. unfold min. case compare_spec; auto. intros H'. apply le_nlt in H. now elim H'. Qed. (** We hence obtain all the generic properties of [min] and [max]. *) Include UsualMinMaxLogicalProperties <+ UsualMinMaxDecProperties. Ltac order := Private_Tac.order. (** Minimum, maximum and constant one *) Lemma max_1_l n : max 1 n = n. Proof. unfold max. case compare_spec; auto. intros H. apply lt_nle in H. elim H. apply le_1_l. Qed. Lemma max_1_r n : max n 1 = n. Proof. rewrite max_comm. apply max_1_l. Qed. Lemma min_1_l n : min 1 n = 1. Proof. unfold min. case compare_spec; auto. intros H. apply lt_nle in H. elim H. apply le_1_l. Qed. Lemma min_1_r n : min n 1 = 1. Proof. rewrite min_comm. apply min_1_l. Qed. (** Minimum, maximum and operations (consequences of monotonicity) *) Lemma succ_max_distr n m : succ (max n m) = max (succ n) (succ m). Proof. symmetry. apply max_monotone. intros x x'. apply succ_le_mono. Qed. Lemma succ_min_distr n m : succ (min n m) = min (succ n) (succ m). Proof. symmetry. apply min_monotone. intros x x'. apply succ_le_mono. Qed. Lemma add_max_distr_l n m p : max (p + n) (p + m) = p + max n m. Proof. apply max_monotone. intros x x'. apply add_le_mono_l. Qed. Lemma add_max_distr_r n m p : max (n + p) (m + p) = max n m + p. Proof. rewrite 3 (add_comm _ p). apply add_max_distr_l. Qed. Lemma add_min_distr_l n m p : min (p + n) (p + m) = p + min n m. Proof. apply min_monotone. intros x x'. apply add_le_mono_l. Qed. Lemma add_min_distr_r n m p : min (n + p) (m + p) = min n m + p. Proof. rewrite 3 (add_comm _ p). apply add_min_distr_l. Qed. Lemma mul_max_distr_l n m p : max (p * n) (p * m) = p * max n m. Proof. apply max_monotone. intros x x'. apply mul_le_mono_l. Qed. Lemma mul_max_distr_r n m p : max (n * p) (m * p) = max n m * p. Proof. rewrite 3 (mul_comm _ p). apply mul_max_distr_l. Qed. Lemma mul_min_distr_l n m p : min (p * n) (p * m) = p * min n m. Proof. apply min_monotone. intros x x'. apply mul_le_mono_l. Qed. Lemma mul_min_distr_r n m p : min (n * p) (m * p) = min n m * p. Proof. rewrite 3 (mul_comm _ p). apply mul_min_distr_l. Qed. (** ** Results concerning [iter_op] *) Lemma iter_op_succ : forall A (op:A->A->A), (forall x y z, op x (op y z) = op (op x y) z) -> forall p a, iter_op op (succ p) a = op a (iter_op op p a). Proof. intros A op H p; induction p as [p IHp|p IHp|]; simpl; intros; trivial. rewrite H. apply IHp. Qed. (** ** Results about [of_nat] and [of_succ_nat] *) Lemma of_nat_succ (n:nat) : of_succ_nat n = of_nat (S n). Proof. induction n as [|n IHn]. - trivial. - simpl. f_equal. now rewrite IHn. Qed. Lemma pred_of_succ_nat (n:nat) : pred (of_succ_nat n) = of_nat n. Proof. destruct n. - trivial. - simpl pred. rewrite pred_succ. apply of_nat_succ. Qed. Lemma succ_of_nat (n:nat) : n<>O -> succ (of_nat n) = of_succ_nat n. Proof. rewrite of_nat_succ. destruct n; trivial. now destruct 1. Qed. (** ** Correctness proofs for the square root function *) Inductive SqrtSpec : positive*mask -> positive -> Prop := | SqrtExact s x : x=s*s -> SqrtSpec (s,IsNul) x | SqrtApprox s r x : x=s*s+r -> r <= s~0 -> SqrtSpec (s,IsPos r) x. Lemma sqrtrem_step_spec f g p x : (f=xO \/ f=xI) -> (g=xO \/ g=xI) -> SqrtSpec p x -> SqrtSpec (sqrtrem_step f g p) (g (f x)). Proof. intros Hf Hg [ s _ -> | s r _ -> Hr ]. - (* exact *) unfold sqrtrem_step. destruct Hf,Hg; subst; simpl; constructor; now rewrite ?square_xO. - (* approx *) assert (Hfg : forall p q, g (f (p+q)) = p~0~0 + g (f q)) by (intros; destruct Hf, Hg; now subst). unfold sqrtrem_step, leb. case compare_spec; [intros EQ | intros LT | intros GT]. + (* - EQ *) rewrite <- EQ, sub_mask_diag. constructor. destruct Hg; subst g; destr_eq EQ. destruct Hf; subst f; destr_eq EQ. subst. now rewrite square_xI. + (* - LT *) destruct (sub_mask_pos' _ _ LT) as (y & -> & H). constructor. * rewrite Hfg, <- H. now rewrite square_xI, add_assoc. * clear Hfg. rewrite <- lt_succ_r in Hr. change (r < s~1) in Hr. rewrite <- lt_succ_r, (add_lt_mono_l (s~0~1)), H. simpl. rewrite add_carry_spec, add_diag. simpl. destruct Hf,Hg; subst; red; simpl_compare; now rewrite Hr. + (* - GT *) constructor. * now rewrite Hfg, square_xO. * apply lt_succ_r, GT. Qed. Lemma sqrtrem_spec p : SqrtSpec (sqrtrem p) p. Proof. revert p. fix sqrtrem_spec 1. intro p; destruct p as [p|p|]; try destruct p; try (constructor; easy); apply sqrtrem_step_spec; auto. Qed. Lemma sqrt_spec p : let s := sqrt p in s*s <= p < (succ s)*(succ s). Proof. simpl. assert (H:=sqrtrem_spec p). unfold sqrt in *. destruct sqrtrem as (s,rm); simpl. inversion_clear H; subst. - (* exact *) split. + reflexivity. + apply mul_lt_mono; apply lt_succ_diag_r. - (* approx *) split. + apply lt_le_incl, lt_add_r. + rewrite <- add_1_l, mul_add_distr_r, !mul_add_distr_l, !mul_1_r, !mul_1_l. rewrite add_assoc, (add_comm _ _). apply add_lt_mono_r. now rewrite <- add_assoc, add_diag, add_1_l, lt_succ_r. Qed. (** ** Correctness proofs for the gcd function *) Lemma divide_add_cancel_l p q r : (p | r) -> (p | q + r) -> (p | q). Proof. intros (s,Hs) (t,Ht). exists (t-s). rewrite mul_sub_distr_r. - rewrite <- Hs, <- Ht. symmetry. apply add_sub. - apply mul_lt_mono_r with p. rewrite <- Hs, <- Ht, add_comm. apply lt_add_r. Qed. Lemma divide_xO_xI p q r : (p | q~0) -> (p | r~1) -> (p | q). Proof. intros (s,Hs) (t,Ht). destruct p. - destruct s as [s|s|]; try easy. simpl in Hs. destr_eq Hs. now exists s. - rewrite mul_xO_r in Ht; discriminate. - exists q; now rewrite mul_1_r. Qed. Lemma divide_xO_xO p q : (p~0|q~0) <-> (p|q). Proof. split; intros (r,H); simpl in *. - rewrite mul_xO_r in H. destr_eq H. now exists r. - exists r; simpl. rewrite mul_xO_r. f_equal; auto. Qed. Lemma divide_mul_l p q r : (p|q) -> (p|q*r). Proof. intros (s,H). exists (s*r). rewrite <- mul_assoc, (mul_comm r p), mul_assoc. now f_equal. Qed. Lemma divide_mul_r p q r : (p|r) -> (p|q*r). Proof. rewrite mul_comm. apply divide_mul_l. Qed. (** The first component of ggcd is gcd *) Lemma ggcdn_gcdn : forall n a b, fst (ggcdn n a b) = gcdn n a b. Proof. intro n; induction n as [|n IHn]. - simpl; auto. - intros a b; destruct a, b; simpl; auto; try case compare_spec; simpl; trivial; rewrite <- IHn; destruct ggcdn as (g,(u,v)); simpl; auto. Qed. Lemma ggcd_gcd : forall a b, fst (ggcd a b) = gcd a b. Proof. unfold ggcd, gcd. intros. apply ggcdn_gcdn. Qed. (** The other components of ggcd are indeed the correct factors. *) Ltac destr_pggcdn IHn := match goal with |- context [ ggcdn _ ?x ?y ] => generalize (IHn x y); destruct ggcdn as (?g,(?u,?v)); simpl end. Lemma ggcdn_correct_divisors : forall n a b, let '(g,(aa,bb)) := ggcdn n a b in a = g*aa /\ b = g*bb. Proof. intro n; induction n as [|n IHn]. - simpl; auto. - intros a b; destruct a, b; simpl; auto; try case compare_spec; try destr_pggcdn IHn. + (* Eq *) intros ->. now rewrite mul_comm. + (* Lt *) intros (H',H) LT; split; auto. rewrite mul_add_distr_l, mul_xO_r, <- H, <- H'. simpl. f_equal. symmetry. rewrite add_comm. now apply sub_add. + (* Gt *) intros (H',H) LT; split; auto. rewrite mul_add_distr_l, mul_xO_r, <- H, <- H'. simpl. f_equal. symmetry. rewrite add_comm. now apply sub_add. + (* Then... *) intros (H,H'); split; auto. rewrite mul_xO_r, H'; auto. + intros (H,H'); split; auto. rewrite mul_xO_r, H; auto. + intros (H,H'); split; subst; auto. Qed. Lemma ggcd_correct_divisors : forall a b, let '(g,(aa,bb)) := ggcd a b in a=g*aa /\ b=g*bb. Proof. unfold ggcd. intros. apply ggcdn_correct_divisors. Qed. (** We can use this fact to prove a part of the gcd correctness *) Lemma gcd_divide_l : forall a b, (gcd a b | a). Proof. intros a b. rewrite <- ggcd_gcd. generalize (ggcd_correct_divisors a b). destruct ggcd as (g,(aa,bb)); simpl. intros (H,_). exists aa. now rewrite mul_comm. Qed. Lemma gcd_divide_r : forall a b, (gcd a b | b). Proof. intros a b. rewrite <- ggcd_gcd. generalize (ggcd_correct_divisors a b). destruct ggcd as (g,(aa,bb)); simpl. intros (_,H). exists bb. now rewrite mul_comm. Qed. (** We now prove directly that gcd is the greatest amongst common divisors *) Lemma gcdn_greatest : forall n a b, (size_nat a + size_nat b <= n)%nat -> forall p, (p|a) -> (p|b) -> (p|gcdn n a b). Proof. intro n; induction n as [|n IHn]; intros a b. - destruct a, b; simpl; inversion 1. - destruct a as [a|a|], b as [b|b|]; simpl; try case compare_spec; simpl; auto. + (* Lt *) intros LT LE p Hp1 Hp2. apply IHn; clear IHn; trivial. * apply le_S_n in LE. eapply Nat.le_trans; [|eapply LE]. rewrite Nat.add_comm, <- plus_n_Sm, <- plus_Sn_m. apply Nat.add_le_mono; trivial. apply size_nat_monotone, sub_decr, LT. * apply divide_xO_xI with a; trivial. apply (divide_add_cancel_l p _ a~1); trivial. now rewrite <- sub_xI_xI, sub_add. + (* Gt *) intros LT LE p Hp1 Hp2. apply IHn; clear IHn; trivial. * apply le_S_n in LE. eapply Nat.le_trans; [|eapply LE]. apply Nat.add_le_mono; trivial. apply size_nat_monotone, sub_decr, LT. * apply divide_xO_xI with b; trivial. apply (divide_add_cancel_l p _ b~1); trivial. now rewrite <- sub_xI_xI, sub_add. + (* a~1 b~0 *) intros LE p Hp1 Hp2. apply IHn; clear IHn; trivial. * apply le_S_n in LE. simpl. now rewrite plus_n_Sm. * apply divide_xO_xI with a; trivial. + (* a~0 b~1 *) intros LE p Hp1 Hp2. apply IHn; clear IHn; trivial. * simpl. now apply le_S_n. * apply divide_xO_xI with b; trivial. + (* a~0 b~0 *) intros LE p Hp1 Hp2. destruct p as [p|p|]. * { change (gcdn n a b)~0 with (2*(gcdn n a b)). apply divide_mul_r. apply IHn; clear IHn. - apply le_S_n in LE. rewrite <- plus_n_Sm in LE. now apply Nat.lt_le_incl. - apply divide_xO_xI with p; trivial. now exists 1. - apply divide_xO_xI with p; trivial. now exists 1. } * { apply divide_xO_xO. apply IHn; clear IHn. - apply le_S_n in LE. rewrite <- plus_n_Sm in LE. now apply Nat.lt_le_incl. - now apply divide_xO_xO. - now apply divide_xO_xO. } * exists (gcdn n a b)~0. now rewrite mul_1_r. Qed. Lemma gcd_greatest : forall a b p, (p|a) -> (p|b) -> (p|gcd a b). Proof. intros. apply gcdn_greatest; auto. Qed. (** As a consequence, the rests after division by gcd are relatively prime *) Lemma ggcd_greatest : forall a b, let (aa,bb) := snd (ggcd a b) in forall p, (p|aa) -> (p|bb) -> p=1. Proof. intros a b **. generalize (gcd_greatest a b) (ggcd_correct_divisors a b). rewrite <- ggcd_gcd. destruct ggcd as (g,(aa,bb)); simpl. intros H (EQa,EQb) p Hp1 Hp2; subst. assert (H' : (g*p | g)). { apply H. - destruct Hp1 as (r,Hr). exists r. now rewrite mul_assoc, (mul_comm r g), <- mul_assoc, <- Hr. - destruct Hp2 as (r,Hr). exists r. now rewrite mul_assoc, (mul_comm r g), <- mul_assoc, <- Hr. } destruct H' as (q,H'). rewrite (mul_comm g p), mul_assoc in H'. apply mul_eq_1 with q; rewrite mul_comm. now apply mul_reg_r with g. Qed. End Pos. Bind Scope positive_scope with Pos.t positive. (** Exportation of notations *) Number Notation positive Pos.of_num_int Pos.to_num_uint : positive_scope. Infix "+" := Pos.add : positive_scope. Infix "-" := Pos.sub : positive_scope. Infix "*" := Pos.mul : positive_scope. Infix "^" := Pos.pow : positive_scope. Infix "?=" := Pos.compare (at level 70, no associativity) : positive_scope. Infix "=?" := Pos.eqb (at level 70, no associativity) : positive_scope. Infix "<=?" := Pos.leb (at level 70, no associativity) : positive_scope. Infix "=" := Pos.ge : positive_scope. Infix ">" := Pos.gt : positive_scope. Notation "x <= y <= z" := (x <= y /\ y <= z) : positive_scope. Notation "x <= y < z" := (x <= y /\ y < z) : positive_scope. Notation "x < y < z" := (x < y /\ y < z) : positive_scope. Notation "x < y <= z" := (x < y /\ y <= z) : positive_scope. Notation "( p | q )" := (Pos.divide p q) (at level 0) : positive_scope. (** Compatibility notations *) Notation positive := positive (only parsing). Notation positive_rect := positive_rect (only parsing). Notation positive_rec := positive_rec (only parsing). Notation positive_ind := positive_ind (only parsing). Notation xI := xI (only parsing). Notation xO := xO (only parsing). Notation xH := xH (only parsing). Notation IsNul := Pos.IsNul (only parsing). Notation IsPos := Pos.IsPos (only parsing). Notation IsNeg := Pos.IsNeg (only parsing). Notation Pplus := Pos.add (only parsing). Notation Pplus_carry := Pos.add_carry (only parsing). Notation Pmult_nat := (Pos.iter_op plus) (only parsing). Notation nat_of_P := Pos.to_nat (only parsing). Notation P_of_succ_nat := Pos.of_succ_nat (only parsing). Notation Pdouble_minus_one := Pos.pred_double (only parsing). Notation positive_mask := Pos.mask (only parsing). Notation positive_mask_rect := Pos.mask_rect (only parsing). Notation positive_mask_ind := Pos.mask_ind (only parsing). Notation positive_mask_rec := Pos.mask_rec (only parsing). Notation Pdouble_plus_one_mask := Pos.succ_double_mask (only parsing). Notation Pdouble_minus_two := Pos.double_pred_mask (only parsing). Notation Pminus_mask := Pos.sub_mask (only parsing). Notation Pminus_mask_carry := Pos.sub_mask_carry (only parsing). Notation Pminus := Pos.sub (only parsing). Notation Pmult := Pos.mul (only parsing). Notation iter_pos := @Pos.iter (only parsing). Notation Psize := Pos.size_nat (only parsing). Notation Psize_pos := Pos.size (only parsing). Notation Pcompare x y m := (Pos.compare_cont m x y) (only parsing). Notation positive_eq_dec := Pos.eq_dec (only parsing). Notation xI_succ_xO := Pos.xI_succ_xO (only parsing). Notation Psucc_o_double_minus_one_eq_xO := Pos.succ_pred_double (only parsing). Notation Pdouble_minus_one_o_succ_eq_xI := Pos.pred_double_succ (only parsing). Notation xO_succ_permute := Pos.double_succ (only parsing). Notation double_moins_un_xO_discr := Pos.pred_double_xO_discr (only parsing). Notation Psucc_not_one := Pos.succ_not_1 (only parsing). Notation Psucc_pred := Pos.succ_pred_or (only parsing). Notation Pplus_carry_spec := Pos.add_carry_spec (only parsing). Notation Pplus_comm := Pos.add_comm (only parsing). Notation Pplus_succ_permute_r := Pos.add_succ_r (only parsing). Notation Pplus_succ_permute_l := Pos.add_succ_l (only parsing). Notation Pplus_no_neutral := Pos.add_no_neutral (only parsing). Notation Pplus_carry_plus := Pos.add_carry_add (only parsing). Notation Pplus_reg_r := Pos.add_reg_r (only parsing). Notation Pplus_reg_l := Pos.add_reg_l (only parsing). Notation Pplus_carry_reg_r := Pos.add_carry_reg_r (only parsing). Notation Pplus_carry_reg_l := Pos.add_carry_reg_l (only parsing). Notation Pplus_assoc := Pos.add_assoc (only parsing). Notation Pplus_xO := Pos.add_xO (only parsing). Notation Pplus_xI_double_minus_one := Pos.add_xI_pred_double (only parsing). Notation Pplus_xO_double_minus_one := Pos.add_xO_pred_double (only parsing). Notation Pplus_diag := Pos.add_diag (only parsing). Notation PeanoView := Pos.PeanoView (only parsing). Notation PeanoOne := Pos.PeanoOne (only parsing). Notation PeanoSucc := Pos.PeanoSucc (only parsing). Notation PeanoView_rect := Pos.PeanoView_rect (only parsing). Notation PeanoView_ind := Pos.PeanoView_ind (only parsing). Notation PeanoView_rec := Pos.PeanoView_rec (only parsing). Notation peanoView_xO := Pos.peanoView_xO (only parsing). Notation peanoView_xI := Pos.peanoView_xI (only parsing). Notation peanoView := Pos.peanoView (only parsing). Notation PeanoView_iter := Pos.PeanoView_iter (only parsing). Notation eq_dep_eq_positive := Pos.eq_dep_eq_positive (only parsing). Notation PeanoViewUnique := Pos.PeanoViewUnique (only parsing). Notation Prect := Pos.peano_rect (only parsing). Notation Prect_succ := Pos.peano_rect_succ (only parsing). Notation Prect_base := Pos.peano_rect_base (only parsing). Notation Prec := Pos.peano_rec (only parsing). Notation Pind := Pos.peano_ind (only parsing). Notation Pcase := Pos.peano_case (only parsing). Notation Pmult_1_r := Pos.mul_1_r (only parsing). Notation Pmult_Sn_m := Pos.mul_succ_l (only parsing). Notation Pmult_xO_permute_r := Pos.mul_xO_r (only parsing). Notation Pmult_xI_permute_r := Pos.mul_xI_r (only parsing). Notation Pmult_comm := Pos.mul_comm (only parsing). Notation Pmult_plus_distr_l := Pos.mul_add_distr_l (only parsing). Notation Pmult_plus_distr_r := Pos.mul_add_distr_r (only parsing). Notation Pmult_assoc := Pos.mul_assoc (only parsing). Notation Pmult_xI_mult_xO_discr := Pos.mul_xI_mul_xO_discr (only parsing). Notation Pmult_xO_discr := Pos.mul_xO_discr (only parsing). Notation Pmult_reg_r := Pos.mul_reg_r (only parsing). Notation Pmult_reg_l := Pos.mul_reg_l (only parsing). Notation Pmult_1_inversion_l := Pos.mul_eq_1_l (only parsing). Notation iter_pos_swap_gen := Pos.iter_swap_gen (only parsing). Notation iter_pos_swap := Pos.iter_swap (only parsing). Notation iter_pos_succ := Pos.iter_succ (only parsing). Notation iter_pos_plus := Pos.iter_add (only parsing). Notation iter_pos_invariant := Pos.iter_invariant (only parsing). Notation Pcompare_refl_id := Pos.compare_cont_refl (only parsing). Notation Pcompare_eq_iff := Pos.compare_eq_iff (only parsing). Notation Pcompare_Gt_Lt := Pos.compare_cont_Gt_Lt (only parsing). Notation Pcompare_eq_Lt := Pos.compare_lt_iff (only parsing). Notation Pcompare_Lt_Gt := Pos.compare_cont_Lt_Gt (only parsing). Notation Pcompare_antisym := Pos.compare_cont_antisym (only parsing). Notation ZC1 := Pos.gt_lt (only parsing). Notation ZC2 := Pos.lt_gt (only parsing). Notation Pcompare_p_Sp := Pos.lt_succ_diag_r (only parsing). Notation Pcompare_1 := Pos.nlt_1_r (only parsing). Notation Plt_1 := Pos.nlt_1_r (only parsing). Notation Pplus_compare_mono_l := Pos.add_compare_mono_l (only parsing). Notation Pplus_compare_mono_r := Pos.add_compare_mono_r (only parsing). Notation Pplus_lt_mono_l := Pos.add_lt_mono_l (only parsing). Notation Pplus_lt_mono_r := Pos.add_lt_mono_r (only parsing). Notation Pplus_lt_mono := Pos.add_lt_mono (only parsing). Notation Pplus_le_mono_l := Pos.add_le_mono_l (only parsing). Notation Pplus_le_mono_r := Pos.add_le_mono_r (only parsing). Notation Pplus_le_mono := Pos.add_le_mono (only parsing). Notation Pmult_compare_mono_l := Pos.mul_compare_mono_l (only parsing). Notation Pmult_compare_mono_r := Pos.mul_compare_mono_r (only parsing). Notation Pmult_lt_mono_l := Pos.mul_lt_mono_l (only parsing). Notation Pmult_lt_mono_r := Pos.mul_lt_mono_r (only parsing). Notation Pmult_lt_mono := Pos.mul_lt_mono (only parsing). Notation Pmult_le_mono_l := Pos.mul_le_mono_l (only parsing). Notation Pmult_le_mono_r := Pos.mul_le_mono_r (only parsing). Notation Pmult_le_mono := Pos.mul_le_mono (only parsing). Notation Plt_plus_r := Pos.lt_add_r (only parsing). Notation Plt_not_plus_l := Pos.lt_not_add_l (only parsing). Notation Pminus_mask_succ_r := Pos.sub_mask_succ_r (only parsing). Notation Pminus_mask_carry_spec := Pos.sub_mask_carry_spec (only parsing). Notation Pminus_succ_r := Pos.sub_succ_r (only parsing). Notation Pminus_mask_diag := Pos.sub_mask_diag (only parsing). Notation Pplus_minus_eq := Pos.add_sub (only parsing). Notation Pmult_minus_distr_l := Pos.mul_sub_distr_l (only parsing). Notation Pminus_lt_mono_l := Pos.sub_lt_mono_l (only parsing). Notation Pminus_compare_mono_l := Pos.sub_compare_mono_l (only parsing). Notation Pminus_compare_mono_r := Pos.sub_compare_mono_r (only parsing). Notation Pminus_lt_mono_r := Pos.sub_lt_mono_r (only parsing). Notation Pminus_decr := Pos.sub_decr (only parsing). Notation Pminus_xI_xI := Pos.sub_xI_xI (only parsing). Notation Pplus_minus_assoc := Pos.add_sub_assoc (only parsing). Notation Pminus_plus_distr := Pos.sub_add_distr (only parsing). Notation Pminus_minus_distr := Pos.sub_sub_distr (only parsing). Notation Pminus_mask_Lt := Pos.sub_mask_neg (only parsing). Notation Pminus_Lt := Pos.sub_lt (only parsing). Notation Pminus_Eq := Pos.sub_diag (only parsing). Notation Psize_monotone := Pos.size_nat_monotone (only parsing). Notation Psize_pos_gt := Pos.size_gt (only parsing). Notation Psize_pos_le := Pos.size_le (only parsing). (** More complex compatibility facts, expressed as lemmas (to preserve scopes for instance) *) Lemma Peqb_true_eq x y : Pos.eqb x y = true -> x=y. Proof. apply Pos.eqb_eq. Qed. Lemma Pcompare_eq_Gt p q : (p ?= q) = Gt <-> p > q. Proof. reflexivity. Qed. Lemma Pplus_one_succ_r p : Pos.succ p = p + 1. Proof (eq_sym (Pos.add_1_r p)). Lemma Pplus_one_succ_l p : Pos.succ p = 1 + p. Proof (eq_sym (Pos.add_1_l p)). Lemma Pcompare_refl p : Pos.compare_cont Eq p p = Eq. Proof (Pos.compare_cont_refl p Eq). Lemma Pcompare_Eq_eq : forall p q, Pos.compare_cont Eq p q = Eq -> p = q. Proof Pos.compare_eq. Lemma ZC4 p q : Pos.compare_cont Eq p q = CompOpp (Pos.compare_cont Eq q p). Proof (Pos.compare_antisym q p). Lemma Ppred_minus p : Pos.pred p = p - 1. Proof (eq_sym (Pos.sub_1_r p)). Lemma Pminus_mask_Gt p q : p > q -> exists h : positive, Pos.sub_mask p q = IsPos h /\ q + h = p /\ (h = 1 \/ Pos.sub_mask_carry p q = IsPos (Pos.pred h)). Proof. intros H. apply Pos.gt_lt in H. destruct (Pos.sub_mask_pos p q H) as (r & U). exists r. repeat split; trivial. - now apply Pos.sub_mask_pos_iff. - destruct (Pos.eq_dec r 1) as [EQ|NE]; [now left|right]. rewrite Pos.sub_mask_carry_spec, U. destruct r; trivial. now elim NE. Qed. Lemma Pplus_minus : forall p q, p > q -> q+(p-q) = p. Proof. intros. rewrite Pos.add_comm. now apply Pos.sub_add, Pos.gt_lt. Qed. (** Discontinued results of little interest and little/zero use in user contributions: Pplus_carry_no_neutral Pplus_carry_pred_eq_plus Pcompare_not_Eq Pcompare_Lt_Lt Pcompare_Lt_eq_Lt Pcompare_Gt_Gt Pcompare_Gt_eq_Gt Psucc_lt_compat Psucc_le_compat ZC3 Pcompare_p_Sq Pminus_mask_carry_diag Pminus_mask_IsNeg ZL10 ZL11 double_eq_zero_inversion double_plus_one_zero_discr double_plus_one_eq_one_inversion double_eq_one_discr Infix "/" := Pdiv2 : positive_scope. *) (** Old stuff, to remove someday *) Lemma Dcompare : forall r:comparison, r = Eq \/ r = Lt \/ r = Gt. Proof. intro r; destruct r; auto. Qed. (** Incompatibilities : - [(_ ?= _)%positive] expects no arg now, and designates [Pos.compare] which is convertible but syntactically distinct to [Pos.compare_cont .. .. Eq]. - [Pmult_nat] cannot be unfolded (unfold [Pos.iter_op] instead). *) (** Re-export the notation for those who just [Import BinPos] *) Number Notation positive Pos.of_num_int Pos.to_num_hex_uint : hex_positive_scope. Number Notation positive Pos.of_num_int Pos.to_num_uint : positive_scope. coq-8.20.0/theories/PArith/BinPosDef.v000066400000000000000000000454441466560755400174310ustar00rootroot00000000000000(* -*- coding: utf-8 -*- *) (************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* (succ p)~0 | p~0 => p~1 | 1 => 1~0 end. (** ** Addition *) Fixpoint add x y := match x, y with | p~1, q~1 => (add_carry p q)~0 | p~1, q~0 => (add p q)~1 | p~1, 1 => (succ p)~0 | p~0, q~1 => (add p q)~1 | p~0, q~0 => (add p q)~0 | p~0, 1 => p~1 | 1, q~1 => (succ q)~0 | 1, q~0 => q~1 | 1, 1 => 1~0 end with add_carry x y := match x, y with | p~1, q~1 => (add_carry p q)~1 | p~1, q~0 => (add_carry p q)~0 | p~1, 1 => (succ p)~1 | p~0, q~1 => (add_carry p q)~0 | p~0, q~0 => (add p q)~1 | p~0, 1 => (succ p)~0 | 1, q~1 => (succ q)~1 | 1, q~0 => (succ q)~0 | 1, 1 => 1~1 end. Infix "+" := add : positive_scope. (** ** Operation [x -> 2*x-1] *) Fixpoint pred_double x := match x with | p~1 => p~0~1 | p~0 => (pred_double p)~1 | 1 => 1 end. (** ** Predecessor *) Definition pred x := match x with | p~1 => p~0 | p~0 => pred_double p | 1 => 1 end. (** ** The predecessor of a positive number can be seen as a [N] *) Definition pred_N x := match x with | p~1 => Npos (p~0) | p~0 => Npos (pred_double p) | 1 => N0 end. (** ** An auxiliary type for subtraction *) Inductive mask : Set := | IsNul : mask | IsPos : positive -> mask | IsNeg : mask. (** ** Operation [x -> 2*x+1] *) Definition succ_double_mask (x:mask) : mask := match x with | IsNul => IsPos 1 | IsNeg => IsNeg | IsPos p => IsPos p~1 end. (** ** Operation [x -> 2*x] *) Definition double_mask (x:mask) : mask := match x with | IsNul => IsNul | IsNeg => IsNeg | IsPos p => IsPos p~0 end. (** ** Operation [x -> 2*x-2] *) Definition double_pred_mask x : mask := match x with | p~1 => IsPos p~0~0 | p~0 => IsPos (pred_double p)~0 | 1 => IsNul end. (** ** Predecessor with mask *) Definition pred_mask (p : mask) : mask := match p with | IsPos 1 => IsNul | IsPos q => IsPos (pred q) | IsNul => IsNeg | IsNeg => IsNeg end. (** ** Subtraction, result as a mask *) Fixpoint sub_mask (x y:positive) {struct y} : mask := match x, y with | p~1, q~1 => double_mask (sub_mask p q) | p~1, q~0 => succ_double_mask (sub_mask p q) | p~1, 1 => IsPos p~0 | p~0, q~1 => succ_double_mask (sub_mask_carry p q) | p~0, q~0 => double_mask (sub_mask p q) | p~0, 1 => IsPos (pred_double p) | 1, 1 => IsNul | 1, _ => IsNeg end with sub_mask_carry (x y:positive) {struct y} : mask := match x, y with | p~1, q~1 => succ_double_mask (sub_mask_carry p q) | p~1, q~0 => double_mask (sub_mask p q) | p~1, 1 => IsPos (pred_double p) | p~0, q~1 => double_mask (sub_mask_carry p q) | p~0, q~0 => succ_double_mask (sub_mask_carry p q) | p~0, 1 => double_pred_mask p | 1, _ => IsNeg end. (** ** Subtraction, result as a positive, returning 1 if [x<=y] *) Definition sub x y := match sub_mask x y with | IsPos z => z | _ => 1 end. Infix "-" := sub : positive_scope. (** ** Multiplication *) Fixpoint mul x y := match x with | p~1 => y + (mul p y)~0 | p~0 => (mul p y)~0 | 1 => y end. Infix "*" := mul : positive_scope. (** ** Iteration over a positive number *) Definition iter {A} (f:A -> A) : A -> positive -> A := fix iter_fix x n := match n with | xH => f x | xO n' => iter_fix (iter_fix x n') n' | xI n' => f (iter_fix (iter_fix x n') n') end. (** ** Power *) Definition pow (x:positive) := iter (mul x) 1. Infix "^" := pow : positive_scope. (** ** Square *) Fixpoint square p := match p with | p~1 => (square p + p)~0~1 | p~0 => (square p)~0~0 | 1 => 1 end. (** ** Division by 2 rounded below but for 1 *) Definition div2 p := match p with | 1 => 1 | p~0 => p | p~1 => p end. (** Division by 2 rounded up *) Definition div2_up p := match p with | 1 => 1 | p~0 => p | p~1 => succ p end. (** ** Number of digits in a positive number *) Fixpoint size_nat p : nat := match p with | 1 => S O | p~1 => S (size_nat p) | p~0 => S (size_nat p) end. (** Same, with positive output *) Fixpoint size p := match p with | 1 => 1 | p~1 => succ (size p) | p~0 => succ (size p) end. (** ** Comparison on binary positive numbers *) Fixpoint compare_cont (r:comparison) (x y:positive) {struct y} : comparison := match x, y with | p~1, q~1 => compare_cont r p q | p~1, q~0 => compare_cont Gt p q | p~1, 1 => Gt | p~0, q~1 => compare_cont Lt p q | p~0, q~0 => compare_cont r p q | p~0, 1 => Gt | 1, q~1 => Lt | 1, q~0 => Lt | 1, 1 => r end. Definition compare := compare_cont Eq. Infix "?=" := compare (at level 70, no associativity) : positive_scope. Definition min p p' := match p ?= p' with | Lt | Eq => p | Gt => p' end. Definition max p p' := match p ?= p' with | Lt | Eq => p' | Gt => p end. (** ** Boolean equality and comparisons *) Fixpoint eqb p q {struct q} := match p, q with | p~1, q~1 => eqb p q | p~0, q~0 => eqb p q | 1, 1 => true | _, _ => false end. Definition leb x y := match x ?= y with Gt => false | _ => true end. Definition ltb x y := match x ?= y with Lt => true | _ => false end. Infix "=?" := eqb (at level 70, no associativity) : positive_scope. Infix "<=?" := leb (at level 70, no associativity) : positive_scope. Infix "positive) p := match p with | (s, IsPos r) => let s' := s~0~1 in let r' := g (f r) in if s' <=? r' then (s~1, sub_mask r' s') else (s~0, IsPos r') | (s,_) => (s~0, sub_mask (g (f 1)) 1~0~0) end. Fixpoint sqrtrem p : positive * mask := match p with | 1 => (1,IsNul) | 1~0 => (1,IsPos 1) | 1~1 => (1,IsPos 1~0) | p~0~0 => sqrtrem_step xO xO (sqrtrem p) | p~0~1 => sqrtrem_step xO xI (sqrtrem p) | p~1~0 => sqrtrem_step xI xO (sqrtrem p) | p~1~1 => sqrtrem_step xI xI (sqrtrem p) end. Definition sqrt p := fst (sqrtrem p). (** ** Greatest Common Divisor *) Definition divide p q := exists r, q = r*p. Notation "( p | q )" := (divide p q) (at level 0) : positive_scope. (** Instead of the Euclid algorithm, we use here the Stein binary algorithm, which is faster for this representation. This algorithm is almost structural, but in the last cases we do some recursive calls on subtraction, hence the need for a counter. *) Fixpoint gcdn (n : nat) (a b : positive) : positive := match n with | O => 1 | S n => match a,b with | 1, _ => 1 | _, 1 => 1 | a~0, b~0 => (gcdn n a b)~0 | _ , b~0 => gcdn n a b | a~0, _ => gcdn n a b | a'~1, b'~1 => match a' ?= b' with | Eq => a | Lt => gcdn n (b'-a') a | Gt => gcdn n (a'-b') b end end end. (** We'll show later that we need at most (log2(a.b)) loops *) Definition gcd (a b : positive) := gcdn (size_nat a + size_nat b)%nat a b. (** Generalized Gcd, also computing the division of a and b by the gcd *) Set Printing Universes. Fixpoint ggcdn (n : nat) (a b : positive) : (positive*(positive*positive)) := match n with | O => (1,(a,b)) | S n => match a,b with | 1, _ => (1,(1,b)) | _, 1 => (1,(a,1)) | a~0, b~0 => let (g,p) := ggcdn n a b in (g~0,p) | _, b~0 => let '(g,(aa,bb)) := ggcdn n a b in (g,(aa, bb~0)) | a~0, _ => let '(g,(aa,bb)) := ggcdn n a b in (g,(aa~0, bb)) | a'~1, b'~1 => match a' ?= b' with | Eq => (a,(1,1)) | Lt => let '(g,(ba,aa)) := ggcdn n (b'-a') a in (g,(aa, aa + ba~0)) | Gt => let '(g,(ab,bb)) := ggcdn n (a'-b') b in (g,(bb + ab~0, bb)) end end end. Definition ggcd (a b: positive) := ggcdn (size_nat a + size_nat b)%nat a b. (** Local copies of the not-yet-available [N.double] and [N.succ_double] *) Definition Nsucc_double x := match x with | N0 => Npos 1 | Npos p => Npos p~1 end. Definition Ndouble n := match n with | N0 => N0 | Npos p => Npos p~0 end. (** Operation over bits. *) (** Logical [or] *) Fixpoint lor (p q : positive) : positive := match p, q with | 1, q~0 => q~1 | 1, _ => q | p~0, 1 => p~1 | _, 1 => p | p~0, q~0 => (lor p q)~0 | p~0, q~1 => (lor p q)~1 | p~1, q~0 => (lor p q)~1 | p~1, q~1 => (lor p q)~1 end. (** Logical [and] *) Fixpoint land (p q : positive) : N := match p, q with | 1, q~0 => N0 | 1, _ => Npos 1 | p~0, 1 => N0 | _, 1 => Npos 1 | p~0, q~0 => Ndouble (land p q) | p~0, q~1 => Ndouble (land p q) | p~1, q~0 => Ndouble (land p q) | p~1, q~1 => Nsucc_double (land p q) end. (** Logical [diff] *) Fixpoint ldiff (p q:positive) : N := match p, q with | 1, q~0 => Npos 1 | 1, _ => N0 | _~0, 1 => Npos p | p~1, 1 => Npos (p~0) | p~0, q~0 => Ndouble (ldiff p q) | p~0, q~1 => Ndouble (ldiff p q) | p~1, q~1 => Ndouble (ldiff p q) | p~1, q~0 => Nsucc_double (ldiff p q) end. (** [xor] *) Fixpoint lxor (p q:positive) : N := match p, q with | 1, 1 => N0 | 1, q~0 => Npos (q~1) | 1, q~1 => Npos (q~0) | p~0, 1 => Npos (p~1) | p~0, q~0 => Ndouble (lxor p q) | p~0, q~1 => Nsucc_double (lxor p q) | p~1, 1 => Npos (p~0) | p~1, q~0 => Nsucc_double (lxor p q) | p~1, q~1 => Ndouble (lxor p q) end. (** Shifts. NB: right shift of 1 stays at 1. *) Definition shiftl_nat (p:positive) := nat_rect _ p (fun _ => xO). Definition shiftr_nat (p:positive) := nat_rect _ p (fun _ => div2). Definition shiftl (p:positive)(n:N) := match n with | N0 => p | Npos n => iter xO p n end. Definition shiftr (p:positive)(n:N) := match n with | N0 => p | Npos n => iter div2 p n end. (** Checking whether a particular bit is set or not *) Fixpoint testbit_nat (p:positive) : nat -> bool := match p with | 1 => fun n => match n with | O => true | S _ => false end | p~0 => fun n => match n with | O => false | S n' => testbit_nat p n' end | p~1 => fun n => match n with | O => true | S n' => testbit_nat p n' end end. (** Same, but with index in N *) Fixpoint testbit (p:positive)(n:N) := match p, n with | p~0, N0 => false | _, N0 => true | 1, _ => false | p~0, Npos n => testbit p (pred_N n) | p~1, Npos n => testbit p (pred_N n) end. (** ** From binary positive numbers to Peano natural numbers *) Definition iter_op {A}(op:A->A->A) := fix iter (p:positive)(a:A) : A := match p with | 1 => a | p~0 => iter p (op a a) | p~1 => op a (iter p (op a a)) end. Definition to_nat (x:positive) : nat := iter_op plus x (S O). Arguments to_nat x: simpl never. (** ** From Peano natural numbers to binary positive numbers *) (** A version preserving positive numbers, and sending 0 to 1. *) Fixpoint of_nat (n:nat) : positive := match n with | O => 1 | S O => 1 | S x => succ (of_nat x) end. (* Another version that converts [n] into [n+1] *) Fixpoint of_succ_nat (n:nat) : positive := match n with | O => 1 | S x => succ (of_succ_nat x) end. (** ** Conversion with a decimal representation for printing/parsing *) Local Notation ten := 1~0~1~0. Fixpoint of_uint_acc (d:Decimal.uint)(acc:positive) := match d with | Decimal.Nil => acc | Decimal.D0 l => of_uint_acc l (mul ten acc) | Decimal.D1 l => of_uint_acc l (add 1 (mul ten acc)) | Decimal.D2 l => of_uint_acc l (add 1~0 (mul ten acc)) | Decimal.D3 l => of_uint_acc l (add 1~1 (mul ten acc)) | Decimal.D4 l => of_uint_acc l (add 1~0~0 (mul ten acc)) | Decimal.D5 l => of_uint_acc l (add 1~0~1 (mul ten acc)) | Decimal.D6 l => of_uint_acc l (add 1~1~0 (mul ten acc)) | Decimal.D7 l => of_uint_acc l (add 1~1~1 (mul ten acc)) | Decimal.D8 l => of_uint_acc l (add 1~0~0~0 (mul ten acc)) | Decimal.D9 l => of_uint_acc l (add 1~0~0~1 (mul ten acc)) end. Fixpoint of_uint (d:Decimal.uint) : N := match d with | Decimal.Nil => N0 | Decimal.D0 l => of_uint l | Decimal.D1 l => Npos (of_uint_acc l 1) | Decimal.D2 l => Npos (of_uint_acc l 1~0) | Decimal.D3 l => Npos (of_uint_acc l 1~1) | Decimal.D4 l => Npos (of_uint_acc l 1~0~0) | Decimal.D5 l => Npos (of_uint_acc l 1~0~1) | Decimal.D6 l => Npos (of_uint_acc l 1~1~0) | Decimal.D7 l => Npos (of_uint_acc l 1~1~1) | Decimal.D8 l => Npos (of_uint_acc l 1~0~0~0) | Decimal.D9 l => Npos (of_uint_acc l 1~0~0~1) end. Local Notation sixteen := 1~0~0~0~0. Fixpoint of_hex_uint_acc (d:Hexadecimal.uint)(acc:positive) := match d with | Hexadecimal.Nil => acc | Hexadecimal.D0 l => of_hex_uint_acc l (mul sixteen acc) | Hexadecimal.D1 l => of_hex_uint_acc l (add 1 (mul sixteen acc)) | Hexadecimal.D2 l => of_hex_uint_acc l (add 1~0 (mul sixteen acc)) | Hexadecimal.D3 l => of_hex_uint_acc l (add 1~1 (mul sixteen acc)) | Hexadecimal.D4 l => of_hex_uint_acc l (add 1~0~0 (mul sixteen acc)) | Hexadecimal.D5 l => of_hex_uint_acc l (add 1~0~1 (mul sixteen acc)) | Hexadecimal.D6 l => of_hex_uint_acc l (add 1~1~0 (mul sixteen acc)) | Hexadecimal.D7 l => of_hex_uint_acc l (add 1~1~1 (mul sixteen acc)) | Hexadecimal.D8 l => of_hex_uint_acc l (add 1~0~0~0 (mul sixteen acc)) | Hexadecimal.D9 l => of_hex_uint_acc l (add 1~0~0~1 (mul sixteen acc)) | Hexadecimal.Da l => of_hex_uint_acc l (add 1~0~1~0 (mul sixteen acc)) | Hexadecimal.Db l => of_hex_uint_acc l (add 1~0~1~1 (mul sixteen acc)) | Hexadecimal.Dc l => of_hex_uint_acc l (add 1~1~0~0 (mul sixteen acc)) | Hexadecimal.Dd l => of_hex_uint_acc l (add 1~1~0~1 (mul sixteen acc)) | Hexadecimal.De l => of_hex_uint_acc l (add 1~1~1~0 (mul sixteen acc)) | Hexadecimal.Df l => of_hex_uint_acc l (add 1~1~1~1 (mul sixteen acc)) end. Fixpoint of_hex_uint (d:Hexadecimal.uint) : N := match d with | Hexadecimal.Nil => N0 | Hexadecimal.D0 l => of_hex_uint l | Hexadecimal.D1 l => Npos (of_hex_uint_acc l 1) | Hexadecimal.D2 l => Npos (of_hex_uint_acc l 1~0) | Hexadecimal.D3 l => Npos (of_hex_uint_acc l 1~1) | Hexadecimal.D4 l => Npos (of_hex_uint_acc l 1~0~0) | Hexadecimal.D5 l => Npos (of_hex_uint_acc l 1~0~1) | Hexadecimal.D6 l => Npos (of_hex_uint_acc l 1~1~0) | Hexadecimal.D7 l => Npos (of_hex_uint_acc l 1~1~1) | Hexadecimal.D8 l => Npos (of_hex_uint_acc l 1~0~0~0) | Hexadecimal.D9 l => Npos (of_hex_uint_acc l 1~0~0~1) | Hexadecimal.Da l => Npos (of_hex_uint_acc l 1~0~1~0) | Hexadecimal.Db l => Npos (of_hex_uint_acc l 1~0~1~1) | Hexadecimal.Dc l => Npos (of_hex_uint_acc l 1~1~0~0) | Hexadecimal.Dd l => Npos (of_hex_uint_acc l 1~1~0~1) | Hexadecimal.De l => Npos (of_hex_uint_acc l 1~1~1~0) | Hexadecimal.Df l => Npos (of_hex_uint_acc l 1~1~1~1) end. Definition of_num_uint (d:Number.uint) : N := match d with | Number.UIntDecimal d => of_uint d | Number.UIntHexadecimal d => of_hex_uint d end. Definition of_int (d:Decimal.int) : option positive := match d with | Decimal.Pos d => match of_uint d with | N0 => None | Npos p => Some p end | Decimal.Neg _ => None end. Definition of_hex_int (d:Hexadecimal.int) : option positive := match d with | Hexadecimal.Pos d => match of_hex_uint d with | N0 => None | Npos p => Some p end | Hexadecimal.Neg _ => None end. Definition of_num_int (d:Number.int) : option positive := match d with | Number.IntDecimal d => of_int d | Number.IntHexadecimal d => of_hex_int d end. Fixpoint to_little_uint p := match p with | 1 => Decimal.D1 Decimal.Nil | p~1 => Decimal.Little.succ_double (to_little_uint p) | p~0 => Decimal.Little.double (to_little_uint p) end. Definition to_uint p := Decimal.rev (to_little_uint p). Fixpoint to_little_hex_uint p := match p with | 1 => Hexadecimal.D1 Hexadecimal.Nil | p~1 => Hexadecimal.Little.succ_double (to_little_hex_uint p) | p~0 => Hexadecimal.Little.double (to_little_hex_uint p) end. Definition to_hex_uint p := Hexadecimal.rev (to_little_hex_uint p). Definition to_num_uint p := Number.UIntDecimal (to_uint p). Definition to_num_hex_uint n := Number.UIntHexadecimal (to_hex_uint n). Definition to_int n := Decimal.Pos (to_uint n). Definition to_hex_int p := Hexadecimal.Pos (to_hex_uint p). Definition to_num_int n := Number.IntDecimal (to_int n). Definition to_num_hex_int n := Number.IntHexadecimal (to_hex_int n). Number Notation positive of_num_int to_num_hex_uint : hex_positive_scope. Number Notation positive of_num_int to_num_uint : positive_scope. End Pos. (** Re-export the notation for those who just [Import BinPosDef] *) Number Notation positive Pos.of_num_int Pos.to_num_hex_uint : hex_positive_scope. Number Notation positive Pos.of_num_int Pos.to_num_uint : positive_scope. coq-8.20.0/theories/PArith/PArith.v000066400000000000000000000014021466560755400167710ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* y<=x -> x=y]. *) coq-8.20.0/theories/PArith/Pnat.v000066400000000000000000000366561466560755400165270ustar00rootroot00000000000000(* -*- coding: utf-8 -*- *) (************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* ). apply Nat.lt_0_succ. Qed. (** [Pos.to_nat] is a bijection between [positive] and non-zero [nat], with [Pos.of_nat] as reciprocal. See [Nat2Pos.id] below for the dual equation. *) Theorem id p : of_nat (to_nat p) = p. Proof. induction p as [|p IHp] using peano_ind. - trivial. - rewrite inj_succ. rewrite <- IHp at 2. now destruct (is_succ p) as (n,->). Qed. (** [Pos.to_nat] is hence injective *) Lemma inj p q : to_nat p = to_nat q -> p = q. Proof. intros H. now rewrite <- (id p), <- (id q), H. Qed. Lemma inj_iff p q : to_nat p = to_nat q <-> p = q. Proof. split. - apply inj. - intros; now subst. Qed. (** [Pos.to_nat] is a morphism for comparison *) Lemma inj_compare p q : (p ?= q)%positive = (to_nat p ?= to_nat q). Proof. revert q. induction p as [ |p IH] using peano_ind; intros q. - destruct (succ_pred_or q) as [Hq|Hq]; [now subst|]. rewrite <- Hq, lt_1_succ, inj_succ, inj_1, Nat.compare_succ. symmetry. apply Nat.compare_lt_iff, is_pos. - destruct (succ_pred_or q) as [Hq|Hq]; [subst|]. + rewrite compare_antisym, lt_1_succ, inj_succ. simpl. symmetry. apply Nat.compare_gt_iff, is_pos. + now rewrite <- Hq, 2 inj_succ, compare_succ_succ, IH. Qed. (** [Pos.to_nat] is a morphism for [lt], [le], etc *) Lemma inj_lt p q : (p < q)%positive <-> to_nat p < to_nat q. Proof. unfold lt. now rewrite inj_compare, Nat.compare_lt_iff. Qed. Lemma inj_le p q : (p <= q)%positive <-> to_nat p <= to_nat q. Proof. unfold le. now rewrite inj_compare, Nat.compare_le_iff. Qed. Lemma inj_gt p q : (p > q)%positive <-> to_nat p > to_nat q. Proof. unfold gt. now rewrite inj_compare, Nat.compare_gt_iff. Qed. Lemma inj_ge p q : (p >= q)%positive <-> to_nat p >= to_nat q. Proof. unfold ge. now rewrite inj_compare, Nat.compare_ge_iff. Qed. (** [Pos.to_nat] is a morphism for subtraction *) Theorem inj_sub p q : (q < p)%positive -> to_nat (p - q) = to_nat p - to_nat q. Proof. intro H. apply Nat.add_cancel_r with (to_nat q). rewrite Nat.sub_add. - now rewrite <- inj_add, sub_add. - now apply Nat.lt_le_incl, inj_lt. Qed. Theorem inj_sub_max p q : to_nat (p - q) = Nat.max 1 (to_nat p - to_nat q). Proof. destruct (ltb_spec q p) as [H|H]. - (* q < p *) rewrite <- inj_sub by trivial. now destruct (is_succ (p - q)) as (m,->). - (* p <= q *) rewrite sub_le by trivial. apply inj_le, Nat.sub_0_le in H. now rewrite H. Qed. Theorem inj_pred p : (1 < p)%positive -> to_nat (pred p) = Nat.pred (to_nat p). Proof. intros. now rewrite <- Pos.sub_1_r, inj_sub, Nat.sub_1_r. Qed. Theorem inj_pred_max p : to_nat (pred p) = Nat.max 1 (Peano.pred (to_nat p)). Proof. rewrite <- Pos.sub_1_r, <- Nat.sub_1_r. apply inj_sub_max. Qed. (** [Pos.to_nat] and other operations *) Lemma inj_min p q : to_nat (min p q) = Nat.min (to_nat p) (to_nat q). Proof. unfold min. rewrite inj_compare. case Nat.compare_spec; intros H; symmetry. - apply Nat.min_l. now rewrite H. - now apply Nat.min_l, Nat.lt_le_incl. - now apply Nat.min_r, Nat.lt_le_incl. Qed. Lemma inj_max p q : to_nat (max p q) = Nat.max (to_nat p) (to_nat q). Proof. unfold max. rewrite inj_compare. case Nat.compare_spec; intros H; symmetry. - apply Nat.max_r. now rewrite H. - now apply Nat.max_r, Nat.lt_le_incl. - now apply Nat.max_l, Nat.lt_le_incl. Qed. Theorem inj_iter p {A} (f:A->A) (x:A) : Pos.iter f x p = nat_rect _ x (fun _ => f) (to_nat p). Proof. induction p as [|p IHp] using peano_ind. - trivial. - intros. rewrite inj_succ, iter_succ. simpl. f_equal. apply IHp. Qed. Theorem inj_pow p q : to_nat (p ^ q) = to_nat p ^ to_nat q. Proof. induction q as [|q IHq] using peano_ind. - now rewrite Pos.pow_1_r, inj_1, Nat.pow_1_r. - unfold Pos.pow. rewrite inj_succ, iter_succ, inj_mul. fold (Pos.pow p q). now rewrite IHq. Qed. End Pos2Nat. Module Nat2Pos. (** [Pos.of_nat] is a bijection between non-zero [nat] and [positive], with [Pos.to_nat] as reciprocal. See [Pos2Nat.id] above for the dual equation. *) Theorem id (n:nat) : n<>0 -> Pos.to_nat (Pos.of_nat n) = n. Proof. induction n as [|n H]; trivial. - now destruct 1. - intros _. simpl Pos.of_nat. destruct n. + trivial. + rewrite Pos2Nat.inj_succ. f_equal. now apply H. Qed. Theorem id_max (n:nat) : Pos.to_nat (Pos.of_nat n) = max 1 n. Proof. destruct n. - trivial. - now rewrite id. Qed. (** [Pos.of_nat] is hence injective for non-zero numbers *) Lemma inj (n m : nat) : n<>0 -> m<>0 -> Pos.of_nat n = Pos.of_nat m -> n = m. Proof. intros Hn Hm H. now rewrite <- (id n), <- (id m), H. Qed. Lemma inj_iff (n m : nat) : n<>0 -> m<>0 -> (Pos.of_nat n = Pos.of_nat m <-> n = m). Proof. split. - now apply inj. - intros; now subst. Qed. (** Usual operations are morphisms with respect to [Pos.of_nat] for non-zero numbers. *) Lemma inj_0 : Pos.of_nat 0 = 1%positive. Proof. reflexivity. Qed. Lemma inj_succ (n:nat) : n<>0 -> Pos.of_nat (S n) = Pos.succ (Pos.of_nat n). Proof. intro H. apply Pos2Nat.inj. now rewrite Pos2Nat.inj_succ, !id. Qed. Lemma inj_pred (n:nat) : Pos.of_nat (pred n) = Pos.pred (Pos.of_nat n). Proof. destruct n as [|[|n]]; trivial. simpl. now rewrite Pos.pred_succ. Qed. Lemma inj_add (n m : nat) : n<>0 -> m<>0 -> Pos.of_nat (n+m) = (Pos.of_nat n + Pos.of_nat m)%positive. Proof. intros Hn Hm. apply Pos2Nat.inj. rewrite Pos2Nat.inj_add, !id; trivial. intros H. destruct n. - now destruct Hn. - now simpl in H. Qed. Lemma inj_mul (n m : nat) : n<>0 -> m<>0 -> Pos.of_nat (n*m) = (Pos.of_nat n * Pos.of_nat m)%positive. Proof. intros Hn Hm. apply Pos2Nat.inj. rewrite Pos2Nat.inj_mul, !id; trivial. intros H. apply Nat.mul_eq_0 in H. destruct H. - now elim Hn. - now elim Hm. Qed. Lemma inj_compare (n m : nat) : n<>0 -> m<>0 -> (n ?= m) = (Pos.of_nat n ?= Pos.of_nat m)%positive. Proof. intros Hn Hm. rewrite Pos2Nat.inj_compare, !id; trivial. Qed. Lemma inj_sub (n m : nat) : m<>0 -> Pos.of_nat (n-m) = (Pos.of_nat n - Pos.of_nat m)%positive. Proof. intros Hm. apply Pos2Nat.inj. rewrite Pos2Nat.inj_sub_max. rewrite (id m) by trivial. rewrite !id_max. destruct n, m; trivial. Qed. Lemma inj_min (n m : nat) : Pos.of_nat (min n m) = Pos.min (Pos.of_nat n) (Pos.of_nat m). Proof. destruct n as [|n]. { simpl. symmetry. apply Pos.min_l, Pos.le_1_l. } destruct m as [|m]. { simpl. symmetry. apply Pos.min_r, Pos.le_1_l. } unfold Pos.min. rewrite <- inj_compare by easy. case Nat.compare_spec; intros H; f_equal; apply Nat.min_l || apply Nat.min_r. - rewrite H; auto. - now apply Nat.lt_le_incl. - now apply Nat.lt_le_incl. Qed. Lemma inj_max (n m : nat) : Pos.of_nat (max n m) = Pos.max (Pos.of_nat n) (Pos.of_nat m). Proof. destruct n as [|n]. { simpl. symmetry. apply Pos.max_r, Pos.le_1_l. } destruct m as [|m]. { simpl. symmetry. apply Pos.max_l, Pos.le_1_l. } unfold Pos.max. rewrite <- inj_compare by easy. case Nat.compare_spec; intros H; f_equal; apply Nat.max_l || apply Nat.max_r. - rewrite H; auto. - now apply Nat.lt_le_incl. - now apply Nat.lt_le_incl. Qed. Theorem inj_pow (n m : nat) : m <> 0 -> Pos.of_nat (n^m) = (Pos.of_nat n ^ Pos.of_nat m)%positive. Proof. intros Hm. apply Pos2Nat.inj. rewrite Pos2Nat.inj_pow. destruct n. - now rewrite Nat.pow_0_l, inj_0, Pos2Nat.inj_1, Nat.pow_1_l. - now rewrite !id; [..|apply Nat.pow_nonzero]. Qed. End Nat2Pos. (**********************************************************************) (** Properties of the shifted injection from Peano natural numbers to binary positive numbers *) Module Pos2SuccNat. (** Composition of [Pos.to_nat] and [Pos.of_succ_nat] is successor on [positive] *) Theorem id_succ p : Pos.of_succ_nat (Pos.to_nat p) = Pos.succ p. Proof. rewrite Pos.of_nat_succ, <- Pos2Nat.inj_succ. apply Pos2Nat.id. Qed. (** Composition of [Pos.to_nat], [Pos.of_succ_nat] and [Pos.pred] is identity on [positive] *) Theorem pred_id p : Pos.pred (Pos.of_succ_nat (Pos.to_nat p)) = p. Proof. now rewrite id_succ, Pos.pred_succ. Qed. End Pos2SuccNat. Module SuccNat2Pos. (** Composition of [Pos.of_succ_nat] and [Pos.to_nat] is successor on [nat] *) Theorem id_succ (n:nat) : Pos.to_nat (Pos.of_succ_nat n) = S n. Proof. rewrite Pos.of_nat_succ. now apply Nat2Pos.id. Qed. Theorem pred_id (n:nat) : pred (Pos.to_nat (Pos.of_succ_nat n)) = n. Proof. now rewrite id_succ. Qed. (** [Pos.of_succ_nat] is hence injective *) Lemma inj (n m : nat) : Pos.of_succ_nat n = Pos.of_succ_nat m -> n = m. Proof. intro H. apply (f_equal Pos.to_nat) in H. rewrite !id_succ in H. now injection H. Qed. Lemma inj_iff (n m : nat) : Pos.of_succ_nat n = Pos.of_succ_nat m <-> n = m. Proof. split. - apply inj. - intros; now subst. Qed. (** Another formulation *) Theorem inv n p : Pos.to_nat p = S n -> Pos.of_succ_nat n = p. Proof. intros H. apply Pos2Nat.inj. now rewrite id_succ. Qed. (** Successor and comparison are morphisms with respect to [Pos.of_succ_nat] *) Lemma inj_succ n : Pos.of_succ_nat (S n) = Pos.succ (Pos.of_succ_nat n). Proof. apply Pos2Nat.inj. now rewrite Pos2Nat.inj_succ, !id_succ. Qed. Lemma inj_compare n m : (n ?= m) = (Pos.of_succ_nat n ?= Pos.of_succ_nat m)%positive. Proof. rewrite Pos2Nat.inj_compare, !id_succ; trivial. Qed. (** Other operations, for instance [Pos.add] and [plus] aren't directly related this way (we would need to compensate for the successor hidden in [Pos.of_succ_nat] *) End SuccNat2Pos. (** For compatibility, old names and old-style lemmas *) Notation Psucc_S := Pos2Nat.inj_succ (only parsing). Notation Pplus_plus := Pos2Nat.inj_add (only parsing). Notation Pmult_mult := Pos2Nat.inj_mul (only parsing). Notation Pcompare_nat_compare := Pos2Nat.inj_compare (only parsing). Notation nat_of_P_xH := Pos2Nat.inj_1 (only parsing). Notation nat_of_P_xO := Pos2Nat.inj_xO (only parsing). Notation nat_of_P_xI := Pos2Nat.inj_xI (only parsing). Notation nat_of_P_is_S := Pos2Nat.is_succ (only parsing). Notation nat_of_P_pos := Pos2Nat.is_pos (only parsing). Notation nat_of_P_inj_iff := Pos2Nat.inj_iff (only parsing). Notation nat_of_P_inj := Pos2Nat.inj (only parsing). Notation Plt_lt := Pos2Nat.inj_lt (only parsing). Notation Pgt_gt := Pos2Nat.inj_gt (only parsing). Notation Ple_le := Pos2Nat.inj_le (only parsing). Notation Pge_ge := Pos2Nat.inj_ge (only parsing). Notation Pminus_minus := Pos2Nat.inj_sub (only parsing). Notation iter_nat_of_P := @Pos2Nat.inj_iter (only parsing). Notation nat_of_P_of_succ_nat := SuccNat2Pos.id_succ (only parsing). Notation P_of_succ_nat_of_P := Pos2SuccNat.id_succ (only parsing). Notation nat_of_P_succ_morphism := Pos2Nat.inj_succ (only parsing). Notation nat_of_P_plus_morphism := Pos2Nat.inj_add (only parsing). Notation nat_of_P_mult_morphism := Pos2Nat.inj_mul (only parsing). Notation nat_of_P_compare_morphism := Pos2Nat.inj_compare (only parsing). Notation lt_O_nat_of_P := Pos2Nat.is_pos (only parsing). Notation ZL4 := Pos2Nat.is_succ (only parsing). Notation nat_of_P_o_P_of_succ_nat_eq_succ := SuccNat2Pos.id_succ (only parsing). Notation P_of_succ_nat_o_nat_of_P_eq_succ := Pos2SuccNat.id_succ (only parsing). Notation pred_o_P_of_succ_nat_o_nat_of_P_eq_id := Pos2SuccNat.pred_id (only parsing). Lemma nat_of_P_minus_morphism p q : Pos.compare_cont Eq p q = Gt -> Pos.to_nat (p - q) = Pos.to_nat p - Pos.to_nat q. Proof (fun H => Pos2Nat.inj_sub p q (Pos.gt_lt _ _ H)). Lemma nat_of_P_lt_Lt_compare_morphism p q : Pos.compare_cont Eq p q = Lt -> Pos.to_nat p < Pos.to_nat q. Proof (proj1 (Pos2Nat.inj_lt p q)). Lemma nat_of_P_gt_Gt_compare_morphism p q : Pos.compare_cont Eq p q = Gt -> Pos.to_nat p > Pos.to_nat q. Proof (proj1 (Pos2Nat.inj_gt p q)). Lemma nat_of_P_lt_Lt_compare_complement_morphism p q : Pos.to_nat p < Pos.to_nat q -> Pos.compare_cont Eq p q = Lt. Proof (proj2 (Pos2Nat.inj_lt p q)). Definition nat_of_P_gt_Gt_compare_complement_morphism p q : Pos.to_nat p > Pos.to_nat q -> Pos.compare_cont Eq p q = Gt. Proof (proj2 (Pos2Nat.inj_gt p q)). (** Old intermediate results about [Pmult_nat] *) Section ObsoletePmultNat. Lemma Pmult_nat_mult : forall p n, Pmult_nat p n = Pos.to_nat p * n. Proof. intro p; induction p as [p IHp|p IHp|]; intros n; unfold Pos.to_nat; simpl. - f_equal. rewrite 2 IHp. rewrite <- Nat.mul_assoc. f_equal. simpl. now rewrite Nat.add_0_r. - rewrite 2 IHp. rewrite <- Nat.mul_assoc. f_equal. simpl. now rewrite Nat.add_0_r. - simpl. now rewrite Nat.add_0_r. Qed. Lemma Pmult_nat_succ_morphism : forall p n, Pmult_nat (Pos.succ p) n = n + Pmult_nat p n. Proof. intros. now rewrite !Pmult_nat_mult, Pos2Nat.inj_succ. Qed. Theorem Pmult_nat_l_plus_morphism : forall p q n, Pmult_nat (p + q) n = Pmult_nat p n + Pmult_nat q n. Proof. intros. rewrite !Pmult_nat_mult, Pos2Nat.inj_add. apply Nat.mul_add_distr_r. Qed. Theorem Pmult_nat_plus_carry_morphism : forall p q n, Pmult_nat (Pos.add_carry p q) n = n + Pmult_nat (p + q) n. Proof. intros. now rewrite Pos.add_carry_spec, Pmult_nat_succ_morphism. Qed. Lemma Pmult_nat_r_plus_morphism : forall p n, Pmult_nat p (n + n) = Pmult_nat p n + Pmult_nat p n. Proof. intros. rewrite !Pmult_nat_mult. apply Nat.mul_add_distr_l. Qed. Lemma ZL6 : forall p, Pmult_nat p 2 = Pos.to_nat p + Pos.to_nat p. Proof. intros. rewrite Pmult_nat_mult, Nat.mul_comm. simpl. now rewrite Nat.add_0_r. Qed. Lemma le_Pmult_nat : forall p n, n <= Pmult_nat p n. Proof. intros p n. rewrite Pmult_nat_mult. apply Nat.le_trans with (1*n). - now rewrite Nat.mul_1_l. - apply Nat.mul_le_mono_r. apply Pos2Nat.is_pos. Qed. End ObsoletePmultNat. coq-8.20.0/theories/Program/000077500000000000000000000000001466560755400156365ustar00rootroot00000000000000coq-8.20.0/theories/Program/Basics.v000066400000000000000000000036041466560755400172340ustar00rootroot00000000000000(* -*- coding: utf-8 -*- *) (************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* C) (f : A -> B) := fun x : A => g (f x). #[global] Hint Unfold compose : core. Declare Scope program_scope. Notation " g ∘ f " := (compose g f) (at level 40, left associativity) : program_scope. Local Open Scope program_scope. (** The non-dependent function space between [A] and [B]. *) Definition arrow (A B : Type) := A -> B. Register arrow as core.arrow. (** Logical implication. *) Definition impl (A B : Prop) : Prop := A -> B. Register impl as core.impl. (** The constant function [const a] always returns [a]. *) Definition const {A B} (a : A) := fun _ : B => a. (** The [flip] combinator reverses the first two arguments of a function. *) Definition flip {A B C} (f : A -> B -> C) x y := f y x. Register flip as core.flip. (** Application as a combinator. *) Definition apply {A B} (f : A -> B) (x : A) := f x. coq-8.20.0/theories/Program/Combinators.v000066400000000000000000000037171466560755400203150ustar00rootroot00000000000000(* -*- coding: utf-8 -*- *) (************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* B), id ∘ f = f. Proof. intros. reflexivity. Qed. Lemma compose_id_right : forall A B (f : A -> B), f ∘ id = f. Proof. intros. reflexivity. Qed. Lemma compose_assoc : forall A B C D (f : A -> B) (g : B -> C) (h : C -> D), h ∘ g ∘ f = h ∘ (g ∘ f). Proof. intros. reflexivity. Qed. Global Hint Rewrite @compose_id_left @compose_id_right : core. Global Hint Rewrite <- @compose_assoc : core. (** [flip] is involutive. *) Lemma flip_flip : forall A B C, @flip A B C ∘ flip = id. Proof. intros. reflexivity. Qed. (** [uncurry] and [curry] are each others inverses. *) Lemma curry_uncurry : forall A B C, @curry A B C ∘ uncurry = id. Proof. intros. reflexivity. Qed. Lemma uncurry_curry : forall A B C, @uncurry A B C ∘ curry = id. Proof. simpl ; intros. unfold curry, uncurry, compose. extensionality x ; extensionality p. destruct p ; simpl ; reflexivity. Qed. coq-8.20.0/theories/Program/Equality.v000066400000000000000000000413411466560755400176250ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* is_ground T end. (** Try to find a contradiction. *) #[global] Hint Extern 10 => is_ground_goal ; progress exfalso : exfalso. (** We will use the [block] definition to separate the goal from the equalities generated by the tactic. *) Definition block {A : Type} (a : A) := a. Ltac block_goal := match goal with [ |- ?T ] => change (block T) end. Ltac unblock_goal := unfold block in *. (** Notation for heterogeneous equality. *) #[deprecated(since="8.17")] Notation " x ~= y " := (@JMeq _ x _ y) (at level 70, no associativity). (** Do something on an heterogeneous equality appearing in the context. *) Ltac on_JMeq tac := match goal with | [ H : @JMeq ?x ?X ?y ?Y |- _ ] => tac H end. (** Try to apply [JMeq_eq] to get back a regular equality when the two types are equal. *) Ltac simpl_one_JMeq := on_JMeq ltac:(fun H => apply JMeq_eq in H). (** Repeat it for every possible hypothesis. *) Ltac simpl_JMeq := repeat simpl_one_JMeq. (** Just simplify an h.eq. without clearing it. *) Ltac simpl_one_dep_JMeq := on_JMeq ltac:(fun H => let H' := fresh "H" in assert (H' := JMeq_eq H)). Require Import Eqdep. (** Simplify dependent equality using sigmas to equality of the second projections if possible. Uses UIP. *) Ltac simpl_existT := match goal with [ H : existT _ ?x _ = existT _ ?x _ |- _ ] => let Hi := fresh H in assert(Hi:=inj_pairT2 _ _ _ _ _ H) ; clear H end. Ltac simpl_existTs := repeat simpl_existT. (** Tries to eliminate a call to [eq_rect] (the substitution principle) by any means available. *) Ltac elim_eq_rect := match goal with | [ |- ?t ] => match t with | context [ @eq_rect _ _ _ _ _ ?p ] => let P := fresh "P" in set (P := p); simpl in P ; ((case P ; clear P) || (clearbody P; rewrite (UIP_refl _ _ P); clear P)) | context [ @eq_rect _ _ _ _ _ ?p _ ] => let P := fresh "P" in set (P := p); simpl in P ; ((case P ; clear P) || (clearbody P; rewrite (UIP_refl _ _ P); clear P)) end end. (** Rewrite using uniqueness of identity proofs [H = eq_refl]. *) Ltac simpl_uip := match goal with [ H : ?X = ?X |- _ ] => rewrite (UIP_refl _ _ H) in *; clear H end. (** Simplify equalities appearing in the context and goal. *) Ltac simpl_eq := simpl ; unfold eq_rec_r, eq_rec ; repeat (elim_eq_rect ; simpl) ; repeat (simpl_uip ; simpl). (** Try to abstract a proof of equality, if no proof of the same equality is present in the context. *) Ltac abstract_eq_hyp H' p := let ty := type of p in let tyred := eval simpl in ty in match tyred with ?X = ?Y => match goal with | [ H : X = Y |- _ ] => fail 1 | _ => set (H':=p) ; try (change p with H') ; clearbody H' ; simpl in H' end end. (** Apply the tactic tac to proofs of equality appearing as coercion arguments. Just redefine this tactic (using [Ltac on_coerce_proof tac ::=]) to handle custom coercion operators. *) Ltac on_coerce_proof tac T := match T with | context [ eq_rect _ _ _ _ ?p ] => tac p end. Ltac on_coerce_proof_gl tac := match goal with [ |- ?T ] => on_coerce_proof tac T end. (** Abstract proofs of equalities of coercions. *) Ltac abstract_eq_proof := on_coerce_proof_gl ltac:(fun p => let H := fresh "eqH" in abstract_eq_hyp H p). Ltac abstract_eq_proofs := repeat abstract_eq_proof. (** Factorize proofs, by using proof irrelevance so that two proofs of the same equality in the goal become convertible. *) Ltac pi_eq_proof_hyp p := let ty := type of p in let tyred := eval simpl in ty in match tyred with ?X = ?Y => match goal with | [ H : X = Y |- _ ] => match p with | H => fail 2 | _ => rewrite (UIP _ X Y p H) end | _ => fail " No hypothesis with same type " end end. (** Factorize proofs of equality appearing as coercion arguments. *) Ltac pi_eq_proof := on_coerce_proof_gl pi_eq_proof_hyp. Ltac pi_eq_proofs := repeat pi_eq_proof. (** The two preceding tactics in sequence. *) Ltac clear_eq_proofs := abstract_eq_proofs ; pi_eq_proofs. Global Hint Rewrite <- eq_rect_eq : refl_id. (** The [refl_id] database should be populated with lemmas of the form [coerce_* t eq_refl = t]. *) Lemma JMeq_eq_refl {A} (x : A) : JMeq_eq (@JMeq_refl _ x) = eq_refl. Proof. apply UIP. Qed. Lemma UIP_refl_refl A (x : A) : Eqdep.EqdepTheory.UIP_refl A x eq_refl = eq_refl. Proof. apply UIP_refl. Qed. Lemma inj_pairT2_refl A (x : A) (P : A -> Type) (p : P x) : Eqdep.EqdepTheory.inj_pairT2 A P x p p eq_refl = eq_refl. Proof. apply UIP_refl. Qed. Global Hint Rewrite @JMeq_eq_refl @UIP_refl_refl @inj_pairT2_refl : refl_id. Ltac rewrite_refl_id := autorewrite with refl_id. (** Clear the context and goal of equality proofs. *) Ltac clear_eq_ctx := rewrite_refl_id ; clear_eq_proofs. (** Reapeated elimination of [eq_rect] applications. Abstracting equalities makes it run much faster than an naive implementation. *) Ltac simpl_eqs := repeat (elim_eq_rect ; simpl ; clear_eq_ctx). (** Clear unused reflexivity proofs. *) Ltac clear_refl_eq := match goal with [ H : ?X = ?X |- _ ] => clear H end. Ltac clear_refl_eqs := repeat clear_refl_eq. (** Clear unused equality proofs. *) Ltac clear_eq := match goal with [ H : _ = _ |- _ ] => clear H end. Ltac clear_eqs := repeat clear_eq. (** Combine all the tactics to simplify goals containing coercions. *) Ltac simplify_eqs := simpl ; simpl_eqs ; clear_eq_ctx ; clear_refl_eqs ; try subst ; simpl ; repeat simpl_uip ; rewrite_refl_id. (** A tactic that tries to remove trivial equality guards in induction hypotheses coming from [dependent induction]/[generalize_eqs] invocations. *) Ltac simplify_IH_hyps := repeat match goal with | [ hyp : context [ block _ ] |- _ ] => specialize_eqs hyp end. (** We split substitution tactics in the two directions depending on which names we want to keep corresponding to the generalization performed by the [generalize_eqs] tactic. *) Ltac subst_left_no_fail := repeat (match goal with [ H : ?X = ?Y |- _ ] => subst X end). Ltac subst_right_no_fail := repeat (match goal with [ H : ?X = ?Y |- _ ] => subst Y end). Ltac inject_left H := progress (inversion H ; subst_left_no_fail ; clear_dups) ; clear H. Ltac inject_right H := progress (inversion H ; subst_right_no_fail ; clear_dups) ; clear H. Ltac autoinjections_left := repeat autoinjection ltac:(inject_left). Ltac autoinjections_right := repeat autoinjection ltac:(inject_right). Ltac simpl_depind := subst_no_fail ; autoinjections ; try discriminates ; simpl_JMeq ; simpl_existTs ; simplify_IH_hyps. Ltac simpl_depind_l := subst_left_no_fail ; autoinjections_left ; try discriminates ; simpl_JMeq ; simpl_existTs ; simplify_IH_hyps. Ltac simpl_depind_r := subst_right_no_fail ; autoinjections_right ; try discriminates ; simpl_JMeq ; simpl_existTs ; simplify_IH_hyps. Ltac blocked t := block_goal ; t ; unblock_goal. (** The [DependentEliminationPackage] provides the default dependent elimination principle to be used by the [equations] resolver. It is especially useful to register the dependent elimination principles for things in [Prop] which are not automatically generated. *) Class DependentEliminationPackage (A : Type) := { elim_type : Type ; elim : elim_type }. (** A higher-order tactic to apply a registered eliminator. *) Ltac elim_tac tac p := let ty := type of p in let eliminator := eval simpl in (@elim _ (_ : DependentEliminationPackage ty)) in tac p eliminator. (** Specialization to do case analysis or induction. Note: the [equations] tactic tries [case] before [elim_case]: there is no need to register generated induction principles. *) Ltac elim_case p := elim_tac ltac:(fun p el => destruct p using el) p. Ltac elim_ind p := elim_tac ltac:(fun p el => induction p using el) p. (** Lemmas used by the simplifier, mainly rephrasings of [eq_rect], [eq_ind]. *) Lemma solution_left A (B : A -> Type) (t : A) : B t -> (forall x, x = t -> B x). Proof. intros; subst; assumption. Defined. Lemma solution_right A (B : A -> Type) (t : A) : B t -> (forall x, t = x -> B x). Proof. intros; subst; assumption. Defined. Lemma deletion A B (t : A) : B -> (t = t -> B). Proof. intros; assumption. Defined. Lemma simplification_heq A B (x y : A) : (x = y -> B) -> (JMeq x y -> B). Proof. intros H J; apply H; apply (JMeq_eq J). Defined. Definition conditional_eq {A} (x y : A) := eq x y. Lemma simplification_existT2 A (P : A -> Type) B (p : A) (x y : P p) : (x = y -> B) -> (conditional_eq (existT P p x) (existT P p y) -> B). Proof. intros H E. apply H. apply inj_pair2. assumption. Defined. Lemma simplification_existT1 A (P : A -> Type) B (p q : A) (x : P p) (y : P q) : (p = q -> conditional_eq (existT P p x) (existT P q y) -> B) -> (existT P p x = existT P q y -> B). Proof. injection 2. auto. Defined. Lemma simplification_K A (x : A) (B : x = x -> Type) : B eq_refl -> (forall p : x = x, B p). Proof. intros. rewrite (UIP_refl A). assumption. Defined. (** This hint database and the following tactic can be used with [autounfold] to unfold everything to [eq_rect]s. *) #[global] Hint Unfold solution_left solution_right deletion simplification_heq simplification_existT1 simplification_existT2 simplification_K eq_rect_r eq_rec eq_ind : dep_elim. (** Using these we can make a simplifier that will perform the unification steps needed to put the goal in normalised form (provided there are only constructor forms). Compare with the lemma 16 of the paper. We don't have a [noCycle] procedure yet. *) Ltac simplify_one_dep_elim_term c := match c with | @JMeq _ _ _ _ -> _ => refine (simplification_heq _ _ _ _ _) | ?t = ?t -> _ => intros _ || refine (simplification_K _ t _ _) | eq (existT _ _ _) (existT _ _ _) -> _ => refine (simplification_existT1 _ _ _ _ _ _ _ _) | conditional_eq (existT _ _ _) (existT _ _ _) -> _ => refine (simplification_existT2 _ _ _ _ _ _ _) || (unfold conditional_eq; intro) | ?x = ?y -> _ => (* variables case *) (unfold x) || (unfold y) || (let hyp := fresh in intros hyp ; move hyp before x ; revert_until hyp ; generalize dependent x ; refine (solution_left _ _ _ _)(* ; intros until 0 *)) || (let hyp := fresh in intros hyp ; move hyp before y ; revert_until hyp ; generalize dependent y ; refine (solution_right _ _ _ _)(* ; intros until 0 *)) | ?f ?x = ?g ?y -> _ => let H := fresh in progress (intros H ; simple injection H; clear H) | ?t = ?u -> _ => let hyp := fresh in intros hyp ; exfalso ; discriminate | ?x = ?y -> _ => let hyp := fresh in intros hyp ; (try (clear hyp ; (* If non dependent, don't clear it! *) fail 1)) ; case hyp ; clear hyp | block ?T => fail 1 (* Do not put any part of the rhs in the hyps *) | forall x, _ => intro x || (let H := fresh x in rename x into H ; intro x) (* Try to keep original names *) | _ => intro end. Ltac simplify_one_dep_elim := match goal with | [ |- ?gl ] => simplify_one_dep_elim_term gl end. (** Repeat until no progress is possible. By construction, it should leave the goal with no remaining equalities generated by the [generalize_eqs] tactic. *) Ltac simplify_dep_elim := repeat simplify_one_dep_elim. (** Do dependent elimination of the last hypothesis, but not simplifying yet (used internally). *) Ltac destruct_last := on_last_hyp ltac:(fun id => simpl in id ; generalize_eqs id ; destruct id). Ltac introduce p := first [ match p with _ => (* Already there, generalize dependent hyps *) generalize dependent p ; intros p end | intros until p | intros until 1 | intros ]. Ltac do_case p := introduce p ; (destruct p || elim_case p || (case p ; clear p)). Ltac do_ind p := introduce p ; (induction p || elim_ind p). (** The following tactics allow to do induction on an already instantiated inductive predicate by first generalizing it and adding the proper equalities to the context, in a maner similar to the BasicElim tactic of "Elimination with a motive" by Conor McBride. *) (** The [do_depelim] higher-order tactic takes an elimination tactic as argument and an hypothesis and starts a dependent elimination using this tactic. *) Ltac is_introduced H := match goal with | [ H' : _ |- _ ] => match H' with H => idtac end end. Tactic Notation "intro_block" hyp(H) := (is_introduced H ; block_goal ; revert_until H ; block_goal) || (let H' := fresh H in intros until H' ; block_goal) || (intros ; block_goal). Tactic Notation "intro_block_id" ident(H) := (is_introduced H ; block_goal ; revert_until H; block_goal) || (let H' := fresh H in intros until H' ; block_goal) || (intros ; block_goal). Ltac unblock_dep_elim := match goal with | |- block ?T => match T with context [ block _ ] => change T ; intros ; unblock_goal end | _ => unblock_goal end. Ltac simpl_dep_elim := simplify_dep_elim ; simplify_IH_hyps ; unblock_dep_elim. Ltac do_intros H := (try intros until H) ; (intro_block_id H || intro_block H). Ltac do_depelim_nosimpl tac H := do_intros H ; generalize_eqs H ; tac H. Ltac do_depelim tac H := do_depelim_nosimpl tac H ; simpl_dep_elim. Ltac do_depind tac H := (try intros until H) ; intro_block H ; generalize_eqs_vars H ; tac H ; simpl_dep_elim. (** To dependent elimination on some hyp. *) Ltac depelim id := do_depelim ltac:(fun hyp => do_case hyp) id. (** Used internally. *) Ltac depelim_nosimpl id := do_depelim_nosimpl ltac:(fun hyp => do_case hyp) id. (** To dependent induction on some hyp. *) Ltac depind id := do_depind ltac:(fun hyp => do_ind hyp) id. (** A variant where generalized variables should be given by the user. *) Ltac do_depelim' rev tac H := (try intros until H) ; block_goal ; (try revert_until H ; block_goal) ; generalize_eqs H ; rev H ; tac H ; simpl_dep_elim. (** Calls [destruct] on the generalized hypothesis, results should be similar to inversion. By default, we don't try to generalize the hyp by its variable indices. *) Tactic Notation "dependent" "destruction" ident(H) := do_depelim' ltac:(fun hyp => idtac) ltac:(fun hyp => do_case hyp) H. Tactic Notation "dependent" "destruction" ident(H) "using" constr(c) := do_depelim' ltac:(fun hyp => idtac) ltac:(fun hyp => destruct hyp using c) H. (** This tactic also generalizes the goal by the given variables before the elimination. *) Tactic Notation "dependent" "destruction" ident(H) "generalizing" ne_hyp_list(l) := do_depelim' ltac:(fun hyp => revert l) ltac:(fun hyp => do_case hyp) H. Tactic Notation "dependent" "destruction" ident(H) "generalizing" ne_hyp_list(l) "using" constr(c) := do_depelim' ltac:(fun hyp => revert l) ltac:(fun hyp => destruct hyp using c) H. (** Then we have wrappers for usual calls to induction. One can customize the induction tactic by writing another wrapper calling do_depelim. We suppose the hyp has to be generalized before calling [induction]. *) Tactic Notation "dependent" "induction" ident(H) := do_depind ltac:(fun hyp => do_ind hyp) H. Tactic Notation "dependent" "induction" ident(H) "using" constr(c) := do_depind ltac:(fun hyp => induction hyp using c) H. (** This tactic also generalizes the goal by the given variables before the induction. *) Tactic Notation "dependent" "induction" ident(H) "generalizing" ne_hyp_list(l) := do_depelim' ltac:(fun hyp => revert l) ltac:(fun hyp => do_ind hyp) H. Tactic Notation "dependent" "induction" ident(H) "generalizing" ne_hyp_list(l) "using" constr(c) := do_depelim' ltac:(fun hyp => revert l) ltac:(fun hyp => induction hyp using c) H. Tactic Notation "dependent" "induction" ident(H) "in" ne_hyp_list(l) := do_depelim' ltac:(fun hyp => idtac) ltac:(fun hyp => induction hyp in l) H. Tactic Notation "dependent" "induction" ident(H) "in" ne_hyp_list(l) "using" constr(c) := do_depelim' ltac:(fun hyp => idtac) ltac:(fun hyp => induction hyp in l using c) H. coq-8.20.0/theories/Program/Program.v000066400000000000000000000016321466560755400174360ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* try on_subset_proof_aux tac P ; tac p end. Ltac on_subset_proof tac := match goal with [ |- ?T ] => on_subset_proof_aux tac T end. Ltac abstract_any_hyp H' p := match type of p with ?X => match goal with | [ H : X |- _ ] => fail 1 | _ => set (H':=p) ; try (change p with H') ; clearbody H' end end. Ltac abstract_subset_proof := on_subset_proof ltac:(fun p => let H := fresh "eqH" in abstract_any_hyp H p ; simpl in H). Ltac abstract_subset_proofs := repeat abstract_subset_proof. Ltac pi_subset_proof_hyp p := match type of p with ?X => match goal with | [ H : X |- _ ] => match p with | H => fail 2 | _ => rewrite (proof_irrelevance X p H) end | _ => fail " No hypothesis with same type " end end. Ltac pi_subset_proof := on_subset_proof pi_subset_proof_hyp. Ltac pi_subset_proofs := repeat pi_subset_proof. (** The two preceding tactics in sequence. *) Ltac clear_subset_proofs := abstract_subset_proofs ; simpl in * |- ; pi_subset_proofs ; clear_dups. Ltac pi := repeat f_equal ; apply proof_irrelevance. Lemma subset_eq : forall A (P : A -> Prop) (n m : sig P), n = m <-> `n = `m. Proof. intros A P n m. destruct n as (x,p). destruct m as (x',p'). simpl. split ; intros H ; subst. - inversion H. reflexivity. - pi. Qed. (* Somewhat trivial definition, but not unfolded automatically hence we can match on [match_eq ?A ?B ?x ?f] in tactics. *) Definition match_eq (A B : Type) (x : A) (fn : {y : A | y = x} -> B) : B := fn (exist _ x eq_refl). (* This is what we want to be able to do: replace the originally matched object by a new, propositionally equal one. If [fn] works on [x] it should work on any [y | y = x]. *) Lemma match_eq_rewrite : forall (A B : Type) (x : A) (fn : {y : A | y = x} -> B) (y : {y:A | y = x}), match_eq A B x fn = fn y. Proof. intros A B x fn y. unfold match_eq. f_equal. destruct y. (* uses proof-irrelevance *) apply <- subset_eq. symmetry. assumption. Qed. (** Now we make a tactic to be able to rewrite a term [t] which is applied to a [match_eq] using an arbitrary equality [t = u], and [u] is now the subject of the [match]. *) Ltac rewrite_match_eq H := match goal with [ |- ?T ] => match T with context [ match_eq ?A ?B ?t ?f ] => rewrite (match_eq_rewrite A B t f (exist _ _ (eq_sym H))) end end. (** Otherwise we can simply unfold [match_eq] and the term trivially reduces to the original definition. *) Ltac simpl_match_eq := unfold match_eq ; simpl. coq-8.20.0/theories/Program/Syntax.v000066400000000000000000000022551466560755400173170ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* idtac T end. Ltac show_hyp id := match goal with | [ H := ?b : ?T |- _ ] => match H with | id => idtac id ":=" b ":" T end | [ H : ?T |- _ ] => match H with | id => idtac id ":" T end end. Ltac show_hyps := try match reverse goal with | [ H : ?T |- _ ] => show_hyp H ; fail end. (** The [do] tactic but using a Coq-side nat. *) Ltac do_nat n tac := match n with | 0 => idtac | S ?n' => tac ; do_nat n' tac end. (** Do something on the last hypothesis, or fail *) Ltac on_last_hyp tac := lazymatch goal with [ H : _ |- _ ] => tac H end. (** Destructs one pair, without care regarding naming. *) Ltac destruct_one_pair := match goal with | [H : (_ /\ _) |- _] => destruct H | [H : prod _ _ |- _] => destruct H end. (** Repeateadly destruct pairs. *) Ltac destruct_pairs := repeat (destruct_one_pair). (** Destruct one existential package, keeping the name of the hypothesis for the first component. *) Ltac destruct_one_ex := let tac H := let ph := fresh "H" in (destruct H as [H ph]) in let tac2 H := let ph := fresh "H" in let ph' := fresh "H" in (destruct H as [H ph ph']) in let tacT H := let ph := fresh "X" in (destruct H as [H ph]) in let tacT2 H := let ph := fresh "X" in let ph' := fresh "X" in (destruct H as [H ph ph']) in match goal with | [H : (ex _) |- _] => tac H | [H : (sig ?P) |- _ ] => tac H | [H : (sigT ?P) |- _ ] => tacT H | [H : (ex2 _ _) |- _] => tac2 H | [H : (sig2 ?P _) |- _ ] => tac2 H | [H : (sigT2 ?P _) |- _ ] => tacT2 H end. (** Repeateadly destruct existentials. *) Ltac destruct_exists := repeat (destruct_one_ex). (** Repeateadly destruct conjunctions and existentials. *) Ltac destruct_conjs := repeat (destruct_one_pair || destruct_one_ex). (** Destruct an existential hypothesis [t] keeping its name for the first component and using [Ht] for the second *) Tactic Notation "destruct" "exist" ident(t) ident(Ht) := destruct t as [t Ht]. (** Destruct a disjunction keeping its name in both subgoals. *) Tactic Notation "destruct" "or" ident(H) := destruct H as [H|H]. (** Discriminate that also work on a [x <> x] hypothesis. *) Ltac discriminates := match goal with | [ H : ?x <> ?x |- _ ] => elim H ; reflexivity | _ => discriminate end. (** Revert the last hypothesis. *) Ltac revert_last := match goal with [ H : _ |- _ ] => revert H end. (** Repeatedly reverse the last hypothesis, putting everything in the goal. *) Ltac reverse := repeat revert_last. (** Reverse everything up to hypothesis id (not included). *) Ltac revert_until id := on_last_hyp ltac:(fun id' => match id' with | id => idtac | _ => revert id' ; revert_until id end). (** Clear duplicated hypotheses *) Ltac clear_dup := match goal with | [ H : ?X |- _ ] => match goal with | [ H' : ?Y |- _ ] => match H with | H' => fail 2 | _ => unify X Y ; (clear H' || clear H) end end end. Ltac clear_dups := repeat clear_dup. (** Try to clear everything except some hyp *) Ltac clear_except hyp := repeat match goal with [ H : _ |- _ ] => match H with | hyp => fail 1 | _ => clear H end end. (** A non-failing subst that substitutes as much as possible. *) Ltac subst_no_fail := repeat (match goal with [ H : ?X = ?Y |- _ ] => subst X || subst Y end). Tactic Notation "subst" "*" := subst_no_fail. Ltac on_application f tac T := match T with | context [f ?x ?y ?z ?w ?v ?u ?a ?b ?c] => tac (f x y z w v u a b c) | context [f ?x ?y ?z ?w ?v ?u ?a ?b] => tac (f x y z w v u a b) | context [f ?x ?y ?z ?w ?v ?u ?a] => tac (f x y z w v u a) | context [f ?x ?y ?z ?w ?v ?u] => tac (f x y z w v u) | context [f ?x ?y ?z ?w ?v] => tac (f x y z w v) | context [f ?x ?y ?z ?w] => tac (f x y z w) | context [f ?x ?y ?z] => tac (f x y z) | context [f ?x ?y] => tac (f x y) | context [f ?x] => tac (f x) end. (** Tactical [on_call f tac] applies [tac] on any application of [f] in the hypothesis or goal. *) Ltac on_call f tac := match goal with | |- ?T => on_application f tac T | H : ?T |- _ => on_application f tac T end. (* Destructs calls to f in hypothesis or conclusion, useful if f creates a subset object. *) Ltac destruct_call f := let tac t := (destruct t) in on_call f tac. Ltac destruct_calls f := repeat destruct_call f. Ltac destruct_call_in f H := let tac t := (destruct t) in let T := type of H in on_application f tac T. Ltac destruct_call_as f l := let tac t := (destruct t as l) in on_call f tac. Ltac destruct_call_as_in f l H := let tac t := (destruct t as l) in let T := type of H in on_application f tac T. Tactic Notation "destruct_call" constr(f) := destruct_call f. (** Permit to name the results of destructing the call to [f]. *) Tactic Notation "destruct_call" constr(f) "as" simple_intropattern(l) := destruct_call_as f l. (** Specify the hypothesis in which the call occurs as well. *) Tactic Notation "destruct_call" constr(f) "in" hyp(id) := destruct_call_in f id. Tactic Notation "destruct_call" constr(f) "as" simple_intropattern(l) "in" hyp(id) := destruct_call_as_in f l id. (** A marker for prototypes to destruct. *) Definition fix_proto {A : Type} (a : A) := a. Register fix_proto as program.tactic.fix_proto. Ltac destruct_rec_calls := match goal with | [ H : fix_proto _ |- _ ] => destruct_calls H ; clear H end. Ltac destruct_all_rec_calls := repeat destruct_rec_calls ; unfold fix_proto in *. (** Try to inject any potential constructor equality hypothesis. *) Ltac autoinjection tac := match goal with | [ H : ?f ?a = ?f' ?a' |- _ ] => tac H end. Ltac inject H := progress (inversion H ; subst*; clear_dups) ; clear H. Ltac autoinjections := repeat (clear_dups ; autoinjection ltac:(inject)). (** Destruct an hypothesis by first copying it to avoid dependencies. *) Ltac destruct_nondep H := let H0 := fresh "H" in assert(H0 := H); destruct H0. (** If bang appears in the goal, it means that we have a proof of False and the goal is solved. *) Ltac bang := match goal with | |- ?x => match x with | context [False_rect _ ?p] => elim p end end. (** A tactic to show contradiction by first asserting an automatically provable hypothesis. *) Tactic Notation "contradiction" "by" constr(t) := let H := fresh in assert t as H by auto with * ; contradiction. (** A tactic that adds [H:=p:typeof(p)] to the context if no hypothesis of the same type appears in the goal. Useful to do saturation using tactics. *) Ltac add_hypothesis H' p := match type of p with ?X => match goal with | [ H : X |- _ ] => fail 1 | _ => set (H':=p) ; try (change p with H') ; clearbody H' end end. (** A tactic to replace an hypothesis by another term. *) Ltac replace_hyp H c := let H' := fresh "H" in assert(H' := c) ; clear H ; rename H' into H. (** A tactic to refine an hypothesis by supplying some of its arguments. *) Ltac refine_hyp c := let tac H := replace_hyp H c in match c with | ?H _ => tac H | ?H _ _ => tac H | ?H _ _ _ => tac H | ?H _ _ _ _ => tac H | ?H _ _ _ _ _ => tac H | ?H _ _ _ _ _ _ => tac H | ?H _ _ _ _ _ _ _ => tac H | ?H _ _ _ _ _ _ _ _ => tac H end. (** The default simplification tactic used by Program is defined by [program_simpl], sometimes [auto] is not enough, better rebind using [Obligation Tactic := tac] in this case, possibly using [program_simplify] to use standard goal-cleaning tactics. *) Ltac program_simplify := simpl; intros ; destruct_all_rec_calls ; repeat (destruct_conjs; simpl proj1_sig in * ); subst*; autoinjections ; try discriminates ; try (solve [ red ; intros ; destruct_conjs ; autoinjections ; discriminates ]). (** Restrict automation to propositional obligations. *) Ltac program_solve_wf := match goal with | |- well_founded _ => auto with * | |- ?T => match type of T with Prop => auto end end. Create HintDb program discriminated. Ltac program_simpl := program_simplify ; try typeclasses eauto 10 with program ; try program_solve_wf. #[global] Obligation Tactic := program_simpl. #[export] Obligation Tactic := program_simpl. coq-8.20.0/theories/Program/Utils.v000066400000000000000000000040601466560755400171250ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* let (x,y) := anonymous in P)) (x name, y name) : type_scope. Declare Scope program_scope. Delimit Scope program_scope with prg. (** Generates an obligation to prove False. *) Notation " ! " := (False_rect _ _) : program_scope. (** Abbreviation for first projection and hiding of proofs of subset objects. *) Notation " ` t " := (proj1_sig t) (at level 10, t at next level) : program_scope. (** Coerces objects to their support before comparing them. *) Require Import Coq.Bool.Sumbool. (** Construct a dependent disjunction from a boolean. *) Notation dec := sumbool_of_bool. (** The notations [in_right] and [in_left] construct objects of a dependent disjunction. *) (** Hide proofs and generates obligations when put in a term. *) Notation in_left := (@left _ _ _). Notation in_right := (@right _ _ _). (** Extraction directives *) (* Extraction Inline proj1_sig. Extract Inductive unit => "unit" [ "()" ]. Extract Inductive bool => "bool" [ "true" "false" ]. Extract Inductive sumbool => "bool" [ "true" "false" ]. (* Extract Inductive prod "'a" "'b" => " 'a * 'b " [ "(,)" ]. *) (* Extract Inductive sigT => "prod" [ "" ]. *) *) coq-8.20.0/theories/Program/Wf.v000066400000000000000000000176411466560755400164120ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* A -> Prop. Hypothesis Rwf : well_founded R. Variable P : A -> Type. Variable F_sub : forall x:A, (forall y: { y : A | R y x }, P (proj1_sig y)) -> P x. Fixpoint Fix_F_sub (x : A) (r : Acc R x) : P x := F_sub x (fun y: { y : A | R y x} => Fix_F_sub (proj1_sig y) (Acc_inv r (proj2_sig y))). Definition Fix_sub (x : A) := Fix_F_sub x (Rwf x). Register Fix_sub as program.wf.fix_sub. (* Notation Fix_F := (Fix_F_sub P F_sub) (only parsing). (* alias *) *) (* Definition Fix (x:A) := Fix_F_sub P F_sub x (Rwf x). *) Hypothesis F_ext : forall (x:A) (f g:forall y:{y:A | R y x}, P (`y)), (forall y:{y : A | R y x}, f y = g y) -> F_sub x f = F_sub x g. Lemma Fix_F_eq : forall (x:A) (r:Acc R x), F_sub x (fun y:{y:A | R y x} => Fix_F_sub (`y) (Acc_inv r (proj2_sig y))) = Fix_F_sub x r. Proof. intros x r; destruct r using Acc_inv_dep; auto. Qed. Lemma Fix_F_inv : forall (x:A) (r s:Acc R x), Fix_F_sub x r = Fix_F_sub x s. Proof. intro x; induction (Rwf x); intros. rewrite <- 2 Fix_F_eq; intros. apply F_ext; intros []; auto. Qed. Lemma Fix_eq : forall x:A, Fix_sub x = F_sub x (fun y:{ y:A | R y x} => Fix_sub (proj1_sig y)). Proof. intro x; unfold Fix_sub. rewrite <- (Fix_F_eq ). apply F_ext; intros. apply Fix_F_inv. Qed. Lemma fix_sub_eq : forall x : A, Fix_sub x = let f_sub := F_sub in f_sub x (fun y: {y : A | R y x} => Fix_sub (`y)). Proof. exact Fix_eq. Qed. End Well_founded. Require Coq.extraction.Extraction. Extraction Inline Fix_F_sub Fix_sub. Set Implicit Arguments. (** Reasoning about well-founded fixpoints on measures. *) Section Measure_well_founded. (* Measure relations are well-founded if the underlying relation is well-founded. *) Variables T M: Type. Variable R: M -> M -> Prop. Hypothesis wf: well_founded R. Variable m: T -> M. Definition MR (x y: T): Prop := R (m x) (m y). Register MR as program.wf.mr. Lemma measure_wf: well_founded MR. Proof with auto. unfold well_founded. cut (forall (a: M) (a0: T), m a0 = a -> Acc MR a0). + intros H a. apply (H (m a))... + apply (@well_founded_ind M R wf (fun mm => forall a, m a = mm -> Acc MR a)). intros ? H ? H0. apply Acc_intro. intros y H1. unfold MR in H1. rewrite H0 in H1. apply (H (m y))... Defined. End Measure_well_founded. #[global] Hint Resolve measure_wf : core. Section Fix_rects. Variable A: Type. Variable P: A -> Type. Variable R : A -> A -> Prop. Variable Rwf : well_founded R. Variable f: forall (x : A), (forall y: { y: A | R y x }, P (proj1_sig y)) -> P x. Lemma F_unfold x r: Fix_F_sub A R P f x r = f (fun y => Fix_F_sub A R P f (proj1_sig y) (Acc_inv r (proj2_sig y))). Proof. intros. case r; auto. Qed. (* Fix_F_sub_rect lets one prove a property of functions defined using Fix_F_sub by showing that property to be invariant over single application of the function body (f in our case). *) Lemma Fix_F_sub_rect (Q: forall x, P x -> Type) (inv: forall x: A, (forall (y: A) (H: R y x) (a: Acc R y), Q y (Fix_F_sub A R P f y a)) -> forall (a: Acc R x), Q x (f (fun y: {y: A | R y x} => Fix_F_sub A R P f (proj1_sig y) (Acc_inv a (proj2_sig y))))) : forall x a, Q _ (Fix_F_sub A R P f x a). Proof with auto. set (R' := fun (x: A) => forall a, Q _ (Fix_F_sub A R P f x a)). cut (forall x, R' x)... apply (well_founded_induction_type Rwf). subst R'. simpl. intros. rewrite F_unfold... Qed. (* Let's call f's second parameter its "lowers" function, since it provides it access to results for inputs with a lower measure. In preparation of lemma similar to Fix_F_sub_rect, but for Fix_sub, we first need an extra hypothesis stating that the function body has the same result for different "lowers" functions (g and h below) as long as those produce the same results for lower inputs, regardless of the lt proofs. *) Hypothesis equiv_lowers: forall x0 (g h: forall x: {y: A | R y x0}, P (proj1_sig x)), (forall x p p', g (exist (fun y: A => R y x0) x p) = h (exist (*FIXME shouldn't be needed *) (fun y => R y x0) x p')) -> f g = f h. (* From equiv_lowers, it follows that [Fix_F_sub A R P f x] applications do not not depend on the Acc proofs. *) Lemma eq_Fix_F_sub x (a a': Acc R x): Fix_F_sub A R P f x a = Fix_F_sub A R P f x a'. Proof. revert a'. pattern x, (Fix_F_sub A R P f x a). apply Fix_F_sub_rect. intros ? H **. rewrite F_unfold. apply equiv_lowers. intros. apply H. assumption. Qed. (* Finally, Fix_F_rect lets one prove a property of functions defined using Fix_F_sub by showing that property to be invariant over single application of the function body (f). *) Lemma Fix_sub_rect (Q: forall x, P x -> Type) (inv: forall (x: A) (H: forall (y: A), R y x -> Q y (Fix_sub A R Rwf P f y)) (a: Acc R x), Q x (f (fun y: {y: A | R y x} => Fix_sub A R Rwf P f (proj1_sig y)))) : forall x, Q _ (Fix_sub A R Rwf P f x). Proof with auto. unfold Fix_sub. intros x. apply Fix_F_sub_rect. intros x0 H a. assert (forall y: A, R y x0 -> Q y (Fix_F_sub A R P f y (Rwf y))) as X0... set (q := inv x0 X0 a). clearbody q. rewrite <- (equiv_lowers (fun y: {y: A | R y x0} => Fix_F_sub A R P f (proj1_sig y) (Rwf (proj1_sig y))) (fun y: {y: A | R y x0} => Fix_F_sub A R P f (proj1_sig y) (Acc_inv a (proj2_sig y))))... intros. apply eq_Fix_F_sub. Qed. End Fix_rects. (** Tactic to fold a definition based on [Fix_measure_sub]. *) Ltac fold_sub f := match goal with | [ |- ?T ] => match T with context C [ @Fix_sub _ _ _ _ _ ?arg ] => let app := context C [ f arg ] in change app end end. (** This module provides the fixpoint equation provided one assumes functional extensionality. *) Require Import FunctionalExtensionality. Module WfExtensionality. (** The two following lemmas allow to unfold a well-founded fixpoint definition without restriction using the functional extensionality axiom. *) (** For a function defined with Program using a well-founded order. *) Program Lemma fix_sub_eq_ext : forall (A : Type) (R : A -> A -> Prop) (Rwf : well_founded R) (P : A -> Type) (F_sub : forall x : A, (forall y:{y : A | R y x}, P (` y)) -> P x), forall x : A, Fix_sub A R Rwf P F_sub x = F_sub x (fun y:{y : A | R y x} => Fix_sub A R Rwf P F_sub (` y)). Proof. intros A R Rwf P F_sub x; apply Fix_eq ; auto. intros ? f g H. assert(f = g) as H0. - extensionality y ; apply H. - rewrite H0 ; auto. Qed. (** Tactic to unfold once a definition based on [Fix_sub]. *) Ltac unfold_sub f fargs := set (call:=fargs) ; unfold f in call ; unfold call ; clear call ; rewrite fix_sub_eq_ext ; repeat fold_sub f ; simpl proj1_sig. End WfExtensionality. coq-8.20.0/theories/QArith/000077500000000000000000000000001466560755400154175ustar00rootroot00000000000000coq-8.20.0/theories/QArith/QArith.v000066400000000000000000000013611466560755400167770ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* y" := (Qlt y x)(only parsing) : Q_scope. Notation "x >= y" := (Qle y x)(only parsing) : Q_scope. Notation "x <= y <= z" := (x<=y/\y<=z) : Q_scope. Notation "x <= y < z" := (x<=y/\y a=b. Proof. intros a b p. unfold Qeq. apply Z.mul_cancel_r, not_eq_sym, Z.lt_neq, Pos2Z.is_pos. Qed. Lemma Qnum_cancel : forall (a b : positive) (z : Z), z<>0%Z -> (z#a)==(z#b) -> a=b. Proof. intros a b z Hz_ne_0. unfold Qeq. rewrite Z.eq_sym_iff, <- Pos2Z.inj_iff. apply (Z.mul_reg_l _ _ _ Hz_ne_0). Qed. (** injection from Z is injective. *) Lemma inject_Z_injective (a b: Z): inject_Z a == inject_Z b <-> a = b. Proof. unfold Qeq; simpl; rewrite !Z.mul_1_r; reflexivity. Qed. (** Another approach : using Qcompare for defining order relations. *) Definition Qcompare (p q : Q) := (Qnum p * QDen q ?= Qnum q * QDen p)%Z. Notation "p ?= q" := (Qcompare p q) : Q_scope. Lemma Qeq_alt p q : (p == q) <-> (p ?= q) = Eq. Proof. symmetry. apply Z.compare_eq_iff. Qed. Lemma Qlt_alt p q : (p (p?=q = Lt). Proof. reflexivity. Qed. Lemma Qgt_alt p q : (p>q) <-> (p?=q = Gt). Proof. symmetry. apply Z.gt_lt_iff. Qed. Lemma Qle_alt p q : (p<=q) <-> (p?=q <> Gt). Proof. reflexivity. Qed. Lemma Qge_alt p q : (p>=q) <-> (p?=q <> Lt). Proof. symmetry. apply Z.ge_le_iff. Qed. #[global] Hint Unfold Qeq Qlt Qle : qarith. #[global] Hint Extern 5 (?X1 <> ?X2) => intro; discriminate: qarith. Lemma Qcompare_antisym x y : CompOpp (x ?= y) = (y ?= x). Proof. symmetry. apply Z.compare_antisym. Qed. Lemma Qcompare_spec x y : CompareSpec (x==y) (x y == x. Proof. auto with qarith. Qed. Theorem Qeq_trans x y z : x == y -> y == z -> x == z. Proof. unfold Qeq; intros XY YZ. apply Z.mul_reg_r with (QDen y); [auto with qarith|]. now rewrite Z.mul_shuffle0, XY, Z.mul_shuffle0, YZ, Z.mul_shuffle0. Qed. #[global] Hint Immediate Qeq_sym : qarith. #[global] Hint Resolve Qeq_refl Qeq_trans : qarith. (** In a word, [Qeq] is a setoid equality. *) #[global] Instance Q_Setoid : Equivalence Qeq. Proof. split; red; eauto with qarith. Qed. (** Furthermore, this equality is decidable: *) Theorem Qeq_dec x y : {x==y} + {~ x==y}. Proof. apply Z.eq_dec. Defined. Definition Qeq_bool x y := (Zeq_bool (Qnum x * QDen y) (Qnum y * QDen x))%Z. Definition Qle_bool x y := (Z.leb (Qnum x * QDen y) (Qnum y * QDen x))%Z. Lemma Qeq_bool_iff x y : Qeq_bool x y = true <-> x == y. Proof. symmetry; apply Zeq_is_eq_bool. Qed. Lemma Qeq_bool_eq x y : Qeq_bool x y = true -> x == y. Proof. apply Qeq_bool_iff. Qed. Lemma Qeq_eq_bool x y : x == y -> Qeq_bool x y = true. Proof. apply Qeq_bool_iff. Qed. Lemma Qeq_bool_neq x y : Qeq_bool x y = false -> ~ x == y. Proof. rewrite <- Qeq_bool_iff. now intros ->. Qed. Lemma Qle_bool_iff x y : Qle_bool x y = true <-> x <= y. Proof. symmetry; apply Zle_is_le_bool. Qed. Lemma Qle_bool_imp_le x y : Qle_bool x y = true -> x <= y. Proof. apply Qle_bool_iff. Qed. Theorem Qnot_eq_sym x y : ~x == y -> ~y == x. Proof. auto with qarith. Qed. Lemma Qeq_bool_comm x y: Qeq_bool x y = Qeq_bool y x. Proof. apply eq_true_iff_eq. rewrite !Qeq_bool_iff. now symmetry. Qed. Lemma Qeq_bool_refl x: Qeq_bool x x = true. Proof. rewrite Qeq_bool_iff. now reflexivity. Qed. Lemma Qeq_bool_sym x y: Qeq_bool x y = true -> Qeq_bool y x = true. Proof. rewrite !Qeq_bool_iff. now symmetry. Qed. Lemma Qeq_bool_trans x y z: Qeq_bool x y = true -> Qeq_bool y z = true -> Qeq_bool x z = true. Proof. rewrite !Qeq_bool_iff; apply Qeq_trans. Qed. #[global] Hint Resolve Qnot_eq_sym : qarith. (** * Addition, multiplication and opposite *) (** The addition, multiplication and opposite are defined in the straightforward way: *) Definition Qplus (x y : Q) := (Qnum x * QDen y + Qnum y * QDen x) # (Qden x * Qden y). Definition Qmult (x y : Q) := (Qnum x * Qnum y) # (Qden x * Qden y). Definition Qopp (x : Q) := (- Qnum x) # (Qden x). Definition Qminus (x y : Q) := Qplus x (Qopp y). Definition Qinv (x : Q) := match Qnum x with | Z0 => 0#1 | Zpos p => (QDen x)#p | Zneg p => (Zneg (Qden x))#p end. Definition Qdiv (x y : Q) := Qmult x (Qinv y). Infix "+" := Qplus : Q_scope. Notation "- x" := (Qopp x) : Q_scope. Infix "-" := Qminus : Q_scope. Infix "*" := Qmult : Q_scope. Notation "/ x" := (Qinv x) : Q_scope. Infix "/" := Qdiv : Q_scope. Register Qplus as rat.Q.Qplus. Register Qminus as rat.Q.Qminus. Register Qopp as rat.Q.Qopp. Register Qmult as rat.Q.Qmult. (** Number notation for constants *) Inductive IZ := | IZpow_pos : Z -> positive -> IZ | IZ0 : IZ | IZpos : positive -> IZ | IZneg : positive -> IZ. Inductive IQ := | IQmake : IZ -> positive -> IQ | IQmult : IQ -> IQ -> IQ | IQdiv : IQ -> IQ -> IQ. Definition IZ_of_Z z := match z with | Z0 => IZ0 | Zpos e => IZpos e | Zneg e => IZneg e end. Definition IZ_to_Z z := match z with | IZ0 => Some Z0 | IZpos e => Some (Zpos e) | IZneg e => Some (Zneg e) | IZpow_pos _ _ => None end. Definition of_decimal (d:Decimal.decimal) : IQ := let '(i, f, e) := match d with | Decimal.Decimal i f => (i, f, Decimal.Pos Decimal.Nil) | Decimal.DecimalExp i f e => (i, f, e) end in let num := Z.of_int (Decimal.app_int i f) in let den := Nat.iter (Decimal.nb_digits f) (Pos.mul 10) 1%positive in let q := IQmake (IZ_of_Z num) den in let e := Z.of_int e in match e with | Z0 => q | Zpos e => IQmult q (IQmake (IZpow_pos 10 e) 1) | Zneg e => IQdiv q (IQmake (IZpow_pos 10 e) 1) end. Definition IQmake_to_decimal num den := let num := Z.to_int num in let (den, e_den) := Decimal.nztail (Pos.to_uint den) in match den with | Decimal.D1 Decimal.Nil => match e_den with | O => Some (Decimal.Decimal num Decimal.Nil) | ne => let ai := Decimal.abs num in let ni := Decimal.nb_digits ai in if Nat.ltb ne ni then let i := Decimal.del_tail_int ne num in let f := Decimal.del_head (Nat.sub ni ne) ai in Some (Decimal.Decimal i f) else let z := match num with | Decimal.Pos _ => Decimal.Pos (Decimal.zero) | Decimal.Neg _ => Decimal.Neg (Decimal.zero) end in Some (Decimal.Decimal z (Nat.iter (Nat.sub ne ni) Decimal.D0 ai)) end | _ => None end. Definition IQmake_to_decimal' num den := match IZ_to_Z num with | None => None | Some num => IQmake_to_decimal num den end. Definition to_decimal (n : IQ) : option Decimal.decimal := match n with | IQmake num den => IQmake_to_decimal' num den | IQmult (IQmake num den) (IQmake (IZpow_pos 10 e) 1) => match IQmake_to_decimal' num den with | Some (Decimal.Decimal i f) => Some (Decimal.DecimalExp i f (Pos.to_int e)) | _ => None end | IQdiv (IQmake num den) (IQmake (IZpow_pos 10 e) 1) => match IQmake_to_decimal' num den with | Some (Decimal.Decimal i f) => Some (Decimal.DecimalExp i f (Decimal.Neg (Pos.to_uint e))) | _ => None end | _ => None end. Definition of_hexadecimal (d:Hexadecimal.hexadecimal) : IQ := let '(i, f, e) := match d with | Hexadecimal.Hexadecimal i f => (i, f, Decimal.Pos Decimal.Nil) | Hexadecimal.HexadecimalExp i f e => (i, f, e) end in let num := Z.of_hex_int (Hexadecimal.app_int i f) in let den := Nat.iter (Hexadecimal.nb_digits f) (Pos.mul 16) 1%positive in let q := IQmake (IZ_of_Z num) den in let e := Z.of_int e in match e with | Z0 => q | Zpos e => IQmult q (IQmake (IZpow_pos 2 e) 1) | Zneg e => IQdiv q (IQmake (IZpow_pos 2 e) 1) end. Definition IQmake_to_hexadecimal num den := let num := Z.to_hex_int num in let (den, e_den) := Hexadecimal.nztail (Pos.to_hex_uint den) in match den with | Hexadecimal.D1 Hexadecimal.Nil => match e_den with | O => Some (Hexadecimal.Hexadecimal num Hexadecimal.Nil) | ne => let ai := Hexadecimal.abs num in let ni := Hexadecimal.nb_digits ai in if Nat.ltb ne ni then let i := Hexadecimal.del_tail_int ne num in let f := Hexadecimal.del_head (Nat.sub ni ne) ai in Some (Hexadecimal.Hexadecimal i f) else let z := match num with | Hexadecimal.Pos _ => Hexadecimal.Pos (Hexadecimal.zero) | Hexadecimal.Neg _ => Hexadecimal.Neg (Hexadecimal.zero) end in Some (Hexadecimal.Hexadecimal z (Nat.iter (Nat.sub ne ni) Hexadecimal.D0 ai)) end | _ => None end. Definition IQmake_to_hexadecimal' num den := match IZ_to_Z num with | None => None | Some num => IQmake_to_hexadecimal num den end. Definition to_hexadecimal (n : IQ) : option Hexadecimal.hexadecimal := match n with | IQmake num den => IQmake_to_hexadecimal' num den | IQmult (IQmake num den) (IQmake (IZpow_pos 2 e) 1) => match IQmake_to_hexadecimal' num den with | Some (Hexadecimal.Hexadecimal i f) => Some (Hexadecimal.HexadecimalExp i f (Pos.to_int e)) | _ => None end | IQdiv (IQmake num den) (IQmake (IZpow_pos 2 e) 1) => match IQmake_to_hexadecimal' num den with | Some (Hexadecimal.Hexadecimal i f) => Some (Hexadecimal.HexadecimalExp i f (Decimal.Neg (Pos.to_uint e))) | _ => None end | _ => None end. Definition of_number (n : Number.number) : IQ := match n with | Number.Decimal d => of_decimal d | Number.Hexadecimal h => of_hexadecimal h end. Definition to_number (q:IQ) : option Number.number := match to_decimal q with | None => None | Some q => Some (Number.Decimal q) end. Definition to_hex_number q := match to_hexadecimal q with | None => None | Some q => Some (Number.Hexadecimal q) end. Number Notation Q of_number to_hex_number (via IQ mapping [Qmake => IQmake, Qmult => IQmult, Qdiv => IQdiv, Z.pow_pos => IZpow_pos, Z0 => IZ0, Zpos => IZpos, Zneg => IZneg]) : hex_Q_scope. Number Notation Q of_number to_number (via IQ mapping [Qmake => IQmake, Qmult => IQmult, Qdiv => IQdiv, Z.pow_pos => IZpow_pos, Z0 => IZ0, Zpos => IZpos, Zneg => IZneg]) : Q_scope. (** A light notation for [Zpos] *) Lemma Qmake_Qdiv a b : a#b==inject_Z a/inject_Z (Zpos b). Proof. unfold Qeq. simpl. ring. Qed. (** * Setoid compatibility results *) #[global] Instance Qplus_comp : Proper (Qeq==>Qeq==>Qeq) Qplus. Proof. unfold Qeq, Qplus; simpl. Open Scope Z_scope. intros (p1, p2) (q1, q2) H (r1, r2) (s1, s2) H0; simpl in *. simpl_mult; ring_simplify. replace (p1 * Zpos r2 * Zpos q2) with (p1 * Zpos q2 * Zpos r2) by ring. rewrite H. replace (r1 * Zpos p2 * Zpos q2 * Zpos s2) with (r1 * Zpos s2 * Zpos p2 * Zpos q2) by ring. rewrite H0. ring. Close Scope Z_scope. Qed. #[global] Instance Qopp_comp : Proper (Qeq==>Qeq) Qopp. Proof. unfold Qeq, Qopp; simpl. Open Scope Z_scope. intros x y H; simpl. replace (- Qnum x * Zpos (Qden y)) with (- (Qnum x * Zpos (Qden y))) by ring. rewrite H; ring. Close Scope Z_scope. Qed. #[global] Instance Qminus_comp : Proper (Qeq==>Qeq==>Qeq) Qminus. Proof. intros x x' Hx y y' Hy. unfold Qminus. rewrite Hx, Hy; auto with qarith. Qed. #[global] Instance Qmult_comp : Proper (Qeq==>Qeq==>Qeq) Qmult. Proof. unfold Qeq; simpl. Open Scope Z_scope. intros (p1, p2) (q1, q2) H (r1, r2) (s1, s2) H0; simpl in *. intros; simpl_mult; ring_simplify. replace (q1 * s1 * Zpos p2) with (q1 * Zpos p2 * s1) by ring. rewrite <- H. replace (p1 * r1 * Zpos q2 * Zpos s2) with (r1 * Zpos s2 * p1 * Zpos q2) by ring. rewrite H0. ring. Close Scope Z_scope. Qed. #[global] Instance Qinv_comp : Proper (Qeq==>Qeq) Qinv. Proof. unfold Qeq, Qinv; simpl. Open Scope Z_scope. intros (p1, p2) (q1, q2) EQ; simpl in *. destruct q1; simpl in *. - apply Z.mul_eq_0 in EQ. destruct EQ; now subst. - destruct p1; simpl in *; try discriminate. now rewrite Pos.mul_comm, <- EQ, Pos.mul_comm. - destruct p1; simpl in *; try discriminate. now rewrite Pos.mul_comm, <- EQ, Pos.mul_comm. Close Scope Z_scope. Qed. #[global] Instance Qdiv_comp : Proper (Qeq==>Qeq==>Qeq) Qdiv. Proof. intros x x' Hx y y' Hy; unfold Qdiv. rewrite Hx, Hy; auto with qarith. Qed. #[global] Instance Qcompare_comp : Proper (Qeq==>Qeq==>eq) Qcompare. Proof. unfold Qeq, Qcompare. Open Scope Z_scope. intros (p1,p2) (q1,q2) H (r1,r2) (s1,s2) H'; simpl in *. rewrite <- (Zcompare_mult_compat (q2*s2) (p1*Zpos r2)). rewrite <- (Zcompare_mult_compat (p2*r2) (q1*Zpos s2)). change (Zpos (q2*s2)) with (Zpos q2 * Zpos s2). change (Zpos (p2*r2)) with (Zpos p2 * Zpos r2). replace (Zpos q2 * Zpos s2 * (p1*Zpos r2)) with ((p1*Zpos q2)*Zpos r2*Zpos s2) by ring. rewrite H. replace (Zpos q2 * Zpos s2 * (r1*Zpos p2)) with ((r1*Zpos s2)*Zpos q2*Zpos p2) by ring. rewrite H'. f_equal; ring. Close Scope Z_scope. Qed. #[global] Instance Qle_comp : Proper (Qeq==>Qeq==>iff) Qle. Proof. intros p q H r s H'. rewrite 2 Qle_alt, H, H'; auto with *. Qed. #[global] Instance Qlt_compat : Proper (Qeq==>Qeq==>iff) Qlt. Proof. intros p q H r s H'. rewrite 2 Qlt_alt, H, H'; auto with *. Qed. #[global] Instance Qeqb_comp : Proper (Qeq==>Qeq==>eq) Qeq_bool. Proof. intros p q H r s H'; apply eq_true_iff_eq. rewrite 2 Qeq_bool_iff, H, H'; split; auto with qarith. Qed. #[global] Instance Qleb_comp : Proper (Qeq==>Qeq==>eq) Qle_bool. Proof. intros p q H r s H'; apply eq_true_iff_eq. rewrite 2 Qle_bool_iff, H, H'; split; auto with qarith. Qed. (** [0] and [1] are apart *) Lemma Q_apart_0_1 : ~ 1 == 0. Proof. unfold Qeq; auto with qarith. Qed. (** * Properties of [Qadd] *) (** Addition is associative: *) Theorem Qplus_assoc : forall x y z, x+(y+z)==(x+y)+z. Proof. intros (x1, x2) (y1, y2) (z1, z2). unfold Qeq, Qplus; simpl; simpl_mult; ring. Qed. (** [0] is a neutral element for addition: *) Lemma Qplus_0_l : forall x, 0+x == x. Proof. intros (x1, x2); unfold Qeq, Qplus; simpl; ring. Qed. Lemma Qplus_0_r : forall x, x+0 == x. Proof. intros (x1, x2); unfold Qeq, Qplus; simpl. rewrite Pos.mul_comm; simpl; ring. Qed. (** Commutativity of addition: *) Theorem Qplus_comm : forall x y, x+y == y+x. Proof. intros (x1, x2); unfold Qeq, Qplus; simpl. intros; rewrite Pos.mul_comm; ring. Qed. (** * Properties of [Qopp] *) Lemma Qopp_involutive : forall q, - -q == q. Proof. red; simpl; intros; ring. Qed. Theorem Qplus_opp_r : forall q, q+(-q) == 0. Proof. red; simpl; intro; ring. Qed. (** Injectivity of addition (uses theory about Qopp above): *) Lemma Qplus_inj_r (x y z: Q): x + z == y + z <-> x == y. Proof. split; intro E. - rewrite <- (Qplus_0_r x), <- (Qplus_0_r y). rewrite <- (Qplus_opp_r z); auto. do 2 rewrite Qplus_assoc. rewrite E. reflexivity. - rewrite E. reflexivity. Qed. Lemma Qplus_inj_l (x y z: Q): z + x == z + y <-> x == y. Proof. rewrite (Qplus_comm z x), (Qplus_comm z y). apply Qplus_inj_r. Qed. (** * Properties of [Qmult] *) (** Multiplication is associative: *) Theorem Qmult_assoc : forall n m p, n*(m*p)==(n*m)*p. Proof. intros; red; simpl; rewrite Pos.mul_assoc; ring. Qed. (** multiplication and zero *) Lemma Qmult_0_l : forall x , 0*x == 0. Proof. intros; compute; reflexivity. Qed. Lemma Qmult_0_r : forall x , x*0 == 0. Proof. intros; red; simpl; ring. Qed. (** [1] is a neutral element for multiplication: *) Lemma Qmult_1_l : forall n, 1*n == n. Proof. intro n; red; simpl; destruct (Qnum n); auto. Qed. Theorem Qmult_1_r : forall n, n*1==n. Proof. intro n; red; simpl. rewrite (Z.mul_1_r (Qnum n)). rewrite Pos.mul_comm; simpl; trivial. Qed. (** Commutativity of multiplication *) Theorem Qmult_comm : forall x y, x*y==y*x. Proof. intros; red; simpl; rewrite Pos.mul_comm; ring. Qed. (** Distributivity over [Qadd] *) Theorem Qmult_plus_distr_r : forall x y z, x*(y+z)==(x*y)+(x*z). Proof. intros (x1, x2) (y1, y2) (z1, z2). unfold Qeq, Qmult, Qplus; simpl; simpl_mult; ring. Qed. Theorem Qmult_plus_distr_l : forall x y z, (x+y)*z==(x*z)+(y*z). Proof. intros (x1, x2) (y1, y2) (z1, z2). unfold Qeq, Qmult, Qplus; simpl; simpl_mult; ring. Qed. (** Integrality *) Theorem Qmult_integral : forall x y, x*y==0 -> x==0 \/ y==0. Proof. intros (x1,x2) (y1,y2). unfold Qeq, Qmult; simpl. now rewrite <- Z.mul_eq_0, !Z.mul_1_r. Qed. Theorem Qmult_integral_l : forall x y, ~ x == 0 -> x*y == 0 -> y == 0. Proof. intros (x1, x2) (y1, y2). unfold Qeq, Qmult; simpl. rewrite !Z.mul_1_r, Z.mul_eq_0. intuition. Qed. (** * inject_Z is a ring homomorphism: *) Lemma inject_Z_plus (x y: Z): inject_Z (x + y) = inject_Z x + inject_Z y. Proof. unfold Qplus, inject_Z. simpl. f_equal. ring. Qed. Lemma inject_Z_mult (x y: Z): inject_Z (x * y) = inject_Z x * inject_Z y. Proof. reflexivity. Qed. Lemma inject_Z_opp (x: Z): inject_Z (- x) = - inject_Z x. Proof. reflexivity. Qed. (** * Inverse and division. *) Lemma Qinv_involutive : forall q, (/ / q) == q. Proof. intros [[|n|n] d]; red; simpl; reflexivity. Qed. Theorem Qmult_inv_r : forall x, ~ x == 0 -> x*(/x) == 1. Proof. intros (x1, x2); unfold Qeq, Qdiv, Qmult; case x1; simpl; intros H **; simpl_mult; try ring. elim H; auto. Qed. Lemma Qinv_mult_distr : forall p q, / (p * q) == /p * /q. Proof. intros (x1,x2) (y1,y2); unfold Qeq, Qinv, Qmult; simpl. destruct x1; simpl; auto; destruct y1; simpl; auto. Qed. Lemma Qinv_pos: forall (a b : positive), / (Z.pos b # a) == Z.pos a # b. Proof. intros a b. reflexivity. Qed. Lemma Qinv_neg: forall (a b : positive), / (Z.neg b # a) == Z.neg a # b. Proof. intros a b. reflexivity. Qed. Theorem Qdiv_mult_l : forall x y, ~ y == 0 -> (x*y)/y == x. Proof. intros x y H; unfold Qdiv. rewrite <- (Qmult_assoc x y (Qinv y)). rewrite (Qmult_inv_r y H). apply Qmult_1_r. Qed. Theorem Qmult_div_r : forall x y, ~ y == 0 -> y*(x/y) == x. Proof. intros x y ?; unfold Qdiv. rewrite (Qmult_assoc y x (Qinv y)). rewrite (Qmult_comm y x). fold (Qdiv (Qmult x y) y). apply Qdiv_mult_l; auto. Qed. Lemma Qinv_plus_distr : forall a b c, ((a # c) + (b # c) == (a+b) # c)%Q. Proof. intros. unfold Qeq. simpl. rewrite Pos2Z.inj_mul. ring. Qed. Lemma Qinv_minus_distr : forall a b c, (a # c) + - (b # c) == (a-b) # c. Proof. intros. unfold Qeq. simpl. rewrite Pos2Z.inj_mul. ring. Qed. (** Injectivity of Qmult (requires theory about Qinv above): *) Lemma Qmult_inj_r (x y z: Q): ~ z == 0 -> (x * z == y * z <-> x == y). Proof. intro z_ne_0. split; intro E. - rewrite <- (Qmult_1_r x), <- (Qmult_1_r y). rewrite <- (Qmult_inv_r z); auto. do 2 rewrite Qmult_assoc. rewrite E. reflexivity. - rewrite E. reflexivity. Qed. Lemma Qmult_inj_l (x y z: Q): ~ z == 0 -> (z * x == z * y <-> x == y). Proof. rewrite (Qmult_comm z x), (Qmult_comm z y). apply Qmult_inj_r. Qed. (** * Reduction and construction of Q *) (** ** Removal/introduction of common factor in both numerator and denominator. *) Lemma Qreduce_l : forall (a : Z) (b z : positive), (Zpos z)*a # z*b == a#b. Proof. intros a b z. unfold Qeq, Qnum, Qden. rewrite Pos2Z.inj_mul. ring. Qed. Lemma Qreduce_r : forall (a : Z) (b z : positive), a*(Zpos z) # b*z == a#b. Proof. intros a b z. unfold Qeq, Qnum, Qden. rewrite Pos2Z.inj_mul. ring. Qed. Lemma Qreduce_num_l : forall (a b : positive), Z.pos a # a * b == (1 # b). Proof. intros a b. unfold Qeq, Qnum, Qden. rewrite Pos2Z.inj_mul. ring. Qed. Lemma Qreduce_num_r : forall (a b : positive), Z.pos b # a * b == (1 # a). Proof. intros a b. unfold Qeq, Qnum, Qden. rewrite Pos2Z.inj_mul. ring. Qed. Lemma Qreduce_den_l : forall (a : positive) (b : Z), Z.pos a * b # a == (b # 1). Proof. intros a b. unfold Qeq, Qnum, Qden. ring. Qed. Lemma Qreduce_den_r : forall (a : Z) (b : positive), a * Z.pos b # b == (a # 1). Proof. intros a b. unfold Qeq, Qnum, Qden. ring. Qed. Lemma Qreduce_den_inject_Z_l : forall (a : positive) (b : Z), (Z.pos a * b # a == inject_Z b)%Q. Proof. intros a b. unfold Qeq, Qnum, Qden, inject_Z. ring. Qed. Lemma Qreduce_den_inject_Z_r : forall (a : Z) (b : positive), a * Z.pos b # b == inject_Z a. Proof. intros a b. unfold Qeq, Qnum, Qden, inject_Z. ring. Qed. Lemma Qreduce_zero: forall (d : positive), (0#d == 0)%Q. Proof. intros d. unfold Qeq, Qnum, Qden; reflexivity. Qed. (** ** Construction of a new rational by multiplication with an integer or pure fraction *) (** (or to be more precise multiplication with a rational of the form z/1 or 1/p) *) Lemma Qmult_inject_Z_l : forall (a : Z) (b : positive) (z : Z), (inject_Z z) * (a#b) == z*a#b. Proof. intros a b z. unfold Qeq. cbn. ring. Qed. Lemma Qmult_inject_Z_r : forall (a : Z) (b : positive) (z : Z), (a#b) * inject_Z z == a*z#b. Proof. intros a b z. unfold Qeq. cbn. rewrite Pos2Z.inj_mul. ring. Qed. Lemma Qmult_frac_l : forall (a:Z) (b c:positive), (a # (b * c)) == (1#b) * (a#c). Proof. intros a b c. unfold Qeq, Qnum, Qden; cbn. destruct a; reflexivity. Qed. Lemma Qmult_frac_r : forall (a:Z) (b c:positive), (a # (b * c)) == (a#b) * (1#c). Proof. intros a b c. unfold Qeq, Qnum, Qden; cbn. rewrite Pos2Z.inj_mul. ring. Qed. (** * Properties of order upon Q. *) Lemma Qle_refl x : x<=x. Proof. unfold Qle; auto with zarith. Qed. Lemma Qle_antisym x y : x<=y -> y<=x -> x==y. Proof. apply Z.le_antisymm. Qed. Lemma Qle_trans : forall x y z, x<=y -> y<=z -> x<=z. Proof. unfold Qle; intros (x1, x2) (y1, y2) (z1, z2); simpl; intros. Open Scope Z_scope. apply Z.mul_le_mono_pos_r with (Zpos y2); [easy|]. apply Z.le_trans with (y1 * Zpos x2 * Zpos z2). - rewrite Z.mul_shuffle0. now apply Z.mul_le_mono_pos_r. - rewrite Z.mul_shuffle0, (Z.mul_shuffle0 z1). now apply Z.mul_le_mono_pos_r. Close Scope Z_scope. Qed. #[global] Hint Resolve Qle_trans : qarith. Lemma Qlt_irrefl x : ~x ~ x==y. Proof. apply Z.lt_neq. Qed. Lemma Zle_Qle (x y: Z): (x <= y)%Z = (inject_Z x <= inject_Z y). Proof. unfold Qle. simpl. now rewrite !Z.mul_1_r. Qed. Lemma Zlt_Qlt (x y: Z): (x < y)%Z = (inject_Z x < inject_Z y). Proof. unfold Qlt. simpl. now rewrite !Z.mul_1_r. Qed. (** Large = strict or equal *) Lemma Qle_lteq x y : x<=y <-> x p <= q /\ ~ (p == q). Proof. intros p q; split; intros H. - rewrite Qlt_alt in H; rewrite Qle_alt, Qeq_alt. rewrite H; split; intros H1; inversion H1. - rewrite Qlt_alt; rewrite Qle_alt, Qeq_alt in H. destruct (p ?= q); tauto. Qed. Lemma Qlt_le_weak x y : x x<=y. Proof. apply Z.lt_le_incl. Qed. (** Qgt and Qge are just a notations, but one might not know this and search for these lemmas *) Lemma Qgt_lt: forall p q : Q, p > q -> q < p. Proof. intros p q H; assumption. Qed. Lemma Qlt_gt: forall p q : Q, p < q -> q > p. Proof. intros p q H; assumption. Qed. Lemma Qge_le: forall p q : Q, p >= q -> q <= p. Proof. intros p q H; assumption. Qed. Lemma Qle_ge: forall p q : Q, p <= q -> q >= p. Proof. intros p q H; assumption. Qed. Lemma Qle_lt_trans : forall x y z, x<=y -> y x y<=z -> x y x y <= x. Proof. apply Z.nlt_ge. Qed. Lemma Qnot_le_lt x y : ~ x <= y -> y < x. Proof. apply Z.nle_gt. Qed. Lemma Qlt_not_le x y : x < y -> ~ y <= x. Proof. apply Z.lt_nge. Qed. Lemma Qle_not_lt x y : x <= y -> ~ y < x. Proof. apply Z.le_ngt. Qed. Lemma Qle_lt_or_eq : forall x y, x<=y -> x -q <= -p. Proof. intros (a1,a2) (b1,b2); unfold Qle, Qlt; simpl. now rewrite !Z.mul_opp_l, <- Z.opp_le_mono. Qed. Lemma Qopp_lt_compat: forall p q : Q, p < q -> - q < - p. Proof. intros (a1,a2) (b1,b2); unfold Qle, Qlt; simpl. now rewrite !Z.mul_opp_l, <- Z.opp_lt_mono. Qed. #[global] Hint Resolve Qopp_le_compat Qopp_lt_compat : qarith. Lemma Qle_minus_iff : forall p q, p <= q <-> 0 <= q+-p. Proof. intros (x1,x2) (y1,y2); unfold Qle; simpl. rewrite Z.mul_1_r, Z.mul_opp_l, <- Z.le_sub_le_add_r, Z.opp_involutive. reflexivity. Qed. Lemma Qlt_minus_iff : forall p q, p < q <-> 0 < q+-p. Proof. intros (x1,x2) (y1,y2); unfold Qlt; simpl. rewrite Z.mul_1_r, Z.mul_opp_l, <- Z.lt_sub_lt_add_r, Z.opp_involutive. reflexivity. Qed. Lemma Qplus_le_compat : forall x y z t, x<=y -> z<=t -> x+z <= y+t. Proof. unfold Qplus, Qle; intros (x1, x2) (y1, y2) (z1, z2) (t1, t2); simpl; simpl_mult. Open Scope Z_scope. intros. match goal with |- ?a <= ?b => ring_simplify a b end. rewrite Z.add_comm. apply Z.add_le_mono. - match goal with |- ?a <= ?b => ring_simplify z1 t1 (Zpos z2) (Zpos t2) a b end. auto with zarith. - match goal with |- ?a <= ?b => ring_simplify x1 y1 (Zpos x2) (Zpos y2) a b end. auto with zarith. Close Scope Z_scope. Qed. Lemma Qplus_lt_le_compat : forall x y z t, x z<=t -> x+z < y+t. Proof. unfold Qplus, Qle, Qlt; intros (x1, x2) (y1, y2) (z1, z2) (t1, t2); simpl; simpl_mult. Open Scope Z_scope. intros. match goal with |- ?a < ?b => ring_simplify a b end. rewrite Z.add_comm. apply Z.add_le_lt_mono. - match goal with |- ?a <= ?b => ring_simplify z1 t1 (Zpos z2) (Zpos t2) a b end. auto with zarith. - match goal with |- ?a < ?b => ring_simplify x1 y1 (Zpos x2) (Zpos y2) a b end. do 2 (apply Z.mul_lt_mono_pos_r;try easy). Close Scope Z_scope. Qed. Lemma Qplus_le_l (x y z: Q): x + z <= y + z <-> x <= y. Proof. split; intros. - rewrite <- (Qplus_0_r x), <- (Qplus_0_r y), <- (Qplus_opp_r z). do 2 rewrite Qplus_assoc. apply Qplus_le_compat; auto with *. - apply Qplus_le_compat; auto with *. Qed. Lemma Qplus_le_r (x y z: Q): z + x <= z + y <-> x <= y. Proof. rewrite (Qplus_comm z x), (Qplus_comm z y). apply Qplus_le_l. Qed. Lemma Qplus_lt_l (x y z: Q): x + z < y + z <-> x < y. Proof. split; intros. - rewrite <- (Qplus_0_r x), <- (Qplus_0_r y), <- (Qplus_opp_r z). do 2 rewrite Qplus_assoc. apply Qplus_lt_le_compat; auto with *. - apply Qplus_lt_le_compat; auto with *. Qed. Lemma Qplus_lt_r (x y z: Q): z + x < z + y <-> x < y. Proof. rewrite (Qplus_comm z x), (Qplus_comm z y). apply Qplus_lt_l. Qed. Lemma Qplus_lt_compat : forall x y z t : Q, x < y -> z < t -> x + z < y + t. Proof. intros x y z t H1 H2. apply Qplus_lt_le_compat. - assumption. - apply Qle_lteq; left; assumption. Qed. (** ** Compatibility of multiplication with order. *) Lemma Qmult_le_compat_r : forall x y z, x <= y -> 0 <= z -> x*z <= y*z. Proof. intros (a1,a2) (b1,b2) (c1,c2); unfold Qle, Qlt; simpl. Open Scope Z_scope. rewrite Z.mul_1_r. intros; simpl_mult. rewrite Z.mul_shuffle1, (Z.mul_shuffle1 b1). apply Z.mul_le_mono_nonneg_r; auto. now apply Z.mul_nonneg_nonneg. Close Scope Z_scope. Qed. Lemma Qmult_lt_0_le_reg_r : forall x y z, 0 < z -> x*z <= y*z -> x <= y. Proof. intros (a1,a2) (b1,b2) (c1,c2); unfold Qle, Qlt; simpl. Open Scope Z_scope. simpl_mult. rewrite Z.mul_shuffle1, (Z.mul_shuffle1 b1). rewrite Z.mul_1_r. intros LT LE. apply Z.mul_le_mono_pos_r in LE; trivial. apply Z.mul_pos_pos; easy. Close Scope Z_scope. Qed. Lemma Qmult_le_r (x y z: Q): 0 < z -> (x*z <= y*z <-> x <= y). Proof. split; intro. - now apply Qmult_lt_0_le_reg_r with z. - apply Qmult_le_compat_r; auto with qarith. Qed. Lemma Qmult_le_l (x y z: Q): 0 < z -> (z*x <= z*y <-> x <= y). Proof. rewrite (Qmult_comm z x), (Qmult_comm z y). apply Qmult_le_r. Qed. Lemma Qmult_lt_compat_r : forall x y z, 0 < z -> x < y -> x*z < y*z. Proof. intros (a1,a2) (b1,b2) (c1,c2); unfold Qle, Qlt; simpl. Open Scope Z_scope. rewrite Z.mul_1_r. intros; simpl_mult. rewrite Z.mul_shuffle1, (Z.mul_shuffle1 b1). apply Z.mul_lt_mono_pos_r; auto with zarith. apply Z.mul_pos_pos; easy. Close Scope Z_scope. Qed. Lemma Qmult_lt_r: forall x y z, 0 < z -> (x*z < y*z <-> x < y). Proof. Open Scope Z_scope. intros (a1,a2) (b1,b2) (c1,c2). unfold Qle, Qlt; simpl. simpl_mult. rewrite Z.mul_shuffle1, (Z.mul_shuffle1 b1). rewrite Z.mul_1_r. intro LT. rewrite <- Z.mul_lt_mono_pos_r. - reflexivity. - now apply Z.mul_pos_pos. Close Scope Z_scope. Qed. Lemma Qmult_lt_l (x y z: Q): 0 < z -> (z*x < z*y <-> x < y). Proof. rewrite (Qmult_comm z x), (Qmult_comm z y). apply Qmult_lt_r. Qed. Lemma Qmult_le_0_compat : forall a b, 0 <= a -> 0 <= b -> 0 <= a*b. Proof. intros a b Ha Hb. unfold Qle in *. simpl in *. rewrite Z.mul_1_r in *. auto with *. Qed. Lemma Qmult_lt_0_compat : forall a b : Q, 0 < a -> 0 < b -> 0 < a * b. Proof. intros a b Ha Hb. destruct a,b. unfold Qlt, Qmult, QArith_base.Qnum, QArith_base.Qden in *. rewrite Pos2Z.inj_mul. rewrite Z.mul_0_l, Z.mul_1_r in *. apply Z.mul_pos_pos; assumption. Qed. Lemma Qmult_le_1_compat: forall a b : Q, 1 <= a -> 1 <= b -> 1 <= a * b. Proof. intros a b Ha Hb. destruct a,b. unfold Qle, Qmult, QArith_base.Qnum, QArith_base.Qden in *. rewrite Pos2Z.inj_mul. rewrite Z.mul_1_l, Z.mul_1_r in *. apply Z.mul_le_mono_nonneg. 2,4: assumption. 1,2: apply Pos2Z.is_nonneg. Qed. Lemma Qmult_lt_1_compat: forall a b : Q, 1 < a -> 1 < b -> 1 < a * b. Proof. intros a b Ha Hb. destruct a,b. unfold Qlt, Qmult, QArith_base.Qnum, QArith_base.Qden in *. rewrite Pos2Z.inj_mul. rewrite Z.mul_1_l, Z.mul_1_r in *. apply Z.mul_lt_mono_nonneg. 2,4: assumption. 1,2: apply Pos2Z.is_nonneg. Qed. Lemma Qmult_lt_compat_nonneg: forall x y z t : Q, 0 <= x < y -> 0 <= z < t -> x * z < y * t. Proof. intros [xn xd] [yn yd] [zn zd] [tn td] [H0lex Hxlty] [H0lez Hzltt]. unfold Qmult, Qlt, Qle, Qnum, Qden in *. rewrite Z.mul_0_l,Z.mul_1_r in H0lex, H0lez. do 2 rewrite Pos2Z.inj_mul. setoid_replace (xn * zn * (Z.pos yd * Z.pos td))%Z with ((xn * Z.pos yd) * (zn * Z.pos td))%Z by ring. setoid_replace (yn * tn * (Z.pos xd * Z.pos zd))%Z with ((yn * Z.pos xd) * (tn * Z.pos zd))%Z by ring. apply Z.mul_lt_mono_nonneg. 2,4 : assumption. 1,2 : rewrite <- (Z.mul_0_l 0); apply Z.mul_le_mono_nonneg; [reflexivity|assumption|reflexivity|apply Pos2Z.is_nonneg]. Qed. Lemma Qmult_le_lt_compat_pos: forall x y z t : Q, 0 < x <= y -> 0 < z < t -> x * z < y * t. Proof. intros [xn xd] [yn yd] [zn zd] [tn td] [H0ltx Hxlty] [H0ltz Hzltt]. unfold Qmult, Qlt, Qle, Qnum, Qden in *. rewrite Z.mul_0_l,Z.mul_1_r in H0ltx, H0ltz. do 2 rewrite Pos2Z.inj_mul. setoid_replace (xn * zn * (Z.pos yd * Z.pos td))%Z with ((xn * Z.pos yd) * (zn * Z.pos td))%Z by ring. setoid_replace (yn * tn * (Z.pos xd * Z.pos zd))%Z with ((yn * Z.pos xd) * (tn * Z.pos zd))%Z by ring. apply Zmult_lt_compat2; split. 2,4 : assumption. 1,2 : rewrite <- (Z.mul_0_l 0); apply Z.mul_lt_mono_nonneg; [reflexivity|assumption|reflexivity|apply Pos2Z.is_pos]. Qed. Lemma Qmult_le_compat_nonneg: forall x y z t : Q, 0 <= x <= y -> 0 <= z <= t -> x * z <= y * t. Proof. intros [xn xd] [yn yd] [zn zd] [tn td] [H0lex Hxlty] [H0lez Hzltt]. unfold Qmult, Qlt, Qle, Qnum, Qden in *. rewrite Z.mul_0_l,Z.mul_1_r in H0lex, H0lez. do 2 rewrite Pos2Z.inj_mul. setoid_replace (xn * zn * (Z.pos yd * Z.pos td))%Z with ((xn * Z.pos yd) * (zn * Z.pos td))%Z by ring. setoid_replace (yn * tn * (Z.pos xd * Z.pos zd))%Z with ((yn * Z.pos xd) * (tn * Z.pos zd))%Z by ring. apply Z.mul_le_mono_nonneg. 2,4 : assumption. 1,2 : rewrite <- (Z.mul_0_l 0); apply Z.mul_le_mono_nonneg; [reflexivity|assumption|reflexivity|apply Pos2Z.is_nonneg]. Qed. (** ** Compatibility of inversion and division with order *) Lemma Qinv_le_0_compat : forall a, 0 <= a -> 0 <= /a. Proof. intros [[|n|n] d] Ha; assumption. Qed. Lemma Qle_shift_div_l : forall a b c, 0 < c -> a*c <= b -> a <= b/c. Proof. intros a b c Hc H. apply Qmult_lt_0_le_reg_r with (c). - assumption. - setoid_replace (b/c*c) with (c*(b/c)) by apply Qmult_comm. rewrite Qmult_div_r; try assumption. auto with *. Qed. Lemma Qle_shift_inv_l : forall a c, 0 < c -> a*c <= 1 -> a <= /c. Proof. intros a c Hc H. setoid_replace (/c) with (1*/c) by (symmetry; apply Qmult_1_l). change (a <= 1/c). apply Qle_shift_div_l; assumption. Qed. Lemma Qle_shift_div_r : forall a b c, 0 < b -> a <= c*b -> a/b <= c. Proof. intros a b c Hc H. apply Qmult_lt_0_le_reg_r with b. - assumption. - setoid_replace (a/b*b) with (b*(a/b)) by apply Qmult_comm. rewrite Qmult_div_r; try assumption. auto with *. Qed. Lemma Qle_shift_inv_r : forall b c, 0 < b -> 1 <= c*b -> /b <= c. Proof. intros b c Hc H. setoid_replace (/b) with (1*/b) by (symmetry; apply Qmult_1_l). change (1/b <= c). apply Qle_shift_div_r; assumption. Qed. Lemma Qinv_lt_0_compat : forall a, 0 < a -> 0 < /a. Proof. intros [[|n|n] d] Ha; assumption. Qed. Lemma Qlt_shift_div_l : forall a b c, 0 < c -> a*c < b -> a < b/c. Proof. intros a b c Hc H. apply Qnot_le_lt. intros H0. apply (Qlt_not_le _ _ H). apply Qmult_lt_0_le_reg_r with (/c). - apply Qinv_lt_0_compat. assumption. - setoid_replace (a*c/c) with (a) by (apply Qdiv_mult_l; auto with *). assumption. Qed. Lemma Qlt_shift_inv_l : forall a c, 0 < c -> a*c < 1 -> a < /c. Proof. intros a c Hc H. setoid_replace (/c) with (1*/c) by (symmetry; apply Qmult_1_l). change (a < 1/c). apply Qlt_shift_div_l; assumption. Qed. Lemma Qlt_shift_div_r : forall a b c, 0 < b -> a < c*b -> a/b < c. Proof. intros a b c Hc H. apply Qnot_le_lt. intros H0. apply (Qlt_not_le _ _ H). apply Qmult_lt_0_le_reg_r with (/b). - apply Qinv_lt_0_compat. assumption. - setoid_replace (c*b/b) with (c) by (apply Qdiv_mult_l; auto with *). assumption. Qed. Lemma Qlt_shift_inv_r : forall b c, 0 < b -> 1 < c*b -> /b < c. Proof. intros b c Hc H. setoid_replace (/b) with (1*/b) by (symmetry; apply Qmult_1_l). change (1/b < c). apply Qlt_shift_div_r; assumption. Qed. Lemma Qinv_lt_contravar : forall a b : Q, 0 < a -> 0 < b -> (a < b <-> /b < /a). Proof. intros a b H H0. split. - intro H1. rewrite <- Qmult_1_l. apply Qlt_shift_div_r. + apply H0. + rewrite <- (Qmult_inv_r a). * rewrite Qmult_comm. apply Qmult_lt_l. -- apply Qinv_lt_0_compat. apply H. -- apply H1. * intro abs. rewrite abs in H. apply (Qlt_irrefl 0 H). - intro H1. rewrite <- (Qinv_involutive b). rewrite <- (Qmult_1_l (// b)). apply Qlt_shift_div_l. + apply Qinv_lt_0_compat. apply H0. + rewrite <- (Qmult_inv_r a). * apply Qmult_lt_l. -- apply H. -- apply H1. * intro abs. rewrite abs in H. apply (Qlt_irrefl 0 H). Qed. (** * Rational to the n-th power *) Definition Qpower_positive : Q -> positive -> Q := pow_pos Qmult. #[global] Instance Qpower_positive_comp : Proper (Qeq==>eq==>Qeq) Qpower_positive. Proof. intros x x' Hx y y' Hy. rewrite <-Hy; clear y' Hy. unfold Qpower_positive. induction y as [y IHy|y IHy|]; simpl; try rewrite IHy; try rewrite Hx; reflexivity. Qed. Definition Qpower (q:Q) (z:Z) := match z with | Zpos p => Qpower_positive q p | Z0 => 1 | Zneg p => /Qpower_positive q p end. Notation " q ^ z " := (Qpower q z) : Q_scope. Register Qpower as rat.Q.Qpower. #[global] Instance Qpower_comp : Proper (Qeq==>eq==>Qeq) Qpower. Proof. intros x x' Hx y y' Hy. rewrite <- Hy; clear y' Hy. destruct y; simpl; rewrite ?Hx; auto with *. Qed. coq-8.20.0/theories/QArith/QOrderedType.v000066400000000000000000000036521466560755400201630ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* Qeq==>iff) Qlt. Proof. auto with *. Qed. Definition le_lteq := Qle_lteq. Definition compare_spec := Qcompare_spec. End Q_as_OT. (** * An [order] tactic for [Q] numbers *) Module QOrder := OTF_to_OrderTac Q_as_OT. Ltac q_order := QOrder.order. (** Note that [q_order] is domain-agnostic: it will not prove [1<=2] or [x<=x+x], but rather things like [x<=y -> y<=x -> x==y]. *) coq-8.20.0/theories/QArith/Qabs.v000066400000000000000000000131421466560755400164750ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* Type), (0 <= x -> P x) -> (x <= 0 -> P (- x)) -> P (Qabs x). Proof. intros x P H1 H2. destruct x as [[|xn|xn] xd]; [apply H1|apply H1|apply H2]; abstract (compute; discriminate). Defined. Add Morphism Qabs with signature Qeq ==> Qeq as Qabs_wd. intros [xn xd] [yn yd] H. simpl. unfold Qeq in *. simpl in *. change (Zpos yd)%Z with (Z.abs (Zpos yd)). change (Zpos xd)%Z with (Z.abs (Zpos xd)). repeat rewrite <- Z.abs_mul. congruence. Qed. Lemma Qabs_pos : forall x, 0 <= x -> Qabs x == x. Proof. intros x H. apply Qabs_case. - reflexivity. - intros H0. setoid_replace x with 0. + reflexivity. + apply Qle_antisym; assumption. Qed. Lemma Qabs_neg : forall x, x <= 0 -> Qabs x == - x. Proof. intros x H. apply Qabs_case. - intros H0. setoid_replace x with 0. + reflexivity. + apply Qle_antisym; assumption. - reflexivity. Qed. Lemma Qabs_nonneg : forall x, 0 <= (Qabs x). intros x. apply Qabs_case. - auto. - apply (Qopp_le_compat x 0). Qed. Lemma Zabs_Qabs : forall n d, (Z.abs n#d)==Qabs (n#d). Proof. intros [|n|n]; reflexivity. Qed. Lemma Qabs_opp : forall x, Qabs (-x) == Qabs x. Proof. intros x. do 2 apply Qabs_case; try (intros; ring); (intros H0 H1; setoid_replace x with 0;[reflexivity|]; apply Qle_antisym);try assumption; rewrite Qle_minus_iff in *; ring_simplify; ring_simplify in H1; assumption. Qed. Lemma Qabs_triangle : forall x y, Qabs (x+y) <= Qabs x + Qabs y. Proof. intros [xn xd] [yn yd]. unfold Qplus. unfold Qle. simpl. apply Z.mul_le_mono_nonneg_r;auto with *. change (Zpos yd)%Z with (Z.abs (Zpos yd)). change (Zpos xd)%Z with (Z.abs (Zpos xd)). repeat rewrite <- Z.abs_mul. apply Z.abs_triangle. Qed. Lemma Qabs_Qmult : forall a b, Qabs (a*b) == (Qabs a)*(Qabs b). Proof. intros [an ad] [bn bd]. simpl. rewrite Z.abs_mul. reflexivity. Qed. Lemma Qabs_Qinv : forall q, Qabs (/ q) == / (Qabs q). Proof. intros [n d]; simpl. unfold Qinv. case_eq n; intros; simpl in *; apply Qeq_refl. Qed. Lemma Qabs_Qminus x y: Qabs (x - y) = Qabs (y - x). Proof. unfold Qminus, Qopp. simpl. rewrite Pos.mul_comm, <- Z.abs_opp. do 2 f_equal. ring. Qed. Lemma Qle_Qabs : forall a, a <= Qabs a. Proof. intros a. apply Qabs_case; auto with *. intros H. apply Qle_trans with 0; try assumption. change 0 with (-0). apply Qopp_le_compat. assumption. Qed. Lemma Qabs_triangle_reverse : forall x y, Qabs x - Qabs y <= Qabs (x - y). Proof. intros x y. rewrite Qle_minus_iff. setoid_replace (Qabs (x - y) + - (Qabs x - Qabs y)) with ((Qabs (x - y) + Qabs y) + - Qabs x) by ring. rewrite <- Qle_minus_iff. setoid_replace (Qabs x) with (Qabs (x-y+y)). - apply Qabs_triangle. - apply Qabs_wd. ring. Qed. Lemma Qabs_Qle_condition x y: Qabs x <= y <-> -y <= x <= y. Proof. split. - split. + rewrite <- (Qopp_opp x). apply Qopp_le_compat. apply Qle_trans with (Qabs (-x)). * apply Qle_Qabs. * now rewrite Qabs_opp. + apply Qle_trans with (Qabs x); auto using Qle_Qabs. - intros (H,H'). apply Qabs_case; trivial. intros. rewrite <- (Qopp_opp y). now apply Qopp_le_compat. Qed. Lemma Qabs_Qlt_condition: forall x y : Q, Qabs x < y <-> -y < x < y. Proof. split. - split. + rewrite <- (Qopp_opp x). apply Qopp_lt_compat. apply Qle_lt_trans with (Qabs (-x)). * apply Qle_Qabs. * now rewrite Qabs_opp. + apply Qle_lt_trans with (Qabs x); auto using Qle_Qabs. - intros (H,H'). apply Qabs_case; trivial. intros. rewrite <- (Qopp_opp y). now apply Qopp_lt_compat. Qed. Lemma Qabs_diff_Qle_condition x y r: Qabs (x - y) <= r <-> x - r <= y <= x + r. Proof. intros. unfold Qminus. rewrite Qabs_Qle_condition. rewrite <- (Qplus_le_l (-r) (x+-y) (y+r)). rewrite <- (Qplus_le_l (x+-y) r (y-r)). setoid_replace (-r + (y + r)) with y by ring. setoid_replace (r + (y - r)) with y by ring. setoid_replace (x + - y + (y + r)) with (x + r) by ring. setoid_replace (x + - y + (y - r)) with (x - r) by ring. intuition. Qed. Lemma Qabs_diff_Qlt_condition x y r: Qabs (x - y) < r <-> x - r < y < x + r. Proof. intros. unfold Qminus. rewrite Qabs_Qlt_condition. rewrite <- (Qplus_lt_l (-r) (x+-y) (y+r)). rewrite <- (Qplus_lt_l (x+-y) r (y-r)). setoid_replace (-r + (y + r)) with y by ring. setoid_replace (r + (y - r)) with y by ring. setoid_replace (x + - y + (y + r)) with (x + r) by ring. setoid_replace (x + - y + (y - r)) with (x - r) by ring. intuition. Qed. Lemma Qabs_ge: forall r s : Q, r <= s -> r <= Qabs s. Proof. intros r s Hrles. apply Qabs_case; intros Hs. - exact Hrles. - pose proof Qle_trans _ _ _ Hrles Hs as Hr. apply Qopp_le_compat in Hs. exact (Qle_trans _ _ _ Hr Hs). Qed. Lemma Qabs_gt: forall r s : Q, r < s -> r < Qabs s. Proof. intros r s Hrlts. apply Qabs_case; intros Hs. - exact Hrlts. - pose proof Qlt_le_trans _ _ _ Hrlts Hs as Hr. apply Qopp_le_compat in Hs. exact (Qlt_le_trans _ _ _ Hr Hs). Qed. coq-8.20.0/theories/QArith/Qcabs.v000066400000000000000000000105411466560755400166400ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* Qred (Qabs x) = Qabs x. Proof. intros H; now rewrite (Qred_abs x), H. Qed. Definition Qcabs (x:Qc) : Qc := {| canon := Qcabs_canon x (canon x) |}. Notation "[ q ]" := (Qcabs q) : Qc_scope. Ltac Qc_unfolds := unfold Qcabs, Qcminus, Qcopp, Qcplus, Qcmult, Qcle, Q2Qc, this. Lemma Qcabs_case (x:Qc) (P : Qc -> Type) : (0 <= x -> P x) -> (x <= 0 -> P (- x)) -> P [x]. Proof. intros A B. apply (Qabs_case x (fun x => forall Hx, P {|this:=x;canon:=Hx|})). - intros; case (Qc_decomp x {|canon:=Hx|}); auto. - intros; case (Qc_decomp (-x) {|canon:=Hx|}); auto. Qed. Lemma Qcabs_pos x : 0 <= x -> [x] = x. Proof. intro Hx; apply Qc_decomp; Qc_unfolds; fold (this x). set (K := canon [x]); simpl in K; case K; clear K. set (a := x) at 1; case (canon x); subst a; apply Qred_complete. now apply Qabs_pos. Qed. Lemma Qcabs_neg x : x <= 0 -> [x] = - x. Proof. intro Hx; apply Qc_decomp; Qc_unfolds; fold (this x). set (K := canon [x]); simpl in K; case K; clear K. now apply Qred_complete; apply Qabs_neg. Qed. Lemma Qcabs_nonneg x : 0 <= [x]. Proof. intros; apply Qabs_nonneg. Qed. Lemma Qcabs_opp x : [(-x)] = [x]. Proof. apply Qc_decomp; Qc_unfolds; fold (this x). set (K := canon [x]); simpl in K; case K; clear K. case Qred_abs; apply Qred_complete; apply Qabs_opp. Qed. Lemma Qcabs_triangle x y : [x+y] <= [x] + [y]. Proof. Qc_unfolds; case Qred_abs; rewrite !Qred_le; apply Qabs_triangle. Qed. Lemma Qcabs_Qcmult x y : [x*y] = [x]*[y]. Proof. apply Qc_decomp; Qc_unfolds; fold (this x) (this y); case Qred_abs. apply Qred_complete; apply Qabs_Qmult. Qed. Lemma Qcabs_Qcminus x y: [x-y] = [y-x]. Proof. apply Qc_decomp; Qc_unfolds; fold (this x) (this y) (this (-x)) (this (-y)). set (a := x) at 2; case (canon x); subst a. set (a := y) at 1; case (canon y); subst a. rewrite !Qred_opp; fold (Qred x - Qred y)%Q (Qred y - Qred x)%Q. repeat case Qred_abs; f_equal; apply Qabs_Qminus. Qed. Lemma Qcle_Qcabs x : x <= [x]. Proof. apply Qle_Qabs. Qed. Lemma Qcabs_triangle_reverse x y : [x] - [y] <= [x - y]. Proof. unfold Qcle, Qcabs, Qcminus, Qcplus, Qcopp, Q2Qc, this; fold (this x) (this y) (this (-x)) (this (-y)). case Qred_abs; rewrite !Qred_le, !Qred_opp, Qred_abs. apply Qabs_triangle_reverse. Qed. Lemma Qcabs_Qcle_condition x y : [x] <= y <-> -y <= x <= y. Proof. Qc_unfolds; fold (this x) (this y). destruct (Qabs_Qle_condition x y) as [A B]. split; intros H. + destruct (A H) as [X Y]; split; auto. now case (canon x); apply Qred_le. + destruct H as [X Y]; apply B; split; auto. now case (canon y); case Qred_opp. Qed. Lemma Qcabs_diff_Qcle_condition x y r : [x-y] <= r <-> x - r <= y <= x + r. Proof. Qc_unfolds; fold (this x) (this y) (this r). case Qred_abs; repeat rewrite Qred_opp. set (a := y) at 1; case (canon y); subst a. set (a := r) at 2; case (canon r); subst a. set (a := Qred r) at 2 3; assert (K := canon (Q2Qc r)); simpl in K; case K; clear K; subst a. set (a := Qred y) at 1; assert (K := canon (Q2Qc y)); simpl in K; case K; clear K; subst a. fold (x - Qred y)%Q (x - Qred r)%Q. destruct (Qabs_diff_Qle_condition x (Qred y) (Qred r)) as [A B]. split. + clear B; rewrite !Qred_le. auto. + clear A; rewrite !Qred_le. auto. Qed. Lemma Qcabs_null x : [x] = 0 -> x = 0. Proof. intros H. destruct (proj1 (Qcabs_Qcle_condition x 0)) as [A B]. + rewrite H; apply Qcle_refl. + apply Qcle_antisym; auto. Qed. coq-8.20.0/theories/QArith/Qcanon.v000066400000000000000000000314371466560755400170350ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* Q ; canon : Qred this = this }. Declare Scope Qc_scope. Delimit Scope Qc_scope with Qc. Bind Scope Qc_scope with Qc. Arguments Qcmake this%_Q _. Open Scope Qc_scope. (** An alternative statement of [Qred q = q] via [Z.gcd] *) Lemma Qred_identity : forall q:Q, Z.gcd (Qnum q) (QDen q) = 1%Z -> Qred q = q. Proof. intros (a,b) H; simpl in *. rewrite <- Z.ggcd_gcd in H. generalize (Z.ggcd_correct_divisors a (Zpos b)). destruct Z.ggcd as (g,(aa,bb)); simpl in *; subst. rewrite !Z.mul_1_l. now intros (<-,<-). Qed. Lemma Qred_identity2 : forall q:Q, Qred q = q -> Z.gcd (Qnum q) (QDen q) = 1%Z. Proof. intros (a,b) H; simpl in *. generalize (Z.gcd_nonneg a (Zpos b)) (Z.ggcd_correct_divisors a (Zpos b)). rewrite <- Z.ggcd_gcd. destruct Z.ggcd as (g,(aa,bb)); simpl in *. injection H as [= <- <-]. intros H (_,H'). destruct g as [|g|g]; [ discriminate | | now elim H ]. destruct bb as [|b|b]; simpl in *; try discriminate. injection H' as [= H']. f_equal. apply Pos.mul_reg_r with b. now rewrite Pos.mul_1_l. Qed. Lemma Qred_iff : forall q:Q, Qred q = q <-> Z.gcd (Qnum q) (QDen q) = 1%Z. Proof. split; intros. - apply Qred_identity2; auto. - apply Qred_identity; auto. Qed. (** Coercion from [Qc] to [Q] and equality *) Lemma Qc_is_canon : forall q q' : Qc, q == q' -> q = q'. Proof. intros (q,hq) (q',hq') H. simpl in *. assert (H' := Qred_complete _ _ H). rewrite hq, hq' in H'. subst q'. f_equal. apply eq_proofs_unicity. intros. repeat decide equality. Qed. #[global] Hint Resolve Qc_is_canon : core. Theorem Qc_decomp: forall q q': Qc, (q:Q) = q' -> q = q'. Proof. intros. apply Qc_is_canon. now rewrite H. Qed. (** [Q2Qc] : a conversion from [Q] to [Qc]. *) Lemma Qred_involutive : forall q:Q, Qred (Qred q) = Qred q. Proof. intros; apply Qred_complete. apply Qred_correct. Qed. Definition Q2Qc (q:Q) : Qc := Qcmake (Qred q) (Qred_involutive q). Arguments Q2Qc q%_Q. Lemma Q2Qc_eq_iff (q q' : Q) : Q2Qc q = Q2Qc q' <-> q == q'. Proof. split; intro H. - now injection H as [= H%Qred_eq_iff]. - apply Qc_is_canon. simpl. now rewrite H. Qed. Notation " 0 " := (Q2Qc 0) : Qc_scope. Notation " 1 " := (Q2Qc 1) : Qc_scope. Definition Qcle (x y : Qc) := (x <= y)%Q. Definition Qclt (x y : Qc) := (x < y)%Q. Notation Qcgt := (fun x y : Qc => Qlt y x). Notation Qcge := (fun x y : Qc => Qle y x). Infix "<" := Qclt : Qc_scope. Infix "<=" := Qcle : Qc_scope. Infix ">" := Qcgt : Qc_scope. Infix ">=" := Qcge : Qc_scope. Notation "x <= y <= z" := (x<=y/\y<=z) : Qc_scope. Notation "x < y < z" := (x (p ?= q) = Eq. Proof. unfold Qccompare. intros; rewrite <- Qeq_alt. split; auto. now intros <-. Qed. Lemma Qclt_alt : forall p q, (p (p?=q = Lt). Proof. intros; exact (Qlt_alt p q). Qed. Lemma Qcgt_alt : forall p q, (p>q) <-> (p?=q = Gt). Proof. intros; exact (Qgt_alt p q). Qed. Lemma Qcle_alt : forall p q, (p<=q) <-> (p?=q <> Gt). Proof. intros; exact (Qle_alt p q). Qed. Lemma Qcge_alt : forall p q, (p>=q) <-> (p?=q <> Lt). Proof. intros; exact (Qge_alt p q). Qed. (** equality on [Qc] is decidable: *) Theorem Qc_eq_dec : forall x y:Qc, {x=y} + {x<>y}. Proof. intros. destruct (Qeq_dec x y) as [H|H]; auto. right; contradict H; subst; auto with qarith. Defined. (** The addition, multiplication and opposite are defined in the straightforward way: *) Definition Qcplus (x y : Qc) := Q2Qc (x+y). Infix "+" := Qcplus : Qc_scope. Definition Qcmult (x y : Qc) := Q2Qc (x*y). Infix "*" := Qcmult : Qc_scope. Definition Qcopp (x : Qc) := Q2Qc (-x). Notation "- x" := (Qcopp x) : Qc_scope. Definition Qcminus (x y : Qc) := x+-y. Infix "-" := Qcminus : Qc_scope. Definition Qcinv (x : Qc) := Q2Qc (/x). Notation "/ x" := (Qcinv x) : Qc_scope. Definition Qcdiv (x y : Qc) := x*/y. Infix "/" := Qcdiv : Qc_scope. (** [0] and [1] are apart *) Lemma Q_apart_0_1 : 1 <> 0. Proof. unfold Q2Qc. intros H; discriminate H. Qed. Ltac qc := match goal with | q:Qc |- _ => destruct q; qc | _ => apply Qc_is_canon; simpl; rewrite !Qred_correct end. Opaque Qred. (** Addition is associative: *) Theorem Qcplus_assoc : forall x y z, x+(y+z)=(x+y)+z. Proof. intros; qc; apply Qplus_assoc. Qed. (** [0] is a neutral element for addition: *) Lemma Qcplus_0_l : forall x, 0+x = x. Proof. intros; qc; apply Qplus_0_l. Qed. Lemma Qcplus_0_r : forall x, x+0 = x. Proof. intros; qc; apply Qplus_0_r. Qed. (** Commutativity of addition: *) Theorem Qcplus_comm : forall x y, x+y = y+x. Proof. intros; qc; apply Qplus_comm. Qed. (** Properties of [Qopp] *) Lemma Qcopp_involutive : forall q, - -q = q. Proof. intros; qc; apply Qopp_involutive. Qed. Theorem Qcplus_opp_r : forall q, q+(-q) = 0. Proof. intros; qc; apply Qplus_opp_r. Qed. (** Multiplication is associative: *) Theorem Qcmult_assoc : forall n m p, n*(m*p)=(n*m)*p. Proof. intros; qc; apply Qmult_assoc. Qed. (** [0] is absorbing for multiplication: *) Lemma Qcmult_0_l : forall n, 0*n = 0. Proof. intros; qc; split. Qed. Theorem Qcmult_0_r : forall n, n*0=0. Proof. intros; qc; rewrite Qmult_comm; split. Qed. (** [1] is a neutral element for multiplication: *) Lemma Qcmult_1_l : forall n, 1*n = n. Proof. intros; qc; apply Qmult_1_l. Qed. Theorem Qcmult_1_r : forall n, n*1=n. Proof. intros; qc; apply Qmult_1_r. Qed. (** Commutativity of multiplication *) Theorem Qcmult_comm : forall x y, x*y=y*x. Proof. intros; qc; apply Qmult_comm. Qed. (** Distributivity *) Theorem Qcmult_plus_distr_r : forall x y z, x*(y+z)=(x*y)+(x*z). Proof. intros; qc; apply Qmult_plus_distr_r. Qed. Theorem Qcmult_plus_distr_l : forall x y z, (x+y)*z=(x*z)+(y*z). Proof. intros; qc; apply Qmult_plus_distr_l. Qed. (** Integrality *) Theorem Qcmult_integral : forall x y, x*y=0 -> x=0 \/ y=0. Proof. intros. destruct (Qmult_integral x y); try qc; auto. injection H as [= H]. rewrite <- (Qred_correct (x*y)). rewrite <- (Qred_correct 0). rewrite H; auto with qarith. Qed. Theorem Qcmult_integral_l : forall x y, ~ x = 0 -> x*y = 0 -> y = 0. Proof. intros; destruct (Qcmult_integral _ _ H0); tauto. Qed. (** Inverse and division. *) Theorem Qcmult_inv_r : forall x, x<>0 -> x*(/x) = 1. Proof. intros; qc; apply Qmult_inv_r; auto. Qed. Theorem Qcmult_inv_l : forall x, x<>0 -> (/x)*x = 1. Proof. intros. rewrite Qcmult_comm. apply Qcmult_inv_r; auto. Qed. Lemma Qcinv_mult_distr : forall p q, / (p * q) = /p * /q. Proof. intros; qc; apply Qinv_mult_distr. Qed. Theorem Qcdiv_mult_l : forall x y, y<>0 -> (x*y)/y = x. Proof. unfold Qcdiv. intros. rewrite <- Qcmult_assoc. rewrite Qcmult_inv_r; auto. apply Qcmult_1_r. Qed. Theorem Qcmult_div_r : forall x y, ~ y = 0 -> y*(x/y) = x. Proof. unfold Qcdiv. intros. rewrite Qcmult_assoc. rewrite Qcmult_comm. rewrite Qcmult_assoc. rewrite Qcmult_inv_l; auto. apply Qcmult_1_l. Qed. (** Properties of order upon Qc. *) Lemma Qcle_refl : forall x, x<=x. Proof. unfold Qcle; intros; simpl; apply Qle_refl. Qed. Lemma Qcle_antisym : forall x y, x<=y -> y<=x -> x=y. Proof. unfold Qcle; intros; simpl in *. apply Qc_is_canon; apply Qle_antisym; auto. Qed. Lemma Qcle_trans : forall x y z, x<=y -> y<=z -> x<=z. Proof. unfold Qcle; intros; eapply Qle_trans; eauto. Qed. Lemma Qclt_not_eq : forall x y, x x<>y. Proof. unfold Qclt; intros; simpl in *. intro; destruct (Qlt_not_eq _ _ H). subst; auto with qarith. Qed. (** Large = strict or equal *) Lemma Qclt_le_weak : forall x y, x x<=y. Proof. unfold Qcle, Qclt; intros; apply Qlt_le_weak; auto. Qed. Lemma Qcle_lt_trans : forall x y z, x<=y -> y x y<=z -> x y x y<=x. Proof. unfold Qcle, Qclt; intros; apply Qnot_lt_le; auto. Qed. Lemma Qcnot_le_lt : forall x y, ~ x<=y -> y ~ y<=x. Proof. unfold Qcle, Qclt; intros; apply Qlt_not_le; auto. Qed. Lemma Qcle_not_lt : forall x y, x<=y -> ~ y x -q <= -p. Proof. unfold Qcle, Qcopp; intros; simpl in *. repeat rewrite Qred_correct. apply Qopp_le_compat; auto. Qed. Lemma Qcle_minus_iff : forall p q, p <= q <-> 0 <= q+-p. Proof. unfold Qcle, Qcminus; intros; simpl in *. repeat rewrite Qred_correct. apply Qle_minus_iff; auto. Qed. Lemma Qclt_minus_iff : forall p q, p < q <-> 0 < q+-p. Proof. unfold Qclt, Qcplus, Qcopp; intros; simpl in *. repeat rewrite Qred_correct. apply Qlt_minus_iff; auto. Qed. Lemma Qcplus_le_compat : forall x y z t, x<=y -> z<=t -> x+z <= y+t. Proof. unfold Qcplus, Qcle; intros; simpl in *. repeat rewrite Qred_correct. apply Qplus_le_compat; auto. Qed. Lemma Qcmult_le_compat_r : forall x y z, x <= y -> 0 <= z -> x*z <= y*z. Proof. unfold Qcmult, Qcle; intros; simpl in *. repeat rewrite Qred_correct. apply Qmult_le_compat_r; auto. Qed. Lemma Qcmult_lt_0_le_reg_r : forall x y z, 0 < z -> x*z <= y*z -> x <= y. Proof. unfold Qcmult, Qcle, Qclt; intros; simpl in *. rewrite !Qred_correct in * |-. eapply Qmult_lt_0_le_reg_r; eauto. Qed. Lemma Qcmult_lt_compat_r : forall x y z, 0 < z -> x < y -> x*z < y*z. Proof. unfold Qcmult, Qclt; intros; simpl in *. rewrite !Qred_correct in *. eapply Qmult_lt_compat_r; eauto. Qed. (** Rational to the n-th power *) Fixpoint Qcpower (q:Qc)(n:nat) : Qc := match n with | O => 1 | S n => q * (Qcpower q n) end. Notation " q ^ n " := (Qcpower q n) : Qc_scope. Lemma Qcpower_1 : forall n, 1^n = 1. Proof. induction n; simpl; auto with qarith. rewrite IHn; auto with qarith. Qed. Lemma Qcpower_0 : forall n, n<>O -> 0^n = 0. Proof. destruct n; simpl. - destruct 1; auto. - intros. now apply Qc_is_canon. Qed. Lemma Qcpower_pos : forall p n, 0 <= p -> 0 <= p^n. Proof. induction n; simpl; auto with qarith. - easy. - intros. apply Qcle_trans with (0*(p^n)). + easy. + apply Qcmult_le_compat_r; auto. Qed. (** And now everything is easier concerning tactics: *) (** A ring tactic for rational numbers *) Definition Qc_eq_bool (x y : Qc) := if Qc_eq_dec x y then true else false. Lemma Qc_eq_bool_correct : forall x y : Qc, Qc_eq_bool x y = true -> x=y. Proof. intros x y; unfold Qc_eq_bool; case (Qc_eq_dec x y); simpl; auto. intros _ H; inversion H. Qed. Definition Qcrt : ring_theory 0 1 Qcplus Qcmult Qcminus Qcopp (eq(A:=Qc)). Proof. constructor. - exact Qcplus_0_l. - exact Qcplus_comm. - exact Qcplus_assoc. - exact Qcmult_1_l. - exact Qcmult_comm. - exact Qcmult_assoc. - exact Qcmult_plus_distr_l. - reflexivity. - exact Qcplus_opp_r. Qed. Definition Qcft : field_theory 0%Qc 1%Qc Qcplus Qcmult Qcminus Qcopp Qcdiv Qcinv (eq(A:=Qc)). Proof. constructor. - exact Qcrt. - exact Q_apart_0_1. - reflexivity. - exact Qcmult_inv_l. Qed. Add Field Qcfield : Qcft. (** A field tactic for rational numbers *) Example test_field : (forall x y : Qc, y<>0 -> (x/y)*y = x)%Qc. Proof. intros. field. auto. Qed. coq-8.20.0/theories/QArith/Qfield.v000066400000000000000000000057721466560755400170250ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* isZcst z | Qmake ?n ?d => match isZcst n with true => isPcst d | _ => false end | _ => false end. Ltac Qcst t := match isQcst t with true => t | _ => NotConstant end. Ltac Qpow_tac t := match t with | Z0 => N0 | Zpos ?n => Ncst (Npos n) | Z.of_N ?n => Ncst n | NtoZ ?n => Ncst n | _ => NotConstant end. Add Field Qfield : Qsft (decidable Qeq_bool_eq, completeness Qeq_eq_bool, constants [Qcst], power_tac Qpower_theory [Qpow_tac]). (** Exemple of use: *) Section Examples. Section Ex1. Let ex1 : forall x y z : Q, (x+y)*z == (x*z)+(y*z). intros. ring. Defined. End Ex1. Section Ex2. Let ex2 : forall x y : Q, x+y == y+x. intros. ring. Defined. End Ex2. Section Ex3. Let ex3 : forall x y z : Q, (x+y)+z == x+(y+z). intros. ring. Defined. End Ex3. Section Ex4. Let ex4 : (inject_Z 1)+(inject_Z 1)==(inject_Z 2). ring. Defined. End Ex4. Section Ex5. Let ex5 : 1+1 == 2#1. ring. Defined. End Ex5. Section Ex6. Let ex6 : (1#1)+(1#1) == 2#1. ring. Defined. End Ex6. Section Ex7. Let ex7 : forall x : Q, x-x== 0. intro. ring. Defined. End Ex7. Section Ex8. Let ex8 : forall x : Q, x^1 == x. intro. ring. Defined. End Ex8. Section Ex9. Let ex9 : forall x : Q, x^0 == 1. intro. ring. Defined. End Ex9. Section Ex10. Let ex10 : forall x y : Q, ~(y==0) -> (x/y)*y == x. intros. field. auto. Defined. End Ex10. End Examples. Lemma Qopp_plus : forall a b, -(a+b) == -a + -b. Proof. intros; ring. Qed. Lemma Qopp_opp : forall q, - -q==q. Proof. intros; ring. Qed. coq-8.20.0/theories/QArith/Qminmax.v000066400000000000000000000043451466560755400172260ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* ~Qpower_positive a n == 0. Proof. intros a n X H. apply X; clear X. induction n; simpl in *; try assumption; destruct (Qmult_integral _ _ H); try destruct (Qmult_integral _ _ H0); auto. Qed. Lemma Qpower_pos_positive : forall p n, 0 <= p -> 0 <= Qpower_positive p n. Proof. intros p n Hp. induction n; simpl; repeat apply Qmult_le_0_compat;assumption. Qed. (** ** Qpower_positive and multiplication, exponent subtraction *) Lemma Qmult_power_positive : forall a b n, Qpower_positive (a*b) n == (Qpower_positive a n)*(Qpower_positive b n). Proof. induction n; simpl; repeat rewrite IHn; ring. Qed. Lemma Qpower_plus_positive : forall a n m, Qpower_positive a (n+m) == (Qpower_positive a n)*(Qpower_positive a m). Proof. intros a n m. unfold Qpower_positive. apply pow_pos_add. - apply Q_Setoid. - apply Qmult_comp. - apply Qmult_assoc. Qed. (** ** Qpower_positive and inversion, division, exponent subtraction *) Lemma Qinv_power_positive : forall a n, Qpower_positive (/a) n == /(Qpower_positive a n). Proof. induction n; simpl; repeat (rewrite IHn || rewrite Qinv_mult_distr); reflexivity. Qed. Lemma Qpower_minus_positive : forall a (n m:positive), (m < n)%positive -> Qpower_positive a (n-m)%positive == (Qpower_positive a n)/(Qpower_positive a m). Proof. intros a n m H. destruct (Qeq_dec a 0) as [EQ|NEQ]. - now rewrite EQ, !Qpower_positive_0. - rewrite <- (Qdiv_mult_l (Qpower_positive a (n - m)) (Qpower_positive a m)) by (now apply Qpower_not_0_positive). f_equiv. rewrite <- Qpower_plus_positive. now rewrite Pos.sub_add. Qed. (** ** Qpower and exponent multiplication *) Lemma Qpower_mult_positive : forall a n m, Qpower_positive a (n*m) == Qpower_positive (Qpower_positive a n) m. Proof. intros a n m. induction n using Pos.peano_ind. - reflexivity. - rewrite Pos.mul_succ_l. rewrite <- Pos.add_1_l. do 2 rewrite Qpower_plus_positive. rewrite IHn. rewrite Qmult_power_positive. reflexivity. Qed. (** ** Qpower_positive decomposition *) Lemma Qpower_decomp_positive p x y : Qpower_positive (x#y) p = x ^ Zpos p # (y ^ p). Proof. induction p; intros; simpl Qpower_positive; rewrite ?IHp. - (* xI *) unfold Qmult, Qnum, Qden. f_equal. + now rewrite <- Z.pow_twice_r, <- Z.pow_succ_r. + apply Pos2Z.inj; rewrite !Pos2Z.inj_mul, !Pos2Z.inj_pow. now rewrite <- Z.pow_twice_r, <- Z.pow_succ_r. - (* xO *) unfold Qmult, Qnum, Qden. f_equal. + now rewrite <- Z.pow_twice_r. + apply Pos2Z.inj; rewrite !Pos2Z.inj_mul, !Pos2Z.inj_pow. now rewrite <- Z.pow_twice_r. - (* xO *) now rewrite Z.pow_1_r, Pos.pow_1_r. Qed. (* This notation will be deprecated with a planned larger rework of Q lemma naming *) Notation Qpower_decomp := Qpower_decomp_positive (only parsing). (** * Properties of Qpower *) (** ** Values of Qpower for specific arguments *) Lemma Qpower_0 : forall n, (n<>0)%Z -> 0^n == 0. Proof. intros [|n|n] Hn; try (elim Hn; reflexivity); simpl; rewrite Qpower_positive_0; reflexivity. Qed. Lemma Qpower_1 : forall n, 1^n == 1. Proof. intros [|n|n]; simpl; try rewrite Qpower_positive_1; reflexivity. Qed. Lemma Qpower_0_r: forall q:Q, q^0 == 1. Proof. intros q. reflexivity. Qed. Lemma Qpower_1_r: forall q:Q, q^1 == q. Proof. intros q. reflexivity. Qed. (** ** Relation of Qpower to zero *) Lemma Qpower_not_0: forall (a : Q) (z : Z), ~ a == 0 -> ~ Qpower a z == 0. Proof. intros a z H; destruct z. - discriminate. - apply Qpower_not_0_positive; assumption. - cbn. intros H1. pose proof Qmult_inv_r (Qpower_positive a p) as H2. specialize (H2 (Qpower_not_0_positive _ _ H)). rewrite H1, Qmult_0_r in H2. discriminate H2. Qed. Lemma Qpower_0_le : forall (p : Q) (n : Z), 0 <= p -> 0 <= p^n. Proof. intros p [|n|n] Hp; simpl; try discriminate; try apply Qinv_le_0_compat; apply Qpower_pos_positive; assumption. Qed. (* This notation will be deprecated with a planned larger rework of Q lemma naming *) Notation Qpower_pos := Qpower_0_le (only parsing). Lemma Qpower_0_lt: forall (a : Q) (z : Z), 0 < a -> 0 < Qpower a z. Proof. intros q z Hpos. pose proof Qpower_pos q z (Qlt_le_weak 0 q Hpos) as H1. pose proof Qpower_not_0 q z as H2. pose proof Qlt_not_eq 0 q Hpos as H3. specialize (H2 (Qnot_eq_sym _ _ H3)); clear H3. apply Qnot_eq_sym in H2. apply Qlt_leneq; split; assumption. Qed. (** ** Relation of Qpower to 1 *) Lemma Qpower_1_lt_pos: forall (q : Q) (n : positive), (1 (1 < q ^ (Z.pos n))%Q. Proof. intros q n Hq. induction n. - cbn in *. apply Qmult_lt_1_compat. 1:assumption. apply Qmult_lt_1_compat; assumption. - cbn in *. apply Qmult_lt_1_compat; assumption. - cbn; assumption. Qed. Lemma Qpower_1_lt: forall (q : Q) (n : Z), (1 (0 (1 < q ^ n)%Q. Proof. intros q n Hq Hn. destruct n. - inversion Hn. - apply Qpower_1_lt_pos; assumption. - discriminate (Z.lt_trans _ _ _ Hn (Pos2Z.neg_is_neg p)). Qed. Lemma Qpower_1_le_pos: forall (q : Q) (n : positive), (1<=q)%Q -> (1 <= q ^ (Z.pos n))%Q. Proof. intros q n Hq. induction n. - cbn in *. apply Qmult_le_1_compat. 1:assumption. apply Qmult_le_1_compat; assumption. - cbn in *. apply Qmult_le_1_compat; assumption. - cbn; assumption. Qed. Lemma Qpower_1_le: forall (q : Q) (n : Z), (1<=q)%Q -> (0<=n)%Z -> (1 <= q ^ n)%Q. Proof. intros q n Hq Hn. destruct n. - apply Qle_refl. - apply Qpower_1_le_pos; assumption. - discriminate (Z.le_lt_trans _ _ _ Hn (Pos2Z.neg_is_neg p)). Qed. (** ** Qpower and multiplication, exponent addition *) Lemma Qmult_power : forall a b n, (a*b)^n == a^n*b^n. Proof. intros a b [|n|n]; simpl; try rewrite Qmult_power_positive; try rewrite Qinv_mult_distr; reflexivity. Qed. Lemma Qpower_plus : forall a n m, ~a==0 -> a^(n+m) == a^n*a^m. Proof. intros a [|n|n] [|m|m] H; simpl; try ring; try rewrite Qpower_plus_positive; try apply Qinv_mult_distr; try reflexivity; rewrite ?Z.pos_sub_spec; case Pos.compare_spec; intros H0; simpl; subst; try rewrite Qpower_minus_positive; try (field; try split; apply Qpower_not_0_positive); assumption. Qed. Lemma Qpower_plus' : forall a n m, (n+m <> 0)%Z -> a^(n+m) == a^n*a^m. Proof. intros a n m H. destruct (Qeq_dec a 0)as [X|X]. - rewrite X. rewrite Qpower_0 by assumption. destruct n; destruct m; try (elim H; reflexivity); simpl; repeat rewrite Qpower_positive_0; ring_simplify; reflexivity. - apply Qpower_plus. assumption. Qed. (** ** Qpower and inversion, division, exponent subtraction *) Lemma Qinv_power : forall a n, (/a)^n == /a^n. Proof. intros a [|n|n]; simpl; try rewrite Qinv_power_positive; reflexivity. Qed. Lemma Qdiv_power : forall a b n, (a/b)^n == (a^n/b^n). Proof. unfold Qdiv. intros a b n. rewrite Qmult_power. rewrite Qinv_power. reflexivity. Qed. Lemma Qinv_power_n : forall n p, (1#p)^n == /(inject_Z (Zpos p))^n. Proof. intros n p. rewrite Qmake_Qdiv. rewrite Qdiv_power. rewrite Qpower_1. unfold Qdiv. ring. Qed. Lemma Qpower_opp : forall a n, a^(-n) == /a^n. Proof. intros a [|n|n]; simpl; try reflexivity. symmetry; apply Qinv_involutive. Qed. Lemma Qpower_minus: forall (a : Q) (n m : Z), ~ a == 0 -> a ^ (n - m) == a ^ n / a ^ m. Proof. intros a n m Hnz. rewrite <- Z.add_opp_r. rewrite Qpower_plus by assumption. rewrite Qpower_opp. field. apply Qpower_not_0; assumption. Qed. Lemma Qpower_minus_pos: forall (a b : positive) (n m : Z), (Z.pos a#b) ^ (n - m) == (Z.pos a#b) ^ n * (Z.pos b#a) ^ m. Proof. intros a b n m. rewrite Qpower_minus by discriminate. rewrite <- (Qinv_pos b a), Qinv_power. reflexivity. Qed. Lemma Qpower_minus_neg: forall (a b : positive) (n m : Z), (Z.neg a#b) ^ (n - m) == (Z.neg a#b) ^ n * (Z.neg b#a) ^ m. Proof. intros a b n m. rewrite Qpower_minus by discriminate. rewrite <- (Qinv_neg b a), Qinv_power. reflexivity. Qed. (** ** Qpower and exponent multiplication *) Lemma Qpower_mult : forall a n m, a^(n*m) == (a^n)^m. Proof. intros a [|n|n] [|m|m]; simpl; try rewrite Qpower_positive_1; try rewrite Qpower_mult_positive; try rewrite Qinv_power_positive; try rewrite Qinv_involutive; try reflexivity. Qed. (** ** Qpower decomposition *) Lemma Qpower_decomp_pos: forall (p : positive) (a : Z) (b : positive), (a # b) ^ (Z.pos p) == a ^ (Z.pos p) # (b ^ p)%positive. Proof. intros p a b. pose proof Qpower_decomp_positive p a b. cbn; rewrite H; reflexivity. Qed. Lemma Qpower_decomp_neg_pos: forall (p a b: positive), (Z.pos a # b) ^ (Z.neg p) == (Z.pos b) ^ (Z.pos p) # (a ^ p)%positive. Proof. intros p a b. cbn. rewrite <- Qinv_power_positive, Qinv_pos. rewrite Qpower_decomp_positive. reflexivity. Qed. Lemma Qpower_decomp_neg_neg: forall (p a b: positive), (Z.neg a # b) ^ (Z.neg p) == (Z.neg b) ^ (Z.pos p) # (a ^ p)%positive. Proof. intros p a b. cbn. rewrite <- Qinv_power_positive, Qinv_neg. rewrite Qpower_decomp_positive. reflexivity. Qed. (** ** Compatibility of Qpower with relational operators *) Lemma Qpower_lt_compat_l: forall (q : Q) (n m : Z), (n < m)%Z -> (1 (q ^ n < q ^ m)%Q. Proof. intros q n m Hnm Hq. replace m with (n+(m-n))%Z by ring. rewrite Qpower_plus, <- Qmult_1_r, <- Qmult_assoc. 2: { intros Habsurd. rewrite Habsurd in Hq. discriminate Hq. } rewrite Qmult_lt_l, Qmult_1_l. 2: { apply Qpower_0_lt. exact (Qlt_trans 0 1 q ltac:(reflexivity) Hq). } remember (m-n)%Z as k. apply Qpower_1_lt. - exact Hq. - rewrite Heqk; apply Z.lt_0_sub, Hnm. Qed. Lemma Qpower_le_compat_l: forall (q : Q) (n m : Z), (n <= m)%Z -> (1<=q)%Q -> (q ^ n <= q ^ m)%Q. Proof. intros q n m Hnm Hq. replace m with (n+(m-n))%Z by ring. rewrite Qpower_plus, <- Qmult_1_r, <- Qmult_assoc. 2: { intros Habsurd. rewrite Habsurd in Hq. apply Hq. reflexivity. } rewrite Qmult_le_l, Qmult_1_l. 2: { apply Qpower_0_lt. exact (Qlt_le_trans 0 1 q ltac:(reflexivity) Hq). } remember (m-n)%Z as k. apply Qpower_1_le. - exact Hq. - rewrite Heqk; apply Z.le_0_sub, Hnm. Qed. Lemma Qpower_lt_compat_l_inv: forall (q : Q) (n m : Z), (q ^ n < q ^ m)%Q -> (1 (n < m)%Z. Proof. intros q n m Hnm Hq. destruct (Z_lt_le_dec n m) as [Hd|Hd]. - assumption. - pose proof Qpower_le_compat_l q m n Hd (Qlt_le_weak _ _ Hq) as Hnm'. pose proof Qlt_le_trans _ _ _ Hnm Hnm' as Habsurd. destruct (Qlt_irrefl _ Habsurd). Qed. Lemma Qpower_le_compat_l_inv: forall (q : Q) (n m : Z), (q ^ n <= q ^ m)%Q -> (1 (n <= m)%Z. Proof. intros q n m Hnm Hq. destruct (Z_lt_le_dec m n) as [Hd|Hd]. - pose proof Qpower_lt_compat_l q m n Hd Hq as Hnm'. pose proof Qle_lt_trans _ _ _ Hnm Hnm' as Habsurd. destruct (Qlt_irrefl _ Habsurd). - assumption. Qed. (** ** Qpower and inject_Z *) Lemma Zpower_Qpower : forall (a n:Z), (0<=n)%Z -> inject_Z (a^n) == (inject_Z a)^n. Proof. intros a [|n|n] H;[reflexivity| |elim H; reflexivity]. induction n using Pos.peano_ind. - replace (a^1)%Z with a by ring. ring. - rewrite Pos2Z.inj_succ. unfold Z.succ. rewrite Zpower_exp; auto with *; try discriminate. rewrite Qpower_plus' by discriminate. rewrite <- IHn by discriminate. replace (a^Zpos n*a^1)%Z with (a^Zpos n*a)%Z by ring. ring_simplify. reflexivity. Qed. (** ** Square *) Lemma Qsqr_nonneg : forall a, 0 <= a^2. Proof. intros a. destruct (Qlt_le_dec 0 a) as [A|A]. - apply (Qmult_le_0_compat a a); (apply Qlt_le_weak; assumption). - setoid_replace (a^2) with ((-a)*(-a)) by ring. rewrite Qle_minus_iff in A. setoid_replace (0+ - a) with (-a) in A by ring. apply Qmult_le_0_compat; assumption. Qed. (** ** Power of 2 positive upper bound *) Lemma Qarchimedean_power2_pos : forall q : Q, {p : positive | (q < Z.pos (2^p) # 1)%Q}. Proof. intros q. destruct (Qarchimedean q) as [pexp Hpexp]. exists (Pos.size pexp). pose proof Pos.size_gt pexp as H1. unfold Qlt in *. cbn in *; Zify.zify. apply (Z.mul_lt_mono_pos_r (QDen q)) in H1; [|assumption]. apply (Z.lt_trans _ _ _ Hpexp H1). Qed. coq-8.20.0/theories/QArith/Qreals.v000066400000000000000000000134061466560755400170410ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* 0%R. Proof. intros. now apply not_O_IZR. Qed. #[global] Hint Resolve IZR_nz Rmult_integral_contrapositive : core. Lemma eqR_Qeq : forall x y : Q, Q2R x = Q2R y -> x==y. Proof. unfold Qeq, Q2R; intros (x1, x2) (y1, y2); unfold Qnum, Qden; intros. apply eq_IZR. do 2 rewrite mult_IZR. set (X1 := IZR x1) in *; assert (X2nz := IZR_nz x2); set (X2 := IZR (Zpos x2)) in *. set (Y1 := IZR y1) in *; assert (Y2nz := IZR_nz y2); set (Y2 := IZR (Zpos y2)) in *. assert ((X2 * X1 * / X2)%R = (X2 * (Y1 * / Y2))%R). - rewrite <- H; field; auto. - rewrite Rinv_r_simpl_m in H0; auto; rewrite H0; field; auto. Qed. Lemma Qeq_eqR : forall x y : Q, x==y -> Q2R x = Q2R y. Proof. unfold Qeq, Q2R; intros (x1, x2) (y1, y2); unfold Qnum, Qden; intros. set (X1 := IZR x1) in *; assert (X2nz := IZR_nz x2); set (X2 := IZR (Zpos x2)) in *. set (Y1 := IZR y1) in *; assert (Y2nz := IZR_nz y2); set (Y2 := IZR (Zpos y2)) in *. assert ((X1 * Y2)%R = (Y1 * X2)%R). - unfold X1, X2, Y1, Y2; do 2 rewrite <- mult_IZR. f_equal; auto. - clear H. field_simplify_eq; auto. rewrite H0; ring. Qed. Lemma Rle_Qle : forall x y : Q, (Q2R x <= Q2R y)%R -> x<=y. Proof. unfold Qle, Q2R; intros (x1, x2) (y1, y2); unfold Qnum, Qden; intros. apply le_IZR. do 2 rewrite mult_IZR. set (X1 := IZR x1) in *; assert (X2nz := IZR_nz x2); set (X2 := IZR (Zpos x2)) in *. set (Y1 := IZR y1) in *; assert (Y2nz := IZR_nz y2); set (Y2 := IZR (Zpos y2)) in *. replace (X1 * Y2)%R with (X1 * / X2 * (X2 * Y2))%R; try (field; auto). replace (Y1 * X2)%R with (Y1 * / Y2 * (X2 * Y2))%R; try (field; auto). apply Rmult_le_compat_r; auto. apply Rmult_le_pos. - now apply IZR_le. - now apply IZR_le. Qed. Lemma Qle_Rle : forall x y : Q, x<=y -> (Q2R x <= Q2R y)%R. Proof. unfold Qle, Q2R; intros (x1, x2) (y1, y2); unfold Qnum, Qden; intros. set (X1 := IZR x1) in *; assert (X2nz := IZR_nz x2); set (X2 := IZR (Zpos x2)) in *. set (Y1 := IZR y1) in *; assert (Y2nz := IZR_nz y2); set (Y2 := IZR (Zpos y2)) in *. assert (X1 * Y2 <= Y1 * X2)%R. - unfold X1, X2, Y1, Y2; do 2 rewrite <- mult_IZR. apply IZR_le; auto. - clear H. replace (X1 * / X2)%R with (X1 * Y2 * (/ X2 * / Y2))%R; try (field; auto). replace (Y1 * / Y2)%R with (Y1 * X2 * (/ X2 * / Y2))%R; try (field; auto). apply Rmult_le_compat_r; auto. apply Rmult_le_pos; apply Rlt_le; apply Rinv_0_lt_compat. + now apply IZR_lt. + now apply IZR_lt. Qed. Lemma Rlt_Qlt : forall x y : Q, (Q2R x < Q2R y)%R -> x (Q2R x < Q2R y)%R. Proof. unfold Qlt, Q2R; intros (x1, x2) (y1, y2); unfold Qnum, Qden; intros. set (X1 := IZR x1) in *; assert (X2nz := IZR_nz x2); set (X2 := IZR (Zpos x2)) in *. set (Y1 := IZR y1) in *; assert (Y2nz := IZR_nz y2); set (Y2 := IZR (Zpos y2)) in *. assert (X1 * Y2 < Y1 * X2)%R. - unfold X1, X2, Y1, Y2; do 2 rewrite <- mult_IZR. apply IZR_lt; auto. - clear H. replace (X1 * / X2)%R with (X1 * Y2 * (/ X2 * / Y2))%R; try (field; auto). replace (Y1 * / Y2)%R with (Y1 * X2 * (/ X2 * / Y2))%R; try (field; auto). apply Rmult_lt_compat_r; auto. apply Rmult_lt_0_compat; apply Rinv_0_lt_compat. + now apply IZR_lt. + now apply IZR_lt. Qed. Lemma Q2R_plus : forall x y : Q, Q2R (x+y) = (Q2R x + Q2R y)%R. Proof. unfold Qplus, Qeq, Q2R; intros (x1, x2) (y1, y2); unfold Qden, Qnum. simpl_mult. rewrite plus_IZR. do 3 rewrite mult_IZR. field; auto. Qed. Lemma Q2R_mult : forall x y : Q, Q2R (x*y) = (Q2R x * Q2R y)%R. Proof. unfold Qmult, Qeq, Q2R; intros (x1, x2) (y1, y2); unfold Qden, Qnum. simpl_mult. do 2 rewrite mult_IZR. field; auto. Qed. Lemma Q2R_opp : forall x : Q, Q2R (- x) = (- Q2R x)%R. Proof. unfold Qopp, Qeq, Q2R; intros (x1, x2); unfold Qden, Qnum. rewrite Ropp_Ropp_IZR. field; auto. Qed. Lemma Q2R_minus : forall x y : Q, Q2R (x-y) = (Q2R x - Q2R y)%R. Proof. unfold Qminus; intros; rewrite Q2R_plus; rewrite Q2R_opp; auto. Qed. Lemma Q2R_inv : forall x : Q, ~ x==0 -> Q2R (/x) = (/ Q2R x)%R. Proof. unfold Qinv, Q2R, Qeq; intros (x1, x2). case x1; unfold Qnum, Qden. - simpl; intros; elim H; trivial. - intros; field; auto. - intros; change (IZR (Zneg x2)) with (- IZR (Zpos x2))%R; change (IZR (Zneg p)) with (- IZR (Zpos p))%R; simpl; field; (*auto 8 with real.*) repeat split; auto; auto with real. Qed. Lemma Q2R_div : forall x y : Q, ~ y==0 -> Q2R (x/y) = (Q2R x / Q2R y)%R. Proof. unfold Qdiv, Rdiv. intros; rewrite Q2R_mult. rewrite Q2R_inv; auto. Qed. Global Hint Rewrite Q2R_plus Q2R_mult Q2R_opp Q2R_minus Q2R_inv Q2R_div : q2r_simpl. coq-8.20.0/theories/QArith/Qreduction.v000066400000000000000000000127701466560755400177320ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* g) by (intro; subst; discriminate). rewrite Z2Pos.id. - ring. - now rewrite <- (Z.mul_pos_cancel_l g); [ rewrite <- Hd | apply Z.le_neq ]. Close Scope Z_scope. Qed. Lemma Qred_complete : forall p q, p==q -> Qred p = Qred q. Proof. intros (a,b) (c,d). unfold Qred, Qeq in *; simpl in *. Open Scope Z_scope. intros H. generalize (Z.ggcd_gcd a (Zpos b)) (Zgcd_is_gcd a (Zpos b)) (Z.gcd_nonneg a (Zpos b)) (Z.ggcd_correct_divisors a (Zpos b)). destruct (Z.ggcd a (Zpos b)) as (g,(aa,bb)). simpl. intros <- Hg1 Hg2 (Hg3,Hg4). assert (Hg0 : g <> 0) by (intro; now subst g). generalize (Z.ggcd_gcd c (Zpos d)) (Zgcd_is_gcd c (Zpos d)) (Z.gcd_nonneg c (Zpos d)) (Z.ggcd_correct_divisors c (Zpos d)). destruct (Z.ggcd c (Zpos d)) as (g',(cc,dd)). simpl. intros <- Hg'1 Hg'2 (Hg'3,Hg'4). assert (Hg'0 : g' <> 0) by (intro; now subst g'). elim (rel_prime_cross_prod aa bb cc dd). - congruence. - (*rel_prime*) constructor. * exists aa; auto using Z.mul_1_r. * exists bb; auto using Z.mul_1_r. * intros x Ha Hb. destruct Hg1 as (Hg11,Hg12,Hg13). destruct (Hg13 (g*x)) as (x',Hx). { rewrite Hg3. destruct Ha as (xa,Hxa); exists xa; rewrite Hxa; ring. } { rewrite Hg4. destruct Hb as (xb,Hxb); exists xb; rewrite Hxb; ring. } exists x'. apply Z.mul_reg_l with g; auto. rewrite Hx at 1; ring. - (* rel_prime *) constructor. * exists cc; auto using Z.mul_1_r. * exists dd; auto using Z.mul_1_r. * intros x Hc Hd. inversion Hg'1 as (Hg'11,Hg'12,Hg'13). destruct (Hg'13 (g'*x)) as (x',Hx). { rewrite Hg'3. destruct Hc as (xc,Hxc); exists xc; rewrite Hxc; ring. } { rewrite Hg'4. destruct Hd as (xd,Hxd); exists xd; rewrite Hxd; ring. } exists x'. apply Z.mul_reg_l with g'; auto. rewrite Hx at 1; ring. - apply Z.lt_gt. rewrite <- (Z.mul_pos_cancel_l g); [ now rewrite <- Hg4 | apply Z.le_neq; intuition ]. - apply Z.lt_gt. rewrite <- (Z.mul_pos_cancel_l g'); [now rewrite <- Hg'4 | apply Z.le_neq; intuition ]. - apply Z.mul_reg_l with (g*g'). * rewrite Z.mul_eq_0. now destruct 1. * rewrite Z.mul_shuffle1, <- Hg3, <- Hg'4. now rewrite Z.mul_shuffle1, <- Hg'3, <- Hg4, H, Z.mul_comm. Close Scope Z_scope. Qed. Lemma Qred_eq_iff q q' : Qred q = Qred q' <-> q == q'. Proof. split. - intros E. rewrite <- (Qred_correct q), <- (Qred_correct q'). now rewrite E. - apply Qred_complete. Qed. Add Morphism Qred with signature (Qeq ==> Qeq) as Qred_comp. Proof. intros. now rewrite !Qred_correct. Qed. Definition Qplus' (p q : Q) := Qred (Qplus p q). Definition Qmult' (p q : Q) := Qred (Qmult p q). Definition Qminus' x y := Qred (Qminus x y). Lemma Qplus'_correct : forall p q : Q, (Qplus' p q)==(Qplus p q). Proof. intros; unfold Qplus'; apply Qred_correct; auto. Qed. Lemma Qmult'_correct : forall p q : Q, (Qmult' p q)==(Qmult p q). Proof. intros; unfold Qmult'; apply Qred_correct; auto. Qed. Lemma Qminus'_correct : forall p q : Q, (Qminus' p q)==(Qminus p q). Proof. intros; unfold Qminus'; apply Qred_correct; auto. Qed. Add Morphism Qplus' with signature (Qeq ==> Qeq ==> Qeq) as Qplus'_comp. Proof. intros ? ? H ? ? H0; unfold Qplus'. rewrite H, H0; auto with qarith. Qed. Add Morphism Qmult' with signature (Qeq ==> Qeq ==> Qeq) as Qmult'_comp. Proof. intros ? ? H ? ? H0; unfold Qmult'. rewrite H, H0; auto with qarith. Qed. Add Morphism Qminus' with signature (Qeq ==> Qeq ==> Qeq) as Qminus'_comp. Proof. intros ? ? H ? ? H0; unfold Qminus'. rewrite H, H0; auto with qarith. Qed. Lemma Qred_opp: forall q, Qred (-q) = - (Qred q). Proof. intros (x, y); unfold Qred; simpl. rewrite Z.ggcd_opp; case Z.ggcd; intros p1 (p2, p3); simpl. unfold Qopp; auto. Qed. Theorem Qred_compare: forall x y, Qcompare x y = Qcompare (Qred x) (Qred y). Proof. intros x y; apply Qcompare_comp; apply Qeq_sym; apply Qred_correct. Qed. Lemma Qred_le q q' : Qred q <= Qred q' <-> q <= q'. Proof. now rewrite !Qle_alt, <- Qred_compare. Qed. Lemma Qred_lt q q' : Qred q < Qred q' <-> q < q'. Proof. now rewrite !Qlt_alt, <- Qred_compare. Qed. coq-8.20.0/theories/QArith/Qring.v000066400000000000000000000012731466560755400166710ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* -> Q. Definition Qfloor (x:Q) := let (n,d) := x in Z.div n (Zpos d). Definition Qceiling (x:Q) := (-(Qfloor (-x)))%Z. Lemma Qfloor_Z : forall z:Z, Qfloor z = z. Proof. intros z. simpl. auto with *. Qed. Lemma Qceiling_Z : forall z:Z, Qceiling z = z. Proof. intros z. unfold Qceiling. simpl. rewrite Z.div_1_r. apply Z.opp_involutive. Qed. Lemma Qfloor_le : forall x, Qfloor x <= x. Proof. intros [n d]. simpl. unfold Qle. simpl. replace (n*1)%Z with n by ring. rewrite Z.mul_comm. now apply Z.mul_div_le. Qed. #[global] Hint Resolve Qfloor_le : qarith. Lemma Qle_ceiling : forall x, x <= Qceiling x. Proof. intros x. apply Qle_trans with (- - x). - rewrite Qopp_involutive. auto with *. - change (Qceiling x:Q) with (-(Qfloor(-x))). auto with *. Qed. #[global] Hint Resolve Qle_ceiling : qarith. Lemma Qle_floor_ceiling : forall x, Qfloor x <= Qceiling x. Proof. eauto with qarith. Qed. Lemma Qlt_floor : forall x, x < (Qfloor x+1)%Z. Proof. intros [n d]. simpl. unfold Qlt. simpl. replace (n*1)%Z with n by ring. ring_simplify. replace (n / Zpos d * Zpos d + Zpos d)%Z with ((Zpos d * (n / Zpos d) + n mod Zpos d) + Zpos d - n mod Zpos d)%Z by ring. rewrite <- Z_div_mod_eq_full. rewrite <- Z.lt_add_lt_sub_r. destruct (Z_mod_lt n (Zpos d)); auto with *. Qed. #[global] Hint Resolve Qlt_floor : qarith. Lemma Qceiling_lt : forall x, (Qceiling x-1)%Z < x. Proof. intros x. unfold Qceiling. replace (- Qfloor (- x) - 1)%Z with (-(Qfloor (-x) + 1))%Z by ring. change ((- (Qfloor (- x) + 1))%Z:Q) with (-(Qfloor (- x) + 1)%Z). apply Qlt_le_trans with (- - x); auto with *. rewrite Qopp_involutive. auto with *. Qed. #[global] Hint Resolve Qceiling_lt : qarith. Lemma Qfloor_resp_le : forall x y, x <= y -> (Qfloor x <= Qfloor y)%Z. Proof. intros [xn xd] [yn yd] Hxy. unfold Qle in *. simpl in *. rewrite <- (Zdiv_mult_cancel_r xn (Zpos xd) (Zpos yd)); auto with *. rewrite <- (Zdiv_mult_cancel_r yn (Zpos yd) (Zpos xd)); auto with *. rewrite (Z.mul_comm (Zpos yd) (Zpos xd)). apply Z_div_le; auto with *. Qed. #[global] Hint Resolve Qfloor_resp_le : qarith. Lemma Qceiling_resp_le : forall x y, x <= y -> (Qceiling x <= Qceiling y)%Z. Proof. intros x y Hxy. unfold Qceiling. rewrite <- Z.opp_le_mono; auto with qarith. Qed. #[global] Hint Resolve Qceiling_resp_le : qarith. Add Morphism Qfloor with signature Qeq ==> eq as Qfloor_comp. Proof. intros x y H. apply Z.le_antisymm. - auto with *. - symmetry in H; auto with *. Qed. Add Morphism Qceiling with signature Qeq ==> eq as Qceiling_comp. Proof. intros x y H. apply Z.le_antisymm. - auto with *. - symmetry in H; auto with *. Qed. Lemma Zdiv_Qdiv (n m: Z): (n / m)%Z = Qfloor (n / m). Proof. unfold Qfloor. intros. simpl. destruct m as [ | | p]; simpl. - now rewrite Zdiv_0_r, Z.mul_0_r. - now rewrite Z.mul_1_r. - rewrite <- Z.opp_eq_mul_m1. rewrite <- (Z.opp_involutive (Zpos p)). now rewrite Zdiv_opp_opp. Qed. coq-8.20.0/theories/Reals/000077500000000000000000000000001466560755400152755ustar00rootroot00000000000000coq-8.20.0/theories/Reals/Abstract/000077500000000000000000000000001466560755400170405ustar00rootroot00000000000000coq-8.20.0/theories/Reals/Abstract/ConstructiveAbs.v000066400000000000000000000312341466560755400223500ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * INRIA, CNRS and contributors - Copyright 1999-2019 *) (* CReq R as CRabs_morph_prop. Proof. intros. apply CRabs_morph, H. Qed. Lemma CRabs_right : forall {R : ConstructiveReals} (x : CRcarrier R), 0 <= x -> CRabs R x == x. Proof. intros. split. - pose proof (CRabs_def R x (CRabs R x)) as [_ H1]. apply H1, CRle_refl. - rewrite <- CRabs_def. split. + apply CRle_refl. + apply (CRle_trans _ 0). 2: exact H. apply (CRle_trans _ (CRopp R 0)). * intro abs. apply CRopp_lt_cancel in abs. contradiction. * apply (CRplus_le_reg_l 0). apply (CRle_trans _ 0). -- apply CRplus_opp_r. -- apply CRplus_0_r. Qed. Lemma CRabs_opp : forall {R : ConstructiveReals} (x : CRcarrier R), CRabs R (- x) == CRabs R x. Proof. intros. split. - rewrite <- CRabs_def. split. + pose proof (CRabs_def R (CRopp R x) (CRabs R (CRopp R x))) as [_ H1]. specialize (H1 (CRle_refl (CRabs R (CRopp R x)))) as [_ H1]. apply (CRle_trans _ (CRopp R (CRopp R x))). 2: exact H1. apply (CRopp_involutive x). + pose proof (CRabs_def R (CRopp R x) (CRabs R (CRopp R x))) as [_ H1]. apply H1, CRle_refl. - rewrite <- CRabs_def. split. + pose proof (CRabs_def R x (CRabs R x)) as [_ H1]. apply H1, CRle_refl. + apply (CRle_trans _ x). * apply CRopp_involutive. * pose proof (CRabs_def R x (CRabs R x)) as [_ H1]. apply H1, CRle_refl. Qed. Lemma CRabs_minus_sym : forall {R : ConstructiveReals} (x y : CRcarrier R), CRabs R (x - y) == CRabs R (y - x). Proof. intros R x y. setoid_replace (x - y) with (-(y-x)). - rewrite CRabs_opp. reflexivity. - unfold CRminus. rewrite CRopp_plus_distr, CRplus_comm, CRopp_involutive. reflexivity. Qed. Lemma CRabs_left : forall {R : ConstructiveReals} (x : CRcarrier R), x <= 0 -> CRabs R x == - x. Proof. intros. rewrite <- CRabs_opp. apply CRabs_right. rewrite <- CRopp_0. apply CRopp_ge_le_contravar, H. Qed. Lemma CRabs_triang : forall {R : ConstructiveReals} (x y : CRcarrier R), CRabs R (x + y) <= CRabs R x + CRabs R y. Proof. intros. rewrite <- CRabs_def. split. - apply (CRle_trans _ (CRplus R (CRabs R x) y)). + apply CRplus_le_compat_r. pose proof (CRabs_def R x (CRabs R x)) as [_ H1]. apply H1, CRle_refl. + apply CRplus_le_compat_l. pose proof (CRabs_def R y (CRabs R y)) as [_ H1]. apply H1, CRle_refl. - apply (CRle_trans _ (CRplus R (CRopp R x) (CRopp R y))). + apply CRopp_plus_distr. + apply (CRle_trans _ (CRplus R (CRabs R x) (CRopp R y))). * apply CRplus_le_compat_r. pose proof (CRabs_def R x (CRabs R x)) as [_ H1]. apply H1, CRle_refl. * apply CRplus_le_compat_l. pose proof (CRabs_def R y (CRabs R y)) as [_ H1]. apply H1, CRle_refl. Qed. Lemma CRabs_le : forall {R : ConstructiveReals} (a b:CRcarrier R), (-b <= a /\ a <= b) -> CRabs R a <= b. Proof. intros. pose proof (CRabs_def R a b) as [H0 _]. apply H0. split. - apply H. - destruct H. rewrite <- (CRopp_involutive b). apply CRopp_ge_le_contravar. exact H. Qed. Lemma CRabs_triang_inv : forall {R : ConstructiveReals} (x y : CRcarrier R), CRabs R x - CRabs R y <= CRabs R (x - y). Proof. intros. apply (CRplus_le_reg_r (CRabs R y)). unfold CRminus. rewrite CRplus_assoc, CRplus_opp_l. rewrite CRplus_0_r. apply (CRle_trans _ (CRabs R (x - y + y))). - setoid_replace (x - y + y) with x. + apply CRle_refl. + unfold CRminus. rewrite CRplus_assoc, CRplus_opp_l. rewrite CRplus_0_r. reflexivity. - apply CRabs_triang. Qed. Lemma CRabs_triang_inv2 : forall {R : ConstructiveReals} (x y : CRcarrier R), CRabs R (CRabs R x - CRabs R y) <= CRabs R (x - y). Proof. intros. apply CRabs_le. split. 2: apply CRabs_triang_inv. apply (CRplus_le_reg_r (CRabs R y)). unfold CRminus. rewrite CRplus_assoc, CRplus_opp_l. rewrite CRplus_0_r. fold (x - y). rewrite CRplus_comm, CRabs_minus_sym. apply (CRle_trans _ _ _ (CRabs_triang_inv y (y-x))). setoid_replace (y - (y - x)) with x. - apply CRle_refl. - unfold CRminus. rewrite CRopp_plus_distr, <- CRplus_assoc. rewrite CRplus_opp_r, CRplus_0_l. apply CRopp_involutive. Qed. Lemma CR_of_Q_abs : forall {R : ConstructiveReals} (q : Q), CRabs R (CR_of_Q R q) == CR_of_Q R (Qabs q). Proof. intros. destruct (Qlt_le_dec 0 q). - apply (CReq_trans _ (CR_of_Q R q)). + apply CRabs_right. apply CR_of_Q_le. apply Qlt_le_weak, q0. + apply CR_of_Q_morph. symmetry. apply Qabs_pos, Qlt_le_weak, q0. - apply (CReq_trans _ (CR_of_Q R (-q))). + apply (CReq_trans _ (CRabs R (CRopp R (CR_of_Q R q)))). * apply CReq_sym, CRabs_opp. * apply (CReq_trans _ (CRopp R (CR_of_Q R q))). -- apply CRabs_right. apply (CRle_trans _ (CR_of_Q R (-q))). ++ apply CR_of_Q_le. apply (Qplus_le_l _ _ q). ring_simplify. exact q0. ++ apply CR_of_Q_opp. -- apply CReq_sym, CR_of_Q_opp. + apply CR_of_Q_morph; symmetry; apply Qabs_neg, q0. Qed. Lemma CRle_abs : forall {R : ConstructiveReals} (x : CRcarrier R), x <= CRabs R x. Proof. intros. pose proof (CRabs_def R x (CRabs R x)) as [_ H]. apply H, CRle_refl. Qed. Lemma CRabs_pos : forall {R : ConstructiveReals} (x : CRcarrier R), 0 <= CRabs R x. Proof. intros. intro abs. destruct (CRltLinear R). clear p. specialize (s _ x _ abs). destruct s. - exact (CRle_abs x c). - rewrite CRabs_left in abs. + rewrite <- CRopp_0 in abs. apply CRopp_lt_cancel in abs. exact (CRlt_asym _ _ abs c). + apply CRlt_asym, c. Qed. Lemma CRabs_appart_0 : forall {R : ConstructiveReals} (x : CRcarrier R), 0 < CRabs R x -> x ≶ 0. Proof. intros. destruct (CRltLinear R). clear p. pose proof (s _ x _ H) as [pos|neg]. - right. exact pos. - left. destruct (CR_Q_dense R _ _ neg) as [q [H0 H1]]. destruct (Qlt_le_dec 0 q). + destruct (s (CR_of_Q R (-q)) x 0). * apply CR_of_Q_lt. apply (Qplus_lt_l _ _ q). ring_simplify. exact q0. * exfalso. pose proof (CRabs_def R x (CR_of_Q R q)) as [H2 _]. apply H2. -- clear H2. split. ++ apply CRlt_asym, H0. ++ rewrite <- Qopp_involutive, CR_of_Q_opp. apply CRopp_ge_le_contravar, CRlt_asym, c. -- exact H1. * exact c. + apply (CRlt_le_trans _ _ _ H0). apply CR_of_Q_le. exact q0. Qed. (* The proof by cases on the signs of x and y applies constructively, because of the positivity hypotheses. *) Lemma CRabs_mult : forall {R : ConstructiveReals} (x y : CRcarrier R), CRabs R (x * y) == CRabs R x * CRabs R y. Proof. intro R. assert (forall (x y : CRcarrier R), x ≶ 0 -> y ≶ 0 -> CRabs R (x * y) == CRabs R x * CRabs R y) as prep. { intros. destruct H, H0. - rewrite CRabs_right, CRabs_left, CRabs_left. + rewrite <- CRopp_mult_distr_l, CRopp_mult_distr_r, CRopp_involutive. reflexivity. + apply CRlt_asym, c0. + apply CRlt_asym, c. + setoid_replace (x*y) with (- x * - y). * apply CRlt_asym, CRmult_lt_0_compat. -- rewrite <- CRopp_0. apply CRopp_gt_lt_contravar, c. -- rewrite <- CRopp_0. apply CRopp_gt_lt_contravar, c0. * rewrite <- CRopp_mult_distr_l, CRopp_mult_distr_r, CRopp_involutive. reflexivity. - rewrite CRabs_left, CRabs_left, CRabs_right. + rewrite <- CRopp_mult_distr_l. reflexivity. + apply CRlt_asym, c0. + apply CRlt_asym, c. + rewrite <- (CRmult_0_l y). apply CRmult_le_compat_r_half. * exact c0. * apply CRlt_asym, c. - rewrite CRabs_left, CRabs_right, CRabs_left. + rewrite <- CRopp_mult_distr_r. reflexivity. + apply CRlt_asym, c0. + apply CRlt_asym, c. + rewrite <- (CRmult_0_r x). apply CRmult_le_compat_l_half. * exact c. * apply CRlt_asym, c0. - rewrite CRabs_right, CRabs_right, CRabs_right. + reflexivity. + apply CRlt_asym, c0. + apply CRlt_asym, c. + apply CRlt_asym, CRmult_lt_0_compat; assumption. } split. - intro abs. assert (0 < CRabs R x * CRabs R y). { apply (CRle_lt_trans _ (CRabs R (x*y))). - apply CRabs_pos. - exact abs. } pose proof (CRmult_pos_appart_zero _ _ H). rewrite CRmult_comm in H. apply CRmult_pos_appart_zero in H. destruct H. 2: apply (CRabs_pos y c). destruct H0. 2: apply (CRabs_pos x c0). apply CRabs_appart_0 in c. apply CRabs_appart_0 in c0. rewrite (prep x y) in abs. + exact (CRlt_asym _ _ abs abs). + exact c0. + exact c. - intro abs. assert (0 < CRabs R (x * y)). { apply (CRle_lt_trans _ (CRabs R x * CRabs R y)). - rewrite <- (CRmult_0_l (CRabs R y)). apply CRmult_le_compat_r. + apply CRabs_pos. + apply CRabs_pos. - exact abs. } apply CRabs_appart_0 in H. destruct H. + apply CRopp_gt_lt_contravar in c. rewrite CRopp_0, CRopp_mult_distr_l in c. pose proof (CRmult_pos_appart_zero _ _ c). rewrite CRmult_comm in c. apply CRmult_pos_appart_zero in c. rewrite (prep x y) in abs. * exact (CRlt_asym _ _ abs abs). * destruct H. -- left. apply CRopp_gt_lt_contravar in c0. rewrite CRopp_involutive, CRopp_0 in c0. exact c0. -- right. apply CRopp_gt_lt_contravar in c0. rewrite CRopp_involutive, CRopp_0 in c0. exact c0. * destruct c. -- right. exact c. -- left. exact c. + pose proof (CRmult_pos_appart_zero _ _ c). rewrite CRmult_comm in c. apply CRmult_pos_appart_zero in c. rewrite (prep x y) in abs. * exact (CRlt_asym _ _ abs abs). * destruct H. -- right. exact c0. -- left. exact c0. * destruct c. -- right. exact c. -- left. exact c. Qed. Lemma CRabs_lt : forall {R : ConstructiveReals} (x y : CRcarrier R), CRabs _ x < y -> prod (x < y) (-x < y). Proof. split. - apply (CRle_lt_trans _ _ _ (CRle_abs x)), H. - apply (CRle_lt_trans _ _ _ (CRle_abs (-x))). rewrite CRabs_opp. exact H. Qed. Lemma CRabs_def1 : forall {R : ConstructiveReals} (x y : CRcarrier R), x < y -> -x < y -> CRabs _ x < y. Proof. intros. destruct (CRltLinear R), p. destruct (s x (CRabs R x) y H). 2: exact c0. rewrite CRabs_left. - exact H0. - intro abs. rewrite CRabs_right in c0. + exact (CRlt_asym x x c0 c0). + apply CRlt_asym, abs. Qed. Lemma CRabs_def2 : forall {R : ConstructiveReals} (x a:CRcarrier R), CRabs _ x <= a -> (x <= a) /\ (- a <= x). Proof. split. - exact (CRle_trans _ _ _ (CRle_abs _) H). - rewrite <- (CRopp_involutive x). apply CRopp_ge_le_contravar. rewrite <- CRabs_opp in H. exact (CRle_trans _ _ _ (CRle_abs _) H). Qed. coq-8.20.0/theories/Reals/Abstract/ConstructiveLUB.v000066400000000000000000000465031466560755400222720ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * INRIA, CNRS and contributors - Copyright 1999-2019 *) (* Prop), (forall n, {P n} + {~P n}) -> {n | ~P n} + {forall n, P n}. Definition sig_not_dec_T : Type := forall P : Prop, { ~~P } + { ~P }. Definition is_upper_bound {R : ConstructiveReals} (E:CRcarrier R -> Prop) (m:CRcarrier R) := forall x:CRcarrier R, E x -> x <= m. Definition is_lub {R : ConstructiveReals} (E:CRcarrier R -> Prop) (m:CRcarrier R) := is_upper_bound E m /\ (forall b:CRcarrier R, is_upper_bound E b -> m <= b). Lemma CRlt_lpo_dec : forall {R : ConstructiveReals} (x y : CRcarrier R), (forall (P : nat -> Prop), (forall n, {P n} + {~P n}) -> {n | ~P n} + {forall n, P n}) -> sum (x < y) (y <= x). Proof. intros R x y lpo. assert (forall (z:CRcarrier R) (n : nat), z < z + CR_of_Q R (1 # Pos.of_nat (S n))). { intros. apply (CRle_lt_trans _ (z+0)). - rewrite CRplus_0_r. apply CRle_refl. - apply CRplus_lt_compat_l. apply CR_of_Q_pos. reflexivity. } pose (fun n:nat => let (q,_) := CR_Q_dense R x (x + CR_of_Q R (1 # Pos.of_nat (S n))) (H x n) in q) as xn. pose (fun n:nat => let (q,_) := CR_Q_dense R y (y + CR_of_Q R (1 # Pos.of_nat (S n))) (H y n) in q) as yn. destruct (lpo (fun n => Qle (yn n) (xn n + (1 # Pos.of_nat (S n))))). - intro n. destruct (Q_dec (yn n) (xn n + (1 # Pos.of_nat (S n)))). + destruct s. * left. apply Qlt_le_weak, q. * right. apply (Qlt_not_le _ _ q). + left. rewrite q. apply Qle_refl. - left. destruct s as [n nmaj]. apply Qnot_le_lt in nmaj. apply (CRlt_le_trans _ (CR_of_Q R (xn n))). + unfold xn. destruct (CR_Q_dense R x (x + CR_of_Q R (1 # Pos.of_nat (S n))) (H x n)). exact (fst p). + apply (CRle_trans _ (CR_of_Q R (yn n - (1 # Pos.of_nat (S n))))). * apply CR_of_Q_le. rewrite <- (Qplus_le_l _ _ (1# Pos.of_nat (S n))). ring_simplify. apply Qlt_le_weak, nmaj. * unfold yn. destruct (CR_Q_dense R y (y + CR_of_Q R (1 # Pos.of_nat (S n))) (H y n)). unfold Qminus. rewrite CR_of_Q_plus, CR_of_Q_opp. apply (CRplus_le_reg_r (CR_of_Q R (1 # Pos.of_nat (S n)))). rewrite CRplus_assoc, CRplus_opp_l, CRplus_0_r. apply CRlt_asym, (snd p). - right. apply (CR_cv_le (fun n => CR_of_Q R (yn n)) (fun n => CR_of_Q R (xn n) + CR_of_Q R (1 # Pos.of_nat (S n)))). + intro n. rewrite <- CR_of_Q_plus. apply CR_of_Q_le. exact (q n). + intro p. exists (Pos.to_nat p). intros. unfold yn. destruct (CR_Q_dense R y (y + CR_of_Q R (1 # Pos.of_nat (S i))) (H y i)). rewrite CRabs_right. * apply (CRplus_le_reg_r y). unfold CRminus. rewrite CRplus_assoc, CRplus_opp_l, CRplus_0_r. rewrite CRplus_comm. apply (CRle_trans _ (y + CR_of_Q R (1 # Pos.of_nat (S i)))). -- apply CRlt_asym, (snd p0). -- apply CRplus_le_compat_l. apply CR_of_Q_le. unfold Qle, Qnum, Qden. rewrite Z.mul_1_l, Z.mul_1_l. apply Pos2Z.pos_le_pos. apply Pos2Nat.inj_le. rewrite Nat2Pos.id. ++ apply le_S, H0. ++ discriminate. * rewrite <- (CRplus_opp_r y). apply CRplus_le_compat_r, CRlt_asym, p0. + apply (CR_cv_proper _ (x+0)). 2: rewrite CRplus_0_r; reflexivity. apply CR_cv_plus. * intro p. exists (Pos.to_nat p). intros. unfold xn. destruct (CR_Q_dense R x (x + CR_of_Q R (1 # Pos.of_nat (S i))) (H x i)). rewrite CRabs_right. -- apply (CRplus_le_reg_r x). unfold CRminus. rewrite CRplus_assoc, CRplus_opp_l, CRplus_0_r. rewrite CRplus_comm. apply (CRle_trans _ (x + CR_of_Q R (1 # Pos.of_nat (S i)))). ++ apply CRlt_asym, (snd p0). ++ apply CRplus_le_compat_l. apply CR_of_Q_le. unfold Qle, Qnum, Qden. rewrite Z.mul_1_l, Z.mul_1_l. apply Pos2Z.pos_le_pos. apply Pos2Nat.inj_le. rewrite Nat2Pos.id. ** apply le_S, H0. ** discriminate. -- rewrite <- (CRplus_opp_r x). apply CRplus_le_compat_r, CRlt_asym, p0. * intro p. exists (Pos.to_nat p). intros. unfold CRminus. rewrite CRopp_0, CRplus_0_r, CRabs_right. -- apply CR_of_Q_le. unfold Qle, Qnum, Qden. rewrite Z.mul_1_l, Z.mul_1_l. apply Pos2Z.pos_le_pos. apply Pos2Nat.inj_le. rewrite Nat2Pos.id. ++ apply le_S, H0. ++ discriminate. -- apply CR_of_Q_le. discriminate. Qed. Lemma is_upper_bound_dec : forall {R : ConstructiveReals} (E:CRcarrier R -> Prop) (x:CRcarrier R), sig_forall_dec_T -> sig_not_dec_T -> { is_upper_bound E x } + { ~is_upper_bound E x }. Proof. intros R E x lpo sig_not_dec. destruct (sig_not_dec (~exists y:CRcarrier R, E y /\ CRltProp R x y)). - left. intros y H. destruct (CRlt_lpo_dec x y lpo). 2: exact c. exfalso. apply n. intro abs. apply abs. clear abs. exists y. split. + exact H. + apply CRltForget. exact c. - right. intro abs. apply n. intros [y [H H0]]. specialize (abs y H). apply CRltEpsilon in H0. contradiction. Qed. Lemma is_upper_bound_epsilon : forall {R : ConstructiveReals} (E:CRcarrier R -> Prop), sig_forall_dec_T -> sig_not_dec_T -> (exists x:CRcarrier R, is_upper_bound E x) -> { n:nat | is_upper_bound E (CR_of_Q R (Z.of_nat n # 1)) }. Proof. intros R E lpo sig_not_dec Ebound. apply constructive_indefinite_ground_description_nat. - intro n. apply is_upper_bound_dec. + exact lpo. + exact sig_not_dec. - destruct Ebound as [x H]. destruct (CRup_nat x) as [n nmaj]. exists n. intros y ey. specialize (H y ey). apply (CRle_trans _ x _ H). apply CRlt_asym, nmaj. Qed. Lemma is_upper_bound_not_epsilon : forall {R : ConstructiveReals} (E:CRcarrier R -> Prop), sig_forall_dec_T -> sig_not_dec_T -> (exists x : CRcarrier R, E x) -> { m:nat | ~is_upper_bound E (-CR_of_Q R (Z.of_nat m # 1)) }. Proof. intros R E lpo sig_not_dec H. apply constructive_indefinite_ground_description_nat. - intro n. destruct (is_upper_bound_dec E (-CR_of_Q R (Z.of_nat n # 1)) lpo sig_not_dec). + right. intro abs. contradiction. + left. exact n0. - destruct H as [x H]. destruct (CRup_nat (-x)) as [n H0]. exists n. intro abs. specialize (abs x H). apply abs. rewrite <- (CRopp_involutive x). apply CRopp_gt_lt_contravar. exact H0. Qed. (* Decidable Dedekind cuts are Cauchy reals. *) Record DedekindDecCut : Type := { DDupcut : Q -> Prop; DDproper : forall q r : Q, (q == r -> DDupcut q -> DDupcut r)%Q; DDlow : Q; DDhigh : Q; DDdec : forall q:Q, { DDupcut q } + { ~DDupcut q }; DDinterval : forall q r : Q, Qle q r -> DDupcut q -> DDupcut r; DDhighProp : DDupcut DDhigh; DDlowProp : ~DDupcut DDlow; }. Lemma DDlow_below_up : forall (upcut : DedekindDecCut) (a b : Q), DDupcut upcut a -> ~DDupcut upcut b -> Qlt b a. Proof. intros. destruct (Qlt_le_dec b a). - exact q. - exfalso. apply H0. apply (DDinterval upcut a). + exact q. + exact H. Qed. Fixpoint DDcut_limit_fix (upcut : DedekindDecCut) (r : Q) (n : nat) : Qlt 0 r -> (DDupcut upcut (DDlow upcut + (Z.of_nat n#1) * r)) -> { q : Q | DDupcut upcut q /\ ~DDupcut upcut (q - r) }. Proof. destruct n. - intros. exfalso. simpl in H0. apply (DDproper upcut _ (DDlow upcut)) in H0. 2: ring. exact (DDlowProp upcut H0). - intros. destruct (DDdec upcut (DDlow upcut + (Z.of_nat n # 1) * r)). + exact (DDcut_limit_fix upcut r n H d). + exists (DDlow upcut + (Z.of_nat (S n) # 1) * r)%Q. split. * exact H0. * intro abs. apply (DDproper upcut _ (DDlow upcut + (Z.of_nat n # 1) * r)) in abs. -- contradiction. -- rewrite Nat2Z.inj_succ. unfold Z.succ. rewrite <- Qinv_plus_distr. ring. Qed. Lemma DDcut_limit : forall (upcut : DedekindDecCut) (r : Q), Qlt 0 r -> { q : Q | DDupcut upcut q /\ ~DDupcut upcut (q - r) }. Proof. intros. destruct (Qarchimedean ((DDhigh upcut - DDlow upcut)/r)) as [n nmaj]. apply (DDcut_limit_fix upcut r (Pos.to_nat n) H). apply (Qmult_lt_r _ _ r) in nmaj. 2: exact H. unfold Qdiv in nmaj. rewrite <- Qmult_assoc, (Qmult_comm (/r)), Qmult_inv_r, Qmult_1_r in nmaj. - apply (DDinterval upcut (DDhigh upcut)). 2: exact (DDhighProp upcut). apply Qlt_le_weak. apply (Qplus_lt_r _ _ (-DDlow upcut)). rewrite Qplus_assoc, <- (Qplus_comm (DDlow upcut)), Qplus_opp_r, Qplus_0_l, Qplus_comm. rewrite positive_nat_Z. exact nmaj. - intros abs. rewrite abs in H. exact (Qlt_irrefl 0 H). Qed. Lemma glb_dec_Q : forall {R : ConstructiveReals} (upcut : DedekindDecCut), { x : CRcarrier R | forall r:Q, (x < CR_of_Q R r -> DDupcut upcut r) /\ (CR_of_Q R r < x -> ~DDupcut upcut r) }. Proof. intros. assert (forall a b : Q, Qle a b -> Qle (-b) (-a)). { intros. apply (Qplus_le_l _ _ (a+b)). ring_simplify. exact H. } assert (CR_cauchy R (fun n:nat => CR_of_Q R (proj1_sig (DDcut_limit upcut (1#Pos.of_nat n) (eq_refl _))))). { intros p. exists (Pos.to_nat p). intros i j pi pj. destruct (DDcut_limit upcut (1 # Pos.of_nat i) eq_refl), (DDcut_limit upcut (1 # Pos.of_nat j) eq_refl); unfold proj1_sig. apply (CRabs_le). split. - intros. unfold CRminus. rewrite <- CR_of_Q_opp, <- CR_of_Q_opp, <- CR_of_Q_plus. apply CR_of_Q_le. apply (Qplus_le_l _ _ x0). ring_simplify. setoid_replace (-1 * (1 # p) + x0)%Q with (x0 - (1 # p))%Q. 2: ring. apply (Qle_trans _ (x0- (1#Pos.of_nat j))). + apply Qplus_le_r. apply H. apply Z2Nat.inj_le. * discriminate. * discriminate. * simpl. rewrite Nat2Pos.id. -- exact pj. -- intro abs. subst j. inversion pj. pose proof (Pos2Nat.is_pos p). rewrite H1 in H0. inversion H0. + apply Qlt_le_weak, (DDlow_below_up upcut). * apply a. * apply a0. - unfold CRminus. rewrite <- CR_of_Q_opp, <- CR_of_Q_plus. apply CR_of_Q_le. apply (Qplus_le_l _ _ (x0-(1#p))). ring_simplify. setoid_replace (x -1 * (1 # p))%Q with (x - (1 # p))%Q. 2: ring. apply (Qle_trans _ (x- (1#Pos.of_nat i))). + apply Qplus_le_r. apply H. apply Z2Nat.inj_le. * discriminate. * discriminate. * simpl. rewrite Nat2Pos.id. -- exact pi. -- intro abs. subst i. inversion pi. pose proof (Pos2Nat.is_pos p). rewrite H1 in H0. inversion H0. + apply Qlt_le_weak, (DDlow_below_up upcut). * apply a0. * apply a. } apply CR_complete in H0. destruct H0 as [l lcv]. exists l. split. - intros. (* find an upper point between the limit and r *) destruct (CR_cv_open_above _ (CR_of_Q R r) l lcv H0) as [p pmaj]. specialize (pmaj p (Nat.le_refl p)). unfold proj1_sig in pmaj. destruct (DDcut_limit upcut (1 # Pos.of_nat p) eq_refl) as [q qmaj]. apply (DDinterval upcut q). 2: apply qmaj. destruct (Q_dec q r). + destruct s. * apply Qlt_le_weak, q0. * exfalso. apply (CR_of_Q_lt R) in q0. exact (CRlt_asym _ _ pmaj q0). + rewrite q0. apply Qle_refl. - intros H0 abs. assert ((CR_of_Q R r+l) * CR_of_Q R (1#2) < l). { apply (CRmult_lt_reg_r (CR_of_Q R 2)). - apply CR_of_Q_pos. reflexivity. - rewrite CRmult_assoc, <- CR_of_Q_mult, (CR_of_Q_plus R 1 1). setoid_replace ((1 # 2) * 2)%Q with 1%Q. 2: reflexivity. rewrite CRmult_plus_distr_l, CRmult_1_r, CRmult_1_r. apply CRplus_lt_compat_r. exact H0. } destruct (CR_cv_open_below _ _ l lcv H1) as [p pmaj]. assert (0 < (l-CR_of_Q R r) * CR_of_Q R (1#2)). { apply CRmult_lt_0_compat. - rewrite <- (CRplus_opp_r (CR_of_Q R r)). apply CRplus_lt_compat_r. exact H0. - apply CR_of_Q_pos. reflexivity. } destruct (CRup_nat (CRinv R _ (inr H2))) as [i imaj]. destruct i. + exfalso. simpl in imaj. exact (CRlt_asym _ _ imaj (CRinv_0_lt_compat R _ (inr H2) H2)). + specialize (pmaj (max (S i) (S p)) (Nat.le_trans p (S p) _ (le_S p p (Nat.le_refl p)) (Nat.le_max_r (S i) (S p)))). unfold proj1_sig in pmaj. destruct (DDcut_limit upcut (1 # Pos.of_nat (max (S i) (S p))) eq_refl) as [q qmaj]. destruct qmaj. apply H4. clear H4. apply (DDinterval upcut r). 2: exact abs. apply (Qplus_le_l _ _ (1 # Pos.of_nat (Init.Nat.max (S i) (S p)))). ring_simplify. apply (Qle_trans _ (r + (1 # Pos.of_nat (S i)))). * rewrite Qplus_le_r. unfold Qle,Qnum,Qden. rewrite Z.mul_1_l, Z.mul_1_l. apply Pos2Z.pos_le_pos. apply Pos2Nat.inj_le. rewrite Nat2Pos.id, Nat2Pos.id. -- apply Nat.le_max_l. -- discriminate. -- discriminate. * apply (CRmult_lt_compat_l ((l - CR_of_Q R r) * CR_of_Q R (1 # 2))) in imaj. 2: exact H2. rewrite CRinv_r in imaj. destruct (Q_dec (r+(1#Pos.of_nat (S i))) q);[|rewrite q0; apply Qle_refl]. destruct s. { apply Qlt_le_weak, q0. } exfalso. apply (CR_of_Q_lt R) in q0. apply (CRlt_asym _ _ pmaj). apply (CRlt_le_trans _ _ _ q0). apply (CRplus_le_reg_l (-CR_of_Q R r)). rewrite CR_of_Q_plus, <- CRplus_assoc, CRplus_opp_l, CRplus_0_l. apply (CRmult_lt_compat_r (CR_of_Q R (1 # Pos.of_nat (S i)))) in imaj. -- rewrite CRmult_1_l in imaj. apply (CRle_trans _ ( (l - CR_of_Q R r) * CR_of_Q R (1 # 2) * CR_of_Q R (Z.of_nat (S i) # 1) * CR_of_Q R (1 # Pos.of_nat (S i)))). ++ apply CRlt_asym, imaj. ++ rewrite CRmult_assoc, <- CR_of_Q_mult. setoid_replace ((Z.of_nat (S i) # 1) * (1 # Pos.of_nat (S i)))%Q with 1%Q. ** rewrite CRmult_1_r. unfold CRminus. rewrite CRmult_plus_distr_r, (CRplus_comm (-CR_of_Q R r)). rewrite (CRplus_comm (CR_of_Q R r)), CRmult_plus_distr_r. rewrite CRplus_assoc. apply CRplus_le_compat_l. rewrite <- CR_of_Q_mult, <- CR_of_Q_opp, <- CR_of_Q_mult, <- CR_of_Q_plus. apply CR_of_Q_le. ring_simplify. apply Qle_refl. ** unfold Qeq, Qmult, Qnum, Qden. rewrite Z.mul_1_r, Z.mul_1_r. rewrite Z.mul_1_l, Pos.mul_1_l. unfold Z.of_nat. apply f_equal. apply Pos.of_nat_succ. -- apply CR_of_Q_pos. reflexivity. Qed. Lemma is_upper_bound_glb : forall {R : ConstructiveReals} (E:CRcarrier R -> Prop), sig_not_dec_T -> sig_forall_dec_T -> (exists x : CRcarrier R, E x) -> (exists x : CRcarrier R, is_upper_bound E x) -> { x : CRcarrier R | forall r:Q, (x < CR_of_Q R r -> is_upper_bound E (CR_of_Q R r)) /\ (CR_of_Q R r < x -> ~is_upper_bound E (CR_of_Q R r)) }. Proof. intros R E sig_not_dec lpo Einhab Ebound. destruct (is_upper_bound_epsilon E lpo sig_not_dec Ebound) as [a luba]. destruct (is_upper_bound_not_epsilon E lpo sig_not_dec Einhab) as [b glbb]. pose (fun q => is_upper_bound E (CR_of_Q R q)) as upcut. assert (forall q:Q, { upcut q } + { ~upcut q } ). { intro q. apply is_upper_bound_dec. - exact lpo. - exact sig_not_dec. } assert (forall q r : Q, (q <= r)%Q -> upcut q -> upcut r). { intros. intros x Ex. specialize (H1 x Ex). intro abs. apply H1. apply (CRle_lt_trans _ (CR_of_Q R r)). 2: exact abs. apply CR_of_Q_le. exact H0. } assert (upcut (Z.of_nat a # 1)%Q). { intros x Ex. exact (luba x Ex). } assert (~upcut (- Z.of_nat b # 1)%Q). { intros abs. apply glbb. intros x Ex. specialize (abs x Ex). rewrite <- CR_of_Q_opp. exact abs. } assert (forall q r : Q, (q == r)%Q -> upcut q -> upcut r). { intros. intros x Ex. specialize (H4 x Ex). rewrite <- H3. exact H4. } destruct (@glb_dec_Q R (Build_DedekindDecCut upcut H3 (-Z.of_nat b # 1)%Q (Z.of_nat a # 1) H H0 H1 H2)). simpl in a0. exists x. intro r. split. - intros. apply a0. exact H4. - intros H6 abs. specialize (a0 r) as [_ a0]. apply a0. + exact H6. + exact abs. Qed. Lemma is_upper_bound_closed : forall {R : ConstructiveReals} (E:CRcarrier R -> Prop) (sig_forall_dec : sig_forall_dec_T) (sig_not_dec : sig_not_dec_T) (Einhab : exists x : CRcarrier R, E x) (Ebound : exists x : CRcarrier R, is_upper_bound E x), is_lub E (proj1_sig (is_upper_bound_glb E sig_not_dec sig_forall_dec Einhab Ebound)). Proof. intros. split. - intros x Ex. destruct (is_upper_bound_glb E sig_not_dec sig_forall_dec Einhab Ebound); simpl. intro abs. destruct (CR_Q_dense R x0 x abs) as [q [qmaj H]]. specialize (a q) as [a _]. specialize (a qmaj x Ex). contradiction. - intros. destruct (is_upper_bound_glb E sig_not_dec sig_forall_dec Einhab Ebound); simpl. intro abs. destruct (CR_Q_dense R b x abs) as [q [qmaj H0]]. specialize (a q) as [_ a]. apply a. + exact H0. + intros y Ey. specialize (H y Ey). intro abs2. apply H. exact (CRlt_trans _ (CR_of_Q R q) _ qmaj abs2). Qed. Lemma sig_lub : forall {R : ConstructiveReals} (E:CRcarrier R -> Prop), sig_forall_dec_T -> sig_not_dec_T -> (exists x : CRcarrier R, E x) -> (exists x : CRcarrier R, is_upper_bound E x) -> { u : CRcarrier R | is_lub E u }. Proof. intros R E sig_forall_dec sig_not_dec Einhab Ebound. pose proof (is_upper_bound_closed E sig_forall_dec sig_not_dec Einhab Ebound). destruct (is_upper_bound_glb E sig_not_dec sig_forall_dec Einhab Ebound); simpl in H. exists x. exact H. Qed. Definition CRis_upper_bound {R : ConstructiveReals} (E:CRcarrier R -> Prop) (m:CRcarrier R) := forall x:CRcarrier R, E x -> CRlt R m x -> False. Lemma CR_sig_lub : forall {R : ConstructiveReals} (E:CRcarrier R -> Prop), (forall x y : CRcarrier R, CReq R x y -> (E x <-> E y)) -> sig_forall_dec_T -> sig_not_dec_T -> (exists x : CRcarrier R, E x) -> (exists x : CRcarrier R, CRis_upper_bound E x) -> { u : CRcarrier R | CRis_upper_bound E u /\ forall y:CRcarrier R, CRis_upper_bound E y -> CRlt R y u -> False }. Proof. intros. exact (sig_lub E X X0 H0 H1). Qed. coq-8.20.0/theories/Reals/Abstract/ConstructiveLimits.v000066400000000000000000000455111466560755400231070ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * INRIA, CNRS and contributors - Copyright 1999-2019 *) (* CRcarrier R) (l : CRcarrier R), (forall n:nat, xn n == yn n) -> CR_cv R xn l -> CR_cv R yn l. Proof. intros. intro p. specialize (H0 p) as [n nmaj]. exists n. intros. specialize (nmaj i H0). apply (CRle_trans _ (CRabs R (CRminus R (xn i) l))). 2: exact nmaj. rewrite <- CRabs_def. split. - apply (CRle_trans _ (CRminus R (xn i) l)). + apply CRplus_le_compat_r. specialize (H i) as [H _]. exact H. + pose proof (CRabs_def R (CRminus R (xn i) l) (CRabs R (CRminus R (xn i) l))) as [_ H1]. apply H1. apply CRle_refl. - apply (CRle_trans _ (CRopp R (CRminus R (xn i) l))). + intro abs. apply CRopp_lt_cancel, CRplus_lt_reg_r in abs. specialize (H i) as [_ H]. contradiction. + pose proof (CRabs_def R (CRminus R (xn i) l) (CRabs R (CRminus R (xn i) l))) as [_ H1]. apply H1. apply CRle_refl. Qed. Lemma CR_cv_opp : forall {R : ConstructiveReals} (xn : nat -> CRcarrier R) (l : CRcarrier R), CR_cv R xn l -> CR_cv R (fun n => - xn n) (- l). Proof. intros. intro p. specialize (H p) as [n nmaj]. exists n. intros. specialize (nmaj i H). apply (CRle_trans _ (CRabs R (CRminus R (xn i) l))). 2: exact nmaj. clear nmaj H. unfold CRminus. rewrite <- CRopp_plus_distr, CRabs_opp. apply CRle_refl. Qed. Lemma CR_cv_plus : forall {R : ConstructiveReals} (xn yn : nat -> CRcarrier R) (a b : CRcarrier R), CR_cv R xn a -> CR_cv R yn b -> CR_cv R (fun n => xn n + yn n) (a + b). Proof. intros. intro p. specialize (H (2*p)%positive) as [i imaj]. specialize (H0 (2*p)%positive) as [j jmaj]. exists (max i j). intros. apply (CRle_trans _ (CRabs R (CRplus R (CRminus R (xn i0) a) (CRminus R (yn i0) b)))). - apply CRabs_morph. unfold CRminus. do 2 rewrite <- (Radd_assoc (CRisRing R)). apply CRplus_morph. + reflexivity. + rewrite CRopp_plus_distr. destruct (CRisRing R). rewrite Radd_comm, <- Radd_assoc. apply CRplus_morph. * reflexivity. * rewrite Radd_comm. reflexivity. - apply (CRle_trans _ _ _ (CRabs_triang _ _)). apply (CRle_trans _ (CRplus R (CR_of_Q R (1 # 2*p)) (CR_of_Q R (1 # 2*p)))). + apply CRplus_le_compat. * apply imaj, (Nat.le_trans _ _ _ (Nat.le_max_l _ _) H). * apply jmaj, (Nat.le_trans _ _ _ (Nat.le_max_r _ _) H). + apply (CRle_trans _ (CR_of_Q R ((1 # 2 * p) + (1 # 2 * p)))). * apply CR_of_Q_plus. * apply CR_of_Q_le. rewrite Qinv_plus_distr. setoid_replace (1 + 1 # 2 * p) with (1 # p). -- apply Qle_refl. -- reflexivity. Qed. Lemma CR_cv_unique : forall {R : ConstructiveReals} (xn : nat -> CRcarrier R) (a b : CRcarrier R), CR_cv R xn a -> CR_cv R xn b -> a == b. Proof. intros. assert (CR_cv R (fun _ => 0) (CRminus R b a)). { apply (CR_cv_extens (fun n => CRminus R (xn n) (xn n))). - intro n. unfold CRminus. apply CRplus_opp_r. - apply CR_cv_plus. + exact H0. + apply CR_cv_opp, H. } assert (forall q r : Q, 0 < q -> / q < r -> 1 < q * r)%Q. { intros. apply (Qmult_lt_l _ _ q) in H3. - rewrite Qmult_inv_r in H3. + exact H3. + intro abs. rewrite abs in H2. exact (Qlt_irrefl 0 H2). - exact H2. } clear H H0 xn. remember (CRminus R b a) as z. assert (z == 0). 1:split. - intro abs. destruct (CR_Q_dense R _ _ abs) as [q [H0 H]]. destruct (Qarchimedean (/(-q))) as [p pmaj]. specialize (H1 p) as [n nmaj]. specialize (nmaj n (Nat.le_refl n)). apply nmaj. apply (CRlt_trans _ (CR_of_Q R (-q))). + apply CR_of_Q_lt. apply H2 in pmaj. * apply (Qmult_lt_r _ _ (1#p)) in pmaj. 2: reflexivity. rewrite Qmult_1_l, <- Qmult_assoc in pmaj. setoid_replace ((Z.pos p # 1) * (1 # p))%Q with 1%Q in pmaj. -- rewrite Qmult_1_r in pmaj. exact pmaj. -- unfold Qeq, Qnum, Qden; simpl. do 2 rewrite Pos.mul_1_r. reflexivity. * apply (Qplus_lt_l _ _ q). ring_simplify. apply (lt_CR_of_Q R q 0). exact H. + apply (CRlt_le_trans _ (CRopp R z)). * apply (CRle_lt_trans _ (CRopp R (CR_of_Q R q))). -- apply CR_of_Q_opp. -- apply CRopp_gt_lt_contravar, H0. * apply (CRle_trans _ (CRabs R (CRopp R z))). -- pose proof (CRabs_def R (CRopp R z) (CRabs R (CRopp R z))) as [_ H1]. apply H1, CRle_refl. -- apply CRabs_morph. unfold CRminus. symmetry. apply CRplus_0_l. - intro abs. destruct (CR_Q_dense R _ _ abs) as [q [H0 H]]. destruct (Qarchimedean (/q)) as [p pmaj]. specialize (H1 p) as [n nmaj]. specialize (nmaj n (Nat.le_refl n)). apply nmaj. apply (CRlt_trans _ (CR_of_Q R q)). + apply CR_of_Q_lt. apply H2 in pmaj. * apply (Qmult_lt_r _ _ (1#p)) in pmaj. 2: reflexivity. rewrite Qmult_1_l, <- Qmult_assoc in pmaj. setoid_replace ((Z.pos p # 1) * (1 # p))%Q with 1%Q in pmaj. -- rewrite Qmult_1_r in pmaj. exact pmaj. -- unfold Qeq, Qnum, Qden; simpl. do 2 rewrite Pos.mul_1_r. reflexivity. * apply (lt_CR_of_Q R 0 q). exact H0. + apply (CRlt_le_trans _ _ _ H). apply (CRle_trans _ (CRabs R (CRopp R z))). * apply (CRle_trans _ (CRabs R z)). -- pose proof (CRabs_def R z (CRabs R z)) as [_ H1]. apply H1. apply CRle_refl. -- apply CRabs_opp. * apply CRabs_morph. unfold CRminus. symmetry. apply CRplus_0_l. - subst z. apply (CRplus_eq_reg_l (CRopp R a)). rewrite CRplus_opp_l, CRplus_comm. symmetry. exact H. Qed. Lemma CR_cv_eq : forall {R : ConstructiveReals} (v u : nat -> CRcarrier R) (s : CRcarrier R), (forall n:nat, u n == v n) -> CR_cv R u s -> CR_cv R v s. Proof. intros R v u s seq H1 p. specialize (H1 p) as [N H0]. exists N. intros. unfold CRminus. rewrite <- seq. apply H0, H. Qed. Lemma CR_cauchy_eq : forall {R : ConstructiveReals} (un vn : nat -> CRcarrier R), (forall n:nat, un n == vn n) -> CR_cauchy R un -> CR_cauchy R vn. Proof. intros. intro p. specialize (H0 p) as [n H0]. exists n. intros. specialize (H0 i j H1 H2). unfold CRminus in H0. rewrite <- CRabs_def. rewrite <- CRabs_def in H0. do 2 rewrite H in H0. exact H0. Qed. Lemma CR_cv_proper : forall {R : ConstructiveReals} (un : nat -> CRcarrier R) (a b : CRcarrier R), CR_cv R un a -> a == b -> CR_cv R un b. Proof. intros. intro p. specialize (H p) as [n H]. exists n. intros. unfold CRminus. rewrite <- H0. apply H, H1. Qed. #[global] Instance CR_cv_morph : forall {R : ConstructiveReals} (un : nat -> CRcarrier R), CMorphisms.Proper (CMorphisms.respectful (CReq R) CRelationClasses.iffT) (CR_cv R un). Proof. split. - intros. apply (CR_cv_proper un x). + exact H0. + exact H. - intros. apply (CR_cv_proper un y). + exact H0. + symmetry. exact H. Qed. Lemma Un_cv_nat_real : forall {R : ConstructiveReals} (un : nat -> CRcarrier R) (l : CRcarrier R), CR_cv R un l -> forall eps : CRcarrier R, 0 < eps -> { p : nat & forall i:nat, le p i -> CRabs R (un i - l) < eps }. Proof. intros. destruct (CR_archimedean R (CRinv R eps (inr H0))) as [k kmaj]. assert (0 < CR_of_Q R (Z.pos k # 1)). { apply CR_of_Q_lt. reflexivity. } specialize (H k) as [p pmaj]. exists p. intros. apply (CRle_lt_trans _ (CR_of_Q R (1 # k))). - apply pmaj, H. - apply (CRmult_lt_reg_l (CR_of_Q R (Z.pos k # 1))). + exact H1. + rewrite <- CR_of_Q_mult. apply (CRle_lt_trans _ 1). * apply CR_of_Q_le. unfold Qle; simpl. do 2 rewrite Pos.mul_1_r. apply Z.le_refl. * apply (CRmult_lt_reg_r (CRinv R eps (inr H0))). -- apply CRinv_0_lt_compat, H0. -- rewrite CRmult_1_l, CRmult_assoc. rewrite CRinv_r, CRmult_1_r. exact kmaj. Qed. Lemma Un_cv_real_nat : forall {R : ConstructiveReals} (un : nat -> CRcarrier R) (l : CRcarrier R), (forall eps : CRcarrier R, 0 < eps -> { p : nat & forall i:nat, le p i -> CRabs R (un i - l) < eps }) -> CR_cv R un l. Proof. intros. intros n. specialize (H (CR_of_Q R (1#n))) as [p pmaj]. - apply CR_of_Q_lt. reflexivity. - exists p. intros. apply CRlt_asym. apply pmaj. apply H. Qed. Lemma CR_cv_minus : forall {R : ConstructiveReals} (An Bn:nat -> CRcarrier R) (l1 l2:CRcarrier R), CR_cv R An l1 -> CR_cv R Bn l2 -> CR_cv R (fun i:nat => An i - Bn i) (l1 - l2). Proof. intros. apply CR_cv_plus. - apply H. - intros p. specialize (H0 p) as [n H0]. exists n. intros. setoid_replace (- Bn i - - l2) with (- (Bn i - l2)). + rewrite CRabs_opp. apply H0, H1. + unfold CRminus. rewrite CRopp_plus_distr, CRopp_involutive. reflexivity. Qed. Lemma CR_cv_nonneg : forall {R : ConstructiveReals} (An:nat -> CRcarrier R) (l:CRcarrier R), CR_cv R An l -> (forall n:nat, 0 <= An n) -> 0 <= l. Proof. intros. intro abs. destruct (Un_cv_nat_real _ l H (-l)) as [N H1]. - rewrite <- CRopp_0. apply CRopp_gt_lt_contravar. apply abs. - specialize (H1 N (Nat.le_refl N)). pose proof (CRabs_def R (An N - l) (CRabs R (An N - l))) as [_ H2]. apply (CRle_lt_trans _ _ _ (CRle_abs _)) in H1. apply (H0 N). apply (CRplus_lt_reg_r (-l)). rewrite CRplus_0_l. exact H1. Qed. Lemma CR_cv_scale : forall {R : ConstructiveReals} (u : nat -> CRcarrier R) (a : CRcarrier R) (s : CRcarrier R), CR_cv R u s -> CR_cv R (fun n => u n * a) (s * a). Proof. intros. intros n. destruct (CR_archimedean R (1 + CRabs R a)). destruct (H (n * x)%positive). exists x0. intros. unfold CRminus. rewrite CRopp_mult_distr_l. rewrite <- CRmult_plus_distr_r. apply (CRle_trans _ ((CR_of_Q R (1 # n * x)) * CRabs R a)). - rewrite CRabs_mult. apply CRmult_le_compat_r. + apply CRabs_pos. + apply c0, H0. - setoid_replace (1 # n * x)%Q with ((1 # n) *(1# x))%Q. 2: reflexivity. rewrite <- (CRmult_1_r (CR_of_Q R (1#n))). rewrite CR_of_Q_mult, CRmult_assoc. apply CRmult_le_compat_l. + apply CR_of_Q_le. discriminate. + intro abs. apply (CRmult_lt_compat_l (CR_of_Q R (Z.pos x #1))) in abs. * rewrite CRmult_1_r, <- CRmult_assoc, <- CR_of_Q_mult in abs. rewrite (CR_of_Q_morph R ((Z.pos x # 1) * (1 # x))%Q 1%Q) in abs. -- rewrite CRmult_1_l in abs. apply (CRlt_asym _ _ abs), (CRlt_trans _ (1 + CRabs R a)). 2: exact c. rewrite <- CRplus_0_l, <- CRplus_assoc. apply CRplus_lt_compat_r. rewrite CRplus_0_r. apply CRzero_lt_one. -- unfold Qmult, Qeq, Qnum, Qden. ring_simplify. rewrite Pos.mul_1_l. reflexivity. * apply (CRlt_trans _ (1+CRabs R a)). 2: exact c. rewrite CRplus_comm. rewrite <- (CRplus_0_r 0). apply CRplus_le_lt_compat. -- apply CRabs_pos. -- apply CRzero_lt_one. Qed. Lemma CR_cv_const : forall {R : ConstructiveReals} (a : CRcarrier R), CR_cv R (fun n => a) a. Proof. intros a p. exists O. intros. unfold CRminus. rewrite CRplus_opp_r. rewrite CRabs_right. - apply CR_of_Q_le. discriminate. - apply CRle_refl. Qed. Lemma Rcv_cauchy_mod : forall {R : ConstructiveReals} (un : nat -> CRcarrier R) (l : CRcarrier R), CR_cv R un l -> CR_cauchy R un. Proof. intros. intros p. specialize (H (2*p)%positive) as [k H]. exists k. intros n q H0 H1. setoid_replace (1#p)%Q with ((1#2*p) + (1#2*p))%Q. - rewrite CR_of_Q_plus. setoid_replace (un n - un q) with ((un n - l) - (un q - l)). + apply (CRle_trans _ _ _ (CRabs_triang _ _)). apply CRplus_le_compat. * apply H, H0. * rewrite CRabs_opp. apply H. apply H1. + unfold CRminus. rewrite CRplus_assoc. apply CRplus_morph. * reflexivity. * rewrite CRplus_comm, CRopp_plus_distr, CRopp_involutive. rewrite CRplus_assoc, CRplus_opp_r, CRplus_0_r. reflexivity. - rewrite Qinv_plus_distr. reflexivity. Qed. Lemma CR_growing_transit : forall {R : ConstructiveReals} (un : nat -> CRcarrier R), (forall n:nat, un n <= un (S n)) -> forall n p : nat, le n p -> un n <= un p. Proof. induction p. - intros. inversion H0. apply CRle_refl. - intros. apply Nat.le_succ_r in H0. destruct H0. + apply (CRle_trans _ (un p)). * apply IHp, H0. * apply H. + subst n. apply CRle_refl. Qed. Lemma growing_ineq : forall {R : ConstructiveReals} (Un:nat -> CRcarrier R) (l:CRcarrier R), (forall n:nat, Un n <= Un (S n)) -> CR_cv R Un l -> forall n:nat, Un n <= l. Proof. intros. intro abs. destruct (Un_cv_nat_real _ l H0 (Un n - l)) as [N H1]. - rewrite <- (CRplus_opp_r l). apply CRplus_lt_compat_r. exact abs. - specialize (H1 (max n N) (Nat.le_max_r _ _)). apply (CRle_lt_trans _ _ _ (CRle_abs _)) in H1. apply CRplus_lt_reg_r in H1. apply (CR_growing_transit Un H n (max n N)). + apply Nat.le_max_l. + exact H1. Qed. Lemma CR_cv_open_below : forall {R : ConstructiveReals} (un : nat -> CRcarrier R) (m l : CRcarrier R), CR_cv R un l -> m < l -> { n : nat & forall i:nat, le n i -> m < un i }. Proof. intros. apply CRlt_minus in H0. pose proof (Un_cv_nat_real _ l H (l-m) H0) as [n nmaj]. exists n. intros. specialize (nmaj i H1). apply CRabs_lt in nmaj. destruct nmaj as [_ nmaj]. unfold CRminus in nmaj. rewrite CRopp_plus_distr, CRopp_involutive, CRplus_comm in nmaj. apply CRplus_lt_reg_l in nmaj. apply (CRplus_lt_reg_l R (-m)). rewrite CRplus_opp_l. apply (CRplus_lt_reg_r (-un i)). rewrite CRplus_0_l. rewrite CRplus_assoc, CRplus_opp_r, CRplus_0_r. exact nmaj. Qed. Lemma CR_cv_open_above : forall {R : ConstructiveReals} (un : nat -> CRcarrier R) (m l : CRcarrier R), CR_cv R un l -> l < m -> { n : nat & forall i:nat, le n i -> un i < m }. Proof. intros. apply CRlt_minus in H0. pose proof (Un_cv_nat_real _ l H (m-l) H0) as [n nmaj]. exists n. intros. specialize (nmaj i H1). apply CRabs_lt in nmaj. destruct nmaj as [nmaj _]. apply CRplus_lt_reg_r in nmaj. exact nmaj. Qed. Lemma CR_cv_bound_down : forall {R : ConstructiveReals} (u : nat -> CRcarrier R) (A l : CRcarrier R) (N : nat), (forall n:nat, le N n -> A <= u n) -> CR_cv R u l -> A <= l. Proof. intros. intro r. apply (CRplus_lt_compat_r (-l)) in r. rewrite CRplus_opp_r in r. destruct (Un_cv_nat_real _ l H0 (A - l) r) as [n H1]. apply (H (n+N)%nat). - rewrite <- (Nat.add_0_l N), Nat.add_assoc. apply Nat.add_le_mono_r, Nat.le_0_l. - specialize (H1 (n+N)%nat). apply (CRplus_lt_reg_r (-l)). assert (n + N >= n)%nat. + rewrite <- (Nat.add_0_r n), <- Nat.add_assoc. apply Nat.add_le_mono_l, Nat.le_0_l. + specialize (H1 H2). apply (CRle_lt_trans _ (CRabs R (u (n + N)%nat - l))). * apply CRle_abs. * assumption. Qed. Lemma CR_cv_bound_up : forall {R : ConstructiveReals} (u : nat -> CRcarrier R) (A l : CRcarrier R) (N : nat), (forall n:nat, le N n -> u n <= A) -> CR_cv R u l -> l <= A. Proof. intros. intro r. apply (CRplus_lt_compat_r (-A)) in r. rewrite CRplus_opp_r in r. destruct (Un_cv_nat_real _ l H0 (l-A) r) as [n H1]. apply (H (n+N)%nat). - rewrite <- (Nat.add_0_l N). apply Nat.add_le_mono_r, Nat.le_0_l. - specialize (H1 (n+N)%nat). apply (CRplus_lt_reg_l R (l - A - u (n+N)%nat)). unfold CRminus. repeat rewrite CRplus_assoc. rewrite CRplus_opp_l, CRplus_0_r, (CRplus_comm (-A)). rewrite CRplus_assoc, CRplus_opp_r, CRplus_0_r. apply (CRle_lt_trans _ _ _ (CRle_abs _)). fold (l - u (n+N)%nat). rewrite CRabs_minus_sym. apply H1. rewrite <- (Nat.add_0_r n), <- Nat.add_assoc. apply Nat.add_le_mono_l, Nat.le_0_l. Qed. Lemma CR_cv_le : forall {R : ConstructiveReals} (u v : nat -> CRcarrier R) (a b : CRcarrier R), (forall n:nat, u n <= v n) -> CR_cv R u a -> CR_cv R v b -> a <= b. Proof. intros. apply (CRplus_le_reg_r (-a)). rewrite CRplus_opp_r. apply (CR_cv_bound_down (fun i:nat => v i - u i) _ _ 0). - intros. rewrite <- (CRplus_opp_l (u n)). unfold CRminus. rewrite (CRplus_comm (v n)). apply CRplus_le_compat_l. apply H. - apply CR_cv_plus. + exact H1. + apply CR_cv_opp, H0. Qed. Lemma CR_cv_abs_cont : forall {R : ConstructiveReals} (u : nat -> CRcarrier R) (s : CRcarrier R), CR_cv R u s -> CR_cv R (fun n => CRabs R (u n)) (CRabs R s). Proof. intros. intros eps. specialize (H eps) as [N lim]. exists N. intros n H. apply (CRle_trans _ (CRabs R (u n - s))). - apply CRabs_triang_inv2. - apply lim. assumption. Qed. Lemma CR_cv_dist_cont : forall {R : ConstructiveReals} (u : nat -> CRcarrier R) (a s : CRcarrier R), CR_cv R u s -> CR_cv R (fun n => CRabs R (a - u n)) (CRabs R (a - s)). Proof. intros. apply CR_cv_abs_cont. intros eps. specialize (H eps) as [N lim]. exists N. intros n H. setoid_replace (a - u n - (a - s)) with (s - (u n)). - specialize (lim n). rewrite CRabs_minus_sym. apply lim. assumption. - unfold CRminus. rewrite CRopp_plus_distr, CRopp_involutive. rewrite (CRplus_comm a), (CRplus_comm s). rewrite CRplus_assoc. apply CRplus_morph. + reflexivity. + rewrite <- CRplus_assoc, CRplus_opp_r, CRplus_0_l. reflexivity. Qed. Lemma CR_cv_shift : forall {R : ConstructiveReals} f k l, CR_cv R (fun n => f (n + k)%nat) l -> CR_cv R f l. Proof. intros. intros eps. specialize (H eps) as [N Nmaj]. exists (N+k)%nat. intros n H. destruct (Nat.le_exists_sub k n). - apply (Nat.le_trans _ (N + k)). 2: exact H. apply (Nat.le_trans _ (0 + k)). + apply Nat.le_refl. + rewrite <- Nat.add_le_mono_r. apply Nat.le_0_l. - destruct H0. subst n. apply Nmaj. unfold ge in H. rewrite <- Nat.add_le_mono_r in H. exact H. Qed. Lemma CR_cv_shift' : forall {R : ConstructiveReals} f k l, CR_cv R f l -> CR_cv R (fun n => f (n + k)%nat) l. Proof. intros R f' k l cvf eps; destruct (cvf eps) as [N Pn]. exists N; intros n nN; apply Pn; auto. apply Nat.le_trans with n; [ assumption | apply Nat.le_add_r ]. Qed. coq-8.20.0/theories/Reals/Abstract/ConstructiveMinMax.v000066400000000000000000000647761466560755400230550ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * INRIA, CNRS and contributors - Copyright 1999-2019 *) (* CRmin x y == x. Proof. intros. unfold CRmin. unfold CRmin in H. apply (CRmult_eq_reg_r (CR_of_Q R 2)). - left; apply CR_of_Q_pos; reflexivity. - rewrite CRmult_assoc, <- CR_of_Q_mult. setoid_replace ((1 # 2) * 2)%Q with 1%Q. 2: reflexivity. rewrite CRmult_1_r. rewrite (CR_of_Q_plus R 1 1), CRmult_plus_distr_l, CRmult_1_r. rewrite CRabs_right. + unfold CRminus. rewrite CRopp_plus_distr, CRplus_assoc, <- (CRplus_assoc y). rewrite CRplus_opp_r, CRplus_0_l, CRopp_involutive. reflexivity. + apply (CRmult_lt_compat_r (CR_of_Q R 2)) in H. 2: apply CR_of_Q_pos; reflexivity. intro abs. contradict H. apply (CRle_trans _ (x + y - CRabs R (y - x))). * rewrite CRabs_left. 2: apply CRlt_asym, abs. unfold CRminus. rewrite CRopp_involutive, CRplus_comm. rewrite CRplus_assoc, <- (CRplus_assoc (-x)), CRplus_opp_l. rewrite CRplus_0_l, (CR_of_Q_plus R 1 1), CRmult_plus_distr_l. rewrite CRmult_1_r. apply CRle_refl. * rewrite CRmult_assoc, <- CR_of_Q_mult. setoid_replace ((1 # 2) * 2)%Q with 1%Q. 2: reflexivity. rewrite CRmult_1_r. apply CRle_refl. Qed. Add Parametric Morphism {R : ConstructiveReals} : CRmin with signature (CReq R) ==> (CReq R) ==> (CReq R) as CRmin_morph. Proof. intros. unfold CRmin. apply CRmult_morph. 2: reflexivity. unfold CRminus. rewrite H, H0. reflexivity. Qed. #[global] Instance CRmin_morphT : forall {R : ConstructiveReals}, CMorphisms.Proper (CMorphisms.respectful (CReq R) (CMorphisms.respectful (CReq R) (CReq R))) (@CRmin R). Proof. intros R x y H z t H0. rewrite H, H0. reflexivity. Qed. Lemma CRmin_l : forall {R : ConstructiveReals} (x y : CRcarrier R), CRmin x y <= x. Proof. intros. unfold CRmin. apply (CRmult_le_reg_r (CR_of_Q R 2)). - apply CR_of_Q_lt; reflexivity. - rewrite CRmult_assoc, <- CR_of_Q_mult. setoid_replace ((1 # 2) * 2)%Q with 1%Q. 2: reflexivity. rewrite CRmult_1_r. rewrite (CR_of_Q_plus _ 1 1), CRmult_plus_distr_l, CRmult_1_r. unfold CRminus. rewrite CRplus_assoc. apply CRplus_le_compat_l. apply (CRplus_le_reg_r (CRabs _ (y + - x)+ -x)). rewrite CRplus_assoc, <- (CRplus_assoc (-CRabs _ (y + - x))). rewrite CRplus_opp_l, CRplus_0_l. rewrite (CRplus_comm x), CRplus_assoc, CRplus_opp_l, CRplus_0_r. apply CRle_abs. Qed. Lemma CRmin_r : forall {R : ConstructiveReals} (x y : CRcarrier R), CRmin x y <= y. Proof. intros. unfold CRmin. apply (CRmult_le_reg_r (CR_of_Q R 2)). - apply CR_of_Q_lt; reflexivity. - rewrite CRmult_assoc, <- CR_of_Q_mult. setoid_replace ((1 # 2) * 2)%Q with 1%Q. 2: reflexivity. rewrite CRmult_1_r. rewrite (CR_of_Q_plus _ 1 1), CRmult_plus_distr_l, CRmult_1_r. rewrite (CRplus_comm x). unfold CRminus. rewrite CRplus_assoc. apply CRplus_le_compat_l. apply (CRplus_le_reg_l (-x)). rewrite <- CRplus_assoc, CRplus_opp_l, CRplus_0_l. rewrite <- (CRopp_involutive y), <- CRopp_plus_distr, <- CRopp_plus_distr. apply CRopp_ge_le_contravar. rewrite CRabs_opp, CRplus_comm. apply CRle_abs. Qed. Lemma CRnegPartAbsMin : forall {R : ConstructiveReals} (x : CRcarrier R), CRmin 0 x == (x - CRabs _ x) * (CR_of_Q _ (1#2)). Proof. intros. unfold CRmin. unfold CRminus. rewrite CRplus_0_l. apply CRmult_morph. 2: reflexivity. rewrite CRopp_0, CRplus_0_r. reflexivity. Qed. Lemma CRmin_sym : forall {R : ConstructiveReals} (x y : CRcarrier R), CRmin x y == CRmin y x. Proof. intros. unfold CRmin. apply CRmult_morph. 2: reflexivity. rewrite CRabs_minus_sym. unfold CRminus. rewrite (CRplus_comm x y). reflexivity. Qed. Lemma CRmin_mult : forall {R : ConstructiveReals} (p q r : CRcarrier R), 0 <= r -> CRmin (r * p) (r * q) == r * CRmin p q. Proof. intros R p q r H. unfold CRmin. setoid_replace (r * q - r * p) with (r * (q - p)). - rewrite CRabs_mult. rewrite (CRabs_right r). 2: exact H. rewrite <- CRmult_assoc. apply CRmult_morph. 2: reflexivity. unfold CRminus. rewrite CRopp_mult_distr_r. do 2 rewrite <- CRmult_plus_distr_l. reflexivity. - unfold CRminus. rewrite CRopp_mult_distr_r. rewrite <- CRmult_plus_distr_l. reflexivity. Qed. Lemma CRmin_plus : forall {R : ConstructiveReals} (x y z : CRcarrier R), x + CRmin y z == CRmin (x + y) (x + z). Proof. intros. unfold CRmin. unfold CRminus. setoid_replace (x + z + - (x + y)) with (z-y). - apply (CRmult_eq_reg_r (CR_of_Q _ 2)). + left. apply CR_of_Q_lt; reflexivity. + rewrite CRmult_plus_distr_r. rewrite CRmult_assoc, <- CR_of_Q_mult. setoid_replace ((1 # 2) * 2)%Q with 1%Q. 2: reflexivity. rewrite CRmult_1_r. rewrite CRmult_assoc, <- CR_of_Q_mult. setoid_replace ((1 # 2) * 2)%Q with 1%Q. 2: reflexivity. rewrite CRmult_1_r. rewrite (CR_of_Q_plus _ 1 1), CRmult_plus_distr_l, CRmult_1_r. do 3 rewrite (CRplus_assoc x). apply CRplus_morph. * reflexivity. * do 2 rewrite <- CRplus_assoc. apply CRplus_morph. 2: reflexivity. rewrite (CRplus_comm x). apply CRplus_assoc. - rewrite CRopp_plus_distr. rewrite <- CRplus_assoc. apply CRplus_morph. 2: reflexivity. rewrite CRplus_comm, <- CRplus_assoc, CRplus_opp_l. apply CRplus_0_l. Qed. Lemma CRmin_left : forall {R : ConstructiveReals} (x y : CRcarrier R), x <= y -> CRmin x y == x. Proof. intros. unfold CRmin. apply (CRmult_eq_reg_r (CR_of_Q R 2)). - left. apply CR_of_Q_lt; reflexivity. - rewrite CRmult_assoc, <- CR_of_Q_mult. setoid_replace ((1 # 2) * 2)%Q with 1%Q. 2: reflexivity. rewrite CRmult_1_r. rewrite (CR_of_Q_plus _ 1 1), CRmult_plus_distr_l, CRmult_1_r. rewrite CRabs_right. + unfold CRminus. rewrite CRopp_plus_distr. rewrite CRplus_assoc. apply CRplus_morph. * reflexivity. * rewrite <- CRplus_assoc, CRplus_opp_r, CRplus_0_l. apply CRopp_involutive. + rewrite <- (CRplus_opp_r x). apply CRplus_le_compat. * exact H. * apply CRle_refl. Qed. Lemma CRmin_right : forall {R : ConstructiveReals} (x y : CRcarrier R), y <= x -> CRmin x y == y. Proof. intros. unfold CRmin. apply (CRmult_eq_reg_r (CR_of_Q R 2)). - left. apply CR_of_Q_lt; reflexivity. - rewrite CRmult_assoc, <- CR_of_Q_mult. setoid_replace ((1 # 2) * 2)%Q with 1%Q. 2: reflexivity. rewrite CRmult_1_r. rewrite (CR_of_Q_plus _ 1 1), CRmult_plus_distr_l, CRmult_1_r. rewrite CRabs_left. + unfold CRminus. do 2 rewrite CRopp_plus_distr. rewrite (CRplus_comm x y). rewrite CRplus_assoc. apply CRplus_morph. * reflexivity. * do 2 rewrite CRopp_involutive. rewrite CRplus_comm, CRplus_assoc, CRplus_opp_l, CRplus_0_r. reflexivity. + rewrite <- (CRplus_opp_r x). apply CRplus_le_compat. * exact H. * apply CRle_refl. Qed. Lemma CRmin_lt : forall {R : ConstructiveReals} (x y z : CRcarrier R), z < x -> z < y -> z < CRmin x y. Proof. intros. unfold CRmin. apply (CRmult_lt_reg_r (CR_of_Q R 2)). - apply CR_of_Q_lt; reflexivity. - rewrite CRmult_assoc, <- CR_of_Q_mult. setoid_replace ((1 # 2) * 2)%Q with 1%Q. 2: reflexivity. rewrite CRmult_1_r. apply (CRplus_lt_reg_l _ (CRabs _ (y - x) - (z*CR_of_Q R 2))). unfold CRminus. rewrite CRplus_assoc. rewrite CRplus_opp_l, CRplus_0_r. rewrite (CRplus_comm (CRabs R (y + - x))). rewrite (CRplus_comm (x+y)), CRplus_assoc. rewrite <- (CRplus_assoc (CRabs R (y + - x))), CRplus_opp_r, CRplus_0_l. rewrite <- (CRplus_comm (x+y)). apply CRabs_def1. + unfold CRminus. rewrite <- (CRplus_comm y), CRplus_assoc. apply CRplus_lt_compat_l. apply (CRplus_lt_reg_l R (-x)). rewrite CRopp_mult_distr_l. rewrite <- CRplus_assoc, CRplus_opp_l, CRplus_0_l. rewrite (CR_of_Q_plus R 1 1), CRmult_plus_distr_l. rewrite CRmult_1_r. apply CRplus_le_lt_compat. * apply CRlt_asym. apply CRopp_gt_lt_contravar, H. * apply CRopp_gt_lt_contravar, H. + rewrite CRopp_plus_distr, CRopp_involutive. rewrite CRplus_comm, CRplus_assoc. apply CRplus_lt_compat_l. apply (CRplus_lt_reg_l R (-y)). rewrite CRopp_mult_distr_l. rewrite <- CRplus_assoc, CRplus_opp_l, CRplus_0_l. rewrite (CR_of_Q_plus R 1 1), CRmult_plus_distr_l. rewrite CRmult_1_r. apply CRplus_le_lt_compat. * apply CRlt_asym. apply CRopp_gt_lt_contravar, H0. * apply CRopp_gt_lt_contravar, H0. Qed. Lemma CRmin_contract : forall {R : ConstructiveReals} (x y a : CRcarrier R), CRabs _ (CRmin x a - CRmin y a) <= CRabs _ (x - y). Proof. intros. unfold CRmin. unfold CRminus. rewrite CRopp_mult_distr_l, <- CRmult_plus_distr_r. rewrite (CRabs_morph _ ((x - y + (CRabs _ (a - y) - CRabs _ (a - x))) * CR_of_Q R (1 # 2))). - rewrite CRabs_mult, (CRabs_right (CR_of_Q R (1 # 2))). 2: apply CR_of_Q_le; discriminate. apply (CRle_trans _ ((CRabs _ (x - y) * 1 + CRabs _ (x-y) * 1) * CR_of_Q R (1 # 2))). + apply CRmult_le_compat_r. * apply CR_of_Q_le. discriminate. * apply (CRle_trans _ (CRabs _ (x - y) + CRabs _ (CRabs _ (a - y) - CRabs _ (a - x)))). -- apply CRabs_triang. -- rewrite CRmult_1_r. apply CRplus_le_compat_l. rewrite (CRabs_morph (x-y) ((a-y)-(a-x))). ++ apply CRabs_triang_inv2. ++ unfold CRminus. rewrite (CRplus_comm (a + - y)). rewrite <- CRplus_assoc. apply CRplus_morph. 2: reflexivity. rewrite CRplus_comm, CRopp_plus_distr, <- CRplus_assoc. rewrite CRplus_opp_r, CRopp_involutive, CRplus_0_l. reflexivity. + rewrite <- CRmult_plus_distr_l. rewrite <- (CR_of_Q_plus R 1 1). rewrite CRmult_assoc, <- CR_of_Q_mult. setoid_replace ((1 + 1) * (1 # 2))%Q with 1%Q. 2: reflexivity. rewrite CRmult_1_r. apply CRle_refl. - unfold CRminus. apply CRmult_morph. 2: reflexivity. do 4 rewrite CRplus_assoc. apply CRplus_morph. + reflexivity. + rewrite <- CRplus_assoc. rewrite CRplus_comm, CRopp_plus_distr. rewrite CRplus_assoc. apply CRplus_morph. * reflexivity. * rewrite CRopp_plus_distr. rewrite (CRplus_comm (-a)). rewrite CRplus_assoc, <- (CRplus_assoc (-a)), CRplus_opp_l. rewrite CRplus_0_l, CRopp_involutive. reflexivity. Qed. Lemma CRmin_glb : forall {R : ConstructiveReals} (x y z:CRcarrier R), z <= x -> z <= y -> z <= CRmin x y. Proof. intros. unfold CRmin. apply (CRmult_le_reg_r (CR_of_Q R 2)). - apply CR_of_Q_lt; reflexivity. - rewrite CRmult_assoc, <- CR_of_Q_mult. setoid_replace ((1 # 2) * 2)%Q with 1%Q. 2: reflexivity. rewrite CRmult_1_r. apply (CRplus_le_reg_l (CRabs _ (y-x) - (z*CR_of_Q R 2))). unfold CRminus. rewrite CRplus_assoc, CRplus_opp_l, CRplus_0_r. rewrite (CRplus_comm (CRabs R (y + - x) + - (z * CR_of_Q R 2))). rewrite CRplus_assoc, <- (CRplus_assoc (- CRabs R (y + - x))). rewrite CRplus_opp_l, CRplus_0_l. apply CRabs_le. split. + do 2 rewrite CRopp_plus_distr. rewrite CRopp_involutive, (CRplus_comm y), CRplus_assoc. apply CRplus_le_compat_l, (CRplus_le_reg_l y). rewrite <- CRplus_assoc, CRplus_opp_r, CRplus_0_l. rewrite (CR_of_Q_plus R 1 1), CRmult_plus_distr_l. rewrite CRmult_1_r. apply CRplus_le_compat; exact H0. + rewrite (CRplus_comm x), CRplus_assoc. apply CRplus_le_compat_l. apply (CRplus_le_reg_l (-x)). rewrite <- CRplus_assoc, CRplus_opp_l, CRplus_0_l. rewrite CRopp_mult_distr_l. rewrite (CR_of_Q_plus R 1 1), CRmult_plus_distr_l. rewrite CRmult_1_r. apply CRplus_le_compat; apply CRopp_ge_le_contravar; exact H. Qed. Lemma CRmin_assoc : forall {R : ConstructiveReals} (a b c : CRcarrier R), CRmin a (CRmin b c) == CRmin (CRmin a b) c. Proof. split. - apply CRmin_glb. + apply (CRle_trans _ (CRmin a b)). * apply CRmin_l. * apply CRmin_l. + apply CRmin_glb. * apply (CRle_trans _ (CRmin a b)). -- apply CRmin_l. -- apply CRmin_r. * apply CRmin_r. - apply CRmin_glb. + apply CRmin_glb. * apply CRmin_l. * apply (CRle_trans _ (CRmin b c)). -- apply CRmin_r. -- apply CRmin_l. + apply (CRle_trans _ (CRmin b c)). * apply CRmin_r. * apply CRmin_r. Qed. Lemma CRlt_min : forall {R : ConstructiveReals} (x y z : CRcarrier R), z < CRmin x y -> prod (z < x) (z < y). Proof. intros. destruct (CR_Q_dense R _ _ H) as [q qmaj]. destruct qmaj. split. - apply (CRlt_le_trans _ (CR_of_Q R q) _ c). intro abs. apply (CRlt_asym _ _ c0). apply (CRle_lt_trans _ x). + apply CRmin_l. + exact abs. - apply (CRlt_le_trans _ (CR_of_Q R q) _ c). intro abs. apply (CRlt_asym _ _ c0). apply (CRle_lt_trans _ y). + apply CRmin_r. + exact abs. Qed. (* Maximum *) Definition CRmax {R : ConstructiveReals} (x y : CRcarrier R) : CRcarrier R := (x + y + CRabs _ (y - x)) * CR_of_Q _ (1#2). Add Parametric Morphism {R : ConstructiveReals} : CRmax with signature (CReq R) ==> (CReq R) ==> (CReq R) as CRmax_morph. Proof. intros. unfold CRmax. apply CRmult_morph. 2: reflexivity. unfold CRminus. rewrite H, H0. reflexivity. Qed. #[global] Instance CRmax_morphT : forall {R : ConstructiveReals}, CMorphisms.Proper (CMorphisms.respectful (CReq R) (CMorphisms.respectful (CReq R) (CReq R))) (@CRmax R). Proof. intros R x y H z t H0. rewrite H, H0. reflexivity. Qed. Lemma CRmax_lub : forall {R : ConstructiveReals} (x y z:CRcarrier R), x <= z -> y <= z -> CRmax x y <= z. Proof. intros. unfold CRmax. apply (CRmult_le_reg_r (CR_of_Q _ 2)). - apply CR_of_Q_lt; reflexivity. - rewrite CRmult_assoc, <- CR_of_Q_mult. setoid_replace ((1 # 2) * 2)%Q with 1%Q. 2: reflexivity. rewrite CRmult_1_r. apply (CRplus_le_reg_l (-x-y)). rewrite <- CRplus_assoc. unfold CRminus. rewrite <- CRopp_plus_distr, CRplus_opp_l, CRplus_0_l. apply CRabs_le. split. + repeat rewrite CRopp_plus_distr. do 2 rewrite CRopp_involutive. rewrite (CRplus_comm x), CRplus_assoc. apply CRplus_le_compat_l. apply (CRplus_le_reg_l (-x)). rewrite <- CRplus_assoc, CRplus_opp_l, CRplus_0_l. rewrite (CR_of_Q_plus _ 1 1), CRmult_plus_distr_l, CRmult_1_r. rewrite CRopp_plus_distr. apply CRplus_le_compat; apply CRopp_ge_le_contravar; assumption. + rewrite (CRplus_comm y), CRopp_plus_distr, CRplus_assoc. apply CRplus_le_compat_l. apply (CRplus_le_reg_l y). rewrite <- CRplus_assoc, CRplus_opp_r, CRplus_0_l. rewrite (CR_of_Q_plus _ 1 1), CRmult_plus_distr_l, CRmult_1_r. apply CRplus_le_compat; assumption. Qed. Lemma CRmax_l : forall {R : ConstructiveReals} (x y : CRcarrier R), x <= CRmax x y. Proof. intros. unfold CRmax. apply (CRmult_le_reg_r (CR_of_Q R 2)). - apply CR_of_Q_lt; reflexivity. - rewrite CRmult_assoc, <- CR_of_Q_mult. setoid_replace ((1 # 2) * 2)%Q with 1%Q. 2: reflexivity. rewrite CRmult_1_r. setoid_replace 2%Q with (1+1)%Q. + rewrite CR_of_Q_plus. rewrite CRmult_plus_distr_l, CRmult_1_r, CRplus_assoc. apply CRplus_le_compat_l. apply (CRplus_le_reg_l (-y)). rewrite <- CRplus_assoc, CRplus_opp_l, CRplus_0_l. rewrite CRabs_minus_sym, CRplus_comm. apply CRle_abs. + reflexivity. Qed. Lemma CRmax_r : forall {R : ConstructiveReals} (x y : CRcarrier R), y <= CRmax x y. Proof. intros. unfold CRmax. apply (CRmult_le_reg_r (CR_of_Q _ 2)). - apply CR_of_Q_lt; reflexivity. - rewrite CRmult_assoc, <- CR_of_Q_mult. setoid_replace ((1 # 2) * 2)%Q with 1%Q. 2: reflexivity. rewrite CRmult_1_r. rewrite (CR_of_Q_plus _ 1 1), CRmult_plus_distr_l, CRmult_1_r. rewrite (CRplus_comm x). rewrite CRplus_assoc. apply CRplus_le_compat_l. apply (CRplus_le_reg_l (-x)). rewrite <- CRplus_assoc, CRplus_opp_l, CRplus_0_l. rewrite CRplus_comm. apply CRle_abs. Qed. Lemma CRposPartAbsMax : forall {R : ConstructiveReals} (x : CRcarrier R), CRmax 0 x == (x + CRabs _ x) * (CR_of_Q R (1#2)). Proof. intros. unfold CRmax. unfold CRminus. rewrite CRplus_0_l. apply CRmult_morph. 2: reflexivity. rewrite CRopp_0, CRplus_0_r. reflexivity. Qed. Lemma CRmax_sym : forall {R : ConstructiveReals} (x y : CRcarrier R), CRmax x y == CRmax y x. Proof. intros. unfold CRmax. rewrite CRabs_minus_sym. apply CRmult_morph. 2: reflexivity. rewrite (CRplus_comm x y). reflexivity. Qed. Lemma CRmax_plus : forall {R : ConstructiveReals} (x y z : CRcarrier R), x + CRmax y z == CRmax (x + y) (x + z). Proof. intros. unfold CRmax. setoid_replace (x + z - (x + y)) with (z-y). - apply (CRmult_eq_reg_r (CR_of_Q _ 2)). + left. apply CR_of_Q_lt; reflexivity. + rewrite CRmult_plus_distr_r. rewrite CRmult_assoc, <- CR_of_Q_mult. setoid_replace ((1 # 2) * 2)%Q with 1%Q. 2: reflexivity. rewrite CRmult_1_r. rewrite CRmult_assoc, <- CR_of_Q_mult. setoid_replace ((1 # 2) * 2)%Q with 1%Q. 2: reflexivity. rewrite (CR_of_Q_plus _ 1 1), CRmult_plus_distr_l, CRmult_1_r. rewrite CRmult_1_r. do 3 rewrite (CRplus_assoc x). apply CRplus_morph. * reflexivity. * do 2 rewrite <- CRplus_assoc. apply CRplus_morph. 2: reflexivity. rewrite (CRplus_comm x). apply CRplus_assoc. - unfold CRminus. rewrite CRopp_plus_distr. rewrite <- CRplus_assoc. apply CRplus_morph. 2: reflexivity. rewrite CRplus_comm, <- CRplus_assoc, CRplus_opp_l. apply CRplus_0_l. Qed. Lemma CRmax_left : forall {R : ConstructiveReals} (x y : CRcarrier R), y <= x -> CRmax x y == x. Proof. intros. unfold CRmax. apply (CRmult_eq_reg_r (CR_of_Q R 2)). - left. apply CR_of_Q_lt; reflexivity. - rewrite CRmult_assoc, <- CR_of_Q_mult. setoid_replace ((1 # 2) * 2)%Q with 1%Q. 2: reflexivity. rewrite CRmult_1_r. rewrite (CR_of_Q_plus _ 1 1), CRmult_plus_distr_l, CRmult_1_r. rewrite CRplus_assoc. apply CRplus_morph. + reflexivity. + rewrite CRabs_left. * unfold CRminus. rewrite CRopp_plus_distr, CRopp_involutive. rewrite <- CRplus_assoc, CRplus_opp_r, CRplus_0_l. reflexivity. * rewrite <- (CRplus_opp_r x). apply CRplus_le_compat_r. exact H. Qed. Lemma CRmax_right : forall {R : ConstructiveReals} (x y : CRcarrier R), x <= y -> CRmax x y == y. Proof. intros. unfold CRmax. apply (CRmult_eq_reg_r (CR_of_Q R 2)). - left. apply CR_of_Q_lt; reflexivity. - rewrite CRmult_assoc, <- CR_of_Q_mult. setoid_replace ((1 # 2) * 2)%Q with 1%Q. 2: reflexivity. rewrite CRmult_1_r. rewrite (CR_of_Q_plus _ 1 1), CRmult_plus_distr_l, CRmult_1_r. rewrite (CRplus_comm x y). rewrite CRplus_assoc. apply CRplus_morph. + reflexivity. + rewrite CRabs_right. * unfold CRminus. rewrite CRplus_comm. rewrite CRplus_assoc, CRplus_opp_l, CRplus_0_r. reflexivity. * rewrite <- (CRplus_opp_r x). apply CRplus_le_compat_r. exact H. Qed. Lemma CRmax_contract : forall {R : ConstructiveReals} (x y a : CRcarrier R), CRabs _ (CRmax x a - CRmax y a) <= CRabs _ (x - y). Proof. intros. unfold CRmax. rewrite (CRabs_morph _ ((x - y + (CRabs _ (a - x) - CRabs _ (a - y))) * CR_of_Q R (1 # 2))). - rewrite CRabs_mult, (CRabs_right (CR_of_Q R (1 # 2))). 2: apply CR_of_Q_le; discriminate. apply (CRle_trans _ ((CRabs _ (x - y) * 1 + CRabs _ (x-y) * 1) * CR_of_Q R (1 # 2))). + apply CRmult_le_compat_r. * apply CR_of_Q_le. discriminate. * apply (CRle_trans _ (CRabs _ (x - y) + CRabs _ (CRabs _ (a - x) - CRabs _ (a - y)))). -- apply CRabs_triang. -- rewrite CRmult_1_r. apply CRplus_le_compat_l. rewrite (CRabs_minus_sym x y). rewrite (CRabs_morph (y-x) ((a-x)-(a-y))). ++ apply CRabs_triang_inv2. ++ unfold CRminus. rewrite (CRplus_comm (a + - x)). rewrite <- CRplus_assoc. apply CRplus_morph. 2: reflexivity. rewrite CRplus_comm, CRopp_plus_distr, <- CRplus_assoc. rewrite CRplus_opp_r, CRopp_involutive, CRplus_0_l. reflexivity. + rewrite <- CRmult_plus_distr_l. rewrite <- (CR_of_Q_plus R 1 1). rewrite CRmult_assoc, <- CR_of_Q_mult. setoid_replace ((1 + 1) * (1 # 2))%Q with 1%Q. 2: reflexivity. rewrite CRmult_1_r. apply CRle_refl. - unfold CRminus. rewrite CRopp_mult_distr_l. rewrite <- CRmult_plus_distr_r. apply CRmult_morph. 2: reflexivity. do 4 rewrite CRplus_assoc. apply CRplus_morph. + reflexivity. + rewrite <- CRplus_assoc. rewrite CRplus_comm, CRopp_plus_distr. rewrite CRplus_assoc. apply CRplus_morph. * reflexivity. * rewrite CRopp_plus_distr. rewrite (CRplus_comm (-a)). rewrite CRplus_assoc, <- (CRplus_assoc (-a)), CRplus_opp_l. rewrite CRplus_0_l. apply CRplus_comm. Qed. Lemma CRmax_lub_lt : forall {R : ConstructiveReals} (x y z : CRcarrier R), x < z -> y < z -> CRmax x y < z. Proof. intros. unfold CRmax. apply (CRmult_lt_reg_r (CR_of_Q R 2)). - apply CR_of_Q_lt; reflexivity. - rewrite CRmult_assoc, <- CR_of_Q_mult. setoid_replace ((1 # 2) * 2)%Q with 1%Q. 2: reflexivity. rewrite CRmult_1_r. apply (CRplus_lt_reg_l _ (-y -x)). unfold CRminus. rewrite CRplus_assoc, <- (CRplus_assoc (-x)), <- (CRplus_assoc (-x)). rewrite CRplus_opp_l, CRplus_0_l, <- CRplus_assoc, CRplus_opp_l, CRplus_0_l. apply CRabs_def1. + rewrite (CRplus_comm y), (CRplus_comm (-y)), CRplus_assoc. apply CRplus_lt_compat_l. apply (CRplus_lt_reg_l _ y). rewrite <- CRplus_assoc, CRplus_opp_r, CRplus_0_l. rewrite (CR_of_Q_plus R 1 1), CRmult_plus_distr_l. rewrite CRmult_1_r. apply CRplus_le_lt_compat. * apply CRlt_asym, H0. * exact H0. + rewrite CRopp_plus_distr, CRopp_involutive. rewrite CRplus_assoc. apply CRplus_lt_compat_l. apply (CRplus_lt_reg_l _ x). rewrite <- CRplus_assoc, CRplus_opp_r, CRplus_0_l. rewrite (CR_of_Q_plus R 1 1), CRmult_plus_distr_l. rewrite CRmult_1_r. apply CRplus_le_lt_compat. * apply CRlt_asym, H. * exact H. Qed. Lemma CRmax_assoc : forall {R : ConstructiveReals} (a b c : CRcarrier R), CRmax a (CRmax b c) == CRmax (CRmax a b) c. Proof. split. - apply CRmax_lub. + apply CRmax_lub. * apply CRmax_l. * apply (CRle_trans _ (CRmax b c)). -- apply CRmax_l. -- apply CRmax_r. + apply (CRle_trans _ (CRmax b c)). * apply CRmax_r. * apply CRmax_r. - apply CRmax_lub. + apply (CRle_trans _ (CRmax a b)). * apply CRmax_l. * apply CRmax_l. + apply CRmax_lub. * apply (CRle_trans _ (CRmax a b)). -- apply CRmax_r. -- apply CRmax_l. * apply CRmax_r. Qed. Lemma CRmax_min_mult_neg : forall {R : ConstructiveReals} (p q r:CRcarrier R), r <= 0 -> CRmax (r * p) (r * q) == r * CRmin p q. Proof. intros R p q r H. unfold CRmin, CRmax. setoid_replace (r * q - r * p) with (r * (q - p)). - rewrite CRabs_mult. rewrite (CRabs_left r), <- CRmult_assoc. + apply CRmult_morph. 2: reflexivity. unfold CRminus. rewrite <- CRopp_mult_distr_l, CRopp_mult_distr_r, CRmult_plus_distr_l, CRmult_plus_distr_l. reflexivity. + exact H. - unfold CRminus. rewrite CRmult_plus_distr_l, CRopp_mult_distr_r. reflexivity. Qed. Lemma CRlt_max : forall {R : ConstructiveReals} (x y z : CRcarrier R), CRmax x y < z -> prod (x < z) (y < z). Proof. intros. destruct (CR_Q_dense R _ _ H) as [q qmaj]. destruct qmaj. split. - apply (CRlt_le_trans _ (CR_of_Q R q)). + apply (CRle_lt_trans _ (CRmax x y)). * apply CRmax_l. * exact c. + apply CRlt_asym, c0. - apply (CRlt_le_trans _ (CR_of_Q R q)). + apply (CRle_lt_trans _ (CRmax x y)). * apply CRmax_r. * exact c. + apply CRlt_asym, c0. Qed. Lemma CRmax_mult : forall {R : ConstructiveReals} (p q r:CRcarrier R), 0 <= r -> CRmax (r * p) (r * q) == r * CRmax p q. Proof. intros R p q r H. unfold CRmin, CRmax. setoid_replace (r * q - r * p) with (r * (q - p)). - rewrite CRabs_mult. rewrite (CRabs_right r), <- CRmult_assoc. + apply CRmult_morph. 2: reflexivity. rewrite CRmult_plus_distr_l, CRmult_plus_distr_l. reflexivity. + exact H. - unfold CRminus. rewrite CRmult_plus_distr_l, CRopp_mult_distr_r. reflexivity. Qed. Lemma CRmin_max_mult_neg : forall {R : ConstructiveReals} (p q r:CRcarrier R), r <= 0 -> CRmin (r * p) (r * q) == r * CRmax p q. Proof. intros R p q r H. unfold CRmin, CRmax. setoid_replace (r * q - r * p) with (r * (q - p)). - rewrite CRabs_mult. rewrite (CRabs_left r), <- CRmult_assoc. + apply CRmult_morph. 2: reflexivity. unfold CRminus. rewrite CRopp_mult_distr_l, CRopp_involutive, CRmult_plus_distr_l, CRmult_plus_distr_l. reflexivity. + exact H. - unfold CRminus. rewrite CRmult_plus_distr_l, CRopp_mult_distr_r. reflexivity. Qed. Lemma CRmorph_min : forall {R1 R2 : ConstructiveReals} (f : @ConstructiveRealsMorphism R1 R2) (a b : CRcarrier R1), CRmorph f (CRmin a b) == CRmin (CRmorph f a) (CRmorph f b). Proof. intros. unfold CRmin. rewrite CRmorph_mult. apply CRmult_morph. 2: apply CRmorph_rat. unfold CRminus. do 2 rewrite CRmorph_plus. apply CRplus_morph. - apply CRplus_morph. + reflexivity. + reflexivity. - rewrite CRmorph_opp. apply CRopp_morph. rewrite <- CRmorph_abs. apply CRabs_morph. rewrite CRmorph_plus. apply CRplus_morph. + reflexivity. + rewrite CRmorph_opp. apply CRopp_morph, CRmorph_proper. reflexivity. Qed. coq-8.20.0/theories/Reals/Abstract/ConstructivePower.v000066400000000000000000000242541466560755400227430ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * INRIA, CNRS and contributors - Copyright 1999-2019 *) (* 1 | S n => r * (CRpow r n) end. Lemma CRpow_ge_one : forall {R : ConstructiveReals} (x : CRcarrier R) (n : nat), 1 <= x -> 1 <= CRpow x n. Proof. induction n. - intros. apply CRle_refl. - intros. simpl. apply (CRle_trans _ (x * 1)). + rewrite CRmult_1_r. exact H. + apply CRmult_le_compat_l_half. * apply (CRlt_le_trans _ 1). -- apply CRzero_lt_one. -- exact H. * apply IHn. exact H. Qed. Lemma CRpow_ge_zero : forall {R : ConstructiveReals} (x : CRcarrier R) (n : nat), 0 <= x -> 0 <= CRpow x n. Proof. induction n. - intros. apply CRlt_asym, CRzero_lt_one. - intros. simpl. apply CRmult_le_0_compat. + exact H. + apply IHn. exact H. Qed. Lemma CRpow_gt_zero : forall {R : ConstructiveReals} (x : CRcarrier R) (n : nat), 0 < x -> 0 < CRpow x n. Proof. induction n. - intros. apply CRzero_lt_one. - intros. simpl. apply CRmult_lt_0_compat. + exact H. + apply IHn. exact H. Qed. Lemma CRpow_mult : forall {R : ConstructiveReals} (x y : CRcarrier R) (n:nat), CRpow x n * CRpow y n == CRpow (x*y) n. Proof. induction n. - simpl. rewrite CRmult_1_r. reflexivity. - simpl. rewrite <- IHn. do 2 rewrite <- (Rmul_assoc (CRisRing R)). apply CRmult_morph. + reflexivity. + rewrite <- (Rmul_comm (CRisRing R)). rewrite <- (Rmul_assoc (CRisRing R)). apply CRmult_morph. * reflexivity. * rewrite <- (Rmul_comm (CRisRing R)). reflexivity. Qed. Lemma CRpow_one : forall {R : ConstructiveReals} (n:nat), @CRpow R 1 n == 1. Proof. induction n. - reflexivity. - transitivity (CRmult R 1 (CRpow 1 n)). + reflexivity. + rewrite IHn. rewrite CRmult_1_r. reflexivity. Qed. Lemma CRpow_proper : forall {R : ConstructiveReals} (x y : CRcarrier R) (n : nat), x == y -> CRpow x n == CRpow y n. Proof. induction n. - intros. reflexivity. - intros. simpl. rewrite IHn, H. + reflexivity. + exact H. Qed. Lemma CRpow_inv : forall {R : ConstructiveReals} (x : CRcarrier R) (xPos : 0 < x) (n : nat), CRpow (CRinv R x (inr xPos)) n == CRinv R (CRpow x n) (inr (CRpow_gt_zero x n xPos)). Proof. induction n. - rewrite CRinv_1. reflexivity. - transitivity (CRinv R x (inr xPos) * CRpow (CRinv R x (inr xPos)) n). + reflexivity. + rewrite IHn. assert (0 < x * CRpow x n). { apply CRmult_lt_0_compat. * exact xPos. * apply CRpow_gt_zero, xPos. } rewrite <- (CRinv_mult_distr _ _ _ _ (inr H)). apply CRinv_morph. reflexivity. Qed. Lemma CRpow_plus_distr : forall {R : ConstructiveReals} (x : CRcarrier R) (n p:nat), CRpow x n * CRpow x p == CRpow x (n+p). Proof. induction n. - intros. simpl. rewrite CRmult_1_l. reflexivity. - intros. simpl. rewrite CRmult_assoc. apply CRmult_morph. + reflexivity. + apply IHn. Qed. Lemma CR_double : forall {R : ConstructiveReals} (x:CRcarrier R), CR_of_Q R 2 * x == x + x. Proof. intros R x. rewrite (CR_of_Q_morph R 2 (1+1)). 2: reflexivity. rewrite CR_of_Q_plus. rewrite CRmult_plus_distr_r, CRmult_1_l. reflexivity. Qed. Lemma GeoCvZero : forall {R : ConstructiveReals}, CR_cv R (fun n:nat => CRpow (CR_of_Q R (1#2)) n) 0. Proof. intro R. assert (forall n:nat, INR n < CRpow (CR_of_Q R 2) n). { induction n. - unfold INR; simpl. apply CRzero_lt_one. - unfold INR. fold (1+n)%nat. rewrite Nat2Z.inj_add. rewrite (CR_of_Q_morph R _ ((Z.of_nat 1 # 1) + (Z.of_nat n #1))). 2: symmetry; apply Qinv_plus_distr. rewrite CR_of_Q_plus. replace (CRpow (CR_of_Q R 2) (1 + n)) with (CR_of_Q R 2 * CRpow (CR_of_Q R 2) n). 2: reflexivity. rewrite CR_double. apply CRplus_le_lt_compat. 2: exact IHn. simpl. apply CRpow_ge_one. apply CR_of_Q_le. discriminate. } intros p. exists (Pos.to_nat p). intros. unfold CRminus. rewrite CRopp_0. rewrite CRplus_0_r. rewrite CRabs_right. 2: apply CRpow_ge_zero; apply CR_of_Q_le; discriminate. apply CRlt_asym. apply (CRmult_lt_reg_l (CR_of_Q R (Z.pos p # 1))). - apply CR_of_Q_lt. reflexivity. - rewrite <- CR_of_Q_mult. rewrite (CR_of_Q_morph R ((Z.pos p # 1) * (1 # p)) 1). 2: unfold Qmult, Qeq, Qnum, Qden; ring_simplify; reflexivity. apply (CRmult_lt_reg_r (CRpow (CR_of_Q R 2) i)). + apply CRpow_gt_zero. apply CR_of_Q_lt. reflexivity. + rewrite CRmult_assoc. rewrite CRpow_mult. rewrite (CRpow_proper (CR_of_Q R (1 # 2) * CR_of_Q R 2) 1), CRpow_one. * rewrite CRmult_1_r, CRmult_1_l. apply (CRle_lt_trans _ (INR i)). 2: exact (H i). clear H. apply CR_of_Q_le. unfold Qle,Qnum,Qden. do 2 rewrite Z.mul_1_r. rewrite <- positive_nat_Z. apply Nat2Z.inj_le, H0. * rewrite <- CR_of_Q_mult. setoid_replace ((1#2)*2)%Q with 1%Q. -- reflexivity. -- reflexivity. Qed. Lemma GeoFiniteSum : forall {R : ConstructiveReals} (n:nat), CRsum (CRpow (CR_of_Q R (1#2))) n == CR_of_Q R 2 - CRpow (CR_of_Q R (1#2)) n. Proof. induction n. - unfold CRsum, CRpow. simpl (1%ConstructiveReals). unfold CRminus. rewrite (CR_of_Q_plus R 1 1). rewrite CRplus_assoc. rewrite CRplus_opp_r, CRplus_0_r. reflexivity. - setoid_replace (CRsum (CRpow (CR_of_Q R (1 # 2))) (S n)) with (CRsum (CRpow (CR_of_Q R (1 # 2))) n + CRpow (CR_of_Q R (1 # 2)) (S n)). 2: reflexivity. rewrite IHn. clear IHn. unfold CRminus. rewrite CRplus_assoc. apply CRplus_morph. + reflexivity. + apply (CRplus_eq_reg_l (CRpow (CR_of_Q R (1 # 2)) n + CRpow (CR_of_Q R (1 # 2)) (S n))). rewrite (CRplus_assoc _ _ (-CRpow (CR_of_Q R (1 # 2)) (S n))), CRplus_opp_r, CRplus_0_r. rewrite (CRplus_comm (CRpow (CR_of_Q R (1 # 2)) n)), CRplus_assoc. rewrite <- (CRplus_assoc (CRpow (CR_of_Q R (1 # 2)) n)), CRplus_opp_r, CRplus_0_l, <- CR_double. setoid_replace (CRpow (CR_of_Q R (1 # 2)) (S n)) with (CR_of_Q R (1 # 2) * CRpow (CR_of_Q R (1 # 2)) n). 2: reflexivity. rewrite <- CRmult_assoc, <- CR_of_Q_mult. setoid_replace (2 * (1 # 2))%Q with 1%Q. * apply CRmult_1_l. * reflexivity. Qed. Lemma GeoHalfBelowTwo : forall {R : ConstructiveReals} (n:nat), CRsum (CRpow (CR_of_Q R (1#2))) n < CR_of_Q R 2. Proof. intros. rewrite <- (CRplus_0_r (CR_of_Q R 2)), GeoFiniteSum. apply CRplus_lt_compat_l. rewrite <- CRopp_0. apply CRopp_gt_lt_contravar. apply CRpow_gt_zero. apply CR_of_Q_lt. reflexivity. Qed. Lemma GeoHalfTwo : forall {R : ConstructiveReals}, series_cv (fun n => CRpow (CR_of_Q R (1#2)) n) (CR_of_Q R 2). Proof. intro R. apply (CR_cv_eq _ (fun n => CR_of_Q R 2 - CRpow (CR_of_Q R (1 # 2)) n)). - intro n. rewrite GeoFiniteSum. reflexivity. - assert (forall n:nat, INR n < CRpow (CR_of_Q R 2) n). { induction n. - unfold INR; simpl. apply CRzero_lt_one. - apply (CRlt_le_trans _ (CRpow (CR_of_Q R 2) n + 1)). + unfold INR. rewrite Nat2Z.inj_succ, <- Z.add_1_l. rewrite (CR_of_Q_morph R _ (1 + (Z.of_nat n #1))). 2: symmetry; apply Qinv_plus_distr. rewrite CR_of_Q_plus. rewrite CRplus_comm. apply CRplus_lt_compat_r, IHn. + setoid_replace (CRpow (CR_of_Q R 2) (S n)) with (CRpow (CR_of_Q R 2) n + CRpow (CR_of_Q R 2) n). * apply CRplus_le_compat. -- apply CRle_refl. -- apply CRpow_ge_one. apply CR_of_Q_le. discriminate. * rewrite <- CR_double. reflexivity. } intros n. exists (Pos.to_nat n). intros. setoid_replace (CR_of_Q R 2 - CRpow (CR_of_Q R (1 # 2)) i - CR_of_Q R 2) with (- CRpow (CR_of_Q R (1 # 2)) i). + rewrite CRabs_opp. rewrite CRabs_right. * assert (0 < CR_of_Q R 2). { apply CR_of_Q_lt. reflexivity. } rewrite (CRpow_proper _ (CRinv R (CR_of_Q R 2) (inr H1))). -- rewrite CRpow_inv. apply CRlt_asym. apply (CRmult_lt_reg_l (CRpow (CR_of_Q R 2) i)). ++ apply CRpow_gt_zero, H1. ++ rewrite CRinv_r. apply (CRmult_lt_reg_r (CR_of_Q R (Z.pos n#1))). ** apply CR_of_Q_lt. reflexivity. ** rewrite CRmult_1_l, CRmult_assoc. rewrite <- CR_of_Q_mult. rewrite (CR_of_Q_morph R ((1 # n) * (Z.pos n # 1)) 1). 2: reflexivity. rewrite CRmult_1_r. apply (CRle_lt_trans _ (INR i)). 2: apply H. apply CR_of_Q_le. unfold Qle, Qnum, Qden. do 2 rewrite Z.mul_1_r. destruct i. { exfalso. inversion H0. pose proof (Pos2Nat.is_pos n). rewrite H3 in H2. inversion H2. } apply Pos2Z.pos_le_pos. apply Pos2Nat.inj_le. apply (Nat.le_trans _ _ _ H0). rewrite SuccNat2Pos.id_succ. apply Nat.le_refl. -- apply (CRmult_eq_reg_l (CR_of_Q R 2)). ++ right. exact H1. ++ rewrite CRinv_r. rewrite <- CR_of_Q_mult. setoid_replace (2 * (1 # 2))%Q with 1%Q. ** reflexivity. ** reflexivity. * apply CRlt_asym, CRpow_gt_zero. apply CR_of_Q_lt. reflexivity. + unfold CRminus. rewrite CRplus_comm, <- CRplus_assoc. rewrite CRplus_opp_l, CRplus_0_l. reflexivity. Qed. coq-8.20.0/theories/Reals/Abstract/ConstructiveReals.v000066400000000000000000001212701466560755400227110ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * INRIA, CNRS and contributors - Copyright 1999-2019 *) (* Prop; upper : Q -> Prop; (* The cuts respect equality on Q. *) lower_proper : Proper (Qeq ==> iff) lower; upper_proper : Proper (Qeq ==> iff) upper; (* The cuts are inhabited. *) lower_bound : { q : Q | lower q }; upper_bound : { r : Q | upper r }; (* The lower cut is a lower set. *) lower_lower : forall q r, q < r -> lower r -> lower q; (* The lower cut is open. *) lower_open : forall q, lower q -> exists r, q < r /\ lower r; (* The upper cut is an upper set. *) upper_upper : forall q r, q < r -> upper q -> upper r; (* The upper cut is open. *) upper_open : forall r, upper r -> exists q, q < r /\ upper q; (* The cuts are disjoint. *) disjoint : forall q, ~ (lower q /\ upper q); (* There is no gap between the cuts. *) located : forall q r, q < r -> { lower q } + { upper r } }. see github.com/andrejbauer/dedekind-reals for the Prop-based version of those Dedekind reals (although Prop fails to make them an instance of ConstructiveReals). Any computation about constructive reals can be worked in the fastest instance for it; we then transport the results to all other instances by the isomorphisms. This way of working is different from the usual interfaces, where we would rather prove things abstractly, by quantifying universally on the instance. The functions of ConstructiveReals do not have a direct impact on performance, because algorithms will be extracted from instances, and because fast ConstructiveReals morphisms should be coded manually. However, since instances are forced to implement those functions, it is probable that they will also use them in their algorithms. So those functions hint at what we think will yield fast and small extracted programs. Constructive reals are setoids, which custom equality is defined as x == y iff (x <= y /\ y <= x). It is hard to quotient constructively to get the Leibniz equality on the real numbers. In "Sheaves in Geometry and Logic", MacLane and Moerdijk show a topos in which all functions R -> Z are constant. Consequently all functions R -> Q are constant and it is not possible to approximate real numbers by rational numbers. WARNING: this file is experimental and likely to change in future releases. *) Require Import QArith Qabs Qround. Definition isLinearOrder {X : Set} (Xlt : X -> X -> Set) : Set := (forall x y:X, Xlt x y -> Xlt y x -> False) * (forall x y z : X, Xlt x y -> Xlt y z -> Xlt x z) * (forall x y z : X, Xlt x z -> Xlt x y + Xlt y z). Structure ConstructiveReals : Type := { CRcarrier : Set; (* Put this order relation in sort Set rather than Prop, to allow the definition of fast ConstructiveReals morphisms. For example, the Cauchy reals do store information in the proofs of CRlt, which is used in algorithms in sort Set. *) CRlt : CRcarrier -> CRcarrier -> Set; CRltLinear : isLinearOrder CRlt; CRle (x y : CRcarrier) := CRlt y x -> False; CReq (x y : CRcarrier) := CRle y x /\ CRle x y; CRapart (x y : CRcarrier) := sum (CRlt x y) (CRlt y x); (* The propositional truncation of CRlt. It facilitates proofs when computations are not considered important, for example in classical reals with extra logical axioms. *) CRltProp : CRcarrier -> CRcarrier -> Prop; (* This choice algorithm can be slow, keep it for the classical quotient of the reals, where computations are blocked by axioms like LPO. *) CRltEpsilon : forall x y : CRcarrier, CRltProp x y -> CRlt x y; CRltForget : forall x y : CRcarrier, CRlt x y -> CRltProp x y; CRltDisjunctEpsilon : forall a b c d : CRcarrier, (CRltProp a b \/ CRltProp c d) -> CRlt a b + CRlt c d; (* The initial field morphism (in characteristic zero). The abstract definition by iteration of addition is probably the slowest. Let each instance implement a faster (and often simpler) version. *) CR_of_Q : Q -> CRcarrier; CR_of_Q_lt : forall q r : Q, Qlt q r -> CRlt (CR_of_Q q) (CR_of_Q r); lt_CR_of_Q : forall q r : Q, CRlt (CR_of_Q q) (CR_of_Q r) -> Qlt q r; (* Addition and multiplication *) CRplus : CRcarrier -> CRcarrier -> CRcarrier; CRopp : CRcarrier -> CRcarrier; (* Computable opposite, stronger than Prop-existence of opposite *) CRmult : CRcarrier -> CRcarrier -> CRcarrier; CR_of_Q_plus : forall q r : Q, CReq (CR_of_Q (q+r)) (CRplus (CR_of_Q q) (CR_of_Q r)); CR_of_Q_mult : forall q r : Q, CReq (CR_of_Q (q*r)) (CRmult (CR_of_Q q) (CR_of_Q r)); CRisRing : ring_theory (CR_of_Q 0) (CR_of_Q 1) CRplus CRmult (fun x y => CRplus x (CRopp y)) CRopp CReq; CRisRingExt : ring_eq_ext CRplus CRmult CRopp CReq; (* Compatibility with order *) CRzero_lt_one : CRlt (CR_of_Q 0) (CR_of_Q 1); CRplus_lt_compat_l : forall r r1 r2 : CRcarrier, CRlt r1 r2 -> CRlt (CRplus r r1) (CRplus r r2); CRplus_lt_reg_l : forall r r1 r2 : CRcarrier, CRlt (CRplus r r1) (CRplus r r2) -> CRlt r1 r2; CRmult_lt_0_compat : forall x y : CRcarrier, CRlt (CR_of_Q 0) x -> CRlt (CR_of_Q 0) y -> CRlt (CR_of_Q 0) (CRmult x y); (* A constructive total inverse function on F would need to be continuous, which is impossible because we cannot connect plus and minus infinities. Therefore it has to be a partial function, defined on non zero elements. For this reason we cannot use Coq's field_theory and field tactic. To implement Finv by Cauchy sequences we need orderAppart, ~orderEq is not enough. *) CRinv : forall x : CRcarrier, CRapart x (CR_of_Q 0) -> CRcarrier; CRinv_l : forall (r:CRcarrier) (rnz : CRapart r (CR_of_Q 0)), CReq (CRmult (CRinv r rnz) r) (CR_of_Q 1); CRinv_0_lt_compat : forall (r : CRcarrier) (rnz : CRapart r (CR_of_Q 0)), CRlt (CR_of_Q 0) r -> CRlt (CR_of_Q 0) (CRinv r rnz); (* This function is very fast in both the Cauchy and Dedekind instances, because this rational number q is almost what the proof of CRlt x y contains. This function is also the heart of the computation of constructive real numbers : it approximates x to any requested precision y. *) CR_Q_dense : forall x y : CRcarrier, CRlt x y -> { q : Q & prod (CRlt x (CR_of_Q q)) (CRlt (CR_of_Q q) y) }; CR_archimedean : forall x : CRcarrier, { n : positive & CRlt x (CR_of_Q (Z.pos n # 1)) }; CRminus (x y : CRcarrier) : CRcarrier := CRplus x (CRopp y); (* Absolute value, CRabs x is the least upper bound of the pair x, -x. *) CRabs : CRcarrier -> CRcarrier; CRabs_def : forall x y : CRcarrier, (CRle x y /\ CRle (CRopp x) y) <-> CRle (CRabs x) y; (* Definitions of convergence and Cauchy-ness. The formulas with orderLe or CRlt are logically equivalent, the choice of orderLe in sort Prop is a question of performance. It is very rare to turn back to the strict order to define functions in sort Set, so we prefer to discard those proofs during extraction. And even in those rare cases, it is easy to divide epsilon by 2 for example. *) CR_cv (un : nat -> CRcarrier) (l : CRcarrier) : Set := forall p:positive, { n : nat | forall i:nat, le n i -> CRle (CRabs (CRminus (un i) l)) (CR_of_Q (1#p)) }; CR_cauchy (un : nat -> CRcarrier) : Set := forall p : positive, { n : nat | forall i j:nat, le n i -> le n j -> CRle (CRabs (CRminus (un i) (un j))) (CR_of_Q (1#p)) }; (* For the Cauchy reals, this algorithm consists in building a Cauchy sequence of rationals un : nat -> Q that has the same limit as xn. For each n:nat, un n is a 1/n rational approximation of a point of xn that has converged within 1/n. *) CR_complete : forall xn : (nat -> CRcarrier), CR_cauchy xn -> { l : CRcarrier & CR_cv xn l }; }. Declare Scope ConstructiveReals. Delimit Scope ConstructiveReals with ConstructiveReals. Notation "x < y" := (CRlt _ x y) : ConstructiveReals. Notation "x <= y" := (CRle _ x y) : ConstructiveReals. Notation "x <= y <= z" := (CRle _ x y /\ CRle _ y z) : ConstructiveReals. Notation "x < y < z" := (prod (CRlt _ x y) (CRlt _ y z)) : ConstructiveReals. Notation "x == y" := (CReq _ x y) : ConstructiveReals. Notation "x ≶ y" := (CRapart _ x y) (at level 70, no associativity) : ConstructiveReals. Notation "0" := (CR_of_Q _ 0) : ConstructiveReals. Notation "1" := (CR_of_Q _ 1) : ConstructiveReals. Notation "2" := (CR_of_Q _ 2) : ConstructiveReals. Notation "3" := (CR_of_Q _ 3) : ConstructiveReals. Notation "4" := (CR_of_Q _ 4) : ConstructiveReals. Notation "5" := (CR_of_Q _ 5) : ConstructiveReals. Notation "6" := (CR_of_Q _ 6) : ConstructiveReals. Notation "7" := (CR_of_Q _ 7) : ConstructiveReals. Notation "8" := (CR_of_Q _ 8) : ConstructiveReals. Notation "9" := (CR_of_Q _ 9) : ConstructiveReals. Notation "10" := (CR_of_Q _ 10) : ConstructiveReals. Notation "x + y" := (CRplus _ x y) : ConstructiveReals. Notation "- x" := (CRopp _ x) : ConstructiveReals. Notation "x - y" := (CRminus _ x y) : ConstructiveReals. Notation "x * y" := (CRmult _ x y) : ConstructiveReals. Notation "/ x" := (CRinv _ x) : ConstructiveReals. Local Open Scope ConstructiveReals. Lemma CRlt_asym : forall {R : ConstructiveReals} (x y : CRcarrier R), x < y -> x <= y. Proof. intros. intro H0. destruct (CRltLinear R), p. apply (f x y); assumption. Qed. Lemma CRlt_proper : forall R : ConstructiveReals, CMorphisms.Proper (CMorphisms.respectful (CReq R) (CMorphisms.respectful (CReq R) CRelationClasses.iffT)) (CRlt R). Proof. intros R x y H x0 y0 H0. destruct H, H0. destruct (CRltLinear R). split. - intro. destruct (s x y x0). + assumption. + contradiction. + destruct (s y y0 x0). * assumption. * assumption. * contradiction. - intro. destruct (s y x y0). + assumption. + contradiction. + destruct (s x x0 y0). * assumption. * assumption. * contradiction. Qed. Lemma CRle_refl : forall {R : ConstructiveReals} (x : CRcarrier R), x <= x. Proof. intros. intro H. destruct (CRltLinear R), p. exact (f x x H H). Qed. Lemma CRle_lt_trans : forall {R : ConstructiveReals} (r1 r2 r3 : CRcarrier R), r1 <= r2 -> r2 < r3 -> r1 < r3. Proof. intros. destruct (CRltLinear R). destruct (s r2 r1 r3 H0). - contradiction. - apply c. Qed. Lemma CRlt_le_trans : forall {R : ConstructiveReals} (r1 r2 r3 : CRcarrier R), r1 < r2 -> r2 <= r3 -> r1 < r3. Proof. intros. destruct (CRltLinear R). destruct (s r1 r3 r2 H). - apply c. - contradiction. Qed. Lemma CRle_trans : forall {R : ConstructiveReals} (x y z : CRcarrier R), x <= y -> y <= z -> x <= z. Proof. intros. intro abs. apply H0. apply (CRlt_le_trans _ x); assumption. Qed. Lemma CRlt_trans : forall {R : ConstructiveReals} (x y z : CRcarrier R), x < y -> y < z -> x < z. Proof. intros. apply (CRlt_le_trans _ y _ H). apply CRlt_asym. exact H0. Qed. Lemma CRlt_trans_flip : forall {R : ConstructiveReals} (x y z : CRcarrier R), y < z -> x < y -> x < z. Proof. intros. apply (CRlt_le_trans _ y). - exact H0. - apply CRlt_asym. exact H. Qed. Lemma CReq_refl : forall {R : ConstructiveReals} (x : CRcarrier R), x == x. Proof. split; apply CRle_refl. Qed. Lemma CReq_sym : forall {R : ConstructiveReals} (x y : CRcarrier R), x == y -> y == x. Proof. intros. destruct H. split; intro abs; contradiction. Qed. Lemma CReq_trans : forall {R : ConstructiveReals} (x y z : CRcarrier R), x == y -> y == z -> x == z. Proof. intros. destruct H,H0. destruct (CRltLinear R), p. split. - intro abs. destruct (s _ y _ abs); contradiction. - intro abs. destruct (s _ y _ abs); contradiction. Qed. Add Parametric Relation {R : ConstructiveReals} : (CRcarrier R) (CReq R) reflexivity proved by (CReq_refl) symmetry proved by (CReq_sym) transitivity proved by (CReq_trans) as CReq_rel. #[global] Instance CReq_relT : forall {R : ConstructiveReals}, CRelationClasses.Equivalence (CReq R). Proof. split. - exact CReq_refl. - exact CReq_sym. - exact CReq_trans. Qed. #[global] Instance CRlt_morph : forall {R : ConstructiveReals}, CMorphisms.Proper (CMorphisms.respectful (CReq R) (CMorphisms.respectful (CReq R) CRelationClasses.iffT)) (CRlt R). Proof. intros R x y H x0 y0 H0. destruct H, H0. split. - intro. destruct (CRltLinear R). destruct (s x y x0). + assumption. + contradiction. + destruct (s y y0 x0). * assumption. * assumption. * contradiction. - intro. destruct (CRltLinear R). destruct (s y x y0). + assumption. + contradiction. + destruct (s x x0 y0). * assumption. * assumption. * contradiction. Qed. Add Parametric Morphism {R : ConstructiveReals} : (CRle R) with signature CReq R ==> CReq R ==> iff as CRle_morph. Proof. intros. split. - intros H1 H2. unfold CRle in H1. rewrite <- H0 in H2. rewrite <- H in H2. contradiction. - intros H1 H2. unfold CRle in H1. rewrite H0 in H2. rewrite H in H2. contradiction. Qed. Lemma CRplus_0_l : forall {R : ConstructiveReals} (x : CRcarrier R), 0 + x == x. Proof. intros. destruct (CRisRing R). apply Radd_0_l. Qed. Lemma CRplus_0_r : forall {R : ConstructiveReals} (x : CRcarrier R), x + 0 == x. Proof. intros. destruct (CRisRing R). transitivity (0 + x). - apply Radd_comm. - apply Radd_0_l. Qed. Lemma CRplus_opp_l : forall {R : ConstructiveReals} (x : CRcarrier R), - x + x == 0. Proof. intros. destruct (CRisRing R). transitivity (x + - x). - apply Radd_comm. - apply Ropp_def. Qed. Lemma CRplus_opp_r : forall {R : ConstructiveReals} (x : CRcarrier R), x + - x == 0. Proof. intros. destruct (CRisRing R). apply Ropp_def. Qed. Lemma CRopp_0 : forall {R : ConstructiveReals}, CRopp R 0 == 0. Proof. intros. rewrite <- CRplus_0_r, CRplus_opp_l. reflexivity. Qed. Lemma CRplus_lt_compat_r : forall {R : ConstructiveReals} (r r1 r2 : CRcarrier R), r1 < r2 -> r1 + r < r2 + r. Proof. intros. destruct (CRisRing R). apply (CRlt_proper R (CRplus R r r1) (CRplus R r1 r) (Radd_comm _ _) (CRplus R r2 r) (CRplus R r2 r)). - apply CReq_refl. - apply (CRlt_proper R _ _ (CReq_refl _) _ (CRplus R r r2)). + apply Radd_comm. + apply CRplus_lt_compat_l. exact H. Qed. Lemma CRplus_lt_reg_r : forall {R : ConstructiveReals} (r r1 r2 : CRcarrier R), r1 + r < r2 + r -> r1 < r2. Proof. intros. destruct (CRisRing R). apply (CRlt_proper R (CRplus R r r1) (CRplus R r1 r) (Radd_comm _ _) (CRplus R r2 r) (CRplus R r2 r)) in H. 2: apply CReq_refl. apply (CRlt_proper R _ _ (CReq_refl _) _ (CRplus R r r2)) in H. - apply CRplus_lt_reg_l in H. exact H. - apply Radd_comm. Qed. Lemma CRplus_le_compat_l : forall {R : ConstructiveReals} (r r1 r2 : CRcarrier R), r1 <= r2 -> r + r1 <= r + r2. Proof. intros. intros abs. apply CRplus_lt_reg_l in abs. apply H. exact abs. Qed. Lemma CRplus_le_compat_r : forall {R : ConstructiveReals} (r r1 r2 : CRcarrier R), r1 <= r2 -> r1 + r <= r2 + r. Proof. intros. intros abs. apply CRplus_lt_reg_r in abs. apply H. exact abs. Qed. Lemma CRplus_le_compat : forall {R : ConstructiveReals} (r1 r2 r3 r4 : CRcarrier R), r1 <= r2 -> r3 <= r4 -> r1 + r3 <= r2 + r4. Proof. intros. apply (CRle_trans _ (CRplus R r2 r3)). - apply CRplus_le_compat_r, H. - apply CRplus_le_compat_l, H0. Qed. Lemma CRle_minus : forall {R : ConstructiveReals} (x y : CRcarrier R), x <= y -> 0 <= y - x. Proof. intros. rewrite <- (CRplus_opp_r x). apply CRplus_le_compat_r. exact H. Qed. Lemma CRplus_le_reg_l : forall {R : ConstructiveReals} (r r1 r2 : CRcarrier R), r + r1 <= r + r2 -> r1 <= r2. Proof. intros. intro abs. apply H. clear H. apply CRplus_lt_compat_l. exact abs. Qed. Lemma CRplus_le_reg_r : forall {R : ConstructiveReals} (r r1 r2 : CRcarrier R), r1 + r <= r2 + r -> r1 <= r2. Proof. intros. intro abs. apply H. clear H. apply CRplus_lt_compat_r. exact abs. Qed. Lemma CRplus_lt_le_compat : forall {R : ConstructiveReals} (r1 r2 r3 r4 : CRcarrier R), r1 < r2 -> r3 <= r4 -> r1 + r3 < r2 + r4. Proof. intros. apply (CRlt_le_trans _ (CRplus R r2 r3)). - apply CRplus_lt_compat_r. exact H. - intro abs. apply CRplus_lt_reg_l in abs. contradiction. Qed. Lemma CRplus_le_lt_compat : forall {R : ConstructiveReals} (r1 r2 r3 r4 : CRcarrier R), r1 <= r2 -> r3 < r4 -> r1 + r3 < r2 + r4. Proof. intros. apply (CRle_lt_trans _ (CRplus R r2 r3)). - apply CRplus_le_compat_r. exact H. - apply CRplus_lt_compat_l. exact H0. Qed. Lemma CRplus_eq_reg_l : forall {R : ConstructiveReals} (r r1 r2 : CRcarrier R), r + r1 == r + r2 -> r1 == r2. Proof. intros. destruct (CRisRingExt R). clear Rmul_ext Ropp_ext. pose proof (Radd_ext (CRopp R r) (CRopp R r) (CReq_refl _) _ _ H). destruct (CRisRing R). apply (CReq_trans r1) in H0. - apply (CReq_trans _ _ _ H0). transitivity ((- r + r) + r2). + apply Radd_assoc. + transitivity (0 + r2). * apply Radd_ext. -- apply CRplus_opp_l. -- apply CReq_refl. * apply Radd_0_l. - apply CReq_sym. transitivity (- r + r + r1). + apply Radd_assoc. + transitivity (0 + r1). * apply Radd_ext. -- apply CRplus_opp_l. -- apply CReq_refl. * apply Radd_0_l. Qed. Lemma CRplus_eq_reg_r : forall {R : ConstructiveReals} (r r1 r2 : CRcarrier R), r1 + r == r2 + r -> r1 == r2. Proof. intros. apply (CRplus_eq_reg_l r). transitivity (r1 + r). - apply (Radd_comm (CRisRing R)). - transitivity (r2 + r). + exact H. + apply (Radd_comm (CRisRing R)). Qed. Lemma CRplus_assoc : forall {R : ConstructiveReals} (r r1 r2 : CRcarrier R), r + r1 + r2 == r + (r1 + r2). Proof. intros. symmetry. apply (Radd_assoc (CRisRing R)). Qed. Lemma CRplus_comm : forall {R : ConstructiveReals} (r1 r2 : CRcarrier R), r1 + r2 == r2 + r1. Proof. intros. apply (Radd_comm (CRisRing R)). Qed. Add Parametric Morphism {R : ConstructiveReals} : (CRplus R) with signature CReq R ==> CReq R ==> CReq R as CRplus_morph. Proof. apply (CRisRingExt R). Qed. Add Parametric Morphism {R : ConstructiveReals} : (CRopp R) with signature CReq R ==> CReq R as CRopp_morph. Proof. apply (CRisRingExt R). Qed. Add Parametric Morphism {R : ConstructiveReals} : (CRmult R) with signature CReq R ==> CReq R ==> CReq R as CRmult_morph. Proof. apply (CRisRingExt R). Qed. #[global] Instance CRplus_morph_T : forall {R : ConstructiveReals}, CMorphisms.Proper (CMorphisms.respectful (CReq R) (CMorphisms.respectful (CReq R) (CReq R))) (CRplus R). Proof. intros R x y H z t H1. apply CRplus_morph; assumption. Qed. #[global] Instance CRmult_morph_T : forall {R : ConstructiveReals}, CMorphisms.Proper (CMorphisms.respectful (CReq R) (CMorphisms.respectful (CReq R) (CReq R))) (CRmult R). Proof. intros R x y H z t H1. apply CRmult_morph; assumption. Qed. #[global] Instance CRopp_morph_T : forall {R : ConstructiveReals}, CMorphisms.Proper (CMorphisms.respectful (CReq R) (CReq R)) (CRopp R). Proof. apply CRisRingExt. Qed. Add Parametric Morphism {R : ConstructiveReals} : (CRminus R) with signature (CReq R) ==> (CReq R) ==> (CReq R) as CRminus_morph. Proof. intros. unfold CRminus. rewrite H,H0. reflexivity. Qed. #[global] Instance CRminus_morph_T : forall {R : ConstructiveReals}, CMorphisms.Proper (CMorphisms.respectful (CReq R) (CMorphisms.respectful (CReq R) (CReq R))) (CRminus R). Proof. intros R x y exy z t ezt. unfold CRminus. rewrite exy,ezt. reflexivity. Qed. Lemma CRopp_involutive : forall {R : ConstructiveReals} (r : CRcarrier R), - - r == r. Proof. intros. apply (CRplus_eq_reg_l (CRopp R r)). transitivity (CR_of_Q R 0). - apply CRisRing. - apply CReq_sym. transitivity (r + - r). + apply CRisRing. + apply CRisRing. Qed. Lemma CRopp_gt_lt_contravar : forall {R : ConstructiveReals} (r1 r2 : CRcarrier R), r2 < r1 -> - r1 < - r2. Proof. intros. apply (CRplus_lt_reg_l R r1). destruct (CRisRing R). apply (CRle_lt_trans _ 0). - apply Ropp_def. - apply (CRplus_lt_compat_l R (CRopp R r2)) in H. apply (CRle_lt_trans _ (CRplus R (CRopp R r2) r2)). + apply (CRle_trans _ (CRplus R r2 (CRopp R r2))). * destruct (Ropp_def r2). exact H0. * destruct (Radd_comm r2 (CRopp R r2)). exact H1. + apply (CRlt_le_trans _ _ _ H). destruct (Radd_comm r1 (CRopp R r2)). exact H0. Qed. Lemma CRopp_lt_cancel : forall {R : ConstructiveReals} (r1 r2 : CRcarrier R), - r2 < - r1 -> r1 < r2. Proof. intros. apply (CRplus_lt_compat_r r1) in H. rewrite (CRplus_opp_l r1) in H. apply (CRplus_lt_compat_l R r2) in H. rewrite CRplus_0_r, (Radd_assoc (CRisRing R)) in H. rewrite CRplus_opp_r, (Radd_0_l (CRisRing R)) in H. exact H. Qed. Lemma CRopp_ge_le_contravar : forall {R : ConstructiveReals} (r1 r2 : CRcarrier R), r2 <= r1 -> - r1 <= - r2. Proof. intros. intros abs. apply CRopp_lt_cancel in abs. contradiction. Qed. Lemma CRopp_plus_distr : forall {R : ConstructiveReals} (r1 r2 : CRcarrier R), - (r1 + r2) == - r1 + - r2. Proof. intros. destruct (CRisRing R), (CRisRingExt R). apply (CRplus_eq_reg_l (CRplus R r1 r2)). transitivity (CR_of_Q R 0). 1:apply Ropp_def. transitivity (r2 + r1 + (-r1 + -r2)). 1:transitivity (r2 + (r1 + (-r1 + -r2))). 1:transitivity (r2 + - r2). - apply CReq_sym. apply Ropp_def. - apply Radd_ext. + apply CReq_refl. + transitivity (0 + - r2). * apply CReq_sym, Radd_0_l. * transitivity (r1 + - r1 + - r2). -- apply Radd_ext. 2: apply CReq_refl. apply CReq_sym, Ropp_def. -- apply CReq_sym, Radd_assoc. - apply Radd_assoc. - apply Radd_ext. 2: apply CReq_refl. apply Radd_comm. Qed. Lemma CRmult_1_l : forall {R : ConstructiveReals} (r : CRcarrier R), 1 * r == r. Proof. intros. destruct (CRisRing R). apply Rmul_1_l. Qed. Lemma CRmult_1_r : forall {R : ConstructiveReals} (x : CRcarrier R), x * 1 == x. Proof. intros. destruct (CRisRing R). transitivity (CRmult R 1 x). - apply Rmul_comm. - apply Rmul_1_l. Qed. Lemma CRmult_assoc : forall {R : ConstructiveReals} (r r1 r2 : CRcarrier R), r * r1 * r2 == r * (r1 * r2). Proof. intros. symmetry. apply (Rmul_assoc (CRisRing R)). Qed. Lemma CRmult_comm : forall {R : ConstructiveReals} (r s : CRcarrier R), r * s == s * r. Proof. intros. rewrite (Rmul_comm (CRisRing R) r). reflexivity. Qed. Lemma CRmult_plus_distr_l : forall {R : ConstructiveReals} (r1 r2 r3 : CRcarrier R), r1 * (r2 + r3) == (r1 * r2) + (r1 * r3). Proof. intros. destruct (CRisRing R). transitivity ((r2 + r3) * r1). - apply Rmul_comm. - transitivity ((r2 * r1) + (r3 * r1)). + apply Rdistr_l. + transitivity ((r1 * r2) + (r3 * r1)). * destruct (CRisRingExt R). apply Radd_ext. -- apply Rmul_comm. -- apply CReq_refl. * destruct (CRisRingExt R). apply Radd_ext. -- apply CReq_refl. -- apply Rmul_comm. Qed. Lemma CRmult_plus_distr_r : forall {R : ConstructiveReals} (r1 r2 r3 : CRcarrier R), (r2 + r3) * r1 == (r2 * r1) + (r3 * r1). Proof. intros. do 3 rewrite <- (CRmult_comm r1). apply CRmult_plus_distr_l. Qed. (* x == x+x -> x == 0 *) Lemma CRzero_double : forall {R : ConstructiveReals} (x : CRcarrier R), x == x + x -> x == 0. Proof. intros. apply (CRplus_eq_reg_l x), CReq_sym. transitivity x. - apply CRplus_0_r. - exact H. Qed. Lemma CRmult_0_r : forall {R : ConstructiveReals} (x : CRcarrier R), x * 0 == 0. Proof. intros. apply CRzero_double. transitivity (x * (0 + 0)). - destruct (CRisRingExt R). apply Rmul_ext. + apply CReq_refl. + apply CReq_sym, CRplus_0_r. - destruct (CRisRing R). apply CRmult_plus_distr_l. Qed. Lemma CRmult_0_l : forall {R : ConstructiveReals} (r : CRcarrier R), 0 * r == 0. Proof. intros. rewrite CRmult_comm. apply CRmult_0_r. Qed. Lemma CRopp_mult_distr_r : forall {R : ConstructiveReals} (r1 r2 : CRcarrier R), - (r1 * r2) == r1 * (- r2). Proof. intros. apply (CRplus_eq_reg_l (CRmult R r1 r2)). destruct (CRisRing R). transitivity (CR_of_Q R 0). 1:apply Ropp_def. transitivity (r1 * (r2 + - r2)). 2: apply CRmult_plus_distr_l. transitivity (r1 * 0). 1:apply CReq_sym, CRmult_0_r. destruct (CRisRingExt R). apply Rmul_ext. - apply CReq_refl. - apply CReq_sym, Ropp_def. Qed. Lemma CRopp_mult_distr_l : forall {R : ConstructiveReals} (r1 r2 : CRcarrier R), - (r1 * r2) == (- r1) * r2. Proof. intros. transitivity (r2 * - r1). 1:transitivity (- (r2 * r1)). - apply (Ropp_ext (CRisRingExt R)). apply CReq_sym, (Rmul_comm (CRisRing R)). - apply CRopp_mult_distr_r. - apply CReq_sym, (Rmul_comm (CRisRing R)). Qed. Lemma CRmult_lt_compat_r : forall {R : ConstructiveReals} (r r1 r2 : CRcarrier R), 0 < r -> r1 < r2 -> r1 * r < r2 * r. Proof. intros. apply (CRplus_lt_reg_r (CRopp R (CRmult R r1 r))). apply (CRle_lt_trans _ 0). 1:apply (Ropp_def (CRisRing R)). apply (CRlt_le_trans _ (CRplus R (CRmult R r2 r) (CRmult R (CRopp R r1) r))). 1:apply (CRlt_le_trans _ (CRmult R (CRplus R r2 (CRopp R r1)) r)). - apply CRmult_lt_0_compat. 2: exact H. apply (CRplus_lt_reg_r r1). apply (CRle_lt_trans _ r1). + apply (Radd_0_l (CRisRing R)). + apply (CRlt_le_trans _ r2 _ H0). apply (CRle_trans _ (CRplus R r2 (CRplus R (CRopp R r1) r1))). 1:apply (CRle_trans _ (CRplus R r2 0)). * destruct (CRplus_0_r r2). exact H1. * apply CRplus_le_compat_l. destruct (CRplus_opp_l r1). exact H1. * destruct (Radd_assoc (CRisRing R) r2 (CRopp R r1) r1). exact H2. - destruct (CRisRing R). destruct (Rdistr_l r2 (CRopp R r1) r). exact H2. - apply CRplus_le_compat_l. destruct (CRopp_mult_distr_l r1 r). exact H1. Qed. Lemma CRmult_lt_compat_l : forall {R : ConstructiveReals} (r r1 r2 : CRcarrier R), 0 < r -> r1 < r2 -> r * r1 < r * r2. Proof. intros. do 2 rewrite (CRmult_comm r). apply CRmult_lt_compat_r; assumption. Qed. Lemma CRinv_r : forall {R : ConstructiveReals} (r:CRcarrier R) (rnz : r ≶ 0), r * (/ r) rnz == 1. Proof. intros. transitivity ((/ r) rnz * r). - apply (CRisRing R). - apply CRinv_l. Qed. Lemma CRmult_lt_reg_r : forall {R : ConstructiveReals} (r r1 r2 : CRcarrier R), 0 < r -> r1 * r < r2 * r -> r1 < r2. Proof. intros. apply (CRmult_lt_compat_r ((/ r) (inr H))) in H0. 2: apply CRinv_0_lt_compat, H. apply (CRle_lt_trans _ ((r1 * r) * ((/ r) (inr H)))). - clear H0. apply (CRle_trans _ (CRmult R r1 1)). + destruct (CRmult_1_r r1). exact H0. + apply (CRle_trans _ (CRmult R r1 (CRmult R r ((/ r) (inr H))))). * destruct (Rmul_ext (CRisRingExt R) r1 r1 (CReq_refl r1) (r * ((/ r) (inr H))) 1). -- apply CRinv_r. -- exact H0. * destruct (Rmul_assoc (CRisRing R) r1 r ((/ r) (inr H))). exact H1. - apply (CRlt_le_trans _ ((r2 * r) * ((/ r) (inr H)))). { exact H0. } clear H0. apply (CRle_trans _ (r2 * 1)). 2: destruct (CRmult_1_r r2); exact H1. apply (CRle_trans _ (r2 * (r * ((/ r) (inr H))))). { destruct (Rmul_assoc (CRisRing R) r2 r ((/ r) (inr H))). exact H0. } destruct (Rmul_ext (CRisRingExt R) r2 r2 (CReq_refl r2) (r * ((/ r) (inr H))) 1). + apply CRinv_r. + exact H1. Qed. Lemma CRmult_lt_reg_l : forall {R : ConstructiveReals} (r r1 r2 : CRcarrier R), 0 < r -> r * r1 < r * r2 -> r1 < r2. Proof. intros. rewrite (Rmul_comm (CRisRing R) r r1) in H0. rewrite (Rmul_comm (CRisRing R) r r2) in H0. apply CRmult_lt_reg_r in H0. - exact H0. - exact H. Qed. Lemma CRmult_le_compat_l_half : forall {R : ConstructiveReals} (r r1 r2 : CRcarrier R), 0 < r -> r1 <= r2 -> r * r1 <= r * r2. Proof. intros. intro abs. apply CRmult_lt_reg_l in abs. - contradiction. - exact H. Qed. Lemma CRmult_le_compat_r_half : forall {R : ConstructiveReals} (r r1 r2 : CRcarrier R), 0 < r -> r1 <= r2 -> r1 * r <= r2 * r. Proof. intros. intro abs. apply CRmult_lt_reg_r in abs. - contradiction. - exact H. Qed. Lemma CRmult_eq_reg_r : forall {R : ConstructiveReals} (r r1 r2 : CRcarrier R), 0 ≶ r -> r1 * r == r2 * r -> r1 == r2. Proof. intros. destruct H0,H. - split. + intro abs. apply H0. apply CRmult_lt_compat_r. * exact c. * exact abs. + intro abs. apply H1. apply CRmult_lt_compat_r. * exact c. * exact abs. - split. + intro abs. apply H1. apply CRopp_lt_cancel. apply (CRle_lt_trans _ (CRmult R r1 (CRopp R r))). { apply CRopp_mult_distr_r. } apply (CRlt_le_trans _ (CRmult R r2 (CRopp R r))). 2: apply CRopp_mult_distr_r. apply CRmult_lt_compat_r. 2: exact abs. apply (CRplus_lt_reg_r r). apply (CRle_lt_trans _ r). { apply (Radd_0_l (CRisRing R)). } apply (CRlt_le_trans _ 0 _ c). apply CRplus_opp_l. + intro abs. apply H0. apply CRopp_lt_cancel. apply (CRle_lt_trans _ (CRmult R r2 (CRopp R r))). 1:apply CRopp_mult_distr_r. apply (CRlt_le_trans _ (CRmult R r1 (CRopp R r))). 2: apply CRopp_mult_distr_r. apply CRmult_lt_compat_r. 2: exact abs. apply (CRplus_lt_reg_r r). apply (CRle_lt_trans _ r). 1:apply (Radd_0_l (CRisRing R)). apply (CRlt_le_trans _ 0 _ c). apply CRplus_opp_l. Qed. Lemma CRinv_1 : forall {R : ConstructiveReals} (onz : CRapart R 1 0), (/ 1) onz == 1. Proof. intros. rewrite <- (CRmult_1_r ((/ 1) onz)). rewrite CRinv_l. reflexivity. Qed. Lemma CRmult_eq_reg_l : forall {R : ConstructiveReals} (r r1 r2 : CRcarrier R), r ≶ 0 -> r * r1 == r * r2 -> r1 == r2. Proof. intros. rewrite (Rmul_comm (CRisRing R)) in H0. rewrite (Rmul_comm (CRisRing R) r) in H0. apply CRmult_eq_reg_r in H0. - exact H0. - destruct H. + right. exact c. + left. exact c. Qed. Lemma CRinv_mult_distr : forall {R : ConstructiveReals} (r1 r2 : CRcarrier R) (r1nz : r1 ≶ 0) (r2nz : r2 ≶ 0) (rmnz : (r1*r2) ≶ 0), (/ (r1 * r2)) rmnz == (/ r1) r1nz * (/ r2) r2nz. Proof. intros. apply (CRmult_eq_reg_l r1). - exact r1nz. - rewrite (Rmul_assoc (CRisRing R)). rewrite CRinv_r. rewrite CRmult_1_l. apply (CRmult_eq_reg_l r2). + exact r2nz. + rewrite CRinv_r. rewrite (Rmul_assoc (CRisRing R)). rewrite (CRmult_comm r2 r1). rewrite CRinv_r. reflexivity. Qed. Lemma CRinv_morph : forall {R : ConstructiveReals} (x y : CRcarrier R) (rxnz : x ≶ 0) (rynz : y ≶ 0), x == y -> (/ x) rxnz == (/ y) rynz. Proof. intros. apply (CRmult_eq_reg_l x). - exact rxnz. - rewrite CRinv_r, H, CRinv_r. reflexivity. Qed. Lemma CRlt_minus : forall {R : ConstructiveReals} (x y : CRcarrier R), x < y -> 0 < y - x. Proof. intros. rewrite <- (CRplus_opp_r x). apply CRplus_lt_compat_r. exact H. Qed. Lemma CR_of_Q_le : forall {R : ConstructiveReals} (r q : Q), Qle r q -> CR_of_Q R r <= CR_of_Q R q. Proof. intros. intro abs. apply lt_CR_of_Q in abs. exact (Qlt_not_le _ _ abs H). Qed. Add Parametric Morphism {R : ConstructiveReals} : (CR_of_Q R) with signature Qeq ==> CReq R as CR_of_Q_morph. Proof. split; apply CR_of_Q_le; rewrite H; apply Qle_refl. Qed. Lemma eq_inject_Q : forall {R : ConstructiveReals} (q r : Q), CR_of_Q R q == CR_of_Q R r -> Qeq q r. Proof. intros. destruct H. destruct (Q_dec q r). - destruct s. + exfalso. apply (CR_of_Q_lt R q r) in q0. contradiction. + exfalso. apply (CR_of_Q_lt R r q) in q0. contradiction. - exact q0. Qed. #[global] Instance CR_of_Q_morph_T : forall {R : ConstructiveReals}, CMorphisms.Proper (CMorphisms.respectful Qeq (CReq R)) (CR_of_Q R). Proof. intros R x y H. apply CR_of_Q_morph; assumption. Qed. Lemma CR_of_Q_opp : forall {R : ConstructiveReals} (q : Q), CR_of_Q R (-q) == - CR_of_Q R q. Proof. intros. apply (CRplus_eq_reg_l (CR_of_Q R q)). transitivity (CR_of_Q R 0). - transitivity (CR_of_Q R (q-q)). + apply CReq_sym, CR_of_Q_plus. + apply CR_of_Q_morph. ring. - apply CReq_sym. apply (CRisRing R). Qed. Lemma CR_of_Q_pos : forall {R : ConstructiveReals} (q:Q), Qlt 0 q -> 0 < CR_of_Q R q. Proof. intros. apply CR_of_Q_lt. exact H. Qed. Lemma CR_of_Q_inv : forall {R : ConstructiveReals} (q : Q) (qPos : Qlt 0 q), CR_of_Q R (/q) == (/ CR_of_Q R q) (inr (CR_of_Q_pos q qPos)). Proof. intros. apply (CRmult_eq_reg_l (CR_of_Q R q)). - right. apply CR_of_Q_pos, qPos. - rewrite CRinv_r, <- CR_of_Q_mult. apply CR_of_Q_morph. field. intro abs. rewrite abs in qPos. exact (Qlt_irrefl 0 qPos). Qed. Lemma CRmult_le_0_compat : forall {R : ConstructiveReals} (a b : CRcarrier R), 0 <= a -> 0 <= b -> 0 <= a * b. Proof. (* Limit of (a + 1/n)*b when n -> infty. *) intros. intro abs. assert (0 < -(a*b)) as epsPos. { rewrite <- CRopp_0. apply CRopp_gt_lt_contravar. exact abs. } destruct (CR_archimedean R (b * ((/ -(a*b)) (inr epsPos)))) as [n maj]. assert (0 < CR_of_Q R (Z.pos n #1)) as nPos. { apply CR_of_Q_lt. reflexivity. } assert (b * (/ CR_of_Q R (Z.pos n #1)) (inr nPos) < -(a*b)). { apply (CRmult_lt_reg_r (CR_of_Q R (Z.pos n #1))). - apply nPos. - rewrite <- (Rmul_assoc (CRisRing R)), CRinv_l, CRmult_1_r. apply (CRmult_lt_compat_r (-(a*b))) in maj. + rewrite CRmult_assoc, CRinv_l, CRmult_1_r in maj. rewrite CRmult_comm. apply maj. + apply epsPos. } pose proof (CRmult_le_compat_l_half (a + (/ CR_of_Q R (Z.pos n #1)) (inr nPos)) 0 b). assert (0 + 0 < a + (/ CR_of_Q R (Z.pos n #1)) (inr nPos)). { apply CRplus_le_lt_compat. - apply H. - apply CRinv_0_lt_compat. apply nPos. } rewrite CRplus_0_l in H3. specialize (H2 H3 H0). clear H3. rewrite CRmult_0_r in H2. apply H2. clear H2. rewrite (Rdistr_l (CRisRing R)). apply (CRplus_lt_compat_l R (a*b)) in H1. rewrite CRplus_opp_r in H1. rewrite (CRmult_comm ((/ CR_of_Q R (Z.pos n # 1)) (inr nPos))). apply H1. Qed. Lemma CRmult_le_compat_l : forall {R : ConstructiveReals} (r r1 r2:CRcarrier R), 0 <= r -> r1 <= r2 -> r * r1 <= r * r2. Proof. intros. apply (CRplus_le_reg_r (-(r*r1))). rewrite CRplus_opp_r, CRopp_mult_distr_r. rewrite <- CRmult_plus_distr_l. apply CRmult_le_0_compat. - exact H. - apply (CRplus_le_reg_r r1). rewrite CRplus_0_l, CRplus_assoc, CRplus_opp_l, CRplus_0_r. exact H0. Qed. Lemma CRmult_le_compat_r : forall {R : ConstructiveReals} (r r1 r2:CRcarrier R), 0 <= r -> r1 <= r2 -> r1 * r <= r2 * r. Proof. intros. do 2 rewrite <- (CRmult_comm r). apply CRmult_le_compat_l; assumption. Qed. Lemma CRmult_pos_pos : forall {R : ConstructiveReals} (x y : CRcarrier R), 0 < x * y -> 0 <= x -> 0 <= y -> 0 < x. Proof. intros. destruct (CRltLinear R). clear p. specialize (s 0 x 1 (CRzero_lt_one R)) as [H2|H2]. - exact H2. - apply CRlt_asym in H2. apply (CRmult_le_compat_r y) in H2. 2: exact H1. rewrite CRmult_1_l in H2. apply (CRlt_le_trans _ _ _ H) in H2. rewrite <- (CRmult_0_l y) in H. apply CRmult_lt_reg_r in H. + exact H. + exact H2. Qed. (* In particular x * y == 1 implies that 0 # x, 0 # y and that x and y are inverses of each other. *) Lemma CRmult_pos_appart_zero : forall {R : ConstructiveReals} (x y : CRcarrier R), 0 < x * y -> 0 ≶ x. Proof. intros. (* Narrow cases to x < 1. *) destruct (CRltLinear R). clear p. pose proof (s 0 x 1 (CRzero_lt_one R)) as [H0|H0]. { left. exact H0. } (* In this case, linear order 0 y (x*y) decides. *) destruct (s 0 y (x*y) H). - left. rewrite <- (CRmult_0_l y) in H. apply CRmult_lt_reg_r in H. + exact H. + exact c. - right. apply CRopp_lt_cancel. rewrite CRopp_0. apply (CRmult_pos_pos (-x) (-y)). + rewrite <- CRopp_mult_distr_l, CRopp_mult_distr_r, CRopp_involutive. exact H. + rewrite <- CRopp_0. apply CRopp_ge_le_contravar. intro abs. rewrite <- (CRmult_0_r x) in H. apply CRmult_lt_reg_l in H. * rewrite <- (CRmult_1_l y) in c. rewrite <- CRmult_assoc in c. apply CRmult_lt_reg_r in c. -- rewrite CRmult_1_r in c. exact (CRlt_asym _ _ H0 c). -- exact H. * exact abs. + intro abs. apply (CRmult_lt_compat_r y) in H0. * rewrite CRmult_1_l in H0. exact (CRlt_asym _ _ H0 c). * apply CRopp_lt_cancel. rewrite CRopp_0. exact abs. Qed. Lemma CRmult_le_reg_l : forall {R : ConstructiveReals} (x y z : CRcarrier R), 0 < x -> x * y <= x * z -> y <= z. Proof. intros. intro abs. apply (CRmult_lt_compat_l x) in abs. - contradiction. - exact H. Qed. Lemma CRmult_le_reg_r : forall {R : ConstructiveReals} (x y z : CRcarrier R), 0 < x -> y * x <= z * x -> y <= z. Proof. intros. intro abs. apply (CRmult_lt_compat_r x) in abs. - contradiction. - exact H. Qed. Definition CRup_nat {R : ConstructiveReals} (x : CRcarrier R) : { n : nat & x < CR_of_Q R (Z.of_nat n #1) }. Proof. destruct (CR_archimedean R x). exists (Pos.to_nat x0). rewrite positive_nat_Z. exact c. Qed. Definition CRfloor {R : ConstructiveReals} (a : CRcarrier R) : { p : Z & prod (CR_of_Q R (p#1) < a) (a < CR_of_Q R (p#1) + CR_of_Q R 2) }. Proof. destruct (CR_Q_dense R (a - CR_of_Q R (1#2)) a) as [q qmaj]. - apply (CRlt_le_trans _ (a-0)). + apply CRplus_lt_compat_l. apply CRopp_gt_lt_contravar. apply CR_of_Q_lt. reflexivity. + unfold CRminus. rewrite CRopp_0, CRplus_0_r. apply CRle_refl. - exists (Qfloor q). destruct qmaj. split. + apply (CRle_lt_trans _ (CR_of_Q R q)). 2: exact c0. apply CR_of_Q_le. apply Qfloor_le. + apply (CRlt_le_trans _ (CR_of_Q R q + CR_of_Q R (1#2))). * apply (CRplus_lt_compat_r (CR_of_Q R (1 # 2))) in c. unfold CRminus in c. rewrite CRplus_assoc, CRplus_opp_l, CRplus_0_r in c. exact c. * rewrite (CR_of_Q_plus R 1 1), <- CRplus_assoc, <- (CR_of_Q_plus R _ 1). apply CRplus_le_compat. -- apply CR_of_Q_le. rewrite Qinv_plus_distr. apply Qlt_le_weak, Qlt_floor. -- apply CR_of_Q_le. discriminate. Qed. Lemma CRplus_appart_reg_l : forall {R : ConstructiveReals} (r r1 r2 : CRcarrier R), (r + r1) ≶ (r + r2) -> r1 ≶ r2. Proof. intros. destruct H. - left. apply (CRplus_lt_reg_l R r), c. - right. apply (CRplus_lt_reg_l R r), c. Qed. Lemma CRplus_appart_reg_r : forall {R : ConstructiveReals} (r r1 r2 : CRcarrier R), (r1 + r) ≶ (r2 + r) -> r1 ≶ r2. Proof. intros. destruct H. - left. apply (CRplus_lt_reg_r r), c. - right. apply (CRplus_lt_reg_r r), c. Qed. Lemma CRmult_appart_reg_l : forall {R : ConstructiveReals} (r r1 r2 : CRcarrier R), 0 < r -> (r * r1) ≶ (r * r2) -> r1 ≶ r2. Proof. intros. destruct H0. - left. exact (CRmult_lt_reg_l r _ _ H c). - right. exact (CRmult_lt_reg_l r _ _ H c). Qed. Lemma CRmult_appart_reg_r : forall {R : ConstructiveReals} (r r1 r2 : CRcarrier R), 0 < r -> (r1 * r) ≶ (r2 * r) -> r1 ≶ r2. Proof. intros. destruct H0. - left. exact (CRmult_lt_reg_r r _ _ H c). - right. exact (CRmult_lt_reg_r r _ _ H c). Qed. #[global] Instance CRapart_morph : forall {R : ConstructiveReals}, CMorphisms.Proper (CMorphisms.respectful (CReq R) (CMorphisms.respectful (CReq R) CRelationClasses.iffT)) (CRapart R). Proof. intros R x y H x0 y0 H0. destruct H, H0. split. - intro. destruct H3. + left. apply (CRle_lt_trans _ x _ H). apply (CRlt_le_trans _ x0 _ c), H2. + right. apply (CRle_lt_trans _ x0 _ H0). apply (CRlt_le_trans _ x _ c), H1. - intro. destruct H3. + left. apply (CRle_lt_trans _ y _ H1). apply (CRlt_le_trans _ y0 _ c), H0. + right. apply (CRle_lt_trans _ y0 _ H2). apply (CRlt_le_trans _ y _ c), H. Qed. coq-8.20.0/theories/Reals/Abstract/ConstructiveRealsMorphisms.v000066400000000000000000001505101466560755400246120ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * INRIA, CNRS and contributors - Copyright 1999-2019 *) (* R2 are extensionally equal. We will further show that they exist, and so are isomorphisms. The difference between two morphisms R1 -> R2 is therefore the speed of computation. The canonical isomorphisms we provide here are often very slow, when a new implementation of constructive reals is added, it should define its own ad hoc isomorphisms for better speed. Apart from the speed, those unique isomorphisms also serve as sanity checks of the interface ConstructiveReals : it captures a concept with a strong notion of uniqueness. WARNING: this file is experimental and likely to change in future releases. *) Require Import QArith. Require Import Qabs. Require Import ConstructiveReals. Require Import ConstructiveLimits. Require Import ConstructiveAbs. Local Open Scope ConstructiveReals. Record ConstructiveRealsMorphism {R1 R2 : ConstructiveReals} : Set := { CRmorph : CRcarrier R1 -> CRcarrier R2; CRmorph_rat : forall q : Q, CRmorph (CR_of_Q R1 q) == CR_of_Q R2 q; CRmorph_increasing : forall x y : CRcarrier R1, CRlt R1 x y -> CRlt R2 (CRmorph x) (CRmorph y); }. Lemma CRmorph_increasing_inv : forall {R1 R2 : ConstructiveReals} (f : ConstructiveRealsMorphism) (x y : CRcarrier R1), CRlt R2 (CRmorph f x) (CRmorph f y) -> CRlt R1 x y. Proof. intros. destruct (CR_Q_dense R2 _ _ H) as [q [H0 H1]]. destruct (CR_Q_dense R2 _ _ H0) as [r [H2 H3]]. apply lt_CR_of_Q, (CR_of_Q_lt R1) in H3. destruct (CRltLinear R1). destruct (s _ x _ H3). - exfalso. apply (CRmorph_increasing f) in c. destruct (CRmorph_rat f r) as [H4 _]. apply (CRle_lt_trans _ _ _ H4) in c. clear H4. exact (CRlt_asym _ _ c H2). - clear H2 H3 r. apply (CRlt_trans _ _ _ c). clear c. destruct (CR_Q_dense R2 _ _ H1) as [t [H2 H3]]. apply lt_CR_of_Q, (CR_of_Q_lt R1) in H2. destruct (s _ y _ H2). { exact c. } exfalso. apply (CRmorph_increasing f) in c. destruct (CRmorph_rat f t) as [_ H4]. apply (CRlt_le_trans _ _ _ c) in H4. clear c. exact (CRlt_asym _ _ H4 H3). Qed. Lemma CRmorph_unique : forall {R1 R2 : ConstructiveReals} (f g : @ConstructiveRealsMorphism R1 R2) (x : CRcarrier R1), CRmorph f x == CRmorph g x. Proof. split. - intro abs. destruct (CR_Q_dense R2 _ _ abs) as [q [H H0]]. destruct (CRmorph_rat f q) as [H1 _]. apply (CRlt_le_trans _ _ _ H) in H1. clear H. apply CRmorph_increasing_inv in H1. destruct (CRmorph_rat g q) as [_ H2]. apply (CRle_lt_trans _ _ _ H2) in H0. clear H2. apply CRmorph_increasing_inv in H0. exact (CRlt_asym _ _ H0 H1). - intro abs. destruct (CR_Q_dense R2 _ _ abs) as [q [H H0]]. destruct (CRmorph_rat f q) as [_ H1]. apply (CRle_lt_trans _ _ _ H1) in H0. clear H1. apply CRmorph_increasing_inv in H0. destruct (CRmorph_rat g q) as [H2 _]. apply (CRlt_le_trans _ _ _ H) in H2. clear H. apply CRmorph_increasing_inv in H2. exact (CRlt_asym _ _ H0 H2). Qed. (* The identity is the only endomorphism of constructive reals. For any ConstructiveReals R1, R2 and any morphisms f : R1 -> R2 and g : R2 -> R1, f and g are isomorphisms and are inverses of each other. *) Lemma Endomorph_id : forall {R : ConstructiveReals} (f : @ConstructiveRealsMorphism R R) (x : CRcarrier R), CRmorph f x == x. Proof. split. - intro abs. destruct (CR_Q_dense R _ _ abs) as [q [H0 H1]]. destruct (CRmorph_rat f q) as [H _]. apply (CRlt_le_trans _ _ _ H0) in H. clear H0. apply CRmorph_increasing_inv in H. exact (CRlt_asym _ _ H1 H). - intro abs. destruct (CR_Q_dense R _ _ abs) as [q [H0 H1]]. destruct (CRmorph_rat f q) as [_ H]. apply (CRle_lt_trans _ _ _ H) in H1. clear H. apply CRmorph_increasing_inv in H1. exact (CRlt_asym _ _ H1 H0). Qed. Lemma CRmorph_proper : forall {R1 R2 : ConstructiveReals} (f : @ConstructiveRealsMorphism R1 R2) (x y : CRcarrier R1), x == y -> CRmorph f x == CRmorph f y. Proof. split. - intro abs. apply CRmorph_increasing_inv in abs. destruct H. contradiction. - intro abs. apply CRmorph_increasing_inv in abs. destruct H. contradiction. Qed. Definition CRmorph_compose {R1 R2 R3 : ConstructiveReals} (f : @ConstructiveRealsMorphism R1 R2) (g : @ConstructiveRealsMorphism R2 R3) : @ConstructiveRealsMorphism R1 R3. Proof. apply (Build_ConstructiveRealsMorphism R1 R3 (fun x:CRcarrier R1 => CRmorph g (CRmorph f x))). - intro q. apply (CReq_trans _ (CRmorph g (CR_of_Q R2 q))). + apply CRmorph_proper. apply CRmorph_rat. + apply CRmorph_rat. - intros. apply CRmorph_increasing. apply CRmorph_increasing. exact H. Defined. Lemma CRmorph_le : forall {R1 R2 : ConstructiveReals} (f : @ConstructiveRealsMorphism R1 R2) (x y : CRcarrier R1), x <= y -> CRmorph f x <= CRmorph f y. Proof. intros. intro abs. apply CRmorph_increasing_inv in abs. contradiction. Qed. Lemma CRmorph_le_inv : forall {R1 R2 : ConstructiveReals} (f : @ConstructiveRealsMorphism R1 R2) (x y : CRcarrier R1), CRmorph f x <= CRmorph f y -> x <= y. Proof. intros. intro abs. apply (CRmorph_increasing f) in abs. contradiction. Qed. Lemma CRmorph_zero : forall {R1 R2 : ConstructiveReals} (f : @ConstructiveRealsMorphism R1 R2), CRmorph f 0 == 0. Proof. intros. apply (CReq_trans _ (CRmorph f (CR_of_Q R1 0))). - apply CRmorph_proper. reflexivity. - apply CRmorph_rat. Qed. Lemma CRmorph_one : forall {R1 R2 : ConstructiveReals} (f : @ConstructiveRealsMorphism R1 R2), CRmorph f 1 == 1. Proof. intros. apply (CReq_trans _ (CRmorph f (CR_of_Q R1 1))). - apply CRmorph_proper. reflexivity. - apply CRmorph_rat. Qed. Lemma CRmorph_opp : forall {R1 R2 : ConstructiveReals} (f : @ConstructiveRealsMorphism R1 R2) (x : CRcarrier R1), CRmorph f (- x) == - CRmorph f x. Proof. split. - intro abs. destruct (CR_Q_dense R2 _ _ abs) as [q [H H0]]. clear abs. destruct (CRmorph_rat f q) as [H1 _]. apply (CRlt_le_trans _ _ _ H) in H1. clear H. apply CRmorph_increasing_inv in H1. apply CRopp_gt_lt_contravar in H0. destruct (@CR_of_Q_opp R2 q) as [H2 _]. apply (CRlt_le_trans _ _ _ H0) in H2. clear H0. pose proof (CRopp_involutive (CRmorph f x)) as [H _]. apply (CRle_lt_trans _ _ _ H) in H2. clear H. destruct (CRmorph_rat f (-q)) as [H _]. apply (CRlt_le_trans _ _ _ H2) in H. clear H2. apply CRmorph_increasing_inv in H. destruct (@CR_of_Q_opp R1 q) as [_ H2]. apply (CRlt_le_trans _ _ _ H) in H2. clear H. apply CRopp_gt_lt_contravar in H2. pose proof (CRopp_involutive (CR_of_Q R1 q)) as [H _]. apply (CRle_lt_trans _ _ _ H) in H2. clear H. exact (CRlt_asym _ _ H1 H2). - intro abs. destruct (CR_Q_dense R2 _ _ abs) as [q [H H0]]. clear abs. destruct (CRmorph_rat f q) as [_ H1]. apply (CRle_lt_trans _ _ _ H1) in H0. clear H1. apply CRmorph_increasing_inv in H0. apply CRopp_gt_lt_contravar in H. pose proof (CRopp_involutive (CRmorph f x)) as [_ H1]. apply (CRlt_le_trans _ _ _ H) in H1. clear H. destruct (@CR_of_Q_opp R2 q) as [_ H2]. apply (CRle_lt_trans _ _ _ H2) in H1. clear H2. destruct (CRmorph_rat f (-q)) as [_ H]. apply (CRle_lt_trans _ _ _ H) in H1. clear H. apply CRmorph_increasing_inv in H1. destruct (@CR_of_Q_opp R1 q) as [H2 _]. apply (CRle_lt_trans _ _ _ H2) in H1. clear H2. apply CRopp_gt_lt_contravar in H1. pose proof (CRopp_involutive (CR_of_Q R1 q)) as [_ H]. apply (CRlt_le_trans _ _ _ H1) in H. clear H1. exact (CRlt_asym _ _ H0 H). Qed. Lemma CRplus_pos_rat_lt : forall {R : ConstructiveReals} (x : CRcarrier R) (q : Q), Qlt 0 q -> CRlt R x (CRplus R x (CR_of_Q R q)). Proof. intros. apply (CRle_lt_trans _ (CRplus R x 0)). - apply CRplus_0_r. - apply CRplus_lt_compat_l. apply (CRle_lt_trans _ (CR_of_Q R 0)). + apply CRle_refl. + apply CR_of_Q_lt. exact H. Qed. Lemma CRplus_neg_rat_lt : forall {R : ConstructiveReals} (x : CRcarrier R) (q : Q), Qlt q 0 -> CRlt R (CRplus R x (CR_of_Q R q)) x. Proof. intros. apply (CRlt_le_trans _ (CRplus R x 0)). 2: apply CRplus_0_r. apply CRplus_lt_compat_l. apply (CRlt_le_trans _ (CR_of_Q R 0)). - apply CR_of_Q_lt. exact H. - apply CRle_refl. Qed. Lemma CRmorph_plus_rat : forall {R1 R2 : ConstructiveReals} (f : @ConstructiveRealsMorphism R1 R2) (x : CRcarrier R1) (q : Q), CRmorph f (CRplus R1 x (CR_of_Q R1 q)) == CRplus R2 (CRmorph f x) (CR_of_Q R2 q). Proof. split. - intro abs. destruct (CR_Q_dense R2 _ _ abs) as [r [H H0]]. clear abs. destruct (CRmorph_rat f r) as [H1 _]. apply (CRlt_le_trans _ _ _ H) in H1. clear H. apply CRmorph_increasing_inv in H1. apply (CRlt_asym _ _ H1). clear H1. apply (CRplus_lt_reg_r (CRopp R1 (CR_of_Q R1 q))). apply (CRlt_le_trans _ x). + apply (CRle_lt_trans _ (CR_of_Q R1 (r-q))). * apply (CRle_trans _ (CRplus R1 (CR_of_Q R1 r) (CR_of_Q R1 (-q)))). -- apply CRplus_le_compat_l. destruct (@CR_of_Q_opp R1 q). exact H. -- destruct (CR_of_Q_plus R1 r (-q)). exact H. * apply (CRmorph_increasing_inv f). apply (CRle_lt_trans _ (CR_of_Q R2 (r - q))). -- apply CRmorph_rat. -- apply (CRplus_lt_reg_r (CR_of_Q R2 q)). apply (CRle_lt_trans _ (CR_of_Q R2 r)). 2: exact H0. intro H. destruct (CR_of_Q_plus R2 (r-q) q) as [H1 _]. apply (CRlt_le_trans _ _ _ H) in H1. clear H. apply lt_CR_of_Q in H1. ring_simplify in H1. exact (Qlt_not_le _ _ H1 (Qle_refl _)). + destruct (CRisRing R1). apply (CRle_trans _ (CRplus R1 x (CRplus R1 (CR_of_Q R1 q) (CRopp R1 (CR_of_Q R1 q))))). * apply (CRle_trans _ (CRplus R1 x 0)). -- destruct (CRplus_0_r x). exact H. -- apply CRplus_le_compat_l. destruct (Ropp_def (CR_of_Q R1 q)). exact H. * destruct (Radd_assoc x (CR_of_Q R1 q) (CRopp R1 (CR_of_Q R1 q))). exact H1. - intro abs. destruct (CR_Q_dense R2 _ _ abs) as [r [H H0]]. clear abs. destruct (CRmorph_rat f r) as [_ H1]. apply (CRle_lt_trans _ _ _ H1) in H0. clear H1. apply CRmorph_increasing_inv in H0. apply (CRlt_asym _ _ H0). clear H0. apply (CRplus_lt_reg_r (CRopp R1 (CR_of_Q R1 q))). apply (CRle_lt_trans _ x). + destruct (CRisRing R1). apply (CRle_trans _ (CRplus R1 x (CRplus R1 (CR_of_Q R1 q) (CRopp R1 (CR_of_Q R1 q))))). * destruct (Radd_assoc x (CR_of_Q R1 q) (CRopp R1 (CR_of_Q R1 q))). exact H0. * apply (CRle_trans _ (CRplus R1 x 0)). -- apply CRplus_le_compat_l. destruct (Ropp_def (CR_of_Q R1 q)). exact H1. -- destruct (CRplus_0_r x). exact H1. + apply (CRlt_le_trans _ (CR_of_Q R1 (r-q))). * apply (CRmorph_increasing_inv f). apply (CRlt_le_trans _ (CR_of_Q R2 (r - q))). 2: apply CRmorph_rat. apply (CRplus_lt_reg_r (CR_of_Q R2 q)). apply (CRlt_le_trans _ _ _ H). apply (CRle_trans _ (CR_of_Q R2 (r-q+q))). -- intro abs. apply lt_CR_of_Q in abs. ring_simplify in abs. exact (Qlt_not_le _ _ abs (Qle_refl _)). -- destruct (CR_of_Q_plus R2 (r-q) q). exact H1. * apply (CRle_trans _ (CRplus R1 (CR_of_Q R1 r) (CR_of_Q R1 (-q)))). -- destruct (CR_of_Q_plus R1 r (-q)). exact H1. -- apply CRplus_le_compat_l. destruct (@CR_of_Q_opp R1 q). exact H1. Qed. Lemma CRmorph_plus : forall {R1 R2 : ConstructiveReals} (f : @ConstructiveRealsMorphism R1 R2) (x y : CRcarrier R1), CRmorph f (CRplus R1 x y) == CRplus R2 (CRmorph f x) (CRmorph f y). Proof. intros R1 R2 f. assert (forall (x y : CRcarrier R1), CRplus R2 (CRmorph f x) (CRmorph f y) <= CRmorph f (CRplus R1 x y)). { intros x y abs. destruct (CR_Q_dense R2 _ _ abs) as [r [H H0]]. clear abs. destruct (CRmorph_rat f r) as [H1 _]. apply (CRlt_le_trans _ _ _ H) in H1. clear H. apply CRmorph_increasing_inv in H1. apply (CRlt_asym _ _ H1). clear H1. destruct (CR_Q_dense R2 _ _ H0) as [q [H2 H3]]. apply lt_CR_of_Q in H2. assert (Qlt (r-q) 0) as epsNeg. { apply (Qplus_lt_r _ _ q). ring_simplify. exact H2. } destruct (CR_Q_dense R1 _ _ (CRplus_neg_rat_lt x (r-q) epsNeg)) as [s [H4 H5]]. apply (CRlt_trans _ (CRplus R1 (CR_of_Q R1 s) y)). 2: apply CRplus_lt_compat_r, H5. apply (CRmorph_increasing_inv f). apply (CRlt_le_trans _ (CRplus R2 (CR_of_Q R2 s) (CRmorph f y))). - apply (CRmorph_increasing f) in H4. destruct (CRmorph_plus_rat f x (r-q)) as [H _]. apply (CRle_lt_trans _ _ _ H) in H4. clear H. destruct (CRmorph_rat f s) as [_ H1]. apply (CRlt_le_trans _ _ _ H4) in H1. clear H4. apply (CRlt_trans _ (CRplus R2 (CRplus R2 (CRmorph f x) (CR_of_Q R2 (r - q))) (CRmorph f y))). 2: apply CRplus_lt_compat_r, H1. apply (CRlt_le_trans _ (CRplus R2 (CRplus R2 (CR_of_Q R2 (r - q)) (CRmorph f x)) (CRmorph f y))). + apply (CRlt_le_trans _ (CRplus R2 (CR_of_Q R2 (r - q)) (CRplus R2 (CRmorph f x) (CRmorph f y)))). * apply (CRle_lt_trans _ (CRplus R2 (CR_of_Q R2 (r - q)) (CR_of_Q R2 q))). 2: apply CRplus_lt_compat_l, H3. intro abs. destruct (CR_of_Q_plus R2 (r-q) q) as [_ H4]. apply (CRle_lt_trans _ _ _ H4) in abs. clear H4. destruct (CRmorph_rat f r) as [_ H4]. apply (CRlt_le_trans _ _ _ abs) in H4. clear abs. apply lt_CR_of_Q in H4. ring_simplify in H4. exact (Qlt_not_le _ _ H4 (Qle_refl _)). * destruct (CRisRing R2); apply Radd_assoc. + apply CRplus_le_compat_r. destruct (CRisRing R2). destruct (Radd_comm (CRmorph f x) (CR_of_Q R2 (r - q))). exact H. - intro abs. destruct (CRmorph_plus_rat f y s) as [H _]. apply H. clear H. apply (CRlt_le_trans _ (CRplus R2 (CR_of_Q R2 s) (CRmorph f y))). + apply (CRle_lt_trans _ (CRmorph f (CRplus R1 (CR_of_Q R1 s) y))). * apply CRmorph_proper. destruct (CRisRing R1); apply Radd_comm. * exact abs. + destruct (CRisRing R2); apply Radd_comm. } split. - apply H. - specialize (H (CRplus R1 x y) (CRopp R1 y)). intro abs. apply H. clear H. apply (CRle_lt_trans _ (CRmorph f x)). + apply CRmorph_proper. destruct (CRisRing R1). apply (CReq_trans _ (CRplus R1 x (CRplus R1 y (CRopp R1 y)))). * apply CReq_sym, Radd_assoc. * apply (CReq_trans _ (CRplus R1 x 0)). 2: apply CRplus_0_r. destruct (CRisRingExt R1). apply Radd_ext. -- apply CReq_refl. -- apply Ropp_def. + apply (CRplus_lt_reg_r (CRmorph f y)). apply (CRlt_le_trans _ _ _ abs). clear abs. apply (CRle_trans _ (CRplus R2 (CRmorph f (CRplus R1 x y)) 0)). * destruct (CRplus_0_r (CRmorph f (CRplus R1 x y))). exact H. * apply (CRle_trans _ (CRplus R2 (CRmorph f (CRplus R1 x y)) (CRplus R2 (CRmorph f (CRopp R1 y)) (CRmorph f y)))). -- apply CRplus_le_compat_l. apply (CRle_trans _ (CRplus R2 (CRopp R2 (CRmorph f y)) (CRmorph f y))). ++ destruct (CRplus_opp_l (CRmorph f y)). exact H. ++ apply CRplus_le_compat_r. destruct (CRmorph_opp f y). exact H. -- destruct (CRisRing R2). destruct (Radd_assoc (CRmorph f (CRplus R1 x y)) (CRmorph f (CRopp R1 y)) (CRmorph f y)). exact H0. Qed. Lemma CRmorph_mult_pos : forall {R1 R2 : ConstructiveReals} (f : @ConstructiveRealsMorphism R1 R2) (x : CRcarrier R1) (n : nat), CRmorph f (CRmult R1 x (CR_of_Q R1 (Z.of_nat n # 1))) == CRmult R2 (CRmorph f x) (CR_of_Q R2 (Z.of_nat n # 1)). Proof. induction n. - simpl. destruct (CRisRingExt R1). apply (CReq_trans _ 0). + apply (CReq_trans _ (CRmorph f 0)). 2: apply CRmorph_zero. apply CRmorph_proper. apply (CReq_trans _ (CRmult R1 x 0)). 2: apply CRmult_0_r. apply Rmul_ext. * apply CReq_refl. * reflexivity. + apply (CReq_trans _ (CRmult R2 (CRmorph f x) 0)). * apply CReq_sym, CRmult_0_r. * destruct (CRisRingExt R2). apply Rmul_ext0. -- apply CReq_refl. -- reflexivity. - destruct (CRisRingExt R1), (CRisRingExt R2). transitivity (CRmorph f (CRplus R1 x (CRmult R1 x (CR_of_Q R1 (Z.of_nat n # 1))))). + apply CRmorph_proper. transitivity (CRmult R1 x (CRplus R1 1 (CR_of_Q R1 (Z.of_nat n # 1)))). * apply Rmul_ext. -- reflexivity. -- transitivity (CR_of_Q R1 (1 + (Z.of_nat n # 1))). ++ apply CR_of_Q_morph. rewrite Nat2Z.inj_succ. unfold Z.succ. rewrite Z.add_comm. rewrite Qinv_plus_distr. reflexivity. ++ rewrite CR_of_Q_plus. reflexivity. * transitivity (CRplus R1 (CRmult R1 x 1) (CRmult R1 x (CR_of_Q R1 (Z.of_nat n # 1)))). -- apply CRmult_plus_distr_l. -- apply Radd_ext. ++ apply CRmult_1_r. ++ reflexivity. + apply (CReq_trans _ (CRplus R2 (CRmorph f x) (CRmorph f (CRmult R1 x (CR_of_Q R1 (Z.of_nat n # 1)))))). * apply CRmorph_plus. * apply (CReq_trans _ (CRplus R2 (CRmorph f x) (CRmult R2 (CRmorph f x) (CR_of_Q R2 (Z.of_nat n # 1))))). -- apply Radd_ext0. ++ apply CReq_refl. ++ exact IHn. -- apply (CReq_trans _ (CRmult R2 (CRmorph f x) (CRplus R2 1 (CR_of_Q R2 (Z.of_nat n # 1))))). 1:apply (CReq_trans _ (CRplus R2 (CRmult R2 (CRmorph f x) 1) (CRmult R2 (CRmorph f x) (CR_of_Q R2 (Z.of_nat n # 1))))). ++ apply Radd_ext0. 2: apply CReq_refl. apply CReq_sym, CRmult_1_r. ++ apply CReq_sym, CRmult_plus_distr_l. ++ apply Rmul_ext0. ** apply CReq_refl. ** apply (CReq_trans _ (CR_of_Q R2 (1 + (Z.of_nat n # 1)))). 1:apply (CReq_trans _ (CRplus R2 (CR_of_Q R2 1) (CR_of_Q R2 (Z.of_nat n # 1)))). { apply Radd_ext0; reflexivity. } { apply CReq_sym, CR_of_Q_plus. } apply CR_of_Q_morph. rewrite Nat2Z.inj_succ. unfold Z.succ. rewrite Z.add_comm. rewrite Qinv_plus_distr. reflexivity. Qed. Lemma NatOfZ : forall n : Z, { p : nat | n = Z.of_nat p \/ n = Z.opp (Z.of_nat p) }. Proof. intros [|p|n]. - exists O. left. reflexivity. - exists (Pos.to_nat p). left. rewrite positive_nat_Z. reflexivity. - exists (Pos.to_nat n). right. rewrite positive_nat_Z. reflexivity. Qed. Lemma CRmorph_mult_int : forall {R1 R2 : ConstructiveReals} (f : @ConstructiveRealsMorphism R1 R2) (x : CRcarrier R1) (n : Z), CRmorph f (CRmult R1 x (CR_of_Q R1 (n # 1))) == CRmult R2 (CRmorph f x) (CR_of_Q R2 (n # 1)). Proof. intros. destruct (NatOfZ n) as [p [pos|neg]]. - subst n. apply CRmorph_mult_pos. - subst n. apply (CReq_trans _ (CRopp R2 (CRmorph f (CRmult R1 x (CR_of_Q R1 (Z.of_nat p # 1)))))). + apply (CReq_trans _ (CRmorph f (CRopp R1 (CRmult R1 x (CR_of_Q R1 (Z.of_nat p # 1)))))). 2: apply CRmorph_opp. apply CRmorph_proper. apply (CReq_trans _ (CRmult R1 x (CR_of_Q R1 (- (Z.of_nat p # 1))))). * destruct (CRisRingExt R1). apply Rmul_ext. -- apply CReq_refl. -- apply CR_of_Q_morph. reflexivity. * apply (CReq_trans _ (CRmult R1 x (CRopp R1 (CR_of_Q R1 (Z.of_nat p # 1))))). -- destruct (CRisRingExt R1). apply Rmul_ext. ++ apply CReq_refl. ++ apply CR_of_Q_opp. -- apply CReq_sym, CRopp_mult_distr_r. + apply (CReq_trans _ (CRopp R2 (CRmult R2 (CRmorph f x) (CR_of_Q R2 (Z.of_nat p # 1))))). * destruct (CRisRingExt R2). apply Ropp_ext. apply CRmorph_mult_pos. * apply (CReq_trans _ (CRmult R2 (CRmorph f x) (CRopp R2 (CR_of_Q R2 (Z.of_nat p # 1))))). -- apply CRopp_mult_distr_r. -- destruct (CRisRingExt R2). apply Rmul_ext. ++ apply CReq_refl. ++ apply (CReq_trans _ (CR_of_Q R2 (- (Z.of_nat p # 1)))). ** apply CReq_sym, CR_of_Q_opp. ** apply CR_of_Q_morph. reflexivity. Qed. Lemma CRmorph_mult_inv : forall {R1 R2 : ConstructiveReals} (f : @ConstructiveRealsMorphism R1 R2) (x : CRcarrier R1) (p : positive), CRmorph f (CRmult R1 x (CR_of_Q R1 (1 # p))) == CRmult R2 (CRmorph f x) (CR_of_Q R2 (1 # p)). Proof. intros. apply (CRmult_eq_reg_r (CR_of_Q R2 (Z.pos p # 1))). - left. apply (CRle_lt_trans _ (CR_of_Q R2 0)). 1:apply CRle_refl. apply CR_of_Q_lt. reflexivity. - apply (CReq_trans _ (CRmorph f x)). 1:apply (CReq_trans _ (CRmorph f (CRmult R1 (CRmult R1 x (CR_of_Q R1 (1 # p))) (CR_of_Q R1 (Z.pos p # 1))))). { apply CReq_sym, CRmorph_mult_int. } + apply CRmorph_proper. apply (CReq_trans _ (CRmult R1 x (CRmult R1 (CR_of_Q R1 (1 # p)) (CR_of_Q R1 (Z.pos p # 1))))). * destruct (CRisRing R1). apply CReq_sym, Rmul_assoc. * apply (CReq_trans _ (CRmult R1 x 1)). { apply (Rmul_ext (CRisRingExt R1)). 1:apply CReq_refl. apply (CReq_trans _ (CR_of_Q R1 ((1#p) * (Z.pos p # 1)))). { apply CReq_sym, CR_of_Q_mult. } apply (CReq_trans _ (CR_of_Q R1 1)). 2:reflexivity. apply CR_of_Q_morph. reflexivity. } apply CRmult_1_r. + apply (CReq_trans _ (CRmult R2 (CRmorph f x) (CRmult R2 (CR_of_Q R2 (1 # p)) (CR_of_Q R2 (Z.pos p # 1))))). 2: apply (Rmul_assoc (CRisRing R2)). apply (CReq_trans _ (CRmult R2 (CRmorph f x) 1)). { apply CReq_sym, CRmult_1_r. } apply (Rmul_ext (CRisRingExt R2)). * apply CReq_refl. * apply (CReq_trans _ (CR_of_Q R2 1)). -- reflexivity. -- apply (CReq_trans _ (CR_of_Q R2 ((1#p)*(Z.pos p # 1)))). ++ apply CR_of_Q_morph. reflexivity. ++ apply CR_of_Q_mult. Qed. Lemma CRmorph_mult_rat : forall {R1 R2 : ConstructiveReals} (f : @ConstructiveRealsMorphism R1 R2) (x : CRcarrier R1) (q : Q), CRmorph f (CRmult R1 x (CR_of_Q R1 q)) == CRmult R2 (CRmorph f x) (CR_of_Q R2 q). Proof. intros. destruct q as [a b]. apply (CReq_trans _ (CRmult R2 (CRmorph f (CRmult R1 x (CR_of_Q R1 (a # 1)))) (CR_of_Q R2 (1 # b)))). - apply (CReq_trans _ (CRmorph f (CRmult R1 (CRmult R1 x (CR_of_Q R1 (a # 1))) (CR_of_Q R1 (1 # b))))). 2: apply CRmorph_mult_inv. apply CRmorph_proper. apply (CReq_trans _ (CRmult R1 x (CRmult R1 (CR_of_Q R1 (a # 1)) (CR_of_Q R1 (1 # b))))). { apply (Rmul_ext (CRisRingExt R1)). { apply CReq_refl. } apply (CReq_trans _ (CR_of_Q R1 ((a#1)*(1#b)))). - apply CR_of_Q_morph. unfold Qeq; simpl. rewrite Z.mul_1_r. reflexivity. - apply CR_of_Q_mult. } apply (Rmul_assoc (CRisRing R1)). - apply (CReq_trans _ (CRmult R2 (CRmult R2 (CRmorph f x) (CR_of_Q R2 (a # 1))) (CR_of_Q R2 (1 # b)))). { apply (Rmul_ext (CRisRingExt R2)). { apply CRmorph_mult_int. } apply CReq_refl. } apply (CReq_trans _ (CRmult R2 (CRmorph f x) (CRmult R2 (CR_of_Q R2 (a # 1)) (CR_of_Q R2 (1 # b))))). { apply CReq_sym, (Rmul_assoc (CRisRing R2)). } apply (Rmul_ext (CRisRingExt R2)). { apply CReq_refl. } apply (CReq_trans _ (CR_of_Q R2 ((a#1)*(1#b)))). { apply CReq_sym, CR_of_Q_mult. } apply CR_of_Q_morph. unfold Qeq; simpl. rewrite Z.mul_1_r. reflexivity. Qed. Lemma CRmorph_mult_pos_pos_le : forall {R1 R2 : ConstructiveReals} (f : @ConstructiveRealsMorphism R1 R2) (x y : CRcarrier R1), CRlt R1 0 y -> CRmult R2 (CRmorph f x) (CRmorph f y) <= CRmorph f (CRmult R1 x y). Proof. intros. intro abs. destruct (CR_Q_dense R2 _ _ abs) as [q [H1 H2]]. destruct (CRmorph_rat f q) as [H3 _]. apply (CRlt_le_trans _ _ _ H1) in H3. clear H1. apply CRmorph_increasing_inv in H3. apply (CRlt_asym _ _ H3). clear H3. destruct (CR_Q_dense R2 _ _ H2) as [r [H1 H3]]. apply lt_CR_of_Q in H1. destruct (CR_archimedean R1 y) as [A Amaj]. assert (/ ((r - q) * (1 # A)) * (q - r) == - (Z.pos A # 1))%Q as diveq. { rewrite Qinv_mult_distr. setoid_replace (q-r)%Q with (-1*(r-q))%Q. 2:field. field_simplify. - reflexivity. - split. + intro H4. inversion H4. + intro H4. apply Qlt_minus_iff in H1. rewrite H4 in H1. inversion H1. } destruct (CR_Q_dense R1 (CRplus R1 x (CR_of_Q R1 ((q-r) * (1#A)))) x) as [s [H4 H5]]. - apply (CRlt_le_trans _ (CRplus R1 x 0)). 2: apply CRplus_0_r. apply CRplus_lt_compat_l. apply (CRplus_lt_reg_l R1 (CR_of_Q R1 ((r-q) * (1#A)))). apply (CRle_lt_trans _ 0). 1:apply (CRle_trans _ (CR_of_Q R1 ((r-q)*(1#A) + (q-r)*(1#A)))). + destruct (CR_of_Q_plus R1 ((r-q)*(1#A)) ((q-r)*(1#A))). exact H0. + apply (CRle_trans _ (CR_of_Q R1 0)). 2: apply CRle_refl. intro H4. apply lt_CR_of_Q in H4. ring_simplify in H4. inversion H4. + apply (CRlt_le_trans _ (CR_of_Q R1 ((r - q) * (1 # A)))). 2: apply CRplus_0_r. apply (CRle_lt_trans _ (CR_of_Q R1 0)). 1:apply CRle_refl. apply CR_of_Q_lt. rewrite <- (Qmult_0_r (r-q)). apply Qmult_lt_l. * apply Qlt_minus_iff in H1. exact H1. * reflexivity. - apply (CRmorph_increasing f) in H4. destruct (CRmorph_plus f x (CR_of_Q R1 ((q-r) * (1#A)))) as [H6 _]. apply (CRle_lt_trans _ _ _ H6) in H4. clear H6. destruct (CRmorph_rat f s) as [_ H6]. apply (CRlt_le_trans _ _ _ H4) in H6. clear H4. apply (CRmult_lt_compat_r (CRmorph f y)) in H6. + destruct (Rdistr_l (CRisRing R2) (CRmorph f x) (CRmorph f (CR_of_Q R1 ((q-r) * (1#A)))) (CRmorph f y)) as [H4 _]. apply (CRle_lt_trans _ _ _ H4) in H6. clear H4. apply (CRle_lt_trans _ (CRmult R1 (CR_of_Q R1 s) y)). 2:{ apply CRmult_lt_compat_r. - exact H. - exact H5. } apply (CRmorph_le_inv f). apply (CRle_trans _ (CR_of_Q R2 q)). { destruct (CRmorph_rat f q). exact H4. } apply (CRle_trans _ (CRmult R2 (CR_of_Q R2 s) (CRmorph f y))). 1:apply (CRle_trans _ (CRplus R2 (CRmult R2 (CRmorph f x) (CRmorph f y)) (CR_of_Q R2 (q-r)))). 1:apply (CRle_trans _ (CRplus R2 (CR_of_Q R2 r) (CR_of_Q R2 (q - r)))). * apply (CRle_trans _ (CR_of_Q R2 (r + (q-r)))). -- intro H4. apply lt_CR_of_Q in H4. ring_simplify in H4. exact (Qlt_not_le q q H4 (Qle_refl q)). -- destruct (CR_of_Q_plus R2 r (q-r)). exact H4. * apply CRplus_le_compat_r. intro H4. apply (CRlt_asym _ _ H3). exact H4. * intro H4. apply (CRlt_asym _ _ H4). clear H4. apply (CRlt_trans_flip _ _ _ H6). clear H6. apply CRplus_lt_compat_l. apply (CRlt_le_trans _ (CRmult R2 (CR_of_Q R2 ((q - r) * (1 # A))) (CRmorph f y))). { apply (CRmult_lt_reg_l (CR_of_Q R2 (/((r-q)*(1#A))))). 1:apply (CRle_lt_trans _ (CR_of_Q R2 0)). - apply CRle_refl. - apply CR_of_Q_lt, Qinv_lt_0_compat. rewrite <- (Qmult_0_r (r-q)). apply Qmult_lt_l. + apply Qlt_minus_iff in H1. exact H1. + reflexivity. - apply (CRle_lt_trans _ (CRopp R2 (CR_of_Q R2 (Z.pos A # 1)))). 1:apply (CRle_trans _ (CR_of_Q R2 (-(Z.pos A # 1)))). 1:apply (CRle_trans _ (CR_of_Q R2 ((/ ((r - q) * (1 # A))) * (q - r)))). + destruct (CR_of_Q_mult R2 (/ ((r - q) * (1 # A))) (q - r)). exact H0. + destruct (CR_of_Q_morph R2 (/ ((r - q) * (1 # A)) * (q - r)) (-(Z.pos A # 1))). * exact diveq. * intro H7. apply lt_CR_of_Q in H7. rewrite diveq in H7. exact (Qlt_not_le _ _ H7 (Qle_refl _)). + destruct (@CR_of_Q_opp R2 (Z.pos A # 1)). exact H4. + apply (CRlt_le_trans _ (CRopp R2 (CRmorph f y))). { apply CRopp_gt_lt_contravar. apply (CRlt_le_trans _ (CRmorph f (CR_of_Q R1 (Z.pos A # 1)))). { apply CRmorph_increasing. exact Amaj. } destruct (CRmorph_rat f (Z.pos A # 1)). exact H4. } apply (CRle_trans _ (CRmult R2 (CRopp R2 1) (CRmorph f y))). 1:apply (CRle_trans _ (CRopp R2 (CRmult R2 1 (CRmorph f y)))). * destruct (Ropp_ext (CRisRingExt R2) (CRmorph f y) (CRmult R2 1 (CRmorph f y))). -- apply CReq_sym, (Rmul_1_l (CRisRing R2)). -- exact H4. * destruct (CRopp_mult_distr_l 1 (CRmorph f y)). exact H4. * apply (CRle_trans _ (CRmult R2 (CRmult R2 (CR_of_Q R2 (/ ((r - q) * (1 # A)))) (CR_of_Q R2 ((q - r) * (1 # A)))) (CRmorph f y))). { apply CRmult_le_compat_r_half. - apply (CRle_lt_trans _ (CRmorph f 0)). + apply CRmorph_zero. + apply CRmorph_increasing. exact H. - apply (CRle_trans _ (CR_of_Q R2 ((/ ((r - q) * (1 # A))) * ((q - r) * (1 # A))))). 1:apply (CRle_trans _ (CR_of_Q R2 (-1))). 1:apply (CRle_trans _ (CRopp R2 (CR_of_Q R2 1))). + destruct (Ropp_ext (CRisRingExt R2) 1 (CR_of_Q R2 1)). * reflexivity. * exact H4. + destruct (@CR_of_Q_opp R2 1). exact H0. + destruct (CR_of_Q_morph R2 (-1) (/ ((r - q) * (1 # A)) * ((q - r) * (1 # A)))). * field. split. -- intro H4. inversion H4. -- intro H4. apply Qlt_minus_iff in H1. rewrite H4 in H1. inversion H1. * exact H4. + destruct (CR_of_Q_mult R2 (/ ((r - q) * (1 # A))) ((q - r) * (1 # A))). exact H4. } destruct (Rmul_assoc (CRisRing R2) (CR_of_Q R2 (/ ((r - q) * (1 # A)))) (CR_of_Q R2 ((q - r) * (1 # A))) (CRmorph f y)). exact H0. } apply CRmult_le_compat_r_half. -- apply (CRle_lt_trans _ (CRmorph f 0)). ++ apply CRmorph_zero. ++ apply CRmorph_increasing. exact H. -- destruct (CRmorph_rat f ((q - r) * (1 # A))). exact H0. * apply (CRle_trans _ (CRmorph f (CRmult R1 y (CR_of_Q R1 s)))). 1:apply (CRle_trans _ (CRmult R2 (CRmorph f y) (CR_of_Q R2 s))). -- destruct (Rmul_comm (CRisRing R2) (CRmorph f y) (CR_of_Q R2 s)). exact H0. -- destruct (CRmorph_mult_rat f y s). exact H0. -- destruct (CRmorph_proper f (CRmult R1 y (CR_of_Q R1 s)) (CRmult R1 (CR_of_Q R1 s) y)). ++ apply (Rmul_comm (CRisRing R1)). ++ exact H4. + apply (CRle_lt_trans _ (CRmorph f 0)). * apply CRmorph_zero. * apply CRmorph_increasing. exact H. Qed. Lemma CRmorph_mult_pos_pos : forall {R1 R2 : ConstructiveReals} (f : @ConstructiveRealsMorphism R1 R2) (x y : CRcarrier R1), CRlt R1 0 y -> CRmorph f (CRmult R1 x y) == CRmult R2 (CRmorph f x) (CRmorph f y). Proof. split. { apply CRmorph_mult_pos_pos_le. exact H. } intro abs. destruct (CR_Q_dense R2 _ _ abs) as [q [H1 H2]]. destruct (CRmorph_rat f q) as [_ H3]. apply (CRle_lt_trans _ _ _ H3) in H2. clear H3. apply CRmorph_increasing_inv in H2. apply (CRlt_asym _ _ H2). clear H2. destruct (CR_Q_dense R2 _ _ H1) as [r [H2 H3]]. apply lt_CR_of_Q in H3. destruct (CR_archimedean R1 y) as [A Amaj]. destruct (CR_Q_dense R1 x (CRplus R1 x (CR_of_Q R1 ((q-r) * (1#A))))) as [s [H4 H5]]. - apply (CRle_lt_trans _ (CRplus R1 x 0)). + apply CRplus_0_r. + apply CRplus_lt_compat_l. apply (CRle_lt_trans _ (CR_of_Q R1 0)). * apply CRle_refl. * apply CR_of_Q_lt. rewrite <- (Qmult_0_r (q-r)). apply Qmult_lt_l. -- apply Qlt_minus_iff in H3. exact H3. -- reflexivity. - apply (CRmorph_increasing f) in H5. destruct (CRmorph_plus f x (CR_of_Q R1 ((q-r) * (1#A)))) as [_ H6]. apply (CRlt_le_trans _ _ _ H5) in H6. clear H5. destruct (CRmorph_rat f s) as [H5 _ ]. apply (CRle_lt_trans _ _ _ H5) in H6. clear H5. apply (CRmult_lt_compat_r (CRmorph f y)) in H6. 2:{ apply (CRle_lt_trans _ (CRmorph f 0)). - apply CRmorph_zero. - apply CRmorph_increasing. exact H. } apply (CRlt_le_trans _ (CRmult R1 (CR_of_Q R1 s) y)). { apply CRmult_lt_compat_r. - exact H. - exact H4. } clear H4. apply (CRmorph_le_inv f). apply (CRle_trans _ (CR_of_Q R2 q)). 2: destruct (CRmorph_rat f q); exact H0. apply (CRle_trans _ (CRmult R2 (CR_of_Q R2 s) (CRmorph f y))). 1:apply (CRle_trans _ (CRmorph f (CRmult R1 y (CR_of_Q R1 s)))). + destruct (CRmorph_proper f (CRmult R1 (CR_of_Q R1 s) y) (CRmult R1 y (CR_of_Q R1 s))). * apply (Rmul_comm (CRisRing R1)). * exact H4. + apply (CRle_trans _ (CRmult R2 (CRmorph f y) (CR_of_Q R2 s))). * exact (proj2 (CRmorph_mult_rat f y s)). * destruct (Rmul_comm (CRisRing R2) (CR_of_Q R2 s) (CRmorph f y)). exact H0. + intro H5. apply (CRlt_asym _ _ H5). clear H5. apply (CRlt_trans _ _ _ H6). clear H6. apply (CRle_lt_trans _ (CRplus R2 (CRmult R2 (CRmorph f x) (CRmorph f y)) (CRmult R2 (CRmorph f (CR_of_Q R1 ((q - r) * (1 # A)))) (CRmorph f y)))). { apply (Rdistr_l (CRisRing R2)). } apply (CRle_lt_trans _ (CRplus R2 (CR_of_Q R2 r) (CRmult R2 (CRmorph f (CR_of_Q R1 ((q - r) * (1 # A)))) (CRmorph f y)))). { apply CRplus_le_compat_r. intro H5. apply (CRlt_asym _ _ H5 H2). } clear H2. apply (CRle_lt_trans _ (CRplus R2 (CR_of_Q R2 r) (CRmult R2 (CR_of_Q R2 ((q - r) * (1 # A))) (CRmorph f y)))). { apply CRplus_le_compat_l, CRmult_le_compat_r_half. - apply (CRle_lt_trans _ (CRmorph f 0)). + apply CRmorph_zero. + apply CRmorph_increasing. exact H. - destruct (CRmorph_rat f ((q - r) * (1 # A))). exact H2. } apply (CRlt_le_trans _ (CRplus R2 (CR_of_Q R2 r) (CR_of_Q R2 ((q - r))))). * apply CRplus_lt_compat_l. apply (CRmult_lt_reg_l (CR_of_Q R2 (/((q - r) * (1 # A))))). { apply (CRle_lt_trans _ (CR_of_Q R2 0)). { apply CRle_refl. } apply CR_of_Q_lt, Qinv_lt_0_compat. rewrite <- (Qmult_0_r (q-r)). apply Qmult_lt_l. - apply Qlt_minus_iff in H3. exact H3. - reflexivity. } apply (CRle_lt_trans _ (CRmorph f y)). -- apply (CRle_trans _ (CRmult R2 (CRmult R2 (CR_of_Q R2 (/ ((q - r) * (1 # A)))) (CR_of_Q R2 ((q - r) * (1 # A)))) (CRmorph f y))). { exact (proj2 (Rmul_assoc (CRisRing R2) (CR_of_Q R2 (/ ((q - r) * (1 # A)))) (CR_of_Q R2 ((q - r) * (1 # A))) (CRmorph f y))). } apply (CRle_trans _ (CRmult R2 1 (CRmorph f y))). ++ apply CRmult_le_compat_r_half. { apply (CRle_lt_trans _ (CRmorph f 0)). { apply CRmorph_zero. } apply CRmorph_increasing. exact H. } apply (CRle_trans _ (CR_of_Q R2 ((/ ((q - r) * (1 # A))) * ((q - r) * (1 # A))))). { exact (proj1 (CR_of_Q_mult R2 (/ ((q - r) * (1 # A))) ((q - r) * (1 # A)))). } apply (CRle_trans _ (CR_of_Q R2 1)). { destruct (CR_of_Q_morph R2 (/ ((q - r) * (1 # A)) * ((q - r) * (1 # A))) 1). - field_simplify. { reflexivity. } split. { intro H5. inversion H5. } intro H5. apply Qlt_minus_iff in H3. rewrite H5 in H3. inversion H3. - exact H2. } apply CRle_refl. ++ destruct (Rmul_1_l (CRisRing R2) (CRmorph f y)). intro H5. contradiction. -- apply (CRlt_le_trans _ (CR_of_Q R2 (Z.pos A # 1))). 1:apply (CRlt_le_trans _ (CRmorph f (CR_of_Q R1 (Z.pos A # 1)))). { apply CRmorph_increasing. exact Amaj. } { exact (proj2 (CRmorph_rat f (Z.pos A # 1))). } apply (CRle_trans _ (CR_of_Q R2 ((/ ((q - r) * (1 # A))) * (q - r)))). 2: exact (proj2 (CR_of_Q_mult R2 (/ ((q - r) * (1 # A))) (q - r))). destruct (CR_of_Q_morph R2 (Z.pos A # 1) (/ ((q - r) * (1 # A)) * (q - r))). { field_simplify. { reflexivity. } split. - intro H5. inversion H5. - intro H5. apply Qlt_minus_iff in H3. rewrite H5 in H3. inversion H3. } exact H2. * apply (CRle_trans _ (CR_of_Q R2 (r + (q-r)))). -- exact (proj1 (CR_of_Q_plus R2 r (q-r))). -- destruct (CR_of_Q_morph R2 (r + (q-r)) q). ++ ring. ++ exact H2. Qed. Lemma CRmorph_mult : forall {R1 R2 : ConstructiveReals} (f : @ConstructiveRealsMorphism R1 R2) (x y : CRcarrier R1), CRmorph f (CRmult R1 x y) == CRmult R2 (CRmorph f x) (CRmorph f y). Proof. intros. destruct (CR_archimedean R1 (CRopp R1 y)) as [p pmaj]. apply (CRplus_eq_reg_r (CRmult R2 (CRmorph f x) (CR_of_Q R2 (Z.pos p # 1)))). apply (CReq_trans _ (CRmorph f (CRmult R1 x (CRplus R1 y (CR_of_Q R1 (Z.pos p # 1)))))). - apply (CReq_trans _ (CRplus R2 (CRmorph f (CRmult R1 x y)) (CRmorph f (CRmult R1 x (CR_of_Q R1 (Z.pos p # 1)))))). + apply (Radd_ext (CRisRingExt R2)). * apply CReq_refl. * apply CReq_sym, CRmorph_mult_int. + apply (CReq_trans _ (CRmorph f (CRplus R1 (CRmult R1 x y) (CRmult R1 x (CR_of_Q R1 (Z.pos p # 1)))))). * apply CReq_sym, CRmorph_plus. * apply CRmorph_proper. apply CReq_sym, CRmult_plus_distr_l. - apply (CReq_trans _ (CRmult R2 (CRmorph f x) (CRmorph f (CRplus R1 y (CR_of_Q R1 (Z.pos p # 1)))))). + apply CRmorph_mult_pos_pos. apply (CRplus_lt_compat_l R1 y) in pmaj. apply (CRle_lt_trans _ (CRplus R1 y (CRopp R1 y))). 2: exact pmaj. apply (CRisRing R1). + apply (CReq_trans _ (CRmult R2 (CRmorph f x) (CRplus R2 (CRmorph f y) (CR_of_Q R2 (Z.pos p # 1))))). * apply (Rmul_ext (CRisRingExt R2)). -- apply CReq_refl. -- apply (CReq_trans _ (CRplus R2 (CRmorph f y) (CRmorph f (CR_of_Q R1 (Z.pos p # 1))))). ++ apply CRmorph_plus. ++ apply (Radd_ext (CRisRingExt R2)). ** apply CReq_refl. ** apply CRmorph_rat. * apply CRmult_plus_distr_l. Qed. Lemma CRmorph_appart : forall {R1 R2 : ConstructiveReals} (f : @ConstructiveRealsMorphism R1 R2) (x y : CRcarrier R1) (app : x ≶ y), CRmorph f x ≶ CRmorph f y. Proof. intros. destruct app. - left. apply CRmorph_increasing. exact c. - right. apply CRmorph_increasing. exact c. Defined. Lemma CRmorph_appart_zero : forall {R1 R2 : ConstructiveReals} (f : @ConstructiveRealsMorphism R1 R2) (x : CRcarrier R1) (app : x ≶ 0), CRmorph f x ≶ 0. Proof. intros. destruct app. - left. apply (CRlt_le_trans _ (CRmorph f 0)). + apply CRmorph_increasing. exact c. + exact (proj2 (CRmorph_zero f)). - right. apply (CRle_lt_trans _ (CRmorph f 0)). + exact (proj1 (CRmorph_zero f)). + apply CRmorph_increasing. exact c. Defined. Lemma CRmorph_inv : forall {R1 R2 : ConstructiveReals} (f : @ConstructiveRealsMorphism R1 R2) (x : CRcarrier R1) (xnz : x ≶ 0) (fxnz : CRmorph f x ≶ 0), CRmorph f ((/ x) xnz) == (/ CRmorph f x) fxnz. Proof. intros. apply (CRmult_eq_reg_r (CRmorph f x)). - destruct fxnz. + right. exact c. + left. exact c. - apply (CReq_trans _ 1). 2: apply CReq_sym, CRinv_l. apply (CReq_trans _ (CRmorph f (CRmult R1 ((/ x) xnz) x))). + apply CReq_sym, CRmorph_mult. + apply (CReq_trans _ (CRmorph f 1)). * apply CRmorph_proper. apply CRinv_l. * apply CRmorph_one. Qed. Lemma CRmorph_rat_cv : forall {R1 R2 : ConstructiveReals} (qn : nat -> Q), CR_cauchy R1 (fun n => CR_of_Q R1 (qn n)) -> CR_cauchy R2 (fun n => CR_of_Q R2 (qn n)). Proof. intros. intro p. destruct (H p) as [n nmaj]. exists n. intros. specialize (nmaj i j H0 H1). unfold CRminus. rewrite <- CR_of_Q_opp, <- CR_of_Q_plus, CR_of_Q_abs. unfold CRminus in nmaj. rewrite <- CR_of_Q_opp, <- CR_of_Q_plus, CR_of_Q_abs in nmaj. apply CR_of_Q_le. destruct (Q_dec (Qabs (qn i + - qn j)) (1#p)). - destruct s. + apply Qlt_le_weak, q. + exfalso. apply (Qlt_not_le _ _ q). apply (CR_of_Q_lt R1) in q. contradiction. - rewrite q. apply Qle_refl. Qed. Definition CR_Q_limit {R : ConstructiveReals} (x : CRcarrier R) (n:nat) : { q:Q & x < CR_of_Q R q < x + CR_of_Q R (1 # Pos.of_nat n) }. Proof. apply (CR_Q_dense R x (x + CR_of_Q R (1 # Pos.of_nat n))). rewrite <- (CRplus_0_r x). rewrite CRplus_assoc. apply CRplus_lt_compat_l. rewrite CRplus_0_l. apply CR_of_Q_pos. reflexivity. Qed. Lemma CR_Q_limit_cv : forall {R : ConstructiveReals} (x : CRcarrier R), CR_cv R (fun n => CR_of_Q R (let (q,_) := CR_Q_limit x n in q)) x. Proof. intros R x p. exists (Pos.to_nat p). intros. destruct (CR_Q_limit x i). rewrite CRabs_right. - apply (CRplus_le_reg_r x). unfold CRminus. rewrite CRplus_assoc, CRplus_opp_l, CRplus_0_r, CRplus_comm. apply (CRle_trans _ (x + CR_of_Q R (1 # Pos.of_nat i))). + apply CRlt_asym, p0. + apply CRplus_le_compat_l, CR_of_Q_le. unfold Qle, Qnum, Qden. rewrite Z.mul_1_l, Z.mul_1_l. apply Pos2Z.pos_le_pos, Pos2Nat.inj_le. rewrite Nat2Pos.id. * exact H. * destruct i. -- exfalso. inversion H. pose proof (Pos2Nat.is_pos p). rewrite H1 in H0. inversion H0. -- discriminate. - rewrite <- (CRplus_opp_r x). apply CRplus_le_compat_r, CRlt_asym, p0. Qed. (* We call this morphism slow to remind that it should only be used for proofs, not for computations. *) Definition SlowMorph {R1 R2 : ConstructiveReals} : CRcarrier R1 -> CRcarrier R2 := fun x => let (y,_) := CR_complete R2 _ (CRmorph_rat_cv _ (Rcv_cauchy_mod _ x (CR_Q_limit_cv x))) in y. Lemma CauchyMorph_rat : forall {R1 R2 : ConstructiveReals} (q : Q), SlowMorph (CR_of_Q R1 q) == CR_of_Q R2 q. Proof. intros. unfold SlowMorph. destruct (CR_complete R2 _ (CRmorph_rat_cv _ (Rcv_cauchy_mod (fun n : nat => CR_of_Q R1 (let (q0, _) := CR_Q_limit (CR_of_Q R1 q) n in q0)) (CR_of_Q R1 q) (CR_Q_limit_cv (CR_of_Q R1 q))))). apply (CR_cv_unique _ _ _ c). intro p. exists (Pos.to_nat p). intros. destruct (CR_Q_limit (CR_of_Q R1 q) i). rewrite CRabs_right. - apply (CRplus_le_reg_r (CR_of_Q R2 q)). unfold CRminus. rewrite CRplus_assoc, CRplus_opp_l, CRplus_0_r, CRplus_comm. rewrite <- CR_of_Q_plus. apply CR_of_Q_le. destruct (Q_dec x0 (q + (1 # p))%Q). + destruct s. * apply Qlt_le_weak, q0. * exfalso. pose proof (CR_of_Q_lt R1 _ _ q0). apply (CRlt_asym _ _ H0). apply (CRlt_le_trans _ _ _ (snd p0)). clear H0. rewrite <- CR_of_Q_plus. apply CR_of_Q_le. apply Qplus_le_r. unfold Qle, Qnum, Qden. rewrite Z.mul_1_l, Z.mul_1_l. apply Pos2Z.pos_le_pos, Pos2Nat.inj_le. rewrite Nat2Pos.id. -- exact H. -- destruct i. ++ exfalso. inversion H. pose proof (Pos2Nat.is_pos p). rewrite H1 in H0. inversion H0. ++ discriminate. + rewrite q0. apply Qle_refl. - rewrite <- (CRplus_opp_r (CR_of_Q R2 q)). apply CRplus_le_compat_r, CR_of_Q_le. destruct (Q_dec q x0). + destruct s. * apply Qlt_le_weak, q0. * exfalso. apply (CRlt_asym _ _ (fst p0)). apply CR_of_Q_lt. exact q0. + rewrite q0. apply Qle_refl. Qed. (* The increasing property of morphisms, when the left bound is rational. *) Lemma SlowMorph_increasing_Qr : forall {R1 R2 : ConstructiveReals} (x : CRcarrier R1) (q : Q), CR_of_Q R1 q < x -> CR_of_Q R2 q < SlowMorph x. Proof. intros. unfold SlowMorph; destruct (CR_complete R2 _ (CRmorph_rat_cv _ (Rcv_cauchy_mod (fun n : nat => CR_of_Q R1 (let (q0, _) := CR_Q_limit x n in q0)) x (CR_Q_limit_cv x)))). destruct (CR_Q_dense R1 _ _ H) as [r [H0 H1]]. apply lt_CR_of_Q in H0. apply (CRlt_le_trans _ (CR_of_Q R2 r)). - apply CR_of_Q_lt, H0. - assert (forall n:nat, le O n -> CR_of_Q R2 r <= CR_of_Q R2 (let (q0, _) := CR_Q_limit x n in q0)). { intros. apply CR_of_Q_le. destruct (CR_Q_limit x n). destruct (Q_dec r x1). - destruct s. + apply Qlt_le_weak, q0. + exfalso. apply (CR_of_Q_lt R1) in q0. apply (CRlt_asym _ _ q0). exact (CRlt_trans _ _ _ H1 (fst p)). - rewrite q0. apply Qle_refl. } exact (CR_cv_bound_down _ _ _ O H2 c). Qed. (* The increasing property of morphisms, when the right bound is rational. *) Lemma SlowMorph_increasing_Ql : forall {R1 R2 : ConstructiveReals} (x : CRcarrier R1) (q : Q), x < CR_of_Q R1 q -> SlowMorph x < CR_of_Q R2 q. Proof. intros. unfold SlowMorph; destruct (CR_complete R2 _ (CRmorph_rat_cv _ (Rcv_cauchy_mod (fun n : nat => CR_of_Q R1 (let (q0, _) := CR_Q_limit x n in q0)) x (CR_Q_limit_cv x)))). assert (CR_cv R1 (fun n => CR_of_Q R1 (let (q0, _) := CR_Q_limit x n in q0) + CR_of_Q R1 (1 # Pos.of_nat n)) x). { apply (CR_cv_proper _ (x+0)). - apply CR_cv_plus. + apply CR_Q_limit_cv. + intro p. exists (Pos.to_nat p). intros. unfold CRminus. rewrite CRopp_0, CRplus_0_r. rewrite CRabs_right. * apply CR_of_Q_le. unfold Qle, Qnum, Qden. do 2 rewrite Z.mul_1_l. apply Pos2Z.pos_le_pos, Pos2Nat.inj_le. rewrite Nat2Pos.id. -- exact H0. -- destruct i. ++ inversion H0. pose proof (Pos2Nat.is_pos p). rewrite H2 in H1. inversion H1. ++ discriminate. * apply CR_of_Q_le. discriminate. - rewrite CRplus_0_r. reflexivity. } pose proof (CR_cv_open_above _ _ _ H0 H) as [n nmaj]. apply (CRle_lt_trans _ (CR_of_Q R2 (let (q0, _) := CR_Q_limit x n in q0 + (1 # Pos.of_nat n)))). - apply (CR_cv_bound_up (fun n : nat => CR_of_Q R2 (let (q0, _) := CR_Q_limit x n in q0)) _ _ n). 2: exact c. intros. destruct (CR_Q_limit x n0), (CR_Q_limit x n). apply CR_of_Q_le, Qlt_le_weak. apply (lt_CR_of_Q R1). apply (CRlt_le_trans _ _ _ (snd p)). apply (CRle_trans _ (CR_of_Q R1 x2 + CR_of_Q R1 (1 # Pos.of_nat n0))). + apply CRplus_le_compat_r. apply CRlt_asym, p0. + rewrite <- CR_of_Q_plus. apply CR_of_Q_le. apply Qplus_le_r. unfold Qle, Qnum, Qden. do 2 rewrite Z.mul_1_l. apply Pos2Z.pos_le_pos, Pos2Nat.inj_le. destruct n. * destruct n0. -- apply Nat.le_refl. -- rewrite (Nat2Pos.id (S n0)). ++ apply -> Nat.succ_le_mono; apply Nat.le_0_l. ++ discriminate. * destruct n0. -- exfalso; inversion H1. -- rewrite Nat2Pos.id, Nat2Pos.id. ++ exact H1. ++ discriminate. ++ discriminate. - specialize (nmaj n (Nat.le_refl n)). destruct (CR_Q_limit x n). apply CR_of_Q_lt. rewrite <- CR_of_Q_plus in nmaj. apply lt_CR_of_Q in nmaj. exact nmaj. Qed. Lemma SlowMorph_increasing : forall {R1 R2 : ConstructiveReals} (x y : CRcarrier R1), x < y -> @SlowMorph R1 R2 x < SlowMorph y. Proof. intros. destruct (CR_Q_dense R1 _ _ H) as [q [H0 H1]]. apply (CRlt_trans _ (CR_of_Q R2 q)). - apply SlowMorph_increasing_Ql. exact H0. - apply SlowMorph_increasing_Qr. exact H1. Qed. (* We call this morphism slow to remind that it should only be used for proofs, not for computations. *) Definition SlowConstructiveRealsMorphism {R1 R2 : ConstructiveReals} : @ConstructiveRealsMorphism R1 R2 := Build_ConstructiveRealsMorphism R1 R2 SlowMorph CauchyMorph_rat SlowMorph_increasing. Lemma CRmorph_abs : forall {R1 R2 : ConstructiveReals} (f : @ConstructiveRealsMorphism R1 R2) (x : CRcarrier R1), CRabs R2 (CRmorph f x) == CRmorph f (CRabs R1 x). Proof. assert (forall {R1 R2 : ConstructiveReals} (f : @ConstructiveRealsMorphism R1 R2) (x : CRcarrier R1), CRabs R2 (CRmorph f x) <= CRmorph f (CRabs R1 x)). { intros. rewrite <- CRabs_def. split. - apply CRmorph_le. pose proof (CRabs_def _ x (CRabs R1 x)) as [_ H]. apply H, CRle_refl. - apply (CRle_trans _ (CRmorph f (CRopp R1 x))). + apply CRmorph_opp. + apply CRmorph_le. pose proof (CRabs_def _ x (CRabs R1 x)) as [_ H]. apply H, CRle_refl. } intros. split. 2: apply H. apply (CRmorph_le_inv (@SlowConstructiveRealsMorphism R2 R1)). apply (CRle_trans _ (CRabs R1 x)). - apply (Endomorph_id (CRmorph_compose f (@SlowConstructiveRealsMorphism R2 R1))). - apply (CRle_trans _ (CRabs R1 (CRmorph (@SlowConstructiveRealsMorphism R2 R1) (CRmorph f x)))). + apply CRabs_morph. apply CReq_sym, (Endomorph_id (CRmorph_compose f (@SlowConstructiveRealsMorphism R2 R1))). + apply H. Qed. Lemma CRmorph_cv : forall {R1 R2 : ConstructiveReals} (f : @ConstructiveRealsMorphism R1 R2) (un : nat -> CRcarrier R1) (l : CRcarrier R1), CR_cv R1 un l -> CR_cv R2 (fun n => CRmorph f (un n)) (CRmorph f l). Proof. intros. intro p. specialize (H p) as [n H]. exists n. intros. specialize (H i H0). unfold CRminus. rewrite <- CRmorph_opp, <- CRmorph_plus, CRmorph_abs. rewrite <- (CRmorph_rat f (1#p)). apply CRmorph_le. exact H. Qed. Lemma CRmorph_cauchy_reverse : forall {R1 R2 : ConstructiveReals} (f : @ConstructiveRealsMorphism R1 R2) (un : nat -> CRcarrier R1), CR_cauchy R2 (fun n => CRmorph f (un n)) -> CR_cauchy R1 un. Proof. intros. intro p. specialize (H p) as [n H]. exists n. intros. specialize (H i j H0 H1). unfold CRminus in H. rewrite <- CRmorph_opp, <- CRmorph_plus, CRmorph_abs in H. rewrite <- (CRmorph_rat f (1#p)) in H. apply (CRmorph_le_inv f) in H. exact H. Qed. coq-8.20.0/theories/Reals/Abstract/ConstructiveSum.v000066400000000000000000000607041466560755400224130ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * INRIA, CNRS and contributors - Copyright 1999-2019 *) (* CRcarrier R) (N:nat) : CRcarrier R := match N with | O => f 0%nat | S i => CRsum f i + f (S i) end. Lemma CRsum_eq : forall {R : ConstructiveReals} (An Bn:nat -> CRcarrier R) (N:nat), (forall i:nat, (i <= N)%nat -> An i == Bn i) -> CRsum An N == CRsum Bn N. Proof. induction N. - intros. exact (H O (Nat.le_refl _)). - intros. simpl. apply CRplus_morph. + apply IHN. intros. apply H. apply (Nat.le_trans _ N _ H0), le_S, Nat.le_refl. + apply H, Nat.le_refl. Qed. Lemma sum_eq_R0 : forall {R : ConstructiveReals} (un : nat -> CRcarrier R) (n : nat), (forall k:nat, un k == 0) -> CRsum un n == 0. Proof. induction n. - intros. apply H. - intros. simpl. rewrite IHn. + rewrite H. apply CRplus_0_l. + exact H. Qed. Definition INR {R : ConstructiveReals} (n : nat) : CRcarrier R := CR_of_Q R (Z.of_nat n # 1). Lemma sum_const : forall {R : ConstructiveReals} (a : CRcarrier R) (n : nat), CRsum (fun _ => a) n == a * INR (S n). Proof. induction n. - unfold INR. simpl. rewrite CRmult_1_r. reflexivity. - simpl. rewrite IHn. unfold INR. replace (Z.of_nat (S (S n))) with (Z.of_nat (S n) + 1)%Z. + rewrite <- Qinv_plus_distr, CR_of_Q_plus, CRmult_plus_distr_l. apply CRplus_morph. * reflexivity. * rewrite CRmult_1_r. reflexivity. + replace 1%Z with (Z.of_nat 1). * rewrite <- Nat2Z.inj_add. apply f_equal. rewrite Nat.add_comm. reflexivity. * reflexivity. Qed. Lemma multiTriangleIneg : forall {R : ConstructiveReals} (u : nat -> CRcarrier R) (n : nat), CRabs R (CRsum u n) <= CRsum (fun k => CRabs R (u k)) n. Proof. induction n. - apply CRle_refl. - simpl. apply (CRle_trans _ (CRabs R (CRsum u n) + CRabs R (u (S n)))). + apply CRabs_triang. + apply CRplus_le_compat. * apply IHn. * apply CRle_refl. Qed. Lemma sum_assoc : forall {R : ConstructiveReals} (u : nat -> CRcarrier R) (n p : nat), CRsum u (S n + p) == CRsum u n + CRsum (fun k => u (S n + k)%nat) p. Proof. induction p. - simpl. rewrite Nat.add_0_r. reflexivity. - simpl. rewrite (Radd_assoc (CRisRing R)). apply CRplus_morph. + rewrite Nat.add_succ_r. rewrite (CRsum_eq (fun k : nat => u (S (n + k))) (fun k : nat => u (S n + k)%nat)). * rewrite <- IHp. reflexivity. * intros. reflexivity. + reflexivity. Qed. Lemma sum_Rle : forall {R : ConstructiveReals} (un vn : nat -> CRcarrier R) (n : nat), (forall k, le k n -> un k <= vn k) -> CRsum un n <= CRsum vn n. Proof. induction n. - intros. apply H. apply Nat.le_refl. - intros. simpl. apply CRplus_le_compat. + apply IHn. intros. apply H. apply (Nat.le_trans _ n _ H0). apply le_S, Nat.le_refl. + apply H. apply Nat.le_refl. Qed. Lemma Abs_sum_maj : forall {R : ConstructiveReals} (un vn : nat -> CRcarrier R), (forall n:nat, CRabs R (un n) <= (vn n)) -> forall n p:nat, (CRabs R (CRsum un n - CRsum un p) <= CRsum vn (Init.Nat.max n p) - CRsum vn (Init.Nat.min n p)). Proof. intros. destruct (le_lt_dec n p). - destruct (Nat.le_exists_sub n p) as [k [maj _]]. + assumption. + subst p. rewrite max_r. 2:assumption. rewrite min_l. 2:assumption. setoid_replace (CRsum un n - CRsum un (k + n)) with (-(CRsum un (k + n) - CRsum un n)). * rewrite CRabs_opp. destruct k. -- simpl. unfold CRminus. rewrite CRplus_opp_r. rewrite CRplus_opp_r. rewrite CRabs_right; apply CRle_refl. -- replace (S k + n)%nat with (S n + k)%nat. ++ unfold CRminus. rewrite sum_assoc. rewrite sum_assoc. rewrite CRplus_comm. rewrite <- CRplus_assoc. rewrite CRplus_opp_l. rewrite CRplus_0_l. rewrite CRplus_comm. rewrite <- CRplus_assoc. rewrite CRplus_opp_l. rewrite CRplus_0_l. apply (CRle_trans _ (CRsum (fun k0 : nat => CRabs R (un (S n + k0)%nat)) k)). ** apply multiTriangleIneg. ** apply sum_Rle. intros. apply H. ++ rewrite Nat.add_comm, Nat.add_succ_r. reflexivity. * unfold CRminus. rewrite CRopp_plus_distr, CRopp_involutive, CRplus_comm. reflexivity. - destruct (Nat.le_exists_sub p n) as [k [maj _]]. + unfold lt in l. apply (Nat.le_trans p (S p)). * apply le_S. apply Nat.le_refl. * assumption. + subst n. rewrite max_l. * rewrite min_r. -- destruct k. ++ simpl. unfold CRminus. rewrite CRplus_opp_r. rewrite CRplus_opp_r. rewrite CRabs_right. ** apply CRle_refl. ** apply CRle_refl. ++ replace (S k + p)%nat with (S p + k)%nat. ** unfold CRminus. rewrite sum_assoc. rewrite sum_assoc. rewrite CRplus_comm. rewrite <- CRplus_assoc. rewrite CRplus_opp_l. rewrite CRplus_0_l. rewrite CRplus_comm. rewrite <- CRplus_assoc. rewrite CRplus_opp_l. rewrite CRplus_0_l. apply (CRle_trans _ (CRsum (fun k0 : nat => CRabs R (un (S p + k0)%nat)) k)). { apply multiTriangleIneg. } apply sum_Rle. intros. apply H. ** rewrite Nat.add_comm, Nat.add_succ_r. reflexivity. -- apply (Nat.le_trans p (S p)). ++ apply le_S. apply Nat.le_refl. ++ assumption. * apply (Nat.le_trans p (S p)). -- apply le_S. apply Nat.le_refl. -- assumption. Qed. Lemma cond_pos_sum : forall {R : ConstructiveReals} (un : nat -> CRcarrier R) (n : nat), (forall k, 0 <= un k) -> 0 <= CRsum un n. Proof. induction n. - intros. apply H. - intros. simpl. rewrite <- CRplus_0_r. apply CRplus_le_compat. + apply IHn, H. + apply H. Qed. Lemma pos_sum_more : forall {R : ConstructiveReals} (u : nat -> CRcarrier R) (n p : nat), (forall k:nat, 0 <= u k) -> le n p -> CRsum u n <= CRsum u p. Proof. intros. destruct (Nat.le_exists_sub n p H0). destruct H1. subst p. rewrite Nat.add_comm. destruct x. - rewrite Nat.add_0_r. apply CRle_refl. - rewrite Nat.add_succ_r. replace (S (n + x)) with (S n + x)%nat. + rewrite sum_assoc. rewrite <- CRplus_0_r, CRplus_assoc. apply CRplus_le_compat_l. rewrite CRplus_0_l. apply cond_pos_sum. intros. apply H. + auto. Qed. Lemma sum_opp : forall {R : ConstructiveReals} (un : nat -> CRcarrier R) (n : nat), CRsum (fun k => - un k) n == - CRsum un n. Proof. induction n. - reflexivity. - simpl. rewrite IHn. rewrite CRopp_plus_distr. reflexivity. Qed. Lemma sum_scale : forall {R : ConstructiveReals} (u : nat -> CRcarrier R) (a : CRcarrier R) (n : nat), CRsum (fun k : nat => u k * a) n == CRsum u n * a. Proof. induction n. - simpl. rewrite (Rmul_comm (CRisRing R)). reflexivity. - simpl. rewrite IHn. rewrite CRmult_plus_distr_r. apply CRplus_morph. + reflexivity. + rewrite (Rmul_comm (CRisRing R)). reflexivity. Qed. Lemma sum_plus : forall {R : ConstructiveReals} (u v : nat -> CRcarrier R) (n : nat), CRsum (fun n0 : nat => u n0 + v n0) n == CRsum u n + CRsum v n. Proof. induction n. - reflexivity. - simpl. rewrite IHn. do 2 rewrite CRplus_assoc. apply CRplus_morph. + reflexivity. + rewrite CRplus_comm, CRplus_assoc. apply CRplus_morph. * reflexivity. * apply CRplus_comm. Qed. Lemma decomp_sum : forall {R : ConstructiveReals} (An:nat -> CRcarrier R) (N:nat), (0 < N)%nat -> CRsum An N == An 0%nat + CRsum (fun i:nat => An (S i)) (pred N). Proof. induction N. - intros. exfalso. inversion H. - intros _. destruct N. + simpl. reflexivity. + simpl. rewrite IHN. * rewrite CRplus_assoc. apply CRplus_morph. -- reflexivity. -- reflexivity. * apply le_n_S, Nat.le_0_l. Qed. Lemma reverse_sum : forall {R : ConstructiveReals} (u : nat -> CRcarrier R) (n : nat), CRsum u n == CRsum (fun k => u (n-k)%nat) n. Proof. induction n. - intros. reflexivity. - rewrite (decomp_sum (fun k : nat => u (S n - k)%nat)). + simpl. rewrite CRplus_comm. apply CRplus_morph. * reflexivity. * assumption. + unfold lt. apply -> Nat.succ_le_mono; apply Nat.le_0_l. Qed. Lemma Rplus_le_pos : forall {R : ConstructiveReals} (a b : CRcarrier R), 0 <= b -> a <= a + b. Proof. intros. rewrite <- (CRplus_0_r a). rewrite CRplus_assoc. apply CRplus_le_compat_l. rewrite CRplus_0_l. assumption. Qed. Lemma selectOneInSum : forall {R : ConstructiveReals} (u : nat -> CRcarrier R) (n i : nat), le i n -> (forall k:nat, 0 <= u k) -> u i <= CRsum u n. Proof. induction n. - intros. inversion H. subst i. apply CRle_refl. - intros. apply Nat.le_succ_r in H. destruct H. + apply (CRle_trans _ (CRsum u n)). * apply IHn. -- assumption. -- assumption. * simpl. apply Rplus_le_pos. apply H0. + subst i. simpl. rewrite CRplus_comm. apply Rplus_le_pos. apply cond_pos_sum. intros. apply H0. Qed. Lemma splitSum : forall {R : ConstructiveReals} (un : nat -> CRcarrier R) (filter : nat -> bool) (n : nat), CRsum un n == CRsum (fun i => if filter i then un i else 0) n + CRsum (fun i => if filter i then 0 else un i) n. Proof. induction n. - simpl. destruct (filter O). + symmetry; apply CRplus_0_r. + symmetry. apply CRplus_0_l. - simpl. rewrite IHn. clear IHn. destruct (filter (S n)). + do 2 rewrite CRplus_assoc. apply CRplus_morph. * reflexivity. * rewrite CRplus_comm. apply CRplus_morph. -- reflexivity. -- rewrite CRplus_0_r. reflexivity. + rewrite CRplus_0_r. rewrite CRplus_assoc. reflexivity. Qed. Definition series_cv {R : ConstructiveReals} (un : nat -> CRcarrier R) (s : CRcarrier R) : Set := CR_cv R (CRsum un) s. Definition series_cv_lim_lt {R : ConstructiveReals} (un : nat -> CRcarrier R) (x : CRcarrier R) : Set := { l : CRcarrier R & prod (series_cv un l) (l < x) }. Definition series_cv_le_lim {R : ConstructiveReals} (x : CRcarrier R) (un : nat -> CRcarrier R) : Set := { l : CRcarrier R & prod (series_cv un l) (x <= l) }. Lemma series_cv_maj : forall {R : ConstructiveReals} (un vn : nat -> CRcarrier R) (s : CRcarrier R), (forall n:nat, CRabs R (un n) <= vn n) -> series_cv vn s -> { l : CRcarrier R & prod (series_cv un l) (l <= s) }. Proof. intros. destruct (CR_complete R (CRsum un)). - intros n. specialize (H0 (2*n)%positive) as [N maj]. exists N. intros i j H0 H1. apply (CRle_trans _ (CRsum vn (max i j) - CRsum vn (min i j))). + apply Abs_sum_maj. apply H. + setoid_replace (CRsum vn (max i j) - CRsum vn (min i j)) with (CRabs R (CRsum vn (max i j) - (CRsum vn (min i j)))). * setoid_replace (CRsum vn (Init.Nat.max i j) - CRsum vn (Init.Nat.min i j)) with (CRsum vn (Init.Nat.max i j) - s - (CRsum vn (Init.Nat.min i j) - s)). -- apply (CRle_trans _ _ _ (CRabs_triang _ _)). setoid_replace (1#n)%Q with ((1#2*n) + (1#2*n))%Q. ++ rewrite CR_of_Q_plus. apply CRplus_le_compat. ** apply maj. apply (Nat.le_trans _ i). { assumption. } apply Nat.le_max_l. ** rewrite CRabs_opp. apply maj. apply Nat.min_case. { apply (Nat.le_trans _ i). - assumption. - apply Nat.le_refl. } assumption. ++ rewrite Qinv_plus_distr. reflexivity. -- unfold CRminus. rewrite CRplus_assoc. apply CRplus_morph. ++ reflexivity. ++ rewrite CRopp_plus_distr, CRopp_involutive. rewrite CRplus_comm, CRplus_assoc, CRplus_opp_r, CRplus_0_r. reflexivity. * rewrite CRabs_right. -- reflexivity. -- rewrite <- (CRplus_opp_r (CRsum vn (Init.Nat.min i j))). apply CRplus_le_compat. ++ apply pos_sum_more. ** intros. apply (CRle_trans _ (CRabs R (un k))), H. apply CRabs_pos. ** apply (Nat.le_trans _ i), Nat.le_max_l. apply Nat.le_min_l. ++ apply CRle_refl. - exists x. split. + assumption. (* x <= s *) + apply (CRplus_le_reg_r (-x)). rewrite CRplus_opp_r. apply (CR_cv_bound_down (fun n => CRsum vn n - CRsum un n) _ _ 0). * intros. rewrite <- (CRplus_opp_r (CRsum un n)). apply CRplus_le_compat. -- apply sum_Rle. intros. apply (CRle_trans _ (CRabs R (un k))). ++ apply CRle_abs. ++ apply H. -- apply CRle_refl. * apply CR_cv_plus. -- assumption. -- apply CR_cv_opp. assumption. Qed. Lemma series_cv_abs_lt : forall {R : ConstructiveReals} (un vn : nat -> CRcarrier R) (l : CRcarrier R), (forall n:nat, CRabs R (un n) <= vn n) -> series_cv_lim_lt vn l -> series_cv_lim_lt un l. Proof. intros. destruct H0 as [x [H0 H1]]. destruct (series_cv_maj un vn x H H0) as [x0 H2]. exists x0. split. - apply H2. - apply (CRle_lt_trans _ x). + apply H2. + apply H1. Qed. Definition series_cv_abs {R : ConstructiveReals} (u : nat -> CRcarrier R) : CR_cauchy R (CRsum (fun n => CRabs R (u n))) -> { l : CRcarrier R & series_cv u l }. Proof. intros. apply CR_complete in H. destruct H. destruct (series_cv_maj u (fun k => CRabs R (u k)) x). - intro n. apply CRle_refl. - assumption. - exists x0. apply p. Qed. Lemma series_cv_unique : forall {R : ConstructiveReals} (Un:nat -> CRcarrier R) (l1 l2:CRcarrier R), series_cv Un l1 -> series_cv Un l2 -> l1 == l2. Proof. intros. apply (CR_cv_unique (CRsum Un)); assumption. Qed. Lemma series_cv_abs_eq : forall {R : ConstructiveReals} (u : nat -> CRcarrier R) (a : CRcarrier R) (cau : CR_cauchy R (CRsum (fun n => CRabs R (u n)))), series_cv u a -> (a == (let (l,_):= series_cv_abs u cau in l))%ConstructiveReals. Proof. intros. destruct (series_cv_abs u cau). apply (series_cv_unique u). - exact H. - exact s. Qed. Lemma series_cv_abs_cv : forall {R : ConstructiveReals} (u : nat -> CRcarrier R) (cau : CR_cauchy R (CRsum (fun n => CRabs R (u n)))), series_cv u (let (l,_):= series_cv_abs u cau in l). Proof. intros. destruct (series_cv_abs u cau). exact s. Qed. Lemma series_cv_opp : forall {R : ConstructiveReals} (s : CRcarrier R) (u : nat -> CRcarrier R), series_cv u s -> series_cv (fun n => - u n) (- s). Proof. intros. intros p. specialize (H p) as [N H]. exists N. intros n H0. setoid_replace (CRsum (fun n0 : nat => - u n0) n - - s) with (-(CRsum (fun n0 : nat => u n0) n - s)). - rewrite CRabs_opp. apply H, H0. - unfold CRminus. rewrite sum_opp. rewrite CRopp_plus_distr. reflexivity. Qed. Lemma series_cv_scale : forall {R : ConstructiveReals} (a : CRcarrier R) (s : CRcarrier R) (u : nat -> CRcarrier R), series_cv u s -> series_cv (fun n => (u n) * a) (s * a). Proof. intros. apply (CR_cv_eq _ (fun n => CRsum u n * a)). - intro n. rewrite sum_scale. reflexivity. - apply CR_cv_scale, H. Qed. Lemma series_cv_plus : forall {R : ConstructiveReals} (u v : nat -> CRcarrier R) (s t : CRcarrier R), series_cv u s -> series_cv v t -> series_cv (fun n => u n + v n) (s + t). Proof. intros. apply (CR_cv_eq _ (fun n => CRsum u n + CRsum v n)). - intro n. symmetry. apply sum_plus. - apply CR_cv_plus. + exact H. + exact H0. Qed. Lemma series_cv_minus : forall {R : ConstructiveReals} (u v : nat -> CRcarrier R) (s t : CRcarrier R), series_cv u s -> series_cv v t -> series_cv (fun n => u n - v n) (s - t). Proof. intros. apply (CR_cv_eq _ (fun n => CRsum u n - CRsum v n)). - intro n. symmetry. unfold CRminus. rewrite sum_plus. rewrite sum_opp. reflexivity. - apply CR_cv_plus. + exact H. + apply CR_cv_opp. exact H0. Qed. Lemma series_cv_nonneg : forall {R : ConstructiveReals} (u : nat -> CRcarrier R) (s : CRcarrier R), (forall n:nat, 0 <= u n) -> series_cv u s -> 0 <= s. Proof. intros. apply (CRle_trans 0 (CRsum u 0)). - apply H. - apply (growing_ineq (CRsum u)). + intro n. simpl. rewrite <- CRplus_0_r. apply CRplus_le_compat. * rewrite CRplus_0_r. apply CRle_refl. * apply H. + apply H0. Qed. Lemma series_cv_eq : forall {R : ConstructiveReals} (u v : nat -> CRcarrier R) (s : CRcarrier R), (forall n:nat, u n == v n) -> series_cv u s -> series_cv v s. Proof. intros. intros p. specialize (H0 p). destruct H0 as [N H0]. exists N. intros. unfold CRminus. rewrite <- (CRsum_eq u). - apply H0, H1. - intros. apply H. Qed. Lemma series_cv_remainder_maj : forall {R : ConstructiveReals} (u : nat -> CRcarrier R) (s eps : CRcarrier R) (N : nat), series_cv u s -> 0 < eps -> (forall n:nat, 0 <= u n) -> CRabs R (CRsum u N - s) <= eps -> forall n:nat, CRsum (fun k=> u (N + S k)%nat) n <= eps. Proof. intros. pose proof (sum_assoc u N n). rewrite <- (CRsum_eq (fun k : nat => u (S N + k)%nat)). - apply (CRplus_le_reg_l (CRsum u N)). rewrite <- H3. apply (CRle_trans _ s). + apply growing_ineq. 2: apply H. intro k. simpl. rewrite <- CRplus_0_r, CRplus_assoc. apply CRplus_le_compat_l. rewrite CRplus_0_l. apply H1. + rewrite CRabs_minus_sym in H2. rewrite CRplus_comm. apply (CRplus_le_reg_r (-CRsum u N)). rewrite CRplus_assoc. rewrite CRplus_opp_r. rewrite CRplus_0_r. apply (CRle_trans _ (CRabs R (s - CRsum u N))). * apply CRle_abs. * assumption. - intros. rewrite Nat.add_succ_r. reflexivity. Qed. Lemma series_cv_abs_remainder : forall {R : ConstructiveReals} (u : nat -> CRcarrier R) (s sAbs : CRcarrier R) (n : nat), series_cv u s -> series_cv (fun n => CRabs R (u n)) sAbs -> CRabs R (CRsum u n - s) <= sAbs - CRsum (fun n => CRabs R (u n)) n. Proof. intros. apply (CR_cv_le (fun N => CRabs R (CRsum u n - (CRsum u (n + N)))) (fun N => CRsum (fun n : nat => CRabs R (u n)) (n + N) - CRsum (fun n : nat => CRabs R (u n)) n)). - intro N. destruct N. + rewrite Nat.add_0_r. unfold CRminus. rewrite CRplus_opp_r. rewrite CRplus_opp_r. rewrite CRabs_right. * apply CRle_refl. * apply CRle_refl. + rewrite Nat.add_succ_r. replace (S (n + N)) with (S n + N)%nat. 2: reflexivity. unfold CRminus. rewrite sum_assoc. rewrite sum_assoc. rewrite CRopp_plus_distr. rewrite <- CRplus_assoc, CRplus_opp_r, CRplus_0_l, CRabs_opp. rewrite CRplus_comm, <- CRplus_assoc, CRplus_opp_l. rewrite CRplus_0_l. apply multiTriangleIneg. - apply CR_cv_dist_cont. intros eps. specialize (H eps) as [N lim]. exists N. intros. rewrite Nat.add_comm. apply lim. apply (Nat.le_trans N i). + assumption. + rewrite <- (Nat.add_0_r i), <- Nat.add_assoc. apply Nat.add_le_mono_l, Nat.le_0_l. - apply CR_cv_plus. 2: apply CR_cv_const. intros eps. specialize (H0 eps) as [N lim]. exists N. intros. rewrite Nat.add_comm. apply lim. apply (Nat.le_trans N i). + assumption. + rewrite <- (Nat.add_0_r i), <- Nat.add_assoc. apply Nat.add_le_mono_l, Nat.le_0_l. Qed. Lemma series_cv_triangle : forall {R : ConstructiveReals} (u : nat -> CRcarrier R) (s sAbs : CRcarrier R), series_cv u s -> series_cv (fun n => CRabs R (u n)) sAbs -> CRabs R s <= sAbs. Proof. intros. apply (CR_cv_le (fun n => CRabs R (CRsum u n)) (CRsum (fun n => CRabs R (u n)))). - intros. apply multiTriangleIneg. - apply CR_cv_abs_cont. assumption. - assumption. Qed. Lemma series_cv_shift : forall {R : ConstructiveReals} (f : nat -> CRcarrier R) k l, series_cv (fun n => f (S k + n)%nat) l -> series_cv f (l + CRsum f k). Proof. intros. intro p. specialize (H p) as [n nmaj]. exists (S k+n)%nat. intros. destruct (Nat.le_exists_sub (S k) i). - apply (Nat.le_trans _ (S k + 0)). + rewrite Nat.add_0_r. apply Nat.le_refl. + apply (Nat.le_trans _ (S k + n)). * apply Nat.add_le_mono_l, Nat.le_0_l. * exact H. - destruct H0. subst i. rewrite Nat.add_comm in H. rewrite <- Nat.add_le_mono_r in H. specialize (nmaj x H). unfold CRminus. rewrite Nat.add_comm, (sum_assoc f k x). setoid_replace (CRsum f k + CRsum (fun k0 : nat => f (S k + k0)%nat) x - (l + CRsum f k)) with (CRsum (fun k0 : nat => f (S k + k0)%nat) x - l). + exact nmaj. + unfold CRminus. rewrite (CRplus_comm (CRsum f k)). rewrite CRplus_assoc. apply CRplus_morph. * reflexivity. * rewrite CRplus_comm, CRopp_plus_distr, CRplus_assoc. rewrite CRplus_opp_l, CRplus_0_r. reflexivity. Qed. Lemma series_cv_shift' : forall {R : ConstructiveReals} (un : nat -> CRcarrier R) (s : CRcarrier R) (shift : nat), series_cv un s -> series_cv (fun n => un (n+shift)%nat) (s - match shift with | O => 0 | S p => CRsum un p end). Proof. intros. destruct shift as [|p]. - unfold CRminus. rewrite CRopp_0. rewrite CRplus_0_r. apply (series_cv_eq un). + intros. rewrite Nat.add_0_r. reflexivity. + apply H. - apply (CR_cv_eq _ (fun n => CRsum un (n + S p) - CRsum un p)). + intros. rewrite Nat.add_comm. unfold CRminus. rewrite sum_assoc. simpl. rewrite CRplus_comm, <- CRplus_assoc. rewrite CRplus_opp_l, CRplus_0_l. apply CRsum_eq. intros. rewrite (Nat.add_comm i). reflexivity. + apply CR_cv_plus. * apply (CR_cv_shift' _ (S p) _ H). * intros n. exists (Pos.to_nat n). intros. unfold CRminus. simpl. rewrite CRopp_involutive, CRplus_opp_l. rewrite CRabs_right. -- apply CR_of_Q_le. discriminate. -- apply CRle_refl. Qed. Lemma CRmorph_sum : forall {R1 R2 : ConstructiveReals} (f : @ConstructiveRealsMorphism R1 R2) (un : nat -> CRcarrier R1) (n : nat), CRmorph f (CRsum un n) == CRsum (fun n0 : nat => CRmorph f (un n0)) n. Proof. induction n. - reflexivity. - simpl. rewrite CRmorph_plus, IHn. reflexivity. Qed. Lemma CRmorph_INR : forall {R1 R2 : ConstructiveReals} (f : @ConstructiveRealsMorphism R1 R2) (n : nat), CRmorph f (INR n) == INR n. Proof. induction n. - apply CRmorph_rat. - simpl. unfold INR. rewrite (CRmorph_proper f _ (1 + CR_of_Q R1 (Z.of_nat n # 1))). + rewrite CRmorph_plus. unfold INR in IHn. rewrite IHn. rewrite CRmorph_one, <- CR_of_Q_plus. apply CR_of_Q_morph. rewrite Qinv_plus_distr. unfold Qeq, Qnum, Qden. do 2 rewrite Z.mul_1_r. rewrite Nat2Z.inj_succ. rewrite <- Z.add_1_l. reflexivity. + rewrite <- CR_of_Q_plus. apply CR_of_Q_morph. rewrite Qinv_plus_distr. unfold Qeq, Qnum, Qden. do 2 rewrite Z.mul_1_r. rewrite Nat2Z.inj_succ. rewrite <- Z.add_1_l. reflexivity. Qed. Lemma CRmorph_series_cv : forall {R1 R2 : ConstructiveReals} (f : @ConstructiveRealsMorphism R1 R2) (un : nat -> CRcarrier R1) (l : CRcarrier R1), series_cv un l -> series_cv (fun n => CRmorph f (un n)) (CRmorph f l). Proof. intros. apply (CR_cv_eq _ (fun n => CRmorph f (CRsum un n))). - intro n. apply CRmorph_sum. - apply CRmorph_cv, H. Qed. coq-8.20.0/theories/Reals/Alembert.v000066400000000000000000000601301466560755400172170ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* R, (forall n:nat, 0 < An n) -> Un_cv (fun n:nat => Rabs (An (S n) / An n)) 0 -> { l:R | Un_cv (fun N:nat => sum_f_R0 An N) l }. Proof. intros An H H0. assert (X:{ l:R | is_lub (EUn (fun N:nat => sum_f_R0 An N)) l } -> { l:R | Un_cv (fun N:nat => sum_f_R0 An N) l }). { intros (x,H1). exists x; apply Un_cv_crit_lub; [ unfold Un_growing; intro; rewrite tech5; pattern (sum_f_R0 An n) at 1; rewrite <- Rplus_0_r; apply Rplus_le_compat_l; left; apply H | apply H1 ]. } apply X. apply completeness. 2:{ exists (sum_f_R0 An 0); unfold EUn; exists 0%nat; reflexivity. } unfold Un_cv in H0; unfold bound; cut (0 < / 2); [ intro | apply Rinv_0_lt_compat; prove_sup0 ]. elim (H0 (/ 2) H1); intros. exists (sum_f_R0 An x + 2 * An (S x)). unfold is_upper_bound; intros; unfold EUn in H3; destruct H3 as (x1,->). destruct (lt_eq_lt_dec x1 x) as [[| -> ]|]. - replace (sum_f_R0 An x) with (sum_f_R0 An x1 + sum_f_R0 (fun i:nat => An (S x1 + i)%nat) (x - S x1)). 2:{ symmetry; apply tech2; assumption. } pattern (sum_f_R0 An x1) at 1; rewrite <- Rplus_0_r; rewrite Rplus_assoc; apply Rplus_le_compat_l. left; apply Rplus_lt_0_compat. + apply tech1; intros; apply H. + apply Rmult_lt_0_compat; [ prove_sup0 | apply H ]. - pattern (sum_f_R0 An x) at 1; rewrite <- Rplus_0_r; apply Rplus_le_compat_l. left; apply Rmult_lt_0_compat; [ prove_sup0 | apply H ]. - replace (sum_f_R0 An x1) with (sum_f_R0 An x + sum_f_R0 (fun i:nat => An (S x + i)%nat) (x1 - S x)). 2:{ symmetry; apply tech2; assumption. } apply Rplus_le_compat_l. cut (sum_f_R0 (fun i:nat => An (S x + i)%nat) (x1 - S x) <= An (S x) * sum_f_R0 (fun i:nat => (/ 2) ^ i) (x1 - S x)). { intro; apply Rle_trans with (An (S x) * sum_f_R0 (fun i:nat => (/ 2) ^ i) (x1 - S x)). - assumption. - rewrite <- (Rmult_comm (An (S x))); apply Rmult_le_compat_l. + left; apply H. + rewrite tech3. * replace (1 - / 2) with (/ 2). -- unfold Rdiv; rewrite Rinv_inv. pattern 2 at 3; rewrite <- Rmult_1_r; rewrite <- (Rmult_comm 2); apply Rmult_le_compat_l. ++ left; prove_sup0. ++ left; apply Rplus_lt_reg_l with ((/ 2) ^ S (x1 - S x)). replace ((/ 2) ^ S (x1 - S x) + (1 - (/ 2) ^ S (x1 - S x))) with 1; [ idtac | ring ]. rewrite <- (Rplus_comm 1); pattern 1 at 1; rewrite <- Rplus_0_r; apply Rplus_lt_compat_l. apply pow_lt; apply Rinv_0_lt_compat; prove_sup0. -- field. * replace 1 with (/ 1); [ apply tech7; discrR | apply Rinv_1 ]. } replace (An (S x)) with (An (S x + 0)%nat) by (f_equal; ring). apply (tech6 (fun i:nat => An (S x + i)%nat) (/ 2)). { left; apply Rinv_0_lt_compat; prove_sup0. } intro; cut (forall n:nat, (n >= x)%nat -> An (S n) < / 2 * An n). { intro H4; replace (S x + S i)%nat with (S (S x + i)) by auto with zarith. apply H4; unfold ge; apply tech8. } intros; unfold Rdist in H2; apply Rmult_lt_reg_l with (/ An n). { apply Rinv_0_lt_compat; apply H. } do 2 rewrite (Rmult_comm (/ An n)); rewrite Rmult_assoc; rewrite Rinv_r. 2:{ intro H5; assert (H8 := H n); rewrite H5 in H8; elim (Rlt_irrefl _ H8). } rewrite Rmult_1_r; replace (An (S n) * / An n) with (Rabs (Rabs (An (S n) / An n) - 0)). { apply H2; assumption. } unfold Rminus; rewrite Ropp_0; rewrite Rplus_0_r; rewrite Rabs_Rabsolu; rewrite Rabs_right. { unfold Rdiv; reflexivity. } left; unfold Rdiv; change (0 < An (S n) * / An n); apply Rmult_lt_0_compat; [ apply H | apply Rinv_0_lt_compat; apply H ]. Qed. Lemma Alembert_C2_aux_positivity : forall Xn : nat -> R, let Yn i := (2 * Rabs (Xn i) + Xn i) / 2 in (forall n, Xn n <> 0) -> forall n, 0 < Yn n. Proof. intros Xn Yn H n; unfold Yn; unfold Rdiv; rewrite <- (Rmult_0_r (/ 2)); rewrite <- (Rmult_comm (/ 2)); apply Rmult_lt_compat_l. - apply Rinv_0_lt_compat; prove_sup0. - apply Rplus_lt_reg_l with (- Xn n); rewrite Rplus_0_r; unfold Rminus; rewrite (Rplus_comm (- Xn n)); rewrite Rplus_assoc; rewrite Rplus_opp_r; rewrite Rplus_0_r; apply Rle_lt_trans with (Rabs (Xn n)). + rewrite <- Rabs_Ropp; apply RRle_abs. + rewrite <-Rplus_diag; pattern (Rabs (Xn n)) at 1; rewrite <- Rplus_0_r; apply Rplus_lt_compat_l; apply Rabs_pos_lt; apply H. Qed. Lemma Alembert_C2_aux_Un_cv : forall Xn : nat -> R, let Yn i := (2 * Rabs (Xn i) + Xn i) / 2 in (forall n, Xn n <> 0) -> Un_cv (fun n:nat => Rabs (Xn (S n) / Xn n)) 0 -> Un_cv (fun n => Rabs (Yn (S n) / Yn n)) 0. Proof. intros An Vn H H0. pose proof (Alembert_C2_aux_positivity An H); fold Vn in H1. pose proof tt as H2. (* <- stupid name compat hack *) cut (forall n:nat, / 2 * Rabs (An n) <= Vn n <= 3 * / 2 * Rabs (An n)). 1:intro; cut (forall n:nat, / Vn n <= 2 * / Rabs (An n)). 1:intro; cut (forall n:nat, Vn (S n) / Vn n <= 3 * Rabs (An (S n) / An n)). + intro; unfold Un_cv; intros; unfold Un_cv in H1; assert (0 < eps / 3). { unfold Rdiv; apply Rmult_lt_0_compat; [ assumption | apply Rinv_0_lt_compat; prove_sup0 ]. } elim (H0 (eps / 3) H7); intros. exists x; intros. assert (H10 := H8 n H9). unfold Rdist; unfold Rminus; rewrite Ropp_0; rewrite Rplus_0_r; rewrite Rabs_Rabsolu; unfold Rdist in H10; unfold Rminus in H10; rewrite Ropp_0 in H10; rewrite Rplus_0_r in H10; rewrite Rabs_Rabsolu in H10; rewrite Rabs_right. 2:{ left; change (0 < Vn (S n) / Vn n); unfold Rdiv; apply Rmult_lt_0_compat. - apply H1. - apply Rinv_0_lt_compat; apply H1. } apply Rle_lt_trans with (3 * Rabs (An (S n) / An n)). { apply H5. } apply Rmult_lt_reg_l with (/ 3). { apply Rinv_0_lt_compat; prove_sup0. } rewrite <- Rmult_assoc; rewrite Rinv_l; [ idtac | discrR ]; rewrite Rmult_1_l; rewrite <- (Rmult_comm eps); unfold Rdiv in H10; exact H10. + intro; unfold Rdiv; rewrite Rabs_mult; rewrite <- Rmult_assoc; replace 3 with (2 * (3 * / 2)); [ idtac | rewrite <- Rmult_assoc; apply Rmult_inv_r_id_m; discrR ]; apply Rle_trans with (Vn (S n) * 2 * / Rabs (An n)). { rewrite Rmult_assoc; apply Rmult_le_compat_l. - left; apply H1. - apply H4. } rewrite Rabs_inv. replace (Vn (S n) * 2 * / Rabs (An n)) with (2 * / Rabs (An n) * Vn (S n)) by ring; replace (2 * (3 * / 2) * Rabs (An (S n)) * / Rabs (An n)) with (2 * / Rabs (An n) * (3 * / 2 * Rabs (An (S n)))) by ring; apply Rmult_le_compat_l. { left; apply Rmult_lt_0_compat. - prove_sup0. - apply Rinv_0_lt_compat; apply Rabs_pos_lt; apply H. } elim (H3 (S n)); intros; assumption. + intro; apply Rmult_le_reg_l with (Vn n). { apply H1. } rewrite Rinv_r. 2:{ red; intro; assert (H5 := H1 n); rewrite H4 in H5; elim (Rlt_irrefl _ H5). } apply Rmult_le_reg_l with (Rabs (An n)). { apply Rabs_pos_lt; apply H. } rewrite Rmult_1_r; replace (Rabs (An n) * (Vn n * (2 * / Rabs (An n)))) with (2 * Vn n * (Rabs (An n) * / Rabs (An n))); [ idtac | ring ]; rewrite Rinv_r. 2:{ apply Rabs_no_R0; apply H. } rewrite Rmult_1_r; apply Rmult_le_reg_l with (/ 2). { apply Rinv_0_lt_compat; prove_sup0. } rewrite <- Rmult_assoc; rewrite Rinv_l. * rewrite Rmult_1_l; elim (H3 n); intros; assumption. * discrR. + intro; split. * unfold Vn; unfold Rdiv; rewrite <- (Rmult_comm (/ 2)); apply Rmult_le_compat_l. { left; apply Rinv_0_lt_compat; prove_sup0. } pattern (Rabs (An n)) at 1; rewrite <- Rplus_0_r; rewrite <-Rplus_diag; rewrite Rplus_assoc; apply Rplus_le_compat_l. apply Rplus_le_reg_l with (- An n); rewrite Rplus_0_r; rewrite <- (Rplus_comm (An n)); rewrite <- Rplus_assoc; rewrite Rplus_opp_l; rewrite Rplus_0_l; rewrite <- Rabs_Ropp; apply RRle_abs. * unfold Vn; unfold Rdiv; repeat rewrite <- (Rmult_comm (/ 2)); repeat rewrite Rmult_assoc; apply Rmult_le_compat_l. { left; apply Rinv_0_lt_compat; prove_sup0. } unfold Rminus; rewrite <-Rplus_diag; replace (3 * Rabs (An n)) with (Rabs (An n) + Rabs (An n) + Rabs (An n)); [ idtac | ring ]; repeat rewrite Rplus_assoc; repeat apply Rplus_le_compat_l; apply RRle_abs. Qed. Lemma Alembert_C2 : forall An:nat -> R, (forall n:nat, An n <> 0) -> Un_cv (fun n:nat => Rabs (An (S n) / An n)) 0 -> { l:R | Un_cv (fun N:nat => sum_f_R0 An N) l }. Proof. intros. set (Vn := fun i:nat => (2 * Rabs (An i) + An i) / 2). set (Wn := fun i:nat => (2 * Rabs (An i) - An i) / 2). assert (forall n:nat, 0 < Vn n). { apply Alembert_C2_aux_positivity;assumption. } assert (Wn_aux : Wn = fun i => (2 * Rabs (- An i) + (- An i)) / 2). { apply FunctionalExtensionality.functional_extensionality. intros n. unfold Wn,Rminus. do 3 f_equal. symmetry;apply Rabs_Ropp. } assert (forall n:nat, 0 < Wn n). { rewrite Wn_aux. apply Alembert_C2_aux_positivity. intros;apply Ropp_neq_0_compat, H. } assert (Un_cv (fun n:nat => Rabs (Vn (S n) / Vn n)) 0). { apply Alembert_C2_aux_Un_cv;assumption. } assert (Un_cv (fun n:nat => Rabs (Wn (S n) / Wn n)) 0). { rewrite Wn_aux. apply (Alembert_C2_aux_Un_cv (fun n => - An n)). - intros;apply Ropp_neq_0_compat, H. - replace (fun n : nat => Rabs (- An (S n) / - An n)) with (fun n : nat => Rabs (An (S n) / An n));[assumption|]. apply FunctionalExtensionality.functional_extensionality. intros n. f_equal. field;trivial. } pose proof (Alembert_C1 Vn H1 H3) as (x,p). pose proof (Alembert_C1 Wn H2 H4) as (x0,p0). exists (x - x0); unfold Un_cv; unfold Un_cv in p; unfold Un_cv in p0; intros; assert (H6:0 < eps / 2). { unfold Rdiv; apply Rmult_lt_0_compat; [ assumption | apply Rinv_0_lt_compat; prove_sup0 ]. } destruct (p (eps / 2) H6) as (x1,H8). clear p. destruct (p0 (eps / 2) H6) as (x2,H9). clear p0. set (N := max x1 x2). exists N; intros; replace (sum_f_R0 An n) with (sum_f_R0 Vn n - sum_f_R0 Wn n). 2:{ symmetry ; apply tech11; intro; unfold Vn, Wn; unfold Rdiv; do 2 rewrite <- (Rmult_comm (/ 2)); apply Rmult_eq_reg_l with 2. - rewrite Rmult_minus_distr_l; repeat rewrite <- Rmult_assoc; rewrite Rinv_r. + ring. + discrR. - discrR. } unfold Rdist; replace (sum_f_R0 Vn n - sum_f_R0 Wn n - (x - x0)) with (sum_f_R0 Vn n - x + - (sum_f_R0 Wn n - x0)) by ring; apply Rle_lt_trans with (Rabs (sum_f_R0 Vn n - x) + Rabs (- (sum_f_R0 Wn n - x0))). { apply Rabs_triang. } rewrite Rabs_Ropp; apply Rlt_le_trans with (eps / 2 + eps / 2). + apply Rplus_lt_compat. * unfold Rdist in H8; apply H8; unfold ge; apply Nat.le_trans with N; [ unfold N; apply Nat.le_max_l | assumption ]. * unfold Rdist in H9; apply H9; unfold ge; apply Nat.le_trans with N; [ unfold N; apply Nat.le_max_r | assumption ]. + right; apply Rplus_half_diag. Qed. Lemma AlembertC3_step1 : forall (An:nat -> R) (x:R), x <> 0 -> (forall n:nat, An n <> 0) -> Un_cv (fun n:nat => Rabs (An (S n) / An n)) 0 -> { l:R | Pser An x l }. Proof. intros; set (Bn := fun i:nat => An i * x ^ i). assert (forall n:nat, Bn n <> 0). { intro; unfold Bn; apply prod_neq_R0; [ apply H0 | apply pow_nonzero; assumption ]. } cut (Un_cv (fun n:nat => Rabs (Bn (S n) / Bn n)) 0). { intro; destruct (Alembert_C2 Bn H2 H3) as (x0,H4). exists x0; unfold Bn in H4; apply tech12; assumption. } unfold Un_cv; intros; unfold Un_cv in H1; cut (0 < eps / Rabs x). 2:{ unfold Rdiv; apply Rmult_lt_0_compat; [ assumption | apply Rinv_0_lt_compat; apply Rabs_pos_lt; assumption ]. } intro; elim (H1 (eps / Rabs x) H4); intros. exists x0; intros; unfold Rdist; unfold Rminus; rewrite Ropp_0; rewrite Rplus_0_r; rewrite Rabs_Rabsolu; unfold Bn; replace (An (S n) * x ^ S n / (An n * x ^ n)) with (An (S n) / An n * x). 2:{ replace (S n) with (n + 1)%nat by ring; rewrite pow_add; unfold Rdiv; rewrite Rinv_mult. replace (An (n + 1)%nat * (x ^ n * x ^ 1) * (/ An n * / x ^ n)) with (An (n + 1)%nat * x ^ 1 * / An n * (x ^ n * / x ^ n)) by ring; rewrite Rinv_r. - simpl; ring. - apply pow_nonzero; assumption. } rewrite Rabs_mult; apply Rmult_lt_reg_l with (/ Rabs x). { apply Rinv_0_lt_compat; apply Rabs_pos_lt; assumption. } rewrite <- (Rmult_comm (Rabs x)); rewrite <- Rmult_assoc; rewrite Rinv_l. 2:{ apply Rabs_no_R0; assumption. } rewrite Rmult_1_l; rewrite <- (Rmult_comm eps); unfold Rdiv in H5; replace (Rabs (An (S n) / An n)) with (Rdist (Rabs (An (S n) * / An n)) 0). { apply H5; assumption. } unfold Rdist; unfold Rminus; rewrite Ropp_0; rewrite Rplus_0_r; rewrite Rabs_Rabsolu; unfold Rdiv; reflexivity. Qed. Lemma AlembertC3_step2 : forall (An:nat -> R) (x:R), x = 0 -> { l:R | Pser An x l }. Proof. intros; exists (An 0%nat). unfold Pser; unfold infinite_sum; intros; exists 0%nat; intros; replace (sum_f_R0 (fun n0:nat => An n0 * x ^ n0) n) with (An 0%nat). - unfold Rdist; unfold Rminus; rewrite Rplus_opp_r; rewrite Rabs_R0; assumption. - induction n as [| n Hrecn]. + simpl; ring. + rewrite tech5; rewrite Hrecn; [ rewrite H; simpl; ring | unfold ge; apply Nat.le_0_l ]. Qed. (** A useful criterion of convergence for power series *) Theorem Alembert_C3 : forall (An:nat -> R) (x:R), (forall n:nat, An n <> 0) -> Un_cv (fun n:nat => Rabs (An (S n) / An n)) 0 -> { l:R | Pser An x l }. Proof. intros; destruct (total_order_T x 0) as [[Hlt|Heq]|Hgt]. - cut (x <> 0). + intro; apply AlembertC3_step1; assumption. + red; intro; rewrite H1 in Hlt; elim (Rlt_irrefl _ Hlt). - apply AlembertC3_step2; assumption. - cut (x <> 0). + intro; apply AlembertC3_step1; assumption. + red; intro; rewrite H1 in Hgt; elim (Rlt_irrefl _ Hgt). Qed. Lemma Alembert_C4 : forall (An:nat -> R) (k:R), 0 <= k < 1 -> (forall n:nat, 0 < An n) -> Un_cv (fun n:nat => Rabs (An (S n) / An n)) k -> { l:R | Un_cv (fun N:nat => sum_f_R0 An N) l }. Proof. intros An k Hyp H H0. assert (X:{ l:R | is_lub (EUn (fun N:nat => sum_f_R0 An N)) l } -> { l:R | Un_cv (fun N:nat => sum_f_R0 An N) l }). { intros (x,H1). exists x; apply Un_cv_crit_lub; [ unfold Un_growing; intro; rewrite tech5; pattern (sum_f_R0 An n) at 1; rewrite <- Rplus_0_r; apply Rplus_le_compat_l; left; apply H | apply H1]. } apply X. apply completeness. 2:{ exists (sum_f_R0 An 0); unfold EUn; exists 0%nat; reflexivity. } assert (H1 := tech13 _ _ Hyp H0). elim H1; intros. elim H2; intros. elim H4; intros. unfold bound; exists (sum_f_R0 An x0 + / (1 - x) * An (S x0)). unfold is_upper_bound; intros; unfold EUn in H6. elim H6; intros. rewrite H7. destruct (lt_eq_lt_dec x2 x0) as [[| -> ]|]. - replace (sum_f_R0 An x0) with (sum_f_R0 An x2 + sum_f_R0 (fun i:nat => An (S x2 + i)%nat) (x0 - S x2)). 2:{ symmetry ; apply tech2; assumption. } pattern (sum_f_R0 An x2) at 1; rewrite <- Rplus_0_r. rewrite Rplus_assoc; apply Rplus_le_compat_l. left; apply Rplus_lt_0_compat. + apply tech1. intros; apply H. + apply Rmult_lt_0_compat. * apply Rinv_0_lt_compat; apply Rplus_lt_reg_l with x; rewrite Rplus_0_r; replace (x + (1 - x)) with 1 by ring; elim H3; intros; assumption. * apply H. - pattern (sum_f_R0 An x0) at 1; rewrite <- Rplus_0_r; apply Rplus_le_compat_l. left; apply Rmult_lt_0_compat. + apply Rinv_0_lt_compat; apply Rplus_lt_reg_l with x; rewrite Rplus_0_r; replace (x + (1 - x)) with 1 by ring; elim H3; intros; assumption. + apply H. - replace (sum_f_R0 An x2) with (sum_f_R0 An x0 + sum_f_R0 (fun i:nat => An (S x0 + i)%nat) (x2 - S x0)). 2:{ symmetry ; apply tech2; assumption. } apply Rplus_le_compat_l. cut (sum_f_R0 (fun i:nat => An (S x0 + i)%nat) (x2 - S x0) <= An (S x0) * sum_f_R0 (fun i:nat => x ^ i) (x2 - S x0)). { intro; apply Rle_trans with (An (S x0) * sum_f_R0 (fun i:nat => x ^ i) (x2 - S x0)). { assumption. } rewrite <- (Rmult_comm (An (S x0))); apply Rmult_le_compat_l. { left; apply H. } rewrite tech3. 2:{ lra. } unfold Rdiv; apply Rmult_le_reg_l with (1 - x). { lra. } do 2 rewrite (Rmult_comm (1 - x)). rewrite Rmult_assoc; rewrite Rinv_l. 2:{ lra. } rewrite Rmult_1_r; apply Rplus_le_reg_l with (x ^ S (x2 - S x0)). replace (x ^ S (x2 - S x0) + (1 - x ^ S (x2 - S x0))) with 1 by ring. rewrite <- (Rplus_comm 1); pattern 1 at 1; rewrite <- Rplus_0_r; apply Rplus_le_compat_l. left; apply pow_lt. lra. } replace (An (S x0)) with (An (S x0 + 0)%nat) by (f_equal;ring). apply (tech6 (fun i:nat => An (S x0 + i)%nat) x). { lra. } intro. cut (forall n:nat, (n >= x0)%nat -> An (S n) < x * An n). { intro H9. replace (S x0 + S i)%nat with (S (S x0 + i)) by ring. apply H9. unfold ge. apply tech8. } intros. apply Rmult_lt_reg_l with (/ An n). { apply Rinv_0_lt_compat; apply H. } do 2 rewrite (Rmult_comm (/ An n)). rewrite Rmult_assoc. rewrite Rinv_r. 2:{ assert (H11 := H n). lra. } rewrite Rmult_1_r. replace (An (S n) * / An n) with (Rabs (An (S n) / An n)). { apply H5; assumption. } rewrite Rabs_right. { unfold Rdiv; reflexivity. } left; unfold Rdiv; change (0 < An (S n) * / An n); apply Rmult_lt_0_compat. + apply H. + apply Rinv_0_lt_compat; apply H. Qed. Lemma Alembert_C5 : forall (An:nat -> R) (k:R), 0 <= k < 1 -> (forall n:nat, An n <> 0) -> Un_cv (fun n:nat => Rabs (An (S n) / An n)) k -> { l:R | Un_cv (fun N:nat => sum_f_R0 An N) l }. Proof. intros. assert (Hyp0:{ l:R | Un_cv (fun N:nat => sum_f_R0 An N) l } -> { l:R | Un_cv (fun N:nat => sum_f_R0 An N) l }). { intro X. elim X; intros. exists x. assumption. } apply Hyp0. apply cv_cauchy_2. apply cauchy_abs. apply cv_cauchy_1. assert (Hyp:{ l:R | Un_cv (fun N:nat => sum_f_R0 (fun i:nat => Rabs (An i)) N) l } -> { l:R | Un_cv (fun N:nat => sum_f_R0 (fun i:nat => Rabs (An i)) N) l }). { intro X. elim X; intros. exists x. assumption. } apply Hyp. apply (Alembert_C4 (fun i:nat => Rabs (An i)) k). - assumption. - intro; apply Rabs_pos_lt; apply H0. - unfold Un_cv. unfold Un_cv in H1. unfold Rdiv. intros. elim (H1 eps H2); intros. exists x; intros. rewrite <- Rabs_inv. rewrite <- Rabs_mult. rewrite Rabs_Rabsolu. unfold Rdiv in H3; apply H3; assumption. Qed. (** Convergence of power series in D(O,1/k) k=0 is described in Alembert_C3 *) Lemma Alembert_C6 : forall (An:nat -> R) (x k:R), 0 < k -> (forall n:nat, An n <> 0) -> Un_cv (fun n:nat => Rabs (An (S n) / An n)) k -> Rabs x < / k -> { l:R | Pser An x l }. Proof. intros. cut { l:R | Un_cv (fun N:nat => sum_f_R0 (fun i:nat => An i * x ^ i) N) l }. { intro X. elim X; intros. exists x0. apply tech12; assumption. } destruct (total_order_T x 0) as [[Hlt|Heq]|Hgt]. - eapply Alembert_C5 with (k * Rabs x). + split. * unfold Rdiv; apply Rmult_le_pos. { lra. } left; apply Rabs_pos_lt. lra. * apply Rmult_lt_reg_l with (/ k). { apply Rinv_0_lt_compat; assumption. } rewrite <- Rmult_assoc. rewrite Rinv_l. 2:{ lra. } rewrite Rmult_1_l. rewrite Rmult_1_r; assumption. + intro; apply prod_neq_R0. { apply H0. } apply pow_nonzero. lra. + unfold Un_cv; unfold Un_cv in H1. intros. assert (0 < eps / Rabs x). { unfold Rdiv; apply Rmult_lt_0_compat. - assumption. - apply Rinv_0_lt_compat; apply Rabs_pos_lt. lra. } elim (H1 (eps / Rabs x) H4); intros. exists x0. intros. replace (An (S n) * x ^ S n / (An n * x ^ n)) with (An (S n) / An n * x). 2:{ unfold Rdiv; replace (S n) with (n + 1)%nat by ring. rewrite pow_add. simpl. rewrite Rmult_1_r. rewrite Rinv_mult. replace (An (n + 1)%nat * (x ^ n * x) * (/ An n * / x ^ n)) with (An (n + 1)%nat * / An n * x * (x ^ n * / x ^ n)) by ring. rewrite Rinv_r. { lra. } apply pow_nonzero;lra. } unfold Rdist. rewrite Rabs_mult. replace (Rabs (An (S n) / An n) * Rabs x - k * Rabs x) with (Rabs x * (Rabs (An (S n) / An n) - k)) by ring. rewrite Rabs_mult. rewrite Rabs_Rabsolu. apply Rmult_lt_reg_l with (/ Rabs x). { apply Rinv_0_lt_compat; apply Rabs_pos_lt. lra. } rewrite <- Rmult_assoc. rewrite Rinv_l. 2:{ apply Rabs_no_R0; lra. } rewrite Rmult_1_l. rewrite <- (Rmult_comm eps). unfold Rdist in H5. unfold Rdiv; unfold Rdiv in H5; apply H5; assumption. - exists (An 0%nat). unfold Un_cv. intros. exists 0%nat. intros. unfold Rdist. replace (sum_f_R0 (fun i:nat => An i * x ^ i) n) with (An 0%nat). { unfold Rminus; rewrite Rplus_opp_r; rewrite Rabs_R0; assumption. } induction n as [| n Hrecn]. + simpl; ring. + rewrite tech5. rewrite <- Hrecn,Heq;simpl. * ring. * unfold ge; apply Nat.le_0_l. - eapply Alembert_C5 with (k * Rabs x). + split. * unfold Rdiv; apply Rmult_le_pos. { left; assumption. } left; apply Rabs_pos_lt. lra. * apply Rmult_lt_reg_l with (/ k). { apply Rinv_0_lt_compat; assumption. } rewrite <- Rmult_assoc. rewrite Rinv_l. 2:{ lra. } rewrite Rmult_1_l. rewrite Rmult_1_r; assumption. + intro; apply prod_neq_R0. * apply H0. * apply pow_nonzero. lra. + unfold Un_cv; unfold Un_cv in H1. intros. assert (0 < eps / Rabs x). { unfold Rdiv; apply Rmult_lt_0_compat. - assumption. - apply Rinv_0_lt_compat; apply Rabs_pos_lt. lra. } elim (H1 (eps / Rabs x) H4); intros. exists x0. intros. replace (An (S n) * x ^ S n / (An n * x ^ n)) with (An (S n) / An n * x). 2:{ unfold Rdiv; replace (S n) with (n + 1)%nat by ring. rewrite pow_add. simpl. rewrite Rmult_1_r. rewrite Rinv_mult. replace (An (n + 1)%nat * (x ^ n * x) * (/ An n * / x ^ n)) with (An (n + 1)%nat * / An n * x * (x ^ n * / x ^ n)) by ring. rewrite Rinv_r. { lra. } apply pow_nonzero;lra. } unfold Rdist. rewrite Rabs_mult. replace (Rabs (An (S n) / An n) * Rabs x - k * Rabs x) with (Rabs x * (Rabs (An (S n) / An n) - k)); [ idtac | ring ]. rewrite Rabs_mult. rewrite Rabs_Rabsolu. apply Rmult_lt_reg_l with (/ Rabs x). { apply Rinv_0_lt_compat; apply Rabs_pos_lt. lra. } rewrite <- Rmult_assoc. rewrite Rinv_l. 2:{ apply Rabs_no_R0. lra. } rewrite Rmult_1_l. rewrite <- (Rmult_comm eps). unfold Rdist in H5. unfold Rdiv; unfold Rdiv in H5; apply H5; assumption. Qed. coq-8.20.0/theories/Reals/AltSeries.v000066400000000000000000000356761466560755400174000ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* R) (i:nat) : R := (-1) ^ i * Un i. Definition positivity_seq (Un:nat -> R) : Prop := forall n:nat, 0 <= Un n. Lemma CV_ALT_step0 : forall Un:nat -> R, Un_decreasing Un -> Un_growing (fun N:nat => sum_f_R0 (tg_alt Un) (S (2 * N))). Proof. intros; unfold Un_growing; intro. cut ((2 * S n)%nat = S (S (2 * n))). - intro; rewrite H0. do 4 rewrite tech5; repeat rewrite Rplus_assoc; apply Rplus_le_compat_l. pattern (tg_alt Un (S (2 * n))) at 1; rewrite <- Rplus_0_r. apply Rplus_le_compat_l. unfold tg_alt; rewrite <- H0; rewrite pow_1_odd; rewrite pow_1_even; rewrite Rmult_1_l. apply Rplus_le_reg_l with (Un (S (2 * S n))). rewrite Rplus_0_r; replace (Un (S (2 * S n)) + (Un (2 * S n)%nat + -1 * Un (S (2 * S n)))) with (Un (2 * S n)%nat); [ idtac | ring ]. apply H. - cut (forall n:nat, S n = (n + 1)%nat); [ intro | intro; ring ]. rewrite (H0 n); rewrite (H0 (S (2 * n))); rewrite (H0 (2 * n)%nat); ring. Qed. Lemma CV_ALT_step1 : forall Un:nat -> R, Un_decreasing Un -> Un_decreasing (fun N:nat => sum_f_R0 (tg_alt Un) (2 * N)). Proof. intros; unfold Un_decreasing; intro. cut ((2 * S n)%nat = S (S (2 * n))). - intro; rewrite H0; do 2 rewrite tech5; repeat rewrite Rplus_assoc. pattern (sum_f_R0 (tg_alt Un) (2 * n)) at 2; rewrite <- Rplus_0_r. apply Rplus_le_compat_l. unfold tg_alt; rewrite <- H0; rewrite pow_1_odd; rewrite pow_1_even; rewrite Rmult_1_l. apply Rplus_le_reg_l with (Un (S (2 * n))). rewrite Rplus_0_r; replace (Un (S (2 * n)) + (-1 * Un (S (2 * n)) + Un (2 * S n)%nat)) with (Un (2 * S n)%nat); [ idtac | ring ]. rewrite H0; apply H. - cut (forall n:nat, S n = (n + 1)%nat); [ intro | intro; ring ]. rewrite (H0 n); rewrite (H0 (S (2 * n))); rewrite (H0 (2 * n)%nat); ring. Qed. (**********) Lemma CV_ALT_step2 : forall (Un:nat -> R) (N:nat), Un_decreasing Un -> positivity_seq Un -> sum_f_R0 (fun i:nat => tg_alt Un (S i)) (S (2 * N)) <= 0. Proof. intros; induction N as [| N HrecN]. - simpl; unfold tg_alt; simpl; rewrite Rmult_1_r. replace (-1 * -1 * Un 2%nat) with (Un 2%nat); [ idtac | ring ]. apply Rplus_le_reg_l with (Un 1%nat); rewrite Rplus_0_r. replace (Un 1%nat + (-1 * Un 1%nat + Un 2%nat)) with (Un 2%nat); [ apply H | ring ]. - cut (S (2 * S N) = S (S (S (2 * N)))). + intro; rewrite H1; do 2 rewrite tech5. apply Rle_trans with (sum_f_R0 (fun i:nat => tg_alt Un (S i)) (S (2 * N))). * pattern (sum_f_R0 (fun i:nat => tg_alt Un (S i)) (S (2 * N))) at 2; rewrite <- Rplus_0_r. rewrite Rplus_assoc; apply Rplus_le_compat_l. unfold tg_alt; rewrite <- H1. rewrite pow_1_odd. cut (S (S (2 * S N)) = (2 * S (S N))%nat). -- intro; rewrite H2; rewrite pow_1_even; rewrite Rmult_1_l; rewrite <- H2. apply Rplus_le_reg_l with (Un (S (2 * S N))). rewrite Rplus_0_r; replace (Un (S (2 * S N)) + (-1 * Un (S (2 * S N)) + Un (S (S (2 * S N))))) with (Un (S (S (2 * S N)))); [ idtac | ring ]. apply H. -- ring. * apply HrecN. + ring. Qed. (** A more general inequality *) Lemma CV_ALT_step3 : forall (Un:nat -> R) (N:nat), Un_decreasing Un -> positivity_seq Un -> sum_f_R0 (fun i:nat => tg_alt Un (S i)) N <= 0. Proof. intros; induction N as [| N HrecN]. - simpl; unfold tg_alt; simpl; rewrite Rmult_1_r. apply Rplus_le_reg_l with (Un 1%nat). rewrite Rplus_0_r; replace (Un 1%nat + -1 * Un 1%nat) with 0; [ apply H0 | ring ]. - assert (H1 := even_odd_cor N). elim H1; intros. elim H2; intro. + rewrite H3; apply CV_ALT_step2; assumption. + rewrite H3; rewrite tech5. apply Rle_trans with (sum_f_R0 (fun i:nat => tg_alt Un (S i)) (S (2 * x))). * pattern (sum_f_R0 (fun i:nat => tg_alt Un (S i)) (S (2 * x))) at 2; rewrite <- Rplus_0_r. apply Rplus_le_compat_l. unfold tg_alt; simpl. replace (x + (x + 0))%nat with (2 * x)%nat; [ idtac | ring ]. rewrite pow_1_even. replace (-1 * (-1 * (-1 * 1)) * Un (S (S (S (2 * x))))) with (- Un (S (S (S (2 * x))))); [ idtac | ring ]. apply Rplus_le_reg_l with (Un (S (S (S (2 * x))))). rewrite Rplus_0_r; rewrite Rplus_opp_r. apply H0. * apply CV_ALT_step2; assumption. Qed. (**********) Lemma CV_ALT_step4 : forall Un:nat -> R, Un_decreasing Un -> positivity_seq Un -> has_ub (fun N:nat => sum_f_R0 (tg_alt Un) (S (2 * N))). Proof. intros; unfold has_ub; unfold bound. exists (Un 0%nat). unfold is_upper_bound; intros; elim H1; intros. rewrite H2; rewrite decomp_sum. - replace (tg_alt Un 0) with (Un 0%nat). + pattern (Un 0%nat) at 2; rewrite <- Rplus_0_r. apply Rplus_le_compat_l. apply CV_ALT_step3; assumption. + unfold tg_alt; simpl; ring. - apply Nat.lt_0_succ. Qed. (** This lemma gives an interesting result about alternated series *) Lemma CV_ALT : forall Un:nat -> R, Un_decreasing Un -> positivity_seq Un -> Un_cv Un 0 -> { l:R | Un_cv (fun N:nat => sum_f_R0 (tg_alt Un) N) l }. Proof. intros. assert (H2 := CV_ALT_step0 _ H). assert (H3 := CV_ALT_step4 _ H H0). destruct (growing_cv _ H2 H3) as (x,p). exists x. unfold Un_cv; unfold Rdist; unfold Un_cv in H1; unfold Rdist in H1; unfold Un_cv in p; unfold Rdist in p. intros; cut (0 < eps / 2); [ intro | unfold Rdiv; apply Rmult_lt_0_compat; [ assumption | apply Rinv_0_lt_compat; prove_sup0 ] ]. elim (H1 (eps / 2) H5); intros N2 H6. elim (p (eps / 2) H5); intros N1 H7. set (N := max (S (2 * N1)) N2). exists N; intros. assert (H9 := even_odd_cor n). elim H9; intros P H10. assert (N1 <= P)%nat. { elim H10; intro; apply le_double. - rewrite <- H11; apply Nat.le_trans with N. + unfold N; apply Nat.le_trans with (S (2 * N1)); [ apply Nat.le_succ_diag_r | apply Nat.le_max_l ]. + assumption. - apply Nat.lt_succ_r. rewrite <- H11. apply Nat.lt_le_trans with N. + unfold N; apply Nat.lt_le_trans with (S (2 * N1)). * apply Nat.lt_succ_diag_r. * apply Nat.le_max_l. + assumption. } elim H10; intro. - replace (sum_f_R0 (tg_alt Un) n - x) with (sum_f_R0 (tg_alt Un) (S n) - x + - tg_alt Un (S n)). + apply Rle_lt_trans with (Rabs (sum_f_R0 (tg_alt Un) (S n) - x) + Rabs (- tg_alt Un (S n))). * apply Rabs_triang. * rewrite <-(Rplus_half_diag eps); apply Rplus_lt_compat. -- rewrite H12; apply H7; assumption. -- rewrite Rabs_Ropp; unfold tg_alt; rewrite Rabs_mult; rewrite pow_1_abs; rewrite Rmult_1_l; unfold Rminus in H6; rewrite Ropp_0 in H6; rewrite <- (Rplus_0_r (Un (S n))); apply H6. unfold ge; apply Nat.le_trans with n. ++ apply Nat.le_trans with N; [ unfold N; apply Nat.le_max_r | assumption ]. ++ apply Nat.le_succ_diag_r. + rewrite tech5; ring. - rewrite H12; apply Rlt_trans with (eps / 2). + apply H7; assumption. + unfold Rdiv; apply Rmult_lt_reg_l with 2. * prove_sup0. * rewrite (Rmult_comm 2); rewrite Rmult_assoc; rewrite Rinv_l; [ rewrite Rmult_1_r | discrR ]. rewrite <-Rplus_diag. pattern eps at 1; rewrite <- (Rplus_0_r eps); apply Rplus_lt_compat_l; assumption. Qed. (*************************************************) (** * Convergence of alternated series *) Theorem alternated_series : forall Un:nat -> R, Un_decreasing Un -> Un_cv Un 0 -> { l:R | Un_cv (fun N:nat => sum_f_R0 (tg_alt Un) N) l }. Proof. intros; apply CV_ALT. - assumption. - unfold positivity_seq; apply decreasing_ineq; assumption. - assumption. Qed. Theorem alternated_series_ineq : forall (Un:nat -> R) (l:R) (N:nat), Un_decreasing Un -> Un_cv Un 0 -> Un_cv (fun N:nat => sum_f_R0 (tg_alt Un) N) l -> sum_f_R0 (tg_alt Un) (S (2 * N)) <= l <= sum_f_R0 (tg_alt Un) (2 * N). Proof. intros. assert (Un_cv (fun N:nat => sum_f_R0 (tg_alt Un) (2 * N)) l). { unfold Un_cv; unfold Rdist; unfold Un_cv in H1; unfold Rdist in H1; intros. elim (H1 eps H2); intros. exists x; intros. apply H3. apply Nat.le_trans with n; [ assumption | ]. rewrite <- Nat.double_twice; apply Nat.le_add_r. } assert (Un_cv (fun N:nat => sum_f_R0 (tg_alt Un) (S (2 * N))) l). { unfold Un_cv; unfold Rdist; unfold Un_cv in H1; unfold Rdist in H1; intros. elim (H1 eps H3); intros. exists x; intros. apply H4. apply Nat.le_trans with n; [ assumption | ]. apply Nat.le_le_succ_r. rewrite <- Nat.double_twice; apply Nat.le_add_r. } intros; split. - apply (growing_ineq (fun N:nat => sum_f_R0 (tg_alt Un) (S (2 * N)))). + apply CV_ALT_step0; assumption. + assumption. - apply (decreasing_ineq (fun N:nat => sum_f_R0 (tg_alt Un) (2 * N))). + apply CV_ALT_step1; assumption. + assumption. Qed. (***************************************) (** * Application : construction of PI *) (***************************************) Definition PI_tg (n:nat) := / INR (2 * n + 1). Lemma PI_tg_pos : forall n:nat, 0 <= PI_tg n. Proof. intro; unfold PI_tg; left; apply Rinv_0_lt_compat; apply lt_INR_0; replace (2 * n + 1)%nat with (S (2 * n)); [ apply Nat.lt_0_succ | ring ]. Qed. Lemma PI_tg_decreasing : Un_decreasing PI_tg. Proof. unfold PI_tg, Un_decreasing; intro. apply Rmult_le_reg_l with (INR (2 * n + 1)). - apply lt_INR_0. replace (2 * n + 1)%nat with (S (2 * n)); [ apply Nat.lt_0_succ | ring ]. - rewrite Rinv_r. + apply Rmult_le_reg_l with (INR (2 * S n + 1)). * apply lt_INR_0. replace (2 * S n + 1)%nat with (S (2 * S n)); [ apply Nat.lt_0_succ | ring ]. * rewrite (Rmult_comm (INR (2 * S n + 1))); rewrite Rmult_assoc; rewrite Rinv_l. -- do 2 rewrite Rmult_1_r; apply le_INR. replace (2 * S n + 1)%nat with (S (S (2 * n + 1))). ++ apply Nat.le_trans with (S (2 * n + 1)); apply Nat.le_succ_diag_r. ++ ring. -- apply not_O_INR; discriminate. + apply not_O_INR; replace (2 * n + 1)%nat with (S (2 * n)); [ discriminate | ring ]. Qed. Lemma PI_tg_cv : Un_cv PI_tg 0. Proof. unfold Un_cv; unfold Rdist; intros. assert (0 < 2 * eps) by lra. assert (H1 := archimed (/ (2 * eps))). assert (0 <= up (/ (2 * eps)))%Z. { apply le_IZR. left; apply Rlt_trans with (/ (2 * eps)). - apply Rinv_0_lt_compat; assumption. - elim H1; intros; assumption. } assert (H3 := IZN (up (/ (2 * eps))) H2). elim H3; intros N H4. assert (0 < N)%nat. { elim H1; intros H5 _. destruct (lt_eq_lt_dec 0 N) as [[| <- ]|H6]. - assumption. - rewrite H4 in H5. simpl in H5. cut (0 < / (2 * eps)); [ intro | apply Rinv_0_lt_compat; assumption ]. elim (Rlt_irrefl _ (Rlt_trans _ _ _ H6 H5)). - elim (Nat.nlt_0_r _ H6). } exists N; intros. assert (0 < n)%nat by (apply Nat.lt_le_trans with N; assumption). unfold Rminus; rewrite Ropp_0; rewrite Rplus_0_r; rewrite Rabs_right. 2:{ apply Rle_ge; apply PI_tg_pos. } unfold PI_tg; apply Rlt_trans with (/ INR (2 * n)). - apply Rmult_lt_reg_l with (INR (2 * n)). { apply lt_INR_0. auto with zarith. } rewrite Rinv_r. 2:{ replace n with (S (pred n)). - apply not_O_INR; discriminate. - apply Nat.lt_succ_pred with 0%nat. assumption. } apply Rmult_lt_reg_l with (INR (2 * n + 1)). { apply lt_INR_0. replace (2 * n + 1)%nat with (S (2 * n)) by ring; apply Nat.lt_0_succ. } rewrite (Rmult_comm (INR (2 * n + 1))). rewrite Rmult_assoc; rewrite Rinv_l. 2:{ apply not_O_INR; replace (2 * n + 1)%nat with (S (2 * n)); [ discriminate | ring ]. } do 2 rewrite Rmult_1_r; apply lt_INR. replace (2 * n + 1)%nat with (S (2 * n)) by ring; apply Nat.lt_succ_diag_r. - apply Rle_lt_trans with (/ INR (2 * N)). + apply Rinv_le_contravar. * rewrite mult_INR; apply Rmult_lt_0_compat; [ simpl; prove_sup0 | apply lt_INR_0; assumption ]. * apply le_INR. now apply Nat.mul_le_mono_nonneg_l; [ apply Nat.le_0_l | ]. + rewrite mult_INR. apply Rmult_lt_reg_l with (INR N / eps). * apply Rdiv_lt_0_compat with (2 := H). now apply (lt_INR 0). * replace (_ */ _) with (/(2 * eps)). -- replace (_ / _ * _) with (INR N). ++ rewrite INR_IZR_INZ. now rewrite <- H4. ++ field. now apply Rgt_not_eq. -- simpl (INR 2); field; split. ++ now apply Rgt_not_eq, (lt_INR 0). ++ now apply Rgt_not_eq. Qed. Lemma exist_PI : { l:R | Un_cv (fun N:nat => sum_f_R0 (tg_alt PI_tg) N) l }. Proof. apply alternated_series. - apply PI_tg_decreasing. - apply PI_tg_cv. Qed. (** Now, PI is defined *) Definition Alt_PI : R := 4 * (let (a,_) := exist_PI in a). (** We can get an approximation of PI with the following inequality *) Lemma Alt_PI_ineq : forall N:nat, sum_f_R0 (tg_alt PI_tg) (S (2 * N)) <= Alt_PI / 4 <= sum_f_R0 (tg_alt PI_tg) (2 * N). Proof. intro; apply alternated_series_ineq. - apply PI_tg_decreasing. - apply PI_tg_cv. - unfold Alt_PI; case exist_PI; intro. replace (4 * x / 4) with x. + trivial. + unfold Rdiv; rewrite (Rmult_comm 4); rewrite Rmult_assoc; rewrite Rinv_r; [ rewrite Rmult_1_r; reflexivity | discrR ]. Qed. Lemma Alt_PI_RGT_0 : 0 < Alt_PI. Proof. assert (H := Alt_PI_ineq 0). apply Rmult_lt_reg_l with (/ 4). - apply Rinv_0_lt_compat; prove_sup0. - rewrite Rmult_0_r; rewrite Rmult_comm. elim H; clear H; intros H _. unfold Rdiv in H; apply Rlt_le_trans with (sum_f_R0 (tg_alt PI_tg) (S (2 * 0))). + simpl; unfold tg_alt; simpl; rewrite Rmult_1_l; rewrite Rmult_1_r; apply Rplus_lt_reg_l with (PI_tg 1). rewrite Rplus_0_r; replace (PI_tg 1 + (PI_tg 0 + -1 * PI_tg 1)) with (PI_tg 0); [ unfold PI_tg | ring ]. simpl; apply Rinv_lt_contravar. * rewrite Rmult_1_l; replace (2 + 1) with 3; [ prove_sup0 | ring ]. * rewrite Rplus_comm; pattern 1 at 1; rewrite <- Rplus_0_r; apply Rplus_lt_compat_l; prove_sup0. + assumption. Qed. coq-8.20.0/theories/Reals/ArithProp.v000066400000000000000000000150011466560755400173710ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* (n - i)%nat <> 0%nat. Proof. intros n i Hlt. apply Nat.neq_0_lt_0, Nat.lt_add_lt_sub_r; assumption. Qed. Lemma le_minusni_n : forall n i:nat, (i <= n)%nat -> (n - i <= n)%nat. Proof. intros n i _. induction i as [ | i IHi ]. - rewrite Nat.sub_0_r; reflexivity. - etransitivity; [ | apply IHi ]. rewrite Nat.sub_succ_r. apply Nat.le_pred_l. Qed. Lemma lt_minus_O_lt : forall m n:nat, (m < n)%nat -> (0 < n - m)%nat. Proof. intros n i Hlt. apply Nat.lt_add_lt_sub_r; assumption. Qed. Lemma even_odd_cor : forall n:nat, exists p : nat, n = (2 * p)%nat \/ n = S (2 * p). Proof. intros n; exists (Nat.div2 n). case_eq (Nat.odd n); intros H; [right|left]. - assert (Nat.b2n (Nat.odd n) = 1%nat) as Hb by now rewrite H. rewrite Nat.div2_odd at 1; rewrite Hb, Nat.add_1_r; reflexivity. - assert (Nat.b2n (Nat.odd n) = 0%nat) as Hb by now rewrite H. rewrite Nat.div2_odd at 1; rewrite Hb, Nat.add_0_r; reflexivity. Qed. (* 2m <= 2n => m<=n *) Lemma le_double : forall m n:nat, (2 * m <= 2 * n)%nat -> (m <= n)%nat. Proof. intros; apply INR_le. assert (H1 := le_INR _ _ H). do 2 rewrite mult_INR in H1. apply Rmult_le_reg_l with (INR 2). - apply lt_0_INR. apply Nat.lt_0_2. - assumption. Qed. (** Here, we have the euclidian division *) (** This lemma is used in the proof of sin_eq_0 : (sin x)=0<->x=kPI *) Lemma euclidian_division : forall x y:R, y <> 0 -> exists k : Z, (exists r : R, x = IZR k * y + r /\ 0 <= r < Rabs y). Proof. intros. set (k0 := match Rcase_abs y with | left _ => (1 - up (x / - y))%Z | right _ => (up (x / y) - 1)%Z end). exists k0. exists (x - IZR k0 * y). split. - ring. - unfold k0; case (Rcase_abs y) as [Hlt|Hge]. + assert (H0 := archimed (x / - y)); rewrite <- Z_R_minus; simpl; unfold Rminus. replace (- ((1 + - IZR (up (x / - y))) * y)) with ((IZR (up (x / - y)) - 1) * y); [ idtac | ring ]. split. * apply Rmult_le_reg_l with (/ - y). -- apply Rinv_0_lt_compat; apply Ropp_0_gt_lt_contravar; exact Hlt. -- rewrite Rmult_0_r; rewrite (Rmult_comm (/ - y)); rewrite Rmult_plus_distr_r; rewrite Rinv_opp. rewrite Rmult_assoc; repeat rewrite Ropp_mult_distr_r_reverse; rewrite Rinv_r; [ rewrite Rmult_1_r | assumption ]. apply Rplus_le_reg_l with (IZR (up (x / - y)) - x / - y). rewrite Rplus_0_r; unfold Rdiv; pattern (/ - y) at 4; rewrite Rinv_opp. replace (IZR (up (x * / - y)) - x * - / y + (- (x * / y) + - (IZR (up (x * / - y)) - 1))) with 1; [ idtac | ring ]. elim H0; intros _ H1; unfold Rdiv in H1; exact H1. * rewrite (Rabs_left _ Hlt); apply Rmult_lt_reg_l with (/ - y). -- apply Rinv_0_lt_compat; apply Ropp_0_gt_lt_contravar; exact Hlt. -- rewrite Rinv_l. ++ rewrite (Rmult_comm (/ - y)); rewrite Rmult_plus_distr_r; rewrite Rinv_opp. rewrite Rmult_assoc; repeat rewrite Ropp_mult_distr_r_reverse; rewrite Rinv_r; [ rewrite Rmult_1_r | assumption ]; apply Rplus_lt_reg_l with (IZR (up (x / - y)) - 1). replace (IZR (up (x / - y)) - 1 + 1) with (IZR (up (x / - y))); [ idtac | ring ]. replace (IZR (up (x / - y)) - 1 + (- (x * / y) + - (IZR (up (x / - y)) - 1))) with (- (x * / y)); [ idtac | ring ]. rewrite <- Ropp_mult_distr_r_reverse; rewrite <- Rinv_opp; elim H0; unfold Rdiv; intros H1 _; exact H1. ++ apply Ropp_neq_0_compat; assumption. + assert (H0 := archimed (x / y)); rewrite <- Z_R_minus; simpl; cut (0 < y). * intro; unfold Rminus; replace (- ((IZR (up (x / y)) + -(1)) * y)) with ((1 - IZR (up (x / y))) * y); [ idtac | ring ]. split. -- apply Rmult_le_reg_l with (/ y). ++ apply Rinv_0_lt_compat; assumption. ++ rewrite Rmult_0_r; rewrite (Rmult_comm (/ y)); rewrite Rmult_plus_distr_r; rewrite Rmult_assoc; rewrite Rinv_r; [ rewrite Rmult_1_r | assumption ]; apply Rplus_le_reg_l with (IZR (up (x / y)) - x / y); rewrite Rplus_0_r; unfold Rdiv; replace (IZR (up (x * / y)) - x * / y + (x * / y + (1 - IZR (up (x * / y))))) with 1; [ idtac | ring ]; elim H0; intros _ H2; unfold Rdiv in H2; exact H2. -- rewrite (Rabs_right _ Hge); apply Rmult_lt_reg_l with (/ y). ++ apply Rinv_0_lt_compat; assumption. ++ rewrite (Rinv_l _ H); rewrite (Rmult_comm (/ y)); rewrite Rmult_plus_distr_r; rewrite Rmult_assoc; rewrite Rinv_r; [ rewrite Rmult_1_r | assumption ]; apply Rplus_lt_reg_l with (IZR (up (x / y)) - 1); replace (IZR (up (x / y)) - 1 + 1) with (IZR (up (x / y))); [ idtac | ring ]; replace (IZR (up (x / y)) - 1 + (x * / y + (1 - IZR (up (x / y))))) with (x * / y); [ idtac | ring ]; elim H0; unfold Rdiv; intros H2 _; exact H2. * destruct (total_order_T 0 y) as [[Hlt|Heq]|Hgt]. -- assumption. -- elim H; symmetry ; exact Heq. -- apply Rge_le in Hge; elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ Hge Hgt)). Qed. Lemma tech8 : forall n i:nat, (n <= S n + i)%nat. Proof. intros; induction i as [| i Hreci]. - replace (S n + 0)%nat with (S n); [ apply Nat.le_succ_diag_r | ring ]. - replace (S n + S i)%nat with (S (S n + i)). + apply le_S; assumption. + apply INR_eq; rewrite S_INR; do 2 rewrite plus_INR; do 2 rewrite S_INR; ring. Qed. coq-8.20.0/theories/Reals/Binomial.v000066400000000000000000000203021466560755400172130ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* C n i = C n (n - i). Proof. intros; unfold C; replace (n - (n - i))%nat with i. - rewrite Rmult_comm. reflexivity. - symmetry; apply Nat.add_sub_eq_l, Nat.sub_add; assumption. Qed. Lemma pascal_step2 : forall n i:nat, (i <= n)%nat -> C (S n) i = INR (S n) / INR (S n - i) * C n i. Proof. intros; unfold C; replace (S n - i)%nat with (S (n - i)). - cut (forall n:nat, fact (S n) = (S n * fact n)%nat). + intro; repeat rewrite H0. unfold Rdiv; repeat rewrite mult_INR; repeat rewrite Rinv_mult. ring. + intro; reflexivity. - symmetry; apply Nat.sub_succ_l; assumption. Qed. Lemma pascal_step3 : forall n i:nat, (i < n)%nat -> C n (S i) = INR (n - i) / INR (S i) * C n i. Proof. intros; unfold C. cut (forall n:nat, fact (S n) = (S n * fact n)%nat). - intro. cut ((n - i)%nat = S (n - S i)). + intro. pattern (n - i)%nat at 2; rewrite H1. repeat rewrite H0; unfold Rdiv; repeat rewrite mult_INR; repeat rewrite Rinv_mult. rewrite <- H1; rewrite (Rmult_comm (/ INR (n - i))); repeat rewrite Rmult_assoc; rewrite (Rmult_comm (INR (n - i))); repeat rewrite Rmult_assoc; rewrite Rinv_l. * ring. * apply not_O_INR; apply minus_neq_O; assumption. + rewrite <- Nat.sub_succ_l. * simpl; reflexivity. * apply -> Nat.le_succ_l; assumption. - intro; reflexivity. Qed. (**********) Lemma pascal : forall n i:nat, (i < n)%nat -> C n i + C n (S i) = C (S n) (S i). Proof. intros. rewrite pascal_step3; [ idtac | assumption ]. replace (C n i + INR (n - i) / INR (S i) * C n i) with (C n i * (1 + INR (n - i) / INR (S i))) by ring. replace (1 + INR (n - i) / INR (S i)) with (INR (S n) / INR (S i)). - rewrite pascal_step1. + rewrite Rmult_comm; replace (S i) with (S n - (n - i))%nat. * rewrite <- pascal_step2. -- apply pascal_step1. apply Nat.le_trans with n. ++ apply le_minusni_n. apply Nat.lt_le_incl; assumption. ++ apply Nat.le_succ_diag_r. -- apply le_minusni_n. apply Nat.lt_le_incl; assumption. * rewrite Nat.sub_succ_l. -- cut ((n - (n - i))%nat = i). ++ intro; rewrite H0; reflexivity. ++ apply Nat.add_sub_eq_l, Nat.sub_add. apply Nat.lt_le_incl; assumption. -- apply le_minusni_n; apply Nat.lt_le_incl; assumption. + apply Nat.lt_le_incl; assumption. - unfold Rdiv. repeat rewrite S_INR. rewrite minus_INR. + cut (INR i + 1 <> 0). * intro. apply Rmult_eq_reg_l with (INR i + 1); [ idtac | assumption ]. rewrite Rmult_plus_distr_l. rewrite Rmult_1_r. do 2 rewrite (Rmult_comm (INR i + 1)). repeat rewrite Rmult_assoc. rewrite Rinv_l; [ idtac | assumption ]. ring. * rewrite <- S_INR. apply not_O_INR; discriminate. + apply Nat.lt_le_incl; assumption. Qed. (*********************) (*********************) Lemma binomial : forall (x y:R) (n:nat), (x + y) ^ n = sum_f_R0 (fun i:nat => C n i * x ^ i * y ^ (n - i)) n. Proof. intros; induction n as [| n Hrecn]. - unfold C; simpl; unfold Rdiv; repeat rewrite Rmult_1_r; rewrite Rinv_1; ring. - pattern (S n) at 1; replace (S n) with (n + 1)%nat; [ idtac | ring ]. rewrite pow_add; rewrite Hrecn. replace ((x + y) ^ 1) with (x + y); [ idtac | simpl; ring ]. rewrite tech5. cut (forall p:nat, C p p = 1). 1:cut (forall p:nat, C p 0 = 1). + intros; rewrite H0; rewrite Nat.sub_diag; rewrite Rmult_1_l. replace (y ^ 0) with 1; [ rewrite Rmult_1_r | simpl; reflexivity ]. induction n as [| n Hrecn0]. * simpl; do 2 rewrite H; ring. * (* N >= 1 *) set (N := S n). rewrite Rmult_plus_distr_l. replace (sum_f_R0 (fun i:nat => C N i * x ^ i * y ^ (N - i)) N * x) with (sum_f_R0 (fun i:nat => C N i * x ^ S i * y ^ (N - i)) N). 1: replace (sum_f_R0 (fun i:nat => C N i * x ^ i * y ^ (N - i)) N * y) with (sum_f_R0 (fun i:nat => C N i * x ^ i * y ^ (S N - i)) N). -- rewrite (decomp_sum (fun i:nat => C (S N) i * x ^ i * y ^ (S N - i)) N). ++ rewrite H; replace (x ^ 0) with 1; [ idtac | reflexivity ]. do 2 rewrite Rmult_1_l. replace (S N - 0)%nat with (S N); [ idtac | reflexivity ]. set (An := fun i:nat => C N i * x ^ S i * y ^ (N - i)). set (Bn := fun i:nat => C N (S i) * x ^ S i * y ^ (N - i)). replace (pred N) with n. 1:replace (sum_f_R0 (fun i:nat => C (S N) (S i) * x ^ S i * y ^ (S N - S i)) n) with (sum_f_R0 (fun i:nat => An i + Bn i) n). ** rewrite plus_sum. replace (x ^ S N) with (An (S n)). { rewrite (Rplus_comm (sum_f_R0 An n)). repeat rewrite Rplus_assoc. rewrite <- tech5. fold N. set (Cn := fun i:nat => C N i * x ^ i * y ^ (S N - i)). cut (forall i:nat, (i < N)%nat -> Cn (S i) = Bn i). - intro; replace (sum_f_R0 Bn n) with (sum_f_R0 (fun i:nat => Cn (S i)) n). + replace (y ^ S N) with (Cn 0%nat). * rewrite <- Rplus_assoc; rewrite (decomp_sum Cn N). -- replace (pred N) with n. ++ ring. ++ unfold N; simpl; reflexivity. -- unfold N; apply Nat.lt_0_succ. * unfold Cn; rewrite H; simpl; ring. + apply sum_eq. intros; apply H1. unfold N; apply Nat.le_lt_trans with n; [ assumption | apply Nat.lt_succ_diag_r ]. - reflexivity. } unfold An; fold N; rewrite Nat.sub_diag; rewrite H0; simpl; ring. ** apply sum_eq. intros; unfold An, Bn. change (S N - S i)%nat with (N - i)%nat. rewrite <- pascal; [ ring | apply Nat.le_lt_trans with n; [ assumption | unfold N; apply Nat.lt_succ_diag_r ] ]. ** unfold N; reflexivity. ++ unfold N; apply Nat.lt_0_succ. -- rewrite <- (Rmult_comm y); rewrite scal_sum; apply sum_eq. intros; replace (S N - i)%nat with (S (N - i)). ++ replace (S (N - i)) with (N - i + 1)%nat; [ idtac | ring ]. rewrite pow_add; replace (y ^ 1) with y; [ idtac | simpl; ring ]; ring. ++ symmetry; apply Nat.sub_succ_l; assumption. -- rewrite <- (Rmult_comm x); rewrite scal_sum; apply sum_eq. intros; replace (S i) with (i + 1)%nat; [ idtac | ring ]; rewrite pow_add; replace (x ^ 1) with x; [ idtac | simpl; ring ]; ring. + intro; unfold C. replace (INR (fact 0)) with 1; [ idtac | reflexivity ]. replace (p - 0)%nat with p; [ idtac | symmetry; apply Nat.sub_0_r ]. rewrite Rmult_1_l; unfold Rdiv; rewrite Rinv_r; [ reflexivity | apply INR_fact_neq_0 ]. + intro; unfold C. replace (p - p)%nat with 0%nat; [ idtac | symmetry; apply Nat.sub_diag ]. replace (INR (fact 0)) with 1; [ idtac | reflexivity ]. rewrite Rmult_1_r; unfold Rdiv; rewrite Rinv_r; [ reflexivity | apply INR_fact_neq_0 ]. Qed. coq-8.20.0/theories/Reals/Cauchy/000077500000000000000000000000001466560755400165115ustar00rootroot00000000000000coq-8.20.0/theories/Reals/Cauchy/ConstructiveCauchyAbs.v000066400000000000000000001063341466560755400231620ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * INRIA, CNRS and contributors - Copyright 1999-2019 *) (* ring_simplify a end. Local Ltac simplify_Qlt := match goal with |- (?l < ?r)%Q => ring_simplify l; ring_simplify r end. Local Lemma Qopp_mult_mone : forall q : Q, (-1 * q == -q)%Q. Proof. intros; ring. Qed. Local Lemma Qabs_involutive: forall q : Q, (Qabs (Qabs q) == Qabs q)%Q. Proof. intros q; apply Qabs_case; intros Hcase. - reflexivity. - pose proof Qabs_nonneg q as Habspos. pose proof Qle_antisym _ _ Hcase Habspos as Heq0. setoid_rewrite Heq0. reflexivity. Qed. (** The constructive formulation of the absolute value on the real numbers. This is followed by the constructive definitions of minimum and maximum, as min x y := (x + y - |x-y|) / 2. WARNING: this file is experimental and likely to change in future releases. *) (* If a rational sequence is Cauchy, then so is its absolute value. This is how the constructive absolute value is defined. A more abstract way to put it is the real numbers are the metric completion of the rational numbers, so the uniformly continuous function Qabs : Q -> Q uniquely extends to a uniformly continuous function CReal_abs : CReal -> CReal *) Definition CReal_abs_seq (x : CReal) (n : Z) := Qabs (seq x n). Definition CReal_abs_scale (x : CReal) := scale x. Lemma CReal_abs_cauchy: forall (x : CReal), QCauchySeq (CReal_abs_seq x). Proof. intros x n p q Hp Hq. pose proof (cauchy x n p q Hp Hq) as Hxbnd. apply (Qle_lt_trans _ (Qabs (seq x p - seq x q))). 2: exact Hxbnd. apply Qabs_Qle_condition. split. 2: apply Qabs_triangle_reverse. apply (Qplus_le_r _ _ (Qabs (seq x q))). rewrite <- Qabs_opp. apply (Qle_trans _ _ _ (Qabs_triangle_reverse _ _)). ring_simplify. unfold CReal_abs_seq. simplify_Qabs; setoid_rewrite Qopp_mult_mone. do 2 rewrite Qabs_opp. lra. Qed. Lemma CReal_abs_bound : forall (x : CReal), QBound (CReal_abs_seq x) (CReal_abs_scale x). Proof. intros x n. unfold CReal_abs_seq, CReal_abs_scale. rewrite Qabs_involutive. apply (bound x). Qed. Definition CReal_abs (x : CReal) : CReal := {| seq := CReal_abs_seq x; scale := CReal_abs_scale x; cauchy := CReal_abs_cauchy x; bound := CReal_abs_bound x |}. Lemma CRealLt_RQ_from_single_dist : forall (r : CReal) (q : Q) (n :Z), (2^n < q - seq r n)%Q -> r < inject_Q q. Proof. intros r q n Hapart. pose proof Qpower_0_lt 2 n ltac:(lra) as H2npos. destruct (QarchimedeanLowExp2_Z (q - seq r n - 2^n) ltac:(lra)) as [k Hk]. unfold CRealLt; exists (Z.min n (k-1))%Z. unfold inject_Q; rewrite CReal_red_seq. pose proof cauchy r n n (Z.min n (k-1))%Z ltac:(lia) ltac:(lia) as Hrbnd. pose proof Qpower_le_compat_l 2 (Z.min n (k - 1))%Z (k-1)%Z ltac:(lia) ltac:(lra). apply (Qmult_le_l _ _ 2 ltac:(lra)) in H. apply (Qle_lt_trans _ _ _ H); clear H. rewrite Qpower_minus_pos. simplify_Qlt. apply Qabs_Qlt_condition in Hrbnd. lra. Qed. Lemma CRealLe_0R_to_single_dist : forall (x : CReal) (n : Z), 0 <= x -> (-(2^n) <= seq x n)%Q. Proof. intros x n Hxnonneg. destruct (Qlt_le_dec (seq x n) (-(2^n))) as [Hdec|Hdec]. - exfalso; apply Hxnonneg. apply (CRealLt_RQ_from_single_dist x 0 n); lra. - exact Hdec. Qed. Lemma CReal_abs_right : forall x : CReal, 0 <= x -> CReal_abs x == x. Proof. intros x Hxnonneg; apply CRealEq_diff; intro n. unfold CReal_abs, CReal_abs_seq, CReal_abs_scale; rewrite CReal_red_seq. pose proof CRealLe_0R_to_single_dist x n Hxnonneg. pose proof Qpower_0_lt 2 n ltac:(lra) as Hpowpos. do 2 apply Qabs_case; intros H1 H2; lra. Qed. Lemma CReal_le_abs : forall x : CReal, x <= CReal_abs x. Proof. intros x [n nmaj]. unfold CReal_abs, CReal_abs_seq, CReal_abs_scale in nmaj; rewrite CReal_red_seq in nmaj. apply (Qle_not_lt _ _ (Qle_Qabs (seq x n))). apply Qlt_minus_iff. apply (Qlt_trans _ (2*2^n)). - pose proof Qpower_0_lt 2 n ltac:(lra); lra. - exact nmaj. Qed. Lemma CReal_abs_pos : forall x : CReal, 0 <= CReal_abs x. Proof. intros x [n nmaj]. unfold CReal_abs, CReal_abs_seq, CReal_abs_scale in nmaj; rewrite CReal_red_seq in nmaj. apply (Qle_not_lt _ _ (Qabs_nonneg (seq x n))). apply Qlt_minus_iff. apply (Qlt_trans _ (2*2^n)). - pose proof Qpower_0_lt 2 n ltac:(lra); lra. - exact nmaj. Qed. Lemma CReal_abs_opp : forall x : CReal, CReal_abs (-x) == CReal_abs x. Proof. intros x; apply CRealEq_diff; intro n. unfold CReal_abs, CReal_abs_seq, CReal_abs_scale; unfold CReal_opp, CReal_opp_seq, CReal_opp_scale; do 3 rewrite CReal_red_seq. rewrite Qabs_opp. simplify_Qabs. rewrite Qabs_pos by lra. pose proof Qpower_0_lt 2 n; lra. Qed. Lemma CReal_abs_left : forall x : CReal, x <= 0 -> CReal_abs x == -x. Proof. intros x Hxnonpos. apply CReal_opp_ge_le_contravar in Hxnonpos. rewrite CReal_opp_0 in Hxnonpos. rewrite <- CReal_abs_opp. apply CReal_abs_right, Hxnonpos. Qed. Lemma CReal_abs_appart_0 : forall x : CReal, 0 < CReal_abs x -> x # 0. Proof. intros x [n nmaj]. unfold CReal_abs, CReal_abs_seq, CReal_abs_scale in nmaj; rewrite CReal_red_seq in nmaj. destruct (Qlt_le_dec (seq x n) 0) as [Hdec|Hdec]. - left. exists n. cbn in nmaj |- * . rewrite Qabs_neg in nmaj; lra. - right. exists n. cbn. rewrite Qabs_pos in nmaj. + exact nmaj. + exact Hdec. Qed. Add Parametric Morphism : CReal_abs with signature CRealEq ==> CRealEq as CReal_abs_morph. Proof. intros. split. - intro abs. destruct (CReal_abs_appart_0 y). + apply (CReal_le_lt_trans _ (CReal_abs x)). * apply CReal_abs_pos. * apply abs. + rewrite CReal_abs_left, CReal_abs_left, H in abs. * exact (CRealLt_asym _ _ abs abs). * apply CRealLt_asym, c. * rewrite H. apply CRealLt_asym, c. + rewrite CReal_abs_right, CReal_abs_right, H in abs. * exact (CRealLt_asym _ _ abs abs). * apply CRealLt_asym, c. * rewrite H. apply CRealLt_asym, c. - intro abs. destruct (CReal_abs_appart_0 x). + apply (CReal_le_lt_trans _ (CReal_abs y)). * apply CReal_abs_pos. * apply abs. + rewrite CReal_abs_left, CReal_abs_left, H in abs. * exact (CRealLt_asym _ _ abs abs). * apply CRealLt_asym, c. * rewrite <- H. apply CRealLt_asym, c. + rewrite CReal_abs_right, CReal_abs_right, H in abs. * exact (CRealLt_asym _ _ abs abs). * apply CRealLt_asym, c. * rewrite <- H. apply CRealLt_asym, c. Qed. Lemma CReal_abs_le : forall a b:CReal, -b <= a <= b -> CReal_abs a <= b. Proof. intros a b H [n nmaj]. unfold CReal_abs, CReal_abs_seq, CReal_abs_scale in nmaj; rewrite CReal_red_seq in nmaj. destruct (Qlt_le_dec (seq a n) 0) as [Hdec|Hdec]. - rewrite Qabs_neg in nmaj by lra. destruct H as [Hl Hr]. apply Hl. clear Hl Hr. exists n; cbn. unfold CReal_opp_seq; lra. - rewrite Qabs_pos in nmaj. + destruct H as [Hl Hr]. apply Hr. clear Hl Hr. exists n; cbn. exact nmaj. + exact Hdec. Qed. Lemma CReal_abs_minus_sym : forall x y : CReal, CReal_abs (x - y) == CReal_abs (y - x). Proof. intros x y. setoid_replace (x - y) with (-(y-x)). - rewrite CReal_abs_opp. reflexivity. - ring. Qed. Lemma CReal_abs_lt : forall x y : CReal, CReal_abs x < y -> prod (x < y) (-x < y). Proof. split. - apply (CReal_le_lt_trans _ _ _ (CReal_le_abs x)), H. - apply (CReal_le_lt_trans _ _ _ (CReal_le_abs (-x))). rewrite CReal_abs_opp. exact H. Qed. Lemma CReal_abs_triang : forall x y : CReal, CReal_abs (x + y) <= CReal_abs x + CReal_abs y. Proof. intros. apply CReal_abs_le. split. - setoid_replace (x + y) with (-(-x - y)). 2: ring. apply CReal_opp_ge_le_contravar. apply CReal_plus_le_compat; rewrite <- CReal_abs_opp; apply CReal_le_abs. - apply CReal_plus_le_compat; apply CReal_le_abs. Qed. Lemma CReal_abs_triang_inv : forall x y : CReal, CReal_abs x - CReal_abs y <= CReal_abs (x - y). Proof. intros. apply (CReal_plus_le_reg_l (CReal_abs y)). ring_simplify. rewrite CReal_plus_comm. apply (CReal_le_trans _ (CReal_abs (x - y + y))). - setoid_replace (x - y + y) with x. + apply CRealLe_refl. + ring. - apply CReal_abs_triang. Qed. Lemma CReal_abs_triang_inv2 : forall x y : CReal, CReal_abs (CReal_abs x - CReal_abs y) <= CReal_abs (x - y). Proof. intros. apply CReal_abs_le. split. 2: apply CReal_abs_triang_inv. apply (CReal_plus_le_reg_r (CReal_abs y)). ring_simplify. rewrite CReal_plus_comm, CReal_abs_minus_sym. apply (CReal_le_trans _ _ _ (CReal_abs_triang_inv y (y-x))). setoid_replace (y - (y - x)) with x. 2: ring. apply CRealLe_refl. Qed. Lemma CReal_abs_gt : forall x : CReal, x < CReal_abs x -> x < 0. Proof. intros x [n nmaj]. unfold CReal_abs, CReal_abs_seq, CReal_abs_scale in nmaj; rewrite CReal_red_seq in nmaj. assert (seq x n < 0)%Q. { destruct (Qlt_le_dec (seq x n) 0) as [Hdec|Hdec]. - exact Hdec. - exfalso. rewrite Qabs_pos in nmaj by apply Hdec. pose proof Qpower_0_lt 2 n; lra. } rewrite Qabs_neg in nmaj by apply Qlt_le_weak, H. apply (CRealLt_RQ_from_single_dist _ _ n); lra. Qed. Lemma Rabs_def1 : forall x y : CReal, x < y -> -x < y -> CReal_abs x < y. Proof. intros x y Hxlty Hmxlty. apply CRealLt_above in Hxlty. apply CRealLt_above in Hmxlty. destruct Hxlty as [i imaj]. destruct Hmxlty as [j jmaj]. specialize (imaj (Z.min i j) ltac:(lia)). specialize (jmaj (Z.min i j) ltac:(lia)). cbn in jmaj; unfold CReal_opp_seq in jmaj. exists (Z.min i j). unfold CReal_abs, CReal_abs_seq, CReal_abs_scale; rewrite CReal_red_seq. pose proof Qpower_0_lt 2 (Z.min i j)%Z ltac:(lra) as Hpowij. pose proof Qpower_le_compat_l 2 (Z.min i j)%Z i ltac:(lia) ltac:(lra) as Hpowlei. pose proof Qpower_le_compat_l 2 (Z.min i j)%Z j ltac:(lia) ltac:(lra) as Hpowlej. apply Qabs_case; intros Hcase; lra. Qed. (* The proof by cases on the signs of x and y applies constructively, because of the positivity hypotheses. *) Lemma CReal_abs_mult : forall x y : CReal, CReal_abs (x * y) == CReal_abs x * CReal_abs y. Proof. assert (forall x y : CReal, x # 0 -> y # 0 -> CReal_abs (x * y) == CReal_abs x * CReal_abs y) as prep. { intros. destruct H, H0. - rewrite CReal_abs_right, CReal_abs_left, CReal_abs_left. + ring. + apply CRealLt_asym, c0. + apply CRealLt_asym, c. + setoid_replace (x*y) with (- x * - y). * apply CRealLt_asym, CReal_mult_lt_0_compat. -- rewrite <- CReal_opp_0. apply CReal_opp_gt_lt_contravar, c. -- rewrite <- CReal_opp_0. apply CReal_opp_gt_lt_contravar, c0. * ring. - rewrite CReal_abs_left, CReal_abs_left, CReal_abs_right. + ring. + apply CRealLt_asym, c0. + apply CRealLt_asym, c. + rewrite <- (CReal_mult_0_l y). apply CReal_mult_le_compat_r. * apply CRealLt_asym, c0. * apply CRealLt_asym, c. - rewrite CReal_abs_left, CReal_abs_right, CReal_abs_left. + ring. + apply CRealLt_asym, c0. + apply CRealLt_asym, c. + rewrite <- (CReal_mult_0_r x). apply CReal_mult_le_compat_l. * apply CRealLt_asym, c. * apply CRealLt_asym, c0. - rewrite CReal_abs_right, CReal_abs_right, CReal_abs_right. + ring. + apply CRealLt_asym, c0. + apply CRealLt_asym, c. + apply CRealLt_asym, CReal_mult_lt_0_compat; assumption. } split. - intro abs. assert (0 < CReal_abs x * CReal_abs y). { apply (CReal_le_lt_trans _ (CReal_abs (x*y))). - apply CReal_abs_pos. - exact abs. } pose proof (CReal_mult_pos_appart_zero _ _ H). rewrite CReal_mult_comm in H. apply CReal_mult_pos_appart_zero in H. destruct H. 2: apply (CReal_abs_pos y c). destruct H0. 2: apply (CReal_abs_pos x c0). apply CReal_abs_appart_0 in c. apply CReal_abs_appart_0 in c0. rewrite (prep x y) in abs. + exact (CRealLt_asym _ _ abs abs). + exact c0. + exact c. - intro abs. assert (0 < CReal_abs (x * y)). { apply (CReal_le_lt_trans _ (CReal_abs x * CReal_abs y)). - rewrite <- (CReal_mult_0_l (CReal_abs y)). apply CReal_mult_le_compat_r. + apply CReal_abs_pos. + apply CReal_abs_pos. - exact abs. } apply CReal_abs_appart_0 in H. destruct H. + apply CReal_opp_gt_lt_contravar in c. rewrite CReal_opp_0, CReal_opp_mult_distr_l in c. pose proof (CReal_mult_pos_appart_zero _ _ c). rewrite CReal_mult_comm in c. apply CReal_mult_pos_appart_zero in c. rewrite (prep x y) in abs. * exact (CRealLt_asym _ _ abs abs). * destruct H. -- left. apply CReal_opp_gt_lt_contravar in c0. rewrite CReal_opp_involutive, CReal_opp_0 in c0. exact c0. -- right. apply CReal_opp_gt_lt_contravar in c0. rewrite CReal_opp_involutive, CReal_opp_0 in c0. exact c0. * destruct c. -- right. exact c. -- left. exact c. + pose proof (CReal_mult_pos_appart_zero _ _ c). rewrite CReal_mult_comm in c. apply CReal_mult_pos_appart_zero in c. rewrite (prep x y) in abs. * exact (CRealLt_asym _ _ abs abs). * destruct H. -- right. exact c0. -- left. exact c0. * destruct c. -- right. exact c. -- left. exact c. Qed. Lemma CReal_abs_def2 : forall x a:CReal, CReal_abs x <= a -> (x <= a) /\ (- a <= x). Proof. split. - exact (CReal_le_trans _ _ _ (CReal_le_abs _) H). - rewrite <- (CReal_opp_involutive x). apply CReal_opp_ge_le_contravar. rewrite <- CReal_abs_opp in H. exact (CReal_le_trans _ _ _ (CReal_le_abs _) H). Qed. (* Min and max *) Definition CReal_min (x y : CReal) : CReal := (x + y - CReal_abs (y - x)) * inject_Q (1#2). Definition CReal_max (x y : CReal) : CReal := (x + y + CReal_abs (y - x)) * inject_Q (1#2). Add Parametric Morphism : CReal_min with signature CRealEq ==> CRealEq ==> CRealEq as CReal_min_morph. Proof. intros. unfold CReal_min. rewrite H, H0. reflexivity. Qed. Add Parametric Morphism : CReal_max with signature CRealEq ==> CRealEq ==> CRealEq as CReal_max_morph. Proof. intros. unfold CReal_max. rewrite H, H0. reflexivity. Qed. Lemma CReal_double : forall x:CReal, 2 * x == x + x. Proof. intro x. rewrite (inject_Q_plus 1 1). ring. Qed. Lemma CReal_max_lub : forall x y z:CReal, x <= z -> y <= z -> CReal_max x y <= z. Proof. intros. unfold CReal_max. apply (CReal_mult_le_reg_r 2). - apply inject_Q_lt; reflexivity. - rewrite CReal_mult_assoc, <- inject_Q_mult. setoid_replace ((1 # 2) * 2)%Q with 1%Q. 2: reflexivity. rewrite CReal_mult_1_r. apply (CReal_plus_le_reg_l (-x-y)). ring_simplify. apply CReal_abs_le. split. + unfold CReal_minus. repeat rewrite CReal_opp_plus_distr. do 2 rewrite CReal_opp_involutive. rewrite (CReal_plus_comm x), CReal_plus_assoc. apply CReal_plus_le_compat_l. apply (CReal_plus_le_reg_l (-x)). rewrite <- CReal_plus_assoc, CReal_plus_opp_l, CReal_plus_0_l. rewrite CReal_mult_comm, CReal_double. rewrite CReal_opp_plus_distr. apply CReal_plus_le_compat; apply CReal_opp_ge_le_contravar; assumption. + unfold CReal_minus. rewrite (CReal_plus_comm y), CReal_plus_assoc. apply CReal_plus_le_compat_l. apply (CReal_plus_le_reg_l y). rewrite <- CReal_plus_assoc, CReal_plus_opp_r, CReal_plus_0_l. rewrite CReal_mult_comm, CReal_double. apply CReal_plus_le_compat; assumption. Qed. Lemma CReal_min_glb : forall x y z:CReal, z <= x -> z <= y -> z <= CReal_min x y. Proof. intros. unfold CReal_min. apply (CReal_mult_le_reg_r 2). - apply inject_Q_lt; reflexivity. - rewrite CReal_mult_assoc, <- inject_Q_mult. setoid_replace ((1 # 2) * 2)%Q with 1%Q. 2: reflexivity. rewrite CReal_mult_1_r. apply (CReal_plus_le_reg_l (CReal_abs(y-x) - (z*2))). ring_simplify. apply CReal_abs_le. split. + unfold CReal_minus. repeat rewrite CReal_opp_plus_distr. rewrite CReal_opp_mult_distr_l, CReal_opp_involutive. rewrite (CReal_plus_comm (z*2)), (CReal_plus_comm y), CReal_plus_assoc. apply CReal_plus_le_compat_l, (CReal_plus_le_reg_r y). rewrite CReal_plus_assoc, CReal_plus_opp_l, CReal_plus_0_r. rewrite CReal_mult_comm, CReal_double. apply CReal_plus_le_compat; assumption. + unfold CReal_minus. rewrite (CReal_plus_comm y). apply CReal_plus_le_compat. 2: apply CRealLe_refl. apply (CReal_plus_le_reg_r (-x)). rewrite CReal_plus_assoc, CReal_plus_opp_r, CReal_plus_0_r. rewrite CReal_mult_comm, CReal_double. apply CReal_plus_le_compat; apply CReal_opp_ge_le_contravar; assumption. Qed. Lemma CReal_max_l : forall x y : CReal, x <= CReal_max x y. Proof. intros. unfold CReal_max. apply (CReal_mult_le_reg_r 2). - apply inject_Q_lt; reflexivity. - rewrite CReal_mult_assoc, <- inject_Q_mult. setoid_replace ((1 # 2) * 2)%Q with 1%Q. 2: reflexivity. rewrite CReal_mult_1_r. rewrite CReal_mult_comm, CReal_double. rewrite CReal_plus_assoc. apply CReal_plus_le_compat_l. apply (CReal_plus_le_reg_l (-y)). rewrite <- CReal_plus_assoc, CReal_plus_opp_l, CReal_plus_0_l. rewrite CReal_abs_minus_sym, CReal_plus_comm. apply CReal_le_abs. Qed. Lemma CReal_max_r : forall x y : CReal, y <= CReal_max x y. Proof. intros. unfold CReal_max. apply (CReal_mult_le_reg_r 2). - apply inject_Q_lt; reflexivity. - rewrite CReal_mult_assoc, <- inject_Q_mult. setoid_replace ((1 # 2) * 2)%Q with 1%Q. 2: reflexivity. rewrite CReal_mult_1_r. rewrite CReal_mult_comm, CReal_double. rewrite (CReal_plus_comm x). rewrite CReal_plus_assoc. apply CReal_plus_le_compat_l. apply (CReal_plus_le_reg_l (-x)). rewrite <- CReal_plus_assoc, CReal_plus_opp_l, CReal_plus_0_l. rewrite CReal_plus_comm. apply CReal_le_abs. Qed. Lemma CReal_min_l : forall x y : CReal, CReal_min x y <= x. Proof. intros. unfold CReal_min. apply (CReal_mult_le_reg_r 2). - apply inject_Q_lt; reflexivity. - rewrite CReal_mult_assoc, <- inject_Q_mult. setoid_replace ((1 # 2) * 2)%Q with 1%Q. 2: reflexivity. rewrite CReal_mult_1_r. rewrite CReal_mult_comm, CReal_double. unfold CReal_minus. rewrite CReal_plus_assoc. apply CReal_plus_le_compat_l. apply (CReal_plus_le_reg_l (CReal_abs (y + - x)+ -x)). ring_simplify. rewrite CReal_plus_comm. apply CReal_le_abs. Qed. Lemma CReal_min_r : forall x y : CReal, CReal_min x y <= y. Proof. intros. unfold CReal_min. apply (CReal_mult_le_reg_r 2). - apply inject_Q_lt; reflexivity. - rewrite CReal_mult_assoc, <- inject_Q_mult. setoid_replace ((1 # 2) * 2)%Q with 1%Q. 2: reflexivity. rewrite CReal_mult_1_r. rewrite CReal_mult_comm, CReal_double. unfold CReal_minus. rewrite (CReal_plus_comm x). rewrite CReal_plus_assoc. apply CReal_plus_le_compat_l. apply (CReal_plus_le_reg_l (CReal_abs (y + - x)+ -y)). ring_simplify. fold (y-x). rewrite CReal_abs_minus_sym. rewrite CReal_plus_comm. apply CReal_le_abs. Qed. Lemma CReal_min_left : forall x y : CReal, x <= y -> CReal_min x y == x. Proof. intros. unfold CReal_min. apply (CReal_mult_eq_reg_r 2). 2: right; apply inject_Q_lt; reflexivity. rewrite CReal_mult_assoc, <- inject_Q_mult. setoid_replace ((1 # 2) * 2)%Q with 1%Q. 2: reflexivity. rewrite CReal_mult_1_r. rewrite CReal_mult_comm, CReal_double. rewrite CReal_abs_right. - ring. - rewrite <- (CReal_plus_opp_r x). apply CReal_plus_le_compat. + exact H. + apply CRealLe_refl. Qed. Lemma CReal_min_right : forall x y : CReal, y <= x -> CReal_min x y == y. Proof. intros. unfold CReal_min. apply (CReal_mult_eq_reg_r 2). 2: right; apply inject_Q_lt; reflexivity. rewrite CReal_mult_assoc, <- inject_Q_mult. setoid_replace ((1 # 2) * 2)%Q with 1%Q. 2: reflexivity. rewrite CReal_mult_1_r. rewrite CReal_mult_comm, CReal_double. rewrite CReal_abs_left. - ring. - rewrite <- (CReal_plus_opp_r x). apply CReal_plus_le_compat. + exact H. + apply CRealLe_refl. Qed. Lemma CReal_max_left : forall x y : CReal, y <= x -> CReal_max x y == x. Proof. intros. unfold CReal_max. apply (CReal_mult_eq_reg_r 2). 2: right; apply inject_Q_lt; reflexivity. rewrite CReal_mult_assoc, <- inject_Q_mult. setoid_replace ((1 # 2) * 2)%Q with 1%Q. 2: reflexivity. rewrite CReal_mult_1_r. rewrite CReal_mult_comm, CReal_double. rewrite CReal_abs_left. - ring. - rewrite <- (CReal_plus_opp_r x). apply CReal_plus_le_compat. + exact H. + apply CRealLe_refl. Qed. Lemma CReal_max_right : forall x y : CReal, x <= y -> CReal_max x y == y. Proof. intros. unfold CReal_max. apply (CReal_mult_eq_reg_r 2). 2: right; apply inject_Q_lt; reflexivity. rewrite CReal_mult_assoc, <- inject_Q_mult. setoid_replace ((1 # 2) * 2)%Q with 1%Q. 2: reflexivity. rewrite CReal_mult_1_r. rewrite CReal_mult_comm, CReal_double. rewrite CReal_abs_right. - ring. - rewrite <- (CReal_plus_opp_r x). apply CReal_plus_le_compat. + exact H. + apply CRealLe_refl. Qed. Lemma CReal_min_lt_r : forall x y : CReal, CReal_min x y < y -> CReal_min x y == x. Proof. intros. unfold CReal_min. unfold CReal_min in H. apply (CReal_mult_eq_reg_r 2). 2: right; apply inject_Q_lt; reflexivity. rewrite CReal_mult_assoc, <- inject_Q_mult. setoid_replace ((1 # 2) * 2)%Q with 1%Q. 2: reflexivity. rewrite CReal_mult_1_r. rewrite CReal_mult_comm, CReal_double. rewrite CReal_abs_right. { ring. } apply (CReal_mult_lt_compat_r 2) in H. 2: apply inject_Q_lt; reflexivity. rewrite CReal_mult_assoc, <- inject_Q_mult in H. setoid_replace ((1 # 2) * 2)%Q with 1%Q in H. 2: reflexivity. rewrite CReal_mult_1_r in H. rewrite CReal_mult_comm, CReal_double in H. intro abs. rewrite CReal_abs_left in H. - unfold CReal_minus in H. rewrite CReal_opp_involutive, CReal_plus_comm in H. rewrite CReal_plus_assoc, <- (CReal_plus_assoc (-x)), CReal_plus_opp_l in H. rewrite CReal_plus_0_l in H. exact (CRealLt_asym _ _ H H). - apply CRealLt_asym, abs. Qed. Lemma posPartAbsMax : forall x : CReal, CReal_max 0 x == (x + CReal_abs x) * (inject_Q (1#2)). Proof. split. - intro abs. apply (CReal_mult_lt_compat_r 2) in abs. 2: apply (inject_Q_lt 0 2); reflexivity. rewrite CReal_mult_assoc, <- (inject_Q_mult) in abs. setoid_replace ((1 # 2) * 2)%Q with 1%Q in abs. 2: reflexivity. rewrite CReal_mult_1_r in abs. apply (CReal_plus_lt_compat_l (-x)) in abs. rewrite <- CReal_plus_assoc, CReal_plus_opp_l, CReal_plus_0_l in abs. apply CReal_abs_le in abs. { exact abs. } split. + rewrite CReal_opp_plus_distr, CReal_opp_involutive. apply (CReal_le_trans _ (x + 0)). 2: rewrite CReal_plus_0_r; apply CRealLe_refl. apply CReal_plus_le_compat_l. apply (CReal_le_trans _ (2 * 0)). * rewrite CReal_opp_mult_distr_l, <- (CReal_mult_comm 2). apply CReal_mult_le_compat_l_half. -- apply inject_Q_lt. reflexivity. -- apply (CReal_plus_le_reg_l (CReal_max 0 x)). rewrite CReal_plus_opp_r, CReal_plus_0_r. apply CReal_max_l. * rewrite CReal_mult_0_r. apply CRealLe_refl. + apply (CReal_plus_le_reg_l x). rewrite <- CReal_plus_assoc, CReal_plus_opp_r, CReal_plus_0_l. rewrite (inject_Q_plus 1 1), CReal_mult_plus_distr_l, CReal_mult_1_r. apply CReal_plus_le_compat; apply CReal_max_r. - apply CReal_max_lub. + rewrite <- (CReal_mult_0_l (inject_Q (1#2))). do 2 rewrite <- (CReal_mult_comm (inject_Q (1#2))). apply CReal_mult_le_compat_l_half. * apply inject_Q_lt; reflexivity. * rewrite <- (CReal_plus_opp_r x). apply CReal_plus_le_compat_l. rewrite <- CReal_abs_opp. apply CReal_le_abs. + intros abs. apply (CReal_mult_lt_compat_r 2) in abs. 2: apply inject_Q_lt; reflexivity. rewrite CReal_mult_assoc, <- inject_Q_mult in abs. setoid_replace ((1 # 2) * 2)%Q with 1%Q in abs. 2: reflexivity. rewrite CReal_mult_1_r, (inject_Q_plus 1 1), CReal_mult_plus_distr_l, CReal_mult_1_r in abs. apply CReal_plus_lt_reg_l in abs. exact (CReal_le_abs x abs). Qed. Lemma negPartAbsMin : forall x : CReal, CReal_min 0 x == (x - CReal_abs x) * (inject_Q (1#2)). Proof. split. - intro abs. apply (CReal_mult_lt_compat_r 2) in abs. 2: apply (inject_Q_lt 0 2); reflexivity. rewrite CReal_mult_assoc, <- (inject_Q_mult) in abs. setoid_replace ((1 # 2) * 2)%Q with 1%Q in abs. 2: reflexivity. rewrite CReal_mult_1_r in abs. apply (CReal_plus_lt_compat_r (CReal_abs x)) in abs. unfold CReal_minus in abs. rewrite CReal_plus_assoc, CReal_plus_opp_l, CReal_plus_0_r in abs. apply (CReal_plus_lt_compat_l (-(CReal_min 0 x * 2))) in abs. rewrite <- CReal_plus_assoc, CReal_plus_opp_l, CReal_plus_0_l in abs. apply CReal_abs_lt in abs. destruct abs. apply (CReal_plus_lt_compat_l (CReal_min 0 x * 2)) in c0. rewrite <- CReal_plus_assoc, CReal_plus_opp_r, CReal_plus_0_l in c0. apply (CReal_plus_lt_compat_r x) in c0. rewrite CReal_plus_assoc, CReal_plus_opp_l, CReal_plus_0_r in c0. rewrite <- CReal_double, CReal_mult_comm in c0. apply CReal_mult_lt_reg_l in c0. + apply CReal_min_lt_r in c0. rewrite c0, CReal_mult_0_l, CReal_opp_0, CReal_plus_0_l in c. exact (CRealLt_asym _ _ c c). + apply inject_Q_lt; reflexivity. - intro abs. assert ((x - CReal_abs x) * inject_Q (1 # 2) < 0 * inject_Q (1 # 2)). { rewrite CReal_mult_0_l. apply (CReal_lt_le_trans _ _ _ abs). apply CReal_min_l. } apply CReal_mult_lt_reg_r in H. 2: apply inject_Q_lt; reflexivity. rewrite <- (CReal_plus_opp_r (CReal_abs x)) in H. apply CReal_plus_lt_reg_r, CReal_abs_gt in H. rewrite CReal_min_right, <- CReal_abs_opp, CReal_abs_right in abs. + unfold CReal_minus in abs. rewrite CReal_opp_involutive, <- CReal_double, CReal_mult_comm in abs. rewrite <- CReal_mult_assoc, <- inject_Q_mult in abs. setoid_replace ((1 # 2) * 2)%Q with 1%Q in abs. * rewrite CReal_mult_1_l in abs. exact (CRealLt_asym _ _ abs abs). * reflexivity. + rewrite <- CReal_opp_0. apply CReal_opp_ge_le_contravar, CRealLt_asym, H. + apply CRealLt_asym, H. Qed. Lemma CReal_min_sym : forall (x y : CReal), CReal_min x y == CReal_min y x. Proof. intros. unfold CReal_min. rewrite CReal_abs_minus_sym. ring. Qed. Lemma CReal_max_sym : forall (x y : CReal), CReal_max x y == CReal_max y x. Proof. intros. unfold CReal_max. rewrite CReal_abs_minus_sym. ring. Qed. Lemma CReal_min_mult : forall (p q r:CReal), 0 <= r -> CReal_min (r * p) (r * q) == r * CReal_min p q. Proof. intros p q r H. unfold CReal_min. setoid_replace (r * q - r * p) with (r * (q - p)). 2: ring. rewrite CReal_abs_mult. rewrite (CReal_abs_right r). - ring. - exact H. Qed. Lemma CReal_min_plus : forall (x y z : CReal), x + CReal_min y z == CReal_min (x + y) (x + z). Proof. intros. unfold CReal_min. setoid_replace (x + z - (x + y)) with (z-y). 2: ring. apply (CReal_mult_eq_reg_r 2). 2: right; apply inject_Q_lt; reflexivity. rewrite CReal_mult_plus_distr_r. rewrite CReal_mult_assoc, <- inject_Q_mult. setoid_replace ((1 # 2) * 2)%Q with 1%Q. 2: reflexivity. rewrite CReal_mult_1_r. rewrite CReal_mult_assoc, <- inject_Q_mult. setoid_replace ((1 # 2) * 2)%Q with 1%Q. 2: reflexivity. rewrite CReal_mult_1_r. rewrite CReal_mult_comm, CReal_double. ring. Qed. Lemma CReal_max_plus : forall (x y z : CReal), x + CReal_max y z == CReal_max (x + y) (x + z). Proof. intros. unfold CReal_max. setoid_replace (x + z - (x + y)) with (z-y). 2: ring. apply (CReal_mult_eq_reg_r 2). 2: right; apply inject_Q_lt; reflexivity. rewrite CReal_mult_plus_distr_r. rewrite CReal_mult_assoc, <- inject_Q_mult. setoid_replace ((1 # 2) * 2)%Q with 1%Q. 2: reflexivity. rewrite CReal_mult_1_r. rewrite CReal_mult_assoc, <- inject_Q_mult. setoid_replace ((1 # 2) * 2)%Q with 1%Q. 2: reflexivity. rewrite CReal_mult_1_r. rewrite CReal_mult_comm, CReal_double. ring. Qed. Lemma CReal_min_lt : forall x y z : CReal, z < x -> z < y -> z < CReal_min x y. Proof. intros. unfold CReal_min. apply (CReal_mult_lt_reg_r 2). { apply inject_Q_lt; reflexivity. } rewrite CReal_mult_assoc, <- inject_Q_mult. setoid_replace ((1 # 2) * 2)%Q with 1%Q. 2: reflexivity. rewrite CReal_mult_1_r. apply (CReal_plus_lt_reg_l (CReal_abs (y - x) - (z*2))). ring_simplify. apply Rabs_def1. - unfold CReal_minus. rewrite <- (CReal_plus_comm y). apply CReal_plus_lt_compat_l. apply (CReal_plus_lt_reg_r (-x)). rewrite CReal_plus_assoc, CReal_plus_opp_r, CReal_plus_0_r. rewrite <- CReal_double, CReal_mult_comm. apply CReal_mult_lt_compat_r. + apply inject_Q_lt; reflexivity. + apply CReal_opp_gt_lt_contravar, H. - unfold CReal_minus. rewrite CReal_opp_plus_distr, CReal_opp_involutive. rewrite CReal_plus_comm, (CReal_plus_comm (-z*2)), CReal_plus_assoc. apply CReal_plus_lt_compat_l. apply (CReal_plus_lt_reg_r (-y)). rewrite CReal_plus_assoc, CReal_plus_opp_r, CReal_plus_0_r. rewrite <- CReal_double, CReal_mult_comm. apply CReal_mult_lt_compat_r. + apply inject_Q_lt; reflexivity. + apply CReal_opp_gt_lt_contravar, H0. Qed. Lemma CReal_max_assoc : forall a b c : CReal, CReal_max a (CReal_max b c) == CReal_max (CReal_max a b) c. Proof. split. - apply CReal_max_lub. + apply CReal_max_lub. * apply CReal_max_l. * apply (CReal_le_trans _ (CReal_max b c)). -- apply CReal_max_l. -- apply CReal_max_r. + apply (CReal_le_trans _ (CReal_max b c)). * apply CReal_max_r. * apply CReal_max_r. - apply CReal_max_lub. + apply (CReal_le_trans _ (CReal_max a b)). * apply CReal_max_l. * apply CReal_max_l. + apply CReal_max_lub. * apply (CReal_le_trans _ (CReal_max a b)). -- apply CReal_max_r. -- apply CReal_max_l. * apply CReal_max_r. Qed. Lemma CReal_min_max_mult_neg : forall (p q r:CReal), r <= 0 -> CReal_min (r * p) (r * q) == r * CReal_max p q. Proof. intros p q r H. unfold CReal_min, CReal_max. setoid_replace (r * q - r * p) with (r * (q - p)). 2: ring. rewrite CReal_abs_mult. rewrite (CReal_abs_left r). - ring. - exact H. Qed. Lemma CReal_min_assoc : forall a b c : CReal, CReal_min a (CReal_min b c) == CReal_min (CReal_min a b) c. Proof. split. - apply CReal_min_glb. + apply (CReal_le_trans _ (CReal_min a b)). * apply CReal_min_l. * apply CReal_min_l. + apply CReal_min_glb. * apply (CReal_le_trans _ (CReal_min a b)). -- apply CReal_min_l. -- apply CReal_min_r. * apply CReal_min_r. - apply CReal_min_glb. + apply CReal_min_glb. * apply CReal_min_l. * apply (CReal_le_trans _ (CReal_min b c)). -- apply CReal_min_r. -- apply CReal_min_l. + apply (CReal_le_trans _ (CReal_min b c)). * apply CReal_min_r. * apply CReal_min_r. Qed. Lemma CReal_max_lub_lt : forall x y z : CReal, x < z -> y < z -> CReal_max x y < z. Proof. intros. unfold CReal_max. apply (CReal_mult_lt_reg_r 2). { apply inject_Q_lt; reflexivity. } rewrite CReal_mult_assoc, <- inject_Q_mult. setoid_replace ((1 # 2) * 2)%Q with 1%Q. 2: reflexivity. rewrite CReal_mult_1_r. apply (CReal_plus_lt_reg_l (-x -y)). ring_simplify. apply Rabs_def1. - unfold CReal_minus. rewrite (CReal_plus_comm y), CReal_plus_assoc. apply CReal_plus_lt_compat_l. apply (CReal_plus_lt_reg_l y). rewrite <- CReal_plus_assoc, CReal_plus_opp_r, CReal_plus_0_l. rewrite <- CReal_double, CReal_mult_comm. apply CReal_mult_lt_compat_r. + apply inject_Q_lt; reflexivity. + exact H0. - unfold CReal_minus. rewrite CReal_opp_plus_distr, CReal_opp_involutive. rewrite (CReal_plus_comm (-x)), CReal_plus_assoc. apply CReal_plus_lt_compat_l. apply (CReal_plus_lt_reg_l x). rewrite <- CReal_plus_assoc, CReal_plus_opp_r, CReal_plus_0_l. rewrite <- CReal_double, CReal_mult_comm. apply CReal_mult_lt_compat_r. + apply inject_Q_lt; reflexivity. + apply H. Qed. Lemma CReal_max_contract : forall x y a : CReal, CReal_abs (CReal_max x a - CReal_max y a) <= CReal_abs (x - y). Proof. intros. unfold CReal_max. rewrite (CReal_abs_morph _ ((x - y + (CReal_abs (a - x) - CReal_abs (a - y))) * inject_Q (1 # 2))). 2: ring. rewrite CReal_abs_mult, (CReal_abs_right (inject_Q (1 # 2))). 2: apply inject_Q_le; discriminate. apply (CReal_le_trans _ ((CReal_abs (x - y) * 1 + CReal_abs (x-y) * 1) * inject_Q (1 # 2))). - apply CReal_mult_le_compat_r. + apply inject_Q_le. discriminate. + apply (CReal_le_trans _ (CReal_abs (x - y) + CReal_abs (CReal_abs (a - x) - CReal_abs (a - y)))). * apply CReal_abs_triang. * rewrite CReal_mult_1_r. apply CReal_plus_le_compat_l. rewrite (CReal_abs_minus_sym x y). rewrite (CReal_abs_morph (y-x) ((a-x)-(a-y))). -- apply CReal_abs_triang_inv2. -- unfold CReal_minus. rewrite (CReal_plus_comm (a + - x)). rewrite <- CReal_plus_assoc. apply CReal_plus_morph. 2: reflexivity. rewrite CReal_plus_comm, CReal_opp_plus_distr, <- CReal_plus_assoc. rewrite CReal_plus_opp_r, CReal_opp_involutive, CReal_plus_0_l. reflexivity. - rewrite <- CReal_mult_plus_distr_l, <- inject_Q_plus. rewrite CReal_mult_assoc, <- inject_Q_mult. setoid_replace ((1 + 1) * (1 # 2))%Q with 1%Q. 2: reflexivity. rewrite CReal_mult_1_r. apply CRealLe_refl. Qed. Lemma CReal_min_contract : forall x y a : CReal, CReal_abs (CReal_min x a - CReal_min y a) <= CReal_abs (x - y). Proof. intros. unfold CReal_min. rewrite (CReal_abs_morph _ ((x - y + (CReal_abs (a - y) - CReal_abs (a - x))) * inject_Q (1 # 2))). 2: ring. rewrite CReal_abs_mult, (CReal_abs_right (inject_Q (1 # 2))). 2: apply inject_Q_le; discriminate. apply (CReal_le_trans _ ((CReal_abs (x - y) * 1 + CReal_abs (x-y) * 1) * inject_Q (1 # 2))). - apply CReal_mult_le_compat_r. + apply inject_Q_le. discriminate. + apply (CReal_le_trans _ (CReal_abs (x - y) + CReal_abs (CReal_abs (a - y) - CReal_abs (a - x)))). * apply CReal_abs_triang. * rewrite CReal_mult_1_r. apply CReal_plus_le_compat_l. rewrite (CReal_abs_morph (x-y) ((a-y)-(a-x))). -- apply CReal_abs_triang_inv2. -- unfold CReal_minus. rewrite (CReal_plus_comm (a + - y)). rewrite <- CReal_plus_assoc. apply CReal_plus_morph. 2: reflexivity. rewrite CReal_plus_comm, CReal_opp_plus_distr, <- CReal_plus_assoc. rewrite CReal_plus_opp_r, CReal_opp_involutive, CReal_plus_0_l. reflexivity. - rewrite <- CReal_mult_plus_distr_l, <- inject_Q_plus. rewrite CReal_mult_assoc, <- inject_Q_mult. setoid_replace ((1 + 1) * (1 # 2))%Q with 1%Q. 2: reflexivity. rewrite CReal_mult_1_r. apply CRealLe_refl. Qed. coq-8.20.0/theories/Reals/Cauchy/ConstructiveCauchyReals.v000066400000000000000000000727121466560755400235250ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* un O) (fun q => O) which says nothing about the limit of un. We define sequences as Z -> Q instead of nat -> Q, so that we can compute arguments like 2^n fast. Todo: doc for Z->Q WARNING: this module is not meant to be imported directly, please import `Reals.Abstract.ConstructiveReals` instead. WARNING: this file is experimental and likely to change in future releases. *) Definition QCauchySeq (xn : Z -> Q) : Prop := forall (k : Z) (p q : Z), Z.le p k -> Z.le q k -> Qabs (xn p - xn q) < 2 ^ k. Definition QBound (xn : Z -> Q) (scale : Z) : Prop := forall (k : Z), Qabs (xn k) < 2 ^ scale. (* A Cauchy real is a sequence with a proof that the sequence is Cauchy *) Record CReal := mkCReal { seq : Z -> Q; scale : Z; cauchy : QCauchySeq seq; bound : QBound seq scale }. Declare Scope CReal_scope. (* Declare Scope R_scope with Key R *) Delimit Scope CReal_scope with CReal. (* Automatically open scope R_scope for arguments of type R *) Bind Scope CReal_scope with CReal. Local Open Scope CReal_scope. Definition CRealLt (x y : CReal) : Set := { n : Z | Qlt (2 * 2 ^ n) (seq y n - seq x n) }. Definition CRealLtProp (x y : CReal) : Prop := exists n : Z, Qlt (2 * 2 ^ n)(seq y n - seq x n). Definition CRealGt (x y : CReal) := CRealLt y x. Definition CReal_appart (x y : CReal) := sum (CRealLt x y) (CRealLt y x). Infix "<" := CRealLt : CReal_scope. Infix ">" := CRealGt : CReal_scope. Infix "#" := CReal_appart : CReal_scope. (* This Prop can be extracted as a sigma type *) Lemma CRealLtEpsilon : forall x y : CReal, CRealLtProp x y -> x < y. Proof. intros x y H. unfold CRealLtProp in H. apply constructive_indefinite_ground_description_Z in H. - apply H. - intros n. pose proof Qlt_le_dec (2 * 2 ^ n) (seq y n - seq x n) as Hdec. destruct Hdec as [H1|H1]. + left; exact H1. + right; apply Qle_not_lt in H1; exact H1. Qed. Lemma CRealLtForget : forall x y : CReal, x < y -> CRealLtProp x y. Proof. intros. destruct H. exists x0. exact q. Qed. (* CRealLt is decided by the LPO in Type, which is a non-constructive oracle. *) Lemma CRealLt_lpo_dec : forall x y : CReal, (forall (P : nat -> Prop), (forall n:nat, {P n} + {~P n}) -> {n | ~P n} + {forall n, P n}) -> CRealLt x y + (CRealLt x y -> False). Proof. intros x y lpo. destruct (lpo (fun n:nat => seq y (Z_inj_nat_rev n) - seq x (Z_inj_nat_rev n) <= 2 * 2 ^ (Z_inj_nat_rev n) )). - intro n. destruct (Qlt_le_dec (2 * 2 ^ (Z_inj_nat_rev n)) (seq y (Z_inj_nat_rev n) - seq x (Z_inj_nat_rev n))). + right; lra. + left; lra. - left; destruct s as [n nmaj]; exists (Z_inj_nat_rev n); lra. - right; intro abs; destruct abs as [n majn]. specialize (q (Z_inj_nat n)). rewrite Z_inj_nat_id in q. pose proof (Qle_not_lt _ _ q). contradiction. Qed. (* Alias the large order *) Definition CRealLe (x y : CReal) : Prop := CRealLt y x -> False. Definition CRealGe (x y : CReal) := CRealLe y x. Infix "<=" := CRealLe : CReal_scope. Infix ">=" := CRealGe : CReal_scope. Notation "x <= y <= z" := (x <= y /\ y <= z) : CReal_scope. Notation "x <= y < z" := (prod (x <= y) (y < z)) : CReal_scope. Notation "x < y < z" := (prod (x < y) (y < z)) : CReal_scope. Notation "x < y <= z" := (prod (x < y) (y <= z)) : CReal_scope. (* Alias the quotient order equality *) Definition CRealEq (x y : CReal) : Prop := (CRealLe y x) /\ (CRealLe x y). Infix "==" := CRealEq : CReal_scope. Lemma CRealLe_not_lt : forall x y : CReal, (forall n : Z, (seq x n - seq y n <= 2 * 2 ^ n)%Q) <-> x <= y. Proof. intros. split. - intros H H0. destruct H0 as [n H0]; specialize (H n); lra. - intros H n. destruct (Qlt_le_dec (2 * 2 ^ n) (seq x n - seq y n)). + exfalso. apply H. exists n. assumption. + assumption. Qed. Lemma CRealEq_diff : forall (x y : CReal), CRealEq x y <-> forall n:Z, ((Qabs (seq x n - seq y n)) <= (2 * 2 ^ n))%Q. Proof. intros x y; split. - intros H n; destruct H as [Hyx Hxy]. pose proof (CRealLe_not_lt x y) as [_ Hxy']. specialize (Hxy' Hxy n). pose proof (CRealLe_not_lt y x) as [_ Hyx']. specialize (Hyx' Hyx n). apply Qabs_Qle_condition; lra. - intros H; split; apply CRealLe_not_lt; intro n; specialize (H n); apply Qabs_Qle_condition in H; lra. Qed. (** If the elements x(n) and y(n) of two Cauchy sequences x and are apart by at least 2*eps(n), we can find a k such that all further elements of the sequences are apart by at least 2*eps(k) *) Lemma CRealLt_aboveSig : forall (x y : CReal) (n : Z), (2 * 2^n < seq y n - seq x n)%Q -> let (k, _) := QarchimedeanExp2_Z (/(seq y n - seq x n - (2 * 2 ^ n)%Q)) in forall p:Z, (p <= n)%Z -> (2^(-k) < seq y p - seq x p)%Q. Proof. intros x y n maj. destruct (QarchimedeanExp2_Z (/((seq y) n - (seq x) n - (2*2^n)%Q))) as [k kmaj]. intros p Hp. apply Qinv_lt_contravar in kmaj. 3: apply Qpower_0_lt; lra. 2: apply Qinv_lt_0_compat; lra. rewrite Qinv_involutive, <- Qpower_opp in kmaj; clear maj. pose proof ((cauchy x) n n p ltac:(lia) ltac:(lia)) as HCSx. pose proof ((cauchy y) n p n ltac:(lia) ltac:(lia)) as HCSy. rewrite Qabs_Qlt_condition in HCSx, HCSy. lra. Qed. (** This is a weakened form of CRealLt_aboveSig which a special shape of eps needed below *) Lemma CRealLt_aboveSig' : forall (x y : CReal) (n : Z), (2 * 2^n < seq y n - seq x n)%Q -> let (k, _) := QarchimedeanExp2_Z (/(seq y n - seq x n - (2 * 2 ^ n)%Q)) in forall p:Z, (p <= n)%Z -> (2 * 2^(Z.min (-k-1) n) < seq y p - seq x p)%Q. Proof. intros x y n Hapart. pose proof CRealLt_aboveSig x y n Hapart. destruct (QarchimedeanExp2_Z (/ (seq y n - seq x n - (2 * 2 ^ n)))) as [k kmaj]. intros p Hp; specialize (H p Hp). pose proof Qpower_le_compat_l 2 (Z.min (- k -1) n) (- k-1) (Z.le_min_l _ _) ltac:(lra) as H1. rewrite Qpower_minus_pos in H1. apply (Qmult_le_compat_r _ _ 2) in H1. 2: lra. ring_simplify in H1. exact (Qle_lt_trans _ _ _ H1 H). Qed. Lemma CRealLt_above : forall (x y : CReal), CRealLt x y -> { n : Z | forall p : Z, (p <= n)%Z -> (2 * 2 ^ n < seq y p - seq x p)%Q }. Proof. intros x y [n maj]. pose proof (CRealLt_aboveSig' x y n maj) as H. destruct (QarchimedeanExp2_Z (/ (seq y n - seq x n - (2 * 2 ^ n)))) as [k kmaj]. exists (Z.min (-k - 1) n)%Z; intros p Hp. apply H. lia. Qed. (* The CRealLt index separates the Cauchy sequences *) Lemma CRealLt_above_same : forall (x y : CReal) (n : Z), (2 * 2 ^ n < seq y n - seq x n)%Q -> forall p:Z, (p <= n)%Z -> Qlt (seq x p) (seq y p). Proof. intros x y n inf p H. simpl in inf |- *. pose proof ((cauchy x) n p n ltac:(lia) ltac:(lia)). pose proof ((cauchy y) n p n ltac:(lia) ltac:(lia)). rewrite Qabs_Qlt_condition in *. lra. Qed. Lemma CRealLt_asym : forall x y : CReal, x < y -> x <= y. Proof. intros x y H [n q]. apply CRealLt_above in H. destruct H as [p H]. pose proof (CRealLt_above_same y x n q). apply (Qlt_not_le (seq y (Z.min n p)) (seq x (Z.min n p))). - apply H0. apply Z.le_min_l. - apply Qlt_le_weak. apply (Qplus_lt_l _ _ (-seq x (Z.min n p))). rewrite Qplus_opp_r. apply (Qlt_trans _ (2*2^p)). + pose proof Qpower_0_lt 2 p ltac:(lra). lra. + apply H. lia. (* ToDo: use lra *) Qed. Lemma CRealLt_irrefl : forall x:CReal, x < x -> False. Proof. intros x abs. exact (CRealLt_asym x x abs abs). Qed. Lemma CRealLe_refl : forall x : CReal, x <= x. Proof. intros. intro abs. pose proof (CRealLt_asym x x abs). contradiction. Qed. Lemma CRealEq_refl : forall x : CReal, x == x. Proof. intros. split; apply CRealLe_refl. Qed. Lemma CRealEq_sym : forall x y : CReal, CRealEq x y -> CRealEq y x. Proof. intros. destruct H. split; intro abs; contradiction. Qed. Lemma CRealLt_dec : forall x y z : CReal, x < y -> sum (x < z) (z < y). Proof. intros x y z [n inf]. destruct (QarchimedeanExp2_Z (/((seq y) n - (seq x) n - (2 * 2 ^ n)))) as [k kmaj]. rewrite Qinv_lt_contravar, Qinv_involutive, <- Qpower_opp in kmaj. 3: apply Qpower_0_lt; lra. 2: apply Qinv_lt_0_compat; lra. destruct (Qlt_le_dec ((1#2) * ((seq y) n + (seq x) n)) ((seq z) (Z.min n (- k - 2)))) as [Hxyltz|Hzlexy]; [left; pose (cauchy x) as HCS|right; pose (cauchy y) as HCS]. all: exists (Z.min (n)%Z (-k - 2))%Z. all: specialize (HCS n n (Z.min n (-k-2))%Z ltac:(lia) ltac:(lia)). all: rewrite Qabs_Qlt_condition in HCS. all: assert (2 ^ Z.min n (- k - 2) <= 2 ^ (- k - 2))%Q as Hpowmin by (apply Qpower_le_compat_l; [lia|lra]). all: rewrite Qpower_minus_pos in Hpowmin; lra. Qed. Definition linear_order_T x y z := CRealLt_dec x z y. Lemma CReal_le_lt_trans : forall x y z : CReal, x <= y -> y < z -> x < z. Proof. intros x y z Hle Hlt. destruct (linear_order_T y x z Hlt) as [Hyltx|Hxltz]. - contradiction. - exact Hxltz. Qed. Lemma CReal_lt_le_trans : forall x y z : CReal, x < y -> y <= z -> x < z. Proof. intros x y z Hlt Hle. destruct (linear_order_T x z y Hlt) as [Hxltz|Hzlty]. - exact Hxltz. - contradiction. Qed. Lemma CReal_le_trans : forall x y z : CReal, x <= y -> y <= z -> x <= z. Proof. intros x y z Hxley Hylez contra. apply Hylez. apply (CReal_lt_le_trans _ x); assumption. Qed. Lemma CReal_lt_trans : forall x y z : CReal, x < y -> y < z -> x < z. Proof. intros x y z Hxlty Hyltz. apply (CReal_lt_le_trans _ y _ Hxlty). apply CRealLt_asym; exact Hyltz. Qed. Lemma CRealEq_trans : forall x y z : CReal, CRealEq x y -> CRealEq y z -> CRealEq x z. Proof. intros x y z Hxeqy Hyeqz. destruct Hxeqy as [Hylex Hxley]. destruct Hyeqz as [Hzley Hylez]. split. - intro contra. destruct (CRealLt_dec _ _ y contra); contradiction. - intro contra. destruct (CRealLt_dec _ _ y contra); contradiction. Qed. Add Parametric Relation : CReal CRealEq reflexivity proved by CRealEq_refl symmetry proved by CRealEq_sym transitivity proved by CRealEq_trans as CRealEq_rel. #[global] Instance CRealEq_relT : CRelationClasses.Equivalence CRealEq. Proof. split. - exact CRealEq_refl. - exact CRealEq_sym. - exact CRealEq_trans. Qed. #[global] Instance CRealLt_morph : CMorphisms.Proper (CMorphisms.respectful CRealEq (CMorphisms.respectful CRealEq CRelationClasses.iffT)) CRealLt. Proof. intros x y Hxeqy x0 y0 Hx0eqy0. destruct Hxeqy as [Hylex Hxley]. destruct Hx0eqy0 as [Hy0lex0 Hx0ley0]. split. - intro Hxltx0; destruct (CRealLt_dec x x0 y). + assumption. + contradiction. + destruct (CRealLt_dec y x0 y0). * assumption. * assumption. * contradiction. - intro Hylty0; destruct (CRealLt_dec y y0 x). + assumption. + contradiction. + destruct (CRealLt_dec x y0 x0). * assumption. * assumption. * contradiction. Qed. #[global] Instance CRealGt_morph : CMorphisms.Proper (CMorphisms.respectful CRealEq (CMorphisms.respectful CRealEq CRelationClasses.iffT)) CRealGt. Proof. intros x y Hxeqy x0 y0 Hx0eqy0. apply CRealLt_morph; assumption. Qed. #[global] Instance CReal_appart_morph : CMorphisms.Proper (CMorphisms.respectful CRealEq (CMorphisms.respectful CRealEq CRelationClasses.iffT)) CReal_appart. Proof. intros x y Hxeqy x0 y0 Hx0eqy0. split. - intros Hapart. destruct Hapart as [Hxltx0|Hx0ltx]. + left. rewrite <- Hx0eqy0, <- Hxeqy. exact Hxltx0. + right. rewrite <- Hx0eqy0, <- Hxeqy. exact Hx0ltx. - intros Hapart. destruct Hapart as [Hylty0|Hy0lty]. + left. rewrite Hx0eqy0, Hxeqy. exact Hylty0. + right. rewrite Hx0eqy0, Hxeqy. exact Hy0lty. Qed. Add Parametric Morphism : CRealLtProp with signature CRealEq ==> CRealEq ==> iff as CRealLtProp_morph. Proof. intros x y Hxeqy x0 y0 Hx0eqy0. split. - intro Hxltpx0. apply CRealLtForget. apply CRealLtEpsilon in Hxltpx0. rewrite <- Hxeqy, <- Hx0eqy0. exact Hxltpx0. - intro Hylty0. apply CRealLtForget. apply CRealLtEpsilon in Hylty0. rewrite Hxeqy, Hx0eqy0. exact Hylty0. Qed. Add Parametric Morphism : CRealLe with signature CRealEq ==> CRealEq ==> iff as CRealLe_morph. Proof. intros x y Hxeqy x0 y0 Hx0eqy0. split. - intros Hxlex0 Hyley0. unfold CRealLe in Hxlex0. rewrite <- Hx0eqy0 in Hyley0. rewrite <- Hxeqy in Hyley0. contradiction. - intros Hxlex0 Hyley0. unfold CRealLe in Hxlex0. rewrite Hx0eqy0 in Hyley0. rewrite Hxeqy in Hyley0. contradiction. Qed. Add Parametric Morphism : CRealGe with signature CRealEq ==> CRealEq ==> iff as CRealGe_morph. Proof. intros x y Hxeqy x0 y0 Hx0eqy0. unfold CRealGe. apply CRealLe_morph; assumption. Qed. Lemma CRealLt_proper_l : forall x y z : CReal, CRealEq x y -> CRealLt x z -> CRealLt y z. Proof. intros x y z Hxeqy Hxltz. apply (CRealLt_morph x y Hxeqy z z). - apply CRealEq_refl. - apply Hxltz. Qed. Lemma CRealLt_proper_r : forall x y z : CReal, CRealEq x y -> CRealLt z x -> CRealLt z y. Proof. intros x y z Hxeqy Hzltx. apply (CRealLt_morph z z (CRealEq_refl z) x y). - apply Hxeqy. - apply Hzltx. Qed. Lemma CRealLe_proper_l : forall x y z : CReal, CRealEq x y -> CRealLe x z -> CRealLe y z. Proof. intros x y z Hxeqy Hxlez. apply (CRealLe_morph x y Hxeqy z z). - apply CRealEq_refl. - apply Hxlez. Qed. Lemma CRealLe_proper_r : forall x y z : CReal, CRealEq x y -> CRealLe z x -> CRealLe z y. Proof. intros x y z Hxeqy Hzlex. apply (CRealLe_morph z z (CRealEq_refl z) x y). - apply Hxeqy. - apply Hzlex. Qed. (* Injection of Q into CReal *) Lemma inject_Q_cauchy : forall q : Q, QCauchySeq (fun _ => q). Proof. intros q k p r Hp Hr. apply Qabs_Qlt_condition. pose proof Qpower_0_lt 2 k; lra. Qed. Definition inject_Q (q : Q) : CReal := {| seq := (fun n : Z => q); scale := Qbound_ltabs_ZExp2 q; cauchy := inject_Q_cauchy q; bound := (fun _ : Z => Qbound_ltabs_ZExp2_spec q) |}. Definition inject_Z : Z -> CReal := fun n => inject_Q (n # 1). Notation "0" := (inject_Q 0) : CReal_scope. Notation "1" := (inject_Q 1) : CReal_scope. Notation "2" := (inject_Q 2) : CReal_scope. Lemma CRealLt_0_1 : CRealLt (inject_Q 0) (inject_Q 1). Proof. exists (-2)%Z; cbn; lra. Qed. Lemma CReal_injectQPos : forall q : Q, (0 < q)%Q -> CRealLt (inject_Q 0) (inject_Q q). Proof. intros q Hq. destruct (QarchimedeanExp2_Z ((2#1) / q)) as [k Hk]. exists (-k)%Z; cbn. apply (Qmult_lt_compat_r _ _ q) in Hk. 2: assumption. apply (Qmult_lt_compat_r _ _ (2^(-k))) in Hk. 2: apply Qpower_0_lt; lra. field_simplify in Hk. 2: lra. (* ToDo: field_simplify should collect powers - the next 3 lines ... *) rewrite <- Qmult_assoc, <- Qpower_plus in Hk by lra. ring_simplify (-k +k)%Z in Hk. rewrite Qpower_0_r in Hk. lra. Qed. Lemma inject_Q_compare : forall (x : CReal) (p : Z), x <= inject_Q (seq x p + (2^p)). Proof. intros x p [n nmaj]. cbn in nmaj. assert(2^n>0)%Q by (apply Qpower_0_lt; lra). assert(2^p>0)%Q by (apply Qpower_0_lt; lra). pose proof x.(cauchy) as xcau. destruct (Z.min_dec p n); [ specialize (xcau n n p ltac:(lia) ltac:(lia)) | specialize (xcau p n p ltac:(lia) ltac:(lia)) ]. all: apply Qabs_Qlt_condition in xcau; lra. Qed. Add Parametric Morphism : inject_Q with signature Qeq ==> CRealEq as inject_Q_morph. Proof. intros x y Heq; split. all: intros [n Hapart]; cbn in Hapart; rewrite Heq in Hapart. all: assert(2^n>0)%Q by (apply Qpower_0_lt; lra); lra. Qed. #[global] Instance inject_Q_morph_T : CMorphisms.Proper (CMorphisms.respectful Qeq CRealEq) inject_Q. Proof. intros x y Heq; split. all: intros [n Hapart]; cbn in Hapart; rewrite Heq in Hapart. all: assert(2^n>0)%Q by (apply Qpower_0_lt; lra); lra. Qed. (** * Algebraic operations *) (** We reduce the rational numbers to accelerate calculations. *) Definition CReal_plus_seq (x y : CReal) := (fun n : Z => Qred (seq x (n-1)%Z + seq y (n-1)%Z)). Definition CReal_plus_scale (x y : CReal) : Z := Z.max x.(scale) y.(scale) + 1. Lemma CReal_plus_cauchy : forall (x y : CReal), QCauchySeq (CReal_plus_seq x y). Proof. intros x y n p q Hp Hq. unfold CReal_plus_seq. pose proof ((cauchy x) (n-1)%Z (p-1)%Z (q-1)%Z ltac:(lia) ltac:(lia)) as Hxbnd. pose proof ((cauchy y) (n-1)%Z (p-1)%Z (q-1)%Z ltac:(lia) ltac:(lia)) as Hybnd. do 2 rewrite Qred_correct. rewrite Qabs_Qlt_condition in Hxbnd, Hybnd |- *. rewrite Qpower_minus_pos in Hxbnd, Hybnd. lra. Qed. Lemma CReal_plus_bound : forall (x y : CReal), QBound (CReal_plus_seq x y) (CReal_plus_scale x y). Proof. intros x y k. unfold CReal_plus_seq, CReal_plus_scale. pose proof (bound x (k-1)%Z) as Hxbnd. pose proof (bound y (k-1)%Z) as Hybnd. rewrite Qpower_plus by lra. pose proof Qpower_le_compat_l 2 (scale x) (Z.max (scale x) (scale y)) ltac:(lia) ltac:(lra) as Hxmax. pose proof Qpower_le_compat_l 2 (scale y) (Z.max (scale x) (scale y)) ltac:(lia) ltac:(lra) as Hymax. rewrite Qabs_Qlt_condition in Hxbnd, Hybnd |- *. rewrite Qred_correct. lra. Qed. Definition CReal_plus (x y : CReal) : CReal := {| seq := CReal_plus_seq x y; scale := CReal_plus_scale x y; cauchy := CReal_plus_cauchy x y; bound := CReal_plus_bound x y |}. Infix "+" := CReal_plus : CReal_scope. Definition CReal_opp_seq (x : CReal) := (fun n : Z => - seq x n). Definition CReal_opp_scale (x : CReal) : Z := x.(scale). Lemma CReal_opp_cauchy : forall (x : CReal), QCauchySeq (CReal_opp_seq x). Proof. intros x n p q Hp Hq; unfold CReal_opp_seq. pose proof ((cauchy x) n p q ltac:(lia) ltac:(lia)) as Hxbnd. rewrite Qabs_Qlt_condition in Hxbnd |- *. lra. Qed. Lemma CReal_opp_bound : forall (x : CReal), QBound (CReal_opp_seq x) (CReal_opp_scale x). Proof. intros x k. unfold CReal_opp_seq, CReal_opp_scale. pose proof (bound x k) as Hxbnd. rewrite Qabs_Qlt_condition in Hxbnd |- *. lra. Qed. Definition CReal_opp (x : CReal) : CReal := {| seq := CReal_opp_seq x; scale := CReal_opp_scale x; cauchy := CReal_opp_cauchy x; bound := CReal_opp_bound x |}. Notation "- x" := (CReal_opp x) : CReal_scope. Definition CReal_minus (x y : CReal) : CReal := CReal_plus x (CReal_opp y). Infix "-" := CReal_minus : CReal_scope. (* ToDo: make a tactic for this *) Lemma CReal_red_seq: forall (a : Z -> Q) (b : Z) (c : QCauchySeq a) (d : QBound a b), seq (mkCReal a b c d) = a. Proof. reflexivity. Qed. Lemma CReal_plus_assoc : forall (x y z : CReal), (x + y) + z == x + (y + z). Proof. intros x y z; apply CRealEq_diff; intro n. unfold CReal_plus, CReal_plus_seq. do 4 rewrite CReal_red_seq. do 4 rewrite Qred_correct. ring_simplify (n-1-1)%Z. pose proof ((cauchy x) (n-1)%Z (n-2)%Z (n-1)%Z ltac:(lia) ltac:(lia)) as Hxbnd. specialize ((cauchy z) (n-1)%Z (n-2)%Z (n-1)%Z ltac:(lia) ltac:(lia)) as Hzbnd. apply Qlt_le_weak. rewrite Qabs_Qlt_condition in Hxbnd, Hzbnd |- *. rewrite Qpower_minus_pos in Hxbnd, Hzbnd. lra. Qed. Lemma CReal_plus_comm : forall x y : CReal, x + y == y + x. Proof. intros x y; apply CRealEq_diff; intros n. unfold CReal_plus, CReal_plus_seq. do 2 rewrite CReal_red_seq. do 2 rewrite Qred_correct. pose proof ((cauchy x) (n-1)%Z (n-1)%Z (n-1)%Z ltac:(lia) ltac:(lia)) as Hxbnd. pose proof ((cauchy y) (n-1)%Z (n-1)%Z (n-1)%Z ltac:(lia) ltac:(lia)) as Hybnd. apply Qlt_le_weak. rewrite Qabs_Qlt_condition in Hxbnd, Hybnd |- *. rewrite Qpower_minus_pos in Hxbnd, Hybnd. lra. Qed. Lemma CReal_plus_0_l : forall r : CReal, inject_Q 0 + r == r. Proof. intros x; apply CRealEq_diff; intros n. unfold CReal_plus, CReal_plus_seq, inject_Q. do 2 rewrite CReal_red_seq. rewrite Qred_correct. pose proof ((cauchy x) (n)%Z (n-1)%Z (n)%Z ltac:(lia) ltac:(lia)) as Hxbnd. apply Qlt_le_weak. rewrite Qabs_Qlt_condition in Hxbnd |- *. lra. Qed. Lemma CReal_plus_0_r : forall r : CReal, r + 0 == r. Proof. intro r. rewrite CReal_plus_comm. apply CReal_plus_0_l. Qed. Lemma CReal_plus_lt_compat_l : forall x y z : CReal, y < z -> x + y < x + z. Proof. intros x y z Hlt. apply CRealLt_above in Hlt; destruct Hlt as [n Hapart]; exists n. unfold CReal_plus, CReal_plus_seq in Hapart |- *. do 2 rewrite CReal_red_seq. do 2 rewrite Qred_correct. specialize (Hapart (n-1)%Z ltac:(lia)). lra. Qed. Lemma CReal_plus_lt_compat_r : forall x y z : CReal, y < z -> y + x < z + x. Proof. intros x y z. do 2 rewrite <- (CReal_plus_comm x). apply CReal_plus_lt_compat_l. Qed. Lemma CReal_plus_lt_reg_l : forall x y z : CReal, x + y < x + z -> y < z. Proof. intros x y z Hlt. destruct Hlt as [n maj]; exists (n - 1)%Z. setoid_replace (seq z (n - 1)%Z - seq y (n - 1)%Z)%Q with (seq (CReal_plus x z) n - seq (CReal_plus x y) n)%Q. - rewrite Qpower_minus_pos. assert (2 ^ n > 0)%Q by (apply Qpower_0_lt; lra); lra. - unfold CReal_plus, CReal_plus_seq in maj |- *. do 2 rewrite CReal_red_seq in maj |- *. do 2 rewrite Qred_correct; ring. Qed. Lemma CReal_plus_lt_reg_r : forall x y z : CReal, y + x < z + x -> y < z. Proof. intros x y z Hlt. rewrite (CReal_plus_comm y), (CReal_plus_comm z) in Hlt. apply CReal_plus_lt_reg_l in Hlt; exact Hlt. Qed. Lemma CReal_plus_le_reg_l : forall x y z : CReal, x + y <= x + z -> y <= z. Proof. intros x y z Hlt contra. apply Hlt. apply CReal_plus_lt_compat_l; exact contra. Qed. Lemma CReal_plus_le_reg_r : forall x y z : CReal, y + x <= z + x -> y <= z. Proof. intros x y z Hlt contra. apply Hlt. apply CReal_plus_lt_compat_r; exact contra. Qed. Lemma CReal_plus_le_compat_l : forall r r1 r2, r1 <= r2 -> r + r1 <= r + r2. Proof. intros x y z Hlt contra. apply Hlt. apply CReal_plus_lt_reg_l in contra; exact contra. Qed. Lemma CReal_plus_le_lt_compat : forall r1 r2 r3 r4 : CReal, r1 <= r2 -> r3 < r4 -> r1 + r3 < r2 + r4. Proof. intros r1 r2 r3 r4 Hr1ler2 Hr3ltr4. apply CReal_le_lt_trans with (r2 + r3). - intro contra; rewrite CReal_plus_comm, (CReal_plus_comm r1) in contra. apply CReal_plus_lt_reg_l in contra. contradiction. - apply CReal_plus_lt_compat_l. exact Hr3ltr4. Qed. Lemma CReal_plus_le_compat : forall r1 r2 r3 r4 : CReal, r1 <= r2 -> r3 <= r4 -> r1 + r3 <= r2 + r4. Proof. intros r1 r2 r3 r4 Hr1ler2 Hr3ler4. apply CReal_le_trans with (r2 + r3). - intro contra; rewrite CReal_plus_comm, (CReal_plus_comm r1) in contra. apply CReal_plus_lt_reg_l in contra. contradiction. - apply CReal_plus_le_compat_l; exact Hr3ler4. Qed. Lemma CReal_plus_opp_r : forall x : CReal, x + - x == 0. Proof. intros x; apply CRealEq_diff; intros n. unfold CReal_plus, CReal_plus_seq, CReal_opp, CReal_opp_seq, inject_Q. do 3 rewrite CReal_red_seq. rewrite Qred_correct. pose proof ((cauchy x) (n)%Z (n-1)%Z (n)%Z ltac:(lia) ltac:(lia)) as Hxbnd. apply Qlt_le_weak. rewrite Qabs_Qlt_condition in Hxbnd |- *. lra. Qed. Lemma CReal_plus_opp_l : forall x : CReal, - x + x == 0. Proof. intro x. rewrite CReal_plus_comm. apply CReal_plus_opp_r. Qed. Lemma CReal_plus_proper_r : forall x y z : CReal, CRealEq x y -> CRealEq (CReal_plus x z) (CReal_plus y z). Proof. intros. apply (CRealEq_trans _ (CReal_plus z x)). - apply CReal_plus_comm. - apply (CRealEq_trans _ (CReal_plus z y)). 2: apply CReal_plus_comm. split. + intro abs. apply CReal_plus_lt_reg_l in abs. destruct H. contradiction. + intro abs. apply CReal_plus_lt_reg_l in abs. destruct H. contradiction. Qed. Lemma CReal_plus_proper_l : forall x y z : CReal, CRealEq x y -> CRealEq (CReal_plus z x) (CReal_plus z y). Proof. intros. split. - intro abs. apply CReal_plus_lt_reg_l in abs. destruct H. contradiction. - intro abs. apply CReal_plus_lt_reg_l in abs. destruct H. contradiction. Qed. Add Parametric Morphism : CReal_plus with signature CRealEq ==> CRealEq ==> CRealEq as CReal_plus_morph. Proof. intros x y H z t H0. apply (CRealEq_trans _ (CReal_plus x t)). - destruct H0. split. + intro abs. apply CReal_plus_lt_reg_l in abs. contradiction. + intro abs. apply CReal_plus_lt_reg_l in abs. contradiction. - apply CReal_plus_proper_r. apply H. Qed. #[global] Instance CReal_plus_morph_T : CMorphisms.Proper (CMorphisms.respectful CRealEq (CMorphisms.respectful CRealEq CRealEq)) CReal_plus. Proof. intros x y H z t H0. apply (CRealEq_trans _ (CReal_plus x t)). - destruct H0. split. + intro abs. apply CReal_plus_lt_reg_l in abs. contradiction. + intro abs. apply CReal_plus_lt_reg_l in abs. contradiction. - apply CReal_plus_proper_r. apply H. Qed. Lemma CReal_plus_eq_reg_l : forall (r r1 r2 : CReal), r + r1 == r + r2 -> r1 == r2. Proof. intros. destruct H. split. - intro abs. apply (CReal_plus_lt_compat_l r) in abs. contradiction. - intro abs. apply (CReal_plus_lt_compat_l r) in abs. contradiction. Qed. Lemma CReal_opp_0 : -0 == 0. Proof. apply (CReal_plus_eq_reg_l 0). rewrite CReal_plus_0_r, CReal_plus_opp_r. reflexivity. Qed. Lemma CReal_opp_plus_distr : forall r1 r2, - (r1 + r2) == - r1 + - r2. Proof. intros. apply (CReal_plus_eq_reg_l (r1+r2)). rewrite CReal_plus_opp_r, (CReal_plus_comm (-r1)), CReal_plus_assoc. rewrite <- (CReal_plus_assoc r2), CReal_plus_opp_r, CReal_plus_0_l. rewrite CReal_plus_opp_r. reflexivity. Qed. Lemma CReal_opp_involutive : forall x:CReal, --x == x. Proof. intros. apply (CReal_plus_eq_reg_l (-x)). rewrite CReal_plus_opp_l, CReal_plus_opp_r. reflexivity. Qed. Lemma CReal_opp_gt_lt_contravar : forall r1 r2, r1 > r2 -> - r1 < - r2. Proof. unfold CRealGt; intros. apply (CReal_plus_lt_reg_l (r2 + r1)). rewrite CReal_plus_assoc, CReal_plus_opp_r, CReal_plus_0_r. rewrite CReal_plus_comm, <- CReal_plus_assoc, CReal_plus_opp_l. rewrite CReal_plus_0_l. exact H. Qed. Lemma CReal_opp_ge_le_contravar : forall r1 r2, r1 >= r2 -> - r1 <= - r2. Proof. intros. intro abs. apply H. clear H. apply (CReal_plus_lt_reg_r (-r1-r2)). unfold CReal_minus. rewrite <- CReal_plus_assoc, CReal_plus_opp_r, CReal_plus_0_l. rewrite (CReal_plus_comm (-r1)), <- CReal_plus_assoc, CReal_plus_opp_r, CReal_plus_0_l. exact abs. Qed. Lemma inject_Q_plus : forall q r : Q, inject_Q (q + r) == inject_Q q + inject_Q r. Proof. intros q r. split. all: intros [n nmaj]; unfold CReal_plus, CReal_plus_seq, inject_Q in nmaj. all: do 4 rewrite CReal_red_seq in nmaj. all: rewrite Qred_correct in nmaj. all: assert(2^n>0)%Q by (apply Qpower_0_lt; lra); lra. Qed. Lemma inject_Q_one : inject_Q 1 == 1. Proof. split. all: intros [n nmaj]; cbn in nmaj. all: assert(2^n>0)%Q by (apply Qpower_0_lt; lra); lra. Qed. Lemma inject_Q_lt : forall q r : Q, Qlt q r -> inject_Q q < inject_Q r. Proof. intros q r Hlt. destruct (QarchimedeanExp2_Z (/(r-q))) as [n Hn]. rewrite Qinv_lt_contravar, Qinv_involutive, <- Qpower_opp in Hn. - exists (-n-1)%Z; cbn. rewrite Qpower_minus_pos; lra. - apply Qlt_shift_inv_l; lra. - apply Qpower_0_lt; lra. Qed. Lemma opp_inject_Q : forall q : Q, inject_Q (-q) == - inject_Q q. Proof. intros q. split. all: intros [n maj]; cbn in maj. all: unfold CReal_opp_seq, inject_Q in maj. all: rewrite CReal_red_seq in maj. all: assert(2^n>0)%Q by (apply Qpower_0_lt; lra); lra. Qed. Lemma lt_inject_Q : forall q r : Q, inject_Q q < inject_Q r -> (q < r)%Q. Proof. intros q r [n Hn]; cbn in Hn. apply Qlt_minus_iff. assert(2^n>0)%Q by (apply Qpower_0_lt; lra); lra. Qed. Lemma le_inject_Q : forall q r : Q, inject_Q q <= inject_Q r -> (q <= r)%Q. Proof. intros q r Hle. destruct (Qlt_le_dec r q) as [Hdec|Hdec]. - exfalso. apply Hle; apply inject_Q_lt; exact Hdec. - exact Hdec. Qed. Lemma inject_Q_le : forall q r : Q, (q <= r)%Q -> inject_Q q <= inject_Q r. Proof. intros q r Hle [n maj]; cbn in maj. assert(2^n>0)%Q by (apply Qpower_0_lt; lra); lra. Qed. Lemma inject_Z_plus : forall q r : Z, inject_Z (q + r) == inject_Z q + inject_Z r. Proof. intros q r; unfold inject_Z. setoid_replace (q + r # 1)%Q with ((q#1) + (r#1))%Q. - apply inject_Q_plus. - rewrite Qinv_plus_distr; reflexivity. Qed. Lemma opp_inject_Z : forall n : Z, inject_Z (-n) == - inject_Z n. Proof. intros n; unfold inject_Z. setoid_replace (-n # 1)%Q with (-(n#1))%Q. - rewrite opp_inject_Q; reflexivity. - reflexivity. Qed. coq-8.20.0/theories/Reals/Cauchy/ConstructiveCauchyRealsMult.v000066400000000000000000001157551466560755400243740ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* seq x (n - scale y - 1)%Z * seq y (n - scale x - 1)%Z). Definition CReal_mult_scale (x y : CReal) : Z := x.(scale) + y.(scale). Local Ltac simplify_Qpower_exponent := match goal with |- context [(_ ^ ?a)%Q] => ring_simplify a end. Local Ltac simplify_Qabs := match goal with |- context [(Qabs ?a)%Q] => ring_simplify a end. Local Ltac simplify_Qabs_in H := match type of H with context [(Qabs ?a)%Q] => ring_simplify a in H end. Local Ltac field_simplify_Qabs := match goal with |- context [(Qabs ?a)%Q] => field_simplify a end. Local Ltac pose_Qabs_pos := match goal with |- context [(Qabs ?a)%Q] => pose proof Qabs_nonneg a end. Local Ltac simplify_Qle := match goal with |- (?l <= ?r)%Q => ring_simplify l; ring_simplify r end. Local Ltac simplify_Qle_in H := match type of H with (?l <= ?r)%Q => ring_simplify l in H; ring_simplify r in H end. Local Ltac simplify_Qlt := match goal with |- (?l < ?r)%Q => ring_simplify l; ring_simplify r end. Local Ltac simplify_Qlt_in H := match type of H with (?l < ?r)%Q => ring_simplify l in H; ring_simplify r in H end. Local Ltac simplify_seq_idx := match goal with |- context [seq ?x ?n] => progress ring_simplify n end. Local Lemma Weaken_Qle_QpowerAddExp: forall (q : Q) (n m : Z), (m >= 0)%Z -> (q <= 2^n)%Q -> (q <= 2^(n+m))%Q. Proof. intros q n m Hmpos Hle. pose proof Qpower_le_compat_l 2 n (n+m) ltac:(lia) ltac:(lra). lra. Qed. Local Lemma Weaken_Qle_QpowerRemSubExp: forall (q : Q) (n m : Z), (m >= 0)%Z -> (q <= 2^(n-m))%Q -> (q <= 2^n)%Q. Proof. intros q n m Hmpos Hle. pose proof Qpower_le_compat_l 2 (n-m) n ltac:(lia) ltac:(lra). lra. Qed. Local Lemma Weaken_Qle_QpowerFac: forall (q r : Q) (n : Z), (r >= 1)%Q -> (q <= 2^n)%Q -> (q <= r * 2^n)%Q. Proof. intros q r n Hrge1 Hle. rewrite <- (Qmult_1_l (2^n)%Q) in Hle. pose proof Qmult_le_compat_r 1 r (2^n)%Q Hrge1 (Qpower_pos 2 n ltac:(lra)) as Hpow. lra. Qed. Lemma CReal_mult_cauchy: forall (x y : CReal), QCauchySeq (CReal_mult_seq x y). Proof. intros x y n p q Hp Hq. unfold CReal_mult_seq. assert(forall xp xq yp yq : Q, xp * yp - xq * yq == (xp - xq) * yp + xq * (yp - yq))%Q as H by (intros; ring). rewrite H; clear H. apply (Qle_lt_trans _ _ _ (Qabs_triangle _ _)). do 2 rewrite Qabs_Qmult. replace n with ((n-1)+1)%Z by ring. rewrite Qpower_plus by lra. setoid_replace (2 ^ (n - 1) * 2 ^1)%Q with (2 ^ (n - 1) + 2 ^ (n - 1))%Q by ring. apply Qplus_lt_le_compat. - apply (Qle_lt_trans _ ((2 ^ (n - scale y - 1)) * Qabs (seq y (p - scale x - 1)))). + apply Qmult_le_compat_r. 2: apply Qabs_nonneg. apply Qlt_le_weak. apply (cauchy x); lia. + apply (Qmult_lt_l _ _ (2 ^ -(n - scale y - 1))%Q). { apply Qpower_0_lt; lra. } rewrite Qmult_assoc, <- Qpower_plus by lra. rewrite <- Qpower_plus by lra. simplify_Qpower_exponent; rewrite Qpower_0_r, Qmult_1_l. simplify_Qpower_exponent. apply (bound y). - apply Qlt_le_weak. apply (Qle_lt_trans _ ((2 ^ (n - scale x - 1)) * Qabs (seq x (q - scale y - 1)))). + rewrite Qmult_comm; apply Qmult_le_compat_r. 2: apply Qabs_nonneg. apply Qlt_le_weak; apply (cauchy y); lia. + apply (Qmult_lt_l _ _ (2 ^ -(n - scale x - 1))%Q). { apply Qpower_0_lt; lra. } rewrite Qmult_assoc, <- Qpower_plus by lra. rewrite <- Qpower_plus by lra. simplify_Qpower_exponent; rewrite Qpower_0_r, Qmult_1_l. simplify_Qpower_exponent. apply (bound x). Qed. Lemma CReal_mult_bound : forall (x y : CReal), QBound (CReal_mult_seq x y) (CReal_mult_scale x y). Proof. intros x y k. unfold CReal_mult_seq, CReal_mult_scale. pose proof (bound x (k - scale y - 1)%Z) as Hxbnd. pose proof (bound y (k - scale x - 1)%Z) as Hybnd. pose proof Qabs_nonneg (seq x (k - scale y - 1)) as Habsx. pose proof Qabs_nonneg (seq y (k - scale x - 1)) as Habsy. rewrite Qabs_Qmult; rewrite Qpower_plus by lra. apply Qmult_lt_compat_nonneg; lra. Qed. Definition CReal_mult (x y : CReal) : CReal := {| seq := CReal_mult_seq x y; scale := CReal_mult_scale x y; cauchy := CReal_mult_cauchy x y; bound := CReal_mult_bound x y |}. Infix "*" := CReal_mult : CReal_scope. Lemma CReal_mult_comm : forall x y : CReal, x * y == y * x. Proof. assert (forall x y : CReal, x * y <= y * x) as H. { intros x y [n nmaj]. apply (Qlt_not_le _ _ nmaj). clear nmaj. unfold CReal_mult, CReal_mult_seq; do 2 rewrite CReal_red_seq. ring_simplify. pose proof Qpower_0_lt 2 n ltac:(lra); lra. } split; apply H. Qed. (* ToDo: make a tactic for this *) Lemma CReal_red_scale: forall (a : Z -> Q) (b : Z) (c : QCauchySeq a) (d : QBound a b), scale (mkCReal a b c d) = b. Proof. reflexivity. Qed. Lemma CReal_mult_proper_0_l : forall x y : CReal, y == 0 -> x * y == 0. Proof. intros x y Hyeq0. apply CRealEq_diff; intros n. unfold CReal_mult, CReal_mult_seq, inject_Q; do 2 rewrite CReal_red_seq. simplify_Qabs. rewrite CRealEq_diff in Hyeq0. unfold inject_Q in Hyeq0; rewrite CReal_red_seq in Hyeq0. specialize (Hyeq0 (n - scale x - 1)%Z). simplify_Qabs_in Hyeq0. rewrite Qpower_minus_pos in Hyeq0 by lra; simplify_Qle_in Hyeq0. pose proof bound x (n - scale y - 1)%Z as Hxbnd. apply Weaken_Qle_QpowerFac; [lra|]. (* Now split the power of 2 and solve the goal*) replace n with ((scale x) + (n - scale x))%Z at 3 by ring. rewrite Qpower_plus by lra. rewrite Qabs_Qmult. apply Qmult_le_compat_nonneg; (pose_Qabs_pos; lra). Qed. Lemma CReal_mult_0_r : forall r, r * 0 == 0. Proof. intros. apply CReal_mult_proper_0_l. reflexivity. Qed. Lemma CReal_mult_0_l : forall r, 0 * r == 0. Proof. intros. rewrite CReal_mult_comm. apply CReal_mult_0_r. Qed. Lemma CReal_scale_sep0_limit : forall (x : CReal) (n : Z), (2 * (2^n)%Q < seq x n)%Q -> (n <= scale x - 2)%Z. Proof. intros x n Hnx. pose proof bound x n as Hxbnd. apply Qabs_Qlt_condition in Hxbnd. destruct Hxbnd as [_ Hxbnd]. apply (Qlt_trans _ _ _ Hnx) in Hxbnd. replace n with ((n+1)-1)%Z in Hxbnd by lia. rewrite Qpower_minus_pos in Hxbnd by lra. simplify_Qlt_in Hxbnd. apply (Qpower_lt_compat_l_inv) in Hxbnd. - lia. - lra. Qed. (* Correctness lemma for the Definition CReal_mult_lt_0_compat below. *) Lemma CReal_mult_lt_0_compat_correct : forall (x y : CReal) (Hx : 0 < x) (Hy : 0 < y), (2 * 2^(proj1_sig Hx + proj1_sig Hy - 1)%Z < seq (x * y)%CReal (proj1_sig Hx + proj1_sig Hy - 1)%Z - seq (inject_Q 0) (proj1_sig Hx + proj1_sig Hy - 1)%Z)%Q. Proof. intros x y Hx Hy. destruct Hx as [nx Hx], Hy as [ny Hy]; unfold proj1_sig. unfold inject_Q, Qminus in Hx. rewrite CReal_red_seq, Qplus_0_r in Hx. unfold inject_Q, Qminus in Hy. rewrite CReal_red_seq, Qplus_0_r in Hy. unfold CReal_mult, CReal_mult_seq, inject_Q; do 2 rewrite CReal_red_seq. rewrite Qpower_minus_pos by lra. rewrite Qpower_plus by lra. simplify_Qlt. do 2 simplify_seq_idx. apply Qmult_lt_compat_nonneg. - split. + pose proof Qpower_0_lt 2 nx; lra. + pose proof CReal_scale_sep0_limit y ny Hy as Hlimy. pose proof cauchy x nx nx (nx + ny - scale y - 2)%Z ltac:(lia) ltac:(lia) as Hbndx. apply Qabs_Qlt_condition in Hbndx. lra. - split. + pose proof Qpower_0_lt 2 ny; lra. + pose proof CReal_scale_sep0_limit x nx Hx as Hlimx. pose proof cauchy y ny ny (nx + ny - scale x - 2)%Z ltac:(lia) ltac:(lia) as Hbndy. apply Qabs_Qlt_condition in Hbndy. lra. Qed. (* Strict inequality on CReal is in sort Type, for example used in the computation of division. *) Definition CReal_mult_lt_0_compat : forall x y : CReal, 0 < x -> 0 < y -> 0 < x * y := fun x y Hx Hy => exist _ (proj1_sig Hx + proj1_sig Hy - 1)%Z (CReal_mult_lt_0_compat_correct x y Hx Hy). Lemma CReal_mult_plus_distr_l : forall r1 r2 r3 : CReal, r1 * (r2 + r3) == (r1 * r2) + (r1 * r3). Proof. intros x y z; apply CRealEq_diff; intros n. unfold CReal_mult, CReal_mult_seq, CReal_mult_scale, CReal_plus, CReal_plus_seq, CReal_plus_scale. do 5 rewrite CReal_red_seq. do 1 rewrite CReal_red_scale. do 2 rewrite Qred_correct. do 5 simplify_seq_idx. simplify_Qabs. assert (forall y' z': CReal, Qabs ( seq x (n - Z.max (scale y') (scale z') - 2) * seq y' (n - scale x - 2) - seq x (n - scale y' - 2) * seq y' (n - scale x - 2)) <= 2 ^ n )%Q as Hdiffbnd. { intros y' z'. assert (forall a b c : Q, a*c-b*c==(a-b)*c)%Q as H by (intros; ring). rewrite H; clear H. pose proof cauchy x (n - (scale y') - 2)%Z (n - Z.max (scale y') (scale z') - 2)%Z (n - scale y' - 2)%Z ltac:(lia) ltac:(lia) as Hxbnd. pose proof bound y' (n - scale x - 2)%Z as Hybnd. replace n with ((n - scale y' - 2) + scale y' + 2)%Z at 4 by lia. apply Weaken_Qle_QpowerAddExp. { lia. } rewrite Qpower_plus, Qabs_Qmult by lra. apply Qmult_le_compat_nonneg; (split; [apply Qabs_nonneg | lra]). } pose proof Hdiffbnd y z as Hyz. pose proof Hdiffbnd z y as Hzy; clear Hdiffbnd. pose proof Qplus_le_compat _ _ _ _ Hyz Hzy as Hcomb; clear Hyz Hzy. apply (Qle_trans _ _ _ (Qabs_triangle _ _)) in Hcomb. rewrite (Z.max_comm (scale z) (scale y)) in Hcomb . rewrite Qabs_Qle_condition in Hcomb |- *. lra. Qed. Lemma CReal_mult_plus_distr_r : forall r1 r2 r3 : CReal, (r2 + r3) * r1 == (r2 * r1) + (r3 * r1). Proof. intros. rewrite CReal_mult_comm, CReal_mult_plus_distr_l, <- (CReal_mult_comm r1), <- (CReal_mult_comm r1). reflexivity. Qed. Lemma CReal_opp_mult_distr_r : forall r1 r2 : CReal, - (r1 * r2) == r1 * (- r2). Proof. intros. apply (CReal_plus_eq_reg_l (r1*r2)). rewrite CReal_plus_opp_r, <- CReal_mult_plus_distr_l. symmetry. apply CReal_mult_proper_0_l. apply CReal_plus_opp_r. Qed. Lemma CReal_mult_proper_l : forall x y z : CReal, y == z -> x * y == x * z. Proof. intros. apply (CReal_plus_eq_reg_l (-(x*z))). rewrite CReal_plus_opp_l, CReal_opp_mult_distr_r. rewrite <- CReal_mult_plus_distr_l. apply CReal_mult_proper_0_l. rewrite H. apply CReal_plus_opp_l. Qed. Lemma CReal_mult_proper_r : forall x y z : CReal, y == z -> y * x == z * x. Proof. intros. rewrite CReal_mult_comm, (CReal_mult_comm z). apply CReal_mult_proper_l, H. Qed. Lemma CReal_mult_assoc : forall x y z : CReal, (x * y) * z == x * (y * z). Proof. intros x y z; apply CRealEq_diff; intros n. (* Expand and simplify the goal *) unfold CReal_mult, CReal_mult_seq, CReal_mult_scale. do 4 rewrite CReal_red_seq. do 2 rewrite CReal_red_scale. do 6 simplify_seq_idx. (* Todo: it is a bug in ring_simplify that the scales are not sorted *) replace (n - scale z - scale y)%Z with (n - scale y - scale z)%Z by ring. replace (n - scale z - scale x)%Z with (n - scale x - scale z)%Z by ring. simplify_Qabs. (* Rearrange the goal such that it used only scale and cauchy bounds *) (* Todo: it is also a bug in ring_simplify that the seq terms are not sorted by the first variable *) assert (forall a1 a2 b c1 c2 : Q, a1*b*c1+(-1)*b*a2*c2==(a1*c1-a2*c2)*b)%Q as H by (intros; ring). rewrite H; clear H. remember (seq x (n - scale y - scale z - 1) - seq x (n - scale y - scale z - 2))%Q as dx eqn:Heqdx. remember (seq z (n - scale x - scale y - 1) - seq z (n - scale x - scale y - 2))%Q as dz eqn:Heqdz. setoid_replace (seq x (n - scale y - scale z - 1)) with (seq x (n - scale y - scale z - 2) + dx)%Q by (rewrite Heqdx; ring). setoid_replace (seq z (n - scale x - scale y - 1)) with (seq z (n - scale x - scale y - 2) + dz)%Q by (rewrite Heqdz; ring). match goal with |- (Qabs (?a * _) <= _)%Q => ring_simplify a end. (* Now pose the scale and cauchy bounds we need to prove this, so that we see how to split the deviation budget *) pose proof bound x (n - scale y - scale z - 2)%Z as Hbndx. pose proof bound z (n - scale x - scale y - 2)%Z as Hbndz. pose proof bound y (n - scale x - scale z - 2)%Z as Hbndy. pose proof cauchy x (n - scale y - scale z - 1)%Z (n - scale y - scale z - 1)%Z (n - scale y - scale z - 2)%Z ltac:(lia) ltac:(lia) as Hbnddx; rewrite <- Heqdx in Hbnddx; clear Heqdx. pose proof cauchy z (n - scale x - scale y - 1)%Z (n - scale x - scale y - 1)%Z (n - scale x - scale y - 2)%Z ltac:(lia) ltac:(lia) as Hbnddz; rewrite <- Heqdz in Hbnddz; clear Heqdz. (* The rest is elementary arithmetic ... *) rewrite Qabs_Qmult. replace n with ((n - scale y) + scale y)%Z at 4 by lia. rewrite Qpower_plus by lra. rewrite Qmult_assoc. apply Qmult_le_compat_nonneg. 2: (split; [apply Qabs_nonneg | lra]). split; [apply Qabs_nonneg|]. apply (Qle_trans _ _ _ (Qabs_triangle _ _)). setoid_replace (2 * 2 ^ (n - scale y))%Q with (2 ^ (n - scale y) + 2 ^ (n - scale y))%Q by ring. apply Qplus_le_compat. - rewrite Qabs_Qmult. replace (n - scale y)%Z with (scale x + (n - scale x - scale y))%Z at 2 by lia. rewrite Qpower_plus by lra. apply Qmult_le_compat_nonneg. + (split; [apply Qabs_nonneg | lra]). + split; [apply Qabs_nonneg|]. apply (Weaken_Qle_QpowerRemSubExp _ _ 1 ltac:(lia)), Qlt_le_weak, Hbnddz. - rewrite Qabs_Qmult. replace (n - scale y)%Z with (scale z + (n - scale y - scale z))%Z by lia. rewrite Qpower_plus by lra. apply Qmult_le_compat_nonneg. + split; [apply Qabs_nonneg|]. rewrite <- Qabs_opp; simplify_Qabs; lra. + split; [apply Qabs_nonneg|]. apply (Weaken_Qle_QpowerRemSubExp _ _ 1 ltac:(lia)), Qlt_le_weak, Hbnddx. Qed. Lemma CReal_mult_1_l : forall r: CReal, 1 * r == r. Proof. intros r; apply CRealEq_diff; intros n. unfold inject_Q, CReal_mult, CReal_mult_seq, CReal_mult_scale. do 2 rewrite CReal_red_seq. do 1 rewrite CReal_red_scale. change (Qbound_ltabs_ZExp2 1)%Z with 1%Z. do 1 simplify_seq_idx. simplify_Qabs. pose proof cauchy r n (n-2)%Z n ltac:(lia) ltac:(lia) as Hrbnd. apply Qabs_Qlt_condition in Hrbnd. apply Qabs_Qle_condition. lra. Qed. Lemma CReal_isRingExt : ring_eq_ext CReal_plus CReal_mult CReal_opp CRealEq. Proof. split. - intros x y H z t H0. apply CReal_plus_morph; assumption. - intros x y H z t H0. apply (CRealEq_trans _ (CReal_mult x t)). + apply CReal_mult_proper_l. apply H0. + apply (CRealEq_trans _ (CReal_mult t x)). { apply CReal_mult_comm. } apply (CRealEq_trans _ (CReal_mult t y)). * apply CReal_mult_proper_l. apply H. * apply CReal_mult_comm. - intros x y H. apply (CReal_plus_eq_reg_l x). apply (CRealEq_trans _ (inject_Q 0)). { apply CReal_plus_opp_r. } apply (CRealEq_trans _ (CReal_plus y (CReal_opp y))). + apply CRealEq_sym. apply CReal_plus_opp_r. + apply CReal_plus_proper_r. apply CRealEq_sym. apply H. Qed. Lemma CReal_isRing : ring_theory (inject_Q 0) (inject_Q 1) CReal_plus CReal_mult CReal_minus CReal_opp CRealEq. Proof. intros. split. - apply CReal_plus_0_l. - apply CReal_plus_comm. - intros x y z. symmetry. apply CReal_plus_assoc. - apply CReal_mult_1_l. - apply CReal_mult_comm. - intros x y z. symmetry. apply CReal_mult_assoc. - intros x y z. rewrite <- (CReal_mult_comm z). rewrite CReal_mult_plus_distr_l. apply (CRealEq_trans _ (CReal_plus (CReal_mult x z) (CReal_mult z y))). + apply CReal_plus_proper_r. apply CReal_mult_comm. + apply CReal_plus_proper_l. apply CReal_mult_comm. - intros x y. apply CRealEq_refl. - apply CReal_plus_opp_r. Qed. Add Parametric Morphism : CReal_mult with signature CRealEq ==> CRealEq ==> CRealEq as CReal_mult_morph. Proof. apply CReal_isRingExt. Qed. #[global] Instance CReal_mult_morph_T : CMorphisms.Proper (CMorphisms.respectful CRealEq (CMorphisms.respectful CRealEq CRealEq)) CReal_mult. Proof. apply CReal_isRingExt. Qed. Add Parametric Morphism : CReal_opp with signature CRealEq ==> CRealEq as CReal_opp_morph. Proof. apply (Ropp_ext CReal_isRingExt). Qed. #[global] Instance CReal_opp_morph_T : CMorphisms.Proper (CMorphisms.respectful CRealEq CRealEq) CReal_opp. Proof. apply CReal_isRingExt. Qed. Add Parametric Morphism : CReal_minus with signature CRealEq ==> CRealEq ==> CRealEq as CReal_minus_morph. Proof. intros. unfold CReal_minus. rewrite H,H0. reflexivity. Qed. #[global] Instance CReal_minus_morph_T : CMorphisms.Proper (CMorphisms.respectful CRealEq (CMorphisms.respectful CRealEq CRealEq)) CReal_minus. Proof. intros x y exy z t ezt. unfold CReal_minus. rewrite exy,ezt. reflexivity. Qed. Add Ring CRealRing : CReal_isRing. (**********) Lemma CReal_mult_1_r : forall r, r * 1 == r. Proof. intro; ring. Qed. Lemma CReal_opp_mult_distr_l : forall r1 r2 : CReal, - (r1 * r2) == (- r1) * r2. Proof. intros. ring. Qed. Lemma CReal_mult_lt_compat_l : forall x y z : CReal, 0 < x -> y < z -> x*y < x*z. Proof. intros. apply (CReal_plus_lt_reg_l (CReal_opp (CReal_mult x y))). rewrite CReal_plus_comm. pose proof CReal_plus_opp_r. unfold CReal_minus in H1. rewrite H1. rewrite CReal_mult_comm, CReal_opp_mult_distr_l, CReal_mult_comm. rewrite <- CReal_mult_plus_distr_l. apply CReal_mult_lt_0_compat. - exact H. - apply (CReal_plus_lt_reg_l y). rewrite CReal_plus_comm, CReal_plus_0_l. rewrite <- CReal_plus_assoc, H1, CReal_plus_0_l. exact H0. Qed. Lemma CReal_mult_lt_compat_r : forall x y z : CReal, 0 < x -> y < z -> y*x < z*x. Proof. intros. rewrite <- (CReal_mult_comm x), <- (CReal_mult_comm x). apply (CReal_mult_lt_compat_l x); assumption. Qed. Lemma CReal_mult_eq_reg_l : forall (r r1 r2 : CReal), r # 0 -> r * r1 == r * r2 -> r1 == r2. Proof. intros. destruct H; split. - intro abs. apply (CReal_mult_lt_compat_l (-r)) in abs. + rewrite <- CReal_opp_mult_distr_l, <- CReal_opp_mult_distr_l, H0 in abs. exact (CRealLe_refl _ abs). + apply (CReal_plus_lt_reg_l r). rewrite CReal_plus_opp_r, CReal_plus_comm, CReal_plus_0_l. exact c. - intro abs. apply (CReal_mult_lt_compat_l (-r)) in abs. + rewrite <- CReal_opp_mult_distr_l, <- CReal_opp_mult_distr_l, H0 in abs. exact (CRealLe_refl _ abs). + apply (CReal_plus_lt_reg_l r). rewrite CReal_plus_opp_r, CReal_plus_comm, CReal_plus_0_l. exact c. - intro abs. apply (CReal_mult_lt_compat_l r) in abs. + rewrite H0 in abs. exact (CRealLe_refl _ abs). + exact c. - intro abs. apply (CReal_mult_lt_compat_l r) in abs. + rewrite H0 in abs. exact (CRealLe_refl _ abs). + exact c. Qed. Lemma CReal_abs_appart_zero : forall (x : CReal) (n : Z), (2*2^n < Qabs (seq x n))%Q -> 0 # x. Proof. intros x n Hapart. unfold CReal_appart. destruct (Qlt_le_dec 0 (seq x n)). - left; exists n; cbn. rewrite Qabs_pos in Hapart; lra. - right; exists n; cbn. rewrite Qabs_neg in Hapart; lra. Qed. (*********************************************************) (** * Field *) (*********************************************************) Lemma CRealArchimedean : forall x:CReal, { n:Z & x < inject_Z n < x+2 }. Proof. intros x. (* We add 3/2: 1/2 for the average rounding of floor + 1 to center in the interval. This gives a margin of 1/2 in each inequality. Since we need margin for Qlt of 2*2^-n plus 2^-n for the real addition, we need n=-3 *) remember (seq x (-3)%Z + (3#2))%Q as q eqn: Heqq. pose proof (Qlt_floor q) as Hltfloor; unfold QArith_base.inject_Z in Hltfloor. pose proof (Qfloor_le q) as Hfloorle; unfold QArith_base.inject_Z in Hfloorle. exists (Qfloor q); split. - unfold inject_Z, inject_Q, CRealLt. rewrite CReal_red_seq. exists (-3)%Z. setoid_replace (2 * 2 ^ (-3))%Q with (1#4)%Q by reflexivity. subst q; rewrite <- Qinv_plus_distr in Hltfloor. lra. - unfold inject_Z, inject_Q, CReal_plus, CReal_plus_seq, CRealLt. do 3 rewrite CReal_red_seq. exists (-3)%Z. setoid_replace (2 * 2 ^ (-3))%Q with (1#4)%Q by reflexivity. simplify_seq_idx; rewrite Qred_correct. pose proof cauchy x (-3)%Z (-3)%Z (-4)%Z ltac:(lia) ltac:(lia) as Hbnddx. rewrite Qabs_Qlt_condition in Hbnddx. setoid_replace (2 ^ (-3))%Q with (1#8)%Q in Hbnddx by reflexivity. subst q; rewrite <- Qinv_plus_distr in Hltfloor. lra. Qed. (* ToDo: This is not efficient. We take the n for the 2^n lower bound fro x>0. This limit can be arbitrarily small and far away from beeing tight. To make this really computational, we need to compute a tight limit starting from scale x and going down in steps of say 16 bits, something which is still easy to compute but likely to succeed. *) Definition CRealLowerBound (x : CReal) (xPos : 0 (seq x p > 2^(CRealLowerBound x xPos))%Q. Proof. intros x xPos p Hp. unfold CRealLowerBound in *. destruct xPos as [n Hn]; unfold proj1_sig in *. unfold inject_Q in Hn; rewrite CReal_red_seq in Hn. ring_simplify in Hn. pose proof cauchy x n n p ltac:(lia) ltac:(lia) as Hxbnd. rewrite Qabs_Qlt_condition in Hxbnd. lra. Qed. Lemma CRealLowerBound_lt_scale: forall (r : CReal) (Hrpos : 0 < r), (CRealLowerBound r Hrpos < scale r)%Z. Proof. intros r Hrpos. pose proof CRealLowerBoundSpec r Hrpos (CRealLowerBound r Hrpos) ltac:(lia) as Hlow. pose proof bound r (CRealLowerBound r Hrpos) as Hup; unfold QBound in Hup. apply Qabs_Qlt_condition in Hup. destruct Hup as [_ Hup]. pose proof Qlt_trans _ _ _ Hlow Hup as Hpow. apply Qpower_lt_compat_l_inv in Hpow. 2: lra. exact Hpow. Qed. (** Note on the convergence modulus for x when computing 1/x: Thinking in terms of absolute and relative errors and scales we get: - 2^n is absolute error of 1/x (the requested error) - 2^k is a lower bound of x -> 2^-k is an upper bound of 1/x For simplicity lets’ say 2^k is the scale of x and 2^-k is the scale of 1/x. With this we get: - relative error of 1/x = absolute error of 1/x / scale of 1/x = 2^n / 2^-k = 2^(n+k) - 1/x maintains relative error - relative error of x = relative error 1/x = 2^(n+k) - absolute error of x = relative error x * scale of x = 2^(n+k) * 2^k - absolute error of x = 2^(n+2*k) *) Definition CReal_inv_pos_cm (x : CReal) (xPos : 0 < x) (n : Z):= (Z.min (CRealLowerBound x xPos) (n + 2 * (CRealLowerBound x xPos)))%Z. Definition CReal_inv_pos_seq (x : CReal) (xPos : 0 < x) (n : Z) := (/ seq x (CReal_inv_pos_cm x xPos n))%Q. Definition CReal_inv_pos_scale (x : CReal) (xPos : 0 < x) : Z := (- (CRealLowerBound x xPos))%Z. Lemma CReal_inv_pos_cauchy: forall (x : CReal) (xPos : 0 < x), QCauchySeq (CReal_inv_pos_seq x xPos). Proof. intros x Hxpos n p q Hp Hq; unfold CReal_inv_pos_seq. unfold CReal_inv_pos_cm; remember (CRealLowerBound x Hxpos) as k. (* These auxilliary lemmas are required a few times below *) assert (forall m:Z, (2^k < seq x (Z.min k (m + 2 * k))))%Q as AuxAppart. { intros m. pose proof CRealLowerBoundSpec x Hxpos (Z.min k (m + 2 * k))%Z ltac:(lia) as H1. rewrite Heqk at 1. lra. } assert (forall m:Z, (0 < seq x (Z.min k (m + 2 * k))))%Q as AuxPos. { intros m. pose proof AuxAppart m as H1. pose proof Qpower_0_lt 2 k as H2. lra. } assert( forall a b : Q, (a>0)%Q -> (b>0)%Q -> (/a - /b == (b - a) / (a * b))%Q ) as H by (intros; field; lra); rewrite H by apply AuxPos; clear H. setoid_rewrite Qabs_Qmult; setoid_rewrite Qabs_Qinv. apply Qlt_shift_div_r. - setoid_rewrite <- (Qmult_0_l 0); setoid_rewrite Qabs_Qmult. apply Qmult_lt_compat_nonneg. 1,2: split; [lra | apply Qabs_gt, AuxPos]. - assert( forall r:Q, (r == (r/2^k/2^k)*(2^k*2^k))%Q ) as H by (intros r; field; apply Qpower_not_0; lra); rewrite H; clear H. apply Qmult_lt_compat_nonneg. + split. * do 2 (apply Qle_shift_div_l; [ apply Qpower_0_lt; lra | rewrite Qmult_0_l ]). apply Qabs_nonneg. * do 2 (apply Qlt_shift_div_r; [apply Qpower_0_lt; lra|]). do 2 rewrite <- Qpower_plus by lra. apply (cauchy x (n+k+k)%Z); lia. + split. * rewrite <- Qpower_plus by lra. apply Qpower_pos; lra. * setoid_rewrite Qabs_Qmult; apply Qmult_lt_compat_nonneg. 1,2: split; [apply Qpower_pos; lra | ]. 1,2: apply Qabs_gt, AuxAppart. Qed. Lemma CReal_inv_pos_bound : forall (x : CReal) (Hxpos : 0 < x), QBound (CReal_inv_pos_seq x Hxpos) (CReal_inv_pos_scale x Hxpos). Proof. intros x Hxpos n. unfold CReal_inv_pos_seq, CReal_inv_pos_scale, CReal_inv_pos_cm. remember (CRealLowerBound x Hxpos) as k. pose proof CRealLowerBoundSpec x Hxpos (Z.min k (n + 2 * k))%Z ltac:(lia) as Hlb. rewrite <- Heqk in Hlb. rewrite Qabs_pos. 2: apply Qinv_le_0_compat; pose proof Qpower_pos 2 k; lra. rewrite Qpower_opp; apply -> Qinv_lt_contravar. - exact Hlb. - pose proof Qpower_0_lt 2 k; lra. - apply Qpower_0_lt; lra. Qed. Definition CReal_inv_pos (x : CReal) (Hxpos : 0 < x) : CReal := {| seq := CReal_inv_pos_seq x Hxpos; scale := CReal_inv_pos_scale x Hxpos; cauchy := CReal_inv_pos_cauchy x Hxpos; bound := CReal_inv_pos_bound x Hxpos |}. Definition CReal_neg_lt_pos : forall x : CReal, x < 0 -> 0 < -x. Proof. intros x [n nmaj]. exists n. simpl in *. unfold CReal_opp_seq, Qminus. abstract now rewrite Qplus_0_r, <- (Qplus_0_l (- seq x n)). Defined. Definition CReal_inv (x : CReal) (xnz : x # 0) : CReal := match xnz with | inl xNeg => - CReal_inv_pos (-x) (CReal_neg_lt_pos x xNeg) | inr xPos => CReal_inv_pos x xPos end. Notation "/ x" := (CReal_inv x) (at level 35, right associativity) : CReal_scope. Lemma CReal_inv_0_lt_compat : forall (r : CReal) (rnz : r # 0), 0 < r -> 0 < ((/ r) rnz). Proof. intros r Hrnz Hrpos; unfold CReal_inv; cbn. destruct Hrnz. - exfalso. apply CRealLt_asym in Hrpos. contradiction. - unfold CRealLt. exists (- (scale r) - 1)%Z. unfold inject_Q; rewrite CReal_red_seq; simplify_Qlt. unfold CReal_inv_pos; rewrite CReal_red_seq. unfold CReal_inv_pos_seq. pose proof bound r as Hrbnd; unfold QBound in Hrbnd. rewrite Qpower_minus by lra. field_simplify (2 * (2 ^ (- scale r) / 2 ^ 1))%Q. rewrite Qpower_opp; apply -> Qinv_lt_contravar. + setoid_rewrite Qabs_Qlt_condition in Hrbnd. specialize (Hrbnd (CReal_inv_pos_cm r c (- scale r - 1))%Z). lra. + apply Qpower_0_lt; lra. + unfold CReal_inv_pos_cm. pose proof CRealLowerBoundSpec r c ((Z.min (CRealLowerBound r c) (- scale r - 1 + 2 * CRealLowerBound r c)))%Z ltac:(lia) as Hlowbnd. pose proof Qpower_0_lt 2 (CRealLowerBound r c) as Hpow. lra. Qed. Lemma CReal_inv_l_pos : forall (r:CReal) (Hrpos : 0 < r), (CReal_inv_pos r Hrpos) * r == 1. Proof. intros r Hrpos; apply CRealEq_diff; intros n. unfold CReal_mult, CReal_mult_seq, CReal_mult_scale; unfold CReal_inv_pos, CReal_inv_pos_seq, CReal_inv_pos_scale, CReal_inv_pos_cm; unfold inject_Q. do 3 rewrite CReal_red_seq. do 1 rewrite CReal_red_scale. simplify_seq_idx. (* This is needed several times below *) remember (Z.min (CRealLowerBound r Hrpos) (n - scale r - 1 + 2 * CRealLowerBound r Hrpos))%Z as k. assert (0 < seq r k)%Q as Hrseqpos. { pose proof Qpower_0_lt 2 (CRealLowerBound r Hrpos)%Z ltac:(lra) as Hpow. pose proof CRealLowerBoundSpec r Hrpos k ltac:(lia) as Hlowbnd. lra. } field_simplify_Qabs; [|lra]; unfold Qdiv. rewrite Qabs_Qmult, Qabs_Qinv. apply Qle_shift_div_r. 1: apply Qabs_gt; lra. pose proof cauchy r (n + CRealLowerBound r Hrpos)%Z (n + CRealLowerBound r Hrpos - 1)%Z k as Hrbnd. pose proof CRealLowerBound_lt_scale r Hrpos as Hscale_lowbnd. specialize (Hrbnd ltac:(lia) ltac:(lia)). simplify_Qabs_in Hrbnd; simplify_Qabs. rewrite Qplus_comm in Hrbnd. apply Qlt_le_weak in Hrbnd. apply (Qle_trans _ _ _ Hrbnd). pose proof CRealLowerBoundSpec r Hrpos k ltac:(lia) as Hlowbnd. rewrite Qpower_plus; [|lra]. apply Qmult_le_compat_nonneg. { pose proof Qpower_pos 2 n; split; lra. } split. - apply Qpower_pos; lra. - rewrite Qabs_pos; [lra|]. pose proof Qpower_0_lt 2 (CRealLowerBound r Hrpos)%Z ltac:(lra) as Hpow. lra. Qed. Lemma CReal_inv_l : forall (r:CReal) (rnz : r # 0), ((/ r) rnz) * r == 1. Proof. intros. unfold CReal_inv. destruct rnz. - rewrite <- CReal_opp_mult_distr_l, CReal_opp_mult_distr_r. apply CReal_inv_l_pos. - apply CReal_inv_l_pos. Qed. Lemma CReal_inv_r : forall (r:CReal) (rnz : r # 0), r * ((/ r) rnz) == 1. Proof. intros. rewrite CReal_mult_comm, CReal_inv_l. reflexivity. Qed. Lemma CReal_inv_1 : forall nz : 1 # 0, (/ 1) nz == 1. Proof. intros. rewrite <- (CReal_mult_1_l ((/1) nz)). rewrite CReal_inv_r. reflexivity. Qed. Lemma CReal_inv_mult_distr : forall r1 r2 (r1nz : r1 # 0) (r2nz : r2 # 0) (rmnz : (r1*r2) # 0), (/ (r1 * r2)) rmnz == (/ r1) r1nz * (/ r2) r2nz. Proof. intros. apply (CReal_mult_eq_reg_l r1). - exact r1nz. - rewrite <- CReal_mult_assoc. rewrite CReal_inv_r. rewrite CReal_mult_1_l. apply (CReal_mult_eq_reg_l r2). + exact r2nz. + rewrite CReal_inv_r. rewrite <- CReal_mult_assoc. rewrite (CReal_mult_comm r2 r1). rewrite CReal_inv_r. reflexivity. Qed. Lemma Rinv_eq_compat : forall x y (rxnz : x # 0) (rynz : y # 0), x == y -> (/ x) rxnz == (/ y) rynz. Proof. intros. apply (CReal_mult_eq_reg_l x). - exact rxnz. - rewrite CReal_inv_r, H, CReal_inv_r. reflexivity. Qed. Lemma CReal_mult_lt_reg_l : forall r r1 r2, 0 < r -> r * r1 < r * r2 -> r1 < r2. Proof. intros z x y H H0. apply (CReal_mult_lt_compat_l ((/z) (inr H))) in H0. - repeat rewrite <- CReal_mult_assoc in H0. rewrite CReal_inv_l in H0. repeat rewrite CReal_mult_1_l in H0. apply H0. - apply CReal_inv_0_lt_compat. exact H. Qed. Lemma CReal_mult_lt_reg_r : forall r r1 r2, 0 < r -> r1 * r < r2 * r -> r1 < r2. Proof. intros. apply CReal_mult_lt_reg_l with r. - exact H. - now rewrite 2!(CReal_mult_comm r). Qed. Lemma CReal_mult_eq_reg_r : forall r r1 r2, r1 * r == r2 * r -> r # 0 -> r1 == r2. Proof. intros. apply (CReal_mult_eq_reg_l r). - exact H0. - now rewrite 2!(CReal_mult_comm r). Qed. Lemma CReal_mult_eq_compat_l : forall r r1 r2, r1 == r2 -> r * r1 == r * r2. Proof. intros. rewrite H. reflexivity. Qed. Lemma CReal_mult_eq_compat_r : forall r r1 r2, r1 == r2 -> r1 * r == r2 * r. Proof. intros. rewrite H. reflexivity. Qed. (* In particular x * y == 1 implies that 0 # x, 0 # y and that x and y are inverses of each other. *) Lemma CReal_mult_pos_appart_zero : forall x y : CReal, 0 < x * y -> 0 # x. Proof. intros x y H0ltxy. unfold CRealLt, CReal_mult, CReal_mult_seq, CReal_mult_scale in H0ltxy; rewrite CReal_red_seq in H0ltxy. destruct H0ltxy as [n nmaj]. cbn in nmaj; setoid_rewrite Qplus_0_r in nmaj. destruct (Q_dec 0 (seq y (n - scale x - 1)))%Q as [[H0lty|Hylt0]|Hyeq0]. - apply (Qmult_lt_compat_r _ _ (/(seq y (n - scale x - 1)))%Q ) in nmaj. 2: apply Qinv_lt_0_compat, H0lty. setoid_rewrite <- Qmult_assoc in nmaj at 2. setoid_rewrite Qmult_inv_r in nmaj. 2: lra. setoid_rewrite Qmult_1_r in nmaj. pose proof bound y (n - scale x - 1)%Z as Hybnd. apply Qabs_Qlt_condition, proj2 in Hybnd. apply Qinv_lt_contravar in Hybnd. 3: apply Qpower_0_lt; lra. 2: exact H0lty. apply (Qmult_lt_l _ _ (2 * (2 ^ n))) in Hybnd. 2: pose proof Qpower_0_lt 2 n; lra. apply (Qlt_trans _ _ _ Hybnd) in nmaj; clear Hybnd. rewrite <- Qpower_opp, <- Qmult_assoc, <- Qpower_plus in nmaj by lra. apply (CReal_abs_appart_zero x (n - scale y - 1)%Z), Qabs_gt. rewrite Qpower_minus_pos. ring_simplify. ring_simplify (n + - scale y)%Z in nmaj. pose proof Qpower_0_lt 2 (n - scale y)%Z; lra. - (* This proof is the same as above, except that we swap the signs of x and y *) (* ToDo: maybe assert teh goal for arbitrary y>0 and then apply twice *) assert (forall a b : Q, ((-a)*(-b)==a*b)%Q) by (intros; ring). setoid_rewrite <- H in nmaj at 2; clear H. apply (Qmult_lt_compat_r _ _ (/-(seq y (n - scale x - 1)))%Q ) in nmaj. 2: apply Qinv_lt_0_compat; lra. setoid_rewrite <- Qmult_assoc in nmaj at 2. setoid_rewrite Qmult_inv_r in nmaj. 2: lra. setoid_rewrite Qmult_1_r in nmaj. pose proof bound y (n - scale x - 1)%Z as Hybnd. apply Qabs_Qlt_condition, proj1 in Hybnd. apply Qopp_lt_compat in Hybnd; rewrite Qopp_involutive in Hybnd. apply Qinv_lt_contravar in Hybnd. 3: apply Qpower_0_lt; lra. 2: lra. apply (Qmult_lt_l _ _ (2 * (2 ^ n))) in Hybnd. 2: pose proof Qpower_0_lt 2 n; lra. apply (Qlt_trans _ _ _ Hybnd) in nmaj; clear Hybnd. rewrite <- Qpower_opp, <- Qmult_assoc, <- Qpower_plus in nmaj by lra. apply (CReal_abs_appart_zero x (n - scale y - 1)%Z). pose proof Qpower_0_lt 2 (n + - scale y)%Z ltac:(lra) as Hpowpos. rewrite Qabs_neg by lra. rewrite Qpower_minus_pos. ring_simplify. ring_simplify (n + - scale y)%Z in nmaj. pose proof Qpower_0_lt 2 (n - scale y)%Z; lra. - pose proof Qpower_0_lt 2 n ltac:(lra). rewrite <- Hyeq0 in nmaj. lra. Qed. Fixpoint pow (r:CReal) (n:nat) : CReal := match n with | O => 1 | S n => r * (pow r n) end. Lemma CReal_mult_le_compat_l_half : forall r r1 r2, 0 < r -> r1 <= r2 -> r * r1 <= r * r2. Proof. intros. intro abs. apply (CReal_mult_lt_reg_l) in abs. - contradiction. - apply H. Qed. Lemma CReal_invQ : forall (b : positive) (pos : Qlt 0 (Z.pos b # 1)), CReal_inv (inject_Q (Z.pos b # 1)) (inr (CReal_injectQPos (Z.pos b # 1) pos)) == inject_Q (1 # b). Proof. intros. apply (CReal_mult_eq_reg_l (inject_Q (Z.pos b # 1))). - right. apply CReal_injectQPos. exact pos. - rewrite CReal_mult_comm, CReal_inv_l. apply CRealEq_diff. intro n. simpl. do 2 rewrite Pos.mul_1_r. rewrite Z.pos_sub_diag. pose proof Qpower_pos 2 n ltac:(lra). rewrite Z.abs_0, Qreduce_zero. lra. Qed. Definition CRealQ_dense (a b : CReal) : a < b -> { q : Q & a < inject_Q q < b }. Proof. (* Locate a and b at the index given by a 0 <= b -> 0 <= a * b. Proof. (* Limit of (a + 1/n)*b when n -> infty. *) intros. intro abs. assert (0 < -(a*b)) as epsPos. { rewrite <- CReal_opp_0. apply CReal_opp_gt_lt_contravar. exact abs. } destruct (Rup_nat (b * (/ (-(a*b))) (inr epsPos))) as [n maj]. destruct n as [|n]. - apply (CReal_mult_lt_compat_r (-(a*b))) in maj. + rewrite CReal_mult_0_l, CReal_mult_assoc, CReal_inv_l, CReal_mult_1_r in maj. contradiction. + exact epsPos. - (* n > 0 *) assert (0 < inject_Q (Z.of_nat (S n) #1)) as nPos. { apply inject_Q_lt. unfold Qlt, Qnum, Qden. do 2 rewrite Z.mul_1_r. apply Z2Nat.inj_lt. - discriminate. - apply Zle_0_nat. - rewrite Nat2Z.id. apply -> Nat.succ_le_mono; apply Nat.le_0_l. } assert (b * (/ inject_Q (Z.of_nat (S n) #1)) (inr nPos) < -(a*b)). { apply (CReal_mult_lt_reg_r (inject_Q (Z.of_nat (S n) #1))). { apply nPos. } rewrite CReal_mult_assoc, CReal_inv_l, CReal_mult_1_r. apply (CReal_mult_lt_compat_r (-(a*b))) in maj. - rewrite CReal_mult_assoc, CReal_inv_l, CReal_mult_1_r in maj. rewrite CReal_mult_comm. apply maj. - apply epsPos. } pose proof (CReal_mult_le_compat_l_half (a + (/ inject_Q (Z.of_nat (S n) #1)) (inr nPos)) 0 b). assert (0 + 0 < a + (/ inject_Q (Z.of_nat (S n) #1)) (inr nPos)). { apply CReal_plus_le_lt_compat. { apply H. } apply CReal_inv_0_lt_compat. apply nPos. } rewrite CReal_plus_0_l in H3. specialize (H2 H3 H0). clear H3. rewrite CReal_mult_0_r in H2. apply H2. clear H2. rewrite CReal_mult_plus_distr_r. apply (CReal_plus_lt_compat_l (a*b)) in H1. rewrite CReal_plus_opp_r in H1. rewrite (CReal_mult_comm ((/ inject_Q (Z.of_nat (S n) #1)) (inr nPos))). apply H1. Qed. Lemma CReal_mult_le_compat_l : forall (r r1 r2:CReal), 0 <= r -> r1 <= r2 -> r * r1 <= r * r2. Proof. intros. apply (CReal_plus_le_reg_r (-(r*r1))). rewrite CReal_plus_opp_r, CReal_opp_mult_distr_r. rewrite <- CReal_mult_plus_distr_l. apply CReal_mult_le_0_compat. { exact H. } apply (CReal_plus_le_reg_r r1). rewrite CReal_plus_0_l, CReal_plus_assoc, CReal_plus_opp_l, CReal_plus_0_r. exact H0. Qed. Lemma CReal_mult_le_compat_r : forall (r r1 r2:CReal), 0 <= r -> r1 <= r2 -> r1 * r <= r2 * r. Proof. intros. apply (CReal_plus_le_reg_r (-(r1*r))). rewrite CReal_plus_opp_r, CReal_opp_mult_distr_l. rewrite <- CReal_mult_plus_distr_r. apply CReal_mult_le_0_compat. 2: exact H. apply (CReal_plus_le_reg_r r1). ring_simplify. exact H0. Qed. Lemma CReal_mult_le_reg_l : forall x y z : CReal, 0 < x -> x * y <= x * z -> y <= z. Proof. intros. intro abs. apply (CReal_mult_lt_compat_l x) in abs. - contradiction. - exact H. Qed. Lemma CReal_mult_le_reg_r : forall x y z : CReal, 0 < x -> y * x <= z * x -> y <= z. Proof. intros. intro abs. apply (CReal_mult_lt_compat_r x) in abs. - contradiction. - exact H. Qed. coq-8.20.0/theories/Reals/Cauchy/ConstructiveExtra.v000066400000000000000000000041251466560755400223760ustar00rootroot00000000000000Require Import ZArith. Require Import ConstructiveEpsilon. Definition Z_inj_nat (z : Z) : nat := match z with | Z0 => 0 | Zpos p => Pos.to_nat (p~0) | Zneg p => Pos.to_nat (Pos.pred_double p) end. Definition Z_inj_nat_rev (n : nat) : Z := match n with | O => 0 | S n' => match Pos.of_nat n with | xH => Zneg xH | xO p => Zpos p | xI p => Zneg (Pos.succ p) end end. Lemma Pos_pred_double_inj: forall (p q : positive), Pos.pred_double p = Pos.pred_double q -> p = q. Proof. intros p q H. apply (f_equal Pos.succ) in H. do 2 rewrite Pos.succ_pred_double in H. inversion H; reflexivity. Qed. Lemma Z_inj_nat_id: forall (z : Z), Z_inj_nat_rev (Z_inj_nat z) = z. Proof. intros z. unfold Z_inj_nat, Z_inj_nat_rev. destruct z eqn:Hdz. - reflexivity. - rewrite Pos2Nat.id. destruct (Pos.to_nat p~0) eqn:Hd. + pose proof Pos2Nat.is_pos p~0 as H. rewrite <- Nat.neq_0_lt_0 in H. exfalso; apply H, Hd. + reflexivity. - rewrite Pos2Nat.id. destruct (Pos.to_nat (Pos.pred_double p)) eqn: Hd. + pose proof Pos2Nat.is_pos (Pos.pred_double p) as H. rewrite <- Nat.neq_0_lt_0 in H. exfalso; apply H, Hd. + destruct (Pos.pred_double p) eqn:Hd2. * rewrite <- Pos.pred_double_succ in Hd2. apply Pos_pred_double_inj in Hd2. rewrite Hd2; reflexivity. * apply (f_equal Pos.succ) in Hd2. rewrite Pos.succ_pred_double in Hd2. rewrite <- Pos.xI_succ_xO in Hd2. inversion Hd2. * change xH with (Pos.pred_double xH) in Hd2. apply Pos_pred_double_inj in Hd2. rewrite Hd2; reflexivity. Qed. Lemma Z_inj_nat_inj: forall (x y : Z), Z_inj_nat x = Z_inj_nat y -> x = y. Proof. intros x y H. apply (f_equal Z_inj_nat_rev) in H. do 2 rewrite Z_inj_nat_id in H. assumption. Qed. Lemma constructive_indefinite_ground_description_Z: forall P : Z -> Prop, (forall z : Z, {P z} + {~ P z}) -> (exists z : Z, P z) -> {z : Z | P z}. Proof. apply (constructive_indefinite_ground_description Z Z_inj_nat Z_inj_nat_rev Z_inj_nat_id). Qed. coq-8.20.0/theories/Reals/Cauchy/ConstructiveRcomplete.v000066400000000000000000000653341466560755400232560ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* CReal) (l : CReal) : Set := forall p : positive, { n : nat | forall i:nat, le n i -> CReal_abs (un i - l) <= inject_Q (1#p) }. Definition Un_cauchy_mod (un : nat -> CReal) : Set := forall p : positive, { n : nat | forall i j:nat, le n i -> le n j -> CReal_abs (un i - un j) <= inject_Q (1#p) }. Lemma seq_cv_proper : forall (un : nat -> CReal) (a b : CReal), seq_cv un a -> a == b -> seq_cv un b. Proof. intros. intro p. specialize (H p) as [n H]. exists n. intros. rewrite <- H0. apply H, H1. Qed. #[global] Instance seq_cv_morph : forall (un : nat -> CReal), CMorphisms.Proper (CMorphisms.respectful CRealEq CRelationClasses.iffT) (seq_cv un). Proof. split. - intros. apply (seq_cv_proper un x). + exact H0. + exact H. - intros. apply (seq_cv_proper un y). + exact H0. + symmetry. exact H. Qed. (* Sharpen the archimedean property : constructive versions of the usual floor and ceiling functions. *) Definition Rfloor (a : CReal) : { p : Z & inject_Q (p#1) < a < inject_Q (p#1) + 2 }. Proof. destruct (CRealArchimedean a) as [n [H H0]]. exists (n-2)%Z. split. - setoid_replace (n - 2 # 1)%Q with ((n#1) + - 2)%Q. + rewrite inject_Q_plus, (opp_inject_Q 2). apply (CReal_plus_lt_reg_r 2). ring_simplify. rewrite CReal_plus_comm. exact H0. + rewrite Qinv_plus_distr. reflexivity. - setoid_replace (n - 2 # 1)%Q with ((n#1) + - 2)%Q. + rewrite inject_Q_plus, (opp_inject_Q 2). ring_simplify. exact H. + rewrite Qinv_plus_distr. reflexivity. Qed. (* ToDo: Move to ConstructiveCauchyAbs.v *) Lemma Qabs_Rabs : forall q : Q, inject_Q (Qabs q) == CReal_abs (inject_Q q). Proof. intro q. apply Qabs_case. - intros. rewrite CReal_abs_right. + reflexivity. + apply inject_Q_le, H. - intros. rewrite CReal_abs_left, opp_inject_Q. + reflexivity. + apply inject_Q_le, H. Qed. Lemma Qlt_trans_swap_hyp: forall x y z : Q, (y < z)%Q -> (x < y)%Q -> (x < z)%Q. Proof. intros x y z H1 H2. apply (Qlt_trans x y z); assumption. Qed. Lemma Qle_trans_swap_hyp: forall x y z : Q, (y <= z)%Q -> (x <= y)%Q -> (x <= z)%Q. Proof. intros x y z H1 H2. apply (Qle_trans x y z); assumption. Qed. (** This inequality is tight since it is equal for n=1 and n=2 *) Lemma Qpower_2powneg_le_inv: forall (n : positive), (2 * 2 ^ Z.neg n <= 1 # n)%Q. Proof. intros n. induction n using Pos.peano_ind. - cbn. lra. - rewrite <- Pos2Z.opp_pos, Pos2Z.inj_succ, Z.opp_succ, Pos2Z.opp_pos, <- Z.sub_1_r. rewrite Qpower_minus_pos. ring_simplify. apply (Qmult_le_l _ _ (1#2)) in IHn. 2: lra. ring_simplify in IHn. apply (Qle_trans _ _ _ IHn). unfold Qle, Qmult, Qnum, Qden. ring_simplify; rewrite Pos2Z.inj_succ, <- Z.add_1_l. clear IHn; induction n using Pos.peano_ind. + reflexivity. + rewrite Pos2Z.inj_succ, <- Z.add_1_l. (* ToDo: does this lemma really need to be named like this and have this statement? *) rewrite <- POrderedType.Positive_as_OT.add_1_l. rewrite POrderedType.Positive_as_OT.mul_add_distr_l. rewrite Pos2Z.inj_add. apply Z.add_le_mono. * lia. * exact IHn. Qed. Lemma Pospow_lin_le_2pow: forall (n : positive), (2 * n <= 2 ^ n)%positive. Proof. intros n. induction n using Pos.peano_ind. - cbn. lia. - rewrite Pos.mul_succ_r, Pos.pow_succ_r. lia. Qed. Lemma CReal_cv_self : forall (x : CReal) (n : positive), CReal_abs (x - inject_Q (seq x (Z.neg n))) <= inject_Q (1#n). Proof. intros x n. (* ToDo: CRealLt_asym should be names CRealLt_Le_weak and asym should be x False *) apply CRealLt_asym. apply (CRealLt_RQ_from_single_dist _ _ (Z.neg n - 1)%Z). unfold CReal_abs, CReal_abs_seq, CReal_abs_scale. unfold CReal_minus, CReal_plus, CReal_plus_seq, CReal_abs_scale. unfold CReal_opp, CReal_opp_seq, CReal_opp_scale. unfold inject_Q. do 4 rewrite CReal_red_seq; rewrite Qred_correct. ring_simplify (Z.neg n - 1 - 1)%Z. pose proof cauchy x (Z.neg n) (Z.neg n - 2)%Z (Z.neg n) ltac:(lia) ltac:(lia) as Hxbnd. apply Qopp_lt_compat in Hxbnd. apply (Qplus_lt_r _ _ (1#n)) in Hxbnd. apply (Qlt_trans_swap_hyp _ _ _ Hxbnd); clear Hxbnd x. rewrite Qpower_minus_pos. apply (Qplus_lt_r _ _ (2 ^ Z.neg n)%Q); ring_simplify. pose proof Qpower_2powneg_le_inv n as Hpowinv. pose proof Qpower_0_lt 2 (Z.neg n) ltac:(lra) as Hpowpos. lra. Qed. Lemma CReal_cv_self' : forall (x : CReal) (n : Z), CReal_abs (x - inject_Q (seq x n)) <= inject_Q (2^n). Proof. intros x n [k kmaj]. unfold CReal_abs, CReal_abs_seq, CReal_abs_scale in kmaj. unfold CReal_minus, CReal_plus, CReal_plus_seq, CReal_abs_scale in kmaj. unfold CReal_opp, CReal_opp_seq, CReal_opp_scale in kmaj. unfold inject_Q in kmaj. do 4 rewrite CReal_red_seq in kmaj; rewrite Qred_correct in kmaj. apply (Qlt_not_le _ _ kmaj). clear kmaj. rewrite CReal_red_seq. apply (Qplus_le_l _ _ (2^n)%Q); ring_simplify. pose proof cauchy x (Z.max (k-1)%Z n) (k-1)%Z n ltac:(lia) ltac:(lia) as Hxbnd. apply Qlt_le_weak in Hxbnd. apply (Qle_trans _ _ _ Hxbnd); clear Hxbnd. apply Z.max_case. - rewrite <- Qplus_0_l; apply Qplus_le_compat. + apply Qpower_pos; lra. + rewrite Qpower_minus_pos. pose proof (Qpower_0_lt 2 k)%Q; lra. - rewrite <- Qplus_0_r; apply Qplus_le_compat. + lra. + pose proof (Qpower_0_lt 2 k)%Q; lra. Qed. Definition QCauchySeqLin (un : positive -> Q) : Prop := forall (k : positive) (p q : positive), Pos.le k p -> Pos.le k q -> Qlt (Qabs (un p - un q)) (1 # k). (* We can probably reduce the factor 4. *) Lemma Rcauchy_limit : forall (xn : nat -> CReal) (xcau : Un_cauchy_mod xn), QCauchySeqLin (fun n : positive => let (p, _) := xcau (4 * n)%positive in seq (xn p) (4 * Z.neg n)%Z). Proof. intros xn xcau n p q Hp Hq. destruct (xcau (4 * p)%positive) as [i imaj], (xcau (4 * q)%positive) as [j jmaj]. assert (CReal_abs (xn i - xn j) <= inject_Q (1 # 4 * n)). { destruct (le_lt_dec i j). - apply (CReal_le_trans _ _ _ (imaj i j (Nat.le_refl _) l)). apply inject_Q_le. unfold Qle, Qnum, Qden. rewrite Z.mul_1_l, Z.mul_1_l. apply Pos2Z.pos_le_pos. apply Pos.mul_le_mono_l, Hp. - apply le_S, le_S_n in l. apply (CReal_le_trans _ _ _ (jmaj i j l (Nat.le_refl _))). apply inject_Q_le. unfold Qle, Qnum, Qden. rewrite Z.mul_1_l, Z.mul_1_l. apply Pos2Z.pos_le_pos. apply Pos.mul_le_mono_l, Hq. } clear jmaj imaj. setoid_replace (1#n)%Q with ((1#(3*n)) + ((1#(3*n)) + (1#(3*n))))%Q. 2: rewrite Qinv_plus_distr, Qinv_plus_distr; reflexivity. apply lt_inject_Q. rewrite inject_Q_plus. rewrite Qabs_Rabs. apply (CReal_le_lt_trans _ (CReal_abs (inject_Q (seq (xn i) (4 * Z.neg p)%Z) - xn i) + CReal_abs (xn i - inject_Q(seq (xn j) (4 * Z.neg q)%Z)))). - unfold Qminus. rewrite inject_Q_plus, opp_inject_Q. setoid_replace (inject_Q (seq (xn i) (4 * Z.neg p)%Z) + - inject_Q (seq (xn j) (4 * Z.neg q)%Z)) with (inject_Q (seq (xn i) (4 * Z.neg p)%Z) - xn i + (xn i - inject_Q (seq (xn j) (4 * Z.neg q)%Z))). 2: ring. apply CReal_abs_triang. - apply CReal_plus_le_lt_compat. + rewrite CReal_abs_minus_sym. apply (CReal_le_trans _ (inject_Q (1# 4*p))). * apply CReal_cv_self. * apply inject_Q_le. unfold Qle, Qnum, Qden. rewrite Z.mul_1_l, Z.mul_1_l. apply Pos2Z.pos_le_pos. apply (Pos.le_trans _ (4*n)). -- apply Pos.mul_le_mono_r. discriminate. -- apply Pos.mul_le_mono_l. exact Hp. + apply (CReal_le_lt_trans _ (CReal_abs (xn i - xn j + (xn j - inject_Q (seq (xn j) (4 * Z.neg q)%Z))))). * apply CReal_abs_morph. ring. * apply (CReal_le_lt_trans _ _ _ (CReal_abs_triang _ _)). rewrite inject_Q_plus. apply CReal_plus_le_lt_compat. -- apply (CReal_le_trans _ _ _ H). apply inject_Q_le. unfold Qle, Qnum, Qden. rewrite Z.mul_1_l, Z.mul_1_l. apply Pos2Z.pos_le_pos. apply Pos.mul_le_mono_r. discriminate. -- apply (CReal_le_lt_trans _ (inject_Q (1#4*q))). ++ apply CReal_cv_self. ++ apply inject_Q_lt. unfold Qlt, Qnum, Qden. rewrite Z.mul_1_l, Z.mul_1_l. apply Pos2Z.pos_lt_pos. apply (Pos.lt_le_trans _ (4*n)). ** apply Pos.mul_lt_mono_r. reflexivity. ** apply Pos.mul_le_mono_l. exact Hq. Qed. Definition CReal_from_cauchy_cm (n : Z) : positive := match n with | Z0 | Zpos _ => 1%positive | Zneg p => p end. Lemma CReal_from_cauchy_cm_mono : forall (n p : Z), (p <= n)%Z -> (CReal_from_cauchy_cm n <= CReal_from_cauchy_cm p)%positive. Proof. intros n p Hpn. unfold CReal_from_cauchy_cm; destruct n; destruct p; lia. Qed. Definition CReal_from_cauchy_seq (xn : nat -> CReal) (xcau : Un_cauchy_mod xn) (n : Z) : Q := let p := CReal_from_cauchy_cm n in let (q, _) := xcau (4 * 2^p)%positive in seq (xn q) (Z.neg p - 2)%Z. Lemma CReal_from_cauchy_cauchy : forall (xn : nat -> CReal) (xcau : Un_cauchy_mod xn), QCauchySeq (CReal_from_cauchy_seq xn xcau). Proof. intros xn xcau n p q Hp Hq. remember (CReal_from_cauchy_cm n) as n'. remember (CReal_from_cauchy_cm p) as p'. remember (CReal_from_cauchy_cm q) as q'. unfold CReal_from_cauchy_seq. rewrite <- Heqp', <- Heqq'. destruct (xcau (4 * 2^p')%positive) as [i imaj]. destruct (xcau (4 * 2^q')%positive) as [j jmaj]. assert (CReal_abs (xn i - xn j) <= inject_Q (1 # 4 * 2^n')). { destruct (le_lt_dec i j). - apply (CReal_le_trans _ _ _ (imaj i j (Nat.le_refl _) l)). apply inject_Q_le. unfold Qle, Qnum, Qden. rewrite Z.mul_1_l, Z.mul_1_l. apply Pos2Z.pos_le_pos. subst; apply Pos.mul_le_mono_l, Pos_pow_le_mono_r, CReal_from_cauchy_cm_mono, Hp. - apply le_S, le_S_n in l. apply (CReal_le_trans _ _ _ (jmaj i j l (Nat.le_refl _))). apply inject_Q_le. unfold Qle, Qnum, Qden. rewrite Z.mul_1_l, Z.mul_1_l. apply Pos2Z.pos_le_pos. subst; apply Pos.mul_le_mono_l, Pos_pow_le_mono_r, CReal_from_cauchy_cm_mono, Hq. } clear jmaj imaj. setoid_replace (2^n)%Q with ((1#3)*2^n + ((1#3)*2^n + (1#3)*2^n))%Q by ring. apply lt_inject_Q. rewrite inject_Q_plus. rewrite Qabs_Rabs. apply (CReal_le_lt_trans _ (CReal_abs (inject_Q (seq (xn i) (Z.neg p' - 2)%Z) - xn i) + CReal_abs (xn i - inject_Q(seq (xn j) (Z.neg q' - 2)%Z)))). { unfold Qminus. rewrite inject_Q_plus, opp_inject_Q. setoid_replace (inject_Q (seq (xn i) (Z.neg p' - 2)%Z) + - inject_Q (seq (xn j) (Z.neg q' - 2)%Z)) with (inject_Q (seq (xn i) (Z.neg p' - 2)%Z) - xn i + (xn i - inject_Q (seq (xn j) (Z.neg q' - 2)%Z))). 2: ring. apply CReal_abs_triang. } apply CReal_plus_le_lt_compat. { rewrite CReal_abs_minus_sym. apply (CReal_le_trans _ (inject_Q ((1#4)*2^(Z.neg p')))). - change (1#4)%Q with ((1#2)^2)%Q. rewrite Qmult_comm, <- Qpower_minus_pos. apply CReal_cv_self'. - apply inject_Q_le. apply Qmult_le_compat_nonneg. + lra. + { split. - apply Qpower_pos; lra. - apply Qpower_le_compat_l. + subst; unfold CReal_from_cauchy_cm; destruct p; lia. + lra. } } apply (CReal_le_lt_trans _ (CReal_abs (xn i - xn j + (xn j - inject_Q (seq (xn j) (Z.neg q' - 2)%Z))))). 1: apply CReal_abs_morph; ring. apply (CReal_le_lt_trans _ _ _ (CReal_abs_triang _ _)). rewrite inject_Q_plus. apply CReal_plus_le_lt_compat. { apply (CReal_le_trans _ _ _ H). apply inject_Q_le. rewrite Qmult_frac_l. rewrite <- (Z.pow_1_l (Z.pos n')) at 2 by lia. rewrite <- (Qpower_decomp_pos). change (1#2)%Q with (/2)%Q; rewrite Qinv_power, <- Qpower_opp. apply Qmult_le_compat_nonneg. - lra. - { split. - apply Qpower_pos; lra. - apply Qpower_le_compat_l. + subst; unfold CReal_from_cauchy_cm; destruct n; lia. + lra. } } apply (CReal_le_lt_trans _ (inject_Q ((1#4)*2^(Z.neg q')))). { change (1#4)%Q with ((1#2)^2)%Q. rewrite Qmult_comm, <- Qpower_minus_pos. apply CReal_cv_self'. } apply inject_Q_lt. setoid_rewrite Qmult_comm at 1 2. apply Qmult_le_lt_compat_pos. + { split. - apply Qpower_0_lt; lra. - apply Qpower_le_compat_l. + subst; unfold CReal_from_cauchy_cm. destruct q; lia. + lra. } + lra. Qed. Lemma Rup_pos (x : CReal) : { n : positive & x < inject_Q (Z.pos n # 1) }. Proof. intros. destruct (CRealArchimedean x) as [p [maj _]]. destruct p. - exists 1%positive. apply (CReal_lt_trans _ 0 _ maj). apply CRealLt_0_1. - exists p. exact maj. - exists 1%positive. apply (CReal_lt_trans _ (inject_Q (Z.neg p # 1)) _ maj). apply (CReal_lt_trans _ 0). + apply inject_Q_lt. reflexivity. + apply CRealLt_0_1. Qed. Lemma CReal_abs_upper_bound (x : CReal) : { n : positive & CReal_abs x < inject_Q (Z.pos n # 1) }. Proof. intros. destruct (Rup_pos x) as [np Hnp]. destruct (Rup_pos (-x)) as [nn Hnn]. exists (Pos.max np nn). apply Rabs_def1. - apply (CReal_lt_le_trans _ _ _ Hnp), inject_Q_le. unfold Qle, Qnum, Qden; ring_simplify. lia. - apply (CReal_lt_le_trans _ _ _ Hnn), inject_Q_le. unfold Qle, Qnum, Qden; ring_simplify. lia. Qed. Require Import Qminmax. Lemma CRealLt_QR_from_single_dist : forall (q : Q) (r : CReal) (n :Z), (2^n < seq r n - q)%Q -> inject_Q q < r . Proof. intros q r n Hapart. pose proof Qpower_0_lt 2 n ltac:(lra) as H2npos. destruct (QarchimedeanLowExp2_Z (seq r n - q - 2^n) ltac:(lra)) as [k Hk]. unfold CRealLt; exists (Z.min n (k-1))%Z. unfold inject_Q; rewrite CReal_red_seq. pose proof cauchy r n n (Z.min n (k-1))%Z ltac:(lia) ltac:(lia) as Hrbnd. pose proof Qpower_le_compat_l 2 (Z.min n (k - 1))%Z (k-1)%Z ltac:(lia) ltac:(lra). apply (Qmult_le_l _ _ 2 ltac:(lra)) in H. apply (Qle_lt_trans _ _ _ H); clear H. rewrite Qpower_minus_pos. ring_simplify. apply Qabs_Qlt_condition in Hrbnd. lra. Qed. Lemma CReal_abs_Qabs: forall (x : CReal) (q : Q) (n : Z), CReal_abs x <= inject_Q q -> (Qabs (seq x n) <= q + 2^n)%Q. Proof. intros x q n Hr. unfold CRealLe in Hr. apply Qnot_lt_le; intros Hq; apply Hr; clear Hr. apply (CRealLt_QR_from_single_dist _ _ n%Z). unfold CReal_abs, CReal_abs_seq; rewrite CReal_red_seq. lra. Qed. Lemma CReal_abs_Qabs_seq: forall (x : CReal) (n : Z), (seq (CReal_abs x) n == Qabs (seq x n))%Q. Proof. intros x n. unfold CReal_abs, CReal_abs_seq; rewrite CReal_red_seq. reflexivity. Qed. Lemma CReal_abs_Qabs_diff: forall (x y : CReal) (q : Q) (n : Z), CReal_abs (x - y) <= inject_Q q -> (Qabs (seq x n - seq y n) <= q + 2*2^n)%Q. Proof. intros x y q n Hr. unfold CRealLe in Hr. apply Qnot_lt_le; intros Hq; apply Hr; clear Hr. apply (CRealLt_QR_from_single_dist _ _ (n+1)%Z). unfold CReal_abs, CReal_abs_seq; rewrite CReal_red_seq. unfold CReal_minus, CReal_plus, CReal_plus_seq; rewrite CReal_red_seq, Qred_correct. unfold CReal_opp, CReal_opp_seq; rewrite CReal_red_seq. ring_simplify (n + 1 - 1)%Z. rewrite Qpower_plus by lra. ring_simplify; change (seq x n + - seq y n)%Q with (seq x n - seq y n)%Q. lra. Qed. (** Note: the <= in the conclusion is likely tight *) Lemma CRealLt_QR_to_single_dist : forall (q : Q) (x : CReal) (n : Z), inject_Q q < x -> (-(2^n) <= seq x n - q)%Q. Proof. intros q x n Hqltx. destruct (Qlt_le_dec (seq x n - q) (-(2^n)) ) as [Hdec|Hdec]. - exfalso. pose proof CRealLt_RQ_from_single_dist x q n ltac:(lra) as contra. apply CRealLt_asym in contra. apply contra, Hqltx. - apply Hdec. Qed. Lemma CRealLt_RQ_to_single_dist : forall (x : CReal) (q : Q) (n : Z), x < inject_Q q -> (-(2^n) <= q - seq x n)%Q. Proof. intros x q n Hxltq. destruct (Qlt_le_dec (q - seq x n) (-(2^n)) ) as [Hdec|Hdec]. - exfalso. pose proof CRealLt_QR_from_single_dist q x n ltac:(lra) as contra. apply CRealLt_asym in contra. apply contra, Hxltq. - apply Hdec. Qed. Lemma Pos2Z_pos_is_pos : forall (p : positive), (1 <= Z.pos p)%Z. Proof. intros p. lia. Qed. Lemma Qabs_Qgt_condition: forall x y : Q, (x < Qabs y)%Q <-> (x < y \/ x < -y)%Q. Proof. intros x y. apply Qabs_case; lra. Qed. Lemma CReal_from_cauchy_seq_bound : forall (xn : nat -> CReal) (xcau : Un_cauchy_mod xn) (i j : Z), (Qabs (CReal_from_cauchy_seq xn xcau i - CReal_from_cauchy_seq xn xcau j) <= 1)%Q. Proof. intros xn xcau i j. unfold CReal_from_cauchy_seq. destruct (xcau (4 * 2 ^ CReal_from_cauchy_cm i)%positive) as [i' imaj]. destruct (xcau (4 * 2 ^ CReal_from_cauchy_cm j)%positive) as [j' jmaj]. assert (CReal_abs (xn i' - xn j') <= inject_Q (1#4)) as Hxij. { destruct (le_lt_dec i' j'). - apply (CReal_le_trans _ _ _ (imaj i' j' (Nat.le_refl _) l)). apply inject_Q_le; unfold Qle, Qnum, Qden; ring_simplify. apply Pos2Z_pos_is_pos. - apply le_S, le_S_n in l. apply (CReal_le_trans _ _ _ (jmaj i' j' l (Nat.le_refl _))). apply inject_Q_le; unfold Qle, Qnum, Qden; ring_simplify. apply Pos2Z_pos_is_pos. } clear imaj jmaj. unfold CReal_abs, CReal_abs_seq in Hxij. unfold CRealLe, CRealLt in Hxij. rewrite CReal_red_seq in Hxij. apply Qnot_lt_le; intros Hxij'; apply Hxij; clear Hxij. exists (-2)%Z. unfold inject_Q; rewrite CReal_red_seq. unfold CReal_minus, CReal_plus, CReal_plus_seq; rewrite CReal_red_seq, Qred_correct. unfold CReal_opp, CReal_opp_seq; rewrite CReal_red_seq. change (2 * 2 ^ (-2))%Q with (2#4)%Q. pose proof cauchy (xn i') (-3)%Z (-3)%Z (Z.neg (CReal_from_cauchy_cm i) - 2)%Z ltac:(lia) ltac:(unfold CReal_from_cauchy_cm; destruct i; lia) as Hxibnd. pose proof cauchy (xn j') (-3)%Z (-3)%Z (Z.neg (CReal_from_cauchy_cm j) - 2)%Z ltac:(lia) ltac:(unfold CReal_from_cauchy_cm; destruct j; lia) as Hxjbnd. apply (Qplus_lt_l _ _ (1 # 4)%Q); ring_simplify. (* ToDo: ring_simplify should return reduced fractions *) setoid_replace (12#16)%Q with (3#4)%Q by ring. change (2^(-3))%Q with (1#8)%Q in Hxibnd, Hxjbnd. change (-2-1)%Z with (-3)%Z. apply Qabs_Qlt_condition in Hxibnd. apply Qabs_Qlt_condition in Hxjbnd. apply Qabs_Qgt_condition. apply Qabs_Qgt_condition in Hxij'. lra. Qed. Definition CReal_from_cauchy_scale (xn : nat -> CReal) (xcau : Un_cauchy_mod xn) : Z := Qbound_lt_ZExp2 (Qabs (CReal_from_cauchy_seq xn xcau (-1)) + 2)%Q. Lemma CReal_from_cauchy_bound : forall (xn : nat -> CReal) (xcau : Un_cauchy_mod xn), QBound (CReal_from_cauchy_seq xn xcau) (CReal_from_cauchy_scale xn xcau). Proof. intros xn xcau n. unfold CReal_from_cauchy_scale. (* Use the spec of Qbound_lt_ZExp2 to linearize the RHS *) apply (Qlt_trans_swap_hyp _ _ _ (Qbound_lt_ZExp2_spec _)). (* Massage the goal so that CReal_from_cauchy_seq_bound can be applied *) apply (Qplus_lt_l _ _ (-Qabs (CReal_from_cauchy_seq xn xcau (-1)))%Q); ring_simplify. assert(forall x y : Q, (x + -1*y == x-y)%Q) as Aux by (intros x y; lra); rewrite Aux; clear Aux. apply (Qle_lt_trans _ _ _ (Qabs_triangle_reverse _ _)). apply (Qle_lt_trans _ 1%Q _). 2: lra. apply CReal_from_cauchy_seq_bound. Qed. Definition CReal_from_cauchy (xn : nat -> CReal) (xcau : Un_cauchy_mod xn) : CReal := {| seq := CReal_from_cauchy_seq xn xcau; scale := CReal_from_cauchy_scale xn xcau; cauchy := CReal_from_cauchy_cauchy xn xcau; bound := CReal_from_cauchy_bound xn xcau |}. Lemma Rcauchy_complete : forall (xn : nat -> CReal), Un_cauchy_mod xn -> { l : CReal & seq_cv xn l }. Proof. intros xn cau. exists (CReal_from_cauchy xn cau). intro p. pose proof (CReal_cv_self' (CReal_from_cauchy xn cau) (Z.neg p - 1)%Z) as H. pose proof (cau (2*p)%positive) as [k cv]. rewrite CReal_abs_minus_sym in H. unfold CReal_from_cauchy at 1 in H. rewrite CReal_red_seq in H. unfold CReal_from_cauchy_seq in H. remember (CReal_from_cauchy_cm (Z.neg p - 1))%positive as i'. destruct (cau (4 * 2 ^ i')%positive) as [i imaj]. exists (max k i). intros j H0. setoid_replace (xn j - CReal_from_cauchy xn cau) with (xn j - inject_Q (seq (xn i) (Z.neg i' - 2)%Z) + (inject_Q (seq (xn i) (Z.neg i' - 2)%Z) - CReal_from_cauchy xn cau)). 2: ring. apply (CReal_le_trans _ _ _ (CReal_abs_triang _ _)). apply (CReal_le_trans _ (inject_Q (1#2*p) + inject_Q (1#2*p))). - apply CReal_plus_le_compat. 2: { apply (CReal_le_trans _ _ _ H). apply inject_Q_le. rewrite Qpower_minus_pos. assert(forall (n:Z) (p q : positive), n#(p*q) == (n#p) * (1#q))%Q as Aux by ( intros; unfold Qeq, Qmult, Qnum, Qden; ring ); rewrite Aux; clear Aux. rewrite Qmult_comm; apply Qmult_le_l; [lra|]. pose proof Qpower_2powneg_le_inv p. pose proof Qpower_0_lt 2 (Z.neg p)%Z; lra. } (* Use imaj to relate xn i and xn j *) specialize (imaj j i (Nat.le_trans _ _ _ (Nat.le_max_r _ _) H0) (Nat.le_refl _)). apply (CReal_le_trans _ (inject_Q (1 # 4 * p) + inject_Q (1 # 4 * p))). + setoid_replace (xn j - inject_Q (seq (xn i) (Z.neg i' - 2))) with (xn j - xn i + (xn i - inject_Q (seq (xn i) (Z.neg i' - 2)))). 2: ring. apply (CReal_le_trans _ _ _ (CReal_abs_triang _ _)). apply CReal_plus_le_compat. * apply (CReal_le_trans _ _ _ imaj). rewrite Heqi'. change (Z.neg p - 1)%Z with (Z.neg (p + 1))%Z. unfold CReal_from_cauchy_cm. apply inject_Q_le. unfold Qle, Qnum, Qden. rewrite Z.mul_1_l, Z.mul_1_l. apply Pos2Z.pos_le_pos, Pos.mul_le_mono_l. pose proof Pospow_lin_le_2pow p. rewrite Pos.add_1_r, Pos.pow_succ_r. lia. * clear imaj. (* Use CReal_cv_self' to relate xn i and seq (xn i) (...) *) pose proof CReal_cv_self' (xn i) (Z.neg i' - 2). apply (CReal_le_trans _ _ _ H1). apply inject_Q_le. rewrite Heqi'. change (Z.neg p - 1)%Z with (Z.neg (p + 1))%Z. unfold CReal_from_cauchy_cm. change (Z.neg (p + 1))%Z with (Z.neg p - 1)%Z. ring_simplify (Z.neg p - 1 - 2)%Z. rewrite Qpower_minus_pos. assert(forall (n:Z) (p q : positive), n#(p*q) == (n#p) * (1#q))%Q as Aux by ( intros; unfold Qeq, Qmult, Qnum, Qden; ring ); rewrite Aux; clear Aux. pose proof Qpower_2powneg_le_inv p. pose proof Qpower_0_lt 2 (Z.neg p)%Z; lra. + (* Solve remaining aux goals *) rewrite <- inject_Q_plus. rewrite (inject_Q_morph _ (1#2*p)). * apply CRealLe_refl. * rewrite Qinv_plus_distr; reflexivity. - rewrite <- inject_Q_plus. rewrite (inject_Q_morph _ (1#p)). + apply CRealLe_refl. + rewrite Qinv_plus_distr; reflexivity. Qed. Lemma CRealLtIsLinear : isLinearOrder CRealLt. Proof. repeat split. - exact CRealLt_asym. - exact CReal_lt_trans. - intros. destruct (CRealLt_dec x z y H). + left. exact c. + right. exact c. Qed. Lemma CRealAbsLUB : forall x y : CReal, x <= y /\ (- x) <= y <-> (CReal_abs x) <= y. Proof. split. - intros [H H0]. apply CReal_abs_le. split. 2: exact H. apply (CReal_plus_le_reg_r (y-x)). ring_simplify. exact H0. - intros. apply CReal_abs_def2 in H. destruct H. split. + exact H. + fold (-x <= y). apply (CReal_plus_le_reg_r (x-y)). ring_simplify. exact H0. Qed. Lemma CRealComplete : forall xn : nat -> CReal, (forall p : positive, {n : nat | forall i j : nat, (n <= i)%nat -> (n <= j)%nat -> (CReal_abs (xn i + - xn j)) <= (inject_Q (1 # p))}) -> {l : CReal & forall p : positive, {n : nat | forall i : nat, (n <= i)%nat -> (CReal_abs (xn i + - l)) <= (inject_Q (1 # p))}}. Proof. intros. destruct (Rcauchy_complete xn) as [l cv]. - intro p. destruct (H p) as [n a]. exists n. intros. exact (a i j H0 H1). - exists l. intros p. destruct (cv p). exists x. exact c. Qed. Lemma Qnot_le_iff_lt: forall x y : Q, ~ (x <= y)%Q <-> (y < x)%Q. Proof. intros x y; split. - apply Qnot_le_lt. - apply Qlt_not_le. Qed. Lemma Qnot_lt_iff_le: forall x y : Q, ~ (x < y)%Q <-> (y <= x)%Q. Proof. intros x y; split. - apply Qnot_lt_le. - apply Qle_not_lt. Qed. Lemma CRealLtDisjunctEpsilon : forall a b c d : CReal, (CRealLtProp a b \/ CRealLtProp c d) -> CRealLt a b + CRealLt c d. Proof. intros. (* Combine both existentials into one *) assert (exists n : Z, 2*2^n < seq b n - seq a n \/ 2*2^n < seq d n - seq c n)%Q. { destruct H. - destruct H as [n maj]. exists n. left. apply maj. - destruct H as [n maj]. exists n. right. apply maj. } apply constructive_indefinite_ground_description_Z in H0. - destruct H0 as [n maj]. destruct (Qlt_le_dec (2 * 2^n) (seq b n - seq a n)). + left. exists n. apply q. + assert (2 * 2^n < seq d n - seq c n)%Q. { destruct maj. - exfalso. apply (Qlt_not_le (2 * 2^n) (seq b n - seq a n)); assumption. - assumption. } clear maj. right. exists n. apply H0. - clear H0 H. intro n. destruct (Qlt_le_dec (2 * 2 ^ n)%Q (seq b n - seq a n)%Q) as [H1|H1]. + now left; left. + destruct (Qlt_le_dec (2 * 2 ^ n)%Q (seq d n - seq c n)%Q) as [H2|H2]. * now left; right. * now right; intros [H3|H3]; apply Qle_not_lt with (2 := H3). Qed. Definition CRealConstructive : ConstructiveReals := Build_ConstructiveReals CReal CRealLt CRealLtIsLinear CRealLtProp CRealLtEpsilon CRealLtForget CRealLtDisjunctEpsilon inject_Q inject_Q_lt lt_inject_Q CReal_plus CReal_opp CReal_mult inject_Q_plus inject_Q_mult CReal_isRing CReal_isRingExt CRealLt_0_1 CReal_plus_lt_compat_l CReal_plus_lt_reg_l CReal_mult_lt_0_compat CReal_inv CReal_inv_l CReal_inv_0_lt_compat CRealQ_dense Rup_pos CReal_abs CRealAbsLUB CRealComplete. coq-8.20.0/theories/Reals/Cauchy/PosExtra.v000066400000000000000000000013751466560755400204530ustar00rootroot00000000000000Require Import PArith. Require Import ZArith. Require Import Lia. Lemma Pos_pow_1_r: forall p : positive, (1^p = 1)%positive. Proof. intros p. assert (forall q:positive, Pos.iter id 1 q = 1)%positive as H1. { intros q; apply Pos.iter_invariant; tauto. } induction p. - cbn; rewrite IHp, H1; reflexivity. - cbn; rewrite IHp, H1; reflexivity. - reflexivity. Qed. Lemma Pos_le_multiple : forall n p : positive, (n <= p * n)%positive. Proof. intros n p. rewrite <- (Pos.mul_1_l n) at 1. apply Pos.mul_le_mono_r. destruct p; discriminate. Qed. Lemma Pos_pow_le_mono_r : forall a b c : positive, (b <= c)%positive -> (a ^ b <= a ^ c)%positive. Proof. intros a b c. pose proof Z.pow_le_mono_r (Z.pos a) (Z.pos b) (Z.pos c). lia. Qed. coq-8.20.0/theories/Reals/Cauchy/QExtra.v000066400000000000000000000213431466560755400201070ustar00rootroot00000000000000Require Import QArith. Require Import Qpower. Require Import Qabs. Require Import Qround. Require Import Lia. Require Import Lqa. (* This is only used in a few places and could be avoided *) Require Import PosExtra. (** * Power of 2 open and closed upper and lower bounds for [q : Q] *) Fixpoint Pos_log2floor_plus1 (p : positive) : positive := match p with | (p'~1)%positive => Pos.succ (Pos_log2floor_plus1 p') | (p'~0)%positive => Pos.succ (Pos_log2floor_plus1 p') | 1%positive => 1 end. Lemma Pos_log2floor_plus1_spec : forall (p : positive), (Pos.pow 2 (Pos_log2floor_plus1 p) <= 2 * p < 2 * Pos.pow 2 (Pos_log2floor_plus1 p))%positive. Proof. intros p. split. - induction p. + cbn. rewrite Pos.pow_succ_r. lia. + cbn. rewrite Pos.pow_succ_r. lia. + cbn. lia. - induction p. + cbn. rewrite Pos.pow_succ_r. lia. + cbn. rewrite Pos.pow_succ_r. lia. + cbn. lia. Qed. Fixpoint Pos_log2ceil_plus1 (p : positive) : positive := match p with | (p'~1)%positive => Pos.succ (Pos.succ (Pos_log2floor_plus1 p')) | (p'~0)%positive => Pos.succ (Pos_log2ceil_plus1 p') | 1%positive => 1 end. Lemma Pos_log2ceil_plus1_spec : forall (p : positive), (Pos.pow 2 (Pos_log2ceil_plus1 p) < 4 * p <= 2 * Pos.pow 2 (Pos_log2ceil_plus1 p))%positive. Proof. intros p. split. - induction p. + cbn. do 2 rewrite Pos.pow_succ_r. pose proof Pos_log2floor_plus1_spec p. lia. + cbn. rewrite Pos.pow_succ_r. lia. + cbn. lia. - induction p. + cbn. do 2 rewrite Pos.pow_succ_r. pose proof Pos_log2floor_plus1_spec p. lia. + cbn. rewrite Pos.pow_succ_r. lia. + cbn. lia. Qed. Fixpoint Pos_is_pow2 (p : positive) : bool := match p with | (p'~1)%positive => false | (p'~0)%positive => Pos_is_pow2 p' | 1%positive => true end. (** ** Power of two closed upper bound [q <= 2^z] *) Definition Qbound_le_ZExp2 (q : Q) : Z := match Qnum q with (* The -1000 is a compromise between a tight Archimedian and avoiding too large numbers *) | Z0 => -1000 | Zneg p => 0 | Zpos p => (Z.pos (Pos_log2ceil_plus1 p) - Z.pos (Pos_log2floor_plus1 (Qden q)))%Z end. Lemma Qbound_le_ZExp2_spec : forall (q : Q), (q <= 2^(Qbound_le_ZExp2 q))%Q. Proof. intros q. destruct q as [num den]; unfold Qbound_le_ZExp2, Qnum; destruct num. - intros contra; inversion contra. - rewrite Qpower_minus by lra. apply Qle_shift_div_l. + apply Qpower_0_lt; lra. + do 2 rewrite Qpower_decomp_pos, Pos_pow_1_r. unfold Qle, Qmult, Qnum, Qden. rewrite Pos.mul_1_r, Z.mul_1_r. pose proof Pos_log2ceil_plus1_spec p as Hnom. pose proof Pos_log2floor_plus1_spec den as Hden. apply (Zmult_le_reg_r _ _ 2). * lia. * replace (Z.pos p * 2 ^ Z.pos (Pos_log2floor_plus1 den) * 2)%Z with ((Z.pos p * 2) * 2 ^ Z.pos (Pos_log2floor_plus1 den))%Z by ring. replace (2 ^ Z.pos (Pos_log2ceil_plus1 p) * Z.pos den * 2)%Z with (2 ^ Z.pos (Pos_log2ceil_plus1 p) * (Z.pos den * 2))%Z by ring. apply Z.mul_le_mono_nonneg; lia. - intros contra; inversion contra. Qed. Definition Qbound_leabs_ZExp2 (q : Q) : Z := Qbound_le_ZExp2 (Qabs q). Lemma Qbound_leabs_ZExp2_spec : forall (q : Q), (Qabs q <= 2^(Qbound_leabs_ZExp2 q))%Q. Proof. intros q. unfold Qbound_leabs_ZExp2; apply Qabs_case; intros. 1,2: apply Qbound_le_ZExp2_spec. Qed. (** ** Power of two open upper bound [q < 2^z] and [Qabs q < 2^z] *) (** Compute a z such that q<2^z. z shall be close to as small as possible, but we need a compromise between the tighness of the bound and the computation speed and proof complexity. Looking just at the log2 of the numerator and denominator, this is a tight bound except when the numerator is a power of 2 and the denomintor is not. E.g. this return 4/5 < 2^1 instead of 4/5< 2^0. If q==0, we return -1000, because as binary integer this has just 10 bits but 2^-1000 should be smaller than almost any number in practice. If numbers are much smaller, computations might be inefficient. *) Definition Qbound_lt_ZExp2 (q : Q) : Z := match Qnum q with (* The -1000 is a compromise between a tight Archimedian and avoiding too large numbers *) | Z0 => -1000 | Zneg p => 0 | Zpos p => Z.pos_sub (Pos.succ (Pos_log2floor_plus1 p)) (Pos_log2floor_plus1 (Qden q)) end. Remark Qbound_lt_ZExp2_test_1 : Qbound_lt_ZExp2 (4#4) = 1%Z. reflexivity. Qed. Remark Qbound_lt_ZExp2_test_2 : Qbound_lt_ZExp2 (5#4) = 1%Z. reflexivity. Qed. Remark Qbound_lt_ZExp2_test_3 : Qbound_lt_ZExp2 (4#5) = 1%Z. reflexivity. Qed. Remark Qbound_lt_ZExp2_test_4 : Qbound_lt_ZExp2 (7#5) = 1%Z. reflexivity. Qed. Lemma Qbound_lt_ZExp2_spec : forall (q : Q), (q < 2^(Qbound_lt_ZExp2 q))%Q. Proof. intros q. destruct q as [num den]; unfold Qbound_lt_ZExp2, Qnum; destruct num. - reflexivity. - (* Todo: A lemma like Pos2Z.add_neg_pos for minus would be nice *) change (Z.pos_sub (Pos.succ (Pos_log2floor_plus1 p)) (Pos_log2floor_plus1 (Qden (Z.pos p # den))))%Z with ((Z.pos (Pos.succ (Pos_log2floor_plus1 p)) - Z.pos (Pos_log2floor_plus1 (Qden (Z.pos p # den)))))%Z. rewrite Qpower_minus by lra. apply Qlt_shift_div_l. + apply Qpower_0_lt; lra. + do 2 rewrite Qpower_decomp_pos, Pos_pow_1_r. unfold Qlt, Qmult, Qnum, Qden. rewrite Pos.mul_1_r, Z.mul_1_r. pose proof Pos_log2floor_plus1_spec p as Hnom. pose proof Pos_log2floor_plus1_spec den as Hden. apply (Zmult_lt_reg_r _ _ 2). * lia. * rewrite Pos2Z.inj_succ, <- Z.add_1_r. rewrite Z.pow_add_r by lia. replace (Z.pos p * 2 ^ Z.pos (Pos_log2floor_plus1 den) * 2)%Z with (2 ^ Z.pos (Pos_log2floor_plus1 den) * (Z.pos p * 2))%Z by ring. replace (2 ^ Z.pos (Pos_log2floor_plus1 p) * 2 ^ 1 * Z.pos den * 2)%Z with ((Z.pos den * 2) * (2 * 2 ^ Z.pos (Pos_log2floor_plus1 p)))%Z by ring. (* ToDo: this is weaker than neccessary: Z.mul_lt_mono_nonneg. *) apply Zmult_lt_compat2; lia. - cbn. (* ToDo: lra could know that negative fractions are negative *) assert (Z.neg p # den < 0) as Hnegfrac by (unfold Qlt, Qnum, Qden; lia). lra. Qed. Definition Qbound_ltabs_ZExp2 (q : Q) : Z := Qbound_lt_ZExp2 (Qabs q). Lemma Qbound_ltabs_ZExp2_spec : forall (q : Q), (Qabs q < 2^(Qbound_ltabs_ZExp2 q))%Q. Proof. intros q. unfold Qbound_ltabs_ZExp2; apply Qabs_case; intros. 1,2: apply Qbound_lt_ZExp2_spec. Qed. (** ** Power of 2 open lower bounds for [2^z < q] and [2^z < Qabs q] *) (** Note: the -2 is required cause of the Qlt limit. In case q is a power of two, the lower and upper bound must be a factor of 4 apart *) Definition Qlowbound_ltabs_ZExp2 (q : Q) : Z := -2 + Qbound_ltabs_ZExp2 q. Lemma Qlowbound_ltabs_ZExp2_inv: forall q : Q, q > 0 -> Qlowbound_ltabs_ZExp2 q = (- Qbound_ltabs_ZExp2 (/q))%Z. Proof. intros q Hqgt0. destruct q as [n d]. unfold Qlowbound_ltabs_ZExp2, Qbound_ltabs_ZExp2, Qbound_lt_ZExp2, Qnum. destruct n. - inversion Hqgt0. - unfold Qabs, Z.abs, Qinv, Qnum, Qden. rewrite -> Z.pos_sub_opp. do 2 rewrite <- Pos2Z.add_pos_neg. lia. - inversion Hqgt0. Qed. Lemma Qlowbound_ltabs_ZExp2_opp: forall q : Q, (Qlowbound_ltabs_ZExp2 q = Qlowbound_ltabs_ZExp2 (-q))%Z. Proof. intros q. destruct q as [[|n|n] d]; reflexivity. Qed. Lemma Qlowbound_lt_ZExp2_spec : forall (q : Q) (Hqgt0 : q > 0), (2^(Qlowbound_ltabs_ZExp2 q) < q)%Q. Proof. intros q Hqgt0. pose proof Qbound_ltabs_ZExp2_spec (/q) as Hspecub. rewrite Qlowbound_ltabs_ZExp2_inv by exact Hqgt0. rewrite Qpower_opp. setoid_rewrite <- (Qinv_involutive q) at 2. apply -> Qinv_lt_contravar. - rewrite Qabs_pos in Hspecub. + exact Hspecub. + apply Qlt_le_weak, Qinv_lt_0_compat, Hqgt0. - apply Qpower_0_lt; lra. - apply Qinv_lt_0_compat, Hqgt0. Qed. Lemma Qlowbound_ltabs_ZExp2_spec : forall (q : Q) (Hqgt0 : ~ q == 0), (2^(Qlowbound_ltabs_ZExp2 q) < Qabs q)%Q. Proof. intros q Hqgt0. destruct (Q_dec 0 q) as [[H|H]|H]. - rewrite Qabs_pos by lra. apply Qlowbound_lt_ZExp2_spec, H. - rewrite Qabs_neg by lra. rewrite Qlowbound_ltabs_ZExp2_opp. apply Qlowbound_lt_ZExp2_spec. lra. - lra. Qed. (** ** Existential formulations of power of 2 lower and upper bounds *) Definition QarchimedeanExp2_Z (q : Q) : {z : Z | (q < 2^z)%Q} := exist _ (Qbound_lt_ZExp2 q) (Qbound_lt_ZExp2_spec q). Definition QarchimedeanAbsExp2_Z (q : Q) : {z : Z | (Qabs q < 2^z)%Q} := exist _ (Qbound_ltabs_ZExp2 q) (Qbound_ltabs_ZExp2_spec q). Definition QarchimedeanLowExp2_Z (q : Q) (Hqgt0 : q > 0) : {z : Z | (2^z < q)%Q} := exist _ (Qlowbound_ltabs_ZExp2 q) (Qlowbound_lt_ZExp2_spec q Hqgt0). Definition QarchimedeanLowAbsExp2_Z (q : Q) (Hqgt0 : ~ q == 0) : {z : Z | (2^z < Qabs q)%Q} := exist _ (Qlowbound_ltabs_ZExp2 q) (Qlowbound_ltabs_ZExp2_spec q Hqgt0). coq-8.20.0/theories/Reals/Cauchy_prod.v000066400000000000000000000216041466560755400177270ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* R) (N:nat), (0 < N)%nat -> sum_f_R0 An N = sum_f_R0 An (pred N) + An N. Proof. intros. replace N with (S (pred N)). - rewrite tech5. reflexivity. - apply Nat.lt_succ_pred with 0%nat; assumption. Qed. (**********) Lemma sum_plus : forall (An Bn:nat -> R) (N:nat), sum_f_R0 (fun l:nat => An l + Bn l) N = sum_f_R0 An N + sum_f_R0 Bn N. Proof. intros. induction N as [| N HrecN]. - reflexivity. - do 3 rewrite tech5. rewrite HrecN; ring. Qed. (* The main result *) Theorem cauchy_finite : forall (An Bn:nat -> R) (N:nat), (0 < N)%nat -> sum_f_R0 An N * sum_f_R0 Bn N = sum_f_R0 (fun k:nat => sum_f_R0 (fun p:nat => An p * Bn (k - p)%nat) k) N + sum_f_R0 (fun k:nat => sum_f_R0 (fun l:nat => An (S (l + k)) * Bn (N - l)%nat) (pred (N - k))) (pred N). Proof. intros; induction N as [| N HrecN]. { elim (Nat.lt_irrefl _ H). } assert (H0:N = 0%nat \/ (0 < N)%nat). { inversion H. - left; reflexivity. - right; apply Nat.lt_le_trans with 1%nat; [ apply Nat.lt_succ_diag_r | exact H1 ]. } elim H0; intro. { rewrite H1; simpl; ring. } replace (pred (S N)) with (S (pred N)) by (simpl; apply Nat.lt_succ_pred with 0%nat; assumption). do 5 rewrite tech5. rewrite Rmult_plus_distr_r; rewrite Rmult_plus_distr_l; rewrite (HrecN H1). repeat rewrite Rplus_assoc; apply Rplus_eq_compat_l. replace (pred (S N - S (pred N))) with 0%nat by auto with zarith. rewrite Rmult_plus_distr_l; replace (sum_f_R0 (fun l:nat => An (S (l + S (pred N))) * Bn (S N - l)%nat) 0) with (An (S N) * Bn (S N)). 2:{ simpl. replace (S (pred N)) with N by auto with zarith. reflexivity. } repeat rewrite <- Rplus_assoc; do 2 rewrite <- (Rplus_comm (An (S N) * Bn (S N))); repeat rewrite Rplus_assoc; apply Rplus_eq_compat_l. rewrite Nat.sub_diag; assert (H2:N = 1%nat \/ (2 <= N)%nat). { inversion H1. - left; reflexivity. - right; apply le_n_S; assumption. } elim H2; intro. { rewrite H3; simpl; ring. } replace (sum_f_R0 (fun k:nat => sum_f_R0 (fun l:nat => An (S (l + k)) * Bn (N - l)%nat) (pred (N - k))) (pred N)) with (sum_f_R0 (fun k:nat => sum_f_R0 (fun l:nat => An (S (S (l + k))) * Bn (N - l)%nat) (pred (pred (N - k)))) (pred (pred N)) + sum_f_R0 (fun l:nat => An (S l) * Bn (N - l)%nat) (pred N)). 2:{ rewrite Rplus_comm. rewrite (decomp_sum (fun k:nat => sum_f_R0 (fun l:nat => An (S (l + k)) * Bn (N - l)%nat) (pred (N - k))) (pred N)). 2:{ auto with zarith. } rewrite Nat.sub_0_r. replace (sum_f_R0 (fun l:nat => An (S (l + 0)) * Bn (N - l)%nat) (pred N)) with (sum_f_R0 (fun l:nat => An (S l) * Bn (N - l)%nat) (pred N)). 2:{ apply sum_eq; intros. replace (i + 0)%nat with i by trivial; reflexivity. } apply Rplus_eq_compat_l. apply sum_eq; intros. replace (pred (N - S i)) with (pred (pred (N - i))) by auto with zarith. apply sum_eq; intros. replace (i0 + S i)%nat with (S (i0 + i)) by auto with zarith. reflexivity. } replace (sum_f_R0 (fun p:nat => An p * Bn (S N - p)%nat) N) with (sum_f_R0 (fun l:nat => An (S l) * Bn (N - l)%nat) (pred N) + An 0%nat * Bn (S N)). 2:{ rewrite Rplus_comm. rewrite (decomp_sum (fun p:nat => An p * Bn (S N - p)%nat) N). - reflexivity. - assumption. } repeat rewrite <- Rplus_assoc; rewrite <- (Rplus_comm (sum_f_R0 (fun l:nat => An (S l) * Bn (N - l)%nat) (pred N))) ; repeat rewrite Rplus_assoc; apply Rplus_eq_compat_l. replace (sum_f_R0 (fun k:nat => sum_f_R0 (fun l:nat => An (S (l + k)) * Bn (S N - l)%nat) (pred (S N - k))) (pred N)) with (sum_f_R0 (fun k:nat => sum_f_R0 (fun l:nat => An (S (S (l + k))) * Bn (N - l)%nat) (pred (N - k))) (pred N) + Bn (S N) * sum_f_R0 (fun l:nat => An (S l)) (pred N)). 2:{ replace (sum_f_R0 (fun k:nat => sum_f_R0 (fun l:nat => An (S (l + k)) * Bn (S N - l)%nat) (pred (S N - k))) (pred N)) with (sum_f_R0 (fun k:nat => sum_f_R0 (fun l:nat => An (S (S (l + k))) * Bn (N - l)%nat) (pred (N - k)) + An (S k) * Bn (S N)) (pred N)). { rewrite (sum_plus (fun k:nat => sum_f_R0 (fun l:nat => An (S (S (l + k))) * Bn (N - l)%nat) (pred (N - k))) (fun k:nat => An (S k) * Bn (S N))). apply Rplus_eq_compat_l. rewrite scal_sum; reflexivity. } apply sum_eq; intros; rewrite Rplus_comm; rewrite (decomp_sum (fun l:nat => An (S (l + i)) * Bn (S N - l)%nat) (pred (S N - i))). 2:{ auto with zarith. } replace (0 + i)%nat with i by ring. rewrite Nat.sub_0_r; apply Rplus_eq_compat_l. replace (pred (pred (S N - i))) with (pred (N - i)) by auto with zarith. apply sum_eq; intros. replace (S N - S i0)%nat with (N - i0)%nat; [ idtac | reflexivity ]. replace (S i0 + i)%nat with (S (i0 + i)) by auto with zarith. reflexivity. } rewrite (decomp_sum An N H1); rewrite Rmult_plus_distr_r; repeat rewrite <- Rplus_assoc; rewrite <- (Rplus_comm (An 0%nat * Bn (S N))); repeat rewrite Rplus_assoc; apply Rplus_eq_compat_l. repeat rewrite <- Rplus_assoc; rewrite <- (Rplus_comm (sum_f_R0 (fun i:nat => An (S i)) (pred N) * Bn (S N))); rewrite <- (Rplus_comm (Bn (S N) * sum_f_R0 (fun i:nat => An (S i)) (pred N))); rewrite (Rmult_comm (Bn (S N))); repeat rewrite Rplus_assoc; apply Rplus_eq_compat_l. replace (sum_f_R0 (fun k:nat => sum_f_R0 (fun l:nat => An (S (S (l + k))) * Bn (N - l)%nat) (pred (N - k))) (pred N)) with (sum_f_R0 (fun k:nat => sum_f_R0 (fun l:nat => An (S (S (l + k))) * Bn (N - l)%nat) (pred (pred (N - k)))) (pred (pred N)) + An (S N) * sum_f_R0 (fun l:nat => Bn (S l)) (pred N)). { rewrite (decomp_sum Bn N H1); rewrite Rmult_plus_distr_l. set (Z := sum_f_R0 (fun k:nat => sum_f_R0 (fun l:nat => An (S (S (l + k))) * Bn (N - l)%nat) (pred (pred (N - k)))) (pred (pred N))); set (Z2 := sum_f_R0 (fun i:nat => Bn (S i)) (pred N)); ring. } rewrite (sum_N_predN (fun k:nat => sum_f_R0 (fun l:nat => An (S (S (l + k))) * Bn (N - l)%nat) (pred (N - k))) (pred N)). 2:{ auto with zarith. } replace (sum_f_R0 (fun k:nat => sum_f_R0 (fun l:nat => An (S (S (l + k))) * Bn (N - l)%nat) (pred (N - k))) (pred (pred N))) with (sum_f_R0 (fun k:nat => sum_f_R0 (fun l:nat => An (S (S (l + k))) * Bn (N - l)%nat) (pred (pred (N - k))) + An (S N) * Bn (S k)) ( pred (pred N))). 2:{ apply sum_eq; intros; rewrite (sum_N_predN (fun l:nat => An (S (S (l + i))) * Bn (N - l)%nat) (pred (N - i))). 2:{ auto with zarith. } replace (S (S (pred (N - i) + i))) with (S N) by auto with zarith. replace (N - pred (N - i))%nat with (S i) by auto with zarith. reflexivity. } rewrite (sum_plus (fun k:nat => sum_f_R0 (fun l:nat => An (S (S (l + k))) * Bn (N - l)%nat) (pred (pred (N - k)))) (fun k:nat => An (S N) * Bn (S k)) (pred (pred N))). repeat rewrite Rplus_assoc; apply Rplus_eq_compat_l. replace (pred (N - pred N)) with 0%nat by auto with zarith. simpl; rewrite Nat.sub_0_r. replace (S (pred N)) with N by auto with zarith. replace (sum_f_R0 (fun k:nat => An (S N) * Bn (S k)) (pred (pred N))) with (sum_f_R0 (fun k:nat => Bn (S k) * An (S N)) (pred (pred N))). 2:{ apply sum_eq; intros; apply Rmult_comm. } rewrite <- (scal_sum (fun l:nat => Bn (S l)) (pred (pred N)) (An (S N))); rewrite (sum_N_predN (fun l:nat => Bn (S l)) (pred N)). 2:{ auto with zarith. } replace (S (pred N)) with N by auto with zarith. ring. Qed. coq-8.20.0/theories/Reals/ClassicalConstructiveReals.v000066400000000000000000000273001466560755400227640ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * INRIA, CNRS and contributors - Copyright 1999-2019 *) (* (a < b)%R + (c < d)%R. Proof. intros. destruct (total_order_T a b). - destruct s. + left. exact r. + right. destruct H. * exfalso. subst a. exact (Rlt_asym b b H H). * exact H. - right. destruct H. + exfalso. exact (Rlt_asym _ _ H r). + exact H. Qed. (* The constructive equality on R. *) Definition Req_constr (x y : R) : Prop := (x < y -> False) /\ (y < x -> False). Lemma Req_constr_refl : forall x:R, Req_constr x x. Proof. split. - intro H. exact (Rlt_asym _ _ H H). - intro H. exact (Rlt_asym _ _ H H). Qed. Lemma Req_constr_leibniz : forall x y:R, Req_constr x y -> x = y. Proof. intros. destruct (total_order_T x y). 1:destruct s. - exfalso. destruct H. contradiction. - exact e. - exfalso. destruct H. contradiction. Qed. Definition IQR (q : Q) := Rabst (inject_Q q). Lemma IQR_zero_quot : Req_constr (IQR 0) R0. Proof. unfold IQR. rewrite R0_def. apply Req_constr_refl. Qed. (* Not RealField.RTheory, because it uses Leibniz equality. *) Lemma Rring : ring_theory (IQR 0) (IQR 1) Rplus Rmult (fun x y : R => (x + - y)%R) Ropp Req_constr. Proof. split. - intro x. replace (IQR 0 + x) with x. + apply Req_constr_refl. + apply Rquot1. rewrite Rrepr_plus. unfold IQR. rewrite Rquot2. rewrite CReal_plus_0_l. reflexivity. - intros. replace (x + y) with (y + x). + apply Req_constr_refl. + apply Rquot1. do 2 rewrite Rrepr_plus. apply CReal_plus_comm. - intros. replace (x + (y + z)) with (x + y + z). + apply Req_constr_refl. + apply Rquot1. do 4 rewrite Rrepr_plus. apply CReal_plus_assoc. - intro x. replace (IQR 1 * x) with x. + apply Req_constr_refl. + unfold IQR. apply Rquot1. rewrite Rrepr_mult, Rquot2, CReal_mult_1_l. reflexivity. - intros. replace (x * y) with (y * x). + apply Req_constr_refl. + apply Rquot1. do 2 rewrite Rrepr_mult. apply CReal_mult_comm. - intros. replace (x * (y * z)) with (x * y * z). + apply Req_constr_refl. + apply Rquot1. do 4 rewrite Rrepr_mult. apply CReal_mult_assoc. - intros. replace ((x + y) * z) with (x * z + y * z). + apply Req_constr_refl. + apply Rquot1. rewrite Rrepr_mult, Rrepr_plus, Rrepr_plus, Rrepr_mult, Rrepr_mult. symmetry. apply CReal_mult_plus_distr_r. - intros. apply Req_constr_refl. - intros. replace (x + - x) with R0. + unfold IQR. rewrite R0_def. apply Req_constr_refl. + apply Rquot1. rewrite Rrepr_plus, Rrepr_opp, CReal_plus_opp_r, Rrepr_0. reflexivity. Qed. Lemma RringExt : ring_eq_ext Rplus Rmult Ropp Req_constr. Proof. split. - intros x y H z t H0. apply Req_constr_leibniz in H. apply Req_constr_leibniz in H0. destruct H, H0. apply Req_constr_refl. - intros x y H z t H0. apply Req_constr_leibniz in H. apply Req_constr_leibniz in H0. destruct H, H0. apply Req_constr_refl. - intros x y H. apply Req_constr_leibniz in H. destruct H. apply Req_constr_refl. Qed. Lemma Rleft_inverse : forall r : R, (sum (r < IQR 0) (IQR 0 < r)) -> Req_constr (/ r * r) (IQR 1). Proof. intros. rewrite Rinv_l. - unfold IQR. rewrite <- R1_def. apply Req_constr_refl. - destruct H. + intro abs. subst r. unfold IQR in r0. rewrite <- R0_def in r0. apply (Rlt_asym _ _ r0 r0). + intro abs. subst r. unfold IQR in r0. rewrite <- R0_def in r0. apply (Rlt_asym _ _ r0 r0). Qed. Lemma Rinv_pos : forall r : R, (sum (r < IQR 0) (IQR 0 < r)) -> IQR 0 < r -> IQR 0 < / r. Proof. intros. rewrite Rlt_def. apply CRealLtForget. rewrite Rlt_def in H0. apply CRealLtEpsilon in H0. unfold IQR in H0. rewrite Rquot2 in H0. rewrite (Rrepr_inv r (inr H0)). unfold IQR. rewrite Rquot2. apply CReal_inv_0_lt_compat, H0. Qed. Lemma Rmult_pos : forall x y : R, IQR 0 < x -> IQR 0 < y -> IQR 0 < x * y. Proof. intros. rewrite Rlt_def. apply CRealLtForget. unfold IQR. rewrite Rquot2. rewrite Rrepr_mult. apply CReal_mult_lt_0_compat. - rewrite Rlt_def in H. apply CRealLtEpsilon in H. unfold IQR in H. rewrite Rquot2 in H. exact H. - unfold IQR in H0. rewrite Rlt_def in H0. apply CRealLtEpsilon in H0. rewrite Rquot2 in H0. exact H0. Qed. Lemma Rplus_reg_l : forall r r1 r2, r + r1 < r + r2 -> r1 < r2. Proof. intros. rewrite Rlt_def in H. apply CRealLtEpsilon in H. rewrite Rrepr_plus, Rrepr_plus in H. apply CReal_plus_lt_reg_l in H. rewrite Rlt_def. apply CRealLtForget. exact H. Qed. Lemma Rzero_lt_one : IQR 0 < IQR 1. Proof. rewrite Rlt_def. apply CRealLtForget. unfold IQR. rewrite Rquot2, Rquot2. apply CRealLt_0_1. Qed. Lemma plus_IQR : forall q r : Q, IQR (q + r) = IQR q + IQR r. Proof. intros. unfold IQR. apply Rquot1. rewrite Rquot2, Rrepr_plus, Rquot2, Rquot2. apply inject_Q_plus. Qed. Lemma mult_IQR : forall q r : Q, IQR (q * r) = IQR q * IQR r. Proof. intros. unfold IQR. apply Rquot1. rewrite Rquot2, Rrepr_mult, Rquot2, Rquot2. apply inject_Q_mult. Qed. Lemma IQR_lt : forall n m:Q, (n < m)%Q -> IQR n < IQR m. Proof. intros. rewrite Rlt_def. apply CRealLtForget. unfold IQR. rewrite Rquot2, Rquot2. apply inject_Q_lt, H. Qed. Lemma lt_IQR : forall n m:Q, IQR n < IQR m -> (n < m)%Q. Proof. intros. rewrite Rlt_def in H. apply CRealLtEpsilon in H. unfold IQR in H. rewrite Rquot2, Rquot2 in H. apply lt_inject_Q, H. Qed. Lemma IQR_plus_quot : forall q r : Q, Req_constr (IQR (q + r)) (IQR q + IQR r). Proof. intros. rewrite plus_IQR. apply Req_constr_refl. Qed. Lemma IQR_mult_quot : forall q r : Q, Req_constr (IQR (q * r)) (IQR q * IQR r). Proof. intros. rewrite mult_IQR. apply Req_constr_refl. Qed. Lemma Rabove_pos : forall x : R, {n : positive & x < IQR (Z.pos n # 1)}. Proof. intros. destruct (Rup_nat (Rrepr x)) as [n nmaj]. exists (Pos.of_nat n). unfold IQR. rewrite Rlt_def, Rquot2. apply CRealLtForget. apply (CReal_lt_le_trans _ _ _ nmaj). apply inject_Q_le. unfold Qle, Qnum, Qden. do 2 rewrite Z.mul_1_r. destruct n. - discriminate. - rewrite <- positive_nat_Z. rewrite Nat2Pos.id. + apply Z.le_refl. + discriminate. Qed. Lemma Rarchimedean : forall x y : R, x < y -> {q : Q & ((x < IQR q) * (IQR q < y))%type}. Proof. intros. rewrite Rlt_def in H. apply CRealLtEpsilon in H. apply CRealQ_dense in H. destruct H as [q [H2 H3]]. exists q. split. - rewrite Rlt_def. apply CRealLtForget. unfold IQR. rewrite Rquot2. exact H2. - rewrite Rlt_def. apply CRealLtForget. unfold IQR. rewrite Rquot2. exact H3. Qed. Lemma RabsLUB : forall x y : R, (y < x -> False) /\ (y < - x -> False) <-> (y < Rabst (CReal_abs (Rrepr x)) -> False). Proof. split. - intros. rewrite Rlt_def in H0. apply CRealLtEpsilon in H0. rewrite Rquot2 in H0. destruct H. apply (CReal_abs_le (Rrepr x) (Rrepr y)). 2: exact H0. split. + apply (CReal_plus_le_reg_l (Rrepr y - Rrepr x)). ring_simplify. intro abs2. apply H1. rewrite Rlt_def. apply CRealLtForget. rewrite Rrepr_opp. exact abs2. + intro abs2. apply H. rewrite Rlt_def. apply CRealLtForget. exact abs2. - intros. split. + intro abs. apply H. rewrite Rlt_def. apply CRealLtForget. rewrite Rquot2. rewrite Rlt_def in abs. apply CRealLtEpsilon in abs. apply (CReal_lt_le_trans _ _ _ abs). apply CReal_le_abs. + intro abs. apply H. rewrite Rlt_def. apply CRealLtForget. rewrite Rquot2. rewrite Rlt_def in abs. apply CRealLtEpsilon in abs. apply (CReal_lt_le_trans _ _ _ abs). rewrite <- CReal_abs_opp, Rrepr_opp. apply CReal_le_abs. Qed. Lemma Rcomplete : forall xn : nat -> R, (forall p : positive, {n : nat | forall i j : nat, (n <= i)%nat -> (n <= j)%nat -> IQR (1 # p) < Rabst (CReal_abs (Rrepr (xn i + - xn j))) -> False}) -> {l : R & forall p : positive, {n : nat | forall i : nat, (n <= i)%nat -> IQR (1 # p) < Rabst (CReal_abs (Rrepr (xn i + - l))) -> False}}. Proof. intros. destruct (Rcauchy_complete (fun n => Rrepr (xn n))) as [l llim]. - intro p. specialize (H p) as [n nmaj]. exists n. intros. specialize (nmaj i j H H0). unfold IQR in nmaj. intro abs. apply nmaj. rewrite Rlt_def. apply CRealLtForget. rewrite Rquot2, Rquot2. apply (CReal_lt_le_trans _ _ _ abs). rewrite Rrepr_plus, Rrepr_opp. apply CRealLe_refl. - exists (Rabst l). intros. specialize (llim p) as [n nmaj]. exists n. intros. specialize (nmaj i H0). unfold IQR in H1. apply nmaj. rewrite Rlt_def in H1. apply CRealLtEpsilon in H1. rewrite Rquot2, Rquot2 in H1. apply (CReal_lt_le_trans _ _ _ H1). rewrite Rrepr_plus, Rrepr_opp, Rquot2. apply CRealLe_refl. Qed. Definition Rabs_quot (x : R) := Rabst (CReal_abs (Rrepr x)). Definition Rinv_quot (x : R) (xnz : sum (x < IQR 0) (IQR 0 < x)) := Rinv x. Definition Rlt_epsilon (x y : R) (H : x < y) := H. Definition DRealConstructive : ConstructiveReals := Build_ConstructiveReals R Rlt RisLinearOrder Rlt Rlt_epsilon Rlt_epsilon RdisjunctEpsilon IQR IQR_lt lt_IQR Rplus Ropp Rmult IQR_plus_quot IQR_mult_quot Rring RringExt Rzero_lt_one Rplus_lt_compat_l Rplus_reg_l Rmult_pos Rinv_quot Rleft_inverse Rinv_pos Rarchimedean Rabove_pos Rabs_quot RabsLUB Rcomplete. Definition Rrepr_morphism : @ConstructiveRealsMorphism DRealConstructive CRealConstructive. Proof. apply (Build_ConstructiveRealsMorphism DRealConstructive CRealConstructive Rrepr). - intro q. simpl. unfold IQR. rewrite Rquot2. apply CRealEq_refl. - intros. simpl. simpl in H. rewrite Rlt_def in H. apply CRealLtEpsilon in H. exact H. Defined. Definition Rabst_morphism : @ConstructiveRealsMorphism CRealConstructive DRealConstructive. Proof. apply (Build_ConstructiveRealsMorphism CRealConstructive DRealConstructive Rabst). - intro q. apply Req_constr_refl. - intros. simpl. simpl in H. rewrite Rlt_def. apply CRealLtForget. rewrite Rquot2, Rquot2. exact H. Defined. coq-8.20.0/theories/Reals/ClassicalDedekindReals.v000066400000000000000000000644601466560755400220130ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* 1 | S n' => 2 * (PosPow2_nat n') end. Local Lemma Qpower_2_neg_eq_pospow_inv : forall n : nat, (2 ^ (- Z.of_nat n) == 1#(PosPow2_nat n)%positive)%Q. Proof. intros n; induction n. - reflexivity. - change (PosPow2_nat (S n)) with (2*(PosPow2_nat n))%positive. rewrite <- Qmult_frac_l. rewrite Nat2Z.inj_succ, Z.opp_succ, <- Z.sub_1_r. rewrite Qpower_minus_pos. change ((1 # 2) ^ 1)%Q with (1 # 2)%Q. rewrite Qmult_comm, IHn; reflexivity. Qed. *) Local Lemma Qpower_2_neg_eq_natpow_inv : forall n : nat, (2 ^ (- Z.of_nat n) == 1#(Pos.of_nat (2^n)%nat))%Q. Proof. intros n; induction n. - reflexivity. - rewrite Nat.pow_succ_r'. rewrite Nat2Pos.inj_mul. 3: apply Nat.pow_nonzero; intros contra; inversion contra. 2: intros contra; inversion contra. change (Pos.of_nat 2)%nat with 2%positive. rewrite Qmult_frac_l. rewrite Nat2Z.inj_succ, Z.opp_succ, <- Z.sub_1_r. rewrite Qpower_minus_pos. change ((1 # 2) ^ 1)%Q with (1 # 2)%Q. rewrite Qmult_comm, IHn; reflexivity. Qed. Local Lemma Qpower_2_invneg_le_pow : forall n : Z, (1 # Pos.of_nat (2 ^ Z.to_nat (- n)) <= 2 ^ n)%Q. Proof. intros n; destruct n. - intros contra; inversion contra. - (* ToDo: find out why this works - somehow 1#(...) seems to be coereced to 1 *) apply (Qpower_1_le_pos 2 p ltac:(lra)). - rewrite <- Qpower_2_neg_eq_natpow_inv. rewrite Z2Nat.id by lia. rewrite Z.opp_involutive. apply Qle_refl. Qed. Local Lemma Qpower_2_neg_le_one : forall n : nat, (2 ^ (- Z.of_nat n) <= 1)%Q. Proof. intros n; induction n. - intros contra; inversion contra. - rewrite Nat2Z.inj_succ, Z.opp_succ, <- Z.sub_1_r. rewrite Qpower_minus_pos. lra. Qed. (*****************************************************************************) (** * Dedekind cuts *) (*****************************************************************************) (** ** Definition *) (** Classical Dedekind reals. With the 3 logical axioms funext, sig_forall_dec and sig_not_dec, the lower cuts defined as functions Q -> bool have all the classical properties of the real numbers. We could prove operations and theorems about them directly, but instead we notice that they are a quotient of the constructive Cauchy reals, from which they inherit many properties. *) (* The limited principle of omniscience *) Axiom sig_forall_dec : forall (P : nat -> Prop), (forall n, {P n} + {~P n}) -> {n | ~P n} + {forall n, P n}. Axiom sig_not_dec : forall P : Prop, { ~~P } + { ~P }. (* Try to find a surjection CReal -> lower cuts. *) Definition isLowerCut (f : Q -> bool) : Prop := (forall q r:Q, Qle q r -> f r = true -> f q = true) (* interval *) /\ ~(forall q:Q, f q = true) (* avoid positive infinity *) /\ ~(forall q:Q, f q = false) (* avoid negative infinity *) (* openness, the cut contains rational numbers strictly lower than a real number. *) /\ (forall q:Q, f q = true -> ~(forall r:Q, Qle r q \/ f r = false)). (** ** Properties *) Lemma isLowerCut_hprop : forall (f : Q -> bool), IsHProp (isLowerCut f). Proof. intro f. apply and_hprop. 2: apply and_hprop. 2: apply not_hprop. 2: apply and_hprop. 2: apply not_hprop. - apply forall_hprop. intro x. apply forall_hprop. intro y. apply impl_hprop. apply impl_hprop. intros p q. apply eq_proofs_unicity_on. intro b. destruct (f x), b. + left. reflexivity. + right. discriminate. + right. discriminate. + left. reflexivity. - apply forall_hprop. intro q. apply impl_hprop. apply not_hprop. Qed. Lemma lowerCutBelow : forall f : Q -> bool, isLowerCut f -> { q : Q | f q = true }. Proof. intros. destruct (sig_forall_dec (fun n:nat => f (-(Z.of_nat n # 1))%Q = false)). - intro n. destruct (f (-(Z.of_nat n # 1))%Q). + right. discriminate. + left. reflexivity. - destruct s. exists (-(Z.of_nat x # 1))%Q. destruct (f (-(Z.of_nat x # 1))%Q). + reflexivity. + exfalso. apply n. reflexivity. - exfalso. destruct H, H0, H1. apply H1. intro q. destruct (f q) eqn:des. 2: reflexivity. exfalso. destruct (Qarchimedean (-q)) as [p pmaj]. rewrite <- (Qplus_lt_l _ _ (q-(Z.pos p # 1))) in pmaj. ring_simplify in pmaj. specialize (H (- (Z.pos p#1))%Q q). specialize (e (Pos.to_nat p)). rewrite positive_nat_Z in e. rewrite H in e. + discriminate. + ring_simplify. apply Qlt_le_weak, pmaj. + exact des. Qed. Lemma lowerCutAbove : forall f : Q -> bool, isLowerCut f -> { q : Q | f q = false }. Proof. intros. destruct (sig_forall_dec (fun n => f (Z.of_nat n # 1)%Q = true)). - intro n. destruct (f (Z.of_nat n # 1)%Q). + left. reflexivity. + right. discriminate. - destruct s. exists (Z.of_nat x # 1)%Q. destruct (f (Z.of_nat x # 1)%Q). + exfalso. apply n. reflexivity. + reflexivity. - exfalso. destruct H, H0, H1. apply H0. intro q. destruct (Qarchimedean q) as [p pmaj]. apply (H q (Z.of_nat (Pos.to_nat p) # 1)%Q). + rewrite positive_nat_Z. apply Qlt_le_weak, pmaj. + apply e. Qed. Lemma lowerUpper : forall (f : Q -> bool) (q r : Q), isLowerCut f -> Qle q r -> f q = false -> f r = false. Proof. intros. destruct H. specialize (H q r H0). destruct (f r) eqn:desR. 2: reflexivity. exfalso. specialize (H (eq_refl _)). rewrite H in H1. discriminate. Qed. Lemma UpperAboveLower : forall (f : Q -> bool) (q r : Q), isLowerCut f -> f q = true -> f r = false -> Qlt q r. Proof. intros. destruct H. apply Qnot_le_lt. intro abs. rewrite (H r q abs) in H1. - discriminate. - exact H0. Qed. (*****************************************************************************) (** * Classical Dedekind reals *) (*****************************************************************************) (** ** Definition *) Definition DReal : Set := { f : Q -> bool | isLowerCut f }. (** ** Induction principle *) Fixpoint DRealQlim_rec (f : Q -> bool) (low : isLowerCut f) (n p : nat) { struct p } : f (proj1_sig (lowerCutBelow f low) + (Z.of_nat p # Pos.of_nat (S n)))%Q = false -> { q : Q | f q = true /\ f (q + (1 # Pos.of_nat (S n)))%Q = false }. Proof. intros. destruct p. - exfalso. destruct (lowerCutBelow f low); unfold proj1_sig in H. destruct low. rewrite (H0 _ x) in H. + discriminate. + simpl. apply (Qplus_le_l _ _ (-x)). ring_simplify. discriminate. + exact e. - destruct (f (proj1_sig (lowerCutBelow f low) + (Z.of_nat p # Pos.of_nat (S n)))%Q) eqn:des. + exists (proj1_sig (lowerCutBelow f low) + (Z.of_nat p # Pos.of_nat (S n)))%Q. split. * exact des. * destruct (f (proj1_sig (lowerCutBelow f low) + (Z.of_nat p # Pos.of_nat (S n)) + (1 # Pos.of_nat (S n)))%Q) eqn:d. 2: reflexivity. exfalso. destruct low. rewrite (e _ (proj1_sig (lowerCutBelow f (conj e a)) + (Z.of_nat p # Pos.of_nat (S n)) + (1 # Pos.of_nat (S n))))%Q in H. -- discriminate. -- rewrite <- Qplus_assoc, Qplus_le_r. rewrite Qinv_plus_distr. replace (Z.of_nat p + 1)%Z with (Z.of_nat (S p))%Z. ++ apply Qle_refl. ++ replace 1%Z with (Z.of_nat 1). ** rewrite <- (Nat2Z.inj_add p 1). apply f_equal. rewrite Nat.add_comm. reflexivity. ** reflexivity. -- exact d. + destruct (DRealQlim_rec f low n p des) as [q qmaj]. exists q. exact qmaj. Qed. (** ** Conversion to and from constructive Cauchy real CReal *) (** *** Conversion from CReal to DReal *) Lemma DRealAbstr_aux : forall x H, isLowerCut (fun q : Q => if sig_forall_dec (fun n : nat => seq x (- Z.of_nat n) <= q + 2 ^ (- Z.of_nat n)) (H q) then true else false). Proof. repeat split. - intros. destruct (sig_forall_dec (fun n : nat => (seq x (-Z.of_nat n) <= q + (2^-Z.of_nat n))%Q) (H q)). + reflexivity. + exfalso. destruct (sig_forall_dec (fun n : nat => (seq x (-Z.of_nat n) <= r + (2^-Z.of_nat n))%Q) (H r)). * destruct s. apply n. apply (Qle_trans _ _ _ (q0 x0)). apply Qplus_le_l. exact H0. * discriminate. - intro abs. destruct (Rfloor x) as [z [_ zmaj]]. specialize (abs (z+3 # 1)%Q). destruct (sig_forall_dec (fun n : nat => (seq x (-Z.of_nat n) <= (z+3 # 1) + (2^-Z.of_nat n))%Q) (H (z+3 # 1)%Q)). 2: exfalso; discriminate. clear abs. destruct s as [n nmaj]. apply nmaj. rewrite <- (inject_Q_plus (z#1) 2) in zmaj. apply CRealLt_asym in zmaj. rewrite <- CRealLe_not_lt in zmaj. specialize (zmaj (-Z.of_nat n)%Z). unfold inject_Q in zmaj; rewrite CReal_red_seq in zmaj. destruct x as [xn xcau]; rewrite CReal_red_seq in H, nmaj, zmaj |- *. rewrite Qinv_plus_distr in zmaj. apply (Qplus_le_l _ _ (-(z + 2 # 1))). apply (Qle_trans _ _ _ zmaj). apply (Qplus_le_l _ _ (-(2^-Z.of_nat n))). apply (Qle_trans _ 1). + ring_simplify. apply Qpower_2_neg_le_one. + ring_simplify. rewrite <- (Qinv_plus_distr z 3 1), <- (Qinv_plus_distr z 2 1). lra. - intro abs. destruct (Rfloor x) as [z [zmaj _]]. specialize (abs (z-4 # 1)%Q). destruct (sig_forall_dec (fun n : nat => (seq x (-Z.of_nat n) <= (z-4 # 1) + (2^-Z.of_nat n))%Q) (H (z-4 # 1)%Q)). + exfalso; discriminate. + clear abs. apply CRealLt_asym in zmaj. apply zmaj. clear zmaj. exists 0%Z. unfold inject_Q; rewrite CReal_red_seq. specialize (q O). destruct x as [xn xcau]. rewrite CReal_red_seq in H, q |- *. unfold Z.of_nat in q. change (2 ^ (- 0))%Q with 1%Q in q. change (-0)%Z with 0%Z in q. rewrite <- Qinv_minus_distr in q. change (2^0)%Q with 1%Q. lra. - intros q H0 abs. destruct (sig_forall_dec (fun n : nat => (seq x (-Z.of_nat n) <= q + (2^-Z.of_nat n))%Q) (H q)). 2: exfalso; discriminate. clear H0. destruct s as [n nmaj]. (* We have that q < x as real numbers. The middle (q + xSn - 1/Sn)/2 is also lower than x, witnessed by the same index n. *) specialize (abs ((q + seq x (-Z.of_nat n) - (2^-Z.of_nat n)%Q)/2)%Q). destruct abs. + apply (Qmult_le_r _ _ 2) in H0. * field_simplify in H0. apply (Qplus_le_r _ _ ((2^-Z.of_nat n) - q)) in H0. ring_simplify in H0. apply nmaj. rewrite Qplus_comm. exact H0. * reflexivity. + destruct (sig_forall_dec (fun n0 : nat => (seq x (-Z.of_nat n0) <= (q + seq x (-Z.of_nat n) - (2^-Z.of_nat n)) / 2 + (2^-Z.of_nat n0))%Q) (H ((q + seq x (-Z.of_nat n) - (2^-Z.of_nat n)) / 2)%Q)). * discriminate. * clear H0. specialize (q0 n). apply (Qmult_le_l _ _ 2) in q0. -- field_simplify in q0. apply (Qplus_le_l _ _ (-seq x (-Z.of_nat n))) in q0. ring_simplify in q0. contradiction. -- reflexivity. Qed. Definition DRealAbstr : CReal -> DReal. Proof. intro x. assert (forall (q : Q) (n : nat), {(fun n0 : nat => (seq x (-Z.of_nat n0) <= q + (2^-Z.of_nat n0))%Q) n} + {~ (fun n0 : nat => (seq x (-Z.of_nat n0) <= q + (2^-Z.of_nat n0))%Q) n}). { intros. destruct (Qlt_le_dec (q + (2^-Z.of_nat n)) (seq x (-Z.of_nat n))). - right. apply (Qlt_not_le _ _ q0). - left. exact q0. } exists (fun q:Q => if sig_forall_dec (fun n:nat => Qle (seq x (-Z.of_nat n)) (q + (2^-Z.of_nat n))) (H q) then true else false). apply DRealAbstr_aux. Defined. (** *** Conversion from DReal to CReal *) Definition DRealQlim (x : DReal) (n : nat) : { q : Q | proj1_sig x q = true /\ proj1_sig x (q + (1# Pos.of_nat (S n)))%Q = false }. Proof. destruct x as [f low]. destruct (lowerCutAbove f low). destruct (Qarchimedean (x - proj1_sig (lowerCutBelow f low))) as [p pmaj]. apply (DRealQlim_rec f low n ((S n) * Pos.to_nat p)). destruct (lowerCutBelow f low); unfold proj1_sig; unfold proj1_sig in pmaj. destruct (f (x0 + (Z.of_nat (S n * Pos.to_nat p) # Pos.of_nat (S n)))%Q) eqn:des. 2: reflexivity. exfalso. destruct low. rewrite (H _ (x0 + (Z.of_nat (S n * Pos.to_nat p) # Pos.of_nat (S n)))%Q) in e. - discriminate. - setoid_replace (Z.of_nat (S n * Pos.to_nat p) # Pos.of_nat (S n))%Q with (Z.pos p # 1)%Q. + apply (Qplus_lt_l _ _ x0) in pmaj. ring_simplify in pmaj. apply Qlt_le_weak, pmaj. + rewrite Nat2Z.inj_mul, positive_nat_Z. unfold Qeq, Qnum, Qden. rewrite Z.mul_1_r, Z.mul_comm. replace (Z.of_nat (S n)) with (Z.pos (Pos.of_nat (S n))). * reflexivity. * simpl. destruct n. -- reflexivity. -- apply f_equal. apply Pos.succ_of_nat. discriminate. - exact des. Qed. Definition DRealQlimExp2 (x : DReal) (n : nat) : { q : Q | proj1_sig x q = true /\ proj1_sig x (q + (1#(Pos.of_nat (2^n)%nat)))%Q = false }. Proof. destruct (DRealQlim x (pred (2^n))%nat) as [q qmaj]. exists q. rewrite Nat.succ_pred_pos in qmaj. 2: apply Nat.neq_0_lt_0, Nat.pow_nonzero; intros contra; inversion contra. exact qmaj. Qed. Definition CReal_of_DReal_seq (x : DReal) (n : Z) := proj1_sig (DRealQlimExp2 x (Z.to_nat (-n))). Lemma CReal_of_DReal_cauchy (x : DReal) : QCauchySeq (CReal_of_DReal_seq x). Proof. unfold QCauchySeq, CReal_of_DReal_seq. intros n k l Hk Hl. destruct (DRealQlimExp2 x (Z.to_nat (-k))) as [q Hq]. destruct (DRealQlimExp2 x (Z.to_nat (-l))) as [r Hr]. destruct x as [f Hflc]. unfold proj1_sig in *. apply Qabs_case. - intros. apply (Qlt_le_trans _ (1 # Pos.of_nat (2 ^ Z.to_nat (-l)))). + apply (Qplus_lt_l _ _ r); ring_simplify. apply (UpperAboveLower f). * exact Hflc. * apply Hq. * apply Hr. + apply (Qle_trans _ _ _ (Qpower_2_invneg_le_pow _)). apply Qpower_le_compat_l; [lia|lra]. - intros. apply (Qlt_le_trans _ (1 # Pos.of_nat (2 ^ Z.to_nat (-k)))). + apply (Qplus_lt_l _ _ q); ring_simplify. apply (UpperAboveLower f). * exact Hflc. * apply Hr. * apply Hq. + apply (Qle_trans _ _ _ (Qpower_2_invneg_le_pow _)). apply Qpower_le_compat_l; [lia|lra]. Qed. Lemma CReal_of_DReal_seq_max_prec_1 : forall (x : DReal) (n : Z), (n>=0)%Z -> CReal_of_DReal_seq x n = CReal_of_DReal_seq x 0. Proof. intros x n Hngt0. unfold CReal_of_DReal_seq. destruct n. - reflexivity. - reflexivity. - lia. Qed. Lemma CReal_of_DReal_seq_bound : forall (x : DReal) (i j : Z), (Qabs (CReal_of_DReal_seq x i - CReal_of_DReal_seq x j) <= 1)%Q. Proof. intros x i j. pose proof CReal_of_DReal_cauchy x 0%Z as Hcau. apply Qlt_le_weak; change (2^0)%Q with 1%Q in Hcau. (* Either i, j are >= 0 in which case we can rewrite with CReal_of_DReal_seq_max_prec_1, or they are <0, in which case Hcau can be used immediately *) destruct (Z_gt_le_dec i 0) as [Hi|Hi]; destruct (Z_gt_le_dec j 0) as [Hj|Hj]. all: try rewrite (CReal_of_DReal_seq_max_prec_1 x i) by lia; try rewrite (CReal_of_DReal_seq_max_prec_1 x j) by lia; apply Hcau; lia. (* ToDo: check if for CReal_from_cauchy_seq_bound a similar simple proof is possible *) Qed. Definition CReal_of_DReal_scale (x : DReal) : Z := Qbound_lt_ZExp2 (Qabs (CReal_of_DReal_seq x (-1)) + 2)%Q. Lemma CReal_of_DReal_bound : forall (x : DReal), QBound (CReal_of_DReal_seq x) (CReal_of_DReal_scale x). Proof. intros x n. unfold CReal_of_DReal_scale. (* Use the spec of Qbound_lt_ZExp2 to linearize the RHS *) apply (Qlt_trans_swap_hyp _ _ _ (Qbound_lt_ZExp2_spec _)). (* Massage the goal so that CReal_of_DReal_seq_bound can be applied *) apply (Qplus_lt_l _ _ (-Qabs (CReal_of_DReal_seq x (-1)))%Q); ring_simplify. assert(forall r s : Q, (r + -1*s == r-s)%Q) as Aux by (intros; lra); rewrite Aux; clear Aux. apply (Qle_lt_trans _ _ _ (Qabs_triangle_reverse _ _)). apply (Qle_lt_trans _ 1%Q _). 2: lra. apply CReal_of_DReal_seq_bound. Qed. Definition DRealRepr (x : DReal) : CReal := {| seq := CReal_of_DReal_seq x; scale := CReal_of_DReal_scale x; cauchy := CReal_of_DReal_cauchy x; bound := CReal_of_DReal_bound x |}. (** ** Order for DReal *) Definition Rle (x y : DReal) := forall q:Q, proj1_sig x q = true -> proj1_sig y q = true. Lemma Rle_antisym : forall x y : DReal, Rle x y -> Rle y x -> x = y. Proof. intros [f cf] [g cg] H H0. unfold Rle in H,H0; simpl in H, H0. assert (f = g). { apply functional_extensionality. intro q. specialize (H q). specialize (H0 q). destruct (f q), (g q). - reflexivity. - exfalso. specialize (H (eq_refl _)). discriminate. - exfalso. specialize (H0 (eq_refl _)). discriminate. - reflexivity. } subst g. replace cg with cf. - reflexivity. - apply isLowerCut_hprop. Qed. Lemma DRealOpen : forall (x : DReal) (q : Q), proj1_sig x q = true -> { r : Q | Qlt q r /\ proj1_sig x r = true }. Proof. intros. destruct (sig_forall_dec (fun n => Qle (proj1_sig (DRealQlim x n)) q)). - intro n. destruct (DRealQlim x n); unfold proj1_sig. destruct (Qlt_le_dec q x0). + right. exact (Qlt_not_le _ _ q0). + left. exact q0. - destruct s. apply Qnot_le_lt in n. destruct (DRealQlim x x0); unfold proj1_sig in n. exists x1. split. + exact n. + apply a. - exfalso. destruct x as [f low]. unfold proj1_sig in H, q0. destruct low, a, a. apply (n1 q H). intros. destruct (Qlt_le_dec q r). 2: left; exact q1. right. destruct (Qarchimedean (/(r - q))) as [p pmaj]. specialize (q0 (Pos.to_nat p)). destruct (DRealQlim (exist _ f (conj e (conj n (conj n0 n1)))) (Pos.to_nat p)) as [s smaj]. unfold proj1_sig in smaj. apply (lowerUpper f (s + (1 # Pos.of_nat (S (Pos.to_nat p))))). + exact (conj e (conj n (conj n0 n1))). + apply (Qle_trans _ (s + (r-q))). * apply Qplus_le_r. apply (Qle_trans _ (1 # p)). -- unfold Qle, Qnum, Qden. do 2 rewrite Z.mul_1_l. apply Pos2Z.pos_le_pos. apply Pos2Nat.inj_le. rewrite Nat2Pos.id. ++ apply le_S, Nat.le_refl. ++ discriminate. -- apply (Qmult_le_l _ _ ( (Z.pos p # 1) / (r-q))). ++ rewrite <- (Qmult_0_r (Z.pos p #1)). apply Qmult_lt_l. ** reflexivity. ** apply Qinv_lt_0_compat. unfold Qminus. rewrite <- Qlt_minus_iff. exact q1. ++ unfold Qdiv. rewrite Qmult_comm, <- Qmult_assoc. rewrite (Qmult_comm (/(r-q))), Qmult_inv_r, Qmult_assoc. ** setoid_replace ((1 # p) * (Z.pos p # 1))%Q with 1%Q. 2: reflexivity. rewrite Qmult_1_l, Qmult_1_r. apply Qlt_le_weak, pmaj. ** intro abs. apply Qlt_minus_iff in q1. rewrite abs in q1. apply (Qlt_not_le _ _ q1), Qle_refl. * apply (Qplus_le_l _ _ (q-r)). ring_simplify. exact q0. + apply smaj. Qed. Lemma DRealReprQ : forall (x : DReal) (q : Q), proj1_sig x q = true -> CRealLt (inject_Q q) (DRealRepr x). Proof. intros x q H. (* expand and simplify goal and hypothesis *) destruct (DRealOpen x q H) as [r rmaj]. destruct (QarchimedeanLowExp2_Z ((1#4)*(r - q))) as [p pmaj]. 1: lra. exists (p)%Z. destruct x as [f low]; unfold DRealRepr, CReal_of_DReal_seq, inject_Q; do 2 rewrite CReal_red_seq. destruct (DRealQlimExp2 (exist _ f low) (Z.to_nat (-p))) as [s smaj]. unfold proj1_sig in smaj, rmaj, H |- * . rewrite <- (Qmult_lt_l _ _ 4%Q) in pmaj by lra. setoid_replace (4 * ((1 # 4) * (r - q)))%Q with (r-q)%Q in pmaj by ring. apply proj2 in rmaj. apply proj2 in smaj. (* Use the fact that s+eps is above the cut and r is below the cut. This limits the distance between s and r. *) pose proof UpperAboveLower f _ _ low rmaj smaj as Hrltse; clear rmaj smaj. pose proof Qpower_2_invneg_le_pow p as Hpowcut. pose proof Qpower_0_lt 2 p ltac:(lra) as Hpowpos. lra. Qed. Lemma DRealReprQup : forall (x : DReal) (q : Q), proj1_sig x q = false -> CRealLe (DRealRepr x) (inject_Q q). Proof. intros x q H [p pmaj]. (* expand and simplify goal and hypothesis *) unfold inject_Q, DRealRepr, CReal_of_DReal_seq in pmaj. do 2 rewrite CReal_red_seq in pmaj. destruct (DRealQlimExp2 x (Z.to_nat (- p))) as [r rmaj]. destruct x as [f low]. unfold proj1_sig in pmaj, rmaj, H. apply proj1 in rmaj. (* Use the fact that q is above the cut and r is below the cut. *) pose proof UpperAboveLower f _ _ low rmaj H as Hrltse. pose proof Qpower_0_lt 2 p ltac:(lra) as Hpowpos. lra. Qed. Lemma DRealQuot1 : forall x y:DReal, CRealEq (DRealRepr x) (DRealRepr y) -> x = y. Proof. intros. destruct H. apply Rle_antisym. - clear H. intros q H1. destruct (proj1_sig y q) eqn:des. + reflexivity. + exfalso. apply H0. apply (CReal_le_lt_trans _ (inject_Q q)). * apply DRealReprQup. exact des. * apply DRealReprQ. exact H1. - clear H0. intros q H1. destruct (proj1_sig x q) eqn:des. + reflexivity. + exfalso. apply H. apply (CReal_le_lt_trans _ (inject_Q q)). * apply DRealReprQup. exact des. * apply DRealReprQ. exact H1. Qed. Lemma DRealAbstrFalse : forall (x : CReal) (q : Q) (n : nat), proj1_sig (DRealAbstr x) q = false -> (seq x (- Z.of_nat n) <= q + 2 ^ (- Z.of_nat n))%Q. Proof. intros x q n H. unfold DRealAbstr, proj1_sig in H. match type of H with context [ if ?a then _ else _ ] => destruct a as [H'|H']end. - discriminate. - apply H'. Qed. (** For arbitrary n:Z, we need to relaxe the bound *) Lemma DRealAbstrFalse' : forall (x : CReal) (q : Q) (n : Z), proj1_sig (DRealAbstr x) q = false -> (seq x n <= q + 2*2^n)%Q. Proof. intros x q n H. unfold DRealAbstr, proj1_sig in H. match type of H with context [ if ?a then _ else _ ] => destruct a as [H'|H']end. - discriminate. - destruct (Z_le_gt_dec n 0) as [Hdec|Hdec]. + specialize (H' (Z.to_nat (-n) )). rewrite (Z2Nat.id (-n)%Z ltac:(lia)), Z.opp_involutive in H'. pose proof Qpower_0_lt 2 n; lra. + specialize (H' (Z.to_nat (0) )). cbn in H'. pose proof cauchy x n%Z 0%Z n ltac:(lia) ltac:(lia) as Hxbnd. apply Qabs_Qlt_condition in Hxbnd. pose proof Qpower_1_le 2 n ltac:(lra) ltac:(lia). lra. Qed. Lemma DRealAbstrFalse'' : forall (x : CReal) (q : Q) (n : Z), proj1_sig (DRealAbstr x) q = false -> (seq x n <= q + 2^n + 1)%Q. Proof. intros x q n H. unfold DRealAbstr, proj1_sig in H. match type of H with context [ if ?a then _ else _ ] => destruct a as [H'|H']end. - discriminate. - destruct (Z_le_gt_dec n 0) as [Hdec|Hdec]. + specialize (H' (Z.to_nat (-n) )). rewrite (Z2Nat.id (-n)%Z ltac:(lia)), Z.opp_involutive in H'. pose proof Qpower_0_lt 2 n; lra. + specialize (H' (Z.to_nat (0) )). cbn in H'. pose proof cauchy x n%Z 0%Z n ltac:(lia) ltac:(lia) as Hxbnd. apply Qabs_Qlt_condition in Hxbnd. lra. Qed. Lemma DRealQuot2 : forall x:CReal, CRealEq (DRealRepr (DRealAbstr x)) x. Proof. split. - intros [p pmaj]. unfold DRealRepr in pmaj. rewrite CReal_red_seq in pmaj. destruct (Z_ge_lt_dec 0 p) as [Hdec|Hdec]. + (* The usual case that p<=0 and 2^p is small *) (* In this case the conversion of Z to nat and back is id *) unfold CReal_of_DReal_seq in pmaj. destruct (DRealQlimExp2 (DRealAbstr x) (Z.to_nat (- p))) as [q [Hql Hqr]]. unfold proj1_sig in pmaj. pose proof (DRealAbstrFalse x _ (Z.to_nat (- p)) Hqr) as Hq; clear Hql Hqr. rewrite <- Qpower_2_neg_eq_natpow_inv in Hq. rewrite Z2Nat.id, Z.opp_involutive in Hq by lia; clear Hdec. lra. + (* The case that p>0 and 2^p is large *) (* In this case we use CReal_of_DReal_seq_max_prec_1 to rewrite the index to 0 *) rewrite CReal_of_DReal_seq_max_prec_1 in pmaj by lia. unfold CReal_of_DReal_seq in pmaj. change (Z.to_nat (-0))%Z with 0%nat in pmaj. destruct (DRealQlimExp2 (DRealAbstr x) 0) as [q [Hql Hqr]]. unfold proj1_sig in pmaj. pose proof (DRealAbstrFalse'' x _ p%nat Hqr) as Hq; clear Hql Hqr. rewrite <- Qpower_2_neg_eq_natpow_inv in Hq. change (- Z.of_nat 0)%Z with 0%Z in Hq. pose proof (Qpower_le_compat_l 2 1 p ltac:(lia) ltac:(lra)) as Hpowle. change (2^1)%Q with 2%Q in Hpowle. lra. - intros [p pmaj]. unfold DRealRepr in pmaj. rewrite CReal_red_seq in pmaj. unfold CReal_of_DReal_seq in pmaj. destruct (DRealQlimExp2 (DRealAbstr x) (Z.to_nat (- p))) as [q [Hql Hqr]]. unfold proj1_sig in pmaj. unfold DRealAbstr, proj1_sig in Hql. match type of Hql with context [ if ?a then _ else _ ] => destruct a as [H'|H']end. 2: discriminate. clear Hql Hqr. destruct H' as [n nmaj]. apply nmaj; clear nmaj. apply (Qplus_lt_l _ _ (seq x p + 2 ^ (- Z.of_nat n))) in pmaj. ring_simplify in pmaj. apply Qlt_le_weak. rewrite Qplus_comm. apply (Qlt_trans _ ((2 * 2^p) + seq x p + (2 ^ (- Z.of_nat n)))). 2: exact pmaj. clear pmaj. apply (Qplus_lt_l _ _ (-seq x p)). apply (Qle_lt_trans _ _ _ (Qle_Qabs _)). destruct (Z_le_gt_dec p (- Z.of_nat n)). + apply (Qlt_trans _ (2 ^ (- Z.of_nat n))). 1: apply (cauchy x). 1, 2: lia. pose proof Qpower_0_lt 2 p; lra. + apply (Qlt_trans _ (2^p)). 1: apply (cauchy x). 1, 2: lia. pose proof Qpower_0_lt 2 (- Z.of_nat n). pose proof Qpower_0_lt 2 p. lra. Qed. coq-8.20.0/theories/Reals/Cos_plus.v000066400000000000000000000571241466560755400172640ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* Rabs (Reste1 x y N) <= Majxy x y (pred N). Proof. intros. set (C := Rmax 1 (Rmax (Rabs x) (Rabs y))). unfold Reste1. apply Rle_trans with (sum_f_R0 (fun k:nat => Rabs (sum_f_R0 (fun l:nat => (-1) ^ S (l + k) / INR (fact (2 * S (l + k))) * x ^ (2 * S (l + k)) * ((-1) ^ (N - l) / INR (fact (2 * (N - l)))) * y ^ (2 * (N - l))) (pred (N - k)))) ( pred N)). { apply (Rsum_abs (fun k:nat => sum_f_R0 (fun l:nat => (-1) ^ S (l + k) / INR (fact (2 * S (l + k))) * x ^ (2 * S (l + k)) * ((-1) ^ (N - l) / INR (fact (2 * (N - l)))) * y ^ (2 * (N - l))) (pred (N - k))) (pred N)). } apply Rle_trans with (sum_f_R0 (fun k:nat => sum_f_R0 (fun l:nat => Rabs ((-1) ^ S (l + k) / INR (fact (2 * S (l + k))) * x ^ (2 * S (l + k)) * ((-1) ^ (N - l) / INR (fact (2 * (N - l)))) * y ^ (2 * (N - l)))) (pred (N - k))) ( pred N)). { apply sum_Rle. intros. apply (Rsum_abs (fun l:nat => (-1) ^ S (l + n) / INR (fact (2 * S (l + n))) * x ^ (2 * S (l + n)) * ((-1) ^ (N - l) / INR (fact (2 * (N - l)))) * y ^ (2 * (N - l))) (pred (N - n))). } apply Rle_trans with (sum_f_R0 (fun k:nat => sum_f_R0 (fun l:nat => / INR (fact (2 * S (l + k)) * fact (2 * (N - l))) * C ^ (2 * S (N + k))) (pred (N - k))) (pred N)). { apply sum_Rle; intros. apply sum_Rle; intros. unfold Rdiv; repeat rewrite Rabs_mult. do 2 rewrite pow_1_abs. do 2 rewrite Rmult_1_l. rewrite (Rabs_right (/ INR (fact (2 * S (n0 + n))))). 2:apply Rle_ge; left; apply Rinv_0_lt_compat; apply INR_fact_lt_0. rewrite (Rabs_right (/ INR (fact (2 * (N - n0))))). 2:apply Rle_ge; left; apply Rinv_0_lt_compat; apply INR_fact_lt_0. rewrite mult_INR. rewrite Rinv_mult. repeat rewrite Rmult_assoc. apply Rmult_le_compat_l. { left; apply Rinv_0_lt_compat; apply INR_fact_lt_0. } rewrite <- Rmult_assoc. rewrite <- (Rmult_comm (/ INR (fact (2 * (N - n0))))). rewrite Rmult_assoc. apply Rmult_le_compat_l. { left; apply Rinv_0_lt_compat; apply INR_fact_lt_0. } do 2 rewrite <- RPow_abs. apply Rle_trans with (Rabs x ^ (2 * S (n0 + n)) * C ^ (2 * (N - n0))). { apply Rmult_le_compat_l. { apply pow_le; apply Rabs_pos. } apply pow_incr. split. { apply Rabs_pos. } unfold C. apply Rle_trans with (Rmax (Rabs x) (Rabs y)); apply RmaxLess2. } apply Rle_trans with (C ^ (2 * S (n0 + n)) * C ^ (2 * (N - n0))). { do 2 rewrite <- (Rmult_comm (C ^ (2 * (N - n0)))). apply Rmult_le_compat_l. { apply pow_le. apply Rle_trans with 1. { left; apply Rlt_0_1. } unfold C; apply RmaxLess1. } apply pow_incr. split. { apply Rabs_pos. } unfold C; apply Rle_trans with (Rmax (Rabs x) (Rabs y)). - apply RmaxLess1. - apply RmaxLess2. } right. replace (2 * S (N + n))%nat with (2 * (N - n0) + 2 * S (n0 + n))%nat by lia. rewrite pow_add. apply Rmult_comm. } apply Rle_trans with (sum_f_R0 (fun k:nat => sum_f_R0 (fun l:nat => / INR (fact (2 * S (l + k)) * fact (2 * (N - l))) * C ^ (4 * N)) (pred (N - k))) (pred N)). { apply sum_Rle; intros. apply sum_Rle; intros. apply Rmult_le_compat_l. { left; apply Rinv_0_lt_compat. rewrite mult_INR; apply Rmult_lt_0_compat; apply INR_fact_lt_0. } apply Rle_pow. { unfold C; apply RmaxLess1. } lia. } apply Rle_trans with (sum_f_R0 (fun k:nat => sum_f_R0 (fun l:nat => C ^ (4 * N) * Rsqr (/ INR (fact (S (N + k))))) (pred (N - k))) (pred N)). { apply sum_Rle; intros. apply sum_Rle; intros. rewrite <- (Rmult_comm (C ^ (4 * N))). apply Rmult_le_compat_l. { apply pow_le. left; apply Rlt_le_trans with 1. { apply Rlt_0_1. } unfold C; apply RmaxLess1. } replace (/ INR (fact (2 * S (n0 + n)) * fact (2 * (N - n0)))) with (Binomial.C (2 * S (N + n)) (2 * S (n0 + n)) / INR (fact (2 * S (N + n)))). 2:{ unfold Rdiv; rewrite Rmult_comm. unfold Binomial.C. unfold Rdiv; repeat rewrite <- Rmult_assoc. rewrite Rinv_l. { rewrite Rmult_1_l. replace (2 * S (N + n) - 2 * S (n0 + n))%nat with (2 * (N - n0))%nat by lia. rewrite mult_INR. reflexivity. } apply INR_fact_neq_0. } apply Rle_trans with (Binomial.C (2 * S (N + n)) (S (N + n)) / INR (fact (2 * S (N + n)))). { unfold Rdiv; do 2 rewrite <- (Rmult_comm (/ INR (fact (2 * S (N + n))))). apply Rmult_le_compat_l. { left; apply Rinv_0_lt_compat; apply INR_fact_lt_0. } apply C_maj. lia. } right. unfold Rdiv; rewrite Rmult_comm. unfold Binomial.C. unfold Rdiv; repeat rewrite <- Rmult_assoc. rewrite Rinv_l. 2:apply INR_fact_neq_0. rewrite Rmult_1_l. replace (2 * S (N + n) - S (N + n))%nat with (S (N + n)) by lia. rewrite Rinv_mult. unfold Rsqr; reflexivity. } apply Rle_trans with (sum_f_R0 (fun k:nat => INR N / INR (fact (S N)) * C ^ (4 * N)) (pred N)). { apply sum_Rle; intros. rewrite <- (scal_sum (fun _:nat => C ^ (4 * N)) (pred (N - n)) (Rsqr (/ INR (fact (S (N + n)))))). rewrite sum_cte. rewrite <- Rmult_assoc. do 2 rewrite <- (Rmult_comm (C ^ (4 * N))). rewrite Rmult_assoc. apply Rmult_le_compat_l. { apply pow_le. left; apply Rlt_le_trans with 1. { apply Rlt_0_1. } unfold C; apply RmaxLess1. } apply Rle_trans with (Rsqr (/ INR (fact (S (N + n)))) * INR N). { apply Rmult_le_compat_l. { apply Rle_0_sqr. } apply le_INR. lia. } rewrite Rmult_comm; unfold Rdiv; apply Rmult_le_compat_l. { apply pos_INR. } apply Rle_trans with (/ INR (fact (S (N + n)))). { pattern (/ INR (fact (S (N + n)))) at 2; rewrite <- Rmult_1_r. unfold Rsqr. apply Rmult_le_compat_l. { left; apply Rinv_0_lt_compat; apply INR_fact_lt_0. } apply Rmult_le_reg_l with (INR (fact (S (N + n)))). { apply INR_fact_lt_0. } rewrite Rinv_r. { rewrite Rmult_1_r. apply (le_INR 1). apply Nat.le_succ_l. apply INR_lt; apply INR_fact_lt_0. } apply INR_fact_neq_0. } apply Rmult_le_reg_l with (INR (fact (S (N + n)))). { apply INR_fact_lt_0. } rewrite Rinv_r. 2:apply INR_fact_neq_0. apply Rmult_le_reg_l with (INR (fact (S N))). { apply INR_fact_lt_0. } rewrite Rmult_1_r. rewrite (Rmult_comm (INR (fact (S N)))). rewrite Rmult_assoc. rewrite Rinv_l. 2:apply INR_fact_neq_0. rewrite Rmult_1_r. apply le_INR. apply fact_le. apply -> Nat.succ_le_mono. apply Nat.le_add_r. } rewrite sum_cte. apply Rle_trans with (C ^ (4 * N) / INR (fact (pred N))). 2:{ right. unfold Majxy. unfold C. replace (S (pred N)) with N by lia. reflexivity. } rewrite <- (Rmult_comm (C ^ (4 * N))). unfold Rdiv; rewrite Rmult_assoc; apply Rmult_le_compat_l. { apply pow_le. left; apply Rlt_le_trans with 1. { apply Rlt_0_1. } unfold C; apply RmaxLess1. } assert (S (pred N) = N) by lia. rewrite H0. pattern N at 2; rewrite <- H0. do 2 rewrite fact_simpl. rewrite H0. repeat rewrite mult_INR. repeat rewrite Rinv_mult. rewrite (Rmult_comm (/ INR (S N))). repeat rewrite <- Rmult_assoc. rewrite Rinv_r. 2:apply not_O_INR;lia. rewrite Rmult_1_l. pattern (/ INR (fact (pred N))) at 2; rewrite <- Rmult_1_r. rewrite Rmult_assoc. apply Rmult_le_compat_l. { left; apply Rinv_0_lt_compat; apply INR_fact_lt_0. } apply Rmult_le_reg_l with (INR (S N)). { apply lt_INR_0; apply Nat.lt_0_succ. } rewrite <- Rmult_assoc; rewrite Rinv_r. { rewrite Rmult_1_r; rewrite Rmult_1_l. apply le_INR; apply Nat.le_succ_diag_r. } apply not_O_INR; discriminate. Qed. Lemma reste2_maj : forall (x y:R) (N:nat), (0 < N)%nat -> Rabs (Reste2 x y N) <= Majxy x y N. Proof. intros. set (C := Rmax 1 (Rmax (Rabs x) (Rabs y))). unfold Reste2. apply Rle_trans with (sum_f_R0 (fun k:nat => Rabs (sum_f_R0 (fun l:nat => (-1) ^ S (l + k) / INR (fact (2 * S (l + k) + 1)) * x ^ (2 * S (l + k) + 1) * ((-1) ^ (N - l) / INR (fact (2 * (N - l) + 1))) * y ^ (2 * (N - l) + 1)) (pred (N - k)))) ( pred N)). { apply (Rsum_abs (fun k:nat => sum_f_R0 (fun l:nat => (-1) ^ S (l + k) / INR (fact (2 * S (l + k) + 1)) * x ^ (2 * S (l + k) + 1) * ((-1) ^ (N - l) / INR (fact (2 * (N - l) + 1))) * y ^ (2 * (N - l) + 1)) (pred (N - k))) ( pred N)). } apply Rle_trans with (sum_f_R0 (fun k:nat => sum_f_R0 (fun l:nat => Rabs ((-1) ^ S (l + k) / INR (fact (2 * S (l + k) + 1)) * x ^ (2 * S (l + k) + 1) * ((-1) ^ (N - l) / INR (fact (2 * (N - l) + 1))) * y ^ (2 * (N - l) + 1))) (pred (N - k))) ( pred N)). { apply sum_Rle. intros. apply (Rsum_abs (fun l:nat => (-1) ^ S (l + n) / INR (fact (2 * S (l + n) + 1)) * x ^ (2 * S (l + n) + 1) * ((-1) ^ (N - l) / INR (fact (2 * (N - l) + 1))) * y ^ (2 * (N - l) + 1)) (pred (N - n))). } apply Rle_trans with (sum_f_R0 (fun k:nat => sum_f_R0 (fun l:nat => / INR (fact (2 * S (l + k) + 1) * fact (2 * (N - l) + 1)) * C ^ (2 * S (S (N + k)))) (pred (N - k))) ( pred N)). { apply sum_Rle; intros. apply sum_Rle; intros. unfold Rdiv; repeat rewrite Rabs_mult. do 2 rewrite pow_1_abs. do 2 rewrite Rmult_1_l. rewrite (Rabs_right (/ INR (fact (2 * S (n0 + n) + 1)))). 2:{ apply Rle_ge; left; apply Rinv_0_lt_compat. apply INR_fact_lt_0. } rewrite (Rabs_right (/ INR (fact (2 * (N - n0) + 1)))). 2:{ apply Rle_ge; left; apply Rinv_0_lt_compat. apply INR_fact_lt_0. } rewrite mult_INR. rewrite Rinv_mult. repeat rewrite Rmult_assoc. apply Rmult_le_compat_l. { left; apply Rinv_0_lt_compat; apply INR_fact_lt_0. } rewrite <- Rmult_assoc. rewrite <- (Rmult_comm (/ INR (fact (2 * (N - n0) + 1)))). rewrite Rmult_assoc. apply Rmult_le_compat_l. { left; apply Rinv_0_lt_compat; apply INR_fact_lt_0. } do 2 rewrite <- RPow_abs. apply Rle_trans with (Rabs x ^ (2 * S (n0 + n) + 1) * C ^ (2 * (N - n0) + 1)). { apply Rmult_le_compat_l. { apply pow_le; apply Rabs_pos. } apply pow_incr. split. { apply Rabs_pos. } unfold C. apply Rle_trans with (Rmax (Rabs x) (Rabs y)); apply RmaxLess2. } apply Rle_trans with (C ^ (2 * S (n0 + n) + 1) * C ^ (2 * (N - n0) + 1)). 2:{ right. replace (2 * S (S (N + n)))%nat with (2 * (N - n0) + 1 + (2 * S (n0 + n) + 1))%nat by lia. repeat rewrite pow_add. ring. } do 2 rewrite <- (Rmult_comm (C ^ (2 * (N - n0) + 1))). apply Rmult_le_compat_l. { apply pow_le. apply Rle_trans with 1. { left; apply Rlt_0_1. } unfold C; apply RmaxLess1. } apply pow_incr. split. { apply Rabs_pos. } unfold C; apply Rle_trans with (Rmax (Rabs x) (Rabs y)). - apply RmaxLess1. - apply RmaxLess2. } apply Rle_trans with (sum_f_R0 (fun k:nat => sum_f_R0 (fun l:nat => / INR (fact (2 * S (l + k) + 1) * fact (2 * (N - l) + 1)) * C ^ (4 * S N)) (pred (N - k))) (pred N)). { apply sum_Rle; intros. apply sum_Rle; intros. apply Rmult_le_compat_l. { left; apply Rinv_0_lt_compat. rewrite mult_INR; apply Rmult_lt_0_compat; apply INR_fact_lt_0. } apply Rle_pow. { unfold C; apply RmaxLess1. } lia. } apply Rle_trans with (sum_f_R0 (fun k:nat => sum_f_R0 (fun l:nat => C ^ (4 * S N) * Rsqr (/ INR (fact (S (S (N + k)))))) (pred (N - k))) (pred N)). { apply sum_Rle; intros. apply sum_Rle; intros. rewrite <- (Rmult_comm (C ^ (4 * S N))). apply Rmult_le_compat_l. { apply pow_le. left; apply Rlt_le_trans with 1. { apply Rlt_0_1. } unfold C; apply RmaxLess1. } replace (/ INR (fact (2 * S (n0 + n) + 1) * fact (2 * (N - n0) + 1))) with (Binomial.C (2 * S (S (N + n))) (2 * S (n0 + n) + 1) / INR (fact (2 * S (S (N + n))))). 2:{ unfold Rdiv; rewrite Rmult_comm. unfold Binomial.C. unfold Rdiv; repeat rewrite <- Rmult_assoc. rewrite Rinv_l. 2:{ apply INR_fact_neq_0. } rewrite Rmult_1_l. replace (2 * S (S (N + n)) - (2 * S (n0 + n) + 1))%nat with (2 * (N - n0) + 1)%nat by lia. rewrite mult_INR. reflexivity. } apply Rle_trans with (Binomial.C (2 * S (S (N + n))) (S (S (N + n))) / INR (fact (2 * S (S (N + n))))). { unfold Rdiv; do 2 rewrite <- (Rmult_comm (/ INR (fact (2 * S (S (N + n)))))). apply Rmult_le_compat_l. { left; apply Rinv_0_lt_compat; apply INR_fact_lt_0. } apply C_maj. lia. } right. unfold Rdiv; rewrite Rmult_comm. unfold Binomial.C. unfold Rdiv; repeat rewrite <- Rmult_assoc. rewrite Rinv_l. 2:{ apply INR_fact_neq_0. } rewrite Rmult_1_l. replace (2 * S (S (N + n)) - S (S (N + n)))%nat with (S (S (N + n))) by lia. rewrite Rinv_mult. unfold Rsqr; reflexivity. } apply Rle_trans with (sum_f_R0 (fun k:nat => INR N / INR (fact (S (S N))) * C ^ (4 * S N)) (pred N)). { apply sum_Rle; intros. rewrite <- (scal_sum (fun _:nat => C ^ (4 * S N)) (pred (N - n)) (Rsqr (/ INR (fact (S (S (N + n))))))). rewrite sum_cte. rewrite <- Rmult_assoc. do 2 rewrite <- (Rmult_comm (C ^ (4 * S N))). rewrite Rmult_assoc. apply Rmult_le_compat_l. { apply pow_le. left; apply Rlt_le_trans with 1. { apply Rlt_0_1. } unfold C; apply RmaxLess1. } apply Rle_trans with (Rsqr (/ INR (fact (S (S (N + n))))) * INR N). { apply Rmult_le_compat_l. { apply Rle_0_sqr. } apply le_INR. lia. } rewrite Rmult_comm; unfold Rdiv; apply Rmult_le_compat_l. { apply pos_INR. } apply Rle_trans with (/ INR (fact (S (S (N + n))))). { pattern (/ INR (fact (S (S (N + n))))) at 2; rewrite <- Rmult_1_r. unfold Rsqr. apply Rmult_le_compat_l. { left; apply Rinv_0_lt_compat; apply INR_fact_lt_0. } apply Rmult_le_reg_l with (INR (fact (S (S (N + n))))). { apply INR_fact_lt_0. } rewrite Rinv_r. { rewrite Rmult_1_r. apply (le_INR 1). apply Nat.le_succ_l. apply INR_lt; apply INR_fact_lt_0. } apply INR_fact_neq_0. } apply Rmult_le_reg_l with (INR (fact (S (S (N + n))))). { apply INR_fact_lt_0. } rewrite Rinv_r. 2:{ apply INR_fact_neq_0. } apply Rmult_le_reg_l with (INR (fact (S (S N)))). { apply INR_fact_lt_0. } rewrite Rmult_1_r. rewrite (Rmult_comm (INR (fact (S (S N))))). rewrite Rmult_assoc. rewrite Rinv_l. 2:{ apply INR_fact_neq_0. } rewrite Rmult_1_r. apply le_INR. apply fact_le. lia. } rewrite sum_cte. apply Rle_trans with (C ^ (4 * S N) / INR (fact N)). 2:{ right. unfold Majxy. unfold C. reflexivity. } rewrite <- (Rmult_comm (C ^ (4 * S N))). unfold Rdiv; rewrite Rmult_assoc; apply Rmult_le_compat_l. { apply pow_le. left; apply Rlt_le_trans with 1. { apply Rlt_0_1. } unfold C; apply RmaxLess1. } assert (S (pred N) = N) by lia. rewrite H0. do 2 rewrite fact_simpl. repeat rewrite mult_INR. repeat rewrite Rinv_mult. apply Rle_trans with (INR (S (S N)) * (/ INR (S (S N)) * (/ INR (S N) * / INR (fact N))) * INR N). { repeat rewrite Rmult_assoc. rewrite (Rmult_comm (INR N)). rewrite (Rmult_comm (INR (S (S N)))). apply Rmult_le_compat_l. 2:{ apply le_INR. lia. } repeat apply Rmult_le_pos; left; try apply Rinv_0_lt_compat; try apply INR_fact_lt_0; apply lt_INR_0; try lia. } repeat rewrite <- Rmult_assoc. rewrite Rinv_r. 2:{ apply not_O_INR; discriminate. } rewrite Rmult_1_l. apply Rle_trans with (/ INR (S N) * / INR (fact N) * INR (S N)). { repeat rewrite Rmult_assoc. repeat apply Rmult_le_compat_l. 3:{ apply le_INR; apply Nat.le_succ_diag_r. } 1,2:left; apply Rinv_0_lt_compat. { apply lt_INR_0;lia. } apply INR_fact_lt_0. } rewrite (Rmult_comm (/ INR (S N))). rewrite Rmult_assoc. rewrite Rinv_l. 2:{ apply not_O_INR; discriminate. } rewrite Rmult_1_r; right; reflexivity. Qed. Lemma reste1_cv_R0 : forall x y:R, Un_cv (Reste1 x y) 0. Proof. intros. assert (H := Majxy_cv_R0 x y). unfold Un_cv in H; unfold Rdist in H. unfold Un_cv; unfold Rdist; intros. elim (H eps H0); intros N0 H1. exists (S N0); intros. unfold Rminus; rewrite Ropp_0; rewrite Rplus_0_r. apply Rle_lt_trans with (Rabs (Majxy x y (pred n))). - rewrite (Rabs_right (Majxy x y (pred n))). + apply reste1_maj. apply Nat.lt_le_trans with (S N0). * apply Nat.lt_0_succ. * assumption. + apply Rle_ge. unfold Majxy. unfold Rdiv; apply Rmult_le_pos. * apply pow_le. apply Rle_trans with 1. -- left; apply Rlt_0_1. -- apply RmaxLess1. * left; apply Rinv_0_lt_compat; apply INR_fact_lt_0. - replace (Majxy x y (pred n)) with (Majxy x y (pred n) - 0); [ idtac | ring ]. apply H1. unfold ge; apply le_S_n. replace (S (pred n)) with n. + assumption. + symmetry; apply Nat.lt_succ_pred with 0%nat. apply Nat.lt_le_trans with (S N0); [ apply Nat.lt_0_succ | assumption ]. Qed. Lemma reste2_cv_R0 : forall x y:R, Un_cv (Reste2 x y) 0. Proof. intros. assert (H := Majxy_cv_R0 x y). unfold Un_cv in H; unfold Rdist in H. unfold Un_cv; unfold Rdist; intros. elim (H eps H0); intros N0 H1. exists (S N0); intros. unfold Rminus; rewrite Ropp_0; rewrite Rplus_0_r. apply Rle_lt_trans with (Rabs (Majxy x y n)). - rewrite (Rabs_right (Majxy x y n)). + apply reste2_maj. apply Nat.lt_le_trans with (S N0). * apply Nat.lt_0_succ. * assumption. + apply Rle_ge. unfold Majxy. unfold Rdiv; apply Rmult_le_pos. * apply pow_le. apply Rle_trans with 1. -- left; apply Rlt_0_1. -- apply RmaxLess1. * left; apply Rinv_0_lt_compat; apply INR_fact_lt_0. - replace (Majxy x y n) with (Majxy x y n - 0); [ idtac | ring ]. apply H1. unfold ge; apply Nat.le_trans with (S N0). + apply Nat.le_succ_diag_r. + exact H2. Qed. Lemma reste_cv_R0 : forall x y:R, Un_cv (Reste x y) 0. Proof. intros. unfold Reste. set (An := fun n:nat => Reste2 x y n). set (Bn := fun n:nat => Reste1 x y (S n)). cut (Un_cv (fun n:nat => An n - Bn n) (0 - 0) -> Un_cv (fun N:nat => Reste2 x y N - Reste1 x y (S N)) 0). - intro. apply H. apply CV_minus. + unfold An. replace (fun n:nat => Reste2 x y n) with (Reste2 x y). * apply reste2_cv_R0. * reflexivity. + unfold Bn. assert (H0 := reste1_cv_R0 x y). unfold Un_cv in H0; unfold Rdist in H0. unfold Un_cv; unfold Rdist; intros. elim (H0 eps H1); intros N0 H2. exists N0; intros. apply H2. unfold ge; apply Nat.le_trans with (S N0). * apply Nat.le_succ_diag_r. * apply -> Nat.succ_le_mono; assumption. - unfold An, Bn. intro. replace 0 with (0 - 0); [ idtac | ring ]. exact H. Qed. Theorem cos_plus : forall x y:R, cos (x + y) = cos x * cos y - sin x * sin y. Proof. intros. cut (Un_cv (C1 x y) (cos x * cos y - sin x * sin y)). { assert (Un_cv (C1 x y) (cos (x + y))) by apply C1_cvg. intros. apply UL_sequence with (C1 x y); assumption. } unfold Un_cv; unfold Rdist. intros. assert (H0 := A1_cvg x). assert (H1 := A1_cvg y). assert (H2 := B1_cvg x). assert (H3 := B1_cvg y). assert (H4 := CV_mult _ _ _ _ H0 H1). assert (H5 := CV_mult _ _ _ _ H2 H3). assert (H6 := reste_cv_R0 x y). unfold Un_cv in H4; unfold Un_cv in H5; unfold Un_cv in H6. unfold Rdist in H4; unfold Rdist in H5; unfold Rdist in H6. cut (0 < eps / 3); [ intro | unfold Rdiv; apply Rmult_lt_0_compat; [ assumption | apply Rinv_0_lt_compat; prove_sup0 ] ]. elim (H4 (eps / 3) H7); intros N1 H8. elim (H5 (eps / 3) H7); intros N2 H9. elim (H6 (eps / 3) H7); intros N3 H10. set (N := S (S (max (max N1 N2) N3))). exists N. intros. assert (n = S (pred n)) by lia. rewrite H12. rewrite <- cos_plus_form. 2:lia. rewrite <- H12. apply Rle_lt_trans with (Rabs (A1 x n * A1 y n - cos x * cos y) + Rabs (sin x * sin y - B1 x (pred n) * B1 y (pred n) + Reste x y (pred n))). { replace (A1 x n * A1 y n - B1 x (pred n) * B1 y (pred n) + Reste x y (pred n) - (cos x * cos y - sin x * sin y)) with (A1 x n * A1 y n - cos x * cos y + (sin x * sin y - B1 x (pred n) * B1 y (pred n) + Reste x y (pred n))); [ apply Rabs_triang | ring ]. } replace eps with (eps / 3 + (eps / 3 + eps / 3)) by field. apply Rplus_lt_compat. { apply H8. lia. } apply Rle_lt_trans with (Rabs (sin x * sin y - B1 x (pred n) * B1 y (pred n)) + Rabs (Reste x y (pred n))). { apply Rabs_triang. } apply Rplus_lt_compat. { rewrite <- Rabs_Ropp. rewrite Ropp_minus_distr. apply H9. lia. } replace (Reste x y (pred n)) with (Reste x y (pred n) - 0) by ring. apply H10. lia. Qed. coq-8.20.0/theories/Reals/Cos_rel.v000066400000000000000000000240471466560755400170610ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* (-1) ^ k / INR (fact (2 * k)) * x ^ (2 * k)) N. Definition B1 (x:R) (N:nat) : R := sum_f_R0 (fun k:nat => (-1) ^ k / INR (fact (2 * k + 1)) * x ^ (2 * k + 1)) N. Definition C1 (x y:R) (N:nat) : R := sum_f_R0 (fun k:nat => (-1) ^ k / INR (fact (2 * k)) * (x + y) ^ (2 * k)) N. Definition Reste1 (x y:R) (N:nat) : R := sum_f_R0 (fun k:nat => sum_f_R0 (fun l:nat => (-1) ^ S (l + k) / INR (fact (2 * S (l + k))) * x ^ (2 * S (l + k)) * ((-1) ^ (N - l) / INR (fact (2 * (N - l)))) * y ^ (2 * (N - l))) (pred (N - k))) (pred N). Definition Reste2 (x y:R) (N:nat) : R := sum_f_R0 (fun k:nat => sum_f_R0 (fun l:nat => (-1) ^ S (l + k) / INR (fact (2 * S (l + k) + 1)) * x ^ (2 * S (l + k) + 1) * ((-1) ^ (N - l) / INR (fact (2 * (N - l) + 1))) * y ^ (2 * (N - l) + 1)) (pred (N - k))) ( pred N). Definition Reste (x y:R) (N:nat) : R := Reste2 x y N - Reste1 x y (S N). (* Here is the main result that will be used to prove that (cos (x+y))=(cos x)(cos y)-(sin x)(sin y) *) Theorem cos_plus_form : forall (x y:R) (n:nat), (0 < n)%nat -> A1 x (S n) * A1 y (S n) - B1 x n * B1 y n + Reste x y n = C1 x y (S n). Proof. intros. unfold A1, B1. rewrite (cauchy_finite (fun k:nat => (-1) ^ k / INR (fact (2 * k)) * x ^ (2 * k)) (fun k:nat => (-1) ^ k / INR (fact (2 * k)) * y ^ (2 * k)) ( S n)). 2:nia. rewrite (cauchy_finite (fun k:nat => (-1) ^ k / INR (fact (2 * k + 1)) * x ^ (2 * k + 1)) (fun k:nat => (-1) ^ k / INR (fact (2 * k + 1)) * y ^ (2 * k + 1)) n H). unfold Reste. replace (sum_f_R0 (fun k:nat => sum_f_R0 (fun l:nat => (-1) ^ S (l + k) / INR (fact (2 * S (l + k))) * x ^ (2 * S (l + k)) * ((-1) ^ (S n - l) / INR (fact (2 * (S n - l))) * y ^ (2 * (S n - l)))) (pred (S n - k))) ( pred (S n))) with (Reste1 x y (S n)). 2:{ unfold Reste1; apply sum_eq; intros. apply sum_eq; intros. nra. } replace (sum_f_R0 (fun k:nat => sum_f_R0 (fun l:nat => (-1) ^ S (l + k) / INR (fact (2 * S (l + k) + 1)) * x ^ (2 * S (l + k) + 1) * ((-1) ^ (n - l) / INR (fact (2 * (n - l) + 1)) * y ^ (2 * (n - l) + 1))) (pred (n - k))) ( pred n)) with (Reste2 x y n). 2:{ unfold Reste2; apply sum_eq; intros. apply sum_eq; intros. nra. } replace (sum_f_R0 (fun k:nat => sum_f_R0 (fun p:nat => (-1) ^ p / INR (fact (2 * p)) * x ^ (2 * p) * ((-1) ^ (k - p) / INR (fact (2 * (k - p))) * y ^ (2 * (k - p)))) k) (S n)) with (sum_f_R0 (fun k:nat => (-1) ^ k / INR (fact (2 * k)) * sum_f_R0 (fun l:nat => C (2 * k) (2 * l) * x ^ (2 * l) * y ^ (2 * (k - l))) k) (S n)). 2:{ apply sum_eq; intros. rewrite scal_sum. apply sum_eq; intros. unfold Rdiv. repeat rewrite <- Rmult_assoc. rewrite <- (Rmult_comm (/ INR (fact (2 * i)))). repeat rewrite <- Rmult_assoc. replace (/ INR (fact (2 * i)) * C (2 * i) (2 * i0)) with (/ INR (fact (2 * i0)) * / INR (fact (2 * (i - i0)))). { replace ((-1) ^ i) with ((-1) ^ i0 * (-1) ^ (i - i0)). - ring. - pattern i at 2; replace i with (i0 + (i - i0))%nat by nia. rewrite pow_add. ring. } unfold C. unfold Rdiv; repeat rewrite <- Rmult_assoc. rewrite Rinv_l. 2:apply INR_fact_neq_0. rewrite Rmult_1_l. rewrite Rinv_mult. replace (2 * i - 2 * i0)%nat with (2 * (i - i0))%nat by lia. reflexivity. } pose (sin_nnn := fun n:nat => match n with | O => 0 | S p => (-1) ^ S p / INR (fact (2 * S p)) * sum_f_R0 (fun l:nat => C (2 * S p) (S (2 * l)) * x ^ S (2 * l) * y ^ S (2 * (p - l))) p end). ring_simplify. unfold Rminus. replace (* (- old ring compat *) (- sum_f_R0 (fun k:nat => sum_f_R0 (fun p:nat => (-1) ^ p / INR (fact (2 * p + 1)) * x ^ (2 * p + 1) * ((-1) ^ (k - p) / INR (fact (2 * (k - p) + 1)) * y ^ (2 * (k - p) + 1))) k) n) with (sum_f_R0 sin_nnn (S n)). - rewrite <- sum_plus. unfold C1. apply sum_eq; intros. induction i as [| i Hreci]. { unfold C; simpl. nra. } unfold sin_nnn. rewrite <- Rmult_plus_distr_l. apply Rmult_eq_compat_l. rewrite binomial. pose (Wn := fun i0:nat => C (2 * S i) i0 * x ^ i0 * y ^ (2 * S i - i0)). replace (sum_f_R0 (fun l:nat => C (2 * S i) (2 * l) * x ^ (2 * l) * y ^ (2 * (S i - l))) (S i)) with (sum_f_R0 (fun l:nat => Wn (2 * l)%nat) (S i)). 2:{ apply sum_eq; intros. unfold Wn. apply Rmult_eq_compat_l. replace (2 * S i - 2 * i0)%nat with (2 * (S i - i0))%nat by lia. reflexivity. } replace (sum_f_R0 (fun l:nat => C (2 * S i) (S (2 * l)) * x ^ S (2 * l) * y ^ S (2 * (i - l))) i) with (sum_f_R0 (fun l:nat => Wn (S (2 * l))) i). { apply sum_decomposition. } apply sum_eq; intros. unfold Wn. apply Rmult_eq_compat_l. replace (2 * S i - S (2 * i0))%nat with (S (2 * (i - i0))) by lia. reflexivity. - match goal with |- _ = - ?r => replace (- r) with (-1 * r) by ring end. rewrite scal_sum. rewrite decomp_sum. 2:nia. replace (sin_nnn 0%nat) with 0 by reflexivity. rewrite Rplus_0_l. change (pred (S n)) with n. apply sum_eq; intros. rewrite Rmult_comm. unfold sin_nnn. rewrite scal_sum. rewrite scal_sum. apply sum_eq; intros. unfold Rdiv. repeat rewrite <- Rmult_assoc. rewrite <- (Rmult_comm (/ INR (fact (2 * S i)))). repeat rewrite <- Rmult_assoc. replace (/ INR (fact (2 * S i)) * C (2 * S i) (S (2 * i0))) with (/ INR (fact (2 * i0 + 1)) * / INR (fact (2 * (i - i0) + 1))). { replace (S (2 * i0)) with (2 * i0 + 1)%nat; [ idtac | ring ]. replace (S (2 * (i - i0))) with (2 * (i - i0) + 1)%nat; [ idtac | ring ]. replace ((-1) ^ S i) with (-1 * (-1) ^ i0 * (-1) ^ (i - i0)). { ring. } simpl. pattern i at 2; replace i with (i0 + (i - i0))%nat by nia. rewrite pow_add. ring. } unfold C. unfold Rdiv; repeat rewrite <- Rmult_assoc. rewrite Rinv_l. 2:apply INR_fact_neq_0. rewrite Rmult_1_l. rewrite Rinv_mult. replace (S (2 * i0)) with (2 * i0 + 1)%nat; [ apply Rmult_eq_compat_l | ring ]. replace (2 * S i - (2 * i0 + 1))%nat with (2 * (i - i0) + 1)%nat by lia. reflexivity. Qed. Lemma pow_sqr : forall (x:R) (i:nat), x ^ (2 * i) = (x * x) ^ i. Proof. intros. assert (H := pow_Rsqr x i). unfold Rsqr in H; exact H. Qed. Lemma A1_cvg : forall x:R, Un_cv (A1 x) (cos x). Proof. intro. unfold cos; destruct (exist_cos (Rsqr x)) as (x0,p). unfold cos_in, cos_n, infinite_sum, Rdist in p. unfold Un_cv, Rdist; intros. destruct (p eps H) as (x1,H0). exists x1; intros. unfold A1. replace (sum_f_R0 (fun k:nat => (-1) ^ k / INR (fact (2 * k)) * x ^ (2 * k)) n) with (sum_f_R0 (fun i:nat => (-1) ^ i / INR (fact (2 * i)) * (x * x) ^ i) n). - apply H0; assumption. - apply sum_eq. intros. replace ((x * x) ^ i) with (x ^ (2 * i)). + reflexivity. + apply pow_sqr. Qed. Lemma C1_cvg : forall x y:R, Un_cv (C1 x y) (cos (x + y)). Proof. intros. unfold cos. destruct (exist_cos (Rsqr (x + y))) as (x0,p). unfold cos_in, cos_n, infinite_sum, Rdist in p. unfold Un_cv, Rdist; intros. destruct (p eps H) as (x1,H0). exists x1; intros. unfold C1. replace (sum_f_R0 (fun k:nat => (-1) ^ k / INR (fact (2 * k)) * (x + y) ^ (2 * k)) n) with (sum_f_R0 (fun i:nat => (-1) ^ i / INR (fact (2 * i)) * ((x + y) * (x + y)) ^ i) n). - apply H0; assumption. - apply sum_eq. intros. replace (((x + y) * (x + y)) ^ i) with ((x + y) ^ (2 * i)). + reflexivity. + apply pow_sqr. Qed. Lemma B1_cvg : forall x:R, Un_cv (B1 x) (sin x). Proof. intro. case (Req_dec x 0); intro. { rewrite H. rewrite sin_0. unfold B1. unfold Un_cv; unfold Rdist; intros; exists 0%nat; intros. replace (sum_f_R0 (fun k:nat => (-1) ^ k / INR (fact (2 * k + 1)) * 0 ^ (2 * k + 1)) n) with 0. { unfold Rminus; rewrite Rplus_opp_r; rewrite Rabs_R0; assumption. } - induction n as [| n Hrecn]. { simpl; ring. } rewrite tech5; rewrite <- Hrecn. { simpl; ring. } unfold ge; apply Nat.le_0_l. } unfold sin. destruct (exist_sin (Rsqr x)) as (x0,p). unfold sin_in, sin_n, infinite_sum, Rdist in p. unfold Un_cv, Rdist; intros. cut (0 < eps / Rabs x); [ intro | unfold Rdiv; apply Rmult_lt_0_compat; [ assumption | apply Rinv_0_lt_compat; apply Rabs_pos_lt; assumption ] ]. destruct (p (eps / Rabs x) H1) as (x1,H2). exists x1; intros. unfold B1. replace (sum_f_R0 (fun k:nat => (-1) ^ k / INR (fact (2 * k + 1)) * x ^ (2 * k + 1)) n) with (x * sum_f_R0 (fun i:nat => (-1) ^ i / INR (fact (2 * i + 1)) * (x * x) ^ i) n). 2:{ rewrite scal_sum. apply sum_eq. intros. rewrite pow_add. rewrite pow_sqr. simpl. ring. } replace (x * sum_f_R0 (fun i:nat => (-1) ^ i / INR (fact (2 * i + 1)) * (x * x) ^ i) n - x * x0) with (x * (sum_f_R0 (fun i:nat => (-1) ^ i / INR (fact (2 * i + 1)) * (x * x) ^ i) n - x0)); [ idtac | ring ]. rewrite Rabs_mult. apply Rmult_lt_reg_l with (/ Rabs x). { apply Rinv_0_lt_compat; apply Rabs_pos_lt; assumption. } rewrite <- Rmult_assoc, Rinv_l, Rmult_1_l, <- (Rmult_comm eps). - apply H2; assumption. - apply Rabs_no_R0; assumption. Qed. coq-8.20.0/theories/Reals/DiscrR.v000066400000000000000000000042301466560755400166510ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* IZR z1 = IZR z2. Proof. intros; rewrite H; reflexivity. Qed. Ltac discrR := try match goal with | |- (?X1 <> ?X2) => repeat rewrite <- plus_IZR || rewrite <- mult_IZR || rewrite <- Ropp_Ropp_IZR || rewrite Z_R_minus; apply eq_IZR_contrapositive; try discriminate end. Ltac prove_sup0 := match goal with | |- (0 < 1) => apply Rlt_0_1 | |- (0 < ?X1) => repeat (apply Rmult_lt_0_compat || apply Rplus_lt_pos; try apply Rlt_0_1 || apply Rlt_R0_R2) | |- (?X1 > 0) => change (0 < X1); prove_sup0 end. Ltac omega_sup := repeat rewrite <- plus_IZR || rewrite <- mult_IZR || rewrite <- Ropp_Ropp_IZR || rewrite Z_R_minus; apply IZR_lt; lia. Ltac prove_sup := match goal with | |- (?X1 > ?X2) => change (X2 < X1); prove_sup | |- (0 < ?X1) => prove_sup0 | |- (- ?X1 < 0) => rewrite <- Ropp_0; prove_sup | |- (- ?X1 < - ?X2) => apply Ropp_lt_gt_contravar; prove_sup | |- (- ?X1 < ?X2) => apply Rlt_trans with 0; prove_sup | |- (?X1 < ?X2) => omega_sup | _ => idtac end. Ltac Rcompute := repeat rewrite <- plus_IZR || rewrite <- mult_IZR || rewrite <- Ropp_Ropp_IZR || rewrite Z_R_minus; apply IZR_eq; try reflexivity. coq-8.20.0/theories/Reals/Exp_prop.v000066400000000000000000000661221466560755400172670ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* / INR (fact k) * x ^ k) N. Lemma E1_cvg : forall x:R, Un_cv (E1 x) (exp x). Proof. intro; unfold exp; unfold projT1. case (exist_exp x); intro. unfold exp_in, Un_cv; unfold infinite_sum, E1; trivial. Qed. Definition Reste_E (x y:R) (N:nat) : R := sum_f_R0 (fun k:nat => sum_f_R0 (fun l:nat => / INR (fact (S (l + k))) * x ^ S (l + k) * (/ INR (fact (N - l)) * y ^ (N - l))) ( pred (N - k))) (pred N). Lemma exp_form : forall (x y:R) (n:nat), (0 < n)%nat -> E1 x n * E1 y n - Reste_E x y n = E1 (x + y) n. Proof. intros; unfold E1. rewrite cauchy_finite. - unfold Reste_E; unfold Rminus; rewrite Rplus_assoc; rewrite Rplus_opp_r; rewrite Rplus_0_r; apply sum_eq; intros. rewrite binomial. rewrite scal_sum; apply sum_eq; intros. unfold C; unfold Rdiv; repeat rewrite Rmult_assoc; rewrite (Rmult_comm (INR (fact i))); repeat rewrite Rmult_assoc; rewrite Rinv_l. + rewrite Rmult_1_r; rewrite Rinv_mult. ring. + apply INR_fact_neq_0. - apply H. Qed. Definition maj_Reste_E (x y:R) (N:nat) : R := 4 * (Rmax 1 (Rmax (Rabs x) (Rabs y)) ^ (2 * N) / Rsqr (INR (fact (Nat.div2 (pred N))))). (**********) Lemma div2_double : forall N:nat, Nat.div2 (2 * N) = N. Proof. exact Nat.div2_double. Qed. Lemma div2_S_double : forall N:nat, Nat.div2 (S (2 * N)) = N. Proof. intro; induction N as [| N HrecN]. - reflexivity. - replace (2 * S N)%nat with (S (S (2 * N))). + simpl; simpl in HrecN; rewrite HrecN; reflexivity. + ring. Qed. Lemma div2_not_R0 : forall N:nat, (1 < N)%nat -> (0 < Nat.div2 N)%nat. Proof. intros; induction N as [| N HrecN]. - elim (Nat.nlt_0_r _ H). - cut ((1 < N)%nat \/ N = 1%nat). { intro; elim H0; intro. - destruct N; cbn; [ auto | apply Nat.lt_0_succ ]. - subst N; simpl; apply Nat.lt_0_succ. } inversion H. + right; reflexivity. + left; apply Nat.lt_le_trans with 2%nat; [ apply Nat.lt_succ_diag_r | assumption ]. Qed. Lemma Reste_E_maj : forall (x y:R) (N:nat), (0 < N)%nat -> Rabs (Reste_E x y N) <= maj_Reste_E x y N. Proof. intros; set (M := Rmax 1 (Rmax (Rabs x) (Rabs y))). assert (HM1 : 1 <= M) by apply RmaxLess1. assert (HMx : Rabs x <= M) by (eapply Rle_trans;[apply RmaxLess1|apply RmaxLess2]). assert (HMy : Rabs y <= M) by (eapply Rle_trans;[apply RmaxLess2|apply RmaxLess2]). pose proof (Rabs_pos x) as HPosAbsx. pose proof (Rabs_pos y) as HPosAbsy. apply Rle_trans with (M ^ (2 * N) * sum_f_R0 (fun k:nat => sum_f_R0 (fun l:nat => / Rsqr (INR (fact (Nat.div2 (S N))))) (pred (N - k))) (pred N)). - unfold Reste_E. apply Rle_trans with (sum_f_R0 (fun k:nat => Rabs (sum_f_R0 (fun l:nat => / INR (fact (S (l + k))) * x ^ S (l + k) * (/ INR (fact (N - l)) * y ^ (N - l))) ( pred (N - k)))) (pred N)). { apply (Rsum_abs (fun k:nat => sum_f_R0 (fun l:nat => / INR (fact (S (l + k))) * x ^ S (l + k) * (/ INR (fact (N - l)) * y ^ (N - l))) ( pred (N - k))) (pred N)). } apply Rle_trans with (sum_f_R0 (fun k:nat => sum_f_R0 (fun l:nat => Rabs (/ INR (fact (S (l + k))) * x ^ S (l + k) * (/ INR (fact (N - l)) * y ^ (N - l)))) ( pred (N - k))) (pred N)). { apply sum_Rle; intros. apply (Rsum_abs (fun l:nat => / INR (fact (S (l + n))) * x ^ S (l + n) * (/ INR (fact (N - l)) * y ^ (N - l)))). } apply Rle_trans with (sum_f_R0 (fun k:nat => sum_f_R0 (fun l:nat => M ^ (2 * N) * / INR (fact (S l)) * / INR (fact (N - l))) (pred (N - k))) (pred N)). + apply sum_Rle; intros. apply sum_Rle; intros. repeat rewrite Rabs_mult. do 2 rewrite <- RPow_abs. rewrite (Rabs_right (/ INR (fact (S (n0 + n))))). 2:{ apply Rle_ge; left; apply Rinv_0_lt_compat; apply INR_fact_lt_0. } rewrite (Rabs_right (/ INR (fact (N - n0)))). 2:{ apply Rle_ge; left; apply Rinv_0_lt_compat; apply INR_fact_lt_0. } replace (/ INR (fact (S (n0 + n))) * Rabs x ^ S (n0 + n) * (/ INR (fact (N - n0)) * Rabs y ^ (N - n0))) with (/ INR (fact (N - n0)) * / INR (fact (S (n0 + n))) * Rabs x ^ S (n0 + n) * Rabs y ^ (N - n0)) by ring. rewrite <- (Rmult_comm (/ INR (fact (N - n0)))). repeat rewrite Rmult_assoc. apply Rmult_le_compat_l. { left; apply Rinv_0_lt_compat; apply INR_fact_lt_0. } apply Rle_trans with (/ INR (fact (S n0)) * Rabs x ^ S (n0 + n) * Rabs y ^ (N - n0)). { rewrite (Rmult_comm (/ INR (fact (S (n0 + n))))); rewrite (Rmult_comm (/ INR (fact (S n0)))); repeat rewrite Rmult_assoc; apply Rmult_le_compat_l. { apply pow_le; apply Rabs_pos. } rewrite (Rmult_comm (/ INR (fact (S n0)))); apply Rmult_le_compat_l. { apply pow_le; apply Rabs_pos. } apply Rinv_le_contravar. { apply INR_fact_lt_0. } apply le_INR; apply fact_le; lia. } rewrite (Rmult_comm (M ^ (2 * N))); rewrite Rmult_assoc; apply Rmult_le_compat_l. { left; apply Rinv_0_lt_compat; apply INR_fact_lt_0. } apply Rle_trans with (M ^ S (n0 + n) * Rabs y ^ (N - n0)). { do 2 rewrite <- (Rmult_comm (Rabs y ^ (N - n0))). apply Rmult_le_compat_l. { apply pow_le; apply Rabs_pos. } apply pow_incr; split;lra. } apply Rle_trans with (M ^ S (n0 + n) * M ^ (N - n0)). { apply Rmult_le_compat_l. { apply pow_le; lra. } apply pow_incr; split; lra. } rewrite <- pow_add; replace (S (n0 + n) + (N - n0))%nat with (N + S n)%nat by lia. apply Rle_pow. { assumption. } lia. + rewrite scal_sum. apply sum_Rle; intros. rewrite <- Rmult_comm. rewrite scal_sum. apply sum_Rle; intros. rewrite (Rmult_comm (/ Rsqr (INR (fact (Nat.div2 (S N)))))). rewrite Rmult_assoc; apply Rmult_le_compat_l. { apply pow_le. lra. } assert (H2 := even_odd_cor N). elim H2; intros N0 H3. elim H3; intro. * apply Rle_trans with (/ INR (fact n0) * / INR (fact (N - n0))). { do 2 rewrite <- (Rmult_comm (/ INR (fact (N - n0)))). apply Rmult_le_compat_l. { left; apply Rinv_0_lt_compat; apply INR_fact_lt_0. } apply Rinv_le_contravar. { apply INR_fact_lt_0. } apply le_INR. apply fact_le. apply Nat.le_succ_diag_r. } replace (/ INR (fact n0) * / INR (fact (N - n0))) with (C N n0 / INR (fact N)). 2:{ unfold C, Rdiv. rewrite (Rmult_comm (INR (fact N))). repeat rewrite Rmult_assoc. rewrite Rinv_r. 2:{ apply INR_fact_neq_0. } rewrite Rinv_mult. rewrite Rmult_1_r; ring. } pattern N at 1; rewrite H4. apply Rle_trans with (C N N0 / INR (fact N)). { unfold Rdiv; do 2 rewrite <- (Rmult_comm (/ INR (fact N))). apply Rmult_le_compat_l. { left; apply Rinv_0_lt_compat; apply INR_fact_lt_0. } rewrite H4. apply C_maj. lia. } replace (C N N0 / INR (fact N)) with (/ Rsqr (INR (fact N0))). { rewrite H4; rewrite div2_S_double; right; reflexivity. } unfold Rsqr, C, Rdiv. repeat rewrite Rinv_mult. rewrite (Rmult_comm (INR (fact N))). repeat rewrite Rmult_assoc. rewrite Rinv_r. 2:apply INR_fact_neq_0. replace (N - N0)%nat with N0 by lia. ring. * replace (/ INR (fact (S n0)) * / INR (fact (N - n0))) with (C (S N) (S n0) / INR (fact (S N))). 2:{ unfold C, Rdiv. rewrite (Rmult_comm (INR (fact (S N)))). rewrite Rmult_assoc; rewrite Rinv_r. 2:{ apply INR_fact_neq_0. } rewrite Rmult_1_r; rewrite Rinv_mult. reflexivity. } apply Rle_trans with (C (S N) (S N0) / INR (fact (S N))). 2:{ assert (S N = (2 * S N0)%nat) by lia. replace (C (S N) (S N0) / INR (fact (S N))) with (/ Rsqr (INR (fact (S N0)))). { rewrite H5; rewrite div2_double. right; reflexivity. } unfold Rsqr, C, Rdiv. repeat rewrite Rinv_mult. replace (S N - S N0)%nat with (S N0) by lia. rewrite (Rmult_comm (INR (fact (S N)))). repeat rewrite Rmult_assoc. rewrite Rinv_r. 2:apply INR_fact_neq_0. ring. } unfold Rdiv; do 2 rewrite <- (Rmult_comm (/ INR (fact (S N)))). apply Rmult_le_compat_l. { left; apply Rinv_0_lt_compat; apply INR_fact_lt_0. } assert (S N = (2 * S N0)%nat) by (rewrite H4; ring). rewrite H5; apply C_maj. lia. - unfold maj_Reste_E. fold M. unfold Rdiv; rewrite (Rmult_comm 4). rewrite Rmult_assoc. apply Rmult_le_compat_l. { apply pow_le. lra. } apply Rle_trans with (sum_f_R0 (fun k:nat => INR (N - k) * / Rsqr (INR (fact (Nat.div2 (S N))))) (pred N)). { apply sum_Rle; intros. rewrite sum_cte. replace (S (pred (N - n))) with (N - n)%nat by lia. right; apply Rmult_comm. } apply Rle_trans with (sum_f_R0 (fun k:nat => INR N * / Rsqr (INR (fact (Nat.div2 (S N))))) (pred N)). { apply sum_Rle; intros. do 2 rewrite <- (Rmult_comm (/ Rsqr (INR (fact (Nat.div2 (S N)))))). apply Rmult_le_compat_l. { left; apply Rinv_0_lt_compat; apply Rsqr_pos_lt. apply INR_fact_neq_0. } apply le_INR. lia. } rewrite sum_cte; replace (S (pred N)) with N by lia. assert (Nat.div2 (S N) = S (Nat.div2 (pred N))). { assert (H0 := even_odd_cor N). elim H0; intros N0 H1. elim H1; intro. - assert (0 < N0)%nat by lia. rewrite H2. rewrite div2_S_double. replace (2 * N0)%nat with (S (S (2 * pred N0))) by lia. replace (pred (S (S (2 * pred N0)))) with (S (2 * pred N0)) by lia. rewrite div2_S_double. lia. - rewrite H2. change (pred (S (2 * N0))) with (2 * N0)%nat. replace (S (S (2 * N0))) with (2 * S N0)%nat by ring. do 2 rewrite div2_double. reflexivity. } rewrite H0. rewrite fact_simpl; rewrite Nat.mul_comm; rewrite mult_INR; rewrite Rsqr_mult. rewrite Rinv_mult. rewrite (Rmult_comm (INR N)); repeat rewrite Rmult_assoc; apply Rmult_le_compat_l. { left; apply Rinv_0_lt_compat; apply Rsqr_pos_lt; apply INR_fact_neq_0. } rewrite <- H0. assert (INR N <= INR (2 * Nat.div2 (S N))). { assert (H1 := even_odd_cor N). elim H1; intros N0 H2. elim H2; intro. - pattern N at 2; rewrite H3. rewrite div2_S_double. rewrite H3. apply Rle_refl. - pattern N at 2; rewrite H3. replace (S (S (2 * N0))) with (2 * S N0)%nat by lia. rewrite div2_double. apply le_INR. lia. } apply Rmult_le_reg_l with (Rsqr (INR (Nat.div2 (S N)))). { apply Rsqr_pos_lt. apply not_O_INR; red; intro. PreOmega.zify; PreOmega.Z.to_euclidean_division_equations; lia. } repeat rewrite <- Rmult_assoc. rewrite Rinv_r. 2:{ unfold Rsqr; apply prod_neq_R0; apply not_O_INR; PreOmega.zify; PreOmega.Z.to_euclidean_division_equations; lia. } rewrite Rmult_1_l. change 4 with (Rsqr 2). rewrite <- Rsqr_mult. apply Rsqr_incr_1. { change 2 with (INR 2). rewrite Rmult_comm, <- mult_INR; apply H1. } { left; apply lt_INR_0; apply H. } change 2 with (INR 2). rewrite <- mult_INR. apply pos_INR. Qed. Lemma maj_Reste_cv_R0 : forall x y:R, Un_cv (maj_Reste_E x y) 0. Proof. intros; assert (H := Majxy_cv_R0 x y). unfold Un_cv in H; unfold Un_cv; intros. cut (0 < eps / 4); [ intro | unfold Rdiv; apply Rmult_lt_0_compat; [ assumption | apply Rinv_0_lt_compat; prove_sup0 ] ]. elim (H _ H1); intros N0 H2. exists (max (2 * S N0) 2); intros. unfold Rdist in H2; unfold Rdist; rewrite Rminus_0_r; unfold Majxy in H2; unfold maj_Reste_E. set (M := Rmax 1 (Rmax (Rabs x) (Rabs y))) in *. assert (HM1 : 1 <= M) by apply RmaxLess1. assert (HMx : Rabs x <= M) by (eapply Rle_trans;[apply RmaxLess1|apply RmaxLess2]). assert (HMy : Rabs y <= M) by (eapply Rle_trans;[apply RmaxLess2|apply RmaxLess2]). pose proof (Rabs_pos x) as HPosAbsx. pose proof (Rabs_pos y) as HPosAbsy. rewrite Rabs_right. 2:{ apply Rle_ge. unfold Rdiv; apply Rmult_le_pos. { left; prove_sup0. } apply Rmult_le_pos. { apply pow_le. lra. } left; apply Rinv_0_lt_compat; apply Rsqr_pos_lt; apply INR_fact_neq_0. } apply Rle_lt_trans with (4 * (M ^ (4 * S (Nat.div2 (pred n))) / INR (fact (Nat.div2 (pred n))))). - apply Rmult_le_compat_l. { left; prove_sup0. } unfold Rdiv, Rsqr; rewrite Rinv_mult. rewrite (Rmult_comm (M ^ (2 * n))); rewrite (Rmult_comm (M ^ (4 * S (Nat.div2 (pred n))))) ; rewrite Rmult_assoc; apply Rmult_le_compat_l. { left; apply Rinv_0_lt_compat; apply INR_fact_lt_0. } apply Rle_trans with (M ^ (2 * n)). { rewrite Rmult_comm; pattern (M ^ (2 * n)) at 2; rewrite <- Rmult_1_r; apply Rmult_le_compat_l. { apply pow_le; lra. } apply Rmult_le_reg_l with (INR (fact (Nat.div2 (pred n)))). { apply INR_fact_lt_0. } rewrite Rmult_1_r; rewrite Rinv_r. { apply (le_INR 1). apply Nat.le_succ_l. apply INR_lt. apply INR_fact_lt_0. } apply INR_fact_neq_0. } apply Rle_pow. { apply RmaxLess1. } assert (H4 := even_odd_cor n). elim H4; intros N1 H5. elim H5; intro. { assert (0 < N1)%nat by lia. rewrite H6. replace (pred (2 * N1)) with (S (2 * pred N1)) by lia. rewrite div2_S_double. lia. } rewrite H6. replace (pred (S (2 * N1))) with (2 * N1)%nat by lia. rewrite div2_double. lia. - apply Rmult_lt_reg_l with (/ 4). { apply Rinv_0_lt_compat; prove_sup0. } rewrite <- Rmult_assoc; rewrite Rinv_l. 2:discrR. rewrite Rmult_1_l; rewrite Rmult_comm. replace (M ^ (4 * S (Nat.div2 (pred n))) / INR (fact (Nat.div2 (pred n)))) with (Rabs (M ^ (4 * S (Nat.div2 (pred n))) / INR (fact (Nat.div2 (pred n))) - 0)). 2:{ rewrite Rminus_0_r; apply Rabs_right. apply Rle_ge. unfold Rdiv; apply Rmult_le_pos. { apply pow_le. lra. } left; apply Rinv_0_lt_compat; apply INR_fact_lt_0. } apply H2; unfold ge. assert (2 * S N0 <= n)%nat by lia. apply le_S_n. apply INR_le; apply Rmult_le_reg_l with (INR 2). { simpl; prove_sup0. } do 2 rewrite <- mult_INR; apply le_INR. apply Nat.le_trans with n. { apply H4. } assert (H5 := even_odd_cor n). elim H5; intros N1 H6. elim H6; intro. { assert (0 < N1)%nat by lia. rewrite H7. apply Nat.mul_le_mono_nonneg_l. { apply Nat.le_0_l. } replace (pred (2 * N1)) with (S (2 * pred N1)) by lia. rewrite div2_S_double. lia. } rewrite H7. change (pred (S (2 * N1))) with (2 * N1)%nat. rewrite div2_double. lia. Qed. (**********) Lemma Reste_E_cv : forall x y:R, Un_cv (Reste_E x y) 0. Proof. intros; assert (H := maj_Reste_cv_R0 x y). unfold Un_cv in H; unfold Un_cv; intros; elim (H _ H0); intros. exists (max x0 1); intros. unfold Rdist; rewrite Rminus_0_r. apply Rle_lt_trans with (maj_Reste_E x y n). - apply Reste_E_maj. apply Nat.lt_le_trans with 1%nat. + apply Nat.lt_0_succ. + apply Nat.le_trans with (max x0 1). * apply Nat.le_max_r. * apply H2. - replace (maj_Reste_E x y n) with (Rdist (maj_Reste_E x y n) 0). + apply H1. unfold ge; apply Nat.le_trans with (max x0 1). * apply Nat.le_max_l. * apply H2. + unfold Rdist; rewrite Rminus_0_r; apply Rabs_right. apply Rle_ge; apply Rle_trans with (Rabs (Reste_E x y n)). * apply Rabs_pos. * apply Reste_E_maj. apply Nat.lt_le_trans with 1%nat. -- apply Nat.lt_0_succ. -- apply Nat.le_trans with (max x0 1). ++ apply Nat.le_max_r. ++ apply H2. Qed. (**********) Lemma exp_plus : forall x y:R, exp (x + y) = exp x * exp y. Proof. intros; assert (H0 := E1_cvg x). assert (H := E1_cvg y). assert (H1 := E1_cvg (x + y)). eapply UL_sequence. - apply H1. - assert (H2 := CV_mult _ _ _ _ H0 H). assert (H3 := CV_minus _ _ _ _ H2 (Reste_E_cv x y)). unfold Un_cv; unfold Un_cv in H3; intros. elim (H3 _ H4); intros. exists (S x0); intros. rewrite <- (exp_form x y n). + rewrite Rminus_0_r in H5. apply H5. unfold ge; apply Nat.le_trans with (S x0). * apply Nat.le_succ_diag_r. * apply H6. + apply Nat.lt_le_trans with (S x0). * apply Nat.lt_0_succ. * apply H6. Qed. (**********) Lemma exp_pos_pos : forall x:R, 0 < x -> 0 < exp x. Proof. intros; set (An := fun N:nat => / INR (fact N) * x ^ N). cut (Un_cv (fun n:nat => sum_f_R0 An n) (exp x)). - intro; apply Rlt_le_trans with (sum_f_R0 An 0). + unfold An; simpl; rewrite Rinv_1; rewrite Rmult_1_r; apply Rlt_0_1. + apply sum_incr. * assumption. * intro; unfold An; left; apply Rmult_lt_0_compat. -- apply Rinv_0_lt_compat; apply INR_fact_lt_0. -- apply (pow_lt _ n H). - unfold exp; unfold projT1; case (exist_exp x); intro. unfold exp_in; unfold infinite_sum, Un_cv; trivial. Qed. (**********) Lemma exp_pos : forall x:R, 0 < exp x. Proof. intro; destruct (total_order_T 0 x) as [[Hlt|<-]|Hgt]. - apply (exp_pos_pos _ Hlt). - rewrite exp_0; apply Rlt_0_1. - replace (exp x) with (1 / exp (- x)). + unfold Rdiv; apply Rmult_lt_0_compat. * apply Rlt_0_1. * apply Rinv_0_lt_compat; apply exp_pos_pos. apply (Ropp_0_gt_lt_contravar _ Hgt). + cut (exp (- x) <> 0). * intro; unfold Rdiv; apply Rmult_eq_reg_l with (exp (- x)). -- rewrite Rmult_1_l; rewrite Rinv_r. ++ rewrite <- exp_plus. rewrite Rplus_opp_l; rewrite exp_0; reflexivity. ++ apply H. -- apply H. * assert (H := exp_plus x (- x)). rewrite Rplus_opp_r in H; rewrite exp_0 in H. red; intro; rewrite H0 in H. rewrite Rmult_0_r in H. elim R1_neq_R0; assumption. Qed. (* ((exp h)-1)/h -> 0 quand h->0 *) Lemma derivable_pt_lim_exp_0 : derivable_pt_lim exp 0 1. Proof. unfold derivable_pt_lim; intros. set (fn := fun (N:nat) (x:R) => x ^ N / INR (fact (S N))). cut (CVN_R fn). - intro; assert (cv:forall x:R, { l:R | Un_cv (fun N:nat => SP fn N x) l }) by apply (CVN_R_CVS _ X). assert (forall n:nat, continuity (fn n)). { intro; unfold fn. replace (fun x:R => x ^ n / INR (fact (S n))) with (pow_fct n / fct_cte (INR (fact (S n))))%F; [ idtac | reflexivity ]. apply continuity_div. - apply derivable_continuous; apply (derivable_pow n). - apply derivable_continuous; apply derivable_const. - intro; unfold fct_cte; apply INR_fact_neq_0. } assert (continuity (SFL fn cv)) by (apply SFL_continuity; assumption). unfold continuity in H1. assert (H2 := H1 0). unfold continuity_pt in H2; unfold continue_in in H2; unfold limit1_in in H2; unfold limit_in in H2; simpl in H2; unfold Rdist in H2. elim (H2 _ H); intros alp H3. elim H3; intros. exists (mkposreal _ H4); intros. rewrite Rplus_0_l; rewrite exp_0. replace ((exp h - 1) / h) with (SFL fn cv h). + replace 1 with (SFL fn cv 0). { apply H5. split. - unfold D_x, no_cond; split. + trivial. + apply (not_eq_sym H6). - rewrite Rminus_0_r; apply H7. } unfold SFL. case (cv 0) as (x,Hu). eapply UL_sequence. { apply Hu. } unfold Un_cv, SP in |- *. intros; exists 1%nat; intros. unfold Rdist; rewrite decomp_sum. 2:lia. rewrite Rplus_comm. replace (fn 0%nat 0) with 1. 2:{ unfold fn; simpl. unfold Rdiv; rewrite Rinv_1; rewrite Rmult_1_r; reflexivity. } unfold Rminus; rewrite Rplus_assoc; rewrite Rplus_opp_r; rewrite Rplus_0_r. replace (sum_f_R0 (fun i:nat => fn (S i) 0) (pred n)) with 0. { rewrite Rabs_R0; apply H8. } symmetry ; apply sum_eq_R0; intros. unfold fn. simpl. unfold Rdiv; do 2 rewrite Rmult_0_l; reflexivity. + unfold SFL, exp. case (cv h) as (x0,Hu); case (exist_exp h) as (x,Hexp); simpl. eapply UL_sequence. { apply Hu. } unfold Un_cv; intros. unfold exp_in, infinite_sum in Hexp. assert (0 < eps0 * Rabs h). { apply Rmult_lt_0_compat. - apply H8. - apply Rabs_pos_lt; assumption. } elim (Hexp _ H9); intros N0 H10. exists N0; intros. unfold Rdist. apply Rmult_lt_reg_l with (Rabs h). { apply Rabs_pos_lt; assumption. } rewrite <- Rabs_mult. rewrite Rmult_minus_distr_l. replace (h * ((x - 1) / h)) with (x - 1). 2:{ field. assumption. } unfold Rdist in H10. replace (h * SP fn n h - (x - 1)) with (sum_f_R0 (fun i:nat => / INR (fact i) * h ^ i) (S n) - x). { rewrite (Rmult_comm (Rabs h)). apply H10. unfold ge. apply Nat.le_trans with (S N0). - apply Nat.le_succ_diag_r. - apply -> Nat.succ_le_mono; apply H11. } rewrite decomp_sum. 2:apply Nat.lt_0_succ. replace (/ INR (fact 0) * h ^ 0) with 1. 2:simpl; rewrite Rinv_1; rewrite Rmult_1_r; reflexivity. unfold Rminus. rewrite Ropp_plus_distr. rewrite Ropp_involutive. rewrite <- (Rplus_comm (- x)). rewrite <- (Rplus_comm (- x + 1)). rewrite Rplus_assoc; repeat apply Rplus_eq_compat_l. replace (pred (S n)) with n; [ idtac | reflexivity ]. unfold SP. rewrite scal_sum. apply sum_eq; intros. unfold fn. replace (h ^ S i) with (h * h ^ i) by (simpl;ring). unfold Rdiv; ring. - assert (H0 := Alembert_exp). unfold CVN_R. intro; unfold CVN_r. exists (fun N:nat => r ^ N / INR (fact (S N))). cut { l:R | Un_cv (fun n:nat => sum_f_R0 (fun k:nat => Rabs (r ^ k / INR (fact (S k)))) n) l }. { intros (x,p). exists x; intros. split. { assumption. } unfold Boule; intros. rewrite Rminus_0_r in H1. unfold fn. unfold Rdiv; rewrite Rabs_mult. assert (0 < INR (fact (S n))). { apply INR_fact_lt_0. } rewrite (Rabs_right (/ INR (fact (S n)))). 2:{ apply Rle_ge; left; apply Rinv_0_lt_compat; apply H2. } do 2 rewrite <- (Rmult_comm (/ INR (fact (S n)))). apply Rmult_le_compat_l. { left; apply Rinv_0_lt_compat; apply H2. } rewrite <- RPow_abs. apply pow_maj_Rabs. rewrite Rabs_Rabsolu; left; apply H1. } assert ((r:R) <> 0). { assert (H1 := cond_pos r); red; intro; rewrite H2 in H1; elim (Rlt_irrefl _ H1). } apply Alembert_C2. { intro; apply Rabs_no_R0. unfold Rdiv; apply prod_neq_R0. { apply pow_nonzero; assumption. } apply Rinv_neq_0_compat; apply INR_fact_neq_0. } unfold Un_cv in H0. unfold Un_cv; intros. cut (0 < eps0 / r); [ intro | unfold Rdiv; apply Rmult_lt_0_compat; [ assumption | apply Rinv_0_lt_compat; apply (cond_pos r) ] ]. elim (H0 _ H3); intros N0 H4. exists N0; intros. assert (hyp_sn:(S n >= N0)%nat) by lia. assert (H6 := H4 _ hyp_sn). unfold Rdist in H6; rewrite Rminus_0_r in H6. rewrite Rabs_Rabsolu in H6. unfold Rdist; rewrite Rminus_0_r. rewrite Rabs_Rabsolu. replace (Rabs (r ^ S n / INR (fact (S (S n)))) / Rabs (r ^ n / INR (fact (S n)))) with (r * / INR (fact (S (S n))) * / / INR (fact (S n))). { rewrite Rmult_assoc; rewrite Rabs_mult. rewrite (Rabs_right r). 2:{ apply Rle_ge; left; apply (cond_pos r). } apply Rmult_lt_reg_l with (/ r). { apply Rinv_0_lt_compat; apply (cond_pos r). } rewrite <- Rmult_assoc; rewrite Rinv_l. 2:assumption. rewrite Rmult_1_l; rewrite <- (Rmult_comm eps0). apply H6. } unfold Rdiv. repeat rewrite Rabs_mult. repeat rewrite Rabs_inv. rewrite Rinv_mult. repeat rewrite Rabs_right. 2,4:match goal with |- context[fact ?x] => pose proof (INR_fact_lt_0 x) end;lra. 2,3:apply Rle_ge; left; apply pow_lt; apply (cond_pos r). rewrite Rinv_inv. rewrite (Rmult_comm r). rewrite (Rmult_comm (r ^ S n)). repeat rewrite Rmult_assoc. apply Rmult_eq_compat_l. rewrite (Rmult_comm r). rewrite <- Rmult_assoc; rewrite <- (Rmult_comm (INR (fact (S n)))). apply Rmult_eq_compat_l. simpl. rewrite Rmult_assoc; rewrite Rinv_r. 2:{ apply pow_nonzero; assumption. } ring. Qed. (**********) Lemma derivable_pt_lim_exp : forall x:R, derivable_pt_lim exp x (exp x). Proof. intro; assert (H0 := derivable_pt_lim_exp_0). unfold derivable_pt_lim in H0; unfold derivable_pt_lim; intros. cut (0 < eps / exp x); [ intro | unfold Rdiv; apply Rmult_lt_0_compat; [ apply H | apply Rinv_0_lt_compat; apply exp_pos ] ]. elim (H0 _ H1); intros del H2. exists del; intros. assert (H5 := H2 _ H3 H4). rewrite Rplus_0_l in H5; rewrite exp_0 in H5. replace ((exp (x + h) - exp x) / h - exp x) with (exp x * ((exp h - 1) / h - 1)). - rewrite Rabs_mult; rewrite (Rabs_right (exp x)). + apply Rmult_lt_reg_l with (/ exp x). * apply Rinv_0_lt_compat; apply exp_pos. * rewrite <- Rmult_assoc; rewrite Rinv_l. -- rewrite Rmult_1_l; rewrite <- (Rmult_comm eps). apply H5. -- assert (H6 := exp_pos x); red; intro; rewrite H7 in H6; elim (Rlt_irrefl _ H6). + apply Rle_ge; left; apply exp_pos. - rewrite Rmult_minus_distr_l. rewrite Rmult_1_r; unfold Rdiv; rewrite <- Rmult_assoc; rewrite Rmult_minus_distr_l. rewrite Rmult_1_r; rewrite exp_plus; reflexivity. Qed. coq-8.20.0/theories/Reals/Integration.v000066400000000000000000000013671466560755400177560ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* R) (a b:R) (pr1:forall c:R, a < c < b -> derivable_pt f c) (pr2:forall c:R, a < c < b -> derivable_pt g c), a < b -> (forall c:R, a <= c <= b -> continuity_pt f c) -> (forall c:R, a <= c <= b -> continuity_pt g c) -> exists c : R, (exists P : a < c < b, (g b - g a) * derive_pt f c (pr1 c P) = (f b - f a) * derive_pt g c (pr2 c P)). Proof. intros; assert (H2 := Rlt_le _ _ H). set (h := fun y:R => (g b - g a) * f y - (f b - f a) * g y). assert (X:forall c:R, a < c < b -> derivable_pt h c). { intros; change (derivable_pt ((fct_cte (g b - g a) * f)%F - (fct_cte (f b - f a) * g)%F) c). apply derivable_pt_minus; apply derivable_pt_mult. - apply derivable_pt_const. - apply (pr1 _ H3). - apply derivable_pt_const. - apply (pr2 _ H3). } assert (forall c:R, a <= c <= b -> continuity_pt h c). { intros; unfold h; change (continuity_pt ((fct_cte (g b - g a) * f)%F - (fct_cte (f b - f a) * g)%F) c). apply continuity_pt_minus; apply continuity_pt_mult. - apply derivable_continuous_pt; apply derivable_const. - apply H0; apply H3. - apply derivable_continuous_pt; apply derivable_const. - apply H1; apply H3. } assert (H4 := continuity_ab_maj h a b H2 H3). assert (H5 := continuity_ab_min h a b H2 H3). elim H4; intros Mx H6. elim H5; intros mx H7. assert (h a = h b) by (unfold h;ring). set (M := h Mx); set (m := h mx). assert (forall (c:R) (P:a < c < b), derive_pt h c (X c P) = (g b - g a) * derive_pt f c (pr1 c P) - (f b - f a) * derive_pt g c (pr2 c P)). { intros; unfold h; replace (derive_pt (fun y:R => (g b - g a) * f y - (f b - f a) * g y) c (X c P)) with (derive_pt ((fct_cte (g b - g a) * f)%F - (fct_cte (f b - f a) * g)%F) c (derivable_pt_minus _ _ _ (derivable_pt_mult _ _ _ (derivable_pt_const (g b - g a) c) (pr1 c P)) (derivable_pt_mult _ _ _ (derivable_pt_const (f b - f a) c) (pr2 c P)))); [ idtac | apply pr_nu ]. rewrite derive_pt_minus; do 2 rewrite derive_pt_mult; do 2 rewrite derive_pt_const; do 2 rewrite Rmult_0_l; do 2 rewrite Rplus_0_l; reflexivity. } case (Req_dec (h a) M); intro. 1:case (Req_dec (h a) m); intro. - (*** h constant ***) assert (forall c:R, a <= c <= b -> h c = M). { intros; elim H6; intros H13 _. elim H7; intros H14 _. apply Rle_antisym. - apply H13; apply H12. - rewrite H10 in H11; rewrite H11; apply H14; apply H12. } assert (a < (a + b) / 2 < b). { split. - apply Rmult_lt_reg_l with 2. + prove_sup0. + unfold Rdiv; rewrite <- (Rmult_comm (/ 2)); rewrite <- Rmult_assoc; rewrite Rinv_r. * rewrite Rmult_1_l; rewrite <-Rplus_diag; apply Rplus_lt_compat_l; apply H. * discrR. - apply Rmult_lt_reg_l with 2. + prove_sup0. + unfold Rdiv; rewrite <- (Rmult_comm (/ 2)); rewrite <- Rmult_assoc; rewrite Rinv_r. * rewrite Rmult_1_l; rewrite Rplus_comm; rewrite <-Rplus_diag; apply Rplus_lt_compat_l; apply H. * discrR. } exists ((a + b) / 2). exists H13. apply Rminus_diag_uniq; rewrite <- H9; apply deriv_constant2 with a b. + elim H13; intros; assumption. + elim H13; intros; assumption. + intros; rewrite (H12 ((a + b) / 2)). * apply H12; split; left; assumption. * elim H13; intros; split; left; assumption. - (*** h admet un minimum global sur [a,b] ***) assert (a < mx < b). { elim H7; intros _ H12; elim H12; intros; split. - inversion H13. + apply H15. + rewrite H15 in H11; elim H11; reflexivity. - inversion H14. + apply H15. + rewrite H8 in H11; rewrite <- H15 in H11; elim H11; reflexivity. } exists mx. exists H12. apply Rminus_diag_uniq; rewrite <- H9; apply deriv_minimum with a b. + elim H12; intros; assumption. + elim H12; intros; assumption. + intros; elim H7; intros. apply H15; split; left; assumption. - (*** h admet un maximum global sur [a,b] ***) assert (a < Mx < b). { elim H6; intros _ H11; elim H11; intros; split. - inversion H12. + apply H14. + rewrite H14 in H10; elim H10; reflexivity. - inversion H13. + apply H14. + rewrite H8 in H10; rewrite <- H14 in H10; elim H10; reflexivity. } exists Mx. exists H11. apply Rminus_diag_uniq; rewrite <- H9; apply deriv_maximum with a b. + elim H11; intros; assumption. + elim H11; intros; assumption. + intros; elim H6; intros; apply H14. split; left; assumption. Qed. (* Corollaries ... *) Lemma MVT_cor1 : forall (f:R -> R) (a b:R) (pr:derivable f), a < b -> exists c : R, f b - f a = derive_pt f c (pr c) * (b - a) /\ a < c < b. Proof. intros f a b pr H; cut (forall c:R, a < c < b -> derivable_pt f c); [ intro X | intros; apply pr ]. cut (forall c:R, a < c < b -> derivable_pt id c); [ intro X0 | intros; apply derivable_pt_id ]. cut (forall c:R, a <= c <= b -> continuity_pt f c); [ intro | intros; apply derivable_continuous_pt; apply pr ]. cut (forall c:R, a <= c <= b -> continuity_pt id c); [ intro | intros; apply derivable_continuous_pt; apply derivable_id ]. assert (H2 := MVT f id a b X X0 H H0 H1). destruct H2 as (c & P & H4). exists c; split. - cut (derive_pt id c (X0 c P) = derive_pt id c (derivable_pt_id c)); [ intro H5 | apply pr_nu ]. rewrite H5 in H4; rewrite (derive_pt_id c) in H4; rewrite Rmult_1_r in H4; rewrite <- H4; replace (derive_pt f c (X c P)) with (derive_pt f c (pr c)); [ idtac | apply pr_nu ]; apply Rmult_comm. - apply P. Qed. Theorem MVT_cor2 : forall (f f':R -> R) (a b:R), a < b -> (forall c:R, a <= c <= b -> derivable_pt_lim f c (f' c)) -> exists c : R, f b - f a = f' c * (b - a) /\ a < c < b. Proof. intros f f' a b H H0; cut (forall c:R, a <= c <= b -> derivable_pt f c). 1:intro X; cut (forall c:R, a < c < b -> derivable_pt f c). 1:intro X0; cut (forall c:R, a <= c <= b -> continuity_pt f c). 1:intro; cut (forall c:R, a <= c <= b -> derivable_pt id c). 1:intro X1; cut (forall c:R, a < c < b -> derivable_pt id c). 1:intro X2; cut (forall c:R, a <= c <= b -> continuity_pt id c). - intro; elim (MVT f id a b X0 X2 H H1 H2); intros x (P,H3). exists x; split. + cut (derive_pt id x (X2 x P) = 1). 1:cut (derive_pt f x (X0 x P) = f' x). * intros; rewrite H4 in H3; rewrite H5 in H3; unfold id in H3; rewrite Rmult_1_r in H3; rewrite Rmult_comm; symmetry ; assumption. * apply derive_pt_eq_0; apply H0; elim P; intros; split; left; assumption. * apply derive_pt_eq_0; apply derivable_pt_lim_id. + assumption. - intros; apply derivable_continuous_pt; apply X1; assumption. - intros; apply derivable_pt_id. - intros; apply derivable_pt_id. - intros; apply derivable_continuous_pt; apply X; assumption. - intros; elim H1; intros; apply X; split; left; assumption. - intros; unfold derivable_pt; exists (f' c); apply H0; apply H1. Qed. Lemma MVT_cor3 : forall (f f':R -> R) (a b:R), a < b -> (forall x:R, a <= x -> x <= b -> derivable_pt_lim f x (f' x)) -> exists c : R, a <= c /\ c <= b /\ f b = f a + f' c * (b - a). Proof. intros f f' a b H H0; assert (H1 : exists c : R, f b - f a = f' c * (b - a) /\ a < c < b); [ apply MVT_cor2; [ apply H | intros; elim H1; intros; apply (H0 _ H2 H3) ] | elim H1; intros; exists x; elim H2; intros; elim H4; intros; split; [ left; assumption | split; [ left; assumption | rewrite <- H3; ring ] ] ]. Qed. Lemma Rolle : forall (f:R -> R) (a b:R) (pr:forall x:R, a < x < b -> derivable_pt f x), (forall x:R, a <= x <= b -> continuity_pt f x) -> a < b -> f a = f b -> exists c : R, (exists P : a < c < b, derive_pt f c (pr c P) = 0). Proof. intros; assert (H2 : forall x:R, a < x < b -> derivable_pt id x). - intros; apply derivable_pt_id. - assert (H3 := MVT f id a b pr H2 H0 H); assert (H4 : forall x:R, a <= x <= b -> continuity_pt id x). + intros; apply derivable_continuous; apply derivable_id. + destruct (H3 H4) as (c & P & H6). exists c; exists P; rewrite H1 in H6. unfold id in H6; unfold Rminus in H6; rewrite Rplus_opp_r in H6. rewrite Rmult_0_l in H6; apply Rmult_eq_reg_l with (b - a); [ rewrite Rmult_0_r; apply H6 | apply Rminus_eq_contra; red; intro H7; rewrite H7 in H0; elim (Rlt_irrefl _ H0) ]. Qed. (**********) Lemma nonneg_derivative_1 : forall (f:R -> R) (pr:derivable f), (forall x:R, 0 <= derive_pt f x (pr x)) -> increasing f. Proof. intros. unfold increasing. intros. destruct (total_order_T x y) as [[H1| ->]|H1]. - apply Rplus_le_reg_l with (- f x). rewrite Rplus_opp_l; rewrite Rplus_comm. pose proof (MVT_cor1 f _ _ pr H1) as (c & H3 & H4). unfold Rminus in H3. rewrite H3. apply Rmult_le_pos. + apply H. + apply Rplus_le_reg_l with x. rewrite Rplus_0_r; replace (x + (y + - x)) with y; [ assumption | ring ]. - right; reflexivity. - elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H0 H1)). Qed. (**********) Lemma nonpos_derivative_0 : forall (f:R -> R) (pr:derivable f), decreasing f -> forall x:R, derive_pt f x (pr x) <= 0. Proof. intros f pr H x; assert (H0 := H); unfold decreasing in H0; generalize (derivable_derive f x (pr x)); intro; elim H1; intros l H2. rewrite H2; case (Rtotal_order l 0); intro. { left; assumption. } elim H3; intro. { right; assumption. } generalize (derive_pt_eq_1 f x l (pr x) H2); intros; assert (0 < l / 2). { unfold Rdiv; apply Rmult_lt_0_compat; [ apply H4 | apply Rinv_0_lt_compat; prove_sup0 ]. } elim (H5 (l / 2) H6); intros delta H7; assert (delta / 2 <> 0 /\ 0 < delta / 2 /\ Rabs (delta / 2) < delta). { split;[|split]. - unfold Rdiv; apply prod_neq_R0. + generalize (cond_pos delta); intro; red; intro H9; rewrite H9 in H8; elim (Rlt_irrefl 0 H8). + apply Rinv_neq_0_compat; discrR. - unfold Rdiv; destruct delta;simpl; lra. - rewrite Rabs_right. + unfold Rdiv; apply Rmult_lt_reg_l with 2. { prove_sup0. } rewrite <- (Rmult_comm (/ 2)); rewrite <- Rmult_assoc; rewrite Rinv_r. 2:{ discrR. } rewrite Rmult_1_l; rewrite <-Rplus_diag; pattern (pos delta) at 1; rewrite <- Rplus_0_r. apply Rplus_lt_compat_l; apply (cond_pos delta). + apply Rle_ge; unfold Rdiv; left; apply Rmult_lt_0_compat. * apply (cond_pos delta). * apply Rinv_0_lt_compat; prove_sup0. } decompose [and] H8; intros; generalize (H7 (delta / 2) H9 H12); assert ((f (x + delta / 2) - f x) / (delta / 2) <= 0). { replace ((f (x + delta / 2) - f x) / (delta / 2)) with (- ((f x - f (x + delta / 2)) / (delta / 2))). - rewrite <- Ropp_0. apply Ropp_ge_le_contravar. apply Rle_ge. unfold Rdiv; apply Rmult_le_pos. + cut (x <= x + delta * / 2). * intro; generalize (H0 x (x + delta * / 2) H10); intro. generalize (Rplus_le_compat_l (- f (x + delta / 2)) (f (x + delta / 2)) (f x) H13); rewrite Rplus_opp_l; rewrite Rplus_comm; intro; assumption. * pattern x at 1; rewrite <- (Rplus_0_r x); apply Rplus_le_compat_l; left; assumption. + left; apply Rinv_0_lt_compat; assumption. - unfold Rdiv; rewrite <- Ropp_mult_distr_l_reverse. rewrite Ropp_minus_distr. reflexivity. } assert (0 < - ((f (x + delta / 2) - f x) / (delta / 2) - l)) by lra. unfold Rabs; case (Rcase_abs ((f (x + delta / 2) - f x) / (delta / 2) - l)) as [Hlt|Hge]; lra. Qed. (**********) Lemma increasing_decreasing_opp : forall f:R -> R, increasing f -> decreasing (- f)%F. Proof. unfold increasing, decreasing, opp_fct; intros; generalize (H x y H0); intro; apply Ropp_ge_le_contravar; apply Rle_ge; assumption. Qed. (**********) Lemma nonpos_derivative_1 : forall (f:R -> R) (pr:derivable f), (forall x:R, derive_pt f x (pr x) <= 0) -> decreasing f. Proof. intros. assert (forall h:R, - - f h = f h) by (intros;ring). generalize (increasing_decreasing_opp (- f)%F). unfold decreasing. unfold opp_fct. intros. rewrite <- (H0 x); rewrite <- (H0 y). apply H1. 2:{ assumption. } assert (forall x:R, 0 <= derive_pt (- f) x (derivable_opp f pr x)). { intro. assert (H3 := derive_pt_opp f x0 (pr x0)). assert (derive_pt (- f) x0 (derivable_pt_opp f x0 (pr x0)) = derive_pt (- f) x0 (derivable_opp f pr x0)) by apply pr_nu. rewrite <- H4. rewrite H3. rewrite <- Ropp_0; apply Ropp_ge_le_contravar; apply Rle_ge; apply (H x0). } replace (fun x:R => - f x) with (- f)%F; [ idtac | reflexivity ]. apply (nonneg_derivative_1 (- f)%F (derivable_opp f pr) H3). Qed. (**********) Lemma positive_derivative : forall (f:R -> R) (pr:derivable f), (forall x:R, 0 < derive_pt f x (pr x)) -> strict_increasing f. Proof. intros. unfold strict_increasing. intros. apply Rplus_lt_reg_l with (- f x). rewrite Rplus_opp_l; rewrite Rplus_comm. assert (H1 := MVT_cor1 f _ _ pr H0). elim H1; intros. elim H2; intros. unfold Rminus in H3. rewrite H3. apply Rmult_lt_0_compat. - apply H. - apply Rplus_lt_reg_l with x. rewrite Rplus_0_r; replace (x + (y + - x)) with y; [ assumption | ring ]. Qed. (**********) Lemma strictincreasing_strictdecreasing_opp : forall f:R -> R, strict_increasing f -> strict_decreasing (- f)%F. Proof. unfold strict_increasing, strict_decreasing, opp_fct; intros; generalize (H x y H0); intro; apply Ropp_lt_gt_contravar; assumption. Qed. (**********) Lemma negative_derivative : forall (f:R -> R) (pr:derivable f), (forall x:R, derive_pt f x (pr x) < 0) -> strict_decreasing f. Proof. intros. assert (forall h:R, - - f h = f h) by (intros;ring). generalize (strictincreasing_strictdecreasing_opp (- f)%F). unfold strict_decreasing, opp_fct. intros. rewrite <- (H0 x). rewrite <- (H0 y). apply H1; [ idtac | assumption ]. cut (forall x:R, 0 < derive_pt (- f) x (derivable_opp f pr x)). { intros; eapply positive_derivative; apply H3. } intro. assert (H3 := derive_pt_opp f x0 (pr x0)). assert (derive_pt (- f) x0 (derivable_pt_opp f x0 (pr x0)) = derive_pt (- f) x0 (derivable_opp f pr x0)) by apply pr_nu. rewrite <- H4; rewrite H3. rewrite <- Ropp_0; apply Ropp_lt_gt_contravar; apply (H x0). Qed. (**********) Lemma null_derivative_0 : forall (f:R -> R) (pr:derivable f), constant f -> forall x:R, derive_pt f x (pr x) = 0. Proof. intros. unfold constant in H. apply derive_pt_eq_0. intros; exists (mkposreal 1 Rlt_0_1); simpl; intros. rewrite (H x (x + h)); unfold Rminus; unfold Rdiv; rewrite Rplus_opp_r; rewrite Rmult_0_l; rewrite Rplus_opp_r; rewrite Rabs_R0; assumption. Qed. (**********) Lemma increasing_decreasing : forall f:R -> R, increasing f -> decreasing f -> constant f. Proof. unfold increasing, decreasing, constant; intros; case (Rtotal_order x y); intro. - generalize (Rlt_le x y H1); intro; apply (Rle_antisym (f x) (f y) (H x y H2) (H0 x y H2)). - elim H1; intro. + rewrite H2; reflexivity. + generalize (Rlt_le y x H2); intro; symmetry ; apply (Rle_antisym (f y) (f x) (H y x H3) (H0 y x H3)). Qed. (**********) Lemma null_derivative_1 : forall (f:R -> R) (pr:derivable f), (forall x:R, derive_pt f x (pr x) = 0) -> constant f. Proof. intros. cut (forall x:R, derive_pt f x (pr x) <= 0). - cut (forall x:R, 0 <= derive_pt f x (pr x)). + intros. assert (H2 := nonneg_derivative_1 f pr H0). assert (H3 := nonpos_derivative_1 f pr H1). apply increasing_decreasing; assumption. + intro; right; symmetry ; apply (H x). - intro; right; apply (H x). Qed. (**********) Lemma derive_increasing_interv_ax : forall (a b:R) (f:R -> R) (pr:derivable f), a < b -> ((forall t:R, a < t < b -> 0 < derive_pt f t (pr t)) -> forall x y:R, a <= x <= b -> a <= y <= b -> x < y -> f x < f y) /\ ((forall t:R, a < t < b -> 0 <= derive_pt f t (pr t)) -> forall x y:R, a <= x <= b -> a <= y <= b -> x < y -> f x <= f y). Proof. intros. split; intros. - apply Rplus_lt_reg_l with (- f x). rewrite Rplus_opp_l; rewrite Rplus_comm. assert (H4 := MVT_cor1 f _ _ pr H3). elim H4; intros. elim H5; intros. unfold Rminus in H6. rewrite H6. apply Rmult_lt_0_compat. 2:{ lra. } apply H0. lra. - apply Rplus_le_reg_l with (- f x). rewrite Rplus_opp_l; rewrite Rplus_comm. assert (H4 := MVT_cor1 f _ _ pr H3). elim H4; intros. elim H5; intros. unfold Rminus in H6. rewrite H6. apply Rmult_le_pos. 2:{ lra. } apply H0. lra. Qed. (**********) Lemma derive_increasing_interv : forall (a b:R) (f:R -> R) (pr:derivable f), a < b -> (forall t:R, a < t < b -> 0 < derive_pt f t (pr t)) -> forall x y:R, a <= x <= b -> a <= y <= b -> x < y -> f x < f y. Proof. intros. generalize (derive_increasing_interv_ax a b f pr H); intro. elim H4; intros H5 _; apply (H5 H0 x y H1 H2 H3). Qed. (**********) Lemma derive_increasing_interv_var : forall (a b:R) (f:R -> R) (pr:derivable f), a < b -> (forall t:R, a < t < b -> 0 <= derive_pt f t (pr t)) -> forall x y:R, a <= x <= b -> a <= y <= b -> x < y -> f x <= f y. Proof. intros a b f pr H H0 x y H1 H2 H3; generalize (derive_increasing_interv_ax a b f pr H); intro; elim H4; intros _ H5; apply (H5 H0 x y H1 H2 H3). Qed. (**********) (**********) Theorem IAF : forall (f:R -> R) (a b k:R) (pr:derivable f), a <= b -> (forall c:R, a <= c <= b -> derive_pt f c (pr c) <= k) -> f b - f a <= k * (b - a). Proof. intros. destruct (total_order_T a b) as [[H1| -> ]|H1]. - pose proof (MVT_cor1 f _ _ pr H1) as (c & -> & H4). do 2 rewrite <- (Rmult_comm (b - a)). apply Rmult_le_compat_l. + apply Rplus_le_reg_l with a; rewrite Rplus_0_r. replace (a + (b - a)) with b; [ assumption | ring ]. + apply H0. elim H4; intros. split; left; assumption. - unfold Rminus; do 2 rewrite Rplus_opp_r. rewrite Rmult_0_r; right; reflexivity. - elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H H1)). Qed. Lemma IAF_var : forall (f g:R -> R) (a b:R) (pr1:derivable f) (pr2:derivable g), a <= b -> (forall c:R, a <= c <= b -> derive_pt g c (pr2 c) <= derive_pt f c (pr1 c)) -> g b - g a <= f b - f a. Proof. intros. assert (X:derivable (g - f)) by (apply derivable_minus; assumption). assert (forall c:R, a <= c <= b -> derive_pt (g - f) c (X c) <= 0). { intros. assert (derive_pt (g - f) c (X c) = derive_pt (g - f) c (derivable_pt_minus _ _ _ (pr2 c) (pr1 c))) by apply pr_nu. rewrite H2. rewrite derive_pt_minus. apply Rplus_le_reg_l with (derive_pt f c (pr1 c)). rewrite Rplus_0_r. replace (derive_pt f c (pr1 c) + (derive_pt g c (pr2 c) - derive_pt f c (pr1 c))) with (derive_pt g c (pr2 c)); [ idtac | ring ]. apply H0; assumption. } assert (H2 := IAF (g - f)%F a b 0 X H H1). unfold minus_fct in H2. lra. Qed. (* If f has a null derivative in ]a,b[ and is continue in [a,b], *) (* then f is constant on [a,b] *) Lemma null_derivative_loc : forall (f:R -> R) (a b:R) (pr:forall x:R, a < x < b -> derivable_pt f x), (forall x:R, a <= x <= b -> continuity_pt f x) -> (forall (x:R) (P:a < x < b), derive_pt f x (pr x P) = 0) -> constant_D_eq f (fun x:R => a <= x <= b) (f a). Proof. intros; unfold constant_D_eq; intros; destruct (total_order_T a b) as [[Hlt|Heq]|Hgt]. - assert (H2 : forall y:R, a < y < x -> derivable_pt id y). { intros; apply derivable_pt_id. } assert (H3 : forall y:R, a <= y <= x -> continuity_pt id y). { intros; apply derivable_continuous; apply derivable_id. } assert (H4 : forall y:R, a < y < x -> derivable_pt f y). { intros; apply pr; elim H4; intros; split. - assumption. - elim H1; intros; apply Rlt_le_trans with x; assumption. } assert (H5 : forall y:R, a <= y <= x -> continuity_pt f y). { intros; apply H; elim H5; intros; split. - assumption. - elim H1; intros; apply Rle_trans with x; assumption. } elim H1; clear H1; intros; elim H1; clear H1; intro. + assert (H7 := MVT f id a x H4 H2 H1 H5 H3). destruct H7 as (c & P & H9). assert (H10 : a < c < b). { split. - apply P. - apply Rlt_le_trans with x; [apply P|assumption]. } assert (H11 : derive_pt f c (H4 c P) = 0). { replace (derive_pt f c (H4 c P)) with (derive_pt f c (pr c H10)); [ apply H0 | apply pr_nu ]. } assert (H12 : derive_pt id c (H2 c P) = 1). { apply derive_pt_eq_0; apply derivable_pt_lim_id. } rewrite H11 in H9; rewrite H12 in H9; rewrite Rmult_0_r in H9; rewrite Rmult_1_r in H9; apply Rminus_diag_uniq; symmetry ; assumption. + rewrite H1; reflexivity. - assert (H2 : x = a). { rewrite <- Heq in H1; elim H1; intros; apply Rle_antisym; assumption. } rewrite H2; reflexivity. - elim H1; intros; elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ (Rle_trans _ _ _ H2 H3) Hgt)). Qed. (* Unicity of the antiderivative *) Lemma antiderivative_Ucte : forall (f g1 g2:R -> R) (a b:R), antiderivative f g1 a b -> antiderivative f g2 a b -> exists c : R, (forall x:R, a <= x <= b -> g1 x = g2 x + c). Proof. unfold antiderivative; intros; elim H; clear H; intros; elim H0; clear H0; intros H0 _; exists (g1 a - g2 a); intros; assert (H3 : forall x:R, a <= x <= b -> derivable_pt g1 x). { intros; unfold derivable_pt; exists (f x0); elim (H x0 H3); intros; eapply derive_pt_eq_1; symmetry ; apply H4. } assert (H4 : forall x:R, a <= x <= b -> derivable_pt g2 x). { intros; unfold derivable_pt; exists (f x0); elim (H0 x0 H4); intros; eapply derive_pt_eq_1; symmetry ; apply H5. } assert (H5 : forall x:R, a < x < b -> derivable_pt (g1 - g2) x). { intros; elim H5; intros; apply derivable_pt_minus; [ apply H3; split; left; assumption | apply H4; split; left; assumption ]. } assert (H6 : forall x:R, a <= x <= b -> continuity_pt (g1 - g2) x). { intros; apply derivable_continuous_pt; apply derivable_pt_minus; [ apply H3 | apply H4 ]; assumption. } assert (H7 : forall (x:R) (P:a < x < b), derive_pt (g1 - g2) x (H5 x P) = 0). { intros; elim P; intros; apply derive_pt_eq_0; replace 0 with (f x0 - f x0); [ idtac | ring ]. assert (H9 : a <= x0 <= b). { split; left; assumption. } apply derivable_pt_lim_minus; [ elim (H _ H9) | elim (H0 _ H9) ]; intros; eapply derive_pt_eq_1; symmetry ; apply H10. } assert (H8 := null_derivative_loc (g1 - g2)%F a b H5 H6 H7); unfold constant_D_eq in H8; assert (H9 := H8 _ H2); unfold minus_fct in H9; rewrite <- H9; ring. Qed. (* A variant of MVT using absolute values. *) Lemma MVT_abs : forall (f f' : R -> R) (a b : R), (forall c : R, Rmin a b <= c <= Rmax a b -> derivable_pt_lim f c (f' c)) -> exists c : R, Rabs (f b - f a) = Rabs (f' c) * Rabs (b - a) /\ Rmin a b <= c <= Rmax a b. Proof. intros f f' a b. destruct (Rle_dec a b) as [aleb | blta]. - destruct (Req_dec a b) as [ab | anb]. + unfold Rminus; intros _; exists a; split. * now rewrite <- ab, !Rplus_opp_r, Rabs_R0, Rmult_0_r. * split;[apply Rmin_l | apply Rmax_l]. + rewrite Rmax_right, Rmin_left; auto; intros derv. destruct (MVT_cor2 f f' a b) as [c [hc intc]]; [destruct aleb;[assumption | contradiction] | apply derv | ]. exists c; rewrite hc, Rabs_mult;split; [reflexivity | unfold Rle; tauto]. - assert (b < a) by (apply Rnot_le_gt; assumption). assert (b <= a) by (apply Rlt_le; assumption). rewrite Rmax_left, Rmin_right; try assumption; intros derv. destruct (MVT_cor2 f f' b a) as [c [hc intc]]; [assumption | apply derv | ]. exists c; rewrite <- Rabs_Ropp, Ropp_minus_distr, hc, Rabs_mult. split;[now rewrite <- (Rabs_Ropp (b - a)), Ropp_minus_distr| unfold Rle; tauto]. Qed. coq-8.20.0/theories/Reals/Machin.v000066400000000000000000000151671466560755400166750ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* 0 -> -PI/2 < atan u - atan v < PI/2 -> -PI/2 < atan (atan_sub u v) < PI/2 -> atan u = atan v + atan (atan_sub u v). Proof. intros u v pn0 uvint aint. assert (cos (atan u) <> 0). { destruct (atan_bound u); apply Rgt_not_eq, cos_gt_0; auto. rewrite <- Rdiv_opp_l; assumption. } assert (cos (atan v) <> 0). { destruct (atan_bound v); apply Rgt_not_eq, cos_gt_0; auto. rewrite <- Rdiv_opp_l; assumption. } assert (t : forall a b c, a - b = c -> a = b + c) by (intros; subst; field). apply t, tan_inj; clear t; try assumption. rewrite tan_minus; auto. - rewrite !tan_atan; reflexivity. - apply Rgt_not_eq, cos_gt_0; rewrite <- ?Rdiv_opp_l; tauto. - rewrite !tan_atan; assumption. Qed. Lemma tech : forall x y , -1 <= x <= 1 -> -1 < y < 1 -> -PI/2 < atan x - atan y < PI/2. Proof. assert (ut := PI_RGT_0). intros x y [xm1 x1] [ym1 y1]. assert (-(PI/4) <= atan x). { destruct xm1 as [xm1 | xm1]. { rewrite <- atan_1, <- atan_opp; apply Rlt_le, atan_increasing. assumption. } solve[rewrite <- xm1; change (-1) with (-(1)); rewrite atan_opp, atan_1; apply Rle_refl]. } assert (-(PI/4) < atan y). { rewrite <- atan_1, <- atan_opp; apply atan_increasing. assumption. } assert (atan x <= PI/4). { destruct x1 as [x1 | x1]. { rewrite <- atan_1; apply Rlt_le, atan_increasing. assumption. } solve[rewrite x1, atan_1; apply Rle_refl]. } assert (atan y < PI/4). { rewrite <- atan_1; apply atan_increasing. assumption. } rewrite Rdiv_opp_l; split; lra. Qed. (* A simple formula, reasonably efficient. *) Lemma Machin_2_3 : PI/4 = atan(/2) + atan(/3). Proof. assert (utility : 0 < PI/2) by (apply PI2_RGT_0). rewrite <- atan_1. rewrite (atan_sub_correct 1 (/2)). - apply f_equal, f_equal; unfold atan_sub; field. - apply Rgt_not_eq; lra. - apply tech; try split; try lra. - apply atan_bound. Qed. Lemma Machin_4_5_239 : PI/4 = 4 * atan (/5) - atan(/239). Proof. rewrite <- atan_1. rewrite (atan_sub_correct 1 (/5)); [ | apply Rgt_not_eq; lra | apply tech; try split; lra | apply atan_bound ]. replace (4 * atan (/5) - atan (/239)) with (atan (/5) + (atan (/5) + (atan (/5) + (atan (/5) + - atan (/239))))) by ring. apply f_equal. replace (atan_sub 1 (/5)) with (2/3) by (unfold atan_sub; field). rewrite (atan_sub_correct (2/3) (/5)); [apply f_equal | apply Rgt_not_eq; lra | apply tech; try split; lra | apply atan_bound ]. replace (atan_sub (2/3) (/5)) with (7/17) by (unfold atan_sub; field). rewrite (atan_sub_correct (7/17) (/5)); [apply f_equal | apply Rgt_not_eq; lra | apply tech; try split; lra | apply atan_bound ]. replace (atan_sub (7/17) (/5)) with (9/46) by (unfold atan_sub; field). rewrite (atan_sub_correct (9/46) (/5)); [apply f_equal | apply Rgt_not_eq; lra | apply tech; try split; lra | apply atan_bound ]. rewrite <- atan_opp; apply f_equal. unfold atan_sub; field. Qed. Lemma Machin_2_3_7 : PI/4 = 2 * atan(/3) + (atan (/7)). Proof. rewrite <- atan_1. rewrite (atan_sub_correct 1 (/3)); [ | apply Rgt_not_eq; lra | apply tech; try split; lra | apply atan_bound ]. replace (2 * atan (/3) + atan (/7)) with (atan (/3) + (atan (/3) + atan (/7))) by ring. apply f_equal. replace (atan_sub 1 (/3)) with (/2) by (unfold atan_sub; field). rewrite (atan_sub_correct (/2) (/3)); [apply f_equal | apply Rgt_not_eq; lra | apply tech; try split; lra | apply atan_bound ]. apply f_equal; unfold atan_sub; field. Qed. (* More efficient way to compute approximations of PI. *) Definition PI_2_3_7_tg n := 2 * Ratan_seq (/3) n + Ratan_seq (/7) n. Lemma PI_2_3_7_ineq : forall N : nat, sum_f_R0 (tg_alt PI_2_3_7_tg) (S (2 * N)) <= PI / 4 <= sum_f_R0 (tg_alt PI_2_3_7_tg) (2 * N). Proof. assert (dec3 : 0 <= /3 <= 1) by (split; lra). assert (dec7 : 0 <= /7 <= 1) by (split; lra). assert (decr : Un_decreasing PI_2_3_7_tg). { apply Ratan_seq_decreasing in dec3. apply Ratan_seq_decreasing in dec7. intros n; apply Rplus_le_compat. { apply Rmult_le_compat_l; [ lra | exact (dec3 n)]. } exact (dec7 n). } assert (cv : Un_cv PI_2_3_7_tg 0). { apply Ratan_seq_converging in dec3. apply Ratan_seq_converging in dec7. intros eps ep. assert (ep' : 0 < eps /3) by lra. destruct (dec3 _ ep') as [N1 Pn1]; destruct (dec7 _ ep') as [N2 Pn2]. exists (N1 + N2)%nat; intros n Nn. unfold PI_2_3_7_tg. rewrite <- (Rplus_0_l 0). apply Rle_lt_trans with (1 := Rdist_plus (2 * Ratan_seq (/3) n) 0 (Ratan_seq (/7) n) 0). replace eps with (2 * eps/3 + eps/3) by field. apply Rplus_lt_compat. { unfold Rdist, Rminus, Rdiv. rewrite <- (Rmult_0_r 2), <- Ropp_mult_distr_r_reverse. rewrite <- Rmult_plus_distr_l, Rabs_mult, (Rabs_pos_eq 2);[|lra]. rewrite Rmult_assoc; apply Rmult_lt_compat_l;[lra | ]. apply (Pn1 n); lia. } apply (Pn2 n); lia. } rewrite Machin_2_3_7. rewrite !atan_eq_ps_atan; try (split; lra). unfold ps_atan; destruct (in_int (/3)); destruct (in_int (/7)); try match goal with id : ~ _ |- _ => case id; split; lra end. destruct (ps_atan_exists_1 (/3)) as [v3 Pv3]. destruct (ps_atan_exists_1 (/7)) as [v7 Pv7]. assert (main : Un_cv (sum_f_R0 (tg_alt PI_2_3_7_tg)) (2 * v3 + v7)). { assert (main :Un_cv (fun n => 2 * sum_f_R0 (tg_alt (Ratan_seq (/3))) n + sum_f_R0 (tg_alt (Ratan_seq (/7))) n) (2 * v3 + v7)). { apply CV_plus;[ | assumption]. apply CV_mult;[ | assumption]. exists 0%nat; intros; rewrite Rdist_eq; assumption. } apply Un_cv_ext with (2 := main). intros n; rewrite scal_sum, <- plus_sum; apply sum_eq; intros. rewrite Rmult_comm; unfold PI_2_3_7_tg, tg_alt; field. } intros N; apply (alternated_series_ineq _ _ _ decr cv main). Qed. coq-8.20.0/theories/Reals/NewtonInt.v000066400000000000000000000716501466560755400174220ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* R) (a b:R) : Type := { g:R -> R | antiderivative f g a b \/ antiderivative f g b a }. Definition NewtonInt (f:R -> R) (a b:R) (pr:Newton_integrable f a b) : R := let (g,_) := pr in g b - g a. (* If f is differentiable, then f' is Newton integrable (Tautology ?) *) Lemma FTCN_step1 : forall (f:Differential) (a b:R), Newton_integrable (fun x:R => derive_pt f x (cond_diff f x)) a b. Proof. intros f a b; unfold Newton_integrable; exists (d1 f); unfold antiderivative; intros; case (Rle_dec a b); intro; [ left; split; [ intros; exists (cond_diff f x); reflexivity | assumption ] | right; split; [ intros; exists (cond_diff f x); reflexivity | auto with real ] ]. Defined. (* By definition, we have the Fondamental Theorem of Calculus *) Lemma FTC_Newton : forall (f:Differential) (a b:R), NewtonInt (fun x:R => derive_pt f x (cond_diff f x)) a b (FTCN_step1 f a b) = f b - f a. Proof. intros; unfold NewtonInt; reflexivity. Qed. (* $\int_a^a f$ exists forall a:R and f:R->R *) Lemma NewtonInt_P1 : forall (f:R -> R) (a:R), Newton_integrable f a a. Proof. intros f a; unfold Newton_integrable; exists (fct_cte (f a) * id)%F; left; unfold antiderivative; split. 2:right;reflexivity. intros; assert (H1 : derivable_pt (fct_cte (f a) * id) x). { apply derivable_pt_mult. { apply derivable_pt_const. } apply derivable_pt_id. } exists H1; assert (H2 : x = a). { elim H; intros; apply Rle_antisym; assumption. } symmetry ; apply derive_pt_eq_0; replace (f x) with (0 * id x + fct_cte (f a) x * 1); [ apply (derivable_pt_lim_mult (fct_cte (f a)) id x); [ apply derivable_pt_lim_const | apply derivable_pt_lim_id ] | unfold id, fct_cte; rewrite H2; ring ]. Qed. (* $\int_a^a f = 0$ *) Lemma NewtonInt_P2 : forall (f:R -> R) (a:R), NewtonInt f a a (NewtonInt_P1 f a) = 0. Proof. intros; unfold NewtonInt; simpl; unfold mult_fct, fct_cte, id. destruct NewtonInt_P1 as [g _]. now apply Rminus_diag_eq. Qed. (* If $\int_a^b f$ exists, then $\int_b^a f$ exists too *) Lemma NewtonInt_P3 : forall (f:R -> R) (a b:R) (X:Newton_integrable f a b), Newton_integrable f b a. Proof. unfold Newton_integrable; intros; elim X; intros g H; exists g; tauto. Defined. (* $\int_a^b f = -\int_b^a f$ *) Lemma NewtonInt_P4 : forall (f:R -> R) (a b:R) (pr:Newton_integrable f a b), NewtonInt f a b pr = - NewtonInt f b a (NewtonInt_P3 f a b pr). Proof. intros f a b (x,H). unfold NewtonInt, NewtonInt_P3; simpl; ring. Qed. (* The set of Newton integrable functions is a vectorial space *) Lemma NewtonInt_P5 : forall (f g:R -> R) (l a b:R), Newton_integrable f a b -> Newton_integrable g a b -> Newton_integrable (fun x:R => l * f x + g x) a b. Proof. unfold Newton_integrable; intros f g l a b X X0; elim X; intros x p; elim X0; intros x0 p0; exists (fun y:R => l * x y + x0 y). elim p; intro; elim p0; intro. - left; unfold antiderivative; unfold antiderivative in H, H0; elim H; clear H; intros; elim H0; clear H0; intros H0 _. split. 2:assumption. intros; elim (H _ H2); elim (H0 _ H2); intros. assert (H5 : derivable_pt (fun y:R => l * x y + x0 y) x1). { reg. } exists H5; symmetry ; reg; rewrite <- H3; rewrite <- H4; reflexivity. - unfold antiderivative in H, H0; elim H; elim H0; intros; elim H4; intro. { elim (Rlt_irrefl _ (Rlt_le_trans _ _ _ H5 H2)). } left; rewrite <- H5; unfold antiderivative; split. 2:right;reflexivity. intros; elim H6; intros; assert (H9 : x1 = a). { apply Rle_antisym; assumption. } assert (H10 : a <= x1 <= b). { split; right; [ symmetry ; assumption | rewrite <- H5; assumption ]. } assert (H11 : b <= x1 <= a). { split; right; [ rewrite <- H5; symmetry ; assumption | assumption ]. } assert (H12 : derivable_pt x x1). { unfold derivable_pt; exists (f x1); elim (H3 _ H10); intros; eapply derive_pt_eq_1; symmetry ; apply H12. } assert (H13 : derivable_pt x0 x1). { unfold derivable_pt; exists (g x1); elim (H1 _ H11); intros; eapply derive_pt_eq_1; symmetry ; apply H13. } assert (H14 : derivable_pt (fun y:R => l * x y + x0 y) x1). { reg. } exists H14; symmetry ; reg. assert (H15 : derive_pt x0 x1 H13 = g x1). { elim (H1 _ H11); intros; rewrite H15; apply pr_nu. } assert (H16 : derive_pt x x1 H12 = f x1). { elim (H3 _ H10); intros; rewrite H16; apply pr_nu. } rewrite H15; rewrite H16; ring. - unfold antiderivative in H, H0; elim H; elim H0; intros; elim H4; intro. { elim (Rlt_irrefl _ (Rlt_le_trans _ _ _ H5 H2)). } left; rewrite H5; unfold antiderivative; split. 2:{ right;reflexivity. } intros; elim H6; intros; assert (H9 : x1 = a). { apply Rle_antisym; assumption. } assert (H10 : a <= x1 <= b). { split; right; [ symmetry ; assumption | rewrite H5; assumption ]. } assert (H11 : b <= x1 <= a). { split; right; [ rewrite H5; symmetry ; assumption | assumption ]. } assert (H12 : derivable_pt x x1). { unfold derivable_pt; exists (f x1); elim (H3 _ H11); intros; eapply derive_pt_eq_1; symmetry ; apply H12. } assert (H13 : derivable_pt x0 x1). { unfold derivable_pt; exists (g x1); elim (H1 _ H10); intros; eapply derive_pt_eq_1; symmetry ; apply H13. } assert (H14 : derivable_pt (fun y:R => l * x y + x0 y) x1). { reg. } exists H14; symmetry ; reg. assert (H15 : derive_pt x0 x1 H13 = g x1). { elim (H1 _ H10); intros; rewrite H15; apply pr_nu. } assert (H16 : derive_pt x x1 H12 = f x1). { elim (H3 _ H11); intros; rewrite H16; apply pr_nu. } rewrite H15; rewrite H16; ring. - right; unfold antiderivative; unfold antiderivative in H, H0; elim H; clear H; intros; elim H0; clear H0; intros H0 _; split. 2:assumption. intros; elim (H _ H2); elim (H0 _ H2); intros. assert (H5 : derivable_pt (fun y:R => l * x y + x0 y) x1). { reg. } exists H5; symmetry ; reg; rewrite <- H3; rewrite <- H4; reflexivity. Qed. (**********) Lemma antiderivative_P1 : forall (f g F G:R -> R) (l a b:R), antiderivative f F a b -> antiderivative g G a b -> antiderivative (fun x:R => l * f x + g x) (fun x:R => l * F x + G x) a b. Proof. unfold antiderivative; intros; elim H; elim H0; clear H H0; intros; split. { intros; elim (H _ H3); elim (H1 _ H3); intros. assert (H6 : derivable_pt (fun x:R => l * F x + G x) x). { reg. } exists H6; symmetry ; reg; rewrite <- H4; rewrite <- H5; ring. } assumption. Qed. (* $\int_a^b \lambda f + g = \lambda \int_a^b f + \int_a^b f *) Lemma NewtonInt_P6 : forall (f g:R -> R) (l a b:R) (pr1:Newton_integrable f a b) (pr2:Newton_integrable g a b), NewtonInt (fun x:R => l * f x + g x) a b (NewtonInt_P5 f g l a b pr1 pr2) = l * NewtonInt f a b pr1 + NewtonInt g a b pr2. Proof. intros f g l a b pr1 pr2; unfold NewtonInt; destruct (NewtonInt_P5 f g l a b pr1 pr2) as (x,o); destruct pr1 as (x0,o0); destruct pr2 as (x1,o1); destruct (total_order_T a b) as [[Hlt|Heq]|Hgt]. - elim o; intro. 2:{ unfold antiderivative in H; elim H; intros; elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H1 Hlt)). } elim o0; intro. 2:{ unfold antiderivative in H0; elim H0; intros; elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H2 Hlt)). } elim o1; intro. 2:{ unfold antiderivative in H1; elim H1; intros; elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H3 Hlt)). } assert (H2 := antiderivative_P1 f g x0 x1 l a b H0 H1); assert (H3 := antiderivative_Ucte _ _ _ _ _ H H2); elim H3; intros; assert (H5 : a <= a <= b). { split; [ right; reflexivity | left; assumption ]. } assert (H6 : a <= b <= b). { split; [ left; assumption | right; reflexivity ]. } assert (H7 := H4 _ H5); assert (H8 := H4 _ H6); rewrite H7; rewrite H8; ring. - rewrite Heq; ring. - elim o; intro. { unfold antiderivative in H; elim H; intros; elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H1 Hgt)). } elim o0; intro. { unfold antiderivative in H0; elim H0; intros; elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H2 Hgt)). } elim o1; intro. { unfold antiderivative in H1; elim H1; intros; elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H3 Hgt)). } assert (H2 := antiderivative_P1 f g x0 x1 l b a H0 H1); assert (H3 := antiderivative_Ucte _ _ _ _ _ H H2); elim H3; intros; assert (H5 : b <= a <= a). { split; [ left; assumption | right; reflexivity ]. } assert (H6 : b <= b <= a). { split; [ right; reflexivity | left; assumption ]. } assert (H7 := H4 _ H5); assert (H8 := H4 _ H6); rewrite H7; rewrite H8; ring. Qed. Lemma antiderivative_P2 : forall (f F0 F1:R -> R) (a b c:R), antiderivative f F0 a b -> antiderivative f F1 b c -> antiderivative f (fun x:R => match Rle_dec x b with | left _ => F0 x | right _ => F1 x + (F0 b - F1 b) end) a c. Proof. intros; destruct H as (H,H1), H0 as (H0,H2); split. 2: apply Rle_trans with b; assumption. intros x (H3,H4); destruct (total_order_T x b) as [[Hlt|Heq]|Hgt]. - assert (H5 : a <= x <= b). { split; [ assumption | left; assumption ]. } destruct (H _ H5) as (x0,H6). assert (H7 : derivable_pt_lim (fun x:R => match Rle_dec x b with | left _ => F0 x | right _ => F1 x + (F0 b - F1 b) end) x (f x)). { unfold derivable_pt_lim. intros eps H9. assert (H7 : derive_pt F0 x x0 = f x) by (symmetry; assumption). destruct (derive_pt_eq_1 F0 x (f x) x0 H7 _ H9) as (x1,H10); set (D := Rmin x1 (b - x)). assert (H11 : 0 < D). { unfold D, Rmin; case (Rle_dec x1 (b - x)); intro. { apply (cond_pos x1). } apply Rlt_0_minus; assumption. } exists (mkposreal _ H11); intros h H12 H13. case (Rle_dec x b) as [|[]]. 2:left;assumption. case (Rle_dec (x + h) b) as [|[]]. { apply H10. { assumption. } apply Rlt_le_trans with D; [ assumption | unfold D; apply Rmin_l ]. } left; apply Rlt_le_trans with (x + D). { apply Rplus_lt_compat_l; apply Rle_lt_trans with (Rabs h). { apply RRle_abs. } apply H13. } apply Rplus_le_reg_l with (- x); rewrite <- Rplus_assoc; rewrite Rplus_opp_l; rewrite Rplus_0_l; rewrite Rplus_comm; unfold D; apply Rmin_r. } assert (H8 : derivable_pt (fun x:R => match Rle_dec x b with | left _ => F0 x | right _ => F1 x + (F0 b - F1 b) end) x). { unfold derivable_pt; exists (f x); apply H7. } exists H8; symmetry ; apply derive_pt_eq_0; apply H7. - assert (H5 : a <= x <= b). { split; [ assumption | right; assumption ]. } assert (H6 : b <= x <= c). { split; [ right; symmetry ; assumption | assumption ]. } elim (H _ H5); elim (H0 _ H6); intros; assert (H9 : derive_pt F0 x x1 = f x). { symmetry ; assumption. } assert (H10 : derive_pt F1 x x0 = f x). { symmetry ; assumption. } assert (H11 := derive_pt_eq_1 F0 x (f x) x1 H9); assert (H12 := derive_pt_eq_1 F1 x (f x) x0 H10); assert (H13 : derivable_pt_lim (fun x:R => match Rle_dec x b with | left _ => F0 x | right _ => F1 x + (F0 b - F1 b) end) x (f x)). { unfold derivable_pt_lim; unfold derivable_pt_lim in H11, H12; intros; elim (H11 _ H13); elim (H12 _ H13); intros; set (D := Rmin x2 x3); assert (H16 : 0 < D). { unfold D; unfold Rmin; case (Rle_dec x2 x3); intro. { apply (cond_pos x2). } apply (cond_pos x3). } exists (mkposreal _ H16); intros; case (Rle_dec x b) as [|[]]. 2:right;assumption. case (Rle_dec (x + h) b); intro. { apply H15. { assumption. } apply Rlt_le_trans with D; [ assumption | unfold D; apply Rmin_r ]. } replace (F1 (x + h) + (F0 b - F1 b) - F0 x) with (F1 (x + h) - F1 x). { apply H14. { assumption. } apply Rlt_le_trans with D; [ assumption | unfold D; apply Rmin_l ]. } rewrite Heq; ring. } assert (H14 : derivable_pt (fun x:R => match Rle_dec x b with | left _ => F0 x | right _ => F1 x + (F0 b - F1 b) end) x). { unfold derivable_pt; exists (f x); apply H13. } exists H14; symmetry ; apply derive_pt_eq_0; apply H13. - assert (H5 : b <= x <= c). { split; [ left; assumption | assumption ]. } assert (H6 := H0 _ H5); elim H6; clear H6; intros; assert (H7 : derivable_pt_lim (fun x:R => match Rle_dec x b with | left _ => F0 x | right _ => F1 x + (F0 b - F1 b) end) x (f x)). { unfold derivable_pt_lim; assert (H7 : derive_pt F1 x x0 = f x). { symmetry ; assumption. } assert (H8 := derive_pt_eq_1 F1 x (f x) x0 H7); unfold derivable_pt_lim in H8; intros; elim (H8 _ H9); intros; set (D := Rmin x1 (x - b)); assert (H11 : 0 < D). { unfold D; unfold Rmin; case (Rle_dec x1 (x - b)); intro. { apply (cond_pos x1). } apply Rlt_0_minus; assumption. } exists (mkposreal _ H11); intros; destruct (Rle_dec x b) as [Hle|Hnle]. { elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ Hle Hgt)). } destruct (Rle_dec (x + h) b) as [Hle'|Hnle']. { cut (b < x + h). { intro; elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ Hle' H14)). } apply Rplus_lt_reg_l with (- h - b); replace (- h - b + b) with (- h); [ idtac | ring ]; replace (- h - b + (x + h)) with (x - b); [ idtac | ring ]; apply Rle_lt_trans with (Rabs h). { rewrite <- Rabs_Ropp; apply RRle_abs. } apply Rlt_le_trans with D. { apply H13. } unfold D; apply Rmin_r. } replace (F1 (x + h) + (F0 b - F1 b) - (F1 x + (F0 b - F1 b))) with (F1 (x + h) - F1 x); [ idtac | ring ]; apply H10. { assumption. } apply Rlt_le_trans with D. { assumption. } unfold D; apply Rmin_l. } assert (H8 : derivable_pt (fun x:R => match Rle_dec x b with | left _ => F0 x | right _ => F1 x + (F0 b - F1 b) end) x). { unfold derivable_pt; exists (f x); apply H7. } exists H8; symmetry ; apply derive_pt_eq_0; apply H7. Qed. Lemma antiderivative_P3 : forall (f F0 F1:R -> R) (a b c:R), antiderivative f F0 a b -> antiderivative f F1 c b -> antiderivative f F1 c a \/ antiderivative f F0 a c. Proof. intros; unfold antiderivative in H, H0; elim H; clear H; elim H0; clear H0; intros; destruct (total_order_T a c) as [[Hle|Heq]|Hgt]. - right; unfold antiderivative; split. { intros; apply H1; elim H3; intros; split; [ assumption | apply Rle_trans with c; assumption ]. } left; assumption. - right; unfold antiderivative; split. { intros; apply H1; elim H3; intros; split; [ assumption | apply Rle_trans with c; assumption ]. } right; assumption. - left; unfold antiderivative; split. { intros; apply H; elim H3; intros; split; [ assumption | apply Rle_trans with a; assumption ]. } left; assumption. Qed. Lemma antiderivative_P4 : forall (f F0 F1:R -> R) (a b c:R), antiderivative f F0 a b -> antiderivative f F1 a c -> antiderivative f F1 b c \/ antiderivative f F0 c b. Proof. intros; unfold antiderivative in H, H0; elim H; clear H; elim H0; clear H0; intros; destruct (total_order_T c b) as [[Hlt|Heq]|Hgt]. - right; unfold antiderivative; split. { intros; apply H1; elim H3; intros; split; [ apply Rle_trans with c; assumption | assumption ]. } left; assumption. - right; unfold antiderivative; split. { intros; apply H1; elim H3; intros; split; [ apply Rle_trans with c; assumption | assumption ]. } right; assumption. - left; unfold antiderivative; split. { intros; apply H; elim H3; intros; split; [ apply Rle_trans with b; assumption | assumption ]. } left; assumption. Qed. Lemma NewtonInt_P7 : forall (f:R -> R) (a b c:R), a < b -> b < c -> Newton_integrable f a b -> Newton_integrable f b c -> Newton_integrable f a c. Proof. unfold Newton_integrable; intros f a b c Hab Hbc X X0; elim X; clear X; intros F0 H0; elim X0; clear X0; intros F1 H1; set (g := fun x:R => match Rle_dec x b with | left _ => F0 x | right _ => F1 x + (F0 b - F1 b) end); exists g; left; unfold g; apply antiderivative_P2. { elim H0; intro. { assumption. } unfold antiderivative in H; elim H; clear H; intros; elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H2 Hab)). } elim H1; intro. { assumption. } unfold antiderivative in H; elim H; clear H; intros; elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H2 Hbc)). Qed. Lemma NewtonInt_P8 : forall (f:R -> R) (a b c:R), Newton_integrable f a b -> Newton_integrable f b c -> Newton_integrable f a c. Proof. intros. elim X; intros F0 H0. elim X0; intros F1 H1. destruct (total_order_T a b) as [[Hlt|Heq]|Hgt]. - destruct (total_order_T b c) as [[Hlt'|Heq']|Hgt']. + (* a match Rle_dec x b with | left _ => F0 x | right _ => F1 x + (F0 b - F1 b) end). elim H0; intro. { elim H1; intro. { left; apply antiderivative_P2; assumption. } unfold antiderivative in H2; elim H2; clear H2; intros _ H2. elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H2 Hlt')). } unfold antiderivative in H; elim H; clear H; intros _ H. elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H Hlt)). + (* ac *) destruct (total_order_T a c) as [[Hlt''|Heq'']|Hgt'']. * unfold Newton_integrable; exists F0. left. elim H1; intro. { unfold antiderivative in H; elim H; clear H; intros _ H. elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H Hgt')). } elim H0; intro. { assert (H3 := antiderivative_P3 f F0 F1 a b c H2 H). elim H3; intro. { unfold antiderivative in H4; elim H4; clear H4; intros _ H4. elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H4 Hlt'')). } assumption. } unfold antiderivative in H2; elim H2; clear H2; intros _ H2. elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H2 Hlt)). * rewrite Heq''; apply NewtonInt_P1. * unfold Newton_integrable; exists F1. right. elim H1; intro. { unfold antiderivative in H; elim H; clear H; intros _ H. elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H Hgt')). } elim H0; intro. { assert (H3 := antiderivative_P3 f F0 F1 a b c H2 H). elim H3; intro. { assumption. } unfold antiderivative in H4; elim H4; clear H4; intros _ H4. elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H4 Hgt'')). } unfold antiderivative in H2; elim H2; clear H2; intros _ H2. elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H2 Hlt)). - (* a=b *) rewrite Heq; apply X0. - destruct (total_order_T b c) as [[Hlt'|Heq']|Hgt']. (* a>b & bb & b=c *) rewrite Heq' in X; apply X. + (* a>b & b>c *) assert (X1 := NewtonInt_P3 f a b X). assert (X2 := NewtonInt_P3 f b c X0). apply NewtonInt_P3. apply NewtonInt_P7 with b; assumption. Qed. (* Chasles' relation *) Lemma NewtonInt_P9 : forall (f:R -> R) (a b c:R) (pr1:Newton_integrable f a b) (pr2:Newton_integrable f b c), NewtonInt f a c (NewtonInt_P8 f a b c pr1 pr2) = NewtonInt f a b pr1 + NewtonInt f b c pr2. Proof. intros; unfold NewtonInt. case (NewtonInt_P8 f a b c pr1 pr2) as (x,Hor). case pr1 as (x0,Hor0). case pr2 as (x1,Hor1). destruct (total_order_T a b) as [[Hlt|Heq]|Hgt]. - destruct (total_order_T b c) as [[Hlt'|Heq']|Hgt']. + (* a match Rle_dec x b with | left _ => x0 x | right _ => x1 x + (x0 b - x1 b) end) a c H1 H2). elim H3; intros. assert (H5 : a <= a <= c). { split; [ right; reflexivity | left; apply Rlt_trans with b; assumption ]. } assert (H6 : a <= c <= c). { split; [ left; apply Rlt_trans with b; assumption | right; reflexivity ]. } rewrite (H4 _ H5); rewrite (H4 _ H6). destruct (Rle_dec a b) as [Hlea|Hnlea]. { destruct (Rle_dec c b) as [Hlec|Hnlec]. { elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ Hlec Hlt')). } ring. } elim Hnlea; left; assumption. + (* ac *) elim Hor1; intro. { unfold antiderivative in H; elim H; clear H; intros _ H. elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H Hgt')). } elim Hor0; intro. 2:{ unfold antiderivative in H0; elim H0; clear H0; intros _ H0. elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H0 Hlt)). } elim Hor; intro. * assert (H2 := antiderivative_P2 f x x1 a c b H1 H). assert (H3 := antiderivative_Ucte _ _ _ a b H0 H2). elim H3; intros. rewrite (H4 a). { rewrite (H4 b). { destruct (Rle_dec b c) as [Hle|Hnle]. { elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ Hle Hgt')). } destruct (Rle_dec a c) as [Hle'|Hnle']. { ring. } elim Hnle'; unfold antiderivative in H1; elim H1; intros; assumption. } split; [ left; assumption | right; reflexivity ]. } split; [ right; reflexivity | left; assumption ]. * assert (H2 := antiderivative_P2 _ _ _ _ _ _ H1 H0). assert (H3 := antiderivative_Ucte _ _ _ c b H H2). elim H3; intros. rewrite (H4 c). { rewrite (H4 b). { destruct (Rle_dec b a) as [Hle|Hnle]. { elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ Hle Hlt)). } destruct (Rle_dec c a) as [Hle'|[]]. { ring. } unfold antiderivative in H1; elim H1; intros; assumption. } split; [ left; assumption | right; reflexivity ]. } split; [ right; reflexivity | left; assumption ]. - (* a=b *) rewrite Heq in Hor |- *. elim Hor; intro. + elim Hor1; intro. * assert (H1 := antiderivative_Ucte _ _ _ b c H H0). elim H1; intros. assert (H3 : b <= c). { unfold antiderivative in H; elim H; intros; assumption. } rewrite (H2 b). { rewrite (H2 c). { ring. } split; [ assumption | right; reflexivity ]. } split; [ right; reflexivity | assumption ]. * assert (H1 : b = c). { unfold antiderivative in H, H0; elim H; elim H0; intros; apply Rle_antisym; assumption. } rewrite H1; ring. + elim Hor1; intro. * assert (H1 : b = c). { unfold antiderivative in H, H0; elim H; elim H0; intros; apply Rle_antisym; assumption. } rewrite H1; ring. * assert (H1 := antiderivative_Ucte _ _ _ c b H H0). elim H1; intros. assert (H3 : c <= b). { unfold antiderivative in H; elim H; intros; assumption. } rewrite (H2 c). { rewrite (H2 b). { ring. } split; [ assumption | right; reflexivity ]. } split; [ right; reflexivity | assumption ]. - (* a>b & bb & b=c *) rewrite <- Heq'. unfold Rminus; rewrite Rplus_opp_r; rewrite Rplus_0_r. rewrite <- Heq' in Hor. elim Hor0; intro. { unfold antiderivative in H; elim H; clear H; intros _ H. elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H Hgt)). } elim Hor; intro. { unfold antiderivative in H0; elim H0; clear H0; intros _ H0. elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H0 Hgt)). } assert (H1 := antiderivative_Ucte f x x0 b a H0 H). elim H1; intros. rewrite (H2 b). { rewrite (H2 a). { ring. } split; [ left; assumption | right; reflexivity ]. } split; [ right; reflexivity | left; assumption ]. + (* a>b & b>c *) elim Hor0; intro. { unfold antiderivative in H; elim H; clear H; intros _ H. elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H Hgt)). } elim Hor1; intro. { unfold antiderivative in H0; elim H0; clear H0; intros _ H0. elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H0 Hgt')). } elim Hor; intro. { unfold antiderivative in H1; elim H1; clear H1; intros _ H1. elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H1 (Rlt_trans _ _ _ Hgt' Hgt))). } assert (H2 := antiderivative_P2 _ _ _ _ _ _ H0 H). assert (H3 := antiderivative_Ucte _ _ _ c a H1 H2). elim H3; intros. assert (H5 : c <= a). { unfold antiderivative in H1; elim H1; intros; assumption. } rewrite (H4 c). { rewrite (H4 a). { destruct (Rle_dec a b) as [Hle|Hnle]. { elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ Hle Hgt)). } destruct (Rle_dec c b) as [|[]]. { ring. } left; assumption. } split; [ assumption | right; reflexivity ]. } split; [ right; reflexivity | assumption ]. Qed. coq-8.20.0/theories/Reals/PSeries_reg.v000066400000000000000000000620401466560755400176750ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* Boule c d y -> x <= z <= y -> Boule c d z. Proof. intros c d x y z bx b_y intz. unfold Boule in bx, b_y; apply Rabs_def2 in bx; apply Rabs_def2 in b_y; apply Rabs_def1; [apply Rle_lt_trans with (y - c);[apply Rplus_le_compat_r|]| apply Rlt_le_trans with (x - c);[|apply Rplus_le_compat_r]];tauto. Qed. Definition boule_of_interval x y (h : x < y) : {c :R & {r : posreal | c - r = x /\ c + r = y}}. Proof. exists ((x + y)/2). assert (radius : 0 < (y - x)/2). - unfold Rdiv; apply Rmult_lt_0_compat. + apply Rlt_0_minus; assumption. + now apply Rinv_0_lt_compat, Rlt_0_2. - exists (mkposreal _ radius). simpl; split; unfold Rdiv; field. Qed. Definition boule_in_interval x y z (h : x < z < y) : {c : R & {r | Boule c r z /\ x < c - r /\ c + r < y}}. Proof. assert (cmp : x * /2 + z * /2 < z * /2 + y * /2). { destruct h as [h1 h2]. rewrite Rplus_comm; apply Rplus_lt_compat_l, Rmult_lt_compat_r. - apply Rinv_0_lt_compat, Rlt_0_2. - apply Rlt_trans with z; assumption. } destruct (boule_of_interval _ _ cmp) as [c [r [P1 P2]]]. assert (0 < /2) by (apply Rinv_0_lt_compat, Rlt_0_2). exists c, r; split. - destruct h; unfold Boule; simpl; apply Rabs_def1. + apply Rplus_lt_reg_l with c; rewrite P2; replace (c + (z - c)) with (z * / 2 + z * / 2) by field. apply Rplus_lt_compat_l, Rmult_lt_compat_r;assumption. + apply Rplus_lt_reg_l with c; change (c + - r) with (c - r); rewrite P1; replace (c + (z - c)) with (z * / 2 + z * / 2) by field. apply Rplus_lt_compat_r, Rmult_lt_compat_r;assumption. - destruct h; split. + replace x with (x * / 2 + x * / 2) by field; rewrite P1. apply Rplus_lt_compat_l, Rmult_lt_compat_r;assumption. + replace y with (y * / 2 + y * /2) by field; rewrite P2. apply Rplus_lt_compat_r, Rmult_lt_compat_r;assumption. Qed. Lemma Ball_in_inter : forall c1 c2 r1 r2 x, Boule c1 r1 x -> Boule c2 r2 x -> {r3 : posreal | forall y, Boule x r3 y -> Boule c1 r1 y /\ Boule c2 r2 y}. Proof. intros c1 c2 [r1 r1p] [r2 r2p] x; unfold Boule; simpl; intros in1 in2. assert (Rmax (c1 - r1)(c2 - r2) < x). { apply Rmax_lub_lt;[revert in1 | revert in2]; intros h; apply Rabs_def2 in h; destruct h as [_ u]; apply (fun h => Rplus_lt_reg_r _ _ _ (Rle_lt_trans _ _ _ h u)), Req_le; ring. } assert (x < Rmin (c1 + r1) (c2 + r2)). { apply Rmin_glb_lt;[revert in1 | revert in2]; intros h; apply Rabs_def2 in h; destruct h as [u _]; apply (fun h => Rplus_lt_reg_r _ _ _ (Rlt_le_trans _ _ _ u h)), Req_le; ring. } assert (t: 0 < Rmin (x - Rmax (c1 - r1) (c2 - r2)) (Rmin (c1 + r1) (c2 + r2) - x)). { apply Rmin_glb_lt; apply Rlt_0_minus; assumption. } exists (mkposreal _ t). apply Rabs_def2 in in1; destruct in1. apply Rabs_def2 in in2; destruct in2. assert (c1 - r1 <= Rmax (c1 - r1) (c2 - r2)) by apply Rmax_l. assert (c2 - r2 <= Rmax (c1 - r1) (c2 - r2)) by apply Rmax_r. assert (Rmin (c1 + r1) (c2 + r2) <= c1 + r1) by apply Rmin_l. assert (Rmin (c1 + r1) (c2 + r2) <= c2 + r2) by apply Rmin_r. assert (Rmin (x - Rmax (c1 - r1) (c2 - r2)) (Rmin (c1 + r1) (c2 + r2) - x) <= x - Rmax (c1 - r1) (c2 - r2)) by apply Rmin_l. assert (Rmin (x - Rmax (c1 - r1) (c2 - r2)) (Rmin (c1 + r1) (c2 + r2) - x) <= Rmin (c1 + r1) (c2 + r2) - x) by apply Rmin_r. simpl. intros y h; apply Rabs_def2 in h; destruct h as [h h']. apply Rmin_Rgt in h; destruct h as [cmp1 cmp2]. apply Rplus_lt_reg_r in cmp2; apply Rmin_Rgt in cmp2. rewrite Ropp_Rmin, Ropp_minus_distr in h'. apply Rmax_Rlt in h'; destruct h' as [cmp3 cmp4]; apply Rplus_lt_reg_r in cmp3; apply Rmax_Rlt in cmp3; split; apply Rabs_def1. - apply (fun h => Rplus_lt_reg_l _ _ _ (Rle_lt_trans _ _ _ h (proj1 cmp2))), Req_le; ring. - apply (fun h => Rplus_lt_reg_l _ _ _ (Rlt_le_trans _ _ _ (proj1 cmp3) h)), Req_le; ring. - apply (fun h => Rplus_lt_reg_l _ _ _ (Rle_lt_trans _ _ _ h (proj2 cmp2))), Req_le; ring. - apply (fun h => Rplus_lt_reg_l _ _ _ (Rlt_le_trans _ _ _ (proj2 cmp3) h)), Req_le; ring. Qed. Lemma Boule_center : forall x r, Boule x r x. Proof. intros x [r rpos]; unfold Boule, Rminus; simpl; rewrite Rplus_opp_r. rewrite Rabs_pos_eq;[assumption | apply Rle_refl]. Qed. (** Uniform convergence *) Definition CVU (fn:nat -> R -> R) (f:R -> R) (x:R) (r:posreal) : Prop := forall eps:R, 0 < eps -> exists N : nat, (forall (n:nat) (y:R), (N <= n)%nat -> Boule x r y -> Rabs (f y - fn n y) < eps). (** Normal convergence *) Definition CVN_r (fn:nat -> R -> R) (r:posreal) : Type := { An:nat -> R & { l:R | Un_cv (fun n:nat => sum_f_R0 (fun k:nat => Rabs (An k)) n) l /\ (forall (n:nat) (y:R), Boule 0 r y -> Rabs (fn n y) <= An n) } }. Definition CVN_R (fn:nat -> R -> R) : Type := forall r:posreal, CVN_r fn r. Definition SFL (fn:nat -> R -> R) (cv:forall x:R, { l:R | Un_cv (fun N:nat => SP fn N x) l }) (y:R) : R := let (a,_) := cv y in a. (** In a complete space, normal convergence implies uniform convergence *) Lemma CVN_CVU : forall (fn:nat -> R -> R) (cv:forall x:R, {l:R | Un_cv (fun N:nat => SP fn N x) l }) (r:posreal), CVN_r fn r -> CVU (fun n:nat => SP fn n) (SFL fn cv) 0 r. Proof. intros; unfold CVU; intros. unfold CVN_r in X. elim X; intros An X0. elim X0; intros s H0. elim H0; intros. assert (Un_cv (fun n:nat => sum_f_R0 (fun k:nat => Rabs (An k)) n - s) 0). { unfold Un_cv in H1; unfold Un_cv; intros. elim (H1 _ H3); intros. exists x; intros. unfold Rdist; unfold Rdist in H4. rewrite Rminus_0_r; apply H4; assumption. } unfold Un_cv in H3. elim (H3 eps H); intros N0 H4. exists N0; intros. apply Rle_lt_trans with (Rabs (sum_f_R0 (fun k:nat => Rabs (An k)) n - s)). 2:{ unfold Rdist in H4; unfold Rminus in H4; rewrite Ropp_0 in H4. assert (H7 := H4 n H5). rewrite Rplus_0_r in H7; apply H7. } rewrite <- (Rabs_Ropp (sum_f_R0 (fun k:nat => Rabs (An k)) n - s)); rewrite Ropp_minus_distr; rewrite (Rabs_right (s - sum_f_R0 (fun k:nat => Rabs (An k)) n)). { eapply sum_maj1. - unfold SFL; case (cv y); intro. trivial. - apply H1. - intro; elim H0; intros. rewrite (Rabs_right (An n0)). + apply H8; apply H6. + apply Rle_ge; apply Rle_trans with (Rabs (fn n0 y)). * apply Rabs_pos. * apply H8; apply H6. } apply Rle_ge; apply Rplus_le_reg_l with (sum_f_R0 (fun k:nat => Rabs (An k)) n). rewrite Rplus_0_r; unfold Rminus; rewrite (Rplus_comm s); rewrite <- Rplus_assoc; rewrite Rplus_opp_r; rewrite Rplus_0_l; apply sum_incr. - apply H1. - intro; apply Rabs_pos. Qed. (** Each limit of a sequence of functions which converges uniformly is continue *) Lemma CVU_continuity : forall (fn:nat -> R -> R) (f:R -> R) (x:R) (r:posreal), CVU fn f x r -> (forall (n:nat) (y:R), Boule x r y -> continuity_pt (fn n) y) -> forall y:R, Boule x r y -> continuity_pt f y. Proof. intros; unfold continuity_pt; unfold continue_in; unfold limit1_in; unfold limit_in; simpl; unfold Rdist; intros. unfold CVU in H. cut (0 < eps / 3); [ intro | unfold Rdiv; apply Rmult_lt_0_compat; [ assumption | apply Rinv_0_lt_compat; prove_sup0 ] ]. elim (H _ H3); intros N0 H4. assert (H5 := H0 N0 y H1). assert (exists del : posreal, (forall h:R, Rabs h < del -> Boule x r (y + h))). { assert (0 < r - Rabs (x - y)). { unfold Boule in H1; rewrite <- (Rabs_Ropp (x - y)); rewrite Ropp_minus_distr; apply Rplus_lt_reg_l with (Rabs (y - x)). rewrite Rplus_0_r; replace (Rabs (y - x) + (r - Rabs (y - x))) with (pos r); [ apply H1 | ring ]. } exists (mkposreal _ H6). simpl; intros. unfold Boule; replace (y + h - x) with (h + (y - x)); [ idtac | ring ]; apply Rle_lt_trans with (Rabs h + Rabs (y - x)). { apply Rabs_triang. } apply Rplus_lt_reg_l with (- Rabs (x - y)). rewrite <- (Rabs_Ropp (y - x)); rewrite Ropp_minus_distr. replace (- Rabs (x - y) + r) with (r - Rabs (x - y)) by ring. replace (- Rabs (x - y) + (Rabs h + Rabs (x - y))) with (Rabs h) by ring. apply H7. } elim H6; intros del1 H7. unfold continuity_pt in H5; unfold continue_in in H5; unfold limit1_in in H5; unfold limit_in in H5; simpl in H5; unfold Rdist in H5. elim (H5 _ H3); intros del2 H8. set (del := Rmin del1 del2). exists del; intros. split. { unfold del; unfold Rmin; case (Rle_dec del1 del2); intro. - apply (cond_pos del1). - elim H8; intros; assumption. } intros; apply Rle_lt_trans with (Rabs (f x0 - fn N0 x0) + Rabs (fn N0 x0 - f y)). { replace (f x0 - f y) with (f x0 - fn N0 x0 + (fn N0 x0 - f y)); [ apply Rabs_triang | ring ]. } apply Rle_lt_trans with (Rabs (f x0 - fn N0 x0) + Rabs (fn N0 x0 - fn N0 y) + Rabs (fn N0 y - f y)). { rewrite Rplus_assoc; apply Rplus_le_compat_l. replace (fn N0 x0 - f y) with (fn N0 x0 - fn N0 y + (fn N0 y - f y)); [ apply Rabs_triang | ring ]. } replace eps with (eps / 3 + eps / 3 + eps / 3) by field. repeat apply Rplus_lt_compat. - apply H4. + apply le_n. + replace x0 with (y + (x0 - y)); [ idtac | ring ]; apply H7. elim H9; intros. apply Rlt_le_trans with del. * assumption. * unfold del; apply Rmin_l. - elim H8; intros. apply H11. split. + elim H9; intros; assumption. + elim H9; intros; apply Rlt_le_trans with del. * assumption. * unfold del; apply Rmin_r. - rewrite <- Rabs_Ropp; rewrite Ropp_minus_distr; apply H4. + apply le_n. + assumption. Qed. (**********) Lemma continuity_pt_finite_SF : forall (fn:nat -> R -> R) (N:nat) (x:R), (forall n:nat, (n <= N)%nat -> continuity_pt (fn n) x) -> continuity_pt (fun y:R => sum_f_R0 (fun k:nat => fn k y) N) x. Proof. intros; induction N as [| N HrecN]. - simpl; apply (H 0%nat); apply le_n. - simpl; replace (fun y:R => sum_f_R0 (fun k:nat => fn k y) N + fn (S N) y) with ((fun y:R => sum_f_R0 (fun k:nat => fn k y) N) + (fun y:R => fn (S N) y))%F; [ idtac | reflexivity ]. apply continuity_pt_plus. + apply HrecN. intros; apply H. apply Nat.le_trans with N; [ assumption | apply Nat.le_succ_diag_r ]. + apply (H (S N)); apply le_n. Qed. (** Continuity and normal convergence *) Lemma SFL_continuity_pt : forall (fn:nat -> R -> R) (cv:forall x:R, { l:R | Un_cv (fun N:nat => SP fn N x) l }) (r:posreal), CVN_r fn r -> (forall (n:nat) (y:R), Boule 0 r y -> continuity_pt (fn n) y) -> forall y:R, Boule 0 r y -> continuity_pt (SFL fn cv) y. Proof. intros; eapply CVU_continuity. - apply CVN_CVU. apply X. - intros; unfold SP; apply continuity_pt_finite_SF. intros; apply H. apply H1. - apply H0. Qed. Lemma SFL_continuity : forall (fn:nat -> R -> R) (cv:forall x:R, { l:R | Un_cv (fun N:nat => SP fn N x) l }), CVN_R fn -> (forall n:nat, continuity (fn n)) -> continuity (SFL fn cv). Proof. intros; unfold continuity; intro. cut (0 < Rabs x + 1); [ intro | apply Rplus_le_lt_0_compat; [ apply Rabs_pos | apply Rlt_0_1 ] ]. cut (Boule 0 (mkposreal _ H0) x). - intro; eapply SFL_continuity_pt with (mkposreal _ H0). + apply X. + intros; apply (H n y). + apply H1. - unfold Boule; simpl; rewrite Rminus_0_r; pattern (Rabs x) at 1; rewrite <- Rplus_0_r; apply Rplus_lt_compat_l; apply Rlt_0_1. Qed. (** As R is complete, normal convergence implies that (fn) is simply-uniformly convergent *) Lemma CVN_R_CVS : forall fn:nat -> R -> R, CVN_R fn -> forall x:R, { l:R | Un_cv (fun N:nat => SP fn N x) l }. Proof. intros; apply R_complete. unfold SP; set (An := fun N:nat => fn N x). change (Cauchy_crit_series An). apply cauchy_abs. unfold Cauchy_crit_series; apply CV_Cauchy. pose proof (Rabs_pos x) as Rabs_pos_x. unfold CVN_R in X; cut (0 < Rabs x + 1). 2:{ lra. } intro; assert (H0 := X (mkposreal _ H)). unfold CVN_r in H0; elim H0; intros Bn H1. elim H1; intros l H2. elim H2; intros. apply Rseries_CV_comp with Bn. { intro; split. { apply Rabs_pos. } unfold An; apply H4; unfold Boule; simpl; rewrite Rminus_0_r. lra. } exists l. assert (forall n:nat, 0 <= Bn n). { intro; apply Rle_trans with (Rabs (An n)). { apply Rabs_pos. } unfold An; apply H4; unfold Boule; simpl; rewrite Rminus_0_r; lra. } unfold Un_cv in H3; unfold Un_cv; intros. elim (H3 _ H6); intros. exists x0; intros. replace (sum_f_R0 Bn n) with (sum_f_R0 (fun k:nat => Rabs (Bn k)) n). - apply H7; assumption. - apply sum_eq; intros; apply Rabs_right; apply Rle_ge; apply H5. Qed. (* Uniform convergence implies pointwise simple convergence *) Lemma CVU_cv : forall f g c d, CVU f g c d -> forall x, Boule c d x -> Un_cv (fun n => f n x) (g x). Proof. intros f g c d cvu x bx eps ep; destruct (cvu eps ep) as [N Pn]. exists N; intros n nN; rewrite Rdist_sym; apply Pn; assumption. Qed. (* convergence is preserved through extensional equality *) Lemma CVU_ext_lim : forall f g1 g2 c d, CVU f g1 c d -> (forall x, Boule c d x -> g1 x = g2 x) -> CVU f g2 c d. Proof. intros f g1 g2 c d cvu q eps ep; destruct (cvu _ ep) as [N Pn]. exists N; intros; rewrite <- q; auto. Qed. (* When a sequence of derivable functions converge pointwise towards a function g, with the derivatives converging uniformly towards a function g', then the function g' is the derivative of g. *) Lemma CVU_derivable : forall f f' g g' c d, CVU f' g' c d -> (forall x, Boule c d x -> Un_cv (fun n => f n x) (g x)) -> (forall n x, Boule c d x -> derivable_pt_lim (f n) x (f' n x)) -> forall x, Boule c d x -> derivable_pt_lim g x (g' x). Proof. intros f f' g g' c d cvu cvp dff' x bx. set (rho_ := fun n y => if Req_dec_T y x then f' n x else ((f n y - f n x)/ (y - x))). set (rho := fun y => if Req_dec_T y x then g' x else (g y - g x)/(y - x)). assert (ctrho : forall n z, Boule c d z -> continuity_pt (rho_ n) z). { intros n z bz. destruct (Req_dec_T x z) as [xz | xnz]. - rewrite <- xz. intros eps' ep'. destruct (dff' n x bx eps' ep') as [alp Pa]. exists (pos alp);split;[apply cond_pos | ]. intros z'; unfold rho_, D_x, dist, R_met; simpl; intros [[_ xnz'] dxz']. destruct (Req_dec_T z' x) as [abs | _]. { case xnz'; symmetry; exact abs. } destruct (Req_dec_T x x) as [_ | abs];[ | case abs; reflexivity]. pattern z' at 1; replace z' with (x + (z' - x)) by ring. apply Pa;[intros h; case xnz'; replace z' with (z' - x + x) by ring; rewrite h, Rplus_0_l; reflexivity | exact dxz']. - destruct (Ball_in_inter c c d d z bz bz) as [delta Pd]. assert (dz : 0 < Rmin delta (Rabs (z - x))). { now apply Rmin_glb_lt;[apply cond_pos | apply Rabs_pos_lt; intros zx0; case xnz; replace z with (z - x + x) by ring; rewrite zx0, Rplus_0_l]. } assert (t' : forall y : R, Rdist y z < Rmin delta (Rabs (z - x)) -> (fun z : R => (f n z - f n x) / (z - x)) y = rho_ n y). { intros y dyz; unfold rho_; destruct (Req_dec_T y x) as [xy | xny]. - rewrite xy in dyz. destruct (Rle_dec delta (Rabs (z - x))). + rewrite Rmin_left, Rdist_sym in dyz; unfold Rdist in dyz; lra. + rewrite Rmin_right, Rdist_sym in dyz; unfold Rdist in dyz; [case (Rlt_irrefl _ dyz) |apply Rlt_le, Rnot_le_gt; assumption]. - reflexivity. } apply (continuity_pt_locally_ext (fun z => (f n z - f n x)/(z - x)) (rho_ n) _ z dz t'); clear t'. apply continuity_pt_div. 1:apply continuity_pt_minus. 1:apply derivable_continuous_pt; eapply exist; apply dff'; assumption. 1:apply continuity_pt_const; intro; intro; reflexivity. 1:apply continuity_pt_minus; [apply derivable_continuous_pt; exists 1; apply derivable_pt_lim_id | apply continuity_pt_const; intro; reflexivity]. lra. } assert (CVU rho_ rho c d ). { intros eps ep. assert (ep8 : 0 < eps/8) by lra. destruct (cvu _ ep8) as [N Pn1]. assert (cauchy1 : forall n p, (N <= n)%nat -> (N <= p)%nat -> forall z, Boule c d z -> Rabs (f' n z - f' p z) < eps/4). { intros n p nN pN z bz; replace (eps/4) with (eps/8 + eps/8) by field. rewrite <- Rabs_Ropp. replace (-(f' n z - f' p z)) with (g' z - f' n z - (g' z - f' p z)) by ring. apply Rle_lt_trans with (1 := Rabs_triang _ _); rewrite Rabs_Ropp. apply Rplus_lt_compat; apply Pn1; assumption. } assert (step_2 : forall n p, (N <= n)%nat -> (N <= p)%nat -> forall y, Boule c d y -> x <> y -> Rabs ((f n y - f n x)/(y - x) - (f p y - f p x)/(y - x)) < eps/4). { intros n p nN pN y b_y xny. assert (mm0 : (Rmin x y = x /\ Rmax x y = y) \/ (Rmin x y = y /\ Rmax x y = x)). { destruct (Rle_dec x y) as [H | H]. - rewrite Rmin_left, Rmax_right. + left; split; reflexivity. + assumption. + assumption. - rewrite Rmin_right, Rmax_left. + right; split; reflexivity. + apply Rlt_le, Rnot_le_gt; assumption. + apply Rlt_le, Rnot_le_gt; assumption. } assert (mm : Rmin x y < Rmax x y). { destruct mm0 as [[q1 q2] | [q1 q2]]; generalize (Rminmax x y); rewrite q1, q2. - intros h; destruct h;[ assumption| contradiction]. - intros h; destruct h as [h | h];[assumption | rewrite h in xny; case xny; reflexivity]. } assert (dm : forall z, Rmin x y <= z <= Rmax x y -> derivable_pt_lim (fun x => f n x - f p x) z (f' n z - f' p z)). { intros z intz; apply derivable_pt_lim_minus. - apply dff'; apply Boule_convex with (Rmin x y) (Rmax x y); destruct mm0 as [[q1 q2] | [q1 q2]]; revert intz; rewrite ?q1, ?q2; intros; try assumption. - apply dff'; apply Boule_convex with (Rmin x y) (Rmax x y); destruct mm0 as [[q1 q2] | [q1 q2]]; revert intz; rewrite ?q1, ?q2; intros; try assumption. } replace ((f n y - f n x) / (y - x) - (f p y - f p x) / (y - x)) with (((f n y - f p y) - (f n x - f p x))/(y - x)) by (field; intros yx0; case xny; replace y with (y - x + x) by ring; rewrite yx0, Rplus_0_l; reflexivity). destruct (MVT_cor2 (fun x => f n x - f p x) (fun x => f' n x - f' p x) (Rmin x y) (Rmax x y) mm dm) as [z [Pz inz]]. destruct mm0 as [[q1 q2] | [q1 q2]]. - replace ((f n y - f p y - (f n x - f p x))/(y - x)) with ((f n (Rmax x y) - f p (Rmax x y) - (f n (Rmin x y) - f p (Rmin x y))) / (Rmax x y - Rmin x y)) by (rewrite q1, q2; reflexivity). unfold Rdiv; rewrite Pz, Rmult_assoc, Rinv_r, Rmult_1_r. + apply cauchy1; auto. apply Boule_convex with (Rmin x y) (Rmax x y); revert inz; rewrite ?q1, ?q2; intros; try assumption. split; apply Rlt_le; tauto. + rewrite q1, q2; apply Rminus_eq_contra, not_eq_sym; assumption. - replace ((f n y - f p y - (f n x - f p x))/(y - x)) with ((f n (Rmax x y) - f p (Rmax x y) - (f n (Rmin x y) - f p (Rmin x y)))/ (Rmax x y - Rmin x y)). + unfold Rdiv; rewrite Pz, Rmult_assoc, Rinv_r, Rmult_1_r. * apply cauchy1; auto. apply Boule_convex with (Rmin x y) (Rmax x y); revert inz; rewrite ?q1, ?q2; intros; try assumption; split; apply Rlt_le; tauto. * rewrite q1, q2; apply Rminus_eq_contra; assumption. + rewrite q1, q2; field; split; apply Rminus_eq_contra;[apply not_eq_sym |]; assumption. } assert (unif_ac : forall n p, (N <= n)%nat -> (N <= p)%nat -> forall y, Boule c d y -> Rabs (rho_ n y - rho_ p y) <= eps/2). { intros n p nN pN y b_y. destruct (Req_dec_T x y) as [xy | xny]. - destruct (Ball_in_inter c c d d x bx bx) as [delta Pdelta]. destruct (ctrho n y b_y _ ep8) as [d' [dp Pd]]. destruct (ctrho p y b_y _ ep8) as [d2 [dp2 Pd2]]. assert (mmpos : 0 < (Rmin (Rmin d' d2) delta)/2). { apply Rmult_lt_0_compat; repeat apply Rmin_glb_lt; try assumption. { apply cond_pos. } apply Rinv_0_lt_compat, Rlt_0_2. } apply Rle_trans with (1 := Rdist_tri _ _ (rho_ n (y + Rmin (Rmin d' d2) delta/2))). replace (eps/2) with (eps/8 + (eps/4 + eps/8)) by field. apply Rplus_le_compat. + rewrite Rdist_sym; apply Rlt_le, Pd;split;[split;[exact I | ] | ]. * symmetry; apply Rminus_not_eq; rewrite Rplus_comm; unfold Rminus; rewrite Rplus_assoc, Rplus_opp_r, Rplus_0_r; apply Rgt_not_eq; assumption. * simpl; unfold Rdist. unfold Rminus; rewrite (Rplus_comm y), Rplus_assoc, Rplus_opp_r, Rplus_0_r. rewrite Rabs_pos_eq;[ |apply Rlt_le; assumption ]. apply Rlt_le_trans with (Rmin (Rmin d' d2) delta);[lra | ]. apply Rle_trans with (Rmin d' d2); apply Rmin_l. + apply Rle_trans with (1 := Rdist_tri _ _ (rho_ p (y + Rmin (Rmin d' d2) delta/2))). apply Rplus_le_compat. * apply Rlt_le. replace (rho_ n (y + Rmin (Rmin d' d2) delta / 2)) with ((f n (y + Rmin (Rmin d' d2) delta / 2) - f n x)/ ((y + Rmin (Rmin d' d2) delta / 2) - x)). 1:replace (rho_ p (y + Rmin (Rmin d' d2) delta / 2)) with ((f p (y + Rmin (Rmin d' d2) delta / 2) - f p x)/ ((y + Rmin (Rmin d' d2) delta / 2) - x)). 2,3:unfold rho_; destruct (Req_dec_T (y + Rmin (Rmin d' d2) delta / 2) x) as [ymx | ymnx]; [case (RIneq.Rle_not_lt _ _ (Req_le _ _ ymx)); lra |reflexivity]. apply step_2; auto; try lra. assert (0 < pos delta) by (apply cond_pos). apply Boule_convex with y (y + delta/2). -- assumption. -- destruct (Pdelta (y + delta/2)); auto. rewrite xy; unfold Boule; rewrite Rabs_pos_eq; try lra; auto. -- split; try lra. apply Rplus_le_compat_l, Rmult_le_compat_r;[ | apply Rmin_r]. now apply Rlt_le, Rinv_0_lt_compat, Rlt_0_2. * apply Rlt_le, Pd2; split;[split;[exact I | apply Rlt_not_eq; lra] | ]. simpl; unfold Rdist. unfold Rminus; rewrite (Rplus_comm y), Rplus_assoc, Rplus_opp_r, Rplus_0_r. rewrite Rabs_pos_eq;[ | lra]. apply Rlt_le_trans with (Rmin (Rmin d' d2) delta); [lra |]. apply Rle_trans with (Rmin d' d2). -- solve[apply Rmin_l]. -- solve[apply Rmin_r]. - apply Rlt_le, Rlt_le_trans with (eps/4);[ | lra]. unfold rho_; destruct (Req_dec_T y x); solve[auto]. } assert (unif_ac' : forall p, (N <= p)%nat -> forall y, Boule c d y -> Rabs (rho y - rho_ p y) < eps). { assert (cvrho : forall y, Boule c d y -> Un_cv (fun n => rho_ n y) (rho y)). { intros y b_y; unfold rho_, rho; destruct (Req_dec_T y x). - intros eps' ep'; destruct (cvu eps' ep') as [N2 Pn2]. exists N2; intros n nN2; rewrite Rdist_sym; apply Pn2; assumption. - apply CV_mult. + apply CV_minus. * apply cvp; assumption. * apply cvp; assumption. + intros eps' ep'; simpl; exists 0%nat; intros; rewrite Rdist_eq; assumption. } intros p pN y b_y. replace eps with (eps/2 + eps/2) by field. assert (ep2 : 0 < eps/2) by lra. destruct (cvrho y b_y _ ep2) as [N2 Pn2]. apply Rle_lt_trans with (1 := Rdist_tri _ _ (rho_ (max N N2) y)). apply Rplus_lt_le_compat. - solve[rewrite Rdist_sym; apply Pn2, Nat.le_max_r]. - apply unif_ac; auto; solve [apply Nat.le_max_l]. } exists N; intros; apply unif_ac'; solve[auto]. } intros eps ep. destruct (CVU_continuity _ _ _ _ H ctrho x bx eps ep) as [delta [dp Pd]]. exists (mkposreal _ dp); intros h hn0 dh. replace ((g (x + h) - g x) / h) with (rho (x + h)). - replace (g' x) with (rho x). + apply Pd; unfold D_x, no_cond;split;[split;[solve[auto] | ] | ]. * intros xxh; case hn0; replace h with (x + h - x) by ring; rewrite <- xxh; ring. * simpl; unfold Rdist; replace (x + h - x) with h by ring; exact dh. + unfold rho; destruct (Req_dec_T x x) as [ _ | abs];[ | case abs]; reflexivity. - unfold rho; destruct (Req_dec_T (x + h) x) as [abs | _];[ | ]. + case hn0; replace h with (x + h - x) by ring; rewrite abs; ring. + replace (x + h - x) with h by ring; reflexivity. Qed. coq-8.20.0/theories/Reals/PartSum.v000066400000000000000000000540651466560755400170710ustar00rootroot00000000000000 (************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* R) (N:nat), (forall n:nat, (n <= N)%nat -> 0 < An n) -> 0 < sum_f_R0 An N. Proof. intros; induction N as [| N HrecN]. - simpl; apply H; apply le_n. - simpl; apply Rplus_lt_0_compat. + apply HrecN; intros; apply H; apply le_S; assumption. + apply H; apply le_n. Qed. (* Chasles' relation *) Lemma tech2 : forall (An:nat -> R) (m n:nat), (m < n)%nat -> sum_f_R0 An n = sum_f_R0 An m + sum_f_R0 (fun i:nat => An (S m + i)%nat) (n - S m). Proof. intros; induction n as [| n Hrecn]. - elim (Nat.nlt_0_r _ H). - cut ((m < n)%nat \/ m = n). + intro; elim H0; intro. * replace (sum_f_R0 An (S n)) with (sum_f_R0 An n + An (S n)); [ idtac | reflexivity ]. replace (S n - S m)%nat with (S (n - S m)). -- replace (sum_f_R0 (fun i:nat => An (S m + i)%nat) (S (n - S m))) with (sum_f_R0 (fun i:nat => An (S m + i)%nat) (n - S m) + An (S m + S (n - S m))%nat); [ idtac | reflexivity ]. replace (S m + S (n - S m))%nat with (S n). ++ rewrite (Hrecn H1). ring. ++ apply INR_eq; rewrite S_INR; rewrite plus_INR; do 2 rewrite S_INR; rewrite minus_INR. ** rewrite S_INR; ring. ** apply Nat.le_succ_l; assumption. -- apply INR_eq; rewrite S_INR; repeat rewrite minus_INR. ++ repeat rewrite S_INR; ring. ++ apply le_n_S; apply Nat.lt_le_incl; assumption. ++ apply Nat.le_succ_l; assumption. * rewrite H1; rewrite Nat.sub_diag; simpl. replace (n + 0)%nat with n; [ reflexivity | ring ]. + inversion H. * right; reflexivity. * left; apply Nat.lt_le_trans with (S m); [ apply Nat.lt_succ_diag_r | assumption ]. Qed. (* Sum of geometric sequences *) Lemma tech3 : forall (k:R) (N:nat), k <> 1 -> sum_f_R0 (fun i:nat => k ^ i) N = (1 - k ^ S N) / (1 - k). Proof. intros; cut (1 - k <> 0). - intro; induction N as [| N HrecN]. + simpl; rewrite Rmult_1_r; unfold Rdiv; rewrite Rinv_r. * reflexivity. * apply H0. + replace (sum_f_R0 (fun i:nat => k ^ i) (S N)) with (sum_f_R0 (fun i:nat => k ^ i) N + k ^ S N); [ idtac | reflexivity ]; rewrite HrecN; replace ((1 - k ^ S N) / (1 - k) + k ^ S N) with ((1 - k ^ S N + (1 - k) * k ^ S N) / (1 - k)). * apply Rmult_eq_reg_l with (1 - k). -- unfold Rdiv; do 2 rewrite <- (Rmult_comm (/ (1 - k))); repeat rewrite <- Rmult_assoc; rewrite Rinv_r; [ do 2 rewrite Rmult_1_l; simpl; ring | apply H0 ]. -- apply H0. * unfold Rdiv; rewrite Rmult_plus_distr_r; rewrite (Rmult_comm (1 - k)); repeat rewrite Rmult_assoc; rewrite Rinv_r. -- rewrite Rmult_1_r; reflexivity. -- apply H0. - apply Rminus_eq_contra; red; intro; elim H; symmetry ; assumption. Qed. Lemma tech4 : forall (An:nat -> R) (k:R) (N:nat), 0 <= k -> (forall i:nat, An (S i) < k * An i) -> An N <= An 0%nat * k ^ N. Proof. intros; induction N as [| N HrecN]. - simpl; right; ring. - apply Rle_trans with (k * An N). + left; apply (H0 N). + replace (S N) with (N + 1)%nat; [ idtac | ring ]. rewrite pow_add; simpl; rewrite Rmult_1_r; replace (An 0%nat * (k ^ N * k)) with (k * (An 0%nat * k ^ N)); [ idtac | ring ]; apply Rmult_le_compat_l. * assumption. * apply HrecN. Qed. Lemma tech5 : forall (An:nat -> R) (N:nat), sum_f_R0 An (S N) = sum_f_R0 An N + An (S N). Proof. intros; reflexivity. Qed. Lemma tech6 : forall (An:nat -> R) (k:R) (N:nat), 0 <= k -> (forall i:nat, An (S i) < k * An i) -> sum_f_R0 An N <= An 0%nat * sum_f_R0 (fun i:nat => k ^ i) N. Proof. intros; induction N as [| N HrecN]. - simpl; right; ring. - apply Rle_trans with (An 0%nat * sum_f_R0 (fun i:nat => k ^ i) N + An (S N)). + rewrite tech5; do 2 rewrite <- (Rplus_comm (An (S N))); apply Rplus_le_compat_l. apply HrecN. + rewrite tech5; rewrite Rmult_plus_distr_l; apply Rplus_le_compat_l. apply tech4; assumption. Qed. Lemma tech7 : forall r1 r2:R, r1 <> 0 -> r2 <> 0 -> r1 <> r2 -> / r1 <> / r2. Proof. intros; red; intro. assert (H3 := Rmult_eq_compat_l r1 _ _ H2). rewrite Rinv_r in H3; [ idtac | assumption ]. assert (H4 := Rmult_eq_compat_l r2 _ _ H3). rewrite Rmult_1_r in H4; rewrite <- Rmult_assoc in H4. rewrite Rmult_inv_r_id_m in H4; [ idtac | assumption ]. elim H1; symmetry ; assumption. Qed. Lemma tech11 : forall (An Bn Cn:nat -> R) (N:nat), (forall i:nat, An i = Bn i - Cn i) -> sum_f_R0 An N = sum_f_R0 Bn N - sum_f_R0 Cn N. Proof. intros; induction N as [| N HrecN]. - simpl; apply H. - do 3 rewrite tech5; rewrite HrecN; rewrite (H (S N)); ring. Qed. Lemma tech12 : forall (An:nat -> R) (x l:R), Un_cv (fun N:nat => sum_f_R0 (fun i:nat => An i * x ^ i) N) l -> Pser An x l. Proof. intros; unfold Pser; unfold infinite_sum; unfold Un_cv in H; assumption. Qed. Lemma scal_sum : forall (An:nat -> R) (N:nat) (x:R), x * sum_f_R0 An N = sum_f_R0 (fun i:nat => An i * x) N. Proof. intros; induction N as [| N HrecN]. - simpl; ring. - do 2 rewrite tech5. rewrite Rmult_plus_distr_l; rewrite <- HrecN; ring. Qed. Lemma decomp_sum : forall (An:nat -> R) (N:nat), (0 < N)%nat -> sum_f_R0 An N = An 0%nat + sum_f_R0 (fun i:nat => An (S i)) (pred N). Proof. intros; induction N as [| N HrecN]. - elim (Nat.lt_irrefl _ H). - cut ((0 < N)%nat \/ N = 0%nat). + intro; elim H0; intro. * cut (S (pred N) = pred (S N)). -- intro; rewrite <- H2. do 2 rewrite tech5. replace (S (S (pred N))) with (S N). ++ rewrite (HrecN H1); ring. ++ rewrite H2; simpl; reflexivity. -- destruct (O_or_S N) as [(m,<-)|<-]. ++ simpl; reflexivity. ++ elim (Nat.lt_irrefl _ H1). * rewrite H1; simpl; reflexivity. + inversion H. * right; reflexivity. * left; apply Nat.lt_le_trans with 1%nat; [ apply Nat.lt_0_succ | assumption ]. Qed. Lemma plus_sum : forall (An Bn:nat -> R) (N:nat), sum_f_R0 (fun i:nat => An i + Bn i) N = sum_f_R0 An N + sum_f_R0 Bn N. Proof. intros; induction N as [| N HrecN]. - simpl; ring. - do 3 rewrite tech5; rewrite HrecN; ring. Qed. Lemma sum_eq : forall (An Bn:nat -> R) (N:nat), (forall i:nat, (i <= N)%nat -> An i = Bn i) -> sum_f_R0 An N = sum_f_R0 Bn N. Proof. intros; induction N as [| N HrecN]. - simpl; apply H; apply le_n. - do 2 rewrite tech5; rewrite HrecN. + rewrite (H (S N)); [ reflexivity | apply le_n ]. + intros; apply H; apply Nat.le_trans with N; [ assumption | apply Nat.le_succ_diag_r ]. Qed. (* Unicity of the limit defined by convergent series *) Lemma uniqueness_sum : forall (An:nat -> R) (l1 l2:R), infinite_sum An l1 -> infinite_sum An l2 -> l1 = l2. Proof. unfold infinite_sum; intros. case (Req_dec l1 l2); intro. - assumption. - cut (0 < Rabs ((l1 - l2) / 2)); [ intro | apply Rabs_pos_lt ]. + elim (H (Rabs ((l1 - l2) / 2)) H2); intros. elim (H0 (Rabs ((l1 - l2) / 2)) H2); intros. set (N := max x0 x); cut (N >= x0)%nat. * cut (N >= x)%nat. -- intros; assert (H7 := H3 N H5); assert (H8 := H4 N H6). cut (Rabs (l1 - l2) <= Rdist (sum_f_R0 An N) l1 + Rdist (sum_f_R0 An N) l2). ++ intro; assert (H10 := Rplus_lt_compat _ _ _ _ H7 H8); assert (H11 := Rle_lt_trans _ _ _ H9 H10); unfold Rdiv in H11; rewrite Rabs_mult in H11. cut (Rabs (/ 2) = / 2). ** intro; rewrite H12 in H11; assert (H13 := Rplus_half_diag); unfold Rdiv in H13; rewrite H13 in H11. elim (Rlt_irrefl _ H11). ** apply Rabs_right; left; change (0 < / 2); apply Rinv_0_lt_compat; cut (0%nat <> 2%nat); [ intro H20; generalize (lt_INR_0 2 (proj1 (Nat.neq_0_lt_0 2) (Nat.neq_sym 0 2 H20))); unfold INR; intro; assumption | discriminate ]. ++ unfold Rdist; rewrite <- (Rabs_Ropp (sum_f_R0 An N - l1)); rewrite Ropp_minus_distr. replace (l1 - l2) with (l1 - sum_f_R0 An N + (sum_f_R0 An N - l2)); [ idtac | ring ]. apply Rabs_triang. -- unfold ge; unfold N; apply Nat.le_max_r. * unfold ge; unfold N; apply Nat.le_max_l. + unfold Rdiv; apply prod_neq_R0. * apply Rminus_eq_contra; assumption. * apply Rinv_neq_0_compat; discrR. Qed. Lemma minus_sum : forall (An Bn:nat -> R) (N:nat), sum_f_R0 (fun i:nat => An i - Bn i) N = sum_f_R0 An N - sum_f_R0 Bn N. Proof. intros; induction N as [| N HrecN]. - simpl; ring. - do 3 rewrite tech5; rewrite HrecN; ring. Qed. Lemma sum_decomposition : forall (An:nat -> R) (N:nat), sum_f_R0 (fun l:nat => An (2 * l)%nat) (S N) + sum_f_R0 (fun l:nat => An (S (2 * l))) N = sum_f_R0 An (2 * S N). Proof. intros. induction N as [| N HrecN]. - simpl; ring. - rewrite tech5. rewrite (tech5 (fun l:nat => An (S (2 * l))) N). replace (2 * S (S N))%nat with (S (S (2 * S N))). + rewrite (tech5 An (S (2 * S N))). rewrite (tech5 An (2 * S N)). rewrite <- HrecN. ring. + ring. Qed. Lemma sum_Rle : forall (An Bn:nat -> R) (N:nat), (forall n:nat, (n <= N)%nat -> An n <= Bn n) -> sum_f_R0 An N <= sum_f_R0 Bn N. Proof. intros. induction N as [| N HrecN]. - simpl; apply H. apply le_n. - do 2 rewrite tech5. apply Rle_trans with (sum_f_R0 An N + Bn (S N)). + apply Rplus_le_compat_l. apply H. apply le_n. + do 2 rewrite <- (Rplus_comm (Bn (S N))). apply Rplus_le_compat_l. apply HrecN. intros; apply H. apply Nat.le_trans with N; [ assumption | apply Nat.le_succ_diag_r ]. Qed. Lemma Rsum_abs : forall (An:nat -> R) (N:nat), Rabs (sum_f_R0 An N) <= sum_f_R0 (fun l:nat => Rabs (An l)) N. Proof. intros. induction N as [| N HrecN]. - simpl. right; reflexivity. - do 2 rewrite tech5. apply Rle_trans with (Rabs (sum_f_R0 An N) + Rabs (An (S N))). + apply Rabs_triang. + do 2 rewrite <- (Rplus_comm (Rabs (An (S N)))). apply Rplus_le_compat_l. apply HrecN. Qed. Lemma sum_cte : forall (x:R) (N:nat), sum_f_R0 (fun _:nat => x) N = x * INR (S N). Proof. intros. induction N as [| N HrecN]. - simpl; ring. - rewrite tech5. rewrite HrecN; repeat rewrite S_INR; ring. Qed. (**********) Lemma sum_growing : forall (An Bn:nat -> R) (N:nat), (forall n:nat, An n <= Bn n) -> sum_f_R0 An N <= sum_f_R0 Bn N. Proof. intros. induction N as [| N HrecN]. - simpl; apply H. - do 2 rewrite tech5. apply Rle_trans with (sum_f_R0 An N + Bn (S N)). + apply Rplus_le_compat_l; apply H. + do 2 rewrite <- (Rplus_comm (Bn (S N))). apply Rplus_le_compat_l; apply HrecN. Qed. (**********) Lemma Rabs_triang_gen : forall (An:nat -> R) (N:nat), Rabs (sum_f_R0 An N) <= sum_f_R0 (fun i:nat => Rabs (An i)) N. Proof. intros. induction N as [| N HrecN]. - simpl. right; reflexivity. - do 2 rewrite tech5. apply Rle_trans with (Rabs (sum_f_R0 An N) + Rabs (An (S N))). + apply Rabs_triang. + do 2 rewrite <- (Rplus_comm (Rabs (An (S N)))). apply Rplus_le_compat_l; apply HrecN. Qed. (**********) Lemma cond_pos_sum : forall (An:nat -> R) (N:nat), (forall n:nat, 0 <= An n) -> 0 <= sum_f_R0 An N. Proof. intros. induction N as [| N HrecN]. - simpl; apply H. - rewrite tech5. apply Rplus_le_le_0_compat. + apply HrecN. + apply H. Qed. (* Cauchy's criterion for series *) Definition Cauchy_crit_series (An:nat -> R) : Prop := Cauchy_crit (fun N:nat => sum_f_R0 An N). (* If (|An|) satisfies the Cauchy's criterion for series, then (An) too *) Lemma cauchy_abs : forall An:nat -> R, Cauchy_crit_series (fun i:nat => Rabs (An i)) -> Cauchy_crit_series An. Proof. unfold Cauchy_crit_series; unfold Cauchy_crit. intros. elim (H eps H0); intros. exists x. intros. cut (Rdist (sum_f_R0 An n) (sum_f_R0 An m) <= Rdist (sum_f_R0 (fun i:nat => Rabs (An i)) n) (sum_f_R0 (fun i:nat => Rabs (An i)) m)). - intro. apply Rle_lt_trans with (Rdist (sum_f_R0 (fun i:nat => Rabs (An i)) n) (sum_f_R0 (fun i:nat => Rabs (An i)) m)). + assumption. + apply H1; assumption. - destruct (lt_eq_lt_dec n m) as [[ | -> ]|]. + rewrite (tech2 An n m); [ idtac | assumption ]. rewrite (tech2 (fun i:nat => Rabs (An i)) n m); [ idtac | assumption ]. unfold Rdist. unfold Rminus. do 2 rewrite Ropp_plus_distr. do 2 rewrite <- Rplus_assoc. do 2 rewrite Rplus_opp_r. do 2 rewrite Rplus_0_l. do 2 rewrite Rabs_Ropp. rewrite (Rabs_right (sum_f_R0 (fun i:nat => Rabs (An (S n + i)%nat)) (m - S n))) . * set (Bn := fun i:nat => An (S n + i)%nat). replace (fun i:nat => Rabs (An (S n + i)%nat)) with (fun i:nat => Rabs (Bn i)). -- apply Rabs_triang_gen. -- unfold Bn; reflexivity. * apply Rle_ge. apply cond_pos_sum. intro; apply Rabs_pos. + unfold Rdist. unfold Rminus; do 2 rewrite Rplus_opp_r. rewrite Rabs_R0; right; reflexivity. + rewrite (tech2 An m n); [ idtac | assumption ]. rewrite (tech2 (fun i:nat => Rabs (An i)) m n); [ idtac | assumption ]. unfold Rdist. unfold Rminus. do 2 rewrite Rplus_assoc. rewrite (Rplus_comm (sum_f_R0 An m)). rewrite (Rplus_comm (sum_f_R0 (fun i:nat => Rabs (An i)) m)). do 2 rewrite Rplus_assoc. do 2 rewrite Rplus_opp_l. do 2 rewrite Rplus_0_r. rewrite (Rabs_right (sum_f_R0 (fun i:nat => Rabs (An (S m + i)%nat)) (n - S m))) . * set (Bn := fun i:nat => An (S m + i)%nat). replace (fun i:nat => Rabs (An (S m + i)%nat)) with (fun i:nat => Rabs (Bn i)). -- apply Rabs_triang_gen. -- unfold Bn; reflexivity. * apply Rle_ge. apply cond_pos_sum. intro; apply Rabs_pos. Qed. (**********) Lemma cv_cauchy_1 : forall An:nat -> R, { l:R | Un_cv (fun N:nat => sum_f_R0 An N) l } -> Cauchy_crit_series An. Proof. intros An (x,p). unfold Un_cv in p. unfold Cauchy_crit_series; unfold Cauchy_crit. intros. cut (0 < eps / 2). - intro. elim (p (eps / 2) H0); intros. exists x0. intros. apply Rle_lt_trans with (Rdist (sum_f_R0 An n) x + Rdist (sum_f_R0 An m) x). + unfold Rdist. replace (sum_f_R0 An n - sum_f_R0 An m) with (sum_f_R0 An n - x + - (sum_f_R0 An m - x)); [ idtac | ring ]. rewrite <- (Rabs_Ropp (sum_f_R0 An m - x)). apply Rabs_triang. + apply Rlt_le_trans with (eps / 2 + eps / 2). * apply Rplus_lt_compat. -- apply H1; assumption. -- apply H1; assumption. * right; apply Rplus_half_diag. - unfold Rdiv; apply Rmult_lt_0_compat; [ assumption | apply Rinv_0_lt_compat; prove_sup0 ]. Qed. Lemma cv_cauchy_2 : forall An:nat -> R, Cauchy_crit_series An -> { l:R | Un_cv (fun N:nat => sum_f_R0 An N) l }. Proof. intros. apply R_complete. unfold Cauchy_crit_series in H. exact H. Qed. (**********) Lemma sum_eq_R0 : forall (An:nat -> R) (N:nat), (forall n:nat, (n <= N)%nat -> An n = 0) -> sum_f_R0 An N = 0. Proof. intros; induction N as [| N HrecN]. - simpl; apply H; apply le_n. - rewrite tech5; rewrite HrecN; [ rewrite Rplus_0_l; apply H; apply le_n | intros; apply H; apply Nat.le_trans with N; [ assumption | apply Nat.le_succ_diag_r ] ]. Qed. Definition SP (fn:nat -> R -> R) (N:nat) (x:R) : R := sum_f_R0 (fun k:nat => fn k x) N. (**********) Lemma sum_incr : forall (An:nat -> R) (N:nat) (l:R), Un_cv (fun n:nat => sum_f_R0 An n) l -> (forall n:nat, 0 <= An n) -> sum_f_R0 An N <= l. Proof. intros; destruct (total_order_T (sum_f_R0 An N) l) as [[Hlt|Heq]|Hgt]. - left; apply Hlt. - right; apply Heq. - cut (Un_growing (fun n:nat => sum_f_R0 An n)). + intro; set (l1 := sum_f_R0 An N) in Hgt. unfold Un_cv in H; cut (0 < l1 - l). * intro; elim (H _ H2); intros. set (N0 := max x N); cut (N0 >= x)%nat. -- intro; assert (H5 := H3 N0 H4). cut (l1 <= sum_f_R0 An N0). ++ intro; unfold Rdist in H5; rewrite Rabs_right in H5. ** cut (sum_f_R0 An N0 < l1). { intro; elim (Rlt_irrefl _ (Rlt_le_trans _ _ _ H7 H6)). } apply Rplus_lt_reg_l with (- l). do 2 rewrite (Rplus_comm (- l)). apply H5. ** apply Rle_ge; apply Rplus_le_reg_l with l. rewrite Rplus_0_r; replace (l + (sum_f_R0 An N0 - l)) with (sum_f_R0 An N0); [ idtac | ring ]; apply Rle_trans with l1. { left; apply Hgt. } apply H6. ++ unfold l1; apply Rge_le; apply (growing_prop (fun k:nat => sum_f_R0 An k)). ** apply H1. ** unfold ge, N0; apply Nat.le_max_r. -- unfold ge, N0; apply Nat.le_max_l. * apply Rplus_lt_reg_l with l; rewrite Rplus_0_r; replace (l + (l1 - l)) with l1; [ apply Hgt | ring ]. + unfold Un_growing; intro; simpl; pattern (sum_f_R0 An n) at 1; rewrite <- Rplus_0_r; apply Rplus_le_compat_l; apply H0. Qed. (**********) Lemma sum_cv_maj : forall (An:nat -> R) (fn:nat -> R -> R) (x l1 l2:R), Un_cv (fun n:nat => SP fn n x) l1 -> Un_cv (fun n:nat => sum_f_R0 An n) l2 -> (forall n:nat, Rabs (fn n x) <= An n) -> Rabs l1 <= l2. Proof. intros; destruct (total_order_T (Rabs l1) l2) as [[Hlt|Heq]|Hgt]. - left; apply Hlt. - right; apply Heq. - cut (forall n0:nat, Rabs (SP fn n0 x) <= sum_f_R0 An n0). { intro; cut (0 < (Rabs l1 - l2) / 2). - intro; unfold Un_cv in H, H0. elim (H _ H3); intros Na H4. elim (H0 _ H3); intros Nb H5. set (N := max Na Nb). unfold Rdist in H4, H5. cut (Rabs (sum_f_R0 An N - l2) < (Rabs l1 - l2) / 2). 1:intro; cut (Rabs (Rabs l1 - Rabs (SP fn N x)) < (Rabs l1 - l2) / 2). 1:intro; cut (sum_f_R0 An N < (Rabs l1 + l2) / 2). 1:intro; cut ((Rabs l1 + l2) / 2 < Rabs (SP fn N x)). 1:intro; cut (sum_f_R0 An N < Rabs (SP fn N x)). 1:intro; assert (H11 := H2 N). + elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H11 H10)). + apply Rlt_trans with ((Rabs l1 + l2) / 2); assumption. + destruct (Rcase_abs (Rabs l1 - Rabs (SP fn N x))) as [Hlt|Hge]. * apply Rlt_trans with (Rabs l1). -- apply Rmult_lt_reg_l with 2. ++ prove_sup0. ++ unfold Rdiv; rewrite (Rmult_comm 2); rewrite Rmult_assoc; rewrite Rinv_l. ** rewrite Rmult_1_r; rewrite <-Rplus_diag; apply Rplus_lt_compat_l; apply Hgt. ** discrR. -- apply (Rminus_lt _ _ Hlt). * rewrite (Rabs_right _ Hge) in H7. apply Rplus_lt_reg_l with ((Rabs l1 - l2) / 2 - Rabs (SP fn N x)). replace ((Rabs l1 - l2) / 2 - Rabs (SP fn N x) + (Rabs l1 + l2) / 2) with (Rabs l1 - Rabs (SP fn N x)). -- unfold Rminus; rewrite Rplus_assoc; rewrite Rplus_opp_l; rewrite Rplus_0_r; apply H7. -- unfold Rdiv; rewrite Rmult_plus_distr_r; rewrite <- (Rmult_comm (/ 2)); rewrite Rmult_minus_distr_l; repeat rewrite (Rmult_comm (/ 2)); pattern (Rabs l1) at 1; rewrite <-Rplus_half_diag; unfold Rdiv in |- *; ring. + destruct (Rcase_abs (sum_f_R0 An N - l2)) as [Hlt|Hge]. * apply Rlt_trans with l2. -- apply (Rminus_lt _ _ Hlt). -- apply Rmult_lt_reg_l with 2. ++ prove_sup0. ++ rewrite <-(Rplus_diag l2); unfold Rdiv; rewrite (Rmult_comm 2); rewrite Rmult_assoc; rewrite Rinv_l. ** rewrite Rmult_1_r; rewrite (Rplus_comm (Rabs l1)); apply Rplus_lt_compat_l; apply Hgt. ** discrR. * rewrite (Rabs_right _ Hge) in H6; apply Rplus_lt_reg_l with (- l2). replace (- l2 + (Rabs l1 + l2) / 2) with ((Rabs l1 - l2) / 2). -- rewrite Rplus_comm; apply H6. -- unfold Rdiv; rewrite <- (Rmult_comm (/ 2)); rewrite Rmult_minus_distr_l; rewrite Rmult_plus_distr_r; pattern l2 at 2; rewrite <-Rplus_half_diag; repeat rewrite (Rmult_comm (/ 2)); rewrite Ropp_plus_distr; unfold Rdiv; ring. + apply Rle_lt_trans with (Rabs (SP fn N x - l1)). * rewrite <- Rabs_Ropp; rewrite Ropp_minus_distr; apply Rabs_triang_inv2. * apply H4; unfold ge, N; apply Nat.le_max_l. + apply H5; unfold ge, N; apply Nat.le_max_r. - unfold Rdiv; apply Rmult_lt_0_compat. + apply Rplus_lt_reg_l with l2. rewrite Rplus_0_r; replace (l2 + (Rabs l1 - l2)) with (Rabs l1); [ apply Hgt | ring ]. + apply Rinv_0_lt_compat; prove_sup0. } intros; induction n0 as [| n0 Hrecn0]. + unfold SP; simpl; apply H1. + unfold SP; simpl. apply Rle_trans with (Rabs (sum_f_R0 (fun k:nat => fn k x) n0) + Rabs (fn (S n0) x)). * apply Rabs_triang. * apply Rle_trans with (sum_f_R0 An n0 + Rabs (fn (S n0) x)). -- do 2 rewrite <- (Rplus_comm (Rabs (fn (S n0) x))). apply Rplus_le_compat_l; apply Hrecn0. -- apply Rplus_le_compat_l; apply H1. Qed. coq-8.20.0/theories/Reals/RIneq.v000066400000000000000000002700711466560755400165110ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* ], [<=] and [>=] - injective morphisms: - [INR : nat -> R] - [IPR : positive -> R] - [IZR : Z -> R] All those lemmas are proved using a set of 17 "primitive" lemmas in [Raxioms.v] (plus the convenient choice that the inverse of 0 is 0 in [Rdefinitions.v]). These "primitive" lemmas are: - [Rplus_comm], [Rplus_assoc], [Rplus_0_l], [Rplus_opp_l] - [Rmult_comm], [Rmult_assoc], [Rmult_1_l], [Rinv_l] - [Rmult_plus_distr_l], [R1_neq_R0] - [Rlt_trans], [Rlt_asym], [Rplus_lt_compat_l], [Rmult_lt_compat_l] - [total_order_T] - [completeness], [archimed] This makes this file independent of the actual construction of the real numbers, since these 17 axioms characterize, up to isomorphism, the ordered field of real numbers. *) Require Import RelationClasses. Require Export Raxioms. Require Import Rpow_def. Require Import ZArith. Require Export ZArithRing. Require Export RealField. Local Open Scope Z_scope. Local Open Scope R_scope. (*********************************************************) (** ** Relation between orders and equality *) (*********************************************************) (** Reflexivity of the large orders *) Lemma Rle_refl : forall r, r <= r. Proof. now intros r; right. Qed. #[global] Hint Immediate Rle_refl: rorders. #[export] Instance Rle_Reflexive : Reflexive Rle | 10 := Rle_refl. Lemma Rge_refl : forall r, r >= r. Proof. now intros r; right. Qed. #[global] Hint Immediate Rge_refl: rorders. #[export] Instance Rge_Reflexive : Reflexive Rge | 10 := Rge_refl. Lemma Req_le : forall r1 r2, r1 = r2 -> r1 <= r2. Proof. now intros r1 r2 H; right. Qed. #[global] Hint Immediate Req_le: real. Lemma Req_ge : forall r1 r2, r1 = r2 -> r1 >= r2. Proof. now intros r1 r2 H; right. Qed. #[global] Hint Immediate Req_ge: real. (** Irreflexivity of the strict orders *) Lemma Rlt_irrefl : forall r, ~ r < r. Proof. intros r H; now apply (Rlt_asym r r). Qed. #[global] Hint Resolve Rlt_irrefl: real. #[export] Instance Rlt_Irreflexive : Irreflexive Rlt | 10 := Rlt_irrefl. Lemma Rgt_irrefl : forall r, ~ r > r. Proof. exact Rlt_irrefl. Qed. #[export] Instance Rgt_Irreflexive : Irreflexive Rgt | 10 := Rgt_irrefl. Lemma Rlt_not_eq : forall r1 r2, r1 < r2 -> r1 <> r2. Proof. now intros r1 r2 H H0; apply (Rlt_irrefl r1); rewrite H0 at 2. Qed. Lemma Rgt_not_eq : forall r1 r2, r1 > r2 -> r1 <> r2. Proof. now intros r1 r2 H1 H2%eq_sym; apply (Rlt_not_eq r2 r1). Qed. Lemma Rlt_dichotomy_converse : forall r1 r2, r1 < r2 \/ r1 > r2 -> r1 <> r2. Proof. intros r1 r2 [Hlt | Hgt]. - now apply Rlt_not_eq. - now apply Rgt_not_eq. Qed. #[global] Hint Resolve Rlt_dichotomy_converse: real. (** Reasoning by case on equality and order *) (* We should use Rtotal_order in proofs and total_order_T in definitions. *) Lemma Rtotal_order : forall r1 r2, r1 < r2 \/ r1 = r2 \/ r1 > r2. Proof. intros r1 r2; destruct (total_order_T r1 r2) as [[Hlt | Heq] | Hgt]. - now left. - now right; left. - now right; right. Qed. Lemma Req_dec : forall r1 r2:R, r1 = r2 \/ r1 <> r2. Proof. intros r1 r2; destruct (Rtotal_order r1 r2) as [Hlt | [Heq | Hgt]]. - now right; apply Rlt_not_eq. - now left. - now right; apply Rgt_not_eq. Qed. #[global] Hint Resolve Req_dec: real. Lemma Rdichotomy : forall r1 r2, r1 <> r2 -> r1 < r2 \/ r1 > r2. Proof. intros r1 r2 r1_neq_r2; destruct (Rtotal_order r1 r2) as [Hlt | [Heq | Hgt]]. - now left. - now exfalso. - now right. Qed. (*********************************************************) (** ** Strong decidable equality *) (*********************************************************) Lemma Req_dec_T : forall r1 r2:R, {r1 = r2} + {r1 <> r2}. Proof. intros r1 r2; destruct (total_order_T r1 r2) as [[H | ] | H]. - now right; intros ->; apply (Rlt_irrefl r2). - now left. - now right; intros ->; apply (Rlt_irrefl r2 H). Qed. (*********************************************************) (** ** Relating [<], [>], [<=] and [>=] *) (*********************************************************) (** *** Relating strict and large orders *) Lemma Rlt_le : forall r1 r2, r1 < r2 -> r1 <= r2. Proof. now intros r1 r2 H; left. Qed. #[global] Hint Resolve Rlt_le: real. Lemma Rgt_ge : forall r1 r2, r1 > r2 -> r1 >= r2. Proof. now intros r1 r2; left. Qed. Lemma Rle_ge : forall r1 r2, r1 <= r2 -> r2 >= r1. Proof. now intros r1 r2 [H1 | H2]; [left | right]. Qed. #[global] Hint Immediate Rle_ge: real. #[global] Hint Resolve Rle_ge: rorders. Lemma Rge_le : forall r1 r2, r1 >= r2 -> r2 <= r1. Proof. now intros r1 r2 [Hge | Heq]; [left | right]. Qed. #[global] Hint Resolve Rge_le: real. #[global] Hint Immediate Rge_le: rorders. Lemma Rlt_gt : forall r1 r2, r1 < r2 -> r2 > r1. Proof. now unfold Rgt. Qed. #[global] Hint Resolve Rlt_gt: rorders. Lemma Rgt_lt : forall r1 r2, r1 > r2 -> r2 < r1. Proof. now unfold Rgt. Qed. #[global] Hint Immediate Rgt_lt: rorders. Lemma Rnot_le_lt : forall r1 r2, ~ r1 <= r2 -> r2 < r1. Proof. intros r1 r2 r1_nle_r2; destruct (Rtotal_order r1 r2) as [Hlt | [Heq | Hgt]]. - now exfalso; apply r1_nle_r2; left. - now exfalso; apply r1_nle_r2; right. - assumption. Qed. #[global] Hint Immediate Rnot_le_lt: real. Lemma Rnot_ge_gt : forall r1 r2, ~ r1 >= r2 -> r2 > r1. Proof. now intros r1 r2 H; apply Rnot_le_lt; intros H'%Rle_ge. Qed. Lemma Rnot_le_gt : forall r1 r2, ~ r1 <= r2 -> r1 > r2. Proof. now intros r1 r2 H; apply Rnot_le_lt. Qed. Lemma Rnot_ge_lt : forall r1 r2, ~ r1 >= r2 -> r1 < r2. Proof. now intros r1 r2 H; apply Rnot_le_lt; intros H'%Rle_ge. Qed. Lemma Rnot_lt_le : forall r1 r2, ~ r1 < r2 -> r2 <= r1. Proof. intros r1 r2 H; destruct (Rtotal_order r1 r2) as [Hlt | [Heq | Hgt]]. - now exfalso. - now right. - now left. Qed. Lemma Rnot_gt_le : forall r1 r2, ~ r1 > r2 -> r1 <= r2. Proof. now intros r1 r2 H; apply Rnot_lt_le. Qed. Lemma Rnot_gt_ge : forall r1 r2, ~ r1 > r2 -> r2 >= r1. Proof. now intros r1 r2 H; apply Rle_ge, Rnot_lt_le. Qed. Lemma Rnot_lt_ge : forall r1 r2, ~ r1 < r2 -> r1 >= r2. Proof. now intros r1 r2 H; apply Rnot_gt_ge. Qed. Lemma Rlt_not_le : forall r1 r2, r2 < r1 -> ~ r1 <= r2. Proof. intros r1 r2 Hgt [Hlt | Hle%eq_sym]. - now apply (Rlt_asym r1 r2). - now apply Rlt_not_eq in Hgt. Qed. #[global] Hint Immediate Rlt_not_le: real. Lemma Rgt_not_le : forall r1 r2, r1 > r2 -> ~ r1 <= r2. Proof. exact Rlt_not_le. Qed. Lemma Rlt_not_ge : forall r1 r2, r1 < r2 -> ~ r1 >= r2. Proof. now intros r1 r2 Hlt%Rlt_not_le Hge%Rge_le. Qed. #[global] Hint Immediate Rlt_not_ge: real. Lemma Rgt_not_ge : forall r1 r2, r2 > r1 -> ~ r1 >= r2. Proof. exact Rlt_not_ge. Qed. Lemma Rle_not_lt : forall r1 r2, r2 <= r1 -> ~ r1 < r2. Proof. intros r1 r2 [Hlt | Heq%eq_sym]; intros Hgt. - now apply (Rlt_asym r1 r2). - now apply Rlt_not_eq in Hgt. Qed. Lemma Rge_not_lt : forall r1 r2, r1 >= r2 -> ~ r1 < r2. Proof. now intros r1 r2 Hge; apply Rle_not_lt, Rge_le. Qed. Lemma Rle_not_gt : forall r1 r2, r1 <= r2 -> ~ r1 > r2. Proof. now intros r1 r2 Hle; apply Rle_not_lt. Qed. Lemma Rge_not_gt : forall r1 r2, r2 >= r1 -> ~ r1 > r2. Proof. now intros r1 r2 Hge; apply Rge_not_lt. Qed. (* TODO: We may want to deprecate it but cannot because of the hint used in external libs (the stdlib can already be compiled without it) *) Lemma Req_le_sym : forall r1 r2, r2 = r1 -> r1 <= r2. Proof. now intros r1 r2; right. Qed. #[global] Hint Immediate Req_le_sym: real. (* TODO: We may want to deprecate it but cannot because of the hint used in external libs (the stdlib can already be compiled without it) *) Lemma Req_ge_sym : forall r1 r2, r2 = r1 -> r1 >= r2. Proof. now intros r1 r2; right. Qed. #[global] Hint Immediate Req_ge_sym: real. (** *** Asymmetry *) (** Remark: [Rlt_asym] is in [Raxioms.v] *) #[export] Instance Rlt_Asymmetric : Asymmetric Rlt | 10 := Rlt_asym. Lemma Rgt_asym : forall r1 r2, r1 > r2 -> ~ r2 > r1. Proof. now intros r1 r2; apply Rlt_asym. Qed. #[export] Instance Rgt_Asymmetric : Asymmetric Rgt | 10 := Rgt_asym. (** *** Antisymmetry *) Lemma Rle_antisym : forall r1 r2, r1 <= r2 -> r2 <= r1 -> r1 = r2. Proof. intros r1 r2 [Hlt | Heq] [Hgt | Heq']; try easy. now exfalso; apply (Rlt_asym r1 r2). Qed. #[global] Hint Resolve Rle_antisym: real. #[export] Instance Rle_Antisymmetric : Antisymmetric R eq Rle | 10 := Rle_antisym. Lemma Rge_antisym : forall r1 r2, r1 >= r2 -> r2 >= r1 -> r1 = r2. Proof. now intros r1 r2 H1%Rge_le H2%Rge_le; apply Rle_antisym. Qed. #[export] Instance Rge_Antisymmetric : Antisymmetric R eq Rge | 10 := Rge_antisym. Lemma Rle_le_eq : forall r1 r2, r1 <= r2 /\ r2 <= r1 <-> r1 = r2. Proof. intros r1 r2; split. - now intros [H1 H2]; apply Rle_antisym. - now intros ->; split; apply Rle_refl. Qed. Lemma Rge_ge_eq : forall r1 r2, r1 >= r2 /\ r2 >= r1 <-> r1 = r2. Proof. intros r1 r2; split. - now intros [H1 H2]; apply Rge_antisym. - now intros ->; split; apply Rge_refl. Qed. (** *** Compatibility with equality *) Lemma Rlt_eq_compat : forall r1 r2 r3 r4, r1 = r2 -> r2 < r4 -> r4 = r3 -> r1 < r3. Proof. now intros r1 r2 r3 r4 -> Hlt <-. Qed. Lemma Rgt_eq_compat : forall r1 r2 r3 r4, r1 = r2 -> r2 > r4 -> r4 = r3 -> r1 > r3. Proof. now intros r1 r2 r3 r4 -> Hgt <-. Qed. (** *** Transitivity *) (** Remark: [Rlt_trans] is in Raxioms *) #[export] Instance Rlt_Transitive : Transitive Rlt | 10 := Rlt_trans. Lemma Rle_trans : forall r1 r2 r3, r1 <= r2 -> r2 <= r3 -> r1 <= r3. Proof. intros r1 r2 r3 [Hlt | ->]; try easy. intros [Hlt' | ->]. - now left; apply (Rlt_trans _ r2). - now left. Qed. #[export] Instance Rle_Transitive : Transitive Rle | 10 := Rle_trans. Lemma Rge_trans : forall r1 r2 r3, r1 >= r2 -> r2 >= r3 -> r1 >= r3. Proof. intros r1 r2 r3 H1%Rge_le H2%Rge_le. now apply Rle_ge, (Rle_trans _ r2). Qed. #[export] Instance Rge_Transitive : Transitive Rge | 10 := Rge_trans. Lemma Rgt_trans : forall r1 r2 r3, r1 > r2 -> r2 > r3 -> r1 > r3. Proof. now intros r1 r2 r3 H H'; apply (Rlt_trans _ r2). Qed. #[export] Instance Rgt_Transitive : Transitive Rgt | 10 := Rgt_trans. Lemma Rle_lt_trans : forall r1 r2 r3, r1 <= r2 -> r2 < r3 -> r1 < r3. Proof. now intros r1 r2 r3 [Hlt | ->]; try easy; apply (Rlt_trans _ r2). Qed. Lemma Rlt_le_trans : forall r1 r2 r3, r1 < r2 -> r2 <= r3 -> r1 < r3. Proof. now intros r1 r2 r3 H1 [Hlt | ->]; try easy; apply (Rlt_trans _ r2). Qed. Lemma Rge_gt_trans : forall r1 r2 r3, r1 >= r2 -> r2 > r3 -> r1 > r3. Proof. now intros r1 r2 r3 H1%Rge_le H2%Rgt_lt; apply (Rlt_le_trans _ r2). Qed. Lemma Rgt_ge_trans : forall r1 r2 r3, r1 > r2 -> r2 >= r3 -> r1 > r3. Proof. now intros r1 r2 r3 H1%Rgt_lt H2%Rge_le; apply (Rle_lt_trans _ r2). Qed. (** *** (Classical) decidability with sumbool types *) Lemma Rlt_dec : forall r1 r2, {r1 < r2} + {~ r1 < r2}. Proof. intros r1 r2; destruct (total_order_T r1 r2) as [[Hlt | Heq] | Hgt]. - now left. - now right; apply Rge_not_lt; right. - now right; apply Rge_not_lt; left. Qed. Lemma Rle_dec : forall r1 r2, {r1 <= r2} + {~ r1 <= r2}. Proof. intros r1 r2; destruct (Rlt_dec r2 r1) as [H%Rlt_not_le | H%Rnot_lt_le]. - now right. - now left. Qed. Lemma Rgt_dec : forall r1 r2, {r1 > r2} + {~ r1 > r2}. Proof. now intros r1 r2; apply Rlt_dec. Qed. Lemma Rge_dec : forall r1 r2, {r1 >= r2} + {~ r1 >= r2}. Proof. intros r1 r2; destruct (Rlt_dec r1 r2) as [H%Rlt_not_ge | H%Rnot_lt_ge]. - now right. - now left. Qed. Lemma Rlt_le_dec : forall r1 r2, {r1 < r2} + {r2 <= r1}. Proof. intros r1 r2; destruct (Rlt_dec r1 r2) as [Hlt | H%Rnot_lt_le]. - now left. - now right. Qed. Lemma Rlt_ge_dec : forall r1 r2, {r1 < r2} + {r1 >= r2}. Proof. intros r1 r2; destruct (Rlt_le_dec r1 r2) as [Hlt | H%Rle_ge]. - now left. - now right. Qed. Lemma Rgt_ge_dec : forall r1 r2, {r1 > r2} + {r2 >= r1}. Proof. intros r1 r2; destruct (Rgt_dec r1 r2) as [Hgt | H%Rnot_gt_ge]. - now left. - now right. Qed. Lemma Rgt_le_dec : forall r1 r2, {r1 > r2} + {r1 <= r2}. Proof. intros r1 r2; destruct (Rgt_ge_dec r1 r2) as [Hgt | H%Rge_le]. - now left. - now right. Qed. Lemma Rle_lt_dec : forall r1 r2, {r1 <= r2} + {r2 < r1}. Proof. intros r1 r2; destruct (Rle_dec r1 r2) as [Hle | H%Rnot_le_lt]. - now left. - now right. Qed. Lemma Rle_gt_dec : forall r1 r2, {r1 <= r2} + {r1 > r2}. Proof. intros r1 r2; destruct (Rle_lt_dec r1 r2) as [Hle | H%Rlt_gt]. - now left. - now right. Qed. Lemma Rge_gt_dec : forall r1 r2, {r1 >= r2} + {r2 > r1}. Proof. intros r1 r2; destruct (Rle_dec r2 r1) as [Hle | H%Rnot_le_lt]. - now left; apply Rle_ge. - now right; apply Rlt_gt. Qed. Lemma Rge_lt_dec : forall r1 r2, {r1 >= r2} + {r1 < r2}. Proof. intros r1 r2; destruct (Rge_gt_dec r1 r2) as [Hge | H%Rgt_lt]. - now left. - now right. Qed. Lemma Rle_lt_or_eq_dec : forall r1 r2, r1 <= r2 -> {r1 < r2} + {r1 = r2}. Proof. intros r1 r2 H; destruct (total_order_T r1 r2) as [[Hlt | Heq] | Hgt]. - now left. - now right. - now exfalso; apply (Rgt_not_le r1 r2). Qed. Lemma Rge_gt_or_eq_dec : forall r1 r2, r1 >= r2 -> {r1 > r2} + {r1 = r2}. Proof. intros r1 r2 H%Rge_le. now destruct (Rle_lt_or_eq_dec r2 r1 H) as [Hle | Heq]; [left | right]. Qed. (** *** Same theorems with disjunctions instead of sumbools *) (* TODO: add this to [Init/Specif.v] ? *) Lemma Private_sumbool_to_or {A B : Prop} : {A} + {B} -> A \/ B. Proof. now intros [HA | HB]; [left | right]. Qed. Lemma Rlt_or_not_lt : forall r1 r2, r1 < r2 \/ ~(r1 < r2). Proof. now intros r1 r2; apply Private_sumbool_to_or, Rlt_dec. Qed. Lemma Rle_or_not_le : forall r1 r2, r1 <= r2 \/ ~(r1 <= r2). Proof. now intros r1 r2; apply Private_sumbool_to_or, Rle_dec. Qed. Lemma Rgt_or_not_gt : forall r1 r2, r1 > r2 \/ ~(r1 > r2). Proof. now intros r1 r2; apply Private_sumbool_to_or, Rgt_dec. Qed. Lemma Rge_or_not_ge : forall r1 r2, r1 >= r2 \/ ~(r1 >= r2). Proof. now intros r1 r2; apply Private_sumbool_to_or, Rge_dec. Qed. Lemma Rlt_or_le : forall r1 r2, r1 < r2 \/ r2 <= r1. Proof. now intros r1 r2; apply Private_sumbool_to_or, Rlt_le_dec. Qed. Lemma Rgt_or_ge : forall r1 r2, r1 > r2 \/ r2 >= r1. Proof. now intros r1 r2; apply Private_sumbool_to_or, Rgt_ge_dec. Qed. Lemma Rle_or_lt : forall r1 r2, r1 <= r2 \/ r2 < r1. Proof. now intros r1 r2; apply Private_sumbool_to_or, Rle_lt_dec. Qed. Lemma Rge_or_gt : forall r1 r2, r1 >= r2 \/ r2 > r1. Proof. now intros r1 r2; apply Private_sumbool_to_or, Rge_gt_dec. Qed. Lemma Rlt_or_ge : forall r1 r2, r1 < r2 \/ r1 >= r2. Proof. now intros r1 r2; apply Private_sumbool_to_or, Rlt_ge_dec. Qed. Lemma Rgt_or_le : forall r1 r2, r1 > r2 \/ r1 <= r2. Proof. now intros r1 r2; apply Private_sumbool_to_or, Rgt_le_dec. Qed. Lemma Rle_or_gt : forall r1 r2, r1 <= r2 \/ r1 > r2. Proof. now intros r1 r2; apply Private_sumbool_to_or, Rle_gt_dec. Qed. Lemma Rge_or_lt : forall r1 r2, r1 >= r2 \/ r1 < r2. Proof. now intros r1 r2; apply Private_sumbool_to_or, Rge_lt_dec. Qed. Lemma Rle_lt_or_eq : forall r1 r2, r1 <= r2 -> r1 < r2 \/ r1 = r2. Proof. now intros r1 r2 H; apply Private_sumbool_to_or, Rle_lt_or_eq_dec. Qed. Lemma Rge_gt_or_eq : forall r1 r2, r1 >= r2 -> r1 > r2 \/ r1 = r2. Proof. now intros r1 r2 H; apply Private_sumbool_to_or, Rge_gt_or_eq_dec. Qed. (*********************************************************) (** ** Addition *) (*********************************************************) Lemma Rplus_eq_compat_l : forall r r1 r2, r1 = r2 -> r + r1 = r + r2. Proof. now intros r r1 r2 H; f_equal. Qed. Lemma Rplus_eq_compat_r : forall r r1 r2, r1 = r2 -> r1 + r = r2 + r. Proof. now intros r r1 r2 H; f_equal. Qed. (** Remark: the following primitive lemmas are in [Raxioms.v] - [Rplus_0_l]; - [Rplus_comm]; - [Rplus_opp_r] and - [Rplus_assoc] *) Lemma Rplus_0_r : forall r, r + 0 = r. Proof. now intros r; rewrite Rplus_comm, Rplus_0_l. Qed. #[global] Hint Resolve Rplus_0_r: real. Lemma Rplus_ne : forall r, r + 0 = r /\ 0 + r = r. Proof. now intros r; split; [apply Rplus_0_r | apply Rplus_0_l]. Qed. #[global] Hint Resolve Rplus_ne: real. Lemma Rplus_opp_l : forall r, - r + r = 0. Proof. now intros r; rewrite Rplus_comm; apply Rplus_opp_r. Qed. #[global] Hint Resolve Rplus_opp_l: real. Lemma Rplus_opp_r_uniq : forall r1 r2, r1 + r2 = 0 -> r2 = - r1. Proof. intros r1 r2 H%(Rplus_eq_compat_l (- r1)). now rewrite <-Rplus_assoc, Rplus_opp_l, Rplus_0_l, Rplus_0_r in H. Qed. Definition f_equal_R := (f_equal (A:=R)). #[global] Hint Resolve f_equal_R : real. Lemma Rplus_eq_reg_l : forall r r1 r2, r + r1 = r + r2 -> r1 = r2. Proof. intros r r1 r2 H%(Rplus_eq_compat_l (- r)). now rewrite <-2Rplus_assoc, Rplus_opp_l, 2Rplus_0_l in H. Qed. #[global] Hint Resolve Rplus_eq_reg_l: real. Lemma Rplus_eq_reg_r : forall r r1 r2, r1 + r = r2 + r -> r1 = r2. Proof. intros r r1 r2 H; rewrite 2(Rplus_comm _ r) in H. now apply (Rplus_eq_reg_l r). Qed. Lemma Rplus_0_r_uniq : forall r r1, r + r1 = r -> r1 = 0. Proof. now intros r r1; rewrite <-(Rplus_0_r r) at 2; apply Rplus_eq_reg_l. Qed. Lemma Rplus_0_l_uniq : forall r r1, r1 + r = r -> r1 = 0. Proof. now intros r r1; rewrite Rplus_comm; apply Rplus_0_r_uniq. Qed. (*********************************************************) (** ** Opposite *) (*********************************************************) Lemma Ropp_eq_compat : forall r1 r2, r1 = r2 -> - r1 = - r2. Proof. now intros r1 r2 H; f_equal. Qed. #[global] Hint Resolve Ropp_eq_compat: real. Lemma Ropp_0 : -0 = 0. Proof. now apply (Rplus_0_r_uniq 0), Rplus_opp_r. Qed. #[global] Hint Resolve Ropp_0: real. Lemma Ropp_eq_0_compat : forall r, r = 0 -> - r = 0. Proof. now intros r ->; apply Ropp_0. Qed. #[global] Hint Resolve Ropp_eq_0_compat: real. Lemma Ropp_involutive : forall r, - - r = r. Proof. now intros r; symmetry; apply (Rplus_opp_r_uniq (- r)), Rplus_opp_l. Qed. #[global] Hint Resolve Ropp_involutive: real. Lemma Ropp_eq_reg : forall r1 r2, - r1 = - r2 -> r1 = r2. Proof. intros r1 r2 H; rewrite <-(Ropp_involutive r1), <-(Ropp_involutive r2). now apply Ropp_eq_compat. Qed. Lemma Ropp_neq_0_compat : forall r, r <> 0 -> - r <> 0. Proof. intros r H H'%Ropp_eq_compat. now rewrite Ropp_involutive, Ropp_0 in H'. Qed. #[global] Hint Resolve Ropp_neq_0_compat: real. Lemma Ropp_plus_distr : forall r1 r2, - (r1 + r2) = - r1 + - r2. Proof. intros r1 r2; symmetry. apply Rplus_opp_r_uniq. rewrite (Rplus_comm r1), Rplus_assoc, <-(Rplus_assoc r1), Rplus_opp_r. now rewrite Rplus_0_l, Rplus_opp_r. Qed. #[global] Hint Resolve Ropp_plus_distr: real. (*********************************************************) (** ** Multiplication *) (*********************************************************) Lemma Rmult_eq_compat_l : forall r r1 r2, r1 = r2 -> r * r1 = r * r2. Proof. now intros r r1 r2 H; f_equal. Qed. Lemma Rmult_eq_compat_r : forall r r1 r2, r1 = r2 -> r1 * r = r2 * r. Proof. now intros r r1 r2 H; f_equal. Qed. (** Remark: the following primitive lemmas are in [Raxioms.v] - [Rmult_comm]; - [Rinv_l]; - [Rmult_assoc]; - [Rmult_1_l] and - [Rmult_plus_distr_l] *) Lemma Rinv_r : forall r, r <> 0 -> r * / r = 1. Proof. now intros r H; rewrite Rmult_comm, Rinv_l. Qed. #[global] Hint Resolve Rinv_r: real. (* TODO: We may want to deprecate it but cannot because of the hint used in external libs (the stdlib can already be compiled without it) *) Lemma Rinv_l_sym : forall r, r <> 0 -> 1 = / r * r. Proof. now intros r H; symmetry; apply Rinv_l. Qed. #[global] Hint Resolve Rinv_l_sym: real. (* TODO: We may want to deprecate it but cannot because of the hint used in external libs (the stdlib can already be compiled without it) *) Lemma Rinv_r_sym : forall r, r <> 0 -> 1 = r * / r. Proof. now intros r H; symmetry; apply Rinv_r. Qed. #[global] Hint Resolve Rinv_r_sym: real. (* For consistency with Rplus_opp_r and Rplus_opp_l. *) Definition Rmult_inv_r := Rinv_r. Definition Rmult_inv_l := Rinv_l. Lemma Rmult_1_r : forall r, r * 1 = r. Proof. now intros r; rewrite Rmult_comm, Rmult_1_l. Qed. #[global] Hint Resolve Rmult_1_r: real. Lemma Rmult_ne : forall r, r * 1 = r /\ 1 * r = r. Proof. now intros r; split; [apply Rmult_1_r | apply Rmult_1_l]. Qed. #[global] Hint Resolve Rmult_ne: real. Lemma Rmult_eq_reg_l : forall r r1 r2, r * r1 = r * r2 -> r <> 0 -> r1 = r2. Proof. intros r r1 r2 H r_not_0. apply (Rmult_eq_compat_l (/ r)) in H. now rewrite <-2Rmult_assoc, Rinv_l, 2Rmult_1_l in H. Qed. Lemma Rmult_eq_reg_r : forall r r1 r2, r1 * r = r2 * r -> r <> 0 -> r1 = r2. Proof. intros r r1 r2 H1 H2. apply Rmult_eq_reg_l with (2 := H2). now rewrite 2!(Rmult_comm r). Qed. Lemma Rmult_plus_distr_r : forall r1 r2 r3, (r1 + r2) * r3 = r1 * r3 + r2 * r3. Proof. intros r1 r2 r3. now rewrite 3(Rmult_comm _ r3); apply Rmult_plus_distr_l. Qed. Lemma Rmult_0_r : forall r, r * 0 = 0. Proof. intros r; apply (Rplus_eq_reg_l r). rewrite <-(Rmult_1_r r) at 1; rewrite <-Rmult_plus_distr_l. now rewrite 2Rplus_0_r, Rmult_1_r. Qed. #[global] Hint Resolve Rmult_0_r: real. Lemma Rmult_0_l : forall r, 0 * r = 0. Proof. now intros r; rewrite Rmult_comm, Rmult_0_r. Qed. #[global] Hint Resolve Rmult_0_l: real. Lemma Rmult_integral : forall r1 r2, r1 * r2 = 0 -> r1 = 0 \/ r2 = 0. Proof. intros; destruct (Req_dec r1 0) as [Hz | Hnz]; [left | right]; try easy. apply (Rmult_eq_compat_l (/ r1)) in H. now rewrite <-Rmult_assoc, Rinv_l, Rmult_1_l, Rmult_0_r in H. Qed. Lemma Rmult_eq_0_compat : forall r1 r2, r1 = 0 \/ r2 = 0 -> r1 * r2 = 0. Proof. now intros r1 r2 [-> | ->]; [apply Rmult_0_l | apply Rmult_0_r]. Qed. #[global] Hint Resolve Rmult_eq_0_compat: real. Lemma Rmult_eq_0_compat_r : forall r1 r2, r1 = 0 -> r1 * r2 = 0. Proof. now intros r1 r2 ->; apply Rmult_0_l. Qed. Lemma Rmult_eq_0_compat_l : forall r1 r2, r2 = 0 -> r1 * r2 = 0. Proof. now intros r1 r2 ->; apply Rmult_0_r. Qed. Lemma Rmult_neq_0_reg : forall r1 r2, r1 * r2 <> 0 -> r1 <> 0 /\ r2 <> 0. Proof. intros r1 r2 H; split; intros Heq0; rewrite Heq0 in H. - now rewrite Rmult_0_l in H. - now rewrite Rmult_0_r in H. Qed. Lemma Rmult_integral_contrapositive : forall r1 r2, r1 <> 0 /\ r2 <> 0 -> r1 * r2 <> 0. Proof. now intros r1 r2 [H1 H2] [r10 | r20]%Rmult_integral. Qed. #[global] Hint Resolve Rmult_integral_contrapositive: real. Lemma Rmult_integral_contrapositive_currified : forall r1 r2, r1 <> 0 -> r2 <> 0 -> r1 * r2 <> 0. Proof. now intros r1 r2 H1 H2; apply Rmult_integral_contrapositive. Qed. (*********************************************************) (** ** Opposite and multiplication *) (*********************************************************) Lemma Ropp_mult_distr_l : forall r1 r2, - (r1 * r2) = - r1 * r2. Proof. intros r1 r2; symmetry; apply Rplus_opp_r_uniq. now rewrite <-Rmult_plus_distr_r, Rplus_opp_r, Rmult_0_l. Qed. Lemma Ropp_mult_distr_r : forall r1 r2, - (r1 * r2) = r1 * - r2. Proof. now intros r1 r2; rewrite 2(Rmult_comm r1); apply Ropp_mult_distr_l. Qed. Lemma Ropp_mult_distr_l_reverse : forall r1 r2, - r1 * r2 = - (r1 * r2). Proof. now intros r1 r2; symmetry; apply Ropp_mult_distr_l. Qed. #[global] Hint Resolve Ropp_mult_distr_l_reverse: real. Lemma Rmult_opp_opp : forall r1 r2, - r1 * - r2 = r1 * r2. Proof. intros r1 r2. now rewrite <-Ropp_mult_distr_l, <-Ropp_mult_distr_r, Ropp_involutive. Qed. #[global] Hint Resolve Rmult_opp_opp: real. Lemma Ropp_mult_distr_r_reverse : forall r1 r2, r1 * - r2 = - (r1 * r2). Proof. now intros r1 r2; symmetry; apply Ropp_mult_distr_r. Qed. (*********************************************************) (** ** Subtraction *) (*********************************************************) Lemma Rminus_def : forall r1 r2, r1 - r2 = r1 + - r2. Proof. now unfold Rminus. Qed. Lemma Rminus_eq_compat_l : forall r r1 r2, r1 = r2 -> r - r1 = r - r2. Proof. now unfold Rminus; intros r r1 r2 H%Ropp_eq_compat; apply Rplus_eq_compat_l. Qed. Lemma Rminus_eq_compat_r : forall r r1 r2, r1 = r2 -> r1 - r = r2 - r. Proof. now unfold Rminus; intros r r1 r2;apply Rplus_eq_compat_r. Qed. Lemma Rminus_eq_reg_l : forall r r1 r2, r - r1 = r - r2 -> r1 = r2. Proof. now unfold Rminus; intros r r1 r2 H%Rplus_eq_reg_l; apply Ropp_eq_reg. Qed. Lemma Rminus_eq_reg_r : forall r r1 r2, r1 - r = r2 - r -> r1 = r2. Proof. now unfold Rminus; intros r r1 r2; apply Rplus_eq_reg_r. Qed. Lemma Rminus_0_r : forall r, r - 0 = r. Proof. now unfold Rminus; intros r; rewrite Ropp_0, Rplus_0_r. Qed. #[global] Hint Resolve Rminus_0_r: real. Lemma Rminus_0_l : forall r, 0 - r = - r. Proof. now unfold Rminus; intros r; rewrite Rplus_0_l. Qed. #[global] Hint Resolve Rminus_0_l: real. Lemma Ropp_minus_distr : forall r1 r2, - (r1 - r2) = r2 - r1. Proof. unfold Rminus; intros r1 r2. now rewrite Ropp_plus_distr, Ropp_involutive, Rplus_comm. Qed. #[global] Hint Resolve Ropp_minus_distr: real. Lemma Rminus_diag_eq : forall r1 r2, r1 = r2 -> r1 - r2 = 0. Proof. now unfold Rminus; intros r1 r2 ->; rewrite Rplus_opp_r. Qed. #[global] Hint Resolve Rminus_diag_eq: real. Lemma Rminus_diag : forall r, r - r = 0. Proof. now intros r; apply Rminus_diag_eq. Qed. Lemma Rminus_diag_uniq : forall r1 r2, r1 - r2 = 0 -> r1 = r2. Proof. unfold Rminus; intros r1 r2 H%(Rplus_eq_compat_r r2). now rewrite Rplus_assoc, Rplus_opp_l, Rplus_0_l, Rplus_0_r in H. Qed. #[global] Hint Immediate Rminus_diag_uniq: real. (* TODO: We may want to deprecate it but cannot because of the hint used in external libs (the stdlib can already be compiled without it) *) Lemma Rminus_diag_uniq_sym : forall r1 r2, r2 - r1 = 0 -> r1 = r2. Proof. now intros r1 r2; symmetry;apply Rminus_diag_uniq. Qed. #[global] Hint Immediate Rminus_diag_uniq_sym: real. Lemma Rplus_minus : forall r1 r2, r1 + (r2 - r1) = r2. Proof. unfold Rminus; intros r1 r2. now rewrite Rplus_comm, Rplus_assoc, Rplus_opp_l, Rplus_0_r. Qed. #[global] Hint Resolve Rplus_minus: real. Lemma Rminus_eq_contra : forall r1 r2, r1 <> r2 -> r1 - r2 <> 0. Proof. now intros r1 r2 H H0%Rminus_diag_uniq. Qed. #[global] Hint Resolve Rminus_eq_contra: real. Lemma Rminus_not_eq : forall r1 r2, r1 - r2 <> 0 -> r1 <> r2. Proof. now intros r1 r2 H Heq; apply H, Rminus_diag_eq. Qed. #[global] Hint Resolve Rminus_not_eq: real. (* TODO: We may want to deprecate it but cannot because of the hint used in external libs (the stdlib can already be compiled without it) *) Lemma Rminus_not_eq_right : forall r1 r2, r2 - r1 <> 0 -> r1 <> r2. Proof. now intros r1 r2 H; apply not_eq_sym, Rminus_not_eq. Qed. #[global] Hint Resolve Rminus_not_eq_right: real. Lemma Rmult_minus_distr_l : forall r1 r2 r3, r1 * (r2 - r3) = r1 * r2 - r1 * r3. Proof. unfold Rminus; intros r1 r2 r3; rewrite Rmult_plus_distr_l. now rewrite Ropp_mult_distr_r. Qed. Lemma Rmult_minus_distr_r : forall r1 r2 r3, (r2 - r3) * r1 = r2 * r1 - r3 * r1. Proof. intros r1 r2 r3; rewrite 3(Rmult_comm _ r1). now apply Rmult_minus_distr_l. Qed. Lemma Rplus_minus_r : forall r1 r2, r1 + r2 - r2 = r1. Proof. now intros r1 r2; unfold Rminus; rewrite Rplus_assoc, Rplus_opp_r, Rplus_0_r. Qed. Lemma Rplus_minus_l : forall r1 r2, r1 + r2 - r1 = r2. Proof. now intros r1 r2; rewrite Rplus_comm, Rplus_minus_r. Qed. Lemma Rplus_minus_assoc : forall r1 r2 r3, r1 + (r2 - r3) = (r1 + r2) - r3. Proof. now unfold Rminus; intros r1 r2 r3; rewrite Rplus_assoc. Qed. Lemma Rplus_minus_swap : forall r1 r2 r3, (r1 + r2) - r3 = (r1 - r3) + r2. Proof. unfold Rminus; intros r1 r2 r3. now rewrite Rplus_assoc, (Rplus_comm r2), <-Rplus_assoc. Qed. Lemma Rminus_plus_distr : forall r1 r2 r3, r1 - (r2 + r3) = (r1 - r2) - r3. Proof. now unfold Rminus; intros r1 r2 r3; rewrite Ropp_plus_distr, Rplus_assoc. Qed. Lemma Rminus_plus_r_r : forall r r1 r2, (r1 + r) - (r2 + r) = r1 - r2. Proof. intros r r1 r2; rewrite Rminus_plus_distr, Rplus_comm. now rewrite <-Rplus_minus_assoc, Rplus_minus_l. Qed. Lemma Rminus_plus_l_r : forall r r1 r2, (r + r1) - (r2 + r) = r1 - r2. Proof. now intros r r1 r2; rewrite (Rplus_comm r), Rminus_plus_r_r. Qed. Lemma Rminus_plus_r_l : forall r r1 r2, (r1 + r) - (r + r2) = r1 - r2. Proof. now intros r r1 r2; rewrite (Rplus_comm r), Rminus_plus_r_r. Qed. Lemma Rminus_plus_l_l : forall r r1 r2, (r + r1) - (r + r2) = r1 - r2. Proof. now intros r r1 r2; rewrite (Rplus_comm _ r1), Rminus_plus_r_l. Qed. (*********************************************************) (** ** Inverse *) (*********************************************************) Lemma Rinv_0 : / 0 = 0. Proof. rewrite RinvImpl.Rinv_def. destruct (Req_appart_dec 0 R0) as [eq0 | [lt0 | gt0]]; try easy; now exfalso; apply (Rlt_irrefl 0). Qed. Lemma Rmult_inv_r_uniq : forall r1 r2, r1 <> 0 -> r1 * r2 = 1 -> r2 = / r1. Proof. intros r1 r2 Hn0 H%(Rmult_eq_compat_l (/ r1)). now rewrite <-Rmult_assoc, Rinv_l, Rmult_1_r, Rmult_1_l in H. Qed. Lemma Rinv_eq_compat : forall r1 r2, r1 = r2 -> / r1 = / r2. Proof. now intros r1 r2 H; f_equal. Qed. Lemma Rinv_1 : / 1 = 1. Proof. symmetry; apply Rmult_inv_r_uniq. - exact R1_neq_R0. - now rewrite Rmult_1_r. Qed. #[global] Hint Resolve Rinv_1: real. Lemma Rinv_neq_0_compat : forall r, r <> 0 -> / r <> 0. Proof. intros r H H'; apply R1_neq_R0. now rewrite <-(Rinv_l r), H', Rmult_0_l. Qed. #[global] Hint Resolve Rinv_neq_0_compat: real. Lemma Rinv_inv r : / / r = r. Proof. destruct (Req_dec r 0) as [-> | H]. - now rewrite Rinv_0, Rinv_0. - symmetry; apply Rmult_inv_r_uniq. * now apply Rinv_neq_0_compat. * now rewrite Rinv_l. Qed. #[global] Hint Resolve Rinv_inv: real. Lemma Rinv_eq_reg : forall r1 r2, / r1 = / r2 -> r1 = r2. Proof. now intros r1 r2 H%Rinv_eq_compat; rewrite !Rinv_inv in H. Qed. Lemma Rinv_mult r1 r2 : / (r1 * r2) = / r1 * / r2. Proof. destruct (Req_dec r1 0) as [-> | H1]. - now rewrite Rinv_0, 2!Rmult_0_l, Rinv_0. - destruct (Req_dec r2 0) as [-> | H2]. + now rewrite Rinv_0, 2!Rmult_0_r, Rinv_0. + symmetry; apply Rmult_inv_r_uniq. { now apply Rmult_integral_contrapositive_currified. } rewrite (Rmult_comm r1), Rmult_assoc, <-(Rmult_assoc r1). now rewrite Rinv_r, Rmult_1_l, Rinv_r. Qed. Lemma Rinv_opp r : / - r = - / r. Proof. destruct (Req_dec r 0) as [-> | H]. - now rewrite Ropp_0, Rinv_0, Ropp_0. - symmetry; apply Rmult_inv_r_uniq. { now apply Ropp_neq_0_compat. } now rewrite Rmult_opp_opp, Rinv_r. Qed. Lemma Rmult_inv_m_id_r : forall r1 r2, r1 <> 0 -> r1 * / r1 * r2 = r2. Proof. now intros r1 r2 r1n0; rewrite Rinv_r, Rmult_1_l. Qed. Lemma Rmult_inv_r_id_l : forall r1 r2, r1 <> 0 -> r2 * r1 * / r1 = r2. Proof. now intros r1 r2 r1n0; rewrite Rmult_assoc, Rinv_r, Rmult_1_r. Qed. Lemma Rmult_inv_r_id_m : forall r1 r2, r1 <> 0 -> r1 * r2 * / r1 = r2. Proof. now intros r1 r2 r1n0; rewrite (Rmult_comm r1), Rmult_inv_r_id_l. Qed. #[global] Hint Resolve Rmult_inv_m_id_r Rmult_inv_r_id_l Rmult_inv_r_id_m: real. (*********************************************************) (** ** Square function *) (*********************************************************) Definition Rsqr r : R := r * r. Notation "r ²" := (Rsqr r) (at level 1, format "r ²") : R_scope. (* Useful to fold Rsqr *) Lemma Rsqr_def : forall r, r² = r * r. Proof. now unfold Rsqr; intros r. Qed. Lemma Rsqr_0 : Rsqr 0 = 0. Proof. now unfold Rsqr; apply Rmult_0_r. Qed. Lemma Rsqr_0_uniq : forall r, Rsqr r = 0 -> r = 0. Proof. now unfold Rsqr; intros r [-> | ->]%Rmult_integral. Qed. (*********************************************************) (** ** Order and addition *) (*********************************************************) (** *** Compatibility *) (** Remark: [Rplus_lt_compat_l] is in [Raxioms.v] *) Lemma Rplus_gt_compat_l : forall r r1 r2, r1 > r2 -> r + r1 > r + r2. Proof. now intros r r1 r2; apply Rplus_lt_compat_l. Qed. #[global] Hint Resolve Rplus_gt_compat_l: real. Lemma Rplus_lt_compat_r : forall r r1 r2, r1 < r2 -> r1 + r < r2 + r. Proof. intros r r1 r2 r1_lt_r2; rewrite (Rplus_comm r1), (Rplus_comm r2). now apply Rplus_lt_compat_l. Qed. #[global] Hint Resolve Rplus_lt_compat_r: real. Lemma Rplus_gt_compat_r : forall r r1 r2, r1 > r2 -> r1 + r > r2 + r. Proof. now intros r r1 r2; apply Rplus_lt_compat_r. Qed. Lemma Rplus_le_compat_l : forall r r1 r2, r1 <= r2 -> r + r1 <= r + r2. Proof. unfold Rle; intros r r1 r2 [Hlt | ->]. - now left; apply Rplus_lt_compat_l. - now right. Qed. Lemma Rplus_ge_compat_l : forall r r1 r2, r1 >= r2 -> r + r1 >= r + r2. Proof. now intros r r1 r2 H%Rge_le; apply Rle_ge, Rplus_le_compat_l. Qed. #[global] Hint Resolve Rplus_ge_compat_l: real. Lemma Rplus_le_compat_r : forall r r1 r2, r1 <= r2 -> r1 + r <= r2 + r. Proof. intros r r1 r2 H. now rewrite 2(Rplus_comm _ r); apply Rplus_le_compat_l. Qed. #[global] Hint Resolve Rplus_le_compat_l Rplus_le_compat_r: real. Lemma Rplus_ge_compat_r : forall r r1 r2, r1 >= r2 -> r1 + r >= r2 + r. Proof. now intros r r1 r2 H%Rge_le; apply Rle_ge, Rplus_le_compat_r. Qed. Lemma Rplus_lt_compat : forall r1 r2 r3 r4, r1 < r2 -> r3 < r4 -> r1 + r3 < r2 + r4. Proof. intros r1 r2 r3 r4 r1_lt_r2 r3_lt_r4; apply (Rlt_trans _ (r2 + r3)). - now apply Rplus_lt_compat_r. - now apply Rplus_lt_compat_l. Qed. #[global] Hint Immediate Rplus_lt_compat: real. Lemma Rplus_le_compat : forall r1 r2 r3 r4, r1 <= r2 -> r3 <= r4 -> r1 + r3 <= r2 + r4. Proof. intros r1 r2 r3 r4 r1_lt_r2 r3_lt_r4; apply (Rle_trans _ (r2 + r3)). - now apply Rplus_le_compat_r. - now apply Rplus_le_compat_l. Qed. #[global] Hint Immediate Rplus_le_compat: real. Lemma Rplus_gt_compat : forall r1 r2 r3 r4, r1 > r2 -> r3 > r4 -> r1 + r3 > r2 + r4. Proof. now intros r1 r2 r3 r4; apply Rplus_lt_compat. Qed. Lemma Rplus_ge_compat : forall r1 r2 r3 r4, r1 >= r2 -> r3 >= r4 -> r1 + r3 >= r2 + r4. Proof. now intros r1 r2 r3 r4 H1%Rge_le H2%Rge_le; apply Rle_ge, Rplus_le_compat. Qed. Lemma Rplus_lt_le_compat : forall r1 r2 r3 r4, r1 < r2 -> r3 <= r4 -> r1 + r3 < r2 + r4. Proof. intros r1 r2 r3 r4 Hlt Hle; apply (Rlt_le_trans _ (r2 + r3)). - now apply Rplus_lt_compat_r. - now apply Rplus_le_compat_l. Qed. Lemma Rplus_le_lt_compat : forall r1 r2 r3 r4, r1 <= r2 -> r3 < r4 -> r1 + r3 < r2 + r4. Proof. intros r1 r2 r3 r4 H H'; rewrite (Rplus_comm r1), (Rplus_comm r2). now apply Rplus_lt_le_compat. Qed. #[global] Hint Immediate Rplus_lt_le_compat Rplus_le_lt_compat: real. Lemma Rplus_gt_ge_compat : forall r1 r2 r3 r4, r1 > r2 -> r3 >= r4 -> r1 + r3 > r2 + r4. Proof. now intros r1 r2 r3 r4 H H'%Rge_le; apply Rplus_lt_le_compat. Qed. Lemma Rplus_ge_gt_compat : forall r1 r2 r3 r4, r1 >= r2 -> r3 > r4 -> r1 + r3 > r2 + r4. Proof. now intros r1 r2 r3 r4 H%Rge_le H'; apply Rplus_le_lt_compat. Qed. Lemma Rplus_lt_0_compat : forall r1 r2, 0 < r1 -> 0 < r2 -> 0 < r1 + r2. Proof. now intros r1 r2 I I'; rewrite <-(Rplus_0_r 0); apply Rplus_lt_compat. Qed. Lemma Rplus_le_lt_0_compat : forall r1 r2, 0 <= r1 -> 0 < r2 -> 0 < r1 + r2. Proof. now intros r1 r2 I I'; rewrite <-(Rplus_0_r 0); apply Rplus_le_lt_compat. Qed. Lemma Rplus_lt_le_0_compat : forall r1 r2, 0 < r1 -> 0 <= r2 -> 0 < r1 + r2. Proof. now intros r1 r2 I I'; rewrite <-(Rplus_0_r 0); apply Rplus_lt_le_compat. Qed. Lemma Rplus_le_le_0_compat : forall r1 r2, 0 <= r1 -> 0 <= r2 -> 0 <= r1 + r2. Proof. now intros r1 r2 I I'; rewrite <-(Rplus_0_r 0); apply Rplus_le_compat. Qed. Lemma Rplus_eq_0_l : forall r1 r2, 0 <= r1 -> 0 <= r2 -> r1 + r2 = 0 -> r1 = 0. Proof. intros r1 r2 [Hlt | <-]; try easy. intros [Hlt' | <-] H. - exfalso; apply (Rgt_not_eq (r1 + r2) 0); try easy. now rewrite <-(Rplus_0_r 0); apply Rplus_lt_compat. - now rewrite Rplus_0_r in H. Qed. Lemma Rplus_eq_0 : forall r1 r2, 0 <= r1 -> 0 <= r2 -> r1 + r2 = 0 -> r1 = 0 /\ r2 = 0. Proof. intros r1 r2 H1 H2 Hp; split. - now apply (Rplus_eq_0_l _ r2). - now rewrite Rplus_comm in Hp; apply (Rplus_eq_0_l r2 r1). Qed. (** *** Cancellation *) Lemma Rplus_lt_reg_l : forall r r1 r2, r + r1 < r + r2 -> r1 < r2. Proof. intros r r1 r2 H%(Rplus_lt_compat_l (-r)). now rewrite <-2Rplus_assoc, Rplus_opp_l, 2Rplus_0_l in H. Qed. Lemma Rplus_lt_reg_r : forall r r1 r2, r1 + r < r2 + r -> r1 < r2. Proof. intros r r1 r2 H. rewrite (Rplus_comm r1), (Rplus_comm r2) in H. now apply (Rplus_lt_reg_l r). Qed. Lemma Rplus_le_reg_l : forall r r1 r2, r + r1 <= r + r2 -> r1 <= r2. Proof. intros r r1 r2 [Ilt | Eq]. - left; apply (Rplus_lt_reg_l r r1 r2 Ilt). - right; apply (Rplus_eq_reg_l r r1 r2 Eq). Qed. Lemma Rplus_le_reg_r : forall r r1 r2, r1 + r <= r2 + r -> r1 <= r2. Proof. intros r r1 r2 H. now apply (Rplus_le_reg_l r); rewrite 2(Rplus_comm r). Qed. Lemma Rplus_gt_reg_l : forall r r1 r2, r + r1 > r + r2 -> r1 > r2. Proof. now intros r r1 r2 H; apply (Rplus_lt_reg_l r r2 r1 H). Qed. Lemma Rplus_gt_reg_r : forall r r1 r2, r1 + r > r2 + r -> r1 > r2. Proof. now intros r r1 r2 H; apply (Rplus_lt_reg_r r r2 r1 H). Qed. Lemma Rplus_ge_reg_l : forall r r1 r2, r + r1 >= r + r2 -> r1 >= r2. Proof. now intros r r1 r2 H%Rge_le; apply Rle_ge, (Rplus_le_reg_l r). Qed. Lemma Rplus_ge_reg_r : forall r r1 r2, r1 + r >= r2 + r -> r1 >= r2. Proof. now intros r r1 r2 H%Rge_le; apply Rle_ge, (Rplus_le_reg_r r). Qed. Lemma Rplus_le_reg_pos_r : forall r1 r2 r3, 0 <= r2 -> r1 + r2 <= r3 -> r1 <= r3. Proof. intros r1 r2 r3 H H'. apply (Rle_trans _ (r1 + r2)); try easy. now rewrite <-(Rplus_0_r r1) at 1; apply Rplus_le_compat_l. Qed. Lemma Rplus_lt_reg_pos_r : forall r1 r2 r3, 0 <= r2 -> r1 + r2 < r3 -> r1 < r3. Proof. intros r1 r2 r3 H H'. apply (Rle_lt_trans _ (r1 + r2)); try easy. now rewrite <-(Rplus_0_r r1) at 1; apply Rplus_le_compat_l. Qed. Lemma Rplus_ge_reg_neg_r : forall r1 r2 r3, 0 >= r2 -> r1 + r2 >= r3 -> r1 >= r3. Proof. intros r1 r2 r3 H H'. apply (Rge_trans _ (r1 + r2)); try easy. now rewrite <-(Rplus_0_r r1) at 1; apply Rplus_ge_compat_l. Qed. Lemma Rplus_gt_reg_neg_r : forall r1 r2 r3, 0 >= r2 -> r1 + r2 > r3 -> r1 > r3. Proof. intros r1 r2 r3 H H'. apply (Rge_gt_trans _ (r1 + r2)); try easy. now rewrite <-(Rplus_0_r r1) at 1; apply Rplus_ge_compat_l. Qed. Lemma Rplus_le_lt_0_neq_0 : forall r1 r2, 0 <= r1 -> 0 < r2 -> r1 + r2 <> 0. Proof. intros r1 r2 H1 H2; apply not_eq_sym, Rlt_not_eq. now rewrite <-(Rplus_0_l 0); apply Rplus_le_lt_compat. Qed. #[global] Hint Immediate Rplus_le_lt_0_neq_0: real. (** *** Comparison of addition with left operand *) Lemma Rplus_pos_gt : forall r1 r2, r2 > 0 -> r1 + r2 > r1. Proof. now intros r1 r2 H; rewrite <-(Rplus_0_r r1) at 2; apply Rplus_gt_compat_l. Qed. Lemma Rplus_nneg_ge : forall r1 r2, r2 >= 0 -> r1 + r2 >= r1. Proof. now intros r1 r2 H; rewrite <-(Rplus_0_r r1) at 2; apply Rplus_ge_compat_l. Qed. Lemma Rplus_neg_lt : forall r1 r2, r2 < 0 -> r1 + r2 < r1. Proof. now intros r1 r2 H; rewrite <-(Rplus_0_r r1) at 2; apply Rplus_lt_compat_l. Qed. Lemma Rplus_npos_le : forall r1 r2, r2 <= 0 -> r1 + r2 <= r1. Proof. now intros r1 r2 H; rewrite <-(Rplus_0_r r1) at 2; apply Rplus_le_compat_l. Qed. (** *** Sign of addition *) Lemma Rplus_pos_pos : forall r1 r2, r1 > 0 -> r2 > 0 -> r1 + r2 > 0. Proof. now intros r1 r2; apply Rplus_lt_0_compat. Qed. Lemma Rplus_neg_neg : forall r1 r2, r1 < 0 -> r2 < 0 -> r1 + r2 < 0. Proof. now intros r1 r2 H1 H2; rewrite <-(Rplus_0_l 0); apply Rplus_lt_compat. Qed. Lemma Rplus_nneg_nneg : forall r1 r2, r1 >= 0 -> r2 >= 0 -> r1 + r2 >= 0. Proof. now intros r1 r2 H1 H2; rewrite <-(Rplus_0_l 0); apply Rplus_ge_compat. Qed. Lemma Rplus_npos_npos : forall r1 r2, r1 <= 0 -> r2 <= 0 -> r1 + r2 <= 0. Proof. now intros r1 r2 H1 H2; rewrite <-(Rplus_0_l 0); apply Rplus_le_compat. Qed. Lemma Rplus_pos_nneg : forall r1 r2, r1 > 0 -> r2 >= 0 -> r1 + r2 > 0. Proof. now intros r1 r2 H1 H2; rewrite <-(Rplus_0_l 0); apply Rplus_gt_ge_compat. Qed. Lemma Rplus_nneg_pos : forall r1 r2, r1 >= 0 -> r2 > 0 -> r1 + r2 > 0. Proof. now intros r1 r2 H1 H2; rewrite <-(Rplus_0_l 0); apply Rplus_ge_gt_compat. Qed. Lemma Rplus_neg_npos : forall r1 r2, r1 < 0 -> r2 <= 0 -> r1 + r2 < 0. Proof. now intros r1 r2 H1 H2; rewrite <-(Rplus_0_l 0); apply Rplus_lt_le_compat. Qed. Lemma Rplus_npos_neg : forall r1 r2, r1 <= 0 -> r2 < 0 -> r1 + r2 < 0. Proof. now intros r1 r2 H1 H2; rewrite <-(Rplus_0_l 0); apply Rplus_le_lt_compat. Qed. (*********************************************************) (** ** Order and opposite *) (*********************************************************) (** *** Contravariant compatibility *) Lemma Ropp_gt_lt_contravar : forall r1 r2, r1 > r2 -> - r1 < - r2. Proof. intros r1 r2 H. apply (Rplus_lt_reg_l r1), (Rplus_lt_reg_r r2). now rewrite Rplus_opp_r, Rplus_0_l, Rplus_assoc, Rplus_opp_l, Rplus_0_r. Qed. #[global] (* TODO: why core? *) Hint Resolve Ropp_gt_lt_contravar : core. Lemma Ropp_lt_gt_contravar : forall r1 r2, r1 < r2 -> - r1 > - r2. Proof. now intros r1 r2 H; apply Ropp_gt_lt_contravar. Qed. #[global] Hint Resolve Ropp_lt_gt_contravar: real. Lemma Ropp_lt_contravar : forall r1 r2, r2 < r1 -> - r1 < - r2. Proof. now intros r1 r2; apply Ropp_lt_gt_contravar. Qed. #[global] Hint Resolve Ropp_lt_contravar: real. Lemma Ropp_gt_contravar : forall r1 r2, r2 > r1 -> - r1 > - r2. Proof. now intros r1 r2; apply Ropp_lt_gt_contravar. Qed. Lemma Ropp_le_ge_contravar : forall r1 r2, r1 <= r2 -> - r1 >= - r2. Proof. now intros r1 r2 [I | ->]; [left | right; easy]; apply Ropp_lt_contravar. Qed. #[global] Hint Resolve Ropp_le_ge_contravar: real. Lemma Ropp_ge_le_contravar : forall r1 r2, r1 >= r2 -> - r1 <= - r2. Proof. now intros r1 r2 I%Rge_le; apply Rge_le, Ropp_le_ge_contravar. Qed. #[global] Hint Resolve Ropp_ge_le_contravar: real. Lemma Ropp_le_contravar : forall r1 r2, r2 <= r1 -> - r1 <= - r2. Proof. now intros r1 r2 I; apply Rge_le, Ropp_le_ge_contravar. Qed. #[global] Hint Resolve Ropp_le_contravar: real. Lemma Ropp_ge_contravar : forall r1 r2, r2 >= r1 -> - r1 >= - r2. Proof. now intros r1 r2 I; apply Rle_ge, Ropp_ge_le_contravar. Qed. Lemma Ropp_0_lt_gt_contravar : forall r, 0 < r -> 0 > - r. Proof. now intros r I; rewrite <-Ropp_0; apply Ropp_lt_contravar. Qed. #[global] Hint Resolve Ropp_0_lt_gt_contravar: real. Lemma Ropp_0_gt_lt_contravar : forall r, 0 > r -> 0 < - r. Proof. now intros r I; rewrite <-Ropp_0; apply Ropp_lt_contravar. Qed. #[global] Hint Resolve Ropp_0_gt_lt_contravar: real. Lemma Ropp_lt_gt_0_contravar : forall r, r > 0 -> - r < 0. Proof. now intros r I; rewrite <-Ropp_0; apply Ropp_lt_contravar. Qed. #[global] Hint Resolve Ropp_lt_gt_0_contravar: real. Lemma Ropp_gt_lt_0_contravar : forall r, r < 0 -> - r > 0. Proof. now intros r I; rewrite <-Ropp_0; apply Ropp_lt_contravar. Qed. #[global] Hint Resolve Ropp_gt_lt_0_contravar: real. Lemma Ropp_0_le_ge_contravar : forall r, 0 <= r -> 0 >= - r. Proof. now intros r I; rewrite <-Ropp_0; apply Ropp_le_ge_contravar. Qed. #[global] Hint Resolve Ropp_0_le_ge_contravar: real. Lemma Ropp_0_ge_le_contravar : forall r, 0 >= r -> 0 <= - r. Proof. now intros r I; rewrite <-Ropp_0; apply Ropp_ge_le_contravar. Qed. #[global] Hint Resolve Ropp_0_ge_le_contravar: real. (** *** Cancellation *) Lemma Ropp_lt_cancel : forall r1 r2, - r2 < - r1 -> r1 < r2. Proof. now intros r1 r2 I%Ropp_lt_contravar; rewrite 2Ropp_involutive in I. Qed. #[global] Hint Immediate Ropp_lt_cancel: real. Lemma Ropp_gt_cancel : forall r1 r2, - r2 > - r1 -> r1 > r2. Proof. now intros r1 r2; apply Ropp_lt_cancel. Qed. Lemma Ropp_le_cancel : forall r1 r2, - r2 <= - r1 -> r1 <= r2. Proof. now intros r1 r2 I%Ropp_le_contravar; rewrite 2Ropp_involutive in I. Qed. #[global] Hint Immediate Ropp_le_cancel: real. Lemma Ropp_ge_cancel : forall r1 r2, - r2 >= - r1 -> r1 >= r2. Proof. now intros r1 r2 I%Rge_le; apply Rle_ge, Ropp_le_cancel. Qed. (** *** Sign of opposite *) Lemma Ropp_pos : forall r, r > 0 -> - r < 0. Proof. now intros r H; rewrite <-Ropp_0; apply Ropp_lt_contravar. Qed. Lemma Ropp_neg : forall r, r < 0 -> - r > 0. Proof. now intros r H; rewrite <-Ropp_0; apply Ropp_lt_contravar. Qed. (*********************************************************) (** ** Order and multiplication *) (*********************************************************) (** Remark: [Rmult_lt_compat_l] is in [Raxioms.v] *) (** *** Covariant compatibility *) Lemma Rmult_lt_compat_r : forall r r1 r2, 0 < r -> r1 < r2 -> r1 * r < r2 * r. Proof. intros r r1 r2; rewrite 2(Rmult_comm _ r); apply Rmult_lt_compat_l. Qed. #[global] (* TODO: why core? *) Hint Resolve Rmult_lt_compat_r : core. Lemma Rmult_gt_compat_r : forall r r1 r2, r > 0 -> r1 > r2 -> r1 * r > r2 * r. Proof. now intros r r1 r2; apply Rmult_lt_compat_r. Qed. Lemma Rmult_gt_compat_l : forall r r1 r2, r > 0 -> r1 > r2 -> r * r1 > r * r2. Proof. now intros r r1 r2; apply Rmult_lt_compat_l. Qed. Lemma Rmult_le_compat_l : forall r r1 r2, 0 <= r -> r1 <= r2 -> r * r1 <= r * r2. Proof. intros r r1 r2 [I | <-] [I' | ->]; try rewrite 2Rmult_0_l; try apply Rle_refl. now left; apply Rmult_lt_compat_l. Qed. #[global] Hint Resolve Rmult_le_compat_l: real. Lemma Rmult_le_compat_r : forall r r1 r2, 0 <= r -> r1 <= r2 -> r1 * r <= r2 * r. Proof. now intros r r1 r2 H; rewrite 2(Rmult_comm _ r); apply Rmult_le_compat_l. Qed. #[global] Hint Resolve Rmult_le_compat_r: real. Lemma Rmult_ge_compat_l : forall r r1 r2, r >= 0 -> r1 >= r2 -> r * r1 >= r * r2. Proof. now intros r r1 r2 I%Rge_le J%Rge_le; apply Rle_ge, Rmult_le_compat_l. Qed. Lemma Rmult_ge_compat_r : forall r r1 r2, r >= 0 -> r1 >= r2 -> r1 * r >= r2 * r. Proof. now intros r r1 r2; rewrite 2(Rmult_comm _ r); apply Rmult_ge_compat_l. Qed. Lemma Rmult_le_compat : forall r1 r2 r3 r4, 0 <= r1 -> 0 <= r3 -> r1 <= r2 -> r3 <= r4 -> r1 * r3 <= r2 * r4. Proof. intros r1 r2 r3 r4 H1 H2 I J; apply (Rle_trans _ (r2 * r3)). - now apply Rmult_le_compat_r. - assert (H3 : 0 <= r2) by now apply (Rle_trans _ r1). now apply Rmult_le_compat_l. Qed. #[global] Hint Resolve Rmult_le_compat: real. Lemma Rmult_le_pos : forall r1 r2, 0 <= r1 -> 0 <= r2 -> 0 <= r1 * r2. Proof. now intros r1 r2 I I'; rewrite <-(Rmult_0_l 0); apply Rmult_le_compat; try apply Rle_refl. Qed. Lemma Rmult_ge_compat : forall r1 r2 r3 r4, r2 >= 0 -> r4 >= 0 -> r1 >= r2 -> r3 >= r4 -> r1 * r3 >= r2 * r4. Proof. intros r1 r2 r3 r4 H1%Rge_le H2%Rge_le I%Rge_le J%Rge_le; apply Rle_ge. now apply Rmult_le_compat. Qed. Lemma Rmult_ge_0_gt_0_lt_compat : forall r1 r2 r3 r4, r3 >= 0 -> r2 > 0 -> r1 < r2 -> r3 < r4 -> r1 * r3 < r2 * r4. Proof. intros r1 r2 r3 r4 H1%Rge_le H2 I J; apply (Rle_lt_trans _ (r2 * r3)). - now apply Rmult_le_compat_r; try apply (Rlt_le r1). - now apply Rmult_lt_compat_l. Qed. Lemma Rmult_gt_0_lt_compat : forall r1 r2 r3 r4, r3 > 0 -> r2 > 0 -> r1 < r2 -> r3 < r4 -> r1 * r3 < r2 * r4. Proof. now intros r1 r2 r3 r4 H1%Rgt_ge; apply Rmult_ge_0_gt_0_lt_compat. Qed. Lemma Rmult_le_0_lt_compat : forall r1 r2 r3 r4, 0 <= r1 -> 0 <= r3 -> r1 < r2 -> r3 < r4 -> r1 * r3 < r2 * r4. Proof. intros r1 r2 r3 r4 H1 H2 I J; apply Rle_lt_trans with (r2 * r3). - now apply Rlt_le in I; apply Rmult_le_compat_r. - assert (H3 : 0 < r2) by now apply (Rle_lt_trans _ r1). now apply Rmult_lt_compat_l. Qed. (** *** Contravariant compatibility *) Lemma Rmult_le_compat_neg_l : forall r r1 r2, r <= 0 -> r1 <= r2 -> r * r2 <= r * r1. Proof. intros r r1 r2 I%Ropp_le_contravar J; rewrite Ropp_0 in I. now apply Ropp_le_cancel; rewrite 2Ropp_mult_distr_l; apply Rmult_le_compat_l. Qed. #[global] Hint Resolve Rmult_le_compat_neg_l: real. Lemma Rmult_le_ge_compat_neg_l : forall r r1 r2, r <= 0 -> r1 <= r2 -> r * r1 >= r * r2. Proof. now intros r r1 r2 H I; apply Rle_ge, Rmult_le_compat_neg_l. Qed. #[global] Hint Resolve Rmult_le_ge_compat_neg_l: real. Lemma Rmult_lt_gt_compat_neg_l : forall r r1 r2, r < 0 -> r1 < r2 -> r * r1 > r * r2. Proof. intros r r1 r2 I%Ropp_lt_contravar J; rewrite Ropp_0 in I. now apply Ropp_lt_cancel; rewrite 2Ropp_mult_distr_l; apply Rmult_lt_compat_l. Qed. (** *** Sign of multiplication *) Lemma Rmult_lt_0_compat : forall r1 r2, 0 < r1 -> 0 < r2 -> 0 < r1 * r2. Proof. now intros r1 r2 I J; rewrite <-(Rmult_0_l 0); apply Rmult_le_0_lt_compat; try apply Rle_refl. Qed. Lemma Rmult_gt_0_compat : forall r1 r2, r1 > 0 -> r2 > 0 -> r1 * r2 > 0. Proof. exact Rmult_lt_0_compat. Qed. Definition Rmult_pos_pos := Rmult_gt_0_compat. Lemma Rmult_neg_neg : forall r1 r2, r1 < 0 -> r2 < 0 -> r1 * r2 > 0. Proof. intros r1 r2 H1%Ropp_lt_contravar H2%Ropp_lt_contravar. rewrite Ropp_0 in H1, H2; rewrite <-Rmult_opp_opp. now apply Rmult_lt_0_compat. Qed. Lemma Rmult_neg_pos : forall r1 r2, r1 < 0 -> r2 > 0 -> r1 * r2 < 0. Proof. intros r1 r2 H1 H2. now rewrite <-(Rmult_0_r r1); apply Rmult_lt_gt_compat_neg_l. Qed. Lemma Rmult_pos_neg : forall r1 r2, r1 > 0 -> r2 < 0 -> r1 * r2 < 0. Proof. now intros r1 r2 H1 H2; rewrite Rmult_comm; apply Rmult_neg_pos. Qed. Lemma Rmult_pos_cases : forall r1 r2, r1 * r2 > 0 -> (r1 > 0 /\ r2 > 0) \/ (r1 < 0 /\ r2 < 0). Proof. intros r1 r2. destruct (Rtotal_order r1 0) as [Hlt1 | [-> | Hgt1]]; cycle 1. - now intros H; exfalso; rewrite Rmult_0_l in H; apply (Rlt_irrefl 0). - destruct (Rtotal_order r2 0) as [Hlt2 | [-> | Hgt2]]; cycle 1. + now intros H; exfalso; rewrite Rmult_0_r in H; apply (Rlt_irrefl 0). + now intros _; left. + intros H; exfalso; apply (Rgt_not_le (r1 * r2) 0); try easy. now left; apply Rmult_pos_neg. - destruct (Rtotal_order r2 0) as [Hlt2 | [-> | Hgt2]]; cycle 1. + now intros H; exfalso; rewrite Rmult_0_r in H; apply (Rlt_irrefl 0). + intros H; exfalso; apply (Rgt_not_le (r1 * r2) 0); try easy. now left; apply Rmult_neg_pos. + now intros _; right. Qed. Lemma Rmult_neg_cases : forall r1 r2, r1 * r2 < 0 -> (r1 > 0 /\ r2 < 0) \/ (r1 < 0 /\ r2 > 0). Proof. intros r1 r2 H%Ropp_lt_contravar%Rlt_gt. rewrite Ropp_0, Ropp_mult_distr_l in H. apply Rmult_pos_cases in H as [[H1%Ropp_lt_contravar H2] | [H1%Ropp_lt_contravar H2]]. - now right; split; [| assumption]; rewrite Ropp_involutive, Ropp_0 in H1. - now left; split; [| assumption]; rewrite Ropp_involutive, Ropp_0 in H1. Qed. (** *** Order and square function *) Lemma Rle_0_sqr : forall r, 0 <= Rsqr r. Proof. unfold Rsqr; intros r. destruct (Rlt_le_dec r 0) as [Hneg%Ropp_lt_contravar%Rlt_le | Hge0]. - rewrite Ropp_0 in Hneg; rewrite <-Rmult_opp_opp, <-(Rmult_0_l 0). now apply Rmult_le_compat; try apply Rle_refl. - now rewrite <-(Rmult_0_l 0); apply Rmult_le_compat; try apply Rle_refl. Qed. Lemma Rlt_0_sqr : forall r, r <> 0 -> 0 < Rsqr r. Proof. now intros r Hr; destruct (Rle_0_sqr r) as [Hle | Eq%eq_sym%Rsqr_0_uniq]. Qed. #[global] Hint Resolve Rle_0_sqr Rlt_0_sqr: real. Lemma Rplus_sqr_eq_0 : forall r1 r2, Rsqr r1 + Rsqr r2 = 0 -> r1 = 0 /\ r2 = 0. Proof. assert (E : forall r1 r2, Rsqr r1 + Rsqr r2 = 0 -> r1 = 0). { intros r1 r2 H; apply Rsqr_0_uniq, Rplus_eq_0_l with (3 := H); now apply Rle_0_sqr. } intros r1 r2 H; split. - now apply (E _ r2). - now rewrite Rplus_comm in H; apply (E _ r1). Qed. (** *** Zero is less than one *) Lemma Rlt_0_1 : 0 < 1. Proof. now rewrite <-(Rmult_1_r 1), <-Rsqr_def; apply Rlt_0_sqr, R1_neq_R0. Qed. #[global] Hint Resolve Rlt_0_1: real. Lemma Rle_0_1 : 0 <= 1. Proof. left; exact Rlt_0_1. Qed. (** *** Sign of inverse *) Lemma Rinv_0_lt_compat : forall r, 0 < r -> 0 < / r. Proof. intros r Hr. destruct (Rlt_or_le 0 (/ r)) as [Hlt | Hle]; try easy. exfalso; apply (Rle_not_lt 0 1); try apply Rlt_0_1. rewrite <-(Rinv_l r), <-(Rmult_0_r (/ r)); cycle 1. { now apply not_eq_sym, Rlt_not_eq. } now apply Rlt_le in Hr; apply Rmult_le_compat_neg_l. Qed. #[global] Hint Resolve Rinv_0_lt_compat: real. Lemma Rinv_lt_0_compat : forall r, r < 0 -> / r < 0. Proof. intros r H%Ropp_lt_contravar; apply Ropp_lt_cancel. now rewrite Ropp_0 in H |- *; rewrite <-Rinv_opp; apply Rinv_0_lt_compat. Qed. #[global] Hint Resolve Rinv_lt_0_compat: real. (** *** Cancellation in inequalities of products *) Lemma Rmult_lt_reg_l : forall r r1 r2, 0 < r -> r * r1 < r * r2 -> r1 < r2. Proof. intros r r1 r2 Hr I%(Rmult_lt_compat_l (/ r)); try now apply Rinv_0_lt_compat. rewrite <-2(Rmult_assoc (/ r)), Rinv_l, 2Rmult_1_l in I; try easy. now apply not_eq_sym, Rlt_not_eq. Qed. Lemma Rmult_lt_reg_r : forall r r1 r2 : R, 0 < r -> r1 * r < r2 * r -> r1 < r2. Proof. intros r r1 r2 H I; apply (Rmult_lt_reg_l r); try easy. now rewrite 2(Rmult_comm r). Qed. Lemma Rmult_gt_reg_l : forall r r1 r2, 0 < r -> r * r1 < r * r2 -> r1 < r2. Proof. now intros r r1 r2; apply Rmult_lt_reg_l. Qed. Lemma Rmult_gt_reg_r : forall r r1 r2, r > 0 -> r1 * r > r2 * r -> r1 > r2. Proof. now intros r r1 r2; apply Rmult_lt_reg_r. Qed. Lemma Rmult_le_reg_l : forall r r1 r2, 0 < r -> r * r1 <= r * r2 -> r1 <= r2. Proof. intros r r1 r2 Hr [I | E]. - now left; apply (Rmult_lt_reg_l r). - now apply Rlt_not_eq, not_eq_sym in Hr; right; apply (Rmult_eq_reg_l r). Qed. Lemma Rmult_le_reg_r : forall r r1 r2, 0 < r -> r1 * r <= r2 * r -> r1 <= r2. Proof. intros r r1 r2 Hr I; rewrite 2(Rmult_comm _ r) in I. now apply (Rmult_le_reg_l r). Qed. (** *** Order and inverse *) Lemma Rinv_0_lt_contravar : forall r1 r2, 0 < r1 -> r1 < r2 -> / r2 < / r1. Proof. intros r1 r2 H1 I. assert (H2 : 0 < r2) by now apply (Rlt_trans _ r1). apply (Rmult_lt_reg_l r2); try easy. rewrite Rinv_r by now apply Rgt_not_eq. apply (Rmult_lt_reg_r r1); try easy. rewrite Rmult_assoc, Rinv_l by now apply Rgt_not_eq. now rewrite Rmult_1_r, Rmult_1_l. Qed. #[global] Hint Resolve Rinv_0_lt_contravar: real. Lemma Rinv_lt_0_contravar : forall r1 r2, r2 < 0 -> r1 < r2 -> / r2 < / r1. Proof. intros r1 r2 H2%Ropp_lt_contravar I%Ropp_lt_contravar. apply Ropp_lt_cancel. rewrite Ropp_0 in H2. now rewrite <-2(Rinv_opp); apply Rinv_0_lt_contravar. Qed. #[global] Hint Resolve Rinv_lt_0_contravar: real. (* TODO: We may want to deprecate it but cannot because of the hint used in external libs (the stdlib can already be compiled without it) *) Lemma Rinv_1_lt_contravar : forall r1 r2, 1 <= r1 -> r1 < r2 -> / r2 < / r1. Proof. intros r1 r2 H1 I. apply Rlt_le_trans with (1 := Rlt_0_1) in H1. now apply Rinv_0_lt_contravar. Qed. #[global] Hint Resolve Rinv_1_lt_contravar: real. Lemma Rinv_lt_contravar : forall r1 r2, 0 < r1 * r2 -> r1 < r2 -> / r2 < / r1. Proof. intros r1 r2 [[H1 H2] | [H1 H2]]%Rmult_pos_cases. - now apply Rinv_0_lt_contravar. - now apply Rinv_lt_0_contravar. Qed. (* NOTE: keeping inconsistent variable names for backward compatibility. *) Lemma Rinv_le_contravar : forall x y, 0 < x -> x <= y -> / y <= / x. Proof. intros r1 r2 H1 [H2 | ->]. - now apply Rlt_le, Rinv_0_lt_contravar. - now apply Rle_refl. Qed. (** *** Sign of inverse *) Lemma Rinv_pos : forall r, r > 0 -> / r > 0. Proof. now intros r; apply Rinv_0_lt_compat. Qed. Lemma Rinv_neg : forall r, r < 0 -> / r < 0. Proof. now intros r; apply Rinv_lt_0_compat. Qed. (*********************************************************) (** ** Order and subtraction *) (*********************************************************) Lemma Rlt_minus : forall r1 r2, r1 < r2 -> r1 - r2 < 0. Proof. unfold Rminus; intros r1 r2 H%(Rplus_lt_compat_r (-r2)). now rewrite Rplus_opp_r in H. Qed. #[global] Hint Resolve Rlt_minus: real. Lemma Rgt_minus : forall r1 r2, r1 > r2 -> r1 - r2 > 0. Proof. unfold Rminus; intros r1 r2 H%(Rplus_lt_compat_r (-r2)). now rewrite Rplus_opp_r in H. Qed. Lemma Rle_minus : forall r1 r2, r1 <= r2 -> r1 - r2 <= 0. Proof. unfold Rminus; intros r1 r2 H%(Rplus_le_compat_r (-r2)). now rewrite Rplus_opp_r in H. Qed. Lemma Rge_minus : forall r1 r2, r1 >= r2 -> r1 - r2 >= 0. Proof. unfold Rminus; intros r1 r2 H%(Rplus_ge_compat_r (-r2)). now rewrite Rplus_opp_r in H. Qed. Lemma Rminus_lt : forall r1 r2, r1 - r2 < 0 -> r1 < r2. Proof. unfold Rminus; intros r1 r2 H. now apply (Rplus_lt_reg_r (-r2)); rewrite Rplus_opp_r. Qed. Lemma Rminus_gt : forall r1 r2, r1 - r2 > 0 -> r1 > r2. Proof. unfold Rminus; intros r1 r2 H. now apply (Rplus_lt_reg_r (-r2)); rewrite Rplus_opp_r. Qed. Lemma Rlt_minus_0 : forall r1 r2, r1 - r2 < 0 <-> r1 < r2. Proof. intros r1 r2; split. - now apply Rminus_lt. - now apply Rlt_minus. Qed. Lemma Rlt_0_minus : forall r1 r2, 0 < r2 - r1 <-> r1 < r2. Proof. intros r1 r2; split. - now apply Rminus_gt. - now apply Rgt_minus. Qed. Lemma Rminus_le : forall r1 r2, r1 - r2 <= 0 -> r1 <= r2. Proof. unfold Rminus; intros r1 r2 H. now apply (Rplus_le_reg_r (-r2)); rewrite Rplus_opp_r. Qed. Lemma Rminus_ge : forall r1 r2, r1 - r2 >= 0 -> r1 >= r2. Proof. unfold Rminus; intros r1 r2 H. now apply (Rplus_ge_reg_r (-r2)); rewrite Rplus_opp_r. Qed. Lemma Rgt_minus_pos : forall r1 r2, 0 < r2 -> r1 > r1 - r2. Proof. intros r1 r2 H%Ropp_lt_contravar; rewrite Ropp_0 in H. now rewrite <-(Rplus_0_r r1) at 1; apply (Rplus_lt_compat_l r1). Qed. (*********************************************************) (** ** Division *) (*********************************************************) Lemma Rdiv_def : forall r1 r2, r1 / r2 = r1 * / r2. Proof. now unfold Rdiv. Qed. Lemma Rdiv_eq_compat_l : forall r r1 r2, r1 = r2 -> r / r1 = r / r2. Proof. now unfold Rdiv; intros r r1 r2 H%Rinv_eq_compat; apply Rmult_eq_compat_l. Qed. Lemma Rdiv_eq_compat_r : forall r r1 r2, r1 = r2 -> r1 / r = r2 / r. Proof. now unfold Rdiv; intros r r1 r2; apply Rmult_eq_compat_r. Qed. Lemma Rdiv_eq_reg_l : forall r r1 r2, r / r1 = r / r2 -> r <> 0 -> r1 = r2. Proof. now unfold Rdiv; intros r r1 r2 H H'; apply Rinv_eq_reg, (Rmult_eq_reg_l r). Qed. Lemma Rdiv_eq_reg_r : forall r r1 r2, r1 / r = r2 / r -> r <> 0 -> r1 = r2. Proof. now unfold Rdiv; intros r r1 r2 H H'%Rinv_neq_0_compat; apply (Rmult_eq_reg_r (/ r)). Qed. Lemma Rdiv_0_l : forall r, 0 / r = 0. Proof. now unfold Rdiv; intros r; rewrite Rmult_0_l. Qed. Lemma Rdiv_0_r : forall r, r / 0 = 0. Proof. now unfold Rdiv; intros r; rewrite Rinv_0, Rmult_0_r. Qed. Lemma Rdiv_1_l : forall r, 1 / r = / r. Proof. now unfold Rdiv; intros r; rewrite Rmult_1_l. Qed. Lemma Rdiv_1_r : forall r, r / 1 = r. Proof. now unfold Rdiv; intros r; rewrite Rinv_1, Rmult_1_r. Qed. Lemma Rdiv_diag : forall r, r <> 0 -> r / r = 1. Proof. now unfold Rdiv; intros r H; rewrite Rinv_r. Qed. Lemma Rdiv_diag_eq : forall r1 r2, r2 <> 0 -> r1 = r2 -> r1 / r2 = 1. Proof. now intros r1 r2 H <-; apply Rdiv_diag. Qed. Lemma Rmult_div_l : forall r1 r2, r2 <> 0 -> r1 * r2 / r2 = r1. Proof. now unfold Rdiv; intros r1 r2 H; rewrite Rmult_assoc, Rinv_r, Rmult_1_r. Qed. Lemma Rmult_div_r : forall r1 r2, r1 <> 0 -> r1 * r2 / r1 = r2. Proof. now intros r1 r2 H; rewrite Rmult_comm, Rmult_div_l. Qed. Lemma Rmult_div_assoc : forall r1 r2 r3, r1 * (r2 / r3) = r1 * r2 / r3. Proof. now unfold Rdiv; intros r1 r2 r3; rewrite Rmult_assoc. Qed. Lemma Rmult_div_swap : forall r1 r2 r3, r1 * r2 / r3 = r1 / r3 * r2. Proof. unfold Rdiv; intros r1 r2 r3. now rewrite Rmult_assoc, (Rmult_comm r2), <-Rmult_assoc. Qed. Lemma Rdiv_diag_uniq : forall r1 r2, r1 / r2 = 1 -> r1 = r2. Proof. intros r1 r2; destruct (Req_dec r2 0) as [-> | Hn0]. - now intros H; rewrite Rdiv_0_r in H; exfalso; apply R1_neq_R0; symmetry. - intros H%(Rmult_eq_compat_r r2). now rewrite <-Rmult_div_swap, Rmult_div_l, Rmult_1_l in H. Qed. Lemma Rdiv_mult_distr : forall r1 r2 r3, r1 / (r2 * r3) = r1 / r2 / r3. Proof. now unfold Rdiv; intros r1 r2 r3; rewrite Rinv_mult, Rmult_assoc. Qed. Lemma Rdiv_mult_r_r : forall r r1 r2, r <> 0 -> (r1 * r) / (r2 * r) = r1 / r2. Proof. intros r r1 r2 H. rewrite <-Rmult_div_assoc, (Rmult_comm r2), Rdiv_mult_distr. now rewrite Rdiv_diag by exact H; rewrite Rdiv_1_l, Rdiv_def. Qed. Lemma Rdiv_mult_l_r : forall r r1 r2, r <> 0 -> (r * r1) / (r2 * r) = r1 / r2. Proof. now intros r r1 r2; rewrite (Rmult_comm r); apply Rdiv_mult_r_r. Qed. Lemma Rdiv_mult_l_l : forall r r1 r2, r <> 0 -> (r * r1) / (r * r2) = r1 / r2. Proof. now intros r r1 r2; rewrite (Rmult_comm _ r2); apply Rdiv_mult_l_r. Qed. Lemma Rdiv_mult_r_l : forall r r1 r2, r <> 0 -> (r1 * r) / (r * r2) = r1 / r2. Proof. now intros r r1 r2; rewrite (Rmult_comm r1); apply Rdiv_mult_l_l. Qed. Lemma Ropp_div_distr_l : forall r1 r2, - (r1 / r2) = - r1 / r2. Proof. unfold Rdiv; intros r1 r2; now apply Ropp_mult_distr_l. Qed. Lemma Ropp_div_distr_r : forall r1 r2, r1 / - r2 = - (r1 / r2). Proof. now unfold Rdiv; intros r1 r2; rewrite Ropp_mult_distr_r, Rinv_opp. Qed. (* NOTE: keeping inconsistent variable names for backward compatibility. *) Lemma Rdiv_plus_distr : forall a b c, (a + b) / c = a / c + b / c. Proof. intros r1 r2 r; now apply Rmult_plus_distr_r. Qed. (* NOTE: keeping inconsistent variable names for backward compatibility. *) Lemma Rdiv_minus_distr : forall a b c, (a - b) / c = a / c - b / c. Proof. unfold Rminus; intros r1 r2 r. now rewrite Ropp_div_distr_l; apply Rdiv_plus_distr. Qed. (* NOTE: keeping inconsistent variable names for backward compatibility. *) Lemma Rinv_div x y : / (x / y) = y / x. Proof. now unfold Rdiv; rewrite Rinv_mult, Rinv_inv; apply Rmult_comm. Qed. (* NOTE: keeping inconsistent variable names for backward compatibility. *) Lemma Rdiv_lt_0_compat : forall a b, 0 < a -> 0 < b -> 0 < a / b. Proof. intros r1 r2 r1_pos r2_pos. now apply (Rmult_lt_0_compat r1 (/ r2) r1_pos), Rinv_0_lt_compat. Qed. Lemma Rdiv_opp_l : forall r1 r2, - r1 / r2 = - (r1 / r2). Proof. now intros r1 r2; rewrite Ropp_div_distr_l. Qed. (* NOTE: keeping inconsistent variable names for backward compatibility. *) Lemma Rdiv_opp_r : forall x y, x / - y = - (x / y). Proof. now intros r1 r2; rewrite Ropp_div_distr_r. Qed. (** *** Sign of division *) Lemma Rdiv_pos_pos : forall r1 r2, r1 > 0 -> r2 > 0 -> r1 / r2 > 0. Proof. now unfold Rdiv; intros r1 r2 H H'%Rinv_pos; apply Rmult_pos_pos. Qed. Lemma Rdiv_pos_neg : forall r1 r2, r1 > 0 -> r2 < 0 -> r1 / r2 < 0. Proof. now unfold Rdiv; intros r1 r2 H H'%Rinv_neg; apply Rmult_pos_neg. Qed. Lemma Rdiv_neg_pos : forall r1 r2, r1 < 0 -> r2 > 0 -> r1 / r2 < 0. Proof. now unfold Rdiv; intros r1 r2 H H'%Rinv_pos; apply Rmult_neg_pos. Qed. Lemma Rdiv_neg_neg : forall r1 r2, r1 < 0 -> r2 < 0 -> r1 / r2 > 0. Proof. now unfold Rdiv; intros r1 r2 H H'%Rinv_neg; apply Rmult_neg_neg. Qed. Lemma Rdiv_pos_cases : forall r1 r2 : R, r1 / r2 > 0 -> r1 > 0 /\ r2 > 0 \/ r1 < 0 /\ r2 < 0. Proof. unfold Rdiv; intros r1 r2 [[I J%Rinv_pos] | [I J%Rinv_neg]]%Rmult_pos_cases. - now left; rewrite Rinv_inv in J. - now right; rewrite Rinv_inv in J. Qed. (*********************************************************) (** ** Miscellaneous *) (*********************************************************) (* This can't be moved to "Order and addition" because of Rlt_0_1 which is proved using a sign rule. *) (* TODO: We may want to deprecate it but cannot because of the hint used in external libs (the stdlib can already be compiled without it) *) Lemma Rle_lt_0_plus_1 : forall r, 0 <= r -> 0 < r + 1. Proof. intros r H; apply Rlt_le_trans with (1 := Rlt_0_1). rewrite <-(Rplus_0_l 1) at 1. apply Rplus_le_compat; try easy. Qed. #[global] Hint Resolve Rle_lt_0_plus_1: real. (* TODO: We may want to deprecate it but cannot because of the hint used in external libs (the stdlib can already be compiled without it) *) Lemma Rlt_plus_1 : forall r, r < r + 1. Proof. intros r; rewrite <-(Rplus_0_r r) at 1; apply Rplus_le_lt_compat. - now apply Rle_refl. - exact Rlt_0_1. Qed. #[global] Hint Resolve Rlt_plus_1: real. Lemma Rlt_0_2 : 0 < 2. Proof. assert (H : 0 < 1) by exact Rlt_0_1. apply (Rlt_trans _ 1); try easy. replace 2 with (1 + 1) by reflexivity. rewrite <-(Rplus_0_l 1) at 1. apply Rplus_lt_le_compat; try easy. Qed. Lemma Rplus_diag : forall r, r + r = 2 * r. Proof. intros r; replace 2 with (1 + 1) by reflexivity. now rewrite Rmult_plus_distr_r, Rmult_1_l. Qed. Lemma Rplus_half_diag : forall r, r / 2 + r / 2 = r. Proof. intros r; rewrite <-Rdiv_plus_distr, Rplus_diag, Rmult_div_r; [easy |]. now apply not_eq_sym, Rlt_not_eq, Rlt_0_2. Qed. Lemma Rlt_half_plus : forall r1 r2, r1 < r2 -> r1 < (r1 + r2) / 2 < r2. Proof. pose proof Rlt_0_2 as two_gt_0. assert (E : forall r r', (r + r') / 2 * 2 = r + r'). { now intros r r'; rewrite Rdiv_plus_distr, Rmult_plus_distr_r, <-2Rmult_div_swap, 2Rmult_div_l by (now apply Rgt_not_eq). } intros r1 r2 r1_lt_r2; split; apply Rmult_lt_reg_r with (1 := two_gt_0); rewrite E, Rmult_comm, <-Rplus_diag. - now apply Rplus_lt_compat_l. - now apply Rplus_lt_compat_r. Qed. Lemma Rle_half_plus : forall r1 r2, r1 <= r2 -> r1 <= (r1 + r2) / 2 <= r2. Proof. intros r1 r2 [I | ->]. - now split; left; apply (Rlt_half_plus r1 r2). - now split; rewrite Rdiv_plus_distr, Rplus_half_diag; apply Rle_refl. Qed. Lemma Rexists_between : forall r1 r2, r1 < r2 -> exists r, r1 < r < r2. Proof. intros r1 r2 r1_lt_r2. exists ((r1 + r2) / 2). now apply Rlt_half_plus. Qed. Lemma Rle_plus_epsilon : forall r1 r2, (forall eps:R, 0 < eps -> r1 <= r2 + eps) -> r1 <= r2. Proof. intros r1 r2 H. destruct (Rle_or_lt r1 r2) as [r1_le_r2 | r1_gt_r2]; [assumption |]. exfalso. destruct (Rexists_between r2 r1) as [r [r2_lt_r r_lt_r1]]; [assumption |]. apply (Rlt_irrefl r1), (Rle_lt_trans _ r); [| assumption]. rewrite <-(Rplus_minus r2 r). now apply H, Rgt_minus. Qed. (** Remark : a sigma-type version, called [completeness] is in [Raxioms.v] *) Lemma upper_bound_thm : forall E : R -> Prop, bound E -> (exists x : R, E x) -> exists m : R, is_lub E m. Proof. intros E E_bnd E_inhab. destruct (completeness E E_bnd E_inhab) as [x xlub]. now exists x. Qed. (*********************************************************) (** ** Injection from [nat] to [R] *) (*********************************************************) Lemma S_INR : forall n, INR (S n) = INR n + 1. Proof. intros [| n']. - now cbv -[IZR]; rewrite Rplus_0_l. - reflexivity. Qed. Lemma INR_0 : INR 0 = 0. Proof. reflexivity. Qed. Lemma INR_1 : INR 1 = 1. Proof. reflexivity. Qed. Lemma plus_INR : forall n m, INR (n + m) = INR n + INR m. Proof. intros n m; induction m as [| m IHm]. - now rewrite Nat.add_0_r, INR_0, Rplus_0_r. - now rewrite Nat.add_succ_r, 2S_INR, IHm, Rplus_assoc. Qed. #[global] Hint Resolve plus_INR: real. Lemma minus_INR : forall n m, (m <= n)%nat -> INR (n - m) = INR n - INR m. Proof. intros n m le; induction le as [|n' H' IH]. - now rewrite Nat.sub_diag, Rminus_diag. - rewrite Nat.sub_succ_l by assumption. now rewrite 2S_INR, IH, Rplus_minus_swap. Qed. #[global] Hint Resolve minus_INR: real. Lemma mult_INR : forall n m:nat, INR (n * m) = INR n * INR m. Proof. intros n m; induction m as [| m IH]. - now rewrite Nat.mul_0_r, INR_0, Rmult_0_r. - now rewrite Nat.mul_succ_r, S_INR, plus_INR, IH, Rmult_plus_distr_l, Rmult_1_r. Qed. #[global] Hint Resolve mult_INR: real. Lemma pow_INR : forall m n:nat, INR (m ^ n) = pow (INR m) n. Proof. now intros m n; induction n as [| n IH]; [| simpl; rewrite mult_INR, IH]. Qed. Lemma lt_0_INR : forall n:nat, (0 < n)%nat -> 0 < INR n. Proof. induction n as [| [|n ] IHn]; intros H. - now inversion H. - now rewrite INR_1; apply Rlt_0_1. - rewrite S_INR; apply Rplus_lt_0_compat. + now apply IHn, Nat.lt_0_succ. + exact Rlt_0_1. Qed. #[global] Hint Resolve lt_0_INR: real. Lemma lt_INR : forall n m:nat, (n < m)%nat -> INR n < INR m. Proof. induction n as [| n IH]; intros m H. - now apply lt_0_INR. - destruct m as [| m']. + now apply Nat.nlt_0_r in H. + rewrite 2S_INR. now apply (Rplus_lt_compat_r 1), IH, Nat.succ_lt_mono. Qed. #[global] Hint Resolve lt_INR: real. Lemma lt_1_INR : forall n:nat, (1 < n)%nat -> 1 < INR n. Proof. now apply lt_INR. Qed. #[global] Hint Resolve lt_1_INR: real. Lemma pos_INR_nat_of_P : forall p:positive, 0 < INR (Pos.to_nat p). Proof. now intros p; apply lt_0_INR, Pos2Nat.is_pos. Qed. #[global] Hint Resolve pos_INR_nat_of_P: real. Lemma pos_INR : forall n:nat, 0 <= INR n. Proof. intros [| n]. - now rewrite INR_0; apply Rle_refl. - now left; apply lt_0_INR, Nat.lt_0_succ. Qed. #[global] Hint Resolve pos_INR: real. Lemma INR_lt : forall n m:nat, INR n < INR m -> (n < m)%nat. Proof. intros n m. generalize dependent n. induction m as [| m IH]; intros n H. - now exfalso; apply Rlt_not_le with (1 := H), pos_INR. - destruct n as [| n]. + apply Nat.lt_0_succ. + apply ->Nat.succ_lt_mono; apply IH. rewrite 2!S_INR in H. now apply Rplus_lt_reg_r with (1 := H). Qed. #[global] Hint Resolve INR_lt: real. Lemma le_INR : forall n m:nat, (n <= m)%nat -> INR n <= INR m. Proof. intros n m [I | ->]%Nat.le_lteq. - now left; apply lt_INR. - now right. Qed. #[global] Hint Resolve le_INR: real. Lemma INR_not_0 : forall n:nat, INR n <> 0 -> n <> 0%nat. Proof. now intros n H ->; apply H, INR_0. Qed. #[global] Hint Immediate INR_not_0: real. Lemma not_0_INR : forall n:nat, n <> 0%nat -> INR n <> 0. Proof. intros [| n'] H. - now exfalso; apply H. - rewrite S_INR; apply Rgt_not_eq. now apply Rplus_le_lt_0_compat with (1 := (pos_INR n')); apply Rlt_0_1. Qed. #[global] Hint Resolve not_0_INR: real. Lemma not_INR : forall n m:nat, n <> m -> INR n <> INR m. Proof. intros n m [Hlt | Hgt]%Nat.lt_gt_cases. - now apply Rlt_not_eq, lt_INR. - now apply not_eq_sym, Rlt_not_eq, lt_INR. Qed. #[global] Hint Resolve not_INR: real. Lemma INR_eq : forall n m:nat, INR n = INR m -> n = m. Proof. intros n m HR. destruct (Nat.eq_dec n m) as [E | NE]; [assumption |]. now apply not_INR in NE. Qed. Lemma INR_le : forall n m:nat, INR n <= INR m -> (n <= m)%nat. Proof. intros n m [I | E]. - now apply Nat.lt_le_incl, INR_lt. - now apply Nat.eq_le_incl, INR_eq. Qed. #[global] Hint Resolve INR_le: real. Lemma not_1_INR : forall n:nat, n <> 1%nat -> INR n <> 1. Proof. now intros n; apply not_INR. Qed. #[global] Hint Resolve not_1_INR: real. (*********************************************************) (** ** Injection from [positive] to [R] *) (*********************************************************) (* NOTES: - IPR is defined in Rdefinitions, using an auxiliary recursive function IPR_2. - positive is the type of positive integers represented in binary. Its 3 constructors are * xH : positive, represents 1 * xO : positive -> positive, add a bit 0 at the end (i.e. multiply by 2) * xI : positive -> positive, add a bit 1 at the end (i.e. multiply by 2 and add 1) 1 is a notation for xH, p~0 is a notation for (xO p), p~1 is a notation for (xI p). - definition of positive (and Z) is in Numbers/BinNums.v - operations and lemmas are in PArith (modules Pos and Pos2Nat) - Pos.peano_ind gives an alternative induction principle using Pos.succ. *) Lemma IPR_2_xH : IPR_2 xH = 2. Proof. reflexivity. Qed. Lemma IPR_2_xO : forall p : positive, IPR_2 (p~0) = 2 * (IPR_2 p). Proof. now intros p. Qed. Lemma IPR_2_xI : forall p : positive, IPR_2 (p~1) = 2 * (IPR_2 p) + 2. Proof. intros p; simpl. rewrite (Rplus_comm _ 2), <-(Rmult_1_r 2) at 1. now rewrite <-(Rmult_plus_distr_l 2). Qed. Lemma IPR_xH : IPR xH = 1. Proof. reflexivity. Qed. Lemma IPR_IPR_2 : forall p : positive, 2 * IPR p = IPR_2 p. Proof. unfold IPR; intros [p | p |]. - rewrite IPR_2_xI, Rplus_comm, Rmult_plus_distr_l. now rewrite <-(Rmult_1_r 2) at 4. - now rewrite IPR_2_xO. - now rewrite IPR_2_xH, Rmult_1_r. Qed. Lemma IPR_xO : forall p : positive, IPR (p~0) = 2 * IPR p. Proof. intros p. apply (Rmult_eq_reg_l 2); cycle 1. { apply not_eq_sym, Rlt_not_eq, Rlt_0_2. } now rewrite 2IPR_IPR_2, IPR_2_xO. Qed. Lemma IPR_xI : forall p : positive, IPR (p~1) = 2 * IPR p + 1. Proof. intros p. apply (Rmult_eq_reg_l 2); cycle 1. { apply not_eq_sym, Rlt_not_eq, Rlt_0_2. } now rewrite 2IPR_IPR_2, IPR_2_xI, Rmult_plus_distr_l, Rmult_1_r. Qed. Lemma INR_IPR : forall p, INR (Pos.to_nat p) = IPR p. Proof. induction p as [p IH | p IH |]. - now rewrite Pos2Nat.inj_xI, IPR_xI, S_INR, mult_INR, IH. - now rewrite Pos2Nat.inj_xO, mult_INR, IPR_xO, IH. - reflexivity. Qed. Lemma succ_IPR : forall p, IPR (Pos.succ p) = IPR 1 + IPR p. Proof. induction p as [p IH |p IH |]. - simpl; rewrite IPR_xO, IPR_xI, IH, IPR_xH, Rmult_plus_distr_l. now rewrite (Rplus_comm 1), (Rplus_assoc _ 1), Rplus_diag, Rplus_comm. - now simpl; rewrite IPR_xI, IPR_xO, IPR_xH, Rplus_comm. - now simpl; rewrite IPR_xO, <-Rplus_diag. Qed. Lemma plus_IPR : forall p q, IPR (p + q) = IPR p + IPR q. Proof. intros p q; induction q as [| q IH] using Pos.peano_ind. - now rewrite Pos.add_1_r, succ_IPR, Rplus_comm. - rewrite Pos.add_succ_r, 2succ_IPR, IH. now rewrite <-Rplus_assoc, (Rplus_comm (IPR 1)), Rplus_assoc. Qed. Lemma minus_IPR : forall p q, (q < p)%positive -> IPR (p - q) = IPR p - IPR q. Proof. induction p as [| p IH] using Pos.peano_ind. - now intros q H%Pos.nlt_1_r. - intros q H; destruct q as [| q] using Pos.peano_ind. + now rewrite succ_IPR, <-Pos.add_1_r, Pos.add_sub, IPR_xH, Rplus_minus_l. + rewrite 2succ_IPR, IPR_xH, Rminus_plus_l_l. rewrite <-2Pos.add_1_r, (Pos.add_comm q). rewrite Pos.sub_add_distr by (now rewrite Pos.add_1_l, Pos.add_1_r). now rewrite Pos.add_sub, IH by (now apply Pos.succ_lt_mono). Qed. Lemma mult_IPR : forall p q:positive, IPR (p * q) = IPR p * IPR q. Proof. intros p q; induction q as [| q IH] using Pos.peano_ind. - now rewrite Pos.mul_1_r, IPR_xH, Rmult_1_r. - now rewrite Pos.mul_succ_r, succ_IPR, plus_IPR, IH, Rmult_plus_distr_l, Rmult_1_r. Qed. Lemma pow_IPR (q p: positive) : IPR (q ^ p) = pow (IPR q) (Pos.to_nat p). Proof. induction p as [| p IH] using Pos.peano_ind. - now simpl; rewrite Pos.pow_1_r, Rmult_1_r. - now rewrite Pos.pow_succ_r, mult_IPR, Pos2Nat.inj_succ; simpl; rewrite IH. Qed. Lemma IPR_ge_1 : forall p:positive, 1 <= IPR p. Proof. pose proof (Rlt_0_1) as H; pose proof (Rlt_0_2) as H'. induction p as [p IH | p IH |]. - rewrite IPR_xI, <-(Rplus_0_l 1) at 1; apply Rplus_le_compat_r. apply Rmult_le_pos; try now left. now apply (Rle_trans _ 1); try apply IH; left. - rewrite IPR_xO, <-Rplus_diag, <-(Rplus_0_l 1); apply Rplus_le_compat; try easy. now apply (Rle_trans _ 1); try apply IH; left. - now rewrite IPR_xH; apply Rle_refl. Qed. Lemma IPR_gt_0 : forall p:positive, 0 < IPR p. Proof. now intros p; apply (Rlt_le_trans _ 1); [apply Rlt_0_1 | apply IPR_ge_1]. Qed. Lemma lt_IPR : forall p q:positive, (p < q)%positive -> IPR p < IPR q. Proof. pose proof IPR_gt_0 as H; pose proof Rlt_0_2 as H'. induction p as [| p IH] using Pos.peano_ind; intros q Hq. - rewrite IPR_xH; induction q as [q IH' | [ q | q |] IH' |]. + rewrite IPR_xI, <-(Rplus_0_l 1) at 1. now apply Rplus_lt_compat_r, Rmult_lt_0_compat. + rewrite IPR_xO, <-(Rplus_0_l 1), <-Rplus_diag. apply Rplus_lt_compat; try easy; apply IH'; constructor. + rewrite IPR_xO, <-(Rplus_0_l 1), <-Rplus_diag. apply Rplus_lt_compat; try easy; apply IH'; constructor. + rewrite IPR_xO, IPR_xH. rewrite <-(Rplus_0_l 1) at 1; rewrite <-Rplus_diag. now apply Rplus_lt_compat_r, Rlt_0_1. + discriminate. - destruct q as [| q'] using Pos.peano_ind. + now exfalso; apply (Pos.nlt_1_r (Pos.succ p)). + now rewrite 2 succ_IPR; apply Rplus_lt_compat_l, IH, Pos.succ_lt_mono. Qed. Lemma lt_1_IPR : forall p:positive, (1 < p)%positive -> 1 < IPR p. Proof. now apply lt_IPR. Qed. Lemma IPR_lt : forall p q:positive, IPR p < IPR q -> (p < q)%positive. Proof. intros p q. generalize dependent p. induction q as [| q IH] using Pos.peano_ind; intros p H. - rewrite IPR_xH in H; exfalso; apply (Rle_not_lt (IPR p) 1); try easy. now apply IPR_ge_1. - destruct p as [| p] using Pos.peano_ind. + exact (Pos.lt_1_succ q). + apply ->Pos.succ_lt_mono; apply IH. rewrite 2!succ_IPR in H. now apply Rplus_lt_reg_l with (1 := H). Qed. Lemma le_IPR : forall p q:positive, (p <= q)%positive -> IPR p <= IPR q. Proof. intros p q [I | ->]%Pos.le_lteq. - now left; apply lt_IPR. - now right. Qed. Lemma IPR_not_1 : forall p:positive, IPR p <> 1 -> p <> 1%positive. Proof. now intros p H ->; apply H, IPR_xH. Qed. Lemma not_1_IPR : forall p:positive, p <> 1%positive -> IPR p <> 1. Proof. intros p H; destruct p as [| p] using Pos.peano_ind. - now exfalso; apply H. - rewrite succ_IPR; apply Rgt_not_eq. rewrite <-(Rplus_0_r 1), IPR_xH. now apply Rplus_gt_compat_l, IPR_gt_0. Qed. Lemma not_IPR : forall p q:positive, p <> q -> IPR p <> IPR q. Proof. intros p q. destruct (Pos.lt_total p q) as [Hlt | [Eq | Hgt]]; intros H. - now apply Rlt_not_eq, lt_IPR. - easy. - now apply not_eq_sym, Rlt_not_eq, lt_IPR. Qed. Lemma IPR_eq : forall p q:positive, IPR p = IPR q -> p = q. Proof. intros p q HR. destruct (Pos.eq_dec p q) as [E | NE]; [assumption |]. now apply not_IPR in NE. Qed. Lemma IPR_le : forall p q:positive, IPR p <= IPR q -> (p <= q)%positive. Proof. intros p q [I | E]. - now apply Pos.lt_le_incl, IPR_lt. - now apply IPR_eq in E as ->; apply Pos.le_refl. Qed. (*********************************************************) (** ** Injection from [Z] to [R] *) (*********************************************************) (* NOTES: - Z has 3 constructors : * Z0 : Z, representing 0 * Zpos : positive -> Z, for a positive integer * Zneg : positive -> Z, for a negative integer - Definition of Z is in Numbers.BinNums - Operations and lemmas are in ZArith (modules Z, Z2Nat, Nat2Z) *) Lemma IZN : forall n:Z, (0 <= n)%Z -> exists m : nat, n = Z.of_nat m. Proof. now intros n H%Z2Nat.id; exists (Z.to_nat n). Qed. Lemma INR_IZR_INZ : forall n:nat, INR n = IZR (Z.of_nat n). Proof. intros [| n]. - reflexivity. - simpl Z.of_nat; unfold IZR; simpl IZR. now rewrite <-INR_IPR, SuccNat2Pos.id_succ. Qed. Lemma IZR_NEG : forall p, IZR (Zneg p) = Ropp (IZR (Zpos p)). Proof. reflexivity. Qed. (** The three following lemmas map the default form of numerical constants to their representation in terms of the axioms of [R]. This can be a useful intermediate representation for reifying to another axiomatics of the reals. It is however generally more convenient to keep constants represented under an [IZR z] form when working within [R]. *) Lemma IZR_POS_xO : forall p, IZR (Zpos (p~0)) = 2 * (IZR (Zpos p)). Proof. now unfold IZR, IPR; intros [p | p |]; simpl; try easy; rewrite Rmult_1_r. Qed. Lemma IZR_POS_xI : forall p, IZR (Zpos (xI p)) = 1 + 2 * IZR (Zpos p). Proof. now unfold IZR, IPR; intros [p | p |]; simpl; try easy; rewrite Rmult_1_r. Qed. Lemma plus_IZR_NEG_POS : forall p q:positive, IZR (Zpos p + Zneg q) = IZR (Zpos p) + IZR (Zneg q). Proof. unfold IZR; intros p q; simpl; rewrite Z.pos_sub_spec. destruct (Pos.compare_spec p q) as [-> | Lt | Gt]. - now rewrite Rplus_opp_r. - rewrite minus_IPR by (exact Lt); rewrite Ropp_minus_distr. now unfold Rminus; rewrite Rplus_comm. - now rewrite minus_IPR by (exact Gt); unfold Rminus. Qed. Lemma plus_IZR : forall n m:Z, IZR (n + m) = IZR n + IZR m. Proof. intros [| p | p] [| q | q]; rewrite ?Rplus_0_l, ?Rplus_0_r, ?Z.add_0_l, ?Z.add_0_r; try easy. - now unfold IZR; simpl; apply plus_IPR. - now apply plus_IZR_NEG_POS. - now rewrite Rplus_comm, Z.add_comm; apply plus_IZR_NEG_POS. - now unfold IZR; simpl; rewrite plus_IPR, Ropp_plus_distr. Qed. Lemma mult_IZR : forall n m:Z, IZR (n * m) = IZR n * IZR m. Proof. intros [| p | p] [| q | q]; rewrite ?Rmult_0_l, ?Rmult_0_r, ?Z.mul_0_l, ?Z.mul_0_r; try easy; unfold IZR; simpl. - now apply mult_IPR. - now rewrite mult_IPR, Ropp_mult_distr_r. - now rewrite mult_IPR, Ropp_mult_distr_l. - now rewrite mult_IPR, Rmult_opp_opp. Qed. Lemma pow_IZR : forall z n, pow (IZR z) n = IZR (Z.pow z (Z.of_nat n)). Proof. intros z; induction n as [| n IH]. - reflexivity. - rewrite Nat2Z.inj_succ, Z.pow_succ_r by (apply Nat2Z.is_nonneg). now simpl; rewrite IH, mult_IZR. Qed. Lemma succ_IZR : forall n:Z, IZR (Z.succ n) = IZR n + 1. Proof. now intros n; unfold Z.succ; apply plus_IZR. Qed. Lemma opp_IZR : forall n:Z, IZR (- n) = - IZR n. Proof. intros [| p | p]; unfold IZR; simpl. - now replace R0 with 0 by reflexivity; rewrite Ropp_0. - reflexivity. - now rewrite Ropp_involutive. Qed. Definition Ropp_Ropp_IZR := opp_IZR. Lemma minus_IZR : forall n m:Z, IZR (n - m) = IZR n - IZR m. Proof. now intros n m; unfold Z.sub, Rminus; rewrite <-opp_IZR; apply plus_IZR. Qed. Lemma Z_R_minus : forall n m:Z, IZR n - IZR m = IZR (n - m). Proof. intros z1 z2; unfold Rminus, Z.sub. now rewrite <-(Ropp_Ropp_IZR z2); symmetry; apply plus_IZR. Qed. Lemma lt_0_IZR : forall n:Z, 0 < IZR n -> (0 < n)%Z. Proof. intros [| p | p]; simpl; intros H. - destruct (Rlt_irrefl _ H). - now constructor. - destruct (Rlt_not_le _ _ H); unfold IZR; replace R0 with 0 by reflexivity. rewrite <-Ropp_0; apply Ropp_le_contravar, Rle_trans with (1 := Rle_0_1). now apply IPR_ge_1. Qed. Lemma lt_IZR : forall n m:Z, IZR n < IZR m -> (n < m)%Z. Proof. intros z1 z2 H; apply Z.lt_0_sub. apply lt_0_IZR. rewrite <- Z_R_minus. exact (Rgt_minus (IZR z2) (IZR z1) H). Qed. Lemma eq_IZR_R0 : forall n:Z, IZR n = 0 -> n = 0%Z. Proof. intros [| p | p]; unfold IZR; simpl; intros H; try easy. - exfalso; apply (Rlt_not_eq 0 (IPR p)); try easy; apply IPR_gt_0. - exfalso; apply (Rlt_not_eq 0 (IPR p)); try apply IPR_gt_0; symmetry. replace R0 with 0 in H by reflexivity; rewrite <-Ropp_0 in H. now apply Ropp_eq_reg. Qed. Lemma eq_IZR : forall n m:Z, IZR n = IZR m -> n = m. Proof. intros n m H%(Rminus_diag_eq); rewrite Z_R_minus in H. now apply Zminus_eq, eq_IZR_R0. Qed. Lemma not_0_IZR : forall n:Z, n <> 0%Z -> IZR n <> 0. Proof. now intros z H H'; apply H, eq_IZR. Qed. Lemma le_0_IZR : forall n:Z, 0 <= IZR n -> (0 <= n)%Z. Proof. unfold Rle; intros n [H | ->%eq_sym%eq_IZR_R0]. - now apply Z.lt_le_incl, lt_0_IZR. - now apply Z.le_refl. Qed. Lemma le_IZR : forall n m:Z, IZR n <= IZR m -> (n <= m)%Z. Proof. unfold Rle; intros n m [H%lt_IZR | ->%eq_IZR]. - now apply Z.lt_le_incl. - now apply Z.le_refl. Qed. (* NOTE: 1 is a notation for (IZR 1) *) Lemma le_IZR_R1 : forall n:Z, IZR n <= 1 -> (n <= 1)%Z. Proof. now intros n; apply le_IZR. Qed. Lemma IZR_ge : forall n m:Z, (n >= m)%Z -> IZR n >= IZR m. Proof. intros n m H; apply Rnot_lt_ge; intros H2%lt_IZR. now apply (Zle_not_lt n m). Qed. Lemma IZR_le : forall n m:Z, (n <= m)%Z -> IZR n <= IZR m. Proof. now intros m n H%Z.le_ge; apply Rge_le, IZR_ge. Qed. Lemma IZR_lt : forall n m:Z, (n < m)%Z -> IZR n < IZR m. Proof. intros n m H; apply Rnot_le_lt; intros [I | E%eq_IZR]. - now apply (Z.lt_irrefl m), Z.lt_trans with (2 := H), lt_IZR. - now apply (Z.lt_irrefl m); rewrite E at 1. Qed. Lemma eq_IZR_contrapositive : forall n m:Z, n <> m -> IZR n <> IZR m. Proof. now intros n m H1 H2%eq_IZR. Qed. #[global] Hint Extern 0 (IZR _ <= IZR _) => apply IZR_le, Zle_bool_imp_le, eq_refl : real. #[global] Hint Extern 0 (IZR _ >= IZR _) => apply Rle_ge, IZR_le, Zle_bool_imp_le, eq_refl : real. #[global] Hint Extern 0 (IZR _ < IZR _) => apply IZR_lt, eq_refl : real. #[global] Hint Extern 0 (IZR _ > IZR _) => apply IZR_lt, eq_refl : real. #[global] Hint Extern 0 (IZR _ <> IZR _) => apply eq_IZR_contrapositive, Zeq_bool_neq, eq_refl : real. Lemma one_IZR_lt1 : forall n:Z, -1 < IZR n < 1 -> n = 0%Z. Proof. intros n [H1 H2]; apply Z.le_antisymm. - now apply Z.lt_succ_r; apply lt_IZR. - replace 0%Z with (Z.succ (-1)) by reflexivity. now apply Z.le_succ_l, lt_IZR. Qed. Lemma one_IZR_r_R1 : forall r (n m:Z), r < IZR n <= r + 1 -> r < IZR m <= r + 1 -> n = m. Proof. intros r n m [H1 H2] [H3 H4]; apply Zminus_eq, one_IZR_lt1. rewrite <-Z_R_minus; split. - replace (-1) with (r - (r + 1)) by (now rewrite Rminus_plus_distr, Rminus_diag, Rminus_0_l). unfold Rminus; apply Rplus_lt_le_compat; [assumption |]. now apply Ropp_le_contravar. - replace 1 with (r + 1 - r) by (now apply Rplus_minus_l). unfold Rminus; apply Rplus_le_lt_compat; try easy. now apply Ropp_lt_contravar. Qed. Lemma INR_unbounded : forall A, exists n, INR n > A. Proof. intros A; destruct (Rle_or_lt 0 A) as [A_ge0 | A_lt0]; cycle 1. { now exists 0%nat; simpl. } destruct (archimed A) as [ar1 _]. exists (Z.to_nat (up A)). rewrite INR_IZR_INZ, Z2Nat.id; try assumption. apply le_IZR, Rle_trans with (1 := A_ge0). now left. Qed. Lemma INR_archimed : forall eps A : R, eps > 0 -> exists n : nat, (INR n) * eps > A. Proof. intros eps A Heps; destruct (INR_unbounded (A / eps)) as [N HN]. exists N. apply (Rmult_gt_reg_r (/ eps)). { now apply Rinv_0_lt_compat. } now rewrite Rmult_assoc, Rinv_r by (now apply Rgt_not_eq); rewrite Rmult_1_r. Qed. 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. - now intros x y H; f_equal; apply Zeq_bool_eq. Qed. (* NOTE: keeping inconsistent variable names for backward compatibility. *) Lemma Zeq_bool_IZR : forall x y:Z, IZR x = IZR y -> Zeq_bool x y = true. Proof. now intros n m H; apply Zeq_is_eq_bool, eq_IZR. Qed. Add Field RField : Rfield (completeness Zeq_bool_IZR, morphism R_rm, constants [IZR_tac], power_tac R_power_theory [Rpow_tac]). (*********************************************************) (** * Definitions of new types *) (*********************************************************) Record nonnegreal : Type := mknonnegreal {nonneg :> R; cond_nonneg : 0 <= nonneg}. Record posreal : Type := mkposreal {pos :> R; cond_pos : 0 < pos}. Record nonposreal : Type := mknonposreal {nonpos :> R; cond_nonpos : nonpos <= 0}. Record negreal : Type := mknegreal {neg :> R; cond_neg : neg < 0}. Record nonzeroreal : Type := mknonzeroreal {nonzero :> R; cond_nonzero : nonzero <> 0}. (** ** A few common instances *) Lemma pos_half_prf : 0 < / 2. Proof. now apply Rinv_0_lt_compat, Rlt_0_2. Qed. Definition posreal_one := mkposreal (1) (Rlt_0_1). Definition posreal_half := mkposreal (/ 2) pos_half_prf. (** * Compatibility *) Notation prod_neq_R0 := Rmult_integral_contrapositive_currified (only parsing). Notation minus_Rgt := Rminus_gt (only parsing). Notation minus_Rge := Rminus_ge (only parsing). Notation plus_le_is_le := Rplus_le_reg_pos_r (only parsing). Notation plus_lt_is_lt := Rplus_lt_reg_pos_r (only parsing). Notation INR_lt_1 := lt_1_INR (only parsing). Notation lt_INR_0 := lt_0_INR (only parsing). Notation not_nm_INR := not_INR (only parsing). Notation INR_pos := pos_INR_nat_of_P (only parsing). Notation not_INR_O := INR_not_0 (only parsing). Notation not_O_INR := not_0_INR (only parsing). Notation not_O_IZR := not_0_IZR (only parsing). Notation le_O_IZR := le_0_IZR (only parsing). Notation lt_O_IZR := lt_0_IZR (only parsing). Notation tech_Rplus := Rplus_le_lt_0_neq_0 (only parsing). Notation tech_Rgt_minus := Rgt_minus_pos (only parsing). Notation le_epsilon := Rle_plus_epsilon (only parsing). Notation completeness_weak := upper_bound_thm (only parsing). Notation Req_EM_T := Req_dec_T (only parsing). Notation Rinv_r_simpl_r := Rmult_inv_m_id_r (only parsing). Notation Rinv_r_simpl_l := Rmult_inv_r_id_l (only parsing). Notation Rinv_r_simpl_m := Rmult_inv_r_id_m (only parsing). Notation Rplus_eq_R0 := Rplus_eq_0 (only parsing). Lemma Rinv_involutive_depr : forall r, r <> 0 -> / / r = r. Proof. now intros r _; apply Rinv_inv. Qed. #[deprecated(since="8.16",note="Use Rinv_inv.")] Notation Rinv_involutive := Rinv_involutive_depr (only parsing). Lemma Rinv_mult_distr_depr : forall r1 r2, r1 <> 0 -> r2 <> 0 -> / (r1 * r2) = / r1 * / r2. Proof. now intros r1 r2 _ _; apply Rinv_mult. Qed. #[deprecated(since="8.16",note="Use Rinv_mult.")] Notation Rinv_mult_distr := Rinv_mult_distr_depr (only parsing). Lemma Ropp_inv_permute_depr : forall r, r <> 0 -> - / r = / - r. Proof. now intros r H; apply eq_sym, Rinv_opp. Qed. #[deprecated(since="8.16",note="Use Rinv_opp.")] Notation Ropp_inv_permute := Ropp_inv_permute_depr (only parsing). Lemma Ropp_div_den_depr : forall x y, y <> 0 -> x / - y = - (x / y). Proof. now intros r1 r2 _; apply Ropp_div_distr_r. Qed. #[deprecated(since="8.16",note="Use Rdiv_opp_r.")] Notation Ropp_div_den := Ropp_div_den_depr (only parsing). Lemma inser_trans_R_depr : forall r1 r2 r3 r4, r1 <= r2 < r3 -> {r1 <= r2 < r4} + {r4 <= r2 < r3}. Proof. intros r1 r2 r3 r4 [H1 H2]; destruct (Rlt_le_dec r2 r4) as [Hlt | Hle]. - now left. - now right. Qed. #[deprecated(since="8.19")] Notation inser_trans_R := inser_trans_R_depr (only parsing). Lemma Ropp_minus_distr'_depr : forall r1 r2, - (r2 - r1) = r1 - r2. Proof. now intros r1 r2; apply Ropp_minus_distr. Qed. #[deprecated(since="8.19",note="Use Ropp_minus_distr instead.")] Notation Ropp_minus_distr' := (fun r1 r2 => (Ropp_minus_distr r2 r1)) (only parsing). #[deprecated(since="8.19",note="Use Rminus_diag instead.")] Notation Rminus_eq_0 := (fun x => Rminus_diag x) (only parsing). Lemma sum_inequa_Rle_lt_depr : forall a x b c y d:R, a <= x -> x < b -> c < y -> y <= d -> a + c < x + y < b + d. Proof. intros; split. - apply Rlt_le_trans with (a + y); auto with real. - apply Rlt_le_trans with (b + y); auto with real. Qed. #[deprecated(since="8.19")] Notation sum_inequa_Rle_lt := sum_inequa_Rle_lt_depr (only parsing). Lemma Rle_Rinv_depr : forall x y:R, 0 < x -> 0 < y -> x <= y -> / y <= / x. Proof. now intros r1 r2 H _; apply Rinv_le_contravar. Qed. #[deprecated(since="8.19",note="Use Rinv_le_contravar.")] Notation Rle_Rinv := Rle_Rinv_depr (only parsing). #[deprecated(since="8.19",note="Use the bidirectional version Rlt_0_minus instead.")] Notation Rlt_Rminus := (fun a b => proj2 (Rlt_0_minus a b)) (only parsing). #[deprecated(since="8.19",note="Use the bidirectional version Rlt_0_minus instead.")] Notation Rminus_gt_0_lt := (fun a b => proj1 (Rlt_0_minus a b)) (only parsing). #[deprecated(since="8.19",note="Use Rdiv_opp_l.")] Notation Ropp_div := (fun x y => Rdiv_opp_l x y) (only parsing). Lemma Rplus_sqr_eq_0_l_depr : forall r1 r2, Rsqr r1 + Rsqr r2 = 0 -> r1 = 0. Proof. now intros r1 r2 H; apply Rsqr_0_uniq, (Rplus_eq_0_l _ (r2²)); try easy; apply Rle_0_sqr. Qed. #[deprecated(since="8.19",note="Use Rplus_sqr_eq_0.")] Notation Rplus_sqr_eq_0_l := Rplus_sqr_eq_0_l_depr (only parsing). #[deprecated(since="8.19",note="Use Rplus_diag.")] Notation double := (fun r1 => eq_sym (Rplus_diag r1)) (only parsing). #[deprecated(since="8.19",note="Use Rplus_half_diag.")] Notation double_var := (fun r1 => eq_sym (Rplus_half_diag r1)) (only parsing). #[deprecated(since="8.19",note="Use eq_IZR_contrapositive.")] Notation IZR_neq := (fun z1 z2 => (eq_IZR_contrapositive z1 z2)) (only parsing). Lemma S_O_plus_INR_depr : forall n, INR (1 + n) = INR 1 + INR n. Proof. intros [| n']. - now rewrite INR_0, Rplus_0_r, Nat.add_0_r. - rewrite Rplus_comm; reflexivity. Qed. #[deprecated(since="8.19")] Notation S_O_plus_INR := S_O_plus_INR_depr (only parsing). Lemma single_z_r_R1_depr : forall r (n m:Z), r < IZR n -> IZR n <= r + 1 -> r < IZR m -> IZR m <= r + 1 -> n = m. Proof. now intros r n m Hlt Hle Hlt' Hle'; apply (one_IZR_r_R1 r). Qed. #[deprecated(since="8.19")] Notation single_z_r_R1 := single_z_r_R1_depr (only parsing). Lemma tech_single_z_r_R1_depr : forall r (n:Z), r < IZR n -> IZR n <= r + 1 -> (exists s : Z, s <> n /\ r < IZR s /\ IZR s <= r + 1) -> False. Proof. now intros r z H1 H2 [s [H3 [H4 H5]]]; apply H3, (one_IZR_r_R1 r). Qed. #[deprecated(since="8.19")] Notation tech_single_z_r_R1 := tech_single_z_r_R1_depr (only parsing). Lemma Rinv_mult_simpl_depr : forall r1 r2 r3, r1 <> 0 -> r1 * / r2 * (r3 * / r1) = r3 * / r2. Proof. intros r1 r2 r3 r1n0. rewrite (Rmult_comm r3 (/ r1)), Rmult_assoc, <-(Rmult_assoc (/ r2)). rewrite (Rmult_comm r3), (Rmult_comm (/ r2)), <-2Rmult_assoc. now rewrite Rinv_r, Rmult_1_l. Qed. #[deprecated(since="8.19")] Notation Rinv_mult_simpl := Rinv_mult_simpl_depr. coq-8.20.0/theories/Reals/RList.v000066400000000000000000000660571466560755400165370ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* 0 | a :: l1 => match l1 with | nil => a | a' :: l2 => Rmax a (MaxRlist l1) end end. Fixpoint MinRlist (l:list R) : R := match l with | nil => 1 | a :: l1 => match l1 with | nil => a | a' :: l2 => Rmin a (MinRlist l1) end end. Lemma MaxRlist_P1 : forall (l:list R) (x:R), In x l -> x <= MaxRlist l. Proof. intros; induction l as [| r l Hrecl]. - simpl in H; elim H. - induction l as [| r0 l Hrecl0]. + simpl in H; elim H; intro. * simpl; right; symmetry; assumption. * elim H0. + replace (MaxRlist (r :: r0 :: l)) with (Rmax r (MaxRlist (r0 :: l))). * simpl in H; decompose [or] H. -- rewrite H0; apply RmaxLess1. -- unfold Rmax; case (Rle_dec r (MaxRlist (r0 :: l))); intro. ++ apply Hrecl; simpl; tauto. ++ apply Rle_trans with (MaxRlist (r0 :: l)); [ apply Hrecl; simpl; tauto | left; auto with real ]. -- unfold Rmax; case (Rle_dec r (MaxRlist (r0 :: l))); intro. ++ apply Hrecl; simpl; tauto. ++ apply Rle_trans with (MaxRlist (r0 :: l)); [ apply Hrecl; simpl; tauto | left; auto with real ]. * reflexivity. Qed. Fixpoint AbsList (l:list R) (x:R) : list R := match l with | nil => nil | a :: l' => (Rabs (a - x) / 2) :: (AbsList l' x) end. Lemma MinRlist_P1 : forall (l:list R) (x:R), In x l -> MinRlist l <= x. Proof. intros; induction l as [| r l Hrecl]. - simpl in H; elim H. - induction l as [| r0 l Hrecl0]. + simpl in H; elim H; intro. * simpl; right; assumption. * elim H0. + replace (MinRlist (r :: r0 :: l)) with (Rmin r (MinRlist (r0 :: l))). * simpl in H; decompose [or] H. -- rewrite H0; apply Rmin_l. -- unfold Rmin; case (Rle_dec r (MinRlist (r0 :: l))); intro. ++ apply Rle_trans with (MinRlist (r0 :: l)). ** assumption. ** apply Hrecl; simpl; tauto. ++ apply Hrecl; simpl; tauto. -- apply Rle_trans with (MinRlist (r0 :: l)). ++ apply Rmin_r. ++ apply Hrecl; simpl; tauto. * reflexivity. Qed. Lemma AbsList_P1 : forall (l:list R) (x y:R), In y l -> In (Rabs (y - x) / 2) (AbsList l x). Proof. intros; induction l as [| r l Hrecl]. - elim H. - simpl; simpl in H; elim H; intro. + left; rewrite H0; reflexivity. + right; apply Hrecl; assumption. Qed. Lemma MinRlist_P2 : forall l:list R, (forall y:R, In y l -> 0 < y) -> 0 < MinRlist l. Proof. intros; induction l as [| r l Hrecl]. - apply Rlt_0_1. - induction l as [| r0 l Hrecl0]. + simpl; apply H; simpl; tauto. + replace (MinRlist (r :: r0 :: l)) with (Rmin r (MinRlist (r0 :: l))). * unfold Rmin; case (Rle_dec r (MinRlist (r0 :: l))); intro. -- apply H; simpl; tauto. -- apply Hrecl; intros; apply H; simpl; simpl in H0; tauto. * reflexivity. Qed. Lemma AbsList_P2 : forall (l:list R) (x y:R), In y (AbsList l x) -> exists z : R, In z l /\ y = Rabs (z - x) / 2. Proof. intros; induction l as [| r l Hrecl]. - elim H. - elim H; intro. + exists r; split. * simpl; tauto. * symmetry. assumption. + assert (H1 := Hrecl H0); elim H1; intros; elim H2; clear H2; intros; exists x0; simpl; simpl in H2; tauto. Qed. Lemma MaxRlist_P2 : forall l:list R, (exists y : R, In y l) -> In (MaxRlist l) l. Proof. intros; induction l as [| r l Hrecl]. - simpl in H; elim H; trivial. - induction l as [| r0 l Hrecl0]. + simpl; left; reflexivity. + change (In (Rmax r (MaxRlist (r0 :: l))) (r :: r0 :: l)); unfold Rmax; case (Rle_dec r (MaxRlist (r0 :: l))); intro. * right; apply Hrecl; exists r0; left; reflexivity. * left; reflexivity. Qed. Fixpoint pos_Rl (l:list R) (i:nat) : R := match l with | nil => 0 | a :: l' => match i with | O => a | S i' => pos_Rl l' i' end end. Lemma pos_Rl_P1 : forall (l:list R) (a:R), (0 < length l)%nat -> pos_Rl (a :: l) (length l) = pos_Rl l (pred (length l)). Proof. intros; induction l as [| r l Hrecl]; [ elim (Nat.nlt_0_r _ H) | simpl; case (length l); [ reflexivity | intro; reflexivity ] ]. Qed. Lemma pos_Rl_P2 : forall (l:list R) (x:R), In x l <-> (exists i : nat, (i < length l)%nat /\ x = pos_Rl l i). Proof. intros; induction l as [| r l Hrecl]. - split; intro; [ elim H | elim H; intros; elim H0; intros; elim (Nat.nlt_0_r _ H1) ]. - split; intro. + elim H; intro. * exists 0%nat; split; [ simpl; apply Nat.lt_0_succ | simpl; symmetry; apply H0 ]. * elim Hrecl; intros; assert (H3 := H1 H0); elim H3; intros; elim H4; intros; exists (S x0); split; [ simpl; apply -> Nat.succ_lt_mono; assumption | simpl; assumption ]. + elim H; intros; elim H0; intros; destruct (zerop x0) as [->|]. * simpl in H2; left; symmetry; assumption. * right; elim Hrecl; intros H4 H5; apply H5; assert (H6 : S (pred x0) = x0). -- apply Nat.lt_succ_pred with 0%nat; assumption. -- exists (pred x0); split; [ simpl in H1; apply Nat.succ_lt_mono; rewrite H6; assumption | rewrite <- H6 in H2; simpl in H2; assumption ]. Qed. Lemma Rlist_P1 : forall (l:list R) (P:R -> R -> Prop), (forall x:R, In x l -> exists y : R, P x y) -> exists l' : list R, length l = length l' /\ (forall i:nat, (i < length l)%nat -> P (pos_Rl l i) (pos_Rl l' i)). Proof. intros; induction l as [| r l Hrecl]. - exists nil; intros; split; [ reflexivity | intros; simpl in H0; elim (Nat.nlt_0_r _ H0) ]. - assert (H0 : In r (r :: l)). + simpl; left; reflexivity. + assert (H1 := H _ H0); assert (H2 : forall x:R, In x l -> exists y : R, P x y). * intros; apply H; simpl; right; assumption. * assert (H3 := Hrecl H2); elim H1; intros; elim H3; intros; exists (x :: x0); intros; elim H5; clear H5; intros; split. -- simpl; rewrite H5; reflexivity. -- intros; destruct (zerop i) as [->|]. ++ simpl; assumption. ++ assert (H9 : i = S (pred i)). ** symmetry; apply Nat.lt_succ_pred with 0%nat; assumption. ** rewrite H9; simpl; apply H6; simpl in H7; apply Nat.succ_lt_mono; rewrite <- H9; assumption. Qed. Definition ordered_Rlist (l:list R) : Prop := forall i:nat, (i < pred (length l))%nat -> pos_Rl l i <= pos_Rl l (S i). Fixpoint insert (l:list R) (x:R) : list R := match l with | nil => x :: nil | a :: l' => match Rle_dec a x with | left _ => a :: (insert l' x) | right _ => x :: l end end. Fixpoint cons_ORlist (k l:list R) : list R := match k with | nil => l | a :: k' => cons_ORlist k' (insert l a) end. Fixpoint mid_Rlist (l:list R) (x:R) : list R := match l with | nil => nil | a :: l' => ((x + a) / 2) :: (mid_Rlist l' a) end. Definition Rtail (l:list R) : list R := match l with | nil => nil | a :: l' => l' end. Definition FF (l:list R) (f:R -> R) : list R := match l with | nil => nil | a :: l' => map f (mid_Rlist l' a) end. Lemma RList_P0 : forall (l:list R) (a:R), pos_Rl (insert l a) 0 = a \/ pos_Rl (insert l a) 0 = pos_Rl l 0. Proof. intros; induction l as [| r l Hrecl]; [ left; reflexivity | simpl; case (Rle_dec r a); intro; [ right; reflexivity | left; reflexivity ] ]. Qed. Lemma RList_P1 : forall (l:list R) (a:R), ordered_Rlist l -> ordered_Rlist (insert l a). Proof. intros; induction l as [| r l Hrecl]. - simpl; unfold ordered_Rlist; intros; simpl in H0; elim (Nat.nlt_0_r _ H0). - simpl; case (Rle_dec r a); intro. + assert (H1 : ordered_Rlist l). * unfold ordered_Rlist; unfold ordered_Rlist in H; intros; assert (H1 : (S i < pred (length (r :: l)))%nat); [ simpl; replace (length l) with (S (pred (length l))); [ apply -> Nat.succ_lt_mono; assumption | apply Nat.lt_succ_pred with 0%nat; apply Nat.neq_0_lt_0; red; intro; rewrite H1 in H0; simpl in H0; elim (Nat.nlt_0_r _ H0) ] | apply (H _ H1) ]. * assert (H2 := Hrecl H1); unfold ordered_Rlist; intros; induction i as [| i Hreci]. -- simpl; assert (H3 := RList_P0 l a); elim H3; intro. ++ rewrite H4; assumption. ++ induction l as [| r1 l Hrecl0]; [ simpl; assumption | rewrite H4; apply (H 0%nat); simpl; apply Nat.lt_0_succ ]. -- simpl; apply H2; simpl in H0; apply Nat.succ_lt_mono; replace (S (pred (length (insert l a)))) with (length (insert l a)); [ assumption | symmetry; apply Nat.lt_succ_pred with 0%nat; apply Nat.neq_0_lt_0; red; intro; rewrite H3 in H0; elim (Nat.nlt_0_r _ H0) ]. + unfold ordered_Rlist; intros; induction i as [| i Hreci]; [ simpl; auto with real | change (pos_Rl (r :: l) i <= pos_Rl (r :: l) (S i)); apply H; simpl in H0; simpl; apply (proj2 (Nat.succ_lt_mono _ _) H0) ]. Qed. Lemma RList_P2 : forall l1 l2:list R, ordered_Rlist l2 -> ordered_Rlist (cons_ORlist l1 l2). Proof. simple induction l1; [ intros; simpl; apply H | intros; simpl; apply H; apply RList_P1; assumption ]. Qed. Lemma RList_P3 : forall (l:list R) (x:R), In x l <-> (exists i : nat, x = pos_Rl l i /\ (i < length l)%nat). Proof. intros; split; intro; [ induction l as [| r l Hrecl] | induction l as [| r l Hrecl] ]. - elim H. - elim H; intro; [ exists 0%nat; split; [ symmetry; apply H0 | simpl; apply Nat.lt_0_succ ] | elim (Hrecl H0); intros; elim H1; clear H1; intros; exists (S x0); split; [ apply H1 | simpl; apply -> Nat.succ_lt_mono; assumption ] ]. - elim H; intros; elim H0; intros; elim (Nat.nlt_0_r _ H2). - simpl; elim H; intros; elim H0; clear H0; intros; induction x0 as [| x0 Hrecx0]; [ left; symmetry; apply H0 | right; apply Hrecl; exists x0; split; [ apply H0 | simpl in H1; apply Nat.succ_lt_mono; assumption ] ]. Qed. Lemma RList_P4 : forall (l1:list R) (a:R), ordered_Rlist (a :: l1) -> ordered_Rlist l1. Proof. intros; unfold ordered_Rlist; intros; apply (H (S i)); simpl; replace (length l1) with (S (pred (length l1))); [ apply -> Nat.succ_lt_mono; assumption | apply Nat.lt_succ_pred with 0%nat; apply Nat.neq_0_lt_0; red; intro; rewrite H1 in H0; elim (Nat.nlt_0_r _ H0) ]. Qed. Lemma RList_P5 : forall (l:list R) (x:R), ordered_Rlist l -> In x l -> pos_Rl l 0 <= x. Proof. intros; induction l as [| r l Hrecl]; [ elim H0 | simpl; elim H0; intro; [ rewrite H1; right; reflexivity | apply Rle_trans with (pos_Rl l 0); [ apply (H 0%nat); simpl; induction l as [| r0 l Hrecl0]; [ elim H1 | simpl; apply Nat.lt_0_succ ] | apply Hrecl; [ eapply RList_P4; apply H | assumption ] ] ] ]. Qed. Lemma RList_P6 : forall l:list R, ordered_Rlist l <-> (forall i j:nat, (i <= j)%nat -> (j < length l)%nat -> pos_Rl l i <= pos_Rl l j). Proof. induction l as [ | r r0 H]; split; intro. - intros; right; reflexivity. - unfold ordered_Rlist;intros; simpl in H0; elim (Nat.nlt_0_r _ H0). - intros; induction i as [| i Hreci]; [ induction j as [| j Hrecj]; [ right; reflexivity | simpl; apply Rle_trans with (pos_Rl r0 0); [ apply (H0 0%nat); simpl; simpl in H2; apply Nat.neq_0_lt_0; red; intro; rewrite H3 in H2; assert (H4 := proj2 (Nat.succ_lt_mono _ _) H2); elim (Nat.nlt_0_r _ H4) | elim H; intros; apply H3; [ apply RList_P4 with r; assumption | apply Nat.le_0_l | simpl in H2; apply Nat.succ_lt_mono; assumption ] ] ] | induction j as [| j Hrecj]; [ elim (Nat.nle_succ_0 _ H1) | simpl; elim H; intros; apply H3; [ apply RList_P4 with r; assumption | apply le_S_n; assumption | simpl in H2; apply Nat.succ_lt_mono; assumption ] ] ]. - unfold ordered_Rlist; intros; apply H0; [ apply Nat.le_succ_diag_r | simpl; simpl in H1; apply -> Nat.succ_lt_mono; assumption ]. Qed. Lemma RList_P7 : forall (l:list R) (x:R), ordered_Rlist l -> In x l -> x <= pos_Rl l (pred (length l)). Proof. intros; assert (H1 := RList_P6 l); elim H1; intros H2 _; assert (H3 := H2 H); clear H1 H2; assert (H1 := RList_P3 l x); elim H1; clear H1; intros; assert (H4 := H1 H0); elim H4; clear H4; intros; elim H4; clear H4; intros; rewrite H4; assert (H6 : length l = S (pred (length l))). - symmetry; apply Nat.lt_succ_pred with 0%nat; apply Nat.neq_0_lt_0; red; intro; rewrite H6 in H5; elim (Nat.nlt_0_r _ H5). - apply H3; [ rewrite H6 in H5; apply Nat.lt_succ_r; assumption | apply Nat.lt_pred_l; red; intro; rewrite H7 in H5; elim (Nat.nlt_0_r _ H5) ]. Qed. Lemma RList_P8 : forall (l:list R) (a x:R), In x (insert l a) <-> x = a \/ In x l. Proof. induction l as [ | r r0 H]. - intros; split; intro; destruct H as [ax | []]; left; symmetry; exact ax. - intros; split; intro. + simpl in H0; generalize H0; case (Rle_dec r a); intros. * simpl in H1; elim H1; intro. -- right; left; assumption. -- elim (H a x); intros; elim (H3 H2); intro. ++ left; assumption. ++ right; right; assumption. * simpl in H1; decompose [or] H1. -- left; symmetry; assumption. -- right; left; assumption. -- right; right; assumption. + simpl; case (Rle_dec r a); intro. * simpl in H0; decompose [or] H0. -- right; elim (H a x); intros; apply H3; left. assumption. -- left. assumption. -- right; elim (H a x); intros; apply H3; right; assumption. * simpl in H0; decompose [or] H0; [ left | right; left | right; right]; trivial; symmetry; assumption. Qed. Lemma RList_P9 : forall (l1 l2:list R) (x:R), In x (cons_ORlist l1 l2) <-> In x l1 \/ In x l2. Proof. induction l1 as [ | r r0 H]. - intros; split; intro; [ simpl in H; right; assumption | simpl; elim H; intro; [ elim H0 | assumption ] ]. - intros; split. + simpl; intros; elim (H (insert l2 r) x); intros; assert (H3 := H1 H0); elim H3; intro. * left; right; assumption. * elim (RList_P8 l2 r x); intros H5 _; assert (H6 := H5 H4); elim H6; intro. -- left; left; symmetry; assumption. -- right; assumption. + intro; simpl; elim (H (insert l2 r) x); intros _ H1; apply H1; elim H0; intro. * elim H2; intro. -- right; elim (RList_P8 l2 r x); intros _ H4; apply H4; left. symmetry; assumption. -- left; assumption. * right; elim (RList_P8 l2 r x); intros _ H3; apply H3; right; assumption. Qed. Lemma RList_P10 : forall (l:list R) (a:R), length (insert l a) = S (length l). Proof. intros; induction l as [| r l Hrecl]; [ reflexivity | simpl; case (Rle_dec r a); intro; [ simpl; rewrite Hrecl; reflexivity | reflexivity ] ]. Qed. Lemma RList_P11 : forall l1 l2:list R, length (cons_ORlist l1 l2) = (length l1 + length l2)%nat. Proof. induction l1 as [ | r r0 H]; [ intro; reflexivity | intros; simpl; rewrite (H (insert l2 r)); rewrite RList_P10; apply INR_eq; rewrite S_INR; do 2 rewrite plus_INR; rewrite S_INR; ring ]. Qed. Lemma RList_P12 : forall (l:list R) (i:nat) (f:R -> R), (i < length l)%nat -> pos_Rl (map f l) i = f (pos_Rl l i). Proof. simple induction l; [ intros; elim (Nat.nlt_0_r _ H) | intros; induction i as [| i Hreci]; [ reflexivity | simpl; apply H; apply Nat.succ_lt_mono; apply H0 ] ]. Qed. Lemma RList_P13 : forall (l:list R) (i:nat) (a:R), (i < pred (length l))%nat -> pos_Rl (mid_Rlist l a) (S i) = (pos_Rl l i + pos_Rl l (S i)) / 2. Proof. induction l as [ | r r0 H]. - intros; simpl in H; elim (Nat.nlt_0_r _ H). - induction r0 as [ | r1 r2 H0]. + intros; simpl in H0; elim (Nat.nlt_0_r _ H0). + intros; simpl in H1; induction i as [| i Hreci]. * reflexivity. * change (pos_Rl (mid_Rlist (r1 :: r2) r) (S i) = (pos_Rl (r1 :: r2) i + pos_Rl (r1 :: r2) (S i)) / 2). apply H; simpl; apply Nat.succ_lt_mono; assumption. Qed. Lemma RList_P14 : forall (l:list R) (a:R), length (mid_Rlist l a) = length l. Proof. induction l as [ | r r0 H]; intros; [ reflexivity | simpl; rewrite (H r); reflexivity ]. Qed. Lemma RList_P15 : forall l1 l2:list R, ordered_Rlist l1 -> ordered_Rlist l2 -> pos_Rl l1 0 = pos_Rl l2 0 -> pos_Rl (cons_ORlist l1 l2) 0 = pos_Rl l1 0. Proof. intros; apply Rle_antisym. - induction l1 as [| r l1 Hrecl1]; [ simpl; simpl in H1; right; symmetry ; assumption | elim (RList_P9 (r :: l1) l2 (pos_Rl (r :: l1) 0)); intros; assert (H4 : In (pos_Rl (r :: l1) 0) (r :: l1) \/ In (pos_Rl (r :: l1) 0) l2); [ left; left; reflexivity | assert (H5 := H3 H4); apply RList_P5; [ apply RList_P2; assumption | assumption ] ] ]. - induction l1 as [| r l1 Hrecl1]; [ simpl; simpl in H1; right; assumption | assert (H2 : In (pos_Rl (cons_ORlist (r :: l1) l2) 0) (cons_ORlist (r :: l1) l2)); [ elim (RList_P3 (cons_ORlist (r :: l1) l2) (pos_Rl (cons_ORlist (r :: l1) l2) 0)); intros; apply H3; exists 0%nat; split; [ reflexivity | rewrite RList_P11; simpl; apply Nat.lt_0_succ ] | elim (RList_P9 (r :: l1) l2 (pos_Rl (cons_ORlist (r :: l1) l2) 0)); intros; assert (H5 := H3 H2); elim H5; intro; [ apply RList_P5; assumption | rewrite H1; apply RList_P5; assumption ] ] ]. Qed. Lemma RList_P16 : forall l1 l2:list R, ordered_Rlist l1 -> ordered_Rlist l2 -> pos_Rl l1 (pred (length l1)) = pos_Rl l2 (pred (length l2)) -> pos_Rl (cons_ORlist l1 l2) (pred (length (cons_ORlist l1 l2))) = pos_Rl l1 (pred (length l1)). Proof. intros; apply Rle_antisym. - induction l1 as [| r l1 Hrecl1]. + simpl; simpl in H1; right; symmetry ; assumption. + assert (H2 : In (pos_Rl (cons_ORlist (r :: l1) l2) (pred (length (cons_ORlist (r :: l1) l2)))) (cons_ORlist (r :: l1) l2)); [ elim (RList_P3 (cons_ORlist (r :: l1) l2) (pos_Rl (cons_ORlist (r :: l1) l2) (pred (length (cons_ORlist (r :: l1) l2))))); intros; apply H3; exists (pred (length (cons_ORlist (r :: l1) l2))); split; [ reflexivity | rewrite RList_P11; simpl; apply Nat.lt_succ_diag_r ] | elim (RList_P9 (r :: l1) l2 (pos_Rl (cons_ORlist (r :: l1) l2) (pred (length (cons_ORlist (r :: l1) l2))))); intros; assert (H5 := H3 H2); elim H5; intro; [ apply RList_P7; assumption | rewrite H1; apply RList_P7; assumption ] ]. - induction l1 as [| r l1 Hrecl1]. + simpl; simpl in H1; right; assumption. + elim (RList_P9 (r :: l1) l2 (pos_Rl (r :: l1) (pred (length (r :: l1))))). intros; assert (H4 : In (pos_Rl (r :: l1) (pred (length (r :: l1)))) (r :: l1) \/ In (pos_Rl (r :: l1) (pred (length (r :: l1)))) l2); [ left; change (In (pos_Rl (r :: l1) (length l1)) (r :: l1)); elim (RList_P3 (r :: l1) (pos_Rl (r :: l1) (length l1))); intros; apply H5; exists (length l1); split; [ reflexivity | simpl; apply Nat.lt_succ_diag_r ] | assert (H5 := H3 H4); apply RList_P7; [ apply RList_P2; assumption | elim (RList_P9 (r :: l1) l2 (pos_Rl (r :: l1) (pred (length (r :: l1))))); intros; apply H7; left; elim (RList_P3 (r :: l1) (pos_Rl (r :: l1) (pred (length (r :: l1))))); intros; apply H9; exists (pred (length (r :: l1))); split; [ reflexivity | simpl; apply Nat.lt_succ_diag_r ] ] ]. Qed. Lemma RList_P17 : forall (l1:list R) (x:R) (i:nat), ordered_Rlist l1 -> In x l1 -> pos_Rl l1 i < x -> (i < pred (length l1))%nat -> pos_Rl l1 (S i) <= x. Proof. induction l1 as [ | r r0 H]. - intros; elim H0. - intros; induction i as [| i Hreci]. + simpl; elim H1; intro; [ simpl in H2; rewrite H4 in H2; elim (Rlt_irrefl _ H2) | apply RList_P5; [ apply RList_P4 with r; assumption | assumption ] ]. + simpl; simpl in H2; elim H1; intro. * rewrite <- H4 in H2; assert (H5 : r <= pos_Rl r0 i); [ apply Rle_trans with (pos_Rl r0 0); [ apply (H0 0%nat); simpl; simpl in H3; apply Nat.neq_0_lt_0; red; intro; rewrite H5 in H3; elim (Nat.nlt_0_r _ H3) | elim (RList_P6 r0); intros; apply H5; [ apply RList_P4 with r; assumption | apply Nat.le_0_l | simpl in H3; apply Nat.succ_lt_mono; apply Nat.lt_trans with (length r0); [ apply H3 | apply Nat.lt_succ_diag_r ] ] ] | elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H5 H2)) ]. * apply H; try assumption; [ apply RList_P4 with r; assumption | simpl in H3; apply Nat.succ_lt_mono; replace (S (pred (length r0))) with (length r0); [ apply H3 | symmetry; apply Nat.lt_succ_pred with 0%nat; apply Nat.neq_0_lt_0; red; intro; rewrite H5 in H3; elim (Nat.nlt_0_r _ H3) ] ]. Qed. Lemma RList_P18 : forall (l:list R) (f:R -> R), length (map f l) = length l. Proof. simple induction l; intros; [ reflexivity | simpl; rewrite H; reflexivity ]. Qed. Lemma RList_P19 : forall l:list R, l <> nil -> exists r : R, (exists r0 : list R, l = r :: r0). Proof. intros; induction l as [| r l Hrecl]; [ elim H; reflexivity | exists r; exists l; reflexivity ]. Qed. Lemma RList_P20 : forall l:list R, (2 <= length l)%nat -> exists r : R, (exists r1 : R, (exists l' : list R, l = r :: r1 :: l')). Proof. intros; induction l as [| r l Hrecl]; [ simpl in H; elim (Nat.nle_succ_0 _ H) | induction l as [| r0 l Hrecl0]; [ simpl in H; elim (Nat.nle_succ_0 _ (le_S_n _ _ H)) | exists r; exists r0; exists l; reflexivity ] ]. Qed. Lemma RList_P21 : forall l l':list R, l = l' -> Rtail l = Rtail l'. Proof. intros; rewrite H; reflexivity. Qed. Lemma RList_P22 : forall l1 l2:list R, l1 <> nil -> pos_Rl (app l1 l2) 0 = pos_Rl l1 0. Proof. simple induction l1; [ intros; elim H; reflexivity | intros; reflexivity ]. Qed. Lemma RList_P24 : forall l1 l2:list R, l2 <> nil -> pos_Rl (app l1 l2) (pred (length (app l1 l2))) = pos_Rl l2 (pred (length l2)). Proof. induction l1 as [ | r r0 H]. - intros; reflexivity. - intros; rewrite <- (H l2 H0); induction l2 as [| r1 l2 Hrecl2]. + elim H0; reflexivity. + do 2 rewrite length_app; replace (length (r :: r0) + length (r1 :: l2))%nat with (S (S (length r0 + length l2))); [ replace (length r0 + length (r1 :: l2))%nat with (S (length r0 + length l2)); [ reflexivity | simpl; apply INR_eq; rewrite S_INR; do 2 rewrite plus_INR; rewrite S_INR; ring ] | simpl; apply INR_eq; do 3 rewrite S_INR; do 2 rewrite plus_INR; rewrite S_INR; ring ]. Qed. Lemma RList_P25 : forall l1 l2:list R, ordered_Rlist l1 -> ordered_Rlist l2 -> pos_Rl l1 (pred (length l1)) <= pos_Rl l2 0 -> ordered_Rlist (app l1 l2). Proof. induction l1 as [ | r r0 H]. - intros; simpl; assumption. - induction r0 as [ | r1 r2 H0]. + intros; simpl; simpl in H2; unfold ordered_Rlist; intros; simpl in H3. induction i as [| i Hreci]. * simpl; assumption. * change (pos_Rl l2 i <= pos_Rl l2 (S i)); apply (H1 i); apply Nat.succ_lt_mono; replace (S (pred (length l2))) with (length l2); [ assumption | symmetry; apply Nat.lt_succ_pred with 0%nat; apply Nat.neq_0_lt_0; red; intro; rewrite H4 in H3; elim (Nat.nlt_0_r _ H3) ]. + intros; assert (H4 : ordered_Rlist (app (r1 :: r2) l2)). * apply H; try assumption. apply RList_P4 with r; assumption. * unfold ordered_Rlist; intros i H5; simpl in H5. induction i as [| i Hreci]. -- simpl; apply (H1 0%nat); simpl; apply Nat.lt_0_succ. -- change (pos_Rl (app (r1 :: r2) l2) i <= pos_Rl (app (r1 :: r2) l2) (S i)); apply (H4 i); simpl; apply Nat.succ_lt_mono; assumption. Qed. Lemma RList_P26 : forall (l1 l2:list R) (i:nat), (i < length l1)%nat -> pos_Rl (app l1 l2) i = pos_Rl l1 i. Proof. simple induction l1. - intros; elim (Nat.nlt_0_r _ H). - intros; induction i as [| i Hreci]. + apply RList_P22; discriminate. + apply (H l2 i); simpl in H0; apply Nat.succ_lt_mono; assumption. Qed. Lemma RList_P29 : forall (l2 l1:list R) (i:nat), (length l1 <= i)%nat -> (i < length (app l1 l2))%nat -> pos_Rl (app l1 l2) i = pos_Rl l2 (i - length l1). Proof. induction l2 as [ | r r0 H]. - intros; rewrite app_nil_r in H0; elim (Nat.lt_irrefl _ (Nat.le_lt_trans _ _ _ H H0)). - intros; replace (app l1 (r :: r0)) with (app (app l1 (r :: nil)) r0). + inversion H0. * rewrite Nat.sub_diag; simpl; rewrite RList_P26. -- clear r0 H i H0 H1 H2; induction l1 as [| r0 l1 Hrecl1]. ++ reflexivity. ++ simpl; assumption. -- rewrite length_app; rewrite Nat.add_comm; simpl; apply Nat.lt_succ_diag_r. * replace (S m - length l1)%nat with (S (S m - S (length l1))). -- rewrite H3; simpl; replace (S (length l1)) with (length (app l1 (r :: nil))). ++ apply (H (app l1 (r :: nil)) i). ** rewrite length_app; rewrite Nat.add_comm; simpl; rewrite <- H3; apply le_n_S; assumption. ** repeat rewrite length_app; simpl; rewrite length_app in H1; rewrite Nat.add_comm in H1; simpl in H1; rewrite (Nat.add_comm (length l1)); simpl; rewrite Nat.add_comm; apply H1. ++ rewrite length_app; rewrite Nat.add_comm; reflexivity. -- change (S (m - length l1) = (S m - length l1)%nat); symmetry; apply Nat.sub_succ_l; assumption. + replace (r :: r0) with (app (r :: nil) r0); [ symmetry ; apply app_assoc | reflexivity ]. Qed. coq-8.20.0/theories/Reals/ROrderedType.v000066400000000000000000000055331466560755400200420ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* r2}. Proof. intros; generalize (total_order_T r1 r2) Rlt_dichotomy_converse; intuition eauto. Qed. Definition Reqb r1 r2 := if Req_dec r1 r2 then true else false. Lemma Reqb_eq : forall r1 r2, Reqb r1 r2 = true <-> r1=r2. Proof. intros; unfold Reqb; destruct Req_dec as [EQ|NEQ]; auto with *. split; try discriminate. intro EQ; elim NEQ; auto. Qed. Module R_as_UBE <: UsualBoolEq. Definition t := R. Definition eq := @eq R. Definition eqb := Reqb. Definition eqb_eq := Reqb_eq. End R_as_UBE. Module R_as_DT <: UsualDecidableTypeFull := Make_UDTF R_as_UBE. (** Note that the last module fulfills by subtyping many other interfaces, such as [DecidableType] or [EqualityType]. *) (** Note that [R_as_DT] can also be seen as a [DecidableType] and a [DecidableTypeOrig]. *) (** * OrderedType structure for binary integers *) Definition Rcompare x y := match total_order_T x y with | inleft (left _) => Lt | inleft (right _) => Eq | inright _ => Gt end. Lemma Rcompare_spec : forall x y, CompareSpec (x=y) (xLogic.eq==>iff) Rlt. Proof. repeat red; intros; subst; auto. Qed. Lemma le_lteq : forall x y, x <= y <-> x < y \/ x = y. Proof. unfold Rle; auto with *. Qed. Definition compare_spec := Rcompare_spec. End R_as_OT. (** Note that [R_as_OT] can also be seen as a [UsualOrderedType] and a [OrderedType] (and also as a [DecidableType]). *) (** * An [order] tactic for real numbers *) Module ROrder := OTF_to_OrderTac R_as_OT. Ltac r_order := ROrder.order. (** Note that [r_order] is domain-agnostic: it will not prove [1<=2] or [x<=x+x], but rather things like [x<=y -> y<=x -> x=y]. *) coq-8.20.0/theories/Reals/R_Ifp.v000066400000000000000000000424211466560755400164660ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* IZR z <= r + 1 -> z = up r. Proof. intros r z Hlt Hle. destruct (archimed r) as [Hlt'%Ropp_lt_contravar Hle'%Ropp_le_contravar]. apply (Rplus_le_compat_l (- r)) in Hle'. rewrite Ropp_minus_distr, Rminus_def, <-Rplus_assoc, Rplus_opp_l, Rplus_0_l in Hle'. apply Z.sub_move_0_r, one_IZR_lt1; split; rewrite minus_IZR. - replace (-1) with (r + (- r + - 1)) by (now rewrite <-Rplus_assoc, Rplus_opp_r, Rplus_0_l). now apply Rplus_lt_le_compat. - replace 1 with (r + 1 + -r) by (now rewrite (Rplus_comm r), Rplus_assoc, Rplus_opp_r, Rplus_0_r). now apply Rplus_le_lt_compat. Qed. Lemma Int_part_spec : forall r z, r - 1 < IZR z <= r -> z = Int_part r. Proof. unfold Int_part; intros r z [Hle Hlt]; apply Z.add_move_r, tech_up. - rewrite <-(Rplus_0_r r), <-(Rplus_opp_l 1), <-Rplus_assoc, plus_IZR. now apply Rplus_lt_compat_r. - now rewrite plus_IZR; apply Rplus_le_compat_r. Qed. (**********) Lemma up_tech : forall (r:R) (z:Z), IZR z <= r -> r < IZR (z + 1) -> (z + 1)%Z = up r. Proof. intros. apply tech_up with (1 := H0). rewrite plus_IZR. now apply Rplus_le_compat_r. Qed. (**********) Lemma fp_R0 : frac_part 0 = 0. Proof. unfold frac_part, Int_part. replace (up 0) with 1%Z. - now rewrite <- minus_IZR. - destruct (archimed 0) as [H1 H2]. apply lt_IZR in H1. rewrite <- minus_IZR in H2. apply le_IZR in H2. normZ. + slia H2 HZ. + slia H1 HZ. Qed. (**********) Lemma for_base_fp : forall r:R, IZR (up r) - r > 0 /\ IZR (up r) - r <= 1. Proof. intro; split; cut (IZR (up r) > r /\ IZR (up r) - r <= 1). - intro; elim H; intros. apply (Rgt_minus (IZR (up r)) r H0). - apply archimed. - intro; elim H; intros. exact H1. - apply archimed. Qed. (**********) Lemma base_fp : forall r:R, frac_part r >= 0 /\ frac_part r < 1. Proof. intro; unfold frac_part; unfold Int_part; split. - (*sup a O*) cut (r - IZR (up r) >= -1). + rewrite <- Z_R_minus; simpl; intro; unfold Rminus; rewrite Ropp_plus_distr; rewrite <- Rplus_assoc; fold (r - IZR (up r)); fold (r - IZR (up r) - -1); apply Rge_minus; auto with zarith real. + rewrite <- Ropp_minus_distr; apply Ropp_le_ge_contravar; elim (for_base_fp r); auto with zarith real. - (*inf a 1*) cut (r - IZR (up r) < 0). + rewrite <- Z_R_minus; simpl; intro; unfold Rminus; rewrite Ropp_plus_distr; rewrite <- Rplus_assoc; fold (r - IZR (up r)); rewrite Ropp_involutive; elim (Rplus_ne 1); intros a b; pattern 1 at 2; rewrite <- a; clear a b; rewrite (Rplus_comm (r - IZR (up r)) 1); apply Rplus_lt_compat_l; auto with zarith real. + elim (for_base_fp r); intros; rewrite <- Ropp_0; rewrite <- Ropp_minus_distr; apply Ropp_gt_lt_contravar; auto with zarith real. Qed. (*********************************************************) (** * Properties *) (*********************************************************) (**********) Lemma base_Int_part : forall r:R, IZR (Int_part r) <= r /\ IZR (Int_part r) - r > -1. Proof. intro; unfold Int_part; elim (archimed r); intros. split; rewrite <- (Z_R_minus (up r) 1); simpl. - apply Rminus_le. replace (IZR (up r) - 1 - r) with (IZR (up r) - r - 1) by ring. now apply Rle_minus. - apply Rminus_gt. replace (IZR (up r) - 1 - r - -1) with (IZR (up r) - r) by ring. now apply Rgt_minus. Qed. (**********) Lemma Int_part_INR : forall n:nat, Int_part (INR n) = Z.of_nat n. Proof. intros n; unfold Int_part. cut (up (INR n) = (Z.of_nat n + Z.of_nat 1)%Z). - intros H'; rewrite H'; simpl; ring. - symmetry; apply tech_up; auto. + replace (Z.of_nat n + Z.of_nat 1)%Z with (Z.of_nat (S n)). * repeat rewrite <- INR_IZR_INZ. apply lt_INR; auto. * rewrite Z.add_comm; rewrite <- Znat.Nat2Z.inj_add; simpl; auto. + rewrite plus_IZR; simpl; auto with real. repeat rewrite <- INR_IZR_INZ; auto with real. Qed. (**********) Lemma fp_nat : forall r:R, frac_part r = 0 -> exists c : Z, r = IZR c. Proof. unfold frac_part; intros; split with (Int_part r); apply Rminus_diag_uniq; auto with zarith real. Qed. (**********) Lemma R0_fp_O : forall r:R, 0 <> frac_part r -> 0 <> r. Proof. red; intros; rewrite <- H0 in H; generalize fp_R0; intro; auto with zarith real. Qed. Lemma Rplus_Int_part_frac_part : forall r, r = IZR (Int_part r) + frac_part r. Proof. now unfold frac_part; intros r; rewrite Rplus_minus. Qed. Lemma Int_part_frac_part_spec : forall r z f, 0 <= f < 1 -> r = (IZR z) + f -> z = Int_part r /\ f = frac_part r. Proof. intros r z f [Hlef Hltf] E%(Rminus_eq_compat_r f); rewrite Rplus_minus_r in E. assert (IP : z = Int_part r). { apply Int_part_spec; split. - now rewrite <-E; apply Rplus_lt_compat_l, Ropp_lt_contravar. - rewrite <-E; apply (Rplus_le_reg_r f). rewrite <-Rplus_minus_swap, Rplus_minus_r, <-(Rplus_0_r r) at 1. now apply Rplus_le_compat_l. } split; try easy. unfold frac_part. now rewrite <-IP, <-E, Rminus_def, Ropp_minus_distr, Rplus_minus. Qed. (**********) Lemma Rminus_Int_part1 : forall r1 r2:R, frac_part r1 >= frac_part r2 -> Int_part (r1 - r2) = (Int_part r1 - Int_part r2)%Z. Proof. intros r1 r2 H; symmetry. apply (Int_part_frac_part_spec _ _ (frac_part r1 - frac_part r2)). - split. + apply (Rplus_le_reg_r (frac_part r2)). rewrite Rplus_0_l, <-Rplus_minus_swap, Rplus_minus_r. now apply Rge_le. + rewrite <-(Rminus_0_r 1); apply Rplus_lt_le_compat. * now apply base_fp. * now apply Ropp_le_contravar, Rge_le, base_fp. - rewrite (Rplus_Int_part_frac_part r1) at 1. rewrite (Rplus_Int_part_frac_part r2) at 1. rewrite minus_IZR, Rplus_minus_swap, Rminus_def at 1. rewrite Ropp_plus_distr, !Rplus_assoc, (Rplus_comm _ (frac_part r1)). now unfold Rminus; rewrite !Rplus_assoc. Qed. (**********) Lemma Rminus_Int_part2 : forall r1 r2:R, frac_part r1 < frac_part r2 -> Int_part (r1 - r2) = (Int_part r1 - Int_part r2 - 1)%Z. Proof. intros r1 r2 H; symmetry. apply (Int_part_frac_part_spec _ _ (frac_part r1 - frac_part r2 + 1)). - split. + apply (Rplus_le_reg_r (- 1)). rewrite !Rplus_assoc, Rplus_opp_r, Rplus_0_r. apply Rplus_le_compat. * now apply Rge_le, base_fp. * apply Ropp_le_contravar; left; apply base_fp. + rewrite <-(Rplus_0_l 1) at 2. now apply Rplus_lt_compat_r, Rlt_minus_0. - rewrite (Rplus_Int_part_frac_part r1) at 1. rewrite (Rplus_Int_part_frac_part r2) at 1. rewrite !minus_IZR, Rplus_minus_swap, Rminus_def at 1. rewrite Ropp_plus_distr, !Rplus_assoc, (Rplus_comm _ (frac_part r1)). unfold Rminus. rewrite (Rplus_assoc _ (- 1)), (Rplus_comm (- 1)). now rewrite !Rplus_assoc, Rplus_opp_r, Rplus_0_r. Qed. (**********) Lemma Rminus_fp1 : forall r1 r2:R, frac_part r1 >= frac_part r2 -> frac_part (r1 - r2) = frac_part r1 - frac_part r2. Proof. intros r1 r2 H%Rminus_Int_part1; unfold frac_part. rewrite H, minus_IZR; unfold Rminus; rewrite !Ropp_plus_distr, Ropp_involutive. rewrite (Rplus_assoc r1), <-(Rplus_assoc (- r2)), (Rplus_comm (- r2)). now rewrite !Rplus_assoc. Qed. (**********) Lemma Rminus_fp2 : forall r1 r2:R, frac_part r1 < frac_part r2 -> frac_part (r1 - r2) = frac_part r1 - frac_part r2 + 1. Proof. intros r1 r2 H%Rminus_Int_part2; unfold frac_part. rewrite H, !minus_IZR; unfold Rminus; rewrite !Ropp_plus_distr, !Ropp_involutive. rewrite (Rplus_assoc r1), <-!(Rplus_assoc (- r2)), (Rplus_comm (- r2)). now rewrite !Rplus_assoc. Qed. (**********) Lemma plus_Int_part1 : forall r1 r2:R, frac_part r1 + frac_part r2 >= 1 -> Int_part (r1 + r2) = (Int_part r1 + Int_part r2 + 1)%Z. Proof. intros; generalize (Rge_le (frac_part r1 + frac_part r2) 1 H); intro; clear H; elim (base_fp r1); elim (base_fp r2); intros; clear H H2; generalize (Rplus_lt_compat_l (frac_part r2) (frac_part r1) 1 H3); intro; clear H3; generalize (Rplus_lt_compat_l 1 (frac_part r2) 1 H1); intro; clear H1; rewrite (Rplus_comm 1 (frac_part r2)) in H2; generalize (Rlt_trans (frac_part r2 + frac_part r1) (frac_part r2 + 1) 2 H H2); intro; clear H H2; rewrite (Rplus_comm (frac_part r2) (frac_part r1)) in H1; unfold frac_part in H0, H1; unfold Rminus in H0, H1; rewrite (Rplus_assoc r1 (- IZR (Int_part r1)) (r2 + - IZR (Int_part r2))) in H1; rewrite (Rplus_comm r2 (- IZR (Int_part r2))) in H1; rewrite <- (Rplus_assoc (- IZR (Int_part r1)) (- IZR (Int_part r2)) r2) in H1; rewrite (Rplus_comm (- IZR (Int_part r1) + - IZR (Int_part r2)) r2) in H1; rewrite <- (Rplus_assoc r1 r2 (- IZR (Int_part r1) + - IZR (Int_part r2))) in H1; rewrite <- (Ropp_plus_distr (IZR (Int_part r1)) (IZR (Int_part r2))) in H1; rewrite (Rplus_assoc r1 (- IZR (Int_part r1)) (r2 + - IZR (Int_part r2))) in H0; rewrite (Rplus_comm r2 (- IZR (Int_part r2))) in H0; rewrite <- (Rplus_assoc (- IZR (Int_part r1)) (- IZR (Int_part r2)) r2) in H0; rewrite (Rplus_comm (- IZR (Int_part r1) + - IZR (Int_part r2)) r2) in H0; rewrite <- (Rplus_assoc r1 r2 (- IZR (Int_part r1) + - IZR (Int_part r2))) in H0; rewrite <- (Ropp_plus_distr (IZR (Int_part r1)) (IZR (Int_part r2))) in H0; generalize (Rplus_le_compat_l (IZR (Int_part r1) + IZR (Int_part r2)) 1 (r1 + r2 + - (IZR (Int_part r1) + IZR (Int_part r2))) H0); intro; clear H0; generalize (Rplus_lt_compat_l (IZR (Int_part r1) + IZR (Int_part r2)) (r1 + r2 + - (IZR (Int_part r1) + IZR (Int_part r2))) 2 H1); intro; clear H1; rewrite (Rplus_comm (r1 + r2) (- (IZR (Int_part r1) + IZR (Int_part r2)))) in H; rewrite <- (Rplus_assoc (IZR (Int_part r1) + IZR (Int_part r2)) (- (IZR (Int_part r1) + IZR (Int_part r2))) (r1 + r2)) in H; rewrite (Rplus_opp_r (IZR (Int_part r1) + IZR (Int_part r2))) in H; elim (Rplus_ne (r1 + r2)); intros a b; rewrite b in H; clear a b; rewrite (Rplus_comm (r1 + r2) (- (IZR (Int_part r1) + IZR (Int_part r2)))) in H0; rewrite <- (Rplus_assoc (IZR (Int_part r1) + IZR (Int_part r2)) (- (IZR (Int_part r1) + IZR (Int_part r2))) (r1 + r2)) in H0; rewrite (Rplus_opp_r (IZR (Int_part r1) + IZR (Int_part r2))) in H0; elim (Rplus_ne (r1 + r2)); intros a b; rewrite b in H0; clear a b; change 2 with (1 + 1) in H0; rewrite <- (Rplus_assoc (IZR (Int_part r1) + IZR (Int_part r2)) 1 1) in H0; auto with real. rewrite <- (plus_IZR (Int_part r1) (Int_part r2)) in H; rewrite <- (plus_IZR (Int_part r1) (Int_part r2)) in H0; rewrite <- (plus_IZR (Int_part r1 + Int_part r2) 1) in H; rewrite <- (plus_IZR (Int_part r1 + Int_part r2) 1) in H0; rewrite <- (plus_IZR (Int_part r1 + Int_part r2 + 1) 1) in H0; generalize (up_tech (r1 + r2) (Int_part r1 + Int_part r2 + 1) H H0); intro; clear H H0; unfold Int_part at 1. normZ. - slia H HZ. - slia H0 HZ. Qed. (**********) Lemma plus_Int_part2 : forall r1 r2:R, frac_part r1 + frac_part r2 < 1 -> Int_part (r1 + r2) = (Int_part r1 + Int_part r2)%Z. Proof. intros; elim (base_fp r1); elim (base_fp r2); intros; clear H1 H3; generalize (Rge_le (frac_part r2) 0 H0); intro; clear H0; generalize (Rge_le (frac_part r1) 0 H2); intro; clear H2; generalize (Rplus_le_compat_l (frac_part r1) 0 (frac_part r2) H1); intro; clear H1; elim (Rplus_ne (frac_part r1)); intros a b; rewrite a in H2; clear a b; generalize (Rle_trans 0 (frac_part r1) (frac_part r1 + frac_part r2) H0 H2); intro; clear H0 H2; unfold frac_part in H, H1; unfold Rminus in H, H1; rewrite (Rplus_assoc r1 (- IZR (Int_part r1)) (r2 + - IZR (Int_part r2))) in H1; rewrite (Rplus_comm r2 (- IZR (Int_part r2))) in H1; rewrite <- (Rplus_assoc (- IZR (Int_part r1)) (- IZR (Int_part r2)) r2) in H1; rewrite (Rplus_comm (- IZR (Int_part r1) + - IZR (Int_part r2)) r2) in H1; rewrite <- (Rplus_assoc r1 r2 (- IZR (Int_part r1) + - IZR (Int_part r2))) in H1; rewrite <- (Ropp_plus_distr (IZR (Int_part r1)) (IZR (Int_part r2))) in H1; rewrite (Rplus_assoc r1 (- IZR (Int_part r1)) (r2 + - IZR (Int_part r2))) in H; rewrite (Rplus_comm r2 (- IZR (Int_part r2))) in H; rewrite <- (Rplus_assoc (- IZR (Int_part r1)) (- IZR (Int_part r2)) r2) in H; rewrite (Rplus_comm (- IZR (Int_part r1) + - IZR (Int_part r2)) r2) in H; rewrite <- (Rplus_assoc r1 r2 (- IZR (Int_part r1) + - IZR (Int_part r2))) in H; rewrite <- (Ropp_plus_distr (IZR (Int_part r1)) (IZR (Int_part r2))) in H; generalize (Rplus_le_compat_l (IZR (Int_part r1) + IZR (Int_part r2)) 0 (r1 + r2 + - (IZR (Int_part r1) + IZR (Int_part r2))) H1); intro; clear H1; generalize (Rplus_lt_compat_l (IZR (Int_part r1) + IZR (Int_part r2)) (r1 + r2 + - (IZR (Int_part r1) + IZR (Int_part r2))) 1 H); intro; clear H; rewrite (Rplus_comm (r1 + r2) (- (IZR (Int_part r1) + IZR (Int_part r2)))) in H1; rewrite <- (Rplus_assoc (IZR (Int_part r1) + IZR (Int_part r2)) (- (IZR (Int_part r1) + IZR (Int_part r2))) (r1 + r2)) in H1; rewrite (Rplus_opp_r (IZR (Int_part r1) + IZR (Int_part r2))) in H1; elim (Rplus_ne (r1 + r2)); intros a b; rewrite b in H1; clear a b; rewrite (Rplus_comm (r1 + r2) (- (IZR (Int_part r1) + IZR (Int_part r2)))) in H0; rewrite <- (Rplus_assoc (IZR (Int_part r1) + IZR (Int_part r2)) (- (IZR (Int_part r1) + IZR (Int_part r2))) (r1 + r2)) in H0; rewrite (Rplus_opp_r (IZR (Int_part r1) + IZR (Int_part r2))) in H0; elim (Rplus_ne (IZR (Int_part r1) + IZR (Int_part r2))); intros a b; rewrite a in H0; clear a b; elim (Rplus_ne (r1 + r2)); intros a b; rewrite b in H0; clear a b. rewrite <- (plus_IZR (Int_part r1) (Int_part r2)) in H0; rewrite <- (plus_IZR (Int_part r1) (Int_part r2)) in H1; rewrite <- (plus_IZR (Int_part r1 + Int_part r2) 1) in H1; generalize (up_tech (r1 + r2) (Int_part r1 + Int_part r2) H0 H1); intro; clear H0 H1; unfold Int_part at 1. normZ. - slia H HZ. - slia H0 HZ. Qed. (**********) Lemma plus_frac_part1 : forall r1 r2:R, frac_part r1 + frac_part r2 >= 1 -> frac_part (r1 + r2) = frac_part r1 + frac_part r2 - 1. Proof. intros; unfold frac_part; generalize (plus_Int_part1 r1 r2 H); intro; rewrite H0; rewrite (plus_IZR (Int_part r1 + Int_part r2) 1); rewrite (plus_IZR (Int_part r1) (Int_part r2)); simpl; unfold Rminus at 3 4; rewrite (Rplus_assoc r1 (- IZR (Int_part r1)) (r2 + - IZR (Int_part r2))); rewrite (Rplus_comm r2 (- IZR (Int_part r2))); rewrite <- (Rplus_assoc (- IZR (Int_part r1)) (- IZR (Int_part r2)) r2); rewrite (Rplus_comm (- IZR (Int_part r1) + - IZR (Int_part r2)) r2); rewrite <- (Rplus_assoc r1 r2 (- IZR (Int_part r1) + - IZR (Int_part r2))); rewrite <- (Ropp_plus_distr (IZR (Int_part r1)) (IZR (Int_part r2))); unfold Rminus; rewrite (Rplus_assoc (r1 + r2) (- (IZR (Int_part r1) + IZR (Int_part r2))) (-(1))) ; rewrite <- (Ropp_plus_distr (IZR (Int_part r1) + IZR (Int_part r2)) 1); trivial with real. Qed. (**********) Lemma plus_frac_part2 : forall r1 r2:R, frac_part r1 + frac_part r2 < 1 -> frac_part (r1 + r2) = frac_part r1 + frac_part r2. Proof. intros; unfold frac_part; generalize (plus_Int_part2 r1 r2 H); intro; rewrite H0; rewrite (plus_IZR (Int_part r1) (Int_part r2)); unfold Rminus at 2 3; rewrite (Rplus_assoc r1 (- IZR (Int_part r1)) (r2 + - IZR (Int_part r2))); rewrite (Rplus_comm r2 (- IZR (Int_part r2))); rewrite <- (Rplus_assoc (- IZR (Int_part r1)) (- IZR (Int_part r2)) r2); rewrite (Rplus_comm (- IZR (Int_part r1) + - IZR (Int_part r2)) r2); rewrite <- (Rplus_assoc r1 r2 (- IZR (Int_part r1) + - IZR (Int_part r2))); rewrite <- (Ropp_plus_distr (IZR (Int_part r1)) (IZR (Int_part r2))); unfold Rminus; trivial with zarith real. Qed. coq-8.20.0/theories/Reals/R_sqr.v000066400000000000000000000271361466560755400165630ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* x <> 0. Proof. intros; red; intro; rewrite H0 in H; rewrite Rsqr_0 in H; elim (Rlt_irrefl 0 H). Qed. Lemma Rsqr_pos_lt : forall x:R, x <> 0 -> 0 < Rsqr x. Proof. intros; case (Rtotal_order 0 x); intro; [ unfold Rsqr; apply Rmult_lt_0_compat; assumption | elim H0; intro; [ elim H; symmetry ; exact H1 | rewrite Rsqr_neg; generalize (Ropp_lt_gt_contravar x 0 H1); rewrite Ropp_0; intro; unfold Rsqr; apply Rmult_lt_0_compat; assumption ] ]. Qed. Lemma Rsqr_div' x y : Rsqr (x / y) = Rsqr x / Rsqr y. Proof. unfold Rsqr, Rdiv. rewrite Rinv_mult. ring. Qed. Lemma Rsqr_div_depr : forall x y:R, y <> 0 -> Rsqr (x / y) = Rsqr x / Rsqr y. Proof. intros x y _. apply Rsqr_div'. Qed. #[deprecated(since="8.16",note="Use Rsqr_div'.")] Notation Rsqr_div := Rsqr_div_depr. Lemma Rsqr_eq_0 : forall x:R, Rsqr x = 0 -> x = 0. Proof. unfold Rsqr; intros; generalize (Rmult_integral x x H); intro; elim H0; intro; assumption. Qed. Lemma Rsqr_minus_plus : forall a b:R, (a - b) * (a + b) = Rsqr a - Rsqr b. Proof. intros; ring_Rsqr. Qed. Lemma Rsqr_plus_minus : forall a b:R, (a + b) * (a - b) = Rsqr a - Rsqr b. Proof. intros; ring_Rsqr. Qed. Lemma Rsqr_incr_0 : forall x y:R, Rsqr x <= Rsqr y -> 0 <= x -> 0 <= y -> x <= y. Proof. intros; destruct (Rle_dec x y) as [Hle|Hnle]; [ assumption | cut (y < x); [ intro; unfold Rsqr in H; generalize (Rmult_le_0_lt_compat y x y x H1 H1 H2 H2); intro; generalize (Rle_lt_trans (x * x) (y * y) (x * x) H H3); intro; elim (Rlt_irrefl (x * x) H4) | auto with real ] ]. Qed. Lemma Rsqr_incr_0_var : forall x y:R, Rsqr x <= Rsqr y -> 0 <= y -> x <= y. Proof. intros; destruct (Rle_dec x y) as [Hle|Hnle]; [ assumption | cut (y < x); [ intro; unfold Rsqr in H; generalize (Rmult_le_0_lt_compat y x y x H0 H0 H1 H1); intro; generalize (Rle_lt_trans (x * x) (y * y) (x * x) H H2); intro; elim (Rlt_irrefl (x * x) H3) | auto with real ] ]. Qed. Lemma Rsqr_incr_1 : forall x y:R, x <= y -> 0 <= x -> 0 <= y -> Rsqr x <= Rsqr y. Proof. intros; unfold Rsqr; apply Rmult_le_compat; assumption. Qed. Lemma Rsqr_incrst_0 : forall x y:R, Rsqr x < Rsqr y -> 0 <= x -> 0 <= y -> x < y. Proof. intros; case (Rtotal_order x y); intro; [ assumption | elim H2; intro; [ rewrite H3 in H; elim (Rlt_irrefl (Rsqr y) H) | generalize (Rmult_le_0_lt_compat y x y x H1 H1 H3 H3); intro; unfold Rsqr in H; generalize (Rlt_trans (x * x) (y * y) (x * x) H H4); intro; elim (Rlt_irrefl (x * x) H5) ] ]. Qed. Lemma Rsqr_incrst_1 : forall x y:R, x < y -> 0 <= x -> 0 <= y -> Rsqr x < Rsqr y. Proof. intros; unfold Rsqr; apply Rmult_le_0_lt_compat; assumption. Qed. Lemma Rsqr_neg_pos_le_0 : forall x y:R, Rsqr x <= Rsqr y -> 0 <= y -> - y <= x. Proof. intros; destruct (Rcase_abs x) as [Hlt|Hle]. - generalize (Ropp_lt_gt_contravar x 0 Hlt); rewrite Ropp_0; intro; generalize (Rlt_le 0 (- x) H1); intro; rewrite (Rsqr_neg x) in H; generalize (Rsqr_incr_0 (- x) y H H2 H0); intro; rewrite <- (Ropp_involutive x); apply Ropp_ge_le_contravar; apply Rle_ge; assumption. - apply Rle_trans with 0; [ rewrite <- Ropp_0; apply Ropp_ge_le_contravar; apply Rle_ge; assumption | apply Rge_le; assumption ]. Qed. Lemma Rsqr_neg_pos_le_1 : forall x y:R, - y <= x -> x <= y -> 0 <= y -> Rsqr x <= Rsqr y. Proof. intros x y H H0 H1; destruct (Rcase_abs x) as [Hlt|Hle]. - apply Ropp_lt_gt_contravar, Rlt_le in Hlt; rewrite Ropp_0 in Hlt; apply Ropp_le_ge_contravar, Rge_le in H; rewrite Ropp_involutive in H; rewrite (Rsqr_neg x); apply Rsqr_incr_1; assumption. - apply Rge_le in Hle; apply Rsqr_incr_1; assumption. Qed. Lemma neg_pos_Rsqr_le : forall x y:R, - y <= x -> x <= y -> Rsqr x <= Rsqr y. Proof. intros x y H H0; destruct (Rcase_abs x) as [Hlt|Hle]. - apply Ropp_lt_gt_contravar, Rlt_le in Hlt; rewrite Ropp_0 in Hlt; apply Ropp_le_ge_contravar, Rge_le in H; rewrite Ropp_involutive in H. assert (0 <= y) by (apply Rle_trans with (-x); assumption). rewrite (Rsqr_neg x); apply Rsqr_incr_1; assumption. - apply Rge_le in Hle; assert (0 <= y) by (apply Rle_trans with x; assumption). apply Rsqr_incr_1; assumption. Qed. Lemma neg_pos_Rsqr_lt : forall x y : R, - y < x -> x < y -> Rsqr x < Rsqr y. Proof. intros x y Hneg Hpos. destruct (Rcase_abs x) as [Hlt|HLe]. - rewrite (Rsqr_neg x); apply Rsqr_incrst_1. + rewrite <- (Ropp_involutive y); apply Ropp_lt_contravar; exact Hneg. + rewrite <- (Ropp_0). apply Ropp_le_contravar, Rlt_le; exact Hlt. + apply (Rlt_trans _ _ _ Hneg) in Hlt. rewrite <- (Ropp_0) in Hlt; apply Ropp_lt_cancel in Hlt; apply Rlt_le; exact Hlt. - apply Rsqr_incrst_1. + exact Hpos. + apply Rge_le; exact HLe. + apply Rge_le in HLe. apply (Rle_lt_trans _ _ _ HLe), Rlt_le in Hpos; exact Hpos. Qed. Lemma Rsqr_bounds_le : forall a b:R, -a <= b <= a -> 0 <= Rsqr b <= Rsqr a. Proof. intros a b [H1 H2]. split. - apply Rle_0_sqr. - apply neg_pos_Rsqr_le; assumption. Qed. Lemma Rsqr_bounds_lt : forall a b:R, -a < b < a -> 0 <= Rsqr b < Rsqr a. Proof. intros a b [H1 H2]. split. - apply Rle_0_sqr. - apply neg_pos_Rsqr_lt; assumption. Qed. Lemma Rsqr_abs : forall x:R, Rsqr x = Rsqr (Rabs x). Proof. intro; unfold Rabs; case (Rcase_abs x); intro; [ apply Rsqr_neg | reflexivity ]. Qed. Lemma Rsqr_le_abs_0 : forall x y:R, Rsqr x <= Rsqr y -> Rabs x <= Rabs y. Proof. intros; apply Rsqr_incr_0; repeat rewrite <- Rsqr_abs; [ assumption | apply Rabs_pos | apply Rabs_pos ]. Qed. Lemma Rsqr_le_abs_1 : forall x y:R, Rabs x <= Rabs y -> Rsqr x <= Rsqr y. Proof. intros; rewrite (Rsqr_abs x); rewrite (Rsqr_abs y); apply (Rsqr_incr_1 (Rabs x) (Rabs y) H (Rabs_pos x) (Rabs_pos y)). Qed. Lemma Rsqr_lt_abs_0 : forall x y:R, Rsqr x < Rsqr y -> Rabs x < Rabs y. Proof. intros; apply Rsqr_incrst_0; repeat rewrite <- Rsqr_abs; [ assumption | apply Rabs_pos | apply Rabs_pos ]. Qed. Lemma Rsqr_lt_abs_1 : forall x y:R, Rabs x < Rabs y -> Rsqr x < Rsqr y. Proof. intros; rewrite (Rsqr_abs x); rewrite (Rsqr_abs y); apply (Rsqr_incrst_1 (Rabs x) (Rabs y) H (Rabs_pos x) (Rabs_pos y)). Qed. Lemma Rsqr_inj : forall x y:R, 0 <= x -> 0 <= y -> Rsqr x = Rsqr y -> x = y. Proof. intros; generalize (Rle_le_eq (Rsqr x) (Rsqr y)); intro; elim H2; intros _ H3; generalize (H3 H1); intro; elim H4; intros; apply Rle_antisym; apply Rsqr_incr_0; assumption. Qed. Lemma Rsqr_eq_abs_0 : forall x y:R, Rsqr x = Rsqr y -> Rabs x = Rabs y. Proof. intros; unfold Rabs; case (Rcase_abs x) as [Hltx|Hgex]; case (Rcase_abs y) as [Hlty|Hgey]. - rewrite (Rsqr_neg x), (Rsqr_neg y) in H; generalize (Ropp_lt_gt_contravar y 0 Hlty); generalize (Ropp_lt_gt_contravar x 0 Hltx); rewrite Ropp_0; intros; generalize (Rlt_le 0 (- x) H0); generalize (Rlt_le 0 (- y) H1); intros; apply Rsqr_inj; assumption. - rewrite (Rsqr_neg x) in H; generalize (Rge_le y 0 Hgey); intro; generalize (Ropp_lt_gt_contravar x 0 Hltx); rewrite Ropp_0; intro; generalize (Rlt_le 0 (- x) H1); intro; apply Rsqr_inj; assumption. - rewrite (Rsqr_neg y) in H; generalize (Rge_le x 0 Hgex); intro; generalize (Ropp_lt_gt_contravar y 0 Hlty); rewrite Ropp_0; intro; generalize (Rlt_le 0 (- y) H1); intro; apply Rsqr_inj; assumption. - apply Rsqr_inj; auto using Rge_le. Qed. Lemma Rsqr_eq_asb_1 : forall x y:R, Rabs x = Rabs y -> Rsqr x = Rsqr y. Proof. intros; cut (Rsqr (Rabs x) = Rsqr (Rabs y)). - intro; repeat rewrite <- Rsqr_abs in H0; assumption. - rewrite H; reflexivity. Qed. Lemma triangle_rectangle : forall x y z:R, 0 <= z -> Rsqr x + Rsqr y <= Rsqr z -> - z <= x <= z /\ - z <= y <= z. Proof. intros; generalize (plus_le_is_le (Rsqr x) (Rsqr y) (Rsqr z) (Rle_0_sqr y) H0); rewrite Rplus_comm in H0; generalize (plus_le_is_le (Rsqr y) (Rsqr x) (Rsqr z) (Rle_0_sqr x) H0); intros; split; [ split; [ apply Rsqr_neg_pos_le_0; assumption | apply Rsqr_incr_0_var; assumption ] | split; [ apply Rsqr_neg_pos_le_0; assumption | apply Rsqr_incr_0_var; assumption ] ]. Qed. Lemma triangle_rectangle_lt : forall x y z:R, Rsqr x + Rsqr y < Rsqr z -> Rabs x < Rabs z /\ Rabs y < Rabs z. Proof. intros; split; [ generalize (plus_lt_is_lt (Rsqr x) (Rsqr y) (Rsqr z) (Rle_0_sqr y) H); intro; apply Rsqr_lt_abs_0; assumption | rewrite Rplus_comm in H; generalize (plus_lt_is_lt (Rsqr y) (Rsqr x) (Rsqr z) (Rle_0_sqr x) H); intro; apply Rsqr_lt_abs_0; assumption ]. Qed. Lemma triangle_rectangle_le : forall x y z:R, Rsqr x + Rsqr y <= Rsqr z -> Rabs x <= Rabs z /\ Rabs y <= Rabs z. Proof. intros; split; [ generalize (plus_le_is_le (Rsqr x) (Rsqr y) (Rsqr z) (Rle_0_sqr y) H); intro; apply Rsqr_le_abs_0; assumption | rewrite Rplus_comm in H; generalize (plus_le_is_le (Rsqr y) (Rsqr x) (Rsqr z) (Rle_0_sqr x) H); intro; apply Rsqr_le_abs_0; assumption ]. Qed. Lemma Rsqr_inv' x : Rsqr (/ x) = / Rsqr x. Proof. unfold Rsqr. now rewrite Rinv_mult. Qed. Lemma Rsqr_inv_depr : forall x:R, x <> 0 -> Rsqr (/ x) = / Rsqr x. Proof. intros x _. apply Rsqr_inv'. Qed. #[deprecated(since="8.16",note="Use Rsqr_inv'.")] Notation Rsqr_inv := Rsqr_inv_depr. Lemma canonical_Rsqr : forall (a:nonzeroreal) (b c x:R), a * Rsqr x + b * x + c = a * Rsqr (x + b / (2 * a)) + (4 * a * c - Rsqr b) / (4 * a). Proof. intros. unfold Rsqr. field. apply a. Qed. Lemma Rsqr_eq : forall x y:R, Rsqr x = Rsqr y -> x = y \/ x = - y. Proof. intros; unfold Rsqr in H; generalize (Rplus_eq_compat_l (- (y * y)) (x * x) (y * y) H); rewrite Rplus_opp_l; replace (- (y * y) + x * x) with ((x - y) * (x + y)). - intro; generalize (Rmult_integral (x - y) (x + y) H0); intro; elim H1; intros. + left; apply Rminus_diag_uniq; assumption. + right; apply Rminus_diag_uniq; unfold Rminus; rewrite Ropp_involutive; assumption. - ring. Qed. coq-8.20.0/theories/Reals/R_sqrt.v000066400000000000000000000335771466560755400167550ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* 0 | right a => Rsqrt (mknonnegreal x (Rge_le _ _ a)) end. Lemma sqrt_pos : forall x : R, 0 <= sqrt x. Proof. intros x. unfold sqrt. destruct (Rcase_abs x) as [H|H]. - apply Rle_refl. - apply Rsqrt_positivity. Qed. Lemma sqrt_positivity : forall x:R, 0 <= x -> 0 <= sqrt x. Proof. intros x _. apply sqrt_pos. Qed. Lemma sqrt_sqrt : forall x:R, 0 <= x -> sqrt x * sqrt x = x. Proof. intros. unfold sqrt. case (Rcase_abs x) as [Hlt|Hge]. - elim (Rlt_irrefl _ (Rlt_le_trans _ _ _ Hlt H)). - rewrite Rsqrt_Rsqrt; reflexivity. Qed. Lemma sqrt_0 : sqrt 0 = 0. Proof. apply Rsqr_eq_0; unfold Rsqr; apply sqrt_sqrt; right; reflexivity. Qed. Lemma sqrt_1 : sqrt 1 = 1. Proof. apply (Rsqr_inj (sqrt 1) 1); [ apply sqrt_positivity; left | left | unfold Rsqr; rewrite sqrt_sqrt; [ ring | left ] ]; apply Rlt_0_1. Qed. Lemma sqrt_eq_0 : forall x:R, 0 <= x -> sqrt x = 0 -> x = 0. Proof. intros; cut (Rsqr (sqrt x) = 0). - intro; unfold Rsqr in H1; rewrite sqrt_sqrt in H1; assumption. - rewrite H0; apply Rsqr_0. Qed. Lemma sqrt_lem_0 : forall x y:R, 0 <= x -> 0 <= y -> sqrt x = y -> y * y = x. Proof. intros; rewrite <- H1; apply (sqrt_sqrt x H). Qed. Lemma sqrt_lem_1 : forall x y:R, 0 <= x -> 0 <= y -> y * y = x -> sqrt x = y. Proof. intros; apply Rsqr_inj; [ apply (sqrt_positivity x H) | assumption | unfold Rsqr; rewrite H1; apply (sqrt_sqrt x H) ]. Qed. Lemma sqrt_def : forall x:R, 0 <= x -> sqrt x * sqrt x = x. Proof. intros; apply (sqrt_sqrt x H). Qed. Lemma sqrt_square : forall x:R, 0 <= x -> sqrt (x * x) = x. Proof. intros; apply (Rsqr_inj (sqrt (Rsqr x)) x (sqrt_positivity (Rsqr x) (Rle_0_sqr x)) H); unfold Rsqr; apply (sqrt_sqrt (Rsqr x) (Rle_0_sqr x)). Qed. Lemma sqrt_Rsqr : forall x:R, 0 <= x -> sqrt (Rsqr x) = x. Proof. intros; unfold Rsqr; apply sqrt_square; assumption. Qed. Lemma sqrt_pow2 : forall x, 0 <= x -> sqrt (x ^ 2) = x. intros; simpl; rewrite Rmult_1_r, sqrt_square; auto. Qed. Lemma pow2_sqrt x : 0 <= x -> sqrt x ^ 2 = x. Proof. now intros x0; simpl; rewrite -> Rmult_1_r, sqrt_sqrt. Qed. Lemma sqrt_Rsqr_abs : forall x:R, sqrt (Rsqr x) = Rabs x. Proof. intro x; rewrite Rsqr_abs; apply sqrt_Rsqr; apply Rabs_pos. Qed. Lemma Rsqr_sqrt : forall x:R, 0 <= x -> Rsqr (sqrt x) = x. Proof. intros x H1; unfold Rsqr; apply (sqrt_sqrt x H1). Qed. Lemma sqrt_mult_alt : forall x y : R, 0 <= x -> sqrt (x * y) = sqrt x * sqrt y. Proof. intros x y Hx. unfold sqrt at 3. destruct (Rcase_abs y) as [Hy|Hy]. - rewrite Rmult_0_r. destruct Hx as [Hx'|Hx']. + unfold sqrt. destruct (Rcase_abs (x * y)) as [Hxy|Hxy]. * apply eq_refl. * elim Rge_not_lt with (1 := Hxy). rewrite <- (Rmult_0_r x). now apply Rmult_lt_compat_l. + rewrite <- Hx', Rmult_0_l. exact sqrt_0. - apply Rsqr_inj. + apply sqrt_pos. + apply Rmult_le_pos. * apply sqrt_pos. * apply Rsqrt_positivity. + rewrite Rsqr_mult, 2!Rsqr_sqrt. * unfold Rsqr. now rewrite Rsqrt_Rsqrt. * exact Hx. * apply Rmult_le_pos. -- exact Hx. -- now apply Rge_le. Qed. Lemma sqrt_mult : forall x y:R, 0 <= x -> 0 <= y -> sqrt (x * y) = sqrt x * sqrt y. Proof. intros x y Hx _. now apply sqrt_mult_alt. Qed. Lemma sqrt_lt_R0 : forall x:R, 0 < x -> 0 < sqrt x. Proof. intros x H1; apply Rsqr_incrst_0; [ rewrite Rsqr_0; rewrite Rsqr_sqrt; [ assumption | left; assumption ] | right; reflexivity | apply (sqrt_positivity x (Rlt_le 0 x H1)) ]. Qed. Lemma Rlt_mult_inv_pos : forall x y:R, 0 < x -> 0 < y -> 0 < x * / y. intros x y H H0; try assumption. replace 0 with (x * 0). - apply Rmult_lt_compat_l; auto with real. - ring. Qed. Lemma Rle_mult_inv_pos : forall x y:R, 0 <= x -> 0 < y -> 0 <= x * / y. intros x y H H0; try assumption. case H; intros. - red; left. apply Rlt_mult_inv_pos; auto with real. - rewrite <- H1. red; right; ring. Qed. Lemma sqrt_div_alt : forall x y : R, 0 < y -> sqrt (x / y) = sqrt x / sqrt y. Proof. intros x y Hy. unfold sqrt at 2. destruct (Rcase_abs x) as [Hx|Hx]. - unfold Rdiv. rewrite Rmult_0_l. unfold sqrt. destruct (Rcase_abs (x * / y)) as [Hxy|Hxy]. + apply eq_refl. + elim Rge_not_lt with (1 := Hxy). apply Rmult_lt_reg_r with y. * exact Hy. * rewrite Rmult_assoc, Rinv_l, Rmult_1_r, Rmult_0_l. -- exact Hx. -- now apply Rgt_not_eq. - set (Hx' := Rge_le x 0 Hx). clearbody Hx'. clear Hx. apply Rsqr_inj. + apply sqrt_pos. + apply Rle_mult_inv_pos. * apply Rsqrt_positivity. * now apply sqrt_lt_R0. + rewrite Rsqr_div', 2!Rsqr_sqrt. * unfold Rsqr. now rewrite Rsqrt_Rsqrt. * now apply Rlt_le. * now apply Rle_mult_inv_pos. Qed. Lemma sqrt_div : forall x y:R, 0 <= x -> 0 < y -> sqrt (x / y) = sqrt x / sqrt y. Proof. intros x y _ H. now apply sqrt_div_alt. Qed. Lemma sqrt_lt_0_alt : forall x y : R, sqrt x < sqrt y -> x < y. Proof. intros x y. unfold sqrt at 2. destruct (Rcase_abs y) as [Hy|Hy]. - intros Hx. elim Rlt_not_le with (1 := Hx). apply sqrt_pos. - set (Hy' := Rge_le y 0 Hy). clearbody Hy'. clear Hy. unfold sqrt. destruct (Rcase_abs x) as [Hx|Hx]. + intros _. now apply Rlt_le_trans with R0. + intros Hxy. apply Rsqr_incrst_1 in Hxy ; try apply Rsqrt_positivity. unfold Rsqr in Hxy. now rewrite 2!Rsqrt_Rsqrt in Hxy. Qed. Lemma sqrt_lt_0 : forall x y:R, 0 <= x -> 0 <= y -> sqrt x < sqrt y -> x < y. Proof. intros x y _ _. apply sqrt_lt_0_alt. Qed. Lemma sqrt_lt_1_alt : forall x y : R, 0 <= x < y -> sqrt x < sqrt y. Proof. intros x y (Hx, Hxy). apply Rsqr_incrst_0 ; try apply sqrt_pos. rewrite 2!Rsqr_sqrt. - exact Hxy. - apply Rlt_le. now apply Rle_lt_trans with x. - exact Hx. Qed. Lemma sqrt_lt_1 : forall x y:R, 0 <= x -> 0 <= y -> x < y -> sqrt x < sqrt y. Proof. intros x y Hx _ Hxy. apply sqrt_lt_1_alt. now split. Qed. Lemma sqrt_le_0 : forall x y:R, 0 <= x -> 0 <= y -> sqrt x <= sqrt y -> x <= y. Proof. intros x y H1 H2 H3; generalize (Rsqr_incr_1 (sqrt x) (sqrt y) H3 (sqrt_positivity x H1) (sqrt_positivity y H2)); intro H4; rewrite (Rsqr_sqrt x H1) in H4; rewrite (Rsqr_sqrt y H2) in H4; assumption. Qed. Lemma sqrt_le_1_alt : forall x y : R, x <= y -> sqrt x <= sqrt y. Proof. intros x y [Hxy|Hxy]. - destruct (Rle_or_lt 0 x) as [Hx|Hx]. + apply Rlt_le. apply sqrt_lt_1_alt. now split. + unfold sqrt at 1. destruct (Rcase_abs x) as [Hx'|Hx']. * apply sqrt_pos. * now elim Rge_not_lt with (1 := Hx'). - rewrite Hxy. apply Rle_refl. Qed. Lemma sqrt_le_1 : forall x y:R, 0 <= x -> 0 <= y -> x <= y -> sqrt x <= sqrt y. Proof. intros x y _ _ Hxy. now apply sqrt_le_1_alt. Qed. Lemma sqrt_neg_0 x : x <= 0 -> sqrt x = 0. Proof. intros Hx. apply Rle_le_eq; split. - rewrite <- sqrt_0; apply sqrt_le_1_alt, Hx. - apply sqrt_pos. Qed. Lemma sqrt_inj : forall x y:R, 0 <= x -> 0 <= y -> sqrt x = sqrt y -> x = y. Proof. intros; cut (Rsqr (sqrt x) = Rsqr (sqrt y)). - intro; rewrite (Rsqr_sqrt x H) in H2; rewrite (Rsqr_sqrt y H0) in H2; assumption. - rewrite H1; reflexivity. Qed. Lemma sqrt_less_alt : forall x : R, 1 < x -> sqrt x < x. Proof. intros x Hx. assert (Hx1 := Rle_lt_trans _ _ _ Rle_0_1 Hx). assert (Hx2 := Rlt_le _ _ Hx1). apply Rsqr_incrst_0 ; trivial. - rewrite Rsqr_sqrt ; trivial. rewrite <- (Rmult_1_l x) at 1. now apply Rmult_lt_compat_r. - apply sqrt_pos. Qed. Lemma sqrt_less : forall x:R, 0 <= x -> 1 < x -> sqrt x < x. Proof. intros x _. apply sqrt_less_alt. Qed. Lemma sqrt_more : forall x:R, 0 < x -> x < 1 -> x < sqrt x. Proof. intros x H1 H2; generalize (sqrt_lt_1 x 1 (Rlt_le 0 x H1) (Rlt_le 0 1 Rlt_0_1) H2); intro H3; rewrite sqrt_1 in H3; generalize (Rmult_ne (sqrt x)); intro H4; elim H4; intros H5 H6; rewrite <- H5; pattern x at 1; rewrite <- (sqrt_def x (Rlt_le 0 x H1)); apply (Rmult_lt_compat_l (sqrt x) (sqrt x) 1 (sqrt_lt_R0 x H1) H3). Qed. Lemma sqrt_inv x : sqrt (/ x) = / sqrt x. Proof. destruct (Rlt_or_le 0 x) as [H|H]. - assert (sqrt x <> 0). + apply Rgt_not_eq. now apply sqrt_lt_R0. + apply Rmult_eq_reg_r with (sqrt x); auto. rewrite Rinv_l; auto. rewrite <- sqrt_mult_alt. * now rewrite -> Rinv_l, sqrt_1; auto with real. * apply Rlt_le. now apply Rinv_0_lt_compat. - rewrite sqrt_neg_0 with (1 := H). rewrite sqrt_neg_0. + apply eq_sym, Rinv_0. + destruct H as [H| ->]. * now apply Rlt_le, Rinv_lt_0_compat. * rewrite Rinv_0. apply Rle_refl. Qed. Lemma inv_sqrt_depr x : 0 < x -> / sqrt x = sqrt (/ x). Proof. intros _. apply eq_sym, sqrt_inv. Qed. #[deprecated(since="8.16",note="Use sqrt_inv.")] Notation inv_sqrt := inv_sqrt_depr. Lemma sqrt_cauchy : forall a b c d:R, a * c + b * d <= sqrt (Rsqr a + Rsqr b) * sqrt (Rsqr c + Rsqr d). Proof. intros a b c d; apply Rsqr_incr_0_var; [ rewrite Rsqr_mult; repeat rewrite Rsqr_sqrt; unfold Rsqr; [ replace ((a * c + b * d) * (a * c + b * d)) with (a * a * c * c + b * b * d * d + 2 * a * b * c * d); [ replace ((a * a + b * b) * (c * c + d * d)) with (a * a * c * c + b * b * d * d + (a * a * d * d + b * b * c * c)); [ apply Rplus_le_compat_l; replace (a * a * d * d + b * b * c * c) with (2 * a * b * c * d + (a * a * d * d + b * b * c * c - 2 * a * b * c * d)); [ pattern (2 * a * b * c * d) at 1; rewrite <- Rplus_0_r; apply Rplus_le_compat_l; replace (a * a * d * d + b * b * c * c - 2 * a * b * c * d) with (Rsqr (a * d - b * c)); [ apply Rle_0_sqr | unfold Rsqr; ring ] | ring ] | ring ] | ring ] | apply (Rplus_le_le_0_compat (Rsqr c) (Rsqr d) (Rle_0_sqr c) (Rle_0_sqr d)) | apply (Rplus_le_le_0_compat (Rsqr a) (Rsqr b) (Rle_0_sqr a) (Rle_0_sqr b)) ] | apply Rmult_le_pos; apply sqrt_positivity; apply Rplus_le_le_0_compat; apply Rle_0_sqr ]. Qed. (************************************************************) (** * Resolution of [a*X^2+b*X+c=0] *) (************************************************************) Definition Delta (a:nonzeroreal) (b c:R) : R := Rsqr b - 4 * a * c. Definition Delta_is_pos (a:nonzeroreal) (b c:R) : Prop := 0 <= Delta a b c. Definition sol_x1 (a:nonzeroreal) (b c:R) : R := (- b + sqrt (Delta a b c)) / (2 * a). Definition sol_x2 (a:nonzeroreal) (b c:R) : R := (- b - sqrt (Delta a b c)) / (2 * a). Lemma Rsqr_sol_eq_0_1 : forall (a:nonzeroreal) (b c x:R), Delta_is_pos a b c -> x = sol_x1 a b c \/ x = sol_x2 a b c -> a * Rsqr x + b * x + c = 0. Proof. intros; elim H0; intro. - rewrite H1. unfold sol_x1, Delta, Rsqr. field_simplify. + rewrite <- (Rsqr_pow2 (sqrt _)), Rsqr_sqrt. * field. apply a. * apply H. + apply a. - rewrite H1. unfold sol_x2, Delta, Rsqr. field_simplify. + rewrite <- (Rsqr_pow2 (sqrt _)), Rsqr_sqrt. * field. apply a. * apply H. + apply a. Qed. Lemma Rsqr_sol_eq_0_0 : forall (a:nonzeroreal) (b c x:R), Delta_is_pos a b c -> a * Rsqr x + b * x + c = 0 -> x = sol_x1 a b c \/ x = sol_x2 a b c. Proof. intros; rewrite (canonical_Rsqr a b c x) in H0; rewrite Rplus_comm in H0; generalize (Rplus_opp_r_uniq ((4 * a * c - Rsqr b) / (4 * a)) (a * Rsqr (x + b / (2 * a))) H0); assert (Rsqr b - 4 * a * c = Delta a b c) by reflexivity. replace (- ((4 * a * c - Rsqr b) / (4 * a))) with ((Rsqr b - 4 * a * c) / (4 * a)). 2:{ unfold Rdiv; rewrite <- Ropp_mult_distr_l_reverse. rewrite Ropp_minus_distr. reflexivity. } rewrite H1; intro; generalize (Rmult_eq_compat_l (/ a) (a * Rsqr (x + b / (2 * a))) (Delta a b c / (4 * a)) H2); replace (/ a * (a * Rsqr (x + b / (2 * a)))) with (Rsqr (x + b / (2 * a))). 2:{ rewrite <- Rmult_assoc; rewrite Rinv_l. - symmetry ; apply Rmult_1_l. - apply (cond_nonzero a). } replace (/ a * (Delta a b c / (4 * a))) with (Rsqr (sqrt (Delta a b c) / (2 * a))). 2:{ rewrite Rsqr_div'. rewrite Rsqr_sqrt. 2:assumption. unfold Rdiv. rewrite (Rmult_comm (/ a)). rewrite Rmult_assoc. rewrite <- Rinv_mult. replace (4 * a * a) with (Rsqr (2 * a)) by ring_Rsqr. reflexivity. } intro; generalize (Rsqr_eq (x + b / (2 * a)) (sqrt (Delta a b c) / (2 * a)) H3); intro; elim H4; intro. - left; unfold sol_x1; generalize (Rplus_eq_compat_l (- (b / (2 * a))) (x + b / (2 * a)) (sqrt (Delta a b c) / (2 * a)) H5); replace (- (b / (2 * a)) + (x + b / (2 * a))) with x by ring. intro; rewrite H6; unfold Rdiv; ring. - right; unfold sol_x2; generalize (Rplus_eq_compat_l (- (b / (2 * a))) (x + b / (2 * a)) (- (sqrt (Delta a b c) / (2 * a))) H5); replace (- (b / (2 * a)) + (x + b / (2 * a))) with x by ring. intro; rewrite H6; unfold Rdiv; ring. Qed. coq-8.20.0/theories/Reals/Ranalysis.v000066400000000000000000000022411466560755400174300ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* R. (****************************************************) (** * Basic operations on functions *) (****************************************************) Definition plus_fct f1 f2 (x:R) : R := f1 x + f2 x. Definition opp_fct f (x:R) : R := - f x. Definition mult_fct f1 f2 (x:R) : R := f1 x * f2 x. Definition mult_real_fct (a:R) f (x:R) : R := a * f x. Definition minus_fct f1 f2 (x:R) : R := f1 x - f2 x. Definition div_fct f1 f2 (x:R) : R := f1 x / f2 x. Definition div_real_fct (a:R) f (x:R) : R := a / f x. Definition comp f1 f2 (x:R) : R := f1 (f2 x). Definition inv_fct f (x:R) : R := / f x. Definition mirr_fct f (x:R) : R := f (- x). Declare Scope Rfun_scope. Delimit Scope Rfun_scope with F. Arguments plus_fct (f1 f2)%_F x%_R. Arguments mult_fct (f1 f2)%_F x%_R. Arguments minus_fct (f1 f2)%_F x%_R. Arguments div_fct (f1 f2)%_F x%_R. Arguments inv_fct f%_F x%_R. Arguments opp_fct f%_F x%_R. Arguments mult_real_fct a%_R f%_F x%_R. Arguments div_real_fct a%_R f%_F x%_R. Arguments comp (f1 f2)%_F x%_R. Arguments mirr_fct f%_F x%_R. Infix "+" := plus_fct : Rfun_scope. Notation "- x" := (opp_fct x) : Rfun_scope. Infix "*" := mult_fct : Rfun_scope. Infix "-" := minus_fct : Rfun_scope. Infix "/" := div_fct : Rfun_scope. Local Notation "f1 'o' f2" := (comp f1 f2) (at level 20, right associativity) : Rfun_scope. Notation "/ x" := (inv_fct x) : Rfun_scope. Definition fct_cte (a x:R) : R := a. Definition id (x:R) := x. (****************************************************) (** * Variations of functions *) (****************************************************) Definition increasing f : Prop := forall x y:R, x <= y -> f x <= f y. Definition decreasing f : Prop := forall x y:R, x <= y -> f y <= f x. Definition strict_increasing f : Prop := forall x y:R, x < y -> f x < f y. Definition strict_decreasing f : Prop := forall x y:R, x < y -> f y < f x. Definition constant f : Prop := forall x y:R, f x = f y. (**********) Definition no_cond (x:R) : Prop := True. (**********) Definition constant_D_eq f (D:R -> Prop) (c:R) : Prop := forall x:R, D x -> f x = c. (***************************************************) (** * Definition of continuity as a limit *) (***************************************************) (**********) Definition continuity_pt f (x0:R) : Prop := continue_in f no_cond x0. Definition continuity f : Prop := forall x:R, continuity_pt f x. Arguments continuity_pt f%_F x0%_R. Arguments continuity f%_F. Lemma continuity_pt_locally_ext : forall f g a x, 0 < a -> (forall y, Rdist y x < a -> f y = g y) -> continuity_pt f x -> continuity_pt g x. intros f g a x a0 q cf eps ep. destruct (cf eps ep) as [a' [a'p Pa']]. exists (Rmin a a'); split. - unfold Rmin; destruct (Rle_dec a a'). + assumption. + assumption. - intros y cy; rewrite <- !q. + apply Pa'. split;[| apply Rlt_le_trans with (Rmin a a');[ | apply Rmin_r]];tauto. + rewrite Rdist_eq; assumption. + apply Rlt_le_trans with (Rmin a a');[ | apply Rmin_l]; tauto. Qed. (**********) Lemma continuity_pt_plus : forall f1 f2 (x0:R), continuity_pt f1 x0 -> continuity_pt f2 x0 -> continuity_pt (f1 + f2) x0. Proof. unfold continuity_pt, plus_fct; unfold continue_in; intros; apply limit_plus; assumption. Qed. Lemma continuity_pt_opp : forall f (x0:R), continuity_pt f x0 -> continuity_pt (- f) x0. Proof. unfold continuity_pt, opp_fct; unfold continue_in; intros; apply limit_Ropp; assumption. Qed. Lemma continuity_pt_minus : forall f1 f2 (x0:R), continuity_pt f1 x0 -> continuity_pt f2 x0 -> continuity_pt (f1 - f2) x0. Proof. unfold continuity_pt, minus_fct; unfold continue_in; intros; apply limit_minus; assumption. Qed. Lemma continuity_pt_mult : forall f1 f2 (x0:R), continuity_pt f1 x0 -> continuity_pt f2 x0 -> continuity_pt (f1 * f2) x0. Proof. unfold continuity_pt, mult_fct; unfold continue_in; intros; apply limit_mul; assumption. Qed. Lemma continuity_pt_const : forall f (x0:R), constant f -> continuity_pt f x0. Proof. unfold constant, continuity_pt; unfold continue_in; unfold limit1_in; unfold limit_in; intros; exists 1; split; [ apply Rlt_0_1 | intros; generalize (H x x0); intro; rewrite H2; simpl; rewrite Rdist_eq; assumption ]. Qed. Lemma continuity_pt_scal : forall f (a x0:R), continuity_pt f x0 -> continuity_pt (mult_real_fct a f) x0. Proof. unfold continuity_pt, mult_real_fct; unfold continue_in; intros; apply (limit_mul (fun x:R => a) f (D_x no_cond x0) a (f x0) x0). - unfold limit1_in; unfold limit_in; intros; exists 1; split. + apply Rlt_0_1. + intros; rewrite Rdist_eq; assumption. - assumption. Qed. Lemma continuity_pt_inv : forall f (x0:R), continuity_pt f x0 -> f x0 <> 0 -> continuity_pt (/ f) x0. Proof. intros. replace (/ f)%F with (fun x:R => / f x). - unfold continuity_pt; unfold continue_in; intros; apply limit_inv; assumption. - unfold inv_fct; reflexivity. Qed. Lemma div_eq_inv : forall f1 f2, (f1 / f2)%F = (f1 * / f2)%F. Proof. intros; reflexivity. Qed. Lemma continuity_pt_div : forall f1 f2 (x0:R), continuity_pt f1 x0 -> continuity_pt f2 x0 -> f2 x0 <> 0 -> continuity_pt (f1 / f2) x0. Proof. intros; rewrite (div_eq_inv f1 f2); apply continuity_pt_mult; [ assumption | apply continuity_pt_inv; assumption ]. Qed. Lemma continuity_pt_comp : forall f1 f2 (x:R), continuity_pt f1 x -> continuity_pt f2 (f1 x) -> continuity_pt (f2 o f1) x. Proof. unfold continuity_pt; unfold continue_in; intros; unfold comp. cut (limit1_in (fun x0:R => f2 (f1 x0)) (Dgf (D_x no_cond x) (D_x no_cond (f1 x)) f1) ( f2 (f1 x)) x -> limit1_in (fun x0:R => f2 (f1 x0)) (D_x no_cond x) (f2 (f1 x)) x). - intro; apply H1. eapply limit_comp. + apply H. + apply H0. - unfold limit1_in; unfold limit_in; unfold dist; simpl; unfold Rdist; intros. assert (H3 := H1 eps H2). elim H3; intros. exists x0. split. + elim H4; intros; assumption. + intros; case (Req_dec (f1 x) (f1 x1)); intro. * rewrite H6; unfold Rminus; rewrite Rplus_opp_r; rewrite Rabs_R0; assumption. * elim H4; intros; apply H8. split. -- unfold Dgf, D_x, no_cond. split. ++ split. ** trivial. ** elim H5; unfold D_x, no_cond; intros. elim H9; intros; assumption. ++ split. ** trivial. ** assumption. -- elim H5; intros; assumption. Qed. (**********) Lemma continuity_plus : forall f1 f2, continuity f1 -> continuity f2 -> continuity (f1 + f2). Proof. unfold continuity; intros; apply (continuity_pt_plus f1 f2 x (H x) (H0 x)). Qed. Lemma continuity_opp : forall f, continuity f -> continuity (- f). Proof. unfold continuity; intros; apply (continuity_pt_opp f x (H x)). Qed. Lemma continuity_minus : forall f1 f2, continuity f1 -> continuity f2 -> continuity (f1 - f2). Proof. unfold continuity; intros; apply (continuity_pt_minus f1 f2 x (H x) (H0 x)). Qed. Lemma continuity_mult : forall f1 f2, continuity f1 -> continuity f2 -> continuity (f1 * f2). Proof. unfold continuity; intros; apply (continuity_pt_mult f1 f2 x (H x) (H0 x)). Qed. Lemma continuity_const : forall f, constant f -> continuity f. Proof. unfold continuity; intros; apply (continuity_pt_const f x H). Qed. Lemma continuity_scal : forall f (a:R), continuity f -> continuity (mult_real_fct a f). Proof. unfold continuity; intros; apply (continuity_pt_scal f a x (H x)). Qed. Lemma continuity_inv : forall f, continuity f -> (forall x:R, f x <> 0) -> continuity (/ f). Proof. unfold continuity; intros; apply (continuity_pt_inv f x (H x) (H0 x)). Qed. Lemma continuity_div : forall f1 f2, continuity f1 -> continuity f2 -> (forall x:R, f2 x <> 0) -> continuity (f1 / f2). Proof. unfold continuity; intros; apply (continuity_pt_div f1 f2 x (H x) (H0 x) (H1 x)). Qed. Lemma continuity_comp : forall f1 f2, continuity f1 -> continuity f2 -> continuity (f2 o f1). Proof. unfold continuity; intros. apply (continuity_pt_comp f1 f2 x (H x) (H0 (f1 x))). Qed. (*****************************************************) (** * Derivative's definition using Landau's kernel *) (*****************************************************) Definition derivable_pt_lim f (x l:R) : Prop := forall eps:R, 0 < eps -> exists delta : posreal, (forall h:R, h <> 0 -> Rabs h < delta -> Rabs ((f (x + h) - f x) / h - l) < eps). Definition derivable_pt_abs f (x l:R) : Prop := derivable_pt_lim f x l. Definition derivable_pt f (x:R) := { l:R | derivable_pt_abs f x l }. Definition derivable f := forall x:R, derivable_pt f x. Definition derive_pt f (x:R) (pr:derivable_pt f x) := proj1_sig pr. Definition derive f (pr:derivable f) (x:R) := derive_pt f x (pr x). Arguments derivable_pt_lim f%_F x%_R l. Arguments derivable_pt_abs f%_F (x l)%_R. Arguments derivable_pt f%_F x%_R. Arguments derivable f%_F. Arguments derive_pt f%_F x%_R pr. Arguments derive f%_F pr x. Definition antiderivative f (g:R -> R) (a b:R) : Prop := (forall x:R, a <= x <= b -> exists pr : derivable_pt g x, f x = derive_pt g x pr) /\ a <= b. (**************************************) (** * Class of differential functions *) (**************************************) Record Differential : Type := mkDifferential {d1 :> R -> R; cond_diff : derivable d1}. Record Differential_D2 : Type := mkDifferential_D2 {d2 :> R -> R; cond_D1 : derivable d2; cond_D2 : derivable (derive d2 cond_D1)}. (**********) Lemma uniqueness_step1 : forall f (x l1 l2:R), limit1_in (fun h:R => (f (x + h) - f x) / h) (fun h:R => h <> 0) l1 0 -> limit1_in (fun h:R => (f (x + h) - f x) / h) (fun h:R => h <> 0) l2 0 -> l1 = l2. Proof. intros; apply (single_limit (fun h:R => (f (x + h) - f x) / h) ( fun h:R => h <> 0) l1 l2 0); try assumption. unfold adhDa; intros; exists (alp / 2). split. - unfold Rdiv; apply prod_neq_R0. + red; intro; rewrite H2 in H1; elim (Rlt_irrefl _ H1). + apply Rinv_neq_0_compat; discrR. - unfold Rdist; unfold Rminus; rewrite Ropp_0; rewrite Rplus_0_r; unfold Rdiv; rewrite Rabs_mult. replace (Rabs (/ 2)) with (/ 2). + replace (Rabs alp) with alp. * apply Rmult_lt_reg_l with 2. -- prove_sup0. -- rewrite (Rmult_comm 2); rewrite Rmult_assoc; rewrite Rinv_l; [ idtac | discrR ]; rewrite Rmult_1_r; rewrite <-Rplus_diag; pattern alp at 1; replace alp with (alp + 0); [ idtac | ring ]; apply Rplus_lt_compat_l; assumption. * symmetry ; apply Rabs_right; left; assumption. + symmetry ; apply Rabs_right; left; change (0 < / 2); apply Rinv_0_lt_compat; prove_sup0. Qed. Lemma uniqueness_step2 : forall f (x l:R), derivable_pt_lim f x l -> limit1_in (fun h:R => (f (x + h) - f x) / h) (fun h:R => h <> 0) l 0. Proof. unfold derivable_pt_lim; intros; unfold limit1_in; unfold limit_in; intros. assert (H1 := H eps H0). elim H1; intros. exists (pos x0). split. - apply (cond_pos x0). - simpl; unfold Rdist; intros. elim H3; intros. apply H2; [ assumption | unfold Rminus in H5; rewrite Ropp_0 in H5; rewrite Rplus_0_r in H5; assumption ]. Qed. Lemma uniqueness_step3 : forall f (x l:R), limit1_in (fun h:R => (f (x + h) - f x) / h) (fun h:R => h <> 0) l 0 -> derivable_pt_lim f x l. Proof. unfold limit1_in, derivable_pt_lim; unfold limit_in; unfold dist; simpl; intros. elim (H eps H0). intros; elim H1; intros. exists (mkposreal x0 H2). simpl; intros; unfold Rdist in H3; apply (H3 h). split; [ assumption | unfold Rminus; rewrite Ropp_0; rewrite Rplus_0_r; assumption ]. Qed. Lemma uniqueness_limite : forall f (x l1 l2:R), derivable_pt_lim f x l1 -> derivable_pt_lim f x l2 -> l1 = l2. Proof. intros. assert (H1 := uniqueness_step2 _ _ _ H). assert (H2 := uniqueness_step2 _ _ _ H0). assert (H3 := uniqueness_step1 _ _ _ _ H1 H2). assumption. Qed. Lemma derive_pt_eq : forall f (x l:R) (pr:derivable_pt f x), derive_pt f x pr = l <-> derivable_pt_lim f x l. Proof. intros; split. - intro; assert (H1 := proj2_sig pr); unfold derive_pt in H; rewrite H in H1; assumption. - intro; assert (H1 := proj2_sig pr); unfold derivable_pt_abs in H1. assert (H2 := uniqueness_limite _ _ _ _ H H1). unfold derive_pt; unfold derivable_pt_abs. symmetry ; assumption. Qed. (**********) Lemma derive_pt_eq_0 : forall f (x l:R) (pr:derivable_pt f x), derivable_pt_lim f x l -> derive_pt f x pr = l. Proof. intros; elim (derive_pt_eq f x l pr); intros. apply (H1 H). Qed. (**********) Lemma derive_pt_eq_1 : forall f (x l:R) (pr:derivable_pt f x), derive_pt f x pr = l -> derivable_pt_lim f x l. Proof. intros; elim (derive_pt_eq f x l pr); intros. apply (H0 H). Qed. (**********************************************************************) (** * Equivalence of this definition with the one using limit concept *) (**********************************************************************) Lemma derive_pt_D_in : forall f (df:R -> R) (x:R) (pr:derivable_pt f x), D_in f df no_cond x <-> derive_pt f x pr = df x. Proof. intros; split. - unfold D_in; unfold limit1_in; unfold limit_in; simpl; unfold Rdist; intros. apply derive_pt_eq_0. unfold derivable_pt_lim. intros; elim (H eps H0); intros alpha H1; elim H1; intros; exists (mkposreal alpha H2); intros; generalize (H3 (x + h)); intro; cut (x + h - x = h); [ intro; cut (D_x no_cond x (x + h) /\ Rabs (x + h - x) < alpha); [ intro; generalize (H6 H8); rewrite H7; intro; assumption | split; [ unfold D_x; split; [ unfold no_cond; trivial | symmetry; apply Rminus_not_eq; rewrite H7; assumption ] | rewrite H7; assumption ] ] | ring ]. - intro. assert (H0 := derive_pt_eq_1 f x (df x) pr H). unfold D_in; unfold limit1_in; unfold limit_in; unfold dist; simpl; unfold Rdist; intros. elim (H0 eps H1); intros alpha H2; exists (pos alpha); split. + apply (cond_pos alpha). + intros; elim H3; intros; unfold D_x in H4; elim H4; intros; cut (x0 - x <> 0). * intro; generalize (H2 (x0 - x) H8 H5); replace (x + (x0 - x)) with x0. -- intro; assumption. -- ring. * auto with real. Qed. Lemma derivable_pt_lim_D_in : forall f (df:R -> R) (x:R), D_in f df no_cond x <-> derivable_pt_lim f x (df x). Proof. intros; split. - unfold D_in; unfold limit1_in; unfold limit_in; simpl; unfold Rdist; intros. unfold derivable_pt_lim. intros; elim (H eps H0); intros alpha H1; elim H1; intros; exists (mkposreal alpha H2); intros; generalize (H3 (x + h)); intro; cut (x + h - x = h); [ intro; cut (D_x no_cond x (x + h) /\ Rabs (x + h - x) < alpha); [ intro; generalize (H6 H8); rewrite H7; intro; assumption | split; [ unfold D_x; split; [ unfold no_cond; trivial | symmetry; apply Rminus_not_eq; rewrite H7; assumption ] | rewrite H7; assumption ] ] | ring ]. - intro. unfold derivable_pt_lim in H. unfold D_in; unfold limit1_in; unfold limit_in; unfold dist; simpl; unfold Rdist; intros. elim (H eps H0); intros alpha H2; exists (pos alpha); split. + apply (cond_pos alpha). + intros. elim H1; intros; unfold D_x in H3; elim H3; intros; cut (x0 - x <> 0). * intro; generalize (H2 (x0 - x) H7 H4); replace (x + (x0 - x)) with x0. -- intro; assumption. -- ring. * auto with real. Qed. (* Extensionally equal functions have the same derivative. *) Lemma derivable_pt_lim_ext : forall f g x l, (forall z, f z = g z) -> derivable_pt_lim f x l -> derivable_pt_lim g x l. intros f g x l fg df e ep; destruct (df e ep) as [d pd]; exists d; intros h; rewrite <- !fg; apply pd. Qed. (* extensionally equal functions have the same derivative, locally. *) Lemma derivable_pt_lim_locally_ext : forall f g x a b l, a < x < b -> (forall z, a < z < b -> f z = g z) -> derivable_pt_lim f x l -> derivable_pt_lim g x l. intros f g x a b l axb fg df e ep. destruct (df e ep) as [d pd]. assert (d'h : 0 < Rmin d (Rmin (b - x) (x - a))). - apply Rmin_pos;[apply cond_pos | apply Rmin_pos; apply Rlt_0_minus; tauto]. - exists (mkposreal _ d'h); simpl; intros h hn0 cmp. rewrite <- !fg;[ |assumption | ]. + apply pd;[assumption |]. apply Rlt_le_trans with (1 := cmp), Rmin_l. + assert (-h < x - a). * apply Rle_lt_trans with (1 := Rle_abs _). rewrite Rabs_Ropp; apply Rlt_le_trans with (1 := cmp). rewrite Rmin_assoc; apply Rmin_r. * assert (h < b - x). -- apply Rle_lt_trans with (1 := Rle_abs _). apply Rlt_le_trans with (1 := cmp). rewrite Rmin_comm, <- Rmin_assoc; apply Rmin_l. -- split. ++ apply (Rplus_lt_reg_l (- h)). replace ((-h) + (x + h)) with x by ring. apply (Rplus_lt_reg_r (- a)). replace (((-h) + a) + - a) with (-h) by ring. assumption. ++ apply (Rplus_lt_reg_r (- x)). replace (x + h + - x) with h by ring. assumption. Qed. (***********************************) (** * derivability -> continuity *) (***********************************) (**********) Lemma derivable_derive : forall f (x:R) (pr:derivable_pt f x), exists l : R, derive_pt f x pr = l. Proof. intros; exists (proj1_sig pr). unfold derive_pt; reflexivity. Qed. Theorem derivable_continuous_pt : forall f (x:R), derivable_pt f x -> continuity_pt f x. Proof. intros f x X. generalize (derivable_derive f x X); intro. elim H; intros l H1. cut (l = fct_cte l x). - intro. rewrite H0 in H1. generalize (derive_pt_D_in f (fct_cte l) x); intro. elim (H2 X); intros. generalize (H4 H1); intro. unfold continuity_pt. apply (cont_deriv f (fct_cte l) no_cond x H5). - unfold fct_cte; reflexivity. Qed. Theorem derivable_continuous : forall f, derivable f -> continuity f. Proof. unfold derivable, continuity; intros f X x. apply (derivable_continuous_pt f x (X x)). Qed. (****************************************************************) (** * Main rules *) (****************************************************************) (** ** Rules for derivable_pt_lim (value of the derivative at a point) *) Lemma derivable_pt_lim_id : forall x:R, derivable_pt_lim id x 1. Proof. intro; unfold derivable_pt_lim. intros eps Heps; exists (mkposreal eps Heps); intros h H1 H2; unfold id; replace ((x + h - x) / h - 1) with 0. - rewrite Rabs_R0; apply Rle_lt_trans with (Rabs h). + apply Rabs_pos. + assumption. - unfold Rminus; rewrite Rplus_assoc; rewrite (Rplus_comm x); rewrite Rplus_assoc. rewrite Rplus_opp_l; rewrite Rplus_0_r; unfold Rdiv; rewrite Rinv_r. + symmetry ; apply Rplus_opp_r. + assumption. Qed. Lemma derivable_pt_lim_comp : forall f1 f2 (x l1 l2:R), derivable_pt_lim f1 x l1 -> derivable_pt_lim f2 (f1 x) l2 -> derivable_pt_lim (f2 o f1) x (l2 * l1). Proof. intros; assert (H1 := derivable_pt_lim_D_in f1 (fun y:R => l1) x). elim H1; intros. assert (H4 := H3 H). assert (H5 := derivable_pt_lim_D_in f2 (fun y:R => l2) (f1 x)). elim H5; intros. assert (H8 := H7 H0). clear H1 H2 H3 H5 H6 H7. assert (H1 := derivable_pt_lim_D_in (f2 o f1)%F (fun y:R => l2 * l1) x). elim H1; intros. clear H1 H3; apply H2. unfold comp; cut (D_in (fun x0:R => f2 (f1 x0)) (fun y:R => l2 * l1) (Dgf no_cond no_cond f1) x -> D_in (fun x0:R => f2 (f1 x0)) (fun y:R => l2 * l1) no_cond x). - intro; apply H1. rewrite Rmult_comm; apply (Dcomp no_cond no_cond (fun y:R => l1) (fun y:R => l2) f1 f2 x); assumption. - unfold Dgf, D_in, no_cond; unfold limit1_in; unfold limit_in; unfold dist; simpl; unfold Rdist; intros. elim (H1 eps H3); intros. exists x0; intros; split. + elim H5; intros; assumption. + intros; elim H5; intros; apply H9; split. * unfold D_x; split. -- split; trivial. -- elim H6; intros; unfold D_x in H10; elim H10; intros; assumption. * elim H6; intros; assumption. Qed. Lemma derivable_pt_lim_opp : forall f (x l:R), derivable_pt_lim f x l -> derivable_pt_lim (- f) x (- l). Proof. intros f x l H. apply uniqueness_step3. unfold opp_fct, limit1_in, limit_in, dist; simpl; unfold Rdist. apply uniqueness_step2 in H. unfold limit1_in, limit_in, dist in H; simpl in H; unfold Rdist in H. intros eps Heps; specialize (H eps Heps). destruct H as [alp [Halp H]]; exists alp. split; [assumption|]. intros x0 Hx0; specialize(H x0 Hx0). rewrite <- Rabs_Ropp in H. match goal with H:Rabs(?a) replace b with a by (field; tauto) end. assumption. Qed. Lemma derivable_pt_lim_opp_fwd : forall f (x l:R), derivable_pt_lim f x (- l) -> derivable_pt_lim (- f) x l. Proof. intros f x l H. apply uniqueness_step3. unfold opp_fct, limit1_in, limit_in, dist; simpl; unfold Rdist. apply uniqueness_step2 in H. unfold limit1_in, limit_in, dist in H; simpl in H; unfold Rdist in H. intros eps Heps; specialize (H eps Heps). destruct H as [alp [Halp H]]; exists alp. split; [assumption|]. intros x0 Hx0; specialize(H x0 Hx0). rewrite <- Rabs_Ropp in H. match goal with H:Rabs(?a) replace b with a by (field; tauto) end. assumption. Qed. Lemma derivable_pt_lim_opp_rev : forall f (x l:R), derivable_pt_lim (- f) x (- l) -> derivable_pt_lim f x l. Proof. intros f x l H. apply derivable_pt_lim_ext with (f := fun x => - - (f x)). - intros; rewrite Ropp_involutive; reflexivity. - apply derivable_pt_lim_opp_fwd; exact H. Qed. Lemma derivable_pt_lim_mirr_fwd : forall f (x l:R), derivable_pt_lim f (- x) (- l) -> derivable_pt_lim (mirr_fct f) x l. Proof. intros f x l H. change (mirr_fct f) with (comp f (opp_fct id)). replace l with ((-l) * -1) by ring. apply derivable_pt_lim_comp; [| exact H]. apply derivable_pt_lim_opp. apply derivable_pt_lim_id. Qed. Lemma derivable_pt_lim_mirr_rev : forall f (x l:R), derivable_pt_lim (mirr_fct f) (- x) (- l) -> derivable_pt_lim f x l. Proof. intros f x l H. apply derivable_pt_lim_ext with (f := fun x => (mirr_fct f (- x))). - intros; unfold mirr_fct; rewrite Ropp_involutive; reflexivity. - apply derivable_pt_lim_mirr_fwd; exact H. Qed. Lemma derivable_pt_lim_plus : forall f1 f2 (x l1 l2:R), derivable_pt_lim f1 x l1 -> derivable_pt_lim f2 x l2 -> derivable_pt_lim (f1 + f2) x (l1 + l2). intros. apply uniqueness_step3. assert (H1 := uniqueness_step2 _ _ _ H). assert (H2 := uniqueness_step2 _ _ _ H0). unfold plus_fct. cut (forall h:R, (f1 (x + h) + f2 (x + h) - (f1 x + f2 x)) / h = (f1 (x + h) - f1 x) / h + (f2 (x + h) - f2 x) / h). - intro. generalize (limit_plus (fun h':R => (f1 (x + h') - f1 x) / h') (fun h':R => (f2 (x + h') - f2 x) / h') (fun h:R => h <> 0) l1 l2 0 H1 H2). unfold limit1_in; unfold limit_in; unfold dist; simpl; unfold Rdist; intros. elim (H4 eps H5); intros. exists x0. elim H6; intros. split. + assumption. + intros; rewrite H3; apply H8; assumption. - intro; unfold Rdiv; ring. Qed. Lemma derivable_pt_lim_minus : forall f1 f2 (x l1 l2:R), derivable_pt_lim f1 x l1 -> derivable_pt_lim f2 x l2 -> derivable_pt_lim (f1 - f2) x (l1 - l2). Proof. intros. apply uniqueness_step3. assert (H1 := uniqueness_step2 _ _ _ H). assert (H2 := uniqueness_step2 _ _ _ H0). unfold minus_fct. cut (forall h:R, (f1 (x + h) - f1 x) / h - (f2 (x + h) - f2 x) / h = (f1 (x + h) - f2 (x + h) - (f1 x - f2 x)) / h). - intro. generalize (limit_minus (fun h':R => (f1 (x + h') - f1 x) / h') (fun h':R => (f2 (x + h') - f2 x) / h') (fun h:R => h <> 0) l1 l2 0 H1 H2). unfold limit1_in; unfold limit_in; unfold dist; simpl; unfold Rdist; intros. elim (H4 eps H5); intros. exists x0. elim H6; intros. split. + assumption. + intros; rewrite <- H3; apply H8; assumption. - intro; unfold Rdiv; ring. Qed. Lemma derivable_pt_lim_mult : forall f1 f2 (x l1 l2:R), derivable_pt_lim f1 x l1 -> derivable_pt_lim f2 x l2 -> derivable_pt_lim (f1 * f2) x (l1 * f2 x + f1 x * l2). Proof. intros. assert (H1 := derivable_pt_lim_D_in f1 (fun y:R => l1) x). elim H1; intros. assert (H4 := H3 H). assert (H5 := derivable_pt_lim_D_in f2 (fun y:R => l2) x). elim H5; intros. assert (H8 := H7 H0). clear H1 H2 H3 H5 H6 H7. assert (H1 := derivable_pt_lim_D_in (f1 * f2)%F (fun y:R => l1 * f2 x + f1 x * l2) x). elim H1; intros. clear H1 H3. apply H2. unfold mult_fct. apply (Dmult no_cond (fun y:R => l1) (fun y:R => l2) f1 f2 x); assumption. Qed. Lemma derivable_pt_lim_const : forall a x:R, derivable_pt_lim (fct_cte a) x 0. Proof. intros; unfold fct_cte, derivable_pt_lim. intros; exists (mkposreal 1 Rlt_0_1); intros; unfold Rminus; rewrite Rplus_opp_r; unfold Rdiv; rewrite Rmult_0_l; rewrite Rplus_opp_r; rewrite Rabs_R0; assumption. Qed. Lemma derivable_pt_lim_scal : forall f (a x l:R), derivable_pt_lim f x l -> derivable_pt_lim (mult_real_fct a f) x (a * l). Proof. intros. assert (H0 := derivable_pt_lim_const a x). replace (mult_real_fct a f) with (fct_cte a * f)%F. - replace (a * l) with (0 * f x + a * l); [ idtac | ring ]. apply (derivable_pt_lim_mult (fct_cte a) f x 0 l); assumption. - unfold mult_real_fct, mult_fct, fct_cte; reflexivity. Qed. Lemma derivable_pt_lim_div_scal : forall f x l a, derivable_pt_lim f x l -> derivable_pt_lim (fun y => f y / a) x (l / a). intros f x l a df; apply (derivable_pt_lim_ext (fun y => /a * f y)). - intros z; rewrite Rmult_comm; reflexivity. - unfold Rdiv; rewrite Rmult_comm; apply derivable_pt_lim_scal; assumption. Qed. Lemma derivable_pt_lim_scal_right : forall f x l a, derivable_pt_lim f x l -> derivable_pt_lim (fun y => f y * a) x (l * a). intros f x l a df; apply (derivable_pt_lim_ext (fun y => a * f y)). - intros z; rewrite Rmult_comm; reflexivity. - unfold Rdiv; rewrite Rmult_comm; apply derivable_pt_lim_scal; assumption. Qed. Lemma derivable_pt_lim_Rsqr : forall x:R, derivable_pt_lim Rsqr x (2 * x). Proof. intro; unfold derivable_pt_lim. unfold Rsqr; intros eps Heps; exists (mkposreal eps Heps); intros h H1 H2; replace (((x + h) * (x + h) - x * x) / h - 2 * x) with h. - assumption. - replace ((x + h) * (x + h) - x * x) with (2 * x * h + h * h); [ idtac | ring ]. unfold Rdiv; rewrite Rmult_plus_distr_r. repeat rewrite Rmult_assoc. repeat rewrite Rinv_r; [ idtac | assumption ]. ring. Qed. (** ** Rules for derivable_pt (derivability at a point) *) Lemma derivable_pt_id : forall x:R, derivable_pt id x. Proof. unfold derivable_pt; intro. exists 1. apply derivable_pt_lim_id. Qed. Lemma derivable_pt_comp : forall f1 f2 (x:R), derivable_pt f1 x -> derivable_pt f2 (f1 x) -> derivable_pt (f2 o f1) x. Proof. unfold derivable_pt; intros f1 f2 x X X0. elim X; intros. elim X0; intros. exists (x1 * x0). apply derivable_pt_lim_comp; assumption. Qed. Lemma derivable_pt_xeq: forall (f : R -> R) (x1 x2 : R), x1=x2 -> derivable_pt f x1 -> derivable_pt f x2. Proof. intros f x1 x2 Heq H. subst; assumption. Qed. Lemma derivable_pt_opp : forall (f : R -> R) (x:R), derivable_pt f x -> derivable_pt (- f) x. Proof. intros f x H. unfold derivable_pt in H. destruct H as [l H]; exists (-l). apply derivable_pt_lim_opp; assumption. Qed. Lemma derivable_pt_opp_rev: forall (f : R -> R) (x : R), derivable_pt (- f) x -> derivable_pt f x. Proof. intros f x H. unfold derivable_pt in H. destruct H as [l H]; exists (-l). apply derivable_pt_lim_opp_rev. rewrite Ropp_involutive; assumption. Qed. Lemma derivable_pt_mirr: forall (f : R -> R) (x : R), derivable_pt f (-x) -> derivable_pt (mirr_fct f) x. Proof. intros f x H. unfold derivable_pt in H. destruct H as [l H]; exists (-l). apply derivable_pt_lim_mirr_fwd. rewrite Ropp_involutive; assumption. Qed. Lemma derivable_pt_mirr_rev: forall (f : R -> R) (x : R), derivable_pt (mirr_fct f) (- x) -> derivable_pt f x. Proof. intros f x H. unfold derivable_pt in H. destruct H as [l H]; exists (-l). apply derivable_pt_lim_mirr_rev. rewrite Ropp_involutive; assumption. Qed. Lemma derivable_pt_mirr_prem: forall (f : R -> R) (x : R), derivable_pt (mirr_fct f) x -> derivable_pt f (-x). Proof. intros f x H. unfold derivable_pt in H. destruct H as [l H]; exists (-l). apply derivable_pt_lim_mirr_rev. repeat rewrite Ropp_involutive; assumption. Qed. Lemma derivable_pt_plus : forall f1 f2 (x:R), derivable_pt f1 x -> derivable_pt f2 x -> derivable_pt (f1 + f2) x. Proof. unfold derivable_pt; intros f1 f2 x X X0. elim X; intros. elim X0; intros. exists (x0 + x1). apply derivable_pt_lim_plus; assumption. Qed. Lemma derivable_pt_minus : forall f1 f2 (x:R), derivable_pt f1 x -> derivable_pt f2 x -> derivable_pt (f1 - f2) x. Proof. unfold derivable_pt; intros f1 f2 x X X0. elim X; intros. elim X0; intros. exists (x0 - x1). apply derivable_pt_lim_minus; assumption. Qed. Lemma derivable_pt_mult : forall f1 f2 (x:R), derivable_pt f1 x -> derivable_pt f2 x -> derivable_pt (f1 * f2) x. Proof. unfold derivable_pt; intros f1 f2 x X X0. elim X; intros. elim X0; intros. exists (x0 * f2 x + f1 x * x1). apply derivable_pt_lim_mult; assumption. Qed. Lemma derivable_pt_const : forall a x:R, derivable_pt (fct_cte a) x. Proof. intros; unfold derivable_pt. exists 0. apply derivable_pt_lim_const. Qed. Lemma derivable_pt_scal : forall f (a x:R), derivable_pt f x -> derivable_pt (mult_real_fct a f) x. Proof. unfold derivable_pt; intros f1 a x X. elim X; intros. exists (a * x0). apply derivable_pt_lim_scal; assumption. Qed. Lemma derivable_pt_Rsqr : forall x:R, derivable_pt Rsqr x. Proof. unfold derivable_pt; intro; exists (2 * x). apply derivable_pt_lim_Rsqr. Qed. (** ** Rules for derivable (derivability on whole domain) *) Lemma derivable_id : derivable id. Proof. unfold derivable; intro; apply derivable_pt_id. Qed. Lemma derivable_comp : forall f1 f2, derivable f1 -> derivable f2 -> derivable (f2 o f1). Proof. unfold derivable; intros f1 f2 X X0 x. apply (derivable_pt_comp _ _ x (X _) (X0 _)). Qed. Lemma derivable_opp : forall f, derivable f -> derivable (- f). Proof. unfold derivable; intros f X x. apply (derivable_pt_opp _ x (X _)). Qed. Lemma derivable_mirr : forall f, derivable f -> derivable (mirr_fct f). Proof. unfold derivable; intros f X x. apply (derivable_pt_mirr _ x (X _)). Qed. Lemma derivable_plus : forall f1 f2, derivable f1 -> derivable f2 -> derivable (f1 + f2). Proof. unfold derivable; intros f1 f2 X X0 x. apply (derivable_pt_plus _ _ x (X _) (X0 _)). Qed. Lemma derivable_minus : forall f1 f2, derivable f1 -> derivable f2 -> derivable (f1 - f2). Proof. unfold derivable; intros f1 f2 X X0 x. apply (derivable_pt_minus _ _ x (X _) (X0 _)). Qed. Lemma derivable_mult : forall f1 f2, derivable f1 -> derivable f2 -> derivable (f1 * f2). Proof. unfold derivable; intros f1 f2 X X0 x. apply (derivable_pt_mult _ _ x (X _) (X0 _)). Qed. Lemma derivable_const : forall a:R, derivable (fct_cte a). Proof. unfold derivable; intros. apply derivable_pt_const. Qed. Lemma derivable_scal : forall f (a:R), derivable f -> derivable (mult_real_fct a f). Proof. unfold derivable; intros f a X x. apply (derivable_pt_scal _ a x (X _)). Qed. Lemma derivable_Rsqr : derivable Rsqr. Proof. unfold derivable; intro; apply derivable_pt_Rsqr. Qed. (** ** Rules for derive_pt (derivative function on whole domain) *) Lemma derive_pt_id : forall x:R, derive_pt id x (derivable_pt_id _) = 1. Proof. intros. apply derive_pt_eq_0. apply derivable_pt_lim_id. Qed. Lemma derive_pt_comp : forall f1 f2 (x:R) (pr1:derivable_pt f1 x) (pr2:derivable_pt f2 (f1 x)), derive_pt (f2 o f1) x (derivable_pt_comp _ _ _ pr1 pr2) = derive_pt f2 (f1 x) pr2 * derive_pt f1 x pr1. Proof. intros. assert (H := derivable_derive f1 x pr1). assert (H0 := derivable_derive f2 (f1 x) pr2). assert (H1 := derivable_derive (f2 o f1)%F x (derivable_pt_comp _ _ _ pr1 pr2)). elim H; clear H; intros l1 H. elim H0; clear H0; intros l2 H0. elim H1; clear H1; intros l H1. rewrite H; rewrite H0; apply derive_pt_eq_0. assert (H3 := proj2_sig pr1). unfold derive_pt in H; rewrite H in H3. assert (H4 := proj2_sig pr2). unfold derive_pt in H0; rewrite H0 in H4. apply derivable_pt_lim_comp; assumption. Qed. Lemma derive_pt_opp : forall f (x:R) (pr1:derivable_pt f x), derive_pt (- f) x (derivable_pt_opp _ _ pr1) = - derive_pt f x pr1. Proof. intros. apply derive_pt_eq_0. apply derivable_pt_lim_opp_fwd. rewrite Ropp_involutive. apply (derive_pt_eq_1 _ _ _ pr1). reflexivity. Qed. Lemma derive_pt_opp_rev : forall f (x:R) (pr1:derivable_pt (- f) x), derive_pt (- f) x pr1 = - derive_pt f x (derivable_pt_opp_rev _ _ pr1). Proof. intros. apply derive_pt_eq_0. apply derivable_pt_lim_opp_fwd. rewrite Ropp_involutive. apply (derive_pt_eq_1 _ _ _ (derivable_pt_opp_rev _ _ pr1)). reflexivity. Qed. Lemma derive_pt_mirr : forall f (x:R) (pr1:derivable_pt f (-x)), derive_pt (mirr_fct f) x (derivable_pt_mirr _ _ pr1) = - derive_pt f (-x) pr1. Proof. intros. apply derive_pt_eq_0. apply derivable_pt_lim_mirr_fwd. rewrite Ropp_involutive. apply (derive_pt_eq_1 _ _ _ pr1). reflexivity. Qed. Lemma derive_pt_mirr_rev : forall f (x:R) (pr1:derivable_pt (mirr_fct f) x), derive_pt (mirr_fct f) x pr1 = - derive_pt f (-x) (derivable_pt_mirr_prem f x pr1). Proof. intros. apply derive_pt_eq_0. apply derivable_pt_lim_mirr_fwd. rewrite Ropp_involutive. apply (derive_pt_eq_1 _ _ _ (derivable_pt_mirr_prem f x pr1)). reflexivity. Qed. Lemma derive_pt_plus : forall f1 f2 (x:R) (pr1:derivable_pt f1 x) (pr2:derivable_pt f2 x), derive_pt (f1 + f2) x (derivable_pt_plus _ _ _ pr1 pr2) = derive_pt f1 x pr1 + derive_pt f2 x pr2. Proof. intros. assert (H := derivable_derive f1 x pr1). assert (H0 := derivable_derive f2 x pr2). assert (H1 := derivable_derive (f1 + f2)%F x (derivable_pt_plus _ _ _ pr1 pr2)). elim H; clear H; intros l1 H. elim H0; clear H0; intros l2 H0. elim H1; clear H1; intros l H1. rewrite H; rewrite H0; apply derive_pt_eq_0. assert (H3 := proj2_sig pr1). unfold derive_pt in H; rewrite H in H3. assert (H4 := proj2_sig pr2). unfold derive_pt in H0; rewrite H0 in H4. apply derivable_pt_lim_plus; assumption. Qed. Lemma derive_pt_minus : forall f1 f2 (x:R) (pr1:derivable_pt f1 x) (pr2:derivable_pt f2 x), derive_pt (f1 - f2) x (derivable_pt_minus _ _ _ pr1 pr2) = derive_pt f1 x pr1 - derive_pt f2 x pr2. Proof. intros. assert (H := derivable_derive f1 x pr1). assert (H0 := derivable_derive f2 x pr2). assert (H1 := derivable_derive (f1 - f2)%F x (derivable_pt_minus _ _ _ pr1 pr2)). elim H; clear H; intros l1 H. elim H0; clear H0; intros l2 H0. elim H1; clear H1; intros l H1. rewrite H; rewrite H0; apply derive_pt_eq_0. assert (H3 := proj2_sig pr1). unfold derive_pt in H; rewrite H in H3. assert (H4 := proj2_sig pr2). unfold derive_pt in H0; rewrite H0 in H4. apply derivable_pt_lim_minus; assumption. Qed. Lemma derive_pt_mult : forall f1 f2 (x:R) (pr1:derivable_pt f1 x) (pr2:derivable_pt f2 x), derive_pt (f1 * f2) x (derivable_pt_mult _ _ _ pr1 pr2) = derive_pt f1 x pr1 * f2 x + f1 x * derive_pt f2 x pr2. Proof. intros. assert (H := derivable_derive f1 x pr1). assert (H0 := derivable_derive f2 x pr2). assert (H1 := derivable_derive (f1 * f2)%F x (derivable_pt_mult _ _ _ pr1 pr2)). elim H; clear H; intros l1 H. elim H0; clear H0; intros l2 H0. elim H1; clear H1; intros l H1. rewrite H; rewrite H0; apply derive_pt_eq_0. assert (H3 := proj2_sig pr1). unfold derive_pt in H; rewrite H in H3. assert (H4 := proj2_sig pr2). unfold derive_pt in H0; rewrite H0 in H4. apply derivable_pt_lim_mult; assumption. Qed. Lemma derive_pt_const : forall a x:R, derive_pt (fct_cte a) x (derivable_pt_const a x) = 0. Proof. intros. apply derive_pt_eq_0. apply derivable_pt_lim_const. Qed. Lemma derive_pt_scal : forall f (a x:R) (pr:derivable_pt f x), derive_pt (mult_real_fct a f) x (derivable_pt_scal _ _ _ pr) = a * derive_pt f x pr. Proof. intros. assert (H := derivable_derive f x pr). assert (H0 := derivable_derive (mult_real_fct a f) x (derivable_pt_scal _ _ _ pr)). elim H; clear H; intros l1 H. elim H0; clear H0; intros l2 H0. rewrite H; apply derive_pt_eq_0. assert (H3 := proj2_sig pr). unfold derive_pt in H; rewrite H in H3. apply derivable_pt_lim_scal; assumption. Qed. Lemma derive_pt_Rsqr : forall x:R, derive_pt Rsqr x (derivable_pt_Rsqr _) = 2 * x. Proof. intros. apply derive_pt_eq_0. apply derivable_pt_lim_Rsqr. Qed. (** ** Definition and derivative of power function with natural number exponent *) Definition pow_fct (n:nat) (y:R) : R := y ^ n. Lemma derivable_pt_lim_pow_pos : forall (x:R) (n:nat), (0 < n)%nat -> derivable_pt_lim (fun y:R => y ^ n) x (INR n * x ^ pred n). Proof. intros. induction n as [| n Hrecn]. - elim (Nat.lt_irrefl _ H). - cut (n = 0%nat \/ (0 < n)%nat). + intro; elim H0; intro. * rewrite H1; simpl. replace (fun y:R => y * 1) with (id * fct_cte 1)%F by reflexivity. replace (1 * 1) with (1 * fct_cte 1 x + id x * 0). -- apply derivable_pt_lim_mult. ++ apply derivable_pt_lim_id. ++ apply derivable_pt_lim_const. -- unfold fct_cte, id; ring. * replace (fun y:R => y ^ S n) with (fun y:R => y * y ^ n) by reflexivity. replace (pred (S n)) with n; [ idtac | reflexivity ]. replace (fun y:R => y * y ^ n) with (id * (fun y:R => y ^ n))%F by reflexivity. set (f := fun y:R => y ^ n). replace (INR (S n) * x ^ n) with (1 * f x + id x * (INR n * x ^ pred n)). -- apply derivable_pt_lim_mult. { apply derivable_pt_lim_id. } unfold f; apply Hrecn; assumption. -- unfold f. pattern n at 1 5; replace n with (S (pred n)). { unfold id; rewrite S_INR; simpl. ring. } apply Nat.lt_succ_pred with 0%nat; assumption. + inversion H. * left; reflexivity. * right. apply Nat.lt_le_trans with 1%nat. -- apply Nat.lt_0_succ. -- assumption. Qed. Lemma derivable_pt_lim_pow : forall (x:R) (n:nat), derivable_pt_lim (fun y:R => y ^ n) x (INR n * x ^ pred n). Proof. intros. induction n as [| n Hrecn]. - simpl. rewrite Rmult_0_l. replace (fun _:R => 1) with (fct_cte 1); [ apply derivable_pt_lim_const | reflexivity ]. - apply derivable_pt_lim_pow_pos. apply Nat.lt_0_succ. Qed. Lemma derivable_pt_pow : forall (n:nat) (x:R), derivable_pt (fun y:R => y ^ n) x. Proof. intros; unfold derivable_pt. exists (INR n * x ^ pred n). apply derivable_pt_lim_pow. Qed. Lemma derivable_pow : forall n:nat, derivable (fun y:R => y ^ n). Proof. intro; unfold derivable; intro; apply derivable_pt_pow. Qed. Lemma derive_pt_pow : forall (n:nat) (x:R), derive_pt (fun y:R => y ^ n) x (derivable_pt_pow n x) = INR n * x ^ pred n. Proof. intros; apply derive_pt_eq_0. apply derivable_pt_lim_pow. Qed. (** ** Irrelevance of derivability proof for derivative *) Lemma pr_nu : forall f (x:R) (pr1 pr2:derivable_pt f x), derive_pt f x pr1 = derive_pt f x pr2. Proof. intros f x (x0,H0) (x1,H1). apply (uniqueness_limite f x x0 x1 H0 H1). Qed. (** In dependently typed environments it is sometimes hard to rewrite. Having pr_nu for separate x with a proof that they are equal helps. *) Lemma pr_nu_xeq : forall f (x1 x2:R) (pr1:derivable_pt f x1) (pr2:derivable_pt f x2), x1 = x2 -> derive_pt f x1 pr1 = derive_pt f x2 pr2. Proof. intros f x1 x2 H1 H2 Heq. subst. apply pr_nu. Qed. (************************************************************) (** * Local extremum's condition *) (************************************************************) Theorem deriv_maximum : forall f (a b c:R) (pr:derivable_pt f c), a < c -> c < b -> (forall x:R, a < x -> x < b -> f x <= f c) -> derive_pt f c pr = 0. Proof. intros; case (Rtotal_order 0 (derive_pt f c pr)); intro. { (* 0 < _ *) assert (H3 := derivable_derive f c pr). elim H3; intros l H4; rewrite H4 in H2. assert (H5 := derive_pt_eq_1 f c l pr H4). cut (0 < l / 2); [ intro | unfold Rdiv; apply Rmult_lt_0_compat; [ assumption | apply Rinv_0_lt_compat; prove_sup0 ] ]. elim (H5 (l / 2) H6); intros delta H7. cut (0 < (b - c) / 2). 1:intro; cut (Rmin (delta / 2) ((b - c) / 2) <> 0). 1:intro; cut (Rabs (Rmin (delta / 2) ((b - c) / 2)) < delta). - intro. assert (H11 := H7 (Rmin (delta / 2) ((b - c) / 2)) H9 H10). cut (0 < Rmin (delta / 2) ((b - c) / 2)). 1:intro; cut (a < c + Rmin (delta / 2) ((b - c) / 2)). 1:intro; cut (c + Rmin (delta / 2) ((b - c) / 2) < b). 1:intro; assert (H15 := H1 (c + Rmin (delta / 2) ((b - c) / 2)) H13 H14). 1:cut ((f (c + Rmin (delta / 2) ((b - c) / 2)) - f c) / Rmin (delta / 2) ((b - c) / 2) <= 0). 1:intro; cut (- l < 0). 1:intro; unfold Rminus in H11. 1:cut ((f (c + Rmin (delta / 2) ((b + - c) / 2)) + - f c) / Rmin (delta / 2) ((b + - c) / 2) + - l < 0). 1:intro; cut (Rabs ((f (c + Rmin (delta / 2) ((b + - c) / 2)) + - f c) / Rmin (delta / 2) ((b + - c) / 2) + - l) < l / 2). + unfold Rabs; case (Rcase_abs ((f (c + Rmin (delta / 2) ((b + - c) / 2)) + - f c) / Rmin (delta / 2) ((b + - c) / 2) + - l)) as [Hlt|Hge]. * replace (- ((f (c + Rmin (delta / 2) ((b + - c) / 2)) + - f c) / Rmin (delta / 2) ((b + - c) / 2) + - l)) with (l + - ((f (c + Rmin (delta / 2) ((b + - c) / 2)) + - f c) / Rmin (delta / 2) ((b + - c) / 2))). -- intro; generalize (Rplus_lt_compat_l (- l) (l + - ((f (c + Rmin (delta / 2) ((b + - c) / 2)) + - f c) / Rmin (delta / 2) ((b + - c) / 2))) (l / 2) H19); repeat rewrite <- Rplus_assoc; rewrite Rplus_opp_l; rewrite Rplus_0_l; replace (- l + l / 2) with (- (l / 2)). ++ intro; generalize (Ropp_lt_gt_contravar (- ((f (c + Rmin (delta / 2) ((b + - c) / 2)) + - f c) / Rmin (delta / 2) ((b + - c) / 2))) (- (l / 2)) H20); repeat rewrite Ropp_involutive; intro; generalize (Rlt_trans 0 (l / 2) ((f (c + Rmin (delta / 2) ((b + - c) / 2)) + - f c) / Rmin (delta / 2) ((b + - c) / 2)) H6 H21); intro; elim (Rlt_irrefl 0 (Rlt_le_trans 0 ((f (c + Rmin (delta / 2) ((b + - c) / 2)) + - f c) / Rmin (delta / 2) ((b + - c) / 2)) 0 H22 H16)). ++ pattern l at 2; rewrite <-Rplus_half_diag. ring. -- ring. * intro. assert (H20 := Rge_le ((f (c + Rmin (delta / 2) ((b + - c) / 2)) + - f c) / Rmin (delta / 2) ((b + - c) / 2) + - l) 0 Hge). elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H20 H18)). + assumption. + rewrite <- Ropp_0; replace ((f (c + Rmin (delta / 2) ((b + - c) / 2)) + - f c) / Rmin (delta / 2) ((b + - c) / 2) + - l) with (- (l + - ((f (c + Rmin (delta / 2) ((b + - c) / 2)) - f c) / Rmin (delta / 2) ((b + - c) / 2)))). * apply Ropp_gt_lt_contravar; change (0 < l + - ((f (c + Rmin (delta / 2) ((b + - c) / 2)) - f c) / Rmin (delta / 2) ((b + - c) / 2))); apply Rplus_lt_le_0_compat; [ assumption | rewrite <- Ropp_0; apply Ropp_ge_le_contravar; apply Rle_ge; assumption ]. * unfold Rminus; ring. + rewrite <- Ropp_0; apply Ropp_lt_gt_contravar; assumption. + replace ((f (c + Rmin (delta / 2) ((b - c) / 2)) - f c) / Rmin (delta / 2) ((b - c) / 2)) with (- ((f c - f (c + Rmin (delta / 2) ((b - c) / 2))) / Rmin (delta / 2) ((b - c) / 2))). * rewrite <- Ropp_0; apply Ropp_ge_le_contravar; apply Rle_ge; unfold Rdiv; apply Rmult_le_pos; [ generalize (Rplus_le_compat_r (- f (c + Rmin (delta * / 2) ((b - c) * / 2))) (f (c + Rmin (delta * / 2) ((b - c) * / 2))) ( f c) H15); rewrite Rplus_opp_r; intro; assumption | left; apply Rinv_0_lt_compat; assumption ]. * unfold Rdiv. rewrite <- Ropp_mult_distr_l_reverse. repeat rewrite <- (Rmult_comm (/ Rmin (delta * / 2) ((b - c) * / 2))). apply Rmult_eq_reg_l with (Rmin (delta * / 2) ((b - c) * / 2)). -- repeat rewrite <- Rmult_assoc. rewrite Rinv_r. ++ repeat rewrite Rmult_1_l. ring. ++ red; intro. unfold Rdiv in H12; rewrite H16 in H12; elim (Rlt_irrefl 0 H12). -- red; intro. unfold Rdiv in H12; rewrite H16 in H12; elim (Rlt_irrefl 0 H12). + assert (H14 := Rmin_r (delta / 2) ((b - c) / 2)). assert (H15 := Rplus_le_compat_l c (Rmin (delta / 2) ((b - c) / 2)) ((b - c) / 2) H14). apply Rle_lt_trans with (c + (b - c) / 2). * assumption. * apply Rmult_lt_reg_l with 2. -- prove_sup0. -- replace (2 * (c + (b - c) / 2)) with (c + b). ++ replace (2 * b) with (b + b). ** apply Rplus_lt_compat_r; assumption. ** ring. ++ unfold Rdiv; rewrite Rmult_plus_distr_l. repeat rewrite (Rmult_comm 2). rewrite Rmult_assoc; rewrite Rinv_l. ** rewrite Rmult_1_r. ring. ** discrR. + apply Rlt_trans with c. * assumption. * pattern c at 1; rewrite <- (Rplus_0_r c); apply Rplus_lt_compat_l; assumption. + cut (0 < delta / 2). * intro; apply (Rmin_stable_in_posreal (mkposreal (delta / 2) H12) (mkposreal ((b - c) / 2) H8)). * unfold Rdiv; apply Rmult_lt_0_compat; [ apply (cond_pos delta) | apply Rinv_0_lt_compat; prove_sup0 ]. - unfold Rabs; case (Rcase_abs (Rmin (delta / 2) ((b - c) / 2))) as [Hlt|Hge]. + cut (0 < delta / 2). * intro. generalize (Rmin_stable_in_posreal (mkposreal (delta / 2) H10) (mkposreal ((b - c) / 2) H8)); simpl; intro; elim (Rlt_irrefl 0 (Rlt_trans 0 (Rmin (delta / 2) ((b - c) / 2)) 0 H11 Hlt)). * unfold Rdiv; apply Rmult_lt_0_compat; [ apply (cond_pos delta) | apply Rinv_0_lt_compat; prove_sup0 ]. + apply Rle_lt_trans with (delta / 2). * apply Rmin_l. * unfold Rdiv; apply Rmult_lt_reg_l with 2. -- prove_sup0. -- rewrite <- (Rmult_comm (/ 2)); rewrite <- Rmult_assoc; rewrite Rinv_r. ++ rewrite Rmult_1_l. replace (2 * delta) with (delta + delta). ** pattern delta at 2; rewrite <- (Rplus_0_r delta); apply Rplus_lt_compat_l. rewrite Rplus_0_r; apply (cond_pos delta). ** apply Rplus_diag. ++ discrR. - cut (0 < delta / 2). + intro; generalize (Rmin_stable_in_posreal (mkposreal (delta / 2) H9) (mkposreal ((b - c) / 2) H8)); simpl; intro; red; intro; rewrite H11 in H10; elim (Rlt_irrefl 0 H10). + unfold Rdiv; apply Rmult_lt_0_compat; [ apply (cond_pos delta) | apply Rinv_0_lt_compat; prove_sup0 ]. - unfold Rdiv; apply Rmult_lt_0_compat. + generalize (Rplus_lt_compat_r (- c) c b H0); rewrite Rplus_opp_r; intro; assumption. + apply Rinv_0_lt_compat; prove_sup0. } elim H2; intro. { (* 0 = _ *) symmetry ; assumption. } (* 0 > _ *) generalize (derivable_derive f c pr); intro; elim H4; intros l H5. rewrite H5 in H3; generalize (derive_pt_eq_1 f c l pr H5); intro; cut (0 < - (l / 2)). - intro; elim (H6 (- (l / 2)) H7); intros delta H9. cut (0 < (c - a) / 2). 1:intro; cut (Rmax (- (delta / 2)) ((a - c) / 2) < 0). 1:intro; cut (Rmax (- (delta / 2)) ((a - c) / 2) <> 0). 1:intro; cut (Rabs (Rmax (- (delta / 2)) ((a - c) / 2)) < delta). 1:intro; generalize (H9 (Rmax (- (delta / 2)) ((a - c) / 2)) H11 H12); intro; cut (a < c + Rmax (- (delta / 2)) ((a - c) / 2)). 1:cut (c + Rmax (- (delta / 2)) ((a - c) / 2) < b). 1:intros; generalize (H1 (c + Rmax (- (delta / 2)) ((a - c) / 2)) H15 H14); intro; cut (0 <= (f (c + Rmax (- (delta / 2)) ((a - c) / 2)) - f c) / Rmax (- (delta / 2)) ((a - c) / 2)). 1:intro; cut (0 < - l). 1:intro; unfold Rminus in H13; cut (0 < (f (c + Rmax (- (delta / 2)) ((a + - c) / 2)) + - f c) / Rmax (- (delta / 2)) ((a + - c) / 2) + - l). 1:intro; cut (Rabs ((f (c + Rmax (- (delta / 2)) ((a + - c) / 2)) + - f c) / Rmax (- (delta / 2)) ((a + - c) / 2) + - l) < - (l / 2)). + unfold Rabs; case (Rcase_abs ((f (c + Rmax (- (delta / 2)) ((a + - c) / 2)) + - f c) / Rmax (- (delta / 2)) ((a + - c) / 2) + - l)) as [Hlt|Hge]. * elim (Rlt_irrefl 0 (Rlt_trans 0 ((f (c + Rmax (- (delta / 2)) ((a + - c) / 2)) + - f c) / Rmax (- (delta / 2)) ((a + - c) / 2) + - l) 0 H19 Hlt)). * intros; generalize (Rplus_lt_compat_r l ((f (c + Rmax (- (delta / 2)) ((a + - c) / 2)) + - f c) / Rmax (- (delta / 2)) ((a + - c) / 2) + - l) ( - (l / 2)) H20); repeat rewrite Rplus_assoc; rewrite Rplus_opp_l; rewrite Rplus_0_r; replace (- (l / 2) + l) with (l / 2). -- cut (l / 2 < 0). ++ intros; generalize (Rlt_trans ((f (c + Rmax (- (delta / 2)) ((a + - c) / 2)) + - f c) / Rmax (- (delta / 2)) ((a + - c) / 2)) (l / 2) 0 H22 H21); intro; elim (Rlt_irrefl 0 (Rle_lt_trans 0 ((f (c + Rmax (- (delta / 2)) ((a - c) / 2)) - f c) / Rmax (- (delta / 2)) ((a - c) / 2)) 0 H17 H23)). ++ rewrite <- (Ropp_involutive (l / 2)); rewrite <- Ropp_0; apply Ropp_lt_gt_contravar; assumption. -- pattern l at 3; rewrite <-Rplus_half_diag. ring. + assumption. + apply Rplus_le_lt_0_compat; assumption. + rewrite <- Ropp_0; apply Ropp_lt_gt_contravar; assumption. + unfold Rdiv; replace ((f (c + Rmax (- (delta * / 2)) ((a - c) * / 2)) - f c) * / Rmax (- (delta * / 2)) ((a - c) * / 2)) with (- (f (c + Rmax (- (delta * / 2)) ((a - c) * / 2)) - f c) * / - Rmax (- (delta * / 2)) ((a - c) * / 2)). * apply Rmult_le_pos. -- generalize (Rplus_le_compat_l (- f (c + Rmax (- (delta * / 2)) ((a - c) * / 2))) (f (c + Rmax (- (delta * / 2)) ((a - c) * / 2))) ( f c) H16); rewrite Rplus_opp_l; replace (- (f (c + Rmax (- (delta * / 2)) ((a - c) * / 2)) - f c)) with (- f (c + Rmax (- (delta * / 2)) ((a - c) * / 2)) + f c). ++ intro; assumption. ++ ring. -- left; apply Rinv_0_lt_compat; rewrite <- Ropp_0; apply Ropp_lt_gt_contravar; assumption. * unfold Rdiv. rewrite Rinv_opp. rewrite Rmult_opp_opp. reflexivity. + generalize (Rplus_lt_compat_l c (Rmax (- (delta / 2)) ((a - c) / 2)) 0 H10); rewrite Rplus_0_r; intro; apply Rlt_trans with c; assumption. + generalize (RmaxLess2 (- (delta / 2)) ((a - c) / 2)); intro; generalize (Rplus_le_compat_l c ((a - c) / 2) (Rmax (- (delta / 2)) ((a - c) / 2)) H14); intro; apply Rlt_le_trans with (c + (a - c) / 2). * apply Rmult_lt_reg_l with 2. -- prove_sup0. -- replace (2 * (c + (a - c) / 2)) with (a + c). ++ rewrite <-Rplus_diag. apply Rplus_lt_compat_l; assumption. ++ field; discrR. * assumption. + unfold Rabs; case (Rcase_abs (Rmax (- (delta / 2)) ((a - c) / 2))) as [Hlt|Hge]. * generalize (RmaxLess1 (- (delta / 2)) ((a - c) / 2)); intro; generalize (Ropp_le_ge_contravar (- (delta / 2)) (Rmax (- (delta / 2)) ((a - c) / 2)) H12); rewrite Ropp_involutive; intro; generalize (Rge_le (delta / 2) (- Rmax (- (delta / 2)) ((a - c) / 2)) H13); intro; apply Rle_lt_trans with (delta / 2). -- assumption. -- apply Rmult_lt_reg_l with 2. ++ prove_sup0. ++ unfold Rdiv; rewrite <- (Rmult_comm (/ 2)); rewrite <- Rmult_assoc; rewrite Rinv_r. ** rewrite Rmult_1_l; rewrite <-Rplus_diag. pattern delta at 2; rewrite <- (Rplus_0_r delta); apply Rplus_lt_compat_l; rewrite Rplus_0_r; apply (cond_pos delta). ** discrR. * cut (- (delta / 2) < 0). -- cut ((a - c) / 2 < 0). ++ intros; generalize (Rmax_stable_in_negreal (mknegreal (- (delta / 2)) H13) (mknegreal ((a - c) / 2) H12)); simpl; intro; generalize (Rge_le (Rmax (- (delta / 2)) ((a - c) / 2)) 0 Hge); intro; elim (Rlt_irrefl 0 (Rle_lt_trans 0 (Rmax (- (delta / 2)) ((a - c) / 2)) 0 H15 H14)). ++ rewrite <- Ropp_0; rewrite <- (Ropp_involutive ((a - c) / 2)); apply Ropp_lt_gt_contravar; replace (- ((a - c) / 2)) with ((c - a) / 2). ** assumption. ** unfold Rdiv. rewrite <- Ropp_mult_distr_l_reverse. rewrite (Ropp_minus_distr a c). reflexivity. -- rewrite <- Ropp_0; apply Ropp_lt_gt_contravar; unfold Rdiv; apply Rmult_lt_0_compat; [ apply (cond_pos delta) | assert (Hyp : 0 < 2); [ prove_sup0 | apply (Rinv_0_lt_compat 2 Hyp) ] ]. + red; intro; rewrite H11 in H10; elim (Rlt_irrefl 0 H10). + cut ((a - c) / 2 < 0). * intro; cut (- (delta / 2) < 0). -- intro; apply (Rmax_stable_in_negreal (mknegreal (- (delta / 2)) H11) (mknegreal ((a - c) / 2) H10)). -- rewrite <- Ropp_0; apply Ropp_lt_gt_contravar; unfold Rdiv; apply Rmult_lt_0_compat; [ apply (cond_pos delta) | assert (Hyp : 0 < 2); [ prove_sup0 | apply (Rinv_0_lt_compat 2 Hyp) ] ]. * rewrite <- Ropp_0; rewrite <- (Ropp_involutive ((a - c) / 2)); apply Ropp_lt_gt_contravar; replace (- ((a - c) / 2)) with ((c - a) / 2). -- assumption. -- unfold Rdiv. rewrite <- Ropp_mult_distr_l_reverse. rewrite (Ropp_minus_distr a c). reflexivity. + unfold Rdiv; apply Rmult_lt_0_compat; [ generalize (Rplus_lt_compat_r (- a) a c H); rewrite Rplus_opp_r; intro; assumption | assert (Hyp : 0 < 2); [ prove_sup0 | apply (Rinv_0_lt_compat 2 Hyp) ] ]. - replace (- (l / 2)) with (- l / 2). + unfold Rdiv; apply Rmult_lt_0_compat. * rewrite <- Ropp_0; apply Ropp_lt_gt_contravar; assumption. * assert (Hyp : 0 < 2); [ prove_sup0 | apply (Rinv_0_lt_compat 2 Hyp) ]. + unfold Rdiv; apply Ropp_mult_distr_l_reverse. Qed. Theorem deriv_minimum : forall f (a b c:R) (pr:derivable_pt f c), a < c -> c < b -> (forall x:R, a < x -> x < b -> f c <= f x) -> derive_pt f c pr = 0. Proof. intros. rewrite <- (Ropp_involutive (derive_pt f c pr)). apply Ropp_eq_0_compat. rewrite <- (derive_pt_opp f c pr). cut (forall x:R, a < x -> x < b -> (- f)%F x <= (- f)%F c). - intro. apply (deriv_maximum (- f)%F a b c (derivable_pt_opp _ _ pr) H H0 H2). - intros; unfold opp_fct; apply Ropp_ge_le_contravar; apply Rle_ge. apply (H1 x H2 H3). Qed. Theorem deriv_constant2 : forall f (a b c:R) (pr:derivable_pt f c), a < c -> c < b -> (forall x:R, a < x -> x < b -> f x = f c) -> derive_pt f c pr = 0. Proof. intros. eapply deriv_maximum with a b; try assumption. intros; right; apply (H1 x H2 H3). Qed. (**********) Lemma nonneg_derivative_0 : forall f (pr:derivable f), increasing f -> forall x:R, 0 <= derive_pt f x (pr x). Proof. intros; unfold increasing in H. assert (H0 := derivable_derive f x (pr x)). elim H0; intros l H1. rewrite H1; case (Rtotal_order 0 l); intro. - left; assumption. - elim H2; intro. + right; assumption. + assert (H4 := derive_pt_eq_1 f x l (pr x) H1). cut (0 < - (l / 2)). 1:intro; elim (H4 (- (l / 2)) H5); intros delta H6. 1:cut (delta / 2 <> 0 /\ 0 < delta / 2 /\ Rabs (delta / 2) < delta). 1:intro; decompose [and] H7; intros; generalize (H6 (delta / 2) H8 H11); cut (0 <= (f (x + delta / 2) - f x) / (delta / 2)). 1:intro; cut (0 <= (f (x + delta / 2) - f x) / (delta / 2) - l). * intro; unfold Rabs; case (Rcase_abs ((f (x + delta / 2) - f x) / (delta / 2) - l)) as [Hlt|Hge]. -- elim (Rlt_irrefl 0 (Rle_lt_trans 0 ((f (x + delta / 2) - f x) / (delta / 2) - l) 0 H12 Hlt)). -- intros; generalize (Rplus_lt_compat_r l ((f (x + delta / 2) - f x) / (delta / 2) - l) (- (l / 2)) H13); unfold Rminus; replace (- (l / 2) + l) with (l / 2). ++ rewrite Rplus_assoc; rewrite Rplus_opp_l; rewrite Rplus_0_r; intro; generalize (Rle_lt_trans 0 ((f (x + delta / 2) - f x) / (delta / 2)) (l / 2) H9 H14); intro; cut (l / 2 < 0). ** intro; elim (Rlt_irrefl 0 (Rlt_trans 0 (l / 2) 0 H15 H16)). ** rewrite <- Ropp_0 in H5; generalize (Ropp_lt_gt_contravar (-0) (- (l / 2)) H5); repeat rewrite Ropp_involutive; intro; assumption. ++ pattern l at 3; rewrite <-Rplus_half_diag. ring. * unfold Rminus; apply Rplus_le_le_0_compat. -- unfold Rdiv; apply Rmult_le_pos. ++ cut (x <= x + delta * / 2). ** intro; generalize (H x (x + delta * / 2) H12); intro; generalize (Rplus_le_compat_l (- f x) (f x) (f (x + delta * / 2)) H13); rewrite Rplus_opp_l; rewrite Rplus_comm; intro; assumption. ** pattern x at 1; rewrite <- (Rplus_0_r x); apply Rplus_le_compat_l; left; assumption. ++ left; apply Rinv_0_lt_compat; assumption. -- left; rewrite <- Ropp_0; apply Ropp_lt_gt_contravar; assumption. * unfold Rdiv; apply Rmult_le_pos. -- cut (x <= x + delta * / 2). ++ intro; generalize (H x (x + delta * / 2) H9); intro; generalize (Rplus_le_compat_l (- f x) (f x) (f (x + delta * / 2)) H12); rewrite Rplus_opp_l; rewrite Rplus_comm; intro; assumption. ++ pattern x at 1; rewrite <- (Rplus_0_r x); apply Rplus_le_compat_l; left; assumption. -- left; apply Rinv_0_lt_compat; assumption. * split. -- unfold Rdiv; apply prod_neq_R0. ++ generalize (cond_pos delta); intro; red; intro H9; rewrite H9 in H7; elim (Rlt_irrefl 0 H7). ++ apply Rinv_neq_0_compat; discrR. -- split. ++ unfold Rdiv; apply Rmult_lt_0_compat; [ apply (cond_pos delta) | apply Rinv_0_lt_compat; prove_sup0 ]. ++ replace (Rabs (delta / 2)) with (delta / 2). ** unfold Rdiv; apply Rmult_lt_reg_l with 2. { prove_sup0. } rewrite (Rmult_comm 2). rewrite Rmult_assoc; rewrite Rinv_l; [ idtac | discrR ]. rewrite Rmult_1_r. rewrite <-Rplus_diag. pattern (pos delta) at 1; rewrite <- Rplus_0_r. apply Rplus_lt_compat_l; apply (cond_pos delta). ** symmetry ; apply Rabs_right. left; change (0 < delta / 2); unfold Rdiv; apply Rmult_lt_0_compat; [ apply (cond_pos delta) | apply Rinv_0_lt_compat; prove_sup0 ]. * unfold Rdiv; rewrite <- Ropp_mult_distr_l_reverse; apply Rmult_lt_0_compat. -- apply Rplus_lt_reg_l with l. unfold Rminus; rewrite Rplus_opp_r; rewrite Rplus_0_r; assumption. -- apply Rinv_0_lt_compat; prove_sup0. Qed. coq-8.20.0/theories/Reals/Ranalysis2.v000066400000000000000000000347101466560755400175200ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* R), h <> 0 -> f2 x <> 0 -> f2 (x + h) <> 0 -> (f1 (x + h) / f2 (x + h) - f1 x / f2 x) / h - (l1 * f2 x - l2 * f1 x) / Rsqr (f2 x) = / f2 (x + h) * ((f1 (x + h) - f1 x) / h - l1) + l1 / (f2 x * f2 (x + h)) * (f2 x - f2 (x + h)) - f1 x / (f2 x * f2 (x + h)) * ((f2 (x + h) - f2 x) / h - l2) + l2 * f1 x / (Rsqr (f2 x) * f2 (x + h)) * (f2 (x + h) - f2 x). Proof. intros; unfold Rdiv, Rminus, Rsqr. repeat rewrite Rmult_plus_distr_r; repeat rewrite Rmult_plus_distr_l; repeat rewrite Rinv_mult. replace (l1 * f2 x * (/ f2 x * / f2 x)) with (l1 * / f2 x * (f2 x * / f2 x)); [ idtac | ring ]. replace (l1 * (/ f2 x * / f2 (x + h)) * f2 x) with (l1 * / f2 (x + h) * (f2 x * / f2 x)); [ idtac | ring ]. replace (l1 * (/ f2 x * / f2 (x + h)) * - f2 (x + h)) with (- (l1 * / f2 x * (f2 (x + h) * / f2 (x + h)))); [ idtac | ring ]. replace (f1 x * (/ f2 x * / f2 (x + h)) * (f2 (x + h) * / h)) with (f1 x * / f2 x * / h * (f2 (x + h) * / f2 (x + h))); [ idtac | ring ]. replace (f1 x * (/ f2 x * / f2 (x + h)) * (- f2 x * / h)) with (- (f1 x * / f2 (x + h) * / h * (f2 x * / f2 x))); [ idtac | ring ]. replace (l2 * f1 x * (/ f2 x * / f2 x * / f2 (x + h)) * f2 (x + h)) with (l2 * f1 x * / f2 x * / f2 x * (f2 (x + h) * / f2 (x + h))); [ idtac | ring ]. replace (l2 * f1 x * (/ f2 x * / f2 x * / f2 (x + h)) * - f2 x) with (- (l2 * f1 x * / f2 x * / f2 (x + h) * (f2 x * / f2 x))); [ idtac | ring ]. repeat rewrite Rinv_r; try assumption || ring. Qed. (* begin hide *) Notation Rmin_pos := Rmin_pos (only parsing). (* compat *) (* end hide *) Lemma maj_term1 : forall (x h eps l1 alp_f2:R) (eps_f2 alp_f1d:posreal) (f1 f2:R -> R), 0 < eps -> f2 x <> 0 -> f2 (x + h) <> 0 -> (forall h:R, h <> 0 -> Rabs h < alp_f1d -> Rabs ((f1 (x + h) - f1 x) / h - l1) < Rabs (eps * f2 x / 8)) -> (forall a:R, Rabs a < Rmin eps_f2 alp_f2 -> / Rabs (f2 (x + a)) < 2 / Rabs (f2 x)) -> h <> 0 -> Rabs h < alp_f1d -> Rabs h < Rmin eps_f2 alp_f2 -> Rabs (/ f2 (x + h) * ((f1 (x + h) - f1 x) / h - l1)) < eps / 4. Proof. intros. assert (H7 := H3 h H6). assert (H8 := H2 h H4 H5). apply Rle_lt_trans with (2 / Rabs (f2 x) * Rabs ((f1 (x + h) - f1 x) / h - l1)). - rewrite Rabs_mult. apply Rmult_le_compat_r. + apply Rabs_pos. + rewrite Rabs_inv; left; exact H7. - apply Rlt_le_trans with (2 / Rabs (f2 x) * Rabs (eps * f2 x / 8)). + apply Rmult_lt_compat_l. * unfold Rdiv; apply Rmult_lt_0_compat; [ prove_sup0 | apply Rinv_0_lt_compat; apply Rabs_pos_lt; assumption ]. * exact H8. + right; unfold Rdiv. repeat rewrite Rabs_mult. rewrite Rabs_inv. rewrite (Rabs_pos_eq 8) by now apply IZR_le. rewrite (Rabs_pos_eq eps). * field. now apply Rabs_no_R0. * now apply Rlt_le. Qed. Lemma maj_term2 : forall (x h eps l1 alp_f2 alp_f2t2:R) (eps_f2:posreal) (f2:R -> R), 0 < eps -> f2 x <> 0 -> f2 (x + h) <> 0 -> (forall a:R, Rabs a < alp_f2t2 -> Rabs (f2 (x + a) - f2 x) < Rabs (eps * Rsqr (f2 x) / (8 * l1))) -> (forall a:R, Rabs a < Rmin eps_f2 alp_f2 -> / Rabs (f2 (x + a)) < 2 / Rabs (f2 x)) -> h <> 0 -> Rabs h < alp_f2t2 -> Rabs h < Rmin eps_f2 alp_f2 -> l1 <> 0 -> Rabs (l1 / (f2 x * f2 (x + h)) * (f2 x - f2 (x + h))) < eps / 4. Proof. intros. assert (H8 := H3 h H6). assert (H9 := H2 h H5). apply Rle_lt_trans with (Rabs (l1 / (f2 x * f2 (x + h))) * Rabs (eps * Rsqr (f2 x) / (8 * l1))). { rewrite Rabs_mult; apply Rmult_le_compat_l. { apply Rabs_pos. } rewrite <- (Rabs_Ropp (f2 x - f2 (x + h))); rewrite Ropp_minus_distr. left; apply H9. } apply Rlt_le_trans with (Rabs (2 * (l1 / (f2 x * f2 x))) * Rabs (eps * Rsqr (f2 x) / (8 * l1))). { apply Rmult_lt_compat_r. { apply Rabs_pos_lt. unfold Rdiv; unfold Rsqr; repeat apply prod_neq_R0; try assumption || discrR. { lra. } apply Rinv_neq_0_compat; apply prod_neq_R0; try assumption || discrR. } unfold Rdiv. repeat rewrite Rinv_mult. repeat rewrite Rabs_mult. replace (Rabs 2) with 2 by (symmetry; apply Rabs_right; left; prove_sup0). rewrite (Rmult_comm 2). replace (Rabs l1 * (Rabs (/ f2 x) * Rabs (/ f2 x)) * 2) with (Rabs l1 * (Rabs (/ f2 x) * (Rabs (/ f2 x) * 2))) by ring. repeat apply Rmult_lt_compat_l. - apply Rabs_pos_lt; assumption. - apply Rabs_pos_lt; apply Rinv_neq_0_compat; assumption. - repeat rewrite Rabs_inv. rewrite <- (Rmult_comm 2). unfold Rdiv in H8; exact H8. } right. unfold Rsqr, Rdiv. rewrite 2!Rinv_mult. repeat rewrite Rabs_mult. repeat rewrite Rabs_inv. replace (Rabs eps) with eps by (symmetry ; apply Rabs_right; left; assumption). replace (Rabs 8) with 8 by (symmetry ; apply Rabs_right; left; prove_sup). replace (Rabs 2) with 2 by (symmetry ; apply Rabs_right; left; prove_sup0). replace 8 with (4 * 2); [ idtac | ring ]. rewrite Rinv_mult. replace (2 * (Rabs l1 * (/ Rabs (f2 x) * / Rabs (f2 x))) * (eps * (Rabs (f2 x) * Rabs (f2 x)) * (/ 4 * / 2 * / Rabs l1))) with (eps * / 4 * (Rabs l1 * / Rabs l1) * (Rabs (f2 x) * / Rabs (f2 x)) * (Rabs (f2 x) * / Rabs (f2 x)) * (2 * / 2)); [ idtac | ring ]. repeat rewrite Rinv_r; try (apply Rabs_no_R0; assumption) || discrR. ring. Qed. Lemma maj_term3 : forall (x h eps l2 alp_f2:R) (eps_f2 alp_f2d:posreal) (f1 f2:R -> R), 0 < eps -> f2 x <> 0 -> f2 (x + h) <> 0 -> (forall h:R, h <> 0 -> Rabs h < alp_f2d -> Rabs ((f2 (x + h) - f2 x) / h - l2) < Rabs (Rsqr (f2 x) * eps / (8 * f1 x))) -> (forall a:R, Rabs a < Rmin eps_f2 alp_f2 -> / Rabs (f2 (x + a)) < 2 / Rabs (f2 x)) -> h <> 0 -> Rabs h < alp_f2d -> Rabs h < Rmin eps_f2 alp_f2 -> f1 x <> 0 -> Rabs (f1 x / (f2 x * f2 (x + h)) * ((f2 (x + h) - f2 x) / h - l2)) < eps / 4. Proof. intros. assert (H8 := H2 h H4 H5). assert (H9 := H3 h H6). apply Rle_lt_trans with (Rabs (f1 x / (f2 x * f2 (x + h))) * Rabs (Rsqr (f2 x) * eps / (8 * f1 x))). { rewrite Rabs_mult. apply Rmult_le_compat_l. { apply Rabs_pos. } left; apply H8. } apply Rlt_le_trans with (Rabs (2 * (f1 x / (f2 x * f2 x))) * Rabs (Rsqr (f2 x) * eps / (8 * f1 x))). - apply Rmult_lt_compat_r. { apply Rabs_pos_lt. unfold Rdiv; unfold Rsqr; repeat apply prod_neq_R0; try assumption. { lra. } apply Rinv_neq_0_compat; apply prod_neq_R0; discrR || assumption. } unfold Rdiv. repeat rewrite Rinv_mult. repeat rewrite Rabs_mult. replace (Rabs 2) with 2 by (symmetry ; apply Rabs_right; left; prove_sup0). rewrite (Rmult_comm 2). replace (Rabs (f1 x) * (Rabs (/ f2 x) * Rabs (/ f2 x)) * 2) with (Rabs (f1 x) * (Rabs (/ f2 x) * (Rabs (/ f2 x) * 2))) by ring. repeat apply Rmult_lt_compat_l. { apply Rabs_pos_lt; assumption. } { apply Rabs_pos_lt; apply Rinv_neq_0_compat; assumption. } repeat rewrite Rabs_inv. rewrite <- (Rmult_comm 2). unfold Rdiv in H9; exact H9. - right. unfold Rsqr, Rdiv. rewrite 2!Rinv_mult. repeat rewrite Rabs_mult. repeat rewrite Rabs_inv. replace (Rabs eps) with eps by (symmetry ; apply Rabs_right; left; assumption). replace (Rabs 8) with 8 by (symmetry ; apply Rabs_right; left; prove_sup). replace (Rabs 2) with 2 by (symmetry ; apply Rabs_right; left; prove_sup0). replace 8 with (4 * 2); [ idtac | ring ]. rewrite Rinv_mult. replace (2 * (Rabs (f1 x) * (/ Rabs (f2 x) * / Rabs (f2 x))) * (Rabs (f2 x) * Rabs (f2 x) * eps * (/ 4 * / 2 * / Rabs (f1 x)))) with (eps * / 4 * (Rabs (f2 x) * / Rabs (f2 x)) * (Rabs (f2 x) * / Rabs (f2 x)) * (Rabs (f1 x) * / Rabs (f1 x)) * (2 * / 2)); [ idtac | ring ]. repeat rewrite Rinv_r; try discrR || (apply Rabs_no_R0; assumption). ring. Qed. Lemma maj_term4 : forall (x h eps l2 alp_f2 alp_f2c:R) (eps_f2:posreal) (f1 f2:R -> R), 0 < eps -> f2 x <> 0 -> f2 (x + h) <> 0 -> (forall a:R, Rabs a < alp_f2c -> Rabs (f2 (x + a) - f2 x) < Rabs (Rsqr (f2 x) * f2 x * eps / (8 * f1 x * l2))) -> (forall a:R, Rabs a < Rmin eps_f2 alp_f2 -> / Rabs (f2 (x + a)) < 2 / Rabs (f2 x)) -> h <> 0 -> Rabs h < alp_f2c -> Rabs h < Rmin eps_f2 alp_f2 -> f1 x <> 0 -> l2 <> 0 -> Rabs (l2 * f1 x / (Rsqr (f2 x) * f2 (x + h)) * (f2 (x + h) - f2 x)) < eps / 4. Proof. intros. assert (H9 := H2 h H5). assert (H10 := H3 h H6). apply Rle_lt_trans with (Rabs (l2 * f1 x / (Rsqr (f2 x) * f2 (x + h))) * Rabs (Rsqr (f2 x) * f2 x * eps / (8 * f1 x * l2))). { rewrite Rabs_mult. apply Rmult_le_compat_l. - apply Rabs_pos. - left; apply H9. } apply Rlt_le_trans with (Rabs (2 * l2 * (f1 x / (Rsqr (f2 x) * f2 x))) * Rabs (Rsqr (f2 x) * f2 x * eps / (8 * f1 x * l2))). { apply Rmult_lt_compat_r. { apply Rabs_pos_lt. unfold Rdiv; unfold Rsqr; repeat apply prod_neq_R0; assumption || idtac. { lra. } apply Rinv_neq_0_compat; apply prod_neq_R0;lra. } unfold Rdiv. repeat rewrite Rinv_mult. repeat rewrite Rabs_mult. replace (Rabs 2) with 2 by (symmetry ; apply Rabs_right; left; prove_sup0). replace (2 * Rabs l2 * (Rabs (f1 x) * (Rabs (/ Rsqr (f2 x)) * Rabs (/ f2 x)))) with (Rabs l2 * (Rabs (f1 x) * (Rabs (/ Rsqr (f2 x)) * (Rabs (/ f2 x) * 2)))); [ idtac | ring ]. replace (Rabs l2 * Rabs (f1 x) * (Rabs (/ Rsqr (f2 x)) * Rabs (/ f2 (x + h)))) with (Rabs l2 * (Rabs (f1 x) * (Rabs (/ Rsqr (f2 x)) * Rabs (/ f2 (x + h))))); [ idtac | ring ]. repeat apply Rmult_lt_compat_l;try apply Rabs_pos_lt. 1,2:assumption. { apply Rinv_neq_0_compat; unfold Rsqr; apply prod_neq_R0; assumption. } repeat rewrite Rabs_inv. rewrite <- (Rmult_comm 2). unfold Rdiv in H10; exact H10. } right; unfold Rsqr, Rdiv. rewrite 4!Rinv_mult. repeat rewrite Rabs_mult. repeat rewrite Rabs_inv. replace (Rabs eps) with eps by (symmetry ; apply Rabs_right; left; assumption). replace (Rabs 8) with 8 by (symmetry ; apply Rabs_right; left; prove_sup). replace (Rabs 2) with 2 by (symmetry ; apply Rabs_right; left; prove_sup0). replace 8 with (4 * 2); [ idtac | ring ]. rewrite Rinv_mult. replace (2 * Rabs l2 * (Rabs (f1 x) * (/ Rabs (f2 x) * / Rabs (f2 x) * / Rabs (f2 x))) * (Rabs (f2 x) * Rabs (f2 x) * Rabs (f2 x) * eps * (/ 4 * / 2 * / Rabs (f1 x) * / Rabs l2))) with (eps * / 4 * (Rabs l2 * / Rabs l2) * (Rabs (f1 x) * / Rabs (f1 x)) * (Rabs (f2 x) * / Rabs (f2 x)) * (Rabs (f2 x) * / Rabs (f2 x)) * (Rabs (f2 x) * / Rabs (f2 x)) * (2 * / 2)); [ idtac | ring ]. repeat rewrite Rinv_r; try discrR || (apply Rabs_no_R0; assumption). ring. Qed. Lemma D_x_no_cond : forall x a:R, a <> 0 -> D_x no_cond x (x + a). Proof. intros. unfold D_x, no_cond. split. - trivial. - apply Rminus_not_eq. unfold Rminus. rewrite Ropp_plus_distr. rewrite <- Rplus_assoc. rewrite Rplus_opp_r. rewrite Rplus_0_l. apply Ropp_neq_0_compat; assumption. Qed. Lemma Rabs_4 : forall a b c d:R, Rabs (a + b + c + d) <= Rabs a + Rabs b + Rabs c + Rabs d. Proof. intros. apply Rle_trans with (Rabs (a + b) + Rabs (c + d)). - replace (a + b + c + d) with (a + b + (c + d)); [ apply Rabs_triang | ring ]. - apply Rle_trans with (Rabs a + Rabs b + Rabs (c + d)). + apply Rplus_le_compat_r. apply Rabs_triang. + repeat rewrite Rplus_assoc; repeat apply Rplus_le_compat_l. apply Rabs_triang. Qed. Lemma Rlt_4 : forall a b c d e f g h:R, a < b -> c < d -> e < f -> g < h -> a + c + e + g < b + d + f + h. Proof. intros. repeat apply Rplus_lt_compat;assumption. Qed. (* begin hide *) Notation Rmin_2 := Rmin_glb_lt (only parsing). (* end hide *) Lemma quadruple : forall x:R, 4 * x = x + x + x + x. Proof. intro; ring. Qed. Lemma quadruple_var : forall x:R, x = x / 4 + x / 4 + x / 4 + x / 4. Proof. intros;field. Qed. (**********) Lemma continuous_neq_0 : forall (f:R -> R) (x0:R), continuity_pt f x0 -> f x0 <> 0 -> exists eps : posreal, (forall h:R, Rabs h < eps -> f (x0 + h) <> 0). Proof. intros; unfold continuity_pt in H; unfold continue_in in H; unfold limit1_in in H; unfold limit_in in H; elim (H (Rabs (f x0 / 2))). 2:{ change (0 < Rabs (f x0 / 2)). apply Rabs_pos_lt; unfold Rdiv; apply prod_neq_R0;lra. } intros; elim H1; intros. exists (mkposreal x H2). intros; assert (H5 := H3 (x0 + h)). cut (dist R_met (x0 + h) x0 < x -> dist R_met (f (x0 + h)) (f x0) < Rabs (f x0 / 2)). 2:{ assert (H6 := Req_dec x0 (x0 + h)); elim H6; intro. - intro; rewrite <- H7. unfold R_met, dist; unfold Rdist; unfold Rminus; rewrite Rplus_opp_r; rewrite Rabs_R0; apply Rabs_pos_lt. unfold Rdiv; apply prod_neq_R0; [ assumption | apply Rinv_neq_0_compat; discrR ]. - intro; apply H5. split. + unfold D_x, no_cond. split; trivial || assumption. + assumption. } unfold dist; simpl; unfold Rdist; replace (x0 + h - x0) with h by ring. intros; assert (H7 := H6 H4). red; intro. rewrite H8 in H7; unfold Rminus in H7; rewrite Rplus_0_l in H7; rewrite Rabs_Ropp in H7; unfold Rdiv in H7; rewrite Rabs_mult in H7; pattern (Rabs (f x0)) at 1 in H7; rewrite <- Rmult_1_r in H7. assert (0 < Rabs (f x0)) by (apply (Rabs_pos_lt _ H0)). assert (H10 := Rmult_lt_reg_l _ _ _ H9 H7). assert (Rabs (/ 2) = / 2) by (apply Rabs_pos_eq;lra). assert (Hyp : 0 < 2) by prove_sup0. rewrite H11 in H10; assert (H12 := Rmult_lt_compat_l 2 _ _ Hyp H10); rewrite Rmult_1_r in H12; rewrite Rinv_r in H12; [ idtac | discrR ]. now apply lt_IZR in H12. Qed. coq-8.20.0/theories/Reals/Ranalysis3.v000066400000000000000000000701011466560755400175130ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* R) (x l1 l2:R), derivable_pt_lim f1 x l1 -> derivable_pt_lim f2 x l2 -> f2 x <> 0 -> derivable_pt_lim (f1 / f2) x ((l1 * f2 x - l2 * f1 x) / Rsqr (f2 x)). Proof. intros f1 f2 x l1 l2 H H0 H1. cut (derivable_pt f2 x); [ intro X | unfold derivable_pt; exists l2; exact H0 ]. assert (H2 := continuous_neq_0 _ _ (derivable_continuous_pt _ _ X) H1). elim H2; clear H2; intros eps_f2 H2. unfold div_fct. assert (H3 := derivable_continuous_pt _ _ X). unfold continuity_pt in H3; unfold continue_in in H3; unfold limit1_in in H3; unfold limit_in in H3; unfold dist in H3. simpl in H3; unfold Rdist in H3. elim (H3 (Rabs (f2 x) / 2)); [ idtac | unfold Rdiv; change (0 < Rabs (f2 x) * / 2); apply Rmult_lt_0_compat; [ apply Rabs_pos_lt; assumption | apply Rinv_0_lt_compat; prove_sup0 ] ]. clear H3; intros alp_f2 H3. assert (H4:forall x0:R, Rabs (x0 - x) < alp_f2 -> Rabs (f2 x0 - f2 x) < Rabs (f2 x) / 2). { intros. case (Req_dec x x0); intro. + rewrite <- H5; unfold Rminus; rewrite Rplus_opp_r; rewrite Rabs_R0; unfold Rdiv; apply Rmult_lt_0_compat; [ apply Rabs_pos_lt; assumption | apply Rinv_0_lt_compat; prove_sup0 ]. + elim H3; intros. apply H7. split. * unfold D_x, no_cond; split. -- trivial. -- assumption. * assumption. } assert (H5:forall a:R, Rabs (a - x) < alp_f2 -> Rabs (f2 x) / 2 < Rabs (f2 a)). { intros. assert (H6 := H4 a H5). rewrite <- (Rabs_Ropp (f2 a - f2 x)) in H6. rewrite Ropp_minus_distr in H6. assert (H7 := Rle_lt_trans _ _ _ (Rabs_triang_inv _ _) H6). apply Rplus_lt_reg_l with (- Rabs (f2 a) + Rabs (f2 x) / 2). rewrite Rplus_assoc. rewrite Rplus_half_diag. do 2 rewrite (Rplus_comm (- Rabs (f2 a))). rewrite Rplus_assoc; rewrite Rplus_opp_l; rewrite Rplus_0_r. unfold Rminus in H7; assumption. } assert (Maj:forall a:R, Rabs a < Rmin eps_f2 alp_f2 -> / Rabs (f2 (x + a)) < 2 / Rabs (f2 x)). { intros. unfold Rdiv. apply Rmult_lt_reg_l with (Rabs (f2 (x + a))). - apply Rabs_pos_lt; apply H2. apply Rlt_le_trans with (Rmin eps_f2 alp_f2). + assumption. + apply Rmin_l. - rewrite Rinv_r. + apply Rmult_lt_reg_l with (Rabs (f2 x)). { apply Rabs_pos_lt; assumption. } rewrite Rmult_1_r. rewrite (Rmult_comm (Rabs (f2 x))). repeat rewrite Rmult_assoc. rewrite Rinv_l. 2:{ apply Rabs_no_R0; assumption. } rewrite Rmult_1_r. apply Rmult_lt_reg_l with (/ 2). { apply Rinv_0_lt_compat; prove_sup0. } repeat rewrite (Rmult_comm (/ 2)). repeat rewrite Rmult_assoc. rewrite Rinv_r. 2:{ discrR. } rewrite Rmult_1_r. unfold Rdiv in H5; apply H5. replace (x + a - x) with a by ring. assert (H7 := Rlt_le_trans _ _ _ H6 (Rmin_r _ _)); assumption. + apply Rabs_no_R0; apply H2. assert (H7 := Rlt_le_trans _ _ _ H6 (Rmin_l _ _)); assumption. } unfold derivable_pt_lim; intros. elim (H (Rabs (eps * f2 x / 8))); [ idtac | unfold Rdiv; change (0 < Rabs (eps * f2 x * / 8)); apply Rabs_pos_lt; repeat apply prod_neq_R0; [ red; intro H7; rewrite H7 in H6; elim (Rlt_irrefl _ H6) | assumption | apply Rinv_neq_0_compat; discrR ] ]. intros alp_f1d H7. case (Req_dec (f1 x) 0); intro. 1:case (Req_dec l1 0); intro. 3:case (Req_dec l1 0); intro. 3:case (Req_dec l2 0); intro. 5:case (Req_dec l2 0); intro. (***********************************) (* First case *) (* (f1 x)=0 l1 =0 *) (***********************************) - cut (0 < Rmin eps_f2 (Rmin alp_f2 alp_f1d)); [ intro | repeat apply Rmin_pos; [ apply (cond_pos eps_f2) | elim H3; intros; assumption | apply (cond_pos alp_f1d) ] ]. exists (mkposreal (Rmin eps_f2 (Rmin alp_f2 alp_f1d)) H10). simpl; intros. assert (H13 := Rlt_le_trans _ _ _ H12 (Rmin_r _ _)). assert (H14 := Rlt_le_trans _ _ _ H12 (Rmin_l _ _)). assert (H15 := Rlt_le_trans _ _ _ H13 (Rmin_r _ _)). assert (H16 := Rlt_le_trans _ _ _ H13 (Rmin_l _ _)). assert (H17 := H7 _ H11 H15). rewrite formule; [ idtac | assumption | assumption | apply H2; apply H14 ]. apply Rle_lt_trans with (Rabs (/ f2 (x + h) * ((f1 (x + h) - f1 x) / h - l1)) + Rabs (l1 / (f2 x * f2 (x + h)) * (f2 x - f2 (x + h))) + Rabs (f1 x / (f2 x * f2 (x + h)) * ((f2 (x + h) - f2 x) / h - l2)) + Rabs (l2 * f1 x / (Rsqr (f2 x) * f2 (x + h)) * (f2 (x + h) - f2 x))). { unfold Rminus. rewrite <- (Rabs_Ropp (f1 x / (f2 x * f2 (x + h)) * ((f2 (x + h) + - f2 x) / h + - l2))). apply Rabs_4. } repeat rewrite Rabs_mult. replace eps with (eps / 4 + eps / 4 + eps / 4 + eps / 4) by field. cut (Rabs (/ f2 (x + h)) * Rabs ((f1 (x + h) - f1 x) / h - l1) < eps / 4). 2:{ rewrite <- Rabs_mult. apply (maj_term1 x h eps l1 alp_f2 eps_f2 alp_f1d f1 f2); try assumption || apply H2. - apply H14. - apply Rmin_2; assumption. } cut (Rabs (l1 / (f2 x * f2 (x + h))) * Rabs (f2 x - f2 (x + h)) < eps / 4). 2:{ rewrite H9. unfold Rdiv; repeat rewrite Rmult_0_r || rewrite Rmult_0_l. rewrite Rabs_R0; rewrite Rmult_0_l. apply Rmult_lt_0_compat; [ assumption | apply Rinv_0_lt_compat; prove_sup ]. } cut (Rabs (f1 x / (f2 x * f2 (x + h))) * Rabs ((f2 (x + h) - f2 x) / h - l2) < eps / 4). 2:{ rewrite H8. unfold Rdiv; repeat rewrite Rmult_0_r || rewrite Rmult_0_l. rewrite Rabs_R0; rewrite Rmult_0_l. apply Rmult_lt_0_compat; [ assumption | apply Rinv_0_lt_compat; prove_sup ]. } cut (Rabs (l2 * f1 x / (Rsqr (f2 x) * f2 (x + h))) * Rabs (f2 (x + h) - f2 x) < eps / 4). 2:{ rewrite H8. unfold Rdiv; repeat rewrite Rmult_0_r || rewrite Rmult_0_l. rewrite Rabs_R0; rewrite Rmult_0_l. apply Rmult_lt_0_compat; [ assumption | apply Rinv_0_lt_compat; prove_sup ]. } intros. lra. (***********************************) (* Second case *) (* (f1 x)=0 l1<>0 *) (***********************************) - assert (H10 := derivable_continuous_pt _ _ X). unfold continuity_pt in H10. unfold continue_in in H10. unfold limit1_in in H10. unfold limit_in in H10. unfold dist in H10. simpl in H10. unfold Rdist in H10. elim (H10 (Rabs (eps * Rsqr (f2 x) / (8 * l1)))). 2:{ change (0 < Rabs (eps * Rsqr (f2 x) / (8 * l1))). apply Rabs_pos_lt; unfold Rdiv, Rsqr; repeat rewrite Rmult_assoc; repeat apply prod_neq_R0. - lra. - assumption. - assumption. - apply Rinv_neq_0_compat; apply prod_neq_R0; [discrR | assumption]. } clear H10; intros alp_f2t2 H10. assert (H11:forall a:R, Rabs a < alp_f2t2 -> Rabs (f2 (x + a) - f2 x) < Rabs (eps * Rsqr (f2 x) / (8 * l1))). { intros. elim H10; intros. case (Req_dec a 0); intro. - rewrite H14; rewrite Rplus_0_r. unfold Rminus; rewrite Rplus_opp_r. rewrite Rabs_R0. apply Rabs_pos_lt. unfold Rdiv, Rsqr; repeat rewrite Rmult_assoc. repeat apply prod_neq_R0; try assumption. + now apply Rgt_not_eq. + apply Rinv_neq_0_compat; apply prod_neq_R0; [discrR | assumption]. - apply H13. split. + apply D_x_no_cond; assumption. + replace (x + a - x) with a; [ assumption | ring ]. } assert (0 < Rmin (Rmin eps_f2 alp_f1d) (Rmin alp_f2 alp_f2t2)). { repeat apply Rmin_pos. - apply (cond_pos eps_f2). - apply (cond_pos alp_f1d). - elim H3; intros; assumption. - elim H10; intros; assumption. } exists (mkposreal (Rmin (Rmin eps_f2 alp_f1d) (Rmin alp_f2 alp_f2t2)) H12). simpl. intros. assert (H15 := Rlt_le_trans _ _ _ H14 (Rmin_r _ _)). assert (H16 := Rlt_le_trans _ _ _ H14 (Rmin_l _ _)). assert (H17 := Rlt_le_trans _ _ _ H15 (Rmin_l _ _)). assert (H18 := Rlt_le_trans _ _ _ H15 (Rmin_r _ _)). assert (H19 := Rlt_le_trans _ _ _ H16 (Rmin_l _ _)). assert (H20 := Rlt_le_trans _ _ _ H16 (Rmin_r _ _)). clear H14 H15 H16. rewrite formule; try assumption. 2:{ apply H2; assumption. } apply Rle_lt_trans with (Rabs (/ f2 (x + h) * ((f1 (x + h) - f1 x) / h - l1)) + Rabs (l1 / (f2 x * f2 (x + h)) * (f2 x - f2 (x + h))) + Rabs (f1 x / (f2 x * f2 (x + h)) * ((f2 (x + h) - f2 x) / h - l2)) + Rabs (l2 * f1 x / (Rsqr (f2 x) * f2 (x + h)) * (f2 (x + h) - f2 x))). { unfold Rminus. rewrite <- (Rabs_Ropp (f1 x / (f2 x * f2 (x + h)) * ((f2 (x + h) + - f2 x) / h + - l2))). apply Rabs_4. } repeat rewrite Rabs_mult. replace eps with (eps / 4 + eps / 4 + eps / 4 + eps / 4) by field. cut (Rabs (/ f2 (x + h)) * Rabs ((f1 (x + h) - f1 x) / h - l1) < eps / 4). 2:{ rewrite <- Rabs_mult. apply (maj_term1 x h eps l1 alp_f2 eps_f2 alp_f1d f1 f2); try assumption. - apply H2; assumption. - apply Rmin_2; assumption. } cut (Rabs (l1 / (f2 x * f2 (x + h))) * Rabs (f2 x - f2 (x + h)) < eps / 4). 2:{ rewrite <- Rabs_mult. apply (maj_term2 x h eps l1 alp_f2 alp_f2t2 eps_f2 f2); try assumption. - apply H2; assumption. - apply Rmin_2; assumption. } cut (Rabs (f1 x / (f2 x * f2 (x + h))) * Rabs ((f2 (x + h) - f2 x) / h - l2) < eps / 4). 2:{ rewrite H8. unfold Rdiv; repeat rewrite Rmult_0_r || rewrite Rmult_0_l. rewrite Rabs_R0; rewrite Rmult_0_l. apply Rmult_lt_0_compat; [ assumption | apply Rinv_0_lt_compat; prove_sup ]. } cut (Rabs (l2 * f1 x / (Rsqr (f2 x) * f2 (x + h))) * Rabs (f2 (x + h) - f2 x) < eps / 4). 2:{ rewrite H8. unfold Rdiv; repeat rewrite Rmult_0_r || rewrite Rmult_0_l. rewrite Rabs_R0; rewrite Rmult_0_l. apply Rmult_lt_0_compat; [ assumption | apply Rinv_0_lt_compat; prove_sup ]. } intros. lra. (***********************************) (* Third case *) (* (f1 x)<>0 l1=0 l2=0 *) (***********************************) - elim (H0 (Rabs (Rsqr (f2 x) * eps / (8 * f1 x)))); [ idtac | apply Rabs_pos_lt; unfold Rdiv, Rsqr; repeat rewrite Rmult_assoc; repeat apply prod_neq_R0 ; [ assumption | assumption | now apply Rgt_not_eq | apply Rinv_neq_0_compat; apply prod_neq_R0; discrR || assumption ] ]. intros alp_f2d H12. assert (0 < Rmin (Rmin eps_f2 alp_f2) (Rmin alp_f1d alp_f2d)). { repeat apply Rmin_pos. - apply (cond_pos eps_f2). - elim H3; intros; assumption. - apply (cond_pos alp_f1d). - apply (cond_pos alp_f2d). } exists (mkposreal (Rmin (Rmin eps_f2 alp_f2) (Rmin alp_f1d alp_f2d)) H11). simpl. intros. assert (H15 := Rlt_le_trans _ _ _ H14 (Rmin_l _ _)). assert (H16 := Rlt_le_trans _ _ _ H14 (Rmin_r _ _)). assert (H17 := Rlt_le_trans _ _ _ H15 (Rmin_l _ _)). assert (H18 := Rlt_le_trans _ _ _ H15 (Rmin_r _ _)). assert (H19 := Rlt_le_trans _ _ _ H16 (Rmin_l _ _)). assert (H20 := Rlt_le_trans _ _ _ H16 (Rmin_r _ _)). clear H15 H16. rewrite formule; try assumption. 2:{ apply H2; assumption. } apply Rle_lt_trans with (Rabs (/ f2 (x + h) * ((f1 (x + h) - f1 x) / h - l1)) + Rabs (l1 / (f2 x * f2 (x + h)) * (f2 x - f2 (x + h))) + Rabs (f1 x / (f2 x * f2 (x + h)) * ((f2 (x + h) - f2 x) / h - l2)) + Rabs (l2 * f1 x / (Rsqr (f2 x) * f2 (x + h)) * (f2 (x + h) - f2 x))). { unfold Rminus. rewrite <- (Rabs_Ropp (f1 x / (f2 x * f2 (x + h)) * ((f2 (x + h) + - f2 x) / h + - l2))). apply Rabs_4. } repeat rewrite Rabs_mult. replace eps with (eps / 4 + eps / 4 + eps / 4 + eps / 4) by field. cut (Rabs (/ f2 (x + h)) * Rabs ((f1 (x + h) - f1 x) / h - l1) < eps / 4). 2:{ rewrite <- Rabs_mult. apply (maj_term1 x h eps l1 alp_f2 eps_f2 alp_f1d f1 f2); assumption || idtac. - apply H2; assumption. - apply Rmin_2; assumption. } cut (Rabs (l1 / (f2 x * f2 (x + h))) * Rabs (f2 x - f2 (x + h)) < eps / 4). 2:{ rewrite H9. unfold Rdiv; repeat rewrite Rmult_0_r || rewrite Rmult_0_l. rewrite Rabs_R0; rewrite Rmult_0_l. apply Rmult_lt_0_compat; [ assumption | apply Rinv_0_lt_compat; prove_sup ]. } cut (Rabs (f1 x / (f2 x * f2 (x + h))) * Rabs ((f2 (x + h) - f2 x) / h - l2) < eps / 4). 2:{ rewrite <- Rabs_mult. apply (maj_term3 x h eps l2 alp_f2 eps_f2 alp_f2d f1 f2); try assumption. - apply H2; assumption. - apply Rmin_2; assumption. } cut (Rabs (l2 * f1 x / (Rsqr (f2 x) * f2 (x + h))) * Rabs (f2 (x + h) - f2 x) < eps / 4). 2:{ rewrite H10. unfold Rdiv; repeat rewrite Rmult_0_r || rewrite Rmult_0_l. rewrite Rabs_R0; rewrite Rmult_0_l. apply Rmult_lt_0_compat; [ assumption | apply Rinv_0_lt_compat; prove_sup ]. } intros. lra. (***********************************) (* Fourth case *) (* (f1 x)<>0 l1=0 l2<>0 *) (***********************************) - elim (H0 (Rabs (Rsqr (f2 x) * eps / (8 * f1 x)))); [ idtac | apply Rabs_pos_lt; unfold Rsqr, Rdiv; repeat apply prod_neq_R0 ; [ assumption.. | now apply Rgt_not_eq | apply Rinv_neq_0_compat; apply prod_neq_R0; discrR || assumption ] ]. intros alp_f2d H11. assert (H12 := derivable_continuous_pt _ _ X). unfold continuity_pt in H12. unfold continue_in in H12. unfold limit1_in in H12. unfold limit_in in H12. unfold dist in H12. simpl in H12. unfold Rdist in H12. elim (H12 (Rabs (Rsqr (f2 x) * f2 x * eps / (8 * f1 x * l2)))). 2:{ change (0 < Rabs (Rsqr (f2 x) * f2 x * eps / (8 * f1 x * l2))). apply Rabs_pos_lt. unfold Rsqr, Rdiv. repeat rewrite Rinv_mult. repeat apply prod_neq_R0; try assumption. - lra. - apply Rinv_neq_0_compat; discrR. - apply Rinv_neq_0_compat; assumption. - apply Rinv_neq_0_compat; assumption. } intros alp_f2c H13. assert (0 < Rmin (Rmin eps_f2 alp_f2) (Rmin alp_f1d (Rmin alp_f2d alp_f2c))). { repeat apply Rmin_pos. - apply (cond_pos eps_f2). - elim H3; intros; assumption. - apply (cond_pos alp_f1d). - apply (cond_pos alp_f2d). - elim H13; intros; assumption. } exists (mkposreal (Rmin (Rmin eps_f2 alp_f2) (Rmin alp_f1d (Rmin alp_f2d alp_f2c))) H14). simpl; intros. assert (H17 := Rlt_le_trans _ _ _ H16 (Rmin_l _ _)). assert (H18 := Rlt_le_trans _ _ _ H16 (Rmin_r _ _)). assert (H19 := Rlt_le_trans _ _ _ H18 (Rmin_r _ _)). assert (H20 := Rlt_le_trans _ _ _ H19 (Rmin_l _ _)). assert (H21 := Rlt_le_trans _ _ _ H19 (Rmin_r _ _)). assert (H22 := Rlt_le_trans _ _ _ H18 (Rmin_l _ _)). assert (H23 := Rlt_le_trans _ _ _ H17 (Rmin_l _ _)). assert (H24 := Rlt_le_trans _ _ _ H17 (Rmin_r _ _)). clear H16 H17 H18 H19. assert (forall a:R, Rabs a < alp_f2c -> Rabs (f2 (x + a) - f2 x) < Rabs (Rsqr (f2 x) * f2 x * eps / (8 * f1 x * l2))). { intros. case (Req_dec a 0); intro. - rewrite H17; rewrite Rplus_0_r. unfold Rminus; rewrite Rplus_opp_r; rewrite Rabs_R0. apply Rabs_pos_lt. unfold Rdiv, Rsqr. repeat rewrite Rinv_mult. repeat apply prod_neq_R0; try assumption. + red; intro H18; rewrite H18 in H6; elim (Rlt_irrefl _ H6). + apply Rinv_neq_0_compat; discrR. + apply Rinv_neq_0_compat; assumption. + apply Rinv_neq_0_compat; assumption. - discrR. elim H13; intros. apply H19. split. + apply D_x_no_cond; assumption. + replace (x + a - x) with a; [ assumption | ring ]. } rewrite formule; try assumption. 2:{ apply H2; assumption. } apply Rle_lt_trans with (Rabs (/ f2 (x + h) * ((f1 (x + h) - f1 x) / h - l1)) + Rabs (l1 / (f2 x * f2 (x + h)) * (f2 x - f2 (x + h))) + Rabs (f1 x / (f2 x * f2 (x + h)) * ((f2 (x + h) - f2 x) / h - l2)) + Rabs (l2 * f1 x / (Rsqr (f2 x) * f2 (x + h)) * (f2 (x + h) - f2 x))). { unfold Rminus. rewrite <- (Rabs_Ropp (f1 x / (f2 x * f2 (x + h)) * ((f2 (x + h) + - f2 x) / h + - l2))). apply Rabs_4. } repeat rewrite Rabs_mult. replace eps with (eps / 4 + eps / 4 + eps / 4 + eps / 4) by field. cut (Rabs (/ f2 (x + h)) * Rabs ((f1 (x + h) - f1 x) / h - l1) < eps / 4). 2:{ rewrite <- Rabs_mult. apply (maj_term1 x h eps l1 alp_f2 eps_f2 alp_f1d f1 f2); try assumption. - apply H2; assumption. - apply Rmin_2; assumption. } cut (Rabs (l1 / (f2 x * f2 (x + h))) * Rabs (f2 x - f2 (x + h)) < eps / 4). 2:{ rewrite H9. unfold Rdiv; repeat rewrite Rmult_0_r || rewrite Rmult_0_l. rewrite Rabs_R0; rewrite Rmult_0_l. apply Rmult_lt_0_compat; [ assumption | apply Rinv_0_lt_compat; prove_sup ]. } cut (Rabs (f1 x / (f2 x * f2 (x + h))) * Rabs ((f2 (x + h) - f2 x) / h - l2) < eps / 4). 2:{ rewrite <- Rabs_mult. apply (maj_term3 x h eps l2 alp_f2 eps_f2 alp_f2d f1 f2); try assumption. - apply H2; assumption. - apply Rmin_2; assumption. } cut (Rabs (l2 * f1 x / (Rsqr (f2 x) * f2 (x + h))) * Rabs (f2 (x + h) - f2 x) < eps / 4). 2:{ rewrite <- Rabs_mult. apply (maj_term4 x h eps l2 alp_f2 alp_f2c eps_f2 f1 f2); try assumption. - apply H2; assumption. - apply Rmin_2; assumption. } intros. lra. (***********************************) (* Fifth case *) (* (f1 x)<>0 l1<>0 l2=0 *) (***********************************) - assert (H11 := derivable_continuous_pt _ _ X). unfold continuity_pt in H11. unfold continue_in in H11. unfold limit1_in in H11. unfold limit_in in H11. unfold dist in H11. simpl in H11. unfold Rdist in H11. elim (H11 (Rabs (eps * Rsqr (f2 x) / (8 * l1)))). 2:{ change (0 < Rabs (eps * Rsqr (f2 x) / (8 * l1))). apply Rabs_pos_lt. unfold Rdiv, Rsqr; rewrite Rinv_mult. repeat apply prod_neq_R0;try apply Rinv_neq_0_compat; lra. } clear H11; intros alp_f2t2 H11. elim (H0 (Rabs (Rsqr (f2 x) * eps / (8 * f1 x)))). 2:{ apply Rabs_pos_lt. unfold Rdiv, Rsqr; rewrite Rinv_mult. repeat apply prod_neq_R0; try apply Rinv_neq_0_compat; lra. } intros alp_f2d H12. assert (0 < Rmin (Rmin eps_f2 alp_f2) (Rmin alp_f1d (Rmin alp_f2d alp_f2t2))). { repeat apply Rmin_pos. - apply (cond_pos eps_f2). - elim H3; intros; assumption. - apply (cond_pos alp_f1d). - apply (cond_pos alp_f2d). - elim H11; intros; assumption. } exists (mkposreal (Rmin (Rmin eps_f2 alp_f2) (Rmin alp_f1d (Rmin alp_f2d alp_f2t2))) H13). simpl. intros. assert (forall a:R, Rabs a < alp_f2t2 -> Rabs (f2 (x + a) - f2 x) < Rabs (eps * Rsqr (f2 x) / (8 * l1))). { intros. case (Req_dec a 0); intro. - rewrite H17; rewrite Rplus_0_r; unfold Rminus; rewrite Rplus_opp_r; rewrite Rabs_R0. apply Rabs_pos_lt. unfold Rdiv; rewrite Rinv_mult. unfold Rsqr. repeat apply prod_neq_R0; try apply Rinv_neq_0_compat;lra. - elim H11; intros. apply H19. split. + apply D_x_no_cond; assumption. + replace (x + a - x) with a; [ assumption | ring ]. } assert (H17 := Rlt_le_trans _ _ _ H15 (Rmin_l _ _)). assert (H18 := Rlt_le_trans _ _ _ H15 (Rmin_r _ _)). assert (H19 := Rlt_le_trans _ _ _ H17 (Rmin_r _ _)). assert (H20 := Rlt_le_trans _ _ _ H17 (Rmin_l _ _)). assert (H21 := Rlt_le_trans _ _ _ H18 (Rmin_r _ _)). assert (H22 := Rlt_le_trans _ _ _ H18 (Rmin_l _ _)). assert (H23 := Rlt_le_trans _ _ _ H21 (Rmin_l _ _)). assert (H24 := Rlt_le_trans _ _ _ H21 (Rmin_r _ _)). clear H15 H17 H18 H21. rewrite formule; auto; try assumption. apply Rle_lt_trans with (Rabs (/ f2 (x + h) * ((f1 (x + h) - f1 x) / h - l1)) + Rabs (l1 / (f2 x * f2 (x + h)) * (f2 x - f2 (x + h))) + Rabs (f1 x / (f2 x * f2 (x + h)) * ((f2 (x + h) - f2 x) / h - l2)) + Rabs (l2 * f1 x / (Rsqr (f2 x) * f2 (x + h)) * (f2 (x + h) - f2 x))). { unfold Rminus. rewrite <- (Rabs_Ropp (f1 x / (f2 x * f2 (x + h)) * ((f2 (x + h) + - f2 x) / h + - l2))). apply Rabs_4. } repeat rewrite Rabs_mult. replace eps with (eps / 4 + eps / 4 + eps / 4 + eps / 4) by field. cut (Rabs (/ f2 (x + h)) * Rabs ((f1 (x + h) - f1 x) / h - l1) < eps / 4). 2:{ rewrite <- Rabs_mult. apply (maj_term1 x h eps l1 alp_f2 eps_f2 alp_f1d f1 f2); try assumption. - apply H2; assumption. - apply Rmin_2; assumption. } cut (Rabs (l1 / (f2 x * f2 (x + h))) * Rabs (f2 x - f2 (x + h)) < eps / 4). 2:{ rewrite <- Rabs_mult. apply (maj_term2 x h eps l1 alp_f2 alp_f2t2 eps_f2 f2); try assumption. - apply H2; assumption. - apply Rmin_2; assumption. } cut (Rabs (f1 x / (f2 x * f2 (x + h))) * Rabs ((f2 (x + h) - f2 x) / h - l2) < eps / 4). 2:{ rewrite <- Rabs_mult. apply (maj_term3 x h eps l2 alp_f2 eps_f2 alp_f2d f1 f2); try assumption. - apply H2; assumption. - apply Rmin_2; assumption. } cut (Rabs (l2 * f1 x / (Rsqr (f2 x) * f2 (x + h))) * Rabs (f2 (x + h) - f2 x) < eps / 4). 2:{ rewrite H10. unfold Rdiv; repeat rewrite Rmult_0_r || rewrite Rmult_0_l. rewrite Rabs_R0; rewrite Rmult_0_l. apply Rmult_lt_0_compat; [ assumption | apply Rinv_0_lt_compat; prove_sup ]. } intros. lra. (***********************************) (* Sixth case *) (* (f1 x)<>0 l1<>0 l2<>0 *) (***********************************) - elim (H0 (Rabs (Rsqr (f2 x) * eps / (8 * f1 x)))). 2:{ apply Rabs_pos_lt. unfold Rdiv, Rsqr; rewrite Rinv_mult. repeat apply prod_neq_R0; try apply Rinv_neq_0_compat; lra. } intros alp_f2d H11. assert (H12 := derivable_continuous_pt _ _ X). unfold continuity_pt in H12. unfold continue_in in H12. unfold limit1_in in H12. unfold limit_in in H12. unfold dist in H12. simpl in H12. unfold Rdist in H12. elim (H12 (Rabs (Rsqr (f2 x) * f2 x * eps / (8 * f1 x * l2)))). 2:{ change (0 < Rabs (Rsqr (f2 x) * f2 x * eps / (8 * f1 x * l2))); apply Rabs_pos_lt. unfold Rdiv, Rsqr; rewrite Rinv_mult. repeat apply prod_neq_R0; try apply Rinv_neq_0_compat; lra. } intros alp_f2c H13. elim (H12 (Rabs (eps * Rsqr (f2 x) / (8 * l1)))). 2:{ change (0 < Rabs (eps * Rsqr (f2 x) / (8 * l1))); apply Rabs_pos_lt. unfold Rdiv, Rsqr; rewrite Rinv_mult. repeat apply prod_neq_R0; try apply Rinv_neq_0_compat; lra. } intros alp_f2t2 H14. assert (0 < Rmin (Rmin (Rmin eps_f2 alp_f2) (Rmin alp_f1d alp_f2d)) (Rmin alp_f2c alp_f2t2)). { repeat apply Rmin_pos. - apply (cond_pos eps_f2). - elim H3; intros; assumption. - apply (cond_pos alp_f1d). - apply (cond_pos alp_f2d). - elim H13; intros; assumption. - elim H14; intros; assumption. } exists (mkposreal (Rmin (Rmin (Rmin eps_f2 alp_f2) (Rmin alp_f1d alp_f2d)) (Rmin alp_f2c alp_f2t2)) H15). simpl. intros. assert (H18 := Rlt_le_trans _ _ _ H17 (Rmin_l _ _)). assert (H19 := Rlt_le_trans _ _ _ H17 (Rmin_r _ _)). assert (H20 := Rlt_le_trans _ _ _ H18 (Rmin_l _ _)). assert (H21 := Rlt_le_trans _ _ _ H18 (Rmin_r _ _)). assert (H22 := Rlt_le_trans _ _ _ H19 (Rmin_l _ _)). assert (H23 := Rlt_le_trans _ _ _ H19 (Rmin_r _ _)). assert (H24 := Rlt_le_trans _ _ _ H20 (Rmin_l _ _)). assert (H25 := Rlt_le_trans _ _ _ H20 (Rmin_r _ _)). assert (H26 := Rlt_le_trans _ _ _ H21 (Rmin_l _ _)). assert (H27 := Rlt_le_trans _ _ _ H21 (Rmin_r _ _)). clear H17 H18 H19 H20 H21. cut (forall a:R, Rabs a < alp_f2t2 -> Rabs (f2 (x + a) - f2 x) < Rabs (eps * Rsqr (f2 x) / (8 * l1))). 2:{ intros. case (Req_dec a 0); intro. - rewrite H18; rewrite Rplus_0_r; unfold Rminus; rewrite Rplus_opp_r; rewrite Rabs_R0; apply Rabs_pos_lt. unfold Rdiv, Rsqr; rewrite Rinv_mult. repeat apply prod_neq_R0; try apply Rinv_neq_0_compat; lra. - elim H14; intros. apply H20. split. + unfold D_x, no_cond; split. * trivial. * symmetry; apply Rminus_not_eq. replace (x + a - x) with a; [ assumption | ring ]. + replace (x + a - x) with a; [ assumption | ring ]. } cut (forall a:R, Rabs a < alp_f2c -> Rabs (f2 (x + a) - f2 x) < Rabs (Rsqr (f2 x) * f2 x * eps / (8 * f1 x * l2))). 2:{ intros. case (Req_dec a 0); intro. - rewrite H18; rewrite Rplus_0_r; unfold Rminus; rewrite Rplus_opp_r; rewrite Rabs_R0; apply Rabs_pos_lt. unfold Rdiv, Rsqr; rewrite Rinv_mult. repeat apply prod_neq_R0; try apply Rinv_neq_0_compat; lra. - elim H13; intros. apply H20. split. + apply D_x_no_cond; assumption. + replace (x + a - x) with a; [ assumption | ring ]. } intros. rewrite formule; try assumption. 2:{ auto. } apply Rle_lt_trans with (Rabs (/ f2 (x + h) * ((f1 (x + h) - f1 x) / h - l1)) + Rabs (l1 / (f2 x * f2 (x + h)) * (f2 x - f2 (x + h))) + Rabs (f1 x / (f2 x * f2 (x + h)) * ((f2 (x + h) - f2 x) / h - l2)) + Rabs (l2 * f1 x / (Rsqr (f2 x) * f2 (x + h)) * (f2 (x + h) - f2 x))). { unfold Rminus. rewrite <- (Rabs_Ropp (f1 x / (f2 x * f2 (x + h)) * ((f2 (x + h) + - f2 x) / h + - l2))). apply Rabs_4. } repeat rewrite Rabs_mult. replace eps with (eps / 4 + eps / 4 + eps / 4 + eps / 4) by field. cut (Rabs (/ f2 (x + h)) * Rabs ((f1 (x + h) - f1 x) / h - l1) < eps / 4). 2:{ rewrite <- Rabs_mult. apply (maj_term1 x h eps l1 alp_f2 eps_f2 alp_f1d f1 f2); try assumption. - apply H2; assumption. - apply Rmin_2; assumption. } cut (Rabs (l1 / (f2 x * f2 (x + h))) * Rabs (f2 x - f2 (x + h)) < eps / 4). 2:{ rewrite <- Rabs_mult. apply (maj_term2 x h eps l1 alp_f2 alp_f2t2 eps_f2 f2); try assumption. - apply H2; assumption. - apply Rmin_2; assumption. } cut (Rabs (f1 x / (f2 x * f2 (x + h))) * Rabs ((f2 (x + h) - f2 x) / h - l2) < eps / 4). 2:{ rewrite <- Rabs_mult. apply (maj_term3 x h eps l2 alp_f2 eps_f2 alp_f2d f1 f2); try assumption. - apply H2; assumption. - apply Rmin_2; assumption. } cut (Rabs (l2 * f1 x / (Rsqr (f2 x) * f2 (x + h))) * Rabs (f2 (x + h) - f2 x) < eps / 4). 2:{ rewrite <- Rabs_mult. apply (maj_term4 x h eps l2 alp_f2 alp_f2c eps_f2 f1 f2); try assumption. - apply H2; assumption. - apply Rmin_2; assumption. } intros. lra. Qed. Lemma derivable_pt_div : forall (f1 f2:R -> R) (x:R), derivable_pt f1 x -> derivable_pt f2 x -> f2 x <> 0 -> derivable_pt (f1 / f2) x. Proof. unfold derivable_pt. intros f1 f2 x X X0 H. elim X; intros. elim X0; intros. exists ((x0 * f2 x - x1 * f1 x) / Rsqr (f2 x)). apply derivable_pt_lim_div; assumption. Qed. Lemma derivable_div : forall f1 f2:R -> R, derivable f1 -> derivable f2 -> (forall x:R, f2 x <> 0) -> derivable (f1 / f2). Proof. unfold derivable; intros f1 f2 X X0 H x. apply (derivable_pt_div _ _ _ (X x) (X0 x) (H x)). Qed. Lemma derive_pt_div : forall (f1 f2:R -> R) (x:R) (pr1:derivable_pt f1 x) (pr2:derivable_pt f2 x) (na:f2 x <> 0), derive_pt (f1 / f2) x (derivable_pt_div _ _ _ pr1 pr2 na) = (derive_pt f1 x pr1 * f2 x - derive_pt f2 x pr2 * f1 x) / Rsqr (f2 x). Proof. intros. assert (H := derivable_derive f1 x pr1). assert (H0 := derivable_derive f2 x pr2). assert (H1 := derivable_derive (f1 / f2)%F x (derivable_pt_div _ _ _ pr1 pr2 na)). elim H; clear H; intros l1 H. elim H0; clear H0; intros l2 H0. elim H1; clear H1; intros l H1. rewrite H; rewrite H0; apply derive_pt_eq_0. assert (H3 := proj2_sig pr1). unfold derive_pt in H; rewrite H in H3. assert (H4 := proj2_sig pr2). unfold derive_pt in H0; rewrite H0 in H4. apply derivable_pt_lim_div; assumption. Qed. coq-8.20.0/theories/Reals/Ranalysis4.v000066400000000000000000000316521466560755400175240ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* R) (x:R), f x <> 0 -> derivable_pt f x -> derivable_pt (/ f) x. Proof. intros f x H X; cut (derivable_pt (fct_cte 1 / f) x -> derivable_pt (/ f) x). - intro X0; apply X0. apply derivable_pt_div. + apply derivable_pt_const. + assumption. + assumption. - unfold div_fct, inv_fct, fct_cte; intros (x0,p); unfold derivable_pt; exists x0; unfold derivable_pt_abs; unfold derivable_pt_lim; unfold derivable_pt_abs in p; unfold derivable_pt_lim in p; intros; elim (p eps H0); intros; exists x1; intros; unfold Rdiv in H1; unfold Rdiv; rewrite <- (Rmult_1_l (/ f x)); rewrite <- (Rmult_1_l (/ f (x + h))). apply H1; assumption. Qed. (**********) Lemma pr_nu_var : forall (f g:R -> R) (x:R) (pr1:derivable_pt f x) (pr2:derivable_pt g x), f = g -> derive_pt f x pr1 = derive_pt g x pr2. Proof. unfold derivable_pt, derive_pt; intros f g x (x0,p0) (x1,p1) ->. apply uniqueness_limite with g x; assumption. Qed. (**********) Lemma pr_nu_var2 : forall (f g:R -> R) (x:R) (pr1:derivable_pt f x) (pr2:derivable_pt g x), (forall h:R, f h = g h) -> derive_pt f x pr1 = derive_pt g x pr2. Proof. unfold derivable_pt, derive_pt; intros f g x (x0,p0) (x1,p1) H. assert (H0 := uniqueness_step2 _ _ _ p0). assert (H1 := uniqueness_step2 _ _ _ p1). cut (limit1_in (fun h:R => (f (x + h) - f x) / h) (fun h:R => h <> 0) x1 0). - intro H2; assert (H3 := uniqueness_step1 _ _ _ _ H0 H2). assumption. - unfold limit1_in; unfold limit_in; unfold dist; simpl; unfold Rdist; unfold limit1_in in H1; unfold limit_in in H1; unfold dist in H1; simpl in H1; unfold Rdist in H1. intros; elim (H1 eps H2); intros. elim H3; intros. exists x2. split. + assumption. + intros; do 2 rewrite H; apply H5; assumption. Qed. (**********) Lemma derivable_inv : forall f:R -> R, (forall x:R, f x <> 0) -> derivable f -> derivable (/ f). Proof. intros f H X. unfold derivable; intro x. apply derivable_pt_inv. - apply (H x). - apply (X x). Qed. Lemma derive_pt_inv : forall (f:R -> R) (x:R) (pr:derivable_pt f x) (na:f x <> 0), derive_pt (/ f) x (derivable_pt_inv f x na pr) = - derive_pt f x pr / Rsqr (f x). Proof. intros; replace (derive_pt (/ f) x (derivable_pt_inv f x na pr)) with (derive_pt (fct_cte 1 / f) x (derivable_pt_div (fct_cte 1) f x (derivable_pt_const 1 x) pr na)). - rewrite derive_pt_div; rewrite derive_pt_const; unfold fct_cte; rewrite Rmult_0_l; rewrite Rmult_1_r; unfold Rminus; rewrite Rplus_0_l; reflexivity. - apply pr_nu_var2. intro; unfold div_fct, fct_cte, inv_fct. unfold Rdiv; ring. Qed. (** Rabsolu *) Lemma Rabs_derive_1 : forall x:R, 0 < x -> derivable_pt_lim Rabs x 1. Proof. intros. unfold derivable_pt_lim; intros. exists (mkposreal x H); intros. rewrite (Rabs_right x). - rewrite (Rabs_right (x + h)). + rewrite Rplus_comm. unfold Rminus; rewrite Rplus_assoc; rewrite Rplus_opp_r. rewrite Rplus_0_r; unfold Rdiv; rewrite Rinv_r. * rewrite Rplus_opp_r; rewrite Rabs_R0; apply H0. * apply H1. + apply Rle_ge. destruct (Rcase_abs h) as [Hlt|Hgt]. * rewrite (Rabs_left h Hlt) in H2. left; rewrite Rplus_comm; apply Rplus_lt_reg_l with (- h); rewrite Rplus_0_r; rewrite <- Rplus_assoc; rewrite Rplus_opp_l; rewrite Rplus_0_l; apply H2. * apply Rplus_le_le_0_compat. -- left; apply H. -- apply Rge_le; apply Hgt. - left; apply H. Qed. Lemma Rabs_derive_2 : forall x:R, x < 0 -> derivable_pt_lim Rabs x (-1). Proof. intros. unfold derivable_pt_lim; intros. cut (0 < - x). - intro; exists (mkposreal (- x) H1); intros. rewrite (Rabs_left x). + rewrite (Rabs_left (x + h)). * replace ((-(x + h) - - x) / h - -1) with 0 by now field. rewrite Rabs_R0; apply H0. * destruct (Rcase_abs h) as [Hlt|Hgt]. -- apply Ropp_lt_cancel. rewrite Ropp_0; rewrite Ropp_plus_distr; apply Rplus_lt_0_compat. ++ apply H1. ++ apply Ropp_0_gt_lt_contravar; apply Hlt. -- rewrite (Rabs_right h Hgt) in H3. apply Rplus_lt_reg_l with (- x); rewrite Rplus_0_r; rewrite <- Rplus_assoc; rewrite Rplus_opp_l; rewrite Rplus_0_l; apply H3. + apply H. - apply Ropp_0_gt_lt_contravar; apply H. Qed. (** Rabsolu is derivable for all x <> 0 *) Lemma Rderivable_pt_abs : forall x:R, x <> 0 -> derivable_pt Rabs x. Proof. intros. destruct (total_order_T x 0) as [[Hlt|Heq]|Hgt]. - unfold derivable_pt; exists (-1). apply (Rabs_derive_2 x Hlt). - elim H; exact Heq. - unfold derivable_pt; exists 1. apply (Rabs_derive_1 x Hgt). Qed. (** Rabsolu is continuous for all x *) Lemma Rcontinuity_abs : continuity Rabs. Proof. unfold continuity; intro. case (Req_dec x 0); intro. - unfold continuity_pt; unfold continue_in; unfold limit1_in; unfold limit_in; simpl; unfold Rdist; intros; exists eps; split. + apply H0. + intros; rewrite H; rewrite Rabs_R0; unfold Rminus; rewrite Ropp_0; rewrite Rplus_0_r; rewrite Rabs_Rabsolu; elim H1; intros; rewrite H in H3; unfold Rminus in H3; rewrite Ropp_0 in H3; rewrite Rplus_0_r in H3; apply H3. - apply derivable_continuous_pt; apply (Rderivable_pt_abs x H). Qed. (** Finite sums : Sum a_k x^k *) Lemma continuity_finite_sum : forall (An:nat -> R) (N:nat), continuity (fun y:R => sum_f_R0 (fun k:nat => An k * y ^ k) N). Proof. intros; unfold continuity; intro. induction N as [| N HrecN]. - simpl. apply continuity_pt_const. unfold constant; intros; reflexivity. - replace (fun y:R => sum_f_R0 (fun k:nat => An k * y ^ k) (S N)) with ((fun y:R => sum_f_R0 (fun k:nat => (An k * y ^ k)%R) N) + (fun y:R => (An (S N) * y ^ S N)%R))%F. + apply continuity_pt_plus. * apply HrecN. * replace (fun y:R => An (S N) * y ^ S N) with (mult_real_fct (An (S N)) (fun y:R => y ^ S N)). -- apply continuity_pt_scal. apply derivable_continuous_pt. apply derivable_pt_pow. -- reflexivity. + reflexivity. Qed. Lemma derivable_pt_lim_fs : forall (An:nat -> R) (x:R) (N:nat), (0 < N)%nat -> derivable_pt_lim (fun y:R => sum_f_R0 (fun k:nat => An k * y ^ k) N) x (sum_f_R0 (fun k:nat => INR (S k) * An (S k) * x ^ k) (pred N)). Proof. intros; induction N as [| N HrecN]. { elim (Nat.lt_irrefl _ H). } assert (N = 0%nat \/ (0 < N)%nat) by nia. elim H0; intro. { rewrite H1. simpl. change (fun y:R => An 0%nat * 1 + An 1%nat * (y * 1)) with (fct_cte (An 0%nat * 1) + mult_real_fct (An 1%nat) (id * fct_cte 1))%F. replace (1 * An 1%nat * 1) with (0 + An 1%nat * (1 * fct_cte 1 x + id x * 0)) by (unfold fct_cte, id; ring). apply derivable_pt_lim_plus. - apply derivable_pt_lim_const. - apply derivable_pt_lim_scal. apply derivable_pt_lim_mult. + apply derivable_pt_lim_id. + apply derivable_pt_lim_const. } change (fun y:R => sum_f_R0 (fun k:nat => An k * y ^ k) (S N)) with ((fun y:R => sum_f_R0 (fun k:nat => (An k * y ^ k)%R) N) + (fun y:R => (An (S N) * y ^ S N)%R))%F. replace (sum_f_R0 (fun k:nat => INR (S k) * An (S k) * x ^ k) (pred (S N))) with (sum_f_R0 (fun k:nat => INR (S k) * An (S k) * x ^ k) (pred N) + An (S N) * (INR (S (pred (S N))) * x ^ pred (S N))). 2:{ assert (pred (S N) = S (pred N)) by lia. rewrite H2. rewrite tech5. apply Rplus_eq_compat_l. rewrite <- H2. change (pred (S N)) with N. ring. } apply derivable_pt_lim_plus. { apply HrecN. assumption. } change (fun y:R => An (S N) * y ^ S N) with (mult_real_fct (An (S N)) (fun y:R => y ^ S N)). apply derivable_pt_lim_scal. apply derivable_pt_lim_pow. Qed. Lemma derivable_pt_lim_finite_sum : forall (An:nat -> R) (x:R) (N:nat), derivable_pt_lim (fun y:R => sum_f_R0 (fun k:nat => An k * y ^ k) N) x match N with | O => 0 | _ => sum_f_R0 (fun k:nat => INR (S k) * An (S k) * x ^ k) (pred N) end. Proof. intros. induction N as [| N HrecN]. - simpl. rewrite Rmult_1_r. replace (fun _:R => An 0%nat) with (fct_cte (An 0%nat)); [ apply derivable_pt_lim_const | reflexivity ]. - apply derivable_pt_lim_fs; apply Nat.lt_0_succ. Qed. Lemma derivable_pt_finite_sum : forall (An:nat -> R) (N:nat) (x:R), derivable_pt (fun y:R => sum_f_R0 (fun k:nat => An k * y ^ k) N) x. Proof. intros. unfold derivable_pt. assert (H := derivable_pt_lim_finite_sum An x N). induction N as [| N HrecN]. - exists 0; apply H. - exists (sum_f_R0 (fun k:nat => INR (S k) * An (S k) * x ^ k) (pred (S N))); apply H. Qed. Lemma derivable_finite_sum : forall (An:nat -> R) (N:nat), derivable (fun y:R => sum_f_R0 (fun k:nat => An k * y ^ k) N). Proof. intros; unfold derivable; intro; apply derivable_pt_finite_sum. Qed. (** Regularity of hyperbolic functions *) Lemma derivable_pt_lim_cosh : forall x:R, derivable_pt_lim cosh x (sinh x). Proof. intro. unfold cosh, sinh; unfold Rdiv. replace (fun x0:R => (exp x0 + exp (- x0)) * / 2) with ((exp + comp exp (- id)) * fct_cte (/ 2))%F; [ idtac | reflexivity ]. replace ((exp x - exp (- x)) * / 2) with ((exp x + exp (- x) * -1) * fct_cte (/ 2) x + (exp + comp exp (- id))%F x * 0). - apply derivable_pt_lim_mult. + apply derivable_pt_lim_plus. * apply derivable_pt_lim_exp. * apply derivable_pt_lim_comp. -- apply derivable_pt_lim_opp. apply derivable_pt_lim_id. -- apply derivable_pt_lim_exp. + apply derivable_pt_lim_const. - unfold plus_fct, mult_real_fct, comp, opp_fct, id, fct_cte; ring. Qed. Lemma derivable_pt_lim_sinh : forall x:R, derivable_pt_lim sinh x (cosh x). Proof. intro. unfold cosh, sinh; unfold Rdiv. replace (fun x0:R => (exp x0 - exp (- x0)) * / 2) with ((exp - comp exp (- id)) * fct_cte (/ 2))%F; [ idtac | reflexivity ]. replace ((exp x + exp (- x)) * / 2) with ((exp x - exp (- x) * -1) * fct_cte (/ 2) x + (exp - comp exp (- id))%F x * 0). - apply derivable_pt_lim_mult. + apply derivable_pt_lim_minus. * apply derivable_pt_lim_exp. * apply derivable_pt_lim_comp. -- apply derivable_pt_lim_opp. apply derivable_pt_lim_id. -- apply derivable_pt_lim_exp. + apply derivable_pt_lim_const. - unfold plus_fct, mult_real_fct, comp, opp_fct, id, fct_cte; ring. Qed. Lemma derivable_pt_exp : forall x:R, derivable_pt exp x. Proof. intro. unfold derivable_pt. exists (exp x). apply derivable_pt_lim_exp. Qed. Lemma derivable_pt_cosh : forall x:R, derivable_pt cosh x. Proof. intro. unfold derivable_pt. exists (sinh x). apply derivable_pt_lim_cosh. Qed. Lemma derivable_pt_sinh : forall x:R, derivable_pt sinh x. Proof. intro. unfold derivable_pt. exists (cosh x). apply derivable_pt_lim_sinh. Qed. Lemma derivable_exp : derivable exp. Proof. unfold derivable; apply derivable_pt_exp. Qed. Lemma derivable_cosh : derivable cosh. Proof. unfold derivable; apply derivable_pt_cosh. Qed. Lemma derivable_sinh : derivable sinh. Proof. unfold derivable; apply derivable_pt_sinh. Qed. Lemma derive_pt_exp : forall x:R, derive_pt exp x (derivable_pt_exp x) = exp x. Proof. intro; apply derive_pt_eq_0. apply derivable_pt_lim_exp. Qed. Lemma derive_pt_cosh : forall x:R, derive_pt cosh x (derivable_pt_cosh x) = sinh x. Proof. intro; apply derive_pt_eq_0. apply derivable_pt_lim_cosh. Qed. Lemma derive_pt_sinh : forall x:R, derive_pt sinh x (derivable_pt_sinh x) = cosh x. Proof. intro; apply derive_pt_eq_0. apply derivable_pt_lim_sinh. Qed. Lemma sinh_lt : forall x y, x < y -> sinh x < sinh y. intros x y xy; destruct (MVT_cor2 sinh cosh x y xy) as [c [Pc _]]. - intros; apply derivable_pt_lim_sinh. - apply Rplus_lt_reg_l with (Ropp (sinh x)); rewrite Rplus_opp_l, Rplus_comm. unfold Rminus at 1 in Pc; rewrite Pc; apply Rmult_lt_0_compat;[ | ]. + unfold cosh; apply Rmult_lt_0_compat;[|apply Rinv_0_lt_compat, Rlt_0_2]. now apply Rplus_lt_0_compat; apply exp_pos. + now apply Rlt_0_minus; assumption. Qed. coq-8.20.0/theories/Reals/Ranalysis5.v000066400000000000000000001672001466560755400175240ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* R, forall lb ub, lb < ub -> (forall x y, lb <= x -> x < y -> y <= ub -> f x < f y) -> (forall x, f lb <= x -> x <= f ub -> (comp f g) x = id x) -> (forall x , f lb <= x -> x <= f ub -> lb <= g x <= ub) -> (forall x y, f lb <= x -> x < y -> y <= f ub -> g x < g y). Proof. intros f g lb ub lb_lt_ub f_incr f_eq_g g_ok x y lb_le_x x_lt_y y_le_ub. assert (x_encad : f lb <= x <= f ub) by lra. assert (y_encad : f lb <= y <= f ub) by lra. assert (gx_encad := g_ok _ (proj1 x_encad) (proj2 x_encad)). assert (gy_encad := g_ok _ (proj1 y_encad) (proj2 y_encad)). case (Rlt_dec (g x) (g y)); [ easy |]. intros Hfalse. assert (Temp := Rnot_lt_le _ _ Hfalse). enough (y <= x) by lra. replace y with (id y) by easy. replace x with (id x) by easy. rewrite <- f_eq_g by easy. rewrite <- f_eq_g by easy. assert (f_incr2 : forall x y, lb <= x -> x <= y -> y < ub -> f x <= f y). { intros m n lb_le_m m_le_n n_lt_ub. case (m_le_n). - intros; apply Rlt_le, f_incr, Rlt_le; assumption. - intros Hyp; rewrite Hyp; apply Req_le; reflexivity. } apply f_incr2; intuition. enough (g x <> ub) by lra. intro Hf. assert (Htemp : (comp f g) x = f ub). { unfold comp; rewrite Hf; reflexivity. } rewrite f_eq_g in Htemp by easy. unfold id in Htemp. lra. Qed. Lemma derivable_pt_id_interv : forall (lb ub x:R), lb <= x <= ub -> derivable_pt id x. Proof. intros. reg. Qed. Lemma pr_nu_var2_interv : forall (f g : R -> R) (lb ub x : R) (pr1 : derivable_pt f x) (pr2 : derivable_pt g x), lb < ub -> lb < x < ub -> (forall h : R, lb < h < ub -> f h = g h) -> derive_pt f x pr1 = derive_pt g x pr2. Proof. intros f g lb ub x Prf Prg lb_lt_ub x_encad local_eq. assert (forall x l, lb < x < ub -> (derivable_pt_abs f x l <-> derivable_pt_abs g x l)). { intros a l a_encad. unfold derivable_pt_abs, derivable_pt_lim. split. { intros Hyp eps eps_pos. elim (Hyp eps eps_pos) ; intros delta Hyp2. assert (Pos_cond : Rmin delta (Rmin (ub - a) (a - lb)) > 0). { clear-a lb ub a_encad delta. apply Rmin_pos ; [exact ((cond_pos delta)) | apply Rmin_pos ] ; apply Rlt_0_minus ; intuition. } exists (mkposreal (Rmin delta (Rmin (ub - a) (a - lb))) Pos_cond). intros h h_neq h_encad. replace (g (a + h) - g a) with (f (a + h) - f a). { apply Hyp2 ; intuition. apply Rlt_le_trans with (r2:=Rmin delta (Rmin (ub - a) (a - lb))). { assumption. } apply Rmin_l. } assert (local_eq2 : forall h : R, lb < h < ub -> - f h = - g h). { intros ; apply Ropp_eq_compat ; intuition. } rewrite local_eq ; unfold Rminus. { rewrite local_eq2. { reflexivity. } assumption. } assert (Sublemma2 : forall x y, Rabs x < Rabs y -> y > 0 -> x < y). { intros m n Hyp_abs y_pos. apply Rlt_le_trans with (r2:=Rabs n). { apply Rle_lt_trans with (r2:=Rabs m) ; [ | assumption] ; apply RRle_abs. } apply Req_le ; apply Rabs_right ; apply Rgt_ge ; assumption. } split. { assert (Sublemma : forall x y z, -z < y - x -> x < y + z). { intros ; lra. } apply Sublemma. apply Sublemma2. { rewrite Rabs_Ropp. apply Rlt_le_trans with (r2:=a-lb) ; [| apply RRle_abs] ; apply Rlt_le_trans with (r2:=Rmin (ub - a) (a - lb)) ; [| apply Rmin_r] ; apply Rlt_le_trans with (r2:=Rmin delta (Rmin (ub - a) (a - lb))) ; [| apply Rmin_r] ; assumption. } apply Rlt_le_trans with (r2:=Rmin (ub - a) (a - lb)) ; [| apply Rmin_r] ; apply Rlt_le_trans with (r2:=Rmin delta (Rmin (ub - a) (a - lb))) ; [| apply Rmin_r] ; assumption. } assert (Sublemma : forall x y z, y < z - x -> x + y < z). { intros ; lra. } apply Sublemma. apply Sublemma2. { apply Rlt_le_trans with (r2:=ub-a) ; [| apply RRle_abs] ; apply Rlt_le_trans with (r2:=Rmin (ub - a) (a - lb)) ; [| apply Rmin_l] ; apply Rlt_le_trans with (r2:=Rmin delta (Rmin (ub - a) (a - lb))) ; [| apply Rmin_r] ; assumption. } apply Rlt_le_trans with (r2:=Rmin (ub - a) (a - lb)) ; [| apply Rmin_l] ; apply Rlt_le_trans with (r2:=Rmin delta (Rmin (ub - a) (a - lb))) ; [| apply Rmin_r] ; assumption. } intros Hyp eps eps_pos. elim (Hyp eps eps_pos) ; intros delta Hyp2. assert (Pos_cond : Rmin delta (Rmin (ub - a) (a - lb)) > 0). { clear-a lb ub a_encad delta. apply Rmin_pos ; [exact ((cond_pos delta)) | apply Rmin_pos ] ; apply Rlt_0_minus ; intuition. } exists (mkposreal (Rmin delta (Rmin (ub - a) (a - lb))) Pos_cond). intros h h_neq h_encad. replace (f (a + h) - f a) with (g (a + h) - g a). { apply Hyp2 ; intuition. apply Rlt_le_trans with (r2:=Rmin delta (Rmin (ub - a) (a - lb))). { assumption. } apply Rmin_l. } assert (local_eq2 : forall h : R, lb < h < ub -> - f h = - g h). { intros ; apply Ropp_eq_compat ; intuition. } rewrite local_eq ; unfold Rminus. { rewrite local_eq2. { reflexivity. } assumption. } assert (Sublemma2 : forall x y, Rabs x < Rabs y -> y > 0 -> x < y). { intros m n Hyp_abs y_pos. apply Rlt_le_trans with (r2:=Rabs n). { apply Rle_lt_trans with (r2:=Rabs m) ; [ | assumption] ; apply RRle_abs. } apply Req_le ; apply Rabs_right ; apply Rgt_ge ; assumption. } split. { assert (Sublemma : forall x y z, -z < y - x -> x < y + z). { intros ; lra. } apply Sublemma. apply Sublemma2. { rewrite Rabs_Ropp. apply Rlt_le_trans with (r2:=a-lb) ; [| apply RRle_abs] ; apply Rlt_le_trans with (r2:=Rmin (ub - a) (a - lb)) ; [| apply Rmin_r] ; apply Rlt_le_trans with (r2:=Rmin delta (Rmin (ub - a) (a - lb))) ; [| apply Rmin_r] ; assumption. } apply Rlt_le_trans with (r2:=Rmin (ub - a) (a - lb)) ; [| apply Rmin_r] ; apply Rlt_le_trans with (r2:=Rmin delta (Rmin (ub - a) (a - lb))) ; [| apply Rmin_r] ; assumption. } assert (Sublemma : forall x y z, y < z - x -> x + y < z). { intros ; lra. } apply Sublemma. apply Sublemma2. { apply Rlt_le_trans with (r2:=ub-a) ; [| apply RRle_abs] ; apply Rlt_le_trans with (r2:=Rmin (ub - a) (a - lb)) ; [| apply Rmin_l] ; apply Rlt_le_trans with (r2:=Rmin delta (Rmin (ub - a) (a - lb))) ; [| apply Rmin_r] ; assumption. } apply Rlt_le_trans with (r2:=Rmin (ub - a) (a - lb)) ; [| apply Rmin_l] ; apply Rlt_le_trans with (r2:=Rmin delta (Rmin (ub - a) (a - lb))) ; [| apply Rmin_r] ; assumption. } unfold derivable_pt in Prf. unfold derivable_pt in Prg. elim Prf; intros x0 p. elim Prg; intros x1 p0. assert (Temp := p); rewrite H in Temp. { unfold derivable_pt_abs in p. unfold derivable_pt_abs in p0. simpl in |- *. apply (uniqueness_limite g x x0 x1 Temp p0). } assumption. Qed. (* begin hide *) Lemma leftinv_is_rightinv : forall (f g:R->R), (forall x y, x < y -> f x < f y) -> (forall x, (comp f g) x = id x) -> (forall x, (comp g f) x = id x). Proof. intros f g f_incr Hyp x. assert(f_inj : forall x y, f x = f y -> x = y). { intros a b fa_eq_fb. pose proof (f_incr a b);pose proof (f_incr b a);lra. } apply f_inj,Hyp. Qed. (* end hide *) Lemma leftinv_is_rightinv_interv : forall (f g:R->R) (lb ub:R), (forall x y, lb <= x -> x < y -> y <= ub -> f x < f y) -> (forall y, f lb <= y -> y <= f ub -> (comp f g) y = id y) -> (forall x, f lb <= x -> x <= f ub -> lb <= g x <= ub) -> forall x, lb <= x <= ub -> (comp g f) x = id x. Proof. intros f g lb ub f_incr_interv Hyp g_wf x x_encad. assert(f_inj : forall x y, lb <= x <= ub -> lb <= y <= ub -> f x = f y -> x = y). { intros a b a_encad b_encad fa_eq_fb. case(total_order_T a b). { intro s ; case s ; clear s. { intro Hf. assert (Hfalse := f_incr_interv a b (proj1 a_encad) Hf (proj2 b_encad)). apply False_ind. apply (Rlt_not_eq (f a) (f b)) ; assumption. } intuition. } intro Hf. assert (Hfalse := f_incr_interv b a (proj1 b_encad) Hf (proj2 a_encad)). apply False_ind. apply (Rlt_not_eq (f b) (f a)) ; [|symmetry] ; assumption. } assert (f_incr_interv2 : forall x y, lb <= x -> x <= y -> y <= ub -> f x <= f y). { intros m n cond1 cond2 cond3. case cond2. { intro cond. apply Rlt_le ; apply f_incr_interv ; assumption. } intro cond ; right ; rewrite cond ; reflexivity. } assert (Hyp2:forall x, lb <= x <= ub -> f (g (f x)) = f x). { intros ; apply Hyp. { apply f_incr_interv2 ; intuition. } apply f_incr_interv2 ; intuition. } unfold comp ; unfold comp in Hyp. apply f_inj. { apply g_wf ; apply f_incr_interv2 ; intuition. } { unfold id ; assumption. } apply Hyp2 ; unfold id ; assumption. Qed. (** Intermediate Value Theorem on an Interval (Proof mainly taken from Reals.Rsqrt_def) and its corollary *) Lemma IVT_interv_prelim0 : forall (x y:R) (P:R->bool) (N:nat), x < y -> x <= Dichotomy_ub x y P N <= y /\ x <= Dichotomy_lb x y P N <= y. Proof. assert (Sublemma : forall x y lb ub, lb <= x <= ub /\ lb <= y <= ub -> lb <= (x+y) / 2 <= ub) by (intros;lra). intros x y P N x_lt_y. induction N. { simpl ; intuition. } simpl. case (P ((Dichotomy_lb x y P N + Dichotomy_ub x y P N) / 2)). { split. { apply Sublemma ; intuition. } intuition. } split. { intuition. } apply Sublemma ; intuition. Qed. Lemma IVT_interv_prelim1 : forall (x y x0:R) (D : R -> bool), x < y -> Un_cv (dicho_up x y D) x0 -> x <= x0 <= y. Proof. intros x y x0 D x_lt_y bnd. assert (Main : forall n, x <= dicho_up x y D n <= y). { intro n. unfold dicho_up. apply (proj1 (IVT_interv_prelim0 x y D n x_lt_y)). } split. - apply Rle_cv_lim with (Vn:=dicho_up x y D) (Un:=fun n => x). + intro n ; exact (proj1 (Main n)). + unfold Un_cv ; intros ; exists 0%nat ; intros ; unfold Rdist ; replace (x -x) with 0 by field ; rewrite Rabs_R0 ; assumption. + assumption. - apply Rle_cv_lim with (Un:=dicho_up x y D) (Vn:=fun n => y). + intro n ; exact (proj2 (Main n)). + assumption. + unfold Un_cv ; intros ; exists 0%nat ; intros ; unfold Rdist ; replace (y -y) with 0 by field ; rewrite Rabs_R0 ; assumption. Qed. Lemma IVT_interv : forall (f : R -> R) (x y : R), (forall a, x <= a <= y -> continuity_pt f a) -> x < y -> f x < 0 -> 0 < f y -> {z : R | x <= z <= y /\ f z = 0}. Proof. intros. (* f x y f_cont_interv x_lt_y fx_neg fy_pos.*) assert (x <= y) by (left;assumption). generalize (dicho_lb_cv x y (fun z:R => cond_positivity (f z)) H3). generalize (dicho_up_cv x y (fun z:R => cond_positivity (f z)) H3). intros X X0. elim X; intros x0 p. elim X0; intros x1 p0. assert (H4 := cv_dicho _ _ _ _ _ H3 p0 p). rewrite H4 in p0. exists x0. split. 1:split. { apply Rle_trans with (dicho_lb x y (fun z:R => cond_positivity (f z)) 0). { simpl in |- *. right; reflexivity. } apply growing_ineq. { apply dicho_lb_growing; assumption. } assumption. } { apply Rle_trans with (dicho_up x y (fun z:R => cond_positivity (f z)) 0). { apply decreasing_ineq. { apply dicho_up_decreasing; assumption. } assumption. } right; reflexivity. } set (Vn := fun n:nat => dicho_lb x y (fun z:R => cond_positivity (f z)) n). set (Wn := fun n:nat => dicho_up x y (fun z:R => cond_positivity (f z)) n). cut ((forall n:nat, f (Vn n) <= 0) -> f x0 <= 0). { cut ((forall n:nat, 0 <= f (Wn n)) -> 0 <= f x0). { intros. cut (forall n:nat, f (Vn n) <= 0). { cut (forall n:nat, 0 <= f (Wn n)). { intros. assert (H9 := H6 H8). assert (H10 := H5 H7). apply Rle_antisym; assumption. } intro. unfold Wn in |- *. cut (forall z:R, cond_positivity z = true <-> 0 <= z). { intro. assert (H8 := dicho_up_car x y (fun z:R => cond_positivity (f z)) n). elim (H7 (f (dicho_up x y (fun z:R => cond_positivity (f z)) n))); intros. apply H9. apply H8. elim (H7 (f y)); intros. apply H12. left; assumption. } intro. unfold cond_positivity in |- *. destruct (Rle_dec 0 z) as [|Hnotle]. { split. { intro; assumption. } intro; reflexivity. } split. { intro feqt;discriminate feqt. } intro. elim Hnotle; assumption. } unfold Vn in |- *. cut (forall z:R, cond_positivity z = false <-> z < 0). { intros. assert (H8 := dicho_lb_car x y (fun z:R => cond_positivity (f z)) n). left. elim (H7 (f (dicho_lb x y (fun z:R => cond_positivity (f z)) n))); intros. apply H9. apply H8. elim (H7 (f x)); intros. apply H12. assumption. } intro. unfold cond_positivity in |- *. destruct (Rle_dec 0 z) as [Hle|]. { split. { intro feqt; discriminate feqt. } intro; elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ Hle H7)). } split. { intro; auto with real. } intro; reflexivity. } cut (Un_cv Wn x0). { intros. assert (Temp : x <= x0 <= y). { apply IVT_interv_prelim1 with (D:=(fun z : R => cond_positivity (f z))) ; assumption. } assert (H7 := continuity_seq f Wn x0 (H x0 Temp) H5). destruct (total_order_T 0 (f x0)) as [[Hlt|<-]|Hgt]. - left; assumption. - right; reflexivity. - unfold Un_cv in H7; unfold Rdist in H7. cut (0 < - f x0). { intro. elim (H7 (- f x0) H8); intros. cut (x2 >= x2)%nat; [ intro | unfold ge in |- *; apply le_n ]. assert (H11 := H9 x2 H10). rewrite Rabs_right in H11. { pattern (- f x0) at 1 in H11; rewrite <- Rplus_0_r in H11. unfold Rminus in H11; rewrite (Rplus_comm (f (Wn x2))) in H11. assert (H12 := Rplus_lt_reg_l _ _ _ H11). assert (H13 := H6 x2). elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H13 H12)). } apply Rle_ge; left; unfold Rminus in |- *; apply Rplus_le_lt_0_compat. { apply H6. } exact H8. } apply Ropp_0_gt_lt_contravar; assumption. } unfold Wn in |- *; assumption. } assert (Un_cv Vn x0) by (unfold Vn; assumption). intros. assert (Temp : x <= x0 <= y). { apply IVT_interv_prelim1 with (D:=(fun z : R => cond_positivity (f z))) ; assumption. } assert (H7 := continuity_seq f Vn x0 (H x0 Temp) H5). destruct (total_order_T 0 (f x0)) as [[Hlt|Heq]|]. - unfold Un_cv in H7; unfold Rdist in H7. elim (H7 (f x0) Hlt); intros. cut (x2 >= x2)%nat; [ intro | unfold ge; apply le_n ]. assert (H10 := H8 x2 H9). rewrite Rabs_left in H10. { pattern (f x0) at 2 in H10; rewrite <- Rplus_0_r in H10. rewrite Ropp_minus_distr in H10. unfold Rminus in H10. assert (H11 := Rplus_lt_reg_l _ _ _ H10). assert (H12 := H6 x2). cut (0 < f (Vn x2)). { intro. elim (Rlt_irrefl _ (Rlt_le_trans _ _ _ H13 H12)). } rewrite <- (Ropp_involutive (f (Vn x2))). apply Ropp_0_gt_lt_contravar; assumption. } apply Rplus_lt_reg_l with (f x0 - f (Vn x2)). rewrite Rplus_0_r; replace (f x0 - f (Vn x2) + (f (Vn x2) - f x0)) with 0; [ unfold Rminus in |- *; apply Rplus_lt_le_0_compat | ring ]. { assumption. } apply Ropp_0_ge_le_contravar; apply Rle_ge; apply H6. - right; rewrite <- Heq; reflexivity. - left; assumption. Qed. (* begin hide *) Ltac case_le H := let t := type of H in let h' := fresh in match t with ?x <= ?y => case (total_order_T x y); [intros h'; case h'; clear h' | intros h'; clear -H h'; exfalso; lra ] end. (* end hide *) Lemma f_interv_is_interv : forall (f:R->R) (lb ub y:R), lb < ub -> f lb <= y <= f ub -> (forall x, lb <= x <= ub -> continuity_pt f x) -> {x | lb <= x <= ub /\ f x = y}. Proof. intros f lb ub y lb_lt_ub y_encad f_cont_interv. case y_encad ; intro y_encad1. case_le y_encad1 ; intros y_encad2 y_encad3 ; case_le y_encad3. - intro y_encad4. clear y_encad y_encad1 y_encad3. assert (Cont : forall a : R, lb <= a <= ub -> continuity_pt (fun x => f x - y) a). { intros a a_encad. unfold continuity_pt, continue_in, limit1_in, limit_in ; simpl ; unfold Rdist. intros eps eps_pos. elim (f_cont_interv a a_encad eps eps_pos). intros alpha alpha_pos. destruct alpha_pos as (alpha_pos,Temp). exists alpha. split. { assumption. } intros x x_cond. replace (f x - y - (f a - y)) with (f x - f a) by field. exact (Temp x x_cond). } assert (H1 : (fun x : R => f x - y) lb < 0). { apply Rlt_minus. assumption. } assert (H2 : 0 < (fun x : R => f x - y) ub). { apply Rgt_minus ; assumption. } destruct (IVT_interv (fun x => f x - y) lb ub Cont lb_lt_ub H1 H2) as (x,Hx). exists x. destruct Hx as (Hyp,Result). intuition. - intro H ; exists ub ; intuition. - intro H ; exists lb ; intuition. - intro H ; exists ub ; intuition. Qed. (** ** The derivative of a reciprocal function *) (** * Continuity of the reciprocal function *) Lemma continuity_pt_recip_prelim : forall (f g:R->R) (lb ub : R) (Pr1:lb < ub), (forall x y, lb <= x -> x < y -> y <= ub -> f x < f y) -> (forall x, lb <= x <= ub -> (comp g f) x = id x) -> (forall a, lb <= a <= ub -> continuity_pt f a) -> forall b, f lb < b < f ub -> continuity_pt g b. Proof. assert (Sublemma : forall x y z, Rmax x y < z <-> x < z /\ y < z). { intros x y z. split. { unfold Rmax. case (Rle_dec x y) ; intros Hyp Hyp2. { split. { apply Rle_lt_trans with (r2:=y) ; assumption. } assumption. } split. { assumption. } apply Rlt_trans with (r2:=x). { assert (Temp : forall x y, ~ x <= y -> x > y). { intros m n Hypmn. intuition. } apply Temp ; clear Temp ; assumption. } assumption. } intros Hyp. unfold Rmax. case (Rle_dec x y). { intro ; exact (proj2 Hyp). } intro ; exact (proj1 Hyp). } assert (Sublemma2 : forall x y z, Rmin x y > z <-> x > z /\ y > z). { intros x y z. split. { unfold Rmin. case (Rle_dec x y) ; intros Hyp Hyp2. { split. { assumption. } apply Rlt_le_trans with (r2:=x) ; intuition. } split. { apply Rlt_trans with (r2:=y). { intuition. } assert (Temp : forall x y, ~ x <= y -> x > y). { intros m n Hypmn. intuition. } apply Temp ; clear Temp ; assumption. } assumption. } intros Hyp. unfold Rmin. case (Rle_dec x y). { intro ; exact (proj1 Hyp). } intro ; exact (proj2 Hyp). } assert (Sublemma3 : forall x y, x <= y /\ x <> y -> x < y). { intros m n Hyp. unfold Rle in Hyp. destruct Hyp as (Hyp1,Hyp2). case Hyp1. { intuition. } intro Hfalse ; apply False_ind ; apply Hyp2 ; exact Hfalse. } intros f g lb ub lb_lt_ub f_incr_interv f_eq_g f_cont_interv b b_encad. assert (f_incr_interv2 : forall x y, lb <= x -> x <= y -> y <= ub -> f x <= f y). { intros m n cond1 cond2 cond3. case cond2. { intro cond. apply Rlt_le ; apply f_incr_interv ; assumption. } intro cond ; right ; rewrite cond ; reflexivity. } unfold continuity_pt, continue_in, limit1_in, limit_in ; intros eps eps_pos. unfold dist ; simpl ; unfold Rdist. assert (b_encad_e : f lb <= b <= f ub) by intuition. elim (f_interv_is_interv f lb ub b lb_lt_ub b_encad_e f_cont_interv) ; intros x Temp. destruct Temp as (x_encad,f_x_b). assert (lb_lt_x : lb < x). { assert (Temp : x <> lb). { intro Hfalse. assert (Temp' : b = f lb). { rewrite <- f_x_b ; rewrite Hfalse ; reflexivity. } assert (Temp'' : b <> f lb). { apply Rgt_not_eq ; exact (proj1 b_encad). } apply Temp'' ; exact Temp'. } apply Sublemma3. split. { exact (proj1 x_encad). } assert (Temp2 : forall x y:R, x <> y <-> y <> x). { intros m n. split ; intuition. } rewrite Temp2 ; assumption. } assert (x_lt_ub : x < ub). { assert (Temp : x <> ub). { intro Hfalse. assert (Temp' : b = f ub). { rewrite <- f_x_b ; rewrite Hfalse ; reflexivity. } assert (Temp'' : b <> f ub). { apply Rlt_not_eq ; exact (proj2 b_encad). } apply Temp'' ; exact Temp'. } apply Sublemma3. split ; [exact (proj2 x_encad) | assumption]. } pose (x1 := Rmax (x - eps) lb). pose (x2 := Rmin (x + eps) ub). assert (Hx1 : x1 = Rmax (x - eps) lb) by intuition. assert (Hx2 : x2 = Rmin (x + eps) ub) by intuition. assert (x1_encad : lb <= x1 <= ub). { split. { apply RmaxLess2. } apply Rlt_le. rewrite Hx1. rewrite Sublemma. split. { apply Rlt_trans with (r2:=x) ; lra. } assumption. } assert (x2_encad : lb <= x2 <= ub). { split. { apply Rlt_le ; rewrite Hx2 ; apply Rgt_lt ; rewrite Sublemma2. split. { apply Rgt_trans with (r2:=x) ; lra. } assumption. } apply Rmin_r. } assert (x_lt_x2 : x < x2). { rewrite Hx2. apply Rgt_lt. rewrite Sublemma2. split ; lra. } assert (x1_lt_x : x1 < x). { rewrite Hx1. rewrite Sublemma. split ; lra. } exists (Rmin (f x - f x1) (f x2 - f x)). split. { apply Rmin_pos ; apply Rgt_minus. { apply f_incr_interv ; [apply RmaxLess2 | | ] ; lra. } apply f_incr_interv ; intuition. } intros y Temp. destruct Temp as (_,y_cond). rewrite <- f_x_b in y_cond. assert (Temp : forall x y d1 d2, d1 > 0 -> d2 > 0 -> Rabs (y - x) < Rmin d1 d2 -> x - d1 <= y <= x + d2). { intros. split. { assert (H10 : forall x y z, x - y <= z -> x - z <= y). { intuition. lra. } apply H10. apply Rle_trans with (r2:=Rabs (y0 - x0)). { replace (Rabs (y0 - x0)) with (Rabs (x0 - y0)). { apply RRle_abs. } rewrite <- Rabs_Ropp. unfold Rminus ; rewrite Ropp_plus_distr. rewrite Ropp_involutive. intuition. } apply Rle_trans with (r2:= Rmin d1 d2). { apply Rlt_le ; assumption. } apply Rmin_l. } assert (H10 : forall x y z, x - y <= z -> x <= y + z). { intuition. lra. } apply H10. apply Rle_trans with (r2:=Rabs (y0 - x0)). { apply RRle_abs. } apply Rle_trans with (r2:= Rmin d1 d2). { apply Rlt_le ; assumption. } apply Rmin_r. } assert (Temp' := Temp (f x) y (f x - f x1) (f x2 - f x)). replace (f x - (f x - f x1)) with (f x1) in Temp' by field. replace (f x + (f x2 - f x)) with (f x2) in Temp' by field. assert (T : f x - f x1 > 0). { apply Rgt_minus. apply f_incr_interv ; intuition. } assert (T' : f x2 - f x > 0). { apply Rgt_minus. apply f_incr_interv ; intuition. } assert (Main := Temp' T T' y_cond). clear Temp Temp' T T'. assert (x1_lt_x2 : x1 < x2). { apply Rlt_trans with (r2:=x) ; assumption. } assert (f_cont_myinterv : forall a : R, x1 <= a <= x2 -> continuity_pt f a). { intros ; apply f_cont_interv ; split. { apply Rle_trans with (r2 := x1) ; intuition. } apply Rle_trans with (r2 := x2) ; intuition. } elim (f_interv_is_interv f x1 x2 y x1_lt_x2 Main f_cont_myinterv) ; intros x' Temp. destruct Temp as (x'_encad,f_x'_y). rewrite <- f_x_b ; rewrite <- f_x'_y. unfold comp in f_eq_g. rewrite f_eq_g. 2:{ split. { apply Rle_trans with (r2:=x1) ; intuition. } apply Rle_trans with (r2:=x2) ; intuition. } rewrite f_eq_g. 2:assumption. unfold id. assert (x'_encad2 : x - eps <= x' <= x + eps). { split. { apply Rle_trans with (r2:=x1) ; [ apply RmaxLess1|] ; intuition. } apply Rle_trans with (r2:=x2) ; [ | apply Rmin_l] ; intuition. } assert (x1_lt_x' : x1 < x'). { apply Sublemma3. assert (x1_neq_x' : x1 <> x'). { intro Hfalse. rewrite Hfalse, f_x'_y in y_cond. assert (Hf : Rabs (y - f x) < f x - y). { apply Rlt_le_trans with (r2:=Rmin (f x - y) (f x2 - f x)). { lra. } apply Rmin_l. } assert(Hfin : f x - y < f x - y). { apply Rle_lt_trans with (r2:=Rabs (y - f x)). { replace (Rabs (y - f x)) with (Rabs (f x - y)). { apply RRle_abs. } rewrite <- Rabs_Ropp. replace (- (f x - y)) with (y - f x) by field ; reflexivity. } lra. } apply (Rlt_irrefl (f x - y)) ; assumption. } split ; intuition. } assert (x'_lb : x - eps < x'). { apply Sublemma3. split. { intuition. } apply Rlt_not_eq. apply Rle_lt_trans with (r2:=x1) ; [ apply RmaxLess1|] ; intuition. } assert (x'_lt_x2 : x' < x2). { apply Sublemma3. assert (x1_neq_x' : x' <> x2). { intro Hfalse. rewrite <- Hfalse, f_x'_y in y_cond. assert (Hf : Rabs (y - f x) < y - f x). { apply Rlt_le_trans with (r2:=Rmin (f x - f x1) (y - f x)). { lra. } apply Rmin_r. } assert(Hfin : y - f x < y - f x). { apply Rle_lt_trans with (r2:=Rabs (y - f x)). { apply RRle_abs. } lra. } apply (Rlt_irrefl (y - f x)) ; assumption. } split ; intuition. } assert (x'_ub : x' < x + eps). { apply Sublemma3. split. { intuition. } apply Rlt_not_eq. apply Rlt_le_trans with (r2:=x2) ; [ |rewrite Hx2 ; apply Rmin_l] ; intuition. } apply Rabs_def1 ; lra. Qed. Lemma continuity_pt_recip_interv : forall (f g:R->R) (lb ub : R) (Pr1:lb < ub), (forall x y, lb <= x -> x < y -> y <= ub -> f x < f y) -> (forall x, f lb <= x -> x <= f ub -> (comp f g) x = id x) -> (forall x, f lb <= x -> x <= f ub -> lb <= g x <= ub) -> (forall a, lb <= a <= ub -> continuity_pt f a) -> forall b, f lb < b < f ub -> continuity_pt g b. Proof. intros f g lb ub lb_lt_ub f_incr_interv f_eq_g g_wf. assert (g_eq_f_prelim := leftinv_is_rightinv_interv f g lb ub f_incr_interv f_eq_g). assert (g_eq_f : forall x, lb <= x <= ub -> (comp g f) x = id x). { intro x ; apply g_eq_f_prelim ; assumption. } apply (continuity_pt_recip_prelim f g lb ub lb_lt_ub f_incr_interv g_eq_f). Qed. (** * Derivability of the reciprocal function *) Lemma derivable_pt_lim_recip_interv : forall (f g:R->R) (lb ub x:R) (Prf:forall a : R, g lb <= a <= g ub -> derivable_pt f a) (Prg : continuity_pt g x), lb < ub -> lb < x < ub -> forall (Prg_incr:g lb <= g x <= g ub), (forall x, lb <= x <= ub -> (comp f g) x = id x) -> derive_pt f (g x) (Prf (g x) Prg_incr) <> 0 -> derivable_pt_lim g x (1 / derive_pt f (g x) (Prf (g x) Prg_incr)). Proof. intros f g lb ub x Prf g_cont_pur lb_lt_ub x_encad Prg_incr f_eq_g df_neq. assert (x_encad2 : lb <= x <= ub). { split ; apply Rlt_le ; intuition. } elim (Prf (g x)); simpl; intros l Hl. unfold derivable_pt_lim. intros eps eps_pos. pose (y := g x). assert (Hlinv := limit_inv). assert (Hf_deriv : forall eps:R, 0 < eps -> exists delta : posreal, (forall h:R, h <> 0 -> Rabs h < delta -> Rabs ((f (g x + h) - f (g x)) / h - l) < eps)). { intros eps0 eps0_pos. red in Hl ; red in Hl. elim (Hl eps0 eps0_pos). intros deltatemp Htemp. exists deltatemp ; exact Htemp. } elim (Hf_deriv eps eps_pos). intros deltatemp Htemp. red in Hlinv ; red in Hlinv ; unfold dist in Hlinv ; unfold Rdist in Hlinv. assert (Hlinv' := Hlinv (fun h => (f (y+h) - f y)/h) (fun h => h <>0) l 0). unfold limit1_in, limit_in, dist in Hlinv' ; simpl in Hlinv'. unfold Rdist in Hlinv'. assert (Premisse : forall eps : R, eps > 0 -> exists alp : R, alp > 0 /\ (forall x : R, (fun h => h <>0) x /\ Rabs (x - 0) < alp -> Rabs ((f (y + x) - f y) / x - l) < eps)). { intros eps0 eps0_pos. elim (Hf_deriv eps0 eps0_pos). intros deltatemp' Htemp'. exists deltatemp'. split. { exact (cond_pos deltatemp'). } intros htemp cond. apply (Htemp' htemp). { exact (proj1 cond). } replace (htemp) with (htemp - 0). { exact (proj2 cond). } intuition. } assert (Premisse2 : l <> 0). { intro l_null. rewrite l_null in Hl. apply df_neq. rewrite derive_pt_eq. exact Hl. } elim (Hlinv' Premisse Premisse2 eps eps_pos). intros alpha cond. assert (alpha_pos := proj1 cond) ; assert (inv_cont := proj2 cond) ; clear cond. unfold derivable, derivable_pt, derivable_pt_abs, derivable_pt_lim in Prf. elim (Hl eps eps_pos). intros delta f_deriv. assert (g_cont := g_cont_pur). unfold continuity_pt, continue_in, limit1_in, limit_in in g_cont. pose (mydelta := Rmin delta alpha). assert (mydelta_pos : mydelta > 0). { unfold mydelta, Rmin. case (Rle_dec delta alpha). { intro ; exact ((cond_pos delta)). } intro ; exact alpha_pos. } elim (g_cont mydelta mydelta_pos). intros delta' new_g_cont. assert(delta'_pos := proj1 (new_g_cont)). clear g_cont ; assert (g_cont := proj2 (new_g_cont)) ; clear new_g_cont. pose (mydelta'' := Rmin delta' (Rmin (x - lb) (ub - x))). assert(mydelta''_pos : mydelta'' > 0). { unfold mydelta''. apply Rmin_pos ; [intuition | apply Rmin_pos] ; apply Rgt_minus ; intuition. } pose (delta'' := mkposreal mydelta'' mydelta''_pos: posreal). exists delta''. intros h h_neq h_le_delta'. assert (lb <= x +h <= ub). { assert (Sublemma2 : forall x y, Rabs x < Rabs y -> y > 0 -> x < y). { intros m n Hyp_abs y_pos. apply Rlt_le_trans with (r2:=Rabs n). { apply Rle_lt_trans with (r2:=Rabs m) ; [ | assumption] ; apply RRle_abs. } apply Req_le ; apply Rabs_right ; apply Rgt_ge ; assumption. } split. { assert (Sublemma : forall x y z, -z <= y - x -> x <= y + z). { intros ; lra. } apply Sublemma. apply Rlt_le ; apply Sublemma2. { rewrite Rabs_Ropp. apply Rlt_le_trans with (r2:=x-lb) ; [| apply RRle_abs] ; apply Rlt_le_trans with (r2:=Rmin (x - lb) (ub - x)) ; [| apply Rmin_l] ; apply Rlt_le_trans with (r2:=Rmin delta' (Rmin (x - lb) (ub - x))). { apply Rlt_le_trans with (r2:=delta''). { assumption. } intuition. } apply Rmin_r. } apply Rgt_minus. intuition. } assert (Sublemma : forall x y z, y <= z - x -> x + y <= z). { intros ; lra. } apply Sublemma. apply Rlt_le ; apply Sublemma2. { apply Rlt_le_trans with (r2:=ub-x) ; [| apply RRle_abs] ; apply Rlt_le_trans with (r2:=Rmin (x - lb) (ub - x)) ; [| apply Rmin_r] ; apply Rlt_le_trans with (r2:=Rmin delta' (Rmin (x - lb) (ub - x))) ; [| apply Rmin_r] ; assumption. } apply Rlt_le_trans with (r2:=delta''). { assumption. } apply Rle_trans with (r2:=Rmin delta' (Rmin (x - lb) (ub - x))). { intuition. } apply Rle_trans with (r2:=Rmin (x - lb) (ub - x)). { apply Rmin_r. } apply Rmin_r. } replace ((g (x + h) - g x) / h) with (1/ (h / (g (x + h) - g x))). 2:{ field ; split. { assumption. } intro Hfalse ; apply h_neq. apply (Rplus_0_r_uniq x). assert (Hfin : (comp f g) (x+h) = (comp f g) x). { apply Rminus_diag_uniq in Hfalse. unfold comp. rewrite Hfalse ; reflexivity. } rewrite f_eq_g in Hfin. { rewrite f_eq_g in Hfin. { unfold id in Hfin. exact Hfin. } assumption. } assumption. } assert (Hrewr : h = (comp f g ) (x+h) - (comp f g) x). { rewrite f_eq_g. { rewrite f_eq_g. { unfold id ; rewrite Rplus_comm ; unfold Rminus ; rewrite Rplus_assoc ; rewrite Rplus_opp_r ; intuition. } assumption. } assumption. } rewrite Hrewr at 1. unfold comp. replace (g(x+h)) with (g x + (g (x+h) - g(x))) by field. pose (h':=g (x+h) - g x). replace (g (x+h) - g x) with h' by intuition. replace (g x + h' - g x) with h' by field. assert (h'_neq : h' <> 0). { unfold h'. intro Hfalse. unfold Rminus in Hfalse ; apply Rminus_diag_uniq in Hfalse. assert (Hfalse' : (comp f g) (x+h) = (comp f g) x). { intros ; unfold comp ; rewrite Hfalse ; trivial. } rewrite f_eq_g in Hfalse' ; rewrite f_eq_g in Hfalse'. - unfold id in Hfalse'. apply Rplus_0_r_uniq in Hfalse'. apply h_neq ; exact Hfalse'. - assumption. - assumption. - assumption. } unfold Rdiv at 1 3; rewrite Rmult_1_l ; rewrite Rmult_1_l. apply inv_cont. split. { exact h'_neq. } rewrite Rminus_0_r. unfold continuity_pt, continue_in, limit1_in, limit_in in g_cont_pur. elim (g_cont_pur mydelta mydelta_pos). intros delta3 cond3. unfold dist in cond3 ; simpl in cond3 ; unfold Rdist in cond3. unfold h'. assert (mydelta_le_alpha : mydelta <= alpha). { unfold mydelta, Rmin ; case (Rle_dec delta alpha). { trivial. } intro ; intuition. } apply Rlt_le_trans with (r2:=mydelta). 2:assumption. unfold dist in g_cont ; simpl in g_cont ; unfold Rdist in g_cont ; apply g_cont. split. { unfold D_x ; simpl. split. { unfold no_cond ; trivial. } intro Hfalse ; apply h_neq. apply (Rplus_0_r_uniq x). symmetry ; assumption. } replace (x + h - x) with h by field. apply Rlt_le_trans with (r2:=delta''). { assumption ; unfold delta''. } intuition. apply Rle_trans with (r2:=mydelta''). { apply Req_le. unfold delta''. intuition. } apply Rmin_l. Qed. Lemma derivable_pt_recip_interv_prelim0 : forall (f g : R -> R) (lb ub x : R) (Prf : forall a : R, g lb <= a <= g ub -> derivable_pt f a), continuity_pt g x -> lb < ub -> lb < x < ub -> forall Prg_incr : g lb <= g x <= g ub, (forall x0 : R, lb <= x0 <= ub -> comp f g x0 = id x0) -> derive_pt f (g x) (Prf (g x) Prg_incr) <> 0 -> derivable_pt g x. Proof. intros f g lb ub x Prf g_cont_pt lb_lt_ub x_encad Prg_incr f_eq_g Df_neq. unfold derivable_pt, derivable_pt_abs. exists (1 / derive_pt f (g x) (Prf (g x) Prg_incr)). apply derivable_pt_lim_recip_interv ; assumption. Qed. Lemma derivable_pt_recip_interv_prelim1 : forall (f g:R->R) (lb ub x : R), lb < ub -> f lb < x < f ub -> (forall x : R, f lb <= x -> x <= f ub -> lb <= g x <= ub) -> (forall a : R, lb <= a <= ub -> derivable_pt f a) -> derivable_pt f (g x). Proof. intros f g lb ub x lb_lt_ub x_encad g_wf f_deriv. apply f_deriv. apply g_wf; lra. Qed. Lemma derivable_pt_recip_interv_prelim1_decr : forall (f g:R->R) (lb ub x : R), lb < ub -> f ub < x < f lb -> (forall x : R, f ub <= x -> x <= f lb -> lb <= g x <= ub) -> (forall a : R, lb <= a <= ub -> derivable_pt f a) -> derivable_pt f (g x). Proof. intros f g lb ub x lb_lt_ub x_encad g_wf f_deriv. apply f_deriv. apply g_wf; lra. Qed. Lemma derivable_pt_recip_interv (f g:R->R) (lb ub x : R) (lb_lt_ub:lb < ub) (x_encad:f lb < x < f ub) (f_eq_g:forall x : R, f lb <= x -> x <= f ub -> comp f g x = id x) (g_wf:forall x : R, f lb <= x -> x <= f ub -> lb <= g x <= ub) (f_incr:forall x y : R, lb <= x -> x < y -> y <= ub -> f x < f y) (f_derivable:forall a : R, lb <= a <= ub -> derivable_pt f a) : derive_pt f (g x) (derivable_pt_recip_interv_prelim1 f g lb ub x lb_lt_ub x_encad g_wf f_derivable) <> 0 -> derivable_pt g x. Proof. intros Df_neq. assert(g_incr : g (f lb) < g x < g (f ub)). { assert (Temp:= f_incr_implies_g_incr_interv f g lb ub lb_lt_ub f_incr f_eq_g g_wf). split ; apply Temp ; intuition. - exact (proj1 x_encad). - apply Rlt_le ; exact (proj2 x_encad). - apply Rlt_le ; exact (proj1 x_encad). - exact (proj2 x_encad). } assert(g_incr2 : g (f lb) <= g x <= g (f ub)). { split ; apply Rlt_le ; intuition. } assert (g_eq_f := leftinv_is_rightinv_interv f g lb ub f_incr f_eq_g g_wf). unfold comp, id in g_eq_f. assert (f_derivable2 : forall a : R, g (f lb) <= a <= g (f ub) -> derivable_pt f a). { intros a a_encad ; apply f_derivable. rewrite g_eq_f in a_encad ; rewrite g_eq_f in a_encad ; intuition. } apply derivable_pt_recip_interv_prelim0 with (f:=f) (lb:=f lb) (ub:=f ub) (Prf:=f_derivable2) (Prg_incr:=g_incr2). - apply continuity_pt_recip_interv with (f:=f) (lb:=lb) (ub:=ub) ; intuition. + apply derivable_continuous_pt ; apply f_derivable ; intuition. + exact (proj1 x_encad). + exact (proj2 x_encad). - apply f_incr ; intuition. - assumption. - intros x0 x0_encad ; apply f_eq_g ; intuition. - rewrite pr_nu_var2_interv with (g:=f) (lb:=lb) (ub:=ub) (pr2:=derivable_pt_recip_interv_prelim1 f g lb ub x lb_lt_ub x_encad g_wf f_derivable); [| |rewrite g_eq_f in g_incr ; rewrite g_eq_f in g_incr| ] ; intuition. Qed. Lemma derivable_pt_recip_interv_decr (f g:R->R) (lb ub x : R) (lb_lt_ub:lb < ub) (x_encad:f ub < x < f lb) (f_eq_g:forall x : R, f ub <= x -> x <= f lb -> comp f g x = id x) (g_wf:forall x : R, f ub <= x -> x <= f lb -> lb <= g x <= ub) (f_decr:forall x y : R, lb <= x -> x < y -> y <= ub -> f y < f x) (f_derivable:forall a : R, lb <= a <= ub -> derivable_pt f a) : derive_pt f (g x) (derivable_pt_recip_interv_prelim1_decr f g lb ub x lb_lt_ub x_encad g_wf f_derivable) <> 0 -> derivable_pt g x. Proof. intros. apply derivable_pt_opp_rev. unshelve eapply (derivable_pt_recip_interv (mirr_fct f) (opp_fct g) (-ub) (-lb) (x)). - lra. - unfold mirr_fct; repeat rewrite Ropp_involutive; lra. - intros x0 H1 H2. unfold mirr_fct in H1,H2; unfold opp_fct. rewrite Ropp_involutive in H1,H2. pose proof g_wf x0 as g_wfs; lra. - intros x0 H1. apply derivable_pt_mirr, f_derivable; lra. - intros x0 H1 H2. unfold mirr_fct in H1,H2 |-*; unfold opp_fct, comp. rewrite Ropp_involutive in H1,H2 |-*. apply f_eq_g; lra. - intros x0 y0 H1 H2 H3. unfold mirr_fct. apply f_decr; lra. - (* In order to rewrite with derive_pt_mirr the term must have the form derive_pt (mirr_fct f) _ (derivable_pt_mirr ... pr_nu is a sort of proof irrelevance lemma for derive_pt equalities *) unshelve erewrite (pr_nu _ _ _). + apply derivable_pt_mirr. unfold opp_fct; rewrite Ropp_involutive. apply f_derivable; apply g_wf; lra. + rewrite derive_pt_mirr. unfold opp_fct; rewrite Ropp_involutive. match goal with H:context[derive_pt _ _ ?pr] |- _ => rewrite (pr_nu f (g x) _ pr) end. apply Ropp_neq_0_compat. assumption. Qed. (****************************************************) (** * Value of the derivative of the reciprocal function *) (****************************************************) Lemma derive_pt_recip_interv_prelim0 (f g:R->R) (lb ub x:R) (Prf:derivable_pt f (g x)) (Prg:derivable_pt g x) : lb < ub -> lb < x < ub -> (forall x, lb < x < ub -> (comp f g) x = id x) -> derive_pt f (g x) Prf <> 0 -> derive_pt g x Prg = 1 / (derive_pt f (g x) Prf). Proof. intros lb_lt_ub x_encad local_recip Df_neq. replace (derive_pt g x Prg) with ((derive_pt g x Prg) * (derive_pt f (g x) Prf) * / (derive_pt f (g x) Prf)). { unfold Rdiv. rewrite (Rmult_comm _ (/ derive_pt f (g x) Prf)). rewrite (Rmult_comm _ (/ derive_pt f (g x) Prf)). apply Rmult_eq_compat_l. rewrite Rmult_comm. rewrite <- derive_pt_comp. assert (x_encad2 : lb <= x <= ub) by intuition. rewrite pr_nu_var2_interv with (g:=id) (pr2:= derivable_pt_id_interv lb ub x x_encad2) (lb:=lb) (ub:=ub) ; [reg| | |] ; assumption. } rewrite Rmult_assoc, Rinv_r. { intuition. } assumption. Qed. Lemma derive_pt_recip_interv_prelim1_0 : forall (f g:R->R) (lb ub x:R), lb < ub -> f lb < x < f ub -> (forall x y : R, lb <= x -> x < y -> y <= ub -> f x < f y) -> (forall x : R, f lb <= x -> x <= f ub -> lb <= g x <= ub) -> (forall x, f lb <= x -> x <= f ub -> (comp f g) x = id x) -> lb < g x < ub. Proof. intros f g lb ub x lb_lt_ub x_encad f_incr g_wf f_eq_g. assert (Temp:= f_incr_implies_g_incr_interv f g lb ub lb_lt_ub f_incr f_eq_g g_wf). assert (Left_inv := leftinv_is_rightinv_interv f g lb ub f_incr f_eq_g g_wf). unfold comp, id in Left_inv. split ; [rewrite <- Left_inv with (x:=lb) | rewrite <- Left_inv ];intuition. Qed. Lemma derive_pt_recip_interv_prelim1_1 : forall (f g:R->R) (lb ub x:R), lb < ub -> f lb < x < f ub -> (forall x y : R, lb <= x -> x < y -> y <= ub -> f x < f y) -> (forall x : R, f lb <= x -> x <= f ub -> lb <= g x <= ub) -> (forall x, f lb <= x -> x <= f ub -> (comp f g) x = id x) -> lb <= g x <= ub. Proof. intros f g lb ub x lb_lt_ub x_encad f_incr g_wf f_eq_g. assert (Temp := derive_pt_recip_interv_prelim1_0 f g lb ub x lb_lt_ub x_encad f_incr g_wf f_eq_g). split ; apply Rlt_le ; intuition. Qed. Lemma derive_pt_recip_interv_prelim1_1_decr : forall (f g:R->R) (lb ub x:R), lb < ub -> f ub < x < f lb -> (forall x y : R, lb <= x -> x < y -> y <= ub -> f y < f x) -> (forall x : R, f ub <= x -> x <= f lb -> lb <= g x <= ub) -> (forall x, f ub <= x -> x <= f lb -> (comp f g) x = id x) -> lb <= g x <= ub. Proof. intros f g lb ub x lb_lt_ub x_encad f_decr g_wf f_eq_g. enough (-ub <= - g x <= - lb) by lra. unshelve eapply (derive_pt_recip_interv_prelim1_1 (mirr_fct f) (opp_fct g) (-ub) (-lb) (x)). - lra. - unfold mirr_fct; repeat rewrite Ropp_involutive; lra. - intros x0 y0 H1 H2 H3. unfold mirr_fct. apply f_decr; lra. - intros x0 H1 H2. unfold mirr_fct in H1,H2; unfold opp_fct. rewrite Ropp_involutive in H1,H2. pose proof g_wf x0 as g_wfs; lra. - intros x0 H1 H2. unfold mirr_fct in H1,H2 |-*; unfold opp_fct, comp. rewrite Ropp_involutive in H1,H2 |-*. apply f_eq_g; lra. Qed. Lemma derive_pt_recip_interv : forall (f g:R->R) (lb ub x:R) (lb_lt_ub:lb < ub) (x_encad:f lb < x < f ub) (f_incr:forall x y : R, lb <= x -> x < y -> y <= ub -> f x < f y) (g_wf:forall x : R, f lb <= x -> x <= f ub -> lb <= g x <= ub) (Prf:forall a : R, lb <= a <= ub -> derivable_pt f a) (f_eq_g:forall x, f lb <= x -> x <= f ub -> (comp f g) x = id x) (Df_neq:derive_pt f (g x) (derivable_pt_recip_interv_prelim1 f g lb ub x lb_lt_ub x_encad g_wf Prf) <> 0), derive_pt g x (derivable_pt_recip_interv f g lb ub x lb_lt_ub x_encad f_eq_g g_wf f_incr Prf Df_neq) = 1 / (derive_pt f (g x) (Prf (g x) (derive_pt_recip_interv_prelim1_1 f g lb ub x lb_lt_ub x_encad f_incr g_wf f_eq_g))). Proof. intros. assert(g_incr := (derive_pt_recip_interv_prelim1_1 f g lb ub x lb_lt_ub x_encad f_incr g_wf f_eq_g)). apply derive_pt_recip_interv_prelim0 with (lb:=f lb) (ub:=f ub) ; [intuition |assumption | intuition |]. intro Hfalse ; apply Df_neq. rewrite pr_nu_var2_interv with (g:=f) (lb:=lb) (ub:=ub) (pr2:= (Prf (g x) (derive_pt_recip_interv_prelim1_1 f g lb ub x lb_lt_ub x_encad f_incr g_wf f_eq_g))) ; [intuition | intuition | | intuition]. exact (derive_pt_recip_interv_prelim1_0 f g lb ub x lb_lt_ub x_encad f_incr g_wf f_eq_g). Qed. Lemma derive_pt_recip_interv_decr : forall (f g:R->R) (lb ub x:R) (lb_lt_ub:lb < ub) (x_encad:f ub < x < f lb) (f_decr:forall x y : R, lb <= x -> x < y -> y <= ub -> f y < f x) (g_wf:forall x : R, f ub <= x -> x <= f lb -> lb <= g x <= ub) (Prf:forall a : R, lb <= a <= ub -> derivable_pt f a) (f_eq_g:forall x, f ub <= x -> x <= f lb -> (comp f g) x = id x) (Df_neq:derive_pt f (g x) (derivable_pt_recip_interv_prelim1_decr f g lb ub x lb_lt_ub x_encad g_wf Prf) <> 0), derive_pt g x (derivable_pt_recip_interv_decr f g lb ub x lb_lt_ub x_encad f_eq_g g_wf f_decr Prf Df_neq) = 1 / (derive_pt f (g x) (Prf (g x) (derive_pt_recip_interv_prelim1_1_decr f g lb ub x lb_lt_ub x_encad f_decr g_wf f_eq_g))). Proof. (* This proof based on derive_pt_recip_interv looks fairly long compared to the direct proof above, but the direct proof needs a lot of lengthy preparation lemmas e.g. derivable_pt_lim_recip_interv. *) intros. (* Note: here "unshelve epose" with proving the premises first does not work. The more abstract form with the unbound evars has less issues with dependent rewriting. *) epose proof (derive_pt_recip_interv (mirr_fct f) (opp_fct g) (-ub) (-lb) (x) _ _ _ _ _ _ _). rewrite derive_pt_mirr_rev in H. rewrite derive_pt_opp_rev in H. unfold opp_fct in H. match goal with | H:context[derive_pt ?f ?x1 ?pr1] |- context[derive_pt ?f ?x2 ?pr2] => rewrite (pr_nu_xeq f x1 x2 pr1 pr2 (Ropp_involutive x2)) in H end. match goal with | H:context[derive_pt ?f ?x ?pr1] |- context[derive_pt ?f ?x ?pr2] => rewrite (pr_nu f x pr1 pr2) in H end. apply Ropp_eq_compat in H; rewrite Ropp_involutive in H. rewrite H; field. pose proof Df_neq as Df_neq'. match goal with | H:context[derive_pt ?f ?x ?pr1] |- context[derive_pt ?f ?x ?pr2] => rewrite (pr_nu f x pr1 pr2) in H end. assumption. Unshelve. - abstract lra. - unfold mirr_fct; repeat rewrite Ropp_involutive; abstract lra. - intros x0 y0 H1 H2 H3. unfold mirr_fct. apply f_decr; abstract lra. - intros x0 H1 H2. unfold mirr_fct in H1,H2; unfold opp_fct. rewrite Ropp_involutive in H1,H2. pose proof g_wf x0 as g_wfs; abstract lra. - intros x0 H1. apply derivable_pt_mirr, Prf; abstract lra. - intros x0 H1 H2. unfold mirr_fct in H1,H2 |-*; unfold opp_fct, comp. rewrite Ropp_involutive in H1,H2 |-*. apply f_eq_g; abstract lra. - unshelve erewrite (pr_nu _ _ _). { apply derivable_pt_mirr. unfold opp_fct; rewrite Ropp_involutive. apply Prf; apply g_wf; abstract lra. } rewrite derive_pt_mirr. unfold opp_fct; rewrite Ropp_involutive. apply Ropp_neq_0_compat. erewrite (pr_nu _ _ _). apply Df_neq. Qed. (****************************************************) (** * Existence of the derivative of a function which is the limit of a sequence of functions *) (****************************************************) (* begin hide *) Lemma ub_lt_2_pos : forall x ub lb, lb < x -> x < ub -> 0 < (ub-lb)/2. Proof. intros x ub lb lb_lt_x x_lt_ub. lra. Qed. Definition mkposreal_lb_ub (x lb ub:R) (lb_lt_x:lb R -> R) (f g:R->R) (x:R) : forall c r, Boule c r x -> (forall y n, Boule c r y -> derivable_pt_lim (fn n) y (fn' n y)) -> (forall y, Boule c r y -> Un_cv (fun n => fn n y) (f y)) -> (CVU fn' g c r) -> (forall y, Boule c r y -> continuity_pt g y) -> derivable_pt_lim f x (g x). Proof. intros c' r xinb Dfn_eq_fn' fn_CV_f fn'_CVU_g g_cont eps eps_pos. assert (eps_8_pos : 0 < eps / 8) by lra. elim (g_cont x xinb _ eps_8_pos) ; clear g_cont ; intros delta1 (delta1_pos, g_cont). destruct (Ball_in_inter _ _ _ _ _ xinb (Boule_center x (mkposreal _ delta1_pos))) as [delta Pdelta]. exists delta; intros h hpos hinbdelta. assert (eps'_pos : 0 < (Rabs h) * eps / 4). { unfold Rdiv ; rewrite Rmult_assoc ; apply Rmult_lt_0_compat. { apply Rabs_pos_lt ; assumption. } lra. } destruct (fn_CV_f x xinb ((Rabs h) * eps / 4) eps'_pos) as [N2 fnx_CV_fx]. assert (xhinbxdelta : Boule x delta (x + h)). { clear -hinbdelta; apply Rabs_def2 in hinbdelta; unfold Boule; simpl. destruct hinbdelta; apply Rabs_def1; lra. } assert (t : Boule c' r (x + h)). { apply Pdelta in xhinbxdelta; tauto. } destruct (fn_CV_f (x+h) t ((Rabs h) * eps / 4) eps'_pos) as [N1 fnxh_CV_fxh]. clear fn_CV_f t. destruct (fn'_CVU_g (eps/8) eps_8_pos) as [N3 fn'c_CVU_gc]. pose (N := ((N1 + N2) + N3)%nat). assert (Main : Rabs ((f (x+h) - fn N (x+h)) - (f x - fn N x) + (fn N (x+h) - fn N x - h * (g x))) < (Rabs h)*eps). 2:{ replace ((f (x + h) - f x) / h - g x) with ((/h) * ((f (x + h) - f x) - h * g x)) by (field;assumption). rewrite Rabs_mult ; rewrite Rabs_inv. replace eps with (/ Rabs h * (Rabs h * eps)). { apply Rmult_lt_compat_l. { apply Rinv_0_lt_compat ; apply Rabs_pos_lt ; assumption. } replace (f (x + h) - f x - h * g x) with (f (x + h) - fn N (x + h) - (f x - fn N x) + (fn N (x + h) - fn N x - h * g x)) by field. assumption. } field ; apply Rgt_not_eq ; apply Rabs_pos_lt ; assumption. } apply Rle_lt_trans with (Rabs (f (x + h) - fn N (x + h) - (f x - fn N x)) + Rabs ((fn N (x + h) - fn N x - h * g x))). { solve[apply Rabs_triang]. } apply Rle_lt_trans with (Rabs (f (x + h) - fn N (x + h)) + Rabs (- (f x - fn N x)) + Rabs (fn N (x + h) - fn N x - h * g x)). { solve[apply Rplus_le_compat_r ; apply Rabs_triang]. } rewrite Rabs_Ropp. case (Rlt_le_dec h 0) ; intro sgn_h. { assert (pr1 : forall c : R, x + h < c < x -> derivable_pt (fn N) c). { intros c c_encad ; unfold derivable_pt. exists (fn' N c) ; apply Dfn_eq_fn'. assert (t : Boule x delta c). { apply Rabs_def2 in xhinbxdelta; destruct xhinbxdelta; destruct c_encad. apply Rabs_def2 in xinb; apply Rabs_def1; lra. } apply Pdelta in t; tauto. } assert (pr2 : forall c : R, x + h < c < x -> derivable_pt id c). { solve[intros; apply derivable_id]. } assert (xh_x : x+h < x) by lra. assert (pr3 : forall c : R, x + h <= c <= x -> continuity_pt (fn N) c). { intros c c_encad ; apply derivable_continuous_pt. exists (fn' N c) ; apply Dfn_eq_fn' ; intuition. assert (t : Boule x delta c). { apply Rabs_def2 in xhinbxdelta; destruct xhinbxdelta. apply Rabs_def2 in xinb; apply Rabs_def1; lra. } apply Pdelta in t; tauto. } assert (pr4 : forall c : R, x + h <= c <= x -> continuity_pt id c). { solve[intros; apply derivable_continuous ; apply derivable_id]. } destruct (MVT (fn N) id (x+h) x pr1 pr2 xh_x pr3 pr4) as [c [P Hc]]. assert (Hc' : h * derive_pt (fn N) c (pr1 c P) = (fn N (x+h) - fn N x)). { apply Rmult_eq_reg_l with (-1). { replace (-1 * (h * derive_pt (fn N) c (pr1 c P))) with (-h * derive_pt (fn N) c (pr1 c P)) by field. replace (-1 * (fn N (x + h) - fn N x)) with (- (fn N (x + h) - fn N x)) by field. replace (-h) with (id x - id (x + h)) by (unfold id; field). rewrite <- Rmult_1_r ; replace 1 with (derive_pt id c (pr2 c P)) by reg. replace (- (fn N (x + h) - fn N x)) with (fn N x - fn N (x + h)) by field. assumption. } now apply Rlt_not_eq, IZR_lt. } rewrite <- Hc'; clear Hc Hc'. replace (derive_pt (fn N) c (pr1 c P)) with (fn' N c). 2:{ assert (H := pr1 c P) ; elim H ; clear H ; intros l Hl. assert (Temp : l = fn' N c). { assert (bc'rc : Boule c' r c). { assert (t : Boule x delta c). { clear - xhinbxdelta P. destruct P; apply Rabs_def2 in xhinbxdelta; destruct xhinbxdelta. apply Rabs_def1; lra. } apply Pdelta in t; tauto. } assert (Hl' := Dfn_eq_fn' c N bc'rc). unfold derivable_pt_abs in Hl; clear -Hl Hl'. apply uniqueness_limite with (f:= fn N) (x:=c) ; assumption. } rewrite <- Temp. assert (Hl' : derivable_pt (fn N) c). { exists l ; apply Hl. } rewrite pr_nu_var with (g:= fn N) (pr2:=Hl'). { elim Hl' ; clear Hl' ; intros l' Hl'. assert (Main : l = l'). { apply uniqueness_limite with (f:= fn N) (x:=c) ; assumption. } rewrite Main ; reflexivity. } reflexivity. } replace (h * fn' N c - h * g x) with (h * (fn' N c - g x)) by field. rewrite Rabs_mult. apply Rlt_trans with (Rabs h * eps / 4 + Rabs (f x - fn N x) + Rabs h * Rabs (fn' N c - g x)). { apply Rplus_lt_compat_r ; apply Rplus_lt_compat_r ; unfold Rdist in fnxh_CV_fxh ; rewrite Rabs_minus_sym ; apply fnxh_CV_fxh. unfold N; lia. } apply Rlt_trans with (Rabs h * eps / 4 + Rabs h * eps / 4 + Rabs h * Rabs (fn' N c - g x)). { apply Rplus_lt_compat_r ; apply Rplus_lt_compat_l. unfold Rdist in fnx_CV_fx ; rewrite Rabs_minus_sym ; apply fnx_CV_fx. unfold N ; lia. } replace (fn' N c - g x) with ((fn' N c - g c) + (g c - g x)) by field. apply Rle_lt_trans with (Rabs h * eps / 4 + Rabs h * eps / 4 + Rabs h * Rabs (fn' N c - g c) + Rabs h * Rabs (g c - g x)). { rewrite Rplus_assoc ; rewrite Rplus_assoc ; rewrite Rplus_assoc ; apply Rplus_le_compat_l ; apply Rplus_le_compat_l ; rewrite <- Rmult_plus_distr_l ; apply Rmult_le_compat_l. { solve[apply Rabs_pos]. } solve[apply Rabs_triang]. } apply Rlt_trans with (Rabs h * eps / 4 + Rabs h * eps / 4 + Rabs h * (eps / 8) + Rabs h * Rabs (g c - g x)). { apply Rplus_lt_compat_r; apply Rplus_lt_compat_l; apply Rmult_lt_compat_l. { apply Rabs_pos_lt ; assumption. } rewrite Rabs_minus_sym ; apply fn'c_CVU_gc. { unfold N ; lia. } assert (t : Boule x delta c). { destruct P. apply Rabs_def2 in xhinbxdelta; destruct xhinbxdelta. apply Rabs_def2 in xinb; apply Rabs_def1; lra. } apply Pdelta in t; tauto. } apply Rlt_trans with (Rabs h * eps / 4 + Rabs h * eps / 4 + Rabs h * (eps / 8) + Rabs h * (eps / 8)). { rewrite Rplus_assoc ; rewrite Rplus_assoc ; rewrite Rplus_assoc ; rewrite Rplus_assoc ; apply Rplus_lt_compat_l ; apply Rplus_lt_compat_l ; rewrite <- Rmult_plus_distr_l ; rewrite <- Rmult_plus_distr_l ; apply Rmult_lt_compat_l. { apply Rabs_pos_lt ; assumption. } apply Rplus_lt_compat_l ; simpl in g_cont ; apply g_cont ; split ; [unfold D_x ; split |]. - solve[unfold no_cond ; intuition]. - apply Rgt_not_eq ; exact (proj2 P). - apply Rlt_trans with (Rabs h). { apply Rabs_def1. { apply Rlt_trans with 0. { destruct P; lra. } apply Rabs_pos_lt ; assumption. } rewrite <- Rabs_Ropp, Rabs_pos_eq, Ropp_involutive;[ | lra]. destruct P; lra. } clear -Pdelta xhinbxdelta. apply Pdelta in xhinbxdelta; destruct xhinbxdelta as [_ P']. apply Rabs_def2 in P'; simpl in P'; destruct P'; apply Rabs_def1; lra. } rewrite Rplus_assoc ; rewrite Rplus_assoc ; rewrite <- Rmult_plus_distr_l. replace (Rabs h * eps / 4 + (Rabs h * eps / 4 + Rabs h * (eps / 8 + eps / 8))) with (Rabs h * (eps / 4 + eps / 4 + eps / 8 + eps / 8)) by field. apply Rmult_lt_compat_l. { apply Rabs_pos_lt ; assumption. } lra. } assert (h_pos : h > 0). { case sgn_h ; intro Hyp. { assumption. } apply False_ind ; apply hpos ; symmetry ; assumption. } clear sgn_h. assert (pr1 : forall c : R, x < c < x + h -> derivable_pt (fn N) c). { intros c c_encad ; unfold derivable_pt. exists (fn' N c) ; apply Dfn_eq_fn'. assert (t : Boule x delta c). { apply Rabs_def2 in xhinbxdelta; destruct xhinbxdelta; destruct c_encad. apply Rabs_def2 in xinb; apply Rabs_def1; lra. } apply Pdelta in t; tauto. } assert (pr2 : forall c : R, x < c < x + h -> derivable_pt id c). { solve[intros; apply derivable_id]. } assert (xh_x : x < x + h) by lra. assert (pr3 : forall c : R, x <= c <= x + h -> continuity_pt (fn N) c). { intros c c_encad ; apply derivable_continuous_pt. exists (fn' N c) ; apply Dfn_eq_fn' ; intuition. assert (t : Boule x delta c). { apply Rabs_def2 in xhinbxdelta; destruct xhinbxdelta. apply Rabs_def2 in xinb; apply Rabs_def1; lra. } apply Pdelta in t; tauto. } assert (pr4 : forall c : R, x <= c <= x + h -> continuity_pt id c). { solve[intros; apply derivable_continuous ; apply derivable_id]. } destruct (MVT (fn N) id x (x+h) pr1 pr2 xh_x pr3 pr4) as [c [P Hc]]. assert (Hc' : h * derive_pt (fn N) c (pr1 c P) = fn N (x+h) - fn N x). { pattern h at 1; replace h with (id (x + h) - id x) by (unfold id; field). rewrite <- Rmult_1_r ; replace 1 with (derive_pt id c (pr2 c P)) by reg. assumption. } rewrite <- Hc'; clear Hc Hc'. replace (derive_pt (fn N) c (pr1 c P)) with (fn' N c). { replace (h * fn' N c - h * g x) with (h * (fn' N c - g x)) by field. rewrite Rabs_mult. apply Rlt_trans with (Rabs h * eps / 4 + Rabs (f x - fn N x) + Rabs h * Rabs (fn' N c - g x)). { apply Rplus_lt_compat_r ; apply Rplus_lt_compat_r ; unfold Rdist in fnxh_CV_fxh ; rewrite Rabs_minus_sym ; apply fnxh_CV_fxh. unfold N; lia. } apply Rlt_trans with (Rabs h * eps / 4 + Rabs h * eps / 4 + Rabs h * Rabs (fn' N c - g x)). { apply Rplus_lt_compat_r ; apply Rplus_lt_compat_l. unfold Rdist in fnx_CV_fx ; rewrite Rabs_minus_sym ; apply fnx_CV_fx. unfold N ; lia. } replace (fn' N c - g x) with ((fn' N c - g c) + (g c - g x)) by field. apply Rle_lt_trans with (Rabs h * eps / 4 + Rabs h * eps / 4 + Rabs h * Rabs (fn' N c - g c) + Rabs h * Rabs (g c - g x)). { rewrite Rplus_assoc ; rewrite Rplus_assoc ; rewrite Rplus_assoc ; apply Rplus_le_compat_l ; apply Rplus_le_compat_l ; rewrite <- Rmult_plus_distr_l ; apply Rmult_le_compat_l. { solve[apply Rabs_pos]. } solve[apply Rabs_triang]. } apply Rlt_trans with (Rabs h * eps / 4 + Rabs h * eps / 4 + Rabs h * (eps / 8) + Rabs h * Rabs (g c - g x)). { apply Rplus_lt_compat_r; apply Rplus_lt_compat_l; apply Rmult_lt_compat_l. { apply Rabs_pos_lt ; assumption. } rewrite Rabs_minus_sym ; apply fn'c_CVU_gc. { unfold N ; lia. } assert (t : Boule x delta c). { destruct P. apply Rabs_def2 in xhinbxdelta; destruct xhinbxdelta. apply Rabs_def2 in xinb; apply Rabs_def1; lra. } apply Pdelta in t; tauto. } apply Rlt_trans with (Rabs h * eps / 4 + Rabs h * eps / 4 + Rabs h * (eps / 8) + Rabs h * (eps / 8)). { rewrite Rplus_assoc ; rewrite Rplus_assoc ; rewrite Rplus_assoc ; rewrite Rplus_assoc ; apply Rplus_lt_compat_l ; apply Rplus_lt_compat_l ; rewrite <- Rmult_plus_distr_l ; rewrite <- Rmult_plus_distr_l ; apply Rmult_lt_compat_l. { apply Rabs_pos_lt ; assumption. } apply Rplus_lt_compat_l ; simpl in g_cont ; apply g_cont ; split ; [unfold D_x ; split |]. - solve[unfold no_cond ; intuition]. - apply Rlt_not_eq ; exact (proj1 P). - apply Rlt_trans with (Rabs h). { apply Rabs_def1. { destruct P; rewrite Rabs_pos_eq;lra. } apply Rle_lt_trans with 0. { assert (t := Rabs_pos h); clear -t; lra. } clear -P; destruct P; lra. } clear -Pdelta xhinbxdelta. apply Pdelta in xhinbxdelta; destruct xhinbxdelta as [_ P']. apply Rabs_def2 in P'; simpl in P'; destruct P'; apply Rabs_def1; lra. } rewrite Rplus_assoc ; rewrite Rplus_assoc ; rewrite <- Rmult_plus_distr_l. replace (Rabs h * eps / 4 + (Rabs h * eps / 4 + Rabs h * (eps / 8 + eps / 8))) with (Rabs h * (eps / 4 + eps / 4 + eps / 8 + eps / 8)) by field. apply Rmult_lt_compat_l. { apply Rabs_pos_lt ; assumption. } lra. } assert (H := pr1 c P) ; elim H ; clear H ; intros l Hl. assert (Temp : l = fn' N c). { assert (bc'rc : Boule c' r c). { assert (t : Boule x delta c). { clear - xhinbxdelta P. destruct P; apply Rabs_def2 in xhinbxdelta; destruct xhinbxdelta. apply Rabs_def1; lra. } apply Pdelta in t; tauto. } assert (Hl' := Dfn_eq_fn' c N bc'rc). unfold derivable_pt_abs in Hl; clear -Hl Hl'. apply uniqueness_limite with (f:= fn N) (x:=c) ; assumption. } rewrite <- Temp. assert (Hl' : derivable_pt (fn N) c). { exists l ; apply Hl. } rewrite pr_nu_var with (g:= fn N) (pr2:=Hl'). { elim Hl' ; clear Hl' ; intros l' Hl'. assert (Main : l = l'). { apply uniqueness_limite with (f:= fn N) (x:=c) ; assumption. } rewrite Main ; reflexivity. } reflexivity. Qed. coq-8.20.0/theories/Reals/Ranalysis_reg.v000066400000000000000000000730551466560755400203000ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* match goal with | |- (derivable _) => intro_hyp_glob X1; intro_hyp_glob X2 | |- (continuity _) => intro_hyp_glob X1; intro_hyp_glob X2 | _ => idtac end | (?X1 - ?X2)%F => match goal with | |- (derivable _) => intro_hyp_glob X1; intro_hyp_glob X2 | |- (continuity _) => intro_hyp_glob X1; intro_hyp_glob X2 | _ => idtac end | (?X1 * ?X2)%F => match goal with | |- (derivable _) => intro_hyp_glob X1; intro_hyp_glob X2 | |- (continuity _) => intro_hyp_glob X1; intro_hyp_glob X2 | _ => idtac end | (?X1 / ?X2)%F => let aux := constr:(X2) in match goal with | _:(forall x0:R, aux x0 <> 0) |- (derivable _) => intro_hyp_glob X1; intro_hyp_glob X2 | _:(forall x0:R, aux x0 <> 0) |- (continuity _) => intro_hyp_glob X1; intro_hyp_glob X2 | |- (derivable _) => cut (forall x0:R, aux x0 <> 0); [ intro; intro_hyp_glob X1; intro_hyp_glob X2 | try assumption ] | |- (continuity _) => cut (forall x0:R, aux x0 <> 0); [ intro; intro_hyp_glob X1; intro_hyp_glob X2 | try assumption ] | _ => idtac end | (comp ?X1 ?X2) => match goal with | |- (derivable _) => intro_hyp_glob X1; intro_hyp_glob X2 | |- (continuity _) => intro_hyp_glob X1; intro_hyp_glob X2 | _ => idtac end | (- ?X1)%F => match goal with | |- (derivable _) => intro_hyp_glob X1 | |- (continuity _) => intro_hyp_glob X1 | _ => idtac end | (/ ?X1)%F => let aux := constr:(X1) in match goal with | _:(forall x0:R, aux x0 <> 0) |- (derivable _) => intro_hyp_glob X1 | _:(forall x0:R, aux x0 <> 0) |- (continuity _) => intro_hyp_glob X1 | |- (derivable _) => cut (forall x0:R, aux x0 <> 0); [ intro; intro_hyp_glob X1 | try assumption ] | |- (continuity _) => cut (forall x0:R, aux x0 <> 0); [ intro; intro_hyp_glob X1 | try assumption ] | _ => idtac end | cos => idtac | sin => idtac | cosh => idtac | sinh => idtac | exp => idtac | Rsqr => idtac | sqrt => idtac | id => idtac | (fct_cte _) => idtac | (pow_fct _) => idtac | Rabs => idtac | ?X1 => let p := constr:(X1) in let HYPPD := fresh "HYPPD" in match goal with | _:(derivable p) |- _ => idtac | |- (derivable p) => idtac | |- (derivable _) => cut (True -> derivable p); [ intro HYPPD; cut (derivable p); [ intro; clear HYPPD | apply HYPPD; clear HYPPD; trivial ] | idtac ] | _:(continuity p) |- _ => idtac | |- (continuity p) => idtac | |- (continuity _) => cut (True -> continuity p); [ intro HYPPD; cut (continuity p); [ intro; clear HYPPD | apply HYPPD; clear HYPPD; trivial ] | idtac ] | _ => idtac end end. (**********) Ltac intro_hyp_pt trm pt := match constr:(trm) with | (?X1 + ?X2)%F => match goal with | |- (derivable_pt _ _) => intro_hyp_pt X1 pt; intro_hyp_pt X2 pt | |- (continuity_pt _ _) => intro_hyp_pt X1 pt; intro_hyp_pt X2 pt | |- (derive_pt _ _ _ = _) => intro_hyp_pt X1 pt; intro_hyp_pt X2 pt | _ => idtac end | (?X1 - ?X2)%F => match goal with | |- (derivable_pt _ _) => intro_hyp_pt X1 pt; intro_hyp_pt X2 pt | |- (continuity_pt _ _) => intro_hyp_pt X1 pt; intro_hyp_pt X2 pt | |- (derive_pt _ _ _ = _) => intro_hyp_pt X1 pt; intro_hyp_pt X2 pt | _ => idtac end | (?X1 * ?X2)%F => match goal with | |- (derivable_pt _ _) => intro_hyp_pt X1 pt; intro_hyp_pt X2 pt | |- (continuity_pt _ _) => intro_hyp_pt X1 pt; intro_hyp_pt X2 pt | |- (derive_pt _ _ _ = _) => intro_hyp_pt X1 pt; intro_hyp_pt X2 pt | _ => idtac end | (?X1 / ?X2)%F => let aux := constr:(X2) in match goal with | _:(aux pt <> 0) |- (derivable_pt _ _) => intro_hyp_pt X1 pt; intro_hyp_pt X2 pt | _:(aux pt <> 0) |- (continuity_pt _ _) => intro_hyp_pt X1 pt; intro_hyp_pt X2 pt | _:(aux pt <> 0) |- (derive_pt _ _ _ = _) => intro_hyp_pt X1 pt; intro_hyp_pt X2 pt | id:(forall x0:R, aux x0 <> 0) |- (derivable_pt _ _) => generalize (id pt); intro; intro_hyp_pt X1 pt; intro_hyp_pt X2 pt | id:(forall x0:R, aux x0 <> 0) |- (continuity_pt _ _) => generalize (id pt); intro; intro_hyp_pt X1 pt; intro_hyp_pt X2 pt | id:(forall x0:R, aux x0 <> 0) |- (derive_pt _ _ _ = _) => generalize (id pt); intro; intro_hyp_pt X1 pt; intro_hyp_pt X2 pt | |- (derivable_pt _ _) => cut (aux pt <> 0); [ intro; intro_hyp_pt X1 pt; intro_hyp_pt X2 pt | try assumption ] | |- (continuity_pt _ _) => cut (aux pt <> 0); [ intro; intro_hyp_pt X1 pt; intro_hyp_pt X2 pt | try assumption ] | |- (derive_pt _ _ _ = _) => cut (aux pt <> 0); [ intro; intro_hyp_pt X1 pt; intro_hyp_pt X2 pt | try assumption ] | _ => idtac end | (comp ?X1 ?X2) => match goal with | |- (derivable_pt _ _) => let pt_f1 := eval cbv beta in (X2 pt) in (intro_hyp_pt X1 pt_f1; intro_hyp_pt X2 pt) | |- (continuity_pt _ _) => let pt_f1 := eval cbv beta in (X2 pt) in (intro_hyp_pt X1 pt_f1; intro_hyp_pt X2 pt) | |- (derive_pt _ _ _ = _) => let pt_f1 := eval cbv beta in (X2 pt) in (intro_hyp_pt X1 pt_f1; intro_hyp_pt X2 pt) | _ => idtac end | (- ?X1)%F => match goal with | |- (derivable_pt _ _) => intro_hyp_pt X1 pt | |- (continuity_pt _ _) => intro_hyp_pt X1 pt | |- (derive_pt _ _ _ = _) => intro_hyp_pt X1 pt | _ => idtac end | (/ ?X1)%F => let aux := constr:(X1) in match goal with | _:(aux pt <> 0) |- (derivable_pt _ _) => intro_hyp_pt X1 pt | _:(aux pt <> 0) |- (continuity_pt _ _) => intro_hyp_pt X1 pt | _:(aux pt <> 0) |- (derive_pt _ _ _ = _) => intro_hyp_pt X1 pt | id:(forall x0:R, aux x0 <> 0) |- (derivable_pt _ _) => generalize (id pt); intro; intro_hyp_pt X1 pt | id:(forall x0:R, aux x0 <> 0) |- (continuity_pt _ _) => generalize (id pt); intro; intro_hyp_pt X1 pt | id:(forall x0:R, aux x0 <> 0) |- (derive_pt _ _ _ = _) => generalize (id pt); intro; intro_hyp_pt X1 pt | |- (derivable_pt _ _) => cut (aux pt <> 0); [ intro; intro_hyp_pt X1 pt | try assumption ] | |- (continuity_pt _ _) => cut (aux pt <> 0); [ intro; intro_hyp_pt X1 pt | try assumption ] | |- (derive_pt _ _ _ = _) => cut (aux pt <> 0); [ intro; intro_hyp_pt X1 pt | try assumption ] | _ => idtac end | cos => idtac | sin => idtac | cosh => idtac | sinh => idtac | exp => idtac | Rsqr => idtac | id => idtac | (fct_cte _) => idtac | (pow_fct _) => idtac | sqrt => match goal with | |- (derivable_pt _ _) => cut (0 < pt); [ intro | try assumption ] | |- (continuity_pt _ _) => cut (0 <= pt); [ intro | try assumption ] | |- (derive_pt _ _ _ = _) => cut (0 < pt); [ intro | try assumption ] | _ => idtac end | Rabs => match goal with | |- (derivable_pt _ _) => cut (pt <> 0); [ intro | try assumption ] | _ => idtac end | ?X1 => let p := constr:(X1) in let HYPPD := fresh "HYPPD" in match goal with | _:(derivable_pt p pt) |- _ => idtac | |- (derivable_pt p pt) => idtac | |- (derivable_pt _ _) => cut (True -> derivable_pt p pt); [ intro HYPPD; cut (derivable_pt p pt); [ intro; clear HYPPD | apply HYPPD; clear HYPPD; trivial ] | idtac ] | _:(continuity_pt p pt) |- _ => idtac | |- (continuity_pt p pt) => idtac | |- (continuity_pt _ _) => cut (True -> continuity_pt p pt); [ intro HYPPD; cut (continuity_pt p pt); [ intro; clear HYPPD | apply HYPPD; clear HYPPD; trivial ] | idtac ] | |- (derive_pt _ _ _ = _) => cut (True -> derivable_pt p pt); [ intro HYPPD; cut (derivable_pt p pt); [ intro; clear HYPPD | apply HYPPD; clear HYPPD; trivial ] | idtac ] | _ => idtac end end. (**********) Ltac is_diff_pt := match goal with | |- (derivable_pt Rsqr _) => (* fonctions de base *) apply derivable_pt_Rsqr | |- (derivable_pt id ?X1) => apply (derivable_pt_id X1) | |- (derivable_pt (fct_cte _) _) => apply derivable_pt_const | |- (derivable_pt sin _) => apply derivable_pt_sin | |- (derivable_pt cos _) => apply derivable_pt_cos | |- (derivable_pt sinh _) => apply derivable_pt_sinh | |- (derivable_pt cosh _) => apply derivable_pt_cosh | |- (derivable_pt exp _) => apply derivable_pt_exp | |- (derivable_pt (pow_fct _) _) => unfold pow_fct in |- *; apply derivable_pt_pow | |- (derivable_pt sqrt ?X1) => apply (derivable_pt_sqrt X1); assumption || unfold plus_fct, minus_fct, opp_fct, mult_fct, div_fct, inv_fct, comp, id, fct_cte, pow_fct in |- * | |- (derivable_pt Rabs ?X1) => apply (Rderivable_pt_abs X1); assumption || unfold plus_fct, minus_fct, opp_fct, mult_fct, div_fct, inv_fct, comp, id, fct_cte, pow_fct in |- * (* regles de differentiabilite *) (* PLUS *) | |- (derivable_pt (?X1 + ?X2) ?X3) => apply (derivable_pt_plus X1 X2 X3); is_diff_pt (* MOINS *) | |- (derivable_pt (?X1 - ?X2) ?X3) => apply (derivable_pt_minus X1 X2 X3); is_diff_pt (* OPPOSE *) | |- (derivable_pt (- ?X1) ?X2) => apply (derivable_pt_opp X1 X2); is_diff_pt (* MULTIPLICATION PAR UN SCALAIRE *) | |- (derivable_pt (mult_real_fct ?X1 ?X2) ?X3) => apply (derivable_pt_scal X2 X1 X3); is_diff_pt (* MULTIPLICATION *) | |- (derivable_pt (?X1 * ?X2) ?X3) => apply (derivable_pt_mult X1 X2 X3); is_diff_pt (* DIVISION *) | |- (derivable_pt (?X1 / ?X2) ?X3) => apply (derivable_pt_div X1 X2 X3); [ is_diff_pt | is_diff_pt | try assumption || unfold plus_fct, mult_fct, div_fct, minus_fct, opp_fct, inv_fct, comp, pow_fct, id, fct_cte in |- * ] | |- (derivable_pt (/ ?X1) ?X2) => (* INVERSION *) apply (derivable_pt_inv X1 X2); [ assumption || unfold plus_fct, mult_fct, div_fct, minus_fct, opp_fct, inv_fct, comp, pow_fct, id, fct_cte in |- * | is_diff_pt ] | |- (derivable_pt (comp ?X1 ?X2) ?X3) => (* COMPOSITION *) apply (derivable_pt_comp X2 X1 X3); is_diff_pt | _:(derivable_pt ?X1 ?X2) |- (derivable_pt ?X1 ?X2) => assumption | _:(derivable ?X1) |- (derivable_pt ?X1 ?X2) => let HypDDPT := fresh "HypDDPT" in cut (derivable X1); [ intro HypDDPT; apply HypDDPT | assumption ] | |- (True -> derivable_pt _ _) => let HypTruE := fresh "HypTruE" in intro HypTruE; clear HypTruE; is_diff_pt | _ => try unfold plus_fct, mult_fct, div_fct, minus_fct, opp_fct, inv_fct, id, fct_cte, comp, pow_fct in |- * end. (**********) Ltac is_diff_glob := match goal with | |- (derivable Rsqr) => (* fonctions de base *) apply derivable_Rsqr | |- (derivable id) => apply derivable_id | |- (derivable (fct_cte _)) => apply derivable_const | |- (derivable sin) => apply derivable_sin | |- (derivable cos) => apply derivable_cos | |- (derivable cosh) => apply derivable_cosh | |- (derivable sinh) => apply derivable_sinh | |- (derivable exp) => apply derivable_exp | |- (derivable (pow_fct _)) => unfold pow_fct in |- *; apply derivable_pow (* regles de differentiabilite *) (* PLUS *) | |- (derivable (?X1 + ?X2)) => apply (derivable_plus X1 X2); is_diff_glob (* MOINS *) | |- (derivable (?X1 - ?X2)) => apply (derivable_minus X1 X2); is_diff_glob (* OPPOSE *) | |- (derivable (- ?X1)) => apply (derivable_opp X1); is_diff_glob (* MULTIPLICATION PAR UN SCALAIRE *) | |- (derivable (mult_real_fct ?X1 ?X2)) => apply (derivable_scal X2 X1); is_diff_glob (* MULTIPLICATION *) | |- (derivable (?X1 * ?X2)) => apply (derivable_mult X1 X2); is_diff_glob (* DIVISION *) | |- (derivable (?X1 / ?X2)) => apply (derivable_div X1 X2); [ is_diff_glob | is_diff_glob | try assumption || unfold plus_fct, mult_fct, div_fct, minus_fct, opp_fct, inv_fct, id, fct_cte, comp, pow_fct in |- * ] | |- (derivable (/ ?X1)) => (* INVERSION *) apply (derivable_inv X1); [ try assumption || unfold plus_fct, mult_fct, div_fct, minus_fct, opp_fct, inv_fct, id, fct_cte, comp, pow_fct in |- * | is_diff_glob ] | |- (derivable (comp sqrt _)) => (* COMPOSITION *) unfold derivable in |- *; intro; try is_diff_pt | |- (derivable (comp Rabs _)) => unfold derivable in |- *; intro; try is_diff_pt | |- (derivable (comp ?X1 ?X2)) => apply (derivable_comp X2 X1); is_diff_glob | _:(derivable ?X1) |- (derivable ?X1) => assumption | |- (True -> derivable _) => let HypTruE := fresh "HypTruE" in intro HypTruE; clear HypTruE; is_diff_glob | _ => try unfold plus_fct, mult_fct, div_fct, minus_fct, opp_fct, inv_fct, id, fct_cte, comp, pow_fct in |- * end. (**********) Ltac is_cont_pt := match goal with | |- (continuity_pt Rsqr _) => (* fonctions de base *) apply derivable_continuous_pt; apply derivable_pt_Rsqr | |- (continuity_pt id ?X1) => apply derivable_continuous_pt; apply (derivable_pt_id X1) | |- (continuity_pt (fct_cte _) _) => apply derivable_continuous_pt; apply derivable_pt_const | |- (continuity_pt sin _) => apply derivable_continuous_pt; apply derivable_pt_sin | |- (continuity_pt cos _) => apply derivable_continuous_pt; apply derivable_pt_cos | |- (continuity_pt sinh _) => apply derivable_continuous_pt; apply derivable_pt_sinh | |- (continuity_pt cosh _) => apply derivable_continuous_pt; apply derivable_pt_cosh | |- (continuity_pt exp _) => apply derivable_continuous_pt; apply derivable_pt_exp | |- (continuity_pt (pow_fct _) _) => unfold pow_fct in |- *; apply derivable_continuous_pt; apply derivable_pt_pow | |- (continuity_pt sqrt ?X1) => apply continuity_pt_sqrt; assumption || unfold plus_fct, minus_fct, opp_fct, mult_fct, div_fct, inv_fct, comp, id, fct_cte, pow_fct in |- * | |- (continuity_pt Rabs ?X1) => apply (Rcontinuity_abs X1) (* regles de differentiabilite *) (* PLUS *) | |- (continuity_pt (?X1 + ?X2) ?X3) => apply (continuity_pt_plus X1 X2 X3); is_cont_pt (* MOINS *) | |- (continuity_pt (?X1 - ?X2) ?X3) => apply (continuity_pt_minus X1 X2 X3); is_cont_pt (* OPPOSE *) | |- (continuity_pt (- ?X1) ?X2) => apply (continuity_pt_opp X1 X2); is_cont_pt (* MULTIPLICATION PAR UN SCALAIRE *) | |- (continuity_pt (mult_real_fct ?X1 ?X2) ?X3) => apply (continuity_pt_scal X2 X1 X3); is_cont_pt (* MULTIPLICATION *) | |- (continuity_pt (?X1 * ?X2) ?X3) => apply (continuity_pt_mult X1 X2 X3); is_cont_pt (* DIVISION *) | |- (continuity_pt (?X1 / ?X2) ?X3) => apply (continuity_pt_div X1 X2 X3); [ is_cont_pt | is_cont_pt | try assumption || unfold plus_fct, mult_fct, div_fct, minus_fct, opp_fct, inv_fct, comp, id, fct_cte, pow_fct in |- * ] | |- (continuity_pt (/ ?X1) ?X2) => (* INVERSION *) apply (continuity_pt_inv X1 X2); [ is_cont_pt | assumption || unfold plus_fct, mult_fct, div_fct, minus_fct, opp_fct, inv_fct, comp, id, fct_cte, pow_fct in |- * ] | |- (continuity_pt (comp ?X1 ?X2) ?X3) => (* COMPOSITION *) apply (continuity_pt_comp X2 X1 X3); is_cont_pt | _:(continuity_pt ?X1 ?X2) |- (continuity_pt ?X1 ?X2) => assumption | _:(continuity ?X1) |- (continuity_pt ?X1 ?X2) => let HypDDPT := fresh "HypDDPT" in cut (continuity X1); [ intro HypDDPT; apply HypDDPT | assumption ] | _:(derivable_pt ?X1 ?X2) |- (continuity_pt ?X1 ?X2) => apply derivable_continuous_pt; assumption | _:(derivable ?X1) |- (continuity_pt ?X1 ?X2) => let HypDDPT := fresh "HypDDPT" in cut (continuity X1); [ intro HypDDPT; apply HypDDPT | apply derivable_continuous; assumption ] | |- (True -> continuity_pt _ _) => let HypTruE := fresh "HypTruE" in intro HypTruE; clear HypTruE; is_cont_pt | _ => try unfold plus_fct, mult_fct, div_fct, minus_fct, opp_fct, inv_fct, id, fct_cte, comp, pow_fct in |- * end. (**********) Ltac is_cont_glob := match goal with | |- (continuity Rsqr) => (* fonctions de base *) apply derivable_continuous; apply derivable_Rsqr | |- (continuity id) => apply derivable_continuous; apply derivable_id | |- (continuity (fct_cte _)) => apply derivable_continuous; apply derivable_const | |- (continuity sin) => apply derivable_continuous; apply derivable_sin | |- (continuity cos) => apply derivable_continuous; apply derivable_cos | |- (continuity exp) => apply derivable_continuous; apply derivable_exp | |- (continuity (pow_fct _)) => unfold pow_fct in |- *; apply derivable_continuous; apply derivable_pow | |- (continuity sinh) => apply derivable_continuous; apply derivable_sinh | |- (continuity cosh) => apply derivable_continuous; apply derivable_cosh | |- (continuity Rabs) => apply Rcontinuity_abs (* regles de continuite *) (* PLUS *) | |- (continuity (?X1 + ?X2)) => apply (continuity_plus X1 X2); try is_cont_glob || assumption (* MOINS *) | |- (continuity (?X1 - ?X2)) => apply (continuity_minus X1 X2); try is_cont_glob || assumption (* OPPOSE *) | |- (continuity (- ?X1)) => apply (continuity_opp X1); try is_cont_glob || assumption (* INVERSE *) | |- (continuity (/ ?X1)) => apply (continuity_inv X1); try is_cont_glob || assumption (* MULTIPLICATION PAR UN SCALAIRE *) | |- (continuity (mult_real_fct ?X1 ?X2)) => apply (continuity_scal X2 X1); try is_cont_glob || assumption (* MULTIPLICATION *) | |- (continuity (?X1 * ?X2)) => apply (continuity_mult X1 X2); try is_cont_glob || assumption (* DIVISION *) | |- (continuity (?X1 / ?X2)) => apply (continuity_div X1 X2); [ try is_cont_glob || assumption | try is_cont_glob || assumption | try assumption || unfold plus_fct, mult_fct, div_fct, minus_fct, opp_fct, inv_fct, id, fct_cte, pow_fct in |- * ] | |- (continuity (comp sqrt _)) => (* COMPOSITION *) unfold continuity_pt in |- *; intro; try is_cont_pt | |- (continuity (comp ?X1 ?X2)) => apply (continuity_comp X2 X1); try is_cont_glob || assumption | _:(continuity ?X1) |- (continuity ?X1) => assumption | |- (True -> continuity _) => let HypTruE := fresh "HypTruE" in intro HypTruE; clear HypTruE; is_cont_glob | _:(derivable ?X1) |- (continuity ?X1) => apply derivable_continuous; assumption | _ => try unfold plus_fct, mult_fct, div_fct, minus_fct, opp_fct, inv_fct, id, fct_cte, comp, pow_fct in |- * end. (**********) Ltac rew_term trm := match constr:(trm) with | (?X1 + ?X2) => let p1 := rew_term X1 with p2 := rew_term X2 in match constr:(p1) with | (fct_cte ?X3) => match constr:(p2) with | (fct_cte ?X4) => constr:(fct_cte (X3 + X4)) | _ => constr:((p1 + p2)%F) end | _ => constr:((p1 + p2)%F) end | (?X1 - ?X2) => let p1 := rew_term X1 with p2 := rew_term X2 in match constr:(p1) with | (fct_cte ?X3) => match constr:(p2) with | (fct_cte ?X4) => constr:(fct_cte (X3 - X4)) | _ => constr:((p1 - p2)%F) end | _ => constr:((p1 - p2)%F) end | (?X1 / ?X2) => let p1 := rew_term X1 with p2 := rew_term X2 in match constr:(p1) with | (fct_cte ?X3) => match constr:(p2) with | (fct_cte ?X4) => constr:(fct_cte (X3 / X4)) | _ => constr:((p1 / p2)%F) end | _ => match constr:(p2) with | (fct_cte ?X4) => constr:((p1 * fct_cte (/ X4))%F) | _ => constr:((p1 / p2)%F) end end | (?X1 * / ?X2) => let p1 := rew_term X1 with p2 := rew_term X2 in match constr:(p1) with | (fct_cte ?X3) => match constr:(p2) with | (fct_cte ?X4) => constr:(fct_cte (X3 / X4)) | _ => constr:((p1 / p2)%F) end | _ => match constr:(p2) with | (fct_cte ?X4) => constr:((p1 * fct_cte (/ X4))%F) | _ => constr:((p1 / p2)%F) end end | (?X1 * ?X2) => let p1 := rew_term X1 with p2 := rew_term X2 in match constr:(p1) with | (fct_cte ?X3) => match constr:(p2) with | (fct_cte ?X4) => constr:(fct_cte (X3 * X4)) | _ => constr:((p1 * p2)%F) end | _ => constr:((p1 * p2)%F) end | (- ?X1) => let p := rew_term X1 in match constr:(p) with | (fct_cte ?X2) => constr:(fct_cte (- X2)) | _ => constr:((- p)%F) end | (/ ?X1) => let p := rew_term X1 in match constr:(p) with | (fct_cte ?X2) => constr:(fct_cte (/ X2)) | _ => constr:((/ p)%F) end | (?X1 AppVar) => constr:(X1) | (?X1 ?X2) => let p := rew_term X2 in match constr:(p) with | (fct_cte ?X3) => constr:(fct_cte (X1 X3)) | _ => constr:(comp X1 p) end | AppVar => constr:(id) | (AppVar ^ ?X1) => constr:(pow_fct X1) | (?X1 ^ ?X2) => let p := rew_term X1 in match constr:(p) with | (fct_cte ?X3) => constr:(fct_cte (pow_fct X2 X3)) | _ => constr:(comp (pow_fct X2) p) end | ?X1 => constr:(fct_cte X1) end. (**********) Ltac deriv_proof trm pt := match constr:(trm) with | (?X1 + ?X2)%F => let p1 := deriv_proof X1 pt with p2 := deriv_proof X2 pt in constr:(derivable_pt_plus X1 X2 pt p1 p2) | (?X1 - ?X2)%F => let p1 := deriv_proof X1 pt with p2 := deriv_proof X2 pt in constr:(derivable_pt_minus X1 X2 pt p1 p2) | (?X1 * ?X2)%F => let p1 := deriv_proof X1 pt with p2 := deriv_proof X2 pt in constr:(derivable_pt_mult X1 X2 pt p1 p2) | (?X1 / ?X2)%F => match goal with | id:(?X2 pt <> 0) |- _ => let p1 := deriv_proof X1 pt with p2 := deriv_proof X2 pt in constr:(derivable_pt_div X1 X2 pt p1 p2 id) | _ => constr:(False) end | (/ ?X1)%F => match goal with | id:(?X1 pt <> 0) |- _ => let p1 := deriv_proof X1 pt in constr:(derivable_pt_inv X1 pt p1 id) | _ => constr:(False) end | (comp ?X1 ?X2) => let pt_f1 := eval cbv beta in (X2 pt) in let p1 := deriv_proof X1 pt_f1 with p2 := deriv_proof X2 pt in constr:(derivable_pt_comp X2 X1 pt p2 p1) | (- ?X1)%F => let p1 := deriv_proof X1 pt in constr:(derivable_pt_opp X1 pt p1) | sin => constr:(derivable_pt_sin pt) | cos => constr:(derivable_pt_cos pt) | sinh => constr:(derivable_pt_sinh pt) | cosh => constr:(derivable_pt_cosh pt) | exp => constr:(derivable_pt_exp pt) | id => constr:(derivable_pt_id pt) | Rsqr => constr:(derivable_pt_Rsqr pt) | sqrt => match goal with | id:(0 < pt) |- _ => constr:(derivable_pt_sqrt pt id) | _ => constr:(False) end | (fct_cte ?X1) => constr:(derivable_pt_const X1 pt) | ?X1 => let aux := constr:(X1) in match goal with | id:(derivable_pt aux pt) |- _ => constr:(id) | id:(derivable aux) |- _ => constr:(id pt) | _ => constr:(False) end end. (**********) Ltac simplify_derive trm pt := match constr:(trm) with | (?X1 + ?X2)%F => try rewrite derive_pt_plus; simplify_derive X1 pt; simplify_derive X2 pt | (?X1 - ?X2)%F => try rewrite derive_pt_minus; simplify_derive X1 pt; simplify_derive X2 pt | (?X1 * ?X2)%F => try rewrite derive_pt_mult; simplify_derive X1 pt; simplify_derive X2 pt | (?X1 / ?X2)%F => try rewrite derive_pt_div; simplify_derive X1 pt; simplify_derive X2 pt | (comp ?X1 ?X2) => let pt_f1 := eval cbv beta in (X2 pt) in (try rewrite derive_pt_comp; simplify_derive X1 pt_f1; simplify_derive X2 pt) | (- ?X1)%F => try rewrite derive_pt_opp; simplify_derive X1 pt | (/ ?X1)%F => try rewrite derive_pt_inv; simplify_derive X1 pt | (fct_cte ?X1) => try rewrite derive_pt_const | id => try rewrite derive_pt_id | sin => try rewrite derive_pt_sin | cos => try rewrite derive_pt_cos | sinh => try rewrite derive_pt_sinh | cosh => try rewrite derive_pt_cosh | exp => try rewrite derive_pt_exp | Rsqr => try rewrite derive_pt_Rsqr | sqrt => try rewrite derive_pt_sqrt | ?X1 => let aux := constr:(X1) in match goal with | id:(derive_pt aux pt ?X2 = _),H:(derivable aux) |- _ => try replace (derive_pt aux pt (H pt)) with (derive_pt aux pt X2); [ rewrite id | apply pr_nu ] | id:(derive_pt aux pt ?X2 = _),H:(derivable_pt aux pt) |- _ => try replace (derive_pt aux pt H) with (derive_pt aux pt X2); [ rewrite id | apply pr_nu ] | _ => idtac end | _ => idtac end. (**********) Ltac reg := match goal with | |- (derivable_pt ?X1 ?X2) => let trm := eval cbv beta in (X1 AppVar) in let aux := rew_term trm in (intro_hyp_pt aux X2; try (change (derivable_pt aux X2) in |- *; is_diff_pt) || is_diff_pt) | |- (derivable ?X1) => let trm := eval cbv beta in (X1 AppVar) in let aux := rew_term trm in (intro_hyp_glob aux; try (change (derivable aux) in |- *; is_diff_glob) || is_diff_glob) | |- (continuity ?X1) => let trm := eval cbv beta in (X1 AppVar) in let aux := rew_term trm in (intro_hyp_glob aux; try (change (continuity aux) in |- *; is_cont_glob) || is_cont_glob) | |- (continuity_pt ?X1 ?X2) => let trm := eval cbv beta in (X1 AppVar) in let aux := rew_term trm in (intro_hyp_pt aux X2; try (change (continuity_pt aux X2) in |- *; is_cont_pt) || is_cont_pt) | |- (derive_pt ?X1 ?X2 ?X3 = ?X4) => let trm := eval cbv beta in (X1 AppVar) in let aux := rew_term trm in intro_hyp_pt aux X2; (let aux2 := deriv_proof aux X2 in try (replace (derive_pt X1 X2 X3) with (derive_pt aux X2 aux2); [ simplify_derive aux X2; try unfold plus_fct, minus_fct, mult_fct, div_fct, id, fct_cte, inv_fct, opp_fct in |- *; ring || ring_simplify | try apply pr_nu ]) || is_diff_pt) end. coq-8.20.0/theories/Reals/Ratan.v000066400000000000000000002206661466560755400165450ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* 0 <= x <= 1. Proof. unfold Boule, posreal_half; simpl. intros x b; apply Rabs_def2 in b; destruct b; split; lra. Qed. Lemma Boule_lt : forall c r x, Boule c r x -> Rabs x < Rabs c + r. Proof. unfold Boule; intros c r x h. apply Rabs_def2 in h; destruct h; apply Rabs_def1; (destruct (Rle_lt_dec 0 c);[rewrite Rabs_pos_eq; lra | rewrite <- Rabs_Ropp, Rabs_pos_eq; lra]). Qed. (* The following lemma does not belong here. *) Lemma Un_cv_ext : forall un vn, (forall n, un n = vn n) -> forall l, Un_cv un l -> Un_cv vn l. Proof. intros un vn quv l P eps ep; destruct (P eps ep) as [N Pn]; exists N. intro n; rewrite <- quv; apply Pn. Qed. (* The following two lemmas are general purposes about alternated series. They do not belong here. *) Lemma Alt_first_term_bound : forall f l N n, Un_decreasing f -> Un_cv f 0 -> Un_cv (sum_f_R0 (tg_alt f)) l -> (N <= n)%nat -> Rdist (sum_f_R0 (tg_alt f) n) l <= f N. Proof. intros f l. assert (WLOG : forall n P, (forall k, (0 < k)%nat -> P k) -> ((forall k, (0 < k)%nat -> P k) -> P 0%nat) -> P n). { clear. intros [ | n] P Hs Ho;[solve[apply Ho, Hs] | apply Hs; auto with arith]. } intros N; pattern N; apply WLOG; clear N. 2:{ clear WLOG; intros Hyp [ | n] decr to0 cv _. { generalize (alternated_series_ineq f l 0 decr to0 cv). unfold Rdist, tg_alt; simpl; rewrite !Rmult_1_l, !Rmult_1_r. assert (f 1%nat <= f 0%nat) by apply decr. intros [A B]; rewrite Rabs_pos_eq; lra. } apply Rle_trans with (f 1%nat). { apply (Hyp 1%nat (le_n 1) (S n) decr to0 cv). lia. } solve[apply decr]. } intros [ | N] Npos n decr to0 cv nN. { lia. } assert (decr' : Un_decreasing (fun i => f (S N + i)%nat)). { intros k; replace (S N+S k)%nat with (S (S N+k)) by ring. apply (decr (S N + k)%nat). } assert (to' : Un_cv (fun i => f (S N + i)%nat) 0). { intros eps ep; destruct (to0 eps ep) as [M PM]. exists M; intros k kM; apply PM; lia. } assert (cv' : Un_cv (sum_f_R0 (tg_alt (fun i => ((-1) ^ S N * f(S N + i)%nat)))) (l - sum_f_R0 (tg_alt f) N)). { intros eps ep; destruct (cv eps ep) as [M PM]; exists M. intros n' nM. match goal with |- ?C => set (U := C) end. assert (nM' : (n' + S N >= M)%nat) by lia. generalize (PM _ nM'); unfold Rdist. rewrite (tech2 (tg_alt f) N (n' + S N)). 2:lia. assert (t : forall a b c, (a + b) - c = b - (c - a)) by (intros; ring). rewrite t; clear t; unfold U, Rdist; clear U. replace (n' + S N - S N)%nat with n' by lia. rewrite <- (sum_eq (tg_alt (fun i => (-1) ^ S N * f(S N + i)%nat))). { tauto. } intros i _; unfold tg_alt. rewrite <- Rmult_assoc, <- pow_add, !(Nat.add_comm i); reflexivity. } assert (cv'' : Un_cv (sum_f_R0 (tg_alt (fun i => f (S N + i)%nat))) ((-1) ^ S N * (l - sum_f_R0 (tg_alt f) N))). { apply (Un_cv_ext (fun n => (-1) ^ S N * sum_f_R0 (tg_alt (fun i : nat => (-1) ^ S N * f (S N + i)%nat)) n)). { intros n0; rewrite scal_sum; apply sum_eq; intros i _. unfold tg_alt; ring_simplify; replace (((-1) ^ S N) ^ 2) with 1. { ring. } rewrite <- pow_mult, Nat.mul_comm, pow_mult; replace ((-1) ^2) with 1 by ring. rewrite pow1; reflexivity. } apply CV_mult. { solve[intros eps ep; exists 0%nat; intros; rewrite Rdist_eq; auto]. } assumption. } destruct (even_odd_cor N) as [p [Neven | Nodd]]. - rewrite Neven; destruct (alternated_series_ineq _ _ p decr to0 cv) as [B C]. case (even_odd_cor n) as [p' [neven | nodd]]. + rewrite neven. destruct (alternated_series_ineq _ _ p' decr to0 cv) as [D E]. unfold Rdist; rewrite Rabs_pos_eq;[ | lra]. assert (dist : (p <= p')%nat) by lia. assert (t := decreasing_prop _ _ _ (CV_ALT_step1 f decr) dist). apply Rle_trans with (sum_f_R0 (tg_alt f) (2 * p) - l). { unfold Rminus; apply Rplus_le_compat_r; exact t. } match goal with _ : ?a <= l, _ : l <= ?b |- _ => replace (f (S (2 * p))) with (b - a) by (rewrite tech5; unfold tg_alt; rewrite pow_1_odd; ring); lra end. + rewrite nodd; destruct (alternated_series_ineq _ _ p' decr to0 cv) as [D E]. unfold Rdist; rewrite <- Rabs_Ropp, Rabs_pos_eq, Ropp_minus_distr; [ | lra]. assert (dist : (p <= p')%nat) by lia. apply Rle_trans with (l - sum_f_R0 (tg_alt f) (S (2 * p))). { unfold Rminus; apply Rplus_le_compat_l, Ropp_le_contravar. solve[apply Rge_le, (growing_prop _ _ _ (CV_ALT_step0 f decr) dist)]. } unfold Rminus; rewrite tech5, Ropp_plus_distr, <- Rplus_assoc. unfold tg_alt at 2; rewrite pow_1_odd; lra. - rewrite Nodd; destruct (alternated_series_ineq _ _ p decr to0 cv) as [B _]. destruct (alternated_series_ineq _ _ (S p) decr to0 cv) as [_ C]. assert (keep : (2 * S p = S (S ( 2 * p)))%nat) by ring. case (even_odd_cor n) as [p' [neven | nodd]]. + rewrite neven; destruct (alternated_series_ineq _ _ p' decr to0 cv) as [D E]. unfold Rdist; rewrite Rabs_pos_eq;[ | lra]. assert (dist : (S p < S p')%nat) by lia. apply Rle_trans with (sum_f_R0 (tg_alt f) (2 * S p) - l). { unfold Rminus; apply Rplus_le_compat_r, (decreasing_prop _ _ _ (CV_ALT_step1 f decr)). lia. } rewrite keep, tech5; unfold tg_alt at 2; rewrite <- keep, pow_1_even. lra. + rewrite nodd; destruct (alternated_series_ineq _ _ p' decr to0 cv) as [D E]. unfold Rdist; rewrite <- Rabs_Ropp, Rabs_pos_eq;[ | lra]. rewrite Ropp_minus_distr. apply Rle_trans with (l - sum_f_R0 (tg_alt f) (S (2 * p))). { unfold Rminus; apply Rplus_le_compat_l, Ropp_le_contravar, Rge_le, (growing_prop _ _ _ (CV_ALT_step0 f decr)); lia. } generalize C; rewrite keep, tech5; unfold tg_alt. rewrite <- keep, pow_1_even. lra. Qed. Lemma Alt_CVU : forall (f : nat -> R -> R) g h c r, (forall x, Boule c r x ->Un_decreasing (fun n => f n x)) -> (forall x, Boule c r x -> Un_cv (fun n => f n x) 0) -> (forall x, Boule c r x -> Un_cv (sum_f_R0 (tg_alt (fun i => f i x))) (g x)) -> (forall x n, Boule c r x -> f n x <= h n) -> (Un_cv h 0) -> CVU (fun N x => sum_f_R0 (tg_alt (fun i => f i x)) N) g c r. Proof. intros f g h c r decr to0 to_g bound bound0 eps ep. assert (ep' : 0 f i y) (g y) n n); auto]. } apply Rle_lt_trans with (h n). { apply bound; assumption. } clear - nN Pn. generalize (Pn _ nN); unfold Rdist; rewrite Rminus_0_r; intros t. apply Rabs_def2 in t; tauto. Qed. (* The following lemmas are general purpose lemmas about squares. They do not belong here *) Lemma pow2_ge_0 : forall x, 0 <= x^2. Proof. intros x; destruct (Rle_lt_dec 0 x). - replace (x ^ 2) with (x * x) by field. apply Rmult_le_pos; assumption. - replace (x ^ 2) with ((-x) * (-x)) by field. apply Rmult_le_pos; lra. Qed. Lemma pow2_abs : forall x, Rabs x^2 = x^2. Proof. intros x; destruct (Rle_lt_dec 0 x). - rewrite Rabs_pos_eq;[field | assumption]. - rewrite <- Rabs_Ropp, Rabs_pos_eq;[field | lra]. Qed. (** ** Properties of tangent *) (** *** Derivative of tangent *) Lemma derivable_pt_tan : forall x, -PI/2 < x < PI/2 -> derivable_pt tan x. Proof. intros x xint. unfold derivable_pt, tan. apply derivable_pt_div ; [reg | reg | ]. apply Rgt_not_eq. unfold Rgt ; apply cos_gt_0; [unfold Rdiv; rewrite <- Ropp_mult_distr_l_reverse; fold (-PI/2) |];tauto. Qed. Lemma derive_pt_tan : forall x, forall (Pr1: -PI/2 < x < PI/2), derive_pt tan x (derivable_pt_tan x Pr1) = 1 + (tan x)^2. Proof. intros x pr. assert (cos x <> 0). { apply Rgt_not_eq, cos_gt_0; rewrite <- ?Rdiv_opp_l; tauto. } unfold tan; reg; unfold pow, Rsqr; field; assumption. Qed. (** *** Proof that tangent is a bijection *) (* to be removed? *) Lemma derive_increasing_interv : forall (a b : R) (f : R -> R), a < b -> forall (pr:forall x, a < x < b -> derivable_pt f x), (forall t:R, forall (t_encad : a < t < b), 0 < derive_pt f t (pr t t_encad)) -> forall x y:R, a < x < b -> a < y < b -> x < y -> f x < f y. Proof. intros a b f a_lt_b pr Df_gt_0 x y x_encad y_encad x_lt_y. assert (derivable_id_interv : forall c : R, x < c < y -> derivable_pt id c). { intros ; apply derivable_pt_id. } assert (derivable_f_interv : forall c : R, x < c < y -> derivable_pt f c). { intros c c_encad. apply pr. split. { apply Rlt_trans with (r2:=x) ; [exact (proj1 x_encad) | exact (proj1 c_encad)]. } apply Rlt_trans with (r2:=y) ; [exact (proj2 c_encad) | exact (proj2 y_encad)]. } assert (f_cont_interv : forall c : R, x <= c <= y -> continuity_pt f c). { intros c c_encad; apply derivable_continuous_pt ; apply pr. split. { apply Rlt_le_trans with (r2:=x) ; [exact (proj1 x_encad) | exact (proj1 c_encad)]. } apply Rle_lt_trans with (r2:=y) ; [ exact (proj2 c_encad) | exact (proj2 y_encad)]. } assert (id_cont_interv : forall c : R, x <= c <= y -> continuity_pt id c). { intros ; apply derivable_continuous_pt ; apply derivable_pt_id. } elim (MVT f id x y derivable_f_interv derivable_id_interv x_lt_y f_cont_interv id_cont_interv). intros c Temp ; elim Temp ; clear Temp ; intros Pr eq. replace (id y - id x) with (y - x) in eq by intuition. replace (derive_pt id c (derivable_id_interv c Pr)) with 1 in eq. 2:{ symmetry ; rewrite derive_pt_eq ; apply derivable_pt_lim_id. } apply Rminus_gt. rewrite Rmult_1_r in eq. rewrite <- eq. apply Rmult_gt_0_compat. { apply Rgt_minus ; assumption. } assert (c_encad2 : a <= c < b). { split. { apply Rlt_le ; apply Rlt_trans with (r2:=x) ; [exact (proj1 x_encad) | exact (proj1 Pr)]. } apply Rle_lt_trans with (r2:=y) ; [apply Rlt_le ; exact (proj2 Pr) | exact (proj2 y_encad)]. } assert (c_encad : a < c < b). { split. { apply Rlt_trans with (r2:=x) ; [exact (proj1 x_encad) | exact (proj1 Pr)]. } apply Rle_lt_trans with (r2:=y) ; [apply Rlt_le ; exact (proj2 Pr) | exact (proj2 y_encad)]. } rewrite (pr_nu f c (derivable_f_interv c Pr) (pr c c_encad)). apply (Df_gt_0 c c_encad). Qed. (* begin hide *) Lemma plus_Rsqr_gt_0 : forall x, 1 + x ^ 2 > 0. Proof. intro m. replace 0 with (0+0) by intuition. apply Rplus_gt_ge_compat. { intuition. } destruct (total_order_T m 0) as [[m_cond|H']|?]. - replace 0 with (0*0) by intuition. replace (m ^ 2) with ((-m)^2). { apply Rle_ge ; apply Rmult_le_compat ; intuition ; apply Rlt_le ; rewrite Rmult_1_r ; intuition. } field. - rewrite H' ; right ; field. - left. intuition. Qed. (* end hide *) (* The following lemmas about PI should probably be in Rtrigo. *) Lemma PI2_lower_bound : forall x, 0 < x < 2 -> 0 < cos x -> x < PI/2. Proof. intros x [xp xlt2] cx. destruct (Rtotal_order x (PI/2)) as [xltpi2 | [xeqpi2 | xgtpi2]]. - assumption. - now case (Rgt_not_eq _ _ cx); rewrite xeqpi2, cos_PI2. - destruct (MVT_cor1 cos (PI/2) x derivable_cos xgtpi2) as [c [Pc [cint1 cint2]]]. revert Pc; rewrite cos_PI2, Rminus_0_r. rewrite <- (pr_nu cos c (derivable_pt_cos c)), derive_pt_cos. assert (0 < c < 2) by (split; assert (t := PI2_RGT_0); lra). assert (0 < sin c) by now apply sin_pos_tech. intros Pc. case (Rlt_not_le _ _ cx). rewrite <- (Rplus_0_l (cos x)), Pc, Ropp_mult_distr_l_reverse. apply Rle_minus, Rmult_le_pos;[apply Rlt_le; assumption | lra ]. Qed. Lemma PI2_3_2 : 3/2 < PI/2. Proof. apply PI2_lower_bound;[split; lra | ]. destruct (pre_cos_bound (3/2) 1) as [t _]; [lra | lra | ]. apply Rlt_le_trans with (2 := t); clear t. unfold cos_approx; simpl; unfold cos_term. rewrite !INR_IZR_INZ. cbv -[IZR]. (* faster than simpl: 0.005s vs 0.2s *) field_simplify. apply Rdiv_lt_0_compat ; now apply IZR_lt. Qed. Lemma PI2_1 : 1 < PI/2. Proof. assert (t := PI2_3_2); lra. Qed. Lemma tan_increasing : forall x y, -PI/2 < x -> x < y -> y < PI/2 -> tan x < tan y. Proof. intros x y Z_le_x x_lt_y y_le_1. assert (x_encad : -PI/2 < x < PI/2). { split ; [assumption | apply Rlt_trans with (r2:=y) ; assumption]. } assert (y_encad : -PI/2 < y < PI/2). { split ; [apply Rlt_trans with (r2:=x) ; intuition | intuition ]. } assert (local_derivable_pt_tan : forall x, -PI/2 < x < PI/2 -> derivable_pt tan x). { intros ; apply derivable_pt_tan ; intuition. } apply derive_increasing_interv with (a:=-PI/2) (b:=PI/2) (pr:=local_derivable_pt_tan) ; intuition. { lra. } assert (Temp := pr_nu tan t (derivable_pt_tan t t_encad) (local_derivable_pt_tan t t_encad)) ; rewrite <- Temp ; clear Temp. assert (Temp := derive_pt_tan t t_encad) ; rewrite Temp ; clear Temp. apply plus_Rsqr_gt_0. Qed. Lemma tan_inj : forall x y, -PI/2 < x < PI/2 -> -PI/2 < y < PI/2 -> tan x = tan y -> x = y. Proof. intros a b a_encad b_encad fa_eq_fb. destruct (total_order_T a b) as [[Hf|?]|Hf]. - assert (Hfalse := tan_increasing a b (proj1 a_encad) Hf (proj2 b_encad)). case (Rlt_not_eq (tan a) (tan b)) ; assumption. - intuition. - assert (Hfalse := tan_increasing b a (proj1 b_encad) Hf (proj2 a_encad)). case (Rlt_not_eq (tan b) (tan a)) ; [|symmetry] ; assumption. Qed. Notation tan_is_inj := tan_inj (only parsing). (* compat *) Lemma exists_atan_in_frame : forall lb ub y, lb < ub -> -PI/2 < lb -> ub < PI/2 -> tan lb < y < tan ub -> {x | lb < x < ub /\ tan x = y}. Proof. intros lb ub y lb_lt_ub lb_cond ub_cond y_encad. case y_encad ; intros y_encad1 y_encad2. assert (f_cont : forall a : R, lb <= a <= ub -> continuity_pt tan a). { intros a a_encad. apply derivable_continuous_pt ; apply derivable_pt_tan. split. - apply Rlt_le_trans with (r2:=lb) ; intuition. - apply Rle_lt_trans with (r2:=ub) ; intuition. } assert (Cont : forall a : R, lb <= a <= ub -> continuity_pt (fun x => tan x - y) a). { intros a a_encad. unfold continuity_pt, continue_in, limit1_in, limit_in ; simpl ; unfold Rdist. intros eps eps_pos. elim (f_cont a a_encad eps eps_pos). intros alpha alpha_pos. destruct alpha_pos as (alpha_pos,Temp). exists alpha. split. { assumption. } intros x x_cond. replace (tan x - y - (tan a - y)) with (tan x - tan a) by field. exact (Temp x x_cond). } assert (H1 : (fun x => tan x - y) lb < 0). { apply Rlt_minus. assumption. } assert (H2 : 0 < (fun x => tan x - y) ub). { apply Rgt_minus. assumption. } destruct (IVT_interv (fun x => tan x - y) lb ub Cont lb_lt_ub H1 H2) as (x,Hx). exists x. destruct Hx as (Hyp,Result). intuition. - assert (Temp2 : x <> lb). { intro Hfalse. rewrite Hfalse in Result. assert (Temp2 : y <> tan lb) by (now apply Rgt_not_eq, Rlt_minus_0). rewrite Result in H1. now apply (Rlt_irrefl 0). } now case H3; intros hyp; [assumption |]; rewrite hyp in Temp2. - assert (Temp : x <> ub). { intro Hfalse. rewrite Hfalse in Result. assert (Temp2 : y <> tan ub). { apply Rlt_not_eq ; assumption. } clear - Temp2 Result. apply Temp2. symmetry; intuition. } case H4 ; intuition. Qed. (*********************************************************) (** * Definition of arctangent *) (*********************************************************) (** ** Definition of arctangent as the reciprocal function of tangent and proof of this status *) Lemma tan_1_gt_1 : tan 1 > 1. Proof. assert (0 < cos 1) by (apply cos_gt_0; assert (t:=PI2_1); lra). assert (t1 : cos 1 <= 1 - 1/2 + 1/24). { destruct (pre_cos_bound 1 0) as [_ t]; try lra; revert t. unfold cos_approx, cos_term; simpl; intros t; apply Rle_trans with (1:=t). clear t; apply Req_le; field. } assert (t2 : 1 - 1/6 <= sin 1). { destruct (pre_sin_bound 1 0) as [t _]; try lra; revert t. unfold sin_approx, sin_term; simpl; intros t; apply Rle_trans with (2:=t). clear t; apply Req_le; field. } pattern 1 at 2; replace 1 with (cos 1 / cos 1) by (field; apply Rgt_not_eq; lra). apply Rlt_gt; apply (Rmult_lt_compat_r (/ cos 1) (cos 1) (sin 1)). { apply Rinv_0_lt_compat; assumption. } apply Rle_lt_trans with (1 := t1); apply Rlt_le_trans with (2 := t2). lra. Qed. Lemma sin_lt_x x : 0 < x -> sin x < x. Proof. intros. pose proof PI2_1. destruct (SIN_bound x), (Rle_or_lt x (PI / 2)); try lra. pose (f x := x - sin x). cut (f 0 < f x); [now unfold f; rewrite sin_0; lra|]. eapply (MVT.derive_increasing_interv 0 (PI/2) (id - sin)%F); try lra. intros t Ht. rewrite derive_pt_minus, derive_pt_id, derive_pt_sin. pose proof (COS_bound t). pose proof cos_0. pose proof (cos_inj 0 t). lra. Qed. Definition frame_tan y : {x | 0 < x < PI/2 /\ Rabs y < tan x}. Proof. destruct (total_order_T (Rabs y) 1) as [Hs|Hgt]. { assert (yle1 : Rabs y <= 1) by (destruct Hs; lra). clear Hs; exists 1; split;[split; [exact Rlt_0_1 | exact PI2_1] | ]. apply Rle_lt_trans with (1 := yle1); exact tan_1_gt_1. } assert (0 < / (Rabs y + 1)). { apply Rinv_0_lt_compat; lra. } set (u := /2 * / (Rabs y + 1)). assert (0 < u). { apply Rmult_lt_0_compat; [lra | assumption]. } assert (vlt1 : / (Rabs y + 1) < 1). { apply Rmult_lt_reg_r with (Rabs y + 1). { assert (t := Rabs_pos y); lra. } rewrite Rinv_l; [rewrite Rmult_1_l | apply Rgt_not_eq]; lra. } assert (vlt2 : u < 1). { apply Rlt_trans with (/ (Rabs y + 1)). { rewrite <-Rplus_half_diag. assert (t : forall x, 0 < x -> x < x + x) by (clear; intros; lra). unfold u; rewrite Rmult_comm; apply t. unfold Rdiv; rewrite Rmult_comm; assumption. } assumption. } assert(int : 0 < PI / 2 - u < PI / 2). { split. { assert (t := PI2_1); apply Rlt_0_minus, Rlt_trans with (2 := t); assumption. } assert (dumb : forall x y, 0 < y -> x - y < x) by (clear; intros; lra). apply dumb; clear dumb; assumption. } exists (PI/2 - u). assert (0 < sin u). { apply sin_gt_0;[ assumption | ]. assert (t := PI2_Rlt_PI); assert (t' := PI2_1). apply Rlt_trans with (2 := Rlt_trans _ _ _ t' t); assumption. } split. { assumption. } apply Rlt_trans with (/2 * / cos(PI / 2 - u)). - rewrite cos_shift. assert (sin u < u) by (apply sin_lt_x;assumption). apply Rlt_trans with (Rabs y + 1);[lra | ]. rewrite <- (Rinv_inv (Rabs y + 1)). rewrite <- Rinv_mult. apply Rinv_lt_contravar. { apply Rmult_lt_0_compat. { apply Rmult_lt_0_compat;[lra | assumption]. } assumption. } replace (/(Rabs y + 1)) with (2 * u). { lra. } unfold u; field; apply Rgt_not_eq; clear -Hgt; lra. - unfold tan. set (u' := PI / 2); unfold Rdiv; apply Rmult_lt_compat_r; unfold u'. { apply Rinv_0_lt_compat. rewrite cos_shift; assumption. } assert (vlt3 : u < /4). { replace (/4) with (/2 * /2) by field. unfold u; apply Rmult_lt_compat_l;[lra | ]. apply Rinv_lt_contravar;lra. } assert (1 < PI / 2 - u) by (assert (t := PI2_3_2); lra). apply Rlt_trans with (sin 1). { assert (t' : 1 <= 4) by lra. destruct (pre_sin_bound 1 0 (Rlt_le _ _ Rlt_0_1) t') as [t _]. apply Rlt_le_trans with (2 := t); clear t. simpl plus; replace (sin_approx 1 1) with (5/6);[lra | ]. unfold sin_approx, sin_term; simpl; field. } apply sin_increasing_1. + assert (t := PI2_1); lra. + apply Rlt_le, PI2_1. + assert (t := PI2_1); lra. + lra. + assumption. Qed. Lemma ub_opp : forall x, x < PI/2 -> -PI/2 < -x. Proof. intros x h; rewrite Rdiv_opp_l; apply Ropp_lt_contravar; assumption. Qed. Lemma pos_opp_lt : forall x, 0 < x -> -x < x. Proof. intros; lra. Qed. Lemma tech_opp_tan : forall x y, -tan x < y -> tan (-x) < y. Proof. intros; rewrite tan_neg; assumption. Qed. Definition pre_atan (y : R) : {x : R | -PI/2 < x < PI/2 /\ tan x = y}. Proof. destruct (frame_tan y) as [ub [[ub0 ubpi2] Ptan_ub]]. set (pr := (conj (tech_opp_tan _ _ (proj2 (Rabs_def2 _ _ Ptan_ub))) (proj1 (Rabs_def2 _ _ Ptan_ub)))). destruct (exists_atan_in_frame (-ub) ub y (pos_opp_lt _ ub0) (ub_opp _ ubpi2) ubpi2 pr) as [v [[vl vu] vq]]. exists v; clear pr. split;[rewrite Rdiv_opp_l; split; lra | assumption]. Qed. Definition atan x := let (v, _) := pre_atan x in v. Lemma atan_bound : forall x, -PI/2 < atan x < PI/2. Proof. intros x; unfold atan; destruct (pre_atan x) as [v [int _]]; exact int. Qed. Lemma tan_atan : forall x, tan (atan x) = x. Proof. intros x; unfold atan; destruct (pre_atan x) as [v [_ q]]; exact q. Qed. Notation atan_right_inv := tan_atan (only parsing). (* compat *) Lemma atan_opp : forall x, atan (- x) = - atan x. Proof. intros x; generalize (atan_bound (-x)); rewrite Rdiv_opp_l;intros [a b]. generalize (atan_bound x); rewrite Rdiv_opp_l; intros [c d]. apply tan_inj; try rewrite Rdiv_opp_l; try split; try lra. rewrite tan_neg, !tan_atan; reflexivity. Qed. Lemma derivable_pt_atan : forall x, derivable_pt atan x. Proof. intros x. destruct (frame_tan x) as [ub [[ub0 ubpi] P]]. assert (lb_lt_ub : -ub < ub) by apply pos_opp_lt, ub0. assert (xint : tan(-ub) < x < tan ub). { assert (xint' : x < tan ub /\ -(tan ub) < x) by apply Rabs_def2, P. rewrite tan_neg; tauto. } assert (inv_p : forall x, tan(-ub) <= x -> x <= tan ub -> comp tan atan x = id x). { intros; apply tan_atan. } assert (int_tan : forall y, tan (- ub) <= y -> y <= tan ub -> -ub <= atan y <= ub). { clear -ub0 ubpi; intros y lo up; split. { destruct (Rle_lt_dec (-ub) (atan y)) as [h | abs]; auto. assert (y < tan (-ub)). { rewrite <- (tan_atan y); apply tan_increasing. - destruct (atan_bound y); assumption. - assumption. - lra. } lra. } destruct (Rle_lt_dec (atan y) ub) as [h | abs]; auto. assert (tan ub < y). { rewrite <- (tan_atan y); apply tan_increasing. - rewrite Rdiv_opp_l; lra. - assumption. - destruct (atan_bound y); assumption. } lra. } assert (incr : forall x y, -ub <= x -> x < y -> y <= ub -> tan x < tan y). { intros y z l yz u; apply tan_increasing. - rewrite Rdiv_opp_l; lra. - assumption. - lra. } assert (der : forall a, -ub <= a <= ub -> derivable_pt tan a). { intros a [la ua]; apply derivable_pt_tan. rewrite Rdiv_opp_l; split; lra. } assert (df_neq : derive_pt tan (atan x) (derivable_pt_recip_interv_prelim1 tan atan (- ub) ub x lb_lt_ub xint int_tan der) <> 0). { rewrite <- (pr_nu tan (atan x) (derivable_pt_tan (atan x) (atan_bound x))). rewrite derive_pt_tan. solve[apply Rgt_not_eq, plus_Rsqr_gt_0]. } apply (derivable_pt_recip_interv tan atan (-ub) ub x lb_lt_ub xint inv_p int_tan incr der). exact df_neq. Qed. Lemma atan_increasing : forall x y, x < y -> atan x < atan y. Proof. intros x y d. assert (t1 := atan_bound x). assert (t2 := atan_bound y). destruct (Rlt_le_dec (atan x) (atan y)) as [lt | bad]. { assumption. } apply Rlt_not_le in d. case d. rewrite <- (tan_atan y), <- (tan_atan x). destruct bad as [ylt | yx]. { apply Rlt_le, tan_increasing; try tauto. } solve[rewrite yx; apply Rle_refl]. Qed. Lemma atan_0 : atan 0 = 0. Proof. apply tan_inj; try (apply atan_bound). { assert (t := PI_RGT_0); rewrite Rdiv_opp_l; split; lra. } rewrite tan_atan, tan_0. reflexivity. Qed. Lemma atan_eq0 : forall x, atan x = 0 -> x = 0. Proof. intros x. generalize (atan_increasing 0 x) (atan_increasing x 0). rewrite atan_0. lra. Qed. Lemma atan_1 : atan 1 = PI/4. Proof. assert (ut := PI_RGT_0). assert (-PI/2 < PI/4 < PI/2) by (rewrite Rdiv_opp_l; split; lra). assert (t := atan_bound 1). apply tan_inj; auto. rewrite tan_PI4, tan_atan; reflexivity. Qed. Lemma atan_tan : forall x, - (PI / 2) < x < PI / 2 -> atan (tan x) = x. Proof. intros x xB. apply tan_inj. - now apply atan_bound. - lra. - now apply tan_atan. Qed. Lemma atan_inv : forall x, (0 < x)%R -> atan (/ x) = (PI / 2 - atan x)%R. Proof. intros x Hx. apply tan_inj. - apply atan_bound. - split. + apply Rlt_trans with R0. * unfold Rdiv. rewrite Ropp_mult_distr_l_reverse. apply Ropp_lt_gt_0_contravar. apply PI2_RGT_0. * apply Rgt_minus. apply atan_bound. + apply Rplus_lt_reg_r with (atan x - PI / 2)%R. ring_simplify. rewrite <- atan_0. now apply atan_increasing. - rewrite tan_atan. unfold tan. rewrite sin_shift. rewrite cos_shift. rewrite <- Rinv_div. apply f_equal, sym_eq, tan_atan. Qed. (** ** Derivative of arctangent *) Lemma derive_pt_atan : forall x, derive_pt atan x (derivable_pt_atan x) = 1 / (1 + x²). Proof. intros x. destruct (frame_tan x) as [ub [[ub0 ubpi] Pub]]. assert (lb_lt_ub : -ub < ub) by apply pos_opp_lt, ub0. assert (xint : tan(-ub) < x < tan ub). { assert (xint' : x < tan ub /\ -(tan ub) < x) by apply Rabs_def2, Pub. rewrite tan_neg; tauto. } assert (inv_p : forall x, tan(-ub) <= x -> x <= tan ub -> comp tan atan x = id x). { intros; apply tan_atan. } assert (int_tan : forall y, tan (- ub) <= y -> y <= tan ub -> -ub <= atan y <= ub). { clear -ub0 ubpi; intros y lo up; split. { destruct (Rle_lt_dec (-ub) (atan y)) as [h | abs]; auto. assert (y < tan (-ub)). { rewrite <- (tan_atan y); apply tan_increasing. - destruct (atan_bound y); assumption. - assumption. - lra. } lra. } destruct (Rle_lt_dec (atan y) ub) as [h | abs]; auto. assert (tan ub < y). { rewrite <- (tan_atan y); apply tan_increasing. - rewrite Rdiv_opp_l; lra. - assumption. - destruct (atan_bound y); assumption. } lra. } assert (incr : forall x y, -ub <= x -> x < y -> y <= ub -> tan x < tan y). { intros y z l yz u; apply tan_increasing. - rewrite Rdiv_opp_l; lra. - assumption. - lra. } assert (der : forall a, -ub <= a <= ub -> derivable_pt tan a). { intros a [la ua]; apply derivable_pt_tan. rewrite Rdiv_opp_l; split; lra. } assert (df_neq : derive_pt tan (atan x) (derivable_pt_recip_interv_prelim1 tan atan (- ub) ub x lb_lt_ub xint int_tan der) <> 0). { rewrite <- (pr_nu tan (atan x) (derivable_pt_tan (atan x) (atan_bound x))). rewrite derive_pt_tan. solve[apply Rgt_not_eq, plus_Rsqr_gt_0]. } assert (t := derive_pt_recip_interv tan atan (-ub) ub x lb_lt_ub xint incr int_tan der inv_p df_neq). rewrite <- (pr_nu atan x (derivable_pt_recip_interv tan atan (- ub) ub x lb_lt_ub xint inv_p int_tan incr der df_neq)). rewrite t. assert (t' := atan_bound x). rewrite <- (pr_nu tan (atan x) (derivable_pt_tan _ t')). rewrite derive_pt_tan, tan_atan. replace (Rsqr x) with (x ^ 2) by (unfold Rsqr; ring). reflexivity. Qed. Lemma derivable_pt_lim_atan : forall x, derivable_pt_lim atan x (/ (1 + x^2)). Proof. intros x. apply derive_pt_eq_1 with (derivable_pt_atan x). replace (x ^ 2) with (x * x) by ring. rewrite <- (Rmult_1_l (Rinv _)). apply derive_pt_atan. Qed. (** ** Definition of the arctangent function as the sum of the arctan power series *) (* Proof taken from Guillaume Melquiond's interval package for Coq *) Definition Ratan_seq x := fun n => (x ^ (2 * n + 1) / INR (2 * n + 1))%R. Lemma Ratan_seq_decreasing : forall x, (0 <= x <= 1)%R -> Un_decreasing (Ratan_seq x). Proof. intros x Hx n. unfold Ratan_seq, Rdiv. apply Rmult_le_compat. - apply pow_le. exact (proj1 Hx). - apply Rlt_le. apply Rinv_0_lt_compat. apply lt_INR_0. lia. - destruct (proj1 Hx) as [Hx1|Hx1]. 1:destruct (proj2 Hx) as [Hx2|Hx2]. + (* . 0 < x < 1 *) rewrite <- (Rinv_inv x). repeat rewrite (pow_inv (/ x)). apply Rlt_le. apply Rinv_lt_contravar. { apply Rmult_lt_0_compat ; apply pow_lt ; auto with real. } apply Rlt_pow. { rewrite <- Rinv_1. apply Rinv_lt_contravar. { rewrite Rmult_1_r. exact Hx1. } exact Hx2. } lia. + (* . x = 1 *) rewrite Hx2. do 2 rewrite pow1. apply Rle_refl. + (* . x = 0 *) rewrite <- Hx1. do 2 (rewrite pow_i ; [ idtac | lia ]). apply Rle_refl. - apply Rlt_le. apply Rinv_lt_contravar. { apply Rmult_lt_0_compat ; apply lt_INR_0 ; lia. } apply lt_INR. lia. Qed. Lemma Ratan_seq_converging : forall x, (0 <= x <= 1)%R -> Un_cv (Ratan_seq x) 0. Proof. intros x Hx eps Heps. destruct (archimed (/ eps)) as (HN,_). assert (0 < up (/ eps))%Z. { apply lt_IZR. apply Rlt_trans with (2 := HN). apply Rinv_0_lt_compat. exact Heps. } case_eq (up (/ eps)) ; intros ; rewrite H0 in H ; try discriminate H. rewrite H0 in HN. simpl in HN. pose (N := Pos.to_nat p). fold N in HN. clear H H0. exists N. intros n Hn. unfold Rdist. rewrite Rminus_0_r. unfold Ratan_seq. rewrite Rabs_right. 2:{ apply Rle_ge. unfold Rdiv. apply Rmult_le_pos. { apply pow_le. exact (proj1 Hx). } apply Rlt_le. apply Rinv_0_lt_compat. apply lt_INR_0. lia. } apply Rle_lt_trans with (1 ^ (2 * n + 1) / INR (2 * n + 1))%R. { unfold Rdiv. apply Rmult_le_compat_r. { apply Rlt_le. apply Rinv_0_lt_compat. apply lt_INR_0. lia. } apply pow_incr. exact Hx. } rewrite pow1. apply Rle_lt_trans with (/ INR (2 * N + 1))%R. { unfold Rdiv. rewrite Rmult_1_l. apply Rinv_le_contravar. { apply lt_INR_0. lia. } apply le_INR. lia. } rewrite <- (Rinv_inv eps). apply Rinv_lt_contravar. { apply Rmult_lt_0_compat. { auto with real. } apply lt_INR_0. lia. } apply Rlt_trans with (INR N). { destruct (archimed (/ eps)) as (H,_). assert (0 < up (/ eps))%Z. { apply lt_IZR. apply Rlt_trans with (2 := H). apply Rinv_0_lt_compat. exact Heps. } unfold N. rewrite INR_IZR_INZ, positive_nat_Z. exact HN. } apply lt_INR. lia. Qed. Definition ps_atan_exists_01 (x : R) (Hx:0 <= x <= 1) : {l : R | Un_cv (fun N : nat => sum_f_R0 (tg_alt (Ratan_seq x)) N) l}. Proof. exact (alternated_series (Ratan_seq x) (Ratan_seq_decreasing _ Hx) (Ratan_seq_converging _ Hx)). Defined. Lemma Ratan_seq_opp : forall x n, Ratan_seq (-x) n = -Ratan_seq x n. Proof. intros x n; unfold Ratan_seq. rewrite !pow_add, !pow_mult, !pow_1. unfold Rdiv; replace ((-x) ^ 2) with (x ^ 2) by ring; ring. Qed. Lemma sum_Ratan_seq_opp : forall x n, sum_f_R0 (tg_alt (Ratan_seq (- x))) n = - sum_f_R0 (tg_alt (Ratan_seq x)) n. Proof. intros x n; replace (-sum_f_R0 (tg_alt (Ratan_seq x)) n) with (-1 * sum_f_R0 (tg_alt (Ratan_seq x)) n) by ring. rewrite scal_sum; apply sum_eq; intros i _; unfold tg_alt. rewrite Ratan_seq_opp; ring. Qed. Definition ps_atan_exists_1 (x : R) (Hx : -1 <= x <= 1) : {l : R | Un_cv (fun N : nat => sum_f_R0 (tg_alt (Ratan_seq x)) N) l}. Proof. destruct (Rle_lt_dec 0 x). { assert (pr : 0 <= x <= 1) by tauto. exact (ps_atan_exists_01 x pr). } assert (pr : 0 <= -x <= 1) by (destruct Hx; split; lra). destruct (ps_atan_exists_01 _ pr) as [v Pv]. exists (-v). apply (Un_cv_ext (fun n => (- 1) * sum_f_R0 (tg_alt (Ratan_seq (- x))) n)). { intros n; rewrite sum_Ratan_seq_opp; ring. } replace (-v) with (-1 * v) by ring. apply CV_mult;[ | assumption]. solve[intros; exists 0%nat; intros; rewrite Rdist_eq; auto]. Qed. Definition in_int (x : R) : {-1 <= x <= 1}+{~ -1 <= x <= 1}. Proof. destruct (Rle_lt_dec x 1). 1:destruct (Rle_lt_dec (-1) x). - left;split; auto. - right;intros [a1 a2]; lra. - right;intros [a1 a2]; lra. Qed. Definition ps_atan (x : R) : R := match in_int x with left h => let (v, _) := ps_atan_exists_1 x h in v | right h => atan x end. (** ** Proof of the equivalence of the two definitions between -1 and 1 *) Lemma ps_atan0_0 : ps_atan 0 = 0. Proof. unfold ps_atan. destruct (in_int 0) as [h1 | h2]. { destruct (ps_atan_exists_1 0 h1) as [v P]. apply (UL_sequence _ _ _ P). apply (Un_cv_ext (fun n => 0)). { symmetry;apply sum_eq_R0. intros i _; unfold tg_alt, Ratan_seq; rewrite Nat.add_comm; simpl. unfold Rdiv; rewrite !Rmult_0_l, Rmult_0_r; reflexivity. } intros eps ep; exists 0%nat; intros n _; unfold Rdist. rewrite Rminus_0_r, Rabs_pos_eq; auto with real. } case h2; split; lra. Qed. Lemma ps_atan_exists_1_opp : forall x h h', proj1_sig (ps_atan_exists_1 (-x) h) = -(proj1_sig (ps_atan_exists_1 x h')). Proof. intros x h h'; destruct (ps_atan_exists_1 (-x) h) as [v Pv]. destruct (ps_atan_exists_1 x h') as [u Pu]; simpl. assert (Pu' : Un_cv (fun N => (-1) * sum_f_R0 (tg_alt (Ratan_seq x)) N) (-1 * u)). { apply CV_mult;[ | assumption]. intros eps ep; exists 0%nat; intros; rewrite Rdist_eq; assumption. } assert (Pv' : Un_cv (fun N : nat => -1 * sum_f_R0 (tg_alt (Ratan_seq x)) N) v). { apply Un_cv_ext with (2 := Pv); intros n; rewrite sum_Ratan_seq_opp; ring. } replace (-u) with (-1 * u) by ring. apply UL_sequence with (1:=Pv') (2:= Pu'). Qed. Lemma ps_atan_opp : forall x, ps_atan (-x) = -ps_atan x. Proof. intros x; unfold ps_atan. destruct (in_int (- x)) as [inside | outside]. { destruct (in_int x) as [ins' | outs']. { generalize (ps_atan_exists_1_opp x inside ins'). intros h; exact h. } destruct inside; case outs'; split; lra. } destruct (in_int x) as [ins' | outs']. { destruct outside; case ins'; split; lra. } apply atan_opp. Qed. (** atan = ps_atan *) Lemma ps_atanSeq_continuity_pt_1 : forall (N : nat) (x : R), 0 <= x -> x <= 1 -> continuity_pt (fun x => sum_f_R0 (tg_alt (Ratan_seq x)) N) x. Proof. assert (Sublemma : forall (x:R) (N:nat), sum_f_R0 (tg_alt (Ratan_seq x)) N = x * (comp (fun x => sum_f_R0 (fun n => (fun i : nat => (-1) ^ i / INR (2 * i + 1)) n * x ^ n) N) (fun x => x ^ 2) x)). { intros x N. induction N. { unfold tg_alt, Ratan_seq, comp ; simpl ; field. } simpl sum_f_R0 at 1. rewrite IHN. replace (comp (fun x => sum_f_R0 (fun n : nat => (-1) ^ n / INR (2 * n + 1) * x ^ n) (S N)) (fun x => x ^ 2)) with (comp (fun x => sum_f_R0 (fun n : nat => (-1) ^ n / INR (2 * n + 1) * x ^ n) N + (-1) ^ (S N) / INR (2 * (S N) + 1) * x ^ (S N)) (fun x => x ^ 2)) by intuition. unfold comp. rewrite Rmult_plus_distr_l. apply Rplus_eq_compat_l. unfold tg_alt, Ratan_seq. rewrite <- Rmult_assoc. case (Req_dec x 0) ; intro Hyp. { rewrite Hyp ; rewrite pow_i. { rewrite Rmult_0_l ; rewrite Rmult_0_l. unfold Rdiv ; rewrite Rmult_0_l ; rewrite Rmult_0_r ; reflexivity. } intuition. } replace (x * ((-1) ^ S N / INR (2 * S N + 1)) * (x ^ 2) ^ S N) with (x ^ (2 * S N + 1) * ((-1) ^ S N / INR (2 * S N + 1))). { lra. } rewrite Rmult_assoc. replace (x * ((-1) ^ S N / INR (2 * S N + 1) * (x ^ 2) ^ S N)) with (((-1) ^ S N / INR (2 * S N + 1) * (x ^ 2) ^ S N) * x) by ring. rewrite Rmult_assoc. replace ((x ^ 2) ^ S N * x) with (x ^ (2 * S N + 1)). { rewrite Rmult_comm at 1 ; reflexivity. } rewrite <- pow_mult. assert (Temp : forall x n, x ^ n * x = x ^ (n+1)). { intros a n ; induction n. { rewrite pow_O. simpl ; intuition. } simpl ; rewrite Rmult_assoc ; rewrite IHn ; intuition. } rewrite Temp ; reflexivity. } intros N x x_lb x_ub. intros eps eps_pos. assert (continuity_id : continuity id). { apply derivable_continuous ; exact derivable_id. } assert (Temp := continuity_mult id (comp (fun x1 : R => sum_f_R0 (fun n : nat => (-1) ^ n / INR (2 * n + 1) * x1 ^ n) N) (fun x1 : R => x1 ^ 2)) continuity_id). assert (Temp2 : continuity (comp (fun x1 : R => sum_f_R0 (fun n : nat => (-1) ^ n / INR (2 * n + 1) * x1 ^ n) N) (fun x1 : R => x1 ^ 2))). { apply continuity_comp. { reg. } apply continuity_finite_sum. } elim (Temp Temp2 x eps eps_pos) ; clear Temp Temp2 ; intros alpha T ; destruct T as (alpha_pos, T). exists alpha ; split. { intuition. } intros x0 x0_cond. rewrite Sublemma ; rewrite Sublemma. apply T. intuition. Qed. (** Definition of ps_atan's derivative *) Definition Datan_seq := fun (x : R) (n : nat) => x ^ (2*n). Lemma pow_lt_1_compat : forall x n, 0 <= x < 1 -> (0 < n)%nat -> 0 <= x ^ n < 1. Proof. intros x n hx; induction 1; simpl. { rewrite Rmult_1_r; tauto. } split. { apply Rmult_le_pos; tauto. } rewrite <- (Rmult_1_r 1); apply Rmult_le_0_lt_compat; intuition. Qed. Lemma Datan_seq_Rabs : forall x n, Datan_seq (Rabs x) n = Datan_seq x n. Proof. intros x n; unfold Datan_seq; rewrite !pow_mult, pow2_abs; reflexivity. Qed. Lemma Datan_seq_pos : forall x n, 0 < x -> 0 < Datan_seq x n. Proof. intros x n x_lb ; unfold Datan_seq ; induction n. { simpl ; intuition. } replace (x ^ (2 * S n)) with ((x ^ 2) * (x ^ (2 * n))). { apply Rmult_gt_0_compat. { replace (x^2) with (x*x) by field ; apply Rmult_gt_0_compat ; assumption. } assumption. } replace (2 * S n)%nat with (S (S (2 * n))) by lia. simpl ; field. Qed. Lemma Datan_sum_eq :forall x n, sum_f_R0 (tg_alt (Datan_seq x)) n = (1 - (- x ^ 2) ^ S n)/(1 + x ^ 2). Proof. intros x n. assert (dif : - x ^ 2 <> 1). { nra. } replace (1 + x ^ 2) with (1 - - (x ^ 2)) by ring; rewrite <- (tech3 _ n dif). apply sum_eq; unfold tg_alt, Datan_seq; intros i _. rewrite pow_mult, <- Rpow_mult_distr. f_equal. ring. Qed. Lemma Datan_seq_increasing : forall x y n, (n > 0)%nat -> 0 <= x < y -> Datan_seq x n < Datan_seq y n. Proof. intros x y n n_lb x_encad ; assert (x_pos : x >= 0) by intuition. assert (y_pos : y > 0). { apply Rle_lt_trans with (r2:=x) ; intuition. } induction n. { lia. } clear -x_encad x_pos y_pos ; induction n ; unfold Datan_seq. { case x_pos ; clear x_pos ; intro x_pos. { simpl ; apply Rmult_gt_0_lt_compat ; intuition. lra. } rewrite x_pos ; rewrite pow_i. { replace (y ^ (2*1)) with (y*y). { apply Rmult_gt_0_compat ; assumption. } simpl ; field. } intuition. } assert (Hrew : forall a, a^(2 * S (S n)) = (a ^ 2) * (a ^ (2 * S n))). { clear ; intro a ; replace (2 * S (S n))%nat with (S (S (2 * S n)))%nat by lia. simpl ; field. } case x_pos ; clear x_pos ; intro x_pos. { rewrite Hrew ; rewrite Hrew. apply Rmult_gt_0_lt_compat ; intuition. apply Rmult_gt_0_lt_compat ; intuition ; lra. } rewrite x_pos. rewrite pow_i. { intuition. } lia. Qed. Lemma Datan_seq_decreasing : forall x, -1 < x -> x < 1 -> Un_decreasing (Datan_seq x). Proof. intros x x_lb x_ub n. unfold Datan_seq. replace (2 * S n)%nat with (2 + 2 * n)%nat by ring. rewrite <- (Rmult_1_l (x ^ (2 * n))). rewrite pow_add. apply Rmult_le_compat_r. { rewrite pow_mult; apply pow_le, pow2_ge_0. } apply Rlt_le; rewrite <- pow2_abs. assert (intabs : 0 <= Rabs x < 1). { split;[apply Rabs_pos | apply Rabs_def1]; tauto. } apply (pow_lt_1_compat (Rabs x) 2) in intabs. { tauto. } lia. Qed. Lemma Datan_seq_CV_0 : forall x, -1 < x -> x < 1 -> Un_cv (Datan_seq x) 0. Proof. intros x x_lb x_ub eps eps_pos. assert (x_ub2 : Rabs (x^2) < 1). { rewrite Rabs_pos_eq;[ | apply pow2_ge_0]. rewrite <- pow2_abs. assert (H: 0 <= Rabs x < 1) by (split;[apply Rabs_pos | apply Rabs_def1; auto]). apply (pow_lt_1_compat _ 2) in H;[tauto | lia]. } elim (pow_lt_1_zero (x^2) x_ub2 eps eps_pos) ; intros N HN ; exists N ; intros n Hn. unfold Rdist, Datan_seq. replace (x ^ (2 * n) - 0) with ((x ^ 2) ^ n). { apply HN ; assumption. } rewrite pow_mult ; field. Qed. Lemma Datan_lim : forall x, -1 < x -> x < 1 -> Un_cv (fun N : nat => sum_f_R0 (tg_alt (Datan_seq x)) N) (/ (1 + x ^ 2)). Proof. intros x x_lb x_ub eps eps_pos. assert (Tool0 : 0 <= x ^ 2) by apply pow2_ge_0. assert (Tool1 : 0 < (1 + x ^ 2)). { solve[apply Rplus_lt_le_0_compat ; intuition]. } assert (Tool2 : / (1 + x ^ 2) > 0). { apply Rinv_0_lt_compat ; tauto. } assert (x_ub2' : 0<= Rabs (x^2) < 1). { rewrite Rabs_pos_eq, <- pow2_abs;[ | apply pow2_ge_0]. apply pow_lt_1_compat;[split;[apply Rabs_pos | ] | lia]. apply Rabs_def1; assumption. } assert (x_ub2 : Rabs (x^2) < 1) by tauto. assert (eps'_pos : ((1 + x^2)*eps) > 0). { apply Rmult_gt_0_compat ; assumption. } elim (pow_lt_1_zero _ x_ub2 _ eps'_pos) ; intros N HN ; exists N. intros n Hn. assert (H1 : - x^2 <> 1). { apply Rlt_not_eq; apply Rle_lt_trans with (2 := Rlt_0_1). assert (t := pow2_ge_0 x); lra. } rewrite Datan_sum_eq. unfold Rdist. assert (tool : forall a b, a / b - /b = (-1 + a) /b). { intros a b; rewrite <- (Rmult_1_l (/b)); unfold Rdiv, Rminus. rewrite <- Ropp_mult_distr_l_reverse, Rmult_plus_distr_r, Rplus_comm. reflexivity. } set (u := 1 + x ^ 2); rewrite tool; unfold Rminus; rewrite <- Rplus_assoc. unfold Rdiv, u. change (-1) with (-(1)). rewrite Rplus_opp_l, Rplus_0_l, Ropp_mult_distr_l_reverse, Rabs_Ropp. rewrite Rabs_mult; clear tool u. assert (tool : forall k, Rabs ((-x ^ 2) ^ k) = Rabs ((x ^ 2) ^ k)). { clear -Tool0; induction k;[simpl; rewrite Rabs_R1;tauto | ]. rewrite <- !(tech_pow_Rmult _ k), !Rabs_mult, Rabs_Ropp, IHk, Rabs_pos_eq. { reflexivity. } exact Tool0. } rewrite tool, (Rabs_pos_eq (/ _)); clear tool;[ | apply Rlt_le; assumption]. assert (tool : forall a b c, 0 < b -> a < b * c -> a * / b < c). { intros a b c bp h; replace c with (b * c * /b). { apply Rmult_lt_compat_r. { apply Rinv_0_lt_compat; assumption. } assumption. } field; apply Rgt_not_eq; exact bp. } apply tool;[exact Tool1 | ]. apply HN; lia. Qed. Lemma Datan_CVU_prelim : forall c (r : posreal), Rabs c + r < 1 -> CVU (fun N x => sum_f_R0 (tg_alt (Datan_seq x)) N) (fun y : R => / (1 + y ^ 2)) c r. Proof. intros c r ub_ub eps eps_pos. apply (Alt_CVU (fun x n => Datan_seq n x) (fun x => /(1 + x ^ 2)) (Datan_seq (Rabs c + r)) c r). - intros x inb; apply Datan_seq_decreasing; apply Boule_lt in inb; apply Rabs_def2 in inb; destruct inb; lra. - intros x inb; apply Datan_seq_CV_0; apply Boule_lt in inb; apply Rabs_def2 in inb; destruct inb; lra. - intros x inb; apply (Datan_lim x); apply Boule_lt in inb; apply Rabs_def2 in inb; destruct inb; lra. - intros x [ | n] inb. { solve[unfold Datan_seq; apply Rle_refl]. } rewrite <- (Datan_seq_Rabs x); apply Rlt_le, Datan_seq_increasing. { lia. } apply Boule_lt in inb; intuition. solve[apply Rabs_pos]. - apply Datan_seq_CV_0. { apply Rlt_trans with 0;[lra | ]. apply Rplus_le_lt_0_compat. { solve[apply Rabs_pos]. } destruct r; assumption. } assumption. - assumption. Qed. Lemma Datan_is_datan : forall (N : nat) (x : R), -1 <= x -> x < 1 -> derivable_pt_lim (fun x => sum_f_R0 (tg_alt (Ratan_seq x)) N) x (sum_f_R0 (tg_alt (Datan_seq x)) N). Proof. assert (Tool : forall N, (-1) ^ (S (2 * N)) = - 1). { intro n ; induction n. { simpl ; field. } replace ((-1) ^ S (2 * S n)) with ((-1) ^ 2 * (-1) ^ S (2*n)). { rewrite IHn ; field. } rewrite <- pow_add. replace (2 + S (2 * n))%nat with (S (2 * S n))%nat. { reflexivity. } lia. } intros N x x_lb x_ub. induction N. { unfold Datan_seq, Ratan_seq, tg_alt ; simpl. intros eps eps_pos. elim (derivable_pt_lim_id x eps eps_pos) ; intros delta Hdelta ; exists delta. intros h hneq h_b. replace (1 * ((x + h) * 1 / 1) - 1 * (x * 1 / 1)) with (id (x + h) - id x). { rewrite Rmult_1_r. apply Hdelta ; assumption. } unfold id ; field ; assumption. } intros eps eps_pos. assert (eps_3_pos : (eps/3) > 0) by lra. elim (IHN (eps/3) eps_3_pos) ; intros delta1 Hdelta1. assert (Main : derivable_pt_lim (fun x =>tg_alt (Ratan_seq x) (S N)) x ((tg_alt (Datan_seq x)) (S N))). { clear -Tool ; intros eps' eps'_pos. elim (derivable_pt_lim_pow x (2 * (S N) + 1) eps' eps'_pos) ; intros delta Hdelta ; exists delta. intros h h_neq h_b ; unfold tg_alt, Ratan_seq, Datan_seq. replace (((-1) ^ S N * ((x + h) ^ (2 * S N + 1) / INR (2 * S N + 1)) - (-1) ^ S N * (x ^ (2 * S N + 1) / INR (2 * S N + 1))) / h - (-1) ^ S N * x ^ (2 * S N)) with (((-1)^(S N)) * ((((x + h) ^ (2 * S N + 1) / INR (2 * S N + 1)) - (x ^ (2 * S N + 1) / INR (2 * S N + 1))) / h - x ^ (2 * S N))) by (field ; split ; [apply Rgt_not_eq |] ; intuition). rewrite Rabs_mult ; rewrite pow_1_abs ; rewrite Rmult_1_l. replace (((x + h) ^ (2 * S N + 1) / INR (2 * S N + 1) - x ^ (2 * S N + 1) / INR (2 * S N + 1)) / h - x ^ (2 * S N)) with ((/INR (2* S N + 1)) * (((x + h) ^ (2 * S N + 1) - x ^ (2 * S N + 1)) / h - INR (2 * S N + 1) * x ^ pred (2 * S N + 1))). { rewrite Rabs_mult. case (Req_dec (((x + h) ^ (2 * S N + 1) - x ^ (2 * S N + 1)) / h - INR (2 * S N + 1) * x ^ pred (2 * S N + 1)) 0) ; intro Heq. { rewrite Heq ; rewrite Rabs_R0 ; rewrite Rmult_0_r ; assumption. } apply Rlt_trans with (r2:=Rabs (((x + h) ^ (2 * S N + 1) - x ^ (2 * S N + 1)) / h - INR (2 * S N + 1) * x ^ pred (2 * S N + 1))). 2:{ apply Hdelta; assumption. } rewrite <- Rmult_1_l ; apply Rmult_lt_compat_r. { apply Rabs_pos_lt ; assumption. } rewrite Rabs_right. { replace 1 with (/1) by field. apply Rinv_0_lt_contravar. { lra. } apply lt_1_INR; lia. } apply Rgt_ge ; replace (INR (2 * S N + 1)) with (INR (2*S N) + 1) ; [apply RiemannInt.RinvN_pos | ]. replace (2 * S N + 1)%nat with (S (2 * S N))%nat by lia. rewrite S_INR ; reflexivity. } rewrite Rmult_minus_distr_l. replace (/ INR (2 * S N + 1) * (INR (2 * S N + 1) * x ^ pred (2 * S N + 1))) with (x ^ (2 * S N)). 2:{ clear ; replace (pred (2 * S N + 1)) with (2 * S N)%nat by lia. field ; apply Rgt_not_eq ; intuition. } unfold Rminus ; rewrite Rplus_comm. replace (((x + h) ^ (2 * S N + 1) / INR (2 * S N + 1) + - (x ^ (2 * S N + 1) / INR (2 * S N + 1))) / h + - x ^ (2 * S N)) with (- x ^ (2 * S N) + (((x + h) ^ (2 * S N + 1) / INR (2 * S N + 1) + - (x ^ (2 * S N + 1) / INR (2 * S N + 1))) / h)) by intuition. apply Rplus_eq_compat_l. field. split ; [apply Rgt_not_eq|] ; intuition. } elim (Main (eps/3) eps_3_pos) ; intros delta2 Hdelta2. destruct delta1 as (delta1, delta1_pos) ; destruct delta2 as (delta2, delta2_pos). pose (mydelta := Rmin delta1 delta2). assert (mydelta_pos : mydelta > 0). { unfold mydelta ; rewrite Rmin_Rgt ; split ; assumption. } pose (delta := mkposreal mydelta mydelta_pos) ; exists delta ; intros h h_neq h_b. clear Main IHN. unfold Rminus at 1. apply Rle_lt_trans with (r2:=eps/3 + eps / 3). { assert (Temp : (sum_f_R0 (tg_alt (Ratan_seq (x + h))) (S N) - sum_f_R0 (tg_alt (Ratan_seq x)) (S N)) / h + - sum_f_R0 (tg_alt (Datan_seq x)) (S N) = ((sum_f_R0 (tg_alt (Ratan_seq (x + h))) N - sum_f_R0 (tg_alt (Ratan_seq x)) N) / h) + (- sum_f_R0 (tg_alt (Datan_seq x)) N) + ((tg_alt (Ratan_seq (x + h)) (S N) - tg_alt (Ratan_seq x) (S N)) / h - tg_alt (Datan_seq x) (S N))). { simpl ; field ; intuition. } apply Rle_trans with (r2:= Rabs ((sum_f_R0 (tg_alt (Ratan_seq (x + h))) N - sum_f_R0 (tg_alt (Ratan_seq x)) N) / h + - sum_f_R0 (tg_alt (Datan_seq x)) N) + Rabs ((tg_alt (Ratan_seq (x + h)) (S N) - tg_alt (Ratan_seq x) (S N)) / h - tg_alt (Datan_seq x) (S N))). { rewrite Temp ; clear Temp ; apply Rabs_triang. } apply Rplus_le_compat ; apply Rlt_le ; [apply Hdelta1 | apply Hdelta2] ; intuition ; apply Rlt_le_trans with (r2:=delta) ; intuition unfold delta, mydelta. { apply Rmin_l. } apply Rmin_r. } lra. Qed. Lemma Ratan_CVU' : CVU (fun N x => sum_f_R0 (tg_alt (Ratan_seq x)) N) ps_atan (/2) posreal_half. Proof. apply (Alt_CVU (fun i r => Ratan_seq r i) ps_atan PI_tg (/2) posreal_half); lazy beta. - now intros; apply Ratan_seq_decreasing, Boule_half_to_interval. - now intros; apply Ratan_seq_converging, Boule_half_to_interval. - intros x b; apply Boule_half_to_interval in b. unfold ps_atan; destruct (in_int x) as [inside | outside]; [ | destruct b; case outside; split; lra]. destruct (ps_atan_exists_1 x inside) as [v Pv]. apply Un_cv_ext with (2 := Pv);[reflexivity]. - intros x n b; apply Boule_half_to_interval in b. rewrite <- (Rmult_1_l (PI_tg n)); unfold Ratan_seq, PI_tg. apply Rmult_le_compat_r. { apply Rlt_le, Rinv_0_lt_compat, (lt_INR 0); lia. } rewrite <- (pow1 (2 * n + 1)); apply pow_incr; assumption. - exact PI_tg_cv. Qed. Lemma Ratan_CVU : CVU (fun N x => sum_f_R0 (tg_alt (Ratan_seq x)) N) ps_atan 0 (mkposreal 1 Rlt_0_1). Proof. intros eps ep; destruct (Ratan_CVU' eps ep) as [N Pn]. exists N; intros n x nN b_y. case (Rtotal_order 0 x) as [xgt0 | [x0 | x0]]. - assert (Boule (/2) posreal_half x). { revert b_y; unfold Boule; simpl; intros b_y; apply Rabs_def2 in b_y. destruct b_y; unfold Boule; simpl; apply Rabs_def1; lra. } apply Pn; assumption. - rewrite <- x0, ps_atan0_0. rewrite <- (sum_eq (fun _ => 0)), sum_cte, Rmult_0_l, Rminus_0_r, Rabs_pos_eq. + assumption. + apply Rle_refl. + intros i _; unfold tg_alt, Ratan_seq, Rdiv; rewrite Nat.add_comm; simpl. solve[rewrite !Rmult_0_l, Rmult_0_r; auto]. - replace (ps_atan x - sum_f_R0 (tg_alt (Ratan_seq x)) n) with (-(ps_atan (-x) - sum_f_R0 (tg_alt (Ratan_seq (-x))) n)). { rewrite Rabs_Ropp. assert (Boule (/2) posreal_half (-x)). { revert b_y; unfold Boule; simpl; intros b_y; apply Rabs_def2 in b_y. destruct b_y; unfold Boule; simpl; apply Rabs_def1; lra. } apply Pn; assumption. } unfold Rminus; rewrite ps_atan_opp, Ropp_plus_distr, sum_Ratan_seq_opp. rewrite !Ropp_involutive; reflexivity. Qed. Lemma Alt_PI_tg : forall n, PI_tg n = Ratan_seq 1 n. Proof. intros n; unfold PI_tg, Ratan_seq, Rdiv; rewrite pow1, Rmult_1_l. reflexivity. Qed. Lemma Ratan_is_ps_atan : forall eps, eps > 0 -> exists N, forall n, (n >= N)%nat -> forall x, -1 < x -> x < 1 -> Rabs (sum_f_R0 (tg_alt (Ratan_seq x)) n - ps_atan x) < eps. Proof. intros eps ep. destruct (Ratan_CVU _ ep) as [N1 PN1]. exists N1; intros n nN x xm1 x1; rewrite <- Rabs_Ropp, Ropp_minus_distr. apply PN1; [assumption | ]. unfold Boule; simpl; rewrite Rminus_0_r; apply Rabs_def1; assumption. Qed. Lemma Datan_continuity : continuity (fun x => /(1 + x^2)). Proof. apply continuity_inv. { apply continuity_plus. { apply continuity_const ; unfold constant ; intuition. } apply derivable_continuous ; apply derivable_pow. } intro x ; apply Rgt_not_eq ; apply Rge_gt_trans with (1+0) ; [|lra] ; apply Rplus_ge_compat_l. replace (x^2) with (x²). { apply Rle_ge ; apply Rle_0_sqr. } unfold Rsqr ; field. Qed. Lemma derivable_pt_lim_ps_atan : forall x, -1 < x < 1 -> derivable_pt_lim ps_atan x ((fun y => /(1 + y ^ 2)) x). Proof. intros x x_encad. destruct (boule_in_interval (-1) 1 x x_encad) as [c [r [Pcr1 [P1 P2]]]]. change (/ (1 + x ^ 2)) with ((fun u => /(1 + u ^ 2)) x). assert (t := derivable_pt_lim_CVU). apply derivable_pt_lim_CVU with (fn := (fun N x => sum_f_R0 (tg_alt (Ratan_seq x)) N)) (fn' := (fun N x => sum_f_R0 (tg_alt (Datan_seq x)) N)) (c := c) (r := r). - assumption. - intros y N inb; apply Rabs_def2 in inb; destruct inb. apply Datan_is_datan. { lra. } lra. - intros y inb; apply Rabs_def2 in inb; destruct inb. assert (y_gt_0 : -1 < y) by lra. assert (y_lt_1 : y < 1) by lra. intros eps eps_pos ; elim (Ratan_is_ps_atan eps eps_pos). intros N HN ; exists N; intros n n_lb ; apply HN ; tauto. - apply Datan_CVU_prelim. replace ((c - r + (c + r)) / 2) with c by field. unfold mkposreal_lb_ub; simpl. replace ((c + r - (c - r)) / 2) with (r :R) by field. assert (Rabs c < 1 - r). { unfold Boule in Pcr1; destruct r; simpl in *; apply Rabs_def1; apply Rabs_def2 in Pcr1; destruct Pcr1; lra. } lra. - intros; apply Datan_continuity. Qed. Lemma derivable_pt_ps_atan : forall x, -1 < x < 1 -> derivable_pt ps_atan x. Proof. intros x x_encad. exists (/(1 + x^2)) ; apply derivable_pt_lim_ps_atan; assumption. Qed. Lemma ps_atan_continuity_pt_1 : forall eps : R, eps > 0 -> exists alp : R, alp > 0 /\ (forall x, x < 1 -> 0 < x -> Rdist x 1 < alp -> dist R_met (ps_atan x) (Alt_PI/4) < eps). Proof. intros eps eps_pos. assert (eps_3_pos : eps / 3 > 0) by lra. elim (Ratan_is_ps_atan (eps / 3) eps_3_pos) ; intros N1 HN1. unfold Alt_PI. destruct exist_PI as [v Pv]; replace ((4 * v)/4) with v by field. assert (Pv' : Un_cv (sum_f_R0 (tg_alt (Ratan_seq 1))) v). { apply Un_cv_ext with (2:= Pv). intros; apply sum_eq; intros; unfold tg_alt; rewrite Alt_PI_tg; tauto. } destruct (Pv' (eps / 3) eps_3_pos) as [N2 HN2]. set (N := (N1 + N2)%nat). assert (O_lb : 0 <= 1) by intuition ; assert (O_ub : 1 <= 1) by intuition ; elim (ps_atanSeq_continuity_pt_1 N 1 O_lb O_ub (eps / 3) eps_3_pos) ; intros alpha Halpha ; clear -HN1 HN2 Halpha eps_3_pos; destruct Halpha as (alpha_pos, Halpha). exists alpha ; split;[assumption | ]. intros x x_ub x_lb x_bounds. simpl ; unfold Rdist. replace (ps_atan x - v) with ((ps_atan x - sum_f_R0 (tg_alt (Ratan_seq x)) N) + (sum_f_R0 (tg_alt (Ratan_seq x)) N - sum_f_R0 (tg_alt (Ratan_seq 1)) N) + (sum_f_R0 (tg_alt (Ratan_seq 1)) N - v)) by ring. apply Rle_lt_trans with (r2:=Rabs (ps_atan x - sum_f_R0 (tg_alt (Ratan_seq x)) N) + Rabs ((sum_f_R0 (tg_alt (Ratan_seq x)) N - sum_f_R0 (tg_alt (Ratan_seq 1)) N) + (sum_f_R0 (tg_alt (Ratan_seq 1)) N - v))). { rewrite Rplus_assoc ; apply Rabs_triang. } replace eps with (2 / 3 * eps + eps / 3) by field. rewrite Rplus_comm. apply Rplus_lt_compat. { apply Rle_lt_trans with (r2 := Rabs (sum_f_R0 (tg_alt (Ratan_seq x)) N - sum_f_R0 (tg_alt (Ratan_seq 1)) N) + Rabs (sum_f_R0 (tg_alt (Ratan_seq 1)) N - v)). { apply Rabs_triang. } apply Rlt_le_trans with (r2:= eps / 3 + eps / 3). { apply Rplus_lt_compat. { simpl in Halpha ; unfold Rdist in Halpha. apply Halpha ; split. { unfold D_x, no_cond ; split ; [ | apply Rgt_not_eq ] ; intuition. } intuition. } apply HN2; unfold N; lia. } lra. } rewrite <- Rabs_Ropp, Ropp_minus_distr; apply HN1. - unfold N; lia. - lra. - assumption. Qed. Lemma Datan_eq_DatanSeq_interv : forall x, -1 < x < 1 -> forall (Pratan:derivable_pt ps_atan x) (Prmymeta:derivable_pt atan x), derive_pt ps_atan x Pratan = derive_pt atan x Prmymeta. Proof. assert (freq : 0 < tan 1) by apply (Rlt_trans _ _ _ Rlt_0_1 tan_1_gt_1). intros x x_encad Pratan Prmymeta. rewrite pr_nu_var2_interv with (g:=ps_atan) (lb:=-1) (ub:=tan 1) (pr2 := derivable_pt_ps_atan x x_encad). - rewrite pr_nu_var2_interv with (f:=atan) (g:=atan) (lb:=-1) (ub:= 1) (pr2:=derivable_pt_atan x). + assert (Temp := derivable_pt_lim_ps_atan x x_encad). assert (Hrew1 : derive_pt ps_atan x (derivable_pt_ps_atan x x_encad) = (/(1 + x^2))). { apply derive_pt_eq_0 ; assumption. } rewrite derive_pt_atan. rewrite Hrew1. replace (Rsqr x) with (x ^ 2) by (unfold Rsqr; ring). unfold Rdiv; rewrite Rmult_1_l; reflexivity. + lra. + assumption. + intros; reflexivity. - lra. - assert (t := tan_1_gt_1); split;destruct x_encad; lra. - intros; reflexivity. Qed. Lemma atan_eq_ps_atan : forall x, 0 < x < 1 -> atan x = ps_atan x. Proof. intros x x_encad. assert (pr1 : forall c : R, 0 < c < x -> derivable_pt (atan - ps_atan) c). { intros c c_encad. apply derivable_pt_minus. { exact (derivable_pt_atan c). } apply derivable_pt_ps_atan. destruct x_encad; destruct c_encad; split; lra. } assert (pr2 : forall c : R, 0 < c < x -> derivable_pt id c). { intros ; apply derivable_pt_id; lra. } assert (delta_cont : forall c : R, 0 <= c <= x -> continuity_pt (atan - ps_atan) c). { intros c [[c_encad1 | c_encad1 ] [c_encad2 | c_encad2]]; apply continuity_pt_minus. - apply derivable_continuous_pt ; apply derivable_pt_atan. - apply derivable_continuous_pt ; apply derivable_pt_ps_atan. split; destruct x_encad; lra. - apply derivable_continuous_pt, derivable_pt_atan. - apply derivable_continuous_pt, derivable_pt_ps_atan. subst c; destruct x_encad; split; lra. - apply derivable_continuous_pt, derivable_pt_atan. - apply derivable_continuous_pt, derivable_pt_ps_atan. subst c; split; lra. - apply derivable_continuous_pt, derivable_pt_atan. - apply derivable_continuous_pt, derivable_pt_ps_atan. subst c; destruct x_encad; split; lra. } assert (id_cont : forall c : R, 0 <= c <= x -> continuity_pt id c). { intros ; apply derivable_continuous ; apply derivable_id. } assert (x_lb : 0 < x) by (destruct x_encad; lra). elim (MVT (atan - ps_atan)%F id 0 x pr1 pr2 x_lb delta_cont id_cont) ; intros d Temp ; elim Temp ; intros d_encad Main. clear - Main x_encad. assert (Temp : forall (pr: derivable_pt (atan - ps_atan) d), derive_pt (atan - ps_atan) d pr = 0). { intro pr. assert (d_encad3 : -1 < d < 1). { destruct d_encad; destruct x_encad; split; lra. } pose (pr3 := derivable_pt_minus atan ps_atan d (derivable_pt_atan d) (derivable_pt_ps_atan d d_encad3)). rewrite <- pr_nu_var2_interv with (f:=(atan - ps_atan)%F) (g:=(atan - ps_atan)%F) (lb:=0) (ub:=x) (pr1:=pr3) (pr2:=pr). - unfold pr3. rewrite derive_pt_minus. rewrite Datan_eq_DatanSeq_interv with (Prmymeta := derivable_pt_atan d). { intuition. } assumption. - destruct d_encad; lra. - assumption. - reflexivity. } assert (iatan0 : atan 0 = 0). { apply tan_inj. - apply atan_bound. - rewrite Rdiv_opp_l; assert (t := PI2_RGT_0); split; lra. - rewrite tan_0, tan_atan; reflexivity. } generalize Main; rewrite Temp, Rmult_0_r. replace ((atan - ps_atan)%F x) with (atan x - ps_atan x) by intuition. replace ((atan - ps_atan)%F 0) with (atan 0 - ps_atan 0) by intuition. rewrite iatan0, ps_atan0_0, !Rminus_0_r. replace (derive_pt id d (pr2 d d_encad)) with 1. { rewrite Rmult_1_r. solve[intros M; apply Rminus_diag_uniq; auto]. } rewrite pr_nu_var with (g:=id) (pr2:=derivable_pt_id d). { symmetry ; apply derive_pt_id. } tauto. Qed. Theorem Alt_PI_eq : Alt_PI = PI. Proof. apply Rmult_eq_reg_r with (/4); fold (Alt_PI/4); fold (PI/4); [ | apply Rgt_not_eq; lra]. assert (0 < PI/6) by (apply PI6_RGT_0). assert (t1:= PI2_1). assert (t2 := PI_4). assert (m := Alt_PI_RGT_0). assert (-PI/2 < 1 < PI/2) by (rewrite Rdiv_opp_l; split; lra). apply cond_eq; intros eps ep. change (Rdist (Alt_PI/4) (PI/4) < eps). assert (ca : continuity_pt atan 1). { apply derivable_continuous_pt, derivable_pt_atan. } assert (Xe : exists eps', exists eps'', eps' + eps'' <= eps /\ 0 < eps' /\ 0 < eps''). { exists (eps/2); exists (eps/2); repeat apply conj; lra. } destruct Xe as [eps' [eps'' [eps_ineq [ep' ep'']]]]. destruct (ps_atan_continuity_pt_1 _ ep') as [alpha [a0 Palpha]]. destruct (ca _ ep'') as [beta [b0 Pbeta]]. assert (Xa : exists a, 0 < a < 1 /\ Rdist a 1 < alpha /\ Rdist a 1 < beta). { exists (Rmax (/2) (Rmax (1 - alpha /2) (1 - beta /2))). assert (/2 <= Rmax (/2) (Rmax (1 - alpha /2) (1 - beta /2))) by apply Rmax_l. assert (Rmax (1 - alpha /2) (1 - beta /2) <= Rmax (/2) (Rmax (1 - alpha /2) (1 - beta /2))) by apply Rmax_r. assert ((1 - alpha /2) <= Rmax (1 - alpha /2) (1 - beta /2)) by apply Rmax_l. assert ((1 - beta /2) <= Rmax (1 - alpha /2) (1 - beta /2)) by apply Rmax_r. assert (Rmax (1 - alpha /2) (1 - beta /2) < 1) by (apply Rmax_lub_lt; lra). split;[split;[ | apply Rmax_lub_lt]; lra | ]. assert (0 <= 1 - Rmax (/ 2) (Rmax (1 - alpha / 2) (1 - beta / 2))). { assert (Rmax (/2) (Rmax (1 - alpha / 2) (1 - beta /2)) <= 1) by (apply Rmax_lub; lra). lra. } split; unfold Rdist; rewrite <-Rabs_Ropp, Ropp_minus_distr, Rabs_pos_eq;lra. } destruct Xa as [a [[Pa0 Pa1] [P1 P2]]]. apply Rle_lt_trans with (1 := Rdist_tri _ _ (ps_atan a)). apply Rlt_le_trans with (2 := eps_ineq). apply Rplus_lt_compat. { rewrite Rdist_sym; apply Palpha; assumption. } rewrite <- atan_eq_ps_atan. { rewrite <- atan_1; apply (Pbeta a); auto. split; [ | exact P2]. split;[exact I | apply Rgt_not_eq; assumption]. } split; assumption. Qed. Lemma PI_ineq : forall N : nat, sum_f_R0 (tg_alt PI_tg) (S (2 * N)) <= PI/4 <= sum_f_R0 (tg_alt PI_tg) (2 * N). Proof. intros; rewrite <- Alt_PI_eq; apply Alt_PI_ineq. Qed. (** ** Relation between arctangent and sine and cosine *) Lemma sin_atan: forall x, sin (atan x) = x / sqrt (1 + x²). Proof. intros x. pose proof (atan_right_inv x) as Hatan. remember (atan(x)) as α. rewrite <- Hatan. apply sin_tan. apply cos_gt_0. 1,2: pose proof atan_bound x; lra. Qed. Lemma cos_atan: forall x, cos (atan x) = 1 / sqrt(1 + x²). Proof. intros x. pose proof (atan_right_inv x) as Hatan. remember (atan(x)) as α. rewrite <- Hatan. apply cos_tan. apply cos_gt_0. 1,2: pose proof atan_bound x; lra. Qed. (*********************************************************) (** * Definition of arcsine based on arctangent *) (*********************************************************) (** asin is defined by cases so that it is defined in the full range from -1 .. 1 *) Definition asin x := if Rle_dec x (-1) then - (PI / 2) else if Rle_dec 1 x then PI / 2 else atan (x / sqrt (1 - x²)). (** ** Relation between arcsin and arctangent *) Lemma asin_atan : forall x, -1 < x < 1 -> asin x = atan (x / sqrt (1 - x²)). Proof. intros x. unfold asin; repeat case Rle_dec; intros; lra. Qed. (** ** arcsine of specific values *) Lemma asin_0 : asin 0 = 0. Proof. unfold asin; repeat case Rle_dec; intros; try lra. replace (0/_) with 0. - apply atan_0. - field. rewrite Rsqr_pow2; field_simplify (1 - 0^2). rewrite sqrt_1; lra. Qed. Lemma asin_1 : asin 1 = PI / 2. Proof. unfold asin; repeat case Rle_dec; lra. Qed. Lemma asin_inv_sqrt2 : asin (/sqrt 2) = PI/4. Proof. rewrite asin_atan. { pose proof sqrt2_neq_0 as SH. rewrite Rsqr_pow2, pow_inv, <- Rsqr_pow2, Rsqr_sqrt; try lra. replace (1 - /2) with (/2) by lra. rewrite sqrt_inv. now rewrite <- atan_1; apply f_equal; field. } split. { apply (Rlt_trans _ 0); try lra. apply Rinv_0_lt_compat; apply sqrt_lt_R0; lra. } replace 1 with (/ sqrt 1). { apply Rinv_0_lt_contravar. { rewrite sqrt_1; lra. } apply sqrt_lt_1; lra. } rewrite sqrt_1; lra. Qed. Lemma asin_opp : forall x, asin (- x) = - asin x. Proof. intros x. unfold asin; repeat case Rle_dec; intros; try lra. rewrite <- Rsqr_neg. rewrite Rdiv_opp_l. rewrite atan_opp. reflexivity. Qed. (** ** Bounds of arcsine *) Lemma asin_bound : forall x, - (PI/2) <= asin x <= PI/2. Proof. intros x. pose proof PI_RGT_0. unfold asin; repeat case Rle_dec; try lra. intros Hx1 Hx2. pose proof atan_bound (x / sqrt (1 - x²)); lra. Qed. Lemma asin_bound_lt : forall x, -1 < x < 1 -> - (PI/2) < asin x < PI/2. Proof. intros x HxB. pose proof PI_RGT_0. unfold asin; repeat case Rle_dec; try lra. intros Hx1 Hx2. pose proof atan_bound (x / sqrt (1 - x²)); lra. Qed. (** ** arcsine is the left and right inverse of sine *) Lemma sin_asin : forall x, -1 <= x <= 1 -> sin (asin x) = x. Proof. intros x. unfold asin; repeat case Rle_dec. - rewrite sin_antisym, sin_PI2; lra. - rewrite sin_PI2; lra. - intros Hx1 Hx2 Hx3. pose proof Rsqr_bounds_lt 1 x ltac:(lra) as Hxsqr; rewrite Rsqr_1 in Hxsqr. rewrite sin_atan. unfold Rdiv at 1 2. rewrite Rmult_assoc, <- Rinv_mult. rewrite <- sqrt_mult_alt by lra. rewrite Rsqr_div', Rsqr_sqrt by lra. field_simplify ((1 - x²) * (1 + x² / (1 - x²))). { rewrite sqrt_1. field. } lra. Qed. Lemma asin_sin : forall x, -(PI/2) <= x <= PI/2 -> asin (sin x) = x. Proof. intros x HB. apply sin_inj; auto. { apply asin_bound. } apply sin_asin. apply SIN_bound. Qed. (** ** Relation between arcsin, cosine and tangent *) Lemma cos_asin : forall x, -1 <= x <= 1 -> cos (asin x) = sqrt (1 - x²). Proof. intros x Hxrange. pose proof (sin_asin x) ltac:(lra) as Hasin. remember (asin(x)) as α. rewrite <- Hasin. apply cos_sin. pose proof cos_ge_0 α. pose proof asin_bound x. lra. Qed. Lemma tan_asin : forall x, -1 <= x <= 1 -> tan (asin x) = x / sqrt (1 - x²). Proof. intros x Hxrange. pose proof (sin_asin x) Hxrange as Hasin. remember (asin(x)) as α. rewrite <- Hasin. apply tan_sin. pose proof cos_ge_0 α. pose proof asin_bound x. lra. Qed. (** ** Derivative of arcsine *) Lemma derivable_pt_asin : forall x, -1 < x < 1 -> derivable_pt asin x. Proof. intros x H. eapply (derivable_pt_recip_interv sin asin (-PI/2) (PI/2)); [shelve ..|]. rewrite <- (pr_nu sin (asin x) (derivable_pt_sin (asin x))). rewrite derive_pt_sin. (* The asin bounds are needed later, so pose them before asin is unfolded *) pose proof asin_bound_lt x ltac:(lra) as HxB3. unfold asin in *. destruct (Rle_dec x (-1)); destruct (Rle_dec 1 x); [lra .. |]. apply Rgt_not_eq; apply cos_gt_0; lra. Unshelve. - pose proof PI_RGT_0 as HPi; lra. - rewrite Rdiv_opp_l,sin_antisym,sin_PI2; lra. - clear x H; intros x Ha Hb. rewrite Rdiv_opp_l; apply asin_bound. - intros a Ha; reg. - intros x0 Ha Hb. unfold comp,id. apply sin_asin. rewrite Rdiv_opp_l,sin_antisym,sin_PI2 in Ha; rewrite sin_PI2 in Hb; lra. - intros x1 x2 Ha Hb Hc. apply sin_increasing_1; lra. Qed. Lemma derive_pt_asin : forall (x : R) (Hxrange : -1 < x < 1), derive_pt asin x (derivable_pt_asin x Hxrange) = 1 / sqrt (1 - x²). Proof. intros x Hxrange. epose proof (derive_pt_recip_interv sin asin (-PI/2) (PI/2) x _ _ _ _ _ _ _) as Hd. rewrite <- (pr_nu sin (asin x) (derivable_pt_sin (asin x))) in Hd. rewrite <- (pr_nu asin x (derivable_pt_asin x Hxrange)) in Hd. rewrite derive_pt_sin in Hd. rewrite cos_asin in Hd by lra. assumption. Unshelve. - pose proof PI_RGT_0. lra. - rewrite Rdiv_opp_l,sin_antisym,sin_PI2; lra. - intros x1 x2 Ha Hb Hc. apply sin_increasing_1; lra. - intros x0 Ha Hb. pose proof asin_bound x0; lra. - intros a Ha; reg. - intros x0 Ha Hb. unfold comp,id. apply sin_asin. rewrite Rdiv_opp_l,sin_antisym,sin_PI2 in Ha; rewrite sin_PI2 in Hb; lra. - rewrite <- (pr_nu sin (asin x) (derivable_pt_sin (asin x))). rewrite derive_pt_sin. rewrite cos_asin by lra. apply Rgt_not_eq. apply sqrt_lt_R0. pose proof Rsqr_bounds_lt 1 x ltac:(lra) as Hxsqrrange. rewrite Rsqr_1 in Hxsqrrange; lra. Qed. (*********************************************************) (** * Definition of arccosine based on arctangent *) (*********************************************************) (** acos is defined by cases so that it is defined in the full range from -1 .. 1 *) Definition acos x := if Rle_dec x (-1) then PI else if Rle_dec 1 x then 0 else PI/2 - atan (x/sqrt(1 - x²)). (** ** Relation between arccosine, arcsine and arctangent *) Lemma acos_atan : forall x, 0 < x -> acos x = atan (sqrt (1 - x²) / x). Proof. intros x. unfold acos; repeat case Rle_dec; [lra | |]. - intros Hx1 Hx2 Hx3. pose proof Rsqr_bounds_le x 1 ltac:(lra)as Hxsqr. rewrite Rsqr_1 in Hxsqr. rewrite sqrt_neg_0 by lra. replace (0/x) with 0 by (field;lra). rewrite atan_0; reflexivity. - intros Hx1 Hx2 Hx3. pose proof atan_inv (sqrt (1 - x²) / x) as Hatan. pose proof Rsqr_bounds_lt 1 x ltac:(lra)as Hxsqr. rewrite Rsqr_1 in Hxsqr. replace (/ (sqrt (1 - x²) / x)) with (x/sqrt (1 - x²)) in Hatan. + rewrite Hatan; [field|]. apply Rdiv_lt_0_compat; [|assumption]. apply sqrt_lt_R0; lra. + field; split. * lra. * assert(sqrt (1 - x²) >0) by (apply sqrt_lt_R0; lra); lra. Qed. Lemma acos_asin : forall x, -1 <= x <= 1 -> acos x = PI/2 - asin x. Proof. intros x. unfold acos, asin; repeat case Rle_dec; lra. Qed. Lemma asin_acos : forall x, -1 <= x <= 1 -> asin x = PI/2 - acos x. Proof. intros x. unfold acos, asin; repeat case Rle_dec; lra. Qed. (** ** arccosine of specific values *) Lemma acos_0 : acos 0 = PI/2. Proof. unfold acos; repeat case Rle_dec; [lra..|]. intros Hx1 Hx2. replace (0/_) with 0. { rewrite atan_0; field. } field. rewrite Rsqr_pow2; field_simplify (1 - 0^2). rewrite sqrt_1; lra. Qed. Lemma acos_1 : acos 1 = 0. Proof. unfold acos; repeat case Rle_dec; lra. Qed. Lemma acos_opp : forall x, acos (- x) = PI - acos x. Proof. intros x. unfold acos; repeat case Rle_dec; try lra. intros Hx1 Hx2 Hx3 Hx4. rewrite <- Rsqr_neg, Rdiv_opp_l, atan_opp. lra. Qed. Lemma acos_inv_sqrt2 : acos (/sqrt 2) = PI/4. Proof. rewrite acos_asin. { rewrite asin_inv_sqrt2. lra. } split. { apply Rlt_le. apply (Rlt_trans (-1) 0 (/ sqrt 2)); try lra. apply Rinv_0_lt_compat. apply Rlt_sqrt2_0. } replace 1 with (/ sqrt 1). { apply Rlt_le. apply Rinv_0_lt_contravar. { rewrite sqrt_1; lra. } apply sqrt_lt_1; lra. } rewrite sqrt_1; lra. Qed. (** ** Bounds of arccosine *) Lemma acos_bound : forall x, 0 <= acos x <= PI. Proof. intros x. pose proof PI_RGT_0. unfold acos; repeat case Rle_dec; try lra. intros Hx1 Hx2. pose proof atan_bound (x / sqrt (1 - x²)); lra. Qed. Lemma acos_bound_lt : forall x, -1 < x < 1 -> 0 < acos x < PI. Proof. intros x xB. pose proof PI_RGT_0. unfold acos; repeat case Rle_dec; try lra. intros Hx1 Hx2. pose proof atan_bound (x / sqrt (1 - x²)); lra. Qed. (** ** arccosine is the left and right inverse of cosine *) Lemma cos_acos : forall x, -1 <= x <= 1 -> cos (acos x) = x. Proof. intros x xB. assert (H : x = -1 \/ -1 < x) by lra. destruct H as [He|Hl]. - rewrite He. change (IZR (-1)) with (-(IZR 1)). now rewrite acos_opp, acos_1, Rminus_0_r, cos_PI. - assert (H : x = 1 \/ x < 1) by lra. destruct H as [He1|Hl1]. { now rewrite He1, acos_1, cos_0. } rewrite acos_asin, cos_shift; try lra. rewrite sin_asin; lra. Qed. Lemma acos_cos : forall x, 0 <= x <= PI -> acos (cos x) = x. Proof. intros x HB. apply cos_inj; try lra. { apply acos_bound. } apply cos_acos. apply COS_bound. Qed. (** ** Relation between arccosine, sine and tangent *) Lemma sin_acos : forall x, -1 <= x <= 1 -> sin (acos x) = sqrt (1 - x²). Proof. intros x Hxrange. pose proof (cos_acos x) ltac:(lra) as Hacos. remember (acos(x)) as α. rewrite <- Hacos. apply sin_cos. pose proof sin_ge_0 α. pose proof acos_bound x. lra. Qed. Lemma tan_acos : forall x, -1 <= x <= 1 -> tan (acos x) = sqrt (1 - x²) / x. Proof. intros x Hxrange. pose proof (cos_acos x) Hxrange as Hacos. remember (acos(x)) as α. rewrite <- Hacos. apply tan_cos. pose proof sin_ge_0 α. pose proof acos_bound x. lra. Qed. (** ** Derivative of arccosine *) Lemma derivable_pt_acos : forall x, -1 < x < 1 -> derivable_pt acos x. Proof. intros x H. eapply (derivable_pt_recip_interv_decr cos acos 0 PI); [shelve ..|]. rewrite <- (pr_nu cos (acos x) (derivable_pt_cos (acos x))). rewrite derive_pt_cos. (* The acos bounds are needed later, so pose them before acos is unfolded *) pose proof acos_bound_lt x ltac:(lra) as Hbnd. unfold acos in *. destruct (Rle_dec x (-1)); destruct (Rle_dec 1 x); [lra..|]. apply Rlt_not_eq, Ropp_lt_gt_0_contravar, Rlt_gt. apply sin_gt_0; lra. Unshelve. - pose proof PI_RGT_0 as HPi; lra. - rewrite cos_0; rewrite cos_PI; lra. - clear x H; intros x H1 H2. apply acos_bound. - intros a Ha; reg. - intros x0 H1 H2. unfold comp,id. apply cos_acos. rewrite cos_PI in H1; rewrite cos_0 in H2; lra. - intros x1 x2 H1 H2 H3. pose proof cos_decreasing_1 x1 x2; lra. Qed. Lemma derive_pt_acos : forall (x : R) (Hxrange : -1 < x < 1), derive_pt acos x (derivable_pt_acos x Hxrange) = -1 / sqrt (1 - x²). Proof. intros x Hxrange. epose proof (derive_pt_recip_interv_decr cos acos 0 PI x _ _ _ _ _ _ _ ) as Hd. rewrite <- (pr_nu cos (acos x) (derivable_pt_cos (acos x))) in Hd. rewrite <- (pr_nu acos x (derivable_pt_acos x Hxrange)) in Hd. rewrite derive_pt_cos in Hd. rewrite sin_acos in Hd by lra. rewrite Hd; field. apply Rgt_not_eq, Rlt_gt; rewrite <- sqrt_0. pose proof Rsqr_bounds_lt 1 x ltac:(lra) as Hxb; rewrite Rsqr_1 in Hxb. apply sqrt_lt_1; lra. Unshelve. - pose proof PI_RGT_0; lra. - rewrite cos_PI,cos_0; lra. - intros x1 x2 Ha Hb Hc. apply cos_decreasing_1; lra. - intros x0 Ha Hb. pose proof acos_bound x0; lra. - intros a Ha; reg. - intros x0 Ha Hb. unfold comp,id. apply cos_acos. rewrite cos_PI in Ha; rewrite cos_0 in Hb; lra. - rewrite <- (pr_nu cos (acos x) (derivable_pt_cos (acos x))). rewrite derive_pt_cos. rewrite sin_acos by lra. apply Rlt_not_eq; rewrite <- Ropp_0; apply Ropp_lt_contravar; rewrite <- sqrt_0. pose proof Rsqr_bounds_lt 1 x ltac:(lra) as Hxb; rewrite Rsqr_1 in Hxb. apply sqrt_lt_1; lra. Qed. Lemma sin_gt_x x : x < 0 -> x < sin x. Proof. intros. pose proof (sin_lt_x (- x)). pose proof (sin_neg x). lra. Qed. coq-8.20.0/theories/Reals/Raxioms.v000066400000000000000000000412071466560755400171120ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* Rrepr x <= Rrepr y. Proof. split. - intros [H|H] abs. + rewrite RbaseSymbolsImpl.Rlt_def in H. apply CRealLtEpsilon in H. exact (CRealLt_asym (Rrepr x) (Rrepr y) H abs). + destruct H. exact (CRealLt_asym (Rrepr x) (Rrepr x) abs abs). - intros. destruct (total_order_T x y). + destruct s. * left. exact r. * right. exact e. + rewrite RbaseSymbolsImpl.Rlt_def in r. apply CRealLtEpsilon in r. contradiction. Qed. Lemma Rrepr_appart : forall x y:R, (x <> y)%R -> Rrepr x # Rrepr y. Proof. intros. destruct (total_order_T x y). - destruct s. + left. rewrite RbaseSymbolsImpl.Rlt_def in r. apply CRealLtEpsilon. exact r. + contradiction. - right. rewrite RbaseSymbolsImpl.Rlt_def in r. apply CRealLtEpsilon. exact r. Qed. Lemma Rappart_repr : forall x y:R, Rrepr x # Rrepr y -> (x <> y)%R. Proof. intros x y [H|H] abs. - destruct abs. exact (CRealLt_asym (Rrepr x) (Rrepr x) H H). - destruct abs. exact (CRealLt_asym (Rrepr x) (Rrepr x) H H). Qed. Close Scope CReal_scope. (**********) Lemma Rplus_comm : forall r1 r2:R, r1 + r2 = r2 + r1. Proof. intros. apply Rquot1. do 2 rewrite Rrepr_plus. apply CReal_plus_comm. Qed. #[global] Hint Resolve Rplus_comm: real. (**********) Lemma Rplus_assoc : forall r1 r2 r3:R, r1 + r2 + r3 = r1 + (r2 + r3). Proof. intros. apply Rquot1. repeat rewrite Rrepr_plus. apply CReal_plus_assoc. Qed. #[global] Hint Resolve Rplus_assoc: real. (**********) Lemma Rplus_opp_r : forall r:R, r + - r = 0. Proof. intros. apply Rquot1. rewrite Rrepr_plus, Rrepr_opp, Rrepr_0. apply CReal_plus_opp_r. Qed. #[global] Hint Resolve Rplus_opp_r: real. (**********) Lemma Rplus_0_l : forall r:R, 0 + r = r. Proof. intros. apply Rquot1. rewrite Rrepr_plus, Rrepr_0. apply CReal_plus_0_l. Qed. #[global] Hint Resolve Rplus_0_l: real. (***********************************************************) (** ** Multiplication *) (***********************************************************) (**********) Lemma Rmult_comm : forall r1 r2:R, r1 * r2 = r2 * r1. Proof. intros. apply Rquot1. do 2 rewrite Rrepr_mult. apply CReal_mult_comm. Qed. #[global] Hint Resolve Rmult_comm: real. (**********) Lemma Rmult_assoc : forall r1 r2 r3:R, r1 * r2 * r3 = r1 * (r2 * r3). Proof. intros. apply Rquot1. repeat rewrite Rrepr_mult. apply CReal_mult_assoc. Qed. #[global] Hint Resolve Rmult_assoc: real. (**********) Lemma Rinv_l : forall r:R, r <> 0 -> / r * r = 1. Proof. intros. rewrite RinvImpl.Rinv_def; destruct (Req_appart_dec r R0). - contradiction. - apply Rquot1. rewrite Rrepr_mult, Rquot2, Rrepr_1. apply CReal_inv_l. Qed. #[global] Hint Resolve Rinv_l: real. (**********) Lemma Rmult_1_l : forall r:R, 1 * r = r. Proof. intros. apply Rquot1. rewrite Rrepr_mult, Rrepr_1. apply CReal_mult_1_l. Qed. #[global] Hint Resolve Rmult_1_l: real. (**********) Lemma R1_neq_R0 : 1 <> 0. Proof. intro abs. assert (CRealEq 1%CReal 0%CReal). { transitivity (Rrepr 1). - symmetry. replace 1%R with (Rabst 1%CReal). 2: unfold IZR,IPR; rewrite RbaseSymbolsImpl.R1_def; reflexivity. rewrite Rquot2. reflexivity. - transitivity (Rrepr 0). + rewrite abs. reflexivity. + replace 0%R with (Rabst 0%CReal). 2: unfold IZR; rewrite RbaseSymbolsImpl.R0_def; reflexivity. rewrite Rquot2. reflexivity. } pose proof (CRealLt_morph 0%CReal 0%CReal (CRealEq_refl _) 1%CReal 0%CReal H). apply (CRealLt_irrefl 0%CReal). apply H0. apply CRealLt_0_1. Qed. #[global] Hint Resolve R1_neq_R0: real. (*********************************************************) (** ** Distributivity *) (*********************************************************) (**********) Lemma Rmult_plus_distr_l : forall r1 r2 r3:R, r1 * (r2 + r3) = r1 * r2 + r1 * r3. Proof. intros. apply Rquot1. rewrite Rrepr_mult, Rrepr_plus, Rrepr_plus, Rrepr_mult, Rrepr_mult. apply CReal_mult_plus_distr_l. Qed. #[global] Hint Resolve Rmult_plus_distr_l: real. (*********************************************************) (** * Order *) (*********************************************************) (*********************************************************) (** ** Lower *) (*********************************************************) (**********) Lemma Rlt_asym : forall r1 r2:R, r1 < r2 -> ~ r2 < r1. Proof. intros. intro abs. rewrite RbaseSymbolsImpl.Rlt_def in H, abs. apply CRealLtEpsilon in H. apply CRealLtEpsilon in abs. apply (CRealLt_asym (Rrepr r1) (Rrepr r2)); assumption. Qed. (**********) Lemma Rlt_trans : forall r1 r2 r3:R, r1 < r2 -> r2 < r3 -> r1 < r3. Proof. intros. rewrite RbaseSymbolsImpl.Rlt_def. rewrite RbaseSymbolsImpl.Rlt_def in H, H0. apply CRealLtEpsilon in H. apply CRealLtEpsilon in H0. apply CRealLtForget. apply (CReal_lt_trans (Rrepr r1) (Rrepr r2) (Rrepr r3)); assumption. Qed. (**********) Lemma Rplus_lt_compat_l : forall r r1 r2:R, r1 < r2 -> r + r1 < r + r2. Proof. intros. rewrite RbaseSymbolsImpl.Rlt_def. rewrite RbaseSymbolsImpl.Rlt_def in H. do 2 rewrite Rrepr_plus. apply CRealLtForget. apply CReal_plus_lt_compat_l. apply CRealLtEpsilon. exact H. Qed. (**********) Lemma Rmult_lt_compat_l : forall r r1 r2:R, 0 < r -> r1 < r2 -> r * r1 < r * r2. Proof. intros. rewrite RbaseSymbolsImpl.Rlt_def. rewrite RbaseSymbolsImpl.Rlt_def in H. do 2 rewrite Rrepr_mult. apply CRealLtForget. apply CReal_mult_lt_compat_l. - rewrite <- (Rquot2 0%CReal). unfold IZR in H. rewrite RbaseSymbolsImpl.R0_def in H. apply CRealLtEpsilon. exact H. - rewrite RbaseSymbolsImpl.Rlt_def in H0. apply CRealLtEpsilon. exact H0. Qed. #[global] Hint Resolve Rlt_asym Rplus_lt_compat_l Rmult_lt_compat_l: real. (**********************************************************) (** * Injection from N to R *) (**********************************************************) (**********) Fixpoint INR (n:nat) : R := match n with | O => 0 | S O => 1 | S n => INR n + 1 end. Arguments INR n%_nat. (**********************************************************) (** * [R] Archimedean *) (**********************************************************) Lemma Rrepr_INR : forall n : nat, CRealEq (Rrepr (INR n)) (inject_Z (Z.of_nat n)). Proof. induction n. - apply Rrepr_0. - replace (Z.of_nat (S n)) with (Z.of_nat n + 1)%Z. + simpl. destruct n. * apply Rrepr_1. * rewrite Rrepr_plus,inject_Z_plus, <- IHn, Rrepr_1. reflexivity. + replace 1%Z with (Z.of_nat 1). * rewrite <- (Nat2Z.inj_add n 1). apply f_equal. rewrite Nat.add_comm. reflexivity. * reflexivity. Qed. Lemma Rrepr_IPR2 : forall n : positive, CRealEq (Rrepr (IPR_2 n)) (inject_Z (Z.pos (n~0))). Proof. induction n. - simpl. replace (Z.pos n~1~0) with ((Z.pos n~0 + 1) + (Z.pos n~0 + 1))%Z. + rewrite RbaseSymbolsImpl.R1_def, Rrepr_mult, inject_Z_plus, inject_Z_plus. rewrite Rrepr_plus, Rrepr_plus, <- IHn. rewrite Rquot2, CReal_mult_plus_distr_r, CReal_mult_1_l. rewrite (CReal_plus_comm 1%CReal). repeat rewrite CReal_plus_assoc. apply CReal_plus_morph. * reflexivity. * reflexivity. + repeat rewrite <- Pos2Z.inj_add. apply f_equal. rewrite Pos.add_diag. apply f_equal. rewrite Pos.add_1_r. reflexivity. - simpl. replace (Z.pos n~0~0) with ((Z.pos n~0) + (Z.pos n~0))%Z. + rewrite RbaseSymbolsImpl.R1_def, Rrepr_mult, inject_Z_plus. rewrite Rrepr_plus, <- IHn. rewrite Rquot2, CReal_mult_plus_distr_r, CReal_mult_1_l. reflexivity. + rewrite <- Pos2Z.inj_add. apply f_equal. rewrite Pos.add_diag. reflexivity. - simpl. rewrite Rrepr_plus, RbaseSymbolsImpl.R1_def, Rquot2. replace 2%Z with (1 + 1)%Z. + rewrite inject_Z_plus. reflexivity. + reflexivity. Qed. Lemma Rrepr_IPR : forall n : positive, CRealEq (Rrepr (IPR n)) (inject_Z (Z.pos n)). Proof. intro n. destruct n. - unfold IPR. rewrite Rrepr_plus. replace (n~1)%positive with (n~0 + 1)%positive. + rewrite Pos2Z.inj_add, inject_Z_plus, <- Rrepr_IPR2, CReal_plus_comm. rewrite RbaseSymbolsImpl.R1_def, Rquot2. reflexivity. + rewrite Pos.add_1_r. reflexivity. - apply Rrepr_IPR2. - unfold IPR. rewrite RbaseSymbolsImpl.R1_def. apply Rquot2. Qed. Lemma Rrepr_IZR : forall n : Z, CRealEq (Rrepr (IZR n)) (inject_Z n). Proof. intros [|p|n]. - unfold IZR. rewrite RbaseSymbolsImpl.R0_def. apply Rquot2. - apply Rrepr_IPR. - unfold IZR. rewrite Rrepr_opp, Rrepr_IPR. rewrite <- opp_inject_Z. replace (- Z.pos n)%Z with (Z.neg n); reflexivity. Qed. (**********) Lemma archimed : forall r:R, IZR (up r) > r /\ IZR (up r) - r <= 1. Proof. intro r. unfold up. destruct (CRealArchimedean (Rrepr r)) as [n nmaj], (total_order_T (IZR n - r) R1). 1:destruct s. - split. + unfold Rgt. rewrite RbaseSymbolsImpl.Rlt_def. rewrite Rrepr_IZR. apply CRealLtForget. apply nmaj. + unfold Rle. left. exact r0. - split. + unfold Rgt. rewrite RbaseSymbolsImpl.Rlt_def. rewrite Rrepr_IZR. apply CRealLtForget. apply nmaj. + right. exact e. - split. + unfold Rgt, Z.pred. rewrite RbaseSymbolsImpl.Rlt_def. rewrite Rrepr_IZR, inject_Z_plus. rewrite RbaseSymbolsImpl.Rlt_def in r0. rewrite Rrepr_minus in r0. rewrite <- (Rrepr_IZR n). apply CRealLtForget. apply CRealLtEpsilon in r0. unfold CReal_minus in r0. apply (CReal_plus_lt_compat_l (CReal_plus (Rrepr r) (CReal_opp (Rrepr R1)))) in r0. rewrite CReal_plus_assoc, CReal_plus_opp_l, CReal_plus_0_r, RbaseSymbolsImpl.R1_def, Rquot2, CReal_plus_comm, CReal_plus_assoc, <- (CReal_plus_assoc (CReal_opp (Rrepr r))), CReal_plus_opp_l, CReal_plus_0_l in r0. rewrite (opp_inject_Z 1). exact r0. + destruct (total_order_T (IZR (Z.pred n) - r) 1). * destruct s. -- left. exact r1. -- right. exact e. * exfalso. destruct nmaj as [_ nmaj]. pose proof Rrepr_IZR as iz. rewrite <- iz in nmaj. apply (Rlt_asym (IZR n) (r + 2)). -- rewrite RbaseSymbolsImpl.Rlt_def. rewrite Rrepr_plus. rewrite (Rrepr_plus 1 1). apply CRealLtForget. apply (CReal_lt_le_trans _ _ _ nmaj). unfold IZR, IPR. rewrite RbaseSymbolsImpl.R1_def, Rquot2. rewrite <- (inject_Z_plus 1 1). apply CRealLe_refl. -- clear nmaj. unfold Z.pred in r1. rewrite RbaseSymbolsImpl.Rlt_def in r1. rewrite Rrepr_minus, (Rrepr_IZR (n + -1)) in r1. rewrite inject_Z_plus, <- (Rrepr_IZR n) in r1. rewrite RbaseSymbolsImpl.Rlt_def, Rrepr_plus. apply CRealLtEpsilon in r1. apply (CReal_plus_lt_compat_l (CReal_plus (Rrepr r) 1%CReal)) in r1. apply CRealLtForget. apply (CReal_le_lt_trans _ (CReal_plus (CReal_plus (Rrepr r) (Rrepr 1)) 1%CReal)). ++ rewrite (Rrepr_plus 1 1). unfold IZR, IPR. rewrite RbaseSymbolsImpl.R1_def, (Rquot2 1%CReal), <- CReal_plus_assoc. apply CRealLe_refl. ++ rewrite <- (CReal_plus_comm (Rrepr 1)), <- CReal_plus_assoc, (CReal_plus_comm (Rrepr 1)) in r1. apply (CReal_lt_le_trans _ _ _ r1). unfold CReal_minus. rewrite (opp_inject_Z 1). rewrite (CReal_plus_comm (Rrepr (IZR n))), CReal_plus_assoc, <- (CReal_plus_assoc 1), <- (CReal_plus_assoc 1), CReal_plus_opp_r. rewrite CReal_plus_0_l, CReal_plus_comm, CReal_plus_assoc, CReal_plus_opp_l, CReal_plus_0_r. apply CRealLe_refl. Qed. (**********************************************************) (** * [R] Complete *) (**********************************************************) (**********) Definition is_upper_bound (E:R -> Prop) (m:R) := forall x:R, E x -> x <= m. (**********) Definition bound (E:R -> Prop) := exists m : R, is_upper_bound E m. (**********) Definition is_lub (E:R -> Prop) (m:R) := is_upper_bound E m /\ (forall b:R, is_upper_bound E b -> m <= b). (**********) Lemma completeness : forall E:R -> Prop, bound E -> (exists x : R, E x) -> { m:R | is_lub E m }. Proof. intros. pose (fun x:CReal => E (Rabst x)) as Er. assert (forall x y : CReal, CRealEq x y -> Er x <-> Er y) as Erproper. { intros. unfold Er. replace (Rabst x) with (Rabst y). - reflexivity. - apply Rquot1. do 2 rewrite Rquot2. split; apply H1. } assert (exists x : CReal, Er x) as Einhab. { destruct H0. exists (Rrepr x). unfold Er. replace (Rabst (Rrepr x)) with x. - exact H0. - apply Rquot1. rewrite Rquot2. reflexivity. } assert (exists x : CReal, (forall y:CReal, Er y -> CRealLe y x)) as Ebound. { destruct H. exists (Rrepr x). intros y Ey. rewrite <- (Rquot2 y). apply Rrepr_le. apply H. exact Ey. } destruct (@CR_sig_lub CRealConstructive Er Erproper sig_forall_dec sig_not_dec Einhab Ebound). exists (Rabst x). split. - intros y Ey. apply Rrepr_le. rewrite Rquot2. unfold CRealLe. apply a. unfold Er. replace (Rabst (Rrepr y)) with y. + exact Ey. + apply Rquot1. rewrite Rquot2. reflexivity. - intros. destruct a. apply Rrepr_le. rewrite Rquot2. unfold CRealLe. apply H3. intros y Ey. intros. rewrite <- (Rquot2 y) in H4. apply Rrepr_le in H4. + exact H4. + apply H1, Ey. Qed. coq-8.20.0/theories/Reals/Rbase.v000066400000000000000000000014061466560755400165210ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* x | right _ => y end. (*********) Lemma Rmin_case : forall r1 r2 (P:R -> Type), P r1 -> P r2 -> P (Rmin r1 r2). Proof. intros r1 r2 P H1 H2; unfold Rmin; case (Rle_dec r1 r2); auto. Qed. (*********) Lemma Rmin_case_strong : forall r1 r2 (P:R -> Type), (r1 <= r2 -> P r1) -> (r2 <= r1 -> P r2) -> P (Rmin r1 r2). Proof. intros r1 r2 P H1 H2; unfold Rmin; destruct (Rle_dec r1 r2); auto with real. Qed. (*********) Lemma Rmin_Rgt_l : forall r1 r2 r, Rmin r1 r2 > r -> r1 > r /\ r2 > r. Proof. intros r1 r2 r; unfold Rmin; case (Rle_dec r1 r2) as [Hle|Hnle]; intros. - split. + assumption. + unfold Rgt; exact (Rlt_le_trans r r1 r2 H Hle). - split. + generalize (Rnot_le_lt r1 r2 Hnle); intro; exact (Rgt_trans r1 r2 r H0 H). + assumption. Qed. (*********) Lemma Rmin_Rgt_r : forall r1 r2 r, r1 > r /\ r2 > r -> Rmin r1 r2 > r. Proof. intros; unfold Rmin; case (Rle_dec r1 r2); elim H; clear H; intros; assumption. Qed. (*********) Lemma Rmin_Rgt : forall r1 r2 r, Rmin r1 r2 > r <-> r1 > r /\ r2 > r. Proof. intros; split. - exact (Rmin_Rgt_l r1 r2 r). - exact (Rmin_Rgt_r r1 r2 r). Qed. (*********) Lemma Rmin_l : forall x y:R, Rmin x y <= x. Proof. intros; unfold Rmin; case (Rle_dec x y); intro H1; [ right; reflexivity | auto with real ]. Qed. (*********) Lemma Rmin_r : forall x y:R, Rmin x y <= y. Proof. intros; unfold Rmin; case (Rle_dec x y); intro H1; [ assumption | auto with real ]. Qed. (*********) Lemma Rmin_left : forall x y, x <= y -> Rmin x y = x. Proof. intros; apply Rmin_case_strong; auto using Rle_antisym. Qed. (*********) Lemma Rmin_right : forall x y, y <= x -> Rmin x y = y. Proof. intros; apply Rmin_case_strong; auto using Rle_antisym. Qed. (*********) Lemma Rle_min_compat_r : forall x y z, x <= y -> Rmin x z <= Rmin y z. Proof. intros; do 2 (apply Rmin_case_strong; intro); eauto using Rle_trans, Rle_refl. Qed. (*********) Lemma Rle_min_compat_l : forall x y z, x <= y -> Rmin z x <= Rmin z y. Proof. intros; do 2 (apply Rmin_case_strong; intro); eauto using Rle_trans, Rle_refl. Qed. (*********) Lemma Rmin_comm : forall x y:R, Rmin x y = Rmin y x. Proof. intros; unfold Rmin; case (Rle_dec x y); case (Rle_dec y x); intros; try reflexivity || (apply Rle_antisym; assumption || auto with real). Qed. (*********) Lemma Rmin_stable_in_posreal : forall x y:posreal, 0 < Rmin x y. Proof. intros; apply Rmin_Rgt_r; split; [ apply (cond_pos x) | apply (cond_pos y) ]. Qed. (*********) Lemma Rmin_pos : forall x y:R, 0 < x -> 0 < y -> 0 < Rmin x y. Proof. intros; unfold Rmin. case (Rle_dec x y); intro; assumption. Qed. (*********) Lemma Rmin_glb : forall x y z:R, z <= x -> z <= y -> z <= Rmin x y. Proof. intros; unfold Rmin; case (Rle_dec x y); intro; assumption. Qed. (*********) Lemma Rmin_glb_lt : forall x y z:R, z < x -> z < y -> z < Rmin x y. Proof. intros; unfold Rmin; case (Rle_dec x y); intro; assumption. Qed. (*******************************) (** * Rmax *) (*******************************) (*********) Definition Rmax (x y:R) : R := match Rle_dec x y with | left _ => y | right _ => x end. (*********) Lemma Rmax_case : forall r1 r2 (P:R -> Type), P r1 -> P r2 -> P (Rmax r1 r2). Proof. intros r1 r2 P H1 H2; unfold Rmax; case (Rle_dec r1 r2); auto. Qed. (*********) Lemma Rmax_case_strong : forall r1 r2 (P:R -> Type), (r2 <= r1 -> P r1) -> (r1 <= r2 -> P r2) -> P (Rmax r1 r2). Proof. intros r1 r2 P H1 H2; unfold Rmax; case (Rle_dec r1 r2); auto with real. Qed. (*********) Lemma Rmax_Rle : forall r1 r2 r, r <= Rmax r1 r2 <-> r <= r1 \/ r <= r2. Proof. intros; split. - unfold Rmax; case (Rle_dec r1 r2); intros; auto. - intro; unfold Rmax; case (Rle_dec r1 r2) as [|Hnle]; elim H; clear H; intros; auto. + apply (Rle_trans r r1 r2); auto. + generalize (Rnot_le_lt r1 r2 Hnle); clear Hnle; intro; unfold Rgt in H0; apply (Rlt_le r r1 (Rle_lt_trans r r2 r1 H H0)). Qed. Lemma Rmax_comm : forall x y:R, Rmax x y = Rmax y x. Proof. intros p q; unfold Rmax; case (Rle_dec p q); case (Rle_dec q p); auto; intros H1 H2; apply Rle_antisym; auto with real. Qed. (* begin hide *) Notation RmaxSym := Rmax_comm (only parsing). (* end hide *) (*********) Lemma Rmax_l : forall x y:R, x <= Rmax x y. Proof. intros; unfold Rmax; case (Rle_dec x y); intro H1; [ assumption | auto with real ]. Qed. (*********) Lemma Rmax_r : forall x y:R, y <= Rmax x y. Proof. intros; unfold Rmax; case (Rle_dec x y); intro H1; [ right; reflexivity | auto with real ]. Qed. (* begin hide *) Notation RmaxLess1 := Rmax_l (only parsing). Notation RmaxLess2 := Rmax_r (only parsing). (* end hide *) (*********) Lemma Rmax_left : forall x y, y <= x -> Rmax x y = x. Proof. intros; apply Rmax_case_strong; auto using Rle_antisym. Qed. (*********) Lemma Rmax_right : forall x y, x <= y -> Rmax x y = y. Proof. intros; apply Rmax_case_strong; auto using Rle_antisym. Qed. (*********) Lemma Rle_max_compat_r : forall x y z, x <= y -> Rmax x z <= Rmax y z. Proof. intros; do 2 (apply Rmax_case_strong; intro); eauto using Rle_trans, Rle_refl. Qed. (*********) Lemma Rle_max_compat_l : forall x y z, x <= y -> Rmax z x <= Rmax z y. Proof. intros; do 2 (apply Rmax_case_strong; intro); eauto using Rle_trans, Rle_refl. Qed. (*********) Lemma RmaxRmult : forall (p q:R) r, 0 <= r -> Rmax (r * p) (r * q) = r * Rmax p q. Proof. intros p q r H; unfold Rmax. case (Rle_dec p q); case (Rle_dec (r * p) (r * q)); auto; intros H1 H2; auto. - case H; intros E1. + case H1; auto with real. + rewrite <- E1; repeat rewrite Rmult_0_l; auto. - case H; intros E1. + case H2; auto with real. apply Rmult_le_reg_l with (r := r); auto. + rewrite <- E1; repeat rewrite Rmult_0_l; auto. Qed. (*********) Lemma Rmax_stable_in_negreal : forall x y:negreal, Rmax x y < 0. Proof. intros; unfold Rmax; case (Rle_dec x y); intro; [ apply (cond_neg y) | apply (cond_neg x) ]. Qed. (*********) Lemma Rmax_lub : forall x y z:R, x <= z -> y <= z -> Rmax x y <= z. Proof. intros; unfold Rmax; case (Rle_dec x y); intro; assumption. Qed. (*********) Lemma Rmax_lub_lt : forall x y z:R, x < z -> y < z -> Rmax x y < z. Proof. intros; unfold Rmax; case (Rle_dec x y); intro; assumption. Qed. Lemma Rmax_Rlt : forall x y z, Rmax x y < z <-> x < z /\ y < z. Proof. intros x y z; split. - unfold Rmax; case (Rle_dec x y). + intros xy yz; split;[apply Rle_lt_trans with y|]; assumption. + intros xz xy; split;[|apply Rlt_trans with x;[apply Rnot_le_gt|]];assumption. - intros [h h']; apply Rmax_lub_lt; assumption. Qed. (*********) Lemma Rmax_neg : forall x y:R, x < 0 -> y < 0 -> Rmax x y < 0. Proof. intros; unfold Rmax. case (Rle_dec x y); intro; assumption. Qed. (*******************************) (** * Rabsolu *) (*******************************) (*********) Lemma Rcase_abs : forall r, {r < 0} + {r >= 0}. Proof. intro; generalize (Rle_dec 0 r); intro X; elim X; intro H; clear X. - right; apply (Rle_ge 0 r H). - left; fold (0 > r); apply (Rnot_le_lt 0 r H). Qed. (*********) Definition Rabs r : R := match Rcase_abs r with | left _ => - r | right _ => r end. (*********) Lemma Rabs_R0 : Rabs 0 = 0. Proof. unfold Rabs; case (Rcase_abs 0); auto; intro. generalize (Rlt_irrefl 0); intro; exfalso; auto. Qed. Lemma Rabs_R1 : Rabs 1 = 1. Proof. unfold Rabs; case (Rcase_abs 1); auto with real. intros H; absurd (1 < 0); auto with real. Qed. (*********) Lemma Rabs_no_R0 : forall r, r <> 0 -> Rabs r <> 0. Proof. intros; unfold Rabs; case (Rcase_abs r); intro; auto. apply Ropp_neq_0_compat; auto. Qed. (*********) Lemma Rabs_left : forall r, r < 0 -> Rabs r = - r. Proof. intros; unfold Rabs; case (Rcase_abs r); trivial; intro; absurd (r >= 0). - exact (Rlt_not_ge r 0 H). - assumption. Qed. (*********) Lemma Rabs_right : forall r, r >= 0 -> Rabs r = r. Proof. intros; unfold Rabs; case (Rcase_abs r) as [Hlt|Hge]. - absurd (r >= 0). + exact (Rlt_not_ge r 0 Hlt). + assumption. - trivial. Qed. Lemma Rabs_left1 : forall a:R, a <= 0 -> Rabs a = - a. Proof. intros a H; case H; intros H1. - apply Rabs_left; auto. - rewrite H1; simpl; rewrite Rabs_right; auto with real. Qed. (*********) Lemma Rabs_pos : forall x:R, 0 <= Rabs x. Proof. intros; unfold Rabs; case (Rcase_abs x) as [Hlt|Hge]. - generalize (Ropp_lt_gt_contravar x 0 Hlt); intro; unfold Rgt in H; rewrite Ropp_0 in H; left; assumption. - apply Rge_le; assumption. Qed. Lemma Rle_abs : forall x:R, x <= Rabs x. Proof. intro; unfold Rabs; case (Rcase_abs x); intros;auto with real. apply Rminus_le; rewrite <- Rplus_0_r; unfold Rminus; rewrite Ropp_involutive; auto with real. Qed. Definition RRle_abs := Rle_abs. Lemma Rabs_le : forall a b, -b <= a <= b -> Rabs a <= b. Proof. intros a b; unfold Rabs; case Rcase_abs. - intros _ [it _]; apply Ropp_le_cancel; rewrite Ropp_involutive; exact it. - intros _ [_ it]; exact it. Qed. (*********) Lemma Rabs_pos_eq : forall x:R, 0 <= x -> Rabs x = x. Proof. intros; unfold Rabs; case (Rcase_abs x) as [Hlt|Hge]; [ generalize (Rgt_not_le 0 x Hlt); intro; exfalso; auto | trivial ]. Qed. (*********) Lemma Rabs_Rabsolu : forall x:R, Rabs (Rabs x) = Rabs x. Proof. intro; apply (Rabs_pos_eq (Rabs x) (Rabs_pos x)). Qed. (*********) Lemma Rabs_pos_lt : forall x:R, x <> 0 -> 0 < Rabs x. Proof. intros; destruct (Rabs_pos x) as [|Heq]; auto. apply Rabs_no_R0 in H; symmetry in Heq; contradiction. Qed. (*********) Lemma Rabs_minus_sym : forall x y:R, Rabs (x - y) = Rabs (y - x). Proof. intros; unfold Rabs; case (Rcase_abs (x - y)) as [Hlt|Hge]; case (Rcase_abs (y - x)) as [Hlt'|Hge']. - apply Rminus_lt, Rlt_asym in Hlt; apply Rminus_lt in Hlt'; contradiction. - rewrite (Ropp_minus_distr x y); trivial. - rewrite (Ropp_minus_distr y x); trivial. - destruct Hge; destruct Hge'. + apply Ropp_lt_gt_0_contravar in H; rewrite (Ropp_minus_distr x y) in H; apply Rlt_asym in H0; contradiction. + apply Rminus_diag_uniq in H0 as ->; trivial. + apply Rminus_diag_uniq in H as ->; trivial. + apply Rminus_diag_uniq in H0 as ->; trivial. Qed. (*********) Lemma Rabs_mult : forall x y:R, Rabs (x * y) = Rabs x * Rabs y. Proof. intros; unfold Rabs; case (Rcase_abs (x * y)) as [Hlt|Hge]; case (Rcase_abs x) as [Hltx|Hgex]; case (Rcase_abs y) as [Hlty|Hgey]; auto. - apply Rmult_lt_gt_compat_neg_l with (r:=x), Rlt_asym in Hlty; trivial. rewrite Rmult_0_r in Hlty; contradiction. - rewrite (Ropp_mult_distr_l_reverse x y); trivial. - rewrite (Rmult_comm x (- y)); rewrite (Ropp_mult_distr_l_reverse y x); rewrite (Rmult_comm x y); trivial. - destruct Hgex as [| ->], Hgey as [| ->]. + apply Rmult_lt_compat_l with (r:=x), Rlt_asym in H0; trivial. rewrite Rmult_0_r in H0; contradiction. + rewrite Rmult_0_r in Hlt; contradiction (Rlt_irrefl 0). + rewrite Rmult_0_l in Hlt; contradiction (Rlt_irrefl 0). + rewrite Rmult_0_l in Hlt; contradiction (Rlt_irrefl 0). - rewrite (Rmult_opp_opp x y); trivial. - destruct Hge. + destruct Hgey. * apply Rmult_lt_compat_r with (r:=y), Rlt_asym in Hltx; trivial. rewrite Rmult_0_l in Hltx; contradiction. * rewrite H0, Rmult_0_r in H; contradiction (Rlt_irrefl 0). + rewrite <- Ropp_mult_distr_l, H, Ropp_0; trivial. - destruct Hge. + destruct Hgex. * apply Rmult_lt_compat_l with (r:=x), Rlt_asym in Hlty; trivial. rewrite Rmult_0_r in Hlty; contradiction. * rewrite H0, 2!Rmult_0_l; trivial. + rewrite <- Ropp_mult_distr_r, H, Ropp_0; trivial. Qed. (*********) Lemma Rabs_inv r : Rabs (/ r) = / Rabs r. Proof. unfold Rabs; case (Rcase_abs r) as [Hlt|Hge]; case (Rcase_abs (/ r)) as [Hlt'|Hge']; auto; intros. - apply eq_sym, Rinv_opp. - rewrite Rinv_opp. destruct Hge' as [| ->]. + apply Rinv_lt_0_compat, Rlt_asym in Hlt; contradiction. + rewrite Ropp_0; trivial. - destruct Hge as [H0| ->]. + apply Rinv_0_lt_compat, Rlt_asym in H0; contradiction. + rewrite Rinv_0. apply Ropp_0. Qed. Lemma Rabs_Rinv_depr : forall r, r <> 0 -> Rabs (/ r) = / Rabs r. Proof. intros r Hr. apply Rabs_inv. Qed. #[deprecated(since="8.16",note="Use Rabs_inv.")] Notation Rabs_Rinv := Rabs_Rinv_depr. Lemma Rabs_Ropp : forall x:R, Rabs (- x) = Rabs x. Proof. intro; replace (-x) with (-1 * x) by ring. rewrite Rabs_mult. replace (Rabs (-1)) with 1. - apply Rmult_1_l. - unfold Rabs; case (Rcase_abs (-1)). + intro; ring. + rewrite <- Ropp_0. intro H0; apply Ropp_ge_cancel in H0. elim (Rge_not_lt _ _ H0). apply Rlt_0_1. Qed. (*********) Lemma Rabs_triang : forall a b:R, Rabs (a + b) <= Rabs a + Rabs b. Proof. intros a b; unfold Rabs; case (Rcase_abs (a + b)) as [Hlt|Hge]; case (Rcase_abs a) as [Hlta|Hgea]; case (Rcase_abs b) as [Hltb|Hgeb]. - apply (Req_le (- (a + b)) (- a + - b)); rewrite (Ropp_plus_distr a b); reflexivity. - (**) rewrite (Ropp_plus_distr a b); apply (Rplus_le_compat_l (- a) (- b) b); unfold Rle; elim Hgeb; intro. + left; unfold Rgt in H; generalize (Rplus_lt_compat_l (- b) 0 b H); intro; elim (Rplus_ne (- b)); intros v w; rewrite v in H0; clear v w; rewrite (Rplus_opp_l b) in H0; apply (Rlt_trans (- b) 0 b H0 H). + right; rewrite H; apply Ropp_0. - (**) rewrite (Ropp_plus_distr a b); rewrite (Rplus_comm (- a) (- b)); rewrite (Rplus_comm a (- b)); apply (Rplus_le_compat_l (- b) (- a) a); unfold Rle; elim Hgea; intro. + left; unfold Rgt in H; generalize (Rplus_lt_compat_l (- a) 0 a H); intro; elim (Rplus_ne (- a)); intros v w; rewrite v in H0; clear v w; rewrite (Rplus_opp_l a) in H0; apply (Rlt_trans (- a) 0 a H0 H). + right; rewrite H; apply Ropp_0. - (**) exfalso; generalize (Rplus_ge_compat_l a b 0 Hgeb); intro; elim (Rplus_ne a); intros v w; rewrite v in H; clear v w; generalize (Rge_trans (a + b) a 0 H Hgea); intro; clear H; unfold Rge in H0; elim H0; intro; clear H0. + unfold Rgt in H; generalize (Rlt_asym (a + b) 0 Hlt); intro; auto. + absurd (a + b = 0); auto. apply (Rlt_dichotomy_converse (a + b) 0); left; assumption. - (**) exfalso; generalize (Rplus_lt_compat_l a b 0 Hltb); intro; elim (Rplus_ne a); intros v w; rewrite v in H; clear v w; generalize (Rlt_trans (a + b) a 0 H Hlta); intro; clear H; destruct Hge. + unfold Rgt in H; generalize (Rlt_trans (a + b) 0 (a + b) H0 H); intro; apply (Rlt_irrefl (a + b)); assumption. + rewrite H in H0; apply (Rlt_irrefl 0); assumption. - (**) rewrite (Rplus_comm a b); rewrite (Rplus_comm (- a) b); apply (Rplus_le_compat_l b a (- a)); apply (Rminus_le a (- a)); unfold Rminus; rewrite (Ropp_involutive a); generalize (Rplus_lt_compat_l a a 0 Hlta); clear Hge Hgeb; intro; elim (Rplus_ne a); intros v w; rewrite v in H; clear v w; generalize (Rlt_trans (a + a) a 0 H Hlta); intro; apply (Rlt_le (a + a) 0 H0). - (**) apply (Rplus_le_compat_l a b (- b)); apply (Rminus_le b (- b)); unfold Rminus; rewrite (Ropp_involutive b); generalize (Rplus_lt_compat_l b b 0 Hltb); clear Hge Hgea; intro; elim (Rplus_ne b); intros v w; rewrite v in H; clear v w; generalize (Rlt_trans (b + b) b 0 H Hltb); intro; apply (Rlt_le (b + b) 0 H0). - (**) unfold Rle; right; reflexivity. Qed. (*********) Lemma Rabs_triang_inv : forall a b:R, Rabs a - Rabs b <= Rabs (a - b). Proof. intros; apply (Rplus_le_reg_l (Rabs b) (Rabs a - Rabs b) (Rabs (a - b))); unfold Rminus; rewrite <- (Rplus_assoc (Rabs b) (Rabs a) (- Rabs b)); rewrite (Rplus_comm (Rabs b) (Rabs a)); rewrite (Rplus_assoc (Rabs a) (Rabs b) (- Rabs b)); rewrite (Rplus_opp_r (Rabs b)); rewrite (proj1 (Rplus_ne (Rabs a))); replace (Rabs a) with (Rabs (a + 0)). - rewrite <- (Rplus_opp_r b); rewrite <- (Rplus_assoc a b (- b)); rewrite (Rplus_comm a b); rewrite (Rplus_assoc b a (- b)). exact (Rabs_triang b (a + - b)). - rewrite (proj1 (Rplus_ne a)); trivial. Qed. (* ||a|-|b||<=|a-b| *) Lemma Rabs_triang_inv2 : forall a b:R, Rabs (Rabs a - Rabs b) <= Rabs (a - b). Proof. cut (forall a b:R, Rabs b <= Rabs a -> Rabs (Rabs a - Rabs b) <= Rabs (a - b)). - intros; destruct (Rtotal_order (Rabs a) (Rabs b)) as [Hlt| [Heq| Hgt]]. + rewrite <- (Rabs_Ropp (Rabs a - Rabs b)); rewrite <- (Rabs_Ropp (a - b)); do 2 rewrite Ropp_minus_distr. apply H; left; assumption. + rewrite Heq; unfold Rminus; rewrite Rplus_opp_r; rewrite Rabs_R0; apply Rabs_pos. + apply H; left; assumption. - intros; replace (Rabs (Rabs a - Rabs b)) with (Rabs a - Rabs b). + apply Rabs_triang_inv. + rewrite (Rabs_right (Rabs a - Rabs b)); [ reflexivity | apply Rle_ge; apply Rplus_le_reg_l with (Rabs b); rewrite Rplus_0_r; replace (Rabs b + (Rabs a - Rabs b)) with (Rabs a); [ assumption | ring ] ]. Qed. (*********) Lemma Rabs_def1 : forall x a:R, x < a -> - a < x -> Rabs x < a. Proof. unfold Rabs; intros; case (Rcase_abs x); intro. - generalize (Ropp_lt_gt_contravar (- a) x H0); unfold Rgt; rewrite Ropp_involutive; intro; assumption. - assumption. Qed. (*********) Lemma Rabs_def2 : forall x a:R, Rabs x < a -> x < a /\ - a < x. Proof. unfold Rabs; intro x; case (Rcase_abs x) as [Hlt|Hge]; intros. - generalize (Ropp_gt_lt_0_contravar x Hlt); unfold Rgt; intro; generalize (Rlt_trans 0 (- x) a H0 H); intro; split. + apply (Rlt_trans x 0 a Hlt H1). + generalize (Ropp_lt_gt_contravar (- x) a H); rewrite (Ropp_involutive x); unfold Rgt; trivial. - fold (a > x) in H; generalize (Rgt_ge_trans a x 0 H Hge); intro; generalize (Ropp_lt_gt_0_contravar a H0); intro; fold (0 > - a); generalize (Rge_gt_trans x 0 (- a) Hge H1); unfold Rgt; intro; split; assumption. Qed. Lemma RmaxAbs : forall (p q:R) r, p <= q -> q <= r -> Rabs q <= Rmax (Rabs p) (Rabs r). Proof. intros p q r H' H'0; case (Rle_or_lt 0 p); intros H'1. - repeat rewrite Rabs_right; auto with real. + apply Rle_trans with r; auto with real. apply RmaxLess2; auto. + apply Rge_trans with p; auto with real; apply Rge_trans with q; auto with real. + apply Rge_trans with p; auto with real. - rewrite (Rabs_left p); auto. case (Rle_or_lt 0 q); intros H'2. + repeat rewrite Rabs_right; auto with real. * apply Rle_trans with r; auto. apply RmaxLess2; auto. * apply Rge_trans with q; auto with real. + rewrite (Rabs_left q); auto. case (Rle_or_lt 0 r); intros H'3. * repeat rewrite Rabs_right; auto with real. apply Rle_trans with (- p); auto with real. apply RmaxLess1; auto. * rewrite (Rabs_left r); auto. apply Rle_trans with (- p); auto with real. apply RmaxLess1; auto. Qed. Lemma Rabs_Zabs : forall z:Z, Rabs (IZR z) = IZR (Z.abs z). Proof. intros z; case z; unfold Z.abs. - apply Rabs_R0. - now intros p0; apply Rabs_pos_eq, (IZR_le 0). - unfold IZR at 1. intros p0; rewrite Rabs_Ropp. now apply Rabs_pos_eq, (IZR_le 0). Qed. Lemma abs_IZR : forall z, IZR (Z.abs z) = Rabs (IZR z). Proof. intros. now rewrite Rabs_Zabs. Qed. Lemma Ropp_Rmax : forall x y, - Rmax x y = Rmin (-x) (-y). intros x y; apply Rmax_case_strong. - now intros w; rewrite Rmin_left;[ | apply Rge_le, Ropp_le_ge_contravar]. - now intros w; rewrite Rmin_right; [ | apply Rge_le, Ropp_le_ge_contravar]. Qed. Lemma Ropp_Rmin : forall x y, - Rmin x y = Rmax (-x) (-y). intros x y; apply Rmin_case_strong. - now intros w; rewrite Rmax_left;[ | apply Rge_le, Ropp_le_ge_contravar]. - now intros w; rewrite Rmax_right; [ | apply Rge_le, Ropp_le_ge_contravar]. Qed. Lemma Rmax_assoc : forall a b c, Rmax a (Rmax b c) = Rmax (Rmax a b) c. Proof. intros a b c. unfold Rmax; destruct (Rle_dec b c); destruct (Rle_dec a b); destruct (Rle_dec a c); destruct (Rle_dec b c); auto with real; match goal with | id : ~ ?x <= ?y, id2 : ?x <= ?z |- _ => case id; apply Rle_trans with z; auto with real | id : ~ ?x <= ?y, id2 : ~ ?z <= ?x |- _ => case id; apply Rle_trans with z; auto with real end. Qed. Lemma Rminmax : forall a b, Rmin a b <= Rmax a b. Proof. intros a b; destruct (Rle_dec a b). - rewrite Rmin_left, Rmax_right; assumption. - now rewrite Rmin_right, Rmax_left; assumption || apply Rlt_le, Rnot_le_gt. Qed. Lemma Rmin_assoc : forall x y z, Rmin x (Rmin y z) = Rmin (Rmin x y) z. Proof. intros a b c. unfold Rmin; destruct (Rle_dec b c); destruct (Rle_dec a b); destruct (Rle_dec a c); destruct (Rle_dec b c); auto with real; match goal with | id : ~ ?x <= ?y, id2 : ?x <= ?z |- _ => case id; apply Rle_trans with z; auto with real | id : ~ ?x <= ?y, id2 : ~ ?z <= ?x |- _ => case id; apply Rle_trans with z; auto with real end. Qed. coq-8.20.0/theories/Reals/Rcomplete.v000066400000000000000000000205411466560755400174200ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* R, Cauchy_crit Un -> { l:R | Un_cv Un l } . Proof. intros. set (Vn := sequence_minorant Un (cauchy_min Un H)). set (Wn := sequence_majorant Un (cauchy_maj Un H)). pose proof (maj_cv Un H) as (x,p). fold Wn in p. pose proof (min_cv Un H) as (x0,p0). fold Vn in p0. cut (x = x0). - intros H2. exists x. rewrite <- H2 in p0. unfold Un_cv. intros. unfold Un_cv in p; unfold Un_cv in p0. cut (0 < eps / 3). + intro H4. elim (p (eps / 3) H4); intros. elim (p0 (eps / 3) H4); intros. exists (max x1 x2). intros. unfold Rdist. apply Rle_lt_trans with (Rabs (Un n - Vn n) + Rabs (Vn n - x)). { replace (Un n - x) with (Un n - Vn n + (Vn n - x)); [ apply Rabs_triang | ring ]. } apply Rle_lt_trans with (Rabs (Wn n - Vn n) + Rabs (Vn n - x)). * do 2 rewrite <- (Rplus_comm (Rabs (Vn n - x))). apply Rplus_le_compat_l. repeat rewrite Rabs_right. -- unfold Rminus; do 2 rewrite <- (Rplus_comm (- Vn n)); apply Rplus_le_compat_l. assert (H8 := Vn_Un_Wn_order Un (cauchy_maj Un H) (cauchy_min Un H)). fold Vn Wn in H8. elim (H8 n); intros. assumption. -- apply Rle_ge. unfold Rminus; apply Rplus_le_reg_l with (Vn n). rewrite Rplus_0_r. replace (Vn n + (Wn n + - Vn n)) with (Wn n); [ idtac | ring ]. assert (H8 := Vn_Un_Wn_order Un (cauchy_maj Un H) (cauchy_min Un H)). fold Vn Wn in H8. elim (H8 n); intros. apply Rle_trans with (Un n); assumption. -- apply Rle_ge. unfold Rminus; apply Rplus_le_reg_l with (Vn n). rewrite Rplus_0_r. replace (Vn n + (Un n + - Vn n)) with (Un n); [ idtac | ring ]. assert (H8 := Vn_Un_Wn_order Un (cauchy_maj Un H) (cauchy_min Un H)). fold Vn Wn in H8. elim (H8 n); intros. assumption. * apply Rle_lt_trans with (Rabs (Wn n - x) + Rabs (x - Vn n) + Rabs (Vn n - x)). -- do 2 rewrite <- (Rplus_comm (Rabs (Vn n - x))). apply Rplus_le_compat_l. replace (Wn n - Vn n) with (Wn n - x + (x - Vn n)); [ apply Rabs_triang | ring ]. -- apply Rlt_le_trans with (eps / 3 + eps / 3 + eps / 3). 1:repeat apply Rplus_lt_compat. ++ unfold Rdist in H1. apply H1. unfold ge; apply Nat.le_trans with (max x1 x2). ** apply Nat.le_max_l. ** assumption. ++ rewrite <- Rabs_Ropp. replace (- (x - Vn n)) with (Vn n - x); [ idtac | ring ]. unfold Rdist in H3. apply H3. unfold ge; apply Nat.le_trans with (max x1 x2). ** apply Nat.le_max_r. ** assumption. ++ unfold Rdist in H3. apply H3. unfold ge; apply Nat.le_trans with (max x1 x2). ** apply Nat.le_max_r. ** assumption. ++ right. pattern eps at 4; replace eps with (3 * (eps / 3)). ** ring. ** unfold Rdiv; rewrite <- Rmult_assoc; apply Rmult_inv_r_id_m; discrR. + unfold Rdiv; apply Rmult_lt_0_compat; [ assumption | apply Rinv_0_lt_compat; prove_sup0 ]. - apply cond_eq. intros. cut (0 < eps / 5). + intro. unfold Un_cv in p; unfold Un_cv in p0. unfold Rdist in p; unfold Rdist in p0. elim (p (eps / 5) H1); intros N1 H4. elim (p0 (eps / 5) H1); intros N2 H5. unfold Cauchy_crit in H. unfold Rdist in H. elim (H (eps / 5) H1); intros N3 H6. set (N := max (max N1 N2) N3). apply Rle_lt_trans with (Rabs (x - Wn N) + Rabs (Wn N - x0)). { replace (x - x0) with (x - Wn N + (Wn N - x0)); [ apply Rabs_triang | ring ]. } apply Rle_lt_trans with (Rabs (x - Wn N) + Rabs (Wn N - Vn N) + Rabs (Vn N - x0)). * rewrite Rplus_assoc. apply Rplus_le_compat_l. replace (Wn N - x0) with (Wn N - Vn N + (Vn N - x0)); [ apply Rabs_triang | ring ]. * replace eps with (eps / 5 + 3 * (eps / 5) + eps / 5). -- repeat apply Rplus_lt_compat. ++ rewrite <- Rabs_Ropp. replace (- (x - Wn N)) with (Wn N - x); [ apply H4 | ring ]. unfold ge, N. apply Nat.le_trans with (max N1 N2); apply Nat.le_max_l. ++ unfold Wn, Vn. unfold sequence_majorant, sequence_minorant. assert (H7 := approx_maj (fun k:nat => Un (N + k)%nat) (maj_ss Un N (cauchy_maj Un H))). assert (H8 := approx_min (fun k:nat => Un (N + k)%nat) (min_ss Un N (cauchy_min Un H))). assert (H10 :Wn N = majorant (fun k:nat => Un (N + k)%nat) (maj_ss Un N (cauchy_maj Un H))) by reflexivity. assert (H9:Vn N = minorant (fun k:nat => Un (N + k)%nat) (min_ss Un N (cauchy_min Un H))) by reflexivity. rewrite <- H9 in H8 |- *. rewrite <- H10 in H7 |- *. elim (H7 (eps / 5) H1); intros k2 H11. elim (H8 (eps / 5) H1); intros k1 H12. apply Rle_lt_trans with (Rabs (Wn N - Un (N + k2)%nat) + Rabs (Un (N + k2)%nat - Vn N)). { replace (Wn N - Vn N) with (Wn N - Un (N + k2)%nat + (Un (N + k2)%nat - Vn N)); [ apply Rabs_triang | ring ]. } apply Rle_lt_trans with (Rabs (Wn N - Un (N + k2)%nat) + Rabs (Un (N + k2)%nat - Un (N + k1)%nat) + Rabs (Un (N + k1)%nat - Vn N)). { rewrite Rplus_assoc. apply Rplus_le_compat_l. replace (Un (N + k2)%nat - Vn N) with (Un (N + k2)%nat - Un (N + k1)%nat + (Un (N + k1)%nat - Vn N)); [ apply Rabs_triang | ring ]. } replace (3 * (eps / 5)) with (eps / 5 + eps / 5 + eps / 5); [ repeat apply Rplus_lt_compat | ring ]. ** assumption. ** { apply H6. - unfold ge. apply Nat.le_trans with N. + unfold N; apply Nat.le_max_r. + apply Nat.le_add_r. - unfold ge. apply Nat.le_trans with N. + unfold N; apply Nat.le_max_r. + apply Nat.le_add_r. } ** rewrite <- Rabs_Ropp. replace (- (Un (N + k1)%nat - Vn N)) with (Vn N - Un (N + k1)%nat); [ assumption | ring ]. ++ apply H5. unfold ge; apply Nat.le_trans with (max N1 N2). ** apply Nat.le_max_r. ** unfold N; apply Nat.le_max_l. -- pattern eps at 4; replace eps with (5 * (eps / 5)). ++ ring. ++ unfold Rdiv; rewrite <- Rmult_assoc; apply Rmult_inv_r_id_m. discrR. + unfold Rdiv; apply Rmult_lt_0_compat. * assumption. * apply Rinv_0_lt_compat. prove_sup0. Qed. coq-8.20.0/theories/Reals/Rdefinitions.v000066400000000000000000000303221466560755400201210ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* R. Axiom Rrepr : R -> CReal. Axiom Rquot1 : forall x y:R, CRealEq (Rrepr x) (Rrepr y) -> x = y. Axiom Rquot2 : forall x:CReal, CRealEq (Rrepr (Rabst x)) x. Parameter R0 : R. Parameter R1 : R. Parameter Rplus : R -> R -> R. Parameter Rmult : R -> R -> R. Parameter Ropp : R -> R. Parameter Rlt : R -> R -> Prop. Parameter R0_def : R0 = Rabst (inject_Q 0). Parameter R1_def : R1 = Rabst (inject_Q 1). Parameter Rplus_def : forall x y : R, Rplus x y = Rabst (CReal_plus (Rrepr x) (Rrepr y)). Parameter Rmult_def : forall x y : R, Rmult x y = Rabst (CReal_mult (Rrepr x) (Rrepr y)). Parameter Ropp_def : forall x : R, Ropp x = Rabst (CReal_opp (Rrepr x)). Parameter Rlt_def : forall x y : R, Rlt x y = CRealLtProp (Rrepr x) (Rrepr y). End RbaseSymbolsSig. Module RbaseSymbolsImpl : RbaseSymbolsSig. Definition R := DReal. Definition Rabst := DRealAbstr. Definition Rrepr := DRealRepr. Definition Rquot1 := DRealQuot1. Definition Rquot2 := DRealQuot2. Definition R0 : R := Rabst (inject_Q 0). Definition R1 : R := Rabst (inject_Q 1). Definition Rplus : R -> R -> R := fun x y : R => Rabst (CReal_plus (Rrepr x) (Rrepr y)). Definition Rmult : R -> R -> R := fun x y : R => Rabst (CReal_mult (Rrepr x) (Rrepr y)). Definition Ropp : R -> R := fun x : R => Rabst (CReal_opp (Rrepr x)). Definition Rlt : R -> R -> Prop := fun x y : R => CRealLtProp (Rrepr x) (Rrepr y). Definition R0_def := eq_refl R0. Definition R1_def := eq_refl R1. Definition Rplus_def := fun x y => eq_refl (Rplus x y). Definition Rmult_def := fun x y => eq_refl (Rmult x y). Definition Ropp_def := fun x => eq_refl (Ropp x). Definition Rlt_def := fun x y => eq_refl (Rlt x y). End RbaseSymbolsImpl. Export RbaseSymbolsImpl. (* Keep the same names as before *) Notation R := RbaseSymbolsImpl.R (only parsing). Notation R0 := RbaseSymbolsImpl.R0 (only parsing). Notation R1 := RbaseSymbolsImpl.R1 (only parsing). Notation Rplus := RbaseSymbolsImpl.Rplus (only parsing). Notation Rmult := RbaseSymbolsImpl.Rmult (only parsing). Notation Ropp := RbaseSymbolsImpl.Ropp (only parsing). Notation Rlt := RbaseSymbolsImpl.Rlt (only parsing). (* Automatically open scope R_scope for arguments of type R *) Bind Scope R_scope with R. Infix "+" := Rplus : R_scope. Infix "*" := Rmult : R_scope. Notation "- x" := (Ropp x) : R_scope. Infix "<" := Rlt : R_scope. (***********************************************************) (**********) Definition Rgt (r1 r2:R) : Prop := r2 < r1. (**********) Definition Rle (r1 r2:R) : Prop := r1 < r2 \/ r1 = r2. (**********) Definition Rge (r1 r2:R) : Prop := Rgt r1 r2 \/ r1 = r2. (**********) Definition Rminus (r1 r2:R) : R := r1 + - r2. (**********) Infix "-" := Rminus : R_scope. Infix "<=" := Rle : R_scope. Infix ">=" := Rge : R_scope. Infix ">" := Rgt : R_scope. Notation "x <= y <= z" := (x <= y /\ y <= z) : R_scope. Notation "x <= y < z" := (x <= y /\ y < z) : R_scope. Notation "x < y < z" := (x < y /\ y < z) : R_scope. Notation "x < y <= z" := (x < y /\ y <= z) : R_scope. (**********************************************************) (** * Injection from [Z] to [R] *) (**********************************************************) (* compact representation for 2*p *) Fixpoint IPR_2 (p:positive) : R := match p with | xH => R1 + R1 | xO p => (R1 + R1) * IPR_2 p | xI p => (R1 + R1) * (R1 + IPR_2 p) end. Definition IPR (p:positive) : R := match p with | xH => R1 | xO p => IPR_2 p | xI p => R1 + IPR_2 p end. Arguments IPR p%_positive : simpl never. (**********) Definition IZR (z:Z) : R := match z with | Z0 => R0 | Zpos n => IPR n | Zneg n => - IPR n end. Arguments IZR z%_Z : simpl never. Lemma total_order_T : forall r1 r2:R, {Rlt r1 r2} + {r1 = r2} + {Rlt r2 r1}. Proof. intros. destruct (CRealLt_lpo_dec (Rrepr r1) (Rrepr r2) sig_forall_dec). - left. left. rewrite RbaseSymbolsImpl.Rlt_def. apply CRealLtForget. exact c. - destruct (CRealLt_lpo_dec (Rrepr r2) (Rrepr r1) sig_forall_dec). + right. rewrite RbaseSymbolsImpl.Rlt_def. apply CRealLtForget. exact c. + left. right. apply Rquot1. split; assumption. Qed. Lemma Req_appart_dec : forall x y : R, { x = y } + { x < y \/ y < x }. Proof. intros. destruct (total_order_T x y). 1:destruct s. - right. left. exact r. - left. exact e. - right. right. exact r. Qed. Lemma Rrepr_appart_0 : forall x:R, (x < R0 \/ R0 < x) -> CReal_appart (Rrepr x) (inject_Q 0). Proof. intros. apply CRealLtDisjunctEpsilon. destruct H. - left. rewrite RbaseSymbolsImpl.Rlt_def, RbaseSymbolsImpl.R0_def, Rquot2 in H. exact H. - right. rewrite RbaseSymbolsImpl.Rlt_def, RbaseSymbolsImpl.R0_def, Rquot2 in H. exact H. Qed. Module Type RinvSig. Parameter Rinv : R -> R. Parameter Rinv_def : forall x : R, Rinv x = match Req_appart_dec x R0 with | left _ => R0 (* / 0 is undefined, we take 0 arbitrarily *) | right r => Rabst ((CReal_inv (Rrepr x) (Rrepr_appart_0 x r))) end. End RinvSig. Module RinvImpl : RinvSig. Definition Rinv : R -> R := fun x => match Req_appart_dec x R0 with | left _ => R0 (* / 0 is undefined, we take 0 arbitrarily *) | right r => Rabst ((CReal_inv (Rrepr x) (Rrepr_appart_0 x r))) end. Definition Rinv_def := fun x => eq_refl (Rinv x). End RinvImpl. Notation Rinv := RinvImpl.Rinv (only parsing). Notation "/ x" := (Rinv x) : R_scope. (**********) Definition Rdiv (r1 r2:R) : R := r1 * / r2. Infix "/" := Rdiv : R_scope. (* First integer strictly above x *) Definition up (x : R) : Z. Proof. destruct (CRealArchimedean (Rrepr x)) as [n nmaj], (total_order_T (IZR n - x) R1). 1:destruct s. - exact n. - (* x = n-1 *) exact n. - exact (Z.pred n). Defined. (** Injection of rational numbers into real numbers. *) Definition Q2R (x : Q) : R := (IZR (Qnum x) * / IZR (QDen x))%R. (**********************************************************) (** * Number notation for constants *) (**********************************************************) Inductive IR := | IRZ : IZ -> IR | IRQ : Q -> IR | IRmult : IR -> IR -> IR | IRdiv : IR -> IR -> IR. Definition of_decimal (d : Decimal.decimal) : IR := let '(i, f, e) := match d with | Decimal.Decimal i f => (i, f, Decimal.Pos Decimal.Nil) | Decimal.DecimalExp i f e => (i, f, e) end in let zq := match f with | Decimal.Nil => IRZ (IZ_of_Z (Z.of_int i)) | _ => let num := Z.of_int (Decimal.app_int i f) in let den := Nat.iter (Decimal.nb_digits f) (Pos.mul 10) 1%positive in IRQ (Qmake num den) end in let e := Z.of_int e in match e with | Z0 => zq | Zpos e => IRmult zq (IRZ (IZpow_pos 10 e)) | Zneg e => IRdiv zq (IRZ (IZpow_pos 10 e)) end. Definition of_hexadecimal (d : Hexadecimal.hexadecimal) : IR := let '(i, f, e) := match d with | Hexadecimal.Hexadecimal i f => (i, f, Decimal.Pos Decimal.Nil) | Hexadecimal.HexadecimalExp i f e => (i, f, e) end in let zq := match f with | Hexadecimal.Nil => IRZ (IZ_of_Z (Z.of_hex_int i)) | _ => let num := Z.of_hex_int (Hexadecimal.app_int i f) in let den := Nat.iter (Hexadecimal.nb_digits f) (Pos.mul 16) 1%positive in IRQ (Qmake num den) end in let e := Z.of_int e in match e with | Z0 => zq | Zpos e => IRmult zq (IRZ (IZpow_pos 2 e)) | Zneg e => IRdiv zq (IRZ (IZpow_pos 2 e)) end. Definition of_number (n : Number.number) : IR := match n with | Number.Decimal d => of_decimal d | Number.Hexadecimal h => of_hexadecimal h end. Definition IQmake_to_decimal num den := match den with | 1%positive => None (* this should be encoded as IRZ *) | _ => IQmake_to_decimal num den end. Definition to_decimal (n : IR) : option Decimal.decimal := match n with | IRZ z => match IZ_to_Z z with | Some z => Some (Decimal.Decimal (Z.to_int z) Decimal.Nil) | None => None end | IRQ (Qmake num den) => IQmake_to_decimal num den | IRmult (IRZ z) (IRZ (IZpow_pos 10 e)) => match IZ_to_Z z with | Some z => Some (Decimal.DecimalExp (Z.to_int z) Decimal.Nil (Pos.to_int e)) | None => None end | IRmult (IRQ (Qmake num den)) (IRZ (IZpow_pos 10 e)) => match IQmake_to_decimal num den with | Some (Decimal.Decimal i f) => Some (Decimal.DecimalExp i f (Pos.to_int e)) | _ => None end | IRdiv (IRZ z) (IRZ (IZpow_pos 10 e)) => match IZ_to_Z z with | Some z => Some (Decimal.DecimalExp (Z.to_int z) Decimal.Nil (Decimal.Neg (Pos.to_uint e))) | None => None end | IRdiv (IRQ (Qmake num den)) (IRZ (IZpow_pos 10 e)) => match IQmake_to_decimal num den with | Some (Decimal.Decimal i f) => Some (Decimal.DecimalExp i f (Decimal.Neg (Pos.to_uint e))) | _ => None end | _ => None end. Definition IQmake_to_hexadecimal num den := match den with | 1%positive => None (* this should be encoded as IRZ *) | _ => IQmake_to_hexadecimal num den end. Definition to_hexadecimal (n : IR) : option Hexadecimal.hexadecimal := match n with | IRZ z => match IZ_to_Z z with | Some z => Some (Hexadecimal.Hexadecimal (Z.to_hex_int z) Hexadecimal.Nil) | None => None end | IRQ (Qmake num den) => IQmake_to_hexadecimal num den | IRmult (IRZ z) (IRZ (IZpow_pos 2 e)) => match IZ_to_Z z with | Some z => Some (Hexadecimal.HexadecimalExp (Z.to_hex_int z) Hexadecimal.Nil (Pos.to_int e)) | None => None end | IRmult (IRQ (Qmake num den)) (IRZ (IZpow_pos 2 e)) => match IQmake_to_hexadecimal num den with | Some (Hexadecimal.Hexadecimal i f) => Some (Hexadecimal.HexadecimalExp i f (Pos.to_int e)) | _ => None end | IRdiv (IRZ z) (IRZ (IZpow_pos 2 e)) => match IZ_to_Z z with | Some z => Some (Hexadecimal.HexadecimalExp (Z.to_hex_int z) Hexadecimal.Nil (Decimal.Neg (Pos.to_uint e))) | None => None end | IRdiv (IRQ (Qmake num den)) (IRZ (IZpow_pos 2 e)) => match IQmake_to_hexadecimal num den with | Some (Hexadecimal.Hexadecimal i f) => Some (Hexadecimal.HexadecimalExp i f (Decimal.Neg (Pos.to_uint e))) | _ => None end | _ => None end. Definition to_number q := match to_decimal q with | None => None | Some q => Some (Number.Decimal q) end. Definition to_hex_number q := match to_hexadecimal q with | None => None | Some q => Some (Number.Hexadecimal q) end. Number Notation R of_number to_hex_number (via IR mapping [IZR => IRZ, Q2R => IRQ, Rmult => IRmult, Rdiv => IRdiv, Z.pow_pos => IZpow_pos, Z0 => IZ0, Zpos => IZpos, Zneg => IZneg]) : hex_R_scope. Number Notation R of_number to_number (via IR mapping [IZR => IRZ, Q2R => IRQ, Rmult => IRmult, Rdiv => IRdiv, Z.pow_pos => IZpow_pos, Z0 => IZ0, Zpos => IZpos, Zneg => IZneg]) : R_scope. coq-8.20.0/theories/Reals/Rderiv.v000066400000000000000000000474521466560755400167330ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* Prop) (y x:R) : Prop := D x /\ y <> x. (*********) Definition continue_in (f:R -> R) (D:R -> Prop) (x0:R) : Prop := limit1_in f (D_x D x0) (f x0) x0. (*********) Definition D_in (f d:R -> R) (D:R -> Prop) (x0:R) : Prop := limit1_in (fun x:R => (f x - f x0) / (x - x0)) (D_x D x0) (d x0) x0. (*********) Lemma cont_deriv : forall (f d:R -> R) (D:R -> Prop) (x0:R), D_in f d D x0 -> continue_in f D x0. Proof. unfold continue_in; unfold D_in; unfold limit1_in; unfold limit_in; unfold Rdiv; simpl; intros; elim (H eps H0); clear H; intros; elim H; clear H; intros; elim (Req_dec (d x0) 0); intro. - split with (Rmin 1 x); split. + elim (Rmin_Rgt 1 x 0); intros a b; apply (b (conj Rlt_0_1 H)). + intros; elim H3; clear H3; intros; generalize (let (H1, H2) := Rmin_Rgt 1 x (Rdist x1 x0) in H1); unfold Rgt; intro; elim (H5 H4); clear H5; intros; generalize (H1 x1 (conj H3 H6)); clear H1; intro; unfold D_x in H3; elim H3; intros. rewrite H2 in H1; unfold Rdist; unfold Rdist in H1; cut (Rabs (f x1 - f x0) < eps * Rabs (x1 - x0)). * intro; unfold Rdist in H5; generalize (Rmult_lt_compat_l eps (Rabs (x1 - x0)) 1 H0 H5); rewrite Rmult_1_r; intro; apply Rlt_trans with (r2 := eps * Rabs (x1 - x0)); assumption. * rewrite (Rminus_0_r ((f x1 - f x0) * / (x1 - x0))) in H1; rewrite Rabs_mult in H1; cut (x1 - x0 <> 0). -- intro; rewrite (Rabs_inv (x1 - x0)) in H1; generalize (Rmult_lt_compat_l (Rabs (x1 - x0)) (Rabs (f x1 - f x0) * / Rabs (x1 - x0)) eps (Rabs_pos_lt (x1 - x0) H9) H1); intro; rewrite Rmult_comm in H10; rewrite Rmult_assoc in H10; rewrite Rinv_l in H10. ++ rewrite Rmult_1_r in H10; rewrite Rmult_comm; assumption. ++ apply Rabs_no_R0; auto. -- apply Rminus_eq_contra; auto. - (**) split with (Rmin (Rmin (/ 2) x) (eps * / Rabs (2 * d x0))); split. + cut (Rmin (/ 2) x > 0). * cut (eps * / Rabs (2 * d x0) > 0). -- intros; elim (Rmin_Rgt (Rmin (/ 2) x) (eps * / Rabs (2 * d x0)) 0); intros a b; apply (b (conj H4 H3)). -- apply Rmult_gt_0_compat; auto. unfold Rgt; apply Rinv_0_lt_compat; apply Rabs_pos_lt; apply Rmult_integral_contrapositive; split. ++ discrR. ++ assumption. * elim (Rmin_Rgt (/ 2) x 0); intros a b; cut (0 < 2). -- intro; generalize (Rinv_0_lt_compat 2 H3); intro; fold (/ 2 > 0) in H4; apply (b (conj H4 H)). -- lra. + intros; elim H3; clear H3; intros; generalize (let (H1, H2) := Rmin_Rgt (Rmin (/ 2) x) (eps * / Rabs (2 * d x0)) (Rdist x1 x0) in H1); unfold Rgt; intro; elim (H5 H4); clear H5; intros; generalize (let (H1, H2) := Rmin_Rgt (/ 2) x (Rdist x1 x0) in H1); unfold Rgt; intro; elim (H7 H5); clear H7; intros; clear H4 H5; generalize (H1 x1 (conj H3 H8)); clear H1; intro; unfold D_x in H3; elim H3; intros; generalize (not_eq_sym H5); clear H5; intro H5; generalize (Rminus_eq_contra x1 x0 H5); intro; generalize H1; pattern (d x0) at 1; rewrite <- (let (H1, H2) := Rmult_ne (d x0) in H2); rewrite <- (Rinv_l (x1 - x0) H9); unfold Rdist; unfold Rminus at 1; rewrite (Rmult_comm (f x1 - f x0) (/ (x1 - x0))); rewrite (Rmult_comm (/ (x1 - x0) * (x1 - x0)) (d x0)); rewrite <- (Ropp_mult_distr_l_reverse (d x0) (/ (x1 - x0) * (x1 - x0))); rewrite (Rmult_comm (- d x0) (/ (x1 - x0) * (x1 - x0))); rewrite (Rmult_assoc (/ (x1 - x0)) (x1 - x0) (- d x0)); rewrite <- (Rmult_plus_distr_l (/ (x1 - x0)) (f x1 - f x0) ((x1 - x0) * - d x0)) ; rewrite (Rabs_mult (/ (x1 - x0)) (f x1 - f x0 + (x1 - x0) * - d x0)); clear H1; intro; generalize (Rmult_lt_compat_l (Rabs (x1 - x0)) (Rabs (/ (x1 - x0)) * Rabs (f x1 - f x0 + (x1 - x0) * - d x0)) eps (Rabs_pos_lt (x1 - x0) H9) H1); rewrite <- (Rmult_assoc (Rabs (x1 - x0)) (Rabs (/ (x1 - x0))) (Rabs (f x1 - f x0 + (x1 - x0) * - d x0))); rewrite (Rabs_inv (x1 - x0)); rewrite (Rinv_r (Rabs (x1 - x0)) (Rabs_no_R0 (x1 - x0) H9)); rewrite (let (H1, H2) := Rmult_ne (Rabs (f x1 - f x0 + (x1 - x0) * - d x0)) in H2) ; generalize (Rabs_triang_inv (f x1 - f x0) ((x1 - x0) * d x0)); intro; rewrite (Rmult_comm (x1 - x0) (- d x0)); rewrite (Ropp_mult_distr_l_reverse (d x0) (x1 - x0)); fold (f x1 - f x0 - d x0 * (x1 - x0)); rewrite (Rmult_comm (x1 - x0) (d x0)) in H10; clear H1; intro; generalize (Rle_lt_trans (Rabs (f x1 - f x0) - Rabs (d x0 * (x1 - x0))) (Rabs (f x1 - f x0 - d x0 * (x1 - x0))) (Rabs (x1 - x0) * eps) H10 H1); clear H1; intro; generalize (Rplus_lt_compat_l (Rabs (d x0 * (x1 - x0))) (Rabs (f x1 - f x0) - Rabs (d x0 * (x1 - x0))) ( Rabs (x1 - x0) * eps) H1); unfold Rminus at 2; rewrite (Rplus_comm (Rabs (f x1 - f x0)) (- Rabs (d x0 * (x1 - x0)))); rewrite <- (Rplus_assoc (Rabs (d x0 * (x1 - x0))) (- Rabs (d x0 * (x1 - x0))) (Rabs (f x1 - f x0))); rewrite (Rplus_opp_r (Rabs (d x0 * (x1 - x0)))); rewrite (let (H1, H2) := Rplus_ne (Rabs (f x1 - f x0)) in H2); clear H1; intro; cut (Rabs (d x0 * (x1 - x0)) + Rabs (x1 - x0) * eps < eps). * intro; apply (Rlt_trans (Rabs (f x1 - f x0)) (Rabs (d x0 * (x1 - x0)) + Rabs (x1 - x0) * eps) eps H1 H11). * clear H1 H5 H3 H10; generalize (Rabs_pos_lt (d x0) H2); intro; unfold Rgt in H0; generalize (Rmult_lt_compat_l eps (Rdist x1 x0) (/ 2) H0 H7); clear H7; intro; generalize (Rmult_lt_compat_l (Rabs (d x0)) (Rdist x1 x0) ( eps * / Rabs (2 * d x0)) H1 H6); clear H6; intro; rewrite (Rmult_comm eps (Rdist x1 x0)) in H3; unfold Rdist in H3, H5; rewrite <- (Rabs_mult (d x0) (x1 - x0)) in H5; rewrite (Rabs_mult 2 (d x0)) in H5; cut (Rabs 2 <> 0). -- intro; fold (Rabs (d x0) > 0) in H1; rewrite (Rinv_mult (Rabs 2) (Rabs (d x0))) in H5; rewrite (Rmult_comm (Rabs (d x0)) (eps * (/ Rabs 2 * / Rabs (d x0)))) in H5; rewrite <- (Rmult_assoc eps (/ Rabs 2) (/ Rabs (d x0))) in H5; rewrite (Rmult_assoc (eps * / Rabs 2) (/ Rabs (d x0)) (Rabs (d x0))) in H5; rewrite (Rinv_l (Rabs (d x0)) (Rlt_dichotomy_converse (Rabs (d x0)) 0 (or_intror (Rabs (d x0) < 0) H1))) in H5; rewrite (let (H1, H2) := Rmult_ne (eps * / Rabs 2) in H1) in H5; cut (Rabs 2 = 2). ++ intro; rewrite H7 in H5; generalize (Rplus_lt_compat (Rabs (d x0 * (x1 - x0))) (eps * / 2) (Rabs (x1 - x0) * eps) (eps * / 2) H5 H3); intro; rewrite eps2 in H10; assumption. ++ unfold Rabs; destruct (Rcase_abs 2) as [Hlt|Hge]; auto. cut (0 < 2). ** intro H7; elim (Rlt_asym 0 2 H7 Hlt). ** lra. -- apply Rabs_no_R0. discrR. Qed. (*********) Lemma Dconst : forall (D:R -> Prop) (y x0:R), D_in (fun x:R => y) (fun x:R => 0) D x0. Proof. unfold D_in; intros; unfold limit1_in; unfold limit_in; unfold Rdiv; intros; simpl; split with eps; split; auto. intros; rewrite (Rminus_diag_eq y y (eq_refl y)); rewrite Rmult_0_l; unfold Rdist; rewrite (Rminus_diag_eq 0 0 (eq_refl 0)); unfold Rabs; case (Rcase_abs 0); intro. - absurd (0 < 0); auto. red; intro; apply (Rlt_irrefl 0 H1). - unfold Rgt in H0; assumption. Qed. (*********) Lemma Dx : forall (D:R -> Prop) (x0:R), D_in (fun x:R => x) (fun x:R => 1) D x0. Proof. unfold D_in; unfold Rdiv; intros; unfold limit1_in; unfold limit_in; intros; simpl; split with eps; split; auto. intros; elim H0; clear H0; intros; unfold D_x in H0; elim H0; intros; rewrite (Rinv_r (x - x0) (Rminus_eq_contra x x0 (sym_not_eq H3))); unfold Rdist; rewrite (Rminus_diag_eq 1 1 (refl_equal 1)); unfold Rabs; case (Rcase_abs 0) as [Hlt|Hge]. - absurd (0 < 0); auto. red in |- *; intro; apply (Rlt_irrefl 0 Hlt). - unfold Rgt in H; assumption. Qed. (*********) Lemma Dadd : forall (D:R -> Prop) (df dg f g:R -> R) (x0:R), D_in f df D x0 -> D_in g dg D x0 -> D_in (fun x:R => f x + g x) (fun x:R => df x + dg x) D x0. Proof. unfold D_in; intros; generalize (limit_plus (fun x:R => (f x - f x0) * / (x - x0)) (fun x:R => (g x - g x0) * / (x - x0)) (D_x D x0) ( df x0) (dg x0) x0 H H0); clear H H0; unfold limit1_in; unfold limit_in; simpl; intros; elim (H eps H0); clear H; intros; elim H; clear H; intros; split with x; split; auto; intros; generalize (H1 x1 H2); clear H1; intro; rewrite (Rmult_comm (f x1 - f x0) (/ (x1 - x0))) in H1; rewrite (Rmult_comm (g x1 - g x0) (/ (x1 - x0))) in H1; rewrite <- (Rmult_plus_distr_l (/ (x1 - x0)) (f x1 - f x0) (g x1 - g x0)) in H1; rewrite (Rmult_comm (/ (x1 - x0)) (f x1 - f x0 + (g x1 - g x0))) in H1; cut (f x1 - f x0 + (g x1 - g x0) = f x1 + g x1 - (f x0 + g x0)). - intro; rewrite H3 in H1; assumption. - ring. Qed. (*********) Lemma Dmult : forall (D:R -> Prop) (df dg f g:R -> R) (x0:R), D_in f df D x0 -> D_in g dg D x0 -> D_in (fun x:R => f x * g x) (fun x:R => df x * g x + f x * dg x) D x0. Proof. intros; unfold D_in; generalize H H0; intros; unfold D_in in H, H0; generalize (cont_deriv f df D x0 H1); unfold continue_in; intro; generalize (limit_mul (fun x:R => (g x - g x0) * / (x - x0)) ( fun x:R => f x) (D_x D x0) (dg x0) (f x0) x0 H0 H3); intro; cut (limit1_in (fun x:R => g x0) (D_x D x0) (g x0) x0). - intro; generalize (limit_mul (fun x:R => (f x - f x0) * / (x - x0)) ( fun _:R => g x0) (D_x D x0) (df x0) (g x0) x0 H H5); clear H H0 H1 H2 H3 H5; intro; generalize (limit_plus (fun x:R => (f x - f x0) * / (x - x0) * g x0) (fun x:R => (g x - g x0) * / (x - x0) * f x) ( D_x D x0) (df x0 * g x0) (dg x0 * f x0) x0 H H4); clear H4 H; intro; unfold limit1_in in H; unfold limit_in in H; simpl in H; unfold limit1_in; unfold limit_in; simpl; intros; elim (H eps H0); clear H; intros; elim H; clear H; intros; split with x; split; auto; intros; generalize (H1 x1 H2); clear H1; intro; rewrite (Rmult_comm (f x1 - f x0) (/ (x1 - x0))) in H1; rewrite (Rmult_comm (g x1 - g x0) (/ (x1 - x0))) in H1; rewrite (Rmult_assoc (/ (x1 - x0)) (f x1 - f x0) (g x0)) in H1; rewrite (Rmult_assoc (/ (x1 - x0)) (g x1 - g x0) (f x1)) in H1; rewrite <- (Rmult_plus_distr_l (/ (x1 - x0)) ((f x1 - f x0) * g x0) ((g x1 - g x0) * f x1)) in H1; rewrite (Rmult_comm (/ (x1 - x0)) ((f x1 - f x0) * g x0 + (g x1 - g x0) * f x1)) in H1; rewrite (Rmult_comm (dg x0) (f x0)) in H1; cut ((f x1 - f x0) * g x0 + (g x1 - g x0) * f x1 = f x1 * g x1 - f x0 * g x0). + intro; rewrite H3 in H1; assumption. + ring. - unfold limit1_in; unfold limit_in; simpl; intros; split with eps; split; auto; intros; elim (Rdist_refl (g x0) (g x0)); intros a b; rewrite (b (eq_refl (g x0))); unfold Rgt in H; assumption. Qed. (*********) Lemma Dmult_const : forall (D:R -> Prop) (f df:R -> R) (x0 a:R), D_in f df D x0 -> D_in (fun x:R => a * f x) (fun x:R => a * df x) D x0. Proof. intros; generalize (Dmult D (fun _:R => 0) df (fun _:R => a) f x0 (Dconst D a x0) H); unfold D_in; intros; rewrite (Rmult_0_l (f x0)) in H0; rewrite (let (H1, H2) := Rplus_ne (a * df x0) in H2) in H0; assumption. Qed. (*********) Lemma Dopp : forall (D:R -> Prop) (f df:R -> R) (x0:R), D_in f df D x0 -> D_in (fun x:R => - f x) (fun x:R => - df x) D x0. Proof. intros; generalize (Dmult_const D f df x0 (-1) H); unfold D_in; unfold limit1_in; unfold limit_in; intros; generalize (H0 eps H1); clear H0; intro; elim H0; clear H0; intros; elim H0; clear H0; simpl; intros; split with x; split; auto. intros; generalize (H2 x1 H3); clear H2; intro. replace (- f x1 - - f x0) with (-1 * f x1 - -1 * f x0) by ring. replace (- df x0) with (-1 * df x0) by ring. exact H2. Qed. (*********) Lemma Dminus : forall (D:R -> Prop) (df dg f g:R -> R) (x0:R), D_in f df D x0 -> D_in g dg D x0 -> D_in (fun x:R => f x - g x) (fun x:R => df x - dg x) D x0. Proof. unfold Rminus; intros; generalize (Dopp D g dg x0 H0); intro; apply (Dadd D df (fun x:R => - dg x) f (fun x:R => - g x) x0); assumption. Qed. (*********) Lemma Dx_pow_n : forall (n:nat) (D:R -> Prop) (x0:R), D_in (fun x:R => x ^ n) (fun x:R => INR n * x ^ (n - 1)) D x0. Proof. simple induction n; intros. - simpl; rewrite Rmult_0_l; apply Dconst. - intros; cut (n0 = (S n0 - 1)%nat); [ intro a; rewrite <- a; clear a | simpl; symmetry; apply Nat.sub_0_r ]. generalize (Dmult D (fun _:R => 1) (fun x:R => INR n0 * x ^ (n0 - 1)) ( fun x:R => x) (fun x:R => x ^ n0) x0 (Dx D x0) ( H D x0)); unfold D_in; unfold limit1_in; unfold limit_in; simpl; intros; elim (H0 eps H1); clear H0; intros; elim H0; clear H0; intros; split with x; split; auto. intros; generalize (H2 x1 H3); clear H2 H3; intro; rewrite (let (H1, H2) := Rmult_ne (x0 ^ n0) in H2) in H2; rewrite (tech_pow_Rmult x1 n0) in H2; rewrite (tech_pow_Rmult x0 n0) in H2; rewrite (Rmult_comm (INR n0) (x0 ^ (n0 - 1))) in H2; rewrite <- (Rmult_assoc x0 (x0 ^ (n0 - 1)) (INR n0)) in H2; rewrite (tech_pow_Rmult x0 (n0 - 1)) in H2; elim (Peano_dec.eq_nat_dec n0 0) ; intros cond. + rewrite cond in H2; rewrite cond; simpl in H2; simpl; cut (1 + x0 * 1 * 0 = 1 * 1); [ intro A; rewrite A in H2; assumption | ring ]. + cut (n0 <> 0%nat -> S (n0 - 1) = n0); [ intro | lia ]; rewrite (H3 cond) in H2; rewrite (Rmult_comm (x0 ^ n0) (INR n0)) in H2; rewrite (tech_pow_Rplus x0 n0 n0) in H2; assumption. Qed. (*********) Lemma Dcomp : forall (Df Dg:R -> Prop) (df dg f g:R -> R) (x0:R), D_in f df Df x0 -> D_in g dg Dg (f x0) -> D_in (fun x:R => g (f x)) (fun x:R => df x * dg (f x)) (Dgf Df Dg f) x0. Proof. intros Df Dg df dg f g x0 H H0; generalize H H0; unfold D_in; unfold Rdiv; intros; generalize (limit_comp f (fun x:R => (g x - g (f x0)) * / (x - f x0)) ( D_x Df x0) (D_x Dg (f x0)) (f x0) (dg (f x0)) x0); intro; generalize (cont_deriv f df Df x0 H); intro; unfold continue_in in H4; generalize (H3 H4 H2); clear H3; intro; generalize (limit_mul (fun x:R => (g (f x) - g (f x0)) * / (f x - f x0)) (fun x:R => (f x - f x0) * / (x - x0)) (Dgf (D_x Df x0) (D_x Dg (f x0)) f) (dg (f x0)) ( df x0) x0 H3); intro; cut (limit1_in (fun x:R => (f x - f x0) * / (x - x0)) (Dgf (D_x Df x0) (D_x Dg (f x0)) f) (df x0) x0). - intro; generalize (H5 H6); clear H5; intro; generalize (limit_mul (fun x:R => (f x - f x0) * / (x - x0)) ( fun x:R => dg (f x0)) (D_x Df x0) (df x0) (dg (f x0)) x0 H1 (limit_free (fun x:R => dg (f x0)) (D_x Df x0) x0 x0)); intro; unfold limit1_in; unfold limit_in; simpl; unfold limit1_in in H5, H7; unfold limit_in in H5, H7; simpl in H5, H7; intros; elim (H5 eps H8); elim (H7 eps H8); clear H5 H7; intros; elim H5; elim H7; clear H5 H7; intros; split with (Rmin x x1); split. + elim (Rmin_Rgt x x1 0); intros a b; apply (b (conj H9 H5)); clear a b. + intros; elim H11; clear H11; intros; elim (Rmin_Rgt x x1 (Rdist x2 x0)); intros a b; clear b; unfold Rgt in a; elim (a H12); clear H5 a; intros; unfold D_x, Dgf in H11, H7, H10; clear H12; elim (Req_dec (f x2) (f x0)); intro. * elim H11; clear H11; intros; elim H11; clear H11; intros; generalize (H10 x2 (conj (conj H11 H14) H5)); intro; rewrite (Rminus_diag_eq (f x2) (f x0) H12) in H16; rewrite (Rmult_0_l (/ (x2 - x0))) in H16; rewrite (Rmult_0_l (dg (f x0))) in H16; rewrite H12; rewrite (Rminus_diag_eq (g (f x0)) (g (f x0)) (eq_refl (g (f x0)))); rewrite (Rmult_0_l (/ (x2 - x0))); assumption. * clear H10 H5; elim H11; clear H11; intros; elim H5; clear H5; intros; cut (((Df x2 /\ x0 <> x2) /\ Dg (f x2) /\ f x0 <> f x2) /\ Rdist x2 x0 < x1); auto; intro; generalize (H7 x2 H14); intro; generalize (Rminus_eq_contra (f x2) (f x0) H12); intro; rewrite (Rmult_assoc (g (f x2) - g (f x0)) (/ (f x2 - f x0)) ((f x2 - f x0) * / (x2 - x0))) in H15; rewrite <- (Rmult_assoc (/ (f x2 - f x0)) (f x2 - f x0) (/ (x2 - x0))) in H15; rewrite (Rinv_l (f x2 - f x0) H16) in H15; rewrite (let (H1, H2) := Rmult_ne (/ (x2 - x0)) in H2) in H15; rewrite (Rmult_comm (df x0) (dg (f x0))); assumption. - clear H5 H3 H4 H2; unfold limit1_in; unfold limit_in; simpl; unfold limit1_in in H1; unfold limit_in in H1; simpl in H1; intros; elim (H1 eps H2); clear H1; intros; elim H1; clear H1; intros; split with x; split; auto; intros; unfold D_x, Dgf in H4, H3; elim H4; clear H4; intros; elim H4; clear H4; intros; exact (H3 x1 (conj H4 H5)). Qed. (*********) Lemma D_pow_n : forall (n:nat) (D:R -> Prop) (x0:R) (expr dexpr:R -> R), D_in expr dexpr D x0 -> D_in (fun x:R => expr x ^ n) (fun x:R => INR n * expr x ^ (n - 1) * dexpr x) ( Dgf D D expr) x0. Proof. intros n D x0 expr dexpr H; generalize (Dcomp D D dexpr (fun x:R => INR n * x ^ (n - 1)) expr ( fun x:R => x ^ n) x0 H (Dx_pow_n n D (expr x0))); intro; unfold D_in; unfold limit1_in; unfold limit_in; simpl; intros; unfold D_in in H0; unfold limit1_in in H0; unfold limit_in in H0; simpl in H0; elim (H0 eps H1); clear H0; intros; elim H0; clear H0; intros; split with x; split; intros; auto. cut (dexpr x0 * (INR n * expr x0 ^ (n - 1)) = INR n * expr x0 ^ (n - 1) * dexpr x0); [ intro Rew; rewrite <- Rew; exact (H2 x1 H3) | ring ]. Qed. coq-8.20.0/theories/Reals/Reals.v000066400000000000000000000030461466560755400165350ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* 0`` - Sup: for goals like ``?1 0. Proof. intro; red; intro; apply (not_O_INR (fact n) (fact_neq_0 n)); assumption. Qed. (*********) Lemma fact_simpl : forall n:nat, fact (S n) = (S n * fact n)%nat. Proof. intro; reflexivity. Qed. (*********) Lemma simpl_fact : forall n:nat, / INR (fact (S n)) * / / INR (fact n) = / INR (S n). Proof. intro; rewrite (Rinv_inv (INR (fact n))); unfold fact at 1; cbv beta iota; fold fact; rewrite (mult_INR (S n) (fact n)); rewrite (Rinv_mult (INR (S n)) (INR (fact n))). rewrite (Rmult_assoc (/ INR (S n)) (/ INR (fact n)) (INR (fact n))); rewrite (Rinv_l (INR (fact n)) (INR_fact_neq_0 n)); apply (let (H1, H2) := Rmult_ne (/ INR (S n)) in H1). Qed. (*******************************) (** * Power *) (*******************************) (*********) Infix "^" := pow : R_scope. Lemma pow_O : forall x:R, x ^ 0 = 1. Proof. reflexivity. Qed. Lemma pow_1 : forall x:R, x ^ 1 = x. Proof. simpl; auto with real. Qed. Lemma pow_add : forall (x:R) (n m:nat), x ^ (n + m) = x ^ n * x ^ m. Proof. intros x n; elim n; simpl; auto with real. intros n0 H' m; rewrite H'; auto with real. Qed. Lemma Rpow_mult_distr : forall (x y:R) (n:nat), (x * y) ^ n = x^n * y^n. Proof. intros x y n ; induction n. - field. - simpl. repeat (rewrite Rmult_assoc) ; apply Rmult_eq_compat_l. rewrite IHn ; field. Qed. Lemma pow_nonzero : forall (x:R) (n:nat), x <> 0 -> x ^ n <> 0. Proof. intro; simple induction n; simpl. - intro; red; intro; apply R1_neq_R0; assumption. - intros; red; intro; elim (Rmult_integral x (x ^ n0) H1). + intro; auto. + apply H; assumption. Qed. #[global] Hint Resolve pow_O pow_1 pow_add pow_nonzero: real. Lemma pow_RN_plus : forall (x:R) (n m:nat), x <> 0 -> x ^ n = x ^ (n + m) * / x ^ m. Proof. intros x n m H. apply (Rmult_eq_reg_r (x ^ m)); cycle 1. { now apply pow_nonzero. } rewrite Rmult_assoc, Rmult_inv_l, Rmult_1_r by (now apply pow_nonzero). now rewrite pow_add. Qed. Lemma pow_lt : forall (x:R) (n:nat), 0 < x -> 0 < x ^ n. Proof. intros x n; elim n; simpl; auto with real. intros n0 H' H'0; replace 0 with (x * 0); auto with real. Qed. #[global] Hint Resolve pow_lt: real. Lemma Rlt_pow_R1 : forall (x:R) (n:nat), 1 < x -> (0 < n)%nat -> 1 < x ^ n. Proof. intros x n; elim n; simpl; auto with real. - intros H' H'0; exfalso. apply (Nat.lt_irrefl 0); assumption. - intros n0; case n0. + simpl; rewrite Rmult_1_r; auto. + intros n1 H' H'0 H'1. replace 1 with (1 * 1); auto with real. apply Rlt_trans with (r2 := x * 1); auto with real. apply Rmult_lt_compat_l; auto with real. * apply Rlt_trans with (r2 := 1); auto with real. * apply H'; auto with arith. Qed. #[global] Hint Resolve Rlt_pow_R1: real. Lemma Rlt_pow : forall (x:R) (n m:nat), 1 < x -> (n < m)%nat -> x ^ n < x ^ m. Proof. intros x n m H' H'0; replace m with (m - n + n)%nat. - rewrite pow_add. pattern (x ^ n) at 1; replace (x ^ n) with (1 * x ^ n); auto with real. apply Rminus_lt. repeat rewrite (fun y:R => Rmult_comm y (x ^ n)); rewrite <- Rmult_minus_distr_l. replace 0 with (x ^ n * 0); auto with real. apply Rmult_lt_compat_l; auto with real. + apply pow_lt; auto with real. apply Rlt_trans with (r2 := 1); auto with real. + apply Rlt_minus; auto with real. apply Rlt_pow_R1; [ | apply lt_minus_O_lt ]; assumption. - apply Nat.sub_add, Nat.lt_le_incl; assumption. Qed. #[global] Hint Resolve Rlt_pow: real. (*********) Lemma tech_pow_Rmult : forall (x:R) (n:nat), x * x ^ n = x ^ S n. Proof. simple induction n; simpl; trivial. Qed. (*********) Lemma tech_pow_Rplus : forall (x:R) (a n:nat), x ^ a + INR n * x ^ a = INR (S n) * x ^ a. Proof. intros; pattern (x ^ a) at 1; rewrite <- (let (H1, H2) := Rmult_ne (x ^ a) in H1); rewrite (Rmult_comm (INR n) (x ^ a)); rewrite <- (Rmult_plus_distr_l (x ^ a) 1 (INR n)); rewrite (Rplus_comm 1 (INR n)); rewrite <- (S_INR n); apply Rmult_comm. Qed. Lemma poly : forall (n:nat) (x:R), 0 < x -> 1 + INR n * x <= (1 + x) ^ n. Proof. intros; elim n. - simpl; cut (1 + 0 * x = 1). + intro; rewrite H0; unfold Rle; right; reflexivity. + ring. - intros; unfold pow; fold pow; apply (Rle_trans (1 + INR (S n0) * x) ((1 + x) * (1 + INR n0 * x)) ((1 + x) * (1 + x) ^ n0)). + cut ((1 + x) * (1 + INR n0 * x) = 1 + INR (S n0) * x + INR n0 * (x * x)). * intro; rewrite H1; pattern (1 + INR (S n0) * x) at 1; rewrite <- (let (H1, H2) := Rplus_ne (1 + INR (S n0) * x) in H1); apply Rplus_le_compat_l; elim n0; intros. -- simpl; rewrite Rmult_0_l; unfold Rle; right; auto. -- unfold Rle; left; generalize Rmult_gt_0_compat; unfold Rgt; intro; fold (Rsqr x); apply (H3 (INR (S n1)) (Rsqr x) (lt_INR_0 (S n1) (Nat.lt_0_succ n1))); fold (x > 0) in H; apply (Rlt_0_sqr x (Rlt_dichotomy_converse x 0 (or_intror (x < 0) H))). * rewrite (S_INR n0); ring. + unfold Rle in H0; elim H0; intro. * unfold Rle; left; apply Rmult_lt_compat_l. -- rewrite Rplus_comm; apply (Rplus_le_lt_0_compat _ _ (Rlt_le 0 x H)); apply Rlt_0_1. -- assumption. * rewrite H1; unfold Rle; right; trivial. Qed. Lemma Power_monotonic : forall (x:R) (m n:nat), Rabs x > 1 -> (m <= n)%nat -> Rabs (x ^ m) <= Rabs (x ^ n). Proof. intros x m n H; induction n as [| n Hrecn]; intros; inversion H0. - unfold Rle; right; reflexivity. - unfold Rle; right; reflexivity. - apply (Rle_trans (Rabs (x ^ m)) (Rabs (x ^ n)) (Rabs (x ^ S n))). + apply Hrecn; assumption. + simpl; rewrite Rabs_mult. pattern (Rabs (x ^ n)) at 1. rewrite <- Rmult_1_r. rewrite (Rmult_comm (Rabs x) (Rabs (x ^ n))). apply Rmult_le_compat_l. * apply Rabs_pos. * unfold Rgt in H. apply Rlt_le; assumption. Qed. Lemma RPow_abs : forall (x:R) (n:nat), Rabs x ^ n = Rabs (x ^ n). Proof. intro; simple induction n; simpl. - symmetry; apply Rabs_pos_eq; apply Rlt_le; apply Rlt_0_1. - intros; rewrite H; symmetry; apply Rabs_mult. Qed. Lemma Pow_x_infinity : forall x:R, Rabs x > 1 -> forall b:R, exists N : nat, (forall n:nat, (n >= N)%nat -> Rabs (x ^ n) >= b). Proof. intros; elim (archimed (b * / (Rabs x - 1))); intros; clear H1; cut (exists N : nat, INR N >= b * / (Rabs x - 1)). - intro; elim H1; clear H1; intros; exists x0; intros; apply (Rge_trans (Rabs (x ^ n)) (Rabs (x ^ x0)) b). { apply Rle_ge; apply Power_monotonic; assumption. } rewrite <- RPow_abs; assert (Rabs x = 1 + (Rabs x - 1)) by ring. rewrite H3; apply (Rge_trans ((1 + (Rabs x - 1)) ^ x0) (1 + INR x0 * (Rabs x - 1)) b). + apply Rle_ge; apply poly; fold (Rabs x - 1 > 0); apply Rgt_minus; assumption. + apply (Rge_trans (1 + INR x0 * (Rabs x - 1)) (INR x0 * (Rabs x - 1)) b). { apply Rle_ge; apply Rlt_le; rewrite (Rplus_comm 1 (INR x0 * (Rabs x - 1))); pattern (INR x0 * (Rabs x - 1)) at 1; rewrite <- (let (H1, H2) := Rplus_ne (INR x0 * (Rabs x - 1)) in H1); apply Rplus_lt_compat_l; apply Rlt_0_1. } cut (b = b * / (Rabs x - 1) * (Rabs x - 1)). * intros; rewrite H4; apply Rmult_ge_compat_r. { apply Rge_minus; unfold Rge; left; assumption. } assumption. * rewrite Rmult_assoc; rewrite Rinv_l. { ring. } apply Rlt_dichotomy_converse; right; apply Rgt_minus; assumption. - assert ((0 <= up (b * / (Rabs x - 1)))%Z \/ (up (b * / (Rabs x - 1)) <= 0)%Z) by apply Z.le_ge_cases. elim H1; intro. + elim (IZN (up (b * / (Rabs x - 1))) H2); intros; exists x0; apply (Rge_trans (INR x0) (IZR (up (b * / (Rabs x - 1)))) (b * / (Rabs x - 1))). * rewrite INR_IZR_INZ; apply IZR_ge. normZ. slia H3 H5. * unfold Rge; left; assumption. + exists 0%nat; apply (Rge_trans (INR 0) (IZR (up (b * / (Rabs x - 1)))) (b * / (Rabs x - 1))). * rewrite INR_IZR_INZ; apply IZR_ge; simpl. normZ. slia H2 H3. * unfold Rge; left; assumption. Qed. Lemma pow_ne_zero : forall n:nat, n <> 0%nat -> 0 ^ n = 0. Proof. simple induction n. - simpl; auto. intros; elim H; reflexivity. - intros; simpl; apply Rmult_0_l. Qed. Lemma pow_inv x n : (/ x)^n = / x^n. Proof. induction n as [|n IH] ; simpl. - apply eq_sym, Rinv_1. - rewrite Rinv_mult. now apply f_equal. Qed. Lemma Rinv_pow_depr : forall (x:R) (n:nat), x <> 0 -> / x ^ n = (/ x) ^ n. Proof. intros x n _. apply eq_sym, pow_inv. Qed. #[deprecated(since="8.16",note="Use pow_inv.")] Notation Rinv_pow := Rinv_pow_depr. Lemma pow_lt_1_zero : forall x:R, Rabs x < 1 -> forall y:R, 0 < y -> exists N : nat, (forall n:nat, (n >= N)%nat -> Rabs (x ^ n) < y). Proof. intros; elim (Req_dec x 0); intro. - exists 1%nat; rewrite H1; intros n GE; rewrite pow_ne_zero. + rewrite Rabs_R0; assumption. + inversion GE; auto. - assert (Rabs (/ x) > 1). { rewrite <- (Rinv_inv 1). rewrite Rabs_inv. unfold Rgt; apply Rinv_lt_contravar. - apply Rmult_lt_0_compat. + apply Rabs_pos_lt. assumption. + rewrite Rinv_1; apply Rlt_0_1. - rewrite Rinv_1; assumption. } elim (Pow_x_infinity (/ x) H2 (/ y + 1)); intros N. exists N; intros; rewrite <- (Rinv_inv y). rewrite <- (Rinv_inv (Rabs (x ^ n))). apply Rinv_lt_contravar. + apply Rmult_lt_0_compat. * apply Rinv_0_lt_compat. assumption. * apply Rinv_0_lt_compat. apply Rabs_pos_lt. apply pow_nonzero. assumption. + rewrite <- Rabs_inv, <- pow_inv. apply (Rlt_le_trans (/ y) (/ y + 1) (Rabs ((/ x) ^ n))). * pattern (/ y) at 1. rewrite <- (let (H1, H2) := Rplus_ne (/ y) in H1). apply Rplus_lt_compat_l. apply Rlt_0_1. * apply Rge_le. apply H3. assumption. Qed. Lemma pow_R1 : forall (r:R) (n:nat), r ^ n = 1 -> Rabs r = 1 \/ n = 0%nat. Proof. intros r n H'. case (Req_dec (Rabs r) 1); auto; intros H'1. case (Rdichotomy _ _ H'1); intros H'2. - generalize H'; case n; auto. intros n0 H'0. cut (r <> 0); [ intros Eq1 | idtac ]. + assert (Eq2: Rabs r <> 0) by (apply Rabs_no_R0; auto). absurd (Rabs (/ r) ^ 0 < Rabs (/ r) ^ S n0); auto. * replace (Rabs (/ r) ^ S n0) with 1. -- simpl; apply Rlt_irrefl; auto. -- rewrite Rabs_inv, pow_inv. rewrite RPow_abs; auto. rewrite H'0; rewrite Rabs_right; auto with real rorders. * apply Rlt_pow; auto with arith. rewrite Rabs_inv. apply Rmult_lt_reg_l with (r := Rabs r). -- case (Rabs_pos r); auto. intros H'3; case Eq2; auto. -- rewrite Rmult_1_r; rewrite Rinv_r; auto with real. + red; intro; absurd (r ^ S n0 = 1); auto. simpl; rewrite H; rewrite Rmult_0_l; auto with real. - generalize H'; case n; auto. intros n0 H'0. cut (r <> 0); [ intros Eq1 | auto with real ]. + cut (Rabs r <> 0); [ intros Eq2 | apply Rabs_no_R0 ]; auto. absurd (Rabs r ^ 0 < Rabs r ^ S n0); auto with real arith. repeat rewrite RPow_abs; rewrite H'0; simpl; auto with real. + red; intro; absurd (r ^ S n0 = 1); auto. simpl; rewrite H; rewrite Rmult_0_l; auto with real. Qed. Lemma pow_Rsqr : forall (x:R) (n:nat), x ^ (2 * n) = Rsqr x ^ n. Proof. intros; induction n as [| n Hrecn]. - reflexivity. - replace (2 * S n)%nat with (S (S (2 * n))). + replace (x ^ S (S (2 * n))) with (x * x * x ^ (2 * n)). * rewrite Hrecn; reflexivity. * simpl; ring. + ring. Qed. Lemma pow_le : forall (a:R) (n:nat), 0 <= a -> 0 <= a ^ n. Proof. intros; induction n as [| n Hrecn]. - simpl; left; apply Rlt_0_1. - simpl; apply Rmult_le_pos; assumption. Qed. (**********) Lemma pow_1_even : forall n:nat, (-1) ^ (2 * n) = 1. Proof. intro; induction n as [| n Hrecn]. - reflexivity. - replace (2 * S n)%nat with (2 + 2 * n)%nat by ring. rewrite pow_add; rewrite Hrecn; simpl; ring. Qed. (**********) Lemma pow_1_odd : forall n:nat, (-1) ^ S (2 * n) = -1. Proof. intro; replace (S (2 * n)) with (2 * n + 1)%nat by ring. rewrite pow_add; rewrite pow_1_even; simpl; ring. Qed. (**********) Lemma pow_1_abs : forall n:nat, Rabs ((-1) ^ n) = 1. Proof. intro; induction n as [| n Hrecn]. - simpl; apply Rabs_R1. - replace (S n) with (n + 1)%nat; [ rewrite pow_add | ring ]. rewrite Rabs_mult. rewrite Hrecn; rewrite Rmult_1_l; simpl; rewrite Rmult_1_r. change (-1) with (-(1)). rewrite Rabs_Ropp; apply Rabs_R1. Qed. Lemma pow_mult : forall (x:R) (n1 n2:nat), x ^ (n1 * n2) = (x ^ n1) ^ n2. Proof. intros; induction n2 as [| n2 Hrecn2]. - simpl; replace (n1 * 0)%nat with 0%nat; [ reflexivity | ring ]. - replace (n1 * S n2)%nat with (n1 * n2 + n1)%nat. + replace (S n2) with (n2 + 1)%nat by ring. do 2 rewrite pow_add. rewrite Hrecn2. simpl. ring. + ring. Qed. Lemma pow_incr : forall (x y:R) (n:nat), 0 <= x <= y -> x ^ n <= y ^ n. Proof. intros. induction n as [| n Hrecn]. - right; reflexivity. - simpl. elim H; intros. apply Rle_trans with (y * x ^ n). + do 2 rewrite <- (Rmult_comm (x ^ n)). apply Rmult_le_compat_l. * apply pow_le; assumption. * assumption. + apply Rmult_le_compat_l. * apply Rle_trans with x; assumption. * apply Hrecn. Qed. Lemma pow_R1_Rle : forall (x:R) (k:nat), 1 <= x -> 1 <= x ^ k. Proof. intros. induction k as [| k Hreck]. - right; reflexivity. - simpl. apply Rle_trans with (x * 1). + rewrite Rmult_1_r; assumption. + apply Rmult_le_compat_l. * left; apply Rlt_le_trans with 1; [ apply Rlt_0_1 | assumption ]. * exact Hreck. Qed. Lemma Rle_pow : forall (x:R) (m n:nat), 1 <= x -> (m <= n)%nat -> x ^ m <= x ^ n. Proof. intros. replace n with (n - m + m)%nat. - rewrite pow_add. rewrite Rmult_comm. pattern (x ^ m) at 1; rewrite <- Rmult_1_r. apply Rmult_le_compat_l. + apply pow_le; left; apply Rlt_le_trans with 1; [ apply Rlt_0_1 | assumption ]. + apply pow_R1_Rle; assumption. - apply Nat.sub_add; assumption. Qed. Lemma pow1 : forall n:nat, 1 ^ n = 1. Proof. intro; induction n as [| n Hrecn]. - reflexivity. - simpl; rewrite Hrecn; rewrite Rmult_1_r; reflexivity. Qed. Lemma pow_Rabs : forall (x:R) (n:nat), x ^ n <= Rabs x ^ n. Proof. intros; induction n as [| n Hrecn]. - right; reflexivity. - simpl; destruct (Rcase_abs x) as [Hlt|Hle]. + apply Rle_trans with (Rabs (x * x ^ n)). * apply RRle_abs. * rewrite Rabs_mult. apply Rmult_le_compat_l. -- apply Rabs_pos. -- right; symmetry; apply RPow_abs. + pattern (Rabs x) at 1; rewrite (Rabs_right x Hle); apply Rmult_le_compat_l. * apply Rge_le; exact Hle. * apply Hrecn. Qed. Lemma pow_maj_Rabs : forall (x y:R) (n:nat), Rabs y <= x -> y ^ n <= x ^ n. Proof. intros; cut (0 <= x). - intro; apply Rle_trans with (Rabs y ^ n). + apply pow_Rabs. + induction n as [| n Hrecn]. * right; reflexivity. * simpl; apply Rle_trans with (x * Rabs y ^ n). -- do 2 rewrite <- (Rmult_comm (Rabs y ^ n)). apply Rmult_le_compat_l. ++ apply pow_le; apply Rabs_pos. ++ assumption. -- apply Rmult_le_compat_l. ++ apply H0. ++ apply Hrecn. - apply Rle_trans with (Rabs y); [ apply Rabs_pos | exact H ]. Qed. Lemma Rsqr_pow2 : forall x, Rsqr x = x ^ 2. Proof. intros; unfold Rsqr; simpl; rewrite Rmult_1_r; reflexivity. Qed. (*******************************) (** * PowerRZ *) (*******************************) (*i Due to L.Thery i*) Section PowerRZ. Local Coercion Z_of_nat : nat >-> Z. (* the following section should probably be somewhere else, but not sure where *) Section Z_compl. Local Open Scope Z_scope. (* Provides a way to reason directly on Z in terms of nats instead of positive *) Inductive Z_spec (x : Z) : Z -> Type := | ZintNull : x = 0 -> Z_spec x 0 | ZintPos (n : nat) : x = n -> Z_spec x n | ZintNeg (n : nat) : x = - n -> Z_spec x (- n). Lemma intP (x : Z) : Z_spec x x. Proof. destruct x as [|p|p]. - now apply ZintNull. - rewrite <-positive_nat_Z at 2. apply ZintPos. now rewrite positive_nat_Z. - rewrite <-Pos2Z.opp_pos. rewrite <-positive_nat_Z at 2. apply ZintNeg. now rewrite positive_nat_Z. Qed. End Z_compl. Definition powerRZ (x:R) (n:Z) := match n with | Z0 => 1 | Zpos p => x ^ Pos.to_nat p | Zneg p => / x ^ Pos.to_nat p end. Local Infix "^Z" := powerRZ (at level 30, right associativity) : R_scope. Lemma Zpower_NR0 : forall (x:Z) (n:nat), (0 <= x)%Z -> (0 <= Zpower_nat x n)%Z. Proof. induction n; unfold Zpower_nat; simpl; auto with zarith. Qed. Lemma powerRZ_O : forall x:R, x ^Z 0 = 1. Proof. reflexivity. Qed. Lemma powerRZ_1 : forall x:R, x ^Z Z.succ 0 = x. Proof. simpl; auto with real. Qed. Lemma powerRZ_NOR : forall (x:R) (z:Z), x <> 0 -> x ^Z z <> 0. Proof. destruct z; simpl; auto with real. Qed. Lemma powerRZ_pos_sub (x:R) (n m:positive) : x <> 0 -> x ^Z (Z.pos_sub n m) = x ^ Pos.to_nat n * / x ^ Pos.to_nat m. Proof. intro Hx. rewrite Z.pos_sub_spec. case Pos.compare_spec; intro H; simpl. - subst; symmetry; auto with real. - rewrite Pos2Nat.inj_sub by trivial. rewrite Pos2Nat.inj_lt in H. rewrite (pow_RN_plus x _ (Pos.to_nat n)) by auto with real. rewrite Nat.sub_add; [ | apply Nat.lt_le_incl; assumption ]. rewrite Rinv_mult, Rinv_inv; auto with real. - rewrite Pos2Nat.inj_sub by trivial. rewrite Pos2Nat.inj_lt in H. rewrite (pow_RN_plus x _ (Pos.to_nat m)) by auto with real. rewrite Nat.sub_add; [ reflexivity | apply Nat.lt_le_incl; assumption ]. Qed. Lemma powerRZ_add : forall (x:R) (n m:Z), x <> 0 -> x ^Z (n + m) = x ^Z n * x ^Z m. Proof. intros x [|n|n] [|m|m]; simpl; intros; auto with real. - (* + + *) rewrite Pos2Nat.inj_add; auto with real. - (* + - *) now apply powerRZ_pos_sub. - (* - + *) rewrite Rmult_comm. now apply powerRZ_pos_sub. - (* - - *) rewrite Pos2Nat.inj_add; auto with real. rewrite pow_add; auto with real. apply Rinv_mult. Qed. #[local] Hint Resolve powerRZ_O powerRZ_1 powerRZ_NOR powerRZ_add: real. Lemma Zpower_nat_powerRZ : forall n m:nat, IZR (Zpower_nat (Z.of_nat n) m) = INR n ^Z Z.of_nat m. Proof. intros n m; elim m; simpl; auto with real. intros m1 H'; rewrite SuccNat2Pos.id_succ; simpl. replace (Zpower_nat (Z.of_nat n) (S m1)) with (Z.of_nat n * Zpower_nat (Z.of_nat n) m1)%Z. - rewrite mult_IZR; auto with real. repeat rewrite <- INR_IZR_INZ; simpl. rewrite H'; simpl. case m1; simpl; auto with real. intros m2; rewrite SuccNat2Pos.id_succ; auto. - unfold Zpower_nat; auto. Qed. Lemma Zpower_pos_powerRZ : forall n m, IZR (Z.pow_pos n m) = IZR n ^Z Zpos m. Proof. intros. rewrite Zpower_pos_nat; simpl. induction (Pos.to_nat m). - easy. - unfold Zpower_nat; simpl. rewrite mult_IZR. now rewrite <- IHn0. Qed. Lemma powerRZ_lt : forall (x:R) (z:Z), 0 < x -> 0 < x ^Z z. Proof. intros x z; case z; simpl; auto with real. Qed. #[local] Hint Resolve powerRZ_lt: real. Lemma powerRZ_le : forall (x:R) (z:Z), 0 < x -> 0 <= x ^Z z. Proof. intros x z H'; apply Rlt_le; auto with real. Qed. #[local] Hint Resolve powerRZ_le: real. Lemma Zpower_nat_powerRZ_absolu : forall n m:Z, (0 <= m)%Z -> IZR (Zpower_nat n (Z.abs_nat m)) = IZR n ^Z m. Proof. intros n m; case m; simpl; auto with zarith. - intros p H'; elim (Pos.to_nat p); simpl; auto with zarith. intros n0 H'0; rewrite <- H'0; simpl; auto with zarith. rewrite <- mult_IZR; auto. - intros p H'; absurd (0 <= Zneg p)%Z; auto with zarith. Qed. Lemma powerRZ_R1 : forall n:Z, 1 ^Z n = 1. Proof. intros n; case n; simpl; auto. - intros p; elim (Pos.to_nat p); simpl; auto; intros n0 H'; rewrite H'; ring. - intros p; elim (Pos.to_nat p); simpl. + exact Rinv_1. + intros n1 H'; rewrite Rinv_mult; try rewrite Rinv_1; try rewrite H'; auto with real. Qed. Local Open Scope Z_scope. Lemma pow_powerRZ (r : R) (n : nat) : (r ^ n)%R = powerRZ r (Z_of_nat n). Proof. induction n; [easy|simpl]. now rewrite SuccNat2Pos.id_succ. Qed. Lemma powerRZ_ind (P : Z -> R -> R -> Prop) : (forall x, P 0 x 1%R) -> (forall x n, P (Z.of_nat n) x (x ^ n)%R) -> (forall x n, P ((-(Z.of_nat n))%Z) x (Rinv (x ^ n))) -> forall x (m : Z), P m x (powerRZ x m)%R. Proof. intros ? ? ? x m. destruct (intP m) as [Hm|n Hm|n Hm]. - easy. - now rewrite <- pow_powerRZ. - unfold powerRZ. destruct n as [|n]; [ easy |]. rewrite Nat2Z.inj_succ, <- Zpos_P_of_succ_nat, Pos2Z.opp_pos. now rewrite <- Pos2Z.opp_pos, <- positive_nat_Z. Qed. Lemma powerRZ_inv' x alpha : powerRZ (/ x) alpha = Rinv (powerRZ x alpha). Proof. destruct (intP alpha). - now simpl; rewrite Rinv_1. - now rewrite <-!pow_powerRZ, ?pow_inv, ?pow_powerRZ. - unfold powerRZ. destruct (- n). + now rewrite Rinv_1. + apply pow_inv. + now rewrite pow_inv. Qed. Lemma powerRZ_inv_depr x alpha : (x <> 0)%R -> powerRZ (/ x) alpha = Rinv (powerRZ x alpha). Proof. intros _. apply powerRZ_inv'. Qed. Lemma powerRZ_neg' x : forall alpha, powerRZ x (- alpha) = Rinv (powerRZ x alpha). Proof. intros [|n|n] ; simpl. - apply eq_sym, Rinv_1. - easy. - now rewrite Rinv_inv. Qed. Lemma powerRZ_neg_depr x : forall alpha, x <> R0 -> powerRZ x (- alpha) = powerRZ (/ x) alpha. Proof. intros alpha _. rewrite powerRZ_neg'. apply eq_sym, powerRZ_inv'. Qed. Lemma powerRZ_mult m x y : (powerRZ (x*y) m = powerRZ x m * powerRZ y m)%R. Proof. destruct (intP m) as [ | | n Hm ]. - now simpl; rewrite Rmult_1_l. - now rewrite <- !pow_powerRZ, Rpow_mult_distr. - rewrite !powerRZ_neg', <- Rinv_mult. now rewrite <- !pow_powerRZ, Rpow_mult_distr. Qed. Lemma powerRZ_mult_distr_depr : forall m x y, ((0 <= m)%Z \/ (x * y <> 0)%R) -> (powerRZ (x*y) m = powerRZ x m * powerRZ y m)%R. Proof. intros m x y _. apply powerRZ_mult. Qed. End PowerRZ. #[deprecated(since="8.16",note="Use powerRZ_inv'.")] Notation powerRZ_inv := powerRZ_inv_depr. #[deprecated(since="8.16",note="Use powerRZ_neg' and powerRZ_inv'.")] Notation powerRZ_neg := powerRZ_neg_depr. #[deprecated(since="8.16",note="Use powerRZ_mult.")] Notation powerRZ_mult_distr := powerRZ_mult_distr_depr. Local Infix "^Z" := powerRZ (at level 30, right associativity) : R_scope. (*******************************) (* For easy interface *) (*******************************) (* decimal_exp r z is defined as r 10^z *) Definition decimal_exp (r:R) (z:Z) : R := (r * 10 ^Z z). (*******************************) (** * Sum of n first naturals *) (*******************************) (*********) Fixpoint sum_nat_f_O (f:nat -> nat) (n:nat) : nat := match n with | O => f 0%nat | S n' => (sum_nat_f_O f n' + f (S n'))%nat end. (*********) Definition sum_nat_f (s n:nat) (f:nat -> nat) : nat := sum_nat_f_O (fun x:nat => f (x + s)%nat) (n - s). (*********) Definition sum_nat_O (n:nat) : nat := sum_nat_f_O (fun x:nat => x) n. (*********) Definition sum_nat (s n:nat) : nat := sum_nat_f s n (fun x:nat => x). (*******************************) (** * Sum *) (*******************************) (*********) Fixpoint sum_f_R0 (f:nat -> R) (N:nat) : R := match N with | O => f 0%nat | S i => sum_f_R0 f i + f (S i) end. (*********) Definition sum_f (s n:nat) (f:nat -> R) : R := sum_f_R0 (fun x:nat => f (x + s)%nat) (n - s). Lemma GP_finite : forall (x:R) (n:nat), sum_f_R0 (fun n:nat => x ^ n) n * (x - 1) = x ^ (n + 1) - 1. Proof. intros; induction n as [| n Hrecn]; simpl. - ring. - rewrite Rmult_plus_distr_r; rewrite Hrecn; cut ((n + 1)%nat = S n). + intro H; rewrite H; simpl; ring. + apply Nat.add_1_r. Qed. Lemma sum_f_R0_triangle : forall (x:nat -> R) (n:nat), Rabs (sum_f_R0 x n) <= sum_f_R0 (fun i:nat => Rabs (x i)) n. Proof. intro; simple induction n; simpl. - unfold Rle; right; reflexivity. - intro m; intro; apply (Rle_trans (Rabs (sum_f_R0 x m + x (S m))) (Rabs (sum_f_R0 x m) + Rabs (x (S m))) (sum_f_R0 (fun i:nat => Rabs (x i)) m + Rabs (x (S m)))). + apply Rabs_triang. + rewrite Rplus_comm; rewrite (Rplus_comm (sum_f_R0 (fun i:nat => Rabs (x i)) m) (Rabs (x (S m)))); apply Rplus_le_compat_l; assumption. Qed. (*******************************) (** * Distance in R *) (*******************************) (*********) Definition Rdist (x y:R) : R := Rabs (x - y). (*********) Lemma Rdist_pos : forall x y:R, Rdist x y >= 0. Proof. intros; unfold Rdist; unfold Rabs; case (Rcase_abs (x - y)); intro l. - unfold Rge; left; apply (Ropp_gt_lt_0_contravar (x - y) l). - trivial. Qed. (*********) Lemma Rdist_sym : forall x y:R, Rdist x y = Rdist y x. Proof. unfold Rdist; intros; split_Rabs; try ring. - generalize (Ropp_gt_lt_0_contravar (y - x) Hlt0); intro; rewrite (Ropp_minus_distr y x) in H; generalize (Rlt_asym (x - y) 0 Hlt); intro; unfold Rgt in H; exfalso; auto. - generalize (minus_Rge y x Hge0); intro; generalize (minus_Rge x y Hge); intro; generalize (Rge_antisym x y H0 H); intro; rewrite H1; ring. Qed. (*********) Lemma Rdist_refl : forall x y:R, Rdist x y = 0 <-> x = y. Proof. unfold Rdist; intros; split_Rabs; split; intros. - rewrite (Ropp_minus_distr x y) in H; symmetry; apply (Rminus_diag_uniq y x H). - rewrite (Ropp_minus_distr x y); generalize (eq_sym H); intro; apply (Rminus_diag_eq y x H0). - apply (Rminus_diag_uniq x y H). - apply (Rminus_diag_eq x y H). Qed. Lemma Rdist_eq : forall x:R, Rdist x x = 0. Proof. unfold Rdist; intros; split_Rabs; intros; ring. Qed. (***********) Lemma Rdist_tri : forall x y z:R, Rdist x y <= Rdist x z + Rdist z y. Proof. intros; unfold Rdist; replace (x - y) with (x - z + (z - y)); [ apply (Rabs_triang (x - z) (z - y)) | ring ]. Qed. (*********) Lemma Rdist_plus : forall a b c d:R, Rdist (a + c) (b + d) <= Rdist a b + Rdist c d. Proof. intros; unfold Rdist; replace (a + c - (b + d)) with (a - b + (c - d)). - exact (Rabs_triang (a - b) (c - d)). - ring. Qed. Lemma Rdist_mult_l : forall a b c, Rdist (a * b) (a * c) = Rabs a * Rdist b c. Proof. unfold Rdist. intros a b c; rewrite <- Rmult_minus_distr_l, Rabs_mult; reflexivity. Qed. Notation R_dist := Rdist (only parsing). Notation R_dist_pos := Rdist_pos (only parsing). Notation R_dist_sym := Rdist_sym (only parsing). Notation R_dist_refl := Rdist_refl (only parsing). Notation R_dist_eq := Rdist_eq (only parsing). Notation R_dist_tri := Rdist_tri (only parsing). Notation R_dist_plus := Rdist_plus (only parsing). Notation R_dist_mult_l := Rdist_mult_l (only parsing). (*******************************) (** * Infinite Sum *) (*******************************) (*********) Definition infinite_sum (s:nat -> R) (l:R) : Prop := forall eps:R, eps > 0 -> exists N : nat, (forall n:nat, (n >= N)%nat -> Rdist (sum_f_R0 s n) l < eps). (** Compatibility with previous versions *) Notation infinit_sum := infinite_sum (only parsing). coq-8.20.0/theories/Reals/Rgeom.v000066400000000000000000000173671466560755400165530ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* Rsqr b = Rsqr c + Rsqr a - 2 * (a * c * cos ac). Proof. unfold dist_euc; intros; repeat rewrite Rsqr_sqrt; [ rewrite H; unfold Rsqr; ring | apply Rplus_le_le_0_compat | apply Rplus_le_le_0_compat | apply Rplus_le_le_0_compat ]; apply Rle_0_sqr. Qed. Lemma triangle : forall x0 y0 x1 y1 x2 y2:R, dist_euc x0 y0 x1 y1 <= dist_euc x0 y0 x2 y2 + dist_euc x2 y2 x1 y1. Proof. intros; unfold dist_euc; apply Rsqr_incr_0; [ rewrite Rsqr_plus; repeat rewrite Rsqr_sqrt; [ replace (Rsqr (x0 - x1)) with (Rsqr (x0 - x2) + Rsqr (x2 - x1) + 2 * (x0 - x2) * (x2 - x1)); [ replace (Rsqr (y0 - y1)) with (Rsqr (y0 - y2) + Rsqr (y2 - y1) + 2 * (y0 - y2) * (y2 - y1)); [ apply Rplus_le_reg_l with (- Rsqr (x0 - x2) - Rsqr (x2 - x1) - Rsqr (y0 - y2) - Rsqr (y2 - y1)); replace (- Rsqr (x0 - x2) - Rsqr (x2 - x1) - Rsqr (y0 - y2) - Rsqr (y2 - y1) + (Rsqr (x0 - x2) + Rsqr (x2 - x1) + 2 * (x0 - x2) * (x2 - x1) + (Rsqr (y0 - y2) + Rsqr (y2 - y1) + 2 * (y0 - y2) * (y2 - y1)))) with (2 * ((x0 - x2) * (x2 - x1) + (y0 - y2) * (y2 - y1))); [ replace (- Rsqr (x0 - x2) - Rsqr (x2 - x1) - Rsqr (y0 - y2) - Rsqr (y2 - y1) + (Rsqr (x0 - x2) + Rsqr (y0 - y2) + (Rsqr (x2 - x1) + Rsqr (y2 - y1)) + 2 * sqrt (Rsqr (x0 - x2) + Rsqr (y0 - y2)) * sqrt (Rsqr (x2 - x1) + Rsqr (y2 - y1)))) with (2 * (sqrt (Rsqr (x0 - x2) + Rsqr (y0 - y2)) * sqrt (Rsqr (x2 - x1) + Rsqr (y2 - y1)))); [ apply Rmult_le_compat_l; [ left; cut (0%nat <> 2%nat); [ intros; generalize (lt_INR_0 2 (proj1 (Nat.neq_0_lt_0 2) (Nat.neq_sym 0 2 H))); intro H0; assumption | discriminate ] | apply sqrt_cauchy ] | ring ] | ring ] | ring_Rsqr ] | ring_Rsqr ] | apply Rplus_le_le_0_compat; apply Rle_0_sqr | apply Rplus_le_le_0_compat; apply Rle_0_sqr | apply Rplus_le_le_0_compat; apply Rle_0_sqr ] | apply sqrt_positivity; apply Rplus_le_le_0_compat; apply Rle_0_sqr | apply Rplus_le_le_0_compat; apply sqrt_positivity; apply Rplus_le_le_0_compat; apply Rle_0_sqr ]. Qed. (******************************************************************) (** * Translation *) (******************************************************************) Definition xt (x tx:R) : R := x + tx. Definition yt (y ty:R) : R := y + ty. Lemma translation_0 : forall x y:R, xt x 0 = x /\ yt y 0 = y. Proof. intros x y; split; [ unfold xt | unfold yt ]; ring. Qed. Lemma isometric_translation : forall x1 x2 y1 y2 tx ty:R, Rsqr (x1 - x2) + Rsqr (y1 - y2) = Rsqr (xt x1 tx - xt x2 tx) + Rsqr (yt y1 ty - yt y2 ty). Proof. intros; unfold Rsqr, xt, yt; ring. Qed. (******************************************************************) (** * Rotation *) (******************************************************************) Definition xr (x y theta:R) : R := x * cos theta + y * sin theta. Definition yr (x y theta:R) : R := - x * sin theta + y * cos theta. Lemma rotation_0 : forall x y:R, xr x y 0 = x /\ yr x y 0 = y. Proof. intros x y; unfold xr, yr; split; rewrite cos_0; rewrite sin_0; ring. Qed. Lemma rotation_PI2 : forall x y:R, xr x y (PI / 2) = y /\ yr x y (PI / 2) = - x. Proof. intros x y; unfold xr, yr; split; rewrite cos_PI2; rewrite sin_PI2; ring. Qed. Lemma isometric_rotation_0 : forall x1 y1 x2 y2 theta:R, Rsqr (x1 - x2) + Rsqr (y1 - y2) = Rsqr (xr x1 y1 theta - xr x2 y2 theta) + Rsqr (yr x1 y1 theta - yr x2 y2 theta). Proof. intros; unfold xr, yr; replace (x1 * cos theta + y1 * sin theta - (x2 * cos theta + y2 * sin theta)) with (cos theta * (x1 - x2) + sin theta * (y1 - y2)); [ replace (- x1 * sin theta + y1 * cos theta - (- x2 * sin theta + y2 * cos theta)) with (cos theta * (y1 - y2) + sin theta * (x2 - x1)); [ repeat rewrite Rsqr_plus; repeat rewrite Rsqr_mult; repeat rewrite cos2; ring_simplify; replace (x2 - x1) with (- (x1 - x2)); [ rewrite <- Rsqr_neg; ring | ring ] | ring ] | ring ]. Qed. Lemma isometric_rotation : forall x1 y1 x2 y2 theta:R, dist_euc x1 y1 x2 y2 = dist_euc (xr x1 y1 theta) (yr x1 y1 theta) (xr x2 y2 theta) (yr x2 y2 theta). Proof. unfold dist_euc; intros; apply Rsqr_inj; [ apply sqrt_positivity; apply Rplus_le_le_0_compat | apply sqrt_positivity; apply Rplus_le_le_0_compat | repeat rewrite Rsqr_sqrt; [ apply isometric_rotation_0 | apply Rplus_le_le_0_compat | apply Rplus_le_le_0_compat ] ]; apply Rle_0_sqr. Qed. (******************************************************************) (** * Similarity *) (******************************************************************) Lemma isometric_rot_trans : forall x1 y1 x2 y2 tx ty theta:R, Rsqr (x1 - x2) + Rsqr (y1 - y2) = Rsqr (xr (xt x1 tx) (yt y1 ty) theta - xr (xt x2 tx) (yt y2 ty) theta) + Rsqr (yr (xt x1 tx) (yt y1 ty) theta - yr (xt x2 tx) (yt y2 ty) theta). Proof. intros; rewrite <- isometric_rotation_0; apply isometric_translation. Qed. Lemma isometric_trans_rot : forall x1 y1 x2 y2 tx ty theta:R, Rsqr (x1 - x2) + Rsqr (y1 - y2) = Rsqr (xt (xr x1 y1 theta) tx - xt (xr x2 y2 theta) tx) + Rsqr (yt (yr x1 y1 theta) ty - yt (yr x2 y2 theta) ty). Proof. intros; rewrite <- isometric_translation; apply isometric_rotation_0. Qed. coq-8.20.0/theories/Reals/RiemannInt.v000066400000000000000000004236321466560755400175420ustar00rootroot00000000000000(* -*- coding: utf-8 -*- *) (************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* R) (a b:R) : Type := forall eps:posreal, { phi:StepFun a b & { psi:StepFun a b | (forall t:R, Rmin a b <= t <= Rmax a b -> Rabs (f t - phi t) <= psi t) /\ Rabs (RiemannInt_SF psi) < eps } }. Definition phi_sequence (un:nat -> posreal) (f:R -> R) (a b:R) (pr:Riemann_integrable f a b) (n:nat) := projT1 (pr (un n)). Lemma phi_sequence_prop : forall (un:nat -> posreal) (f:R -> R) (a b:R) (pr:Riemann_integrable f a b) (N:nat), { psi:StepFun a b | (forall t:R, Rmin a b <= t <= Rmax a b -> Rabs (f t - phi_sequence un pr N t) <= psi t) /\ Rabs (RiemannInt_SF psi) < un N }. Proof. intros; apply (projT2 (pr (un N))). Qed. Lemma RiemannInt_P1 : forall (f:R -> R) (a b:R), Riemann_integrable f a b -> Riemann_integrable f b a. Proof. unfold Riemann_integrable; intros; elim (X eps); clear X; intros. elim p; clear p; intros x0 p; exists (mkStepFun (StepFun_P6 (pre x))); exists (mkStepFun (StepFun_P6 (pre x0))); elim p; clear p; intros; split. - intros; apply (H t); elim H1; clear H1; intros; split; [ apply Rle_trans with (Rmin b a); try assumption; right; unfold Rmin | apply Rle_trans with (Rmax b a); try assumption; right; unfold Rmax ]; (case (Rle_dec a b); case (Rle_dec b a); intros; try reflexivity || apply Rle_antisym; [ assumption | assumption | auto with real | auto with real ]). - generalize H0; unfold RiemannInt_SF; case (Rle_dec a b); case (Rle_dec b a); intros; (replace (Int_SF (subdivision_val (mkStepFun (StepFun_P6 (pre x0)))) (subdivision (mkStepFun (StepFun_P6 (pre x0))))) with (Int_SF (subdivision_val x0) (subdivision x0)); [ idtac | apply StepFun_P17 with (fe x0) a b; [ apply StepFun_P1 | apply StepFun_P2; apply (StepFun_P1 (mkStepFun (StepFun_P6 (pre x0)))) ] ]). + apply H1. + rewrite Rabs_Ropp; apply H1. + rewrite Rabs_Ropp in H1; apply H1. + apply H1. Qed. Lemma RiemannInt_P2 : forall (f:R -> R) (a b:R) (un:nat -> posreal) (vn wn:nat -> StepFun a b), Un_cv un 0 -> a <= b -> (forall n:nat, (forall t:R, Rmin a b <= t <= Rmax a b -> Rabs (f t - vn n t) <= wn n t) /\ Rabs (RiemannInt_SF (wn n)) < un n) -> { l:R | Un_cv (fun N:nat => RiemannInt_SF (vn N)) l }. Proof. intros; apply R_complete; unfold Un_cv in H; unfold Cauchy_crit; intros; assert (H3 : 0 < eps / 2) by lra. elim (H _ H3); intros N0 H4; exists N0; intros; unfold Rdist; unfold Rdist in H4; elim (H1 n); elim (H1 m); intros; replace (RiemannInt_SF (vn n) - RiemannInt_SF (vn m)) with (RiemannInt_SF (vn n) + -1 * RiemannInt_SF (vn m)); [ idtac | ring ]; rewrite <- StepFun_P30; apply Rle_lt_trans with (RiemannInt_SF (mkStepFun (StepFun_P32 (mkStepFun (StepFun_P28 (-1) (vn n) (vn m)))))). { apply StepFun_P34; assumption. } apply Rle_lt_trans with (RiemannInt_SF (mkStepFun (StepFun_P28 1 (wn n) (wn m)))). { apply StepFun_P37; try assumption. intros; simpl; apply Rle_trans with (Rabs (vn n x - f x) + Rabs (f x - vn m x)). { replace (vn n x + -1 * vn m x) with (vn n x - f x + (f x - vn m x)); [ apply Rabs_triang | ring ]. } assert (H12 : Rmin a b = a). { unfold Rmin; decide (Rle_dec a b) with H0; reflexivity. } assert (H13 : Rmax a b = b). { unfold Rmax; decide (Rle_dec a b) with H0; reflexivity. } rewrite <- H12 in H11; rewrite <- H13 in H11 at 2; rewrite Rmult_1_l; apply Rplus_le_compat. { rewrite <- Rabs_Ropp; rewrite Ropp_minus_distr; apply H9. elim H11; intros; split; left; assumption. } apply H7. elim H11; intros; split; left; assumption. } rewrite StepFun_P30; rewrite Rmult_1_l; apply Rlt_trans with (un n + un m). { apply Rle_lt_trans with (Rabs (RiemannInt_SF (wn n)) + Rabs (RiemannInt_SF (wn m))). { apply Rplus_le_compat; apply RRle_abs. } apply Rplus_lt_compat; assumption. } apply Rle_lt_trans with (Rabs (un n) + Rabs (un m)). { apply Rplus_le_compat; apply RRle_abs. } replace (pos (un n)) with (un n - 0); [ idtac | ring ]; replace (pos (un m)) with (un m - 0); [ idtac | ring ]; rewrite <-(Rplus_half_diag eps); apply Rplus_lt_compat; apply H4; assumption. Qed. Lemma RiemannInt_P3 : forall (f:R -> R) (a b:R) (un:nat -> posreal) (vn wn:nat -> StepFun a b), Un_cv un 0 -> (forall n:nat, (forall t:R, Rmin a b <= t <= Rmax a b -> Rabs (f t - vn n t) <= wn n t) /\ Rabs (RiemannInt_SF (wn n)) < un n) -> { l:R | Un_cv (fun N:nat => RiemannInt_SF (vn N)) l }. Proof. intros; destruct (Rle_dec a b) as [Hle|Hnle]. { apply RiemannInt_P2 with f un wn; assumption. } assert (H1 : b <= a); auto with real. set (vn' := fun n:nat => mkStepFun (StepFun_P6 (pre (vn n)))); set (wn' := fun n:nat => mkStepFun (StepFun_P6 (pre (wn n)))); assert (H2 : forall n:nat, (forall t:R, Rmin b a <= t <= Rmax b a -> Rabs (f t - vn' n t) <= wn' n t) /\ Rabs (RiemannInt_SF (wn' n)) < un n). { intro; elim (H0 n); intros; split. { intros t (H4,H5); apply (H2 t); split; [ apply Rle_trans with (Rmin b a); try assumption; right; unfold Rmin | apply Rle_trans with (Rmax b a); try assumption; right; unfold Rmax ]; decide (Rle_dec a b) with Hnle; decide (Rle_dec b a) with H1; reflexivity. } generalize H3; unfold RiemannInt_SF; destruct (Rle_dec a b) as [Hleab|Hnleab]; destruct (Rle_dec b a) as [Hle'|Hnle']; unfold wn'; intros; (replace (Int_SF (subdivision_val (mkStepFun (StepFun_P6 (pre (wn n))))) (subdivision (mkStepFun (StepFun_P6 (pre (wn n)))))) with (Int_SF (subdivision_val (wn n)) (subdivision (wn n))); [ idtac | apply StepFun_P17 with (fe (wn n)) a b; [ apply StepFun_P1 | apply StepFun_P2; apply (StepFun_P1 (mkStepFun (StepFun_P6 (pre (wn n))))) ] ]). - apply H4. - rewrite Rabs_Ropp; apply H4. - rewrite Rabs_Ropp in H4; apply H4. - apply H4. } assert (H3 := RiemannInt_P2 _ _ _ _ H H1 H2); elim H3; intros x p; exists (- x); unfold Un_cv; unfold Un_cv in p; intros; elim (p _ H4); intros; exists x0; intros; generalize (H5 _ H6); unfold Rdist, RiemannInt_SF; destruct (Rle_dec b a) as [Hle'|Hnle']; destruct (Rle_dec a b) as [Hle''|Hnle'']; intros. 1,3,4: lra. unfold vn' in H7; replace (Int_SF (subdivision_val (vn n)) (subdivision (vn n))) with (Int_SF (subdivision_val (mkStepFun (StepFun_P6 (pre (vn n))))) (subdivision (mkStepFun (StepFun_P6 (pre (vn n)))))); [ unfold Rminus; rewrite Ropp_involutive; rewrite <- Rabs_Ropp; rewrite Ropp_plus_distr; rewrite Ropp_involutive; apply H7 | symmetry ; apply StepFun_P17 with (fe (vn n)) a b; [ apply StepFun_P1 | apply StepFun_P2; apply (StepFun_P1 (mkStepFun (StepFun_P6 (pre (vn n))))) ] ]. Qed. Lemma RiemannInt_exists : forall (f:R -> R) (a b:R) (pr:Riemann_integrable f a b) (un:nat -> posreal), Un_cv un 0 -> { l:R | Un_cv (fun N:nat => RiemannInt_SF (phi_sequence un pr N)) l }. Proof. intros f; intros; apply RiemannInt_P3 with f un (fun n:nat => proj1_sig (phi_sequence_prop un pr n)); [ apply H | intro; apply (proj2_sig (phi_sequence_prop un pr n)) ]. Qed. Lemma RiemannInt_P4 : forall (f:R -> R) (a b l:R) (pr1 pr2:Riemann_integrable f a b) (un vn:nat -> posreal), Un_cv un 0 -> Un_cv vn 0 -> Un_cv (fun N:nat => RiemannInt_SF (phi_sequence un pr1 N)) l -> Un_cv (fun N:nat => RiemannInt_SF (phi_sequence vn pr2 N)) l. Proof. unfold Un_cv; unfold Rdist; intros f; intros; assert (H3 : 0 < eps / 3). { unfold Rdiv; apply Rmult_lt_0_compat; [ assumption | apply Rinv_0_lt_compat; prove_sup0 ]. } elim (H _ H3); clear H; intros N0 H; elim (H0 _ H3); clear H0; intros N1 H0; elim (H1 _ H3); clear H1; intros N2 H1; set (N := max (max N0 N1) N2); exists N; intros; apply Rle_lt_trans with (Rabs (RiemannInt_SF (phi_sequence vn pr2 n) - RiemannInt_SF (phi_sequence un pr1 n)) + Rabs (RiemannInt_SF (phi_sequence un pr1 n) - l)). { replace (RiemannInt_SF (phi_sequence vn pr2 n) - l) with (RiemannInt_SF (phi_sequence vn pr2 n) - RiemannInt_SF (phi_sequence un pr1 n) + (RiemannInt_SF (phi_sequence un pr1 n) - l)); [ apply Rabs_triang | ring ]. } replace eps with (2 * (eps / 3) + eps / 3) by lra. apply Rplus_lt_compat. 2:{ apply H1; unfold ge; apply Nat.le_trans with N; try assumption; unfold N; apply Nat.le_max_r. } elim (phi_sequence_prop vn pr2 n); intros psi_vn H5; elim (phi_sequence_prop un pr1 n); intros psi_un H6; replace (RiemannInt_SF (phi_sequence vn pr2 n) - RiemannInt_SF (phi_sequence un pr1 n)) with (RiemannInt_SF (phi_sequence vn pr2 n) + -1 * RiemannInt_SF (phi_sequence un pr1 n)); [ idtac | ring ]; rewrite <- StepFun_P30. destruct (Rle_dec a b) as [Hle|Hnle]. - apply Rle_lt_trans with (RiemannInt_SF (mkStepFun (StepFun_P32 (mkStepFun (StepFun_P28 (-1) (phi_sequence vn pr2 n) (phi_sequence un pr1 n)))))). { apply StepFun_P34; assumption. } apply Rle_lt_trans with (RiemannInt_SF (mkStepFun (StepFun_P28 1 psi_un psi_vn))). { apply StepFun_P37; try assumption; intros; simpl; rewrite Rmult_1_l; apply Rle_trans with (Rabs (phi_sequence vn pr2 n x - f x) + Rabs (f x - phi_sequence un pr1 n x)). { replace (phi_sequence vn pr2 n x + -1 * phi_sequence un pr1 n x) with (phi_sequence vn pr2 n x - f x + (f x - phi_sequence un pr1 n x)); [ apply Rabs_triang | ring ]. } assert (H10 : Rmin a b = a). { unfold Rmin; decide (Rle_dec a b) with Hle; reflexivity. } assert (H11 : Rmax a b = b). { unfold Rmax; decide (Rle_dec a b) with Hle; reflexivity. } rewrite (Rplus_comm (psi_un x)); apply Rplus_le_compat. { rewrite <- Rabs_Ropp; rewrite Ropp_minus_distr; destruct H5 as (H8,H9); apply H8. rewrite H10; rewrite H11; elim H7; intros; split; left; assumption. } elim H6; intros; apply H8. rewrite H10; rewrite H11; elim H7; intros; split; left; assumption. } rewrite StepFun_P30; rewrite Rmult_1_l; rewrite <-Rplus_diag; apply Rplus_lt_compat. { apply Rlt_trans with (pos (un n)). { elim H6; intros; apply Rle_lt_trans with (Rabs (RiemannInt_SF psi_un)). { apply RRle_abs. } assumption. } replace (pos (un n)) with (Rabs (un n - 0)); [ apply H; unfold ge; apply Nat.le_trans with N; try assumption; unfold N; apply Nat.le_trans with (max N0 N1); apply Nat.le_max_l | unfold Rminus; rewrite Ropp_0; rewrite Rplus_0_r; apply Rabs_right; apply Rle_ge; left; apply (cond_pos (un n)) ]. } apply Rlt_trans with (pos (vn n)). { elim H5; intros; apply Rle_lt_trans with (Rabs (RiemannInt_SF psi_vn)). { apply RRle_abs; assumption. } assumption. } replace (pos (vn n)) with (Rabs (vn n - 0)); [ apply H0; unfold ge; apply Nat.le_trans with N; try assumption; unfold N; apply Nat.le_trans with (max N0 N1); [ apply Nat.le_max_r | apply Nat.le_max_l ] | unfold Rminus; rewrite Ropp_0; rewrite Rplus_0_r; apply Rabs_right; apply Rle_ge; left; apply (cond_pos (vn n)) ]. - rewrite StepFun_P39; rewrite Rabs_Ropp; apply Rle_lt_trans with (RiemannInt_SF (mkStepFun (StepFun_P32 (mkStepFun (StepFun_P6 (pre (mkStepFun (StepFun_P28 (-1) (phi_sequence vn pr2 n) (phi_sequence un pr1 n))))))))). { apply StepFun_P34; try auto with real. } apply Rle_lt_trans with (RiemannInt_SF (mkStepFun (StepFun_P6 (pre (mkStepFun (StepFun_P28 1 psi_vn psi_un)))))). { apply StepFun_P37. { auto with real. } intros; simpl; rewrite Rmult_1_l; apply Rle_trans with (Rabs (phi_sequence vn pr2 n x - f x) + Rabs (f x - phi_sequence un pr1 n x)). { replace (phi_sequence vn pr2 n x + -1 * phi_sequence un pr1 n x) with (phi_sequence vn pr2 n x - f x + (f x - phi_sequence un pr1 n x)); [ apply Rabs_triang | ring ]. } assert (H10 : Rmin a b = b). { unfold Rmin; decide (Rle_dec a b) with Hnle; reflexivity. } assert (H11 : Rmax a b = a). { unfold Rmax; decide (Rle_dec a b) with Hnle; reflexivity. } apply Rplus_le_compat. { rewrite <- Rabs_Ropp; rewrite Ropp_minus_distr; elim H5; intros; apply H8. rewrite H10; rewrite H11; elim H7; intros; split; left; assumption. } elim H6; intros; apply H8. rewrite H10; rewrite H11; elim H7; intros; split; left; assumption. } rewrite <- (Ropp_involutive (RiemannInt_SF (mkStepFun (StepFun_P6 (pre (mkStepFun (StepFun_P28 1 psi_vn psi_un))))))) ; rewrite <- StepFun_P39; rewrite StepFun_P30; rewrite Rmult_1_l; rewrite <-Rplus_diag; rewrite Ropp_plus_distr; apply Rplus_lt_compat. { apply Rlt_trans with (pos (vn n)). { elim H5; intros; apply Rle_lt_trans with (Rabs (RiemannInt_SF psi_vn)). { rewrite <- Rabs_Ropp; apply RRle_abs. } assumption. } replace (pos (vn n)) with (Rabs (vn n - 0)); [ apply H0; unfold ge; apply Nat.le_trans with N; try assumption; unfold N; apply Nat.le_trans with (max N0 N1); [ apply Nat.le_max_r | apply Nat.le_max_l ] | unfold Rdist; unfold Rminus; rewrite Ropp_0; rewrite Rplus_0_r; apply Rabs_right; apply Rle_ge; left; apply (cond_pos (vn n)) ]. } apply Rlt_trans with (pos (un n)). { elim H6; intros; apply Rle_lt_trans with (Rabs (RiemannInt_SF psi_un)). { rewrite <- Rabs_Ropp; apply RRle_abs; assumption. } assumption. } replace (pos (un n)) with (Rabs (un n - 0)); [ apply H; unfold ge; apply Nat.le_trans with N; try assumption; unfold N; apply Nat.le_trans with (max N0 N1); apply Nat.le_max_l | unfold Rminus; rewrite Ropp_0; rewrite Rplus_0_r; apply Rabs_right; apply Rle_ge; left; apply (cond_pos (un n)) ]. Qed. Lemma RinvN_pos : forall n:nat, 0 < / (INR n + 1). Proof. intro; apply Rinv_0_lt_compat; apply Rplus_le_lt_0_compat; [ apply pos_INR | apply Rlt_0_1 ]. Qed. Definition RinvN (N:nat) : posreal := mkposreal _ (RinvN_pos N). Lemma RinvN_cv : Un_cv RinvN 0. Proof. unfold Un_cv; intros; assert (H0 := archimed (/ eps)); elim H0; clear H0; intros; assert (H2 : (0 <= up (/ eps))%Z). { apply le_IZR; left; apply Rlt_trans with (/ eps); [ apply Rinv_0_lt_compat; assumption | assumption ]. } elim (IZN _ H2); intros; exists x; intros; unfold Rdist; simpl; unfold Rminus; rewrite Ropp_0; rewrite Rplus_0_r; assert (H5 : 0 < INR n + 1). { apply Rplus_le_lt_0_compat; [ apply pos_INR | apply Rlt_0_1 ]. } rewrite Rabs_right; [ idtac | left; change (0 < / (INR n + 1)); apply Rinv_0_lt_compat; assumption ]; apply Rle_lt_trans with (/ (INR x + 1)). { apply Rinv_le_contravar. { apply Rplus_le_lt_0_compat; [ apply pos_INR | apply Rlt_0_1 ]. } apply Rplus_le_compat_r; apply le_INR; apply H4. } rewrite <- (Rinv_inv eps). apply Rinv_lt_contravar. { apply Rmult_lt_0_compat. { apply Rinv_0_lt_compat; assumption. } apply Rplus_le_lt_0_compat; [ apply pos_INR | apply Rlt_0_1 ]. } apply Rlt_trans with (INR x); [ rewrite INR_IZR_INZ; rewrite <- H3; apply H0 | pattern (INR x) at 1; rewrite <- Rplus_0_r; apply Rplus_lt_compat_l; apply Rlt_0_1 ]. Qed. Lemma Riemann_integrable_ext : forall f g a b, (forall x, Rmin a b <= x <= Rmax a b -> f x = g x) -> Riemann_integrable f a b -> Riemann_integrable g a b. intros f g a b fg rif eps; destruct (rif eps) as [phi [psi [P1 P2]]]. exists phi; exists psi;split;[ | assumption ]. intros t intt; rewrite <- fg;[ | assumption]. apply P1; assumption. Qed. (**********) Definition RiemannInt (f:R -> R) (a b:R) (pr:Riemann_integrable f a b) : R := let (a,_) := RiemannInt_exists pr RinvN RinvN_cv in a. Lemma RiemannInt_P5 : forall (f:R -> R) (a b:R) (pr1 pr2:Riemann_integrable f a b), RiemannInt pr1 = RiemannInt pr2. Proof. intros; unfold RiemannInt; case (RiemannInt_exists pr1 RinvN RinvN_cv) as (x,HUn); case (RiemannInt_exists pr2 RinvN RinvN_cv) as (x0,HUn0); eapply UL_sequence; [ apply HUn | apply RiemannInt_P4 with pr2 RinvN; apply RinvN_cv || assumption ]. Qed. (***************************************) (** C°([a,b]) is included in L1([a,b]) *) (***************************************) Lemma maxN : forall (a b:R) (del:posreal), a < b -> { n:nat | a + INR n * del < b /\ b <= a + INR (S n) * del }. Proof. intros; set (I := fun n:nat => a + INR n * del < b); assert (H0 : exists n : nat, I n). { exists 0%nat; unfold I; rewrite Rmult_0_l; rewrite Rplus_0_r; assumption. } cut (Nbound I). { intro; assert (H2 := Nzorn H0 H1); elim H2; intros x p; exists x; elim p; intros; split. { apply H3. } destruct (total_order_T (a + INR (S x) * del) b) as [[Hlt|Heq]|Hgt]. { assert (H5 := H4 (S x) Hlt); elim (Nat.nle_succ_diag_l _ H5). } { right; symmetry ; assumption. } left; apply Hgt. } assert (H1 : 0 <= (b - a) / del). { unfold Rdiv; apply Rmult_le_pos; [ apply Rge_le; apply Rge_minus; apply Rle_ge; left; apply H | left; apply Rinv_0_lt_compat; apply (cond_pos del) ]. } elim (archimed ((b - a) / del)); intros; assert (H4 : (0 <= up ((b - a) / del))%Z). { apply le_IZR; simpl; left; apply Rle_lt_trans with ((b - a) / del); assumption. } assert (H5 := IZN _ H4); elim H5; clear H5; intros N H5; unfold Nbound; exists N; intros; unfold I in H6; apply INR_le; rewrite H5 in H2; rewrite <- INR_IZR_INZ in H2; left; apply Rle_lt_trans with ((b - a) / del); try assumption; apply Rmult_le_reg_l with (pos del); [ apply (cond_pos del) | unfold Rdiv; rewrite <- (Rmult_comm (/ del)); rewrite <- Rmult_assoc; rewrite Rinv_r; [ rewrite Rmult_1_l; rewrite Rmult_comm; apply Rplus_le_reg_l with a; replace (a + (b - a)) with b; [ left; assumption | ring ] | assert (H7 := cond_pos del); red; intro; rewrite H8 in H7; elim (Rlt_irrefl _ H7) ] ]. Qed. Fixpoint SubEquiN (N:nat) (x y:R) (del:posreal) : list R := match N with | O => cons y nil | S p => cons x (SubEquiN p (x + del) y del) end. Definition max_N (a b:R) (del:posreal) (h:a < b) : nat := let (N,_) := maxN del h in N. Definition SubEqui (a b:R) (del:posreal) (h:a < b) : list R := SubEquiN (S (max_N del h)) a b del. Lemma Heine_cor1 : forall (f:R -> R) (a b:R), a < b -> (forall x:R, a <= x <= b -> continuity_pt f x) -> forall eps:posreal, { delta:posreal | delta <= b - a /\ (forall x y:R, a <= x <= b -> a <= y <= b -> Rabs (x - y) < delta -> Rabs (f x - f y) < eps) }. Proof. intro f; intros; set (E := fun l:R => 0 < l <= b - a /\ (forall x y:R, a <= x <= b -> a <= y <= b -> Rabs (x - y) < l -> Rabs (f x - f y) < eps)); assert (H1 : bound E). { unfold bound; exists (b - a); unfold is_upper_bound; intros; unfold E in H1; elim H1; clear H1; intros H1 _; elim H1; intros; assumption. } assert (H2 : exists x : R, E x). { assert (H2 := Heine f (fun x:R => a <= x <= b) (compact_P3 a b) H0 eps); elim H2; intros; exists (Rmin x (b - a)); unfold E; split; [ split; [ unfold Rmin; case (Rle_dec x (b - a)); intro; [ apply (cond_pos x) | apply Rlt_0_minus; assumption ] | apply Rmin_r ] | intros; apply H3; try assumption; apply Rlt_le_trans with (Rmin x (b - a)); [ assumption | apply Rmin_l ] ]. } assert (H3 := completeness E H1 H2); elim H3; intros x p; cut (0 < x <= b - a). { intro; elim H4; clear H4; intros; exists (mkposreal _ H4); split. { apply H5. } unfold is_lub in p; elim p; intros; unfold is_upper_bound in H6; set (D := Rabs (x0 - y)). assert (H11: ((exists y : R, D < y /\ E y) \/ (forall y : R, not (D < y /\ E y)) -> False) -> False). { clear; intros H; apply H. right; intros y0 H0; apply H. left; now exists y0. } apply Rnot_le_lt; intros H30. apply H11; clear H11; intros H11. revert H30; apply Rlt_not_le. destruct H11 as [H11|H12]. { elim H11; intros; elim H12; clear H12; intros; unfold E in H13; elim H13; intros; apply H15; assumption. } assert (H13 : is_upper_bound E D). { unfold is_upper_bound; intros; assert (H14 := H12 x1); apply Rnot_lt_le; contradict H14; now split. } assert (H14 := H7 _ H13); elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H14 H10)). } unfold is_lub in p; unfold is_upper_bound in p; elim p; clear p; intros; split. { elim H2; intros; assert (H7 := H4 _ H6); unfold E in H6; elim H6; clear H6; intros H6 _; elim H6; intros; apply Rlt_le_trans with x0; assumption. } apply H5; intros; unfold E in H6; elim H6; clear H6; intros H6 _; elim H6; intros; assumption. Qed. Lemma Heine_cor2 : forall (f:R -> R) (a b:R), (forall x:R, a <= x <= b -> continuity_pt f x) -> forall eps:posreal, { delta:posreal | forall x y:R, a <= x <= b -> a <= y <= b -> Rabs (x - y) < delta -> Rabs (f x - f y) < eps }. Proof. intro f; intros; destruct (total_order_T a b) as [[Hlt|Heq]|Hgt]. - assert (H0 := Heine_cor1 Hlt H eps); elim H0; intros x p; exists x; elim p; intros; apply H2; assumption. - exists (mkposreal _ Rlt_0_1); intros; assert (H3 : x = y); [ elim H0; elim H1; intros; rewrite Heq in H3, H5; apply Rle_antisym; apply Rle_trans with b; assumption | rewrite H3; unfold Rminus; rewrite Rplus_opp_r; rewrite Rabs_R0; apply (cond_pos eps) ]. - exists (mkposreal _ Rlt_0_1); intros; elim H0; intros; elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ (Rle_trans _ _ _ H3 H4) Hgt)). Qed. Lemma SubEqui_P1 : forall (a b:R) (del:posreal) (h:a < b), pos_Rl (SubEqui del h) 0 = a. Proof. intros; unfold SubEqui; case (maxN del h); intros; reflexivity. Qed. Lemma SubEqui_P2 : forall (a b:R) (del:posreal) (h:a < b), pos_Rl (SubEqui del h) (pred (length (SubEqui del h))) = b. Proof. intros; unfold SubEqui; destruct (maxN del h)as (x,_). cut (forall (x:nat) (a:R) (del:posreal), pos_Rl (SubEquiN (S x) a b del) (pred (length (SubEquiN (S x) a b del))) = b); [ intro; apply H | simple induction x0; [ intros; reflexivity | intros; change (pos_Rl (SubEquiN (S n) (a0 + del0) b del0) (pred (length (SubEquiN (S n) (a0 + del0) b del0))) = b) ; apply H ] ]. Qed. Lemma SubEqui_P3 : forall (N:nat) (a b:R) (del:posreal), length (SubEquiN N a b del) = S N. Proof. simple induction N; intros; [ reflexivity | simpl; rewrite H; reflexivity ]. Qed. Lemma SubEqui_P4 : forall (N:nat) (a b:R) (del:posreal) (i:nat), (i < S N)%nat -> pos_Rl (SubEquiN (S N) a b del) i = a + INR i * del. Proof. simple induction N; [ intros; inversion H; [ simpl; ring | elim (Nat.nle_succ_0 _ H1) ] | intros; induction i as [| i Hreci]; [ simpl; ring | change (pos_Rl (SubEquiN (S n) (a + del) b del) i = a + INR (S i) * del) ; rewrite H; [ rewrite S_INR; ring | apply Nat.succ_lt_mono; apply H0 ] ] ]. Qed. Lemma SubEqui_P5 : forall (a b:R) (del:posreal) (h:a < b), length (SubEqui del h) = S (S (max_N del h)). Proof. intros; unfold SubEqui; apply SubEqui_P3. Qed. Lemma SubEqui_P6 : forall (a b:R) (del:posreal) (h:a < b) (i:nat), (i < S (max_N del h))%nat -> pos_Rl (SubEqui del h) i = a + INR i * del. Proof. intros; unfold SubEqui; apply SubEqui_P4; assumption. Qed. Lemma SubEqui_P7 : forall (a b:R) (del:posreal) (h:a < b), ordered_Rlist (SubEqui del h). Proof. intros; unfold ordered_Rlist; intros; rewrite SubEqui_P5 in H; simpl in H; inversion H. { rewrite (SubEqui_P6 del h (i:=(max_N del h))). { replace (S (max_N del h)) with (pred (length (SubEqui del h))). { rewrite SubEqui_P2; unfold max_N; case (maxN del h) as (?&?&?); left; assumption. } rewrite SubEqui_P5; reflexivity. } apply Nat.lt_succ_diag_r. } repeat rewrite SubEqui_P6. 3: assumption. 2: apply Nat.lt_succ_r; assumption. apply Rplus_le_compat_l; rewrite S_INR; rewrite Rmult_plus_distr_r; pattern (INR i * del) at 1; rewrite <- Rplus_0_r; apply Rplus_le_compat_l; rewrite Rmult_1_l; left; apply (cond_pos del). Qed. Lemma SubEqui_P8 : forall (a b:R) (del:posreal) (h:a < b) (i:nat), (i < length (SubEqui del h))%nat -> a <= pos_Rl (SubEqui del h) i <= b. Proof. intros; split. { pattern a at 1; rewrite <- (SubEqui_P1 del h); apply RList_P5. { apply SubEqui_P7. } elim (RList_P3 (SubEqui del h) (pos_Rl (SubEqui del h) i)); intros; apply H1; exists i; split; [ reflexivity | assumption ]. } pattern b at 2; rewrite <- (SubEqui_P2 del h); apply RList_P7; [ apply SubEqui_P7 | elim (RList_P3 (SubEqui del h) (pos_Rl (SubEqui del h) i)); intros; apply H1; exists i; split; [ reflexivity | assumption ] ]. Qed. Lemma SubEqui_P9 : forall (a b:R) (del:posreal) (f:R -> R) (h:a < b), { g:StepFun a b | g b = f b /\ (forall i:nat, (i < pred (length (SubEqui del h)))%nat -> constant_D_eq g (co_interval (pos_Rl (SubEqui del h) i) (pos_Rl (SubEqui del h) (S i))) (f (pos_Rl (SubEqui del h) i))) }. Proof. intros; apply StepFun_P38; [ apply SubEqui_P7 | apply SubEqui_P1 | apply SubEqui_P2 ]. Qed. Lemma RiemannInt_P6 : forall (f:R -> R) (a b:R), a < b -> (forall x:R, a <= x <= b -> continuity_pt f x) -> Riemann_integrable f a b. Proof. intros; unfold Riemann_integrable; intro; assert (H1 : 0 < eps / (2 * (b - a))). { unfold Rdiv; apply Rmult_lt_0_compat; [ apply (cond_pos eps) | apply Rinv_0_lt_compat; apply Rmult_lt_0_compat; [ prove_sup0 | apply Rlt_0_minus; assumption ] ]. } assert (H2 : Rmin a b = a). { apply Rlt_le in H. unfold Rmin; decide (Rle_dec a b) with H; reflexivity. } assert (H3 : Rmax a b = b). { apply Rlt_le in H. unfold Rmax; decide (Rle_dec a b) with H; reflexivity. } elim (Heine_cor2 H0 (mkposreal _ H1)); intros del H4; elim (SubEqui_P9 del f H); intros phi [H5 H6]; split with phi; split with (mkStepFun (StepFun_P4 a b (eps / (2 * (b - a))))); split. 2: rewrite StepFun_P18; unfold Rdiv; rewrite Rinv_mult. 2: do 2 rewrite Rmult_assoc; rewrite Rinv_l. 2: rewrite Rmult_1_r; rewrite Rabs_right. 2: apply Rmult_lt_reg_l with 2. 2: prove_sup0. 2: rewrite <- (Rmult_comm (/ 2)); rewrite <- Rmult_assoc; rewrite Rinv_r. 2: rewrite Rmult_1_l; pattern (pos eps) at 1; rewrite <- Rplus_0_r; rewrite <-Rplus_diag; apply Rplus_lt_compat_l; apply (cond_pos eps). 2: discrR. 2: apply Rle_ge; left; apply Rmult_lt_0_compat. 2: apply (cond_pos eps). 2: apply Rinv_0_lt_compat; prove_sup0. 2: apply Rminus_eq_contra; red; intro; clear H6; rewrite H7 in H; elim (Rlt_irrefl _ H). intros; rewrite H2 in H7; rewrite H3 in H7; simpl; unfold fct_cte; cut (forall t:R, a <= t <= b -> t = b \/ (exists i : nat, (i < pred (length (SubEqui del H)))%nat /\ co_interval (pos_Rl (SubEqui del H) i) (pos_Rl (SubEqui del H) (S i)) t)). { intro; elim (H8 _ H7); intro. { rewrite H9; rewrite H5; unfold Rminus; rewrite Rplus_opp_r; rewrite Rabs_R0; left; assumption. } elim H9; clear H9; intros I [H9 H10]; assert (H11 := H6 I H9 t H10); rewrite H11; left; apply H4. - assumption. - apply SubEqui_P8; apply Nat.lt_trans with (pred (length (SubEqui del H))). { assumption. } apply Nat.lt_pred_l; red; intro; rewrite H12 in H9; elim (Nat.nlt_0_r _ H9). - unfold co_interval in H10; elim H10; clear H10; intros; rewrite Rabs_right. { rewrite SubEqui_P5 in H9; simpl in H9; inversion H9. { apply Rplus_lt_reg_l with (pos_Rl (SubEqui del H) (max_N del H)). replace (pos_Rl (SubEqui del H) (max_N del H) + (t - pos_Rl (SubEqui del H) (max_N del H))) with t; [ idtac | ring ]; apply Rlt_le_trans with b. { rewrite H14 in H12; assert (H13 : S (max_N del H) = pred (length (SubEqui del H))). { rewrite SubEqui_P5; reflexivity. } rewrite H13 in H12; rewrite SubEqui_P2 in H12; apply H12. } rewrite SubEqui_P6. 2: apply Nat.lt_succ_diag_r. unfold max_N; destruct (maxN del H) as (?&?&H13); replace (a + INR x * del + del) with (a + INR (S x) * del); [ assumption | rewrite S_INR; ring ]. } apply Rplus_lt_reg_l with (pos_Rl (SubEqui del H) I); replace (pos_Rl (SubEqui del H) I + (t - pos_Rl (SubEqui del H) I)) with t; [ idtac | ring ]; replace (pos_Rl (SubEqui del H) I + del) with (pos_Rl (SubEqui del H) (S I)). { assumption. } repeat rewrite SubEqui_P6. - rewrite S_INR; ring. - assumption. - apply Nat.lt_succ_r; assumption. } apply Rge_minus; apply Rle_ge; assumption. } intros; clear H0 H1 H4 phi H5 H6 t H7; case (Req_dec t0 b); intro. { left; assumption. } right; set (I := fun j:nat => a + INR j * del <= t0); assert (H1 : exists n : nat, I n). { exists 0%nat; unfold I; rewrite Rmult_0_l; rewrite Rplus_0_r; elim H8; intros; assumption. } assert (H4 : Nbound I). { unfold Nbound; exists (S (max_N del H)); intros; unfold max_N; destruct (maxN del H) as (?&_&H5); apply INR_le; apply Rmult_le_reg_l with (pos del). { apply (cond_pos del). } apply Rplus_le_reg_l with a; do 2 rewrite (Rmult_comm del); apply Rle_trans with t0; unfold I in H4; try assumption; apply Rle_trans with b; try assumption; elim H8; intros; assumption. } elim (Nzorn H1 H4); intros N [H5 H6]; assert (H7 : (N < S (max_N del H))%nat). { unfold max_N; case (maxN del H) as (?&?&?); apply INR_lt; apply Rmult_lt_reg_l with (pos del). { apply (cond_pos del). } apply Rplus_lt_reg_l with a; do 2 rewrite (Rmult_comm del); apply Rle_lt_trans with t0; unfold I in H5; try assumption; apply Rlt_le_trans with b; try assumption; elim H8; intros. elim H11; intro. { assumption. } elim H0; assumption. } exists N; split. { rewrite SubEqui_P5; simpl; assumption. } unfold co_interval; split. { rewrite SubEqui_P6. { apply H5. } assumption. } inversion H7. { replace (S (max_N del H)) with (pred (length (SubEqui del H))). { rewrite (SubEqui_P2 del H); elim H8; intros. elim H11; intro. { assumption. } elim H0; assumption. } rewrite SubEqui_P5; reflexivity. } rewrite SubEqui_P6. { destruct (Rle_dec (a + INR (S N) * del) t0) as [Hle|Hnle]. { assert (H11 := H6 (S N) Hle); elim (Nat.nle_succ_diag_l _ H11). } auto with real. } apply Nat.lt_succ_r; assumption. Qed. Lemma RiemannInt_P7 : forall (f:R -> R) (a:R), Riemann_integrable f a a. Proof. unfold Riemann_integrable; intro f; intros; split with (mkStepFun (StepFun_P4 a a (f a))); split with (mkStepFun (StepFun_P4 a a 0)); split. - intros; simpl; unfold fct_cte; replace t with a. + unfold Rminus; rewrite Rplus_opp_r; rewrite Rabs_R0; right; reflexivity. + generalize H; unfold Rmin, Rmax; decide (Rle_dec a a) with (Rle_refl a). intros (?,?); apply Rle_antisym; assumption. - rewrite StepFun_P18; rewrite Rmult_0_l; rewrite Rabs_R0; apply (cond_pos eps). Qed. Lemma continuity_implies_RiemannInt : forall (f:R -> R) (a b:R), a <= b -> (forall x:R, a <= x <= b -> continuity_pt f x) -> Riemann_integrable f a b. Proof. intros; destruct (total_order_T a b) as [[Hlt| -> ]|Hgt]; [ apply RiemannInt_P6; assumption | apply RiemannInt_P7 | elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H Hgt)) ]. Qed. Lemma RiemannInt_P8 : forall (f:R -> R) (a b:R) (pr1:Riemann_integrable f a b) (pr2:Riemann_integrable f b a), RiemannInt pr1 = - RiemannInt pr2. Proof. intro f; intros; eapply UL_sequence. { unfold RiemannInt; destruct (RiemannInt_exists pr1 RinvN RinvN_cv) as (?,HUn); apply HUn. } unfold RiemannInt; destruct (RiemannInt_exists pr2 RinvN RinvN_cv) as (?,HUn); intros; cut (exists psi1 : nat -> StepFun a b, (forall n:nat, (forall t:R, Rmin a b <= t /\ t <= Rmax a b -> Rabs (f t - phi_sequence RinvN pr1 n t) <= psi1 n t) /\ Rabs (RiemannInt_SF (psi1 n)) < RinvN n)). 2:{ split with (fun n:nat => proj1_sig (phi_sequence_prop RinvN pr1 n)); intro; apply (proj2_sig (phi_sequence_prop RinvN pr1 n)). } cut (exists psi2 : nat -> StepFun b a, (forall n:nat, (forall t:R, Rmin a b <= t /\ t <= Rmax a b -> Rabs (f t - phi_sequence RinvN pr2 n t) <= psi2 n t) /\ Rabs (RiemannInt_SF (psi2 n)) < RinvN n)). 2:{ split with (fun n:nat => proj1_sig (phi_sequence_prop RinvN pr2 n)); intro; rewrite Rmin_comm; rewrite RmaxSym; apply (proj2_sig (phi_sequence_prop RinvN pr2 n)). } intros; elim H; clear H; intros psi2 H; elim H0; clear H0; intros psi1 H0; assert (H1 := RinvN_cv); unfold Un_cv; intros; assert (H3 : 0 < eps / 3). { unfold Rdiv; apply Rmult_lt_0_compat; [ assumption | apply Rinv_0_lt_compat; prove_sup0 ]. } unfold Un_cv in H1; elim (H1 _ H3); clear H1; intros N0 H1; unfold Rdist in H1; simpl in H1; assert (H4 : forall n:nat, (n >= N0)%nat -> RinvN n < eps / 3). { intros; assert (H5 := H1 _ H4); replace (pos (RinvN n)) with (Rabs (/ (INR n + 1) - 0)); [ assumption | unfold Rminus; rewrite Ropp_0; rewrite Rplus_0_r; apply Rabs_right; left; apply (cond_pos (RinvN n)) ]. } clear H1; destruct (HUn _ H3) as (N1,H1); exists (max N0 N1); intros; unfold Rdist; apply Rle_lt_trans with (Rabs (RiemannInt_SF (phi_sequence RinvN pr1 n) + RiemannInt_SF (phi_sequence RinvN pr2 n)) + Rabs (RiemannInt_SF (phi_sequence RinvN pr2 n) - x)). { rewrite <- (Rabs_Ropp (RiemannInt_SF (phi_sequence RinvN pr2 n) - x)); replace (RiemannInt_SF (phi_sequence RinvN pr1 n) - - x) with (RiemannInt_SF (phi_sequence RinvN pr1 n) + RiemannInt_SF (phi_sequence RinvN pr2 n) + - (RiemannInt_SF (phi_sequence RinvN pr2 n) - x)); [ apply Rabs_triang | ring ]. } replace eps with (2 * (eps / 3) + eps / 3) by lra. apply Rplus_lt_compat. 2:{ unfold Rdist in H1; apply H1; unfold ge; apply Nat.le_trans with (max N0 N1); [ apply Nat.le_max_r | assumption ]. } rewrite (StepFun_P39 (phi_sequence RinvN pr2 n)); replace (RiemannInt_SF (phi_sequence RinvN pr1 n) + - RiemannInt_SF (mkStepFun (StepFun_P6 (pre (phi_sequence RinvN pr2 n))))) with (RiemannInt_SF (phi_sequence RinvN pr1 n) + -1 * RiemannInt_SF (mkStepFun (StepFun_P6 (pre (phi_sequence RinvN pr2 n))))); [ idtac | ring ]; rewrite <- StepFun_P30. destruct (Rle_dec a b) as [Hle|Hnle]. { apply Rle_lt_trans with (RiemannInt_SF (mkStepFun (StepFun_P32 (mkStepFun (StepFun_P28 (-1) (phi_sequence RinvN pr1 n) (mkStepFun (StepFun_P6 (pre (phi_sequence RinvN pr2 n))))))))). { apply StepFun_P34; assumption. } apply Rle_lt_trans with (RiemannInt_SF (mkStepFun (StepFun_P28 1 (psi1 n) (mkStepFun (StepFun_P6 (pre (psi2 n))))))). { apply StepFun_P37; try assumption. intros; simpl; rewrite Rmult_1_l; apply Rle_trans with (Rabs (phi_sequence RinvN pr1 n x0 - f x0) + Rabs (f x0 - phi_sequence RinvN pr2 n x0)). { replace (phi_sequence RinvN pr1 n x0 + -1 * phi_sequence RinvN pr2 n x0) with (phi_sequence RinvN pr1 n x0 - f x0 + (f x0 - phi_sequence RinvN pr2 n x0)); [ apply Rabs_triang | ring ]. } assert (H7 : Rmin a b = a). { unfold Rmin; decide (Rle_dec a b) with Hle; reflexivity. } assert (H8 : Rmax a b = b). { unfold Rmax; decide (Rle_dec a b) with Hle; reflexivity. } apply Rplus_le_compat. { elim (H0 n); intros; rewrite <- Rabs_Ropp; rewrite Ropp_minus_distr; apply H9; rewrite H7; rewrite H8. elim H6; intros; split; left; assumption. } elim (H n); intros; apply H9; rewrite H7; rewrite H8. elim H6; intros; split; left; assumption. } rewrite StepFun_P30; rewrite Rmult_1_l; rewrite <-Rplus_diag; apply Rplus_lt_compat. { elim (H0 n); intros; apply Rle_lt_trans with (Rabs (RiemannInt_SF (psi1 n))); [ apply RRle_abs | apply Rlt_trans with (pos (RinvN n)); [ assumption | apply H4; unfold ge; apply Nat.le_trans with (max N0 N1); [ apply Nat.le_max_l | assumption ] ] ]. } elim (H n); intros; rewrite <- (Ropp_involutive (RiemannInt_SF (mkStepFun (StepFun_P6 (pre (psi2 n)))))) ; rewrite <- StepFun_P39; apply Rle_lt_trans with (Rabs (RiemannInt_SF (psi2 n))); [ rewrite <- Rabs_Ropp; apply RRle_abs | apply Rlt_trans with (pos (RinvN n)); [ assumption | apply H4; unfold ge; apply Nat.le_trans with (max N0 N1); [ apply Nat.le_max_l | assumption ] ] ]. } assert (Hyp : b <= a). { auto with real. } rewrite StepFun_P39; rewrite Rabs_Ropp; apply Rle_lt_trans with (RiemannInt_SF (mkStepFun (StepFun_P32 (mkStepFun (StepFun_P6 (StepFun_P28 (-1) (phi_sequence RinvN pr1 n) (mkStepFun (StepFun_P6 (pre (phi_sequence RinvN pr2 n)))))))))). { apply StepFun_P34; assumption. } apply Rle_lt_trans with (RiemannInt_SF (mkStepFun (StepFun_P28 1 (mkStepFun (StepFun_P6 (pre (psi1 n)))) (psi2 n)))). { apply StepFun_P37; try assumption. intros; simpl; rewrite Rmult_1_l; apply Rle_trans with (Rabs (phi_sequence RinvN pr1 n x0 - f x0) + Rabs (f x0 - phi_sequence RinvN pr2 n x0)). { replace (phi_sequence RinvN pr1 n x0 + -1 * phi_sequence RinvN pr2 n x0) with (phi_sequence RinvN pr1 n x0 - f x0 + (f x0 - phi_sequence RinvN pr2 n x0)); [ apply Rabs_triang | ring ]. } assert (H7 : Rmin a b = b). { unfold Rmin; decide (Rle_dec a b) with Hnle; reflexivity. } assert (H8 : Rmax a b = a). { unfold Rmax; decide (Rle_dec a b) with Hnle; reflexivity. } apply Rplus_le_compat. { elim (H0 n); intros; rewrite <- Rabs_Ropp; rewrite Ropp_minus_distr; apply H9; rewrite H7; rewrite H8. elim H6; intros; split; left; assumption. } elim (H n); intros; apply H9; rewrite H7; rewrite H8; elim H6; intros; split; left; assumption. } rewrite StepFun_P30; rewrite Rmult_1_l; rewrite <-Rplus_diag; apply Rplus_lt_compat. { elim (H0 n); intros; rewrite <- (Ropp_involutive (RiemannInt_SF (mkStepFun (StepFun_P6 (pre (psi1 n)))))) ; rewrite <- StepFun_P39; apply Rle_lt_trans with (Rabs (RiemannInt_SF (psi1 n))); [ rewrite <- Rabs_Ropp; apply RRle_abs | apply Rlt_trans with (pos (RinvN n)); [ assumption | apply H4; unfold ge; apply Nat.le_trans with (max N0 N1); [ apply Nat.le_max_l | assumption ] ] ]. } elim (H n); intros; apply Rle_lt_trans with (Rabs (RiemannInt_SF (psi2 n))); [ apply RRle_abs | apply Rlt_trans with (pos (RinvN n)); [ assumption | apply H4; unfold ge; apply Nat.le_trans with (max N0 N1); [ apply Nat.le_max_l | assumption ] ] ]. Qed. Lemma RiemannInt_P9 : forall (f:R -> R) (a:R) (pr:Riemann_integrable f a a), RiemannInt pr = 0. Proof. intros; assert (H := RiemannInt_P8 pr pr); apply Rmult_eq_reg_l with 2; [ rewrite Rmult_0_r; rewrite <-Rplus_diag; pattern (RiemannInt pr) at 2; rewrite H; apply Rplus_opp_r | discrR ]. Qed. (* L1([a,b]) is a vectorial space *) Lemma RiemannInt_P10 : forall (f g:R -> R) (a b l:R), Riemann_integrable f a b -> Riemann_integrable g a b -> Riemann_integrable (fun x:R => f x + l * g x) a b. Proof. unfold Riemann_integrable; intros f g; intros; destruct (Req_dec_T l 0) as [Heq|Hneq]. { elim (X eps); intros x p; split with x; elim p; intros x0 p0; split with x0; elim p0; intros; split; try assumption; rewrite Heq; intros; rewrite Rmult_0_l; rewrite Rplus_0_r; apply H; assumption. } assert (H : 0 < eps / 2). { unfold Rdiv; apply Rmult_lt_0_compat; [ apply (cond_pos eps) | apply Rinv_0_lt_compat; prove_sup0 ]. } assert (H0 : 0 < eps / (2 * Rabs l)). { unfold Rdiv; apply Rmult_lt_0_compat; [ apply (cond_pos eps) | apply Rinv_0_lt_compat; apply Rmult_lt_0_compat; [ prove_sup0 | apply Rabs_pos_lt; assumption ] ]. } elim (X (mkposreal _ H)); intros x p; elim (X0 (mkposreal _ H0)); intros x0 p0; split with (mkStepFun (StepFun_P28 l x x0)); elim p0; elim p; intros x1 p1 x2 p2. split with (mkStepFun (StepFun_P28 (Rabs l) x1 x2)); elim p1; elim p2; clear p1 p2 p0 p X X0; intros; split. { intros; simpl; apply Rle_trans with (Rabs (f t - x t) + Rabs (l * (g t - x0 t))). { replace (f t + l * g t - (x t + l * x0 t)) with (f t - x t + l * (g t - x0 t)); [ apply Rabs_triang | ring ]. } apply Rplus_le_compat; [ apply H3; assumption | rewrite Rabs_mult; apply Rmult_le_compat_l; [ apply Rabs_pos | apply H1; assumption ] ]. } rewrite StepFun_P30; apply Rle_lt_trans with (Rabs (RiemannInt_SF x1) + Rabs (Rabs l * RiemannInt_SF x2)). { apply Rabs_triang. } rewrite <-(Rplus_half_diag eps); apply Rplus_lt_compat. { apply H4. } rewrite Rabs_mult; rewrite Rabs_Rabsolu; apply Rmult_lt_reg_l with (/ Rabs l). { apply Rinv_0_lt_compat; apply Rabs_pos_lt; assumption. } rewrite <- Rmult_assoc; rewrite Rinv_l; [ rewrite Rmult_1_l; replace (/ Rabs l * (eps / 2)) with (eps / (2 * Rabs l)); [ apply H2 | unfold Rdiv; rewrite Rinv_mult; ring ] | apply Rabs_no_R0; assumption ]. Qed. Lemma RiemannInt_P11 : forall (f:R -> R) (a b l:R) (un:nat -> posreal) (phi1 phi2 psi1 psi2:nat -> StepFun a b), Un_cv un 0 -> (forall n:nat, (forall t:R, Rmin a b <= t <= Rmax a b -> Rabs (f t - phi1 n t) <= psi1 n t) /\ Rabs (RiemannInt_SF (psi1 n)) < un n) -> (forall n:nat, (forall t:R, Rmin a b <= t <= Rmax a b -> Rabs (f t - phi2 n t) <= psi2 n t) /\ Rabs (RiemannInt_SF (psi2 n)) < un n) -> Un_cv (fun N:nat => RiemannInt_SF (phi1 N)) l -> Un_cv (fun N:nat => RiemannInt_SF (phi2 N)) l. Proof. unfold Un_cv; intro f; intros; intros. case (Rle_dec a b); intro Hyp. - assert (H4 : 0 < eps / 3) by lra. elim (H _ H4); clear H; intros N0 H. elim (H2 _ H4); clear H2; intros N1 H2. set (N := max N0 N1); exists N; intros; unfold Rdist. apply Rle_lt_trans with (Rabs (RiemannInt_SF (phi2 n) - RiemannInt_SF (phi1 n)) + Rabs (RiemannInt_SF (phi1 n) - l)). { replace (RiemannInt_SF (phi2 n) - l) with (RiemannInt_SF (phi2 n) - RiemannInt_SF (phi1 n) + (RiemannInt_SF (phi1 n) - l)); [ apply Rabs_triang | ring ]. } replace eps with (2 * (eps / 3) + eps / 3) by lra. apply Rplus_lt_compat. 2:{ unfold Rdist in H2; apply H2; unfold ge; apply Nat.le_trans with N; try assumption; unfold N; apply Nat.le_max_r. } replace (RiemannInt_SF (phi2 n) - RiemannInt_SF (phi1 n)) with (RiemannInt_SF (phi2 n) + -1 * RiemannInt_SF (phi1 n)); [ idtac | ring ]. rewrite <- StepFun_P30. apply Rle_lt_trans with (RiemannInt_SF (mkStepFun (StepFun_P32 (mkStepFun (StepFun_P28 (-1) (phi2 n) (phi1 n)))))). { apply StepFun_P34; assumption. } apply Rle_lt_trans with (RiemannInt_SF (mkStepFun (StepFun_P28 1 (psi1 n) (psi2 n)))). { apply StepFun_P37; try assumption; intros; simpl; rewrite Rmult_1_l. apply Rle_trans with (Rabs (phi2 n x - f x) + Rabs (f x - phi1 n x)). { replace (phi2 n x + -1 * phi1 n x) with (phi2 n x - f x + (f x - phi1 n x)); [ apply Rabs_triang | ring ]. } rewrite (Rplus_comm (psi1 n x)); apply Rplus_le_compat. { rewrite <- Rabs_Ropp; rewrite Ropp_minus_distr; elim (H1 n); intros; apply H7. assert (H10 : Rmin a b = a). { unfold Rmin; decide (Rle_dec a b) with Hyp; reflexivity. } assert (H11 : Rmax a b = b). { unfold Rmax; decide (Rle_dec a b) with Hyp; reflexivity. } rewrite H10; rewrite H11; elim H6; intros; split; left; assumption. } elim (H0 n); intros; apply H7; assert (H10 : Rmin a b = a). { unfold Rmin; decide (Rle_dec a b) with Hyp; reflexivity. } assert (H11 : Rmax a b = b). { unfold Rmax; decide (Rle_dec a b) with Hyp; reflexivity. } rewrite H10; rewrite H11; elim H6; intros; split; left; assumption. } rewrite StepFun_P30; rewrite Rmult_1_l; rewrite <-Rplus_diag; apply Rplus_lt_compat. { apply Rlt_trans with (pos (un n)). { elim (H0 n); intros; apply Rle_lt_trans with (Rabs (RiemannInt_SF (psi1 n))). { apply RRle_abs. } assumption. } replace (pos (un n)) with (Rdist (un n) 0). { apply H; unfold ge; apply Nat.le_trans with N; try assumption. unfold N; apply Nat.le_max_l. } unfold Rdist; unfold Rminus; rewrite Ropp_0; rewrite Rplus_0_r; apply Rabs_right. apply Rle_ge; left; apply (cond_pos (un n)). } apply Rlt_trans with (pos (un n)). { elim (H1 n); intros; apply Rle_lt_trans with (Rabs (RiemannInt_SF (psi2 n))). { apply RRle_abs; assumption. } assumption. } replace (pos (un n)) with (Rdist (un n) 0). { apply H; unfold ge; apply Nat.le_trans with N; try assumption; unfold N; apply Nat.le_max_l. } unfold Rdist; unfold Rminus; rewrite Ropp_0; rewrite Rplus_0_r; apply Rabs_right; apply Rle_ge; left; apply (cond_pos (un n)). - assert (H4 : 0 < eps / 3) by lra. elim (H _ H4); clear H; intros N0 H. elim (H2 _ H4); clear H2; intros N1 H2. set (N := max N0 N1); exists N; intros; unfold Rdist. apply Rle_lt_trans with (Rabs (RiemannInt_SF (phi2 n) - RiemannInt_SF (phi1 n)) + Rabs (RiemannInt_SF (phi1 n) - l)). { replace (RiemannInt_SF (phi2 n) - l) with (RiemannInt_SF (phi2 n) - RiemannInt_SF (phi1 n) + (RiemannInt_SF (phi1 n) - l)); [ apply Rabs_triang | ring ]. } assert (Hyp_b : b <= a). { auto with real. } replace eps with (2 * (eps / 3) + eps / 3) by lra. apply Rplus_lt_compat. 2:{ unfold Rdist in H2; apply H2; unfold ge; apply Nat.le_trans with N; try assumption; unfold N; apply Nat.le_max_r. } replace (RiemannInt_SF (phi2 n) - RiemannInt_SF (phi1 n)) with (RiemannInt_SF (phi2 n) + -1 * RiemannInt_SF (phi1 n)); [ idtac | ring ]. rewrite <- StepFun_P30. rewrite StepFun_P39. rewrite Rabs_Ropp. apply Rle_lt_trans with (RiemannInt_SF (mkStepFun (StepFun_P32 (mkStepFun (StepFun_P6 (pre (mkStepFun (StepFun_P28 (-1) (phi2 n) (phi1 n))))))))). { apply StepFun_P34; try assumption. } apply Rle_lt_trans with (RiemannInt_SF (mkStepFun (StepFun_P6 (pre (mkStepFun (StepFun_P28 1 (psi1 n) (psi2 n))))))). { apply StepFun_P37; try assumption. intros; simpl; rewrite Rmult_1_l. apply Rle_trans with (Rabs (phi2 n x - f x) + Rabs (f x - phi1 n x)). { replace (phi2 n x + -1 * phi1 n x) with (phi2 n x - f x + (f x - phi1 n x)); [ apply Rabs_triang | ring ]. } rewrite (Rplus_comm (psi1 n x)); apply Rplus_le_compat. { rewrite <- Rabs_Ropp; rewrite Ropp_minus_distr; elim (H1 n); intros; apply H7. assert (H10 : Rmin a b = b). { unfold Rmin; case (Rle_dec a b); intro; [ elim Hyp; assumption | reflexivity ]. } assert (H11 : Rmax a b = a). { unfold Rmax; case (Rle_dec a b); intro; [ elim Hyp; assumption | reflexivity ]. } rewrite H10; rewrite H11; elim H6; intros; split; left; assumption. } elim (H0 n); intros; apply H7; assert (H10 : Rmin a b = b). { unfold Rmin; case (Rle_dec a b); intro; [ elim Hyp; assumption | reflexivity ]. } assert (H11 : Rmax a b = a). { unfold Rmax; case (Rle_dec a b); intro; [ elim Hyp; assumption | reflexivity ]. } rewrite H10; rewrite H11; elim H6; intros; split; left; assumption. } rewrite <- (Ropp_involutive (RiemannInt_SF (mkStepFun (StepFun_P6 (pre (mkStepFun (StepFun_P28 1 (psi1 n) (psi2 n)))))))). rewrite <- StepFun_P39. rewrite StepFun_P30. rewrite Rmult_1_l; rewrite <-Rplus_diag. rewrite Ropp_plus_distr; apply Rplus_lt_compat. { apply Rlt_trans with (pos (un n)). { elim (H0 n); intros; apply Rle_lt_trans with (Rabs (RiemannInt_SF (psi1 n))). { rewrite <- Rabs_Ropp; apply RRle_abs. } assumption. } replace (pos (un n)) with (Rdist (un n) 0). { apply H; unfold ge; apply Nat.le_trans with N; try assumption. unfold N; apply Nat.le_max_l. } unfold Rdist; unfold Rminus; rewrite Ropp_0; rewrite Rplus_0_r; apply Rabs_right. apply Rle_ge; left; apply (cond_pos (un n)). } apply Rlt_trans with (pos (un n)). { elim (H1 n); intros; apply Rle_lt_trans with (Rabs (RiemannInt_SF (psi2 n))). { rewrite <- Rabs_Ropp; apply RRle_abs; assumption. } assumption. } replace (pos (un n)) with (Rdist (un n) 0). { apply H; unfold ge; apply Nat.le_trans with N; try assumption; unfold N; apply Nat.le_max_l. } unfold Rdist; unfold Rminus; rewrite Ropp_0; rewrite Rplus_0_r; apply Rabs_right; apply Rle_ge; left; apply (cond_pos (un n)). Qed. Lemma RiemannInt_P12 : forall (f g:R -> R) (a b l:R) (pr1:Riemann_integrable f a b) (pr2:Riemann_integrable g a b) (pr3:Riemann_integrable (fun x:R => f x + l * g x) a b), a <= b -> RiemannInt pr3 = RiemannInt pr1 + l * RiemannInt pr2. Proof. intro f; intros; case (Req_dec l 0); intro. { pattern l at 2; rewrite H0; rewrite Rmult_0_l; rewrite Rplus_0_r; unfold RiemannInt; destruct (RiemannInt_exists pr3 RinvN RinvN_cv) as (?,HUn_cv); destruct (RiemannInt_exists pr1 RinvN RinvN_cv) as (?,HUn_cv0); intros. eapply UL_sequence; [ apply HUn_cv | set (psi1 := fun n:nat => proj1_sig (phi_sequence_prop RinvN pr1 n)); set (psi2 := fun n:nat => proj1_sig (phi_sequence_prop RinvN pr3 n)); apply RiemannInt_P11 with f RinvN (phi_sequence RinvN pr1) psi1 psi2; [ apply RinvN_cv | intro; apply (proj2_sig (phi_sequence_prop RinvN pr1 n)) | intro; assert (H1 : (forall t:R, Rmin a b <= t /\ t <= Rmax a b -> Rabs (f t + l * g t - phi_sequence RinvN pr3 n t) <= psi2 n t) /\ Rabs (RiemannInt_SF (psi2 n)) < RinvN n); [ apply (proj2_sig (phi_sequence_prop RinvN pr3 n)) | elim H1; intros; split; try assumption; intros; replace (f t) with (f t + l * g t); [ apply H2; assumption | rewrite H0; ring ] ] | assumption ] ]. } eapply UL_sequence. { unfold RiemannInt; destruct (RiemannInt_exists pr3 RinvN RinvN_cv) as (?,HUn_cv); intros; apply HUn_cv. } unfold Un_cv; intros; unfold RiemannInt; case (RiemannInt_exists pr1 RinvN RinvN_cv) as (x0,HUn_cv0); case (RiemannInt_exists pr2 RinvN RinvN_cv) as (x,HUn_cv); unfold Un_cv; intros; assert (H2 : 0 < eps / 5). { unfold Rdiv; apply Rmult_lt_0_compat; [ assumption | apply Rinv_0_lt_compat; prove_sup0 ]. } elim (HUn_cv0 _ H2); clear HUn_cv0; intros N0 H3; assert (H4 := RinvN_cv); unfold Un_cv in H4; elim (H4 _ H2); clear H4 H2; intros N1 H4; assert (H5 : 0 < eps / (5 * Rabs l)). { unfold Rdiv; apply Rmult_lt_0_compat; [ assumption | apply Rinv_0_lt_compat; apply Rmult_lt_0_compat; [ prove_sup0 | apply Rabs_pos_lt; assumption ] ]. } elim (HUn_cv _ H5); clear HUn_cv; intros N2 H6; assert (H7 := RinvN_cv); unfold Un_cv in H7; elim (H7 _ H5); clear H7 H5; intros N3 H5; unfold Rdist in H3, H4, H5, H6; set (N := max (max N0 N1) (max N2 N3)). assert (H7 : forall n:nat, (n >= N1)%nat -> RinvN n < eps / 5). { intros; replace (pos (RinvN n)) with (Rabs (RinvN n - 0)); [ unfold RinvN; apply H4; assumption | unfold Rminus; rewrite Ropp_0; rewrite Rplus_0_r; apply Rabs_right; left; apply (cond_pos (RinvN n)) ]. } clear H4; assert (H4 := H7); clear H7; assert (H7 : forall n:nat, (n >= N3)%nat -> RinvN n < eps / (5 * Rabs l)). { intros; replace (pos (RinvN n)) with (Rabs (RinvN n - 0)); [ unfold RinvN; apply H5; assumption | unfold Rminus; rewrite Ropp_0; rewrite Rplus_0_r; apply Rabs_right; left; apply (cond_pos (RinvN n)) ]. } clear H5; assert (H5 := H7); clear H7; exists N; intros; unfold Rdist. apply Rle_lt_trans with (Rabs (RiemannInt_SF (phi_sequence RinvN pr3 n) - (RiemannInt_SF (phi_sequence RinvN pr1 n) + l * RiemannInt_SF (phi_sequence RinvN pr2 n))) + Rabs (RiemannInt_SF (phi_sequence RinvN pr1 n) - x0) + Rabs l * Rabs (RiemannInt_SF (phi_sequence RinvN pr2 n) - x)). { apply Rle_trans with (Rabs (RiemannInt_SF (phi_sequence RinvN pr3 n) - (RiemannInt_SF (phi_sequence RinvN pr1 n) + l * RiemannInt_SF (phi_sequence RinvN pr2 n))) + Rabs (RiemannInt_SF (phi_sequence RinvN pr1 n) - x0 + l * (RiemannInt_SF (phi_sequence RinvN pr2 n) - x))). { replace (RiemannInt_SF (phi_sequence RinvN pr3 n) - (x0 + l * x)) with (RiemannInt_SF (phi_sequence RinvN pr3 n) - (RiemannInt_SF (phi_sequence RinvN pr1 n) + l * RiemannInt_SF (phi_sequence RinvN pr2 n)) + (RiemannInt_SF (phi_sequence RinvN pr1 n) - x0 + l * (RiemannInt_SF (phi_sequence RinvN pr2 n) - x))); [ apply Rabs_triang | ring ]. } rewrite Rplus_assoc; apply Rplus_le_compat_l; rewrite <- Rabs_mult; replace (RiemannInt_SF (phi_sequence RinvN pr1 n) - x0 + l * (RiemannInt_SF (phi_sequence RinvN pr2 n) - x)) with (RiemannInt_SF (phi_sequence RinvN pr1 n) - x0 + l * (RiemannInt_SF (phi_sequence RinvN pr2 n) - x)); [ apply Rabs_triang | ring ]. } replace eps with (3 * (eps / 5) + eps / 5 + eps / 5) by lra. apply Rplus_lt_compat. 2:{ apply Rmult_lt_reg_l with (/ Rabs l). { apply Rinv_0_lt_compat; apply Rabs_pos_lt; assumption. } rewrite <- Rmult_assoc; rewrite Rinv_l. 2:apply Rabs_no_R0; assumption. rewrite Rmult_1_l; replace (/ Rabs l * (eps / 5)) with (eps / (5 * Rabs l)). { apply H6; unfold ge; apply Nat.le_trans with (max N2 N3); [ apply Nat.le_max_l | apply Nat.le_trans with N; [ unfold N; apply Nat.le_max_r | assumption ] ]. } unfold Rdiv; rewrite Rinv_mult; ring. } apply Rplus_lt_compat. 2:apply H3;Lia.lia. assert (H7 : exists psi1 : nat -> StepFun a b, (forall n:nat, (forall t:R, Rmin a b <= t /\ t <= Rmax a b -> Rabs (f t - phi_sequence RinvN pr1 n t) <= psi1 n t) /\ Rabs (RiemannInt_SF (psi1 n)) < RinvN n)). { split with (fun n:nat => proj1_sig (phi_sequence_prop RinvN pr1 n)); intro; apply (proj2_sig (phi_sequence_prop RinvN pr1 n0)). } assert (H8 : exists psi2 : nat -> StepFun a b, (forall n:nat, (forall t:R, Rmin a b <= t /\ t <= Rmax a b -> Rabs (g t - phi_sequence RinvN pr2 n t) <= psi2 n t) /\ Rabs (RiemannInt_SF (psi2 n)) < RinvN n)). { split with (fun n:nat => proj1_sig (phi_sequence_prop RinvN pr2 n)); intro; apply (proj2_sig (phi_sequence_prop RinvN pr2 n0)). } assert (H9 : exists psi3 : nat -> StepFun a b, (forall n:nat, (forall t:R, Rmin a b <= t /\ t <= Rmax a b -> Rabs (f t + l * g t - phi_sequence RinvN pr3 n t) <= psi3 n t) /\ Rabs (RiemannInt_SF (psi3 n)) < RinvN n)). { split with (fun n:nat => proj1_sig (phi_sequence_prop RinvN pr3 n)); intro; apply (proj2_sig (phi_sequence_prop RinvN pr3 n0)). } elim H7; clear H7; intros psi1 H7; elim H8; clear H8; intros psi2 H8; elim H9; clear H9; intros psi3 H9; replace (RiemannInt_SF (phi_sequence RinvN pr3 n) - (RiemannInt_SF (phi_sequence RinvN pr1 n) + l * RiemannInt_SF (phi_sequence RinvN pr2 n))) with (RiemannInt_SF (phi_sequence RinvN pr3 n) + -1 * (RiemannInt_SF (phi_sequence RinvN pr1 n) + l * RiemannInt_SF (phi_sequence RinvN pr2 n))); [ idtac | ring ]; do 2 rewrite <- StepFun_P30; assert (H10 : Rmin a b = a). { unfold Rmin; decide (Rle_dec a b) with H; reflexivity. } assert (H11 : Rmax a b = b). { unfold Rmax; decide (Rle_dec a b) with H; reflexivity. } rewrite H10 in H7; rewrite H10 in H8; rewrite H10 in H9; rewrite H11 in H7; rewrite H11 in H8; rewrite H11 in H9; apply Rle_lt_trans with (RiemannInt_SF (mkStepFun (StepFun_P32 (mkStepFun (StepFun_P28 (-1) (phi_sequence RinvN pr3 n) (mkStepFun (StepFun_P28 l (phi_sequence RinvN pr1 n) (phi_sequence RinvN pr2 n)))))))). { apply StepFun_P34; assumption. } apply Rle_lt_trans with (RiemannInt_SF (mkStepFun (StepFun_P28 1 (psi3 n) (mkStepFun (StepFun_P28 (Rabs l) (psi1 n) (psi2 n)))))). { apply StepFun_P37; try assumption. intros; simpl; rewrite Rmult_1_l. apply Rle_trans with (Rabs (phi_sequence RinvN pr3 n x1 - (f x1 + l * g x1)) + Rabs (f x1 + l * g x1 + -1 * (phi_sequence RinvN pr1 n x1 + l * phi_sequence RinvN pr2 n x1))). { replace (phi_sequence RinvN pr3 n x1 + -1 * (phi_sequence RinvN pr1 n x1 + l * phi_sequence RinvN pr2 n x1)) with (phi_sequence RinvN pr3 n x1 - (f x1 + l * g x1) + (f x1 + l * g x1 + -1 * (phi_sequence RinvN pr1 n x1 + l * phi_sequence RinvN pr2 n x1))); [ apply Rabs_triang | ring ]. } rewrite Rplus_assoc; apply Rplus_le_compat. { elim (H9 n); intros; rewrite <- Rabs_Ropp; rewrite Ropp_minus_distr; apply H13. elim H12; intros; split; left; assumption. } apply Rle_trans with (Rabs (f x1 - phi_sequence RinvN pr1 n x1) + Rabs l * Rabs (g x1 - phi_sequence RinvN pr2 n x1)). { rewrite <- Rabs_mult; replace (f x1 + (l * g x1 + -1 * (phi_sequence RinvN pr1 n x1 + l * phi_sequence RinvN pr2 n x1))) with (f x1 - phi_sequence RinvN pr1 n x1 + l * (g x1 - phi_sequence RinvN pr2 n x1)); [ apply Rabs_triang | ring ]. } apply Rplus_le_compat. { elim (H7 n); intros; apply H13. elim H12; intros; split; left; assumption. } apply Rmult_le_compat_l; [ apply Rabs_pos | elim (H8 n); intros; apply H13; elim H12; intros; split; left; assumption ]. } do 2 rewrite StepFun_P30; rewrite Rmult_1_l; replace (3 * (eps / 5)) with (eps / 5 + (eps / 5 + eps / 5)) by ring. repeat apply Rplus_lt_compat. - apply Rlt_trans with (pos (RinvN n)); [ apply Rle_lt_trans with (Rabs (RiemannInt_SF (psi3 n))); [ apply RRle_abs | elim (H9 n); intros; assumption ] | apply H4; unfold ge; apply Nat.le_trans with N; [ apply Nat.le_trans with (max N0 N1); [ apply Nat.le_max_r | unfold N; apply Nat.le_max_l ] | assumption ] ]. - apply Rlt_trans with (pos (RinvN n)); [ apply Rle_lt_trans with (Rabs (RiemannInt_SF (psi1 n))); [ apply RRle_abs | elim (H7 n); intros; assumption ] | apply H4; unfold ge; apply Nat.le_trans with N; [ apply Nat.le_trans with (max N0 N1); [ apply Nat.le_max_r | unfold N; apply Nat.le_max_l ] | assumption ] ]. - apply Rmult_lt_reg_l with (/ Rabs l). { apply Rinv_0_lt_compat; apply Rabs_pos_lt; assumption. } rewrite <- Rmult_assoc; rewrite Rinv_l. { rewrite Rmult_1_l; replace (/ Rabs l * (eps / 5)) with (eps / (5 * Rabs l)). { apply Rlt_trans with (pos (RinvN n)); [ apply Rle_lt_trans with (Rabs (RiemannInt_SF (psi2 n))); [ apply RRle_abs | elim (H8 n); intros; assumption ] | apply H5; unfold ge; apply Nat.le_trans with N; [ apply Nat.le_trans with (max N2 N3); [ apply Nat.le_max_r | unfold N; apply Nat.le_max_r ] | assumption ] ]. } unfold Rdiv; rewrite Rinv_mult; ring. } apply Rabs_no_R0; assumption. Qed. Lemma RiemannInt_P13 : forall (f g:R -> R) (a b l:R) (pr1:Riemann_integrable f a b) (pr2:Riemann_integrable g a b) (pr3:Riemann_integrable (fun x:R => f x + l * g x) a b), RiemannInt pr3 = RiemannInt pr1 + l * RiemannInt pr2. Proof. intros; destruct (Rle_dec a b) as [Hle|Hnle]; [ apply RiemannInt_P12; assumption | assert (H : b <= a); [ auto with real | replace (RiemannInt pr3) with (- RiemannInt (RiemannInt_P1 pr3)); [ idtac | symmetry ; apply RiemannInt_P8 ]; replace (RiemannInt pr2) with (- RiemannInt (RiemannInt_P1 pr2)); [ idtac | symmetry ; apply RiemannInt_P8 ]; replace (RiemannInt pr1) with (- RiemannInt (RiemannInt_P1 pr1)); [ idtac | symmetry ; apply RiemannInt_P8 ]; rewrite (RiemannInt_P12 (RiemannInt_P1 pr1) (RiemannInt_P1 pr2) (RiemannInt_P1 pr3) H); ring ] ]. Qed. Lemma RiemannInt_P14 : forall a b c:R, Riemann_integrable (fct_cte c) a b. Proof. unfold Riemann_integrable; intros; split with (mkStepFun (StepFun_P4 a b c)); split with (mkStepFun (StepFun_P4 a b 0)); split; [ intros; simpl; unfold Rminus; rewrite Rplus_opp_r; rewrite Rabs_R0; unfold fct_cte; right; reflexivity | rewrite StepFun_P18; rewrite Rmult_0_l; rewrite Rabs_R0; apply (cond_pos eps) ]. Qed. Lemma RiemannInt_P15 : forall (a b c:R) (pr:Riemann_integrable (fct_cte c) a b), RiemannInt pr = c * (b - a). Proof. intros; unfold RiemannInt; destruct (RiemannInt_exists pr RinvN RinvN_cv) as (?,HUn_cv); intros; eapply UL_sequence. { apply HUn_cv. } set (phi1 := fun N:nat => phi_sequence RinvN pr N); change (Un_cv (fun N:nat => RiemannInt_SF (phi1 N)) (c * (b - a))); set (f := fct_cte c); assert (H1 : exists psi1 : nat -> StepFun a b, (forall n:nat, (forall t:R, Rmin a b <= t /\ t <= Rmax a b -> Rabs (f t - phi_sequence RinvN pr n t) <= psi1 n t) /\ Rabs (RiemannInt_SF (psi1 n)) < RinvN n)). { split with (fun n:nat => proj1_sig (phi_sequence_prop RinvN pr n)); intro; apply (proj2_sig (phi_sequence_prop RinvN pr n)). } elim H1; clear H1; intros psi1 H1; set (phi2 := fun n:nat => mkStepFun (StepFun_P4 a b c)); set (psi2 := fun n:nat => mkStepFun (StepFun_P4 a b 0)); apply RiemannInt_P11 with f RinvN phi2 psi2 psi1. - apply RinvN_cv. - intro; split. { intros; unfold f; simpl; unfold Rminus; rewrite Rplus_opp_r; rewrite Rabs_R0; unfold fct_cte; right; reflexivity. } unfold psi2; rewrite StepFun_P18; rewrite Rmult_0_l; rewrite Rabs_R0; apply (cond_pos (RinvN n)). - assumption. - unfold Un_cv; intros; split with 0%nat; intros; unfold Rdist; unfold phi2; rewrite StepFun_P18; unfold Rminus; rewrite Rplus_opp_r; rewrite Rabs_R0; apply H. Qed. Lemma RiemannInt_P16 : forall (f:R -> R) (a b:R), Riemann_integrable f a b -> Riemann_integrable (fun x:R => Rabs (f x)) a b. Proof. unfold Riemann_integrable; intro f; intros; elim (X eps); clear X; intros phi [psi [H H0]]; split with (mkStepFun (StepFun_P32 phi)); split with psi; split; try assumption; intros; simpl; apply Rle_trans with (Rabs (f t - phi t)); [ apply Rabs_triang_inv2 | apply H; assumption ]. Qed. Lemma Rle_cv_lim : forall (Un Vn:nat -> R) (l1 l2:R), (forall n:nat, Un n <= Vn n) -> Un_cv Un l1 -> Un_cv Vn l2 -> l1 <= l2. Proof. intros; destruct (Rle_dec l1 l2) as [Hle|Hnle]. { assumption. } assert (H2 : l2 < l1). { auto with real. } assert (H3 : 0 < (l1 - l2) / 2). { unfold Rdiv; apply Rmult_lt_0_compat; [ apply Rlt_0_minus; assumption | apply Rinv_0_lt_compat; prove_sup0 ]. } elim (H1 _ H3); elim (H0 _ H3); clear H0 H1; unfold Rdist; intros; set (N := max x x0); cut (Vn N < Un N). { intro; elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ (H N) H4)). } apply Rlt_trans with ((l1 + l2) / 2). { apply Rplus_lt_reg_l with (- l2); replace (- l2 + (l1 + l2) / 2) with ((l1 - l2) / 2). { rewrite Rplus_comm; apply Rle_lt_trans with (Rabs (Vn N - l2)). { apply RRle_abs. } apply H1; unfold ge; unfold N; apply Nat.le_max_r. } lra. } apply Ropp_lt_cancel; apply Rplus_lt_reg_l with l1; replace (l1 + - ((l1 + l2) / 2)) with ((l1 - l2) / 2). { apply Rle_lt_trans with (Rabs (Un N - l1)). { rewrite <- Rabs_Ropp; rewrite Ropp_minus_distr; apply RRle_abs. } apply H0; unfold ge; unfold N; apply Nat.le_max_l. } lra. Qed. Lemma RiemannInt_P17 : forall (f:R -> R) (a b:R) (pr1:Riemann_integrable f a b) (pr2:Riemann_integrable (fun x:R => Rabs (f x)) a b), a <= b -> Rabs (RiemannInt pr1) <= RiemannInt pr2. Proof. intro f; intros; unfold RiemannInt; case (RiemannInt_exists pr1 RinvN RinvN_cv) as (x0,HUn_cv0); case (RiemannInt_exists pr2 RinvN RinvN_cv) as (x,HUn_cv); set (phi1 := phi_sequence RinvN pr1) in HUn_cv0; set (phi2 := fun N:nat => mkStepFun (StepFun_P32 (phi1 N))); apply Rle_cv_lim with (fun N:nat => Rabs (RiemannInt_SF (phi1 N))) (fun N:nat => RiemannInt_SF (phi2 N)). { intro; unfold phi2; apply StepFun_P34; assumption. } { apply (continuity_seq Rabs (fun N:nat => RiemannInt_SF (phi1 N)) x0); try assumption. apply Rcontinuity_abs. } set (phi3 := phi_sequence RinvN pr2); assert (H0 : exists psi3 : nat -> StepFun a b, (forall n:nat, (forall t:R, Rmin a b <= t /\ t <= Rmax a b -> Rabs (Rabs (f t) - phi3 n t) <= psi3 n t) /\ Rabs (RiemannInt_SF (psi3 n)) < RinvN n)). { split with (fun n:nat => proj1_sig (phi_sequence_prop RinvN pr2 n)); intro; apply (proj2_sig (phi_sequence_prop RinvN pr2 n)). } assert (H1 : exists psi2 : nat -> StepFun a b, (forall n:nat, (forall t:R, Rmin a b <= t /\ t <= Rmax a b -> Rabs (Rabs (f t) - phi2 n t) <= psi2 n t) /\ Rabs (RiemannInt_SF (psi2 n)) < RinvN n)). { assert (H1 : exists psi2 : nat -> StepFun a b, (forall n:nat, (forall t:R, Rmin a b <= t /\ t <= Rmax a b -> Rabs (f t - phi1 n t) <= psi2 n t) /\ Rabs (RiemannInt_SF (psi2 n)) < RinvN n)). { split with (fun n:nat => proj1_sig (phi_sequence_prop RinvN pr1 n)); intro; apply (proj2_sig (phi_sequence_prop RinvN pr1 n)). } elim H1; clear H1; intros psi2 H1; split with psi2; intros; elim (H1 n); clear H1; intros; split; try assumption. intros; unfold phi2; simpl; apply Rle_trans with (Rabs (f t - phi1 n t)). { apply Rabs_triang_inv2. } apply H1; assumption. } elim H0; clear H0; intros psi3 H0; elim H1; clear H1; intros psi2 H1; apply RiemannInt_P11 with (fun x:R => Rabs (f x)) RinvN phi3 psi3 psi2; try assumption; apply RinvN_cv. Qed. Lemma RiemannInt_P18 : forall (f g:R -> R) (a b:R) (pr1:Riemann_integrable f a b) (pr2:Riemann_integrable g a b), a <= b -> (forall x:R, a < x < b -> f x = g x) -> RiemannInt pr1 = RiemannInt pr2. Proof. intro f; intros; unfold RiemannInt; case (RiemannInt_exists pr1 RinvN RinvN_cv) as (x0,HUn_cv0); case (RiemannInt_exists pr2 RinvN RinvN_cv) as (x,HUn_cv); eapply UL_sequence. { apply HUn_cv0. } set (phi1 := fun N:nat => phi_sequence RinvN pr1 N); change (Un_cv (fun N:nat => RiemannInt_SF (phi1 N)) x); assert (H1 : exists psi1 : nat -> StepFun a b, (forall n:nat, (forall t:R, Rmin a b <= t /\ t <= Rmax a b -> Rabs (f t - phi1 n t) <= psi1 n t) /\ Rabs (RiemannInt_SF (psi1 n)) < RinvN n)). { split with (fun n:nat => proj1_sig (phi_sequence_prop RinvN pr1 n)); intro; apply (proj2_sig (phi_sequence_prop RinvN pr1 n)). } elim H1; clear H1; intros psi1 H1; set (phi2 := fun N:nat => phi_sequence RinvN pr2 N). set (phi2_aux := fun (N:nat) (x:R) => match Req_dec_T x a with | left _ => f a | right _ => match Req_dec_T x b with | left _ => f b | right _ => phi2 N x end end). cut (forall N:nat, IsStepFun (phi2_aux N) a b). { intro; set (phi2_m := fun N:nat => mkStepFun (X N)). assert (H2 : exists psi2 : nat -> StepFun a b, (forall n:nat, (forall t:R, Rmin a b <= t /\ t <= Rmax a b -> Rabs (g t - phi2 n t) <= psi2 n t) /\ Rabs (RiemannInt_SF (psi2 n)) < RinvN n)). { split with (fun n:nat => proj1_sig (phi_sequence_prop RinvN pr2 n)); intro; apply (proj2_sig (phi_sequence_prop RinvN pr2 n)). } elim H2; clear H2; intros psi2 H2; apply RiemannInt_P11 with f RinvN phi2_m psi2 psi1; try assumption. - apply RinvN_cv. - intro; elim (H2 n); intros; split; try assumption. intros; unfold phi2_m; simpl; unfold phi2_aux; destruct (Req_dec_T t a) as [Heqa|Hneqa]; destruct (Req_dec_T t b) as [Heqb|Hneqb]. + rewrite Heqa; unfold Rminus; rewrite Rplus_opp_r; rewrite Rabs_R0; apply Rle_trans with (Rabs (g t - phi2 n t)). { apply Rabs_pos. } pattern a at 3; rewrite <- Heqa; apply H3; assumption. + rewrite Heqa; unfold Rminus; rewrite Rplus_opp_r; rewrite Rabs_R0; apply Rle_trans with (Rabs (g t - phi2 n t)). { apply Rabs_pos. } pattern a at 3; rewrite <- Heqa; apply H3; assumption. + rewrite Heqb; unfold Rminus; rewrite Rplus_opp_r; rewrite Rabs_R0; apply Rle_trans with (Rabs (g t - phi2 n t)). { apply Rabs_pos. } pattern b at 3; rewrite <- Heqb; apply H3; assumption. + replace (f t) with (g t). { apply H3; assumption. } symmetry ; apply H0; elim H5; clear H5; intros. assert (H7 : Rmin a b = a). { unfold Rmin; destruct (Rle_dec a b) as [Heqab|Hneqab]; [ reflexivity | elim Hneqab; assumption ]. } assert (H8 : Rmax a b = b). { unfold Rmax; destruct (Rle_dec a b) as [Heqab|Hneqab]; [ reflexivity | elim Hneqab; assumption ]. } rewrite H7 in H5; rewrite H8 in H6; split. { elim H5; intro; [ assumption | elim Hneqa; symmetry ; assumption ]. } elim H6; intro; [ assumption | elim Hneqb; assumption ]. - cut (forall N:nat, RiemannInt_SF (phi2_m N) = RiemannInt_SF (phi2 N)). { intro; unfold Un_cv; intros; elim (HUn_cv _ H4); intros; exists x1; intros; rewrite (H3 n); apply H5; assumption. } intro; apply Rle_antisym. { apply StepFun_P37; try assumption. intros; unfold phi2_m; simpl; unfold phi2_aux; destruct (Req_dec_T x1 a) as [Heqa|Hneqa]; destruct (Req_dec_T x1 b) as [Heqb|Hneqb]. + elim H3; intros; rewrite Heqa in H4; elim (Rlt_irrefl _ H4). + elim H3; intros; rewrite Heqa in H4; elim (Rlt_irrefl _ H4). + elim H3; intros; rewrite Heqb in H5; elim (Rlt_irrefl _ H5). + right; reflexivity. } apply StepFun_P37; try assumption. intros; unfold phi2_m; simpl; unfold phi2_aux; destruct (Req_dec_T x1 a) as [ -> |Hneqa]. { elim H3; intros; elim (Rlt_irrefl _ H4). } destruct (Req_dec_T x1 b) as [ -> |Hneqb]. { elim H3; intros; elim (Rlt_irrefl _ H5). } right; reflexivity. } intro; assert (H2 := pre (phi2 N)); unfold IsStepFun in H2; unfold is_subdivision in H2; elim H2; clear H2; intros l [lf H2]; split with l; split with lf; unfold adapted_couple in H2; decompose [and] H2; clear H2; unfold adapted_couple; repeat split; try assumption. intros; assert (H9 := H8 i H2); unfold constant_D_eq, open_interval in H9; unfold constant_D_eq, open_interval; intros; rewrite <- (H9 x1 H7); assert (H10 : a <= pos_Rl l i). { replace a with (Rmin a b). { rewrite <- H5; elim (RList_P6 l); intros; apply H10. - assumption. - apply Nat.le_0_l. - apply Nat.lt_trans with (pred (length l)); [ assumption | apply Nat.lt_pred_l ]. intro; rewrite H12 in H6; discriminate. } unfold Rmin; decide (Rle_dec a b) with H; reflexivity. } assert (H11 : pos_Rl l (S i) <= b). { replace b with (Rmax a b). { rewrite <- H4; elim (RList_P6 l); intros; apply H11. - assumption. - apply Nat.le_succ_l; assumption. - apply Nat.lt_pred_l; intro; rewrite H13 in H6; discriminate. } unfold Rmax; decide (Rle_dec a b) with H; reflexivity. } elim H7; clear H7; intros; unfold phi2_aux; destruct (Req_dec_T x1 a) as [Heq|Hneq]; destruct (Req_dec_T x1 b) as [Heq'|Hneq']. - rewrite Heq' in H12; elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H11 H12)). - rewrite Heq in H7; elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H10 H7)). - rewrite Heq' in H12; elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H11 H12)). - reflexivity. Qed. Lemma RiemannInt_P19 : forall (f g:R -> R) (a b:R) (pr1:Riemann_integrable f a b) (pr2:Riemann_integrable g a b), a <= b -> (forall x:R, a < x < b -> f x <= g x) -> RiemannInt pr1 <= RiemannInt pr2. Proof. intro f; intros; apply Rplus_le_reg_l with (- RiemannInt pr1); rewrite Rplus_opp_l; rewrite Rplus_comm; apply Rle_trans with (Rabs (RiemannInt (RiemannInt_P10 (-1) pr2 pr1))). { apply Rabs_pos. } replace (RiemannInt pr2 + - RiemannInt pr1) with (RiemannInt (RiemannInt_P16 (RiemannInt_P10 (-1) pr2 pr1))). { apply (RiemannInt_P17 (RiemannInt_P10 (-1) pr2 pr1) (RiemannInt_P16 (RiemannInt_P10 (-1) pr2 pr1))); assumption. } replace (RiemannInt pr2 + - RiemannInt pr1) with (RiemannInt (RiemannInt_P10 (-1) pr2 pr1)). { apply RiemannInt_P18; try assumption. intros; apply Rabs_right. apply Rle_ge; apply Rplus_le_reg_l with (f x); rewrite Rplus_0_r; replace (f x + (g x + -1 * f x)) with (g x); [ apply H0; assumption | ring ]. } rewrite (RiemannInt_P12 pr2 pr1 (RiemannInt_P10 (-1) pr2 pr1)); [ ring | assumption ]. Qed. Lemma FTC_P1 : forall (f:R -> R) (a b:R), a <= b -> (forall x:R, a <= x <= b -> continuity_pt f x) -> forall x:R, a <= x -> x <= b -> Riemann_integrable f a x. Proof. intros; apply continuity_implies_RiemannInt; [ assumption | intros; apply H0; elim H3; intros; split; assumption || apply Rle_trans with x; assumption ]. Qed. Definition primitive (f:R -> R) (a b:R) (h:a <= b) (pr:forall x:R, a <= x -> x <= b -> Riemann_integrable f a x) (x:R) : R := match Rle_dec a x with | left r => match Rle_dec x b with | left r0 => RiemannInt (pr x r r0) | right _ => f b * (x - b) + RiemannInt (pr b h (Rle_refl b)) end | right _ => f a * (x - a) end. Lemma RiemannInt_P20 : forall (f:R -> R) (a b:R) (h:a <= b) (pr:forall x:R, a <= x -> x <= b -> Riemann_integrable f a x) (pr0:Riemann_integrable f a b), RiemannInt pr0 = primitive h pr b - primitive h pr a. Proof. intros; replace (primitive h pr a) with 0. { replace (RiemannInt pr0) with (primitive h pr b). { ring. } unfold primitive; destruct (Rle_dec a b) as [Hle|[]]; destruct (Rle_dec b b) as [Hle'|Hnle']; [ apply RiemannInt_P5 | destruct Hnle'; right; reflexivity | assumption | assumption]. } symmetry ; unfold primitive; destruct (Rle_dec a a) as [Hle|[]]; destruct (Rle_dec a b) as [Hle'|Hnle']; [ apply RiemannInt_P9 | elim Hnle'; assumption | right; reflexivity | right; reflexivity ]. Qed. Lemma RiemannInt_P21 : forall (f:R -> R) (a b c:R), a <= b -> b <= c -> Riemann_integrable f a b -> Riemann_integrable f b c -> Riemann_integrable f a c. Proof. unfold Riemann_integrable; intros f a b c Hyp1 Hyp2 X X0 eps. assert (H : 0 < eps / 2). { unfold Rdiv; apply Rmult_lt_0_compat; [ apply (cond_pos eps) | apply Rinv_0_lt_compat; prove_sup0 ]. } elim (X (mkposreal _ H)); clear X; intros phi1 [psi1 H1]; elim (X0 (mkposreal _ H)); clear X0; intros phi2 [psi2 H2]. set (phi3 := fun x:R => match Rle_dec a x with | left _ => match Rle_dec x b with | left _ => phi1 x | right _ => phi2 x end | right _ => 0 end). set (psi3 := fun x:R => match Rle_dec a x with | left _ => match Rle_dec x b with | left _ => psi1 x | right _ => psi2 x end | right _ => 0 end). cut (IsStepFun phi3 a c). 1:intro; cut (IsStepFun psi3 a b). 1:intro; cut (IsStepFun psi3 b c). 1:intro; assert (IsStepFun psi3 a c) by (apply StepFun_P46 with b; assumption). - split with (mkStepFun X); split with (mkStepFun X2); simpl; split. + intros; unfold phi3, psi3; case (Rle_dec t b) as [|Hnle]; case (Rle_dec a t) as [|Hnle']. * elim H1; intros; apply H3. replace (Rmin a b) with a. { replace (Rmax a b) with b. { split; assumption. } unfold Rmax; decide (Rle_dec a b) with Hyp1; reflexivity. } unfold Rmin; decide (Rle_dec a b) with Hyp1; reflexivity. * elim Hnle'; replace a with (Rmin a c). { elim H0; intros; assumption. } unfold Rmin; case (Rle_dec a c) as [|[]]; [ reflexivity | apply Rle_trans with b; assumption ]. * elim H2; intros; apply H3. replace (Rmax b c) with (Rmax a c). { elim H0; intros; split; try assumption. replace (Rmin b c) with b. { auto with real. } unfold Rmin; decide (Rle_dec b c) with Hyp2; reflexivity. } unfold Rmax; decide (Rle_dec b c) with Hyp2; case (Rle_dec a c) as [|[]]; [ reflexivity | apply Rle_trans with b; assumption ]. * elim Hnle'; replace a with (Rmin a c). { elim H0; intros; assumption. } unfold Rmin; case (Rle_dec a c) as [|[]]; [ reflexivity | apply Rle_trans with b; assumption ]. + rewrite <- (StepFun_P43 X0 X1 X2). apply Rle_lt_trans with (Rabs (RiemannInt_SF (mkStepFun X0)) + Rabs (RiemannInt_SF (mkStepFun X1))). { apply Rabs_triang. } rewrite <-(Rplus_half_diag eps); replace (RiemannInt_SF (mkStepFun X0)) with (RiemannInt_SF psi1). { replace (RiemannInt_SF (mkStepFun X1)) with (RiemannInt_SF psi2). { apply Rplus_lt_compat. { elim H1; intros; assumption. } elim H2; intros; assumption. } apply Rle_antisym. { apply StepFun_P37; try assumption. simpl; intros; unfold psi3; elim H0; clear H0; intros; destruct (Rle_dec a x) as [Hle|Hnle]; destruct (Rle_dec x b) as [Hle'|Hnle']; [ elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ Hle' H0)) | right; reflexivity | elim Hnle; apply Rle_trans with b; [ assumption | left; assumption ] | elim Hnle; apply Rle_trans with b; [ assumption | left; assumption ] ]. } apply StepFun_P37; try assumption. simpl; intros; unfold psi3; elim H0; clear H0; intros; destruct (Rle_dec a x) as [Hle|Hnle]; destruct (Rle_dec x b) as [Hle'|Hnle']; [ elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ Hle' H0)) | right; reflexivity | elim Hnle; apply Rle_trans with b; [ assumption | left; assumption ] | elim Hnle; apply Rle_trans with b; [ assumption | left; assumption ] ]. } apply Rle_antisym. { apply StepFun_P37; try assumption. simpl; intros; unfold psi3; elim H0; clear H0; intros; destruct (Rle_dec a x) as [Hle|Hnle]; destruct (Rle_dec x b) as [Hle'|Hnle']; [ right; reflexivity | elim Hnle'; left; assumption | elim Hnle; left; assumption | elim Hnle; left; assumption ]. } apply StepFun_P37; try assumption. simpl; intros; unfold psi3; elim H0; clear H0; intros; destruct (Rle_dec a x) as [Hle|Hnle]; destruct (Rle_dec x b) as [Hle'|Hnle']; [ right; reflexivity | elim Hnle'; left; assumption | elim Hnle; left; assumption | elim Hnle; left; assumption ]. - assert (H3 := pre psi2); unfold IsStepFun in H3; unfold is_subdivision in H3; elim H3; clear H3; intros l1 [lf1 H3]; split with l1; split with lf1; unfold adapted_couple in H3; decompose [and] H3; clear H3; unfold adapted_couple; repeat split; try assumption. intros; assert (H9 := H8 i H3); unfold constant_D_eq, open_interval; unfold constant_D_eq, open_interval in H9; intros; rewrite <- (H9 x H7); unfold psi3; assert (H10 : b < x). { apply Rle_lt_trans with (pos_Rl l1 i). { replace b with (Rmin b c). { rewrite <- H5; elim (RList_P6 l1); intros; apply H10; try assumption. { apply Nat.le_0_l. } apply Nat.lt_trans with (pred (length l1)); try assumption; apply Nat.lt_pred_l; red; intro; rewrite H12 in H6; discriminate. } unfold Rmin; decide (Rle_dec b c) with Hyp2; reflexivity. } elim H7; intros; assumption. } destruct (Rle_dec a x) as [Hle|Hnle]; destruct (Rle_dec x b) as [Hle'|Hnle']; [ elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ Hle' H10)) | reflexivity | elim Hnle; apply Rle_trans with b; [ assumption | left; assumption ] | elim Hnle; apply Rle_trans with b; [ assumption | left; assumption ] ]. - assert (H3 := pre psi1); unfold IsStepFun in H3; unfold is_subdivision in H3; elim H3; clear H3; intros l1 [lf1 H3]; split with l1; split with lf1; unfold adapted_couple in H3; decompose [and] H3; clear H3; unfold adapted_couple; repeat split; try assumption. intros; assert (H9 := H8 i H3); unfold constant_D_eq, open_interval; unfold constant_D_eq, open_interval in H9; intros; rewrite <- (H9 x H7); unfold psi3; assert (H10 : x <= b). { apply Rle_trans with (pos_Rl l1 (S i)). { elim H7; intros; left; assumption. } replace b with (Rmax a b). { rewrite <- H4; elim (RList_P6 l1); intros; apply H10; try assumption. apply Nat.lt_pred_l; red; intro; rewrite H12 in H6; discriminate. } unfold Rmax; decide (Rle_dec a b) with Hyp1; reflexivity. } assert (H11 : a <= x). { apply Rle_trans with (pos_Rl l1 i). { replace a with (Rmin a b). { rewrite <- H5; elim (RList_P6 l1); intros; apply H11; try assumption. { apply Nat.le_0_l. } apply Nat.lt_trans with (pred (length l1)); try assumption; apply Nat.lt_pred_l; red; intro; rewrite H13 in H6; discriminate. } unfold Rmin; decide (Rle_dec a b) with Hyp1; reflexivity. } left; elim H7; intros; assumption. } decide (Rle_dec a x) with H11; decide (Rle_dec x b) with H10; reflexivity. - apply StepFun_P46 with b. { assert (H3 := pre phi1); unfold IsStepFun in H3; unfold is_subdivision in H3; elim H3; clear H3; intros l1 [lf1 H3]; split with l1; split with lf1; unfold adapted_couple in H3; decompose [and] H3; clear H3; unfold adapted_couple; repeat split; try assumption. intros; assert (H9 := H8 i H3); unfold constant_D_eq, open_interval; unfold constant_D_eq, open_interval in H9; intros; rewrite <- (H9 x H7); unfold psi3; assert (H10 : x <= b). { apply Rle_trans with (pos_Rl l1 (S i)). { elim H7; intros; left; assumption. } replace b with (Rmax a b). { rewrite <- H4; elim (RList_P6 l1); intros; apply H10; try assumption. apply Nat.lt_pred_l; red; intro; rewrite H12 in H6; discriminate. } unfold Rmax; decide (Rle_dec a b) with Hyp1; reflexivity. } assert (H11 : a <= x). { apply Rle_trans with (pos_Rl l1 i). { replace a with (Rmin a b). { rewrite <- H5; elim (RList_P6 l1); intros; apply H11; try assumption. { apply Nat.le_0_l. } apply Nat.lt_trans with (pred (length l1)); try assumption; apply Nat.lt_pred_l; red; intro; rewrite H13 in H6; discriminate. } unfold Rmin; decide (Rle_dec a b) with Hyp1; reflexivity. } left; elim H7; intros; assumption. } unfold phi3; decide (Rle_dec a x) with H11; decide (Rle_dec x b) with H10; reflexivity || elim n; assumption. } assert (H3 := pre phi2); unfold IsStepFun in H3; unfold is_subdivision in H3; elim H3; clear H3; intros l1 [lf1 H3]; split with l1; split with lf1; unfold adapted_couple in H3; decompose [and] H3; clear H3; unfold adapted_couple; repeat split; try assumption. intros; assert (H9 := H8 i H3); unfold constant_D_eq, open_interval; unfold constant_D_eq, open_interval in H9; intros; rewrite <- (H9 x H7); unfold psi3; assert (H10 : b < x). { apply Rle_lt_trans with (pos_Rl l1 i). { replace b with (Rmin b c). { rewrite <- H5; elim (RList_P6 l1); intros; apply H10; try assumption. { apply Nat.le_0_l. } apply Nat.lt_trans with (pred (length l1)); try assumption; apply Nat.lt_pred_l; red; intro; rewrite H12 in H6; discriminate. } unfold Rmin; decide (Rle_dec b c) with Hyp2; reflexivity. } elim H7; intros; assumption. } unfold phi3; destruct (Rle_dec a x) as [Hle|Hnle]; destruct (Rle_dec x b) as [Hle'|Hnle']; intros; [ elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ Hle' H10)) | reflexivity | elim Hnle; apply Rle_trans with b; [ assumption | left; assumption ] | elim Hnle; apply Rle_trans with b; [ assumption | left; assumption ] ]. Qed. Lemma RiemannInt_P22 : forall (f:R -> R) (a b c:R), Riemann_integrable f a b -> a <= c <= b -> Riemann_integrable f a c. Proof. unfold Riemann_integrable; intros; elim (X eps); clear X; intros phi [psi H0]; elim H; elim H0; clear H H0; intros; assert (H3 : IsStepFun phi a c). { apply StepFun_P44 with b. { apply (pre phi). } split; assumption. } assert (H4 : IsStepFun psi a c). { apply StepFun_P44 with b. { apply (pre psi). } split; assumption. } split with (mkStepFun H3); split with (mkStepFun H4); split. { simpl; intros; apply H. replace (Rmin a b) with (Rmin a c) by (rewrite 2!Rmin_left; eauto using Rle_trans). destruct H5; split; try assumption. apply Rle_trans with (Rmax a c); try assumption. apply Rle_max_compat_l; assumption. } rewrite Rabs_right. { assert (H5 : IsStepFun psi c b). { apply StepFun_P46 with a. { apply StepFun_P6; assumption. } apply (pre psi). } replace (RiemannInt_SF (mkStepFun H4)) with (RiemannInt_SF psi - RiemannInt_SF (mkStepFun H5)). { apply Rle_lt_trans with (RiemannInt_SF psi). { unfold Rminus; pattern (RiemannInt_SF psi) at 2; rewrite <- Rplus_0_r; apply Rplus_le_compat_l; rewrite <- Ropp_0; apply Ropp_ge_le_contravar; apply Rle_ge; replace 0 with (RiemannInt_SF (mkStepFun (StepFun_P4 c b 0))). { apply StepFun_P37; try assumption. intros; simpl; unfold fct_cte; apply Rle_trans with (Rabs (f x - phi x)). { apply Rabs_pos. } apply H. rewrite Rmin_left; eauto using Rle_trans. rewrite Rmax_right; eauto using Rle_trans. destruct H6; split; left. { apply Rle_lt_trans with c; assumption. } assumption. } rewrite StepFun_P18; ring. } apply Rle_lt_trans with (Rabs (RiemannInt_SF psi)). { apply RRle_abs. } assumption. } assert (H6 : IsStepFun psi a b). { apply (pre psi). } replace (RiemannInt_SF psi) with (RiemannInt_SF (mkStepFun H6)). { rewrite <- (StepFun_P43 H4 H5 H6); ring. } unfold RiemannInt_SF; case (Rle_dec a b); intro. { eapply StepFun_P17. { apply StepFun_P1. } simpl; apply StepFun_P1. } apply Ropp_eq_compat; eapply StepFun_P17. { apply StepFun_P1. } simpl; apply StepFun_P1. } apply Rle_ge. replace 0 with (RiemannInt_SF (mkStepFun (StepFun_P4 a c 0))) by (rewrite StepFun_P18; ring). apply StepFun_P37; try assumption. intros; simpl; unfold fct_cte; apply Rle_trans with (Rabs (f x - phi x)). { apply Rabs_pos. } apply H. rewrite Rmin_left; eauto using Rle_trans. rewrite Rmax_right; eauto using Rle_trans. destruct H5; split; left. { assumption. } apply Rlt_le_trans with c; assumption. Qed. Lemma RiemannInt_P23 : forall (f:R -> R) (a b c:R), Riemann_integrable f a b -> a <= c <= b -> Riemann_integrable f c b. Proof. unfold Riemann_integrable; intros; elim (X eps); clear X; intros phi [psi H0]; elim H; elim H0; clear H H0; intros; assert (H3 : IsStepFun phi c b). { apply StepFun_P45 with a. { apply (pre phi). } split; assumption. } assert (H4 : IsStepFun psi c b). { apply StepFun_P45 with a. { apply (pre psi). } split; assumption. } split with (mkStepFun H3); split with (mkStepFun H4); split. { simpl; intros; apply H. replace (Rmax a b) with (Rmax c b). { elim H5; intros; split; try assumption. apply Rle_trans with (Rmin c b); try assumption. rewrite Rmin_left; eauto using Rle_trans. rewrite Rmin_left; eauto using Rle_trans. } rewrite Rmax_right; eauto using Rle_trans. rewrite Rmax_right; eauto using Rle_trans. } rewrite Rabs_right. { assert (H5 : IsStepFun psi a c). { apply StepFun_P46 with b. { apply (pre psi). } apply StepFun_P6; assumption. } replace (RiemannInt_SF (mkStepFun H4)) with (RiemannInt_SF psi - RiemannInt_SF (mkStepFun H5)). { apply Rle_lt_trans with (RiemannInt_SF psi). { unfold Rminus; pattern (RiemannInt_SF psi) at 2; rewrite <- Rplus_0_r; apply Rplus_le_compat_l; rewrite <- Ropp_0; apply Ropp_ge_le_contravar; apply Rle_ge; replace 0 with (RiemannInt_SF (mkStepFun (StepFun_P4 a c 0))). { apply StepFun_P37; try assumption. intros; simpl; unfold fct_cte; apply Rle_trans with (Rabs (f x - phi x)). { apply Rabs_pos. } apply H. rewrite Rmin_left; eauto using Rle_trans. rewrite Rmax_right; eauto using Rle_trans. destruct H6; split; left. { assumption. } apply Rlt_le_trans with c; assumption. } rewrite StepFun_P18; ring. } apply Rle_lt_trans with (Rabs (RiemannInt_SF psi)). { apply RRle_abs. } assumption. } assert (H6 : IsStepFun psi a b). { apply (pre psi). } replace (RiemannInt_SF psi) with (RiemannInt_SF (mkStepFun H6)). { rewrite <- (StepFun_P43 H5 H4 H6); ring. } unfold RiemannInt_SF; case (Rle_dec a b); intro. { eapply StepFun_P17. { apply StepFun_P1. } simpl; apply StepFun_P1. } apply Ropp_eq_compat; eapply StepFun_P17. { apply StepFun_P1. } simpl; apply StepFun_P1. } apply Rle_ge; replace 0 with (RiemannInt_SF (mkStepFun (StepFun_P4 c b 0))) by (rewrite StepFun_P18; ring). apply StepFun_P37; try assumption. intros; simpl; unfold fct_cte; apply Rle_trans with (Rabs (f x - phi x)). { apply Rabs_pos. } apply H. rewrite Rmin_left; eauto using Rle_trans. rewrite Rmax_right; eauto using Rle_trans. destruct H5; split; left. { apply Rle_lt_trans with c; assumption. } assumption. Qed. Lemma RiemannInt_P24 : forall (f:R -> R) (a b c:R), Riemann_integrable f a b -> Riemann_integrable f b c -> Riemann_integrable f a c. Proof. intros; case (Rle_dec a b); case (Rle_dec b c); intros. - apply RiemannInt_P21 with b; assumption. - case (Rle_dec a c); intro. + apply RiemannInt_P22 with b; try assumption. split; [ assumption | auto with real ]. + apply RiemannInt_P1; apply RiemannInt_P22 with b. * apply RiemannInt_P1; assumption. * split; auto with real. - case (Rle_dec a c); intro. + apply RiemannInt_P23 with b; try assumption. split; auto with real. + apply RiemannInt_P1; apply RiemannInt_P23 with b. * apply RiemannInt_P1; assumption. * split; [ assumption | auto with real ]. - apply RiemannInt_P1; apply RiemannInt_P21 with b; auto with real || apply RiemannInt_P1; assumption. Qed. Lemma RiemannInt_P25 : forall (f:R -> R) (a b c:R) (pr1:Riemann_integrable f a b) (pr2:Riemann_integrable f b c) (pr3:Riemann_integrable f a c), a <= b -> b <= c -> RiemannInt pr1 + RiemannInt pr2 = RiemannInt pr3. Proof. intros f a b c pr1 pr2 pr3 Hyp1 Hyp2; unfold RiemannInt; case (RiemannInt_exists pr1 RinvN RinvN_cv) as (x1,HUn_cv1); case (RiemannInt_exists pr2 RinvN RinvN_cv) as (x0,HUn_cv0); case (RiemannInt_exists pr3 RinvN RinvN_cv) as (x,HUn_cv); symmetry ; eapply UL_sequence. { apply HUn_cv. } unfold Un_cv; intros; assert (H0 : 0 < eps / 3). { unfold Rdiv; apply Rmult_lt_0_compat; [ assumption | apply Rinv_0_lt_compat; prove_sup0 ]. } destruct (HUn_cv1 _ H0) as (N1,H1); clear HUn_cv1; destruct (HUn_cv0 _ H0) as (N2,H2); clear HUn_cv0; cut (Un_cv (fun n:nat => RiemannInt_SF (phi_sequence RinvN pr3 n) - (RiemannInt_SF (phi_sequence RinvN pr1 n) + RiemannInt_SF (phi_sequence RinvN pr2 n))) 0). { intro; elim (H3 _ H0); clear H3; intros N3 H3; set (N0 := max (max N1 N2) N3); exists N0; intros; unfold Rdist; apply Rle_lt_trans with (Rabs (RiemannInt_SF (phi_sequence RinvN pr3 n) - (RiemannInt_SF (phi_sequence RinvN pr1 n) + RiemannInt_SF (phi_sequence RinvN pr2 n))) + Rabs (RiemannInt_SF (phi_sequence RinvN pr1 n) + RiemannInt_SF (phi_sequence RinvN pr2 n) - (x1 + x0))). { replace (RiemannInt_SF (phi_sequence RinvN pr3 n) - (x1 + x0)) with (RiemannInt_SF (phi_sequence RinvN pr3 n) - (RiemannInt_SF (phi_sequence RinvN pr1 n) + RiemannInt_SF (phi_sequence RinvN pr2 n)) + (RiemannInt_SF (phi_sequence RinvN pr1 n) + RiemannInt_SF (phi_sequence RinvN pr2 n) - (x1 + x0))); [ apply Rabs_triang | ring ]. } replace eps with (eps / 3 + eps / 3 + eps / 3) by lra. rewrite Rplus_assoc; apply Rplus_lt_compat. { unfold Rdist in H3; cut (n >= N3)%nat. { intro; assert (H6 := H3 _ H5); unfold Rminus in H6; rewrite Ropp_0 in H6; rewrite Rplus_0_r in H6; apply H6. } unfold ge; apply Nat.le_trans with N0; [ unfold N0; apply Nat.le_max_r | assumption ]. } apply Rle_lt_trans with (Rabs (RiemannInt_SF (phi_sequence RinvN pr1 n) - x1) + Rabs (RiemannInt_SF (phi_sequence RinvN pr2 n) - x0)). { replace (RiemannInt_SF (phi_sequence RinvN pr1 n) + RiemannInt_SF (phi_sequence RinvN pr2 n) - (x1 + x0)) with (RiemannInt_SF (phi_sequence RinvN pr1 n) - x1 + (RiemannInt_SF (phi_sequence RinvN pr2 n) - x0)); [ apply Rabs_triang | ring ]. } apply Rplus_lt_compat. { unfold Rdist in H1; apply H1. unfold ge; apply Nat.le_trans with N0; [ apply Nat.le_trans with (max N1 N2); [ apply Nat.le_max_l | unfold N0; apply Nat.le_max_l ] | assumption ]. } unfold Rdist in H2; apply H2. unfold ge; apply Nat.le_trans with N0; [ apply Nat.le_trans with (max N1 N2); [ apply Nat.le_max_r | unfold N0; apply Nat.le_max_l ] | assumption ]. } clear x HUn_cv x0 x1 eps H H0 N1 H1 N2 H2; assert (H1 : exists psi1 : nat -> StepFun a b, (forall n:nat, (forall t:R, Rmin a b <= t /\ t <= Rmax a b -> Rabs (f t - phi_sequence RinvN pr1 n t) <= psi1 n t) /\ Rabs (RiemannInt_SF (psi1 n)) < RinvN n)). { split with (fun n:nat => proj1_sig (phi_sequence_prop RinvN pr1 n)); intro; apply (proj2_sig (phi_sequence_prop RinvN pr1 n)). } assert (H2 : exists psi2 : nat -> StepFun b c, (forall n:nat, (forall t:R, Rmin b c <= t /\ t <= Rmax b c -> Rabs (f t - phi_sequence RinvN pr2 n t) <= psi2 n t) /\ Rabs (RiemannInt_SF (psi2 n)) < RinvN n)). { split with (fun n:nat => proj1_sig (phi_sequence_prop RinvN pr2 n)); intro; apply (proj2_sig (phi_sequence_prop RinvN pr2 n)). } assert (H3 : exists psi3 : nat -> StepFun a c, (forall n:nat, (forall t:R, Rmin a c <= t /\ t <= Rmax a c -> Rabs (f t - phi_sequence RinvN pr3 n t) <= psi3 n t) /\ Rabs (RiemannInt_SF (psi3 n)) < RinvN n)). { split with (fun n:nat => proj1_sig (phi_sequence_prop RinvN pr3 n)); intro; apply (proj2_sig (phi_sequence_prop RinvN pr3 n)). } elim H1; clear H1; intros psi1 H1; elim H2; clear H2; intros psi2 H2; elim H3; clear H3; intros psi3 H3; assert (H := RinvN_cv); unfold Un_cv; intros; assert (H4 : 0 < eps / 3). { unfold Rdiv; apply Rmult_lt_0_compat; [ assumption | apply Rinv_0_lt_compat; prove_sup0 ]. } elim (H _ H4); clear H; intros N0 H; assert (H5 : forall n:nat, (n >= N0)%nat -> RinvN n < eps / 3). { intros; replace (pos (RinvN n)) with (Rdist (mkposreal (/ (INR n + 1)) (RinvN_pos n)) 0). { apply H; assumption. } unfold Rdist; unfold Rminus; rewrite Ropp_0; rewrite Rplus_0_r; apply Rabs_right; apply Rle_ge; left; apply (cond_pos (RinvN n)). } exists N0; intros; elim (H1 n); elim (H2 n); elim (H3 n); clear H1 H2 H3; intros; unfold Rdist; unfold Rminus; rewrite Ropp_0; rewrite Rplus_0_r; set (phi1 := phi_sequence RinvN pr1 n) in H8 |- *; set (phi2 := phi_sequence RinvN pr2 n) in H3 |- *; set (phi3 := phi_sequence RinvN pr3 n) in H1 |- *; assert (H10 : IsStepFun phi3 a b). { apply StepFun_P44 with c. { apply (pre phi3). } split; assumption. } assert (H11 : IsStepFun (psi3 n) a b). { apply StepFun_P44 with c. { apply (pre (psi3 n)). } split; assumption. } assert (H12 : IsStepFun phi3 b c). { apply StepFun_P45 with a. { apply (pre phi3). } split; assumption. } assert (H13 : IsStepFun (psi3 n) b c). { apply StepFun_P45 with a. { apply (pre (psi3 n)). } split; assumption. } replace (RiemannInt_SF phi3) with (RiemannInt_SF (mkStepFun H10) + RiemannInt_SF (mkStepFun H12)). { apply Rle_lt_trans with (Rabs (RiemannInt_SF (mkStepFun H10) - RiemannInt_SF phi1) + Rabs (RiemannInt_SF (mkStepFun H12) - RiemannInt_SF phi2)). { replace (RiemannInt_SF (mkStepFun H10) + RiemannInt_SF (mkStepFun H12) + - (RiemannInt_SF phi1 + RiemannInt_SF phi2)) with (RiemannInt_SF (mkStepFun H10) - RiemannInt_SF phi1 + (RiemannInt_SF (mkStepFun H12) - RiemannInt_SF phi2)) by ring; apply Rabs_triang. } replace (RiemannInt_SF (mkStepFun H10) - RiemannInt_SF phi1) with (RiemannInt_SF (mkStepFun (StepFun_P28 (-1) (mkStepFun H10) phi1))) by (rewrite StepFun_P30; ring). replace (RiemannInt_SF (mkStepFun H12) - RiemannInt_SF phi2) with (RiemannInt_SF (mkStepFun (StepFun_P28 (-1) (mkStepFun H12) phi2))) by (rewrite StepFun_P30; ring). apply Rle_lt_trans with (RiemannInt_SF (mkStepFun (StepFun_P32 (mkStepFun (StepFun_P28 (-1) (mkStepFun H10) phi1)))) + RiemannInt_SF (mkStepFun (StepFun_P32 (mkStepFun (StepFun_P28 (-1) (mkStepFun H12) phi2))))). { apply Rle_trans with (Rabs (RiemannInt_SF (mkStepFun (StepFun_P28 (-1) (mkStepFun H10) phi1))) + RiemannInt_SF (mkStepFun (StepFun_P32 (mkStepFun (StepFun_P28 (-1) (mkStepFun H12) phi2))))). { apply Rplus_le_compat_l. apply StepFun_P34; try assumption. } do 2 rewrite <- (Rplus_comm (RiemannInt_SF (mkStepFun (StepFun_P32 (mkStepFun (StepFun_P28 (-1) (mkStepFun H12) phi2)))))) ; apply Rplus_le_compat_l; apply StepFun_P34; try assumption. } apply Rle_lt_trans with (RiemannInt_SF (mkStepFun (StepFun_P28 1 (mkStepFun H11) (psi1 n))) + RiemannInt_SF (mkStepFun (StepFun_P28 1 (mkStepFun H13) (psi2 n)))). { apply Rle_trans with (RiemannInt_SF (mkStepFun (StepFun_P32 (mkStepFun (StepFun_P28 (-1) (mkStepFun H10) phi1)))) + RiemannInt_SF (mkStepFun (StepFun_P28 1 (mkStepFun H13) (psi2 n)))). { apply Rplus_le_compat_l; apply StepFun_P37; try assumption. intros; simpl; rewrite Rmult_1_l; apply Rle_trans with (Rabs (f x - phi3 x) + Rabs (f x - phi2 x)). { rewrite <- (Rabs_Ropp (f x - phi3 x)); rewrite Ropp_minus_distr; replace (phi3 x + -1 * phi2 x) with (phi3 x - f x + (f x - phi2 x)); [ apply Rabs_triang | ring ]. } apply Rplus_le_compat. { apply H1. elim H14; intros; split. { rewrite Rmin_left; eauto using Rle_trans. apply Rle_trans with b; try assumption. left; assumption. } rewrite Rmax_right; eauto using Rle_trans. left; assumption. } apply H3. elim H14; intros; split. { rewrite Rmin_left; eauto using Rle_trans. left; assumption. } rewrite Rmax_right; eauto using Rle_trans. left; assumption. } do 2 rewrite <- (Rplus_comm (RiemannInt_SF (mkStepFun (StepFun_P28 1 (mkStepFun H13) (psi2 n))))) ; apply Rplus_le_compat_l; apply StepFun_P37; try assumption. intros; simpl; rewrite Rmult_1_l; apply Rle_trans with (Rabs (f x - phi3 x) + Rabs (f x - phi1 x)). { rewrite <- (Rabs_Ropp (f x - phi3 x)); rewrite Ropp_minus_distr; replace (phi3 x + -1 * phi1 x) with (phi3 x - f x + (f x - phi1 x)); [ apply Rabs_triang | ring ]. } apply Rplus_le_compat. { apply H1. elim H14; intros; split. { rewrite Rmin_left; eauto using Rle_trans. left; assumption. } rewrite Rmax_right; eauto using Rle_trans. apply Rle_trans with b. { left; assumption. } assumption. } apply H8. elim H14; intros; split. { rewrite Rmin_left; trivial. left; assumption. } rewrite Rmax_right; trivial. left; assumption. } do 2 rewrite StepFun_P30. do 2 rewrite Rmult_1_l; replace (RiemannInt_SF (mkStepFun H11) + RiemannInt_SF (psi1 n) + (RiemannInt_SF (mkStepFun H13) + RiemannInt_SF (psi2 n))) with (RiemannInt_SF (psi3 n) + RiemannInt_SF (psi1 n) + RiemannInt_SF (psi2 n)). { replace eps with (eps / 3 + eps / 3 + eps / 3) by lra. repeat rewrite Rplus_assoc; apply Rplus_lt_compat. { apply Rle_lt_trans with (Rabs (RiemannInt_SF (psi3 n))). { apply RRle_abs. } apply Rlt_trans with (pos (RinvN n)). { assumption. } apply H5; assumption. } apply Rplus_lt_compat. { apply Rle_lt_trans with (Rabs (RiemannInt_SF (psi1 n))). { apply RRle_abs. } apply Rlt_trans with (pos (RinvN n)). { assumption. } apply H5; assumption. } apply Rle_lt_trans with (Rabs (RiemannInt_SF (psi2 n))). { apply RRle_abs. } apply Rlt_trans with (pos (RinvN n)). { assumption. } apply H5; assumption. } replace (RiemannInt_SF (psi3 n)) with (RiemannInt_SF (mkStepFun (pre (psi3 n)))). { rewrite <- (StepFun_P43 H11 H13 (pre (psi3 n))); ring. } reflexivity. } apply (StepFun_P43 H10 H12 (pre phi3)). Qed. Lemma RiemannInt_P26 : forall (f:R -> R) (a b c:R) (pr1:Riemann_integrable f a b) (pr2:Riemann_integrable f b c) (pr3:Riemann_integrable f a c), RiemannInt pr1 + RiemannInt pr2 = RiemannInt pr3. Proof. intros; destruct (Rle_dec a b) as [Hle|Hnle]; destruct (Rle_dec b c) as [Hle'|Hnle']. - apply RiemannInt_P25; assumption. - destruct (Rle_dec a c) as [Hle''|Hnle'']. { assert (H : c <= b). { auto with real. } rewrite <- (RiemannInt_P25 pr3 (RiemannInt_P1 pr2) pr1 Hle'' H); rewrite (RiemannInt_P8 pr2 (RiemannInt_P1 pr2)); ring. } assert (H : c <= a). { auto with real. } rewrite (RiemannInt_P8 pr2 (RiemannInt_P1 pr2)); rewrite <- (RiemannInt_P25 (RiemannInt_P1 pr3) pr1 (RiemannInt_P1 pr2) H Hle); rewrite (RiemannInt_P8 pr3 (RiemannInt_P1 pr3)); ring. - assert (H : b <= a). { auto with real. } destruct (Rle_dec a c) as [Hle''|Hnle'']. { rewrite <- (RiemannInt_P25 (RiemannInt_P1 pr1) pr3 pr2 H Hle''); rewrite (RiemannInt_P8 pr1 (RiemannInt_P1 pr1)); ring. } assert (H0 : c <= a). { auto with real. } rewrite (RiemannInt_P8 pr1 (RiemannInt_P1 pr1)); rewrite <- (RiemannInt_P25 pr2 (RiemannInt_P1 pr3) (RiemannInt_P1 pr1) Hle' H0); rewrite (RiemannInt_P8 pr3 (RiemannInt_P1 pr3)); ring. - rewrite (RiemannInt_P8 pr1 (RiemannInt_P1 pr1)); rewrite (RiemannInt_P8 pr2 (RiemannInt_P1 pr2)); rewrite (RiemannInt_P8 pr3 (RiemannInt_P1 pr3)); rewrite <- (RiemannInt_P25 (RiemannInt_P1 pr2) (RiemannInt_P1 pr1) (RiemannInt_P1 pr3)) ; [ ring | auto with real | auto with real ]. Qed. Lemma RiemannInt_P27 : forall (f:R -> R) (a b x:R) (h:a <= b) (C0:forall x:R, a <= x <= b -> continuity_pt f x), a < x < b -> derivable_pt_lim (primitive h (FTC_P1 h C0)) x (f x). Proof. intro f; intros; elim H; clear H; intros; assert (H1 : continuity_pt f x). { apply C0; split; left; assumption. } unfold derivable_pt_lim; intros; assert (Hyp : 0 < eps / 2). { unfold Rdiv; apply Rmult_lt_0_compat; [ assumption | apply Rinv_0_lt_compat; prove_sup0 ]. } elim (H1 _ Hyp); unfold dist, D_x, no_cond; simpl; unfold Rdist; intros; set (del := Rmin x0 (Rmin (b - x) (x - a))); assert (H4 : 0 < del). { unfold del; unfold Rmin; case (Rle_dec (b - x) (x - a)); intro. { destruct (Rle_dec x0 (b - x)) as [Hle|Hnle]; [ elim H3; intros; assumption | apply Rlt_0_minus; assumption ]. } destruct (Rle_dec x0 (x - a)) as [Hle'|Hnle']; [ elim H3; intros; assumption | apply Rlt_0_minus; assumption ]. } split with (mkposreal _ H4); intros; assert (H7 : Riemann_integrable f x (x + h0)). { destruct (Rle_dec x (x + h0)) as [Hle''|Hnle'']. { apply continuity_implies_RiemannInt; try assumption. intros; apply C0; elim H7; intros; split. { apply Rle_trans with x; [ left; assumption | assumption ]. } apply Rle_trans with (x + h0). { assumption. } left; apply Rlt_le_trans with (x + del). { apply Rplus_lt_compat_l; apply Rle_lt_trans with (Rabs h0); [ apply RRle_abs | apply H6 ]. } unfold del; apply Rle_trans with (x + Rmin (b - x) (x - a)). { apply Rplus_le_compat_l; apply Rmin_r. } pattern b at 2; replace b with (x + (b - x)); [ apply Rplus_le_compat_l; apply Rmin_l | ring ]. } apply RiemannInt_P1; apply continuity_implies_RiemannInt; auto with real. intros; apply C0; elim H7; intros; split. { apply Rle_trans with (x + h0). { left; apply Rle_lt_trans with (x - del). { unfold del; apply Rle_trans with (x - Rmin (b - x) (x - a)). { pattern a at 1; replace a with (x + (a - x)); [ idtac | ring ]. unfold Rminus; apply Rplus_le_compat_l; apply Ropp_le_cancel. rewrite Ropp_involutive; rewrite Ropp_plus_distr; rewrite Ropp_involutive; rewrite (Rplus_comm x); apply Rmin_r. } unfold Rminus; apply Rplus_le_compat_l; apply Ropp_le_cancel. do 2 rewrite Ropp_involutive; apply Rmin_r. } unfold Rminus; apply Rplus_lt_compat_l; apply Ropp_lt_cancel. rewrite Ropp_involutive; apply Rle_lt_trans with (Rabs h0); [ rewrite <- Rabs_Ropp; apply RRle_abs | apply H6 ]. } assumption. } apply Rle_trans with x; [ assumption | left; assumption ]. } replace (primitive h (FTC_P1 h C0) (x + h0) - primitive h (FTC_P1 h C0) x) with (RiemannInt H7). 2:{ cut (a <= x + h0). { cut (x + h0 <= b). { intros; unfold primitive. assert (H10: a <= x) by (left; assumption). assert (H11: x <= b) by (left; assumption). decide (Rle_dec a (x + h0)) with H9; decide (Rle_dec (x + h0) b) with H8; decide (Rle_dec a x) with H10; decide (Rle_dec x b) with H11. rewrite <- (RiemannInt_P26 (FTC_P1 h C0 H10 H11) H7 (FTC_P1 h C0 H9 H8)); ring. } apply Rplus_le_reg_l with (- x); replace (- x + (x + h0)) with h0; [ idtac | ring ]. rewrite Rplus_comm; apply Rle_trans with (Rabs h0). { apply RRle_abs. } apply Rle_trans with del; [ left; assumption | unfold del; apply Rle_trans with (Rmin (b - x) (x - a)); [ apply Rmin_r | apply Rmin_l ] ]. } apply Ropp_le_cancel; apply Rplus_le_reg_l with x; replace (x + - (x + h0)) with (- h0) by ring. apply Rle_trans with (Rabs h0). { rewrite <- Rabs_Ropp; apply RRle_abs. } apply Rle_trans with del. { left; assumption. } unfold del; apply Rle_trans with (Rmin (b - x) (x - a)); apply Rmin_r. } replace (f x) with (RiemannInt (RiemannInt_P14 x (x + h0) (f x)) / h0). 2:{ rewrite RiemannInt_P15; apply Rmult_eq_reg_l with h0; [ unfold Rdiv; rewrite (Rmult_comm h0); repeat rewrite Rmult_assoc; rewrite Rinv_l; [ ring | assumption ] | assumption ]. } replace (RiemannInt H7 / h0 - RiemannInt (RiemannInt_P14 x (x + h0) (f x)) / h0) with ((RiemannInt H7 - RiemannInt (RiemannInt_P14 x (x + h0) (f x))) / h0). 2:{ unfold Rdiv, Rminus; rewrite Rmult_plus_distr_r; ring. } replace (RiemannInt H7 - RiemannInt (RiemannInt_P14 x (x + h0) (f x))) with (RiemannInt (RiemannInt_P10 (-1) H7 (RiemannInt_P14 x (x + h0) (f x)))). 2:{ rewrite (RiemannInt_P13 H7 (RiemannInt_P14 x (x + h0) (f x)) (RiemannInt_P10 (-1) H7 (RiemannInt_P14 x (x + h0) (f x)))). ring. } unfold Rdiv; rewrite Rabs_mult; destruct (Rle_dec x (x + h0)) as [Hle|Hnle]. - apply Rle_lt_trans with (RiemannInt (RiemannInt_P16 (RiemannInt_P10 (-1) H7 (RiemannInt_P14 x (x + h0) (f x)))) * Rabs (/ h0)). { do 2 rewrite <- (Rmult_comm (Rabs (/ h0))); apply Rmult_le_compat_l. { apply Rabs_pos. } apply (RiemannInt_P17 (RiemannInt_P10 (-1) H7 (RiemannInt_P14 x (x + h0) (f x))) (RiemannInt_P16 (RiemannInt_P10 (-1) H7 (RiemannInt_P14 x (x + h0) (f x))))); assumption. } apply Rle_lt_trans with (RiemannInt (RiemannInt_P14 x (x + h0) (eps / 2)) * Rabs (/ h0)). { do 2 rewrite <- (Rmult_comm (Rabs (/ h0))); apply Rmult_le_compat_l. { apply Rabs_pos. } apply RiemannInt_P19; try assumption. intros; replace (f x1 + -1 * fct_cte (f x) x1) with (f x1 - f x). { unfold fct_cte; destruct (Req_dec x x1) as [H9|H9]. { rewrite H9; unfold Rminus; rewrite Rplus_opp_r; rewrite Rabs_R0; left; assumption. } elim H3; intros; left; apply H11. repeat split. { assumption. } rewrite Rabs_right. { apply Rplus_lt_reg_l with x; replace (x + (x1 - x)) with x1; [ idtac | ring ]. apply Rlt_le_trans with (x + h0). { elim H8; intros; assumption. } apply Rplus_le_compat_l; apply Rle_trans with del. { left; apply Rle_lt_trans with (Rabs h0); [ apply RRle_abs | assumption ]. } unfold del; apply Rmin_l. } apply Rge_minus; apply Rle_ge; left; elim H8; intros; assumption. } unfold fct_cte; ring. } rewrite RiemannInt_P15. rewrite Rmult_assoc; replace ((x + h0 - x) * Rabs (/ h0)) with 1. { rewrite Rmult_1_r; unfold Rdiv; apply Rmult_lt_reg_l with 2; [ prove_sup0 | rewrite <- (Rmult_comm (/ 2)); rewrite <- Rmult_assoc; rewrite Rinv_r; [ rewrite Rmult_1_l; pattern eps at 1; rewrite <- Rplus_0_r; rewrite <-Rplus_diag; apply Rplus_lt_compat_l; assumption | discrR ] ]. } rewrite Rabs_right. { replace (x + h0 - x) with h0; [ idtac | ring ]. symmetry; apply Rinv_r. assumption. } apply Rle_ge; left; apply Rinv_0_lt_compat. elim Hle; intro. { apply Rplus_lt_reg_l with x; rewrite Rplus_0_r; assumption. } elim H5; symmetry ; apply Rplus_eq_reg_l with x; rewrite Rplus_0_r; assumption. - apply Rle_lt_trans with (RiemannInt (RiemannInt_P16 (RiemannInt_P1 (RiemannInt_P10 (-1) H7 (RiemannInt_P14 x (x + h0) (f x))))) * Rabs (/ h0)). { do 2 rewrite <- (Rmult_comm (Rabs (/ h0))); apply Rmult_le_compat_l. { apply Rabs_pos. } replace (RiemannInt (RiemannInt_P10 (-1) H7 (RiemannInt_P14 x (x + h0) (f x)))) with (- RiemannInt (RiemannInt_P1 (RiemannInt_P10 (-1) H7 (RiemannInt_P14 x (x + h0) (f x))))). { rewrite Rabs_Ropp; apply (RiemannInt_P17 (RiemannInt_P1 (RiemannInt_P10 (-1) H7 (RiemannInt_P14 x (x + h0) (f x)))) (RiemannInt_P16 (RiemannInt_P1 (RiemannInt_P10 (-1) H7 (RiemannInt_P14 x (x + h0) (f x)))))); auto with real. } symmetry ; apply RiemannInt_P8. } apply Rle_lt_trans with (RiemannInt (RiemannInt_P14 (x + h0) x (eps / 2)) * Rabs (/ h0)). { do 2 rewrite <- (Rmult_comm (Rabs (/ h0))); apply Rmult_le_compat_l. { apply Rabs_pos. } apply RiemannInt_P19. { auto with real. } intros; replace (f x1 + -1 * fct_cte (f x) x1) with (f x1 - f x). { unfold fct_cte; case (Req_dec x x1); intro. { rewrite H9; unfold Rminus; rewrite Rplus_opp_r; rewrite Rabs_R0; left; assumption. } elim H3; intros; left; apply H11. repeat split. { assumption. } rewrite Rabs_left. { apply Rplus_lt_reg_l with (x1 - x0); replace (x1 - x0 + x0) with x1 by ring. replace (x1 - x0 + - (x1 - x)) with (x - x0) by ring. apply Rle_lt_trans with (x + h0). { unfold Rminus; apply Rplus_le_compat_l; apply Ropp_le_cancel. rewrite Ropp_involutive; apply Rle_trans with (Rabs h0). { rewrite <- Rabs_Ropp; apply RRle_abs. } apply Rle_trans with del; [ left; assumption | unfold del; apply Rmin_l ]. } elim H8; intros; assumption. } lra. } unfold fct_cte; ring. } rewrite RiemannInt_P15. rewrite Rmult_assoc; replace ((x - (x + h0)) * Rabs (/ h0)) with 1. { lra. } rewrite Rabs_left. { field. lra. } apply Rinv_lt_0_compat. assert (H8 : x + h0 < x). { auto with real. } apply Rplus_lt_reg_l with x; rewrite Rplus_0_r; assumption. Qed. Lemma RiemannInt_P28 : forall (f:R -> R) (a b x:R) (h:a <= b) (C0:forall x:R, a <= x <= b -> continuity_pt f x), a <= x <= b -> derivable_pt_lim (primitive h (FTC_P1 h C0)) x (f x). Proof. intro f; intros; elim h; intro. 1:elim H; clear H; intros; elim H; intro. - elim H1; intro. { apply RiemannInt_P27; split; assumption. } set (f_b := fun x:R => f b * (x - b) + RiemannInt (FTC_P1 h C0 h (Rle_refl b))); rewrite H3. assert (H4 : derivable_pt_lim f_b b (f b)). { unfold f_b; pattern (f b) at 2; replace (f b) with (f b + 0) by ring. change (derivable_pt_lim ((fct_cte (f b) * (id - fct_cte b))%F + fct_cte (RiemannInt (FTC_P1 h C0 h (Rle_refl b)))) b ( f b + 0)). apply derivable_pt_lim_plus. { pattern (f b) at 2; replace (f b) with (0 * (id - fct_cte b)%F b + fct_cte (f b) b * 1) by (unfold fct_cte;ring). apply derivable_pt_lim_mult. { apply derivable_pt_lim_const. } replace 1 with (1 - 0); [ idtac | ring ]. apply derivable_pt_lim_minus. { apply derivable_pt_lim_id. } apply derivable_pt_lim_const. } apply derivable_pt_lim_const. } unfold derivable_pt_lim; intros; elim (H4 _ H5); intros; assert (H7 : continuity_pt f b). { apply C0; split; [ left; assumption | right; reflexivity ]. } assert (H8 : 0 < eps / 2). { unfold Rdiv; apply Rmult_lt_0_compat; [ assumption | apply Rinv_0_lt_compat; prove_sup0 ]. } elim (H7 _ H8); unfold D_x, no_cond, dist; simpl; unfold Rdist; intros; set (del := Rmin x0 (Rmin x1 (b - a))); assert (H10 : 0 < del). { unfold del; unfold Rmin; case (Rle_dec x1 (b - a)); intros. { destruct (Rle_dec x0 x1) as [Hle|Hnle]; [ apply (cond_pos x0) | elim H9; intros; assumption ]. } destruct (Rle_dec x0 (b - a)) as [Hle'|Hnle']; [ apply (cond_pos x0) | apply Rlt_0_minus; assumption ]. } split with (mkposreal _ H10); intros; destruct (Rcase_abs h0) as [Hle|Hnle]. + assert (H14 : b + h0 < b). { pattern b at 2; rewrite <- Rplus_0_r; apply Rplus_lt_compat_l; assumption. } assert (H13 : Riemann_integrable f (b + h0) b). { apply continuity_implies_RiemannInt. { left; assumption. } intros; apply C0; elim H13; intros; split; try assumption. apply Rle_trans with (b + h0); try assumption. apply Rplus_le_reg_l with (- a - h0). replace (- a - h0 + a) with (- h0); [ idtac | ring ]. replace (- a - h0 + (b + h0)) with (b - a); [ idtac | ring ]. apply Rle_trans with del. { apply Rle_trans with (Rabs h0). { rewrite <- Rabs_Ropp; apply RRle_abs. } left; assumption. } unfold del; apply Rle_trans with (Rmin x1 (b - a)); apply Rmin_r. } replace (primitive h (FTC_P1 h C0) (b + h0) - primitive h (FTC_P1 h C0) b) with (- RiemannInt H13). { replace (f b) with (- RiemannInt (RiemannInt_P14 (b + h0) b (f b)) / h0). 2:{ rewrite RiemannInt_P15. rewrite <- Ropp_mult_distr_l_reverse; apply Rmult_eq_reg_l with h0; [ repeat rewrite (Rmult_comm h0); unfold Rdiv; repeat rewrite Rmult_assoc; rewrite Rinv_l; [ ring | assumption ] | assumption ]. } rewrite <- Rabs_Ropp; unfold Rminus; unfold Rdiv; rewrite Ropp_mult_distr_l_reverse; rewrite Ropp_plus_distr; repeat rewrite Ropp_involutive; replace (RiemannInt H13 * / h0 + - RiemannInt (RiemannInt_P14 (b + h0) b (f b)) * / h0) with ((RiemannInt H13 - RiemannInt (RiemannInt_P14 (b + h0) b (f b))) / h0). 2:{ unfold Rdiv, Rminus; rewrite Rmult_plus_distr_r; ring. } replace (RiemannInt H13 - RiemannInt (RiemannInt_P14 (b + h0) b (f b))) with (RiemannInt (RiemannInt_P10 (-1) H13 (RiemannInt_P14 (b + h0) b (f b)))). 2:{ rewrite (RiemannInt_P13 H13 (RiemannInt_P14 (b + h0) b (f b)) (RiemannInt_P10 (-1) H13 (RiemannInt_P14 (b + h0) b (f b)))) ; ring. } unfold Rdiv; rewrite Rabs_mult; apply Rle_lt_trans with (RiemannInt (RiemannInt_P16 (RiemannInt_P10 (-1) H13 (RiemannInt_P14 (b + h0) b (f b)))) * Rabs (/ h0)). { do 2 rewrite <- (Rmult_comm (Rabs (/ h0))); apply Rmult_le_compat_l. { apply Rabs_pos. } apply (RiemannInt_P17 (RiemannInt_P10 (-1) H13 (RiemannInt_P14 (b + h0) b (f b))) (RiemannInt_P16 (RiemannInt_P10 (-1) H13 (RiemannInt_P14 (b + h0) b (f b))))); left; assumption. } apply Rle_lt_trans with (RiemannInt (RiemannInt_P14 (b + h0) b (eps / 2)) * Rabs (/ h0)). { do 2 rewrite <- (Rmult_comm (Rabs (/ h0))); apply Rmult_le_compat_l. { apply Rabs_pos. } apply RiemannInt_P19. { left; assumption. } intros; replace (f x2 + -1 * fct_cte (f b) x2) with (f x2 - f b) by (unfold fct_cte; ring). unfold fct_cte; case (Req_dec b x2); intro. { rewrite H16; unfold Rminus; rewrite Rplus_opp_r; rewrite Rabs_R0; left; assumption. } elim H9; intros; left; apply H18. repeat split. { assumption. } rewrite <- Rabs_Ropp; rewrite Ropp_minus_distr; rewrite Rabs_right. 2:{ apply Rle_ge; left; apply Rlt_0_minus; elim H15; intros; assumption. } apply Rplus_lt_reg_l with (x2 - x1); replace (x2 - x1 + (b - x2)) with (b - x1); [ idtac | ring ]. replace (x2 - x1 + x1) with x2; [ idtac | ring ]. apply Rlt_le_trans with (b + h0). 2: elim H15; intros; left; assumption. unfold Rminus; apply Rplus_lt_compat_l; apply Ropp_lt_cancel; rewrite Ropp_involutive; apply Rle_lt_trans with (Rabs h0). { rewrite <- Rabs_Ropp; apply RRle_abs. } apply Rlt_le_trans with del; [ assumption | unfold del; apply Rle_trans with (Rmin x1 (b - a)); [ apply Rmin_r | apply Rmin_l ] ]. } rewrite RiemannInt_P15. rewrite Rmult_assoc; replace ((b - (b + h0)) * Rabs (/ h0)) with 1. { lra. } rewrite Rabs_left. { apply Rmult_eq_reg_l with h0; [ do 2 rewrite (Rmult_comm h0); rewrite Rmult_assoc; rewrite Ropp_mult_distr_l_reverse; rewrite Rinv_l; [ ring | assumption ] | assumption ]. } apply Rinv_lt_0_compat; assumption. } cut (a <= b + h0). { cut (b + h0 <= b). 2:{ left; assumption. } intros; unfold primitive; destruct (Rle_dec a (b + h0)) as [Hle'|Hnle']; destruct (Rle_dec (b + h0) b) as [Hle''|[]]; destruct (Rle_dec a b) as [Hleab|[]]; destruct (Rle_dec b b) as [Hlebb|[]]; assumption || (right; reflexivity) || (try (left; assumption)). { rewrite <- (RiemannInt_P26 (FTC_P1 h C0 Hle' Hle'') H13 (FTC_P1 h C0 Hleab Hlebb)); ring. } elim Hnle'; assumption. } apply Rplus_le_reg_l with (- a - h0). replace (- a - h0 + a) with (- h0); [ idtac | ring ]. replace (- a - h0 + (b + h0)) with (b - a); [ idtac | ring ]. apply Rle_trans with del. { apply Rle_trans with (Rabs h0). { rewrite <- Rabs_Ropp; apply RRle_abs. } left; assumption. } unfold del; apply Rle_trans with (Rmin x1 (b - a)); apply Rmin_r. + cut (primitive h (FTC_P1 h C0) b = f_b b). { intro; cut (primitive h (FTC_P1 h C0) (b + h0) = f_b (b + h0)). { intro; rewrite H13; rewrite H14; apply H6. { assumption. } apply Rlt_le_trans with del; [ assumption | unfold del; apply Rmin_l ]. } assert (H14 : b < b + h0). { pattern b at 1; rewrite <- Rplus_0_r; apply Rplus_lt_compat_l. assert (H14 := Rge_le _ _ Hnle); elim H14; intro. { assumption. } elim H11; symmetry ; assumption. } unfold primitive; destruct (Rle_dec a (b + h0)) as [Hle|[]]; destruct (Rle_dec (b + h0) b) as [Hle'|Hnle']; [ elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ Hle' H14)) | unfold f_b; reflexivity | left; apply Rlt_trans with b; assumption | left; apply Rlt_trans with b; assumption ]. } unfold f_b; unfold Rminus; rewrite Rplus_opp_r; rewrite Rmult_0_r; rewrite Rplus_0_l; unfold primitive; destruct (Rle_dec a b) as [Hle'|Hnle']; destruct (Rle_dec b b) as [Hle''|[]]; [ apply RiemannInt_P5 | right; reflexivity | elim Hnle'; left; assumption | right; reflexivity ]. - (*****) set (f_a := fun x:R => f a * (x - a)); rewrite <- H2; assert (H3 : derivable_pt_lim f_a a (f a)). { unfold f_a; change (derivable_pt_lim (fct_cte (f a) * (id - fct_cte a)%F) a (f a)) ; pattern (f a) at 2; replace (f a) with (0 * (id - fct_cte a)%F a + fct_cte (f a) a * 1). { apply derivable_pt_lim_mult. { apply derivable_pt_lim_const. } replace 1 with (1 - 0); [ idtac | ring ]. apply derivable_pt_lim_minus. { apply derivable_pt_lim_id. } apply derivable_pt_lim_const. } unfold fct_cte; ring. } unfold derivable_pt_lim; intros; elim (H3 _ H4); intros. assert (H6 : continuity_pt f a). { apply C0; split; [ right; reflexivity | left; assumption ]. } assert (H7 : 0 < eps / 2). { unfold Rdiv; apply Rmult_lt_0_compat; [ assumption | apply Rinv_0_lt_compat; prove_sup0 ]. } elim (H6 _ H7); unfold D_x, no_cond, dist; simpl; unfold Rdist; intros. set (del := Rmin x0 (Rmin x1 (b - a))). assert (H9 : 0 < del). { unfold del; unfold Rmin. case (Rle_dec x1 (b - a)); intros. { case (Rle_dec x0 x1); intro. { apply (cond_pos x0). } elim H8; intros; assumption. } case (Rle_dec x0 (b - a)); intro. { apply (cond_pos x0). } apply Rlt_0_minus; assumption. } split with (mkposreal _ H9). intros; destruct (Rcase_abs h0) as [Hle|Hnle]. + assert (H12 : a + h0 < a). { pattern a at 2; rewrite <- Rplus_0_r; apply Rplus_lt_compat_l; assumption. } unfold primitive. destruct (Rle_dec a (a + h0)) as [Hle'|Hnle']; destruct (Rle_dec (a + h0) b) as [Hle''|Hnle'']; destruct (Rle_dec a a) as [Hleaa|[]]; destruct (Rle_dec a b) as [Hleab|[]]; try (left; assumption) || (right; reflexivity). * elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ Hle' H12)). * elim Hnle''; left; apply Rlt_trans with a; assumption. * rewrite RiemannInt_P9; replace 0 with (f_a a). { replace (f a * (a + h0 - a)) with (f_a (a + h0)). { apply H5; try assumption. apply Rlt_le_trans with del; [ assumption | unfold del; apply Rmin_l ]. } unfold f_a; ring. } unfold f_a; ring. * elim Hnle''; left; apply Rlt_trans with a; assumption. + assert (H12 : a < a + h0). { pattern a at 1; rewrite <- Rplus_0_r; apply Rplus_lt_compat_l. assert (H12 := Rge_le _ _ Hnle); elim H12; intro. { assumption. } elim H10; symmetry ; assumption. } assert (H13 : Riemann_integrable f a (a + h0)). { apply continuity_implies_RiemannInt. { left; assumption. } intros; apply C0; elim H13; intros; split; try assumption. apply Rle_trans with (a + h0); try assumption. apply Rplus_le_reg_l with (- b - h0). replace (- b - h0 + b) with (- h0); [ idtac | ring ]. replace (- b - h0 + (a + h0)) with (a - b); [ idtac | ring ]. apply Ropp_le_cancel; rewrite Ropp_involutive; rewrite Ropp_minus_distr; apply Rle_trans with del. { apply Rle_trans with (Rabs h0); [ apply RRle_abs | left; assumption ]. } unfold del; apply Rle_trans with (Rmin x1 (b - a)); apply Rmin_r. } replace (primitive h (FTC_P1 h C0) (a + h0) - primitive h (FTC_P1 h C0) a) with (RiemannInt H13). { replace (f a) with (RiemannInt (RiemannInt_P14 a (a + h0) (f a)) / h0). 2:{ rewrite RiemannInt_P15. rewrite Rplus_comm; unfold Rminus; rewrite Rplus_assoc; rewrite Rplus_opp_r; rewrite Rplus_0_r; unfold Rdiv; rewrite Rmult_assoc; rewrite Rinv_r; [ ring | assumption ]. } replace (RiemannInt H13 / h0 - RiemannInt (RiemannInt_P14 a (a + h0) (f a)) / h0) with ((RiemannInt H13 - RiemannInt (RiemannInt_P14 a (a + h0) (f a))) / h0). 2:{ unfold Rdiv, Rminus; rewrite Rmult_plus_distr_r; ring. } replace (RiemannInt H13 - RiemannInt (RiemannInt_P14 a (a + h0) (f a))) with (RiemannInt (RiemannInt_P10 (-1) H13 (RiemannInt_P14 a (a + h0) (f a)))). 2:{ rewrite (RiemannInt_P13 H13 (RiemannInt_P14 a (a + h0) (f a)) (RiemannInt_P10 (-1) H13 (RiemannInt_P14 a (a + h0) (f a)))) ; ring. } unfold Rdiv; rewrite Rabs_mult; apply Rle_lt_trans with (RiemannInt (RiemannInt_P16 (RiemannInt_P10 (-1) H13 (RiemannInt_P14 a (a + h0) (f a)))) * Rabs (/ h0)). { do 2 rewrite <- (Rmult_comm (Rabs (/ h0))); apply Rmult_le_compat_l. { apply Rabs_pos. } apply (RiemannInt_P17 (RiemannInt_P10 (-1) H13 (RiemannInt_P14 a (a + h0) (f a))) (RiemannInt_P16 (RiemannInt_P10 (-1) H13 (RiemannInt_P14 a (a + h0) (f a))))); left; assumption. } apply Rle_lt_trans with (RiemannInt (RiemannInt_P14 a (a + h0) (eps / 2)) * Rabs (/ h0)). { do 2 rewrite <- (Rmult_comm (Rabs (/ h0))); apply Rmult_le_compat_l. { apply Rabs_pos. } apply RiemannInt_P19. { left; assumption. } intros; replace (f x2 + -1 * fct_cte (f a) x2) with (f x2 - f a). 2:{ unfold fct_cte; ring. } unfold fct_cte; case (Req_dec a x2); intro. { rewrite H15; unfold Rminus; rewrite Rplus_opp_r; rewrite Rabs_R0; left; assumption. } elim H8; intros; left; apply H17; repeat split. { assumption. } rewrite Rabs_right. { apply Rplus_lt_reg_l with a; replace (a + (x2 - a)) with x2; [ idtac | ring ]. apply Rlt_le_trans with (a + h0). { elim H14; intros; assumption. } apply Rplus_le_compat_l; left; apply Rle_lt_trans with (Rabs h0). { apply RRle_abs. } apply Rlt_le_trans with del; [ assumption | unfold del; apply Rle_trans with (Rmin x1 (b - a)); [ apply Rmin_r | apply Rmin_l ] ]. } apply Rle_ge; left; apply Rlt_0_minus; elim H14; intros; assumption. } rewrite RiemannInt_P15. rewrite Rmult_assoc; replace ((a + h0 - a) * Rabs (/ h0)) with 1. { lra. } rewrite Rabs_right. { rewrite Rplus_comm; unfold Rminus; rewrite Rplus_assoc; rewrite Rplus_opp_r; rewrite Rplus_0_r; rewrite Rinv_r; [ reflexivity | assumption ]. } apply Rle_ge; left; apply Rinv_0_lt_compat; assert (H14 := Rge_le _ _ Hnle); elim H14; intro. { assumption. } elim H10; symmetry ; assumption. } cut (a <= a + h0). 2:left;assumption. cut (a + h0 <= b). { intros; unfold primitive. decide (Rle_dec (a+h0) b) with H14. decide (Rle_dec a a) with (Rle_refl a). decide (Rle_dec a (a+h0)) with H15. decide (Rle_dec a b) with h. rewrite RiemannInt_P9; unfold Rminus; rewrite Ropp_0; rewrite Rplus_0_r; apply RiemannInt_P5. } apply Rplus_le_reg_l with (- a); replace (- a + (a + h0)) with h0; [ idtac | ring ]. rewrite Rplus_comm; apply Rle_trans with del; [ apply Rle_trans with (Rabs h0); [ apply RRle_abs | left; assumption ] | unfold del; apply Rle_trans with (Rmin x1 (b - a)); apply Rmin_r ]. - (*****) assert (H1 : x = a). { rewrite <- H0 in H; elim H; intros; apply Rle_antisym; assumption. } set (f_a := fun x:R => f a * (x - a)). assert (H2 : derivable_pt_lim f_a a (f a)). { unfold f_a; change (derivable_pt_lim (fct_cte (f a) * (id - fct_cte a)%F) a (f a)) ; pattern (f a) at 2; replace (f a) with (0 * (id - fct_cte a)%F a + fct_cte (f a) a * 1). { apply derivable_pt_lim_mult. { apply derivable_pt_lim_const. } replace 1 with (1 - 0); [ idtac | ring ]. apply derivable_pt_lim_minus. { apply derivable_pt_lim_id. } apply derivable_pt_lim_const. } unfold fct_cte; ring. } set (f_b := fun x:R => f b * (x - b) + RiemannInt (FTC_P1 h C0 h (Rle_refl b))). assert (H3 : derivable_pt_lim f_b b (f b)). { unfold f_b; pattern (f b) at 2; replace (f b) with (f b + 0). { change (derivable_pt_lim ((fct_cte (f b) * (id - fct_cte b))%F + fct_cte (RiemannInt (FTC_P1 h C0 h (Rle_refl b)))) b ( f b + 0)). apply derivable_pt_lim_plus. { pattern (f b) at 2; replace (f b) with (0 * (id - fct_cte b)%F b + fct_cte (f b) b * 1). { apply derivable_pt_lim_mult. { apply derivable_pt_lim_const. } replace 1 with (1 - 0); [ idtac | ring ]. apply derivable_pt_lim_minus. { apply derivable_pt_lim_id. } apply derivable_pt_lim_const. } unfold fct_cte; ring. } apply derivable_pt_lim_const. } ring. } unfold derivable_pt_lim; intros; elim (H2 _ H4); intros; elim (H3 _ H4); intros; set (del := Rmin x0 x1). assert (H7 : 0 < del). { unfold del; unfold Rmin; destruct (Rle_dec x0 x1) as [Hle|Hnle]. { apply (cond_pos x0). } apply (cond_pos x1). } split with (mkposreal _ H7); intros; destruct (Rcase_abs h0) as [Hle|Hnle]. { assert (H10 : a + h0 < a). { pattern a at 2; rewrite <- Rplus_0_r; apply Rplus_lt_compat_l; assumption. } rewrite H1; unfold primitive. apply (decide_left (Rle_dec a b) h); intro h'. assert (H11:~ a<=a+h0) by auto using Rlt_not_le. decide (Rle_dec a (a+h0)) with H11. decide (Rle_dec a a) with (Rle_refl a). rewrite RiemannInt_P9; replace 0 with (f_a a). { replace (f a * (a + h0 - a)) with (f_a (a + h0)). { apply H5; try assumption. apply Rlt_le_trans with del; try assumption. unfold del; apply Rmin_l. } unfold f_a; ring. } unfold f_a; ring. } assert (H10 : a < a + h0). { pattern a at 1; rewrite <- Rplus_0_r; apply Rplus_lt_compat_l. assert (H10 := Rge_le _ _ Hnle); elim H10; intro. { assumption. } elim H8; symmetry ; assumption. } rewrite H0 in H1; rewrite H1; unfold primitive. decide (Rle_dec a b) with h. decide (Rle_dec b b) with (Rle_refl b). assert (H12 : a<=b+h0) by (eauto using Rlt_le_trans with real). decide (Rle_dec a (b+h0)) with H12. rewrite H0 in H10. assert (H13 : ~b+h0<=b) by (auto using Rlt_not_le). decide (Rle_dec (b+h0) b) with H13. replace (RiemannInt (FTC_P1 h C0 hbis H11)) with (f_b b). { fold (f_b (b + h0)). apply H6; try assumption. apply Rlt_le_trans with del; try assumption. unfold del; apply Rmin_r. } unfold f_b; unfold Rminus; rewrite Rplus_opp_r; rewrite Rmult_0_r; rewrite Rplus_0_l; apply RiemannInt_P5. Qed. Lemma RiemannInt_P29 : forall (f:R -> R) a b (h:a <= b) (C0:forall x:R, a <= x <= b -> continuity_pt f x), antiderivative f (primitive h (FTC_P1 h C0)) a b. Proof. intro f; intros; unfold antiderivative; split; try assumption; intros; assert (H0 := RiemannInt_P28 h C0 H); assert (H1 : derivable_pt (primitive h (FTC_P1 h C0)) x); [ unfold derivable_pt; split with (f x); apply H0 | split with H1; symmetry ; apply derive_pt_eq_0; apply H0 ]. Qed. Lemma RiemannInt_P30 : forall (f:R -> R) (a b:R), a <= b -> (forall x:R, a <= x <= b -> continuity_pt f x) -> { g:R -> R | antiderivative f g a b }. Proof. intros; split with (primitive H (FTC_P1 H H0)); apply RiemannInt_P29. Qed. Record C1_fun : Type := mkC1 {c1 :> R -> R; diff0 : derivable c1; cont1 : continuity (derive c1 diff0)}. Lemma RiemannInt_P31 : forall (f:C1_fun) (a b:R), a <= b -> antiderivative (derive f (diff0 f)) f a b. Proof. intro f; intros; unfold antiderivative; split; try assumption; intros; split with (diff0 f x); reflexivity. Qed. Lemma RiemannInt_P32 : forall (f:C1_fun) (a b:R), Riemann_integrable (derive f (diff0 f)) a b. Proof. intro f; intros; destruct (Rle_dec a b) as [Hle|Hnle]; [ apply continuity_implies_RiemannInt; try assumption; intros; apply (cont1 f) | assert (H : b <= a); [ auto with real | apply RiemannInt_P1; apply continuity_implies_RiemannInt; try assumption; intros; apply (cont1 f) ] ]. Qed. Lemma RiemannInt_P33 : forall (f:C1_fun) (a b:R) (pr:Riemann_integrable (derive f (diff0 f)) a b), a <= b -> RiemannInt pr = f b - f a. Proof. intro f; intros; assert (H0 : forall x:R, a <= x <= b -> continuity_pt (derive f (diff0 f)) x). { intros; apply (cont1 f). } rewrite (RiemannInt_P20 H (FTC_P1 H H0) pr); assert (H1 := RiemannInt_P29 H H0); assert (H2 := RiemannInt_P31 f H); elim (antiderivative_Ucte (derive f (diff0 f)) _ _ _ _ H1 H2); intros C H3; repeat rewrite H3; [ ring | split; [ right; reflexivity | assumption ] | split; [ assumption | right; reflexivity ] ]. Qed. Lemma FTC_Riemann : forall (f:C1_fun) (a b:R) (pr:Riemann_integrable (derive f (diff0 f)) a b), RiemannInt pr = f b - f a. Proof. intro f; intros; destruct (Rle_dec a b) as [Hle|Hnle]; [ apply RiemannInt_P33; assumption | assert (H : b <= a); [ auto with real | assert (H0 := RiemannInt_P1 pr); rewrite (RiemannInt_P8 pr H0); rewrite (RiemannInt_P33 _ H0 H); ring ] ]. Qed. (* RiemannInt *) Lemma RiemannInt_const_bound : forall f a b l u (h : Riemann_integrable f a b), a <= b -> (forall x, a < x < b -> l <= f x <= u) -> l * (b - a) <= RiemannInt h <= u * (b - a). intros f a b l u ri ab intf. rewrite <- !(fun l => RiemannInt_P15 (RiemannInt_P14 a b l)). split; apply RiemannInt_P19; try assumption; intros x intx; unfold fct_cte; destruct (intf x intx); assumption. Qed. Lemma Riemann_integrable_scal : forall f a b k, Riemann_integrable f a b -> Riemann_integrable (fun x => k * f x) a b. intros f a b k ri. apply Riemann_integrable_ext with (f := fun x => 0 + k * f x). { intros; ring. } apply (RiemannInt_P10 _ (RiemannInt_P14 _ _ 0) ri). Qed. Arguments Riemann_integrable_scal [f a b] k _ eps. Lemma Riemann_integrable_Ropp : forall f a b, Riemann_integrable f a b -> Riemann_integrable (fun x => - f x) a b. intros ff a b h. apply Riemann_integrable_ext with (f := fun x => (-1) * ff x). { intros; ring. } apply Riemann_integrable_scal; assumption. Qed. Arguments Riemann_integrable_Ropp [f a b] _ eps. coq-8.20.0/theories/Reals/RiemannInt_SF.v000066400000000000000000003244451466560755400201340ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* Prop) : Prop := exists n : nat, (forall i:nat, I i -> (i <= n)%nat). Lemma IZN_var : forall z:Z, (0 <= z)%Z -> {n : nat | z = Z.of_nat n}. Proof. intros; apply Z_of_nat_complete_inf; assumption. Qed. Lemma Nzorn : forall I:nat -> Prop, (exists n : nat, I n) -> Nbound I -> { n:nat | I n /\ (forall i:nat, I i -> (i <= n)%nat) }. Proof. intros I H H0; set (E := fun x:R => exists i : nat, I i /\ INR i = x); assert (H1 : bound E). { unfold Nbound in H0; elim H0; intros N H1; unfold bound; exists (INR N); unfold is_upper_bound; intros; unfold E in H2; elim H2; intros; elim H3; intros; rewrite <- H5; apply le_INR; apply H1; assumption. } assert (H2 : exists x : R, E x). { elim H; intros; exists (INR x); unfold E; exists x; split; [ assumption | reflexivity ]. } destruct (completeness E H1 H2) as (x,(H4,H5)); unfold is_upper_bound in H4, H5; assert (H6 : 0 <= x). { destruct H2 as (x0,H6). remember H6 as H7. destruct H7 as (x1,(H8,H9)). apply Rle_trans with x0; [ rewrite <- H9; change (INR 0 <= INR x1); apply le_INR; apply Nat.le_0_l | apply H4; assumption ]. } assert (H7 := archimed x); elim H7; clear H7; intros; assert (H9 : x <= IZR (up x) - 1). { apply H5; intros x0 H9. assert (H10 := H4 _ H9); unfold E in H9; elim H9; intros x1 (H12,<-). apply Rplus_le_reg_l with 1; replace (1 + (IZR (up x) - 1)) with (IZR (up x)); [ idtac | ring ]; replace (1 + INR x1) with (INR (S x1)); [ idtac | rewrite S_INR; ring ]. assert (H14 : (0 <= up x)%Z). { apply le_IZR; apply Rle_trans with x; [ apply H6 | left; assumption ]. } destruct (IZN _ H14) as (x2,H15). rewrite H15, <- INR_IZR_INZ; apply le_INR; apply Nat.le_succ_l. apply INR_lt; apply Rle_lt_trans with x; [ assumption | rewrite INR_IZR_INZ; rewrite <- H15; assumption ]. } assert (H10 : x = IZR (up x) - 1). { apply Rle_antisym; [ assumption | apply Rplus_le_reg_l with (- x + 1); replace (- x + 1 + (IZR (up x) - 1)) with (IZR (up x) - x); [ idtac | ring ]; replace (- x + 1 + x) with 1; [ assumption | ring ] ]. } assert (H11 : (0 <= up x)%Z). { apply le_IZR; apply Rle_trans with x; [ apply H6 | left; assumption ]. } assert (H12 := IZN_var H11); elim H12; clear H12; intros x0 H8; assert (H13 : E x). 2:{ split with (pred x0); unfold E in H13; elim H13; intros; elim H12; intros; rewrite H10 in H15; rewrite H8 in H15; rewrite <- INR_IZR_INZ in H15; assert (H16 : INR x0 = INR x1 + 1). { rewrite H15; ring. } rewrite <- S_INR in H16; assert (H17 := INR_eq _ _ H16); rewrite H17; simpl; split. { assumption. } intros; apply INR_le; rewrite H15; rewrite <- H15; elim H12; intros; rewrite H20; apply H4; unfold E; exists i; split; [ assumption | reflexivity ]. } elim (classic (E x)); intro; try assumption. cut (forall y:R, E y -> y <= x - 1). { intro H13; assert (H14 := H5 _ H13); lra. } intros y H13; assert (H14 := H4 _ H13); elim H14; intro H15; unfold E in H13; elim H13; intros x1 H16; elim H16; intros H17 H18; apply Rplus_le_reg_l with 1. 2:{ rewrite H15 in H13; elim H12; assumption. } replace (1 + (x - 1)) with x; [ idtac | ring ]; rewrite <- H18; replace (1 + INR x1) with (INR (S x1)); [ idtac | rewrite S_INR; ring ]. cut (x = INR (pred x0)). { intro H19; rewrite H19; apply le_INR; apply Nat.le_succ_l; apply INR_lt; rewrite H18; rewrite <- H19; assumption. } rewrite H10; rewrite H8; rewrite <- INR_IZR_INZ; rewrite <- (minus_INR _ 1). { apply f_equal; case x0; [ reflexivity | intro; apply Nat.sub_0_r ]. } induction x0 as [|x0 Hrecx0]. { rewrite H8 in H3. rewrite <- INR_IZR_INZ in H3; simpl in H3. elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H6 H3)). } apply le_n_S; apply Nat.le_0_l. Qed. (*******************************************) (** * Step functions *) (*******************************************) Definition open_interval (a b x:R) : Prop := a < x < b. Definition co_interval (a b x:R) : Prop := a <= x < b. Definition adapted_couple (f:R -> R) (a b:R) (l lf:list R) : Prop := ordered_Rlist l /\ pos_Rl l 0 = Rmin a b /\ pos_Rl l (pred (length l)) = Rmax a b /\ length l = S (length lf) /\ (forall i:nat, (i < pred (length l))%nat -> constant_D_eq f (open_interval (pos_Rl l i) (pos_Rl l (S i))) (pos_Rl lf i)). Definition adapted_couple_opt (f:R -> R) (a b:R) (l lf:list R) := adapted_couple f a b l lf /\ (forall i:nat, (i < pred (length lf))%nat -> pos_Rl lf i <> pos_Rl lf (S i) \/ f (pos_Rl l (S i)) <> pos_Rl lf i) /\ (forall i:nat, (i < pred (length l))%nat -> pos_Rl l i <> pos_Rl l (S i)). Definition is_subdivision (f:R -> R) (a b:R) (l:list R) : Type := { l0:list R & adapted_couple f a b l l0 }. Definition IsStepFun (f:R -> R) (a b:R) : Type := { l:list R & is_subdivision f a b l }. (** ** Class of step functions *) Record StepFun (a b:R) : Type := mkStepFun {fe :> R -> R; pre : IsStepFun fe a b}. Definition subdivision (a b:R) (f:StepFun a b) : list R := projT1 (pre f). Definition subdivision_val (a b:R) (f:StepFun a b) : list R := match projT2 (pre f) with | existT _ a b => a end. Fixpoint Int_SF (l k:list R) : R := match l with | nil => 0 | cons a l' => match k with | nil => 0 | cons x nil => 0 | cons x (cons y k') => a * (y - x) + Int_SF l' (cons y k') end end. (** ** Integral of step functions *) Definition RiemannInt_SF (a b:R) (f:StepFun a b) : R := match Rle_dec a b with | left _ => Int_SF (subdivision_val f) (subdivision f) | right _ => - Int_SF (subdivision_val f) (subdivision f) end. (************************************) (** ** Properties of step functions *) (************************************) Lemma StepFun_P1 : forall (a b:R) (f:StepFun a b), adapted_couple f a b (subdivision f) (subdivision_val f). Proof. intros a b f; unfold subdivision_val; case (projT2 (pre f)) as (x,H); apply H. Qed. Lemma StepFun_P2 : forall (a b:R) (f:R -> R) (l lf:list R), adapted_couple f a b l lf -> adapted_couple f b a l lf. Proof. unfold adapted_couple; intros; decompose [and] H; clear H; repeat split; try assumption. - rewrite H2; unfold Rmin; case (Rle_dec a b); intro; case (Rle_dec b a); intro; try reflexivity. + apply Rle_antisym; assumption. + apply Rle_antisym; auto with real. - rewrite H1; unfold Rmax; case (Rle_dec a b); intro; case (Rle_dec b a); intro; try reflexivity. + apply Rle_antisym; assumption. + apply Rle_antisym; auto with real. Qed. Lemma StepFun_P3 : forall a b c:R, a <= b -> adapted_couple (fct_cte c) a b (cons a (cons b nil)) (cons c nil). Proof. intros; unfold adapted_couple; repeat split. - unfold ordered_Rlist; intros; simpl in H0; inversion H0; [ simpl; assumption | elim (Nat.nle_succ_0 _ H2) ]. - simpl; unfold Rmin; decide (Rle_dec a b) with H; reflexivity. - simpl; unfold Rmax; decide (Rle_dec a b) with H; reflexivity. - unfold constant_D_eq, open_interval; intros; simpl in H0; inversion H0; [ reflexivity | elim (Nat.nle_succ_0 _ H3) ]. Qed. Lemma StepFun_P4 : forall a b c:R, IsStepFun (fct_cte c) a b. Proof. intros; unfold IsStepFun; destruct (Rle_dec a b) as [Hle|Hnle]. - apply existT with (cons a (cons b nil)); unfold is_subdivision; apply existT with (cons c nil); apply (StepFun_P3 c Hle). - apply existT with (cons b (cons a nil)); unfold is_subdivision; apply existT with (cons c nil); apply StepFun_P2; apply StepFun_P3; auto with real. Qed. Lemma StepFun_P5 : forall (a b:R) (f:R -> R) (l:list R), is_subdivision f a b l -> is_subdivision f b a l. Proof. destruct 1 as (x,(H0,(H1,(H2,(H3,H4))))); exists x; repeat split; try assumption. - rewrite H1; apply Rmin_comm. - rewrite H2; apply Rmax_comm. Qed. Lemma StepFun_P6 : forall (f:R -> R) (a b:R), IsStepFun f a b -> IsStepFun f b a. Proof. unfold IsStepFun; intros; elim X; intros; apply existT with x; apply StepFun_P5; assumption. Qed. Lemma StepFun_P7 : forall (a b r1 r2 r3:R) (f:R -> R) (l lf:list R), a <= b -> adapted_couple f a b (cons r1 (cons r2 l)) (cons r3 lf) -> adapted_couple f r2 b (cons r2 l) lf. Proof. unfold adapted_couple; intros; decompose [and] H0; clear H0; assert (H5 : Rmax a b = b). { unfold Rmax; decide (Rle_dec a b) with H; reflexivity. } assert (H7 : r2 <= b). { rewrite H5 in H2; rewrite <- H2; apply RList_P7; [ assumption | simpl; right; left; reflexivity ]. } repeat split. - apply RList_P4 with r1; assumption. - rewrite H5 in H2; unfold Rmin; decide (Rle_dec r2 b) with H7; reflexivity. - unfold Rmax; decide (Rle_dec r2 b) with H7. rewrite H5 in H2; rewrite <- H2; reflexivity. - simpl in H4; simpl; apply INR_eq; apply Rplus_eq_reg_l with 1; do 2 rewrite (Rplus_comm 1); do 2 rewrite <- S_INR; rewrite H4; reflexivity. - intros; unfold constant_D_eq, open_interval; intros; unfold constant_D_eq, open_interval in H6; assert (H9 : (S i < pred (length (cons r1 (cons r2 l))))%nat). + simpl; simpl in H0; apply -> Nat.succ_lt_mono; assumption. + assert (H10 := H6 _ H9); apply H10; assumption. Qed. Lemma StepFun_P8 : forall (f:R -> R) (l1 lf1:list R) (a b:R), adapted_couple f a b l1 lf1 -> a = b -> Int_SF lf1 l1 = 0. Proof. simple induction l1. { intros; induction lf1 as [| r lf1 Hreclf1]; reflexivity. } intros r r0. induction r0 as [ | r1 r2 H0]. - intros; induction lf1 as [| r1 lf1 Hreclf1]. + reflexivity. + unfold adapted_couple in H0; decompose [and] H0; clear H0; simpl in H5; discriminate. - intros H. induction lf1 as [| r3 lf1 Hreclf1]; intros a b H1 H2. + reflexivity. + simpl; cut (r = r1). * intros H3. rewrite H3; rewrite (H lf1 r b). -- ring. -- rewrite H3; apply StepFun_P7 with a r r3; [ right; assumption | assumption ]. -- clear H H0 Hreclf1; unfold adapted_couple in H1. decompose [and] H1. intros; simpl in H4; rewrite H4; unfold Rmin; case (Rle_dec a b); intro; [ assumption | reflexivity ]. * unfold adapted_couple in H1; decompose [and] H1; intros; apply Rle_antisym. -- apply (H3 0%nat); simpl; apply Nat.lt_0_succ. -- simpl in H5; rewrite H2 in H5; rewrite H5; replace (Rmin b b) with (Rmax a b); [ rewrite <- H4; apply RList_P7; [ assumption | simpl; right; left; reflexivity ] | unfold Rmin, Rmax; case (Rle_dec b b); case (Rle_dec a b); intros; try assumption || reflexivity ]. Qed. Lemma StepFun_P9 : forall (a b:R) (f:R -> R) (l lf:list R), adapted_couple f a b l lf -> a <> b -> (2 <= length l)%nat. Proof. intros; unfold adapted_couple in H; decompose [and] H; clear H; induction l as [| r l Hrecl]. - simpl in H4; discriminate. - induction l as [| r0 l Hrecl0]; [ simpl in H3; simpl in H2; generalize H3; generalize H2; unfold Rmin, Rmax; case (Rle_dec a b); intros; elim H0; rewrite <- H5; rewrite <- H7; reflexivity | simpl; do 2 apply le_n_S; apply Nat.le_0_l ]. Qed. Lemma StepFun_P10 : forall (f:R -> R) (l lf:list R) (a b:R), a <= b -> adapted_couple f a b l lf -> exists l' : list R, (exists lf' : list R, adapted_couple_opt f a b l' lf'). Proof. induction l as [ | r r0 H]. { intros; unfold adapted_couple in H0; decompose [and] H0; simpl in H4; discriminate. } intros; case (Req_dec a b); intro. { exists (cons a nil); exists nil; unfold adapted_couple_opt; unfold adapted_couple; unfold ordered_Rlist; repeat split; try (intros; simpl in H3; elim (Nat.nlt_0_r _ H3)). 1,2:simpl; rewrite <- H2; unfold Rmin,Rmax; case (Rle_dec a a); intro; reflexivity. } elim (RList_P20 _ (StepFun_P9 H1 H2)); intros t1 [t2 [t3 H3]]; induction lf as [| r1 lf Hreclf]. { unfold adapted_couple in H1; decompose [and] H1; rewrite H3 in H7; simpl in H7; discriminate. } clear Hreclf; assert (H4 : adapted_couple f t2 b r0 lf). { rewrite H3 in H1; assert (H4 := RList_P21 _ _ H3); simpl in H4; rewrite H4; eapply StepFun_P7; [ apply H0 | apply H1 ]. } assert (t2 <= b). { rewrite H3 in H1; clear H4; unfold adapted_couple in H1; decompose [and] H1; clear H1; clear H H7 H9; cut (Rmax a b = b); [ intro; rewrite H in H5; rewrite <- H5; apply RList_P7; [ assumption | simpl; right; left; reflexivity ] | unfold Rmax; decide (Rle_dec a b) with H0; reflexivity ]. } assert (H6 := H _ _ _ H5 H4); case (Req_dec t1 t2); intro Hyp_eq. { replace a with t2. { apply H6. } rewrite <- Hyp_eq; rewrite H3 in H1; unfold adapted_couple in H1; decompose [and] H1; clear H1; simpl in H9; rewrite H9; unfold Rmin; decide (Rle_dec a b) with H0; reflexivity. } elim H6; clear H6; intros l' [lf' H6]; case (Req_dec t2 b); intro. { exists (cons a (cons b nil)); exists (cons r1 nil); unfold adapted_couple_opt; unfold adapted_couple; repeat split. - unfold ordered_Rlist; intros; simpl in H8; inversion H8; [ simpl; assumption | elim (Nat.nle_succ_0 _ H10) ]. - simpl; unfold Rmin; decide (Rle_dec a b) with H0; reflexivity. - simpl; unfold Rmax; decide (Rle_dec a b) with H0; reflexivity. - intros; simpl in H8; inversion H8. + unfold constant_D_eq, open_interval; intros; simpl; simpl in H9; rewrite H3 in H1; unfold adapted_couple in H1; decompose [and] H1; apply (H16 0%nat). * simpl; apply Nat.lt_0_succ. * unfold open_interval; simpl; rewrite H7; simpl in H13; rewrite H13; unfold Rmin; decide (Rle_dec a b) with H0; assumption. + elim (Nat.nle_succ_0 _ H10). - intros; simpl in H8; elim (Nat.nlt_0_r _ H8). - intros; simpl in H8; inversion H8; [ simpl; assumption | elim (Nat.nle_succ_0 _ H10) ]. } assert (Hyp_min : Rmin t2 b = t2) by apply Rmin_left,H5. unfold adapted_couple in H6; elim H6; clear H6; intros; elim (RList_P20 _ (StepFun_P9 H6 H7)); intros s1 [s2 [s3 H9]]; induction lf' as [| r2 lf' Hreclf']. { unfold adapted_couple in H6; decompose [and] H6; rewrite H9 in H13; simpl in H13; discriminate. } clear Hreclf'; case (Req_dec r1 r2); intro. 1:case (Req_dec (f t2) r1); intro. - exists (cons t1 (cons s2 s3)); exists (cons r1 lf'); rewrite H3 in H1; rewrite H9 in H6; unfold adapted_couple in H6, H1; decompose [and] H1; decompose [and] H6; clear H1 H6; unfold adapted_couple_opt; unfold adapted_couple; repeat split. + unfold ordered_Rlist; intros; simpl in H1; induction i as [| i Hreci]. { simpl; apply Rle_trans with s1. { replace s1 with t2. { apply (H12 0%nat). simpl; apply Nat.lt_0_succ. } simpl in H19; rewrite H19; symmetry ; apply Hyp_min. } apply (H16 0%nat); simpl; apply Nat.lt_0_succ. } change (pos_Rl (cons s2 s3) i <= pos_Rl (cons s2 s3) (S i)); apply (H16 (S i)); simpl; assumption. + simpl; simpl in H14; rewrite H14; reflexivity. + simpl; simpl in H18; rewrite H18; unfold Rmax; decide (Rle_dec a b) with H0; decide (Rle_dec t2 b) with H5; reflexivity. + simpl; simpl in H20; apply H20. + intros; simpl in H1; unfold constant_D_eq, open_interval; intros; induction i as [| i Hreci]. { simpl; simpl in H6; destruct (total_order_T x t2) as [[Hlt|Heq]|Hgt]. - apply (H17 0%nat); [ simpl; apply Nat.lt_0_succ | unfold open_interval; simpl; elim H6; intros; split; assumption ]. - rewrite Heq; assumption. - rewrite H10; apply (H22 0%nat); [ simpl; apply Nat.lt_0_succ | unfold open_interval; simpl; replace s1 with t2; [ elim H6; intros; split; assumption | simpl in H19; rewrite H19; rewrite Hyp_min; reflexivity ] ]. } simpl; simpl in H6; apply (H22 (S i)); [ simpl; assumption | unfold open_interval; simpl; apply H6 ]. + intros; simpl in H1; rewrite H10; change (pos_Rl (cons r2 lf') i <> pos_Rl (cons r2 lf') (S i) \/ f (pos_Rl (cons s1 (cons s2 s3)) (S i)) <> pos_Rl (cons r2 lf') i) ; rewrite <- H9; elim H8; intros; apply H6; simpl; apply H1. + intros; induction i as [| i Hreci]. { simpl; red; intro; elim Hyp_eq; apply Rle_antisym. - apply (H12 0%nat); simpl; apply Nat.lt_0_succ. - rewrite <- Hyp_min; rewrite H6; simpl in H19; rewrite <- H19; apply (H16 0%nat); simpl; apply Nat.lt_0_succ. } elim H8; intros; rewrite H9 in H21; apply (H21 (S i)); simpl; simpl in H1; apply H1. - exists (cons t1 l'); exists (cons r1 (cons r2 lf')); rewrite H9 in H6; rewrite H3 in H1; unfold adapted_couple in H1, H6; decompose [and] H6; decompose [and] H1; clear H6 H1; unfold adapted_couple_opt; unfold adapted_couple; repeat split. + rewrite H9; unfold ordered_Rlist; intros; simpl in H1; induction i as [| i Hreci]. { simpl; replace s1 with t2. { apply (H16 0%nat); simpl; apply Nat.lt_0_succ. } simpl in H14; rewrite H14; rewrite Hyp_min; reflexivity. } change (pos_Rl (cons s1 (cons s2 s3)) i <= pos_Rl (cons s1 (cons s2 s3)) (S i)) ; apply (H12 i); simpl; apply Nat.succ_lt_mono; assumption. + simpl; simpl in H19; apply H19. + rewrite H9; simpl; simpl in H13; rewrite H13; unfold Rmax; decide (Rle_dec t2 b) with H5; decide (Rle_dec a b) with H0; reflexivity. + rewrite H9; simpl; simpl in H15; rewrite H15; reflexivity. + intros; simpl in H1; unfold constant_D_eq, open_interval; intros; induction i as [| i Hreci]. { simpl; rewrite H9 in H6; simpl in H6; apply (H22 0%nat). { simpl; apply Nat.lt_0_succ. } unfold open_interval; simpl. replace t2 with s1. { assumption. } simpl in H14; rewrite H14; rewrite Hyp_min; reflexivity. } change (f x = pos_Rl (cons r2 lf') i); clear Hreci; apply (H17 i). { simpl; rewrite H9 in H1; simpl in H1; apply Nat.succ_lt_mono; apply H1. } rewrite H9 in H6; unfold open_interval; apply H6. + intros; simpl in H1; induction i as [| i Hreci]. { simpl; rewrite H9; right; simpl; replace s1 with t2. { assumption. } simpl in H14; rewrite H14; rewrite Hyp_min; reflexivity. } elim H8; intros; apply (H6 i). simpl; apply Nat.succ_lt_mono; apply H1. + intros; rewrite H9; induction i as [| i Hreci]. { simpl; red; intro; elim Hyp_eq; apply Rle_antisym. { apply (H16 0%nat); simpl; apply Nat.lt_0_succ. } rewrite <- Hyp_min; rewrite H6; simpl in H14; rewrite <- H14; right; reflexivity. } elim H8; intros; rewrite <- H9; apply (H21 i); rewrite H9; rewrite H9 in H1; simpl; simpl in H1; apply Nat.succ_lt_mono; apply H1. - exists (cons t1 l'); exists (cons r1 (cons r2 lf')); rewrite H9 in H6; rewrite H3 in H1; unfold adapted_couple in H1, H6; decompose [and] H6; decompose [and] H1; clear H6 H1; unfold adapted_couple_opt; unfold adapted_couple; repeat split. + rewrite H9; unfold ordered_Rlist; intros; simpl in H1; induction i as [| i Hreci]. { simpl; replace s1 with t2. { apply (H15 0%nat); simpl; apply Nat.lt_0_succ. } simpl in H13; rewrite H13; rewrite Hyp_min; reflexivity. } change (pos_Rl (cons s1 (cons s2 s3)) i <= pos_Rl (cons s1 (cons s2 s3)) (S i)) ; apply (H11 i); simpl; apply Nat.succ_lt_mono; assumption. + simpl; simpl in H18; apply H18. + rewrite H9; simpl; simpl in H12; rewrite H12; unfold Rmax; decide (Rle_dec t2 b) with H5; decide (Rle_dec a b) with H0; reflexivity. + rewrite H9; simpl; simpl in H14; rewrite H14; reflexivity. + intros; simpl in H1; unfold constant_D_eq, open_interval; intros; induction i as [| i Hreci]. { simpl; rewrite H9 in H6; simpl in H6; apply (H21 0%nat). { simpl; apply Nat.lt_0_succ. } unfold open_interval; simpl; replace t2 with s1. { assumption. } simpl in H13; rewrite H13; rewrite Hyp_min; reflexivity. } change (f x = pos_Rl (cons r2 lf') i); clear Hreci; apply (H16 i). { simpl; rewrite H9 in H1; simpl in H1; apply Nat.succ_lt_mono; apply H1. } rewrite H9 in H6; unfold open_interval; apply H6. + intros; simpl in H1; induction i as [| i Hreci]. { simpl; left; assumption. } elim H8; intros; apply (H6 i). simpl; apply Nat.succ_lt_mono; apply H1. + intros; rewrite H9; induction i as [| i Hreci]. { simpl; red; intro; elim Hyp_eq; apply Rle_antisym. { apply (H15 0%nat); simpl; apply Nat.lt_0_succ. } rewrite <- Hyp_min; rewrite H6; simpl in H13; rewrite <- H13; right; reflexivity. } elim H8; intros; rewrite <- H9; apply (H20 i); rewrite H9; rewrite H9 in H1; simpl; simpl in H1; apply Nat.succ_lt_mono; apply H1. Qed. Lemma StepFun_P11 : forall (a b r r1 r3 s1 s2 r4:R) (r2 lf1 s3 lf2:list R) (f:R -> R), a < b -> adapted_couple f a b (cons r (cons r1 r2)) (cons r3 lf1) -> adapted_couple_opt f a b (cons s1 (cons s2 s3)) (cons r4 lf2) -> r1 <= s2. Proof. intros; unfold adapted_couple_opt in H1; elim H1; clear H1; intros; unfold adapted_couple in H0, H1; decompose [and] H0; decompose [and] H1; clear H0 H1; assert (H12 : r = s1). { simpl in H10; simpl in H5; congruence. } assert (H14 := H3 0%nat (Nat.lt_0_succ _)); simpl in H14; elim H14; intro. 2:{ rewrite <- H0; rewrite H12; apply (H7 0%nat); simpl; apply Nat.lt_0_succ. } assert (H15 := H7 0%nat (Nat.lt_0_succ _)); simpl in H15; elim H15; intro. 2:{ elim H2; clear H2; intros; assert (H17 := H16 0%nat); simpl in H17; elim (H17 (Nat.lt_0_succ _)); assumption. } rewrite <- H12 in H1; destruct (Rle_dec r1 s2) as [Hle|Hnle]; try assumption. assert (H16 : s2 < r1) by auto with real. induction s3 as [| r0 s3 Hrecs3]. { simpl in H9; rewrite H9 in H16; cut (r1 <= Rmax a b). { intro; elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H17 H16)). } rewrite <- H4; apply RList_P7; [ assumption | simpl; right; left; reflexivity ]. } clear Hrecs3; induction lf2 as [| r5 lf2 Hreclf2]. { simpl in H11; discriminate. } clear Hreclf2; assert (H17 : r3 = r4). { set (x := (r + s2) / 2); assert (H17 := H8 0%nat (Nat.lt_0_succ _)); assert (H18 := H13 0%nat (Nat.lt_0_succ _)); unfold constant_D_eq, open_interval in H17, H18; simpl in H17; simpl in H18; rewrite <- (H17 x). 1: apply H18;rewrite <- H12. 1,2: unfold x; lra. } assert (H18 : f s2 = r3). { apply (H8 0%nat); [ simpl; apply Nat.lt_0_succ | unfold open_interval; simpl; split; assumption ]. } assert (H19 : r3 = r5). 2:{ elim H2; intros; assert (H22 := H20 0%nat); simpl in H22; assert (H23 := H22 (Nat.lt_0_succ _)); elim H23; intro; [ elim H24; rewrite <- H17; rewrite <- H19; reflexivity | elim H24; rewrite <- H17; assumption ]. } assert (H19 := H7 1%nat); simpl in H19; assert (H20 := H19 (proj1 (Nat.succ_lt_mono _ _) (Nat.lt_0_succ _))); elim H20; intro. 2:{ elim H2; clear H2; intros; assert (H23 := H22 1%nat); simpl in H23; assert (H24 := H23 (proj1 (Nat.succ_lt_mono _ _) (Nat.lt_0_succ _))); elim H24; assumption. } set (x := (s2 + Rmin r1 r0) / 2); assert (H22 := H8 0%nat); assert (H23 := H13 1%nat); simpl in H22; simpl in H23; rewrite <- (H22 (Nat.lt_0_succ _) x). 1:apply (H23 (proj1 (Nat.succ_lt_mono _ _) (Nat.lt_0_succ _)) x). 1,2:unfold open_interval; simpl; unfold x; unfold Rmin;destruct (Rle_dec r1 r0);lra. Qed. Lemma StepFun_P12 : forall (a b:R) (f:R -> R) (l lf:list R), adapted_couple_opt f a b l lf -> adapted_couple_opt f b a l lf. Proof. unfold adapted_couple_opt; unfold adapted_couple; intros; decompose [and] H; clear H; repeat split; try assumption. - rewrite H0; unfold Rmin; case (Rle_dec a b); intro; case (Rle_dec b a); intro; try reflexivity. + apply Rle_antisym; assumption. + apply Rle_antisym; auto with real. - rewrite H3; unfold Rmax; case (Rle_dec a b); intro; case (Rle_dec b a); intro; try reflexivity. + apply Rle_antisym; assumption. + apply Rle_antisym; auto with real. Qed. Lemma StepFun_P13 : forall (a b r r1 r3 s1 s2 r4:R) (r2 lf1 s3 lf2:list R) (f:R -> R), a <> b -> adapted_couple f a b (cons r (cons r1 r2)) (cons r3 lf1) -> adapted_couple_opt f a b (cons s1 (cons s2 s3)) (cons r4 lf2) -> r1 <= s2. Proof. intros; destruct (total_order_T a b) as [[Hlt|Heq]|Hgt]. - eapply StepFun_P11; [ apply Hlt | apply H0 | apply H1 ]. - elim H; assumption. - eapply StepFun_P11; [ apply Hgt | apply StepFun_P2; apply H0 | apply StepFun_P12; apply H1 ]. Qed. Lemma StepFun_P14 : forall (f:R -> R) (l1 l2 lf1 lf2:list R) (a b:R), a <= b -> adapted_couple f a b l1 lf1 -> adapted_couple_opt f a b l2 lf2 -> Int_SF lf1 l1 = Int_SF lf2 l2. Proof. induction l1 as [ | r r0 H0]. { intros l2 lf1 lf2 a b Hyp H H0; unfold adapted_couple in H; decompose [and] H; clear H H0 H2 H3 H1 H6; simpl in H4; discriminate. } induction r0 as [|r1 r2 H]. { intros; case (Req_dec a b); intro. - unfold adapted_couple_opt in H2; elim H2; intros; rewrite (StepFun_P8 H4 H3); rewrite (StepFun_P8 H1 H3); reflexivity. - assert (H4 := StepFun_P9 H1 H3); simpl in H4; elim (Nat.nle_succ_0 _ (le_S_n _ _ H4)). } intros; clear H; unfold adapted_couple_opt in H3; elim H3; clear H3; intros; case (Req_dec a b); intro. { rewrite (StepFun_P8 H2 H4); rewrite (StepFun_P8 H H4); reflexivity. } assert (Hyp_min : Rmin a b = a). { unfold Rmin; decide (Rle_dec a b) with H1; reflexivity. } assert (Hyp_max : Rmax a b = b). { unfold Rmax; decide (Rle_dec a b) with H1; reflexivity. } elim (RList_P20 _ (StepFun_P9 H H4)); intros s1 [s2 [s3 H5]]; rewrite H5 in H; rewrite H5; induction lf1 as [| r3 lf1 Hreclf1]. { unfold adapted_couple in H2; decompose [and] H2; clear H H2 H4 H5 H3 H6 H8 H7 H11; simpl in H9; discriminate. } clear Hreclf1; induction lf2 as [| r4 lf2 Hreclf2]. { unfold adapted_couple in H; decompose [and] H; clear H H2 H4 H5 H3 H6 H8 H7 H11; simpl in H9; discriminate. } clear Hreclf2; assert (H6 : r = s1). { unfold adapted_couple in H, H2; decompose [and] H; decompose [and] H2; clear H H2; simpl in H13; simpl in H8; rewrite H13; rewrite H8; reflexivity. } assert (H7 : r3 = r4 \/ r = r1). { case (Req_dec r r1); intro. { right; assumption. } left; assert (r1 <= s2). { eapply StepFun_P13. - apply H4. - apply H2. - unfold adapted_couple_opt; split. + apply H. + rewrite H5 in H3; apply H3. } unfold adapted_couple in H2, H; decompose [and] H; decompose [and] H2; clear H H2; set (x := (r + r1) / 2); assert (H18 := H14 0%nat); assert (H20 := H19 0%nat); unfold constant_D_eq, open_interval in H18, H20; simpl in H18; simpl in H20; rewrite <- (H18 (Nat.lt_0_succ _) x). { rewrite <- (H20 (Nat.lt_0_succ _) x). { reflexivity. } assert (H21 := H13 0%nat (Nat.lt_0_succ _)); simpl in H21; elim H21; intro; [ idtac | elim H7; assumption ]; unfold x; lra. } rewrite <- H6; assert (H21 := H13 0%nat (Nat.lt_0_succ _)); simpl in H21; elim H21; intro; [ idtac | elim H7; assumption ]; unfold x; lra. } assert (H8 : r1 <= s2). { eapply StepFun_P13. - apply H4. - apply H2. - unfold adapted_couple_opt; split. + apply H. + rewrite H5 in H3; apply H3. } elim H7; intro. 2:{ simpl; rewrite H9; unfold Rminus; rewrite Rplus_opp_r; rewrite Rmult_0_r; rewrite Rplus_0_l; change (Int_SF lf1 (cons r1 r2) = Int_SF (cons r4 lf2) (cons s1 (cons s2 s3))) ; eapply H0. - apply H1. - assert (H10 : r = a). + unfold adapted_couple in H2; decompose [and] H2; clear H2; simpl in H12; rewrite H12; apply Hyp_min. + rewrite <- H9; rewrite H10; apply StepFun_P7 with a r r3; [ apply H1 | pattern a at 2; rewrite <- H10; pattern r at 2; rewrite H9; apply H2 ]. - rewrite H5 in H3; unfold adapted_couple_opt; split; assumption. } simpl; elim H8; intro. { replace (r4 * (s2 - s1)) with (r3 * (r1 - r) + r3 * (s2 - r1)); [ idtac | rewrite H9; rewrite H6; ring ]. rewrite Rplus_assoc; apply Rplus_eq_compat_l; change (Int_SF lf1 (cons r1 r2) = Int_SF (cons r3 lf2) (cons r1 (cons s2 s3))) ; apply H0 with r1 b. { unfold adapted_couple in H2; decompose [and] H2; clear H2; replace b with (Rmax a b); rewrite <- H12; apply RList_P7; [ assumption | simpl; right; left; reflexivity ]. } { eapply StepFun_P7. - apply H1. - apply H2. } unfold adapted_couple_opt; split. { apply StepFun_P7 with a a r3. { apply H1. } unfold adapted_couple in H2, H; decompose [and] H2; decompose [and] H; clear H H2; assert (H20 : r = a). { simpl in H13; rewrite H13; apply Hyp_min. } unfold adapted_couple; repeat split. - unfold ordered_Rlist; intros; simpl in H; induction i as [| i Hreci]. { simpl; rewrite <- H20; apply (H11 0%nat). simpl; apply Nat.lt_0_succ. } induction i as [| i Hreci0]. { simpl; assumption. } change (pos_Rl (cons s2 s3) i <= pos_Rl (cons s2 s3) (S i)); apply (H15 (S i)); simpl; apply Nat.succ_lt_mono; assumption. - simpl; symmetry ; apply Hyp_min. - rewrite <- H17; reflexivity. - simpl in H19; simpl; rewrite H19; reflexivity. - intros; simpl in H; unfold constant_D_eq, open_interval; intros; induction i as [| i Hreci]. { simpl; apply (H16 0%nat). { simpl; apply Nat.lt_0_succ. } simpl in H2; rewrite <- H20 in H2; unfold open_interval; simpl; apply H2. } clear Hreci; induction i as [| i Hreci]. { simpl; simpl in H2; rewrite H9; apply (H21 0%nat). { simpl; apply Nat.lt_0_succ. } unfold open_interval; simpl; elim H2; intros; split. { apply Rle_lt_trans with r1; try assumption; rewrite <- H6; apply (H11 0%nat); simpl; apply Nat.lt_0_succ. } assumption. } clear Hreci; simpl; apply (H21 (S i)). { simpl; apply Nat.succ_lt_mono; assumption. } unfold open_interval; apply H2. } elim H3; clear H3; intros; split. { rewrite H9; change (forall i:nat, (i < pred (length (cons r4 lf2)))%nat -> pos_Rl (cons r4 lf2) i <> pos_Rl (cons r4 lf2) (S i) \/ f (pos_Rl (cons s1 (cons s2 s3)) (S i)) <> pos_Rl (cons r4 lf2) i) ; rewrite <- H5; apply H3. } rewrite H5 in H11; intros; simpl in H12; induction i as [| i Hreci]. { simpl; red; intro; rewrite H13 in H10; elim (Rlt_irrefl _ H10). } clear Hreci; apply (H11 (S i)); simpl; apply H12. } rewrite H9; rewrite H10; rewrite H6; apply Rplus_eq_compat_l; rewrite <- H10; apply H0 with r1 b. { unfold adapted_couple in H2; decompose [and] H2; clear H2; replace b with (Rmax a b). rewrite <- H12; apply RList_P7; [ assumption | simpl; right; left; reflexivity ]. } { eapply StepFun_P7. - apply H1. - apply H2. } unfold adapted_couple_opt; split. { apply StepFun_P7 with a a r3. { apply H1. } unfold adapted_couple in H2, H; decompose [and] H2; decompose [and] H; clear H H2; assert (H20 : r = a). { simpl in H13; rewrite H13; apply Hyp_min. } unfold adapted_couple; repeat split. - unfold ordered_Rlist; intros; simpl in H; induction i as [| i Hreci]. { simpl; rewrite <- H20; apply (H11 0%nat); simpl; apply Nat.lt_0_succ. } rewrite H10; apply (H15 (S i)); simpl; assumption. - simpl; symmetry ; apply Hyp_min. - rewrite <- H17; rewrite H10; reflexivity. - simpl in H19; simpl; apply H19. - intros; simpl in H; unfold constant_D_eq, open_interval; intros; induction i as [| i Hreci]. { simpl; apply (H16 0%nat). { simpl; apply Nat.lt_0_succ. } simpl in H2; rewrite <- H20 in H2; unfold open_interval; simpl; apply H2. } clear Hreci; simpl; apply (H21 (S i)). { simpl; assumption. } rewrite <- H10; unfold open_interval; apply H2. } elim H3; clear H3; intros; split. - rewrite H5 in H3; intros; apply (H3 (S i)). simpl; replace (length lf2) with (S (pred (length lf2))). { apply -> Nat.succ_lt_mono; apply H12. } apply Nat.lt_succ_pred with 0%nat; apply Nat.neq_0_lt_0; red; intro; rewrite H13 in H12; elim (Nat.nlt_0_r _ H12). - intros; simpl in H12; rewrite H10; rewrite H5 in H11; apply (H11 (S i)); simpl; apply -> Nat.succ_lt_mono; apply H12. Qed. Lemma StepFun_P15 : forall (f:R -> R) (l1 l2 lf1 lf2:list R) (a b:R), adapted_couple f a b l1 lf1 -> adapted_couple_opt f a b l2 lf2 -> Int_SF lf1 l1 = Int_SF lf2 l2. Proof. intros; destruct (Rle_dec a b) as [Hle|Hnle]; [ apply (StepFun_P14 Hle H H0) | assert (H1 : b <= a); [ auto with real | eapply StepFun_P14; [ apply H1 | apply StepFun_P2; apply H | apply StepFun_P12; apply H0 ] ] ]. Qed. Lemma StepFun_P16 : forall (f:R -> R) (l lf:list R) (a b:R), adapted_couple f a b l lf -> exists l' : list R, (exists lf' : list R, adapted_couple_opt f a b l' lf'). Proof. intros; destruct (Rle_dec a b) as [Hle|Hnle]; [ apply (StepFun_P10 Hle H) | assert (H1 : b <= a); [ auto with real | assert (H2 := StepFun_P10 H1 (StepFun_P2 H)); elim H2; intros l' [lf' H3]; exists l'; exists lf'; apply StepFun_P12; assumption ] ]. Qed. Lemma StepFun_P17 : forall (f:R -> R) (l1 l2 lf1 lf2:list R) (a b:R), adapted_couple f a b l1 lf1 -> adapted_couple f a b l2 lf2 -> Int_SF lf1 l1 = Int_SF lf2 l2. Proof. intros; elim (StepFun_P16 H); intros l' [lf' H1]; rewrite (StepFun_P15 H H1); rewrite (StepFun_P15 H0 H1); reflexivity. Qed. Lemma StepFun_P18 : forall a b c:R, RiemannInt_SF (mkStepFun (StepFun_P4 a b c)) = c * (b - a). Proof. intros; unfold RiemannInt_SF; case (Rle_dec a b); intro. - replace (Int_SF (subdivision_val (mkStepFun (StepFun_P4 a b c))) (subdivision (mkStepFun (StepFun_P4 a b c)))) with (Int_SF (cons c nil) (cons a (cons b nil))); [ simpl; ring | apply StepFun_P17 with (fct_cte c) a b; [ apply StepFun_P3; assumption | apply (StepFun_P1 (mkStepFun (StepFun_P4 a b c))) ] ]. - replace (Int_SF (subdivision_val (mkStepFun (StepFun_P4 a b c))) (subdivision (mkStepFun (StepFun_P4 a b c)))) with (Int_SF (cons c nil) (cons b (cons a nil))); [ simpl; ring | apply StepFun_P17 with (fct_cte c) a b; [ apply StepFun_P2; apply StepFun_P3; auto with real | apply (StepFun_P1 (mkStepFun (StepFun_P4 a b c))) ] ]. Qed. Lemma StepFun_P19 : forall (l1:list R) (f g:R -> R) (l:R), Int_SF (FF l1 (fun x:R => f x + l * g x)) l1 = Int_SF (FF l1 f) l1 + l * Int_SF (FF l1 g) l1. Proof. intros; induction l1 as [| r l1 Hrecl1]; [ simpl; ring | induction l1 as [| r0 l1 Hrecl0]; simpl; [ ring | simpl in Hrecl1; rewrite Hrecl1; ring ] ]. Qed. Lemma StepFun_P20 : forall (l:list R) (f:R -> R), (0 < length l)%nat -> length l = S (length (FF l f)). Proof. intros l f H; induction l; [ elim (Nat.lt_irrefl _ H) | simpl; rewrite RList_P18; rewrite RList_P14; reflexivity ]. Qed. Lemma StepFun_P21 : forall (a b:R) (f:R -> R) (l:list R), is_subdivision f a b l -> adapted_couple f a b l (FF l f). Proof. intros * (x & H & H1 & H0 & H2 & H4). repeat split; try assumption. - apply StepFun_P20; rewrite H2; apply Nat.lt_0_succ. - intros; assert (H5 := H4 _ H3); unfold constant_D_eq, open_interval in H5; unfold constant_D_eq, open_interval; intros; induction l as [| r l Hrecl]. + discriminate. + unfold FF; rewrite RList_P12. * simpl; change (f x0 = f (pos_Rl (mid_Rlist (cons r l) r) (S i))); rewrite RList_P13; try assumption; rewrite (H5 x0 H6); rewrite H5. -- reflexivity. -- lra. * rewrite RList_P14; simpl in H3; apply H3. Qed. Lemma StepFun_P22 : forall (a b:R) (f g:R -> R) (lf lg:list R), a <= b -> is_subdivision f a b lf -> is_subdivision g a b lg -> is_subdivision f a b (cons_ORlist lf lg). Proof. unfold is_subdivision; intros a b f g lf lg Hyp X X0; elim X; elim X0; clear X X0; intros lg0 p lf0 p0; assert (Hyp_min : Rmin a b = a). { unfold Rmin; decide (Rle_dec a b) with Hyp; reflexivity. } assert (Hyp_max : Rmax a b = b). { unfold Rmax; decide (Rle_dec a b) with Hyp; reflexivity. } apply existT with (FF (cons_ORlist lf lg) f); unfold adapted_couple in p, p0; decompose [and] p; decompose [and] p0; clear p p0; rewrite Hyp_min in H6; rewrite Hyp_min in H1; rewrite Hyp_max in H0; rewrite Hyp_max in H5; unfold adapted_couple; repeat split. - apply RList_P2; assumption. - rewrite Hyp_min; symmetry ; apply Rle_antisym. 2:{ induction lf as [| r lf Hreclf]. { simpl; right; assumption. } assert (H8 : In a (cons_ORlist (cons r lf) lg)). { elim (RList_P9 (cons r lf) lg a); intros; apply H10; left; elim (RList_P3 (cons r lf) a); intros; apply H12; exists 0%nat; split; [ symmetry ; assumption | simpl; apply Nat.lt_0_succ ]. } apply RList_P5; [ apply RList_P2; assumption | assumption ]. } induction lf as [| r lf Hreclf]. { simpl; right; symmetry ; assumption. } assert (H10 : In (pos_Rl (cons_ORlist (cons r lf) lg) 0) (cons_ORlist (cons r lf) lg)). { elim (RList_P3 (cons_ORlist (cons r lf) lg) (pos_Rl (cons_ORlist (cons r lf) lg) 0)); intros _ H10; apply H10; exists 0%nat; split; [ reflexivity | rewrite RList_P11; simpl; apply Nat.lt_0_succ ]. } elim (RList_P9 (cons r lf) lg (pos_Rl (cons_ORlist (cons r lf) lg) 0)); intros H12 _; assert (H13 := H12 H10); elim H13; intro. { elim (RList_P3 (cons r lf) (pos_Rl (cons_ORlist (cons r lf) lg) 0)); intros H11 _; assert (H14 := H11 H8); elim H14; intros; elim H15; clear H15; intros; rewrite H15; rewrite <- H6; elim (RList_P6 (cons r lf)); intros; apply H17; [ assumption | apply Nat.le_0_l | assumption ]. } elim (RList_P3 lg (pos_Rl (cons_ORlist (cons r lf) lg) 0)); intros H11 _; assert (H14 := H11 H8); elim H14; intros; elim H15; clear H15; intros; rewrite H15; rewrite <- H1; elim (RList_P6 lg); intros; apply H17; [ assumption | apply Nat.le_0_l | assumption ]. - rewrite Hyp_max; apply Rle_antisym. 2:{ induction lf as [| r lf Hreclf]. { simpl; right; symmetry ; assumption. } assert (H8 : In b (cons_ORlist (cons r lf) lg)). { elim (RList_P9 (cons r lf) lg b); intros; apply H10; left; elim (RList_P3 (cons r lf) b); intros; apply H12; exists (pred (length (cons r lf))); split; [ symmetry ; assumption | simpl; apply Nat.lt_succ_diag_r ]. } apply RList_P7; [ apply RList_P2; assumption | assumption ]. } induction lf as [| r lf Hreclf]. { simpl; right; assumption. } assert (H8 : In (pos_Rl (cons_ORlist (cons r lf) lg) (pred (length (cons_ORlist (cons r lf) lg)))) (cons_ORlist (cons r lf) lg)). { elim (RList_P3 (cons_ORlist (cons r lf) lg) (pos_Rl (cons_ORlist (cons r lf) lg) (pred (length (cons_ORlist (cons r lf) lg))))); intros _ H10; apply H10; exists (pred (length (cons_ORlist (cons r lf) lg))); split; [ reflexivity | rewrite RList_P11; simpl; apply Nat.lt_succ_diag_r ]. } elim (RList_P9 (cons r lf) lg (pos_Rl (cons_ORlist (cons r lf) lg) (pred (length (cons_ORlist (cons r lf) lg))))); intros H10 _. assert (H11 := H10 H8); elim H11; intro. { elim (RList_P3 (cons r lf) (pos_Rl (cons_ORlist (cons r lf) lg) (pred (length (cons_ORlist (cons r lf) lg))))); intros H13 _; assert (H14 := H13 H12); elim H14; intros; elim H15; clear H15; intros; rewrite H15; rewrite <- H5; elim (RList_P6 (cons r lf)); intros; apply H17; [ assumption | simpl; simpl in H14; apply Nat.lt_succ_r; assumption | simpl; apply Nat.lt_succ_diag_r ]. } elim (RList_P3 lg (pos_Rl (cons_ORlist (cons r lf) lg) (pred (length (cons_ORlist (cons r lf) lg))))); intros H13 _; assert (H14 := H13 H12); elim H14; intros; elim H15; clear H15; intros. rewrite H15; assert (H17 : length lg = S (pred (length lg))). { symmetry; apply Nat.lt_succ_pred with 0%nat. apply Nat.neq_0_lt_0; red; intro; rewrite H17 in H16; elim (Nat.nlt_0_r _ H16). } rewrite <- H0; elim (RList_P6 lg); intros; apply H18; [ assumption | rewrite H17 in H16; apply Nat.lt_succ_r; assumption | apply Nat.lt_pred_l; rewrite H17; intros Heq; discriminate ]. - apply StepFun_P20; rewrite RList_P11; rewrite H2; rewrite H7; simpl; apply Nat.lt_0_succ. - intros; unfold constant_D_eq, open_interval; intros; cut (exists l : R, constant_D_eq f (open_interval (pos_Rl (cons_ORlist lf lg) i) (pos_Rl (cons_ORlist lf lg) (S i))) l). + intros; elim H11; clear H11; intros; assert (H12 := H11); assert (Hyp_cons : exists r : R, (exists r0 : list R, cons_ORlist lf lg = cons r r0)). { apply RList_P19; red; intro; rewrite H13 in H8; elim (Nat.nlt_0_r _ H8). } elim Hyp_cons; clear Hyp_cons; intros r [r0 Hyp_cons]; rewrite Hyp_cons; unfold FF; rewrite RList_P12. 2:{ rewrite RList_P14; rewrite Hyp_cons in H8; simpl in H8; apply H8. } change (f x = f (pos_Rl (mid_Rlist (cons r r0) r) (S i))); rewrite <- Hyp_cons; rewrite RList_P13. 2:{ apply H8. } assert (H13 := RList_P2 _ _ H _ H8); elim H13; intro. 2:{ elim H10; intros; rewrite H14 in H15; elim (Rlt_irrefl _ (Rlt_trans _ _ _ H16 H15)). } unfold constant_D_eq, open_interval in H11, H12; rewrite (H11 x H10); assert (H15 : pos_Rl (cons_ORlist lf lg) i < (pos_Rl (cons_ORlist lf lg) i + pos_Rl (cons_ORlist lf lg) (S i)) / 2 < pos_Rl (cons_ORlist lf lg) (S i)) by lra. rewrite (H11 _ H15); reflexivity. + assert (H11 : a < b). { apply Rle_lt_trans with (pos_Rl (cons_ORlist lf lg) i). 2:apply Rlt_le_trans with (pos_Rl (cons_ORlist lf lg) (S i)). - rewrite <- H6; rewrite <- (RList_P15 lf lg). + elim (RList_P6 (cons_ORlist lf lg)); intros; apply H11. * apply RList_P2; assumption. * apply Nat.le_0_l. * apply Nat.lt_trans with (pred (length (cons_ORlist lf lg))); [ assumption | apply Nat.lt_pred_l; apply Nat.neq_0_lt_0; apply Nat.neq_0_lt_0; red; intro; rewrite H13 in H8; elim (Nat.nlt_0_r _ H8) ]. + assumption. + assumption. + rewrite H1; assumption. - elim H10; intros; apply Rlt_trans with x; assumption. - rewrite <- H5; rewrite <- (RList_P16 lf lg); try assumption. { elim (RList_P6 (cons_ORlist lf lg)); intros; apply H11. - apply RList_P2; assumption. - apply Nat.lt_succ_r; apply -> Nat.succ_lt_mono; assumption. - apply Nat.lt_pred_l; red; intro; rewrite H13 in H8; elim (Nat.nlt_0_r _ H8). } rewrite H0; assumption. } set (I := fun j:nat => pos_Rl lf j <= pos_Rl (cons_ORlist lf lg) i /\ (j < length lf)%nat); assert (H12 : Nbound I). { unfold Nbound; exists (length lf); intros; unfold I in H12; elim H12; intros; apply Nat.lt_le_incl; assumption. } assert (H13 : exists n : nat, I n). { exists 0%nat; unfold I; split. 2:{ apply Nat.neq_0_lt_0; red; intro; rewrite H13 in H5; rewrite <- H6 in H11; rewrite <- H5 in H11; elim (Rlt_irrefl _ H11). } apply Rle_trans with (pos_Rl (cons_ORlist lf lg) 0). { right; symmetry . apply RList_P15; try assumption; rewrite H1; assumption. } elim (RList_P6 (cons_ORlist lf lg)); intros; apply H13. - apply RList_P2; assumption. - apply Nat.le_0_l. - lia. } assert (H14 := Nzorn H13 H12); elim H14; clear H14; intros x0 H14; exists (pos_Rl lf0 x0); unfold constant_D_eq, open_interval; intros; assert (H16 := H9 x0); assert (H17 : (x0 < pred (length lf))%nat). { elim H14; clear H14; intros; unfold I in H14; elim H14; clear H14; intros; apply Nat.succ_lt_mono; replace (S (pred (length lf))) with (length lf). { inversion H18. 2: apply -> Nat.succ_lt_mono; assumption. assert (x0 = pred (length lf)). { rewrite <- H20; reflexivity. } rewrite H19 in H14; rewrite H5 in H14; cut (pos_Rl (cons_ORlist lf lg) i < b). - intro; elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H14 H21)). - apply Rlt_le_trans with (pos_Rl (cons_ORlist lf lg) (S i)). { elim H10; intros; apply Rlt_trans with x; assumption. } rewrite <- H5; apply Rle_trans with (pos_Rl (cons_ORlist lf lg) (pred (length (cons_ORlist lf lg)))). + elim (RList_P6 (cons_ORlist lf lg)); intros; apply H21. * apply RList_P2; assumption. * apply Nat.lt_succ_r; apply -> Nat.succ_lt_mono; assumption. * apply Nat.lt_pred_l; red; intro; rewrite H23 in H8; elim (Nat.nlt_0_r _ H8). + right; apply RList_P16; try assumption; rewrite H0; assumption. } symmetry; apply Nat.lt_succ_pred with 0%nat; apply Nat.neq_0_lt_0; red; intro; rewrite H19 in H18; elim (Nat.nlt_0_r _ H18). } assert (H18 := H16 H17); unfold constant_D_eq, open_interval in H18; rewrite (H18 x1). { reflexivity. } elim H15; clear H15; intros; elim H14; clear H14; intros; unfold I in H14; elim H14; clear H14; intros; split. { apply Rle_lt_trans with (pos_Rl (cons_ORlist lf lg) i); assumption. } apply Rlt_le_trans with (pos_Rl (cons_ORlist lf lg) (S i)). { assumption. } assert (H22 : (S x0 < length lf)%nat) by lia. elim (Rle_dec (pos_Rl lf (S x0)) (pos_Rl (cons_ORlist lf lg) i)); intro a0. * assert (H23 : (S x0 <= x0)%nat). { apply H20; unfold I; split; assumption. } elim (Nat.nle_succ_diag_l _ H23). * assert (H23 : pos_Rl (cons_ORlist lf lg) i < pos_Rl lf (S x0)) by auto with real. clear a0; apply RList_P17; try assumption. { apply RList_P2; assumption. } elim (RList_P9 lf lg (pos_Rl lf (S x0))); intros; apply H25; left; elim (RList_P3 lf (pos_Rl lf (S x0))); intros; apply H27; exists (S x0); split; [ reflexivity | apply H22 ]. Qed. Lemma StepFun_P23 : forall (a b:R) (f g:R -> R) (lf lg:list R), is_subdivision f a b lf -> is_subdivision g a b lg -> is_subdivision f a b (cons_ORlist lf lg). Proof. intros; case (Rle_dec a b); intro; [ apply StepFun_P22 with g; assumption | apply StepFun_P5; apply StepFun_P22 with g; [ auto with real | apply StepFun_P5; assumption | apply StepFun_P5; assumption ] ]. Qed. Lemma StepFun_P24 : forall (a b:R) (f g:R -> R) (lf lg:list R), a <= b -> is_subdivision f a b lf -> is_subdivision g a b lg -> is_subdivision g a b (cons_ORlist lf lg). Proof. unfold is_subdivision; intros a b f g lf lg Hyp X X0; elim X; elim X0; clear X X0; intros lg0 p lf0 p0; assert (Hyp_min : Rmin a b = a). { unfold Rmin; decide (Rle_dec a b) with Hyp; reflexivity. } assert (Hyp_max : Rmax a b = b). { unfold Rmax; decide (Rle_dec a b) with Hyp; reflexivity. } apply existT with (FF (cons_ORlist lf lg) g); unfold adapted_couple in p, p0; decompose [and] p; decompose [and] p0; clear p p0; rewrite Hyp_min in H1; rewrite Hyp_min in H6; rewrite Hyp_max in H0; rewrite Hyp_max in H5; unfold adapted_couple; repeat split. - apply RList_P2; assumption. - rewrite Hyp_min; symmetry ; apply Rle_antisym. { induction lf as [| r lf Hreclf]. { simpl; right; symmetry ; assumption. } assert (H10 : In (pos_Rl (cons_ORlist (cons r lf) lg) 0) (cons_ORlist (cons r lf) lg)). { elim (RList_P3 (cons_ORlist (cons r lf) lg) (pos_Rl (cons_ORlist (cons r lf) lg) 0)); intros _ H10; apply H10; exists 0%nat; split; [ reflexivity | rewrite RList_P11; simpl; apply Nat.lt_0_succ ]. } elim (RList_P9 (cons r lf) lg (pos_Rl (cons_ORlist (cons r lf) lg) 0)); intros H12 _; assert (H13 := H12 H10); elim H13; intro. { elim (RList_P3 (cons r lf) (pos_Rl (cons_ORlist (cons r lf) lg) 0)); intros H11 _; assert (H14 := H11 H8); elim H14; intros; elim H15; clear H15; intros; rewrite H15; rewrite <- H6; elim (RList_P6 (cons r lf)); intros; apply H17; [ assumption | apply Nat.le_0_l | assumption ]. } elim (RList_P3 lg (pos_Rl (cons_ORlist (cons r lf) lg) 0)); intros H11 _; assert (H14 := H11 H8); elim H14; intros; elim H15; clear H15; intros; rewrite H15; rewrite <- H1; elim (RList_P6 lg); intros; apply H17; [ assumption | apply Nat.le_0_l | assumption ]. } induction lf as [| r lf Hreclf]. { simpl; right; assumption. } assert (H8 : In a (cons_ORlist (cons r lf) lg)). { elim (RList_P9 (cons r lf) lg a); intros; apply H10; left; elim (RList_P3 (cons r lf) a); intros; apply H12; exists 0%nat; split; [ symmetry ; assumption | simpl; apply Nat.lt_0_succ ]. } apply RList_P5; [ apply RList_P2; assumption | assumption ]. - rewrite Hyp_max; apply Rle_antisym. 2:{ induction lf as [| r lf Hreclf]. { simpl; right; symmetry ; assumption. } assert (H8 : In b (cons_ORlist (cons r lf) lg)). { elim (RList_P9 (cons r lf) lg b); intros; apply H10; left; elim (RList_P3 (cons r lf) b); intros; apply H12; exists (pred (length (cons r lf))); split; [ symmetry ; assumption | simpl; apply Nat.lt_succ_diag_r ]. } apply RList_P7; [ apply RList_P2; assumption | assumption ]. } induction lf as [| r lf Hreclf]. { simpl; right; assumption. } assert (H8 : In (pos_Rl (cons_ORlist (cons r lf) lg) (pred (length (cons_ORlist (cons r lf) lg)))) (cons_ORlist (cons r lf) lg)). { elim (RList_P3 (cons_ORlist (cons r lf) lg) (pos_Rl (cons_ORlist (cons r lf) lg) (pred (length (cons_ORlist (cons r lf) lg))))); intros _ H10; apply H10; exists (pred (length (cons_ORlist (cons r lf) lg))); split; [ reflexivity | rewrite RList_P11; simpl; apply Nat.lt_succ_diag_r ]. } elim (RList_P9 (cons r lf) lg (pos_Rl (cons_ORlist (cons r lf) lg) (pred (length (cons_ORlist (cons r lf) lg))))); intros H10 _; assert (H11 := H10 H8); elim H11; intro. { elim (RList_P3 (cons r lf) (pos_Rl (cons_ORlist (cons r lf) lg) (pred (length (cons_ORlist (cons r lf) lg))))); intros H13 _; assert (H14 := H13 H12); elim H14; intros; elim H15; clear H15; intros; rewrite H15; rewrite <- H5; elim (RList_P6 (cons r lf)); intros; apply H17; [ assumption | simpl; simpl in H14; apply Nat.lt_succ_r; assumption | simpl; apply Nat.lt_succ_diag_r ]. } elim (RList_P3 lg (pos_Rl (cons_ORlist (cons r lf) lg) (pred (length (cons_ORlist (cons r lf) lg))))); intros H13 _; assert (H14 := H13 H12); elim H14; intros; elim H15; clear H15; intros; rewrite H15; assert (H17 : length lg = S (pred (length lg))). { symmetry; apply Nat.lt_succ_pred with 0%nat; apply Nat.neq_0_lt_0; red; intro; rewrite H17 in H16; elim (Nat.nlt_0_r _ H16). } rewrite <- H0; elim (RList_P6 lg); intros; apply H18; [ assumption | rewrite H17 in H16; apply Nat.lt_succ_r; assumption | apply Nat.lt_pred_l; rewrite H17; intros Heq; discriminate ]. - apply StepFun_P20; rewrite RList_P11; rewrite H7; rewrite H2; simpl; apply Nat.lt_0_succ. - unfold constant_D_eq, open_interval; intros; cut (exists l : R, constant_D_eq g (open_interval (pos_Rl (cons_ORlist lf lg) i) (pos_Rl (cons_ORlist lf lg) (S i))) l). { intros; elim H11; clear H11; intros; assert (H12 := H11); assert (Hyp_cons : exists r : R, (exists r0 : list R, cons_ORlist lf lg = cons r r0)). { apply RList_P19; red; intro; rewrite H13 in H8; elim (Nat.nlt_0_r _ H8). } elim Hyp_cons; clear Hyp_cons; intros r [r0 Hyp_cons]; rewrite Hyp_cons; unfold FF; rewrite RList_P12. 2:{ rewrite RList_P14; rewrite Hyp_cons in H8; simpl in H8; apply H8. } change (g x = g (pos_Rl (mid_Rlist (cons r r0) r) (S i))); rewrite <- Hyp_cons; rewrite RList_P13. 2:{ apply H8. } assert (H13 := RList_P2 _ _ H _ H8); elim H13; intro. 2:{ elim H10; intros; rewrite H14 in H15; elim (Rlt_irrefl _ (Rlt_trans _ _ _ H16 H15)). } unfold constant_D_eq, open_interval in H11, H12; rewrite (H11 x H10); rewrite H11. { reflexivity. } lra. } assert (H11 : a < b). { apply Rle_lt_trans with (pos_Rl (cons_ORlist lf lg) i). { rewrite <- H6; rewrite <- (RList_P15 lf lg); try assumption. { elim (RList_P6 (cons_ORlist lf lg)); intros; apply H11. { apply RList_P2; assumption. } { apply Nat.le_0_l. } apply Nat.lt_trans with (pred (length (cons_ORlist lf lg))); [ assumption | apply Nat.lt_pred_l; red; intro; rewrite H13 in H8; elim (Nat.nlt_0_r _ H8) ]. } rewrite H1; assumption. } apply Rlt_le_trans with (pos_Rl (cons_ORlist lf lg) (S i)). { elim H10; intros; apply Rlt_trans with x; assumption. } rewrite <- H5; rewrite <- (RList_P16 lf lg); try assumption. { elim (RList_P6 (cons_ORlist lf lg)); intros; apply H11. { apply RList_P2; assumption. } { apply Nat.lt_succ_r; apply -> Nat.succ_lt_mono; assumption. } apply Nat.lt_pred_l; red; intro; rewrite H13 in H8; elim (Nat.nlt_0_r _ H8). } rewrite H0; assumption. } set (I := fun j:nat => pos_Rl lg j <= pos_Rl (cons_ORlist lf lg) i /\ (j < length lg)%nat); assert (H12 : Nbound I). { unfold Nbound; exists (length lg); intros; unfold I in H12; elim H12; intros; apply Nat.lt_le_incl; assumption. } assert (H13 : exists n : nat, I n). { exists 0%nat; unfold I; split. { apply Rle_trans with (pos_Rl (cons_ORlist lf lg) 0). { right; symmetry ; rewrite H1; rewrite <- H6; apply RList_P15; try assumption; rewrite H1; assumption. } elim (RList_P6 (cons_ORlist lf lg)); intros; apply H13; [ apply RList_P2; assumption | apply Nat.le_0_l | apply Nat.lt_trans with (pred (length (cons_ORlist lf lg))); [ assumption | apply Nat.lt_pred_l; red; intro; rewrite H15 in H8; elim (Nat.nlt_0_r _ H8) ] ]. } apply Nat.neq_0_lt_0; red; intro; rewrite H13 in H0; rewrite <- H1 in H11; rewrite <- H0 in H11; elim (Rlt_irrefl _ H11). } assert (H14 := Nzorn H13 H12); elim H14; clear H14; intros x0 H14; exists (pos_Rl lg0 x0); unfold constant_D_eq, open_interval; intros; assert (H16 := H4 x0); assert (H17 : (x0 < pred (length lg))%nat). { elim H14; clear H14; intros; unfold I in H14; elim H14; clear H14; intros; apply Nat.succ_lt_mono; replace (S (pred (length lg))) with (length lg). { inversion H18. 2: apply -> Nat.succ_lt_mono; assumption. cut (x0 = pred (length lg)). { intro; rewrite H19 in H14; rewrite H0 in H14; cut (pos_Rl (cons_ORlist lf lg) i < b). { intro; elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H14 H21)). } apply Rlt_le_trans with (pos_Rl (cons_ORlist lf lg) (S i)). { elim H10; intros; apply Rlt_trans with x; assumption. } rewrite <- H0; apply Rle_trans with (pos_Rl (cons_ORlist lf lg) (pred (length (cons_ORlist lf lg)))). { elim (RList_P6 (cons_ORlist lf lg)); intros; apply H21. { apply RList_P2; assumption. } { apply Nat.lt_succ_r; apply -> Nat.succ_lt_mono; assumption. } apply Nat.lt_pred_l; red; intro; rewrite H23 in H8; elim (Nat.nlt_0_r _ H8). } right; rewrite H0; rewrite <- H5; apply RList_P16; try assumption. rewrite H0; assumption. } rewrite <- H20; reflexivity. } symmetry; apply Nat.lt_succ_pred with 0%nat; apply Nat.neq_0_lt_0; red; intro; rewrite H19 in H18; elim (Nat.nlt_0_r _ H18). } assert (H18 := H16 H17); unfold constant_D_eq, open_interval in H18; rewrite (H18 x1). { reflexivity. } elim H15; clear H15; intros; elim H14; clear H14; intros; unfold I in H14; elim H14; clear H14; intros; split. { apply Rle_lt_trans with (pos_Rl (cons_ORlist lf lg) i); assumption. } apply Rlt_le_trans with (pos_Rl (cons_ORlist lf lg) (S i)); try assumption. assert (H22 : (S x0 < length lg)%nat). { replace (length lg) with (S (pred (length lg))). { apply -> Nat.succ_lt_mono; assumption. } apply Nat.lt_succ_pred with 0%nat; apply Nat.neq_0_lt_0; red; intro; rewrite H22 in H21; elim (Nat.nlt_0_r _ H21). } elim (Rle_dec (pos_Rl lg (S x0)) (pos_Rl (cons_ORlist lf lg) i)); intro a0. { assert (H23 : (S x0 <= x0)%nat); [ apply H20; unfold I; split; assumption | elim (Nat.nle_succ_diag_l _ H23) ]. } assert (H23 : pos_Rl (cons_ORlist lf lg) i < pos_Rl lg (S x0)) by auto with real. clear a0; apply RList_P17; try assumption; [ apply RList_P2; assumption | elim (RList_P9 lf lg (pos_Rl lg (S x0))); intros; apply H25; right; elim (RList_P3 lg (pos_Rl lg (S x0))); intros; apply H27; exists (S x0); split; [ reflexivity | apply H22 ] ]. Qed. Lemma StepFun_P25 : forall (a b:R) (f g:R -> R) (lf lg:list R), is_subdivision f a b lf -> is_subdivision g a b lg -> is_subdivision g a b (cons_ORlist lf lg). Proof. intros a b f g lf lg H H0; case (Rle_dec a b); intro; [ apply StepFun_P24 with f; assumption | apply StepFun_P5; apply StepFun_P24 with f; [ auto with real | apply StepFun_P5; assumption | apply StepFun_P5; assumption ] ]. Qed. Lemma StepFun_P26 : forall (a b l:R) (f g:R -> R) (l1:list R), is_subdivision f a b l1 -> is_subdivision g a b l1 -> is_subdivision (fun x:R => f x + l * g x) a b l1. Proof. intros a b l f g l1 (x0,(H0,(H1,(H2,(H3,H4))))) (x,(_,(_,(_,(_,H9))))). exists (FF l1 (fun x:R => f x + l * g x)); repeat split. 1,2,3:assumption. - apply StepFun_P20; rewrite H3; auto with arith. - intros i H8 x1 H10; unfold open_interval in H10, H9, H4; rewrite (H9 _ H8 _ H10); rewrite (H4 _ H8 _ H10); assert (H11 : l1 <> nil). { red; intro H11; rewrite H11 in H8; elim (Nat.nlt_0_r _ H8). } destruct (RList_P19 _ H11) as (r,(r0,H12)); rewrite H12; unfold FF; change (pos_Rl x0 i + l * pos_Rl x i = pos_Rl (map (fun x2:R => f x2 + l * g x2) (mid_Rlist (cons r r0) r)) (S i)); rewrite RList_P12. { rewrite RList_P13. { rewrite <- H12; rewrite (H9 _ H8); try rewrite (H4 _ H8); lra. } rewrite <- H12; assumption. } rewrite RList_P14; simpl; rewrite H12 in H8; simpl in H8; apply -> Nat.succ_lt_mono; apply H8. Qed. Lemma StepFun_P27 : forall (a b l:R) (f g:R -> R) (lf lg:list R), is_subdivision f a b lf -> is_subdivision g a b lg -> is_subdivision (fun x:R => f x + l * g x) a b (cons_ORlist lf lg). Proof. intros a b l f g lf lg H H0; apply StepFun_P26; [ apply StepFun_P23 with g; assumption | apply StepFun_P25 with f; assumption ]. Qed. (** The set of step functions on [a,b] is a vectorial space *) Lemma StepFun_P28 : forall (a b l:R) (f g:StepFun a b), IsStepFun (fun x:R => f x + l * g x) a b. Proof. intros a b l f g; unfold IsStepFun; assert (H := pre f); assert (H0 := pre g); unfold IsStepFun in H, H0; elim H; elim H0; intros; apply existT with (cons_ORlist x0 x); apply StepFun_P27; assumption. Qed. Lemma StepFun_P29 : forall (a b:R) (f:StepFun a b), is_subdivision f a b (subdivision f). Proof. intros a b f; unfold is_subdivision; apply existT with (subdivision_val f); apply StepFun_P1. Qed. Lemma StepFun_P30 : forall (a b l:R) (f g:StepFun a b), RiemannInt_SF (mkStepFun (StepFun_P28 l f g)) = RiemannInt_SF f + l * RiemannInt_SF g. Proof. intros a b l f g; unfold RiemannInt_SF; case (Rle_dec a b); (intro; replace (Int_SF (subdivision_val (mkStepFun (StepFun_P28 l f g))) (subdivision (mkStepFun (StepFun_P28 l f g)))) with (Int_SF (FF (cons_ORlist (subdivision f) (subdivision g)) (fun x:R => f x + l * g x)) (cons_ORlist (subdivision f) (subdivision g))); [ rewrite StepFun_P19; replace (Int_SF (FF (cons_ORlist (subdivision f) (subdivision g)) f) (cons_ORlist (subdivision f) (subdivision g))) with (Int_SF (subdivision_val f) (subdivision f)); [ replace (Int_SF (FF (cons_ORlist (subdivision f) (subdivision g)) g) (cons_ORlist (subdivision f) (subdivision g))) with (Int_SF (subdivision_val g) (subdivision g)); [ ring | apply StepFun_P17 with (fe g) a b; [ apply StepFun_P1 | apply StepFun_P21; apply StepFun_P25 with (fe f); apply StepFun_P29 ] ] | apply StepFun_P17 with (fe f) a b; [ apply StepFun_P1 | apply StepFun_P21; apply StepFun_P23 with (fe g); apply StepFun_P29 ] ] | apply StepFun_P17 with (fun x:R => f x + l * g x) a b; [ apply StepFun_P21; apply StepFun_P27; apply StepFun_P29 | apply (StepFun_P1 (mkStepFun (StepFun_P28 l f g))) ] ]). Qed. Lemma StepFun_P31 : forall (a b:R) (f:R -> R) (l lf:list R), adapted_couple f a b l lf -> adapted_couple (fun x:R => Rabs (f x)) a b l (map Rabs lf). Proof. unfold adapted_couple; intros; decompose [and] H; clear H; repeat split; try assumption. - symmetry ; rewrite H3; rewrite RList_P18; reflexivity. - intros; unfold constant_D_eq, open_interval; unfold constant_D_eq, open_interval in H5; intros; rewrite (H5 _ H _ H4); rewrite RList_P12; [ reflexivity | rewrite H3 in H; simpl in H; apply H ]. Qed. Lemma StepFun_P32 : forall (a b:R) (f:StepFun a b), IsStepFun (fun x:R => Rabs (f x)) a b. Proof. intros a b f; unfold IsStepFun; apply existT with (subdivision f); unfold is_subdivision; apply existT with (map Rabs (subdivision_val f)); apply StepFun_P31; apply StepFun_P1. Qed. Lemma StepFun_P33 : forall l2 l1:list R, ordered_Rlist l1 -> Rabs (Int_SF l2 l1) <= Int_SF (map Rabs l2) l1. Proof. induction l2 as [ | r r0 H]; intros. - simpl; rewrite Rabs_R0; right; reflexivity. - simpl; induction l1 as [| r1 l1 Hrecl1]. + rewrite Rabs_R0; right; reflexivity. + induction l1 as [| r2 l1 Hrecl0]. * rewrite Rabs_R0; right; reflexivity. * apply Rle_trans with (Rabs (r * (r2 - r1)) + Rabs (Int_SF r0 (cons r2 l1))). -- apply Rabs_triang. -- rewrite Rabs_mult; rewrite (Rabs_right (r2 - r1)); [ apply Rplus_le_compat_l; apply H; apply RList_P4 with r1; assumption | apply Rge_minus; apply Rle_ge; apply (H0 0%nat); simpl; apply Nat.lt_0_succ ]. Qed. Lemma StepFun_P34 : forall (a b:R) (f:StepFun a b), a <= b -> Rabs (RiemannInt_SF f) <= RiemannInt_SF (mkStepFun (StepFun_P32 f)). Proof. intros; unfold RiemannInt_SF; decide (Rle_dec a b) with H. replace (Int_SF (subdivision_val (mkStepFun (StepFun_P32 f))) (subdivision (mkStepFun (StepFun_P32 f)))) with (Int_SF (map Rabs (subdivision_val f)) (subdivision f)). - apply StepFun_P33; assert (H0 := StepFun_P29 f); unfold is_subdivision in H0; elim H0; intros; unfold adapted_couple in p; decompose [and] p; assumption. - apply StepFun_P17 with (fun x:R => Rabs (f x)) a b; [ apply StepFun_P31; apply StepFun_P1 | apply (StepFun_P1 (mkStepFun (StepFun_P32 f))) ]. Qed. Lemma StepFun_P35 : forall (l:list R) (a b:R) (f g:R -> R), ordered_Rlist l -> pos_Rl l 0 = a -> pos_Rl l (pred (length l)) = b -> (forall x:R, a < x < b -> f x <= g x) -> Int_SF (FF l f) l <= Int_SF (FF l g) l. Proof. induction l as [ | r r0 H]; intros. { right; reflexivity. } simpl; induction r0 as [| r0 r1 Hrecr0]. { right; reflexivity. } simpl; apply Rplus_le_compat. 2:{ simpl in H; apply H with r0 b. - apply RList_P4 with r; assumption. - reflexivity. - rewrite <- H2; reflexivity. - intros; apply H3; elim H4; intros; split; try assumption. apply Rle_lt_trans with r0; try assumption. rewrite <- H1. simpl; apply (H0 0%nat); simpl; apply Nat.lt_0_succ. } case (Req_dec r r0); intro. { rewrite H4; right; ring. } do 2 rewrite <- (Rmult_comm (r0 - r)); apply Rmult_le_compat_l. { apply Rge_le; apply Rge_minus; apply Rle_ge; apply (H0 0%nat); simpl; apply Nat.lt_0_succ. } apply H3; split. { apply Rmult_lt_reg_l with 2. { prove_sup0. } unfold Rdiv; rewrite <- (Rmult_comm (/ 2)); rewrite <- Rmult_assoc; rewrite Rinv_r. 2:discrR. simpl in H1. assert (H6 := H0 0%nat (Nat.lt_0_succ _)). simpl in H6. lra. } apply Rmult_lt_reg_l with 2. { prove_sup0. } unfold Rdiv; rewrite <- (Rmult_comm (/ 2)); rewrite <- Rmult_assoc; rewrite Rinv_r. 2:discrR. rewrite Rmult_1_l; rewrite <-Rplus_diag; assert (H5 : r0 <= b). { replace b with (pos_Rl (cons r (cons r0 r1)) (pred (length (cons r (cons r0 r1))))). replace r0 with (pos_Rl (cons r (cons r0 r1)) 1). { elim (RList_P6 (cons r (cons r0 r1))); intros; apply H5. { assumption. } { simpl; lia. } simpl; apply Nat.lt_succ_diag_r. } reflexivity. } apply Rle_lt_trans with (r + b). { apply Rplus_le_compat_l; assumption. } rewrite (Rplus_comm r); apply Rplus_lt_compat_l. apply Rlt_le_trans with r0. { assert (H6 := H0 0%nat (Nat.lt_0_succ _)). simpl in H6. lra. } assumption. Qed. Lemma StepFun_P36 : forall (a b:R) (f g:StepFun a b) (l:list R), a <= b -> is_subdivision f a b l -> is_subdivision g a b l -> (forall x:R, a < x < b -> f x <= g x) -> RiemannInt_SF f <= RiemannInt_SF g. Proof. intros; unfold RiemannInt_SF; decide (Rle_dec a b) with H. replace (Int_SF (subdivision_val f) (subdivision f)) with (Int_SF (FF l f) l). - replace (Int_SF (subdivision_val g) (subdivision g)) with (Int_SF (FF l g) l). + unfold is_subdivision in X; elim X; clear X; intros; unfold adapted_couple in p; decompose [and] p; clear p; assert (H5 : Rmin a b = a); [ unfold Rmin; decide (Rle_dec a b) with H; reflexivity | assert (H7 : Rmax a b = b); [ unfold Rmax; decide (Rle_dec a b) with H; reflexivity | rewrite H5 in H3; rewrite H7 in H2; eapply StepFun_P35 with a b; assumption ] ]. + apply StepFun_P17 with (fe g) a b; [ apply StepFun_P21; assumption | apply StepFun_P1 ]. - apply StepFun_P17 with (fe f) a b; [ apply StepFun_P21; assumption | apply StepFun_P1 ]. Qed. Lemma StepFun_P37 : forall (a b:R) (f g:StepFun a b), a <= b -> (forall x:R, a < x < b -> f x <= g x) -> RiemannInt_SF f <= RiemannInt_SF g. Proof. intros; eapply StepFun_P36; try assumption. - eapply StepFun_P25; apply StepFun_P29. - eapply StepFun_P23; apply StepFun_P29. Qed. Lemma StepFun_P38 : forall (l:list R) (a b:R) (f:R -> R), ordered_Rlist l -> pos_Rl l 0 = a -> pos_Rl l (pred (length l)) = b -> { g:StepFun a b | g b = f b /\ (forall i:nat, (i < pred (length l))%nat -> constant_D_eq g (co_interval (pos_Rl l i) (pos_Rl l (S i))) (f (pos_Rl l i))) }. Proof. intros l a b f; generalize a; clear a; induction l as [|r l IHl]. { intros a H H0 H1; simpl in H0; simpl in H1; exists (mkStepFun (StepFun_P4 a b (f b))); split. { reflexivity. } intros; elim (Nat.nlt_0_r _ H2). } intros; destruct l as [| r1 l]. { simpl in H1; simpl in H0; exists (mkStepFun (StepFun_P4 a b (f b))); split. { reflexivity. } intros i H2; elim (Nat.nlt_0_r _ H2). } intros; assert (H2 : ordered_Rlist (cons r1 l)). { apply RList_P4 with r; assumption. } assert (H3 : pos_Rl (cons r1 l) 0 = r1). { reflexivity. } assert (H4 : pos_Rl (cons r1 l) (pred (length (cons r1 l))) = b). { rewrite <- H1; reflexivity. } elim (IHl r1 H2 H3 H4); intros g [H5 H6]. set (g' := fun x:R => match Rle_dec r1 x with | left _ => g x | right _ => f a end). assert (H7 : r1 <= b). { rewrite <- H4; apply RList_P7; [ assumption | left; reflexivity ]. } assert (H8 : IsStepFun g' a b). { unfold IsStepFun; assert (H8 := pre g); unfold IsStepFun in H8; elim H8; intros lg H9; unfold is_subdivision in H9; elim H9; clear H9; intros lg2 H9; split with (cons a lg); unfold is_subdivision; split with (cons (f a) lg2); unfold adapted_couple in H9; decompose [and] H9; clear H9; unfold adapted_couple; repeat split. - unfold ordered_Rlist; intros; simpl in H9; induction i as [| i Hreci]. { simpl; rewrite H12; replace (Rmin r1 b) with r1. { simpl in H0; rewrite <- H0; apply (H 0%nat); simpl; apply Nat.lt_0_succ. } unfold Rmin; decide (Rle_dec r1 b) with H7; reflexivity. } apply (H10 i); apply Nat.succ_lt_mono. replace (S (pred (length lg))) with (length lg). { apply H9. } symmetry; apply Nat.lt_succ_pred with 0%nat; apply Nat.neq_0_lt_0; intro; rewrite H14 in H9; elim (Nat.nlt_0_r _ H9). - simpl; assert (H14 : a <= b). { rewrite <- H1; simpl in H0; rewrite <- H0; apply RList_P7; [ assumption | left; reflexivity ]. } unfold Rmin; decide (Rle_dec a b) with H14; reflexivity. - assert (H14 : a <= b). { rewrite <- H1; simpl in H0; rewrite <- H0; apply RList_P7; [ assumption | left; reflexivity ]. } replace (Rmax a b) with (Rmax r1 b). { rewrite <- H11; induction lg as [| r0 lg Hreclg]. { simpl in H13; discriminate. } reflexivity. } unfold Rmax; decide (Rle_dec a b) with H14; decide (Rle_dec r1 b) with H7; reflexivity. - simpl; rewrite H13; reflexivity. - intros; simpl in H9; induction i as [| i Hreci]. { unfold constant_D_eq, open_interval; simpl; intros; assert (H16 : Rmin r1 b = r1). { unfold Rmin; decide (Rle_dec r1 b) with H7; reflexivity. } rewrite H16 in H12; rewrite H12 in H14; elim H14; clear H14; intros _ H14; unfold g'; case (Rle_dec r1 x); intro r3. { elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ r3 H14)). } reflexivity. } change (constant_D_eq g' (open_interval (pos_Rl lg i) (pos_Rl lg (S i))) (pos_Rl lg2 i)); clear Hreci; assert (H16 := H15 i); assert (H17 : (i < pred (length lg))%nat). { apply Nat.succ_lt_mono. replace (S (pred (length lg))) with (length lg). { assumption. } symmetry; apply Nat.lt_succ_pred with 0%nat; apply Nat.neq_0_lt_0; red; intro; rewrite H14 in H9; elim (Nat.nlt_0_r _ H9). } assert (H18 := H16 H17); unfold constant_D_eq, open_interval in H18; unfold constant_D_eq, open_interval; intros; assert (H19 := H18 _ H14); rewrite <- H19; unfold g'; case (Rle_dec r1 x) as [|[]]. { reflexivity. } replace r1 with (Rmin r1 b). { rewrite <- H12; elim H14; clear H14; intros H14 _; left; apply Rle_lt_trans with (pos_Rl lg i); try assumption. apply RList_P5. { assumption. } elim (RList_P3 lg (pos_Rl lg i)); intros; apply H21; exists i; split. { reflexivity. } apply Nat.lt_trans with (pred (length lg)); try assumption. apply Nat.lt_pred_l; red; intro; rewrite H22 in H17; elim (Nat.nlt_0_r _ H17). } unfold Rmin; decide (Rle_dec r1 b) with H7; reflexivity. } exists (mkStepFun H8); split. { simpl; unfold g'; decide (Rle_dec r1 b) with H7; assumption. } intros; simpl in H9; induction i as [| i Hreci]. { unfold constant_D_eq, co_interval; simpl; intros; simpl in H0; rewrite H0; elim H10; clear H10; intros; unfold g'; case (Rle_dec r1 x); intro r3. { elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ r3 H11)). } reflexivity. } clear Hreci; change (constant_D_eq (mkStepFun H8) (co_interval (pos_Rl (cons r1 l) i) (pos_Rl (cons r1 l) (S i))) (f (pos_Rl (cons r1 l) i))); assert (H10 := H6 i); assert (H11 : (i < pred (length (cons r1 l)))%nat). { simpl; apply Nat.succ_lt_mono; assumption. } assert (H12 := H10 H11); unfold constant_D_eq, co_interval in H12; unfold constant_D_eq, co_interval; intros; rewrite <- (H12 _ H13); simpl; unfold g'; case (Rle_dec r1 x) as [|[]]. { reflexivity. } elim H13; clear H13; intros; apply Rle_trans with (pos_Rl (cons r1 l) i); try assumption; change (pos_Rl (cons r1 l) 0 <= pos_Rl (cons r1 l) i); elim (RList_P6 (cons r1 l)); intros; apply H15; [ assumption | apply Nat.le_0_l | simpl; apply Nat.lt_trans with (length l); [ apply Nat.succ_lt_mono; assumption | apply Nat.lt_succ_diag_r ] ]. Qed. Lemma StepFun_P39 : forall (a b:R) (f:StepFun a b), RiemannInt_SF f = - RiemannInt_SF (mkStepFun (StepFun_P6 (pre f))). Proof. intros; unfold RiemannInt_SF; case (Rle_dec a b); case (Rle_dec b a); intros. - assert (H : adapted_couple f a b (subdivision f) (subdivision_val f)); [ apply StepFun_P1 | assert (H0 : adapted_couple (mkStepFun (StepFun_P6 (pre f))) b a (subdivision (mkStepFun (StepFun_P6 (pre f)))) (subdivision_val (mkStepFun (StepFun_P6 (pre f))))); [ apply StepFun_P1 | assert (H1 : a = b); [ apply Rle_antisym; assumption | rewrite (StepFun_P8 H H1); assert (H2 : b = a); [ symmetry ; apply H1 | rewrite (StepFun_P8 H0 H2); ring ] ] ] ]. - rewrite Ropp_involutive; eapply StepFun_P17; [ apply StepFun_P1 | apply StepFun_P2; set (H := StepFun_P6 (pre f)); unfold IsStepFun in H; elim H; intros; unfold is_subdivision; elim p; intros; apply p0 ]. - apply Ropp_eq_compat; eapply StepFun_P17; [ apply StepFun_P1 | apply StepFun_P2; set (H := StepFun_P6 (pre f)); unfold IsStepFun in H; elim H; intros; unfold is_subdivision; elim p; intros; apply p0 ]. - assert (H : a < b); [ auto with real | assert (H0 : b < a); [ auto with real | elim (Rlt_irrefl _ (Rlt_trans _ _ _ H H0)) ] ]. Qed. Lemma StepFun_P40 : forall (f:R -> R) (a b c:R) (l1 l2 lf1 lf2:list R), a < b -> b < c -> adapted_couple f a b l1 lf1 -> adapted_couple f b c l2 lf2 -> adapted_couple f a c (app l1 l2) (FF (app l1 l2) f). Proof. intros f a b c l1 l2 lf1 lf2 H H0 H1 H2; unfold adapted_couple in H1, H2; unfold adapted_couple; decompose [and] H1; decompose [and] H2; clear H1 H2; repeat split. - apply RList_P25; try assumption. rewrite H10; rewrite H4; unfold Rmin, Rmax; case (Rle_dec a b) as [|[]]; case (Rle_dec b c) as [|[]]; (right; reflexivity) || (left; assumption). - rewrite RList_P22. { rewrite H5; unfold Rmin, Rmax; case (Rle_dec a c) as [|[]]; case (Rle_dec a b) as [|[]]; [ reflexivity | left; assumption | apply Rle_trans with b; left; assumption | left; assumption ]. } red; intro; rewrite H1 in H6; discriminate. - rewrite RList_P24. { rewrite H9; unfold Rmin, Rmax; case (Rle_dec a c) as [|[]]; case (Rle_dec b c) as [|[]]; [ reflexivity | left; assumption | apply Rle_trans with b; left; assumption | left; assumption ]. } red; intro; rewrite H1 in H11; discriminate. - apply StepFun_P20. rewrite length_app; apply Nat.neq_0_lt_0; red; intro. assert (List.length l1 = 0)%nat as H12 by now destruct (List.length l1); inversion H1. rewrite H12 in H6; discriminate. - unfold constant_D_eq, open_interval; intros; elim (Nat.le_gt_cases (S (S i)) (length l1)); intro. + assert (H14 : pos_Rl (app l1 l2) i = pos_Rl l1 i). { apply RList_P26; apply Nat.succ_lt_mono; apply Nat.lt_succ_r; apply Nat.succ_le_mono; apply Nat.le_trans with (length l1); [ assumption | apply Nat.le_succ_diag_r ]. } assert (H15 : pos_Rl (app l1 l2) (S i) = pos_Rl l1 (S i)). { apply RList_P26; apply Nat.succ_lt_mono; apply Nat.lt_succ_r; assumption. } rewrite H14 in H2; rewrite H15 in H2; assert (H16 : (2 <= length l1)%nat). { apply Nat.le_trans with (S (S i)); [ repeat apply -> Nat.succ_le_mono; apply Nat.le_0_l | assumption ]. } elim (RList_P20 _ H16); intros r1 [r2 [r3 H17]]; rewrite H17; change (f x = pos_Rl (map f (mid_Rlist (app (cons r2 r3) l2) r1)) i) ; rewrite RList_P12. { induction i as [| i Hreci]. { simpl; assert (H18 := H8 0%nat); unfold constant_D_eq, open_interval in H18; assert (H19 : (0 < pred (length l1))%nat). { rewrite H17; simpl; apply Nat.lt_0_succ. } assert (H20 := H18 H19); repeat rewrite H20. { reflexivity. } { assert (H21 : r1 <= r2). { rewrite H17 in H3; apply (H3 0%nat). simpl; apply Nat.lt_0_succ. } elim H21; intro. { split. { rewrite H17; simpl; apply Rmult_lt_reg_l with 2; [ prove_sup0 | unfold Rdiv; rewrite <- (Rmult_comm (/ 2)); rewrite <- Rmult_assoc; rewrite Rinv_r; [ rewrite Rmult_1_l; rewrite <-Rplus_diag; apply Rplus_lt_compat_l; assumption | discrR ] ]. } rewrite H17; simpl; apply Rmult_lt_reg_l with 2; [ prove_sup0 | unfold Rdiv; rewrite <- (Rmult_comm (/ 2)); rewrite <- Rmult_assoc; rewrite Rinv_r; [ rewrite Rmult_1_l; rewrite (Rplus_comm r1); rewrite <-Rplus_diag; apply Rplus_lt_compat_l; assumption | discrR ] ]. } elim H2; intros; rewrite H17 in H23; rewrite H17 in H24; simpl in H24; simpl in H23; rewrite H22 in H23; elim (Rlt_irrefl _ (Rlt_trans _ _ _ H23 H24)). } assumption. } clear Hreci; rewrite RList_P13. { rewrite H17 in H14; rewrite H17 in H15; change (pos_Rl (app (cons r2 r3) l2) i = pos_Rl (cons r1 (cons r2 r3)) (S i)) in H14; rewrite H14; change (pos_Rl (app (cons r2 r3) l2) (S i) = pos_Rl (cons r1 (cons r2 r3)) (S (S i))) in H15; rewrite H15; assert (H18 := H8 (S i)); unfold constant_D_eq, open_interval in H18; assert (H19 : (S i < pred (length l1))%nat). { apply -> Nat.lt_succ_lt_pred; apply Nat.succ_lt_mono; apply Nat.lt_succ_r; assumption. } assert (H20 := H18 H19); repeat rewrite H20. { reflexivity. } { rewrite <- H17; assert (H21 : pos_Rl l1 (S i) <= pos_Rl l1 (S (S i))). { apply (H3 (S i)); lia. } elim H21; intro. { split. { apply Rmult_lt_reg_l with 2; [ prove_sup0 | unfold Rdiv; rewrite <- (Rmult_comm (/ 2)); rewrite <- Rmult_assoc; rewrite Rinv_r; [ rewrite Rmult_1_l; rewrite <-Rplus_diag; apply Rplus_lt_compat_l; assumption | discrR ] ]. } apply Rmult_lt_reg_l with 2; [ prove_sup0 | unfold Rdiv; rewrite <- (Rmult_comm (/ 2)); rewrite <- Rmult_assoc; rewrite Rinv_r; [ rewrite Rmult_1_l; rewrite (Rplus_comm (pos_Rl l1 (S i))); rewrite <-Rplus_diag; apply Rplus_lt_compat_l; assumption | discrR ] ]. } elim H2; intros; rewrite H22 in H23; elim (Rlt_irrefl _ (Rlt_trans _ _ _ H23 H24)). } assumption. } simpl; rewrite H17 in H1; simpl in H1; apply Nat.succ_lt_mono; assumption. } rewrite RList_P14; rewrite H17 in H1; simpl in H1; apply H1. + inversion H12. { assert (H16 : pos_Rl (app l1 l2) (S i) = b). { rewrite RList_P29. { rewrite H15; rewrite Nat.sub_diag; rewrite H10; unfold Rmin; case (Rle_dec b c) as [|[]]; [ reflexivity | left; assumption ]. } { rewrite H15; apply le_n. } induction l1 as [| r l1 Hrecl1]. { simpl in H15; discriminate. } clear Hrecl1; simpl in H1; simpl; apply -> Nat.succ_lt_mono; assumption. } assert (H17 : pos_Rl (app l1 l2) i = b). { rewrite RList_P26. { replace i with (pred (length l1)); [ rewrite H4; unfold Rmax; case (Rle_dec a b) as [|[]]; [ reflexivity | left; assumption ] | rewrite H15; reflexivity ]. } rewrite H15; apply Nat.lt_succ_diag_r. } rewrite H16 in H2; rewrite H17 in H2; elim H2; intros; elim (Rlt_irrefl _ (Rlt_trans _ _ _ H14 H18)). } assert (H16 : pos_Rl (app l1 l2) i = pos_Rl l2 (i - length l1)). { apply RList_P29. { apply Nat.succ_le_mono; assumption. } apply Nat.lt_le_trans with (pred (length (app l1 l2))); [ assumption | apply Nat.le_pred_l ]. } assert (H17 : pos_Rl (app l1 l2) (S i) = pos_Rl l2 (S (i - length l1))). { replace (S (i - length l1)) with (S i - length l1)%nat. { apply RList_P29. { apply le_S_n; apply Nat.le_trans with (S i); [ assumption | apply Nat.le_succ_diag_r ]. } induction l1 as [| r l1 Hrecl1]. { simpl in H6; discriminate. } clear Hrecl1; simpl in H1; simpl; apply -> Nat.succ_lt_mono; assumption. } apply Nat.sub_succ_l, Nat.succ_le_mono; assumption. } assert (H18 : (2 <= length l1)%nat). { clear f c l2 lf2 H0 H3 H8 H7 H10 H9 H11 H13 i H1 x H2 H12 m H14 H15 H16 H17; induction l1 as [| r l1 Hrecl1]. { discriminate. } clear Hrecl1; induction l1 as [| r0 l1 Hrecl1]. { simpl in H5; simpl in H4; assert (H0 : Rmin a b < Rmax a b). { unfold Rmin, Rmax; case (Rle_dec a b) as [|[]]; [ assumption | left; assumption ]. } rewrite <- H5 in H0; rewrite <- H4 in H0; elim (Rlt_irrefl _ H0). } clear Hrecl1; simpl; repeat apply -> Nat.succ_le_mono; apply Nat.le_0_l. } elim (RList_P20 _ H18); intros r1 [r2 [r3 H19]]; rewrite H19; change (f x = pos_Rl (map f (mid_Rlist (app (cons r2 r3) l2) r1)) i) ; rewrite RList_P12. 2:{ rewrite RList_P14; rewrite H19 in H1; simpl in H1; simpl; apply H1. } induction i as [| i Hreci]. { assert (H20 := le_S_n _ _ H15); assert (H21 := Nat.le_trans _ _ _ H18 H20); elim (Nat.nle_succ_0 _ H21). } clear Hreci; rewrite RList_P13. 2:{ simpl; rewrite H19 in H1; simpl in H1; apply Nat.succ_lt_mono; assumption. } rewrite H19 in H16; rewrite H19 in H17; change (pos_Rl (app (cons r2 r3) l2) i = pos_Rl l2 (S i - length (cons r1 (cons r2 r3)))) in H16; rewrite H16; change (pos_Rl (app (cons r2 r3) l2) (S i) = pos_Rl l2 (S (S i - length (cons r1 (cons r2 r3))))) in H17; rewrite H17; assert (H20 := H13 (S i - length l1)%nat); unfold constant_D_eq, open_interval in H20; assert (H21 : (S i - length l1 < pred (length l2))%nat). { apply Nat.lt_succ_lt_pred; rewrite <- Nat.sub_succ_l. { apply Nat.add_lt_mono_l with (length l1); rewrite Nat.add_comm, Nat.sub_add. { rewrite H19 in H1; simpl in H1; rewrite H19; simpl; rewrite length_app in H1; apply -> Nat.succ_lt_mono; assumption. } apply Nat.le_trans with (S i); [ apply Nat.succ_le_mono; assumption | apply Nat.le_succ_diag_r ]. } apply Nat.succ_le_mono; assumption. } assert (H22 := H20 H21); repeat rewrite H22. { reflexivity. } { rewrite <- H19; assert (H23 : pos_Rl l2 (S i - length l1) <= pos_Rl l2 (S (S i - length l1))). { apply H7; apply Nat.lt_succ_lt_pred. rewrite <- Nat.sub_succ_l. { apply Nat.add_lt_mono_l with (length l1); rewrite Nat.add_comm, Nat.sub_add. { rewrite H19 in H1; simpl in H1; rewrite H19; simpl; rewrite length_app in H1; apply -> Nat.succ_lt_mono; assumption. } apply Nat.le_trans with (S i); [ apply Nat.succ_le_mono; assumption | apply Nat.le_succ_diag_r ]. } apply Nat.succ_le_mono; assumption. } elim H23; intro. { split. { apply Rmult_lt_reg_l with 2; [ prove_sup0 | unfold Rdiv; rewrite <- (Rmult_comm (/ 2)); rewrite <- Rmult_assoc; rewrite Rinv_r; [ rewrite Rmult_1_l; rewrite <-Rplus_diag; apply Rplus_lt_compat_l; assumption | discrR ] ]. } apply Rmult_lt_reg_l with 2; [ prove_sup0 | unfold Rdiv; rewrite <- (Rmult_comm (/ 2)); rewrite <- Rmult_assoc; rewrite Rinv_r; [ rewrite Rmult_1_l; rewrite (Rplus_comm (pos_Rl l2 (S i - length l1))); rewrite <-Rplus_diag; apply Rplus_lt_compat_l; assumption | discrR ] ]. } rewrite <- H19 in H16; rewrite <- H19 in H17; elim H2; intros; rewrite H19 in H25; rewrite H19 in H26; simpl in H25; simpl in H16; rewrite H16 in H25; simpl in H26; simpl in H17; rewrite H17 in H26; simpl in H24; rewrite H24 in H25; elim (Rlt_irrefl _ (Rlt_trans _ _ _ H25 H26)). } assert (H23 : pos_Rl (app l1 l2) (S i) = pos_Rl l2 (S i - length l1)). { rewrite H19; simpl; simpl in H16; apply H16. } assert (H24 : pos_Rl (app l1 l2) (S (S i)) = pos_Rl l2 (S (S i - length l1))). { rewrite H19; simpl; simpl in H17; apply H17. } rewrite <- H23; rewrite <- H24; assumption. Qed. Lemma StepFun_P41 : forall (f:R -> R) (a b c:R), a <= b -> b <= c -> IsStepFun f a b -> IsStepFun f b c -> IsStepFun f a c. Proof. intros f a b c H H0 (l1,(lf1,H1)) (l2,(lf2,H2)); destruct (total_order_T a b) as [[Hltab|Hab]|Hgtab]. - destruct (total_order_T b c) as [[Hltbc|Hbc]|Hgtbc]. + exists (app l1 l2); exists (FF (app l1 l2) f); apply StepFun_P40 with b lf1 lf2; assumption. + exists l1; exists lf1; rewrite Hbc in H1; assumption. + elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H0 Hgtbc)). - exists l2; exists lf2; rewrite <- Hab in H2; assumption. - elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H Hgtab)). Qed. Lemma StepFun_P42 : forall (l1 l2:list R) (f:R -> R), pos_Rl l1 (pred (length l1)) = pos_Rl l2 0 -> Int_SF (FF (app l1 l2) f) (app l1 l2) = Int_SF (FF l1 f) l1 + Int_SF (FF l2 f) l2. Proof. intros l1 l2 f; induction l1 as [| r l1 IHl1]; intros H; [ simpl; ring | destruct l1 as [| r0 r1]; [ simpl in H; simpl; destruct l2 as [| r0 r1]; [ simpl; ring | simpl; simpl in H; rewrite H; ring ] | simpl; rewrite Rplus_assoc; apply Rplus_eq_compat_l; apply IHl1; rewrite <- H; reflexivity ] ]. Qed. Lemma StepFun_P43 : forall (f:R -> R) (a b c:R) (pr1:IsStepFun f a b) (pr2:IsStepFun f b c) (pr3:IsStepFun f a c), RiemannInt_SF (mkStepFun pr1) + RiemannInt_SF (mkStepFun pr2) = RiemannInt_SF (mkStepFun pr3). Proof. intros f; intros. pose proof pr1 as (l1,(lf1,H1)). pose proof pr2 as (l2,(lf2,H2)). pose proof pr3 as (l3,(lf3,H3)). replace (RiemannInt_SF (mkStepFun pr1)) with match Rle_dec a b with | left _ => Int_SF lf1 l1 | right _ => - Int_SF lf1 l1 end. 1:replace (RiemannInt_SF (mkStepFun pr2)) with match Rle_dec b c with | left _ => Int_SF lf2 l2 | right _ => - Int_SF lf2 l2 end. 1:replace (RiemannInt_SF (mkStepFun pr3)) with match Rle_dec a c with | left _ => Int_SF lf3 l3 | right _ => - Int_SF lf3 l3 end. 2,3,4:unfold RiemannInt_SF; case (Rle_dec _ _); intro;[|apply Ropp_eq_compat]; (eapply StepFun_P17;[|apply StepFun_P1]);assumption. case (Rle_dec a b) as [Hle|Hnle]; case (Rle_dec b c) as [Hle'|Hnle']; case (Rle_dec a c) as [Hle''|Hnle'']. - elim Hle; intro. 1:elim Hle'; intro. + replace (Int_SF lf3 l3) with (Int_SF (FF (app l1 l2) f) (app l1 l2)). 2:{ eapply StepFun_P17; [ apply (StepFun_P40 H H0 H1 H2) | apply H3 ]. } replace (Int_SF lf1 l1) with (Int_SF (FF l1 f) l1). { replace (Int_SF lf2 l2) with (Int_SF (FF l2 f) l2). { symmetry ; apply StepFun_P42. unfold adapted_couple in H1, H2; decompose [and] H1; decompose [and] H2; clear H1 H2; rewrite H11; rewrite H5; unfold Rmax, Rmin; decide (Rle_dec a b) with Hle; decide (Rle_dec b c) with Hle'; reflexivity. } eapply StepFun_P17; [ apply StepFun_P21; unfold is_subdivision; split with lf2; apply H2; assumption | assumption ]. } eapply StepFun_P17; [ apply StepFun_P21; unfold is_subdivision; split with lf1; apply H1 | assumption ]. + replace (Int_SF lf2 l2) with 0. { rewrite Rplus_0_r; eapply StepFun_P17; [ apply H1 | rewrite <- H0 in H3; apply H3 ]. } symmetry ; eapply StepFun_P8; [ apply H2 | assumption ]. + replace (Int_SF lf1 l1) with 0. { rewrite Rplus_0_l; eapply StepFun_P17; [ apply H2 | rewrite H in H3; apply H3 ]. } symmetry ; eapply StepFun_P8; [ apply H1 | assumption ]. - elim Hnle''; apply Rle_trans with b; assumption. - apply Rplus_eq_reg_l with (Int_SF lf2 l2); replace (Int_SF lf2 l2 + (Int_SF lf1 l1 + - Int_SF lf2 l2)) with (Int_SF lf1 l1); [ idtac | ring ]. assert (H : c < b). { auto with real. } elim Hle''; intro. { rewrite Rplus_comm; replace (Int_SF lf1 l1) with (Int_SF (FF (app l3 l2) f) (app l3 l2)). { replace (Int_SF lf3 l3) with (Int_SF (FF l3 f) l3). { replace (Int_SF lf2 l2) with (Int_SF (FF l2 f) l2). { apply StepFun_P42. unfold adapted_couple in H2, H3; decompose [and] H2; decompose [and] H3; clear H3 H2; rewrite H10; rewrite H6; unfold Rmax, Rmin. decide (Rle_dec a c) with Hle''; decide (Rle_dec b c) with Hnle'; reflexivity. } eapply StepFun_P17; [ apply StepFun_P21; unfold is_subdivision; split with lf2; apply H2 | assumption ]. } eapply StepFun_P17; [ apply StepFun_P21; unfold is_subdivision; split with lf3; apply H3 | assumption ]. } eapply StepFun_P17; [ apply (StepFun_P40 H0 H H3 (StepFun_P2 H2)) | apply H1 ]. } replace (Int_SF lf3 l3) with 0. { rewrite Rplus_0_r; eapply StepFun_P17; [ apply H1 | apply StepFun_P2; rewrite <- H0 in H2; apply H2 ]. } symmetry ; eapply StepFun_P8; [ apply H3 | assumption ]. - replace (Int_SF lf2 l2) with (Int_SF lf3 l3 + Int_SF lf1 l1). { ring. } elim Hle; intro. { replace (Int_SF lf2 l2) with (Int_SF (FF (app l3 l1) f) (app l3 l1)). { replace (Int_SF lf3 l3) with (Int_SF (FF l3 f) l3). { replace (Int_SF lf1 l1) with (Int_SF (FF l1 f) l1). { symmetry ; apply StepFun_P42. unfold adapted_couple in H1, H3; decompose [and] H1; decompose [and] H3; clear H3 H1; rewrite H9; rewrite H5; unfold Rmax, Rmin; decide (Rle_dec a c) with Hnle''; decide (Rle_dec a b) with Hle; reflexivity. } eapply StepFun_P17; [ apply StepFun_P21; unfold is_subdivision; split with lf1; apply H1 | assumption ]. } eapply StepFun_P17; [ apply StepFun_P21; unfold is_subdivision; split with lf3; apply H3 | assumption ]. } eapply StepFun_P17. { assert (H0 : c < a). { auto with real. } apply (StepFun_P40 H0 H (StepFun_P2 H3) H1). } apply StepFun_P2; apply H2. } replace (Int_SF lf1 l1) with 0. { rewrite Rplus_0_r; eapply StepFun_P17; [ apply H3 | rewrite <- H in H2; apply H2 ]. } symmetry ; eapply StepFun_P8; [ apply H1 | assumption ]. - assert (H : b < a). { auto with real. } replace (Int_SF lf2 l2) with (Int_SF lf3 l3 + Int_SF lf1 l1). { ring. } rewrite Rplus_comm; elim Hle''; intro. { replace (Int_SF lf2 l2) with (Int_SF (FF (app l1 l3) f) (app l1 l3)). { replace (Int_SF lf3 l3) with (Int_SF (FF l3 f) l3). { replace (Int_SF lf1 l1) with (Int_SF (FF l1 f) l1). { symmetry ; apply StepFun_P42. unfold adapted_couple in H1, H3; decompose [and] H1; decompose [and] H3; clear H3 H1; rewrite H11; rewrite H5; unfold Rmax, Rmin; decide (Rle_dec a c) with Hle''; decide (Rle_dec a b) with Hnle; reflexivity. } eapply StepFun_P17; [ apply StepFun_P21; unfold is_subdivision; split with lf1; apply H1 | assumption ]. } eapply StepFun_P17; [ apply StepFun_P21; unfold is_subdivision; split with lf3; apply H3 | assumption ]. } eapply StepFun_P17. { apply (StepFun_P40 H H0 (StepFun_P2 H1) H3). } apply H2. } replace (Int_SF lf3 l3) with 0. { rewrite Rplus_0_r; eapply StepFun_P17; [ apply H1 | rewrite <- H0 in H2; apply StepFun_P2; apply H2 ]. } symmetry ; eapply StepFun_P8; [ apply H3 | assumption ]. - assert (H : c < a). { auto with real. } replace (Int_SF lf1 l1) with (Int_SF lf2 l2 + Int_SF lf3 l3). { ring. } elim Hle'; intro. { replace (Int_SF lf1 l1) with (Int_SF (FF (app l2 l3) f) (app l2 l3)). { replace (Int_SF lf3 l3) with (Int_SF (FF l3 f) l3). { replace (Int_SF lf2 l2) with (Int_SF (FF l2 f) l2). { symmetry ; apply StepFun_P42. unfold adapted_couple in H2, H3; decompose [and] H2; decompose [and] H3; clear H3 H2; rewrite H11; rewrite H5; unfold Rmax, Rmin; decide (Rle_dec a c) with Hnle''; decide (Rle_dec b c) with Hle'; reflexivity. } eapply StepFun_P17; [ apply StepFun_P21; unfold is_subdivision; split with lf2; apply H2 | assumption ]. } eapply StepFun_P17; [ apply StepFun_P21; unfold is_subdivision; split with lf3; apply H3 | assumption ]. } eapply StepFun_P17. { apply (StepFun_P40 H0 H H2 (StepFun_P2 H3)). } apply StepFun_P2; apply H1. } replace (Int_SF lf2 l2) with 0. { rewrite Rplus_0_l; eapply StepFun_P17; [ apply H3 | rewrite H0 in H1; apply H1 ]. } symmetry; eapply StepFun_P8; [ apply H2 | assumption ]. - elim Hnle'; apply Rle_trans with a; try assumption. auto with real. - assert (H : c < b). { auto with real. } assert (H0 : b < a). { auto with real. } replace (Int_SF lf3 l3) with (Int_SF lf2 l2 + Int_SF lf1 l1). { ring. } replace (Int_SF lf3 l3) with (Int_SF (FF (app l2 l1) f) (app l2 l1)). { replace (Int_SF lf1 l1) with (Int_SF (FF l1 f) l1). { replace (Int_SF lf2 l2) with (Int_SF (FF l2 f) l2). { symmetry ; apply StepFun_P42. unfold adapted_couple in H2, H1; decompose [and] H2; decompose [and] H1; clear H1 H2; rewrite H11; rewrite H5; unfold Rmax, Rmin; decide (Rle_dec a b) with Hnle; decide (Rle_dec b c) with Hnle'; reflexivity. } eapply StepFun_P17; [ apply StepFun_P21; unfold is_subdivision; split with lf2; apply H2 | assumption ]. } eapply StepFun_P17; [ apply StepFun_P21; unfold is_subdivision; split with lf1; apply H1 | assumption ]. } eapply StepFun_P17. { apply (StepFun_P40 H H0 (StepFun_P2 H2) (StepFun_P2 H1)). } apply StepFun_P2; apply H3. Qed. Lemma StepFun_P44 : forall (f:R -> R) (a b c:R), IsStepFun f a b -> a <= c <= b -> IsStepFun f a c. Proof. intros f; intros; assert (H0 : a <= b). { elim H; intros; apply Rle_trans with c; assumption. } elim H; clear H; intros; unfold IsStepFun in X; unfold is_subdivision in X; elim X; clear X; intros l1 [lf1 H2]; cut (forall (l1 lf1:list R) (a b c:R) (f:R -> R), adapted_couple f a b l1 lf1 -> a <= c <= b -> { l:list R & { l0:list R & adapted_couple f a c l l0 } }). { intro X; unfold IsStepFun; unfold is_subdivision; eapply X. { apply H2. } split; assumption. } clear f a b c H0 H H1 H2 l1 lf1; simple induction l1. { intros; unfold adapted_couple in H; decompose [and] H; clear H; simpl in H4; discriminate. } intros r r0; elim r0. { intros X lf1 a b c f H H0; assert (H1 : a = b). { unfold adapted_couple in H; decompose [and] H; clear H; simpl in H3; simpl in H2; assert (H7 : a <= b). { elim H0; intros; apply Rle_trans with c; assumption. } replace a with (Rmin a b). { pattern b at 2; replace b with (Rmax a b). { rewrite <- H2; rewrite H3; reflexivity. } unfold Rmax; decide (Rle_dec a b) with H7; reflexivity. } unfold Rmin; decide (Rle_dec a b) with H7; reflexivity. } split with (cons r nil); split with lf1; assert (H2 : c = b). { rewrite H1 in H0; elim H0; intros; apply Rle_antisym; assumption. } rewrite H2; assumption. } intros r1 r2 _ X0 lf1 a b c f H H0; induction lf1 as [| r3 lf1 Hreclf1]. { unfold adapted_couple in H; decompose [and] H; clear H; simpl in H4; discriminate. } clear Hreclf1; assert (H1 : {c <= r1} + {r1 < c}). { case (Rle_dec c r1); intro; [ left; assumption | right; auto with real ]. } elim H1; intro a0. { split with (cons r (cons c nil)); split with (cons r3 nil); unfold adapted_couple in H; decompose [and] H; clear H; assert (H6 : r = a). { simpl in H4; rewrite H4; unfold Rmin; case (Rle_dec a b) as [|[]]; [ reflexivity | elim H0; intros; apply Rle_trans with c; assumption ]. } elim H0; clear H0; intros; unfold adapted_couple; repeat split. { rewrite H6; unfold ordered_Rlist; intros; simpl in H8; inversion H8; [ simpl; assumption | elim (Nat.nle_succ_0 _ H10) ]. } { simpl; unfold Rmin; decide (Rle_dec a c) with H; assumption. } { simpl; unfold Rmax; decide (Rle_dec a c) with H; reflexivity. } unfold constant_D_eq, open_interval; intros; simpl in H8; inversion H8. { simpl; assert (H10 := H7 0%nat); assert (H12 : (0 < pred (length (cons r (cons r1 r2))))%nat). { simpl; apply Nat.lt_0_succ. } apply (H10 H12); unfold open_interval; simpl; rewrite H11 in H9; simpl in H9; elim H9; clear H9; intros; split; try assumption. apply Rlt_le_trans with c; assumption. } elim (Nat.nle_succ_0 _ H11). } cut (adapted_couple f r1 b (cons r1 r2) lf1). { cut (r1 <= c <= b). { intros. elim (X0 _ _ _ _ _ H3 H2); intros l1' [lf1' H4]; split with (cons r l1'); split with (cons r3 lf1'); unfold adapted_couple in H, H4; decompose [and] H; decompose [and] H4; clear H H4 X0; assert (H14 : a <= b). { elim H0; intros; apply Rle_trans with c; assumption. } assert (H16 : r = a). { simpl in H7; rewrite H7; unfold Rmin; decide (Rle_dec a b) with H14; reflexivity. } induction l1' as [| r4 l1' Hrecl1']. { simpl in H13; discriminate. } clear Hrecl1'; unfold adapted_couple; repeat split. { unfold ordered_Rlist; intros; simpl in H; induction i as [| i Hreci]. { simpl; replace r4 with r1. { apply (H5 0%nat). simpl; apply Nat.lt_0_succ. } simpl in H12; rewrite H12; unfold Rmin; case (Rle_dec r1 c) as [|[]]; [ reflexivity | left; assumption ]. } apply (H9 i); simpl; apply Nat.succ_lt_mono; assumption. } { simpl; unfold Rmin; case (Rle_dec a c) as [|[]]; [ assumption | elim H0; intros; assumption ]. } { replace (Rmax a c) with (Rmax r1 c). { rewrite <- H11; reflexivity. } unfold Rmax; case (Rle_dec a c) as [|[]]; case (Rle_dec r1 c) as [|[]]; [ reflexivity | left; assumption | elim H0; intros; assumption | left; assumption ]. } { simpl; simpl in H13; rewrite H13; reflexivity. } intros; simpl in H; unfold constant_D_eq, open_interval; intros; induction i as [| i Hreci]. { simpl; assert (H17 := H10 0%nat); assert (H18 : (0 < pred (length (cons r (cons r1 r2))))%nat). { simpl; apply Nat.lt_0_succ. } apply (H17 H18); unfold open_interval; simpl; simpl in H4; elim H4; clear H4; intros; split; try assumption; replace r1 with r4. { assumption. } simpl in H12; rewrite H12; unfold Rmin; case (Rle_dec r1 c) as [|[]]; [ reflexivity | left; assumption ]. } clear Hreci; simpl; apply H15. { simpl; apply Nat.succ_lt_mono; assumption. } unfold open_interval; apply H4. } split. { left; assumption. } elim H0; intros; assumption. } eapply StepFun_P7; [ elim H0; intros; apply Rle_trans with c; [ apply H2 | apply H3 ] | apply H ]. Qed. Lemma StepFun_P45 : forall (f:R -> R) (a b c:R), IsStepFun f a b -> a <= c <= b -> IsStepFun f c b. Proof. intros f; intros; assert (H0 : a <= b). { elim H; intros; apply Rle_trans with c; assumption. } elim H; clear H; intros; unfold IsStepFun in X; unfold is_subdivision in X; elim X; clear X; intros l1 [lf1 H2]; cut (forall (l1 lf1:list R) (a b c:R) (f:R -> R), adapted_couple f a b l1 lf1 -> a <= c <= b -> { l:list R & { l0:list R & adapted_couple f c b l l0 } }). { intro X; unfold IsStepFun; unfold is_subdivision; eapply X; [ apply H2 | split; assumption ]. } clear f a b c H0 H H1 H2 l1 lf1; simple induction l1. { intros; unfold adapted_couple in H; decompose [and] H; clear H; simpl in H4; discriminate. } intros r r0; elim r0. { intros X lf1 a b c f H H0; assert (H1 : a = b). { unfold adapted_couple in H; decompose [and] H; clear H; simpl in H3; simpl in H2; assert (H7 : a <= b). { elim H0; intros; apply Rle_trans with c; assumption. } replace a with (Rmin a b). { pattern b at 2; replace b with (Rmax a b). { rewrite <- H2; rewrite H3; reflexivity. } unfold Rmax; decide (Rle_dec a b) with H7; reflexivity. } unfold Rmin; decide (Rle_dec a b) with H7; reflexivity. } split with (cons r nil); split with lf1; assert (H2 : c = b). { rewrite H1 in H0; elim H0; intros; apply Rle_antisym; assumption. } rewrite <- H2 in H1; rewrite <- H1; assumption. } intros r1 r2 _ X0 lf1 a b c f H H0; induction lf1 as [| r3 lf1 Hreclf1]. { unfold adapted_couple in H; decompose [and] H; clear H; simpl in H4; discriminate. } clear Hreclf1; assert (H1 : {c <= r1} + {r1 < c}). { case (Rle_dec c r1); intro; [ left; assumption | right; auto with real ]. } elim H1; intro a0. { split with (cons c (cons r1 r2)); split with (cons r3 lf1); unfold adapted_couple in H; decompose [and] H; clear H; unfold adapted_couple; repeat split. - unfold ordered_Rlist; intros; simpl in H; induction i as [| i Hreci]. { simpl; assumption. } clear Hreci; apply (H2 (S i)); simpl; assumption. - simpl; unfold Rmin; case (Rle_dec c b) as [|[]]; [ reflexivity | elim H0; intros; assumption ]. - replace (Rmax c b) with (Rmax a b). { rewrite <- H3; reflexivity. } unfold Rmax; case (Rle_dec c b) as [|[]]; case (Rle_dec a b) as [|[]]; [ reflexivity | elim H0; intros; apply Rle_trans with c; assumption | elim H0; intros; assumption | elim H0; intros; apply Rle_trans with c; assumption ]. - simpl; simpl in H5; apply H5. - intros; simpl in H; induction i as [| i Hreci]. { unfold constant_D_eq, open_interval; intros; simpl; apply (H7 0%nat). { simpl; apply Nat.lt_0_succ. } unfold open_interval; simpl; simpl in H6; elim H6; clear H6; intros; split; try assumption; apply Rle_lt_trans with c; try assumption; replace r with a. { elim H0; intros; assumption. } simpl in H4; rewrite H4; unfold Rmin; case (Rle_dec a b) as [|[]]; [ reflexivity | elim H0; intros; apply Rle_trans with c; assumption ]. } clear Hreci; apply (H7 (S i)); simpl; assumption. } cut (adapted_couple f r1 b (cons r1 r2) lf1). { cut (r1 <= c <= b). { intros; elim (X0 _ _ _ _ _ H3 H2); intros l1' [lf1' H4]; split with l1'; split with lf1'; assumption. } split; [ left; assumption | elim H0; intros; assumption ]. } eapply StepFun_P7; [ elim H0; intros; apply Rle_trans with c; [ apply H2 | apply H3 ] | apply H ]. Qed. Lemma StepFun_P46 : forall (f:R -> R) (a b c:R), IsStepFun f a b -> IsStepFun f b c -> IsStepFun f a c. Proof. intros f; intros; case (Rle_dec a b); case (Rle_dec b c); intros. - apply StepFun_P41 with b; assumption. - case (Rle_dec a c); intro. + apply StepFun_P44 with b; try assumption. split; [ assumption | auto with real ]. + apply StepFun_P6; apply StepFun_P44 with b. * apply StepFun_P6; assumption. * split; auto with real. - case (Rle_dec a c); intro. + apply StepFun_P45 with b; try assumption. split; auto with real. + apply StepFun_P6; apply StepFun_P45 with b. * apply StepFun_P6; assumption. * split; [ assumption | auto with real ]. - apply StepFun_P6; apply StepFun_P41 with b; auto with real || apply StepFun_P6; assumption. Qed. coq-8.20.0/theories/Reals/Rlimit.v000066400000000000000000000507401466560755400167320ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* 0 -> eps * / 2 > 0. Proof. intros; lra. Qed. (*********) Lemma eps2 : forall eps:R, eps * / 2 + eps * / 2 = eps. Proof. intro esp. apply Rplus_half_diag. Qed. (*********) Lemma eps4 : forall eps:R, eps * / (2 + 2) + eps * / (2 + 2) = eps * / 2. Proof. intro eps. field. Qed. (*********) Lemma Rlt_eps2_eps : forall eps:R, eps > 0 -> eps * / 2 < eps. Proof. intros. lra. Qed. (*********) Lemma Rlt_eps4_eps : forall eps:R, eps > 0 -> eps * / (2 + 2) < eps. Proof. intros. lra. Qed. (*********) Lemma prop_eps : forall r:R, (forall eps:R, eps > 0 -> r < eps) -> r <= 0. Proof. intros; elim (Rtotal_order r 0); intro. - apply Rlt_le; assumption. - elim H0; intro. + apply Req_le; assumption. + clear H0; generalize (H r H1); intro; generalize (Rlt_irrefl r); intro; exfalso; auto. Qed. (*********) Definition mul_factor (l l':R) := / (1 + (Rabs l + Rabs l')). (*********) Lemma mul_factor_wd : forall l l':R, 1 + (Rabs l + Rabs l') <> 0. Proof. intros; rewrite (Rplus_comm 1 (Rabs l + Rabs l')); apply Rplus_le_lt_0_neq_0. - cut (Rabs (l + l') <= Rabs l + Rabs l'). + cut (0 <= Rabs (l + l')). * exact (Rle_trans _ _ _). * exact (Rabs_pos (l + l')). + exact (Rabs_triang _ _). - exact Rlt_0_1. Qed. (*********) Lemma mul_factor_gt : forall eps l l':R, eps > 0 -> eps * mul_factor l l' > 0. Proof. intros; unfold Rgt; rewrite <- (Rmult_0_r eps); apply Rmult_lt_compat_l. - assumption. - unfold mul_factor; apply Rinv_0_lt_compat; cut (1 <= 1 + (Rabs l + Rabs l')). + cut (0 < 1). * exact (Rlt_le_trans _ _ _). * exact Rlt_0_1. + replace (1 <= 1 + (Rabs l + Rabs l')) with (1 + 0 <= 1 + (Rabs l + Rabs l')). * apply Rplus_le_compat_l. cut (Rabs (l + l') <= Rabs l + Rabs l'). -- cut (0 <= Rabs (l + l')). ++ exact (Rle_trans _ _ _). ++ exact (Rabs_pos _). -- exact (Rabs_triang _ _). * rewrite (proj1 (Rplus_ne 1)); trivial. Qed. (*********) Lemma mul_factor_gt_f : forall eps l l':R, eps > 0 -> Rmin 1 (eps * mul_factor l l') > 0. intros; apply Rmin_Rgt_r; split. - exact Rlt_0_1. - exact (mul_factor_gt eps l l' H). Qed. (*******************************) (** * Metric space *) (*******************************) (*********) Record Metric_Space : Type := {Base : Type; dist : Base -> Base -> R; dist_pos : forall x y:Base, dist x y >= 0; dist_sym : forall x y:Base, dist x y = dist y x; dist_refl : forall x y:Base, dist x y = 0 <-> x = y; dist_tri : forall x y z:Base, dist x y <= dist x z + dist z y}. (*******************************) (** ** Limit in Metric space *) (*******************************) (*********) Definition limit_in (X X':Metric_Space) (f:Base X -> Base X') (D:Base X -> Prop) (x0:Base X) (l:Base X') := forall eps:R, eps > 0 -> exists alp : R, alp > 0 /\ (forall x:Base X, D x /\ (dist X) x x0 < alp -> (dist X') (f x) l < eps). (*******************************) (** ** R is a metric space *) (*******************************) (*********) Definition R_met : Metric_Space := Build_Metric_Space R Rdist Rdist_pos Rdist_sym Rdist_refl Rdist_tri. Declare Equivalent Keys dist Rdist. (*******************************) (** * Limit 1 arg *) (*******************************) (*********) Definition Dgf (Df Dg:R -> Prop) (f:R -> R) (x:R) := Df x /\ Dg (f x). (*********) Definition limit1_in (f:R -> R) (D:R -> Prop) (l x0:R) : Prop := limit_in R_met R_met f D x0 l. (*********) Lemma tech_limit : forall (f:R -> R) (D:R -> Prop) (l x0:R), D x0 -> limit1_in f D l x0 -> l = f x0. Proof. intros f D l x0 H H0. case (Rabs_pos (f x0 - l)); intros H1. - absurd ((@dist R_met) (f x0) l < (@dist R_met) (f x0) l). + apply Rlt_irrefl. + case (H0 ((@dist R_met) (f x0) l)); auto. intros alpha1 [H2 H3]; apply H3; auto; split; auto. case (dist_refl R_met x0 x0); intros Hr1 Hr2; rewrite Hr2; auto. - case (dist_refl R_met (f x0) l); intros Hr1 Hr2; symmetry; auto. Qed. (*********) Lemma tech_limit_contr : forall (f:R -> R) (D:R -> Prop) (l x0:R), D x0 -> l <> f x0 -> ~ limit1_in f D l x0. Proof. intros; generalize (tech_limit f D l x0); tauto. Qed. (*********) Lemma lim_x : forall (D:R -> Prop) (x0:R), limit1_in (fun x:R => x) D x0 x0. Proof. unfold limit1_in; unfold limit_in; simpl; intros; split with eps; split; auto; intros; elim H0; intros; auto. Qed. (*********) Lemma limit_plus : forall (f g:R -> R) (D:R -> Prop) (l l' x0:R), limit1_in f D l x0 -> limit1_in g D l' x0 -> limit1_in (fun x:R => f x + g x) D (l + l') x0. Proof. intros; unfold limit1_in; unfold limit_in; simpl; intros; elim (H (eps * / 2) (eps2_Rgt_R0 eps H1)); elim (H0 (eps * / 2) (eps2_Rgt_R0 eps H1)); simpl; clear H H0; intros; elim H; elim H0; clear H H0; intros; split with (Rmin x1 x); split. - exact (Rmin_Rgt_r x1 x 0 (conj H H2)). - intros; elim H4; clear H4; intros; cut (Rdist (f x2) l + Rdist (g x2) l' < eps). + cut (Rdist (f x2 + g x2) (l + l') <= Rdist (f x2) l + Rdist (g x2) l'). * exact (Rle_lt_trans _ _ _). * exact (Rdist_plus _ _ _ _). + elim (Rmin_Rgt_l x1 x (Rdist x2 x0) H5); clear H5; intros. generalize (H3 x2 (conj H4 H6)); generalize (H0 x2 (conj H4 H5)); intros; replace eps with (eps * / 2 + eps * / 2). * exact (Rplus_lt_compat _ _ _ _ H7 H8). * exact (eps2 eps). Qed. (*********) Lemma limit_Ropp : forall (f:R -> R) (D:R -> Prop) (l x0:R), limit1_in f D l x0 -> limit1_in (fun x:R => - f x) D (- l) x0. Proof. unfold limit1_in; unfold limit_in; simpl; intros; elim (H eps H0); clear H; intros; elim H; clear H; intros; split with x; split; auto; intros; generalize (H1 x1 H2); clear H1; intro; unfold Rdist; unfold Rminus; rewrite (Ropp_involutive l); rewrite (Rplus_comm (- f x1) l); fold (l - f x1); fold (Rdist l (f x1)); rewrite Rdist_sym; assumption. Qed. (*********) Lemma limit_minus : forall (f g:R -> R) (D:R -> Prop) (l l' x0:R), limit1_in f D l x0 -> limit1_in g D l' x0 -> limit1_in (fun x:R => f x - g x) D (l - l') x0. Proof. intros; unfold Rminus; generalize (limit_Ropp g D l' x0 H0); intro; exact (limit_plus f (fun x:R => - g x) D l (- l') x0 H H1). Qed. (*********) Lemma limit_free : forall (f:R -> R) (D:R -> Prop) (x x0:R), limit1_in (fun h:R => f x) D (f x) x0. Proof. unfold limit1_in; unfold limit_in; simpl; intros; split with eps; split; auto; intros; elim (Rdist_refl (f x) (f x)); intros a b; rewrite (b (eq_refl (f x))); unfold Rgt in H; assumption. Qed. (*********) Lemma limit_mul : forall (f g:R -> R) (D:R -> Prop) (l l' x0:R), limit1_in f D l x0 -> limit1_in g D l' x0 -> limit1_in (fun x:R => f x * g x) D (l * l') x0. Proof. intros; unfold limit1_in; unfold limit_in; simpl; intros; elim (H (Rmin 1 (eps * mul_factor l l')) (mul_factor_gt_f eps l l' H1)); elim (H0 (eps * mul_factor l l') (mul_factor_gt eps l l' H1)); clear H H0; simpl; intros; elim H; elim H0; clear H H0; intros; split with (Rmin x1 x); split. { exact (Rmin_Rgt_r x1 x 0 (conj H H2)). } intros; elim H4; clear H4; intros; unfold Rdist; replace (f x2 * g x2 - l * l') with (f x2 * (g x2 - l') + l' * (f x2 - l)). - cut (Rabs (f x2 * (g x2 - l')) + Rabs (l' * (f x2 - l)) < eps). { cut (Rabs (f x2 * (g x2 - l') + l' * (f x2 - l)) <= Rabs (f x2 * (g x2 - l')) + Rabs (l' * (f x2 - l))). - exact (Rle_lt_trans _ _ _). - exact (Rabs_triang _ _). } rewrite (Rabs_mult (f x2) (g x2 - l')); rewrite (Rabs_mult l' (f x2 - l)); cut ((1 + Rabs l) * (eps * mul_factor l l') + Rabs l' * (eps * mul_factor l l') <= eps). 1:cut (Rabs (f x2) * Rabs (g x2 - l') + Rabs l' * Rabs (f x2 - l) < (1 + Rabs l) * (eps * mul_factor l l') + Rabs l' * (eps * mul_factor l l')). + exact (Rlt_le_trans _ _ _). + elim (Rmin_Rgt_l x1 x (Rdist x2 x0) H5); clear H5; intros; generalize (H0 x2 (conj H4 H5)); intro; generalize (Rmin_Rgt_l _ _ _ H7); intro; elim H8; intros; clear H0 H8; apply Rplus_lt_le_compat. * apply Rmult_ge_0_gt_0_lt_compat. -- apply Rle_ge. exact (Rabs_pos (g x2 - l')). -- rewrite (Rplus_comm 1 (Rabs l)); unfold Rgt; apply Rplus_le_lt_0_compat with (1 := (Rabs_pos l)); exact Rlt_0_1. -- unfold Rdist in H9; apply (Rplus_lt_reg_l (- Rabs l) (Rabs (f x2)) (1 + Rabs l)). rewrite <- (Rplus_assoc (- Rabs l) 1 (Rabs l)); rewrite (Rplus_comm (- Rabs l) 1); rewrite (Rplus_assoc 1 (- Rabs l) (Rabs l)); rewrite (Rplus_opp_l (Rabs l)); rewrite (proj1 (Rplus_ne 1)); rewrite (Rplus_comm (- Rabs l) (Rabs (f x2))); generalize H9; cut (Rabs (f x2) - Rabs l <= Rabs (f x2 - l)). ++ exact (Rle_lt_trans _ _ _). ++ exact (Rabs_triang_inv _ _). -- generalize (H3 x2 (conj H4 H6)); trivial. * apply Rmult_le_compat_l. -- exact (Rabs_pos l'). -- unfold Rle; left; assumption. + rewrite (Rmult_comm (1 + Rabs l) (eps * mul_factor l l')); rewrite (Rmult_comm (Rabs l') (eps * mul_factor l l')); rewrite <- (Rmult_plus_distr_l (eps * mul_factor l l') (1 + Rabs l) (Rabs l')) ; rewrite (Rmult_assoc eps (mul_factor l l') (1 + Rabs l + Rabs l')); rewrite (Rplus_assoc 1 (Rabs l) (Rabs l')); unfold mul_factor; rewrite (Rinv_l (1 + (Rabs l + Rabs l')) (mul_factor_wd l l')); rewrite (proj1 (Rmult_ne eps)); apply Req_le; trivial. - ring. Qed. (*********) Definition adhDa (D:R -> Prop) (a:R) : Prop := forall alp:R, alp > 0 -> exists x : R, D x /\ Rdist x a < alp. (*********) Lemma single_limit : forall (f:R -> R) (D:R -> Prop) (l l' x0:R), adhDa D x0 -> limit1_in f D l x0 -> limit1_in f D l' x0 -> l = l'. Proof. unfold limit1_in; unfold limit_in; intros. simpl in *. cut (forall eps:R, eps > 0 -> dist R_met l l' < 2 * eps). - clear H0 H1; unfold dist in |- *; unfold R_met; unfold Rdist in |- *; unfold Rabs; case (Rcase_abs (l - l')) as [Hlt|Hge]; intros. + cut (forall eps:R, eps > 0 -> - (l - l') < eps). * intro; generalize (prop_eps (- (l - l')) H1); intro; generalize (Ropp_gt_lt_0_contravar (l - l') Hlt); intro; unfold Rgt in H3; generalize (Rgt_not_le (- (l - l')) 0 H3); intro; exfalso; auto. * intros; cut (eps * / 2 > 0). -- intro; generalize (H0 (eps * / 2) H2); rewrite (Rmult_comm eps (/ 2)); rewrite <- (Rmult_assoc 2 (/ 2) eps); rewrite (Rinv_r 2). ++ elim (Rmult_ne eps); intros a b; rewrite b; clear a b; trivial. ++ apply (Rlt_dichotomy_converse 2 0); right; generalize Rlt_0_1; intro; unfold Rgt; generalize (Rplus_lt_compat_l 1 0 1 H3); intro; elim (Rplus_ne 1); intros a b; rewrite a in H4; clear a b; apply (Rlt_trans 0 1 2 H3 H4). -- unfold Rgt; unfold Rgt in H1; rewrite (Rmult_comm eps (/ 2)); rewrite <- (Rmult_0_r (/ 2)); apply (Rmult_lt_compat_l (/ 2) 0 eps); auto. apply (Rinv_0_lt_compat 2); cut (1 < 2). ++ intro; apply (Rlt_trans 0 1 2 Rlt_0_1 H2). ++ generalize (Rplus_lt_compat_l 1 0 1 Rlt_0_1); elim (Rplus_ne 1); intros a b; rewrite a; clear a b; trivial. + (**) cut (forall eps:R, eps > 0 -> l - l' < eps). * intro; generalize (prop_eps (l - l') H1); intro; elim (Rle_le_eq (l - l') 0); intros a b; clear b; apply (Rminus_diag_uniq l l'); apply a; split. -- assumption. -- apply (Rge_le (l - l') 0 Hge). * intros; cut (eps * / 2 > 0). -- intro; generalize (H0 (eps * / 2) H2); rewrite (Rmult_comm eps (/ 2)); rewrite <- (Rmult_assoc 2 (/ 2) eps); rewrite (Rinv_r 2). ++ elim (Rmult_ne eps); intros a b; rewrite b; clear a b; trivial. ++ apply (Rlt_dichotomy_converse 2 0); right; generalize Rlt_0_1; intro; unfold Rgt; generalize (Rplus_lt_compat_l 1 0 1 H3); intro; elim (Rplus_ne 1); intros a b; rewrite a in H4; clear a b; apply (Rlt_trans 0 1 2 H3 H4). -- unfold Rgt; unfold Rgt in H1; rewrite (Rmult_comm eps (/ 2)); rewrite <- (Rmult_0_r (/ 2)); apply (Rmult_lt_compat_l (/ 2) 0 eps); auto. apply (Rinv_0_lt_compat 2); cut (1 < 2). ++ intro; apply (Rlt_trans 0 1 2 Rlt_0_1 H2). ++ generalize (Rplus_lt_compat_l 1 0 1 Rlt_0_1); elim (Rplus_ne 1); intros a b; rewrite a; clear a b; trivial. - (**) intros; unfold adhDa in H; elim (H0 eps H2); intros; elim (H1 eps H2); intros; clear H0 H1; elim H3; elim H4; clear H3 H4; intros; simpl; simpl in H1, H4; generalize (Rmin_Rgt x x1 0); intro; elim H5; intros; clear H5; elim (H (Rmin x x1) (H7 (conj H3 H0))); intros; elim H5; intros; clear H5 H H6 H7; generalize (Rmin_Rgt x x1 (Rdist x2 x0)); intro; elim H; intros; clear H H6; unfold Rgt in H5; elim (H5 H9); intros; clear H5 H9; generalize (H1 x2 (conj H8 H6)); generalize (H4 x2 (conj H8 H)); clear H8 H H6 H1 H4 H0 H3; intros; generalize (Rplus_lt_compat (Rdist (f x2) l) eps (Rdist (f x2) l') eps H H0); unfold Rdist; intros; rewrite (Rabs_minus_sym (f x2) l) in H1; rewrite (Rmult_comm 2 eps); replace (eps *2) with (eps + eps) by ring; generalize (Rdist_tri l l' (f x2)); unfold Rdist; intros; apply (Rle_lt_trans (Rabs (l - l')) (Rabs (l - f x2) + Rabs (f x2 - l')) (eps + eps) H3 H1). Qed. (*********) Lemma limit_comp : forall (f g:R -> R) (Df Dg:R -> Prop) (l l' x0:R), limit1_in f Df l x0 -> limit1_in g Dg l' l -> limit1_in (fun x:R => g (f x)) (Dgf Df Dg f) l' x0. Proof. unfold limit1_in, limit_in, Dgf; simpl. intros f g Df Dg l l' x0 Hf Hg eps eps_pos. elim (Hg eps eps_pos). intros alpg lg. elim (Hf alpg). 2: tauto. intros alpf lf. exists alpf. intuition. Qed. (*********) Lemma limit_inv : forall (f:R -> R) (D:R -> Prop) (l x0:R), limit1_in f D l x0 -> l <> 0 -> limit1_in (fun x:R => / f x) D (/ l) x0. Proof. unfold limit1_in; unfold limit_in; simpl; unfold Rdist; intros; elim (H (Rabs l / 2)). - intros delta1 H2; elim (H (eps * (Rsqr l / 2))). + intros delta2 H3; elim H2; elim H3; intros; exists (Rmin delta1 delta2); split. { unfold Rmin; case (Rle_dec delta1 delta2); intro; assumption. } intro; generalize (H5 x); clear H5; intro H5; generalize (H7 x); clear H7; intro H7; intro H10; elim H10; intros; cut (D x /\ Rabs (x - x0) < delta1). * cut (D x /\ Rabs (x - x0) < delta2). -- intros; generalize (H5 H11); clear H5; intro H5; generalize (H7 H12); clear H7; intro H7; generalize (Rabs_triang_inv l (f x)); intro; rewrite Rabs_minus_sym in H7; generalize (Rle_lt_trans (Rabs l - Rabs (f x)) (Rabs (l - f x)) (Rabs l / 2) H13 H7); intro; generalize (Rplus_lt_compat_l (Rabs (f x) - Rabs l / 2) (Rabs l - Rabs (f x)) (Rabs l / 2) H14); replace (Rabs (f x) - Rabs l / 2 + (Rabs l - Rabs (f x))) with (Rabs l / 2). ++ unfold Rminus; rewrite Rplus_assoc; rewrite Rplus_opp_l; rewrite Rplus_0_r; intro; cut (f x <> 0). ** intro; replace (/ f x + - / l) with ((l - f x) * / (l * f x)). { rewrite Rabs_mult; rewrite Rabs_inv. cut (/ Rabs (l * f x) < 2 / Rsqr l). - intro; rewrite Rabs_minus_sym in H5; cut (0 <= / Rabs (l * f x)). + intro; generalize (Rmult_le_0_lt_compat (Rabs (l - f x)) (eps * (Rsqr l / 2)) (/ Rabs (l * f x)) (2 / Rsqr l) (Rabs_pos (l - f x)) H18 H5 H17); replace (eps * (Rsqr l / 2) * (2 / Rsqr l)) with eps. * intro; assumption. * unfold Rdiv; unfold Rsqr; rewrite Rinv_mult. field. exact H0. + left; apply Rinv_0_lt_compat; apply Rabs_pos_lt; apply prod_neq_R0; assumption. - rewrite Rmult_comm; rewrite Rabs_mult; rewrite Rinv_mult. rewrite (Rsqr_abs l); unfold Rsqr; unfold Rdiv; rewrite Rinv_mult. repeat rewrite <- Rmult_assoc; apply Rmult_lt_compat_r. + apply Rinv_0_lt_compat; apply Rabs_pos_lt; assumption. + apply Rmult_lt_reg_l with (Rabs (f x) * Rabs l * / 2). * repeat apply Rmult_lt_0_compat. -- apply Rabs_pos_lt; assumption. -- apply Rabs_pos_lt; assumption. -- apply Rinv_0_lt_compat; cut (0%nat <> 2%nat); [ intro H17; generalize (lt_INR_0 2 (proj1 (Nat.neq_0_lt_0 2) (Nat.neq_sym 0 2 H17))); unfold INR; intro H18; assumption | discriminate ]. * replace (Rabs (f x) * Rabs l * / 2 * / Rabs (f x)) with (Rabs l / 2). -- replace (Rabs (f x) * Rabs l * / 2 * (2 * / Rabs l)) with (Rabs (f x)). ++ assumption. ++ field. apply Rabs_no_R0. assumption. -- field. apply Rabs_no_R0; assumption. } field. now split. ** red; intro; rewrite H16 in H15; rewrite Rabs_R0 in H15; cut (0 < Rabs l / 2). { intro; elim (Rlt_irrefl 0 (Rlt_trans 0 (Rabs l / 2) 0 H17 H15)). } unfold Rdiv; apply Rmult_lt_0_compat. { apply Rabs_pos_lt; assumption. } apply Rinv_0_lt_compat; cut (0%nat <> 2%nat); [ intro H17; generalize (lt_INR_0 2 (proj1 (Nat.neq_0_lt_0 2) (Nat.neq_sym 0 2 H17))); unfold INR; intro; assumption | discriminate ]. ++ pattern (Rabs l) at 3; rewrite <-Rplus_half_diag. ring. -- split; [ assumption | apply Rlt_le_trans with (Rmin delta1 delta2); [ assumption | apply Rmin_r ] ]. * split; [ assumption | apply Rlt_le_trans with (Rmin delta1 delta2); [ assumption | apply Rmin_l ] ]. + change (0 < eps * (Rsqr l / 2)); unfold Rdiv; repeat rewrite Rmult_assoc; apply Rmult_lt_0_compat. * assumption. * apply Rmult_lt_0_compat. -- apply Rsqr_pos_lt; assumption. -- apply Rinv_0_lt_compat; cut (0%nat <> 2%nat); [ intro H3; generalize (lt_INR_0 2 (proj1 (Nat.neq_0_lt_0 2) (Nat.neq_sym 0 2 H3))); unfold INR; intro; assumption | discriminate ]. - change (0 < Rabs l / 2); unfold Rdiv; apply Rmult_lt_0_compat; [ apply Rabs_pos_lt; assumption | apply Rinv_0_lt_compat; cut (0%nat <> 2%nat); [ intro H3; generalize (lt_INR_0 2 (proj1 (Nat.neq_0_lt_0 2) (Nat.neq_sym 0 2 H3))); unfold INR; intro; assumption | discriminate ] ]. Qed. coq-8.20.0/theories/Reals/Rlogic.v000066400000000000000000000142661466560755400167140ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* Prop. Hypothesis HP : forall n, {P n} + {~P n}. Lemma sig_forall_dec : {n | ~P n} + {forall n, P n}. Proof. assert (Hi: (forall n, 0 < INR n + 1)%R). { intros n. apply Rplus_le_lt_0_compat with (1 := (pos_INR n)); apply Rlt_0_1. } set (u n := (if HP n then 0 else / (INR n + 1))%R). assert (Bu: forall n, (u n <= 1)%R). { intros n. unfold u. case HP ; intros _. - apply Rle_0_1. - rewrite <- S_INR, <- Rinv_1. apply Rinv_le_contravar with (1 := Rlt_0_1). apply (le_INR 1); apply -> Nat.succ_le_mono; apply Nat.le_0_l. } set (E y := exists n, y = u n). destruct (completeness E) as [l [ub lub]]. - exists R1. intros y [n ->]. apply Bu. - exists (u O). now exists O. - assert (Hnp: forall n, not (P n) -> ((/ (INR n + 1) <= l)%R)). { intros n Hp. apply ub. exists n. unfold u. now destruct (HP n). } destruct (Rle_lt_dec l 0) as [Hl|Hl]. + right. intros n. destruct (HP n) as [H|H]. * exact H. * exfalso. apply Rle_not_lt with (1 := Hl). apply Rlt_le_trans with (/ (INR n + 1))%R. -- now apply Rinv_0_lt_compat. -- now apply Hnp. + left. set (N := Z.abs_nat (up (/l) - 2)). assert (H1l: (1 <= /l)%R). { rewrite <- Rinv_1. apply Rinv_le_contravar with (1 := Hl). apply lub. now intros y [m ->]. } assert (HN: (INR N + 1 = IZR (up (/ l)) - 1)%R). { unfold N. rewrite INR_IZR_INZ. rewrite inj_Zabs_nat. replace (IZR (up (/ l)) - 1)%R with (IZR (up (/ l) - 2) + 1)%R. - apply (f_equal (fun v => IZR v + 1)%R). apply Z.abs_eq. apply Zle_minus_le_0. apply (Zlt_le_succ 1). apply lt_IZR. apply Rle_lt_trans with (1 := H1l). apply archimed. - rewrite minus_IZR. simpl. ring. } assert (Hl': (/ (INR (S N) + 1) < l)%R). { rewrite <- (Rinv_inv l). apply Rinv_0_lt_contravar. { now apply Rinv_0_lt_compat. } rewrite S_INR. rewrite HN. ring_simplify. apply archimed. } exists N. intros H. apply Rle_not_lt with (2 := Hl'). apply lub. intros y [n ->]. unfold u. destruct (HP n) as [_|Hp]. * apply Rlt_le. now apply Rinv_0_lt_compat. * apply Rinv_le_contravar. -- apply Hi. -- apply Rplus_le_compat_r. apply le_INR. destruct (Nat.le_gt_cases n N) as [Hn|Hn]. 2: now apply Nat.le_succ_l. exfalso. destruct (proj1 (Nat.lt_eq_cases _ _) Hn) as [Hn'| ->]. 2: now apply Hp. apply Rlt_not_le with (2 := Hnp _ Hp). rewrite <- (Rinv_inv l). apply Rinv_0_lt_contravar. ++ apply Rplus_le_lt_0_compat. ** apply pos_INR. ** apply Rlt_0_1. ++ apply Rlt_le_trans with (INR N + 1)%R. ** apply Rplus_lt_compat_r. now apply lt_INR. ** rewrite HN. apply Rplus_le_reg_r with (-/l + 1)%R. ring_simplify. apply archimed. Qed. End Arithmetical_dec. (** * Derivability of the Archimedean axiom *) (** This is a standard proof (it has been taken from PlanetMath). It is formulated negatively so as to avoid the need for classical logic. Using a proof of [{n | ~P n}+{forall n, P n}], we can in principle also derive [up] and its specification. The proof above cannot be used for that purpose, since it relies on the [archimed] axiom. *) Theorem not_not_archimedean : forall r : R, ~ (forall n : nat, (INR n <= r)%R). Proof. intros r H. set (E := fun r => exists n : nat, r = INR n). assert (exists x : R, E x) by (exists 0%R; simpl; red; exists 0%nat; reflexivity). assert (bound E) by (exists r; intros x (m,H2); rewrite H2; apply H). destruct (completeness E) as (M,(H3,H4)); try assumption. set (M' := (M + -1)%R). assert (H2 : ~ is_upper_bound E M'). { intro H5. assert (M <= M')%R by (apply H4; exact H5). apply (Rlt_not_le M M'). { unfold M'. pattern M at 2. rewrite <- Rplus_0_l. pattern (0 + M)%R. rewrite Rplus_comm. rewrite <- (Rplus_opp_r 1). apply Rplus_lt_compat_l. rewrite Rplus_comm. apply Rplus_pos_gt, Rlt_0_1. } assumption. } apply H2. intros N (n,H7). rewrite H7. unfold M'. assert (H5 : (INR (S n) <= M)%R) by (apply H3; exists (S n); reflexivity). rewrite S_INR in H5. assert (H6 : (INR n + 1 + -1 <= M + -1)%R). { apply Rplus_le_compat_r. assumption. } rewrite Rplus_assoc in H6. rewrite Rplus_opp_r in H6. rewrite (Rplus_comm (INR n) 0) in H6. rewrite Rplus_0_l in H6. assumption. Qed. (** * Decidability of negated formulas *) Lemma sig_not_dec : forall P : Prop, {not (not P)} + {not P}. Proof. intros P. set (E := fun x => x = R0 \/ (x = R1 /\ P)). destruct (completeness E) as [x H]. - exists R1. intros x [->|[-> _]]. + apply Rle_0_1. + apply Rle_refl. - exists R0. now left. - destruct (Rle_lt_dec 1 x) as [H'|H']. + left. intros HP. elim Rle_not_lt with (1 := H'). apply Rle_lt_trans with (2 := Rlt_0_1). apply H. intros y [->|[_ Hy]]. * apply Rle_refl. * now elim HP. + right. intros HP. apply Rlt_not_le with (1 := H'). apply H. right. now split. Qed. coq-8.20.0/theories/Reals/Rminmax.v000066400000000000000000000074121466560755400171030ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* Rmax x y = x. Proof. unfold Rmax. intros. destruct Rle_dec as [H'|H']; [| apply Rnot_le_lt in H' ]; unfold Rle in *; intuition. Qed. Lemma Rmax_r : forall x y, x<=y -> Rmax x y = y. Proof. unfold Rmax. intros. destruct Rle_dec as [H'|H']; [| apply Rnot_le_lt in H' ]; unfold Rle in *; intuition. Qed. Lemma Rmin_l : forall x y, x<=y -> Rmin x y = x. Proof. unfold Rmin. intros. destruct Rle_dec as [H'|H']; [| apply Rnot_le_lt in H' ]; unfold Rle in *; intuition. Qed. Lemma Rmin_r : forall x y, y<=x -> Rmin x y = y. Proof. unfold Rmin. intros. destruct Rle_dec as [H'|H']; [| apply Rnot_le_lt in H' ]; unfold Rle in *; intuition. Qed. Module RHasMinMax <: HasMinMax R_as_OT. Definition max := Rmax. Definition min := Rmin. Definition max_l := Rmax_l. Definition max_r := Rmax_r. Definition min_l := Rmin_l. Definition min_r := Rmin_r. End RHasMinMax. Module R. (** We obtain hence all the generic properties of max and min. *) Include UsualMinMaxProperties R_as_OT RHasMinMax. (** * Properties specific to the [R] domain *) (** Compatibilities (consequences of monotonicity) *) Lemma plus_max_distr_l : forall n m p, Rmax (p + n) (p + m) = p + Rmax n m. Proof. intros. apply max_monotone. intros x y. apply Rplus_le_compat_l. Qed. Lemma plus_max_distr_r : forall n m p, Rmax (n + p) (m + p) = Rmax n m + p. Proof. intros. rewrite (Rplus_comm n p), (Rplus_comm m p), (Rplus_comm _ p). apply plus_max_distr_l. Qed. Lemma plus_min_distr_l : forall n m p, Rmin (p + n) (p + m) = p + Rmin n m. Proof. intros. apply min_monotone. intros x y. apply Rplus_le_compat_l. Qed. Lemma plus_min_distr_r : forall n m p, Rmin (n + p) (m + p) = Rmin n m + p. Proof. intros. rewrite (Rplus_comm n p), (Rplus_comm m p), (Rplus_comm _ p). apply plus_min_distr_l. Qed. (** Anti-monotonicity swaps the role of [min] and [max] *) Lemma opp_max_distr : forall n m : R, -(Rmax n m) = Rmin (- n) (- m). Proof. intros. symmetry. apply min_max_antimonotone. do 3 red. intros; apply Rge_le. apply Ropp_le_ge_contravar; auto. Qed. Lemma opp_min_distr : forall n m : R, - (Rmin n m) = Rmax (- n) (- m). Proof. intros. symmetry. apply max_min_antimonotone. do 3 red. intros; apply Rge_le. apply Ropp_le_ge_contravar; auto. Qed. Lemma minus_max_distr_l : forall n m p, Rmax (p - n) (p - m) = p - Rmin n m. Proof. unfold Rminus. intros. rewrite opp_min_distr. apply plus_max_distr_l. Qed. Lemma minus_max_distr_r : forall n m p, Rmax (n - p) (m - p) = Rmax n m - p. Proof. unfold Rminus. intros. apply plus_max_distr_r. Qed. Lemma minus_min_distr_l : forall n m p, Rmin (p - n) (p - m) = p - Rmax n m. Proof. unfold Rminus. intros. rewrite opp_max_distr. apply plus_min_distr_l. Qed. Lemma minus_min_distr_r : forall n m p, Rmin (n - p) (m - p) = Rmin n m - p. Proof. unfold Rminus. intros. apply plus_min_distr_r. Qed. End R. coq-8.20.0/theories/Reals/Rpow_def.v000066400000000000000000000014461466560755400172360ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* 1 | S n => Rmult r (pow r n) end. coq-8.20.0/theories/Reals/Rpower.v000066400000000000000000000723021466560755400167460ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* R->R; main properties *) (************************************************************) Require Import Rbase. Require Import Rfunctions. Require Import SeqSeries. Require Import Rtrigo1. Require Import Ranalysis1. Require Import Exp_prop. Require Import Rsqrt_def. Require Import R_sqrt. Require Import Sqrt_reg. Require Import MVT. Require Import Ranalysis4. Require Import Lra. Local Open Scope R_scope. Definition P_Rmin_stt (P:R -> Prop) x y := Rmin_case x y P. #[deprecated(since="8.16", note="Use Rmin_case instead.")] Notation P_Rmin := P_Rmin_stt. Lemma exp_le_3 : exp 1 <= 3. Proof. assert (exp_1 : exp 1 <> 0). { assert (H0 := exp_pos 1); red; intro; rewrite H in H0; elim (Rlt_irrefl _ H0). } apply Rmult_le_reg_l with (/ exp 1). { apply Rinv_0_lt_compat; apply exp_pos. } rewrite Rinv_l. 2:assumption. apply Rmult_le_reg_l with (/ 3). { lra. } rewrite Rmult_1_r; rewrite <- (Rmult_comm 3); rewrite <- Rmult_assoc; rewrite Rinv_l. 2:lra. rewrite Rmult_1_l; replace (/ exp 1) with (exp (-1)). 2:{ apply Rmult_eq_reg_l with (exp 1). 2:assumption. rewrite <- exp_plus; rewrite Rplus_opp_r; rewrite exp_0; rewrite Rinv_r;trivial. } unfold exp; case (exist_exp (-1)) as (?,e); simpl in |- *; unfold exp_in in e; assert (H := alternated_series_ineq (fun i:nat => / INR (fact i)) x 1). cut (sum_f_R0 (tg_alt (fun i:nat => / INR (fact i))) (S (2 * 1)) <= x <= sum_f_R0 (tg_alt (fun i:nat => / INR (fact i))) (2 * 1)). { intro; elim H0; clear H0; intros H0 _; simpl in H0; unfold tg_alt in H0; simpl in H0. replace (/ 3) with (1 * / 1 + -1 * 1 * / 1 + -1 * (-1 * 1) * / 2 + -1 * (-1 * (-1 * 1)) * / (2 + 1 + 1 + 1 + 1)) by field. apply H0. } apply H. - unfold Un_decreasing; intros; apply Rmult_le_reg_l with (INR (fact n)). { apply INR_fact_lt_0. } apply Rmult_le_reg_l with (INR (fact (S n))). { apply INR_fact_lt_0. } rewrite Rinv_r. 2:{ apply INR_fact_neq_0. } rewrite Rmult_1_r; rewrite Rmult_comm; rewrite Rmult_assoc; rewrite Rinv_l. 2:{ apply INR_fact_neq_0. } rewrite Rmult_1_r; apply le_INR; apply fact_le; apply Nat.le_succ_diag_r. - assert (H0 := cv_speed_pow_fact 1); unfold Un_cv; unfold Un_cv in H0; intros; elim (H0 _ H1); intros; exists x0; intros; unfold Rdist in H2; unfold Rdist; replace (/ INR (fact n)) with (1 ^ n / INR (fact n));auto. unfold Rdiv; rewrite pow1; rewrite Rmult_1_l; reflexivity. - unfold infinite_sum in e; unfold Un_cv, tg_alt; intros; elim (e _ H0); intros; exists x0; intros; replace (sum_f_R0 (fun i:nat => (-1) ^ i * / INR (fact i)) n) with (sum_f_R0 (fun i:nat => / INR (fact i) * (-1) ^ i) n);auto. apply sum_eq; intros; apply Rmult_comm. Qed. (******************************************************************) (** * Properties of Exp *) (******************************************************************) Lemma exp_neq_0 : forall x:R, exp x <> 0. Proof. intro x. exact (not_eq_sym (Rlt_not_eq 0 (exp x) (exp_pos x))). Qed. Theorem exp_increasing : forall x y:R, x < y -> exp x < exp y. Proof. intros x y H. assert (H0 : derivable exp). - apply derivable_exp. - assert (H1 := positive_derivative _ H0). unfold strict_increasing in H1. apply H1. + intro. replace (derive_pt exp x0 (H0 x0)) with (exp x0). * apply exp_pos. * symmetry ; apply derive_pt_eq_0. apply (derivable_pt_lim_exp x0). + apply H. Qed. Theorem exp_lt_inv : forall x y:R, exp x < exp y -> x < y. Proof. intros x y H; case (Rtotal_order x y); [ intros H1 | intros [H1| H1] ]. - assumption. - rewrite H1 in H; elim (Rlt_irrefl _ H). - assert (H2 := exp_increasing _ _ H1). elim (Rlt_irrefl _ (Rlt_trans _ _ _ H H2)). Qed. Lemma exp_ineq1 : forall x : R, x <> 0 -> 1 + x < exp x. Proof. assert (Hd : forall c : R, derivable_pt_lim (fun x : R => exp x - (x + 1)) c (exp c - 1)). { intros. apply derivable_pt_lim_minus; [apply derivable_pt_lim_exp | ]. replace (1) with (1 + 0) at 1 by lra. apply derivable_pt_lim_plus; [apply derivable_pt_lim_id | apply derivable_pt_lim_const]. } intros x xdz; destruct (Rtotal_order x 0) as [xlz|[xez|xgz]]. - destruct (MVT_cor2 _ _ x 0 xlz (fun c _ => Hd c)) as [c [HH1 HH2]]. rewrite exp_0 in HH1. assert (H1 : 0 < x * exp c - x); [| lra]. assert (H2 : x * exp 0 < x * exp c); [| rewrite exp_0 in H2; lra]. apply Rmult_lt_gt_compat_neg_l; auto. now apply exp_increasing. - now case xdz. - destruct (MVT_cor2 _ _ 0 x xgz (fun c _ => Hd c)) as [c [HH1 HH2]]. rewrite exp_0 in HH1. assert (H1 : 0 < x * exp c - x); [| lra]. assert (H2 : x * exp 0 < x * exp c); [| rewrite exp_0 in H2; lra]. apply Rmult_lt_compat_l; auto. now apply exp_increasing. Qed. Lemma exp_ineq1_le (x : R) : 1 + x <= exp x. Proof. destruct (Req_dec x 0) as [xeq|?]. - rewrite xeq, exp_0; lra. - left. now apply exp_ineq1. Qed. Lemma ln_exists1 : forall y:R, 1 <= y -> { z:R | y = exp z }. Proof. intros; set (f := fun x:R => exp x - y). assert (H0 : 0 < y) by (apply Rlt_le_trans with 1; auto with real). cut (f 0 <= 0); [intro H1|]. - cut (continuity f); [intro H2|]. + cut (0 <= f y); [intro H3|]. * cut (f 0 * f y <= 0); [intro H4|]. -- pose proof (IVT_cor f 0 y H2 (Rlt_le _ _ H0) H4) as (t,(_,H7)); exists t; unfold f in H7; symmetry; apply Rminus_diag_uniq; exact H7. -- pattern 0 at 2; rewrite <- (Rmult_0_r (f y)); rewrite (Rmult_comm (f 0)); apply Rmult_le_compat_l; assumption. * unfold f; apply Rplus_le_reg_l with y; left; apply Rlt_trans with (1 + y). -- rewrite <- (Rplus_comm y); apply Rplus_lt_compat_l; apply Rlt_0_1. -- replace (y + (exp y - y)) with (exp y); [ apply (exp_ineq1 y); lra | ring ]. + unfold f; change (continuity (exp - fct_cte y)); apply continuity_minus; [ apply derivable_continuous; apply derivable_exp | apply derivable_continuous; apply derivable_const ]. - unfold f; rewrite exp_0; apply Rplus_le_reg_l with y; rewrite Rplus_0_r; replace (y + (1 - y)) with 1; [ apply H | ring ]. Qed. (**********) Lemma ln_exists : forall y:R, 0 < y -> { z:R | y = exp z }. Proof. intros; destruct (Rle_dec 1 y) as [Hle|Hnle]. - apply (ln_exists1 _ Hle). - assert (H0 : 1 <= / y). + apply Rmult_le_reg_l with y. * apply H. * rewrite Rinv_r. -- rewrite Rmult_1_r; left; apply (Rnot_le_lt _ _ Hnle). -- red; intro; rewrite H0 in H; elim (Rlt_irrefl _ H). + destruct (ln_exists1 _ H0) as (x,p); exists (- x); apply Rmult_eq_reg_l with (exp x / y). * unfold Rdiv; rewrite Rmult_assoc; rewrite Rinv_l. -- rewrite Rmult_1_r; rewrite <- (Rmult_comm (/ y)); rewrite Rmult_assoc; rewrite <- exp_plus; rewrite Rplus_opp_r; rewrite exp_0; rewrite Rmult_1_r; symmetry ; apply p. -- red; intro H3; rewrite H3 in H; elim (Rlt_irrefl _ H). * unfold Rdiv; apply prod_neq_R0. -- assert (H3 := exp_pos x); red; intro H4; rewrite H4 in H3; elim (Rlt_irrefl _ H3). -- apply Rinv_neq_0_compat; red; intro H3; rewrite H3 in H; elim (Rlt_irrefl _ H). Qed. (* Definition of log R+* -> R *) Definition Rln (y:posreal) : R := let (a,_) := ln_exists (pos y) (cond_pos y) in a. (* Extension on R *) Definition ln (x:R) : R := match Rlt_dec 0 x with | left a => Rln (mkposreal x a) | right a => 0 end. Definition Rlog x y := (ln y)/(ln x). Lemma exp_ln : forall x:R, 0 < x -> exp (ln x) = x. Proof. intros; unfold ln; decide (Rlt_dec 0 x) with H. unfold Rln; case (ln_exists (mkposreal x H) (cond_pos (mkposreal x H))) as (?,Hex). symmetry; apply Hex. Qed. Theorem exp_inv : forall x y:R, exp x = exp y -> x = y. Proof. intros x y H; case (Rtotal_order x y); [ intros H1 | intros [H1| H1] ]; auto; assert (H2 := exp_increasing _ _ H1); rewrite H in H2; elim (Rlt_irrefl _ H2). Qed. Theorem exp_Ropp : forall x:R, exp (- x) = / exp x. Proof. intros x; assert (H : exp x <> 0). - assert (H := exp_pos x); red; intro; rewrite H0 in H; elim (Rlt_irrefl _ H). - apply Rmult_eq_reg_l with (r := exp x). + rewrite <- exp_plus; rewrite Rplus_opp_r; rewrite exp_0. symmetry; apply Rinv_r. apply H. + apply H. Qed. (******************************************************************) (** * Properties of Ln *) (******************************************************************) Theorem ln_increasing : forall x y:R, 0 < x -> x < y -> ln x < ln y. Proof. intros x y H H0; apply exp_lt_inv. repeat rewrite exp_ln. - apply H0. - apply Rlt_trans with x; assumption. - apply H. Qed. Theorem ln_exp : forall x:R, ln (exp x) = x. Proof. intros x; apply exp_inv. apply exp_ln. apply exp_pos. Qed. Theorem ln_1 : ln 1 = 0. Proof. rewrite <- exp_0; rewrite ln_exp; reflexivity. Qed. Theorem ln_lt_inv : forall x y:R, 0 < x -> 0 < y -> ln x < ln y -> x < y. Proof. intros x y H H0 H1; rewrite <- (exp_ln x); try rewrite <- (exp_ln y). - apply exp_increasing; apply H1. - assumption. - assumption. Qed. Theorem ln_inv : forall x y:R, 0 < x -> 0 < y -> ln x = ln y -> x = y. Proof. intros x y H H0 H'0; case (Rtotal_order x y); [ intros H1 | intros [H1| H1] ]; auto. - assert (H2 := ln_increasing _ _ H H1); rewrite H'0 in H2; elim (Rlt_irrefl _ H2). - assert (H2 := ln_increasing _ _ H0 H1); rewrite H'0 in H2; elim (Rlt_irrefl _ H2). Qed. Lemma ln_neq_0 : forall x:R, x <> 1 -> 0 < x -> ln x <> 0. Proof. intros x Hneq_x_1 Hlt_0_x. rewrite <- ln_1. intro H. assert (x = 1) as H0. + exact (ln_inv x 1 Hlt_0_x (ltac:(lra) : 0 < 1) H). + contradiction. Qed. Theorem ln_mult : forall x y:R, 0 < x -> 0 < y -> ln (x * y) = ln x + ln y. Proof. intros x y H H0; apply exp_inv. rewrite exp_plus. repeat rewrite exp_ln. - reflexivity. - assumption. - assumption. - apply Rmult_lt_0_compat; assumption. Qed. Lemma ln_pow : forall (x : R), 0 < x -> forall (n : nat), ln (x^n) = (INR n)*(ln x). Proof. intros x Hx. induction n as [|m Hm]. + simpl. rewrite ln_1. exact (eq_sym (Rmult_0_l (ln x))). + unfold pow. fold pow. rewrite (ln_mult x (x^m) Hx (pow_lt x m Hx)). rewrite Hm. rewrite <- (Rmult_1_l (ln x)) at 1. rewrite <- (Rmult_plus_distr_r 1 (INR m) (ln x)). rewrite (Rplus_comm 1 (INR m)). destruct m as [|m]; simpl. - lra. - reflexivity. Qed. Theorem ln_Rinv : forall x:R, 0 < x -> ln (/ x) = - ln x. Proof. intros x H; apply exp_inv; repeat rewrite exp_ln || rewrite exp_Ropp. - reflexivity. - assumption. - apply Rinv_0_lt_compat; assumption. Qed. Theorem ln_continue : forall y:R, 0 < y -> continue_in ln (fun x:R => 0 < x) y. Proof. intros y H. unfold continue_in, limit1_in, limit_in; intros eps Heps. assert (H1:1 < exp eps). { rewrite <- exp_0. apply exp_increasing; apply Heps. } assert (H2:exp (- eps) < 1). { apply Rmult_lt_reg_l with (exp eps). - apply exp_pos. - rewrite <- exp_plus; rewrite Rmult_1_r; rewrite Rplus_opp_r; rewrite exp_0; apply H1. } exists (Rmin (y * (exp eps - 1)) (y * (1 - exp (- eps)))); split. { red; apply Rmin_case; nra. } unfold dist, R_met, Rdist; simpl. intros x [[H3 H4] H5]. assert (Hxyy:y * (x * / y) = x). { field. lra. } replace (ln x - ln y) with (ln (x * / y)). 2:{ rewrite ln_mult;try apply Rinv_0_lt_compat; try assumption. rewrite ln_Rinv;try assumption. ring. } pose proof (Rinv_0_lt_compat y) as Hinvy. case (Rtotal_order x y); [ intros Hxy | intros [Hxy| Hxy] ]. - rewrite Rabs_left. 2:{ rewrite <- ln_1. apply ln_increasing;nra. } apply Ropp_lt_cancel; rewrite Ropp_involutive. apply exp_lt_inv. rewrite exp_ln. 2:nra. apply Rmult_lt_reg_l with (r := y). { apply H. } rewrite Hxyy. apply Ropp_lt_cancel. apply Rplus_lt_reg_l with (r := y). replace (y + - (y * exp (- eps))) with (y * (1 - exp (- eps))); [ idtac | ring ]. replace (y + - x) with (Rabs (x - y)). 2:{ rewrite Rabs_left; [ ring | idtac ]. lra. } apply Rlt_le_trans with (1 := H5); apply Rmin_r. - rewrite Hxy; rewrite Rinv_r. 2:lra. rewrite ln_1; rewrite Rabs_R0; apply Heps. - rewrite Rabs_right. 2:{ rewrite <- ln_1. apply Rgt_ge; red; apply ln_increasing;nra. } apply exp_lt_inv. rewrite exp_ln. 2:nra. apply Rmult_lt_reg_l with (r := y). { apply H. } rewrite Hxyy. apply Rplus_lt_reg_l with (r := - y). replace (- y + y * exp eps) with (y * (exp eps - 1)); [ idtac | ring ]. replace (- y + x) with (Rabs (x - y)). 2:{ rewrite Rabs_right; [ ring | idtac ]. lra. } apply Rlt_le_trans with (1 := H5); apply Rmin_l. Qed. (******************************************************************) (** * Definition of Rpower *) (******************************************************************) Definition Rpower (x y:R) := exp (y * ln x). (******************************************************************) (** * Properties of Rpower *) (******************************************************************) (** Note: [Rpower] is prolongated to [1] on negative real numbers and it thus does not extend integer power. The next two lemmas, which hold for integer power, accidentally hold on negative real numbers as a side effect of the default value taken on negative real numbers. Contrastingly, the lemmas that do not hold for the integer power of a negative number are stated for [Rpower] on the positive numbers only (even if they accidentally hold due to the default value of [Rpower] on the negative side, as it is the case for [Rpower_O]). *) Theorem Rpower_plus : forall x y z:R, Rpower z (x + y) = Rpower z x * Rpower z y. Proof. intros x y z; unfold Rpower. rewrite Rmult_plus_distr_r; rewrite exp_plus; auto. Qed. Theorem Rpower_mult : forall x y z:R, Rpower (Rpower x y) z = Rpower x (y * z). Proof. intros x y z; unfold Rpower. rewrite ln_exp. replace (z * (y * ln x)) with (y * z * ln x). - reflexivity. - ring. Qed. Theorem Rpower_O : forall x:R, 0 < x -> Rpower x 0 = 1. Proof. intros x _; unfold Rpower. rewrite Rmult_0_l; apply exp_0. Qed. Theorem Rpower_1 : forall x:R, 0 < x -> Rpower x 1 = x. Proof. intros x H; unfold Rpower. rewrite Rmult_1_l; apply exp_ln; apply H. Qed. Theorem Rpower_pow : forall (n:nat) (x:R), 0 < x -> Rpower x (INR n) = x ^ n. Proof. intros n; elim n; simpl; auto; fold INR. - intros x H; apply Rpower_O; auto. - intros n1; case n1. + intros H x H0; simpl; rewrite Rmult_1_r; apply Rpower_1; auto. + intros n0 H x H0; rewrite Rpower_plus; rewrite H; try rewrite Rpower_1; try apply Rmult_comm || assumption. Qed. Lemma Rpower_nonzero : forall (x : R) (n : nat), 0 < x -> Rpower x (INR n) <> 0. Proof. intros x n H. rewrite (Rpower_pow n x H). exact (pow_nonzero x n (not_eq_sym (Rlt_not_eq 0 x H))). Qed. Theorem Rpower_lt : forall x y z:R, 1 < x -> y < z -> Rpower x y < Rpower x z. Proof. intros x y z H H1. unfold Rpower. apply exp_increasing. apply Rmult_lt_compat_r. - rewrite <- ln_1; apply ln_increasing. + apply Rlt_0_1. + apply H. - apply H1. Qed. Lemma Rpower_Rlog : forall x y:R, x <> 1 -> 0 < x -> 0 < y -> Rpower x (Rlog x y) = y. Proof. intros x y H_neq_x_1 H_lt_0_x H_lt_0_y. unfold Rpower. unfold Rlog. unfold Rdiv. rewrite (Rmult_assoc (ln y) (/ln x) (ln x)). rewrite (Rinv_l (ln x) (ln_neq_0 x H_neq_x_1 H_lt_0_x)). rewrite (Rmult_1_r (ln y)). exact (exp_ln y H_lt_0_y). Qed. Theorem Rpower_sqrt : forall x:R, 0 < x -> Rpower x (/ 2) = sqrt x. Proof. intros x H. apply ln_inv. - unfold Rpower; apply exp_pos. - apply sqrt_lt_R0; apply H. - apply Rmult_eq_reg_l with (INR 2). + apply exp_inv. fold Rpower. cut (Rpower (Rpower x (/ INR 2)) (INR 2) = Rpower (sqrt x) (INR 2)). * unfold Rpower; auto. * rewrite Rpower_mult. rewrite Rinv_l. -- change 1 with (INR 1). repeat rewrite Rpower_pow; simpl. ++ pattern x at 1; rewrite <- (sqrt_sqrt x (Rlt_le _ _ H)). ring. ++ apply sqrt_lt_R0; apply H. ++ apply H. -- apply not_O_INR; discriminate. + apply not_O_INR; discriminate. Qed. Theorem Rpower_Ropp : forall x y:R, Rpower x (- y) = / (Rpower x y). Proof. unfold Rpower. intros x y; rewrite Ropp_mult_distr_l_reverse. apply exp_Ropp. Qed. Lemma powerRZ_Rpower x z : (0 < x)%R -> powerRZ x z = Rpower x (IZR z). Proof. intros Hx. destruct (intP z). - now rewrite Rpower_O. - rewrite <- pow_powerRZ, <- Rpower_pow by assumption. now rewrite INR_IZR_INZ. - rewrite opp_IZR, Rpower_Ropp. rewrite powerRZ_neg'. now rewrite <- pow_powerRZ, <- INR_IZR_INZ, Rpower_pow. Qed. Theorem Rle_Rpower : forall e n m:R, 1 <= e -> n <= m -> Rpower e n <= Rpower e m. Proof. intros e n m [H | H]; intros H1. - case H1. + intros H2; left; apply Rpower_lt; assumption. + intros H2; rewrite H2; right; reflexivity. - now rewrite <- H; unfold Rpower; rewrite ln_1, !Rmult_0_r; apply Rle_refl. Qed. Lemma ln_Rpower : forall x y:R, ln (Rpower x y) = y * ln x. Proof. intros x y. unfold Rpower. rewrite (ln_exp (y * ln x)). reflexivity. Qed. Lemma Rlog_pow : forall (x : R) (n : nat), x <> 1 -> 0 < x -> Rlog x (x^n) = INR n. Proof. intros x n H_neq_x_1 H_lt_0_x. rewrite <- (Rpower_pow n x H_lt_0_x). unfold Rpower. unfold Rlog. rewrite (ln_exp (INR n * ln x)). unfold Rdiv. rewrite (Rmult_assoc (INR n) (ln x) (/ln x)). rewrite (Rinv_r (ln x) (ln_neq_0 x H_neq_x_1 H_lt_0_x)). exact (Rmult_1_r (INR n)). Qed. Theorem ln_lt_2 : / 2 < ln 2. Proof. apply Rmult_lt_reg_l with (r := 2). - prove_sup0. - rewrite Rinv_r. + apply exp_lt_inv. apply Rle_lt_trans with (1 := exp_le_3). change (3 < Rpower 2 (1 + 1)). repeat rewrite Rpower_plus; repeat rewrite Rpower_1. * now apply (IZR_lt 3 4). * prove_sup0. + discrR. Qed. (*****************************************) (** * Differentiability of Ln and Rpower *) (*****************************************) Theorem limit1_ext : forall (f g:R -> R) (D:R -> Prop) (l x:R), (forall x:R, D x -> f x = g x) -> limit1_in f D l x -> limit1_in g D l x. Proof. intros f g D l x H; unfold limit1_in, limit_in. intros H0 eps H1; case (H0 eps); auto. intros x0 [H2 H3]; exists x0; split; auto. intros x1 [H4 H5]; rewrite <- H; auto. Qed. Theorem limit1_imp : forall (f:R -> R) (D D1:R -> Prop) (l x:R), (forall x:R, D1 x -> D x) -> limit1_in f D l x -> limit1_in f D1 l x. Proof. intros f D D1 l x H; unfold limit1_in, limit_in. intros H0 eps H1; case (H0 eps H1); auto. intros alpha [H2 H3]; exists alpha; split; auto. intros d [H4 H5]; apply H3; split; auto. Qed. Theorem Rinv_Rdiv_depr : forall x y:R, x <> 0 -> y <> 0 -> / (x / y) = y / x. Proof. intros x y _ _. apply Rinv_div. Qed. #[deprecated(since="8.16",note="Use Rinv_div.")] Notation Rinv_Rdiv := Rinv_Rdiv_depr. Theorem Dln : forall y:R, 0 < y -> D_in ln Rinv (fun x:R => 0 < x) y. Proof. intros y Hy; unfold D_in. apply limit1_ext with (f := fun x:R => / ((exp (ln x) - exp (ln y)) / (ln x - ln y))). { intros x [HD1 HD2]; repeat rewrite exp_ln. 2,3:assumption. unfold Rdiv; rewrite Rinv_mult. rewrite Rinv_inv. apply Rmult_comm. } apply limit_inv with (f := fun x:R => (exp (ln x) - exp (ln y)) / (ln x - ln y)). 2:lra. apply limit1_imp with (f := fun x:R => (fun x:R => (exp x - exp (ln y)) / (x - ln y)) (ln x)) (D := Dgf (D_x (fun x:R => 0 < x) y) (D_x (fun x:R => True) (ln y)) ln). { intros x [H1 H2]; split. - split; auto. - split; auto. red; intros H3; case H2; apply ln_inv; auto. } apply limit_comp with (l := ln y) (g := fun x:R => (exp x - exp (ln y)) / (x - ln y)) (f := ln). { apply ln_continue; auto. } assert (H0 := derivable_pt_lim_exp (ln y)); unfold derivable_pt_lim in H0; unfold limit1_in; unfold limit_in; simpl; unfold Rdist; intros; elim (H0 _ H); intros; exists (pos x); split. { apply (cond_pos x). } intros; pattern y at 3; rewrite <- exp_ln. 2:assumption. pattern x0 at 1; replace x0 with (ln y + (x0 - ln y)); [ idtac | ring ]. apply H1. { elim H2; intros H3 _; unfold D_x in H3; elim H3; clear H3; intros _ H3; apply Rminus_eq_contra; apply (not_eq_sym (A:=R)); apply H3. } elim H2; clear H2; intros _ H2; apply H2. Qed. Lemma derivable_pt_lim_ln : forall x:R, 0 < x -> derivable_pt_lim ln x (/ x). Proof. intros; assert (H0 := Dln x H); unfold D_in in H0; unfold limit1_in in H0; unfold limit_in in H0; simpl in H0; unfold Rdist in H0; unfold derivable_pt_lim; intros; elim (H0 _ H1); intros; elim H2; clear H2; intros; set (alp := Rmin x0 (x / 2)); assert (H4 : 0 < alp). { unfold alp; unfold Rmin; case (Rle_dec x0 (x / 2)); intro;unfold Rdiv;lra. } exists (mkposreal _ H4); intros; pattern h at 2; replace h with (x + h - x); [ idtac | ring ]. apply H3; split. 2:{ replace (x + h - x) with h by ring. apply Rlt_le_trans with alp; [ apply H6 | unfold alp; apply Rmin_l ]. } unfold D_x; split. 2:lra. pose proof (Rmin_r _ _ : alp <= _) as H7. unfold Rdiv in H7. unfold Rabs in H6. simpl in H6. destruct (Rcase_abs h) as [Hlt|Hgt];lra. Qed. Theorem D_in_imp : forall (f g:R -> R) (D D1:R -> Prop) (x:R), (forall x:R, D1 x -> D x) -> D_in f g D x -> D_in f g D1 x. Proof. intros f g D D1 x H; unfold D_in. intros H0; apply limit1_imp with (D := D_x D x); auto. intros x1 [H1 H2]; split; auto. Qed. Theorem D_in_ext : forall (f g h:R -> R) (D:R -> Prop) (x:R), f x = g x -> D_in h f D x -> D_in h g D x. Proof. intros f g h D x H; unfold D_in. rewrite H; auto. Qed. Theorem Dpower : forall y z:R, 0 < y -> D_in (fun x:R => Rpower x z) (fun x:R => z * Rpower x (z - 1)) ( fun x:R => 0 < x) y. Proof. intros y z H; apply D_in_imp with (D := Dgf (fun x:R => 0 < x) (fun x:R => True) ln). { intros x H0; repeat split. assumption. } apply D_in_ext with (f := fun x:R => / x * (z * exp (z * ln x))). { unfold Rminus; rewrite Rpower_plus; rewrite Rpower_Ropp; rewrite (Rpower_1 _ H); unfold Rpower; ring. } apply Dcomp with (f := ln) (g := fun x:R => exp (z * x)) (df := Rinv) (dg := fun x:R => z * exp (z * x)). { apply (Dln _ H). } apply D_in_imp with (D := Dgf (fun x:R => True) (fun x:R => True) (fun x:R => z * x)). { intros x H1; repeat split; auto. } apply (Dcomp (fun _:R => True) (fun _:R => True) (fun x => z) exp (fun x:R => z * x) exp); simpl. - apply D_in_ext with (f := fun x:R => z * 1). { apply Rmult_1_r. } apply (Dmult_const (fun x => True) (fun x => x) (fun x => 1)); apply Dx. - assert (H0 := derivable_pt_lim_D_in exp exp (z * ln y)); elim H0; clear H0; intros _ H0; apply H0; apply derivable_pt_lim_exp. Qed. Theorem derivable_pt_lim_power : forall x y:R, 0 < x -> derivable_pt_lim (fun x => Rpower x y) x (y * Rpower x (y - 1)). Proof. intros x y H. unfold Rminus; rewrite Rpower_plus. rewrite Rpower_Ropp. rewrite Rpower_1; auto. rewrite <- Rmult_assoc. unfold Rpower. apply derivable_pt_lim_comp with (f1 := ln) (f2 := fun x => exp (y * x)). - apply derivable_pt_lim_ln; assumption. - rewrite (Rmult_comm y). apply derivable_pt_lim_comp with (f1 := fun x => y * x) (f2 := exp). + pattern y at 2; replace y with (0 * ln x + y * 1). * apply derivable_pt_lim_mult with (f1 := fun x:R => y) (f2 := fun x:R => x). -- apply derivable_pt_lim_const with (a := y). -- apply derivable_pt_lim_id. * ring. + apply derivable_pt_lim_exp. Qed. (* added later. *) Lemma Rpower_mult_distr : forall x y z, 0 < x -> 0 < y -> Rpower x z * Rpower y z = Rpower (x * y) z. intros x y z x0 y0; unfold Rpower. rewrite <- exp_plus, ln_mult, Rmult_plus_distr_l; auto. Qed. Lemma Rlt_Rpower_l a b c: 0 < c -> 0 < a < b -> Rpower a c < Rpower b c. Proof. intros c0 [a0 ab]; apply exp_increasing. now apply Rmult_lt_compat_l; auto; apply ln_increasing; lra. Qed. Lemma Rle_Rpower_l a b c: 0 <= c -> 0 < a <= b -> Rpower a c <= Rpower b c. Proof. intros [c0 | c0]; [ | intros; rewrite <- c0, !Rpower_O; [apply Rle_refl | |] ]. - intros [a0 [ab|ab]]. + now apply Rlt_le, Rlt_Rpower_l;[ | split]; lra. + rewrite ab; apply Rle_refl. - apply Rlt_le_trans with a; tauto. - tauto. Qed. (* arcsinh function *) Definition arcsinh x := ln (x + sqrt (x ^ 2 + 1)). Lemma arcsinh_sinh : forall x, arcsinh (sinh x) = x. intros x; unfold sinh, arcsinh. assert (Rminus_eq_0 : forall r, r - r = 0) by (intros; ring). rewrite <- exp_0, <- (Rminus_eq_0 x); unfold Rminus. rewrite exp_plus. match goal with |- context[sqrt ?a] => replace a with (((exp x + exp(-x))/2)^2) by field end. rewrite sqrt_pow2; [|apply Rlt_le, Rmult_lt_0_compat;[apply Rplus_lt_0_compat; apply exp_pos | apply Rinv_0_lt_compat, Rlt_0_2]]. match goal with |- context[ln ?a] => replace a with (exp x) by field end. rewrite ln_exp; reflexivity. Qed. Lemma sinh_arcsinh x : sinh (arcsinh x) = x. unfold sinh, arcsinh. assert (cmp : 0 < x + sqrt (x ^ 2 + 1)). { destruct (Rle_dec x 0). - replace (x ^ 2) with ((-x) ^ 2) by ring. assert (sqrt ((- x) ^ 2) < sqrt ((-x)^2+1)). { apply sqrt_lt_1_alt. split;[apply pow_le | ]; lra. } pattern x at 1; replace x with (- (sqrt ((- x) ^ 2))). + assert (t:= sqrt_pos ((-x)^2)); lra. + simpl; rewrite Rmult_1_r, sqrt_square, Ropp_involutive;[reflexivity | lra]. - apply Rplus_lt_le_0_compat;[apply Rnot_le_gt; assumption | apply sqrt_pos]. } rewrite exp_ln;[ | assumption]. rewrite exp_Ropp, exp_ln;[ | assumption]. assert (Rmult_minus_distr_r : forall x y z, (x - y) * z = x * z - y * z) by (intros; ring). apply Rminus_diag_uniq; unfold Rdiv; rewrite Rmult_minus_distr_r. assert (t: forall x y z, x - z = y -> x - y - z = 0);[ | apply t; clear t]. - intros a b c H; rewrite <- H; ring. - apply Rmult_eq_reg_l with (2 * (x + sqrt (x ^ 2 + 1)));[ | apply Rgt_not_eq, Rmult_lt_0_compat;[apply Rlt_0_2 | assumption]]. field_simplify;[rewrite pow2_sqrt;[field | ] | apply Rgt_not_eq; lra]. apply Rplus_le_le_0_compat;[simpl; rewrite Rmult_1_r; apply (Rle_0_sqr x)|apply Rlt_le, Rlt_0_1]. Qed. Lemma derivable_pt_lim_arcsinh : forall x, derivable_pt_lim arcsinh x (/sqrt (x ^ 2 + 1)). intros x; unfold arcsinh. assert (0 < x + sqrt (x ^ 2 + 1)). { destruct (Rle_dec x 0); [ | assert (0 < x) by (apply Rnot_le_gt; assumption); apply Rplus_lt_le_0_compat; auto; apply sqrt_pos]. replace (x ^ 2) with ((-x) ^ 2) by ring. assert (sqrt ((- x) ^ 2) < sqrt ((-x)^2+1)). { apply sqrt_lt_1_alt. split;[apply pow_le|]; lra. } pattern x at 1; replace x with (- (sqrt ((- x) ^ 2))). - assert (t:= sqrt_pos ((-x)^2)); lra. - simpl; rewrite Rmult_1_r, sqrt_square, Ropp_involutive; auto; lra. } assert (0 < x ^ 2 + 1). { apply Rplus_le_lt_0_compat;[simpl; rewrite Rmult_1_r; apply Rle_0_sqr|lra]. } replace (/sqrt (x ^ 2 + 1)) with (/(x + sqrt (x ^ 2 + 1)) * (1 + (/(2 * sqrt (x ^ 2 + 1)) * (INR 2 * x ^ 1 + 0)))). 2:{ replace (INR 2 * x ^ 1 + 0) with (2 * x) by (simpl; ring). replace (1 + / (2 * sqrt (x ^ 2 + 1)) * (2 * x)) with (((sqrt (x ^ 2 + 1) + x))/sqrt (x ^ 2 + 1)); [ | field; apply Rgt_not_eq, sqrt_lt_R0; assumption]. apply Rmult_eq_reg_l with (x + sqrt (x ^ 2 + 1)); [ | apply Rgt_not_eq; assumption]. field. split;apply Rgt_not_eq; auto; apply sqrt_lt_R0; assumption. } apply (derivable_pt_lim_comp (fun x => x + sqrt (x ^ 2 + 1)) ln). + apply (derivable_pt_lim_plus). * apply derivable_pt_lim_id. * apply (derivable_pt_lim_comp (fun x => x ^ 2 + 1) sqrt x). -- apply derivable_pt_lim_plus. ++ apply derivable_pt_lim_pow. ++ apply derivable_pt_lim_const. -- apply derivable_pt_lim_sqrt; assumption. + apply derivable_pt_lim_ln; assumption. Qed. Lemma arcsinh_lt : forall x y, x < y -> arcsinh x < arcsinh y. intros x y xy. case (Rle_dec (arcsinh y) (arcsinh x));[ | apply Rnot_le_lt ]. intros abs; case (Rlt_not_le _ _ xy). rewrite <- (sinh_arcsinh y), <- (sinh_arcsinh x). destruct abs as [lt | q];[| rewrite q; lra]. apply Rlt_le, sinh_lt; assumption. Qed. Lemma arcsinh_le : forall x y, x <= y -> arcsinh x <= arcsinh y. intros x y [xy | xqy]. - apply Rlt_le, arcsinh_lt; assumption. - rewrite xqy; apply Rle_refl. Qed. Lemma arcsinh_0 : arcsinh 0 = 0. unfold arcsinh; rewrite pow_ne_zero, !Rplus_0_l, sqrt_1, ln_1; [reflexivity | discriminate]. Qed. coq-8.20.0/theories/Reals/Rprod.v000066400000000000000000000156651466560755400165670ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* R) (N:nat) : R := match N with | O => f O | S p => prod_f_R0 f p * f (S p) end. Notation prod_f_SO := (fun An N => prod_f_R0 (fun n => An (S n)) N). (**********) Lemma prod_SO_split : forall (An:nat -> R) (n k:nat), (k < n)%nat -> prod_f_R0 An n = prod_f_R0 An k * prod_f_R0 (fun l:nat => An (k +1+l)%nat) (n - k -1). Proof. intros; induction n as [| n Hrecn]. - absurd (k < 0)%nat; lia. - cut (k = n \/ (k < n)%nat);[intro; elim H0; intro|lia]. + replace (S n - k - 1)%nat with O; [rewrite H1; simpl|lia]. replace (n+1+0)%nat with (S n); ring. + replace (S n - k-1)%nat with (S (n - k-1));[idtac|lia]. simpl; replace (k + S (n - k))%nat with (S n). * replace (k + 1 + S (n - k - 1))%nat with (S n). -- rewrite Hrecn; [ ring | assumption ]. -- lia. * lia. Qed. (**********) Lemma prod_SO_pos : forall (An:nat -> R) (N:nat), (forall n:nat, (n <= N)%nat -> 0 <= An n) -> 0 <= prod_f_R0 An N. Proof. intros; induction N as [| N HrecN]. - simpl; apply H; trivial. - simpl; apply Rmult_le_pos. + apply HrecN; intros; apply H; apply Nat.le_trans with N; [ assumption | apply Nat.le_succ_diag_r ]. + apply H; apply Nat.le_refl. Qed. (**********) Lemma prod_SO_Rle : forall (An Bn:nat -> R) (N:nat), (forall n:nat, (n <= N)%nat -> 0 <= An n <= Bn n) -> prod_f_R0 An N <= prod_f_R0 Bn N. Proof. intros; induction N as [| N HrecN]. - elim H with O; trivial. - simpl; apply Rle_trans with (prod_f_R0 An N * Bn (S N)). + apply Rmult_le_compat_l. * apply prod_SO_pos; intros; elim (H n (Nat.le_trans _ _ _ H0 (Nat.le_succ_diag_r N))); intros; assumption. * elim (H (S N) (le_n (S N))); intros; assumption. + do 2 rewrite <- (Rmult_comm (Bn (S N))); apply Rmult_le_compat_l. * elim (H (S N) (le_n (S N))); intros. apply Rle_trans with (An (S N)); assumption. * apply HrecN; intros; elim (H n (Nat.le_trans _ _ _ H0 (Nat.le_succ_diag_r N))); intros; split; assumption. Qed. (** Application to factorial *) Lemma fact_prodSO : forall n:nat, INR (fact n) = prod_f_R0 (fun k:nat => (match (eq_nat_dec k 0) with | left _ => 1%R | right _ => INR k end)) n. Proof. intro; induction n as [| n Hrecn]. - reflexivity. - simpl; rewrite <- Hrecn. case n; auto with real. intros; repeat rewrite plus_INR;rewrite mult_INR;ring. Qed. Lemma le_n_2n : forall n:nat, (n <= 2 * n)%nat. Proof. simple induction n. - replace (2 * 0)%nat with 0%nat; [ apply le_n | ring ]. - intros; replace (2 * S n0)%nat with (S (S (2 * n0))). + apply le_n_S; apply le_S; assumption. + replace (S (S (2 * n0))) with (2 * n0 + 2)%nat; [ idtac | ring ]. replace (S n0) with (n0 + 1)%nat; [ idtac | ring ]. ring. Qed. (** We prove that (N!)^2<=(2N-k)!*k! forall k in [|O;2N|] *) Lemma RfactN_fact2N_factk : forall N k:nat, (k <= 2 * N)%nat -> Rsqr (INR (fact N)) <= INR (fact (2 * N - k)) * INR (fact k). Proof. assert (forall (n:nat), 0 <= (if eq_nat_dec n 0 then 1 else INR n)). { intros; case (eq_nat_dec n 0); auto with real. } assert (forall (n:nat), (0 < n)%nat -> (if eq_nat_dec n 0 then 1 else INR n) = INR n). { intros n; case (eq_nat_dec n 0); auto with real. intros; absurd (0 < n)%nat; lia. } intros; unfold Rsqr; repeat rewrite fact_prodSO. assert (H2:(k=N)%nat \/ (k < N)%nat \/ (N < k)%nat) by lia. elim H2; intro H3. { rewrite H3; replace (2*N-N)%nat with N by lia;right; ring. } case H3; intro; clear H2 H3. + rewrite (prod_SO_split (fun l:nat => if eq_nat_dec l 0 then 1 else INR l) (2 * N - k) N). 2:{ lia. } rewrite Rmult_assoc; apply Rmult_le_compat_l. { apply prod_SO_pos; intros; auto. } replace (2 * N - k - N-1)%nat with (N - k-1)%nat by lia. rewrite Rmult_comm; rewrite (prod_SO_split (fun l:nat => if eq_nat_dec l 0 then 1 else INR l) N k). 2:{ lia. } apply Rmult_le_compat_l. * apply prod_SO_pos; intros; auto. * apply prod_SO_Rle; intros; split; auto. rewrite H0. -- rewrite H0. ++ apply le_INR; lia. ++ lia. -- lia. + rewrite <- (Rmult_comm (prod_f_R0 (fun l:nat => if eq_nat_dec l 0 then 1 else INR l) k)); rewrite (prod_SO_split (fun l:nat => if eq_nat_dec l 0 then 1 else INR l) k N). 2:{ lia. } rewrite Rmult_assoc; apply Rmult_le_compat_l. { apply prod_SO_pos; intros; auto. } rewrite Rmult_comm; rewrite (prod_SO_split (fun l:nat => if eq_nat_dec l 0 then 1 else INR l) N (2 * N - k)). 2:{ lia. } apply Rmult_le_compat_l. { apply prod_SO_pos; intros; auto. } replace (N - (2 * N - k)-1)%nat with (k - N-1)%nat. 2:{ lia. } apply prod_SO_Rle; intros; split; auto. rewrite H0. 2:{ lia. } rewrite H0. 2:{ lia. } apply le_INR; lia. Qed. (**********) Lemma INR_fact_lt_0 : forall n:nat, 0 < INR (fact n). Proof. intro; apply lt_INR_0; apply Nat.neq_0_lt_0; red; intro; elim (fact_neq_0 n); assumption. Qed. (** We have the following inequality : (C 2N k) <= (C 2N N) forall k in [|O;2N|] *) Lemma C_maj : forall N k:nat, (k <= 2 * N)%nat -> C (2 * N) k <= C (2 * N) N. Proof. intros; unfold C; unfold Rdiv; apply Rmult_le_compat_l. { apply pos_INR. } replace (2 * N - N)%nat with N. - apply Rmult_le_reg_l with (INR (fact N) * INR (fact N)). { apply Rmult_lt_0_compat; apply INR_fact_lt_0. } rewrite Rinv_r. + rewrite Rmult_comm; apply Rmult_le_reg_l with (INR (fact k) * INR (fact (2 * N - k))). { apply Rmult_lt_0_compat; apply INR_fact_lt_0. } rewrite Rmult_1_r; rewrite <- mult_INR; rewrite <- Rmult_assoc; rewrite Rinv_r. * rewrite Rmult_1_l; rewrite mult_INR; rewrite (Rmult_comm (INR (fact k))); replace (INR (fact N) * INR (fact N)) with (Rsqr (INR (fact N))). -- apply RfactN_fact2N_factk. assumption. -- reflexivity. * rewrite mult_INR; apply prod_neq_R0; apply INR_fact_neq_0. + apply prod_neq_R0; apply INR_fact_neq_0. - lia. Qed. coq-8.20.0/theories/Reals/Rregisternames.v000066400000000000000000000026701466560755400204630ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* R. (*********) Fixpoint Rmax_N (N:nat) : R := match N with | O => Un 0 | S n => Rmax (Un (S n)) (Rmax_N n) end. (*********) Definition EUn r : Prop := exists i : nat, r = Un i. (*********) Definition Un_cv (l:R) : Prop := forall eps:R, eps > 0 -> exists N : nat, (forall n:nat, (n >= N)%nat -> Rdist (Un n) l < eps). (*********) Definition Cauchy_crit : Prop := forall eps:R, eps > 0 -> exists N : nat, (forall n m:nat, (n >= N)%nat -> (m >= N)%nat -> Rdist (Un n) (Un m) < eps). (*********) Definition Un_growing : Prop := forall n:nat, Un n <= Un (S n). (*********) Lemma EUn_noempty : exists r : R, EUn r. Proof. unfold EUn; split with (Un 0); split with 0%nat; trivial. Qed. (*********) Lemma Un_in_EUn : forall n:nat, EUn (Un n). Proof. intro; unfold EUn; split with n; trivial. Qed. (*********) Lemma Un_bound_imp : forall x:R, (forall n:nat, Un n <= x) -> is_upper_bound EUn x. Proof. intros; unfold is_upper_bound; intros; unfold EUn in H0; elim H0; clear H0; intros; generalize (H x1); intro; rewrite <- H0 in H1; trivial. Qed. (*********) Lemma growing_prop : forall n m:nat, Un_growing -> (n >= m)%nat -> Un n >= Un m. Proof. intros * Hgrowing Hle. induction Hle as [|p]. - apply Rge_refl. - apply Rge_trans with (Un p). + apply Rle_ge, Hgrowing. + apply IHHle. Qed. (*********) Lemma Un_cv_crit_lub : Un_growing -> forall l, is_lub EUn l -> Un_cv l. Proof. intros Hug l H eps Heps. cut (exists N, Un N > l - eps). { intros (N, H3). exists N. intros n H4. unfold Rdist. rewrite Rabs_left1, Ropp_minus_distr. - apply Rplus_lt_reg_l with (Un n - eps). apply Rlt_le_trans with (Un N). + now replace (Un n - eps + (l - Un n)) with (l - eps) by ring. + replace (Un n - eps + eps) with (Un n) by ring. apply Rge_le. now apply growing_prop. - apply Rle_minus. apply (proj1 H). now exists n. } assert (Hi2pn: forall n, 0 < (/ 2)^n). { clear. intros n. apply pow_lt. apply Rinv_0_lt_compat. now apply (IZR_lt 0 2). } pose (test := fun n => match Rle_lt_dec (Un n) (l - eps) with left _ => false | right _ => true end). pose (sum := let fix aux n := match n with S n' => aux n' + if test n' then (/ 2)^n else 0 | O => 0 end in aux). assert (Hsum': forall m n, sum m <= sum (m + n)%nat <= sum m + (/2)^m - (/2)^(m + n)). { clearbody test. clear -Hi2pn. intros m. induction n. - rewrite<- plus_n_O. ring_simplify (sum m + (/ 2) ^ m - (/ 2) ^ m). split ; apply Rle_refl. - rewrite <- plus_n_Sm. simpl. split. + apply Rle_trans with (sum (m + n)%nat + 0). * rewrite Rplus_0_r. apply IHn. * apply Rplus_le_compat_l. case (test (m + n)%nat). -- apply Rlt_le. exact (Hi2pn (S (m + n))). -- apply Rle_refl. + apply Rle_trans with (sum (m + n)%nat + / 2 * (/ 2) ^ (m + n)). * apply Rplus_le_compat_l. case (test (m + n)%nat). -- apply Rle_refl. -- apply Rlt_le. exact (Hi2pn (S (m + n))). * apply Rplus_le_reg_r with (-(/ 2 * (/ 2) ^ (m + n))). rewrite Rplus_assoc, Rplus_opp_r, Rplus_0_r. apply Rle_trans with (1 := proj2 IHn). apply Req_le. field. } assert (Hsum: forall n, 0 <= sum n <= 1 - (/2)^n). { intros N. generalize (Hsum' O N). simpl. now rewrite Rplus_0_l. } destruct (completeness (fun x : R => exists n : nat, x = sum n)) as (m, (Hm1, Hm2)). - exists 1. intros x (n, H1). rewrite H1. apply Rle_trans with (1 := proj2 (Hsum n)). apply Rlt_le. apply Rplus_lt_reg_l with ((/2)^n - 1). now ring_simplify. - exists 0. now exists O. - destruct (Rle_or_lt m 0) as [[Hm|Hm]|Hm]. + elim Rlt_not_le with (1 := Hm). apply Hm1. now exists O. + assert (Hs0: forall n, sum n = 0). { intros n. specialize (Hm1 (sum n) (ex_intro _ _ (eq_refl _))). apply Rle_antisym with (2 := proj1 (Hsum n)). now rewrite <- Hm. } assert (Hub: forall n, Un n <= l - eps). { intros n. generalize (eq_refl (sum (S n))). simpl sum at 1. rewrite 2!Hs0, Rplus_0_l. unfold test. destruct Rle_lt_dec. - easy. - intros H'. elim Rgt_not_eq with (2 := H'). exact (Hi2pn (S n)). } clear -Heps H Hub. destruct H as (_, H). refine (False_ind _ (Rle_not_lt _ _ (H (l - eps) _) _)). * intros x (n, H1). now rewrite H1. * apply Rplus_lt_reg_l with (eps - l). now ring_simplify. + assert (Rabs (/2) < 1). { rewrite Rabs_pos_eq. - rewrite <- Rinv_1. apply Rinv_lt_contravar. + rewrite Rmult_1_l. now apply (IZR_lt 0 2). + now apply (IZR_lt 1 2). - apply Rlt_le. apply Rinv_0_lt_compat. now apply (IZR_lt 0 2). } destruct (pow_lt_1_zero (/2) H0 m Hm) as [N H4]. exists N. apply Rnot_le_lt. intros H5. apply Rlt_not_le with (1 := H4 _ (Nat.le_refl _)). rewrite Rabs_pos_eq. 2: now apply Rlt_le. apply Hm2. intros x (n, H6). rewrite H6. clear x H6. assert (Hs: sum N = 0). { clear H4. induction N. - easy. - simpl. assert (H6: Un N <= l - eps). + apply Rle_trans with (2 := H5). apply Rge_le. apply growing_prop ; try easy. apply Nat.le_succ_diag_r. + rewrite (IHN H6), Rplus_0_l. unfold test. destruct Rle_lt_dec as [Hle|Hlt]. * apply eq_refl. * now elim Rlt_not_le with (1 := Hlt). } destruct (Nat.le_gt_cases N n) as [Hn|Hn]. * rewrite <- (Nat.sub_add _ _ Hn), Nat.add_comm. apply Rle_trans with (1 := proj2 (Hsum' N (n - N)%nat)). rewrite Hs, Rplus_0_l. set (k := (N + (n - N))%nat). apply Rlt_le. apply Rplus_lt_reg_l with ((/2)^k - (/2)^N). now ring_simplify. * apply Rle_trans with (sum N). -- rewrite <- (Nat.sub_add _ _ Hn), Nat.add_comm. simpl Nat.add; rewrite <- Nat.add_succ_r. exact (proj1 (Hsum' _ _)). -- rewrite Hs. now apply Rlt_le. Qed. (*********) Lemma Un_cv_crit : Un_growing -> bound EUn -> exists l : R, Un_cv l. Proof. intros Hug Heub. exists (proj1_sig (completeness EUn Heub EUn_noempty)). destruct (completeness EUn Heub EUn_noempty) as (l, H). now apply Un_cv_crit_lub. Qed. (*********) Lemma finite_greater : forall N:nat, exists M : R, (forall n:nat, (n <= N)%nat -> Un n <= M). Proof. intro; induction N as [| N HrecN]. - split with (Un 0); intros. rewrite (proj1 (Nat.le_0_r n) H); apply (Req_le (Un 0) (Un 0) (eq_refl (Un 0))). - elim HrecN; clear HrecN; intros; split with (Rmax (Un (S N)) x); intros; elim (Rmax_Rle (Un (S N)) x (Un n)); intros; clear H1; inversion H0. + rewrite <- H1; rewrite <- H1 in H2; apply (H2 (or_introl (Un n <= x) (Req_le (Un n) (Un n) (eq_refl (Un n))))). + apply (H2 (or_intror (Un n <= Un (S N)) (H n H3))). Qed. (*********) Lemma cauchy_bound : Cauchy_crit -> bound EUn. Proof. unfold Cauchy_crit, bound; intros; unfold is_upper_bound; unfold Rgt in H; elim (H 1 Rlt_0_1); clear H; intros; generalize (H x); intro; generalize (le_dec x); intro; elim (finite_greater x); intros; split with (Rmax x0 (Un x + 1)); clear H; intros; unfold EUn in H; elim H; clear H; intros; elim (H1 x2); clear H1; intro y. - unfold ge in H0; generalize (H0 x2 (le_n x) y); clear H0; intro; rewrite <- H in H0; unfold Rdist in H0; elim (Rabs_def2 (Un x - x1) 1 H0); clear H0; intros; elim (Rmax_Rle x0 (Un x + 1) x1); intros; apply H4; clear H3 H4; right; clear H H0 y; apply (Rlt_le x1 (Un x + 1)); generalize (Rlt_minus (-1) (Un x - x1) H1); clear H1; intro; apply (Rminus_lt x1 (Un x + 1)); cut (-1 - (Un x - x1) = x1 - (Un x + 1)); [ intro; rewrite H0 in H; assumption | ring ]. - generalize (H2 x2 y); clear H2 H0; intro; rewrite <- H in H0; elim (Rmax_Rle x0 (Un x + 1) x1); intros; clear H1; apply H2; left; assumption. Qed. End sequence. (*****************************************************************) (** * Definition of Power Series and properties *) (* *) (*****************************************************************) Section Isequence. (*********) Variable An : nat -> R. (*********) Definition Pser (x l:R) : Prop := infinite_sum (fun n:nat => An n * x ^ n) l. End Isequence. Lemma GP_infinite : forall x:R, Rabs x < 1 -> Pser (fun n:nat => 1) x (/ (1 - x)). Proof. intros; unfold Pser; unfold infinite_sum; intros; elim (Req_dec x 0). - intros; exists 0%nat; intros; rewrite H1; rewrite Rminus_0_r; rewrite Rinv_1; cut (sum_f_R0 (fun n0:nat => 1 * 0 ^ n0) n = 1). + intros; rewrite H3; rewrite Rdist_eq; auto. + elim n; simpl. * ring. * intros; rewrite H3; ring. - intro; cut (0 < eps * (Rabs (1 - x) * Rabs (/ x))). + intro; elim (pow_lt_1_zero x H (eps * (Rabs (1 - x) * Rabs (/ x))) H2); intro N; intros; exists N; intros; cut (sum_f_R0 (fun n0:nat => 1 * x ^ n0) n = sum_f_R0 (fun n0:nat => x ^ n0) n). * intros; rewrite H5; apply (Rmult_lt_reg_l (Rabs (1 - x)) (Rdist (sum_f_R0 (fun n0:nat => x ^ n0) n) (/ (1 - x))) eps). -- apply Rabs_pos_lt. apply Rminus_eq_contra. apply Rlt_dichotomy_converse. right; unfold Rgt. apply (Rle_lt_trans x (Rabs x) 1). ++ apply RRle_abs. ++ assumption. -- unfold Rdist; rewrite <- Rabs_mult. rewrite Rmult_minus_distr_l. cut ((1 - x) * sum_f_R0 (fun n0:nat => x ^ n0) n = - (sum_f_R0 (fun n0:nat => x ^ n0) n * (x - 1))). ++ intro; rewrite H6. rewrite GP_finite. rewrite Rinv_r. ** assert (- (x ^ (n + 1) - 1) - 1 = - x ^ (n + 1)) by ring. rewrite H7. rewrite Rabs_Ropp; replace (n + 1)%nat with (S n) by ring. simpl; rewrite Rabs_mult; apply (Rlt_le_trans (Rabs x * Rabs (x ^ n)) (Rabs x * (eps * (Rabs (1 - x) * Rabs (/ x)))) (Rabs (1 - x) * eps)). { apply Rmult_lt_compat_l. - apply Rabs_pos_lt. assumption. - auto. } replace (Rabs x * (eps * (Rabs (1 - x) * Rabs (/ x)))) with (Rabs x * Rabs (/ x) * (eps * Rabs (1 - x))) by ring. rewrite <- Rabs_mult; rewrite Rinv_r. 2:assumption. rewrite Rabs_R1. replace (1 * (eps * Rabs (1 - x))) with (Rabs (1 - x) * eps) by ring. unfold Rle; right; reflexivity. ** apply Rminus_eq_contra. apply Rlt_dichotomy_converse. right; unfold Rgt. apply (Rle_lt_trans x (Rabs x) 1). { apply RRle_abs. } assumption. ++ ring. * elim n; simpl. -- ring. -- intros; rewrite H5. ring. + apply Rmult_lt_0_compat. * auto. * apply Rmult_lt_0_compat. -- apply Rabs_pos_lt. apply Rminus_eq_contra. apply Rlt_dichotomy_converse. right; unfold Rgt. apply (Rle_lt_trans x (Rabs x) 1). ++ apply RRle_abs. ++ assumption. -- apply Rabs_pos_lt. apply Rinv_neq_0_compat. assumption. Qed. (* Convergence is preserved after shifting the indices. *) Lemma CV_shift : forall f k l, Un_cv (fun n => f (n + k)%nat) l -> Un_cv f l. intros f' k l cvfk eps ep; destruct (cvfk eps ep) as [N Pn]. exists (N + k)%nat; intros n nN; assert (tmp: (n = (n - k) + k)%nat). - rewrite Nat.sub_add;[ | apply Nat.le_trans with (N + k)%nat]; auto with arith. - rewrite tmp; apply Pn; apply Nat.le_add_le_sub_r; assumption. Qed. Lemma CV_shift' : forall f k l, Un_cv f l -> Un_cv (fun n => f (n + k)%nat) l. intros f' k l cvf eps ep; destruct (cvf eps ep) as [N Pn]. exists N; intros n nN; apply Pn; auto with arith. Qed. (* Growing property is preserved after shifting the indices (one way only) *) Lemma Un_growing_shift : forall k un, Un_growing un -> Un_growing (fun n => un (n + k)%nat). Proof. intros k un P n; apply P. Qed. coq-8.20.0/theories/Reals/Rsigma.v000066400000000000000000000127671466560755400167230ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* R. Definition sigma (low high:nat) : R := sum_f_R0 (fun k:nat => f (low + k)) (high - low). Theorem sigma_split : forall low high k:nat, (low <= k)%nat -> (k < high)%nat -> sigma low high = sigma low k + sigma (S k) high. Proof. intros; induction k as [| k Hreck]. - cut (low = 0%nat). + intro; rewrite H1; unfold sigma; rewrite Nat.sub_diag, Nat.sub_0_r; simpl; replace (high - 1)%nat with (pred high). * apply (decomp_sum (fun k:nat => f k)). assumption. * symmetry; apply Nat.sub_1_r. + inversion H; reflexivity. - cut ((low <= k)%nat \/ low = S k). + intro; elim H1; intro. * replace (sigma low (S k)) with (sigma low k + f (S k)). -- rewrite Rplus_assoc; replace (f (S k) + sigma (S (S k)) high) with (sigma (S k) high). ++ apply Hreck. ** assumption. ** apply Nat.lt_trans with (S k); [ apply Nat.lt_succ_diag_r | assumption ]. ++ unfold sigma; replace (high - S (S k))%nat with (pred (high - S k)). ** pattern (S k) at 3; replace (S k) with (S k + 0)%nat; [ idtac | ring ]. replace (sum_f_R0 (fun k0:nat => f (S (S k) + k0)) (pred (high - S k))) with (sum_f_R0 (fun k0:nat => f (S k + S k0)) (pred (high - S k))). { apply (decomp_sum (fun i:nat => f (S k + i))). apply lt_minus_O_lt; assumption. } apply sum_eq; intros. replace (S k + S i)%nat with (S (S k) + i)%nat by ring. reflexivity. ** replace (high - S (S k))%nat with (high - S k - 1)%nat by lia. symmetry; apply Nat.sub_1_r. -- unfold sigma; replace (S k - low)%nat with (S (k - low)) by lia. pattern (S k) at 1; replace (S k) with (low + S (k - low))%nat by lia. symmetry ; apply (tech5 (fun i:nat => f (low + i))). * rewrite <- H2; unfold sigma; rewrite Nat.sub_diag; simpl; replace (high - S low)%nat with (pred (high - low)) by lia. replace (sum_f_R0 (fun k0:nat => f (S (low + k0))) (pred (high - low))) with (sum_f_R0 (fun k0:nat => f (low + S k0)) (pred (high - low))). -- apply (decomp_sum (fun k0:nat => f (low + k0))). apply lt_minus_O_lt. apply Nat.le_lt_trans with (S k); [ rewrite H2; apply Nat.le_refl | assumption ]. -- apply sum_eq; intros; replace (S (low + i)) with (low + S i)%nat by ring. reflexivity. + inversion H; [ right; reflexivity | left; assumption ]. Qed. Theorem sigma_diff : forall low high k:nat, (low <= k)%nat -> (k < high)%nat -> sigma low high - sigma low k = sigma (S k) high. Proof. intros low high k H1 H2; symmetry ; rewrite (sigma_split H1 H2); ring. Qed. Theorem sigma_diff_neg : forall low high k:nat, (low <= k)%nat -> (k < high)%nat -> sigma low k - sigma low high = - sigma (S k) high. Proof. intros low high k H1 H2; rewrite (sigma_split H1 H2); ring. Qed. Theorem sigma_first : forall low high:nat, (low < high)%nat -> sigma low high = f low + sigma (S low) high. Proof. intros low high H1; generalize (proj2 (Nat.le_succ_l low high) H1); intro H2; generalize (Nat.lt_le_incl low high H1); intro H3; replace (f low) with (sigma low low). - apply sigma_split. + apply le_n. + assumption. - unfold sigma; rewrite Nat.sub_diag. simpl. replace (low + 0)%nat with low; [ reflexivity | ring ]. Qed. Theorem sigma_last : forall low high:nat, (low < high)%nat -> sigma low high = f high + sigma low (pred high). Proof. intros low high H1; generalize (proj2 (Nat.le_succ_l low high) H1); intro H2; generalize (Nat.lt_le_incl low high H1); intro H3; replace (f high) with (sigma high high). - rewrite Rplus_comm; cut (high = S (pred high)). + intro; pattern high at 3; rewrite H. apply sigma_split. * apply le_S_n; rewrite <- H; apply Nat.le_succ_l; assumption. * apply Nat.lt_pred_l, Nat.neq_0_lt_0; apply Nat.le_lt_trans with low; [ apply Nat.le_0_l | assumption ]. + symmetry; apply Nat.lt_succ_pred with 0%nat; apply Nat.le_lt_trans with low; [ apply Nat.le_0_l | assumption ]. - unfold sigma; rewrite Nat.sub_diag; simpl; replace (high + 0)%nat with high; [ reflexivity | ring ]. Qed. Theorem sigma_eq_arg : forall low:nat, sigma low low = f low. Proof. intro; unfold sigma; rewrite Nat.sub_diag. simpl; replace (low + 0)%nat with low; [ reflexivity | ring ]. Qed. End Sigma. coq-8.20.0/theories/Reals/Rsqrt_def.v000066400000000000000000000554021466560755400174230ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* bool) (N:nat) {struct N} : R := match N with | O => x | S n => let down := Dichotomy_lb x y P n in let up := Dichotomy_ub x y P n in let z := (down + up) / 2 in if P z then down else z end with Dichotomy_ub (x y:R) (P:R -> bool) (N:nat) {struct N} : R := match N with | O => y | S n => let down := Dichotomy_lb x y P n in let up := Dichotomy_ub x y P n in let z := (down + up) / 2 in if P z then z else up end. Definition dicho_lb (x y:R) (P:R -> bool) (N:nat) : R := Dichotomy_lb x y P N. Definition dicho_up (x y:R) (P:R -> bool) (N:nat) : R := Dichotomy_ub x y P N. (**********) Lemma dicho_comp : forall (x y:R) (P:R -> bool) (n:nat), x <= y -> dicho_lb x y P n <= dicho_up x y P n. Proof. intros. induction n as [| n Hrecn]. - simpl; assumption. - simpl. case (P ((Dichotomy_lb x y P n + Dichotomy_ub x y P n) / 2)). + unfold Rdiv; apply Rmult_le_reg_l with 2. * prove_sup0. * pattern 2 at 1; rewrite Rmult_comm. rewrite Rmult_assoc; rewrite Rinv_l; [ idtac | discrR ]. rewrite Rmult_1_r. rewrite <-Rplus_diag. apply Rplus_le_compat_l. assumption. + unfold Rdiv; apply Rmult_le_reg_l with 2. * prove_sup0. * rewrite Rmult_comm. rewrite Rmult_assoc; rewrite Rinv_l; [ idtac | discrR ]. rewrite Rmult_1_r. rewrite <-Rplus_diag. rewrite <- (Rplus_comm (Dichotomy_ub x y P n)). apply Rplus_le_compat_l. assumption. Qed. Lemma dicho_lb_growing : forall (x y:R) (P:R -> bool), x <= y -> Un_growing (dicho_lb x y P). Proof. intros. unfold Un_growing. intro. simpl. case (P ((Dichotomy_lb x y P n + Dichotomy_ub x y P n) / 2)). - right; reflexivity. - unfold Rdiv; apply Rmult_le_reg_l with 2. + prove_sup0. + pattern 2 at 1; rewrite Rmult_comm. rewrite Rmult_assoc; rewrite Rinv_l; [ idtac | discrR ]. rewrite Rmult_1_r. rewrite <-Rplus_diag. apply Rplus_le_compat_l. replace (Dichotomy_ub x y P n) with (dicho_up x y P n); [ apply dicho_comp; assumption | reflexivity ]. Qed. Lemma dicho_up_decreasing : forall (x y:R) (P:R -> bool), x <= y -> Un_decreasing (dicho_up x y P). Proof. intros. unfold Un_decreasing. intro. simpl. case (P ((Dichotomy_lb x y P n + Dichotomy_ub x y P n) / 2)). - unfold Rdiv; apply Rmult_le_reg_l with 2. + prove_sup0. + rewrite Rmult_comm. rewrite Rmult_assoc; rewrite Rinv_l; [ idtac | discrR ]. rewrite Rmult_1_r. rewrite <-Rplus_diag. replace (Dichotomy_ub x y P n) with (dicho_up x y P n); [ idtac | reflexivity ]. replace (Dichotomy_lb x y P n) with (dicho_lb x y P n); [ idtac | reflexivity ]. rewrite <- (Rplus_comm (dicho_up x y P n)). apply Rplus_le_compat_l. apply dicho_comp; assumption. - right; reflexivity. Qed. Lemma dicho_lb_maj_y : forall (x y:R) (P:R -> bool), x <= y -> forall n:nat, dicho_lb x y P n <= y. Proof. intros. induction n as [| n Hrecn]. - simpl; assumption. - simpl. case (P ((Dichotomy_lb x y P n + Dichotomy_ub x y P n) / 2)). + assumption. + unfold Rdiv; apply Rmult_le_reg_l with 2. * prove_sup0. * rewrite Rmult_comm. rewrite Rmult_assoc; rewrite Rinv_l; [ rewrite Rmult_1_r | discrR ]. rewrite <-Rplus_diag; apply Rplus_le_compat. -- assumption. -- pattern y at 2; replace y with (Dichotomy_ub x y P 0); [ idtac | reflexivity ]. apply decreasing_prop. ++ assert (H0 := dicho_up_decreasing x y P H). assumption. ++ apply Nat.le_0_l. Qed. Lemma dicho_lb_maj : forall (x y:R) (P:R -> bool), x <= y -> has_ub (dicho_lb x y P). Proof. intros. cut (forall n:nat, dicho_lb x y P n <= y). - intro. unfold has_ub. unfold bound. exists y. unfold is_upper_bound. intros. elim H1; intros. rewrite H2; apply H0. - apply dicho_lb_maj_y; assumption. Qed. Lemma dicho_up_min_x : forall (x y:R) (P:R -> bool), x <= y -> forall n:nat, x <= dicho_up x y P n. Proof. intros. induction n as [| n Hrecn]. - simpl; assumption. - simpl. case (P ((Dichotomy_lb x y P n + Dichotomy_ub x y P n) / 2)). + unfold Rdiv; apply Rmult_le_reg_l with 2. * prove_sup0. * pattern 2 at 1; rewrite Rmult_comm. rewrite Rmult_assoc; rewrite Rinv_l; [ rewrite Rmult_1_r | discrR ]. rewrite <-Rplus_diag; apply Rplus_le_compat. -- pattern x at 1; replace x with (Dichotomy_lb x y P 0); [ idtac | reflexivity ]. apply tech9. ++ assert (H0 := dicho_lb_growing x y P H). assumption. ++ apply Nat.le_0_l. -- assumption. + assumption. Qed. Lemma dicho_up_min : forall (x y:R) (P:R -> bool), x <= y -> has_lb (dicho_up x y P). Proof. intros. cut (forall n:nat, x <= dicho_up x y P n). - intro. unfold has_lb. unfold bound. exists (- x). unfold is_upper_bound. intros. elim H1; intros. rewrite H2. unfold opp_seq. apply Ropp_le_contravar. apply H0. - apply dicho_up_min_x; assumption. Qed. Lemma dicho_lb_cv : forall (x y:R) (P:R -> bool), x <= y -> { l:R | Un_cv (dicho_lb x y P) l }. Proof. intros. apply growing_cv. - apply dicho_lb_growing; assumption. - apply dicho_lb_maj; assumption. Qed. Lemma dicho_up_cv : forall (x y:R) (P:R -> bool), x <= y -> { l:R | Un_cv (dicho_up x y P) l }. Proof. intros. apply decreasing_cv. - apply dicho_up_decreasing; assumption. - apply dicho_up_min; assumption. Qed. Lemma dicho_lb_dicho_up : forall (x y:R) (P:R -> bool) (n:nat), x <= y -> dicho_up x y P n - dicho_lb x y P n = (y - x) / 2 ^ n. Proof. intros. induction n as [| n Hrecn]. - simpl. unfold Rdiv; rewrite Rinv_1; ring. - simpl. case (P ((Dichotomy_lb x y P n + Dichotomy_ub x y P n) / 2)). + unfold Rdiv. replace ((Dichotomy_lb x y P n + Dichotomy_ub x y P n) * / 2 - Dichotomy_lb x y P n) with ((dicho_up x y P n - dicho_lb x y P n) / 2). * unfold Rdiv; rewrite Hrecn. unfold Rdiv. field. apply pow_nonzero; discrR. * pattern (Dichotomy_lb x y P n) at 2; rewrite <-(Rplus_half_diag (Dichotomy_lb x y P n)); unfold dicho_up, dicho_lb, Rminus, Rdiv; ring. + replace (Dichotomy_ub x y P n - (Dichotomy_lb x y P n + Dichotomy_ub x y P n) / 2) with ((dicho_up x y P n - dicho_lb x y P n) / 2). * unfold Rdiv; rewrite Hrecn. field. apply pow_nonzero; discrR. * pattern (Dichotomy_ub x y P n) at 1; rewrite <-(Rplus_half_diag (Dichotomy_ub x y P n)); unfold dicho_up, dicho_lb, Rminus, Rdiv; ring. Qed. Definition pow_2_n (n:nat) := 2 ^ n. Lemma pow_2_n_neq_R0 : forall n:nat, pow_2_n n <> 0. Proof. intro. unfold pow_2_n. apply pow_nonzero. discrR. Qed. Lemma pow_2_n_growing : Un_growing pow_2_n. Proof. unfold Un_growing. intro. replace (S n) with (n + 1)%nat; [ unfold pow_2_n; rewrite pow_add | ring ]. pattern (2 ^ n) at 1; rewrite <- Rmult_1_r. apply Rmult_le_compat_l. - left; apply pow_lt; prove_sup0. - simpl. rewrite Rmult_1_r. pattern 1 at 1; rewrite <- Rplus_0_r; apply Rplus_le_compat_l; left; apply Rlt_0_1. Qed. Lemma pow_2_n_infty : cv_infty pow_2_n. Proof. assert (forall N:nat, INR N <= 2 ^ N). { simple induction N. - simpl. left; apply Rlt_0_1. - intros. pattern (S n) at 2; replace (S n) with (n + 1)%nat; [ idtac | ring ]. rewrite S_INR; rewrite pow_add. simpl. rewrite Rmult_1_r. apply Rle_trans with (2 ^ n). + rewrite <- (Rplus_comm 1). rewrite <- (Rmult_1_r (INR n)). apply (poly n 1). apply Rlt_0_1. + pattern (2 ^ n) at 1; rewrite <- Rplus_0_r. rewrite <- (Rmult_comm 2). rewrite <-Rplus_diag. apply Rplus_le_compat_l. left; apply pow_lt; prove_sup0. } intros. unfold cv_infty. intro. destruct (total_order_T 0 M) as [[Hlt|<-]|Hgt]. 2:{ exists 0%nat; intros. unfold pow_2_n; apply pow_lt; prove_sup0. } 2:{ exists 0%nat; intros. apply Rlt_trans with 0. - assumption. - unfold pow_2_n; apply pow_lt; prove_sup0. } set (N := up M). assert (0 <= N)%Z. { apply le_IZR. unfold N. assert (H0 := archimed M); elim H0; intros. left; apply Rlt_trans with M; assumption. } elim (IZN N H0); intros N0 H1. exists N0. intros. apply Rlt_le_trans with (INR N0). { rewrite INR_IZR_INZ. rewrite <- H1. unfold N. assert (H3 := archimed M). elim H3; intros; assumption. } apply Rle_trans with (pow_2_n N0). { unfold pow_2_n; apply H. } apply Rge_le. apply growing_prop. 2:assumption. apply pow_2_n_growing. Qed. Lemma cv_dicho : forall (x y l1 l2:R) (P:R -> bool), x <= y -> Un_cv (dicho_lb x y P) l1 -> Un_cv (dicho_up x y P) l2 -> l1 = l2. Proof. intros. assert (H2 := CV_minus _ _ _ _ H0 H1). cut (Un_cv (fun i:nat => dicho_lb x y P i - dicho_up x y P i) 0). { intro. assert (H4 := UL_sequence _ _ _ H2 H3). apply Rminus_diag_uniq; assumption. } unfold Un_cv; unfold Rdist. intros. assert (H4 := cv_infty_cv_0 pow_2_n pow_2_n_infty). destruct (total_order_T x y) as [[ Hlt | -> ]|Hgt]. 2:{ exists 0%nat; intros. replace (dicho_lb y y P n - dicho_up y y P n - 0) with (dicho_lb y y P n - dicho_up y y P n); [ idtac | ring ]. rewrite <- Rabs_Ropp. rewrite Ropp_minus_distr. rewrite dicho_lb_dicho_up. - unfold Rminus, Rdiv; rewrite Rplus_opp_r; rewrite Rmult_0_l; rewrite Rabs_R0; assumption. - assumption. } 2:{ elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H Hgt)). } unfold Un_cv in H4; unfold Rdist in H4. assert (Hyp:0 < y - x) by lra. assert (0 < eps / (y - x)). { unfold Rdiv; apply Rmult_lt_0_compat; [ assumption | apply Rinv_0_lt_compat; assumption ]. } elim (H4 (eps / (y - x)) H5); intros N H6. exists N; intros. replace (dicho_lb x y P n - dicho_up x y P n - 0) with (dicho_lb x y P n - dicho_up x y P n); [ idtac | ring ]. rewrite <- Rabs_Ropp. rewrite Ropp_minus_distr. rewrite dicho_lb_dicho_up. 2:lra. unfold Rdiv; rewrite Rabs_mult. rewrite (Rabs_right (y - x)). 2:lra. apply Rmult_lt_reg_l with (/ (y - x)). { apply Rinv_0_lt_compat; assumption. } rewrite <- Rmult_assoc; rewrite Rinv_l. 2:lra. rewrite Rmult_1_l. replace (/ 2 ^ n) with (/ 2 ^ n - 0); [ unfold pow_2_n, Rdiv in H6; rewrite <- (Rmult_comm eps); apply H6; assumption | ring ]. Qed. Definition cond_positivity (x:R) : bool := match Rle_dec 0 x with | left _ => true | right _ => false end. (** Sequential characterisation of continuity *) Lemma continuity_seq : forall (f:R -> R) (Un:nat -> R) (l:R), continuity_pt f l -> Un_cv Un l -> Un_cv (fun i:nat => f (Un i)) (f l). Proof. unfold continuity_pt, Un_cv; unfold continue_in. unfold limit1_in. unfold limit_in. unfold dist. simpl. unfold Rdist. intros. elim (H eps H1); intros alp H2. elim H2; intros. elim (H0 alp H3); intros N H5. exists N; intros. case (Req_dec (Un n) l); intro. - rewrite H7; unfold Rminus; rewrite Rplus_opp_r; rewrite Rabs_R0; assumption. - apply H4. split. + unfold D_x, no_cond. split. * trivial. * apply (not_eq_sym (A:=R)); assumption. + apply H5; assumption. Qed. Lemma dicho_lb_car : forall (x y:R) (P:R -> bool) (n:nat), P x = false -> P (dicho_lb x y P n) = false. Proof. intros. induction n as [| n Hrecn]. - assumption. - simpl. destruct (sumbool_of_bool (P ((Dichotomy_lb x y P n + Dichotomy_ub x y P n) / 2))) as [Heq|Heq]. + rewrite Heq. unfold dicho_lb in Hrecn; assumption. + rewrite Heq. assumption. Qed. Lemma dicho_up_car : forall (x y:R) (P:R -> bool) (n:nat), P y = true -> P (dicho_up x y P n) = true. Proof. intros. induction n as [| n Hrecn]. - assumption. - simpl. destruct (sumbool_of_bool (P ((Dichotomy_lb x y P n + Dichotomy_ub x y P n) / 2))) as [Heq|Heq]. + rewrite Heq. unfold dicho_lb in Hrecn; assumption. + rewrite Heq. assumption. Qed. (* A general purpose corollary. *) Lemma cv_pow_half : forall a, Un_cv (fun n => a/2^n) 0. intros a; unfold Rdiv; replace 0 with (a * 0) by ring. apply CV_mult. - intros eps ep; exists 0%nat; rewrite Rdist_eq; intros n _; assumption. - exact (cv_infty_cv_0 pow_2_n pow_2_n_infty). Qed. (** Intermediate Value Theorem *) Lemma IVT : forall (f:R -> R) (x y:R), continuity f -> x < y -> f x < 0 -> 0 < f y -> { z:R | x <= z <= y /\ f z = 0 }. Proof. intros. assert (x <= y) by (left; assumption). destruct (dicho_lb_cv x y (fun z:R => cond_positivity (f z)) H3) as (x1,p0). destruct (dicho_up_cv x y (fun z:R => cond_positivity (f z)) H3) as (x0,p). assert (H4 := cv_dicho _ _ _ _ _ H3 p0 p). rewrite H4 in p0. exists x0. split;[split|]. - apply Rle_trans with (dicho_lb x y (fun z:R => cond_positivity (f z)) 0). { simpl. right; reflexivity. } apply growing_ineq. { apply dicho_lb_growing; assumption. } assumption. - apply Rle_trans with (dicho_up x y (fun z:R => cond_positivity (f z)) 0). { apply decreasing_ineq. { apply dicho_up_decreasing; assumption. } assumption. } right; reflexivity. - set (Vn := fun n:nat => dicho_lb x y (fun z:R => cond_positivity (f z)) n). set (Wn := fun n:nat => dicho_up x y (fun z:R => cond_positivity (f z)) n). cut ((forall n:nat, f (Vn n) <= 0) -> f x0 <= 0). 1:cut ((forall n:nat, 0 <= f (Wn n)) -> 0 <= f x0). + intros. cut (forall n:nat, f (Vn n) <= 0). 1:cut (forall n:nat, 0 <= f (Wn n)). { intros. assert (H9 := H6 H8). assert (H10 := H5 H7). apply Rle_antisym; assumption. } * intro. unfold Wn. cut (forall z:R, cond_positivity z = true <-> 0 <= z). 2:{ intro. unfold cond_positivity. case (Rle_dec 0 z) as [Hle|Hnle]. - split. + intro; assumption. + intro; reflexivity. - split. + intro feqt;discriminate feqt. + intro. contradiction. } intro. assert (H8 := dicho_up_car x y (fun z:R => cond_positivity (f z)) n). elim (H7 (f (dicho_up x y (fun z:R => cond_positivity (f z)) n))); intros. apply H9. apply H8. elim (H7 (f y)); intros. apply H12. left; assumption. * unfold Vn. cut (forall z:R, cond_positivity z = false <-> z < 0). 2:{ intro. unfold cond_positivity. case (Rle_dec 0 z) as [Hle|Hnle]. - split. + intro feqt; discriminate feqt. + intro; elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ Hle H7)). - split. + intro; auto with real. + intro; reflexivity. } intros. assert (H8 := dicho_lb_car x y (fun z:R => cond_positivity (f z)) n). left. elim (H7 (f (dicho_lb x y (fun z:R => cond_positivity (f z)) n))); intros. apply H9. apply H8. elim (H7 (f x)); intros. apply H12. assumption. + assert (Un_cv Wn x0) by (unfold Wn; assumption). intros. assert (H7 := continuity_seq f Wn x0 (H x0) H5). destruct (total_order_T 0 (f x0)) as [[Hlt|<-]|Hgt]. { left; assumption. } { right; reflexivity. } unfold Un_cv in H7; unfold Rdist in H7. assert (0 < - f x0) by (apply Ropp_0_gt_lt_contravar; assumption). elim (H7 (- f x0) H8); intros. cut (x2 >= x2)%nat; [ intro | unfold ge; apply le_n ]. assert (H11 := H9 x2 H10). rewrite Rabs_right in H11. 2:{ apply Rle_ge; left; unfold Rminus; apply Rplus_le_lt_0_compat. - apply H6. - exact H8. } pattern (- f x0) at 1 in H11; rewrite <- Rplus_0_r in H11. unfold Rminus in H11; rewrite (Rplus_comm (f (Wn x2))) in H11. assert (H12 := Rplus_lt_reg_l _ _ _ H11). assert (H13 := H6 x2). elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H13 H12)). + assert (Un_cv Vn x0) by (unfold Vn; assumption). intros. assert (H7 := continuity_seq f Vn x0 (H x0) H5). destruct (total_order_T 0 (f x0)) as [[Hlt|<-]|Hgt]. 2:{ right; reflexivity. } 2:{ left; assumption. } unfold Un_cv in H7; unfold Rdist in H7. elim (H7 (f x0) Hlt); intros. cut (x2 >= x2)%nat; [ intro | unfold ge; apply le_n ]. assert (H10 := H8 x2 H9). rewrite Rabs_left in H10. 2:{ apply Rplus_lt_reg_l with (f x0 - f (Vn x2)). rewrite Rplus_0_r; replace (f x0 - f (Vn x2) + (f (Vn x2) - f x0)) with 0; [ unfold Rminus; apply Rplus_lt_le_0_compat | ring ]. - assumption. - apply Ropp_0_ge_le_contravar; apply Rle_ge; apply H6. } pattern (f x0) at 2 in H10; rewrite <- Rplus_0_r in H10. rewrite Ropp_minus_distr in H10. unfold Rminus in H10. assert (H11 := Rplus_lt_reg_l _ _ _ H10). assert (H12 := H6 x2). cut (0 < f (Vn x2)). * intro. elim (Rlt_irrefl _ (Rlt_le_trans _ _ _ H13 H12)). * rewrite <- (Ropp_involutive (f (Vn x2))). apply Ropp_0_gt_lt_contravar; assumption. Qed. Lemma IVT_cor : forall (f:R -> R) (x y:R), continuity f -> x <= y -> f x * f y <= 0 -> { z:R | x <= z <= y /\ f z = 0 }. Proof. intros. destruct (total_order_T 0 (f x)) as [[Hltx|Heqx]|Hgtx]. 2:{ exists x. split. - split; [ right; reflexivity | assumption ]. - symmetry ; assumption. } 1,2:destruct (total_order_T 0 (f y)) as [[Hlty|Heqy]|Hgty]. - cut (0 < f x * f y); [ intro; elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H1 H2)) | apply Rmult_lt_0_compat; assumption ]. - exists y. split. + split; [ assumption | right; reflexivity ]. + symmetry ; exact Heqy. - cut (x < y). + intro. assert (H3 := IVT (- f)%F x y (continuity_opp f H) H2). cut ((- f)%F x < 0). * cut (0 < (- f)%F y). -- intros. destruct (H3 H5 H4) as (x0,[]). exists x0. split. ++ assumption. ++ unfold opp_fct in H7. rewrite <- (Ropp_involutive (f x0)). apply Ropp_eq_0_compat; assumption. -- unfold opp_fct; apply Ropp_0_gt_lt_contravar; assumption. * unfold opp_fct. apply Rplus_lt_reg_l with (f x); rewrite Rplus_opp_r; rewrite Rplus_0_r; assumption. + inversion H0. * assumption. * rewrite H2 in Hltx. elim (Rlt_irrefl _ (Rlt_trans _ _ _ Hgty Hltx)). - cut (x < y). + intro. apply IVT; assumption. + inversion H0. * assumption. * rewrite H2 in Hgtx. elim (Rlt_irrefl _ (Rlt_trans _ _ _ Hlty Hgtx)). - exists y. split. + split; [ assumption | right; reflexivity ]. + symmetry ; assumption. - cut (0 < f x * f y). + intro. elim (Rlt_irrefl _ (Rlt_le_trans _ _ _ H2 H1)). + rewrite <- Rmult_opp_opp; apply Rmult_lt_0_compat; apply Ropp_0_gt_lt_contravar; assumption. Qed. (** We can now define the square root function as the reciprocal transformation of the square function *) Lemma Rsqrt_exists : forall y:R, 0 <= y -> { z:R | 0 <= z /\ y = Rsqr z }. Proof. intros. set (f := fun x:R => Rsqr x - y). assert (f 0 <= 0). { unfold f; rewrite Rsqr_0. unfold Rminus; rewrite Rplus_0_l. apply Rge_le. apply Ropp_0_le_ge_contravar; assumption. } assert (continuity f). { replace f with (Rsqr - fct_cte y)%F by reflexivity. apply continuity_minus;apply derivable_continuous. - apply derivable_Rsqr. - apply derivable_const. } destruct (total_order_T y 1) as [[Hlt| -> ]|Hgt]. - assert (0 <= f 1). { unfold f. rewrite Rsqr_1. apply Rplus_le_reg_l with y. rewrite Rplus_0_r; rewrite Rplus_comm; unfold Rminus; rewrite Rplus_assoc; rewrite Rplus_opp_l; rewrite Rplus_0_r; left; assumption. } assert (f 0 * f 1 <= 0). { rewrite Rmult_comm; pattern 0 at 2; rewrite <- (Rmult_0_r (f 1)). apply Rmult_le_compat_l; assumption. } assert (X := IVT_cor f 0 1 H1 (Rlt_le _ _ Rlt_0_1) H3). elim X; intros t H4. exists t. elim H4; intros. split. + elim H5; intros; assumption. + unfold f in H6. symmetry; apply Rminus_diag_uniq; exact H6. - exists 1. split. + left; apply Rlt_0_1. + symmetry; apply Rsqr_1. - assert (0 <= f y). { unfold f. apply Rplus_le_reg_l with y. rewrite Rplus_0_r; rewrite Rplus_comm; unfold Rminus; rewrite Rplus_assoc; rewrite Rplus_opp_l; rewrite Rplus_0_r. pattern y at 1; rewrite <- Rmult_1_r. unfold Rsqr; apply Rmult_le_compat_l. - assumption. - left; exact Hgt. } assert (f 0 * f y <= 0). { rewrite Rmult_comm; pattern 0 at 2; rewrite <- (Rmult_0_r (f y)). apply Rmult_le_compat_l; assumption. } assert (X := IVT_cor f 0 y H1 H H3). elim X; intros t H4. exists t. elim H4; intros. split. + elim H5; intros; assumption. + unfold f in H6. symmetry; apply Rminus_diag_uniq; exact H6. Qed. (* Definition of the square root: R+->R *) Definition Rsqrt (y:nonnegreal) : R := let (a,_) := Rsqrt_exists (nonneg y) (cond_nonneg y) in a. (**********) Lemma Rsqrt_positivity : forall x:nonnegreal, 0 <= Rsqrt x. Proof. intro. destruct (Rsqrt_exists (nonneg x) (cond_nonneg x)) as (x0 & H1 & H2). cut (x0 = Rsqrt x). - intros. rewrite <- H; assumption. - unfold Rsqrt. case (Rsqrt_exists x (cond_nonneg x)) as (?,[]). apply Rsqr_inj. + assumption. + assumption. + rewrite <- H0, <- H2; reflexivity. Qed. (**********) Lemma Rsqrt_Rsqrt : forall x:nonnegreal, Rsqrt x * Rsqrt x = x. Proof. intros. destruct (Rsqrt_exists (nonneg x) (cond_nonneg x)) as (x0 & H1 & H2). cut (x0 = Rsqrt x). - intros. rewrite <- H. rewrite H2; reflexivity. - unfold Rsqrt. case (Rsqrt_exists x (cond_nonneg x)) as (x1 & ? & ?). apply Rsqr_inj. + assumption. + assumption. + rewrite <- H0, <- H2; reflexivity. Qed. coq-8.20.0/theories/Reals/Rtopology.v000066400000000000000000002545441466560755400175000ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* Prop) : Prop := forall x:R, D1 x -> D2 x. Definition disc (x:R) (delta:posreal) (y:R) : Prop := Rabs (y - x) < delta. Definition neighbourhood (V:R -> Prop) (x:R) : Prop := exists delta : posreal, included (disc x delta) V. Definition open_set (D:R -> Prop) : Prop := forall x:R, D x -> neighbourhood D x. Definition complementary (D:R -> Prop) (c:R) : Prop := ~ D c. Definition closed_set (D:R -> Prop) : Prop := open_set (complementary D). Definition intersection_domain (D1 D2:R -> Prop) (c:R) : Prop := D1 c /\ D2 c. Definition union_domain (D1 D2:R -> Prop) (c:R) : Prop := D1 c \/ D2 c. Definition interior (D:R -> Prop) (x:R) : Prop := neighbourhood D x. Lemma interior_P1 : forall D:R -> Prop, included (interior D) D. Proof. intros; unfold included; unfold interior; intros; unfold neighbourhood in H; elim H; intros; unfold included in H0; apply H0; unfold disc; unfold Rminus; rewrite Rplus_opp_r; rewrite Rabs_R0; apply (cond_pos x0). Qed. Lemma interior_P2 : forall D:R -> Prop, open_set D -> included D (interior D). Proof. intros; unfold open_set in H; unfold included; intros; assert (H1 := H _ H0); unfold interior; apply H1. Qed. Definition point_adherent (D:R -> Prop) (x:R) : Prop := forall V:R -> Prop, neighbourhood V x -> exists y : R, intersection_domain V D y. Definition adherence (D:R -> Prop) (x:R) : Prop := point_adherent D x. Lemma adherence_P1 : forall D:R -> Prop, included D (adherence D). Proof. intro; unfold included; intros; unfold adherence; unfold point_adherent; intros; exists x; unfold intersection_domain; split. - unfold neighbourhood in H0; elim H0; intros; unfold included in H1; apply H1; unfold disc; unfold Rminus; rewrite Rplus_opp_r; rewrite Rabs_R0; apply (cond_pos x0). - apply H. Qed. Lemma included_trans : forall D1 D2 D3:R -> Prop, included D1 D2 -> included D2 D3 -> included D1 D3. Proof. unfold included; intros; apply H0; apply H; apply H1. Qed. Lemma interior_P3 : forall D:R -> Prop, open_set (interior D). Proof. intro; unfold open_set, interior; unfold neighbourhood; intros; elim H; intros. exists x0; unfold included; intros. set (del := x0 - Rabs (x - x1)). cut (0 < del). - intro; exists (mkposreal del H2); intros. cut (included (disc x1 (mkposreal del H2)) (disc x x0)). + intro; assert (H5 := included_trans _ _ _ H4 H0). apply H5; apply H3. + unfold included; unfold disc; intros. apply Rle_lt_trans with (Rabs (x3 - x1) + Rabs (x1 - x)). * replace (x3 - x) with (x3 - x1 + (x1 - x)); [ apply Rabs_triang | ring ]. * replace (pos x0) with (del + Rabs (x1 - x)). -- do 2 rewrite <- (Rplus_comm (Rabs (x1 - x))); apply Rplus_lt_compat_l; apply H4. -- unfold del; rewrite <- (Rabs_Ropp (x - x1)); rewrite Ropp_minus_distr; ring. - unfold del; apply Rplus_lt_reg_l with (Rabs (x - x1)); rewrite Rplus_0_r; replace (Rabs (x - x1) + (x0 - Rabs (x - x1))) with (pos x0); [ idtac | ring ]. unfold disc in H1; rewrite <- Rabs_Ropp; rewrite Ropp_minus_distr; apply H1. Qed. Lemma complementary_P1 : forall D:R -> Prop, ~ (exists y : R, intersection_domain D (complementary D) y). Proof. intro; red; intro; elim H; intros; unfold intersection_domain, complementary in H0; elim H0; intros; elim H2; assumption. Qed. Lemma adherence_P2 : forall D:R -> Prop, closed_set D -> included (adherence D) D. Proof. unfold closed_set; unfold open_set, complementary; intros; unfold included, adherence; intros; assert (H1 := classic (D x)); elim H1; intro. - assumption. - assert (H3 := H _ H2); assert (H4 := H0 _ H3); elim H4; intros; unfold intersection_domain in H5; elim H5; intros; elim H6; assumption. Qed. Lemma adherence_P3 : forall D:R -> Prop, closed_set (adherence D). Proof. intro; unfold closed_set, adherence; unfold open_set, complementary, point_adherent; intros; set (P := fun V:R -> Prop => neighbourhood V x -> exists y : R, intersection_domain V D y); assert (H0 := not_all_ex_not _ P H); elim H0; intros V0 H1; unfold P in H1; assert (H2 := imply_to_and _ _ H1); unfold neighbourhood; elim H2; intros; unfold neighbourhood in H3; elim H3; intros; exists x0; unfold included; intros; red; intro. assert (H8 := H7 V0); cut (exists delta : posreal, (forall x:R, disc x1 delta x -> V0 x)). - intro; assert (H10 := H8 H9); elim H4; assumption. - cut (0 < x0 - Rabs (x - x1)). + intro; set (del := mkposreal _ H9); exists del; intros; unfold included in H5; apply H5; unfold disc; apply Rle_lt_trans with (Rabs (x2 - x1) + Rabs (x1 - x)). * replace (x2 - x) with (x2 - x1 + (x1 - x)); [ apply Rabs_triang | ring ]. * replace (pos x0) with (del + Rabs (x1 - x)). -- do 2 rewrite <- (Rplus_comm (Rabs (x1 - x))); apply Rplus_lt_compat_l; apply H10. -- unfold del; simpl; rewrite <- (Rabs_Ropp (x - x1)); rewrite Ropp_minus_distr; ring. + apply Rplus_lt_reg_l with (Rabs (x - x1)); rewrite Rplus_0_r; replace (Rabs (x - x1) + (x0 - Rabs (x - x1))) with (pos x0); [ rewrite <- Rabs_Ropp; rewrite Ropp_minus_distr; apply H6 | ring ]. Qed. Definition eq_Dom (D1 D2:R -> Prop) : Prop := included D1 D2 /\ included D2 D1. Infix "=_D" := eq_Dom (at level 70, no associativity). Lemma open_set_P1 : forall D:R -> Prop, open_set D <-> D =_D interior D. Proof. intro; split. - intro; unfold eq_Dom; split. + apply interior_P2; assumption. + apply interior_P1. - intro; unfold eq_Dom in H; elim H; clear H; intros; unfold open_set; intros; unfold included, interior in H; unfold included in H0; apply (H _ H1). Qed. Lemma closed_set_P1 : forall D:R -> Prop, closed_set D <-> D =_D adherence D. Proof. intro; split. - intro; unfold eq_Dom; split. + apply adherence_P1. + apply adherence_P2; assumption. - unfold eq_Dom; unfold included; intros; assert (H0 := adherence_P3 D); unfold closed_set in H0; unfold closed_set; unfold open_set; unfold open_set in H0; intros; assert (H2 : complementary (adherence D) x). + unfold complementary; unfold complementary in H1; red; intro; elim H; clear H; intros _ H; elim H1; apply (H _ H2). + assert (H3 := H0 _ H2); unfold neighbourhood; unfold neighbourhood in H3; elim H3; intros; exists x0; unfold included; unfold included in H4; intros; assert (H6 := H4 _ H5); unfold complementary in H6; unfold complementary; red; intro; elim H; clear H; intros H _; elim H6; apply (H _ H7). Qed. Lemma neighbourhood_P1 : forall (D1 D2:R -> Prop) (x:R), included D1 D2 -> neighbourhood D1 x -> neighbourhood D2 x. Proof. unfold included, neighbourhood; intros; elim H0; intros; exists x0; intros; unfold included; unfold included in H1; intros; apply (H _ (H1 _ H2)). Qed. Lemma open_set_P2 : forall D1 D2:R -> Prop, open_set D1 -> open_set D2 -> open_set (union_domain D1 D2). Proof. unfold open_set; intros; unfold union_domain in H1; elim H1; intro. - apply neighbourhood_P1 with D1. + unfold included, union_domain; tauto. + apply H; assumption. - apply neighbourhood_P1 with D2. + unfold included, union_domain; tauto. + apply H0; assumption. Qed. Lemma open_set_P3 : forall D1 D2:R -> Prop, open_set D1 -> open_set D2 -> open_set (intersection_domain D1 D2). Proof. unfold open_set; intros; unfold intersection_domain in H1; elim H1; intros. assert (H4 := H _ H2); assert (H5 := H0 _ H3); unfold intersection_domain; unfold neighbourhood in H4, H5; elim H4; clear H; intros del1 H; elim H5; clear H0; intros del2 H0; cut (0 < Rmin del1 del2). - intro; set (del := mkposreal _ H6). exists del; unfold included; intros; unfold included in H, H0; unfold disc in H, H0, H7. split. + apply H; apply Rlt_le_trans with (pos del). * apply H7. * unfold del; simpl; apply Rmin_l. + apply H0; apply Rlt_le_trans with (pos del). * apply H7. * unfold del; simpl; apply Rmin_r. - unfold Rmin; case (Rle_dec del1 del2); intro. + apply (cond_pos del1). + apply (cond_pos del2). Qed. Lemma open_set_P4 : open_set (fun x:R => False). Proof. unfold open_set; intros; elim H. Qed. Lemma open_set_P5 : open_set (fun x:R => True). Proof. unfold open_set; intros; unfold neighbourhood. exists (mkposreal 1 Rlt_0_1); unfold included; intros; trivial. Qed. Lemma disc_P1 : forall (x:R) (del:posreal), open_set (disc x del). Proof. intros; assert (H := open_set_P1 (disc x del)). elim H; intros; apply H1. unfold eq_Dom; split. - unfold included, interior, disc; intros; cut (0 < del - Rabs (x - x0)). + intro; set (del2 := mkposreal _ H3). exists del2; unfold included; intros. apply Rle_lt_trans with (Rabs (x1 - x0) + Rabs (x0 - x)). * replace (x1 - x) with (x1 - x0 + (x0 - x)); [ apply Rabs_triang | ring ]. * replace (pos del) with (del2 + Rabs (x0 - x)). -- do 2 rewrite <- (Rplus_comm (Rabs (x0 - x))); apply Rplus_lt_compat_l. apply H4. -- unfold del2; simpl; rewrite <- (Rabs_Ropp (x - x0)); rewrite Ropp_minus_distr; ring. + apply Rplus_lt_reg_l with (Rabs (x - x0)); rewrite Rplus_0_r; replace (Rabs (x - x0) + (del - Rabs (x - x0))) with (pos del); [ rewrite <- Rabs_Ropp; rewrite Ropp_minus_distr; apply H2 | ring ]. - apply interior_P1. Qed. Lemma continuity_P1 : forall (f:R -> R) (x:R), continuity_pt f x <-> (forall W:R -> Prop, neighbourhood W (f x) -> exists V : R -> Prop, neighbourhood V x /\ (forall y:R, V y -> W (f y))). Proof. intros; split. - intros; unfold neighbourhood in H0. elim H0; intros del1 H1. unfold continuity_pt in H; unfold continue_in in H; unfold limit1_in in H; unfold limit_in in H; simpl in H; unfold Rdist in H. assert (H2 := H del1 (cond_pos del1)). elim H2; intros del2 H3. elim H3; intros. exists (disc x (mkposreal del2 H4)). intros; unfold included in H1; split. + unfold neighbourhood, disc. exists (mkposreal del2 H4). unfold included; intros; assumption. + intros; apply H1; unfold disc; case (Req_dec y x); intro. * rewrite H7; unfold Rminus; rewrite Rplus_opp_r; rewrite Rabs_R0; apply (cond_pos del1). * apply H5; split. -- unfold D_x, no_cond; split. ++ trivial. ++ apply (not_eq_sym (A:=R)); apply H7. -- unfold disc in H6; apply H6. - intros; unfold continuity_pt; unfold continue_in; unfold limit1_in; unfold limit_in; intros. assert (H1 := H (disc (f x) (mkposreal eps H0))). cut (neighbourhood (disc (f x) (mkposreal eps H0)) (f x)). + intro; assert (H3 := H1 H2). elim H3; intros D H4; elim H4; intros; unfold neighbourhood in H5; elim H5; intros del1 H7. exists (pos del1); split. * apply (cond_pos del1). * intros; elim H8; intros; simpl in H10; unfold Rdist in H10; simpl; unfold Rdist; apply (H6 _ (H7 _ H10)). + unfold neighbourhood, disc; exists (mkposreal eps H0); unfold included; intros; assumption. Qed. Definition image_rec (f:R -> R) (D:R -> Prop) (x:R) : Prop := D (f x). (**********) Lemma continuity_P2 : forall (f:R -> R) (D:R -> Prop), continuity f -> open_set D -> open_set (image_rec f D). Proof. intros; unfold open_set in H0; unfold open_set; intros; assert (H2 := continuity_P1 f x); elim H2; intros H3 _; assert (H4 := H3 (H x)); unfold neighbourhood, image_rec; unfold image_rec in H1; assert (H5 := H4 D (H0 (f x) H1)); elim H5; intros V0 H6; elim H6; intros; unfold neighbourhood in H7; elim H7; intros del H9; exists del; unfold included in H9; unfold included; intros; apply (H8 _ (H9 _ H10)). Qed. (**********) Lemma continuity_P3 : forall f:R -> R, continuity f <-> (forall D:R -> Prop, open_set D -> open_set (image_rec f D)). Proof. intros; split. - intros; apply continuity_P2; assumption. - intros; unfold continuity; unfold continuity_pt; unfold continue_in; unfold limit1_in; unfold limit_in; simpl; unfold Rdist; intros; cut (open_set (disc (f x) (mkposreal _ H0))). + intro; assert (H2 := H _ H1). unfold open_set, image_rec in H2; cut (disc (f x) (mkposreal _ H0) (f x)). * intro; assert (H4 := H2 _ H3). unfold neighbourhood in H4; elim H4; intros del H5. exists (pos del); split. -- apply (cond_pos del). -- intros; unfold included in H5; apply H5; elim H6; intros; apply H8. * unfold disc; unfold Rminus; rewrite Rplus_opp_r; rewrite Rabs_R0; apply H0. + apply disc_P1. Qed. (**********) Theorem Rsepare : forall x y:R, x <> y -> exists V : R -> Prop, (exists W : R -> Prop, neighbourhood V x /\ neighbourhood W y /\ ~ (exists y : R, intersection_domain V W y)). Proof. intros x y Hsep; set (D := Rabs (x - y)). cut (0 < D / 2). - intro; exists (disc x (mkposreal _ H)). exists (disc y (mkposreal _ H)); split. + unfold neighbourhood; exists (mkposreal _ H); unfold included; tauto. + split. * unfold neighbourhood; exists (mkposreal _ H); unfold included; tauto. * red; intro; elim H0; intros; unfold intersection_domain in H1; elim H1; intros. cut (D < D). -- intro; elim (Rlt_irrefl _ H4). -- change (Rabs (x - y) < D); apply Rle_lt_trans with (Rabs (x - x0) + Rabs (x0 - y)). ++ replace (x - y) with (x - x0 + (x0 - y)); [ apply Rabs_triang | ring ]. ++ rewrite <-(Rplus_half_diag D); apply Rplus_lt_compat. ** rewrite <- Rabs_Ropp; rewrite Ropp_minus_distr; apply H2. ** apply H3. - unfold Rdiv; apply Rmult_lt_0_compat. + unfold D; apply Rabs_pos_lt; apply (Rminus_eq_contra _ _ Hsep). + apply Rinv_0_lt_compat; prove_sup0. Qed. Record family : Type := mkfamily {ind : R -> Prop; f :> R -> R -> Prop; cond_fam : forall x:R, (exists y : R, f x y) -> ind x}. Definition family_open_set (f:family) : Prop := forall x:R, open_set (f x). Definition domain_finite (D:R -> Prop) : Prop := exists l : list R, (forall x:R, D x <-> In x l). Definition family_finite (f:family) : Prop := domain_finite (ind f). Definition covering (D:R -> Prop) (f:family) : Prop := forall x:R, D x -> exists y : R, f y x. Definition covering_open_set (D:R -> Prop) (f:family) : Prop := covering D f /\ family_open_set f. Definition covering_finite (D:R -> Prop) (f:family) : Prop := covering D f /\ family_finite f. Lemma restriction_family : forall (f:family) (D:R -> Prop) (x:R), (exists y : R, (fun z1 z2:R => f z1 z2 /\ D z1) x y) -> intersection_domain (ind f) D x. Proof. intros; elim H; intros; unfold intersection_domain; elim H0; intros; split. - apply (cond_fam f0); exists x0; assumption. - assumption. Qed. Definition subfamily (f:family) (D:R -> Prop) : family := mkfamily (intersection_domain (ind f) D) (fun x y:R => f x y /\ D x) (restriction_family f D). Definition compact (X:R -> Prop) : Prop := forall f:family, covering_open_set X f -> exists D : R -> Prop, covering_finite X (subfamily f D). (**********) Lemma family_P1 : forall (f:family) (D:R -> Prop), family_open_set f -> family_open_set (subfamily f D). Proof. unfold family_open_set; intros; unfold subfamily; simpl; assert (H0 := classic (D x)). elim H0; intro. - cut (open_set (f0 x) -> open_set (fun y:R => f0 x y /\ D x)). + intro; apply H2; apply H. + unfold open_set; unfold neighbourhood; intros; elim H3; intros; assert (H6 := H2 _ H4); elim H6; intros; exists x1; unfold included; intros; split. * apply (H7 _ H8). * assumption. - cut (open_set (fun y:R => False) -> open_set (fun y:R => f0 x y /\ D x)). + intro; apply H2; apply open_set_P4. + unfold open_set; unfold neighbourhood; intros; elim H3; intros; elim H1; assumption. Qed. Definition bounded (D:R -> Prop) : Prop := exists m : R, (exists M : R, (forall x:R, D x -> m <= x <= M)). Lemma open_set_P6 : forall D1 D2:R -> Prop, open_set D1 -> D1 =_D D2 -> open_set D2. Proof. unfold open_set; unfold neighbourhood; intros. unfold eq_Dom in H0; elim H0; intros. assert (H4 := H _ (H3 _ H1)). elim H4; intros. exists x0; apply included_trans with D1; assumption. Qed. (**********) Lemma compact_P1 : forall X:R -> Prop, compact X -> bounded X. Proof. intros; unfold compact in H; set (D := fun x:R => True); set (g := fun x y:R => Rabs y < x); cut (forall x:R, (exists y : _, g x y) -> True); [ intro | intro; trivial ]. set (f0 := mkfamily D g H0); assert (H1 := H f0); cut (covering_open_set X f0). - intro; assert (H3 := H1 H2); elim H3; intros D' H4; unfold covering_finite in H4; elim H4; intros; unfold family_finite in H6; unfold domain_finite in H6; elim H6; intros l H7; unfold bounded; set (r := MaxRlist l). exists (- r); exists r; intros. unfold covering in H5; assert (H9 := H5 _ H8); elim H9; intros; unfold subfamily in H10; simpl in H10; elim H10; intros; assert (H13 := H7 x0); simpl in H13; cut (intersection_domain D D' x0). + elim H13; clear H13; intros. assert (H16 := H13 H15); unfold g in H11; split. * cut (x0 <= r). -- intro; cut (Rabs x < r). ++ intro; assert (H19 := Rabs_def2 x r H18); elim H19; intros; left; assumption. ++ apply Rlt_le_trans with x0; assumption. -- apply (MaxRlist_P1 l x0 H16). * cut (x0 <= r). -- intro; apply Rle_trans with (Rabs x). ++ apply RRle_abs. ++ apply Rle_trans with x0. ** left; apply H11. ** assumption. -- apply (MaxRlist_P1 l x0 H16). + unfold intersection_domain, D; tauto. - unfold covering_open_set; split. + unfold covering; intros; simpl; exists (Rabs x + 1); unfold g; pattern (Rabs x) at 1; rewrite <- Rplus_0_r; apply Rplus_lt_compat_l; apply Rlt_0_1. + unfold family_open_set; intro; case (Rtotal_order 0 x); intro. * apply open_set_P6 with (disc 0 (mkposreal _ H2)). -- apply disc_P1. -- unfold eq_Dom; unfold f0; simpl; unfold g, disc; split. ++ unfold included; intros; unfold Rminus in H3; rewrite Ropp_0 in H3; rewrite Rplus_0_r in H3; apply H3. ++ unfold included; intros; unfold Rminus; rewrite Ropp_0; rewrite Rplus_0_r; apply H3. * apply open_set_P6 with (fun x:R => False). -- apply open_set_P4. -- unfold eq_Dom; split. ++ unfold included; intros; elim H3. ++ unfold included, f0; simpl; unfold g; intros; elim H2; intro; [ rewrite <- H4 in H3; assert (H5 := Rabs_pos x0); elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H5 H3)) | assert (H6 := Rabs_pos x0); assert (H7 := Rlt_trans _ _ _ H3 H4); elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H6 H7)) ]. Qed. (**********) Lemma compact_P2 : forall X:R -> Prop, compact X -> closed_set X. Proof. intros; assert (H0 := closed_set_P1 X); elim H0; clear H0; intros _ H0; apply H0; clear H0. unfold eq_Dom; split. { apply adherence_P1. } unfold included; unfold adherence; unfold point_adherent; intros; unfold compact in H; assert (H1 := classic (X x)); elim H1; clear H1; intro. { assumption. } cut (forall y:R, X y -> 0 < Rabs (y - x) / 2). 1:intro; set (D := X); set (g := fun y z:R => Rabs (y - z) < Rabs (y - x) / 2 /\ D y); cut (forall x:R, (exists y : _, g x y) -> D x). 1:intro; set (f0 := mkfamily D g H3); assert (H4 := H f0); cut (covering_open_set X f0). 1:intro; assert (H6 := H4 H5); elim H6; clear H6; intros D' H6. 1:unfold covering_finite in H6; decompose [and] H6; unfold covering, subfamily in H7; simpl in H7; unfold family_finite, subfamily in H8; simpl in H8; unfold domain_finite in H8; elim H8; clear H8; intros l H8; set (alp := MinRlist (AbsList l x)); cut (0 < alp). 1:intro; assert (H10 := H0 (disc x (mkposreal _ H9))); cut (neighbourhood (disc x (mkposreal alp H9)) x). 1:intro; assert (H12 := H10 H11); elim H12; clear H12; intros y H12; unfold intersection_domain in H12; elim H12; clear H12; intros; assert (H14 := H7 _ H13); elim H14; clear H14; intros y0 H14; elim H14; clear H14; intros; unfold g in H14; elim H14; clear H14; intros; unfold disc in H12; simpl in H12; cut (alp <= Rabs (y0 - x) / 2). 1:intro; assert (H18 := Rlt_le_trans _ _ _ H12 H17); cut (Rabs (y0 - x) < Rabs (y0 - x)). - intro; elim (Rlt_irrefl _ H19). - apply Rle_lt_trans with (Rabs (y0 - y) + Rabs (y - x)). + replace (y0 - x) with (y0 - y + (y - x)); [ apply Rabs_triang | ring ]. + rewrite <-(Rplus_half_diag (Rabs (y0 - x))); apply Rplus_lt_compat; assumption. - apply (MinRlist_P1 (AbsList l x) (Rabs (y0 - x) / 2)); apply AbsList_P1; elim (H8 y0); clear H8; intros; apply H8; unfold intersection_domain; split; assumption. - assert (H11 := disc_P1 x (mkposreal alp H9)); unfold open_set in H11; apply H11. unfold disc; unfold Rminus; rewrite Rplus_opp_r; rewrite Rabs_R0; apply H9. - unfold alp; apply MinRlist_P2; intros; assert (H10 := AbsList_P2 _ _ _ H9); elim H10; clear H10; intros z H10; elim H10; clear H10; intros; rewrite H11; apply H2; elim (H8 z); clear H8; intros; assert (H13 := H12 H10); unfold intersection_domain, D in H13; elim H13; clear H13; intros; assumption. - unfold covering_open_set; split. + unfold covering; intros; exists x0; simpl; unfold g; split. * unfold Rminus; rewrite Rplus_opp_r; rewrite Rabs_R0; unfold Rminus in H2; apply (H2 _ H5). * apply H5. + unfold family_open_set; intro; simpl; unfold g; elim (classic (D x0)); intro. * apply open_set_P6 with (disc x0 (mkposreal _ (H2 _ H5))). -- apply disc_P1. -- unfold eq_Dom; split. ++ unfold included, disc; simpl; intros; split. ** rewrite <- (Rabs_Ropp (x0 - x1)); rewrite Ropp_minus_distr; apply H6. ** apply H5. ++ unfold included, disc; simpl; intros; elim H6; intros; rewrite <- (Rabs_Ropp (x1 - x0)); rewrite Ropp_minus_distr; apply H7. * apply open_set_P6 with (fun z:R => False). -- apply open_set_P4. -- unfold eq_Dom; split. ++ unfold included; intros; elim H6. ++ unfold included; intros; elim H6; intros; elim H5; assumption. - intros; elim H3; intros; unfold g in H4; elim H4; clear H4; intros _ H4; apply H4. - intros; unfold Rdiv; apply Rmult_lt_0_compat. + apply Rabs_pos_lt; apply Rminus_eq_contra; red; intro; rewrite H3 in H2; elim H1; apply H2. + apply Rinv_0_lt_compat; prove_sup0. Qed. (**********) Lemma compact_EMP : compact (fun _:R => False). Proof. unfold compact; intros; exists (fun x:R => False); unfold covering_finite; split. - unfold covering; intros; elim H0. - unfold family_finite; unfold domain_finite; exists nil; intro. split. + simpl; unfold intersection_domain; intros; elim H0. elim H0; clear H0; intros _ H0; elim H0. + simpl; intro; elim H0. Qed. Lemma compact_eqDom : forall X1 X2:R -> Prop, compact X1 -> X1 =_D X2 -> compact X2. Proof. unfold compact; intros; unfold eq_Dom in H0; elim H0; clear H0; unfold included; intros; assert (H3 : covering_open_set X1 f0). - unfold covering_open_set; unfold covering_open_set in H1; elim H1; clear H1; intros; split. + unfold covering in H1; unfold covering; intros; apply (H1 _ (H0 _ H4)). + apply H3. - elim (H _ H3); intros D H4; exists D; unfold covering_finite; unfold covering_finite in H4; elim H4; intros; split. + unfold covering in H5; unfold covering; intros; apply (H5 _ (H2 _ H7)). + apply H6. Qed. (** Borel-Lebesgue's lemma *) Lemma compact_P3 : forall a b:R, compact (fun c:R => a <= c <= b). Proof. intros a b; destruct (Rle_dec a b) as [Hle|Hnle]. - unfold compact; intros f0 (H,H5); set (A := fun x:R => a <= x <= b /\ (exists D : R -> Prop, covering_finite (fun c:R => a <= c <= x) (subfamily f0 D))). cut (A a); [intro H0|]. 1:cut (bound A); [intro H1|]. 1:cut (exists a0 : R, A a0); [intro H2|]. 1:pose proof (completeness A H1 H2) as (m,H3); unfold is_lub in H3. 1:cut (a <= m <= b); [intro H4|]. 1:unfold covering in H; pose proof (H m H4) as (y0,H6). 1:unfold family_open_set in H5; pose proof (H5 y0 m H6) as (eps,H8). 1:cut (exists x : R, A x /\ m - eps < x <= m); [intros (x,((H9 & Dx & H12 & H13),(Hltx,_)))|]. + destruct (Req_dec m b) as [->|H11]. * set (Db := fun x:R => Dx x \/ x = y0); exists Db; unfold covering_finite; split. -- unfold covering; intros x0 (H14,H18); unfold covering in H12; destruct (Rle_dec x0 x) as [Hle'|Hnle']. ++ cut (a <= x0 <= x); [intro H15|]. ** pose proof (H12 x0 H15) as (x1 & H16 & H17); exists x1; simpl; unfold Db; split; [ apply H16 | left; apply H17 ]. ** split; assumption. ++ exists y0; simpl; split. ** apply H8; unfold disc; rewrite <- Rabs_Ropp, Ropp_minus_distr, Rabs_right. { apply Rlt_trans with (b - x). - unfold Rminus; apply Rplus_lt_compat_l, Ropp_lt_gt_contravar; auto with real. - apply Rplus_lt_reg_l with (x - eps); replace (x - eps + (b - x)) with (b - eps); [ replace (x - eps + eps) with x; [ apply Hltx | ring ] | ring ]. } apply Rge_minus, Rle_ge, H18. ** unfold Db; right; reflexivity. -- unfold family_finite, domain_finite. intros; unfold family_finite in H13; unfold domain_finite in H13; destruct H13 as (l,H13); exists (cons y0 l); intro; split. ++ intro H14; simpl in H14; unfold intersection_domain in H14; specialize H13 with x0; destruct H13 as (H13,H15); destruct (Req_dec x0 y0) as [H16|H16]. ** simpl; left. symmetry; apply H16. ** simpl; right; apply H13. simpl; unfold intersection_domain; unfold Db in H14; decompose [and or] H14. { split; assumption. } elim H16; assumption. ++ intro H14; simpl in H14; destruct H14 as [H15|H15]; simpl; unfold intersection_domain. ** split. { apply (cond_fam f0); rewrite <- H15; exists b; apply H6. } unfold Db; right; symmetry; assumption. ** simpl; unfold intersection_domain; elim (H13 x0). intros _ H16; assert (H17 := H16 H15); simpl in H17; unfold intersection_domain in H17; split. { elim H17; intros; assumption. } unfold Db; left; elim H17; intros; assumption. * set (m' := Rmin (m + eps / 2) b). cut (A m'); [intro H7|]. -- destruct H3 as (H14,H15); unfold is_upper_bound in H14. assert (H16 := H14 m' H7). cut (m < m'); [intro H17|]. ++ elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H16 H17))... ++ unfold m', Rmin; destruct (Rle_dec (m + eps / 2) b) as [Hle'|Hnle']. ** pattern m at 1; rewrite <- Rplus_0_r; apply Rplus_lt_compat_l; unfold Rdiv; apply Rmult_lt_0_compat; [ apply (cond_pos eps) | apply Rinv_0_lt_compat; prove_sup0 ]. ** destruct H4 as (_,[]). { assumption. } elim H11; assumption. -- unfold A; split;[split|]. ++ apply Rle_trans with m. { elim H4; intros; assumption. } unfold m'; unfold Rmin; case (Rle_dec (m + eps / 2) b); intro. { pattern m at 1; rewrite <- Rplus_0_r; apply Rplus_le_compat_l; left; unfold Rdiv; apply Rmult_lt_0_compat; [ apply (cond_pos eps) | apply Rinv_0_lt_compat; prove_sup0 ]. } destruct H4. assumption. ++ unfold m'; apply Rmin_r. ++ set (Db := fun x:R => Dx x \/ x = y0); exists Db; unfold covering_finite; split. ** unfold covering; intros x0 (H14,H18); unfold covering in H12; destruct (Rle_dec x0 x) as [Hle'|Hnle']. { cut (a <= x0 <= x); [intro H15|]. - pose proof (H12 x0 H15) as (x1 & H16 & H17); exists x1; simpl; unfold Db; split; [ apply H16 | left; apply H17 ]. - split; assumption. } exists y0; simpl; split. { apply H8; unfold disc, Rabs; destruct (Rcase_abs (x0 - m)) as [Hlt|Hge]. - rewrite Ropp_minus_distr; apply Rlt_trans with (m - x). + unfold Rminus; apply Rplus_lt_compat_l; apply Ropp_lt_gt_contravar; auto with real. + apply Rplus_lt_reg_l with (x - eps); replace (x - eps + (m - x)) with (m - eps) by ring. replace (x - eps + eps) with x by ring. assumption. - apply Rle_lt_trans with (m' - m). + unfold Rminus; do 2 rewrite <- (Rplus_comm (- m)); apply Rplus_le_compat_l; elim H14; intros; assumption. + apply Rplus_lt_reg_l with m; replace (m + (m' - m)) with m' by ring. apply Rle_lt_trans with (m + eps / 2). { unfold m'; apply Rmin_l. } apply Rplus_lt_compat_l; apply Rmult_lt_reg_l with 2. { prove_sup0. } unfold Rdiv; rewrite <- (Rmult_comm (/ 2)); rewrite <- Rmult_assoc; rewrite Rinv_r. { rewrite Rmult_1_l; pattern (pos eps) at 1; rewrite <- Rplus_0_r; rewrite <-Rplus_diag; apply Rplus_lt_compat_l; apply (cond_pos eps). } discrR. } unfold Db; right; reflexivity. ** { unfold family_finite, domain_finite; unfold family_finite, domain_finite in H13; destruct H13 as (l,H13); exists (cons y0 l); intro; split. - intro H14; simpl in H14; unfold intersection_domain in H14; specialize (H13 x0); destruct H13 as (H13,H15); destruct (Req_dec x0 y0) as [Heq|Hneq]. { simpl; left; symmetry; apply Heq. } simpl; right; apply H13; simpl; unfold intersection_domain; unfold Db in H14; decompose [and or] H14. { split; assumption. } elim Hneq; assumption. - intros [H15|H15]. + split. * apply (cond_fam f0); rewrite <- H15; exists m; apply H6. * unfold Db; right; symmetry; assumption. + elim (H13 x0); intros _ H16. assert (H17 := H16 H15). simpl in H17. unfold intersection_domain in H17. split. * elim H17; intros; assumption. * unfold Db; left; elim H17; intros; assumption. } + elim (classic (exists x : R, A x /\ m - eps < x <= m)); intro H9. { assumption. } elim H3; intros H10 H11; cut (is_upper_bound A (m - eps)). * intro H12; assert (H13 := H11 _ H12); cut (m - eps < m). { intro H14; elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H13 H14)). } pattern m at 2; rewrite <- Rplus_0_r; unfold Rminus; apply Rplus_lt_compat_l; apply Ropp_lt_cancel; rewrite Ropp_involutive; rewrite Ropp_0; apply (cond_pos eps). * set (P := fun n:R => A n /\ m - eps < n <= m); assert (H12 := not_ex_all_not _ P H9); unfold P in H12; unfold is_upper_bound; intros x H13; assert (H14 := not_and_or _ _ (H12 x)); elim H14; intro H15. { elim H15; apply H13. } destruct (not_and_or _ _ H15) as [H16|H16]. -- destruct (Rle_dec x (m - eps)) as [H17|H17]. { assumption. } elim H16; auto with real. -- unfold is_upper_bound in H10; assert (H17 := H10 x H13); elim H16; apply H17. + elim H3; clear H3; intros. unfold is_upper_bound in H3. split. * apply (H3 _ H0). * clear H5. apply (H4 b); unfold is_upper_bound; intros x H5; unfold A in H5; elim H5; clear H5; intros H5 _; elim H5; clear H5; intros _ H5; apply H5. + exists a; apply H0. + unfold bound; exists b; unfold is_upper_bound; intros; unfold A in H1; elim H1; clear H1; intros H1 _; elim H1; clear H1; intros _ H1; apply H1. + unfold A; split. { split; [ right; reflexivity | apply Hle ]. } unfold covering in H; cut (a <= a <= b). * intro H1; elim (H _ H1); intros y0 H2; set (D' := fun x:R => x = y0); exists D'; unfold covering_finite; split. -- unfold covering; simpl; intros x H3; cut (x = a). ++ intro H4; exists y0; split. ** rewrite H4; apply H2. ** unfold D'; reflexivity. ++ elim H3; intros; apply Rle_antisym; assumption. -- unfold family_finite; unfold domain_finite; exists (cons y0 nil); intro; split. ++ simpl; unfold intersection_domain; intros (H3,H4). unfold D' in H4; left; symmetry; apply H4. ++ simpl; unfold intersection_domain; intros [H4|[]]. split; [ rewrite <- H4; apply (cond_fam f0); exists a; apply H2 | symmetry; apply H4 ]. * split; [ right; reflexivity | apply Hle ]. - apply compact_eqDom with (fun c:R => False). + apply compact_EMP. + unfold eq_Dom; split. * unfold included; intros; elim H. * unfold included; intros; elim H; clear H; intros; assert (H1 := Rle_trans _ _ _ H H0); elim Hnle; apply H1. Qed. Lemma compact_P4 : forall X F:R -> Prop, compact X -> closed_set F -> included F X -> compact F. Proof. unfold compact; intros; elim (classic (exists z : R, F z)); intro Hyp_F_NE. - set (D := ind f0); set (g := f f0); unfold closed_set in H0. set (g' := fun x y:R => f0 x y \/ complementary F y /\ D x). set (D' := D). cut (forall x:R, (exists y : R, g' x y) -> D' x). 1:intro; set (f' := mkfamily D' g' H3); cut (covering_open_set X f'). + intro; elim (H _ H4); intros DX H5; exists DX. unfold covering_finite; unfold covering_finite in H5; elim H5; clear H5; intros. split. * unfold covering; unfold covering in H5; intros. elim (H5 _ (H1 _ H7)); intros y0 H8; exists y0; simpl in H8; simpl; elim H8; clear H8; intros. split. -- unfold g' in H8; elim H8; intro. ++ apply H10. ++ elim H10; intros H11 _; unfold complementary in H11; elim H11; apply H7. -- apply H9. * unfold family_finite; unfold domain_finite; unfold family_finite in H6; unfold domain_finite in H6; elim H6; clear H6; intros l H6; exists l; intro; assert (H7 := H6 x); elim H7; clear H7; intros. split. -- intro; apply H7; simpl; unfold intersection_domain; simpl in H9; unfold intersection_domain in H9; unfold D'; apply H9. -- intro; assert (H10 := H8 H9); simpl in H10; unfold intersection_domain in H10; simpl; unfold intersection_domain; unfold D' in H10; apply H10. + unfold covering_open_set; unfold covering_open_set in H2; elim H2; clear H2; intros. split. * unfold covering; unfold covering in H2; intros. elim (classic (F x)); intro. -- elim (H2 _ H6); intros y0 H7; exists y0; simpl; unfold g'; left; assumption. -- cut (exists z : R, D z). ++ intro; elim H7; clear H7; intros x0 H7; exists x0; simpl; unfold g'; right. split. ** unfold complementary; apply H6. ** apply H7. ++ elim Hyp_F_NE; intros z0 H7. assert (H8 := H2 _ H7). elim H8; clear H8; intros t H8; exists t; apply (cond_fam f0); exists z0; apply H8. * unfold family_open_set; intro; simpl; unfold g'; elim (classic (D x)); intro. -- apply open_set_P6 with (union_domain (f0 x) (complementary F)). ++ apply open_set_P2. ** unfold family_open_set in H4; apply H4. ** apply H0. ++ unfold eq_Dom; split. ** unfold included, union_domain, complementary; intros. elim H6; intro; [ left; apply H7 | right; split; assumption ]. ** unfold included, union_domain, complementary; intros. elim H6; intro; [ left; apply H7 | right; elim H7; intros; apply H8 ]. -- apply open_set_P6 with (f0 x). ++ unfold family_open_set in H4; apply H4. ++ unfold eq_Dom; split. ** unfold included, complementary; intros; left; apply H6. ** unfold included, complementary; intros. elim H6; intro. { apply H7. } elim H7; intros _ H8; elim H5; apply H8. + intros; elim H3; intros y0 H4; unfold g' in H4; elim H4; intro. * apply (cond_fam f0); exists y0; apply H5. * elim H5; clear H5; intros _ H5; apply H5. - (* Cas ou F est l'ensemble vide *) cut (compact F). + intro; apply (H3 f0 H2). + apply compact_eqDom with (fun _:R => False). * apply compact_EMP. * unfold eq_Dom; split. -- unfold included; intros; elim H3. -- assert (H3 := not_ex_all_not _ _ Hyp_F_NE); unfold included; intros; elim (H3 x); apply H4. Qed. (**********) Lemma compact_P5 : forall X:R -> Prop, closed_set X -> bounded X -> compact X. Proof. intros; unfold bounded in H0. elim H0; clear H0; intros m H0. elim H0; clear H0; intros M H0. assert (H1 := compact_P3 m M). apply (compact_P4 (fun c:R => m <= c <= M) X H1 H H0). Qed. (**********) Lemma compact_carac : forall X:R -> Prop, compact X <-> closed_set X /\ bounded X. Proof. intro; split. - intro; split; [ apply (compact_P2 _ H) | apply (compact_P1 _ H) ]. - intro; elim H; clear H; intros; apply (compact_P5 _ H H0). Qed. Definition image_dir (f:R -> R) (D:R -> Prop) (x:R) : Prop := exists y : R, x = f y /\ D y. (**********) Lemma continuity_compact : forall (f:R -> R) (X:R -> Prop), (forall x:R, continuity_pt f x) -> compact X -> compact (image_dir f X). Proof. unfold compact; intros; unfold covering_open_set in H1. elim H1; clear H1; intros. set (D := ind f1). set (g := fun x y:R => image_rec f0 (f1 x) y). cut (forall x:R, (exists y : R, g x y) -> D x). 1:intro; set (f' := mkfamily D g H3). 1:cut (covering_open_set X f'). - intro; elim (H0 f' H4); intros D' H5; exists D'. unfold covering_finite in H5; elim H5; clear H5; intros; unfold covering_finite; split. + unfold covering, image_dir; simpl; unfold covering in H5; intros; elim H7; intros y H8; elim H8; intros; assert (H11 := H5 _ H10); simpl in H11; elim H11; intros z H12; exists z; unfold g in H12; unfold image_rec in H12; rewrite H9; apply H12. + unfold family_finite in H6; unfold domain_finite in H6; unfold family_finite; unfold domain_finite; elim H6; intros l H7; exists l; intro; elim (H7 x); intros; split; intro. * apply H8; simpl in H10; simpl; apply H10. * apply (H9 H10). - unfold covering_open_set; split. + unfold covering; intros; simpl; unfold covering in H1; unfold image_dir in H1; unfold g; unfold image_rec; apply H1. exists x; split; [ reflexivity | apply H4 ]. + unfold family_open_set; unfold family_open_set in H2; intro; simpl; unfold g; cut ((fun y:R => image_rec f0 (f1 x) y) = image_rec f0 (f1 x)). * intro; rewrite H4. apply (continuity_P2 f0 (f1 x) H (H2 x)). * reflexivity. - intros; apply (cond_fam f1); unfold g in H3; unfold image_rec in H3; elim H3; intros; exists (f0 x0); apply H4. Qed. Lemma prolongement_C0 : forall (f:R -> R) (a b:R), a <= b -> (forall c:R, a <= c <= b -> continuity_pt f c) -> exists g : R -> R, continuity g /\ (forall c:R, a <= c <= b -> g c = f c). Proof. intros; elim H; intro. - set (h := fun x:R => match Rle_dec x a with | left _ => f0 a | right _ => match Rle_dec x b with | left _ => f0 x | right _ => f0 b end end). assert (H2 : 0 < b - a). { apply Rlt_0_minus; assumption. } exists h; split. + unfold continuity; intro; case (Rtotal_order x a); intro. * unfold continuity_pt; unfold continue_in; unfold limit1_in; unfold limit_in; simpl; unfold Rdist; intros; exists (a - x); split. -- change (0 < a - x); apply Rlt_0_minus; assumption. -- intros; elim H5; clear H5; intros _ H5; unfold h. case (Rle_dec x a) as [|[]]. ++ case (Rle_dec x0 a) as [|[]]. ** unfold Rminus; rewrite Rplus_opp_r, Rabs_R0; assumption. ** left; apply Rplus_lt_reg_l with (- x); do 2 rewrite (Rplus_comm (- x)); apply Rle_lt_trans with (Rabs (x0 - x)). { apply RRle_abs. } assumption. ++ left; assumption. * elim H3; intro. -- assert (H5 : a <= a <= b). { split; [ right; reflexivity | left; assumption ]. } assert (H6 := H0 _ H5); unfold continuity_pt in H6; unfold continue_in in H6; unfold limit1_in in H6; unfold limit_in in H6; simpl in H6; unfold Rdist in H6; unfold continuity_pt; unfold continue_in; unfold limit1_in; unfold limit_in; simpl; unfold Rdist; intros; elim (H6 _ H7); intros; exists (Rmin x0 (b - a)); split. ++ unfold Rmin; case (Rle_dec x0 (b - a)); intro. ** elim H8; intros; assumption. ** change (0 < b - a); apply Rlt_0_minus; assumption. ++ intros; elim H9; clear H9; intros _ H9; cut (x1 < b). ** intro; unfold h; case (Rle_dec x a) as [|[]]. { case (Rle_dec x1 a) as [Hlta|Hnlea]. - unfold Rminus; rewrite Rplus_opp_r; rewrite Rabs_R0; assumption. - case (Rle_dec x1 b) as [Hleb|[]]. + elim H8; intros; apply H12; split. * unfold D_x, no_cond; split. -- trivial. -- red; intro; elim Hnlea; right; symmetry ; assumption. * apply Rlt_le_trans with (Rmin x0 (b - a)). -- rewrite H4 in H9; apply H9. -- apply Rmin_l. + left; assumption. } right; assumption. ** apply Rplus_lt_reg_l with (- a); do 2 rewrite (Rplus_comm (- a)); rewrite H4 in H9; apply Rle_lt_trans with (Rabs (x1 - a)). { apply RRle_abs. } apply Rlt_le_trans with (Rmin x0 (b - a)). { assumption. } apply Rmin_r. -- case (Rtotal_order x b); intro. ++ assert (H6 : a <= x <= b). { split; left; assumption. } assert (H7 := H0 _ H6); unfold continuity_pt in H7; unfold continue_in in H7; unfold limit1_in in H7; unfold limit_in in H7; simpl in H7; unfold Rdist in H7; unfold continuity_pt; unfold continue_in; unfold limit1_in; unfold limit_in; simpl; unfold Rdist; intros; elim (H7 _ H8); intros; elim H9; clear H9; intros. assert (H11 : 0 < x - a). { apply Rlt_0_minus; assumption. } assert (H12 : 0 < b - x). { apply Rlt_0_minus; assumption. } exists (Rmin x0 (Rmin (x - a) (b - x))); split. ** unfold Rmin; case (Rle_dec (x - a) (b - x)) as [Hle|Hnle]. { case (Rle_dec x0 (x - a)) as [Hlea|Hnlea]; assumption. } case (Rle_dec x0 (b - x)) as [Hleb|Hnleb]; assumption. ** intros x1 (H13,H14); cut (a < x1 < b). { intro; elim H15; clear H15; intros; unfold h; case (Rle_dec x a) as [Hle|Hnle]. - elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ Hle H4)). - case (Rle_dec x b) as [|[]]. + case (Rle_dec x1 a) as [Hle0|]. * elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ Hle0 H15)). * case (Rle_dec x1 b) as [|[]]. -- apply H10; split. ++ assumption. ++ apply Rlt_le_trans with (Rmin x0 (Rmin (x - a) (b - x))). ** assumption. ** apply Rmin_l. -- left; assumption. + left; assumption. } split. { apply Ropp_lt_cancel; apply Rplus_lt_reg_l with x; apply Rle_lt_trans with (Rabs (x1 - x)). - rewrite <- Rabs_Ropp; rewrite Ropp_minus_distr; apply RRle_abs. - apply Rlt_le_trans with (Rmin x0 (Rmin (x - a) (b - x))). + assumption. + apply Rle_trans with (Rmin (x - a) (b - x)). * apply Rmin_r. * apply Rmin_l. } apply Rplus_lt_reg_l with (- x); do 2 rewrite (Rplus_comm (- x)); apply Rle_lt_trans with (Rabs (x1 - x)). { apply RRle_abs. } apply Rlt_le_trans with (Rmin x0 (Rmin (x - a) (b - x))). { assumption. } apply Rle_trans with (Rmin (x - a) (b - x)); apply Rmin_r. ++ elim H5; intro. ** assert (H7 : a <= b <= b). { split; [ left; assumption | right; reflexivity ]. } assert (H8 := H0 _ H7); unfold continuity_pt in H8; unfold continue_in in H8; unfold limit1_in in H8; unfold limit_in in H8; simpl in H8; unfold Rdist in H8; unfold continuity_pt; unfold continue_in; unfold limit1_in; unfold limit_in; simpl; unfold Rdist; intros; elim (H8 _ H9); intros; exists (Rmin x0 (b - a)); split. { unfold Rmin; case (Rle_dec x0 (b - a)); intro. - elim H10; intros; assumption. - change (0 < b - a); apply Rlt_0_minus; assumption. } intros; elim H11; clear H11; intros _ H11; cut (a < x1). { intro; unfold h; case (Rle_dec x a) as [Hlea|Hnlea]. - elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ Hlea H4)). - case (Rle_dec x1 a) as [Hlea'|Hnlea']. + elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ Hlea' H12)). + case (Rle_dec x b) as [Hleb|Hnleb]. * case (Rle_dec x1 b) as [Hleb'|Hnleb']. -- rewrite H6; elim H10; intros; destruct Hleb'. ++ apply H14; split. ** unfold D_x, no_cond; split. { trivial. } red; intro; rewrite <- H16 in H15; elim (Rlt_irrefl _ H15). ** rewrite H6 in H11; apply Rlt_le_trans with (Rmin x0 (b - a)). { apply H11. } apply Rmin_l. ++ rewrite H15; unfold Rminus; rewrite Rplus_opp_r; rewrite Rabs_R0; assumption. -- rewrite H6; unfold Rminus; rewrite Rplus_opp_r; rewrite Rabs_R0; assumption. * elim Hnleb; right; assumption. } rewrite H6 in H11; apply Ropp_lt_cancel; apply Rplus_lt_reg_l with b; apply Rle_lt_trans with (Rabs (x1 - b)). { rewrite <- Rabs_Ropp; rewrite Ropp_minus_distr; apply RRle_abs. } apply Rlt_le_trans with (Rmin x0 (b - a)). { assumption. } apply Rmin_r. ** unfold continuity_pt; unfold continue_in; unfold limit1_in; unfold limit_in; simpl; unfold Rdist; intros; exists (x - b); split. { change (0 < x - b); apply Rlt_0_minus; assumption. } intros; elim H8; clear H8; intros. assert (H10 : b < x0). { apply Ropp_lt_cancel; apply Rplus_lt_reg_l with x; apply Rle_lt_trans with (Rabs (x0 - x)). - rewrite <- Rabs_Ropp; rewrite Ropp_minus_distr; apply RRle_abs. - assumption. } unfold h; case (Rle_dec x a) as [Hle|Hnle]. { elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ Hle H4)). } case (Rle_dec x b) as [Hleb|Hnleb]. { elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ Hleb H6)). } case (Rle_dec x0 a) as [Hlea'|Hnlea']. { elim (Rlt_irrefl _ (Rlt_trans _ _ _ H1 (Rlt_le_trans _ _ _ H10 Hlea'))). } case (Rle_dec x0 b) as [Hleb'|Hnleb']. { elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ Hleb' H10)). } unfold Rminus; rewrite Rplus_opp_r; rewrite Rabs_R0; assumption. + intros; elim H3; intros; unfold h; case (Rle_dec c a) as [[|]|]. * elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H4 H6)). * rewrite H6; reflexivity. * case (Rle_dec c b) as [|[]]. -- reflexivity. -- assumption. - exists (fun _:R => f0 a); split. + apply derivable_continuous; apply (derivable_const (f0 a)). + intros; elim H2; intros; rewrite H1 in H3; cut (b = c). * intro; rewrite <- H5; rewrite H1; reflexivity. * apply Rle_antisym; assumption. Qed. (**********) Lemma continuity_ab_maj : forall (f:R -> R) (a b:R), a <= b -> (forall c:R, a <= c <= b -> continuity_pt f c) -> exists Mx : R, (forall c:R, a <= c <= b -> f c <= f Mx) /\ a <= Mx <= b. Proof. intros; cut (exists g : R -> R, continuity g /\ (forall c:R, a <= c <= b -> g c = f0 c)). - intro HypProl. elim HypProl; intros g Hcont_eq. elim Hcont_eq; clear Hcont_eq; intros Hcont Heq. assert (H1 := compact_P3 a b). assert (H2 := continuity_compact g (fun c:R => a <= c <= b) Hcont H1). assert (H3 := compact_P2 _ H2). assert (H4 := compact_P1 _ H2). cut (bound (image_dir g (fun c:R => a <= c <= b))). 1:cut (exists x : R, image_dir g (fun c:R => a <= c <= b) x). + intros; assert (H7 := completeness _ H6 H5). elim H7; clear H7; intros M H7; cut (image_dir g (fun c:R => a <= c <= b) M). * intro; unfold image_dir in H8; elim H8; clear H8; intros Mxx H8; elim H8; clear H8; intros; exists Mxx; split. -- intros; rewrite <- (Heq c H10); rewrite <- (Heq Mxx H9); intros; rewrite <- H8; unfold is_lub in H7; elim H7; clear H7; intros H7 _; unfold is_upper_bound in H7; apply H7; unfold image_dir; exists c; split; [ reflexivity | apply H10 ]. -- apply H9. * elim (classic (image_dir g (fun c:R => a <= c <= b) M)); intro. -- assumption. -- cut (exists eps : posreal, (forall y:R, ~ intersection_domain (disc M eps) (image_dir g (fun c:R => a <= c <= b)) y)). { intro; elim H9; clear H9; intros eps H9; unfold is_lub in H7; elim H7; clear H7; intros; cut (is_upper_bound (image_dir g (fun c:R => a <= c <= b)) (M - eps)). - intro; assert (H12 := H10 _ H11); cut (M - eps < M). + intro; elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H12 H13)). + pattern M at 2; rewrite <- Rplus_0_r; unfold Rminus; apply Rplus_lt_compat_l; apply Ropp_lt_cancel; rewrite Ropp_0; rewrite Ropp_involutive; apply (cond_pos eps). - unfold is_upper_bound, image_dir; intros; cut (x <= M). + intro; destruct (Rle_dec x (M - eps)) as [H13|]. * apply H13. * elim (H9 x); unfold intersection_domain, disc, image_dir; split. -- rewrite <- Rabs_Ropp; rewrite Ropp_minus_distr; rewrite Rabs_right. ++ apply Rplus_lt_reg_l with (x - eps); replace (x - eps + (M - x)) with (M - eps) by ring. replace (x - eps + eps) with x by ring. auto with real. ++ apply Rge_minus; apply Rle_ge; apply H12. -- apply H11. + apply H7; apply H11. } cut (exists V : R -> Prop, neighbourhood V M /\ (forall y:R, ~ intersection_domain V (image_dir g (fun c:R => a <= c <= b)) y)). { intro; elim H9; intros V H10; elim H10; clear H10; intros. unfold neighbourhood in H10; elim H10; intros del H12; exists del; intros; red; intro; elim (H11 y). unfold intersection_domain; unfold intersection_domain in H13; elim H13; clear H13; intros; split. - apply (H12 _ H13). - apply H14. } cut (~ point_adherent (image_dir g (fun c:R => a <= c <= b)) M). { intro; unfold point_adherent in H9. assert (H10 := not_all_ex_not _ (fun V:R -> Prop => neighbourhood V M -> exists y : R, intersection_domain V (image_dir g (fun c:R => a <= c <= b)) y) H9). elim H10; intros V0 H11; exists V0; assert (H12 := imply_to_and _ _ H11); elim H12; clear H12; intros. split. - apply H12. - apply (not_ex_all_not _ _ H13). } red; intro; cut (adherence (image_dir g (fun c:R => a <= c <= b)) M). ++ intro; elim (closed_set_P1 (image_dir g (fun c:R => a <= c <= b))); intros H11 _; assert (H12 := H11 H3). elim H8. unfold eq_Dom in H12; elim H12; clear H12; intros. apply (H13 _ H10). ++ apply H9. + exists (g a); unfold image_dir; exists a; split. * reflexivity. * split; [ right; reflexivity | apply H ]. + unfold bound; unfold bounded in H4; elim H4; clear H4; intros m H4; elim H4; clear H4; intros M H4; exists M; unfold is_upper_bound; intros; elim (H4 _ H5); intros _ H6; apply H6. - apply prolongement_C0; assumption. Qed. (**********) Lemma continuity_ab_min : forall (f:R -> R) (a b:R), a <= b -> (forall c:R, a <= c <= b -> continuity_pt f c) -> exists mx : R, (forall c:R, a <= c <= b -> f mx <= f c) /\ a <= mx <= b. Proof. intros. cut (forall c:R, a <= c <= b -> continuity_pt (- f0) c). - intro; assert (H2 := continuity_ab_maj (- f0)%F a b H H1); elim H2; intros x0 H3; exists x0; intros; split. + intros; rewrite <- (Ropp_involutive (f0 x0)); rewrite <- (Ropp_involutive (f0 c)); apply Ropp_le_contravar; elim H3; intros; unfold opp_fct in H5; apply H5; apply H4. + elim H3; intros; assumption. - intros. assert (H2 := H0 _ H1). apply (continuity_pt_opp _ _ H2). Qed. (********************************************************) (** * Proof of Bolzano-Weierstrass theorem *) (********************************************************) Definition ValAdh (un:nat -> R) (x:R) : Prop := forall (V:R -> Prop) (N:nat), neighbourhood V x -> exists p : nat, (N <= p)%nat /\ V (un p). Definition intersection_family (f:family) (x:R) : Prop := forall y:R, ind f y -> f y x. Lemma ValAdh_un_exists : forall (un:nat -> R) (D:=fun x:R => exists n : nat, x = INR n) (f:= fun x:R => adherence (fun y:R => (exists p : nat, y = un p /\ x <= INR p) /\ D x)) (x:R), (exists y : R, f x y) -> D x. Proof. intros; elim H; intros; unfold f in H0; unfold adherence in H0; unfold point_adherent in H0; assert (H1 : neighbourhood (disc x0 (mkposreal _ Rlt_0_1)) x0). - unfold neighbourhood, disc; exists (mkposreal _ Rlt_0_1); unfold included; trivial. - elim (H0 _ H1); intros; unfold intersection_domain in H2; elim H2; intros; elim H4; intros; apply H6. Qed. Definition ValAdh_un (un:nat -> R) : R -> Prop := let D := fun x:R => exists n : nat, x = INR n in let f := fun x:R => adherence (fun y:R => (exists p : nat, y = un p /\ x <= INR p) /\ D x) in intersection_family (mkfamily D f (ValAdh_un_exists un)). Lemma ValAdh_un_prop : forall (un:nat -> R) (x:R), ValAdh un x <-> ValAdh_un un x. Proof. intros; split; intro. - unfold ValAdh in H; unfold ValAdh_un; unfold intersection_family; simpl; intros; elim H0; intros N H1; unfold adherence; unfold point_adherent; intros; elim (H V N H2); intros; exists (un x0); unfold intersection_domain; elim H3; clear H3; intros; split. + assumption. + split. * exists x0; split; [ reflexivity | rewrite H1; apply (le_INR _ _ H3) ]. * exists N; assumption. - unfold ValAdh; intros; unfold ValAdh_un in H; unfold intersection_family in H; simpl in H; assert (H1 : adherence (fun y0:R => (exists p : nat, y0 = un p /\ INR N <= INR p) /\ (exists n : nat, INR N = INR n)) x). + apply H; exists N; reflexivity. + unfold adherence in H1; unfold point_adherent in H1; assert (H2 := H1 _ H0); elim H2; intros; unfold intersection_domain in H3; elim H3; clear H3; intros; elim H4; clear H4; intros; elim H4; clear H4; intros; elim H4; clear H4; intros; exists x1; split. * apply (INR_le _ _ H6). * rewrite H4 in H3; apply H3. Qed. Lemma adherence_P4 : forall F G:R -> Prop, included F G -> included (adherence F) (adherence G). Proof. unfold adherence, included; unfold point_adherent; intros; elim (H0 _ H1); unfold intersection_domain; intros; elim H2; clear H2; intros; exists x0; split; [ assumption | apply (H _ H3) ]. Qed. Definition family_closed_set (f:family) : Prop := forall x:R, closed_set (f x). Definition intersection_vide_in (D:R -> Prop) (f:family) : Prop := forall x:R, (ind f x -> included (f x) D) /\ ~ (exists y : R, intersection_family f y). Definition intersection_vide_finite_in (D:R -> Prop) (f:family) : Prop := intersection_vide_in D f /\ family_finite f. (**********) Lemma compact_P6 : forall X:R -> Prop, compact X -> (exists z : R, X z) -> forall g:family, family_closed_set g -> intersection_vide_in X g -> exists D : R -> Prop, intersection_vide_finite_in X (subfamily g D). Proof. intros X H Hyp g H0 H1. set (D' := ind g). set (f' := fun x y:R => complementary (g x) y /\ D' x). assert (H2 : forall x:R, (exists y : R, f' x y) -> D' x). { intros; elim H2; intros; unfold f' in H3; elim H3; intros; assumption. } set (f0 := mkfamily D' f' H2). unfold compact in H; assert (H3 : covering_open_set X f0). - unfold covering_open_set; split. + unfold covering; intros; unfold intersection_vide_in in H1; elim (H1 x); intros; unfold intersection_family in H5; assert (H6 := not_ex_all_not _ (fun y:R => forall y0:R, ind g y0 -> g y0 y) H5 x); assert (H7 := not_all_ex_not _ (fun y0:R => ind g y0 -> g y0 x) H6); elim H7; intros; exists x0; elim (imply_to_and _ _ H8); intros; unfold f0; simpl; unfold f'; split; [ apply H10 | apply H9 ]. + unfold family_open_set; intro; elim (classic (D' x)); intro. * apply open_set_P6 with (complementary (g x)). -- unfold family_closed_set in H0; unfold closed_set in H0; apply H0. -- unfold f0; simpl; unfold f'; unfold eq_Dom; split. ++ unfold included; intros; split; [ apply H4 | apply H3 ]. ++ unfold included; intros; elim H4; intros; assumption. * apply open_set_P6 with (fun _:R => False). -- apply open_set_P4. -- unfold eq_Dom; unfold included; split; intros; [ elim H4 | simpl in H4; unfold f' in H4; elim H4; intros; elim H3; assumption ]. - elim (H _ H3); intros SF H4; exists SF; unfold intersection_vide_finite_in; split. + unfold intersection_vide_in; simpl; intros; split. * intros; unfold included; intros; unfold intersection_vide_in in H1; elim (H1 x); intros; elim H6; intros; apply H7. -- unfold intersection_domain in H5; elim H5; intros; assumption. -- assumption. * elim (classic (exists y : R, intersection_domain (ind g) SF y)); intro Hyp'. -- red; intro; elim H5; intros; unfold intersection_family in H6; simpl in H6. cut (X x0). ++ intro; unfold covering_finite in H4; elim H4; clear H4; intros H4 _; unfold covering in H4; elim (H4 x0 H7); intros; simpl in H8; unfold intersection_domain in H6; cut (ind g x1 /\ SF x1). ** intro; assert (H10 := H6 x1 H9); elim H10; clear H10; intros H10 _; elim H8; clear H8; intros H8 _; unfold f' in H8; unfold complementary in H8; elim H8; clear H8; intros H8 _; elim H8; assumption. ** split. { apply (cond_fam f0). exists x0; elim H8; intros; assumption. } elim H8; intros; assumption. ++ unfold intersection_vide_in in H1; elim Hyp'; intros; assert (H8 := H6 _ H7); elim H8; intros; cut (ind g x1). ** intro; elim (H1 x1); intros; apply H12. { apply H11. } apply H9. ** apply (cond_fam g); exists x0; assumption. -- unfold covering_finite in H4; elim H4; clear H4; intros H4 _; cut (exists z : R, X z). ++ intro; elim H5; clear H5; intros; unfold covering in H4; elim (H4 x0 H5); intros; simpl in H6; elim Hyp'; exists x1; elim H6; intros; unfold intersection_domain; split. ** apply (cond_fam f0); exists x0; apply H7. ** apply H8. ++ apply Hyp. + unfold covering_finite in H4; elim H4; clear H4; intros; unfold family_finite in H5; unfold domain_finite in H5; unfold family_finite; unfold domain_finite; elim H5; clear H5; intros l H5; exists l; intro; elim (H5 x); intros; split; intro; [ apply H6; simpl; simpl in H8; apply H8 | apply (H7 H8) ]. Qed. Theorem Bolzano_Weierstrass : forall (un:nat -> R) (X:R -> Prop), compact X -> (forall n:nat, X (un n)) -> exists l : R, ValAdh un l. Proof. intros; cut (exists l : R, ValAdh_un un l). - intro; elim H1; intros; exists x; elim (ValAdh_un_prop un x); intros; apply (H4 H2). - assert (H1 : exists z : R, X z). { exists (un 0%nat); apply H0. } set (D := fun x:R => exists n : nat, x = INR n). set (g := fun x:R => adherence (fun y:R => (exists p : nat, y = un p /\ x <= INR p) /\ D x)). assert (H2 : forall x:R, (exists y : R, g x y) -> D x). { intros; elim H2; intros; unfold g in H3; unfold adherence in H3; unfold point_adherent in H3. assert (H4 : neighbourhood (disc x0 (mkposreal _ Rlt_0_1)) x0). { unfold neighbourhood; exists (mkposreal _ Rlt_0_1); unfold included; trivial. } elim (H3 _ H4); intros; unfold intersection_domain in H5; decompose [and] H5; assumption. } set (f0 := mkfamily D g H2). assert (H3 := compact_P6 X H H1 f0). elim (classic (exists l : R, ValAdh_un un l)); intro. + assumption. + cut (family_closed_set f0). 1:intro; cut (intersection_vide_in X f0). * intro; assert (H7 := H3 H5 H6). elim H7; intros SF H8; unfold intersection_vide_finite_in in H8; elim H8; clear H8; intros; unfold intersection_vide_in in H8; elim (H8 0); intros _ H10; elim H10; unfold family_finite in H9; unfold domain_finite in H9; elim H9; clear H9; intros l H9; set (r := MaxRlist l); cut (D r). -- intro; unfold D in H11; elim H11; intros; exists (un x); unfold intersection_family; simpl; unfold intersection_domain; intros; split. ++ unfold g; apply adherence_P1; split. ** exists x; split; [ reflexivity | rewrite <- H12; unfold r; apply MaxRlist_P1; elim (H9 y); intros; apply H14; simpl; apply H13 ]. ** elim H13; intros; assumption. ++ elim H13; intros; assumption. -- elim (H9 r); intros. simpl in H12; unfold intersection_domain in H12; cut (In r l). ++ intro; elim (H12 H13); intros; assumption. ++ unfold r; apply MaxRlist_P2; cut (exists z : R, intersection_domain (ind f0) SF z). ** intro; elim H13; intros; elim (H9 x); intros; simpl in H15; assert (H17 := H15 H14); exists x; apply H17. ** elim (classic (exists z : R, intersection_domain (ind f0) SF z)); intro. { assumption. } elim (H8 0); intros _ H14; elim H1; intros; assert (H16 := not_ex_all_not _ (fun y:R => intersection_family (subfamily f0 SF) y) H14); assert (H17 := not_ex_all_not _ (fun z:R => intersection_domain (ind f0) SF z) H13); assert (H18 := H16 x); unfold intersection_family in H18; simpl in H18; assert (H19 := not_all_ex_not _ (fun y:R => intersection_domain D SF y -> g y x /\ SF y) H18); elim H19; intros; assert (H21 := imply_to_and _ _ H20); elim (H17 x0); elim H21; intros; assumption. * unfold intersection_vide_in; intros; split. -- intro; simpl in H6; unfold f0; simpl; unfold g; apply included_trans with (adherence X). ++ apply adherence_P4. unfold included; intros; elim H7; intros; elim H8; intros; elim H10; intros; rewrite H11; apply H0. ++ apply adherence_P2; apply compact_P2; assumption. -- apply H4. * unfold family_closed_set; unfold f0; simpl; unfold g; intro; apply adherence_P3. Qed. (********************************************************) (** * Proof of Heine's theorem *) (********************************************************) Definition uniform_continuity (f:R -> R) (X:R -> Prop) : Prop := forall eps:posreal, exists delta : posreal, (forall x y:R, X x -> X y -> Rabs (x - y) < delta -> Rabs (f x - f y) < eps). Lemma is_lub_u : forall (E:R -> Prop) (x y:R), is_lub E x -> is_lub E y -> x = y. Proof. unfold is_lub; intros; elim H; elim H0; intros; apply Rle_antisym; [ apply (H4 _ H1) | apply (H2 _ H3) ]. Qed. Lemma domain_P1 : forall X:R -> Prop, ~ (exists y : R, X y) \/ (exists y : R, X y /\ (forall x:R, X x -> x = y)) \/ (exists x : R, (exists y : R, X x /\ X y /\ x <> y)). Proof. intro; elim (classic (exists y : R, X y)); intro. - right; elim H; intros; elim (classic (exists y : R, X y /\ y <> x)); intro. + right; elim H1; intros; elim H2; intros; exists x; exists x0; intros. split; [ assumption | split; [ assumption | apply (not_eq_sym (A:=R)); assumption ] ]. + left; exists x; split. * assumption. * intros; case (Req_dec x0 x); intro. -- assumption. -- elim H1; exists x0; split; assumption. - left; assumption. Qed. Theorem Heine : forall (f:R -> R) (X:R -> Prop), compact X -> (forall x:R, X x -> continuity_pt f x) -> uniform_continuity f X. Proof. intros f0 X H0 H; elim (domain_P1 X); intro Hyp. - (* X is empty *) unfold uniform_continuity; intros; exists (mkposreal _ Rlt_0_1); intros; elim Hyp; exists x; assumption. - elim Hyp; clear Hyp; intro Hyp. + (* X has only one element *) unfold uniform_continuity; intros; exists (mkposreal _ Rlt_0_1); intros; elim Hyp; clear Hyp; intros; elim H4; clear H4; intros; assert (H6 := H5 _ H1); assert (H7 := H5 _ H2); rewrite H6; rewrite H7; unfold Rminus; rewrite Rplus_opp_r; rewrite Rabs_R0; apply (cond_pos eps). + (* X has at least two distinct elements *) assert (X_enc : exists m : R, (exists M : R, (forall x:R, X x -> m <= x <= M) /\ m < M)). * assert (H1 := compact_P1 X H0); unfold bounded in H1; elim H1; intros; elim H2; intros; exists x; exists x0; split. -- apply H3. -- elim Hyp; intros; elim H4; intros; decompose [and] H5; assert (H10 := H3 _ H6); assert (H11 := H3 _ H8); elim H10; intros; elim H11; intros; destruct (total_order_T x x0) as [[|H15]|H15]. ++ assumption. ++ rewrite H15 in H13, H7; elim H9; apply Rle_antisym; apply Rle_trans with x0; assumption. ++ elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ (Rle_trans _ _ _ H13 H14) H15)). * elim X_enc; clear X_enc; intros m X_enc; elim X_enc; clear X_enc; intros M X_enc; elim X_enc; clear X_enc Hyp; intros X_enc Hyp; unfold uniform_continuity; intro; assert (H1 : forall t:posreal, 0 < t / 2). -- intro; unfold Rdiv; apply Rmult_lt_0_compat; [ apply (cond_pos t) | apply Rinv_0_lt_compat; prove_sup0 ]. -- set (g := fun x y:R => X x /\ (exists del : posreal, (forall z:R, Rabs (z - x) < del -> Rabs (f0 z - f0 x) < eps / 2) /\ is_lub (fun zeta:R => 0 < zeta <= M - m /\ (forall z:R, Rabs (z - x) < zeta -> Rabs (f0 z - f0 x) < eps / 2)) del /\ disc x (mkposreal (del / 2) (H1 del)) y)). assert (H2 : forall x:R, (exists y : R, g x y) -> X x). { intros; elim H2; intros; unfold g in H3; elim H3; clear H3; intros H3 _; apply H3. } set (f' := mkfamily X g H2); unfold compact in H0; assert (H3 : covering_open_set X f'). ++ unfold covering_open_set; split. ** unfold covering; intros; exists x; simpl; unfold g; split. { assumption. } assert (H4 := H _ H3); unfold continuity_pt in H4; unfold continue_in in H4; unfold limit1_in in H4; unfold limit_in in H4; simpl in H4; unfold Rdist in H4; elim (H4 (eps / 2) (H1 eps)); intros; set (E := fun zeta:R => 0 < zeta <= M - m /\ (forall z:R, Rabs (z - x) < zeta -> Rabs (f0 z - f0 x) < eps / 2)); assert (H6 : bound E). { unfold bound; exists (M - m); unfold is_upper_bound; unfold E; intros; elim H6; clear H6; intros H6 _; elim H6; clear H6; intros _ H6; apply H6. } assert (H7 : exists x : R, E x). { elim H5; clear H5; intros; exists (Rmin x0 (M - m)); unfold E; intros; split;[ split|]. - unfold Rmin; case (Rle_dec x0 (M - m)); intro. + apply H5. + apply Rlt_0_minus; apply Hyp. - apply Rmin_r. - intros; case (Req_dec x z); intro. + rewrite H9; unfold Rminus; rewrite Rplus_opp_r; rewrite Rabs_R0; apply (H1 eps). + apply H7; split. * unfold D_x, no_cond; split; [ trivial | assumption ]. * apply Rlt_le_trans with (Rmin x0 (M - m)); [ apply H8 | apply Rmin_l ]. } destruct (completeness _ H6 H7) as (x1,p). { cut (0 < x1 <= M - m). - intros (H8,H9); exists (mkposreal _ H8); split. + intros; cut (exists alp : R, Rabs (z - x) < alp <= x1 /\ E alp). * intros; elim H11; intros; elim H12; clear H12; intros; unfold E in H13; elim H13; intros; apply H15. elim H12; intros; assumption. * elim (classic (exists alp : R, Rabs (z - x) < alp <= x1 /\ E alp)); intro. -- assumption. -- assert (H12 := not_ex_all_not _ (fun alp:R => Rabs (z - x) < alp <= x1 /\ E alp) H11); unfold is_lub in p; elim p; intros; cut (is_upper_bound E (Rabs (z - x))). ++ intro; assert (H16 := H14 _ H15); elim (Rlt_irrefl _ (Rlt_le_trans _ _ _ H10 H16)). ++ unfold is_upper_bound; intros; unfold is_upper_bound in H13; assert (H16 := H13 _ H15); case (Rle_dec x2 (Rabs (z - x))); intro. ** assumption. ** elim (H12 x2); split; [ split; [ auto with real | assumption ] | assumption ]. + split. * apply p. * unfold disc; unfold Rminus; rewrite Rplus_opp_r; rewrite Rabs_R0; simpl; unfold Rdiv; apply Rmult_lt_0_compat; [ apply H8 | apply Rinv_0_lt_compat; prove_sup0 ]. - elim H7; intros; unfold E in H8; elim H8; intros H9 _; elim H9; intros H10 _; unfold is_lub in p; elim p; intros; unfold is_upper_bound in H12; unfold is_upper_bound in H11; split. + apply Rlt_le_trans with x2; [ assumption | apply (H11 _ H8) ]. + apply H12; intros; unfold E in H13; elim H13; intros; elim H14; intros; assumption. } ** { unfold family_open_set; intro; simpl; elim (classic (X x)); intro. - unfold g; unfold open_set; intros; elim H4; clear H4; intros _ H4; elim H4; clear H4; intros; elim H4; clear H4; intros; unfold neighbourhood; case (Req_dec x x0); intro. + exists (mkposreal _ (H1 x1)); rewrite <- H6; unfold included; intros; split. * assumption. * exists x1; split. -- apply H4. -- split. ++ elim H5; intros; apply H8. ++ apply H7. + set (d := x1 / 2 - Rabs (x0 - x)); assert (H7 : 0 < d). * unfold d; apply Rlt_0_minus; elim H5; clear H5; intros; unfold disc in H7; apply H7. * exists (mkposreal _ H7); unfold included; intros; split. { assumption. } exists x1; split. { apply H4. } elim H5; intros; split. { assumption. } unfold disc in H8; simpl in H8; unfold disc; simpl; unfold disc in H10; simpl in H10; apply Rle_lt_trans with (Rabs (x2 - x0) + Rabs (x0 - x)). { replace (x2 - x) with (x2 - x0 + (x0 - x)); [ apply Rabs_triang | ring ]. } replace (x1 / 2) with (d + Rabs (x0 - x)); [ idtac | unfold d; ring ]. do 2 rewrite <- (Rplus_comm (Rabs (x0 - x))); apply Rplus_lt_compat_l; apply H8. - apply open_set_P6 with (fun _:R => False). + apply open_set_P4. + unfold eq_Dom; unfold included; intros; split. * intros; elim H4. * intros; unfold g in H4; elim H4; clear H4; intros H4 _; elim H3; apply H4. } ++ elim (H0 _ H3); intros DF H4; unfold covering_finite in H4; elim H4; clear H4; intros; unfold family_finite in H5; unfold domain_finite in H5; unfold covering in H4; simpl in H4; simpl in H5; elim H5; clear H5; intros l H5; unfold intersection_domain in H5; cut (forall x:R, In x l -> exists del : R, 0 < del /\ (forall z:R, Rabs (z - x) < del -> Rabs (f0 z - f0 x) < eps / 2) /\ included (g x) (fun z:R => Rabs (z - x) < del / 2)). ** { intros; assert (H7 := Rlist_P1 l (fun x del:R => 0 < del /\ (forall z:R, Rabs (z - x) < del -> Rabs (f0 z - f0 x) < eps / 2) /\ included (g x) (fun z:R => Rabs (z - x) < del / 2)) H6); elim H7; clear H7; intros l' H7; elim H7; clear H7; intros; set (D := MinRlist l'); cut (0 < D / 2). - intro; exists (mkposreal _ H9); intros; assert (H13 := H4 _ H10); elim H13; clear H13; intros xi H13; assert (H14 : In xi l). + unfold g in H13; decompose [and] H13; elim (H5 xi); intros; apply H14; split; assumption. + elim (pos_Rl_P2 l xi); intros H15 _; elim (H15 H14); intros i H16; elim H16; intros; apply Rle_lt_trans with (Rabs (f0 x - f0 xi) + Rabs (f0 xi - f0 y)). * replace (f0 x - f0 y) with (f0 x - f0 xi + (f0 xi - f0 y)); [ apply Rabs_triang | ring ]. * rewrite <-(Rplus_half_diag eps); apply Rplus_lt_compat. -- assert (H19 := H8 i H17); elim H19; clear H19; intros; rewrite <- H18 in H20; elim H20; clear H20; intros; apply H20; unfold included in H21; apply Rlt_trans with (pos_Rl l' i / 2). ++ apply H21. elim H13; clear H13; intros; assumption. ++ unfold Rdiv; apply Rmult_lt_reg_l with 2. { prove_sup0. } rewrite Rmult_comm; rewrite Rmult_assoc; rewrite Rinv_l. { rewrite Rmult_1_r; pattern (pos_Rl l' i) at 1; rewrite <- Rplus_0_r; rewrite <-Rplus_diag; apply Rplus_lt_compat_l; apply H19. } discrR. -- assert (H19 := H8 i H17); elim H19; clear H19; intros; rewrite <- H18 in H20; elim H20; clear H20; intros; rewrite <- Rabs_Ropp; rewrite Ropp_minus_distr; apply H20; unfold included in H21; elim H13; intros; assert (H24 := H21 x H22); apply Rle_lt_trans with (Rabs (y - x) + Rabs (x - xi)). ++ replace (y - xi) with (y - x + (x - xi)); [ apply Rabs_triang | ring ]. ++ rewrite <-(Rplus_half_diag (pos_Rl l' i)); apply Rplus_lt_compat. ** apply Rlt_le_trans with (D / 2). { rewrite <- Rabs_Ropp; rewrite Ropp_minus_distr; apply H12. } unfold Rdiv; do 2 rewrite <- (Rmult_comm (/ 2)); apply Rmult_le_compat_l. { left; apply Rinv_0_lt_compat; prove_sup0. } unfold D; apply MinRlist_P1; elim (pos_Rl_P2 l' (pos_Rl l' i)); intros; apply H26; exists i; split; [ rewrite <- H7; assumption | reflexivity ]. ** assumption. - unfold Rdiv; apply Rmult_lt_0_compat; [ unfold D; apply MinRlist_P2; intros; elim (pos_Rl_P2 l' y); intros; elim (H10 H9); intros; elim H12; intros; rewrite H14; rewrite <- H7 in H13; elim (H8 x H13); intros; apply H15 | apply Rinv_0_lt_compat; prove_sup0 ]. } ** { intros; elim (H5 x); intros; elim (H8 H6); intros; set (E := fun zeta:R => 0 < zeta <= M - m /\ (forall z:R, Rabs (z - x) < zeta -> Rabs (f0 z - f0 x) < eps / 2)); assert (H11 : bound E). - unfold bound; exists (M - m); unfold is_upper_bound; unfold E; intros; elim H11; clear H11; intros H11 _; elim H11; clear H11; intros _ H11; apply H11. - assert (H12 : exists x : R, E x). { assert (H13 := H _ H9); unfold continuity_pt in H13; unfold continue_in in H13; unfold limit1_in in H13; unfold limit_in in H13; simpl in H13; unfold Rdist in H13; elim (H13 _ (H1 eps)); intros; elim H12; clear H12; intros; exists (Rmin x0 (M - m)); unfold E; intros; split. - split; [ unfold Rmin; case (Rle_dec x0 (M - m)); intro; [ apply H12 | apply Rlt_0_minus; apply Hyp ] | apply Rmin_r ]. - intros; case (Req_dec x z); intro. + rewrite H16; unfold Rminus; rewrite Rplus_opp_r; rewrite Rabs_R0; apply (H1 eps). + apply H14; split; [ unfold D_x, no_cond; split; [ trivial | assumption ] | apply Rlt_le_trans with (Rmin x0 (M - m)); [ apply H15 | apply Rmin_l ] ]. } destruct (completeness _ H11 H12) as (x0,p). cut (0 < x0 <= M - m). + intro; elim H13; clear H13; intros; exists x0; split. * assumption. * split. -- intros; cut (exists alp : R, Rabs (z - x) < alp <= x0 /\ E alp). ++ intros; elim H16; intros; elim H17; clear H17; intros; unfold E in H18; elim H18; intros; apply H20; elim H17; intros; assumption. ++ elim (classic (exists alp : R, Rabs (z - x) < alp <= x0 /\ E alp)); intro. { assumption. } assert (H17 := not_ex_all_not _ (fun alp:R => Rabs (z - x) < alp <= x0 /\ E alp) H16); unfold is_lub in p; elim p; intros; cut (is_upper_bound E (Rabs (z - x))). ** intro; assert (H21 := H19 _ H20); elim (Rlt_irrefl _ (Rlt_le_trans _ _ _ H15 H21)). ** unfold is_upper_bound; intros; unfold is_upper_bound in H18; assert (H21 := H18 _ H20); case (Rle_dec x1 (Rabs (z - x))); intro. { assumption. } elim (H17 x1); split. { split; [ auto with real | assumption ]. } assumption. -- unfold included, g; intros; elim H15; intros; elim H17; intros; decompose [and] H18; cut (x0 = x2). ++ intro; rewrite H20; apply H22. ++ unfold E in p; eapply is_lub_u. ** apply p. ** apply H21. + elim H12; intros; unfold E in H13; elim H13; intros H14 _; elim H14; intros H15 _; unfold is_lub in p; elim p; intros; unfold is_upper_bound in H16; unfold is_upper_bound in H17; split. * apply Rlt_le_trans with x1; [ assumption | apply (H16 _ H13) ]. * apply H17; intros; unfold E in H18; elim H18; intros; elim H19; intros; assumption. } Qed. coq-8.20.0/theories/Reals/Rtrigo.v000066400000000000000000000021251466560755400167320ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* R -> R, fn = (fun (N:nat) (x:R) => (-1) ^ N / INR (fact (2 * N)) * x ^ (2 * N)) -> CVN_R fn. Proof. unfold CVN_R in |- *; intros. assert (hyp_r:(r:R) <> 0). { assert (H0 := cond_pos r); lra. } unfold CVN_r in |- *. exists (fun n:nat => / INR (fact (2 * n)) * r ^ (2 * n)). cut { l:R | Un_cv (fun n:nat => sum_f_R0 (fun k:nat => Rabs (/ INR (fact (2 * k)) * r ^ (2 * k))) n) l }. { intros (x,p). exists x. split. - apply p. - intros; rewrite H; unfold Rdiv in |- *; do 2 rewrite Rabs_mult. rewrite pow_1_abs; rewrite Rmult_1_l. assert (0 < / INR (fact (2 * n))). { apply Rinv_0_lt_compat; apply INR_fact_lt_0. } rewrite (Rabs_right _ (Rle_ge _ _ (Rlt_le _ _ H1))). apply Rmult_le_compat_l. { left; apply H1. } rewrite <- RPow_abs; apply pow_maj_Rabs. rewrite Rabs_Rabsolu. unfold Boule in H0; rewrite Rminus_0_r in H0. left; apply H0. } apply Alembert_C2. { intro; apply Rabs_no_R0. apply prod_neq_R0. - apply Rinv_neq_0_compat. apply INR_fact_neq_0. - apply pow_nonzero; assumption. } assert (H0 := Alembert_cos). unfold cos_n in H0; unfold Un_cv in H0; unfold Un_cv in |- *; intros. assert (0 < eps / Rsqr r). { unfold Rdiv in |- *; apply Rmult_lt_0_compat. - apply H1. - apply Rinv_0_lt_compat; apply Rsqr_pos_lt; assumption. } elim (H0 _ H2); intros N0 H3. exists N0; intros. unfold Rdist in |- *; assert (H5 := H3 _ H4). unfold Rdist in H5; replace (Rabs (Rabs (/ INR (fact (2 * S n)) * r ^ (2 * S n)) / Rabs (/ INR (fact (2 * n)) * r ^ (2 * n)))) with (Rsqr r * Rabs ((-1) ^ S n / INR (fact (2 * S n)) / ((-1) ^ n / INR (fact (2 * n))))). { apply Rmult_lt_reg_l with (/ Rsqr r). { apply Rinv_0_lt_compat; apply Rsqr_pos_lt; assumption. } pattern (/ Rsqr r) at 1 in |- *; replace (/ Rsqr r) with (Rabs (/ Rsqr r)). 2:{ rewrite Rabs_inv. rewrite Rabs_right. - reflexivity. - apply Rle_ge; apply Rle_0_sqr. } rewrite <- Rabs_mult; rewrite Rmult_minus_distr_l; rewrite Rmult_0_r; rewrite <- Rmult_assoc; rewrite Rinv_l. 2:{ unfold Rsqr in |- *; apply prod_neq_R0; assumption. } rewrite Rmult_1_l; rewrite <- (Rmult_comm eps); apply H5. } rewrite (Rmult_comm (Rsqr r)); unfold Rdiv in |- *; repeat rewrite Rabs_mult; rewrite Rabs_Rabsolu; rewrite pow_1_abs; rewrite Rmult_1_l; repeat rewrite Rmult_assoc; apply Rmult_eq_compat_l. rewrite Rabs_inv. rewrite Rabs_mult; rewrite (pow_1_abs n); rewrite Rmult_1_l; rewrite <- Rabs_inv. rewrite Rinv_inv. rewrite Rinv_mult. rewrite Rabs_inv. rewrite Rinv_inv. rewrite (Rmult_comm (Rabs (Rabs (r ^ (2 * S n))))); rewrite Rabs_mult; rewrite Rabs_Rabsolu; rewrite Rmult_assoc; apply Rmult_eq_compat_l. rewrite Rabs_inv. do 2 rewrite Rabs_Rabsolu; repeat rewrite Rabs_right. 2,3:apply Rle_ge; apply pow_le; left; apply (cond_pos r). replace (r ^ (2 * S n)) with (r ^ (2 * n) * r * r). 2:{ replace (2 * S n)%nat with (S (S (2 * n))) by ring. simpl; ring. } repeat rewrite <- Rmult_assoc; rewrite Rinv_l. 2:{ apply pow_nonzero; assumption. } unfold Rsqr; ring. Qed. (**********) Lemma continuity_cos : continuity cos. Proof. set (fn := fun (N:nat) (x:R) => (-1) ^ N / INR (fact (2 * N)) * x ^ (2 * N)). cut (CVN_R fn). 1:intro; cut (forall x:R, { l:R | Un_cv (fun N:nat => SP fn N x) l }). 1:intro cv; cut (forall n:nat, continuity (fn n)). 1:intro; cut (forall x:R, cos x = SFL fn cv x). 1:intro; cut (continuity (SFL fn cv) -> continuity cos). - intro; apply H1. apply SFL_continuity; assumption. - unfold continuity in |- *; unfold continuity_pt in |- *; unfold continue_in in |- *; unfold limit1_in in |- *; unfold limit_in in |- *; simpl in |- *; unfold Rdist in |- *; intros. elim (H1 x _ H2); intros. exists x0; intros. elim H3; intros. split. + apply H4. + intros; rewrite (H0 x); rewrite (H0 x1); apply H5; apply H6. - intro; unfold cos, SFL in |- *. case (cv x) as (x1,HUn); case (exist_cos (Rsqr x)) as (x0,Hcos); intros. symmetry; eapply UL_sequence. + apply HUn. + unfold cos_in, infinite_sum in Hcos; unfold Un_cv in |- *; intros. elim (Hcos _ H0); intros N0 H1. exists N0; intros. unfold Rdist in H1; unfold Rdist, SP in |- *. replace (sum_f_R0 (fun k:nat => fn k x) n) with (sum_f_R0 (fun i:nat => cos_n i * Rsqr x ^ i) n). * apply H1; assumption. * apply sum_eq; intros. unfold cos_n, fn in |- *; apply Rmult_eq_compat_l. unfold Rsqr in |- *; rewrite pow_sqr; reflexivity. - intro; unfold fn in |- *; replace (fun x:R => (-1) ^ n / INR (fact (2 * n)) * x ^ (2 * n)) with (fct_cte ((-1) ^ n / INR (fact (2 * n))) * pow_fct (2 * n))%F; [ idtac | reflexivity ]. apply continuity_mult. + apply derivable_continuous; apply derivable_const. + apply derivable_continuous; apply (derivable_pow (2 * n)). - apply CVN_R_CVS; apply X. - apply CVN_R_cos; unfold fn in |- *; reflexivity. Qed. Lemma sin_gt_cos_7_8 : sin (7 / 8) > cos (7 / 8). Proof. assert (lo1 : 0 <= 7/8) by lra. assert (up1 : 7/8 <= 4) by lra. assert (lo : -2 <= 7/8) by lra. assert (up : 7/8 <= 2) by lra. destruct (pre_sin_bound _ 0 lo1 up1) as [lower _ ]. destruct (pre_cos_bound _ 0 lo up) as [_ upper]. apply Rle_lt_trans with (1 := upper). apply Rlt_le_trans with (2 := lower). unfold cos_approx, sin_approx. simpl sum_f_R0. unfold cos_term, sin_term; simpl fact; rewrite !INR_IZR_INZ. simpl plus; simpl mult; simpl Z_of_nat. field_simplify. match goal with |- IZR ?a / ?b < ?c / ?d => apply Rmult_lt_reg_r with d;[apply (IZR_lt 0); reflexivity | unfold Rdiv at 2; rewrite Rmult_assoc, Rinv_l, Rmult_1_r, Rmult_comm; [ |apply not_eq_sym, Rlt_not_eq, (IZR_lt 0); reflexivity ]]; apply Rmult_lt_reg_r with b;[apply (IZR_lt 0); reflexivity | ] end. unfold Rdiv; rewrite !Rmult_assoc, Rinv_l, Rmult_1_r; [ | apply not_eq_sym, Rlt_not_eq, (IZR_lt 0); reflexivity]. rewrite <- !mult_IZR. apply IZR_lt; reflexivity. Qed. Definition PI_2_aux : {z | 7/8 <= z <= 7/4 /\ -cos z = 0}. assert (cc : continuity (fun r =>- cos r)). { apply continuity_opp, continuity_cos. } assert (cvp : 0 < cos (7/8)). { assert (int78 : -2 <= 7/8 <= 2) by (split; lra). destruct int78 as [lower upper]. case (pre_cos_bound _ 0 lower upper). unfold cos_approx; simpl sum_f_R0; unfold cos_term. intros cl _; apply Rlt_le_trans with (2 := cl); simpl. lra. } assert (cun : cos (7/4) < 0). { replace (7/4) with (7/8 + 7/8) by field. rewrite cos_plus. apply Rlt_minus; apply Rsqr_incrst_1. - exact sin_gt_cos_7_8. - apply Rlt_le; assumption. - apply Rlt_le; apply Rlt_trans with (1 := cvp); exact sin_gt_cos_7_8. } apply IVT; auto; lra. Qed. Definition PI2 := proj1_sig PI_2_aux. Definition PI := 2 * PI2. Lemma cos_pi2 : cos PI2 = 0. unfold PI2; case PI_2_aux; simpl. intros x [_ q]; rewrite <- (Ropp_involutive (cos x)), q; apply Ropp_0. Qed. Lemma pi2_int : 7/8 <= PI2 <= 7/4. unfold PI2; case PI_2_aux; simpl; tauto. Qed. (**********) Lemma cos_minus : forall x y:R, cos (x - y) = cos x * cos y + sin x * sin y. Proof. intros; unfold Rminus in |- *; rewrite cos_plus. rewrite <- cos_sym; rewrite sin_antisym; ring. Qed. (**********) Lemma sin2_cos2 : forall x:R, Rsqr (sin x) + Rsqr (cos x) = 1. Proof. intro; unfold Rsqr in |- *; rewrite Rplus_comm; rewrite <- (cos_minus x x); unfold Rminus in |- *; rewrite Rplus_opp_r; apply cos_0. Qed. Lemma cos2 : forall x:R, Rsqr (cos x) = 1 - Rsqr (sin x). Proof. intros x; rewrite <- (sin2_cos2 x); ring. Qed. Lemma sin2 : forall x:R, Rsqr (sin x) = 1 - Rsqr (cos x). Proof. intro x; generalize (cos2 x); intro H1; rewrite H1. unfold Rminus in |- *; rewrite Ropp_plus_distr; rewrite <- Rplus_assoc; rewrite Rplus_opp_r; rewrite Rplus_0_l; symmetry in |- *; apply Ropp_involutive. Qed. (**********) Lemma cos_PI2 : cos (PI / 2) = 0. Proof. unfold PI; generalize cos_pi2; replace ((2 * PI2)/2) with PI2 by field; tauto. Qed. Lemma sin_pos_tech : forall x, 0 < x < 2 -> 0 < sin x. intros x [int1 int2]. assert (lo : 0 <= x) by (apply Rlt_le; assumption). assert (up : x <= 4) by (apply Rlt_le, Rlt_trans with (1:=int2); lra). destruct (pre_sin_bound _ 0 lo up) as [t _]; clear lo up. apply Rlt_le_trans with (2:= t); clear t. unfold sin_approx; simpl sum_f_R0; unfold sin_term; simpl. match goal with |- _ < ?a => replace a with (x * (1 - x^2/6)) by (simpl; field) end. assert (t' : x ^ 2 <= 4). { replace 4 with (2 ^ 2) by field. apply (pow_incr x 2); split; apply Rlt_le; assumption. } apply Rmult_lt_0_compat;[assumption | lra ]. Qed. Lemma sin_PI2 : sin (PI / 2) = 1. replace (PI / 2) with PI2 by (unfold PI; field). assert (int' : 0 < PI2 < 2). { destruct pi2_int; split; lra. } assert (lo2 := sin_pos_tech PI2 int'). assert (t2 : Rabs (sin PI2) = 1). { rewrite <- Rabs_R1; apply Rsqr_eq_abs_0. rewrite Rsqr_1, sin2, cos_pi2, Rsqr_0, Rminus_0_r; reflexivity. } revert t2; rewrite Rabs_pos_eq;[| apply Rlt_le]; tauto. Qed. Lemma PI_RGT_0 : PI > 0. Proof. unfold PI; destruct pi2_int; lra. Qed. Lemma PI_4 : PI <= 4. Proof. unfold PI; destruct pi2_int; lra. Qed. (**********) Lemma PI_neq0 : PI <> 0. Proof. red in |- *; intro; assert (H0 := PI_RGT_0); rewrite H in H0; elim (Rlt_irrefl _ H0). Qed. (**********) Lemma cos_PI : cos PI = -1. Proof. replace PI with (PI / 2 + PI / 2). - rewrite cos_plus. rewrite sin_PI2; rewrite cos_PI2. ring. - apply Rplus_half_diag. Qed. Lemma sin_PI : sin PI = 0. Proof. assert (H := sin2_cos2 PI). rewrite cos_PI in H. change (-1) with (-(1)) in H. rewrite <- Rsqr_neg in H. rewrite Rsqr_1 in H. cut (Rsqr (sin PI) = 0). - intro; apply (Rsqr_eq_0 _ H0). - apply Rplus_eq_reg_l with 1. rewrite Rplus_0_r; rewrite Rplus_comm; exact H. Qed. Lemma sin_bound : forall (a : R) (n : nat), 0 <= a -> a <= PI -> sin_approx a (2 * n + 1) <= sin a <= sin_approx a (2 * (n + 1)). Proof. intros a n a0 api; apply pre_sin_bound. - assumption. - apply Rle_trans with (1:= api) (2 := PI_4). Qed. Lemma cos_bound : forall (a : R) (n : nat), - PI / 2 <= a -> a <= PI / 2 -> cos_approx a (2 * n + 1) <= cos a <= cos_approx a (2 * (n + 1)). Proof. intros a n lower upper; apply pre_cos_bound. - apply Rle_trans with (2 := lower). apply Rmult_le_reg_r with 2; [lra |]. replace ((-PI/2) * 2) with (-PI) by field. assert (t := PI_4); lra. - apply Rle_trans with (1 := upper). apply Rmult_le_reg_r with 2; [lra | ]. replace ((PI/2) * 2) with PI by field. generalize PI_4; intros; lra. Qed. (**********) Lemma neg_cos : forall x:R, cos (x + PI) = - cos x. Proof. intro x; rewrite cos_plus; rewrite sin_PI; rewrite cos_PI; ring. Qed. (**********) Lemma sin_cos : forall x:R, sin x = - cos (PI / 2 + x). Proof. intro x; rewrite cos_plus; rewrite sin_PI2; rewrite cos_PI2; ring. Qed. (**********) Lemma sin_plus : forall x y:R, sin (x + y) = sin x * cos y + cos x * sin y. Proof. intros. rewrite (sin_cos (x + y)). replace (PI / 2 + (x + y)) with (PI / 2 + x + y); [ rewrite cos_plus | ring ]. rewrite (sin_cos (PI / 2 + x)). replace (PI / 2 + (PI / 2 + x)) with (x + PI). - rewrite neg_cos. replace (cos (PI / 2 + x)) with (- sin x). + ring. + rewrite sin_cos; rewrite Ropp_involutive; reflexivity. - pattern PI at 1 in |- *; rewrite <-(Rplus_half_diag PI); ring. Qed. Lemma sin_minus : forall x y:R, sin (x - y) = sin x * cos y - cos x * sin y. Proof. intros; unfold Rminus in |- *; rewrite sin_plus. rewrite <- cos_sym; rewrite sin_antisym; ring. Qed. (**********) Definition tan (x:R) : R := sin x / cos x. Lemma tan_plus : forall x y:R, cos x <> 0 -> cos y <> 0 -> cos (x + y) <> 0 -> 1 - tan x * tan y <> 0 -> tan (x + y) = (tan x + tan y) / (1 - tan x * tan y). Proof. intros; unfold tan in |- *; rewrite sin_plus; rewrite cos_plus; unfold Rdiv in |- *; replace (cos x * cos y - sin x * sin y) with (cos x * cos y * (1 - sin x * / cos x * (sin y * / cos y))). - rewrite Rinv_mult. repeat rewrite <- Rmult_assoc; replace ((sin x * cos y + cos x * sin y) * / (cos x * cos y)) with (sin x * / cos x + sin y * / cos y). + reflexivity. + rewrite Rmult_plus_distr_r; rewrite Rinv_mult. repeat rewrite Rmult_assoc; repeat rewrite (Rmult_comm (sin x)); repeat rewrite <- Rmult_assoc. repeat rewrite Rmult_inv_r_id_m; [ reflexivity | assumption | assumption ]. - unfold Rminus in |- *; rewrite Rmult_plus_distr_l; rewrite Rmult_1_r; apply Rplus_eq_compat_l; repeat rewrite Rmult_assoc; rewrite (Rmult_comm (sin x)); rewrite (Rmult_comm (cos y)); rewrite <- Ropp_mult_distr_r_reverse; repeat rewrite <- Rmult_assoc; rewrite Rinv_r. + rewrite Rmult_1_l; rewrite (Rmult_comm (sin x)); rewrite <- Ropp_mult_distr_r_reverse; repeat rewrite Rmult_assoc; apply Rmult_eq_compat_l; rewrite (Rmult_comm (/ cos y)); rewrite Rmult_assoc; rewrite Rinv_r. * apply Rmult_1_r. * assumption. + assumption. Qed. (*******************************************************) (** * Some properties of cos, sin and tan *) (*******************************************************) Lemma sin_2a : forall x:R, sin (2 * x) = 2 * sin x * cos x. Proof. intro x; rewrite <-Rplus_diag; rewrite sin_plus. rewrite <- (Rmult_comm (sin x)); symmetry in |- *; rewrite Rmult_assoc; symmetry; apply Rplus_diag. Qed. Lemma cos_2a : forall x:R, cos (2 * x) = cos x * cos x - sin x * sin x. Proof. intro x; rewrite <-Rplus_diag; apply cos_plus. Qed. Lemma cos_2a_cos : forall x:R, cos (2 * x) = 2 * cos x * cos x - 1. Proof. intro x; rewrite <-Rplus_diag; unfold Rminus in |- *; rewrite Rmult_assoc; rewrite cos_plus; generalize (sin2_cos2 x); rewrite <-Rplus_diag; intro H1; rewrite <- H1; ring_Rsqr. Qed. Lemma cos_2a_sin : forall x:R, cos (2 * x) = 1 - 2 * sin x * sin x. Proof. intro x; rewrite Rmult_assoc; unfold Rminus in |- *; repeat rewrite <-Rplus_diag. generalize (sin2_cos2 x); intro H1; rewrite <- H1; rewrite cos_plus; ring_Rsqr. Qed. Lemma tan_2a : forall x:R, cos x <> 0 -> cos (2 * x) <> 0 -> 1 - tan x * tan x <> 0 -> tan (2 * x) = 2 * tan x / (1 - tan x * tan x). Proof. repeat rewrite <-Rplus_diag; intros; repeat rewrite <-Rplus_diag; rewrite <-Rplus_diag in H0; apply tan_plus; assumption. Qed. Lemma sin_neg : forall x:R, sin (- x) = - sin x. Proof. apply sin_antisym. Qed. Lemma cos_neg : forall x:R, cos (- x) = cos x. Proof. intro; symmetry in |- *; apply cos_sym. Qed. Lemma tan_0 : tan 0 = 0. Proof. unfold tan in |- *; rewrite sin_0; rewrite cos_0. unfold Rdiv in |- *; apply Rmult_0_l. Qed. Lemma tan_neg : forall x:R, tan (- x) = - tan x. Proof. intros x; unfold tan in |- *; rewrite sin_neg; rewrite cos_neg; unfold Rdiv in |- *. apply Ropp_mult_distr_l_reverse. Qed. Lemma tan_minus : forall x y:R, cos x <> 0 -> cos y <> 0 -> cos (x - y) <> 0 -> 1 + tan x * tan y <> 0 -> tan (x - y) = (tan x - tan y) / (1 + tan x * tan y). Proof. intros; unfold Rminus in |- *; rewrite tan_plus. - rewrite tan_neg; unfold Rminus in |- *; rewrite <- Ropp_mult_distr_l_reverse; rewrite Rmult_opp_opp; reflexivity. - assumption. - rewrite cos_neg; assumption. - assumption. - rewrite tan_neg; unfold Rminus in |- *; rewrite <- Ropp_mult_distr_l_reverse; rewrite Rmult_opp_opp; assumption. Qed. Lemma cos_3PI2 : cos (3 * (PI / 2)) = 0. Proof. replace (3 * (PI / 2)) with (PI + PI / 2). - rewrite cos_plus; rewrite sin_PI; rewrite cos_PI2; ring. - pattern PI at 1 in |- *; rewrite <-(Rplus_half_diag PI). ring. Qed. Lemma sin_2PI : sin (2 * PI) = 0. Proof. rewrite sin_2a; rewrite sin_PI; ring. Qed. Lemma cos_2PI : cos (2 * PI) = 1. Proof. rewrite cos_2a; rewrite sin_PI; rewrite cos_PI; ring. Qed. Lemma neg_sin : forall x:R, sin (x + PI) = - sin x. Proof. intro x; rewrite sin_plus; rewrite sin_PI; rewrite cos_PI; ring. Qed. Lemma sin_PI_x : forall x:R, sin (PI - x) = sin x. Proof. intro x; rewrite sin_minus; rewrite sin_PI; rewrite cos_PI. ring. Qed. Lemma sin_period : forall (x:R) (k:nat), sin (x + 2 * INR k * PI) = sin x. Proof. intros x k; induction k as [| k Hreck]. - simpl in |- *; ring_simplify (x + 2 * 0 * PI). trivial. - replace (x + 2 * INR (S k) * PI) with (x + 2 * INR k * PI + 2 * PI). + rewrite sin_plus in |- *; rewrite sin_2PI in |- *; rewrite cos_2PI in |- *. ring_simplify; trivial. + rewrite S_INR in |- *; ring. Qed. Lemma cos_period : forall (x:R) (k:nat), cos (x + 2 * INR k * PI) = cos x. Proof. intros x k; induction k as [| k Hreck]. - simpl in |- *; ring_simplify (x + 2 * 0 * PI). trivial. - replace (x + 2 * INR (S k) * PI) with (x + 2 * INR k * PI + 2 * PI). + rewrite cos_plus in |- *; rewrite sin_2PI in |- *; rewrite cos_2PI in |- *. ring_simplify; trivial. + rewrite S_INR in |- *; ring. Qed. Lemma sin_shift : forall x:R, sin (PI / 2 - x) = cos x. Proof. intro x; rewrite sin_minus; rewrite sin_PI2; rewrite cos_PI2; ring. Qed. Lemma cos_shift : forall x:R, cos (PI / 2 - x) = sin x. Proof. intro x; rewrite cos_minus; rewrite sin_PI2; rewrite cos_PI2; ring. Qed. Lemma cos_sin : forall x:R, cos x = sin (PI / 2 + x). Proof. intro x; rewrite sin_plus; rewrite sin_PI2; rewrite cos_PI2; ring. Qed. Lemma PI2_RGT_0 : 0 < PI / 2. Proof. unfold Rdiv in |- *; apply Rmult_lt_0_compat; [ apply PI_RGT_0 | apply Rinv_0_lt_compat; prove_sup ]. Qed. Lemma SIN_bound : forall x:R, -1 <= sin x <= 1. Proof. intro; destruct (Rle_dec (-1) (sin x)) as [Hle|Hnle]. - destruct (Rle_dec (sin x) 1) as [Hle'|Hnle']. + split; assumption. + cut (1 < sin x). * intro; generalize (Rsqr_incrst_1 1 (sin x) H (Rlt_le 0 1 Rlt_0_1) (Rlt_le 0 (sin x) (Rlt_trans 0 1 (sin x) Rlt_0_1 H))); rewrite Rsqr_1; intro; rewrite sin2 in H0; unfold Rminus in H0. generalize (Rplus_lt_compat_l (-1) 1 (1 + - Rsqr (cos x)) H0); repeat rewrite <- Rplus_assoc; change (-1) with (-(1)); rewrite Rplus_opp_l; rewrite Rplus_0_l; intro; rewrite <- Ropp_0 in H1; generalize (Ropp_lt_gt_contravar (-0) (- Rsqr (cos x)) H1); repeat rewrite Ropp_involutive; intro; generalize (Rle_0_sqr (cos x)); intro; elim (Rlt_irrefl 0 (Rle_lt_trans 0 (Rsqr (cos x)) 0 H3 H2)). * auto with real. - cut (sin x < -1). + intro; generalize (Ropp_lt_gt_contravar (sin x) (-1) H); change (-1) with (-(1)); rewrite Ropp_involutive; clear H; intro; generalize (Rsqr_incrst_1 1 (- sin x) H (Rlt_le 0 1 Rlt_0_1) (Rlt_le 0 (- sin x) (Rlt_trans 0 1 (- sin x) Rlt_0_1 H))); rewrite Rsqr_1; intro; rewrite <- Rsqr_neg in H0; rewrite sin2 in H0; unfold Rminus in H0; generalize (Rplus_lt_compat_l (-1) 1 (1 + - Rsqr (cos x)) H0); rewrite <- Rplus_assoc; change (-1) with (-(1)); rewrite Rplus_opp_l; rewrite Rplus_0_l; intro; rewrite <- Ropp_0 in H1; generalize (Ropp_lt_gt_contravar (-0) (- Rsqr (cos x)) H1); repeat rewrite Ropp_involutive; intro; generalize (Rle_0_sqr (cos x)); intro; elim (Rlt_irrefl 0 (Rle_lt_trans 0 (Rsqr (cos x)) 0 H3 H2)). + auto with real. Qed. Lemma COS_bound : forall x:R, -1 <= cos x <= 1. Proof. intro; rewrite <- sin_shift; apply SIN_bound. Qed. Lemma cos_sin_0 : forall x:R, ~ (cos x = 0 /\ sin x = 0). Proof. intro; red in |- *; intro; elim H; intros; generalize (sin2_cos2 x); intro; rewrite H0 in H2; rewrite H1 in H2; repeat rewrite Rsqr_0 in H2; rewrite Rplus_0_r in H2; generalize Rlt_0_1; intro; rewrite <- H2 in H3; elim (Rlt_irrefl 0 H3). Qed. Lemma cos_sin_0_var : forall x:R, cos x <> 0 \/ sin x <> 0. Proof. intros x. destruct (Req_dec (cos x) 0). 2: now left. right. intros H'. apply (cos_sin_0 x). now split. Qed. (*****************************************************************) (** * Using series definitions of cos and sin *) (*****************************************************************) Definition sin_lb (a:R) : R := sin_approx a 3. Definition sin_ub (a:R) : R := sin_approx a 4. Definition cos_lb (a:R) : R := cos_approx a 3. Definition cos_ub (a:R) : R := cos_approx a 4. Lemma sin_lb_gt_0 : forall a:R, 0 < a -> a <= PI / 2 -> 0 < sin_lb a. Proof. intros. unfold sin_lb in |- *; unfold sin_approx in |- *; unfold sin_term in |- *. set (Un := fun i:nat => a ^ (2 * i + 1) / INR (fact (2 * i + 1))). replace (sum_f_R0 (fun i:nat => (-1) ^ i * (a ^ (2 * i + 1) / INR (fact (2 * i + 1)))) 3) with (sum_f_R0 (fun i:nat => (-1) ^ i * Un i) 3); [ idtac | apply sum_eq; intros; unfold Un in |- *; reflexivity ]. cut (forall n:nat, Un (S n) < Un n). { intro; simpl in |- *. repeat rewrite Rmult_1_l; repeat rewrite Rmult_1_r; replace (-1 * Un 1%nat) with (- Un 1%nat); [ idtac | ring ]; replace (-1 * -1 * Un 2%nat) with (Un 2%nat); [ idtac | ring ]; replace (-1 * (-1 * -1) * Un 3%nat) with (- Un 3%nat); [ idtac | ring ]; replace (Un 0%nat + - Un 1%nat + Un 2%nat + - Un 3%nat) with (Un 0%nat - Un 1%nat + (Un 2%nat - Un 3%nat)); [ idtac | ring ]. apply Rplus_lt_0_compat. - unfold Rminus in |- *; apply Rplus_lt_reg_l with (Un 1%nat); rewrite Rplus_0_r; rewrite (Rplus_comm (Un 1%nat)); rewrite Rplus_assoc; rewrite Rplus_opp_l; rewrite Rplus_0_r; apply H1. - unfold Rminus in |- *; apply Rplus_lt_reg_l with (Un 3%nat); rewrite Rplus_0_r; rewrite (Rplus_comm (Un 3%nat)); rewrite Rplus_assoc; rewrite Rplus_opp_l; rewrite Rplus_0_r; apply H1. } intro; unfold Un in |- *. assert ((2 * S n + 1)%nat = (2 * n + 1 + 2)%nat) by ring. rewrite H1. rewrite pow_add; unfold Rdiv in |- *; rewrite Rmult_assoc; apply Rmult_lt_compat_l. { apply pow_lt; assumption. } rewrite <- H1; apply Rmult_lt_reg_l with (INR (fact (2 * n + 1))). { apply INR_fact_lt_0. } rewrite Rinv_r. 2:{ apply INR_fact_neq_0. } apply Rmult_lt_reg_l with (INR (fact (2 * S n + 1))). { apply INR_fact_lt_0. } rewrite (Rmult_comm (INR (fact (2 * S n + 1)))); repeat rewrite Rmult_assoc; rewrite Rinv_l. 2:{ apply INR_fact_neq_0. } do 2 rewrite Rmult_1_r; apply Rle_lt_trans with (INR (fact (2 * n + 1)) * 4). { apply Rmult_le_compat_l. { apply pos_INR. } simpl in |- *; rewrite Rmult_1_r; change 4 with (Rsqr 2); apply Rsqr_incr_1;[|lra|lra]. apply Rle_trans with (PI / 2); [ assumption | unfold Rdiv in |- *; apply Rmult_le_reg_l with 2; [ prove_sup0 | rewrite <- Rmult_assoc; rewrite Rmult_inv_r_id_m; [ apply PI_4 | discrR ] ] ]. } rewrite H1; replace (2 * n + 1 + 2)%nat with (S (S (2 * n + 1))) by ring. do 2 rewrite fact_simpl; do 2 rewrite mult_INR. repeat rewrite <- Rmult_assoc. rewrite <- (Rmult_comm (INR (fact (2 * n + 1)))). apply Rmult_lt_compat_l. { apply INR_fact_lt_0. } do 2 rewrite S_INR; rewrite plus_INR; rewrite mult_INR; set (x := INR n); unfold INR in |- *. pose proof (pos_INR _ : 0 <= x). nra. Qed. Lemma SIN : forall a:R, 0 <= a -> a <= PI -> sin_lb a <= sin a <= sin_ub a. Proof. intros; unfold sin_lb, sin_ub in |- *; apply (sin_bound a 1 H H0). Qed. Lemma COS : forall a:R, - PI / 2 <= a -> a <= PI / 2 -> cos_lb a <= cos a <= cos_ub a. Proof. intros; unfold cos_lb, cos_ub in |- *; apply (cos_bound a 1 H H0). Qed. (**********) Lemma _PI2_RLT_0 : - (PI / 2) < 0. Proof. assert (H := PI_RGT_0). lra. Qed. Lemma PI4_RLT_PI2 : PI / 4 < PI / 2. Proof. assert (H := PI_RGT_0). lra. Qed. Lemma PI2_Rlt_PI : PI / 2 < PI. Proof. assert (H := PI_RGT_0). lra. Qed. (***************************************************) (** * Increasing and decreasing of [cos] and [sin] *) (***************************************************) Theorem sin_gt_0 : forall x:R, 0 < x -> x < PI -> 0 < sin x. Proof. intros; elim (SIN x (Rlt_le 0 x H) (Rlt_le x PI H0)); intros H1 _; case (Rtotal_order x (PI / 2)); intro H2. - apply Rlt_le_trans with (sin_lb x). + apply sin_lb_gt_0; [ assumption | left; assumption ]. + assumption. - elim H2; intro H3. + rewrite H3; rewrite sin_PI2; apply Rlt_0_1. + rewrite <- sin_PI_x; generalize (Ropp_gt_lt_contravar x (PI / 2) H3); intro H4; generalize (Rplus_lt_compat_l PI (- x) (- (PI / 2)) H4). replace (PI + - (PI / 2)) with (PI / 2) by field. intro H5; generalize (Ropp_lt_gt_contravar x PI H0); intro H6; change (- PI < - x) in H6; generalize (Rplus_lt_compat_l PI (- PI) (- x) H6). rewrite Rplus_opp_r. intro H7; elim (SIN (PI - x) (Rlt_le 0 (PI - x) H7) (Rlt_le (PI - x) PI (Rlt_trans (PI - x) (PI / 2) PI H5 PI2_Rlt_PI))); intros H8 _; generalize (sin_lb_gt_0 (PI - x) H7 (Rlt_le (PI - x) (PI / 2) H5)); intro H9; apply (Rlt_le_trans 0 (sin_lb (PI - x)) (sin (PI - x)) H9 H8). Qed. Theorem cos_gt_0 : forall x:R, - (PI / 2) < x -> x < PI / 2 -> 0 < cos x. Proof. intros; rewrite cos_sin; generalize (Rplus_lt_compat_l (PI / 2) (- (PI / 2)) x H). rewrite Rplus_opp_r; intro H1; generalize (Rplus_lt_compat_l (PI / 2) x (PI / 2) H0); rewrite Rplus_half_diag; intro H2; apply (sin_gt_0 (PI / 2 + x) H1 H2). Qed. Lemma sin_ge_0 : forall x:R, 0 <= x -> x <= PI -> 0 <= sin x. Proof. intros x H1 H2; elim H1; intro H3; [ elim H2; intro H4; [ left; apply (sin_gt_0 x H3 H4) | rewrite H4; right; symmetry in |- *; apply sin_PI ] | rewrite <- H3; right; symmetry in |- *; apply sin_0 ]. Qed. Lemma cos_ge_0 : forall x:R, - (PI / 2) <= x -> x <= PI / 2 -> 0 <= cos x. Proof. intros x H1 H2; elim H1; intro H3; [ elim H2; intro H4; [ left; apply (cos_gt_0 x H3 H4) | rewrite H4; right; symmetry in |- *; apply cos_PI2 ] | rewrite <- H3; rewrite cos_neg; right; symmetry in |- *; apply cos_PI2 ]. Qed. Lemma sin_le_0 : forall x:R, PI <= x -> x <= 2 * PI -> sin x <= 0. Proof. intros x H1 H2; apply Rge_le; rewrite <- Ropp_0; rewrite <- (Ropp_involutive (sin x)); apply Ropp_le_ge_contravar; rewrite <- neg_sin; replace (x + PI) with (x - PI + 2 * INR 1 * PI); [ rewrite (sin_period (x - PI) 1); apply sin_ge_0; [ replace (x - PI) with (x + - PI); [ rewrite Rplus_comm; replace 0 with (- PI + PI); [ apply Rplus_le_compat_l; assumption | ring ] | ring ] | replace (x - PI) with (x + - PI); rewrite Rplus_comm; [ pattern PI at 2 in |- *; replace PI with (- PI + 2 * PI); [ apply Rplus_le_compat_l; assumption | ring ] | ring ] ] | unfold INR in |- *; ring ]. Qed. Lemma cos_le_0 : forall x:R, PI / 2 <= x -> x <= 3 * (PI / 2) -> cos x <= 0. Proof. intros x H1 H2; apply Rge_le; rewrite <- Ropp_0; rewrite <- (Ropp_involutive (cos x)); apply Ropp_le_ge_contravar; rewrite <- neg_cos; replace (x + PI) with (x - PI + 2 * INR 1 * PI). - rewrite cos_period; apply cos_ge_0. + replace (- (PI / 2)) with (- PI + PI / 2) by field. unfold Rminus in |- *; rewrite (Rplus_comm x); apply Rplus_le_compat_l; assumption. + unfold Rminus in |- *; rewrite Rplus_comm; replace (PI / 2) with (- PI + 3 * (PI / 2)) by field. apply Rplus_le_compat_l; assumption. - unfold INR in |- *; ring. Qed. Lemma sin_lt_0 : forall x:R, PI < x -> x < 2 * PI -> sin x < 0. Proof. intros x H1 H2; rewrite <- Ropp_0; rewrite <- (Ropp_involutive (sin x)); apply Ropp_lt_gt_contravar; rewrite <- neg_sin; replace (x + PI) with (x - PI + 2 * INR 1 * PI); [ rewrite (sin_period (x - PI) 1); apply sin_gt_0; [ replace (x - PI) with (x + - PI); [ rewrite Rplus_comm; replace 0 with (- PI + PI); [ apply Rplus_lt_compat_l; assumption | ring ] | ring ] | replace (x - PI) with (x + - PI); rewrite Rplus_comm; [ pattern PI at 2 in |- *; replace PI with (- PI + 2 * PI); [ apply Rplus_lt_compat_l; assumption | ring ] | ring ] ] | unfold INR in |- *; ring ]. Qed. Lemma sin_lt_0_var : forall x:R, - PI < x -> x < 0 -> sin x < 0. Proof. intros; generalize (Rplus_lt_compat_l (2 * PI) (- PI) x H); replace (2 * PI + - PI) with PI; [ intro H1; rewrite Rplus_comm in H1; generalize (Rplus_lt_compat_l (2 * PI) x 0 H0); intro H2; rewrite (Rplus_comm (2 * PI)) in H2; rewrite <- (Rplus_comm 0) in H2; rewrite Rplus_0_l in H2; rewrite <- (sin_period x 1); unfold INR in |- *; replace (2 * 1 * PI) with (2 * PI); [ apply (sin_lt_0 (x + 2 * PI) H1 H2) | ring ] | ring ]. Qed. Lemma cos_lt_0 : forall x:R, PI / 2 < x -> x < 3 * (PI / 2) -> cos x < 0. Proof. intros x H1 H2; rewrite <- Ropp_0; rewrite <- (Ropp_involutive (cos x)); apply Ropp_lt_gt_contravar; rewrite <- neg_cos; replace (x + PI) with (x - PI + 2 * INR 1 * PI). - rewrite cos_period; apply cos_gt_0. + replace (- (PI / 2)) with (- PI + PI / 2) by field. unfold Rminus in |- *; rewrite (Rplus_comm x); apply Rplus_lt_compat_l; assumption. + unfold Rminus in |- *; rewrite Rplus_comm; replace (PI / 2) with (- PI + 3 * (PI / 2)) by field. apply Rplus_lt_compat_l; assumption. - unfold INR in |- *; ring. Qed. Lemma tan_gt_0 : forall x:R, 0 < x -> x < PI / 2 -> 0 < tan x. Proof. intros x H1 H2; unfold tan in |- *; generalize _PI2_RLT_0; generalize (Rlt_trans 0 x (PI / 2) H1 H2); intros; generalize (Rlt_trans (- (PI / 2)) 0 x H0 H1); intro H5; generalize (Rlt_trans x (PI / 2) PI H2 PI2_Rlt_PI); intro H7; unfold Rdiv in |- *; apply Rmult_lt_0_compat. - apply sin_gt_0; assumption. - apply Rinv_0_lt_compat; apply cos_gt_0; assumption. Qed. Lemma tan_lt_0 : forall x:R, - (PI / 2) < x -> x < 0 -> tan x < 0. Proof. intros x H1 H2; unfold tan in |- *; generalize (cos_gt_0 x H1 (Rlt_trans x 0 (PI / 2) H2 PI2_RGT_0)); intro H3; rewrite <- Ropp_0; replace (sin x / cos x) with (- (- sin x / cos x)). - rewrite <- sin_neg; apply Ropp_gt_lt_contravar; change (0 < sin (- x) / cos x) in |- *; unfold Rdiv in |- *; apply Rmult_lt_0_compat. + apply sin_gt_0. * rewrite <- Ropp_0; apply Ropp_gt_lt_contravar; assumption. * apply Rlt_trans with (PI / 2). -- rewrite <- (Ropp_involutive (PI / 2)); apply Ropp_gt_lt_contravar; assumption. -- apply PI2_Rlt_PI. + apply Rinv_0_lt_compat; assumption. - unfold Rdiv in |- *; ring. Qed. Lemma cos_ge_0_3PI2 : forall x:R, 3 * (PI / 2) <= x -> x <= 2 * PI -> 0 <= cos x. Proof. intros; rewrite <- cos_neg; rewrite <- (cos_period (- x) 1); unfold INR in |- *; replace (- x + 2 * 1 * PI) with (2 * PI - x) by ring. generalize (Ropp_le_ge_contravar x (2 * PI) H0); intro H1; generalize (Rge_le (- x) (- (2 * PI)) H1); clear H1; intro H1; generalize (Rplus_le_compat_l (2 * PI) (- (2 * PI)) (- x) H1). rewrite Rplus_opp_r. intro H2; generalize (Ropp_le_ge_contravar (3 * (PI / 2)) x H); intro H3; generalize (Rge_le (- (3 * (PI / 2))) (- x) H3); clear H3; intro H3; generalize (Rplus_le_compat_l (2 * PI) (- x) (- (3 * (PI / 2))) H3). replace (2 * PI + - (3 * (PI / 2))) with (PI / 2) by field. intro H4; apply (cos_ge_0 (2 * PI - x) (Rlt_le (- (PI / 2)) (2 * PI - x) (Rlt_le_trans (- (PI / 2)) 0 (2 * PI - x) _PI2_RLT_0 H2)) H4). Qed. Lemma form1 : forall p q:R, cos p + cos q = 2 * cos ((p - q) / 2) * cos ((p + q) / 2). Proof. intros p q; pattern p at 1 in |- *; replace p with ((p - q) / 2 + (p + q) / 2) by field. rewrite <- (cos_neg q); replace (- q) with ((p - q) / 2 - (p + q) / 2) by field. rewrite cos_plus; rewrite cos_minus; ring. Qed. Lemma form2 : forall p q:R, cos p - cos q = -2 * sin ((p - q) / 2) * sin ((p + q) / 2). Proof. intros p q; pattern p at 1 in |- *; replace p with ((p - q) / 2 + (p + q) / 2) by field. rewrite <- (cos_neg q); replace (- q) with ((p - q) / 2 - (p + q) / 2) by field. rewrite cos_plus; rewrite cos_minus; ring. Qed. Lemma form3 : forall p q:R, sin p + sin q = 2 * cos ((p - q) / 2) * sin ((p + q) / 2). Proof. intros p q; pattern p at 1 in |- *; replace p with ((p - q) / 2 + (p + q) / 2). - pattern q at 3 in |- *; replace q with ((p + q) / 2 - (p - q) / 2). + rewrite sin_plus; rewrite sin_minus; ring. + pattern q at 3 in |- *; rewrite <-Rplus_half_diag; unfold Rdiv in |- *; ring. - pattern p at 3 in |- *; rewrite <-Rplus_half_diag; unfold Rdiv in |- *; ring. Qed. Lemma form4 : forall p q:R, sin p - sin q = 2 * cos ((p + q) / 2) * sin ((p - q) / 2). Proof. intros p q; pattern p at 1 in |- *; replace p with ((p - q) / 2 + (p + q) / 2) by field. pattern q at 3 in |- *; replace q with ((p + q) / 2 - (p - q) / 2) by field. rewrite sin_plus; rewrite sin_minus; ring. Qed. Lemma sin_increasing_0 : forall x y:R, - (PI / 2) <= x -> x <= PI / 2 -> - (PI / 2) <= y -> y <= PI / 2 -> sin x < sin y -> x < y. Proof. intros; cut (sin ((x - y) / 2) < 0). - intro H4; case (Rtotal_order ((x - y) / 2) 0); intro H5. { unfold Rdiv in H5;lra. } elim H5; intro H6. { rewrite H6 in H4; rewrite sin_0 in H4; elim (Rlt_irrefl 0 H4). } change (0 < (x - y) / 2) in H6; generalize (Ropp_le_ge_contravar (- (PI / 2)) y H1). rewrite Ropp_involutive. intro H7; generalize (Rge_le (PI / 2) (- y) H7); clear H7; intro H7; generalize (Rplus_le_compat x (PI / 2) (- y) (PI / 2) H0 H7). rewrite Rplus_half_diag. intro H8. assert (Hyp : 0 < 2) by lra. generalize (Rmult_le_compat_l (/ 2) (x - y) PI (Rlt_le 0 (/ 2) (Rinv_0_lt_compat 2 Hyp)) H8). repeat rewrite (Rmult_comm (/ 2)). intro H9; generalize (sin_gt_0 ((x - y) / 2) H6 (Rle_lt_trans ((x - y) / 2) (PI / 2) PI H9 PI2_Rlt_PI)); intro H10; elim (Rlt_irrefl (sin ((x - y) / 2)) (Rlt_trans (sin ((x - y) / 2)) 0 (sin ((x - y) / 2)) H4 H10)). - generalize (Rlt_minus (sin x) (sin y) H3); clear H3; intro H3; rewrite form4 in H3; generalize (Rplus_le_compat x (PI / 2) y (PI / 2) H0 H2). rewrite Rplus_half_diag. assert (Hyp : 0 < 2) by prove_sup0. intro H4; generalize (Rmult_le_compat_l (/ 2) (x + y) PI (Rlt_le 0 (/ 2) (Rinv_0_lt_compat 2 Hyp)) H4). repeat rewrite (Rmult_comm (/ 2)). clear H4; intro H4; generalize (Rplus_le_compat (- (PI / 2)) x (- (PI / 2)) y H H1); replace (- (PI / 2) + - (PI / 2)) with (- PI) by field. intro H5; generalize (Rmult_le_compat_l (/ 2) (- PI) (x + y) (Rlt_le 0 (/ 2) (Rinv_0_lt_compat 2 Hyp)) H5). replace (/ 2 * (x + y)) with ((x + y) / 2) by apply Rmult_comm. replace (/ 2 * - PI) with (- (PI / 2)) by field. clear H5; intro H5; elim H4; intro H40. 2:{ unfold Rdiv in H3. rewrite H40 in H3; assert (H50 := cos_PI2); unfold Rdiv in H50; rewrite H50 in H3; rewrite Rmult_0_r in H3; rewrite Rmult_0_l in H3; elim (Rlt_irrefl 0 H3). } elim H5; intro H50. 2:{ rewrite <- H50 in H3; rewrite cos_neg in H3; rewrite cos_PI2 in H3; rewrite Rmult_0_r in H3; rewrite Rmult_0_l in H3; elim (Rlt_irrefl 0 H3). } generalize (cos_gt_0 ((x + y) / 2) H50 H40); intro H6; generalize (Rmult_lt_compat_l 2 0 (cos ((x + y) / 2)) Hyp H6). rewrite Rmult_0_r. clear H6; intro H6; case (Rcase_abs (sin ((x - y) / 2))); intro H7. { assumption. } generalize (Rge_le (sin ((x - y) / 2)) 0 H7); clear H7; intro H7; generalize (Rmult_le_pos (2 * cos ((x + y) / 2)) (sin ((x - y) / 2)) (Rlt_le 0 (2 * cos ((x + y) / 2)) H6) H7); intro H8; generalize (Rle_lt_trans 0 (2 * cos ((x + y) / 2) * sin ((x - y) / 2)) 0 H8 H3); intro H9; elim (Rlt_irrefl 0 H9). Qed. Lemma sin_increasing_1 : forall x y:R, - (PI / 2) <= x -> x <= PI / 2 -> - (PI / 2) <= y -> y <= PI / 2 -> x < y -> sin x < sin y. Proof. intros; generalize (Rplus_lt_compat_l x x y H3); intro H4; generalize (Rplus_le_compat (- (PI / 2)) x (- (PI / 2)) x H H); replace (- (PI / 2) + - (PI / 2)) with (- PI) by field. assert (Hyp : 0 < 2) by prove_sup0. intro H5; generalize (Rle_lt_trans (- PI) (x + x) (x + y) H5 H4); intro H6; generalize (Rmult_lt_compat_l (/ 2) (- PI) (x + y) (Rinv_0_lt_compat 2 Hyp) H6); replace (/ 2 * - PI) with (- (PI / 2)) by field. replace (/ 2 * (x + y)) with ((x + y) / 2) by apply Rmult_comm. clear H4 H5 H6; intro H4; generalize (Rplus_lt_compat_l y x y H3); intro H5; rewrite Rplus_comm in H5; generalize (Rplus_le_compat y (PI / 2) y (PI / 2) H2 H2). rewrite Rplus_half_diag. intro H6; generalize (Rlt_le_trans (x + y) (y + y) PI H5 H6); intro H7; generalize (Rmult_lt_compat_l (/ 2) (x + y) PI (Rinv_0_lt_compat 2 Hyp) H7); replace (/ 2 * PI) with (PI / 2) by apply Rmult_comm. replace (/ 2 * (x + y)) with ((x + y) / 2) by apply Rmult_comm. clear H5 H6 H7; intro H5; generalize (Ropp_le_ge_contravar (- (PI / 2)) y H1); rewrite Ropp_involutive; clear H1; intro H1; generalize (Rge_le (PI / 2) (- y) H1); clear H1; intro H1; generalize (Ropp_le_ge_contravar y (PI / 2) H2); clear H2; intro H2; generalize (Rge_le (- y) (- (PI / 2)) H2); clear H2; intro H2; generalize (Rplus_lt_compat_l (- y) x y H3); replace (- y + x) with (x - y) by apply Rplus_comm. rewrite Rplus_opp_l. intro H6; generalize (Rmult_lt_compat_l (/ 2) (x - y) 0 (Rinv_0_lt_compat 2 Hyp) H6); rewrite Rmult_0_r; replace (/ 2 * (x - y)) with ((x - y) / 2) by apply Rmult_comm. clear H6; intro H6; generalize (Rplus_le_compat (- (PI / 2)) x (- (PI / 2)) (- y) H H2); replace (- (PI / 2) + - (PI / 2)) with (- PI) by field. intro H7; generalize (Rmult_le_compat_l (/ 2) (- PI) (x - y) (Rlt_le 0 (/ 2) (Rinv_0_lt_compat 2 Hyp)) H7); replace (/ 2 * - PI) with (- (PI / 2)) by field. replace (/ 2 * (x - y)) with ((x - y) / 2) by apply Rmult_comm. clear H7; intro H7; clear H H0 H1 H2; apply Rminus_lt; rewrite form4; generalize (cos_gt_0 ((x + y) / 2) H4 H5); intro H8; generalize (Rmult_lt_0_compat 2 (cos ((x + y) / 2)) Hyp H8); clear H8; intro H8; cut (- PI < - (PI / 2)). - intro H9; generalize (sin_lt_0_var ((x - y) / 2) (Rlt_le_trans (- PI) (- (PI / 2)) ((x - y) / 2) H9 H7) H6); intro H10; generalize (Rmult_lt_gt_compat_neg_l (sin ((x - y) / 2)) 0 ( 2 * cos ((x + y) / 2)) H10 H8); intro H11; rewrite Rmult_0_r in H11; rewrite Rmult_comm; assumption. - apply Ropp_lt_gt_contravar; apply PI2_Rlt_PI. Qed. Lemma sin_decreasing_0 : forall x y:R, x <= 3 * (PI / 2) -> PI / 2 <= x -> y <= 3 * (PI / 2) -> PI / 2 <= y -> sin x < sin y -> y < x. Proof. intros; rewrite <- (sin_PI_x x) in H3; rewrite <- (sin_PI_x y) in H3; generalize (Ropp_lt_gt_contravar (sin (PI - x)) (sin (PI - y)) H3); repeat rewrite <- sin_neg; generalize (Rplus_le_compat_l (- PI) x (3 * (PI / 2)) H); generalize (Rplus_le_compat_l (- PI) (PI / 2) x H0); generalize (Rplus_le_compat_l (- PI) y (3 * (PI / 2)) H1); generalize (Rplus_le_compat_l (- PI) (PI / 2) y H2); replace (- PI + x) with (x - PI) by apply Rplus_comm. replace (- PI + PI / 2) with (- (PI / 2)) by field. replace (- PI + y) with (y - PI) by apply Rplus_comm. replace (- PI + 3 * (PI / 2)) with (PI / 2) by field. replace (- (PI - x)) with (x - PI) by ring. replace (- (PI - y)) with (y - PI) by ring. intros; change (sin (y - PI) < sin (x - PI)) in H8; apply Rplus_lt_reg_l with (- PI); rewrite Rplus_comm. rewrite (Rplus_comm _ x). apply (sin_increasing_0 (y - PI) (x - PI) H4 H5 H6 H7 H8). Qed. Lemma sin_decreasing_1 : forall x y:R, x <= 3 * (PI / 2) -> PI / 2 <= x -> y <= 3 * (PI / 2) -> PI / 2 <= y -> x < y -> sin y < sin x. Proof. intros; rewrite <- (sin_PI_x x); rewrite <- (sin_PI_x y); generalize (Rplus_le_compat_l (- PI) x (3 * (PI / 2)) H); generalize (Rplus_le_compat_l (- PI) (PI / 2) x H0); generalize (Rplus_le_compat_l (- PI) y (3 * (PI / 2)) H1); generalize (Rplus_le_compat_l (- PI) (PI / 2) y H2); generalize (Rplus_lt_compat_l (- PI) x y H3); replace (- PI + PI / 2) with (- (PI / 2)) by field. replace (- PI + y) with (y - PI) by apply Rplus_comm. replace (- PI + 3 * (PI / 2)) with (PI / 2) by field. replace (- PI + x) with (x - PI) by apply Rplus_comm. intros; apply Ropp_lt_cancel; repeat rewrite <- sin_neg; replace (- (PI - x)) with (x - PI) by ring. replace (- (PI - y)) with (y - PI) by ring. apply (sin_increasing_1 (x - PI) (y - PI) H7 H8 H5 H6 H4). Qed. Lemma sin_inj x y : -(PI/2) <= x <= PI/2 -> -(PI/2) <= y <= PI/2 -> sin x = sin y -> x = y. Proof. intros xP yP Hsin. destruct (total_order_T x y) as [[H|H]|H]; auto. - assert (sin x < sin y). + now apply sin_increasing_1; lra. + now lra. - assert (sin y < sin x). + now apply sin_increasing_1; lra. + now lra. Qed. Lemma cos_increasing_0 : forall x y:R, PI <= x -> x <= 2 * PI -> PI <= y -> y <= 2 * PI -> cos x < cos y -> x < y. Proof. intros x y H1 H2 H3 H4; rewrite <- (cos_neg x); rewrite <- (cos_neg y); rewrite <- (cos_period (- x) 1); rewrite <- (cos_period (- y) 1); unfold INR in |- *; replace (- x + 2 * 1 * PI) with (PI / 2 - (x - 3 * (PI / 2))) by field. replace (- y + 2 * 1 * PI) with (PI / 2 - (y - 3 * (PI / 2))) by field. repeat rewrite cos_shift; intro H5; generalize (Rplus_le_compat_l (-3 * (PI / 2)) PI x H1); generalize (Rplus_le_compat_l (-3 * (PI / 2)) x (2 * PI) H2); generalize (Rplus_le_compat_l (-3 * (PI / 2)) PI y H3); generalize (Rplus_le_compat_l (-3 * (PI / 2)) y (2 * PI) H4). replace (-3 * (PI / 2) + y) with (y - 3 * (PI / 2)) by ring. replace (-3 * (PI / 2) + x) with (x - 3 * (PI / 2)) by ring. replace (-3 * (PI / 2) + 2 * PI) with (PI / 2) by field. replace (-3 * (PI / 2) + PI) with (- (PI / 2)) by field. clear H1 H2 H3 H4; intros H1 H2 H3 H4; apply Rplus_lt_reg_l with (-3 * (PI / 2)); replace (-3 * (PI / 2) + x) with (x - 3 * (PI / 2)) by ring. replace (-3 * (PI / 2) + y) with (y - 3 * (PI / 2)) by ring. apply (sin_increasing_0 (x - 3 * (PI / 2)) (y - 3 * (PI / 2)) H4 H3 H2 H1 H5). Qed. Lemma cos_increasing_1 : forall x y:R, PI <= x -> x <= 2 * PI -> PI <= y -> y <= 2 * PI -> x < y -> cos x < cos y. Proof. intros x y H1 H2 H3 H4 H5; generalize (Rplus_le_compat_l (-3 * (PI / 2)) PI x H1); generalize (Rplus_le_compat_l (-3 * (PI / 2)) x (2 * PI) H2); generalize (Rplus_le_compat_l (-3 * (PI / 2)) PI y H3); generalize (Rplus_le_compat_l (-3 * (PI / 2)) y (2 * PI) H4); generalize (Rplus_lt_compat_l (-3 * (PI / 2)) x y H5); rewrite <- (cos_neg x); rewrite <- (cos_neg y); rewrite <- (cos_period (- x) 1); rewrite <- (cos_period (- y) 1); unfold INR in |- *; replace (-3 * (PI / 2) + x) with (x - 3 * (PI / 2)) by ring. replace (-3 * (PI / 2) + y) with (y - 3 * (PI / 2)) by ring. replace (-3 * (PI / 2) + PI) with (- (PI / 2)) by field. replace (-3 * (PI / 2) + 2 * PI) with (PI / 2) by field. clear H1 H2 H3 H4 H5; intros H1 H2 H3 H4 H5; replace (- x + 2 * 1 * PI) with (PI / 2 - (x - 3 * (PI / 2))) by field. replace (- y + 2 * 1 * PI) with (PI / 2 - (y - 3 * (PI / 2))) by field. repeat rewrite cos_shift; apply (sin_increasing_1 (x - 3 * (PI / 2)) (y - 3 * (PI / 2)) H5 H4 H3 H2 H1). Qed. Lemma cos_decreasing_0 : forall x y:R, 0 <= x -> x <= PI -> 0 <= y -> y <= PI -> cos x < cos y -> y < x. Proof. intros; generalize (Ropp_lt_gt_contravar (cos x) (cos y) H3); repeat rewrite <- neg_cos; intro H4; change (cos (y + PI) < cos (x + PI)) in H4; rewrite (Rplus_comm x) in H4; rewrite (Rplus_comm y) in H4; generalize (Rplus_le_compat_l PI 0 x H); generalize (Rplus_le_compat_l PI x PI H0); generalize (Rplus_le_compat_l PI 0 y H1); generalize (Rplus_le_compat_l PI y PI H2); rewrite Rplus_0_r. rewrite Rplus_diag. clear H H0 H1 H2 H3; intros; apply Rplus_lt_reg_l with PI; apply (cos_increasing_0 (PI + y) (PI + x) H0 H H2 H1 H4). Qed. Lemma cos_decreasing_1 : forall x y:R, 0 <= x -> x <= PI -> 0 <= y -> y <= PI -> x < y -> cos y < cos x. Proof. intros; apply Ropp_lt_cancel; repeat rewrite <- neg_cos; rewrite (Rplus_comm x); rewrite (Rplus_comm y); generalize (Rplus_le_compat_l PI 0 x H); generalize (Rplus_le_compat_l PI x PI H0); generalize (Rplus_le_compat_l PI 0 y H1); generalize (Rplus_le_compat_l PI y PI H2); rewrite Rplus_0_r. rewrite Rplus_diag. generalize (Rplus_lt_compat_l PI x y H3); clear H H0 H1 H2 H3; intros; apply (cos_increasing_1 (PI + x) (PI + y) H3 H2 H1 H0 H). Qed. Lemma cos_inj x y : 0 <= x <= PI -> 0 <= y <= PI -> cos x = cos y -> x = y. Proof. intros xP yP Hcos. destruct (total_order_T x y) as [[H|H]|H]; auto. - assert (cos y < cos x). + now apply cos_decreasing_1; lra. + now lra. - assert (cos x < cos y). + now apply cos_decreasing_1; lra. + now lra. Qed. Lemma tan_diff : forall x y:R, cos x <> 0 -> cos y <> 0 -> tan x - tan y = sin (x - y) / (cos x * cos y). Proof. intros; unfold tan in |- *; rewrite sin_minus. field. now split. Qed. Lemma tan_increasing_0 : forall x y:R, - (PI / 4) <= x -> x <= PI / 4 -> - (PI / 4) <= y -> y <= PI / 4 -> tan x < tan y -> x < y. Proof. intros; generalize PI4_RLT_PI2; intro H4; generalize (Ropp_lt_gt_contravar (PI / 4) (PI / 2) H4); intro H5; change (- (PI / 2) < - (PI / 4)) in H5; generalize (cos_gt_0 x (Rlt_le_trans (- (PI / 2)) (- (PI / 4)) x H5 H) (Rle_lt_trans x (PI / 4) (PI / 2) H0 H4)); intro HP1; generalize (cos_gt_0 y (Rlt_le_trans (- (PI / 2)) (- (PI / 4)) y H5 H1) (Rle_lt_trans y (PI / 4) (PI / 2) H2 H4)); intro HP2; generalize (not_eq_sym (Rlt_not_eq 0 (cos x) (cos_gt_0 x (Rlt_le_trans (- (PI / 2)) (- (PI / 4)) x H5 H) (Rle_lt_trans x (PI / 4) (PI / 2) H0 H4)))); intro H6; generalize (not_eq_sym (Rlt_not_eq 0 (cos y) (cos_gt_0 y (Rlt_le_trans (- (PI / 2)) (- (PI / 4)) y H5 H1) (Rle_lt_trans y (PI / 4) (PI / 2) H2 H4)))); intro H7; generalize (tan_diff x y H6 H7); intro H8; generalize (Rlt_minus (tan x) (tan y) H3); clear H3; intro H3; rewrite H8 in H3; cut (sin (x - y) < 0). - intro H9; generalize (Ropp_le_ge_contravar (- (PI / 4)) y H1); rewrite Ropp_involutive; intro H10; generalize (Rge_le (PI / 4) (- y) H10); clear H10; intro H10; generalize (Ropp_le_ge_contravar y (PI / 4) H2); intro H11; generalize (Rge_le (- y) (- (PI / 4)) H11); clear H11; intro H11; generalize (Rplus_le_compat (- (PI / 4)) x (- (PI / 4)) (- y) H H11); generalize (Rplus_le_compat x (PI / 4) (- y) (PI / 4) H0 H10). replace (PI / 4 + PI / 4) with (PI / 2) by field. replace (- (PI / 4) + - (PI / 4)) with (- (PI / 2)) by field. intros; case (Rtotal_order 0 (x - y)); intro H14. + generalize (sin_gt_0 (x - y) H14 (Rle_lt_trans (x - y) (PI / 2) PI H12 PI2_Rlt_PI)); intro H15; elim (Rlt_irrefl 0 (Rlt_trans 0 (sin (x - y)) 0 H15 H9)). + elim H14; intro H15. * rewrite <- H15 in H9; rewrite sin_0 in H9; elim (Rlt_irrefl 0 H9). * apply Rminus_lt; assumption. - case (Rcase_abs (sin (x - y))); intro H9. + assumption. + generalize (Rge_le (sin (x - y)) 0 H9); clear H9; intro H9; generalize (Rinv_0_lt_compat (cos x) HP1); intro H10; generalize (Rinv_0_lt_compat (cos y) HP2); intro H11; generalize (Rmult_lt_0_compat (/ cos x) (/ cos y) H10 H11); replace (/ cos x * / cos y) with (/ (cos x * cos y)). * intro H12; generalize (Rmult_le_pos (sin (x - y)) (/ (cos x * cos y)) H9 (Rlt_le 0 (/ (cos x * cos y)) H12)); intro H13; elim (Rlt_irrefl 0 (Rle_lt_trans 0 (sin (x - y) * / (cos x * cos y)) 0 H13 H3)). * apply Rinv_mult. Qed. Lemma tan_increasing_1 : forall x y:R, - (PI / 4) <= x -> x <= PI / 4 -> - (PI / 4) <= y -> y <= PI / 4 -> x < y -> tan x < tan y. Proof. intros; apply Rminus_lt; generalize PI4_RLT_PI2; intro H4; generalize (Ropp_lt_gt_contravar (PI / 4) (PI / 2) H4); intro H5; change (- (PI / 2) < - (PI / 4)) in H5; generalize (cos_gt_0 x (Rlt_le_trans (- (PI / 2)) (- (PI / 4)) x H5 H) (Rle_lt_trans x (PI / 4) (PI / 2) H0 H4)); intro HP1; generalize (cos_gt_0 y (Rlt_le_trans (- (PI / 2)) (- (PI / 4)) y H5 H1) (Rle_lt_trans y (PI / 4) (PI / 2) H2 H4)); intro HP2; generalize (not_eq_sym (Rlt_not_eq 0 (cos x) (cos_gt_0 x (Rlt_le_trans (- (PI / 2)) (- (PI / 4)) x H5 H) (Rle_lt_trans x (PI / 4) (PI / 2) H0 H4)))); intro H6; generalize (not_eq_sym (Rlt_not_eq 0 (cos y) (cos_gt_0 y (Rlt_le_trans (- (PI / 2)) (- (PI / 4)) y H5 H1) (Rle_lt_trans y (PI / 4) (PI / 2) H2 H4)))); intro H7; rewrite (tan_diff x y H6 H7); generalize (Rinv_0_lt_compat (cos x) HP1); intro H10; generalize (Rinv_0_lt_compat (cos y) HP2); intro H11; generalize (Rmult_lt_0_compat (/ cos x) (/ cos y) H10 H11); replace (/ cos x * / cos y) with (/ (cos x * cos y)). - clear H10 H11; intro H8; generalize (Ropp_le_ge_contravar y (PI / 4) H2); intro H11; generalize (Rge_le (- y) (- (PI / 4)) H11); clear H11; intro H11; generalize (Rplus_le_compat (- (PI / 4)) x (- (PI / 4)) (- y) H H11). replace (- (PI / 4) + - (PI / 4)) with (- (PI / 2)) by field. clear H11; intro H9; generalize (Rlt_minus x y H3); clear H3; intro H3; clear H H0 H1 H2 H4 H5 HP1 HP2; generalize PI2_Rlt_PI; intro H1; generalize (Ropp_lt_gt_contravar (PI / 2) PI H1); clear H1; intro H1; generalize (sin_lt_0_var (x - y) (Rlt_le_trans (- PI) (- (PI / 2)) (x - y) H1 H9) H3); intro H2; generalize (Rmult_lt_gt_compat_neg_l (sin (x - y)) 0 (/ (cos x * cos y)) H2 H8); rewrite Rmult_0_r; intro H4; assumption. - apply Rinv_mult. Qed. Lemma sin_incr_0 : forall x y:R, - (PI / 2) <= x -> x <= PI / 2 -> - (PI / 2) <= y -> y <= PI / 2 -> sin x <= sin y -> x <= y. Proof. intros; case (Rtotal_order (sin x) (sin y)); intro H4; [ left; apply (sin_increasing_0 x y H H0 H1 H2 H4) | elim H4; intro H5; [ case (Rtotal_order x y); intro H6; [ left; assumption | elim H6; intro H7; [ right; assumption | generalize (sin_increasing_1 y x H1 H2 H H0 H7); intro H8; rewrite H5 in H8; elim (Rlt_irrefl (sin y) H8) ] ] | elim (Rlt_irrefl (sin x) (Rle_lt_trans (sin x) (sin y) (sin x) H3 H5)) ] ]. Qed. Lemma sin_incr_1 : forall x y:R, - (PI / 2) <= x -> x <= PI / 2 -> - (PI / 2) <= y -> y <= PI / 2 -> x <= y -> sin x <= sin y. Proof. intros; case (Rtotal_order x y); intro H4; [ left; apply (sin_increasing_1 x y H H0 H1 H2 H4) | elim H4; intro H5; [ case (Rtotal_order (sin x) (sin y)); intro H6; [ left; assumption | elim H6; intro H7; [ right; assumption | generalize (sin_increasing_0 y x H1 H2 H H0 H7); intro H8; rewrite H5 in H8; elim (Rlt_irrefl y H8) ] ] | elim (Rlt_irrefl x (Rle_lt_trans x y x H3 H5)) ] ]. Qed. Lemma sin_decr_0 : forall x y:R, x <= 3 * (PI / 2) -> PI / 2 <= x -> y <= 3 * (PI / 2) -> PI / 2 <= y -> sin x <= sin y -> y <= x. Proof. intros; case (Rtotal_order (sin x) (sin y)); intro H4; [ left; apply (sin_decreasing_0 x y H H0 H1 H2 H4) | elim H4; intro H5; [ case (Rtotal_order x y); intro H6; [ generalize (sin_decreasing_1 x y H H0 H1 H2 H6); intro H8; rewrite H5 in H8; elim (Rlt_irrefl (sin y) H8) | elim H6; intro H7; [ right; symmetry in |- *; assumption | left; assumption ] ] | elim (Rlt_irrefl (sin x) (Rle_lt_trans (sin x) (sin y) (sin x) H3 H5)) ] ]. Qed. Lemma sin_decr_1 : forall x y:R, x <= 3 * (PI / 2) -> PI / 2 <= x -> y <= 3 * (PI / 2) -> PI / 2 <= y -> x <= y -> sin y <= sin x. Proof. intros; case (Rtotal_order x y); intro H4; [ left; apply (sin_decreasing_1 x y H H0 H1 H2 H4) | elim H4; intro H5; [ case (Rtotal_order (sin x) (sin y)); intro H6; [ generalize (sin_decreasing_0 x y H H0 H1 H2 H6); intro H8; rewrite H5 in H8; elim (Rlt_irrefl y H8) | elim H6; intro H7; [ right; symmetry in |- *; assumption | left; assumption ] ] | elim (Rlt_irrefl x (Rle_lt_trans x y x H3 H5)) ] ]. Qed. Lemma cos_incr_0 : forall x y:R, PI <= x -> x <= 2 * PI -> PI <= y -> y <= 2 * PI -> cos x <= cos y -> x <= y. Proof. intros; case (Rtotal_order (cos x) (cos y)); intro H4; [ left; apply (cos_increasing_0 x y H H0 H1 H2 H4) | elim H4; intro H5; [ case (Rtotal_order x y); intro H6; [ left; assumption | elim H6; intro H7; [ right; assumption | generalize (cos_increasing_1 y x H1 H2 H H0 H7); intro H8; rewrite H5 in H8; elim (Rlt_irrefl (cos y) H8) ] ] | elim (Rlt_irrefl (cos x) (Rle_lt_trans (cos x) (cos y) (cos x) H3 H5)) ] ]. Qed. Lemma cos_incr_1 : forall x y:R, PI <= x -> x <= 2 * PI -> PI <= y -> y <= 2 * PI -> x <= y -> cos x <= cos y. Proof. intros; case (Rtotal_order x y); intro H4; [ left; apply (cos_increasing_1 x y H H0 H1 H2 H4) | elim H4; intro H5; [ case (Rtotal_order (cos x) (cos y)); intro H6; [ left; assumption | elim H6; intro H7; [ right; assumption | generalize (cos_increasing_0 y x H1 H2 H H0 H7); intro H8; rewrite H5 in H8; elim (Rlt_irrefl y H8) ] ] | elim (Rlt_irrefl x (Rle_lt_trans x y x H3 H5)) ] ]. Qed. Lemma cos_decr_0 : forall x y:R, 0 <= x -> x <= PI -> 0 <= y -> y <= PI -> cos x <= cos y -> y <= x. Proof. intros; case (Rtotal_order (cos x) (cos y)); intro H4; [ left; apply (cos_decreasing_0 x y H H0 H1 H2 H4) | elim H4; intro H5; [ case (Rtotal_order x y); intro H6; [ generalize (cos_decreasing_1 x y H H0 H1 H2 H6); intro H8; rewrite H5 in H8; elim (Rlt_irrefl (cos y) H8) | elim H6; intro H7; [ right; symmetry in |- *; assumption | left; assumption ] ] | elim (Rlt_irrefl (cos x) (Rle_lt_trans (cos x) (cos y) (cos x) H3 H5)) ] ]. Qed. Lemma cos_decr_1 : forall x y:R, 0 <= x -> x <= PI -> 0 <= y -> y <= PI -> x <= y -> cos y <= cos x. Proof. intros; case (Rtotal_order x y); intro H4; [ left; apply (cos_decreasing_1 x y H H0 H1 H2 H4) | elim H4; intro H5; [ case (Rtotal_order (cos x) (cos y)); intro H6; [ generalize (cos_decreasing_0 x y H H0 H1 H2 H6); intro H8; rewrite H5 in H8; elim (Rlt_irrefl y H8) | elim H6; intro H7; [ right; symmetry in |- *; assumption | left; assumption ] ] | elim (Rlt_irrefl x (Rle_lt_trans x y x H3 H5)) ] ]. Qed. Lemma tan_incr_0 : forall x y:R, - (PI / 4) <= x -> x <= PI / 4 -> - (PI / 4) <= y -> y <= PI / 4 -> tan x <= tan y -> x <= y. Proof. intros; case (Rtotal_order (tan x) (tan y)); intro H4; [ left; apply (tan_increasing_0 x y H H0 H1 H2 H4) | elim H4; intro H5; [ case (Rtotal_order x y); intro H6; [ left; assumption | elim H6; intro H7; [ right; assumption | generalize (tan_increasing_1 y x H1 H2 H H0 H7); intro H8; rewrite H5 in H8; elim (Rlt_irrefl (tan y) H8) ] ] | elim (Rlt_irrefl (tan x) (Rle_lt_trans (tan x) (tan y) (tan x) H3 H5)) ] ]. Qed. Lemma tan_incr_1 : forall x y:R, - (PI / 4) <= x -> x <= PI / 4 -> - (PI / 4) <= y -> y <= PI / 4 -> x <= y -> tan x <= tan y. Proof. intros; case (Rtotal_order x y); intro H4; [ left; apply (tan_increasing_1 x y H H0 H1 H2 H4) | elim H4; intro H5; [ case (Rtotal_order (tan x) (tan y)); intro H6; [ left; assumption | elim H6; intro H7; [ right; assumption | generalize (tan_increasing_0 y x H1 H2 H H0 H7); intro H8; rewrite H5 in H8; elim (Rlt_irrefl y H8) ] ] | elim (Rlt_irrefl x (Rle_lt_trans x y x H3 H5)) ] ]. Qed. (**********) Lemma sin_eq_0_1 : forall x:R, (exists k : Z, x = IZR k * PI) -> sin x = 0. Proof. assert (forall n, sin (INR n * PI) = 0). { intros n;induction n as [|n IHn]. { change (INR 0) with 0. replace (0 * PI) with 0 by ring. exact sin_0. } rewrite S_INR. replace ((INR n + 1) * PI) with ((INR n) * PI + PI) by ring. rewrite neg_sin,IHn. ring. } intros x [k Hx]. rewrite Hx;clear x Hx. destruct (Z.abs_or_opp_abs k). - replace (IZR k) with (INR (Z.to_nat k)). { apply H. } rewrite INR_IZR_INZ. f_equal. apply Z2Nat.id. lia. - replace (IZR k) with (- INR (Z.to_nat (- k))). { replace (- INR (Z.to_nat (- k)) * PI) with (- (INR (Z.to_nat (- k)) * PI)) by ring. rewrite sin_neg. rewrite H;ring. } rewrite INR_IZR_INZ. rewrite <-opp_IZR. f_equal. lia. Qed. Lemma sin_eq_0_0 (x:R) : sin x = 0 -> exists k : Z, x = IZR k * PI. Proof. intros Hx. destruct (euclidian_division x PI PI_neq0) as (q & r & EQ & Hr & Hr'). exists q. rewrite <- (Rplus_0_r (_*_)). subst. apply Rplus_eq_compat_l. rewrite sin_plus in Hx. assert (H : sin (IZR q * PI) = 0) by (apply sin_eq_0_1; now exists q). rewrite H, Rmult_0_l, Rplus_0_l in Hx. destruct (Rmult_integral _ _ Hx) as [H'|H']. - exfalso. generalize (sin2_cos2 (IZR q * PI)). rewrite H, H', Rsqr_0, Rplus_0_l. intros; now apply R1_neq_R0. - rewrite Rabs_right in Hr'; [|left; apply PI_RGT_0]. destruct Hr as [Hr | ->]; trivial. exfalso. generalize (sin_gt_0 r Hr Hr'). rewrite H'. apply Rlt_irrefl. Qed. Lemma cos_eq_0_0 (x:R) : cos x = 0 -> exists k : Z, x = IZR k * PI + PI / 2. Proof. rewrite cos_sin. intros Hx. destruct (sin_eq_0_0 (PI/2 + x) Hx) as (k,Hk). clear Hx. exists (k-1)%Z. rewrite <- Z_R_minus; simpl. symmetry in Hk. field_simplify [Hk]. field. Qed. Lemma cos_eq_0_1 (x:R) : (exists k : Z, x = IZR k * PI + PI / 2) -> cos x = 0. Proof. rewrite cos_sin. intros (k,->). replace (_ + _) with (IZR k * PI + PI) by field. rewrite neg_sin, <- Ropp_0. apply Ropp_eq_compat. apply sin_eq_0_1. now exists k. Qed. Lemma sin_eq_O_2PI_0 (x:R) : 0 <= x -> x <= 2 * PI -> sin x = 0 -> x = 0 \/ x = PI \/ x = 2 * PI. Proof. intros Lo Hi Hx. destruct (sin_eq_0_0 x Hx) as (k,Hk). clear Hx. destruct (Rtotal_order PI x) as [Hx|[Hx|Hx]]. - right; right. clear Lo. subst. f_equal. change 2 with (IZR (- (-2))). f_equal. apply Z.add_move_0_l. apply one_IZR_lt1. rewrite plus_IZR; simpl. split. + replace (-1) with (-2 + 1) by ring. apply Rplus_lt_compat_l. apply Rmult_lt_reg_r with PI; [apply PI_RGT_0|]. now rewrite Rmult_1_l. + apply Rle_lt_trans with 0; [|apply Rlt_0_1]. replace 0 with (-2 + 2) by ring. apply Rplus_le_compat_l. apply Rmult_le_reg_r with PI; [apply PI_RGT_0|]. trivial. - right; left; auto. - left. clear Hi. subst. replace 0 with (IZR 0 * PI) by apply Rmult_0_l. f_equal. f_equal. apply one_IZR_lt1. split. + apply Rlt_le_trans with 0; [rewrite <- Ropp_0; apply Ropp_gt_lt_contravar, Rlt_0_1 | ]. apply Rmult_le_reg_r with PI; [apply PI_RGT_0|]. now rewrite Rmult_0_l. + apply Rmult_lt_reg_r with PI; [apply PI_RGT_0|]. now rewrite Rmult_1_l. Qed. Lemma sin_eq_O_2PI_1 (x:R) : 0 <= x -> x <= 2 * PI -> x = 0 \/ x = PI \/ x = 2 * PI -> sin x = 0. Proof. intros _ _ [ -> |[ -> | -> ]]. - now rewrite sin_0. - now rewrite sin_PI. - now rewrite sin_2PI. Qed. Lemma cos_eq_0_2PI_0 (x:R) : 0 <= x -> x <= 2 * PI -> cos x = 0 -> x = PI / 2 \/ x = 3 * (PI / 2). Proof. intros Lo Hi Hx. destruct (Rtotal_order x (3 * (PI / 2))) as [LT|[EQ|GT]]. - rewrite cos_sin in Hx. assert (Lo' : 0 <= PI / 2 + x). { apply Rplus_le_le_0_compat. - apply Rlt_le, PI2_RGT_0. - trivial. } assert (Hi' : PI / 2 + x <= 2 * PI). { apply Rlt_le. replace (2 * PI) with (PI / 2 + 3 * (PI / 2)) by field. now apply Rplus_lt_compat_l. } destruct (sin_eq_O_2PI_0 (PI / 2 + x) Lo' Hi' Hx) as [H|[H|H]]. + exfalso. apply (Rplus_le_compat_l (PI/2)) in Lo. rewrite Rplus_0_r, H in Lo. apply (Rlt_irrefl 0 (Rlt_le_trans 0 (PI / 2) 0 PI2_RGT_0 Lo)). + left. apply (Rplus_eq_compat_l (-(PI/2))) in H. ring_simplify in H. rewrite H. field. + right. apply (Rplus_eq_compat_l (-(PI/2))) in H. ring_simplify in H. rewrite H. field. - now right. - exfalso. destruct (cos_eq_0_0 x Hx) as (k,Hk). clear Hx Lo. subst. assert (LT : (k < 2)%Z). { apply lt_IZR. simpl. apply (Rmult_lt_reg_r PI); [apply PI_RGT_0|]. apply Rlt_le_trans with (IZR k * PI + PI/2); trivial. rewrite <- (Rplus_0_r (IZR k * PI)) at 1. apply Rplus_lt_compat_l. apply PI2_RGT_0. } assert (GT' : (1 < k)%Z). { apply lt_IZR. simpl. apply (Rmult_lt_reg_r PI); [apply PI_RGT_0|rewrite Rmult_1_l]. replace (3*(PI/2)) with (PI/2 + PI) in GT by field. rewrite Rplus_comm in GT. now apply Rplus_lt_reg_l in GT. } lia. Qed. Lemma cos_eq_0_2PI_1 (x:R) : 0 <= x -> x <= 2 * PI -> x = PI / 2 \/ x = 3 * (PI / 2) -> cos x = 0. Proof. intros Lo Hi [ -> | -> ]. - now rewrite cos_PI2. - now rewrite cos_3PI2. Qed. coq-8.20.0/theories/Reals/Rtrigo_alt.v000066400000000000000000000316241466560755400176000ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* a <= 4 -> sin_approx a (2 * n + 1) <= sin a <= sin_approx a (2 * (n + 1)). Proof. intros; case (Req_dec a 0); intro Hyp_a. { rewrite Hyp_a; rewrite sin_0; split; right; unfold sin_approx; apply sum_eq_R0 || (symmetry ; apply sum_eq_R0); intros; unfold sin_term; rewrite pow_add; simpl; unfold Rdiv; rewrite Rmult_0_l; ring. } unfold sin_approx; assert (Hyp_a_pos:0 < a) by lra. rewrite (decomp_sum (sin_term a) (2 * n + 1)). 2:lia. rewrite (decomp_sum (sin_term a) (2 * (n + 1))). 2:lia. replace (sin_term a 0) with a. 2:{ unfold sin_term; simpl; unfold Rdiv; rewrite Rinv_1; ring. } assert (sum_f_R0 (fun i:nat => sin_term a (S i)) (pred (2 * n + 1)) <= sin a - a /\ sin a - a <= sum_f_R0 (fun i:nat => sin_term a (S i)) (pred (2 * (n + 1))) -> a + sum_f_R0 (fun i:nat => sin_term a (S i)) (pred (2 * n + 1)) <= sin a /\ sin a <= a + sum_f_R0 (fun i:nat => sin_term a (S i)) (pred (2 * (n + 1)))) by lra. apply H1. set (Un := fun n:nat => a ^ (2 * S n + 1) / INR (fact (2 * S n + 1))). replace (pred (2 * n + 1)) with (2 * n)%nat by lia. replace (pred (2 * (n + 1))) with (S (2 * n)) by lia. replace (sum_f_R0 (fun i:nat => sin_term a (S i)) (2 * n)) with (- sum_f_R0 (tg_alt Un) (2 * n)). 2:{ replace (- sum_f_R0 (tg_alt Un) (2 * n)) with (-1 * sum_f_R0 (tg_alt Un) (2 * n)) by ring. rewrite scal_sum. apply sum_eq; intros. unfold sin_term, Un, tg_alt; change ((-1) ^ S i) with (-1 * (-1) ^ i). unfold Rdiv; ring. } replace (sum_f_R0 (fun i:nat => sin_term a (S i)) (S (2 * n))) with (- sum_f_R0 (tg_alt Un) (S (2 * n))). 2:{ replace (- sum_f_R0 (tg_alt Un) (S (2 * n))) with (-1 * sum_f_R0 (tg_alt Un) (S (2 * n))); [ rewrite scal_sum | ring ]. apply sum_eq; intros; unfold sin_term, Un, tg_alt; change ((-1) ^ S i) with (-1 * (-1) ^ i). unfold Rdiv; ring. } assert (sum_f_R0 (tg_alt Un) (S (2 * n)) <= a - sin a <= sum_f_R0 (tg_alt Un) (2 * n) -> - sum_f_R0 (tg_alt Un) (2 * n) <= sin a - a <= - sum_f_R0 (tg_alt Un) (S (2 * n))) by lra. apply H2. apply alternated_series_ineq. - unfold Un_decreasing, Un; intro; assert ((2 * S (S n0) + 1)%nat = S (S (2 * S n0 + 1))) by lia. rewrite H3. replace (a ^ S (S (2 * S n0 + 1))) with (a ^ (2 * S n0 + 1) * (a * a)) by (simpl;ring). unfold Rdiv; rewrite Rmult_assoc; apply Rmult_le_compat_l. { left; apply pow_lt; assumption. } apply Rmult_le_reg_l with (INR (fact (S (S (2 * S n0 + 1))))). { rewrite <- H3; apply lt_INR_0; apply Nat.neq_0_lt_0; red; intro; elim (fact_neq_0 _ H4). } rewrite <- H3; rewrite (Rmult_comm (INR (fact (2 * S (S n0) + 1)))); rewrite Rmult_assoc; rewrite Rinv_l. 2:{ apply INR_fact_neq_0. } rewrite Rmult_1_r; rewrite H3; do 2 rewrite fact_simpl; do 2 rewrite mult_INR; repeat rewrite Rmult_assoc; rewrite Rinv_r. 2:{ apply INR_fact_neq_0. } rewrite Rmult_1_r. do 2 rewrite S_INR; rewrite plus_INR; rewrite mult_INR; repeat rewrite S_INR; simpl; replace (((0 + 1 + 1) * (INR n0 + 1) + (0 + 1) + 1 + 1) * ((0 + 1 + 1) * (INR n0 + 1) + (0 + 1) + 1)) with (4 * INR n0 * INR n0 + 18 * INR n0 + 20); [ idtac | ring ]. apply Rle_trans with 20. + apply Rle_trans with 16. 2:lra. replace 16 with (Rsqr 4); [ idtac | ring_Rsqr ]. apply Rsqr_incr_1;lra. + rewrite <- (Rplus_0_l 20) at 1; apply Rplus_le_compat_r. pose proof (pos_INR n0). nra. - assert (H3 := cv_speed_pow_fact a); unfold Un; unfold Un_cv in H3; unfold Rdist in H3; unfold Un_cv; unfold Rdist; intros; elim (H3 eps H4); intros N H5. exists N; intros; apply H5. lia. - unfold sin. destruct (exist_sin (Rsqr a)) as (x,p). unfold sin_in, infinite_sum, Rdist in p; unfold Un_cv, Rdist; intros. assert (H4:0 < eps / Rabs a). { unfold Rdiv; apply Rmult_lt_0_compat. - assumption. - apply Rinv_0_lt_compat; apply Rabs_pos_lt; assumption. } destruct (p _ H4) as (N,H6). exists N; intros. replace (sum_f_R0 (tg_alt Un) n0) with (a * (1 - sum_f_R0 (fun i:nat => sin_n i * Rsqr a ^ i) (S n0))). { unfold Rminus; rewrite Rmult_plus_distr_l; rewrite Rmult_1_r; rewrite Ropp_plus_distr; rewrite Ropp_involutive; repeat rewrite Rplus_assoc; rewrite (Rplus_comm a); rewrite (Rplus_comm (- a)); repeat rewrite Rplus_assoc; rewrite Rplus_opp_l; rewrite Rplus_0_r; apply Rmult_lt_reg_l with (/ Rabs a). { apply Rinv_0_lt_compat; apply Rabs_pos_lt; assumption. } pattern (/ Rabs a) at 1; rewrite <- (Rabs_inv a). rewrite <- Rabs_mult, Rmult_plus_distr_l, <- 2!Rmult_assoc, Rinv_l; [ rewrite Rmult_1_l | assumption ]; rewrite (Rmult_comm (/ Rabs a)), <- Rabs_Ropp, Ropp_plus_distr, Ropp_involutive, Rmult_1_l. unfold Rminus, Rdiv in H6. apply H6; unfold ge; apply Nat.le_trans with n0; [ exact H5 | apply Nat.le_succ_diag_r ]. } rewrite (decomp_sum (fun i:nat => sin_n i * Rsqr a ^ i) (S n0)). 2:lia. replace (sin_n 0) with 1. 2:{ unfold sin_n; unfold Rdiv; simpl; rewrite Rinv_1; rewrite Rmult_1_r; reflexivity. } simpl; rewrite Rmult_1_r; unfold Rminus; rewrite Ropp_plus_distr; rewrite <- Rplus_assoc; rewrite Rplus_opp_r; rewrite Rplus_0_l; rewrite Ropp_mult_distr_r_reverse; rewrite <- Ropp_mult_distr_l_reverse; rewrite scal_sum; apply sum_eq. intros; unfold sin_n, Un, tg_alt; replace ((-1) ^ S i) with (- (-1) ^ i) by (simpl;ring). replace (a ^ (2 * S i + 1)) with (Rsqr a * Rsqr a ^ i * a). { unfold Rdiv; ring. } rewrite pow_add; rewrite pow_Rsqr; simpl; ring. Qed. (**********) Lemma pre_cos_bound : forall (a:R) (n:nat), - 2 <= a -> a <= 2 -> cos_approx a (2 * n + 1) <= cos a <= cos_approx a (2 * (n + 1)). Proof. assert (H:(forall (a:R) (n:nat), 0 <= a -> a <= 2 -> cos_approx a (2 * n + 1) <= cos a <= cos_approx a (2 * (n + 1))) -> forall (a:R) (n:nat), - 2 <= a -> a <= 2 -> cos_approx a (2 * n + 1) <= cos a <= cos_approx a (2 * (n + 1))). { intros; destruct (total_order_T 0 a) as [[Hlt|Heq]|Hgt];try (apply H;lra). assert (0 < - a) by lra. cut (forall (x:R) (n:nat), cos_approx x n = cos_approx (- x) n). { intro; rewrite H3; rewrite (H3 a (2 * (n + 1))%nat); rewrite cos_sym; apply H;lra. } intros; unfold cos_approx; apply sum_eq; intros; unfold cos_term; do 2 rewrite pow_Rsqr; rewrite Rsqr_neg; unfold Rdiv; reflexivity. } intros a n; apply H. intros; unfold cos_approx. rewrite (decomp_sum (cos_term a0) (2 * n0 + 1)). 2:lia. rewrite (decomp_sum (cos_term a0) (2 * (n0 + 1))). 2:lia. replace (cos_term a0 0) with 1. 2:{ unfold cos_term; simpl; unfold Rdiv; rewrite Rinv_1; ring. } assert (sum_f_R0 (fun i:nat => cos_term a0 (S i)) (pred (2 * n0 + 1)) <= cos a0 - 1 /\ cos a0 - 1 <= sum_f_R0 (fun i:nat => cos_term a0 (S i)) (pred (2 * (n0 + 1))) -> 1 + sum_f_R0 (fun i:nat => cos_term a0 (S i)) (pred (2 * n0 + 1)) <= cos a0 /\ cos a0 <= 1 + sum_f_R0 (fun i:nat => cos_term a0 (S i)) (pred (2 * (n0 + 1)))). { intro; elim H2; intros; split; apply Rplus_le_reg_l with (-(1)); rewrite <- Rplus_assoc; rewrite Rplus_opp_l; rewrite Rplus_0_l; rewrite (Rplus_comm (-1));assumption. } apply H2. set (Un := fun n:nat => a0 ^ (2 * S n) / INR (fact (2 * S n))). replace (pred (2 * n0 + 1)) with (2 * n0)%nat by lia. replace (pred (2 * (n0 + 1))) with (S (2 * n0)) by lia. replace (sum_f_R0 (fun i:nat => cos_term a0 (S i)) (2 * n0)) with (- sum_f_R0 (tg_alt Un) (2 * n0)). 2:{ replace (- sum_f_R0 (tg_alt Un) (2 * n0)) with (-1 * sum_f_R0 (tg_alt Un) (2 * n0)); [ rewrite scal_sum | ring ]; apply sum_eq; intros; unfold cos_term, Un, tg_alt; change ((-1) ^ S i) with (-1 * (-1) ^ i). unfold Rdiv; ring. } replace (sum_f_R0 (fun i:nat => cos_term a0 (S i)) (S (2 * n0))) with (- sum_f_R0 (tg_alt Un) (S (2 * n0))). 2:{ replace (- sum_f_R0 (tg_alt Un) (S (2 * n0))) with (-1 * sum_f_R0 (tg_alt Un) (S (2 * n0))); [ rewrite scal_sum | ring ]. apply sum_eq; intros; unfold cos_term, Un, tg_alt; change ((-1) ^ S i) with (-1 * (-1) ^ i). unfold Rdiv; ring. } assert (sum_f_R0 (tg_alt Un) (S (2 * n0)) <= 1 - cos a0 <= sum_f_R0 (tg_alt Un) (2 * n0) -> - sum_f_R0 (tg_alt Un) (2 * n0) <= cos a0 - 1 <= - sum_f_R0 (tg_alt Un) (S (2 * n0))) by lra. apply H3. apply alternated_series_ineq. - unfold Un_decreasing; intro; unfold Un. assert ((2 * S (S n1))%nat = S (S (2 * S n1))) by lia. rewrite H4; replace (a0 ^ S (S (2 * S n1))) with (a0 ^ (2 * S n1) * (a0 * a0)) by (simpl;ring). unfold Rdiv; rewrite Rmult_assoc; apply Rmult_le_compat_l. { apply pow_le; assumption. } apply Rmult_le_reg_l with (INR (fact (S (S (2 * S n1))))). { apply INR_fact_lt_0. } rewrite <- H4; rewrite (Rmult_comm (INR (fact (2 * S (S n1))))); rewrite Rmult_assoc; rewrite Rinv_l. 2:(pose proof (INR_fact_lt_0 (2 * S (S n1)));lra). rewrite Rmult_1_r; rewrite H4; do 2 rewrite fact_simpl; do 2 rewrite mult_INR; repeat rewrite Rmult_assoc; rewrite Rinv_r. 2:(pose proof (INR_fact_lt_0 (2 * S n1));lra). rewrite Rmult_1_r; do 2 rewrite S_INR; rewrite mult_INR; repeat rewrite S_INR; simpl; replace (((0 + 1 + 1) * (INR n1 + 1) + 1 + 1) * ((0 + 1 + 1) * (INR n1 + 1) + 1)) with (4 * INR n1 * INR n1 + 14 * INR n1 + 12); [ idtac | ring ]. apply Rle_trans with 12. { nra. } pose proof (pos_INR n1);nra. - assert (H4 := cv_speed_pow_fact a0); unfold Un; unfold Un_cv in H4; unfold Rdist in H4; unfold Un_cv; unfold Rdist; intros; elim (H4 eps H5); intros N H6; exists N; intros. apply H6; nia. - unfold cos. destruct (exist_cos (Rsqr a0)) as (x,p). unfold cos_in, infinite_sum, Rdist in p; unfold Un_cv, Rdist; intros. destruct (p _ H4) as (N,H6). exists N; intros. replace (sum_f_R0 (tg_alt Un) n1) with (1 - sum_f_R0 (fun i:nat => cos_n i * Rsqr a0 ^ i) (S n1)). { unfold Rminus; rewrite Ropp_plus_distr; rewrite Ropp_involutive; repeat rewrite Rplus_assoc; rewrite (Rplus_comm 1); rewrite (Rplus_comm (-(1))); repeat rewrite Rplus_assoc; rewrite Rplus_opp_l; rewrite Rplus_0_r; rewrite <- Rabs_Ropp; rewrite Ropp_plus_distr; rewrite Ropp_involutive; unfold Rminus in H6; apply H6. lia. } rewrite (decomp_sum (fun i:nat => cos_n i * Rsqr a0 ^ i) (S n1)). 2:lia. replace (cos_n 0) with 1. 2:{ unfold cos_n; unfold Rdiv; simpl; rewrite Rinv_1; rewrite Rmult_1_r; reflexivity. } simpl; rewrite Rmult_1_r; unfold Rminus; rewrite Ropp_plus_distr; rewrite <- Rplus_assoc; rewrite Rplus_opp_r; rewrite Rplus_0_l; replace (- sum_f_R0 (fun i:nat => cos_n (S i) * (Rsqr a0 * Rsqr a0 ^ i)) n1) with (-1 * sum_f_R0 (fun i:nat => cos_n (S i) * (Rsqr a0 * Rsqr a0 ^ i)) n1); [ idtac | ring ]; rewrite scal_sum; apply sum_eq; intros; unfold cos_n, Un, tg_alt. replace ((-1) ^ S i) with (- (-1) ^ i) by (simpl;ring). replace (a0 ^ (2 * S i)) with (Rsqr a0 * Rsqr a0 ^ i) by (rewrite pow_Rsqr; reflexivity). unfold Rdiv; ring. Qed. coq-8.20.0/theories/Reals/Rtrigo_calc.v000066400000000000000000000261221466560755400177170ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* 0. Proof. assert (Hyp : 0 < 2); [ prove_sup0 | generalize (Rlt_le 0 2 Hyp); intro H1; red; intro H2; generalize (sqrt_eq_0 2 H1 H2); intro H; absurd (2 = 0); [ discrR | assumption ] ]. Qed. Lemma R1_sqrt2_neq_0 : 1 / sqrt 2 <> 0. Proof. generalize (Rinv_neq_0_compat (sqrt 2) sqrt2_neq_0); intro H; generalize (prod_neq_R0 1 (/ sqrt 2) R1_neq_R0 H); intro H0; assumption. Qed. Lemma sqrt3_2_neq_0 : 2 * sqrt 3 <> 0. Proof. apply prod_neq_R0; [ discrR | assert (Hyp : 0 < 3); [ prove_sup0 | generalize (Rlt_le 0 3 Hyp); intro H1; red; intro H2; generalize (sqrt_eq_0 3 H1 H2); intro H; absurd (3 = 0); [ discrR | assumption ] ] ]. Qed. Lemma Rlt_sqrt2_0 : 0 < sqrt 2. Proof. assert (Hyp : 0 < 2); [ prove_sup0 | generalize (sqrt_positivity 2 (Rlt_le 0 2 Hyp)); intro H1; elim H1; intro H2; [ assumption | absurd (0 = sqrt 2); [ apply (not_eq_sym (A:=R)); apply sqrt2_neq_0 | assumption ] ] ]. Qed. Lemma Rlt_sqrt3_0 : 0 < sqrt 3. Proof. cut (0%nat <> 1%nat); [ intro H0; assert (Hyp : 0 < 2); [ prove_sup0 | generalize (Rlt_le 0 2 Hyp); intro H1; assert (Hyp2 : 0 < 3); [ prove_sup0 | generalize (Rlt_le 0 3 Hyp2); intro H2; generalize (lt_INR_0 1 (proj1 (Nat.neq_0_lt_0 1) (Nat.neq_sym 0 1 H0))); unfold INR; intro H3; generalize (Rplus_lt_compat_l 2 0 1 H3); rewrite Rplus_comm; rewrite Rplus_0_l; replace (2 + 1) with 3; [ intro H4; generalize (sqrt_lt_1 2 3 H1 H2 H4); clear H3; intro H3; apply (Rlt_trans 0 (sqrt 2) (sqrt 3) Rlt_sqrt2_0 H3) | ring ] ] ] | discriminate ]. Qed. Lemma PI4_RGT_0 : 0 < PI / 4. Proof. unfold Rdiv; apply Rmult_lt_0_compat; [ apply PI_RGT_0 | apply Rinv_0_lt_compat; prove_sup0 ]. Qed. Lemma cos_PI4 : cos (PI / 4) = 1 / sqrt 2. Proof with trivial. apply Rsqr_inj... - apply cos_ge_0... + left; apply (Rlt_trans (- (PI / 2)) 0 (PI / 4) _PI2_RLT_0 PI4_RGT_0)... + left; apply PI4_RLT_PI2... - left; apply (Rmult_lt_0_compat 1 (/ sqrt 2))... + prove_sup... + apply Rinv_0_lt_compat; apply Rlt_sqrt2_0... - rewrite Rsqr_div'. rewrite Rsqr_1; rewrite Rsqr_sqrt... + unfold Rsqr; pattern (cos (PI / 4)) at 1; rewrite <- sin_cos_PI4; replace (sin (PI / 4) * cos (PI / 4)) with (1 / 2 * (2 * sin (PI / 4) * cos (PI / 4))) by field. rewrite <- sin_2a; replace (2 * (PI / 4)) with (PI / 2) by field. rewrite sin_PI2... field. + left; prove_sup... Qed. Lemma sin_PI4 : sin (PI / 4) = 1 / sqrt 2. Proof. rewrite sin_cos_PI4; apply cos_PI4. Qed. Lemma tan_PI4 : tan (PI / 4) = 1. Proof. unfold tan; rewrite sin_cos_PI4. unfold Rdiv; apply Rinv_r. change (cos (PI / 4) <> 0); rewrite cos_PI4; apply R1_sqrt2_neq_0. Qed. Lemma cos_3PI4 : cos (3 * (PI / 4)) = -1 / sqrt 2. Proof. replace (3 * (PI / 4)) with (PI / 2 - - (PI / 4)) by field. rewrite cos_shift; rewrite sin_neg; rewrite sin_PI4. unfold Rdiv. ring. Qed. Lemma sin_3PI4 : sin (3 * (PI / 4)) = 1 / sqrt 2. Proof. replace (3 * (PI / 4)) with (PI / 2 - - (PI / 4)) by field. now rewrite sin_shift, cos_neg, cos_PI4. Qed. Lemma cos_PI6 : cos (PI / 6) = sqrt 3 / 2. Proof with trivial. apply Rsqr_inj... - apply cos_ge_0... + left; apply (Rlt_trans (- (PI / 2)) 0 (PI / 6) _PI2_RLT_0 PI6_RGT_0)... + left; apply PI6_RLT_PI2... - left; apply (Rmult_lt_0_compat (sqrt 3) (/ 2))... + apply Rlt_sqrt3_0... + apply Rinv_0_lt_compat; prove_sup0... - rewrite Rsqr_div'. rewrite cos2; unfold Rsqr; rewrite sin_PI6; rewrite sqrt_def... + field. + left ; prove_sup0. Qed. Lemma tan_PI6 : tan (PI / 6) = 1 / sqrt 3. Proof. unfold tan; rewrite sin_PI6; rewrite cos_PI6; unfold Rdiv; repeat rewrite Rmult_1_l; rewrite Rinv_mult. rewrite Rinv_inv. rewrite (Rmult_comm (/ 2)); rewrite Rmult_assoc; rewrite Rinv_r. - apply Rmult_1_r. - discrR. Qed. Lemma sin_PI3 : sin (PI / 3) = sqrt 3 / 2. Proof. rewrite sin_PI3_cos_PI6; apply cos_PI6. Qed. Lemma cos_PI3 : cos (PI / 3) = 1 / 2. Proof. rewrite sin_PI6_cos_PI3; apply sin_PI6. Qed. Lemma tan_PI3 : tan (PI / 3) = sqrt 3. Proof. unfold tan; rewrite sin_PI3; rewrite cos_PI3; unfold Rdiv; rewrite Rmult_1_l; rewrite Rinv_inv. rewrite Rmult_assoc; rewrite Rinv_l. - apply Rmult_1_r. - discrR. Qed. Lemma sin_2PI3 : sin (2 * (PI / 3)) = sqrt 3 / 2. Proof. rewrite <-Rplus_diag; rewrite sin_plus; rewrite sin_PI3; rewrite cos_PI3; unfold Rdiv; repeat rewrite Rmult_1_l; rewrite (Rmult_comm (/ 2)); repeat rewrite <- Rmult_assoc; rewrite <-Rplus_half_diag; reflexivity. Qed. Lemma cos_2PI3 : cos (2 * (PI / 3)) = -1 / 2. Proof. rewrite cos_2a, sin_PI3, cos_PI3. replace (sqrt 3 / 2 * (sqrt 3 / 2)) with ((sqrt 3 * sqrt 3) / 4) by field. rewrite sqrt_sqrt. - field. - left ; prove_sup0. Qed. Lemma tan_2PI3 : tan (2 * (PI / 3)) = - sqrt 3. Proof. unfold tan; rewrite sin_2PI3, cos_2PI3. field. Qed. Lemma cos_5PI4 : cos (5 * (PI / 4)) = -1 / sqrt 2. Proof. replace (5 * (PI / 4)) with (PI / 4 + PI) by field. rewrite neg_cos; rewrite cos_PI4; unfold Rdiv. ring. Qed. Lemma sin_5PI4 : sin (5 * (PI / 4)) = -1 / sqrt 2. Proof. replace (5 * (PI / 4)) with (PI / 4 + PI) by field. rewrite neg_sin; rewrite sin_PI4; unfold Rdiv. ring. Qed. Lemma sin_cos5PI4 : cos (5 * (PI / 4)) = sin (5 * (PI / 4)). Proof. rewrite cos_5PI4; rewrite sin_5PI4; reflexivity. Qed. Lemma Rgt_3PI2_0 : 0 < 3 * (PI / 2). Proof. apply Rmult_lt_0_compat; [ prove_sup0 | unfold Rdiv; apply Rmult_lt_0_compat; [ apply PI_RGT_0 | apply Rinv_0_lt_compat; prove_sup0 ] ]. Qed. Lemma Rgt_2PI_0 : 0 < 2 * PI. Proof. apply Rmult_lt_0_compat; [ prove_sup0 | apply PI_RGT_0 ]. Qed. Lemma Rlt_PI_3PI2 : PI < 3 * (PI / 2). Proof. generalize PI2_RGT_0; intro H1; generalize (Rplus_lt_compat_l PI 0 (PI / 2) H1); replace (PI + PI / 2) with (3 * (PI / 2)). - rewrite Rplus_0_r; intro H2; assumption. - pattern PI at 2; rewrite <-Rplus_half_diag; ring. Qed. Lemma Rlt_3PI2_2PI : 3 * (PI / 2) < 2 * PI. Proof. generalize PI2_RGT_0; intro H1; generalize (Rplus_lt_compat_l (3 * (PI / 2)) 0 (PI / 2) H1); replace (3 * (PI / 2) + PI / 2) with (2 * PI). - rewrite Rplus_0_r; intro H2; assumption. - rewrite <-Rplus_diag; pattern PI at 1 2; rewrite <-Rplus_half_diag; ring. Qed. (***************************************************************) (** Radian -> Degree | Degree -> Radian *) (***************************************************************) Definition plat : R := 180. Definition toRad (x:R) : R := x * PI * / plat. Definition toDeg (x:R) : R := x * plat * / PI. Lemma rad_deg : forall x:R, toRad (toDeg x) = x. Proof. intro; unfold toRad, toDeg; replace (x * plat * / PI * PI * / plat) with (x * (plat * / plat) * (PI * / PI)); [ idtac | ring ]. repeat rewrite Rinv_r. - ring. - apply PI_neq0. - unfold plat; discrR. Qed. Lemma toRad_inj : forall x y:R, toRad x = toRad y -> x = y. Proof. intros; unfold toRad in H; apply Rmult_eq_reg_l with PI. - rewrite <- (Rmult_comm x); rewrite <- (Rmult_comm y). apply Rmult_eq_reg_l with (/ plat). + rewrite <- (Rmult_comm (x * PI)); rewrite <- (Rmult_comm (y * PI)); assumption. + apply Rinv_neq_0_compat; unfold plat; discrR. - apply PI_neq0. Qed. Lemma deg_rad : forall x:R, toDeg (toRad x) = x. Proof. intro x; apply toRad_inj; rewrite (rad_deg (toRad x)); reflexivity. Qed. Definition sind (x:R) : R := sin (toRad x). Definition cosd (x:R) : R := cos (toRad x). Definition tand (x:R) : R := tan (toRad x). Lemma Rsqr_sin_cos_d_one : forall x:R, Rsqr (sind x) + Rsqr (cosd x) = 1. Proof. intro x; unfold sind; unfold cosd; apply sin2_cos2. Qed. (***************************************************) (** Other properties *) (***************************************************) Lemma sin_lb_ge_0 : forall a:R, 0 <= a -> a <= PI / 2 -> 0 <= sin_lb a. Proof. intros; case (Rtotal_order 0 a); intro. - left; apply sin_lb_gt_0; assumption. - elim H1; intro. + rewrite <- H2; unfold sin_lb; unfold sin_approx; unfold sum_f_R0; unfold sin_term; repeat rewrite pow_ne_zero. * unfold Rdiv; repeat rewrite Rmult_0_l; repeat rewrite Rmult_0_r; repeat rewrite Rplus_0_r; right; reflexivity. * discriminate. * discriminate. * discriminate. * discriminate. + elim (Rlt_irrefl 0 (Rle_lt_trans 0 a 0 H H2)). Qed. coq-8.20.0/theories/Reals/Rtrigo_def.v000066400000000000000000000271061466560755400175560ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* / INR (fact i) * x ^ i) l. Lemma exp_cof_no_R0 : forall n:nat, / INR (fact n) <> 0. Proof. intro. apply Rinv_neq_0_compat. apply INR_fact_neq_0. Qed. Lemma exist_exp : forall x:R, { l:R | exp_in x l }. Proof. intro; generalize (Alembert_C3 (fun n:nat => / INR (fact n)) x exp_cof_no_R0 Alembert_exp). unfold Pser, exp_in. trivial. Defined. Definition exp (x:R) : R := proj1_sig (exist_exp x). Lemma pow_i : forall i:nat, (0 < i)%nat -> 0 ^ i = 0. Proof. intros; apply pow_ne_zero. red; intro; rewrite H0 in H; elim (Nat.lt_irrefl _ H). Qed. (* Value of [exp 0] *) Lemma exp_0 : exp 0 = 1. Proof. cut (exp_in 0 1). - cut (exp_in 0 (exp 0)). + apply uniqueness_sum. + exact (proj2_sig (exist_exp 0)). - unfold exp_in; unfold infinite_sum; intros. exists 0%nat. intros; replace (sum_f_R0 (fun i:nat => / INR (fact i) * 0 ^ i) n) with 1. + unfold Rdist; replace (1 - 1) with 0; [ rewrite Rabs_R0; assumption | ring ]. + induction n as [| n Hrecn]. * simpl; rewrite Rinv_1; ring. * rewrite tech5. rewrite <- Hrecn. -- simpl. ring. -- unfold ge; apply Nat.le_0_l. Qed. (*****************************************) (** * Definition of hyperbolic functions *) (*****************************************) Definition cosh (x:R) : R := (exp x + exp (- x)) / 2. Definition sinh (x:R) : R := (exp x - exp (- x)) / 2. Definition tanh (x:R) : R := sinh x / cosh x. Lemma cosh_0 : cosh 0 = 1. Proof. unfold cosh; rewrite Ropp_0; rewrite exp_0. unfold Rdiv; rewrite Rinv_r; [ reflexivity | discrR ]. Qed. Lemma sinh_0 : sinh 0 = 0. Proof. unfold sinh; rewrite Ropp_0; rewrite exp_0. unfold Rminus, Rdiv; rewrite Rplus_opp_r; apply Rmult_0_l. Qed. Definition cos_n (n:nat) : R := (-1) ^ n / INR (fact (2 * n)). Lemma simpl_cos_n : forall n:nat, cos_n (S n) / cos_n n = - / INR (2 * S n * (2 * n + 1)). Proof. intro; unfold cos_n; replace (S n) with (n + 1)%nat by ring. rewrite pow_add; unfold Rdiv; rewrite Rinv_mult. rewrite Rinv_inv. replace ((-1) ^ n * (-1) ^ 1 * / INR (fact (2 * (n + 1))) * (/ (-1) ^ n * INR (fact (2 * n)))) with ((-1) ^ n * / (-1) ^ n * / INR (fact (2 * (n + 1))) * INR (fact (2 * n)) * (-1) ^ 1); [ idtac | ring ]. rewrite Rinv_r. - rewrite Rmult_1_l; unfold pow; rewrite Rmult_1_r. replace (2 * (n + 1))%nat with (S (S (2 * n))) by ring. do 2 rewrite fact_simpl; do 2 rewrite mult_INR; repeat rewrite Rinv_mult. rewrite <- (Rmult_comm (-1)). repeat rewrite Rmult_assoc; rewrite Rinv_l. + rewrite Rmult_1_r. replace (S (2 * n)) with (2 * n + 1)%nat by ring. rewrite mult_INR; rewrite Rinv_mult. ring. + apply INR_fact_neq_0. - apply pow_nonzero; discrR. Qed. Lemma archimed_cor1 : forall eps:R, 0 < eps -> exists N : nat, / INR N < eps /\ (0 < N)%nat. Proof. intros; assert (/ eps < IZR (up (/ eps))). { assert (H0 := archimed (/ eps)). elim H0; intros; assumption. } assert (0 <= up (/ eps))%Z. { apply le_IZR; left; apply Rlt_trans with (/ eps); [ apply Rinv_0_lt_compat; assumption | assumption ]. } assert (H2 := IZN _ H1); elim H2; intros; exists (max x 1). split. - assert (0 < IZR (Z.of_nat x)). { apply Rlt_trans with (/ eps). - apply Rinv_0_lt_compat; assumption. - rewrite H3 in H0; assumption. } rewrite INR_IZR_INZ; apply Rle_lt_trans with (/ IZR (Z.of_nat x)). + apply Rmult_le_reg_l with (IZR (Z.of_nat x)). { assumption. } rewrite Rinv_r; [ idtac | red; intro; rewrite H5 in H4; elim (Rlt_irrefl _ H4) ]. apply Rmult_le_reg_l with (IZR (Z.of_nat (max x 1))). * apply Rlt_le_trans with (IZR (Z.of_nat x)). -- assumption. -- repeat rewrite <- INR_IZR_INZ; apply le_INR; apply Nat.le_max_l. * rewrite Rmult_1_r; rewrite (Rmult_comm (IZR (Z.of_nat (max x 1)))); rewrite Rmult_assoc; rewrite Rinv_l. -- rewrite Rmult_1_r; repeat rewrite <- INR_IZR_INZ; apply le_INR; apply Nat.le_max_l. -- rewrite <- INR_IZR_INZ; apply not_O_INR. red; intro; assert (H6 := Nat.le_max_r x 1); cut (0 < 1)%nat; [ intro | apply Nat.lt_0_succ ]; assert (H8 := Nat.lt_le_trans _ _ _ H7 H6); rewrite H5 in H8; elim (Nat.lt_irrefl _ H8). + pattern eps at 1; rewrite <- Rinv_inv. apply Rinv_lt_contravar. * apply Rmult_lt_0_compat; [ apply Rinv_0_lt_compat; assumption | assumption ]. * rewrite H3 in H0; assumption. - apply Nat.lt_le_trans with 1%nat; [ apply Nat.lt_0_succ | apply Nat.le_max_r ]. Qed. Lemma Alembert_cos : Un_cv (fun n:nat => Rabs (cos_n (S n) / cos_n n)) 0. Proof. unfold Un_cv; intros. assert (H0 := archimed_cor1 eps H). elim H0; intros; exists x. intros; rewrite simpl_cos_n; unfold Rdist; unfold Rminus; rewrite Ropp_0; rewrite Rplus_0_r; rewrite Rabs_Rabsolu; rewrite Rabs_Ropp; rewrite Rabs_right. 2:{ apply Rle_ge; left; apply Rinv_0_lt_compat. apply lt_INR_0. replace (2 * S n * (2 * n + 1))%nat with (2 + (4 * (n * n) + 6 * n))%nat by ring. apply Nat.lt_0_succ. } rewrite mult_INR; rewrite Rinv_mult. assert (/ INR (2 * S n) < 1). { apply Rmult_lt_reg_l with (INR (2 * S n)). - apply lt_INR_0; replace (2 * S n)%nat with (S (S (2 * n))). + apply Nat.lt_0_succ. + replace (S n) with (n + 1)%nat by ring. ring. - rewrite Rinv_r. + rewrite Rmult_1_r. apply (lt_INR 1). nia. + apply not_O_INR; discriminate. } cut (/ INR (2 * n + 1) < eps). { intro; rewrite <- (Rmult_1_l eps). apply Rmult_gt_0_lt_compat; try assumption. - change (0 < / INR (2 * n + 1)); apply Rinv_0_lt_compat; apply lt_INR_0. replace (2 * n + 1)%nat with (S (2 * n)); [ apply Nat.lt_0_succ | ring ]. - apply Rlt_0_1. } assert (x < 2 * n + 1)%nat by nia. assert (H5 := lt_INR _ _ H4). apply Rlt_trans with (/ INR x). 2:{ elim H1; intros; assumption. } apply Rinv_lt_contravar. { apply Rmult_lt_0_compat. - apply lt_INR_0. nia. - apply lt_INR_0; nia. } assumption. Qed. Lemma cosn_no_R0 : forall n:nat, cos_n n <> 0. Proof. intro; unfold cos_n; unfold Rdiv; apply prod_neq_R0. - apply pow_nonzero; discrR. - apply Rinv_neq_0_compat. apply INR_fact_neq_0. Qed. (**********) Definition cos_in (x l:R) : Prop := infinite_sum (fun i:nat => cos_n i * x ^ i) l. (**********) Lemma exist_cos : forall x:R, { l:R | cos_in x l }. Proof. intro; generalize (Alembert_C3 cos_n x cosn_no_R0 Alembert_cos). unfold Pser, cos_in; trivial. Qed. (** Definition of cosinus *) Definition cos (x:R) : R := let (a,_) := exist_cos (Rsqr x) in a. Definition sin_n (n:nat) : R := (-1) ^ n / INR (fact (2 * n + 1)). Lemma simpl_sin_n : forall n:nat, sin_n (S n) / sin_n n = - / INR ((2 * S n + 1) * (2 * S n)). Proof. intro; unfold sin_n; replace (S n) with (n + 1)%nat; [ idtac | ring ]. rewrite pow_add; unfold Rdiv; rewrite Rinv_mult. rewrite Rinv_inv. replace ((-1) ^ n * (-1) ^ 1 * / INR (fact (2 * (n + 1) + 1)) * (/ (-1) ^ n * INR (fact (2 * n + 1)))) with ((-1) ^ n * / (-1) ^ n * / INR (fact (2 * (n + 1) + 1)) * INR (fact (2 * n + 1)) * (-1) ^ 1); [ idtac | ring ]. rewrite Rinv_r. 2:{ apply pow_nonzero; discrR. } rewrite Rmult_1_l; unfold pow; rewrite Rmult_1_r; replace (2 * (n + 1) + 1)%nat with (S (S (2 * n + 1))) by nia. do 2 rewrite fact_simpl; do 2 rewrite mult_INR; repeat rewrite Rinv_mult. rewrite <- (Rmult_comm (-1)); repeat rewrite Rmult_assoc; rewrite Rinv_l. - rewrite Rmult_1_r; replace (S (2 * n + 1)) with (2 * (n + 1))%nat by nia. repeat rewrite mult_INR; repeat rewrite Rinv_mult. ring. - apply INR_fact_neq_0. Qed. Lemma Alembert_sin : Un_cv (fun n:nat => Rabs (sin_n (S n) / sin_n n)) 0. Proof. unfold Un_cv; intros; assert (H0 := archimed_cor1 eps H). elim H0; intros; exists x. intros; rewrite simpl_sin_n; unfold Rdist; unfold Rminus; rewrite Ropp_0; rewrite Rplus_0_r; rewrite Rabs_Rabsolu; rewrite Rabs_Ropp; rewrite Rabs_right. 2:{ left; apply Rinv_0_lt_compat. apply lt_INR_0. nia. } rewrite mult_INR; rewrite Rinv_mult. assert (/ INR (2 * S n) < 1). { apply Rmult_lt_reg_l with (INR (2 * S n)). - apply lt_INR_0; replace (2 * S n)%nat with (S (S (2 * n))); [ apply Nat.lt_0_succ | ring ]. - rewrite Rinv_r. + rewrite Rmult_1_r. apply (lt_INR 1). nia. + apply not_O_INR; discriminate. } cut (/ INR (2 * S n + 1) < eps). { intro; rewrite <- (Rmult_1_l eps); rewrite (Rmult_comm (/ INR (2 * S n + 1))); apply Rmult_gt_0_lt_compat; try assumption. - change (0 < / INR (2 * S n + 1)); apply Rinv_0_lt_compat; apply lt_INR_0; nia. - apply Rlt_0_1. } assert (x < 2 * S n + 1)%nat by nia. assert (H5 := lt_INR _ _ H4); apply Rlt_trans with (/ INR x). { apply Rinv_lt_contravar. - apply Rmult_lt_0_compat;apply lt_INR_0; nia. - assumption. } elim H1; intros; assumption. Qed. Lemma sin_no_R0 : forall n:nat, sin_n n <> 0. Proof. intro; unfold sin_n; unfold Rdiv; apply prod_neq_R0. - apply pow_nonzero; discrR. - apply Rinv_neq_0_compat; apply INR_fact_neq_0. Qed. (**********) Definition sin_in (x l:R) : Prop := infinite_sum (fun i:nat => sin_n i * x ^ i) l. (**********) Lemma exist_sin : forall x:R, { l:R | sin_in x l }. Proof. intro; generalize (Alembert_C3 sin_n x sin_no_R0 Alembert_sin). unfold Pser, sin_n; trivial. Defined. (***********************) (* Definition of sinus *) Definition sin (x:R) : R := let (a,_) := exist_sin (Rsqr x) in x * a. (*********************************************) (** * Properties *) (*********************************************) Lemma cos_sym : forall x:R, cos x = cos (- x). Proof. intros; unfold cos; replace (Rsqr (- x)) with (Rsqr x). - reflexivity. - apply Rsqr_neg. Qed. Lemma sin_antisym : forall x:R, sin (- x) = - sin x. Proof. intro; unfold sin; replace (Rsqr (- x)) with (Rsqr x); [ idtac | apply Rsqr_neg ]. case (exist_sin (Rsqr x)); intros; ring. Qed. Lemma sin_0 : sin 0 = 0. Proof. unfold sin; case (exist_sin (Rsqr 0)). intros; ring. Qed. (* Value of [cos 0] *) Lemma cos_0 : cos 0 = 1. Proof. cut (cos_in 0 1). - cut (cos_in 0 (cos 0)). + apply uniqueness_sum. + rewrite <- Rsqr_0 at 1. exact (proj2_sig (exist_cos (Rsqr 0))). - unfold cos_in; unfold infinite_sum; intros; exists 0%nat. intros. unfold Rdist. induction n as [| n Hrecn]. + unfold cos_n; simpl. unfold Rdiv; rewrite Rinv_1. do 2 rewrite Rmult_1_r. unfold Rminus; rewrite Rplus_opp_r; rewrite Rabs_R0; assumption. + rewrite tech5. replace (cos_n (S n) * 0 ^ S n) with 0. * rewrite Rplus_0_r. apply Hrecn; unfold ge; apply Nat.le_0_l. * simpl; ring. Qed. coq-8.20.0/theories/Reals/Rtrigo_facts.v000066400000000000000000000151411466560755400201140ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * INRIA, CNRS and contributors - Copyright 1999-2019 *) (* =0 -> cos x = sqrt(1 - (sin x)²). Proof. intros x H. apply Rsqr_inj. - lra. - apply sqrt_pos. - rewrite Rsqr_sqrt. + apply cos2. + pose proof sin2_bound x. lra. Qed. Lemma cos_sin_opp : forall x, cos x <=0 -> cos x = - sqrt(1 - (sin x)²). Proof. intros x H. rewrite <- (Ropp_involutive (cos x)). apply Ropp_eq_compat. apply Rsqr_inj. - lra. - apply sqrt_pos. - rewrite Rsqr_sqrt. + rewrite <- Rsqr_neg. apply cos2. + pose proof sin2_bound x. lra. Qed. Lemma cos_sin_Rabs : forall x, Rabs (cos x) = sqrt(1 - (sin x)²). Proof. intros x. unfold Rabs. destruct (Rcase_abs (cos x)). - rewrite <- (Ropp_involutive (sqrt (1 - (sin x)²))). apply Ropp_eq_compat. apply cos_sin_opp; lra. - apply cos_sin; assumption. Qed. Lemma sin_cos : forall x, sin x >=0 -> sin x = sqrt(1 - (cos x)²). Proof. intros x H. apply Rsqr_inj. - lra. - apply sqrt_pos. - rewrite Rsqr_sqrt. + apply sin2. + pose proof cos2_bound x. lra. Qed. Lemma sin_cos_opp : forall x, sin x <=0 -> sin x = - sqrt(1 - (cos x)²). Proof. intros x H. rewrite <- (Ropp_involutive (sin x)). apply Ropp_eq_compat. apply Rsqr_inj. - lra. - apply sqrt_pos. - rewrite Rsqr_sqrt. + rewrite <- Rsqr_neg. apply sin2. + pose proof cos2_bound x. lra. Qed. Lemma sin_cos_Rabs : forall x, Rabs (sin x) = sqrt(1 - (cos x)²). Proof. intros x. unfold Rabs. destruct (Rcase_abs (sin x)). - rewrite <- ( Ropp_involutive (sqrt (1 - (cos x)²))). apply Ropp_eq_compat. apply sin_cos_opp; lra. - apply sin_cos; assumption. Qed. (** ** Express tan with sin and cos *) Lemma tan_sin : forall x, 0 <= cos x -> tan x = sin x / sqrt (1 - (sin x)²). Proof. intros x H. unfold tan. rewrite <- (sqrt_Rsqr (cos x)) by assumption. rewrite <- (cos2 x). reflexivity. Qed. Lemma tan_sin_opp : forall x, 0 > cos x -> tan x = - (sin x / sqrt (1 - (sin x)²)). Proof. intros x H. unfold tan. rewrite cos_sin_opp by lra. apply Rdiv_opp_r. Qed. (** Note: tan_sin_Rabs wouldn't make a lot of sense, because one would need Rabs on both sides *) Lemma tan_cos : forall x, 0 <= sin x -> tan x = sqrt (1 - (cos x)²) / cos x. Proof. intros x H. unfold tan. rewrite <- (sqrt_Rsqr (sin x)) by assumption. rewrite <- (sin2 x). reflexivity. Qed. Lemma tan_cos_opp : forall x, 0 >= sin x -> tan x = - sqrt (1 - (cos x)²) / cos x. Proof. intros x H. unfold tan. rewrite sin_cos_opp by lra. reflexivity. Qed. (** ** Express sin and cos with tan *) Lemma sin_tan : forall x, 0 < cos x -> sin x = tan x / sqrt (1 + (tan x)²). Proof. intros. assert(Hcosle:0<=cos x) by lra. pose proof tan_sin x Hcosle as Htan. pose proof (sin2 x); pose proof Rsqr_pos_lt (cos x). rewrite Htan. unfold Rdiv at 1 2. rewrite Rmult_assoc, <- Rinv_mult. rewrite <- sqrt_mult_alt by lra. rewrite Rsqr_div', Rsqr_sqrt by lra. field_simplify ((1 - (sin x)²) * (1 + (sin x)² / (1 - (sin x)²))). - rewrite sqrt_1. field. - lra. Qed. Lemma cos_tan : forall x, 0 < cos x -> cos x = 1 / sqrt (1 + (tan x)²). Proof. intros. destruct (Rcase_abs (sin x)) as [Hsignsin|Hsignsin]. - assert(Hsinle:0>=sin x) by lra. pose proof tan_cos_opp x Hsinle as Htan. rewrite Htan. rewrite Rsqr_div'. rewrite <- Rsqr_neg. pose proof cos2_bound x. pose proof Rsqr_pos_lt (cos x) ltac:(lra). pose proof sqrt_lt_R0 (cos x)² ltac:(assumption). rewrite Rsqr_sqrt. 2:lra. field_simplify( 1 + (1 - (cos x)²) / (cos x)² ). 2:lra. rewrite sqrt_div_alt. 2:lra. rewrite sqrt_1. field_simplify_eq. 2:lra. rewrite sqrt_Rsqr;lra. - assert(Hsinge:0<=sin x) by lra. pose proof tan_cos x Hsinge as Htan. rewrite Htan. rewrite Rsqr_div'. pose proof cos2_bound x. pose proof Rsqr_pos_lt (cos x) ltac:(lra). pose proof sqrt_lt_R0 (cos x)² ltac:(assumption). rewrite Rsqr_sqrt. 2:lra. field_simplify( 1 + (1 - (cos x)²) / (cos x)² ). 2:lra. rewrite sqrt_div_alt. 2:lra. rewrite sqrt_1. field_simplify_eq. 2:lra. rewrite sqrt_Rsqr;lra. Qed. (*********************************************************) (** * Additional shift lemmas for sin, cos, tan *) (*********************************************************) Lemma sin_pi_minus : forall x, sin (PI - x) = sin x. Proof. intros x. rewrite sin_minus, cos_PI, sin_PI. ring. Qed. Lemma sin_pi_plus : forall x, sin (PI + x) = - sin x. Proof. intros x. rewrite sin_plus, cos_PI, sin_PI. ring. Qed. Lemma cos_pi_minus : forall x, cos (PI - x) = - cos x. Proof. intros x. rewrite cos_minus, cos_PI, sin_PI. ring. Qed. Lemma cos_pi_plus : forall x, cos (PI + x) = - cos x. Proof. intros x. rewrite cos_plus, cos_PI, sin_PI. ring. Qed. Lemma tan_pi_minus : forall x, cos x <> 0 -> tan (PI - x) = - tan x. Proof. intros x H. unfold tan; rewrite sin_pi_minus, cos_pi_minus. field; assumption. Qed. Lemma tan_pi_plus : forall x, cos x <> 0 -> tan (PI + x) = tan x. Proof. intros x H. unfold tan; rewrite sin_pi_plus, cos_pi_plus. field; assumption. Qed. coq-8.20.0/theories/Reals/Rtrigo_fun.v000066400000000000000000000132271466560755400176070ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* Rabs (/ INR (fact (S n)) * / / INR (fact n))) 0. Proof. unfold Un_cv; intros; destruct (Rgt_dec eps 1) as [Hgt|Hnotgt]. - split with 0%nat; intros; rewrite (simpl_fact n); unfold Rdist; rewrite (Rminus_0_r (Rabs (/ INR (S n)))); rewrite (Rabs_Rabsolu (/ INR (S n))); cut (/ INR (S n) > 0). + intro; rewrite (Rabs_pos_eq (/ INR (S n))). * cut (/ eps - 1 < 0). -- intro H2; generalize (Rlt_le_trans (/ eps - 1) 0 (INR n) H2 (pos_INR n)); clear H2; intro; unfold Rminus in H2; generalize (Rplus_lt_compat_l 1 (/ eps + -1) (INR n) H2); replace (1 + (/ eps + -1)) with (/ eps); [ clear H2; intro | ring ]. rewrite (Rplus_comm 1 (INR n)) in H2; rewrite <- (S_INR n) in H2; generalize (Rmult_gt_0_compat (/ INR (S n)) eps H1 H); intro; unfold Rgt in H3; generalize (Rmult_lt_compat_l (/ INR (S n) * eps) (/ eps) (INR (S n)) H3 H2); intro; rewrite (Rmult_assoc (/ INR (S n)) eps (/ eps)) in H4; rewrite (Rinv_r eps (Rlt_dichotomy_converse eps 0 (or_intror (eps < 0) H))) in H4; rewrite (let (H1, H2) := Rmult_ne (/ INR (S n)) in H1) in H4; rewrite (Rmult_comm (/ INR (S n))) in H4; rewrite (Rmult_assoc eps (/ INR (S n)) (INR (S n))) in H4; rewrite (Rinv_l (INR (S n)) (not_O_INR (S n) (not_eq_sym (O_S n)))) in H4; rewrite (let (H1, H2) := Rmult_ne eps in H1) in H4; assumption. -- apply Rlt_minus; unfold Rgt in Hgt; rewrite <- Rinv_1; apply (Rinv_lt_contravar 1 eps); auto; rewrite (let (H1, H2) := Rmult_ne eps in H2); unfold Rgt in H; assumption. * unfold Rgt in H1; apply Rlt_le; assumption. + unfold Rgt; apply Rinv_0_lt_compat; apply lt_INR_0; apply Nat.lt_0_succ. - cut (0 <= up (/ eps - 1))%Z. + intro; elim (IZN (up (/ eps - 1)) H0); intros; split with x; intros; rewrite (simpl_fact n); unfold Rdist; rewrite (Rminus_0_r (Rabs (/ INR (S n)))); rewrite (Rabs_Rabsolu (/ INR (S n))); cut (/ INR (S n) > 0). * intro; rewrite (Rabs_pos_eq (/ INR (S n))). -- cut (/ eps - 1 < INR x). ++ intro ; generalize (Rlt_le_trans (/ eps - 1) (INR x) (INR n) H4 (le_INR x n H2)); clear H4; intro; unfold Rminus in H4; generalize (Rplus_lt_compat_l 1 (/ eps + -1) (INR n) H4); replace (1 + (/ eps + -1)) with (/ eps); [ clear H4; intro | ring ]. rewrite (Rplus_comm 1 (INR n)) in H4; rewrite <- (S_INR n) in H4; generalize (Rmult_gt_0_compat (/ INR (S n)) eps H3 H); intro; unfold Rgt in H5; generalize (Rmult_lt_compat_l (/ INR (S n) * eps) (/ eps) (INR (S n)) H5 H4); intro; rewrite (Rmult_assoc (/ INR (S n)) eps (/ eps)) in H6; rewrite (Rinv_r eps (Rlt_dichotomy_converse eps 0 (or_intror (eps < 0) H))) in H6; rewrite (let (H1, H2) := Rmult_ne (/ INR (S n)) in H1) in H6; rewrite (Rmult_comm (/ INR (S n))) in H6; rewrite (Rmult_assoc eps (/ INR (S n)) (INR (S n))) in H6; rewrite (Rinv_l (INR (S n)) (not_O_INR (S n) (not_eq_sym (O_S n)))) in H6; rewrite (let (H1, H2) := Rmult_ne eps in H1) in H6; assumption. ++ cut (IZR (up (/ eps - 1)) = IZR (Z.of_nat x)); [ intro | rewrite H1; trivial ]. elim (archimed (/ eps - 1)); intros; clear H6; unfold Rgt in H5; rewrite H4 in H5; rewrite INR_IZR_INZ; assumption. -- unfold Rgt in H1; apply Rlt_le; assumption. * unfold Rgt; apply Rinv_0_lt_compat; apply lt_INR_0; apply Nat.lt_0_succ. + apply (le_O_IZR (up (/ eps - 1))); apply (Rle_trans 0 (/ eps - 1) (IZR (up (/ eps - 1)))). * generalize (Rnot_gt_le eps 1 Hnotgt); clear Hnotgt; unfold Rle; intro; elim H0; clear H0; intro. -- left; unfold Rgt in H; generalize (Rmult_lt_compat_l (/ eps) eps 1 (Rinv_0_lt_compat eps H) H0); rewrite (Rinv_l eps (not_eq_sym (Rlt_dichotomy_converse 0 eps (or_introl (0 > eps) H)))) ; rewrite (let (H1, H2) := Rmult_ne (/ eps) in H1); intro; fold (/ eps - 1 > 0); apply Rgt_minus; unfold Rgt; assumption. -- right; rewrite H0; rewrite Rinv_1; symmetry; apply Rminus_diag_eq; auto. * elim (archimed (/ eps - 1)); intros; clear H1; unfold Rgt in H0; apply Rlt_le; assumption. Qed. coq-8.20.0/theories/Reals/Rtrigo_reg.v000066400000000000000000000361301466560755400175720ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* R -> R, fn = (fun (N:nat) (x:R) => (-1) ^ N / INR (fact (2 * N + 1)) * x ^ (2 * N)) -> CVN_R fn. Proof. unfold CVN_R; unfold CVN_r; intros fn H r. exists (fun n:nat => / INR (fact (2 * n + 1)) * r ^ (2 * n)). cut { l:R | Un_cv (fun n:nat => sum_f_R0 (fun k:nat => Rabs (/ INR (fact (2 * k + 1)) * r ^ (2 * k))) n) l }. { intros (x,p). exists x. split. { apply p. } intros; rewrite H; unfold Rdiv; do 2 rewrite Rabs_mult; rewrite pow_1_abs; rewrite Rmult_1_l. assert (0 < / INR (fact (2 * n + 1))). { apply Rinv_0_lt_compat; apply INR_fact_lt_0. } rewrite (Rabs_right _ (Rle_ge _ _ (Rlt_le _ _ H1))). apply Rmult_le_compat_l. { left; apply H1. } rewrite <- RPow_abs; apply pow_maj_Rabs. rewrite Rabs_Rabsolu; unfold Boule in H0; rewrite Rminus_0_r in H0; left; apply H0. } assert ((r:R) <> 0). { assert (H0 := cond_pos r); red; intro; rewrite H1 in H0; elim (Rlt_irrefl _ H0). } apply Alembert_C2. { intro; apply Rabs_no_R0. apply prod_neq_R0. { apply Rinv_neq_0_compat; apply INR_fact_neq_0. } apply pow_nonzero; assumption. } assert (H1 := Alembert_sin). unfold sin_n in H1; unfold Un_cv in H1; unfold Un_cv; intros. assert (0 < eps / Rsqr r). { unfold Rdiv; apply Rmult_lt_0_compat; [ assumption | apply Rinv_0_lt_compat; apply Rsqr_pos_lt; assumption ]. } elim (H1 _ H3); intros N0 H4. exists N0; intros. unfold Rdist; assert (H6 := H4 _ H5). unfold Rdist in H5; replace (Rabs (Rabs (/ INR (fact (2 * S n + 1)) * r ^ (2 * S n)) / Rabs (/ INR (fact (2 * n + 1)) * r ^ (2 * n)))) with (Rsqr r * Rabs ((-1) ^ S n / INR (fact (2 * S n + 1)) / ((-1) ^ n / INR (fact (2 * n + 1))))). { apply Rmult_lt_reg_l with (/ Rsqr r). { apply Rinv_0_lt_compat; apply Rsqr_pos_lt; assumption. } pattern (/ Rsqr r) at 1; rewrite <- (Rabs_right (/ Rsqr r)). 2:{ apply Rle_ge; left; apply Rinv_0_lt_compat; apply Rsqr_pos_lt; assumption. } rewrite <- Rabs_mult. rewrite Rmult_minus_distr_l. rewrite Rmult_0_r; rewrite <- Rmult_assoc; rewrite Rinv_l. 2:{ unfold Rsqr; apply prod_neq_R0; assumption. } rewrite Rmult_1_l; rewrite <- (Rmult_comm eps). apply H6. } unfold Rdiv; rewrite (Rmult_comm (Rsqr r)); repeat rewrite Rabs_mult; rewrite Rabs_Rabsolu; rewrite pow_1_abs. rewrite Rmult_1_l. repeat rewrite Rmult_assoc; apply Rmult_eq_compat_l. rewrite Rinv_mult. rewrite Rinv_inv. rewrite Rabs_mult. rewrite Rabs_inv. rewrite pow_1_abs; rewrite Rinv_1; rewrite Rmult_1_l. rewrite Rinv_mult. rewrite <- Rabs_inv. rewrite Rinv_inv. rewrite Rabs_mult. do 2 rewrite Rabs_Rabsolu. rewrite (Rmult_comm (Rabs (r ^ (2 * S n)))). rewrite Rmult_assoc; apply Rmult_eq_compat_l. rewrite Rabs_inv. rewrite Rabs_Rabsolu. repeat rewrite Rabs_right. 2,3:apply Rle_ge; apply pow_le; left; apply (cond_pos r). replace (r ^ (2 * S n)) with (r ^ (2 * n) * r * r). 2:{ replace (2 * S n)%nat with (S (S (2 * n)));simpl;ring. } do 2 rewrite <- Rmult_assoc. rewrite Rinv_l. 2:{ apply pow_nonzero; assumption. } unfold Rsqr; ring. Qed. (** (sin h)/h -> 1 when h -> 0 *) Lemma derivable_pt_lim_sin_0 : derivable_pt_lim sin 0 1. Proof. unfold derivable_pt_lim; intros. set (fn := fun (N:nat) (x:R) => (-1) ^ N / INR (fact (2 * N + 1)) * x ^ (2 * N)). assert (CVN_R fn) by (apply CVN_R_sin; unfold fn; reflexivity). assert (cv:forall x:R, { l:R | Un_cv (fun N:nat => SP fn N x) l }) by apply (CVN_R_CVS _ X). set (r := mkposreal _ Rlt_0_1). assert (CVN_r fn r) by apply (X r). assert (forall (n:nat) (y:R), Boule 0 r y -> continuity_pt (fn n) y). { intros; unfold fn; replace (fun x:R => (-1) ^ n / INR (fact (2 * n + 1)) * x ^ (2 * n)) with (fct_cte ((-1) ^ n / INR (fact (2 * n + 1))) * pow_fct (2 * n))%F; [ idtac | reflexivity ]. apply continuity_pt_mult. - apply derivable_continuous_pt. apply derivable_pt_const. - apply derivable_continuous_pt. apply (derivable_pt_pow (2 * n) y). } assert (Boule 0 r 0). { unfold Boule; unfold Rminus; rewrite Ropp_0; rewrite Rplus_0_r; rewrite Rabs_R0; apply (cond_pos r). } assert (H2 := SFL_continuity_pt _ cv _ X0 H0 _ H1). unfold continuity_pt in H2; unfold continue_in in H2; unfold limit1_in in H2; unfold limit_in in H2; simpl in H2; unfold Rdist in H2. elim (H2 _ H); intros alp H3. elim H3; intros. exists (mkposreal _ H4). simpl; intros. rewrite sin_0; rewrite Rplus_0_l; unfold Rminus; rewrite Ropp_0; rewrite Rplus_0_r. assert (Rabs (SFL fn cv h - SFL fn cv 0) < eps). { apply H5. split. - unfold D_x, no_cond; split. + trivial. + apply (not_eq_sym (A:=R)); apply H6. - unfold Rminus; rewrite Ropp_0; rewrite Rplus_0_r; apply H7. } assert (SFL fn cv 0 = 1). { unfold SFL, sin. case (cv 0) as (?,HUn). eapply UL_sequence. - apply HUn. - unfold SP, fn; unfold Un_cv; intros; exists 1%nat; intros. unfold Rdist; replace (sum_f_R0 (fun k:nat => (-1) ^ k / INR (fact (2 * k + 1)) * 0 ^ (2 * k)) n) with 1. + unfold Rminus; rewrite Rplus_opp_r; rewrite Rabs_R0; assumption. + rewrite decomp_sum. * simpl; rewrite Rmult_1_r; unfold Rdiv; rewrite Rinv_1; rewrite Rmult_1_r; pattern 1 at 1; rewrite <- Rplus_0_r; apply Rplus_eq_compat_l. symmetry ; apply sum_eq_R0; intros. rewrite Rmult_0_l; rewrite Rmult_0_r; reflexivity. * unfold ge in H10; apply Nat.lt_le_trans with 1%nat; [ apply Nat.lt_succ_diag_r | apply H10 ]. } cut (SFL fn cv h = sin h / h). { intro; rewrite H9 in H8; rewrite H10 in H8. apply H8. } unfold SFL, sin. case (cv h) as (x,HUn). case (exist_sin (Rsqr h)) as (x0,Hsin). unfold Rdiv; rewrite (Rmult_inv_r_id_m h x0 H6). eapply UL_sequence. - apply HUn. - unfold sin_in in Hsin; unfold sin_n, infinite_sum in Hsin; unfold SP, fn, Un_cv; intros. elim (Hsin _ H10); intros N0 H11. exists N0; intros. unfold Rdist; unfold Rdist in H11. replace (sum_f_R0 (fun k:nat => (-1) ^ k / INR (fact (2 * k + 1)) * h ^ (2 * k)) n) with (sum_f_R0 (fun i:nat => (-1) ^ i / INR (fact (2 * i + 1)) * Rsqr h ^ i) n). + apply H11; assumption. + apply sum_eq; intros; apply Rmult_eq_compat_l; unfold Rsqr; rewrite pow_sqr; reflexivity. Qed. (** ((cos h)-1)/h -> 0 when h -> 0 *) Lemma derivable_pt_lim_cos_0 : derivable_pt_lim cos 0 0. Proof. unfold derivable_pt_lim; intros. assert (H0 := derivable_pt_lim_sin_0). unfold derivable_pt_lim in H0. assert (0 < eps / 2) by lra. elim (H0 _ H1); intros del H2. assert (continuity_pt sin 0) by apply continuity_sin. unfold continuity_pt in H3; unfold continue_in in H3; unfold limit1_in in H3; unfold limit_in in H3; simpl in H3; unfold Rdist in H3. cut (0 < eps / 2); [ intro | assumption ]. elim (H3 _ H4); intros del_c H5. assert (0 < Rmin del del_c). { unfold Rmin; case (Rle_dec del del_c); intro. - apply (cond_pos del). - elim H5; intros; assumption. } set (delta := mkposreal _ H6). exists delta; intros. rewrite Rplus_0_l; replace (cos h - cos 0) with (-2 * Rsqr (sin (h / 2))). 2:{ pattern h at 2; replace h with (2 * (h / 2)) by field. rewrite (cos_2a_sin (h / 2)). rewrite cos_0; unfold Rsqr; ring. } unfold Rminus; rewrite Ropp_0; rewrite Rplus_0_r. change (-2) with (-(2)). unfold Rdiv; do 2 rewrite Ropp_mult_distr_l_reverse. rewrite Rabs_Ropp. replace (2 * Rsqr (sin (h * / 2)) * / h) with (sin (h / 2) * (sin (h / 2) / (h / 2) - 1) + sin (h / 2)). 2:{ rewrite Rmult_minus_distr_l; rewrite Rmult_1_r; unfold Rminus; rewrite Rplus_assoc; rewrite Rplus_opp_l; rewrite Rplus_0_r; rewrite (Rmult_comm 2); unfold Rdiv, Rsqr. field. assumption. } apply Rle_lt_trans with (Rabs (sin (h / 2) * (sin (h / 2) / (h / 2) - 1)) + Rabs (sin (h / 2))). { apply Rabs_triang. } rewrite <-(Rplus_half_diag eps); apply Rplus_lt_compat. - apply Rle_lt_trans with (Rabs (sin (h / 2) / (h / 2) - 1)). { rewrite Rabs_mult; rewrite Rmult_comm; pattern (Rabs (sin (h / 2) / (h / 2) - 1)) at 2; rewrite <- Rmult_1_r; apply Rmult_le_compat_l. { apply Rabs_pos. } pose proof (SIN_bound (h/2));unfold Rabs. destruct (Rcase_abs _);lra. } cut (Rabs (h / 2) < del). { intro; assert (h / 2 <> 0) by lra. assert (H11 := H2 _ H10 H9). rewrite Rplus_0_l in H11; rewrite sin_0 in H11. rewrite Rminus_0_r in H11; apply H11. } apply Rlt_trans with (del / 2). 2:pose proof (cond_pos del);lra. unfold Rdiv; rewrite Rabs_mult. rewrite (Rabs_right (/ 2)). 2:lra. do 2 rewrite <- (Rmult_comm (/ 2)); apply Rmult_lt_compat_l. { lra. } apply Rlt_le_trans with (pos delta). { assumption. } unfold delta; simpl; apply Rmin_l. - elim H5; intros; assert (H11 := H10 (h / 2)). rewrite sin_0 in H11; do 2 rewrite Rminus_0_r in H11. apply H11. split. { unfold D_x, no_cond; split;lra. } apply Rlt_trans with (del_c / 2). 2:{ lra. } unfold Rdiv; rewrite Rabs_mult. rewrite (Rabs_right (/ 2)). 2:lra. do 2 rewrite <- (Rmult_comm (/ 2)). apply Rmult_lt_compat_l. { lra. } apply Rlt_le_trans with (pos delta). + assumption. + unfold delta; simpl; apply Rmin_r. Qed. (**********) Theorem derivable_pt_lim_sin : forall x:R, derivable_pt_lim sin x (cos x). Proof. intro; assert (H0 := derivable_pt_lim_sin_0). assert (H := derivable_pt_lim_cos_0). unfold derivable_pt_lim in H0, H. unfold derivable_pt_lim; intros. cut (0 < eps / 2); [ intro | unfold Rdiv; apply Rmult_lt_0_compat; [ apply H1 | apply Rinv_0_lt_compat; prove_sup0 ] ]. elim (H0 _ H2); intros alp1 H3. elim (H _ H2); intros alp2 H4. set (alp := Rmin alp1 alp2). assert (0 < alp). { unfold alp; unfold Rmin; case (Rle_dec alp1 alp2); intro. - apply (cond_pos alp1). - apply (cond_pos alp2). } exists (mkposreal _ H5); intros. replace ((sin (x + h) - sin x) / h - cos x) with (sin x * ((cos h - 1) / h) + cos x * (sin h / h - 1)). 2:{ rewrite sin_plus; now field. } eapply Rle_lt_trans. { apply Rabs_triang. } rewrite <-(Rplus_half_diag eps); apply Rplus_lt_compat. - apply Rle_lt_trans with (Rabs ((cos h - 1) / h)). + rewrite Rabs_mult; rewrite Rmult_comm; pattern (Rabs ((cos h - 1) / h)) at 2; rewrite <- Rmult_1_r; apply Rmult_le_compat_l. { apply Rabs_pos. } pose proof (SIN_bound x). unfold Rabs; case (Rcase_abs (sin x)); lra. + assert (Rabs h < alp2). { apply Rlt_le_trans with alp. - apply H7. - unfold alp; apply Rmin_r. } assert (H9 := H4 _ H6 H8). rewrite cos_0 in H9; rewrite Rplus_0_l in H9; rewrite Rminus_0_r in H9; apply H9. - apply Rle_lt_trans with (Rabs (sin h / h - 1)). + rewrite Rabs_mult; rewrite Rmult_comm; pattern (Rabs (sin h / h - 1)) at 2; rewrite <- Rmult_1_r; apply Rmult_le_compat_l. { apply Rabs_pos. } pose proof (COS_bound x). unfold Rabs; case (Rcase_abs (cos x)); lra. + assert (Rabs h < alp1). { apply Rlt_le_trans with alp. - apply H7. - unfold alp; apply Rmin_l. } assert (H9 := H3 _ H6 H8). rewrite sin_0 in H9; rewrite Rplus_0_l in H9; rewrite Rminus_0_r in H9; apply H9. Qed. Lemma derivable_pt_lim_cos : forall x:R, derivable_pt_lim cos x (- sin x). Proof. intro; cut (forall h:R, sin (h + PI / 2) = cos h). - intro; replace (- sin x) with (cos (x + PI / 2) * (1 + 0)). + generalize (derivable_pt_lim_comp (id + fct_cte (PI / 2))%F sin); intros. cut (derivable_pt_lim (id + fct_cte (PI / 2)) x (1 + 0)). * cut (derivable_pt_lim sin ((id + fct_cte (PI / 2))%F x) (cos (x + PI / 2))). -- intros; generalize (H0 _ _ _ H2 H1); replace (comp sin (id + fct_cte (PI / 2))%F) with (fun x:R => sin (x + PI / 2)); [ idtac | reflexivity ]. unfold derivable_pt_lim; intros. elim (H3 eps H4); intros. exists x0. intros; rewrite <- (H (x + h)); rewrite <- (H x); apply H5; assumption. -- apply derivable_pt_lim_sin. * apply derivable_pt_lim_plus. -- apply derivable_pt_lim_id. -- apply derivable_pt_lim_const. + rewrite sin_cos; rewrite <- (Rplus_comm x); ring. - intro; rewrite cos_sin; rewrite Rplus_comm; reflexivity. Qed. Lemma derivable_pt_sin : forall x:R, derivable_pt sin x. Proof. unfold derivable_pt; intro. exists (cos x). apply derivable_pt_lim_sin. Qed. Lemma derivable_pt_cos : forall x:R, derivable_pt cos x. Proof. unfold derivable_pt; intro. exists (- sin x). apply derivable_pt_lim_cos. Qed. Lemma derivable_sin : derivable sin. Proof. unfold derivable; intro; apply derivable_pt_sin. Qed. Lemma derivable_cos : derivable cos. Proof. unfold derivable; intro; apply derivable_pt_cos. Qed. Lemma derive_pt_sin : forall x:R, derive_pt sin x (derivable_pt_sin _) = cos x. Proof. intros; apply derive_pt_eq_0. apply derivable_pt_lim_sin. Qed. Lemma derive_pt_cos : forall x:R, derive_pt cos x (derivable_pt_cos _) = - sin x. Proof. intros; apply derive_pt_eq_0. apply derivable_pt_lim_cos. Qed. coq-8.20.0/theories/Reals/Runcountable.v000066400000000000000000000472221466560755400201340ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* A) (v : A -> nat) : Prop := (forall x : A, u (v x) = x) /\ (forall n : nat, v (u n) = n). Definition in_holed_interval (a b hole : R) (u : nat -> R) (n : nat) : Prop := Rlt a (u n) /\ Rlt (u n) b /\ u n <> hole. (* Here we use axiom total_order_T, which is not constructive *) Lemma in_holed_interval_dec (a b h : R) (u : nat -> R) (n : nat) : {in_holed_interval a b h u n} + {~in_holed_interval a b h u n}. Proof. destruct (total_order_T a (u n)) as [[l|e]|hi]. - destruct (total_order_T b (u n)) as [[lb|eb]|hb]. + right. intro H. destruct H. destruct H0. apply Rlt_asym in H0. contradiction. + subst. right. intro H. destruct H. destruct H0. pose proof (Rlt_asym (u n) (u n) H0). contradiction. + destruct (Req_dec_T h (u n)). * subst. right. intro H. destruct H. destruct H0. exact (H1 eq_refl). * left. split. -- assumption. -- split. ++ assumption. ++ intro H. subst. exact (n0 eq_refl). - subst. right. intro H. destruct H. pose proof (Rlt_asym (u n) (u n) H). contradiction. - right. intro H. destruct H. apply Rlt_asym in H. contradiction. Qed. Definition point_in_holed_interval (a b h : R) : R := if Req_dec_T h (Rdiv (Rplus a b) (INR 2)) then (Rdiv (Rplus a h) (INR 2)) else (Rdiv (Rplus a b) (INR 2)). Lemma middle_in_interval : forall a b : R, Rlt a b -> (a < (a + b) / INR 2 < b)%R. Proof. intros. assert (twoNotZero: INR 2 <> 0%R). { apply not_0_INR. intro abs. inversion abs. } assert (twoAboveZero : (0 < / INR 2)%R). { apply Rinv_0_lt_compat. apply lt_0_INR. apply le_n_S. apply le_S. apply le_n. } assert (double : forall x : R, Rplus x x = ((INR 2) * x)%R) by now intros x; rewrite S_INR, INR_1, Rmult_plus_distr_r, Rmult_1_l. split. - assert (a + a < a + b)%R. { apply (Rplus_lt_compat_l a a b). assumption. } rewrite -> double in H0. apply (Rmult_lt_compat_l (/ (INR 2))) in H0. + rewrite <- Rmult_assoc in H0. rewrite -> Rinv_l in H0. * simpl in H0. rewrite -> Rmult_1_l in H0. rewrite -> Rmult_comm in H0. assumption. * assumption. + assumption. - assert (b + a < b + b)%R. { apply (Rplus_lt_compat_l b a b). assumption. } rewrite -> Rplus_comm in H0. rewrite -> double in H0. apply (Rmult_lt_compat_l (/ (INR 2))) in H0. + rewrite <- Rmult_assoc in H0. rewrite -> Rinv_l in H0. * simpl in H0. rewrite -> Rmult_1_l in H0. rewrite -> Rmult_comm in H0. assumption. * assumption. + assumption. Qed. Lemma point_in_holed_interval_works (a b h : R) : Rlt a b -> let p := point_in_holed_interval a b h in Rlt a p /\ Rlt p b /\ p <> h. Proof. intros. unfold point_in_holed_interval in p. pose proof (middle_in_interval a b H). destruct H0. destruct (Req_dec_T h ((a + b) / INR 2)). - (* middle hole, p is quarter *) subst. pose proof (middle_in_interval a ((a + b) / INR 2) H0). destruct H2. split. + assumption. + split. * apply (Rlt_trans p ((a + b) / INR 2)%R). -- assumption. -- assumption. * apply Rlt_not_eq. assumption. - split. + assumption. + split. * assumption. * intro abs. subst. contradiction. Qed. (* An enumeration of R reaches any open interval of R, extract the first two real numbers in it. *) Definition first_in_holed_interval (u : nat -> R) (v : R -> nat) (a b h : R) : enumeration R u v -> Rlt a b -> { n : nat | in_holed_interval a b h u n /\ forall k : nat, in_holed_interval a b h u k -> n <= k }. Proof. intros. apply epsilon_smallest. - apply (in_holed_interval_dec a b h u). - exists (v (point_in_holed_interval a b h)). destruct H. unfold in_holed_interval. rewrite -> H. apply point_in_holed_interval_works. assumption. Defined. Lemma first_in_holed_interval_works (u : nat -> R) (v : R -> nat) (a b h : R) (pen : enumeration R u v) (plow : Rlt a b) : let (c,_) := first_in_holed_interval u v a b h pen plow in forall x:R, Rlt a x -> Rlt x b -> x <> h -> x <> u c -> c < v x. Proof. destruct (first_in_holed_interval u v a b h pen plow) as [c [_ beyond]]. destruct pen as [uv _]. intros x H H0 H1 x_uc. assert (ihi : in_holed_interval a b h u (v x)). { split. - rewrite -> uv. assumption. - rewrite -> uv. split; assumption. } destruct (proj1 (Nat.lt_eq_cases _ _) (beyond (v x) ihi)) as [lcvx | ecvx]. - exact lcvx. - exfalso. apply x_uc. rewrite ecvx. rewrite -> uv. reflexivity. Qed. Definition first_two_in_interval (u : nat -> R) (v : R -> nat) (a b : R) (pen : enumeration R u v) (plow : Rlt a b) : prod R R := let (first_index, pr) := first_in_holed_interval u v a b b pen plow in let (second_index, pr2) := first_in_holed_interval u v a b (u first_index) pen plow in if Rle_dec (u first_index) (u second_index) then (u first_index, u second_index) else (u second_index, u first_index). Lemma split_couple_eq : forall {a b c d : R}, (a,b) = (c,d) -> a = c /\ b = d. Proof. intros. injection H. intros. split. - subst. reflexivity. - subst. reflexivity. Qed. Lemma first_two_in_interval_works (u : nat -> R) (v : R -> nat) (a b : R) (pen : enumeration R u v) (plow : Rlt a b) : let (c,d) := first_two_in_interval u v a b pen plow in Rlt a c /\ Rlt c b /\ Rlt a d /\ Rlt d b /\ Rlt c d /\ (forall x:R, Rlt a x -> Rlt x b -> x <> c -> x <> d -> v c < v x). Proof. intros. destruct (first_two_in_interval u v a b) as [r r0] eqn:ft. unfold first_two_in_interval in ft. pose proof (first_in_holed_interval_works u v a b b pen plow) as Wb. destruct (first_in_holed_interval u v a b b pen plow) as [first_index pr]. pose proof (first_in_holed_interval_works u v a b (u first_index) pen plow) as Wu. destruct pr as [[H1 [H3 H4]] H2]. destruct (first_in_holed_interval u v a b (u first_index) pen plow) as [second_index pr2]. destruct pr2 as [[H5 [H7 diff]] H6]. destruct pen as [_ pen2]. destruct (Rle_dec (u first_index) (u second_index)) as [lfs | nlfs]. - destruct (split_couple_eq ft); subst; repeat (split; [assumption | idtac]); split. + destruct (Rle_lt_or_eq_dec _ _ lfs). * assumption. * exfalso. apply diff. symmetry. apply e. + intros. rewrite -> pen2. apply Wb; try assumption. apply Rlt_not_eq; assumption. - destruct (split_couple_eq ft); subst; repeat (split; [assumption | idtac]); split. + apply Rnot_le_lt, nlfs. + intros. rewrite -> pen2. apply Wu; assumption. Qed. (* If u,v is an enumeration of R, this sequence of open intervals tears the segment [0,1]. The recursive definition needs the proof that the previous interval is ordered, hence the type. The first sequence is increasing, the second decreasing. The first is below the second. Therefore the first sequence has a limit, a least upper bound b, that u cannot reach, which contradicts u (v b) = b. *) Definition tearing_sequences (u : nat -> R) (v : R -> nat) : (enumeration R u v) -> nat -> { ab : prod R R | Rlt (fst ab) (snd ab) }. Proof. intro pen. apply nat_rec. - exists (INR 0, INR 1). simpl. apply Rlt_0_1. - intros n [[a b] pr]. exists (first_two_in_interval u v a b pen pr). pose proof (first_two_in_interval_works u v a b pen pr). destruct (first_two_in_interval u v a b pen pr). apply H. Defined. Lemma tearing_sequences_projsig (u : nat -> R) (v : R -> nat) (en : enumeration R u v) (n : nat) : let (I,pr) := tearing_sequences u v en n in proj1_sig (tearing_sequences u v en (S n)) = first_two_in_interval u v (fst I) (snd I) en pr. Proof. simpl. destruct (tearing_sequences u v en n) as [[a b] pr]. simpl. reflexivity. Qed. (* The first tearing sequence in increasing, the second decreasing. That means the tearing sequences are nested intervals. *) Lemma tearing_sequences_inc_dec (u : nat -> R) (v : R -> nat) (pen : enumeration R u v) : forall n : nat, let I := proj1_sig (tearing_sequences u v pen n) in let SI := proj1_sig (tearing_sequences u v pen (S n)) in Rlt (fst I) (fst SI) /\ Rlt (snd SI) (snd I). Proof. intro n. simpl. destruct (tearing_sequences u v pen n) as [[a b] pr]. simpl. pose proof (first_two_in_interval_works u v a b pen pr). destruct (first_two_in_interval u v a b pen pr). simpl. split. - destruct H. assumption. - destruct H as [H1 [H2 [H3 [H4 H5]]]]. assumption. Qed. Lemma split_lt_succ : forall n m : nat, lt n (S m) -> lt n m \/ n = m. Proof. intros n m. generalize dependent n. induction m. - intros. destruct n. + right. reflexivity. + exfalso. inversion H. inversion H1. - intros. destruct n. + left. unfold lt. apply -> Nat.succ_le_mono; apply Nat.le_0_l. + apply Nat.lt_succ_lt_pred in H. simpl in H. specialize (IHm n H). destruct IHm. * left. apply -> Nat.succ_lt_mono. assumption. * subst. right. reflexivity. Qed. Lemma increase_seq_transit (u : nat -> R) : (forall n : nat, Rlt (u n) (u (S n))) -> (forall n m : nat, n < m -> Rlt (u n) (u m)). Proof. intros. induction m. - intros. inversion H0. - intros. destruct (split_lt_succ n m H0). + apply (Rlt_trans (u n) (u m)). * apply IHm. assumption. * apply H. + subst. apply H. Qed. Lemma decrease_seq_transit (u : nat -> R) : (forall n : nat, Rlt (u (S n)) (u n)) -> (forall n m : nat, n < m -> Rlt (u m) (u n)). Proof. intros. induction m. - intros. inversion H0. - intros. destruct (split_lt_succ n m H0). + apply (Rlt_trans (u (S m)) (u m)). * apply H. * apply IHm. assumption. + subst. apply H. Qed. (* Either increase the first sequence, or decrease the second sequence, until n = m and conclude by tearing_sequences_ordered *) Lemma tearing_sequences_ordered_forall (u : nat -> R) (v : R -> nat) (pen : enumeration R u v) : forall n m : nat, let In := proj1_sig (tearing_sequences u v pen n) in let Im := proj1_sig (tearing_sequences u v pen m) in Rlt (fst In) (snd Im). Proof. intros. destruct (tearing_sequences u v pen n) eqn:tn. simpl in In. destruct (tearing_sequences u v pen m) eqn:tm. simpl in Im. destruct (n ?= m) eqn:order. - apply Nat.compare_eq_iff in order. subst. rewrite -> tm in tn. inversion tn. subst. assumption. - apply Nat.compare_lt_iff in order. (* increase first sequence *) apply (Rlt_trans (fst In) (fst Im)). + remember (fun n => fst (proj1_sig (tearing_sequences u v pen n))) as fseq. pose proof (increase_seq_transit fseq). assert ((forall n : nat, (fseq n < fseq (S n))%R)). { intro n0. rewrite -> Heqfseq. pose proof (tearing_sequences_inc_dec u v pen n0). destruct (tearing_sequences u v pen (S n0)). simpl. destruct ((tearing_sequences u v pen n0)). apply H0. } specialize (H H0). rewrite -> Heqfseq in H. specialize (H n m order). rewrite -> tn in H. rewrite -> tm in H. simpl in H. apply H. + assumption. - apply Nat.compare_gt_iff in order. (* decrease second sequence *) apply (Rlt_trans (fst In) (snd In)). + assumption. + remember (fun n => snd (proj1_sig (tearing_sequences u v pen n))) as sseq. pose proof (decrease_seq_transit sseq). assert ((forall n : nat, (sseq (S n) < sseq n)%R)). { intro n0. rewrite -> Heqsseq. pose proof (tearing_sequences_inc_dec u v pen n0). destruct (tearing_sequences u v pen (S n0)). simpl. destruct ((tearing_sequences u v pen n0)). apply H0. } specialize (H H0). rewrite -> Heqsseq in H. specialize (H m n order). rewrite -> tn in H. rewrite -> tm in H. apply H. Qed. Definition tearing_elem_fst (u : nat -> R) (v : R -> nat) (pen : enumeration R u v) (x : R) := exists n : nat, x = fst (proj1_sig (tearing_sequences u v pen n)). (* The limit of the first tearing sequence cannot be reached by u *) Definition torn_number (u : nat -> R) (v : R -> nat) (pen : enumeration R u v) : {m : R | is_lub (tearing_elem_fst u v pen) m}. Proof. intros. assert (bound (tearing_elem_fst u v pen)). { exists (INR 1). intros x H0. destruct H0 as [n H0]. subst. left. apply (tearing_sequences_ordered_forall u v pen n 0). } apply (completeness (tearing_elem_fst u v pen) H). exists (INR 0). exists 0. reflexivity. Defined. Lemma torn_number_above_first_sequence (u : nat -> R) (v : R -> nat) (en : enumeration R u v) : forall n : nat, Rlt (fst (proj1_sig (tearing_sequences u v en n))) (proj1_sig (torn_number u v en)). Proof. intros. destruct (torn_number u v en) as [torn i]. simpl. destruct (Rlt_le_dec (fst (proj1_sig (tearing_sequences u v en n))) torn). - assumption. - exfalso. destruct i. (* Apply the first sequence once to make the inequality strict *) assert (Rlt torn (fst (proj1_sig (tearing_sequences u v en (S n))))). { apply (Rle_lt_trans torn (fst (proj1_sig (tearing_sequences u v en n)))). - assumption. - apply tearing_sequences_inc_dec. } clear r. specialize (H (fst (proj1_sig (tearing_sequences u v en (S n))))). assert (tearing_elem_fst u v en (fst (proj1_sig (tearing_sequences u v en (S n))))). { exists (S n). reflexivity. } specialize (H H2). assert (Rlt torn torn). { apply (Rlt_le_trans torn (fst (proj1_sig (tearing_sequences u v en (S n))))); assumption. } apply Rlt_irrefl in H3. contradiction. Qed. (* The torn number is between both tearing sequences, so it could have been chosen at each step. *) Lemma torn_number_below_second_sequence (u : nat -> R) (v : R -> nat) (en : enumeration R u v) : forall n : nat, Rlt (proj1_sig (torn_number u v en)) (snd (proj1_sig (tearing_sequences u v en n))). Proof. intros. destruct (torn_number u v en) as [torn i]. simpl. destruct (Rlt_le_dec torn (snd (proj1_sig (tearing_sequences u v en n)))) as [l|h]. - assumption. - exfalso. (* Apply the second sequence once to make the inequality strict *) assert (Rlt (snd (proj1_sig (tearing_sequences u v en (S n)))) torn). { apply (Rlt_le_trans (snd (proj1_sig (tearing_sequences u v en (S n)))) (snd (proj1_sig (tearing_sequences u v en n))) torn). - apply (tearing_sequences_inc_dec u v en n). - assumption. } clear h. (* Then prove snd (tearing_sequences u v (S n)) is an upper bound of the first sequence. It will yield the contradiction torn < torn. *) assert (is_upper_bound (tearing_elem_fst u v en) (snd (proj1_sig (tearing_sequences u v en (S n))))). { intros x H0. destruct H0. subst. left. apply tearing_sequences_ordered_forall. } destruct i. apply H2 in H0. pose proof (Rle_lt_trans torn (snd (proj1_sig (tearing_sequences u v en (S n)))) torn H0 H). apply Rlt_irrefl in H3. contradiction. Qed. (* Here is the contradiction : the torn number's index is above a sequence that tends to infinity *) Lemma limit_index_above_all_indices (u : nat -> R) (v : R -> nat) (en : enumeration R u v) : forall n : nat, v (fst (proj1_sig (tearing_sequences u v en (S n)))) < v (proj1_sig (torn_number u v en)). Proof. intros. simpl. destruct (tearing_sequences u v en n) as [[r r0] H] eqn:tear. (* The torn number was not chosen, so its index is above *) simpl. pose proof (first_two_in_interval_works u v r r0 en H). destruct (first_two_in_interval u v r r0) eqn:ft. simpl. assert (proj1_sig (tearing_sequences u v en (S n)) = (r1, r2)). { simpl. rewrite -> tear. assumption. } apply H0. - pose proof (torn_number_above_first_sequence u v en n). rewrite -> tear in H2. assumption. - pose proof (torn_number_below_second_sequence u v en n). rewrite -> tear in H2. assumption. - pose proof (torn_number_above_first_sequence u v en (S n)). rewrite -> H1 in H2. simpl in H2. intro H5. subst. apply Rlt_irrefl in H2. contradiction. - pose proof (torn_number_below_second_sequence u v en (S n)). rewrite -> H1 in H2. simpl in H2. intro H5. subst. apply Rlt_irrefl in H2. contradiction. Qed. (* The indices increase because each time the minimum index is chosen *) Lemma first_indices_increasing (u : nat -> R) (v : R -> nat) (H : enumeration R u v) : forall n : nat, n <> 0 -> v (fst (proj1_sig (tearing_sequences u v H n))) < v (fst (proj1_sig (tearing_sequences u v H (S n)))). Proof. intros. destruct n. - contradiction. - (* The n+1 and n+2 intervals are drawn from the n-th interval, which we note r r0 *) destruct (tearing_sequences u v H n) as [[r r0] H1] eqn:In. simpl in H1. (* Draw the n+1 interval *) destruct (tearing_sequences u v H (S n)) as [[r1 r2] H2] eqn:ISn. simpl in H2. (* Draw the n+2 interval *) destruct (tearing_sequences u v H (S (S n))) as [[r3 r4] H3] eqn:ISSn. simpl in H3. simpl. assert ((r1,r2) = first_two_in_interval u v r r0 H H1). { simpl in ISn. rewrite -> In in ISn. inversion ISn. reflexivity. } assert ((r3,r4) = first_two_in_interval u v r1 r2 H H2). { pose proof (tearing_sequences_projsig u v H (S n)). rewrite -> ISn in H5. rewrite -> ISSn in H5. apply H5. } pose proof (first_two_in_interval_works u v r r0 H H1) as firstChoiceWorks. rewrite <- H4 in firstChoiceWorks. destruct firstChoiceWorks as [fth [fth0 [fth1 [fth2 [fth3 fth4]]]]]. (* to prove the n+2 left bound in between r1 and r2 *) pose proof (first_two_in_interval_works u v r1 r2 H H2). rewrite <- H5 in H6. destruct H6 as [H6 [H7 [H8 [H9 [H10 H11]]]]]. apply fth4. + apply (Rlt_trans r r1); assumption. + apply (Rlt_trans r3 r2); assumption. + intro abs. subst. apply Rlt_irrefl in H6. contradiction. + intro abs. subst. apply Rlt_irrefl in H7. contradiction. Qed. Theorem R_uncountable : forall u : nat -> R, ~Bijective u. Proof. intros u [v [H3 H4]]. pose proof (conj H4 H3) as H. assert (forall n : nat, n + v (fst (proj1_sig (tearing_sequences u v H 1))) <= v (fst (proj1_sig (tearing_sequences u v H (S n))))). { induction n. - simpl. apply Nat.le_refl. - apply (Nat.le_trans (S n + v (fst (proj1_sig (tearing_sequences u v H 1)))) (S (v (fst (proj1_sig (tearing_sequences u v H (S n))))))). + simpl. apply -> Nat.succ_le_mono. assumption. + apply first_indices_increasing. intro H1. discriminate. } assert (v (proj1_sig (torn_number u v H)) + v (fst (proj1_sig (tearing_sequences u v H 1))) < v (proj1_sig (torn_number u v H))). { pose proof (limit_index_above_all_indices u v H (v (proj1_sig (torn_number u v H)))). specialize (H0 (v (proj1_sig (torn_number u v H)))). apply (Nat.le_lt_trans (v (proj1_sig (torn_number u v H)) + v (fst (proj1_sig (tearing_sequences u v H 1)))) (v (fst (proj1_sig (tearing_sequences u v H (S (v (proj1_sig (torn_number u v H))))))))). - assumption. - assumption. } assert (forall n m : nat, ~(n + m < n)). { induction n. - intros. intro H2. inversion H2. - intro m. intro H2. simpl in H2. apply Nat.lt_succ_lt_pred in H2. simpl in H2. apply IHn in H2. contradiction. } apply H2 in H1. contradiction. Qed. coq-8.20.0/theories/Reals/SeqProp.v000066400000000000000000001240331466560755400170600ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* R) : Prop := forall n:nat, Un (S n) <= Un n. Definition opp_seq (Un:nat -> R) (n:nat) : R := - Un n. Definition has_ub (Un:nat -> R) : Prop := bound (EUn Un). Definition has_lb (Un:nat -> R) : Prop := bound (EUn (opp_seq Un)). (**********) Lemma growing_cv : forall Un:nat -> R, Un_growing Un -> has_ub Un -> { l:R | Un_cv Un l }. Proof. intros Un Hug Heub. exists (proj1_sig (completeness (EUn Un) Heub (EUn_noempty Un))). destruct (completeness _ Heub (EUn_noempty Un)) as (l, H). now apply Un_cv_crit_lub. Qed. Lemma decreasing_growing : forall Un:nat -> R, Un_decreasing Un -> Un_growing (opp_seq Un). Proof. intro. unfold Un_growing, opp_seq, Un_decreasing. intros. apply Ropp_le_contravar. apply H. Qed. Lemma decreasing_cv : forall Un:nat -> R, Un_decreasing Un -> has_lb Un -> { l:R | Un_cv Un l }. Proof. intros. cut ({ l:R | Un_cv (opp_seq Un) l } -> { l:R | Un_cv Un l }). - intro X. apply X. apply growing_cv. + apply decreasing_growing; assumption. + exact H0. - intros (x,p). exists (- x). unfold Un_cv in p. unfold Rdist in p. unfold opp_seq in p. unfold Un_cv. unfold Rdist. intros. elim (p eps H1); intros. exists x0; intros. assert (H4 := H2 n H3). rewrite <- Rabs_Ropp. replace (- (Un n - - x)) with (- Un n - x); [ assumption | ring ]. Qed. (***********) Lemma ub_to_lub : forall Un:nat -> R, has_ub Un -> { l:R | is_lub (EUn Un) l }. Proof. intros. unfold has_ub in H. apply completeness. - assumption. - exists (Un 0%nat). unfold EUn. exists 0%nat; reflexivity. Qed. (**********) Lemma lb_to_glb : forall Un:nat -> R, has_lb Un -> { l:R | is_lub (EUn (opp_seq Un)) l }. Proof. intros; unfold has_lb in H. apply completeness. - assumption. - exists (- Un 0%nat). exists 0%nat. reflexivity. Qed. Definition lub (Un:nat -> R) (pr:has_ub Un) : R := let (a,_) := ub_to_lub Un pr in a. Definition glb (Un:nat -> R) (pr:has_lb Un) : R := let (a,_) := lb_to_glb Un pr in - a. (* Compatibility with previous unappropriate terminology *) Notation maj_sup := ub_to_lub (only parsing). Notation min_inf := lb_to_glb (only parsing). Notation majorant := lub (only parsing). Notation minorant := glb (only parsing). Lemma maj_ss : forall (Un:nat -> R) (k:nat), has_ub Un -> has_ub (fun i:nat => Un (k + i)%nat). Proof. intros. unfold has_ub in H. unfold bound in H. elim H; intros. unfold is_upper_bound in H0. unfold has_ub. exists x. unfold is_upper_bound. intros. apply H0. elim H1; intros. exists (k + x1)%nat; assumption. Qed. Lemma min_ss : forall (Un:nat -> R) (k:nat), has_lb Un -> has_lb (fun i:nat => Un (k + i)%nat). Proof. intros. unfold has_lb in H. unfold bound in H. elim H; intros. unfold is_upper_bound in H0. unfold has_lb. exists x. unfold is_upper_bound. intros. apply H0. elim H1; intros. exists (k + x1)%nat; assumption. Qed. Definition sequence_ub (Un:nat -> R) (pr:has_ub Un) (i:nat) : R := lub (fun k:nat => Un (i + k)%nat) (maj_ss Un i pr). Definition sequence_lb (Un:nat -> R) (pr:has_lb Un) (i:nat) : R := glb (fun k:nat => Un (i + k)%nat) (min_ss Un i pr). (* Compatibility *) Notation sequence_majorant := sequence_ub (only parsing). Notation sequence_minorant := sequence_lb (only parsing). Lemma Wn_decreasing : forall (Un:nat -> R) (pr:has_ub Un), Un_decreasing (sequence_ub Un pr). Proof. intros. unfold Un_decreasing. intro. unfold sequence_ub. pose proof (ub_to_lub (fun k:nat => Un (S n + k)%nat) (maj_ss Un (S n) pr)) as (x,(H1,H2)). pose proof (ub_to_lub (fun k:nat => Un (n + k)%nat) (maj_ss Un n pr)) as (x0,(H3,H4)). cut (lub (fun k:nat => Un (S n + k)%nat) (maj_ss Un (S n) pr) = x); [ intro Maj1; rewrite Maj1 | idtac ]. 1:cut (lub (fun k:nat => Un (n + k)%nat) (maj_ss Un n pr) = x0); [ intro Maj2; rewrite Maj2 | idtac ]. - apply H2. unfold is_upper_bound. intros x1 H5. unfold is_upper_bound in H3. apply H3. elim H5; intros. exists (1 + x2)%nat. replace (n + (1 + x2))%nat with (S n + x2)%nat. + assumption. + replace (S n) with (1 + n)%nat; [ ring | ring ]. - cut (is_lub (EUn (fun k:nat => Un (n + k)%nat)) (lub (fun k:nat => Un (n + k)%nat) (maj_ss Un n pr))). + intros (H5,H6). assert (H7 := H6 x0 H3). assert (H8 := H4 (lub (fun k:nat => Un (n + k)%nat) (maj_ss Un n pr)) H5). apply Rle_antisym; assumption. + unfold lub. case (ub_to_lub (fun k:nat => Un (n + k)%nat) (maj_ss Un n pr)). trivial. - cut (is_lub (EUn (fun k:nat => Un (S n + k)%nat)) (lub (fun k:nat => Un (S n + k)%nat) (maj_ss Un (S n) pr))). + intros (H5,H6). assert (H7 := H6 x H1). assert (H8 := H2 (lub (fun k:nat => Un (S n + k)%nat) (maj_ss Un (S n) pr)) H5). apply Rle_antisym; assumption. + unfold lub. case (ub_to_lub (fun k:nat => Un (S n + k)%nat) (maj_ss Un (S n) pr)). trivial. Qed. Lemma Vn_growing : forall (Un:nat -> R) (pr:has_lb Un), Un_growing (sequence_lb Un pr). Proof. intros. unfold Un_growing. intro. unfold sequence_lb. assert (H := lb_to_glb (fun k:nat => Un (S n + k)%nat) (min_ss Un (S n) pr)). assert (H0 := lb_to_glb (fun k:nat => Un (n + k)%nat) (min_ss Un n pr)). elim H; intros. elim H0; intros. cut (glb (fun k:nat => Un (S n + k)%nat) (min_ss Un (S n) pr) = - x); [ intro Maj1; rewrite Maj1 | idtac ]. 1:cut (glb (fun k:nat => Un (n + k)%nat) (min_ss Un n pr) = - x0); [ intro Maj2; rewrite Maj2 | idtac ]. - unfold is_lub in p. unfold is_lub in p0. elim p; intros. apply Ropp_le_contravar. apply H2. elim p0; intros. unfold is_upper_bound. intros. unfold is_upper_bound in H3. apply H3. elim H5; intros. exists (1 + x2)%nat. unfold opp_seq in H6. unfold opp_seq. replace (n + (1 + x2))%nat with (S n + x2)%nat. + assumption. + replace (S n) with (1 + n)%nat; [ ring | ring ]. - cut (is_lub (EUn (opp_seq (fun k:nat => Un (n + k)%nat))) (- glb (fun k:nat => Un (n + k)%nat) (min_ss Un n pr))). + intro. unfold is_lub in p0; unfold is_lub in H1. elim p0; intros; elim H1; intros. assert (H6 := H5 x0 H2). assert (H7 := H3 (- glb (fun k:nat => Un (n + k)%nat) (min_ss Un n pr)) H4). rewrite <- (Ropp_involutive (glb (fun k:nat => Un (n + k)%nat) (min_ss Un n pr))) . apply Ropp_eq_compat; apply Rle_antisym; assumption. + unfold glb. case (lb_to_glb (fun k:nat => Un (n + k)%nat) (min_ss Un n pr)); simpl. intro; rewrite Ropp_involutive. trivial. - cut (is_lub (EUn (opp_seq (fun k:nat => Un (S n + k)%nat))) (- glb (fun k:nat => Un (S n + k)%nat) (min_ss Un (S n) pr))). + intro. unfold is_lub in p; unfold is_lub in H1. elim p; intros; elim H1; intros. assert (H6 := H5 x H2). assert (H7 := H3 (- glb (fun k:nat => Un (S n + k)%nat) (min_ss Un (S n) pr)) H4). rewrite <- (Ropp_involutive (glb (fun k:nat => Un (S n + k)%nat) (min_ss Un (S n) pr))) . apply Ropp_eq_compat; apply Rle_antisym; assumption. + unfold glb. case (lb_to_glb (fun k:nat => Un (S n + k)%nat) (min_ss Un (S n) pr)); simpl. intro; rewrite Ropp_involutive. trivial. Qed. (**********) Lemma Vn_Un_Wn_order : forall (Un:nat -> R) (pr1:has_ub Un) (pr2:has_lb Un) (n:nat), sequence_lb Un pr2 n <= Un n <= sequence_ub Un pr1 n. Proof. intros. split. - unfold sequence_lb. cut { l:R | is_lub (EUn (opp_seq (fun i:nat => Un (n + i)%nat))) l }. + intro X. elim X; intros. replace (glb (fun k:nat => Un (n + k)%nat) (min_ss Un n pr2)) with (- x). * unfold is_lub in p. elim p; intros. unfold is_upper_bound in H. rewrite <- (Ropp_involutive (Un n)). apply Ropp_le_contravar. apply H. exists 0%nat. unfold opp_seq. replace (n + 0)%nat with n; [ reflexivity | ring ]. * cut (is_lub (EUn (opp_seq (fun k:nat => Un (n + k)%nat))) (- glb (fun k:nat => Un (n + k)%nat) (min_ss Un n pr2))). -- intro. unfold is_lub in p; unfold is_lub in H. elim p; intros; elim H; intros. assert (H4 := H3 x H0). assert (H5 := H1 (- glb (fun k:nat => Un (n + k)%nat) (min_ss Un n pr2)) H2). rewrite <- (Ropp_involutive (glb (fun k:nat => Un (n + k)%nat) (min_ss Un n pr2))) . apply Ropp_eq_compat; apply Rle_antisym; assumption. -- unfold glb. case (lb_to_glb (fun k:nat => Un (n + k)%nat) (min_ss Un n pr2)); simpl. intro; rewrite Ropp_involutive. trivial. + apply lb_to_glb. apply min_ss; assumption. - unfold sequence_ub. cut { l:R | is_lub (EUn (fun i:nat => Un (n + i)%nat)) l }. + intro X. elim X; intros. replace (lub (fun k:nat => Un (n + k)%nat) (maj_ss Un n pr1)) with x. * unfold is_lub in p. elim p; intros. unfold is_upper_bound in H. apply H. exists 0%nat. replace (n + 0)%nat with n; [ reflexivity | ring ]. * cut (is_lub (EUn (fun k:nat => Un (n + k)%nat)) (lub (fun k:nat => Un (n + k)%nat) (maj_ss Un n pr1))). -- intro. unfold is_lub in p; unfold is_lub in H. elim p; intros; elim H; intros. assert (H4 := H3 x H0). assert (H5 := H1 (lub (fun k:nat => Un (n + k)%nat) (maj_ss Un n pr1)) H2). apply Rle_antisym; assumption. -- unfold lub. case (ub_to_lub (fun k:nat => Un (n + k)%nat) (maj_ss Un n pr1)). intro; trivial. + apply ub_to_lub. apply maj_ss; assumption. Qed. Lemma min_maj : forall (Un:nat -> R) (pr1:has_ub Un) (pr2:has_lb Un), has_ub (sequence_lb Un pr2). Proof. intros. assert (H := Vn_Un_Wn_order Un pr1 pr2). unfold has_ub. unfold bound. unfold has_ub in pr1. unfold bound in pr1. elim pr1; intros. exists x. unfold is_upper_bound. intros. unfold is_upper_bound in H0. elim H1; intros. rewrite H2. apply Rle_trans with (Un x1). - assert (H3 := H x1); elim H3; intros; assumption. - apply H0. exists x1; reflexivity. Qed. Lemma maj_min : forall (Un:nat -> R) (pr1:has_ub Un) (pr2:has_lb Un), has_lb (sequence_ub Un pr1). Proof. intros. assert (H := Vn_Un_Wn_order Un pr1 pr2). unfold has_lb. unfold bound. unfold has_lb in pr2. unfold bound in pr2. elim pr2; intros. exists x. unfold is_upper_bound. intros. unfold is_upper_bound in H0. elim H1; intros. rewrite H2. apply Rle_trans with (opp_seq Un x1). - assert (H3 := H x1); elim H3; intros. unfold opp_seq; apply Ropp_le_contravar. assumption. - apply H0. exists x1; reflexivity. Qed. (**********) Lemma cauchy_maj : forall Un:nat -> R, Cauchy_crit Un -> has_ub Un. Proof. intros. unfold has_ub. apply cauchy_bound. assumption. Qed. (**********) Lemma cauchy_opp : forall Un:nat -> R, Cauchy_crit Un -> Cauchy_crit (opp_seq Un). Proof. intro. unfold Cauchy_crit. unfold Rdist. intros. elim (H eps H0); intros. exists x; intros. unfold opp_seq. rewrite <- Rabs_Ropp. replace (- (- Un n - - Un m)) with (Un n - Un m); [ apply H1; assumption | ring ]. Qed. (**********) Lemma cauchy_min : forall Un:nat -> R, Cauchy_crit Un -> has_lb Un. Proof. intros. unfold has_lb. assert (H0 := cauchy_opp _ H). apply cauchy_bound. assumption. Qed. (**********) Lemma maj_cv : forall (Un:nat -> R) (pr:Cauchy_crit Un), { l:R | Un_cv (sequence_ub Un (cauchy_maj Un pr)) l }. Proof. intros. apply decreasing_cv. - apply Wn_decreasing. - apply maj_min. apply cauchy_min. assumption. Qed. (**********) Lemma min_cv : forall (Un:nat -> R) (pr:Cauchy_crit Un), { l:R | Un_cv (sequence_lb Un (cauchy_min Un pr)) l }. Proof. intros. apply growing_cv. - apply Vn_growing. - apply min_maj. apply cauchy_maj. assumption. Qed. Lemma cond_eq : forall x y:R, (forall eps:R, 0 < eps -> Rabs (x - y) < eps) -> x = y. Proof. intros. destruct (total_order_T x y) as [[Hlt|Heq]|Hgt]. - cut (0 < y - x). + intro. assert (H1 := H (y - x) H0). rewrite <- Rabs_Ropp in H1. cut (- (x - y) = y - x); [ intro; rewrite H2 in H1 | ring ]. rewrite Rabs_right in H1. * elim (Rlt_irrefl _ H1). * left; assumption. + apply Rplus_lt_reg_l with x. rewrite Rplus_0_r; replace (x + (y - x)) with y; [ assumption | ring ]. - assumption. - cut (0 < x - y). + intro. assert (H1 := H (x - y) H0). rewrite Rabs_right in H1. * elim (Rlt_irrefl _ H1). * left; assumption. + apply Rplus_lt_reg_l with y. rewrite Rplus_0_r; replace (y + (x - y)) with x; [ assumption | ring ]. Qed. Lemma not_Rlt : forall r1 r2:R, ~ r1 < r2 -> r1 >= r2. Proof. intros r1 r2; generalize (Rtotal_order r1 r2); unfold Rge. tauto. Qed. (**********) Lemma approx_maj : forall (Un:nat -> R) (pr:has_ub Un) (eps:R), 0 < eps -> exists k : nat, Rabs (lub Un pr - Un k) < eps. Proof. intros Un pr. pose (Vn := fix aux n := match n with S n' => if Rle_lt_dec (aux n') (Un n) then Un n else aux n' | O => Un O end). pose (In := fix aux n := match n with S n' => if Rle_lt_dec (Vn n) (Un n) then n else aux n' | O => O end). assert (VUI: forall n, Vn n = Un (In n)). { induction n. - easy. - simpl. destruct (Rle_lt_dec (Vn n) (Un (S n))) as [H1|H1]. + destruct (Rle_lt_dec (Un (S n)) (Un (S n))) as [H2|H2]. * easy. * elim (Rlt_irrefl _ H2). + destruct (Rle_lt_dec (Vn n) (Un (S n))) as [H2|H2]. * elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H2 H1)). * exact IHn. } assert (HubV : has_ub Vn). { destruct pr as (ub, Hub). exists ub. intros x (n, Hn). rewrite Hn, VUI. apply Hub. now exists (In n). } assert (HgrV : Un_growing Vn). { intros n. induction n. - simpl. destruct (Rle_lt_dec (Un O) (Un 1%nat)) as [H|_]. + exact H. + apply Rle_refl. - simpl. destruct (Rle_lt_dec (Vn n) (Un (S n))) as [H1|H1]. + destruct (Rle_lt_dec (Un (S n)) (Un (S (S n)))) as [H2|H2]. * exact H2. * apply Rle_refl. + destruct (Rle_lt_dec (Vn n) (Un (S (S n)))) as [H2|H2]. * exact H2. * apply Rle_refl. } destruct (ub_to_lub Vn HubV) as (l, Hl). unfold lub. destruct (ub_to_lub Un pr) as (l', Hl'). replace l' with l. - intros eps Heps. destruct (Un_cv_crit_lub Vn HgrV l Hl eps Heps) as (n, Hn). exists (In n). rewrite <- VUI. rewrite Rabs_minus_sym. apply Hn. apply Nat.le_refl. - apply Rle_antisym. + apply Hl. intros n (k, Hk). rewrite Hk, VUI. apply Hl'. now exists (In k). + apply Hl'. intros n (k, Hk). rewrite Hk. apply Rle_trans with (Vn k). * clear. induction k. -- apply Rle_refl. -- simpl. destruct (Rle_lt_dec (Vn k) (Un (S k))) as [H|H]. ++ apply Rle_refl. ++ now apply Rlt_le. * apply Hl. now exists k. Qed. (**********) Lemma approx_min : forall (Un:nat -> R) (pr:has_lb Un) (eps:R), 0 < eps -> exists k : nat, Rabs (glb Un pr - Un k) < eps. Proof. intros Un pr. unfold glb. destruct lb_to_glb as (lb, Hlb). intros eps Heps. destruct (approx_maj _ pr eps Heps) as (n, Hn). exists n. unfold Rminus. rewrite <- Ropp_plus_distr, Rabs_Ropp. replace lb with (lub (opp_seq Un) pr). - now rewrite <- (Ropp_involutive (Un n)). - unfold lub. destruct ub_to_lub as (ub, Hub). apply Rle_antisym. + apply Hub. apply Hlb. + apply Hlb. apply Hub. Qed. (** Unicity of limit for convergent sequences *) Lemma UL_sequence : forall (Un:nat -> R) (l1 l2:R), Un_cv Un l1 -> Un_cv Un l2 -> l1 = l2. Proof. intros Un l1 l2; unfold Un_cv; unfold Rdist; intros. apply cond_eq. intros; cut (0 < eps / 2); [ intro | unfold Rdiv; apply Rmult_lt_0_compat; [ assumption | apply Rinv_0_lt_compat; prove_sup0 ] ]. elim (H (eps / 2) H2); intros. elim (H0 (eps / 2) H2); intros. set (N := max x x0). apply Rle_lt_trans with (Rabs (l1 - Un N) + Rabs (Un N - l2)). - replace (l1 - l2) with (l1 - Un N + (Un N - l2)); [ apply Rabs_triang | ring ]. - rewrite <-(Rplus_half_diag eps); apply Rplus_lt_compat. + rewrite <- Rabs_Ropp; rewrite Ropp_minus_distr; apply H3; unfold ge, N; apply Nat.le_max_l. + apply H4; unfold ge, N; apply Nat.le_max_r. Qed. (**********) Lemma CV_plus : forall (An Bn:nat -> R) (l1 l2:R), Un_cv An l1 -> Un_cv Bn l2 -> Un_cv (fun i:nat => An i + Bn i) (l1 + l2). Proof. unfold Un_cv; unfold Rdist; intros. cut (0 < eps / 2); [ intro | unfold Rdiv; apply Rmult_lt_0_compat; [ assumption | apply Rinv_0_lt_compat; prove_sup0 ] ]. elim (H (eps / 2) H2); intros. elim (H0 (eps / 2) H2); intros. set (N := max x x0). exists N; intros. replace (An n + Bn n - (l1 + l2)) with (An n - l1 + (Bn n - l2)); [ idtac | ring ]. apply Rle_lt_trans with (Rabs (An n - l1) + Rabs (Bn n - l2)). - apply Rabs_triang. - rewrite <-(Rplus_half_diag eps); apply Rplus_lt_compat. + apply H3; unfold ge; apply Nat.le_trans with N; [ unfold N; apply Nat.le_max_l | assumption ]. + apply H4; unfold ge; apply Nat.le_trans with N; [ unfold N; apply Nat.le_max_r | assumption ]. Qed. (**********) Lemma cv_cvabs : forall (Un:nat -> R) (l:R), Un_cv Un l -> Un_cv (fun i:nat => Rabs (Un i)) (Rabs l). Proof. unfold Un_cv; unfold Rdist; intros. elim (H eps H0); intros. exists x; intros. apply Rle_lt_trans with (Rabs (Un n - l)). - apply Rabs_triang_inv2. - apply H1; assumption. Qed. (**********) Lemma CV_Cauchy : forall Un:nat -> R, { l:R | Un_cv Un l } -> Cauchy_crit Un. Proof. intros Un X; elim X; intros. unfold Cauchy_crit; intros. unfold Un_cv in p; unfold Rdist in p. cut (0 < eps / 2); [ intro | unfold Rdiv; apply Rmult_lt_0_compat; [ assumption | apply Rinv_0_lt_compat; prove_sup0 ] ]. elim (p (eps / 2) H0); intros. exists x0; intros. unfold Rdist; apply Rle_lt_trans with (Rabs (Un n - x) + Rabs (x - Un m)). - replace (Un n - Un m) with (Un n - x + (x - Un m)); [ apply Rabs_triang | ring ]. - rewrite <-(Rplus_half_diag eps); apply Rplus_lt_compat. + apply H1; assumption. + rewrite <- Rabs_Ropp; rewrite Ropp_minus_distr; apply H1; assumption. Qed. (**********) Lemma maj_by_pos : forall Un:nat -> R, { l:R | Un_cv Un l } -> exists l : R, 0 < l /\ (forall n:nat, Rabs (Un n) <= l). Proof. intros Un X; elim X; intros. cut { l:R | Un_cv (fun k:nat => Rabs (Un k)) l }. - intro X0. assert (H := CV_Cauchy (fun k:nat => Rabs (Un k)) X0). assert (H0 := cauchy_bound (fun k:nat => Rabs (Un k)) H). elim H0; intros. exists (x0 + 1). cut (0 <= x0). + intro. split. * apply Rplus_le_lt_0_compat; [ assumption | apply Rlt_0_1 ]. * intros. apply Rle_trans with x0. -- unfold is_upper_bound in H1. apply H1. exists n; reflexivity. -- pattern x0 at 1; rewrite <- Rplus_0_r; apply Rplus_le_compat_l; left; apply Rlt_0_1. + apply Rle_trans with (Rabs (Un 0%nat)). * apply Rabs_pos. * unfold is_upper_bound in H1. apply H1. exists 0%nat; reflexivity. - exists (Rabs x). apply cv_cvabs; assumption. Qed. (**********) Lemma CV_mult : forall (An Bn:nat -> R) (l1 l2:R), Un_cv An l1 -> Un_cv Bn l2 -> Un_cv (fun i:nat => An i * Bn i) (l1 * l2). Proof. intros. assert (X:{ l:R | Un_cv An l }) by (exists l1; assumption). assert (H1 := maj_by_pos An X). elim H1; intros M H2. elim H2; intros. unfold Un_cv; unfold Rdist; intros. cut (0 < eps / (2 * M)). - intro. case (Req_dec l2 0); intro. + unfold Un_cv in H0; unfold Rdist in H0. elim (H0 (eps / (2 * M)) H6); intros. exists x; intros. apply Rle_lt_trans with (Rabs (An n * Bn n - An n * l2) + Rabs (An n * l2 - l1 * l2)). { replace (An n * Bn n - l1 * l2) with (An n * Bn n - An n * l2 + (An n * l2 - l1 * l2)); [ apply Rabs_triang | ring ]. } replace (Rabs (An n * Bn n - An n * l2)) with (Rabs (An n) * Rabs (Bn n - l2)). { replace (Rabs (An n * l2 - l1 * l2)) with 0. - rewrite Rplus_0_r. apply Rle_lt_trans with (M * Rabs (Bn n - l2)). + do 2 rewrite <- (Rmult_comm (Rabs (Bn n - l2))). apply Rmult_le_compat_l. * apply Rabs_pos. * apply H4. + apply Rmult_lt_reg_l with (/ M). { apply Rinv_0_lt_compat; apply H3. } rewrite <- Rmult_assoc; rewrite Rinv_l. * rewrite Rmult_1_l; rewrite (Rmult_comm (/ M)). apply Rlt_trans with (eps / (2 * M)). { apply H8; assumption. } unfold Rdiv; rewrite Rinv_mult. apply Rmult_lt_reg_l with 2. { prove_sup0. } replace (2 * (eps * (/ 2 * / M))) with (2 * / 2 * (eps * / M)); [ idtac | ring ]. rewrite Rinv_r. -- rewrite Rmult_1_l; rewrite <-Rplus_diag. pattern (eps * / M) at 1; rewrite <- Rplus_0_r. apply Rplus_lt_compat_l; apply Rmult_lt_0_compat; [ assumption | apply Rinv_0_lt_compat; assumption ]. -- discrR. * red; intro; rewrite H10 in H3; elim (Rlt_irrefl _ H3). - rewrite H7; do 2 rewrite Rmult_0_r; unfold Rminus; rewrite Rplus_opp_r; rewrite Rabs_R0; reflexivity. } replace (An n * Bn n - An n * l2) with (An n * (Bn n - l2)) by ring. symmetry ; apply Rabs_mult. + assert (0 < eps / (2 * Rabs l2)). { unfold Rdiv; apply Rmult_lt_0_compat. { assumption. } apply Rinv_0_lt_compat; apply Rmult_lt_0_compat; [ prove_sup0 | apply Rabs_pos_lt; assumption ]. } unfold Un_cv in H; unfold Rdist in H; unfold Un_cv in H0; unfold Rdist in H0. elim (H (eps / (2 * Rabs l2)) H8); intros N1 H9. elim (H0 (eps / (2 * M)) H6); intros N2 H10. set (N := max N1 N2). exists N; intros. apply Rle_lt_trans with (Rabs (An n * Bn n - An n * l2) + Rabs (An n * l2 - l1 * l2)). { replace (An n * Bn n - l1 * l2) with (An n * Bn n - An n * l2 + (An n * l2 - l1 * l2)) by ring; apply Rabs_triang. } replace (Rabs (An n * Bn n - An n * l2)) with (Rabs (An n) * Rabs (Bn n - l2)). 1:replace (Rabs (An n * l2 - l1 * l2)) with (Rabs l2 * Rabs (An n - l1)). * rewrite <-(Rplus_half_diag eps); apply Rplus_lt_compat. -- apply Rle_lt_trans with (M * Rabs (Bn n - l2)). { do 2 rewrite <- (Rmult_comm (Rabs (Bn n - l2))). apply Rmult_le_compat_l. - apply Rabs_pos. - apply H4. } apply Rmult_lt_reg_l with (/ M). { apply Rinv_0_lt_compat; apply H3. } rewrite <- Rmult_assoc; rewrite Rinv_l. ++ rewrite Rmult_1_l; rewrite (Rmult_comm (/ M)). apply Rlt_le_trans with (eps / (2 * M)). ** apply H10. unfold ge; apply Nat.le_trans with N. { unfold N; apply Nat.le_max_r. } assumption. ** unfold Rdiv; rewrite Rinv_mult. right; ring. ++ red; intro; rewrite H12 in H3; elim (Rlt_irrefl _ H3). -- apply Rmult_lt_reg_l with (/ Rabs l2). { apply Rinv_0_lt_compat; apply Rabs_pos_lt; assumption. } rewrite <- Rmult_assoc; rewrite Rinv_l. ++ rewrite Rmult_1_l; apply Rlt_le_trans with (eps / (2 * Rabs l2)). ** apply H9. unfold ge; apply Nat.le_trans with N. { unfold N; apply Nat.le_max_l. } assumption. ** unfold Rdiv; right; rewrite Rinv_mult. ring. ++ apply Rabs_no_R0; assumption. * replace (An n * l2 - l1 * l2) with (l2 * (An n - l1)); [ symmetry ; apply Rabs_mult | ring ]. * replace (An n * Bn n - An n * l2) with (An n * (Bn n - l2)); [ symmetry ; apply Rabs_mult | ring ]. - unfold Rdiv; apply Rmult_lt_0_compat; [ assumption | apply Rinv_0_lt_compat; apply Rmult_lt_0_compat; [ prove_sup0 | assumption ] ]. Qed. Lemma tech9 : forall Un:nat -> R, Un_growing Un -> forall m n:nat, (m <= n)%nat -> Un m <= Un n. Proof. intros; unfold Un_growing in H. induction n as [| n Hrecn]. - induction m as [| m Hrecm]. + right; reflexivity. + elim (Nat.nle_succ_0 _ H0). - cut ((m <= n)%nat \/ m = S n). + intro; elim H1; intro. * apply Rle_trans with (Un n). -- apply Hrecn; assumption. -- apply H. * rewrite H2; right; reflexivity. + inversion H0. * right; reflexivity. * left; assumption. Qed. Lemma tech13 : forall (An:nat -> R) (k:R), 0 <= k < 1 -> Un_cv (fun n:nat => Rabs (An (S n) / An n)) k -> exists k0 : R, k < k0 < 1 /\ (exists N : nat, (forall n:nat, (N <= n)%nat -> Rabs (An (S n) / An n) < k0)). Proof. intros; exists (k + (1 - k) / 2). split. 1:split. - pattern k at 1; rewrite <- Rplus_0_r; apply Rplus_lt_compat_l. unfold Rdiv; apply Rmult_lt_0_compat. + apply Rplus_lt_reg_l with k; rewrite Rplus_0_r; replace (k + (1 - k)) with 1; [ elim H; intros; assumption | ring ]. + apply Rinv_0_lt_compat; prove_sup0. - apply Rmult_lt_reg_l with 2. + prove_sup0. + unfold Rdiv; rewrite Rmult_1_r; rewrite Rmult_plus_distr_l; pattern 2 at 1; rewrite Rmult_comm; rewrite Rmult_assoc; rewrite Rinv_l; [ idtac | discrR ]; rewrite Rmult_1_r; replace (2 * k + (1 - k)) with (1 + k); [ idtac | ring ]. elim H; intros. apply Rplus_lt_compat_l; assumption. - unfold Un_cv in H0; cut (0 < (1 - k) / 2). + intro; elim (H0 ((1 - k) / 2) H1); intros. exists x; intros. assert (H4 := H2 n H3). unfold Rdist in H4; rewrite <- Rabs_Rabsolu; replace (Rabs (An (S n) / An n)) with (Rabs (An (S n) / An n) - k + k); [ idtac | ring ]; apply Rle_lt_trans with (Rabs (Rabs (An (S n) / An n) - k) + Rabs k). * apply Rabs_triang. * rewrite (Rabs_right k). -- apply Rplus_lt_reg_l with (- k); rewrite <- (Rplus_comm k); repeat rewrite <- Rplus_assoc; rewrite Rplus_opp_l; repeat rewrite Rplus_0_l; apply H4. -- apply Rle_ge; elim H; intros; assumption. + unfold Rdiv; apply Rmult_lt_0_compat. * apply Rplus_lt_reg_l with k; rewrite Rplus_0_r; elim H; intros; replace (k + (1 - k)) with 1; [ assumption | ring ]. * apply Rinv_0_lt_compat; prove_sup0. Qed. (**********) Lemma growing_ineq : forall (Un:nat -> R) (l:R), Un_growing Un -> Un_cv Un l -> forall n:nat, Un n <= l. Proof. intros; destruct (total_order_T (Un n) l) as [[Hlt|Heq]|Hgt]. - left; assumption. - right; assumption. - cut (0 < Un n - l). + intro; unfold Un_cv in H0; unfold Rdist in H0. elim (H0 (Un n - l) H1); intros N1 H2. set (N := max n N1). cut (Un n - l <= Un N - l). * intro; cut (Un N - l < Un n - l). -- intro; elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H3 H4)). -- apply Rle_lt_trans with (Rabs (Un N - l)). ++ apply RRle_abs. ++ apply H2. unfold ge, N; apply Nat.le_max_r. * unfold Rminus; do 2 rewrite <- (Rplus_comm (- l)); apply Rplus_le_compat_l. apply tech9. -- assumption. -- unfold N; apply Nat.le_max_l. + apply Rplus_lt_reg_l with l. rewrite Rplus_0_r. replace (l + (Un n - l)) with (Un n); [ assumption | ring ]. Qed. (** Un->l => (-Un) -> (-l) *) Lemma CV_opp : forall (An:nat -> R) (l:R), Un_cv An l -> Un_cv (opp_seq An) (- l). Proof. intros An l. unfold Un_cv; unfold Rdist; intros. elim (H eps H0); intros. exists x; intros. unfold opp_seq; replace (- An n - - l) with (- (An n - l)); [ rewrite Rabs_Ropp | ring ]. apply H1; assumption. Qed. (**********) Lemma decreasing_ineq : forall (Un:nat -> R) (l:R), Un_decreasing Un -> Un_cv Un l -> forall n:nat, l <= Un n. Proof. intros. assert (H1 := decreasing_growing _ H). assert (H2 := CV_opp _ _ H0). assert (H3 := growing_ineq _ _ H1 H2). apply Ropp_le_cancel. unfold opp_seq in H3; apply H3. Qed. (**********) Lemma CV_minus : forall (An Bn:nat -> R) (l1 l2:R), Un_cv An l1 -> Un_cv Bn l2 -> Un_cv (fun i:nat => An i - Bn i) (l1 - l2). Proof. intros. replace (fun i:nat => An i - Bn i) with (fun i:nat => An i + opp_seq Bn i). - unfold Rminus; apply CV_plus. + assumption. + apply CV_opp; assumption. - unfold Rminus, opp_seq; reflexivity. Qed. (** Un -> +oo *) Definition cv_infty (Un:nat -> R) : Prop := forall M:R, exists N : nat, (forall n:nat, (N <= n)%nat -> M < Un n). (** Un -> +oo => /Un -> O *) Lemma cv_infty_cv_0 : forall Un:nat -> R, cv_infty Un -> Un_cv (fun n:nat => / Un n) 0. Proof. unfold cv_infty, Un_cv; unfold Rdist; intros Un H0 eps H1. elim (H0 (/ eps)); intros N0 H2. exists N0; intros n H3. unfold Rminus; rewrite Ropp_0; rewrite Rplus_0_r; rewrite Rabs_inv. destruct (Req_dec (Un n) 0) as [->|H]. { now rewrite Rabs_R0, Rinv_0. } apply Rmult_lt_reg_l with (Rabs (Un n)). - apply Rabs_pos_lt; apply H. - rewrite Rinv_r. + apply Rmult_lt_reg_l with (/ eps). * apply Rinv_0_lt_compat; assumption. * rewrite Rmult_1_r; rewrite (Rmult_comm (/ eps)); rewrite Rmult_assoc; rewrite Rinv_r. -- rewrite Rmult_1_r; apply Rlt_le_trans with (Un n). ++ apply H2; assumption. ++ apply RRle_abs. -- red; intro; rewrite H4 in H1; elim (Rlt_irrefl _ H1). + apply Rabs_no_R0; apply H. Qed. Lemma cv_infty_cv_R0_depr : forall Un:nat -> R, (forall n:nat, Un n <> 0) -> cv_infty Un -> Un_cv (fun n:nat => / Un n) 0. Proof. intros Un _. apply cv_infty_cv_0. Qed. #[deprecated(since="8.16",note="Use cv_infty_cv_0.")] Notation cv_infty_cv_R0 := cv_infty_cv_R0_depr. (**********) Lemma decreasing_prop : forall (Un:nat -> R) (m n:nat), Un_decreasing Un -> (m <= n)%nat -> Un n <= Un m. Proof. unfold Un_decreasing; intros. induction n as [| n Hrecn]. - induction m as [| m Hrecm]. + right; reflexivity. + elim (Nat.nle_succ_0 _ H0). - cut ((m <= n)%nat \/ m = S n). + intro; elim H1; intro. * apply Rle_trans with (Un n). -- apply H. -- apply Hrecn; assumption. * rewrite H2; right; reflexivity. + inversion H0; [ right; reflexivity | left; assumption ]. Qed. (** |x|^n/n! -> 0 *) Lemma cv_speed_pow_fact : forall x:R, Un_cv (fun n:nat => x ^ n / INR (fact n)) 0. Proof. intro; cut (Un_cv (fun n:nat => Rabs x ^ n / INR (fact n)) 0 -> Un_cv (fun n:nat => x ^ n / INR (fact n)) 0). { intro; apply H. unfold Un_cv; unfold Rdist; intros; case (Req_dec x 0); intro. - exists 1%nat; intros. rewrite H1; unfold Rminus; rewrite Ropp_0; rewrite Rplus_0_r; rewrite Rabs_R0; rewrite pow_ne_zero; [ unfold Rdiv; rewrite Rmult_0_l; rewrite Rabs_R0; assumption | red; intro; rewrite H3 in H2; elim (Nat.nle_succ_diag_l _ H2) ]. - assert (H2 := Rabs_pos_lt x H1); set (M := up (Rabs x)); cut (0 <= M)%Z. + intro; elim (IZN M H3); intros M_nat H4. set (Un := fun n:nat => Rabs x ^ (M_nat + n) / INR (fact (M_nat + n))). cut (Un_cv Un 0); unfold Un_cv; unfold Rdist; intros. * elim (H5 eps H0); intros N H6. exists (M_nat + N)%nat; intros; cut (exists p : nat, (p >= N)%nat /\ n = (M_nat + p)%nat). { intro; elim H8; intros p H9. elim H9; intros; rewrite H11; unfold Un in H6; apply H6; assumption. } exists (n - M_nat)%nat. split. -- unfold ge; apply (fun p n m:nat => Nat.add_le_mono_l n m p) with M_nat; rewrite (Nat.add_comm _ (n - M_nat)), Nat.sub_add. { assumption. } apply Nat.le_trans with (M_nat + N)%nat. ++ apply Nat.le_add_r. ++ assumption. -- rewrite Nat.add_comm, Nat.sub_add; [reflexivity | ]; apply Nat.le_trans with (M_nat + N)%nat; [ apply Nat.le_add_r | assumption ]. * set (Vn := fun n:nat => Rabs x * (Un 0%nat / INR (S n))). cut (1 <= M_nat)%nat. 1:intro; cut (forall n:nat, 0 < Un n). 1:intro; cut (Un_decreasing Un). 1:intro; cut (forall n:nat, Un (S n) <= Vn n). 1:intro; cut (Un_cv Vn 0). -- unfold Un_cv; unfold Rdist; intros. elim (H10 eps0 H5); intros N1 H11. exists (S N1); intros. cut (forall n:nat, 0 < Vn n). { intro; apply Rle_lt_trans with (Rabs (Vn (pred n) - 0)). 1:repeat rewrite Rabs_right. - unfold Rminus; rewrite Ropp_0; do 2 rewrite Rplus_0_r; replace n with (S (pred n)). + apply H9. + inversion H12; simpl; reflexivity. - apply Rle_ge; unfold Rminus; rewrite Ropp_0; rewrite Rplus_0_r; left; apply H13. - apply Rle_ge; unfold Rminus; rewrite Ropp_0; rewrite Rplus_0_r; left; apply H7. - apply H11; unfold ge; apply le_S_n; replace (S (pred n)) with n; [ unfold ge in H12; exact H12 | inversion H12; simpl; reflexivity ]. } intro; apply Rlt_le_trans with (Un (S n0)); [ apply H7 | apply H9 ]. -- cut (cv_infty (fun n:nat => INR (S n))). 1:intro; cut (Un_cv (fun n:nat => / INR (S n)) 0). 1:unfold Un_cv, Rdist; intros; unfold Vn. 1:cut (0 < eps1 / (Rabs x * Un 0%nat)). ++ intro; elim (H11 _ H13); intros N H14. exists N; intros; replace (Rabs x * (Un 0%nat / INR (S n)) - 0) with (Rabs x * Un 0%nat * (/ INR (S n) - 0)); [ idtac | unfold Rdiv; ring ]. rewrite Rabs_mult; apply Rmult_lt_reg_l with (/ Rabs (Rabs x * Un 0%nat)). ** apply Rinv_0_lt_compat; apply Rabs_pos_lt. apply prod_neq_R0. { apply Rabs_no_R0; assumption. } assert (H16 := H7 0%nat); red; intro; rewrite H17 in H16; elim (Rlt_irrefl _ H16). ** rewrite <- Rmult_assoc; rewrite Rinv_l. { rewrite Rmult_1_l. replace (/ Rabs (Rabs x * Un 0%nat) * eps1) with (eps1 / (Rabs x * Un 0%nat)). - apply H14; assumption. - unfold Rdiv; rewrite (Rabs_right (Rabs x * Un 0%nat)). + apply Rmult_comm. + apply Rle_ge; apply Rmult_le_pos. * apply Rabs_pos. * left; apply H7. } apply Rabs_no_R0. apply prod_neq_R0; [ apply Rabs_no_R0; assumption | assert (H16 := H7 0%nat); red; intro; rewrite H17 in H16; elim (Rlt_irrefl _ H16) ]. ++ unfold Rdiv; apply Rmult_lt_0_compat. { assumption. } apply Rinv_0_lt_compat; apply Rmult_lt_0_compat. { apply Rabs_pos_lt; assumption. } apply H7. ++ now apply (cv_infty_cv_0 (fun n:nat => INR (S n))). ++ unfold cv_infty; intro; destruct (total_order_T M0 0) as [[Hlt|Heq]|Hgt]. ** exists 0%nat; intros. apply Rlt_trans with 0; [ assumption | apply lt_INR_0; apply Nat.lt_0_succ ]. ** exists 0%nat; intros; rewrite Heq; apply lt_INR_0; apply Nat.lt_0_succ. ** set (M0_z := up M0). assert (H10 := archimed M0). cut (0 <= M0_z)%Z. { intro; elim (IZN _ H11); intros M0_nat H12. exists M0_nat; intros. apply Rlt_le_trans with (IZR M0_z). - elim H10; intros; assumption. - rewrite H12; rewrite <- INR_IZR_INZ; apply le_INR. apply Nat.le_trans with n; [ assumption | apply Nat.le_succ_diag_r ]. } apply le_IZR; left; simpl; unfold M0_z; apply Rlt_trans with M0; [ assumption | elim H10; intros; assumption ]. -- intro; apply Rle_trans with (Rabs x * Un n * / INR (S n)). ++ unfold Un; replace (M_nat + S n)%nat with (M_nat + n + 1)%nat. ** { rewrite pow_add; replace (Rabs x ^ 1) with (Rabs x); [ idtac | simpl; ring ]. unfold Rdiv; rewrite <- (Rmult_comm (Rabs x)); repeat rewrite Rmult_assoc; repeat apply Rmult_le_compat_l. - apply Rabs_pos. - left; apply pow_lt; assumption. - replace (M_nat + n + 1)%nat with (S (M_nat + n)). + rewrite fact_simpl; rewrite Nat.mul_comm; rewrite mult_INR; rewrite Rinv_mult. apply Rmult_le_compat_l. * left; apply Rinv_0_lt_compat; apply lt_INR_0; apply -> Nat.neq_0_lt_0; red; intro; elim (fact_neq_0 _ H9). * left; apply Rinv_lt_contravar. -- apply Rmult_lt_0_compat; apply lt_INR_0; apply Nat.lt_0_succ. -- apply lt_INR; apply -> Nat.succ_lt_mono. pattern n at 1; replace n with (0 + n)%nat; [ idtac | reflexivity ]. apply Nat.add_lt_mono_r. apply Nat.lt_le_trans with 1%nat; [ apply Nat.lt_0_succ | assumption ]. + ring. } ** ring. ++ unfold Vn; rewrite Rmult_assoc; unfold Rdiv; rewrite (Rmult_comm (Un 0%nat)); rewrite (Rmult_comm (Un n)). repeat apply Rmult_le_compat_l. ** apply Rabs_pos. ** left; apply Rinv_0_lt_compat; apply lt_INR_0; apply Nat.lt_0_succ. ** apply decreasing_prop; [ assumption | apply Nat.le_0_l ]. -- unfold Un_decreasing; intro; unfold Un. replace (M_nat + S n)%nat with (M_nat + n + 1)%nat by ring. rewrite pow_add; unfold Rdiv; rewrite Rmult_assoc; apply Rmult_le_compat_l. { left; apply pow_lt; assumption. } replace (Rabs x ^ 1) with (Rabs x); [ idtac | simpl; ring ]. replace (M_nat + n + 1)%nat with (S (M_nat + n)) by ring. apply Rmult_le_reg_l with (INR (fact (S (M_nat + n)))). ++ apply lt_INR_0; apply Nat.neq_0_lt_0; red; intro; elim (fact_neq_0 _ H8). ++ rewrite (Rmult_comm (Rabs x)); rewrite <- Rmult_assoc; rewrite Rinv_r. ** rewrite Rmult_1_l. rewrite fact_simpl; rewrite mult_INR; rewrite Rmult_assoc; rewrite Rinv_r. { rewrite Rmult_1_r; apply Rle_trans with (INR M_nat). - left; rewrite INR_IZR_INZ. rewrite <- H4; assert (H8 := archimed (Rabs x)); elim H8; intros; assumption. - apply le_INR; lia. } apply INR_fact_neq_0. ** apply INR_fact_neq_0. -- intro; unfold Un; unfold Rdiv; apply Rmult_lt_0_compat. { apply pow_lt; assumption. } apply Rinv_0_lt_compat; apply lt_INR_0; apply Nat.neq_0_lt_0; red; intro; elim (fact_neq_0 _ H7). -- clear Un Vn; apply INR_le; simpl. induction M_nat as [| M_nat HrecM_nat]. ++ assert (H6 := archimed (Rabs x)); fold M in H6; elim H6; intros. rewrite H4 in H7; rewrite <- INR_IZR_INZ in H7. simpl in H7; elim (Rlt_irrefl _ (Rlt_trans _ _ _ H2 H7)). ++ apply (le_INR 1); apply le_n_S; apply Nat.le_0_l. + apply le_IZR; simpl; left; apply Rlt_trans with (Rabs x). { assumption. } elim (archimed (Rabs x)); intros; assumption. } unfold Un_cv; unfold Rdist; intros; elim (H eps H0); intros. exists x0; intros; apply Rle_lt_trans with (Rabs (Rabs x ^ n / INR (fact n) - 0)). - unfold Rminus; rewrite Ropp_0; do 2 rewrite Rplus_0_r; rewrite (Rabs_right (Rabs x ^ n / INR (fact n))). + unfold Rdiv; rewrite Rabs_mult; rewrite (Rabs_right (/ INR (fact n))). * rewrite RPow_abs; right; reflexivity. * apply Rle_ge; left; apply Rinv_0_lt_compat; apply lt_INR_0; apply Nat.neq_0_lt_0; red; intro; elim (fact_neq_0 _ H3). + apply Rle_ge; unfold Rdiv; apply Rmult_le_pos. * case (Req_dec x 0); intro. -- rewrite H3; rewrite Rabs_R0. induction n as [| n Hrecn]; [ simpl; left; apply Rlt_0_1 | simpl; rewrite Rmult_0_l; right; reflexivity ]. -- left; apply pow_lt; apply Rabs_pos_lt; assumption. * left; apply Rinv_0_lt_compat; apply lt_INR_0; apply Nat.neq_0_lt_0; red; intro; elim (fact_neq_0 _ H3). - apply H1; assumption. Qed. coq-8.20.0/theories/Reals/SeqSeries.v000066400000000000000000000412651466560755400173770ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* R -> R) (An:nat -> R) (x l1 l2:R) (N:nat), Un_cv (fun n:nat => SP fn n x) l1 -> Un_cv (fun n:nat => sum_f_R0 An n) l2 -> (forall n:nat, Rabs (fn n x) <= An n) -> Rabs (l1 - SP fn N x) <= l2 - sum_f_R0 An N. Proof. intros; assert (X:{ l:R | Un_cv (fun n => sum_f_R0 (fun l => fn (S N + l)%nat x) n) l }). { exists (l1 - SP fn N x). unfold Un_cv in H; unfold Un_cv; intros. elim (H eps H2); intros N0 H3. unfold Rdist in H3; exists N0; intros. unfold Rdist, SP. replace (sum_f_R0 (fun l:nat => fn (S N + l)%nat x) n - (l1 - sum_f_R0 (fun k:nat => fn k x) N)) with (sum_f_R0 (fun k:nat => fn k x) N + sum_f_R0 (fun l:nat => fn (S N + l)%nat x) n - l1); [ idtac | ring ]. replace (sum_f_R0 (fun k:nat => fn k x) N + sum_f_R0 (fun l:nat => fn (S N + l)%nat x) n) with (sum_f_R0 (fun k:nat => fn k x) (S (N + n))). { unfold SP in H3; apply H3. unfold ge; apply Nat.le_trans with n. - apply H4. - apply Nat.le_trans with (N + n)%nat. + apply Nat.le_add_l. + apply Nat.le_succ_diag_r. } cut (0 <= N)%nat. 2:{ apply Nat.le_0_l. } cut (N < S (N + n))%nat. 2:{ apply Nat.lt_succ_r. apply Nat.le_add_r. } intros; assert (H7 := sigma_split (fun k:nat => fn k x) H6 H5). unfold sigma in H7. do 2 rewrite Nat.sub_0_r in H7. replace (sum_f_R0 (fun k:nat => fn k x) (S (N + n))) with (sum_f_R0 (fun k:nat => fn (0 + k)%nat x) (S (N + n))) by reflexivity. replace (sum_f_R0 (fun k:nat => fn k x) N) with (sum_f_R0 (fun k:nat => fn (0 + k)%nat x) N) by reflexivity. assert ((S (N + n) - S N)%nat = n). { apply INR_eq; rewrite minus_INR. - do 2 rewrite S_INR; rewrite plus_INR; ring. - apply -> Nat.succ_le_mono; apply Nat.le_add_r. } rewrite H8 in H7. apply H7. } assert { l:R | Un_cv (fun n => sum_f_R0 (fun l => An (S N + l)%nat) n) l } as X0. { exists (l2 - sum_f_R0 An N). unfold Un_cv in H0; unfold Un_cv; intros. elim (H0 eps H2); intros N0 H3. unfold Rdist in H3; exists N0; intros. unfold Rdist; replace (sum_f_R0 (fun l:nat => An (S N + l)%nat) n - (l2 - sum_f_R0 An N)) with (sum_f_R0 An N + sum_f_R0 (fun l:nat => An (S N + l)%nat) n - l2); [ idtac | ring ]. replace (sum_f_R0 An N + sum_f_R0 (fun l:nat => An (S N + l)%nat) n) with (sum_f_R0 An (S (N + n))). 2:{ cut (0 <= N)%nat. 2:{ apply Nat.le_0_l. } cut (N < S (N + n))%nat. 2:{ apply Nat.lt_succ_r. apply Nat.le_add_r. } intros; assert (H7 := sigma_split An H6 H5). unfold sigma in H7. do 2 rewrite Nat.sub_0_r in H7. replace (sum_f_R0 An (S (N + n))) with (sum_f_R0 (fun k:nat => An (0 + k)%nat) (S (N + n))) by reflexivity. replace (sum_f_R0 An N) with (sum_f_R0 (fun k:nat => An (0 + k)%nat) N) by reflexivity. assert ((S (N + n) - S N)%nat = n). { apply INR_eq; rewrite minus_INR. - do 2 rewrite S_INR; rewrite plus_INR; ring. - apply -> Nat.succ_le_mono; apply Nat.le_add_r. } rewrite H8 in H7. apply H7. } apply H3; unfold ge; apply Nat.le_trans with n. - apply H4. - apply Nat.le_trans with (N + n)%nat. + apply Nat.le_add_l. + apply Nat.le_succ_diag_r. } elim X; intros l1N H2. elim X0; intros l2N H3. cut (l1 - SP fn N x = l1N). 1:intro; cut (l2 - sum_f_R0 An N = l2N). { intro; rewrite H4; rewrite H5. apply sum_cv_maj with (fun l:nat => An (S N + l)%nat) (fun (l:nat) (x:R) => fn (S N + l)%nat x) x. - unfold SP; apply H2. - apply H3. - intros; apply H1. } { symmetry ; eapply UL_sequence. { apply H3. } unfold Un_cv in H0; unfold Un_cv; intros; elim (H0 eps H5); intros N0 H6. unfold Rdist in H6; exists N0; intros. unfold Rdist; replace (sum_f_R0 (fun l:nat => An (S N + l)%nat) n - (l2 - sum_f_R0 An N)) with (sum_f_R0 An N + sum_f_R0 (fun l:nat => An (S N + l)%nat) n - l2); [ idtac | ring ]. replace (sum_f_R0 An N + sum_f_R0 (fun l:nat => An (S N + l)%nat) n) with (sum_f_R0 An (S (N + n))). { apply H6; unfold ge; apply Nat.le_trans with n. - apply H7. - apply Nat.le_trans with (N + n)%nat. + apply Nat.le_add_l. + apply Nat.le_succ_diag_r. } cut (0 <= N)%nat. 2:{ apply Nat.le_0_l. } cut (N < S (N + n))%nat. 2:{ apply Nat.lt_succ_r. apply Nat.le_add_r. } intros; assert (H10 := sigma_split An H9 H8). unfold sigma in H10. do 2 rewrite Nat.sub_0_r in H10. replace (sum_f_R0 An (S (N + n))) with (sum_f_R0 (fun k:nat => An (0 + k)%nat) (S (N + n))) by reflexivity. replace (sum_f_R0 An N) with (sum_f_R0 (fun k:nat => An (0 + k)%nat) N) by reflexivity. cut ((S (N + n) - S N)%nat = n). { intro; rewrite H11 in H10. apply H10. } apply INR_eq; rewrite minus_INR. - do 2 rewrite S_INR; rewrite plus_INR; ring. - apply le_n_S; apply Nat.le_add_r. } symmetry ; eapply UL_sequence. { apply H2. } unfold Un_cv in H; unfold Un_cv; intros. elim (H eps H4); intros N0 H5. unfold Rdist in H5; exists N0; intros. unfold Rdist, SP; replace (sum_f_R0 (fun l:nat => fn (S N + l)%nat x) n - (l1 - sum_f_R0 (fun k:nat => fn k x) N)) with (sum_f_R0 (fun k:nat => fn k x) N + sum_f_R0 (fun l:nat => fn (S N + l)%nat x) n - l1); [ idtac | ring ]. replace (sum_f_R0 (fun k:nat => fn k x) N + sum_f_R0 (fun l:nat => fn (S N + l)%nat x) n) with (sum_f_R0 (fun k:nat => fn k x) (S (N + n))). { unfold SP in H5; apply H5; unfold ge; apply Nat.le_trans with n. - apply H6. - apply Nat.le_trans with (N + n)%nat. + apply Nat.le_add_l. + apply Nat.le_succ_diag_r. } cut (0 <= N)%nat. 2:{ apply Nat.le_0_l. } cut (N < S (N + n))%nat. 2:{ apply Nat.lt_succ_r. apply Nat.le_add_r. } intros; assert (H9 := sigma_split (fun k:nat => fn k x) H8 H7). unfold sigma in H9. do 2 rewrite Nat.sub_0_r in H9. replace (sum_f_R0 (fun k:nat => fn k x) (S (N + n))) with (sum_f_R0 (fun k:nat => fn (0 + k)%nat x) (S (N + n))) by reflexivity. replace (sum_f_R0 (fun k:nat => fn k x) N) with (sum_f_R0 (fun k:nat => fn (0 + k)%nat x) N) by reflexivity. cut ((S (N + n) - S N)%nat = n). { intro; rewrite H10 in H9. apply H9. } apply INR_eq; rewrite minus_INR. - do 2 rewrite S_INR; rewrite plus_INR; ring. - apply le_n_S; apply Nat.le_add_r. Qed. (** Comparaison of convergence for series *) Lemma Rseries_CV_comp : forall An Bn:nat -> R, (forall n:nat, 0 <= An n <= Bn n) -> { l:R | Un_cv (fun N:nat => sum_f_R0 Bn N) l } -> { l:R | Un_cv (fun N:nat => sum_f_R0 An N) l }. Proof. intros An Bn H X; apply cv_cauchy_2. assert (H0 := cv_cauchy_1 _ X). unfold Cauchy_crit_series; unfold Cauchy_crit. intros; elim (H0 eps H1); intros. exists x; intros. cut (Rdist (sum_f_R0 An n) (sum_f_R0 An m) <= Rdist (sum_f_R0 Bn n) (sum_f_R0 Bn m)). { intro; apply Rle_lt_trans with (Rdist (sum_f_R0 Bn n) (sum_f_R0 Bn m)). - assumption. - apply H2; assumption. } destruct (lt_eq_lt_dec n m) as [[| -> ]|]. - rewrite (tech2 An n m); [ idtac | assumption ]. rewrite (tech2 Bn n m); [ idtac | assumption ]. unfold Rdist; unfold Rminus; do 2 rewrite Ropp_plus_distr; do 2 rewrite <- Rplus_assoc; do 2 rewrite Rplus_opp_r; do 2 rewrite Rplus_0_l; do 2 rewrite Rabs_Ropp; repeat rewrite Rabs_right. + apply sum_Rle; intros. elim (H (S n + n0)%nat); intros H7 H8. apply H8. + apply Rle_ge; apply cond_pos_sum; intro. elim (H (S n + n0)%nat); intros. apply Rle_trans with (An (S n + n0)%nat); assumption. + apply Rle_ge; apply cond_pos_sum; intro. elim (H (S n + n0)%nat); intros; assumption. - unfold Rdist; unfold Rminus; do 2 rewrite Rplus_opp_r; rewrite Rabs_R0; right; reflexivity. - rewrite (tech2 An m n); [ idtac | assumption ]. rewrite (tech2 Bn m n); [ idtac | assumption ]. unfold Rdist; unfold Rminus; do 2 rewrite Rplus_assoc; rewrite (Rplus_comm (sum_f_R0 An m)); rewrite (Rplus_comm (sum_f_R0 Bn m)); do 2 rewrite Rplus_assoc; do 2 rewrite Rplus_opp_l; do 2 rewrite Rplus_0_r; repeat rewrite Rabs_right. + apply sum_Rle; intros. elim (H (S m + n0)%nat); intros H7 H8; apply H8. + apply Rle_ge; apply cond_pos_sum; intro. elim (H (S m + n0)%nat); intros. apply Rle_trans with (An (S m + n0)%nat); assumption. + apply Rle_ge. apply cond_pos_sum; intro. elim (H (S m + n0)%nat); intros; assumption. Qed. (** Cesaro's theorem *) Lemma Cesaro : forall (An Bn:nat -> R) (l:R), Un_cv Bn l -> (forall n:nat, 0 < An n) -> cv_infty (fun n:nat => sum_f_R0 An n) -> Un_cv (fun n:nat => sum_f_R0 (fun k:nat => An k * Bn k) n / sum_f_R0 An n) l. Proof. unfold Un_cv; intros; assert (H3 : forall n:nat, 0 < sum_f_R0 An n). { intro; apply tech1; trivial. } assert (H4 : forall n:nat, sum_f_R0 An n <> 0). { intro; red; intro; assert (H5 := H3 n); rewrite H4 in H5; elim (Rlt_irrefl _ H5). } assert (H5 := cv_infty_cv_0 _ H1); assert (H6 : 0 < eps / 2). { unfold Rdiv; apply Rmult_lt_0_compat. - trivial. - apply Rinv_0_lt_compat; prove_sup. } elim (H _ H6); clear H; intros N1 H; set (C := Rabs (sum_f_R0 (fun k:nat => An k * (Bn k - l)) N1)); assert (H7 : exists N : nat, (forall n:nat, (N <= n)%nat -> C / sum_f_R0 An n < eps / 2)). { case (Req_dec C 0); intro. - exists 0%nat; intros. rewrite H7; unfold Rdiv; rewrite Rmult_0_l; apply Rmult_lt_0_compat. + trivial. + apply Rinv_0_lt_compat; prove_sup. - assert (H8 : 0 < eps / (2 * Rabs C)). + unfold Rdiv; apply Rmult_lt_0_compat. * trivial. * apply Rinv_0_lt_compat; apply Rmult_lt_0_compat. -- prove_sup. -- apply Rabs_pos_lt;assumption. + elim (H5 _ H8); intros; exists x; intros; assert (H11 := H9 _ H10); unfold Rdist in H11; unfold Rminus in H11; rewrite Ropp_0 in H11; rewrite Rplus_0_r in H11. apply Rle_lt_trans with (Rabs (C / sum_f_R0 An n)). { apply RRle_abs. } unfold Rdiv; rewrite Rabs_mult; apply Rmult_lt_reg_l with (/ Rabs C). { apply Rinv_0_lt_compat; apply Rabs_pos_lt;assumption. } rewrite <- Rmult_assoc; rewrite Rinv_l. * rewrite Rmult_1_l; replace (/ Rabs C * (eps * / 2)) with (eps / (2 * Rabs C)). { trivial. } field. apply Rabs_no_R0;assumption. * apply Rabs_no_R0;assumption. } elim H7; clear H7; intros N2 H7; set (N := max N1 N2); exists (S N); intros; unfold Rdist; replace (sum_f_R0 (fun k:nat => An k * Bn k) n / sum_f_R0 An n - l) with (sum_f_R0 (fun k:nat => An k * (Bn k - l)) n / sum_f_R0 An n). 2:{ replace (sum_f_R0 (fun k:nat => An k * (Bn k - l)) n) with (sum_f_R0 (fun k:nat => An k * Bn k) n + sum_f_R0 (fun k:nat => An k * - l) n). - rewrite <- (scal_sum An n (- l)); field. trivial. - rewrite <- plus_sum; apply sum_eq; intros; ring. } assert (H9 : (N1 < n)%nat). { apply Nat.lt_le_trans with (S N). - apply Nat.lt_succ_r; unfold N; apply Nat.le_max_l. - trivial. } rewrite (tech2 (fun k:nat => An k * (Bn k - l)) _ _ H9); unfold Rdiv; rewrite Rmult_plus_distr_r; apply Rle_lt_trans with (Rabs (sum_f_R0 (fun k:nat => An k * (Bn k - l)) N1 / sum_f_R0 An n) + Rabs (sum_f_R0 (fun i:nat => An (S N1 + i)%nat * (Bn (S N1 + i)%nat - l)) (n - S N1) / sum_f_R0 An n)). { apply Rabs_triang. } rewrite <-(Rplus_half_diag eps); apply Rplus_lt_compat. { unfold Rdiv; rewrite Rabs_mult; fold C; rewrite Rabs_right. - apply (H7 n); apply Nat.le_trans with (S N). + apply Nat.le_trans with N; [ unfold N; apply Nat.le_max_r | apply Nat.le_succ_diag_r ]. + trivial. - apply Rle_ge; left; apply Rinv_0_lt_compat;trivial. } unfold Rdist in H; unfold Rdiv; rewrite Rabs_mult; rewrite (Rabs_right (/ sum_f_R0 An n)). 2:{ apply Rle_ge; left; apply Rinv_0_lt_compat;trivial. } apply Rle_lt_trans with (sum_f_R0 (fun i:nat => Rabs (An (S N1 + i)%nat * (Bn (S N1 + i)%nat - l))) (n - S N1) * / sum_f_R0 An n). { do 2 rewrite <- (Rmult_comm (/ sum_f_R0 An n)); apply Rmult_le_compat_l. - left; apply Rinv_0_lt_compat;trivial. - apply (Rsum_abs (fun i:nat => An (S N1 + i)%nat * (Bn (S N1 + i)%nat - l)) (n - S N1)). } apply Rle_lt_trans with (sum_f_R0 (fun i:nat => An (S N1 + i)%nat * (eps / 2)) (n - S N1) * / sum_f_R0 An n). - do 2 rewrite <- (Rmult_comm (/ sum_f_R0 An n)); apply Rmult_le_compat_l. + left; apply Rinv_0_lt_compat. trivial. + apply sum_Rle; intros; rewrite Rabs_mult; pattern (An (S N1 + n0)%nat) at 2; rewrite <- (Rabs_right (An (S N1 + n0)%nat)). * apply Rmult_le_compat_l. -- apply Rabs_pos. -- left; apply H; unfold ge; apply Nat.le_trans with (S N1); [ apply Nat.le_succ_diag_r | apply Nat.le_add_r ]. * apply Rle_ge; left. trivial. - rewrite <- (scal_sum (fun i:nat => An (S N1 + i)%nat) (n - S N1) (eps / 2)); unfold Rdiv; repeat rewrite Rmult_assoc; apply Rmult_lt_compat_l. { trivial. } pattern (/ 2) at 2; rewrite <- Rmult_1_r; apply Rmult_lt_compat_l. + apply Rinv_0_lt_compat; prove_sup. + rewrite Rmult_comm; apply Rmult_lt_reg_l with (sum_f_R0 An n). { trivial. } rewrite <- Rmult_assoc; rewrite Rinv_r. 2:{ trivial. } rewrite Rmult_1_l; rewrite Rmult_1_r; rewrite (tech2 An N1 n). 2:{ trivial. } rewrite Rplus_comm; pattern (sum_f_R0 (fun i:nat => An (S N1 + i)%nat) (n - S N1)) at 1; rewrite <- Rplus_0_r; apply Rplus_lt_compat_l. trivial. Qed. Lemma Cesaro_1 : forall (An:nat -> R) (l:R), Un_cv An l -> Un_cv (fun n:nat => sum_f_R0 An (pred n) / INR n) l. Proof. intros Bn l H; set (An := fun _:nat => 1). assert (H0 : forall n:nat, 0 < An n). { intro; unfold An; apply Rlt_0_1. } assert (H1 : forall n:nat, 0 < sum_f_R0 An n). { intro; apply tech1. trivial. } assert (H2 : cv_infty (fun n:nat => sum_f_R0 An n)). { unfold cv_infty; intro; destruct (Rle_dec M 0) as [Hle|Hnle]. - exists 0%nat; intros; apply Rle_lt_trans with 0; trivial. - assert (H2 : 0 < M) by auto with real. clear Hnle; set (m := up M); elim (archimed M); intros; assert (H5 : (0 <= m)%Z). + apply le_IZR; unfold m; simpl; left; apply Rlt_trans with M; trivial. + elim (IZN _ H5); intros; exists x; intros; unfold An; rewrite sum_cte; rewrite Rmult_1_l; apply Rlt_trans with (IZR (up M));trivial. apply Rle_lt_trans with (INR x). * rewrite INR_IZR_INZ; fold m; rewrite <- H6; right. trivial. * apply lt_INR; apply Nat.lt_succ_r. trivial. } assert (H3 := Cesaro _ _ _ H H0 H2). unfold Un_cv; unfold Un_cv in H3; intros; elim (H3 _ H4); intros; exists (S x); intros; unfold Rdist; unfold Rdist in H5; apply Rle_lt_trans with (Rabs (sum_f_R0 (fun k:nat => An k * Bn k) (pred n) / sum_f_R0 An (pred n) - l)). - right; replace (sum_f_R0 Bn (pred n) / INR n - l) with (sum_f_R0 (fun k:nat => An k * Bn k) (pred n) / sum_f_R0 An (pred n) - l);trivial. unfold Rminus; do 2 rewrite <- (Rplus_comm (- l)); apply Rplus_eq_compat_l. unfold An; replace (sum_f_R0 (fun k:nat => 1 * Bn k) (pred n)) with (sum_f_R0 Bn (pred n)). + rewrite sum_cte; rewrite Rmult_1_l; replace (S (pred n)) with n;trivial. symmetry; apply Nat.lt_succ_pred with 0%nat; apply Nat.lt_le_trans with (S x);trivial. apply Nat.lt_0_succ. + apply sum_eq; intros; ring. - apply H5; unfold ge; apply le_S_n; replace (S (pred n)) with n;trivial. symmetry; apply Nat.lt_succ_pred with 0%nat; apply Nat.lt_le_trans with (S x);trivial. apply Nat.lt_0_succ. Qed. coq-8.20.0/theories/Reals/SplitAbsolu.v000066400000000000000000000020451466560755400177260ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* destruct (Rcase_abs X1) as [?Hlt|?Hge]; try split_case_Rabs end. Ltac split_Rabs := match goal with | id:context [(Rabs _)] |- _ => generalize id; clear id; try split_Rabs | |- context [(Rabs ?X1)] => unfold Rabs; try split_case_Rabs; intros end. coq-8.20.0/theories/Reals/SplitRmult.v000066400000000000000000000016631466560755400176110ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* 0`` /\ ``r2<>0`` -> ``r1*r2<>0``. i*) Require Import Rdefinitions Raxioms RIneq. Ltac split_Rmult := match goal with | |- ((?X1 * ?X2)%R <> 0%R) => apply Rmult_integral_contrapositive; split; try split_Rmult end. coq-8.20.0/theories/Reals/Sqrt_reg.v000066400000000000000000000300061466560755400172510ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* Rabs (sqrt (1 + h) - 1) <= Rabs h. Proof. intros; assert (0 <= 1 + h). { destruct (total_order_T h 0) as [[Hlt|Heq]|Hgt]. + rewrite (Rabs_left h Hlt) in H. apply Rplus_le_reg_l with (- h). rewrite Rplus_0_r; rewrite Rplus_comm; rewrite Rplus_assoc; rewrite Rplus_opp_r; rewrite Rplus_0_r; exact H. + left; rewrite Heq; rewrite Rplus_0_r; apply Rlt_0_1. + left; apply Rplus_lt_0_compat. * apply Rlt_0_1. * apply Hgt. } apply Rle_trans with (Rabs (sqrt (Rsqr (1 + h)) - 1)). 2:{ rewrite sqrt_Rsqr. - replace (1 + h - 1) with h; [ right; reflexivity | ring ]. - apply H0. } destruct (total_order_T h 0) as [[Hlt|Heq]|Hgt]. - repeat rewrite Rabs_left. + unfold Rminus; do 2 rewrite <- (Rplus_comm (-1)). change (-1) with (-(1)). do 2 rewrite Ropp_plus_distr; rewrite Ropp_involutive; apply Rplus_le_compat_l. apply Ropp_le_contravar; apply sqrt_le_1. * apply Rle_0_sqr. * apply H0. * pattern (1 + h) at 2; rewrite <- Rmult_1_r; unfold Rsqr; apply Rmult_le_compat_l; lra. + apply Rplus_lt_reg_l with 1; rewrite Rplus_0_r; rewrite Rplus_comm; unfold Rminus; rewrite Rplus_assoc; rewrite Rplus_opp_l; rewrite Rplus_0_r. pattern 1 at 2; rewrite <- sqrt_1; apply sqrt_lt_1. * apply Rle_0_sqr. * left; apply Rlt_0_1. * pattern 1 at 2; rewrite <- Rsqr_1; apply Rsqr_incrst_1;lra. + apply Rplus_lt_reg_l with 1; rewrite Rplus_0_r; rewrite Rplus_comm; unfold Rminus; rewrite Rplus_assoc; rewrite Rplus_opp_l; rewrite Rplus_0_r. pattern 1 at 2; rewrite <- sqrt_1; apply sqrt_lt_1;lra. - rewrite Heq; rewrite Rplus_0_r; rewrite Rsqr_1; rewrite sqrt_1; right; reflexivity. - repeat rewrite Rabs_right. + unfold Rminus; do 2 rewrite <- (Rplus_comm (-1)); apply Rplus_le_compat_l. apply sqrt_le_1. * apply H0. * apply Rle_0_sqr. * pattern (1 + h) at 1; rewrite <- Rmult_1_r; unfold Rsqr; apply Rmult_le_compat_l;lra. + apply Rle_ge; apply Rplus_le_reg_l with 1. rewrite Rplus_0_r; rewrite Rplus_comm; unfold Rminus; rewrite Rplus_assoc; rewrite Rplus_opp_l; rewrite Rplus_0_r. pattern 1 at 1; rewrite <- sqrt_1; apply sqrt_le_1. * left; apply Rlt_0_1. * apply Rle_0_sqr. * pattern 1 at 1; rewrite <- Rsqr_1; apply Rsqr_incr_1;lra. + apply Rle_ge; left; apply Rplus_lt_reg_l with 1. rewrite Rplus_0_r; rewrite Rplus_comm; unfold Rminus; rewrite Rplus_assoc; rewrite Rplus_opp_l; rewrite Rplus_0_r. pattern 1 at 1; rewrite <- sqrt_1; apply sqrt_lt_1;lra. Qed. (** sqrt is continuous in 1 *) Lemma sqrt_continuity_pt_R1 : continuity_pt sqrt 1. Proof. unfold continuity_pt; unfold continue_in; unfold limit1_in; unfold limit_in; unfold dist; simpl; unfold Rdist; intros. set (alpha := Rmin eps 1). exists alpha; intros. split. - unfold alpha; unfold Rmin; case (Rle_dec eps 1); intro. + assumption. + apply Rlt_0_1. - intros; elim H0; intros. rewrite sqrt_1; replace x with (1 + (x - 1)); [ idtac | ring ]; apply Rle_lt_trans with (Rabs (x - 1)). + apply sqrt_var_maj. apply Rle_trans with alpha. * left; apply H2. * unfold alpha; apply Rmin_r. + apply Rlt_le_trans with alpha; [ apply H2 | unfold alpha; apply Rmin_l ]. Qed. (** sqrt is continuous forall x>0 *) Lemma sqrt_continuity_pt : forall x:R, 0 < x -> continuity_pt sqrt x. Proof. intros; generalize sqrt_continuity_pt_R1. unfold continuity_pt; unfold continue_in; unfold limit1_in; unfold limit_in; unfold dist; simpl; unfold Rdist; intros. assert (0 < eps / sqrt x). { unfold Rdiv; apply Rmult_lt_0_compat. - apply H1. - apply Rinv_0_lt_compat; apply sqrt_lt_R0; apply H. } elim (H0 _ H2); intros alp_1 H3. elim H3; intros. set (alpha := alp_1 * x). exists (Rmin alpha x); intros. split. { change (0 < Rmin alpha x); unfold Rmin; case (Rle_dec alpha x); intro. - unfold alpha; apply Rmult_lt_0_compat; assumption. - apply H. } intros; replace x0 with (x + (x0 - x)); [ idtac | ring ]; replace (sqrt (x + (x0 - x)) - sqrt x) with (sqrt x * (sqrt (1 + (x0 - x) / x) - sqrt 1)). 2:{ unfold Rminus; rewrite Rmult_plus_distr_l; rewrite Ropp_mult_distr_r_reverse; repeat rewrite <- sqrt_mult. - rewrite Rmult_1_r; rewrite Rmult_plus_distr_l; rewrite Rmult_1_r; unfold Rdiv; rewrite Rmult_comm; rewrite Rmult_assoc; rewrite Rinv_l. + rewrite Rmult_1_r; reflexivity. + red; intro; rewrite H7 in H; elim (Rlt_irrefl _ H). - left; apply H. - left; apply Rlt_0_1. - left; apply H. - elim H6; intros. destruct (Rcase_abs (x0 - x)) as [Hlt|Hgt]. + rewrite (Rabs_left (x0 - x) Hlt) in H8. rewrite Rplus_comm. apply Rplus_le_reg_l with (- ((x0 - x) / x)). rewrite Rplus_0_r; rewrite <- Rplus_assoc; rewrite Rplus_opp_l; rewrite Rplus_0_l; unfold Rdiv; rewrite <- Ropp_mult_distr_l_reverse. apply Rmult_le_reg_l with x. * apply H. * rewrite Rmult_1_r; rewrite Rmult_comm; rewrite Rmult_assoc; rewrite Rinv_l. -- rewrite Rmult_1_r; left; apply Rlt_le_trans with (Rmin alpha x). ++ apply H8. ++ apply Rmin_r. -- lra. + apply Rplus_le_le_0_compat. * lra. * unfold Rdiv; apply Rmult_le_pos. -- lra. -- left; apply Rinv_0_lt_compat; apply H. } rewrite Rabs_mult; rewrite (Rabs_right (sqrt x)). 2:{ apply Rle_ge; apply sqrt_positivity. left; apply H. } apply Rmult_lt_reg_l with (/ sqrt x). { apply Rinv_0_lt_compat; apply sqrt_lt_R0; assumption. } rewrite <- Rmult_assoc; rewrite Rinv_l. 2:{ assert (H7 := sqrt_lt_R0 x H). lra. } rewrite Rmult_1_l; rewrite Rmult_comm. unfold Rdiv in H5. case (Req_dec x x0); intro. { rewrite H7; unfold Rminus, Rdiv; rewrite Rplus_opp_r; rewrite Rmult_0_l; rewrite Rplus_0_r; rewrite Rplus_opp_r; rewrite Rabs_R0. apply Rmult_lt_0_compat. - assumption. - apply Rinv_0_lt_compat; rewrite <- H7; apply sqrt_lt_R0; assumption. } apply H5. split. - unfold D_x, no_cond. split. + trivial. + red; intro. assert ((x0 - x) * / x = 0) by lra. elim (Rmult_integral _ _ H9); intro. { lra. } assert (H11 := Rmult_eq_0_compat_r _ x H10). rewrite Rinv_l in H11;lra. - unfold Rminus; rewrite Rplus_comm; rewrite <- Rplus_assoc; rewrite Rplus_opp_l; rewrite Rplus_0_l; elim H6; intros. unfold Rdiv; rewrite Rabs_mult. rewrite Rabs_inv. rewrite (Rabs_right x). + rewrite Rmult_comm; apply Rmult_lt_reg_l with x. { apply H. } rewrite <- Rmult_assoc; rewrite Rinv_r. 2:{ lra. } rewrite Rmult_1_l; rewrite Rmult_comm; fold alpha. apply Rlt_le_trans with (Rmin alpha x). * apply H9. * apply Rmin_l. + apply Rle_ge; left; apply H. Qed. (** sqrt is derivable for all x>0 *) Lemma derivable_pt_lim_sqrt : forall x:R, 0 < x -> derivable_pt_lim sqrt x (/ (2 * sqrt x)). Proof. intros; set (g := fun h:R => sqrt x + sqrt (x + h)). assert (continuity_pt g 0). { replace g with (fct_cte (sqrt x) + comp sqrt (fct_cte x + id))%F; [ idtac | reflexivity ]. apply continuity_pt_plus. - apply continuity_pt_const; unfold constant, fct_cte; intro; reflexivity. - apply continuity_pt_comp. + apply continuity_pt_plus. * apply continuity_pt_const; unfold constant, fct_cte; intro; reflexivity. * apply derivable_continuous_pt; apply derivable_pt_id. + apply sqrt_continuity_pt. unfold plus_fct, fct_cte, id; rewrite Rplus_0_r; apply H. } assert (g 0 <> 0). { unfold g; rewrite Rplus_0_r. assert (0 < sqrt x + sqrt x);[|lra]. apply Rplus_lt_0_compat; apply sqrt_lt_R0; apply H. } intro; assert (H2 := continuity_pt_inv g 0 H0 H1). unfold derivable_pt_lim; intros; unfold continuity_pt in H2; unfold continue_in in H2; unfold limit1_in in H2; unfold limit_in in H2; simpl in H2; unfold Rdist in H2. elim (H2 eps H3); intros alpha H4. elim H4; intros. set (alpha1 := Rmin alpha x). assert (0 < alpha1). { unfold alpha1; unfold Rmin; case (Rle_dec alpha x); intro;lra. } exists (mkposreal alpha1 H7); intros. replace ((sqrt (x + h) - sqrt x) / h) with (/ (sqrt x + sqrt (x + h))). { unfold inv_fct, g in H6; replace (2 * sqrt x) with (sqrt x + sqrt (x + 0)). - apply H6. split. + unfold D_x, no_cond. split. * trivial. * apply (not_eq_sym (A:=R)); exact H8. + unfold Rminus; rewrite Ropp_0; rewrite Rplus_0_r; apply Rlt_le_trans with alpha1. * exact H9. * unfold alpha1; apply Rmin_l. - rewrite Rplus_0_r; ring. } assert (0 <= x + h). { destruct (Rcase_abs h) as [Hlt|Hgt]. 2:lra. rewrite (Rabs_left h Hlt) in H9. apply Rplus_le_reg_l with (- h). rewrite Rplus_0_r; rewrite Rplus_comm; rewrite Rplus_assoc; rewrite Rplus_opp_r; rewrite Rplus_0_r; left; apply Rlt_le_trans with alpha1. - apply H9. - unfold alpha1; apply Rmin_r. } assert (0 < sqrt x + sqrt (x + h)). { apply Rplus_lt_le_0_compat. - apply sqrt_lt_R0; apply H. - apply sqrt_positivity; apply H10. } apply Rmult_eq_reg_l with (sqrt x + sqrt (x + h)). 2:lra. rewrite Rinv_r. 2:lra. rewrite Rplus_comm; unfold Rdiv; rewrite <- Rmult_assoc; rewrite Rsqr_plus_minus; repeat rewrite Rsqr_sqrt. 2,3: lra. rewrite Rplus_comm; unfold Rminus; rewrite Rplus_assoc; rewrite Rplus_opp_r; rewrite Rplus_0_r; rewrite Rinv_r;lra. Qed. (**********) Lemma derivable_pt_sqrt : forall x:R, 0 < x -> derivable_pt sqrt x. Proof. unfold derivable_pt; intros. exists (/ (2 * sqrt x)). apply derivable_pt_lim_sqrt; assumption. Qed. (**********) Lemma derive_pt_sqrt : forall (x:R) (pr:0 < x), derive_pt sqrt x (derivable_pt_sqrt _ pr) = / (2 * sqrt x). Proof. intros. apply derive_pt_eq_0. apply derivable_pt_lim_sqrt; assumption. Qed. (** We show that sqrt is continuous for all x>=0 *) (** Remark : by definition of sqrt (as extension of Rsqrt on |R), we could also show that sqrt is continuous for all x *) Lemma continuity_pt_sqrt : forall x:R, 0 <= x -> continuity_pt sqrt x. Proof. intros; case (Rtotal_order 0 x); intro. { apply (sqrt_continuity_pt x H0). } elim H0; intro. 2:exfalso;lra. unfold continuity_pt; unfold continue_in; unfold limit1_in; unfold limit_in; simpl; unfold Rdist; intros. exists (Rsqr eps); intros. split. { change (0 < Rsqr eps); apply Rsqr_pos_lt;lra. } intros; elim H3; intros. rewrite <- H1; rewrite sqrt_0; unfold Rminus; rewrite Ropp_0; rewrite Rplus_0_r; rewrite <- H1 in H5; unfold Rminus in H5; rewrite Ropp_0 in H5; rewrite Rplus_0_r in H5. destruct (Rcase_abs x0) as [Hlt|Hgt] eqn:Heqs. { unfold sqrt. rewrite Heqs. rewrite Rabs_R0; apply H2. } rewrite Rabs_right. 2: apply Rle_ge; apply sqrt_positivity; apply Rge_le; exact Hgt. apply Rsqr_incrst_0. - rewrite Rsqr_sqrt. + rewrite (Rabs_right x0 Hgt) in H5; apply H5. + apply Rge_le; exact Hgt. - apply sqrt_positivity; apply Rge_le; exact Hgt. - left; exact H2. Qed. coq-8.20.0/theories/Relations/000077500000000000000000000000001466560755400161675ustar00rootroot00000000000000coq-8.20.0/theories/Relations/Operators_Properties.v000066400000000000000000000331541466560755400225560ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* clos_trans R y z -> clos_trans R x z. Proof. induction 1 as [b d H1|b|a b d H1 H2 IH1 IH2]; auto. intro H. apply (t_trans _ _ _ d); auto. constructor. auto. Qed. (** Correctness of the reflexive-symmetric-transitive closure *) Lemma clos_rst_is_equiv : equivalence A (clos_refl_sym_trans R). Proof. apply Build_equivalence. - exact (rst_refl A R). - exact (rst_trans A R). - exact (rst_sym A R). Qed. (** Idempotency of the reflexive-symmetric-transitive closure operator *) Lemma clos_rst_idempotent : inclusion (clos_refl_sym_trans (clos_refl_sym_trans R)) (clos_refl_sym_trans R). Proof. red. induction 1 as [x y H|x|x y H IH|x y z H IH H0 IH0]; auto with sets. apply rst_trans with y; auto with sets. Qed. End Clos_Refl_Sym_Trans. Section Equivalences. (** *** Equivalences between the different definition of the reflexive, symmetric, transitive closures *) (** *** Contributed by P. Castéran *) (** Direct transitive closure vs left-step extension *) Lemma clos_t1n_trans : forall x y, clos_trans_1n R x y -> clos_trans R x y. Proof. induction 1 as [x y H|x y z H H0 IH0]. - left; assumption. - right with y; auto. left; auto. Qed. Lemma clos_trans_t1n : forall x y, clos_trans R x y -> clos_trans_1n R x y. Proof. induction 1 as [x y H|x y z H IHclos_trans1 H0 IHclos_trans2]. - left; assumption. - generalize IHclos_trans2; clear IHclos_trans2. induction IHclos_trans1 as [x y H1|x y z0 H1 ? IHIHclos_trans1]. + right with y; auto. + right with y; auto. eapply IHIHclos_trans1; auto. apply clos_t1n_trans; auto. Qed. Lemma clos_trans_t1n_iff : forall x y, clos_trans R x y <-> clos_trans_1n R x y. Proof. split. - apply clos_trans_t1n. - apply clos_t1n_trans. Qed. (** Direct transitive closure vs right-step extension *) Lemma clos_tn1_trans : forall x y, clos_trans_n1 R x y -> clos_trans R x y. Proof. induction 1 as [y H|y z H H0 ?]. - left; assumption. - right with y; auto. left; assumption. Qed. Lemma clos_trans_tn1 : forall x y, clos_trans R x y -> clos_trans_n1 R x y. Proof. induction 1 as [x y H|x y z H IHclos_trans1 H0 IHclos_trans2]. - left; assumption. - elim IHclos_trans2. + intro y0; right with y. * auto. * auto. + intro y0; intros. right with y0; auto. Qed. Lemma clos_trans_tn1_iff : forall x y, clos_trans R x y <-> clos_trans_n1 R x y. Proof. split. - apply clos_trans_tn1. - apply clos_tn1_trans. Qed. (** Direct reflexive-transitive closure is equivalent to transitivity by left-step extension *) Lemma clos_rt1n_step : forall x y, R x y -> clos_refl_trans_1n R x y. Proof. intros x y H. right with y;[assumption|left]. Qed. Lemma clos_rtn1_step : forall x y, R x y -> clos_refl_trans_n1 R x y. Proof. intros x y H. right with x;[assumption|left]. Qed. Lemma clos_rt1n_rt : forall x y, clos_refl_trans_1n R x y -> clos_refl_trans R x y. Proof. induction 1 as [|x y z]. - constructor 2. - constructor 3 with y; auto. constructor 1; auto. Qed. Lemma clos_rt_rt1n : forall x y, clos_refl_trans R x y -> clos_refl_trans_1n R x y. Proof. induction 1 as [| |x y z H IHclos_refl_trans1 H0 IHclos_refl_trans2]. - apply clos_rt1n_step; assumption. - left. - generalize IHclos_refl_trans2; clear IHclos_refl_trans2; induction IHclos_refl_trans1 as [|x y z0 H1 ? IH]; auto. right with y; auto. eapply IH; auto. apply clos_rt1n_rt; auto. Qed. Lemma clos_rt_rt1n_iff : forall x y, clos_refl_trans R x y <-> clos_refl_trans_1n R x y. Proof. split. - apply clos_rt_rt1n. - apply clos_rt1n_rt. Qed. (** Direct reflexive-transitive closure is equivalent to transitivity by right-step extension *) Lemma clos_rtn1_rt : forall x y, clos_refl_trans_n1 R x y -> clos_refl_trans R x y. Proof. induction 1 as [|y z]. - constructor 2. - constructor 3 with y; auto. constructor 1; assumption. Qed. Lemma clos_rt_rtn1 : forall x y, clos_refl_trans R x y -> clos_refl_trans_n1 R x y. Proof. induction 1 as [| |x y z H1 IH1 H2 IH2]. - apply clos_rtn1_step; auto. - left. - elim IH2; auto. intro y0; intros. right with y0; auto. Qed. Lemma clos_rt_rtn1_iff : forall x y, clos_refl_trans R x y <-> clos_refl_trans_n1 R x y. Proof. split. - apply clos_rt_rtn1. - apply clos_rtn1_rt. Qed. (** Induction on the left transitive step *) Lemma clos_refl_trans_ind_left : forall (x:A) (P:A -> Prop), P x -> (forall y z:A, clos_refl_trans R x y -> P y -> R y z -> P z) -> forall z:A, clos_refl_trans R x z -> P z. Proof. intros x P H H0 z H1. revert H H0. induction H1 as [x| |x y z H1 IH1 H2 IH2]; intros HP HIS; auto with sets. - apply HIS with x; auto with sets. - apply IH2. + apply IH1; auto with sets. + intro y0; intros; apply HIS with y0; auto with sets. apply rt_trans with y; auto with sets. Qed. (** Induction on the right transitive step *) Lemma rt1n_ind_right : forall (P : A -> Prop) (z:A), P z -> (forall x y, R x y -> clos_refl_trans_1n R y z -> P y -> P x) -> forall x, clos_refl_trans_1n R x z -> P x. intros P z H H0 x; induction 1 as [|x y z]; auto. apply H0 with y; auto. Qed. Lemma clos_refl_trans_ind_right : forall (P : A -> Prop) (z:A), P z -> (forall x y, R x y -> P y -> clos_refl_trans R y z -> P x) -> forall x, clos_refl_trans R x z -> P x. intros P z Hz IH x Hxz. apply clos_rt_rt1n_iff in Hxz. elim Hxz using rt1n_ind_right; auto. clear x Hxz. intros x y Hxy Hyz Hy. apply clos_rt_rt1n_iff in Hyz. eauto. Qed. (** Direct reflexive-symmetric-transitive closure is equivalent to transitivity by symmetric left-step extension *) Lemma clos_rst1n_rst : forall x y, clos_refl_sym_trans_1n R x y -> clos_refl_sym_trans R x y. Proof. induction 1 as [|x y z H]. - constructor 2. - constructor 4 with y; auto. case H;[constructor 1|constructor 3; constructor 1]; auto. Qed. Lemma clos_rst1n_trans : forall x y z, clos_refl_sym_trans_1n R x y -> clos_refl_sym_trans_1n R y z -> clos_refl_sym_trans_1n R x z. induction 1 as [|x y z0]. - auto. - intros; right with y; eauto. Qed. Lemma clos_rst1n_sym : forall x y, clos_refl_sym_trans_1n R x y -> clos_refl_sym_trans_1n R y x. Proof. intros x y H; elim H. - constructor 1. - intros x0 y0 z D H0 H1; apply clos_rst1n_trans with y0; auto. right with x0. + tauto. + left. Qed. Lemma clos_rst_rst1n : forall x y, clos_refl_sym_trans R x y -> clos_refl_sym_trans_1n R x y. induction 1 as [x y| | |]. - constructor 2 with y; auto. constructor 1. - constructor 1. - apply clos_rst1n_sym; auto. - eapply clos_rst1n_trans; eauto. Qed. Lemma clos_rst_rst1n_iff : forall x y, clos_refl_sym_trans R x y <-> clos_refl_sym_trans_1n R x y. Proof. split. - apply clos_rst_rst1n. - apply clos_rst1n_rst. Qed. (** Direct reflexive-symmetric-transitive closure is equivalent to transitivity by symmetric right-step extension *) Lemma clos_rstn1_rst : forall x y, clos_refl_sym_trans_n1 R x y -> clos_refl_sym_trans R x y. Proof. induction 1 as [|y z H]. - constructor 2. - constructor 4 with y; auto. case H;[constructor 1|constructor 3; constructor 1]; auto. Qed. Lemma clos_rstn1_trans : forall x y z, clos_refl_sym_trans_n1 R x y -> clos_refl_sym_trans_n1 R y z -> clos_refl_sym_trans_n1 R x z. Proof. intros x y z H1 H2. induction H2 as [|y0 z]. - auto. - right with y0; eauto. Qed. Lemma clos_rstn1_sym : forall x y, clos_refl_sym_trans_n1 R x y -> clos_refl_sym_trans_n1 R y x. Proof. intros x y H; elim H. - constructor 1. - intros y0 z D H0 H1. apply clos_rstn1_trans with y0; auto. right with z. + tauto. + left. Qed. Lemma clos_rst_rstn1 : forall x y, clos_refl_sym_trans R x y -> clos_refl_sym_trans_n1 R x y. Proof. induction 1 as [x| | |]. - constructor 2 with x; auto. constructor 1. - constructor 1. - apply clos_rstn1_sym; auto. - eapply clos_rstn1_trans; eauto. Qed. Lemma clos_rst_rstn1_iff : forall x y, clos_refl_sym_trans R x y <-> clos_refl_sym_trans_n1 R x y. Proof. split. - apply clos_rst_rstn1. - apply clos_rstn1_rst. Qed. End Equivalences. Lemma clos_trans_transp_permute : forall x y, transp _ (clos_trans R) x y <-> clos_trans (transp _ R) x y. Proof. split; induction 1; (apply t_step; assumption) || eapply t_trans; eassumption. Qed. End Properties. (* begin hide *) (* Compatibility *) Notation trans_tn1 := clos_trans_tn1 (only parsing). Notation tn1_trans := clos_tn1_trans (only parsing). Notation tn1_trans_equiv := clos_trans_tn1_iff (only parsing). Notation trans_t1n := clos_trans_t1n (only parsing). Notation t1n_trans := clos_t1n_trans (only parsing). Notation t1n_trans_equiv := clos_trans_t1n_iff (only parsing). Notation R_rtn1 := clos_rtn1_step (only parsing). Notation trans_rt1n := clos_rt_rt1n (only parsing). Notation rt1n_trans := clos_rt1n_rt (only parsing). Notation rt1n_trans_equiv := clos_rt_rt1n_iff (only parsing). Notation R_rt1n := clos_rt1n_step (only parsing). Notation trans_rtn1 := clos_rt_rtn1 (only parsing). Notation rtn1_trans := clos_rtn1_rt (only parsing). Notation rtn1_trans_equiv := clos_rt_rtn1_iff (only parsing). Notation rts1n_rts := clos_rst1n_rst (only parsing). Notation rts_1n_trans := clos_rst1n_trans (only parsing). Notation rts1n_sym := clos_rst1n_sym (only parsing). Notation rts_rts1n := clos_rst_rst1n (only parsing). Notation rts_rts1n_equiv := clos_rst_rst1n_iff (only parsing). Notation rtsn1_rts := clos_rstn1_rst (only parsing). Notation rtsn1_trans := clos_rstn1_trans (only parsing). Notation rtsn1_sym := clos_rstn1_sym (only parsing). Notation rts_rtsn1 := clos_rst_rstn1 (only parsing). Notation rts_rtsn1_equiv := clos_rst_rstn1_iff (only parsing). (* end hide *) coq-8.20.0/theories/Relations/Relation_Definitions.v000066400000000000000000000047011466560755400224700ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* A -> Prop. Variable R : relation. Section General_Properties_of_Relations. Definition reflexive : Prop := forall x:A, R x x. Definition transitive : Prop := forall x y z:A, R x y -> R y z -> R x z. Definition symmetric : Prop := forall x y:A, R x y -> R y x. Definition antisymmetric : Prop := forall x y:A, R x y -> R y x -> x = y. (* for compatibility with Equivalence in ../PROGRAMS/ALG/ *) Definition equiv := reflexive /\ transitive /\ symmetric. End General_Properties_of_Relations. Section Sets_of_Relations. Record preorder : Prop := { preord_refl : reflexive; preord_trans : transitive}. Record order : Prop := { ord_refl : reflexive; ord_trans : transitive; ord_antisym : antisymmetric}. Record equivalence : Prop := { equiv_refl : reflexive; equiv_trans : transitive; equiv_sym : symmetric}. Record PER : Prop := {per_sym : symmetric; per_trans : transitive}. End Sets_of_Relations. Section Relations_of_Relations. Definition inclusion (R1 R2:relation) : Prop := forall x y:A, R1 x y -> R2 x y. Definition same_relation (R1 R2:relation) : Prop := inclusion R1 R2 /\ inclusion R2 R1. Definition commut (R1 R2:relation) : Prop := forall x y:A, R1 y x -> forall z:A, R2 z y -> exists2 y' : A, R2 y' x & R1 z y'. End Relations_of_Relations. End Relation_Definition. #[global] Hint Unfold reflexive transitive antisymmetric symmetric: sets. #[global] Hint Resolve Build_preorder Build_order Build_equivalence Build_PER preord_refl preord_trans ord_refl ord_trans ord_antisym equiv_refl equiv_trans equiv_sym per_sym per_trans: sets. #[global] Hint Unfold inclusion same_relation commut: sets. coq-8.20.0/theories/Relations/Relation_Operators.v000066400000000000000000000207451466560755400222010ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* Prop := | t_step (y:A) : R x y -> clos_trans x y | t_trans (y z:A) : clos_trans x y -> clos_trans y z -> clos_trans x z. (** Alternative definition by transitive extension on the left *) Inductive clos_trans_1n (x: A) : A -> Prop := | t1n_step (y:A) : R x y -> clos_trans_1n x y | t1n_trans (y z:A) : R x y -> clos_trans_1n y z -> clos_trans_1n x z. (** Alternative definition by transitive extension on the right *) Inductive clos_trans_n1 (x: A) : A -> Prop := | tn1_step (y:A) : R x y -> clos_trans_n1 x y | tn1_trans (y z:A) : R y z -> clos_trans_n1 x y -> clos_trans_n1 x z. End Transitive_Closure. (** ** Reflexive closure *) Section Reflexive_Closure. Variable A : Type. Variable R : relation A. (** Definition by direct transitive closure *) Inductive clos_refl (x: A) : A -> Prop := | r_step (y:A) : R x y -> clos_refl x y | r_refl : clos_refl x x. End Reflexive_Closure. (** ** Reflexive-transitive closure *) Section Reflexive_Transitive_Closure. Variable A : Type. Variable R : relation A. (** Definition by direct reflexive-transitive closure *) Inductive clos_refl_trans (x:A) : A -> Prop := | rt_step (y:A) : R x y -> clos_refl_trans x y | rt_refl : clos_refl_trans x x | rt_trans (y z:A) : clos_refl_trans x y -> clos_refl_trans y z -> clos_refl_trans x z. (** Alternative definition by transitive extension on the left *) Inductive clos_refl_trans_1n (x: A) : A -> Prop := | rt1n_refl : clos_refl_trans_1n x x | rt1n_trans (y z:A) : R x y -> clos_refl_trans_1n y z -> clos_refl_trans_1n x z. (** Alternative definition by transitive extension on the right *) Inductive clos_refl_trans_n1 (x: A) : A -> Prop := | rtn1_refl : clos_refl_trans_n1 x x | rtn1_trans (y z:A) : R y z -> clos_refl_trans_n1 x y -> clos_refl_trans_n1 x z. End Reflexive_Transitive_Closure. (** ** Reflexive-symmetric-transitive closure *) Section Reflexive_Symmetric_Transitive_Closure. Variable A : Type. Variable R : relation A. (** Definition by direct reflexive-symmetric-transitive closure *) Inductive clos_refl_sym_trans : relation A := | rst_step (x y:A) : R x y -> clos_refl_sym_trans x y | rst_refl (x:A) : clos_refl_sym_trans x x | rst_sym (x y:A) : clos_refl_sym_trans x y -> clos_refl_sym_trans y x | rst_trans (x y z:A) : clos_refl_sym_trans x y -> clos_refl_sym_trans y z -> clos_refl_sym_trans x z. (** Alternative definition by symmetric-transitive extension on the left *) Inductive clos_refl_sym_trans_1n (x: A) : A -> Prop := | rst1n_refl : clos_refl_sym_trans_1n x x | rst1n_trans (y z:A) : R x y \/ R y x -> clos_refl_sym_trans_1n y z -> clos_refl_sym_trans_1n x z. (** Alternative definition by symmetric-transitive extension on the right *) Inductive clos_refl_sym_trans_n1 (x: A) : A -> Prop := | rstn1_refl : clos_refl_sym_trans_n1 x x | rstn1_trans (y z:A) : R y z \/ R z y -> clos_refl_sym_trans_n1 x y -> clos_refl_sym_trans_n1 x z. End Reflexive_Symmetric_Transitive_Closure. (** ** Converse of a relation *) Section Converse. Variable A : Type. Variable R : relation A. Definition transp (x y:A) := R y x. End Converse. (** ** Union of relations *) Section Union. Variable A : Type. Variables R1 R2 : relation A. Definition union (x y:A) := R1 x y \/ R2 x y. End Union. (** ** Disjoint union of relations *) Section Disjoint_Union. Variables A B : Type. Variable leA : A -> A -> Prop. Variable leB : B -> B -> Prop. Inductive le_AsB : A + B -> A + B -> Prop := | le_aa (x y:A) : leA x y -> le_AsB (inl _ x) (inl _ y) | le_ab (x:A) (y:B) : le_AsB (inl _ x) (inr _ y) | le_bb (x y:B) : leB x y -> le_AsB (inr _ x) (inr _ y). End Disjoint_Union. (** ** Lexicographic order on dependent pairs *) Section Lexicographic_Product. Import SigTNotations. Variable A : Type. Variable B : A -> Type. Variable leA : A -> A -> Prop. Variable leB : forall x:A, B x -> B x -> Prop. Inductive lexprod : sigT B -> sigT B -> Prop := | left_lex : forall (x x' : A) (y : B x) (y' : B x'), leA x x' -> lexprod (x; y) (x'; y') | right_lex : forall (x : A) (y y' : B x), leB x y y' -> lexprod (x; y) (x; y'). End Lexicographic_Product. (** ** Lexicographic order on pairs *) Section Simple_Lexicographic_Product. Variable A : Type. Variable B : Type. Variable leA : A -> A -> Prop. Variable leB : B -> B -> Prop. Inductive slexprod : A * B -> A * B -> Prop := | left_slex : forall (x x' : A) (y : B) (y' : B), leA x x' -> slexprod (x, y) (x', y') | right_slex : forall (x : A) (y y' : B), leB y y' -> slexprod (x, y) (x, y'). Lemma slexprod_lexprod p1 p2 : slexprod p1 p2 <-> lexprod _ _ leA (fun _ => leB) (sigT_of_prod p1) (sigT_of_prod p2). Proof. now split; intros HP; destruct p1, p2; inversion HP; constructor. Qed. End Simple_Lexicographic_Product. (** ** Product of relations *) Section Symmetric_Product. Variable A : Type. Variable B : Type. Variable leA : A -> A -> Prop. Variable leB : B -> B -> Prop. Inductive symprod : A * B -> A * B -> Prop := | left_sym : forall x x':A, leA x x' -> forall y:B, symprod (x, y) (x', y) | right_sym : forall y y':B, leB y y' -> forall x:A, symprod (x, y) (x, y'). End Symmetric_Product. (** ** Multiset of two relations *) Section Swap. Variable A : Type. Variable R : A -> A -> Prop. Inductive swapprod : A * A -> A * A -> Prop := | sp_noswap x y (p:A * A) : symprod A A R R (x, y) p -> swapprod (x, y) p | sp_swap x y (p:A * A) : symprod A A R R (x, y) p -> swapprod (y, x) p. End Swap. Local Open Scope list_scope. Section Lexicographic_Exponentiation. Variable A : Set. Variable leA : A -> A -> Prop. Let Nil := nil (A:=A). Let List := list A. Inductive Ltl : List -> List -> Prop := | Lt_nil (a:A) (x:List) : Ltl Nil (a :: x) | Lt_hd (a b:A) : leA a b -> forall x y:list A, Ltl (a :: x) (b :: y) | Lt_tl (a:A) (x y:List) : Ltl x y -> Ltl (a :: x) (a :: y). Inductive Desc : List -> Prop := | d_nil : Desc Nil | d_one (x:A) : Desc (x :: Nil) | d_conc (x y:A) (l:List) : clos_refl A leA x y -> Desc (l ++ y :: Nil) -> Desc ((l ++ y :: Nil) ++ x :: Nil). Definition Pow : Set := sig Desc. Definition lex_exp (a b:Pow) : Prop := Ltl (proj1_sig a) (proj1_sig b). End Lexicographic_Exponentiation. #[global] Hint Unfold transp union: sets. #[global] Hint Resolve t_step rt_step rt_refl rst_step rst_refl: sets. #[global] Hint Immediate rst_sym: sets. (* begin hide *) (* Compatibility *) Notation rts1n_refl := rst1n_refl (only parsing). Notation rts1n_trans := rst1n_trans (only parsing). Notation rtsn1_refl := rstn1_refl (only parsing). Notation rtsn1_trans := rstn1_trans (only parsing). (* end hide *) coq-8.20.0/theories/Relations/Relations.v000066400000000000000000000025501466560755400203200ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* B) (r:relation B), equivalence B r -> equivalence A (fun x y:A => r (f x) (f y)). Proof. intros A B f r H; split; elim H; red; auto. intros _ equiv_trans _ x y z H0 H1; apply equiv_trans with (f y); assumption. Qed. Lemma inverse_image_of_eq : forall (A B:Type) (f:A -> B), equivalence A (fun x y:A => f x = f y). Proof. intros A B f; split; red; [ (* reflexivity *) reflexivity | (* transitivity *) intros x y z; transitivity (f y); assumption | (* symmetry *) intros; symmetry ; assumption ]. Qed. coq-8.20.0/theories/Setoids/000077500000000000000000000000001466560755400156415ustar00rootroot00000000000000coq-8.20.0/theories/Setoids/Setoid.v000066400000000000000000000044551466560755400172670ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* Aeq y x. Proof. unfold Setoid_Theory in s. intros ; symmetry ; assumption. Defined. Definition Seq_trans A Aeq (s : Setoid_Theory A Aeq) : forall x y z:A, Aeq x y -> Aeq y z -> Aeq x z. Proof. unfold Setoid_Theory in s. intros x y z H0 H1 ; transitivity y ; assumption. Defined. (** Some tactics for manipulating Setoid Theory not officially declared as Setoid. *) Ltac trans_st x := idtac "trans_st on Setoid_Theory is OBSOLETE"; idtac "use transitivity on Equivalence instead"; match goal with | H : Setoid_Theory _ ?eqA |- ?eqA _ _ => apply (Seq_trans _ _ H) with x; auto end. Ltac sym_st := idtac "sym_st on Setoid_Theory is OBSOLETE"; idtac "use symmetry on Equivalence instead"; match goal with | H : Setoid_Theory _ ?eqA |- ?eqA _ _ => apply (Seq_sym _ _ H); auto end. Ltac refl_st := idtac "refl_st on Setoid_Theory is OBSOLETE"; idtac "use reflexivity on Equivalence instead"; match goal with | H : Setoid_Theory _ ?eqA |- ?eqA _ _ => apply (Seq_refl _ _ H); auto end. Definition gen_st : forall A : Set, Setoid_Theory _ (@eq A). Proof. constructor; congruence. Qed. coq-8.20.0/theories/Sets/000077500000000000000000000000001466560755400151455ustar00rootroot00000000000000coq-8.20.0/theories/Sets/Classical_sets.v000066400000000000000000000112301466560755400202650ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* Inhabited U A. Proof. intros A NI. elim (not_all_ex_not U (fun x:U => ~ In U A x)). - intros x H; apply Inhabited_intro with x. apply NNPP; auto with sets. - red; intro. apply NI; red. intros x H'; elim (H x); trivial with sets. Qed. Lemma not_empty_Inhabited : forall A:Ensemble U, A <> Empty_set U -> Inhabited U A. Proof. intros; apply not_included_empty_Inhabited. red; auto with sets. Qed. Lemma Inhabited_Setminus : forall X Y:Ensemble U, Included U X Y -> ~ Included U Y X -> Inhabited U (Setminus U Y X). Proof. intros X Y I NI. elim (not_all_ex_not U (fun x:U => In U Y x -> In U X x) NI). intros x YX. apply Inhabited_intro with x. apply Setminus_intro. - apply not_imply_elim with (In U X x); trivial with sets. - auto with sets. Qed. Lemma Strict_super_set_contains_new_element : forall X Y:Ensemble U, Included U X Y -> X <> Y -> Inhabited U (Setminus U Y X). Proof. auto 7 using Inhabited_Setminus with sets. Qed. Lemma Subtract_intro : forall (A:Ensemble U) (x y:U), In U A y -> x <> y -> In U (Subtract U A x) y. Proof. unfold Subtract at 1; auto with sets. Qed. #[local] Hint Resolve Subtract_intro : sets. Lemma Subtract_inv : forall (A:Ensemble U) (x y:U), In U (Subtract U A x) y -> In U A y /\ x <> y. Proof. intros A x y H'; elim H'; auto with sets. Qed. Lemma Included_Strict_Included : forall X Y:Ensemble U, Included U X Y -> Strict_Included U X Y \/ X = Y. Proof. intros X Y H'; try assumption. elim (classic (X = Y)); auto with sets. Qed. Lemma Strict_Included_inv : forall X Y:Ensemble U, Strict_Included U X Y -> Included U X Y /\ Inhabited U (Setminus U Y X). Proof. intros X Y H'; red in H'. split; [ tauto | idtac ]. elim H'; intros H'0 H'1; try exact H'1; clear H'. apply Strict_super_set_contains_new_element; auto with sets. Qed. Lemma not_SIncl_empty : forall X:Ensemble U, ~ Strict_Included U X (Empty_set U). Proof. intro X; red; intro H'; try exact H'. lapply (Strict_Included_inv X (Empty_set U)); auto with sets. intro H'0; elim H'0; intros H'1 H'2; elim H'2; clear H'0. intros x H'0; elim H'0. intro H'3; elim H'3. Qed. Lemma Complement_Complement : forall A:Ensemble U, Complement U (Complement U A) = A. Proof. unfold Complement; intros; apply Extensionality_Ensembles; auto with sets. red; split; auto with sets. red; intros; apply NNPP; auto with sets. Qed. End Ensembles_classical. #[global] Hint Resolve Strict_super_set_contains_new_element Subtract_intro not_SIncl_empty: sets. coq-8.20.0/theories/Sets/Constructive_sets.v000066400000000000000000000117661466560755400210750ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* Same_set U B C. Proof. intros B C H'; rewrite H'; auto with sets. Qed. Lemma Noone_in_empty : forall x:U, ~ In U (Empty_set U) x. Proof. red; destruct 1. Qed. Lemma Included_Empty : forall A:Ensemble U, Included U (Empty_set U) A. Proof. intro; red. intros x H; elim (Noone_in_empty x); auto with sets. Qed. Lemma Add_intro1 : forall (A:Ensemble U) (x y:U), In U A y -> In U (Add U A x) y. Proof. unfold Add at 1; auto with sets. Qed. Lemma Add_intro2 : forall (A:Ensemble U) (x:U), In U (Add U A x) x. Proof. unfold Add at 1; auto with sets. Qed. Lemma Inhabited_add : forall (A:Ensemble U) (x:U), Inhabited U (Add U A x). Proof. intros A x. apply Inhabited_intro with (x := x); auto using Add_intro2 with sets. Qed. Lemma Inhabited_not_empty : forall X:Ensemble U, Inhabited U X -> X <> Empty_set U. Proof. intros X H'; elim H'. intros x H'0; red; intro H'1. absurd (In U X x); auto with sets. rewrite H'1; auto using Noone_in_empty with sets. Qed. Lemma Add_not_Empty : forall (A:Ensemble U) (x:U), Add U A x <> Empty_set U. Proof. intros A x; apply Inhabited_not_empty; apply Inhabited_add. Qed. Lemma not_Empty_Add : forall (A:Ensemble U) (x:U), Empty_set U <> Add U A x. Proof. intros; red; intro H; generalize (Add_not_Empty A x); auto with sets. Qed. Lemma Singleton_inv : forall x y:U, In U (Singleton U x) y -> x = y. Proof. intros x y H'; elim H'; trivial with sets. Qed. Lemma Singleton_intro : forall x y:U, x = y -> In U (Singleton U x) y. Proof. intros x y H'; rewrite H'; trivial with sets. Qed. Lemma Union_inv : forall (B C:Ensemble U) (x:U), In U (Union U B C) x -> In U B x \/ In U C x. Proof. intros B C x H'; elim H'; auto with sets. Qed. Lemma Add_inv : forall (A:Ensemble U) (x y:U), In U (Add U A x) y -> In U A y \/ x = y. Proof. intros A x y H'; induction H'. - left; assumption. - right; apply Singleton_inv; assumption. Qed. Lemma Intersection_inv : forall (B C:Ensemble U) (x:U), In U (Intersection U B C) x -> In U B x /\ In U C x. Proof. intros B C x H'; elim H'; auto with sets. Qed. Lemma Couple_inv : forall x y z:U, In U (Couple U x y) z -> z = x \/ z = y. Proof. intros x y z H'; elim H'; auto with sets. Qed. Lemma Setminus_intro : forall (A B:Ensemble U) (x:U), In U A x -> ~ In U B x -> In U (Setminus U A B) x. Proof. unfold Setminus at 1; red; auto with sets. Qed. Lemma Strict_Included_intro : forall X Y:Ensemble U, Included U X Y /\ X <> Y -> Strict_Included U X Y. Proof. auto with sets. Qed. Lemma Strict_Included_strict : forall X:Ensemble U, ~ Strict_Included U X X. Proof. intro X; red; intro H'; elim H'. intros H'0 H'1; elim H'1; auto with sets. Qed. End Ensembles_facts. #[global] Hint Resolve Singleton_inv Singleton_intro Add_intro1 Add_intro2 Intersection_inv Couple_inv Setminus_intro Strict_Included_intro Strict_Included_strict Noone_in_empty Inhabited_not_empty Add_not_Empty not_Empty_Add Inhabited_add Included_Empty: sets. coq-8.20.0/theories/Sets/Cpo.v000066400000000000000000000104101466560755400160510ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* (forall y:U, In U B y -> R y x) -> Upper_Bound B x. Inductive Lower_Bound (B:Ensemble U) (x:U) : Prop := Lower_Bound_definition : In U C x -> (forall y:U, In U B y -> R x y) -> Lower_Bound B x. Inductive Lub (B:Ensemble U) (x:U) : Prop := Lub_definition : Upper_Bound B x -> (forall y:U, Upper_Bound B y -> R x y) -> Lub B x. Inductive Glb (B:Ensemble U) (x:U) : Prop := Glb_definition : Lower_Bound B x -> (forall y:U, Lower_Bound B y -> R y x) -> Glb B x. Inductive Bottom (bot:U) : Prop := Bottom_definition : In U C bot -> (forall y:U, In U C y -> R bot y) -> Bottom bot. Inductive Totally_ordered (B:Ensemble U) : Prop := Totally_ordered_definition : (Included U B C -> forall x y:U, Included U (Couple U x y) B -> R x y \/ R y x) -> Totally_ordered B. Definition Compatible : Relation U := fun x y:U => In U C x -> In U C y -> exists z : _, In U C z /\ Upper_Bound (Couple U x y) z. Inductive Directed (X:Ensemble U) : Prop := Definition_of_Directed : Included U X C -> Inhabited U X -> (forall x1 x2:U, Included U (Couple U x1 x2) X -> exists x3 : _, In U X x3 /\ Upper_Bound (Couple U x1 x2) x3) -> Directed X. Inductive Complete : Prop := Definition_of_Complete : (exists bot : _, Bottom bot) -> (forall X:Ensemble U, Directed X -> exists bsup : _, Lub X bsup) -> Complete. Inductive Conditionally_complete : Prop := Definition_of_Conditionally_complete : (forall X:Ensemble U, Included U X C -> (exists maj : _, Upper_Bound X maj) -> exists bsup : _, Lub X bsup) -> Conditionally_complete. End Bounds. #[global] Hint Resolve Totally_ordered_definition Upper_Bound_definition Lower_Bound_definition Lub_definition Glb_definition Bottom_definition Definition_of_Complete Definition_of_Complete Definition_of_Conditionally_complete : core. Section Specific_orders. Variable U : Type. Record Cpo : Type := Definition_of_cpo {PO_of_cpo : PO U; Cpo_cond : Complete U PO_of_cpo}. Record Chain : Type := Definition_of_chain {PO_of_chain : PO U; Chain_cond : Totally_ordered U PO_of_chain (@Carrier_of _ PO_of_chain)}. End Specific_orders. coq-8.20.0/theories/Sets/Ensembles.v000066400000000000000000000101201466560755400172430ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* Prop. Definition In (A:Ensemble) (x:U) : Prop := A x. Definition Included (B C:Ensemble) : Prop := forall x:U, In B x -> In C x. Inductive Empty_set : Ensemble :=. Inductive Full_set : Ensemble := Full_intro : forall x:U, In Full_set x. (** NB: The following definition builds-in equality of elements in [U] as Leibniz equality. This may have to be changed if we replace [U] by a Setoid on [U] with its own equality [eqs], with [In_singleton: (y: U)(eqs x y) -> (In (Singleton x) y)]. *) Inductive Singleton (x:U) : Ensemble := In_singleton : In (Singleton x) x. Inductive Union (B C:Ensemble) : Ensemble := | Union_introl : forall x:U, In B x -> In (Union B C) x | Union_intror : forall x:U, In C x -> In (Union B C) x. Definition Add (B:Ensemble) (x:U) : Ensemble := Union B (Singleton x). Inductive Intersection (B C:Ensemble) : Ensemble := Intersection_intro : forall x:U, In B x -> In C x -> In (Intersection B C) x. Inductive Couple (x y:U) : Ensemble := | Couple_l : In (Couple x y) x | Couple_r : In (Couple x y) y. Inductive Triple (x y z:U) : Ensemble := | Triple_l : In (Triple x y z) x | Triple_m : In (Triple x y z) y | Triple_r : In (Triple x y z) z. Definition Complement (A:Ensemble) : Ensemble := fun x:U => ~ In A x. Definition Setminus (B C:Ensemble) : Ensemble := fun x:U => In B x /\ ~ In C x. Definition Subtract (B:Ensemble) (x:U) : Ensemble := Setminus B (Singleton x). Inductive Disjoint (B C:Ensemble) : Prop := Disjoint_intro : (forall x:U, ~ In (Intersection B C) x) -> Disjoint B C. Inductive Inhabited (B:Ensemble) : Prop := Inhabited_intro : forall x:U, In B x -> Inhabited B. Definition Strict_Included (B C:Ensemble) : Prop := Included B C /\ B <> C. Definition Same_set (B C:Ensemble) : Prop := Included B C /\ Included C B. (** Extensionality Axiom *) Axiom Extensionality_Ensembles : forall A B:Ensemble, Same_set A B -> A = B. End Ensembles. #[global] Hint Unfold In Included Same_set Strict_Included Add Setminus Subtract: sets. #[global] Hint Resolve Union_introl Union_intror Intersection_intro In_singleton Couple_l Couple_r Triple_l Triple_m Triple_r Disjoint_intro Extensionality_Ensembles: sets. coq-8.20.0/theories/Sets/Finite_sets.v000066400000000000000000000061001466560755400176050ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* Prop := | Empty_is_finite : Finite (Empty_set U) | Union_is_finite : forall A:Ensemble U, Finite A -> forall x:U, ~ In U A x -> Finite (Add U A x). Inductive cardinal : Ensemble U -> nat -> Prop := | card_empty : cardinal (Empty_set U) 0 | card_add : forall (A:Ensemble U) (n:nat), cardinal A n -> forall x:U, ~ In U A x -> cardinal (Add U A x) (S n). End Ensembles_finis. #[global] Hint Resolve Empty_is_finite Union_is_finite: sets. #[global] Hint Resolve card_empty card_add: sets. Require Import Constructive_sets. Section Ensembles_finis_facts. Variable U : Type. Lemma cardinal_invert : forall (X:Ensemble U) (p:nat), cardinal U X p -> match p with | O => X = Empty_set U | S n => exists A : _, (exists x : _, X = Add U A x /\ ~ In U A x /\ cardinal U A n) end. Proof. induction 1; simpl; auto. exists A; exists x; auto. Qed. Lemma cardinal_elim : forall (X:Ensemble U) (p:nat), cardinal U X p -> match p with | O => X = Empty_set U | S n => Inhabited U X end. Proof. intros X p C; elim C; simpl; trivial with sets. Qed. End Ensembles_finis_facts. coq-8.20.0/theories/Sets/Finite_sets_facts.v000066400000000000000000000211151466560755400207700ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* exists n : nat, cardinal U X n. Proof. induction 1 as [| A _ [n H]]. - exists 0; auto with sets. - exists (S n); auto with sets. Qed. Lemma cardinal_finite : forall (X:Ensemble U) (n:nat), cardinal U X n -> Finite U X. Proof. induction 1; auto with sets. Qed. Theorem Add_preserves_Finite : forall (X:Ensemble U) (x:U), Finite U X -> Finite U (Add U X x). Proof. intros X x H'. elim (classic (In U X x)); intro H'0; auto with sets. rewrite (Non_disjoint_union U X x); auto with sets. Qed. Theorem Singleton_is_finite : forall x:U, Finite U (Singleton U x). Proof. intro x; rewrite <- Empty_set_zero'. apply Union_is_finite; auto with sets. Qed. Theorem Union_preserves_Finite : forall X Y:Ensemble U, Finite U X -> Finite U Y -> Finite U (Union U X Y). Proof. intros X Y HX HY. induction HX. - now rewrite Empty_set_zero. - rewrite Union_commutative. rewrite <- Union_add. apply Add_preserves_Finite. now rewrite Union_commutative. Qed. Lemma Finite_downward_closed : forall A:Ensemble U, Finite U A -> forall X:Ensemble U, Included U X A -> Finite U X. Proof. intros A HA. induction HA as [|A HA IHHA]; [ intros X HX | intros X HXAx ]. - rewrite less_than_empty; auto with sets. - destruct (Included_Add _ _ _ _ HXAx) as [|[X' [-> HX'A]]]; auto with sets. Qed. Lemma Intersection_preserves_finite : forall A:Ensemble U, Finite U A -> forall X:Ensemble U, Finite U (Intersection U X A). Proof. intros A H' X; apply Finite_downward_closed with A; auto with sets. Qed. Lemma cardinalO_empty : forall X:Ensemble U, cardinal U X 0 -> X = Empty_set U. Proof. intros X H; apply (cardinal_invert U X 0); trivial with sets. Qed. Lemma inh_card_gt_O : forall X:Ensemble U, Inhabited U X -> forall n:nat, cardinal U X n -> n > 0. Proof. intros X [x HX] [] HCX. - now rewrite (cardinalO_empty X HCX) in HX. - apply Nat.lt_0_succ. Qed. Lemma card_soustr_1 : forall (X:Ensemble U) (n:nat), cardinal U X n -> forall x:U, In U X x -> cardinal U (Subtract U X x) (pred n). Proof. intros X n H. induction H as [|X n H IH x Hx]; intros x' Hx'. - destruct Hx'. - rewrite Nat.pred_succ. apply Add_inv in Hx' as [Hx' | <-]. + rewrite (add_soustr_xy _ _ x x') by (intros <-; contradiction Hx). rewrite <- Nat.succ_pred_pos. * apply card_add; [ apply (IH _ Hx') |]. now intros [? _]%Subtract_inv. * apply inh_card_gt_O with (X := X); [| assumption ]. exact (Inhabited_intro _ _ _ Hx'). + rewrite <- (Sub_Add_new _ _ _ Hx). assumption. Qed. Lemma cardinal_Empty : forall m:nat, cardinal U (Empty_set U) m -> 0 = m. Proof. intros m Cm. inversion Cm as [|X n _ x _ H]; [ reflexivity | ]. symmetry in H. now apply not_Empty_Add in H. Qed. Lemma cardinal_is_functional : forall (X:Ensemble U) (c1:nat), cardinal U X c1 -> forall (Y:Ensemble U) (c2:nat), cardinal U Y c2 -> X = Y -> c1 = c2. Proof. intros X c1 H'; elim H'. - intros Y c2 H'0 <-; now apply cardinal_Empty. - clear H' c1 X. intros X n H' H'0 x H'1 Y c2 H'2. elim H'2. + intro H'3; now elim (not_Empty_Add U X x). + clear H'2 c2 Y. intros X0 c2 H'2 _ x0 H'4 H'5. apply f_equal. assert (H'6 : In U (Add U X x) x) by apply Add_intro2. rewrite H'5 in H'6. destruct (Add_inv _ _ _ _ H'6) as [H'7 | <-]. * apply H'0 with (Y := Subtract U (Add U X0 x0) x). -- rewrite <- Nat.pred_succ; apply card_soustr_1; auto with sets. -- rewrite <- H'5; auto with sets. * apply (H'0 _ _ H'2 (Simplify_add _ _ _ _ H'1 H'4 H'5)). Qed. Lemma cardinal_unicity : forall (X:Ensemble U) (n:nat), cardinal U X n -> forall m:nat, cardinal U X m -> n = m. Proof. intros X ? ? ? ?; now apply cardinal_is_functional with X X. Qed. Lemma card_Add_gen : forall (A:Ensemble U) (x:U) (n n':nat), cardinal U A n -> cardinal U (Add U A x) n' -> n' <= S n. Proof. intros A x n n' H0 H1. elim (classic (In U A x)); intro H2. - rewrite (Non_disjoint_union _ _ _ H2) in H1. rewrite (cardinal_unicity _ _ H0 _ H1). apply Nat.le_succ_diag_r. - apply Nat.eq_le_incl. apply cardinal_unicity with (X := Add U A x); auto with sets. Qed. Lemma incl_st_card_lt : forall (X:Ensemble U) (c1:nat), cardinal U X c1 -> forall (Y:Ensemble U) (c2:nat), cardinal U Y c2 -> Strict_Included U X Y -> c2 > c1. Proof. intros X c1 H1. induction H1 as [|X' ? HX' IH x Hx]; intros Y c2 HY Hsincl; (inversion HY as [HXY Hc | ? ? ? ? ? HXY]; subst Y; [ apply not_SIncl_empty in Hsincl as [] |]). - apply Nat.lt_0_succ. - subst c2. apply -> Nat.succ_lt_mono. refine (IH _ _ _ (incl_st_add_soustr _ _ _ _ Hx Hsincl)). rewrite <- Nat.pred_succ. apply card_soustr_1; [ assumption | ]. apply Hsincl, Add_intro2. Qed. Lemma incl_card_le : forall (X Y:Ensemble U) (n m:nat), cardinal U X n -> cardinal U Y m -> Included U X Y -> n <= m. Proof. intros X Y n m HX HY HXY. destruct (Included_Strict_Included _ _ _ HXY) as [HXY' | <-]. - apply Nat.lt_le_incl. now apply (incl_st_card_lt _ _ HX _ _ HY). - apply Nat.eq_le_incl. now apply cardinal_unicity with X. Qed. Lemma Generalized_induction_on_finite_sets : forall P:Ensemble U -> Prop, (forall X:Ensemble U, Finite U X -> (forall Y:Ensemble U, Strict_Included U Y X -> P Y) -> P X) -> forall X:Ensemble U, Finite U X -> P X. Proof. intros P HP X HX. induction HX as [|X HX IH x Hx] in P, HP. - apply HP; [ auto with sets | ]. now intros Y [->%less_than_empty []]. - enough (forall Y, Included U Y (Add U X x) -> P Y) by auto with sets. revert Hx. apply IH. clear IH X HX. intros Y HY IH' Hx Z HZYx. apply HP; [ apply Finite_downward_closed with (Add _ Y x); auto with sets | ]. intros Z' HZ'Z. pose proof (Strict_inclusion_is_transitive_with_inclusion _ _ _ _ HZ'Z HZYx) as [HZ'Yx Hneq]. case (Included_Add _ _ _ _ HZ'Yx) as [HZ'Y | [Y' [-> HY'Y]]]. + case (classic (Z' = Y)) as [-> | Hneq']. * apply (HP _ HY). intros Y' [HY'Y Hneq']. apply (IH' Y'); auto with sets. * apply (IH' Z'); auto with sets. + apply (IH' Y'); auto with sets. now split; [| intros -> ]. Qed. End Finite_sets_facts. coq-8.20.0/theories/Sets/Image.v000066400000000000000000000163651466560755400163710ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* V) : Ensemble V := Im_intro : forall x:U, In _ X x -> forall y:V, y = f x -> In _ (Im X f) y. Lemma Im_def : forall (X:Ensemble U) (f:U -> V) (x:U), In _ X x -> In _ (Im X f) (f x). Proof. intros X f x H'; try assumption. apply Im_intro with (x := x); auto with sets. Qed. Lemma Im_add : forall (X:Ensemble U) (x:U) (f:U -> V), Im (Add _ X x) f = Add _ (Im X f) (f x). Proof. intros X x f. apply Extensionality_Ensembles. split; red; intros x0 H'. - elim H'; intros. rewrite H0. elim Add_inv with U X x x1; auto using Im_def with sets. destruct 1; auto using Im_def with sets. - elim Add_inv with V (Im X f) (f x) x0. + destruct 1 as [x0 H y H0]. rewrite H0; auto using Im_def with sets. + destruct 1; auto using Im_def with sets. + trivial. Qed. Lemma image_empty : forall f:U -> V, Im (Empty_set U) f = Empty_set V. Proof. intro f; try assumption. apply Extensionality_Ensembles. split; auto with sets. red. intros x H'; elim H'. intros x0 H'0; elim H'0; auto with sets. Qed. Lemma finite_image : forall (X:Ensemble U) (f:U -> V), Finite _ X -> Finite _ (Im X f). Proof. intros X f H'; elim H'. - rewrite (image_empty f); auto with sets. - intros A H'0 H'1 x H'2; clear H' X. rewrite (Im_add A x f); auto with sets. apply Add_preserves_Finite; auto with sets. Qed. Lemma Im_inv : forall (X:Ensemble U) (f:U -> V) (y:V), In _ (Im X f) y -> exists x : U, In _ X x /\ f x = y. Proof. intros X f y H'; elim H'. intros x H'0 y0 H'1; rewrite H'1. exists x; auto with sets. Qed. Definition injective (f:U -> V) := forall x y:U, f x = f y -> x = y. Lemma not_injective_elim : forall f:U -> V, ~ injective f -> exists x : _, (exists y : _, f x = f y /\ x <> y). Proof. unfold injective; intros f H. cut (exists x : _, ~ (forall y:U, f x = f y -> x = y)). 2: apply not_all_ex_not with (P := fun x:U => forall y:U, f x = f y -> x = y); trivial with sets. destruct 1 as [x C]; exists x. cut (exists y : _, ~ (f x = f y -> x = y)). 2: apply not_all_ex_not with (P := fun y:U => f x = f y -> x = y); trivial with sets. destruct 1 as [y D]; exists y. apply imply_to_and; trivial with sets. Qed. Lemma cardinal_Im_intro : forall (A:Ensemble U) (f:U -> V) (n:nat), cardinal _ A n -> exists p : nat, cardinal _ (Im A f) p. Proof. intros. apply finite_cardinal; apply finite_image. apply cardinal_finite with n; trivial with sets. Qed. Lemma In_Image_elim : forall (A:Ensemble U) (f:U -> V), injective f -> forall x:U, In _ (Im A f) (f x) -> In _ A x. Proof. intros. elim Im_inv with A f (f x); trivial with sets. intros z C; elim C; intros InAz E. elim (H z x E); trivial with sets. Qed. Lemma injective_preserves_cardinal : forall (A:Ensemble U) (f:U -> V) (n:nat), injective f -> cardinal _ A n -> forall n':nat, cardinal _ (Im A f) n' -> n' = n. Proof. induction 2 as [| A n H'0 H'1 x H'2]; auto with sets. - rewrite (image_empty f). intros n' CE. apply cardinal_unicity with V (Empty_set V); auto with sets. - intro n'. rewrite (Im_add A x f). intro H'3. elim cardinal_Im_intro with A f n; trivial with sets. intros i CI. lapply (H'1 i); trivial with sets. cut (~ In _ (Im A f) (f x)). + intros H0 H1. apply cardinal_unicity with V (Add _ (Im A f) (f x)); trivial with sets. apply card_add; auto with sets. rewrite <- H1; trivial with sets. + red; intro; apply H'2. apply In_Image_elim with f; trivial with sets. Qed. Lemma cardinal_decreases : forall (A:Ensemble U) (f:U -> V) (n:nat), cardinal U A n -> forall n':nat, cardinal V (Im A f) n' -> n' <= n. Proof. induction 1 as [| A n H'0 H'1 x H'2]; auto with sets. - rewrite (image_empty f); intros. cut (n' = 0). + intro E; rewrite E; trivial with sets. + apply cardinal_unicity with V (Empty_set V); auto with sets. - intro n'. rewrite (Im_add A x f). elim cardinal_Im_intro with A f n; trivial with sets. intros p C H'3. apply Nat.le_trans with (S p). + apply card_Add_gen with V (Im A f) (f x); trivial with sets. + apply -> Nat.succ_le_mono; auto with sets. Qed. Theorem Pigeonhole : forall (A:Ensemble U) (f:U -> V) (n:nat), cardinal U A n -> forall n':nat, cardinal V (Im A f) n' -> n' < n -> ~ injective f. Proof. unfold not; intros A f n CAn n' CIfn' ltn'n I. cut (n' = n). - intro E; generalize ltn'n; rewrite E; exact (Nat.lt_irrefl n). - apply injective_preserves_cardinal with (A := A) (f := f) (n := n); trivial with sets. Qed. Lemma Pigeonhole_principle : forall (A:Ensemble U) (f:U -> V) (n:nat), cardinal _ A n -> forall n':nat, cardinal _ (Im A f) n' -> n' < n -> exists x : _, (exists y : _, f x = f y /\ x <> y). Proof. intros; apply not_injective_elim. apply Pigeonhole with A n n'; trivial with sets. Qed. End Image. #[global] Hint Resolve Im_def image_empty finite_image: sets. coq-8.20.0/theories/Sets/Infinite_sets.v000066400000000000000000000221171466560755400201420ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* Included U X A -> Approximant A X. End Approx. #[global] Hint Resolve Defn_of_Approximant : core. Section Infinite_sets. Variable U : Type. Lemma make_new_approximant : forall A X:Ensemble U, ~ Finite U A -> Approximant U A X -> Inhabited U (Setminus U A X). Proof. intros A X H' H'0. elim H'0; intros H'1 H'2. apply Strict_super_set_contains_new_element; auto with sets. red; intro H'3; apply H'. rewrite <- H'3; auto with sets. Qed. Lemma approximants_grow : forall A X:Ensemble U, ~ Finite U A -> forall n:nat, cardinal U X n -> Included U X A -> exists Y : _, cardinal U Y (S n) /\ Included U Y A. Proof. intros A X H' n H'0; elim H'0; auto with sets. - intro H'1. cut (Inhabited U (Setminus U A (Empty_set U))). + intro H'2; elim H'2. intros x H'3. exists (Add U (Empty_set U) x); auto with sets. split. * apply card_add; auto with sets. * cut (In U A x). -- intro H'4; red; auto with sets. intros x0 H'5; elim H'5; auto with sets. intros x1 H'6; elim H'6; auto with sets. -- elim H'3; auto with sets. + apply make_new_approximant; auto with sets. - intros A0 n0 H'1 H'2 x H'3 H'5. lapply H'2; [ intro H'6; elim H'6; clear H'2 | clear H'2 ]; auto with sets. intros x0 H'2; try assumption. elim H'2; intros H'7 H'8; try exact H'8; clear H'2. elim (make_new_approximant A x0); auto with sets. + intros x1 H'2; try assumption. exists (Add U x0 x1); auto with sets. split. * apply card_add; auto with sets. elim H'2; auto with sets. * red. intros x2 H'9; elim H'9; auto with sets. intros x3 H'10; elim H'10; auto with sets. elim H'2; auto with sets. + auto with sets. apply Defn_of_Approximant; auto with sets. apply cardinal_finite with (n := S n0); auto with sets. Qed. Lemma approximants_grow' : forall A X:Ensemble U, ~ Finite U A -> forall n:nat, cardinal U X n -> Approximant U A X -> exists Y : _, cardinal U Y (S n) /\ Approximant U A Y. Proof. intros A X H' n H'0 H'1; try assumption. elim H'1. intros H'2 H'3. cut (exists Y : _, cardinal U Y (S n) /\ Included U Y A). - intros [x H'4]; elim H'4; intros H'5 H'6; try exact H'5; clear H'4. exists x; auto with sets. split; [ auto with sets | idtac ]. apply Defn_of_Approximant; auto with sets. apply cardinal_finite with (n := S n); auto with sets. - apply approximants_grow with (X := X); auto with sets. Qed. Lemma approximant_can_be_any_size : forall A X:Ensemble U, ~ Finite U A -> forall n:nat, exists Y : _, cardinal U Y n /\ Approximant U A Y. Proof. intros A H' H'0 n; elim n. - exists (Empty_set U); auto with sets. - intros n0 H'1; elim H'1. intros x H'2. apply approximants_grow' with (X := x); tauto. Qed. Variable V : Type. Theorem Image_set_continuous : forall (A:Ensemble U) (f:U -> V) (X:Ensemble V), Finite V X -> Included V X (Im U V A f) -> exists n : _, (exists Y : _, (cardinal U Y n /\ Included U Y A) /\ Im U V Y f = X). Proof. intros A f X H'; elim H'. - intro H'0; exists 0. exists (Empty_set U); auto with sets. - intros A0 H'0 H'1 x H'2 H'3; try assumption. lapply H'1; [ intro H'4; elim H'4; intros n E; elim E; clear H'4 H'1 | clear H'1 ]; auto with sets. intros x0 H'1; try assumption. exists (S n); try assumption. elim H'1; intros H'4 H'5; elim H'4; intros H'6 H'7; try exact H'6; clear H'4 H'1. clear E. generalize H'2. rewrite <- H'5. intro H'1; try assumption. red in H'3. generalize (H'3 x). intro H'4; lapply H'4; [ intro H'8; try exact H'8; clear H'4 | clear H'4 ]; auto with sets. specialize Im_inv with (U := U) (V := V) (X := A) (f := f) (y := x); intro H'11; lapply H'11; [ intro H'13; elim H'11; clear H'11 | clear H'11 ]; auto with sets. intros x1 H'4; try assumption. apply ex_intro with (x := Add U x0 x1). split; [ split; [ try assumption | idtac ] | idtac ]. + apply card_add; auto with sets. red; intro H'9; try exact H'9. apply H'1. elim H'4; intros H'10 H'11; rewrite <- H'11; clear H'4; auto with sets. + elim H'4; intros H'9 H'10; try exact H'9; clear H'4; auto with sets. red; auto with sets. intros x2 H'4; elim H'4; auto with sets. intros x3 H'11; elim H'11; auto with sets. + elim H'4; intros H'9 H'10; rewrite <- H'10; clear H'4; auto with sets. apply Im_add; auto with sets. Qed. Theorem Image_set_continuous' : forall (A:Ensemble U) (f:U -> V) (X:Ensemble V), Approximant V (Im U V A f) X -> exists Y : _, Approximant U A Y /\ Im U V Y f = X. Proof. intros A f X H'; try assumption. cut (exists n : _, (exists Y : _, (cardinal U Y n /\ Included U Y A) /\ Im U V Y f = X)). - intro H'0; elim H'0; intros n E; elim E; clear H'0. intros x H'0; try assumption. elim H'0; intros H'1 H'2; elim H'1; intros H'3 H'4; try exact H'3; clear H'1 H'0; auto with sets. exists x. split; [ idtac | try assumption ]. apply Defn_of_Approximant; auto with sets. apply cardinal_finite with (n := n); auto with sets. - apply Image_set_continuous; auto with sets. + elim H'; auto with sets. + elim H'; auto with sets. Qed. Theorem Pigeonhole_bis : forall (A:Ensemble U) (f:U -> V), ~ Finite U A -> Finite V (Im U V A f) -> ~ injective U V f. Proof. intros A f H'0 H'1; try assumption. elim (Image_set_continuous' A f (Im U V A f)); auto with sets. intros x H'2; elim H'2; intros H'3 H'4; try exact H'3; clear H'2. elim (make_new_approximant A x); auto with sets. intros x0 H'2; elim H'2. intros H'5 H'6. elim (finite_cardinal V (Im U V A f)); auto with sets. intros n E. elim (finite_cardinal U x); auto with sets. - intros n0 E0. apply Pigeonhole with (A := Add U x x0) (n := S n0) (n' := n). + apply card_add; auto with sets. + rewrite (Im_add U V x x0 f); auto with sets. cut (In V (Im U V x f) (f x0)). * intro H'8. rewrite (Non_disjoint_union V (Im U V x f) (f x0)); auto with sets. rewrite H'4; auto with sets. * elim (Extension V (Im U V x f) (Im U V A f)); auto with sets. + apply Nat.lt_succ_r. apply cardinal_decreases with (U := U) (V := V) (A := x) (f := f); auto with sets. rewrite H'4; auto with sets. - elim H'3; auto with sets. Qed. Theorem Pigeonhole_ter : forall (A:Ensemble U) (f:U -> V) (n:nat), injective U V f -> Finite V (Im U V A f) -> Finite U A. Proof. intros A f H' H'0 H'1. apply NNPP. red; intro H'2. elim (Pigeonhole_bis A f); auto with sets. Qed. End Infinite_sets. coq-8.20.0/theories/Sets/Integers.v000066400000000000000000000130111466560755400171100ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* exists m : nat, Upper_Bound nat nat_po X m. Proof. intros X H'; elim H'. - exists 0. apply Upper_Bound_definition. + unfold nat_po. simpl. apply triv_nat. + intros y H'0; elim H'0; auto with sets arith. - intros A H'0 H'1 x H'2; try assumption. elim H'1; intros x0 H'3; clear H'1. elim le_total_order. simpl. intro H'1; try assumption. lapply H'1; [ intro H'4; idtac | try assumption ]; auto with sets arith. generalize (H'4 x0 x). clear H'4. clear H'1. intro H'1; lapply H'1; [ intro H'4; elim H'4; [ intro H'5; try exact H'5; clear H'4 H'1 | intro H'5; clear H'4 H'1 ] | clear H'1 ]. + exists x. apply Upper_Bound_definition. * simpl. apply triv_nat. * intros y H'1; elim H'1. -- generalize le_trans. intro H'4; red in H'4. intros x1 H'6; try assumption. apply H'4 with (y := x0). ++ elim H'3; simpl; auto with sets arith. ++ trivial. -- intros x1 H'4; elim H'4. unfold nat_po; simpl; trivial. + exists x0. apply Upper_Bound_definition. * unfold nat_po. simpl. apply triv_nat. * intros y H'1; elim H'1. -- intros x1 H'4; try assumption. elim H'3; simpl; auto with sets arith. -- intros x1 H'4; elim H'4; auto with sets arith. + red. intros x1 H'1; elim H'1; apply triv_nat. Qed. Lemma Integers_has_no_ub : ~ (exists m : nat, Upper_Bound nat nat_po Integers m). Proof. red; intro H'; elim H'. intros x H'0. elim H'0; intros H'1 H'2. cut (In nat Integers (S x)). - intro H'3. specialize H'2 with (y := S x); lapply H'2; [ intro H'5; clear H'2 | try assumption; clear H'2 ]. apply Nat.nle_succ_diag_l in H'5; assumption. - apply triv_nat. Qed. Lemma Integers_infinite : ~ Finite nat Integers. Proof. generalize Integers_has_no_ub. intro H'; red; intro H'0; try exact H'0. apply H'. apply Finite_subset_has_lub; auto with sets arith. Qed. End Integers_sect. coq-8.20.0/theories/Sets/Multiset.v000066400000000000000000000136171466560755400171520ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* A -> Prop. Hypothesis eqA_equiv : Equivalence eqA. Hypothesis Aeq_dec : forall x y:A, {eqA x y} + {~ eqA x y}. Inductive multiset : Type := Bag : (A -> nat) -> multiset. Definition EmptyBag := Bag (fun a:A => 0). Definition SingletonBag (a:A) := Bag (fun a':A => match Aeq_dec a a' with | left _ => 1 | right _ => 0 end). Definition multiplicity (m:multiset) (a:A) : nat := let (f) := m in f a. (** multiset equality *) Definition meq (m1 m2:multiset) := forall a:A, multiplicity m1 a = multiplicity m2 a. Lemma meq_refl : forall x:multiset, meq x x. Proof. destruct x; unfold meq; reflexivity. Qed. Lemma meq_trans : forall x y z:multiset, meq x y -> meq y z -> meq x z. Proof. unfold meq. destruct x; destruct y; destruct z. intros; rewrite H; auto. Qed. Lemma meq_sym : forall x y:multiset, meq x y -> meq y x. Proof. unfold meq. destruct x; destruct y; auto. Qed. (** multiset union *) Definition munion (m1 m2:multiset) := Bag (fun a:A => multiplicity m1 a + multiplicity m2 a). Lemma munion_empty_left : forall x:multiset, meq x (munion EmptyBag x). Proof. unfold meq; unfold munion; simpl; auto. Qed. Lemma munion_empty_right : forall x:multiset, meq x (munion x EmptyBag). Proof. unfold meq; unfold munion; simpl; auto. Qed. Lemma munion_comm : forall x y:multiset, meq (munion x y) (munion y x). Proof. unfold meq; unfold multiplicity; unfold munion. destruct x; destruct y; intros; apply Nat.add_comm. Qed. Lemma munion_ass : forall x y z:multiset, meq (munion (munion x y) z) (munion x (munion y z)). Proof. unfold meq; unfold munion; unfold multiplicity. destruct x; destruct y; destruct z; intros; symmetry; apply Nat.add_assoc. Qed. Lemma meq_left : forall x y z:multiset, meq x y -> meq (munion x z) (munion y z). Proof. unfold meq; unfold munion; unfold multiplicity. destruct x; destruct y; destruct z. intros; elim H; reflexivity. Qed. Lemma meq_right : forall x y z:multiset, meq x y -> meq (munion z x) (munion z y). Proof. unfold meq; unfold munion; unfold multiplicity. destruct x; destruct y; destruct z. intros; elim H; auto. Qed. (** Here we should make multiset an abstract datatype, by hiding [Bag], [munion], [multiplicity]; all further properties are proved abstractly *) Lemma munion_rotate : forall x y z:multiset, meq (munion x (munion y z)) (munion z (munion x y)). Proof. intros; apply (op_rotate multiset munion meq). - apply munion_comm. - apply munion_ass. - exact meq_trans. - exact meq_sym. - trivial. Qed. Lemma meq_congr : forall x y z t:multiset, meq x y -> meq z t -> meq (munion x z) (munion y t). Proof. intros; apply (cong_congr multiset munion meq); auto using meq_left, meq_right. exact meq_trans. Qed. Lemma munion_perm_left : forall x y z:multiset, meq (munion x (munion y z)) (munion y (munion x z)). Proof. intros; apply (perm_left multiset munion meq); auto using munion_comm, munion_ass, meq_left, meq_right, meq_sym. exact meq_trans. Qed. Lemma multiset_twist1 : forall x y z t:multiset, meq (munion x (munion (munion y z) t)) (munion (munion y (munion x t)) z). Proof. intros; apply (twist multiset munion meq); auto using munion_comm, munion_ass, meq_sym, meq_left, meq_right. exact meq_trans. Qed. Lemma multiset_twist2 : forall x y z t:multiset, meq (munion x (munion (munion y z) t)) (munion (munion y (munion x z)) t). Proof. intros; apply meq_trans with (munion (munion x (munion y z)) t). - apply meq_sym; apply munion_ass. - apply meq_left; apply munion_perm_left. Qed. (** specific for treesort *) Lemma treesort_twist1 : forall x y z t u:multiset, meq u (munion y z) -> meq (munion x (munion u t)) (munion (munion y (munion x t)) z). Proof. intros; apply meq_trans with (munion x (munion (munion y z) t)). - apply meq_right; apply meq_left; trivial. - apply multiset_twist1. Qed. Lemma treesort_twist2 : forall x y z t u:multiset, meq u (munion y z) -> meq (munion x (munion u t)) (munion (munion y (munion x z)) t). Proof. intros; apply meq_trans with (munion x (munion (munion y z) t)). - apply meq_right; apply meq_left; trivial. - apply multiset_twist2. Qed. (** SingletonBag *) Lemma meq_singleton : forall a a', eqA a a' -> meq (SingletonBag a) (SingletonBag a'). Proof. intros; red; simpl; intro a0. destruct (Aeq_dec a a0) as [Ha|Ha]; rewrite H in Ha; decide (Aeq_dec a' a0) with Ha; reflexivity. Qed. (*i theory of minter to do similarly (* multiset intersection *) Definition minter := [m1,m2:multiset] (Bag [a:A](min (multiplicity m1 a)(multiplicity m2 a))). i*) End multiset_defs. Unset Implicit Arguments. #[global] Hint Unfold meq multiplicity: datatypes. #[global] Hint Resolve munion_empty_right munion_comm munion_ass meq_left meq_right munion_empty_left: datatypes. #[global] Hint Immediate meq_sym: datatypes. coq-8.20.0/theories/Sets/Partial_Order.v000066400000000000000000000073311466560755400200670ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* Rel_of p x y /\ x <> y. Inductive covers (y x:U) : Prop := Definition_of_covers : Strict_Rel_of x y -> ~ (exists z : _, Strict_Rel_of x z /\ Strict_Rel_of z y) -> covers y x. End Partial_orders. #[global] Hint Unfold Carrier_of Rel_of Strict_Rel_of: sets. #[global] Hint Resolve Definition_of_covers: sets. Section Partial_order_facts. Variable U : Type. Variable D : PO U. Lemma Strict_Rel_Transitive_with_Rel : forall x y z:U, Strict_Rel_of U D x y -> @Rel_of U D y z -> Strict_Rel_of U D x z. Proof. unfold Strict_Rel_of at 1. red. elim D; simpl. intros C R H' H'0; elim H'0. intros H'1 H'2 H'3 x y z H'4 H'5; split. - apply H'2 with (y := y); tauto. - red; intro H'6. elim H'4; intros H'7 H'8; apply H'8; clear H'4. apply H'3; auto. rewrite H'6; tauto. Qed. Lemma Strict_Rel_Transitive_with_Rel_left : forall x y z:U, @Rel_of U D x y -> Strict_Rel_of U D y z -> Strict_Rel_of U D x z. Proof. unfold Strict_Rel_of at 1. red. elim D; simpl. intros C R H' H'0; elim H'0. intros H'1 H'2 H'3 x y z H'4 H'5; split. - apply H'2 with (y := y); tauto. - red; intro H'6. elim H'5; intros H'7 H'8; apply H'8; clear H'5. apply H'3; auto. rewrite <- H'6; auto. Qed. Lemma Strict_Rel_Transitive : Transitive U (Strict_Rel_of U D). red. intros x y z H' H'0. apply Strict_Rel_Transitive_with_Rel with (y := y); [ intuition | unfold Strict_Rel_of in H', H'0; intuition ]. Qed. End Partial_order_facts. coq-8.20.0/theories/Sets/Permut.v000066400000000000000000000060571466560755400166200ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* U -> U. Variable cong : U -> U -> Prop. Hypothesis op_comm : forall x y:U, cong (op x y) (op y x). Hypothesis op_ass : forall x y z:U, cong (op (op x y) z) (op x (op y z)). Hypothesis cong_left : forall x y z:U, cong x y -> cong (op x z) (op y z). Hypothesis cong_right : forall x y z:U, cong x y -> cong (op z x) (op z y). Hypothesis cong_trans : forall x y z:U, cong x y -> cong y z -> cong x z. Hypothesis cong_sym : forall x y:U, cong x y -> cong y x. (** Remark. we do not need: [Hypothesis cong_refl : (x:U)(cong x x)]. *) Lemma cong_congr : forall x y z t:U, cong x y -> cong z t -> cong (op x z) (op y t). Proof. intros; apply cong_trans with (op y z). - apply cong_left; trivial. - apply cong_right; trivial. Qed. Lemma comm_right : forall x y z:U, cong (op x (op y z)) (op x (op z y)). Proof. intros; apply cong_right; apply op_comm. Qed. Lemma comm_left : forall x y z:U, cong (op (op x y) z) (op (op y x) z). Proof. intros; apply cong_left; apply op_comm. Qed. Lemma perm_right : forall x y z:U, cong (op (op x y) z) (op (op x z) y). Proof. intros. apply cong_trans with (op x (op y z)). - apply op_ass. - apply cong_trans with (op x (op z y)). + apply cong_right; apply op_comm. + apply cong_sym; apply op_ass. Qed. Lemma perm_left : forall x y z:U, cong (op x (op y z)) (op y (op x z)). Proof. intros. apply cong_trans with (op (op x y) z). - apply cong_sym; apply op_ass. - apply cong_trans with (op (op y x) z). + apply cong_left; apply op_comm. + apply op_ass. Qed. Lemma op_rotate : forall x y z t:U, cong (op x (op y z)) (op z (op x y)). Proof. intros; apply cong_trans with (op (op x y) z). - apply cong_sym; apply op_ass. - apply op_comm. Qed. (** Needed for treesort ... *) Lemma twist : forall x y z t:U, cong (op x (op (op y z) t)) (op (op y (op x t)) z). Proof. intros. apply cong_trans with (op x (op (op y t) z)). - apply cong_right; apply perm_right. - apply cong_trans with (op (op x (op y t)) z). + apply cong_sym; apply op_ass. + apply cong_left; apply perm_left. Qed. End Axiomatisation. coq-8.20.0/theories/Sets/Powerset.v000066400000000000000000000156311466560755400171520ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* In (Ensemble U) (Power_set A) X. #[local] Hint Resolve Definition_of_Power_set : core. Theorem Empty_set_minimal : forall X:Ensemble U, Included U (Empty_set U) X. intro X; red. intros x H'; elim H'. Qed. #[local] Hint Resolve Empty_set_minimal : core. Theorem Power_set_Inhabited : forall X:Ensemble U, Inhabited (Ensemble U) (Power_set X). intro X. apply Inhabited_intro with (Empty_set U); auto with sets. Qed. #[local] Hint Resolve Power_set_Inhabited : core. Theorem Inclusion_is_an_order : Order (Ensemble U) (Included U). auto 6 with sets. Qed. #[local] Hint Resolve Inclusion_is_an_order : core. Theorem Inclusion_is_transitive : Transitive (Ensemble U) (Included U). elim Inclusion_is_an_order; auto with sets. Qed. #[local] Hint Resolve Inclusion_is_transitive : core. Definition Power_set_PO : Ensemble U -> PO (Ensemble U). intro A; try assumption. apply Definition_of_PO with (Power_set A) (Included U); auto with sets. Defined. #[local] Hint Unfold Power_set_PO : core. Theorem Strict_Rel_is_Strict_Included : same_relation (Ensemble U) (Strict_Included U) (Strict_Rel_of (Ensemble U) (Power_set_PO (Full_set U))). auto with sets. Qed. #[local] Hint Resolve Strict_Rel_Transitive Strict_Rel_is_Strict_Included : core. Lemma Strict_inclusion_is_transitive_with_inclusion : forall x y z:Ensemble U, Strict_Included U x y -> Included U y z -> Strict_Included U x z. intros x y z H' H'0; try assumption. elim Strict_Rel_is_Strict_Included. unfold contains. intros H'1 H'2; try assumption. apply H'1. apply Strict_Rel_Transitive_with_Rel with (y := y); auto with sets. Qed. Lemma Strict_inclusion_is_transitive_with_inclusion_left : forall x y z:Ensemble U, Included U x y -> Strict_Included U y z -> Strict_Included U x z. intros x y z H' H'0; try assumption. elim Strict_Rel_is_Strict_Included. unfold contains. intros H'1 H'2; try assumption. apply H'1. apply Strict_Rel_Transitive_with_Rel_left with (y := y); auto with sets. Qed. Lemma Strict_inclusion_is_transitive : Transitive (Ensemble U) (Strict_Included U). apply cong_transitive_same_relation with (R := Strict_Rel_of (Ensemble U) (Power_set_PO (Full_set U))); auto with sets. Qed. Theorem Empty_set_is_Bottom : forall A:Ensemble U, Bottom (Ensemble U) (Power_set_PO A) (Empty_set U). intro A; apply Bottom_definition; simpl; auto with sets. Qed. #[local] Hint Resolve Empty_set_is_Bottom : core. Theorem Union_minimal : forall a b X:Ensemble U, Included U a X -> Included U b X -> Included U (Union U a b) X. intros a b X H' H'0; red. intros x H'1; elim H'1; auto with sets. Qed. #[local] Hint Resolve Union_minimal : core. Theorem Intersection_maximal : forall a b X:Ensemble U, Included U X a -> Included U X b -> Included U X (Intersection U a b). auto with sets. Qed. Theorem Union_increases_l : forall a b:Ensemble U, Included U a (Union U a b). auto with sets. Qed. Theorem Union_increases_r : forall a b:Ensemble U, Included U b (Union U a b). auto with sets. Qed. Theorem Intersection_decreases_l : forall a b:Ensemble U, Included U (Intersection U a b) a. intros a b; red. intros x H'; elim H'; auto with sets. Qed. Theorem Intersection_decreases_r : forall a b:Ensemble U, Included U (Intersection U a b) b. intros a b; red. intros x H'; elim H'; auto with sets. Qed. #[local] Hint Resolve Union_increases_l Union_increases_r Intersection_decreases_l Intersection_decreases_r : core. Theorem Union_is_Lub : forall A a b:Ensemble U, Included U a A -> Included U b A -> Lub (Ensemble U) (Power_set_PO A) (Couple (Ensemble U) a b) (Union U a b). intros A a b H' H'0. apply Lub_definition; simpl. - apply Upper_Bound_definition; simpl; auto with sets. intros y H'1; elim H'1; auto with sets. - intros y H'1; elim H'1; simpl; auto with sets. Qed. Theorem Intersection_is_Glb : forall A a b:Ensemble U, Included U a A -> Included U b A -> Glb (Ensemble U) (Power_set_PO A) (Couple (Ensemble U) a b) (Intersection U a b). intros A a b H' H'0. apply Glb_definition; simpl. - apply Lower_Bound_definition; simpl; auto with sets. + apply Definition_of_Power_set. generalize Inclusion_is_transitive; intro IT; red in IT; apply IT with a; auto with sets. + intros y H'1; elim H'1; auto with sets. - intros y H'1; elim H'1; simpl; auto with sets. Qed. End The_power_set_partial_order. #[global] Hint Resolve Empty_set_minimal: sets. #[global] Hint Resolve Power_set_Inhabited: sets. #[global] Hint Resolve Inclusion_is_an_order: sets. #[global] Hint Resolve Inclusion_is_transitive: sets. #[global] Hint Resolve Union_minimal: sets. #[global] Hint Resolve Union_increases_l: sets. #[global] Hint Resolve Union_increases_r: sets. #[global] Hint Resolve Intersection_decreases_l: sets. #[global] Hint Resolve Intersection_decreases_r: sets. #[global] Hint Resolve Empty_set_is_Bottom: sets. #[global] Hint Resolve Strict_inclusion_is_transitive: sets. coq-8.20.0/theories/Sets/Powerset_Classical_facts.v000066400000000000000000000272471466560755400223160ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* Strict_Included U (Add U A x) (Add U B x) -> Strict_Included U A B. Proof. intros A B x H' H'0; red. lapply (Strict_Included_inv U (Add U A x) (Add U B x)); auto with sets. clear H'0; intro H'0; split. - apply incl_add_x with (x := x); tauto. - elim H'0; intros H'1 H'2; elim H'2; clear H'0 H'2. intros x0 H'0. red; intro H'2. elim H'0; clear H'0. rewrite <- H'2; auto with sets. Qed. Lemma incl_soustr_in : forall (X:Ensemble U) (x:U), In U X x -> Included U (Subtract U X x) X. Proof. intros X x H'; red. intros x0 H'0; elim H'0; auto with sets. Qed. Lemma incl_soustr : forall (X Y:Ensemble U) (x:U), Included U X Y -> Included U (Subtract U X x) (Subtract U Y x). Proof. intros X Y x H'; red. intros x0 H'0; elim H'0. intros H'1 H'2. apply Subtract_intro; auto with sets. Qed. Lemma incl_soustr_add_l : forall (X:Ensemble U) (x:U), Included U (Subtract U (Add U X x) x) X. Proof. intros X x; red. intros x0 H'; elim H'; auto with sets. intro H'0; elim H'0; auto with sets. intros t H'1 H'2; elim H'2; auto with sets. Qed. Lemma incl_soustr_add_r : forall (X:Ensemble U) (x:U), ~ In U X x -> Included U X (Subtract U (Add U X x) x). Proof. intros X x H'; red. intros x0 H'0; try assumption. apply Subtract_intro; auto with sets. red; intro H'1; apply H'; rewrite H'1; auto with sets. Qed. #[local] Hint Resolve incl_soustr_add_r: sets. Lemma add_soustr_2 : forall (X:Ensemble U) (x:U), In U X x -> Included U X (Add U (Subtract U X x) x). Proof. intros X x H'; red. intros x0 H'0; try assumption. elim (classic (x = x0)); intro K; auto with sets. elim K; auto with sets. Qed. Lemma add_soustr_1 : forall (X:Ensemble U) (x:U), In U X x -> Included U (Add U (Subtract U X x) x) X. Proof. intros X x H'; red. intros x0 H'0; elim H'0; auto with sets. - intros y H'1; elim H'1; auto with sets. - intros t H'1; try assumption. rewrite <- (Singleton_inv U x t); auto with sets. Qed. Lemma add_soustr_xy : forall (X:Ensemble U) (x y:U), x <> y -> Subtract U (Add U X x) y = Add U (Subtract U X y) x. Proof. intros X x y H'; apply Extensionality_Ensembles. split; red. - intros x0 H'0; elim H'0; auto with sets. intro H'1; elim H'1. + intros u H'2 H'3; try assumption. apply Add_intro1. apply Subtract_intro; auto with sets. + intros t H'2 H'3; try assumption. elim (Singleton_inv U x t); auto with sets. - intros u H'2; try assumption. elim (Add_inv U (Subtract U X y) x u); auto with sets. + intro H'0; elim H'0; auto with sets. + intro H'0; rewrite <- H'0; auto with sets. Qed. Lemma incl_st_add_soustr : forall (X Y:Ensemble U) (x:U), ~ In U X x -> Strict_Included U (Add U X x) Y -> Strict_Included U X (Subtract U Y x). Proof. intros X Y x H' H'0; apply sincl_add_x with (x := x); auto using add_soustr_1 with sets. split. - elim H'0. intros H'1 H'2. generalize (Inclusion_is_transitive U). intro H'4; red in H'4. apply H'4 with (y := Y); auto using add_soustr_2 with sets. - red in H'0. elim H'0; intros H'1 H'2; try exact H'1; clear H'0. (* PB *) red; intro H'0; apply H'2. rewrite H'0; auto 8 using add_soustr_xy, add_soustr_1, add_soustr_2 with sets. Qed. Lemma Sub_Add_new : forall (X:Ensemble U) (x:U), ~ In U X x -> X = Subtract U (Add U X x) x. Proof. auto using incl_soustr_add_l with sets. Qed. Lemma Simplify_add : forall (X X0:Ensemble U) (x:U), ~ In U X x -> ~ In U X0 x -> Add U X x = Add U X0 x -> X = X0. Proof. intros X X0 x H' H'0 H'1; try assumption. rewrite (Sub_Add_new X x); auto with sets. rewrite (Sub_Add_new X0 x); auto with sets. rewrite H'1; auto with sets. Qed. Lemma Included_Add : forall (X A:Ensemble U) (x:U), Included U X (Add U A x) -> Included U X A \/ (exists A' : _, X = Add U A' x /\ Included U A' A). Proof. intros X A x H'0; try assumption. elim (classic (In U X x)). - intro H'1; right; try assumption. exists (Subtract U X x). split; auto using incl_soustr_in, add_soustr_xy, add_soustr_1, add_soustr_2 with sets. red in H'0. red. intros x0 H'2; try assumption. lapply (Subtract_inv U X x x0); auto with sets. intro H'3; elim H'3; intros K K'; clear H'3. lapply (H'0 x0); auto with sets. intro H'3; try assumption. lapply (Add_inv U A x x0); auto with sets. intro H'4; elim H'4; [ intro H'5; try exact H'5; clear H'4 | intro H'5; clear H'4 ]. elim K'; auto with sets. - intro H'1; left; try assumption. red in H'0. red. intros x0 H'2; try assumption. lapply (H'0 x0); auto with sets. intro H'3; try assumption. lapply (Add_inv U A x x0); auto with sets. intro H'4; elim H'4; [ intro H'5; try exact H'5; clear H'4 | intro H'5; clear H'4 ]. absurd (In U X x0); auto with sets. rewrite <- H'5; auto with sets. Qed. Lemma setcover_inv : forall A x y:Ensemble U, covers (Ensemble U) (Power_set_PO U A) y x -> Strict_Included U x y /\ (forall z:Ensemble U, Included U x z -> Included U z y -> x = z \/ z = y). Proof. intros A x y H'; elim H'. unfold Strict_Rel_of; simpl. intros H'0 H'1; split; [ auto with sets | idtac ]. intros z H'2 H'3; try assumption. elim (classic (x = z)); auto with sets. intro H'4; right; try assumption. elim (classic (z = y)); auto with sets. intro H'5; try assumption. elim H'1. exists z; auto with sets. Qed. Theorem Add_covers : forall A a:Ensemble U, Included U a A -> forall x:U, In U A x -> ~ In U a x -> covers (Ensemble U) (Power_set_PO U A) (Add U a x) a. Proof. intros A a H' x H'0 H'1; try assumption. apply setcover_intro; auto with sets. - red. split; [ idtac | red; intro H'2; try exact H'2 ]; auto with sets. apply H'1. rewrite H'2; auto with sets. - red; intro H'2; elim H'2; clear H'2. intros z H'2; elim H'2; intros H'3 H'4; try exact H'3; clear H'2. lapply (Strict_Included_inv U a z); auto with sets; clear H'3. intro H'2; elim H'2; intros H'3 H'5; elim H'5; clear H'2 H'5. intros x0 H'2; elim H'2. intros H'5 H'6; try assumption. generalize H'4; intro K. red in H'4. elim H'4; intros H'8 H'9; red in H'8; clear H'4. lapply (H'8 x0); auto with sets. intro H'7; try assumption. elim (Add_inv U a x x0); auto with sets. intro H'15. cut (Included U (Add U a x) z). + intro H'10; try assumption. red in K. elim K; intros H'11 H'12; apply H'12; clear K; auto with sets. + rewrite H'15. red. intros x1 H'10; elim H'10; auto with sets. intros x2 H'11; elim H'11; auto with sets. Qed. Theorem covers_Add : forall A a a':Ensemble U, Included U a A -> Included U a' A -> covers (Ensemble U) (Power_set_PO U A) a' a -> exists x : _, a' = Add U a x /\ In U A x /\ ~ In U a x. Proof. intros A a a' H' H'0 H'1; try assumption. elim (setcover_inv A a a'); auto with sets. intros H'6 H'7. clear H'1. elim (Strict_Included_inv U a a'); auto with sets. intros H'5 H'8; elim H'8. intros x H'1; elim H'1. intros H'2 H'3; try assumption. exists x. split; [ try assumption | idtac ]. - clear H'8 H'1. elim (H'7 (Add U a x)); auto with sets. + intro H'1. absurd (a = Add U a x); auto with sets. red; intro H'8; try exact H'8. apply H'3. rewrite H'8; auto with sets. + auto with sets. red. intros x0 H'1; elim H'1; auto with sets. intros x1 H'8; elim H'8; auto with sets. - split; [ idtac | try assumption ]. red in H'0; auto with sets. Qed. Theorem covers_is_Add : forall A a a':Ensemble U, Included U a A -> Included U a' A -> (covers (Ensemble U) (Power_set_PO U A) a' a <-> (exists x : _, a' = Add U a x /\ In U A x /\ ~ In U a x)). Proof. intros A a a' H' H'0; split; intro K. - apply covers_Add with (A := A); auto with sets. - elim K. intros x H'1; elim H'1; intros H'2 H'3; rewrite H'2; clear H'1. apply Add_covers; intuition. Qed. Theorem Singleton_atomic : forall (x:U) (A:Ensemble U), In U A x -> covers (Ensemble U) (Power_set_PO U A) (Singleton U x) (Empty_set U). Proof. intros x A H'. rewrite <- (Empty_set_zero' U x). apply Add_covers; auto with sets. Qed. Lemma less_than_singleton : forall (X:Ensemble U) (x:U), Strict_Included U X (Singleton U x) -> X = Empty_set U. Proof. intros X x H'; try assumption. red in H'. lapply (Singleton_atomic x (Full_set U)); [ intro H'2; try exact H'2 | apply Full_intro ]. elim H'; intros H'0 H'1; try exact H'1; clear H'. elim (setcover_inv (Full_set U) (Empty_set U) (Singleton U x)); [ intros H'6 H'7; try exact H'7 | idtac ]; auto with sets. elim (H'7 X); [ intro H'5; try exact H'5 | intro H'5 | idtac | idtac ]; auto with sets. elim H'1; auto with sets. Qed. End Sets_as_an_algebra. #[global] Hint Resolve incl_soustr_in: sets. #[global] Hint Resolve incl_soustr: sets. #[global] Hint Resolve incl_soustr_add_l: sets. #[global] Hint Resolve incl_soustr_add_r: sets. #[global] Hint Resolve add_soustr_1 add_soustr_2: sets. #[global] Hint Resolve add_soustr_xy: sets. coq-8.20.0/theories/Sets/Powerset_facts.v000066400000000000000000000264221466560755400203320ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* X = Empty_set U. Proof. auto with sets. Qed. Theorem Union_commutative : forall A B:Ensemble U, Union U A B = Union U B A. Proof. auto with sets. Qed. Theorem Union_associative : forall A B C:Ensemble U, Union U (Union U A B) C = Union U A (Union U B C). Proof. auto 9 with sets. Qed. Theorem Union_idempotent : forall A:Ensemble U, Union U A A = A. Proof. auto 7 with sets. Qed. Lemma Union_absorbs : forall A B:Ensemble U, Included U B A -> Union U A B = A. Proof. auto 7 with sets. Qed. Theorem Couple_as_union : forall x y:U, Union U (Singleton U x) (Singleton U y) = Couple U x y. Proof. intros x y; apply Extensionality_Ensembles; split; red. - intros x0 H'; elim H'; (intros x1 H'0; elim H'0; auto with sets). - intros x0 H'; elim H'; auto with sets. Qed. Theorem Triple_as_union : forall x y z:U, Union U (Union U (Singleton U x) (Singleton U y)) (Singleton U z) = Triple U x y z. Proof. intros x y z; apply Extensionality_Ensembles; split; red. - intros x0 H'; elim H'. + intros x1 H'0; elim H'0; (intros x2 H'1; elim H'1; auto with sets). + intros x1 H'0; elim H'0; auto with sets. - intros x0 H'; elim H'; auto with sets. Qed. Theorem Triple_as_Couple : forall x y:U, Couple U x y = Triple U x x y. Proof. intros x y. rewrite <- (Couple_as_union x y). rewrite <- (Union_idempotent (Singleton U x)). apply Triple_as_union. Qed. Theorem Triple_as_Couple_Singleton : forall x y z:U, Triple U x y z = Union U (Couple U x y) (Singleton U z). Proof. intros x y z. rewrite <- (Triple_as_union x y z). rewrite <- (Couple_as_union x y); auto with sets. Qed. Theorem Intersection_commutative : forall A B:Ensemble U, Intersection U A B = Intersection U B A. Proof. intros A B. apply Extensionality_Ensembles. split; red; intros x H'; elim H'; auto with sets. Qed. Theorem Distributivity : forall A B C:Ensemble U, Intersection U A (Union U B C) = Union U (Intersection U A B) (Intersection U A C). Proof. intros A B C. apply Extensionality_Ensembles. split; red; intros x H'. - elim H'. intros x0 H'0 H'1; generalize H'0. elim H'1; auto with sets. - elim H'; intros x0 H'0; elim H'0; auto with sets. Qed. Lemma Distributivity_l : forall (A B C : Ensemble U), Intersection U (Union U A B) C = Union U (Intersection U A C) (Intersection U B C). Proof. intros A B C. rewrite Intersection_commutative. rewrite Distributivity. f_equal; apply Intersection_commutative. Qed. Theorem Distributivity' : forall A B C:Ensemble U, Union U A (Intersection U B C) = Intersection U (Union U A B) (Union U A C). Proof. intros A B C. apply Extensionality_Ensembles. split; red; intros x H'. - elim H'; auto with sets. intros x0 H'0; elim H'0; auto with sets. - elim H'. intros x0 H'0; elim H'0; auto with sets. intros x1 H'1 H'2; try exact H'2. generalize H'1. elim H'2; auto with sets. Qed. Theorem Union_add : forall (A B:Ensemble U) (x:U), Add U (Union U A B) x = Union U A (Add U B x). Proof. unfold Add; auto using Union_associative with sets. Qed. Theorem Non_disjoint_union : forall (X:Ensemble U) (x:U), In U X x -> Add U X x = X. Proof. intros X x H'; unfold Add. apply Extensionality_Ensembles; red. split; red; auto with sets. intros x0 H'0; elim H'0; auto with sets. intros t H'1; elim H'1; auto with sets. Qed. Theorem Non_disjoint_union' : forall (X:Ensemble U) (x:U), ~ In U X x -> Subtract U X x = X. Proof. intros X x H'; unfold Subtract. apply Extensionality_Ensembles. split; red; auto with sets. - intros x0 H'0; elim H'0; auto with sets. - intros x0 H'0; apply Setminus_intro; auto with sets. red; intro H'1; elim H'1. lapply (Singleton_inv U x x0); auto with sets. intro H'4; apply H'; rewrite H'4; auto with sets. Qed. Lemma singlx : forall x y:U, In U (Add U (Empty_set U) x) y -> x = y. Proof. intro x; rewrite (Empty_set_zero' x); auto with sets. Qed. Lemma incl_add : forall (A B:Ensemble U) (x:U), Included U A B -> Included U (Add U A x) (Add U B x). Proof. intros A B x H'; red; auto with sets. intros x0 H'0. lapply (Add_inv U A x x0); auto with sets. intro H'1; elim H'1; [ intro H'2; clear H'1 | intro H'2; rewrite <- H'2; clear H'1 ]; auto with sets. Qed. Lemma incl_add_x : forall (A B:Ensemble U) (x:U), ~ In U A x -> Included U (Add U A x) (Add U B x) -> Included U A B. Proof. unfold Included. intros A B x H' H'0 x0 H'1. lapply (H'0 x0); auto with sets. intro H'2; lapply (Add_inv U B x x0); auto with sets. intro H'3; elim H'3; [ intro H'4; try exact H'4; clear H'3 | intro H'4; clear H'3 ]. absurd (In U A x0); auto with sets. rewrite <- H'4; auto with sets. Qed. Lemma Add_commutative : forall (A:Ensemble U) (x y:U), Add U (Add U A x) y = Add U (Add U A y) x. Proof. intros A x y. unfold Add. rewrite (Union_associative A (Singleton U x) (Singleton U y)). rewrite (Union_commutative (Singleton U x) (Singleton U y)). rewrite <- (Union_associative A (Singleton U y) (Singleton U x)); auto with sets. Qed. Lemma Add_commutative' : forall (A:Ensemble U) (x y z:U), Add U (Add U (Add U A x) y) z = Add U (Add U (Add U A z) x) y. Proof. intros A x y z. rewrite (Add_commutative (Add U A x) y z). rewrite (Add_commutative A x z); auto with sets. Qed. Lemma Add_distributes : forall (A B:Ensemble U) (x y:U), Included U B A -> Add U (Add U A x) y = Union U (Add U A x) (Add U B y). Proof. intros A B x y H'; try assumption. rewrite <- (Union_add (Add U A x) B y). unfold Add at 4. rewrite (Union_commutative A (Singleton U x)). rewrite Union_associative. rewrite (Union_absorbs A B H'). rewrite (Union_commutative (Singleton U x) A). auto with sets. Qed. Lemma setcover_intro : forall (U:Type) (A x y:Ensemble U), Strict_Included U x y -> ~ (exists z : _, Strict_Included U x z /\ Strict_Included U z y) -> covers (Ensemble U) (Power_set_PO U A) y x. Proof. intros; apply Definition_of_covers; auto with sets. Qed. Lemma Disjoint_Intersection: forall A s1 s2, Disjoint A s1 s2 -> Intersection A s1 s2 = Empty_set A. Proof. intros. apply Extensionality_Ensembles. split. * destruct H. intros x H1. unfold In in *. exfalso. intuition. apply (H _ H1). * intuition. Qed. Lemma Intersection_Empty_set_l: forall A s, Intersection A (Empty_set A) s = Empty_set A. Proof. intros. auto with sets. Qed. Lemma Intersection_Empty_set_r: forall A s, Intersection A s (Empty_set A) = Empty_set A. Proof. intros. auto with sets. Qed. Lemma Seminus_Empty_set_l: forall A s, Setminus A (Empty_set A) s = Empty_set A. Proof. intros. apply Extensionality_Ensembles. split. * intros x H1. destruct H1. unfold In in *. assumption. * intuition. Qed. Lemma Seminus_Empty_set_r: forall A s, Setminus A s (Empty_set A) = s. Proof. intros. apply Extensionality_Ensembles. split. * intros x H1. destruct H1. unfold In in *. assumption. * intuition. Qed. Lemma Setminus_Union_l: forall A s1 s2 s3, Setminus A (Union A s1 s2) s3 = Union A (Setminus A s1 s3) (Setminus A s2 s3). Proof. intros. apply Extensionality_Ensembles. split. * intros x H. inversion H. inversion H0; intuition. * intros x H. constructor; inversion H; inversion H0; intuition. Qed. Lemma Setminus_Union_r: forall A s1 s2 s3, Setminus A s1 (Union A s2 s3) = Setminus A (Setminus A s1 s2) s3. Proof. intros. apply Extensionality_Ensembles. split. * intros x H. inversion H. constructor. -- intuition. -- contradict H1. intuition. * intros x H. inversion H. inversion H0. constructor; intuition. inversion H4; intuition. Qed. Lemma Setminus_Disjoint_noop: forall A s1 s2, Intersection A s1 s2 = Empty_set A -> Setminus A s1 s2 = s1. Proof. intros. apply Extensionality_Ensembles. split. * intros x H1. inversion_clear H1. intuition. * intros x H1. constructor; intuition. contradict H. apply Inhabited_not_empty. exists x. intuition. Qed. Lemma Setminus_Included_empty: forall A s1 s2, Included A s1 s2 -> Setminus A s1 s2 = Empty_set A. Proof. intros. apply Extensionality_Ensembles. split. * intros x H1. inversion_clear H1. contradiction H2. intuition. * intuition. Qed. End Sets_as_an_algebra. #[global] Hint Resolve Empty_set_zero Empty_set_zero' Union_associative Union_add singlx incl_add: sets. coq-8.20.0/theories/Sets/Relations_1.v000066400000000000000000000057701466560755400175250ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* U -> Prop. Variable R : Relation. Definition Reflexive : Prop := forall x:U, R x x. Definition Transitive : Prop := forall x y z:U, R x y -> R y z -> R x z. Definition Symmetric : Prop := forall x y:U, R x y -> R y x. Definition Antisymmetric : Prop := forall x y:U, R x y -> R y x -> x = y. Definition contains (R R':Relation) : Prop := forall x y:U, R' x y -> R x y. Definition same_relation (R R':Relation) : Prop := contains R R' /\ contains R' R. Inductive Preorder : Prop := Definition_of_preorder : Reflexive -> Transitive -> Preorder. Inductive Order : Prop := Definition_of_order : Reflexive -> Transitive -> Antisymmetric -> Order. Inductive Equivalence : Prop := Definition_of_equivalence : Reflexive -> Transitive -> Symmetric -> Equivalence. Inductive PER : Prop := Definition_of_PER : Symmetric -> Transitive -> PER. End Relations_1. #[global] Hint Unfold Reflexive Transitive Antisymmetric Symmetric contains same_relation: sets. #[global] Hint Resolve Definition_of_preorder Definition_of_order Definition_of_equivalence Definition_of_PER: sets. coq-8.20.0/theories/Sets/Relations_1_facts.v000066400000000000000000000103321466560755400206730ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* ~ R x y. Theorem Rsym_imp_notRsym : forall (U:Type) (R:Relation U), Symmetric U R -> Symmetric U (Complement U R). Proof. unfold Symmetric, Complement. intros U R H' x y H'0; red; intro H'1; apply H'0; auto with sets. Qed. Theorem Equiv_from_preorder : forall (U:Type) (R:Relation U), Preorder U R -> Equivalence U (fun x y:U => R x y /\ R y x). Proof. intros U R H'; elim H'; intros H'0 H'1. apply Definition_of_equivalence. - red in H'0; auto 10 with sets. - red in H'1; red; auto 10 with sets. intros x y z h; elim h; intros H'3 H'4; clear h. intro h; elim h; intros H'5 H'6; clear h. split; apply H'1 with y; auto 10 with sets. - red; intros x y h; elim h; intros H'3 H'4; auto 10 with sets. Qed. #[global] Hint Resolve Equiv_from_preorder : core. Theorem Equiv_from_order : forall (U:Type) (R:Relation U), Order U R -> Equivalence U (fun x y:U => R x y /\ R y x). Proof. intros U R H'; elim H'; auto 10 with sets. Qed. #[global] Hint Resolve Equiv_from_order : core. Theorem contains_is_preorder : forall U:Type, Preorder (Relation U) (contains U). Proof. auto 10 with sets. Qed. #[global] Hint Resolve contains_is_preorder : core. Theorem same_relation_is_equivalence : forall U:Type, Equivalence (Relation U) (same_relation U). Proof. unfold same_relation at 1; auto 10 with sets. Qed. #[global] Hint Resolve same_relation_is_equivalence : core. Theorem cong_reflexive_same_relation : forall (U:Type) (R R':Relation U), same_relation U R R' -> Reflexive U R -> Reflexive U R'. Proof. unfold same_relation; intuition. Qed. Theorem cong_symmetric_same_relation : forall (U:Type) (R R':Relation U), same_relation U R R' -> Symmetric U R -> Symmetric U R'. Proof. compute; intros; elim H; intros; clear H; apply (H3 y x (H0 x y (H2 x y H1))). (*Intuition.*) Qed. Theorem cong_antisymmetric_same_relation : forall (U:Type) (R R':Relation U), same_relation U R R' -> Antisymmetric U R -> Antisymmetric U R'. Proof. compute; intros; elim H; intros; clear H; apply (H0 x y (H3 x y H1) (H3 y x H2)). (*Intuition.*) Qed. Theorem cong_transitive_same_relation : forall (U:Type) (R R':Relation U), same_relation U R R' -> Transitive U R -> Transitive U R'. Proof. intros U R R' H' H'0; red. elim H'. intros H'1 H'2 x y z H'3 H'4; apply H'2. apply H'0 with y; auto with sets. Qed. coq-8.20.0/theories/Sets/Relations_2.v000066400000000000000000000051271466560755400175220ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* Prop := | Rstar_0 : Rstar x x | Rstar_n : forall y z:U, R x y -> Rstar y z -> Rstar x z. Inductive Rstar1 (x:U) : U -> Prop := | Rstar1_0 : Rstar1 x x | Rstar1_1 : forall y:U, R x y -> Rstar1 x y | Rstar1_n : forall y z:U, Rstar1 x y -> Rstar1 y z -> Rstar1 x z. Inductive Rplus (x:U) : U -> Prop := | Rplus_0 : forall y:U, R x y -> Rplus x y | Rplus_n : forall y z:U, R x y -> Rplus y z -> Rplus x z. Definition Strongly_confluent : Prop := forall x a b:U, R x a -> R x b -> ex (fun z:U => R a z /\ R b z). End Relations_2. #[global] Hint Resolve Rstar_0: sets. #[global] Hint Resolve Rstar1_0: sets. #[global] Hint Resolve Rstar1_1: sets. #[global] Hint Resolve Rplus_0: sets. coq-8.20.0/theories/Sets/Relations_2_facts.v000066400000000000000000000131611466560755400206770ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* x = y \/ (exists u : _, R x u /\ Rstar U R u y). Proof. intros U R x y H'; elim H'; auto with sets. intros x0 y0 z H'0 H'1 H'2; right; exists y0; auto with sets. Qed. Theorem Rstar_equiv_Rstar1 : forall (U:Type) (R:Relation U), same_relation U (Rstar U R) (Rstar1 U R). Proof. generalize Rstar_contains_R; intro T; red in T. intros U R; unfold same_relation, contains. split; intros x y H'; elim H'; auto with sets. - generalize Rstar_transitive; intro T1; red in T1. intros x0 y0 z H'0 H'1 H'2 H'3; apply T1 with y0; auto with sets. - intros x0 y0 z H'0 H'1 H'2; apply Rstar1_n with y0; auto with sets. Qed. Theorem Rsym_imp_Rstarsym : forall (U:Type) (R:Relation U), Symmetric U R -> Symmetric U (Rstar U R). Proof. intros U R H'; red. intros x y H'0; elim H'0; auto with sets. intros x0 y0 z H'1 H'2 H'3. generalize Rstar_transitive; intro T1; red in T1. apply T1 with y0; auto with sets. apply Rstar_n with x0; auto with sets. Qed. Theorem Sstar_contains_Rstar : forall (U:Type) (R S:Relation U), contains U (Rstar U S) R -> contains U (Rstar U S) (Rstar U R). Proof. unfold contains. intros U R S H' x y H'0; elim H'0; auto with sets. generalize Rstar_transitive; intro T1; red in T1. intros x0 y0 z H'1 H'2 H'3; apply T1 with y0; auto with sets. Qed. Theorem star_monotone : forall (U:Type) (R S:Relation U), contains U S R -> contains U (Rstar U S) (Rstar U R). Proof. intros U R S H'. apply Sstar_contains_Rstar; auto with sets. generalize (Rstar_contains_R U S); auto with sets. Qed. Theorem RstarRplus_RRstar : forall (U:Type) (R:Relation U) (x y z:U), Rstar U R x y -> Rplus U R y z -> exists u : _, R x u /\ Rstar U R u z. Proof. generalize Rstar_contains_Rplus; intro T; red in T. generalize Rstar_transitive; intro T1; red in T1. intros U R x y z H'; elim H'. - intros x0 H'0; elim H'0. + intros x1 y0 H'1; exists y0; auto with sets. + intros x1 y0 z0 H'1 H'2 H'3; exists y0; auto with sets. - intros x0 y0 z0 H'0 H'1 H'2 H'3; exists y0. split; [ try assumption | idtac ]. apply T1 with z0; auto with sets. Qed. Theorem Lemma1 : forall (U:Type) (R:Relation U), Strongly_confluent U R -> forall x b:U, Rstar U R x b -> forall a:U, R x a -> exists z : _, Rstar U R a z /\ R b z. Proof. intros U R H' x b H'0; elim H'0. - intros x0 a H'1; exists a; auto with sets. - intros x0 y z H'1 H'2 H'3 a H'4. red in H'. specialize H' with (x := x0) (a := a) (b := y); lapply H'; [ intro H'8; lapply H'8; [ intro H'9; try exact H'9; clear H'8 H' | clear H'8 H' ] | clear H' ]; auto with sets. elim H'9. intros t H'5; elim H'5; intros H'6 H'7; try exact H'6; clear H'5. elim (H'3 t); auto with sets. intros z1 H'5; elim H'5; intros H'8 H'10; try exact H'8; clear H'5. exists z1; split; [ idtac | assumption ]. apply Rstar_n with t; auto with sets. Qed. coq-8.20.0/theories/Sets/Relations_3.v000066400000000000000000000054621466560755400175250ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* R x z -> coherent y z. Definition Locally_confluent : Prop := forall x:U, locally_confluent x. Definition confluent (x:U) : Prop := forall y z:U, Rstar U R x y -> Rstar U R x z -> coherent y z. Definition Confluent : Prop := forall x:U, confluent x. Inductive noetherian (x: U) : Prop := definition_of_noetherian : (forall y:U, R x y -> noetherian y) -> noetherian x. Definition Noetherian : Prop := forall x:U, noetherian x. End Relations_3. #[global] Hint Unfold coherent: sets. #[global] Hint Unfold locally_confluent: sets. #[global] Hint Unfold confluent: sets. #[global] Hint Unfold Confluent: sets. #[global] Hint Resolve definition_of_noetherian: sets. #[global] Hint Unfold Noetherian: sets. coq-8.20.0/theories/Sets/Relations_3_facts.v000066400000000000000000000152231466560755400207010ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* coherent U R x y. Proof. intros U R x y H'; red. exists y; auto with sets. Qed. #[global] Hint Resolve Rstar_imp_coherent : core. Theorem coherent_symmetric : forall (U:Type) (R:Relation U), Symmetric U (coherent U R). Proof. unfold coherent at 1. intros U R; red. intros x y H'; elim H'. intros z H'0; exists z; tauto. Qed. Theorem Strong_confluence : forall (U:Type) (R:Relation U), Strongly_confluent U R -> Confluent U R. Proof. intros U R H'; red. intro x; red; intros a b H'0. unfold coherent at 1. generalize b; clear b. elim H'0; clear H'0. - intros x0 b H'1; exists b; auto with sets. - intros x0 y z H'1 H'2 H'3 b H'4. generalize (Lemma1 U R); intro h; lapply h; [ intro H'0; generalize (H'0 x0 b); intro h0; lapply h0; [ intro H'5; generalize (H'5 y); intro h1; lapply h1; [ intro h2; elim h2; intros z0 h3; elim h3; intros H'6 H'7; clear h h0 h1 h2 h3 | clear h h0 h1 ] | clear h h0 ] | clear h ]; auto with sets. generalize (H'3 z0); intro h; lapply h; [ intro h0; elim h0; intros z1 h1; elim h1; intros H'8 H'9; clear h h0 h1 | clear h ]; auto with sets. exists z1; split; auto with sets. apply Rstar_n with z0; auto with sets. Qed. Theorem Strong_confluence_direct : forall (U:Type) (R:Relation U), Strongly_confluent U R -> Confluent U R. Proof. intros U R H'; red. intro x; red; intros a b H'0. unfold coherent at 1. generalize b; clear b. elim H'0; clear H'0. - intros x0 b H'1; exists b; auto with sets. - intros x0 y z H'1 H'2 H'3 b H'4. cut (ex (fun t:U => Rstar U R y t /\ R b t)). + intro h; elim h; intros t h0; elim h0; intros H'0 H'5; clear h h0. generalize (H'3 t); intro h; lapply h; [ intro h0; elim h0; intros z0 h1; elim h1; intros H'6 H'7; clear h h0 h1 | clear h ]; auto with sets. exists z0; split; [ assumption | idtac ]. apply Rstar_n with t; auto with sets. + generalize H'1; generalize y; clear H'1. elim H'4. * intros x1 y0 H'0; exists y0; auto with sets. * intros x1 y0 z0 H'0 H'1 H'5 y1 H'6. red in H'. generalize (H' x1 y0 y1); intro h; lapply h; [ intro H'7; lapply H'7; [ intro h0; elim h0; intros z1 h1; elim h1; intros H'8 H'9; clear h H'7 h0 h1 | clear h ] | clear h ]; auto with sets. generalize (H'5 z1); intro h; lapply h; [ intro h0; elim h0; intros t h1; elim h1; intros H'7 H'10; clear h h0 h1 | clear h ]; auto with sets. exists t; split; auto with sets. apply Rstar_n with z1; auto with sets. Qed. Theorem Noetherian_contains_Noetherian : forall (U:Type) (R R':Relation U), Noetherian U R -> contains U R R' -> Noetherian U R'. Proof. unfold Noetherian at 2. intros U R R' H' H'0 x. elim (H' x); auto with sets. Qed. Theorem Newman : forall (U:Type) (R:Relation U), Noetherian U R -> Locally_confluent U R -> Confluent U R. Proof. intros U R H' H'0; red; intro x. elim (H' x); unfold confluent. intros x0 H'1 H'2 y z H'3 H'4. generalize (Rstar_cases U R x0 y); intro h; lapply h; [ intro h0; elim h0; [ clear h h0; intro h1 | intro h1; elim h1; intros u h2; elim h2; intros H'5 H'6; clear h h0 h1 h2 ] | clear h ]; auto with sets. - elim h1; auto with sets. - generalize (Rstar_cases U R x0 z); intro h; lapply h; [ intro h0; elim h0; [ clear h h0; intro h1 | intro h1; elim h1; intros v h2; elim h2; intros H'7 H'8; clear h h0 h1 h2 ] | clear h ]; auto with sets. + elim h1; generalize coherent_symmetric; intro t; red in t; auto with sets. + unfold Locally_confluent, locally_confluent, coherent in H'0. generalize (H'0 x0 u v); intro h; lapply h; [ intro H'9; lapply H'9; [ intro h0; elim h0; intros t h1; elim h1; intros H'10 H'11; clear h H'9 h0 h1 | clear h ] | clear h ]; auto with sets. clear H'0. unfold coherent at 1 in H'2. generalize (H'2 u); intro h; lapply h; [ intro H'0; generalize (H'0 y t); intro h0; lapply h0; [ intro H'9; lapply H'9; [ intro h1; elim h1; intros y1 h2; elim h2; intros H'12 H'13; clear h h0 H'9 h1 h2 | clear h h0 ] | clear h h0 ] | clear h ]; auto with sets. generalize Rstar_transitive; intro T; red in T. generalize (H'2 v); intro h; lapply h; [ intro H'9; generalize (H'9 y1 z); intro h0; lapply h0; [ intro H'14; lapply H'14; [ intro h1; elim h1; intros z1 h2; elim h2; intros H'15 H'16; clear h h0 H'14 h1 h2 | clear h h0 ] | clear h h0 ] | clear h ]; auto with sets. * red; (exists z1; split); auto with sets. apply T with y1; auto with sets. * apply T with t; auto with sets. Qed. coq-8.20.0/theories/Sets/Uniset.v000066400000000000000000000133041466560755400166040ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* A -> Prop. Hypothesis eqA_dec : forall x y:A, {eqA x y} + {~ eqA x y}. Inductive uniset : Set := Charac : (A -> bool) -> uniset. Definition charac (s:uniset) (a:A) : bool := let (f) := s in f a. Definition Emptyset := Charac (fun a:A => false). Definition Fullset := Charac (fun a:A => true). Definition Singleton (a:A) := Charac (fun a':A => match eqA_dec a a' with | left h => true | right h => false end). Definition In (s:uniset) (a:A) : Prop := charac s a = true. #[local] Hint Unfold In : core. (** uniset inclusion *) Definition incl (s1 s2:uniset) := forall a:A, Bool.le (charac s1 a) (charac s2 a). #[local] Hint Unfold incl : core. (** uniset equality *) Definition seq (s1 s2:uniset) := forall a:A, charac s1 a = charac s2 a. #[local] Hint Unfold seq : core. Lemma le_refl : forall b, Bool.le b b. Proof. destruct b; simpl; auto. Qed. #[local] Hint Resolve le_refl : core. Lemma incl_left : forall s1 s2:uniset, seq s1 s2 -> incl s1 s2. Proof. unfold incl; intros s1 s2 E a; elim (E a); auto. Qed. Lemma incl_right : forall s1 s2:uniset, seq s1 s2 -> incl s2 s1. Proof. unfold incl; intros s1 s2 E a; elim (E a); auto. Qed. Lemma seq_refl : forall x:uniset, seq x x. Proof. destruct x; unfold seq; auto. Qed. #[local] Hint Resolve seq_refl : core. Lemma seq_trans : forall x y z:uniset, seq x y -> seq y z -> seq x z. Proof. unfold seq. destruct x; destruct y; destruct z; simpl; intros. rewrite H; auto. Qed. Lemma seq_sym : forall x y:uniset, seq x y -> seq y x. Proof. unfold seq. destruct x; destruct y; simpl; auto. Qed. (** uniset union *) Definition union (m1 m2:uniset) := Charac (fun a:A => orb (charac m1 a) (charac m2 a)). Lemma union_empty_left : forall x:uniset, seq x (union Emptyset x). Proof. unfold seq; unfold union; simpl; auto. Qed. #[local] Hint Resolve union_empty_left : core. Lemma union_empty_right : forall x:uniset, seq x (union x Emptyset). Proof. unfold seq; unfold union; simpl. intros x a; rewrite (orb_b_false (charac x a)); auto. Qed. #[local] Hint Resolve union_empty_right : core. Lemma union_comm : forall x y:uniset, seq (union x y) (union y x). Proof. unfold seq; unfold charac; unfold union. destruct x; destruct y; auto with bool. Qed. #[local] Hint Resolve union_comm : core. Lemma union_ass : forall x y z:uniset, seq (union (union x y) z) (union x (union y z)). Proof. unfold seq; unfold union; unfold charac. destruct x; destruct y; destruct z; auto with bool. Qed. #[local] Hint Resolve union_ass : core. Lemma seq_left : forall x y z:uniset, seq x y -> seq (union x z) (union y z). Proof. unfold seq; unfold union; unfold charac. destruct x; destruct y; destruct z. intros; elim H; auto. Qed. #[local] Hint Resolve seq_left : core. Lemma seq_right : forall x y z:uniset, seq x y -> seq (union z x) (union z y). Proof. unfold seq; unfold union; unfold charac. destruct x; destruct y; destruct z. intros; elim H; auto. Qed. #[local] Hint Resolve seq_right : core. (** All the proofs that follow duplicate [Multiset_of_A] *) (** Here we should make uniset an abstract datatype, by hiding [Charac], [union], [charac]; all further properties are proved abstractly *) Lemma union_rotate : forall x y z:uniset, seq (union x (union y z)) (union z (union x y)). Proof. intros; apply (op_rotate uniset union seq); auto. exact seq_trans. Qed. Lemma seq_congr : forall x y z t:uniset, seq x y -> seq z t -> seq (union x z) (union y t). Proof. intros; apply (cong_congr uniset union seq); auto. exact seq_trans. Qed. Lemma union_perm_left : forall x y z:uniset, seq (union x (union y z)) (union y (union x z)). Proof. intros; apply (perm_left uniset union seq); auto. exact seq_trans. Qed. Lemma uniset_twist1 : forall x y z t:uniset, seq (union x (union (union y z) t)) (union (union y (union x t)) z). Proof. intros; apply (twist uniset union seq); auto. exact seq_trans. Qed. Lemma uniset_twist2 : forall x y z t:uniset, seq (union x (union (union y z) t)) (union (union y (union x z)) t). Proof. intros; apply seq_trans with (union (union x (union y z)) t). - apply seq_sym; apply union_ass. - apply seq_left; apply union_perm_left. Qed. (** specific for treesort *) Lemma treesort_twist1 : forall x y z t u:uniset, seq u (union y z) -> seq (union x (union u t)) (union (union y (union x t)) z). Proof. intros; apply seq_trans with (union x (union (union y z) t)). - apply seq_right; apply seq_left; trivial. - apply uniset_twist1. Qed. Lemma treesort_twist2 : forall x y z t u:uniset, seq u (union y z) -> seq (union x (union u t)) (union (union y (union x z)) t). Proof. intros; apply seq_trans with (union x (union (union y z) t)). - apply seq_right; apply seq_left; trivial. - apply uniset_twist2. Qed. (*i theory of minter to do similarly (* uniset intersection *) Definition minter := [m1,m2:uniset] (Charac [a:A](andb (charac m1 a)(charac m2 a))). i*) End defs. Unset Implicit Arguments. coq-8.20.0/theories/Sorting/000077500000000000000000000000001466560755400156545ustar00rootroot00000000000000coq-8.20.0/theories/Sorting/CPermutation.v000066400000000000000000000235661466560755400204710ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* list A -> Prop := | cperm : forall l1 l2, CPermutation (l1 ++ l2) (l2 ++ l1). Instance CPermutation_Permutation : Proper (CPermutation ==> (@Permutation A)) id. Proof. intros ? ? [? ?]; apply Permutation_app_comm. Qed. (** Some facts about [CPermutation] *) Theorem CPermutation_nil : forall l, CPermutation [] l -> l = []. Proof. intros l HC; inversion HC as [l1 l2 Heq]; subst. now apply app_eq_nil in Heq; destruct Heq; subst. Qed. Theorem CPermutation_nil_cons : forall l a, ~ CPermutation [] (a :: l). Proof. intros l a HC; apply CPermutation_nil in HC; inversion HC. Qed. Theorem CPermutation_nil_app_cons : forall l1 l2 a, ~ CPermutation [] (l1 ++ a ::l2). Proof. intros l1 l2 a HC; apply CPermutation_nil in HC; destruct l1; inversion HC. Qed. Lemma CPermutation_split : forall l1 l2, CPermutation l1 l2 <-> exists n, l2 = skipn n l1 ++ firstn n l1. Proof. intros l1 l2; split. - intros [l1' l2']. exists (length l1'). rewrite skipn_app, skipn_all, Nat.sub_diag; simpl; f_equal. now rewrite firstn_app, firstn_all, Nat.sub_diag; simpl; rewrite app_nil_r. - now intros [n ->]; rewrite <- (firstn_skipn n) at 1. Qed. (** Equivalence relation *) Theorem CPermutation_refl : forall l, CPermutation l l. Proof. intros l; now rewrite <- (app_nil_l l) at 1; rewrite <- (app_nil_r l) at 2. Qed. Instance CPermutation_refl' : Proper (Logic.eq ==> CPermutation) id. Proof. intros ? ? ->; apply CPermutation_refl. Qed. Theorem CPermutation_sym : forall l l', CPermutation l l' -> CPermutation l' l. Proof. now intros ? ? [? ?]. Qed. Theorem CPermutation_trans : forall l l' l'', CPermutation l l' -> CPermutation l' l'' -> CPermutation l l''. Proof. intros l l' l'' HC1 HC2. inversion HC1 as [l1 l2]; inversion HC2 as [l3 l4 Heq Heq']; subst. clear - Heq; revert l1 l2 l4 Heq; clear; induction l3; simpl; intros. - now subst; rewrite app_nil_r. - destruct l2 as [| b]. + simpl in Heq; subst. now rewrite app_nil_r, app_comm_cons. + inversion Heq as [[Heqb Heq']]; subst. replace (l1 ++ b :: l2) with ((l1 ++ b :: nil) ++ l2) by now rewrite <- app_assoc, <- app_comm_cons. replace (l4 ++ b :: l3) with ((l4 ++ b :: nil) ++ l3) by now rewrite <- app_assoc, <- app_comm_cons. apply IHl3. now rewrite 2 app_assoc, Heq'. Qed. End CPermutation. #[global] Hint Resolve CPermutation_refl : core. (* These hints do not reduce the size of the problem to solve and they must be used with care to avoid combinatoric explosions *) Local Hint Resolve cperm CPermutation_sym CPermutation_trans : core. #[global] Instance CPermutation_Equivalence A : Equivalence (@CPermutation A) | 10 := { Equivalence_Reflexive := @CPermutation_refl A ; Equivalence_Symmetric := @CPermutation_sym A ; Equivalence_Transitive := @CPermutation_trans A }. Section CPermutation_properties. Variable A B:Type. Implicit Types a b : A. Implicit Types l : list A. (** Compatibility with others operations on lists *) Lemma CPermutation_app : forall l1 l2 l3, CPermutation (l1 ++ l2) l3 -> CPermutation (l2 ++ l1) l3. Proof. intros l1 l2 l3 HC; now transitivity (l1 ++ l2). Qed. Theorem CPermutation_app_comm : forall l1 l2, CPermutation (l1 ++ l2) (l2 ++ l1). Proof. apply cperm. Qed. Lemma CPermutation_app_rot : forall l1 l2 l3, CPermutation (l1 ++ l2 ++ l3) (l2 ++ l3 ++ l1). Proof. intros l1 l2 l3; now rewrite (app_assoc l2). Qed. Lemma CPermutation_cons_append : forall l a, CPermutation (a :: l) (l ++ [a]). Proof. intros l a; now rewrite <- (app_nil_l l), app_comm_cons. Qed. Lemma CPermutation_morph_cons : forall P : list A -> Prop, (forall a l, P (l ++ [a]) -> P (a :: l)) -> Proper (@CPermutation A ==> iff) P. Proof. enough (forall P : list A -> Prop, (forall a l, P (l ++ [a]) -> P (a :: l)) -> forall l1 l2, CPermutation l1 l2 -> P l1 -> P l2) as Himp by now intros P HP l1 l2 HC; split; [ | symmetry in HC ]; apply Himp. intros P HP l1 l2 [l1' l2']. revert l1'; induction l2' using rev_ind; intros l1' HPl. - now rewrite app_nil_r in HPl. - rewrite app_assoc in HPl. apply HP in HPl. rewrite <- app_assoc, <- app_comm_cons, app_nil_l. now apply IHl2'. Qed. Lemma CPermutation_length_1 : forall a b, CPermutation [a] [b] -> a = b. Proof. intros; now apply Permutation_length_1, CPermutation_Permutation. Qed. Lemma CPermutation_length_1_inv : forall a l, CPermutation [a] l -> l = [a]. Proof. intros; now apply Permutation_length_1_inv, CPermutation_Permutation. Qed. Lemma CPermutation_swap : forall a b, CPermutation [a; b] [b; a]. Proof. intros; now change [a; b] with ([a] ++ [b]); change [b; a] with ([b] ++ [a]). Qed. Lemma CPermutation_length_2 : forall a1 a2 b1 b2, CPermutation [a1; a2] [b1; b2] -> a1 = b1 /\ a2 = b2 \/ a1 = b2 /\ a2 = b1. Proof. intros; now apply Permutation_length_2, CPermutation_Permutation. Qed. Lemma CPermutation_length_2_inv : forall a b l, CPermutation [a; b] l -> l = [a; b] \/ l = [b; a]. Proof. intros; now apply Permutation_length_2_inv, CPermutation_Permutation. Qed. Lemma CPermutation_vs_elt_inv : forall l l1 l2 a, CPermutation l (l1 ++ a :: l2) -> exists l' l'', l2 ++ l1 = l'' ++ l' /\ l = l' ++ a :: l''. Proof. intros l l1 l2 a HC. inversion HC as [l1' l2' Heq' Heq]; clear HC; subst. enough (exists l3, (l2' ++ l3 = l1 /\ l1' = l3 ++ a :: l2) \/ (l2' = l1 ++ a :: l3 /\ l3 ++ l1' = l2)) as [l3 [[<- ->]|[-> <-]]]. - exists l3, (l2 ++ l2'); rewrite app_comm_cons; intuition. - exists (l1' ++ l1), l3; intuition. - revert l1' l2' l2 Heq; induction l1; simpl; intros l1' l2' l2 Heq. + destruct l2'; inversion Heq; subst. * exists nil; intuition. * exists l2'; intuition. + destruct l2'; inversion Heq; subst. * exists (a0 :: l1); intuition. * apply IHl1 in H1 as [l3 [[<- ->]|[-> <-]]]; exists l3; intuition. Qed. Lemma CPermutation_vs_cons_inv : forall l l0 a, CPermutation l (a :: l0) -> exists l' l'', l0 = l'' ++ l' /\ l = l' ++ a :: l''. Proof. intros; rewrite <- (app_nil_r l0); now apply CPermutation_vs_elt_inv. Qed. End CPermutation_properties. (** [rev], [in], [map], [Forall], [Exists], etc. *) Global Instance CPermutation_rev A : Proper (@CPermutation A ==> @CPermutation A) (@rev A) | 10. Proof. intro l; induction l; intros l' HC. - now apply CPermutation_nil in HC; subst. - symmetry in HC. destruct (CPermutation_vs_cons_inv HC) as [l1 [l2 [-> ->]]]. simpl; rewrite ? rev_app_distr; simpl. now rewrite <- app_assoc. Qed. Global Instance CPermutation_in A a : Proper (@CPermutation A ==> Basics.impl) (In a). Proof. intros l l' HC Hin. now apply Permutation_in with l; [ apply CPermutation_Permutation | ]. Qed. Global Instance CPermutation_in' A : Proper (Logic.eq ==> @CPermutation A ==> iff) (@In A) | 10. Proof. intros a a' <- l l' HC; split; now apply CPermutation_in. Qed. Global Instance CPermutation_map A B (f : A -> B) : Proper (@CPermutation A ==> @CPermutation B) (map f) | 10. Proof. now intros ? ? [l1 l2]; rewrite 2 map_app. Qed. Lemma CPermutation_map_inv A B : forall (f : A -> B) m l, CPermutation m (map f l) -> exists l', m = map f l' /\ CPermutation l l'. Proof. induction m as [| b m]; intros l HC. - exists nil; split; auto. destruct l; auto. apply CPermutation_nil in HC; inversion HC. - symmetry in HC. destruct (CPermutation_vs_cons_inv HC) as [m1 [m2 [-> Heq]]]. apply map_eq_app in Heq as [l1 [l1' [-> [<- Heq]]]]. apply map_eq_cons in Heq as [a [l1'' [-> [<- <-]]]]. exists (a :: l1'' ++ l1); split. + now simpl; rewrite map_app. + now rewrite app_comm_cons. Qed. Lemma CPermutation_image A B : forall (f : A -> B) a l l', CPermutation (a :: l) (map f l') -> exists a', a = f a'. Proof. intros f a l l' HP. now apply CPermutation_Permutation, Permutation_image in HP. Qed. #[global] Instance CPermutation_Forall A (P : A -> Prop) : Proper (@CPermutation A ==> Basics.impl) (Forall P). Proof. intros ? ? [? ?] HF. now apply Forall_app in HF; apply Forall_app. Qed. #[global] Instance CPermutation_Exists A (P : A -> Prop) : Proper (@CPermutation A ==> Basics.impl) (Exists P). Proof. intros ? ? [? ?] HE. apply Exists_app in HE; apply Exists_app; intuition. Qed. Lemma CPermutation_Forall2 A B (P : A -> B -> Prop) : forall l1 l1' l2, CPermutation l1 l1' -> Forall2 P l1 l2 -> exists l2', CPermutation l2 l2' /\ Forall2 P l1' l2'. Proof. intros ? ? ? [? ?] HF. apply Forall2_app_inv_l in HF as (l2' & l2'' & HF' & HF'' & ->). exists (l2'' ++ l2'); intuition. now apply Forall2_app. Qed. (** As an equivalence relation compatible with some operations, [CPermutation] can be used through [rewrite]. *) Example CPermutation_rewrite_rev A (l1 l2 l3: list A) : CPermutation l1 l2 -> CPermutation (rev l1) l3 -> CPermutation l3 (rev l2). Proof. intros HP1 HP2; rewrite <- HP1, HP2; reflexivity. Qed. coq-8.20.0/theories/Sorting/Heap.v000066400000000000000000000257421466560755400167320ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* leA x y. Hypothesis leA_trans : forall x y z:A, leA x y -> leA y z -> leA x z. Hypothesis leA_antisym : forall x y:A, leA x y -> leA y x -> eqA x y. #[local] Hint Resolve leA_refl : core. #[local] Hint Immediate eqA_dec leA_dec leA_antisym : core. Let emptyBag := EmptyBag A. Let singletonBag := SingletonBag _ eqA_dec. Inductive Tree := | Tree_Leaf : Tree | Tree_Node : A -> Tree -> Tree -> Tree. (** [a] is lower than a Tree [T] if [T] is a Leaf or [T] is a Node holding [b>a] *) #[deprecated(since="8.3", note="Use mergesort.v")] Definition leA_Tree (a:A) (t:Tree) := match t with | Tree_Leaf => True | Tree_Node b T1 T2 => leA a b end. #[deprecated(since="8.3", note="Use mergesort.v")] Lemma leA_Tree_Leaf : forall a:A, leA_Tree a Tree_Leaf. Proof. simpl; auto with datatypes. Qed. #[deprecated(since="8.3", note="Use mergesort.v")] Lemma leA_Tree_Node : forall (a b:A) (G D:Tree), leA a b -> leA_Tree a (Tree_Node b G D). Proof. simpl; auto with datatypes. Qed. (** ** The heap property *) Inductive is_heap : Tree -> Prop := | nil_is_heap : is_heap Tree_Leaf | node_is_heap : forall (a:A) (T1 T2:Tree), leA_Tree a T1 -> leA_Tree a T2 -> is_heap T1 -> is_heap T2 -> is_heap (Tree_Node a T1 T2). #[deprecated(since="8.3", note="Use mergesort.v")] Lemma invert_heap : forall (a:A) (T1 T2:Tree), is_heap (Tree_Node a T1 T2) -> leA_Tree a T1 /\ leA_Tree a T2 /\ is_heap T1 /\ is_heap T2. Proof. intros; inversion H; auto with datatypes. Qed. (* This lemma ought to be generated automatically by the Inversion tools *) #[deprecated(since="8.3", note="Use mergesort.v")] Lemma is_heap_rect : forall P:Tree -> Type, P Tree_Leaf -> (forall (a:A) (T1 T2:Tree), leA_Tree a T1 -> leA_Tree a T2 -> is_heap T1 -> P T1 -> is_heap T2 -> P T2 -> P (Tree_Node a T1 T2)) -> forall T:Tree, is_heap T -> P T. Proof. simple induction T; auto with datatypes. intros a G PG D PD PN. elim (invert_heap a G D); auto with datatypes. intros H1 H2; elim H2; intros H3 H4; elim H4; intros. apply X0; auto with datatypes. Qed. (* This lemma ought to be generated automatically by the Inversion tools *) #[deprecated(since="8.3", note="Use mergesort.v")] Lemma is_heap_rec : forall P:Tree -> Set, P Tree_Leaf -> (forall (a:A) (T1 T2:Tree), leA_Tree a T1 -> leA_Tree a T2 -> is_heap T1 -> P T1 -> is_heap T2 -> P T2 -> P (Tree_Node a T1 T2)) -> forall T:Tree, is_heap T -> P T. Proof. simple induction T; auto with datatypes. intros a G PG D PD PN. elim (invert_heap a G D); auto with datatypes. intros H1 H2; elim H2; intros H3 H4; elim H4; intros. apply X; auto with datatypes. Qed. #[deprecated(since="8.3", note="Use mergesort.v")] Lemma low_trans : forall (T:Tree) (a b:A), leA a b -> leA_Tree b T -> leA_Tree a T. Proof. simple induction T; auto with datatypes. intros; simpl; apply leA_trans with b; auto with datatypes. Qed. (** ** Merging two sorted lists *) Inductive merge_lem (l1 l2:list A) : Type := merge_exist : forall l:list A, Sorted leA l -> meq (list_contents _ eqA_dec l) (munion (list_contents _ eqA_dec l1) (list_contents _ eqA_dec l2)) -> (forall a, HdRel leA a l1 -> HdRel leA a l2 -> HdRel leA a l) -> merge_lem l1 l2. Import Morphisms. Instance: Equivalence (@meq A). Proof. constructor; auto with datatypes. red. apply meq_trans. Defined. Instance: Proper (@meq A ++> @meq _ ++> @meq _) (@munion A). Proof. intros x y H x' y' H'. now apply meq_congr. Qed. #[deprecated(since="8.3", note="Use mergesort.v")] Lemma merge : forall l1:list A, Sorted leA l1 -> forall l2:list A, Sorted leA l2 -> merge_lem l1 l2. Proof. fix merge 1; intros; destruct l1. - apply merge_exist with l2; auto with datatypes. - rename l1 into l. revert l2 H0. fix merge0 1. intros. destruct l2 as [|a0 l0]. + apply merge_exist with (a :: l); simpl; auto with datatypes. + induction (leA_dec a a0) as [Hle|Hle]. * (* 1 (leA a a0) *) apply Sorted_inv in H. destruct H. destruct (merge l H (a0 :: l0) H0) as [l1 H2 H3 H4]. apply merge_exist with (a :: l1). -- clear merge merge0. auto using cons_sort, cons_leA with datatypes. -- simpl. rewrite H3. now rewrite munion_ass. -- intros. apply cons_leA. apply (@HdRel_inv _ leA) with l; trivial with datatypes. * (* 2 (leA a0 a) *) apply Sorted_inv in H0. destruct H0. destruct (merge0 l0 H0) as [l1 H2 H3 H4]. clear merge merge0. apply merge_exist with (a0 :: l1); auto using cons_sort, cons_leA with datatypes. -- simpl; rewrite H3. simpl. setoid_rewrite munion_ass at 1. rewrite munion_comm. repeat rewrite munion_ass. setoid_rewrite munion_comm at 3. reflexivity. -- intros. apply cons_leA. apply (@HdRel_inv _ leA) with l0; trivial with datatypes. Qed. (** ** From trees to multisets *) (** contents of a tree as a multiset *) (** Nota Bene : In what follows the definition of SingletonBag in not used. Actually, we could just take as postulate: [Parameter SingletonBag : A->multiset]. *) #[deprecated(since="8.3", note="Use mergesort.v")] Fixpoint contents (t:Tree) : multiset A := match t with | Tree_Leaf => emptyBag | Tree_Node a t1 t2 => munion (contents t1) (munion (contents t2) (singletonBag a)) end. (** equivalence of two trees is equality of corresponding multisets *) #[deprecated(since="8.3", note="Use mergesort.v")] Definition equiv_Tree (t1 t2:Tree) := meq (contents t1) (contents t2). (** * From lists to sorted lists *) (** ** Specification of heap insertion *) Inductive insert_spec (a:A) (T:Tree) : Type := insert_exist : forall T1:Tree, is_heap T1 -> meq (contents T1) (munion (contents T) (singletonBag a)) -> (forall b:A, leA b a -> leA_Tree b T -> leA_Tree b T1) -> insert_spec a T. #[deprecated(since="8.3", note="Use mergesort.v")] Lemma insert : forall T:Tree, is_heap T -> forall a:A, insert_spec a T. Proof. simple induction 1; intros. - apply insert_exist with (Tree_Node a Tree_Leaf Tree_Leaf); auto using node_is_heap, nil_is_heap, leA_Tree_Leaf with datatypes. - simpl; unfold meq, munion; auto using node_is_heap with datatypes. elim (leA_dec a a0); intros. + elim (X a0); intros. apply insert_exist with (Tree_Node a T2 T0); auto using node_is_heap, nil_is_heap, leA_Tree_Leaf with datatypes. simpl; apply treesort_twist1; trivial with datatypes. + elim (X a); intros T3 HeapT3 ConT3 LeA. apply insert_exist with (Tree_Node a0 T2 T3); auto using node_is_heap, nil_is_heap, leA_Tree_Leaf with datatypes. * apply node_is_heap; auto using node_is_heap, nil_is_heap, leA_Tree_Leaf with datatypes. -- apply low_trans with a; auto with datatypes. -- apply LeA; auto with datatypes. apply low_trans with a; auto with datatypes. * simpl; apply treesort_twist2; trivial with datatypes. Qed. (** ** Building a heap from a list *) Inductive build_heap (l:list A) : Type := heap_exist : forall T:Tree, is_heap T -> meq (list_contents _ eqA_dec l) (contents T) -> build_heap l. #[deprecated(since="8.3", note="Use mergesort.v")] Lemma list_to_heap : forall l:list A, build_heap l. Proof. simple induction l. - apply (heap_exist nil Tree_Leaf); auto with datatypes. simpl; unfold meq; exact nil_is_heap. - simple induction 1. intros T i m; elim (insert T i a). intros; apply heap_exist with T1; simpl; auto with datatypes. apply meq_trans with (munion (contents T) (singletonBag a)). + apply meq_trans with (munion (singletonBag a) (contents T)). * apply meq_right; trivial with datatypes. * apply munion_comm. + apply meq_sym; trivial with datatypes. Qed. (** ** Building the sorted list *) Inductive flat_spec (T:Tree) : Type := flat_exist : forall l:list A, Sorted leA l -> (forall a:A, leA_Tree a T -> HdRel leA a l) -> meq (contents T) (list_contents _ eqA_dec l) -> flat_spec T. #[deprecated(since="8.3", note="Use mergesort.v")] Lemma heap_to_list : forall T:Tree, is_heap T -> flat_spec T. Proof. intros T h; elim h; intros. - apply flat_exist with (nil (A:=A)); auto with datatypes. - elim X; intros l1 s1 i1 m1; elim X0; intros l2 s2 i2 m2. elim (merge _ s1 _ s2); intros. apply flat_exist with (a :: l); simpl; auto with datatypes. apply meq_trans with (munion (list_contents _ eqA_dec l1) (munion (list_contents _ eqA_dec l2) (singletonBag a))). + apply meq_congr; auto with datatypes. + apply meq_trans with (munion (singletonBag a) (munion (list_contents _ eqA_dec l1) (list_contents _ eqA_dec l2))). * apply munion_rotate. * apply meq_right; apply meq_sym; trivial with datatypes. Qed. (** * Specification of treesort *) #[deprecated(since="8.3", note="Use mergesort.v")] Theorem treesort : forall l:list A, {m : list A | Sorted leA m & permutation _ eqA_dec l m}. Proof. intro l; unfold permutation. elim (list_to_heap l). intros. elim (heap_to_list T); auto with datatypes. intros. exists l0; auto with datatypes. apply meq_trans with (contents T); trivial with datatypes. Qed. End defs. coq-8.20.0/theories/Sorting/Mergesort.v000066400000000000000000000221311466560755400200110ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* -> Sortclass. (** The main module defining [mergesort] on a given boolean order [<=?]. We require minimal hypotheses : this boolean order should only be total: [forall x y, (x<=?y) \/ (y<=?x)]. Transitivity is not mandatory, but without it one can only prove [LocallySorted] and not [StronglySorted]. *) Module Sort (Import X:Orders.TotalLeBool'). Fixpoint merge l1 l2 := let fix merge_aux l2 := match l1, l2 with | [], _ => l2 | _, [] => l1 | a1::l1', a2::l2' => if a1 <=? a2 then a1 :: merge l1' l2 else a2 :: merge_aux l2' end in merge_aux l2. (** We implement mergesort using an explicit stack of pending mergings. Pending merging are represented like a binary number where digits are either None (denoting 0) or Some list to merge (denoting 1). The n-th digit represents the pending list to be merged at level n, if any. Merging a list to a stack is like adding 1 to the binary number represented by the stack but the carry is propagated by merging the lists. In practice, when used in mergesort, the n-th digit, if non 0, carries a list of length 2^n. For instance, adding singleton list [3] to the stack Some [4]::Some [2;6]::None::Some [1;3;5;5] reduces to propagate the carry [3;4] (resulting of the merge of [3] and [4]) to the list Some [2;6]::None::Some [1;3;5;5], which reduces to propagating the carry [2;3;4;6] (resulting of the merge of [3;4] and [2;6]) to the list None::Some [1;3;5;5], which locally produces Some [2;3;4;6]::Some [1;3;5;5], i.e. which produces the final result None::None::Some [2;3;4;6]::Some [1;3;5;5]. For instance, here is how [6;2;3;1;5] is sorted: << operation stack list iter_merge [] [6;2;3;1;5] = append_list_to_stack [ + [6]] [2;3;1;5] -> iter_merge [[6]] [2;3;1;5] = append_list_to_stack [[6] + [2]] [3;1;5] = append_list_to_stack [ + [2;6];] [3;1;5] -> iter_merge [[2;6];] [3;1;5] = append_list_to_stack [[2;6]; + [3]] [1;5] -> merge_list [[2;6];[3]] [1;5] = append_list_to_stack [[2;6];[3] + [1] [5] = append_list_to_stack [[2;6] + [1;3];] [5] = append_list_to_stack [ + [1;2;3;6];;] [5] -> merge_list [[1;2;3;6];;] [5] = append_list_to_stack [[1;2;3;6];; + [5]] [] -> merge_stack [[1;2;3;6];;[5]] = [1;2;3;5;6] >> The complexity of the algorithm is n*log n, since there are 2^(p-1) mergings to do of length 2, 2^(p-2) of length 4, ..., 2^0 of length 2^p for a list of length 2^p. The algorithm does not need explicitly cutting the list in 2 parts at each step since it the successive accumulation of fragments on the stack which ensures that lists are merged on a dichotomic basis. *) Fixpoint merge_list_to_stack stack l := match stack with | [] => [Some l] | None :: stack' => Some l :: stack' | Some l' :: stack' => None :: merge_list_to_stack stack' (merge l' l) end. Fixpoint merge_stack stack := match stack with | [] => [] | None :: stack' => merge_stack stack' | Some l :: stack' => merge l (merge_stack stack') end. Fixpoint iter_merge stack l := match l with | [] => merge_stack stack | a::l' => iter_merge (merge_list_to_stack stack [a]) l' end. Definition sort := iter_merge []. (** The proof of correctness *) Local Notation Sorted := (LocallySorted leb) (only parsing). Fixpoint SortedStack stack := match stack with | [] => True | None :: stack' => SortedStack stack' | Some l :: stack' => Sorted l /\ SortedStack stack' end. Local Ltac invert H := inversion H; subst; clear H. Fixpoint flatten_stack (stack : list (option (list t))) := match stack with | [] => [] | None :: stack' => flatten_stack stack' | Some l :: stack' => l ++ flatten_stack stack' end. Theorem Sorted_merge : forall l1 l2, Sorted l1 -> Sorted l2 -> Sorted (merge l1 l2). Proof. induction l1; induction l2; intros; simpl; auto. destruct (a <=? a0) eqn:Heq1. - invert H. + simpl. constructor; trivial; rewrite Heq1; constructor. + assert (Sorted (merge (b::l) (a0::l2))) by (apply IHl1; auto). clear H0 H3 IHl1; simpl in *. destruct (b <=? a0); constructor; auto || rewrite Heq1; constructor. - assert (a0 <=? a) by (destruct (leb_total a0 a) as [H'|H']; trivial || (rewrite Heq1 in H'; inversion H')). invert H0. + constructor; trivial. + assert (Sorted (merge (a::l1) (b::l))) by auto using IHl1. clear IHl2; simpl in *. destruct (a <=? b); constructor; auto. Qed. Theorem Permuted_merge : forall l1 l2, Permutation (l1++l2) (merge l1 l2). Proof. induction l1; simpl merge; intro. - assert (forall l, (fix merge_aux (l0 : list t) : list t := l0) l = l) as -> by (destruct l; trivial). (* Technical lemma *) apply Permutation_refl. - induction l2. + rewrite app_nil_r. apply Permutation_refl. + destruct (a <=? a0). * constructor; apply IHl1. * apply Permutation_sym, Permutation_cons_app, Permutation_sym, IHl2. Qed. Theorem Sorted_merge_list_to_stack : forall stack l, SortedStack stack -> Sorted l -> SortedStack (merge_list_to_stack stack l). Proof. induction stack as [|[|]]; intros; simpl. - auto. - apply IHstack. + destruct H as (_,H1). fold SortedStack in H1. auto. + apply Sorted_merge; auto; destruct H; auto. - auto. Qed. Theorem Permuted_merge_list_to_stack : forall stack l, Permutation (l ++ flatten_stack stack) (flatten_stack (merge_list_to_stack stack l)). Proof. induction stack as [|[]]; simpl; intros. - reflexivity. - rewrite app_assoc. etransitivity. + apply Permutation_app_tail. etransitivity. * apply Permutation_app_comm. * apply Permuted_merge. + apply IHstack. - reflexivity. Qed. Theorem Sorted_merge_stack : forall stack, SortedStack stack -> Sorted (merge_stack stack). Proof. induction stack as [|[|]]; simpl; intros. - constructor; auto. - apply Sorted_merge; tauto. - auto. Qed. Theorem Permuted_merge_stack : forall stack, Permutation (flatten_stack stack) (merge_stack stack). Proof. induction stack as [|[]]; simpl. - trivial. - transitivity (l ++ merge_stack stack). + apply Permutation_app_head; trivial. + apply Permuted_merge. - assumption. Qed. Theorem Sorted_iter_merge : forall stack l, SortedStack stack -> Sorted (iter_merge stack l). Proof. intros stack l H; induction l in stack, H |- *; simpl. - auto using Sorted_merge_stack. - assert (Sorted [a]) by constructor. auto using Sorted_merge_list_to_stack. Qed. Theorem Permuted_iter_merge : forall l stack, Permutation (flatten_stack stack ++ l) (iter_merge stack l). Proof. induction l; simpl; intros. - rewrite app_nil_r. apply Permuted_merge_stack. - change (a::l) with ([a]++l). rewrite app_assoc. etransitivity. + apply Permutation_app_tail. etransitivity. * apply Permutation_app_comm. * apply Permuted_merge_list_to_stack. + apply IHl. Qed. Theorem LocallySorted_sort : forall l, Sorted (sort l). Proof. intro; apply Sorted_iter_merge. constructor. Qed. Corollary Sorted_sort : forall l, Sorted.Sorted leb (sort l). Proof. intro; eapply Sorted_LocallySorted_iff, LocallySorted_sort; auto. Qed. Theorem Permuted_sort : forall l, Permutation l (sort l). Proof. intro; apply (Permuted_iter_merge l []). Qed. Corollary StronglySorted_sort : forall l, Transitive leb -> StronglySorted leb (sort l). Proof. auto using Sorted_StronglySorted, Sorted_sort. Qed. End Sort. (** An example *) Module NatOrder <: TotalLeBool. Definition t := nat. Fixpoint leb x y := match x, y with | 0, _ => true | _, 0 => false | S x', S y' => leb x' y' end. Infix "<=?" := leb (at level 70, no associativity). Theorem leb_total : forall a1 a2, a1 <=? a2 \/ a2 <=? a1. Proof. induction a1; destruct a2; simpl; auto. Qed. End NatOrder. Module Import NatSort := Sort NatOrder. Example SimpleMergeExample := Eval compute in sort [5;3;6;1;8;6;0]. coq-8.20.0/theories/Sorting/PermutEq.v000066400000000000000000000167121466560755400176140ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* 0 < multiplicity (list_contents l) a. Proof. intros; split; intro H. - eapply In_InA, multiplicity_InA in H; eauto with typeclass_instances. - eapply multiplicity_InA, InA_alt in H as (y & -> & H); eauto with typeclass_instances. Qed. Lemma multiplicity_In_O : forall l a, ~ In a l -> multiplicity (list_contents l) a = 0. Proof. intros l a; rewrite multiplicity_In; destruct (multiplicity (list_contents l) a); auto. destruct 1; auto with arith. Qed. Lemma multiplicity_In_S : forall l a, In a l -> multiplicity (list_contents l) a >= 1. Proof. intros l a; rewrite multiplicity_In; auto. Qed. Lemma multiplicity_NoDup : forall l, NoDup l <-> (forall a, multiplicity (list_contents l) a <= 1). Proof. induction l. - simpl. split; auto with arith. intros; apply NoDup_nil. - split; simpl. + inversion_clear 1. rewrite IHl in H1. intros; destruct (eq_dec a a0) as [H2|H2]; simpl; auto. subst a0. rewrite multiplicity_In_O; auto. + intros; constructor. * rewrite multiplicity_In. generalize (H a). destruct (eq_dec a a) as [H0|H0]. -- destruct (multiplicity (list_contents l) a); auto with arith. simpl; inversion 1. inversion H3. -- destruct H0; auto. * rewrite IHl; intros. generalize (H a0); auto with arith. destruct (eq_dec a a0); simpl; auto with arith. Qed. Lemma NoDup_permut : forall l l', NoDup l -> NoDup l' -> (forall x, In x l <-> In x l') -> permutation l l'. Proof. intros. red; unfold meq; intros. rewrite multiplicity_NoDup in H, H0. generalize (H a) (H0 a) (H1 a); clear H H0 H1. do 2 rewrite multiplicity_In. intros H H' [H0 H0']. destruct (multiplicity (list_contents l) a) as [|[|n]], (multiplicity (list_contents l') a) as [|[|n']]; [ tauto | | | | tauto | | | | ]; try solve [intuition auto with arith]; exfalso. - now inversion H'. - now inversion H. - now inversion H. Qed. (** Permutation is compatible with In. *) Lemma permut_In_In : forall l1 l2 e, permutation l1 l2 -> In e l1 -> In e l2. Proof. unfold PermutSetoid.permutation, meq; intros l1 l2 e P IN. generalize (P e); clear P. destruct (In_dec eq_dec e l2) as [H|H]; auto. rewrite (multiplicity_In_O _ _ H). intros. generalize (multiplicity_In_S _ _ IN). rewrite H0. inversion 1. Qed. Lemma permut_cons_In : forall l1 l2 e, permutation (e :: l1) l2 -> In e l2. Proof. intros; eapply permut_In_In; eauto. red; auto. Qed. (** Permutation of an empty list. *) Lemma permut_nil : forall l, permutation l nil -> l = nil. Proof. intro l; destruct l as [ | e l ]; trivial. assert (In e (e::l)) by (red; auto). intro Abs; generalize (permut_In_In _ Abs H). inversion 1. Qed. (** When used with [eq], this permutation notion is equivalent to the one defined in [List.v]. *) Lemma permutation_Permutation : forall l l', Permutation l l' <-> permutation l l'. Proof. split. - induction 1. + apply permut_refl. + apply permut_cons; auto. + change (permutation (y::x::l) ((x::nil)++y::l)). apply permut_add_cons_inside; simpl; apply permut_refl. + apply permut_trans with l'; auto. - revert l'. induction l. + intros. rewrite (permut_nil (permut_sym H)). apply Permutation_refl. + intros. destruct (In_split _ _ (permut_cons_In H)) as (h2,(t2,H1)). subst l'. apply Permutation_cons_app. apply IHl. apply permut_remove_hd with a; auto with typeclass_instances. Qed. (** Permutation for short lists. *) Lemma permut_length_1: forall a b, permutation (a :: nil) (b :: nil) -> a=b. Proof. intros a b; unfold PermutSetoid.permutation, meq; intro P; generalize (P b); clear P; simpl. destruct (eq_dec b b) as [H|H]; [ | destruct H; auto]. destruct (eq_dec a b); simpl; auto; intros; discriminate. Qed. Lemma permut_length_2 : forall a1 b1 a2 b2, permutation (a1 :: b1 :: nil) (a2 :: b2 :: nil) -> (a1=a2) /\ (b1=b2) \/ (a1=b2) /\ (a2=b1). Proof. intros a1 b1 a2 b2 P. assert (H:=permut_cons_In P). inversion_clear H. - left; split; auto. apply permut_length_1. red; red; intros. generalize (P a); clear P; simpl. destruct (eq_dec a1 a) as [H2|H2]; destruct (eq_dec a2 a) as [H3|H3]; auto. + destruct H3; transitivity a1; auto. + destruct H2; transitivity a2; auto. - right. inversion_clear H0; [|inversion H]. split; auto. apply permut_length_1. red; red; intros. generalize (P a); clear P; simpl. destruct (eq_dec a1 a) as [H2|H2]; destruct (eq_dec b2 a) as [H3|H3]; auto. + simpl; rewrite <- plus_n_Sm; inversion 1; auto. + destruct H3; transitivity a1; auto. + destruct H2; transitivity b2; auto. Qed. (** Permutation is compatible with length. *) Lemma permut_length : forall l1 l2, permutation l1 l2 -> length l1 = length l2. Proof. induction l1; intros l2 H. - rewrite (permut_nil (permut_sym H)); auto. - destruct (In_split _ _ (permut_cons_In H)) as (h2,(t2,H1)). subst l2. rewrite length_app. simpl; rewrite <- plus_n_Sm; f_equal. rewrite <- length_app. apply IHl1. apply permut_remove_hd with a; auto with typeclass_instances. Qed. Variable B : Type. Variable eqB_dec : forall x y:B, { x=y }+{ ~x=y }. (** Permutation is compatible with map. *) Lemma permutation_map : forall f l1 l2, permutation l1 l2 -> PermutSetoid.permutation _ eqB_dec (map f l1) (map f l2). Proof. intros f; induction l1. - intros l2 P; rewrite (permut_nil (permut_sym P)); apply permut_refl. - intros l2 P. simpl. destruct (In_split _ _ (permut_cons_In P)) as (h2,(t2,H1)). subst l2. rewrite map_app. simpl. apply permut_add_cons_inside. rewrite <- map_app. apply IHl1; auto. apply permut_remove_hd with a; auto with typeclass_instances. Qed. End Perm. coq-8.20.0/theories/Sorting/PermutSetoid.v000066400000000000000000000377571466560755400205120ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* emptyBag | a :: l => munion (singletonBag a) (list_contents l) end. Lemma list_contents_app : forall l m:list A, meq (list_contents (l ++ m)) (munion (list_contents l) (list_contents m)). Proof. simple induction l; simpl; auto with datatypes. intros. apply meq_trans with (munion (singletonBag a) (munion (list_contents l0) (list_contents m))); auto with datatypes. Qed. (** * [permutation]: definition and basic properties *) Definition permutation (l m:list A) := meq (list_contents l) (list_contents m). Lemma permut_refl : forall l:list A, permutation l l. Proof. unfold permutation; auto with datatypes. Qed. Lemma permut_sym : forall l1 l2 : list A, permutation l1 l2 -> permutation l2 l1. Proof. unfold permutation, meq; intros; symmetry; trivial. Qed. Lemma permut_trans : forall l m n:list A, permutation l m -> permutation m n -> permutation l n. Proof. unfold permutation; intros. apply meq_trans with (list_contents m); auto with datatypes. Qed. Lemma permut_cons_eq : forall l m:list A, permutation l m -> forall a a', eqA a a' -> permutation (a :: l) (a' :: m). Proof. unfold permutation; simpl; intros. apply meq_trans with (munion (singletonBag a') (list_contents l)). - apply meq_left, meq_singleton; auto. - auto with datatypes. Qed. Lemma permut_cons : forall l m:list A, permutation l m -> forall a:A, permutation (a :: l) (a :: m). Proof. unfold permutation; simpl; auto with datatypes. Qed. Lemma permut_app : forall l l' m m':list A, permutation l l' -> permutation m m' -> permutation (l ++ m) (l' ++ m'). Proof. unfold permutation; intros. apply meq_trans with (munion (list_contents l) (list_contents m)); auto using permut_cons, list_contents_app with datatypes. apply meq_trans with (munion (list_contents l') (list_contents m')); auto using permut_cons, list_contents_app with datatypes. apply meq_trans with (munion (list_contents l') (list_contents m)); auto using permut_cons, list_contents_app with datatypes. Qed. Lemma permut_add_inside_eq : forall a a' l1 l2 l3 l4, eqA a a' -> permutation (l1 ++ l2) (l3 ++ l4) -> permutation (l1 ++ a :: l2) (l3 ++ a' :: l4). Proof. unfold permutation, meq in *; intros. specialize H0 with a0. repeat rewrite list_contents_app in *; simpl in *. destruct (eqA_dec a a0) as [Ha|Ha]; rewrite H in Ha; decide (eqA_dec a' a0) with Ha; simpl; auto with arith. do 2 rewrite <- plus_n_Sm; f_equal; auto. Qed. Lemma permut_add_inside : forall a l1 l2 l3 l4, permutation (l1 ++ l2) (l3 ++ l4) -> permutation (l1 ++ a :: l2) (l3 ++ a :: l4). Proof. unfold permutation, meq in *; intros. generalize (H a0); clear H. do 4 rewrite list_contents_app. simpl. destruct (eqA_dec a a0); simpl; auto with arith. do 2 rewrite <- plus_n_Sm; f_equal; auto. Qed. Lemma permut_add_cons_inside_eq : forall a a' l l1 l2, eqA a a' -> permutation l (l1 ++ l2) -> permutation (a :: l) (l1 ++ a' :: l2). Proof. intros; replace (a :: l) with ([] ++ a :: l); trivial; apply permut_add_inside_eq; trivial. Qed. Lemma permut_add_cons_inside : forall a l l1 l2, permutation l (l1 ++ l2) -> permutation (a :: l) (l1 ++ a :: l2). Proof. intros; replace (a :: l) with ([] ++ a :: l); trivial; apply permut_add_inside; trivial. Qed. Lemma permut_middle : forall (l m:list A) (a:A), permutation (a :: l ++ m) (l ++ a :: m). Proof. intros; apply permut_add_cons_inside; auto using permut_sym, permut_refl. Qed. Lemma permut_sym_app : forall l1 l2, permutation (l1 ++ l2) (l2 ++ l1). Proof. intros l1 l2; unfold permutation, meq; intro a; do 2 rewrite list_contents_app; simpl; auto with arith. Qed. Lemma permut_rev : forall l, permutation l (rev l). Proof. induction l. - simpl; trivial using permut_refl. - simpl. apply permut_add_cons_inside. rewrite app_nil_r. trivial. Qed. (** * Some inversion results. *) Lemma permut_conv_inv : forall e l1 l2, permutation (e :: l1) (e :: l2) -> permutation l1 l2. Proof. intros e l1 l2; unfold permutation, meq; simpl; intros H a; generalize (H a); lia. Qed. Lemma permut_app_inv1 : forall l l1 l2, permutation (l1 ++ l) (l2 ++ l) -> permutation l1 l2. Proof. intros l l1 l2; unfold permutation, meq; simpl; intros H a; generalize (H a); clear H. do 2 rewrite list_contents_app. simpl. lia. Qed. (** we can use [multiplicity] to define [InA] and [NoDupA]. *) Fact if_eqA_then : forall a a' (B:Type)(b b':B), eqA a a' -> (if eqA_dec a a' then b else b') = b. Proof. intros. destruct eqA_dec as [_|NEQ]; auto. contradict NEQ; auto. Qed. Lemma permut_app_inv2 : forall l l1 l2, permutation (l ++ l1) (l ++ l2) -> permutation l1 l2. Proof. intros l l1 l2; unfold permutation, meq; simpl; intros H a; generalize (H a); clear H. do 2 rewrite list_contents_app. simpl. lia. Qed. Lemma permut_remove_hd_eq : forall l l1 l2 a b, eqA a b -> permutation (a :: l) (l1 ++ b :: l2) -> permutation l (l1 ++ l2). Proof. unfold permutation, meq; simpl; intros l l1 l2 a b Heq H a0. specialize H with a0. rewrite list_contents_app in *. simpl in *. destruct (eqA_dec a _) as [Ha|Ha]; rewrite Heq in Ha; revert H; decide (eqA_dec b a0) with Ha; lia. Qed. Lemma permut_remove_hd : forall l l1 l2 a, permutation (a :: l) (l1 ++ a :: l2) -> permutation l (l1 ++ l2). Proof. pose proof (Equivalence_Reflexive (R := eqA)); eauto using permut_remove_hd_eq. Qed. Fact if_eqA_else : forall a a' (B:Type)(b b':B), ~eqA a a' -> (if eqA_dec a a' then b else b') = b'. Proof. intros. decide (eqA_dec a a') with H; auto. Qed. Fact if_eqA_refl : forall a (B:Type)(b b':B), (if eqA_dec a a then b else b') = b. Proof. intros; apply (decide_left (eqA_dec a a)); auto with *. Qed. (** PL: Inutilisable dans un rewrite sans un change prealable. *) Global Instance if_eqA (B:Type)(b b':B) : Proper (eqA==>eqA==>@eq _) (fun x y => if eqA_dec x y then b else b'). Proof. intros x x' Hxx' y y' Hyy'. intros; destruct (eqA_dec x y) as [H|H]; destruct (eqA_dec x' y') as [H'|H']; auto. - contradict H'; transitivity x; auto with *; transitivity y; auto with *. - contradict H; transitivity x'; auto with *; transitivity y'; auto with *. Qed. Fact if_eqA_rewrite_l : forall a1 a1' a2 (B:Type)(b b':B), eqA a1 a1' -> (if eqA_dec a1 a2 then b else b') = (if eqA_dec a1' a2 then b else b'). Proof. intros; destruct (eqA_dec a1 a2) as [A1|A1]; destruct (eqA_dec a1' a2) as [A1'|A1']; auto. - contradict A1'; transitivity a1; eauto with *. - contradict A1; transitivity a1'; eauto with *. Qed. Fact if_eqA_rewrite_r : forall a1 a2 a2' (B:Type)(b b':B), eqA a2 a2' -> (if eqA_dec a1 a2 then b else b') = (if eqA_dec a1 a2' then b else b'). Proof. intros; destruct (eqA_dec a1 a2) as [A2|A2]; destruct (eqA_dec a1 a2') as [A2'|A2']; auto. - contradict A2'; transitivity a2; eauto with *. - contradict A2; transitivity a2'; eauto with *. Qed. Global Instance multiplicity_eqA (l:list A) : Proper (eqA==>@eq _) (multiplicity (list_contents l)). Proof. intros x x' Hxx'. induction l as [|y l Hl]; simpl; auto. rewrite (@if_eqA_rewrite_r y x x'); auto. Qed. Lemma multiplicity_InA : forall l a, InA eqA a l <-> 0 < multiplicity (list_contents l) a. Proof. induction l. - simpl. split; inversion 1. - simpl. intros a'; split; intros H. + inversion_clear H. * apply (decide_left (eqA_dec a a')); auto with *. * destruct (eqA_dec a a'); auto with *. simpl; rewrite <- IHl; auto. + destruct (eqA_dec a a'); auto with *. right. rewrite IHl; auto. Qed. Lemma multiplicity_InA_O : forall l a, ~ InA eqA a l -> multiplicity (list_contents l) a = 0. Proof. intros l a; rewrite multiplicity_InA; destruct (multiplicity (list_contents l) a); auto with arith. destruct 1; auto with arith. Qed. Lemma multiplicity_InA_S : forall l a, InA eqA a l -> multiplicity (list_contents l) a >= 1. Proof. intros l a; rewrite multiplicity_InA; auto with arith. Qed. Lemma multiplicity_NoDupA : forall l, NoDupA eqA l <-> (forall a, multiplicity (list_contents l) a <= 1). Proof. induction l. - simpl. split; auto with arith. - split; simpl. + inversion_clear 1. rewrite IHl in H1. intros; destruct (eqA_dec a a0) as [EQ|NEQ]; simpl; auto with *. rewrite <- EQ. rewrite multiplicity_InA_O; auto. + intros; constructor. * rewrite multiplicity_InA. specialize (H a). rewrite if_eqA_refl in H. clear IHl; lia. * rewrite IHl; intros. specialize (H a0). lia. Qed. (** Permutation is compatible with InA. *) Lemma permut_InA_InA : forall l1 l2 e, permutation l1 l2 -> InA eqA e l1 -> InA eqA e l2. Proof. intros l1 l2 e. do 2 rewrite multiplicity_InA. unfold permutation, meq. intros H;rewrite H; auto. Qed. Lemma permut_cons_InA : forall l1 l2 e, permutation (e :: l1) l2 -> InA eqA e l2. Proof. intros; apply (permut_InA_InA (e:=e) H); auto with *. Qed. (** Permutation of an empty list. *) Lemma permut_nil : forall l, permutation l [] -> l = []. Proof. intro l; destruct l as [ | e l ]; trivial. assert (InA eqA e (e::l)) by (auto with *). intro Abs; generalize (permut_InA_InA Abs H). inversion 1. Qed. (** Permutation for short lists. *) Lemma permut_length_1: forall a b, permutation [a] [b] -> eqA a b. Proof. intros a b; unfold permutation, meq. intro P; specialize (P b); simpl in *. rewrite if_eqA_refl in *. destruct (eqA_dec a b); simpl; auto; discriminate. Qed. Lemma permut_length_2 : forall a1 b1 a2 b2, permutation [a1; b1] [a2; b2] -> (eqA a1 a2) /\ (eqA b1 b2) \/ (eqA a1 b2) /\ (eqA a2 b1). Proof. intros a1 b1 a2 b2 P. assert (H:=permut_cons_InA P). inversion_clear H. - left; split; auto. apply permut_length_1. red; red; intros. specialize (P a). simpl in *. rewrite (@if_eqA_rewrite_l a1 a2 a) in P by auto. lia. - right. inversion_clear H0; [|inversion H]. split; auto. apply permut_length_1. red; red; intros. specialize (P a); simpl in *. rewrite (@if_eqA_rewrite_l a1 b2 a) in P by auto. lia. Qed. (** Permutation is compatible with length. *) Lemma permut_length : forall l1 l2, permutation l1 l2 -> length l1 = length l2. Proof. induction l1; intros l2 H. - rewrite (permut_nil (permut_sym H)); auto. - assert (H0:=permut_cons_InA H). destruct (InA_split H0) as (h2,(b,(t2,(H1,H2)))). subst l2. rewrite length_app. simpl; rewrite <- plus_n_Sm; f_equal. rewrite <- length_app. apply IHl1. apply permut_remove_hd with b. apply permut_trans with (a::l1); auto. revert H1; unfold permutation, meq; simpl. intros; f_equal; auto. rewrite (@if_eqA_rewrite_l a b a0); auto. Qed. Lemma NoDupA_equivlistA_permut : forall l l', NoDupA eqA l -> NoDupA eqA l' -> equivlistA eqA l l' -> permutation l l'. Proof. intros. red; unfold meq; intros. rewrite multiplicity_NoDupA in H, H0. generalize (H a) (H0 a) (H1 a); clear H H0 H1. do 2 rewrite multiplicity_InA. destruct 3; lia. Qed. End Permut. Section Permut_map. Variables A B : Type. Variable eqA : relation A. Hypothesis eqA_dec : forall x y:A, {eqA x y} + {~ eqA x y}. Hypothesis eqA_equiv : Equivalence eqA. Variable eqB : B->B->Prop. Hypothesis eqB_dec : forall x y:B, { eqB x y }+{ ~eqB x y }. Hypothesis eqB_trans : Transitive eqB. (** Permutation is compatible with map. *) Lemma permut_map : forall f, (Proper (eqA==>eqB) f) -> forall l1 l2, permutation _ eqA_dec l1 l2 -> permutation _ eqB_dec (map f l1) (map f l2). Proof. intros f; induction l1. - intros l2 P; rewrite (permut_nil eqA_equiv (permut_sym P)); apply permut_refl. - intros l2 P. simpl. assert (H0:=permut_cons_InA eqA_equiv P). destruct (InA_split H0) as (h2,(b,(t2,(H1,H2)))). subst l2. rewrite map_app. simpl. apply permut_trans with (f b :: map f l1). + revert H1; unfold permutation, meq; simpl. intros; f_equal; auto. destruct (eqB_dec (f b) a0) as [H2|H2]; destruct (eqB_dec (f a) a0) as [H3|H3]; auto. * destruct H3; transitivity (f b); auto with *. * destruct H2; transitivity (f a); auto with *. + apply permut_add_cons_inside. rewrite <- map_app. apply IHl1; auto. apply permut_remove_hd with b; trivial. apply permut_trans with (a::l1); auto. revert H1; unfold permutation, meq; simpl. intros; f_equal; auto. rewrite (@if_eqA_rewrite_l _ _ eqA_equiv eqA_dec a b a0); auto. Qed. End Permut_map. Require Import Permutation. Section Permut_permut. Variable A : Type. Variable eqA : relation A. Hypothesis eqA_dec : forall x y:A, {eqA x y} + {~ eqA x y}. Hypothesis eqA_equiv : Equivalence eqA. Lemma Permutation_impl_permutation : forall l l', Permutation l l' -> permutation _ eqA_dec l l'. Proof. induction 1. - apply permut_refl. - apply permut_cons; auto using Equivalence_Reflexive. - change (x :: y :: l) with ([x] ++ y :: l); apply permut_add_cons_inside; simpl; apply permut_cons_eq; pose proof (Equivalence_Reflexive (R := eqA)); auto using permut_refl. - apply permut_trans with l'; trivial. Qed. Lemma permut_eqA : forall l l', Forall2 eqA l l' -> permutation _ eqA_dec l l'. Proof. induction 1. - apply permut_refl. - apply permut_cons_eq; trivial. Qed. Lemma permutation_Permutation : forall l l', permutation _ eqA_dec l l' <-> exists l'', Permutation l l'' /\ Forall2 eqA l'' l'. Proof. split; intro H. - (* -> *) induction l in l', H |- *. + exists []; apply permut_sym, permut_nil in H as ->; auto using Forall2. + pose proof H as H'. apply permut_cons_InA, InA_split in H as (l1 & y & l2 & Heq & ->); trivial. apply permut_remove_hd_eq, IHl in H' as (l'' & IHP & IHA); clear IHl; trivial. apply Forall2_app_inv_r in IHA as (l1'' & l2'' & Hl1 & Hl2 & ->). exists (l1'' ++ a :: l2''); split. * apply Permutation_cons_app; trivial. * apply Forall2_app, Forall2_cons; trivial. - (* <- *) destruct H as (l'' & H & Heq). apply permut_trans with l''. + apply Permutation_impl_permutation; trivial. + apply permut_eqA; trivial. Qed. End Permut_permut. (* begin hide *) (** For compatibility *) Notation permut_right := permut_cons (only parsing). Notation permut_tran := permut_trans (only parsing). (* end hide *) coq-8.20.0/theories/Sorting/Permutation.v000066400000000000000000000752641466560755400203700ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* list A -> Prop := | perm_nil: Permutation [] [] | perm_skip x l l' : Permutation l l' -> Permutation (x::l) (x::l') | perm_swap x y l : Permutation (y::x::l) (x::y::l) | perm_trans l l' l'' : Permutation l l' -> Permutation l' l'' -> Permutation l l''. Local Hint Constructors Permutation : core. (** Some facts about [Permutation] *) Theorem Permutation_nil : forall (l : list A), Permutation [] l -> l = []. Proof. intros l HF. remember (@nil A) as m in HF. induction HF; discriminate || auto. Qed. Theorem Permutation_nil_cons : forall (l : list A) (x : A), ~ Permutation nil (x::l). Proof. intros l x HF. apply Permutation_nil in HF; discriminate. Qed. (** Permutation over lists is a equivalence relation *) Theorem Permutation_refl : forall l : list A, Permutation l l. Proof. induction l; constructor. exact IHl. Qed. Instance Permutation_refl' : Proper (Logic.eq ==> Permutation) id. Proof. intros x y Heq; rewrite Heq; apply Permutation_refl. Qed. Theorem Permutation_sym : forall l l' : list A, Permutation l l' -> Permutation l' l. Proof. intros l l' Hperm; induction Hperm; auto. apply perm_trans with (l':=l'); assumption. Qed. Theorem Permutation_trans : forall l l' l'' : list A, Permutation l l' -> Permutation l' l'' -> Permutation l l''. Proof. exact perm_trans. Qed. End Permutation. #[global] Hint Resolve Permutation_refl perm_nil perm_skip : core. (* These hints do not reduce the size of the problem to solve and they must be used with care to avoid combinatoric explosions *) Local Hint Resolve perm_swap perm_trans : core. Local Hint Resolve Permutation_sym Permutation_trans : core. (* This provides reflexivity, symmetry and transitivity and rewriting on morphims to come *) #[global] Instance Permutation_Equivalence A : Equivalence (@Permutation A) := { Equivalence_Reflexive := @Permutation_refl A ; Equivalence_Symmetric := @Permutation_sym A ; Equivalence_Transitive := @Permutation_trans A }. Lemma Permutation_morph_transp A : forall P : list A -> Prop, (forall a b l1 l2, P (l1 ++ a :: b :: l2) -> P (l1 ++ b :: a :: l2)) -> Proper (@Permutation A ==> Basics.impl) P. Proof. intros P HT l1 l2 HP. enough (forall l0, P (l0 ++ l1) -> P (l0 ++ l2)) as IH by (intro; rewrite <- (app_nil_l l2); now apply (IH nil)). induction HP; intuition. rewrite <- (app_nil_l l'), app_comm_cons, app_assoc. now apply IHHP; rewrite <- app_assoc. Qed. #[export] Instance Permutation_cons A : Proper (Logic.eq ==> @Permutation A ==> @Permutation A) (@cons A). Proof. repeat intro; subst; auto using perm_skip. Qed. Section Permutation_properties. Variable A B:Type. Implicit Types a : A. Implicit Types l m : list A. (** Compatibility with others operations on lists *) Theorem Permutation_in : forall (l l' : list A) (x : A), Permutation l l' -> In x l -> In x l'. Proof. intros l l' x Hperm; induction Hperm; simpl; tauto. Qed. Global Instance Permutation_in' : Proper (Logic.eq ==> @Permutation A ==> iff) (@In A). Proof. repeat red; intros; subst; eauto using Permutation_in. Qed. Lemma Permutation_app_tail : forall (l l' tl : list A), Permutation l l' -> Permutation (l++tl) (l'++tl). Proof. intros l l' tl Hperm; induction Hperm as [|x l l'|x y l|l l' l'']; simpl; auto. eapply Permutation_trans with (l':=l'++tl); trivial. Qed. Lemma Permutation_app_head : forall (l tl tl' : list A), Permutation tl tl' -> Permutation (l++tl) (l++tl'). Proof. intros l tl tl' Hperm; induction l; [trivial | repeat rewrite <- app_comm_cons; constructor; assumption]. Qed. Theorem Permutation_app : forall (l m l' m' : list A), Permutation l l' -> Permutation m m' -> Permutation (l++m) (l'++m'). Proof. intros l m l' m' Hpermll' Hpermmm'; induction Hpermll' as [|x l l'|x y l|l l' l'']; repeat rewrite <- app_comm_cons; auto. - apply Permutation_trans with (l' := (x :: y :: l ++ m)); [idtac | repeat rewrite app_comm_cons; apply Permutation_app_head]; trivial. - apply Permutation_trans with (l' := (l' ++ m')); try assumption. apply Permutation_app_tail; assumption. Qed. #[export] Instance Permutation_app' : Proper (@Permutation A ==> @Permutation A ==> @Permutation A) (@app A). Proof. repeat intro; now apply Permutation_app. Qed. Lemma Permutation_add_inside : forall a (l l' tl tl' : list A), Permutation l l' -> Permutation tl tl' -> Permutation (l ++ a :: tl) (l' ++ a :: tl'). Proof. intros; apply Permutation_app; auto. Qed. Lemma Permutation_cons_append : forall (l : list A) x, Permutation (x :: l) (l ++ x :: nil). Proof. induction l; intros; auto. simpl. rewrite <- IHl; auto. Qed. Local Hint Resolve Permutation_cons_append : core. Theorem Permutation_app_comm : forall (l l' : list A), Permutation (l ++ l') (l' ++ l). Proof. induction l as [|x l]; simpl; intro l'. - rewrite app_nil_r; trivial. - rewrite IHl. rewrite app_comm_cons, Permutation_cons_append. now rewrite <- app_assoc. Qed. Local Hint Resolve Permutation_app_comm : core. Lemma Permutation_app_rot : forall l1 l2 l3: list A, Permutation (l1 ++ l2 ++ l3) (l2 ++ l3 ++ l1). Proof. intros l1 l2 l3; now rewrite (app_assoc l2). Qed. Local Hint Resolve Permutation_app_rot : core. Lemma Permutation_app_swap_app : forall l1 l2 l3: list A, Permutation (l1 ++ l2 ++ l3) (l2 ++ l1 ++ l3). Proof. intros. rewrite 2 app_assoc. apply Permutation_app_tail, Permutation_app_comm. Qed. Local Hint Resolve Permutation_app_swap_app : core. Lemma Permutation_app_middle : forall l l1 l2 l3 l4, Permutation (l1 ++ l2) (l3 ++ l4) -> Permutation (l1 ++ l ++ l2) (l3 ++ l ++ l4). Proof. intros l l1 l2 l3 l4 HP. now rewrite Permutation_app_swap_app, HP, Permutation_app_swap_app. Qed. Theorem Permutation_cons_app : forall (l l1 l2:list A) a, Permutation l (l1 ++ l2) -> Permutation (a :: l) (l1 ++ a :: l2). Proof. intros l l1 l2 a H. rewrite H. rewrite app_comm_cons, Permutation_cons_append. now rewrite <- app_assoc. Qed. Local Hint Resolve Permutation_cons_app : core. Lemma Permutation_Add a l l' : Add a l l' -> Permutation (a::l) l'. Proof. induction 1; simpl; trivial. rewrite perm_swap. now apply perm_skip. Qed. Theorem Permutation_middle : forall (l1 l2:list A) a, Permutation (a :: l1 ++ l2) (l1 ++ a :: l2). Proof. auto. Qed. Local Hint Resolve Permutation_middle : core. Lemma Permutation_middle2 : forall l1 l2 l3 a b, Permutation (a :: b :: l1 ++ l2 ++ l3) (l1 ++ a :: l2 ++ b :: l3). Proof. intros l1 l2 l3 a b. apply Permutation_cons_app. rewrite 2 app_assoc. now apply Permutation_cons_app. Qed. Local Hint Resolve Permutation_middle2 : core. Lemma Permutation_elt : forall l1 l2 l1' l2' (a:A), Permutation (l1 ++ l2) (l1' ++ l2') -> Permutation (l1 ++ a :: l2) (l1' ++ a :: l2'). Proof. intros l1 l2 l1' l2' a HP. transitivity (a :: l1 ++ l2); auto. Qed. Theorem Permutation_rev : forall (l : list A), Permutation l (rev l). Proof. induction l as [| x l]; simpl; trivial. now rewrite IHl at 1. Qed. Global Instance Permutation_rev' : Proper (@Permutation A ==> @Permutation A) (@rev A). Proof. repeat intro; now rewrite <- 2 Permutation_rev. Qed. Theorem Permutation_length : forall (l l' : list A), Permutation l l' -> length l = length l'. Proof. intros l l' Hperm; induction Hperm; simpl; auto. now transitivity (length l'). Qed. Global Instance Permutation_length' : Proper (@Permutation A ==> Logic.eq) (@length A) | 10. Proof. exact Permutation_length. Qed. Global Instance Permutation_Forall (P : A -> Prop) : Proper ((@Permutation A) ==> Basics.impl) (Forall P). Proof. intros l1 l2 HP. induction HP; intro HF; auto. - inversion_clear HF; auto. - inversion_clear HF as [ | ? ? HF1 HF2]. inversion_clear HF2; auto. Qed. Global Instance Permutation_Exists (P : A -> Prop) : Proper ((@Permutation A) ==> Basics.impl) (Exists P). Proof. intros l1 l2 HP. induction HP; intro HF; auto. - inversion_clear HF; auto. - inversion_clear HF as [ | ? ? HF1 ]; auto. inversion_clear HF1; auto. Qed. Lemma Permutation_Forall2 (P : A -> B -> Prop) : forall l1 l1' (l2 : list B), Permutation l1 l1' -> Forall2 P l1 l2 -> exists l2' : list B, Permutation l2 l2' /\ Forall2 P l1' l2'. Proof. intros l1 l1' l2 HP. revert l2; induction HP; intros l2 HF; inversion HF as [ | ? b ? ? HF1 HF2 ]; subst. - now exists nil. - apply IHHP in HF2 as [l2' [HP2 HF2]]. exists (b :: l2'); auto. - inversion_clear HF2 as [ | ? b' ? l2' HF3 HF4 ]. exists (b' :: b :: l2'); auto. - apply Permutation_nil in HP1; subst. apply Permutation_nil in HP2; subst. now exists nil. - apply IHHP1 in HF as [l2' [HP2' HF2']]. apply IHHP2 in HF2' as [l2'' [HP2'' HF2'']]. exists l2''; split; auto. now transitivity l2'. Qed. Theorem Permutation_ind_bis : forall P : list A -> list A -> Prop, P [] [] -> (forall x l l', Permutation l l' -> P l l' -> P (x :: l) (x :: l')) -> (forall x y l l', Permutation l l' -> P l l' -> P (y :: x :: l) (x :: y :: l')) -> (forall l l' l'', Permutation l l' -> P l l' -> Permutation l' l'' -> P l' l'' -> P l l'') -> forall l l', Permutation l l' -> P l l'. Proof. intros P Hnil Hskip Hswap Htrans. induction 1; auto. - apply Htrans with (x::y::l); auto. + apply Hswap; auto. induction l; auto. + apply Hskip; auto. apply Hskip; auto. induction l; auto. - eauto. Qed. Theorem Permutation_nil_app_cons : forall (l l' : list A) (x : A), ~ Permutation nil (l++x::l'). Proof. intros l l' x HF. apply Permutation_nil in HF. destruct l; discriminate. Qed. Ltac InvAdd := repeat (match goal with | H: Add ?x _ (_ :: _) |- _ => inversion H; clear H; subst end). Ltac finish_basic_perms H := try constructor; try rewrite perm_swap; try constructor; trivial; (rewrite <- H; now apply Permutation_Add) || (rewrite H; symmetry; now apply Permutation_Add). Theorem Permutation_Add_inv a l1 l2 : Permutation l1 l2 -> forall l1' l2', Add a l1' l1 -> Add a l2' l2 -> Permutation l1' l2'. Proof. revert l1 l2. refine (Permutation_ind_bis _ _ _ _ _). - (* nil *) inversion_clear 1. - (* skip *) intros x l1 l2 PE IH. intros. InvAdd; try finish_basic_perms PE. constructor. now apply IH. - (* swap *) intros x y l1 l2 PE IH. intros. InvAdd; try finish_basic_perms PE. rewrite perm_swap; do 2 constructor. now apply IH. - (* trans *) intros l1 l l2 PE IH PE' IH' l1' l2' AD1 AD2. assert (Ha : In a l). { rewrite <- PE. rewrite (Add_in AD1). simpl; auto. } destruct (Add_inv _ _ Ha) as (l',AD). transitivity l'; auto. Qed. Theorem Permutation_app_inv (l1 l2 l3 l4:list A) a : Permutation (l1++a::l2) (l3++a::l4) -> Permutation (l1++l2) (l3 ++ l4). Proof. intros. eapply Permutation_Add_inv; eauto using Add_app. Qed. Theorem Permutation_cons_inv l l' a : Permutation (a::l) (a::l') -> Permutation l l'. Proof. intro. eapply Permutation_Add_inv; eauto using Add_head. Qed. Theorem Permutation_cons_app_inv l l1 l2 a : Permutation (a :: l) (l1 ++ a :: l2) -> Permutation l (l1 ++ l2). Proof. intro. eapply Permutation_Add_inv; eauto using Add_head, Add_app. Qed. Theorem Permutation_app_inv_l : forall l l1 l2, Permutation (l ++ l1) (l ++ l2) -> Permutation l1 l2. Proof. induction l; simpl; auto. intros. apply IHl. apply Permutation_cons_inv with a; auto. Qed. Theorem Permutation_app_inv_r l l1 l2 : Permutation (l1 ++ l) (l2 ++ l) -> Permutation l1 l2. Proof. rewrite 2 (Permutation_app_comm _ l). apply Permutation_app_inv_l. Qed. Lemma Permutation_app_inv_m l l1 l2 l3 l4 : Permutation (l1 ++ l ++ l2) (l3 ++ l ++ l4) -> Permutation (l1 ++ l2) (l3 ++ l4). Proof. intros HP. apply (Permutation_app_inv_l l). transitivity (l1 ++ l ++ l2); auto. transitivity (l3 ++ l ++ l4); auto. Qed. Lemma Permutation_length_1_inv: forall a l, Permutation [a] l -> l = [a]. Proof. intros a l H; remember [a] as m in H. induction H; try (injection Heqm as [= -> ->]); discriminate || auto. apply Permutation_nil in H as ->; trivial. Qed. Lemma Permutation_length_1: forall a b, Permutation [a] [b] -> a = b. Proof. intros a b H. apply Permutation_length_1_inv in H; injection H as [= ->]; trivial. Qed. Lemma Permutation_length_2_inv : forall a1 a2 l, Permutation [a1;a2] l -> l = [a1;a2] \/ l = [a2;a1]. Proof. intros a1 a2 l H; remember [a1;a2] as m in H. revert a1 a2 Heqm. induction H; intros; try (injection Heqm as [= ? ?]; subst); discriminate || (try tauto). - apply Permutation_length_1_inv in H as ->; left; auto. - apply IHPermutation1 in Heqm as [H1|H1]; apply IHPermutation2 in H1 as []; auto. Qed. Lemma Permutation_length_2 : forall a1 a2 b1 b2, Permutation [a1;a2] [b1;b2] -> a1 = b1 /\ a2 = b2 \/ a1 = b2 /\ a2 = b1. Proof. intros a1 b1 a2 b2 H. apply Permutation_length_2_inv in H as [H|H]; injection H as [= -> ->]; auto. Qed. Lemma Permutation_vs_elt_inv : forall l l1 l2 a, Permutation l (l1 ++ a :: l2) -> exists l' l'', l = l' ++ a :: l''. Proof. intros l l1 l2 a HP. symmetry in HP. apply (Permutation_in a), in_split in HP; trivial. apply in_elt. Qed. Lemma Permutation_vs_cons_inv : forall l l1 a, Permutation l (a :: l1) -> exists l' l'', l = l' ++ a :: l''. Proof. intros l l1 a HP. rewrite <- (app_nil_l (a :: l1)) in HP. apply (Permutation_vs_elt_inv _ _ _ HP). Qed. Lemma Permutation_vs_cons_cons_inv : forall l l' a b, Permutation l (a :: b :: l') -> exists l1 l2 l3, l = l1 ++ a :: l2 ++ b :: l3 \/ l = l1 ++ b :: l2 ++ a :: l3. Proof. intros l l' a b HP. destruct (Permutation_vs_cons_inv HP) as [l1 [l2]]; subst. symmetry in HP. apply Permutation_cons_app_inv in HP. apply (Permutation_in b), in_app_or in HP; [|now apply in_eq]. destruct HP as [(l3 & l4 & ->)%in_split | (l3 & l4 & ->)%in_split]. - exists l3, l4, l2; right. now rewrite <-app_assoc; simpl. - now exists l1, l3, l4; left. Qed. Lemma NoDup_Permutation l l' : NoDup l -> NoDup l' -> (forall x:A, In x l <-> In x l') -> Permutation l l'. Proof. intros N. revert l'. induction N as [|a l Hal Hl IH]. - destruct l'; simpl; auto. intros Hl' H. exfalso. rewrite (H a); auto. - intros l' Hl' H. assert (Ha : In a l') by (apply H; simpl; auto). destruct (Add_inv _ _ Ha) as (l'' & AD). rewrite <- (Permutation_Add AD). apply perm_skip. apply IH; clear IH. * now apply (NoDup_Add AD). * split. + apply incl_Add_inv with a l'; trivial. intro. apply H. + intro Hx. assert (Hx' : In x (a::l)). { apply H. rewrite (Add_in AD). now right. } destruct Hx'; simpl; trivial. subst. rewrite (NoDup_Add AD) in Hl'. tauto. Qed. Lemma NoDup_Permutation_bis l l' : NoDup l -> length l' <= length l -> incl l l' -> Permutation l l'. Proof. intros. apply NoDup_Permutation; auto. - now apply NoDup_incl_NoDup with l. - split; auto. apply NoDup_length_incl; trivial. Qed. Lemma Permutation_NoDup l l' : Permutation l l' -> NoDup l -> NoDup l'. Proof. induction 1; auto. - inversion_clear 1; constructor; eauto using Permutation_in. - inversion_clear 1 as [|? ? H1 H2]. inversion_clear H2; simpl in *. constructor. + simpl; intuition. + constructor; intuition. Qed. Global Instance Permutation_NoDup' : Proper (@Permutation A ==> iff) (@NoDup A). Proof. repeat red; eauto using Permutation_NoDup. Qed. Lemma Permutation_repeat x n l : Permutation l (repeat x n) -> l = repeat x n. Proof. revert n; induction l as [|y l IHl] ; simpl; intros n HP; auto. - now apply Permutation_nil in HP; inversion HP. - assert (y = x) as Heq by (now apply repeat_spec with n, (Permutation_in _ HP); left); subst. destruct n; simpl; simpl in HP. + symmetry in HP; apply Permutation_nil in HP; inversion HP. + f_equal; apply IHl. now apply Permutation_cons_inv with x. Qed. Lemma Permutation_incl_cons_inv_r (l1 l2 : list A) a : incl l1 (a :: l2) -> exists n l3, Permutation l1 (repeat a n ++ l3) /\ incl l3 l2. Proof. induction l1 as [|b l1 IH]. - intros _. now exists 0, nil. - intros [Hb Hincl] %incl_cons_inv. destruct (IH Hincl) as [n [l3 [Hl1 Hl3l2]]]. destruct Hb. + subst b. exists (S n), l3. eauto. + exists n, (b :: l3). eauto using incl_cons. Qed. Lemma Permutation_pigeonhole l1 l2 : incl l1 l2 -> length l2 < length l1 -> exists a l3, Permutation l1 (a :: a :: l3). Proof. induction l2 as [|a l2 IH] in l1 |- *. - intros -> %incl_l_nil [] %PeanoNat.Nat.nlt_0_r. - intros [[|[|n]] [l4 [Hl1 Hl4]]] %Permutation_incl_cons_inv_r Hlen. + apply IH. * unfold incl. eauto using Permutation_in. * eauto using PeanoNat.Nat.lt_trans. + assert (Hl2l4 : length l2 < length l4). { rewrite (Permutation_length Hl1) in Hlen. now apply PeanoNat.Nat.succ_lt_mono. } destruct (IH l4 Hl4 Hl2l4) as [b [l3 Hl4l3]]. exists b, (a :: l3). apply (Permutation_trans Hl1). now apply (Permutation_cons_app (b :: b :: nil)). + now exists a, (repeat a n ++ l4). Qed. Lemma Permutation_pigeonhole_rel (R : B -> A -> Prop) (l1 : list B) l2 : Forall (fun b => Exists (R b) l2) l1 -> length l2 < length l1 -> exists b b' (l3 : list B), Permutation l1 (b :: b' :: l3) /\ exists a, In a l2 /\ R b a /\ R b' a. Proof. intros [l2' [Hl2'l1 Hl2'l2]]%Forall_Exists_exists_Forall2. intros Hl2l2'. rewrite (Forall2_length Hl2'l1) in Hl2l2'. destruct (Permutation_pigeonhole Hl2'l2 Hl2l2') as [a [l3 Hl2']]. destruct (Permutation_Forall2 Hl2' (Forall2_flip Hl2'l1)) as [l1' [Hl1l1' Hl1']]. destruct (Forall2_app_inv_l [a; a] l3 Hl1') as [lbb' [l1'' [Ha [? ?]]]]. assert (Hlbb' := Forall2_length Ha). destruct lbb' as [|b lb']; [easy|]. apply Forall2_cons_iff in Ha as [Hba Ha]. destruct lb' as [|b' l]; [easy|]. apply Forall2_cons_iff in Ha as [Hb'a Ha]. inversion Ha. subst. exists b, b', l1''. split; [easy|]. exists a. split; eauto using Permutation_in, in_eq. Qed. Hypothesis eq_dec : forall x y : A, {x = y}+{x <> y}. Lemma Permutation_count_occ l1 l2 : Permutation l1 l2 <-> forall x, count_occ eq_dec l1 x = count_occ eq_dec l2 x. Proof. split. - induction 1 as [ | y l1 l2 HP IHP | y z l | l1 l2 l3 HP1 IHP1 HP2 IHP2 ]; cbn; intros a; auto. + now rewrite IHP. + destruct (eq_dec y a); destruct (eq_dec z a); auto. + now rewrite IHP1, IHP2. - revert l2; induction l1 as [|y l1 IHl1]; cbn; intros l2 Hocc. + replace l2 with (@nil A); auto. symmetry; apply (count_occ_inv_nil eq_dec); intuition. + assert (exists l2' l2'', l2 = l2' ++ y :: l2'') as [l2' [l2'' ->]]. { specialize (Hocc y). destruct (eq_dec y y); intuition. apply in_split, (count_occ_In eq_dec). rewrite <- Hocc; apply Nat.lt_0_succ. } apply Permutation_cons_app, IHl1. intros z; specialize (Hocc z); destruct (eq_dec y z) as [Heq | Hneq]. * rewrite (count_occ_elt_eq _ _ _ Heq) in Hocc. now injection Hocc. * now rewrite (count_occ_elt_neq _ _ _ Hneq) in Hocc. Qed. End Permutation_properties. Section Permutation_map. Variable A B : Type. Variable f : A -> B. Lemma Permutation_map l l' : Permutation l l' -> Permutation (map f l) (map f l'). Proof. induction 1; simpl; eauto. Qed. Global Instance Permutation_map' : Proper (@Permutation A ==> @Permutation B) (map f). Proof. exact Permutation_map. Qed. Lemma Permutation_map_inv : forall l1 l2, Permutation l1 (map f l2) -> exists l3, l1 = map f l3 /\ Permutation l2 l3. Proof. induction l1; intros l2 HP. - exists nil; split; auto. apply Permutation_nil in HP. destruct l2; auto. inversion HP. - symmetry in HP. destruct (Permutation_vs_cons_inv HP) as [l3 [l4 Heq]]. destruct (map_eq_app _ _ _ _ Heq) as [l1' [l2' [Heq1 [Heq2 Heq3]]]]; subst. destruct (map_eq_cons _ _ Heq3) as [b [l1'' [Heq1' [Heq2' Heq3']]]]; subst. rewrite map_app in HP; simpl in HP. symmetry in HP. apply Permutation_cons_app_inv in HP. rewrite <- map_app in HP. destruct (IHl1 _ HP) as [l3 [Heq1'' Heq2'']]; subst. exists (b :: l3); split; auto. symmetry in Heq2''; symmetry; apply (Permutation_cons_app _ _ _ Heq2''). Qed. Lemma Permutation_image : forall a l l', Permutation (a :: l) (map f l') -> exists a', a = f a'. Proof. intros a l l' HP. destruct (Permutation_map_inv _ HP) as [l'' [Heq _]]. destruct l'' as [ | a' l'']; inversion_clear Heq. now exists a'. Qed. Lemma Permutation_elt_map_inv: forall l1 l2 l3 l4 a, Permutation (l1 ++ a :: l2) (l3 ++ map f l4) -> (forall b, a <> f b) -> exists l1' l2', l3 = l1' ++ a :: l2'. Proof. intros l1 l2 l3 l4 a HP Hf. apply (Permutation_in a), in_app_or in HP; [| now apply in_elt]. destruct HP as [HP%in_split | (x & Heq & ?)%in_map_iff]; trivial; subst. now contradiction (Hf x). Qed. Global Instance Permutation_flat_map (g : A -> list B) : Proper ((@Permutation A) ==> (@Permutation B)) (flat_map g). Proof. intros l1; induction l1; intros l2 HP. - now apply Permutation_nil in HP; subst. - symmetry in HP. destruct (Permutation_vs_cons_inv HP) as [l' [l'']]; subst. symmetry in HP. apply Permutation_cons_app_inv in HP. rewrite flat_map_app; simpl. rewrite <- (app_nil_l _). apply Permutation_app_middle; simpl. rewrite <- flat_map_app. apply (IHl1 _ HP). Qed. End Permutation_map. Lemma nat_bijection_Permutation n f : bFun n f -> Injective f -> let l := seq 0 n in Permutation (map f l) l. Proof. intros Hf BD. apply NoDup_Permutation_bis; auto using Injective_map_NoDup, seq_NoDup. * now rewrite length_map. * intros x. rewrite in_map_iff. intros (y & <- & Hy'). rewrite in_seq in *. simpl in *. destruct Hy' as (_,Hy'). split; [ apply Nat.le_0_l | auto ]. Qed. Section Permutation_alt. Variable A:Type. Implicit Type a : A. Implicit Type l : list A. (** Alternative characterization of permutation via [nth_error] and [nth] *) Let adapt f n := let m := f (S n) in if le_lt_dec m (f 0) then m else pred m. Local Definition adapt_injective f : Injective f -> Injective (adapt f). Proof. unfold adapt. intros Hf x y EQ. destruct le_lt_dec as [LE|LT]; destruct le_lt_dec as [LE'|LT']. - now apply eq_add_S, Hf. - apply Nat.lt_eq_cases in LE. destruct LE as [LT|EQ']; [|now apply Hf in EQ']. unfold lt in LT. rewrite EQ in LT. rewrite (Nat.lt_succ_pred _ _ LT') in LT. elim (proj1 (Nat.lt_nge _ _) LT' LT). - apply Nat.lt_eq_cases in LE'. destruct LE' as [LT'|EQ']; [|now apply Hf in EQ']. unfold lt in LT'. rewrite <- EQ in LT'. rewrite (Nat.lt_succ_pred _ _ LT) in LT'. elim (proj1 (Nat.lt_nge _ _) LT LT'). - apply eq_add_S, Hf. now rewrite <- (Nat.lt_succ_pred _ _ LT), <- (Nat.lt_succ_pred _ _ LT'), EQ. Defined. Local Definition adapt_ok a l1 l2 f : Injective f -> length l1 = f 0 -> forall n, nth_error (l1++a::l2) (f (S n)) = nth_error (l1++l2) (adapt f n). Proof. unfold adapt. intros Hf E n. destruct le_lt_dec as [LE|LT]. - apply Nat.lt_eq_cases in LE. destruct LE as [LT|EQ]; [|now apply Hf in EQ]. rewrite <- E in LT. rewrite 2 nth_error_app1; auto. - rewrite <- (Nat.lt_succ_pred _ _ LT) at 1. rewrite <- E, <- (Nat.lt_succ_pred _ _ LT) in LT. rewrite 2 nth_error_app2. + rewrite Nat.sub_succ_l; [ reflexivity | ]. apply Nat.lt_succ_r; assumption. + apply Nat.lt_succ_r; assumption. + apply Nat.lt_le_incl; assumption. Defined. Lemma Permutation_nth_error l l' : Permutation l l' <-> (length l = length l' /\ exists f:nat->nat, Injective f /\ forall n, nth_error l' n = nth_error l (f n)). Proof. split. { intros P. split; [now apply Permutation_length|]. induction P. - exists (fun n => n). split; try red; auto. - destruct IHP as (f & Hf & Hf'). exists (fun n => match n with O => O | S n => S (f n) end). split; try red. * intros [|y] [|z]; simpl; now auto. * intros [|n]; simpl; auto. - exists (fun n => match n with 0 => 1 | 1 => 0 | n => n end). split; try red. * intros [|[|z]] [|[|t]]; simpl; now auto. * intros [|[|n]]; simpl; auto. - destruct IHP1 as (f & Hf & Hf'). destruct IHP2 as (g & Hg & Hg'). exists (fun n => f (g n)). split; try red. * auto. * intros n. rewrite <- Hf'; auto. } { revert l. induction l'. - intros [|l] (E & _); now auto. - intros l (E & f & Hf & Hf'). simpl in E. assert (Ha : nth_error l (f 0) = Some a) by (symmetry; apply (Hf' 0)). destruct (nth_error_split l (f 0) Ha) as (l1 & l2 & L12 & L1). rewrite L12. rewrite <- Permutation_middle. constructor. apply IHl'; split; [|exists (adapt f); split]. * revert E. rewrite L12, !length_app. simpl. rewrite <- plus_n_Sm. now injection 1. * now apply adapt_injective. * intro n. rewrite <- (adapt_ok a), <- L12; auto. apply (Hf' (S n)). } Qed. Lemma Permutation_nth_error_bis l l' : Permutation l l' <-> exists f:nat->nat, Injective f /\ bFun (length l) f /\ (forall n, nth_error l' n = nth_error l (f n)). Proof. rewrite Permutation_nth_error; split. - intros (E & f & Hf & Hf'). exists f. do 2 (split; trivial). intros n Hn. destruct (Nat.le_gt_cases (length l) (f n)) as [LE|LT]; trivial. rewrite <- nth_error_None, <- Hf', nth_error_None, <- E in LE. elim (proj1 (Nat.lt_nge _ _) Hn LE). - intros (f & Hf & Hf2 & Hf3); split; [|exists f; auto]. assert (H : length l' <= length l') by auto. rewrite <- nth_error_None, Hf3, nth_error_None in H. destruct (Nat.le_gt_cases (length l) (length l')) as [LE|LT]; [|apply Hf2 in LT; elim (proj1 (Nat.lt_nge _ _) LT H)]. apply Nat.lt_eq_cases in LE. destruct LE as [LT|EQ]; trivial. rewrite <- nth_error_Some, Hf3, nth_error_Some in LT. assert (Hf' : bInjective (length l) f). { intros x y _ _ E. now apply Hf. } rewrite (bInjective_bSurjective Hf2) in Hf'. destruct (Hf' _ LT) as (y & Hy & Hy'). apply Hf in Hy'. subst y. elim (Nat.lt_irrefl _ Hy). Qed. Lemma Permutation_nth l l' d : Permutation l l' <-> (let n := length l in length l' = n /\ exists f:nat->nat, bFun n f /\ bInjective n f /\ (forall x, x < n -> nth x l' d = nth (f x) l d)). Proof. split. - intros H. assert (E := Permutation_length H). split; auto. apply Permutation_nth_error_bis in H. destruct H as (f & Hf & Hf2 & Hf3). exists f. split; [|split]; auto. + intros x y _ _ Hxy. now apply Hf. + intros n Hn. rewrite <- 2 nth_default_eq. unfold nth_default. now rewrite Hf3. - intros (E & f & Hf1 & Hf2 & Hf3). rewrite Permutation_nth_error. split; auto. exists (fun n => if le_lt_dec (length l) n then n else f n). split. * intros x y. destruct le_lt_dec as [LE|LT]; destruct le_lt_dec as [LE'|LT']; auto. + apply Hf1 in LT'. intros ->. elim (Nat.lt_irrefl (f y)). eapply Nat.lt_le_trans; eauto. + apply Hf1 in LT. intros <-. elim (Nat.lt_irrefl (f x)). eapply Nat.lt_le_trans; eauto. * intros n. destruct le_lt_dec as [LE|LT]. + assert (LE' : length l' <= n) by (now rewrite E). rewrite <- nth_error_None in LE, LE'. congruence. + assert (LT' : n < length l') by (now rewrite E). specialize (Hf3 n LT). rewrite <- 2 nth_default_eq in Hf3. unfold nth_default in Hf3. apply Hf1 in LT. rewrite <- nth_error_Some in LT, LT'. do 2 destruct nth_error; congruence. Qed. End Permutation_alt. #[global] Instance Permutation_list_sum : Proper (@Permutation nat ==> eq) list_sum | 10. Proof. intros l1 l2 HP; induction HP; simpl; intuition. - rewrite 2 (Nat.add_comm x). apply Nat.add_assoc. - now transitivity (list_sum l'). Qed. #[global] Instance Permutation_list_max : Proper (@Permutation nat ==> eq) list_max | 10. Proof. intros l1 l2 HP; induction HP; simpl; intuition. - rewrite 2 (Nat.max_comm x). apply Nat.max_assoc. - now transitivity (list_max l'). Qed. Section Permutation_transp. Variable A:Type. (** Permutation definition based on transpositions for induction with fixed length *) Inductive Permutation_transp : list A -> list A -> Prop := | perm_t_refl : forall l, Permutation_transp l l | perm_t_swap : forall x y l1 l2, Permutation_transp (l1 ++ y :: x :: l2) (l1 ++ x :: y :: l2) | perm_t_trans l l' l'' : Permutation_transp l l' -> Permutation_transp l' l'' -> Permutation_transp l l''. Instance Permutation_transp_sym : Symmetric Permutation_transp. Proof. intros l1 l2 HP; induction HP; subst; try (now constructor). now apply (perm_t_trans IHHP2). Qed. Global Instance Permutation_transp_equiv : Equivalence Permutation_transp | 100. Proof. split. - intros l; apply perm_t_refl. - apply Permutation_transp_sym. - intros l1 l2 l3 ;apply perm_t_trans. Qed. Lemma Permutation_transp_cons : forall (x : A) l1 l2, Permutation_transp l1 l2 -> Permutation_transp (x :: l1) (x :: l2). Proof. intros x l1 l2 HP. induction HP. - reflexivity. - rewrite 2 app_comm_cons. apply perm_t_swap. - now transitivity (x :: l'). Qed. Lemma Permutation_Permutation_transp : forall l1 l2 : list A, Permutation l1 l2 <-> Permutation_transp l1 l2. Proof. intros l1 l2; split; intros HP; induction HP; intuition auto. - solve_relation. - now apply Permutation_transp_cons. - rewrite <- (app_nil_l (y :: _)). rewrite <- (app_nil_l (x :: y :: _)). apply perm_t_swap. - now transitivity l'. - apply Permutation_app_head. apply perm_swap. - now transitivity l'. Qed. Lemma Permutation_ind_transp : forall P : list A -> list A -> Prop, (forall l, P l l) -> (forall x y l1 l2, P (l1 ++ y :: x :: l2) (l1 ++ x :: y :: l2)) -> (forall l l' l'', Permutation l l' -> P l l' -> Permutation l' l'' -> P l' l'' -> P l l'') -> forall l1 l2, Permutation l1 l2 -> P l1 l2. Proof. intros P Hr Ht Htr l1 l2 HP; apply Permutation_Permutation_transp in HP. revert Hr Ht Htr; induction HP; intros Hr Ht Htr; auto. apply (Htr _ l'); intuition; now apply Permutation_Permutation_transp. Qed. End Permutation_transp. (* begin hide *) Notation Permutation_app_swap := Permutation_app_comm (only parsing). (* end hide *) coq-8.20.0/theories/Sorting/Sorted.v000066400000000000000000000117531466560755400173120ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* A -> Prop. (** Locally sorted: consecutive elements of the list are ordered *) Inductive LocallySorted : list A -> Prop := | LSorted_nil : LocallySorted [] | LSorted_cons1 a : LocallySorted [a] | LSorted_consn a b l : LocallySorted (b :: l) -> R a b -> LocallySorted (a :: b :: l). (** Alternative two-step definition of being locally sorted *) Inductive HdRel a : list A -> Prop := | HdRel_nil : HdRel a [] | HdRel_cons b l : R a b -> HdRel a (b :: l). Inductive Sorted : list A -> Prop := | Sorted_nil : Sorted [] | Sorted_cons a l : Sorted l -> HdRel a l -> Sorted (a :: l). Lemma HdRel_inv : forall a b l, HdRel a (b :: l) -> R a b. Proof. inversion 1; auto. Qed. Lemma Sorted_inv : forall a l, Sorted (a :: l) -> Sorted l /\ HdRel a l. Proof. intros a l H; inversion H; auto. Qed. Lemma Sorted_rect : forall P:list A -> Type, P [] -> (forall a l, Sorted l -> P l -> HdRel a l -> P (a :: l)) -> forall l:list A, Sorted l -> P l. Proof. intros P ? ? l. induction l. - firstorder using Sorted_inv. - firstorder using Sorted_inv. Qed. Lemma Sorted_LocallySorted_iff : forall l, Sorted l <-> LocallySorted l. Proof. split; [induction 1 as [|a l [|]]| induction 1]; auto using Sorted, LocallySorted, HdRel. match goal with H1 : HdRel a (_ :: _) |- _ => inversion H1 end. subst; auto using LocallySorted. Qed. (** Strongly sorted: elements of the list are pairwise ordered *) Inductive StronglySorted : list A -> Prop := | SSorted_nil : StronglySorted [] | SSorted_cons a l : StronglySorted l -> Forall (R a) l -> StronglySorted (a :: l). Lemma StronglySorted_inv : forall a l, StronglySorted (a :: l) -> StronglySorted l /\ Forall (R a) l. Proof. intros a l H; inversion H; auto. Defined. Lemma StronglySorted_rect : forall P:list A -> Type, P [] -> (forall a l, StronglySorted l -> P l -> Forall (R a) l -> P (a :: l)) -> forall l, StronglySorted l -> P l. Proof. intros P ? ? l; induction l; firstorder using StronglySorted_inv. Defined. Lemma StronglySorted_rec : forall P:list A -> Type, P [] -> (forall a l, StronglySorted l -> P l -> Forall (R a) l -> P (a :: l)) -> forall l, StronglySorted l -> P l. Proof. firstorder using StronglySorted_rect. Qed. Lemma StronglySorted_Sorted : forall l, StronglySorted l -> Sorted l. Proof. induction 1 as [|? ? ? ? HForall]; constructor; trivial. destruct HForall; constructor; trivial. Qed. Lemma Sorted_extends : Transitive R -> forall a l, Sorted (a::l) -> Forall (R a) l. Proof. intros H a l H0. change match a :: l with [] => True | a :: l => Forall (R a) l end. induction H0 as [|? ? ? ? H1]; [trivial|]. destruct H1; constructor; trivial. eapply Forall_impl; [|eassumption]. firstorder. Qed. Lemma Sorted_StronglySorted : Transitive R -> forall l, Sorted l -> StronglySorted l. Proof. induction 2; constructor; trivial. apply Sorted_extends; trivial. constructor; trivial. Qed. End defs. #[global] Hint Constructors HdRel : core. #[global] Hint Constructors Sorted : core. (* begin hide *) (* Compatibility with deprecated file Sorting.v *) Notation lelistA := HdRel (only parsing). Notation nil_leA := HdRel_nil (only parsing). Notation cons_leA := HdRel_cons (only parsing). Notation sort := Sorted (only parsing). Notation nil_sort := Sorted_nil (only parsing). Notation cons_sort := Sorted_cons (only parsing). Notation lelistA_inv := HdRel_inv (only parsing). Notation sort_inv := Sorted_inv (only parsing). Notation sort_rect := Sorted_rect (only parsing). (* end hide *) coq-8.20.0/theories/Sorting/Sorting.v000066400000000000000000000013251466560755400174710ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* Ascii c a1 a2 a3 a4 a5 a6 a7 end. (** Definition of a decidable function that is effective *) Definition ascii_dec : forall a b : ascii, {a = b} + {a <> b}. Proof. decide equality; apply bool_dec. Defined. Local Open Scope lazy_bool_scope. Definition eqb (a b : ascii) : bool := match a, b with | Ascii a0 a1 a2 a3 a4 a5 a6 a7, Ascii b0 b1 b2 b3 b4 b5 b6 b7 => Bool.eqb a0 b0 &&& Bool.eqb a1 b1 &&& Bool.eqb a2 b2 &&& Bool.eqb a3 b3 &&& Bool.eqb a4 b4 &&& Bool.eqb a5 b5 &&& Bool.eqb a6 b6 &&& Bool.eqb a7 b7 end. Infix "=?" := eqb : char_scope. Lemma eqb_spec (a b : ascii) : reflect (a = b) (a =? b)%char. Proof. destruct a, b; simpl. do 8 (case Bool.eqb_spec; [ intros -> | constructor; now intros [= ] ]). now constructor. Qed. Local Ltac t_eqb := repeat first [ congruence | progress subst | apply conj | match goal with | [ |- context[eqb ?x ?y] ] => destruct (eqb_spec x y) end | intro ]. Lemma eqb_refl x : (x =? x)%char = true. Proof. t_eqb. Qed. Lemma eqb_sym x y : (x =? y)%char = (y =? x)%char. Proof. t_eqb. Qed. Lemma eqb_eq n m : (n =? m)%char = true <-> n = m. Proof. t_eqb. Qed. Lemma eqb_neq x y : (x =? y)%char = false <-> x <> y. Proof. t_eqb. Qed. Lemma eqb_compat: Morphisms.Proper (Morphisms.respectful eq (Morphisms.respectful eq eq)) eqb. Proof. t_eqb. Qed. (** * Conversion between natural numbers modulo 256 and ascii characters *) (** Auxiliary function that turns a positive into an ascii by looking at the last 8 bits, ie z mod 2^8 *) Definition ascii_of_pos : positive -> ascii := let loop := fix loop n p := match n with | O => zero | S n' => match p with | xH => one | xI p' => shift true (loop n' p') | xO p' => shift false (loop n' p') end end in loop 8. (** Conversion from [N] to [ascii] *) Definition ascii_of_N (n : N) := match n with | N0 => zero | Npos p => ascii_of_pos p end. (** Same for [nat] *) Definition ascii_of_nat (a : nat) := ascii_of_N (N.of_nat a). (** The opposite functions *) Local Open Scope list_scope. Fixpoint N_of_digits (l:list bool) : N := match l with | nil => 0 | b :: l' => (if b then 1 else 0) + 2*(N_of_digits l') end%N. Definition N_of_ascii (a : ascii) : N := let (a0,a1,a2,a3,a4,a5,a6,a7) := a in N_of_digits (a0::a1::a2::a3::a4::a5::a6::a7::nil). Definition nat_of_ascii (a : ascii) : nat := N.to_nat (N_of_ascii a). (** Proofs that we have indeed opposite function (below 256) *) Theorem ascii_N_embedding : forall a : ascii, ascii_of_N (N_of_ascii a) = a. Proof. intro a; destruct a as [[|][|][|][|][|][|][|][|]]; vm_compute; reflexivity. Qed. Theorem N_ascii_embedding : forall n:N, (n < 256)%N -> N_of_ascii (ascii_of_N n) = n. Proof. intro n; destruct n as [|p]. - reflexivity. - do 8 (destruct p as [p|p|]; [ | | intros; vm_compute; reflexivity ]); intro H; vm_compute in H; destruct p; discriminate. Qed. Theorem N_ascii_bounded : forall a : ascii, (N_of_ascii a < 256)%N. Proof. intro a; destruct a as [[|][|][|][|][|][|][|][|]]; vm_compute; reflexivity. Qed. Theorem ascii_nat_embedding : forall a : ascii, ascii_of_nat (nat_of_ascii a) = a. Proof. intro a; destruct a as [[|][|][|][|][|][|][|][|]]; compute; reflexivity. Qed. Theorem nat_ascii_embedding : forall n : nat, n < 256 -> nat_of_ascii (ascii_of_nat n) = n. Proof. intros. unfold nat_of_ascii, ascii_of_nat. rewrite N_ascii_embedding. - apply Nat2N.id. - unfold N.lt. change 256%N with (N.of_nat 256). rewrite <- Nat2N.inj_compare. now apply Nat.compare_lt_iff. Qed. Theorem nat_ascii_bounded : forall a : ascii, nat_of_ascii a < 256. Proof. intro a; unfold nat_of_ascii. change 256 with (N.to_nat 256). rewrite <- Nat.compare_lt_iff, <- N2Nat.inj_compare, N.compare_lt_iff. apply N_ascii_bounded. Qed. Definition compare (a b : ascii) : comparison := N.compare (N_of_ascii a) (N_of_ascii b). Lemma compare_antisym (a b : ascii) : compare a b = CompOpp (compare b a). Proof. apply N.compare_antisym. Qed. Lemma compare_eq_iff (a b : ascii) : compare a b = Eq -> a = b. Proof. unfold compare. intros H. apply N.compare_eq_iff in H. rewrite <- ascii_N_embedding. rewrite <- H. rewrite ascii_N_embedding. reflexivity. Qed. Definition ltb (a b : ascii) : bool := if compare a b is Lt then true else false. Definition leb (a b : ascii) : bool := if compare a b is Gt then false else true. Lemma leb_antisym (a b : ascii) : leb a b = true -> leb b a = true -> a = b. Proof. unfold leb. rewrite compare_antisym. destruct (compare b a) eqn:Hcmp; simpl in *; intuition. - apply compare_eq_iff in Hcmp. intuition. - discriminate H. - discriminate H0. Qed. Lemma leb_total (a b : ascii) : leb a b = true \/ leb b a = true. Proof. unfold leb. rewrite compare_antisym. destruct (compare b a); intuition. Qed. Infix "?=" := compare : char_scope. Infix "= 128 do not denote stand-alone utf8 characters so that only the notation "nnn" is available for them (unless your terminal is able to represent them, which is typically not the case in coqide). *) Definition ascii_of_byte (b : byte) : ascii := let '(b0, (b1, (b2, (b3, (b4, (b5, (b6, b7))))))) := Byte.to_bits b in Ascii b0 b1 b2 b3 b4 b5 b6 b7. Definition byte_of_ascii (a : ascii) : byte := let (b0, b1, b2, b3, b4, b5, b6, b7) := a in Byte.of_bits (b0, (b1, (b2, (b3, (b4, (b5, (b6, b7))))))). Lemma ascii_of_byte_of_ascii x : ascii_of_byte (byte_of_ascii x) = x. Proof. cbv [ascii_of_byte byte_of_ascii]. destruct x; rewrite to_bits_of_bits; reflexivity. Qed. Lemma byte_of_ascii_of_byte x : byte_of_ascii (ascii_of_byte x) = x. Proof. cbv [ascii_of_byte byte_of_ascii]. repeat match goal with | [ |- context[match ?x with pair _ _ => _ end] ] => rewrite (surjective_pairing x) | [ |- context[(fst ?x, snd ?x)] ] => rewrite <- (surjective_pairing x) end. rewrite of_bits_to_bits; reflexivity. Qed. Lemma ascii_of_byte_via_N x : ascii_of_byte x = ascii_of_N (Byte.to_N x). Proof. destruct x; reflexivity. Qed. Lemma ascii_of_byte_via_nat x : ascii_of_byte x = ascii_of_nat (Byte.to_nat x). Proof. destruct x; reflexivity. Qed. Lemma byte_of_ascii_via_N x : Some (byte_of_ascii x) = Byte.of_N (N_of_ascii x). Proof. rewrite <- (ascii_of_byte_of_ascii x); destruct (byte_of_ascii x); reflexivity. Qed. Lemma byte_of_ascii_via_nat x : Some (byte_of_ascii x) = Byte.of_nat (nat_of_ascii x). Proof. rewrite <- (ascii_of_byte_of_ascii x); destruct (byte_of_ascii x); reflexivity. Qed. Module Export AsciiSyntax. String Notation ascii ascii_of_byte byte_of_ascii : char_scope. End AsciiSyntax. Local Open Scope char_scope. Example Space := " ". Example DoubleQuote := """". Example Beep := "007". coq-8.20.0/theories/Strings/BinaryString.v000066400000000000000000000102341466560755400204620ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* (pos_bin_app p q)~0 | q~1 => (pos_bin_app p q)~1 | 1 => p~1 end. Module Raw. Fixpoint of_pos (p : positive) (rest : string) : string := match p with | 1 => String "1" rest | p'~0 => of_pos p' (String "0" rest) | p'~1 => of_pos p' (String "1" rest) end. Fixpoint to_N (s : string) (rest : N) : N := match s with | "" => rest | String ch s' => to_N s' match ascii_to_digit ch with | Some v => N.add v (N.double rest) | None => N0 end end. Fixpoint to_N_of_pos (p : positive) (rest : string) (base : N) {struct p} : to_N (of_pos p rest) base = to_N rest match base with | N0 => N.pos p | Npos v => Npos (pos_bin_app v p) end. Proof. destruct p as [p|p|]; destruct base; try reflexivity; cbn; rewrite to_N_of_pos; reflexivity. Qed. End Raw. Definition of_pos (p : positive) : string := String "0" (String "b" (Raw.of_pos p "")). Definition of_N (n : N) : string := match n with | N0 => "0b0" | Npos p => of_pos p end. Definition of_Z (z : Z) : string := match z with | Zneg p => String "-" (of_pos p) | Z0 => "0b0" | Zpos p => of_pos p end. Definition of_nat (n : nat) : string := of_N (N.of_nat n). Definition to_N (s : string) : N := match s with | String s0 (String sb s) => if ascii_dec s0 "0" then if ascii_dec sb "b" then Raw.to_N s N0 else N0 else N0 | _ => N0 end. Definition to_pos (s : string) : positive := match to_N s with | N0 => 1 | Npos p => p end. Definition to_Z (s : string) : Z := let '(is_neg, n) := match s with | String s0 s' => if ascii_dec s0 "-" then (true, to_N s') else (false, to_N s) | EmptyString => (false, to_N s) end in match n with | N0 => Z0 | Npos p => if is_neg then Zneg p else Zpos p end. Definition to_nat (s : string) : nat := N.to_nat (to_N s). Lemma to_N_of_N (n : N) : to_N (of_N n) = n. Proof. destruct n; [ reflexivity | apply Raw.to_N_of_pos ]. Qed. Lemma Z_of_of_Z (z : Z) : to_Z (of_Z z) = z. Proof. cbv [of_Z to_Z]; destruct z as [|z|z]; cbn; try reflexivity; rewrite Raw.to_N_of_pos; cbn; reflexivity. Qed. Lemma to_nat_of_nat (n : nat) : to_nat (of_nat n) = n. Proof. cbv [to_nat of_nat]; rewrite to_N_of_N, Nnat.Nat2N.id; reflexivity. Qed. Lemma to_pos_of_pos (p : positive) : to_pos (of_pos p) = p. Proof. cbv [of_pos to_pos to_N]; cbn; rewrite Raw.to_N_of_pos; cbn; reflexivity. Qed. Example of_pos_1 : of_pos 1 = "0b1" := eq_refl. Example of_pos_2 : of_pos 2 = "0b10" := eq_refl. Example of_pos_3 : of_pos 3 = "0b11" := eq_refl. Example of_N_0 : of_N 0 = "0b0" := eq_refl. Example of_Z_0 : of_Z 0 = "0b0" := eq_refl. Example of_Z_m1 : of_Z (-1) = "-0b1" := eq_refl. Example of_nat_0 : of_nat 0 = "0b0" := eq_refl. coq-8.20.0/theories/Strings/Byte.v000066400000000000000000000707671466560755400167730ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* eqb x y = true. Proof. intro; subst y; destruct x; reflexivity. Defined. Lemma byte_dec_bl x y (H : eqb x y = true) : x = y. Proof. rewrite <- (of_bits_to_bits x), <- (of_bits_to_bits y). unfold eqb in H; revert H. assert (H : forall (P : bool -> bool -> Prop) b1 b2 b3, (b3 = true -> P b1 b1) -> (b3 && Bool.eqb b1 b2)%bool = true -> P b1 b2). { intros ???? H [? <-%Bool.eqb_prop]%Bool.andb_true_iff. now apply H. } destruct (to_bits x) as (? & ? & ? & ? & ? & ? & ? & ?). destruct (to_bits y) as (? & ? & ? & ? & ? & ? & ? & ?). do 7 refine (H (fun _ _ => _) _ _ _ _). now intros <-%Bool.eqb_prop. Qed. Lemma eqb_false x y : eqb x y = false -> x <> y. Proof. intros H H'; pose proof (byte_dec_lb H'); congruence. Qed. Definition byte_eq_dec (x y : byte) : {x = y} + {x <> y} := (if eqb x y as beq return eqb x y = beq -> _ then fun pf => left (byte_dec_bl x y pf) else fun pf => right (eqb_false pf)) eq_refl. Section nat. Definition to_nat (x : byte) : nat := match x with | x00 => 0 | x01 => 1 | x02 => 2 | x03 => 3 | x04 => 4 | x05 => 5 | x06 => 6 | x07 => 7 | x08 => 8 | x09 => 9 | x0a => 10 | x0b => 11 | x0c => 12 | x0d => 13 | x0e => 14 | x0f => 15 | x10 => 16 | x11 => 17 | x12 => 18 | x13 => 19 | x14 => 20 | x15 => 21 | x16 => 22 | x17 => 23 | x18 => 24 | x19 => 25 | x1a => 26 | x1b => 27 | x1c => 28 | x1d => 29 | x1e => 30 | x1f => 31 | x20 => 32 | x21 => 33 | x22 => 34 | x23 => 35 | x24 => 36 | x25 => 37 | x26 => 38 | x27 => 39 | x28 => 40 | x29 => 41 | x2a => 42 | x2b => 43 | x2c => 44 | x2d => 45 | x2e => 46 | x2f => 47 | x30 => 48 | x31 => 49 | x32 => 50 | x33 => 51 | x34 => 52 | x35 => 53 | x36 => 54 | x37 => 55 | x38 => 56 | x39 => 57 | x3a => 58 | x3b => 59 | x3c => 60 | x3d => 61 | x3e => 62 | x3f => 63 | x40 => 64 | x41 => 65 | x42 => 66 | x43 => 67 | x44 => 68 | x45 => 69 | x46 => 70 | x47 => 71 | x48 => 72 | x49 => 73 | x4a => 74 | x4b => 75 | x4c => 76 | x4d => 77 | x4e => 78 | x4f => 79 | x50 => 80 | x51 => 81 | x52 => 82 | x53 => 83 | x54 => 84 | x55 => 85 | x56 => 86 | x57 => 87 | x58 => 88 | x59 => 89 | x5a => 90 | x5b => 91 | x5c => 92 | x5d => 93 | x5e => 94 | x5f => 95 | x60 => 96 | x61 => 97 | x62 => 98 | x63 => 99 | x64 => 100 | x65 => 101 | x66 => 102 | x67 => 103 | x68 => 104 | x69 => 105 | x6a => 106 | x6b => 107 | x6c => 108 | x6d => 109 | x6e => 110 | x6f => 111 | x70 => 112 | x71 => 113 | x72 => 114 | x73 => 115 | x74 => 116 | x75 => 117 | x76 => 118 | x77 => 119 | x78 => 120 | x79 => 121 | x7a => 122 | x7b => 123 | x7c => 124 | x7d => 125 | x7e => 126 | x7f => 127 | x80 => 128 | x81 => 129 | x82 => 130 | x83 => 131 | x84 => 132 | x85 => 133 | x86 => 134 | x87 => 135 | x88 => 136 | x89 => 137 | x8a => 138 | x8b => 139 | x8c => 140 | x8d => 141 | x8e => 142 | x8f => 143 | x90 => 144 | x91 => 145 | x92 => 146 | x93 => 147 | x94 => 148 | x95 => 149 | x96 => 150 | x97 => 151 | x98 => 152 | x99 => 153 | x9a => 154 | x9b => 155 | x9c => 156 | x9d => 157 | x9e => 158 | x9f => 159 | xa0 => 160 | xa1 => 161 | xa2 => 162 | xa3 => 163 | xa4 => 164 | xa5 => 165 | xa6 => 166 | xa7 => 167 | xa8 => 168 | xa9 => 169 | xaa => 170 | xab => 171 | xac => 172 | xad => 173 | xae => 174 | xaf => 175 | xb0 => 176 | xb1 => 177 | xb2 => 178 | xb3 => 179 | xb4 => 180 | xb5 => 181 | xb6 => 182 | xb7 => 183 | xb8 => 184 | xb9 => 185 | xba => 186 | xbb => 187 | xbc => 188 | xbd => 189 | xbe => 190 | xbf => 191 | xc0 => 192 | xc1 => 193 | xc2 => 194 | xc3 => 195 | xc4 => 196 | xc5 => 197 | xc6 => 198 | xc7 => 199 | xc8 => 200 | xc9 => 201 | xca => 202 | xcb => 203 | xcc => 204 | xcd => 205 | xce => 206 | xcf => 207 | xd0 => 208 | xd1 => 209 | xd2 => 210 | xd3 => 211 | xd4 => 212 | xd5 => 213 | xd6 => 214 | xd7 => 215 | xd8 => 216 | xd9 => 217 | xda => 218 | xdb => 219 | xdc => 220 | xdd => 221 | xde => 222 | xdf => 223 | xe0 => 224 | xe1 => 225 | xe2 => 226 | xe3 => 227 | xe4 => 228 | xe5 => 229 | xe6 => 230 | xe7 => 231 | xe8 => 232 | xe9 => 233 | xea => 234 | xeb => 235 | xec => 236 | xed => 237 | xee => 238 | xef => 239 | xf0 => 240 | xf1 => 241 | xf2 => 242 | xf3 => 243 | xf4 => 244 | xf5 => 245 | xf6 => 246 | xf7 => 247 | xf8 => 248 | xf9 => 249 | xfa => 250 | xfb => 251 | xfc => 252 | xfd => 253 | xfe => 254 | xff => 255 end. Definition of_nat (x : nat) : option byte := match x with | 0 => Some x00 | 1 => Some x01 | 2 => Some x02 | 3 => Some x03 | 4 => Some x04 | 5 => Some x05 | 6 => Some x06 | 7 => Some x07 | 8 => Some x08 | 9 => Some x09 | 10 => Some x0a | 11 => Some x0b | 12 => Some x0c | 13 => Some x0d | 14 => Some x0e | 15 => Some x0f | 16 => Some x10 | 17 => Some x11 | 18 => Some x12 | 19 => Some x13 | 20 => Some x14 | 21 => Some x15 | 22 => Some x16 | 23 => Some x17 | 24 => Some x18 | 25 => Some x19 | 26 => Some x1a | 27 => Some x1b | 28 => Some x1c | 29 => Some x1d | 30 => Some x1e | 31 => Some x1f | 32 => Some x20 | 33 => Some x21 | 34 => Some x22 | 35 => Some x23 | 36 => Some x24 | 37 => Some x25 | 38 => Some x26 | 39 => Some x27 | 40 => Some x28 | 41 => Some x29 | 42 => Some x2a | 43 => Some x2b | 44 => Some x2c | 45 => Some x2d | 46 => Some x2e | 47 => Some x2f | 48 => Some x30 | 49 => Some x31 | 50 => Some x32 | 51 => Some x33 | 52 => Some x34 | 53 => Some x35 | 54 => Some x36 | 55 => Some x37 | 56 => Some x38 | 57 => Some x39 | 58 => Some x3a | 59 => Some x3b | 60 => Some x3c | 61 => Some x3d | 62 => Some x3e | 63 => Some x3f | 64 => Some x40 | 65 => Some x41 | 66 => Some x42 | 67 => Some x43 | 68 => Some x44 | 69 => Some x45 | 70 => Some x46 | 71 => Some x47 | 72 => Some x48 | 73 => Some x49 | 74 => Some x4a | 75 => Some x4b | 76 => Some x4c | 77 => Some x4d | 78 => Some x4e | 79 => Some x4f | 80 => Some x50 | 81 => Some x51 | 82 => Some x52 | 83 => Some x53 | 84 => Some x54 | 85 => Some x55 | 86 => Some x56 | 87 => Some x57 | 88 => Some x58 | 89 => Some x59 | 90 => Some x5a | 91 => Some x5b | 92 => Some x5c | 93 => Some x5d | 94 => Some x5e | 95 => Some x5f | 96 => Some x60 | 97 => Some x61 | 98 => Some x62 | 99 => Some x63 | 100 => Some x64 | 101 => Some x65 | 102 => Some x66 | 103 => Some x67 | 104 => Some x68 | 105 => Some x69 | 106 => Some x6a | 107 => Some x6b | 108 => Some x6c | 109 => Some x6d | 110 => Some x6e | 111 => Some x6f | 112 => Some x70 | 113 => Some x71 | 114 => Some x72 | 115 => Some x73 | 116 => Some x74 | 117 => Some x75 | 118 => Some x76 | 119 => Some x77 | 120 => Some x78 | 121 => Some x79 | 122 => Some x7a | 123 => Some x7b | 124 => Some x7c | 125 => Some x7d | 126 => Some x7e | 127 => Some x7f | 128 => Some x80 | 129 => Some x81 | 130 => Some x82 | 131 => Some x83 | 132 => Some x84 | 133 => Some x85 | 134 => Some x86 | 135 => Some x87 | 136 => Some x88 | 137 => Some x89 | 138 => Some x8a | 139 => Some x8b | 140 => Some x8c | 141 => Some x8d | 142 => Some x8e | 143 => Some x8f | 144 => Some x90 | 145 => Some x91 | 146 => Some x92 | 147 => Some x93 | 148 => Some x94 | 149 => Some x95 | 150 => Some x96 | 151 => Some x97 | 152 => Some x98 | 153 => Some x99 | 154 => Some x9a | 155 => Some x9b | 156 => Some x9c | 157 => Some x9d | 158 => Some x9e | 159 => Some x9f | 160 => Some xa0 | 161 => Some xa1 | 162 => Some xa2 | 163 => Some xa3 | 164 => Some xa4 | 165 => Some xa5 | 166 => Some xa6 | 167 => Some xa7 | 168 => Some xa8 | 169 => Some xa9 | 170 => Some xaa | 171 => Some xab | 172 => Some xac | 173 => Some xad | 174 => Some xae | 175 => Some xaf | 176 => Some xb0 | 177 => Some xb1 | 178 => Some xb2 | 179 => Some xb3 | 180 => Some xb4 | 181 => Some xb5 | 182 => Some xb6 | 183 => Some xb7 | 184 => Some xb8 | 185 => Some xb9 | 186 => Some xba | 187 => Some xbb | 188 => Some xbc | 189 => Some xbd | 190 => Some xbe | 191 => Some xbf | 192 => Some xc0 | 193 => Some xc1 | 194 => Some xc2 | 195 => Some xc3 | 196 => Some xc4 | 197 => Some xc5 | 198 => Some xc6 | 199 => Some xc7 | 200 => Some xc8 | 201 => Some xc9 | 202 => Some xca | 203 => Some xcb | 204 => Some xcc | 205 => Some xcd | 206 => Some xce | 207 => Some xcf | 208 => Some xd0 | 209 => Some xd1 | 210 => Some xd2 | 211 => Some xd3 | 212 => Some xd4 | 213 => Some xd5 | 214 => Some xd6 | 215 => Some xd7 | 216 => Some xd8 | 217 => Some xd9 | 218 => Some xda | 219 => Some xdb | 220 => Some xdc | 221 => Some xdd | 222 => Some xde | 223 => Some xdf | 224 => Some xe0 | 225 => Some xe1 | 226 => Some xe2 | 227 => Some xe3 | 228 => Some xe4 | 229 => Some xe5 | 230 => Some xe6 | 231 => Some xe7 | 232 => Some xe8 | 233 => Some xe9 | 234 => Some xea | 235 => Some xeb | 236 => Some xec | 237 => Some xed | 238 => Some xee | 239 => Some xef | 240 => Some xf0 | 241 => Some xf1 | 242 => Some xf2 | 243 => Some xf3 | 244 => Some xf4 | 245 => Some xf5 | 246 => Some xf6 | 247 => Some xf7 | 248 => Some xf8 | 249 => Some xf9 | 250 => Some xfa | 251 => Some xfb | 252 => Some xfc | 253 => Some xfd | 254 => Some xfe | 255 => Some xff | _ => None end. Lemma of_to_nat x : of_nat (to_nat x) = Some x. Proof. destruct x; reflexivity. Qed. Lemma to_of_nat x y : of_nat x = Some y -> to_nat y = x. Proof. intros E. pose (P := fun n : nat => match of_nat n with Some z => to_nat z = n | None => True end). enough (H : P x) by now subst P; simpl in H; rewrite E in H. clear y E. revert x. assert (H : forall P, P 0 -> (forall n, P (S n)) -> forall n, P n) by now intros ??? [|?]. now do 256 refine (H _ eq_refl _). Qed. Lemma to_of_nat_iff x y : of_nat x = Some y <-> to_nat y = x. Proof. split; intro; subst; (apply of_to_nat || apply to_of_nat); assumption. Qed. Lemma to_of_nat_option_map x : option_map to_nat (of_nat x) = if Nat.leb x 255 then Some x else None. Proof. pose (P := (fun n : nat => option_map to_nat (of_nat n) = (if Nat.leb n 255 then Some n else None))). change (P x). revert x. assert (H : forall P, P 0 -> (forall n, P (S n)) -> forall n, P n) by now intros ??? [|?]. now do 256 (refine (H _ eq_refl _)). Qed. Lemma to_nat_bounded x : to_nat x <= 255. Proof. apply PeanoNat.Nat.leb_le. generalize (to_of_nat_option_map (to_nat x)). rewrite of_to_nat. now destruct (Nat.leb (to_nat x) 255). Qed. Lemma of_nat_None_iff x : of_nat x = None <-> 255 < x. Proof. assert (H := to_of_nat_option_map x). split. - intros E. rewrite E in H. now destruct (PeanoNat.Nat.leb_spec x 255). - intros E%PeanoNat.Nat.leb_gt. rewrite E in H. now destruct (of_nat x). Qed. End nat. Section N. Local Open Scope N_scope. Definition to_N (x : byte) : N := match x with | x00 => 0 | x01 => 1 | x02 => 2 | x03 => 3 | x04 => 4 | x05 => 5 | x06 => 6 | x07 => 7 | x08 => 8 | x09 => 9 | x0a => 10 | x0b => 11 | x0c => 12 | x0d => 13 | x0e => 14 | x0f => 15 | x10 => 16 | x11 => 17 | x12 => 18 | x13 => 19 | x14 => 20 | x15 => 21 | x16 => 22 | x17 => 23 | x18 => 24 | x19 => 25 | x1a => 26 | x1b => 27 | x1c => 28 | x1d => 29 | x1e => 30 | x1f => 31 | x20 => 32 | x21 => 33 | x22 => 34 | x23 => 35 | x24 => 36 | x25 => 37 | x26 => 38 | x27 => 39 | x28 => 40 | x29 => 41 | x2a => 42 | x2b => 43 | x2c => 44 | x2d => 45 | x2e => 46 | x2f => 47 | x30 => 48 | x31 => 49 | x32 => 50 | x33 => 51 | x34 => 52 | x35 => 53 | x36 => 54 | x37 => 55 | x38 => 56 | x39 => 57 | x3a => 58 | x3b => 59 | x3c => 60 | x3d => 61 | x3e => 62 | x3f => 63 | x40 => 64 | x41 => 65 | x42 => 66 | x43 => 67 | x44 => 68 | x45 => 69 | x46 => 70 | x47 => 71 | x48 => 72 | x49 => 73 | x4a => 74 | x4b => 75 | x4c => 76 | x4d => 77 | x4e => 78 | x4f => 79 | x50 => 80 | x51 => 81 | x52 => 82 | x53 => 83 | x54 => 84 | x55 => 85 | x56 => 86 | x57 => 87 | x58 => 88 | x59 => 89 | x5a => 90 | x5b => 91 | x5c => 92 | x5d => 93 | x5e => 94 | x5f => 95 | x60 => 96 | x61 => 97 | x62 => 98 | x63 => 99 | x64 => 100 | x65 => 101 | x66 => 102 | x67 => 103 | x68 => 104 | x69 => 105 | x6a => 106 | x6b => 107 | x6c => 108 | x6d => 109 | x6e => 110 | x6f => 111 | x70 => 112 | x71 => 113 | x72 => 114 | x73 => 115 | x74 => 116 | x75 => 117 | x76 => 118 | x77 => 119 | x78 => 120 | x79 => 121 | x7a => 122 | x7b => 123 | x7c => 124 | x7d => 125 | x7e => 126 | x7f => 127 | x80 => 128 | x81 => 129 | x82 => 130 | x83 => 131 | x84 => 132 | x85 => 133 | x86 => 134 | x87 => 135 | x88 => 136 | x89 => 137 | x8a => 138 | x8b => 139 | x8c => 140 | x8d => 141 | x8e => 142 | x8f => 143 | x90 => 144 | x91 => 145 | x92 => 146 | x93 => 147 | x94 => 148 | x95 => 149 | x96 => 150 | x97 => 151 | x98 => 152 | x99 => 153 | x9a => 154 | x9b => 155 | x9c => 156 | x9d => 157 | x9e => 158 | x9f => 159 | xa0 => 160 | xa1 => 161 | xa2 => 162 | xa3 => 163 | xa4 => 164 | xa5 => 165 | xa6 => 166 | xa7 => 167 | xa8 => 168 | xa9 => 169 | xaa => 170 | xab => 171 | xac => 172 | xad => 173 | xae => 174 | xaf => 175 | xb0 => 176 | xb1 => 177 | xb2 => 178 | xb3 => 179 | xb4 => 180 | xb5 => 181 | xb6 => 182 | xb7 => 183 | xb8 => 184 | xb9 => 185 | xba => 186 | xbb => 187 | xbc => 188 | xbd => 189 | xbe => 190 | xbf => 191 | xc0 => 192 | xc1 => 193 | xc2 => 194 | xc3 => 195 | xc4 => 196 | xc5 => 197 | xc6 => 198 | xc7 => 199 | xc8 => 200 | xc9 => 201 | xca => 202 | xcb => 203 | xcc => 204 | xcd => 205 | xce => 206 | xcf => 207 | xd0 => 208 | xd1 => 209 | xd2 => 210 | xd3 => 211 | xd4 => 212 | xd5 => 213 | xd6 => 214 | xd7 => 215 | xd8 => 216 | xd9 => 217 | xda => 218 | xdb => 219 | xdc => 220 | xdd => 221 | xde => 222 | xdf => 223 | xe0 => 224 | xe1 => 225 | xe2 => 226 | xe3 => 227 | xe4 => 228 | xe5 => 229 | xe6 => 230 | xe7 => 231 | xe8 => 232 | xe9 => 233 | xea => 234 | xeb => 235 | xec => 236 | xed => 237 | xee => 238 | xef => 239 | xf0 => 240 | xf1 => 241 | xf2 => 242 | xf3 => 243 | xf4 => 244 | xf5 => 245 | xf6 => 246 | xf7 => 247 | xf8 => 248 | xf9 => 249 | xfa => 250 | xfb => 251 | xfc => 252 | xfd => 253 | xfe => 254 | xff => 255 end. Definition of_N (x : N) : option byte := match x with | 0 => Some x00 | 1 => Some x01 | 2 => Some x02 | 3 => Some x03 | 4 => Some x04 | 5 => Some x05 | 6 => Some x06 | 7 => Some x07 | 8 => Some x08 | 9 => Some x09 | 10 => Some x0a | 11 => Some x0b | 12 => Some x0c | 13 => Some x0d | 14 => Some x0e | 15 => Some x0f | 16 => Some x10 | 17 => Some x11 | 18 => Some x12 | 19 => Some x13 | 20 => Some x14 | 21 => Some x15 | 22 => Some x16 | 23 => Some x17 | 24 => Some x18 | 25 => Some x19 | 26 => Some x1a | 27 => Some x1b | 28 => Some x1c | 29 => Some x1d | 30 => Some x1e | 31 => Some x1f | 32 => Some x20 | 33 => Some x21 | 34 => Some x22 | 35 => Some x23 | 36 => Some x24 | 37 => Some x25 | 38 => Some x26 | 39 => Some x27 | 40 => Some x28 | 41 => Some x29 | 42 => Some x2a | 43 => Some x2b | 44 => Some x2c | 45 => Some x2d | 46 => Some x2e | 47 => Some x2f | 48 => Some x30 | 49 => Some x31 | 50 => Some x32 | 51 => Some x33 | 52 => Some x34 | 53 => Some x35 | 54 => Some x36 | 55 => Some x37 | 56 => Some x38 | 57 => Some x39 | 58 => Some x3a | 59 => Some x3b | 60 => Some x3c | 61 => Some x3d | 62 => Some x3e | 63 => Some x3f | 64 => Some x40 | 65 => Some x41 | 66 => Some x42 | 67 => Some x43 | 68 => Some x44 | 69 => Some x45 | 70 => Some x46 | 71 => Some x47 | 72 => Some x48 | 73 => Some x49 | 74 => Some x4a | 75 => Some x4b | 76 => Some x4c | 77 => Some x4d | 78 => Some x4e | 79 => Some x4f | 80 => Some x50 | 81 => Some x51 | 82 => Some x52 | 83 => Some x53 | 84 => Some x54 | 85 => Some x55 | 86 => Some x56 | 87 => Some x57 | 88 => Some x58 | 89 => Some x59 | 90 => Some x5a | 91 => Some x5b | 92 => Some x5c | 93 => Some x5d | 94 => Some x5e | 95 => Some x5f | 96 => Some x60 | 97 => Some x61 | 98 => Some x62 | 99 => Some x63 | 100 => Some x64 | 101 => Some x65 | 102 => Some x66 | 103 => Some x67 | 104 => Some x68 | 105 => Some x69 | 106 => Some x6a | 107 => Some x6b | 108 => Some x6c | 109 => Some x6d | 110 => Some x6e | 111 => Some x6f | 112 => Some x70 | 113 => Some x71 | 114 => Some x72 | 115 => Some x73 | 116 => Some x74 | 117 => Some x75 | 118 => Some x76 | 119 => Some x77 | 120 => Some x78 | 121 => Some x79 | 122 => Some x7a | 123 => Some x7b | 124 => Some x7c | 125 => Some x7d | 126 => Some x7e | 127 => Some x7f | 128 => Some x80 | 129 => Some x81 | 130 => Some x82 | 131 => Some x83 | 132 => Some x84 | 133 => Some x85 | 134 => Some x86 | 135 => Some x87 | 136 => Some x88 | 137 => Some x89 | 138 => Some x8a | 139 => Some x8b | 140 => Some x8c | 141 => Some x8d | 142 => Some x8e | 143 => Some x8f | 144 => Some x90 | 145 => Some x91 | 146 => Some x92 | 147 => Some x93 | 148 => Some x94 | 149 => Some x95 | 150 => Some x96 | 151 => Some x97 | 152 => Some x98 | 153 => Some x99 | 154 => Some x9a | 155 => Some x9b | 156 => Some x9c | 157 => Some x9d | 158 => Some x9e | 159 => Some x9f | 160 => Some xa0 | 161 => Some xa1 | 162 => Some xa2 | 163 => Some xa3 | 164 => Some xa4 | 165 => Some xa5 | 166 => Some xa6 | 167 => Some xa7 | 168 => Some xa8 | 169 => Some xa9 | 170 => Some xaa | 171 => Some xab | 172 => Some xac | 173 => Some xad | 174 => Some xae | 175 => Some xaf | 176 => Some xb0 | 177 => Some xb1 | 178 => Some xb2 | 179 => Some xb3 | 180 => Some xb4 | 181 => Some xb5 | 182 => Some xb6 | 183 => Some xb7 | 184 => Some xb8 | 185 => Some xb9 | 186 => Some xba | 187 => Some xbb | 188 => Some xbc | 189 => Some xbd | 190 => Some xbe | 191 => Some xbf | 192 => Some xc0 | 193 => Some xc1 | 194 => Some xc2 | 195 => Some xc3 | 196 => Some xc4 | 197 => Some xc5 | 198 => Some xc6 | 199 => Some xc7 | 200 => Some xc8 | 201 => Some xc9 | 202 => Some xca | 203 => Some xcb | 204 => Some xcc | 205 => Some xcd | 206 => Some xce | 207 => Some xcf | 208 => Some xd0 | 209 => Some xd1 | 210 => Some xd2 | 211 => Some xd3 | 212 => Some xd4 | 213 => Some xd5 | 214 => Some xd6 | 215 => Some xd7 | 216 => Some xd8 | 217 => Some xd9 | 218 => Some xda | 219 => Some xdb | 220 => Some xdc | 221 => Some xdd | 222 => Some xde | 223 => Some xdf | 224 => Some xe0 | 225 => Some xe1 | 226 => Some xe2 | 227 => Some xe3 | 228 => Some xe4 | 229 => Some xe5 | 230 => Some xe6 | 231 => Some xe7 | 232 => Some xe8 | 233 => Some xe9 | 234 => Some xea | 235 => Some xeb | 236 => Some xec | 237 => Some xed | 238 => Some xee | 239 => Some xef | 240 => Some xf0 | 241 => Some xf1 | 242 => Some xf2 | 243 => Some xf3 | 244 => Some xf4 | 245 => Some xf5 | 246 => Some xf6 | 247 => Some xf7 | 248 => Some xf8 | 249 => Some xf9 | 250 => Some xfa | 251 => Some xfb | 252 => Some xfc | 253 => Some xfd | 254 => Some xfe | 255 => Some xff | _ => None end. Lemma of_to_N x : of_N (to_N x) = Some x. Proof. destruct x; reflexivity. Qed. Lemma to_of_N x y : of_N x = Some y -> to_N y = x. Proof. intros E. pose (P := fun n : N => match of_N n with Some z => to_N z = n | None => True end). enough (H : P x) by now subst P; simpl in H; rewrite E in H. clear E y. destruct x as [|p]; [reflexivity|revert p]. assert (H : forall P, (forall p, P (xI p)) -> (forall p, P (xO p)) -> P xH -> forall p, P p) by now intros ???? []. (do 8 refine (H _ _ _ eq_refl)); exact (fun _ => I). Qed. Lemma to_of_N_iff x y : of_N x = Some y <-> to_N y = x. Proof. split; intro; subst; (apply of_to_N || apply to_of_N); assumption. Qed. Lemma to_of_N_option_map x : option_map to_N (of_N x) = if N.leb x 255 then Some x else None. Proof. cbv [of_N]; repeat match goal with | [ |- context[match ?x with _ => _ end] ] => is_var x; destruct x end; reflexivity. Qed. Lemma to_N_bounded x : to_N x <= 255. Proof. apply N.leb_le. generalize (to_of_N_option_map (to_N x)). rewrite of_to_N. now destruct (N.leb (to_N x) 255). Qed. Lemma of_N_None_iff x : of_N x = None <-> 255 < x. Proof. assert (H := to_of_N_option_map x). split. - intros E. rewrite E in H. now destruct (N.leb_spec x 255). - intros E%N.leb_gt. rewrite E in H. now destruct (of_N x). Qed. Lemma to_N_via_nat x : to_N x = N.of_nat (to_nat x). Proof. destruct x; reflexivity. Qed. Lemma to_nat_via_N x : to_nat x = N.to_nat (to_N x). Proof. destruct x; reflexivity. Qed. Lemma of_N_via_nat x : of_N x = of_nat (N.to_nat x). Proof. destruct (of_N x) as [b|] eqn:H1. { rewrite to_of_N_iff in H1; subst. destruct b; reflexivity. } { rewrite of_N_None_iff, <- N.compare_lt_iff in H1. symmetry; rewrite of_nat_None_iff, <- PeanoNat.Nat.compare_lt_iff. rewrite Nat2N.inj_compare, N2Nat.id; assumption. } Qed. Lemma of_nat_via_N x : of_nat x = of_N (N.of_nat x). Proof. destruct (of_nat x) as [b|] eqn:H1. { rewrite to_of_nat_iff in H1; subst. destruct b; reflexivity. } { rewrite of_nat_None_iff, <- PeanoNat.Nat.compare_lt_iff in H1. symmetry; rewrite of_N_None_iff, <- N.compare_lt_iff. rewrite N2Nat.inj_compare, Nat2N.id; assumption. } Qed. End N. coq-8.20.0/theories/Strings/HexString.v000066400000000000000000000167001466560755400177660ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* p~0~0~0~1 | 2 => p~0~0~1~0 | 3 => p~0~0~1~1 | 4 => p~0~1~0~0 | 5 => p~0~1~0~1 | 6 => p~0~1~1~0 | 7 => p~0~1~1~1 | 8 => p~1~0~0~0 | 9 => p~1~0~0~1 | 10 => p~1~0~1~0 | 11 => p~1~0~1~1 | 12 => p~1~1~0~0 | 13 => p~1~1~0~1 | 14 => p~1~1~1~0 | 15 => p~1~1~1~1 | q~0~0~0~0 => (pos_hex_app p q)~0~0~0~0 | q~0~0~0~1 => (pos_hex_app p q)~0~0~0~1 | q~0~0~1~0 => (pos_hex_app p q)~0~0~1~0 | q~0~0~1~1 => (pos_hex_app p q)~0~0~1~1 | q~0~1~0~0 => (pos_hex_app p q)~0~1~0~0 | q~0~1~0~1 => (pos_hex_app p q)~0~1~0~1 | q~0~1~1~0 => (pos_hex_app p q)~0~1~1~0 | q~0~1~1~1 => (pos_hex_app p q)~0~1~1~1 | q~1~0~0~0 => (pos_hex_app p q)~1~0~0~0 | q~1~0~0~1 => (pos_hex_app p q)~1~0~0~1 | q~1~0~1~0 => (pos_hex_app p q)~1~0~1~0 | q~1~0~1~1 => (pos_hex_app p q)~1~0~1~1 | q~1~1~0~0 => (pos_hex_app p q)~1~1~0~0 | q~1~1~0~1 => (pos_hex_app p q)~1~1~0~1 | q~1~1~1~0 => (pos_hex_app p q)~1~1~1~0 | q~1~1~1~1 => (pos_hex_app p q)~1~1~1~1 end. Module Raw. Fixpoint of_pos (p : positive) (rest : string) : string := match p with | 1 => String "1" rest | 2 => String "2" rest | 3 => String "3" rest | 4 => String "4" rest | 5 => String "5" rest | 6 => String "6" rest | 7 => String "7" rest | 8 => String "8" rest | 9 => String "9" rest | 10 => String "a" rest | 11 => String "b" rest | 12 => String "c" rest | 13 => String "d" rest | 14 => String "e" rest | 15 => String "f" rest | p'~0~0~0~0 => of_pos p' (String "0" rest) | p'~0~0~0~1 => of_pos p' (String "1" rest) | p'~0~0~1~0 => of_pos p' (String "2" rest) | p'~0~0~1~1 => of_pos p' (String "3" rest) | p'~0~1~0~0 => of_pos p' (String "4" rest) | p'~0~1~0~1 => of_pos p' (String "5" rest) | p'~0~1~1~0 => of_pos p' (String "6" rest) | p'~0~1~1~1 => of_pos p' (String "7" rest) | p'~1~0~0~0 => of_pos p' (String "8" rest) | p'~1~0~0~1 => of_pos p' (String "9" rest) | p'~1~0~1~0 => of_pos p' (String "a" rest) | p'~1~0~1~1 => of_pos p' (String "b" rest) | p'~1~1~0~0 => of_pos p' (String "c" rest) | p'~1~1~0~1 => of_pos p' (String "d" rest) | p'~1~1~1~0 => of_pos p' (String "e" rest) | p'~1~1~1~1 => of_pos p' (String "f" rest) end. Fixpoint to_N (s : string) (rest : N) : N := match s with | "" => rest | String ch s' => to_N s' match ascii_to_digit ch with | Some v => N.add v (N.mul 16 rest) | None => N0 end end. Fixpoint to_N_of_pos (p : positive) (rest : string) (base : N) {struct p} : to_N (of_pos p rest) base = to_N rest match base with | N0 => N.pos p | Npos v => Npos (pos_hex_app v p) end. Proof. do 4 try destruct p as [p|p|]; destruct base; try reflexivity; cbn; rewrite to_N_of_pos; reflexivity. Qed. End Raw. Definition of_pos (p : positive) : string := String "0" (String "x" (Raw.of_pos p "")). Definition of_N (n : N) : string := match n with | N0 => "0x0" | Npos p => of_pos p end. Definition of_Z (z : Z) : string := match z with | Zneg p => String "-" (of_pos p) | Z0 => "0x0" | Zpos p => of_pos p end. Definition of_nat (n : nat) : string := of_N (N.of_nat n). Definition to_N (s : string) : N := match s with | String s0 (String so s) => if ascii_dec s0 "0" then if ascii_dec so "x" then Raw.to_N s N0 else N0 else N0 | _ => N0 end. Definition to_pos (s : string) : positive := match to_N s with | N0 => 1 | Npos p => p end. Definition to_Z (s : string) : Z := let '(is_neg, n) := match s with | String s0 s' => if ascii_dec s0 "-" then (true, to_N s') else (false, to_N s) | EmptyString => (false, to_N s) end in match n with | N0 => Z0 | Npos p => if is_neg then Zneg p else Zpos p end. Definition to_nat (s : string) : nat := N.to_nat (to_N s). Lemma to_N_of_N (n : N) : to_N (of_N n) = n. Proof. destruct n; [ reflexivity | apply Raw.to_N_of_pos ]. Qed. Lemma to_Z_of_Z (z : Z) : to_Z (of_Z z) = z. Proof. cbv [of_Z to_Z]; destruct z as [|z|z]; cbn; try reflexivity; rewrite Raw.to_N_of_pos; cbn; reflexivity. Qed. Lemma to_nat_of_nat (n : nat) : to_nat (of_nat n) = n. Proof. cbv [to_nat of_nat]; rewrite to_N_of_N, Nnat.Nat2N.id; reflexivity. Qed. Lemma to_pos_of_pos (p : positive) : to_pos (of_pos p) = p. Proof. cbv [of_pos to_pos to_N]; cbn; rewrite Raw.to_N_of_pos; cbn; reflexivity. Qed. Example of_pos_1 : of_pos 1 = "0x1" := eq_refl. Example of_pos_2 : of_pos 2 = "0x2" := eq_refl. Example of_pos_3 : of_pos 3 = "0x3" := eq_refl. Example of_pos_7 : of_pos 7 = "0x7" := eq_refl. Example of_pos_8 : of_pos 8 = "0x8" := eq_refl. Example of_pos_9 : of_pos 9 = "0x9" := eq_refl. Example of_pos_10 : of_pos 10 = "0xa" := eq_refl. Example of_pos_11 : of_pos 11 = "0xb" := eq_refl. Example of_pos_12 : of_pos 12 = "0xc" := eq_refl. Example of_pos_13 : of_pos 13 = "0xd" := eq_refl. Example of_pos_14 : of_pos 14 = "0xe" := eq_refl. Example of_pos_15 : of_pos 15 = "0xf" := eq_refl. Example of_pos_16 : of_pos 16 = "0x10" := eq_refl. Example of_N_0 : of_N 0 = "0x0" := eq_refl. Example of_Z_0 : of_Z 0 = "0x0" := eq_refl. Example of_Z_m1 : of_Z (-1) = "-0x1" := eq_refl. Example of_nat_0 : of_nat 0 = "0x0" := eq_refl. coq-8.20.0/theories/Strings/OctalString.v000066400000000000000000000125131466560755400203020ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* p~0~0~1 | 2 => p~0~1~0 | 3 => p~0~1~1 | 4 => p~1~0~0 | 5 => p~1~0~1 | 6 => p~1~1~0 | 7 => p~1~1~1 | q~0~0~0 => (pos_oct_app p q)~0~0~0 | q~0~0~1 => (pos_oct_app p q)~0~0~1 | q~0~1~0 => (pos_oct_app p q)~0~1~0 | q~0~1~1 => (pos_oct_app p q)~0~1~1 | q~1~0~0 => (pos_oct_app p q)~1~0~0 | q~1~0~1 => (pos_oct_app p q)~1~0~1 | q~1~1~0 => (pos_oct_app p q)~1~1~0 | q~1~1~1 => (pos_oct_app p q)~1~1~1 end. Module Raw. Fixpoint of_pos (p : positive) (rest : string) : string := match p with | 1 => String "1" rest | 2 => String "2" rest | 3 => String "3" rest | 4 => String "4" rest | 5 => String "5" rest | 6 => String "6" rest | 7 => String "7" rest | p'~0~0~0 => of_pos p' (String "0" rest) | p'~0~0~1 => of_pos p' (String "1" rest) | p'~0~1~0 => of_pos p' (String "2" rest) | p'~0~1~1 => of_pos p' (String "3" rest) | p'~1~0~0 => of_pos p' (String "4" rest) | p'~1~0~1 => of_pos p' (String "5" rest) | p'~1~1~0 => of_pos p' (String "6" rest) | p'~1~1~1 => of_pos p' (String "7" rest) end. Fixpoint to_N (s : string) (rest : N) : N := match s with | "" => rest | String ch s' => to_N s' match ascii_to_digit ch with | Some v => N.add v (N.mul 8 rest) | None => N0 end end. Fixpoint to_N_of_pos (p : positive) (rest : string) (base : N) {struct p} : to_N (of_pos p rest) base = to_N rest match base with | N0 => N.pos p | Npos v => Npos (pos_oct_app v p) end. Proof. do 3 try destruct p as [p|p|]; destruct base; try reflexivity; cbn; rewrite to_N_of_pos; reflexivity. Qed. End Raw. Definition of_pos (p : positive) : string := String "0" (String "o" (Raw.of_pos p "")). Definition of_N (n : N) : string := match n with | N0 => "0o0" | Npos p => of_pos p end. Definition of_Z (z : Z) : string := match z with | Zneg p => String "-" (of_pos p) | Z0 => "0o0" | Zpos p => of_pos p end. Definition of_nat (n : nat) : string := of_N (N.of_nat n). Definition to_N (s : string) : N := match s with | String s0 (String so s) => if ascii_dec s0 "0" then if ascii_dec so "o" then Raw.to_N s N0 else N0 else N0 | _ => N0 end. Definition to_pos (s : string) : positive := match to_N s with | N0 => 1 | Npos p => p end. Definition to_Z (s : string) : Z := let '(is_neg, n) := match s with | String s0 s' => if ascii_dec s0 "-" then (true, to_N s') else (false, to_N s) | EmptyString => (false, to_N s) end in match n with | N0 => Z0 | Npos p => if is_neg then Zneg p else Zpos p end. Definition to_nat (s : string) : nat := N.to_nat (to_N s). Lemma to_N_of_N (n : N) : to_N (of_N n) = n. Proof. destruct n; [ reflexivity | apply Raw.to_N_of_pos ]. Qed. Lemma to_Z_of_Z (z : Z) : to_Z (of_Z z) = z. Proof. cbv [of_Z to_Z]; destruct z as [|z|z]; cbn; try reflexivity; rewrite Raw.to_N_of_pos; cbn; reflexivity. Qed. Lemma to_nat_of_nat (n : nat) : to_nat (of_nat n) = n. Proof. cbv [to_nat of_nat]; rewrite to_N_of_N, Nnat.Nat2N.id; reflexivity. Qed. Lemma to_pos_of_pos (p : positive) : to_pos (of_pos p) = p. Proof. cbv [of_pos to_pos to_N]; cbn; rewrite Raw.to_N_of_pos; cbn; reflexivity. Qed. Example of_pos_1 : of_pos 1 = "0o1" := eq_refl. Example of_pos_2 : of_pos 2 = "0o2" := eq_refl. Example of_pos_3 : of_pos 3 = "0o3" := eq_refl. Example of_pos_7 : of_pos 7 = "0o7" := eq_refl. Example of_pos_8 : of_pos 8 = "0o10" := eq_refl. Example of_N_0 : of_N 0 = "0o0" := eq_refl. Example of_Z_0 : of_Z 0 = "0o0" := eq_refl. Example of_Z_m1 : of_Z (-1) = "-0o1" := eq_refl. Example of_nat_0 : of_nat 0 = "0o0" := eq_refl. coq-8.20.0/theories/Strings/PString.v000066400000000000000000000564321466560755400174470ustar00rootroot00000000000000Require Import Uint63. Require Export PrimString. Require Export PrimStringAxioms. Require Import Coq.micromega.Lia. Require Import Coq.micromega.ZifyUint63. Require Import Coq.micromega.Zify. Require Import Coq.Numbers.Cyclic.Int63.Ring63. Require Import ZArith. #[local] Open Scope Z_scope. #[local] Open Scope list_scope. #[local] Arguments to_Z _/ : simpl nomatch. #[local] Instance Op_max_length : ZifyClasses.CstOp max_length := { TCst := 16777211%Z ; TCstInj := eq_refl }. Add Zify CstOp Op_max_length. #[local] Ltac case_if := lazymatch goal with | |- context C [if ?b then _ else _] => destruct b eqn:? | H : context C [if ?b then _ else _] |- _ => destruct b eqn:? end. (** Derived properties of to_list and of_list. *) Lemma to_list_inj (s1 s2 : string) : to_list s1 = to_list s2 -> s1 = s2. Proof. intros H. rewrite <-(of_to_list s1), <-(of_to_list s2), H. reflexivity. Qed. Lemma to_of_list (l : list char63) : List.Forall char63_valid l -> Z.of_nat (List.length l) <= to_Z max_length -> to_list (of_list l) = l. Proof. induction l as [|c l IH]; simpl; intros Hvalid Hlen; [reflexivity|]. apply List.Forall_cons_iff in Hvalid as [Hvalid1 Hvalid2]. rewrite cat_spec, make_spec, Hvalid1, IH; [|assumption|simpl; lia]. rewrite List.firstn_all2; [reflexivity|simpl; lia]. Qed. (** Alternative specifications with explicit bounds. *) Lemma get_spec_in_bounds (s : string) (i : int) : to_Z i < to_Z (length s) -> char63_valid (get s i) /\ List.nth_error (to_list s) (to_nat i) = Some (get s i). Proof. intros Hlt. rewrite get_spec. split. - pose proof to_list_char63_valid s as Hs. apply List.Forall_nth; [assumption|]. rewrite <-length_spec. lia. - apply List.nth_error_nth'. rewrite <-length_spec. lia. Qed. Lemma get_spec_not_in_bounds (s : string) (i : int) : to_Z (length s) <= to_Z i -> get s i = 0%uint63. Proof. intros Hle. rewrite get_spec, List.nth_overflow; [reflexivity|]. rewrite <-length_spec. lia. Qed. Lemma make_spec_valid_length (i : int) (c : char63) : to_Z i <= to_Z max_length -> to_list (make i c) = List.repeat (c land 255)%uint63 (to_nat i). Proof. intros Hle. rewrite make_spec, Nat.min_l; [reflexivity | lia]. Qed. Lemma make_spec_invalid_length (i : int) (c : char63) : to_Z max_length < to_Z i -> to_list (make i c) = List.repeat (c land 255)%uint63 (to_nat max_length). Proof. intros Hle. rewrite make_spec, Nat.min_r; [reflexivity | lia]. Qed. Lemma cat_spec_valid_length (s1 s2 : string) : to_Z (length s1) + to_Z (length s2) <= to_Z max_length -> to_list (cat s1 s2) = to_list s1 ++ to_list s2. Proof. intros Hlen. rewrite cat_spec, List.firstn_all2; [reflexivity|]. rewrite List.length_app, <-!length_spec. lia. Qed. (** * Properties of string length *) Lemma valid_length (s : string) : to_Z (length s) <= to_Z max_length. Proof. pose proof (to_list_length s) as Hvalid. rewrite <-(length_spec s) in Hvalid. lia. Qed. Lemma length_spec_int (s : string) : length s = of_Z (Z.of_nat (List.length (to_list s))). Proof. apply to_Z_inj. rewrite <-length_spec. rewrite of_Z_spec, Z.mod_small, Z2Nat.id; lia. Qed. Lemma length_spec_Z (s : string) : to_Z (length s) = Z.of_nat (List.length (to_list s)). Proof. rewrite <-length_spec. rewrite Z2Nat.id; lia. Qed. Lemma make_length_spec (i : int) (c : char63) : to_Z i <= to_Z max_length -> length (make i c) = i. Proof. intros Hvalid. pose proof (length_spec (make i c)) as Hlen. rewrite (make_spec_valid_length i c Hvalid) in Hlen. rewrite List.repeat_length in Hlen. lia. Qed. Lemma sub_length_spec (s : string) (off len : int) : to_Z off <= to_Z (length s) -> to_Z len <= to_Z (length s) - to_Z off -> length (sub s off len) = len. Proof. intros Hoff Hlen. pose proof (length_spec (sub s off len)) as Hs. rewrite sub_spec, List.firstn_length_le in Hs; [lia|]. rewrite List.length_skipn, <-length_spec. lia. Qed. Lemma cat_length_spec (s1 s2 : string) : length (cat s1 s2) = Uint63.min max_length (length s1 + length s2)%uint63. Proof. rewrite length_spec_int, cat_spec, List.length_firstn. rewrite Nat2Z.inj_min, Z2Nat.id; [|lia]. rewrite List.length_app, <-!length_spec. rewrite <-Z2Nat.inj_add; [|lia|lia]. rewrite Z2Nat.id; [|lia]. assert (to_Z (length s1) + to_Z (length s2) = (to_Z (length s1) + to_Z (length s2)) mod wB) as ->. { rewrite Z.mod_small; [reflexivity|]. split; [lia|]. pose proof valid_length s1 as Hs1. pose proof valid_length s2 as Hs2. simpl in *. lia. } rewrite <-add_spec, <-Uint63.min_spec, of_to_Z. reflexivity. Qed. Lemma cat_length_spec_no_overflow (s1 s2 : string) : to_Z (length s1) + to_Z (length s2) <= to_Z max_length -> length (cat s1 s2) = (length s1 + length s2)%uint63. Proof. intros Hlen. rewrite cat_length_spec. unfold min. destruct (max_length ≤? length s1 + length s2)%uint63 eqn:Hle; [|reflexivity]. rewrite leb_spec, add_spec, Z.mod_small in Hle; [|lia]. apply to_Z_inj. rewrite add_spec, Z.mod_small; lia. Qed. (** * Properties of string get *) Lemma get_char63_valid (s : string) (i : int) : char63_valid (get s i). Proof. rewrite get_spec. destruct (to_nat i to_Z j < to_Z i -> get (make i c) j = (c land 255)%uint63. Proof. intros Hmax Hj. rewrite get_spec, make_spec. rewrite List.nth_repeat_lt; [reflexivity|lia]. Qed. Lemma make_get_spec_valid (i j : int) (c : char63) : to_Z j < to_Z max_length -> to_Z j < to_Z i -> char63_valid c -> get (make i c) j = c. Proof. intros. rewrite make_get_spec; assumption. Qed. Lemma sub_get_spec (s : string) (off len i : int) : to_Z off + to_Z i < wB -> to_Z i < to_Z len -> get (sub s off len) i = get s (off + i). Proof. intros Hno Hi. rewrite !get_spec, sub_spec. rewrite List.nth_firstn, List.nth_skipn. case_if; [|lia]. f_equal. rewrite Uint63.add_spec, Z.mod_small; lia. Qed. Lemma cat_get_spec_l (s1 s2 : string) (i : int) : to_Z i < to_Z (length s1) -> get (cat s1 s2) i = get s1 i. Proof. intros Hi. pose proof valid_length s1 as Hs1. rewrite !get_spec, cat_spec. rewrite List.nth_firstn. case_if; [|lia]. rewrite List.app_nth1; [reflexivity|]. rewrite <-length_spec. lia. Qed. Lemma cat_get_spec_r (s1 s2 : string) (i : int) : to_Z (length s1) <= to_Z i -> to_Z i < to_Z max_length -> get (cat s1 s2) i = get s2 (i - length s1). Proof. intros H1 H2. rewrite !get_spec, cat_spec. rewrite List.nth_firstn. case_if; [|lia]. rewrite List.app_nth2; [|rewrite <-length_spec; lia]. rewrite <-length_spec, Uint63.sub_spec, Z.mod_small; [|lia]. rewrite Z2Nat.inj_sub; [reflexivity|lia]. Qed. (** * Properties of string comparison *) Lemma char63_compare_refl (c1 c2 : char63) : char63_compare c1 c2 = Eq <-> c1 = c2. Proof. rewrite Uint63.compare_spec, Z.compare_eq_iff. split; [apply to_Z_inj|intros <-; reflexivity]. Qed. Lemma char63_compare_antisym (c1 c2 : char63) : char63_compare c2 c1 = CompOpp (char63_compare c1 c2). Proof. rewrite !Uint63.compare_spec. apply Z.compare_antisym. Qed. Lemma char63_compare_trans (c1 c2 c3 : char63) (c : comparison) : char63_compare c1 c2 = c -> char63_compare c2 c3 = c -> char63_compare c1 c3 = c. Proof. destruct c. - rewrite !char63_compare_refl. intros -> ->. reflexivity. - rewrite !Uint63.compare_spec. apply Zcompare_Lt_trans. - rewrite !Uint63.compare_spec. apply Zcompare_Gt_trans. Qed. Lemma compare_refl (s : string) : compare s s = Eq. Proof. rewrite PrimStringAxioms.compare_spec. apply (List.list_compare_refl _ char63_compare_refl). reflexivity. Qed. Lemma compare_antisym (s1 s2 : string) : compare s2 s1 = CompOpp (compare s1 s2). Proof. rewrite !PrimStringAxioms.compare_spec. apply List.list_compare_antisym. - apply char63_compare_refl. - apply char63_compare_antisym. Qed. Lemma compare_trans (c : comparison) (s1 s2 s3 : string) : compare s1 s2 = c -> compare s2 s3 = c -> compare s1 s3 = c. Proof. rewrite !PrimStringAxioms.compare_spec. apply List.list_compare_trans. - apply char63_compare_refl. - apply char63_compare_trans. - apply char63_compare_antisym. Qed. Lemma compare_eq_correct (s1 s2 : string) : compare s1 s2 = Eq -> s1 = s2. Proof. rewrite compare_spec, (List.list_compare_refl _ char63_compare_refl). apply to_list_inj. Qed. Lemma string_eq_ext (s1 s2 : string) : (length s1 = length s2 /\ forall i, to_Z i < to_Z (length s1) -> get s1 i = get s2 i) -> s1 = s2. Proof. intros [Hlen Hget]. apply to_list_inj. apply (List.nth_ext _ _ 0%uint63 0%uint63). + rewrite <-!length_spec, Hlen. reflexivity. + intros n Hn. rewrite <-length_spec in Hn. assert (n = to_nat (of_nat n)) as ->. { rewrite of_Z_spec, Z.mod_small, Nat2Z.id; lia. } rewrite <-!get_spec. apply Hget. rewrite of_Z_spec, Z.mod_small; lia. Qed. Lemma to_list_firstn_skipn_middle (s : string) (i : int) : to_Z i < to_Z (length s) -> to_list s = List.firstn (to_nat i) (to_list s) ++ get s i :: List.skipn (to_nat (i + 1)) (to_list s). Proof. intros Hi. assert (to_nat (i + 1) = S (to_nat i)) as ->. { rewrite add_spec, Z.mod_small, Z2Nat.inj_add; lia. } symmetry. apply List.firstn_skipn_middle. rewrite get_spec. apply List.nth_error_nth'. rewrite <-length_spec. lia. Qed. Lemma compare_spec (s1 s2 : string) (c : comparison) : compare s1 s2 = c <-> exists i, to_Z i <= to_Z (length s1) /\ to_Z i <= to_Z (length s2) /\ (forall j, to_Z j < to_Z i -> get s1 j = get s2 j) /\ match (i =? length s1, i =? length s2)%uint63 with | (true , true ) => c = Eq | (true , false) => c = Lt | (false, true ) => c = Gt | (false, false) => match Uint63.compare (get s1 i) (get s2 i) with | Eq => False | ci => c = ci end end. Proof. rewrite compare_spec. split. - pose proof List.list_compareP _ char63_compare_refl (to_list s1) (to_list s2) as Hcmp. revert Hcmp. remember (List.list_compare _ _ _) as c' eqn:Hc'. intros Hcmp Hcc'. induction Hcmp as [H|y ys H|x xs H|????? H1 H2 H|????? H1 H2 H]; clear Hc'; subst c. + apply to_list_inj in H. subst s2. exists (length s1). rewrite eqb_eq, Z.eqb_refl. repeat split; lia. + exists (length s1). rewrite !eqb_eq, Z.eqb_refl, !length_spec_Z, H, List.length_app. repeat split; [lia|lia| |]. * intros j Hj. rewrite !get_spec, H. rewrite List.app_nth1; [reflexivity|lia]. * simpl in *. case_if; [exfalso; lia|reflexivity]. + exists (length s2). rewrite !eqb_eq, Z.eqb_refl, !length_spec_Z, H, List.length_app. repeat split; [lia|lia| |]. * intros j Hj. rewrite !get_spec, H. rewrite List.app_nth1; [reflexivity|lia]. * simpl in *. case_if; [exfalso; lia|reflexivity]. + exists (of_nat (List.length prefix)). assert (Z.of_nat (List.length prefix) < wB) as Hprefix. { pose proof f_equal (@List.length _) H1 as Hlen. pose proof valid_length s1 as Hmax. rewrite <-length_spec, List.length_app in Hlen. lia. } rewrite !eqb_eq, !length_spec_Z, H1, H2, !List.length_app. rewrite of_Z_spec, Z.mod_small; [|lia]. repeat split; [lia|lia| |]. * intros i Hj. rewrite !get_spec, H1, H2, !List.app_nth1; [reflexivity|lia|lia]. * simpl in *; repeat case_if; try lia. rewrite !get_spec, H1, H2. do 2 (rewrite List.app_nth2; [|rewrite of_Z_spec, Z.mod_small; lia]). rewrite !of_Z_spec, Z.mod_small, Nat2Z.id, Nat.sub_diag; [|lia]. simpl. rewrite H. reflexivity. + exists (of_nat (List.length prefix)). assert (Z.of_nat (List.length prefix) < wB) as Hprefix. { pose proof f_equal (@List.length _) H1 as Hlen. pose proof valid_length s1 as Hmax. rewrite <-length_spec, List.length_app in Hlen. lia. } rewrite !eqb_eq, !length_spec_Z, H1, H2, !List.length_app. rewrite of_Z_spec, Z.mod_small; [|lia]. repeat split; [lia|lia| |]. * intros i Hj. rewrite !get_spec, H1, H2, !List.app_nth1; [reflexivity|lia|lia]. * simpl in *; repeat case_if; try lia. rewrite !get_spec, H1, H2. do 2 (rewrite List.app_nth2; [|rewrite of_Z_spec, Z.mod_small; lia]). rewrite !of_Z_spec, Z.mod_small, Nat2Z.id, Nat.sub_diag; [|lia]. simpl. rewrite H. reflexivity. - intros (i & Hs1 & Hs2 & Hget & H). pose proof valid_length s1 as Hlen1. pose proof valid_length s2 as Hlen2. apply (List.list_compare_spec_complete char63_compare_refl). repeat case_if; subst. + apply List.ListCompareEq. f_equal. apply string_eq_ext. split; [lia|]. intros j Hj. apply Hget. lia. + assert (to_Z (length s1) < to_Z (length s2)) as Hlen by lia. assert (i = length s1) by lia; subst i. apply (List.ListCompareShorter _ _ (get s2 (length s1)) (List.skipn (to_nat (length s1 + 1)) (to_list s2))). rewrite (to_list_firstn_skipn_middle s2 (length s1)) at 1; [|lia]. f_equal. apply (List.nth_ext _ _ 0%uint63 0%uint63). { rewrite List.length_firstn, <-!length_spec. lia. } rewrite List.length_firstn, <-!length_spec, Nat.min_l; [|lia]. intros n Hn. rewrite List.nth_firstn. case_if; [|lia]. pose proof Hget (of_nat n). rewrite !get_spec in H. rewrite of_Z_spec, Z.mod_small, Nat2Z.id in H; [|lia]. symmetry. apply H. lia. + assert (to_Z (length s2) < to_Z (length s1)) as Hlen by lia. assert (i = length s2) by lia; subst i. eapply (List.ListCompareLonger _ _ (get s1 (length s2)) (List.skipn (to_nat (length s2 + 1)) (to_list s1))). rewrite (to_list_firstn_skipn_middle s1 (length s2)) at 1; [|lia]. f_equal. apply (List.nth_ext _ _ 0%uint63 0%uint63). { rewrite List.length_firstn, <-!length_spec. lia. } rewrite List.length_firstn, <-!length_spec, Nat.min_l; [|lia]. intros n Hn. rewrite List.nth_firstn. case_if; [|lia]. pose proof Hget (of_nat n). rewrite !get_spec in H. rewrite of_Z_spec, Z.mod_small, Nat2Z.id in H; [|lia]. apply H. lia. + enough ( exists p l1 l2, to_list s1 = p ++ get s1 i :: l1 /\ to_list s2 = p ++ get s2 i :: l2 ) as (p & l1 & l2 & Hp1 & Hp2). { revert H. destruct (_ ?= _)%uint63 eqn:Hi; [intros []|intros -> ..]. - eapply List.ListCompareLt; solve [eauto]. - eapply List.ListCompareGt; solve [eauto]. } exists (to_list (sub s1 0 i)). exists (to_list (sub s1 (i + 1) (length s1 - i - 1))). exists (to_list (sub s2 (i + 1) (length s2 - i - 1))). rewrite !sub_spec; simpl. rewrite !(List.firstn_all2 (n:=to_nat (length _ - _ - _))). 2-3: repeat progress rewrite ?List.length_skipn, ?Uint63.add_spec, ?Uint63.sub_spec, ?Z.mod_small, ?Z.min_r, <-?length_spec; simpl; lia. split; [apply to_list_firstn_skipn_middle; lia|]. rewrite (to_list_firstn_skipn_middle s2 i) at 1; [|lia]. enough (sub s2 0 i = sub s1 0 i) as H12. { f_equal. apply (f_equal to_list) in H12. revert H12. rewrite !sub_spec. simpl. intros ->. reflexivity. } apply string_eq_ext; split. { rewrite !sub_length_spec; lia. } rewrite sub_length_spec; [|lia|lia]. intros j Hj. rewrite !sub_get_spec; [|lia..]. ring_simplify (0 + j)%uint63. symmetry. apply Hget. assumption. Qed. Lemma compare_eq (s1 s2 : string) : compare s1 s2 = Eq <-> s1 = s2. Proof. split; [apply compare_eq_correct|intros []; apply compare_refl]. Qed. Lemma compare_lt_spec (s1 s2 : string) : compare s1 s2 = Lt <-> exists i, to_Z i <= to_Z (length s1) /\ to_Z i <= to_Z (length s2) /\ (forall j, to_Z j < to_Z i -> get s1 j = get s2 j) /\ ((i = length s1 /\ to_Z i < to_Z (length s2)) \/ (to_Z i < to_Z (length s1) /\ to_Z i < to_Z (length s2) /\ char63_compare (get s1 i) (get s2 i) = Lt)). Proof. rewrite compare_spec. setoid_rewrite Uint63.compare_def_spec; unfold compare_def. split. - intros [i (H1 & H2 & Hget & Heq)]; exists i. repeat split; [assumption..|]. repeat case_if; try inversion Heq; try lia. right. repeat split; lia. - intros [i (H1 & H2 & Hget & H)]; exists i. repeat split; [assumption..|]. destruct H as [(-> & Hi)|(Hi1 & Hi2 & H)]. + repeat case_if; try reflexivity; lia. + repeat case_if; try reflexivity; try inversion H; lia. Qed. (** * Properties of make *) Lemma make_0 (c : char63) : make 0 c = ""%pstring. Proof. apply to_list_inj. rewrite make_spec. reflexivity. Qed. (** * Properties of cat *) Lemma length_0_empty (s : string) : length s = 0%uint63 -> s = ""%pstring. Proof. pose proof valid_length s as Hs. rewrite length_spec_Z in Hs. rewrite length_spec_int. intros H%eq_int_inj. rewrite of_Z_spec, Z.mod_small in H; [|lia]. apply to_list_inj. destruct (to_list s); simpl in *; [reflexivity|lia]. Qed. Lemma cat_empty_l (s : string) : cat ""%pstring s = s. Proof. pose proof valid_length s as Hs. apply string_eq_ext. split. - rewrite cat_length_spec_no_overflow; simpl; [ring|assumption]. - intros i Hi. rewrite cat_length_spec_no_overflow in Hi; [|simpl in * |- *; lia]. simpl in Hi. ring_simplify (0 + length s)%uint63 in Hi. rewrite cat_get_spec_r; simpl in *; [|lia|lia]. ring_simplify (i - 0)%uint63. reflexivity. Qed. Lemma cat_empty_r (s : string) : cat s ""%pstring = s. Proof. pose proof valid_length s as Hs. apply string_eq_ext. split. - rewrite cat_length_spec_no_overflow; simpl in *; [ring|lia]. - intros i Hi. rewrite cat_length_spec_no_overflow in Hi; [|simpl in * |- *; lia]. simpl in Hi. ring_simplify (length s + 0)%uint63 in Hi. rewrite cat_get_spec_l; [reflexivity|assumption]. Qed. Lemma cat_assoc (s1 s2 s3 : string) : cat (cat s1 s2) s3 = cat s1 (cat s2 s3). Proof. apply string_eq_ext. rewrite !cat_length_spec. pose proof valid_length s1 as Hs1. pose proof valid_length s2 as Hs2. pose proof valid_length s3 as Hs3. simpl in *. rewrite !min_add_min_n_same; [|rewrite add_spec, Z.mod_small; lia]. rewrite !min_add_n_min_same; [|rewrite add_spec, Z.mod_small; lia]. split; [f_equal; ring|]. intros i Hi. rewrite !get_spec, !cat_spec. rewrite Uint63.min_spec, !add_spec, !Z.mod_small in Hi. 2-3: repeat rewrite Z.mod_small; lia. rewrite !List.nth_firstn. case_if; [|reflexivity]. destruct (to_Z i to_Z len2 <= to_Z len1 - to_Z off2 -> sub (sub s off1 len1) off2 len2 = sub s (off1 + off2)%uint63 len2. Proof. intros H1 H2. apply to_list_inj. rewrite !sub_spec. rewrite <-H1, Z2Nat.inj_add; [|lia|lia]. clear H1. rewrite !List.skipn_firstn_comm. rewrite List.firstn_firstn, List.skipn_skipn. f_equal; [lia|f_equal; lia]. Qed. (** Properties of to_list and of_list *) Lemma of_list_length (l : list char63) : Z.of_nat (List.length l) <= to_Z max_length -> length (of_list l) = of_Z (Z.of_nat (List.length l)). Proof. induction l as [|c l IH]; [reflexivity|]. assert (List.length (c :: l) = S (List.length l)) as -> by reflexivity. rewrite Nat2Z.inj_succ. intros Hlen; simpl. pose proof (IH ltac:(lia)) as IH. rewrite cat_length_spec_no_overflow. 2: rewrite IH, make_length_spec, of_Z_spec, Z.mod_small; lia. rewrite make_length_spec; [|lia]. rewrite IH. apply to_Z_inj. rewrite of_Z_spec, Z.mod_small; [|lia]. rewrite Uint63.add_spec, Z.mod_small. 2: rewrite of_Z_spec, Z.mod_small; lia. rewrite of_Z_spec, Z.mod_small; lia. Qed. Lemma of_list_app (l1 l2 : list char63) : of_list (l1 ++ l2) = cat (of_list l1) (of_list l2). Proof. revert l2; induction l1 as [|c l1 IH]; intros l2; simpl. - rewrite cat_empty_l. reflexivity. - rewrite IH. rewrite cat_assoc. reflexivity. Qed. Lemma to_list_cat (s1 s2 : string) : (to_Z (length s1) + to_Z (length s2) <= to_Z max_length)%Z -> to_list (cat s1 s2) = app (to_list s1) (to_list s2). Proof. rewrite cat_spec. intros Hlen. rewrite List.firstn_all2; [reflexivity|]. rewrite List.length_app, <-!length_spec. lia. Qed. (** * Ordered type *) Require OrderedType. Module OT <: OrderedType.OrderedType with Definition t := string. Definition t := string. Definition eq s1 s2 := compare s1 s2 = Eq. Definition lt s1 s2 := compare s1 s2 = Lt. Lemma eq_refl (s : t) : eq s s. Proof. apply compare_refl. Qed. Lemma eq_sym (s1 s2 : t) : eq s1 s2 -> eq s2 s1. Proof. unfold eq. intros Heq. rewrite compare_antisym, Heq. reflexivity. Qed. Lemma eq_trans (s1 s2 s3 : t) : eq s1 s2 -> eq s2 s3 -> eq s1 s3. Proof. unfold eq. apply compare_trans. Qed. Lemma lt_trans (s1 s2 s3 : t) : lt s1 s2 -> lt s2 s3 -> lt s1 s3. Proof. unfold lt. apply compare_trans. Qed. Lemma lt_not_eq (s1 s2 : t) : lt s1 s2 -> not (eq s1 s2). Proof. unfold lt, eq. intros ->. discriminate. Qed. #[program] Definition compare (s1 s2 : t) : OrderedType.Compare lt eq s1 s2 := match compare s1 s2 with | Eq => OrderedType.EQ _ | Lt => OrderedType.LT _ | Gt => OrderedType.GT _ end. Next Obligation. symmetry. assumption. Defined. Next Obligation. symmetry. assumption. Defined. Next Obligation. unfold lt. rewrite compare_antisym, <-Heq_anonymous. reflexivity. Defined. Hint Immediate eq_sym : core. Hint Resolve eq_refl eq_trans lt_not_eq lt_trans : core. Definition eq_dec (s1 s2 : t) : {eq s1 s2} + {~ eq s1 s2}. Proof. unfold eq. destruct (PrimString.compare s1 s2). - left. reflexivity. - right. discriminate. - right. discriminate. Qed. End OT. coq-8.20.0/theories/Strings/PrimString.v000066400000000000000000000031621466560755400201470ustar00rootroot00000000000000Require Import PrimInt63. Definition char63 := int. Primitive string := #string_type. Primitive max_length : int := #string_max_length. Primitive make : int -> char63 -> string := #string_make. Primitive length : string -> int := #string_length. Primitive get : string -> int -> char63 := #string_get. Primitive sub : string -> int -> int -> string := #string_sub. Primitive cat : string -> string -> string := #string_cat. Primitive compare : string -> string -> comparison := #string_compare. Module Export PStringNotations. Record string_wrapper := wrap_string {string_wrap : string}. Definition id_string (s : string) : string := s. Register string as strings.pstring.type. Register string_wrapper as strings.pstring.string_wrapper. Register wrap_string as strings.pstring.wrap_string. Declare Scope pstring_scope. Delimit Scope pstring_scope with pstring. Bind Scope pstring_scope with string. String Notation string id_string id_string : pstring_scope. End PStringNotations. Record char63_wrapper := wrap_char63 { char63_wrap : char63 }. Module Export Char63Notations. Coercion char63_wrap : char63_wrapper >-> char63. Definition parse (s : string) : option char63_wrapper := if PrimInt63.eqb (length s) 1%uint63 then Some (wrap_char63 (get s 0)) else None. Definition print (i : char63_wrapper) : option string := if PrimInt63.ltb i.(char63_wrap) 256%uint63 then Some (make 1 i.(char63_wrap)) else None. Declare Scope char63_scope. Delimit Scope char63_scope with char63. Bind Scope char63_scope with char63. String Notation char63_wrapper parse print : char63_scope. End Char63Notations. coq-8.20.0/theories/Strings/PrimStringAxioms.v000066400000000000000000000031271466560755400213310ustar00rootroot00000000000000Require Import Uint63. Require Import ZArith. Require Import PrimString. Definition char63_valid (c : char63) := (c land 255 = c)%uint63. (** * Conversion to / from lists *) Definition to_list (s : string) : list char63 := List.map (fun i => get s (of_nat i)) (List.seq 0 (to_nat (length s))). Fixpoint of_list (cs : list char63) : string := match cs with | nil => ""%pstring | cons c cs => cat (make 1 c) (of_list cs) end. Axiom of_to_list : forall (s : string), of_list (to_list s) = s. Axiom to_list_length : forall (s : string), List.length (to_list s) <= to_nat max_length. Axiom to_list_char63_valid : forall (s : string), List.Forall char63_valid (to_list s). (** * Axioms relating string operations with list operations *) Axiom length_spec : forall (s : string), to_nat (length s) = List.length (to_list s). Axiom get_spec : forall (s : string) (i : int), get s i = List.nth (to_nat i) (to_list s) 0%uint63. Axiom make_spec : forall (i : int) (c : char63), to_list (make i c) = List.repeat (c land 255)%uint63 (Nat.min (to_nat i) (to_nat max_length)). Axiom sub_spec : forall (s : string) (off len : int), to_list (sub s off len) = List.firstn (to_nat len) (List.skipn (to_nat off) (to_list s)). Axiom cat_spec : forall (s1 s2 : string), to_list (cat s1 s2) = List.firstn (to_nat max_length) (to_list s1 ++ to_list s2). Notation char63_compare := PrimInt63.compare (only parsing). Axiom compare_spec : forall (s1 s2 : string), compare s1 s2 = List.list_compare char63_compare (to_list s1) (to_list s2). coq-8.20.0/theories/Strings/String.v000066400000000000000000000424211466560755400173200ustar00rootroot00000000000000(* -*- coding: utf-8 -*- *) (************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* string -> string. Declare Scope string_scope. Delimit Scope string_scope with string. Bind Scope string_scope with string. Local Open Scope string_scope. Register string as core.string.type. Register EmptyString as core.string.empty. Register String as core.string.string. (** Equality is decidable *) Definition string_dec : forall s1 s2 : string, {s1 = s2} + {s1 <> s2}. Proof. decide equality; apply ascii_dec. Defined. Local Open Scope lazy_bool_scope. Fixpoint eqb s1 s2 : bool := match s1, s2 with | EmptyString, EmptyString => true | String c1 s1', String c2 s2' => Ascii.eqb c1 c2 &&& eqb s1' s2' | _,_ => false end. Infix "=?" := eqb : string_scope. Lemma eqb_spec s1 s2 : Bool.reflect (s1 = s2) (s1 =? s2)%string. Proof. revert s2. induction s1 as [|? s1 IHs1]; intro s2; destruct s2; try (constructor; easy); simpl. case Ascii.eqb_spec; simpl; [intros -> | constructor; now intros [= ]]. case IHs1; [intros ->; now constructor | constructor; now intros [= ]]. Qed. Local Ltac t_eqb := repeat first [ congruence | progress subst | apply conj | match goal with | [ |- context[eqb ?x ?y] ] => destruct (eqb_spec x y) end | intro ]. Lemma eqb_refl x : (x =? x)%string = true. Proof. t_eqb. Qed. Lemma eqb_sym x y : (x =? y)%string = (y =? x)%string. Proof. t_eqb. Qed. Lemma eqb_eq n m : (n =? m)%string = true <-> n = m. Proof. t_eqb. Qed. Lemma eqb_neq x y : (x =? y)%string = false <-> x <> y. Proof. t_eqb. Qed. Lemma eqb_compat: Morphisms.Proper (Morphisms.respectful eq (Morphisms.respectful eq eq)) eqb. Proof. t_eqb. Qed. (** *** Compare strings lexicographically *) Fixpoint compare (s1 s2 : string) : comparison := match s1, s2 with | EmptyString, EmptyString => Eq | EmptyString, String _ _ => Lt | String _ _ , EmptyString => Gt | String c1 s1', String c2 s2' => match Ascii.compare c1 c2 with | Eq => compare s1' s2' | ne => ne end end. Lemma compare_antisym : forall s1 s2 : string, compare s1 s2 = CompOpp (compare s2 s1). Proof. induction s1, s2; intuition. simpl. rewrite Ascii.compare_antisym. destruct (Ascii.compare a0 a); simpl; intuition. Qed. Lemma compare_eq_iff : forall s1 s2 : string, compare s1 s2 = Eq -> s1 = s2. Proof. induction s1, s2; intuition; inversion H. destruct (Ascii.compare a a0) eqn:Heq; try discriminate H1. apply Ascii.compare_eq_iff in Heq. apply IHs1 in H1. subst. reflexivity. Qed. Definition ltb (s1 s2 : string) : bool := if compare s1 s2 is Lt then true else false. Definition leb (s1 s2 : string) : bool := if compare s1 s2 is Gt then false else true. Lemma leb_antisym (s1 s2 : string) : leb s1 s2 = true -> leb s2 s1 = true -> s1 = s2. Proof. unfold leb. rewrite compare_antisym. destruct (compare s2 s1) eqn:Hcmp; simpl in *; intuition. - apply compare_eq_iff in Hcmp. intuition. - discriminate H. - discriminate H0. Qed. Lemma leb_total (s1 s2 : string) : leb s1 s2 = true \/ leb s2 s1 = true. Proof. unfold leb. rewrite compare_antisym. destruct (compare s2 s1); intuition. Qed. Infix "?=" := compare : string_scope. Infix " s2 | String c s1' => String c (s1' ++ s2) end where "s1 ++ s2" := (append s1 s2) : string_scope. (******************************) (** Length *) (******************************) Fixpoint length (s : string) : nat := match s with | EmptyString => 0 | String c s' => S (length s') end. (******************************) (** Nth character of a string *) (******************************) Fixpoint get (n : nat) (s : string) {struct s} : option ascii := match s with | EmptyString => None | String c s' => match n with | O => Some c | S n' => get n' s' end end. (** Two lists that are identical through get are syntactically equal *) Theorem get_correct : forall s1 s2 : string, (forall n : nat, get n s1 = get n s2) <-> s1 = s2. Proof. intros s1; elim s1; simpl. - intros s2; case s2; simpl; split; auto. + intros H; generalize (H O); intros H1; inversion H1. + intros; discriminate. - intros a s1' Rec s2; case s2 as [|? s]; simpl; split; auto. + intros H; generalize (H O); intros H1; inversion H1. + intros; discriminate. + intros H; generalize (H O); simpl; intros H1; inversion H1. case (Rec s). intros H0; rewrite H0; auto. intros n; exact (H (S n)). + intros [= H1 H2]. rewrite H2; trivial. rewrite H1; auto. Qed. (** The first elements of [s1 ++ s2] are the ones of [s1] *) Theorem append_correct1 : forall (s1 s2 : string) (n : nat), n < length s1 -> get n s1 = get n (s1 ++ s2). Proof. intros s1; elim s1; simpl; auto. - intros s2 n H; inversion H. - intros a s1' Rec s2 n; case n; simpl; auto. intros n0 H; apply Rec; auto. apply Nat.succ_lt_mono; auto. Qed. (** The last elements of [s1 ++ s2] are the ones of [s2] *) Theorem append_correct2 : forall (s1 s2 : string) (n : nat), get n s2 = get (n + length s1) (s1 ++ s2). Proof. intros s1; elim s1; simpl; auto. - intros s2 n; rewrite Nat.add_comm; simpl; auto. - intros a s1' Rec s2 n; case n; simpl; auto. intros. (replace (n0 + S (length s1')) with (S n0 + length s1') by now rewrite Nat.add_succ_r); auto. Qed. (** *** Substrings *) (** [substring n m s] returns the substring of [s] that starts at position [n] and of length [m]; if this does not make sense it returns [""] *) Fixpoint substring (n m : nat) (s : string) : string := match n, m, s with | O, O, _ => EmptyString | O, S m', EmptyString => s | O, S m', String c s' => String c (substring 0 m' s') | S n', _, EmptyString => s | S n', _, String c s' => substring n' m s' end. (** The substring is included in the initial string *) Theorem substring_correct1 : forall (s : string) (n m p : nat), p < m -> get p (substring n m s) = get (p + n) s. Proof. intros s; elim s; simpl; auto. - intros n; case n; simpl; auto. intros m; case m; simpl; auto. - intros a s' Rec; intros n; case n; simpl; auto. + intros m; case m; simpl; auto. * intros p H; inversion H. * intros m' p; case p; simpl; auto. intros n0 H; apply Rec; simpl; auto. apply <- Nat.succ_lt_mono; auto. + intros n' m p H; rewrite Nat.add_succ_r; auto. Qed. (** The substring has at most [m] elements *) Theorem substring_correct2 : forall (s : string) (n m p : nat), m <= p -> get p (substring n m s) = None. Proof. intros s; elim s; simpl; auto. - intros n; case n; simpl; auto. intros m; case m; simpl; auto. - intros a s' Rec; intros n; case n; simpl; auto. intros m; case m; simpl; auto. intros m' p; case p; simpl; auto. + intros H; inversion H. + intros n0 H; apply Rec; simpl; auto. apply <- Nat.succ_le_mono; auto. Qed. (** *** Concatenating lists of strings *) (** [concat sep sl] concatenates the list of strings [sl], inserting the separator string [sep] between each. *) Fixpoint concat (sep : string) (ls : list string) := match ls with | nil => EmptyString | cons x nil => x | cons x xs => x ++ sep ++ concat sep xs end. (** *** Test functions *) (** Test if [s1] is a prefix of [s2] *) Fixpoint prefix (s1 s2 : string) {struct s2} : bool := match s1 with | EmptyString => true | String a s1' => match s2 with | EmptyString => false | String b s2' => match ascii_dec a b with | left _ => prefix s1' s2' | right _ => false end end end. (** If [s1] is a prefix of [s2], it is the [substring] of length [length s1] starting at position [O] of [s2] *) Theorem prefix_correct : forall s1 s2 : string, prefix s1 s2 = true <-> substring 0 (length s1) s2 = s1. Proof. intros s1; elim s1; simpl; auto. - intros s2; case s2; simpl; split; auto. - intros a s1' Rec s2; case s2; simpl; auto. + split; intros; discriminate. + intros b s2'; case (ascii_dec a b); simpl; auto. * intros e; case (Rec s2'); intros H1 H2; split; intros H3; auto. -- rewrite e; rewrite H1; auto. -- apply H2; injection H3; auto. * intros n; split; intros H; try discriminate. case n; injection H; auto. Qed. (** Test if, starting at position [n], [s1] occurs in [s2]; if so it returns the position *) Fixpoint index (n : nat) (s1 s2 : string) : option nat := match s2, n with | EmptyString, O => match s1 with | EmptyString => Some O | String a s1' => None end | EmptyString, S n' => None | String b s2', O => if prefix s1 s2 then Some O else match index O s1 s2' with | Some n => Some (S n) | None => None end | String b s2', S n' => match index n' s1 s2' with | Some n => Some (S n) | None => None end end. (* Dirty trick to avoid locally that prefix reduces itself *) Opaque prefix. (** If the result of [index] is [Some m], [s1] in [s2] at position [m] *) Theorem index_correct1 : forall (n m : nat) (s1 s2 : string), index n s1 s2 = Some m -> substring m (length s1) s2 = s1. Proof. intros n m s1 s2; generalize n m s1; clear n m s1; elim s2; simpl; auto. - intros n; case n; simpl; auto. + intros m s1; case s1; simpl; auto. * intros [= <-]; auto. * intros; discriminate. + intros; discriminate. - intros b s2' Rec n m s1. case n; simpl; auto. + generalize (prefix_correct s1 (String b s2')); case (prefix s1 (String b s2')). * intros H0 [= <-]; auto. case H0; simpl; auto. * case m; simpl; auto. -- case (index O s1 s2'); intros; discriminate. -- intros m'; generalize (Rec O m' s1); case (index O s1 s2'); auto. ++ intros x H H0 H1; apply H; injection H1; auto. ++ intros; discriminate. + intros n'; case m; simpl; auto. * case (index n' s1 s2'); intros; discriminate. * intros m'; generalize (Rec n' m' s1); case (index n' s1 s2'); auto. -- intros x H H1; apply H; injection H1; auto. -- intros; discriminate. Qed. (** If the result of [index] is [Some m], [s1] does not occur in [s2] before [m] *) Theorem index_correct2 : forall (n m : nat) (s1 s2 : string), index n s1 s2 = Some m -> forall p : nat, n <= p -> p < m -> substring p (length s1) s2 <> s1. Proof. intros n m s1 s2; generalize n m s1; clear n m s1; elim s2; simpl; auto. - intros n; case n; simpl; auto. + intros m s1; case s1; simpl; auto. * intros [= <-]. intros p H0 H2; inversion H2. * intros; discriminate. + intros; discriminate. - intros b s2' Rec n m s1. case n; simpl; auto. + generalize (prefix_correct s1 (String b s2')); case (prefix s1 (String b s2')). * intros H0 [= <-]; auto. intros p H2 H3; inversion H3. * case m; simpl; auto. -- case (index 0 s1 s2'); intros; discriminate. -- intros m'; generalize (Rec O m' s1); case (index 0 s1 s2'); auto. ++ intros x H H0 H1 p; try case p; simpl; auto. ** intros H2 H3; red; intros H4; case H0. intros H5 H6; absurd (false = true); auto with bool. ** { intros n0 H2 H3; apply H; auto. - injection H1; auto. - apply Nat.le_0_l. - apply <- Nat.succ_lt_mono; auto. } ++ intros; discriminate. + intros n'; case m; simpl; auto. * case (index n' s1 s2'); intros; discriminate. * intros m'; generalize (Rec n' m' s1); case (index n' s1 s2'); auto. -- intros x H H0 p; case p; simpl; auto. ++ intros H1; inversion H1; auto. ++ intros n0 H1 H2; apply H; auto. ** injection H0; auto. ** apply <- Nat.succ_le_mono; auto. ** apply <- Nat.succ_lt_mono; auto. -- intros; discriminate. Qed. (** If the result of [index] is [None], [s1] does not occur in [s2] after [n] *) Theorem index_correct3 : forall (n m : nat) (s1 s2 : string), index n s1 s2 = None -> s1 <> EmptyString -> n <= m -> substring m (length s1) s2 <> s1. Proof. intros n m s1 s2; generalize n m s1; clear n m s1; elim s2; simpl; auto. - intros n; case n; simpl; auto. + intros m s1; case s1; simpl; auto. case m; intros; red; intros; discriminate. + intros n' m; case m; auto. intros s1; case s1; simpl; auto. - intros b s2' Rec n m s1. case n; simpl; auto. + generalize (prefix_correct s1 (String b s2')); case (prefix s1 (String b s2')). * intros; discriminate. * case m; simpl; auto with bool. -- case s1; simpl; auto. intros a s H H0 H1 H2; red; intros H3; case H. intros H4 H5; absurd (false = true); auto with bool. -- case s1; simpl; auto. intros a s n0 H H0 H1 H2; change (substring n0 (length (String a s)) s2' <> String a s); apply (Rec O); auto. ++ generalize H0; case (index 0 (String a s) s2'); simpl; auto; intros; discriminate. ++ apply Nat.le_0_l. + intros n'; case m; simpl; auto. * intros H H0 H1; inversion H1. * intros n0 H H0 H1; apply (Rec n'); auto. -- generalize H; case (index n' s1 s2'); simpl; auto; intros; discriminate. -- apply Nat.succ_le_mono; auto. Qed. (* Back to normal for prefix *) Transparent prefix. (** If we are searching for the [Empty] string and the answer is no this means that [n] is greater than the size of [s] *) Theorem index_correct4 : forall (n : nat) (s : string), index n EmptyString s = None -> length s < n. Proof. intros n s; generalize n; clear n; elim s; simpl; auto. - intros n; case n; simpl; auto. + intros; discriminate. + intros; apply Nat.lt_0_succ. - intros a s' H n; case n; simpl; auto. + intros; discriminate. + intros n'; generalize (H n'); case (index n' EmptyString s'); simpl; auto. * intros; discriminate. * intros H0 H1. apply -> Nat.succ_lt_mono; auto. Qed. (** Same as [index] but with no optional type, we return [0] when it does not occur *) Definition findex n s1 s2 := match index n s1 s2 with | Some n => n | None => O end. (** *** Conversion to/from [list ascii] and [list byte] *) Fixpoint string_of_list_ascii (s : list ascii) : string := match s with | nil => EmptyString | cons ch s => String ch (string_of_list_ascii s) end. Fixpoint list_ascii_of_string (s : string) : list ascii := match s with | EmptyString => nil | String ch s => cons ch (list_ascii_of_string s) end. Lemma string_of_list_ascii_of_string s : string_of_list_ascii (list_ascii_of_string s) = s. Proof. induction s as [|? ? IHs]; [ reflexivity | cbn; apply f_equal, IHs ]. Defined. Lemma list_ascii_of_string_of_list_ascii s : list_ascii_of_string (string_of_list_ascii s) = s. Proof. induction s as [|? ? IHs]; [ reflexivity | cbn; apply f_equal, IHs ]. Defined. Definition string_of_list_byte (s : list byte) : string := string_of_list_ascii (List.map ascii_of_byte s). Definition list_byte_of_string (s : string) : list byte := List.map byte_of_ascii (list_ascii_of_string s). Lemma string_of_list_byte_of_string s : string_of_list_byte (list_byte_of_string s) = s. Proof. cbv [string_of_list_byte list_byte_of_string]. erewrite List.map_map, List.map_ext, List.map_id, string_of_list_ascii_of_string; [ reflexivity | intro ]. apply ascii_of_byte_of_ascii. Qed. Lemma list_byte_of_string_of_list_byte s : list_byte_of_string (string_of_list_byte s) = s. Proof. cbv [string_of_list_byte list_byte_of_string]. erewrite list_ascii_of_string_of_list_ascii, List.map_map, List.map_ext, List.map_id; [ reflexivity | intro ]. apply byte_of_ascii_of_byte. Qed. (** *** Concrete syntax *) (** The concrete syntax for strings in scope string_scope follows the Coq convention for strings: all ascii characters of code less than 128 are literals to the exception of the character `double quote' which must be doubled. Strings that involve ascii characters of code >= 128 which are not part of a valid utf8 sequence of characters are not representable using the Coq string notation (use explicitly the String constructor with the ascii codes of the characters). *) Module Export StringSyntax. String Notation string string_of_list_byte list_byte_of_string : string_scope. End StringSyntax. Example HelloWorld := " ""Hello world!"" ". coq-8.20.0/theories/Structures/000077500000000000000000000000001466560755400164125ustar00rootroot00000000000000coq-8.20.0/theories/Structures/DecidableType.v000066400000000000000000000111521466560755400212770ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* split : core. (* eqke is stricter than eqk *) Lemma eqke_eqk : forall x x', eqke x x' -> eqk x x'. Proof. unfold eqk, eqke; intuition. Qed. (* eqk, eqke are equalities *) Lemma eqk_refl : forall e, eqk e e. Proof. auto. Qed. Lemma eqke_refl : forall e, eqke e e. Proof. auto. Qed. Lemma eqk_sym : forall e e', eqk e e' -> eqk e' e. Proof. auto. Qed. Lemma eqke_sym : forall e e', eqke e e' -> eqke e' e. Proof. unfold eqke; intuition. Qed. Lemma eqk_trans : forall e e' e'', eqk e e' -> eqk e' e'' -> eqk e e''. Proof. eauto. Qed. Lemma eqke_trans : forall e e' e'', eqke e e' -> eqke e' e'' -> eqke e e''. Proof. unfold eqke; intuition; [ eauto | congruence ]. Qed. #[local] Hint Resolve eqk_trans eqke_trans eqk_refl eqke_refl : core. #[local] Hint Immediate eqk_sym eqke_sym : core. Global Instance eqk_equiv : Equivalence eqk. Proof. split; eauto. Qed. Global Instance eqke_equiv : Equivalence eqke. Proof. split; eauto. Qed. Lemma InA_eqke_eqk : forall x m, InA eqke x m -> InA eqk x m. Proof. unfold eqke; induction 1; intuition. Qed. #[local] Hint Resolve InA_eqke_eqk : core. Lemma InA_eqk : forall p q m, eqk p q -> InA eqk p m -> InA eqk q m. Proof. intros p q m **; apply InA_eqA with p; auto using eqk_equiv. Qed. Definition MapsTo (k:key)(e:elt):= InA eqke (k,e). Definition In k m := exists e:elt, MapsTo k e m. #[local] Hint Unfold MapsTo In : core. (* An alternative formulation for [In k l] is [exists e, InA eqk (k,e) l] *) Lemma In_alt : forall k l, In k l <-> exists e, InA eqk (k,e) l. Proof. intros k l; split; intros [y H]. - exists y; auto. - induction H as [a l eq|a l H IH]. + destruct a as [k' y']. exists y'; auto. + destruct IH as [e H0]. exists e; auto. Qed. Lemma MapsTo_eq : forall l x y e, eq x y -> MapsTo x e l -> MapsTo y e l. Proof. intros l x y e **; unfold MapsTo in *; apply InA_eqA with (x,e); auto using eqke_equiv. Qed. Lemma In_eq : forall l x y, eq x y -> In x l -> In y l. Proof. destruct 2 as (e,E); exists e; eapply MapsTo_eq; eauto. Qed. Lemma In_inv : forall k k' e l, In k ((k',e) :: l) -> eq k k' \/ In k l. Proof. inversion 1 as [? H0]. inversion_clear H0 as [? ? H1|]; eauto. destruct H1; simpl in *; intuition. Qed. Lemma In_inv_2 : forall k k' e e' l, InA eqk (k, e) ((k', e') :: l) -> ~ eq k k' -> InA eqk (k, e) l. Proof. inversion_clear 1 as [? ? H0|? ? H0]; compute in H0; intuition. Qed. Lemma In_inv_3 : forall x x' l, InA eqke x (x' :: l) -> ~ eqk x x' -> InA eqke x l. Proof. inversion_clear 1 as [? ? H0|? ? H0]; compute in H0; intuition. Qed. End Elt. #[global] Hint Unfold eqk eqke : core. #[global] Hint Extern 2 (eqke ?a ?b) => split : core. #[global] Hint Resolve eqk_trans eqke_trans eqk_refl eqke_refl : core. #[global] Hint Immediate eqk_sym eqke_sym : core. #[global] Hint Resolve InA_eqke_eqk : core. #[global] Hint Unfold MapsTo In : core. #[global] Hint Resolve In_inv_2 In_inv_3 : core. End KeyDecidableType. coq-8.20.0/theories/Structures/DecidableTypeEx.v000066400000000000000000000063451466560755400216040ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* eq y x. Proof. intros (x1,x2) (y1,y2); unfold eq; simpl; intuition. Qed. Lemma eq_trans : forall x y z : t, eq x y -> eq y z -> eq x z. Proof. intros (x1,x2) (y1,y2) (z1,z2); unfold eq; simpl; intuition eauto. Qed. Definition eq_dec : forall x y, { eq x y }+{ ~eq x y }. Proof. intros (x1,x2) (y1,y2); unfold eq; simpl. destruct (D1.eq_dec x1 y1); destruct (D2.eq_dec x2 y2); intuition. Defined. End PairDecidableType. (** Similarly for pairs of UsualDecidableType *) Module PairUsualDecidableType(D1 D2:UsualDecidableType) <: UsualDecidableType. Definition t := prod D1.t D2.t. Definition eq := @eq t. Definition eq_refl := @eq_refl t. Definition eq_sym := @eq_sym t. Definition eq_trans := @eq_trans t. Definition eq_dec : forall x y, { eq x y }+{ ~eq x y }. Proof. intros (x1,x2) (y1,y2); destruct (D1.eq_dec x1 y1); destruct (D2.eq_dec x2 y2); unfold eq, D1.eq, D2.eq in *; simpl; (left; f_equal; auto; fail) || (right; injection; auto). Defined. End PairUsualDecidableType. coq-8.20.0/theories/Structures/Equalities.v000066400000000000000000000203321466560755400207060ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* t -> Prop. End HasEq. Module Type Eq := Typ <+ HasEq. Module Type EqNotation (Import E:Eq). Infix "==" := eq (at level 70, no associativity). Notation "x ~= y" := (~eq x y) (at level 70, no associativity). End EqNotation. Module Type Eq' := Eq <+ EqNotation. (** * Specification of the equality via the [Equivalence] type class *) Module Type IsEq (Import E:Eq). #[global] Declare Instance eq_equiv : Equivalence eq. End IsEq. (** * Earlier specification of equality by three separate lemmas. *) Module Type IsEqOrig (Import E:Eq'). Axiom eq_refl : forall x : t, x==x. Axiom eq_sym : forall x y : t, x==y -> y==x. Axiom eq_trans : forall x y z : t, x==y -> y==z -> x==z. #[global] Hint Immediate eq_sym : core. #[global] Hint Resolve eq_refl eq_trans : core. End IsEqOrig. (** * Types with decidable equality *) Module Type HasEqDec (Import E:Eq'). Parameter eq_dec : forall x y : t, { x==y } + { ~ x==y }. End HasEqDec. (** * Boolean Equality *) (** Having [eq_dec] is the same as having a boolean equality plus a correctness proof. *) Module Type HasEqb (Import T:Typ). Parameter Inline eqb : t -> t -> bool. End HasEqb. Module Type EqbSpec (T:Typ)(X:HasEq T)(Y:HasEqb T). Parameter eqb_eq : forall x y, Y.eqb x y = true <-> X.eq x y. End EqbSpec. Module Type EqbNotation (T:Typ)(E:HasEqb T). Infix "=?" := E.eqb (at level 70, no associativity). End EqbNotation. Module Type HasEqBool (E:Eq) := HasEqb E <+ EqbSpec E E. (** From these basic blocks, we can build many combinations of static standalone module types. *) Module Type EqualityType := Eq <+ IsEq. Module Type EqualityTypeOrig := Eq <+ IsEqOrig. Module Type EqualityTypeBoth <: EqualityType <: EqualityTypeOrig := Eq <+ IsEq <+ IsEqOrig. Module Type DecidableType <: EqualityType := Eq <+ IsEq <+ HasEqDec. Module Type DecidableTypeOrig <: EqualityTypeOrig := Eq <+ IsEqOrig <+ HasEqDec. Module Type DecidableTypeBoth <: DecidableType <: DecidableTypeOrig := EqualityTypeBoth <+ HasEqDec. Module Type BooleanEqualityType <: EqualityType := Eq <+ IsEq <+ HasEqBool. Module Type BooleanDecidableType <: DecidableType <: BooleanEqualityType := Eq <+ IsEq <+ HasEqDec <+ HasEqBool. Module Type DecidableTypeFull <: DecidableTypeBoth <: BooleanDecidableType := Eq <+ IsEq <+ IsEqOrig <+ HasEqDec <+ HasEqBool. (** Same, with notation for [eq] *) Module Type EqualityType' := EqualityType <+ EqNotation. Module Type EqualityTypeOrig' := EqualityTypeOrig <+ EqNotation. Module Type EqualityTypeBoth' := EqualityTypeBoth <+ EqNotation. Module Type DecidableType' := DecidableType <+ EqNotation. Module Type DecidableTypeOrig' := DecidableTypeOrig <+ EqNotation. Module Type DecidableTypeBoth' := DecidableTypeBoth <+ EqNotation. Module Type BooleanEqualityType' := BooleanEqualityType <+ EqNotation <+ EqbNotation. Module Type BooleanDecidableType' := BooleanDecidableType <+ EqNotation <+ EqbNotation. Module Type DecidableTypeFull' := DecidableTypeFull <+ EqNotation. (** * Compatibility wrapper from/to the old version of [EqualityType] and [DecidableType] *) Module BackportEq (E:Eq)(F:IsEq E) <: IsEqOrig E. Definition eq_refl := @Equivalence_Reflexive _ _ F.eq_equiv. Definition eq_sym := @Equivalence_Symmetric _ _ F.eq_equiv. Definition eq_trans := @Equivalence_Transitive _ _ F.eq_equiv. End BackportEq. Module UpdateEq (E:Eq)(F:IsEqOrig E) <: IsEq E. #[global] Instance eq_equiv : Equivalence E.eq. Proof. exact (Build_Equivalence _ F.eq_refl F.eq_sym F.eq_trans). Qed. End UpdateEq. Module Backport_ET (E:EqualityType) <: EqualityTypeBoth := E <+ BackportEq. Module Update_ET (E:EqualityTypeOrig) <: EqualityTypeBoth := E <+ UpdateEq. Module Backport_DT (E:DecidableType) <: DecidableTypeBoth := E <+ BackportEq. Module Update_DT (E:DecidableTypeOrig) <: DecidableTypeBoth := E <+ UpdateEq. (** * Having [eq_dec] is equivalent to having [eqb] and its spec. *) Module HasEqDec2Bool (E:Eq)(F:HasEqDec E) <: HasEqBool E. Definition eqb x y := if F.eq_dec x y then true else false. Lemma eqb_eq : forall x y, eqb x y = true <-> E.eq x y. Proof. intros x y. unfold eqb. destruct F.eq_dec as [EQ|NEQ]. - auto with *. - split. + discriminate. + intro EQ; elim NEQ; auto. Qed. End HasEqDec2Bool. Module HasEqBool2Dec (E:Eq)(F:HasEqBool E) <: HasEqDec E. Lemma eq_dec : forall x y, {E.eq x y}+{~E.eq x y}. Proof. intros x y. assert (H:=F.eqb_eq x y). destruct (F.eqb x y); [left|right]. - apply -> H; auto. - intro EQ. apply H in EQ. discriminate. Defined. End HasEqBool2Dec. Module Dec2Bool (E:DecidableType) <: BooleanDecidableType := E <+ HasEqDec2Bool. Module Bool2Dec (E:BooleanEqualityType) <: BooleanDecidableType := E <+ HasEqBool2Dec. (** Some properties of boolean equality *) Module BoolEqualityFacts (Import E : BooleanEqualityType'). (** [eqb] is compatible with [eq] *) #[global] Instance eqb_compat : Proper (E.eq ==> E.eq ==> Logic.eq) eqb. Proof. intros x x' Exx' y y' Eyy'. apply eq_true_iff_eq. now rewrite 2 eqb_eq, Exx', Eyy'. Qed. (** Alternative specification of [eqb] based on [reflect]. *) Lemma eqb_spec x y : reflect (x==y) (x =? y). Proof. apply iff_reflect. symmetry. apply eqb_eq. Defined. (** Negated form of [eqb_eq] *) Lemma eqb_neq x y : (x =? y) = false <-> x ~= y. Proof. now rewrite <- not_true_iff_false, eqb_eq. Qed. (** Basic equality laws for [eqb] *) Lemma eqb_refl x : (x =? x) = true. Proof. now apply eqb_eq. Qed. Lemma eqb_sym x y : (x =? y) = (y =? x). Proof. apply eq_true_iff_eq. now rewrite 2 eqb_eq. Qed. (** Transitivity is a particular case of [eqb_compat] *) End BoolEqualityFacts. (** * UsualDecidableType A particular case of [DecidableType] where the equality is the usual one of Coq. *) Module Type HasUsualEq (Import T:Typ) <: HasEq T. Definition eq := @Logic.eq t. End HasUsualEq. Module Type UsualEq <: Eq := Typ <+ HasUsualEq. Module Type UsualIsEq (E:UsualEq) <: IsEq E. (* No Instance syntax to avoid saturating the Equivalence tables *) Definition eq_equiv : Equivalence E.eq := eq_equivalence. End UsualIsEq. Module Type UsualIsEqOrig (E:UsualEq) <: IsEqOrig E. Definition eq_refl := @Logic.eq_refl E.t. Definition eq_sym := @Logic.eq_sym E.t. Definition eq_trans := @Logic.eq_trans E.t. End UsualIsEqOrig. Module Type UsualEqualityType <: EqualityType := UsualEq <+ UsualIsEq. Module Type UsualDecidableType <: DecidableType := UsualEq <+ UsualIsEq <+ HasEqDec. Module Type UsualDecidableTypeOrig <: DecidableTypeOrig := UsualEq <+ UsualIsEqOrig <+ HasEqDec. Module Type UsualDecidableTypeBoth <: DecidableTypeBoth := UsualEq <+ UsualIsEq <+ UsualIsEqOrig <+ HasEqDec. Module Type UsualBoolEq := UsualEq <+ HasEqBool. Module Type UsualDecidableTypeFull <: DecidableTypeFull := UsualEq <+ UsualIsEq <+ UsualIsEqOrig <+ HasEqDec <+ HasEqBool. (** Some shortcuts for easily building a [UsualDecidableType] *) Module Type MiniDecidableType. Include Typ. Parameter eq_dec : forall x y : t, {x=y}+{~x=y}. End MiniDecidableType. Module Make_UDT (M:MiniDecidableType) <: UsualDecidableTypeBoth := M <+ HasUsualEq <+ UsualIsEq <+ UsualIsEqOrig. Module Make_UDTF (M:UsualBoolEq) <: UsualDecidableTypeFull := M <+ UsualIsEq <+ UsualIsEqOrig <+ HasEqBool2Dec. coq-8.20.0/theories/Structures/EqualitiesFacts.v000066400000000000000000000146221466560755400216740ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* D.eq k k'. Proof. now destruct 1. Qed. Lemma eqke_2 {elt} k k' (e e':elt) : eqke (k,e) (k',e') -> e=e'. Proof. now destruct 1. Qed. Lemma eqk_def {elt} k k' (e e':elt) : eqk (k,e) (k',e') = D.eq k k'. Proof. reflexivity. Defined. Lemma eqk_def' {elt} (p q:key*elt) : eqk p q = D.eq (fst p) (fst q). Proof. reflexivity. Qed. Lemma eqk_1 {elt} k k' (e e':elt) : eqk (k,e) (k',e') -> D.eq k k'. Proof. trivial. Qed. #[global] Hint Resolve eqke_1 eqke_2 eqk_1 : core. (* Additional facts *) Lemma InA_eqke_eqk {elt} p (m:list (key*elt)) : InA eqke p m -> InA eqk p m. Proof. induction 1; firstorder. Qed. #[global] Hint Resolve InA_eqke_eqk : core. Lemma InA_eqk_eqke {elt} p (m:list (key*elt)) : InA eqk p m -> exists q, eqk p q /\ InA eqke q m. Proof. induction 1; firstorder auto with crelations. Qed. Lemma InA_eqk {elt} p q (m:list (key*elt)) : eqk p q -> InA eqk p m -> InA eqk q m. Proof. now intros <-. Qed. Definition MapsTo {elt} (k:key)(e:elt):= InA eqke (k,e). Definition In {elt} k m := exists e:elt, MapsTo k e m. #[global] Hint Unfold MapsTo In : core. (* Alternative formulations for [In k l] *) Lemma In_alt {elt} k (l:list (key*elt)) : In k l <-> exists e, InA eqk (k,e) l. Proof. unfold In, MapsTo. split; intros (e,H). - exists e; auto. - apply InA_eqk_eqke in H. destruct H as ((k',e'),(E,H)). compute in E. exists e'. now rewrite E. Qed. Lemma In_alt' {elt} (l:list (key*elt)) k e : In k l <-> InA eqk (k,e) l. Proof. rewrite In_alt. firstorder. eapply InA_eqk; eauto. now compute. Qed. Lemma In_alt2 {elt} k (l:list (key*elt)) : In k l <-> Exists (fun p => D.eq k (fst p)) l. Proof. unfold In, MapsTo. setoid_rewrite Exists_exists; setoid_rewrite InA_alt. firstorder. exists (snd x), x; auto. Qed. Lemma In_nil {elt} k : In k (@nil (key*elt)) <-> False. Proof. rewrite In_alt2; apply Exists_nil. Qed. Lemma In_cons {elt} k p (l:list (key*elt)) : In k (p::l) <-> D.eq k (fst p) \/ In k l. Proof. rewrite !In_alt2, Exists_cons; intuition. Qed. #[global] Instance MapsTo_compat {elt} : Proper (D.eq==>Logic.eq==>equivlistA eqke==>iff) (@MapsTo elt). Proof. intros x x' Hx e e' He l l' Hl. unfold MapsTo. rewrite Hx, He, Hl; intuition. Qed. #[global] Instance In_compat {elt} : Proper (D.eq==>equivlistA eqk==>iff) (@In elt). Proof. intros x x' Hx l l' Hl. rewrite !In_alt. setoid_rewrite Hl. setoid_rewrite Hx. intuition. Qed. Lemma MapsTo_eq {elt} (l:list (key*elt)) x y e : D.eq x y -> MapsTo x e l -> MapsTo y e l. Proof. now intros <-. Qed. Lemma In_eq {elt} (l:list (key*elt)) x y : D.eq x y -> In x l -> In y l. Proof. now intros <-. Qed. Lemma In_inv {elt} k k' e (l:list (key*elt)) : In k ((k',e) :: l) -> D.eq k k' \/ In k l. Proof. intros (e',H). red in H. rewrite InA_cons, eqke_def in H. intuition. right. now exists e'. Qed. Lemma In_inv_2 {elt} k k' e e' (l:list (key*elt)) : InA eqk (k, e) ((k', e') :: l) -> ~ D.eq k k' -> InA eqk (k, e) l. Proof. rewrite InA_cons, eqk_def. intuition. Qed. Lemma In_inv_3 {elt} x x' (l:list (key*elt)) : InA eqke x (x' :: l) -> ~ eqk x x' -> InA eqke x l. Proof. rewrite InA_cons. destruct 1 as [H|H]; trivial. destruct 1. eauto with *. Qed. #[global] Hint Extern 2 (eqke ?a ?b) => split : core. #[global] Hint Resolve InA_eqke_eqk : core. #[global] Hint Resolve In_inv_2 In_inv_3 : core. End KeyDecidableType. (** * PairDecidableType From two decidable types, we can build a new DecidableType over their cartesian product. *) Module PairDecidableType(D1 D2:DecidableType) <: DecidableType. Definition t := (D1.t * D2.t)%type. Definition eq := (D1.eq * D2.eq)%signature. #[global] Instance eq_equiv : Equivalence eq := _. Definition eq_dec : forall x y, { eq x y }+{ ~eq x y }. Proof. intros (x1,x2) (y1,y2); unfold eq; simpl. destruct (D1.eq_dec x1 y1); destruct (D2.eq_dec x2 y2); compute; intuition. Defined. End PairDecidableType. (** Similarly for pairs of UsualDecidableType *) Module PairUsualDecidableType(D1 D2:UsualDecidableType) <: UsualDecidableType. Definition t := (D1.t * D2.t)%type. Definition eq := @eq t. #[global] Instance eq_equiv : Equivalence eq := _. Definition eq_dec : forall x y, { eq x y }+{ ~eq x y }. Proof. intros (x1,x2) (y1,y2); destruct (D1.eq_dec x1 y1); destruct (D2.eq_dec x2 y2); unfold eq, D1.eq, D2.eq in *; simpl; (left; f_equal; auto; fail) || (right; intros [=]; auto). Defined. End PairUsualDecidableType. (** And also for pairs of UsualDecidableTypeFull *) Module PairUsualDecidableTypeFull (D1 D2:UsualDecidableTypeFull) <: UsualDecidableTypeFull. Module M := PairUsualDecidableType D1 D2. Include Backport_DT (M). Include HasEqDec2Bool. End PairUsualDecidableTypeFull. coq-8.20.0/theories/Structures/GenericMinMax.v000066400000000000000000000452621466560755400213000ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* t -> t. Parameter max_l : forall x y, y<=x -> max x y == x. Parameter max_r : forall x y, x<=y -> max x y == y. End HasMax. Module Type HasMin (Import E:EqLe'). Parameter Inline min : t -> t -> t. Parameter min_l : forall x y, x<=y -> min x y == x. Parameter min_r : forall x y, y<=x -> min x y == y. End HasMin. Module Type HasMinMax (E:EqLe) := HasMax E <+ HasMin E. (** ** Any [OrderedTypeFull] can be equipped by [max] and [min] based on the compare function. *) Definition gmax {A} (cmp : A->A->comparison) x y := match cmp x y with Lt => y | _ => x end. Definition gmin {A} (cmp : A->A->comparison) x y := match cmp x y with Gt => y | _ => x end. Module GenericMinMax (Import O:OrderedTypeFull') <: HasMinMax O. Definition max := gmax O.compare. Definition min := gmin O.compare. Lemma ge_not_lt x y : y<=x -> x False. Proof. intros H H'. apply (StrictOrder_Irreflexive x). rewrite le_lteq in *; destruct H as [H|H]. - transitivity y; auto. - rewrite H in H'; auto. Qed. Lemma max_l x y : y<=x -> max x y == x. Proof. intros. unfold max, gmax. case compare_spec; auto with relations. intros; elim (ge_not_lt x y); auto. Qed. Lemma max_r x y : x<=y -> max x y == y. Proof. intros. unfold max, gmax. case compare_spec; auto with relations. intros; elim (ge_not_lt y x); auto. Qed. Lemma min_l x y : x<=y -> min x y == x. Proof. intros. unfold min, gmin. case compare_spec; auto with relations. intros; elim (ge_not_lt y x); auto. Qed. Lemma min_r x y : y<=x -> min x y == y. Proof. intros. unfold min, gmin. case compare_spec; auto with relations. intros; elim (ge_not_lt x y); auto. Qed. End GenericMinMax. (** ** Consequences of the minimalist interface: facts about [max] and [min]. *) Module MinMaxLogicalProperties (Import O:TotalOrder')(Import M:HasMinMax O). Module Import Private_Tac := !MakeOrderTac O O. (** An alternative characterisation of [max], equivalent to [max_l /\ max_r] *) Lemma max_spec n m : (n < m /\ max n m == m) \/ (m <= n /\ max n m == n). Proof. destruct (lt_total n m); [left|right]. - split; auto. apply max_r. rewrite le_lteq; auto. - assert (m <= n) by (rewrite le_lteq; intuition auto with relations). split; auto. now apply max_l. Qed. (** A more symmetric version of [max_spec], based only on [le]. Beware that left and right alternatives overlap. *) Lemma max_spec_le n m : (n <= m /\ max n m == m) \/ (m <= n /\ max n m == n). Proof. destruct (max_spec n m); [left|right]; intuition; order. Qed. #[global] Instance : Proper (eq==>eq==>iff) le. Proof. repeat red. intuition order. Qed. #[global] Instance max_compat : Proper (eq==>eq==>eq) max. Proof. intros x x' Hx y y' Hy. assert (H1 := max_spec x y). assert (H2 := max_spec x' y'). set (m := max x y) in *; set (m' := max x' y') in *; clearbody m m'. rewrite <- Hx, <- Hy in *. destruct (lt_total x y); intuition order. Qed. (** A function satisfying the same specification is equal to [max]. *) Lemma max_unicity n m p : ((n < m /\ p == m) \/ (m <= n /\ p == n)) -> p == max n m. Proof. assert (Hm := max_spec n m). destruct (lt_total n m); intuition; order. Qed. Lemma max_unicity_ext f : (forall n m, (n < m /\ f n m == m) \/ (m <= n /\ f n m == n)) -> (forall n m, f n m == max n m). Proof. intros. apply max_unicity; auto. Qed. (** [max] commutes with monotone functions. *) Lemma max_mono f : (Proper (eq ==> eq) f) -> (Proper (le ==> le) f) -> forall x y, max (f x) (f y) == f (max x y). Proof. intros Eqf Lef x y. destruct (max_spec x y) as [(H,E)|(H,E)]; rewrite E; destruct (max_spec (f x) (f y)) as [(H',E')|(H',E')]; auto. - assert (f x <= f y) by (apply Lef; order). order. - assert (f y <= f x) by (apply Lef; order). order. Qed. (** *** Semi-lattice algebraic properties of [max] *) Lemma max_id n : max n n == n. Proof. apply max_l; order. Qed. Notation max_idempotent := max_id (only parsing). Lemma max_assoc m n p : max m (max n p) == max (max m n) p. Proof. destruct (max_spec n p) as [(H,E)|(H,E)]; rewrite E; destruct (max_spec m n) as [(H',E')|(H',E')]; rewrite E', ?E; try easy. - apply max_r; order. - symmetry. apply max_l; order. Qed. Lemma max_comm n m : max n m == max m n. Proof. destruct (max_spec m n) as [(H,E)|(H,E)]; rewrite E; (apply max_r || apply max_l); order. Qed. Ltac solve_max := match goal with |- context [max ?n ?m] => destruct (max_spec n m); intuition; order end. (** *** Least-upper bound properties of [max] *) Lemma le_max_l n m : n <= max n m. Proof. solve_max. Qed. Lemma le_max_r n m : m <= max n m. Proof. solve_max. Qed. Lemma max_l_iff n m : max n m == n <-> m <= n. Proof. solve_max. Qed. Lemma max_r_iff n m : max n m == m <-> n <= m. Proof. solve_max. Qed. Lemma max_le n m p : p <= max n m -> p <= n \/ p <= m. Proof. destruct (max_spec n m); [right|left]; intuition; order. Qed. Lemma max_le_iff n m p : p <= max n m <-> p <= n \/ p <= m. Proof. split. - apply max_le. - solve_max. Qed. Lemma max_lt_iff n m p : p < max n m <-> p < n \/ p < m. Proof. destruct (max_spec n m); intuition; order || (right; order) || (left; order). Qed. Lemma max_lub_l n m p : max n m <= p -> n <= p. Proof. solve_max. Qed. Lemma max_lub_r n m p : max n m <= p -> m <= p. Proof. solve_max. Qed. Lemma max_lub n m p : n <= p -> m <= p -> max n m <= p. Proof. solve_max. Qed. Lemma max_lub_iff n m p : max n m <= p <-> n <= p /\ m <= p. Proof. solve_max. Qed. Lemma max_lub_lt n m p : n < p -> m < p -> max n m < p. Proof. solve_max. Qed. Lemma max_lub_lt_iff n m p : max n m < p <-> n < p /\ m < p. Proof. solve_max. Qed. Lemma max_le_compat_l n m p : n <= m -> max p n <= max p m. Proof. intros. apply max_lub_iff. solve_max. Qed. Lemma max_le_compat_r n m p : n <= m -> max n p <= max m p. Proof. intros. apply max_lub_iff. solve_max. Qed. Lemma max_le_compat n m p q : n <= m -> p <= q -> max n p <= max m q. Proof. intros Hnm Hpq. assert (LE := max_le_compat_l _ _ m Hpq). assert (LE' := max_le_compat_r _ _ p Hnm). order. Qed. (** Properties of [min] *) Lemma min_spec n m : (n < m /\ min n m == n) \/ (m <= n /\ min n m == m). Proof. destruct (lt_total n m); [left|right]. - split; auto. apply min_l. rewrite le_lteq; auto. - assert (m <= n) by (rewrite le_lteq; intuition auto with relations). split; auto. now apply min_r. Qed. Lemma min_spec_le n m : (n <= m /\ min n m == n) \/ (m <= n /\ min n m == m). Proof. destruct (min_spec n m); [left|right]; intuition; order. Qed. #[global] Instance min_compat : Proper (eq==>eq==>eq) min. Proof. intros x x' Hx y y' Hy. assert (H1 := min_spec x y). assert (H2 := min_spec x' y'). set (m := min x y) in *; set (m' := min x' y') in *; clearbody m m'. rewrite <- Hx, <- Hy in *. destruct (lt_total x y); intuition order. Qed. Lemma min_unicity n m p : ((n < m /\ p == n) \/ (m <= n /\ p == m)) -> p == min n m. Proof. assert (Hm := min_spec n m). destruct (lt_total n m); intuition; order. Qed. Lemma min_unicity_ext f : (forall n m, (n < m /\ f n m == n) \/ (m <= n /\ f n m == m)) -> (forall n m, f n m == min n m). Proof. intros. apply min_unicity; auto. Qed. Lemma min_mono f : (Proper (eq ==> eq) f) -> (Proper (le ==> le) f) -> forall x y, min (f x) (f y) == f (min x y). Proof. intros Eqf Lef x y. destruct (min_spec x y) as [(H,E)|(H,E)]; rewrite E; destruct (min_spec (f x) (f y)) as [(H',E')|(H',E')]; auto. - assert (f x <= f y) by (apply Lef; order). order. - assert (f y <= f x) by (apply Lef; order). order. Qed. Lemma min_id n : min n n == n. Proof. apply min_l; order. Qed. Notation min_idempotent := min_id (only parsing). Lemma min_assoc m n p : min m (min n p) == min (min m n) p. Proof. destruct (min_spec n p) as [(H,E)|(H,E)]; rewrite E; destruct (min_spec m n) as [(H',E')|(H',E')]; rewrite E', ?E; try easy. - symmetry. apply min_l; order. - apply min_r; order. Qed. Lemma min_comm n m : min n m == min m n. Proof. destruct (min_spec m n) as [(H,E)|(H,E)]; rewrite E; (apply min_r || apply min_l); order. Qed. Ltac solve_min := match goal with |- context [min ?n ?m] => destruct (min_spec n m); intuition; order end. Lemma le_min_r n m : min n m <= m. Proof. solve_min. Qed. Lemma le_min_l n m : min n m <= n. Proof. solve_min. Qed. Lemma min_l_iff n m : min n m == n <-> n <= m. Proof. solve_min. Qed. Lemma min_r_iff n m : min n m == m <-> m <= n. Proof. solve_min. Qed. Lemma min_le n m p : min n m <= p -> n <= p \/ m <= p. Proof. destruct (min_spec n m); [left|right]; intuition; order. Qed. Lemma min_le_iff n m p : min n m <= p <-> n <= p \/ m <= p. Proof. split. - apply min_le. - solve_min. Qed. Lemma min_lt_iff n m p : min n m < p <-> n < p \/ m < p. Proof. destruct (min_spec n m); intuition; order || (right; order) || (left; order). Qed. Lemma min_glb_l n m p : p <= min n m -> p <= n. Proof. solve_min. Qed. Lemma min_glb_r n m p : p <= min n m -> p <= m. Proof. solve_min. Qed. Lemma min_glb n m p : p <= n -> p <= m -> p <= min n m. Proof. solve_min. Qed. Lemma min_glb_iff n m p : p <= min n m <-> p <= n /\ p <= m. Proof. solve_min. Qed. Lemma min_glb_lt n m p : p < n -> p < m -> p < min n m. Proof. solve_min. Qed. Lemma min_glb_lt_iff n m p : p < min n m <-> p < n /\ p < m. Proof. solve_min. Qed. Lemma min_le_compat_l n m p : n <= m -> min p n <= min p m. Proof. intros. apply min_glb_iff. solve_min. Qed. Lemma min_le_compat_r n m p : n <= m -> min n p <= min m p. Proof. intros. apply min_glb_iff. solve_min. Qed. Lemma min_le_compat n m p q : n <= m -> p <= q -> min n p <= min m q. Proof. intros Hnm Hpq. assert (LE := min_le_compat_l _ _ m Hpq). assert (LE' := min_le_compat_r _ _ p Hnm). order. Qed. (** *** Combined properties of min and max *) Lemma min_max_absorption n m : max n (min n m) == n. Proof. intros. destruct (min_spec n m) as [(C,E)|(C,E)]; rewrite E. - apply max_l. order. - destruct (max_spec n m); intuition; order. Qed. Lemma max_min_absorption n m : min n (max n m) == n. Proof. intros. destruct (max_spec n m) as [(C,E)|(C,E)]; rewrite E. - destruct (min_spec n m) as [(C',E')|(C',E')]; auto. order. - apply min_l; auto. order. Qed. (** Distributivity *) Lemma max_min_distr n m p : max n (min m p) == min (max n m) (max n p). Proof. symmetry. apply min_mono. - eauto with *. - repeat red; intros. apply max_le_compat_l; auto. Qed. Lemma min_max_distr n m p : min n (max m p) == max (min n m) (min n p). Proof. symmetry. apply max_mono. - eauto with *. - repeat red; intros. apply min_le_compat_l; auto. Qed. (** Modularity *) Lemma max_min_modular n m p : max n (min m (max n p)) == min (max n m) (max n p). Proof. rewrite <- max_min_distr. destruct (max_spec n p) as [(C,E)|(C,E)]; rewrite E; auto with *. destruct (min_spec m n) as [(C',E')|(C',E')]; rewrite E'. - rewrite 2 max_l; try order. rewrite min_le_iff; auto. - rewrite 2 max_l; try order. rewrite min_le_iff; auto. Qed. Lemma min_max_modular n m p : min n (max m (min n p)) == max (min n m) (min n p). Proof. intros. rewrite <- min_max_distr. destruct (min_spec n p) as [(C,E)|(C,E)]; rewrite E; auto with *. destruct (max_spec m n) as [(C',E')|(C',E')]; rewrite E'. - rewrite 2 min_l; try order. rewrite max_le_iff; right; order. - rewrite 2 min_l; try order. rewrite max_le_iff; auto. Qed. (** Disassociativity *) Lemma max_min_disassoc n m p : min n (max m p) <= max (min n m) p. Proof. intros. rewrite min_max_distr. auto using max_le_compat_l, le_min_r. Qed. (** Anti-monotonicity swaps the role of [min] and [max] *) Lemma max_min_antimono f : Proper (eq==>eq) f -> Proper (le==>flip le) f -> forall x y, max (f x) (f y) == f (min x y). Proof. intros Eqf Lef x y. destruct (min_spec x y) as [(H,E)|(H,E)]; rewrite E; destruct (max_spec (f x) (f y)) as [(H',E')|(H',E')]; auto. - assert (f y <= f x) by (apply Lef; order). order. - assert (f x <= f y) by (apply Lef; order). order. Qed. Lemma min_max_antimono f : Proper (eq==>eq) f -> Proper (le==>flip le) f -> forall x y, min (f x) (f y) == f (max x y). Proof. intros Eqf Lef x y. destruct (max_spec x y) as [(H,E)|(H,E)]; rewrite E; destruct (min_spec (f x) (f y)) as [(H',E')|(H',E')]; auto. - assert (f y <= f x) by (apply Lef; order). order. - assert (f x <= f y) by (apply Lef; order). order. Qed. End MinMaxLogicalProperties. (** ** Properties requiring a decidable order *) Module MinMaxDecProperties (Import O:OrderedTypeFull')(Import M:HasMinMax O). (** Induction principles for [max]. *) Lemma max_case_strong n m (P:t -> Type) : (forall x y, x==y -> P x -> P y) -> (m<=n -> P n) -> (n<=m -> P m) -> P (max n m). Proof. intros Compat Hl Hr. destruct (CompSpec2Type (compare_spec n m)) as [EQ|LT|GT]. - assert (n<=m) by (rewrite le_lteq; auto). apply (Compat m), Hr; auto. symmetry; apply max_r; auto. - assert (n<=m) by (rewrite le_lteq; auto). apply (Compat m), Hr; auto. symmetry; apply max_r; auto. - assert (m<=n) by (rewrite le_lteq; auto). apply (Compat n), Hl; auto. symmetry; apply max_l; auto. Defined. Lemma max_case n m (P:t -> Type) : (forall x y, x == y -> P x -> P y) -> P n -> P m -> P (max n m). Proof. intros. apply max_case_strong; auto. Defined. (** [max] returns one of its arguments. *) Lemma max_dec n m : {max n m == n} + {max n m == m}. Proof. apply max_case; auto with relations. intros x y H [E|E]; [left|right]; rewrite <-H; auto. Defined. (** Idem for [min] *) Lemma min_case_strong n m (P:O.t -> Type) : (forall x y, x == y -> P x -> P y) -> (n<=m -> P n) -> (m<=n -> P m) -> P (min n m). Proof. intros Compat Hl Hr. destruct (CompSpec2Type (compare_spec n m)) as [EQ|LT|GT]. - assert (n<=m) by (rewrite le_lteq; auto). apply (Compat n), Hl; auto. symmetry; apply min_l; auto. - assert (n<=m) by (rewrite le_lteq; auto). apply (Compat n), Hl; auto. symmetry; apply min_l; auto. - assert (m<=n) by (rewrite le_lteq; auto). apply (Compat m), Hr; auto. symmetry; apply min_r; auto. Defined. Lemma min_case n m (P:O.t -> Type) : (forall x y, x == y -> P x -> P y) -> P n -> P m -> P (min n m). Proof. intros. apply min_case_strong; auto. Defined. Lemma min_dec n m : {min n m == n} + {min n m == m}. Proof. intros. apply min_case; auto with relations. intros x y H [E|E]; [left|right]; rewrite <- E; auto with relations. Defined. End MinMaxDecProperties. Module MinMaxProperties (Import O:OrderedTypeFull')(Import M:HasMinMax O). Module OT := OTF_to_TotalOrder O. Include MinMaxLogicalProperties OT M. Include MinMaxDecProperties O M. Definition max_l := max_l. Definition max_r := max_r. Definition min_l := min_l. Definition min_r := min_r. Notation max_monotone := max_mono. Notation min_monotone := min_mono. Notation max_min_antimonotone := max_min_antimono. Notation min_max_antimonotone := min_max_antimono. End MinMaxProperties. (** ** When the equality is Leibniz, we can skip a few [Proper] precondition. *) Module UsualMinMaxLogicalProperties (Import O:UsualTotalOrder')(Import M:HasMinMax O). Include MinMaxLogicalProperties O M. Lemma max_monotone f : Proper (le ==> le) f -> forall x y, max (f x) (f y) = f (max x y). Proof. intros; apply max_mono; auto. congruence. Qed. Lemma min_monotone f : Proper (le ==> le) f -> forall x y, min (f x) (f y) = f (min x y). Proof. intros; apply min_mono; auto. congruence. Qed. Lemma min_max_antimonotone f : Proper (le ==> flip le) f -> forall x y, min (f x) (f y) = f (max x y). Proof. intros; apply min_max_antimono; auto. congruence. Qed. Lemma max_min_antimonotone f : Proper (le ==> flip le) f -> forall x y, max (f x) (f y) = f (min x y). Proof. intros; apply max_min_antimono; auto. congruence. Qed. End UsualMinMaxLogicalProperties. Module UsualMinMaxDecProperties (Import O:UsualOrderedTypeFull')(Import M:HasMinMax O). Module Import Private_Dec := MinMaxDecProperties O M. Lemma max_case_strong : forall n m (P:t -> Type), (m<=n -> P n) -> (n<=m -> P m) -> P (max n m). Proof. intros; apply max_case_strong; auto. congruence. Defined. Lemma max_case : forall n m (P:t -> Type), P n -> P m -> P (max n m). Proof. intros; apply max_case_strong; auto. Defined. Lemma max_dec : forall n m, {max n m = n} + {max n m = m}. Proof. exact max_dec. Defined. Lemma min_case_strong : forall n m (P:O.t -> Type), (n<=m -> P n) -> (m<=n -> P m) -> P (min n m). Proof. intros; apply min_case_strong; auto. congruence. Defined. Lemma min_case : forall n m (P:O.t -> Type), P n -> P m -> P (min n m). Proof. intros. apply min_case_strong; auto. Defined. Lemma min_dec : forall n m, {min n m = n} + {min n m = m}. Proof. exact min_dec. Defined. End UsualMinMaxDecProperties. Module UsualMinMaxProperties (Import O:UsualOrderedTypeFull')(Import M:HasMinMax O). Module OT := OTF_to_TotalOrder O. Include UsualMinMaxLogicalProperties OT M. Include UsualMinMaxDecProperties O M. Definition max_l := max_l. Definition max_r := max_r. Definition min_l := min_l. Definition min_r := min_r. End UsualMinMaxProperties. (** From [TotalOrder] and [HasMax] and [HasEqDec], we can prove that the order is decidable and build an [OrderedTypeFull]. *) Module TOMaxEqDec_to_Compare (Import O:TotalOrder')(Import M:HasMax O)(Import E:HasEqDec O) <: HasCompare O. Definition compare x y := if eq_dec x y then Eq else if eq_dec (M.max x y) y then Lt else Gt. Lemma compare_spec x y : CompSpec eq lt x y (compare x y). Proof. unfold compare; repeat destruct eq_dec; auto; constructor. - destruct (lt_total x y); auto. absurd (x==y); auto. transitivity (max x y); auto. symmetry. apply max_l. rewrite le_lteq; intuition. - destruct (lt_total y x); auto. absurd (max x y == y); auto. apply max_r; rewrite le_lteq; intuition auto with relations. Qed. End TOMaxEqDec_to_Compare. Module TOMaxEqDec_to_OTF (O:TotalOrder)(M:HasMax O)(E:HasEqDec O) <: OrderedTypeFull := O <+ E <+ TOMaxEqDec_to_Compare O M E. (** TODO: Some Remaining questions... --> Compare with a type-classes version ? --> Is max_unicity and max_unicity_ext really convenient to express that any possible definition of max will in fact be equivalent ? --> Is it possible to avoid copy-paste about min even more ? *) coq-8.20.0/theories/Structures/OrderedType.v000066400000000000000000000375011466560755400210350ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* X -> Prop) (x y : X) : Type := | LT : lt x y -> Compare lt eq x y | EQ : eq x y -> Compare lt eq x y | GT : lt y x -> Compare lt eq x y. Arguments LT [X lt eq x y] _. Arguments EQ [X lt eq x y] _. Arguments GT [X lt eq x y] _. Create HintDb ordered_type. Module Type MiniOrderedType. Parameter Inline t : Type. Parameter Inline eq : t -> t -> Prop. Parameter Inline lt : t -> t -> Prop. Axiom eq_refl : forall x : t, eq x x. Axiom eq_sym : forall x y : t, eq x y -> eq y x. Axiom eq_trans : forall x y z : t, eq x y -> eq y z -> eq x z. Axiom lt_trans : forall x y z : t, lt x y -> lt y z -> lt x z. Axiom lt_not_eq : forall x y : t, lt x y -> ~ eq x y. Parameter compare : forall x y : t, Compare lt eq x y. #[global] Hint Immediate eq_sym : ordered_type. #[global] Hint Resolve eq_refl eq_trans lt_not_eq lt_trans : ordered_type. End MiniOrderedType. Module Type OrderedType. Include MiniOrderedType. (** A [eq_dec] can be deduced from [compare] below. But adding this redundant field allows seeing an OrderedType as a DecidableType. *) Parameter eq_dec : forall x y, { eq x y } + { ~ eq x y }. End OrderedType. Module MOT_to_OT (Import O : MiniOrderedType) <: OrderedType. Include O. Definition eq_dec : forall x y : t, {eq x y} + {~ eq x y}. Proof with auto with ordered_type. intros x y; elim (compare x y); intro H; [ right | left | right ]... assert (~ eq y x)... Defined. End MOT_to_OT. (** * Ordered types properties *) (** Additional properties that can be derived from signature [OrderedType]. *) Module OrderedTypeFacts (Import O: OrderedType). #[global] Instance eq_equiv : Equivalence eq. Proof. split; [ exact eq_refl | exact eq_sym | exact eq_trans ]. Qed. Lemma lt_antirefl : forall x, ~ lt x x. Proof. intros x; intro; absurd (eq x x); auto with ordered_type. Qed. #[global] Instance lt_strorder : StrictOrder lt. Proof. split; [ exact lt_antirefl | exact lt_trans]. Qed. Lemma lt_eq : forall x y z, lt x y -> eq y z -> lt x z. Proof with auto with ordered_type. intros x y z H ?; destruct (compare x z) as [Hlt|Heq|Hlt]; auto. - elim (lt_not_eq H); apply eq_trans with z... - elim (lt_not_eq (lt_trans Hlt H))... Qed. Lemma eq_lt : forall x y z, eq x y -> lt y z -> lt x z. Proof with auto with ordered_type. intros x y z H H0; destruct (compare x z) as [Hlt|Heq|Hlt]; auto. - elim (lt_not_eq H0); apply eq_trans with x... - elim (lt_not_eq (lt_trans H0 Hlt))... Qed. #[global] Instance lt_compat : Proper (eq==>eq==>iff) lt. apply proper_sym_impl_iff_2; auto with *. intros x x' Hx y y' Hy H. apply eq_lt with x; auto with ordered_type. apply lt_eq with y; auto. Qed. Lemma lt_total : forall x y, lt x y \/ eq x y \/ lt y x. Proof. intros x y; destruct (compare x y); auto. Qed. Module TO. Definition t := t. Definition eq := eq. Definition lt := lt. Definition le x y := lt x y \/ eq x y. End TO. Module IsTO. Definition eq_equiv := eq_equiv. Definition lt_strorder := lt_strorder. Definition lt_compat := lt_compat. Definition lt_total := lt_total. Lemma le_lteq x y : TO.le x y <-> lt x y \/ eq x y. Proof. reflexivity. Qed. End IsTO. Module OrderTac := !MakeOrderTac TO IsTO. Ltac order := OrderTac.order. Lemma le_eq x y z : ~lt x y -> eq y z -> ~lt x z. Proof. order. Qed. Lemma eq_le x y z : eq x y -> ~lt y z -> ~lt x z. Proof. order. Qed. Lemma neq_eq x y z : ~eq x y -> eq y z -> ~eq x z. Proof. order. Qed. Lemma eq_neq x y z : eq x y -> ~eq y z -> ~eq x z. Proof. order. Qed. Lemma le_lt_trans x y z : ~lt y x -> lt y z -> lt x z. Proof. order. Qed. Lemma lt_le_trans x y z : lt x y -> ~lt z y -> lt x z. Proof. order. Qed. Lemma le_neq x y : ~lt x y -> ~eq x y -> lt y x. Proof. order. Qed. Lemma le_trans x y z : ~lt y x -> ~lt z y -> ~lt z x. Proof. order. Qed. Lemma le_antisym x y : ~lt y x -> ~lt x y -> eq x y. Proof. order. Qed. Lemma neq_sym x y : ~eq x y -> ~eq y x. Proof. order. Qed. Lemma lt_le x y : lt x y -> ~lt y x. Proof. order. Qed. Lemma gt_not_eq x y : lt y x -> ~ eq x y. Proof. order. Qed. Lemma eq_not_lt x y : eq x y -> ~ lt x y. Proof. order. Qed. Lemma eq_not_gt x y : eq x y -> ~ lt y x. Proof. order. Qed. Lemma lt_not_gt x y : lt x y -> ~ lt y x. Proof. order. Qed. #[global] Hint Resolve gt_not_eq eq_not_lt : ordered_type. #[global] Hint Immediate eq_lt lt_eq le_eq eq_le neq_eq eq_neq : ordered_type. #[global] Hint Resolve eq_not_gt lt_antirefl lt_not_gt : ordered_type. Lemma elim_compare_eq : forall x y : t, eq x y -> exists H : eq x y, compare x y = EQ H. Proof. intros x y H; case (compare x y); intros H'; try (exfalso; order). exists H'; auto. Qed. Lemma elim_compare_lt : forall x y : t, lt x y -> exists H : lt x y, compare x y = LT H. Proof. intros x y H; case (compare x y); intros H'; try (exfalso; order). exists H'; auto. Qed. Lemma elim_compare_gt : forall x y : t, lt y x -> exists H : lt y x, compare x y = GT H. Proof. intros x y H; case (compare x y); intros H'; try (exfalso; order). exists H'; auto. Qed. Ltac elim_comp := match goal with | |- ?e => match e with | context ctx [ compare ?a ?b ] => let H := fresh in (destruct (compare a b) as [H|H|H]; try order) end end. Ltac elim_comp_eq x y := elim (elim_compare_eq (x:=x) (y:=y)); [ intros _1 _2; rewrite _2; clear _1 _2 | auto ]. Ltac elim_comp_lt x y := elim (elim_compare_lt (x:=x) (y:=y)); [ intros _1 _2; rewrite _2; clear _1 _2 | auto ]. Ltac elim_comp_gt x y := elim (elim_compare_gt (x:=x) (y:=y)); [ intros _1 _2; rewrite _2; clear _1 _2 | auto ]. (** For compatibility reasons *) Definition eq_dec := eq_dec. Lemma lt_dec : forall x y : t, {lt x y} + {~ lt x y}. Proof. intros x y; elim (compare x y); [ left | right | right ]; auto with ordered_type. Defined. Definition eqb x y : bool := if eq_dec x y then true else false. Lemma eqb_alt : forall x y, eqb x y = match compare x y with EQ _ => true | _ => false end. Proof. unfold eqb; intros x y; destruct (eq_dec x y); elim_comp; auto. Qed. (* Specialization of results about lists modulo. *) Section ForNotations. Notation In:=(InA eq). Notation Inf:=(lelistA lt). Notation Sort:=(sort lt). Notation NoDup:=(NoDupA eq). Lemma In_eq : forall l x y, eq x y -> In x l -> In y l. Proof. exact (InA_eqA eq_equiv). Qed. Lemma ListIn_In : forall l x, List.In x l -> In x l. Proof. exact (In_InA eq_equiv). Qed. Lemma Inf_lt : forall l x y, lt x y -> Inf y l -> Inf x l. Proof. exact (InfA_ltA lt_strorder). Qed. Lemma Inf_eq : forall l x y, eq x y -> Inf y l -> Inf x l. Proof. exact (InfA_eqA eq_equiv lt_compat). Qed. Lemma Sort_Inf_In : forall l x a, Sort l -> Inf a l -> In x l -> lt a x. Proof. exact (SortA_InfA_InA eq_equiv lt_strorder lt_compat). Qed. Lemma ListIn_Inf : forall l x, (forall y, List.In y l -> lt x y) -> Inf x l. Proof. exact (@In_InfA t lt). Qed. Lemma In_Inf : forall l x, (forall y, In y l -> lt x y) -> Inf x l. Proof. exact (InA_InfA eq_equiv (ltA:=lt)). Qed. Lemma Inf_alt : forall l x, Sort l -> (Inf x l <-> (forall y, In y l -> lt x y)). Proof. exact (InfA_alt eq_equiv lt_strorder lt_compat). Qed. Lemma Sort_NoDup : forall l, Sort l -> NoDup l. Proof. exact (SortA_NoDupA eq_equiv lt_strorder lt_compat). Qed. End ForNotations. #[global] Hint Resolve ListIn_In Sort_NoDup Inf_lt : ordered_type. #[global] Hint Immediate In_eq Inf_lt : ordered_type. End OrderedTypeFacts. Module KeyOrderedType(O:OrderedType). Import O. Module MO:=OrderedTypeFacts(O). Import MO. Section Elt. Variable elt : Type. Notation key:=t. Definition eqk (p p':key*elt) := eq (fst p) (fst p'). Definition eqke (p p':key*elt) := eq (fst p) (fst p') /\ (snd p) = (snd p'). Definition ltk (p p':key*elt) := lt (fst p) (fst p'). #[local] Hint Unfold eqk eqke ltk : ordered_type. #[local] Hint Extern 2 (eqke ?a ?b) => split : ordered_type. (* eqke is stricter than eqk *) Lemma eqke_eqk : forall x x', eqke x x' -> eqk x x'. Proof. unfold eqk, eqke; intuition. Qed. (* ltk ignore the second components *) Lemma ltk_right_r : forall x k e e', ltk x (k,e) -> ltk x (k,e'). Proof. auto. Qed. Lemma ltk_right_l : forall x k e e', ltk (k,e) x -> ltk (k,e') x. Proof. auto. Qed. #[local] Hint Immediate ltk_right_r ltk_right_l : ordered_type. (* eqk, eqke are equalities, ltk is a strict order *) Lemma eqk_refl : forall e, eqk e e. Proof. auto with ordered_type. Qed. Lemma eqke_refl : forall e, eqke e e. Proof. auto with ordered_type. Qed. Lemma eqk_sym : forall e e', eqk e e' -> eqk e' e. Proof. auto with ordered_type. Qed. Lemma eqke_sym : forall e e', eqke e e' -> eqke e' e. Proof. unfold eqke; intuition auto with relations. Qed. Lemma eqk_trans : forall e e' e'', eqk e e' -> eqk e' e'' -> eqk e e''. Proof. eauto with ordered_type. Qed. Lemma eqke_trans : forall e e' e'', eqke e e' -> eqke e' e'' -> eqke e e''. Proof. unfold eqke; intuition; [ eauto with ordered_type | congruence ]. Qed. Lemma ltk_trans : forall e e' e'', ltk e e' -> ltk e' e'' -> ltk e e''. Proof. eauto with ordered_type. Qed. Lemma ltk_not_eqk : forall e e', ltk e e' -> ~ eqk e e'. Proof. unfold eqk, ltk; auto with ordered_type. Qed. Lemma ltk_not_eqke : forall e e', ltk e e' -> ~eqke e e'. Proof. unfold eqke, ltk; intuition; simpl in *; subst. match goal with H : lt _ _, H1 : eq _ _ |- _ => exact (lt_not_eq H H1) end. Qed. #[local] Hint Resolve eqk_trans eqke_trans eqk_refl eqke_refl : ordered_type. #[local] Hint Resolve ltk_trans ltk_not_eqk ltk_not_eqke : ordered_type. #[local] Hint Immediate eqk_sym eqke_sym : ordered_type. Global Instance eqk_equiv : Equivalence eqk. Proof. constructor; eauto with ordered_type. Qed. Global Instance eqke_equiv : Equivalence eqke. Proof. split; eauto with ordered_type. Qed. Global Instance ltk_strorder : StrictOrder ltk. Proof. constructor; eauto with ordered_type. intros x; apply (irreflexivity (x:=fst x)). Qed. Global Instance ltk_compat : Proper (eqk==>eqk==>iff) ltk. Proof. intros (x,e) (x',e') Hxx' (y,f) (y',f') Hyy'; compute. compute in Hxx'; compute in Hyy'. rewrite Hxx', Hyy'; auto. Qed. Global Instance ltk_compat' : Proper (eqke==>eqke==>iff) ltk. Proof. intros (x,e) (x',e') (Hxx',_) (y,f) (y',f') (Hyy',_); compute. compute in Hxx'; compute in Hyy'. rewrite Hxx', Hyy'; auto. Qed. (* Additional facts *) Lemma eqk_not_ltk : forall x x', eqk x x' -> ~ltk x x'. Proof. unfold eqk, ltk; simpl; auto with ordered_type. Qed. Lemma ltk_eqk : forall e e' e'', ltk e e' -> eqk e' e'' -> ltk e e''. Proof. eauto with ordered_type. Qed. Lemma eqk_ltk : forall e e' e'', eqk e e' -> ltk e' e'' -> ltk e e''. Proof. intros (k,e) (k',e') (k'',e''). unfold ltk, eqk; simpl; eauto with ordered_type. Qed. #[local] Hint Resolve eqk_not_ltk : ordered_type. #[local] Hint Immediate ltk_eqk eqk_ltk : ordered_type. Lemma InA_eqke_eqk : forall x m, InA eqke x m -> InA eqk x m. Proof. unfold eqke; induction 1; intuition. Qed. #[local] Hint Resolve InA_eqke_eqk : ordered_type. Definition MapsTo (k:key)(e:elt):= InA eqke (k,e). Definition In k m := exists e:elt, MapsTo k e m. Notation Sort := (sort ltk). Notation Inf := (lelistA ltk). #[local] Hint Unfold MapsTo In : ordered_type. (* An alternative formulation for [In k l] is [exists e, InA eqk (k,e) l] *) Lemma In_alt : forall k l, In k l <-> exists e, InA eqk (k,e) l. Proof with auto with ordered_type. intros k l; split; intros [y H]. - exists y... - induction H as [a l eq|a l H IH]. + destruct a as [k' y']. exists y'... + destruct IH as [e H0]. exists e... Qed. Lemma MapsTo_eq : forall l x y e, eq x y -> MapsTo x e l -> MapsTo y e l. Proof. intros l x y e **; unfold MapsTo in *; apply InA_eqA with (x,e); eauto with *. Qed. Lemma In_eq : forall l x y, eq x y -> In x l -> In y l. Proof. destruct 2 as (e,E); exists e; eapply MapsTo_eq; eauto. Qed. Lemma Inf_eq : forall l x x', eqk x x' -> Inf x' l -> Inf x l. Proof. exact (InfA_eqA eqk_equiv ltk_compat). Qed. Lemma Inf_lt : forall l x x', ltk x x' -> Inf x' l -> Inf x l. Proof. exact (InfA_ltA ltk_strorder). Qed. #[local] Hint Immediate Inf_eq : ordered_type. #[local] Hint Resolve Inf_lt : ordered_type. Lemma Sort_Inf_In : forall l p q, Sort l -> Inf q l -> InA eqk p l -> ltk q p. Proof. exact (SortA_InfA_InA eqk_equiv ltk_strorder ltk_compat). Qed. Lemma Sort_Inf_NotIn : forall l k e, Sort l -> Inf (k,e) l -> ~In k l. Proof. intros l k e H H0; red; intros H1. destruct H1 as [e' H2]. elim (@ltk_not_eqk (k,e) (k,e')). - eapply Sort_Inf_In; eauto with ordered_type. - red; simpl; auto with ordered_type. Qed. Lemma Sort_NoDupA: forall l, Sort l -> NoDupA eqk l. Proof. exact (SortA_NoDupA eqk_equiv ltk_strorder ltk_compat). Qed. Lemma Sort_In_cons_1 : forall e l e', Sort (e::l) -> InA eqk e' l -> ltk e e'. Proof. inversion 1; intros; eapply Sort_Inf_In; eauto. Qed. Lemma Sort_In_cons_2 : forall l e e', Sort (e::l) -> InA eqk e' (e::l) -> ltk e e' \/ eqk e e'. Proof. intros l; inversion_clear 2; auto with ordered_type. left; apply Sort_In_cons_1 with l; auto. Qed. Lemma Sort_In_cons_3 : forall x l k e, Sort ((k,e)::l) -> In x l -> ~eq x k. Proof. inversion_clear 1 as [|? ? H0 H1]; red; intros H H2. destruct (Sort_Inf_NotIn H0 H1 (In_eq H2 H)). Qed. Lemma In_inv : forall k k' e l, In k ((k',e) :: l) -> eq k k' \/ In k l. Proof. inversion 1 as [? H0]. inversion_clear H0 as [? ? H1|]; eauto with ordered_type. destruct H1; simpl in *; intuition. Qed. Lemma In_inv_2 : forall k k' e e' l, InA eqk (k, e) ((k', e') :: l) -> ~ eq k k' -> InA eqk (k, e) l. Proof. inversion_clear 1 as [? ? H0|? ? H0]; compute in H0; intuition. Qed. Lemma In_inv_3 : forall x x' l, InA eqke x (x' :: l) -> ~ eqk x x' -> InA eqke x l. Proof. inversion_clear 1 as [? ? H0|? ? H0]; compute in H0; intuition. Qed. End Elt. #[global] Hint Unfold eqk eqke ltk : ordered_type. #[global] Hint Extern 2 (eqke ?a ?b) => split : ordered_type. #[global] Hint Resolve eqk_trans eqke_trans eqk_refl eqke_refl : ordered_type. #[global] Hint Resolve ltk_trans ltk_not_eqk ltk_not_eqke : ordered_type. #[global] Hint Immediate eqk_sym eqke_sym : ordered_type. #[global] Hint Resolve eqk_not_ltk : ordered_type. #[global] Hint Immediate ltk_eqk eqk_ltk : ordered_type. #[global] Hint Resolve InA_eqke_eqk : ordered_type. #[global] Hint Unfold MapsTo In : ordered_type. #[global] Hint Immediate Inf_eq : ordered_type. #[global] Hint Resolve Inf_lt : ordered_type. #[global] Hint Resolve Sort_Inf_NotIn : ordered_type. #[global] Hint Resolve In_inv_2 In_inv_3 : ordered_type. End KeyOrderedType. coq-8.20.0/theories/Structures/OrderedTypeAlt.v000066400000000000000000000060561466560755400214770ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* t -> comparison. Infix "?=" := compare (at level 70, no associativity). Parameter compare_sym : forall x y, (y?=x) = CompOpp (x?=y). Parameter compare_trans : forall c x y z, (x?=y) = c -> (y?=z) = c -> (x?=z) = c. End OrderedTypeAlt. (** From this new presentation to the original one. *) Module OrderedType_from_Alt (O:OrderedTypeAlt) <: OrderedType. Import O. Definition t := t. Definition eq x y := (x?=y) = Eq. Definition lt x y := (x?=y) = Lt. Lemma eq_refl : forall x, eq x x. Proof. intro x. unfold eq. assert (H:=compare_sym x x). destruct (x ?= x); simpl in *; try discriminate; auto. Qed. Lemma eq_sym : forall x y, eq x y -> eq y x. Proof. unfold eq; intros. rewrite compare_sym. rewrite H; simpl; auto. Qed. Definition eq_trans := (compare_trans Eq). Definition lt_trans := (compare_trans Lt). Lemma lt_not_eq : forall x y, lt x y -> ~eq x y. Proof. unfold eq, lt; intros. rewrite H; discriminate. Qed. Definition compare : forall x y, Compare lt eq x y. Proof. intros. case_eq (x ?= y); intros. - apply EQ; auto. - apply LT; auto. - apply GT; red. rewrite compare_sym; rewrite H; auto. Defined. Definition eq_dec : forall x y, { eq x y } + { ~ eq x y }. Proof. intros; unfold eq. case (x ?= y); [ left | right | right ]; auto; discriminate. Defined. End OrderedType_from_Alt. (** From the original presentation to this alternative one. *) Module OrderedType_to_Alt (O:OrderedType) <: OrderedTypeAlt. Import O. Module MO:=OrderedTypeFacts(O). Import MO. Definition t := t. Definition compare x y := match compare x y with | LT _ => Lt | EQ _ => Eq | GT _ => Gt end. Infix "?=" := compare (at level 70, no associativity). Lemma compare_sym : forall x y, (y?=x) = CompOpp (x?=y). Proof. intros x y; unfold compare. destruct O.compare; elim_comp; simpl; auto. Qed. Lemma compare_trans : forall c x y z, (x?=y) = c -> (y?=z) = c -> (x?=z) = c. Proof. intros c x y z. destruct c; unfold compare; do 2 (destruct O.compare; intros; try discriminate); elim_comp; auto. Qed. End OrderedType_to_Alt. coq-8.20.0/theories/Structures/OrderedTypeEx.v000066400000000000000000000361101466560755400213250ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* t -> Prop. Definition eq_refl := @eq_refl t. Definition eq_sym := @eq_sym t. Definition eq_trans := @eq_trans t. Axiom lt_trans : forall x y z : t, lt x y -> lt y z -> lt x z. Axiom lt_not_eq : forall x y : t, lt x y -> ~ eq x y. Parameter compare : forall x y : t, Compare lt eq x y. Parameter eq_dec : forall x y : t, { eq x y } + { ~ eq x y }. End UsualOrderedType. (** a [UsualOrderedType] is in particular an [OrderedType]. *) Module UOT_to_OT (U:UsualOrderedType) <: OrderedType := U. (** [nat] is an ordered type with respect to the usual order on natural numbers. *) Module Nat_as_OT <: UsualOrderedType. Definition t := nat. Definition eq := @eq nat. Definition eq_refl := @eq_refl t. Definition eq_sym := @eq_sym t. Definition eq_trans := @eq_trans t. Definition lt := lt. Lemma lt_trans : forall x y z : t, lt x y -> lt y z -> lt x z. Proof. unfold lt; intros; apply Nat.lt_trans with y; auto. Qed. Lemma lt_not_eq : forall x y : t, lt x y -> ~ eq x y. Proof. unfold lt, eq; intros ? ? LT ->; revert LT; apply Nat.lt_irrefl. Qed. Definition compare x y : Compare lt eq x y. Proof. case_eq (Nat.compare x y); intro. - apply EQ. now apply nat_compare_eq. - apply LT. now apply nat_compare_Lt_lt. - apply GT. now apply nat_compare_Gt_gt. Defined. Definition eq_dec := eq_nat_dec. End Nat_as_OT. (** [Z] is an ordered type with respect to the usual order on integers. *) Local Open Scope Z_scope. Module Z_as_OT <: UsualOrderedType. Definition t := Z. Definition eq := @eq Z. Definition eq_refl := @eq_refl t. Definition eq_sym := @eq_sym t. Definition eq_trans := @eq_trans t. Definition lt (x y:Z) := (x y x ~ x=y. Proof. intros x y LT ->; revert LT; apply Z.lt_irrefl. Qed. Definition compare x y : Compare lt eq x y. Proof. case_eq (x ?= y); intro. - apply EQ. now apply Z.compare_eq. - apply LT. assumption. - apply GT. now apply Z.gt_lt. Defined. Definition eq_dec := Z.eq_dec. End Z_as_OT. (** [positive] is an ordered type with respect to the usual order on natural numbers. *) Local Open Scope positive_scope. Module Positive_as_OT <: UsualOrderedType. Definition t:=positive. Definition eq:=@eq positive. Definition eq_refl := @eq_refl t. Definition eq_sym := @eq_sym t. Definition eq_trans := @eq_trans t. Definition lt := Pos.lt. Definition lt_trans := Pos.lt_trans. Lemma lt_not_eq : forall x y : t, lt x y -> ~ eq x y. Proof. intros x y H. contradict H. rewrite H. apply Pos.lt_irrefl. Qed. Definition compare x y : Compare lt eq x y. Proof. case_eq (x ?= y); intros H. - apply EQ. now apply Pos.compare_eq. - apply LT; assumption. - apply GT. now apply Pos.gt_lt. Defined. Definition eq_dec := Pos.eq_dec. End Positive_as_OT. (** [N] is an ordered type with respect to the usual order on natural numbers. *) Module N_as_OT <: UsualOrderedType. Definition t:=N. Definition eq:=@eq N. Definition eq_refl := @eq_refl t. Definition eq_sym := @eq_sym t. Definition eq_trans := @eq_trans t. Definition lt := N.lt. Definition lt_trans := N.lt_trans. Definition lt_not_eq := N.lt_neq. Definition compare x y : Compare lt eq x y. Proof. case_eq (x ?= y)%N; intro. - apply EQ. now apply N.compare_eq. - apply LT. assumption. - apply GT. now apply N.gt_lt. Defined. Definition eq_dec := N.eq_dec. End N_as_OT. (** From two ordered types, we can build a new OrderedType over their cartesian product, using the lexicographic order. *) Module PairOrderedType(O1 O2:OrderedType) <: OrderedType. Module MO1:=OrderedTypeFacts(O1). Module MO2:=OrderedTypeFacts(O2). Definition t := prod O1.t O2.t. Definition eq x y := O1.eq (fst x) (fst y) /\ O2.eq (snd x) (snd y). Definition lt x y := O1.lt (fst x) (fst y) \/ (O1.eq (fst x) (fst y) /\ O2.lt (snd x) (snd y)). Lemma eq_refl : forall x : t, eq x x. Proof. intros (x1,x2); red; simpl; auto with ordered_type. Qed. Lemma eq_sym : forall x y : t, eq x y -> eq y x. Proof. intros (x1,x2) (y1,y2); unfold eq; simpl; intuition auto with relations. Qed. Lemma eq_trans : forall x y z : t, eq x y -> eq y z -> eq x z. Proof. intros (x1,x2) (y1,y2) (z1,z2); unfold eq; simpl; intuition eauto with ordered_type. Qed. Lemma lt_trans : forall x y z : t, lt x y -> lt y z -> lt x z. Proof. intros (x1,x2) (y1,y2) (z1,z2); unfold eq, lt; simpl; intuition. - left; eauto with ordered_type. - left; eapply MO1.lt_eq; eauto. - left; eapply MO1.eq_lt; eauto. - right; split; eauto with ordered_type. Qed. Lemma lt_not_eq : forall x y : t, lt x y -> ~ eq x y. Proof. intros (x1,x2) (y1,y2); unfold eq, lt; simpl; intuition. - apply (O1.lt_not_eq H0 H1). - apply (O2.lt_not_eq H3 H2). Qed. Definition compare : forall x y : t, Compare lt eq x y. intros (x1,x2) (y1,y2). destruct (O1.compare x1 y1). - apply LT; unfold lt; auto. - destruct (O2.compare x2 y2). + apply LT; unfold lt; auto. + apply EQ; unfold eq; auto. + apply GT; unfold lt; auto with ordered_type. - apply GT; unfold lt; auto. Defined. Definition eq_dec : forall x y : t, {eq x y} + {~ eq x y}. Proof. intros; elim (compare x y); intro H; [ right | left | right ]; auto. - auto using lt_not_eq. - assert (~ eq y x); auto using lt_not_eq, eq_sym. Defined. End PairOrderedType. (** Even if [positive] can be seen as an ordered type with respect to the usual order (see above), we can also use a lexicographic order over bits (lower bits are considered first). This is more natural when using [positive] as indexes for sets or maps (see FSetPositive and FMapPositive. *) Module PositiveOrderedTypeBits <: UsualOrderedType. Definition t:=positive. Definition eq:=@eq positive. Definition eq_refl := @eq_refl t. Definition eq_sym := @eq_sym t. Definition eq_trans := @eq_trans t. Fixpoint bits_lt (p q:positive) : Prop := match p, q with | xH, xI _ => True | xH, _ => False | xO p, xO q => bits_lt p q | xO _, _ => True | xI p, xI q => bits_lt p q | xI _, _ => False end. Definition lt:=bits_lt. Lemma bits_lt_trans : forall x y z : positive, bits_lt x y -> bits_lt y z -> bits_lt x z. Proof. induction x. - induction y; destruct z; simpl; eauto; intuition. - induction y; destruct z; simpl; eauto; intuition. - induction y; destruct z; simpl; eauto; intuition. Qed. Lemma lt_trans : forall x y z : t, lt x y -> lt y z -> lt x z. Proof. exact bits_lt_trans. Qed. Lemma bits_lt_antirefl : forall x : positive, ~ bits_lt x x. Proof. induction x; simpl; auto. Qed. Lemma lt_not_eq : forall x y : t, lt x y -> ~ eq x y. Proof. intros; intro. rewrite <- H0 in H; clear H0 y. unfold lt in H. exact (bits_lt_antirefl x H). Qed. Definition compare : forall x y : t, Compare lt eq x y. Proof. induction x; destruct y. + (* I I *) destruct (IHx y) as [l|e|g]. * apply LT; auto. * apply EQ; rewrite e; red; auto. * apply GT; auto. + (* I O *) apply GT; simpl; auto. + (* I H *) apply GT; simpl; auto. + (* O I *) apply LT; simpl; auto. + (* O O *) destruct (IHx y) as [l|e|g]. * apply LT; auto. * apply EQ; rewrite e; red; auto. * apply GT; auto. + (* O H *) apply LT; simpl; auto. + (* H I *) apply LT; simpl; auto. + (* H O *) apply GT; simpl; auto. + (* H H *) apply EQ; red; auto. Qed. Lemma eq_dec (x y: positive): {x = y} + {x <> y}. Proof. intros. case_eq (x ?= y); intros. - left. now apply Pos.compare_eq. - right. intro. subst y. now rewrite (Pos.compare_refl x) in *. - right. intro. subst y. now rewrite (Pos.compare_refl x) in *. Qed. End PositiveOrderedTypeBits. Module Ascii_as_OT <: UsualOrderedType. Definition t := ascii. Definition eq := @eq ascii. Definition eq_refl := @eq_refl t. Definition eq_sym := @eq_sym t. Definition eq_trans := @eq_trans t. Definition cmp : ascii -> ascii -> comparison := Ascii.compare. Lemma cmp_eq (a b : ascii): cmp a b = Eq <-> a = b. Proof. unfold cmp, Ascii.compare. rewrite N.compare_eq_iff. split. 2:{ intro. now subst. } intro H. rewrite<- (ascii_N_embedding a). rewrite<- (ascii_N_embedding b). now rewrite H. Qed. Lemma cmp_lt_nat (a b : ascii): cmp a b = Lt <-> (nat_of_ascii a < nat_of_ascii b)%nat. Proof. unfold cmp. unfold nat_of_ascii, Ascii.compare. rewrite N2Nat.inj_compare. rewrite Nat.compare_lt_iff. reflexivity. Qed. Lemma cmp_antisym (a b : ascii): cmp a b = CompOpp (cmp b a). Proof. unfold cmp. apply N.compare_antisym. Qed. Definition lt (x y : ascii) := (N_of_ascii x < N_of_ascii y)%N. Lemma lt_trans (x y z : ascii): lt x y -> lt y z -> lt x z. Proof. apply N.lt_trans. Qed. Lemma lt_not_eq (x y : ascii): lt x y -> x <> y. Proof. intros L H. subst. exact (N.lt_irrefl _ L). Qed. Local Lemma compare_helper_eq {a b : ascii} (E : cmp a b = Eq): a = b. Proof. now apply cmp_eq. Qed. Local Lemma compare_helper_gt {a b : ascii} (G : cmp a b = Gt): lt b a. Proof. now apply N.compare_gt_iff. Qed. Definition compare (a b : ascii) : Compare lt eq a b := match cmp a b as z return _ = z -> _ with | Lt => fun E => LT E | Gt => fun E => GT (compare_helper_gt E) | Eq => fun E => EQ (compare_helper_eq E) end Logic.eq_refl. Definition eq_dec (x y : ascii): {x = y} + { ~ (x = y)} := ascii_dec x y. End Ascii_as_OT. (** [String] is an ordered type with respect to the usual lexical order. *) Module String_as_OT <: UsualOrderedType. Definition t := string. Definition eq := @eq string. Definition eq_refl := @eq_refl t. Definition eq_sym := @eq_sym t. Definition eq_trans := @eq_trans t. Inductive lts : string -> string -> Prop := | lts_empty : forall a s, lts EmptyString (String a s) | lts_tail : forall a s1 s2, lts s1 s2 -> lts (String a s1) (String a s2) | lts_head : forall (a b : ascii) s1 s2, lt (nat_of_ascii a) (nat_of_ascii b) -> lts (String a s1) (String b s2). Definition lt := lts. Lemma nat_of_ascii_inverse a b : nat_of_ascii a = nat_of_ascii b -> a = b. Proof. intro H. rewrite <- (ascii_nat_embedding a). rewrite <- (ascii_nat_embedding b). apply f_equal; auto. Qed. Lemma lts_tail_unique a s1 s2 : lt (String a s1) (String a s2) -> lt s1 s2. Proof. intro H; inversion H; subst; auto. remember (nat_of_ascii a) as x. apply Nat.lt_irrefl in H1; inversion H1. Qed. Lemma lt_trans : forall x y z : t, lt x y -> lt y z -> lt x z. Proof. induction x; intros y z H1 H2. - destruct y as [| b y']; inversion H1. destruct z as [| c z']; inversion H2; constructor. - destruct y as [| b y']; inversion H1; subst; destruct z as [| c z']; inversion H2; subst. + constructor. eapply IHx; eauto. + constructor; assumption. + constructor; assumption. + constructor. eapply Nat.lt_trans; eassumption. Qed. Lemma lt_not_eq : forall x y : t, lt x y -> ~ eq x y. Proof. induction x; intros y LT. - inversion LT. intro. inversion H. - inversion LT; subst; intros EQ. * specialize (IHx s2 H2). inversion EQ; subst; auto. apply IHx; unfold eq; auto. * inversion EQ; subst; auto. apply Nat.lt_irrefl in H2; auto. Qed. Definition cmp : string -> string -> comparison := String.compare. Lemma cmp_eq (a b : string): cmp a b = Eq <-> a = b. Proof. revert b. induction a, b; try easy. cbn. remember (Ascii.compare _ _) as c eqn:Heqc. symmetry in Heqc. destruct c; split; try discriminate; try rewrite Ascii_as_OT.cmp_eq in Heqc; try subst; try rewrite IHa; intro H. { now subst. } { now inversion H. } { inversion H; subst. rewrite<- Heqc. now rewrite Ascii_as_OT.cmp_eq. } { inversion H; subst. rewrite<- Heqc. now rewrite Ascii_as_OT.cmp_eq. } Qed. Lemma cmp_antisym (a b : string): cmp a b = CompOpp (cmp b a). Proof. revert b. induction a, b; try easy. cbn. rewrite IHa. clear IHa. remember (Ascii.compare _ _) as c eqn:Heqc. symmetry in Heqc. destruct c; rewrite Ascii_as_OT.cmp_antisym in Heqc; destruct Ascii_as_OT.cmp; cbn in *; easy. Qed. Lemma cmp_lt (a b : string): cmp a b = Lt <-> lt a b. Proof. revert b. induction a as [ | a_head a_tail ], b; try easy; cbn. { split; trivial. intro. apply lts_empty. } remember (Ascii.compare _ _) as c eqn:Heqc. symmetry in Heqc. destruct c; split; intro H; try discriminate; trivial. { rewrite Ascii_as_OT.cmp_eq in Heqc. subst. apply String_as_OT.lts_tail. apply IHa_tail. assumption. } { rewrite Ascii_as_OT.cmp_eq in Heqc. subst. inversion H; subst. { rewrite IHa_tail. assumption. } exfalso. apply (Nat.lt_irrefl (nat_of_ascii a)). assumption. } { apply String_as_OT.lts_head. rewrite<- Ascii_as_OT.cmp_lt_nat. assumption. } { exfalso. inversion H; subst. { assert(X: Ascii.compare a a = Eq). { apply Ascii_as_OT.cmp_eq. trivial. } rewrite Heqc in X. discriminate. } rewrite<- Ascii_as_OT.cmp_lt_nat in *. unfold Ascii_as_OT.cmp in *. rewrite Heqc in *. discriminate. } Qed. Local Lemma compare_helper_lt {a b : string} (L : cmp a b = Lt): lt a b. Proof. now apply cmp_lt. Qed. Local Lemma compare_helper_gt {a b : string} (G : cmp a b = Gt): lt b a. Proof. rewrite cmp_antisym in G. rewrite CompOpp_iff in G. now apply cmp_lt. Qed. Local Lemma compare_helper_eq {a b : string} (E : cmp a b = Eq): a = b. Proof. now apply cmp_eq. Qed. Definition compare (a b : string) : Compare lt eq a b := match cmp a b as z return _ = z -> _ with | Lt => fun E => LT (compare_helper_lt E) | Gt => fun E => GT (compare_helper_gt E) | Eq => fun E => EQ (compare_helper_eq E) end Logic.eq_refl. Definition eq_dec (x y : string): {x = y} + { ~ (x = y)} := string_dec x y. End String_as_OT. coq-8.20.0/theories/Structures/Orders.v000066400000000000000000000256331466560755400200500ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* t -> Prop. End HasLt. Module Type HasLe (Import T:Typ). Parameter Inline(40) le : t -> t -> Prop. End HasLe. Module Type EqLt := Typ <+ HasEq <+ HasLt. Module Type EqLe := Typ <+ HasEq <+ HasLe. Module Type EqLtLe := Typ <+ HasEq <+ HasLt <+ HasLe. (** Versions with nice notations *) Module Type LtNotation (E:EqLt). Infix "<" := E.lt. Notation "x > y" := (y= y" := (y<=x) (only parsing). Notation "x <= y <= z" := (x<=y /\ y<=z). End LeNotation. Module Type LtLeNotation (E:EqLtLe). Include LtNotation E <+ LeNotation E. Notation "x <= y < z" := (x<=y /\ yeq==>iff) lt. End IsStrOrder. Module Type LeIsLtEq (Import E:EqLtLe'). Axiom le_lteq : forall x y, x<=y <-> x t -> comparison. End HasCmp. Module Type CmpNotation (T:Typ)(C:HasCmp T). Infix "?=" := C.compare (at level 70, no associativity). End CmpNotation. Module Type CmpSpec (Import E:EqLt')(Import C:HasCmp E). Axiom compare_spec : forall x y, CompareSpec (x==y) (x true | _ => false end. Lemma eqb_eq : forall x y, eqb x y = true <-> x==y. Proof. unfold eqb. intros x y. destruct (compare_spec x y) as [H|H|H]; split; auto; try discriminate. - intros EQ; rewrite EQ in H; elim (StrictOrder_Irreflexive _ H). - intros EQ; rewrite EQ in H; elim (StrictOrder_Irreflexive _ H). Qed. End Compare2EqBool. Module DSO_to_OT (O:DecStrOrder) <: OrderedType := O <+ Compare2EqBool <+ HasEqBool2Dec. (** From [OrderedType] To [OrderedTypeFull] (adding [<=]) *) Module OT_to_Full (O:OrderedType') <: OrderedTypeFull. Include O. Definition le x y := x x-> Sortclass. #[global] Hint Unfold is_true : core. Module Type HasLeb (Import T:Typ). Parameter Inline leb : t -> t -> bool. End HasLeb. Module Type HasLtb (Import T:Typ). Parameter Inline ltb : t -> t -> bool. End HasLtb. Module Type LebNotation (T:Typ)(E:HasLeb T). Infix "<=?" := E.leb (at level 70, no associativity). End LebNotation. Module Type LtbNotation (T:Typ)(E:HasLtb T). Infix " X.le x y. End LebSpec. Module Type LtbSpec (T:Typ)(X:HasLt T)(Y:HasLtb T). Parameter ltb_lt : forall x y, Y.ltb x y = true <-> X.lt x y. End LtbSpec. Module Type LeBool := Typ <+ HasLeb. Module Type LtBool := Typ <+ HasLtb. Module Type LeBool' := LeBool <+ LebNotation. Module Type LtBool' := LtBool <+ LtbNotation. Module Type LebIsTotal (Import X:LeBool'). Axiom leb_total : forall x y, (x <=? y) = true \/ (y <=? x) = true. End LebIsTotal. Module Type TotalLeBool := LeBool <+ LebIsTotal. Module Type TotalLeBool' := LeBool' <+ LebIsTotal. Module Type LebIsTransitive (Import X:LeBool'). Axiom leb_trans : Transitive X.leb. End LebIsTransitive. Module Type TotalTransitiveLeBool := TotalLeBool <+ LebIsTransitive. Module Type TotalTransitiveLeBool' := TotalLeBool' <+ LebIsTransitive. (** Grouping all boolean comparison functions *) Module Type HasBoolOrdFuns (T:Typ) := HasEqb T <+ HasLtb T <+ HasLeb T. Module Type HasBoolOrdFuns' (T:Typ) := HasBoolOrdFuns T <+ EqbNotation T <+ LtbNotation T <+ LebNotation T. Module Type BoolOrdSpecs (O:EqLtLe)(F:HasBoolOrdFuns O) := EqbSpec O O F <+ LtbSpec O O F <+ LebSpec O O F. Module Type OrderFunctions (E:EqLtLe) := HasCompare E <+ HasBoolOrdFuns E <+ BoolOrdSpecs E. Module Type OrderFunctions' (E:EqLtLe) := HasCompare E <+ CmpNotation E <+ HasBoolOrdFuns' E <+ BoolOrdSpecs E. (** * From [OrderedTypeFull] to [TotalTransitiveLeBool] *) Module OTF_to_TTLB (Import O : OrderedTypeFull') <: TotalTransitiveLeBool. Definition leb x y := match compare x y with Gt => false | _ => true end. Lemma leb_le : forall x y, leb x y <-> x <= y. Proof. intros x y. unfold leb. rewrite le_lteq. destruct (compare_spec x y) as [EQ|LT|GT]; split; auto. - discriminate. - intros LE. elim (StrictOrder_Irreflexive x). destruct LE as [LT|EQ]. + now transitivity y. + now rewrite <- EQ in GT. Qed. Lemma leb_total : forall x y, leb x y \/ leb y x. Proof. intros x y. rewrite 2 leb_le. rewrite 2 le_lteq. destruct (compare_spec x y); intuition. Qed. Lemma leb_trans : Transitive leb. Proof. intros x y z. rewrite !leb_le, !le_lteq. intros [Hxy|Hxy] [Hyz|Hyz]. - left; transitivity y; auto. - left; rewrite <- Hyz; auto. - left; rewrite Hxy; auto. - right; transitivity y; auto. Qed. Definition t := t. End OTF_to_TTLB. (** * From [TotalTransitiveLeBool] to [OrderedTypeFull] [le] is [leb ... = true]. [eq] is [le /\ swap le]. [lt] is [le /\ ~swap le]. *) Local Open Scope bool_scope. Module TTLB_to_OTF (Import O : TotalTransitiveLeBool') <: OrderedTypeFull. Definition t := t. Definition le x y : Prop := x <=? y. Definition eq x y : Prop := le x y /\ le y x. Definition lt x y : Prop := le x y /\ ~le y x. Definition compare x y := if x <=? y then (if y <=? x then Eq else Lt) else Gt. Lemma compare_spec : forall x y, CompSpec eq lt x y (compare x y). Proof. intros x y. unfold compare. case_eq (x <=? y). - case_eq (y <=? x). + constructor. split; auto. + constructor. split; congruence. - constructor. destruct (leb_total x y); split; congruence. Qed. Definition eqb x y := (x <=? y) && (y <=? x). Lemma eqb_eq : forall x y, eqb x y <-> eq x y. Proof. intros. unfold eq, eqb, le. case leb; simpl; intuition auto; discriminate. Qed. Include HasEqBool2Dec. #[global] Instance eq_equiv : Equivalence eq. Proof. split. - intros x; unfold eq, le. destruct (leb_total x x); auto. - intros x y; unfold eq, le. intuition. - intros x y z; unfold eq, le. intuition; apply leb_trans with y; auto. Qed. #[global] Instance lt_strorder : StrictOrder lt. Proof. split. - intros x. unfold lt; red; intuition. - intros x y z; unfold lt, le. intuition. + apply leb_trans with y; auto. + absurd (z <=? y); auto. apply leb_trans with x; auto. Qed. #[global] Instance lt_compat : Proper (eq ==> eq ==> iff) lt. Proof. apply proper_sym_impl_iff_2; auto with *. intros x x' Hx y y' Hy' H. unfold eq, lt, le in *. intuition. - apply leb_trans with x; auto. apply leb_trans with y; auto. - absurd (y <=? x); auto. apply leb_trans with x'; auto. apply leb_trans with y'; auto. Qed. Definition le_lteq : forall x y, le x y <-> lt x y \/ eq x y. Proof. intros x y. unfold lt, eq, le. split; [ | intuition ]. intros LE. case_eq (y <=? x); [right|left]; intuition auto; discriminate. Qed. End TTLB_to_OTF. coq-8.20.0/theories/Structures/OrdersAlt.v000066400000000000000000000156131466560755400205060ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* t -> comparison. Infix "?=" := compare (at level 70, no associativity). Parameter compare_sym : forall x y, (y?=x) = CompOpp (x?=y). Parameter compare_trans : forall c x y z, (x?=y) = c -> (y?=z) = c -> (x?=z) = c. End OrderedTypeAlt. (** ** From OrderedTypeOrig to OrderedType. *) Module Update_OT (O:OrderedTypeOrig) <: OrderedType. Include Update_DT O. (* Provides : t eq eq_equiv eq_dec *) Definition lt := O.lt. #[global] Instance lt_strorder : StrictOrder lt. Proof. split. - intros x Hx. apply (O.lt_not_eq Hx); auto with *. - exact O.lt_trans. Qed. #[global] Instance lt_compat : Proper (eq==>eq==>iff) lt. Proof. apply proper_sym_impl_iff_2; auto with *. intros x x' Hx y y' Hy H. assert (H0 : lt x' y). { destruct (O.compare x' y) as [H'|H'|H']; auto. - elim (O.lt_not_eq H). transitivity x'; auto with *. - elim (O.lt_not_eq (O.lt_trans H H')); auto. } destruct (O.compare x' y') as [H'|H'|H']; auto. - elim (O.lt_not_eq H). transitivity x'; auto with *. transitivity y'; auto with *. - elim (O.lt_not_eq (O.lt_trans H' H0)); auto with *. Qed. Definition compare x y := match O.compare x y with | EQ _ => Eq | LT _ => Lt | GT _ => Gt end. Lemma compare_spec : forall x y, CompSpec eq lt x y (compare x y). Proof. intros; unfold compare; destruct O.compare; auto. Qed. End Update_OT. (** ** From OrderedType to OrderedTypeOrig. *) Module Backport_OT (O:OrderedType) <: OrderedTypeOrig. Include Backport_DT O. (* Provides : t eq eq_refl eq_sym eq_trans eq_dec *) Definition lt := O.lt. Lemma lt_not_eq : forall x y, lt x y -> ~eq x y. Proof. intros x y L E; rewrite E in L. apply (StrictOrder_Irreflexive y); auto. Qed. Lemma lt_trans : Transitive lt. Proof. apply O.lt_strorder. Qed. Definition compare : forall x y, Compare lt eq x y. Proof. intros x y; destruct (CompSpec2Type (O.compare_spec x y)); [apply EQ|apply LT|apply GT]; auto. Defined. End Backport_OT. (** ** From OrderedTypeAlt to OrderedType. *) Module OT_from_Alt (Import O:OrderedTypeAlt) <: OrderedType. Definition t := t. Definition eq x y := (x?=y) = Eq. Definition lt x y := (x?=y) = Lt. #[global] Instance eq_equiv : Equivalence eq. Proof. split; red. - (* refl *) unfold eq; intros x. assert (H:=compare_sym x x). destruct (x ?= x); simpl in *; auto; discriminate. - (* sym *) unfold eq; intros x y H. rewrite compare_sym, H; simpl; auto. - (* trans *) apply compare_trans. Qed. #[global] Instance lt_strorder : StrictOrder lt. Proof. split; repeat red; unfold lt; try apply compare_trans. intros x H. assert (eq x x) by reflexivity. unfold eq in *; congruence. Qed. Lemma lt_eq : forall x y z, lt x y -> eq y z -> lt x z. Proof. unfold lt, eq; intros x y z Hxy Hyz. destruct (compare x z) eqn:Hxz; auto. - rewrite compare_sym, CompOpp_iff in Hyz. simpl in Hyz. rewrite (compare_trans Hxz Hyz) in Hxy; discriminate. - rewrite compare_sym, CompOpp_iff in Hxy. simpl in Hxy. rewrite (compare_trans Hxy Hxz) in Hyz; discriminate. Qed. Lemma eq_lt : forall x y z, eq x y -> lt y z -> lt x z. Proof. unfold lt, eq; intros x y z Hxy Hyz. destruct (compare x z) eqn:Hxz; auto. - rewrite compare_sym, CompOpp_iff in Hxy. simpl in Hxy. rewrite (compare_trans Hxy Hxz) in Hyz; discriminate. - rewrite compare_sym, CompOpp_iff in Hyz. simpl in Hyz. rewrite (compare_trans Hxz Hyz) in Hxy; discriminate. Qed. #[global] Instance lt_compat : Proper (eq==>eq==>iff) lt. Proof. apply proper_sym_impl_iff_2; auto with *. repeat red; intros. eapply lt_eq; eauto. eapply eq_lt; eauto. symmetry; auto. Qed. Definition compare := O.compare. Lemma compare_spec : forall x y, CompSpec eq lt x y (compare x y). Proof. unfold eq, lt, compare; intros. destruct (O.compare x y) eqn:H; auto. apply CompGt. rewrite compare_sym, H; auto. Qed. Definition eq_dec : forall x y, { eq x y } + { ~ eq x y }. Proof. intros; unfold eq. case (x ?= y); [ left | right | right ]; auto; discriminate. Defined. End OT_from_Alt. (** From the original presentation to this alternative one. *) Module OT_to_Alt (Import O:OrderedType) <: OrderedTypeAlt. Definition t := t. Definition compare := compare. Infix "?=" := compare (at level 70, no associativity). Lemma compare_sym : forall x y, (y?=x) = CompOpp (x?=y). Proof. intros x y; unfold compare. destruct (compare_spec x y) as [U|U|U]; destruct (compare_spec y x) as [V|V|V]; auto. - rewrite U in V. elim (StrictOrder_Irreflexive y); auto. - rewrite U in V. elim (StrictOrder_Irreflexive y); auto. - rewrite V in U. elim (StrictOrder_Irreflexive x); auto. - rewrite V in U. elim (StrictOrder_Irreflexive x); auto. - rewrite V in U. elim (StrictOrder_Irreflexive x); auto. - rewrite V in U. elim (StrictOrder_Irreflexive y); auto. Qed. Lemma compare_Eq : forall x y, compare x y = Eq <-> eq x y. Proof. unfold compare. intros x y; destruct (compare_spec x y); intuition; try discriminate. - rewrite H0 in H. elim (StrictOrder_Irreflexive y); auto. - rewrite H0 in H. elim (StrictOrder_Irreflexive y); auto. Qed. Lemma compare_Lt : forall x y, compare x y = Lt <-> lt x y. Proof. unfold compare. intros x y; destruct (compare_spec x y); intuition; try discriminate. - rewrite H in H0. elim (StrictOrder_Irreflexive y); auto. - rewrite H in H0. elim (StrictOrder_Irreflexive x); auto. Qed. Lemma compare_Gt : forall x y, compare x y = Gt <-> lt y x. Proof. intros x y. rewrite compare_sym, CompOpp_iff. apply compare_Lt. Qed. Lemma compare_trans : forall c x y z, (x?=y) = c -> (y?=z) = c -> (x?=z) = c. Proof. intros c x y z. destruct c; unfold compare; rewrite ?compare_Eq, ?compare_Lt, ?compare_Gt; transitivity y; auto. Qed. End OT_to_Alt. coq-8.20.0/theories/Structures/OrdersEx.v000066400000000000000000000201551466560755400203370ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* eq==>iff) lt. Proof. compute. intros (x1,x2) (x1',x2') (X1,X2) (y1,y2) (y1',y2') (Y1,Y2). rewrite X1,X2,Y1,Y2; intuition. Qed. Definition compare x y := match O1.compare (fst x) (fst y) with | Eq => O2.compare (snd x) (snd y) | Lt => Lt | Gt => Gt end. Lemma compare_spec : forall x y, CompSpec eq lt x y (compare x y). Proof. intros (x1,x2) (y1,y2); unfold compare; simpl. destruct (O1.compare_spec x1 y1); try (constructor; compute; auto). destruct (O2.compare_spec x2 y2); constructor; compute; auto with relations. Qed. End PairOrderedType. (** Even if [positive] can be seen as an ordered type with respect to the usual order (see above), we can also use a lexicographic order over bits (lower bits are considered first). This is more natural when using [positive] as indexes for sets or maps (see MSetPositive). *) Local Open Scope positive. Module PositiveOrderedTypeBits <: UsualOrderedType. Definition t:=positive. Include HasUsualEq <+ UsualIsEq. Definition eqb := Pos.eqb. Definition eqb_eq := Pos.eqb_eq. Include HasEqBool2Dec. Fixpoint bits_lt (p q:positive) : Prop := match p, q with | xH, xI _ => True | xH, _ => False | xO p, xO q => bits_lt p q | xO _, _ => True | xI p, xI q => bits_lt p q | xI _, _ => False end. Definition lt:=bits_lt. Lemma bits_lt_antirefl : forall x : positive, ~ bits_lt x x. Proof. induction x; simpl; auto. Qed. Lemma bits_lt_trans : forall x y z : positive, bits_lt x y -> bits_lt y z -> bits_lt x z. Proof. induction x; destruct y,z; simpl; eauto; intuition. Qed. #[global] Instance lt_compat : Proper (eq==>eq==>iff) lt. Proof. intros x x' Hx y y' Hy. rewrite Hx, Hy; intuition. Qed. #[global] Instance lt_strorder : StrictOrder lt. Proof. split; [ exact bits_lt_antirefl | exact bits_lt_trans ]. Qed. Fixpoint compare x y := match x, y with | x~1, y~1 => compare x y | _~1, _ => Gt | x~0, y~0 => compare x y | _~0, _ => Lt | 1, _~1 => Lt | 1, 1 => Eq | 1, _~0 => Gt end. Lemma compare_spec : forall x y, CompSpec eq lt x y (compare x y). Proof. unfold eq, lt. induction x; destruct y; try constructor; simpl; auto. - destruct (IHx y); subst; auto. - destruct (IHx y); subst; auto. Qed. End PositiveOrderedTypeBits. Module Ascii_as_OT <: UsualOrderedType. Definition t := ascii. Include HasUsualEq <+ UsualIsEq. Definition eqb := Ascii.eqb. Definition eqb_eq := Ascii.eqb_eq. Include HasEqBool2Dec. Definition compare (a b : ascii) := N_as_OT.compare (N_of_ascii a) (N_of_ascii b). Definition lt (a b : ascii) := N_as_OT.lt (N_of_ascii a) (N_of_ascii b). #[global] Instance lt_compat : Proper (eq==>eq==>iff) lt. Proof. intros x x' Hx y y' Hy. rewrite Hx, Hy; intuition. Qed. #[global] Instance lt_strorder : StrictOrder lt. Proof. split; unfold lt; [ intro | intros ??? ]; eapply N_as_OT.lt_strorder. Qed. Lemma compare_spec : forall x y, CompSpec eq lt x y (compare x y). Proof. intros x y; unfold eq, lt, compare. destruct (N_as_OT.compare_spec (N_of_ascii x) (N_of_ascii y)) as [H|H|H]; constructor; try assumption. now rewrite <- (ascii_N_embedding x), <- (ascii_N_embedding y), H. Qed. End Ascii_as_OT. (** [String] is an ordered type with respect to the usual lexical order. *) Module String_as_OT <: UsualOrderedType. Definition t := string. Include HasUsualEq <+ UsualIsEq. Definition eqb := String.eqb. Definition eqb_eq := String.eqb_eq. Include HasEqBool2Dec. Fixpoint compare (a b : string) := match a, b with | EmptyString, EmptyString => Eq | EmptyString, _ => Lt | String _ _, EmptyString => Gt | String a_head a_tail, String b_head b_tail => match Ascii_as_OT.compare a_head b_head with | Lt => Lt | Gt => Gt | Eq => compare a_tail b_tail end end. Definition lt (a b : string) := compare a b = Lt. #[global] Instance lt_compat : Proper (eq==>eq==>iff) lt. Proof. intros x x' Hx y y' Hy. rewrite Hx, Hy; intuition. Qed. Lemma compare_spec : forall x y, CompSpec eq lt x y (compare x y). Proof. unfold eq, lt. induction x as [|x xs IHxs], y as [|y ys]; cbn [compare]; try constructor; cbn [compare]; try reflexivity. specialize (IHxs ys). destruct (Ascii_as_OT.compare x y) eqn:H; [ destruct IHxs; constructor | constructor | constructor ]; cbn [compare]. all: destruct (Ascii_as_OT.compare_spec y x), (Ascii_as_OT.compare_spec x y); cbv [Ascii_as_OT.eq] in *; try congruence; subst. all: exfalso; eapply irreflexivity; (idtac + etransitivity); eassumption. Qed. #[global] Instance lt_strorder : StrictOrder lt. Proof. split; unfold lt; [ intro x | intros x y z ]; unfold complement. { induction x as [|x xs IHxs]; cbn [compare]; [ congruence | ]. destruct (Ascii_as_OT.compare x x) eqn:H; try congruence. exfalso; eapply irreflexivity; eassumption. } { revert x y z. induction x as [|x xs IHxs], y as [|y ys], z as [|z zs]; cbn [compare]; try congruence. specialize (IHxs ys zs). destruct (Ascii_as_OT.compare x y) eqn:Hxy, (Ascii_as_OT.compare y z) eqn:Hyz, (Ascii_as_OT.compare x z) eqn:Hxz; try intuition (congruence || eauto). all: destruct (Ascii_as_OT.compare_spec x y), (Ascii_as_OT.compare_spec y z), (Ascii_as_OT.compare_spec x z); try discriminate. all: unfold Ascii_as_OT.eq in *; subst. all: exfalso; eapply irreflexivity; (idtac + etransitivity); (idtac + etransitivity); eassumption. } Qed. End String_as_OT. coq-8.20.0/theories/Structures/OrdersFacts.v000066400000000000000000000313051466560755400210220ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* y==x := Equivalence_Symmetric x y. Definition eq_trans (x y z:t) : x==y -> y==z -> x==z := Equivalence_Transitive x y z. Definition lt_trans (x y z:t) : x y x b | _ => b' end). Proof. destruct eq_dec; elim_compare x y; auto; order. Qed. Lemma eqb_alt : forall x y, eqb x y = match compare x y with Eq => true | _ => false end. Proof. unfold eqb; intros; apply if_eq_dec. Qed. #[global] Instance eqb_compat : Proper (eq==>eq==>Logic.eq) eqb. Proof. intros x x' Hxx' y y' Hyy'. rewrite 2 eqb_alt, Hxx', Hyy'; auto. Qed. End OrderedTypeFacts. (** * Tests of the order tactic Is it at least capable of proving some basic properties ? *) Module OrderedTypeTest (Import O:OrderedType'). Module Import MO := OrderedTypeFacts O. Local Open Scope order. Lemma lt_not_eq x y : x ~x==y. Proof. order. Qed. Lemma lt_eq x y z : x y==z -> x y x y==z -> x<=z. Proof. order. Qed. Lemma eq_le x y z : x==y -> y<=z -> x<=z. Proof. order. Qed. Lemma neq_eq x y z : ~x==y -> y==z -> ~x==z. Proof. order. Qed. Lemma eq_neq x y z : x==y -> ~y==z -> ~x==z. Proof. order. Qed. Lemma le_lt_trans x y z : x<=y -> y x y<=z -> x y<=z -> x<=z. Proof. order. Qed. Lemma le_antisym x y : x<=y -> y<=x -> x==y. Proof. order. Qed. Lemma le_neq x y : x<=y -> ~x==y -> x ~y==x. Proof. order. Qed. Lemma lt_le x y : x x<=y. Proof. order. Qed. Lemma gt_not_eq x y : y ~x==y. Proof. order. Qed. Lemma eq_not_lt x y : x==y -> ~x ~ y ~ y ~xeq==>iff) lt. Proof. unfold lt; auto with *. Qed. Lemma le_lteq : forall x y, le x y <-> lt x y \/ eq x y. Proof. intros; unfold le, lt, flip. rewrite O.le_lteq; intuition auto with relations. Qed. Definition compare := flip O.compare. Lemma compare_spec : forall x y, CompSpec eq lt x y (compare x y). Proof. intros x y; unfold compare, eq, lt, flip. destruct (O.compare_spec y x); auto with relations. Qed. End OrderedTypeRev. Unset Implicit Arguments. (** * Order relations derived from a [compare] function. We factorize here some common properties for ZArith, NArith and co, where [lt] and [le] are defined in terms of [compare]. Note that we do not require anything here concerning compatibility of [compare] w.r.t [eq], nor anything concerning transitivity. *) Module Type CompareBasedOrder (Import E:EqLtLe')(Import C:HasCmp E). Include CmpNotation E C. Include IsEq E. Axiom compare_eq_iff : forall x y, (x ?= y) = Eq <-> x == y. Axiom compare_lt_iff : forall x y, (x ?= y) = Lt <-> x < y. Axiom compare_le_iff : forall x y, (x ?= y) <> Gt <-> x <= y. Axiom compare_antisym : forall x y, (y ?= x) = CompOpp (x ?= y). End CompareBasedOrder. Module Type CompareBasedOrderFacts (Import E:EqLtLe') (Import C:HasCmp E) (Import O:CompareBasedOrder E C). Lemma compare_spec x y : CompareSpec (x==y) (x x==y. Proof. apply compare_eq_iff. Qed. Lemma compare_refl x : (x ?= x) = Eq. Proof. now apply compare_eq_iff. Qed. Lemma compare_gt_iff x y : (x ?= y) = Gt <-> y Lt <-> y<=x. Proof. now rewrite <- compare_le_iff, compare_antisym, CompOpp_iff. Qed. Lemma compare_ngt_iff x y : (x ?= y) <> Gt <-> ~(y Lt <-> ~(x ~(x<=y). Proof. rewrite <- compare_le_iff. destruct compare; split; easy || now destruct 1. Qed. Lemma compare_nge_iff x y : (x ?= y) = Lt <-> ~(y<=x). Proof. now rewrite <- compare_nle_iff, compare_antisym, CompOpp_iff. Qed. Lemma lt_irrefl x : ~ (x n < m \/ n==m. Proof. rewrite <- compare_lt_iff, <- compare_le_iff, <- compare_eq_iff. destruct (n ?= m); now intuition. Qed. End CompareBasedOrderFacts. (** Basic facts about boolean comparisons *) Module Type BoolOrderFacts (Import E:EqLtLe') (Import C:HasCmp E) (Import F:HasBoolOrdFuns' E) (Import O:CompareBasedOrder E C) (Import S:BoolOrdSpecs E F). Include CompareBasedOrderFacts E C O. (** Nota : apart from [eqb_compare] below, facts about [eqb] are in BoolEqualityFacts *) (** Alternate specifications based on [BoolSpec] and [reflect] *) Lemma leb_spec0 x y : reflect (x<=y) (x<=?y). Proof. apply iff_reflect. symmetry. apply leb_le. Defined. Lemma leb_spec x y : BoolSpec (x<=y) (y ~ (x <= y). Proof. now rewrite <- not_true_iff_false, leb_le. Qed. Lemma leb_gt x y : x <=? y = false <-> y < x. Proof. now rewrite leb_nle, <- compare_lt_iff, compare_nge_iff. Qed. Lemma ltb_nlt x y : x ~ (x < y). Proof. now rewrite <- not_true_iff_false, ltb_lt. Qed. Lemma ltb_ge x y : x y <= x. Proof. now rewrite ltb_nlt, <- compare_le_iff, compare_ngt_iff. Qed. (** Basic equality laws for boolean tests *) Lemma leb_refl x : x <=? x = true. Proof. apply leb_le. apply lt_eq_cases. now right. Qed. Lemma leb_antisym x y : y <=? x = negb (x true | _ => false end. Proof. apply eq_true_iff_eq. rewrite eqb_eq, <- compare_eq_iff. now destruct compare. Qed. Lemma ltb_compare x y : (x true | _ => false end. Proof. apply eq_true_iff_eq. rewrite ltb_lt, <- compare_lt_iff. now destruct compare. Qed. Lemma leb_compare x y : (x <=? y) = match compare x y with Gt => false | _ => true end. Proof. apply eq_true_iff_eq. rewrite leb_le, <- compare_le_iff. now destruct compare. Qed. End BoolOrderFacts. coq-8.20.0/theories/Structures/OrdersLists.v000066400000000000000000000116001466560755400210540ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* In x l -> In y l. Proof. intros. rewrite <- H; auto. Qed. Lemma ListIn_In : forall l x, List.In x l -> In x l. Proof. exact (In_InA O.eq_equiv). Qed. Lemma Inf_lt : forall l x y, O.lt x y -> Inf y l -> Inf x l. Proof. exact (InfA_ltA O.lt_strorder). Qed. Lemma Inf_eq : forall l x y, O.eq x y -> Inf y l -> Inf x l. Proof. exact (InfA_eqA O.eq_equiv O.lt_compat). Qed. Lemma Sort_Inf_In : forall l x a, Sort l -> Inf a l -> In x l -> O.lt a x. Proof. exact (SortA_InfA_InA O.eq_equiv O.lt_strorder O.lt_compat). Qed. Lemma ListIn_Inf : forall l x, (forall y, List.In y l -> O.lt x y) -> Inf x l. Proof. exact (@In_InfA O.t O.lt). Qed. Lemma In_Inf : forall l x, (forall y, In y l -> O.lt x y) -> Inf x l. Proof. exact (InA_InfA O.eq_equiv (ltA:=O.lt)). Qed. Lemma Inf_alt : forall l x, Sort l -> (Inf x l <-> (forall y, In y l -> O.lt x y)). Proof. exact (InfA_alt O.eq_equiv O.lt_strorder O.lt_compat). Qed. Lemma Sort_NoDup : forall l, Sort l -> NoDup l. Proof. exact (SortA_NoDupA O.eq_equiv O.lt_strorder O.lt_compat) . Qed. #[global] Hint Resolve ListIn_In Sort_NoDup Inf_lt : core. #[global] Hint Immediate In_eq Inf_lt : core. End OrderedTypeLists. (** * Results about keys and data as manipulated in the future MMaps. *) Module KeyOrderedType(O:OrderedType). Include KeyDecidableType(O). (* provides eqk, eqke *) Local Notation key:=O.t. Local Open Scope signature_scope. Definition ltk {elt} : relation (key*elt) := O.lt @@1. #[global] Hint Unfold ltk : core. (* ltk is a strict order *) #[global] Instance ltk_strorder {elt} : StrictOrder (@ltk elt) := _. #[global] Instance ltk_compat {elt} : Proper (eqk==>eqk==>iff) (@ltk elt). Proof. unfold eqk, ltk; auto with *. Qed. #[global] Instance ltk_compat' {elt} : Proper (eqke==>eqke==>iff) (@ltk elt). Proof. eapply subrelation_proper; eauto with *. Qed. (* Additional facts *) #[global] Instance pair_compat {elt} : Proper (O.eq==>Logic.eq==>eqke) (@pair key elt). Proof. apply pair_compat. Qed. Section Elt. Variable elt : Type. Implicit Type p q : key*elt. Implicit Type l m : list (key*elt). Lemma ltk_not_eqk p q : ltk p q -> ~ eqk p q. Proof. intros LT EQ; rewrite EQ in LT. elim (StrictOrder_Irreflexive _ LT). Qed. Lemma ltk_not_eqke p q : ltk p q -> ~eqke p q. Proof. intros LT EQ; rewrite EQ in LT. elim (StrictOrder_Irreflexive _ LT). Qed. Notation Sort := (sort ltk). Notation Inf := (lelistA ltk). Lemma Inf_eq l x x' : eqk x x' -> Inf x' l -> Inf x l. Proof. now intros <-. Qed. Lemma Inf_lt l x x' : ltk x x' -> Inf x' l -> Inf x l. Proof. apply InfA_ltA; auto with *. Qed. #[local] Hint Immediate Inf_eq : core. #[local] Hint Resolve Inf_lt : core. Lemma Sort_Inf_In l p q : Sort l -> Inf q l -> InA eqk p l -> ltk q p. Proof. apply SortA_InfA_InA; auto with *. Qed. Lemma Sort_Inf_NotIn l k e : Sort l -> Inf (k,e) l -> ~In k l. Proof. intros; red; intros. destruct H1 as [e' H2]. elim (@ltk_not_eqk (k,e) (k,e')). - eapply Sort_Inf_In; eauto. - repeat red; reflexivity. Qed. Lemma Sort_NoDupA l : Sort l -> NoDupA eqk l. Proof. apply SortA_NoDupA; auto with *. Qed. Lemma Sort_In_cons_1 l p q : Sort (p::l) -> InA eqk q l -> ltk p q. Proof. intros; invlist sort; eapply Sort_Inf_In; eauto. Qed. Lemma Sort_In_cons_2 l p q : Sort (p::l) -> InA eqk q (p::l) -> ltk p q \/ eqk p q. Proof. intros; invlist InA; auto with relations. left; apply Sort_In_cons_1 with l; auto with relations. Qed. Lemma Sort_In_cons_3 x l k e : Sort ((k,e)::l) -> In x l -> ~O.eq x k. Proof. intros; invlist sort; red; intros. eapply Sort_Inf_NotIn; eauto using In_eq. Qed. End Elt. #[global] Hint Resolve ltk_not_eqk ltk_not_eqke : core. #[global] Hint Immediate Inf_eq : core. #[global] Hint Resolve Inf_lt : core. #[global] Hint Resolve Sort_Inf_NotIn : core. End KeyOrderedType. coq-8.20.0/theories/Structures/OrdersTac.v000066400000000000000000000223751466560755400205000ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* le y z -> le x z]. *) Inductive ord : Set := OEQ | OLT | OLE. Definition trans_ord o o' := match o, o' with | OEQ, _ => o' | _, OEQ => o | OLE, OLE => OLE | _, _ => OLT end. Local Infix "+" := trans_ord. (** ** The tactic requirements : a total order We need : - an equivalence [eq], - a strict order [lt] total and compatible with [eq], - a larger order [le] synonym for [lt\/eq]. This used to be provided here via a [TotalOrder], but for technical reasons related to extraction, we now ask for two separate parts: relations in a [EqLtLe] + properties in [IsTotalOrder]. Note that [TotalOrder = EqLtLe <+ IsTotalOrder] *) Module Type IsTotalOrder (O:EqLtLe) := IsEq O <+ IsStrOrder O <+ LeIsLtEq O <+ LtIsTotal O. (** ** Properties that will be used by the [order] tactic *) Module OrderFacts (Import O:EqLtLe)(P:IsTotalOrder O). Include EqLtLeNotation O. (** Reflexivity rules *) Lemma eq_refl : forall x, x==x. Proof. reflexivity. Qed. Lemma le_refl : forall x, x<=x. Proof. intros; rewrite P.le_lteq; right; reflexivity. Qed. Lemma lt_irrefl : forall x, ~ x y==x. Proof. auto with *. Qed. Lemma le_antisym : forall x y, x<=y -> y<=x -> x==y. Proof. intros x y; rewrite 2 P.le_lteq. intuition auto with relations. elim (StrictOrder_Irreflexive x); transitivity y; auto. Qed. Lemma neq_sym : forall x y, ~x==y -> ~y==x. Proof. auto using eq_sym. Qed. (** Transitivity rules : first, a generic formulation, then instances*) Ltac subst_eqns := match goal with | H : _==_ |- _ => (rewrite H || rewrite <- H); clear H; subst_eqns | _ => idtac end. Definition interp_ord o := match o with OEQ => O.eq | OLT => O.lt | OLE => O.le end. Local Notation "#" := interp_ord. Lemma trans o o' x y z : #o x y -> #o' y z -> #(o+o') x z. Proof. destruct o, o'; simpl; rewrite ?P.le_lteq; intuition auto; subst_eqns; pose proof (StrictOrder_Transitive x y z); eauto with *. Qed. Definition eq_trans x y z : x==y -> y==z -> x==z := @trans OEQ OEQ x y z. Definition le_trans x y z : x<=y -> y<=z -> x<=z := @trans OLE OLE x y z. Definition lt_trans x y z : x y x y x y<=z -> x y x y==z -> x y<=z -> x<=z := @trans OEQ OLE x y z. Definition le_eq x y z : x<=y -> y==z -> x<=z := @trans OLE OEQ x y z. Lemma eq_neq : forall x y z, x==y -> ~y==z -> ~x==z. Proof. eauto using eq_trans, eq_sym. Qed. Lemma neq_eq : forall x y z, ~x==y -> y==z -> ~x==z. Proof. eauto using eq_trans, eq_sym. Qed. (** (double) negation rules *) Lemma not_neq_eq : forall x y, ~~x==y -> x==y. Proof. intros x y H. destruct (P.lt_total x y) as [H'|[H'|H']]; auto; destruct H; intro H; rewrite H in H'; eapply lt_irrefl; eauto. Qed. Lemma not_ge_lt : forall x y, ~y<=x -> x x<=y. Proof. intros x y H. rewrite P.le_lteq. generalize (P.lt_total x y); intuition. Qed. Lemma le_neq_lt : forall x y, x<=y -> ~x==y -> x

~ (n|p)). Lemma Z_0_1_more x : 0<=x -> x=0 \/ x=1 \/ 1 prime p. Proof. split; intros (Hp,H). - (* prime -> prime' *) constructor; trivial; intros n Hn. constructor; auto with zarith; intros x Hxn Hxp. rewrite <- Z.divide_abs_l in Hxn, Hxp |- *. assert (Hx := Z.abs_nonneg x). set (y:=Z.abs x) in *; clearbody y; clear x; rename y into x. destruct (Z_0_1_more x Hx) as [->|[->|Hx']]. + exfalso. apply Z.divide_0_l in Hxn. absurd (1 <= n). * rewrite Hxn; red; auto. * intuition. + now exists 1. + elim (H x); auto. split; trivial. apply Z.le_lt_trans with n; try tauto. apply Z.divide_pos_le; auto with zarith. apply Z.lt_le_trans with (2 := proj1 Hn); red; auto. - (* prime' -> prime *) constructor; trivial. intros n Hn Hnp. case (Zis_gcd_unique n p n 1). + constructor; auto with zarith. + apply H; auto with zarith. now intuition; apply Z.lt_le_incl. + intros H1; intuition; subst n; discriminate. + intros H1; intuition; subst n; discriminate. Qed. Theorem square_not_prime: forall a, ~ prime (a * a). Proof. intros a Ha. rewrite <- (Z.abs_square a) in Ha. assert (H:=Z.abs_nonneg a). set (b:=Z.abs a) in *; clearbody b; clear a; rename b into a. rewrite <- prime_alt in Ha; destruct Ha as (Ha,Ha'). assert (H' : 1 < a) by now apply (Z.square_lt_simpl_nonneg 1). apply (Ha' a). + split; trivial. rewrite <- (Z.mul_1_l a) at 1. apply Z.mul_lt_mono_pos_r; auto. apply Z.lt_trans with (2 := H'); red; auto. + exists a; auto. Qed. Theorem prime_div_prime: forall p q, prime p -> prime q -> (p | q) -> p = q. Proof. intros p q H H1 H2; assert (Hp: 0 < p); try apply Z.lt_le_trans with 2; try apply prime_ge_2; auto with zarith. assert (Hq: 0 < q); try apply Z.lt_le_trans with 2; try apply prime_ge_2; auto with zarith. case prime_divisors with (2 := H2); auto. - intros H4; contradict Hp; subst; discriminate. - intros [H4| [H4 | H4]]; subst; auto. + contradict H; auto; apply not_prime_1. + contradict Hp; apply Zle_not_lt, (Z.opp_le_mono _ 0). now rewrite Z.opp_involutive; apply Z.lt_le_incl. Qed. Notation Zgcd_is_pos := Z.gcd_nonneg (only parsing). Theorem Zgcd_spec : forall x y : Z, {z : Z | Zis_gcd x y z /\ 0 <= z}. Proof. intros x y; exists (Z.gcd x y). split; [apply Zgcd_is_gcd | apply Z.gcd_nonneg]. Qed. Theorem Zdivide_Zgcd: forall p q r : Z, (p | q) -> (p | r) -> (p | Z.gcd q r). Proof. intros. now apply Z.gcd_greatest. Qed. Theorem Zis_gcd_gcd: forall a b c : Z, 0 <= c -> Zis_gcd a b c -> Z.gcd a b = c. Proof. intros a b c H1 H2. case (Zis_gcd_uniqueness_apart_sign a b c (Z.gcd a b)); auto. - apply Zgcd_is_gcd; auto. - Z.le_elim H1. + generalize (Z.gcd_nonneg a b); auto with zarith. intros H3 H4; contradict H3. rewrite <- (Z.opp_involutive (Z.gcd a b)), <- H4. now apply Zlt_not_le, Z.opp_lt_mono; rewrite Z.opp_involutive. + subst. now case (Z.gcd a b). Qed. Notation Zgcd_inv_0_l := Z.gcd_eq_0_l (only parsing). Notation Zgcd_inv_0_r := Z.gcd_eq_0_r (only parsing). Theorem Zgcd_div_swap0 : forall a b : Z, 0 < Z.gcd a b -> 0 < b -> (a / Z.gcd a b) * b = a * (b/Z.gcd a b). Proof. intros a b Hg Hb. assert (F := Zgcd_is_gcd a b); inversion F as [F1 F2 F3]. pattern b at 2; rewrite (Zdivide_Zdiv_eq (Z.gcd a b) b); auto. repeat rewrite Z.mul_assoc; f_equal. rewrite Z.mul_comm. rewrite <- Zdivide_Zdiv_eq; auto. Qed. Theorem Zgcd_div_swap : forall a b c : Z, 0 < Z.gcd a b -> 0 < b -> (c * a) / Z.gcd a b * b = c * a * (b/Z.gcd a b). Proof. intros a b c Hg Hb. assert (F := Zgcd_is_gcd a b); inversion F as [F1 F2 F3]. pattern b at 2; rewrite (Zdivide_Zdiv_eq (Z.gcd a b) b); auto. repeat rewrite Z.mul_assoc; f_equal. rewrite Zdivide_Zdiv_eq_2; auto. repeat rewrite <- Z.mul_assoc; f_equal. rewrite Z.mul_comm. rewrite <- Zdivide_Zdiv_eq; auto. Qed. Lemma Zgcd_ass a b c : Z.gcd (Z.gcd a b) c = Z.gcd a (Z.gcd b c). Proof. symmetry. apply Z.gcd_assoc. Qed. Notation Zgcd_Zabs := Z.gcd_abs_l (only parsing). Notation Zgcd_0 := Z.gcd_0_r (only parsing). Notation Zgcd_1 := Z.gcd_1_r (only parsing). #[global] Hint Resolve Z.gcd_0_r Z.gcd_1_r : zarith. Theorem Zgcd_1_rel_prime : forall a b, Z.gcd a b = 1 <-> rel_prime a b. Proof. unfold rel_prime; intros a b; split; intro H. - rewrite <- H; apply Zgcd_is_gcd. - case (Zis_gcd_unique a b (Z.gcd a b) 1); auto. + apply Zgcd_is_gcd. + intros H2; absurd (0 <= Z.gcd a b); auto with zarith. * rewrite H2; red; auto. * generalize (Z.gcd_nonneg a b); auto with zarith. Qed. Definition rel_prime_dec: forall a b, { rel_prime a b }+{ ~ rel_prime a b }. Proof. intros a b; case (Z.eq_dec (Z.gcd a b) 1); intros H1. - left; apply -> Zgcd_1_rel_prime; auto. - right; contradict H1; apply <- Zgcd_1_rel_prime; auto. Defined. Definition prime_dec_aux: forall p m, { forall n, 1 < n < m -> rel_prime n p } + { exists n, 1 < n < m /\ ~ rel_prime n p }. Proof. intros p m. case (Z_lt_dec 1 m); intros H1; [ | left; intros n ?; exfalso; contradict H1; apply Z.lt_trans with n; intuition]. pattern m; apply natlike_rec; auto with zarith. - left; intros n ?; exfalso. absurd (1 < 0); try discriminate. apply Z.lt_trans with n; intuition. - intros x Hx IH; destruct IH as [F|E]. + destruct (rel_prime_dec x p) as [Y|N]. * left; intros n [HH1 HH2]. rewrite Z.lt_succ_r in HH2. Z.le_elim HH2; subst; auto with zarith. * case (Z_lt_dec 1 x); intros HH1. -- right; exists x; split; auto with zarith. -- left; intros n [HHH1 HHH2]; contradict HHH1; auto with zarith. apply Zle_not_lt; apply Z.le_trans with x. ++ now apply Zlt_succ_le. ++ now apply Znot_gt_le; contradict HH1; apply Z.gt_lt. + right; destruct E as (n,((H0,H2),H3)); exists n; auto with zarith. - apply Z.le_trans with (2 := Z.lt_le_incl _ _ H1); discriminate. Defined. Definition prime_dec: forall p, { prime p }+{ ~ prime p }. Proof. intros p; case (Z_lt_dec 1 p); intros H1. + case (prime_dec_aux p p); intros H2. * left; apply prime_intro; auto. intros n (Hn1,Hn2). Z.le_elim Hn1; auto; subst n. constructor; auto with zarith. * right; intros H3; inversion_clear H3 as [Hp1 Hp2]. case H2; intros n [Hn1 Hn2]; case Hn2; auto with zarith. now apply Hp2; intuition; apply Z.lt_le_incl. + right; intros H3; inversion_clear H3 as [Hp1 Hp2]; case H1; auto. Defined. Theorem not_prime_divide: forall p, 1 < p -> ~ prime p -> exists n, 1 < n < p /\ (n | p). Proof. intros p Hp Hp1. case (prime_dec_aux p p); intros H1. - elim Hp1; constructor; auto. intros n (Hn1,Hn2). Z.le_elim Hn1; auto with zarith. subst n; constructor; auto with zarith. - case H1; intros n (Hn1,Hn2). destruct (Z_0_1_more _ (Z.gcd_nonneg n p)) as [H|[H|H]]. + exfalso. apply Z.gcd_eq_0_l in H. absurd (1 < n). * rewrite H; discriminate. * now intuition. + elim Hn2. red. rewrite <- H. apply Zgcd_is_gcd. + exists (Z.gcd n p); split; [ split; auto | apply Z.gcd_divide_r ]. apply Z.le_lt_trans with n; auto with zarith. * apply Z.divide_pos_le; auto with zarith. -- apply Z.lt_trans with 1; intuition. -- apply Z.gcd_divide_l. * intuition. Qed. coq-8.20.0/theories/ZArith/Zorder.v000066400000000000000000000347641466560755400171020ustar00rootroot00000000000000(* -*- coding: utf-8 -*- *) (************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* m}. Proof. unfold ">", "<". generalize (Z.compare_eq n m). destruct (n ?= m); [ left; right | left; left | right]; auto. Defined. Theorem Ztrichotomy n m : n < m \/ n = m \/ n > m. Proof. Z.swap_greater. apply Z.lt_trichotomy. Qed. (**********************************************************************) (** * Decidability of equality and order on Z *) Notation dec_eq := Z.eq_decidable (only parsing). Notation dec_Zle := Z.le_decidable (only parsing). Notation dec_Zlt := Z.lt_decidable (only parsing). Theorem dec_Zne n m : decidable (Zne n m). Proof. destruct (Z.eq_decidable n m); [right|left]; subst; auto. Qed. Theorem dec_Zgt n m : decidable (n > m). Proof. destruct (Z.lt_decidable m n); [left|right]; Z.swap_greater; auto. Qed. Theorem dec_Zge n m : decidable (n >= m). Proof. destruct (Z.le_decidable m n); [left|right]; Z.swap_greater; auto. Qed. Theorem not_Zeq n m : n <> m -> n < m \/ m < n. Proof. apply Z.lt_gt_cases. Qed. (** * Relating strict and large orders *) Notation Zgt_iff_lt := Z.gt_lt_iff (only parsing). Notation Zge_iff_le := Z.ge_le_iff (only parsing). Lemma Zle_not_lt n m : n <= m -> ~ m < n. Proof. apply Z.le_ngt. Qed. Lemma Zlt_not_le n m : n < m -> ~ m <= n. Proof. apply Z.lt_nge. Qed. Lemma Zle_not_gt n m : n <= m -> ~ n > m. Proof. trivial. Qed. Lemma Zgt_not_le n m : n > m -> ~ n <= m. Proof. Z.swap_greater. apply Z.lt_nge. Qed. Lemma Znot_ge_lt n m : ~ n >= m -> n < m. Proof. Z.swap_greater. apply Z.nle_gt. Qed. Lemma Znot_lt_ge n m : ~ n < m -> n >= m. Proof. trivial. Qed. Lemma Znot_gt_le n m: ~ n > m -> n <= m. Proof. trivial. Qed. Lemma Znot_le_gt n m : ~ n <= m -> n > m. Proof. Z.swap_greater. apply Z.nle_gt. Qed. Lemma not_Zne n m : ~ Zne n m -> n = m. Proof. intros H. destruct (Z.eq_decidable n m); [assumption|now elim H]. Qed. (** * Equivalence and order properties *) (** Reflexivity *) Notation Zeq_le := Z.eq_le_incl (only parsing). #[global] Hint Resolve Z.le_refl: zarith. (** Antisymmetry *) Notation Zle_antisym := Z.le_antisymm (only parsing). (** Asymmetry *) Notation Zlt_asym := Z.lt_asymm (only parsing). Lemma Zgt_asym n m : n > m -> ~ m > n. Proof. Z.swap_greater. apply Z.lt_asymm. Qed. (** Irreflexivity *) Notation Zlt_not_eq := Z.lt_neq (only parsing). Lemma Zgt_irrefl n : ~ n > n. Proof. Z.swap_greater. apply Z.lt_irrefl. Qed. (** Large = strict or equal *) Notation Zlt_le_weak := Z.lt_le_incl (only parsing). Notation Zle_lt_or_eq_iff := Z.lt_eq_cases (only parsing). Lemma Zle_lt_or_eq n m : n <= m -> n < m \/ n = m. Proof. apply Z.lt_eq_cases. Qed. (** Dichotomy *) Notation Zle_or_lt := Z.le_gt_cases (only parsing). (** Transitivity of strict orders *) Lemma Zgt_trans n m p : n > m -> m > p -> n > p. Proof. Z.swap_greater. intros; now transitivity m. Qed. (** Mixed transitivity *) Lemma Zle_gt_trans n m p : m <= n -> m > p -> n > p. Proof. Z.swap_greater. Z.order. Qed. Lemma Zgt_le_trans n m p : n > m -> p <= m -> n > p. Proof. Z.swap_greater. Z.order. Qed. (** Transitivity of large orders *) Lemma Zge_trans n m p : n >= m -> m >= p -> n >= p. Proof. Z.swap_greater. Z.order. Qed. #[global] Hint Resolve Z.le_trans: zarith. (** * Compatibility of order and operations on Z *) (** ** Successor *) (** Compatibility of successor wrt to order *) Lemma Zsucc_le_compat n m : m <= n -> Z.succ m <= Z.succ n. Proof. apply Z.succ_le_mono. Qed. Lemma Zsucc_lt_compat n m : n < m -> Z.succ n < Z.succ m. Proof. apply Z.succ_lt_mono. Qed. Lemma Zsucc_gt_compat n m : m > n -> Z.succ m > Z.succ n. Proof. Z.swap_greater. apply Z.succ_lt_mono. Qed. #[global] Hint Resolve Zsucc_le_compat: zarith. (** Simplification of successor wrt to order *) Lemma Zsucc_gt_reg n m : Z.succ m > Z.succ n -> m > n. Proof. Z.swap_greater. apply Z.succ_lt_mono. Qed. Lemma Zsucc_le_reg n m : Z.succ m <= Z.succ n -> m <= n. Proof. apply Z.succ_le_mono. Qed. Lemma Zsucc_lt_reg n m : Z.succ n < Z.succ m -> n < m. Proof. apply Z.succ_lt_mono. Qed. (** Special base instances of order *) Notation Zlt_succ := Z.lt_succ_diag_r (only parsing). Notation Zlt_pred := Z.lt_pred_l (only parsing). Lemma Zgt_succ n : Z.succ n > n. Proof. Z.swap_greater. apply Z.lt_succ_diag_r. Qed. Lemma Znot_le_succ n : ~ Z.succ n <= n. Proof. apply Z.lt_nge, Z.lt_succ_diag_r. Qed. (** Relating strict and large order using successor or predecessor *) Lemma Zgt_le_succ n m : m > n -> Z.succ n <= m. Proof. Z.swap_greater. apply Z.le_succ_l. Qed. Lemma Zle_gt_succ n m : n <= m -> Z.succ m > n. Proof. Z.swap_greater. apply Z.lt_succ_r. Qed. Lemma Zle_lt_succ n m : n <= m -> n < Z.succ m. Proof. apply Z.lt_succ_r. Qed. Lemma Zlt_le_succ n m : n < m -> Z.succ n <= m. Proof. apply Z.le_succ_l. Qed. Lemma Zgt_succ_le n m : Z.succ m > n -> n <= m. Proof. Z.swap_greater. apply Z.lt_succ_r. Qed. Lemma Zlt_succ_le n m : n < Z.succ m -> n <= m. Proof. apply Z.lt_succ_r. Qed. Lemma Zle_succ_gt n m : Z.succ n <= m -> m > n. Proof. Z.swap_greater. apply Z.le_succ_l. Qed. (** Weakening order *) Notation Zle_succ := Z.le_succ_diag_r (only parsing). Notation Zle_pred := Z.le_pred_l (only parsing). Notation Zlt_lt_succ := Z.lt_lt_succ_r (only parsing). Notation Zle_le_succ := Z.le_le_succ_r (only parsing). Lemma Zle_succ_le n m : Z.succ n <= m -> n <= m. Proof. intros. now apply Z.lt_le_incl, Z.le_succ_l. Qed. #[global] Hint Resolve Z.le_succ_diag_r: zarith. #[global] Hint Resolve Z.le_le_succ_r: zarith. (** Relating order wrt successor and order wrt predecessor *) Lemma Zgt_succ_pred n m : m > Z.succ n -> Z.pred m > n. Proof. Z.swap_greater. apply Z.lt_succ_lt_pred. Qed. Lemma Zlt_succ_pred n m : Z.succ n < m -> n < Z.pred m. Proof. apply Z.lt_succ_lt_pred. Qed. (** Relating strict order and large order on positive *) Lemma Zlt_0_le_0_pred n : 0 < n -> 0 <= Z.pred n. Proof. apply Z.lt_le_pred. Qed. Lemma Zgt_0_le_0_pred n : n > 0 -> 0 <= Z.pred n. Proof. Z.swap_greater. apply Z.lt_le_pred. Qed. (** Special cases of ordered integers *) Lemma Zle_neg_pos : forall p q:positive, Zneg p <= Zpos q. Proof. exact Pos2Z.neg_le_pos. Qed. Lemma Zgt_pos_0 : forall p:positive, Zpos p > 0. Proof. easy. Qed. (* weaker but useful (in [Z.pow] for instance) *) Lemma Zle_0_pos : forall p:positive, 0 <= Zpos p. Proof. exact Pos2Z.pos_is_nonneg. Qed. Lemma Zlt_neg_0 : forall p:positive, Zneg p < 0. Proof. exact Pos2Z.neg_is_neg. Qed. Lemma Zle_0_nat : forall n:nat, 0 <= Z.of_nat n. Proof. intros n; induction n; simpl; intros. - apply Z.le_refl. - easy. Qed. #[global] Hint Immediate Z.eq_le_incl: zarith. (** Derived lemma *) Lemma Zgt_succ_gt_or_eq n m : Z.succ n > m -> n > m \/ m = n. Proof. Z.swap_greater. intros. now apply Z.lt_eq_cases, Z.lt_succ_r. Qed. (** ** Addition *) (** Compatibility of addition wrt to order *) Notation Zplus_lt_le_compat := Z.add_lt_le_mono (only parsing). Notation Zplus_le_lt_compat := Z.add_le_lt_mono (only parsing). Notation Zplus_le_compat := Z.add_le_mono (only parsing). Notation Zplus_lt_compat := Z.add_lt_mono (only parsing). Lemma Zplus_gt_compat_l n m p : n > m -> p + n > p + m. Proof. Z.swap_greater. apply Z.add_lt_mono_l. Qed. Lemma Zplus_gt_compat_r n m p : n > m -> n + p > m + p. Proof. Z.swap_greater. apply Z.add_lt_mono_r. Qed. Lemma Zplus_le_compat_l n m p : n <= m -> p + n <= p + m. Proof. apply Z.add_le_mono_l. Qed. Lemma Zplus_le_compat_r n m p : n <= m -> n + p <= m + p. Proof. apply Z.add_le_mono_r. Qed. Lemma Zplus_lt_compat_l n m p : n < m -> p + n < p + m. Proof. apply Z.add_lt_mono_l. Qed. Lemma Zplus_lt_compat_r n m p : n < m -> n + p < m + p. Proof. apply Z.add_lt_mono_r. Qed. (** Compatibility of addition wrt to being positive *) Notation Zplus_le_0_compat := Z.add_nonneg_nonneg (only parsing). (** Simplification of addition wrt to order *) Lemma Zplus_le_reg_l n m p : p + n <= p + m -> n <= m. Proof. apply Z.add_le_mono_l. Qed. Lemma Zplus_le_reg_r n m p : n + p <= m + p -> n <= m. Proof. apply Z.add_le_mono_r. Qed. Lemma Zplus_lt_reg_l n m p : p + n < p + m -> n < m. Proof. apply Z.add_lt_mono_l. Qed. Lemma Zplus_lt_reg_r n m p : n + p < m + p -> n < m. Proof. apply Z.add_lt_mono_r. Qed. Lemma Zplus_gt_reg_l n m p : p + n > p + m -> n > m. Proof. Z.swap_greater. apply Z.add_lt_mono_l. Qed. Lemma Zplus_gt_reg_r n m p : n + p > m + p -> n > m. Proof. Z.swap_greater. apply Z.add_lt_mono_r. Qed. (** ** Multiplication *) (** Compatibility of multiplication by a positive wrt to order *) Lemma Zmult_le_compat_r n m p : n <= m -> 0 <= p -> n * p <= m * p. Proof. intros. now apply Z.mul_le_mono_nonneg_r. Qed. Lemma Zmult_le_compat_l n m p : n <= m -> 0 <= p -> p * n <= p * m. Proof. intros. now apply Z.mul_le_mono_nonneg_l. Qed. Lemma Zmult_lt_compat_r n m p : 0 < p -> n < m -> n * p < m * p. Proof. apply Z.mul_lt_mono_pos_r. Qed. Lemma Zmult_gt_compat_r n m p : p > 0 -> n > m -> n * p > m * p. Proof. Z.swap_greater. apply Z.mul_lt_mono_pos_r. Qed. Lemma Zmult_gt_0_lt_compat_r n m p : p > 0 -> n < m -> n * p < m * p. Proof. Z.swap_greater. apply Z.mul_lt_mono_pos_r. Qed. Lemma Zmult_gt_0_le_compat_r n m p : p > 0 -> n <= m -> n * p <= m * p. Proof. Z.swap_greater. apply Z.mul_le_mono_pos_r. Qed. Lemma Zmult_lt_0_le_compat_r n m p : 0 < p -> n <= m -> n * p <= m * p. Proof. apply Z.mul_le_mono_pos_r. Qed. Lemma Zmult_gt_0_lt_compat_l n m p : p > 0 -> n < m -> p * n < p * m. Proof. Z.swap_greater. apply Z.mul_lt_mono_pos_l. Qed. Lemma Zmult_lt_compat_l n m p : 0 < p -> n < m -> p * n < p * m. Proof. apply Z.mul_lt_mono_pos_l. Qed. Lemma Zmult_gt_compat_l n m p : p > 0 -> n > m -> p * n > p * m. Proof. Z.swap_greater. apply Z.mul_lt_mono_pos_l. Qed. Lemma Zmult_ge_compat_r n m p : n >= m -> p >= 0 -> n * p >= m * p. Proof. Z.swap_greater. intros. now apply Z.mul_le_mono_nonneg_r. Qed. Lemma Zmult_ge_compat_l n m p : n >= m -> p >= 0 -> p * n >= p * m. Proof. Z.swap_greater. intros. now apply Z.mul_le_mono_nonneg_l. Qed. Lemma Zmult_ge_compat n m p q : n >= p -> m >= q -> p >= 0 -> q >= 0 -> n * m >= p * q. Proof. Z.swap_greater. intros. now apply Z.mul_le_mono_nonneg. Qed. Lemma Zmult_le_compat n m p q : n <= p -> m <= q -> 0 <= n -> 0 <= m -> n * m <= p * q. Proof. intros. now apply Z.mul_le_mono_nonneg. Qed. (** Simplification of multiplication by a positive wrt to being positive *) Lemma Zmult_gt_0_lt_reg_r n m p : p > 0 -> n * p < m * p -> n < m. Proof. Z.swap_greater. apply Z.mul_lt_mono_pos_r. Qed. Lemma Zmult_lt_reg_r n m p : 0 < p -> n * p < m * p -> n < m. Proof. apply Z.mul_lt_mono_pos_r. Qed. Lemma Zmult_le_reg_r n m p : p > 0 -> n * p <= m * p -> n <= m. Proof. Z.swap_greater. apply Z.mul_le_mono_pos_r. Qed. Lemma Zmult_lt_0_le_reg_r n m p : 0 < p -> n * p <= m * p -> n <= m. Proof. apply Z.mul_le_mono_pos_r. Qed. Lemma Zmult_ge_reg_r n m p : p > 0 -> n * p >= m * p -> n >= m. Proof. Z.swap_greater. apply Z.mul_le_mono_pos_r. Qed. Lemma Zmult_gt_reg_r n m p : p > 0 -> n * p > m * p -> n > m. Proof. Z.swap_greater. apply Z.mul_lt_mono_pos_r. Qed. Lemma Zmult_lt_compat n m p q : 0 <= n < p -> 0 <= m < q -> n * m < p * q. Proof. intros (Hn,Hnp) (Hm,Hmq). now apply Z.mul_lt_mono_nonneg. Qed. Lemma Zmult_lt_compat2 n m p q : 0 < n <= p -> 0 < m < q -> n * m < p * q. Proof. intros (Hn, Hnp) (Hm,Hmq). apply Z.le_lt_trans with (p * m). - apply Z.mul_le_mono_pos_r; trivial. - apply Z.mul_lt_mono_pos_l; Z.order. Qed. (** Compatibility of multiplication by a positive wrt to being positive *) Notation Zmult_le_0_compat := Z.mul_nonneg_nonneg (only parsing). Notation Zmult_lt_0_compat := Z.mul_pos_pos (only parsing). Notation Zmult_lt_O_compat := Z.mul_pos_pos (only parsing). Lemma Zmult_gt_0_compat n m : n > 0 -> m > 0 -> n * m > 0. Proof. Z.swap_greater. apply Z.mul_pos_pos. Qed. (* To remove someday ... *) Lemma Zmult_gt_0_le_0_compat n m : n > 0 -> 0 <= m -> 0 <= m * n. Proof. Z.swap_greater. intros. apply Z.mul_nonneg_nonneg. - trivial. - now apply Z.lt_le_incl. Qed. (** Simplification of multiplication by a positive wrt to being positive *) Lemma Zmult_le_0_reg_r n m : n > 0 -> 0 <= m * n -> 0 <= m. Proof. Z.swap_greater. apply Z.mul_nonneg_cancel_r. Qed. Lemma Zmult_lt_0_reg_r n m : 0 < n -> 0 < m * n -> 0 < m. Proof. apply Z.mul_pos_cancel_r. Qed. Lemma Zmult_gt_0_lt_0_reg_r n m : n > 0 -> 0 < m * n -> 0 < m. Proof. Z.swap_greater. apply Z.mul_pos_cancel_r. Qed. Lemma Zmult_gt_0_reg_l n m : n > 0 -> n * m > 0 -> m > 0. Proof. Z.swap_greater. apply Z.mul_pos_cancel_l. Qed. (** ** Square *) (** Simplification of square wrt order *) Lemma Zlt_square_simpl n m : 0 <= n -> m * m < n * n -> m < n. Proof. apply Z.square_lt_simpl_nonneg. Qed. Lemma Zgt_square_simpl n m : n >= 0 -> n * n > m * m -> n > m. Proof. Z.swap_greater. apply Z.square_lt_simpl_nonneg. Qed. (** * Equivalence between inequalities *) Notation Zle_plus_swap := Z.le_add_le_sub_r (only parsing). Notation Zlt_plus_swap := Z.lt_add_lt_sub_r (only parsing). Notation Zlt_minus_simpl_swap := Z.lt_sub_pos (only parsing). Lemma Zeq_plus_swap n m p : n + p = m <-> n = m - p. Proof. apply Z.add_move_r. Qed. Lemma Zlt_0_minus_lt n m : 0 < n - m -> m < n. Proof. apply Z.lt_0_sub. Qed. Lemma Zle_0_minus_le n m : 0 <= n - m -> m <= n. Proof. apply Z.le_0_sub. Qed. Lemma Zle_minus_le_0 n m : m <= n -> 0 <= n - m. Proof. apply Z.le_0_sub. Qed. (** For compatibility *) Notation Zlt_O_minus_lt := Zlt_0_minus_lt (only parsing). coq-8.20.0/theories/ZArith/Zpow_alt.v000066400000000000000000000052371466560755400174250ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* 1 | Zpos p => Pos.iter_op Z.mul p n | Zneg p => 0 end. Infix "^^" := Zpower_alt (at level 30, right associativity) : Z_scope. Lemma Piter_mul_acc : forall f, (forall x y:Z, (f x)*y = f (x*y)) -> forall p k, Pos.iter f k p = (Pos.iter f 1 p)*k. Proof. intros f Hf. induction p; simpl; intros. - set (g := Pos.iter f 1 p) in *. now rewrite !IHp, Hf, Z.mul_assoc. - set (g := Pos.iter f 1 p) in *. now rewrite !IHp, Z.mul_assoc. - now rewrite Hf, Z.mul_1_l. Qed. Lemma Piter_op_square : forall p a, Pos.iter_op Z.mul p (a*a) = (Pos.iter_op Z.mul p a)*(Pos.iter_op Z.mul p a). Proof. induction p; simpl; intros; trivial. now rewrite IHp, Z.mul_shuffle1. Qed. Lemma Zpower_equiv a b : a^^b = a^b. Proof. destruct b as [|p|p]; trivial. unfold Zpower_alt, Z.pow, Z.pow_pos. revert a. induction p; simpl; intros. - f_equal. rewrite Piter_mul_acc. + now rewrite Piter_op_square, IHp. + intros. symmetry; apply Z.mul_assoc. - rewrite Piter_mul_acc. + now rewrite Piter_op_square, IHp. + intros. symmetry; apply Z.mul_assoc. - now Z.nzsimpl. Qed. Lemma Zpower_alt_0_r n : n^^0 = 1. Proof. reflexivity. Qed. Lemma Zpower_alt_succ_r a b : 0<=b -> a^^(Z.succ b) = a * a^^b. Proof. destruct b as [|b|b]; intros Hb; simpl. - now Z.nzsimpl. - now rewrite Pos.add_1_r, Pos.iter_op_succ by apply Z.mul_assoc. - now elim Hb. Qed. Lemma Zpower_alt_neg_r a b : b<0 -> a^^b = 0. Proof. now destruct b. Qed. Lemma Zpower_alt_Ppow p q : (Zpos p)^^(Zpos q) = Zpos (p^q). Proof. now rewrite Zpower_equiv, Pos2Z.inj_pow. Qed. coq-8.20.0/theories/ZArith/Zpow_def.v000066400000000000000000000027501466560755400174000ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* 0 < Z.pow_pos x p. Proof. intros. now apply (Z.pow_pos_nonneg x (Zpos p)). Qed. Notation Zpower_1_r := Z.pow_1_r (only parsing). Notation Zpower_1_l := Z.pow_1_l (only parsing). Notation Zpower_0_l := Z.pow_0_l' (only parsing). Notation Zpower_0_r := Z.pow_0_r (only parsing). Notation Zpower_2 := Z.pow_2_r (only parsing). Notation Zpower_gt_0 := Z.pow_pos_nonneg (only parsing). Notation Zpower_ge_0 := Z.pow_nonneg (only parsing). Notation Zpower_Zabs := Z.abs_pow (only parsing). Notation Zpower_Zsucc := Z.pow_succ_r (only parsing). Notation Zpower_mult := Z.pow_mul_r (only parsing). Notation Zpower_le_monotone2 := Z.pow_le_mono_r (only parsing). Theorem Zpower_le_monotone a b c : 0 < a -> 0 <= b <= c -> a^b <= a^c. Proof. intros. now apply Z.pow_le_mono_r. Qed. Theorem Zpower_lt_monotone a b c : 1 < a -> 0 <= b < c -> a^b < a^c. Proof. intros. apply Z.pow_lt_mono_r; lia. Qed. Theorem Zpower_gt_1 x y : 1 < x -> 0 < y -> 1 < x^y. Proof. apply Z.pow_gt_1. Qed. Theorem Zmult_power p q r : 0 <= r -> (p*q)^r = p^r * q^r. Proof. intros. apply Z.pow_mul_l. Qed. #[global] Hint Resolve Z.pow_nonneg Z.pow_pos_nonneg : zarith. Theorem Zpower_le_monotone3 a b c : 0 <= c -> 0 <= a <= b -> a^c <= b^c. Proof. intros. now apply Z.pow_le_mono_l. Qed. Lemma Zpower_le_monotone_inv a b c : 1 < a -> 0 < b -> a^b <= a^c -> b <= c. Proof. intros Ha Hb H. apply (Z.pow_le_mono_r_iff a); trivial. apply Z.lt_le_incl; apply (Z.pow_gt_1 a); trivial. apply Z.lt_le_trans with (a^b); trivial. now apply Z.pow_gt_1. Qed. Notation Zpower_nat_Zpower := Zpower_nat_Zpower (only parsing). Theorem Zpower2_lt_lin n : 0 <= n -> n < 2^n. Proof. intros. now apply Z.pow_gt_lin_r. Qed. Theorem Zpower2_le_lin n : 0 <= n -> n <= 2^n. Proof. intros. apply Z.lt_le_incl. now apply Z.pow_gt_lin_r. Qed. Lemma Zpower2_Psize n p : Zpos p < 2^(Z.of_nat n) <-> (Pos.size_nat p <= n)%nat. Proof. revert p; induction n as [|n IHn]. - intros p; destruct p; now split. - assert (Hn := Nat2Z.is_nonneg n). intros p; destruct p as [p|p|]; simpl Pos.size_nat. + specialize IHn with p. rewrite Nat2Z.inj_succ, Z.pow_succ_r; lia. + specialize IHn with p. rewrite Nat2Z.inj_succ, Z.pow_succ_r; lia. + split. * lia. * intros _. apply Z.pow_gt_1. -- easy. -- now rewrite Nat2Z.inj_succ, Z.lt_succ_r. Qed. (** * Z.pow and modulo *) Theorem Zpower_mod p q n : 0 < n -> (p^q) mod n = ((p mod n)^q) mod n. Proof. intros Hn; destruct (Z.le_gt_cases 0 q) as [H1|H1]. - pattern q; apply natlike_ind; trivial. clear q H1. intros q Hq Rec. rewrite !Z.pow_succ_r; trivial. rewrite Z.mul_mod_idemp_l by lia. rewrite Z.mul_mod, Rec, <- Z.mul_mod by lia. reflexivity. - rewrite !Z.pow_neg_r; auto with zarith. Qed. (** A direct way to compute Z.pow modulo **) Fixpoint Zpow_mod_pos (a: Z)(m: positive)(n : Z) : Z := match m with | xH => a mod n | xO m' => let z := Zpow_mod_pos a m' n in match z with | 0 => 0 | _ => (z * z) mod n end | xI m' => let z := Zpow_mod_pos a m' n in match z with | 0 => 0 | _ => (z * z * a) mod n end end. Definition Zpow_mod a m n := match m with | 0 => 1 mod n | Zpos p => Zpow_mod_pos a p n | Zneg p => 0 end. Theorem Zpow_mod_pos_correct a m n : n <> 0 -> Zpow_mod_pos a m n = (Z.pow_pos a m) mod n. Proof. intros Hn. induction m as [m IHm|m IHm|]. - rewrite Pos.xI_succ_xO at 2. rewrite <- Pos.add_1_r, <- Pos.add_diag. rewrite 2 Zpower_pos_is_exp, Zpower_pos_1_r. rewrite Z.mul_mod, (Z.mul_mod (Z.pow_pos a m)) by trivial. rewrite <- IHm, <- Z.mul_mod by trivial. simpl. now destruct (Zpow_mod_pos a m n). - rewrite <- Pos.add_diag at 2. rewrite Zpower_pos_is_exp. rewrite Z.mul_mod by trivial. rewrite <- IHm. simpl. now destruct (Zpow_mod_pos a m n). - now rewrite Zpower_pos_1_r. Qed. Theorem Zpow_mod_correct a m n : n <> 0 -> Zpow_mod a m n = (a ^ m) mod n. Proof. intros Hn. destruct m; simpl; trivial. - apply Zpow_mod_pos_correct; auto with zarith. Qed. (* Complements about power and number theory. *) Lemma Zpower_divide p q : 0 < q -> (p | p ^ q). Proof. exists (p^(q - 1)). rewrite Z.mul_comm, <- Z.pow_succ_r by lia; f_equal; lia. Qed. Theorem rel_prime_Zpower_r i p q : 0 <= i -> rel_prime p q -> rel_prime p (q^i). Proof. intros Hi Hpq; pattern i; apply natlike_ind; auto with zarith. - simpl. apply rel_prime_sym, rel_prime_1. - clear i Hi. intros i Hi Rec; rewrite Z.pow_succ_r; auto. apply rel_prime_mult; auto. Qed. Theorem rel_prime_Zpower i j p q : 0 <= i -> 0 <= j -> rel_prime p q -> rel_prime (p^i) (q^j). Proof. intros Hi Hj H. apply rel_prime_Zpower_r; trivial. apply rel_prime_sym. apply rel_prime_Zpower_r; trivial. now apply rel_prime_sym. Qed. Theorem prime_power_prime p q n : 0 <= n -> prime p -> prime q -> (p | q^n) -> p = q. Proof. intros Hn Hp Hq; pattern n; apply natlike_ind; auto; clear n Hn. - simpl; intros. assert (2<=p) by (apply prime_ge_2; auto). assert (p<=1) by (apply Z.divide_pos_le; auto with zarith). lia. - intros n Hn Rec. rewrite Z.pow_succ_r by trivial. intros H. assert (2<=p) by (apply prime_ge_2; auto). assert (2<=q) by (apply prime_ge_2; auto). destruct prime_mult with (2 := H); auto. apply prime_div_prime; auto. Qed. Theorem Zdivide_power_2 x p n : 0 <= n -> 0 <= x -> prime p -> (x | p^n) -> exists m, x = p^m. Proof. intros Hn Hx; revert p n Hn. generalize Hx. pattern x; apply Z_lt_induction; auto. clear x Hx; intros x IH Hx p n Hn Hp H. Z.le_elim Hx; subst. - apply Z.le_succ_l in Hx; simpl in Hx. Z.le_elim Hx; subst. + (* x > 1 *) case (prime_dec x); intros Hpr. * exists 1; rewrite Z.pow_1_r; apply prime_power_prime with n; auto. * case not_prime_divide with (2 := Hpr); auto. intros p1 ((Hp1, Hpq1),(q1,->)). assert (Hq1 : 0 < q1) by (apply Z.mul_lt_mono_pos_r with p1; lia). destruct (IH p1) with p n as (r1,Hr1). 3-4: assumption. 1-2: lia. -- transitivity (q1 * p1); trivial. exists q1; auto with zarith. -- destruct (IH q1) with p n as (r2,Hr2). 3-4: assumption. 2: lia. ++ split. ** lia. ** rewrite <- (Z.mul_1_r q1) at 1. apply Z.mul_lt_mono_pos_l; auto with zarith. ++ transitivity (q1 * p1); trivial. exists p1; auto with zarith. ++ exists (r2 + r1); subst. symmetry. apply Z.pow_add_r. ** generalize Hq1; case r2; now auto with zarith. ** generalize Hp1; case r1; now auto with zarith. + (* x = 1 *) exists 0; rewrite Z.pow_0_r; auto. - (* x = 0 *) exists n; destruct H as [? H]; rewrite Z.mul_0_r in H; auto. Qed. (** * Z.square: a direct definition of [z^2] *) Notation Psquare_correct := Pos.square_spec (only parsing). Notation Zsquare_correct := Z.square_spec (only parsing). coq-8.20.0/theories/ZArith/Zpower.v000066400000000000000000000253761466560755400171220ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* Z.mul z). Lemma Zpower_nat_0_r z : Zpower_nat z 0 = 1. Proof. reflexivity. Qed. Lemma Zpower_nat_succ_r n z : Zpower_nat z (S n) = z * (Zpower_nat z n). Proof. reflexivity. Qed. (** [Zpower_nat_is_exp] says [Zpower_nat] is a morphism for [plus : nat->nat->nat] and [Z.mul : Z->Z->Z] *) Lemma Zpower_nat_is_exp : forall (n m:nat) (z:Z), Zpower_nat z (n + m) = Zpower_nat z n * Zpower_nat z m. Proof. intros n; induction n as [|n IHn]. - intros. now rewrite Zpower_nat_0_r, Z.mul_1_l. - intros. simpl. now rewrite IHn, Z.mul_assoc. Qed. (** Conversions between powers of unary and binary integers *) Lemma Zpower_pos_nat (z : Z) (p : positive) : Z.pow_pos z p = Zpower_nat z (Pos.to_nat p). Proof. apply Pos2Nat.inj_iter. Qed. Lemma Zpower_nat_Z (z : Z) (n : nat) : Zpower_nat z n = z ^ (Z.of_nat n). Proof. induction n. - trivial. - rewrite Zpower_nat_succ_r, Nat2Z.inj_succ, Z.pow_succ_r. + now f_equal. + apply Nat2Z.is_nonneg. Qed. Theorem Zpower_nat_Zpower z n : 0 <= n -> z^n = Zpower_nat z (Z.abs_nat n). Proof. intros. now rewrite Zpower_nat_Z, Zabs2Nat.id_abs, Z.abs_eq. Qed. (** The function [(Z.pow_pos z)] is a morphism for [Pos.add : positive->positive->positive] and [Z.mul : Z->Z->Z] *) Lemma Zpower_pos_is_exp (n m : positive)(z:Z) : Z.pow_pos z (n + m) = Z.pow_pos z n * Z.pow_pos z m. Proof. now apply (Z.pow_add_r z (Zpos n) (Zpos m)). Qed. #[global] Hint Immediate Zpower_nat_is_exp Zpower_pos_is_exp : zarith. #[global] Hint Unfold Z.pow_pos Zpower_nat: zarith. Theorem Zpower_exp x n m : n >= 0 -> m >= 0 -> x ^ (n + m) = x ^ n * x ^ m. Proof. Z.swap_greater. apply Z.pow_add_r. Qed. Section Powers_of_2. (** * Powers of 2 *) (** For the powers of two, that will be widely used, a more direct calculus is possible. [shift n m] computes [2^n * m], i.e. [m] shifted by [n] positions *) Definition shift_nat (n:nat) (z:positive) := nat_rect _ z (fun _ => xO) n. Definition shift_pos (n z:positive) := Pos.iter xO z n. Definition shift (n:Z) (z:positive) := match n with | Z0 => z | Zpos p => Pos.iter xO z p | Zneg p => z end. Definition two_power_nat (n:nat) := Zpos (shift_nat n 1). Definition two_power_pos (x:positive) := Zpos (shift_pos x 1). Definition two_p (x:Z) := match x with | Z0 => 1 | Zpos y => two_power_pos y | Zneg y => 0 end. (** Equivalence with notions defined in BinInt *) Lemma shift_nat_equiv n p : shift_nat n p = Pos.shiftl_nat p n. Proof. reflexivity. Qed. Lemma shift_pos_equiv n p : shift_pos n p = Pos.shiftl p (Npos n). Proof. reflexivity. Qed. Lemma shift_equiv n p : 0<=n -> Zpos (shift n p) = Z.shiftl (Zpos p) n. Proof. destruct n. - trivial. - simpl; intros. now apply Pos.iter_swap_gen. - now destruct 1. Qed. Lemma two_power_nat_equiv n : two_power_nat n = 2 ^ (Z.of_nat n). Proof. induction n as [|n IHn]. - trivial. - now rewrite Nat2Z.inj_succ, Z.pow_succ_r, <- IHn by apply Nat2Z.is_nonneg. Qed. Lemma two_power_pos_equiv p : two_power_pos p = 2 ^ Zpos p. Proof. now apply Pos.iter_swap_gen. Qed. Lemma two_p_equiv x : two_p x = 2 ^ x. Proof. destruct x; trivial. apply two_power_pos_equiv. Qed. (** Properties of these old versions of powers of two *) Lemma two_power_nat_S n : two_power_nat (S n) = 2 * two_power_nat n. Proof. reflexivity. Qed. Lemma shift_nat_plus n m x : shift_nat (n + m) x = shift_nat n (shift_nat m x). Proof. induction n; simpl; now f_equal. Qed. Theorem shift_nat_correct n x : Zpos (shift_nat n x) = Zpower_nat 2 n * Zpos x. Proof. induction n as [|n IHn]. - trivial. - now rewrite Zpower_nat_succ_r, <- Z.mul_assoc, <- IHn. Qed. Theorem two_power_nat_correct n : two_power_nat n = Zpower_nat 2 n. Proof. now rewrite two_power_nat_equiv, Zpower_nat_Z. Qed. Lemma shift_pos_nat p x : shift_pos p x = shift_nat (Pos.to_nat p) x. Proof. apply Pos2Nat.inj_iter. Qed. Lemma two_power_pos_nat p : two_power_pos p = two_power_nat (Pos.to_nat p). Proof. unfold two_power_pos. now rewrite shift_pos_nat. Qed. Theorem shift_pos_correct p x : Zpos (shift_pos p x) = Z.pow_pos 2 p * Zpos x. Proof. now rewrite shift_pos_nat, Zpower_pos_nat, shift_nat_correct. Qed. Theorem two_power_pos_correct x : two_power_pos x = Z.pow_pos 2 x. Proof. apply two_power_pos_equiv. Qed. Theorem two_power_pos_is_exp x y : two_power_pos (x + y) = two_power_pos x * two_power_pos y. Proof. rewrite 3 two_power_pos_equiv. now apply (Z.pow_add_r 2 (Zpos x) (Zpos y)). Qed. Lemma two_p_correct x : two_p x = 2^x. Proof (two_p_equiv x). Theorem two_p_is_exp x y : 0 <= x -> 0 <= y -> two_p (x + y) = two_p x * two_p y. Proof. rewrite !two_p_equiv. apply Z.pow_add_r. Qed. Lemma two_p_gt_ZERO x : 0 <= x -> two_p x > 0. Proof. Z.swap_greater. rewrite two_p_equiv. now apply Z.pow_pos_nonneg. Qed. Lemma two_p_S x : 0 <= x -> two_p (Z.succ x) = 2 * two_p x. Proof. rewrite !two_p_equiv. now apply Z.pow_succ_r. Qed. Lemma two_p_pred x : 0 <= x -> two_p (Z.pred x) < two_p x. Proof. rewrite !two_p_equiv. intros. apply Z.pow_lt_mono_r; auto using Z.lt_pred_l. reflexivity. Qed. End Powers_of_2. #[global] Hint Resolve two_p_gt_ZERO: zarith. #[global] Hint Immediate two_p_pred two_p_S: zarith. Section power_div_with_rest. (** * Division by a power of two. *) (** To [x:Z] and [p:positive], [q],[r] are associated such that [x = 2^p.q + r] and [0 <= r < 2^p] *) (** Invariant: [d*q + r = d'*q + r /\ d' = 2*d /\ 0<=r (0, r) | Zpos xH => (0, d + r) | Zpos (xI n) => (Zpos n, d + r) | Zpos (xO n) => (Zpos n, r) | Zneg xH => (-1, d + r) | Zneg (xI n) => (Zneg n - 1, d + r) | Zneg (xO n) => (Zneg n, r) end, 2 * d). Definition Zdiv_rest (x:Z) (p:positive) := let (qr, d) := Pos.iter Zdiv_rest_aux (x, 0, 1) p in qr. Lemma Zdiv_rest_correct1 (x:Z) (p:positive) : let (_, d) := Pos.iter Zdiv_rest_aux (x, 0, 1) p in d = two_power_pos p. Proof. rewrite Pos2Nat.inj_iter, two_power_pos_nat. induction (Pos.to_nat p); simpl; trivial. destruct (nat_rect _ _ _ _) as ((q,r),d). unfold Zdiv_rest_aux. rewrite two_power_nat_S; now f_equal. Qed. Lemma Zdiv_rest_correct2 (x:Z) (p:positive) : let '(q,r,d) := Pos.iter Zdiv_rest_aux (x, 0, 1) p in x = q * d + r /\ 0 <= r < d. Proof. apply Pos.iter_invariant; [|rewrite Z.mul_1_r, Z.add_0_r; repeat split; auto; discriminate]. intros ((q,r),d) (H,(H1',H2')). unfold Zdiv_rest_aux. assert (H1 : 0 < d) by now apply Z.le_lt_trans with (1 := H1'). assert (H2 : 0 <= d + r) by now apply Z.add_nonneg_nonneg; auto; apply Z.lt_le_incl. assert (H3 : d + r < 2 * d) by now rewrite <-Z.add_diag; apply Zplus_lt_compat_l. assert (H4 : r < 2 * d) by now apply Z.lt_le_trans with (1 * d); [ rewrite Z.mul_1_l; auto | apply Zmult_le_compat_r; try discriminate; now apply Z.lt_le_incl]. destruct q as [ |[q|q| ]|[q|q| ]]. - repeat split; auto. - rewrite Pos2Z.inj_xI, Z.mul_add_distr_r in H. rewrite Z.mul_shuffle3, Z.mul_assoc. rewrite Z.mul_1_l in H; rewrite Z.add_assoc. repeat split; auto with zarith. - rewrite Pos2Z.inj_xO in H. rewrite Z.mul_shuffle3, Z.mul_assoc. repeat split; auto. - rewrite Z.mul_1_l in H; repeat split; auto. - rewrite Pos2Z.neg_xI, Z.mul_sub_distr_r in H. rewrite Z.mul_sub_distr_r, Z.mul_shuffle3, Z.mul_assoc. repeat split; auto. rewrite !Z.mul_1_l, H, Z.add_assoc. apply (f_equal2 Z.add); auto. rewrite <- Z.sub_sub_distr, <- !Z.add_diag, Z.add_simpl_r. now rewrite Z.mul_1_l. - rewrite Pos2Z.neg_xO in H. rewrite Z.mul_shuffle3, Z.mul_assoc. repeat split; auto. - repeat split; auto. rewrite H, (Z.mul_opp_l 1), Z.mul_1_l, Z.add_assoc. apply (f_equal2 Z.add); auto. rewrite Z.add_comm, <- Z.add_diag. rewrite Z.mul_add_distr_l. replace (-1 * d) with (-d). + now rewrite Z.add_assoc, Z.add_opp_diag_r . + now rewrite (Z.mul_opp_l 1), <-(Z.mul_opp_l 1). Qed. (** Old-style rich specification by proof of existence *) Inductive Zdiv_rest_proofs (x:Z) (p:positive) : Set := Zdiv_rest_proof : forall q r:Z, x = q * two_power_pos p + r -> 0 <= r -> r < two_power_pos p -> Zdiv_rest_proofs x p. Lemma Zdiv_rest_correct (x:Z) (p:positive) : Zdiv_rest_proofs x p. Proof. generalize (Zdiv_rest_correct1 x p); generalize (Zdiv_rest_correct2 x p). destruct (Pos.iter Zdiv_rest_aux (x, 0, 1) p) as ((q,r),d). intros (H1,(H2,H3)) ->. now exists q r. Qed. (** Direct correctness of [Zdiv_rest] *) Lemma Zdiv_rest_ok x p : let (q,r) := Zdiv_rest x p in x = q * 2^(Zpos p) + r /\ 0 <= r < 2^(Zpos p). Proof. unfold Zdiv_rest. generalize (Zdiv_rest_correct1 x p); generalize (Zdiv_rest_correct2 x p). destruct (Pos.iter Zdiv_rest_aux (x, 0, 1) p) as ((q,r),d). intros H ->. now rewrite two_power_pos_equiv in H. Qed. (** Equivalence with [Z.shiftr] *) Lemma Zdiv_rest_shiftr x p : fst (Zdiv_rest x p) = Z.shiftr x (Zpos p). Proof. generalize (Zdiv_rest_ok x p). destruct (Zdiv_rest x p) as (q,r). intros (H,H'). simpl. rewrite Z.shiftr_div_pow2 by easy. apply Z.div_unique_pos with r; trivial. now rewrite Z.mul_comm. Qed. End power_div_with_rest. coq-8.20.0/theories/ZArith/Zquot.v000066400000000000000000000330001466560755400167350ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* 0] condition whenever possible. *) Lemma Zrem_0_l a : Z.rem 0 a = 0. Proof. now destruct a. Qed. Lemma Zquot_0_l a : 0÷a = 0. Proof. now destruct a. Qed. #[global] Hint Resolve Zrem_0_l Zrem_0_r Zquot_0_l Zquot_0_r Z.quot_1_r Z.rem_1_r : zarith. Ltac zero_or_not a := destruct (Z.eq_decidable a 0) as [->|?]; [rewrite ?Zquot_0_l, ?Zrem_0_l, ?Zquot_0_r, ?Zrem_0_r; try lia; auto with zarith|]. Lemma Z_rem_same a : Z.rem a a = 0. Proof. zero_or_not a. now apply Z.rem_same. Qed. Lemma Z_rem_mult a b : Z.rem (a*b) b = 0. Proof. zero_or_not b. now apply Z.rem_mul. Qed. (** * Division and Opposite *) (* The precise equalities that are invalid with "historic" Zdiv. *) Theorem Zquot_opp_l a b : (-a)÷b = -(a÷b). Proof. zero_or_not b. now apply Z.quot_opp_l. Qed. Theorem Zquot_opp_r a b : a÷(-b) = -(a÷b). Proof. zero_or_not b. now apply Z.quot_opp_r. Qed. Theorem Zrem_opp_l a b : Z.rem (-a) b = -(Z.rem a b). Proof. zero_or_not b. now apply Z.rem_opp_l. Qed. Theorem Zrem_opp_r a b : Z.rem a (-b) = Z.rem a b. Proof. zero_or_not b. now apply Z.rem_opp_r. Qed. Theorem Zquot_opp_opp a b : (-a)÷(-b) = a÷b. Proof. zero_or_not b. now apply Z.quot_opp_opp. Qed. Theorem Zrem_opp_opp a b : Z.rem (-a) (-b) = -(Z.rem a b). Proof. zero_or_not b. now apply Z.rem_opp_opp. Qed. (** The sign of the remainder is the one of [a]. Due to the possible nullity of [a], a general result is to be stated in the following form: *) Theorem Zrem_sgn a b : 0 <= Z.sgn (Z.rem a b) * Z.sgn a. Proof. zero_or_not b. - zero_or_not (Z.rem a b). rewrite Z.rem_sign_nz; trivial. apply Z.square_nonneg. Qed. (** This can also be said in a simpler way: *) Theorem Zrem_sgn2 a b : 0 <= (Z.rem a b) * a. Proof. zero_or_not b. - apply Z.square_nonneg. - now apply Z.rem_sign_mul. Qed. (** Reformulation of [Z.rem_bound_abs] in 2 then 4 particular cases. *) Theorem Zrem_lt_pos a b : 0<=a -> b<>0 -> 0 <= Z.rem a b < Z.abs b. Proof. intros; generalize (Z.rem_nonneg a b) (Z.rem_bound_abs a b); lia. Qed. Theorem Zrem_lt_neg a b : a<=0 -> b<>0 -> -Z.abs b < Z.rem a b <= 0. Proof. intros; generalize (Z.rem_nonpos a b) (Z.rem_bound_abs a b); lia. Qed. Theorem Zrem_lt_pos_pos a b : 0<=a -> 0 0 <= Z.rem a b < b. Proof. intros; generalize (Zrem_lt_pos a b); lia. Qed. Theorem Zrem_lt_pos_neg a b : 0<=a -> b<0 -> 0 <= Z.rem a b < -b. Proof. intros; generalize (Zrem_lt_pos a b); lia. Qed. Theorem Zrem_lt_neg_pos a b : a<=0 -> 0 -b < Z.rem a b <= 0. Proof. intros; generalize (Zrem_lt_neg a b); lia. Qed. Theorem Zrem_lt_neg_neg a b : a<=0 -> b<0 -> b < Z.rem a b <= 0. Proof. intros; generalize (Zrem_lt_neg a b); lia. Qed. (** * Unicity results *) Definition Remainder a b r := (0 <= a /\ 0 <= r < Z.abs b) \/ (a <= 0 /\ -Z.abs b < r <= 0). Definition Remainder_alt a b r := Z.abs r < Z.abs b /\ 0 <= r * a. Lemma Remainder_equiv : forall a b r, Remainder a b r <-> Remainder_alt a b r. Proof. unfold Remainder, Remainder_alt; intuition auto with zarith. - lia. - lia. - rewrite <-(Z.mul_opp_opp). apply Z.mul_nonneg_nonneg; lia. - assert (0 <= Z.sgn r * Z.sgn a). { rewrite <-Z.sgn_mul, Z.sgn_nonneg; auto. } destruct r; simpl Z.sgn in *; lia. Qed. Theorem Zquot_mod_unique_full a b q r : Remainder a b r -> a = b*q + r -> q = a÷b /\ r = Z.rem a b. Proof. destruct 1 as [(H,H0)|(H,H0)]; intros. - apply Zdiv_mod_unique with b; auto. + apply Zrem_lt_pos; auto. lia. + rewrite <- H1; apply Z.quot_rem'. - rewrite <- (Z.opp_involutive a). rewrite Zquot_opp_l, Zrem_opp_l. generalize (Zdiv_mod_unique b (-q) (-a÷b) (-r) (Z.rem (-a) b)). generalize (Zrem_lt_pos (-a) b). rewrite <-Z.quot_rem', Z.mul_opp_r, <-Z.opp_add_distr, <-H1. lia. Qed. Theorem Zquot_unique_full a b q r : Remainder a b r -> a = b*q + r -> q = a÷b. Proof. intros; destruct (Zquot_mod_unique_full a b q r); auto. Qed. Theorem Zrem_unique_full a b q r : Remainder a b r -> a = b*q + r -> r = Z.rem a b. Proof. intros; destruct (Zquot_mod_unique_full a b q r); auto. Qed. (** * Order results about Zrem and Zquot *) (* Division of positive numbers is positive. *) Lemma Z_quot_pos a b : 0 <= a -> 0 <= b -> 0 <= a÷b. Proof. intros. zero_or_not b. apply Z.quot_pos; lia. Qed. (** As soon as the divisor is greater or equal than 2, the division is strictly decreasing. *) Lemma Z_quot_lt a b : 0 < a -> 2 <= b -> a÷b < a. Proof. intros. apply Z.quot_lt; lia. Qed. (** [<=] is compatible with a positive division. *) Lemma Z_quot_monotone a b c : 0<=c -> a<=b -> a÷c <= b÷c. Proof. intros. zero_or_not c. apply Z.quot_le_mono; lia. Qed. (** With our choice of division, rounding of (a÷b) is always done toward 0: *) Lemma Z_mult_quot_le a b : 0 <= a -> 0 <= b*(a÷b) <= a. Proof. intros. zero_or_not b. apply Z.mul_quot_le; auto with zarith. Qed. Lemma Z_mult_quot_ge a b : a <= 0 -> a <= b*(a÷b) <= 0. Proof. intros. zero_or_not b. apply Z.mul_quot_ge; auto with zarith. Qed. (** The previous inequalities between [b*(a÷b)] and [a] are exact iff the modulo is zero. *) Lemma Z_quot_exact_full a b : a = b*(a÷b) <-> Z.rem a b = 0. Proof. intros. zero_or_not b. apply Z.quot_exact; auto. Qed. (** A modulo cannot grow beyond its starting point. *) Theorem Zrem_le a b : 0 <= a -> 0 <= b -> Z.rem a b <= a. Proof. intros. zero_or_not b. apply Z.rem_le; lia. Qed. (** Some additional inequalities about Zdiv. *) Theorem Zquot_le_upper_bound: forall a b q, 0 < b -> a <= q*b -> a÷b <= q. Proof. intros a b q; rewrite Z.mul_comm; apply Z.quot_le_upper_bound. Qed. Theorem Zquot_lt_upper_bound: forall a b q, 0 <= a -> 0 < b -> a < q*b -> a÷b < q. Proof. intros a b q; rewrite Z.mul_comm; apply Z.quot_lt_upper_bound. Qed. Theorem Zquot_le_lower_bound: forall a b q, 0 < b -> q*b <= a -> q <= a÷b. Proof. intros a b q; rewrite Z.mul_comm; apply Z.quot_le_lower_bound. Qed. Theorem Zquot_sgn: forall a b, 0 <= Z.sgn (a÷b) * Z.sgn a * Z.sgn b. Proof. destruct a as [ |a|a]; destruct b as [ |b|b]; simpl; auto with zarith; unfold Z.quot; simpl; destruct N.pos_div_eucl; simpl; destruct n; simpl; auto with zarith. Qed. (** * Relations between usual operations and Z.modulo and Z.div *) (** First, a result that used to be always valid with Zdiv, but must be restricted here. For instance, now (9+(-5)*2) rem 2 = -1 <> 1 = 9 rem 2 *) Lemma Z_rem_plus : forall a b c:Z, 0 <= (a+b*c) * a -> Z.rem (a + b * c) c = Z.rem a c. Proof. intros. zero_or_not c. apply Z.rem_add; auto with zarith. Qed. Lemma Z_quot_plus : forall a b c:Z, 0 <= (a+b*c) * a -> c<>0 -> (a + b * c) ÷ c = a ÷ c + b. Proof. intros. apply Z.quot_add; auto with zarith. Qed. Theorem Z_quot_plus_l: forall a b c : Z, 0 <= (a*b+c)*c -> b<>0 -> b<>0 -> (a * b + c) ÷ b = a + c ÷ b. Proof. intros. apply Z.quot_add_l; auto with zarith. Qed. (** Cancellations. *) Lemma Zquot_mult_cancel_r : forall a b c:Z, c<>0 -> (a*c)÷(b*c) = a÷b. Proof. intros. zero_or_not b. apply Z.quot_mul_cancel_r; auto. Qed. Lemma Zquot_mult_cancel_l : forall a b c:Z, c<>0 -> (c*a)÷(c*b) = a÷b. Proof. intros. rewrite (Z.mul_comm c b). zero_or_not b. rewrite (Z.mul_comm b c). apply Z.quot_mul_cancel_l; auto. Qed. Lemma Zmult_rem_distr_l: forall a b c, Z.rem (c*a) (c*b) = c * (Z.rem a b). Proof. intros. zero_or_not c. rewrite (Z.mul_comm c b). zero_or_not b. rewrite (Z.mul_comm b c). apply Z.mul_rem_distr_l; auto. Qed. Lemma Zmult_rem_distr_r: forall a b c, Z.rem (a*c) (b*c) = (Z.rem a b) * c. Proof. intros. zero_or_not b. rewrite (Z.mul_comm b c). zero_or_not c. rewrite (Z.mul_comm c b). apply Z.mul_rem_distr_r; auto. Qed. (** Operations modulo. *) Theorem Zrem_rem: forall a n, Z.rem (Z.rem a n) n = Z.rem a n. Proof. intros. zero_or_not n. apply Z.rem_rem; auto. Qed. Theorem Zmult_rem: forall a b n, Z.rem (a * b) n = Z.rem (Z.rem a n * Z.rem b n) n. Proof. intros. zero_or_not n. apply Z.mul_rem; auto. Qed. (** addition and modulo Generally speaking, unlike with Zdiv, we don't have (a+b) rem n = (a rem n + b rem n) rem n for any a and b. For instance, take (8 + (-10)) rem 3 = -2 whereas (8 rem 3 + (-10 rem 3)) rem 3 = 1. *) Theorem Zplus_rem: forall a b n, 0 <= a * b -> Z.rem (a + b) n = Z.rem (Z.rem a n + Z.rem b n) n. Proof. intros. zero_or_not n. apply Z.add_rem; auto. Qed. Lemma Zplus_rem_idemp_l: forall a b n, 0 <= a * b -> Z.rem (Z.rem a n + b) n = Z.rem (a + b) n. Proof. intros. zero_or_not n. apply Z.add_rem_idemp_l; auto. Qed. Lemma Zplus_rem_idemp_r: forall a b n, 0 <= a*b -> Z.rem (b + Z.rem a n) n = Z.rem (b + a) n. Proof. intros. zero_or_not n. apply Z.add_rem_idemp_r; auto. rewrite Z.mul_comm; auto. Qed. Lemma Zmult_rem_idemp_l: forall a b n, Z.rem (Z.rem a n * b) n = Z.rem (a * b) n. Proof. intros. zero_or_not n. apply Z.mul_rem_idemp_l; auto. Qed. Lemma Zmult_rem_idemp_r: forall a b n, Z.rem (b * Z.rem a n) n = Z.rem (b * a) n. Proof. intros. zero_or_not n. apply Z.mul_rem_idemp_r; auto. Qed. (** Unlike with Zdiv, the following result is true without restrictions. *) Lemma Zquot_Zquot : forall a b c, (a÷b)÷c = a÷(b*c). Proof. intros. zero_or_not b. rewrite Z.mul_comm. zero_or_not c. rewrite Z.mul_comm. apply Z.quot_quot; auto. Qed. (** A last inequality: *) Theorem Zquot_mult_le: forall a b c, 0<=a -> 0<=b -> 0<=c -> c*(a÷b) <= (c*a)÷b. Proof. intros. zero_or_not b. apply Z.quot_mul_le; lia. Qed. (** Z.rem is related to divisibility (see more in Znumtheory) *) Lemma Zrem_divides : forall a b, Z.rem a b = 0 <-> exists c, a = b*c. Proof. intros. zero_or_not b. - firstorder. - rewrite Z.rem_divide; trivial. split; intros (c,Hc); exists c; subst; auto with zarith. Qed. (** Particular case : dividing by 2 is related with parity *) Lemma Zquot2_odd_remainder : forall a, Remainder a 2 (if Z.odd a then Z.sgn a else 0). Proof. intros [ |p|p]. - simpl. left. simpl. auto with zarith. - left. destruct p; simpl; lia. - right. destruct p; simpl; split; now auto with zarith. Qed. Lemma Zrem_odd : forall a, Z.rem a 2 = if Z.odd a then Z.sgn a else 0. Proof. intros. symmetry. apply Zrem_unique_full with (Z.quot2 a). - apply Zquot2_odd_remainder. - apply Zquot2_odd_eqn. Qed. Lemma Zrem_even : forall a, Z.rem a 2 = if Z.even a then 0 else Z.sgn a. Proof. intros a. rewrite Zrem_odd, Zodd_even_bool. now destruct Z.even. Qed. Lemma Zeven_rem : forall a, Z.even a = Z.eqb (Z.rem a 2) 0. Proof. intros a. rewrite Zrem_even. destruct a as [ |p|p]; trivial; now destruct p. Qed. Lemma Zodd_rem : forall a, Z.odd a = negb (Z.eqb (Z.rem a 2) 0). Proof. intros a. rewrite Zrem_odd. destruct a as [ |p|p]; trivial; now destruct p. Qed. (** * Interaction with "historic" Zdiv *) (** They agree at least on positive numbers: *) Theorem Zquotrem_Zdiv_eucl_pos : forall a b:Z, 0 <= a -> 0 < b -> a÷b = a/b /\ Z.rem a b = a mod b. Proof. intros. apply Zdiv_mod_unique with b. - apply Zrem_lt_pos; lia. - rewrite Z.abs_eq by lia. apply Z_mod_lt; lia. - rewrite <- Z_div_mod_eq_full. symmetry; apply Z.quot_rem; lia. Qed. Theorem Zquot_Zdiv_pos : forall a b, 0 <= a -> 0 <= b -> a÷b = a/b. Proof. intros a b Ha Hb. Z.le_elim Hb. - generalize (Zquotrem_Zdiv_eucl_pos a b Ha Hb); intuition. - subst; now rewrite Zquot_0_r, Zdiv_0_r. Qed. Theorem Zrem_Zmod_pos : forall a b, 0 <= a -> 0 < b -> Z.rem a b = a mod b. Proof. intros a b Ha Hb; generalize (Zquotrem_Zdiv_eucl_pos a b Ha Hb); intuition. Qed. (** Modulos are null at the same places *) Theorem Zrem_Zmod_zero : forall a b, b<>0 -> (Z.rem a b = 0 <-> a mod b = 0). Proof. intros. rewrite Zrem_divides, Zmod_divides; intuition. Qed. coq-8.20.0/theories/ZArith/Zwf.v000066400000000000000000000047511466560755400163740ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* Acc (Zwf c) a). { clear a; simple induction n; intros. - (** n= 0 *) case H; intros. + lia. + apply Acc_intro; unfold Zwf; intros. lia. - (** inductive case *) case H0; clear H0; intro; auto. apply Acc_intro; intros. apply H. unfold Zwf in H1. case (Z.le_gt_cases c y); intro. 2: lia. left. apply Nat.lt_le_trans with (f a); auto with arith. unfold f. lia. } apply (H (S (f a))); auto. Qed. End wf_proof. #[global] Hint Resolve Zwf_well_founded: datatypes. (** We also define the other family of relations: [x (Zwf_up c) y] iff [y < x <= c] *) Definition Zwf_up (c x y:Z) := y < x <= c. (** and we prove that [(Zwf_up c)] is well founded *) Section wf_proof_up. Variable c : Z. (** The proof of well-foundness is classic: we do the proof by induction on a measure in nat, which is here [|c-x|] *) Let f (z:Z) := Z.abs_nat (c - z). Lemma Zwf_up_well_founded : well_founded (Zwf_up c). Proof. apply well_founded_lt_compat with (f := f). unfold Zwf_up, f. lia. Qed. End wf_proof_up. #[global] Hint Resolve Zwf_up_well_founded: datatypes. coq-8.20.0/theories/ZArith/auxiliary.v000066400000000000000000000047621466560755400176370ustar00rootroot00000000000000(* -*- coding: utf-8 -*- *) (************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* Zne (n + - m) 0. Proof. unfold Zne. now rewrite <- Z.sub_move_0_r. Qed. Theorem Zegal_left n m : n = m -> n + - m = 0. Proof. apply Z.sub_move_0_r. Qed. Theorem Zle_left n m : n <= m -> 0 <= m + - n. Proof. apply Z.le_0_sub. Qed. Theorem Zle_left_rev n m : 0 <= m + - n -> n <= m. Proof. apply Z.le_0_sub. Qed. Theorem Zlt_left_rev n m : 0 < m + - n -> n < m. Proof. apply Z.lt_0_sub. Qed. Theorem Zlt_left_lt n m : n < m -> 0 < m + - n. Proof. apply Z.lt_0_sub. Qed. Theorem Zlt_left n m : n < m -> 0 <= m + -1 + - n. Proof. intros. rewrite Z.add_shuffle0. change (-1) with (- Z.succ 0). now apply Z.le_0_sub, Z.le_succ_l, Z.lt_0_sub. Qed. Theorem Zge_left n m : n >= m -> 0 <= n + - m. Proof. Z.swap_greater. apply Z.le_0_sub. Qed. Theorem Zgt_left n m : n > m -> 0 <= n + -1 + - m. Proof. Z.swap_greater. apply Zlt_left. Qed. Theorem Zgt_left_gt n m : n > m -> n + - m > 0. Proof. Z.swap_greater. apply Z.lt_0_sub. Qed. Theorem Zgt_left_rev n m : n + - m > 0 -> n > m. Proof. Z.swap_greater. apply Z.lt_0_sub. Qed. Theorem Zle_mult_approx n m p : n > 0 -> p > 0 -> 0 <= m -> 0 <= m * n + p. Proof. Z.swap_greater. intros. Z.order_pos. Qed. Theorem Zmult_le_approx n m p : n > 0 -> n > p -> 0 <= m * n + p -> 0 <= m. Proof. Z.swap_greater. intros. apply Z.lt_succ_r. apply Z.mul_pos_cancel_r with n; trivial. Z.nzsimpl. apply Z.le_lt_trans with (m*n+p); trivial. now apply Z.add_lt_mono_l. Qed. coq-8.20.0/theories/_CoqProject000066400000000000000000000000111466560755400163520ustar00rootroot00000000000000-R . Coq coq-8.20.0/theories/btauto/000077500000000000000000000000001466560755400155255ustar00rootroot00000000000000coq-8.20.0/theories/btauto/Algebra.v000066400000000000000000000451051466560755400172560ustar00rootroot00000000000000Require Import Bool PArith DecidableClass Ring Lia. Ltac bool := repeat match goal with | [ H : ?P && ?Q = true |- _ ] => apply andb_true_iff in H; destruct H | |- ?P && ?Q = true => apply <- andb_true_iff; split end. Arguments decide P /H. #[export] Hint Extern 5 => progress bool : core. Ltac define t x H := set (x := t) in *; assert (H : t = x) by reflexivity; clearbody x. Lemma Decidable_sound : forall P (H : Decidable P), decide P = true -> P. Proof. intros P H Hp; apply -> Decidable_spec; assumption. Qed. Lemma Decidable_complete : forall P (H : Decidable P), P -> decide P = true. Proof. intros P H Hp; apply <- Decidable_spec; assumption. Qed. Lemma Decidable_sound_alt : forall P (H : Decidable P), ~ P -> decide P = false. Proof. intros P [wit spec] Hd; destruct wit; simpl; tauto. Qed. Lemma Decidable_complete_alt : forall P (H : Decidable P), decide P = false -> ~ P. Proof. intros P [wit spec] Hd Hc; simpl in *; intuition congruence. Qed. Ltac try_rewrite := repeat match goal with | [ H : ?P |- _ ] => rewrite H end. (* We opacify here decide for proofs, and will make it transparent for reflexive tactics later on. *) Global Opaque decide. Ltac tac_decide := match goal with | [ H : @decide ?P ?D = true |- _ ] => apply (@Decidable_sound P D) in H | [ H : @decide ?P ?D = false |- _ ] => apply (@Decidable_complete_alt P D) in H | [ |- @decide ?P ?D = true ] => apply (@Decidable_complete P D) | [ |- @decide ?P ?D = false ] => apply (@Decidable_sound_alt P D) | [ |- negb ?b = true ] => apply negb_true_iff | [ |- negb ?b = false ] => apply negb_false_iff | [ H : negb ?b = true |- _ ] => apply negb_true_iff in H | [ H : negb ?b = false |- _ ] => apply negb_false_iff in H end. Ltac try_decide := repeat tac_decide. Ltac make_decide P := match goal with | [ |- context [@decide P ?D] ] => let b := fresh "b" in let H := fresh "H" in define (@decide P D) b H; destruct b; try_decide | [ X : context [@decide P ?D] |- _ ] => let b := fresh "b" in let H := fresh "H" in define (@decide P D) b H; destruct b; try_decide end. Ltac case_decide := match goal with | [ |- context [@decide ?P ?D] ] => let b := fresh "b" in let H := fresh "H" in define (@decide P D) b H; destruct b; try_decide | [ X : context [@decide ?P ?D] |- _ ] => let b := fresh "b" in let H := fresh "H" in define (@decide P D) b H; destruct b; try_decide | [ |- context [Pos.compare ?x ?y] ] => destruct (Pos.compare_spec x y); try lia | [ X : context [Pos.compare ?x ?y] |- _ ] => destruct (Pos.compare_spec x y); try lia end. Section Definitions. (** * Global, inductive definitions. *) (** A Horner polynomial is either a constant, or a product P × (i + Q), where i is a variable. *) Inductive poly := | Cst : bool -> poly | Poly : poly -> positive -> poly -> poly. (* TODO: We should use [positive] instead of [nat] to encode variables, for efficiency purpose. *) Inductive null : poly -> Prop := | null_intro : null (Cst false). (** Polynomials satisfy a uniqueness condition whenever they are valid. A polynomial [p] satisfies [valid n p] whenever it is well-formed and each of its variable indices is < [n]. *) Inductive valid : positive -> poly -> Prop := | valid_cst : forall k c, valid k (Cst c) | valid_poly : forall k p i q, Pos.lt i k -> ~ null q -> valid i p -> valid (Pos.succ i) q -> valid k (Poly p i q). (** Linear polynomials are valid polynomials in which every variable appears at most once. *) Inductive linear : positive -> poly -> Prop := | linear_cst : forall k c, linear k (Cst c) | linear_poly : forall k p i q, Pos.lt i k -> ~ null q -> linear i p -> linear i q -> linear k (Poly p i q). End Definitions. Section Computational. Program Instance Decidable_PosEq : forall (p q : positive), Decidable (p = q) := { Decidable_witness := Pos.eqb p q }. Next Obligation. apply Pos.eqb_eq. Qed. Program Instance Decidable_PosLt : forall p q, Decidable (Pos.lt p q) := { Decidable_witness := Pos.ltb p q }. Next Obligation. apply Pos.ltb_lt. Qed. Program Instance Decidable_PosLe : forall p q, Decidable (Pos.le p q) := { Decidable_witness := Pos.leb p q }. Next Obligation. apply Pos.leb_le. Qed. (** * The core reflexive part. *) #[local] Hint Constructors valid : core. Fixpoint beq_poly pl pr := match pl with | Cst cl => match pr with | Cst cr => decide (cl = cr) | Poly _ _ _ => false end | Poly pl il ql => match pr with | Cst _ => false | Poly pr ir qr => decide (il = ir) && beq_poly pl pr && beq_poly ql qr end end. (* We could do that with [decide equality] but dependency in proofs is heavy *) Program Instance Decidable_eq_poly : forall (p q : poly), Decidable (eq p q) := { Decidable_witness := beq_poly p q }. Next Obligation. split. - revert q; induction p; intros [] ?; simpl in *; bool; try_decide; f_equal; first [intuition congruence|auto]. - revert q; induction p; intros [] Heq; simpl in *; bool; try_decide; intuition; try injection Heq; first[congruence|intuition]. Qed. Program Instance Decidable_null : forall p, Decidable (null p) := { Decidable_witness := match p with Cst false => true | _ => false end }. Next Obligation. split. - destruct p as [[]|]; first [discriminate|constructor]. - inversion 1; trivial. Qed. Definition list_nth {A} p (l : list A) def := Pos.peano_rect (fun _ => list A -> A) (fun l => match l with nil => def | cons t l => t end) (fun _ F l => match l with nil => def | cons t l => F l end) p l. Fixpoint eval var (p : poly) := match p with | Cst c => c | Poly p i q => let vi := list_nth i var false in xorb (eval var p) (andb vi (eval var q)) end. Fixpoint valid_dec k p := match p with | Cst c => true | Poly p i q => negb (decide (null q)) && decide (i < k)%positive && valid_dec i p && valid_dec (Pos.succ i) q end. Program Instance Decidable_valid : forall n p, Decidable (valid n p) := { Decidable_witness := valid_dec n p }. Next Obligation. split. - revert n; induction p; unfold valid_dec in *; intuition; bool; try_decide; auto. - intros H; induction H; unfold valid_dec in *; bool; try_decide; auto. Qed. (** Basic algebra *) (* Addition of polynomials *) Fixpoint poly_add pl {struct pl} := match pl with | Cst cl => fix F pr := match pr with | Cst cr => Cst (xorb cl cr) | Poly pr ir qr => Poly (F pr) ir qr end | Poly pl il ql => fix F pr {struct pr} := match pr with | Cst cr => Poly (poly_add pl pr) il ql | Poly pr ir qr => match Pos.compare il ir with | Eq => let qs := poly_add ql qr in (* Ensure validity *) if decide (null qs) then poly_add pl pr else Poly (poly_add pl pr) il qs | Gt => Poly (poly_add pl (Poly pr ir qr)) il ql | Lt => Poly (F pr) ir qr end end end. (* Multiply a polynomial by a constant *) Fixpoint poly_mul_cst v p := match p with | Cst c => Cst (andb c v) | Poly p i q => let r := poly_mul_cst v q in (* Ensure validity *) if decide (null r) then poly_mul_cst v p else Poly (poly_mul_cst v p) i r end. (* Multiply a polynomial by a monomial *) Fixpoint poly_mul_mon k p := match p with | Cst c => if decide (null p) then p else Poly (Cst false) k p | Poly p i q => if decide (i <= k)%positive then Poly (Cst false) k (Poly p i q) else Poly (poly_mul_mon k p) i (poly_mul_mon k q) end. (* Multiplication of polynomials *) Fixpoint poly_mul pl {struct pl} := match pl with | Cst cl => poly_mul_cst cl | Poly pl il ql => fun pr => (* Multiply by a factor *) let qs := poly_mul ql pr in (* Ensure validity *) if decide (null qs) then poly_mul pl pr else poly_add (poly_mul pl pr) (poly_mul_mon il qs) end. (** Quotienting a polynomial by the relation X_i^2 ~ X_i *) (* Remove the multiple occurrences of monomials x_k *) Fixpoint reduce_aux k p := match p with | Cst c => Cst c | Poly p i q => if decide (i = k) then poly_add (reduce_aux k p) (reduce_aux k q) else let qs := reduce_aux i q in (* Ensure validity *) if decide (null qs) then (reduce_aux k p) else Poly (reduce_aux k p) i qs end. (* Rewrite any x_k ^ {n + 1} to x_k *) Fixpoint reduce p := match p with | Cst c => Cst c | Poly p i q => let qs := reduce_aux i q in (* Ensure validity *) if decide (null qs) then reduce p else Poly (reduce p) i qs end. End Computational. Section Validity. (* Decision procedure of validity *) #[local] Hint Constructors valid linear : core. Lemma valid_le_compat : forall k l p, valid k p -> (k <= l)%positive -> valid l p. Proof. intros k l p H Hl; induction H; constructor; eauto. now eapply Pos.lt_le_trans; eassumption. Qed. Lemma linear_le_compat : forall k l p, linear k p -> (k <= l)%positive -> linear l p. Proof. intros k l p H; revert l; induction H; constructor; eauto; lia. Qed. Lemma linear_valid_incl : forall k p, linear k p -> valid k p. Proof. intros k p H; induction H; constructor; auto. eapply valid_le_compat; eauto; lia. Qed. End Validity. Section Evaluation. (* Useful simple properties *) Lemma eval_null_zero : forall p var, null p -> eval var p = false. Proof. intros p var []; reflexivity. Qed. Lemma eval_extensional_eq_compat : forall p var1 var2, (forall x, list_nth x var1 false = list_nth x var2 false) -> eval var1 p = eval var2 p. Proof. intros p var1 var2 H; induction p; simpl; try_rewrite; auto. Qed. Lemma eval_suffix_compat : forall k p var1 var2, (forall i, (i < k)%positive -> list_nth i var1 false = list_nth i var2 false) -> valid k p -> eval var1 p = eval var2 p. Proof. intros k p var1 var2 Hvar Hv; revert var1 var2 Hvar. induction Hv; intros var1 var2 Hvar; simpl; [now auto|]. rewrite Hvar; [|now auto]; erewrite (IHHv1 var1 var2). + erewrite (IHHv2 var1 var2); [ring|]. intros; apply Hvar; lia. + intros; apply Hvar; lia. Qed. End Evaluation. Section Algebra. (* Compatibility with evaluation *) Lemma poly_add_compat : forall pl pr var, eval var (poly_add pl pr) = xorb (eval var pl) (eval var pr). Proof. intros pl; induction pl; intros pr var; simpl. - induction pr; simpl; auto; solve [try_rewrite; ring]. - induction pr; simpl; auto; try solve [try_rewrite; simpl; ring]. destruct (Pos.compare_spec p p0); repeat case_decide; simpl; first [try_rewrite; ring|idtac]. + try_rewrite; ring_simplify; repeat rewrite xorb_assoc. match goal with [ |- context [xorb (andb ?b1 ?b2) (andb ?b1 ?b3)] ] => replace (xorb (andb b1 b2) (andb b1 b3)) with (andb b1 (xorb b2 b3)) by ring end. rewrite <- IHpl2. match goal with [ H : null ?p |- _ ] => rewrite (eval_null_zero _ _ H) end; ring. + simpl; rewrite IHpl1; simpl; ring. Qed. Lemma poly_mul_cst_compat : forall v p var, eval var (poly_mul_cst v p) = andb v (eval var p). Proof. intros v p; induction p; intros var; simpl; [ring|]. case_decide; simpl; try_rewrite; [ring_simplify|ring]. replace (v && list_nth p2 var false && eval var p3) with (list_nth p2 var false && (v && eval var p3)) by ring. rewrite <- IHp2; inversion H; simpl; ring. Qed. Lemma poly_mul_mon_compat : forall i p var, eval var (poly_mul_mon i p) = (list_nth i var false && eval var p). Proof. intros i p var; induction p; simpl; case_decide; simpl; try_rewrite; try ring. inversion H; ring. Qed. Lemma poly_mul_compat : forall pl pr var, eval var (poly_mul pl pr) = andb (eval var pl) (eval var pr). Proof. intros pl; induction pl; intros pr var; simpl. - apply poly_mul_cst_compat. - case_decide; simpl. + rewrite IHpl1; ring_simplify. replace (eval var pr && list_nth p var false && eval var pl2) with (list_nth p var false && (eval var pl2 && eval var pr)) by ring. now rewrite <- IHpl2; inversion H; simpl; ring. + rewrite poly_add_compat, poly_mul_mon_compat, IHpl1, IHpl2; ring. Qed. #[local] Hint Extern 5 => match goal with | [ |- (Pos.max ?x ?y <= ?z)%positive ] => apply Pos.max_case_strong; intros; lia | [ |- (?z <= Pos.max ?x ?y)%positive ] => apply Pos.max_case_strong; intros; lia | [ |- (Pos.max ?x ?y < ?z)%positive ] => apply Pos.max_case_strong; intros; lia | [ |- (?z < Pos.max ?x ?y)%positive ] => apply Pos.max_case_strong; intros; lia | _ => lia end : core. #[local] Hint Resolve Pos.le_max_r Pos.le_max_l : core. #[local] Hint Constructors valid linear : core. (* Compatibility of validity w.r.t algebraic operations *) Lemma poly_add_valid_compat : forall kl kr pl pr, valid kl pl -> valid kr pr -> valid (Pos.max kl kr) (poly_add pl pr). Proof. intros kl kr pl pr Hl Hr; revert kr pr Hr; induction Hl; intros kr pr Hr; simpl. { eapply valid_le_compat; [clear k|apply Pos.le_max_r]. now induction Hr; auto. } { assert (Hle : (Pos.max (Pos.succ i) kr <= Pos.max k kr)%positive) by auto. apply (valid_le_compat (Pos.max (Pos.succ i) kr)); [|assumption]. clear - IHHl1 IHHl2 Hl2 Hr H0; induction Hr. - constructor; auto. now rewrite <- (Pos.max_id i); intuition. - destruct (Pos.compare_spec i i0); subst; try case_decide; repeat (constructor; intuition). + apply (valid_le_compat (Pos.max i0 i0)); [now auto|]; rewrite Pos.max_id; auto. + apply (valid_le_compat (Pos.max i0 i0)); [now auto|]; rewrite Pos.max_id; lia. + apply (valid_le_compat (Pos.max (Pos.succ i0) (Pos.succ i0))); [now auto|]; rewrite Pos.max_id; lia. + apply (valid_le_compat (Pos.max (Pos.succ i) i0)); intuition. + apply (valid_le_compat (Pos.max i (Pos.succ i0))); intuition. } Qed. Lemma poly_mul_cst_valid_compat : forall k v p, valid k p -> valid k (poly_mul_cst v p). Proof. intros k v p H; induction H; simpl; [now auto|]. case_decide; [|now auto]. eapply (valid_le_compat i); [now auto|lia]. Qed. Lemma poly_mul_mon_null_compat : forall i p, null (poly_mul_mon i p) -> null p. Proof. intros i p; induction p; simpl; case_decide; simpl; inversion 1; intuition. Qed. Lemma poly_mul_mon_valid_compat : forall k i p, valid k p -> valid (Pos.max (Pos.succ i) k) (poly_mul_mon i p). Proof. intros k i p H; induction H; simpl poly_mul_mon; case_decide; intuition. + apply (valid_le_compat (Pos.succ i)); auto; constructor; intuition. - match goal with [ H : null ?p |- _ ] => solve[inversion H] end. + apply (valid_le_compat k); auto; constructor; intuition. - assert (X := poly_mul_mon_null_compat); intuition eauto. - enough (Pos.max (Pos.succ i) i0 = i0) as <-; intuition. - enough (Pos.max (Pos.succ i) (Pos.succ i0) = Pos.succ i0) as <-; intuition. Qed. Lemma poly_mul_valid_compat : forall kl kr pl pr, valid kl pl -> valid kr pr -> valid (Pos.max kl kr) (poly_mul pl pr). Proof. intros kl kr pl pr Hl Hr; revert kr pr Hr. induction Hl; intros kr pr Hr; simpl. + apply poly_mul_cst_valid_compat; auto. apply (valid_le_compat kr); now auto. + apply (valid_le_compat (Pos.max (Pos.max i kr) (Pos.max (Pos.succ i) (Pos.max (Pos.succ i) kr)))). - case_decide. { apply (valid_le_compat (Pos.max i kr)); auto. } { apply poly_add_valid_compat; auto. now apply poly_mul_mon_valid_compat; intuition. } - repeat apply Pos.max_case_strong; lia. Qed. (* Compatibility of linearity wrt to linear operations *) Lemma poly_add_linear_compat : forall kl kr pl pr, linear kl pl -> linear kr pr -> linear (Pos.max kl kr) (poly_add pl pr). Proof. intros kl kr pl pr Hl; revert kr pr; induction Hl; intros kr pr Hr; simpl. + apply (linear_le_compat kr); [|apply Pos.max_case_strong; lia]. now induction Hr; constructor; auto. + apply (linear_le_compat (Pos.max kr (Pos.succ i))); [|now auto]. induction Hr; simpl. - constructor; auto. replace i with (Pos.max i i) by (apply Pos.max_id); intuition. - destruct (Pos.compare_spec i i0); subst; try case_decide; repeat (constructor; intuition). { apply (linear_le_compat (Pos.max i0 i0)); [now auto|]; rewrite Pos.max_id; auto. } { apply (linear_le_compat (Pos.max i0 i0)); [now auto|]; rewrite Pos.max_id; auto. } { apply (linear_le_compat (Pos.max i0 i0)); [now auto|]; rewrite Pos.max_id; auto. } { apply (linear_le_compat (Pos.max i0 (Pos.succ i))); intuition. } { apply (linear_le_compat (Pos.max i (Pos.succ i0))); intuition. } Qed. End Algebra. Section Reduce. (* A stronger version of the next lemma *) Lemma reduce_aux_eval_compat : forall k p var, valid (Pos.succ k) p -> (list_nth k var false && eval var (reduce_aux k p) = list_nth k var false && eval var p). Proof. intros k p var; revert k; induction p; intros k Hv; simpl; auto. inversion Hv; case_decide; subst. + rewrite poly_add_compat; ring_simplify. specialize (IHp1 k); specialize (IHp2 k). destruct (list_nth k var false); ring_simplify; [|now auto]. rewrite <- (andb_true_l (eval var p1)), <- (andb_true_l (eval var p3)). rewrite <- IHp2; auto; rewrite <- IHp1; [ring|]. apply (valid_le_compat k); [now auto|lia]. + remember (list_nth k var false) as b; destruct b; ring_simplify; [|now auto]. case_decide; simpl. - rewrite <- (IHp2 p2); [inversion H|now auto]; simpl. replace (eval var p1) with (list_nth k var false && eval var p1) by (rewrite <- Heqb; ring); rewrite <- (IHp1 k). { rewrite <- Heqb; ring. } { apply (valid_le_compat p2); [auto|lia]. } - rewrite (IHp2 p2); [|now auto]. replace (eval var p1) with (list_nth k var false && eval var p1) by (rewrite <- Heqb; ring). rewrite <- (IHp1 k); [rewrite <- Heqb; ring|]. apply (valid_le_compat p2); [auto|lia]. Qed. (* Reduction preserves evaluation by boolean assignations *) Lemma reduce_eval_compat : forall k p var, valid k p -> eval var (reduce p) = eval var p. Proof. intros k p var H; induction H; simpl; auto. case_decide; try_rewrite; simpl. + rewrite <- reduce_aux_eval_compat; auto; inversion H3; simpl; ring. + repeat rewrite reduce_aux_eval_compat; try_rewrite; now auto. Qed. Lemma reduce_aux_le_compat : forall k l p, valid k p -> (k <= l)%positive -> reduce_aux l p = reduce_aux k p. Proof. intros k l p; revert k l; induction p; intros k l H Hle; simpl; auto. inversion H; subst; repeat case_decide; subst; try lia. + apply IHp1; [|now auto]; eapply valid_le_compat; [eauto|lia]. + f_equal; apply IHp1; auto. now eapply valid_le_compat; [eauto|lia]. Qed. (* Reduce projects valid polynomials into linear ones *) Lemma linear_reduce_aux : forall i p, valid (Pos.succ i) p -> linear i (reduce_aux i p). Proof. intros i p; revert i; induction p; intros i Hp; simpl. + constructor. + inversion Hp; subst; case_decide; subst. - rewrite <- (Pos.max_id i) at 1; apply poly_add_linear_compat. { apply IHp1; eapply valid_le_compat; [eassumption|lia]. } { intuition. } - case_decide. { apply IHp1; eapply valid_le_compat; [eauto|lia]. } { constructor; try lia; auto. erewrite (reduce_aux_le_compat p2); [|assumption|lia]. apply IHp1; eapply valid_le_compat; [eauto|]; lia. } Qed. Lemma linear_reduce : forall k p, valid k p -> linear k (reduce p). Proof. intros k p H; induction H; simpl. + now constructor. + case_decide. - eapply linear_le_compat; [eauto|lia]. - constructor; auto. apply linear_reduce_aux; auto. Qed. End Reduce. coq-8.20.0/theories/btauto/Btauto.v000066400000000000000000000001341466560755400171500ustar00rootroot00000000000000Require Import Algebra Reflect. Declare ML Module "btauto_plugin:coq-core.plugins.btauto". coq-8.20.0/theories/btauto/Reflect.v000066400000000000000000000330621466560755400173040ustar00rootroot00000000000000Require Import Bool DecidableClass Algebra Ring PArith Lia. Section Bool. (* Boolean formulas and their evaluations *) Inductive formula := | formula_var : positive -> formula | formula_btm : formula | formula_top : formula | formula_cnj : formula -> formula -> formula | formula_dsj : formula -> formula -> formula | formula_neg : formula -> formula | formula_xor : formula -> formula -> formula | formula_ifb : formula -> formula -> formula -> formula. Fixpoint formula_eval var f := match f with | formula_var x => list_nth x var false | formula_btm => false | formula_top => true | formula_cnj fl fr => (formula_eval var fl) && (formula_eval var fr) | formula_dsj fl fr => (formula_eval var fl) || (formula_eval var fr) | formula_neg f => negb (formula_eval var f) | formula_xor fl fr => xorb (formula_eval var fl) (formula_eval var fr) | formula_ifb fc fl fr => if formula_eval var fc then formula_eval var fl else formula_eval var fr end. End Bool. (* Translation of formulas into polynomials *) Section Translation. (* This is straightforward. *) Fixpoint poly_of_formula f := match f with | formula_var x => Poly (Cst false) x (Cst true) | formula_btm => Cst false | formula_top => Cst true | formula_cnj fl fr => let pl := poly_of_formula fl in let pr := poly_of_formula fr in poly_mul pl pr | formula_dsj fl fr => let pl := poly_of_formula fl in let pr := poly_of_formula fr in poly_add (poly_add pl pr) (poly_mul pl pr) | formula_neg f => poly_add (Cst true) (poly_of_formula f) | formula_xor fl fr => poly_add (poly_of_formula fl) (poly_of_formula fr) | formula_ifb fc fl fr => let pc := poly_of_formula fc in let pl := poly_of_formula fl in let pr := poly_of_formula fr in poly_add pr (poly_add (poly_mul pc pl) (poly_mul pc pr)) end. Opaque poly_add. (* Compatibility of translation wrt evaluation *) Lemma poly_of_formula_eval_compat : forall var f, eval var (poly_of_formula f) = formula_eval var f. Proof. intros var f; induction f; simpl poly_of_formula; simpl formula_eval; auto. - now simpl; match goal with [ |- ?t = ?u ] => destruct u; reflexivity end. - rewrite poly_mul_compat, IHf1, IHf2; ring. - repeat rewrite poly_add_compat. rewrite poly_mul_compat; try_rewrite. now match goal with [ |- ?t = ?x || ?y ] => destruct x; destruct y; reflexivity end. - rewrite poly_add_compat; try_rewrite. now match goal with [ |- ?t = negb ?x ] => destruct x; reflexivity end. - rewrite poly_add_compat; congruence. - rewrite ?poly_add_compat, ?poly_mul_compat; try_rewrite. match goal with [ |- ?t = if ?b1 then ?b2 else ?b3 ] => destruct b1; destruct b2; destruct b3; reflexivity end. Qed. #[local] Hint Extern 5 => change 0 with (min 0 0) : core. Local Hint Resolve poly_add_valid_compat poly_mul_valid_compat : core. Local Hint Constructors valid : core. #[local] Hint Extern 5 => lia : core. (* Compatibility with validity *) Lemma poly_of_formula_valid_compat : forall f, exists n, valid n (poly_of_formula f). Proof. intros f; induction f; simpl. + exists (Pos.succ p); constructor; intuition; inversion H. + exists 1%positive; auto. + exists 1%positive; auto. + destruct IHf1 as [n1 Hn1]; destruct IHf2 as [n2 Hn2]; exists (Pos.max n1 n2); auto. + destruct IHf1 as [n1 Hn1]; destruct IHf2 as [n2 Hn2]; exists (Pos.max (Pos.max n1 n2) (Pos.max n1 n2)); auto. + destruct IHf as [n Hn]; exists (Pos.max 1 n); auto. + destruct IHf1 as [n1 Hn1]; destruct IHf2 as [n2 Hn2]; exists (Pos.max n1 n2); auto. + destruct IHf1 as [n1 Hn1]; destruct IHf2 as [n2 Hn2]; destruct IHf3 as [n3 Hn3]; eexists; eauto. Qed. (* The soundness lemma ; alas not complete! *) Lemma poly_of_formula_sound : forall fl fr var, poly_of_formula fl = poly_of_formula fr -> formula_eval var fl = formula_eval var fr. Proof. intros fl fr var Heq. repeat rewrite <- poly_of_formula_eval_compat. rewrite Heq; reflexivity. Qed. End Translation. Section Completeness. (* Lemma reduce_poly_of_formula_simpl : forall fl fr var, simpl_eval (var_of_list var) (reduce (poly_of_formula fl)) = simpl_eval (var_of_list var) (reduce (poly_of_formula fr)) -> formula_eval var fl = formula_eval var fr. Proof. intros fl fr var Hrw. do 2 rewrite <- poly_of_formula_eval_compat. destruct (poly_of_formula_valid_compat fl) as [nl Hl]. destruct (poly_of_formula_valid_compat fr) as [nr Hr]. rewrite <- (reduce_eval_compat nl (poly_of_formula fl)); [|assumption]. rewrite <- (reduce_eval_compat nr (poly_of_formula fr)); [|assumption]. do 2 rewrite <- eval_simpl_eval_compat; assumption. Qed. *) (* Soundness of the method ; immediate *) Lemma reduce_poly_of_formula_sound : forall fl fr var, reduce (poly_of_formula fl) = reduce (poly_of_formula fr) -> formula_eval var fl = formula_eval var fr. Proof. intros fl fr var Heq. repeat rewrite <- poly_of_formula_eval_compat. destruct (poly_of_formula_valid_compat fl) as [nl Hl]. destruct (poly_of_formula_valid_compat fr) as [nr Hr]. rewrite <- (reduce_eval_compat nl (poly_of_formula fl)); auto. rewrite <- (reduce_eval_compat nr (poly_of_formula fr)); auto. rewrite Heq; reflexivity. Qed. Definition make_last {A} n (x def : A) := Pos.peano_rect (fun _ => list A) (cons x nil) (fun _ F => cons def F) n. (* Replace the nth element of a list *) Fixpoint list_replace l n b := match l with | nil => make_last n b false | cons a l => Pos.peano_rect _ (cons b l) (fun n _ => cons a (list_replace l n b)) n end. (** Extract a non-null witness from a polynomial *) Existing Instance Decidable_null. Fixpoint boolean_witness p := match p with | Cst c => nil | Poly p i q => if decide (null p) then let var := boolean_witness q in list_replace var i true else let var := boolean_witness p in list_replace var i false end. Lemma list_nth_base : forall A (def : A) l, list_nth 1 l def = match l with nil => def | cons x _ => x end. Proof. intros A def l; unfold list_nth. rewrite Pos.peano_rect_base; reflexivity. Qed. Lemma list_nth_succ : forall A n (def : A) l, list_nth (Pos.succ n) l def = match l with nil => def | cons _ l => list_nth n l def end. Proof. intros A def l; unfold list_nth. rewrite Pos.peano_rect_succ; reflexivity. Qed. Lemma list_nth_nil : forall A n (def : A), list_nth n nil def = def. Proof. intros A n def; induction n using Pos.peano_rect. + rewrite list_nth_base; reflexivity. + rewrite list_nth_succ; reflexivity. Qed. Lemma make_last_nth_1 : forall A n i x def, i <> n -> list_nth i (@make_last A n x def) def = def. Proof. intros A n; induction n using Pos.peano_rect; intros i x def Hd; unfold make_last; simpl. + induction i using Pos.peano_case; [elim Hd; reflexivity|]. rewrite list_nth_succ, list_nth_nil; reflexivity. + unfold make_last; rewrite Pos.peano_rect_succ; fold (make_last n x def). induction i using Pos.peano_case. - rewrite list_nth_base; reflexivity. - rewrite list_nth_succ; apply IHn; lia. Qed. Lemma make_last_nth_2 : forall A n x def, list_nth n (@make_last A n x def) def = x. Proof. intros A n; induction n using Pos.peano_rect; intros x def; simpl. + reflexivity. + unfold make_last; rewrite Pos.peano_rect_succ; fold (make_last n x def). rewrite list_nth_succ; auto. Qed. Lemma list_replace_nth_1 : forall var i j x, i <> j -> list_nth i (list_replace var j x) false = list_nth i var false. Proof. intros var; induction var; intros i j x Hd; simpl. + rewrite make_last_nth_1, list_nth_nil; auto. + induction j using Pos.peano_rect. - rewrite Pos.peano_rect_base. induction i using Pos.peano_rect; [now elim Hd; auto|]. rewrite 2list_nth_succ; reflexivity. - rewrite Pos.peano_rect_succ. induction i using Pos.peano_rect. { rewrite 2list_nth_base; reflexivity. } { rewrite 2list_nth_succ; apply IHvar; lia. } Qed. Lemma list_replace_nth_2 : forall var i x, list_nth i (list_replace var i x) false = x. Proof. intros var; induction var; intros i x; simpl. + now apply make_last_nth_2. + induction i using Pos.peano_rect. - rewrite Pos.peano_rect_base, list_nth_base; reflexivity. - rewrite Pos.peano_rect_succ, list_nth_succ; auto. Qed. (* The witness is correct only if the polynomial is linear *) Lemma boolean_witness_nonzero : forall k p, linear k p -> ~ null p -> eval (boolean_witness p) p = true. Proof. intros k p Hl Hp; induction Hl; simpl. - destruct c; [reflexivity|elim Hp; now constructor]. - case_decide. + rewrite eval_null_zero; [|assumption]; rewrite list_replace_nth_2; simpl. erewrite eval_suffix_compat; [now eauto| |now apply linear_valid_incl; eauto]. now intros j Hd; apply list_replace_nth_1; lia. + rewrite list_replace_nth_2, xorb_false_r. erewrite eval_suffix_compat; [now eauto| |now apply linear_valid_incl; eauto]. now intros j Hd; apply list_replace_nth_1; lia. Qed. (* This should be better when using the [vm_compute] tactic instead of plain reflexivity. *) Lemma reduce_poly_of_formula_sound_alt : forall var fl fr, reduce (poly_add (poly_of_formula fl) (poly_of_formula fr)) = Cst false -> formula_eval var fl = formula_eval var fr. Proof. intros var fl fr Heq. repeat rewrite <- poly_of_formula_eval_compat. destruct (poly_of_formula_valid_compat fl) as [nl Hl]. destruct (poly_of_formula_valid_compat fr) as [nr Hr]. rewrite <- (reduce_eval_compat nl (poly_of_formula fl)); auto. rewrite <- (reduce_eval_compat nr (poly_of_formula fr)); auto. rewrite <- xorb_false_l; change false with (eval var (Cst false)). rewrite <- poly_add_compat, <- Heq. repeat rewrite poly_add_compat. rewrite (reduce_eval_compat nl); [|assumption]. rewrite (reduce_eval_compat (Pos.max nl nr)); [|apply poly_add_valid_compat; assumption]. rewrite (reduce_eval_compat nr); [|assumption]. rewrite poly_add_compat; ring. Qed. (* The completeness lemma *) (* Lemma reduce_poly_of_formula_complete : forall fl fr, reduce (poly_of_formula fl) <> reduce (poly_of_formula fr) -> {var | formula_eval var fl <> formula_eval var fr}. Proof. intros fl fr H. pose (p := poly_add (reduce (poly_of_formula fl)) (poly_opp (reduce (poly_of_formula fr)))). pose (var := boolean_witness p). exists var. intros Hc; apply (f_equal Z_of_bool) in Hc. assert (Hfl : linear 0 (reduce (poly_of_formula fl))). now destruct (poly_of_formula_valid_compat fl) as [n Hn]; apply (linear_le_compat n); [|now auto]; apply linear_reduce; auto. assert (Hfr : linear 0 (reduce (poly_of_formula fr))). now destruct (poly_of_formula_valid_compat fr) as [n Hn]; apply (linear_le_compat n); [|now auto]; apply linear_reduce; auto. repeat rewrite <- poly_of_formula_eval_compat in Hc. define (decide (null p)) b Hb; destruct b; tac_decide. now elim H; apply (null_sub_implies_eq 0 0); fold p; auto; apply linear_valid_incl; auto. elim (boolean_witness_nonzero 0 p); auto. unfold p; rewrite <- (min_id 0); apply poly_add_linear_compat; try apply poly_opp_linear_compat; now auto. unfold p at 2; rewrite poly_add_compat, poly_opp_compat. destruct (poly_of_formula_valid_compat fl) as [nl Hnl]. destruct (poly_of_formula_valid_compat fr) as [nr Hnr]. repeat erewrite reduce_eval_compat; eauto. fold var; rewrite Hc; ring. Defined. *) End Completeness. (* Reification tactics *) (* For reflexivity purposes, that would better be transparent *) Global Transparent decide poly_add. (* Ltac append_var x l k := match l with | nil => constr: (k, cons x l) | cons x _ => constr: (k, l) | cons ?y ?l => let ans := append_var x l (S k) in match ans with (?k, ?l) => constr: (k, cons y l) end end. Ltac build_formula t l := match t with | true => constr: (formula_top, l) | false => constr: (formula_btm, l) | ?fl && ?fr => match build_formula fl l with (?tl, ?l) => match build_formula fr l with (?tr, ?l) => constr: (formula_cnj tl tr, l) end end | ?fl || ?fr => match build_formula fl l with (?tl, ?l) => match build_formula fr l with (?tr, ?l) => constr: (formula_dsj tl tr, l) end end | negb ?f => match build_formula f l with (?t, ?l) => constr: (formula_neg t, l) end | _ => let ans := append_var t l 0 in match ans with (?k, ?l) => constr: (formula_var k, l) end end. (* Extract a counterexample from a polynomial and display it *) Ltac counterexample p l := let var := constr: (boolean_witness p) in let var := eval vm_compute in var in let rec print l vl := match l with | nil => idtac | cons ?x ?l => match vl with | nil => idtac x ":=" "false"; print l (@nil bool) | cons ?v ?vl => idtac x ":=" v; print l vl end end in idtac "Counter-example:"; print l var. Ltac btauto_reify := lazymatch goal with | [ |- @eq bool ?t ?u ] => lazymatch build_formula t (@nil bool) with | (?fl, ?l) => lazymatch build_formula u l with | (?fr, ?l) => change (formula_eval l fl = formula_eval l fr) end end | _ => fail "Cannot recognize a boolean equality" end. (* The long-awaited tactic *) Ltac btauto := lazymatch goal with | [ |- @eq bool ?t ?u ] => lazymatch build_formula t (@nil bool) with | (?fl, ?l) => lazymatch build_formula u l with | (?fr, ?l) => change (formula_eval l fl = formula_eval l fr); apply reduce_poly_of_formula_sound_alt; vm_compute; (reflexivity || fail "Not a tautology") end end | _ => fail "Cannot recognize a boolean equality" end. *) Register formula_var as plugins.btauto.f_var. Register formula_btm as plugins.btauto.f_btm. Register formula_top as plugins.btauto.f_top. Register formula_cnj as plugins.btauto.f_cnj. Register formula_dsj as plugins.btauto.f_dsj. Register formula_neg as plugins.btauto.f_neg. Register formula_xor as plugins.btauto.f_xor. Register formula_ifb as plugins.btauto.f_ifb. Register formula_eval as plugins.btauto.eval. Register boolean_witness as plugins.btauto.witness. Register reduce_poly_of_formula_sound_alt as plugins.btauto.soundness. coq-8.20.0/theories/derive/000077500000000000000000000000001466560755400155055ustar00rootroot00000000000000coq-8.20.0/theories/derive/Derive.v000066400000000000000000000000731466560755400171120ustar00rootroot00000000000000Declare ML Module "derive_plugin:coq-core.plugins.derive". coq-8.20.0/theories/dune.disabled000066400000000000000000000013041466560755400166510ustar00rootroot00000000000000; For now we use coq_dune to generate the rules here (coq.theory (name Coq) (package coq-stdlib) (synopsis "Coq's Standard Library") ; Uncomment this to have dune compile native files in release mode ; (mode native) (boot) (plugins coq-core.plugins.ltac coq-core.plugins.tauto coq-core.plugins.cc coq-core.plugins.firstorder coq-core.plugins.number_string_notation coq-core.plugins.btauto coq-core.plugins.rtauto coq-core.plugins.ring coq-core.plugins.nsatz coq-core.plugins.zify coq-core.plugins.micromega coq-core.plugins.funind coq-core.plugins.ssreflect coq-core.plugins.derive)) (include_subdirs qualified) (documentation (package coq-stdlib)) coq-8.20.0/theories/extraction/000077500000000000000000000000001466560755400164075ustar00rootroot00000000000000coq-8.20.0/theories/extraction/ExtrHaskellBasic.v000066400000000000000000000014071466560755400217700ustar00rootroot00000000000000(** Extraction to Haskell : use of basic Haskell types *) Require Coq.extraction.Extraction. Extract Inductive bool => "Prelude.Bool" [ "Prelude.True" "Prelude.False" ]. Extract Inductive option => "Prelude.Maybe" [ "Prelude.Just" "Prelude.Nothing" ]. Extract Inductive unit => "()" [ "()" ]. Extract Inductive list => "([])" [ "([])" "(:)" ]. Extract Inductive prod => "(,)" [ "(,)" ]. Extract Inductive sumbool => "Prelude.Bool" [ "Prelude.True" "Prelude.False" ]. Extract Inductive sumor => "Prelude.Maybe" [ "Prelude.Just" "Prelude.Nothing" ]. Extract Inductive sum => "Prelude.Either" [ "Prelude.Left" "Prelude.Right" ]. Extract Inlined Constant andb => "(Prelude.&&)". Extract Inlined Constant orb => "(Prelude.||)". Extract Inlined Constant negb => "Prelude.not". coq-8.20.0/theories/extraction/ExtrHaskellNatInt.v000066400000000000000000000007071466560755400221460ustar00rootroot00000000000000(** Extraction of [nat] into Haskell's [Int] *) Require Coq.extraction.Extraction. Require Import Arith. Require Import ExtrHaskellNatNum. (** * Disclaimer: trying to obtain efficient certified programs * by extracting [nat] into [Int] is definitively *not* a good idea. * See comments in [ExtrOcamlNatInt.v]. *) Extract Inductive nat => "Prelude.Int" [ "0" "Prelude.succ" ] "(\fO fS n -> if n Prelude.== 0 then fO () else fS (n Prelude.- 1))". coq-8.20.0/theories/extraction/ExtrHaskellNatInteger.v000066400000000000000000000007161466560755400230110ustar00rootroot00000000000000(** Extraction of [nat] into Haskell's [Integer] *) Require Coq.extraction.Extraction. Require Import Arith. Require Import ExtrHaskellNatNum. (** * Disclaimer: trying to obtain efficient certified programs * by extracting [nat] into [Integer] isn't necessarily a good idea. * See comments in [ExtrOcamlNatInt.v]. *) Extract Inductive nat => "Prelude.Integer" [ "0" "Prelude.succ" ] "(\fO fS n -> if n Prelude.== 0 then fO () else fS (n Prelude.- 1))". coq-8.20.0/theories/extraction/ExtrHaskellNatNum.v000066400000000000000000000034531466560755400221540ustar00rootroot00000000000000(** * Efficient (but uncertified) extraction of usual [nat] functions * into equivalent versions in Haskell's Prelude that are defined * for any [Num] typeclass instances. Useful in combination with * [Extract Inductive nat] that maps [nat] onto a Haskell type that * implements [Num]. *) Require Coq.extraction.Extraction. Require Import Arith. Require Import EqNat. Extract Inlined Constant Nat.add => "(Prelude.+)". Extract Inlined Constant Nat.mul => "(Prelude.*)". Extract Inlined Constant Nat.max => "Prelude.max". Extract Inlined Constant Nat.min => "Prelude.min". Extract Inlined Constant Init.Nat.add => "(Prelude.+)". Extract Inlined Constant Init.Nat.mul => "(Prelude.*)". Extract Inlined Constant Init.Nat.max => "Prelude.max". Extract Inlined Constant Init.Nat.min => "Prelude.min". Extract Inlined Constant Compare_dec.lt_dec => "(Prelude.<)". Extract Inlined Constant Compare_dec.leb => "(Prelude.<=)". Extract Inlined Constant Compare_dec.le_lt_dec => "(Prelude.<=)". Extract Inlined Constant Nat.eqb => "(Prelude.==)". Extract Inlined Constant EqNat.eq_nat_decide => "(Prelude.==)". Extract Inlined Constant Peano_dec.eq_nat_dec => "(Prelude.==)". Extract Constant Nat.pred => "(\n -> Prelude.max 0 (Prelude.pred n))". Extract Constant Nat.sub => "(\n m -> Prelude.max 0 (n Prelude.- m))". Extract Constant Init.Nat.pred => "(\n -> Prelude.max 0 (Prelude.pred n))". Extract Constant Init.Nat.sub => "(\n m -> Prelude.max 0 (n Prelude.- m))". Extract Constant Nat.div => "(\n m -> if m Prelude.== 0 then 0 else Prelude.div n m)". Extract Constant Nat.modulo => "(\n m -> if m Prelude.== 0 then n else Prelude.mod n m)". Extract Constant Init.Nat.div => "(\n m -> if m Prelude.== 0 then 0 else Prelude.div n m)". Extract Constant Init.Nat.modulo => "(\n m -> if m Prelude.== 0 then n else Prelude.mod n m)". coq-8.20.0/theories/extraction/ExtrHaskellString.v000066400000000000000000000114411466560755400222140ustar00rootroot00000000000000(** * Special handling of ascii and strings for extraction to Haskell. *) Require Coq.extraction.Extraction. Require Import Ascii. Require Import String. Require Import Coq.Strings.Byte. Require Export ExtrHaskellBasic. (** * At the moment, Coq's extraction has no way to add extra import * statements to the extracted Haskell code. You will have to * manually add: * * import qualified Data.Bits * import qualified Data.Char *) Extract Inductive ascii => "Prelude.Char" [ "(\b0 b1 b2 b3 b4 b5 b6 b7 -> Data.Char.chr ( (if b0 then Data.Bits.shiftL 1 0 else 0) Prelude.+ (if b1 then Data.Bits.shiftL 1 1 else 0) Prelude.+ (if b2 then Data.Bits.shiftL 1 2 else 0) Prelude.+ (if b3 then Data.Bits.shiftL 1 3 else 0) Prelude.+ (if b4 then Data.Bits.shiftL 1 4 else 0) Prelude.+ (if b5 then Data.Bits.shiftL 1 5 else 0) Prelude.+ (if b6 then Data.Bits.shiftL 1 6 else 0) Prelude.+ (if b7 then Data.Bits.shiftL 1 7 else 0)))" ] "(\f a -> f (Data.Bits.testBit (Data.Char.ord a) 0) (Data.Bits.testBit (Data.Char.ord a) 1) (Data.Bits.testBit (Data.Char.ord a) 2) (Data.Bits.testBit (Data.Char.ord a) 3) (Data.Bits.testBit (Data.Char.ord a) 4) (Data.Bits.testBit (Data.Char.ord a) 5) (Data.Bits.testBit (Data.Char.ord a) 6) (Data.Bits.testBit (Data.Char.ord a) 7))". Extract Inlined Constant Ascii.ascii_dec => "((Prelude.==) :: Prelude.Char -> Prelude.Char -> Prelude.Bool)". Extract Inlined Constant Ascii.eqb => "((Prelude.==) :: Prelude.Char -> Prelude.Char -> Prelude.Bool)". Extract Inductive string => "Prelude.String" [ "([])" "(:)" ]. Extract Inlined Constant String.string_dec => "((Prelude.==) :: Prelude.String -> Prelude.String -> Prelude.Bool)". Extract Inlined Constant String.eqb => "((Prelude.==) :: Prelude.String -> Prelude.String -> Prelude.Bool)". (* python -c 'print(" ".join(r""" "%s" """.strip() % (r"'"'\''"'" if chr(i) == "'"'"'" else repr(""" "" """.strip()) if chr(i) == """ " """.strip() else repr(chr(i))) for i in range(256)))' # " to satisfy Coq's comment parser *) Extract Inductive byte => "Prelude.Char" ["'\x00'" "'\x01'" "'\x02'" "'\x03'" "'\x04'" "'\x05'" "'\x06'" "'\x07'" "'\x08'" "'\t'" "'\n'" "'\x0b'" "'\x0c'" "'\r'" "'\x0e'" "'\x0f'" "'\x10'" "'\x11'" "'\x12'" "'\x13'" "'\x14'" "'\x15'" "'\x16'" "'\x17'" "'\x18'" "'\x19'" "'\x1a'" "'\x1b'" "'\x1c'" "'\x1d'" "'\x1e'" "'\x1f'" "' '" "'!'" "'""'" "'#'" "'$'" "'%'" "'&'" "'\''" "'('" "')'" "'*'" "'+'" "','" "'-'" "'.'" "'/'" "'0'" "'1'" "'2'" "'3'" "'4'" "'5'" "'6'" "'7'" "'8'" "'9'" "':'" "';'" "'<'" "'='" "'>'" "'?'" "'@'" "'A'" "'B'" "'C'" "'D'" "'E'" "'F'" "'G'" "'H'" "'I'" "'J'" "'K'" "'L'" "'M'" "'N'" "'O'" "'P'" "'Q'" "'R'" "'S'" "'T'" "'U'" "'V'" "'W'" "'X'" "'Y'" "'Z'" "'['" "'\\'" "']'" "'^'" "'_'" "'`'" "'a'" "'b'" "'c'" "'d'" "'e'" "'f'" "'g'" "'h'" "'i'" "'j'" "'k'" "'l'" "'m'" "'n'" "'o'" "'p'" "'q'" "'r'" "'s'" "'t'" "'u'" "'v'" "'w'" "'x'" "'y'" "'z'" "'{'" "'|'" "'}'" "'~'" "'\x7f'" "'\x80'" "'\x81'" "'\x82'" "'\x83'" "'\x84'" "'\x85'" "'\x86'" "'\x87'" "'\x88'" "'\x89'" "'\x8a'" "'\x8b'" "'\x8c'" "'\x8d'" "'\x8e'" "'\x8f'" "'\x90'" "'\x91'" "'\x92'" "'\x93'" "'\x94'" "'\x95'" "'\x96'" "'\x97'" "'\x98'" "'\x99'" "'\x9a'" "'\x9b'" "'\x9c'" "'\x9d'" "'\x9e'" "'\x9f'" "'\xa0'" "'\xa1'" "'\xa2'" "'\xa3'" "'\xa4'" "'\xa5'" "'\xa6'" "'\xa7'" "'\xa8'" "'\xa9'" "'\xaa'" "'\xab'" "'\xac'" "'\xad'" "'\xae'" "'\xaf'" "'\xb0'" "'\xb1'" "'\xb2'" "'\xb3'" "'\xb4'" "'\xb5'" "'\xb6'" "'\xb7'" "'\xb8'" "'\xb9'" "'\xba'" "'\xbb'" "'\xbc'" "'\xbd'" "'\xbe'" "'\xbf'" "'\xc0'" "'\xc1'" "'\xc2'" "'\xc3'" "'\xc4'" "'\xc5'" "'\xc6'" "'\xc7'" "'\xc8'" "'\xc9'" "'\xca'" "'\xcb'" "'\xcc'" "'\xcd'" "'\xce'" "'\xcf'" "'\xd0'" "'\xd1'" "'\xd2'" "'\xd3'" "'\xd4'" "'\xd5'" "'\xd6'" "'\xd7'" "'\xd8'" "'\xd9'" "'\xda'" "'\xdb'" "'\xdc'" "'\xdd'" "'\xde'" "'\xdf'" "'\xe0'" "'\xe1'" "'\xe2'" "'\xe3'" "'\xe4'" "'\xe5'" "'\xe6'" "'\xe7'" "'\xe8'" "'\xe9'" "'\xea'" "'\xeb'" "'\xec'" "'\xed'" "'\xee'" "'\xef'" "'\xf0'" "'\xf1'" "'\xf2'" "'\xf3'" "'\xf4'" "'\xf5'" "'\xf6'" "'\xf7'" "'\xf8'" "'\xf9'" "'\xfa'" "'\xfb'" "'\xfc'" "'\xfd'" "'\xfe'" "'\xff'"]. Extract Inlined Constant Byte.eqb => "((Prelude.==) :: Prelude.Char -> Prelude.Char -> Prelude.Bool)". Extract Inlined Constant Byte.byte_eq_dec => "((Prelude.==) :: Prelude.Char -> Prelude.Char -> Prelude.Bool)". Extract Inlined Constant Ascii.ascii_of_byte => "(\x -> x)". Extract Inlined Constant Ascii.byte_of_ascii => "(\x -> x)". (* Require Import ExtrHaskellBasic. Definition test := "ceci est un test"%string. Definition test2 := List.map (option_map Byte.to_nat) (List.map Byte.of_nat (List.seq 0 256)). Definition test3 := List.map ascii_of_nat (List.seq 0 256). Extraction Language Haskell. Recursive Extraction test Ascii.zero Ascii.one test2 test3 byte_rect. *) coq-8.20.0/theories/extraction/ExtrHaskellZInt.v000066400000000000000000000015131466560755400216310ustar00rootroot00000000000000(** Extraction of [Z] into Haskell's [Int] *) Require Coq.extraction.Extraction. Require Import ZArith. Require Import ExtrHaskellZNum. (** * Disclaimer: trying to obtain efficient certified programs * by extracting [Z] into [Int] is definitively *not* a good idea. * See comments in [ExtrOcamlNatInt.v]. *) Extract Inductive positive => "Prelude.Int" [ "(\x -> 2 Prelude.* x Prelude.+ 1)" "(\x -> 2 Prelude.* x)" "1" ] "(\fI fO fH n -> if n Prelude.== 1 then fH () else if Prelude.odd n then fI (n `Prelude.div` 2) else fO (n `Prelude.div` 2))". Extract Inductive Z => "Prelude.Int" [ "0" "(\x -> x)" "Prelude.negate" ] "(\fO fP fN n -> if n Prelude.== 0 then fO () else if n Prelude.> 0 then fP n else fN (Prelude.negate n))". coq-8.20.0/theories/extraction/ExtrHaskellZInteger.v000066400000000000000000000015251466560755400224770ustar00rootroot00000000000000(** Extraction of [Z] into Haskell's [Integer] *) Require Coq.extraction.Extraction. Require Import ZArith. Require Import ExtrHaskellZNum. (** Disclaimer: trying to obtain efficient certified programs by extracting [Z] into [Integer] isn't necessarily a good idea. See comments in [ExtrOcamlNatInt.v]. *) Extract Inductive positive => "Prelude.Integer" [ "(\x -> 2 Prelude.* x Prelude.+ 1)" "(\x -> 2 Prelude.* x)" "1" ] "(\fI fO fH n -> if n Prelude.== 1 then fH () else if Prelude.odd n then fI (n `Prelude.div` 2) else fO (n `Prelude.div` 2))". Extract Inductive Z => "Prelude.Integer" [ "0" "(\x -> x)" "Prelude.negate" ] "(\fO fP fN n -> if n Prelude.== 0 then fO () else if n Prelude.> 0 then fP n else fN (Prelude.negate n))". coq-8.20.0/theories/extraction/ExtrHaskellZNum.v000066400000000000000000000016071466560755400216420ustar00rootroot00000000000000(** * Efficient (but uncertified) extraction of usual [Z] functions * into equivalent versions in Haskell's Prelude that are defined * for any [Num] typeclass instances. Useful in combination with * [Extract Inductive Z] that maps [Z] onto a Haskell type that * implements [Num]. *) Require Coq.extraction.Extraction. Require Import ZArith. Require Import EqNat. Extract Inlined Constant Z.add => "(Prelude.+)". Extract Inlined Constant Z.sub => "(Prelude.-)". Extract Inlined Constant Z.mul => "(Prelude.*)". Extract Inlined Constant Z.max => "Prelude.max". Extract Inlined Constant Z.min => "Prelude.min". Extract Inlined Constant Z_ge_lt_dec => "(Prelude.>=)". Extract Inlined Constant Z_gt_le_dec => "(Prelude.>)". Extract Constant Z.div => "(\n m -> if m Prelude.== 0 then 0 else Prelude.div n m)". Extract Constant Z.modulo => "(\n m -> if m Prelude.== 0 then n else Prelude.mod n m)". coq-8.20.0/theories/extraction/ExtrOCamlFloats.v000066400000000000000000000057341466560755400216160ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* bool [ true false ]. Extract Inductive prod => "( * )" [ "" ]. Extract Inductive FloatClass.float_class => "Float64.float_class" [ "PNormal" "NNormal" "PSubn" "NSubn" "PZero" "NZero" "PInf" "NInf" "NaN" ]. Extract Inductive PrimFloat.float_comparison => "Float64.float_comparison" [ "FEq" "FLt" "FGt" "FNotComparable" ]. (** Primitive types and operators. *) Extract Constant PrimFloat.float => "Float64.t". Extraction Inline PrimFloat.float. (* Otherwise, the name conflicts with the primitive OCaml type [float] *) Extract Constant PrimFloat.classify => "Float64.classify". Extract Constant PrimFloat.abs => "Float64.abs". Extract Constant PrimFloat.sqrt => "Float64.sqrt". Extract Constant PrimFloat.opp => "Float64.opp". Extract Constant PrimFloat.eqb => "Float64.eq". Extract Constant PrimFloat.ltb => "Float64.lt". Extract Constant PrimFloat.leb => "Float64.le". Extract Constant PrimFloat.compare => "Float64.compare". Extract Constant PrimFloat.Leibniz.eqb => "Float64.equal". Extract Constant PrimFloat.mul => "Float64.mul". Extract Constant PrimFloat.add => "Float64.add". Extract Constant PrimFloat.sub => "Float64.sub". Extract Constant PrimFloat.div => "Float64.div". Extract Constant PrimFloat.of_uint63 => "Float64.of_uint63". Extract Constant PrimFloat.normfr_mantissa => "Float64.normfr_mantissa". Extract Constant PrimFloat.frshiftexp => "Float64.frshiftexp". Extract Constant PrimFloat.ldshiftexp => "Float64.ldshiftexp". Extract Constant PrimFloat.next_up => "Float64.next_up". Extract Constant PrimFloat.next_down => "Float64.next_down". coq-8.20.0/theories/extraction/ExtrOCamlInt63.v000066400000000000000000000053611466560755400212650ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* bool [ true false ]. Extract Inductive prod => "( * )" [ "" ]. Extract Inductive DoubleType.carry => "Uint63.carry" [ "Uint63.C0" "Uint63.C1" ]. (** Primitive types and operators. *) Extract Constant Uint63.int => "Uint63.t". Extraction Inline Uint63.int. (* Otherwise, the name conflicts with the primitive OCaml type [int] *) Extract Constant Uint63.lsl => "Uint63.l_sl". Extract Constant Uint63.lsr => "Uint63.l_sr". Extract Constant Sint63.asr => "Uint63.a_sr". Extract Constant Uint63.land => "Uint63.l_and". Extract Constant Uint63.lor => "Uint63.l_or". Extract Constant Uint63.lxor => "Uint63.l_xor". Extract Constant Uint63.add => "Uint63.add". Extract Constant Uint63.sub => "Uint63.sub". Extract Constant Uint63.mul => "Uint63.mul". Extract Constant Uint63.mulc => "Uint63.mulc". Extract Constant Uint63.div => "Uint63.div". Extract Constant Uint63.mod => "Uint63.rem". Extract Constant Sint63.div => "Uint63.divs". Extract Constant Sint63.rem => "Uint63.rems". Extract Constant Uint63.eqb => "Uint63.equal". Extract Constant Uint63.ltb => "Uint63.lt". Extract Constant Uint63.leb => "Uint63.le". Extract Constant Sint63.ltb => "Uint63.lts". Extract Constant Sint63.leb => "Uint63.les". Extract Constant Uint63.addc => "Uint63.addc". Extract Constant Uint63.addcarryc => "Uint63.addcarryc". Extract Constant Uint63.subc => "Uint63.subc". Extract Constant Uint63.subcarryc => "Uint63.subcarryc". Extract Constant Uint63.diveucl => "Uint63.diveucl". Extract Constant Uint63.diveucl_21 => "Uint63.div21". Extract Constant Uint63.addmuldiv => "Uint63.addmuldiv". Extract Constant Uint63.compare => "(fun x y -> let c = Uint63.compare x y in if c = 0 then Eq else if c < 0 then Lt else Gt)". Extract Constant Sint63.compare => "(fun x y -> let c = Uint63.compares x y in if c = 0 then Eq else if c < 0 then Lt else Gt)". Extract Constant Uint63.head0 => "Uint63.head0". Extract Constant Uint63.tail0 => "Uint63.tail0". coq-8.20.0/theories/extraction/ExtrOCamlPArray.v000066400000000000000000000023411466560755400215530ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * INRIA, CNRS and contributors - Copyright 1999-2019 *) (* "'a Parray.t". Extraction Inline PArray.array. (* Otherwise, the name conflicts with the primitive OCaml type [array] *) Extract Constant PArray.make => "Parray.make". Extract Constant PArray.get => "Parray.get". Extract Constant PArray.default => "Parray.default". Extract Constant PArray.set => "Parray.set". Extract Constant PArray.length => "Parray.length". Extract Constant PArray.copy => "Parray.copy". coq-8.20.0/theories/extraction/ExtrOCamlPString.v000066400000000000000000000036361466560755400217530ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* "Pstring.t". Extract Constant PrimString.max_length => "Pstring.max_length". Extract Constant PrimString.make => "Pstring.make". Extract Constant PrimString.length => "Pstring.length". Extract Constant PrimString.get => "Pstring.get". Extract Constant PrimString.sub => "Pstring.sub". Extract Constant PrimString.cat => "Pstring.cat". Extract Constant PrimString.compare => "(fun x y -> let c = Pstring.compare x y in if c = 0 then Eq else if c < 0 then Lt else Gt)". coq-8.20.0/theories/extraction/ExtrOcamlBasic.v000066400000000000000000000031211466560755400214330ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* bool [ true false ]. Extract Inductive option => option [ Some None ]. Extract Inductive unit => unit [ "()" ]. Extract Inductive list => list [ "[]" "( :: )" ]. Extract Inductive prod => "( * )" [ "" ]. (** NB: The "" above is a hack, but produce nicer code than "(,)" *) (** Mapping sumbool to bool and sumor to option is not always nicer, but it helps when realizing stuff like [lt_eq_lt_dec] *) Extract Inductive sumbool => bool [ true false ]. Extract Inductive sumor => option [ Some None ]. (** Restore laziness of andb, orb. NB: without these Extract Constant, andb/orb would be inlined by extraction in order to have laziness, producing inelegant (if ... then ... else false) and (if ... then true else ...). *) Extract Inlined Constant andb => "(&&)". Extract Inlined Constant orb => "(||)". coq-8.20.0/theories/extraction/ExtrOcamlChar.v000066400000000000000000000102071466560755400212720ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* char [ "(* If this appears, you're using Ascii internals. Please don't *) (fun (b0,b1,b2,b3,b4,b5,b6,b7) -> let f b i = if b then 1 lsl i else 0 in Char.chr (f b0 0 + f b1 1 + f b2 2 + f b3 3 + f b4 4 + f b5 5 + f b6 6 + f b7 7))" ] "(* If this appears, you're using Ascii internals. Please don't *) (fun f c -> let n = Char.code c in let h i = (n land (1 lsl i)) <> 0 in f (h 0) (h 1) (h 2) (h 3) (h 4) (h 5) (h 6) (h 7))". Extract Constant zero => "'\000'". Extract Constant one => "'\001'". Extract Constant shift => "fun b c -> Char.chr (((Char.code c) lsl 1) land 255 + if b then 1 else 0)". Extract Inlined Constant ascii_dec => "(=)". Extract Inlined Constant Ascii.eqb => "(=)". Extract Constant Ascii.compare => "fun c1 c2 -> let cmp = Char.compare c1 c2 in if cmp < 0 then Lt else if cmp = 0 then Eq else Gt". (* python -c 'print(" ".join(r""" "%s" """.strip() % (r"'"'\''"'" if chr(i) == "'"'"'" else repr(""" "" """.strip()) if chr(i) == """ " """.strip() else repr(chr(i))) for i in range(256)))' # " to satisfy Coq's comment parser *) Extract Inductive byte => char ["'\x00'" "'\x01'" "'\x02'" "'\x03'" "'\x04'" "'\x05'" "'\x06'" "'\x07'" "'\x08'" "'\t'" "'\n'" "'\x0b'" "'\x0c'" "'\r'" "'\x0e'" "'\x0f'" "'\x10'" "'\x11'" "'\x12'" "'\x13'" "'\x14'" "'\x15'" "'\x16'" "'\x17'" "'\x18'" "'\x19'" "'\x1a'" "'\x1b'" "'\x1c'" "'\x1d'" "'\x1e'" "'\x1f'" "' '" "'!'" "'""'" "'#'" "'$'" "'%'" "'&'" "'\''" "'('" "')'" "'*'" "'+'" "','" "'-'" "'.'" "'/'" "'0'" "'1'" "'2'" "'3'" "'4'" "'5'" "'6'" "'7'" "'8'" "'9'" "':'" "';'" "'<'" "'='" "'>'" "'?'" "'@'" "'A'" "'B'" "'C'" "'D'" "'E'" "'F'" "'G'" "'H'" "'I'" "'J'" "'K'" "'L'" "'M'" "'N'" "'O'" "'P'" "'Q'" "'R'" "'S'" "'T'" "'U'" "'V'" "'W'" "'X'" "'Y'" "'Z'" "'['" "'\\'" "']'" "'^'" "'_'" "'`'" "'a'" "'b'" "'c'" "'d'" "'e'" "'f'" "'g'" "'h'" "'i'" "'j'" "'k'" "'l'" "'m'" "'n'" "'o'" "'p'" "'q'" "'r'" "'s'" "'t'" "'u'" "'v'" "'w'" "'x'" "'y'" "'z'" "'{'" "'|'" "'}'" "'~'" "'\x7f'" "'\x80'" "'\x81'" "'\x82'" "'\x83'" "'\x84'" "'\x85'" "'\x86'" "'\x87'" "'\x88'" "'\x89'" "'\x8a'" "'\x8b'" "'\x8c'" "'\x8d'" "'\x8e'" "'\x8f'" "'\x90'" "'\x91'" "'\x92'" "'\x93'" "'\x94'" "'\x95'" "'\x96'" "'\x97'" "'\x98'" "'\x99'" "'\x9a'" "'\x9b'" "'\x9c'" "'\x9d'" "'\x9e'" "'\x9f'" "'\xa0'" "'\xa1'" "'\xa2'" "'\xa3'" "'\xa4'" "'\xa5'" "'\xa6'" "'\xa7'" "'\xa8'" "'\xa9'" "'\xaa'" "'\xab'" "'\xac'" "'\xad'" "'\xae'" "'\xaf'" "'\xb0'" "'\xb1'" "'\xb2'" "'\xb3'" "'\xb4'" "'\xb5'" "'\xb6'" "'\xb7'" "'\xb8'" "'\xb9'" "'\xba'" "'\xbb'" "'\xbc'" "'\xbd'" "'\xbe'" "'\xbf'" "'\xc0'" "'\xc1'" "'\xc2'" "'\xc3'" "'\xc4'" "'\xc5'" "'\xc6'" "'\xc7'" "'\xc8'" "'\xc9'" "'\xca'" "'\xcb'" "'\xcc'" "'\xcd'" "'\xce'" "'\xcf'" "'\xd0'" "'\xd1'" "'\xd2'" "'\xd3'" "'\xd4'" "'\xd5'" "'\xd6'" "'\xd7'" "'\xd8'" "'\xd9'" "'\xda'" "'\xdb'" "'\xdc'" "'\xdd'" "'\xde'" "'\xdf'" "'\xe0'" "'\xe1'" "'\xe2'" "'\xe3'" "'\xe4'" "'\xe5'" "'\xe6'" "'\xe7'" "'\xe8'" "'\xe9'" "'\xea'" "'\xeb'" "'\xec'" "'\xed'" "'\xee'" "'\xef'" "'\xf0'" "'\xf1'" "'\xf2'" "'\xf3'" "'\xf4'" "'\xf5'" "'\xf6'" "'\xf7'" "'\xf8'" "'\xf9'" "'\xfa'" "'\xfb'" "'\xfc'" "'\xfd'" "'\xfe'" "'\xff'"]. Extract Inlined Constant Byte.eqb => "(=)". Extract Inlined Constant Byte.byte_eq_dec => "(=)". Extract Inlined Constant Ascii.ascii_of_byte => "(fun x -> x)". Extract Inlined Constant Ascii.byte_of_ascii => "(fun x -> x)". coq-8.20.0/theories/extraction/ExtrOcamlIntConv.v000066400000000000000000000061401466560755400217760ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* int. Parameter int_opp : int -> int. Parameter int_twice : int -> int. Extract Inlined Constant int => int. Extract Inlined Constant int_zero => "0". Extract Inlined Constant int_succ => "succ". Extract Inlined Constant int_opp => "-". Extract Inlined Constant int_twice => "2 *". Definition int_of_nat : nat -> int := (fix loop acc n := match n with | O => acc | S n => loop (int_succ acc) n end) int_zero. Fixpoint int_of_pos p := match p with | xH => int_succ int_zero | xO p => int_twice (int_of_pos p) | xI p => int_succ (int_twice (int_of_pos p)) end. Definition int_of_z z := match z with | Z0 => int_zero | Zpos p => int_of_pos p | Zneg p => int_opp (int_of_pos p) end. Definition int_of_n n := match n with | N0 => int_zero | Npos p => int_of_pos p end. (** NB: as for [pred] or [minus], [nat_of_int], [n_of_int] and [pos_of_int] are total and return zero (resp. one) for non-positive inputs. *) Parameter int_natlike_rec : forall A, A -> (A->A) -> int -> A. Extract Constant int_natlike_rec => "fun fO fS -> let rec loop acc i = if i <= 0 then acc else loop (fS acc) (i-1) in loop fO". Definition nat_of_int : int -> nat := int_natlike_rec _ O S. Parameter int_poslike_rec : forall A, A -> (A->A) -> (A->A) -> int -> A. Extract Constant int_poslike_rec => "fun f1 f2x f2x1 -> let rec loop i = if i <= 1 then f1 else if i land 1 = 0 then f2x (loop (i lsr 1)) else f2x1 (loop (i lsr 1)) in loop". Definition pos_of_int : int -> positive := int_poslike_rec _ xH xO xI. Parameter int_zlike_case : forall A, A -> (int->A) -> (int->A) -> int -> A. Extract Constant int_zlike_case => "fun f0 fpos fneg i -> if i = 0 then f0 else if i>0 then fpos i else fneg (-i)". Definition z_of_int : int -> Z := int_zlike_case _ Z0 (fun i => Zpos (pos_of_int i)) (fun i => Zneg (pos_of_int i)). Definition n_of_int : int -> N := int_zlike_case _ N0 (fun i => Npos (pos_of_int i)) (fun _ => N0). (** Warning: [z_of_int] is currently wrong for Ocaml's [min_int], since [min_int] has no positive opposite ([-min_int = min_int]). *) (* Extraction "/tmp/test.ml" nat_of_int int_of_nat pos_of_int int_of_pos z_of_int int_of_z n_of_int int_of_n. *) coq-8.20.0/theories/extraction/ExtrOcamlNatBigInt.v000066400000000000000000000062751466560755400222460ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* "Big_int_Z.big_int" [ "Big_int_Z.zero_big_int" "Big_int_Z.succ_big_int" ] "(fun fO fS n -> if Big_int_Z.sign_big_int n <= 0 then fO () else fS (Big_int_Z.pred_big_int n))". (** Efficient (but uncertified) versions for usual [nat] functions *) Extract Constant plus => "Big_int_Z.add_big_int". Extract Constant mult => "Big_int_Z.mult_big_int". Extract Constant pred => "(fun n -> Big_int_Z.max_big_int Big_int_Z.zero_big_int (Big_int_Z.pred_big_int n))". Extract Constant minus => "(fun n m -> Big_int_Z.max_big_int Big_int_Z.zero_big_int (Big_int_Z.sub_big_int n m))". Extract Constant max => "Big_int_Z.max_big_int". Extract Constant min => "Big_int_Z.min_big_int". (*Extract Constant nat_beq => "Big.eq".*) Extract Constant Nat.eqb => "Big_int_Z.eq_big_int". Extract Constant EqNat.eq_nat_decide => "Big_int_Z.eq_big_int". Extract Constant Peano_dec.eq_nat_dec => "Big_int_Z.eq_big_int". Extract Constant Nat.compare => "(fun x y -> let s = Big_int_Z.compare_big_int x y in if s = 0 then Eq else if s < 0 then Lt else Gt)". Extract Constant Compare_dec.leb => "Big_int_Z.le_big_int". Extract Constant Compare_dec.le_lt_dec => "Big_int_Z.le_big_int". Extract Constant Compare_dec.lt_eq_lt_dec => "(fun x y -> let s = Big_int_Z.compare_big_int x y in if s = 0 then (Some false) else if s < 0 then (Some true) else None)". Extract Constant Nat.Even_or_Odd => "(fun n -> Big_int_Z.sign_big_int (Big_int_Z.mod_big_int n (Big_int_Z.big_int_of_int 2)) = 0)". Extract Constant Nat.div2 => "(fun n -> Big_int_Z.div_big_int n (Big_int_Z.big_int_of_int 2))". Extract Inductive Euclid.diveucl => "(Big_int_Z.big_int * Big_int_Z.big_int)" [""]. Extract Constant Euclid.eucl_dev => "(fun n m -> Big_int_Z.quomod_big_int m n)". Extract Constant Euclid.quotient => "(fun n m -> Big_int_Z.div_big_int m n)". Extract Constant Euclid.modulo => "(fun n m -> Big_int_Z.mod_big_int m n)". (* Require Import Euclid. Definition test n m (H:m>0) := let (q,r,_,_) := eucl_dev m H n in nat_compare n (q*m+r). Extraction "/tmp/test.ml" test fact pred minus max min Div2.div2. *) coq-8.20.0/theories/extraction/ExtrOcamlNatInt.v000066400000000000000000000067541466560755400216260ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* int [ "0" "Stdlib.Int.succ" ] "(fun fO fS n -> if n=0 then fO () else fS (n-1))". (** Efficient (but uncertified) versions for usual [nat] functions *) Extract Constant plus => "(+)". Extract Constant pred => "fun n -> Stdlib.max 0 (n-1)". Extract Constant minus => "fun n m -> Stdlib.max 0 (n-m)". Extract Constant mult => "( * )". Extract Inlined Constant max => "Stdlib.max". Extract Inlined Constant min => "Stdlib.min". (*Extract Inlined Constant nat_beq => "(=)".*) Extract Inlined Constant Nat.eqb => "(=)". Extract Inlined Constant EqNat.eq_nat_decide => "(=)". Extract Inlined Constant Peano_dec.eq_nat_dec => "(=)". Extract Constant Nat.compare => "fun n m -> if n=m then Eq else if n "(<=)". Extract Inlined Constant Compare_dec.le_lt_dec => "(<=)". Extract Inlined Constant Compare_dec.lt_dec => "(<)". Extract Constant Compare_dec.lt_eq_lt_dec => "fun n m -> if n>m then None else Some (n "fun n -> n mod 2 = 0". Extract Constant Nat.div2 => "fun n -> n/2". Extract Inductive Euclid.diveucl => "(int * int)" [ "" ]. Extract Constant Euclid.eucl_dev => "fun n m -> (m/n, m mod n)". Extract Constant Euclid.quotient => "fun n m -> m/n". Extract Constant Euclid.modulo => "fun n m -> m mod n". (* Definition test n m (H:m>0) := let (q,r,_,_) := eucl_dev m H n in nat_compare n (q*m+r). Recursive Extraction test fact. *) coq-8.20.0/theories/extraction/ExtrOcamlNativeString.v000066400000000000000000000124321466560755400230340ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* char ["'\x00'" "'\x01'" "'\x02'" "'\x03'" "'\x04'" "'\x05'" "'\x06'" "'\x07'" "'\x08'" "'\t'" "'\n'" "'\x0b'" "'\x0c'" "'\r'" "'\x0e'" "'\x0f'" "'\x10'" "'\x11'" "'\x12'" "'\x13'" "'\x14'" "'\x15'" "'\x16'" "'\x17'" "'\x18'" "'\x19'" "'\x1a'" "'\x1b'" "'\x1c'" "'\x1d'" "'\x1e'" "'\x1f'" "' '" "'!'" "'""'" "'#'" "'$'" "'%'" "'&'" "'\''" "'('" "')'" "'*'" "'+'" "','" "'-'" "'.'" "'/'" "'0'" "'1'" "'2'" "'3'" "'4'" "'5'" "'6'" "'7'" "'8'" "'9'" "':'" "';'" "'<'" "'='" "'>'" "'?'" "'@'" "'A'" "'B'" "'C'" "'D'" "'E'" "'F'" "'G'" "'H'" "'I'" "'J'" "'K'" "'L'" "'M'" "'N'" "'O'" "'P'" "'Q'" "'R'" "'S'" "'T'" "'U'" "'V'" "'W'" "'X'" "'Y'" "'Z'" "'['" "'\\'" "']'" "'^'" "'_'" "'`'" "'a'" "'b'" "'c'" "'d'" "'e'" "'f'" "'g'" "'h'" "'i'" "'j'" "'k'" "'l'" "'m'" "'n'" "'o'" "'p'" "'q'" "'r'" "'s'" "'t'" "'u'" "'v'" "'w'" "'x'" "'y'" "'z'" "'{'" "'|'" "'}'" "'~'" "'\x7f'" "'\x80'" "'\x81'" "'\x82'" "'\x83'" "'\x84'" "'\x85'" "'\x86'" "'\x87'" "'\x88'" "'\x89'" "'\x8a'" "'\x8b'" "'\x8c'" "'\x8d'" "'\x8e'" "'\x8f'" "'\x90'" "'\x91'" "'\x92'" "'\x93'" "'\x94'" "'\x95'" "'\x96'" "'\x97'" "'\x98'" "'\x99'" "'\x9a'" "'\x9b'" "'\x9c'" "'\x9d'" "'\x9e'" "'\x9f'" "'\xa0'" "'\xa1'" "'\xa2'" "'\xa3'" "'\xa4'" "'\xa5'" "'\xa6'" "'\xa7'" "'\xa8'" "'\xa9'" "'\xaa'" "'\xab'" "'\xac'" "'\xad'" "'\xae'" "'\xaf'" "'\xb0'" "'\xb1'" "'\xb2'" "'\xb3'" "'\xb4'" "'\xb5'" "'\xb6'" "'\xb7'" "'\xb8'" "'\xb9'" "'\xba'" "'\xbb'" "'\xbc'" "'\xbd'" "'\xbe'" "'\xbf'" "'\xc0'" "'\xc1'" "'\xc2'" "'\xc3'" "'\xc4'" "'\xc5'" "'\xc6'" "'\xc7'" "'\xc8'" "'\xc9'" "'\xca'" "'\xcb'" "'\xcc'" "'\xcd'" "'\xce'" "'\xcf'" "'\xd0'" "'\xd1'" "'\xd2'" "'\xd3'" "'\xd4'" "'\xd5'" "'\xd6'" "'\xd7'" "'\xd8'" "'\xd9'" "'\xda'" "'\xdb'" "'\xdc'" "'\xdd'" "'\xde'" "'\xdf'" "'\xe0'" "'\xe1'" "'\xe2'" "'\xe3'" "'\xe4'" "'\xe5'" "'\xe6'" "'\xe7'" "'\xe8'" "'\xe9'" "'\xea'" "'\xeb'" "'\xec'" "'\xed'" "'\xee'" "'\xef'" "'\xf0'" "'\xf1'" "'\xf2'" "'\xf3'" "'\xf4'" "'\xf5'" "'\xf6'" "'\xf7'" "'\xf8'" "'\xf9'" "'\xfa'" "'\xfb'" "'\xfc'" "'\xfd'" "'\xfe'" "'\xff'"]. Extract Inlined Constant Byte.eqb => "(=)". Extract Inlined Constant Byte.byte_eq_dec => "(=)". Extract Inlined Constant Ascii.ascii_of_byte => "(fun x -> x)". Extract Inlined Constant Ascii.byte_of_ascii => "(fun x -> x)". (* This differs from ExtrOcamlString.v: the latter extracts "string" to "char list", and we extract "string" to "string" *) Extract Inductive string => "string" [ (* EmptyString *) "(* If this appears, you're using String internals. Please don't *) """" " (* String *) "(* If this appears, you're using String internals. Please don't *) (fun (c, s) -> String.make 1 c ^ s) " ] "(* If this appears, you're using String internals. Please don't *) (fun f0 f1 s -> let l = String.length s in if l = 0 then f0 () else f1 (String.get s 0) (String.sub s 1 (l-1))) ". Extract Inlined Constant String.string_dec => "(=)". Extract Inlined Constant String.eqb => "(=)". Extract Inlined Constant String.append => "(^)". Extract Inlined Constant String.concat => "String.concat". Extract Inlined Constant String.prefix => "(fun s1 s2 -> let l1 = String.length s1 and l2 = String.length s2 in l1 <= l2 && String.sub s2 0 l1 = s1)". Extract Inlined Constant String.string_of_list_ascii => "(fun l -> let a = Array.of_list l in String.init (Array.length a) (fun i -> a.(i)))". Extract Inlined Constant String.list_ascii_of_string => "(fun s -> List.init (String.length s) (fun i -> s.[i]))". Extract Inlined Constant String.string_of_list_byte => "(fun l -> let a = Array.of_list l in String.init (Array.length a) (fun i -> a.(i)))". Extract Inlined Constant String.list_byte_of_string => "(fun s -> List.init (String.length s) (fun i -> s.[i]))". (* Other operations in module String (at the time of this writing): String.length String.get String.substring String.index String.findex They all use type "nat". If we know that "nat" extracts to O | S of nat, we can provide OCaml implementations for these functions that work directly on OCaml's strings. However "nat" could be extracted to other OCaml types... *) (* Definition test := "ceci est un test"%string. Recursive Extraction test Ascii.zero Ascii.one. *) coq-8.20.0/theories/extraction/ExtrOcamlString.v000066400000000000000000000016211466560755400216630ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* "char list" [ "[]" "(::)" ]. coq-8.20.0/theories/extraction/ExtrOcamlZBigInt.v000066400000000000000000000147761466560755400217420ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* "Big_int_Z.big_int" [ "(fun x -> Big_int_Z.succ_big_int (Big_int_Z.mult_int_big_int 2 x))" "Big_int_Z.mult_int_big_int 2" "Big_int_Z.unit_big_int" ] "(fun f2p1 f2p f1 p -> if Big_int_Z.le_big_int p Big_int_Z.unit_big_int then f1 () else let (q,r) = Big_int_Z.quomod_big_int p (Big_int_Z.big_int_of_int 2) in if Big_int_Z.eq_big_int r Big_int_Z.zero_big_int then f2p q else f2p1 q)". Extract Inductive Z => "Big_int_Z.big_int" [ "Big_int_Z.zero_big_int" "" "Big_int_Z.minus_big_int" ] "(fun fO fp fn z -> let s = Big_int_Z.sign_big_int z in if s = 0 then fO () else if s > 0 then fp z else fn (Big_int_Z.minus_big_int z))". Extract Inductive N => "Big_int_Z.big_int" [ "Big_int_Z.zero_big_int" "" ] "(fun fO fp n -> if Big_int_Z.sign_big_int n <= 0 then fO () else fp n)". (** Nota: the "" above is used as an identity function "(fun p->p)" *) (** Efficient (but uncertified) versions for usual functions *) Extract Constant Pos.add => "Big_int_Z.add_big_int". Extract Constant Pos.succ => "Big_int_Z.succ_big_int". Extract Constant Pos.pred => "(fun n -> Big_int_Z.max_big_int Big_int_Z.unit_big_int (Big_int_Z.pred_big_int n))". Extract Constant Pos.sub => "(fun n m -> Big_int_Z.max_big_int Big_int_Z.unit_big_int (Big_int_Z.sub_big_int n m))". Extract Constant Pos.mul => "Big_int_Z.mult_big_int". Extract Constant Pos.min => "Big_int_Z.min_big_int". Extract Constant Pos.max => "Big_int_Z.max_big_int". Extract Constant Pos.compare => "(fun x y -> let s = Big_int_Z.compare_big_int x y in if s = 0 then Eq else if s < 0 then Lt else Gt)". Extract Constant Pos.compare_cont => "(fun c x y -> let s = Big_int_Z.compare_big_int x y in if s = 0 then c else if s < 0 then Lt else Gt)". Extract Constant N.add => "Big_int_Z.add_big_int". Extract Constant N.succ => "Big_int_Z.succ_big_int". Extract Constant N.pred => "(fun n -> Big_int_Z.max_big_int Big_int_Z.zero_big_int (Big_int_Z.pred_big_int n))". Extract Constant N.sub => "(fun n m -> Big_int_Z.max_big_int Big_int_Z.zero_big_int (Big_int_Z.sub_big_int n m))". Extract Constant N.mul => "Big_int_Z.mult_big_int". Extract Constant N.min => "Big_int_Z.min_big_int". Extract Constant N.max => "Big_int_Z.max_big_int". Extract Constant N.div_eucl => "Big_int_Z.(fun x y -> if eq_big_int zero_big_int y then (zero_big_int, x) else quomod_big_int x y)". Extract Constant N.div => "(fun a b -> if Big_int_Z.eq_big_int b Big_int_Z.zero_big_int then Big_int_Z.zero_big_int else Big_int_Z.div_big_int a b)". Extract Constant N.modulo => "(fun a b -> if Big_int_Z.eq_big_int b Big_int_Z.zero_big_int then a else Big_int_Z.mod_big_int a b)". Extract Constant Z.eqb => "Big_int_Z.eq_big_int". Extract Constant Z.eq_dec => "Big_int_Z.eq_big_int". Extract Constant N.compare => "(fun x y -> let s = Big_int_Z.compare_big_int x y in if s = 0 then Eq else if s < 0 then Lt else Gt)". (* In Zarith, the second operand of a shift is an [int]. The conversion to [int] may throw an [Overflow]. Bigger shifts involve enormous numbers that don't fit in memory anyway. *) Extract Constant N.shiftl => "Big_int_Z.(fun x y -> shift_left_big_int x (int_of_big_int y))". Extract Constant N.shiftr => "Big_int_Z.(fun x y -> shift_right_big_int x (int_of_big_int y))". Extract Constant Z.add => "Big_int_Z.add_big_int". Extract Constant Z.succ => "Big_int_Z.succ_big_int". Extract Constant Z.pred => "Big_int_Z.pred_big_int". Extract Constant Z.sub => "Big_int_Z.sub_big_int". Extract Constant Z.mul => "Big_int_Z.mult_big_int". Extract Constant Z.opp => "Big_int_Z.minus_big_int". Extract Constant Z.abs => "Big_int_Z.abs_big_int". Extract Constant Z.min => "Big_int_Z.min_big_int". Extract Constant Z.max => "Big_int_Z.max_big_int". Extract Constant Z.compare => "(fun x y -> let s = Big_int_Z.compare_big_int x y in if s = 0 then Eq else if s < 0 then Lt else Gt)". Extract Constant Z.eqb => "Big_int_Z.eq_big_int". Extract Constant Z.eq_dec => "Big_int_Z.eq_big_int". Extract Constant Z.to_N => "Big_int_Z.(fun p -> if sign_big_int p < 0 then zero_big_int else p)". Extract Constant Z.of_N => "(fun p -> p)". Extract Constant Z.abs_N => "Big_int_Z.abs_big_int". Extract Constant Z.div_eucl => "Big_int_Z.(fun x y -> match sign_big_int y with | 0 -> (zero_big_int, x) | 1 -> quomod_big_int x y | _ -> let (q, r) = quomod_big_int (add_int_big_int (-1) x) y in (add_int_big_int (-1) q, add_big_int (add_int_big_int 1 y) r))". Extract Constant Z.div => "Big_int_Z.(fun x y -> match sign_big_int y with | 0 -> zero_big_int | 1 -> div_big_int x y | _ -> add_int_big_int (-1) (div_big_int (add_int_big_int (-1) x) y))". Extract Constant Z.modulo => "Big_int_Z.(fun x y -> match sign_big_int y with | 0 -> x | 1 -> mod_big_int x y | _ -> add_big_int y (add_int_big_int 1 (mod_big_int (add_int_big_int (-1) x) y)))". Extract Constant Z.shiftl => "Big_int_Z.(fun x y -> let y = int_of_big_int y in if y < 0 then shift_right_big_int x (-y) else shift_left_big_int x y)". Extract Constant Z.shiftr => "Big_int_Z.(fun x y -> let y = int_of_big_int y in if y < 0 then shift_left_big_int x (-y) else shift_right_big_int x y)". (** Test: Require Import ZArith NArith. Extraction "/tmp/test.ml" Pos.add Pos.pred Pos.sub Pos.mul Pos.compare N.pred N.sub N.div N.modulo N.compare Z.add Z.mul Z.compare Z.of_N Z.abs_N Z.div Z.modulo. *) coq-8.20.0/theories/extraction/ExtrOcamlZInt.v000066400000000000000000000066761466560755400213200ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* int [ "(fun p->1+2*p)" "(fun p->2*p)" "1" ] "(fun f2p1 f2p f1 p -> if p<=1 then f1 () else if p mod 2 = 0 then f2p (p/2) else f2p1 (p/2))". Extract Inductive Z => int [ "0" "" "(~-)" ] "(fun f0 fp fn z -> if z=0 then f0 () else if z>0 then fp z else fn (-z))". Extract Inductive N => int [ "0" "" ] "(fun f0 fp n -> if n=0 then f0 () else fp n)". (** Nota: the "" above is used as an identity function "(fun p->p)" *) (** Efficient (but uncertified) versions for usual functions *) Extract Constant Pos.add => "(+)". Extract Constant Pos.succ => "Stdlib.Int.succ". (* Stdlib.Int.max only available in >= 4.13 *) Extract Constant Pos.pred => "fun n -> Stdlib.max 1 (n-1)". Extract Constant Pos.sub => "fun n m -> Stdlib.max 1 (n-m)". Extract Constant Pos.mul => "( * )". Extract Constant Pos.min => "Stdlib.min". Extract Constant Pos.max => "Stdlib.max". Extract Constant Pos.compare => "fun x y -> if x=y then Eq else if x "fun c x y -> if x=y then c else if x "(+)". Extract Constant N.succ => "Stdlib.Int.succ". Extract Constant N.pred => "fun n -> Stdlib.Int.max 0 (n-1)". Extract Constant N.sub => "fun n m -> Stdlib.Int.max 0 (n-m)". Extract Constant N.mul => "( * )". (* Stdlib.Int.max only available in >= 4.13 *) Extract Constant N.min => "Stdlib.min". Extract Constant N.max => "Stdlib.max". Extract Constant N.div => "fun a b -> if b=0 then 0 else a/b". Extract Constant N.modulo => "fun a b -> if b=0 then a else a mod b". Extract Constant N.compare => "fun x y -> if x=y then Eq else if x "(+)". Extract Constant Z.succ => "Stdlib.Int.succ". Extract Constant Z.pred => "Stdlib.Int.pred". Extract Constant Z.sub => "(-)". Extract Constant Z.mul => "( * )". Extract Constant Z.opp => "(~-)". Extract Constant Z.abs => "Stdlib.Int.abs". (* Stdlib.Int.max only available in >= 4.13 *) Extract Constant Z.min => "Stdlib.min". Extract Constant Z.max => "Stdlib.max". Extract Constant Z.compare => "fun x y -> if x=y then Eq else if x "fun p -> p". Extract Constant Z.abs_N => "Stdlib.Int.abs". (** Z.div and Z.modulo are quite complex to define in terms of (/) and (mod). For the moment we don't even try *) coq-8.20.0/theories/extraction/Extraction.v000066400000000000000000000013471466560755400207230ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* A) -> A -> A := fun (fl : A -> A) (def : A) => match n with | O => def | S m => fl (iter m fl def) end. End Iter. Theorem le_lt_SS x y : x <= y -> x < S (S y). Proof. intros. now apply Nat.lt_succ_r, Nat.le_le_succ_r. Qed. Theorem Splus_lt x y : y < S (x + y). Proof. apply Nat.lt_succ_r. apply Nat.le_add_l. Qed. Theorem SSplus_lt x y : x < S (S (x + y)). Proof. apply le_lt_SS, Nat.le_add_r. Qed. Inductive max_type (m n:nat) : Set := cmt : forall v, m <= v -> n <= v -> max_type m n. Definition max m n : max_type m n. Proof. destruct (Compare_dec.le_gt_dec m n) as [h|h]. - exists n; [exact h | apply le_n]. - exists m; [apply le_n | apply Nat.lt_le_incl; exact h]. Defined. Definition Acc_intro_generator_function := fun A R => @Acc_intro_generator A R 100. coq-8.20.0/theories/index.mld000066400000000000000000000001701466560755400160320ustar00rootroot00000000000000{0 coq-stdlib } The coq-stdlib package only contains Coq theory files for the standard library and no OCaml libraries. coq-8.20.0/theories/micromega/000077500000000000000000000000001466560755400161725ustar00rootroot00000000000000coq-8.20.0/theories/micromega/DeclConstant.v000066400000000000000000000057211466560755400207470ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* T2) (A : T1) : DeclaredConstant F -> GT A -> GT (F A). Defined. #[global] Instance GT_APP2 {T1 T2 T3: Type} (F : T1 -> T2 -> T3) {A1 : T1} {A2 : T2} {DC:DeclaredConstant F} : GT A1 -> GT A2 -> GT (F A1 A2). Defined. Require Import QArith_base. #[global] Instance DO : DeclaredConstant O := {}. #[global] Instance DS : DeclaredConstant S := {}. #[global] Instance DxH: DeclaredConstant xH := {}. #[global] Instance DxI: DeclaredConstant xI := {}. #[global] Instance DxO: DeclaredConstant xO := {}. #[global] Instance DZO: DeclaredConstant Z0 := {}. #[global] Instance DZpos: DeclaredConstant Zpos := {}. #[global] Instance DZneg: DeclaredConstant Zneg := {}. #[global] Instance DZpow_pos : DeclaredConstant Z.pow_pos := {}. #[global] Instance DZpow : DeclaredConstant Z.pow := {}. #[global] Instance DQ : DeclaredConstant Qmake := {}. coq-8.20.0/theories/micromega/Env.v000066400000000000000000000062611466560755400171160ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* D. Definition jump (j:positive) (e:Env) := fun x => e (x+j). Definition nth (n:positive) (e:Env) := e n. Definition hd (e:Env) := nth 1 e. Definition tail (e:Env) := jump 1 e. Lemma jump_add i j l x : jump (i + j) l x = jump i (jump j l) x. Proof. unfold jump. f_equal. apply Pos.add_assoc. Qed. Lemma jump_simpl p l x : jump p l x = match p with | xH => tail l x | xO p => jump p (jump p l) x | xI p => jump p (jump p (tail l)) x end. Proof. destruct p; unfold tail; rewrite <- ?jump_add; f_equal; now rewrite Pos.add_diag. Qed. Lemma jump_tl j l x : tail (jump j l) x = jump j (tail l) x. Proof. unfold tail. rewrite <- !jump_add. f_equal. apply Pos.add_comm. Qed. Lemma jump_succ j l x : jump (Pos.succ j) l x = jump 1 (jump j l) x. Proof. rewrite <- jump_add. f_equal. symmetry. apply Pos.add_1_l. Qed. Lemma jump_pred_double i l x : jump (Pos.pred_double i) (tail l) x = jump i (jump i l) x. Proof. unfold tail. rewrite <- !jump_add. f_equal. now rewrite Pos.add_1_r, Pos.succ_pred_double, Pos.add_diag. Qed. Lemma nth_spec p l : nth p l = match p with | xH => hd l | xO p => nth p (jump p l) | xI p => nth p (jump p (tail l)) end. Proof. unfold hd, nth, tail, jump. destruct p; f_equal; now rewrite Pos.add_diag. Qed. Lemma nth_jump p l : nth p (tail l) = hd (jump p l). Proof. unfold hd, nth, tail, jump. f_equal. apply Pos.add_comm. Qed. Lemma nth_pred_double p l : nth (Pos.pred_double p) (tail l) = nth p (jump p l). Proof. unfold nth, tail, jump. f_equal. now rewrite Pos.add_1_r, Pos.succ_pred_double, Pos.add_diag. Qed. End S. Ltac jump_simpl := repeat match goal with | |- context [jump xH] => rewrite (jump_simpl xH) | |- context [jump (xO ?p)] => rewrite (jump_simpl (xO p)) | |- context [jump (xI ?p)] => rewrite (jump_simpl (xI p)) end. coq-8.20.0/theories/micromega/EnvRing.v000066400000000000000000000777221466560755400177500ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* PExpr | PEX : positive -> PExpr | PEadd : PExpr -> PExpr -> PExpr | PEsub : PExpr -> PExpr -> PExpr | PEmul : PExpr -> PExpr -> PExpr | PEopp : PExpr -> PExpr | PEpow : PExpr -> N -> PExpr. Arguments PExpr : clear implicits. Register PEc as micromega.PExpr.PEc. Register PEX as micromega.PExpr.PEX. Register PEadd as micromega.PExpr.PEadd. Register PEsub as micromega.PExpr.PEsub. Register PEmul as micromega.PExpr.PEmul. Register PEopp as micromega.PExpr.PEopp. Register PEpow as micromega.PExpr.PEpow. (* Definition of multivariable polynomials with coefficients in C : Type [Pol] represents [X1 ... Xn]. The representation is Horner's where a [n] variable polynomial (C[X1..Xn]) is seen as a polynomial on [X1] which coefficients are polynomials with [n-1] variables (C[X2..Xn]). There are several optimisations to make the repr compacter: - [Pc c] is the constant polynomial of value c == c*X1^0*..*Xn^0 - [Pinj j Q] is a polynomial constant w.r.t the [j] first variables. variable indices are shifted of j in Q. == X1^0 *..* Xj^0 * Q{X1 <- Xj+1;..; Xn-j <- Xn} - [PX P i Q] is an optimised Horner form of P*X^i + Q with P not the null polynomial == P * X1^i + Q{X1 <- X2; ..; Xn-1 <- Xn} In addition: - polynomials of the form (PX (PX P i (Pc 0)) j Q) are forbidden since they can be represented by the simpler form (PX P (i+j) Q) - (Pinj i (Pinj j P)) is (Pinj (i+j) P) - (Pinj i (Pc c)) is (Pc c) *) #[universes(template)] Inductive Pol {C} : Type := | Pc : C -> Pol | Pinj : positive -> Pol -> Pol | PX : Pol -> positive -> Pol -> Pol. Arguments Pol : clear implicits. Register Pc as micromega.Pol.Pc. Register Pinj as micromega.Pol.Pinj. Register PX as micromega.Pol.PX. Section MakeRingPol. (* Ring elements *) Variable R:Type. Variable (rO rI : R) (radd rmul rsub: R->R->R) (ropp : R->R). Variable req : R -> R -> Prop. (* Ring properties *) Variable Rsth : Equivalence req. Variable Reqe : ring_eq_ext radd rmul ropp req. Variable ARth : almost_ring_theory rO rI radd rmul rsub ropp req. (* Coefficients *) Variable C: Type. Variable (cO cI: C) (cadd cmul csub : C->C->C) (copp : C->C). Variable ceqb : C->C->bool. Variable phi : C -> R. Variable CRmorph : ring_morph rO rI radd rmul rsub ropp req cO cI cadd cmul csub copp ceqb phi. (* Power coefficients *) Variable Cpow : Type. Variable Cp_phi : N -> Cpow. Variable rpow : R -> Cpow -> R. Variable pow_th : power_theory rI rmul req Cp_phi rpow. (* R notations *) Notation "0" := rO. Notation "1" := rI. Infix "+" := radd. Infix "*" := rmul. Infix "-" := rsub. Notation "- x" := (ropp x). Infix "==" := req. Infix "^" := (pow_pos rmul). (* C notations *) Infix "+!" := cadd. Infix "*!" := cmul. Infix "-! " := csub. Notation "-! x" := (copp x). Infix "?=!" := ceqb. Notation "[ x ]" := (phi x). (* Useful tactics *) Add Morphism radd with signature (req ==> req ==> req) as radd_ext. Proof. exact (Radd_ext Reqe). Qed. Add Morphism rmul with signature (req ==> req ==> req) as rmul_ext. Proof. exact (Rmul_ext Reqe). Qed. Add Morphism ropp with signature (req ==> req) as ropp_ext. Proof. exact (Ropp_ext Reqe). Qed. Add Morphism rsub with signature (req ==> req ==> req) as rsub_ext. Proof. exact (ARsub_ext Rsth Reqe ARth). Qed. Ltac rsimpl := gen_srewrite Rsth Reqe ARth. Ltac add_push := gen_add_push radd Rsth Reqe ARth. Ltac mul_push := gen_mul_push rmul Rsth Reqe ARth. Ltac add_permut_rec t := match t with | ?x + ?y => add_permut_rec y || add_permut_rec x | _ => add_push t; apply (Radd_ext Reqe); [|reflexivity] end. Ltac add_permut := repeat (reflexivity || match goal with |- ?t == _ => add_permut_rec t end). Ltac mul_permut_rec t := match t with | ?x * ?y => mul_permut_rec y || mul_permut_rec x | _ => mul_push t; apply (Rmul_ext Reqe); [|reflexivity] end. Ltac mul_permut := repeat (reflexivity || match goal with |- ?t == _ => mul_permut_rec t end). Notation PExpr := (PExpr C). Notation Pol := (Pol C). Implicit Types pe : PExpr. Implicit Types P : Pol. Definition P0 := Pc cO. Definition P1 := Pc cI. Fixpoint Peq (P P' : Pol) {struct P'} : bool := match P, P' with | Pc c, Pc c' => c ?=! c' | Pinj j Q, Pinj j' Q' => match j ?= j' with | Eq => Peq Q Q' | _ => false end | PX P i Q, PX P' i' Q' => match i ?= i' with | Eq => if Peq P P' then Peq Q Q' else false | _ => false end | _, _ => false end. Infix "?==" := Peq. Definition mkPinj j P := match P with | Pc _ => P | Pinj j' Q => Pinj (j + j') Q | _ => Pinj j P end. Definition mkPinj_pred j P := match j with | xH => P | xO j => Pinj (Pos.pred_double j) P | xI j => Pinj (xO j) P end. Definition mkPX P i Q := match P with | Pc c => if c ?=! cO then mkPinj xH Q else PX P i Q | Pinj _ _ => PX P i Q | PX P' i' Q' => if Q' ?== P0 then PX P' (i' + i) Q else PX P i Q end. Definition mkXi i := PX P1 i P0. Definition mkX := mkXi 1. (** Opposite of addition *) Fixpoint Popp (P:Pol) : Pol := match P with | Pc c => Pc (-! c) | Pinj j Q => Pinj j (Popp Q) | PX P i Q => PX (Popp P) i (Popp Q) end. Notation "-- P" := (Popp P). (** Addition et subtraction *) Fixpoint PaddC (P:Pol) (c:C) : Pol := match P with | Pc c1 => Pc (c1 +! c) | Pinj j Q => Pinj j (PaddC Q c) | PX P i Q => PX P i (PaddC Q c) end. Fixpoint PsubC (P:Pol) (c:C) : Pol := match P with | Pc c1 => Pc (c1 -! c) | Pinj j Q => Pinj j (PsubC Q c) | PX P i Q => PX P i (PsubC Q c) end. Section PopI. Variable Pop : Pol -> Pol -> Pol. Variable Q : Pol. Fixpoint PaddI (j:positive) (P:Pol) : Pol := match P with | Pc c => mkPinj j (PaddC Q c) | Pinj j' Q' => match Z.pos_sub j' j with | Zpos k => mkPinj j (Pop (Pinj k Q') Q) | Z0 => mkPinj j (Pop Q' Q) | Zneg k => mkPinj j' (PaddI k Q') end | PX P i Q' => match j with | xH => PX P i (Pop Q' Q) | xO j => PX P i (PaddI (Pos.pred_double j) Q') | xI j => PX P i (PaddI (xO j) Q') end end. Fixpoint PsubI (j:positive) (P:Pol) : Pol := match P with | Pc c => mkPinj j (PaddC (--Q) c) | Pinj j' Q' => match Z.pos_sub j' j with | Zpos k => mkPinj j (Pop (Pinj k Q') Q) | Z0 => mkPinj j (Pop Q' Q) | Zneg k => mkPinj j' (PsubI k Q') end | PX P i Q' => match j with | xH => PX P i (Pop Q' Q) | xO j => PX P i (PsubI (Pos.pred_double j) Q') | xI j => PX P i (PsubI (xO j) Q') end end. Variable P' : Pol. Fixpoint PaddX (i':positive) (P:Pol) : Pol := match P with | Pc c => PX P' i' P | Pinj j Q' => match j with | xH => PX P' i' Q' | xO j => PX P' i' (Pinj (Pos.pred_double j) Q') | xI j => PX P' i' (Pinj (xO j) Q') end | PX P i Q' => match Z.pos_sub i i' with | Zpos k => mkPX (Pop (PX P k P0) P') i' Q' | Z0 => mkPX (Pop P P') i Q' | Zneg k => mkPX (PaddX k P) i Q' end end. Fixpoint PsubX (i':positive) (P:Pol) : Pol := match P with | Pc c => PX (--P') i' P | Pinj j Q' => match j with | xH => PX (--P') i' Q' | xO j => PX (--P') i' (Pinj (Pos.pred_double j) Q') | xI j => PX (--P') i' (Pinj (xO j) Q') end | PX P i Q' => match Z.pos_sub i i' with | Zpos k => mkPX (Pop (PX P k P0) P') i' Q' | Z0 => mkPX (Pop P P') i Q' | Zneg k => mkPX (PsubX k P) i Q' end end. End PopI. Fixpoint Padd (P P': Pol) {struct P'} : Pol := match P' with | Pc c' => PaddC P c' | Pinj j' Q' => PaddI Padd Q' j' P | PX P' i' Q' => match P with | Pc c => PX P' i' (PaddC Q' c) | Pinj j Q => match j with | xH => PX P' i' (Padd Q Q') | xO j => PX P' i' (Padd (Pinj (Pos.pred_double j) Q) Q') | xI j => PX P' i' (Padd (Pinj (xO j) Q) Q') end | PX P i Q => match Z.pos_sub i i' with | Zpos k => mkPX (Padd (PX P k P0) P') i' (Padd Q Q') | Z0 => mkPX (Padd P P') i (Padd Q Q') | Zneg k => mkPX (PaddX Padd P' k P) i (Padd Q Q') end end end. Infix "++" := Padd. Fixpoint Psub (P P': Pol) {struct P'} : Pol := match P' with | Pc c' => PsubC P c' | Pinj j' Q' => PsubI Psub Q' j' P | PX P' i' Q' => match P with | Pc c => PX (--P') i' (*(--(PsubC Q' c))*) (PaddC (--Q') c) | Pinj j Q => match j with | xH => PX (--P') i' (Psub Q Q') | xO j => PX (--P') i' (Psub (Pinj (Pos.pred_double j) Q) Q') | xI j => PX (--P') i' (Psub (Pinj (xO j) Q) Q') end | PX P i Q => match Z.pos_sub i i' with | Zpos k => mkPX (Psub (PX P k P0) P') i' (Psub Q Q') | Z0 => mkPX (Psub P P') i (Psub Q Q') | Zneg k => mkPX (PsubX Psub P' k P) i (Psub Q Q') end end end. Infix "--" := Psub. (** Multiplication *) Fixpoint PmulC_aux (P:Pol) (c:C) : Pol := match P with | Pc c' => Pc (c' *! c) | Pinj j Q => mkPinj j (PmulC_aux Q c) | PX P i Q => mkPX (PmulC_aux P c) i (PmulC_aux Q c) end. Definition PmulC P c := if c ?=! cO then P0 else if c ?=! cI then P else PmulC_aux P c. Section PmulI. Variable Pmul : Pol -> Pol -> Pol. Variable Q : Pol. Fixpoint PmulI (j:positive) (P:Pol) : Pol := match P with | Pc c => mkPinj j (PmulC Q c) | Pinj j' Q' => match Z.pos_sub j' j with | Zpos k => mkPinj j (Pmul (Pinj k Q') Q) | Z0 => mkPinj j (Pmul Q' Q) | Zneg k => mkPinj j' (PmulI k Q') end | PX P' i' Q' => match j with | xH => mkPX (PmulI xH P') i' (Pmul Q' Q) | xO j' => mkPX (PmulI j P') i' (PmulI (Pos.pred_double j') Q') | xI j' => mkPX (PmulI j P') i' (PmulI (xO j') Q') end end. End PmulI. Fixpoint Pmul (P P'' : Pol) {struct P''} : Pol := match P'' with | Pc c => PmulC P c | Pinj j' Q' => PmulI Pmul Q' j' P | PX P' i' Q' => match P with | Pc c => PmulC P'' c | Pinj j Q => let QQ' := match j with | xH => Pmul Q Q' | xO j => Pmul (Pinj (Pos.pred_double j) Q) Q' | xI j => Pmul (Pinj (xO j) Q) Q' end in mkPX (Pmul P P') i' QQ' | PX P i Q=> let QQ' := Pmul Q Q' in let PQ' := PmulI Pmul Q' xH P in let QP' := Pmul (mkPinj xH Q) P' in let PP' := Pmul P P' in (mkPX (mkPX PP' i P0 ++ QP') i' P0) ++ mkPX PQ' i QQ' end end. Infix "**" := Pmul. Fixpoint Psquare (P:Pol) : Pol := match P with | Pc c => Pc (c *! c) | Pinj j Q => Pinj j (Psquare Q) | PX P i Q => let twoPQ := Pmul P (mkPinj xH (PmulC Q (cI +! cI))) in let Q2 := Psquare Q in let P2 := Psquare P in mkPX (mkPX P2 i P0 ++ twoPQ) i Q2 end. (** Monomial **) (** A monomial is X1^k1...Xi^ki. Its representation is a simplified version of the polynomial representation: - [mon0] correspond to the polynom [P1]. - [(zmon j M)] corresponds to [(Pinj j ...)], i.e. skip j variable indices. - [(vmon i M)] is X^i*M with X the current variable, its corresponds to (PX P1 i ...)] *) Inductive Mon: Set := | mon0: Mon | zmon: positive -> Mon -> Mon | vmon: positive -> Mon -> Mon. Definition mkZmon j M := match M with mon0 => mon0 | _ => zmon j M end. Definition zmon_pred j M := match j with xH => M | _ => mkZmon (Pos.pred j) M end. Definition mkVmon i M := match M with | mon0 => vmon i mon0 | zmon j m => vmon i (zmon_pred j m) | vmon i' m => vmon (i+i') m end. Fixpoint MFactor (P: Pol) (M: Mon) : Pol * Pol := match P, M with _, mon0 => (Pc cO, P) | Pc _, _ => (P, Pc cO) | Pinj j1 P1, zmon j2 M1 => match (j1 ?= j2) with Eq => let (R,S) := MFactor P1 M1 in (mkPinj j1 R, mkPinj j1 S) | Lt => let (R,S) := MFactor P1 (zmon (j2 - j1) M1) in (mkPinj j1 R, mkPinj j1 S) | Gt => (P, Pc cO) end | Pinj _ _, vmon _ _ => (P, Pc cO) | PX P1 i Q1, zmon j M1 => let M2 := zmon_pred j M1 in let (R1, S1) := MFactor P1 M in let (R2, S2) := MFactor Q1 M2 in (mkPX R1 i R2, mkPX S1 i S2) | PX P1 i Q1, vmon j M1 => match (i ?= j) with Eq => let (R1,S1) := MFactor P1 (mkZmon xH M1) in (mkPX R1 i Q1, S1) | Lt => let (R1,S1) := MFactor P1 (vmon (j - i) M1) in (mkPX R1 i Q1, S1) | Gt => let (R1,S1) := MFactor P1 (mkZmon xH M1) in (mkPX R1 i Q1, mkPX S1 (i-j) (Pc cO)) end end. Definition POneSubst (P1: Pol) (M1: Mon) (P2: Pol): option Pol := let (Q1,R1) := MFactor P1 M1 in match R1 with (Pc c) => if c ?=! cO then None else Some (Padd Q1 (Pmul P2 R1)) | _ => Some (Padd Q1 (Pmul P2 R1)) end. Fixpoint PNSubst1 (P1: Pol) (M1: Mon) (P2: Pol) (n: nat) : Pol := match POneSubst P1 M1 P2 with Some P3 => match n with S n1 => PNSubst1 P3 M1 P2 n1 | _ => P3 end | _ => P1 end. Definition PNSubst (P1: Pol) (M1: Mon) (P2: Pol) (n: nat): option Pol := match POneSubst P1 M1 P2 with Some P3 => match n with S n1 => Some (PNSubst1 P3 M1 P2 n1) | _ => None end | _ => None end. Fixpoint PSubstL1 (P1: Pol) (LM1: list (Mon * Pol)) (n: nat) : Pol := match LM1 with cons (M1,P2) LM2 => PSubstL1 (PNSubst1 P1 M1 P2 n) LM2 n | _ => P1 end. Fixpoint PSubstL (P1: Pol) (LM1: list (Mon * Pol)) (n: nat) : option Pol := match LM1 with cons (M1,P2) LM2 => match PNSubst P1 M1 P2 n with Some P3 => Some (PSubstL1 P3 LM2 n) | None => PSubstL P1 LM2 n end | _ => None end. Fixpoint PNSubstL (P1: Pol) (LM1: list (Mon * Pol)) (m n: nat) : Pol := match PSubstL P1 LM1 n with Some P3 => match m with S m1 => PNSubstL P3 LM1 m1 n | _ => P3 end | _ => P1 end. (** Evaluation of a polynomial towards R *) Fixpoint Pphi(l:Env R) (P:Pol) : R := match P with | Pc c => [c] | Pinj j Q => Pphi (jump j l) Q | PX P i Q => Pphi l P * (hd l) ^ i + Pphi (tail l) Q end. Reserved Notation "P @ l " (at level 10, no associativity). Notation "P @ l " := (Pphi l P). (** Evaluation of a monomial towards R *) Fixpoint Mphi(l:Env R) (M: Mon) : R := match M with | mon0 => rI | zmon j M1 => Mphi (jump j l) M1 | vmon i M1 => Mphi (tail l) M1 * (hd l) ^ i end. Notation "M @@ l" := (Mphi l M) (at level 10, no associativity). (** Proofs *) Ltac destr_pos_sub := match goal with |- context [Z.pos_sub ?x ?y] => generalize (Z.pos_sub_discr x y); destruct (Z.pos_sub x y) end. Lemma Peq_ok P P' : (P ?== P') = true -> forall l, P@l == P'@ l. Proof. revert P';induction P as [|p P IHP|P2 IHP1 p P3 IHP2]; intro P';destruct P' as [|p0 P'|P'1 p0 P'2];simpl; intros H l; try easy. - now apply (morph_eq CRmorph). - destruct (Pos.compare_spec p p0); [ subst | easy | easy ]. now rewrite IHP. - specialize (IHP1 P'1); specialize (IHP2 P'2). destruct (Pos.compare_spec p p0); [ subst | easy | easy ]. destruct (P2 ?== P'1); [|easy]. rewrite H in *. now rewrite IHP1, IHP2. Qed. Lemma Peq_spec P P' : BoolSpec (forall l, P@l == P'@l) True (P ?== P'). Proof. generalize (Peq_ok P P'). destruct (P ?== P'); auto. Qed. Lemma Pphi0 l : P0@l == 0. Proof. simpl;apply (morph0 CRmorph). Qed. Lemma Pphi1 l : P1@l == 1. Proof. simpl;apply (morph1 CRmorph). Qed. Lemma env_morph p e1 e2 : (forall x, e1 x = e2 x) -> p @ e1 = p @ e2. Proof. revert e1 e2. induction p as [|? ? IHp|? IHp1 ? ? IHp2]; simpl. - reflexivity. - intros e1 e2 EQ. apply IHp. intros. apply EQ. - intros e1 e2 EQ. f_equal; [f_equal|]. + now apply IHp1. + f_equal. apply EQ. + apply IHp2. intros; apply EQ. Qed. Lemma Pjump_add P i j l : P @ (jump (i + j) l) = P @ (jump j (jump i l)). Proof. apply env_morph. intros. rewrite <- jump_add. f_equal. apply Pos.add_comm. Qed. Lemma Pjump_xO_tail P p l : P @ (jump (xO p) (tail l)) = P @ (jump (xI p) l). Proof. apply env_morph. intros. now jump_simpl. Qed. Lemma Pjump_pred_double P p l : P @ (jump (Pos.pred_double p) (tail l)) = P @ (jump (xO p) l). Proof. apply env_morph. intros. rewrite jump_pred_double. now jump_simpl. Qed. Lemma mkPinj_ok j l P : (mkPinj j P)@l == P@(jump j l). Proof. destruct P;simpl;rsimpl. now rewrite Pjump_add. Qed. Lemma pow_pos_add x i j : x^(j + i) == x^i * x^j. Proof. rewrite Pos.add_comm. apply (pow_pos_add Rsth (Rmul_ext Reqe) (ARmul_assoc ARth)). Qed. Lemma ceqb_spec c c' : BoolSpec ([c] == [c']) True (c ?=! c'). Proof. generalize (morph_eq CRmorph c c'). destruct (c ?=! c'); auto. Qed. Lemma mkPX_ok l P i Q : (mkPX P i Q)@l == P@l * (hd l)^i + Q@(tail l). Proof. unfold mkPX. destruct P. - case ceqb_spec; intros H; simpl; try reflexivity. rewrite H, (morph0 CRmorph), mkPinj_ok; rsimpl. - reflexivity. - case Peq_spec; intros H; simpl; try reflexivity. rewrite H, Pphi0, Pos.add_comm, pow_pos_add; rsimpl. Qed. Hint Rewrite Pphi0 Pphi1 mkPinj_ok mkPX_ok (morph0 CRmorph) (morph1 CRmorph) (morph0 CRmorph) (morph_add CRmorph) (morph_mul CRmorph) (morph_sub CRmorph) (morph_opp CRmorph) : Esimpl. (* Quicker than autorewrite with Esimpl :-) *) Ltac Esimpl := try rewrite_db Esimpl; rsimpl; simpl. Lemma PaddC_ok c P l : (PaddC P c)@l == P@l + [c]. Proof. revert l;induction P as [| |? ? ? ? IHP2];simpl;intros;Esimpl;trivial. rewrite IHP2;rsimpl. Qed. Lemma PsubC_ok c P l : (PsubC P c)@l == P@l - [c]. Proof. revert l;induction P as [|? ? IHP|? ? ? ? IHP2];simpl;intros. - Esimpl. - rewrite IHP;rsimpl. - rewrite IHP2;rsimpl. Qed. Lemma PmulC_aux_ok c P l : (PmulC_aux P c)@l == P@l * [c]. Proof. revert l;induction P as [| |? IHP1 ? ? IHP2];simpl;intros;Esimpl;trivial. rewrite IHP1, IHP2;rsimpl. add_permut. mul_permut. Qed. Lemma PmulC_ok c P l : (PmulC P c)@l == P@l * [c]. Proof. unfold PmulC. case ceqb_spec; intros H. - rewrite H; Esimpl. - case ceqb_spec; intros H'. + rewrite H'; Esimpl. + apply PmulC_aux_ok. Qed. Lemma Popp_ok P l : (--P)@l == - P@l. Proof. revert l;induction P as [|? ? IHP|? IHP1 ? ? IHP2];simpl;intros. - Esimpl. - apply IHP. - rewrite IHP1, IHP2;rsimpl. Qed. Hint Rewrite PaddC_ok PsubC_ok PmulC_ok Popp_ok : Esimpl. Lemma PaddX_ok P' P k l : (forall P l, (P++P')@l == P@l + P'@l) -> (PaddX Padd P' k P) @ l == P@l + P'@l * (hd l)^k. Proof. intros IHP'. revert k l. induction P as [|p|? IHP1];simpl;intros. - add_permut. - destruct p; simpl; rewrite ?Pjump_xO_tail, ?Pjump_pred_double; add_permut. - destr_pos_sub; intros ->;Esimpl. + rewrite IHP';rsimpl. add_permut. + rewrite IHP', pow_pos_add;simpl;Esimpl. add_permut. + rewrite IHP1, pow_pos_add;rsimpl. add_permut. Qed. Lemma Padd_ok P' P l : (P ++ P')@l == P@l + P'@l. Proof. revert P l; induction P' as [|p P' IHP'|? IHP'1 ? ? IHP'2];simpl;intros P l;Esimpl. - revert p l; induction P as [|? P IHP|? IHP1 p ? IHP2];simpl;intros p0 l. + Esimpl; add_permut. + destr_pos_sub; intros ->;Esimpl. * now rewrite IHP'. * rewrite IHP';Esimpl. now rewrite Pjump_add. * rewrite IHP. now rewrite Pjump_add. + destruct p0;simpl. * rewrite IHP2;simpl. rsimpl. rewrite Pjump_xO_tail. Esimpl. * rewrite IHP2;simpl. rewrite Pjump_pred_double. rsimpl. * rewrite IHP'. rsimpl. - destruct P as [|p0|];simpl. + Esimpl. add_permut. + destruct p0;simpl;Esimpl; rewrite IHP'2; simpl. * rewrite Pjump_xO_tail. rsimpl. add_permut. * rewrite Pjump_pred_double. rsimpl. add_permut. * rsimpl. unfold tail. add_permut. + destr_pos_sub; intros ->; Esimpl. * rewrite IHP'1, IHP'2;rsimpl. add_permut. * rewrite IHP'1, IHP'2;simpl;Esimpl. rewrite pow_pos_add;rsimpl. add_permut. * rewrite PaddX_ok by trivial; rsimpl. rewrite IHP'2, pow_pos_add; rsimpl. add_permut. Qed. Lemma PsubX_ok P' P k l : (forall P l, (P--P')@l == P@l - P'@l) -> (PsubX Psub P' k P) @ l == P@l - P'@l * (hd l)^k. Proof. intros IHP'. revert k l. induction P as [|p|? IHP1];simpl;intros. - rewrite Popp_ok;rsimpl; add_permut. - destruct p; simpl; rewrite Popp_ok;rsimpl; rewrite ?Pjump_xO_tail, ?Pjump_pred_double; add_permut. - destr_pos_sub; intros ->; Esimpl. + rewrite IHP';rsimpl. add_permut. + rewrite IHP', pow_pos_add;simpl;Esimpl. add_permut. + rewrite IHP1, pow_pos_add;rsimpl. add_permut. Qed. Lemma Psub_ok P' P l : (P -- P')@l == P@l - P'@l. Proof. revert P l; induction P' as [|p P' IHP'|? IHP'1 ? ? IHP'2];simpl;intros P l;Esimpl. - revert p l; induction P as [|? ? IHP|? IHP1 ? ? IHP2];simpl;intros p0 l. + Esimpl; add_permut. + destr_pos_sub; intros ->;Esimpl. * rewrite IHP';rsimpl. * rewrite IHP';Esimpl. now rewrite Pjump_add. * rewrite IHP. now rewrite Pjump_add. + destruct p0;simpl. * rewrite IHP2;simpl. rsimpl. rewrite Pjump_xO_tail. Esimpl. * rewrite IHP2;simpl. rewrite Pjump_pred_double. rsimpl. * rewrite IHP'. rsimpl. - destruct P as [|p0|];simpl. + Esimpl; add_permut. + destruct p0;simpl;Esimpl; rewrite IHP'2; simpl. * rewrite Pjump_xO_tail. rsimpl. add_permut. * rewrite Pjump_pred_double. rsimpl. add_permut. * rsimpl. unfold tail. add_permut. + destr_pos_sub; intros ->; Esimpl. * rewrite IHP'1, IHP'2;rsimpl. add_permut. * rewrite IHP'1, IHP'2;simpl;Esimpl. rewrite pow_pos_add;rsimpl. add_permut. * rewrite PsubX_ok by trivial;rsimpl. rewrite IHP'2, pow_pos_add;rsimpl. add_permut. Qed. Lemma PmulI_ok P' : (forall P l, (Pmul P P') @ l == P @ l * P' @ l) -> forall P p l, (PmulI Pmul P' p P) @ l == P @ l * P' @ (jump p l). Proof. intros IHP' P. induction P as [|? ? IHP|? IHP1 ? ? IHP2];simpl;intros p0 l. - Esimpl; mul_permut. - destr_pos_sub; intros ->;Esimpl. + now rewrite IHP'. + now rewrite IHP', Pjump_add. + now rewrite IHP, Pjump_add. - destruct p0;Esimpl; rewrite ?IHP1, ?IHP2; rsimpl. + rewrite Pjump_xO_tail. f_equiv. mul_permut. + rewrite Pjump_pred_double. f_equiv. mul_permut. + rewrite IHP'. f_equiv. mul_permut. Qed. Lemma Pmul_ok P P' l : (P**P')@l == P@l * P'@l. Proof. revert P l;induction P' as [| |? IHP'1 ? ? IHP'2];simpl;intros P l. - apply PmulC_ok. - apply PmulI_ok;trivial. - destruct P as [|p0|]. + rewrite (ARmul_comm ARth). Esimpl. + Esimpl. rewrite IHP'1;Esimpl. f_equiv. destruct p0;rewrite IHP'2;Esimpl. * now rewrite Pjump_xO_tail. * rewrite Pjump_pred_double; Esimpl. + rewrite Padd_ok, !mkPX_ok, Padd_ok, !mkPX_ok, !IHP'1, !IHP'2, PmulI_ok; trivial. simpl. Esimpl. unfold tail. add_permut; f_equiv; mul_permut. Qed. Lemma Psquare_ok P l : (Psquare P)@l == P@l * P@l. Proof. revert l;induction P as [|? ? IHP|P2 IHP1 p ? IHP2];simpl;intros l;Esimpl. - apply IHP. - rewrite Padd_ok, Pmul_ok;Esimpl. rewrite IHP1, IHP2. mul_push ((hd l)^p). now mul_push (P2@l). Qed. Lemma Mphi_morph M e1 e2 : (forall x, e1 x = e2 x) -> M @@ e1 = M @@ e2. Proof. revert e1 e2; induction M as [|? ? IHM|? ? IHM]; simpl; intros e1 e2 EQ; trivial. - apply IHM. intros; apply EQ. - f_equal. * apply IHM. intros; apply EQ. * f_equal. apply EQ. Qed. Lemma Mjump_xO_tail M p l : M @@ (jump (xO p) (tail l)) = M @@ (jump (xI p) l). Proof. apply Mphi_morph. intros. now jump_simpl. Qed. Lemma Mjump_pred_double M p l : M @@ (jump (Pos.pred_double p) (tail l)) = M @@ (jump (xO p) l). Proof. apply Mphi_morph. intros. rewrite jump_pred_double. now jump_simpl. Qed. Lemma Mjump_add M i j l : M @@ (jump (i + j) l) = M @@ (jump j (jump i l)). Proof. apply Mphi_morph. intros. now rewrite <- jump_add, Pos.add_comm. Qed. Lemma mkZmon_ok M j l : (mkZmon j M) @@ l == (zmon j M) @@ l. Proof. destruct M; simpl; rsimpl. Qed. Lemma zmon_pred_ok M j l : (zmon_pred j M) @@ (tail l) == (zmon j M) @@ l. Proof. destruct j; simpl; rewrite ?mkZmon_ok; simpl; rsimpl. - now rewrite Mjump_xO_tail. - rewrite Mjump_pred_double; rsimpl. Qed. Lemma mkVmon_ok M i l : (mkVmon i M)@@l == M@@l * (hd l)^i. Proof. destruct M;simpl;intros;rsimpl. - rewrite zmon_pred_ok;simpl;rsimpl. - rewrite pow_pos_add;rsimpl. Qed. Ltac destr_mfactor R S := match goal with | H : context [MFactor ?P _] |- context [MFactor ?P ?M] => specialize (H M); destruct MFactor as (R,S) end. Lemma Mphi_ok P M l : let (Q,R) := MFactor P M in P@l == Q@l + M@@l * R@l. Proof. revert M l; induction P as [|? ? IHP|? IHP1 ? ? IHP2]; intros M; destruct M; intros l; simpl; auto; Esimpl. - case Pos.compare_spec; intros He; simpl. * destr_mfactor R1 S1. now rewrite IHP, He, !mkPinj_ok. * destr_mfactor R1 S1. rewrite IHP; simpl. now rewrite !mkPinj_ok, <- Mjump_add, Pos.add_comm, Pos.sub_add. * Esimpl. - destr_mfactor R1 S1. destr_mfactor R2 S2. rewrite IHP1, IHP2, !mkPX_ok, zmon_pred_ok; simpl; rsimpl. add_permut. - case Pos.compare_spec; intros He; simpl; destr_mfactor R1 S1; rewrite ?He, IHP1, mkPX_ok, ?mkZmon_ok; simpl; rsimpl; unfold tail; add_permut; mul_permut. * rewrite <- pow_pos_add, Pos.add_comm, Pos.sub_add by trivial; rsimpl. * rewrite mkPX_ok. simpl. Esimpl. mul_permut. rewrite <- pow_pos_add, Pos.sub_add by trivial; rsimpl. Qed. Lemma POneSubst_ok P1 M1 P2 P3 l : POneSubst P1 M1 P2 = Some P3 -> M1@@l == P2@l -> P1@l == P3@l. Proof. unfold POneSubst. assert (H := Mphi_ok P1). destr_mfactor R1 S1. rewrite H; clear H. intros EQ EQ'. replace P3 with (R1 ++ P2 ** S1). - rewrite EQ', Padd_ok, Pmul_ok; rsimpl. - revert EQ. destruct S1; try now injection 1. case ceqb_spec; now inversion 2. Qed. Lemma PNSubst1_ok n P1 M1 P2 l : M1@@l == P2@l -> P1@l == (PNSubst1 P1 M1 P2 n)@l. Proof. revert P1. induction n as [|n IHn]; simpl; intros P1; generalize (POneSubst_ok P1 M1 P2); destruct POneSubst; intros; rewrite <- ?IHn; auto; reflexivity. Qed. Lemma PNSubst_ok n P1 M1 P2 l P3 : PNSubst P1 M1 P2 n = Some P3 -> M1@@l == P2@l -> P1@l == P3@l. Proof. unfold PNSubst. assert (H := POneSubst_ok P1 M1 P2); destruct POneSubst; try discriminate. destruct n; inversion_clear 1. intros. rewrite <- PNSubst1_ok; auto. Qed. Fixpoint MPcond (LM1: list (Mon * Pol)) (l: Env R) : Prop := match LM1 with | cons (M1,P2) LM2 => (M1@@l == P2@l) /\ MPcond LM2 l | _ => True end. Lemma PSubstL1_ok n LM1 P1 l : MPcond LM1 l -> P1@l == (PSubstL1 P1 LM1 n)@l. Proof. revert P1; induction LM1 as [|(M2,P2) LM2 IH]; simpl; intros. - reflexivity. - rewrite <- IH by intuition. now apply PNSubst1_ok. Qed. Lemma PSubstL_ok n LM1 P1 P2 l : PSubstL P1 LM1 n = Some P2 -> MPcond LM1 l -> P1@l == P2@l. Proof. revert P1. induction LM1 as [|(M2,P2') LM2 IH]; simpl; intros P3 H **. - discriminate. - assert (H':=PNSubst_ok n P3 M2 P2'). destruct PNSubst. * injection H as [= <-]. rewrite <- PSubstL1_ok; intuition. * now apply IH. Qed. Lemma PNSubstL_ok m n LM1 P1 l : MPcond LM1 l -> P1@l == (PNSubstL P1 LM1 m n)@l. Proof. revert LM1 P1. induction m as [|m IHm]; simpl; intros LM1 P2 **; assert (H' := PSubstL_ok n LM1 P2); destruct PSubstL; auto; try reflexivity. rewrite <- IHm; auto. Qed. (** evaluation of polynomial expressions towards R *) Definition mk_X j := mkPinj_pred j mkX. (** evaluation of polynomial expressions towards R *) Fixpoint PEeval (l:Env R) (pe:PExpr) : R := match pe with | PEc c => phi c | PEX j => nth j l | PEadd pe1 pe2 => (PEeval l pe1) + (PEeval l pe2) | PEsub pe1 pe2 => (PEeval l pe1) - (PEeval l pe2) | PEmul pe1 pe2 => (PEeval l pe1) * (PEeval l pe2) | PEopp pe1 => - (PEeval l pe1) | PEpow pe1 n => rpow (PEeval l pe1) (Cp_phi n) end. (** Correctness proofs *) Lemma mkX_ok p l : nth p l == (mk_X p) @ l. Proof. destruct p;simpl;intros;Esimpl;trivial. rewrite nth_spec ; auto. unfold hd. now rewrite <- nth_pred_double, nth_jump. Qed. Hint Rewrite Padd_ok Psub_ok : Esimpl. Section POWER. Variable subst_l : Pol -> Pol. Fixpoint Ppow_pos (res P:Pol) (p:positive) : Pol := match p with | xH => subst_l (res ** P) | xO p => Ppow_pos (Ppow_pos res P p) P p | xI p => subst_l ((Ppow_pos (Ppow_pos res P p) P p) ** P) end. Definition Ppow_N P n := match n with | N0 => P1 | Npos p => Ppow_pos P1 P p end. Lemma Ppow_pos_ok l : (forall P, subst_l P@l == P@l) -> forall res P p, (Ppow_pos res P p)@l == res@l * (pow_pos Pmul P p)@l. Proof. intros subst_l_ok res P p. revert res. induction p as [p IHp|p IHp|];simpl;intros; rewrite ?subst_l_ok, ?Pmul_ok, ?IHp; mul_permut. Qed. Lemma Ppow_N_ok l : (forall P, subst_l P@l == P@l) -> forall P n, (Ppow_N P n)@l == (pow_N P1 Pmul P n)@l. Proof. intros ? P n;destruct n;simpl. - reflexivity. - rewrite Ppow_pos_ok by trivial. Esimpl. Qed. End POWER. (** Normalization and rewriting *) Section NORM_SUBST_REC. Variable n : nat. Variable lmp:list (Mon*Pol). Let subst_l P := PNSubstL P lmp n n. Let Pmul_subst P1 P2 := subst_l (Pmul P1 P2). Let Ppow_subst := Ppow_N subst_l. Fixpoint norm_aux (pe:PExpr) : Pol := match pe with | PEc c => Pc c | PEX j => mk_X j | PEadd (PEopp pe1) pe2 => Psub (norm_aux pe2) (norm_aux pe1) | PEadd pe1 (PEopp pe2) => Psub (norm_aux pe1) (norm_aux pe2) | PEadd pe1 pe2 => Padd (norm_aux pe1) (norm_aux pe2) | PEsub pe1 pe2 => Psub (norm_aux pe1) (norm_aux pe2) | PEmul pe1 pe2 => Pmul (norm_aux pe1) (norm_aux pe2) | PEopp pe1 => Popp (norm_aux pe1) | PEpow pe1 n => Ppow_N (fun p => p) (norm_aux pe1) n end. Definition norm_subst pe := subst_l (norm_aux pe). (** Internally, [norm_aux] is expanded in a large number of cases. To speed-up proofs, we use an alternative definition. *) Definition get_PEopp pe := match pe with | PEopp pe' => Some pe' | _ => None end. Lemma norm_aux_PEadd pe1 pe2 : norm_aux (PEadd pe1 pe2) = match get_PEopp pe1, get_PEopp pe2 with | Some pe1', _ => (norm_aux pe2) -- (norm_aux pe1') | None, Some pe2' => (norm_aux pe1) -- (norm_aux pe2') | None, None => (norm_aux pe1) ++ (norm_aux pe2) end. Proof. simpl (norm_aux (PEadd _ _)). destruct pe1; [ | | | | | reflexivity | ]; destruct pe2; simpl get_PEopp; reflexivity. Qed. Lemma norm_aux_PEopp pe : match get_PEopp pe with | Some pe' => norm_aux pe = -- (norm_aux pe') | None => True end. Proof. now destruct pe. Qed. Lemma norm_aux_spec l pe : PEeval l pe == (norm_aux pe)@l. Proof. intros. induction pe as [| |pe1 IHpe1 pe2 IHpe2|? IHpe1 ? IHpe2|? IHpe1 ? IHpe2|? IHpe|? IHpe n0]. - reflexivity. - apply mkX_ok. - simpl PEeval. rewrite IHpe1, IHpe2. assert (H1 := norm_aux_PEopp pe1). assert (H2 := norm_aux_PEopp pe2). rewrite norm_aux_PEadd. do 2 destruct get_PEopp; rewrite ?H1, ?H2; Esimpl; add_permut. - simpl. rewrite IHpe1, IHpe2. Esimpl. - simpl. rewrite IHpe1, IHpe2. now rewrite Pmul_ok. - simpl. rewrite IHpe. Esimpl. - simpl. rewrite Ppow_N_ok by reflexivity. rewrite (rpow_pow_N pow_th). destruct n0 as [|p]; simpl; Esimpl. induction p as [p IHp|p IHp|];simpl; now rewrite ?IHp, ?IHpe, ?Pms_ok, ?Pmul_ok. Qed. End NORM_SUBST_REC. End MakeRingPol. coq-8.20.0/theories/micromega/Fourier.v000066400000000000000000000002011466560755400177650ustar00rootroot00000000000000Require Import Lra. Require Export Fourier_util. #[deprecated(since = "8.9.0", note = "Use lra instead.")] Ltac fourier := lra. coq-8.20.0/theories/micromega/Fourier_util.v000066400000000000000000000013561466560755400210360ustar00rootroot00000000000000Require Export Rbase. Require Import Lra. Local Open Scope R_scope. Lemma Rlt_mult_inv_pos : forall x y:R, 0 < x -> 0 < y -> 0 < x * / y. Proof. intros x y H H0; try assumption. replace 0 with (x * 0). - apply Rmult_lt_compat_l; auto with real. - ring. Qed. Lemma Rlt_zero_pos_plus1 : forall x:R, 0 < x -> 0 < 1 + x. Proof. intros x H; try assumption. rewrite Rplus_comm. apply Rplus_lt_0_compat; [assumption | exact Rlt_0_1]. Qed. Lemma Rle_zero_pos_plus1 : forall x:R, 0 <= x -> 0 <= 1 + x. Proof. intros; lra. Qed. Lemma Rle_mult_inv_pos : forall x y:R, 0 <= x -> 0 < y -> 0 <= x * / y. Proof. intros x y H H0; try assumption. case H; intros. - red; left. apply Rlt_mult_inv_pos; auto with real. - rewrite <- H1. red; right; ring. Qed. coq-8.20.0/theories/micromega/Lia.v000066400000000000000000000034121466560755400170660ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* ((xsos_Q rchecker) || (xpsatz_Q d rchecker)) | _ => fail "Unsupported domain" end in tac. Tactic Notation "psatz" constr(dom) int_or_var(n) := xpsatz dom n. Tactic Notation "psatz" constr(dom) := xpsatz dom ltac:(-1). (* Local Variables: *) (* coding: utf-8 *) (* End: *) coq-8.20.0/theories/micromega/Lra.v000066400000000000000000000046161466560755400171060ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* (xsos_R rchecker) || (xpsatz_R d rchecker) | _ => fail "Unsupported domain" end in tac. Tactic Notation "psatz" constr(dom) int_or_var(n) := xpsatz dom n. Tactic Notation "psatz" constr(dom) := xpsatz dom ltac:(-1). (* Local Variables: *) (* coding: utf-8 *) (* End: *) coq-8.20.0/theories/micromega/MExtraction.v000066400000000000000000000054511466560755400206230ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* "( * )" [ "(,)" ]. Extract Inductive list => list [ "[]" "(::)" ]. Extract Inductive bool => bool [ true false ]. Extract Inductive sumbool => bool [ true false ]. Extract Inductive option => option [ Some None ]. Extract Inductive sumor => option [ Some None ]. (** Then, in a ternary alternative { }+{ }+{ }, - leftmost choice (Inleft Left) is (Some true), - middle choice (Inleft Right) is (Some false), - rightmost choice (Inright) is (None) *) (** To preserve its laziness, andb is normally expanded. Let's rather use the ocaml && *) Extract Inlined Constant andb => "(&&)". Import Reals.Rdefinitions. Extract Constant R => "int". Extract Constant R0 => "0". Extract Constant R1 => "1". Extract Constant Rplus => "( + )". Extract Constant Rmult => "( * )". Extract Constant Ropp => "fun x -> - x". Extract Constant Rinv => "fun x -> 1 / x". (** In order to avoid annoying build dependencies the actual extraction is only performed as a test in the test suite. *) (* Extraction "micromega.ml" Tauto.mapX Tauto.foldA Tauto.collect_annot Tauto.ids_of_formula Tauto.map_bformula Tauto.abst_form ZMicromega.cnfZ ZMicromega.Zeval_const QMicromega.cnfQ List.map simpl_cone (*map_cone indexes*) denorm QArith_base.Qpower vm_add normZ normQ normQ n_of_Z N.of_nat ZTautoChecker ZWeakChecker QTautoChecker RTautoChecker find. *) (* Local Variables: *) (* coding: utf-8 *) (* End: *) coq-8.20.0/theories/micromega/OrderedRing.v000066400000000000000000000341161466560755400205720ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* R -> R) (ropp : R -> R). Variable req rle rlt : R -> R -> Prop. Notation "0" := rO. Notation "1" := rI. Notation "x + y" := (rplus x y). Notation "x * y " := (rtimes x y). Notation "x - y " := (rminus x y). Notation "- x" := (ropp x). Notation "x == y" := (req x y). Notation "x ~= y" := (~ req x y). Notation "x <= y" := (rle x y). Notation "x < y" := (rlt x y). Record SOR : Prop := mk_SOR_theory { SORsetoid : Setoid_Theory R req; SORplus_wd : forall x1 x2, x1 == x2 -> forall y1 y2, y1 == y2 -> x1 + y1 == x2 + y2; SORtimes_wd : forall x1 x2, x1 == x2 -> forall y1 y2, y1 == y2 -> x1 * y1 == x2 * y2; SORopp_wd : forall x1 x2, x1 == x2 -> -x1 == -x2; SORle_wd : forall x1 x2, x1 == x2 -> forall y1 y2, y1 == y2 -> (x1 <= y1 <-> x2 <= y2); SORlt_wd : forall x1 x2, x1 == x2 -> forall y1 y2, y1 == y2 -> (x1 < y1 <-> x2 < y2); SORrt : ring_theory rO rI rplus rtimes rminus ropp req; SORle_refl : forall n : R, n <= n; SORle_antisymm : forall n m : R, n <= m -> m <= n -> n == m; SORle_trans : forall n m p : R, n <= m -> m <= p -> n <= p; SORlt_le_neq : forall n m : R, n < m <-> n <= m /\ n ~= m; SORlt_trichotomy : forall n m : R, n < m \/ n == m \/ m < n; SORplus_le_mono_l : forall n m p : R, n <= m -> p + n <= p + m; SORtimes_pos_pos : forall n m : R, 0 < n -> 0 < m -> 0 < n * m; SORneq_0_1 : 0 ~= 1 }. (* We cannot use Relation_Definitions.order.ord_antisym and Relations_1.Antisymmetric because they refer to Leibniz equality *) End DEFINITIONS. Section STRICT_ORDERED_RING. Variable R : Type. Variable (rO rI : R) (rplus rtimes rminus: R -> R -> R) (ropp : R -> R). Variable req rle rlt : R -> R -> Prop. Variable sor : SOR rO rI rplus rtimes rminus ropp req rle rlt. Notation "0" := rO. Notation "1" := rI. Notation "x + y" := (rplus x y). Notation "x * y " := (rtimes x y). Notation "x - y " := (rminus x y). Notation "- x" := (ropp x). Notation "x == y" := (req x y). Notation "x ~= y" := (~ req x y). Notation "x <= y" := (rle x y). Notation "x < y" := (rlt x y). Add Relation R req reflexivity proved by (@Equivalence_Reflexive _ _ (SORsetoid sor)) symmetry proved by (@Equivalence_Symmetric _ _ (SORsetoid sor)) transitivity proved by (@Equivalence_Transitive _ _ (SORsetoid sor)) as sor_setoid. Add Morphism rplus with signature req ==> req ==> req as rplus_morph. Proof. exact (SORplus_wd sor). Qed. Add Morphism rtimes with signature req ==> req ==> req as rtimes_morph. Proof. exact (SORtimes_wd sor). Qed. Add Morphism ropp with signature req ==> req as ropp_morph. Proof. exact (SORopp_wd sor). Qed. Add Morphism rle with signature req ==> req ==> iff as rle_morph. Proof. exact (SORle_wd sor). Qed. Add Morphism rlt with signature req ==> req ==> iff as rlt_morph. Proof. exact (SORlt_wd sor). Qed. Add Ring SOR : (SORrt sor). Add Morphism rminus with signature req ==> req ==> req as rminus_morph. Proof. intros x1 x2 H1 y1 y2 H2. rewrite ((Rsub_def (SORrt sor)) x1 y1). rewrite ((Rsub_def (SORrt sor)) x2 y2). rewrite H1; now rewrite H2. Qed. Theorem Rneq_symm : forall n m : R, n ~= m -> m ~= n. Proof. intros n m H1 H2; rewrite H2 in H1; now apply H1. Qed. (* Properties of plus, minus and opp *) Theorem Rplus_0_l : forall n : R, 0 + n == n. Proof. intro; ring. Qed. Theorem Rplus_0_r : forall n : R, n + 0 == n. Proof. intro; ring. Qed. Theorem Rtimes_0_r : forall n : R, n * 0 == 0. Proof. intro; ring. Qed. Theorem Rplus_comm : forall n m : R, n + m == m + n. Proof. intros; ring. Qed. Theorem Rtimes_0_l : forall n : R, 0 * n == 0. Proof. intro; ring. Qed. Theorem Rtimes_comm : forall n m : R, n * m == m * n. Proof. intros; ring. Qed. Theorem Rminus_eq_0 : forall n m : R, n - m == 0 <-> n == m. Proof. intros n m. split; intro H. - setoid_replace n with ((n - m) + m) by ring. rewrite H. now rewrite Rplus_0_l. - rewrite H; ring. Qed. Theorem Rplus_cancel_l : forall n m p : R, p + n == p + m <-> n == m. Proof. intros n m p; split; intro H. - setoid_replace n with (- p + (p + n)) by ring. setoid_replace m with (- p + (p + m)) by ring. now rewrite H. - now rewrite H. Qed. (* Relations *) Theorem Rle_refl : forall n : R, n <= n. Proof (SORle_refl sor). Theorem Rle_antisymm : forall n m : R, n <= m -> m <= n -> n == m. Proof (SORle_antisymm sor). Theorem Rle_trans : forall n m p : R, n <= m -> m <= p -> n <= p. Proof (SORle_trans sor). Theorem Rlt_trichotomy : forall n m : R, n < m \/ n == m \/ m < n. Proof (SORlt_trichotomy sor). Theorem Rlt_le_neq : forall n m : R, n < m <-> n <= m /\ n ~= m. Proof (SORlt_le_neq sor). Theorem Rneq_0_1 : 0 ~= 1. Proof (SORneq_0_1 sor). Theorem Req_em : forall n m : R, n == m \/ n ~= m. Proof. intros n m. destruct (Rlt_trichotomy n m) as [H | [H | H]]; try rewrite Rlt_le_neq in H. - right; now destruct H. - now left. - right; apply Rneq_symm; now destruct H. Qed. Theorem Req_dne : forall n m : R, ~ ~ n == m <-> n == m. Proof. intros n m; destruct (Req_em n m) as [H | H]. - split; auto. - split. + intro H1; false_hyp H H1. + auto. Qed. Theorem Rle_lt_eq : forall n m : R, n <= m <-> n < m \/ n == m. Proof. intros n m; rewrite Rlt_le_neq. split; [intro H | intros [[H1 H2] | H]]. - destruct (Req_em n m) as [H1 | H1]. + now right. + left; now split. - assumption. - rewrite H; apply Rle_refl. Qed. Ltac le_less := rewrite Rle_lt_eq; left; try assumption. Ltac le_equal := rewrite Rle_lt_eq; right; try reflexivity; try assumption. Ltac le_elim H := rewrite Rle_lt_eq in H; destruct H as [H | H]. Theorem Rlt_trans : forall n m p : R, n < m -> m < p -> n < p. Proof. intros n m p; repeat rewrite Rlt_le_neq; intros [H1 H2] [H3 H4]; split. - now apply Rle_trans with m. - intro H. rewrite H in H1. pose proof (Rle_antisymm H3 H1). now apply H4. Qed. Theorem Rle_lt_trans : forall n m p : R, n <= m -> m < p -> n < p. Proof. intros n m p H1 H2; le_elim H1. - now apply (Rlt_trans (m := m)). - now rewrite H1. Qed. Theorem Rlt_le_trans : forall n m p : R, n < m -> m <= p -> n < p. Proof. intros n m p H1 H2; le_elim H2. - now apply (Rlt_trans (m := m)). - now rewrite <- H2. Qed. Theorem Rle_gt_cases : forall n m : R, n <= m \/ m < n. Proof. intros n m; destruct (Rlt_trichotomy n m) as [H | [H | H]]. - left; now le_less. - left; now le_equal. - now right. Qed. Theorem Rlt_neq : forall n m : R, n < m -> n ~= m. Proof. intros n m; rewrite Rlt_le_neq; now intros [_ H]. Qed. Theorem Rle_ngt : forall n m : R, n <= m <-> ~ m < n. Proof. intros n m; split. - intros H H1; assert (H2 : n < n) by now apply Rle_lt_trans with m. now apply (Rlt_neq H2). - intro H. destruct (Rle_gt_cases n m) as [H1 | H1]. + assumption. + false_hyp H1 H. Qed. Theorem Rlt_nge : forall n m : R, n < m <-> ~ m <= n. Proof. intros n m; split. - intros H H1; assert (H2 : n < n) by now apply Rlt_le_trans with m. now apply (Rlt_neq H2). - intro H. destruct (Rle_gt_cases m n) as [H1 | H1]. + false_hyp H1 H. + assumption. Qed. (* Plus, minus and order *) Theorem Rplus_le_mono_l : forall n m p : R, n <= m <-> p + n <= p + m. Proof. intros n m p; split. - apply (SORplus_le_mono_l sor). - intro H. apply ((SORplus_le_mono_l sor) (p + n) (p + m) (- p)) in H. setoid_replace (- p + (p + n)) with n in H by ring. setoid_replace (- p + (p + m)) with m in H by ring. assumption. Qed. Theorem Rplus_le_mono_r : forall n m p : R, n <= m <-> n + p <= m + p. Proof. intros n m p; rewrite (Rplus_comm n p); rewrite (Rplus_comm m p). apply Rplus_le_mono_l. Qed. Theorem Rplus_lt_mono_l : forall n m p : R, n < m <-> p + n < p + m. Proof. intros n m p; do 2 rewrite Rlt_le_neq. rewrite Rplus_cancel_l. now rewrite <- Rplus_le_mono_l. Qed. Theorem Rplus_lt_mono_r : forall n m p : R, n < m <-> n + p < m + p. Proof. intros n m p. rewrite (Rplus_comm n p); rewrite (Rplus_comm m p); apply Rplus_lt_mono_l. Qed. Theorem Rplus_lt_mono : forall n m p q : R, n < m -> p < q -> n + p < m + q. Proof. intros n m p q H1 H2. apply Rlt_trans with (m + p); [now apply -> Rplus_lt_mono_r | now apply -> Rplus_lt_mono_l]. Qed. Theorem Rplus_le_mono : forall n m p q : R, n <= m -> p <= q -> n + p <= m + q. Proof. intros n m p q H1 H2. apply Rle_trans with (m + p); [now apply -> Rplus_le_mono_r | now apply -> Rplus_le_mono_l]. Qed. Theorem Rplus_lt_le_mono : forall n m p q : R, n < m -> p <= q -> n + p < m + q. Proof. intros n m p q H1 H2. apply Rlt_le_trans with (m + p); [now apply -> Rplus_lt_mono_r | now apply -> Rplus_le_mono_l]. Qed. Theorem Rplus_le_lt_mono : forall n m p q : R, n <= m -> p < q -> n + p < m + q. Proof. intros n m p q H1 H2. apply Rle_lt_trans with (m + p); [now apply -> Rplus_le_mono_r | now apply -> Rplus_lt_mono_l]. Qed. Theorem Rplus_pos_pos : forall n m : R, 0 < n -> 0 < m -> 0 < n + m. Proof. intros n m H1 H2. rewrite <- (Rplus_0_l 0). now apply Rplus_lt_mono. Qed. Theorem Rplus_pos_nonneg : forall n m : R, 0 < n -> 0 <= m -> 0 < n + m. Proof. intros n m H1 H2. rewrite <- (Rplus_0_l 0). now apply Rplus_lt_le_mono. Qed. Theorem Rplus_nonneg_pos : forall n m : R, 0 <= n -> 0 < m -> 0 < n + m. Proof. intros n m H1 H2. rewrite <- (Rplus_0_l 0). now apply Rplus_le_lt_mono. Qed. Theorem Rplus_nonneg_nonneg : forall n m : R, 0 <= n -> 0 <= m -> 0 <= n + m. Proof. intros n m H1 H2. rewrite <- (Rplus_0_l 0). now apply Rplus_le_mono. Qed. Theorem Rle_le_minus : forall n m : R, n <= m <-> 0 <= m - n. Proof. intros n m. rewrite (@Rplus_le_mono_r n m (- n)). setoid_replace (n + - n) with 0 by ring. now setoid_replace (m + - n) with (m - n) by ring. Qed. Theorem Rlt_lt_minus : forall n m : R, n < m <-> 0 < m - n. Proof. intros n m. rewrite (@Rplus_lt_mono_r n m (- n)). setoid_replace (n + - n) with 0 by ring. now setoid_replace (m + - n) with (m - n) by ring. Qed. Theorem Ropp_lt_mono : forall n m : R, n < m <-> - m < - n. Proof. intros n m. split; intro H. - apply -> (@Rplus_lt_mono_l n m (- n - m)) in H. setoid_replace (- n - m + n) with (- m) in H by ring. now setoid_replace (- n - m + m) with (- n) in H by ring. - apply -> (@Rplus_lt_mono_l (- m) (- n) (n + m)) in H. setoid_replace (n + m + - m) with n in H by ring. now setoid_replace (n + m + - n) with m in H by ring. Qed. Theorem Ropp_pos_neg : forall n : R, 0 < - n <-> n < 0. Proof. intro n; rewrite (Ropp_lt_mono n 0). now setoid_replace (- 0) with 0 by ring. Qed. (* Times and order *) Theorem Rtimes_pos_pos : forall n m : R, 0 < n -> 0 < m -> 0 < n * m. Proof (SORtimes_pos_pos sor). Theorem Rtimes_nonneg_nonneg : forall n m : R, 0 <= n -> 0 <= m -> 0 <= n * m. Proof. intros n m H1 H2. le_elim H1. - le_elim H2. + le_less; now apply Rtimes_pos_pos. + rewrite <- H2; rewrite Rtimes_0_r; le_equal. - rewrite <- H1; rewrite Rtimes_0_l; le_equal. Qed. Theorem Rtimes_pos_neg : forall n m : R, 0 < n -> m < 0 -> n * m < 0. Proof. intros n m H1 H2. apply -> Ropp_pos_neg. setoid_replace (- (n * m)) with (n * (- m)) by ring. apply Rtimes_pos_pos. - assumption. - now apply <- Ropp_pos_neg. Qed. Theorem Rtimes_neg_neg : forall n m : R, n < 0 -> m < 0 -> 0 < n * m. Proof. intros n m H1 H2. setoid_replace (n * m) with ((- n) * (- m)) by ring. apply Rtimes_pos_pos; now apply <- Ropp_pos_neg. Qed. Theorem Rtimes_square_nonneg : forall n : R, 0 <= n * n. Proof. intro n; destruct (Rlt_trichotomy 0 n) as [H | [H | H]]. - le_less; now apply Rtimes_pos_pos. - rewrite <- H, Rtimes_0_l; le_equal. - le_less; now apply Rtimes_neg_neg. Qed. Theorem Rtimes_neq_0 : forall n m : R, n ~= 0 /\ m ~= 0 -> n * m ~= 0. Proof. intros n m [H1 H2]. destruct (Rlt_trichotomy n 0) as [H3 | [H3 | H3]]; destruct (Rlt_trichotomy m 0) as [H4 | [H4 | H4]]; try (false_hyp H3 H1); try (false_hyp H4 H2). - apply Rneq_symm. apply Rlt_neq. now apply Rtimes_neg_neg. - apply Rlt_neq. rewrite Rtimes_comm. now apply Rtimes_pos_neg. - apply Rlt_neq. now apply Rtimes_pos_neg. - apply Rneq_symm. apply Rlt_neq. now apply Rtimes_pos_pos. Qed. (* The following theorems are used to build a morphism from Z to R and prove its properties in ZCoeff.v. They are not used in RingMicromega.v. *) (* Surprisingly, multiplication is needed to prove the following theorem *) Theorem Ropp_neg_pos : forall n : R, - n < 0 <-> 0 < n. Proof. intro n; setoid_replace n with (- - n) by ring. rewrite Ropp_pos_neg. now setoid_replace (- - n) with n by ring. Qed. Theorem Rlt_0_1 : 0 < 1. Proof. apply <- Rlt_le_neq. split. - setoid_replace 1 with (1 * 1) by ring. apply Rtimes_square_nonneg. - apply Rneq_0_1. Qed. Theorem Rlt_succ_r : forall n : R, n < 1 + n. Proof. intro n. rewrite <- (Rplus_0_l n); setoid_replace (1 + (0 + n)) with (1 + n) by ring. apply -> Rplus_lt_mono_r. apply Rlt_0_1. Qed. Theorem Rlt_lt_succ : forall n m : R, n < m -> n < 1 + m. Proof. intros n m H; apply Rlt_trans with m. - assumption. - apply Rlt_succ_r. Qed. (*Theorem Rtimes_lt_mono_pos_l : forall n m p : R, 0 < p -> n < m -> p * n < p * m. Proof. intros n m p H1 H2. apply <- Rlt_lt_minus. setoid_replace (p * m - p * n) with (p * (m - n)) by ring. apply Rtimes_pos_pos. assumption. now apply -> Rlt_lt_minus. Qed.*) End STRICT_ORDERED_RING. coq-8.20.0/theories/micromega/Psatz.v000066400000000000000000000043731466560755400174710ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* (xsos_Z Lia.zchecker) || (xpsatz_Z d Lia.zchecker) | R => (xsos_R Lra.rchecker) || (xpsatz_R d Lra.rchecker) | Q => (xsos_Q Lqa.rchecker) || (xpsatz_Q d Lqa.rchecker) | _ => fail "Unsupported domain" end in tac. Tactic Notation "psatz" constr(dom) int_or_var(n) := xpsatz dom n. Tactic Notation "psatz" constr(dom) := xpsatz dom ltac:(-1). Ltac psatzl dom := let tac := lazymatch dom with | Z => Lia.lia | Q => Lqa.lra | R => Lra.lra | _ => fail "Unsupported domain" end in tac. Ltac lra := first [ psatzl R | psatzl Q ]. Ltac nra := first [ Lra.nra | Lqa.nra ]. (* Local Variables: *) (* coding: utf-8 *) (* End: *) coq-8.20.0/theories/micromega/QMicromega.v000066400000000000000000000207341466560755400204130ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* x) (fun x => x) (pow_N 1 Qmult). Proof. constructor. - constructor ; intros ; try reflexivity. apply Qeq_bool_eq; auto. - constructor. reflexivity. - intros x y. apply Qeq_bool_neq ; auto. - apply Qle_bool_imp_le. Qed. (*Definition Zeval_expr := eval_pexpr 0 Z.add Z.mul Z.sub Z.opp (fun x => x) (fun x => Z.of_N x) (Z.pow).*) Require Import EnvRing. Fixpoint Qeval_expr (env: PolEnv Q) (e: PExpr Q) : Q := match e with | PEc c => c | PEX j => env j | PEadd pe1 pe2 => (Qeval_expr env pe1) + (Qeval_expr env pe2) | PEsub pe1 pe2 => (Qeval_expr env pe1) - (Qeval_expr env pe2) | PEmul pe1 pe2 => (Qeval_expr env pe1) * (Qeval_expr env pe2) | PEopp pe1 => - (Qeval_expr env pe1) | PEpow pe1 n => Qpower (Qeval_expr env pe1) (Z.of_N n) end. Lemma Qeval_expr_simpl : forall env e, Qeval_expr env e = match e with | PEc c => c | PEX j => env j | PEadd pe1 pe2 => (Qeval_expr env pe1) + (Qeval_expr env pe2) | PEsub pe1 pe2 => (Qeval_expr env pe1) - (Qeval_expr env pe2) | PEmul pe1 pe2 => (Qeval_expr env pe1) * (Qeval_expr env pe2) | PEopp pe1 => - (Qeval_expr env pe1) | PEpow pe1 n => Qpower (Qeval_expr env pe1) (Z.of_N n) end. Proof. destruct e ; reflexivity. Qed. Definition Qeval_expr' := eval_pexpr Qplus Qmult Qminus Qopp (fun x => x) (fun x => x) (pow_N 1 Qmult). Lemma QNpower : forall r n, r ^ Z.of_N n = pow_N 1 Qmult r n. Proof. destruct n ; reflexivity. Qed. Lemma Qeval_expr_compat : forall env e, Qeval_expr env e = Qeval_expr' env e. Proof. induction e ; simpl ; subst ; try congruence. - reflexivity. - rewrite IHe. apply QNpower. Qed. Definition Qeval_pop2 (o : Op2) : Q -> Q -> Prop := match o with | OpEq => Qeq | OpNEq => fun x y => ~ x == y | OpLe => Qle | OpGe => fun x y => Qle y x | OpLt => Qlt | OpGt => fun x y => Qlt y x end. Definition Qlt_bool (x y : Q) := (Qnum x * QDen y Q -> bool := match o with | OpEq => Qeq_bool | OpNEq => fun x y => negb (Qeq_bool x y) | OpLe => Qle_bool | OpGe => fun x y => Qle_bool y x | OpLt => Qlt_bool | OpGt => fun x y => Qlt_bool y x end. Lemma Qlt_bool_iff : forall q1 q2, Qlt_bool q1 q2 = true <-> q1 < q2. Proof. unfold Qlt_bool. unfold Qlt. intros. apply Z.ltb_lt. Qed. Lemma pop2_bop2 : forall (op : Op2) (q1 q2 : Q), is_true (Qeval_bop2 op q1 q2) <-> Qeval_pop2 op q1 q2. Proof. unfold is_true. destruct op ; simpl; intros. - apply Qeq_bool_iff. - rewrite <- Qeq_bool_iff. rewrite negb_true_iff. destruct (Qeq_bool q1 q2) ; intuition congruence. - apply Qle_bool_iff. - apply Qle_bool_iff. - apply Qlt_bool_iff. - apply Qlt_bool_iff. Qed. Definition Qeval_op2 (k:Tauto.kind) : Op2 -> Q -> Q -> Tauto.rtyp k:= if k as k0 return (Op2 -> Q -> Q -> Tauto.rtyp k0) then Qeval_pop2 else Qeval_bop2. Lemma Qeval_op2_hold : forall k op q1 q2, Tauto.hold k (Qeval_op2 k op q1 q2) <-> Qeval_pop2 op q1 q2. Proof. destruct k. - simpl ; tauto. - simpl. apply pop2_bop2. Qed. Definition Qeval_formula (e:PolEnv Q) (k: Tauto.kind) (ff : Formula Q) := let (lhs,o,rhs) := ff in Qeval_op2 k o (Qeval_expr e lhs) (Qeval_expr e rhs). Definition Qeval_formula' := eval_formula Qplus Qmult Qminus Qopp Qeq Qle Qlt (fun x => x) (fun x => x) (pow_N 1 Qmult). Lemma Qeval_formula_compat : forall env b f, Tauto.hold b (Qeval_formula env b f) <-> Qeval_formula' env f. Proof. intros. unfold Qeval_formula. destruct f. repeat rewrite Qeval_expr_compat. unfold Qeval_formula'. unfold Qeval_expr'. simpl. rewrite Qeval_op2_hold. split ; destruct Fop ; simpl; auto. Qed. Definition Qeval_nformula := eval_nformula 0 Qplus Qmult Qeq Qle Qlt (fun x => x) . Definition Qeval_op1 (o : Op1) : Q -> Prop := match o with | Equal => fun x : Q => x == 0 | NonEqual => fun x : Q => ~ x == 0 | Strict => fun x : Q => 0 < x | NonStrict => fun x : Q => 0 <= x end. Lemma Qeval_nformula_dec : forall env d, (Qeval_nformula env d) \/ ~ (Qeval_nformula env d). Proof. exact (fun env d =>eval_nformula_dec Qsor (fun x => x) env d). Qed. Definition QWitness := Psatz Q. Register QWitness as micromega.QWitness.type. Definition QWeakChecker := check_normalised_formulas 0 1 Qplus Qmult Qeq_bool Qle_bool. Require Import List. Lemma QWeakChecker_sound : forall (l : list (NFormula Q)) (cm : QWitness), QWeakChecker l cm = true -> forall env, make_impl (Qeval_nformula env) l False. Proof. intros l cm H. intro. unfold Qeval_nformula. apply (checker_nf_sound Qsor QSORaddon l cm). unfold QWeakChecker in H. exact H. Qed. Require Import Coq.micromega.Tauto. Definition Qnormalise := @cnf_normalise Q 0 1 Qplus Qmult Qminus Qopp Qeq_bool Qle_bool. Definition Qnegate := @cnf_negate Q 0 1 Qplus Qmult Qminus Qopp Qeq_bool Qle_bool. Definition qunsat := check_inconsistent 0 Qeq_bool Qle_bool. Definition qdeduce := nformula_plus_nformula 0 Qplus Qeq_bool. Definition normQ := norm 0 1 Qplus Qmult Qminus Qopp Qeq_bool. Declare Equivalent Keys normQ RingMicromega.norm. Definition cnfQ (Annot:Type) (TX: Tauto.kind -> Type) (AF: Type) (k: Tauto.kind) (f: TFormula (Formula Q) Annot TX AF k) := rxcnf qunsat qdeduce (Qnormalise Annot) (Qnegate Annot) true f. Definition QTautoChecker (f : BFormula (Formula Q) Tauto.isProp) (w: list QWitness) : bool := @tauto_checker (Formula Q) (NFormula Q) unit qunsat qdeduce (Qnormalise unit) (Qnegate unit) QWitness (fun cl => QWeakChecker (List.map fst cl)) f w. Lemma QTautoChecker_sound : forall f w, QTautoChecker f w = true -> forall env, eval_bf (Qeval_formula env) f. Proof. intros f w. unfold QTautoChecker. apply tauto_checker_sound with (eval:= Qeval_formula) (eval':= Qeval_nformula). - apply Qeval_nformula_dec. - intros until env. unfold eval_nformula. unfold RingMicromega.eval_nformula. destruct t. apply (check_inconsistent_sound Qsor QSORaddon) ; auto. - unfold qdeduce. intros. revert H. apply (nformula_plus_nformula_correct Qsor QSORaddon);auto. - intros. rewrite Qeval_formula_compat. eapply (cnf_normalise_correct Qsor QSORaddon) ; eauto. - intros. rewrite Tauto.hold_eNOT. rewrite Qeval_formula_compat. now eapply (cnf_negate_correct Qsor QSORaddon);eauto. - intros t w0. unfold eval_tt. intros. rewrite make_impl_map with (eval := Qeval_nformula env). + eapply QWeakChecker_sound; eauto. + tauto. Qed. coq-8.20.0/theories/micromega/RMicromega.v000066400000000000000000000357601466560755400204210ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* Q2R x = Q2R y. Proof. intros. now apply Qeq_eqR, Qeq_bool_eq. Qed. Lemma Qeq_false : forall x y, Qeq_bool x y = false -> Q2R x <> Q2R y. Proof. intros. apply Qeq_bool_neq in H. contradict H. now apply eqR_Qeq. Qed. Lemma Qle_true : forall x y : Q, Qle_bool x y = true -> Q2R x <= Q2R y. Proof. intros. now apply Qle_Rle, Qle_bool_imp_le. Qed. Lemma Q2R_0 : Q2R 0 = 0. Proof. apply Rmult_0_l. Qed. Lemma Q2R_1 : Q2R 1 = 1. Proof. compute. apply Rinv_1. Qed. Lemma Q2R_inv_ext : forall x, Q2R (/ x) = (if Qeq_bool x 0 then 0 else / Q2R x). Proof. intros. case_eq (Qeq_bool x 0). - intros. apply Qeq_bool_eq in H. destruct x ; simpl. unfold Qeq in H. simpl in H. rewrite Zmult_1_r in H. rewrite H. apply Rmult_0_l. - intros. now apply Q2R_inv, Qeq_bool_neq. Qed. Notation to_nat := N.to_nat. Lemma QSORaddon : @SORaddon R R0 R1 Rplus Rmult Rminus Ropp (@eq R) Rle (* ring elements *) Q 0%Q 1%Q Qplus Qmult Qminus Qopp (* coefficients *) Qeq_bool Qle_bool Q2R nat to_nat pow. Proof. constructor. - constructor ; intros ; try reflexivity. + apply Q2R_0. + apply Q2R_1. + apply Q2R_plus. + apply Q2R_minus. + apply Q2R_mult. + apply Q2R_opp. + apply Qeq_true ; auto. - apply R_power_theory. - apply Qeq_false. - apply Qle_true. Qed. (* Syntactic ring coefficients. *) Inductive Rcst := | C0 | C1 | CQ (r : Q) | CZ (r : Z) | CPlus (r1 r2 : Rcst) | CMinus (r1 r2 : Rcst) | CMult (r1 r2 : Rcst) | CPow (r1 : Rcst) (z:Z+nat) | CInv (r : Rcst) | COpp (r : Rcst). Register Rcst as micromega.Rcst.type. Register C0 as micromega.Rcst.C0. Register C1 as micromega.Rcst.C1. Register CQ as micromega.Rcst.CQ. Register CZ as micromega.Rcst.CZ. Register CPlus as micromega.Rcst.CPlus. Register CMinus as micromega.Rcst.CMinus. Register CMult as micromega.Rcst.CMult. Register CPow as micromega.Rcst.CPow. Register CInv as micromega.Rcst.CInv. Register COpp as micromega.Rcst.COpp. Definition z_of_exp (z : Z + nat) := match z with | inl z => z | inr n => Z.of_nat n end. Fixpoint Q_of_Rcst (r : Rcst) : Q := match r with | C0 => 0 # 1 | C1 => 1 # 1 | CZ z => z # 1 | CQ q => q | CPlus r1 r2 => Qplus (Q_of_Rcst r1) (Q_of_Rcst r2) | CMinus r1 r2 => Qminus (Q_of_Rcst r1) (Q_of_Rcst r2) | CMult r1 r2 => Qmult (Q_of_Rcst r1) (Q_of_Rcst r2) | CPow r1 z => Qpower (Q_of_Rcst r1) (z_of_exp z) | CInv r => Qinv (Q_of_Rcst r) | COpp r => Qopp (Q_of_Rcst r) end. Definition is_neg (z: Z+nat) := match z with | inl (Zneg _) => true | _ => false end. Lemma is_neg_true : forall z, is_neg z = true -> (z_of_exp z < 0)%Z. Proof. destruct z ; simpl ; try congruence. destruct z ; try congruence. intros. reflexivity. Qed. Lemma is_neg_false : forall z, is_neg z = false -> (z_of_exp z >= 0)%Z. Proof. destruct z ; simpl ; try congruence. - destruct z ; try congruence. + compute. congruence. + compute. congruence. - generalize (Zle_0_nat n). auto using Z.le_ge. Qed. Definition CInvR0 (r : Rcst) := Qeq_bool (Q_of_Rcst r) (0 # 1). Definition CPowR0 (z : Z) (r : Rcst) := Z.ltb z Z0 && Qeq_bool (Q_of_Rcst r) (0 # 1). Fixpoint R_of_Rcst (r : Rcst) : R := match r with | C0 => R0 | C1 => R1 | CZ z => IZR z | CQ q => Q2R q | CPlus r1 r2 => (R_of_Rcst r1) + (R_of_Rcst r2) | CMinus r1 r2 => (R_of_Rcst r1) - (R_of_Rcst r2) | CMult r1 r2 => (R_of_Rcst r1) * (R_of_Rcst r2) | CPow r1 z => match z with | inl z => if CPowR0 z r1 then R0 else powerRZ (R_of_Rcst r1) z | inr n => pow (R_of_Rcst r1) n end | CInv r => if CInvR0 r then R0 else Rinv (R_of_Rcst r) | COpp r => - (R_of_Rcst r) end. Add Morphism Q2R with signature Qeq ==> @eq R as Q2R_m. exact Qeq_eqR. Qed. Lemma Q2R_pow_pos : forall q p, Q2R (pow_pos Qmult q p) = pow_pos Rmult (Q2R q) p. Proof. induction p ; simpl;auto; rewrite <- IHp; repeat rewrite Q2R_mult; reflexivity. Qed. Lemma Q2R_pow_N : forall q n, Q2R (pow_N 1%Q Qmult q n) = pow_N 1 Rmult (Q2R q) n. Proof. destruct n ; simpl. - apply Q2R_1. - apply Q2R_pow_pos. Qed. Lemma Qmult_integral : forall q r, q * r == 0 -> q == 0 \/ r == 0. Proof. intros. destruct (Qeq_dec q 0)%Q. - left ; apply q0. - apply Qmult_integral_l in H ; tauto. Qed. Lemma Qpower_positive_eq_zero : forall q p, Qpower_positive q p == 0 -> q == 0. Proof. unfold Qpower_positive. induction p ; simpl; intros; repeat match goal with | H : _ * _ == 0 |- _ => apply Qmult_integral in H; destruct H end; tauto. Qed. Lemma Qpower_positive_zero : forall p, Qpower_positive 0 p == 0%Q. Proof. induction p ; simpl; try rewrite IHp ; reflexivity. Qed. Lemma Q2RpowerRZ : forall q z (DEF : not (q == 0)%Q \/ (z >= Z0)%Z), Q2R (q ^ z) = powerRZ (Q2R q) z. Proof. intros. destruct Qpower_theory. destruct R_power_theory. unfold Qpower, powerRZ. destruct z. - apply Q2R_1. - change (Qpower_positive q p) with (Qpower q (Zpos p)). rewrite <- N2Z.inj_pos. rewrite <- positive_N_nat. rewrite rpow_pow_N. rewrite rpow_pow_N0. apply Q2R_pow_N. - rewrite Q2R_inv. + unfold Qpower_positive. rewrite <- positive_N_nat. rewrite rpow_pow_N0. unfold pow_N. rewrite Q2R_pow_pos. auto. + intro. apply Qpower_positive_eq_zero in H. destruct DEF ; auto with arith. Qed. Lemma Qpower0 : forall z, (z <> 0)%Z -> (0 ^ z == 0)%Q. Proof. unfold Qpower. destruct z;intros. - congruence. - apply Qpower_positive_zero. - rewrite Qpower_positive_zero. reflexivity. Qed. Lemma Q_of_RcstR : forall c, Q2R (Q_of_Rcst c) = R_of_Rcst c. Proof. induction c ; simpl ; try (rewrite <- IHc1 ; rewrite <- IHc2). - apply Q2R_0. - apply Q2R_1. - reflexivity. - unfold Q2R. simpl. rewrite Rinv_1. reflexivity. - apply Q2R_plus. - apply Q2R_minus. - apply Q2R_mult. - destruct z. 1:destruct (CPowR0 z c) eqn:C; unfold CPowR0 in C. + rewrite andb_true_iff in C. destruct C as (C1 & C2). rewrite Z.ltb_lt in C1. apply Qeq_bool_eq in C2. rewrite C2. simpl. assert (z <> 0%Z). { intro ; subst. apply Z.lt_irrefl in C1. auto. } rewrite Qpower0 by auto. apply Q2R_0. + rewrite Q2RpowerRZ. * rewrite IHc. reflexivity. * rewrite andb_false_iff in C. destruct C. -- simpl. apply Z.ltb_ge in H. right. Ztac.normZ. Ztac.slia H H0. -- left ; apply Qeq_bool_neq; auto. + simpl. rewrite <- IHc. destruct Qpower_theory. rewrite <- nat_N_Z. rewrite rpow_pow_N. destruct R_power_theory. rewrite <- (Nnat.Nat2N.id n) at 2. rewrite rpow_pow_N0. apply Q2R_pow_N. - rewrite <- IHc. unfold CInvR0. apply Q2R_inv_ext. - rewrite <- IHc. apply Q2R_opp. Qed. Require Import EnvRing. Definition INZ (n:N) : R := match n with | N0 => IZR 0%Z | Npos p => IZR (Zpos p) end. Definition Reval_expr := eval_pexpr Rplus Rmult Rminus Ropp R_of_Rcst N.to_nat pow. Definition Reval_pop2 (o:Op2) : R -> R -> Prop := match o with | OpEq => @eq R | OpNEq => fun x y => ~ x = y | OpLe => Rle | OpGe => Rge | OpLt => Rlt | OpGt => Rgt end. Definition sumboolb {A B : Prop} (x : @sumbool A B) : bool := if x then true else false. Definition Reval_bop2 (o : Op2) : R -> R -> bool := match o with | OpEq => fun x y => sumboolb (Req_dec_T x y) | OpNEq => fun x y => negb (sumboolb (Req_dec_T x y)) | OpLe => fun x y => (sumboolb (Rle_lt_dec x y)) | OpGe => fun x y => (sumboolb (Rge_gt_dec x y)) | OpLt => fun x y => (sumboolb (Rlt_le_dec x y)) | OpGt => fun x y => (sumboolb (Rgt_dec x y)) end. Lemma pop2_bop2 : forall (op : Op2) (r1 r2 : R), is_true (Reval_bop2 op r1 r2) <-> Reval_pop2 op r1 r2. Proof. unfold is_true. destruct op ; simpl; intros; match goal with | |- context[sumboolb (?F ?X ?Y)] => destruct (F X Y) ; simpl; intuition try congruence end. - apply Rlt_not_le in r. tauto. - apply Rgt_not_ge in r. tauto. - apply Rlt_not_le in H. tauto. Qed. Definition Reval_op2 (k: Tauto.kind) : Op2 -> R -> R -> Tauto.rtyp k:= if k as k0 return (Op2 -> R -> R -> Tauto.rtyp k0) then Reval_pop2 else Reval_bop2. Lemma Reval_op2_hold : forall b op q1 q2, Tauto.hold b (Reval_op2 b op q1 q2) <-> Reval_pop2 op q1 q2. Proof. destruct b. - simpl ; tauto. - simpl. apply pop2_bop2. Qed. Definition Reval_formula (e: PolEnv R) (k: Tauto.kind) (ff : Formula Rcst) := let (lhs,o,rhs) := ff in Reval_op2 k o (Reval_expr e lhs) (Reval_expr e rhs). Definition Reval_formula' := eval_sformula Rplus Rmult Rminus Ropp (@eq R) Rle Rlt N.to_nat pow R_of_Rcst. Lemma Reval_pop2_eval_op2 : forall o e1 e2, Reval_pop2 o e1 e2 <-> eval_op2 eq Rle Rlt o e1 e2. Proof. destruct o ; simpl ; try tauto. split. - apply Rge_le. - apply Rle_ge. Qed. Lemma Reval_formula_compat : forall env b f, Tauto.hold b (Reval_formula env b f) <-> Reval_formula' env f. Proof. intros. unfold Reval_formula. destruct f. unfold Reval_formula'. simpl. rewrite Reval_op2_hold. apply Reval_pop2_eval_op2. Qed. Definition QReval_expr := eval_pexpr Rplus Rmult Rminus Ropp Q2R to_nat pow. Definition QReval_formula (e: PolEnv R) (k: Tauto.kind) (ff : Formula Q) := let (lhs,o,rhs) := ff in Reval_op2 k o (QReval_expr e lhs) (QReval_expr e rhs). Definition QReval_formula' := eval_formula Rplus Rmult Rminus Ropp (@eq R) Rle Rlt Q2R N.to_nat pow. Lemma QReval_formula_compat : forall env b f, Tauto.hold b (QReval_formula env b f) <-> QReval_formula' env f. Proof. intros. unfold QReval_formula. destruct f. unfold QReval_formula'. rewrite Reval_op2_hold. apply Reval_pop2_eval_op2. Qed. Definition Qeval_nformula := eval_nformula 0 Rplus Rmult (@eq R) Rle Rlt Q2R. Lemma Reval_nformula_dec : forall env d, (Qeval_nformula env d) \/ ~ (Qeval_nformula env d). Proof. exact (fun env d =>eval_nformula_dec Rsor Q2R env d). Qed. Definition RWitness := Psatz Q. Definition RWeakChecker := check_normalised_formulas 0%Q 1%Q Qplus Qmult Qeq_bool Qle_bool. Require Import List. Lemma RWeakChecker_sound : forall (l : list (NFormula Q)) (cm : RWitness), RWeakChecker l cm = true -> forall env, make_impl (Qeval_nformula env) l False. Proof. intros l cm H. intro. unfold Qeval_nformula. apply (checker_nf_sound Rsor QSORaddon l cm). unfold RWeakChecker in H. exact H. Qed. Require Import Coq.micromega.Tauto. Definition Rnormalise := @cnf_normalise Q 0%Q 1%Q Qplus Qmult Qminus Qopp Qeq_bool Qle_bool. Definition Rnegate := @cnf_negate Q 0%Q 1%Q Qplus Qmult Qminus Qopp Qeq_bool Qle_bool. Definition runsat := check_inconsistent 0%Q Qeq_bool Qle_bool. Definition rdeduce := nformula_plus_nformula 0%Q Qplus Qeq_bool. Definition RTautoChecker (f : BFormula (Formula Rcst) Tauto.isProp) (w: list RWitness) : bool := @tauto_checker (Formula Q) (NFormula Q) unit runsat rdeduce (Rnormalise unit) (Rnegate unit) RWitness (fun cl => RWeakChecker (List.map fst cl)) (map_bformula (map_Formula Q_of_Rcst) f) w. Lemma RTautoChecker_sound : forall f w, RTautoChecker f w = true -> forall env, eval_bf (Reval_formula env) f. Proof. intros f w. unfold RTautoChecker. intros TC env. apply tauto_checker_sound with (eval:=QReval_formula) (eval':= Qeval_nformula) (env := env) in TC. - change (eval_f e_rtyp (QReval_formula env)) with (eval_bf (QReval_formula env)) in TC. rewrite eval_bf_map in TC. unfold eval_bf in TC. rewrite eval_f_morph with (ev':= Reval_formula env) in TC ; auto. intros. apply Tauto.hold_eiff. rewrite QReval_formula_compat. unfold QReval_formula'. rewrite <- eval_formulaSC with (phiS := R_of_Rcst). + rewrite Reval_formula_compat. tauto. + intro. rewrite Q_of_RcstR. reflexivity. - apply Reval_nformula_dec. - destruct t. apply (check_inconsistent_sound Rsor QSORaddon) ; auto. - unfold rdeduce. intros. revert H. eapply (nformula_plus_nformula_correct Rsor QSORaddon); eauto. - intros. rewrite QReval_formula_compat. eapply (cnf_normalise_correct Rsor QSORaddon) ; eauto. - intros. rewrite Tauto.hold_eNOT. rewrite QReval_formula_compat. now eapply (cnf_negate_correct Rsor QSORaddon); eauto. - intros t w0. unfold eval_tt. intros. rewrite make_impl_map with (eval := Qeval_nformula env0). + eapply RWeakChecker_sound; eauto. + tauto. Qed. (* Local Variables: *) (* coding: utf-8 *) (* End: *) coq-8.20.0/theories/micromega/Refl.v000066400000000000000000000107531466560755400172570ustar00rootroot00000000000000(* -*- coding: utf-8 -*- *) (************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* ' '/\': basic properties *) Fixpoint make_impl (A : Type) (eval : A -> Prop) (l : list A) (goal : Prop) {struct l} : Prop := match l with | nil => goal | cons e l => (eval e) -> (make_impl eval l goal) end. Theorem make_impl_true : forall (A : Type) (eval : A -> Prop) (l : list A), make_impl eval l True. Proof. intros A eval l; induction l as [| a l IH]; simpl. - trivial. - intro; apply IH. Qed. Theorem make_impl_map : forall (A B: Type) (eval : A -> Prop) (eval' : A*B -> Prop) (l : list (A*B)) r (EVAL : forall x, eval' x <-> eval (fst x)), make_impl eval' l r <-> make_impl eval (List.map fst l) r. Proof. intros A B eval eval' l; induction l as [| a l IH]; simpl. - tauto. - intros r EVAL. rewrite EVAL. rewrite IH. + tauto. + auto. Qed. Fixpoint make_conj (A : Type) (eval : A -> Prop) (l : list A) {struct l} : Prop := match l with | nil => True | cons e nil => (eval e) | cons e l2 => ((eval e) /\ (make_conj eval l2)) end. Theorem make_conj_cons : forall (A : Type) (eval : A -> Prop) (a : A) (l : list A), make_conj eval (a :: l) <-> eval a /\ make_conj eval l. Proof. intros A eval a l; destruct l; simpl; tauto. Qed. Lemma make_conj_impl : forall (A : Type) (eval : A -> Prop) (l : list A) (g : Prop), (make_conj eval l -> g) <-> make_impl eval l g. Proof. intros A eval l; induction l as [|? l IHl]. - simpl. tauto. - simpl. intros g. destruct l. + simpl. tauto. + generalize (IHl g). tauto. Qed. Lemma make_conj_in : forall (A : Type) (eval : A -> Prop) (l : list A), make_conj eval l -> (forall p, In p l -> eval p). Proof. intros A eval l; induction l as [|? l IHl]. - simpl. tauto. - simpl. intros H ? H0. destruct l. + simpl in H0. destruct H0. * subst; auto. * tauto. + destruct H. destruct H0. * subst;auto. * apply IHl; auto. Qed. Lemma make_conj_app : forall A eval l1 l2, @make_conj A eval (l1 ++ l2) <-> @make_conj A eval l1 /\ @make_conj A eval l2. Proof. intros A eval l1; induction l1 as [|a l1 IHl1]. - simpl. tauto. - intros l2. change ((a::l1) ++ l2) with (a :: (l1 ++ l2)). rewrite make_conj_cons. rewrite IHl1. rewrite make_conj_cons. tauto. Qed. Infix "+++" := rev_append (right associativity, at level 60) : list_scope. Lemma make_conj_rapp : forall A eval l1 l2, @make_conj A eval (l1 +++ l2) <-> @make_conj A eval (l1++l2). Proof. intros A eval l1; induction l1 as [|? ? IHl1]. - simpl. tauto. - intros. simpl rev_append at 1. rewrite IHl1. rewrite make_conj_app. rewrite make_conj_cons. simpl app. rewrite make_conj_cons. rewrite make_conj_app. tauto. Qed. Lemma not_make_conj_cons : forall (A:Type) (t:A) a eval (no_middle_eval : (eval t) \/ ~ (eval t)), ~ make_conj eval (t ::a) <-> ~ (eval t) \/ (~ make_conj eval a). Proof. intros. rewrite make_conj_cons. tauto. Qed. Lemma not_make_conj_app : forall (A:Type) (t:list A) a eval (no_middle_eval : forall d, eval d \/ ~ eval d) , ~ make_conj eval (t ++ a) <-> (~ make_conj eval t) \/ (~ make_conj eval a). Proof. intros A t; induction t as [|a t IHt]. - simpl. tauto. - intros a0 **. simpl ((a::t)++a0). rewrite !not_make_conj_cons by auto. rewrite IHt by auto. tauto. Qed. coq-8.20.0/theories/micromega/RingMicromega.v000066400000000000000000001031341466560755400211060ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* R -> R. Variable ropp : R -> R. Variables req rle rlt : R -> R -> Prop. Variable sor : SOR rO rI rplus rtimes rminus ropp req rle rlt. Notation "0" := rO. Notation "1" := rI. Notation "x + y" := (rplus x y). Notation "x * y " := (rtimes x y). Notation "x - y " := (rminus x y). Notation "- x" := (ropp x). Notation "x == y" := (req x y). Notation "x ~= y" := (~ req x y). Notation "x <= y" := (rle x y). Notation "x < y" := (rlt x y). (* Assume we have a type of coefficients C and a morphism from C to R *) Variable C : Type. Variables cO cI : C. Variables cplus ctimes cminus: C -> C -> C. Variable copp : C -> C. Variables ceqb cleb : C -> C -> bool. Variable phi : C -> R. (* Power coefficients *) Variable E : Type. (* the type of exponents *) Variable pow_phi : N -> E. Variable rpow : R -> E -> R. Notation "[ x ]" := (phi x). Notation "x [=] y" := (ceqb x y). Notation "x [<=] y" := (cleb x y). (* Let's collect all hypotheses in addition to the ordered ring axioms into one structure *) Record SORaddon := mk_SOR_addon { SORrm : ring_morph 0 1 rplus rtimes rminus ropp req cO cI cplus ctimes cminus copp ceqb phi; SORpower : power_theory rI rtimes req pow_phi rpow; SORcneqb_morph : forall x y : C, x [=] y = false -> [x] ~= [y]; SORcleb_morph : forall x y : C, x [<=] y = true -> [x] <= [y] }. Variable addon : SORaddon. Add Relation R req reflexivity proved by (@Equivalence_Reflexive _ _ (SORsetoid sor)) symmetry proved by (@Equivalence_Symmetric _ _ (SORsetoid sor)) transitivity proved by (@Equivalence_Transitive _ _ (SORsetoid sor)) as micomega_sor_setoid. Add Morphism rplus with signature req ==> req ==> req as rplus_morph. Proof. exact (SORplus_wd sor). Qed. Add Morphism rtimes with signature req ==> req ==> req as rtimes_morph. Proof. exact (SORtimes_wd sor). Qed. Add Morphism ropp with signature req ==> req as ropp_morph. Proof. exact (SORopp_wd sor). Qed. Add Morphism rle with signature req ==> req ==> iff as rle_morph. Proof. exact (SORle_wd sor). Qed. Add Morphism rlt with signature req ==> req ==> iff as rlt_morph. Proof. exact (SORlt_wd sor). Qed. Add Morphism rminus with signature req ==> req ==> req as rminus_morph. Proof. exact (rminus_morph sor). (* We already proved that minus is a morphism in OrderedRing.v *) Qed. Definition cneqb (x y : C) := negb (ceqb x y). Definition cltb (x y : C) := (cleb x y) && (cneqb x y). Notation "x [~=] y" := (cneqb x y). Notation "x [<] y" := (cltb x y). Ltac le_less := rewrite (Rle_lt_eq sor); left; try assumption. Ltac le_equal := rewrite (Rle_lt_eq sor); right; try reflexivity; try assumption. Ltac le_elim H := rewrite (Rle_lt_eq sor) in H; destruct H as [H | H]. Lemma cleb_sound : forall x y : C, x [<=] y = true -> [x] <= [y]. Proof. exact (SORcleb_morph addon). Qed. Lemma cneqb_sound : forall x y : C, x [~=] y = true -> [x] ~= [y]. Proof. intros x y H1. apply (SORcneqb_morph addon). unfold cneqb, negb in H1. destruct (ceqb x y); now try discriminate. Qed. Lemma cltb_sound : forall x y : C, x [<] y = true -> [x] < [y]. Proof. intros x y H. unfold cltb in H. apply andb_prop in H. destruct H as [H1 H2]. apply cleb_sound in H1. apply cneqb_sound in H2. apply <- (Rlt_le_neq sor). now split. Qed. (* Begin Micromega *) Definition PolC := Pol C. (* polynomials in generalized Horner form, defined in Ring_polynom or EnvRing *) Definition PolEnv := Env R. (* For interpreting PolC *) Definition eval_pol : PolEnv -> PolC -> R := Pphi rplus rtimes phi. Inductive Op1 : Set := (* relations with 0 *) | Equal (* == 0 *) | NonEqual (* ~= 0 *) | Strict (* > 0 *) | NonStrict (* >= 0 *). Definition NFormula := (PolC * Op1)%type. (* normalized formula *) Definition eval_op1 (o : Op1) : R -> Prop := match o with | Equal => fun x => x == 0 | NonEqual => fun x : R => x ~= 0 | Strict => fun x : R => 0 < x | NonStrict => fun x : R => 0 <= x end. Definition eval_nformula (env : PolEnv) (f : NFormula) : Prop := let (p, op) := f in eval_op1 op (eval_pol env p). (** Rule of "signs" for addition and multiplication. An arbitrary result is coded buy None. *) Definition OpMult (o o' : Op1) : option Op1 := match o with | Equal => Some Equal | NonStrict => match o' with | Equal => Some Equal | NonEqual => None | Strict => Some NonStrict | NonStrict => Some NonStrict end | Strict => match o' with | NonEqual => None | _ => Some o' end | NonEqual => match o' with | Equal => Some Equal | NonEqual => Some NonEqual | _ => None end end. Definition OpAdd (o o': Op1) : option Op1 := match o with | Equal => Some o' | NonStrict => match o' with | Strict => Some Strict | NonEqual => None | _ => Some NonStrict end | Strict => match o' with | NonEqual => None | _ => Some Strict end | NonEqual => match o' with | Equal => Some NonEqual | _ => None end end. Lemma OpMult_sound : forall (o o' om: Op1) (x y : R), eval_op1 o x -> eval_op1 o' y -> OpMult o o' = Some om -> eval_op1 om (x * y). Proof. unfold eval_op1; intros o; destruct o; simpl; intros o' om x y H1 H2 H3. - (* x == 0 *) inversion H3. rewrite H1. now rewrite (Rtimes_0_l sor). - (* x ~= 0 *) destruct o' ; inversion H3. + (* y == 0 *) rewrite H2. now rewrite (Rtimes_0_r sor). + (* y ~= 0 *) apply (Rtimes_neq_0 sor) ; auto. - (* 0 < x *) destruct o' ; inversion H3. + (* y == 0 *) rewrite H2; now rewrite (Rtimes_0_r sor). + (* 0 < y *) now apply (Rtimes_pos_pos sor). + (* 0 <= y *) apply (Rtimes_nonneg_nonneg sor); [le_less | assumption]. - (* 0 <= x *) destruct o' ; inversion H3. + (* y == 0 *) rewrite H2; now rewrite (Rtimes_0_r sor). + (* 0 < y *) apply (Rtimes_nonneg_nonneg sor); [assumption | le_less ]. + (* 0 <= y *) now apply (Rtimes_nonneg_nonneg sor). Qed. Lemma OpAdd_sound : forall (o o' oa : Op1) (e e' : R), eval_op1 o e -> eval_op1 o' e' -> OpAdd o o' = Some oa -> eval_op1 oa (e + e'). Proof. unfold eval_op1; intros o; destruct o; simpl; intros o' oa e e' H1 H2 Hoa. - (* e == 0 *) inversion Hoa as [H0]. rewrite <- H0. destruct o' ; rewrite H1 ; now rewrite (Rplus_0_l sor). - (* e ~= 0 *) destruct o'. + (* e' == 0 *) inversion Hoa. rewrite H2. now rewrite (Rplus_0_r sor). + (* e' ~= 0 *) discriminate. + (* 0 < e' *) discriminate. + (* 0 <= e' *) discriminate. - (* 0 < e *) destruct o'. + (* e' == 0 *) inversion Hoa. rewrite H2. now rewrite (Rplus_0_r sor). + (* e' ~= 0 *) discriminate. + (* 0 < e' *) inversion Hoa. now apply (Rplus_pos_pos sor). + (* 0 <= e' *) inversion Hoa. now apply (Rplus_pos_nonneg sor). - (* 0 <= e *) destruct o'. + (* e' == 0 *) inversion Hoa. now rewrite H2, (Rplus_0_r sor). + (* e' ~= 0 *) discriminate. (* 0 < e' *) + inversion Hoa. now apply (Rplus_nonneg_pos sor). + (* 0 <= e' *) inversion Hoa. now apply (Rplus_nonneg_nonneg sor). Qed. Inductive Psatz : Type := | PsatzLet: Psatz -> Psatz -> Psatz | PsatzIn : nat -> Psatz | PsatzSquare : PolC -> Psatz | PsatzMulC : PolC -> Psatz -> Psatz | PsatzMulE : Psatz -> Psatz -> Psatz | PsatzAdd : Psatz -> Psatz -> Psatz | PsatzC : C -> Psatz | PsatzZ : Psatz. Register PsatzLet as micromega.Psatz.PsatzLet. Register PsatzIn as micromega.Psatz.PsatzIn. Register PsatzSquare as micromega.Psatz.PsatzSquare. Register PsatzMulC as micromega.Psatz.PsatzMulC. Register PsatzMulE as micromega.Psatz.PsatzMulE. Register PsatzAdd as micromega.Psatz.PsatzAdd. Register PsatzC as micromega.Psatz.PsatzC. Register PsatzZ as micromega.Psatz.PsatzZ. (** Given a list [l] of NFormula and an extended polynomial expression [e], if [eval_Psatz l e] succeeds (= Some f) then [f] is a logic consequence of the conjunction of the formulae in l. Moreover, the polynomial expression is obtained by replacing the (PsatzIn n) by the nth polynomial expression in [l] and the sign is computed by the "rule of sign" *) (* Might be defined elsewhere *) Definition map_option (A B:Type) (f : A -> option B) (o : option A) : option B := match o with | None => None | Some x => f x end. Arguments map_option [A B] f o. Definition map_option2 (A B C : Type) (f : A -> B -> option C) (o: option A) (o': option B) : option C := match o , o' with | None , _ => None | _ , None => None | Some x , Some x' => f x x' end. Arguments map_option2 [A B C] f o o'. Definition Rops_wd := mk_reqe (*rplus rtimes ropp req*) (SORplus_wd sor) (SORtimes_wd sor) (SORopp_wd sor). Definition pexpr_times_nformula (e: PolC) (f : NFormula) : option NFormula := let (ef,o) := f in match o with | Equal => Some (Pmul cO cI cplus ctimes ceqb e ef , Equal) | _ => None end. Definition nformula_times_nformula (f1 f2 : NFormula) : option NFormula := let (e1,o1) := f1 in let (e2,o2) := f2 in map_option (fun x => (Some (Pmul cO cI cplus ctimes ceqb e1 e2,x))) (OpMult o1 o2). Definition nformula_plus_nformula (f1 f2 : NFormula) : option NFormula := let (e1,o1) := f1 in let (e2,o2) := f2 in map_option (fun x => (Some (Padd cO cplus ceqb e1 e2,x))) (OpAdd o1 o2). Fixpoint eval_Psatz (l : list NFormula) (e : Psatz) {struct e} : option NFormula := match e with | PsatzLet p1 p2 => match eval_Psatz l p1 with | None => None | Some f => eval_Psatz (f::l) p2 end | PsatzIn n => Some (nth n l (Pc cO, Equal)) | PsatzSquare e => Some (Psquare cO cI cplus ctimes ceqb e , NonStrict) | PsatzMulC re e => map_option (pexpr_times_nformula re) (eval_Psatz l e) | PsatzMulE f1 f2 => map_option2 nformula_times_nformula (eval_Psatz l f1) (eval_Psatz l f2) | PsatzAdd f1 f2 => map_option2 nformula_plus_nformula (eval_Psatz l f1) (eval_Psatz l f2) | PsatzC c => if cltb cO c then Some (Pc c, Strict) else None (* This could be 0, or <> 0 -- but these cases are useless *) | PsatzZ => Some (Pc cO, Equal) (* Just to make life easier *) end. Lemma pexpr_times_nformula_correct : forall (env: PolEnv) (e: PolC) (f f' : NFormula), eval_nformula env f -> pexpr_times_nformula e f = Some f' -> eval_nformula env f'. Proof. unfold pexpr_times_nformula. intros env e f; destruct f as [? o]. intros f' H H0. destruct o ; inversion H0 ; try discriminate. simpl in *. unfold eval_pol in *. rewrite (Pmul_ok (SORsetoid sor) Rops_wd (Rth_ARth (SORsetoid sor) Rops_wd (SORrt sor)) (SORrm addon)). rewrite H. apply (Rtimes_0_r sor). Qed. Lemma nformula_times_nformula_correct : forall (env:PolEnv) (f1 f2 f : NFormula), eval_nformula env f1 -> eval_nformula env f2 -> nformula_times_nformula f1 f2 = Some f -> eval_nformula env f. Proof. unfold nformula_times_nformula. intros env f1 f2; destruct f1 as [? o]; destruct f2 as [? o0]. case_eq (OpMult o o0) ; simpl ; try discriminate. intros o1 H ? H0 H1 H2. inversion H2 ; simpl. unfold eval_pol. destruct o1; simpl; rewrite (Pmul_ok (SORsetoid sor) Rops_wd (Rth_ARth (SORsetoid sor) Rops_wd (SORrt sor)) (SORrm addon)); apply OpMult_sound with (3:= H);assumption. Qed. Lemma nformula_plus_nformula_correct : forall (env:PolEnv) (f1 f2 f : NFormula), eval_nformula env f1 -> eval_nformula env f2 -> nformula_plus_nformula f1 f2 = Some f -> eval_nformula env f. Proof. unfold nformula_plus_nformula. intros env f1 f2; destruct f1 as [? o] ; destruct f2 as [? o0]. case_eq (OpAdd o o0) ; simpl ; try discriminate. intros o1 H ? H0 H1 H2. inversion H2 ; simpl. unfold eval_pol. destruct o1; simpl; rewrite (Padd_ok (SORsetoid sor) Rops_wd (Rth_ARth (SORsetoid sor) Rops_wd (SORrt sor)) (SORrm addon)); apply OpAdd_sound with (3:= H);assumption. Qed. Lemma eval_Psatz_Sound : forall (l : list NFormula) (env : PolEnv), (forall (f : NFormula), In f l -> eval_nformula env f) -> forall (e : Psatz) (f : NFormula), eval_Psatz l e = Some f -> eval_nformula env f. Proof. intros l env H e. revert l H. induction e as [e1 IHe1 e2 IHe2 | n|?|? e IHe|e1 IHe1 e2 IHe2|e1 IHe1 e2 IHe2|c|]; simpl ; intros l IN f. - (* PsatzLet *) destruct (eval_Psatz l e1) as [f'|] eqn:EP; [|discriminate]. apply IHe2. intros f2 [EQ |IN']. + subst. eapply IHe1; eauto. + eauto. - (* PsatzIn *) simpl ; intros H0. destruct (nth_in_or_default n l (Pc cO, Equal)) as [Hin|Heq]. + (* index is in bounds *) apply IN. congruence. + (* index is out-of-bounds *) inversion H0. rewrite Heq. simpl. now apply (morph0 (SORrm addon)). - (* PsatzSquare *) intros H0. inversion H0. simpl. unfold eval_pol. rewrite (Psquare_ok (SORsetoid sor) Rops_wd (Rth_ARth (SORsetoid sor) Rops_wd (SORrt sor)) (SORrm addon)); now apply (Rtimes_square_nonneg sor). - (* PsatzMulC *) case_eq (eval_Psatz l e) ; simpl ; intros ? H0; [intros H1|]. + apply IHe in H0. * apply pexpr_times_nformula_correct with (1:=H0) (2:= H1). * apply IN. + discriminate. - (* PsatzMulC *) simpl. case_eq (eval_Psatz l e1) ; simpl ; try discriminate. case_eq (eval_Psatz l e2) ; simpl ; try discriminate. intros n H0 n0 H1. apply IHe1 in H1; auto. apply IHe2 in H0; auto. apply (nformula_times_nformula_correct env n0 n); auto. - (* PsatzAdd *) simpl. case_eq (eval_Psatz l e1) ; simpl ; try discriminate. case_eq (eval_Psatz l e2) ; simpl ; try discriminate. intros n H0 n0 H1. apply IHe1 in H1; auto. apply IHe2 in H0; auto. apply (nformula_plus_nformula_correct env n0 n) ; assumption. - (* PsatzC *) simpl. case_eq (cO [<] c). + intros H0 H1. inversion H1. simpl. rewrite <- (morph0 (SORrm addon)). now apply cltb_sound. + discriminate. - (* PsatzZ *) simpl. intros H0. inversion H0. simpl. apply (morph0 (SORrm addon)). Qed. Fixpoint ge_bool (n m : nat) : bool := match n with | O => match m with | O => true | S _ => false end | S n => match m with | O => true | S m => ge_bool n m end end. Lemma ge_bool_cases : forall n m, (if ge_bool n m then n >= m else n < m)%nat. Proof. intros n; induction n as [|n IHn]; intros m; destruct m as [|m]; simpl; auto with arith. specialize (IHn m). destruct (ge_bool); auto with arith. Qed. Fixpoint xhyps_of_psatz (base:nat) (acc : list nat) (prf : Psatz) : list nat := match prf with | PsatzC _ | PsatzZ | PsatzSquare _ => acc | PsatzMulC _ prf => xhyps_of_psatz base acc prf | PsatzAdd e1 e2 | PsatzMulE e1 e2 => xhyps_of_psatz base (xhyps_of_psatz base acc e2) e1 | PsatzIn n => if ge_bool n base then (n::acc) else acc | PsatzLet e1 e2 => xhyps_of_psatz base (xhyps_of_psatz (S base) acc e2) e1 end. Fixpoint nhyps_of_psatz (base:nat) (prf : Psatz) : list nat := match prf with | PsatzC _ | PsatzZ | PsatzSquare _ => nil | PsatzMulC _ prf => nhyps_of_psatz base prf | PsatzAdd e1 e2 | PsatzMulE e1 e2 => nhyps_of_psatz base e1 ++ nhyps_of_psatz base e2 | PsatzIn n => if ge_bool n base then (n::nil) else nil | PsatzLet e1 e2 => nhyps_of_psatz base e1 ++ nhyps_of_psatz (S base) e2 end. Fixpoint extract_hyps (l: list NFormula) (ln : list nat) : list NFormula := match ln with | nil => nil | n::ln => nth n l (Pc cO, Equal) :: extract_hyps l ln end. Lemma extract_hyps_app : forall l ln1 ln2, extract_hyps l (ln1 ++ ln2) = (extract_hyps l ln1) ++ (extract_hyps l ln2). Proof. intros l ln1; induction ln1 as [|? ln1 IHln1]. - reflexivity. - simpl. intros. rewrite IHln1. reflexivity. Qed. Ltac inv H := inversion H ; try subst ; clear H. (* roughly speaking, normalise_pexpr_correct is a proof of forall env p, eval_pexpr env p == eval_pol env (normalise_pexpr p) *) (*****) Definition paddC := PaddC cplus. Definition psubC := PsubC cminus. Definition PsubC_ok : forall c P env, eval_pol env (psubC P c) == eval_pol env P - [c] := let Rops_wd := mk_reqe (*rplus rtimes ropp req*) (SORplus_wd sor) (SORtimes_wd sor) (SORopp_wd sor) in PsubC_ok (SORsetoid sor) Rops_wd (Rth_ARth (SORsetoid sor) Rops_wd (SORrt sor)) (SORrm addon). Definition PaddC_ok : forall c P env, eval_pol env (paddC P c) == eval_pol env P + [c] := let Rops_wd := mk_reqe (*rplus rtimes ropp req*) (SORplus_wd sor) (SORtimes_wd sor) (SORopp_wd sor) in PaddC_ok (SORsetoid sor) Rops_wd (Rth_ARth (SORsetoid sor) Rops_wd (SORrt sor)) (SORrm addon). (* Check that a formula f is inconsistent by normalizing and comparing the resulting constant with 0 *) Definition check_inconsistent (f : NFormula) : bool := let (e, op) := f in match e with | Pc c => match op with | Equal => cneqb c cO | NonStrict => c [<] cO | Strict => c [<=] cO | NonEqual => c [=] cO end | _ => false (* not a constant *) end. Lemma check_inconsistent_sound : forall (p : PolC) (op : Op1), check_inconsistent (p, op) = true -> forall env, ~ eval_op1 op (eval_pol env p). Proof. intros p op H1 env. unfold check_inconsistent in H1. destruct op; simpl ; (*****) destruct p ; simpl; try discriminate H1; try rewrite <- (morph0 (SORrm addon)); trivial. - now apply cneqb_sound. - apply (morph_eq (SORrm addon)) in H1. congruence. - apply cleb_sound in H1. now apply -> (Rle_ngt sor). - apply cltb_sound in H1. now apply -> (Rlt_nge sor). Qed. Definition check_normalised_formulas : list NFormula -> Psatz -> bool := fun l cm => match eval_Psatz l cm with | None => false | Some f => check_inconsistent f end. Lemma checker_nf_sound : forall (l : list NFormula) (cm : Psatz), check_normalised_formulas l cm = true -> forall env : PolEnv, make_impl (eval_nformula env) l False. Proof. intros l cm H env. unfold check_normalised_formulas in H. revert H. case_eq (eval_Psatz l cm) ; [|discriminate]. intros nf. intros H H0. rewrite <- make_conj_impl. intro H1. assert (H1' := make_conj_in _ _ H1). assert (Hnf := @eval_Psatz_Sound _ _ H1' _ _ H). destruct nf. apply (@check_inconsistent_sound _ _ H0 env Hnf). Qed. (** Normalisation of formulae **) Inductive Op2 : Set := (* binary relations *) | OpEq | OpNEq | OpLe | OpGe | OpLt | OpGt. Register OpEq as micromega.Op2.OpEq. Register OpNEq as micromega.Op2.OpNEq. Register OpLe as micromega.Op2.OpLe. Register OpGe as micromega.Op2.OpGe. Register OpLt as micromega.Op2.OpLt. Register OpGt as micromega.Op2.OpGt. Definition eval_op2 (o : Op2) : R -> R -> Prop := match o with | OpEq => req | OpNEq => fun x y : R => x ~= y | OpLe => rle | OpGe => fun x y : R => y <= x | OpLt => fun x y : R => x < y | OpGt => fun x y : R => y < x end. Definition eval_pexpr : PolEnv -> PExpr C -> R := PEeval rplus rtimes rminus ropp phi pow_phi rpow. #[universes(template)] Record Formula (T:Type) : Type := Build_Formula{ Flhs : PExpr T; Fop : Op2; Frhs : PExpr T }. Register Formula as micromega.Formula.type. Register Build_Formula as micromega.Formula.Build_Formula. Definition eval_formula (env : PolEnv) (f : Formula C) : Prop := let (lhs, op, rhs) := f in (eval_op2 op) (eval_pexpr env lhs) (eval_pexpr env rhs). (* We normalize Formulas by moving terms to one side *) Definition norm := norm_aux cO cI cplus ctimes cminus copp ceqb. Definition psub := Psub cO cplus cminus copp ceqb. Definition padd := Padd cO cplus ceqb. Definition pmul := Pmul cO cI cplus ctimes ceqb. Definition popp := Popp copp. Definition normalise (f : Formula C) : NFormula := let (lhs, op, rhs) := f in let lhs := norm lhs in let rhs := norm rhs in match op with | OpEq => (psub lhs rhs, Equal) | OpNEq => (psub lhs rhs, NonEqual) | OpLe => (psub rhs lhs, NonStrict) | OpGe => (psub lhs rhs, NonStrict) | OpGt => (psub lhs rhs, Strict) | OpLt => (psub rhs lhs, Strict) end. Definition negate (f : Formula C) : NFormula := let (lhs, op, rhs) := f in let lhs := norm lhs in let rhs := norm rhs in match op with | OpEq => (psub rhs lhs, NonEqual) | OpNEq => (psub rhs lhs, Equal) | OpLe => (psub lhs rhs, Strict) (* e <= e' == ~ e > e' *) | OpGe => (psub rhs lhs, Strict) | OpGt => (psub rhs lhs, NonStrict) | OpLt => (psub lhs rhs, NonStrict) end. Lemma eval_pol_sub : forall env lhs rhs, eval_pol env (psub lhs rhs) == eval_pol env lhs - eval_pol env rhs. Proof. intros. apply (Psub_ok (SORsetoid sor) Rops_wd (Rth_ARth (SORsetoid sor) Rops_wd (SORrt sor)) (SORrm addon)). Qed. Lemma eval_pol_add : forall env lhs rhs, eval_pol env (padd lhs rhs) == eval_pol env lhs + eval_pol env rhs. Proof. intros. apply (Padd_ok (SORsetoid sor) Rops_wd (Rth_ARth (SORsetoid sor) Rops_wd (SORrt sor)) (SORrm addon)). Qed. Lemma eval_pol_mul : forall env lhs rhs, eval_pol env (pmul lhs rhs) == eval_pol env lhs * eval_pol env rhs. Proof. intros. apply (Pmul_ok sor.(SORsetoid) Rops_wd (Rth_ARth (SORsetoid sor) Rops_wd sor.(SORrt)) addon.(SORrm)). Qed. Lemma eval_pol_opp : forall env e, eval_pol env (popp e) == - eval_pol env e. Proof. intros. apply (Popp_ok (SORsetoid sor) Rops_wd (Rth_ARth (SORsetoid sor) Rops_wd (SORrt sor)) (SORrm addon)). Qed. Lemma eval_pol_norm : forall env lhs, eval_pexpr env lhs == eval_pol env (norm lhs). Proof. intros. apply (norm_aux_spec (SORsetoid sor) Rops_wd (Rth_ARth (SORsetoid sor) Rops_wd (SORrt sor)) (SORrm addon) (SORpower addon) ). Qed. Theorem normalise_sound : forall (env : PolEnv) (f : Formula C), eval_formula env f <-> eval_nformula env (normalise f). Proof. intros env f; destruct f as [lhs op rhs]; simpl in *. destruct op; simpl in *; rewrite eval_pol_sub ; rewrite <- eval_pol_norm ; rewrite <- eval_pol_norm. - symmetry. now apply (Rminus_eq_0 sor). - rewrite (Rminus_eq_0 sor). tauto. - now apply (Rle_le_minus sor). - now apply (Rle_le_minus sor). - now apply (Rlt_lt_minus sor). - now apply (Rlt_lt_minus sor). Qed. Theorem negate_correct : forall (env : PolEnv) (f : Formula C), eval_formula env f <-> ~ (eval_nformula env (negate f)). Proof. intros env f; destruct f as [lhs op rhs]; simpl. destruct op; simpl in *; rewrite eval_pol_sub ; rewrite <- eval_pol_norm ; rewrite <- eval_pol_norm. - symmetry. rewrite (Rminus_eq_0 sor). split; intro H; [symmetry; now apply -> (Req_dne sor) | symmetry in H; now apply <- (Req_dne sor)]. - rewrite (Rminus_eq_0 sor). split; intro; now apply (Rneq_symm sor). - rewrite <- (Rlt_lt_minus sor). now rewrite <- (Rle_ngt sor). - rewrite <- (Rlt_lt_minus sor). now rewrite <- (Rle_ngt sor). - rewrite <- (Rle_le_minus sor). now rewrite <- (Rlt_nge sor). - rewrite <- (Rle_le_minus sor). now rewrite <- (Rlt_nge sor). Qed. (** Another normalisation - this is used for cnf conversion **) Definition xnormalise (f:NFormula) : list (NFormula) := let (e,o) := f in match o with | Equal => (e , Strict) :: (popp e, Strict) :: nil | NonEqual => (e , Equal) :: nil | Strict => (popp e, NonStrict) :: nil | NonStrict => (popp e, Strict) :: nil end. Definition xnegate (t:NFormula) : list (NFormula) := let (e,o) := t in match o with | Equal => (e,Equal) :: nil | NonEqual => (e,Strict)::(popp e,Strict)::nil | Strict => (e,Strict) :: nil | NonStrict => (e,NonStrict) :: nil end. Import Coq.micromega.Tauto. Definition cnf_of_list {T : Type} (l:list NFormula) (tg : T) : cnf NFormula T := List.fold_right (fun x acc => if check_inconsistent x then acc else ((x,tg)::nil)::acc) (cnf_tt _ _) l. Add Ring SORRing : (SORrt sor). Lemma cnf_of_list_correct : forall (T : Type) env l tg, eval_cnf (Annot:=T) eval_nformula env (cnf_of_list l tg) <-> make_conj (fun x : NFormula => eval_nformula env x -> False) l. Proof. unfold cnf_of_list. intros T env l tg. set (F := (fun (x : NFormula) (acc : list (list (NFormula * T))) => if check_inconsistent x then acc else ((x, tg) :: nil) :: acc)). set (G := ((fun x : NFormula => eval_nformula env x -> False))). induction l as [|a l IHl]. - compute. tauto. - rewrite make_conj_cons. simpl. unfold F at 1. destruct (check_inconsistent a) eqn:EQ. + rewrite IHl. unfold G. destruct a. specialize (check_inconsistent_sound _ _ EQ env). simpl. tauto. + rewrite <- eval_cnf_cons_iff. simpl. unfold eval_tt. simpl. rewrite IHl. unfold G at 2. tauto. Qed. Definition cnf_normalise {T: Type} (t: Formula C) (tg: T) : cnf NFormula T := let f := normalise t in if check_inconsistent f then cnf_ff _ _ else cnf_of_list (xnormalise f) tg. Definition cnf_negate {T: Type} (t: Formula C) (tg: T) : cnf NFormula T := let f := normalise t in if check_inconsistent f then cnf_tt _ _ else cnf_of_list (xnegate f) tg. Lemma eq0_cnf : forall x, (0 < x -> False) /\ (0 < - x -> False) <-> x == 0. Proof. intros x; split ; intros H. + apply (SORle_antisymm sor). * now rewrite (Rle_ngt sor). * rewrite (Rle_ngt sor). rewrite (Rlt_lt_minus sor). setoid_replace (0 - x) with (-x) by ring. tauto. + split; intro H0. * rewrite (SORlt_le_neq sor) in H0. apply (proj2 H0). now rewrite H. * rewrite (SORlt_le_neq sor) in H0. apply (proj2 H0). rewrite H. ring. Qed. Lemma xnormalise_correct : forall env f, (make_conj (fun x => eval_nformula env x -> False) (xnormalise f)) <-> eval_nformula env f. Proof. intros env f. destruct f as [e o]; destruct o eqn:Op; cbn - [psub]; repeat rewrite eval_pol_sub; fold eval_pol; repeat rewrite eval_pol_Pc; repeat rewrite eval_pol_opp; generalize (eval_pol env e) as x; intro x. - apply eq0_cnf. - unfold not. tauto. - symmetry. rewrite (Rlt_nge sor). rewrite (Rle_le_minus sor). setoid_replace (0 - x) with (-x) by ring. tauto. - rewrite (Rle_ngt sor). symmetry. rewrite (Rlt_lt_minus sor). setoid_replace (0 - x) with (-x) by ring. tauto. Qed. Lemma xnegate_correct : forall env f, (make_conj (fun x => eval_nformula env x -> False) (xnegate f)) <-> ~ eval_nformula env f. Proof. intros env f. destruct f as [e o]; destruct o eqn:Op; cbn - [psub]; repeat rewrite eval_pol_sub; fold eval_pol; repeat rewrite eval_pol_Pc; repeat rewrite eval_pol_opp; generalize (eval_pol env e) as x; intro. - tauto. - rewrite eq0_cnf. rewrite (Req_dne sor). tauto. - tauto. - tauto. Qed. Lemma cnf_normalise_correct : forall (T : Type) env t tg, eval_cnf (Annot:=T) eval_nformula env (cnf_normalise t tg) <-> eval_formula env t. Proof. intros T env t tg. unfold cnf_normalise. rewrite normalise_sound. generalize (normalise t) as f;intro f. destruct (check_inconsistent f) eqn:U. - destruct f as [e op]. assert (US := check_inconsistent_sound _ _ U env). rewrite eval_cnf_ff. tauto. - intros. rewrite cnf_of_list_correct. now apply xnormalise_correct. Qed. Lemma cnf_negate_correct : forall (T : Type) env t (tg:T), eval_cnf eval_nformula env (cnf_negate t tg) <-> ~ eval_formula env t. Proof. intros T env t tg. rewrite normalise_sound. unfold cnf_negate. generalize (normalise t) as f;intro f. destruct (check_inconsistent f) eqn:U. - destruct f as [e o]. assert (US := check_inconsistent_sound _ _ U env). rewrite eval_cnf_tt. tauto. - rewrite cnf_of_list_correct. apply xnegate_correct. Qed. Lemma eval_nformula_dec : forall env d, (eval_nformula env d) \/ ~ (eval_nformula env d). Proof. intros env d. destruct d as [p o]; simpl. generalize (eval_pol env p); intros r. destruct o ; simpl. - apply (Req_em sor r 0). - destruct (Req_em sor r 0) ; tauto. - rewrite <- (Rle_ngt sor r 0). generalize (Rle_gt_cases sor r 0). tauto. - rewrite <- (Rlt_nge sor r 0). generalize (Rle_gt_cases sor 0 r). tauto. Qed. (** Reverse transformation *) Fixpoint xdenorm (jmp : positive) (p: Pol C) : PExpr C := match p with | Pc c => PEc c | Pinj j p => xdenorm (Pos.add j jmp ) p | PX p j q => PEadd (PEmul (xdenorm jmp p) (PEpow (PEX jmp) (Npos j))) (xdenorm (Pos.succ jmp) q) end. Lemma xdenorm_correct : forall p i env, eval_pol (jump i env) p == eval_pexpr env (xdenorm (Pos.succ i) p). Proof. unfold eval_pol. intros p; induction p as [|? p IHp|p2 IHp1 ? p3 IHp2]. - simpl. reflexivity. - (* Pinj *) simpl. intros. rewrite Pos.add_succ_r. rewrite <- IHp. symmetry. rewrite Pos.add_comm. rewrite Pjump_add. reflexivity. - (* PX *) simpl. intros. rewrite <- IHp1, <- IHp2. unfold Env.tail , Env.hd. rewrite <- Pjump_add. rewrite Pos.add_1_r. unfold Env.nth. unfold jump at 2. rewrite <- Pos.add_1_l. rewrite (rpow_pow_N (SORpower addon)). unfold pow_N. ring. Qed. Definition denorm := xdenorm xH. Lemma denorm_correct : forall p env, eval_pol env p == eval_pexpr env (denorm p). Proof. unfold denorm. intros p; induction p as [| |? IHp1 ? ? IHp2]. - reflexivity. - simpl. rewrite Pos.add_1_r. apply xdenorm_correct. - simpl. intros. rewrite IHp1. unfold Env.tail. rewrite xdenorm_correct. change (Pos.succ xH) with 2%positive. rewrite (rpow_pow_N (SORpower addon)). simpl. reflexivity. Qed. (** Sometimes it is convenient to make a distinction between "syntactic" coefficients and "real" coefficients that are used to actually compute *) Variable S : Type. Variable C_of_S : S -> C. Variable phiS : S -> R. Variable phi_C_of_S : forall c, phiS c = phi (C_of_S c). Fixpoint map_PExpr (e : PExpr S) : PExpr C := match e with | PEc c => PEc (C_of_S c) | PEX p => PEX p | PEadd e1 e2 => PEadd (map_PExpr e1) (map_PExpr e2) | PEsub e1 e2 => PEsub (map_PExpr e1) (map_PExpr e2) | PEmul e1 e2 => PEmul (map_PExpr e1) (map_PExpr e2) | PEopp e => PEopp (map_PExpr e) | PEpow e n => PEpow (map_PExpr e) n end. Definition map_Formula (f : Formula S) : Formula C := let (l,o,r) := f in Build_Formula (map_PExpr l) o (map_PExpr r). Definition eval_sexpr : PolEnv -> PExpr S -> R := PEeval rplus rtimes rminus ropp phiS pow_phi rpow. Definition eval_sformula (env : PolEnv) (f : Formula S) : Prop := let (lhs, op, rhs) := f in (eval_op2 op) (eval_sexpr env lhs) (eval_sexpr env rhs). Lemma eval_pexprSC : forall env s, eval_sexpr env s = eval_pexpr env (map_PExpr s). Proof. unfold eval_pexpr, eval_sexpr. intros env s; induction s as [| |? IHs1 ? IHs2|? IHs1 ? IHs2|? IHs1 ? IHs2|? IHs|? IHs ?]; simpl ; try (rewrite IHs1 ; rewrite IHs2) ; try reflexivity. - apply phi_C_of_S. - rewrite IHs. reflexivity. - rewrite IHs. reflexivity. Qed. (** equality might be (too) strong *) Lemma eval_formulaSC : forall env f, eval_sformula env f = eval_formula env (map_Formula f). Proof. intros env f; destruct f. simpl. repeat rewrite eval_pexprSC. reflexivity. Qed. (** Some syntactic simplifications of expressions *) Definition simpl_cone (e:Psatz) : Psatz := match e with | PsatzSquare t => match t with | Pc c => if ceqb cO c then PsatzZ else PsatzC (ctimes c c) | _ => PsatzSquare t end | PsatzMulE t1 t2 => match t1 , t2 with | PsatzZ , _ => PsatzZ | _ , PsatzZ => PsatzZ | PsatzC c , PsatzC c' => PsatzC (ctimes c c') | PsatzC p1 , PsatzMulE (PsatzC p2) x => PsatzMulE (PsatzC (ctimes p1 p2)) x | PsatzC p1 , PsatzMulE x (PsatzC p2) => PsatzMulE (PsatzC (ctimes p1 p2)) x | PsatzMulE (PsatzC p2) x , PsatzC p1 => PsatzMulE (PsatzC (ctimes p1 p2)) x | PsatzMulE x (PsatzC p2) , PsatzC p1 => PsatzMulE (PsatzC (ctimes p1 p2)) x | PsatzC x , PsatzAdd y z => PsatzAdd (PsatzMulE (PsatzC x) y) (PsatzMulE (PsatzC x) z) | PsatzC c , _ => if ceqb cI c then t2 else PsatzMulE t1 t2 | _ , PsatzC c => if ceqb cI c then t1 else PsatzMulE t1 t2 | _ , _ => e end | PsatzAdd t1 t2 => match t1 , t2 with | PsatzZ , x => x | x , PsatzZ => x | x , y => PsatzAdd x y end | _ => e end. End Micromega. (* Local Variables: *) (* coding: utf-8 *) (* End: *) coq-8.20.0/theories/micromega/Tauto.v000066400000000000000000001775751466560755400175030ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* Trace A -> Trace A | merge : Trace A -> Trace A -> Trace A . Section S. Context {TA : Type}. (* type of interpreted atoms *) Context {TX : kind -> Type}. (* type of uninterpreted terms (Prop) *) Context {AA : Type}. (* type of annotations for atoms *) Context {AF : Type}. (* type of formulae identifiers *) Inductive GFormula : kind -> Type := | TT : forall (k: kind), GFormula k | FF : forall (k: kind), GFormula k | X : forall (k: kind), TX k -> GFormula k | A : forall (k: kind), TA -> AA -> GFormula k | AND : forall (k: kind), GFormula k -> GFormula k -> GFormula k | OR : forall (k: kind), GFormula k -> GFormula k -> GFormula k | NOT : forall (k: kind), GFormula k -> GFormula k | IMPL : forall (k: kind), GFormula k -> option AF -> GFormula k -> GFormula k | IFF : forall (k: kind), GFormula k -> GFormula k -> GFormula k | EQ : GFormula isBool -> GFormula isBool -> GFormula isProp. Register TT as micromega.GFormula.TT. Register FF as micromega.GFormula.FF. Register X as micromega.GFormula.X. Register A as micromega.GFormula.A. Register AND as micromega.GFormula.AND. Register OR as micromega.GFormula.OR. Register NOT as micromega.GFormula.NOT. Register IMPL as micromega.GFormula.IMPL. Register IFF as micromega.GFormula.IFF. Register EQ as micromega.GFormula.EQ. Section MAPX. Variable F : forall k, TX k -> TX k. Fixpoint mapX (k:kind) (f : GFormula k) : GFormula k := match f with | TT k => TT k | FF k => FF k | X x => X (F x) | A k a an => A k a an | AND f1 f2 => AND (mapX f1) (mapX f2) | OR f1 f2 => OR (mapX f1) (mapX f2) | NOT f => NOT (mapX f) | IMPL f1 o f2 => IMPL (mapX f1) o (mapX f2) | IFF f1 f2 => IFF (mapX f1) (mapX f2) | EQ f1 f2 => EQ (mapX f1) (mapX f2) end. End MAPX. Section FOLDANNOT. Variable ACC : Type. Variable F : ACC -> AA -> ACC. Fixpoint foldA (k: kind) (f : GFormula k) (acc : ACC) : ACC := match f with | TT _ => acc | FF _ => acc | X x => acc | A _ a an => F acc an | AND f1 f2 | OR f1 f2 | IFF f1 f2 | IMPL f1 _ f2 | EQ f1 f2 => foldA f1 (foldA f2 acc) | NOT f => foldA f acc end. End FOLDANNOT. Definition cons_id (id : option AF) (l : list AF) := match id with | None => l | Some id => id :: l end. Fixpoint ids_of_formula (k: kind) (f:GFormula k) := match f with | IMPL f id f' => cons_id id (ids_of_formula f') | _ => nil end. Fixpoint collect_annot (k: kind) (f : GFormula k) : list AA := match f with | TT _ | FF _ | X _ => nil | A _ _ a => a ::nil | AND f1 f2 | OR f1 f2 | IFF f1 f2 | EQ f1 f2 | IMPL f1 _ f2 => collect_annot f1 ++ collect_annot f2 | NOT f => collect_annot f end. Definition rtyp (k: kind) : Type := if k then Prop else bool. Variable ex : forall (k: kind), TX k -> rtyp k. (* [ex] will be the identity *) Section EVAL. Variable ea : forall (k: kind), TA -> rtyp k. Definition eTT (k: kind) : rtyp k := if k as k' return rtyp k' then True else true. Definition eFF (k: kind) : rtyp k := if k as k' return rtyp k' then False else false. Definition eAND (k: kind) : rtyp k -> rtyp k -> rtyp k := if k as k' return rtyp k' -> rtyp k' -> rtyp k' then and else andb. Definition eOR (k: kind) : rtyp k -> rtyp k -> rtyp k := if k as k' return rtyp k' -> rtyp k' -> rtyp k' then or else orb. Definition eIMPL (k: kind) : rtyp k -> rtyp k -> rtyp k := if k as k' return rtyp k' -> rtyp k' -> rtyp k' then (fun x y => x -> y) else implb. Definition eIFF (k: kind) : rtyp k -> rtyp k -> rtyp k := if k as k' return rtyp k' -> rtyp k' -> rtyp k' then iff else eqb. Definition eNOT (k: kind) : rtyp k -> rtyp k := if k as k' return rtyp k' -> rtyp k' then not else negb. Fixpoint eval_f (k: kind) (f:GFormula k) {struct f}: rtyp k := match f in GFormula k' return rtyp k' with | TT tk => eTT tk | FF tk => eFF tk | A k a _ => ea k a | X p => ex p | @AND k e1 e2 => eAND k (eval_f e1) (eval_f e2) | @OR k e1 e2 => eOR k (eval_f e1) (eval_f e2) | @NOT k e => eNOT k (eval_f e) | @IMPL k f1 _ f2 => eIMPL k (eval_f f1) (eval_f f2) | @IFF k f1 f2 => eIFF k (eval_f f1) (eval_f f2) | EQ f1 f2 => (eval_f f1) = (eval_f f2) end. Lemma eval_f_rew : forall k (f:GFormula k), eval_f f = match f in GFormula k' return rtyp k' with | TT tk => eTT tk | FF tk => eFF tk | A k a _ => ea k a | X p => ex p | @AND k e1 e2 => eAND k (eval_f e1) (eval_f e2) | @OR k e1 e2 => eOR k (eval_f e1) (eval_f e2) | @NOT k e => eNOT k (eval_f e) | @IMPL k f1 _ f2 => eIMPL k (eval_f f1) (eval_f f2) | @IFF k f1 f2 => eIFF k (eval_f f1) (eval_f f2) | EQ f1 f2 => (eval_f f1) = (eval_f f2) end. Proof. intros k f; destruct f ; reflexivity. Qed. End EVAL. Definition hold (k: kind) : rtyp k -> Prop := if k as k0 return (rtyp k0 -> Prop) then fun x => x else is_true. Definition eiff (k: kind) : rtyp k -> rtyp k -> Prop := if k as k' return rtyp k' -> rtyp k' -> Prop then iff else @eq bool. Lemma eiff_refl (k: kind) (x : rtyp k) : eiff k x x. Proof. destruct k ; simpl; tauto. Qed. Lemma eiff_sym k (x y : rtyp k) : eiff k x y -> eiff k y x. Proof. destruct k ; simpl; intros ; intuition. Qed. Lemma eiff_trans k (x y z : rtyp k) : eiff k x y -> eiff k y z -> eiff k x z. Proof. destruct k ; simpl; intros ; intuition congruence. Qed. Lemma hold_eiff (k: kind) (x y : rtyp k) : (hold k x <-> hold k y) <-> eiff k x y. Proof. destruct k ; simpl. - tauto. - unfold is_true. destruct x,y ; intuition congruence. Qed. Instance eiff_eq (k: kind) : Equivalence (eiff k). Proof. constructor. - exact (eiff_refl k). - exact (eiff_sym k). - exact (eiff_trans k). Qed. Add Parametric Morphism (k: kind) : (@eAND k) with signature eiff k ==> eiff k ==> eiff k as eAnd_morph. Proof. intros. destruct k ; simpl in *; intuition congruence. Qed. Add Parametric Morphism (k: kind) : (@eOR k) with signature eiff k ==> eiff k ==> eiff k as eOR_morph. Proof. intros. destruct k ; simpl in *; intuition congruence. Qed. Add Parametric Morphism (k: kind) : (@eIMPL k) with signature eiff k ==> eiff k ==> eiff k as eIMPL_morph. Proof. intros. destruct k ; simpl in *; intuition congruence. Qed. Add Parametric Morphism (k: kind) : (@eIFF k) with signature eiff k ==> eiff k ==> eiff k as eIFF_morph. Proof. intros. destruct k ; simpl in *; intuition congruence. Qed. Add Parametric Morphism (k: kind) : (@eNOT k) with signature eiff k ==> eiff k as eNOT_morph. Proof. intros. destruct k ; simpl in *; intuition congruence. Qed. Lemma eval_f_morph : forall (ev ev' : forall (k: kind), TA -> rtyp k), (forall k a, eiff k (ev k a) (ev' k a)) -> forall (k: kind)(f : GFormula k), (eiff k (eval_f ev f) (eval_f ev' f)). Proof. intros ev ev' H k f; induction f as [| | | |? ? IHf1 ? IHf2|? ? IHf1 ? IHf2|? ? IHf |? ? IHf1 ? ? IHf2|? ? IHf1 ? IHf2|]; simpl. - reflexivity. - reflexivity. - reflexivity. - apply H. - rewrite IHf1. rewrite IHf2. reflexivity. - rewrite IHf1. rewrite IHf2. reflexivity. - rewrite IHf. reflexivity. - rewrite IHf1. rewrite IHf2. reflexivity. - rewrite IHf1. rewrite IHf2. reflexivity. - simpl in *. intuition congruence. Qed. End S. (** Typical boolean formulae *) Definition eKind (k: kind) := if k then Prop else bool. Register eKind as micromega.eKind. Definition BFormula (A : Type) := @GFormula A eKind unit unit. Register BFormula as micromega.BFormula.type. Section MAPATOMS. Context {TA TA':Type}. Context {TX : kind -> Type}. Context {AA : Type}. Context {AF : Type}. Fixpoint map_bformula (k: kind)(fct : TA -> TA') (f : @GFormula TA TX AA AF k) : @GFormula TA' TX AA AF k:= match f with | TT k => TT k | FF k => FF k | X k p => X k p | A k a t => A k (fct a) t | AND f1 f2 => AND (map_bformula fct f1) (map_bformula fct f2) | OR f1 f2 => OR (map_bformula fct f1) (map_bformula fct f2) | NOT f => NOT (map_bformula fct f) | IMPL f1 a f2 => IMPL (map_bformula fct f1) a (map_bformula fct f2) | IFF f1 f2 => IFF (map_bformula fct f1) (map_bformula fct f2) | EQ f1 f2 => EQ (map_bformula fct f1) (map_bformula fct f2) end. End MAPATOMS. Lemma map_simpl : forall A B f l, @map A B f l = match l with | nil => nil | a :: l=> (f a) :: (@map A B f l) end. Proof. intros A B f l; destruct l ; reflexivity. Qed. Section S. (** A cnf tracking annotations of atoms. *) (** Type parameters *) Variable Env : Type. Variable Term : Type. Variable Term' : Type. Variable Annot : Type. Local Notation Trace := (Trace Annot). Variable unsat : Term' -> bool. (* see [unsat_prop] *) Variable deduce : Term' -> Term' -> option Term'. (* see [deduce_prop] *) Local Notation null := (@null Annot). Local Notation push := (@push Annot). Local Notation merge := (@merge Annot). Definition clause := list (Term' * Annot). Definition cnf := list clause. Variable normalise : Term -> Annot -> cnf. Variable negate : Term -> Annot -> cnf. Definition cnf_tt : cnf := @nil clause. Definition cnf_ff : cnf := cons (@nil (Term' * Annot)) nil. (** Our cnf is optimised and detects contradictions on the fly. *) Fixpoint add_term (t: Term' * Annot) (cl : clause) : option clause := match cl with | nil => match deduce (fst t) (fst t) with | None => Some (t ::nil) | Some u => if unsat u then None else Some (t::nil) end | t'::cl => match deduce (fst t) (fst t') with | None => match add_term t cl with | None => None | Some cl' => Some (t' :: cl') end | Some u => if unsat u then None else match add_term t cl with | None => None | Some cl' => Some (t' :: cl') end end end. Fixpoint or_clause (cl1 cl2 : clause) : option clause := match cl1 with | nil => Some cl2 | t::cl => match add_term t cl2 with | None => None | Some cl' => or_clause cl cl' end end. Definition xor_clause_cnf (t:clause) (f:cnf) : cnf := List.fold_left (fun acc e => match or_clause t e with | None => acc | Some cl => cl :: acc end) f nil . Definition or_clause_cnf (t: clause) (f:cnf) : cnf := match t with | nil => f | _ => xor_clause_cnf t f end. Fixpoint or_cnf (f : cnf) (f' : cnf) {struct f}: cnf := match f with | nil => cnf_tt | e :: rst => (or_cnf rst f') +++ (or_clause_cnf e f') end. Definition and_cnf (f1 : cnf) (f2 : cnf) : cnf := f1 +++ f2. (** TX is Prop in Coq and EConstr.constr in Ocaml. AF is unit in Coq and Names.Id.t in Ocaml *) Definition TFormula (TX: kind -> Type) (AF: Type) := @GFormula Term TX Annot AF. Definition is_cnf_tt (c : cnf) : bool := match c with | nil => true | _ => false end. Definition is_cnf_ff (c : cnf) : bool := match c with | nil::nil => true | _ => false end. Definition and_cnf_opt (f1 : cnf) (f2 : cnf) : cnf := if is_cnf_ff f1 || is_cnf_ff f2 then cnf_ff else if is_cnf_tt f2 then f1 else and_cnf f1 f2. Definition or_cnf_opt (f1 : cnf) (f2 : cnf) : cnf := if is_cnf_tt f1 || is_cnf_tt f2 then cnf_tt else if is_cnf_ff f2 then f1 else or_cnf f1 f2. Section REC. Context {TX : kind -> Type}. Context {AF : Type}. Variable REC : forall (pol : bool) (k: kind) (f : TFormula TX AF k), cnf. Definition mk_and (k: kind) (pol:bool) (f1 f2 : TFormula TX AF k):= (if pol then and_cnf_opt else or_cnf_opt) (REC pol f1) (REC pol f2). Definition mk_or (k: kind) (pol:bool) (f1 f2 : TFormula TX AF k):= (if pol then or_cnf_opt else and_cnf_opt) (REC pol f1) (REC pol f2). Definition mk_impl (k: kind) (pol:bool) (f1 f2 : TFormula TX AF k):= (if pol then or_cnf_opt else and_cnf_opt) (REC (negb pol) f1) (REC pol f2). Definition mk_iff (k: kind) (pol:bool) (f1 f2: TFormula TX AF k):= or_cnf_opt (and_cnf_opt (REC (negb pol) f1) (REC false f2)) (and_cnf_opt (REC pol f1) (REC true f2)). End REC. Definition is_bool {TX : kind -> Type} {AF: Type} (k: kind) (f : TFormula TX AF k) := match f with | TT _ => Some true | FF _ => Some false | _ => None end. Lemma is_bool_inv : forall {TX : kind -> Type} {AF: Type} (k: kind) (f : TFormula TX AF k) res, is_bool f = Some res -> f = if res then TT _ else FF _. Proof. intros TX AF k f res H. destruct f ; inversion H; reflexivity. Qed. Fixpoint xcnf {TX : kind -> Type} {AF: Type} (pol : bool) (k: kind) (f : TFormula TX AF k) {struct f}: cnf := match f with | TT _ => if pol then cnf_tt else cnf_ff | FF _ => if pol then cnf_ff else cnf_tt | X _ p => if pol then cnf_ff else cnf_ff (* This is not complete - cannot negate any proposition *) | A _ x t => if pol then normalise x t else negate x t | NOT e => xcnf (negb pol) e | AND e1 e2 => mk_and xcnf pol e1 e2 | OR e1 e2 => mk_or xcnf pol e1 e2 | IMPL e1 _ e2 => mk_impl xcnf pol e1 e2 | IFF e1 e2 => match is_bool e2 with | Some isb => xcnf (if isb then pol else negb pol) e1 | None => mk_iff xcnf pol e1 e2 end | EQ e1 e2 => match is_bool e2 with | Some isb => xcnf (if isb then pol else negb pol) e1 | None => mk_iff xcnf pol e1 e2 end end. Section CNFAnnot. (** Records annotations used to optimise the cnf. Those need to be kept when pruning the formula. For efficiency, this is a separate function. *) Fixpoint radd_term (t : Term' * Annot) (cl : clause) : clause + Trace := match cl with | nil => (* if t is unsat, the clause is empty BUT t is needed. *) match deduce (fst t) (fst t) with | Some u => if unsat u then inr (push (snd t) null) else inl (t::nil) | None => inl (t::nil) end | t'::cl => (* if t /\ t' is unsat, the clause is empty BUT t & t' are needed *) match deduce (fst t) (fst t') with | Some u => if unsat u then inr (push (snd t) (push (snd t') null)) else match radd_term t cl with | inl cl' => inl (t'::cl') | inr l => inr l end | None => match radd_term t cl with | inl cl' => inl (t'::cl') | inr l => inr l end end end. Fixpoint ror_clause cl1 cl2 := match cl1 with | nil => inl cl2 | t::cl => match radd_term t cl2 with | inl cl' => ror_clause cl cl' | inr l => inr l end end. Definition xror_clause_cnf t f := List.fold_left (fun '(acc,tg) e => match ror_clause t e with | inl cl => (cl :: acc,tg) | inr l => (acc,merge tg l) end) f (nil, null). Definition ror_clause_cnf t f := match t with | nil => (f, null) | _ => xror_clause_cnf t f end. Fixpoint ror_cnf (f f':list clause) := match f with | nil => (cnf_tt, null) | e :: rst => let (rst_f',t) := ror_cnf rst f' in let (e_f', t') := ror_clause_cnf e f' in (rst_f' +++ e_f', merge t t') end. Definition annot_of_clause (l : clause) : list Annot := List.map snd l. Definition annot_of_cnf (f : cnf) : list Annot := List.fold_left (fun acc e => annot_of_clause e +++ acc ) f nil. Definition ror_cnf_opt f1 f2 := if is_cnf_tt f1 then (cnf_tt, null) else if is_cnf_tt f2 then (cnf_tt, null) else if is_cnf_ff f2 then (f1, null) else ror_cnf f1 f2. Definition ocons {A : Type} (o : option A) (l : list A) : list A := match o with | None => l | Some e => e ::l end. Definition ratom (c : cnf) (a : Annot) : cnf * Trace := if is_cnf_ff c || is_cnf_tt c then (c,push a null) else (c,null). (* t is embedded in c *) Section REC. Context {TX : kind -> Type} {AF : Type}. Variable RXCNF : forall (polarity: bool) (k: kind) (f: TFormula TX AF k) , cnf * Trace. Definition rxcnf_and (polarity:bool) (k: kind) (e1 e2 : TFormula TX AF k) := let '(e1,t1) := RXCNF polarity e1 in let '(e2,t2) := RXCNF polarity e2 in if polarity then (and_cnf_opt e1 e2, merge t1 t2) else let (f',t') := ror_cnf_opt e1 e2 in (f', merge t1 (merge t2 t')). Definition rxcnf_or (polarity:bool) (k: kind) (e1 e2 : TFormula TX AF k) := let '(e1,t1) := RXCNF polarity e1 in let '(e2,t2) := RXCNF polarity e2 in if polarity then let (f',t') := ror_cnf_opt e1 e2 in (f', merge t1 (merge t2 t')) else (and_cnf_opt e1 e2, merge t1 t2). Definition rxcnf_impl (polarity:bool) (k: kind) (e1 e2 : TFormula TX AF k) := let '(e1 , t1) := (RXCNF (negb polarity) e1) in if polarity then if is_cnf_tt e1 then (e1,t1) else if is_cnf_ff e1 then RXCNF polarity e2 else (* compute disjunction *) let '(e2 , t2) := (RXCNF polarity e2) in let (f',t') := ror_cnf_opt e1 e2 in (f', merge t1 (merge t2 t')) (* record the hypothesis *) else let '(e2 , t2) := (RXCNF polarity e2) in (and_cnf_opt e1 e2, merge t1 t2). Definition rxcnf_iff (polarity:bool) (k: kind) (e1 e2 : TFormula TX AF k) := let '(c1,t1) := RXCNF (negb polarity) e1 in let '(c2,t2) := RXCNF false e2 in let '(c3,t3) := RXCNF polarity e1 in let '(c4,t4) := RXCNF true e2 in let (f',t') := ror_cnf_opt (and_cnf_opt c1 c2) (and_cnf_opt c3 c4) in (f', merge t1 (merge t2 (merge t3 (merge t4 t')))) . End REC. Fixpoint rxcnf {TX : kind -> Type} {AF: Type}(polarity : bool) (k: kind) (f : TFormula TX AF k) : cnf * Trace := match f with | TT _ => if polarity then (cnf_tt, null) else (cnf_ff, null) | FF _ => if polarity then (cnf_ff, null) else (cnf_tt, null) | X b p => if polarity then (cnf_ff, null) else (cnf_ff, null) | A _ x t => ratom (if polarity then normalise x t else negate x t) t | NOT e => rxcnf (negb polarity) e | AND e1 e2 => rxcnf_and rxcnf polarity e1 e2 | OR e1 e2 => rxcnf_or rxcnf polarity e1 e2 | IMPL e1 a e2 => rxcnf_impl rxcnf polarity e1 e2 | IFF e1 e2 => rxcnf_iff rxcnf polarity e1 e2 | EQ e1 e2 => rxcnf_iff rxcnf polarity e1 e2 end. Section Abstraction. Variable TX : kind -> Type. Variable AF : Type. Class to_constrT : Type := { mkTT : forall (k: kind), TX k; mkFF : forall (k: kind), TX k; mkA : forall (k: kind), Term -> Annot -> TX k; mkAND : forall (k: kind), TX k -> TX k -> TX k; mkOR : forall (k: kind), TX k -> TX k -> TX k; mkIMPL : forall (k: kind), TX k -> TX k -> TX k; mkIFF : forall (k: kind), TX k -> TX k -> TX k; mkNOT : forall (k: kind), TX k -> TX k; mkEQ : TX isBool -> TX isBool -> TX isProp }. Context {to_constr : to_constrT}. Fixpoint aformula (k: kind) (f : TFormula TX AF k) : TX k := match f with | TT b => mkTT b | FF b => mkFF b | X b p => p | A b x t => mkA b x t | AND f1 f2 => mkAND (aformula f1) (aformula f2) | OR f1 f2 => mkOR (aformula f1) (aformula f2) | IMPL f1 o f2 => mkIMPL (aformula f1) (aformula f2) | IFF f1 f2 => mkIFF (aformula f1) (aformula f2) | NOT f => mkNOT (aformula f) | EQ f1 f2 => mkEQ (aformula f1) (aformula f2) end. Definition is_X (k: kind) (f : TFormula TX AF k) : option (TX k) := match f with | X _ p => Some p | _ => None end. Definition is_X_inv : forall (k: kind) (f: TFormula TX AF k) x, is_X f = Some x -> f = X k x. Proof. intros k f; destruct f ; simpl ; try congruence. Qed. Variable needA : Annot -> bool. Definition abs_and (k: kind) (f1 f2 : TFormula TX AF k) (c : forall (k: kind), TFormula TX AF k -> TFormula TX AF k -> TFormula TX AF k) := match is_X f1 , is_X f2 with | Some _ , _ | _ , Some _ => X k (aformula (c k f1 f2)) | _ , _ => c k f1 f2 end. Definition abs_or (k: kind) (f1 f2 : TFormula TX AF k) (c : forall (k: kind), TFormula TX AF k -> TFormula TX AF k -> TFormula TX AF k) := match is_X f1 , is_X f2 with | Some _ , Some _ => X k (aformula (c k f1 f2)) | _ , _ => c k f1 f2 end. Definition abs_not (k: kind) (f1 : TFormula TX AF k) (c : forall (k: kind), TFormula TX AF k -> TFormula TX AF k) := match is_X f1 with | Some _ => X k (aformula (c k f1 )) | _ => c k f1 end. Definition mk_arrow (o : option AF) (k: kind) (f1 f2: TFormula TX AF k) := match o with | None => IMPL f1 None f2 | Some _ => if is_X f1 then f2 else IMPL f1 o f2 end. Fixpoint abst_simpl (k: kind) (f : TFormula TX AF k) : TFormula TX AF k:= match f with | TT k => TT k | FF k => FF k | X k p => X k p | A k x t => if needA t then A k x t else X k (mkA k x t) | AND f1 f2 => AND (abst_simpl f1) (abst_simpl f2) | OR f1 f2 => OR (abst_simpl f1) (abst_simpl f2) | IMPL f1 o f2 => IMPL (abst_simpl f1) o (abst_simpl f2) | NOT f => NOT (abst_simpl f) | IFF f1 f2 => IFF (abst_simpl f1) (abst_simpl f2) | EQ f1 f2 => EQ (abst_simpl f1) (abst_simpl f2) end. Section REC. Variable REC : forall (pol : bool) (k: kind) (f : TFormula TX AF k), TFormula TX AF k. Definition abst_and (pol : bool) (k: kind) (f1 f2:TFormula TX AF k) : TFormula TX AF k:= (if pol then abs_and else abs_or) k (REC pol f1) (REC pol f2) AND. Definition abst_or (pol : bool) (k: kind) (f1 f2:TFormula TX AF k) : TFormula TX AF k:= (if pol then abs_or else abs_and) k (REC pol f1) (REC pol f2) OR. Definition abst_impl (pol : bool) (o :option AF) (k: kind) (f1 f2:TFormula TX AF k) : TFormula TX AF k:= (if pol then abs_or else abs_and) k (REC (negb pol) f1) (REC pol f2) (mk_arrow o). Definition or_is_X (k: kind) (f1 f2: TFormula TX AF k) : bool := match is_X f1 , is_X f2 with | Some _ , _ | _ , Some _ => true | _ , _ => false end. Definition abs_iff (k: kind) (nf1 ff2 f1 tf2 : TFormula TX AF k) (r: kind) (def : TFormula TX AF r) : TFormula TX AF r := if andb (or_is_X nf1 ff2) (or_is_X f1 tf2) then X r (aformula def) else def. Definition abst_iff (pol : bool) (k: kind) (f1 f2: TFormula TX AF k) : TFormula TX AF k := abs_iff (REC (negb pol) f1) (REC false f2) (REC pol f1) (REC true f2) (IFF (abst_simpl f1) (abst_simpl f2)). Definition abst_eq (pol : bool) (f1 f2: TFormula TX AF isBool) : TFormula TX AF isProp := abs_iff (REC (negb pol) f1) (REC false f2) (REC pol f1) (REC true f2) (EQ (abst_simpl f1) (abst_simpl f2)). End REC. Fixpoint abst_form (pol : bool) (k: kind) (f : TFormula TX AF k) : TFormula TX AF k:= match f with | TT k => if pol then TT k else X k (mkTT k) | FF k => if pol then X k (mkFF k) else FF k | X k p => X k p | A k x t => if needA t then A k x t else X k (mkA k x t) | AND f1 f2 => abst_and abst_form pol f1 f2 | OR f1 f2 => abst_or abst_form pol f1 f2 | IMPL f1 o f2 => abst_impl abst_form pol o f1 f2 | NOT f => abs_not (abst_form (negb pol) f) NOT | IFF f1 f2 => abst_iff abst_form pol f1 f2 | EQ f1 f2 => abst_eq abst_form pol f1 f2 end. Lemma if_same : forall {A: Type} (b: bool) (t:A), (if b then t else t) = t. Proof. intros A b; destruct b ; reflexivity. Qed. Lemma is_cnf_tt_cnf_ff : is_cnf_tt cnf_ff = false. Proof. reflexivity. Qed. Lemma is_cnf_ff_cnf_ff : is_cnf_ff cnf_ff = true. Proof. reflexivity. Qed. Lemma is_cnf_tt_inv : forall f1, is_cnf_tt f1 = true -> f1 = cnf_tt. Proof. unfold cnf_tt. intros f1; destruct f1 ; simpl ; try congruence. Qed. Lemma is_cnf_ff_inv : forall f1, is_cnf_ff f1 = true -> f1 = cnf_ff. Proof. unfold cnf_ff. intros f1 ; destruct f1 as [|c f1] ; simpl ; try congruence. destruct c ; simpl ; try congruence. destruct f1 ; try congruence. reflexivity. Qed. Lemma if_cnf_tt : forall f, (if is_cnf_tt f then cnf_tt else f) = f. Proof. intros f. destruct (is_cnf_tt f) eqn:EQ. - apply is_cnf_tt_inv in EQ;auto. - reflexivity. Qed. Lemma or_cnf_opt_cnf_ff : forall f, or_cnf_opt cnf_ff f = f. Proof. intros f. unfold or_cnf_opt. rewrite is_cnf_tt_cnf_ff. simpl. destruct (is_cnf_tt f) eqn:EQ. - apply is_cnf_tt_inv in EQ. congruence. - destruct (is_cnf_ff f) eqn:EQ1. + apply is_cnf_ff_inv in EQ1. congruence. + reflexivity. Qed. Lemma abs_and_pol : forall (k: kind) (f1 f2: TFormula TX AF k) pol, and_cnf_opt (xcnf pol f1) (xcnf pol f2) = xcnf pol (abs_and f1 f2 (if pol then AND else OR)). Proof. unfold abs_and; intros k f1 f2 pol. destruct (is_X f1) eqn:EQ1. - apply is_X_inv in EQ1. subst. simpl. rewrite if_same. reflexivity. - destruct (is_X f2) eqn:EQ2. + apply is_X_inv in EQ2. subst. simpl. rewrite if_same. unfold and_cnf_opt. rewrite orb_comm. reflexivity. + destruct pol ; simpl; auto. Qed. Lemma abs_or_pol : forall (k: kind) (f1 f2:TFormula TX AF k) pol, or_cnf_opt (xcnf pol f1) (xcnf pol f2) = xcnf pol (abs_or f1 f2 (if pol then OR else AND)). Proof. unfold abs_or; intros k f1 f2 pol. destruct (is_X f1) eqn:EQ1. - apply is_X_inv in EQ1. subst. destruct (is_X f2) eqn:EQ2. + apply is_X_inv in EQ2. subst. simpl. rewrite if_same. reflexivity. + simpl. rewrite if_same. destruct pol ; simpl; auto. - destruct pol ; simpl ; auto. Qed. Variable needA_all : forall a, needA a = true. Lemma xcnf_true_mk_arrow_l : forall b o t (f:TFormula TX AF b), xcnf true (mk_arrow o (X b t) f) = xcnf true f. Proof. intros b o; destruct o ; simpl; auto. intros. rewrite or_cnf_opt_cnf_ff. reflexivity. Qed. Lemma or_cnf_opt_cnf_ff_r : forall f, or_cnf_opt f cnf_ff = f. Proof. unfold or_cnf_opt. intros. rewrite is_cnf_tt_cnf_ff. rewrite orb_comm. simpl. apply if_cnf_tt. Qed. Lemma xcnf_true_mk_arrow_r : forall b o t (f:TFormula TX AF b), xcnf true (mk_arrow o f (X b t)) = xcnf false f. Proof. intros b o; destruct o ; simpl; auto. - intros t f. destruct (is_X f) eqn:EQ. + apply is_X_inv in EQ. subst. reflexivity. + simpl. apply or_cnf_opt_cnf_ff_r. - intros. apply or_cnf_opt_cnf_ff_r. Qed. Lemma and_cnf_opt_cnf_ff_r : forall f, and_cnf_opt f cnf_ff = cnf_ff. Proof. intros. unfold and_cnf_opt. rewrite is_cnf_ff_cnf_ff. rewrite orb_comm. reflexivity. Qed. Lemma and_cnf_opt_cnf_ff : forall f, and_cnf_opt cnf_ff f = cnf_ff. Proof. intros. unfold and_cnf_opt. rewrite is_cnf_ff_cnf_ff. reflexivity. Qed. Lemma and_cnf_opt_cnf_tt : forall f, and_cnf_opt f cnf_tt = f. Proof. intros f. unfold and_cnf_opt. simpl. rewrite orb_comm. simpl. destruct (is_cnf_ff f) eqn:EQ ; auto. apply is_cnf_ff_inv in EQ. auto. Qed. Lemma is_bool_abst_simpl : forall b (f:TFormula TX AF b), is_bool (abst_simpl f) = is_bool f. Proof. intros b f; induction f ; simpl ; auto. rewrite needA_all. reflexivity. Qed. Lemma abst_simpl_correct : forall b (f:TFormula TX AF b) pol, xcnf pol f = xcnf pol (abst_simpl f). Proof. intros b f; induction f as [| | | |? ? IHf1 f2 IHf2|? ? IHf1 f2 IHf2 |? ? IHf|? ? IHf1 ? f2 IHf2|? ? IHf1 f2 IHf2|f1 IHf1 f2 IHf2]; simpl;intros; unfold mk_and,mk_or,mk_impl, mk_iff; rewrite <- ?IHf; try (rewrite <- !IHf1; rewrite <- !IHf2); try reflexivity. - rewrite needA_all. reflexivity. - rewrite is_bool_abst_simpl. destruct (is_bool f2); auto. - rewrite is_bool_abst_simpl. destruct (is_bool f2); auto. Qed. Ltac is_X t := match goal with | |-context[is_X ?X] => let f := fresh "EQ" in destruct (is_X X) as [t|] eqn:f ; [apply is_X_inv in f|] end. Ltac cnf_simpl := repeat match goal with | |- context[and_cnf_opt cnf_ff _ ] => rewrite and_cnf_opt_cnf_ff | |- context[and_cnf_opt _ cnf_ff] => rewrite and_cnf_opt_cnf_ff_r | |- context[and_cnf_opt _ cnf_tt] => rewrite and_cnf_opt_cnf_tt | |- context[or_cnf_opt cnf_ff _] => rewrite or_cnf_opt_cnf_ff | |- context[or_cnf_opt _ cnf_ff] => rewrite or_cnf_opt_cnf_ff_r end. Lemma or_is_X_inv : forall (k: kind) (f1 f2 : TFormula TX AF k), or_is_X f1 f2 = true -> exists k1, is_X f1 = Some k1 \/ is_X f2 = Some k1. Proof. unfold or_is_X. intros k f1 f2. is_X t; is_X t0. - exists t ; intuition. - exists t ; intuition. - exists t0 ; intuition. - congruence. Qed. Lemma mk_iff_is_bool : forall (k: kind) (f1 f2:TFormula TX AF k) pol, match is_bool f2 with | Some isb => xcnf (if isb then pol else negb pol) f1 | None => mk_iff xcnf pol f1 f2 end = mk_iff xcnf pol f1 f2. Proof. intros k f1 f2 pol. destruct (is_bool f2) as [b|] eqn:EQ; auto. apply is_bool_inv in EQ. subst. unfold mk_iff. destruct b ; simpl; cnf_simpl; reflexivity. Qed. Lemma abst_iff_correct : forall (k: kind) (f1 f2 : GFormula k) (IHf1 : forall pol : bool, xcnf pol f1 = xcnf pol (abst_form pol f1)) (IHf2 : forall pol : bool, xcnf pol f2 = xcnf pol (abst_form pol f2)) (pol : bool), xcnf pol (IFF f1 f2) = xcnf pol (abst_iff abst_form pol f1 f2). Proof. intros k f1 f2 IHf1 IHf2 pol; simpl. assert (D1 :mk_iff xcnf pol f1 f2 = mk_iff xcnf pol (abst_simpl f1) (abst_simpl f2)). { simpl. unfold mk_iff. rewrite <- !abst_simpl_correct. reflexivity. } rewrite mk_iff_is_bool. unfold abst_iff,abs_iff. destruct ( or_is_X (abst_form (negb pol) f1) (abst_form false f2) && or_is_X (abst_form pol f1) (abst_form true f2) ) eqn:EQ1. + simpl. rewrite andb_true_iff in EQ1. destruct EQ1 as (EQ1 & EQ2). apply or_is_X_inv in EQ1. apply or_is_X_inv in EQ2. destruct EQ1 as (b1 & EQ1). destruct EQ2 as (b2 & EQ2). rewrite if_same. unfold mk_iff. rewrite !IHf1. rewrite !IHf2. destruct EQ1 as [EQ1 | EQ1] ; apply is_X_inv in EQ1; destruct EQ2 as [EQ2 | EQ2] ; apply is_X_inv in EQ2; rewrite EQ1; rewrite EQ2; simpl; repeat rewrite if_same ; cnf_simpl; auto. + simpl. rewrite mk_iff_is_bool. unfold mk_iff. rewrite <- ! abst_simpl_correct. reflexivity. Qed. Lemma abst_eq_correct : forall (f1 f2 : GFormula isBool) (IHf1 : forall pol : bool, xcnf pol f1 = xcnf pol (abst_form pol f1)) (IHf2 : forall pol : bool, xcnf pol f2 = xcnf pol (abst_form pol f2)) (pol : bool), xcnf pol (EQ f1 f2) = xcnf pol (abst_form pol (EQ f1 f2)). Proof. intros f1 f2 IHf1 IHf2 pol. change (xcnf pol (IFF f1 f2) = xcnf pol (abst_form pol (EQ f1 f2))). rewrite abst_iff_correct by assumption. simpl. unfold abst_iff, abst_eq. unfold abs_iff. destruct (or_is_X (abst_form (negb pol) f1) (abst_form false f2) && or_is_X (abst_form pol f1) (abst_form true f2) ) ; auto. Qed. Lemma abst_form_correct : forall b (f:TFormula TX AF b) pol, xcnf pol f = xcnf pol (abst_form pol f). Proof. intros b f; induction f as [| | | |? ? IHf1 ? IHf2|? ? IHf1 ? IHf2|? f IHf |? f1 IHf1 o f2 IHf2|? IHf1 ? IHf2|]; intros pol. - simpl. destruct pol ; reflexivity. - simpl. destruct pol ; reflexivity. - simpl. reflexivity. - simpl. rewrite needA_all. reflexivity. - simpl. unfold mk_and. specialize (IHf1 pol). specialize (IHf2 pol). rewrite IHf1. rewrite IHf2. destruct pol. + apply abs_and_pol; auto. + apply abs_or_pol. - simpl. unfold mk_or. specialize (IHf1 pol). specialize (IHf2 pol). rewrite IHf1. rewrite IHf2. destruct pol. + apply abs_or_pol; auto. + apply abs_and_pol; auto. - simpl. unfold abs_not. specialize (IHf (negb pol)). destruct (is_X (abst_form (negb pol) f)) eqn:EQ1. + apply is_X_inv in EQ1. rewrite EQ1 in *. simpl in *. destruct pol ; auto. + simpl. congruence. - simpl. unfold mk_impl. specialize (IHf1 (negb pol)). specialize (IHf2 pol). destruct pol. + simpl in *. unfold abs_or. destruct (is_X (abst_form false f1)) eqn:EQ1; destruct (is_X (abst_form true f2)) eqn:EQ2 ; simpl. * apply is_X_inv in EQ1. apply is_X_inv in EQ2. rewrite EQ1 in *. rewrite EQ2 in *. rewrite IHf1. rewrite IHf2. simpl. reflexivity. * apply is_X_inv in EQ1. rewrite EQ1 in *. rewrite IHf1. simpl. rewrite xcnf_true_mk_arrow_l. rewrite or_cnf_opt_cnf_ff. congruence. * apply is_X_inv in EQ2. rewrite EQ2 in *. rewrite IHf2. simpl. rewrite xcnf_true_mk_arrow_r. rewrite or_cnf_opt_cnf_ff_r. congruence. * destruct o ; simpl ; try congruence. rewrite EQ1. simpl. congruence. + simpl in *. unfold abs_and. destruct (is_X (abst_form true f1)) eqn:EQ1; destruct (is_X (abst_form false f2)) eqn:EQ2 ; simpl. * apply is_X_inv in EQ1. apply is_X_inv in EQ2. rewrite EQ1 in *. rewrite EQ2 in *. rewrite IHf1. rewrite IHf2. simpl. reflexivity. * apply is_X_inv in EQ1. rewrite EQ1 in *. rewrite IHf1. simpl. reflexivity. * apply is_X_inv in EQ2. rewrite EQ2 in *. rewrite IHf2. simpl. unfold and_cnf_opt. rewrite orb_comm. reflexivity. * destruct o; simpl. -- rewrite EQ1. simpl. congruence. -- congruence. - apply abst_iff_correct; auto. - apply abst_eq_correct; auto. Qed. End Abstraction. End CNFAnnot. Lemma radd_term_term : forall a' a cl, radd_term a a' = inl cl -> add_term a a' = Some cl. Proof. intros a'; induction a' as [|a a' IHa']; simpl. - intros a cl H. destruct (deduce (fst a) (fst a)) as [t|]. + destruct (unsat t). * congruence. * inversion H. reflexivity. + inversion H ;reflexivity. - intros a0 cl H. destruct (deduce (fst a0) (fst a)) as [t|]. + destruct (unsat t). * congruence. * destruct (radd_term a0 a') eqn:RADD; try congruence. inversion H. subst. apply IHa' in RADD. rewrite RADD. reflexivity. + destruct (radd_term a0 a') eqn:RADD; try congruence. inversion H. subst. apply IHa' in RADD. rewrite RADD. reflexivity. Qed. Lemma radd_term_term' : forall a' a cl, add_term a a' = Some cl -> radd_term a a' = inl cl. Proof. intros a'; induction a' as [|a a' IHa']; simpl. - intros a cl H. destruct (deduce (fst a) (fst a)) as [t|]. + destruct (unsat t). * congruence. * inversion H. reflexivity. + inversion H ;reflexivity. - intros a0 cl H. destruct (deduce (fst a0) (fst a)) as [t|]. + destruct (unsat t). * congruence. * destruct (add_term a0 a') eqn:RADD; try congruence. inversion H. subst. apply IHa' in RADD. rewrite RADD. reflexivity. + destruct (add_term a0 a') eqn:RADD; try congruence. inversion H. subst. apply IHa' in RADD. rewrite RADD. reflexivity. Qed. Lemma xror_clause_clause : forall a f, fst (xror_clause_cnf a f) = xor_clause_cnf a f. Proof. unfold xror_clause_cnf. unfold xor_clause_cnf. assert (ACC: fst (@nil clause, null) = nil) by reflexivity. intros a f. set (F1:= (fun '(acc, tg) (e : clause) => match ror_clause a e with | inl cl => (cl :: acc, tg) | inr l => (acc, merge tg l) end)). set (F2:= (fun (acc : list clause) (e : clause) => match or_clause a e with | Some cl => cl :: acc | None => acc end)). revert ACC. generalize (@nil clause, null). generalize (@nil clause). induction f as [|a0 f IHf]; simpl ; auto. intros ? p ?. apply IHf. unfold F1 , F2. destruct p ; simpl in * ; subst. clear. revert a0. induction a as [|a a0 IHa]; simpl; auto. intros a1. destruct (radd_term a a1) eqn:RADD. - apply radd_term_term in RADD. rewrite RADD. auto. - destruct (add_term a a1) eqn:RADD'. + apply radd_term_term' in RADD'. congruence. + reflexivity. Qed. Lemma ror_clause_clause : forall a f, fst (ror_clause_cnf a f) = or_clause_cnf a f. Proof. unfold ror_clause_cnf,or_clause_cnf. intros a; destruct a ; auto. apply xror_clause_clause. Qed. Lemma ror_cnf_cnf : forall f1 f2, fst (ror_cnf f1 f2) = or_cnf f1 f2. Proof. intros f1; induction f1 as [|a f1 IHf1] ; simpl ; auto. intros f2. specialize (IHf1 f2). destruct(ror_cnf f1 f2). rewrite <- ror_clause_clause. destruct(ror_clause_cnf a f2). simpl. rewrite <- IHf1. reflexivity. Qed. Lemma ror_opt_cnf_cnf : forall f1 f2, fst (ror_cnf_opt f1 f2) = or_cnf_opt f1 f2. Proof. unfold ror_cnf_opt, or_cnf_opt. intros f1 f2. destruct (is_cnf_tt f1). - simpl ; auto. - simpl. destruct (is_cnf_tt f2) ; simpl ; auto. destruct (is_cnf_ff f2) eqn:EQ. + reflexivity. + apply ror_cnf_cnf. Qed. Lemma ratom_cnf : forall f a, fst (ratom f a) = f. Proof. unfold ratom. intros f a. destruct (is_cnf_ff f || is_cnf_tt f); auto. Qed. Lemma rxcnf_and_xcnf : forall {TX : kind -> Type} {AF:Type} (k: kind) (f1 f2:TFormula TX AF k) (IHf1 : forall pol : bool, fst (rxcnf pol f1) = xcnf pol f1) (IHf2 : forall pol : bool, fst (rxcnf pol f2) = xcnf pol f2), forall pol : bool, fst (rxcnf_and rxcnf pol f1 f2) = mk_and xcnf pol f1 f2. Proof. intros TX AF k f1 f2 IHf1 IHf2 pol. unfold mk_and, rxcnf_and. specialize (IHf1 pol). specialize (IHf2 pol). destruct (rxcnf pol f1). destruct (rxcnf pol f2). simpl in *. subst. destruct pol ; auto. rewrite <- ror_opt_cnf_cnf. destruct (ror_cnf_opt (xcnf false f1) (xcnf false f2)). reflexivity. Qed. Lemma rxcnf_or_xcnf : forall {TX : kind -> Type} {AF:Type} (k: kind) (f1 f2:TFormula TX AF k) (IHf1 : forall pol : bool, fst (rxcnf pol f1) = xcnf pol f1) (IHf2 : forall pol : bool, fst (rxcnf pol f2) = xcnf pol f2), forall pol : bool, fst (rxcnf_or rxcnf pol f1 f2) = mk_or xcnf pol f1 f2. Proof. intros TX AF k f1 f2 IHf1 IHf2 pol. unfold rxcnf_or, mk_or. specialize (IHf1 pol). specialize (IHf2 pol). destruct (rxcnf pol f1). destruct (rxcnf pol f2). simpl in *. subst. destruct pol ; auto. rewrite <- ror_opt_cnf_cnf. destruct (ror_cnf_opt (xcnf true f1) (xcnf true f2)). reflexivity. Qed. Lemma rxcnf_impl_xcnf : forall {TX : kind -> Type} {AF:Type} (k: kind) (f1 f2:TFormula TX AF k) (IHf1 : forall pol : bool, fst (rxcnf pol f1) = xcnf pol f1) (IHf2 : forall pol : bool, fst (rxcnf pol f2) = xcnf pol f2), forall pol : bool, fst (rxcnf_impl rxcnf pol f1 f2) = mk_impl xcnf pol f1 f2. Proof. intros TX AF k f1 f2 IHf1 IHf2 pol. unfold rxcnf_impl, mk_impl, mk_or. specialize (IHf1 (negb pol)). specialize (IHf2 pol). rewrite <- IHf1. rewrite <- IHf2. destruct (rxcnf (negb pol) f1). destruct (rxcnf pol f2). simpl in *. subst. destruct pol;auto. generalize (is_cnf_tt_inv (xcnf (negb true) f1)). destruct (is_cnf_tt (xcnf (negb true) f1)). + intros H. rewrite H by auto. reflexivity. + generalize (is_cnf_ff_inv (xcnf (negb true) f1)). destruct (is_cnf_ff (xcnf (negb true) f1)). * intros H. rewrite H by auto. unfold or_cnf_opt. simpl. destruct (is_cnf_tt (xcnf true f2)) eqn:EQ;auto. -- apply is_cnf_tt_inv in EQ; auto. -- destruct (is_cnf_ff (xcnf true f2)) eqn:EQ1. ++ apply is_cnf_ff_inv in EQ1. congruence. ++ reflexivity. * rewrite <- ror_opt_cnf_cnf. destruct (ror_cnf_opt (xcnf (negb true) f1) (xcnf true f2)). intros. reflexivity. Qed. Lemma rxcnf_iff_xcnf : forall {TX : kind -> Type} {AF:Type} (k: kind) (f1 f2:TFormula TX AF k) (IHf1 : forall pol : bool, fst (rxcnf pol f1) = xcnf pol f1) (IHf2 : forall pol : bool, fst (rxcnf pol f2) = xcnf pol f2), forall pol : bool, fst (rxcnf_iff rxcnf pol f1 f2) = mk_iff xcnf pol f1 f2. Proof. intros TX AF k f1 f2 IHf1 IHf2 pol. unfold rxcnf_iff. unfold mk_iff. rewrite <- (IHf1 (negb pol)). rewrite <- (IHf1 pol). rewrite <- (IHf2 false). rewrite <- (IHf2 true). destruct (rxcnf (negb pol) f1) as [c ?]. destruct (rxcnf false f2) as [c0 ?]. destruct (rxcnf pol f1) as [c1 ?]. destruct (rxcnf true f2) as [c2 ?]. destruct (ror_cnf_opt (and_cnf_opt c c0) (and_cnf_opt c1 c2)) as [c3 l3] eqn:EQ. simpl. change c3 with (fst (c3,l3)). rewrite <- EQ. rewrite ror_opt_cnf_cnf. reflexivity. Qed. Lemma rxcnf_xcnf : forall {TX : kind -> Type} {AF:Type} (k: kind) (f:TFormula TX AF k) pol, fst (rxcnf pol f) = xcnf pol f. Proof. intros TX AF k f; induction f ; simpl ; auto; intros pol. - destruct pol; simpl ; auto. - destruct pol; simpl ; auto. - destruct pol ; simpl ; auto. - intros. rewrite ratom_cnf. reflexivity. - apply rxcnf_and_xcnf; auto. - apply rxcnf_or_xcnf; auto. - apply rxcnf_impl_xcnf; auto. - intros. rewrite mk_iff_is_bool. apply rxcnf_iff_xcnf; auto. - intros. rewrite mk_iff_is_bool. apply rxcnf_iff_xcnf; auto. Qed. Variable eval' : Env -> Term' -> Prop. Variable no_middle_eval' : forall env d, (eval' env d) \/ ~ (eval' env d). Variable unsat_prop : forall t, unsat t = true -> forall env, eval' env t -> False. Variable deduce_prop : forall t t' u, deduce t t' = Some u -> forall env, eval' env t -> eval' env t' -> eval' env u. Definition eval_tt (env : Env) (tt : Term' * Annot) := eval' env (fst tt). Definition eval_clause (env : Env) (cl : clause) := ~ make_conj (eval_tt env) cl. Definition eval_cnf (env : Env) (f:cnf) := make_conj (eval_clause env) f. Lemma eval_cnf_app : forall env x y, eval_cnf env (x+++y) <-> eval_cnf env x /\ eval_cnf env y. Proof. unfold eval_cnf. intros. rewrite make_conj_rapp. rewrite make_conj_app ; auto. tauto. Qed. Lemma eval_cnf_ff : forall env, eval_cnf env cnf_ff <-> False. Proof using. clear. unfold cnf_ff, eval_cnf,eval_clause. simpl. tauto. Qed. Lemma eval_cnf_tt : forall env, eval_cnf env cnf_tt <-> True. Proof using. clear. unfold cnf_tt, eval_cnf,eval_clause. simpl. tauto. Qed. Lemma eval_cnf_and_opt : forall env x y, eval_cnf env (and_cnf_opt x y) <-> eval_cnf env (and_cnf x y). Proof. unfold and_cnf_opt. intros env x y. destruct (is_cnf_ff x) eqn:F1. { apply is_cnf_ff_inv in F1. simpl. subst. unfold and_cnf. rewrite eval_cnf_app. rewrite eval_cnf_ff. tauto. } simpl. destruct (is_cnf_ff y) eqn:F2. { apply is_cnf_ff_inv in F2. simpl. subst. unfold and_cnf. rewrite eval_cnf_app. rewrite eval_cnf_ff. tauto. } destruct (is_cnf_tt y) eqn:F3. { apply is_cnf_tt_inv in F3. subst. unfold and_cnf. rewrite eval_cnf_app. rewrite eval_cnf_tt. tauto. } tauto. Qed. Definition eval_opt_clause (env : Env) (cl: option clause) := match cl with | None => True | Some cl => eval_clause env cl end. Lemma add_term_correct : forall env t cl , eval_opt_clause env (add_term t cl) <-> eval_clause env (t::cl). Proof. intros env t cl; induction cl as [|a cl IHcl]. - (* BC *) simpl. case_eq (deduce (fst t) (fst t)) ; try tauto. intros t0 H. generalize (@deduce_prop _ _ _ H env). case_eq (unsat t0) ; try tauto. { intros H0 ?. generalize (@unsat_prop _ H0 env). unfold eval_clause. rewrite make_conj_cons. simpl; intros. tauto. } - (* IC *) simpl. case_eq (deduce (fst t) (fst a)); intros t0; [intros H|]. + generalize (@deduce_prop _ _ _ H env). case_eq (unsat t0); intros H0 H1. { generalize (@unsat_prop _ H0 env). simpl. unfold eval_clause. repeat rewrite make_conj_cons. tauto. } destruct (add_term t cl) ; simpl in * ; try tauto. { intros. unfold eval_clause in *. repeat rewrite make_conj_cons in *. tauto. } { unfold eval_clause in *. repeat rewrite make_conj_cons in *. tauto. } + destruct (add_term t cl) ; simpl in *; unfold eval_clause in * ; repeat rewrite make_conj_cons in *; tauto. Qed. Lemma no_middle_eval_tt : forall env a, eval_tt env a \/ ~ eval_tt env a. Proof. unfold eval_tt. auto. Qed. #[local] Hint Resolve no_middle_eval_tt : tauto. Lemma or_clause_correct : forall cl cl' env, eval_opt_clause env (or_clause cl cl') <-> eval_clause env cl \/ eval_clause env cl'. Proof. intros cl; induction cl as [|a cl IHcl]. - simpl. unfold eval_clause at 2. simpl. tauto. - intros cl' env. simpl. assert (HH := add_term_correct env a cl'). assert (eval_tt env a \/ ~ eval_tt env a) by (apply no_middle_eval'). destruct (add_term a cl'); simpl in *. + rewrite IHcl. unfold eval_clause in *. rewrite !make_conj_cons in *. tauto. + unfold eval_clause in *. repeat rewrite make_conj_cons in *. tauto. Qed. Lemma or_clause_cnf_correct : forall env t f, eval_cnf env (or_clause_cnf t f) <-> (eval_clause env t) \/ (eval_cnf env f). Proof. unfold eval_cnf. unfold or_clause_cnf. intros env t. set (F := (fun (acc : list clause) (e : clause) => match or_clause t e with | Some cl => cl :: acc | None => acc end)). intro f. assert ( make_conj (eval_clause env) (fold_left F f nil) <-> (eval_clause env t \/ make_conj (eval_clause env) f) /\ make_conj (eval_clause env) nil) as H. { generalize (@nil clause) as acc. induction f as [|a f IHf]. - simpl. intros ; tauto. - intros. simpl fold_left. rewrite IHf. rewrite make_conj_cons. unfold F in *; clear F. generalize (or_clause_correct t a env). destruct (or_clause t a). + rewrite make_conj_cons. simpl. tauto. + simpl. tauto. } destruct t ; auto. - unfold eval_clause ; simpl. tauto. - unfold xor_clause_cnf. unfold F in H. rewrite H. unfold make_conj at 2. tauto. Qed. Lemma eval_cnf_cons : forall env a f, (~ make_conj (eval_tt env) a /\ eval_cnf env f) <-> eval_cnf env (a::f). Proof. intros. unfold eval_cnf in *. rewrite make_conj_cons ; eauto. unfold eval_clause at 2. tauto. Qed. Lemma eval_cnf_cons_iff : forall env a f, ((~ make_conj (eval_tt env) a) /\ eval_cnf env f) <-> eval_cnf env (a::f). Proof using. intros; clear. unfold eval_cnf in *. rewrite make_conj_cons ; eauto. unfold eval_clause. tauto. Qed. Lemma or_cnf_correct : forall env f f', eval_cnf env (or_cnf f f') <-> (eval_cnf env f) \/ (eval_cnf env f'). Proof. intros env f; induction f as [|a f IHf]. - unfold eval_cnf. simpl. tauto. (**) - intros. simpl. rewrite eval_cnf_app. rewrite <- eval_cnf_cons_iff. rewrite IHf. rewrite or_clause_cnf_correct. unfold eval_clause. tauto. Qed. Lemma or_cnf_opt_correct : forall env f f', eval_cnf env (or_cnf_opt f f') <-> eval_cnf env (or_cnf f f'). Proof. unfold or_cnf_opt. intros env f f'. destruct (is_cnf_tt f) eqn:TF. { simpl. apply is_cnf_tt_inv in TF. subst. rewrite or_cnf_correct. rewrite eval_cnf_tt. tauto. } destruct (is_cnf_tt f') eqn:TF'. { simpl. apply is_cnf_tt_inv in TF'. subst. rewrite or_cnf_correct. rewrite eval_cnf_tt. tauto. } { simpl. destruct (is_cnf_ff f') eqn:EQ. - apply is_cnf_ff_inv in EQ. subst. rewrite or_cnf_correct. rewrite eval_cnf_ff. tauto. - tauto. } Qed. Variable eval : Env -> forall (k: kind), Term -> rtyp k. Variable normalise_correct : forall env b t tg, eval_cnf env (normalise t tg) -> hold b (eval env b t). Variable negate_correct : forall env b t tg, eval_cnf env (negate t tg) -> hold b (eNOT b (eval env b t)). Definition e_rtyp (k: kind) (x : rtyp k) : rtyp k := x. Lemma hold_eTT : forall k, hold k (eTT k). Proof. intros k; destruct k ; simpl; auto. Qed. #[local] Hint Resolve hold_eTT : tauto. Lemma hold_eFF : forall k, hold k (eNOT k (eFF k)). Proof. intros k; destruct k ; simpl;auto. Qed. #[local] Hint Resolve hold_eFF : tauto. Lemma hold_eAND : forall k r1 r2, hold k (eAND k r1 r2) <-> (hold k r1 /\ hold k r2). Proof. intros k; destruct k ; simpl. - intros. apply iff_refl. - apply andb_true_iff. Qed. Lemma hold_eOR : forall k r1 r2, hold k (eOR k r1 r2) <-> (hold k r1 \/ hold k r2). Proof. intros k; destruct k ; simpl. - intros. apply iff_refl. - apply orb_true_iff. Qed. Lemma hold_eNOT : forall k e, hold k (eNOT k e) <-> not (hold k e). Proof. intros k; destruct k ; simpl. - intros. apply iff_refl. - intros e. unfold is_true. rewrite negb_true_iff. destruct e ; intuition congruence. Qed. Lemma hold_eIMPL : forall k e1 e2, hold k (eIMPL k e1 e2) <-> (hold k e1 -> hold k e2). Proof. intros k; destruct k ; simpl. - intros. apply iff_refl. - intros e1 e2. unfold is_true. destruct e1,e2 ; simpl ; intuition congruence. Qed. Lemma hold_eIFF : forall k e1 e2, hold k (eIFF k e1 e2) <-> (hold k e1 <-> hold k e2). Proof. intros k; destruct k ; simpl. - intros. apply iff_refl. - intros e1 e2. unfold is_true. rewrite eqb_true_iff. destruct e1,e2 ; simpl ; intuition congruence. Qed. Lemma xcnf_impl : forall (k: kind) (f1 : GFormula k) (o : option unit) (f2 : GFormula k) (IHf1 : forall (pol : bool) (env : Env), eval_cnf env (xcnf pol f1) -> hold k (eval_f e_rtyp (eval env) (if pol then f1 else NOT f1))) (IHf2 : forall (pol : bool) (env : Env), eval_cnf env (xcnf pol f2) -> hold k (eval_f e_rtyp (eval env) (if pol then f2 else NOT f2))), forall (pol : bool) (env : Env), eval_cnf env (xcnf pol (IMPL f1 o f2)) -> hold k (eval_f e_rtyp (eval env) (if pol then IMPL f1 o f2 else NOT (IMPL f1 o f2))). Proof. simpl; intros k f1 o f2 IHf1 IHf2 pol env H. unfold mk_impl in H. destruct pol. + simpl. rewrite hold_eIMPL. intro. rewrite or_cnf_opt_correct in H. rewrite or_cnf_correct in H. destruct H as [H | H]. * generalize (IHf1 _ _ H). simpl in *. rewrite hold_eNOT. tauto. * generalize (IHf2 _ _ H). auto. + (* pol = false *) rewrite eval_cnf_and_opt in H. unfold and_cnf in H. simpl in H. rewrite eval_cnf_app in H. destruct H as [H0 H1]. generalize (IHf1 _ _ H0). generalize (IHf2 _ _ H1). simpl. rewrite ! hold_eNOT. rewrite ! hold_eIMPL. tauto. Qed. Lemma hold_eIFF_IMPL : forall k e1 e2, hold k (eIFF k e1 e2) <-> (hold k (eAND k (eIMPL k e1 e2) (eIMPL k e2 e1))). Proof. intros. rewrite hold_eIFF. rewrite hold_eAND. rewrite! hold_eIMPL. tauto. Qed. Lemma hold_eEQ : forall e1 e2, hold isBool (eIFF isBool e1 e2) <-> e1 = e2. Proof. simpl. intros e1 e2; destruct e1,e2 ; simpl ; intuition congruence. Qed. Lemma xcnf_iff : forall (k : kind) (f1 f2 : @GFormula Term rtyp Annot unit k) (IHf1 : forall (pol : bool) (env : Env), eval_cnf env (xcnf pol f1) -> hold k (eval_f e_rtyp (eval env) (if pol then f1 else NOT f1))) (IHf2 : forall (pol : bool) (env : Env), eval_cnf env (xcnf pol f2) -> hold k (eval_f e_rtyp (eval env) (if pol then f2 else NOT f2))), forall (pol : bool) (env : Env), eval_cnf env (xcnf pol (IFF f1 f2)) -> hold k (eval_f e_rtyp (eval env) (if pol then IFF f1 f2 else NOT (IFF f1 f2))). Proof. simpl. intros k f1 f2 IHf1 IHf2 pol env H. rewrite mk_iff_is_bool in H. unfold mk_iff in H. destruct pol; rewrite or_cnf_opt_correct in H; rewrite or_cnf_correct in H; rewrite! eval_cnf_and_opt in H; unfold and_cnf in H; rewrite! eval_cnf_app in H; generalize (IHf1 false env); generalize (IHf1 true env); generalize (IHf2 false env); generalize (IHf2 true env); simpl. - rewrite hold_eIFF_IMPL. rewrite hold_eAND. rewrite! hold_eIMPL. rewrite! hold_eNOT. tauto. - rewrite! hold_eNOT. rewrite hold_eIFF_IMPL. rewrite hold_eAND. rewrite! hold_eIMPL. tauto. Qed. Lemma xcnf_correct : forall (k: kind) (f : @GFormula Term rtyp Annot unit k) pol env, eval_cnf env (xcnf pol f) -> hold k (eval_f e_rtyp (eval env) (if pol then f else NOT f)). Proof. intros k f; induction f as [| | | |? ? IHf1 ? IHf2|? ? IHf1 ? IHf2|? ? IHf |? ? IHf1 ? ? IHf2|? ? IHf1 f2 IHf2|f1 IHf1 f2 IHf2]; intros pol env H. - (* TT *) unfold eval_cnf. simpl. destruct pol ; intros; simpl; auto with tauto. rewrite eval_cnf_ff in H. tauto. - (* FF *) destruct pol ; simpl in *; intros; auto with tauto. + rewrite eval_cnf_ff in H. tauto. - (* P *) simpl. destruct pol ; intros ;simpl. + rewrite eval_cnf_ff in H. tauto. + rewrite eval_cnf_ff in H. tauto. - (* A *) simpl. destruct pol ; simpl. + intros. eapply normalise_correct ; eauto. + (* A 2 *) intros. eapply negate_correct ; eauto. - (* AND *) destruct pol ; simpl in H. + (* pol = true *) intros. rewrite eval_cnf_and_opt in H. unfold and_cnf in H. rewrite eval_cnf_app in H. destruct H as [H H0]. apply hold_eAND; split. * apply (IHf1 _ _ H). * apply (IHf2 _ _ H0). + (* pol = false *) intros. apply hold_eNOT. rewrite hold_eAND. rewrite or_cnf_opt_correct in H. rewrite or_cnf_correct in H. destruct H as [H | H]. * generalize (IHf1 false env H). simpl. rewrite hold_eNOT. tauto. * generalize (IHf2 false env H). simpl. rewrite hold_eNOT. tauto. - (* OR *) simpl in H. destruct pol. + (* pol = true *) intros. unfold mk_or in H. rewrite or_cnf_opt_correct in H. rewrite or_cnf_correct in H. destruct H as [H | H]. * generalize (IHf1 _ env H). simpl. rewrite hold_eOR. tauto. * generalize (IHf2 _ env H). simpl. rewrite hold_eOR. tauto. + (* pol = true *) intros. unfold mk_or in H. rewrite eval_cnf_and_opt in H. unfold and_cnf. rewrite eval_cnf_app in H. destruct H as [H0 H1]. simpl. generalize (IHf1 _ _ H0). generalize (IHf2 _ _ H1). simpl. rewrite ! hold_eNOT. rewrite ! hold_eOR. tauto. - (**) simpl. destruct pol ; simpl. + intros. apply (IHf false) ; auto. + intros. generalize (IHf _ _ H). rewrite ! hold_eNOT. tauto. - (* IMPL *) apply xcnf_impl; auto. - apply xcnf_iff ; auto. - simpl in H. destruct (is_bool f2) as [b|] eqn:EQ. + apply is_bool_inv in EQ. destruct b; subst; intros; apply IHf1 in H; destruct pol ; simpl in * ; auto. * unfold is_true in H. rewrite negb_true_iff in H. congruence. * unfold is_true in H. rewrite negb_true_iff in H. congruence. * unfold is_true in H. congruence. + intros. rewrite <- mk_iff_is_bool in H. apply xcnf_iff in H; auto. simpl in H. destruct pol ; simpl in *. * rewrite <- hold_eEQ. simpl; auto. * rewrite <- hold_eEQ. simpl; auto. unfold is_true in *. rewrite negb_true_iff in H. congruence. Qed. Variable Witness : Type. Variable checker : list (Term'*Annot) -> Witness -> bool. Variable checker_sound : forall t w, checker t w = true -> forall env, make_impl (eval_tt env) t False. Fixpoint cnf_checker (f : cnf) (l : list Witness) {struct f}: bool := match f with | nil => true | e::f => match l with | nil => false | c::l => match checker e c with | true => cnf_checker f l | _ => false end end end. Lemma cnf_checker_sound : forall t w, cnf_checker t w = true -> forall env, eval_cnf env t. Proof. unfold eval_cnf. intros t; induction t as [|a t IHt]. - (* bc *) simpl. auto. - (* ic *) simpl. intros w; destruct w as [|w ?]. + intros ; discriminate. + case_eq (checker a w) ; intros H H0 env ** ; try discriminate. generalize (@checker_sound _ _ H env). generalize (IHt _ H0 env) ; intros H1 H2. destruct t. * red ; intro. rewrite <- make_conj_impl in H2. tauto. * rewrite <- make_conj_impl in H2. tauto. Qed. Definition tauto_checker (f:@GFormula Term rtyp Annot unit isProp) (w:list Witness) : bool := cnf_checker (xcnf true f) w. Lemma tauto_checker_sound : forall t w, tauto_checker t w = true -> forall env, eval_f e_rtyp (eval env) t. Proof. unfold tauto_checker. intros t w H env. change (eval_f e_rtyp (eval env) t) with (eval_f e_rtyp (eval env) (if true then t else TT isProp)). apply (xcnf_correct t true). eapply cnf_checker_sound ; eauto. Qed. Definition eval_bf {A : Type} (ea : forall (k: kind), A -> rtyp k) (k: kind) (f: BFormula A k) := eval_f e_rtyp ea f. Lemma eval_bf_map : forall T U (fct: T-> U) env (k: kind) (f:BFormula T k) , eval_bf env (map_bformula fct f) = eval_bf (fun b x => env b (fct x)) f. Proof. intros T U fct env k f; induction f as [| | | |? ? IHf1 ? IHf2|? ? IHf1 ? IHf2|? ? IHf |? ? IHf1 ? ? IHf2|? ? IHf1 ? IHf2|? IHf1 ? IHf2]; simpl ; try (rewrite IHf1 ; rewrite IHf2) ; auto. rewrite <- IHf. auto. Qed. End S. (* Local Variables: *) (* coding: utf-8 *) (* End: *) coq-8.20.0/theories/micromega/VarMap.v000066400000000000000000000055671466560755400175640ustar00rootroot00000000000000(* -*- coding: utf-8 -*- *) (************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* t | Branch : t -> A -> t -> t . Arguments t : clear implicits. Register Branch as micromega.VarMap.Branch. Register Elt as micromega.VarMap.Elt. Register Empty as micromega.VarMap.Empty. Register t as micromega.VarMap.type. Section MakeVarMap. Variable A : Type. Variable default : A. Notation t := (t A). Fixpoint find (vm : t) (p:positive) {struct vm} : A := match vm with | Empty => default | Elt i => i | Branch l e r => match p with | xH => e | xO p => find l p | xI p => find r p end end. Fixpoint singleton (x:positive) (v : A) : t := match x with | xH => Elt v | xO p => Branch (singleton p v) default Empty | xI p => Branch Empty default (singleton p v) end. Fixpoint vm_add (x: positive) (v : A) (m : t) {struct m} : t := match m with | Empty => singleton x v | Elt vl => match x with | xH => Elt v | xO p => Branch (singleton p v) vl Empty | xI p => Branch Empty vl (singleton p v) end | Branch l o r => match x with | xH => Branch l v r | xI p => Branch l o (vm_add p v r) | xO p => Branch (vm_add p v l) o r end end. End MakeVarMap. (* TODO #14736 for compatibility only, should be removed after deprecation *) coq-8.20.0/theories/micromega/ZArith_hints.v000066400000000000000000000042571466560755400207770ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* nat) => abstract lia: zarith. #[global] Hint Extern 10 (_ <= _) => abstract lia: zarith. #[global] Hint Extern 10 (_ < _) => abstract lia: zarith. #[global] Hint Extern 10 (_ >= _) => abstract lia: zarith. #[global] Hint Extern 10 (_ > _) => abstract lia: zarith. #[global] Hint Extern 10 (_ <> _ :>nat) => abstract lia: zarith. #[global] Hint Extern 10 (~ _ <= _) => abstract lia: zarith. #[global] Hint Extern 10 (~ _ < _) => abstract lia: zarith. #[global] Hint Extern 10 (~ _ >= _) => abstract lia: zarith. #[global] Hint Extern 10 (~ _ > _) => abstract lia: zarith. #[global] Hint Extern 10 (_ = _ :>Z) => abstract lia: zarith. #[global] Hint Extern 10 (_ <= _)%Z => abstract lia: zarith. #[global] Hint Extern 10 (_ < _)%Z => abstract lia: zarith. #[global] Hint Extern 10 (_ >= _)%Z => abstract lia: zarith. #[global] Hint Extern 10 (_ > _)%Z => abstract lia: zarith. #[global] Hint Extern 10 (_ <> _ :>Z) => abstract lia: zarith. #[global] Hint Extern 10 (~ (_ <= _)%Z) => abstract lia: zarith. #[global] Hint Extern 10 (~ (_ < _)%Z) => abstract lia: zarith. #[global] Hint Extern 10 (~ (_ >= _)%Z) => abstract lia: zarith. #[global] Hint Extern 10 (~ (_ > _)%Z) => abstract lia: zarith. #[global] Hint Extern 10 False => abstract lia: zarith. coq-8.20.0/theories/micromega/ZCoeff.v000066400000000000000000000127571466560755400175510ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* R -> R. Variable ropp : R -> R. Variables req rle rlt : R -> R -> Prop. Variable sor : SOR rO rI rplus rtimes rminus ropp req rle rlt. Notation "0" := rO. Notation "1" := rI. Notation "x + y" := (rplus x y). Notation "x * y " := (rtimes x y). Notation "x - y " := (rminus x y). Notation "- x" := (ropp x). Notation "x == y" := (req x y). Notation "x ~= y" := (~ req x y). Notation "x <= y" := (rle x y). Notation "x < y" := (rlt x y). Lemma req_refl : forall x, req x x. Proof. destruct (SORsetoid sor) as (Equivalence_Reflexive,_,_). apply Equivalence_Reflexive. Qed. Lemma req_sym : forall x y, req x y -> req y x. Proof. destruct (SORsetoid sor) as (_,Equivalence_Symmetric,_). apply Equivalence_Symmetric. Qed. Lemma req_trans : forall x y z, req x y -> req y z -> req x z. Proof. destruct (SORsetoid sor) as (_,_,Equivalence_Transitive). apply Equivalence_Transitive. Qed. Add Relation R req reflexivity proved by (@Equivalence_Reflexive _ _ (SORsetoid sor)) symmetry proved by (@Equivalence_Symmetric _ _ (SORsetoid sor)) transitivity proved by (@Equivalence_Transitive _ _ (SORsetoid sor)) as sor_setoid. Add Morphism rplus with signature req ==> req ==> req as rplus_morph. Proof. exact (SORplus_wd sor). Qed. Add Morphism rtimes with signature req ==> req ==> req as rtimes_morph. Proof. exact (SORtimes_wd sor). Qed. Add Morphism ropp with signature req ==> req as ropp_morph. Proof. exact (SORopp_wd sor). Qed. Add Morphism rle with signature req ==> req ==> iff as rle_morph. Proof. exact (SORle_wd sor). Qed. Add Morphism rlt with signature req ==> req ==> iff as rlt_morph. Proof. exact (SORlt_wd sor). Qed. Add Morphism rminus with signature req ==> req ==> req as rminus_morph. Proof. exact (rminus_morph sor). Qed. Ltac le_less := rewrite (Rle_lt_eq sor); left; try assumption. Ltac le_equal := rewrite (Rle_lt_eq sor); right; try reflexivity; try assumption. Definition gen_order_phi_Z : Z -> R := gen_phiZ 0 1 rplus rtimes ropp. Declare Equivalent Keys gen_order_phi_Z gen_phiZ. Notation phi_pos := (gen_phiPOS 1 rplus rtimes). Notation phi_pos1 := (gen_phiPOS1 1 rplus rtimes). Notation "[ x ]" := (gen_order_phi_Z x). Lemma ring_ops_wd : ring_eq_ext rplus rtimes ropp req. Proof. constructor. - exact rplus_morph. - exact rtimes_morph. - exact ropp_morph. Qed. Lemma Zring_morph : ring_morph 0 1 rplus rtimes rminus ropp req 0%Z 1%Z Z.add Z.mul Z.sub Z.opp Zeq_bool gen_order_phi_Z. Proof. exact (gen_phiZ_morph (SORsetoid sor) ring_ops_wd (SORrt sor)). Qed. Lemma phi_pos1_pos : forall x : positive, 0 < phi_pos1 x. Proof. intros x; induction x as [x IH | x IH |]; simpl; try apply (Rplus_pos_pos sor); try apply (Rtimes_pos_pos sor); try apply (Rplus_pos_pos sor); try apply (Rlt_0_1 sor); assumption. Qed. Lemma phi_pos1_succ : forall x : positive, phi_pos1 (Pos.succ x) == 1 + phi_pos1 x. Proof. exact (ARgen_phiPOS_Psucc (SORsetoid sor) ring_ops_wd (Rth_ARth (SORsetoid sor) ring_ops_wd (SORrt sor))). Qed. Lemma clt_pos_morph : forall x y : positive, (x < y)%positive -> phi_pos1 x < phi_pos1 y. Proof. intros x y H. pattern y; apply Pos.lt_ind with x. - rewrite phi_pos1_succ; apply (Rlt_succ_r sor). - clear y H; intros y _ H. rewrite phi_pos1_succ. now apply (Rlt_lt_succ sor). - assumption. Qed. Lemma clt_morph : forall x y : Z, (x < y)%Z -> [x] < [y]. Proof. intros x y H. do 2 rewrite (same_genZ (SORsetoid sor) ring_ops_wd (SORrt sor)); destruct x; destruct y; simpl in *; try discriminate. - apply phi_pos1_pos. - now apply clt_pos_morph. - apply <- (Ropp_neg_pos sor); apply phi_pos1_pos. - apply (Rlt_trans sor) with 0. + apply <- (Ropp_neg_pos sor); apply phi_pos1_pos. + apply phi_pos1_pos. - apply -> (Ropp_lt_mono sor); apply clt_pos_morph. red. now rewrite Pos.compare_antisym. Qed. Lemma Zcleb_morph : forall x y : Z, Z.leb x y = true -> [x] <= [y]. Proof. unfold Z.leb; intros x y H. case_eq (x ?= y)%Z; intro H1; rewrite H1 in H. - le_equal. apply (morph_eq Zring_morph). unfold Zeq_bool; now rewrite H1. - le_less. now apply clt_morph. - discriminate. Qed. Lemma Zcneqb_morph : forall x y : Z, Zeq_bool x y = false -> [x] ~= [y]. Proof. intros x y H. unfold Zeq_bool in H. case_eq (Z.compare x y); intro H1; rewrite H1 in *; (discriminate || clear H). - apply (Rlt_neq sor). now apply clt_morph. - fold (x > y)%Z in H1. rewrite Z.gt_lt_iff in H1. apply (Rneq_symm sor). apply (Rlt_neq sor). now apply clt_morph. Qed. End InitialMorphism. coq-8.20.0/theories/micromega/ZMicromega.v000066400000000000000000001607741466560755400204350ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* destruct (andb_prop _ _ id); clear id | [ id : (_ || _)%bool = true |- _ ] => destruct (orb_prop _ _ id); clear id end. Ltac inv H := inversion H ; try subst ; clear H. Lemma eq_le_iff : forall x, 0 = x <-> (0 <= x /\ x <= 0). Proof. intros. split ; intros H. - subst. compute. intuition congruence. - destruct H. apply Z.le_antisymm; auto. Qed. Lemma lt_le_iff : forall x, 0 < x <-> 0 <= x - 1. Proof. split ; intros H. - apply Zlt_succ_le. ring_simplify. auto. - apply Zle_lt_succ in H. ring_simplify in H. auto. Qed. Lemma le_0_iff : forall x y, x <= y <-> 0 <= y - x. Proof. split ; intros. - apply Zle_minus_le_0; auto. - apply Zle_0_minus_le; auto. Qed. Lemma le_neg : forall x, ((0 <= x) -> False) <-> 0 < -x. Proof. intro. rewrite lt_le_iff. split ; intros H. - apply Znot_le_gt in H. apply Zgt_le_succ in H. rewrite le_0_iff in H. ring_simplify in H; auto. - intro H0. assert (C := (Z.add_le_mono _ _ _ _ H H0)). ring_simplify in C. compute in C. apply C ; reflexivity. Qed. Lemma eq_cnf : forall x, (0 <= x - 1 -> False) /\ (0 <= -1 - x -> False) <-> x = 0. Proof. intros x. rewrite Z.eq_sym_iff. rewrite eq_le_iff. rewrite (le_0_iff x 0). rewrite !le_neg. rewrite !lt_le_iff. replace (- (x - 1) -1) with (-x) by ring. replace (- (-1 - x) -1) with x by ring. split ; intros (H1 & H2); auto. Qed. Require Import EnvRing. Lemma Zsor : SOR 0 1 Z.add Z.mul Z.sub Z.opp (@eq Z) Z.le Z.lt. Proof. constructor ; intros ; subst; try reflexivity. - apply Zsth. - apply Zth. - auto using Z.le_antisymm. - eauto using Z.le_trans. - apply Z.le_neq. - apply Z.lt_trichotomy. - apply Z.add_le_mono_l; assumption. - apply Z.mul_pos_pos ; auto. - discriminate. Qed. Lemma ZSORaddon : SORaddon 0 1 Z.add Z.mul Z.sub Z.opp (@eq Z) Z.le (* ring elements *) 0%Z 1%Z Z.add Z.mul Z.sub Z.opp (* coefficients *) Zeq_bool Z.leb (fun x => x) (fun x => x) (pow_N 1 Z.mul). Proof. constructor. - constructor ; intros ; try reflexivity. apply Zeq_bool_eq ; auto. - constructor. reflexivity. - intros x y. apply Zeq_bool_neq ; auto. - apply Zle_bool_imp_le. Qed. Fixpoint Zeval_expr (env : PolEnv Z) (e: PExpr Z) : Z := match e with | PEc c => c | PEX x => env x | PEadd e1 e2 => Zeval_expr env e1 + Zeval_expr env e2 | PEmul e1 e2 => Zeval_expr env e1 * Zeval_expr env e2 | PEpow e1 n => Z.pow (Zeval_expr env e1) (Z.of_N n) | PEsub e1 e2 => (Zeval_expr env e1) - (Zeval_expr env e2) | PEopp e => Z.opp (Zeval_expr env e) end. Strategy expand [ Zeval_expr ]. Definition eval_expr := eval_pexpr Z.add Z.mul Z.sub Z.opp (fun x => x) (fun x => x) (pow_N 1 Z.mul). Fixpoint Zeval_const (e: PExpr Z) : option Z := match e with | PEc c => Some c | PEX x => None | PEadd e1 e2 => map_option2 (fun x y => Some (x + y)) (Zeval_const e1) (Zeval_const e2) | PEmul e1 e2 => map_option2 (fun x y => Some (x * y)) (Zeval_const e1) (Zeval_const e2) | PEpow e1 n => map_option (fun x => Some (Z.pow x (Z.of_N n))) (Zeval_const e1) | PEsub e1 e2 => map_option2 (fun x y => Some (x - y)) (Zeval_const e1) (Zeval_const e2) | PEopp e => map_option (fun x => Some (Z.opp x)) (Zeval_const e) end. Lemma ZNpower : forall r n, r ^ Z.of_N n = pow_N 1 Z.mul r n. Proof. intros r n; destruct n as [|p]. - reflexivity. - simpl. unfold Z.pow_pos. replace (pow_pos Z.mul r p) with (1 * (pow_pos Z.mul r p)) by ring. generalize 1. induction p as [p IHp|p IHp|]; simpl ; intros ; repeat rewrite IHp ; ring. Qed. Lemma Zeval_expr_compat : forall env e, Zeval_expr env e = eval_expr env e. Proof. intros env e; induction e ; simpl ; try congruence. - reflexivity. - rewrite ZNpower. congruence. Qed. Definition Zeval_pop2 (o : Op2) : Z -> Z -> Prop := match o with | OpEq => @eq Z | OpNEq => fun x y => ~ x = y | OpLe => Z.le | OpGe => Z.ge | OpLt => Z.lt | OpGt => Z.gt end. Definition Zeval_bop2 (o : Op2) : Z -> Z -> bool := match o with | OpEq => Z.eqb | OpNEq => fun x y => negb (Z.eqb x y) | OpLe => Z.leb | OpGe => Z.geb | OpLt => Z.ltb | OpGt => Z.gtb end. Lemma pop2_bop2 : forall (op : Op2) (q1 q2 : Z), is_true (Zeval_bop2 op q1 q2) <-> Zeval_pop2 op q1 q2. Proof. unfold is_true. intro op; destruct op ; simpl; intros q1 q2. - apply Z.eqb_eq. - rewrite <- Z.eqb_eq. rewrite negb_true_iff. destruct (q1 =? q2) ; intuition congruence. - apply Z.leb_le. - rewrite Z.geb_le. rewrite Z.ge_le_iff. tauto. - apply Z.ltb_lt. - rewrite <- Zgt_is_gt_bool; tauto. Qed. Definition Zeval_op2 (k: Tauto.kind) : Op2 -> Z -> Z -> Tauto.rtyp k:= if k as k0 return (Op2 -> Z -> Z -> Tauto.rtyp k0) then Zeval_pop2 else Zeval_bop2. Lemma Zeval_op2_hold : forall k op q1 q2, Tauto.hold k (Zeval_op2 k op q1 q2) <-> Zeval_pop2 op q1 q2. Proof. intro k; destruct k. - simpl ; tauto. - simpl. apply pop2_bop2. Qed. Definition Zeval_formula (env : PolEnv Z) (k: Tauto.kind) (f : Formula Z):= let (lhs, op, rhs) := f in (Zeval_op2 k op) (Zeval_expr env lhs) (Zeval_expr env rhs). Definition Zeval_formula' := eval_formula Z.add Z.mul Z.sub Z.opp (@eq Z) Z.le Z.lt (fun x => x) (fun x => x) (pow_N 1 Z.mul). Lemma Zeval_formula_compat : forall env k f, Tauto.hold k (Zeval_formula env k f) <-> Zeval_formula env Tauto.isProp f. Proof. intros env k; destruct k ; simpl. - tauto. - intros f; destruct f ; simpl. rewrite <- (Zeval_op2_hold Tauto.isBool). simpl. tauto. Qed. Lemma Zeval_formula_compat' : forall env f, Zeval_formula env Tauto.isProp f <-> Zeval_formula' env f. Proof. intros env f. unfold Zeval_formula. destruct f as [Flhs Fop Frhs]. repeat rewrite Zeval_expr_compat. unfold Zeval_formula' ; simpl. unfold eval_expr. generalize (eval_pexpr Z.add Z.mul Z.sub Z.opp (fun x : Z => x) (fun x : N => x) (pow_N 1 Z.mul) env Flhs). generalize ((eval_pexpr Z.add Z.mul Z.sub Z.opp (fun x : Z => x) (fun x : N => x) (pow_N 1 Z.mul) env Frhs)). destruct Fop ; simpl; intros; intuition auto using Z.le_ge, Z.ge_le, Z.lt_gt, Z.gt_lt. Qed. Definition eval_nformula := eval_nformula 0 Z.add Z.mul (@eq Z) Z.le Z.lt (fun x => x) . Definition Zeval_op1 (o : Op1) : Z -> Prop := match o with | Equal => fun x : Z => x = 0 | NonEqual => fun x : Z => x <> 0 | Strict => fun x : Z => 0 < x | NonStrict => fun x : Z => 0 <= x end. Lemma Zeval_nformula_dec : forall env d, (eval_nformula env d) \/ ~ (eval_nformula env d). Proof. intros. apply (eval_nformula_dec Zsor). Qed. Definition ZWitness := Psatz Z. Definition ZWeakChecker := check_normalised_formulas 0 1 Z.add Z.mul Zeq_bool Z.leb. Lemma ZWeakChecker_sound : forall (l : list (NFormula Z)) (cm : ZWitness), ZWeakChecker l cm = true -> forall env, make_impl (eval_nformula env) l False. Proof. intros l cm H. intro. unfold eval_nformula. apply (checker_nf_sound Zsor ZSORaddon l cm). unfold ZWeakChecker in H. exact H. Qed. Definition psub := psub Z0 Z.add Z.sub Z.opp Zeq_bool. Declare Equivalent Keys psub RingMicromega.psub. Definition popp := popp Z.opp. Declare Equivalent Keys popp RingMicromega.popp. Definition padd := padd Z0 Z.add Zeq_bool. Declare Equivalent Keys padd RingMicromega.padd. Definition pmul := pmul 0 1 Z.add Z.mul Zeq_bool. Definition normZ := norm 0 1 Z.add Z.mul Z.sub Z.opp Zeq_bool. Declare Equivalent Keys normZ RingMicromega.norm. Definition eval_pol := eval_pol Z.add Z.mul (fun x => x). Declare Equivalent Keys eval_pol RingMicromega.eval_pol. Lemma eval_pol_sub : forall env lhs rhs, eval_pol env (psub lhs rhs) = eval_pol env lhs - eval_pol env rhs. Proof. intros. apply (eval_pol_sub Zsor ZSORaddon). Qed. Lemma eval_pol_add : forall env lhs rhs, eval_pol env (padd lhs rhs) = eval_pol env lhs + eval_pol env rhs. Proof. intros. apply (eval_pol_add Zsor ZSORaddon). Qed. Lemma eval_pol_mul : forall env lhs rhs, eval_pol env (pmul lhs rhs) = eval_pol env lhs * eval_pol env rhs. Proof. intros. apply (eval_pol_mul Zsor ZSORaddon). Qed. Lemma eval_pol_norm : forall env e, eval_expr env e = eval_pol env (normZ e) . Proof. intros. apply (eval_pol_norm Zsor ZSORaddon). Qed. Definition Zunsat := check_inconsistent 0 Zeq_bool Z.leb. Definition Zdeduce := nformula_plus_nformula 0 Z.add Zeq_bool. Lemma Zunsat_sound : forall f, Zunsat f = true -> forall env, eval_nformula env f -> False. Proof. unfold Zunsat. intros f H env ?. destruct f. eapply check_inconsistent_sound with (1 := Zsor) (2 := ZSORaddon) in H; eauto. Qed. Definition xnnormalise (t : Formula Z) : NFormula Z := let (lhs,o,rhs) := t in let lhs := normZ lhs in let rhs := normZ rhs in match o with | OpEq => (psub rhs lhs, Equal) | OpNEq => (psub rhs lhs, NonEqual) | OpGt => (psub lhs rhs, Strict) | OpLt => (psub rhs lhs, Strict) | OpGe => (psub lhs rhs, NonStrict) | OpLe => (psub rhs lhs, NonStrict) end. Lemma xnnormalise_correct : forall env f, eval_nformula env (xnnormalise f) <-> Zeval_formula env Tauto.isProp f. Proof. intros env f. rewrite Zeval_formula_compat'. unfold xnnormalise. destruct f as [lhs o rhs]. destruct o eqn:O ; cbn ; rewrite ?eval_pol_sub; rewrite <- !eval_pol_norm ; simpl in *; unfold eval_expr; generalize ( eval_pexpr Z.add Z.mul Z.sub Z.opp (fun x : Z => x) (fun x : N => x) (pow_N 1 Z.mul) env lhs); generalize (eval_pexpr Z.add Z.mul Z.sub Z.opp (fun x : Z => x) (fun x : N => x) (pow_N 1 Z.mul) env rhs); intros z z0. - split ; intros. + assert (z0 + (z - z0) = z0 + 0) as H0 by congruence. rewrite Z.add_0_r in H0. rewrite <- H0. ring. + subst. ring. - split ; intros H H0. + subst. apply H. ring. + apply H. assert (z0 + (z - z0) = z0 + 0) as H1 by congruence. rewrite Z.add_0_r in H1. rewrite <- H1. ring. - split ; intros. + apply Zle_0_minus_le; auto. + apply Zle_minus_le_0; auto. - split ; intros. + apply Zle_0_minus_le; auto. + apply Zle_minus_le_0; auto. - split ; intros H. + apply Zlt_0_minus_lt; auto. + apply Zlt_left_lt in H. apply H. - split ; intros H. + apply Zlt_0_minus_lt ; auto. + apply Zlt_left_lt in H. apply H. Qed. Definition xnormalise (f: NFormula Z) : list (NFormula Z) := let (e,o) := f in match o with | Equal => (psub e (Pc 1),NonStrict) :: (psub (Pc (-1)) e, NonStrict) :: nil | NonStrict => ((psub (Pc (-1)) e,NonStrict)::nil) | Strict => ((psub (Pc 0)) e, NonStrict)::nil | NonEqual => (e, Equal)::nil end. Lemma eval_pol_Pc : forall env z, eval_pol env (Pc z) = z. Proof. reflexivity. Qed. Ltac iff_ring := match goal with | |- ?F 0 ?X <-> ?F 0 ?Y => replace X with Y by ring ; tauto end. Lemma xnormalise_correct : forall env f, (make_conj (fun x => eval_nformula env x -> False) (xnormalise f)) <-> eval_nformula env f. Proof. intros env f. destruct f as [e o]; destruct o eqn:Op; cbn - [psub]; repeat rewrite eval_pol_sub; fold eval_pol; repeat rewrite eval_pol_Pc; generalize (eval_pol env e) as x; intro. - apply eq_cnf. - unfold not. tauto. - rewrite le_neg. iff_ring. - rewrite le_neg. rewrite lt_le_iff. iff_ring. Qed. Require Import Coq.micromega.Tauto BinNums. Definition cnf_of_list {T: Type} (tg : T) (l : list (NFormula Z)) := List.fold_right (fun x acc => if Zunsat x then acc else ((x,tg)::nil)::acc) (cnf_tt _ _) l. Lemma cnf_of_list_correct : forall {T : Type} (tg:T) (f : list (NFormula Z)) env, eval_cnf eval_nformula env (cnf_of_list tg f) <-> make_conj (fun x : NFormula Z => eval_nformula env x -> False) f. Proof. unfold cnf_of_list. intros T tg f env. set (F := (fun (x : NFormula Z) (acc : list (list (NFormula Z * T))) => if Zunsat x then acc else ((x, tg) :: nil) :: acc)). set (E := ((fun x : NFormula Z => eval_nformula env x -> False))). induction f as [|a f IHf]. - compute. tauto. - rewrite make_conj_cons. simpl. unfold F at 1. destruct (Zunsat a) eqn:EQ. + rewrite IHf. unfold E at 1. specialize (Zunsat_sound _ EQ env). tauto. + rewrite <- eval_cnf_cons_iff. rewrite IHf. simpl. unfold E at 2. unfold eval_tt. simpl. tauto. Qed. Definition normalise {T : Type} (t:Formula Z) (tg:T) : cnf (NFormula Z) T := let f := xnnormalise t in if Zunsat f then cnf_ff _ _ else cnf_of_list tg (xnormalise f). Lemma normalise_correct : forall (T: Type) env t (tg:T), eval_cnf eval_nformula env (normalise t tg) <-> Zeval_formula env Tauto.isProp t. Proof. intros T env t tg. rewrite <- xnnormalise_correct. unfold normalise. generalize (xnnormalise t) as f;intro f. destruct (Zunsat f) eqn:U. - assert (US := Zunsat_sound _ U env). rewrite eval_cnf_ff. tauto. - rewrite cnf_of_list_correct. apply xnormalise_correct. Qed. Definition xnegate (f:NFormula Z) : list (NFormula Z) := let (e,o) := f in match o with | Equal => (e,Equal) :: nil | NonEqual => (psub e (Pc 1),NonStrict) :: (psub (Pc (-1)) e, NonStrict) :: nil | NonStrict => (e,NonStrict)::nil | Strict => (psub e (Pc 1),NonStrict)::nil end. Definition negate {T : Type} (t:Formula Z) (tg:T) : cnf (NFormula Z) T := let f := xnnormalise t in if Zunsat f then cnf_tt _ _ else cnf_of_list tg (xnegate f). Lemma xnegate_correct : forall env f, (make_conj (fun x => eval_nformula env x -> False) (xnegate f)) <-> ~ eval_nformula env f. Proof. intros env f. destruct f as [e o]; destruct o eqn:Op; cbn - [psub]; repeat rewrite eval_pol_sub; fold eval_pol; repeat rewrite eval_pol_Pc; generalize (eval_pol env e) as x; intro x. - tauto. - rewrite eq_cnf. destruct (Z.eq_decidable x 0);tauto. - rewrite lt_le_iff. tauto. - tauto. Qed. Lemma negate_correct : forall T env t (tg:T), eval_cnf eval_nformula env (negate t tg) <-> ~ Zeval_formula env Tauto.isProp t. Proof. intros T env t tg. rewrite <- xnnormalise_correct. unfold negate. generalize (xnnormalise t) as f;intro f. destruct (Zunsat f) eqn:U. - assert (US := Zunsat_sound _ U env). rewrite eval_cnf_tt. tauto. - rewrite cnf_of_list_correct. apply xnegate_correct. Qed. Definition cnfZ (Annot: Type) (TX : Tauto.kind -> Type) (AF : Type) (k: Tauto.kind) (f : TFormula (Formula Z) Annot TX AF k) := rxcnf Zunsat Zdeduce normalise negate true f. Definition ZweakTautoChecker (w: list ZWitness) (f : BFormula (Formula Z) Tauto.isProp) : bool := @tauto_checker (Formula Z) (NFormula Z) unit Zunsat Zdeduce normalise negate ZWitness (fun cl => ZWeakChecker (List.map fst cl)) f w. (* To get a complete checker, the proof format has to be enriched *) Require Import Zdiv. Local Open Scope Z_scope. Definition ceiling (a b:Z) : Z := let (q,r) := Z.div_eucl a b in match r with | Z0 => q | _ => q + 1 end. Require Import Znumtheory. Lemma Zdivide_ceiling : forall a b, (b | a) -> ceiling a b = Z.div a b. Proof. unfold ceiling. intros a b H. apply Zdivide_mod in H. case_eq (Z.div_eucl a b). intros z z0 H0. change z with (fst (z,z0)). rewrite <- H0. change (fst (Z.div_eucl a b)) with (Z.div a b). change z0 with (snd (z,z0)). rewrite <- H0. change (snd (Z.div_eucl a b)) with (Z.modulo a b). rewrite H. reflexivity. Qed. Lemma narrow_interval_lower_bound a b x : a > 0 -> a * x >= b -> x >= ceiling b a. Proof. rewrite !Z.ge_le_iff. unfold ceiling. intros Ha H. generalize (Z_div_mod b a Ha). destruct (Z.div_eucl b a) as (q,r). intros (->,(H1,H2)). destruct r as [|r|r]. - rewrite Z.add_0_r in H. apply Z.mul_le_mono_pos_l in H; auto with zarith. - assert (0 < Z.pos r) by easy. rewrite Z.add_1_r, Z.le_succ_l. apply Z.mul_lt_mono_pos_l with a. + auto using Z.gt_lt. + eapply Z.lt_le_trans. 2: eassumption. now apply Z.lt_add_pos_r. - now elim H1. Qed. (** NB: narrow_interval_upper_bound is Zdiv.Zdiv_le_lower_bound *) Require Import QArith. Inductive ZArithProof := | DoneProof | RatProof : ZWitness -> ZArithProof -> ZArithProof | CutProof : ZWitness -> ZArithProof -> ZArithProof | SplitProof : PolC Z -> ZArithProof -> ZArithProof -> ZArithProof | EnumProof : ZWitness -> ZWitness -> list ZArithProof -> ZArithProof | ExProof : positive -> ZArithProof -> ZArithProof (*ExProof x : exists z t, x = z - t /\ z >= 0 /\ t >= 0 *) . Register ZArithProof as micromega.ZArithProof.type. Register DoneProof as micromega.ZArithProof.DoneProof. Register RatProof as micromega.ZArithProof.RatProof. Register CutProof as micromega.ZArithProof.CutProof. Register SplitProof as micromega.ZArithProof.SplitProof. Register EnumProof as micromega.ZArithProof.EnumProof. Register ExProof as micromega.ZArithProof.ExProof. (* In order to compute the 'cut', we need to express a polynomial P as a * Q + b. - b is the constant - a is the gcd of the other coefficient. *) Require Import Znumtheory. Definition isZ0 (x:Z) := match x with | Z0 => true | _ => false end. Lemma isZ0_0 : forall x, isZ0 x = true <-> x = 0. Proof. intros x; destruct x ; simpl ; intuition congruence. Qed. Lemma isZ0_n0 : forall x, isZ0 x = false <-> x <> 0. Proof. intros x; destruct x ; simpl ; intuition congruence. Qed. Definition ZgcdM (x y : Z) := Z.max (Z.gcd x y) 1. Fixpoint Zgcd_pol (p : PolC Z) : (Z * Z) := match p with | Pc c => (0,c) | Pinj _ p => Zgcd_pol p | PX p _ q => let (g1,c1) := Zgcd_pol p in let (g2,c2) := Zgcd_pol q in (ZgcdM (ZgcdM g1 c1) g2 , c2) end. (*Eval compute in (Zgcd_pol ((PX (Pc (-2)) 1 (Pc 4)))).*) Fixpoint Zdiv_pol (p:PolC Z) (x:Z) : PolC Z := match p with | Pc c => Pc (Z.div c x) | Pinj j p => Pinj j (Zdiv_pol p x) | PX p j q => PX (Zdiv_pol p x) j (Zdiv_pol q x) end. Inductive Zdivide_pol (x:Z): PolC Z -> Prop := | Zdiv_Pc : forall c, (x | c) -> Zdivide_pol x (Pc c) | Zdiv_Pinj : forall p, Zdivide_pol x p -> forall j, Zdivide_pol x (Pinj j p) | Zdiv_PX : forall p q, Zdivide_pol x p -> Zdivide_pol x q -> forall j, Zdivide_pol x (PX p j q). Lemma Zdiv_pol_correct : forall a p, 0 < a -> Zdivide_pol a p -> forall env, eval_pol env p = a * eval_pol env (Zdiv_pol p a). Proof. intros a p H H0. induction H0 as [? ?|? ? IHZdivide_pol j|? ? ? IHZdivide_pol1 ? IHZdivide_pol2 j]. - (* Pc *) simpl. intros. apply Zdivide_Zdiv_eq ; auto. - (* Pinj *) simpl. intros. apply IHZdivide_pol. - (* PX *) simpl. intros. rewrite IHZdivide_pol1. rewrite IHZdivide_pol2. ring. Qed. Lemma Zgcd_pol_ge : forall p, fst (Zgcd_pol p) >= 0. Proof. intros p; induction p as [c|p p1 IHp1|p1 IHp1 ? p3 IHp3]. 1-2: easy. simpl. case_eq (Zgcd_pol p1). case_eq (Zgcd_pol p3). intros. simpl. unfold ZgcdM. apply Z.le_ge; transitivity 1. - easy. - apply Z.le_max_r. Qed. Lemma Zdivide_pol_Zdivide : forall p x y, Zdivide_pol x p -> (y | x) -> Zdivide_pol y p. Proof. intros p x y H H0. induction H. - constructor. apply Z.divide_trans with (1:= H0) ; assumption. - constructor. auto. - constructor ; auto. Qed. Lemma Zdivide_pol_one : forall p, Zdivide_pol 1 p. Proof. intros p; induction p as [c| |]; constructor ; auto. exists c. ring. Qed. Lemma Zgcd_minus : forall a b c, (a | c - b ) -> (Z.gcd a b | c). Proof. intros a b c (q,Hq). destruct (Zgcd_is_gcd a b) as [(a',Ha) (b',Hb) _]. set (g:=Z.gcd a b) in *; clearbody g. exists (q * a' + b'). symmetry in Hq. rewrite <- Z.add_move_r in Hq. rewrite <- Hq, Hb, Ha. ring. Qed. Lemma Zdivide_pol_sub : forall p a b, 0 < Z.gcd a b -> Zdivide_pol a (PsubC Z.sub p b) -> Zdivide_pol (Z.gcd a b) p. Proof. intros p; induction p as [c|? p IHp|p ? ? ? IHp2]. - simpl. intros a b H H0. inversion H0. constructor. apply Zgcd_minus ; auto. - intros ? ? H H0. constructor. simpl in H0. inversion H0 ; subst; clear H0. apply IHp ; auto. - simpl. intros a b H H0. inv H0. constructor. + apply Zdivide_pol_Zdivide with (1:= (ltac:(assumption) : Zdivide_pol a p)). destruct (Zgcd_is_gcd a b) ; assumption. + apply IHp2 ; assumption. Qed. Lemma Zdivide_pol_sub_0 : forall p a, Zdivide_pol a (PsubC Z.sub p 0) -> Zdivide_pol a p. Proof. intros p; induction p as [c|? p IHp|? IHp1 ? ? IHp2]. - simpl. intros ? H. inversion H. constructor. rewrite Z.sub_0_r in *. assumption. - intros ? H. constructor. simpl in H. inversion H ; subst; clear H. apply IHp ; auto. - simpl. intros ? H. inv H. constructor. + auto. + apply IHp2 ; assumption. Qed. Lemma Zgcd_pol_div : forall p g c, Zgcd_pol p = (g, c) -> Zdivide_pol g (PsubC Z.sub p c). Proof. intros p; induction p as [c|? ? IHp|p1 IHp1 ? p3 IHp2]; simpl. - (* Pc *) intros ? ? H. inv H. constructor. exists 0. now ring. - (* Pinj *) intros. constructor. apply IHp ; auto. - (* PX *) intros g c. case_eq (Zgcd_pol p1) ; case_eq (Zgcd_pol p3) ; intros z z0 H z1 z2 H0 H1. inv H1. unfold ZgcdM at 1. destruct (Zmax_spec (Z.gcd (ZgcdM z1 z2) z) 1) as [HH1 | HH1]; destruct HH1 as [HH1 HH1'] ; rewrite HH1'. + constructor. * apply (Zdivide_pol_Zdivide _ (ZgcdM z1 z2)). -- unfold ZgcdM. destruct (Zmax_spec (Z.gcd z1 z2) 1) as [HH2 | HH2]. ++ destruct HH2 as [H1 H2]. rewrite H2. apply Zdivide_pol_sub ; auto. apply Z.lt_le_trans with 1. ** reflexivity. ** now apply Z.ge_le. ++ destruct HH2 as [H1 H2]. rewrite H2. apply Zdivide_pol_one. -- unfold ZgcdM in HH1. unfold ZgcdM. destruct (Zmax_spec (Z.gcd z1 z2) 1) as [HH2 | HH2]. ++ destruct HH2 as [H1 H2]. rewrite H2 in *. destruct (Zgcd_is_gcd (Z.gcd z1 z2) z); auto. ++ destruct HH2 as [H1 H2]. rewrite H2. destruct (Zgcd_is_gcd 1 z); auto. * apply (Zdivide_pol_Zdivide _ z). -- apply (IHp2 _ _ H); auto. -- destruct (Zgcd_is_gcd (ZgcdM z1 z2) z); auto. + constructor. * apply Zdivide_pol_one. * apply Zdivide_pol_one. Qed. Lemma Zgcd_pol_correct_lt : forall p env g c, Zgcd_pol p = (g,c) -> 0 < g -> eval_pol env p = g * (eval_pol env (Zdiv_pol (PsubC Z.sub p c) g)) + c. Proof. intros. rewrite <- Zdiv_pol_correct ; auto. - rewrite (RingMicromega.PsubC_ok Zsor ZSORaddon). unfold eval_pol. ring. (**) - apply Zgcd_pol_div ; auto. Qed. Definition makeCuttingPlane (p : PolC Z) : PolC Z * Z := let (g,c) := Zgcd_pol p in if Z.gtb g Z0 then (Zdiv_pol (PsubC Z.sub p c) g , Z.opp (ceiling (Z.opp c) g)) else (p,Z0). Definition genCuttingPlane (f : NFormula Z) : option (PolC Z * Z * Op1) := let (e,op) := f in match op with | Equal => let (g,c) := Zgcd_pol e in if andb (Z.gtb g Z0) (andb (negb (Zeq_bool c Z0)) (negb (Zeq_bool (Z.gcd g c) g))) then None (* inconsistent *) else (* Could be optimised Zgcd_pol is recomputed *) let (p,c) := makeCuttingPlane e in Some (p,c,Equal) | NonEqual => Some (e,Z0,op) | Strict => let (p,c) := makeCuttingPlane (PsubC Z.sub e 1) in Some (p,c,NonStrict) | NonStrict => let (p,c) := makeCuttingPlane e in Some (p,c,NonStrict) end. Definition nformula_of_cutting_plane (t : PolC Z * Z * Op1) : NFormula Z := let (e_z, o) := t in let (e,z) := e_z in (padd e (Pc z) , o). Definition is_pol_Z0 (p : PolC Z) : bool := match p with | Pc Z0 => true | _ => false end. Lemma is_pol_Z0_eval_pol : forall p, is_pol_Z0 p = true -> forall env, eval_pol env p = 0. Proof. unfold is_pol_Z0. intros p; destruct p as [z| |]; try discriminate. destruct z ; try discriminate. reflexivity. Qed. Definition eval_Psatz : list (NFormula Z) -> ZWitness -> option (NFormula Z) := eval_Psatz 0 1 Z.add Z.mul Zeq_bool Z.leb. Definition valid_cut_sign (op:Op1) := match op with | Equal => true | NonStrict => true | _ => false end. Definition bound_var (v : positive) : Formula Z := Build_Formula (PEX v) OpGe (PEc 0). Definition mk_eq_pos (x : positive) (y:positive) (t : positive) : Formula Z := Build_Formula (PEX x) OpEq (PEsub (PEX y) (PEX t)). Fixpoint vars (jmp : positive) (p : Pol Z) : list positive := match p with | Pc c => nil | Pinj j p => vars (Pos.add j jmp) p | PX p j q => jmp::(vars jmp p)++vars (Pos.succ jmp) q end. Fixpoint max_var (jmp : positive) (p : Pol Z) : positive := match p with | Pc _ => jmp | Pinj j p => max_var (Pos.add j jmp) p | PX p j q => Pos.max (max_var jmp p) (max_var (Pos.succ jmp) q) end. Lemma pos_le_add : forall y x, (x <= y + x)%positive. Proof. intros y x. assert ((Z.pos x) <= Z.pos (x + y))%Z as H. - rewrite <- (Z.add_0_r (Zpos x)). rewrite <- Pos2Z.add_pos_pos. apply Z.add_le_mono_l. compute. congruence. - rewrite Pos.add_comm in H. apply H. Qed. Lemma max_var_le : forall p v, (v <= max_var v p)%positive. Proof. intros p; induction p as [?|p ? IHp|? IHp1 ? ? IHp2]; simpl. - intros. apply Pos.le_refl. - intros v. specialize (IHp (p+v)%positive). eapply Pos.le_trans ; eauto. assert (xH + v <= p + v)%positive. { apply Pos.add_le_mono. - apply Pos.le_1_l. - apply Pos.le_refl. } eapply Pos.le_trans ; eauto. apply pos_le_add. - intros v. apply Pos.max_case_strong;intros ; auto. specialize (IHp2 (Pos.succ v)%positive). eapply Pos.le_trans ; eauto. Qed. Lemma max_var_correct : forall p j v, In v (vars j p) -> Pos.le v (max_var j p). Proof. intros p; induction p; simpl. - tauto. - auto. - intros j v H. rewrite in_app_iff in H. destruct H as [H |[ H | H]]. + subst. apply Pos.max_case_strong;intros ; auto. * apply max_var_le. * eapply Pos.le_trans ; eauto. apply max_var_le. + apply Pos.max_case_strong;intros ; auto. eapply Pos.le_trans ; eauto. + apply Pos.max_case_strong;intros ; auto. eapply Pos.le_trans ; eauto. Qed. Definition max_var_nformulae (l : list (NFormula Z)) := List.fold_left (fun acc f => Pos.max acc (max_var xH (fst f))) l xH. Section MaxVar. Definition F (acc : positive) (f : Pol Z * Op1) := Pos.max acc (max_var 1 (fst f)). Lemma max_var_nformulae_mono_aux : forall l v acc, (v <= acc -> v <= fold_left F l acc)%positive. Proof. intros l; induction l as [|a l IHl] ; simpl ; [easy|]. intros. apply IHl. unfold F. apply Pos.max_case_strong;intros ; auto. eapply Pos.le_trans ; eauto. Qed. Lemma max_var_nformulae_mono_aux' : forall l acc acc', (acc <= acc' -> fold_left F l acc <= fold_left F l acc')%positive. Proof. intros l; induction l as [|a l IHl]; simpl ; [easy|]. intros. apply IHl. unfold F. apply Pos.max_le_compat_r; auto. Qed. Lemma max_var_nformulae_correct_aux : forall l p o v, In (p,o) l -> In v (vars xH p) -> Pos.le v (fold_left F l 1)%positive. Proof. intros l p o v H H0. generalize 1%positive as acc. revert p o v H H0. induction l as [|a l IHl]. - simpl. tauto. - simpl. intros p o v H H0 ?. destruct H ; subst. + unfold F at 2. simpl. apply max_var_correct in H0. apply max_var_nformulae_mono_aux. apply Pos.max_case_strong;intros ; auto. eapply Pos.le_trans ; eauto. + eapply IHl ; eauto. Qed. End MaxVar. Lemma max_var_nformalae_correct : forall l p o v, In (p,o) l -> In v (vars xH p) -> Pos.le v (max_var_nformulae l)%positive. Proof. intros l p o v. apply max_var_nformulae_correct_aux. Qed. Fixpoint max_var_psatz (w : Psatz Z) : positive := match w with | PsatzIn _ n => xH | PsatzSquare p => max_var xH (Psquare 0 1 Z.add Z.mul Zeq_bool p) | PsatzMulC p w => Pos.max (max_var xH p) (max_var_psatz w) | PsatzMulE w1 w2 => Pos.max (max_var_psatz w1) (max_var_psatz w2) | PsatzAdd w1 w2 => Pos.max (max_var_psatz w1) (max_var_psatz w2) | _ => xH end. Fixpoint max_var_prf (w : ZArithProof) : positive := match w with | DoneProof => xH | RatProof w pf | CutProof w pf => Pos.max (max_var_psatz w) (max_var_prf pf) | SplitProof p pf1 pf2 => Pos.max (max_var xH p) (Pos.max (max_var_prf pf1) (max_var_prf pf1)) | EnumProof w1 w2 l => List.fold_left (fun acc prf => Pos.max acc (max_var_prf prf)) l (Pos.max (max_var_psatz w1) (max_var_psatz w2)) | ExProof _ pf => max_var_prf pf end. Fixpoint ZChecker (l:list (NFormula Z)) (pf : ZArithProof) {struct pf} : bool := match pf with | DoneProof => false | RatProof w pf => match eval_Psatz l w with | None => false | Some f => if Zunsat f then true else ZChecker (f::l) pf end | CutProof w pf => match eval_Psatz l w with | None => false | Some f => match genCuttingPlane f with | None => true | Some cp => ZChecker (nformula_of_cutting_plane cp::l) pf end end | SplitProof p pf1 pf2 => match genCuttingPlane (p,NonStrict) , genCuttingPlane (popp p, NonStrict) with | None , _ | _ , None => false | Some cp1 , Some cp2 => ZChecker (nformula_of_cutting_plane cp1::l) pf1 && ZChecker (nformula_of_cutting_plane cp2::l) pf2 end | ExProof x prf => let fr := max_var_nformulae l in if Pos.leb x fr then let z := Pos.succ fr in let t := Pos.succ z in let nfx := xnnormalise (mk_eq_pos x z t) in let posz := xnnormalise (bound_var z) in let post := xnnormalise (bound_var t) in ZChecker (nfx::posz::post::l) prf else false | EnumProof w1 w2 pf => match eval_Psatz l w1 , eval_Psatz l w2 with | Some f1 , Some f2 => match genCuttingPlane f1 , genCuttingPlane f2 with |Some (e1,z1,op1) , Some (e2,z2,op2) => if (valid_cut_sign op1 && valid_cut_sign op2 && is_pol_Z0 (padd e1 e2)) then (fix label (pfs:list ZArithProof) := fun lb ub => match pfs with | nil => if Z.gtb lb ub then true else false | pf::rsr => andb (ZChecker ((psub e1 (Pc lb), Equal) :: l) pf) (label rsr (Z.add lb 1%Z) ub) end) pf (Z.opp z1) z2 else false | _ , _ => true end | _ , _ => false end end. Fixpoint bdepth (pf : ZArithProof) : nat := match pf with | DoneProof => O | RatProof _ p => S (bdepth p) | CutProof _ p => S (bdepth p) | SplitProof _ p1 p2 => S (Nat.max (bdepth p1) (bdepth p2)) | EnumProof _ _ l => S (List.fold_right (fun pf x => Nat.max (bdepth pf) x) O l) | ExProof _ p => S (bdepth p) end. Require Import Wf_nat. Lemma in_bdepth : forall l a b y, In y l -> ltof ZArithProof bdepth y (EnumProof a b l). Proof. intros l; induction l as [|a l IHl]. - (* nil *) simpl. tauto. - (* cons *) simpl. intros a0 b y H. destruct H as [H|H]. + subst. unfold ltof. simpl. generalize ( (fold_right (fun (pf : ZArithProof) (x : nat) => Nat.max (bdepth pf) x) 0%nat l)). intros. generalize (bdepth y) ; intros. rewrite Nat.lt_succ_r. apply Nat.le_max_l. + generalize (IHl a0 b y H). unfold ltof. simpl. generalize ( (fold_right (fun (pf : ZArithProof) (x : nat) => Nat.max (bdepth pf) x) 0%nat l)). intros. eapply Nat.lt_le_trans. * eassumption. * rewrite <- Nat.succ_le_mono. apply Nat.le_max_r. Qed. Lemma ltof_bdepth_split_l : forall p pf1 pf2, ltof ZArithProof bdepth pf1 (SplitProof p pf1 pf2). Proof. intros. unfold ltof. simpl. rewrite Nat.lt_succ_r. apply Nat.le_max_l. Qed. Lemma ltof_bdepth_split_r : forall p pf1 pf2, ltof ZArithProof bdepth pf2 (SplitProof p pf1 pf2). Proof. intros. unfold ltof. simpl. rewrite Nat.lt_succ_r. apply Nat.le_max_r. Qed. Lemma eval_Psatz_sound : forall env w l f', make_conj (eval_nformula env) l -> eval_Psatz l w = Some f' -> eval_nformula env f'. Proof. intros env w l f' H H0. apply (fun H => eval_Psatz_Sound Zsor ZSORaddon l _ H w) ; auto. apply make_conj_in ; auto. Qed. Lemma makeCuttingPlane_ns_sound : forall env e e' c, eval_nformula env (e, NonStrict) -> makeCuttingPlane e = (e',c) -> eval_nformula env (nformula_of_cutting_plane (e', c, NonStrict)). Proof. unfold nformula_of_cutting_plane. unfold eval_nformula. unfold RingMicromega.eval_nformula. unfold eval_op1. intros env e e' c H H0. rewrite (RingMicromega.eval_pol_add Zsor ZSORaddon). simpl. (**) unfold makeCuttingPlane in H0. revert H0. case_eq (Zgcd_pol e) ; intros g c0. generalize (Zgt_cases g 0) ; destruct (Z.gtb g 0). - intros H0 H1 H2. inv H2. change (RingMicromega.eval_pol Z.add Z.mul (fun x : Z => x)) with eval_pol in *. apply (Zgcd_pol_correct_lt _ env) in H1. 2: auto using Z.gt_lt. apply Z.le_add_le_sub_l, Z.ge_le; rewrite Z.add_0_r. apply (narrow_interval_lower_bound g (- c0) (eval_pol env (Zdiv_pol (PsubC Z.sub e c0) g)) H0). apply Z.le_ge. rewrite <- Z.sub_0_l. apply Z.le_sub_le_add_r. rewrite <- H1. assumption. (* g <= 0 *) - intros H0 H1 H2. inv H2. auto with zarith. Qed. Lemma cutting_plane_sound : forall env f p, eval_nformula env f -> genCuttingPlane f = Some p -> eval_nformula env (nformula_of_cutting_plane p). Proof. unfold genCuttingPlane. intros env f; destruct f as [e op]. destruct op. - (* Equal *) intros p; destruct p as [[e' z] op]. case_eq (Zgcd_pol e) ; intros g c. case_eq (Z.gtb g 0 && (negb (Zeq_bool c 0) && negb (Zeq_bool (Z.gcd g c) g))) ; [discriminate|]. case_eq (makeCuttingPlane e). intros ? ? H H0 H1 H2 H3. inv H3. unfold makeCuttingPlane in H. rewrite H1 in H. revert H. change (eval_pol env e = 0) in H2. case_eq (Z.gtb g 0). + intros H H3. rewrite <- Zgt_is_gt_bool in H. rewrite Zgcd_pol_correct_lt with (1:= H1) in H2. 2: auto using Z.gt_lt. unfold nformula_of_cutting_plane. change (eval_pol env (padd e' (Pc z)) = 0). inv H3. rewrite eval_pol_add. set (x:=eval_pol env (Zdiv_pol (PsubC Z.sub e c) g)) in *; clearbody x. simpl. rewrite andb_false_iff in H0. destruct H0 as [H0|H0]. * rewrite Zgt_is_gt_bool in H ; congruence. * rewrite andb_false_iff in H0. destruct H0 as [H0|H0]. -- rewrite negb_false_iff in H0. apply Zeq_bool_eq in H0. subst. simpl. rewrite Z.add_0_r, Z.mul_eq_0 in H2. intuition subst; easy. -- rewrite negb_false_iff in H0. apply Zeq_bool_eq in H0. assert (HH := Zgcd_is_gcd g c). rewrite H0 in HH. destruct HH as [H3 H4 ?]. apply Zdivide_opp_r in H4. rewrite Zdivide_ceiling ; auto. apply Z.sub_move_0_r. apply Z.div_unique_exact. ++ now intros ->. ++ now rewrite Z.add_move_0_r in H2. + intros H H3. unfold nformula_of_cutting_plane. inv H3. change (eval_pol env (padd e' (Pc 0)) = 0). rewrite eval_pol_add. simpl. now rewrite Z.add_0_r. - (* NonEqual *) intros ? H H0. inv H0. unfold eval_nformula in *. unfold RingMicromega.eval_nformula in *. unfold nformula_of_cutting_plane. unfold eval_op1 in *. rewrite (RingMicromega.eval_pol_add Zsor ZSORaddon). simpl. now rewrite Z.add_0_r. - (* Strict *) intros p; destruct p as [[e' z] op]. case_eq (makeCuttingPlane (PsubC Z.sub e 1)). intros ? ? H H0 H1. inv H1. apply (makeCuttingPlane_ns_sound env) with (2:= H). simpl in *. rewrite (RingMicromega.PsubC_ok Zsor ZSORaddon). now apply Z.lt_le_pred. - (* NonStrict *) intros p; destruct p as [[e' z] op]. case_eq (makeCuttingPlane e). intros ? ? H H0 H1. inv H1. apply (makeCuttingPlane_ns_sound env) with (2:= H). assumption. Qed. Lemma genCuttingPlaneNone : forall env f, genCuttingPlane f = None -> eval_nformula env f -> False. Proof. unfold genCuttingPlane. intros env f; destruct f as [p o]. destruct o. - case_eq (Zgcd_pol p) ; intros g c. case_eq (Z.gtb g 0 && (negb (Zeq_bool c 0) && negb (Zeq_bool (Z.gcd g c) g))). + intros H H0 H1 H2. flatten_bool. match goal with [ H' : (g >? 0) = true |- ?G ] => rename H' into H3 end. match goal with [ H' : negb (Zeq_bool c 0) = true |- ?G ] => rename H' into H end. match goal with [ H' : negb (Zeq_bool (Z.gcd g c) g) = true |- ?G ] => rename H' into H5 end. rewrite negb_true_iff in H5. apply Zeq_bool_neq in H5. rewrite <- Zgt_is_gt_bool in H3. rewrite negb_true_iff in H. apply Zeq_bool_neq in H. change (eval_pol env p = 0) in H2. rewrite Zgcd_pol_correct_lt with (1:= H0) in H2. 2: auto using Z.gt_lt. set (x:=eval_pol env (Zdiv_pol (PsubC Z.sub p c) g)) in *; clearbody x. contradict H5. apply Zis_gcd_gcd. * apply Z.lt_le_incl, Z.gt_lt; assumption. * constructor; auto with zarith. exists (-x). rewrite Z.mul_opp_l, Z.mul_comm. now apply Z.add_move_0_l. (**) + destruct (makeCuttingPlane p); discriminate. - discriminate. - destruct (makeCuttingPlane (PsubC Z.sub p 1)) ; discriminate. - destruct (makeCuttingPlane p) ; discriminate. Qed. Lemma eval_nformula_mk_eq_pos : forall env x z t, env x = env z - env t -> eval_nformula env (xnnormalise (mk_eq_pos x z t)). Proof. intros. rewrite xnnormalise_correct. simpl. auto. Qed. Lemma eval_nformula_bound_var : forall env x, env x >= 0 -> eval_nformula env (xnnormalise (bound_var x)). Proof. intros. rewrite xnnormalise_correct. simpl. auto. Qed. Definition agree_env (fr : positive) (env env' : positive -> Z) : Prop := forall x, Pos.le x fr -> env x = env' x. Lemma agree_env_subset : forall v1 v2 env env', agree_env v1 env env' -> Pos.le v2 v1 -> agree_env v2 env env'. Proof. unfold agree_env. intros v1 v2 env env' H ? ? ?. apply H. eapply Pos.le_trans ; eauto. Qed. Lemma agree_env_jump : forall fr j env env', agree_env (fr + j) env env' -> agree_env fr (Env.jump j env) (Env.jump j env'). Proof. intros fr j env env' H. unfold agree_env ; intro. intros. unfold Env.jump. apply H. apply Pos.add_le_mono_r; auto. Qed. Lemma agree_env_tail : forall fr env env', agree_env (Pos.succ fr) env env' -> agree_env fr (Env.tail env) (Env.tail env'). Proof. intros fr env env' H. unfold Env.tail. apply agree_env_jump. rewrite <- Pos.add_1_r in H. apply H. Qed. Lemma max_var_acc : forall p i j, (max_var (i + j) p = max_var i p + j)%positive. Proof. intros p; induction p as [|? ? IHp|? IHp1 ? ? IHp2]; simpl. - reflexivity. - intros. rewrite ! IHp. rewrite Pos.add_assoc. reflexivity. - intros. rewrite !Pplus_one_succ_l. rewrite ! IHp1. rewrite ! IHp2. rewrite ! Pos.add_assoc. rewrite <- Pos.add_max_distr_r. reflexivity. Qed. Lemma agree_env_eval_nformula : forall env env' e (AGREE : agree_env (max_var xH (fst e)) env env'), eval_nformula env e <-> eval_nformula env' e. Proof. intros env env' e; destruct e as [p o]. simpl; intros AGREE. assert ((RingMicromega.eval_pol Z.add Z.mul (fun x : Z => x) env p) = (RingMicromega.eval_pol Z.add Z.mul (fun x : Z => x) env' p)) as H. { revert env env' AGREE. generalize xH. induction p as [?|p ? IHp|? IHp1 ? ? IHp2]; simpl. - reflexivity. - intros p1 **. apply (IHp p1). apply agree_env_jump. eapply agree_env_subset; eauto. rewrite (Pos.add_comm p). rewrite max_var_acc. apply Pos.le_refl. - intros p ? ? AGREE. f_equal;[f_equal|]. + apply (IHp1 p). eapply agree_env_subset; eauto. apply Pos.le_max_l. + f_equal. unfold Env.hd. unfold Env.nth. apply AGREE. apply Pos.le_1_l. + apply (IHp2 p). apply agree_env_tail. eapply agree_env_subset; eauto. rewrite !Pplus_one_succ_r. rewrite max_var_acc. apply Pos.le_max_r. } rewrite H. tauto. Qed. Lemma agree_env_eval_nformulae : forall env env' l (AGREE : agree_env (max_var_nformulae l) env env'), make_conj (eval_nformula env) l <-> make_conj (eval_nformula env') l. Proof. intros env env' l; induction l as [|a l IHl]. - simpl. tauto. - intros. rewrite ! make_conj_cons. assert (eval_nformula env a <-> eval_nformula env' a) as H. { apply agree_env_eval_nformula. eapply agree_env_subset ; eauto. unfold max_var_nformulae. simpl. rewrite Pos.max_1_l. apply max_var_nformulae_mono_aux. apply Pos.le_refl. } rewrite H. apply and_iff_compat_l. apply IHl. eapply agree_env_subset ; eauto. unfold max_var_nformulae. simpl. apply max_var_nformulae_mono_aux'. apply Pos.le_1_l. Qed. Lemma eq_true_iff_eq : forall b1 b2 : bool, (b1 = true <-> b2 = true) <-> b1 = b2. Proof. intros b1 b2; destruct b1,b2 ; intuition congruence. Qed. Ltac pos_tac := repeat match goal with | |- false = _ => symmetry | |- Pos.eqb ?X ?Y = false => rewrite Pos.eqb_neq ; intro | H : @eq positive ?X ?Y |- _ => apply Zpos_eq in H | H : context[Z.pos (Pos.succ ?X)] |- _ => rewrite (Pos2Z.inj_succ X) in H | H : Pos.leb ?X ?Y = true |- _ => rewrite Pos.leb_le in H ; apply (Pos2Z.pos_le_pos X Y) in H end. Lemma eval_nformula_split : forall env p, eval_nformula env (p,NonStrict) \/ eval_nformula env (popp p,NonStrict). Proof. unfold popp. simpl. intros. rewrite (eval_pol_opp Zsor ZSORaddon). rewrite Z.opp_nonneg_nonpos. apply Z.le_ge_cases. Qed. Lemma ZChecker_sound : forall w l, ZChecker l w = true -> forall env, make_impl (eval_nformula env) l False. Proof. intros w; induction w as [w H] using (well_founded_ind (well_founded_ltof _ bdepth)). destruct w as [ | w pf | w pf | p pf1 pf2 | w1 w2 pf | x pf]. - (* DoneProof *) simpl. discriminate. - (* RatProof *) simpl. intros l. case_eq (eval_Psatz l w) ; [| discriminate]. intros f Hf. case_eq (Zunsat f). + intros H0 ? ?. apply (checker_nf_sound Zsor ZSORaddon l w). unfold check_normalised_formulas. unfold eval_Psatz in Hf. rewrite Hf. unfold Zunsat in H0. assumption. + intros H0 H1 env. assert (make_impl (eval_nformula env) (f::l) False) as H2. { apply H with (2:= H1). unfold ltof. simpl. auto with arith. } destruct f. rewrite <- make_conj_impl in H2. rewrite make_conj_cons in H2. rewrite <- make_conj_impl. intro. apply H2. split ; auto. apply eval_Psatz_sound with (2:= Hf) ; assumption. - (* CutProof *) simpl. intros l. case_eq (eval_Psatz l w) ; [ | discriminate]. intros f' Hlc. case_eq (genCuttingPlane f'). + intros p H0 H1 env. assert (make_impl (eval_nformula env) (nformula_of_cutting_plane p::l) False) as H2. { eapply (H pf) ; auto. unfold ltof. simpl. auto with arith. } rewrite <- make_conj_impl in H2. rewrite make_conj_cons in H2. rewrite <- make_conj_impl. intro. apply H2. split ; auto. apply (eval_Psatz_sound env) in Hlc. * apply cutting_plane_sound with (1:= Hlc) (2:= H0). * auto. + (* genCuttingPlane = None *) intros H0 H1 env. rewrite <- make_conj_impl. intros H2. apply eval_Psatz_sound with (2:= Hlc) in H2. apply genCuttingPlaneNone with (2:= H2) ; auto. - (* SplitProof *) intros l. cbn - [genCuttingPlane]. case_eq (genCuttingPlane (p, NonStrict)) ; [| discriminate]. case_eq (genCuttingPlane (popp p, NonStrict)) ; [| discriminate]. intros cp1 GCP1 cp2 GCP2 ZC1 env. flatten_bool. match goal with [ H' : ZChecker _ pf1 = true |- _ ] => rename H' into H0 end. match goal with [ H' : ZChecker _ pf2 = true |- _ ] => rename H' into H1 end. destruct (eval_nformula_split env p). + apply (fun H' ck => H _ H' _ ck env) in H0. * rewrite <- make_conj_impl in *. intro ; apply H0. rewrite make_conj_cons. split; auto. apply (cutting_plane_sound _ (p,NonStrict)) ; auto. * apply ltof_bdepth_split_l. + apply (fun H' ck => H _ H' _ ck env) in H1. * rewrite <- make_conj_impl in *. intro ; apply H1. rewrite make_conj_cons. split; auto. apply (cutting_plane_sound _ (popp p,NonStrict)) ; auto. * apply ltof_bdepth_split_r. - (* EnumProof *) intros l. simpl. case_eq (eval_Psatz l w1) ; [ | discriminate]. case_eq (eval_Psatz l w2) ; [ | discriminate]. intros f1 Hf1 f2 Hf2. case_eq (genCuttingPlane f2). + intros p; destruct p as [ [p1 z1] op1]. case_eq (genCuttingPlane f1). * intros p; destruct p as [ [p2 z2] op2]. case_eq (valid_cut_sign op1 && valid_cut_sign op2 && is_pol_Z0 (padd p1 p2)). -- intros Hcond. flatten_bool. match goal with [ H1 : is_pol_Z0 (padd p1 p2) = true |- _ ] => rename H1 into HZ0 end. match goal with [ H2 : valid_cut_sign op1 = true |- _ ] => rename H2 into Hop1 end. match goal with [ H3 : valid_cut_sign op2 = true |- _ ] => rename H3 into Hop2 end. intros HCutL HCutR Hfix env. (* get the bounds of the enum *) rewrite <- make_conj_impl. intro H0. assert (-z1 <= eval_pol env p1 <= z2) as H1. { split. - apply (eval_Psatz_sound env) in Hf2 ; auto. apply cutting_plane_sound with (1:= Hf2) in HCutR. unfold nformula_of_cutting_plane in HCutR. unfold eval_nformula in HCutR. unfold RingMicromega.eval_nformula in HCutR. change (RingMicromega.eval_pol Z.add Z.mul (fun x : Z => x)) with eval_pol in HCutR. unfold eval_op1 in HCutR. destruct op1 ; simpl in Hop1 ; try discriminate; rewrite eval_pol_add in HCutR; simpl in HCutR. + rewrite Z.add_move_0_l in HCutR; rewrite HCutR, Z.opp_involutive; reflexivity. + now apply Z.le_sub_le_add_r in HCutR. (**) - apply (fun H => is_pol_Z0_eval_pol _ H env) in HZ0. rewrite eval_pol_add, Z.add_move_r, Z.sub_0_l in HZ0. rewrite HZ0. apply (eval_Psatz_sound env) in Hf1 ; auto. apply cutting_plane_sound with (1:= Hf1) in HCutL. unfold nformula_of_cutting_plane in HCutL. unfold eval_nformula in HCutL. unfold RingMicromega.eval_nformula in HCutL. change (RingMicromega.eval_pol Z.add Z.mul (fun x : Z => x)) with eval_pol in HCutL. unfold eval_op1 in HCutL. rewrite eval_pol_add in HCutL. simpl in HCutL. destruct op2 ; simpl in Hop2 ; try discriminate. + rewrite Z.add_move_r, Z.sub_0_l in HCutL. now rewrite HCutL, Z.opp_involutive. + now rewrite <- Z.le_sub_le_add_l in HCutL. } revert Hfix. match goal with | |- context[?F pf (-z1) z2 = true] => set (FF := F) end. intros Hfix. assert (HH :forall x, -z1 <= x <= z2 -> exists pr, (In pr pf /\ ZChecker ((PsubC Z.sub p1 x,Equal) :: l) pr = true)%Z). { clear HZ0 Hop1 Hop2 HCutL HCutR H0 H1. revert Hfix. generalize (-z1). clear z1. intro z1. revert z1 z2. induction pf as [|a pf IHpf];simpl ;intros z1 z2 Hfix x **. - revert Hfix. now case (Z.gtb_spec); [ | easy ]; intros LT; elim (Zlt_not_le _ _ LT); transitivity x. - flatten_bool. match goal with [ H' : _ <= x <= _ |- _ ] => rename H' into H0 end. match goal with [ H' : FF pf (z1 + 1) z2 = true |- _ ] => rename H' into H2 end. destruct (Z_le_lt_eq_dec _ _ (proj1 H0)) as [ LT | -> ]. 2: exists a; auto. rewrite <- Z.le_succ_l in LT. assert (LE: (Z.succ z1 <= x <= z2)%Z) by intuition. elim IHpf with (2:=H2) (3:= LE). + intros x0 ?. exists x0 ; split;tauto. + intros until 1. apply H ; auto. unfold ltof in *. simpl in *. Zify.zify. intuition subst. * assumption. * eapply Z.lt_le_trans. -- eassumption. -- apply Z.add_le_mono_r. assumption. } (*/asser *) destruct (HH _ H1) as [pr [Hin Hcheker]]. assert (make_impl (eval_nformula env) ((PsubC Z.sub p1 (eval_pol env p1),Equal) :: l) False) as H2. { eapply (H pr) ;auto. apply in_bdepth ; auto. } rewrite <- make_conj_impl in H2. apply H2. rewrite make_conj_cons. split ;auto. unfold eval_nformula. unfold RingMicromega.eval_nformula. simpl. rewrite (RingMicromega.PsubC_ok Zsor ZSORaddon). unfold eval_pol. ring. -- discriminate. * (* No cutting plane *) intros H0 H1 H2 env. rewrite <- make_conj_impl. intros H3. apply eval_Psatz_sound with (2:= Hf1) in H3. apply genCuttingPlaneNone with (2:= H3) ; auto. + (* No Cutting plane (bis) *) intros H0 H1 env. rewrite <- make_conj_impl. intros H2. apply eval_Psatz_sound with (2:= Hf2) in H2. apply genCuttingPlaneNone with (2:= H2) ; auto. - intros l. unfold ZChecker. fold ZChecker. set (fr := (max_var_nformulae l)%positive). set (z1 := (Pos.succ fr)) in *. set (t1 := (Pos.succ z1)) in *. destruct (x <=? fr)%positive eqn:LE ; [|congruence]. intros H0 env. set (env':= fun v => if Pos.eqb v z1 then if Z.leb (env x) 0 then 0 else env x else if Pos.eqb v t1 then if Z.leb (env x) 0 then -(env x) else 0 else env v). apply (fun H' ck => H _ H' _ ck env') in H0. + rewrite <- make_conj_impl in *. intro H1. rewrite !make_conj_cons in H0. apply H0 ; repeat split. * apply eval_nformula_mk_eq_pos. unfold env'. rewrite! Pos.eqb_refl. replace (x=?z1)%positive with false. 1:replace (x=?t1)%positive with false. 1:replace (t1=?z1)%positive with false. 1:destruct (env x <=? 0); ring. { unfold t1. pos_tac; normZ. lia (Hyp (e := Z.pos z1 - Z.succ (Z.pos z1)) ltac:(assumption)). } { unfold t1, z1. pos_tac; normZ. lia (Add (Hyp LE) (Hyp (e := Z.pos x - Z.succ (Z.succ (Z.pos fr))) ltac:(assumption))). } { unfold z1. pos_tac; normZ. lia (Add (Hyp LE) (Hyp (e := Z.pos x - Z.succ (Z.pos fr)) ltac:(assumption))). } * apply eval_nformula_bound_var. unfold env'. rewrite! Pos.eqb_refl. destruct (env x <=? 0) eqn:EQ. -- compute. congruence. -- rewrite Z.leb_gt in EQ. normZ. lia (Add (Hyp EQ) (Hyp (e := 0 - (env x + 1)) ltac:(assumption))). * apply eval_nformula_bound_var. unfold env'. rewrite! Pos.eqb_refl. replace (t1 =? z1)%positive with false. -- destruct (env x <=? 0) eqn:EQ. ++ rewrite Z.leb_le in EQ. normZ. lia (Add (Hyp EQ) (Hyp (e := 0 - (- env x + 1)) ltac:(assumption))). ++ compute; congruence. -- unfold t1. clear. pos_tac; normZ. lia (Hyp (e := Z.pos z1 - Z.succ (Z.pos z1)) ltac:(assumption)). * rewrite (agree_env_eval_nformulae _ env') in H1;auto. unfold agree_env; intros x0 H2. unfold env'. replace (x0 =? z1)%positive with false. 1:replace (x0 =? t1)%positive with false. 1:reflexivity. { unfold t1, z1. unfold fr in *. apply Pos2Z.pos_le_pos in H2. pos_tac; normZ. lia (Add (Hyp H2) (Hyp (e := Z.pos x0 - Z.succ (Z.succ (Z.pos (max_var_nformulae l)))) ltac:(assumption))). } { unfold z1, fr in *. apply Pos2Z.pos_le_pos in H2. pos_tac; normZ. lia (Add (Hyp H2) (Hyp (e := Z.pos x0 - Z.succ (Z.pos (max_var_nformulae l))) ltac:(assumption))). } + unfold ltof. simpl. apply Nat.lt_succ_diag_r. Qed. Definition ZTautoChecker (f : BFormula (Formula Z) Tauto.isProp) (w: list ZArithProof): bool := @tauto_checker (Formula Z) (NFormula Z) unit Zunsat Zdeduce normalise negate ZArithProof (fun cl => ZChecker (List.map fst cl)) f w. Lemma ZTautoChecker_sound : forall f w, ZTautoChecker f w = true -> forall env, eval_bf (Zeval_formula env) f. Proof. intros f w. unfold ZTautoChecker. apply (tauto_checker_sound _ _ _ _ eval_nformula). - apply Zeval_nformula_dec. - intros t ? env. unfold eval_nformula. unfold RingMicromega.eval_nformula. destruct t. apply (check_inconsistent_sound Zsor ZSORaddon) ; auto. - unfold Zdeduce. intros ? ? ? H **. revert H. apply (nformula_plus_nformula_correct Zsor ZSORaddon); auto. - intros ? ? ? ? H. rewrite normalise_correct in H. rewrite Zeval_formula_compat; auto. - intros ? ? ? ? H. rewrite negate_correct in H ; auto. rewrite Tauto.hold_eNOT. rewrite Zeval_formula_compat; auto. - intros t w0. unfold eval_tt. intros H env. rewrite (make_impl_map (eval_nformula env)). + eapply ZChecker_sound; eauto. + tauto. Qed. Fixpoint xhyps_of_pt (base:nat) (acc : list nat) (pt:ZArithProof) : list nat := match pt with | DoneProof => acc | RatProof c pt => xhyps_of_pt (S base ) (xhyps_of_psatz base acc c) pt | CutProof c pt => xhyps_of_pt (S base ) (xhyps_of_psatz base acc c) pt | SplitProof p pt1 pt2 => xhyps_of_pt (S base) (xhyps_of_pt (S base) acc pt1) pt2 | EnumProof c1 c2 l => let acc := xhyps_of_psatz base (xhyps_of_psatz base acc c2) c1 in List.fold_left (xhyps_of_pt (S base)) l acc | ExProof _ pt => xhyps_of_pt (S (S (S base ))) acc pt end. Definition hyps_of_pt (pt : ZArithProof) : list nat := xhyps_of_pt 0 nil pt. Open Scope Z_scope. (** To ease bindings from ml code **) Definition make_impl := Refl.make_impl. Definition make_conj := Refl.make_conj. Require VarMap. (*Definition varmap_type := VarMap.t Z. *) Definition env := PolEnv Z. Definition node := @VarMap.Branch Z. Definition empty := @VarMap.Empty Z. Definition leaf := @VarMap.Elt Z. Definition coneMember := ZWitness. Definition eval := eval_formula. Definition prod_pos_nat := prod positive nat. Notation n_of_Z := Z.to_N (only parsing). coq-8.20.0/theories/micromega/Zify.v000066400000000000000000000030261466560755400173030ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* 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_to_euclidean_division_equations ; zify_post_hook. coq-8.20.0/theories/micromega/ZifyBool.v000066400000000000000000000124231466560755400201200ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* destruct C as [C|C]; rewrite C in * end. Ltac Zify.zify_post_hook ::= elim_bool_cstr. coq-8.20.0/theories/micromega/ZifyClasses.v000066400000000000000000000232621466560755400206250ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* S -> S]. Another limitation is that our injection theorems e.g. [TBOpInj], are using Leibniz equality; the payoff is that there is no need for morphisms... *) (** An injection [InjTyp S T] declares an injection from source type S to target type T. *) Class InjTyp (S : Type) (T : Type) := mkinj { (* [inj] is the injection function *) inj : S -> T; pred : T -> Prop; (* [cstr] states that [pred] holds for any injected element. [cstr (inj x)] is introduced in the goal for any leaf term of the form [inj x] *) cstr : forall x, pred (inj x) }. (** [BinOp Op] declares a source operator [Op: S1 -> S2 -> S3]. *) Class BinOp {S1 S2 S3 T1 T2 T3:Type} (Op : S1 -> S2 -> S3) {I1 : InjTyp S1 T1} {I2 : InjTyp S2 T2} {I3 : InjTyp S3 T3} := mkbop { (* [TBOp] is the target operator after injection of operands. *) TBOp : T1 -> T2 -> T3; (* [TBOpInj] states the correctness of the injection. *) TBOpInj : forall (n:S1) (m:S2), inj (Op n m) = TBOp (inj n) (inj m) }. (** [Unop Op] declares a source operator [Op : S1 -> S2]. *) Class UnOp {S1 S2 T1 T2:Type} (Op : S1 -> S2) {I1 : InjTyp S1 T1} {I2 : InjTyp S2 T2} := mkuop { (* [TUOp] is the target operator after injection of operands. *) TUOp : T1 -> T2; (* [TUOpInj] states the correctness of the injection. *) TUOpInj : forall (x:S1), inj (Op x) = TUOp (inj x) }. (** [CstOp Op] declares a source constant [Op : S]. *) Class CstOp {S T:Type} (Op : S) {I : InjTyp S T} := mkcst { (* [TCst] is the target constant. *) TCst : T; (* [TCstInj] states the correctness of the injection. *) TCstInj : inj Op = TCst }. (** In the framework, [Prop] is mapped to [Prop] and the injection is phrased in terms of [=] instead of [<->]. *) (** [BinRel R] declares the injection of a binary relation. *) Class BinRel {S:Type} {T:Type} (R : S -> S -> Prop) {I : InjTyp S T} := mkbrel { TR : T -> T -> Prop; TRInj : forall n m : S, R n m <-> TR (@inj _ _ I n) (inj m) }. (** [PropOp Op] declares morphisms for [<->]. This will be used to deal with e.g. [and], [or],... *) Class PropOp (Op : Prop -> Prop -> Prop) := mkprop { op_iff : forall (p1 p2 q1 q2:Prop), (p1 <-> q1) -> (p2 <-> q2) -> (Op p1 p2 <-> Op q1 q2) }. Class PropUOp (Op : Prop -> Prop) := mkuprop { uop_iff : forall (p1 q1 :Prop), (p1 <-> q1) -> (Op p1 <-> Op q1) }. (** Once the term is injected, terms can be replaced by their specification. NB1: The Ltac code is currently limited to (Op: Z -> Z -> Z) NB2: This is not sufficient to cope with [Z.div] or [Z.mod] *) Class BinOpSpec {T1 T2 T3: Type} (Op : T1 -> T2 -> T3) := mkbspec { BPred : T1 -> T2 -> T3 -> Prop; BSpec : forall x y, BPred x y (Op x y) }. Class UnOpSpec {T1 T2: Type} (Op : T1 -> T2) := mkuspec { UPred : T1 -> T2 -> Prop; USpec : forall x, UPred x (Op x) }. (** After injections, e.g. nat -> Z, the fact that Z.of_nat x * Z.of_nat y is positive is lost. This information can be recovered using instance of the [Saturate] class. *) Class Saturate {T: Type} (Op : T -> T -> T) := mksat { (** Given [Op x y], - [PArg1] is the pre-condition of x - [PArg2] is the pre-condition of y - [PRes] is the pos-condition of (Op x y) *) PArg1 : T -> Prop; PArg2 : T -> Prop; PRes : T -> T -> T -> Prop; (** [SatOk] states the correctness of the reasoning *) SatOk : forall x y, PArg1 x -> PArg2 y -> PRes x y (Op x y) }. (* )Arguments PRes {_ _} _. *) (* The [ZifyInst.saturate] iterates over all the instances and for every pattern of the form [H1 : PArg1 ?x , H2 : PArg2 ?y , T : context[Op ?x ?y] |- _ ] [H1 : PArg1 ?x , H2 : PArg2 ?y |- context[Op ?x ?y] ] asserts (SatOK x y H1 H2) *) (** The rest of the file is for internal use by the ML tactic. There are data-structures and lemmas used to inductively construct the injected terms. *) (** The data-structures [injterm] and [injected_prop] are used to store source and target expressions together with a correctness proof. *) Record injterm {S T: Type} (I : S -> T) := mkinjterm { source : S ; target : T ; inj_ok : I source = target}. Record injprop := mkinjprop { source_prop : Prop ; target_prop : Prop ; injprop_ok : source_prop <-> target_prop}. (** Lemmas for building rewrite rules. *) Definition PropOp_iff (Op : Prop -> Prop -> Prop) := forall (p1 p2 q1 q2:Prop), (p1 <-> q1) -> (p2 <-> q2) -> (Op p1 p2 <-> Op q1 q2). Definition PropUOp_iff (Op : Prop -> Prop) := forall (p1 q1 :Prop), (p1 <-> q1) -> (Op p1 <-> Op q1). Lemma mkapp2 (S1 S2 S3 T1 T2 T3 : Type) (Op : S1 -> S2 -> S3) (I1 : S1 -> T1) (I2 : S2 -> T2) (I3 : S3 -> T3) (TBOP : T1 -> T2 -> T3) (TBOPINJ : forall n m, I3 (Op n m) = TBOP (I1 n) (I2 m)) (s1 : S1) (t1 : T1) (P1: I1 s1 = t1) (s2 : S2) (t2 : T2) (P2: I2 s2 = t2): I3 (Op s1 s2) = TBOP t1 t2. Proof. subst. apply TBOPINJ. Qed. Lemma mkapp (S1 S2 T1 T2 : Type) (OP : S1 -> S2) (I1 : S1 -> T1) (I2 : S2 -> T2) (TUOP : T1 -> T2) (TUOPINJ : forall n, I2 (OP n) = TUOP (I1 n)) (s1: S1) (t1: T1) (P1: I1 s1 = t1): I2 (OP s1) = TUOP t1. Proof. subst. apply TUOPINJ. Qed. Lemma mkrel (S T : Type) (R : S -> S -> Prop) (I : S -> T) (TR : T -> T -> Prop) (TRINJ : forall n m : S, R n m <-> TR (I n) (I m)) (s1 : S) (t1 : T) (P1 : I s1 = t1) (s2 : S) (t2 : T) (P2 : I s2 = t2): R s1 s2 <-> TR t1 t2. Proof. subst. apply TRINJ. Qed. (** Hardcoded support and lemma for propositional logic *) Lemma and_morph : forall (s1 s2 t1 t2:Prop), s1 <-> t1 -> s2 <-> t2 -> ((s1 /\ s2) <-> (t1 /\ t2)). Proof. intros. tauto. Qed. Lemma or_morph : forall (s1 s2 t1 t2:Prop), s1 <-> t1 -> s2 <-> t2 -> ((s1 \/ s2) <-> (t1 \/ t2)). Proof. intros. tauto. Qed. Lemma impl_morph : forall (s1 s2 t1 t2:Prop), s1 <-> t1 -> s2 <-> t2 -> ((s1 -> s2) <-> (t1 -> t2)). Proof. intros. tauto. Qed. Lemma iff_morph : forall (s1 s2 t1 t2:Prop), s1 <-> t1 -> s2 <-> t2 -> ((s1 <-> s2) <-> (t1 <-> t2)). Proof. intros. tauto. Qed. Lemma not_morph : forall (s1 t1:Prop), s1 <-> t1 -> (not s1) <-> (not t1). Proof. intros. tauto. Qed. Lemma eq_iff : forall (P Q : Prop), P = Q -> (P <-> Q). Proof. intros P Q H. rewrite H. apply iff_refl. Defined. Lemma rew_iff (P Q : Prop) (IFF : P <-> Q) : P -> Q. Proof. exact (fun H => proj1 IFF H). Qed. Lemma rew_iff_rev (P Q : Prop) (IFF : P <-> Q) : Q -> P. Proof. exact (fun H => proj2 IFF H). Qed. (** Registering constants for use by the plugin *) Register eq_iff as ZifyClasses.eq_iff. Register target_prop as ZifyClasses.target_prop. Register mkrel as ZifyClasses.mkrel. Register target as ZifyClasses.target. Register mkapp2 as ZifyClasses.mkapp2. Register mkapp as ZifyClasses.mkapp. Register op_iff as ZifyClasses.op_iff. Register uop_iff as ZifyClasses.uop_iff. Register TR as ZifyClasses.TR. Register TBOp as ZifyClasses.TBOp. Register TUOp as ZifyClasses.TUOp. Register TCst as ZifyClasses.TCst. Register injprop_ok as ZifyClasses.injprop_ok. Register inj_ok as ZifyClasses.inj_ok. Register source as ZifyClasses.source. Register source_prop as ZifyClasses.source_prop. Register inj as ZifyClasses.inj. Register TRInj as ZifyClasses.TRInj. Register TUOpInj as ZifyClasses.TUOpInj. Register not as ZifyClasses.not. Register mkinjterm as ZifyClasses.mkinjterm. Register eq_refl as ZifyClasses.eq_refl. Register eq as ZifyClasses.eq. Register mkinjprop as ZifyClasses.mkinjprop. Register iff_refl as ZifyClasses.iff_refl. Register rew_iff as ZifyClasses.rew_iff. Register rew_iff_rev as ZifyClasses.rew_iff_rev. Register source_prop as ZifyClasses.source_prop. Register injprop_ok as ZifyClasses.injprop_ok. Register iff as ZifyClasses.iff. Register InjTyp as ZifyClasses.InjTyp. Register BinOp as ZifyClasses.BinOp. Register UnOp as ZifyClasses.UnOp. Register CstOp as ZifyClasses.CstOp. Register BinRel as ZifyClasses.BinRel. Register PropOp as ZifyClasses.PropOp. Register PropUOp as ZifyClasses.PropUOp. Register BinOpSpec as ZifyClasses.BinOpSpec. Register UnOpSpec as ZifyClasses.UnOpSpec. Register Saturate as ZifyClasses.Saturate. (** Propositional logic *) Register and as ZifyClasses.and. Register and_morph as ZifyClasses.and_morph. Register or as ZifyClasses.or. Register or_morph as ZifyClasses.or_morph. Register iff as ZifyClasses.iff. Register iff_morph as ZifyClasses.iff_morph. Register impl_morph as ZifyClasses.impl_morph. Register not as ZifyClasses.not. Register not_morph as ZifyClasses.not_morph. Register True as ZifyClasses.True. Register I as ZifyClasses.I. coq-8.20.0/theories/micromega/ZifyComparison.v000066400000000000000000000051251466560755400213400ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* -1 | Eq => 0 | Gt => 1 end. Lemma Z_of_comparison_bound : forall x, -1 <= Z_of_comparison x <= 1. Proof. destruct x ; simpl; compute; intuition congruence. Qed. #[global] Instance Inj_comparison_Z : InjTyp comparison Z := { inj := Z_of_comparison ; pred :=(fun x => -1 <= x <= 1) ; cstr := Z_of_comparison_bound}. Add Zify InjTyp Inj_comparison_Z. Definition ZcompareZ (x y : Z) := Z_of_comparison (Z.compare x y). #[global] Program Instance BinOp_Zcompare : BinOp Z.compare := { TBOp := ZcompareZ }. Add Zify BinOp BinOp_Zcompare. #[global] Instance Op_eq_comparison : BinRel (@eq comparison) := {TR := @eq Z ; TRInj := ltac:(intros [] []; simpl ; intuition congruence) }. Add Zify BinRel Op_eq_comparison. #[global] Instance Op_Eq : CstOp Eq := { TCst := 0 ; TCstInj := eq_refl }. Add Zify CstOp Op_Eq. #[global] Instance Op_Lt : CstOp Lt := { TCst := -1 ; TCstInj := eq_refl }. Add Zify CstOp Op_Lt. #[global] Instance Op_Gt : CstOp Gt := { TCst := 1 ; TCstInj := eq_refl }. Add Zify CstOp Op_Gt. Lemma Zcompare_spec : forall x y, (x = y -> ZcompareZ x y = 0) /\ (x > y -> ZcompareZ x y = 1) /\ (x < y -> ZcompareZ x y = -1). Proof. unfold ZcompareZ. intros. destruct (x ?= y) eqn:C; simpl. - rewrite Z.compare_eq_iff in C. lia. - rewrite Z.compare_lt_iff in C. lia. - rewrite Z.compare_gt_iff in C. lia. Qed. #[global] Instance ZcompareSpec : BinOpSpec ZcompareZ := {| BPred := fun x y r => (x = y -> r = 0) /\ (x > y -> r = 1) /\ (x < y -> r = -1) ; BSpec := Zcompare_spec|}. Add Zify BinOpSpec ZcompareSpec. coq-8.20.0/theories/micromega/ZifyInst.v000066400000000000000000000407341466560755400201500ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* unfold X, inj end ; reflexivity). #[global] Instance Inj_Z_Z : InjTyp Z Z := mkinj _ _ (fun x => x) (fun x => True ) (fun _ => I). Add Zify InjTyp Inj_Z_Z. (** Support for nat *) #[global] Instance Inj_nat_Z : InjTyp nat Z := mkinj _ _ Z.of_nat (fun x => 0 <= x ) Nat2Z.is_nonneg. Add Zify InjTyp Inj_nat_Z. (* zify_nat_rel *) #[global] Instance Op_ge : BinRel ge := { TR := Z.ge; TRInj := Nat2Z.inj_ge }. Add Zify BinRel Op_ge. #[global] Instance Op_lt : BinRel lt := { TR := Z.lt; TRInj := Nat2Z.inj_lt }. Add Zify BinRel Op_lt. #[global] Instance Op_Nat_lt : BinRel Nat.lt := Op_lt. Add Zify BinRel Op_Nat_lt. #[global] Instance Op_gt : BinRel gt := { TR := Z.gt; TRInj := Nat2Z.inj_gt }. Add Zify BinRel Op_gt. #[global] Instance Op_le : BinRel le := { TR := Z.le; TRInj := Nat2Z.inj_le }. Add Zify BinRel Op_le. #[global] Instance Op_Nat_le : BinRel Nat.le := Op_le. Add Zify BinRel Op_Nat_le. #[global] Instance Op_eq_nat : BinRel (@eq nat) := { TR := @eq Z ; TRInj x y := iff_sym (Nat2Z.inj_iff x y) }. Add Zify BinRel Op_eq_nat. #[global] Instance Op_Nat_eq : BinRel (Nat.eq) := Op_eq_nat. Add Zify BinRel Op_Nat_eq. (* zify_nat_op *) #[global] Instance Op_plus : BinOp Nat.add := { TBOp := Z.add; TBOpInj := Nat2Z.inj_add }. Add Zify BinOp Op_plus. #[global] Instance Op_sub : BinOp Nat.sub := { TBOp n m := Z.max 0 (n - m) ; TBOpInj := Nat2Z.inj_sub_max }. Add Zify BinOp Op_sub. #[global] Instance Op_mul : BinOp Nat.mul := { TBOp := Z.mul ; TBOpInj := Nat2Z.inj_mul }. Add Zify BinOp Op_mul. #[global] Instance Op_min : BinOp Nat.min := { TBOp := Z.min ; TBOpInj := Nat2Z.inj_min }. Add Zify BinOp Op_min. #[global] Instance Op_max : BinOp Nat.max := { TBOp := Z.max ; TBOpInj := Nat2Z.inj_max }. Add Zify BinOp Op_max. #[global] Instance Op_pred : UnOp Nat.pred := { TUOp n := Z.max 0 (n - 1) ; TUOpInj := Nat2Z.inj_pred_max }. Add Zify UnOp Op_pred. #[global] Instance Op_S : UnOp S := { TUOp x := Z.add x 1 ; TUOpInj := Nat2Z.inj_succ }. Add Zify UnOp Op_S. #[global] Instance Op_O : CstOp O := { TCst := Z0 ; TCstInj := eq_refl (Z.of_nat 0) }. Add Zify CstOp Op_O. #[global] Instance Op_Z_abs_nat : UnOp Z.abs_nat := { TUOp := Z.abs ; TUOpInj := Zabs2Nat.id_abs }. Add Zify UnOp Op_Z_abs_nat. #[global] Instance Op_nat_div2 : UnOp Nat.div2 := { TUOp x := x / 2 ; TUOpInj x := ltac:(now rewrite Nat2Z.inj_div2, Z.div2_div) }. Add Zify UnOp Op_nat_div2. #[global] Instance Op_nat_double : UnOp Nat.double := {| TUOp := Z.mul 2 ; TUOpInj := Nat2Z.inj_double |}. Add Zify UnOp Op_nat_double. (** Support for positive *) #[global] Instance Inj_pos_Z : InjTyp positive Z := { inj := Zpos ; pred x := 0 < x ; cstr := Pos2Z.pos_is_pos }. Add Zify InjTyp Inj_pos_Z. #[global] Instance Op_pos_to_nat : UnOp Pos.to_nat := {TUOp x := x ; TUOpInj := positive_nat_Z}. Add Zify UnOp Op_pos_to_nat. #[global] Instance Inj_N_Z : InjTyp N Z := mkinj _ _ Z.of_N (fun x => 0 <= x ) N2Z.is_nonneg. Add Zify InjTyp Inj_N_Z. #[global] Instance Op_N_to_nat : UnOp N.to_nat := { TUOp x := x ; TUOpInj := N_nat_Z }. Add Zify UnOp Op_N_to_nat. (* zify_positive_rel *) #[global] Instance Op_pos_ge : BinRel Pos.ge := { TR := Z.ge; TRInj x y := iff_refl (Z.pos x >= Z.pos y) }. Add Zify BinRel Op_pos_ge. #[global] Instance Op_pos_lt : BinRel Pos.lt := { TR := Z.lt; TRInj x y := iff_refl (Z.pos x < Z.pos y) }. Add Zify BinRel Op_pos_lt. #[global] Instance Op_pos_gt : BinRel Pos.gt := { TR := Z.gt; TRInj x y := iff_refl (Z.pos x > Z.pos y) }. Add Zify BinRel Op_pos_gt. #[global] Instance Op_pos_le : BinRel Pos.le := { TR := Z.le; TRInj x y := iff_refl (Z.pos x <= Z.pos y) }. Add Zify BinRel Op_pos_le. Lemma eq_pos_inj x y : x = y <-> Z.pos x = Z.pos y. Proof. apply (iff_sym (Pos2Z.inj_iff x y)). Qed. #[global] Instance Op_eq_pos : BinRel (@eq positive) := { TR := @eq Z ; TRInj := eq_pos_inj }. Add Zify BinRel Op_eq_pos. (* zify_positive_op *) #[global] Instance Op_Z_of_N : UnOp Z.of_N := { TUOp x := x ; TUOpInj x := eq_refl (Z.of_N x) }. Add Zify UnOp Op_Z_of_N. #[global] Instance Op_Z_to_N : UnOp Z.to_N := { TUOp x := Z.max 0 x ; TUOpInj x := ltac:(now destruct x) }. Add Zify UnOp Op_Z_to_N. #[global] Instance Op_Z_neg : UnOp Z.neg := { TUOp := Z.opp ; TUOpInj x := eq_refl (Zneg x) }. Add Zify UnOp Op_Z_neg. #[global] Instance Op_Z_pos : UnOp Z.pos := { TUOp x := x ; TUOpInj x := eq_refl (Z.pos x) }. Add Zify UnOp Op_Z_pos. #[global] Instance Op_pos_succ : UnOp Pos.succ := { TUOp x := x + 1 ; TUOpInj := Pos2Z.inj_succ }. Add Zify UnOp Op_pos_succ. #[global] Instance Op_pos_pred_double : UnOp Pos.pred_double := { TUOp x := 2 * x - 1 ; TUOpInj _ := eq_refl }. Add Zify UnOp Op_pos_pred_double. #[global] Instance Op_pos_pred : UnOp Pos.pred := { TUOp x := Z.max 1 (x - 1) ; TUOpInj x := ltac:(rewrite <- Pos.sub_1_r; apply Pos2Z.inj_sub_max) }. Add Zify UnOp Op_pos_pred. #[global] Instance Op_pos_predN : UnOp Pos.pred_N := { TUOp x := x - 1 ; TUOpInj x := ltac: (now destruct x; rewrite N.pos_pred_spec) }. Add Zify UnOp Op_pos_predN. #[global] Instance Op_pos_of_succ_nat : UnOp Pos.of_succ_nat := { TUOp x := x + 1 ; TUOpInj := Zpos_P_of_succ_nat }. Add Zify UnOp Op_pos_of_succ_nat. #[global] Instance Op_pos_of_nat : UnOp Pos.of_nat := { TUOp x := Z.max 1 x ; TUOpInj x := ltac: (now destruct x; [|rewrite <- Pos.of_nat_succ, <- (Nat2Z.inj_max 1)]) }. Add Zify UnOp Op_pos_of_nat. #[global] Instance Op_pos_add : BinOp Pos.add := { TBOp := Z.add ; TBOpInj _ _ := eq_refl }. Add Zify BinOp Op_pos_add. #[global] Instance Op_pos_add_carry : BinOp Pos.add_carry := { TBOp x y := x + y + 1 ; TBOpInj := ltac:(now intros; rewrite Pos.add_carry_spec, Pos2Z.inj_succ) }. Add Zify BinOp Op_pos_add_carry. #[global] Instance Op_pos_sub : BinOp Pos.sub := { TBOp n m := Z.max 1 (n - m) ; TBOpInj := Pos2Z.inj_sub_max }. Add Zify BinOp Op_pos_sub. #[global] Instance Op_pos_mul : BinOp Pos.mul := { TBOp := Z.mul ; TBOpInj _ _ := eq_refl }. Add Zify BinOp Op_pos_mul. #[global] Instance Op_pos_min : BinOp Pos.min := { TBOp := Z.min ; TBOpInj := Pos2Z.inj_min }. Add Zify BinOp Op_pos_min. #[global] Instance Op_pos_max : BinOp Pos.max := { TBOp := Z.max ; TBOpInj := Pos2Z.inj_max }. Add Zify BinOp Op_pos_max. #[global] Instance Op_pos_pow : BinOp Pos.pow := { TBOp := Z.pow ; TBOpInj := Pos2Z.inj_pow }. Add Zify BinOp Op_pos_pow. #[global] Instance Op_pos_square : UnOp Pos.square := { TUOp := Z.square ; TUOpInj := Pos2Z.inj_square }. Add Zify UnOp Op_pos_square. #[global] Instance Op_Pos_Nsucc_double : UnOp Pos.Nsucc_double := { TUOp x := 2 * x + 1 ; TUOpInj x := ltac:(now destruct x) }. Add Zify UnOp Op_Pos_Nsucc_double. #[global] Instance Op_Pos_Ndouble : UnOp Pos.Ndouble := { TUOp x := 2 * x ; TUOpInj x := ltac:(now destruct x) }. Add Zify UnOp Op_Pos_Ndouble. #[global] Instance Op_xO : UnOp xO := { TUOp x := 2 * x ; TUOpInj _ := eq_refl }. Add Zify UnOp Op_xO. #[global] Instance Op_xI : UnOp xI := { TUOp x := 2 * x + 1 ; TUOpInj _ := eq_refl }. Add Zify UnOp Op_xI. #[global] Instance Op_xH : CstOp xH := { TCst := 1%Z ; TCstInj := eq_refl }. Add Zify CstOp Op_xH. #[global] Instance Op_Z_of_nat : UnOp Z.of_nat:= { TUOp x := x ; TUOpInj x := eq_refl (Z.of_nat x) }. Add Zify UnOp Op_Z_of_nat. (* zify_N_rel *) #[global] Instance Op_N_ge : BinRel N.ge := { TR := Z.ge ; TRInj := N2Z.inj_ge }. Add Zify BinRel Op_N_ge. #[global] Instance Op_N_lt : BinRel N.lt := { TR := Z.lt ; TRInj := N2Z.inj_lt }. Add Zify BinRel Op_N_lt. #[global] Instance Op_N_gt : BinRel N.gt := { TR := Z.gt ; TRInj := N2Z.inj_gt }. Add Zify BinRel Op_N_gt. #[global] Instance Op_N_le : BinRel N.le := { TR := Z.le ; TRInj := N2Z.inj_le }. Add Zify BinRel Op_N_le. #[global] Instance Op_eq_N : BinRel (@eq N) := { TR := @eq Z ; TRInj x y := iff_sym (N2Z.inj_iff x y) }. Add Zify BinRel Op_eq_N. (* zify_N_op *) #[global] Instance Op_N_N0 : CstOp N0 := { TCst := Z0 ; TCstInj := eq_refl }. Add Zify CstOp Op_N_N0. #[global] Instance Op_N_Npos : UnOp Npos := { TUOp x := x ; TUOpInj _ := eq_refl }. Add Zify UnOp Op_N_Npos. #[global] Instance Op_N_of_nat : UnOp N.of_nat := { TUOp x := x ; TUOpInj := nat_N_Z }. Add Zify UnOp Op_N_of_nat. #[global] Instance Op_Z_abs_N : UnOp Z.abs_N := { TUOp := Z.abs ; TUOpInj := N2Z.inj_abs_N }. Add Zify UnOp Op_Z_abs_N. #[global] Instance Op_N_pos : UnOp N.pos := { TUOp x := x ; TUOpInj _ := eq_refl }. Add Zify UnOp Op_N_pos. #[global] Instance Op_N_add : BinOp N.add := { TBOp := Z.add ; TBOpInj := N2Z.inj_add }. Add Zify BinOp Op_N_add. #[global] Instance Op_N_min : BinOp N.min := { TBOp := Z.min ; TBOpInj := N2Z.inj_min }. Add Zify BinOp Op_N_min. #[global] Instance Op_N_max : BinOp N.max := { TBOp := Z.max ; TBOpInj := N2Z.inj_max }. Add Zify BinOp Op_N_max. #[global] Instance Op_N_mul : BinOp N.mul := { TBOp := Z.mul ; TBOpInj := N2Z.inj_mul }. Add Zify BinOp Op_N_mul. #[global] Instance Op_N_sub : BinOp N.sub := { TBOp x y := Z.max 0 (x - y) ; TBOpInj := N2Z.inj_sub_max }. Add Zify BinOp Op_N_sub. #[global] Instance Op_N_div : BinOp N.div := { TBOp := Z.div ; TBOpInj := N2Z.inj_div }. Add Zify BinOp Op_N_div. #[global] Instance Op_N_mod : BinOp N.modulo := { TBOp := Z.rem ; TBOpInj := N2Z.inj_rem }. Add Zify BinOp Op_N_mod. #[global] Instance Op_N_pred : UnOp N.pred := { TUOp x := Z.max 0 (x - 1) ; TUOpInj x := ltac:(rewrite N.pred_sub; apply N2Z.inj_sub_max) }. Add Zify UnOp Op_N_pred. #[global] Instance Op_N_succ : UnOp N.succ := { TUOp x := x + 1 ; TUOpInj := N2Z.inj_succ }. Add Zify UnOp Op_N_succ. #[global] Instance Op_N_succ_double : UnOp N.succ_double := { TUOp x := 2 * x + 1 ; TUOpInj x := ltac:(now destruct x) }. Add Zify UnOp Op_N_succ_double. #[global] Instance Op_N_double : UnOp N.double := { TUOp x := 2 * x ; TUOpInj x := ltac:(now destruct x) }. Add Zify UnOp Op_N_double. #[global] Instance Op_N_succ_pos : UnOp N.succ_pos := { TUOp x := x + 1 ; TUOpInj x := ltac:(now destruct x; simpl; [| rewrite Pplus_one_succ_r]) }. Add Zify UnOp Op_N_succ_pos. #[global] Instance Op_N_div2 : UnOp N.div2 := { TUOp x := x / 2 ; TUOpInj x := ltac:(now rewrite N2Z.inj_div2, Z.div2_div) }. Add Zify UnOp Op_N_div2. #[global] Instance Op_N_pow : BinOp N.pow := { TBOp := Z.pow ; TBOpInj := N2Z.inj_pow }. Add Zify BinOp Op_N_pow. #[global] Instance Op_N_square : UnOp N.square := { TUOp x := x * x ; TUOpInj x := ltac:(now rewrite N.square_spec, N2Z.inj_mul) }. Add Zify UnOp Op_N_square. (** Support for Z - injected to itself *) (* zify_Z_rel *) #[global] Instance Op_Z_ge : BinRel Z.ge := { TR := Z.ge ; TRInj x y := iff_refl (x>= y) }. Add Zify BinRel Op_Z_ge. #[global] Instance Op_Z_lt : BinRel Z.lt := { TR := Z.lt ; TRInj x y := iff_refl (x < y) }. Add Zify BinRel Op_Z_lt. #[global] Instance Op_Z_gt : BinRel Z.gt := { TR := Z.gt ;TRInj x y := iff_refl (x > y) }. Add Zify BinRel Op_Z_gt. #[global] Instance Op_Z_le : BinRel Z.le := { TR := Z.le ;TRInj x y := iff_refl (x <= y) }. Add Zify BinRel Op_Z_le. #[global] Instance Op_eqZ : BinRel (@eq Z) := { TR := @eq Z ; TRInj x y := iff_refl (x = y) }. Add Zify BinRel Op_eqZ. #[global] Instance Op_Z_Z0 : CstOp Z0 := { TCst := Z0 ; TCstInj := eq_refl }. Add Zify CstOp Op_Z_Z0. #[global] Instance Op_Z_add : BinOp Z.add := { TBOp := Z.add ; TBOpInj _ _ := eq_refl }. Add Zify BinOp Op_Z_add. #[global] Instance Op_Z_min : BinOp Z.min := { TBOp := Z.min ; TBOpInj _ _ := eq_refl }. Add Zify BinOp Op_Z_min. #[global] Instance Op_Z_max : BinOp Z.max := { TBOp := Z.max ; TBOpInj _ _ := eq_refl }. Add Zify BinOp Op_Z_max. #[global] Instance Op_Z_mul : BinOp Z.mul := { TBOp := Z.mul ; TBOpInj _ _ := eq_refl }. Add Zify BinOp Op_Z_mul. #[global] Instance Op_Z_sub : BinOp Z.sub := { TBOp := Z.sub ; TBOpInj _ _ := eq_refl }. Add Zify BinOp Op_Z_sub. #[global] Instance Op_Z_div : BinOp Z.div := { TBOp := Z.div ; TBOpInj _ _ := eq_refl }. Add Zify BinOp Op_Z_div. #[global] Instance Op_Z_mod : BinOp Z.modulo := { TBOp := Z.modulo ; TBOpInj _ _ := eq_refl }. Add Zify BinOp Op_Z_mod. #[global] Instance Op_Z_rem : BinOp Z.rem := { TBOp := Z.rem ; TBOpInj _ _ := eq_refl }. Add Zify BinOp Op_Z_rem. #[global] Instance Op_Z_quot : BinOp Z.quot := { TBOp := Z.quot ; TBOpInj _ _ := eq_refl }. Add Zify BinOp Op_Z_quot. #[global] Instance Op_Z_succ : UnOp Z.succ := { TUOp x := x + 1 ; TUOpInj _ := eq_refl }. Add Zify UnOp Op_Z_succ. #[global] Instance Op_Z_pred : UnOp Z.pred := { TUOp x := x - 1 ; TUOpInj _ := eq_refl }. Add Zify UnOp Op_Z_pred. #[global] Instance Op_Z_opp : UnOp Z.opp := { TUOp := Z.opp ; TUOpInj _ := eq_refl }. Add Zify UnOp Op_Z_opp. #[global] Instance Op_Z_abs : UnOp Z.abs := { TUOp := Z.abs ; TUOpInj _ := eq_refl }. Add Zify UnOp Op_Z_abs. #[global] Instance Op_Z_sgn : UnOp Z.sgn := { TUOp := Z.sgn ; TUOpInj _ := eq_refl }. Add Zify UnOp Op_Z_sgn. #[global] Instance Op_Z_pow : BinOp Z.pow := { TBOp := Z.pow ; TBOpInj _ _ := eq_refl }. Add Zify BinOp Op_Z_pow. #[global] Instance Op_Z_pow_pos : BinOp Z.pow_pos := { TBOp := Z.pow ; TBOpInj _ _ := eq_refl }. Add Zify BinOp Op_Z_pow_pos. #[global] Instance Op_Z_double : UnOp Z.double := { TUOp := Z.mul 2 ; TUOpInj := Z.double_spec }. Add Zify UnOp Op_Z_double. #[global] Instance Op_Z_pred_double : UnOp Z.pred_double := { TUOp x := 2 * x - 1 ; TUOpInj := Z.pred_double_spec }. Add Zify UnOp Op_Z_pred_double. #[global] Instance Op_Z_succ_double : UnOp Z.succ_double := { TUOp x := 2 * x + 1 ; TUOpInj := Z.succ_double_spec }. Add Zify UnOp Op_Z_succ_double. #[global] Instance Op_Z_square : UnOp Z.square := { TUOp x := x * x ; TUOpInj := Z.square_spec }. Add Zify UnOp Op_Z_square. #[global] Instance Op_Z_div2 : UnOp Z.div2 := { TUOp x := x / 2 ; TUOpInj := Z.div2_div }. Add Zify UnOp Op_Z_div2. #[global] Instance Op_Z_quot2 : UnOp Z.quot2 := { TUOp x := Z.quot x 2 ; TUOpInj := Zeven.Zquot2_quot }. Add Zify UnOp Op_Z_quot2. Lemma of_nat_to_nat_eq x : Z.of_nat (Z.to_nat x) = Z.max 0 x. Proof. destruct x; simpl. - reflexivity. - now rewrite positive_nat_Z. - reflexivity. Qed. #[global] Instance Op_Z_to_nat : UnOp Z.to_nat := { TUOp x := Z.max 0 x ; TUOpInj := of_nat_to_nat_eq }. Add Zify UnOp Op_Z_to_nat. #[global] Instance Op_Z_to_pos : UnOp Z.to_pos := { TUOp x := Z.max 1 x ; TUOpInj x := ltac:(now simpl; destruct x; [| rewrite <- Pos2Z.inj_max; rewrite Pos.max_1_l |]) }. Add Zify UnOp Op_Z_to_pos. (** Specification of derived operators over Z *) #[global] Instance ZmaxSpec : BinOpSpec Z.max := { BPred n m r := n < m /\ r = m \/ m <= n /\ r = n ; BSpec := Z.max_spec }. Add Zify BinOpSpec ZmaxSpec. #[global] Instance ZminSpec : BinOpSpec Z.min := { BPred n m r := n < m /\ r = n \/ m <= n /\ r = m ; BSpec := Z.min_spec }. Add Zify BinOpSpec ZminSpec. #[global] Instance ZsgnSpec : UnOpSpec Z.sgn := { UPred n r := 0 < n /\ r = 1 \/ 0 = n /\ r = 0 \/ n < 0 /\ r = - 1 ; USpec := Z.sgn_spec }. Add Zify UnOpSpec ZsgnSpec. #[global] Instance ZabsSpec : UnOpSpec Z.abs := { UPred n r := 0 <= n /\ r = n \/ n < 0 /\ r = - n ; USpec := Z.abs_spec }. Add Zify UnOpSpec ZabsSpec. (** Saturate positivity constraints *) #[global] Instance SatPowPos : Saturate Z.pow := { PArg1 x := 0 < x; PArg2 y := 0 <= y; PRes _ _ r := 0 < r; SatOk := fun x y => Z.pow_pos_nonneg x y}. Add Zify Saturate SatPowPos. #[global] Instance SatPowNonneg : Saturate Z.pow := { PArg1 x := 0 <= x; PArg2 y := True; PRes _ _ r := 0 <= r; SatOk a b Ha _ := @Z.pow_nonneg a b Ha }. Add Zify Saturate SatPowNonneg. (* TODO #14736 for compatibility only, should be removed after deprecation *) coq-8.20.0/theories/micromega/ZifyN.v000066400000000000000000000033671466560755400174310ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* 0 <= x; PArg2 := fun y => 0 <= y; PRes := fun _ _ r => 0 <= r; SatOk := Z_div_nonneg_nonneg |}. Add Zify Saturate SatDiv. #[global] Instance SatMod : Saturate Z.modulo := {| PArg1 := fun x => 0 <= x; PArg2 := fun y => 0 <= y; PRes := fun _ _ r => 0 <= r; SatOk := Z_mod_nonneg_nonneg |}. Add Zify Saturate SatMod. coq-8.20.0/theories/micromega/ZifyNat.v000066400000000000000000000033721466560755400177520ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* 0 <= x; PArg2 := fun y => 0 <= y; PRes := fun _ _ r => 0 <= r; SatOk := Z_div_nonneg_nonneg |}. Add Zify Saturate SatDiv. #[global] Instance SatMod : Saturate Z.modulo := {| PArg1 := fun x => 0 <= x; PArg2 := fun y => 0 <= y; PRes := fun _ _ r => 0 <= r; SatOk := Z_mod_nonneg_nonneg |}. Add Zify Saturate SatMod. coq-8.20.0/theories/micromega/ZifyPow.v000066400000000000000000000000311466560755400177620ustar00rootroot00000000000000Require Export ZifyInst. coq-8.20.0/theories/micromega/ZifySint63.v000066400000000000000000000126171466560755400203200ustar00rootroot00000000000000Require Import ZArith. Require Import Sint63. Require Import ZifyBool. Import ZifyClasses. Lemma to_Z_bounded (x : int) : (-4611686018427387904 <= to_Z x <= 4611686018427387903)%Z. Proof. now apply to_Z_bounded. Qed. #[global] Instance Inj_int_Z : InjTyp int Z := mkinj _ _ to_Z (fun x => -4611686018427387904 <= x <= 4611686018427387903)%Z to_Z_bounded. Add Zify InjTyp Inj_int_Z. #[global] Instance Op_max_int : CstOp max_int := { TCst := 4611686018427387903 ; TCstInj := eq_refl }. Add Zify CstOp Op_max_int. #[global] Instance Op_min_int : CstOp min_int := { TCst := -4611686018427387904 ; TCstInj := eq_refl }. Add Zify CstOp Op_min_int. #[global] Instance Op_digits : CstOp digits := { TCst := 63 ; TCstInj := eq_refl }. Add Zify CstOp Op_digits. #[global] Instance Op_size : CstOp size := { TCst := 63 ; TCstInj := eq_refl }. Add Zify CstOp Op_size. #[global] Instance Op_wB : CstOp wB := { TCst := 2^63 ; TCstInj := eq_refl }. Add Zify CstOp Op_wB. Lemma ltb_lt : forall n m, (n (to_Z n = to_Z m)%sint63. Proof. split; intro H. - rewrite H; reflexivity. - now apply to_Z_inj. Qed. #[global] Instance Op_eq : BinRel (@eq int) := {| TR := @eq Z; TRInj := eq_int_inj |}. Add Zify BinRel Op_eq. Notation cmodwB x := ((x + 4611686018427387904) mod 9223372036854775808 - 4611686018427387904)%Z. #[global] Instance Op_add : BinOp add := {| TBOp := fun x y => cmodwB (x + y); TBOpInj := add_spec |}%Z. Add Zify BinOp Op_add. #[global] Instance Op_sub : BinOp sub := {| TBOp := fun x y => cmodwB (x - y); TBOpInj := sub_spec |}%Z. Add Zify BinOp Op_sub. #[global] Instance Op_opp : UnOp Uint63.opp := {| TUOp := fun x => cmodwB (- x); TUOpInj := (sub_spec 0) |}%Z. Add Zify UnOp Op_opp. #[global] Instance Op_succ : UnOp succ := {| TUOp := fun x => cmodwB (x + 1); TUOpInj := succ_spec |}%Z. Add Zify UnOp Op_succ. #[global] Instance Op_pred : UnOp Uint63.pred := {| TUOp := fun x => cmodwB (x - 1); TUOpInj := pred_spec |}%Z. Add Zify UnOp Op_pred. #[global] Instance Op_mul : BinOp mul := {| TBOp := fun x y => cmodwB (x * y); TBOpInj := mul_spec |}%Z. Add Zify BinOp Op_mul. #[global] Instance Op_mod : BinOp PrimInt63.mods := {| TBOp := Z.rem ; TBOpInj := mod_spec |}. Add Zify BinOp Op_mod. #[global] Instance Op_asr : BinOp asr := {| TBOp := fun x y => x / 2^ y ; TBOpInj := asr_spec |}%Z. Add Zify BinOp Op_asr. Definition quots (x d : Z) : Z := if ((x =? -4611686018427387904)%Z && (d =? -1)%Z)%bool then -4611686018427387904 else Z.quot x d. Lemma div_quots (x y : int) : to_Z (x / y) = quots (to_Z x) (to_Z y). Proof. unfold quots; destruct andb eqn: eq_min_m1. - rewrite Bool.andb_true_iff, !Z.eqb_eq in eq_min_m1. change (-4611686018427387904)%Z with (to_Z min_int) in eq_min_m1. change (-1)%Z with (to_Z (-1)) in eq_min_m1. destruct eq_min_m1 as [to_Z_x_min to_Z_y_m1]. now rewrite (to_Z_inj _ _ to_Z_x_min), (to_Z_inj _ _ to_Z_y_m1). - apply div_spec. now rewrite Bool.andb_false_iff, !Z.eqb_neq in eq_min_m1. Qed. #[global] Instance Op_div : BinOp div := {| TBOp := quots ; TBOpInj := div_quots |}. Add Zify BinOp Op_div. Lemma quots_spec (x y : Z) : ((x = -4611686018427387904 /\ y = -1 /\ quots x y = -4611686018427387904) \/ ((x <> -4611686018427387904 \/ y <> -1) /\ quots x y = Z.quot x y))%Z. Proof. unfold quots; case andb eqn: eq_min_m1. - now left; rewrite Bool.andb_true_iff, !Z.eqb_eq in eq_min_m1. - now right; rewrite Bool.andb_false_iff, !Z.eqb_neq in eq_min_m1. Qed. #[global] Instance quotsSpec : BinOpSpec quots := {| BPred := fun x d r : Z => ((x = -4611686018427387904 /\ d = -1 /\ r = -4611686018427387904) \/ ((x <> -4611686018427387904 \/ d <> -1) /\ r = Z.quot x d))%Z; BSpec := quots_spec |}. Add Zify BinOpSpec quotsSpec. #[global] Instance Op_of_Z : UnOp of_Z := { TUOp := fun x => cmodwB x; TUOpInj := of_Z_spec }. Add Zify UnOp Op_of_Z. #[global] Instance Op_to_Z : UnOp to_Z := { TUOp := fun x => x ; TUOpInj := fun x : int => eq_refl }. Add Zify UnOp Op_to_Z. Lemma is_zeroE : forall n : int, is_zero n = (to_Z n =? 0)%Z. Proof. intro n; apply Bool.eq_true_iff_eq. rewrite is_zero_spec, Z.eqb_eq; split. - now intro eqn0; rewrite eqn0. - now change 0%Z with (to_Z 0); apply to_Z_inj. Qed. #[global] Instance Op_is_zero : UnOp is_zero := { TUOp := (Z.eqb 0) ; TUOpInj := is_zeroE }. Add Zify UnOp Op_is_zero. #[global] Instance Op_abs : UnOp abs := { TUOp := fun x => cmodwB (Z.abs x) ; TUOpInj := abs_spec }. Add Zify UnOp Op_abs. Ltac Zify.zify_convert_to_euclidean_division_equations_flag ::= constr:(true). coq-8.20.0/theories/micromega/ZifyUint63.v000066400000000000000000000123261466560755400203170ustar00rootroot00000000000000Require Import ZArith. Require Import Uint63. Require Import ZifyBool. Import ZifyClasses. Lemma to_Z_bounded : forall x, (0 <= to_Z x < 9223372036854775808)%Z. Proof. apply to_Z_bounded. Qed. #[global] 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. #[global] Instance Op_max_int : CstOp max_int := { TCst := 9223372036854775807 ; TCstInj := eq_refl }. Add Zify CstOp Op_max_int. #[global] Instance Op_digits : CstOp digits := { TCst := 63 ; TCstInj := eq_refl }. Add Zify CstOp Op_digits. #[global] Instance Op_size : CstOp size := { TCst := 63 ; TCstInj := eq_refl }. Add Zify CstOp Op_size. #[global] Instance Op_wB : CstOp wB := { TCst := 2^63 ; TCstInj := eq_refl }. Add Zify CstOp Op_wB. Lemma ltb_lt : forall n m, (n (φ n = φ m)%uint63. Proof. split; intro H. - rewrite H ; reflexivity. - apply to_Z_inj; auto. Qed. #[global] Instance Op_eq : BinRel (@eq int) := {| TR := @eq Z; TRInj := eq_int_inj |}. Add Zify BinRel Op_eq. #[global] Instance Op_add : BinOp add := {| TBOp := fun x y => (x + y) mod 9223372036854775808%Z; TBOpInj := add_spec |}%Z. Add Zify BinOp Op_add. #[global] Instance Op_sub : BinOp sub := {| TBOp := fun x y => (x - y) mod 9223372036854775808%Z; TBOpInj := sub_spec |}%Z. Add Zify BinOp Op_sub. #[global] Instance Op_opp : UnOp Uint63.opp := {| TUOp := (fun x => (- x) mod 9223372036854775808)%Z; TUOpInj := (sub_spec 0) |}%Z. Add Zify UnOp Op_opp. #[global] Instance Op_oppcarry : UnOp oppcarry := {| TUOp := (fun x => 2^63 - x - 1)%Z; TUOpInj := oppcarry_spec |}%Z. Add Zify UnOp Op_oppcarry. #[global] Instance Op_succ : UnOp succ := {| TUOp := (fun x => (x + 1) mod 2^63)%Z; TUOpInj := succ_spec |}%Z. Add Zify UnOp Op_succ. #[global] Instance Op_pred : UnOp Uint63.pred := {| TUOp := (fun x => (x - 1) mod 2^63)%Z; TUOpInj := pred_spec |}%Z. Add Zify UnOp Op_pred. #[global] Instance Op_mul : BinOp mul := {| TBOp := fun x y => (x * y) mod 9223372036854775808%Z; TBOpInj := mul_spec |}%Z. Add Zify BinOp Op_mul. #[global] 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. #[global] Instance Op_mod : BinOp Uint63.mod := {| TBOp := Z.modulo ; TBOpInj := mod_spec |}. Add Zify BinOp Op_mod. #[global] Instance Op_subcarry : BinOp subcarry := {| TBOp := (fun x y => (x - y - 1) mod 2^63)%Z ; TBOpInj := subcarry_spec |}. Add Zify BinOp Op_subcarry. #[global] Instance Op_addcarry : BinOp addcarry := {| TBOp := (fun x y => (x + y + 1) mod 2^63)%Z ; TBOpInj := addcarry_spec |}. Add Zify BinOp Op_addcarry. #[global] Instance Op_lsr : BinOp lsr := {| TBOp := (fun x y => x / 2^ y)%Z ; TBOpInj := lsr_spec |}. Add Zify BinOp Op_lsr. #[global] Instance Op_lsl : BinOp lsl := {| TBOp := (fun x y => (x * 2^ y) mod 2^ 63)%Z ; TBOpInj := lsl_spec |}. Add Zify BinOp Op_lsl. #[global] Instance Op_lor : BinOp Uint63.lor := {| TBOp := Z.lor ; TBOpInj := lor_spec' |}. Add Zify BinOp Op_lor. #[global] Instance Op_land : BinOp Uint63.land := {| TBOp := Z.land ; TBOpInj := land_spec' |}. Add Zify BinOp Op_land. #[global] Instance Op_lxor : BinOp Uint63.lxor := {| TBOp := Z.lxor ; TBOpInj := lxor_spec' |}. Add Zify BinOp Op_lxor. #[global] Instance Op_div : BinOp div := {| TBOp := Z.div ; TBOpInj := div_spec |}. Add Zify BinOp Op_div. #[global] Instance Op_bit : BinOp bit := {| TBOp := Z.testbit ; TBOpInj := bitE |}. Add Zify BinOp Op_bit. #[global] Instance Op_of_Z : UnOp of_Z := { TUOp := (fun x => x mod 9223372036854775808)%Z; TUOpInj := of_Z_spec }. Add Zify UnOp Op_of_Z. #[global] Instance Op_to_Z : UnOp to_Z := { TUOp := fun x => x ; TUOpInj := fun x : int => eq_refl }. Add Zify UnOp Op_to_Z. #[global] 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)%uint63. 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. #[global] 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). coq-8.20.0/theories/micromega/Ztac.v000066400000000000000000000071041466560755400172640ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* x <= y /\ y <= x. Proof. intros; split; apply Z.eq_le_incl; auto. Qed. Lemma elim_concl_eq : forall x y, (x < y \/ y < x -> False) -> x = y. Proof. intros x y H. destruct (Z_lt_le_dec x y). - exfalso. apply H ; auto. - destruct (Zle_lt_or_eq y x);auto. exfalso. apply H ; auto. Qed. Lemma elim_concl_le : forall x y, (y < x -> False) -> x <= y. Proof. intros x y H. destruct (Z_lt_le_dec y x). - exfalso ; auto. - auto. Qed. Lemma elim_concl_lt : forall x y, (y <= x -> False) -> x < y. Proof. intros x y H. destruct (Z_lt_le_dec x y). - auto. - exfalso ; auto. Qed. Lemma Zlt_le_add_1 : forall n m : Z, n < m -> n + 1 <= m. Proof. exact (Zlt_le_succ). Qed. Ltac normZ := repeat match goal with | H : _ < _ |- _ => apply Zlt_le_add_1 in H | H : ?Y <= _ |- _ => lazymatch Y with | 0 => fail | _ => apply Zle_minus_le_0 in H end | H : _ >= _ |- _ => apply Z.ge_le in H | H : _ > _ |- _ => apply Z.gt_lt in H | H : _ = _ |- _ => apply eq_incl in H ; destruct H | |- @eq Z _ _ => apply elim_concl_eq ; let H := fresh "HZ" in intros [H|H] | |- _ <= _ => apply elim_concl_le ; intros | |- _ < _ => apply elim_concl_lt ; intros | |- _ >= _ => apply Z.le_ge end. Inductive proof := | Hyp (e : Z) (prf : 0 <= e) | Add (p1 p2: proof) | Mul (p1 p2: proof) | Cst (c : Z) . Lemma add_le : forall e1 e2, 0 <= e1 -> 0 <= e2 -> 0 <= e1+e2. Proof. intros. change 0 with (0+ 0). apply Z.add_le_mono; auto. Qed. Lemma mul_le : forall e1 e2, 0 <= e1 -> 0 <= e2 -> 0 <= e1*e2. Proof. intros e1 e2 H H0. change 0 with (0* e2). apply Zmult_le_compat_r; auto. Qed. Fixpoint eval_proof (p : proof) : { e : Z | 0 <= e} := match p with | Hyp e prf => exist _ e prf | Add p1 p2 => let (e1,p1) := eval_proof p1 in let (e2,p2) := eval_proof p2 in exist _ _ (add_le _ _ p1 p2) | Mul p1 p2 => let (e1,p1) := eval_proof p1 in let (e2,p2) := eval_proof p2 in exist _ _ (mul_le _ _ p1 p2) | Cst c => match Z_le_dec 0 c with | left prf => exist _ _ prf | _ => exist _ _ Z.le_0_1 end end. Ltac lia_step p := let H := fresh in let prf := (eval cbn - [Z.le Z.mul Z.opp Z.sub Z.add] in (eval_proof p)) in match prf with | @exist _ _ _ ?P => pose proof P as H end ; ring_simplify in H. Ltac lia_contr := match goal with | H : 0 <= - (Zpos _) |- _ => rewrite <- Z.leb_le in H; compute in H ; discriminate | H : 0 <= (Zneg _) |- _ => rewrite <- Z.leb_le in H; compute in H ; discriminate end. Ltac lia p := lia_step p ; lia_contr. Ltac slia H1 H2 := normZ ; lia (Add (Hyp _ H1) (Hyp _ H2)). Arguments Hyp {_} prf. coq-8.20.0/theories/nsatz/000077500000000000000000000000001466560755400153665ustar00rootroot00000000000000coq-8.20.0/theories/nsatz/Nsatz.v000066400000000000000000000047711466560755400166650ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* match isZcst z with | true => open_constr:((true, PEc z)) | false => open_constr:((false,tt)) end | _ => open_constr:((false,tt)) end. Lemma R_one_zero: 1%R <> 0%R. discrR. Qed. #[global] Instance Rcri: (Cring (Rr:=Rri)). red. exact Rmult_comm. Defined. #[global] Instance Rdi : (Integral_domain (Rcr:=Rcri)). constructor. - exact Rmult_integral. - exact R_one_zero. Defined. coq-8.20.0/theories/nsatz/NsatzTactic.v000066400000000000000000000334301466560755400200070ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* x == y. intros x y H; setoid_replace x with ((x - y) + y); simpl; [setoid_rewrite H | idtac]; simpl. - cring. - cring. Qed. Lemma psos_r1: forall x y, x == y -> x - y == 0. intros x y H; simpl; setoid_rewrite H; simpl; cring. Qed. Lemma nsatzR_diff: forall x y:R, not (x == y) -> not (x - y == 0). intros. intro; apply H. simpl; setoid_replace x with ((x - y) + y). - simpl. setoid_rewrite H0. simpl; cring. - simpl. simpl; cring. Qed. (* adpatation du code de Benjamin aux setoides *) Export Ring_polynom. Export InitialRing. Definition PolZ := Pol Z. Definition PEZ := PExpr Z. Definition P0Z : PolZ := P0 (C:=Z) 0%Z. Definition PolZadd : PolZ -> PolZ -> PolZ := @Padd Z 0%Z Z.add Zeq_bool. Definition PolZmul : PolZ -> PolZ -> PolZ := @Pmul Z 0%Z 1%Z Z.add Z.mul Zeq_bool. Definition PolZeq := @Peq Z Zeq_bool. Definition norm := @norm_aux Z 0%Z 1%Z Z.add Z.mul Z.sub Z.opp Zeq_bool. Fixpoint mult_l (la : list PEZ) (lp: list PolZ) : PolZ := match la, lp with | a::la, p::lp => PolZadd (PolZmul (norm a) p) (mult_l la lp) | _, _ => P0Z end. Fixpoint compute_list (lla: list (list PEZ)) (lp:list PolZ) := match lla with | List.nil => lp | la::lla => compute_list lla ((mult_l la lp)::lp) end. Definition check (lpe:list PEZ) (qe:PEZ) (certif: list (list PEZ) * list PEZ) := let (lla, lq) := certif in let lp := List.map norm lpe in PolZeq (norm qe) (mult_l lq (compute_list lla lp)). (* Correction *) Definition PhiR : list R -> PolZ -> R := (Pphi ring0 add mul (InitialRing.gen_phiZ ring0 ring1 add mul opp)). Definition PEevalR : list R -> PEZ -> R := PEeval ring0 ring1 add mul sub opp (gen_phiZ ring0 ring1 add mul opp) N.to_nat pow. Lemma P0Z_correct : forall l, PhiR l P0Z = 0. Proof. trivial. Qed. Lemma Rext: ring_eq_ext add mul opp _==_. Proof. constructor; solve_proper. Qed. Lemma Rset : Setoid_Theory R _==_. apply ring_setoid. Qed. Definition Rtheory:ring_theory ring0 ring1 add mul sub opp _==_. apply mk_rt. - apply ring_add_0_l. - apply ring_add_comm. - apply ring_add_assoc. - apply ring_mul_1_l. - apply cring_mul_comm. - apply ring_mul_assoc. - apply ring_distr_l. - apply ring_sub_def. - apply ring_opp_def. Defined. Lemma PolZadd_correct : forall P' P l, PhiR l (PolZadd P P') == ((PhiR l P) + (PhiR l P')). Proof. unfold PolZadd, PhiR. intros. simpl. refine (Padd_ok Rset Rext (Rth_ARth Rset Rext Rtheory) (gen_phiZ_morph Rset Rext Rtheory) _ _ _). Qed. Lemma PolZmul_correct : forall P P' l, PhiR l (PolZmul P P') == ((PhiR l P) * (PhiR l P')). Proof. unfold PolZmul, PhiR. intros. refine (Pmul_ok Rset Rext (Rth_ARth Rset Rext Rtheory) (gen_phiZ_morph Rset Rext Rtheory) _ _ _). Qed. Lemma R_power_theory : Ring_theory.power_theory ring1 mul _==_ N.to_nat pow. apply Ring_theory.mkpow_th. unfold pow. intros. rewrite Nnat.N2Nat.id. reflexivity. Qed. Lemma norm_correct : forall (l : list R) (pe : PEZ), PEevalR l pe == PhiR l (norm pe). Proof. intros;apply (norm_aux_spec Rset Rext (Rth_ARth Rset Rext Rtheory) (gen_phiZ_morph Rset Rext Rtheory) R_power_theory). Qed. Lemma PolZeq_correct : forall P P' l, PolZeq P P' = true -> PhiR l P == PhiR l P'. Proof. intros;apply (Peq_ok Rset Rext (gen_phiZ_morph Rset Rext Rtheory));trivial. Qed. Fixpoint Cond0 (A:Type) (Interp:A->R) (l:list A) : Prop := match l with | List.nil => True | a::l => Interp a == 0 /\ Cond0 A Interp l end. Lemma mult_l_correct : forall l la lp, Cond0 PolZ (PhiR l) lp -> PhiR l (mult_l la lp) == 0. Proof. induction la;simpl;intros. - cring. - destruct lp;trivial. + simpl. cring. + simpl in H;destruct H. rewrite PolZadd_correct. simpl. rewrite PolZmul_correct. simpl. rewrite H. rewrite IHla. * cring. * trivial. Qed. Lemma compute_list_correct : forall l lla lp, Cond0 PolZ (PhiR l) lp -> Cond0 PolZ (PhiR l) (compute_list lla lp). Proof. induction lla;simpl;intros;trivial. apply IHlla;simpl;split;trivial. apply mult_l_correct;trivial. Qed. Lemma check_correct : forall l lpe qe certif, check lpe qe certif = true -> Cond0 PEZ (PEevalR l) lpe -> PEevalR l qe == 0. Proof. unfold check;intros l lpe qe (lla, lq) H2 H1. apply PolZeq_correct with (l:=l) in H2. rewrite norm_correct, H2. apply mult_l_correct. apply compute_list_correct. clear H2 lq lla qe;induction lpe;simpl;trivial. simpl in H1;destruct H1. rewrite <- norm_correct;auto. Qed. (* fin *) Definition R2:= 1 + 1. Fixpoint IPR p {struct p}: R := match p with xH => ring1 | xO xH => 1+1 | xO p1 => R2*(IPR p1) | xI xH => 1+(1+1) | xI p1 => 1+(R2*(IPR p1)) end. Definition IZR1 z := match z with Z0 => 0 | Zpos p => IPR p | Zneg p => -(IPR p) end. Fixpoint interpret3 t fv {struct t}: R := match t with | (PEadd t1 t2) => let v1 := interpret3 t1 fv in let v2 := interpret3 t2 fv in (v1 + v2) | (PEmul t1 t2) => let v1 := interpret3 t1 fv in let v2 := interpret3 t2 fv in (v1 * v2) | (PEsub t1 t2) => let v1 := interpret3 t1 fv in let v2 := interpret3 t2 fv in (v1 - v2) | (PEopp t1) => let v1 := interpret3 t1 fv in (-v1) | (PEpow t1 t2) => let v1 := interpret3 t1 fv in pow v1 (N.to_nat t2) | (PEc t1) => (IZR1 t1) | PEO => 0 | PEI => 1 | (PEX _ n) => List.nth (pred (Pos.to_nat n)) fv 0 end. End nsatz1. Ltac equality_to_goal H x y:= (* eliminate trivial hypotheses, but it takes time!: let h := fresh "nH" in (assert (h:equality x y); [solve [cring] | clear H; clear h]) || *) try (generalize (@psos_r1 _ _ _ _ _ _ _ _ _ _ _ x y H); clear H) . Ltac equalities_to_goal := lazymatch goal with | H: (_ ?x ?y) |- _ => equality_to_goal H x y | H: (_ _ ?x ?y) |- _ => equality_to_goal H x y | H: (_ _ _ ?x ?y) |- _ => equality_to_goal H x y | H: (_ _ _ _ ?x ?y) |- _ => equality_to_goal H x y (* extension possible :-) *) | H: (?x == ?y) |- _ => equality_to_goal H x y end. (* lp est incluse dans fv. La met en tete. *) Ltac parametres_en_tete fv lp := match fv with | (@nil _) => lp | (@cons _ ?x ?fv1) => let res := AddFvTail x lp in parametres_en_tete fv1 res end. Ltac append1 a l := match l with | (@nil _) => constr:(cons a l) | (cons ?x ?l) => let l' := append1 a l in constr:(cons x l') end. Ltac rev l := match l with |(@nil _) => l | (cons ?x ?l) => let l' := rev l in append1 x l' end. Ltac nsatz_call_n info nparam p rr lp kont := (* idtac "Trying power: " rr;*) let ll := constr:(PEc info :: PEc nparam :: PEpow p rr :: lp) in (* idtac "calcul...";*) nsatz_compute ll; (* idtac "done";*) match goal with | |- (?c::PEpow _ ?r::?lq0)::?lci0 = _ -> _ => intros _; let lci := fresh "lci" in set (lci:=lci0); let lq := fresh "lq" in set (lq:=lq0); kont c rr lq lci end. Ltac nsatz_call radicalmax info nparam p lp kont := let rec try_n n := lazymatch n with | 0%N => fail | _ => (let r := eval compute in (N.sub radicalmax (N.pred n)) in nsatz_call_n info nparam p r lp kont) || let n' := eval compute in (N.pred n) in try_n n' end in try_n radicalmax. Ltac lterm_goal g := match g with ?b1 == ?b2 => constr:(b1::b2::nil) | ?b1 == ?b2 -> ?g => let l := lterm_goal g in constr:(b1::b2::l) end. Ltac reify_goal l le lb:= match le with nil => idtac | ?e::?le1 => match lb with ?b::?lb1 => (* idtac "b="; idtac b;*) let x := fresh "B" in set (x:= b) at 1; change x with (interpret3 e l); clear x; reify_goal l le1 lb1 end end. Ltac get_lpol g := match g with (interpret3 ?p _) == _ => constr:(p::nil) | (interpret3 ?p _) == _ -> ?g => let l := get_lpol g in constr:(p::l) end. (** We only make use of [discrR] if [nsatz] support for reals is loaded. To do this, we redefine this tactic in Nsatz.v to make use of real discrimination. *) Ltac nsatz_internal_discrR := idtac. Ltac nsatz_generic radicalmax info lparam lvar := let nparam := eval compute in (Z.of_nat (List.length lparam)) in match goal with |- ?g => let lb := lterm_goal g in match (lazymatch lvar with |(@nil _) => lazymatch lparam with |(@nil _) => let r := list_reifyl0 lb in r |_ => let reif := list_reifyl0 lb in match reif with |(?fv, ?le) => let fv := parametres_en_tete fv lparam in (* we reify a second time, with the good order for variables *) list_reifyl fv lb end end |_ => let fv := parametres_en_tete lvar lparam in list_reifyl fv lb end) with |(?fv, ?le) => reify_goal fv le lb ; match goal with |- ?g => let lp := get_lpol g in let lpol := eval compute in (List.rev lp) in intros; let SplitPolyList kont := match lpol with | ?p2::?lp2 => kont p2 lp2 | _ => idtac "polynomial not in the ideal" end in SplitPolyList ltac:(fun p lp => let p21 := fresh "p21" in let lp21 := fresh "lp21" in set (p21:=p) ; set (lp21:=lp); (* idtac "nparam:"; idtac nparam; idtac "p:"; idtac p; idtac "lp:"; idtac lp; *) nsatz_call radicalmax info nparam p lp ltac:(fun c r lq lci => let q := fresh "q" in set (q := PEmul c (PEpow p21 r)); let Hg := fresh "Hg" in assert (Hg:check lp21 q (lci,lq) = true); [ (vm_compute;reflexivity) || idtac "invalid nsatz certificate" | let Hg2 := fresh "Hg" in assert (Hg2: (interpret3 q fv) == 0); [ (*simpl*) idtac; generalize (@check_correct _ _ _ _ _ _ _ _ _ _ _ fv lp21 q (lci,lq) Hg); let cc := fresh "H" in (*simpl*) idtac; intro cc; apply cc; clear cc; (*simpl*) idtac; repeat (split;[assumption|idtac]); exact I | (*simpl in Hg2;*) (*simpl*) idtac; apply Rintegral_domain_pow with (interpret3 c fv) (N.to_nat r); (*simpl*) idtac; try apply integral_domain_one_zero; try apply integral_domain_minus_one_zero; try trivial; try exact integral_domain_one_zero; try exact integral_domain_minus_one_zero || (solve [simpl; unfold R2, equality, eq_notation, addition, add_notation, one, one_notation, multiplication, mul_notation, zero, zero_notation; nsatz_internal_discrR || lia ]) || ((*simpl*) idtac) || idtac "could not prove discrimination result" ] ] ) ) end end end . Ltac nsatz_default:= intros; try apply (@psos_r1b _ _ _ _ _ _ _ _ _ _ _); match goal with |- (@equality ?r _ _ _) => repeat equalities_to_goal; nsatz_generic 6%N 1%Z (@nil r) (@nil r) end. Tactic Notation "nsatz" := nsatz_default. Tactic Notation "nsatz" "with" "radicalmax" ":=" constr(radicalmax) "strategy" ":=" constr(info) "parameters" ":=" constr(lparam) "variables" ":=" constr(lvar):= intros; try apply (@psos_r1b _ _ _ _ _ _ _ _ _ _ _); match goal with |- (@equality ?r _ _ _) => repeat equalities_to_goal; nsatz_generic radicalmax info lparam lvar end. (* Rational numbers *) Require Import QArith. #[global] Instance Qops: (@Ring_ops Q 0%Q 1%Q Qplus Qmult Qminus Qopp Qeq). Defined. #[global] Instance Qri : (Ring (Ro:=Qops)). constructor. - apply Q_Setoid. - apply Qplus_comp. - apply Qmult_comp. - apply Qminus_comp. - apply Qopp_comp. - exact Qplus_0_l. - exact Qplus_comm. - apply Qplus_assoc. - exact Qmult_1_l. - exact Qmult_1_r. - apply Qmult_assoc. - apply Qmult_plus_distr_l. - intros. apply Qmult_plus_distr_r. - reflexivity. - exact Qplus_opp_r. Defined. Lemma Q_one_zero: not (Qeq 1%Q 0%Q). Proof. unfold Qeq. simpl. lia. Qed. #[global] Instance Qcri: (Cring (Rr:=Qri)). red. exact Qmult_comm. Defined. #[global] Instance Qdi : (Integral_domain (Rcr:=Qcri)). constructor. - exact Qmult_integral. - exact Q_one_zero. Defined. (* Integers *) Lemma Z_one_zero: 1%Z <> 0%Z. Proof. lia. Qed. #[global] Instance Zcri: (Cring (Rr:=Zr)). red. exact Z.mul_comm. Defined. #[global] Instance Zdi : (Integral_domain (Rcr:=Zcri)). constructor. - exact Zmult_integral. - exact Z_one_zero. Defined. coq-8.20.0/theories/omega/000077500000000000000000000000001466560755400153175ustar00rootroot00000000000000coq-8.20.0/theories/omega/OmegaLemmas.v000066400000000000000000000176551466560755400177130ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* 0 <= x -> 0 <= y. Proof. now intros ->. Qed. Lemma OMEGA2 x y : 0 <= x -> 0 <= y -> 0 <= x + y. Proof. Z.order_pos. Qed. Lemma OMEGA3 x y k : k > 0 -> x = y * k -> x = 0 -> y = 0. Proof. intros LT -> EQ. apply Z.mul_eq_0 in EQ. destruct EQ; now subst. Qed. Lemma OMEGA4 x y z : x > 0 -> y > x -> z * y + x <> 0. Proof. Z.swap_greater. intros Hx Hxy. rewrite Z.add_move_0_l, <- Z.mul_opp_l. destruct (Z.lt_trichotomy (-z) 1) as [LT|[->|GT]]. - intro. revert LT. apply Z.le_ngt, (Z.le_succ_l 0). apply Z.mul_pos_cancel_r with y; Z.order. - Z.nzsimpl. Z.order. - rewrite (Z.mul_lt_mono_pos_r y), Z.mul_1_l in GT; Z.order. Qed. Lemma OMEGA5 x y z : x = 0 -> y = 0 -> x + y * z = 0. Proof. now intros -> ->. Qed. Lemma OMEGA6 x y z : 0 <= x -> y = 0 -> 0 <= x + y * z. Proof. intros H ->. now Z.nzsimpl. Qed. Lemma OMEGA7 x y z t : z > 0 -> t > 0 -> 0 <= x -> 0 <= y -> 0 <= x * z + y * t. Proof. intros. Z.swap_greater. Z.order_pos. Qed. Lemma OMEGA8 x y : 0 <= x -> 0 <= y -> x = - y -> x = 0. Proof. intros H1 H2 H3. rewrite <- Z.opp_nonpos_nonneg in H2. Z.order. Qed. Lemma OMEGA9 x y z t : y = 0 -> x = z -> y + (- x + z) * t = 0. Proof. intros. subst. now rewrite Z.add_opp_diag_l. Qed. Lemma OMEGA10 v c1 c2 l1 l2 k1 k2 : (v * c1 + l1) * k1 + (v * c2 + l2) * k2 = v * (c1 * k1 + c2 * k2) + (l1 * k1 + l2 * k2). Proof. rewrite ?Z.mul_add_distr_r, ?Z.mul_add_distr_l, ?Z.mul_assoc. rewrite <- !Z.add_assoc. f_equal. apply Z.add_shuffle3. Qed. Lemma OMEGA11 v1 c1 l1 l2 k1 : (v1 * c1 + l1) * k1 + l2 = v1 * (c1 * k1) + (l1 * k1 + l2). Proof. rewrite ?Z.mul_add_distr_r, ?Z.mul_add_distr_l, ?Z.mul_assoc. now rewrite Z.add_assoc. Qed. Lemma OMEGA12 v2 c2 l1 l2 k2 : l1 + (v2 * c2 + l2) * k2 = v2 * (c2 * k2) + (l1 + l2 * k2). Proof. rewrite ?Z.mul_add_distr_r, ?Z.mul_add_distr_l, ?Z.mul_assoc. apply Z.add_shuffle3. Qed. Lemma OMEGA13 (v l1 l2 : Z) (x : positive) : v * Zpos x + l1 + (v * Zneg x + l2) = l1 + l2. Proof. rewrite Z.add_shuffle1. rewrite <- Z.mul_add_distr_l, <- Pos2Z.opp_neg, Z.add_opp_diag_r. now Z.nzsimpl. Qed. Lemma OMEGA14 (v l1 l2 : Z) (x : positive) : v * Zneg x + l1 + (v * Zpos x + l2) = l1 + l2. Proof. rewrite Z.add_shuffle1. rewrite <- Z.mul_add_distr_l, <- Pos2Z.opp_neg, Z.add_opp_diag_r. now Z.nzsimpl. Qed. Lemma OMEGA15 v c1 c2 l1 l2 k2 : v * c1 + l1 + (v * c2 + l2) * k2 = v * (c1 + c2 * k2) + (l1 + l2 * k2). Proof. rewrite ?Z.mul_add_distr_r, ?Z.mul_add_distr_l, ?Z.mul_assoc. apply Z.add_shuffle1. Qed. Lemma OMEGA16 v c l k : (v * c + l) * k = v * (c * k) + l * k. Proof. now rewrite ?Z.mul_add_distr_r, ?Z.mul_add_distr_l, ?Z.mul_assoc. Qed. Lemma OMEGA17 x y z : Zne x 0 -> y = 0 -> Zne (x + y * z) 0. Proof. unfold Zne, not. intros NE EQ. subst. now Z.nzsimpl. Qed. Lemma OMEGA18 x y k : x = y * k -> Zne x 0 -> Zne y 0. Proof. unfold Zne, not. intros. subst; auto. Qed. Lemma OMEGA19 x : Zne x 0 -> 0 <= x + -1 \/ 0 <= x * -1 + -1. Proof. unfold Zne. intros Hx. apply Z.lt_gt_cases in Hx. destruct Hx as [LT|GT]. - right. change (-1) with (-(1)). rewrite Z.mul_opp_r, <- Z.opp_add_distr. Z.nzsimpl. rewrite Z.opp_nonneg_nonpos. now apply Z.le_succ_l. - left. now apply Z.lt_le_pred. Qed. Lemma OMEGA20 x y z : Zne x 0 -> y = 0 -> Zne (x + y * z) 0. Proof. unfold Zne, not. intros H1 H2 H3; apply H1; rewrite H2 in H3; simpl in H3; rewrite Z.add_0_r in H3; trivial with arith. Qed. Definition fast_Zplus_comm (x y : Z) (P : Z -> Prop) (H : P (y + x)) := eq_ind_r P H (Z.add_comm x y). Definition fast_Zplus_assoc_reverse (n m p : Z) (P : Z -> Prop) (H : P (n + (m + p))) := eq_ind_r P H (Zplus_assoc_reverse n m p). Definition fast_Zplus_assoc (n m p : Z) (P : Z -> Prop) (H : P (n + m + p)) := eq_ind_r P H (Z.add_assoc n m p). Definition fast_Zplus_permute (n m p : Z) (P : Z -> Prop) (H : P (m + (n + p))) := eq_ind_r P H (Z.add_shuffle3 n m p). Definition fast_OMEGA10 (v c1 c2 l1 l2 k1 k2 : Z) (P : Z -> Prop) (H : P (v * (c1 * k1 + c2 * k2) + (l1 * k1 + l2 * k2))) := eq_ind_r P H (OMEGA10 v c1 c2 l1 l2 k1 k2). Definition fast_OMEGA11 (v1 c1 l1 l2 k1 : Z) (P : Z -> Prop) (H : P (v1 * (c1 * k1) + (l1 * k1 + l2))) := eq_ind_r P H (OMEGA11 v1 c1 l1 l2 k1). Definition fast_OMEGA12 (v2 c2 l1 l2 k2 : Z) (P : Z -> Prop) (H : P (v2 * (c2 * k2) + (l1 + l2 * k2))) := eq_ind_r P H (OMEGA12 v2 c2 l1 l2 k2). Definition fast_OMEGA15 (v c1 c2 l1 l2 k2 : Z) (P : Z -> Prop) (H : P (v * (c1 + c2 * k2) + (l1 + l2 * k2))) := eq_ind_r P H (OMEGA15 v c1 c2 l1 l2 k2). Definition fast_OMEGA16 (v c l k : Z) (P : Z -> Prop) (H : P (v * (c * k) + l * k)) := eq_ind_r P H (OMEGA16 v c l k). Definition fast_OMEGA13 (v l1 l2 : Z) (x : positive) (P : Z -> Prop) (H : P (l1 + l2)) := eq_ind_r P H (OMEGA13 v l1 l2 x). Definition fast_OMEGA14 (v l1 l2 : Z) (x : positive) (P : Z -> Prop) (H : P (l1 + l2)) := eq_ind_r P H (OMEGA14 v l1 l2 x). Definition fast_Zred_factor0 (x : Z) (P : Z -> Prop) (H : P (x * 1)) := eq_ind_r P H (Zred_factor0 x). Definition fast_Zopp_eq_mult_neg_1 (x : Z) (P : Z -> Prop) (H : P (x * -1)) := eq_ind_r P H (Z.opp_eq_mul_m1 x). Definition fast_Zmult_comm (x y : Z) (P : Z -> Prop) (H : P (y * x)) := eq_ind_r P H (Z.mul_comm x y). Definition fast_Zopp_plus_distr (x y : Z) (P : Z -> Prop) (H : P (- x + - y)) := eq_ind_r P H (Z.opp_add_distr x y). Definition fast_Zopp_mult_distr_r (x y : Z) (P : Z -> Prop) (H : P (x * - y)) := eq_ind_r P H (Zopp_mult_distr_r x y). Definition fast_Zmult_plus_distr_l (n m p : Z) (P : Z -> Prop) (H : P (n * p + m * p)) := eq_ind_r P H (Z.mul_add_distr_r n m p). Definition fast_Zmult_assoc_reverse (n m p : Z) (P : Z -> Prop) (H : P (n * (m * p))) := eq_ind_r P H (Zmult_assoc_reverse n m p). Definition fast_Zred_factor1 (x : Z) (P : Z -> Prop) (H : P (x * 2)) := eq_ind_r P H (Zred_factor1 x). Definition fast_Zred_factor2 (x y : Z) (P : Z -> Prop) (H : P (x * (1 + y))) := eq_ind_r P H (Zred_factor2 x y). Definition fast_Zred_factor3 (x y : Z) (P : Z -> Prop) (H : P (x * (1 + y))) := eq_ind_r P H (Zred_factor3 x y). Definition fast_Zred_factor4 (x y z : Z) (P : Z -> Prop) (H : P (x * (y + z))) := eq_ind_r P H (Zred_factor4 x y z). Definition fast_Zred_factor5 (x y : Z) (P : Z -> Prop) (H : P y) := eq_ind_r P H (Zred_factor5 x y). Definition fast_Zred_factor6 (x : Z) (P : Z -> Prop) (H : P (x + 0)) := eq_ind_r P H (Zred_factor6 x). Theorem intro_Z : forall n:nat, exists y : Z, Z.of_nat n = y /\ 0 <= y * 1 + 0. Proof. intros n; exists (Z.of_nat n); split; trivial. rewrite Z.mul_1_r, Z.add_0_r. apply Nat2Z.is_nonneg. Qed. coq-8.20.0/theories/omega/PreOmega.v000066400000000000000000000302231466560755400172050ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* q₂] for quotients that are likely to be the same, which allows tactics like [nia] to prove more goals, including those relating [Z.div]/[Z.mod] to [Z.quot]/[Z.rem]. The [Z.euclidean_division_equations_cleanup] tactic removes needless hypotheses, which makes tactics like [nia] run faster. The tactic [Z.to_euclidean_division_equations] combines the handling of both variants of division/quotient and modulo/remainder. *) Module Z. Lemma mod_0_r_ext x y : y = 0 -> x mod y = x. Proof. intro; subst; destruct x; reflexivity. Qed. Lemma div_0_r_ext x y : y = 0 -> x / y = 0. Proof. intro; subst; destruct x; reflexivity. Qed. Lemma rem_0_r_ext x y : y = 0 -> Z.rem x y = x. Proof. intro; subst; destruct x; reflexivity. Qed. Lemma quot_0_r_ext x y : y = 0 -> Z.quot x y = 0. Proof. intro; subst; destruct x; reflexivity. Qed. Lemma rem_bound_pos_pos x y : 0 < y -> 0 <= x -> 0 <= Z.rem x y < y. Proof. intros; apply Z.rem_bound_pos; assumption. Qed. Lemma rem_bound_neg_pos x y : y < 0 -> 0 <= x -> 0 <= Z.rem x y < -y. Proof. rewrite <- Z.rem_opp_r'; intros; apply Z.rem_bound_pos; rewrite ?Z.opp_pos_neg; assumption. Qed. Lemma rem_bound_pos_neg x y : 0 < y -> x <= 0 -> -y < Z.rem x y <= 0. Proof. rewrite <- (Z.opp_involutive x), Z.rem_opp_l', <- Z.opp_lt_mono, and_comm, !Z.opp_nonpos_nonneg; apply rem_bound_pos_pos. Qed. Lemma rem_bound_neg_neg x y : y < 0 -> x <= 0 -> y < Z.rem x y <= 0. Proof. rewrite <- (Z.opp_involutive x), <- (Z.opp_involutive y), Z.rem_opp_l', <- Z.opp_lt_mono, and_comm, !Z.opp_nonpos_nonneg, Z.opp_involutive; apply rem_bound_neg_pos. Qed. (* Make the direction of [Z.divide] line up with the rest of the Euclidean equation facts *) Local Lemma divide_alt x y : Z.divide x y -> exists z, y = x * z. Proof. intros [z H]; exists z; subst; apply Z.mul_comm. Qed. Ltac div_mod_to_equations_generalize x y := pose proof (Z.div_mod x y); pose proof (Z.mod_pos_bound x y); pose proof (Z.mod_neg_bound x y); pose proof (div_0_r_ext x y); pose proof (mod_0_r_ext x y); let q := fresh "q" in let r := fresh "r" in set (q := x / y) in *; set (r := x mod y) in *; clearbody q r. Ltac quot_rem_to_equations_generalize x y := pose proof (Z.quot_rem' x y); pose proof (rem_bound_pos_pos x y); pose proof (rem_bound_pos_neg x y); pose proof (rem_bound_neg_pos x y); pose proof (rem_bound_neg_neg x y); pose proof (quot_0_r_ext x y); pose proof (rem_0_r_ext x y); let q := fresh "q" in let r := fresh "r" in set (q := Z.quot x y) in *; set (r := Z.rem x y) in *; clearbody q r. Ltac div_mod_to_equations_step := match goal with | [ |- context[?x / ?y] ] => div_mod_to_equations_generalize x y | [ |- context[?x mod ?y] ] => div_mod_to_equations_generalize x y | [ H : context[?x / ?y] |- _ ] => div_mod_to_equations_generalize x y | [ H : context[?x mod ?y] |- _ ] => div_mod_to_equations_generalize x y end. Ltac quot_rem_to_equations_step := match goal with | [ |- context[Z.quot ?x ?y] ] => quot_rem_to_equations_generalize x y | [ |- context[Z.rem ?x ?y] ] => quot_rem_to_equations_generalize x y | [ H : context[Z.quot ?x ?y] |- _ ] => quot_rem_to_equations_generalize x y | [ H : context[Z.rem ?x ?y] |- _ ] => quot_rem_to_equations_generalize x y end. Ltac divide_to_equations_step := match goal with | [ H : Z.divide _ _ |- _ ] => apply divide_alt in H; destruct H end. Ltac div_mod_to_equations' := repeat div_mod_to_equations_step. Ltac quot_rem_to_equations' := repeat quot_rem_to_equations_step. Ltac divide_to_equations' := repeat divide_to_equations_step. Ltac euclidean_division_equations_cleanup := repeat (repeat match goal with | [ H : 0 <= ?x < _ |- _ ] => destruct H end; repeat match goal with | [ H : ?x <> ?x -> _ |- _ ] => clear H | [ H : ?x < ?x -> _ |- _ ] => clear H | [ H : ?T -> _, H' : ~?T |- _ ] => clear H | [ H : ~?T -> _, H' : ?T |- _ ] => clear H | [ H : ?A -> ?x <> ?x -> _ |- _ ] => clear H | [ H : ?A -> ?x < ?x -> _ |- _ ] => clear H | [ H : ?A -> ?B -> _, H' : ~?B |- _ ] => clear H | [ H : ?A -> ~?B -> _, H' : ?B |- _ ] => clear H | [ H : 0 < ?x -> _, H' : ?x < 0 |- _ ] => clear H | [ H : ?x < 0 -> _, H' : 0 < ?x |- _ ] => clear H | [ H : ?A -> 0 < ?x -> _, H' : ?x < 0 |- _ ] => clear H | [ H : ?A -> ?x < 0 -> _, H' : 0 < ?x |- _ ] => clear H | [ H : 0 <= ?x -> _, H' : ?x < 0 |- _ ] => clear H | [ H : ?x <= 0 -> _, H' : 0 < ?x |- _ ] => clear H | [ H : ?A -> 0 <= ?x -> _, H' : ?x < 0 |- _ ] => clear H | [ H : ?A -> ?x <= 0 -> _, H' : 0 < ?x |- _ ] => clear H | [ H : 0 < ?x -> _, H' : ?x <= 0 |- _ ] => clear H | [ H : ?x < 0 -> _, H' : 0 <= ?x |- _ ] => clear H | [ H : ?A -> 0 < ?x -> _, H' : ?x <= 0 |- _ ] => clear H | [ H : ?A -> ?x < 0 -> _, H' : 0 <= ?x |- _ ] => clear H | [ H : ?x < ?y -> _, H' : ?x = ?y |- _ ] => clear H | [ H : ?x < ?y -> _, H' : ?y = ?x |- _ ] => clear H | [ H : ?A -> ?x < ?y -> _, H' : ?x = ?y |- _ ] => clear H | [ H : ?A -> ?x < ?y -> _, H' : ?y = ?x |- _ ] => clear H | [ H : ?x = ?y -> _, H' : ?x < ?y |- _ ] => clear H | [ H : ?x = ?y -> _, H' : ?y < ?x |- _ ] => clear H | [ H : ?A -> ?x = ?y -> _, H' : ?x < ?y |- _ ] => clear H | [ H : ?A -> ?x = ?y -> _, H' : ?y < ?x |- _ ] => clear H end; repeat match goal with | [ H : ?x = ?x -> ?Q |- _ ] => specialize (H eq_refl) | [ H : ?T -> ?Q, H' : ?T |- _ ] => specialize (H H') | [ H : ?A -> ?x = ?x -> ?Q |- _ ] => specialize (fun a => H a eq_refl) | [ H : ?A -> ?B -> ?Q, H' : ?B |- _ ] => specialize (fun a => H a H') | [ H : 0 <= ?x -> ?Q, H' : ?x <= 0 |- _ ] => specialize (fun pf => H (@Z.eq_le_incl 0 x (eq_sym pf))) | [ H : ?A -> 0 <= ?x -> ?Q, H' : ?x <= 0 |- _ ] => specialize (fun a pf => H a (@Z.eq_le_incl 0 x (eq_sym pf))) | [ H : ?x <= 0 -> ?Q, H' : 0 <= ?x |- _ ] => specialize (fun pf => H (@Z.eq_le_incl 0 x pf)) | [ H : ?A -> ?x <= 0 -> ?Q, H' : 0 <= ?x |- _ ] => specialize (fun a pf => H a (@Z.eq_le_incl x 0 pf)) end). (** poses [x = y \/ x <> y] unless that is redundant or contradictory *) Ltac euclidean_division_equations_pose_eq_fact x y := assert_fails constr_eq x y; lazymatch goal with | [ H : x = y |- _ ] => fail | [ H : y = x |- _ ] => fail | [ H : x = y \/ x <> y |- _ ] => fail | [ H : y = x \/ y <> x |- _ ] => fail | [ H : x < y |- _ ] => fail | [ H : y < x |- _ ] => fail | [ H : x <> y |- _ ] => fail | [ H : y <> x |- _ ] => fail | _ => pose proof (Z.eq_decidable x y : x = y \/ x <> y) end. Ltac euclidean_division_equations_find_duplicate_quotients_step := let pose_eq_fact x y := euclidean_division_equations_pose_eq_fact x y in match goal with | [ H : context[?x = ?y * ?q1], H' : context[?x = ?y * ?q2] |- _ ] => pose_eq_fact q1 q2 | [ H : context[?x = ?y * ?q1 + _], H' : context[?x = ?y * ?q2] |- _ ] => pose_eq_fact q1 q2 | [ H : context[?x = ?y * ?q1 + _], H' : context[?x = ?y * ?q2 + _] |- _ ] => pose_eq_fact q1 q2 | [ H : context[?y * ?q2 + _ = ?y * ?q1 + _] |- _ ] => pose_eq_fact q1 q2 | [ H : context[?x * ?y = ?y * ?q1 + _] |- _ ] => pose_eq_fact x q1 | [ H : context[?y * ?x = ?y * ?q1 + _] |- _ ] => pose_eq_fact x q1 end. Ltac euclidean_division_equations_find_duplicate_quotients := repeat euclidean_division_equations_find_duplicate_quotients_step. Ltac div_mod_to_equations := div_mod_to_equations'; euclidean_division_equations_cleanup. Ltac quot_rem_to_equations := quot_rem_to_equations'; euclidean_division_equations_cleanup. Ltac divide_to_equations := divide_to_equations'; euclidean_division_equations_cleanup. Module euclidean_division_equations_flags. #[local] Set Primitive Projections. Record t := { find_duplicate_quotients : bool }. Ltac default_find_duplicate_quotients := constr:(true). Ltac default := let find_duplicate_quotients_value := default_find_duplicate_quotients in constr:({| find_duplicate_quotients := find_duplicate_quotients_value |}). Module Import DefaultHelpers. Ltac try_unify_args x y := tryif first [ has_evar x | has_evar y ] then (tryif unify x y then idtac else (lazymatch x with | ?f ?x => lazymatch y with | ?g ?y => try_unify_args f g; try_unify_args x y | ?y => fail 0 "Z.euclidean_division_equations_flags: try_unify_args: cannot unify application" x "with non-application" y end | ?x => (tryif has_evar x then fail 0 "Z.euclidean_division_equations_flags: try_unify_args: cannot unify evar-containing non-application" x "with" y else (tryif has_evar y then fail 0 "Z.euclidean_division_equations_flags: try_unify_args: cannot unify non-application" x "with evar-containing" y else fail 100 "Z.euclidean_division_equations_flags: try_unify_args: Impossible inconsistent state of has_evar in try_unify_args" x y)) end)) else idtac. End DefaultHelpers. Ltac flags_with orig_flags proj value := let flags := open_constr:(match True return t with _ => ltac:(econstructor) end) in let __unif := constr:(eq_refl : proj flags = value) in let __force := lazymatch goal with _ => try_unify_args flags orig_flags end in flags. Ltac default_with proj value := flags_with default proj value. Ltac guard_with proj flags tac := lazymatch (eval cbv in (proj flags)) with | true => tac | false => idtac | ?v => let ctrue := constr:(true) in let cfalse := constr:(false) in fail 0 "Invalid flag value for" proj "in" flags "(got" v "expected" ctrue "or" cfalse ")" end. End euclidean_division_equations_flags. Import euclidean_division_equations_flags (find_duplicate_quotients). Ltac to_euclidean_division_equations_with flags := divide_to_equations'; div_mod_to_equations'; quot_rem_to_equations'; euclidean_division_equations_cleanup; euclidean_division_equations_flags.guard_with find_duplicate_quotients flags euclidean_division_equations_find_duplicate_quotients. Ltac to_euclidean_division_equations := to_euclidean_division_equations_with euclidean_division_equations_flags.default. End Z. Require Import ZifyClasses ZifyInst. Require Zify. Ltac Zify.zify_internal_to_euclidean_division_equations ::= Z.to_euclidean_division_equations. Ltac zify := Zify.zify. (* TODO #14736 for compatibility only, should be removed after deprecation *) coq-8.20.0/theories/rtauto/000077500000000000000000000000001466560755400155455ustar00rootroot00000000000000coq-8.20.0/theories/rtauto/Bintree.v000066400000000000000000000233201466560755400173240ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* (p ?= q) = Gt. Proof. intros. rewrite <- Pos.compare_succ_succ. now apply Pos.lt_gt, Pos.lt_lt_succ, Pos.gt_lt. Qed. Lemma Psucc_Gt : forall p, (Pos.succ p ?= p) = Gt. Proof. intros. apply Pos.lt_gt, Pos.lt_succ_diag_r. Qed. Fixpoint Lget (A:Set) (n:nat) (l:list A) {struct l}:option A := match l with nil => None | x::q => match n with O => Some x | S m => Lget A m q end end . Arguments Lget [A] n l. Lemma map_app : forall (A B:Set) (f:A -> B) l m, List.map f (l ++ m) = List.map f l ++ List.map f m. induction l. - reflexivity. - simpl. intro m ; apply f_equal;apply IHl. Qed. Lemma length_map : forall (A B:Set) (f:A -> B) l, length (List.map f l) = length l. induction l. - reflexivity. - simpl; apply f_equal;apply IHl. Qed. Lemma Lget_map : forall (A B:Set) (f:A -> B) i l, Lget i (List.map f l) = match Lget i l with Some a => Some (f a) | None => None end. induction i;intros [ | x l ] ;trivial. simpl;auto. Qed. Lemma Lget_app : forall (A:Set) (a:A) l i, Lget i (l ++ a :: nil) = if Nat.eqb i (length l) then Some a else Lget i l. Proof. induction l;simpl Lget;simpl length. - intros [ | i];simpl;reflexivity. - intros [ | i];simpl. + reflexivity. + auto. Qed. Lemma Lget_app_Some : forall (A:Set) l delta i (a: A), Lget i l = Some a -> Lget i (l ++ delta) = Some a. induction l;destruct i;simpl;try congruence;auto. Qed. Inductive Poption {A} : Type:= PSome : A -> Poption | PNone : Poption. Arguments Poption : clear implicits. Inductive Tree {A} : Type := Tempty : Tree | Branch0 : Tree -> Tree -> Tree | Branch1 : A -> Tree -> Tree -> Tree. Arguments Tree : clear implicits. Section Store. Variable A:Type. Notation Poption := (Poption A). Notation Tree := (Tree A). Fixpoint Tget (p:positive) (T:Tree) {struct p} : Poption := match T with Tempty => PNone | Branch0 T1 T2 => match p with xI pp => Tget pp T2 | xO pp => Tget pp T1 | xH => PNone end | Branch1 a T1 T2 => match p with xI pp => Tget pp T2 | xO pp => Tget pp T1 | xH => PSome a end end. Fixpoint Tadd (p:positive) (a:A) (T:Tree) {struct p}: Tree := match T with | Tempty => match p with | xI pp => Branch0 Tempty (Tadd pp a Tempty) | xO pp => Branch0 (Tadd pp a Tempty) Tempty | xH => Branch1 a Tempty Tempty end | Branch0 T1 T2 => match p with | xI pp => Branch0 T1 (Tadd pp a T2) | xO pp => Branch0 (Tadd pp a T1) T2 | xH => Branch1 a T1 T2 end | Branch1 b T1 T2 => match p with | xI pp => Branch1 b T1 (Tadd pp a T2) | xO pp => Branch1 b (Tadd pp a T1) T2 | xH => Branch1 a T1 T2 end end. Definition mkBranch0 (T1 T2:Tree) := match T1,T2 with Tempty ,Tempty => Tempty | _,_ => Branch0 T1 T2 end. Fixpoint Tremove (p:positive) (T:Tree) {struct p}: Tree := match T with | Tempty => Tempty | Branch0 T1 T2 => match p with | xI pp => mkBranch0 T1 (Tremove pp T2) | xO pp => mkBranch0 (Tremove pp T1) T2 | xH => T end | Branch1 b T1 T2 => match p with | xI pp => Branch1 b T1 (Tremove pp T2) | xO pp => Branch1 b (Tremove pp T1) T2 | xH => mkBranch0 T1 T2 end end. Theorem Tget_Tempty: forall (p : positive), Tget p (Tempty) = PNone. destruct p;reflexivity. Qed. Theorem Tget_Tadd: forall i j a T, Tget i (Tadd j a T) = match (i ?= j) with Eq => PSome a | Lt => Tget i T | Gt => Tget i T end. Proof. intros i j. case_eq (i ?= j). - intro H;rewrite (Pos.compare_eq _ _ H);intros a;clear i H. induction j;destruct T;simpl;try (apply IHj);congruence. - unfold Pos.compare. generalize i;clear i;induction j;destruct T;simpl in H|-*; destruct i;simpl;try rewrite (IHj _ H);try (destruct i;simpl;congruence);reflexivity|| congruence. - unfold Pos.compare. generalize i;clear i;induction j;destruct T;simpl in H|-*; destruct i;simpl;try rewrite (IHj _ H);try (destruct i;simpl;congruence);reflexivity|| congruence. Qed. Record Store : Type := mkStore {index:positive;contents:Tree}. Definition empty := mkStore xH Tempty. Definition push a S := mkStore (Pos.succ (index S)) (Tadd (index S) a (contents S)). Definition get i S := Tget i (contents S). Lemma get_empty : forall i, get i empty = PNone. intro i; case i; unfold empty,get; simpl;reflexivity. Qed. Inductive Full : Store -> Type:= F_empty : Full empty | F_push : forall a S, Full S -> Full (push a S). Theorem get_Full_Gt : forall S, Full S -> forall i, (i ?= index S) = Gt -> get i S = PNone. Proof. intros S W;induction W. - unfold empty,index,get,contents;intros;apply Tget_Tempty. - unfold index,get,push. simpl @contents. intros i e;rewrite Tget_Tadd. rewrite (Gt_Psucc _ _ e). unfold get in IHW. apply IHW;apply Gt_Psucc;assumption. Qed. Theorem get_Full_Eq : forall S, Full S -> get (index S) S = PNone. intros [index0 contents0] F. case F. - unfold empty,index,get,contents;intros;apply Tget_Tempty. - unfold push,index,get;simpl @contents. intros a S. rewrite Tget_Tadd. rewrite Psucc_Gt. intro W. change (get (Pos.succ (index S)) S =PNone). apply get_Full_Gt; auto. apply Psucc_Gt. Qed. Theorem get_push_Full : forall i a S, Full S -> get i (push a S) = match (i ?= index S) with Eq => PSome a | Lt => get i S | Gt => PNone end. Proof. intros i a S F. case_eq (i ?= index S). - intro e;rewrite (Pos.compare_eq _ _ e). destruct S;unfold get,push,index;simpl @contents;rewrite Tget_Tadd. rewrite Pos.compare_refl;reflexivity. - intros;destruct S;unfold get,push,index;simpl @contents;rewrite Tget_Tadd. simpl @index in H;rewrite H;reflexivity. - intro H;generalize H;clear H. unfold get,push;simpl. rewrite Tget_Tadd;intro e;rewrite e. change (get i S=PNone). apply get_Full_Gt;auto. Qed. Lemma Full_push_compat : forall i a S, Full S -> forall x, get i S = PSome x -> get i (push a S) = PSome x. Proof. intros i a S F x H. case_eq (i ?= index S);intro test. - rewrite (Pos.compare_eq _ _ test) in H. rewrite (get_Full_Eq _ F) in H;congruence. - rewrite <- H. rewrite (get_push_Full i a). + rewrite test;reflexivity. + assumption. - rewrite (get_Full_Gt _ F) in H;congruence. Qed. Lemma Full_index_one_empty : forall S, Full S -> index S = 1 -> S=empty. intros [ind cont] F one; inversion F. - reflexivity. - simpl @index in one;assert (h:=Pos.succ_not_1 (index S)). congruence. Qed. Lemma push_not_empty: forall a S, (push a S) <> empty. intros a [ind cont];unfold push,empty. intros [= H%Pos.succ_not_1]. assumption. Qed. Fixpoint In (x:A) (S:Store) (F:Full S) {struct F}: Prop := match F with F_empty => False | F_push a SS FF => x=a \/ In x SS FF end. Lemma get_In : forall (x:A) (S:Store) (F:Full S) i , get i S = PSome x -> In x S F. induction F. - intro i;rewrite get_empty; congruence. - intro i;rewrite get_push_Full;trivial. case_eq (i ?= index S);simpl. + left;congruence. + right;eauto. + congruence. Qed. End Store. Arguments PNone {A}. Arguments PSome [A] _. Arguments Tempty {A}. Arguments Branch0 [A] _ _. Arguments Branch1 [A] _ _ _. Arguments Tget [A] p T. Arguments Tadd [A] p a T. Arguments Tget_Tempty [A] p. Arguments Tget_Tadd [A] i j a T. Arguments mkStore [A] index contents. Arguments index [A] s. Arguments contents [A] s. Arguments empty {A}. Arguments get [A] i S. Arguments push [A] a S. Arguments get_empty [A] i. Arguments get_push_Full [A] i a S _. Arguments Full [A] _. Arguments F_empty {A}. Arguments F_push [A] a S _. Arguments In [A] x S F. Register empty as plugins.rtauto.empty. Register push as plugins.rtauto.push. Section Map. Variables A B:Set. Variable f: A -> B. Fixpoint Tmap (T: Tree A) : Tree B := match T with Tempty => Tempty | Branch0 t1 t2 => Branch0 (Tmap t1) (Tmap t2) | Branch1 a t1 t2 => Branch1 (f a) (Tmap t1) (Tmap t2) end. Lemma Tget_Tmap: forall T i, Tget i (Tmap T)= match Tget i T with PNone => PNone | PSome a => PSome (f a) end. induction T;intro i;case i;simpl;auto. Defined. Lemma Tmap_Tadd: forall i a T, Tmap (Tadd i a T) = Tadd i (f a) (Tmap T). induction i;intros a T;case T;simpl;intros;try (rewrite IHi);simpl;reflexivity. Defined. Definition map (S:Store A) : Store B := mkStore (index S) (Tmap (contents S)). Lemma get_map: forall i S, get i (map S)= match get i S with PNone => PNone | PSome a => PSome (f a) end. destruct S;unfold get,map,contents,index;apply Tget_Tmap. Defined. Lemma map_push: forall a S, map (push a S) = push (f a) (map S). intros a S. case S. unfold push,map,contents,index. intros;rewrite Tmap_Tadd;reflexivity. Defined. Theorem Full_map : forall S, Full S -> Full (map S). intros S F. induction F. - exact F_empty. - rewrite map_push;constructor 2;assumption. Defined. End Map. Arguments Tmap [A B] f T. Arguments map [A B] f S. Arguments Full_map [A B f] S _. Notation "hyps \ A" := (push A hyps) (at level 72,left associativity). (* TODO #14736 for compatibility only, should be removed after deprecation *) Require Arith.EqNat. coq-8.20.0/theories/rtauto/Rtauto.v000066400000000000000000000266011466560755400172170ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* form | Arrow : form -> form -> form | Bot | Conjunct : form -> form -> form | Disjunct : form -> form -> form. Notation "[ n ]":=(Atom n). Notation "A =>> B":= (Arrow A B) (at level 59, right associativity). Notation "#" := Bot. Notation "A //\\ B" := (Conjunct A B) (at level 57, left associativity). Notation "A \\// B" := (Disjunct A B) (at level 58, left associativity). Definition ctx := Store form. Fixpoint pos_eq (m n:positive) {struct m} :bool := match m with xI mm => match n with xI nn => pos_eq mm nn | _ => false end | xO mm => match n with xO nn => pos_eq mm nn | _ => false end | xH => match n with xH => true | _ => false end end. Theorem pos_eq_refl : forall m n, pos_eq m n = true -> m = n. induction m;simpl;destruct n;congruence || (intro e;apply f_equal;auto). Qed. Fixpoint form_eq (p q:form) {struct p} :bool := match p with Atom m => match q with Atom n => pos_eq m n | _ => false end | Arrow p1 p2 => match q with Arrow q1 q2 => form_eq p1 q1 && form_eq p2 q2 | _ => false end | Bot => match q with Bot => true | _ => false end | Conjunct p1 p2 => match q with Conjunct q1 q2 => form_eq p1 q1 && form_eq p2 q2 | _ => false end | Disjunct p1 p2 => match q with Disjunct q1 q2 => form_eq p1 q1 && form_eq p2 q2 | _ => false end end. Theorem form_eq_refl: forall p q, form_eq p q = true -> p = q. induction p;destruct q;simpl;clean. - intro h;generalize (pos_eq_refl _ _ h);congruence. - case_eq (form_eq p1 q1);clean. intros e1 e2;generalize (IHp1 _ e1) (IHp2 _ e2);congruence. - case_eq (form_eq p1 q1);clean. intros e1 e2;generalize (IHp1 _ e1) (IHp2 _ e2);congruence. - case_eq (form_eq p1 q1);clean. intros e1 e2;generalize (IHp1 _ e1) (IHp2 _ e2);congruence. Qed. Arguments form_eq_refl [p q] _. Section with_env. Variable env:Store Prop. Fixpoint interp_form (f:form): Prop := match f with [n]=> match get n env with PNone => True | PSome P => P end | A =>> B => (interp_form A) -> (interp_form B) | # => False | A //\\ B => (interp_form A) /\ (interp_form B) | A \\// B => (interp_form A) \/ (interp_form B) end. Notation "[[ A ]]" := (interp_form A). Fixpoint interp_ctx (hyps:ctx) (F:Full hyps) (G:Prop) {struct F} : Prop := match F with F_empty => G | F_push H hyps0 F0 => interp_ctx hyps0 F0 ([[H]] -> G) end. Ltac wipe := intros;simpl;constructor. Lemma compose0 : forall hyps F (A:Prop), A -> (interp_ctx hyps F A). induction F;intros A H;simpl;auto. Qed. Lemma compose1 : forall hyps F (A B:Prop), (A -> B) -> (interp_ctx hyps F A) -> (interp_ctx hyps F B). induction F;intros A B H;simpl;auto. apply IHF;auto. Qed. Theorem compose2 : forall hyps F (A B C:Prop), (A -> B -> C) -> (interp_ctx hyps F A) -> (interp_ctx hyps F B) -> (interp_ctx hyps F C). induction F;intros A B C H;simpl;auto. apply IHF;auto. Qed. Theorem compose3 : forall hyps F (A B C D:Prop), (A -> B -> C -> D) -> (interp_ctx hyps F A) -> (interp_ctx hyps F B) -> (interp_ctx hyps F C) -> (interp_ctx hyps F D). induction F;intros A B C D H;simpl;auto. apply IHF;auto. Qed. Lemma weaken : forall hyps F f G, (interp_ctx hyps F G) -> (interp_ctx (hyps\f) (F_push f hyps F) G). induction F;simpl;intros;auto. apply compose1 with ([[a]]-> G);auto. Qed. Theorem project_In : forall hyps F g, In g hyps F -> interp_ctx hyps F [[g]]. induction F;simpl. - contradiction. - intros g H;destruct H. + subst;apply compose0;simpl;trivial. + apply compose1 with [[g]];auto. Qed. Theorem project : forall hyps F p g, get p hyps = PSome g-> interp_ctx hyps F [[g]]. intros hyps F p g e; apply project_In. apply get_In with p;assumption. Qed. Arguments project [hyps] F [p g] _. Inductive proof:Set := Ax : positive -> proof | I_Arrow : proof -> proof | E_Arrow : positive -> positive -> proof -> proof | D_Arrow : positive -> proof -> proof -> proof | E_False : positive -> proof | I_And: proof -> proof -> proof | E_And: positive -> proof -> proof | D_And: positive -> proof -> proof | I_Or_l: proof -> proof | I_Or_r: proof -> proof | E_Or: positive -> proof -> proof -> proof | D_Or: positive -> proof -> proof | Cut: form -> proof -> proof -> proof. Notation "hyps \ A" := (push A hyps) (at level 72,left associativity). Fixpoint check_proof (hyps:ctx) (gl:form) (P:proof) {struct P}: bool := match P with Ax i => match get i hyps with PSome F => form_eq F gl | _ => false end | I_Arrow p => match gl with A =>> B => check_proof (hyps \ A) B p | _ => false end | E_Arrow i j p => match get i hyps,get j hyps with PSome A,PSome (B =>>C) => form_eq A B && check_proof (hyps \ C) (gl) p | _,_ => false end | D_Arrow i p1 p2 => match get i hyps with PSome ((A =>>B)=>>C) => (check_proof ( hyps \ B =>> C \ A) B p1) && (check_proof (hyps \ C) gl p2) | _ => false end | E_False i => match get i hyps with PSome # => true | _ => false end | I_And p1 p2 => match gl with A //\\ B => check_proof hyps A p1 && check_proof hyps B p2 | _ => false end | E_And i p => match get i hyps with PSome (A //\\ B) => check_proof (hyps \ A \ B) gl p | _=> false end | D_And i p => match get i hyps with PSome (A //\\ B =>> C) => check_proof (hyps \ A=>>B=>>C) gl p | _=> false end | I_Or_l p => match gl with (A \\// B) => check_proof hyps A p | _ => false end | I_Or_r p => match gl with (A \\// B) => check_proof hyps B p | _ => false end | E_Or i p1 p2 => match get i hyps with PSome (A \\// B) => check_proof (hyps \ A) gl p1 && check_proof (hyps \ B) gl p2 | _=> false end | D_Or i p => match get i hyps with PSome (A \\// B =>> C) => (check_proof (hyps \ A=>>C \ B=>>C) gl p) | _=> false end | Cut A p1 p2 => check_proof hyps A p1 && check_proof (hyps \ A) gl p2 end. Theorem interp_proof: forall p hyps F gl, check_proof hyps gl p = true -> interp_ctx hyps F [[gl]]. induction p; intros hyps F gl. - (* Axiom *) simpl;case_eq (get p hyps);clean. intros f nth_f e;rewrite <- (form_eq_refl e). apply project with p;trivial. - (* Arrow_Intro *) destruct gl; clean. simpl; intros. change (interp_ctx (hyps\gl1) (F_push gl1 hyps F) [[gl2]]). apply IHp; try constructor; trivial. - (* Arrow_Elim *) simpl check_proof; case_eq (get p hyps); clean. intros f ef; case_eq (get p0 hyps); clean. intros f0 ef0; destruct f0; clean. case_eq (form_eq f f0_1); clean. simpl; intros e check_p1. generalize (project F ef) (project F ef0) (IHp (hyps \ f0_2) (F_push f0_2 hyps F) gl check_p1); clear check_p1 IHp p p0 p1 ef ef0. simpl. apply compose3. rewrite (form_eq_refl e). auto. - (* Arrow_Destruct *) simpl; case_eq (get p1 hyps); clean. intros f ef; destruct f; clean. destruct f1; clean. case_eq (check_proof (hyps \ f1_2 =>> f2 \ f1_1) f1_2 p2); clean. intros check_p1 check_p2. generalize (project F ef) (IHp1 (hyps \ f1_2 =>> f2 \ f1_1) (F_push f1_1 (hyps \ f1_2 =>> f2) (F_push (f1_2 =>> f2) hyps F)) f1_2 check_p1) (IHp2 (hyps \ f2) (F_push f2 hyps F) gl check_p2). simpl; apply compose3; auto. - (* False_Elim *) simpl; case_eq (get p hyps); clean. intros f ef; destruct f; clean. intros _; generalize (project F ef). apply compose1; apply False_ind. - (* And_Intro *) simpl; destruct gl; clean. case_eq (check_proof hyps gl1 p1); clean. intros Hp1 Hp2;generalize (IHp1 hyps F gl1 Hp1) (IHp2 hyps F gl2 Hp2). apply compose2 ; simpl; auto. - (* And_Elim *) simpl; case_eq (get p hyps); clean. intros f ef; destruct f; clean. intro check_p; generalize (project F ef) (IHp (hyps \ f1 \ f2) (F_push f2 (hyps \ f1) (F_push f1 hyps F)) gl check_p). simpl; apply compose2; intros [h1 h2]; auto. - (* And_Destruct*) simpl; case_eq (get p hyps); clean. intros f ef; destruct f; clean. destruct f1; clean. intro H; generalize (project F ef) (IHp (hyps \ f1_1 =>> f1_2 =>> f2) (F_push (f1_1 =>> f1_2 =>> f2) hyps F) gl H); clear H; simpl. apply compose2; auto. - (* Or_Intro_left *) destruct gl; clean. intro Hp; generalize (IHp hyps F gl1 Hp). apply compose1; simpl; auto. - (* Or_Intro_right *) destruct gl; clean. intro Hp; generalize (IHp hyps F gl2 Hp). apply compose1; simpl; auto. - (* Or_elim *) simpl; case_eq (get p1 hyps); clean. intros f ef; destruct f; clean. case_eq (check_proof (hyps \ f1) gl p2); clean. intros check_p1 check_p2; generalize (project F ef) (IHp1 (hyps \ f1) (F_push f1 hyps F) gl check_p1) (IHp2 (hyps \ f2) (F_push f2 hyps F) gl check_p2); simpl; apply compose3; simpl; intro h; destruct h; auto. - (* Or_Destruct *) simpl; case_eq (get p hyps); clean. intros f ef; destruct f; clean. destruct f1; clean. intro check_p0; generalize (project F ef) (IHp (hyps \ f1_1 =>> f2 \ f1_2 =>> f2) (F_push (f1_2 =>> f2) (hyps \ f1_1 =>> f2) (F_push (f1_1 =>> f2) hyps F)) gl check_p0); simpl. apply compose2; auto. - (* Cut *) simpl; case_eq (check_proof hyps f p1); clean. intros check_p1 check_p2; generalize (IHp1 hyps F f check_p1) (IHp2 (hyps\f) (F_push f hyps F) gl check_p2); simpl; apply compose2; auto. Qed. Theorem Reflect: forall gl prf, if check_proof empty gl prf then [[gl]] else True. intros gl prf;case_eq (check_proof empty gl prf);intro check_prf. - change (interp_ctx empty F_empty [[gl]]) ; apply interp_proof with prf;assumption. - trivial. Qed. End with_env. (* (* A small example *) Parameters A B C D:Prop. Theorem toto:A /\ (B \/ C) -> (A /\ B) \/ (A /\ C). exact (Reflect (empty \ A \ B \ C) ([1] //\\ ([2] \\// [3]) =>> [1] //\\ [2] \\// [1] //\\ [3]) (I_Arrow (E_And 1 (E_Or 3 (I_Or_l (I_And (Ax 2) (Ax 4))) (I_Or_r (I_And (Ax 2) (Ax 4))))))). Qed. Print toto. *) Register Reflect as plugins.rtauto.Reflect. Register Atom as plugins.rtauto.Atom. Register Arrow as plugins.rtauto.Arrow. Register Bot as plugins.rtauto.Bot. Register Conjunct as plugins.rtauto.Conjunct. Register Disjunct as plugins.rtauto.Disjunct. Register Ax as plugins.rtauto.Ax. Register I_Arrow as plugins.rtauto.I_Arrow. Register E_Arrow as plugins.rtauto.E_Arrow. Register D_Arrow as plugins.rtauto.D_Arrow. Register E_False as plugins.rtauto.E_False. Register I_And as plugins.rtauto.I_And. Register E_And as plugins.rtauto.E_And. Register D_And as plugins.rtauto.D_And. Register I_Or_l as plugins.rtauto.I_Or_l. Register I_Or_r as plugins.rtauto.I_Or_r. Register E_Or as plugins.rtauto.E_Or. Register D_Or as plugins.rtauto.D_Or. coq-8.20.0/theories/setoid_ring/000077500000000000000000000000001466560755400165355ustar00rootroot00000000000000coq-8.20.0/theories/setoid_ring/Algebra_syntax.v000066400000000000000000000030771466560755400216760ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* A -> A. Notation "_+_" := addition. Notation "x + y" := (addition x y). Class Multiplication {A B : Type} := multiplication : A -> B -> B. Notation "_*_" := multiplication. Notation "x * y" := (multiplication x y). Class Subtraction (A : Type) := subtraction : A -> A -> A. Notation "_-_" := subtraction. Notation "x - y" := (subtraction x y). Class Opposite (A : Type) := opposite : A -> A. Notation "-_" := opposite. Notation "- x" := (opposite(x)). Class Equality {A : Type}:= equality : A -> A -> Prop. Notation "_==_" := equality. Notation "x == y" := (equality x y) (at level 70, no associativity). Class Bracket (A B: Type):= bracket : A -> B. Notation "[ x ]" := (bracket(x)). Class Power {A B: Type} := power : A -> B -> A. Notation "x ^ y" := (power x y). coq-8.20.0/theories/setoid_ring/ArithRing.v000066400000000000000000000044601466560755400206170ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* constr:(N.of_nat t) | _ => constr:(InitialRing.NotConstant) end. Ltac Ss_to_add f acc := match f with | S ?f1 => Ss_to_add f1 (S acc) | _ => constr:((acc + f)%nat) end. (* For internal use only *) Local Definition protected_to_nat := N.to_nat. Ltac natprering := match goal with |- context C [S ?p] => match p with O => fail 1 (* avoid replacing 1 with 1+0 ! *) | p => match isnatcst p with | true => fail 1 | false => let v := Ss_to_add p (S 0) in fold v; natprering end end | _ => change N.to_nat with protected_to_nat end. Ltac natpostring := match goal with | |- context [N.to_nat ?x] => let v := eval cbv in (N.to_nat x) in change (N.to_nat x) with v; natpostring | _ => change protected_to_nat with N.to_nat end. Add Ring natr : natSRth (morphism nat_morph_N, constants [natcst], preprocess [natprering], postprocess [natpostring]). coq-8.20.0/theories/setoid_ring/BinList.v000066400000000000000000000047151466560755400202770ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* tl l | xO p => jump p (jump p l) | xI p => jump p (jump p (tl l)) end. Fixpoint nth (p:positive) (l:list A) {struct p} : A:= match p with | xH => hd default l | xO p => nth p (jump p l) | xI p => nth p (jump p (tl l)) end. Lemma jump_tl : forall j l, tl (jump j l) = jump j (tl l). Proof. intro j;induction j as [j IHj|j IHj|];simpl;intros; now rewrite ?IHj. Qed. Lemma jump_succ : forall j l, jump (Pos.succ j) l = jump 1 (jump j l). Proof. intro j;induction j as [j IHj|j IHj|];simpl;intros. - rewrite !IHj; simpl; now rewrite !jump_tl. - now rewrite !jump_tl. - trivial. Qed. Lemma jump_add : forall i j l, jump (i + j) l = jump i (jump j l). Proof. intro i; induction i as [|i IHi] using Pos.peano_ind; intros. - now rewrite Pos.add_1_l, jump_succ. - now rewrite Pos.add_succ_l, !jump_succ, IHi. Qed. Lemma jump_pred_double : forall i l, jump (Pos.pred_double i) (tl l) = jump i (jump i l). Proof. intro i;induction i as [i IHi|i IHi|];intros;simpl. - now rewrite !jump_tl. - now rewrite IHi, <- 2 jump_tl, IHi. - trivial. Qed. Lemma nth_jump : forall p l, nth p (tl l) = hd default (jump p l). Proof. intro p;induction p as [p IHp|p IHp|];simpl;intros. - now rewrite <-jump_tl, IHp. - now rewrite <-jump_tl, IHp. - trivial. Qed. Lemma nth_pred_double : forall p l, nth (Pos.pred_double p) (tl l) = nth p (jump p l). Proof. intro p;induction p as [p IHp|p IHp|];simpl;intros. - now rewrite !jump_tl. - now rewrite jump_pred_double, <- !jump_tl, IHp. - trivial. Qed. End MakeBinList. coq-8.20.0/theories/setoid_ring/Cring.v000066400000000000000000000217671466560755400200030ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* idtac | ?e1::?e2::_ => match goal with |- (?op ?u1 ?u2) => change (op (@Ring_polynom.PEeval _ zero one _+_ _*_ _-_ -_ Z Ncring_initial.gen_phiZ N (fun n:N => n) (@Ring_theory.pow_N _ 1 multiplication) lvar e1) (@Ring_polynom.PEeval _ zero one _+_ _*_ _-_ -_ Z Ncring_initial.gen_phiZ N (fun n:N => n) (@Ring_theory.pow_N _ 1 multiplication) lvar e2)) end end. Section cring. Context {R:Type}`{Rr:Cring R}. Lemma cring_eq_ext: ring_eq_ext _+_ _*_ -_ _==_. Proof. intros. apply mk_reqe; solve_proper. Defined. Lemma cring_almost_ring_theory: almost_ring_theory (R:=R) zero one _+_ _*_ _-_ -_ _==_. intros. apply mk_art ;intros. - rewrite ring_add_0_l; reflexivity. - rewrite ring_add_comm; reflexivity. - rewrite ring_add_assoc; reflexivity. - rewrite ring_mul_1_l; reflexivity. - apply ring_mul_0_l. - rewrite cring_mul_comm; reflexivity. - rewrite ring_mul_assoc; reflexivity. - rewrite ring_distr_l; reflexivity. - rewrite ring_opp_mul_l; reflexivity. - apply ring_opp_add. - rewrite ring_sub_def ; reflexivity. Defined. Lemma cring_morph: ring_morph zero one _+_ _*_ _-_ -_ _==_ 0%Z 1%Z Z.add Z.mul Z.sub Z.opp Zeq_bool Ncring_initial.gen_phiZ. intros. apply mkmorph ; intros; simpl; try reflexivity. - rewrite Ncring_initial.gen_phiZ_add; reflexivity. - rewrite ring_sub_def. unfold Z.sub. rewrite Ncring_initial.gen_phiZ_add. rewrite Ncring_initial.gen_phiZ_opp; reflexivity. - rewrite Ncring_initial.gen_phiZ_mul; reflexivity. - rewrite Ncring_initial.gen_phiZ_opp; reflexivity. - rewrite (Zeqb_ok x y H). reflexivity. Defined. Lemma cring_power_theory : @Ring_theory.power_theory R one _*_ _==_ N (fun n:N => n) (@Ring_theory.pow_N _ 1 multiplication). intros; apply Ring_theory.mkpow_th. reflexivity. Defined. Lemma cring_div_theory: div_theory _==_ Z.add Z.mul Ncring_initial.gen_phiZ Z.quotrem. intros. apply InitialRing.Ztriv_div_th. unfold Setoid_Theory. simpl. apply ring_setoid. Defined. End cring. Ltac cring_gen := match goal with |- ?g => let lterm := lterm_goal g in let reif := list_reifyl0 lterm in match reif with | (?fv, ?lexpr) => (*idtac "variables:";idtac fv; idtac "terms:"; idtac lterm; idtac "reifications:"; idtac lexpr; *) reify_goal fv lexpr lterm; match goal with |- ?g => generalize (@Ring_polynom.ring_correct _ 0 1 _+_ _*_ _-_ -_ _==_ ring_setoid cring_eq_ext cring_almost_ring_theory Z 0%Z 1%Z Z.add Z.mul Z.sub Z.opp Zeq_bool Ncring_initial.gen_phiZ cring_morph N (fun n:N => n) (@Ring_theory.pow_N _ 1 multiplication) cring_power_theory Z.quotrem cring_div_theory O fv nil); let rc := fresh "rc"in intro rc; apply rc end end end. Ltac cring_compute:= vm_compute; reflexivity. Ltac cring:= intros; cring_gen; cring_compute. #[global] Instance Zcri: (Cring (Rr:=Zr)). red. exact Z.mul_comm. Defined. (* Cring_simplify *) Ltac cring_simplify_aux lterm fv lexpr hyp := match lterm with | ?t0::?lterm => match lexpr with | ?e::?le => let t := constr:(@Ring_polynom.norm_subst Z 0%Z 1%Z Z.add Z.mul Z.sub Z.opp Zeq_bool Z.quotrem O nil e) in let te := constr:(@Ring_polynom.Pphi_dev _ 0 1 _+_ _*_ _-_ -_ Z 0%Z 1%Z Zeq_bool Ncring_initial.gen_phiZ get_signZ fv t) in let eq1 := fresh "ring" in let nft := eval vm_compute in t in let t':= fresh "t" in pose (t' := nft); assert (eq1 : t = t'); [vm_cast_no_check (eq_refl t')| let eq2 := fresh "ring" in assert (eq2:(@Ring_polynom.PEeval _ zero _+_ _*_ _-_ -_ Z Ncring_initial.gen_phiZ N (fun n:N => n) (@Ring_theory.pow_N _ 1 multiplication) fv e) == te); [let eq3 := fresh "ring" in generalize (@ring_rw_correct _ 0 1 _+_ _*_ _-_ -_ _==_ ring_setoid cring_eq_ext cring_almost_ring_theory Z 0%Z 1%Z Z.add Z.mul Z.sub Z.opp Zeq_bool Ncring_initial.gen_phiZ cring_morph N (fun n:N => n) (@Ring_theory.pow_N _ 1 multiplication) cring_power_theory Z.quotrem cring_div_theory get_signZ get_signZ_th O nil fv I nil (eq_refl nil) ); intro eq3; apply eq3; reflexivity| match hyp with | 1%nat => rewrite eq2 | ?H => try rewrite eq2 in H end]; let P:= fresh "P" in match hyp with | 1%nat => rewrite eq1; pattern (@Ring_polynom.Pphi_dev _ 0 1 _+_ _*_ _-_ -_ Z 0%Z 1%Z Zeq_bool Ncring_initial.gen_phiZ get_signZ fv t'); match goal with |- (?p ?t) => set (P:=p) end; unfold t' in *; clear t' eq1 eq2; unfold Pphi_dev, Pphi_avoid; simpl; repeat (unfold mkmult1, mkmultm1, mkmult_c_pos, mkmult_c, mkadd_mult, mkmult_c_pos, mkmult_pow, mkadd_mult, mkpow;simpl) | ?H => rewrite eq1 in H; pattern (@Ring_polynom.Pphi_dev _ 0 1 _+_ _*_ _-_ -_ Z 0%Z 1%Z Zeq_bool Ncring_initial.gen_phiZ get_signZ fv t') in H; match type of H with | (?p ?t) => set (P:=p) in H end; unfold t' in *; clear t' eq1 eq2; unfold Pphi_dev, Pphi_avoid in H; simpl in H; repeat (unfold mkmult1, mkmultm1, mkmult_c_pos, mkmult_c, mkadd_mult, mkmult_c_pos, mkmult_pow, mkadd_mult, mkpow in H;simpl in H) end; unfold P in *; clear P ]; cring_simplify_aux lterm fv le hyp | nil => idtac end | nil => idtac end. Ltac set_variables fv := match fv with | nil => idtac | ?t::?fv => let v := fresh "X" in set (v:=t) in *; set_variables fv end. Ltac deset n:= match n with | 0%nat => idtac | S ?n1 => match goal with | h:= ?v : ?t |- ?g => unfold h in *; clear h; deset n1 end end. (* a est soit un terme de l'anneau, soit une liste de termes. J'ai pas réussi à un décomposer les Vlists obtenues avec ne_constr_list dans Tactic Notation *) Ltac cring_simplify_gen a hyp := let lterm := match a with | _::_ => a | _ => constr:(a::nil) end in let reif := list_reifyl0 lterm in match reif with | (?fv, ?lexpr) => idtac lterm; idtac fv; idtac lexpr; let n := eval compute in (length fv) in idtac n; let lt:=fresh "lt" in set (lt:= lterm); let lv:=fresh "fv" in set (lv:= fv); (* les termes de fv sont remplacés par des variables pour pouvoir utiliser simpl ensuite sans risquer des simplifications indésirables *) set_variables fv; let lterm1 := eval unfold lt in lt in let lv1 := eval unfold lv in lv in idtac lterm1; idtac lv1; cring_simplify_aux lterm1 lv1 lexpr hyp; clear lt lv; (* on remet les termes de fv *) deset n end. Tactic Notation "cring_simplify" constr(lterm):= cring_simplify_gen lterm 1%nat. Tactic Notation "cring_simplify" constr(lterm) "in" ident(H):= cring_simplify_gen lterm H. coq-8.20.0/theories/setoid_ring/Field.v000066400000000000000000000013331466560755400177470ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* match t with | rO => fun _ => constr:(@FEO C) | rI => fun _ => constr:(@FEI C) | (radd ?t1 ?t2) => fun _ => let e1 := mkP t1 in let e2 := mkP t2 in constr:(@FEadd C e1 e2) | (rmul ?t1 ?t2) => fun _ => let e1 := mkP t1 in let e2 := mkP t2 in constr:(@FEmul C e1 e2) | (rsub ?t1 ?t2) => fun _ => let e1 := mkP t1 in let e2 := mkP t2 in constr:(@FEsub C e1 e2) | (ropp ?t1) => fun _ => let e1 := mkP t1 in constr:(@FEopp C e1) | (rdiv ?t1 ?t2) => fun _ => let e1 := mkP t1 in let e2 := mkP t2 in constr:(@FEdiv C e1 e2) | (rinv ?t1) => fun _ => let e1 := mkP t1 in constr:(@FEinv C e1) | (rpow ?t1 ?n) => match CstPow n with | InitialRing.NotConstant => fun _ => let p := Find_at t fv in constr:(@FEX C p) | ?c => fun _ => let e1 := mkP t1 in constr:(@FEpow C e1 c) end | _ => fun _ => let p := Find_at t fv in constr:(@FEX C p) end | ?c => fun _ => constr:(@FEc C c) end in f () in mkP t. (* We do not assume that Cst recognizes the rO and rI terms as constants, as *) (* the tactic could be used to discriminate occurrences of an opaque *) (* constant phi, with (phi 0) not convertible to 0 for instance *) Ltac FFV Cst CstPow rO rI add mul sub opp div inv pow t fv := let rec TFV t fv := match Cst t with | InitialRing.NotConstant => match t with | rO => fv | rI => fv | (add ?t1 ?t2) => TFV t2 ltac:(TFV t1 fv) | (mul ?t1 ?t2) => TFV t2 ltac:(TFV t1 fv) | (sub ?t1 ?t2) => TFV t2 ltac:(TFV t1 fv) | (opp ?t1) => TFV t1 fv | (div ?t1 ?t2) => TFV t2 ltac:(TFV t1 fv) | (inv ?t1) => TFV t1 fv | (pow ?t1 ?n) => match CstPow n with | InitialRing.NotConstant => AddFvTail t fv | _ => TFV t1 fv end | _ => AddFvTail t fv end | _ => fv end in TFV t fv. (* packaging the field structure *) (* TODO: inline PackField into field_lookup *) Ltac PackField F req Cst_tac Pow_tac L1 L2 L3 L4 cond_ok pre post := let FLD := match type of L1 with | context [req (@FEeval ?R ?rO ?rI ?radd ?rmul ?rsub ?ropp ?rdiv ?rinv ?C ?phi ?Cpow ?Cp_phi ?rpow _ _) _ ] => (fun proj => proj Cst_tac Pow_tac pre post req rO rI radd rmul rsub ropp rdiv rinv rpow C L1 L2 L3 L4 cond_ok) | _ => fail 1 "field anomaly: bad correctness lemma (parse)" end in F FLD. Ltac get_FldPre FLD := FLD ltac: (fun Cst_tac Pow_tac pre post req r0 r1 radd rmul rsub ropp rdiv rinv rpow C L1 L2 L3 L4 cond_ok => pre). Ltac get_FldPost FLD := FLD ltac: (fun Cst_tac Pow_tac pre post req r0 r1 radd rmul rsub ropp rdiv rinv rpow C L1 L2 L3 L4 cond_ok => post). Ltac get_L1 FLD := FLD ltac: (fun Cst_tac Pow_tac pre post req r0 r1 radd rmul rsub ropp rdiv rinv rpow C L1 L2 L3 L4 cond_ok => L1). Ltac get_SimplifyEqLemma FLD := FLD ltac: (fun Cst_tac Pow_tac pre post req r0 r1 radd rmul rsub ropp rdiv rinv rpow C L1 L2 L3 L4 cond_ok => L2). Ltac get_SimplifyLemma FLD := FLD ltac: (fun Cst_tac Pow_tac pre post req r0 r1 radd rmul rsub ropp rdiv rinv rpow C L1 L2 L3 L4 cond_ok => L3). Ltac get_L4 FLD := FLD ltac: (fun Cst_tac Pow_tac pre post req r0 r1 radd rmul rsub ropp rdiv rinv rpow C L1 L2 L3 L4 cond_ok => L4). Ltac get_CondLemma FLD := FLD ltac: (fun Cst_tac Pow_tac pre post req r0 r1 radd rmul rsub ropp rdiv rinv rpow C L1 L2 L3 L4 cond_ok => cond_ok). Ltac get_FldEq FLD := FLD ltac: (fun Cst_tac Pow_tac pre post req r0 r1 radd rmul rsub ropp rdiv rinv rpow C L1 L2 L3 L4 cond_ok => req). Ltac get_FldCarrier FLD := let req := get_FldEq FLD in relation_carrier req. Ltac get_RingFV FLD := FLD ltac: (fun Cst_tac Pow_tac pre post req r0 r1 radd rmul rsub ropp rdiv rinv rpow C L1 L2 L3 L4 cond_ok => FV Cst_tac Pow_tac r0 r1 radd rmul rsub ropp rpow). Ltac get_FFV FLD := FLD ltac: (fun Cst_tac Pow_tac pre post req r0 r1 radd rmul rsub ropp rdiv rinv rpow C L1 L2 L3 L4 cond_ok => FFV Cst_tac Pow_tac r0 r1 radd rmul rsub ropp rdiv rinv rpow). Ltac get_RingMeta FLD := FLD ltac: (fun Cst_tac Pow_tac pre post req r0 r1 radd rmul rsub ropp rdiv rinv rpow C L1 L2 L3 L4 cond_ok => mkPolexpr C Cst_tac Pow_tac r0 r1 radd rmul rsub ropp rpow). Ltac get_Meta FLD := FLD ltac: (fun Cst_tac Pow_tac pre post req r0 r1 radd rmul rsub ropp rdiv rinv rpow C L1 L2 L3 L4 cond_ok => mkFieldexpr C Cst_tac Pow_tac r0 r1 radd rmul rsub ropp rdiv rinv rpow). Ltac get_Hyp_tac FLD := FLD ltac: (fun Cst_tac Pow_tac pre post req r0 r1 radd rmul rsub ropp rdiv rinv rpow C L1 L2 L3 L4 cond_ok => let mkPol := mkPolexpr C Cst_tac Pow_tac r0 r1 radd rmul rsub ropp rpow in fun fv lH => mkHyp_tac C req ltac:(fun t => mkPol t fv) lH). Ltac get_FEeval FLD := let L1 := get_L1 FLD in match type of L1 with | context [(@FEeval ?R ?r0 ?r1 ?add ?mul ?sub ?opp ?div ?inv ?C ?phi ?Cpow ?powphi ?pow _ _)] => constr:(@FEeval R r0 r1 add mul sub opp div inv C phi Cpow powphi pow) | _ => fail 1 "field anomaly: bad correctness lemma (get_FEeval)" end. (* simplifying the non-zero condition... *) Ltac fold_field_cond req := let rec fold_concl t := match t with ?x /\ ?y => let fx := fold_concl x in let fy := fold_concl y in constr:(fx/\fy) | req ?x ?y -> False => constr:(~ req x y) | _ => t end in let ft := fold_concl Get_goal in change ft. Ltac simpl_PCond FLD := let req := get_FldEq FLD in let lemma := get_CondLemma FLD in try (apply lemma; intros ?lock ?lock_def; vm_compute; rewrite lock_def; clear lock_def lock); protect_fv "field_cond"; fold_field_cond req; try exact I. Ltac simpl_PCond_BEURK FLD := let req := get_FldEq FLD in let lemma := get_CondLemma FLD in (apply lemma; intros ?lock ?lock_def; vm_compute; rewrite lock_def; clear lock_def lock); protect_fv "field_cond"; fold_field_cond req. (* Rewriting (field_simplify) *) Ltac Field_norm_gen f n FLD lH rl := let mkFV := get_RingFV FLD in let mkFFV := get_FFV FLD in let mkFE := get_Meta FLD in let fv0 := FV_hypo_tac mkFV ltac:(get_FldEq FLD) lH in let lemma_tac fv kont := let lemma := get_SimplifyLemma FLD in (* reify equations of the context *) let lpe := get_Hyp_tac FLD fv lH in let vlpe := fresh "hyps" in pose (vlpe := lpe); let prh := proofHyp_tac lH in (* compute the normal form of the reified hyps *) let vlmp := fresh "hyps'" in let vlmp_eq := fresh "hyps_eq" in let mk_monpol := get_MonPol lemma in compute_assertion vlmp_eq vlmp (mk_monpol vlpe); (* partially instantiate the lemma *) let lem := fresh "f_rw_lemma" in (assert (lem := lemma n vlpe fv prh vlmp vlmp_eq) || fail "type error when building the rewriting lemma"); (* continuation will call main_tac for all reified terms *) kont lem; (* at the end, cleanup *) (clear lem vlmp_eq vlmp vlpe||idtac"Field_norm_gen:cleanup failed") in (* each instance of the lemma is simplified then passed to f *) let main_tac H := protect_fv "field" in H; f H in (* generate and use equations for each expression *) ReflexiveRewriteTactic mkFFV mkFE lemma_tac main_tac fv0 rl; try simpl_PCond FLD. Ltac Field_simplify_gen f FLD lH rl := get_FldPre FLD (); Field_norm_gen f ring_subst_niter FLD lH rl; get_FldPost FLD (). Ltac Field_simplify := Field_simplify_gen ltac:(fun H => rewrite H). Tactic Notation (at level 0) "field_simplify" constr_list(rl) := let G := Get_goal in field_lookup (PackField Field_simplify) [] rl G. Tactic Notation (at level 0) "field_simplify" "[" constr_list(lH) "]" constr_list(rl) := let G := Get_goal in field_lookup (PackField Field_simplify) [lH] rl G. Tactic Notation "field_simplify" constr_list(rl) "in" hyp(H):= let G := Get_goal in let t := type of H in let g := fresh "goal" in set (g:= G); revert H; field_lookup (PackField Field_simplify) [] rl t; [ intro H; unfold g | .. ]; clear g. Tactic Notation "field_simplify" "["constr_list(lH) "]" constr_list(rl) "in" hyp(H):= let G := Get_goal in let t := type of H in let g := fresh "goal" in set (g:= G); revert H; field_lookup (PackField Field_simplify) [lH] rl t; [ intro H; unfold g | .. ]; clear g. (* Ltac Field_simplify_in hyp:= Field_simplify_gen ltac:(fun H => rewrite H in hyp). Tactic Notation (at level 0) "field_simplify" constr_list(rl) "in" hyp(h) := let t := type of h in field_lookup (Field_simplify_in h) [] rl t. Tactic Notation (at level 0) "field_simplify" "[" constr_list(lH) "]" constr_list(rl) "in" hyp(h) := let t := type of h in field_lookup (Field_simplify_in h) [lH] rl t. *) (** Generic tactic for solving equations *) Ltac Field_Scheme Simpl_tac n lemma FLD lH := let req := get_FldEq FLD in let mkFV := get_RingFV FLD in let mkFFV := get_FFV FLD in let mkFE := get_Meta FLD in let Main_eq t1 t2 := let fv := FV_hypo_tac mkFV req lH in let fv := mkFFV t1 fv in let fv := mkFFV t2 fv in let lpe := get_Hyp_tac FLD fv lH in let prh := proofHyp_tac lH in let vlpe := fresh "list_hyp" in let fe1 := mkFE t1 fv in let fe2 := mkFE t2 fv in pose (vlpe := lpe); let nlemma := fresh "field_lemma" in (assert (nlemma := lemma n fv vlpe fe1 fe2 prh) || fail "field anomaly:failed to build lemma"); ProveLemmaHyps nlemma ltac:(fun ilemma => apply ilemma || fail "field anomaly: failed in applying lemma"; [ Simpl_tac | simpl_PCond FLD]); clear nlemma; subst vlpe in OnEquation req Main_eq. (* solve completely a field equation, leaving non-zero conditions to be proved (field) *) Ltac FIELD FLD lH rl := let Simpl := vm_compute; reflexivity || fail "not a valid field equation" in let lemma := get_L1 FLD in get_FldPre FLD (); Field_Scheme Simpl Ring_tac.ring_subst_niter lemma FLD lH; try exact I; get_FldPost FLD(). Tactic Notation (at level 0) "field" := let G := Get_goal in field_lookup (PackField FIELD) [] G. Tactic Notation (at level 0) "field" "[" constr_list(lH) "]" := let G := Get_goal in field_lookup (PackField FIELD) [lH] G. (* transforms a field equation to an equivalent (simplified) ring equation, and leaves non-zero conditions to be proved (field_simplify_eq) *) Ltac FIELD_SIMPL FLD lH rl := let Simpl := (protect_fv "field") in let lemma := get_SimplifyEqLemma FLD in get_FldPre FLD (); Field_Scheme Simpl Ring_tac.ring_subst_niter lemma FLD lH; get_FldPost FLD (). Tactic Notation (at level 0) "field_simplify_eq" := let G := Get_goal in field_lookup (PackField FIELD_SIMPL) [] G. Tactic Notation (at level 0) "field_simplify_eq" "[" constr_list(lH) "]" := let G := Get_goal in field_lookup (PackField FIELD_SIMPL) [lH] G. (* Same as FIELD_SIMPL but in hypothesis *) Ltac Field_simplify_eq n FLD lH := let req := get_FldEq FLD in let mkFV := get_RingFV FLD in let mkFFV := get_FFV FLD in let mkFE := get_Meta FLD in let lemma := get_L4 FLD in let hyp := fresh "hyp" in intro hyp; OnEquationHyp req hyp ltac:(fun t1 t2 => let fv := FV_hypo_tac mkFV req lH in let fv := mkFFV t1 fv in let fv := mkFFV t2 fv in let lpe := get_Hyp_tac FLD fv lH in let prh := proofHyp_tac lH in let fe1 := mkFE t1 fv in let fe2 := mkFE t2 fv in let vlpe := fresh "vlpe" in ProveLemmaHyps (lemma n fv lpe fe1 fe2 prh) ltac:(fun ilemma => match type of ilemma with | req _ _ -> _ -> ?EQ => let tmp := fresh "tmp" in assert (tmp : EQ); [ apply ilemma; [ exact hyp | simpl_PCond_BEURK FLD] | protect_fv "field" in tmp; revert tmp ]; clear hyp end)). Ltac FIELD_SIMPL_EQ FLD lH rl := get_FldPre FLD (); Field_simplify_eq Ring_tac.ring_subst_niter FLD lH; get_FldPost FLD (). Tactic Notation (at level 0) "field_simplify_eq" "in" hyp(H) := let t := type of H in generalize H; field_lookup (PackField FIELD_SIMPL_EQ) [] t; [ try exact I | clear H;intro H]. Tactic Notation (at level 0) "field_simplify_eq" "[" constr_list(lH) "]" "in" hyp(H) := let t := type of H in generalize H; field_lookup (PackField FIELD_SIMPL_EQ) [lH] t; [ try exact I |clear H;intro H]. (* More generic tactics to build variants of field *) (* This tactic reifies c and pass to F: - the FLD structure gathering all info in the field DB - the atom list - the expression (FExpr) *) Ltac gen_with_field F c := let MetaExpr FLD _ rl := let R := get_FldCarrier FLD in let mkFFV := get_FFV FLD in let mkFE := get_Meta FLD in let csr := match rl with | List.cons ?r _ => r | _ => fail 1 "anomaly: ill-formed list" end in let fv := mkFFV csr (@List.nil R) in let expr := mkFE csr fv in F FLD fv expr in field_lookup (PackField MetaExpr) [] (c=c). (* pushes the equation expr = ope(expr) in the goal, and discharge it with field *) Ltac prove_field_eqn ope FLD fv expr := let res := ope expr in let expr' := fresh "input_expr" in pose (expr' := expr); let res' := fresh "result" in pose (res' := res); let lemma := get_L1 FLD in let lemma := constr:(lemma O fv List.nil expr' res' I List.nil (eq_refl _)) in let ty := type of lemma in let lhs := match ty with forall _, ?lhs=_ -> _ => lhs end in let rhs := match ty with forall _, _=_ -> forall _, ?rhs=_ -> _ => rhs end in let lhs' := fresh "lhs" in let lhs_eq := fresh "lhs_eq" in let rhs' := fresh "rhs" in let rhs_eq := fresh "rhs_eq" in compute_assertion lhs_eq lhs' lhs; compute_assertion rhs_eq rhs' rhs; let H := fresh "fld_eqn" in refine (_ (lemma lhs' lhs_eq rhs' rhs_eq _ _)); (* main goal *) [intro H;protect_fv "field" in H; revert H (* ring-nf(lhs') = ring-nf(rhs') *) | vm_compute; reflexivity || fail "field cannot prove this equality" (* denominator condition *) | simpl_PCond FLD]; clear lhs_eq rhs_eq; subst lhs' rhs'. Ltac prove_with_field ope c := gen_with_field ltac:(prove_field_eqn ope) c. (* Prove an equation x=ope(x) and rewrite with it *) Ltac prove_rw ope x := prove_with_field ope x; [ let H := fresh "Heq_maple" in intro H; rewrite H; clear H |..]. (* Apply ope (FExpr->FExpr) on an expression *) Ltac reduce_field_expr ope kont FLD fv expr := let evfun := get_FEeval FLD in let res := ope expr in let c := (eval simpl_field_expr in (evfun fv res)) in kont c. (* Hack to let a Ltac return a term in the context of a primitive tactic *) Ltac return_term x := generalize (eq_refl x). Ltac get_term := match goal with | |- ?x = _ -> _ => x end. (* Turn an operation on field expressions (FExpr) into a reduction on terms (in the field carrier). Because of field_lookup, the tactic cannot return a term directly, so it is returned via the conclusion of the goal (return_term). *) Ltac reduce_field_ope ope c := gen_with_field ltac:(reduce_field_expr ope return_term) c. (* Adding a new field *) Ltac ring_of_field f := match type of f with | almost_field_theory _ _ _ _ _ _ _ _ _ => constr:(AF_AR f) | field_theory _ _ _ _ _ _ _ _ _ => constr:(F_R f) | semi_field_theory _ _ _ _ _ _ _ => constr:(SF_SR f) end. Ltac coerce_to_almost_field set ext f := match type of f with | almost_field_theory _ _ _ _ _ _ _ _ _ => f | field_theory _ _ _ _ _ _ _ _ _ => constr:(F2AF set ext f) | semi_field_theory _ _ _ _ _ _ _ => constr:(SF2AF set f) end. Ltac field_elements set ext fspec pspec sspec dspec rk := let afth := coerce_to_almost_field set ext fspec in let rspec := ring_of_field fspec in ring_elements set ext rspec pspec sspec dspec rk ltac:(fun arth ext_r morph p_spec s_spec d_spec f => f afth ext_r morph p_spec s_spec d_spec). Ltac field_lemmas set ext inv_m fspec pspec sspec dspec rk := let get_lemma := match pspec with None => fun x y => x | _ => fun x y => y end in let simpl_eq_lemma := get_lemma Field_simplify_eq_correct Field_simplify_eq_pow_correct in let simpl_eq_in_lemma := get_lemma Field_simplify_eq_in_correct Field_simplify_eq_pow_in_correct in let rw_lemma := get_lemma Field_rw_correct Field_rw_pow_correct in field_elements set ext fspec pspec sspec dspec rk ltac:(fun afth ext_r morph p_spec s_spec d_spec => match morph with | _ => let field_ok1 := constr:(Field_correct set ext_r inv_m afth morph) in match p_spec with | mkhypo ?pp_spec => let field_ok2 := constr:(field_ok1 _ _ _ pp_spec) in match s_spec with | mkhypo ?ss_spec => match d_spec with | mkhypo ?dd_spec => let field_ok := constr:(field_ok2 _ dd_spec) in let mk_lemma lemma := constr:(lemma _ _ _ _ _ _ _ _ _ _ set ext_r inv_m afth _ _ _ _ _ _ _ _ _ morph _ _ _ pp_spec _ ss_spec _ dd_spec) in let field_simpl_eq_ok := mk_lemma simpl_eq_lemma in let field_simpl_ok := mk_lemma rw_lemma in let field_simpl_eq_in := mk_lemma simpl_eq_in_lemma in let cond1_ok := constr:(Pcond_simpl_gen set ext_r afth morph pp_spec dd_spec) in let cond2_ok := constr:(Pcond_simpl_complete set ext_r afth morph pp_spec dd_spec) in (fun f => f afth ext_r morph field_ok field_simpl_ok field_simpl_eq_ok field_simpl_eq_in cond1_ok cond2_ok) | _ => fail 4 "field: bad coefficient division specification" end | _ => fail 3 "field: bad sign specification" end | _ => fail 2 "field: bad power specification" end | _ => fail 1 "field internal error : field_lemmas, please report" end). coq-8.20.0/theories/setoid_ring/Field_theory.v000066400000000000000000001564101466560755400213500ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* R->R) (ropp : R->R). Variable (rdiv : R->R->R) (rinv : R->R). Variable req : R -> R -> Prop. Notation "0" := rO : R_scope. Notation "1" := rI : R_scope. Infix "+" := radd : R_scope. Infix "-" := rsub : R_scope. Infix "*" := rmul : R_scope. Infix "/" := rdiv : R_scope. Notation "- x" := (ropp x) : R_scope. Notation "/ x" := (rinv x) : R_scope. Infix "==" := req (at level 70, no associativity) : R_scope. (* Equality properties *) Variable Rsth : Equivalence req. Variable Reqe : ring_eq_ext radd rmul ropp req. Variable SRinv_ext : forall p q, p == q -> / p == / q. (* Field properties *) Record almost_field_theory : Prop := mk_afield { AF_AR : almost_ring_theory rO rI radd rmul rsub ropp req; AF_1_neq_0 : ~ 1 == 0; AFdiv_def : forall p q, p / q == p * / q; AFinv_l : forall p, ~ p == 0 -> / p * p == 1 }. Section AlmostField. Variable AFth : almost_field_theory. Let ARth := (AF_AR AFth). Let rI_neq_rO := (AF_1_neq_0 AFth). Let rdiv_def := (AFdiv_def AFth). Let rinv_l := (AFinv_l AFth). Add Morphism radd with signature (req ==> req ==> req) as radd_ext. Proof. exact (Radd_ext Reqe). Qed. Add Morphism rmul with signature (req ==> req ==> req) as rmul_ext. Proof. exact (Rmul_ext Reqe). Qed. Add Morphism ropp with signature (req ==> req) as ropp_ext. Proof. exact (Ropp_ext Reqe). Qed. Add Morphism rsub with signature (req ==> req ==> req) as rsub_ext. Proof. exact (ARsub_ext Rsth Reqe ARth). Qed. Add Morphism rinv with signature (req ==> req) as rinv_ext. Proof. exact SRinv_ext. Qed. Let eq_trans := Setoid.Seq_trans _ _ Rsth. Let eq_sym := Setoid.Seq_sym _ _ Rsth. Let eq_refl := Setoid.Seq_refl _ _ Rsth. Let radd_0_l := ARadd_0_l ARth. Let radd_comm := ARadd_comm ARth. Let radd_assoc := ARadd_assoc ARth. Let rmul_1_l := ARmul_1_l ARth. Let rmul_0_l := ARmul_0_l ARth. Let rmul_comm := ARmul_comm ARth. Let rmul_assoc := ARmul_assoc ARth. Let rdistr_l := ARdistr_l ARth. Let ropp_mul_l := ARopp_mul_l ARth. Let ropp_add := ARopp_add ARth. Let rsub_def := ARsub_def ARth. Let radd_0_r := ARadd_0_r Rsth ARth. Let rmul_0_r := ARmul_0_r Rsth ARth. Let rmul_1_r := ARmul_1_r Rsth ARth. Let ropp_0 := ARopp_zero Rsth Reqe ARth. Let rdistr_r := ARdistr_r Rsth Reqe ARth. (* Coefficients : C *) Variable C: Type. Declare Scope C_scope. Bind Scope C_scope with C. Delimit Scope C_scope with coef. Variable (cO cI: C) (cadd cmul csub : C->C->C) (copp : C->C). Variable ceqb : C->C->bool. Variable phi : C -> R. Variable CRmorph : ring_morph rO rI radd rmul rsub ropp req cO cI cadd cmul csub copp ceqb phi. Notation "0" := cO : C_scope. Notation "1" := cI : C_scope. Infix "+" := cadd : C_scope. Infix "-" := csub : C_scope. Infix "*" := cmul : C_scope. Notation "- x" := (copp x) : C_scope. Infix "=?" := ceqb : C_scope. Notation "[ x ]" := (phi x) (at level 0). Let phi_0 := (morph0 CRmorph). Let phi_1 := (morph1 CRmorph). Lemma ceqb_spec c c' : BoolSpec ([c] == [c']) True (c =? c')%coef. Proof. generalize ((morph_eq CRmorph) c c'). destruct (c =? c')%coef; auto. Qed. (* Power coefficients : Cpow *) Variable Cpow : Type. Variable Cp_phi : N -> Cpow. Variable rpow : R -> Cpow -> R. Variable pow_th : power_theory rI rmul req Cp_phi rpow. (* sign function *) Variable get_sign : C -> option C. Variable get_sign_spec : sign_theory copp ceqb get_sign. Variable cdiv:C -> C -> C*C. Variable cdiv_th : div_theory req cadd cmul phi cdiv. Let rpow_pow := (rpow_pow_N pow_th). (* Polynomial expressions : (PExpr C) *) Declare Scope PE_scope. Bind Scope PE_scope with PExpr. Delimit Scope PE_scope with poly. Notation NPEeval := (PEeval rO rI radd rmul rsub ropp phi Cp_phi rpow). Notation "P @ l" := (NPEeval l P) (at level 10, no associativity). Arguments PEc _ _%_coef. Notation "0" := (PEc 0) : PE_scope. Notation "1" := (PEc 1) : PE_scope. Infix "+" := PEadd : PE_scope. Infix "-" := PEsub : PE_scope. Infix "*" := PEmul : PE_scope. Notation "- e" := (PEopp e) : PE_scope. Infix "^" := PEpow : PE_scope. Definition NPEequiv e e' := forall l, e@l == e'@l. Infix "===" := NPEequiv (at level 70, no associativity) : PE_scope. Instance NPEequiv_eq : Equivalence NPEequiv. Proof. split; red; unfold NPEequiv; intros; [reflexivity|symmetry|etransitivity]; eauto. Qed. Instance NPEeval_ext : Proper (eq ==> NPEequiv ==> req) NPEeval. Proof. intros l l' <- e e' He. now rewrite (He l). Qed. Notation Nnorm := (norm_subst cO cI cadd cmul csub copp ceqb cdiv). Notation NPphi_dev := (Pphi_dev rO rI radd rmul rsub ropp cO cI ceqb phi get_sign). Notation NPphi_pow := (Pphi_pow rO rI radd rmul rsub ropp cO cI ceqb phi Cp_phi rpow get_sign). (* add abstract semi-ring to help with some proofs *) Add Ring Rring : (ARth_SRth ARth). (* additional ring properties *) Lemma rsub_0_l r : 0 - r == - r. Proof. rewrite rsub_def; ring. Qed. Lemma rsub_0_r r : r - 0 == r. Proof. rewrite rsub_def, ropp_0; ring. Qed. (*************************************************************************** Properties of division ***************************************************************************) Theorem rdiv_simpl p q : ~ q == 0 -> q * (p / q) == p. Proof. intros. rewrite rdiv_def. transitivity (/ q * q * p); [ ring | ]. now rewrite rinv_l. Qed. Instance rdiv_ext: Proper (req ==> req ==> req) rdiv. Proof. intros p1 p2 Ep q1 q2 Eq. now rewrite !rdiv_def, Ep, Eq. Qed. Lemma rmul_reg_l p q1 q2 : ~ p == 0 -> p * q1 == p * q2 -> q1 == q2. Proof. intros H EQ. assert (H' : p * (q1 / p) == p * (q2 / p)). { now rewrite !rdiv_def, !rmul_assoc, EQ. } now rewrite !rdiv_simpl in H'. Qed. Theorem field_is_integral_domain r1 r2 : ~ r1 == 0 -> ~ r2 == 0 -> ~ r1 * r2 == 0. Proof. intros H1 H2. contradict H2. transitivity (/r1 * r1 * r2). - now rewrite rinv_l. - now rewrite <- rmul_assoc, H2. Qed. Theorem ropp_neq_0 r : ~ -(1) == 0 -> ~ r == 0 -> ~ -r == 0. Proof. intros. setoid_replace (- r) with (- (1) * r). - apply field_is_integral_domain; trivial. - now rewrite <- ropp_mul_l, rmul_1_l. Qed. Theorem rdiv_r_r r : ~ r == 0 -> r / r == 1. Proof. intros. rewrite rdiv_def, rmul_comm. now apply rinv_l. Qed. Theorem rdiv1 r : r == r / 1. Proof. transitivity (1 * (r / 1)). - symmetry; apply rdiv_simpl. apply rI_neq_rO. - apply rmul_1_l. Qed. Theorem rdiv2 a b c d : ~ b == 0 -> ~ d == 0 -> a / b + c / d == (a * d + c * b) / (b * d). Proof. intros H H0. assert (~ b * d == 0) by now apply field_is_integral_domain. apply rmul_reg_l with (b * d); trivial. rewrite rdiv_simpl; trivial. rewrite rdistr_r. apply radd_ext. - now rewrite <- rmul_assoc, (rmul_comm d), rmul_assoc, rdiv_simpl. - now rewrite (rmul_comm c), <- rmul_assoc, rdiv_simpl. Qed. Theorem rdiv2b a b c d e : ~ (b*e) == 0 -> ~ (d*e) == 0 -> a / (b*e) + c / (d*e) == (a * d + c * b) / (b * (d * e)). Proof. intros H H0. assert (~ b == 0) by (contradict H; rewrite H; ring). assert (~ e == 0) by (contradict H; rewrite H; ring). assert (~ d == 0) by (contradict H0; rewrite H0; ring). assert (~ b * (d * e) == 0) by (repeat apply field_is_integral_domain; trivial). apply rmul_reg_l with (b * (d * e)); trivial. rewrite rdiv_simpl; trivial. rewrite rdistr_r. apply radd_ext. - transitivity ((b * e) * (a / (b * e)) * d); [ ring | now rewrite rdiv_simpl ]. - transitivity ((d * e) * (c / (d * e)) * b); [ ring | now rewrite rdiv_simpl ]. Qed. Theorem rdiv5 a b : - (a / b) == - a / b. Proof. now rewrite !rdiv_def, ropp_mul_l. Qed. Theorem rdiv3b a b c d e : ~ (b * e) == 0 -> ~ (d * e) == 0 -> a / (b*e) - c / (d*e) == (a * d - c * b) / (b * (d * e)). Proof. intros H H0. rewrite !rsub_def, rdiv5, ropp_mul_l. now apply rdiv2b. Qed. Theorem rdiv6 a b : ~ a == 0 -> ~ b == 0 -> / (a / b) == b / a. Proof. intros H H0. assert (Hk : ~ a / b == 0). { contradict H. transitivity (b * (a / b)). - now rewrite rdiv_simpl. - rewrite H. apply rmul_0_r. } apply rmul_reg_l with (a / b); trivial. rewrite (rmul_comm (a / b)), rinv_l; trivial. rewrite !rdiv_def. transitivity (/ a * a * (/ b * b)); [ | ring ]. now rewrite !rinv_l, rmul_1_l. Qed. Theorem rdiv4 a b c d : ~ b == 0 -> ~ d == 0 -> (a / b) * (c / d) == (a * c) / (b * d). Proof. intros H H0. assert (~ b * d == 0) by now apply field_is_integral_domain. apply rmul_reg_l with (b * d); trivial. rewrite rdiv_simpl; trivial. transitivity (b * (a / b) * (d * (c / d))); [ ring | ]. rewrite !rdiv_simpl; trivial. Qed. Theorem rdiv4b a b c d e f : ~ b * e == 0 -> ~ d * f == 0 -> ((a * f) / (b * e)) * ((c * e) / (d * f)) == (a * c) / (b * d). Proof. intros H H0. assert (~ b == 0) by (contradict H; rewrite H; ring). assert (~ e == 0) by (contradict H; rewrite H; ring). assert (~ d == 0) by (contradict H0; rewrite H0; ring). assert (~ f == 0) by (contradict H0; rewrite H0; ring). assert (~ b*d == 0) by now apply field_is_integral_domain. assert (~ e*f == 0) by now apply field_is_integral_domain. rewrite rdiv4; trivial. transitivity ((e * f) * (a * c) / ((e * f) * (b * d))). - apply rdiv_ext; ring. - rewrite <- rdiv4, rdiv_r_r; trivial. Qed. Theorem rdiv7 a b c d : ~ b == 0 -> ~ c == 0 -> ~ d == 0 -> (a / b) / (c / d) == (a * d) / (b * c). Proof. intros. rewrite (rdiv_def (a / b)). rewrite rdiv6; trivial. apply rdiv4; trivial. Qed. Theorem rdiv7b a b c d e f : ~ b * f == 0 -> ~ c * e == 0 -> ~ d * f == 0 -> ((a * e) / (b * f)) / ((c * e) / (d * f)) == (a * d) / (b * c). Proof. intros Hbf Hce Hdf. assert (~ c==0) by (contradict Hce; rewrite Hce; ring). assert (~ e==0) by (contradict Hce; rewrite Hce; ring). assert (~ b==0) by (contradict Hbf; rewrite Hbf; ring). assert (~ f==0) by (contradict Hbf; rewrite Hbf; ring). assert (~ b*c==0) by now apply field_is_integral_domain. assert (~ e*f==0) by now apply field_is_integral_domain. rewrite rdiv7; trivial. transitivity ((e * f) * (a * d) / ((e * f) * (b * c))). - apply rdiv_ext; ring. - now rewrite <- rdiv4, rdiv_r_r. Qed. Theorem rinv_nz a : ~ a == 0 -> ~ /a == 0. Proof. intros H H0. apply rI_neq_rO. rewrite <- (rdiv_r_r H), rdiv_def, H0. apply rmul_0_r. Qed. Theorem rdiv8 a b : ~ b == 0 -> a == 0 -> a / b == 0. Proof. intros H H0. now rewrite rdiv_def, H0, rmul_0_l. Qed. Theorem cross_product_eq a b c d : ~ b == 0 -> ~ d == 0 -> a * d == c * b -> a / b == c / d. Proof. intros H H0 H1. transitivity (a / b * (d / d)). - now rewrite rdiv_r_r, rmul_1_r. - now rewrite rdiv4, H1, (rmul_comm b d), <- rdiv4, rdiv_r_r. Qed. (* Results about [pow_pos] and [pow_N] *) Instance pow_ext : Proper (req ==> eq ==> req) (pow_pos rmul). Proof. intros x y H p p' <-. induction p as [p IH| p IH|];simpl; trivial; now rewrite !IH, ?H. Qed. Instance pow_N_ext : Proper (req ==> eq ==> req) (pow_N rI rmul). Proof. intros x y H n n' <-. destruct n; simpl; trivial. now apply pow_ext. Qed. Lemma pow_pos_0 p : pow_pos rmul 0 p == 0. Proof. induction p as [p IHp|p IHp|];simpl;trivial; now rewrite !IHp. Qed. Lemma pow_pos_1 p : pow_pos rmul 1 p == 1. Proof. induction p as [p IHp|p IHp|];simpl;trivial; ring [IHp]. Qed. Lemma pow_pos_cst c p : pow_pos rmul [c] p == [pow_pos cmul c p]. Proof. induction p as [p IHp|p IHp|];simpl;trivial; now rewrite !(morph_mul CRmorph), !IHp. Qed. Lemma pow_pos_mul_l x y p : pow_pos rmul (x * y) p == pow_pos rmul x p * pow_pos rmul y p. Proof. induction p as [p IHp|p IHp|];simpl;trivial; ring [IHp]. Qed. Lemma pow_pos_add_r x p1 p2 : pow_pos rmul x (p1+p2) == pow_pos rmul x p1 * pow_pos rmul x p2. Proof. exact (Ring_theory.pow_pos_add Rsth rmul_ext rmul_assoc x p1 p2). Qed. Lemma pow_pos_mul_r x p1 p2 : pow_pos rmul x (p1*p2) == pow_pos rmul (pow_pos rmul x p1) p2. Proof. induction p1 as [p1 IHp1|p1 IHp1|];simpl;intros; rewrite ?pow_pos_mul_l, ?pow_pos_add_r; simpl; trivial; ring [IHp1]. Qed. Lemma pow_pos_nz x p : ~x==0 -> ~pow_pos rmul x p == 0. Proof. intros Hx. induction p;simpl;trivial; repeat (apply field_is_integral_domain; trivial). Qed. Lemma pow_pos_div a b p : ~ b == 0 -> pow_pos rmul (a / b) p == pow_pos rmul a p / pow_pos rmul b p. Proof. intros H. induction p as [p IHp|p IHp|]; simpl; trivial. - rewrite IHp. assert (nz := pow_pos_nz p H). rewrite !rdiv4; trivial. apply field_is_integral_domain; trivial. - rewrite IHp. assert (nz := pow_pos_nz p H). rewrite !rdiv4; trivial. Qed. (* === is a morphism *) Instance PEadd_ext : Proper (NPEequiv ==> NPEequiv ==> NPEequiv) (@PEadd C). Proof. intros ? ? E ? ? E' l. simpl. now rewrite E, E'. Qed. Instance PEsub_ext : Proper (NPEequiv ==> NPEequiv ==> NPEequiv) (@PEsub C). Proof. intros ? ? E ? ? E' l. simpl. now rewrite E, E'. Qed. Instance PEmul_ext : Proper (NPEequiv ==> NPEequiv ==> NPEequiv) (@PEmul C). Proof. intros ? ? E ? ? E' l. simpl. now rewrite E, E'. Qed. Instance PEopp_ext : Proper (NPEequiv ==> NPEequiv) (@PEopp C). Proof. intros ? ? E l. simpl. now rewrite E. Qed. Instance PEpow_ext : Proper (NPEequiv ==> eq ==> NPEequiv) (@PEpow C). Proof. intros ? ? E ? ? <- l. simpl. rewrite !rpow_pow. apply pow_N_ext; trivial. Qed. Lemma PE_1_l (e : PExpr C) : (1 * e === e)%poly. Proof. intros l. simpl. rewrite phi_1. apply rmul_1_l. Qed. Lemma PE_1_r (e : PExpr C) : (e * 1 === e)%poly. Proof. intros l. simpl. rewrite phi_1. apply rmul_1_r. Qed. Lemma PEpow_0_r (e : PExpr C) : (e ^ 0 === 1)%poly. Proof. intros l. simpl. now rewrite !rpow_pow. Qed. Lemma PEpow_1_r (e : PExpr C) : (e ^ 1 === e)%poly. Proof. intros l. simpl. now rewrite !rpow_pow. Qed. Lemma PEpow_1_l n : (1 ^ n === 1)%poly. Proof. intros l. simpl. rewrite rpow_pow. destruct n; simpl. - now rewrite phi_1. - now rewrite phi_1, pow_pos_1. Qed. Lemma PEpow_add_r (e : PExpr C) n n' : (e ^ (n+n') === e ^ n * e ^ n')%poly. Proof. intros l. simpl. rewrite !rpow_pow. destruct n; simpl. - rewrite rmul_1_l. trivial. - destruct n'; simpl. + rewrite rmul_1_r. trivial. + apply pow_pos_add_r. Qed. Lemma PEpow_mul_l (e e' : PExpr C) n : ((e * e') ^ n === e ^ n * e' ^ n)%poly. Proof. intros l. simpl. rewrite !rpow_pow. destruct n; simpl; trivial. - symmetry; apply rmul_1_l. - apply pow_pos_mul_l. Qed. Lemma PEpow_mul_r (e : PExpr C) n n' : (e ^ (n * n') === (e ^ n) ^ n')%poly. Proof. intros l. simpl. rewrite !rpow_pow. destruct n, n'; simpl; trivial. - now rewrite pow_pos_1. - apply pow_pos_mul_r. Qed. Lemma PEpow_nz l e n : ~ e @ l == 0 -> ~ (e^n) @ l == 0. Proof. intros. simpl. rewrite rpow_pow. destruct n; simpl. - apply rI_neq_rO. - now apply pow_pos_nz. Qed. (*************************************************************************** Some equality test ***************************************************************************) Local Notation "a &&& b" := (if a then b else false) (at level 40, left associativity). (* equality test *) Fixpoint PExpr_eq (e e' : PExpr C) {struct e} : bool := match e, e' with | PEc c, PEc c' => ceqb c c' | PEX _ p, PEX _ p' => Pos.eqb p p' | e1 + e2, e1' + e2' => PExpr_eq e1 e1' &&& PExpr_eq e2 e2' | e1 - e2, e1' - e2' => PExpr_eq e1 e1' &&& PExpr_eq e2 e2' | e1 * e2, e1' * e2' => PExpr_eq e1 e1' &&& PExpr_eq e2 e2' | - e, - e' => PExpr_eq e e' | e ^ n, e' ^ n' => N.eqb n n' &&& PExpr_eq e e' | _, _ => false end%poly. Lemma if_true (a b : bool) : a &&& b = true -> a = true /\ b = true. Proof. destruct a, b; split; trivial. Qed. Theorem PExpr_eq_semi_ok e e' : PExpr_eq e e' = true -> (e === e')%poly. Proof. revert e'; induction e as [| |?|?|? IHe1 ? IHe2|? IHe1 ? IHe2|? IHe1 ? IHe2|? IHe|? IHe ?]; intro e'; destruct e'; simpl; try discriminate. - intros H l. now apply (morph_eq CRmorph). - case Pos.eqb_spec; intros; now subst. - intros H; destruct (if_true _ _ H). now rewrite IHe1, IHe2. - intros H; destruct (if_true _ _ H). now rewrite IHe1, IHe2. - intros H; destruct (if_true _ _ H). now rewrite IHe1, IHe2. - intros H. now rewrite IHe. - intros H. destruct (if_true _ _ H) as [H0 H1]. apply N.eqb_eq in H0. now rewrite IHe, H0. Qed. Lemma PExpr_eq_spec e e' : BoolSpec (e === e')%poly True (PExpr_eq e e'). Proof. assert (H := PExpr_eq_semi_ok e e'). destruct PExpr_eq; constructor; intros; trivial. now apply H. Qed. (** Smart constructors for polynomial expression, with reduction of constants *) Definition NPEadd e1 e2 := match e1, e2 with | PEc c1, PEc c2 => PEc (c1 + c2) | PEc c, _ => if (c =? 0)%coef then e2 else e1 + e2 | _, PEc c => if (c =? 0)%coef then e1 else e1 + e2 (* Peut t'on factoriser ici ??? *) | _, _ => (e1 + e2) end%poly. Infix "++" := NPEadd (at level 60, right associativity). Theorem NPEadd_ok e1 e2 : (e1 ++ e2 === e1 + e2)%poly. Proof. intros l. destruct e1, e2; simpl; try reflexivity; try (case ceqb_spec); try intro H; try rewrite H; simpl; try apply eq_refl; try (ring [phi_0]). apply (morph_add CRmorph). Qed. Definition NPEsub e1 e2 := match e1, e2 with | PEc c1, PEc c2 => PEc (c1 - c2) | PEc c, _ => if (c =? 0)%coef then - e2 else e1 - e2 | _, PEc c => if (c =? 0)%coef then e1 else e1 - e2 (* Peut-on factoriser ici *) | _, _ => e1 - e2 end%poly. Infix "--" := NPEsub (at level 50, left associativity). Theorem NPEsub_ok e1 e2: (e1 -- e2 === e1 - e2)%poly. Proof. intros l. destruct e1, e2; simpl; try reflexivity; try case ceqb_spec; try intro H; try rewrite H; simpl; try rewrite phi_0; try reflexivity; try (symmetry; apply rsub_0_l); try (symmetry; apply rsub_0_r). apply (morph_sub CRmorph). Qed. Definition NPEopp e1 := match e1 with PEc c1 => PEc (- c1) | _ => - e1 end%poly. Theorem NPEopp_ok e : (NPEopp e === -e)%poly. Proof. intros l. destruct e; simpl; trivial. apply (morph_opp CRmorph). Qed. Definition NPEpow x n := match n with | N0 => 1 | Npos p => if (p =? 1)%positive then x else match x with | PEc c => if (c =? 1)%coef then 1 else if (c =? 0)%coef then 0 else PEc (pow_pos cmul c p) | _ => x ^ n end end%poly. Infix "^^" := NPEpow (at level 35, right associativity). Theorem NPEpow_ok e n : (e ^^ n === e ^ n)%poly. Proof. intros l. unfold NPEpow; destruct n. - simpl; now rewrite rpow_pow. - case Pos.eqb_spec; [intro; subst | intros _]. + simpl. now rewrite rpow_pow. + destruct e;simpl;trivial. repeat case ceqb_spec; intros H **; rewrite ?rpow_pow, ?H; simpl. * now rewrite phi_1, pow_pos_1. * now rewrite phi_0, pow_pos_0. * now rewrite pow_pos_cst. Qed. Fixpoint NPEmul (x y : PExpr C) {struct x} : PExpr C := match x, y with | PEc c1, PEc c2 => PEc (c1 * c2) | PEc c, _ => if (c =? 1)%coef then y else if (c =? 0)%coef then 0 else x * y | _, PEc c => if (c =? 1)%coef then x else if (c =? 0)%coef then 0 else x * y | e1 ^ n1, e2 ^ n2 => if (n1 =? n2)%N then (NPEmul e1 e2)^^n1 else x * y | _, _ => x * y end%poly. Infix "**" := NPEmul (at level 40, left associativity). Theorem NPEmul_ok e1 e2 : (e1 ** e2 === e1 * e2)%poly. Proof. intros l. revert e2; induction e1 as [| |?|?|? IHe1 ? IHe2|? IHe1 ? IHe2|? IHe1 ? IHe2|? IHe1|? IHe1 n]; intro e2; destruct e2; simpl;try reflexivity; repeat (case ceqb_spec; intro H; try rewrite H; clear H); simpl; try reflexivity; try ring [phi_0 phi_1]. - apply (morph_mul CRmorph). - case N.eqb_spec; [intros <- | reflexivity]. rewrite NPEpow_ok. simpl. rewrite !rpow_pow. rewrite IHe1. destruct n; simpl; [ ring | apply pow_pos_mul_l ]. Qed. (* simplification *) Fixpoint PEsimp (e : PExpr C) : PExpr C := match e with | e1 + e2 => (PEsimp e1) ++ (PEsimp e2) | e1 * e2 => (PEsimp e1) ** (PEsimp e2) | e1 - e2 => (PEsimp e1) -- (PEsimp e2) | - e1 => NPEopp (PEsimp e1) | e1 ^ n1 => (PEsimp e1) ^^ n1 | _ => e end%poly. Theorem PEsimp_ok e : (PEsimp e === e)%poly. Proof. induction e; simpl. - reflexivity. - reflexivity. - intro l; trivial. - intro l; trivial. - rewrite NPEadd_ok. now f_equiv. - rewrite NPEsub_ok. now f_equiv. - rewrite NPEmul_ok. now f_equiv. - rewrite NPEopp_ok. now f_equiv. - rewrite NPEpow_ok. now f_equiv. Qed. (**************************************************************************** Datastructure ***************************************************************************) (* The input: syntax of a field expression *) Inductive FExpr : Type := | FEO : FExpr | FEI : FExpr | FEc: C -> FExpr | FEX: positive -> FExpr | FEadd: FExpr -> FExpr -> FExpr | FEsub: FExpr -> FExpr -> FExpr | FEmul: FExpr -> FExpr -> FExpr | FEopp: FExpr -> FExpr | FEinv: FExpr -> FExpr | FEdiv: FExpr -> FExpr -> FExpr | FEpow: FExpr -> N -> FExpr . Fixpoint FEeval (l : list R) (pe : FExpr) {struct pe} : R := match pe with | FEO => rO | FEI => rI | FEc c => phi c | FEX x => BinList.nth 0 x l | FEadd x y => FEeval l x + FEeval l y | FEsub x y => FEeval l x - FEeval l y | FEmul x y => FEeval l x * FEeval l y | FEopp x => - FEeval l x | FEinv x => / FEeval l x | FEdiv x y => FEeval l x / FEeval l y | FEpow x n => rpow (FEeval l x) (Cp_phi n) end. Strategy expand [FEeval]. (* The result of the normalisation *) Record linear : Type := mk_linear { num : PExpr C; denum : PExpr C; condition : list (PExpr C) }. (*************************************************************************** Semantics and properties of side condition ***************************************************************************) Fixpoint PCond (l : list R) (le : list (PExpr C)) {struct le} : Prop := match le with | nil => True | e1 :: nil => ~ req (e1 @ l) rO | e1 :: l1 => ~ req (e1 @ l) rO /\ PCond l l1 end. Theorem PCond_cons l a l1 : PCond l (a :: l1) <-> ~ a @ l == 0 /\ PCond l l1. Proof. destruct l1. - simpl. split; [split|destruct 1]; trivial. - reflexivity. Qed. Theorem PCond_cons_inv_l l a l1 : PCond l (a::l1) -> ~ a @ l == 0. Proof. rewrite PCond_cons. now destruct 1. Qed. Theorem PCond_cons_inv_r l a l1 : PCond l (a :: l1) -> PCond l l1. Proof. rewrite PCond_cons. now destruct 1. Qed. Theorem PCond_app l l1 l2 : PCond l (l1 ++ l2) <-> PCond l l1 /\ PCond l l2. Proof. induction l1 as [|a l1 IHl1]. - simpl. split; [split|destruct 1]; trivial. - simpl app. rewrite !PCond_cons, IHl1. symmetry; apply and_assoc. Qed. (* An unsatisfiable condition: issued when a division by zero is detected *) Definition absurd_PCond := cons 0%poly nil. Lemma absurd_PCond_bottom : forall l, ~ PCond l absurd_PCond. Proof. unfold absurd_PCond; simpl. red; intros ? H. apply H. apply phi_0. Qed. (*************************************************************************** Normalisation ***************************************************************************) Definition default_isIn e1 p1 e2 p2 := if PExpr_eq e1 e2 then match Z.pos_sub p1 p2 with | Zpos p => Some (Npos p, 1%poly) | Z0 => Some (N0, 1%poly) | Zneg p => Some (N0, e2 ^^ Npos p) end else None. Fixpoint isIn e1 p1 e2 p2 {struct e2}: option (N * PExpr C) := match e2 with | e3 * e4 => match isIn e1 p1 e3 p2 with | Some (N0, e5) => Some (N0, e5 ** (e4 ^^ Npos p2)) | Some (Npos p, e5) => match isIn e1 p e4 p2 with | Some (n, e6) => Some (n, e5 ** e6) | None => Some (Npos p, e5 ** (e4 ^^ Npos p2)) end | None => match isIn e1 p1 e4 p2 with | Some (n, e5) => Some (n, (e3 ^^ Npos p2) ** e5) | None => None end end | e3 ^ N0 => None | e3 ^ Npos p3 => isIn e1 p1 e3 (Pos.mul p3 p2) | _ => default_isIn e1 p1 e2 p2 end%poly. Definition ZtoN z := match z with Zpos p => Npos p | _ => N0 end. Definition NtoZ n := match n with Npos p => Zpos p | _ => Z0 end. Lemma Z_pos_sub_gt p q : (p > q)%positive -> Z.pos_sub p q = Zpos (p - q). Proof. intros; now apply Z.pos_sub_gt, Pos.gt_lt. Qed. Ltac simpl_pos_sub := rewrite ?Z_pos_sub_gt in * by assumption. Lemma default_isIn_ok e1 e2 p1 p2 : match default_isIn e1 p1 e2 p2 with | Some(n, e3) => let n' := ZtoN (Zpos p1 - NtoZ n) in (e2 ^ N.pos p2 === e1 ^ n' * e3)%poly /\ (Zpos p1 > NtoZ n)%Z | _ => True end. Proof. unfold default_isIn. case PExpr_eq_spec; trivial. intros EQ. rewrite Z.pos_sub_spec. case Pos.compare_spec;intros H; split; try reflexivity. - simpl. now rewrite PE_1_r, H, EQ. - rewrite NPEpow_ok, EQ, <- PEpow_add_r. f_equiv. simpl. f_equiv. now rewrite Pos.add_comm, Pos.sub_add. - simpl. rewrite PE_1_r, EQ. f_equiv. rewrite Z.pos_sub_gt by now apply Pos.sub_decr. simpl. f_equiv. rewrite Pos.sub_sub_distr, Pos.add_comm; trivial. + rewrite Pos.add_sub; trivial. + apply Pos.sub_decr; trivial. - simpl. now apply Z.lt_gt, Pos.sub_decr. Qed. Ltac npe_simpl := rewrite ?NPEmul_ok, ?NPEpow_ok, ?PEpow_mul_l. Ltac npe_ring := intro l; simpl; ring. Theorem isIn_ok e1 p1 e2 p2 : match isIn e1 p1 e2 p2 with | Some(n, e3) => let n' := ZtoN (Zpos p1 - NtoZ n) in (e2 ^ N.pos p2 === e1 ^ n' * e3)%poly /\ (Zpos p1 > NtoZ n)%Z | _ => True end. Proof. Opaque NPEpow. revert p1 p2. induction e2 as [| |?|?|? IHe1 ? IHe2|? IHe1 ? IHe2|? IHe2_1 ? IHe2_2|? IHe|? IHe2 n]; intros p1 p2; try refine (default_isIn_ok e1 _ p1 p2); simpl isIn. - specialize (IHe2_1 p1 p2). destruct isIn as [([|p],e)|]. + split; [|reflexivity]. clear IHe2_2. destruct IHe2_1 as (IH,_). npe_simpl. rewrite IH. npe_ring. + specialize (IHe2_2 p p2). destruct isIn as [([|p'],e')|]. * destruct IHe2_1 as (IH1,GT1). destruct IHe2_2 as (IH2,GT2). split; [|simpl; apply Zgt_trans with (Z.pos p); trivial]. npe_simpl. rewrite IH1, IH2. simpl. simpl_pos_sub. simpl. replace (N.pos p1) with (N.pos p + N.pos (p1 - p))%N. { rewrite PEpow_add_r; npe_ring. } { simpl. f_equal. rewrite Pos.add_comm, Pos.sub_add. - trivial. - now apply Pos.gt_lt. } * destruct IHe2_1 as (IH1,GT1). destruct IHe2_2 as (IH2,GT2). assert (Z.pos p1 > Z.pos p')%Z by (now apply Zgt_trans with (Zpos p)). split; [|simpl; trivial]. npe_simpl. rewrite IH1, IH2. simpl. simpl_pos_sub. simpl. replace (N.pos (p1 - p')) with (N.pos (p1 - p) + N.pos (p - p'))%N. { rewrite PEpow_add_r; npe_ring. } { simpl. f_equal. rewrite Pos.add_sub_assoc, Pos.sub_add; trivial. - now apply Pos.gt_lt. - now apply Pos.gt_lt. } * destruct IHe2_1 as (IH,GT). split; trivial. npe_simpl. rewrite IH. npe_ring. + specialize (IHe2_2 p1 p2). destruct isIn as [(n,e)|]; trivial. destruct IHe2_2 as (IH,GT). split; trivial. set (d := ZtoN (Z.pos p1 - NtoZ n)) in *; clearbody d. npe_simpl. rewrite IH. npe_ring. - destruct n as [|p]; trivial. specialize (IHe2 p1 (p * p2)%positive). destruct isIn as [(n,e)|]; trivial. destruct IHe2 as (IH,GT). split; trivial. set (d := ZtoN (Z.pos p1 - NtoZ n)) in *; clearbody d. now rewrite <- PEpow_mul_r. Qed. Record rsplit : Type := mk_rsplit { rsplit_left : PExpr C; rsplit_common : PExpr C; rsplit_right : PExpr C}. (* Stupid name clash *) Notation left := rsplit_left. Notation right := rsplit_right. Notation common := rsplit_common. Fixpoint split_aux e1 p e2 {struct e1}: rsplit := match e1 with | e3 * e4 => let r1 := split_aux e3 p e2 in let r2 := split_aux e4 p (right r1) in mk_rsplit (left r1 ** left r2) (common r1 ** common r2) (right r2) | e3 ^ N0 => mk_rsplit 1 1 e2 | e3 ^ Npos p3 => split_aux e3 (Pos.mul p3 p) e2 | _ => match isIn e1 p e2 1 with | Some (N0,e3) => mk_rsplit 1 (e1 ^^ Npos p) e3 | Some (Npos q, e3) => mk_rsplit (e1 ^^ Npos q) (e1 ^^ Npos (p - q)) e3 | None => mk_rsplit (e1 ^^ Npos p) 1 e2 end end%poly. Lemma split_aux_ok1 e1 p e2 : (let res := match isIn e1 p e2 1 with | Some (N0,e3) => mk_rsplit 1 (e1 ^^ Npos p) e3 | Some (Npos q, e3) => mk_rsplit (e1 ^^ Npos q) (e1 ^^ Npos (p - q)) e3 | None => mk_rsplit (e1 ^^ Npos p) 1 e2 end in e1 ^ Npos p === left res * common res /\ e2 === right res * common res)%poly. Proof. Opaque NPEpow NPEmul. intros res. unfold res;clear res; generalize (isIn_ok e1 p e2 xH). destruct (isIn e1 p e2 1) as [([|p'],e')|]; simpl. - intros (H1,H2); split; npe_simpl. + now rewrite PE_1_l. + rewrite PEpow_1_r in H1. rewrite H1. npe_ring. - intros (H1,H2); split; npe_simpl. + rewrite <- PEpow_add_r. f_equiv. simpl. f_equal. rewrite Pos.add_comm, Pos.sub_add; trivial. now apply Z.gt_lt in H2. + rewrite PEpow_1_r in H1. rewrite H1. simpl_pos_sub. simpl. npe_ring. - intros _; split; npe_simpl; now rewrite PE_1_r. Qed. Theorem split_aux_ok: forall e1 p e2, (e1 ^ Npos p === left (split_aux e1 p e2) * common (split_aux e1 p e2) /\ e2 === right (split_aux e1 p e2) * common (split_aux e1 p e2))%poly. Proof. intro e1;induction e1 as [| |?|?|? IHe1_1 ? IHe1_2|? IHe1_1 ? IHe1_2|e1_1 IHe1_1 ? IHe1_2|? IHe1|? IHe1 n]; intros k e2; try refine (split_aux_ok1 _ k e2);simpl. - destruct (IHe1_1 k e2) as (H1,H2). destruct (IHe1_2 k (right (split_aux e1_1 k e2))) as (H3,H4). clear IHe1_1 IHe1_2. npe_simpl; split. + rewrite H1, H3. npe_ring. + rewrite H2 at 1. rewrite H4 at 1. npe_ring. - destruct n; simpl. + rewrite PEpow_0_r, PEpow_1_l, !PE_1_r. now split. + rewrite <- PEpow_mul_r. simpl. apply IHe1. Qed. Definition split e1 e2 := split_aux e1 xH e2. Theorem split_ok_l e1 e2 : (e1 === left (split e1 e2) * common (split e1 e2))%poly. Proof. destruct (split_aux_ok e1 xH e2) as (H,_). now rewrite <- H, PEpow_1_r. Qed. Theorem split_ok_r e1 e2 : (e2 === right (split e1 e2) * common (split e1 e2))%poly. Proof. destruct (split_aux_ok e1 xH e2) as (_,H). trivial. Qed. Lemma split_nz_l l e1 e2 : ~ e1 @ l == 0 -> ~ left (split e1 e2) @ l == 0. Proof. intros H. contradict H. rewrite (split_ok_l e1 e2); simpl. now rewrite H, rmul_0_l. Qed. Lemma split_nz_r l e1 e2 : ~ e2 @ l == 0 -> ~ right (split e1 e2) @ l == 0. Proof. intros H. contradict H. rewrite (split_ok_r e1 e2); simpl. now rewrite H, rmul_0_l. Qed. Fixpoint Fnorm (e : FExpr) : linear := match e with | FEO => mk_linear 0 1 nil | FEI => mk_linear 1 1 nil | FEc c => mk_linear (PEc c) 1 nil | FEX x => mk_linear (PEX C x) 1 nil | FEadd e1 e2 => let x := Fnorm e1 in let y := Fnorm e2 in let s := split (denum x) (denum y) in mk_linear ((num x ** right s) ++ (num y ** left s)) (left s ** (right s ** common s)) (condition x ++ condition y)%list | FEsub e1 e2 => let x := Fnorm e1 in let y := Fnorm e2 in let s := split (denum x) (denum y) in mk_linear ((num x ** right s) -- (num y ** left s)) (left s ** (right s ** common s)) (condition x ++ condition y)%list | FEmul e1 e2 => let x := Fnorm e1 in let y := Fnorm e2 in let s1 := split (num x) (denum y) in let s2 := split (num y) (denum x) in mk_linear (left s1 ** left s2) (right s2 ** right s1) (condition x ++ condition y)%list | FEopp e1 => let x := Fnorm e1 in mk_linear (NPEopp (num x)) (denum x) (condition x) | FEinv e1 => let x := Fnorm e1 in mk_linear (denum x) (num x) (num x :: condition x) | FEdiv e1 e2 => let x := Fnorm e1 in let y := Fnorm e2 in let s1 := split (num x) (num y) in let s2 := split (denum x) (denum y) in mk_linear (left s1 ** right s2) (left s2 ** right s1) (num y :: condition x ++ condition y)%list | FEpow e1 n => let x := Fnorm e1 in mk_linear ((num x)^^n) ((denum x)^^n) (condition x) end. (* Example *) (* Eval compute in (Fnorm (FEdiv (FEc cI) (FEadd (FEinv (FEX xH%positive)) (FEinv (FEX (xO xH)%positive))))). *) Theorem Pcond_Fnorm l e : PCond l (condition (Fnorm e)) -> ~ (denum (Fnorm e))@l == 0. Proof. induction e as [| |?|?|? IHe1 ? IHe2|? IHe1 ? IHe2|? IHe1 ? IHe2|? IHe|? IHe|? IHe1 ? IHe2|? IHe n]; simpl condition; rewrite ?PCond_cons, ?PCond_app; simpl denum; intros (Hc1,Hc2) || intros Hc; rewrite ?NPEmul_ok. - simpl. rewrite phi_1; exact rI_neq_rO. - simpl. rewrite phi_1; exact rI_neq_rO. - simpl; intros. rewrite phi_1; exact rI_neq_rO. - simpl; intros. rewrite phi_1; exact rI_neq_rO. - rewrite <- split_ok_r. simpl. apply field_is_integral_domain. + apply split_nz_l, IHe1, Hc1. + apply IHe2, Hc2. - rewrite <- split_ok_r. simpl. apply field_is_integral_domain. + apply split_nz_l, IHe1, Hc1. + apply IHe2, Hc2. - simpl. apply field_is_integral_domain. + apply split_nz_r, IHe1, Hc1. + apply split_nz_r, IHe2, Hc2. - now apply IHe. - trivial. - destruct Hc2 as (Hc2,_). simpl. apply field_is_integral_domain. + apply split_nz_l, IHe1, Hc2. + apply split_nz_r, Hc1. - rewrite NPEpow_ok. apply PEpow_nz, IHe, Hc. Qed. (*************************************************************************** Main theorem ***************************************************************************) Ltac uneval := repeat match goal with | |- context [ ?x @ ?l * ?y @ ?l ] => change (x@l * y@l) with ((x*y)@l) | |- context [ ?x @ ?l + ?y @ ?l ] => change (x@l + y@l) with ((x+y)@l) end. Theorem Fnorm_FEeval_PEeval l fe: PCond l (condition (Fnorm fe)) -> FEeval l fe == (num (Fnorm fe)) @ l / (denum (Fnorm fe)) @ l. Proof. induction fe as [| |?|?|fe1 IHfe1 fe2 IHfe2|fe1 IHfe1 fe2 IHfe2|fe1 IHfe1 fe2 IHfe2|fe IHfe|fe IHfe|fe1 IHfe1 fe2 IHfe2|fe IHfe n]; simpl condition; rewrite ?PCond_cons, ?PCond_app; simpl; intros (Hc1,Hc2) || intros Hc; try (specialize (IHfe1 Hc1);apply Pcond_Fnorm in Hc1); try (specialize (IHfe2 Hc2);apply Pcond_Fnorm in Hc2); try set (F1 := Fnorm fe1) in *; try set (F2 := Fnorm fe2) in *. - now rewrite phi_1, phi_0, rdiv_def. - now rewrite phi_1; apply rdiv1. - rewrite phi_1; apply rdiv1. - rewrite phi_1; apply rdiv1. - rewrite NPEadd_ok, !NPEmul_ok. simpl. rewrite <- rdiv2b; uneval; rewrite <- ?split_ok_l, <- ?split_ok_r; trivial. now f_equiv. - rewrite NPEsub_ok, !NPEmul_ok. simpl. rewrite <- rdiv3b; uneval; rewrite <- ?split_ok_l, <- ?split_ok_r; trivial. now f_equiv. - rewrite !NPEmul_ok. simpl. rewrite IHfe1, IHfe2. rewrite (split_ok_l (num F1) (denum F2) l), (split_ok_r (num F1) (denum F2) l), (split_ok_l (num F2) (denum F1) l), (split_ok_r (num F2) (denum F1) l) in *. apply rdiv4b; trivial. - rewrite NPEopp_ok; simpl; rewrite (IHfe Hc); apply rdiv5. - rewrite (IHfe Hc2); apply rdiv6; trivial; apply Pcond_Fnorm; trivial. - destruct Hc2 as (Hc2,Hc3). rewrite !NPEmul_ok. simpl. assert (U1 := split_ok_l (num F1) (num F2) l). assert (U2 := split_ok_r (num F1) (num F2) l). assert (U3 := split_ok_l (denum F1) (denum F2) l). assert (U4 := split_ok_r (denum F1) (denum F2) l). rewrite (IHfe1 Hc2), (IHfe2 Hc3), U1, U2, U3, U4. simpl in U2, U3, U4. apply rdiv7b; rewrite <- ?U2, <- ?U3, <- ?U4; try apply Pcond_Fnorm; trivial. - rewrite !NPEpow_ok. simpl. rewrite !rpow_pow, (IHfe Hc). destruct n; simpl. + apply rdiv1. + apply pow_pos_div. apply Pcond_Fnorm; trivial. Qed. Theorem Fnorm_crossproduct l fe1 fe2 : let nfe1 := Fnorm fe1 in let nfe2 := Fnorm fe2 in (num nfe1 * denum nfe2) @ l == (num nfe2 * denum nfe1) @ l -> PCond l (condition nfe1 ++ condition nfe2) -> FEeval l fe1 == FEeval l fe2. Proof. simpl. rewrite PCond_app. intros Hcrossprod (Hc1,Hc2). rewrite !Fnorm_FEeval_PEeval; trivial. apply cross_product_eq; trivial; apply Pcond_Fnorm; trivial. Qed. (* Correctness lemmas of reflexive tactics *) Notation Ninterp_PElist := (interp_PElist rO rI radd rmul rsub ropp req phi Cp_phi rpow). Notation Nmk_monpol_list := (mk_monpol_list cO cI cadd cmul csub copp ceqb cdiv). Theorem Fnorm_ok: forall n l lpe fe, Ninterp_PElist l lpe -> Peq ceqb (Nnorm n (Nmk_monpol_list lpe) (num (Fnorm fe))) (Pc cO) = true -> PCond l (condition (Fnorm fe)) -> FEeval l fe == 0. Proof. intros n l lpe fe Hlpe H H1. rewrite (Fnorm_FEeval_PEeval l fe H1). apply rdiv8. - apply Pcond_Fnorm; trivial. - transitivity (0@l); trivial. rewrite (norm_subst_ok Rsth Reqe ARth CRmorph pow_th cdiv_th n l lpe); trivial. change (0 @ l) with (Pphi 0 radd rmul phi l (Pc cO)). apply (Peq_ok Rsth Reqe CRmorph); trivial. Qed. Notation ring_rw_correct := (ring_rw_correct Rsth Reqe ARth CRmorph pow_th cdiv_th get_sign_spec). Notation ring_rw_pow_correct := (ring_rw_pow_correct Rsth Reqe ARth CRmorph pow_th cdiv_th get_sign_spec). Notation ring_correct := (ring_correct Rsth Reqe ARth CRmorph pow_th cdiv_th). (* simplify a field expression into a fraction *) Definition display_linear l num den := let lnum := NPphi_dev l num in match den with | Pc c => if ceqb c cI then lnum else lnum / NPphi_dev l den | _ => lnum / NPphi_dev l den end. Definition display_pow_linear l num den := let lnum := NPphi_pow l num in match den with | Pc c => if ceqb c cI then lnum else lnum / NPphi_pow l den | _ => lnum / NPphi_pow l den end. Theorem Field_rw_correct n lpe l : Ninterp_PElist l lpe -> forall lmp, Nmk_monpol_list lpe = lmp -> forall fe nfe, Fnorm fe = nfe -> PCond l (condition nfe) -> FEeval l fe == display_linear l (Nnorm n lmp (num nfe)) (Nnorm n lmp (denum nfe)). Proof. intros Hlpe lmp lmp_eq fe nfe eq_nfe H; subst nfe lmp. rewrite (Fnorm_FEeval_PEeval _ _ H). unfold display_linear. destruct (Nnorm _ _ _) as [c | | ] eqn: HN; try ( apply rdiv_ext; eapply ring_rw_correct; eauto). destruct (ceqb_spec c cI) as [H0|]. - set (nnum := NPphi_dev _ _). apply eq_trans with (nnum / NPphi_dev l (Pc c)). + apply rdiv_ext; eapply ring_rw_correct; eauto. + rewrite Pphi_dev_ok; try eassumption. now simpl; rewrite H0, phi_1, <- rdiv1. - apply rdiv_ext; eapply ring_rw_correct; eauto. Qed. Theorem Field_rw_pow_correct n lpe l : Ninterp_PElist l lpe -> forall lmp, Nmk_monpol_list lpe = lmp -> forall fe nfe, Fnorm fe = nfe -> PCond l (condition nfe) -> FEeval l fe == display_pow_linear l (Nnorm n lmp (num nfe)) (Nnorm n lmp (denum nfe)). Proof. intros Hlpe lmp lmp_eq fe nfe eq_nfe H; subst nfe lmp. rewrite (Fnorm_FEeval_PEeval _ _ H). unfold display_pow_linear. destruct (Nnorm _ _ _) as [c | | ] eqn: HN; try ( apply rdiv_ext; eapply ring_rw_pow_correct; eauto). destruct (ceqb_spec c cI) as [H0|]. - set (nnum := NPphi_pow _ _). apply eq_trans with (nnum / NPphi_pow l (Pc c)). + apply rdiv_ext; eapply ring_rw_pow_correct; eauto. + rewrite Pphi_pow_ok; try eassumption. now simpl; rewrite H0, phi_1, <- rdiv1. - apply rdiv_ext; eapply ring_rw_pow_correct; eauto. Qed. Theorem Field_correct n l lpe fe1 fe2 : Ninterp_PElist l lpe -> forall lmp, Nmk_monpol_list lpe = lmp -> forall nfe1, Fnorm fe1 = nfe1 -> forall nfe2, Fnorm fe2 = nfe2 -> Peq ceqb (Nnorm n lmp (num nfe1 * denum nfe2)) (Nnorm n lmp (num nfe2 * denum nfe1)) = true -> PCond l (condition nfe1 ++ condition nfe2) -> FEeval l fe1 == FEeval l fe2. Proof. intros Hlpe lmp eq_lmp nfe1 eq1 nfe2 eq2 Hnorm Hcond; subst nfe1 nfe2 lmp. apply Fnorm_crossproduct; trivial. eapply ring_correct; eauto. Qed. (* simplify a field equation : generate the crossproduct and simplify polynomials *) (** This allows rewriting modulo the simplification of PEeval on PMul *) Declare Equivalent Keys PEeval rmul. Theorem Field_simplify_eq_correct : forall n l lpe fe1 fe2, Ninterp_PElist l lpe -> forall lmp, Nmk_monpol_list lpe = lmp -> forall nfe1, Fnorm fe1 = nfe1 -> forall nfe2, Fnorm fe2 = nfe2 -> forall den, split (denum nfe1) (denum nfe2) = den -> NPphi_dev l (Nnorm n lmp (num nfe1 * right den)) == NPphi_dev l (Nnorm n lmp (num nfe2 * left den)) -> PCond l (condition nfe1 ++ condition nfe2) -> FEeval l fe1 == FEeval l fe2. Proof. intros n l lpe fe1 fe2 Hlpe lmp Hlmp nfe1 eq1 nfe2 eq2 den eq3 Hcrossprod Hcond. apply Fnorm_crossproduct; rewrite ?eq1, ?eq2; trivial. simpl. rewrite (split_ok_l (denum nfe1) (denum nfe2) l), eq3. rewrite (split_ok_r (denum nfe1) (denum nfe2) l), eq3. simpl. rewrite !rmul_assoc. apply rmul_ext; trivial. rewrite (ring_rw_correct n lpe l Hlpe Logic.eq_refl (num nfe1 * right den) Logic.eq_refl), (ring_rw_correct n lpe l Hlpe Logic.eq_refl (num nfe2 * left den) Logic.eq_refl). rewrite Hlmp. apply Hcrossprod. Qed. Theorem Field_simplify_eq_pow_correct : forall n l lpe fe1 fe2, Ninterp_PElist l lpe -> forall lmp, Nmk_monpol_list lpe = lmp -> forall nfe1, Fnorm fe1 = nfe1 -> forall nfe2, Fnorm fe2 = nfe2 -> forall den, split (denum nfe1) (denum nfe2) = den -> NPphi_pow l (Nnorm n lmp (num nfe1 * right den)) == NPphi_pow l (Nnorm n lmp (num nfe2 * left den)) -> PCond l (condition nfe1 ++ condition nfe2) -> FEeval l fe1 == FEeval l fe2. Proof. intros n l lpe fe1 fe2 Hlpe lmp Hlmp nfe1 eq1 nfe2 eq2 den eq3 Hcrossprod Hcond. apply Fnorm_crossproduct; rewrite ?eq1, ?eq2; trivial. simpl. rewrite (split_ok_l (denum nfe1) (denum nfe2) l), eq3. rewrite (split_ok_r (denum nfe1) (denum nfe2) l), eq3. simpl. rewrite !rmul_assoc. apply rmul_ext; trivial. rewrite (ring_rw_pow_correct n lpe l Hlpe Logic.eq_refl (num nfe1 * right den) Logic.eq_refl), (ring_rw_pow_correct n lpe l Hlpe Logic.eq_refl (num nfe2 * left den) Logic.eq_refl). rewrite Hlmp. apply Hcrossprod. Qed. Theorem Field_simplify_aux_ok l fe1 fe2 den : FEeval l fe1 == FEeval l fe2 -> split (denum (Fnorm fe1)) (denum (Fnorm fe2)) = den -> PCond l (condition (Fnorm fe1) ++ condition (Fnorm fe2)) -> (num (Fnorm fe1) * right den) @ l == (num (Fnorm fe2) * left den) @ l. Proof. rewrite PCond_app; intros Hfe Hden (Hc1,Hc2); simpl. assert (Hc1' := Pcond_Fnorm _ _ Hc1). assert (Hc2' := Pcond_Fnorm _ _ Hc2). set (N1 := num (Fnorm fe1)) in *. set (N2 := num (Fnorm fe2)) in *. set (D1 := denum (Fnorm fe1)) in *. set (D2 := denum (Fnorm fe2)) in *. assert (~ (common den) @ l == 0). { intro H. apply Hc1'. rewrite (split_ok_l D1 D2 l). rewrite Hden. simpl. ring [H]. } apply (@rmul_reg_l ((common den) @ l)); trivial. rewrite !(rmul_comm ((common den) @ l)), <- !rmul_assoc. change (N1@l * (right den * common den) @ l == N2@l * (left den * common den) @ l). rewrite <- Hden, <- split_ok_l, <- split_ok_r. apply (@rmul_reg_l (/ D2@l)). { apply rinv_nz; trivial. } rewrite (rmul_comm (/ D2 @ l)), <- !rmul_assoc. rewrite <- rdiv_def, rdiv_r_r, rmul_1_r by trivial. apply (@rmul_reg_l (/ (D1@l))). { apply rinv_nz; trivial. } rewrite !(rmul_comm (/ D1@l)), <- !rmul_assoc. rewrite <- !rdiv_def, rdiv_r_r, rmul_1_r by trivial. rewrite (rmul_comm (/ D2@l)), <- rdiv_def. unfold N1,N2,D1,D2; rewrite <- !Fnorm_FEeval_PEeval; trivial. Qed. Theorem Field_simplify_eq_pow_in_correct : forall n l lpe fe1 fe2, Ninterp_PElist l lpe -> forall lmp, Nmk_monpol_list lpe = lmp -> forall nfe1, Fnorm fe1 = nfe1 -> forall nfe2, Fnorm fe2 = nfe2 -> forall den, split (denum nfe1) (denum nfe2) = den -> forall np1, Nnorm n lmp (num nfe1 * right den) = np1 -> forall np2, Nnorm n lmp (num nfe2 * left den) = np2 -> FEeval l fe1 == FEeval l fe2 -> PCond l (condition nfe1 ++ condition nfe2) -> NPphi_pow l np1 == NPphi_pow l np2. Proof. intros n l lpe fe1 fe2 ? lmp ? nfe1 ? nfe2 ? den ? np1 ? np2 ? ? ?. subst nfe1 nfe2 lmp np1 np2. rewrite !(Pphi_pow_ok Rsth Reqe ARth CRmorph pow_th get_sign_spec). repeat (rewrite <- (norm_subst_ok Rsth Reqe ARth CRmorph pow_th);trivial). simpl. apply Field_simplify_aux_ok; trivial. Qed. Theorem Field_simplify_eq_in_correct : forall n l lpe fe1 fe2, Ninterp_PElist l lpe -> forall lmp, Nmk_monpol_list lpe = lmp -> forall nfe1, Fnorm fe1 = nfe1 -> forall nfe2, Fnorm fe2 = nfe2 -> forall den, split (denum nfe1) (denum nfe2) = den -> forall np1, Nnorm n lmp (num nfe1 * right den) = np1 -> forall np2, Nnorm n lmp (num nfe2 * left den) = np2 -> FEeval l fe1 == FEeval l fe2 -> PCond l (condition nfe1 ++ condition nfe2) -> NPphi_dev l np1 == NPphi_dev l np2. Proof. intros n l lpe fe1 fe2 ? lmp ? nfe1 ? nfe2 ? den ? np1 ? np2 ? ? ?. subst nfe1 nfe2 lmp np1 np2. rewrite !(Pphi_dev_ok Rsth Reqe ARth CRmorph get_sign_spec). repeat (rewrite <- (norm_subst_ok Rsth Reqe ARth CRmorph pow_th);trivial). apply Field_simplify_aux_ok; trivial. Qed. Section Fcons_impl. Variable Fcons : PExpr C -> list (PExpr C) -> list (PExpr C). Hypothesis PCond_fcons_inv : forall l a l1, PCond l (Fcons a l1) -> ~ a @ l == 0 /\ PCond l l1. Fixpoint Fapp (l m:list (PExpr C)) {struct l} : list (PExpr C) := match l with | nil => m | cons a l1 => Fcons a (Fapp l1 m) end. Lemma fcons_ok : forall l l1, (forall lock, lock = PCond l -> lock (Fapp l1 nil)) -> PCond l l1. Proof. intros l l1 h1; assert (H := h1 (PCond l) (refl_equal _));clear h1. induction l1 as [|a l1 IHl1]; simpl; intros. - trivial. - elim PCond_fcons_inv with (1 := H); intros. destruct l1; trivial. split; trivial. apply IHl1; trivial. Qed. End Fcons_impl. Section Fcons_simpl. (* Some general simpifications of the condition: eliminate duplicates, split multiplications *) Fixpoint Fcons (e:PExpr C) (l:list (PExpr C)) {struct l} : list (PExpr C) := match l with nil => cons e nil | cons a l1 => if PExpr_eq e a then l else cons a (Fcons e l1) end. Theorem PFcons_fcons_inv: forall l a l1, PCond l (Fcons a l1) -> ~ a @ l == 0 /\ PCond l l1. Proof. intros l a l1; induction l1 as [|e l1 IHl1]; simpl Fcons. - simpl; now split. - case PExpr_eq_spec; intros H; rewrite !PCond_cons; intros (H1,H2); repeat split; trivial. + now rewrite H. + now apply IHl1. + now apply IHl1. Qed. (* equality of normal forms rather than syntactic equality *) Fixpoint Fcons0 (e:PExpr C) (l:list (PExpr C)) {struct l} : list (PExpr C) := match l with nil => cons e nil | cons a l1 => if Peq ceqb (Nnorm O nil e) (Nnorm O nil a) then l else cons a (Fcons0 e l1) end. Theorem PFcons0_fcons_inv: forall l a l1, PCond l (Fcons0 a l1) -> ~ a @ l == 0 /\ PCond l l1. Proof. intros l a l1; induction l1 as [|e l1 IHl1]; simpl Fcons0. - simpl; now split. - generalize (ring_correct O l nil a e). lazy zeta; simpl Peq. case Peq; intros H; rewrite !PCond_cons; intros (H1,H2); repeat split; trivial. + now rewrite H. + now apply IHl1. + now apply IHl1. Qed. (* split factorized denominators *) Fixpoint Fcons00 (e:PExpr C) (l:list (PExpr C)) {struct e} : list (PExpr C) := match e with PEmul e1 e2 => Fcons00 e1 (Fcons00 e2 l) | PEpow e1 _ => Fcons00 e1 l | _ => Fcons0 e l end. Theorem PFcons00_fcons_inv: forall l a l1, PCond l (Fcons00 a l1) -> ~ a @ l == 0 /\ PCond l l1. Proof. intros l a; elim a; try (intros; apply PFcons0_fcons_inv; trivial; fail). - intros p H p0 H0 l1 H1. simpl in H1. destruct (H _ H1) as (H2,H3). destruct (H0 _ H3) as (H4,H5). split; trivial. simpl. apply field_is_integral_domain; trivial. - intros ? H ? ? H0. destruct (H _ H0). split; trivial. apply PEpow_nz; trivial. Qed. Definition Pcond_simpl_gen := fcons_ok _ PFcons00_fcons_inv. (* Specific case when the equality test of coefs is complete w.r.t. the field equality: non-zero coefs can be eliminated, and opposite can be simplified (if -1 <> 0) *) Hypothesis ceqb_complete : forall c1 c2, [c1] == [c2] -> ceqb c1 c2 = true. Lemma ceqb_spec' c1 c2 : Bool.reflect ([c1] == [c2]) (ceqb c1 c2). Proof. assert (H := morph_eq CRmorph c1 c2). assert (H' := @ceqb_complete c1 c2). destruct (ceqb c1 c2); constructor. - now apply H. - intro E. specialize (H' E). discriminate. Qed. Fixpoint Fcons1 (e:PExpr C) (l:list (PExpr C)) {struct e} : list (PExpr C) := match e with | PEmul e1 e2 => Fcons1 e1 (Fcons1 e2 l) | PEpow e _ => Fcons1 e l | PEopp e => if (-(1) =? 0)%coef then absurd_PCond else Fcons1 e l | PEc c => if (c =? 0)%coef then absurd_PCond else l | _ => Fcons0 e l end. Theorem PFcons1_fcons_inv: forall l a l1, PCond l (Fcons1 a l1) -> ~ a @ l == 0 /\ PCond l l1. Proof. intros l a; elim a; try (intros; apply PFcons0_fcons_inv; trivial; fail). - simpl; intros c l1. case ceqb_spec'; intros H H0. + elim (@absurd_PCond_bottom l H0). + split; trivial. rewrite <- phi_0; trivial. - intros p H p0 H0 l1 H1. simpl in H1. destruct (H _ H1) as (H2,H3). destruct (H0 _ H3) as (H4,H5). split; trivial. simpl. apply field_is_integral_domain; trivial. - simpl; intros p H l1. case ceqb_spec'; intros H0 H1. + elim (@absurd_PCond_bottom l H1). + destruct (H _ H1). split; trivial. apply ropp_neq_0; trivial. rewrite (morph_opp CRmorph), phi_0, phi_1 in H0. trivial. - intros ? H ? ? H0. destruct (H _ H0);split;trivial. apply PEpow_nz; trivial. Qed. Definition Fcons2 e l := Fcons1 (PEsimp e) l. Theorem PFcons2_fcons_inv: forall l a l1, PCond l (Fcons2 a l1) -> ~ a @ l == 0 /\ PCond l l1. Proof. unfold Fcons2; intros l a l1 H; split; case (PFcons1_fcons_inv l (PEsimp a) l1); trivial. intros H1 H2 H3; case H1. transitivity (a@l); trivial. apply PEsimp_ok. Qed. Definition Pcond_simpl_complete := fcons_ok _ PFcons2_fcons_inv. End Fcons_simpl. End AlmostField. Section FieldAndSemiField. Record field_theory : Prop := mk_field { F_R : ring_theory rO rI radd rmul rsub ropp req; F_1_neq_0 : ~ 1 == 0; Fdiv_def : forall p q, p / q == p * / q; Finv_l : forall p, ~ p == 0 -> / p * p == 1 }. Definition F2AF f := mk_afield (Rth_ARth Rsth Reqe (F_R f)) (F_1_neq_0 f) (Fdiv_def f) (Finv_l f). Record semi_field_theory : Prop := mk_sfield { SF_SR : semi_ring_theory rO rI radd rmul req; SF_1_neq_0 : ~ 1 == 0; SFdiv_def : forall p q, p / q == p * / q; SFinv_l : forall p, ~ p == 0 -> / p * p == 1 }. End FieldAndSemiField. End MakeFieldPol. Definition SF2AF R (rO rI:R) radd rmul rdiv rinv req Rsth (sf:semi_field_theory rO rI radd rmul rdiv rinv req) := mk_afield _ _ (SRth_ARth Rsth (SF_SR sf)) (SF_1_neq_0 sf) (SFdiv_def sf) (SFinv_l sf). Section Complete. Variable R : Type. Variable (rO rI : R) (radd rmul rsub: R->R->R) (ropp : R -> R). Variable (rdiv : R -> R -> R) (rinv : R -> R). Variable req : R -> R -> Prop. Notation "0" := rO. Notation "1" := rI. Notation "x + y" := (radd x y). Notation "x * y " := (rmul x y). Notation "x - y " := (rsub x y). Notation "- x" := (ropp x). Notation "x / y " := (rdiv x y). Notation "/ x" := (rinv x). Notation "x == y" := (req x y) (at level 70, no associativity). Variable Rsth : Setoid_Theory R req. Add Parametric Relation : R req reflexivity proved by (@Equivalence_Reflexive _ _ Rsth) symmetry proved by (@Equivalence_Symmetric _ _ Rsth) transitivity proved by (@Equivalence_Transitive _ _ Rsth) as R_setoid3. Variable Reqe : ring_eq_ext radd rmul ropp req. Add Morphism radd with signature (req ==> req ==> req) as radd_ext3. Proof. exact (Radd_ext Reqe). Qed. Add Morphism rmul with signature (req ==> req ==> req) as rmul_ext3. Proof. exact (Rmul_ext Reqe). Qed. Add Morphism ropp with signature (req ==> req) as ropp_ext3. Proof. exact (Ropp_ext Reqe). Qed. Section AlmostField. Variable AFth : almost_field_theory rO rI radd rmul rsub ropp rdiv rinv req. Let ARth := (AF_AR AFth). Let rI_neq_rO := (AF_1_neq_0 AFth). Let rdiv_def := (AFdiv_def AFth). Let rinv_l := (AFinv_l AFth). Hypothesis S_inj : forall x y, 1+x==1+y -> x==y. Hypothesis gen_phiPOS_not_0 : forall p, ~ gen_phiPOS1 rI radd rmul p == 0. Lemma add_inj_r p x y : gen_phiPOS1 rI radd rmul p + x == gen_phiPOS1 rI radd rmul p + y -> x==y. Proof. elim p using Pos.peano_ind; simpl; [intros H|intros ? H ?]. - apply S_inj; trivial. - apply H. apply S_inj. rewrite !(ARadd_assoc ARth). rewrite <- (ARgen_phiPOS_Psucc Rsth Reqe ARth); trivial. Qed. Lemma gen_phiPOS_inj x y : gen_phiPOS rI radd rmul x == gen_phiPOS rI radd rmul y -> x = y. Proof. rewrite <- !(same_gen Rsth Reqe ARth). case (Pos.compare_spec x y). - intros. trivial. - intros. elim gen_phiPOS_not_0 with (y - x)%positive. apply add_inj_r with x. symmetry. rewrite (ARadd_0_r Rsth ARth). rewrite <- (ARgen_phiPOS_add Rsth Reqe ARth). now rewrite Pos.add_comm, Pos.sub_add. - intros. elim gen_phiPOS_not_0 with (x - y)%positive. apply add_inj_r with y. rewrite (ARadd_0_r Rsth ARth). rewrite <- (ARgen_phiPOS_add Rsth Reqe ARth). now rewrite Pos.add_comm, Pos.sub_add. Qed. Lemma gen_phiN_inj x y : gen_phiN rO rI radd rmul x == gen_phiN rO rI radd rmul y -> x = y. Proof. destruct x as [|p]; destruct y as [|p']; simpl; intros H; trivial. - elim gen_phiPOS_not_0 with p'. symmetry . rewrite (same_gen Rsth Reqe ARth); trivial. - elim gen_phiPOS_not_0 with p. rewrite (same_gen Rsth Reqe ARth); trivial. - rewrite gen_phiPOS_inj with (1 := H); trivial. Qed. Lemma gen_phiN_complete x y : gen_phiN rO rI radd rmul x == gen_phiN rO rI radd rmul y -> N.eqb x y = true. Proof. intros. now apply N.eqb_eq, gen_phiN_inj. Qed. End AlmostField. Section Field. Variable Fth : field_theory rO rI radd rmul rsub ropp rdiv rinv req. Let Rth := (F_R Fth). Let rI_neq_rO := (F_1_neq_0 Fth). Let rdiv_def := (Fdiv_def Fth). Let rinv_l := (Finv_l Fth). Let AFth := F2AF Rsth Reqe Fth. Let ARth := Rth_ARth Rsth Reqe Rth. Lemma ring_S_inj x y : 1+x==1+y -> x==y. Proof. intros. rewrite <- (ARadd_0_l ARth x), <- (ARadd_0_l ARth y). rewrite <- (Ropp_def Rth 1), (ARadd_comm ARth 1). rewrite <- !(ARadd_assoc ARth). now apply (Radd_ext Reqe). Qed. Hypothesis gen_phiPOS_not_0 : forall p, ~ gen_phiPOS1 rI radd rmul p == 0. Let gen_phiPOS_inject := gen_phiPOS_inj AFth ring_S_inj gen_phiPOS_not_0. Lemma gen_phiPOS_discr_sgn x y : ~ gen_phiPOS rI radd rmul x == - gen_phiPOS rI radd rmul y. Proof. red; intros. apply gen_phiPOS_not_0 with (y + x)%positive. rewrite (ARgen_phiPOS_add Rsth Reqe ARth). transitivity (gen_phiPOS1 1 radd rmul y + - gen_phiPOS1 1 radd rmul y). - apply (Radd_ext Reqe); trivial. + reflexivity. + rewrite (same_gen Rsth Reqe ARth). rewrite (same_gen Rsth Reqe ARth). trivial. - apply (Ropp_def Rth). Qed. Lemma gen_phiZ_inj x y : gen_phiZ rO rI radd rmul ropp x == gen_phiZ rO rI radd rmul ropp y -> x = y. Proof. destruct x as [|p|p]; destruct y as [|p'|p']; simpl; intros H. - trivial. - elim gen_phiPOS_not_0 with p'. rewrite (same_gen Rsth Reqe ARth). symmetry ; trivial. - elim gen_phiPOS_not_0 with p'. rewrite (same_gen Rsth Reqe ARth). rewrite <- (Ropp_opp Rsth Reqe Rth (gen_phiPOS 1 radd rmul p')). rewrite <- H. apply (ARopp_zero Rsth Reqe ARth). - elim gen_phiPOS_not_0 with p. rewrite (same_gen Rsth Reqe ARth). trivial. - rewrite gen_phiPOS_inject with (1 := H); trivial. - elim gen_phiPOS_discr_sgn with (1 := H). - elim gen_phiPOS_not_0 with p. rewrite (same_gen Rsth Reqe ARth). rewrite <- (Ropp_opp Rsth Reqe Rth (gen_phiPOS 1 radd rmul p)). rewrite H. apply (ARopp_zero Rsth Reqe ARth). - elim gen_phiPOS_discr_sgn with p' p. symmetry ; trivial. - replace p' with p; trivial. apply gen_phiPOS_inject. rewrite <- (Ropp_opp Rsth Reqe Rth (gen_phiPOS 1 radd rmul p)). rewrite <- (Ropp_opp Rsth Reqe Rth (gen_phiPOS 1 radd rmul p')). rewrite H; trivial. reflexivity. Qed. Lemma gen_phiZ_complete x y : gen_phiZ rO rI radd rmul ropp x == gen_phiZ rO rI radd rmul ropp y -> Zeq_bool x y = true. Proof. intros. replace y with x. - unfold Zeq_bool. rewrite Z.compare_refl; trivial. - apply gen_phiZ_inj; trivial. Qed. End Field. End Complete. Arguments FEO {C}. Arguments FEI {C}. coq-8.20.0/theories/setoid_ring/InitialRing.v000066400000000000000000000656151466560755400211520ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* R->R) (ropp : R -> R). Variable req : R -> R -> Prop. Notation "0" := rO. Notation "1" := rI. Notation "x + y" := (radd x y). Notation "x * y " := (rmul x y). Notation "x - y " := (rsub x y). Notation "- x" := (ropp x). Notation "x == y" := (req x y). Variable Rsth : Setoid_Theory R req. Add Parametric Relation : R req reflexivity proved by (@Equivalence_Reflexive _ _ Rsth) symmetry proved by (@Equivalence_Symmetric _ _ Rsth) transitivity proved by (@Equivalence_Transitive _ _ Rsth) as R_setoid3. Ltac rrefl := gen_reflexivity Rsth. Variable Reqe : ring_eq_ext radd rmul ropp req. Add Morphism radd with signature (req ==> req ==> req) as radd_ext3. Proof. exact (Radd_ext Reqe). Qed. Add Morphism rmul with signature (req ==> req ==> req) as rmul_ext3. Proof. exact (Rmul_ext Reqe). Qed. Add Morphism ropp with signature (req ==> req) as ropp_ext3. Proof. exact (Ropp_ext Reqe). Qed. Fixpoint gen_phiPOS1 (p:positive) : R := match p with | xH => 1 | xO p => (1 + 1) * (gen_phiPOS1 p) | xI p => 1 + ((1 + 1) * (gen_phiPOS1 p)) end. Fixpoint gen_phiPOS (p:positive) : R := match p with | xH => 1 | xO xH => (1 + 1) | xO p => (1 + 1) * (gen_phiPOS p) | xI xH => 1 + (1 +1) | xI p => 1 + ((1 + 1) * (gen_phiPOS p)) end. Definition gen_phiZ1 z := match z with | Zpos p => gen_phiPOS1 p | Z0 => 0 | Zneg p => -(gen_phiPOS1 p) end. Definition gen_phiZ z := match z with | Zpos p => gen_phiPOS p | Z0 => 0 | Zneg p => -(gen_phiPOS p) end. Notation "[ x ]" := (gen_phiZ x). Definition get_signZ z := match z with | Zneg p => Some (Zpos p) | _ => None end. Lemma get_signZ_th : sign_theory Z.opp Zeq_bool get_signZ. Proof. constructor. intros c;destruct c;intros ? H;try discriminate. injection H as [= <-]. simpl. unfold Zeq_bool. rewrite Z.compare_refl. trivial. Qed. Section ALMOST_RING. Variable ARth : almost_ring_theory 0 1 radd rmul rsub ropp req. Add Morphism rsub with signature (req ==> req ==> req) as rsub_ext3. Proof. exact (ARsub_ext Rsth Reqe ARth). Qed. Ltac norm := gen_srewrite Rsth Reqe ARth. Ltac add_push := gen_add_push radd Rsth Reqe ARth. Lemma same_gen : forall x, gen_phiPOS1 x == gen_phiPOS x. Proof. intros x;induction x as [x IHx|x IHx|];simpl. - rewrite IHx;destruct x;simpl;norm. - rewrite IHx;destruct x;simpl;norm. - rrefl. Qed. Lemma ARgen_phiPOS_Psucc : forall x, gen_phiPOS1 (Pos.succ x) == 1 + (gen_phiPOS1 x). Proof. intros x;induction x as [x IHx|x IHx|];simpl;norm. rewrite IHx;norm. add_push 1;rrefl. Qed. Lemma ARgen_phiPOS_add : forall x y, gen_phiPOS1 (x + y) == (gen_phiPOS1 x) + (gen_phiPOS1 y). Proof. intros x;induction x as [x IHx|x IHx|]; intros y;destruct y as [y|y|];simpl;norm. - rewrite Pos.add_carry_spec. rewrite ARgen_phiPOS_Psucc. rewrite IHx;norm. add_push (gen_phiPOS1 y);add_push 1;rrefl. - rewrite IHx;norm;add_push (gen_phiPOS1 y);rrefl. - rewrite ARgen_phiPOS_Psucc;norm;add_push 1;rrefl. - rewrite IHx;norm;add_push(gen_phiPOS1 y); add_push 1;rrefl. - rewrite IHx;norm;add_push(gen_phiPOS1 y);rrefl. - add_push 1;rrefl. - rewrite ARgen_phiPOS_Psucc;norm;add_push 1;rrefl. Qed. Lemma ARgen_phiPOS_mult : forall x y, gen_phiPOS1 (x * y) == gen_phiPOS1 x * gen_phiPOS1 y. Proof. intros x;induction x as [x IHx|x IHx|];intros;simpl;norm. - rewrite ARgen_phiPOS_add;simpl;rewrite IHx;norm. - rewrite IHx;rrefl. Qed. End ALMOST_RING. Variable Rth : ring_theory 0 1 radd rmul rsub ropp req. Let ARth := Rth_ARth Rsth Reqe Rth. Add Morphism rsub with signature (req ==> req ==> req) as rsub_ext4. Proof. exact (ARsub_ext Rsth Reqe ARth). Qed. Ltac norm := gen_srewrite Rsth Reqe ARth. Ltac add_push := gen_add_push radd Rsth Reqe ARth. (*morphisms are extensionally equal*) Lemma same_genZ : forall x, [x] == gen_phiZ1 x. Proof. intros x;destruct x;simpl; try rewrite (same_gen ARth);rrefl. Qed. Lemma gen_Zeqb_ok : forall x y, Zeq_bool x y = true -> [x] == [y]. Proof. intros x y H. assert (H1 := Zeq_bool_eq x y H);unfold IDphi in H1. rewrite H1;rrefl. Qed. Lemma gen_phiZ1_pos_sub : forall x y, gen_phiZ1 (Z.pos_sub x y) == gen_phiPOS1 x + -gen_phiPOS1 y. Proof. intros x y. rewrite Z.pos_sub_spec. case Pos.compare_spec; intros H; simpl. - rewrite H. rewrite (Ropp_def Rth);rrefl. - rewrite <- (Pos.sub_add y x H) at 2. rewrite Pos.add_comm. rewrite (ARgen_phiPOS_add ARth);simpl;norm. rewrite (Ropp_def Rth);norm. - rewrite <- (Pos.sub_add x y H) at 2. rewrite (ARgen_phiPOS_add ARth);simpl;norm. add_push (gen_phiPOS1 (x-y));rewrite (Ropp_def Rth); norm. Qed. Lemma gen_phiZ_add : forall x y, [x + y] == [x] + [y]. Proof. intros x y; repeat rewrite same_genZ; generalize x y;clear x y. intros x y;destruct x, y; simpl; norm. - apply (ARgen_phiPOS_add ARth). - apply gen_phiZ1_pos_sub. - rewrite gen_phiZ1_pos_sub. apply (Radd_comm Rth). - rewrite (ARgen_phiPOS_add ARth); norm. Qed. Lemma gen_phiZ_mul : forall x y, [x * y] == [x] * [y]. Proof. intros x y;repeat rewrite same_genZ. destruct x;destruct y;simpl;norm; rewrite (ARgen_phiPOS_mult ARth);try (norm;fail). rewrite (Ropp_opp Rsth Reqe Rth);rrefl. Qed. Lemma gen_phiZ_ext : forall x y : Z, x = y -> [x] == [y]. Proof. intros;subst;rrefl. Qed. (*proof that [.] satisfies morphism specifications*) Lemma gen_phiZ_morph : ring_morph 0 1 radd rmul rsub ropp req Z0 (Zpos xH) Z.add Z.mul Z.sub Z.opp Zeq_bool gen_phiZ. Proof. assert ( SRmorph : semi_morph 0 1 radd rmul req Z0 (Zpos xH) Z.add Z.mul Zeq_bool gen_phiZ). - apply mkRmorph;simpl;try rrefl. + apply gen_phiZ_add. + apply gen_phiZ_mul. + apply gen_Zeqb_ok. - apply (Smorph_morph Rsth Reqe Rth Zth SRmorph gen_phiZ_ext). Qed. End ZMORPHISM. (** N is a semi-ring and a setoid*) Lemma Nsth : Setoid_Theory N (@eq N). Proof (Eqsth N). Lemma Nseqe : sring_eq_ext N.add N.mul (@eq N). Proof (Eq_s_ext N.add N.mul). Lemma Nth : semi_ring_theory 0%N 1%N N.add N.mul (@eq N). Proof. constructor. - exact N.add_0_l. - exact N.add_comm. - exact N.add_assoc. - exact N.mul_1_l. - exact N.mul_0_l. - exact N.mul_comm. - exact N.mul_assoc. - exact N.mul_add_distr_r. Qed. Definition Nsub := SRsub N.add. Definition Nopp := (@SRopp N). Lemma Neqe : ring_eq_ext N.add N.mul Nopp (@eq N). Proof (SReqe_Reqe Nseqe). Lemma Nath : almost_ring_theory 0%N 1%N N.add N.mul Nsub Nopp (@eq N). Proof (SRth_ARth Nsth Nth). Lemma Neqb_ok : forall x y, N.eqb x y = true -> x = y. Proof. exact (fun x y => proj1 (N.eqb_eq x y)). Qed. (**Same as above : definition of two, extensionally equal, generic morphisms *) (**from N to any semi-ring*) Section NMORPHISM. Variable R : Type. Variable (rO rI : R) (radd rmul: R->R->R). Variable req : R -> R -> Prop. Notation "0" := rO. Notation "1" := rI. Notation "x + y" := (radd x y). Notation "x * y " := (rmul x y). Variable Rsth : Setoid_Theory R req. Add Parametric Relation : R req reflexivity proved by (@Equivalence_Reflexive _ _ Rsth) symmetry proved by (@Equivalence_Symmetric _ _ Rsth) transitivity proved by (@Equivalence_Transitive _ _ Rsth) as R_setoid4. Ltac rrefl := gen_reflexivity Rsth. Variable SReqe : sring_eq_ext radd rmul req. Variable SRth : semi_ring_theory 0 1 radd rmul req. Let ARth := SRth_ARth Rsth SRth. Let Reqe := SReqe_Reqe SReqe. Let ropp := (@SRopp R). Let rsub := (@SRsub R radd). Notation "x - y " := (rsub x y). Notation "- x" := (ropp x). Notation "x == y" := (req x y). Add Morphism radd with signature (req ==> req ==> req) as radd_ext4. Proof. exact (Radd_ext Reqe). Qed. Add Morphism rmul with signature (req ==> req ==> req) as rmul_ext4. Proof. exact (Rmul_ext Reqe). Qed. Ltac norm := gen_srewrite_sr Rsth Reqe ARth. Definition gen_phiN1 x := match x with | N0 => 0 | Npos x => gen_phiPOS1 1 radd rmul x end. Definition gen_phiN x := match x with | N0 => 0 | Npos x => gen_phiPOS 1 radd rmul x end. Notation "[ x ]" := (gen_phiN x). Lemma same_genN : forall x, [x] == gen_phiN1 x. Proof. intros x;destruct x;simpl. - reflexivity. - now rewrite (same_gen Rsth Reqe ARth). Qed. Lemma gen_phiN_add : forall x y, [x + y] == [x] + [y]. Proof. intros x y;repeat rewrite same_genN. destruct x;destruct y;simpl;norm. apply (ARgen_phiPOS_add Rsth Reqe ARth). Qed. Lemma gen_phiN_mult : forall x y, [x * y] == [x] * [y]. Proof. intros x y;repeat rewrite same_genN. destruct x;destruct y;simpl;norm. apply (ARgen_phiPOS_mult Rsth Reqe ARth). Qed. Lemma gen_phiN_sub : forall x y, [Nsub x y] == [x] - [y]. Proof. exact gen_phiN_add. Qed. (*gen_phiN satisfies morphism specifications*) Lemma gen_phiN_morph : ring_morph 0 1 radd rmul rsub ropp req 0%N 1%N N.add N.mul Nsub Nopp N.eqb gen_phiN. Proof. constructor; simpl; try reflexivity. - apply gen_phiN_add. - apply gen_phiN_sub. - apply gen_phiN_mult. - intros x y EQ. apply N.eqb_eq in EQ. now subst. Qed. End NMORPHISM. (* Words on N : initial structure for almost-rings. *) Definition Nword := list N. Definition NwO : Nword := nil. Definition NwI : Nword := 1%N :: nil. Definition Nwcons n (w : Nword) : Nword := match w, n with | nil, 0%N => nil | _, _ => n :: w end. Fixpoint Nwadd (w1 w2 : Nword) {struct w1} : Nword := match w1, w2 with | n1::w1', n2:: w2' => (n1+n2)%N :: Nwadd w1' w2' | nil, _ => w2 | _, nil => w1 end. Definition Nwopp (w:Nword) : Nword := Nwcons 0%N w. Definition Nwsub w1 w2 := Nwadd w1 (Nwopp w2). Fixpoint Nwscal (n : N) (w : Nword) {struct w} : Nword := match w with | m :: w' => (n*m)%N :: Nwscal n w' | nil => nil end. Fixpoint Nwmul (w1 w2 : Nword) {struct w1} : Nword := match w1 with | 0%N::w1' => Nwopp (Nwmul w1' w2) | n1::w1' => Nwsub (Nwscal n1 w2) (Nwmul w1' w2) | nil => nil end. Fixpoint Nw_is0 (w : Nword) : bool := match w with | nil => true | 0%N :: w' => Nw_is0 w' | _ => false end. Fixpoint Nweq_bool (w1 w2 : Nword) {struct w1} : bool := match w1, w2 with | n1::w1', n2::w2' => if N.eqb n1 n2 then Nweq_bool w1' w2' else false | nil, _ => Nw_is0 w2 | _, nil => Nw_is0 w1 end. Section NWORDMORPHISM. Variable R : Type. Variable (rO rI : R) (radd rmul rsub: R->R->R) (ropp : R -> R). Variable req : R -> R -> Prop. Notation "0" := rO. Notation "1" := rI. Notation "x + y" := (radd x y). Notation "x * y " := (rmul x y). Notation "x - y " := (rsub x y). Notation "- x" := (ropp x). Notation "x == y" := (req x y). Variable Rsth : Setoid_Theory R req. Add Parametric Relation : R req reflexivity proved by (@Equivalence_Reflexive _ _ Rsth) symmetry proved by (@Equivalence_Symmetric _ _ Rsth) transitivity proved by (@Equivalence_Transitive _ _ Rsth) as R_setoid5. Ltac rrefl := gen_reflexivity Rsth. Variable Reqe : ring_eq_ext radd rmul ropp req. Add Morphism radd with signature (req ==> req ==> req) as radd_ext5. Proof. exact (Radd_ext Reqe). Qed. Add Morphism rmul with signature (req ==> req ==> req) as rmul_ext5. Proof. exact (Rmul_ext Reqe). Qed. Add Morphism ropp with signature (req ==> req) as ropp_ext5. Proof. exact (Ropp_ext Reqe). Qed. Variable ARth : almost_ring_theory 0 1 radd rmul rsub ropp req. Add Morphism rsub with signature (req ==> req ==> req) as rsub_ext7. Proof. exact (ARsub_ext Rsth Reqe ARth). Qed. Ltac norm := gen_srewrite Rsth Reqe ARth. Ltac add_push := gen_add_push radd Rsth Reqe ARth. Fixpoint gen_phiNword (w : Nword) : R := match w with | nil => 0 | n :: nil => gen_phiN rO rI radd rmul n | N0 :: w' => - gen_phiNword w' | n::w' => gen_phiN rO rI radd rmul n - gen_phiNword w' end. Lemma gen_phiNword0_ok : forall w, Nw_is0 w = true -> gen_phiNword w == 0. Proof. intros w; induction w as [|a w IHw]; simpl; intros; auto. - reflexivity. - destruct a. + destruct w. * reflexivity. * rewrite IHw; trivial. apply (ARopp_zero Rsth Reqe ARth). + discriminate. Qed. Lemma gen_phiNword_cons : forall w n, gen_phiNword (n::w) == gen_phiN rO rI radd rmul n - gen_phiNword w. intros w; induction w. - intros n; destruct n; simpl; norm. - intros n. destruct n; norm. Qed. Lemma gen_phiNword_Nwcons : forall w n, gen_phiNword (Nwcons n w) == gen_phiN rO rI radd rmul n - gen_phiNword w. intros w; destruct w; intros n0. - destruct n0; norm. - unfold Nwcons. rewrite gen_phiNword_cons. reflexivity. Qed. Lemma gen_phiNword_ok : forall w1 w2, Nweq_bool w1 w2 = true -> gen_phiNword w1 == gen_phiNword w2. intros w1; induction w1 as [|a w1 IHw1]; intros w2 H. - simpl. rewrite (gen_phiNword0_ok _ H). reflexivity. - rewrite gen_phiNword_cons. destruct w2 as [|n w2]. + simpl in H. destruct a; try discriminate. rewrite (gen_phiNword0_ok _ H). norm. + simpl in H. rewrite gen_phiNword_cons. case_eq (N.eqb a n); intros H0. * rewrite H0 in H. apply N.eqb_eq in H0. rewrite <- H0. rewrite (IHw1 _ H). reflexivity. * rewrite H0 in H; discriminate H. Qed. Lemma Nwadd_ok : forall x y, gen_phiNword (Nwadd x y) == gen_phiNword x + gen_phiNword y. intros x; induction x as [|n x IHx]; intros y. - simpl. norm. - destruct y. + simpl Nwadd; norm. + simpl Nwadd. repeat rewrite gen_phiNword_cons. rewrite (fun sreq => gen_phiN_add Rsth sreq (ARth_SRth ARth)) by (destruct Reqe; constructor; trivial). rewrite IHx. norm. add_push (- gen_phiNword x); reflexivity. Qed. Lemma Nwopp_ok : forall x, gen_phiNword (Nwopp x) == - gen_phiNword x. simpl. unfold Nwopp; simpl. intros. rewrite gen_phiNword_Nwcons; norm. Qed. Lemma Nwscal_ok : forall n x, gen_phiNword (Nwscal n x) == gen_phiN rO rI radd rmul n * gen_phiNword x. intros n x; induction x as [|a x IHx]; intros. - norm. - simpl Nwscal. repeat rewrite gen_phiNword_cons. rewrite (fun sreq => gen_phiN_mult Rsth sreq (ARth_SRth ARth)) by (destruct Reqe; constructor; trivial). rewrite IHx. norm. Qed. Lemma Nwmul_ok : forall x y, gen_phiNword (Nwmul x y) == gen_phiNword x * gen_phiNword y. intros x; induction x as [|a x IHx]; intros. - norm. - destruct a. + simpl Nwmul. rewrite Nwopp_ok. rewrite IHx. rewrite gen_phiNword_cons. norm. + simpl Nwmul. unfold Nwsub. rewrite Nwadd_ok. rewrite Nwscal_ok. rewrite Nwopp_ok. rewrite IHx. rewrite gen_phiNword_cons. norm. Qed. (* Proof that [.] satisfies morphism specifications *) Lemma gen_phiNword_morph : ring_morph 0 1 radd rmul rsub ropp req NwO NwI Nwadd Nwmul Nwsub Nwopp Nweq_bool gen_phiNword. constructor. - reflexivity. - reflexivity. - exact Nwadd_ok. - intros. unfold Nwsub. rewrite Nwadd_ok. rewrite Nwopp_ok. norm. - exact Nwmul_ok. - exact Nwopp_ok. - exact gen_phiNword_ok. Qed. End NWORDMORPHISM. Section GEN_DIV. Variables (R : Type) (rO : R) (rI : R) (radd : R -> R -> R) (rmul : R -> R -> R) (rsub : R -> R -> R) (ropp : R -> R) (req : R -> R -> Prop) (C : Type) (cO : C) (cI : C) (cadd : C -> C -> C) (cmul : C -> C -> C) (csub : C -> C -> C) (copp : C -> C) (ceqb : C -> C -> bool) (phi : C -> R). Variable Rsth : Setoid_Theory R req. Variable Reqe : ring_eq_ext radd rmul ropp req. Variable ARth : almost_ring_theory rO rI radd rmul rsub ropp req. Variable morph : ring_morph rO rI radd rmul rsub ropp req cO cI cadd cmul csub copp ceqb phi. (* Useful tactics *) Add Parametric Relation : R req reflexivity proved by (@Equivalence_Reflexive _ _ Rsth) symmetry proved by (@Equivalence_Symmetric _ _ Rsth) transitivity proved by (@Equivalence_Transitive _ _ Rsth) as R_set1. Ltac rrefl := gen_reflexivity Rsth. Add Morphism radd with signature (req ==> req ==> req) as radd_ext. Proof. exact (Radd_ext Reqe). Qed. Add Morphism rmul with signature (req ==> req ==> req) as rmul_ext. Proof. exact (Rmul_ext Reqe). Qed. Add Morphism ropp with signature (req ==> req) as ropp_ext. Proof. exact (Ropp_ext Reqe). Qed. Add Morphism rsub with signature (req ==> req ==> req) as rsub_ext. Proof. exact (ARsub_ext Rsth Reqe ARth). Qed. Ltac rsimpl := gen_srewrite Rsth Reqe ARth. Definition triv_div x y := if ceqb x y then (cI, cO) else (cO, x). Ltac Esimpl :=repeat (progress ( match goal with | |- context [phi cO] => rewrite (morph0 morph) | |- context [phi cI] => rewrite (morph1 morph) | |- context [phi (cadd ?x ?y)] => rewrite ((morph_add morph) x y) | |- context [phi (cmul ?x ?y)] => rewrite ((morph_mul morph) x y) | |- context [phi (csub ?x ?y)] => rewrite ((morph_sub morph) x y) | |- context [phi (copp ?x)] => rewrite ((morph_opp morph) x) end)). Lemma triv_div_th : Ring_theory.div_theory req cadd cmul phi triv_div. Proof. constructor. intros a b;unfold triv_div. assert (X:= morph_eq morph a b);destruct (ceqb a b). - Esimpl. rewrite X; trivial. rsimpl. - Esimpl; rsimpl. Qed. Variable zphi : Z -> R. Lemma Ztriv_div_th : div_theory req Z.add Z.mul zphi Z.quotrem. Proof. constructor. intros a b; generalize (Z.quotrem_eq a b); case Z.quotrem; intros; subst. rewrite Z.mul_comm; rsimpl. Qed. Variable nphi : N -> R. Lemma Ntriv_div_th : div_theory req N.add N.mul nphi N.div_eucl. constructor. intros a b; generalize (N.div_eucl_spec a b); case N.div_eucl; intros; subst. rewrite N.mul_comm; rsimpl. Qed. End GEN_DIV. (* syntaxification of constants in an abstract ring: the inverse of gen_phiPOS *) Ltac inv_gen_phi_pos rI add mul t := let rec inv_cst t := match t with rI => constr:(1%positive) | (add rI rI) => constr:(2%positive) | (add rI (add rI rI)) => constr:(3%positive) | (mul (add rI rI) ?p) => (* 2p *) match inv_cst p with NotConstant => constr:(NotConstant) | 1%positive => constr:(NotConstant) (* 2*1 is not convertible to 2 *) | ?p => constr:(xO p) end | (add rI (mul (add rI rI) ?p)) => (* 1+2p *) match inv_cst p with NotConstant => constr:(NotConstant) | 1%positive => constr:(NotConstant) | ?p => constr:(xI p) end | _ => constr:(NotConstant) end in inv_cst t. (* The (partial) inverse of gen_phiNword *) Ltac inv_gen_phiNword rO rI add mul opp t := match t with rO => constr:(NwO) | _ => match inv_gen_phi_pos rI add mul t with NotConstant => constr:(NotConstant) | ?p => constr:(Npos p::nil) end end. (* The inverse of gen_phiN *) Ltac inv_gen_phiN rO rI add mul t := match t with rO => constr:(0%N) | _ => match inv_gen_phi_pos rI add mul t with NotConstant => constr:(NotConstant) | ?p => constr:(Npos p) end end. (* The inverse of gen_phiZ *) Ltac inv_gen_phiZ rO rI add mul opp t := match t with rO => constr:(0%Z) | (opp ?p) => match inv_gen_phi_pos rI add mul p with NotConstant => constr:(NotConstant) | ?p => constr:(Zneg p) end | _ => match inv_gen_phi_pos rI add mul t with NotConstant => constr:(NotConstant) | ?p => constr:(Zpos p) end end. (* A simple tactic recognizing only 0 and 1. The inv_gen_phiX above are only optimisations that directly returns the reified constant instead of resorting to the constant propagation of the simplification algorithm. *) Ltac inv_gen_phi rO rI cO cI t := match t with | rO => cO | rI => cI end. (* A simple tactic recognizing no constant *) Ltac inv_morph_nothing t := constr:(NotConstant). Ltac coerce_to_almost_ring set ext rspec := match type of rspec with | ring_theory _ _ _ _ _ _ _ => constr:(Rth_ARth set ext rspec) | semi_ring_theory _ _ _ _ _ => constr:(SRth_ARth set rspec) | almost_ring_theory _ _ _ _ _ _ _ => rspec | _ => fail 1 "not a valid ring theory" end. Ltac coerce_to_ring_ext ext := match type of ext with | ring_eq_ext _ _ _ _ => ext | sring_eq_ext _ _ _ => constr:(SReqe_Reqe ext) | _ => fail 1 "not a valid ring_eq_ext theory" end. Ltac abstract_ring_morphism set ext rspec := match type of rspec with | ring_theory _ _ _ _ _ _ _ => constr:(gen_phiZ_morph set ext rspec) | semi_ring_theory _ _ _ _ _ => constr:(gen_phiN_morph set ext rspec) | almost_ring_theory _ _ _ _ _ _ _ => constr:(gen_phiNword_morph set ext rspec) | _ => fail 1 "bad ring structure" end. Record hypo : Type := mkhypo { hypo_type : Type; hypo_proof : hypo_type }. Ltac gen_ring_pow set arth pspec := match pspec with | None => match type of arth with | @almost_ring_theory ?R ?rO ?rI ?radd ?rmul ?rsub ?ropp ?req => constr:(mkhypo (@pow_N_th R rI rmul req set)) | _ => fail 1 "gen_ring_pow" end | Some ?t => constr:(t) end. Ltac gen_ring_sign morph sspec := match sspec with | None => match type of morph with | @ring_morph ?R ?r0 ?rI ?radd ?rmul ?rsub ?ropp ?req Z ?c0 ?c1 ?cadd ?cmul ?csub ?copp ?ceqb ?phi => constr:(@mkhypo (sign_theory copp ceqb get_signZ) get_signZ_th) | @ring_morph ?R ?r0 ?rI ?radd ?rmul ?rsub ?ropp ?req ?C ?c0 ?c1 ?cadd ?cmul ?csub ?copp ?ceqb ?phi => constr:(mkhypo (@get_sign_None_th C copp ceqb)) | _ => fail 2 "ring anomaly : default_sign_spec" end | Some ?t => constr:(t) end. Ltac default_div_spec set reqe arth morph := match type of morph with | @ring_morph ?R ?r0 ?rI ?radd ?rmul ?rsub ?ropp ?req Z ?c0 ?c1 Z.add Z.mul ?csub ?copp ?ceq_b ?phi => constr:(mkhypo (Ztriv_div_th set phi)) | @ring_morph ?R ?r0 ?rI ?radd ?rmul ?rsub ?ropp ?req N ?c0 ?c1 N.add N.mul ?csub ?copp ?ceq_b ?phi => constr:(mkhypo (Ntriv_div_th set phi)) | @ring_morph ?R ?r0 ?rI ?radd ?rmul ?rsub ?ropp ?req ?C ?c0 ?c1 ?cadd ?cmul ?csub ?copp ?ceq_b ?phi => constr:(mkhypo (triv_div_th set reqe arth morph)) | _ => fail 1 "ring anomaly : default_sign_spec" end. Ltac gen_ring_div set reqe arth morph dspec := match dspec with | None => default_div_spec set reqe arth morph | Some ?t => constr:(t) end. Ltac ring_elements set ext rspec pspec sspec dspec rk := let arth := coerce_to_almost_ring set ext rspec in let ext_r := coerce_to_ring_ext ext in let morph := match rk with | Abstract => abstract_ring_morphism set ext rspec | @Computational ?reqb_ok => match type of arth with | almost_ring_theory ?rO ?rI ?add ?mul ?sub ?opp _ => constr:(IDmorph rO rI add mul sub opp set _ reqb_ok) | _ => fail 2 "ring anomaly" end | @Morphism ?m => match type of m with | ring_morph _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ => m | @semi_morph _ _ _ _ _ _ _ _ _ _ _ _ _ => constr:(SRmorph_Rmorph set m) | _ => fail 2 "ring anomaly" end | _ => fail 1 "ill-formed ring kind" end in let p_spec := gen_ring_pow set arth pspec in let s_spec := gen_ring_sign morph sspec in let d_spec := gen_ring_div set ext_r arth morph dspec in fun f => f arth ext_r morph p_spec s_spec d_spec. (* Given a ring structure and the kind of morphism, returns 2 lemmas (one for ring, and one for ring_simplify). *) Ltac ring_lemmas set ext rspec pspec sspec dspec rk := let gen_lemma2 := match pspec with | None => constr:(ring_rw_correct) | Some _ => constr:(ring_rw_pow_correct) end in ring_elements set ext rspec pspec sspec dspec rk ltac:(fun arth ext_r morph p_spec s_spec d_spec => lazymatch type of morph with | @ring_morph ?R ?r0 ?rI ?radd ?rmul ?rsub ?ropp ?req ?C ?c0 ?c1 ?cadd ?cmul ?csub ?copp ?ceq_b ?phi => let gen_lemma2_0 := constr:(gen_lemma2 R r0 rI radd rmul rsub ropp req set ext_r arth C c0 c1 cadd cmul csub copp ceq_b phi morph) in lazymatch p_spec with | @mkhypo (power_theory _ _ _ ?Cp_phi ?rpow) ?pp_spec => let gen_lemma2_1 := constr:(gen_lemma2_0 _ Cp_phi rpow pp_spec) in lazymatch d_spec with | @mkhypo (div_theory _ _ _ _ ?cdiv) ?dd_spec => let gen_lemma2_2 := constr:(gen_lemma2_1 cdiv dd_spec) in lazymatch s_spec with | @mkhypo (sign_theory _ _ ?get_sign) ?ss_spec => let lemma2 := constr:(gen_lemma2_2 get_sign ss_spec) in let lemma1 := constr:(ring_correct set ext_r arth morph pp_spec dd_spec) in fun f => f arth ext_r morph lemma1 lemma2 | _ => fail "ring: bad sign specification" end | _ => fail "ring: bad coefficient division specification" end | _ => fail "ring: bad power specification" end | _ => fail "ring internal error: ring_lemmas, please report" end). (* Tactic for constant *) Ltac isnatcst t := match t with O => constr:(true) | S ?p => isnatcst p | _ => constr:(false) end. Ltac isPcst t := match t with | xI ?p => isPcst p | xO ?p => isPcst p | xH => constr:(true) (* nat -> positive *) | Pos.of_succ_nat ?n => isnatcst n | _ => constr:(false) end. Ltac isNcst t := match t with N0 => constr:(true) | Npos ?p => isPcst p | _ => constr:(false) end. Ltac isZcst t := match t with Z0 => constr:(true) | Zpos ?p => isPcst p | Zneg ?p => isPcst p (* injection nat -> Z *) | Z.of_nat ?n => isnatcst n (* injection N -> Z *) | Z.of_N ?n => isNcst n (* *) | _ => constr:(false) end. coq-8.20.0/theories/setoid_ring/Integral_domain.v000066400000000000000000000040431466560755400220210ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* x == 0 \/ y == 0; integral_domain_one_zero: not (1 == 0)}. Section integral_domain. Context {R:Type}`{Rid:Integral_domain R}. Lemma integral_domain_minus_one_zero: ~ - (1:R) == 0. red;intro. apply integral_domain_one_zero. assert (0 == - (0:R)). - cring. - rewrite H0. rewrite <- H. cring. Qed. Definition pow (r : R) (n : nat) := Ring_theory.pow_N 1 mul r (N.of_nat n). Lemma pow_not_zero: forall p n, pow p n == 0 -> p == 0. induction n. - unfold pow; simpl. intros. absurd (1 == 0). + simpl. apply integral_domain_one_zero. + trivial. - setoid_replace (pow p (S n)) with (p * (pow p n)). + intros. case (integral_domain_product p (pow p n) H). * trivial. * trivial. + unfold pow; simpl. clear IHn. induction n; simpl; try cring. rewrite Ring_theory.pow_pos_succ. * cring. * apply ring_setoid. * apply ring_mult_comp. * apply ring_mul_assoc. Qed. Lemma Rintegral_domain_pow: forall c p r, ~c == 0 -> c * (pow p r) == ring0 -> p == ring0. intros. case (integral_domain_product c (pow p r) H0). - intros; absurd (c == ring0); auto. - intros. apply pow_not_zero with r. trivial. Qed. End integral_domain. coq-8.20.0/theories/setoid_ring/NArithRing.v000066400000000000000000000016271466560755400207370ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* t | _ => constr:(NotConstant) end. Add Ring Nr : Nth (decidable Neqb_ok, constants [Ncst]). coq-8.20.0/theories/setoid_ring/Ncring.v000066400000000000000000000232001466560755400201410ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* T->T} {mul:T->T->T} {sub:T->T->T} {opp:T->T} {ring_eq:T->T->Prop}. #[global] Instance zero_notation(T:Type)`{Ring_ops T}:Zero T:= ring0. #[global] Instance one_notation(T:Type)`{Ring_ops T}:One T:= ring1. #[global] Instance add_notation(T:Type)`{Ring_ops T}:Addition T:= add. #[global] Instance mul_notation(T:Type)`{Ring_ops T}:@Multiplication T T:= mul. #[global] Instance sub_notation(T:Type)`{Ring_ops T}:Subtraction T:= sub. #[global] Instance opp_notation(T:Type)`{Ring_ops T}:Opposite T:= opp. #[global] Instance eq_notation(T:Type)`{Ring_ops T}:@Equality T:= ring_eq. Class Ring `{Ro:Ring_ops}:={ ring_setoid: Equivalence _==_; ring_plus_comp: Proper (_==_ ==> _==_ ==>_==_) _+_; ring_mult_comp: Proper (_==_ ==> _==_ ==>_==_) _*_; ring_sub_comp: Proper (_==_ ==> _==_ ==>_==_) _-_; ring_opp_comp: Proper (_==_==>_==_) -_; ring_add_0_l : forall x, 0 + x == x; ring_add_comm : forall x y, x + y == y + x; ring_add_assoc : forall x y z, x + (y + z) == (x + y) + z; ring_mul_1_l : forall x, 1 * x == x; ring_mul_1_r : forall x, x * 1 == x; ring_mul_assoc : forall x y z, x * (y * z) == (x * y) * z; ring_distr_l : forall x y z, (x + y) * z == x * z + y * z; ring_distr_r : forall x y z, z * ( x + y) == z * x + z * y; ring_sub_def : forall x y, x - y == x + -y; ring_opp_def : forall x, x + -x == 0 }. (* inutile! je sais plus pourquoi j'ai mis ca... Instance ring_Ring_ops(R:Type)`{Ring R} :@Ring_ops R 0 1 addition multiplication subtraction opposite equality. *) #[global] Existing Instance ring_setoid. #[global] Existing Instance ring_plus_comp. #[global] Existing Instance ring_mult_comp. #[global] Existing Instance ring_sub_comp. #[global] Existing Instance ring_opp_comp. Section Ring_power. Context {R:Type}`{Ring R}. Fixpoint pow_pos (x:R) (i:positive) {struct i}: R := match i with | xH => x | xO i => let p := pow_pos x i in p * p | xI i => let p := pow_pos x i in x * (p * p) end. Definition pow_N (x:R) (p:N) := match p with | N0 => 1 | Npos p => pow_pos x p end. End Ring_power. Definition ZN(x:Z):= match x with Z0 => N0 |Zpos p | Zneg p => Npos p end. #[global] Instance power_ring {R:Type}`{Ring R} : Power:= {power x y := pow_N x (ZN y)}. (** Interpretation morphisms definition*) Class Ring_morphism (C R:Type)`{Cr:Ring C} `{Rr:Ring R}`{Rh:Bracket C R}:= { ring_morphism0 : [0] == 0; ring_morphism1 : [1] == 1; ring_morphism_add : forall x y, [x + y] == [x] + [y]; ring_morphism_sub : forall x y, [x - y] == [x] - [y]; ring_morphism_mul : forall x y, [x * y] == [x] * [y]; ring_morphism_opp : forall x, [-x] == -[x]; ring_morphism_eq : forall x y, x == y -> [x] == [y]}. Section Ring. Context {R:Type}`{Rr:Ring R}. (* Powers *) Lemma pow_pos_comm : forall x j, x * pow_pos x j == pow_pos x j * x. Proof. induction j; simpl. - rewrite <- ring_mul_assoc. rewrite <- ring_mul_assoc. rewrite <- IHj. rewrite (ring_mul_assoc (pow_pos x j) x (pow_pos x j)). rewrite <- IHj. rewrite <- ring_mul_assoc. reflexivity. - rewrite <- ring_mul_assoc. rewrite <- IHj. rewrite ring_mul_assoc. rewrite IHj. rewrite <- ring_mul_assoc. rewrite IHj. reflexivity. - reflexivity. Qed. Lemma pow_pos_succ : forall x j, pow_pos x (Pos.succ j) == x * pow_pos x j. Proof. induction j; simpl. - rewrite IHj. rewrite <- (ring_mul_assoc x (pow_pos x j) (x * pow_pos x j)). rewrite (ring_mul_assoc (pow_pos x j) x (pow_pos x j)). rewrite <- pow_pos_comm. rewrite <- ring_mul_assoc. reflexivity. - reflexivity. - reflexivity. Qed. Lemma pow_pos_add : forall x i j, pow_pos x (i + j) == pow_pos x i * pow_pos x j. Proof. intro x;induction i;intros. - rewrite Pos.xI_succ_xO;rewrite <- Pos.add_1_r. rewrite <- Pos.add_diag;repeat rewrite <- Pos.add_assoc. repeat rewrite IHi. rewrite Pos.add_comm;rewrite Pos.add_1_r; rewrite pow_pos_succ. simpl;repeat rewrite ring_mul_assoc. reflexivity. - rewrite <- Pos.add_diag;repeat rewrite <- Pos.add_assoc. repeat rewrite IHi. rewrite ring_mul_assoc. reflexivity. - rewrite Pos.add_comm;rewrite Pos.add_1_r;rewrite pow_pos_succ. simpl. reflexivity. Qed. Definition id_phi_N (x:N) : N := x. Lemma pow_N_pow_N : forall x n, pow_N x (id_phi_N n) == pow_N x n. Proof. intros; reflexivity. Qed. (** Identity is a morphism *) (* Instance IDmorph : Ring_morphism _ _ _ (fun x => x). Proof. apply (Build_Ring_morphism H6 H6 (fun x => x));intros; try reflexivity. trivial. Qed. *) (** rings are almost rings*) Lemma ring_mul_0_l : forall x, 0 * x == 0. Proof. intro x. setoid_replace (0*x) with ((0+1)*x + -x). - rewrite ring_add_0_l. rewrite ring_mul_1_l . rewrite ring_opp_def . fold zero. reflexivity. - rewrite ring_distr_l . rewrite ring_mul_1_l . rewrite <- ring_add_assoc ; rewrite ring_opp_def . rewrite ring_add_comm ; rewrite ring_add_0_l ;reflexivity. Qed. Lemma ring_mul_0_r : forall x, x * 0 == 0. Proof. intro x; setoid_replace (x*0) with (x*(0+1) + -x). - rewrite ring_add_0_l ; rewrite ring_mul_1_r . rewrite ring_opp_def ; fold zero; reflexivity. - rewrite ring_distr_r ;rewrite ring_mul_1_r . rewrite <- ring_add_assoc ; rewrite ring_opp_def . rewrite ring_add_comm ; rewrite ring_add_0_l ;reflexivity. Qed. Lemma ring_opp_mul_l : forall x y, -(x * y) == -x * y. Proof. intros x y;rewrite <- (ring_add_0_l (- x * y)). rewrite ring_add_comm . rewrite <- (ring_opp_def (x*y)). rewrite ring_add_assoc . rewrite <- ring_distr_l. rewrite (ring_add_comm (-x));rewrite ring_opp_def . rewrite ring_mul_0_l;rewrite ring_add_0_l ;reflexivity. Qed. Lemma ring_opp_mul_r : forall x y, -(x * y) == x * -y. Proof. intros x y;rewrite <- (ring_add_0_l (x * - y)). rewrite ring_add_comm . rewrite <- (ring_opp_def (x*y)). rewrite ring_add_assoc . rewrite <- ring_distr_r . rewrite (ring_add_comm (-y));rewrite ring_opp_def . rewrite ring_mul_0_r;rewrite ring_add_0_l ;reflexivity. Qed. Lemma ring_opp_add : forall x y, -(x + y) == -x + -y. Proof. intros x y;rewrite <- (ring_add_0_l (-(x+y))). rewrite <- (ring_opp_def x). rewrite <- (ring_add_0_l (x + - x + - (x + y))). rewrite <- (ring_opp_def y). rewrite (ring_add_comm x). rewrite (ring_add_comm y). rewrite <- (ring_add_assoc (-y)). rewrite <- (ring_add_assoc (- x)). rewrite (ring_add_assoc y). rewrite (ring_add_comm y). rewrite <- (ring_add_assoc (- x)). rewrite (ring_add_assoc y). rewrite (ring_add_comm y);rewrite ring_opp_def . rewrite (ring_add_comm (-x) 0);rewrite ring_add_0_l . rewrite ring_add_comm; reflexivity. Qed. Lemma ring_opp_opp : forall x, - -x == x. Proof. intros x; rewrite <- (ring_add_0_l (- -x)). rewrite <- (ring_opp_def x). rewrite <- ring_add_assoc ; rewrite ring_opp_def . rewrite (ring_add_comm x); rewrite ring_add_0_l . reflexivity. Qed. Lemma ring_sub_ext : forall x1 x2, x1 == x2 -> forall y1 y2, y1 == y2 -> x1 - y1 == x2 - y2. Proof. intros. setoid_replace (x1 - y1) with (x1 + -y1). - setoid_replace (x2 - y2) with (x2 + -y2). + rewrite H;rewrite H0;reflexivity. + rewrite ring_sub_def. reflexivity. - rewrite ring_sub_def. reflexivity. Qed. Ltac mrewrite := repeat first [ rewrite ring_add_0_l | rewrite <- (ring_add_comm 0) | rewrite ring_mul_1_l | rewrite ring_mul_0_l | rewrite ring_distr_l | reflexivity ]. Lemma ring_add_0_r : forall x, (x + 0) == x. Proof. intros; mrewrite. Qed. Lemma ring_add_assoc1 : forall x y z, (x + y) + z == (y + z) + x. Proof. intros;rewrite <- (ring_add_assoc x). rewrite (ring_add_comm x);reflexivity. Qed. Lemma ring_add_assoc2 : forall x y z, (y + x) + z == (y + z) + x. Proof. intros; repeat rewrite <- ring_add_assoc. rewrite (ring_add_comm x); reflexivity. Qed. Lemma ring_opp_zero : -0 == 0. Proof. rewrite <- (ring_mul_0_r 0). rewrite ring_opp_mul_l. repeat rewrite ring_mul_0_r. reflexivity. Qed. End Ring. (** Some simplification tactics*) Ltac gen_reflexivity := reflexivity. Ltac gen_rewrite := repeat first [ reflexivity | progress rewrite ring_opp_zero | rewrite ring_add_0_l | rewrite ring_add_0_r | rewrite ring_mul_1_l | rewrite ring_mul_1_r | rewrite ring_mul_0_l | rewrite ring_mul_0_r | rewrite ring_distr_l | rewrite ring_distr_r | rewrite ring_add_assoc | rewrite ring_mul_assoc | progress rewrite ring_opp_add | progress rewrite ring_sub_def | progress rewrite <- ring_opp_mul_l | progress rewrite <- ring_opp_mul_r ]. Ltac gen_add_push x := repeat (match goal with | |- context [(?y + x) + ?z] => progress rewrite (ring_add_assoc2 x y z) | |- context [(x + ?y) + ?z] => progress rewrite (ring_add_assoc1 x y z) end). coq-8.20.0/theories/setoid_ring/Ncring_initial.v000066400000000000000000000154331466560755400216630ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* 1 | xO p => (1 + 1) * (gen_phiPOS1 p) | xI p => 1 + ((1 + 1) * (gen_phiPOS1 p)) end. Fixpoint gen_phiPOS (p:positive) : R := match p with | xH => 1 | xO xH => (1 + 1) | xO p => (1 + 1) * (gen_phiPOS p) | xI xH => 1 + (1 +1) | xI p => 1 + ((1 + 1) * (gen_phiPOS p)) end. Definition gen_phiZ1 z := match z with | Zpos p => gen_phiPOS1 p | Z0 => 0 | Zneg p => -(gen_phiPOS1 p) end. Definition gen_phiZ z := match z with | Zpos p => gen_phiPOS p | Z0 => 0 | Zneg p => -(gen_phiPOS p) end. Declare Scope ZMORPHISM. Notation "[ x ]" := (gen_phiZ x) : ZMORPHISM. Open Scope ZMORPHISM. Definition get_signZ z := match z with | Zneg p => Some (Zpos p) | _ => None end. Ltac norm := gen_rewrite. Ltac add_push := Ncring.gen_add_push. Ltac rsimpl := simpl. Lemma same_gen : forall x, gen_phiPOS1 x == gen_phiPOS x. Proof. induction x;rsimpl. - rewrite IHx. destruct x;simpl;norm. - rewrite IHx;destruct x;simpl;norm. - reflexivity. Qed. Lemma ARgen_phiPOS_Psucc : forall x, gen_phiPOS1 (Pos.succ x) == 1 + (gen_phiPOS1 x). Proof. induction x; simpl. - now rewrite IHx, ring_distr_r, ring_mul_1_r, ring_add_assoc. - reflexivity. - now rewrite ring_mul_1_r. Qed. Lemma ARgen_phiPOS_add : forall x y, gen_phiPOS1 (x + y) == (gen_phiPOS1 x) + (gen_phiPOS1 y). Proof. induction x;destruct y;simpl. - rewrite Pos.add_carry_spec, ARgen_phiPOS_Psucc, IHx. rewrite !ring_distr_r, !ring_mul_1_r, !ring_add_assoc. now add_push 1. - now rewrite IHx, !ring_distr_r, !ring_add_assoc. - rewrite ARgen_phiPOS_Psucc, !ring_distr_r, !ring_mul_1_r. now add_push 1. - rewrite IHx, !ring_distr_r, !ring_add_assoc. now add_push 1. - now rewrite IHx, !ring_distr_r. - now rewrite ring_add_comm. - now rewrite ARgen_phiPOS_Psucc, !ring_distr_r, !ring_mul_1_r, !ring_add_assoc. - reflexivity. - now rewrite ring_mul_1_r. Qed. Lemma ARgen_phiPOS_mult : forall x y, gen_phiPOS1 (x * y) == gen_phiPOS1 x * gen_phiPOS1 y. Proof. induction x; intros; simpl. - rewrite ARgen_phiPOS_add. simpl. now rewrite IHx, !ring_distr_l, !ring_mul_1_l. - now rewrite IHx, ring_mul_assoc. - now rewrite ring_mul_1_l. Qed. (*morphisms are extensionally equal*) Lemma same_genZ : forall x, [x] == gen_phiZ1 x. Proof. destruct x;rsimpl; try rewrite same_gen; reflexivity. Qed. Lemma gen_Zeqb_ok : forall x y, Zeq_bool x y = true -> [x] == [y]. Proof. intros x y H7. assert (H10 := Zeq_bool_eq x y H7);unfold IDphi in H10. rewrite H10;reflexivity. Qed. Lemma gen_phiZ1_add_pos_neg : forall x y, gen_phiZ1 (Z.pos_sub x y) == gen_phiPOS1 x + -gen_phiPOS1 y. Proof. intros x y. generalize (Z.pos_sub_discr x y). destruct (Z.pos_sub x y) as [|p|p]; intros; subst. - now rewrite ring_opp_def. - rewrite ARgen_phiPOS_add; simpl. add_push (gen_phiPOS1 p). now rewrite ring_opp_def, ring_add_0_l. - rewrite ARgen_phiPOS_add; simpl. now rewrite ring_opp_add, ring_add_assoc, ring_opp_def, ring_add_0_l. Qed. Lemma match_compOpp : forall x (B:Type) (be bl bg:B), match CompOpp x with Eq => be | Lt => bl | Gt => bg end = match x with Eq => be | Lt => bg | Gt => bl end. Proof. destruct x;simpl;intros;trivial. Qed. Lemma gen_phiZ_add : forall x y, [x + y] == [x] + [y]. Proof. intros x y; repeat rewrite same_genZ; generalize x y;clear x y. induction x;destruct y;simpl;norm. - apply ARgen_phiPOS_add. - apply gen_phiZ1_add_pos_neg. - rewrite gen_phiZ1_add_pos_neg. rewrite ring_add_comm. reflexivity. - rewrite ARgen_phiPOS_add. rewrite ring_opp_add. reflexivity. Qed. Lemma gen_phiZ_opp : forall x, [- x] == - [x]. Proof. intros x. repeat rewrite same_genZ. generalize x ;clear x. induction x;simpl;norm. rewrite ring_opp_opp. reflexivity. Qed. Lemma gen_phiZ_mul : forall x y, [x * y] == [x] * [y]. Proof. intros x y;repeat rewrite same_genZ. destruct x; simpl; [now rewrite ring_mul_0_l|destruct y..]; simpl. - now rewrite ring_mul_0_r. - now rewrite ARgen_phiPOS_mult. - now rewrite ARgen_phiPOS_mult, ring_opp_mul_r. - now rewrite ring_mul_0_r. - now rewrite ARgen_phiPOS_mult, ring_opp_mul_l. - now rewrite ARgen_phiPOS_mult, <- ring_opp_mul_l, <- ring_opp_mul_r, ring_opp_opp. Qed. Lemma gen_phiZ_ext : forall x y : Z, x = y -> [x] == [y]. Proof. intros;subst;reflexivity. Qed. Declare Equivalent Keys bracket gen_phiZ. (*proof that [.] satisfies morphism specifications*) Global Instance gen_phiZ_morph : (@Ring_morphism (Z:Type) R _ _ _ _ _ _ _ Zops Zr _ _ _ _ _ _ _ _ _ gen_phiZ) . (* beurk!*) apply Build_Ring_morphism; simpl;try reflexivity. - apply gen_phiZ_add. - intros. rewrite ring_sub_def. replace (x-y)%Z with (x + (-y))%Z. + now rewrite gen_phiZ_add, gen_phiZ_opp, ring_sub_def. + reflexivity. - apply gen_phiZ_mul. - apply gen_phiZ_opp. - apply gen_phiZ_ext. Defined. End ZMORPHISM. #[global] Instance multiplication_phi_ring{R:Type}`{Ring R} : Multiplication := {multiplication x y := (gen_phiZ x) * y}. coq-8.20.0/theories/setoid_ring/Ncring_polynom.v000066400000000000000000000417651466560755400217360ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* : non commutative polynomials on a commutative ring A *) Set Implicit Arguments. Require Import Setoid. Require Import BinList. Require Import BinPos. Require Import BinNat. Require Import BinInt. Require Export Ring_polynom. (* n'utilise que PExpr *) Require Export Ncring. #[local] Create HintDb rsimpl. Section MakeRingPol. Context (C R:Type) `{Rh:Ring_morphism C R}. Variable phiCR_comm: forall (c:C)(x:R), x * [c] == [c] * x. Ltac rsimpl := repeat (gen_rewrite || rewrite phiCR_comm). Ltac add_push := gen_add_push . #[local] Hint Rewrite ring_opp_zero ring_opp_add ring_add_0_l ring_add_0_r ring_mul_1_l ring_mul_1_r ring_mul_0_l ring_mul_0_r ring_distr_l ring_distr_r ring_add_assoc ring_mul_assoc : rsimpl. (* Definition of non commutative multivariable polynomials with coefficients in C : *) Inductive Pol : Type := | Pc : C -> Pol | PX : Pol -> positive -> positive -> Pol -> Pol. (* PX P i n Q represents P * X_i^n + Q *) Definition cO:C . exact ring0. Defined. Definition cI:C . exact ring1. Defined. Definition P0 := Pc 0. Definition P1 := Pc 1. Variable Ceqb:C->C->bool. #[universes(template)] Class Equalityb (A : Type):= {equalityb : A -> A -> bool}. Notation "x =? y" := (equalityb x y) (at level 70, no associativity). Variable Ceqb_eq: forall x y:C, Ceqb x y = true -> (x == y). Instance equalityb_coef : Equalityb C := {equalityb x y := Ceqb x y}. Fixpoint Peq (P P' : Pol) {struct P'} : bool := match P, P' with | Pc c, Pc c' => c =? c' | PX P i n Q, PX P' i' n' Q' => match Pos.compare i i', Pos.compare n n' with | Eq, Eq => if Peq P P' then Peq Q Q' else false | _,_ => false end | _, _ => false end. Instance equalityb_pol : Equalityb Pol := {equalityb x y := Peq x y}. (* Q a ses variables de queue < i *) Definition mkPX P i n Q := match P with | Pc c => if c =? 0 then Q else PX P i n Q | PX P' i' n' Q' => match Pos.compare i i' with | Eq => if Q' =? P0 then PX P' i (n + n') Q else PX P i n Q | _ => PX P i n Q end end. Definition mkXi i n := PX P1 i n P0. Definition mkX i := mkXi i 1. (** Opposite of addition *) Fixpoint Popp (P:Pol) : Pol := match P with | Pc c => Pc (- c) | PX P i n Q => PX (Popp P) i n (Popp Q) end. Notation "-- P" := (Popp P)(at level 30). (** Addition et subtraction *) Fixpoint PaddCl (c:C)(P:Pol) {struct P} : Pol := match P with | Pc c1 => Pc (c + c1) | PX P i n Q => PX P i n (PaddCl c Q) end. (* Q quelconque *) Section PaddX. Variable Padd:Pol->Pol->Pol. Variable P:Pol. (* Xi^n * P + Q les variables de tete de Q ne sont pas forcement < i mais Q est normalisé : variables de tete decroissantes *) Fixpoint PaddX (i n:positive)(Q:Pol){struct Q}:= match Q with | Pc c => mkPX P i n Q | PX P' i' n' Q' => match Pos.compare i i' with | (* i > i' *) Gt => mkPX P i n Q | (* i < i' *) Lt => mkPX P' i' n' (PaddX i n Q') | (* i = i' *) Eq => match Z.pos_sub n n' with | (* n > n' *) Zpos k => mkPX (PaddX i k P') i' n' Q' | (* n = n' *) Z0 => mkPX (Padd P P') i n Q' | (* n < n' *) Zneg k => mkPX (Padd P (mkPX P' i k P0)) i n Q' end end end. End PaddX. Fixpoint Padd (P1 P2: Pol) {struct P1} : Pol := match P1 with | Pc c => PaddCl c P2 | PX P' i' n' Q' => PaddX Padd P' i' n' (Padd Q' P2) end. Notation "P ++ P'" := (Padd P P'). Definition Psub(P P':Pol):= P ++ (--P'). Notation "P -- P'" := (Psub P P')(at level 50). (** Multiplication *) Fixpoint PmulC_aux (P:Pol) (c:C) {struct P} : Pol := match P with | Pc c' => Pc (c' * c) | PX P i n Q => mkPX (PmulC_aux P c) i n (PmulC_aux Q c) end. Definition PmulC P c := if c =? 0 then P0 else if c =? 1 then P else PmulC_aux P c. Fixpoint Pmul (P1 P2 : Pol) {struct P2} : Pol := match P2 with | Pc c => PmulC P1 c | PX P i n Q => PaddX Padd (Pmul P1 P) i n (Pmul P1 Q) end. Notation "P ** P'" := (Pmul P P')(at level 40). Definition Psquare (P:Pol) : Pol := P ** P. (** Evaluation of a polynomial towards R *) Fixpoint Pphi(l:list R) (P:Pol) {struct P} : R := match P with | Pc c => [c] | PX P i n Q => let x := nth 0 i l in let xn := pow_pos x n in (Pphi l P) * xn + (Pphi l Q) end. Reserved Notation "P @ l " (at level 10, no associativity). Notation "P @ l " := (Pphi l P). (** Proofs *) Ltac destr_pos_sub H := match goal with |- context [Z.pos_sub ?x ?y] => assert (H := Z.pos_sub_discr x y); destruct (Z.pos_sub x y) end. Lemma Peq_ok : forall P P', (P =? P') = true -> forall l, P@l == P'@ l. Proof. induction P;destruct P';simpl;intros ;try easy. - now apply ring_morphism_eq, Ceqb_eq. - specialize (IHP1 P'1). specialize (IHP2 P'2). simpl in IHP1, IHP2. destruct (Pos.compare_spec p p1); try discriminate; destruct (Pos.compare_spec p0 p2); try discriminate. destruct (Peq P2 P'1); try discriminate. subst; now rewrite IHP1, IHP2. Qed. Lemma Pphi0 : forall l, P0@l == 0. Proof. intros;simpl. rewrite ring_morphism0. reflexivity. Qed. Lemma Pphi1 : forall l, P1@l == 1. Proof. intros;simpl; rewrite ring_morphism1. reflexivity. Qed. Lemma mkPX_ok : forall l P i n Q, (mkPX P i n Q)@l == P@l * (pow_pos (nth 0 i l) n) + Q@l. Proof. intros l P i n Q;unfold mkPX. destruct P;try (simpl;reflexivity). - assert (Hh := ring_morphism_eq c 0). simpl; case_eq (Ceqb c 0);simpl;try reflexivity. intros. rewrite Hh. + rewrite ring_morphism0. now rewrite_db rsimpl. + apply Ceqb_eq. trivial. - destruct (Pos.compare_spec i p). + subst. assert (Hh := @Peq_ok P3 P0). case_eq (P3=? P0). * intro. simpl. rewrite Hh. -- rewrite Pos.add_comm, pow_pos_add, Pphi0. now rewrite_db rsimpl. -- trivial. * intros. reflexivity. + reflexivity. + reflexivity. Qed. Ltac Esimpl := repeat (progress ( match goal with | |- context [?P@?l] => match P with | P0 => rewrite (Pphi0 l) | P1 => rewrite (Pphi1 l) | (mkPX ?P ?i ?n ?Q) => rewrite (mkPX_ok l P i n Q) end | |- context [[?c]] => match c with | 0 => rewrite ring_morphism0 | 1 => rewrite ring_morphism1 | ?x + ?y => rewrite ring_morphism_add | ?x * ?y => rewrite ring_morphism_mul | ?x - ?y => rewrite ring_morphism_sub | - ?x => rewrite ring_morphism_opp end end)); simpl; rsimpl. Lemma PaddCl_ok : forall c P l, (PaddCl c P)@l == [c] + P@l . Proof. induction P as [|????? IH2]; simpl; intros. - now rewrite ring_morphism_add. - now rewrite IH2, !(ring_add_comm [_]), ring_add_assoc. Qed. Lemma PmulC_aux_ok : forall c P l, (PmulC_aux P c)@l == P@l * [c]. Proof. induction P as [|? IH1 ??? IH2]; simpl; intros. - now rewrite ring_morphism_mul. - rewrite mkPX_ok, IH1, IH2, !phiCR_comm. now rewrite_db rsimpl. Qed. Lemma PmulC_ok : forall c P l, (PmulC P c)@l == P@l * [c]. Proof. intros c P l; unfold PmulC. assert (Hh:= ring_morphism_eq c 0);case_eq (c =? 0). - intros. rewrite Hh. + now rewrite Pphi0, ring_morphism0, ring_mul_0_r. + now apply Ceqb_eq. - assert (H1h:= ring_morphism_eq c 1);case_eq (c =? 1);intros. + rewrite H1h. * now rewrite ring_morphism1, ring_mul_1_r. * now apply Ceqb_eq. + apply PmulC_aux_ok. Qed. Lemma Popp_ok : forall P l, (--P)@l == - P@l. Proof. induction P as [|? IH1 ??? IH2];simpl;intros. - now rewrite ring_morphism_opp. - rewrite IH1, IH2. now rewrite ring_opp_add, ring_opp_mul_l. Qed. Ltac Esimpl2 := Esimpl; repeat (progress ( match goal with | |- context [(PaddCl ?c ?P)@?l] => rewrite (PaddCl_ok c P l) | |- context [(PmulC ?P ?c)@?l] => rewrite (PmulC_ok c P l) | |- context [(--?P)@?l] => rewrite (Popp_ok P l) end)); Esimpl. Lemma PaddXPX: forall P i n Q, PaddX Padd P i n Q = match Q with | Pc c => mkPX P i n Q | PX P' i' n' Q' => match Pos.compare i i' with | (* i > i' *) Gt => mkPX P i n Q | (* i < i' *) Lt => mkPX P' i' n' (PaddX Padd P i n Q') | (* i = i' *) Eq => match Z.pos_sub n n' with | (* n > n' *) Zpos k => mkPX (PaddX Padd P i k P') i' n' Q' | (* n = n' *) Z0 => mkPX (Padd P P') i n Q' | (* n < n' *) Zneg k => mkPX (Padd P (mkPX P' i k P0)) i n Q' end end end. Proof. induction Q; reflexivity. Qed. Lemma PaddX_ok2 : forall P2, (forall P l, (P2 ++ P) @ l == P2 @ l + P @ l) /\ (forall P k n l, (PaddX Padd P2 k n P) @ l == P2 @ l * pow_pos (nth 0 k l) n + P @ l). Proof. induction P2 as [|? IH1 ??? IH2];simpl;intros. - split. + intros. apply PaddCl_ok. + intros P. induction P as [|? IH'1 ??? IH'2]. * unfold PaddX. intros. now rewrite mkPX_ok. * intros. simpl. destruct (Pos.compare_spec k p) as [Hh|Hh|Hh]. -- destr_pos_sub H1h; subst. ++ rewrite mkPX_ok, PaddCl_ok. now rewrite_db rsimpl. ++ rewrite mkPX_ok, IH'1, Pos.add_comm, pow_pos_add. now rewrite_db rsimpl. ++ rewrite mkPX_ok, PaddCl_ok, mkPX_ok, Pphi0, Pos.add_comm, pow_pos_add. now rewrite_db rsimpl. -- rewrite mkPX_ok, IH'2. rewrite_db rsimpl. now rewrite (ring_add_comm (_ * _)). -- assert (H1h := ring_morphism_eq c 0);case_eq (Ceqb c 0); intros; simpl. ++ rewrite H1h;trivial. ** rewrite ring_morphism0. now rewrite_db rsimpl. ** apply Ceqb_eq; trivial. ++ reflexivity. - decompose [and] IH1. decompose [and] IH2. clear IH1 IH2. split. + intros. rewrite H0. rewrite H1. now rewrite ring_add_assoc. + induction P. * unfold PaddX. intros. rewrite mkPX_ok. reflexivity. * intros. rewrite PaddXPX. destruct (Pos.compare_spec k p1) as [H3h|H3h|H3h]. -- destr_pos_sub H4h; subst. ++ rewrite mkPX_ok. simpl. rewrite H0, H1. now rewrite_db rsimpl. ++ rewrite mkPX_ok, IHP1. simpl. rewrite Pos.add_comm, pow_pos_add. now rewrite_db rsimpl. ++ rewrite mkPX_ok. simpl. rewrite H0, H1. rewrite mkPX_ok, Pphi0. rewrite Pos.add_comm, pow_pos_add. now rewrite_db rsimpl. -- rewrite mkPX_ok. simpl. rewrite IHP2. now rewrite ring_add_comm, <- ring_add_assoc, (ring_add_comm (_ @ _)). -- now rewrite mkPX_ok. Qed. Lemma Padd_ok : forall P Q l, (P ++ Q) @ l == P @ l + Q @ l. Proof. intro P. elim (PaddX_ok2 P); auto. Qed. Lemma PaddX_ok : forall P2 P k n l, (PaddX Padd P2 k n P) @ l == P2 @ l * pow_pos (nth 0 k l) n + P @ l. Proof. intro P2. elim (PaddX_ok2 P2); auto. Qed. Lemma Psub_ok : forall P' P l, (P -- P')@l == P@l - P'@l. Proof. unfold Psub. intros. now rewrite Padd_ok, Popp_ok, ring_sub_def. Qed. Lemma Pmul_ok : forall P P' l, (P**P')@l == P@l * P'@l. Proof. induction P'; simpl; intros. - rewrite PmulC_ok. reflexivity. - rewrite PaddX_ok. rewrite IHP'1. rewrite IHP'2. now rewrite_db rsimpl. Qed. Lemma Psquare_ok : forall P l, (Psquare P)@l == P@l * P@l. Proof. intros. unfold Psquare. apply Pmul_ok. Qed. (** Definition of polynomial expressions *) (* Inductive PExpr : Type := | PEc : C -> PExpr | PEX : positive -> PExpr | PEadd : PExpr -> PExpr -> PExpr | PEsub : PExpr -> PExpr -> PExpr | PEmul : PExpr -> PExpr -> PExpr | PEopp : PExpr -> PExpr | PEpow : PExpr -> N -> PExpr. *) (** Specification of the power function *) Section POWER. Variable Cpow : Set. Variable Cp_phi : N -> Cpow. Variable rpow : R -> Cpow -> R. Record power_theory : Prop := mkpow_th { rpow_pow_N : forall r n, (rpow r (Cp_phi n))== (pow_N r n) }. End POWER. Variable Cpow : Set. Variable Cp_phi : N -> Cpow. Variable rpow : R -> Cpow -> R. Variable pow_th : power_theory Cp_phi rpow. (** evaluation of polynomial expressions towards R *) Fixpoint PEeval (l:list R) (pe:PExpr C) {struct pe} : R := match pe with | PEO => 0 | PEI => 1 | PEc c => [c] | PEX _ j => nth 0 j l | PEadd pe1 pe2 => (PEeval l pe1) + (PEeval l pe2) | PEsub pe1 pe2 => (PEeval l pe1) - (PEeval l pe2) | PEmul pe1 pe2 => (PEeval l pe1) * (PEeval l pe2) | PEopp pe1 => - (PEeval l pe1) | PEpow pe1 n => rpow (PEeval l pe1) (Cp_phi n) end. Strategy expand [PEeval]. Definition mk_X j := mkX j. (** Correctness proofs *) Lemma mkX_ok : forall p l, nth 0 p l == (mk_X p) @ l. Proof. intros. simpl. rewrite ring_morphism0, ring_morphism1. now rewrite_db rsimpl. Qed. Ltac Esimpl3 := repeat match goal with | |- context [(?P1 ++ ?P2)@?l] => rewrite (Padd_ok P1 P2 l) | |- context [(?P1 -- ?P2)@?l] => rewrite (Psub_ok P1 P2 l) end;try Esimpl2;try reflexivity;try apply ring_add_comm. (* Power using the chinise algorithm *) Section POWER2. Variable subst_l : Pol -> Pol. Fixpoint Ppow_pos (res P:Pol) (p:positive){struct p} : Pol := match p with | xH => subst_l (Pmul P res) | xO p => Ppow_pos (Ppow_pos res P p) P p | xI p => subst_l (Pmul P (Ppow_pos (Ppow_pos res P p) P p)) end. Definition Ppow_N P n := match n with | N0 => P1 | Npos p => Ppow_pos P1 P p end. Fixpoint pow_pos_gen (R:Type)(m:R->R->R)(x:R) (i:positive) {struct i}: R := match i with | xH => x | xO i => let p := pow_pos_gen m x i in m p p | xI i => let p := pow_pos_gen m x i in m x (m p p) end. Lemma Ppow_pos_ok : forall l, (forall P, subst_l P@l == P@l) -> forall res P p, (Ppow_pos res P p)@l == (pow_pos_gen Pmul P p)@l * res@l. Proof. intros l subst_l_ok res P p. generalize res;clear res. induction p;simpl;intros. - rewrite subst_l_ok, !Pmul_ok, !IHp. now rewrite_db rsimpl. - rewrite Pmul_ok, !IHp. now rewrite_db rsimpl. - now rewrite subst_l_ok, Pmul_ok. Qed. Definition pow_N_gen (R:Type)(x1:R)(m:R->R->R)(x:R) (p:N) := match p with | N0 => x1 | Npos p => pow_pos_gen m x p end. Lemma Ppow_N_ok : forall l, (forall P, subst_l P@l == P@l) -> forall P n, (Ppow_N P n)@l == (pow_N_gen P1 Pmul P n)@l. Proof. destruct n;simpl. - reflexivity. - rewrite Ppow_pos_ok; trivial. now rewrite Pphi1, ring_mul_1_r. Qed. End POWER2. (** Normalization and rewriting *) Section NORM_SUBST_REC. Let subst_l (P:Pol) := P. Let Pmul_subst P1 P2 := subst_l (Pmul P1 P2). Let Ppow_subst := Ppow_N subst_l. Fixpoint norm_aux (pe:PExpr C) : Pol := match pe with | PEO => Pc cO | PEI => Pc cI | PEc c => Pc c | PEX _ j => mk_X j | PEadd pe1 (PEopp pe2) => Psub (norm_aux pe1) (norm_aux pe2) | PEadd pe1 pe2 => Padd (norm_aux pe1) (norm_aux pe2) | PEsub pe1 pe2 => Psub (norm_aux pe1) (norm_aux pe2) | PEmul pe1 pe2 => Pmul (norm_aux pe1) (norm_aux pe2) | PEopp pe1 => Popp (norm_aux pe1) | PEpow pe1 n => Ppow_N (fun p => p) (norm_aux pe1) n end. Definition norm_subst pe := subst_l (norm_aux pe). Lemma norm_aux_spec : forall l pe, PEeval l pe == (norm_aux pe)@l. Proof. intros. induction pe as [ | | | |pe1 IH1 pe2 IH2|pe1 IH1 pe2 IH2|pe1 IH1 pe2 IH2|pe IH|pe IH n]; simpl. - now rewrite <- ring_morphism0. - now rewrite <- ring_morphism1. - reflexivity. - rewrite ring_morphism0, ring_morphism1. now rewrite_db rsimpl. - rewrite IH1, IH2. unfold Psub. destruct pe2; now rewrite Padd_ok. - rewrite IH1, IH2. unfold Psub. now rewrite Padd_ok, Popp_ok, ring_sub_def. - now rewrite IH1, IH2, Pmul_ok. - now rewrite IH, Popp_ok. - rewrite Ppow_N_ok; [|intros; reflexivity]. rewrite rpow_pow_N; [|now apply pow_th]. destruct n; simpl; [now rewrite ring_morphism1|]. induction p as [p IHp|p IHp|]; simpl; [| |now apply IH]. + now rewrite IHp, IH, !Pmul_ok. + now rewrite Pmul_ok, IHp. Qed. Lemma norm_subst_spec : forall l pe, PEeval l pe == (norm_subst pe)@l. Proof. intros. apply norm_aux_spec. Qed. End NORM_SUBST_REC. Fixpoint interp_PElist (l:list R) (lpe:list (PExpr C * PExpr C)) {struct lpe} : Prop := match lpe with | nil => True | (me,pe)::lpe => match lpe with | nil => PEeval l me == PEeval l pe | _ => PEeval l me == PEeval l pe /\ interp_PElist l lpe end end. Lemma norm_subst_ok : forall l pe, PEeval l pe == (norm_subst pe)@l. Proof. intros. apply norm_subst_spec. Qed. Lemma ring_correct : forall l pe1 pe2, (norm_subst pe1 =? norm_subst pe2) = true -> PEeval l pe1 == PEeval l pe2. Proof. simpl;intros. do 2 (rewrite (norm_subst_ok l);trivial). apply Peq_ok;trivial. Qed. End MakeRingPol. coq-8.20.0/theories/setoid_ring/Ncring_tac.v000066400000000000000000000256001466560755400207760ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* let conv := match goal with | _ => let _ := match goal with _ => convert term t0 end in open_constr:(true) | _ => open_constr:(false) end in match conv with | true => n | false => reify_as_var_aux open_constr:(S n) tl term end | _ => let _ := open_constr:(eq_refl : lvar = @cons _ term _) in n end. Ltac reify_as_var lvar term := reify_as_var_aux Datatypes.O lvar term. Ltac close_varlist lvar := match lvar with | @nil _ => idtac | @cons _ _ ?tl => close_varlist tl | _ => let _ := constr:(eq_refl : lvar = @nil _) in idtac end. Ltac extra_reify term := open_constr:((false,tt)). Ltac reify_term Tring lvar term := match open_constr:((Tring, term)) with (* int literals *) | (_, Z0) => open_constr:(PEc 0%Z) | (_, Zpos ?p) => open_constr:(PEc (Zpos p)) | (_, Zneg ?p) => open_constr:(PEc (Zneg p)) (* ring constants *) | (Ring (ring0:=?op), _) => let _ := match goal with _ => convert op term end in open_constr:(PEc 0%Z) | (Ring (ring1:=?op), _) => let _ := match goal with _ => convert op term end in open_constr:(PEc 1%Z) (* binary operators *) | (Ring (T:=?R) (add:=?add) (mul:=?mul) (sub:=?sub), ?op ?t1 ?t2) => (* quick(?) check op is of th right type? TODO try without this check *) let _ := open_constr:(t1 : R) in let _ := open_constr:(t2 : R) in match tt with | _ => let _ := match goal with _ => convert add op end in (* NB: don't reify before we recognize the operator in case we can't recognire it *) let et1 := reify_term Tring lvar t1 in let et2 := reify_term Tring lvar t2 in open_constr:(PEadd et1 et2) | _ => let _ := match goal with _ => convert mul op end in let et1 := reify_term Tring lvar t1 in let et2 := reify_term Tring lvar t2 in open_constr:(PEmul et1 et2) | _ => let _ := match goal with _ => convert sub op end in let et1 := reify_term Tring lvar t1 in let et2 := reify_term Tring lvar t2 in open_constr:(PEsub et1 et2) end (* unary operator (opposite) *) | (Ring (T:=?R) (opp:=?opp), ?op ?t) => let _ := match goal with _ => convert opp op end in let et := reify_term Tring lvar t in open_constr:(PEopp et) (* special cases (XXX can/should we be less syntactic?) *) | (_, @multiplication Z _ _ ?z ?t) => let et := reify_term Tring lvar t in open_constr:(PEmul (PEc z) et) | (_, pow_N ?t ?n) => let et := reify_term Tring lvar t in open_constr:(PEpow et n) | (_, @power _ _ power_ring ?t ?n) => let et := reify_term Tring lvar t in open_constr:(PEpow et (ZN n)) (* extensibility and variable case *) | _ => let extra := extra_reify term in lazymatch extra with | (false,_) => let n := reify_as_var lvar term in open_constr:(PEX Z (Pos.of_succ_nat n)) | (true,?v) => v end end. Ltac list_reifyl_core Tring lvar lterm := match lterm with | @nil _ => open_constr:(@nil (PExpr Z)) | @cons _ ?t ?tl => let et := reify_term Tring lvar t in let etl := list_reifyl_core Tring lvar tl in open_constr:(@cons (PExpr Z) et etl) end. Ltac list_reifyl lvar lterm := match lterm with | @cons ?R _ _ => let R_ring := constr:(_ :> Ring (T:=R)) in let Tring := type of R_ring in let lexpr := list_reifyl_core Tring lvar lterm in let _ := match goal with _ => close_varlist lvar end in constr:((lvar,lexpr)) end. Ltac list_reifyl0 lterm := match lterm with | @cons ?R _ _ => let lvar := open_constr:(_ :> list R) in list_reifyl lvar lterm end. Class ReifyL {R:Type} (lvar lterm : list R) := list_reifyl : (list R * list (PExpr Z)). Arguments list_reifyl {R lvar lterm _}. Global Hint Extern 0 (ReifyL ?lvar ?lterm) => let reif := list_reifyl lvar lterm in exact reif : typeclass_instances. Unset Implicit Arguments. Ltac lterm_goal g := match g with | ?t1 == ?t2 => constr:(t1::t2::nil) | ?t1 = ?t2 => constr:(t1::t2::nil) | (_ ?t1 ?t2) => constr:(t1::t2::nil) end. Lemma Zeqb_ok: forall x y : Z, Zeq_bool x y = true -> x == y. intros x y H. rewrite (Zeq_bool_eq x y H). reflexivity. Qed. Ltac reify_goal lvar lexpr lterm:= (*idtac lvar; idtac lexpr; idtac lterm;*) match lexpr with nil => idtac | ?e1::?e2::_ => match goal with |- (?op ?u1 ?u2) => change (op (@PEeval Z _ _ _ _ _ _ _ _ _ (@gen_phiZ _ _ _ _ _ _ _ _ _) N (fun n:N => n) (@pow_N _ _ _ _ _ _ _ _ _) lvar e1) (@PEeval Z _ _ _ _ _ _ _ _ _ (@gen_phiZ _ _ _ _ _ _ _ _ _) N (fun n:N => n) (@pow_N _ _ _ _ _ _ _ _ _) lvar e2)) end end. Lemma comm: forall (R:Type)`{Ring R}(c : Z) (x : R), x * (gen_phiZ c) == (gen_phiZ c) * x. induction c. - intros. simpl. gen_rewrite. - simpl. intros. rewrite <- same_gen. induction p. + simpl. gen_rewrite. rewrite IHp. reflexivity. + simpl. gen_rewrite. rewrite IHp. reflexivity. + simpl. gen_rewrite. - simpl. intros. rewrite <- same_gen. induction p. + simpl. generalize IHp. clear IHp. gen_rewrite. intro IHp. rewrite IHp. reflexivity. + simpl. generalize IHp. clear IHp. gen_rewrite. intro IHp. rewrite IHp. reflexivity. + simpl. gen_rewrite. Qed. Ltac ring_gen := match goal with |- ?g => let lterm := lterm_goal g in let reif := list_reifyl0 lterm in match reif with | (?fv, ?lexpr) => (*idtac "variables:";idtac fv; idtac "terms:"; idtac lterm; idtac "reifications:"; idtac lexpr; *) reify_goal fv lexpr lterm; match goal with |- ?g => apply (@ring_correct Z _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ (@gen_phiZ _ _ _ _ _ _ _ _ _) _ (@comm _ _ _ _ _ _ _ _ _ _) Zeq_bool Zeqb_ok N (fun n:N => n) (@pow_N _ _ _ _ _ _ _ _ _)); [apply mkpow_th; reflexivity |vm_compute; reflexivity] end end end. Ltac non_commutative_ring:= intros; ring_gen. (* simplification *) Ltac ring_simplify_aux lterm fv lexpr hyp := match lterm with | ?t0::?lterm => match lexpr with | ?e::?le => (* e:PExpr Z est la réification de t0:R *) let t := constr:(@Ncring_polynom.norm_subst Z 0%Z 1%Z Z.add Z.mul Z.sub Z.opp (@eq Z) Zops Zeq_bool e) in (* t:Pol Z *) let te := constr:(@Ncring_polynom.Pphi Z _ 0 1 _+_ _*_ _-_ -_ _==_ _ Ncring_initial.gen_phiZ fv t) in let eq1 := fresh "ring" in let nft := eval vm_compute in t in let t':= fresh "t" in pose (t' := nft); assert (eq1 : t = t'); [vm_cast_no_check (eq_refl t')| let eq2 := fresh "ring" in assert (eq2:(@Ncring_polynom.PEeval Z _ 0 1 _+_ _*_ _-_ -_ _==_ _ Ncring_initial.gen_phiZ N (fun n:N => n) (@Ring_theory.pow_N _ 1 multiplication) fv e) == te); [apply (@Ncring_polynom.norm_subst_ok Z _ 0%Z 1%Z Z.add Z.mul Z.sub Z.opp (@eq Z) _ _ 0 1 _+_ _*_ _-_ -_ _==_ _ _ Ncring_initial.gen_phiZ _ (@comm _ 0 1 _+_ _*_ _-_ -_ _==_ _ _) _ Zeqb_ok); apply mkpow_th; reflexivity | match hyp with | 1%nat => rewrite eq2 | ?H => try rewrite eq2 in H end]; let P:= fresh "P" in match hyp with | 1%nat => idtac "ok"; rewrite eq1; pattern (@Ncring_polynom.Pphi Z _ 0 1 _+_ _*_ _-_ -_ _==_ _ Ncring_initial.gen_phiZ fv t'); match goal with |- (?p ?t) => set (P:=p) end; unfold t' in *; clear t' eq1 eq2; simpl | ?H => rewrite eq1 in H; pattern (@Ncring_polynom.Pphi Z _ 0 1 _+_ _*_ _-_ -_ _==_ _ Ncring_initial.gen_phiZ fv t') in H; match type of H with | (?p ?t) => set (P:=p) in H end; unfold t' in *; clear t' eq1 eq2; simpl in H end; unfold P in *; clear P ]; ring_simplify_aux lterm fv le hyp | nil => idtac end | nil => idtac end. Ltac set_variables fv := match fv with | nil => idtac | ?t::?fv => let v := fresh "X" in set (v:=t) in *; set_variables fv end. Ltac deset n:= match n with | 0%nat => idtac | S ?n1 => match goal with | h:= ?v : ?t |- ?g => unfold h in *; clear h; deset n1 end end. (* a est soit un terme de l'anneau, soit une liste de termes. J'ai pas réussi à un décomposer les Vlists obtenues avec ne_constr_list dans Tactic Notation *) Ltac ring_simplify_gen a hyp := let lterm := match a with | _::_ => a | _ => constr:(a::nil) end in let reif := list_reifyl0 lterm in match reif with | (?fv, ?lexpr) => idtac lterm; idtac fv; idtac lexpr; let n := eval compute in (length fv) in idtac n; let lt:=fresh "lt" in set (lt:= lterm); let lv:=fresh "fv" in set (lv:= fv); (* les termes de fv sont remplacés par des variables pour pouvoir utiliser simpl ensuite sans risquer des simplifications indésirables *) set_variables fv; let lterm1 := eval unfold lt in lt in let lv1 := eval unfold lv in lv in idtac lterm1; idtac lv1; ring_simplify_aux lterm1 lv1 lexpr hyp; clear lt lv; (* on remet les termes de fv *) deset n end. Tactic Notation "non_commutative_ring_simplify" constr(lterm):= ring_simplify_gen lterm 1%nat. Tactic Notation "non_commutative_ring_simplify" constr(lterm) "in" ident(H):= ring_simplify_gen lterm H. coq-8.20.0/theories/setoid_ring/RealField.v000066400000000000000000000104221466560755400205520ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* 0. unfold Rgt. induction x; simpl; intros. - apply Rlt_trans with (1 + 0). + rewrite Rplus_comm. apply Rlt_n_Sn. + apply Rplus_lt_compat_l. rewrite <- (Rmul_0_l Rset Rext RTheory 2). rewrite Rmult_comm. apply Rmult_lt_compat_l. * apply Rlt_0_2. * trivial. - rewrite <- (Rmul_0_l Rset Rext RTheory 2). rewrite Rmult_comm. apply Rmult_lt_compat_l. + apply Rlt_0_2. + trivial. - replace 1 with (0 + 1). + apply Rlt_n_Sn. + apply Rplus_0_l. Qed. Lemma Rgen_phiPOS_not_0 : forall x, InitialRing.gen_phiPOS1 1 Rplus Rmult x <> 0. red; intros. specialize (Rgen_phiPOS x). rewrite H; intro. apply (Rlt_asym 0 0); trivial. Qed. Lemma Zeq_bool_complete : forall x y, InitialRing.gen_phiZ 0%R 1%R Rplus Rmult Ropp x = InitialRing.gen_phiZ 0%R 1%R Rplus Rmult Ropp y -> Zeq_bool x y = true. Proof gen_phiZ_complete Rset Rext Rfield Rgen_phiPOS_not_0. Lemma Rdef_pow_add : forall (x:R) (n m:nat), pow x (n + m) = pow x n * pow x m. Proof. intros x n; elim n; simpl; auto with real. intros n0 H' m; rewrite H'; auto with real. Qed. Lemma R_power_theory : power_theory 1%R Rmult (@eq R) N.to_nat pow. Proof. constructor. destruct n. - reflexivity. - simpl. induction p. + rewrite Pos2Nat.inj_xI. simpl. now rewrite Nat.add_0_r, Rdef_pow_add, IHp. + rewrite Pos2Nat.inj_xO. simpl. now rewrite Nat.add_0_r, Rdef_pow_add, IHp. + simpl. rewrite Rmult_comm;apply Rmult_1_l. Qed. Ltac Rpow_tac t := match isnatcst t with | false => constr:(InitialRing.NotConstant) | _ => constr:(N.of_nat t) end. Ltac IZR_tac t := match t with | R0 => constr:(0%Z) | R1 => constr:(1%Z) | IZR (Z.pow_pos 10 ?p) => match isPcst p with | true => constr:(Z.pow_pos 10 p) | _ => constr:(InitialRing.NotConstant) end | IZR ?u => match isZcst u with | true => u | _ => constr:(InitialRing.NotConstant) end | _ => constr:(InitialRing.NotConstant) end. Add Field RField : Rfield (completeness Zeq_bool_complete, constants [IZR_tac], power_tac R_power_theory [Rpow_tac]). coq-8.20.0/theories/setoid_ring/Ring.v000066400000000000000000000032701466560755400176250ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* b) (eq(A:=bool)). split; simpl. - intros x; destruct x; reflexivity. - intros x y; destruct x; destruct y; reflexivity. - intros x y z; destruct x; destruct y; destruct z; reflexivity. - reflexivity. - intros x y; destruct x; destruct y; reflexivity. - intros x y; destruct x; destruct y; reflexivity. - intros x y z; destruct x; destruct y; destruct z; reflexivity. - reflexivity. - intros x; destruct x; reflexivity. Qed. Definition bool_eq (b1 b2:bool) := if b1 then b2 else negb b2. Lemma bool_eq_ok : forall b1 b2, bool_eq b1 b2 = true -> b1 = b2. intros b1 b2; destruct b1; destruct b2; auto. Qed. Ltac bool_cst t := let t := eval hnf in t in match t with true => constr:(true) | false => constr:(false) | _ => constr:(NotConstant) end. Add Ring bool_ring : BoolTheory (decidable bool_eq_ok, constants [bool_cst]). coq-8.20.0/theories/setoid_ring/Ring_base.v000066400000000000000000000017041466560755400206170ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* R->R) (ropp : R->R). Variable req : R -> R -> Prop. (* Ring properties *) Variable Rsth : Equivalence req. Variable Reqe : ring_eq_ext radd rmul ropp req. Variable ARth : almost_ring_theory rO rI radd rmul rsub ropp req. (* Coefficients *) Variable C: Type. Variable (cO cI: C) (cadd cmul csub : C->C->C) (copp : C->C). Variable ceqb : C->C->bool. Variable phi : C -> R. Variable CRmorph : ring_morph rO rI radd rmul rsub ropp req cO cI cadd cmul csub copp ceqb phi. (* Power coefficients *) Variable Cpow : Type. Variable Cp_phi : N -> Cpow. Variable rpow : R -> Cpow -> R. Variable pow_th : power_theory rI rmul req Cp_phi rpow. (* division is ok *) Variable cdiv: C -> C -> C * C. Variable div_th: div_theory req cadd cmul phi cdiv. (* R notations *) Notation "0" := rO. Notation "1" := rI. Infix "+" := radd. Infix "*" := rmul. Infix "-" := rsub. Notation "- x" := (ropp x). Infix "==" := req. Infix "^" := (pow_pos rmul). (* C notations *) Infix "+!" := cadd. Infix "*!" := cmul. Infix "-! " := csub. Notation "-! x" := (copp x). Infix "?=!" := ceqb. Notation "[ x ]" := (phi x). (* Useful tactics *) Add Morphism radd with signature (req ==> req ==> req) as radd_ext. Proof. exact (Radd_ext Reqe). Qed. Add Morphism rmul with signature (req ==> req ==> req) as rmul_ext. Proof. exact (Rmul_ext Reqe). Qed. Add Morphism ropp with signature (req ==> req) as ropp_ext. Proof. exact (Ropp_ext Reqe). Qed. Add Morphism rsub with signature (req ==> req ==> req) as rsub_ext. Proof. exact (ARsub_ext Rsth Reqe ARth). Qed. Ltac rsimpl := gen_srewrite Rsth Reqe ARth. Ltac add_push := gen_add_push radd Rsth Reqe ARth. Ltac mul_push := gen_mul_push rmul Rsth Reqe ARth. Ltac add_permut_rec t := match t with | ?x + ?y => add_permut_rec y || add_permut_rec x | _ => add_push t; apply (Radd_ext Reqe); [|reflexivity] end. Ltac add_permut := repeat (reflexivity || match goal with |- ?t == _ => add_permut_rec t end). Ltac mul_permut_rec t := match t with | ?x * ?y => mul_permut_rec y || mul_permut_rec x | _ => mul_push t; apply (Rmul_ext Reqe); [|reflexivity] end. Ltac mul_permut := repeat (reflexivity || match goal with |- ?t == _ => mul_permut_rec t end). (* Definition of multivariable polynomials with coefficients in C : Type [Pol] represents [X1 ... Xn]. The representation is Horner's where a [n] variable polynomial (C[X1..Xn]) is seen as a polynomial on [X1] which coefficients are polynomials with [n-1] variables (C[X2..Xn]). There are several optimisations to make the repr compacter: - [Pc c] is the constant polynomial of value c == c*X1^0*..*Xn^0 - [Pinj j Q] is a polynomial constant w.r.t the [j] first variables. variable indices are shifted of j in Q. == X1^0 *..* Xj^0 * Q{X1 <- Xj+1;..; Xn-j <- Xn} - [PX P i Q] is an optimised Horner form of P*X^i + Q with P not the null polynomial == P * X1^i + Q{X1 <- X2; ..; Xn-1 <- Xn} In addition: - polynomials of the form (PX (PX P i (Pc 0)) j Q) are forbidden since they can be represented by the simpler form (PX P (i+j) Q) - (Pinj i (Pinj j P)) is (Pinj (i+j) P) - (Pinj i (Pc c)) is (Pc c) *) Inductive Pol : Type := | Pc : C -> Pol | Pinj : positive -> Pol -> Pol | PX : Pol -> positive -> Pol -> Pol. Definition P0 := Pc cO. Definition P1 := Pc cI. Fixpoint Peq (P P' : Pol) {struct P'} : bool := match P, P' with | Pc c, Pc c' => c ?=! c' | Pinj j Q, Pinj j' Q' => match j ?= j' with | Eq => Peq Q Q' | _ => false end | PX P i Q, PX P' i' Q' => match i ?= i' with | Eq => if Peq P P' then Peq Q Q' else false | _ => false end | _, _ => false end. Infix "?==" := Peq. Definition mkPinj j P := match P with | Pc _ => P | Pinj j' Q => Pinj (j + j') Q | _ => Pinj j P end. Definition mkPinj_pred j P:= match j with | xH => P | xO j => Pinj (Pos.pred_double j) P | xI j => Pinj (xO j) P end. Definition mkPX P i Q := match P with | Pc c => if c ?=! cO then mkPinj xH Q else PX P i Q | Pinj _ _ => PX P i Q | PX P' i' Q' => if Q' ?== P0 then PX P' (i' + i) Q else PX P i Q end. Definition mkXi i := PX P1 i P0. Definition mkX := mkXi 1. (** Opposite of addition *) Fixpoint Popp (P:Pol) : Pol := match P with | Pc c => Pc (-! c) | Pinj j Q => Pinj j (Popp Q) | PX P i Q => PX (Popp P) i (Popp Q) end. Notation "-- P" := (Popp P). (** Addition et subtraction *) Fixpoint PaddC (P:Pol) (c:C) : Pol := match P with | Pc c1 => Pc (c1 +! c) | Pinj j Q => Pinj j (PaddC Q c) | PX P i Q => PX P i (PaddC Q c) end. Fixpoint PsubC (P:Pol) (c:C) : Pol := match P with | Pc c1 => Pc (c1 -! c) | Pinj j Q => Pinj j (PsubC Q c) | PX P i Q => PX P i (PsubC Q c) end. Section PopI. Variable Pop : Pol -> Pol -> Pol. Variable Q : Pol. Fixpoint PaddI (j:positive) (P:Pol) : Pol := match P with | Pc c => mkPinj j (PaddC Q c) | Pinj j' Q' => match Z.pos_sub j' j with | Zpos k => mkPinj j (Pop (Pinj k Q') Q) | Z0 => mkPinj j (Pop Q' Q) | Zneg k => mkPinj j' (PaddI k Q') end | PX P i Q' => match j with | xH => PX P i (Pop Q' Q) | xO j => PX P i (PaddI (Pos.pred_double j) Q') | xI j => PX P i (PaddI (xO j) Q') end end. Fixpoint PsubI (j:positive) (P:Pol) : Pol := match P with | Pc c => mkPinj j (PaddC (--Q) c) | Pinj j' Q' => match Z.pos_sub j' j with | Zpos k => mkPinj j (Pop (Pinj k Q') Q) | Z0 => mkPinj j (Pop Q' Q) | Zneg k => mkPinj j' (PsubI k Q') end | PX P i Q' => match j with | xH => PX P i (Pop Q' Q) | xO j => PX P i (PsubI (Pos.pred_double j) Q') | xI j => PX P i (PsubI (xO j) Q') end end. Variable P' : Pol. Fixpoint PaddX (i':positive) (P:Pol) : Pol := match P with | Pc c => PX P' i' P | Pinj j Q' => match j with | xH => PX P' i' Q' | xO j => PX P' i' (Pinj (Pos.pred_double j) Q') | xI j => PX P' i' (Pinj (xO j) Q') end | PX P i Q' => match Z.pos_sub i i' with | Zpos k => mkPX (Pop (PX P k P0) P') i' Q' | Z0 => mkPX (Pop P P') i Q' | Zneg k => mkPX (PaddX k P) i Q' end end. Fixpoint PsubX (i':positive) (P:Pol) : Pol := match P with | Pc c => PX (--P') i' P | Pinj j Q' => match j with | xH => PX (--P') i' Q' | xO j => PX (--P') i' (Pinj (Pos.pred_double j) Q') | xI j => PX (--P') i' (Pinj (xO j) Q') end | PX P i Q' => match Z.pos_sub i i' with | Zpos k => mkPX (Pop (PX P k P0) P') i' Q' | Z0 => mkPX (Pop P P') i Q' | Zneg k => mkPX (PsubX k P) i Q' end end. End PopI. Fixpoint Padd (P P': Pol) {struct P'} : Pol := match P' with | Pc c' => PaddC P c' | Pinj j' Q' => PaddI Padd Q' j' P | PX P' i' Q' => match P with | Pc c => PX P' i' (PaddC Q' c) | Pinj j Q => match j with | xH => PX P' i' (Padd Q Q') | xO j => PX P' i' (Padd (Pinj (Pos.pred_double j) Q) Q') | xI j => PX P' i' (Padd (Pinj (xO j) Q) Q') end | PX P i Q => match Z.pos_sub i i' with | Zpos k => mkPX (Padd (PX P k P0) P') i' (Padd Q Q') | Z0 => mkPX (Padd P P') i (Padd Q Q') | Zneg k => mkPX (PaddX Padd P' k P) i (Padd Q Q') end end end. Infix "++" := Padd. Fixpoint Psub (P P': Pol) {struct P'} : Pol := match P' with | Pc c' => PsubC P c' | Pinj j' Q' => PsubI Psub Q' j' P | PX P' i' Q' => match P with | Pc c => PX (--P') i' (*(--(PsubC Q' c))*) (PaddC (--Q') c) | Pinj j Q => match j with | xH => PX (--P') i' (Psub Q Q') | xO j => PX (--P') i' (Psub (Pinj (Pos.pred_double j) Q) Q') | xI j => PX (--P') i' (Psub (Pinj (xO j) Q) Q') end | PX P i Q => match Z.pos_sub i i' with | Zpos k => mkPX (Psub (PX P k P0) P') i' (Psub Q Q') | Z0 => mkPX (Psub P P') i (Psub Q Q') | Zneg k => mkPX (PsubX Psub P' k P) i (Psub Q Q') end end end. Infix "--" := Psub. (** Multiplication *) Fixpoint PmulC_aux (P:Pol) (c:C) : Pol := match P with | Pc c' => Pc (c' *! c) | Pinj j Q => mkPinj j (PmulC_aux Q c) | PX P i Q => mkPX (PmulC_aux P c) i (PmulC_aux Q c) end. Definition PmulC P c := if c ?=! cO then P0 else if c ?=! cI then P else PmulC_aux P c. Section PmulI. Variable Pmul : Pol -> Pol -> Pol. Variable Q : Pol. Fixpoint PmulI (j:positive) (P:Pol) : Pol := match P with | Pc c => mkPinj j (PmulC Q c) | Pinj j' Q' => match Z.pos_sub j' j with | Zpos k => mkPinj j (Pmul (Pinj k Q') Q) | Z0 => mkPinj j (Pmul Q' Q) | Zneg k => mkPinj j' (PmulI k Q') end | PX P' i' Q' => match j with | xH => mkPX (PmulI xH P') i' (Pmul Q' Q) | xO j' => mkPX (PmulI j P') i' (PmulI (Pos.pred_double j') Q') | xI j' => mkPX (PmulI j P') i' (PmulI (xO j') Q') end end. End PmulI. Fixpoint Pmul (P P'' : Pol) {struct P''} : Pol := match P'' with | Pc c => PmulC P c | Pinj j' Q' => PmulI Pmul Q' j' P | PX P' i' Q' => match P with | Pc c => PmulC P'' c | Pinj j Q => let QQ' := match j with | xH => Pmul Q Q' | xO j => Pmul (Pinj (Pos.pred_double j) Q) Q' | xI j => Pmul (Pinj (xO j) Q) Q' end in mkPX (Pmul P P') i' QQ' | PX P i Q=> let QQ' := Pmul Q Q' in let PQ' := PmulI Pmul Q' xH P in let QP' := Pmul (mkPinj xH Q) P' in let PP' := Pmul P P' in (mkPX (mkPX PP' i P0 ++ QP') i' P0) ++ mkPX PQ' i QQ' end end. Infix "**" := Pmul. (** Monomial **) (** A monomial is X1^k1...Xi^ki. Its representation is a simplified version of the polynomial representation: - [mon0] correspond to the polynom [P1]. - [(zmon j M)] corresponds to [(Pinj j ...)], i.e. skip j variable indices. - [(vmon i M)] is X^i*M with X the current variable, its corresponds to (PX P1 i ...)] *) Inductive Mon: Set := | mon0: Mon | zmon: positive -> Mon -> Mon | vmon: positive -> Mon -> Mon. Definition mkZmon j M := match M with mon0 => mon0 | _ => zmon j M end. Definition zmon_pred j M := match j with xH => M | _ => mkZmon (Pos.pred j) M end. Definition mkVmon i M := match M with | mon0 => vmon i mon0 | zmon j m => vmon i (zmon_pred j m) | vmon i' m => vmon (i+i') m end. Fixpoint CFactor (P: Pol) (c: C) {struct P}: Pol * Pol := match P with | Pc c1 => let (q,r) := cdiv c1 c in (Pc r, Pc q) | Pinj j1 P1 => let (R,S) := CFactor P1 c in (mkPinj j1 R, mkPinj j1 S) | PX P1 i Q1 => let (R1, S1) := CFactor P1 c in let (R2, S2) := CFactor Q1 c in (mkPX R1 i R2, mkPX S1 i S2) end. Fixpoint MFactor (P: Pol) (c: C) (M: Mon) {struct P}: Pol * Pol := match P, M with _, mon0 => if (ceqb c cI) then (Pc cO, P) else CFactor P c | Pc _, _ => (P, Pc cO) | Pinj j1 P1, zmon j2 M1 => match j1 ?= j2 with Eq => let (R,S) := MFactor P1 c M1 in (mkPinj j1 R, mkPinj j1 S) | Lt => let (R,S) := MFactor P1 c (zmon (j2 - j1) M1) in (mkPinj j1 R, mkPinj j1 S) | Gt => (P, Pc cO) end | Pinj _ _, vmon _ _ => (P, Pc cO) | PX P1 i Q1, zmon j M1 => let M2 := zmon_pred j M1 in let (R1, S1) := MFactor P1 c M in let (R2, S2) := MFactor Q1 c M2 in (mkPX R1 i R2, mkPX S1 i S2) | PX P1 i Q1, vmon j M1 => match i ?= j with Eq => let (R1,S1) := MFactor P1 c (mkZmon xH M1) in (mkPX R1 i Q1, S1) | Lt => let (R1,S1) := MFactor P1 c (vmon (j - i) M1) in (mkPX R1 i Q1, S1) | Gt => let (R1,S1) := MFactor P1 c (mkZmon xH M1) in (mkPX R1 i Q1, mkPX S1 (i-j) (Pc cO)) end end. Definition POneSubst (P1: Pol) (cM1: C * Mon) (P2: Pol): option Pol := let (c,M1) := cM1 in let (Q1,R1) := MFactor P1 c M1 in match R1 with (Pc c) => if c ?=! cO then None else Some (Padd Q1 (Pmul P2 R1)) | _ => Some (Padd Q1 (Pmul P2 R1)) end. Fixpoint PNSubst1 (P1: Pol) (cM1: C * Mon) (P2: Pol) (n: nat) : Pol := match POneSubst P1 cM1 P2 with Some P3 => match n with S n1 => PNSubst1 P3 cM1 P2 n1 | _ => P3 end | _ => P1 end. Definition PNSubst (P1: Pol) (cM1: C * Mon) (P2: Pol) (n: nat): option Pol := match POneSubst P1 cM1 P2 with Some P3 => match n with S n1 => Some (PNSubst1 P3 cM1 P2 n1) | _ => None end | _ => None end. Fixpoint PSubstL1 (P1: Pol) (LM1: list ((C * Mon) * Pol)) (n: nat) : Pol := match LM1 with cons (M1,P2) LM2 => PSubstL1 (PNSubst1 P1 M1 P2 n) LM2 n | _ => P1 end. Fixpoint PSubstL (P1: Pol) (LM1: list ((C * Mon) * Pol)) (n: nat) : option Pol := match LM1 with cons (M1,P2) LM2 => match PNSubst P1 M1 P2 n with Some P3 => Some (PSubstL1 P3 LM2 n) | None => PSubstL P1 LM2 n end | _ => None end. Fixpoint PNSubstL (P1: Pol) (LM1: list ((C * Mon) * Pol)) (m n: nat) : Pol := match PSubstL P1 LM1 n with Some P3 => match m with S m1 => PNSubstL P3 LM1 m1 n | _ => P3 end | _ => P1 end. (** Evaluation of a polynomial towards R *) Local Notation hd := (List.hd 0). Fixpoint Pphi(l:list R) (P:Pol) : R := match P with | Pc c => [c] | Pinj j Q => Pphi (jump j l) Q | PX P i Q => Pphi l P * (hd l) ^ i + Pphi (tail l) Q end. Reserved Notation "P @ l " (at level 10, no associativity). Notation "P @ l " := (Pphi l P). Definition Pequiv (P Q : Pol) := forall l, P@l == Q@l. Infix "===" := Pequiv (at level 70, no associativity). Instance Pequiv_eq : Equivalence Pequiv. Proof. unfold Pequiv; split; red; intros; [reflexivity|now symmetry|now etransitivity]. Qed. Instance Pphi_ext : Proper (eq ==> Pequiv ==> req) Pphi. Proof. now intros l l' <- P Q H. Qed. Instance Pinj_ext : Proper (eq ==> Pequiv ==> Pequiv) Pinj. Proof. intros i j <- P P' HP l. simpl. now rewrite HP. Qed. Instance PX_ext : Proper (Pequiv ==> eq ==> Pequiv ==> Pequiv) PX. Proof. intros P P' HP p p' <- Q Q' HQ l. simpl. now rewrite HP, HQ. Qed. (** Evaluation of a monomial towards R *) Fixpoint Mphi(l:list R) (M: Mon) : R := match M with | mon0 => rI | zmon j M1 => Mphi (jump j l) M1 | vmon i M1 => Mphi (tail l) M1 * (hd l) ^ i end. Notation "M @@ l" := (Mphi l M) (at level 10, no associativity). (** Proofs *) Ltac destr_pos_sub := match goal with |- context [Z.pos_sub ?x ?y] => generalize (Z.pos_sub_discr x y); destruct (Z.pos_sub x y) end. Lemma jump_add' i j (l:list R) : jump (i + j) l = jump j (jump i l). Proof. rewrite Pos.add_comm. apply jump_add. Qed. Lemma Peq_ok P P' : (P ?== P') = true -> P === P'. Proof. unfold Pequiv. revert P';induction P as [|p P IHP|P2 IHP1 p P3 IHP2]; intros P';destruct P' as [|p0 P'|P'1 p0 P'2];simpl; intros H l; try easy. - now apply (morph_eq CRmorph). - destruct (Pos.compare_spec p p0); [ subst | easy | easy ]. now rewrite IHP. - specialize (IHP1 P'1); specialize (IHP2 P'2). destruct (Pos.compare_spec p p0); [ subst | easy | easy ]. destruct (P2 ?== P'1); [|easy]. rewrite H in *. now rewrite IHP1, IHP2. Qed. Lemma Peq_spec P P' : BoolSpec (P === P') True (P ?== P'). Proof. generalize (Peq_ok P P'). destruct (P ?== P'); auto. Qed. Lemma Pphi0 l : P0@l == 0. Proof. simpl;apply (morph0 CRmorph). Qed. Lemma Pphi1 l : P1@l == 1. Proof. simpl;apply (morph1 CRmorph). Qed. Lemma mkPinj_ok j l P : (mkPinj j P)@l == P@(jump j l). Proof. destruct P;simpl;rsimpl. now rewrite jump_add'. Qed. Instance mkPinj_ext : Proper (eq ==> Pequiv ==> Pequiv) mkPinj. Proof. intros i j <- P Q H l. now rewrite !mkPinj_ok. Qed. Lemma pow_pos_add x i j : x^(j + i) == x^i * x^j. Proof. rewrite Pos.add_comm. apply (pow_pos_add Rsth (Rmul_ext Reqe) (ARmul_assoc ARth)). Qed. Lemma ceqb_spec c c' : BoolSpec ([c] == [c']) True (c ?=! c'). Proof. generalize (morph_eq CRmorph c c'). destruct (c ?=! c'); auto. Qed. Lemma mkPX_ok l P i Q : (mkPX P i Q)@l == P@l * (hd l)^i + Q@(tail l). Proof. unfold mkPX. destruct P. - case ceqb_spec; intros H; simpl; try reflexivity. rewrite H, (morph0 CRmorph), mkPinj_ok; rsimpl. - reflexivity. - case Peq_spec; intros H; simpl; try reflexivity. rewrite H, Pphi0, Pos.add_comm, pow_pos_add; rsimpl. Qed. Instance mkPX_ext : Proper (Pequiv ==> eq ==> Pequiv ==> Pequiv) mkPX. Proof. intros P P' HP i i' <- Q Q' HQ l. now rewrite !mkPX_ok, HP, HQ. Qed. Hint Rewrite Pphi0 Pphi1 mkPinj_ok mkPX_ok (morph0 CRmorph) (morph1 CRmorph) (morph0 CRmorph) (morph_add CRmorph) (morph_mul CRmorph) (morph_sub CRmorph) (morph_opp CRmorph) : Esimpl. (* Quicker than autorewrite with Esimpl :-) *) Ltac Esimpl := try rewrite_db Esimpl; rsimpl; simpl. Lemma PaddC_ok c P l : (PaddC P c)@l == P@l + [c]. Proof. revert l;induction P as [| |P2 IHP1 p P3 IHP2];simpl;intros;Esimpl;trivial. rewrite IHP2;rsimpl. Qed. Lemma PsubC_ok c P l : (PsubC P c)@l == P@l - [c]. Proof. revert l;induction P as [|p P IHP|P2 IHP1 p P3 IHP2];simpl;intros. - Esimpl. - rewrite IHP;rsimpl. - rewrite IHP2;rsimpl. Qed. Lemma PmulC_aux_ok c P l : (PmulC_aux P c)@l == P@l * [c]. Proof. revert l;induction P as [| |P2 IHP1 p P3 IHP2];simpl;intros;Esimpl;trivial. rewrite IHP1, IHP2;rsimpl. add_permut. mul_permut. Qed. Lemma PmulC_ok c P l : (PmulC P c)@l == P@l * [c]. Proof. unfold PmulC. case ceqb_spec; intros H. - rewrite H; Esimpl. - case ceqb_spec; intros H'. + rewrite H'; Esimpl. + apply PmulC_aux_ok. Qed. Lemma Popp_ok P l : (--P)@l == - P@l. Proof. revert l;induction P as [|p P IHP|P2 IHP1 p P3 IHP2];simpl;intros. - Esimpl. - apply IHP. - rewrite IHP1, IHP2;rsimpl. Qed. Hint Rewrite PaddC_ok PsubC_ok PmulC_ok Popp_ok : Esimpl. Lemma PaddX_ok P' P k l : (forall P l, (P++P')@l == P@l + P'@l) -> (PaddX Padd P' k P) @ l == P@l + P'@l * (hd l)^k. Proof. intros IHP'. revert k l. induction P as [|p P IHP|P2 IHP1 p P3 IHP2];simpl;intros. - add_permut. - destruct p; simpl; rewrite ?jump_pred_double; add_permut. - destr_pos_sub; intros ->; Esimpl. + rewrite IHP';rsimpl. add_permut. + rewrite IHP', pow_pos_add;simpl;Esimpl. add_permut. + rewrite IHP1, pow_pos_add;rsimpl. add_permut. Qed. Lemma Padd_ok P' P l : (P ++ P')@l == P@l + P'@l. Proof. revert P l; induction P' as [|p P' IHP'|P'1 IHP'1 p P'2 IHP'2]; simpl;intros P l;Esimpl. - revert p l; induction P as [|p P IHP|P2 IHP1 p P3 IHP2];simpl;intros p0 l. + Esimpl; add_permut. + destr_pos_sub; intros ->;Esimpl. * now rewrite IHP'. * rewrite IHP';Esimpl. now rewrite jump_add'. * rewrite IHP. now rewrite jump_add'. + destruct p0;simpl. * rewrite IHP2;simpl. rsimpl. * rewrite IHP2;simpl. rewrite jump_pred_double. rsimpl. * rewrite IHP'. rsimpl. - destruct P as [|p0 ?|? ? ?];simpl. + Esimpl. add_permut. + destruct p0;simpl;Esimpl; rewrite IHP'2; simpl. * rsimpl. add_permut. * rewrite jump_pred_double. rsimpl. add_permut. * rsimpl. add_permut. + destr_pos_sub; intros ->; Esimpl. * rewrite IHP'1, IHP'2;rsimpl. add_permut. * rewrite IHP'1, IHP'2;simpl;Esimpl. rewrite pow_pos_add;rsimpl. add_permut. * rewrite PaddX_ok by trivial; rsimpl. rewrite IHP'2, pow_pos_add; rsimpl. add_permut. Qed. Lemma Psub_opp P' P : P -- P' === P ++ (--P'). Proof. revert P; induction P' as [|p P' IHP'|P'1 IHP'1 p P'2 IHP'2]; simpl; intros P. - intro l; Esimpl. - revert p; induction P; simpl; intros p0; try reflexivity. + destr_pos_sub; intros ->; now apply mkPinj_ext. + destruct p0; now apply PX_ext. - destruct P as [|p0 P|P2 p0 P3]; simpl; try reflexivity. + destruct p0; now apply PX_ext. + destr_pos_sub; intros ->; apply mkPX_ext; auto. let p1 := match goal with |- PsubX _ _ ?p1 _ === _ => p1 end in revert p1. induction P2; simpl; intros; try reflexivity. destr_pos_sub; intros ->; now apply mkPX_ext. Qed. Lemma Psub_ok P' P l : (P -- P')@l == P@l - P'@l. Proof. rewrite Psub_opp, Padd_ok, Popp_ok. rsimpl. Qed. Lemma PmulI_ok P' : (forall P l, (Pmul P P') @ l == P @ l * P' @ l) -> forall P p l, (PmulI Pmul P' p P) @ l == P @ l * P' @ (jump p l). Proof. intros IHP' P. induction P as [|p P IHP|? IHP1 ? ? IHP2];simpl;intros p0 l. - Esimpl; mul_permut. - destr_pos_sub; intros ->;Esimpl. + now rewrite IHP'. + now rewrite IHP', jump_add'. + now rewrite IHP, jump_add'. - destruct p0;Esimpl; rewrite ?IHP1, ?IHP2; rsimpl. + f_equiv. mul_permut. + rewrite jump_pred_double. f_equiv. mul_permut. + rewrite IHP'. f_equiv. mul_permut. Qed. Lemma Pmul_ok P P' l : (P**P')@l == P@l * P'@l. Proof. revert P l;induction P' as [| |? IHP'1 ? ? IHP'2];simpl;intros P l. - apply PmulC_ok. - apply PmulI_ok;trivial. - destruct P as [|p0|]. + rewrite (ARmul_comm ARth). Esimpl. + Esimpl. f_equiv. * rewrite IHP'1; Esimpl. * destruct p0;rewrite IHP'2;Esimpl. rewrite jump_pred_double; Esimpl. + rewrite Padd_ok, !mkPX_ok, Padd_ok, !mkPX_ok, !IHP'1, !IHP'2, PmulI_ok; trivial. simpl. Esimpl. add_permut; f_equiv; mul_permut. Qed. Lemma mkZmon_ok M j l : (mkZmon j M) @@ l == (zmon j M) @@ l. Proof. destruct M; simpl; rsimpl. Qed. Lemma zmon_pred_ok M j l : (zmon_pred j M) @@ (tail l) == (zmon j M) @@ l. Proof. destruct j; simpl; rewrite ?mkZmon_ok; simpl; rsimpl. rewrite jump_pred_double; rsimpl. Qed. Lemma mkVmon_ok M i l : (mkVmon i M)@@l == M@@l * (hd l)^i. Proof. destruct M;simpl;intros;rsimpl. - rewrite zmon_pred_ok;simpl;rsimpl. - rewrite pow_pos_add;rsimpl. Qed. Ltac destr_factor := match goal with | H : context [CFactor ?P _] |- context [CFactor ?P ?c] => destruct (CFactor P c); destr_factor; rewrite H; clear H | H : context [MFactor ?P _ _] |- context [MFactor ?P ?c ?M] => specialize (H M); destruct (MFactor P c M); destr_factor; rewrite H; clear H | _ => idtac end. Lemma Mcphi_ok P c l : let (Q,R) := CFactor P c in P@l == Q@l + [c] * R@l. Proof. revert l. induction P as [c0 | j P IH | P1 IH1 i P2 IH2]; intros l; Esimpl. - assert (H := (div_eucl_th div_th) c0 c). destruct cdiv as (q,r). rewrite H; Esimpl. add_permut. - destr_factor. Esimpl. - destr_factor. Esimpl. add_permut. Qed. Lemma Mphi_ok P (cM: C * Mon) l : let (c,M) := cM in let (Q,R) := MFactor P c M in P@l == Q@l + [c] * M@@l * R@l. Proof. destruct cM as (c,M). revert M l. induction P as [c0|p P ?|P2 ? ? P3 ?]; intros M; destruct M; intros l; simpl; auto; try (case ceqb_spec; intro He); try (case Pos.compare_spec; intros He); rewrite ?He; destr_factor; simpl; Esimpl. - assert (H := div_eucl_th div_th c0 c). destruct cdiv as (q,r). rewrite H; Esimpl. add_permut. - assert (H := Mcphi_ok P c). destr_factor. Esimpl. - now rewrite <- jump_add, Pos.sub_add. - assert (H2 := Mcphi_ok P2 c). assert (H3 := Mcphi_ok P3 c). destr_factor. Esimpl. add_permut. - rewrite zmon_pred_ok. simpl. add_permut. - rewrite mkZmon_ok. simpl. add_permut. mul_permut. - add_permut. mul_permut. rewrite <- pow_pos_add, Pos.add_comm, Pos.sub_add by trivial; rsimpl. - rewrite mkZmon_ok. simpl. Esimpl. add_permut. mul_permut. rewrite <- pow_pos_add, Pos.sub_add by trivial; rsimpl. Qed. Lemma POneSubst_ok P1 cM1 P2 P3 l : POneSubst P1 cM1 P2 = Some P3 -> [fst cM1] * (snd cM1)@@l == P2@l -> P1@l == P3@l. Proof. destruct cM1 as (cc,M1). unfold POneSubst. assert (H := Mphi_ok P1 (cc, M1) l). simpl in H. destruct MFactor as (R1,S1); simpl. rewrite H. clear H. intros EQ EQ'. replace P3 with (R1 ++ P2 ** S1). - rewrite EQ', Padd_ok, Pmul_ok; rsimpl. - revert EQ. destruct S1; try now injection 1. case ceqb_spec; now inversion 2. Qed. Lemma PNSubst1_ok n P1 cM1 P2 l : [fst cM1] * (snd cM1)@@l == P2@l -> P1@l == (PNSubst1 P1 cM1 P2 n)@l. Proof. revert P1. induction n as [|n IHn]; simpl; intros P1; generalize (POneSubst_ok P1 cM1 P2); destruct POneSubst; intros; rewrite <- ?IHn; auto; reflexivity. Qed. Lemma PNSubst_ok n P1 cM1 P2 l P3 : PNSubst P1 cM1 P2 n = Some P3 -> [fst cM1] * (snd cM1)@@l == P2@l -> P1@l == P3@l. Proof. unfold PNSubst. assert (H := POneSubst_ok P1 cM1 P2); destruct POneSubst; try discriminate. destruct n; inversion_clear 1. intros. rewrite <- PNSubst1_ok; auto. Qed. Fixpoint MPcond (LM1: list (C * Mon * Pol)) (l: list R) : Prop := match LM1 with | (M1,P2) :: LM2 => ([fst M1] * (snd M1)@@l == P2@l) /\ MPcond LM2 l | _ => True end. Lemma PSubstL1_ok n LM1 P1 l : MPcond LM1 l -> P1@l == (PSubstL1 P1 LM1 n)@l. Proof. revert P1; induction LM1 as [|(M2,P2) LM2 IH]; simpl; intros. - reflexivity. - rewrite <- IH by intuition; now apply PNSubst1_ok. Qed. Lemma PSubstL_ok n LM1 P1 P2 l : PSubstL P1 LM1 n = Some P2 -> MPcond LM1 l -> P1@l == P2@l. Proof. revert P1. induction LM1 as [|(M2,P2') LM2 IH]; simpl; intros P3 H **. - discriminate. - assert (H':=PNSubst_ok n P3 M2 P2'). destruct PNSubst. * injection H as [= <-]. rewrite <- PSubstL1_ok; intuition. * now apply IH. Qed. Lemma PNSubstL_ok m n LM1 P1 l : MPcond LM1 l -> P1@l == (PNSubstL P1 LM1 m n)@l. Proof. revert LM1 P1. induction m as [|m IHm]; simpl; intros LM1 P2 H; assert (H' := PSubstL_ok n LM1 P2); destruct PSubstL; auto; try reflexivity. rewrite <- IHm; auto. Qed. (** Definition of polynomial expressions *) Inductive PExpr : Type := | PEO : PExpr | PEI : PExpr | PEc : C -> PExpr | PEX : positive -> PExpr | PEadd : PExpr -> PExpr -> PExpr | PEsub : PExpr -> PExpr -> PExpr | PEmul : PExpr -> PExpr -> PExpr | PEopp : PExpr -> PExpr | PEpow : PExpr -> N -> PExpr. Register PExpr as plugins.ring.pexpr. Register PEc as plugins.ring.const. Register PEX as plugins.ring.var. Register PEadd as plugins.ring.add. Register PEsub as plugins.ring.sub. Register PEmul as plugins.ring.mul. Register PEopp as plugins.ring.opp. Register PEpow as plugins.ring.pow. (** evaluation of polynomial expressions towards R *) Definition mk_X j := mkPinj_pred j mkX. (** evaluation of polynomial expressions towards R *) Fixpoint PEeval (l:list R) (pe:PExpr) {struct pe} : R := match pe with | PEO => rO | PEI => rI | PEc c => phi c | PEX j => nth 0 j l | PEadd pe1 pe2 => (PEeval l pe1) + (PEeval l pe2) | PEsub pe1 pe2 => (PEeval l pe1) - (PEeval l pe2) | PEmul pe1 pe2 => (PEeval l pe1) * (PEeval l pe2) | PEopp pe1 => - (PEeval l pe1) | PEpow pe1 n => rpow (PEeval l pe1) (Cp_phi n) end. Strategy expand [PEeval]. (** Correctness proofs *) Lemma mkX_ok p l : nth 0 p l == (mk_X p) @ l. Proof. destruct p;simpl;intros;Esimpl;trivial. - now rewrite <-jump_tl, nth_jump. - now rewrite <- nth_jump, nth_pred_double. Qed. Hint Rewrite Padd_ok Psub_ok : Esimpl. Section POWER. Variable subst_l : Pol -> Pol. Fixpoint Ppow_pos (res P:Pol) (p:positive) : Pol := match p with | xH => subst_l (res ** P) | xO p => Ppow_pos (Ppow_pos res P p) P p | xI p => subst_l ((Ppow_pos (Ppow_pos res P p) P p) ** P) end. Definition Ppow_N P n := match n with | N0 => P1 | Npos p => Ppow_pos P1 P p end. Lemma Ppow_pos_ok l : (forall P, subst_l P@l == P@l) -> forall res P p, (Ppow_pos res P p)@l == res@l * (pow_pos Pmul P p)@l. Proof. intros subst_l_ok res P p. revert res. induction p as [p IHp|p IHp|];simpl;intros; rewrite ?subst_l_ok, ?Pmul_ok, ?IHp; mul_permut. Qed. Lemma Ppow_N_ok l : (forall P, subst_l P@l == P@l) -> forall P n, (Ppow_N P n)@l == (pow_N P1 Pmul P n)@l. Proof. intros ? P n; destruct n;simpl. - reflexivity. - rewrite Ppow_pos_ok by trivial. Esimpl. Qed. End POWER. (** Normalization and rewriting *) Section NORM_SUBST_REC. Variable n : nat. Variable lmp:list (C*Mon*Pol). Let subst_l P := PNSubstL P lmp n n. Let Pmul_subst P1 P2 := subst_l (P1 ** P2). Let Ppow_subst := Ppow_N subst_l. Fixpoint norm_aux (pe:PExpr) : Pol := match pe with | PEO => Pc cO | PEI => Pc cI | PEc c => Pc c | PEX j => mk_X j | PEadd (PEopp pe1) pe2 => (norm_aux pe2) -- (norm_aux pe1) | PEadd pe1 (PEopp pe2) => (norm_aux pe1) -- (norm_aux pe2) | PEadd pe1 pe2 => (norm_aux pe1) ++ (norm_aux pe2) | PEsub pe1 pe2 => (norm_aux pe1) -- (norm_aux pe2) | PEmul pe1 pe2 => (norm_aux pe1) ** (norm_aux pe2) | PEopp pe1 => -- (norm_aux pe1) | PEpow pe1 n => Ppow_N (fun p => p) (norm_aux pe1) n end. Definition norm_subst pe := subst_l (norm_aux pe). (** Internally, [norm_aux] is expanded in a large number of cases. To speed-up proofs, we use an alternative definition. *) Definition get_PEopp pe := match pe with | PEopp pe' => Some pe' | _ => None end. Lemma norm_aux_PEadd pe1 pe2 : norm_aux (PEadd pe1 pe2) = match get_PEopp pe1, get_PEopp pe2 with | Some pe1', _ => (norm_aux pe2) -- (norm_aux pe1') | None, Some pe2' => (norm_aux pe1) -- (norm_aux pe2') | None, None => (norm_aux pe1) ++ (norm_aux pe2) end. Proof. simpl (norm_aux (PEadd _ _)). destruct pe1; [ | | | | | | | reflexivity | ]; destruct pe2; simpl get_PEopp; reflexivity. Qed. Lemma norm_aux_PEopp pe : match get_PEopp pe with | Some pe' => norm_aux pe = -- (norm_aux pe') | None => True end. Proof. now destruct pe. Qed. Arguments norm_aux !pe : simpl nomatch. Lemma norm_aux_spec l pe : PEeval l pe == (norm_aux pe)@l. Proof. intros. induction pe as [| |c|p|pe1 IHpe1 pe2 IHpe2|? IHpe1 ? IHpe2|? IHpe1 ? IHpe2 |? IHpe|? IHpe n0]; cbn. - now rewrite (morph0 CRmorph). - now rewrite (morph1 CRmorph). - reflexivity. - apply mkX_ok. - rewrite IHpe1, IHpe2. assert (H1 := norm_aux_PEopp pe1). assert (H2 := norm_aux_PEopp pe2). rewrite norm_aux_PEadd. do 2 destruct get_PEopp; rewrite ?H1, ?H2; Esimpl; add_permut. - rewrite IHpe1, IHpe2. Esimpl. - rewrite IHpe1, IHpe2. now rewrite Pmul_ok. - rewrite IHpe. Esimpl. - rewrite Ppow_N_ok by reflexivity. rewrite (rpow_pow_N pow_th). destruct n0 as [|p]; simpl; Esimpl. induction p as [p IHp|p IHp|];simpl; now rewrite ?IHp, ?IHpe, ?Pms_ok, ?Pmul_ok. Qed. Lemma norm_subst_spec : forall l pe, MPcond lmp l -> PEeval l pe == (norm_subst pe)@l. Proof. intros;unfold norm_subst. unfold subst_l;rewrite <- PNSubstL_ok;trivial. apply norm_aux_spec. Qed. End NORM_SUBST_REC. Fixpoint interp_PElist (l:list R) (lpe:list (PExpr*PExpr)) {struct lpe} : Prop := match lpe with | nil => True | (me,pe)::lpe => match lpe with | nil => PEeval l me == PEeval l pe | _ => PEeval l me == PEeval l pe /\ interp_PElist l lpe end end. Fixpoint mon_of_pol (P:Pol) : option (C * Mon) := match P with | Pc c => if (c ?=! cO) then None else Some (c, mon0) | Pinj j P => match mon_of_pol P with | None => None | Some (c,m) => Some (c, mkZmon j m) end | PX P i Q => if Peq Q P0 then match mon_of_pol P with | None => None | Some (c,m) => Some (c, mkVmon i m) end else None end. Fixpoint mk_monpol_list (lpe:list (PExpr * PExpr)) : list (C*Mon*Pol) := match lpe with | nil => nil | (me,pe)::lpe => match mon_of_pol (norm_subst 0 nil me) with | None => mk_monpol_list lpe | Some m => (m,norm_subst 0 nil pe):: mk_monpol_list lpe end end. Lemma mon_of_pol_ok : forall P m, mon_of_pol P = Some m -> forall l, [fst m] * Mphi l (snd m) == P@l. Proof. intros P; induction P as [c|p P IHP|P2 IHP1 ? P3 ?];simpl;intros m H l;Esimpl. - assert (H1 := (morph_eq CRmorph) c cO). destruct (c ?=! cO). + discriminate. + inversion H;trivial;Esimpl. - generalize H;clear H;case_eq (mon_of_pol P). + intros (c1,P2) H0 H1; inversion H1; Esimpl. generalize (IHP (c1, P2) H0 (jump p l)). rewrite mkZmon_ok;simpl;auto. + intros; discriminate. - generalize H;clear H;change match P3 with | Pc c => c ?=! cO | Pinj _ _ => false | PX _ _ _ => false end with (P3 ?== P0). assert (H := Peq_ok P3 P0). destruct (P3 ?== P0). + case_eq (mon_of_pol P2);try intros (cc, pp); intros H0 H1. * inversion H1. simpl. rewrite mkVmon_ok;simpl. rewrite H;trivial;Esimpl. generalize (IHP1 _ H0); simpl; intros HH; rewrite HH; rsimpl. * discriminate. + intros;discriminate. Qed. Lemma interp_PElist_ok : forall l lpe, interp_PElist l lpe -> MPcond (mk_monpol_list lpe) l. Proof. intros l lpe; induction lpe as [|a lpe IHlpe];simpl. - trivial. - destruct a as [p p0];simpl;intros H. assert (HH:=mon_of_pol_ok (norm_subst 0 nil p)); destruct (mon_of_pol (norm_subst 0 nil p)). + split. * rewrite <- norm_subst_spec by exact I. destruct lpe;try destruct H as [H H0];rewrite <- H; rewrite (norm_subst_spec 0 nil); try exact I;apply HH;trivial. * apply IHlpe. destruct lpe;simpl;trivial. destruct H as [H H0]. exact H0. + apply IHlpe. destruct lpe;simpl;trivial. destruct H as [H H0]. exact H0. Qed. Lemma norm_subst_ok : forall n l lpe pe, interp_PElist l lpe -> PEeval l pe == (norm_subst n (mk_monpol_list lpe) pe)@l. Proof. intros;apply norm_subst_spec. apply interp_PElist_ok;trivial. Qed. Lemma ring_correct : forall n l lpe pe1 pe2, interp_PElist l lpe -> (let lmp := mk_monpol_list lpe in norm_subst n lmp pe1 ?== norm_subst n lmp pe2) = true -> PEeval l pe1 == PEeval l pe2. Proof. simpl;intros n l lpe pe1 pe2 **. do 2 (rewrite (norm_subst_ok n l lpe);trivial). apply Peq_ok;trivial. Qed. (** Generic evaluation of polynomial towards R avoiding parenthesis *) Variable get_sign : C -> option C. Variable get_sign_spec : sign_theory copp ceqb get_sign. Section EVALUATION. (* [mkpow x p] = x^p *) Variable mkpow : R -> positive -> R. (* [mkpow x p] = -(x^p) *) Variable mkopp_pow : R -> positive -> R. (* [mkmult_pow r x p] = r * x^p *) Variable mkmult_pow : R -> R -> positive -> R. Fixpoint mkmult_rec (r:R) (lm:list (R*positive)) {struct lm}: R := match lm with | nil => r | cons (x,p) t => mkmult_rec (mkmult_pow r x p) t end. Definition mkmult1 lm := match lm with | nil => 1 | cons (x,p) t => mkmult_rec (mkpow x p) t end. Definition mkmultm1 lm := match lm with | nil => ropp rI | cons (x,p) t => mkmult_rec (mkopp_pow x p) t end. Definition mkmult_c_pos c lm := if c ?=! cI then mkmult1 (rev' lm) else mkmult_rec [c] (rev' lm). Definition mkmult_c c lm := match get_sign c with | None => mkmult_c_pos c lm | Some c' => if c' ?=! cI then mkmultm1 (rev' lm) else mkmult_rec [c] (rev' lm) end. Definition mkadd_mult rP c lm := match get_sign c with | None => rP + mkmult_c_pos c lm | Some c' => rP - mkmult_c_pos c' lm end. Definition add_pow_list (r:R) n l := match n with | N0 => l | Npos p => (r,p)::l end. Fixpoint add_mult_dev (rP:R) (P:Pol) (fv:list R) (n:N) (lm:list (R*positive)) {struct P} : R := match P with | Pc c => let lm := add_pow_list (hd fv) n lm in mkadd_mult rP c lm | Pinj j Q => add_mult_dev rP Q (jump j fv) N0 (add_pow_list (hd fv) n lm) | PX P i Q => let rP := add_mult_dev rP P fv (N.add (Npos i) n) lm in if Q ?== P0 then rP else add_mult_dev rP Q (tail fv) N0 (add_pow_list (hd fv) n lm) end. Fixpoint mult_dev (P:Pol) (fv : list R) (n:N) (lm:list (R*positive)) {struct P} : R := (* P@l * (hd 0 l)^n * lm *) match P with | Pc c => mkmult_c c (add_pow_list (hd fv) n lm) | Pinj j Q => mult_dev Q (jump j fv) N0 (add_pow_list (hd fv) n lm) | PX P i Q => let rP := mult_dev P fv (N.add (Npos i) n) lm in if Q ?== P0 then rP else let lmq := add_pow_list (hd fv) n lm in add_mult_dev rP Q (tail fv) N0 lmq end. Definition Pphi_avoid fv P := mult_dev P fv N0 nil. Fixpoint r_list_pow (l:list (R*positive)) : R := match l with | nil => rI | cons (r,p) l => pow_pos rmul r p * r_list_pow l end. Hypothesis mkpow_spec : forall r p, mkpow r p == pow_pos rmul r p. Hypothesis mkopp_pow_spec : forall r p, mkopp_pow r p == - (pow_pos rmul r p). Hypothesis mkmult_pow_spec : forall r x p, mkmult_pow r x p == r * pow_pos rmul x p. Lemma mkmult_rec_ok : forall lm r, mkmult_rec r lm == r * r_list_pow lm. Proof. intros lm; induction lm as [|a lm IHlm];intros;simpl;Esimpl. destruct a as (x,p);Esimpl. rewrite IHlm. rewrite mkmult_pow_spec. Esimpl. Qed. Lemma mkmult1_ok : forall lm, mkmult1 lm == r_list_pow lm. Proof. intros lm; destruct lm as [|p lm];simpl;Esimpl. destruct p. rewrite mkmult_rec_ok;rewrite mkpow_spec;Esimpl. Qed. Lemma mkmultm1_ok : forall lm, mkmultm1 lm == - r_list_pow lm. Proof. intros lm; destruct lm as [|p lm];simpl;Esimpl. destruct p;rewrite mkmult_rec_ok. rewrite mkopp_pow_spec;Esimpl. Qed. Lemma r_list_pow_rev : forall l, r_list_pow (rev' l) == r_list_pow l. Proof. assert (forall l lr : list (R * positive), r_list_pow (rev_append l lr) == r_list_pow lr * r_list_pow l) as H. - intros l; induction l as [|a l IHl];intros;simpl;Esimpl. destruct a as [r p];rewrite IHl;Esimpl. rewrite (ARmul_comm ARth (pow_pos rmul r p)). reflexivity. - intros;unfold rev'. rewrite H;simpl;Esimpl. Qed. Lemma mkmult_c_pos_ok : forall c lm, mkmult_c_pos c lm == [c]* r_list_pow lm. Proof. intros c lm;unfold mkmult_c_pos;simpl. assert (H := (morph_eq CRmorph) c cI). rewrite <- r_list_pow_rev; destruct (c ?=! cI). - rewrite H;trivial;Esimpl. apply mkmult1_ok. - apply mkmult_rec_ok. Qed. Lemma mkmult_c_ok : forall c lm, mkmult_c c lm == [c] * r_list_pow lm. Proof. intros c lm;unfold mkmult_c;simpl. case_eq (get_sign c);intros c0; try intros H. - assert (H1 := (morph_eq CRmorph) c0 cI). destruct (c0 ?=! cI). + rewrite (morph_eq CRmorph _ _ (sign_spec get_sign_spec _ H)). Esimpl. rewrite H1;trivial. rewrite <- r_list_pow_rev;trivial;Esimpl. apply mkmultm1_ok. + rewrite <- r_list_pow_rev; apply mkmult_rec_ok. - apply mkmult_c_pos_ok. Qed. Lemma mkadd_mult_ok : forall rP c lm, mkadd_mult rP c lm == rP + [c]*r_list_pow lm. Proof. intros rP c lm;unfold mkadd_mult. case_eq (get_sign c);intros c0; try intros H. - rewrite (morph_eq CRmorph _ _ (sign_spec get_sign_spec _ H));Esimpl. rewrite mkmult_c_pos_ok;Esimpl. - rewrite mkmult_c_pos_ok;Esimpl. Qed. Lemma add_pow_list_ok : forall r n l, r_list_pow (add_pow_list r n l) == pow_N rI rmul r n * r_list_pow l. Proof. intros r n; destruct n;simpl;intros;Esimpl. Qed. Lemma add_mult_dev_ok : forall P rP fv n lm, add_mult_dev rP P fv n lm == rP + P@fv*pow_N rI rmul (hd fv) n * r_list_pow lm. Proof. intros P; induction P as [|p P IHP|P2 IHP1 p P3 IHP2];simpl;intros rP fv n lm. - rewrite mkadd_mult_ok. rewrite add_pow_list_ok; Esimpl. - rewrite IHP. simpl. rewrite add_pow_list_ok; Esimpl. - change (match P3 with | Pc c => c ?=! cO | Pinj _ _ => false | PX _ _ _ => false end) with (Peq P3 P0). change match n with | N0 => Npos p | Npos q => Npos (p + q) end with (N.add (Npos p) n);trivial. assert (H := Peq_ok P3 P0). destruct (P3 ?== P0). + rewrite (H eq_refl). rewrite IHP1. destruct n;simpl;Esimpl;rewrite pow_pos_add;Esimpl. add_permut. mul_permut. + rewrite IHP2. rewrite IHP1. destruct n;simpl;Esimpl;rewrite pow_pos_add;Esimpl. add_permut. mul_permut. Qed. Lemma mult_dev_ok : forall P fv n lm, mult_dev P fv n lm == P@fv * pow_N rI rmul (hd fv) n * r_list_pow lm. Proof. intros P; induction P as [|p P IHP|P2 IHP1 p P3 IHP2];simpl;intros fv n lm;Esimpl. - rewrite mkmult_c_ok;rewrite add_pow_list_ok;Esimpl. - rewrite IHP. simpl;rewrite add_pow_list_ok;Esimpl. - change (match P3 with | Pc c => c ?=! cO | Pinj _ _ => false | PX _ _ _ => false end) with (Peq P3 P0). change match n with | N0 => Npos p | Npos q => Npos (p + q) end with (N.add (Npos p) n);trivial. assert (H := Peq_ok P3 P0). destruct (P3 ?== P0). + rewrite (H eq_refl). rewrite IHP1. destruct n;simpl;Esimpl;rewrite pow_pos_add;Esimpl. mul_permut. + rewrite add_mult_dev_ok. rewrite IHP1; rewrite add_pow_list_ok. destruct n;simpl;Esimpl;rewrite pow_pos_add;Esimpl. add_permut; mul_permut. Qed. Lemma Pphi_avoid_ok : forall P fv, Pphi_avoid fv P == P@fv. Proof. unfold Pphi_avoid;intros;rewrite mult_dev_ok;simpl;Esimpl. Qed. End EVALUATION. Definition Pphi_pow := let mkpow x p := match p with xH => x | _ => rpow x (Cp_phi (Npos p)) end in let mkopp_pow x p := ropp (mkpow x p) in let mkmult_pow r x p := rmul r (mkpow x p) in Pphi_avoid mkpow mkopp_pow mkmult_pow. Lemma local_mkpow_ok r p : match p with | xI _ => rpow r (Cp_phi (Npos p)) | xO _ => rpow r (Cp_phi (Npos p)) | 1 => r end == pow_pos rmul r p. Proof. destruct p; now rewrite ?(rpow_pow_N pow_th). Qed. Lemma Pphi_pow_ok : forall P fv, Pphi_pow fv P == P@fv. Proof. unfold Pphi_pow;intros;apply Pphi_avoid_ok;intros; now rewrite ?local_mkpow_ok. Qed. Lemma ring_rw_pow_correct : forall n lH l, interp_PElist l lH -> forall lmp, mk_monpol_list lH = lmp -> forall pe npe, norm_subst n lmp pe = npe -> PEeval l pe == Pphi_pow l npe. Proof. intros n lH l H1 lmp Heq1 pe npe Heq2. rewrite Pphi_pow_ok, <- Heq2, <- Heq1. apply norm_subst_ok. trivial. Qed. Fixpoint mkmult_pow (r x:R) (p: positive) {struct p} : R := match p with | xH => r*x | xO p => mkmult_pow (mkmult_pow r x p) x p | xI p => mkmult_pow (mkmult_pow (r*x) x p) x p end. Definition mkpow x p := match p with | xH => x | xO p => mkmult_pow x x (Pos.pred_double p) | xI p => mkmult_pow x x (xO p) end. Definition mkopp_pow x p := match p with | xH => -x | xO p => mkmult_pow (-x) x (Pos.pred_double p) | xI p => mkmult_pow (-x) x (xO p) end. Definition Pphi_dev := Pphi_avoid mkpow mkopp_pow mkmult_pow. Lemma mkmult_pow_ok p r x : mkmult_pow r x p == r * x^p. Proof. revert r; induction p as [p IHp|p IHp|];intros;simpl;Esimpl;rewrite !IHp;Esimpl. Qed. Lemma mkpow_ok p x : mkpow x p == x^p. Proof. destruct p;simpl;intros;Esimpl. - rewrite !mkmult_pow_ok;Esimpl. - rewrite mkmult_pow_ok;Esimpl. change x with (x^1) at 1. now rewrite <- pow_pos_add, Pos.add_1_r, Pos.succ_pred_double. Qed. Lemma mkopp_pow_ok p x : mkopp_pow x p == - x^p. Proof. destruct p;simpl;intros;Esimpl. - rewrite !mkmult_pow_ok;Esimpl. - rewrite mkmult_pow_ok;Esimpl. change x with (x^1) at 1. now rewrite <- pow_pos_add, Pos.add_1_r, Pos.succ_pred_double. Qed. Lemma Pphi_dev_ok : forall P fv, Pphi_dev fv P == P@fv. Proof. unfold Pphi_dev;intros;apply Pphi_avoid_ok. - intros;apply mkpow_ok. - intros;apply mkopp_pow_ok. - intros;apply mkmult_pow_ok. Qed. Lemma ring_rw_correct : forall n lH l, interp_PElist l lH -> forall lmp, mk_monpol_list lH = lmp -> forall pe npe, norm_subst n lmp pe = npe -> PEeval l pe == Pphi_dev l npe. Proof. intros n lH l H1 lmp Heq1 pe npe Heq2. rewrite Pphi_dev_ok. rewrite <- Heq2;rewrite <- Heq1. apply norm_subst_ok. trivial. Qed. End MakeRingPol. Arguments PEO {C}. Arguments PEI {C}. coq-8.20.0/theories/setoid_ring/Ring_tac.v000066400000000000000000000365551466560755400204700ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* _ => R | _ => fail 1000 "Equality has no relation type" end. Ltac Get_goal := match goal with [|- ?G] => G end. (********************************************************************) (* Tacticals to build reflexive tactics *) Ltac OnEquation req := match goal with | |- req ?lhs ?rhs => (fun f => f lhs rhs) | _ => (fun _ => fail "Goal is not an equation (of expected equality)" req) end. Ltac OnEquationHyp req h := match type of h with | req ?lhs ?rhs => fun f => f lhs rhs | _ => (fun _ => fail "Hypothesis is not an equation (of expected equality)") end. (* Note: auxiliary subgoals in reverse order *) Ltac OnMainSubgoal H ty := match ty with | _ -> ?ty' => let subtac := OnMainSubgoal H ty' in fun kont => lapply H; [clear H; intro H; subtac kont | idtac] | _ => (fun kont => kont()) end. (* A generic pattern to have reflexive tactics do some computation: lemmas of the form [forall x', x=x' -> P(x')] are understood as: compute the normal form of x, instantiate x' with it, prove hypothesis x=x' with vm_compute and reflexivity, and pass the instantiated lemma to the continuation. *) Ltac ProveLemmaHyp lemma := match type of lemma with forall x', ?x = x' -> _ => (fun kont => let x' := fresh "res" in let H := fresh "res_eq" in compute_assertion H x' x; let lemma' := constr:(lemma x' H) in kont lemma'; (clear H||idtac"ProveLemmaHyp: cleanup failed"); subst x') | _ => (fun _ => fail "ProveLemmaHyp: lemma not of the expected form") end. Ltac ProveLemmaHyps lemma := match type of lemma with forall x', ?x = x' -> _ => (fun kont => let x' := fresh "res" in let H := fresh "res_eq" in compute_assertion H x' x; let lemma' := constr:(lemma x' H) in ProveLemmaHyps lemma' kont; (clear H||idtac"ProveLemmaHyps: cleanup failed"); subst x') | _ => (fun kont => kont lemma) end. (* Ltac ProveLemmaHyps lemma := (* expects a continuation *) let try_step := ProveLemmaHyp lemma in (fun kont => try_step ltac:(fun lemma' => ProveLemmaHyps lemma' kont) || kont lemma). *) Ltac ApplyLemmaThen lemma expr kont := let lem := constr:(lemma expr) in ProveLemmaHyp lem ltac:(fun lem' => let Heq := fresh "thm" in assert (Heq:=lem'); OnMainSubgoal Heq ltac:(type of Heq) ltac:(fun _ => kont Heq); (clear Heq||idtac"ApplyLemmaThen: cleanup failed")). (* Ltac ApplyLemmaThenAndCont lemma expr tac CONT_tac cont_arg := let pe := match type of (lemma expr) with forall pe', ?pe = pe' -> _ => pe | _ => fail 1 "ApplyLemmaThenAndCont: cannot find norm expression" end in let pe' := fresh "expr_nf" in let nf_pe := fresh "pe_eq" in compute_assertion nf_pe pe' pe; let Heq := fresh "thm" in (assert (Heq:=lemma pe pe' H) || fail "anomaly: failed to apply lemma"); clear nf_pe; OnMainSubgoal Heq ltac:(type of Heq) ltac:(try tac Heq; clear Heq pe';CONT_tac cont_arg)). *) Ltac ApplyLemmaThenAndCont lemma expr tac CONT_tac := ApplyLemmaThen lemma expr ltac:(fun lemma' => try tac lemma'; CONT_tac()). (* General scheme of reflexive tactics using of correctness lemma that involves normalisation of one expression - [FV_tac term fv] is a tactic that adds the atomic expressions of [term] into [fv] - [SYN_tac term fv] reifies [term] given the list of atomic expressions - [LEMMA_tac fv kont] computes the correctness lemma and passes it to continuation kont - [MAIN_tac H] process H which is the conclusion of the correctness lemma instantiated with each reified term - [fv] is the initial value of atomic expressions (to be completed by the reification of the terms - [terms] the list (a constr of type list) of terms to reify and process. *) Ltac ReflexiveRewriteTactic FV_tac SYN_tac LEMMA_tac MAIN_tac fv terms := (* extend the atom list *) let fv := list_fold_left FV_tac fv terms in let RW_tac lemma := let fcons term CONT_tac := let expr := SYN_tac term fv in let main H := match type of H with | (?req _ ?rhs) => change (req term rhs) in H end; MAIN_tac H in (ApplyLemmaThenAndCont lemma expr main CONT_tac) in (* rewrite steps *) lazy_list_fold_right fcons ltac:(fun _=>idtac) terms in LEMMA_tac fv RW_tac. (********************************************************) Ltac FV_hypo_tac mkFV req lH := let R := relation_carrier req in let FV_hypo_l_tac h := match h with @mkhypo (req ?pe _) _ => mkFV pe end in let FV_hypo_r_tac h := match h with @mkhypo (req _ ?pe) _ => mkFV pe end in let fv := list_fold_right FV_hypo_l_tac (@nil R) lH in list_fold_right FV_hypo_r_tac fv lH. Ltac mkHyp_tac C req Reify lH := let mkHyp h res := match h with | @mkhypo (req ?r1 ?r2) _ => let pe1 := Reify r1 in let pe2 := Reify r2 in constr:(cons (pe1,pe2) res) | _ => fail 1 "hypothesis is not a ring equality" end in list_fold_right mkHyp (@nil (PExpr C * PExpr C)) lH. Ltac proofHyp_tac lH := let get_proof h := match h with | @mkhypo _ ?p => p end in let rec bh l := match l with | nil => constr:(I) | cons ?h nil => get_proof h | cons ?h ?tl => let l := get_proof h in let r := bh tl in constr:(conj l r) end in bh lH. Ltac get_MonPol lemma := match type of lemma with | context [(mk_monpol_list ?cO ?cI ?cadd ?cmul ?csub ?copp ?cdiv ?ceqb _)] => constr:(mk_monpol_list cO cI cadd cmul csub copp cdiv ceqb) | _ => fail 1 "ring/field anomaly: bad correctness lemma (get_MonPol)" end. (********************************************************) (* Building the atom list of a ring expression *) (* We do not assume that Cst recognizes the rO and rI terms as constants, as *) (* the tactic could be used to discriminate occurrences of an opaque *) (* constant phi, with (phi 0) not convertible to 0 for instance *) Ltac FV Cst CstPow rO rI add mul sub opp pow t fv := let rec TFV t fv := let f := match Cst t with | NotConstant => match t with | rO => fun _ => fv | rI => fun _ => fv | (add ?t1 ?t2) => fun _ => TFV t2 ltac:(TFV t1 fv) | (mul ?t1 ?t2) => fun _ => TFV t2 ltac:(TFV t1 fv) | (sub ?t1 ?t2) => fun _ => TFV t2 ltac:(TFV t1 fv) | (opp ?t1) => fun _ => TFV t1 fv | (pow ?t1 ?n) => match CstPow n with | InitialRing.NotConstant => fun _ => AddFvTail t fv | _ => fun _ => TFV t1 fv end | _ => fun _ => AddFvTail t fv end | _ => fun _ => fv end in f() in TFV t fv. (* syntaxification of ring expressions *) (* We do not assume that Cst recognizes the rO and rI terms as constants, as *) (* the tactic could be used to discriminate occurrences of an opaque *) (* constant phi, with (phi 0) not convertible to 0 for instance *) Ltac mkPolexpr C Cst CstPow rO rI radd rmul rsub ropp rpow t fv := let rec mkP t := let f := match Cst t with | InitialRing.NotConstant => match t with | rO => fun _ => constr:(@PEO C) | rI => fun _ => constr:(@PEI C) | (radd ?t1 ?t2) => fun _ => let e1 := mkP t1 in let e2 := mkP t2 in constr:(@PEadd C e1 e2) | (rmul ?t1 ?t2) => fun _ => let e1 := mkP t1 in let e2 := mkP t2 in constr:(@PEmul C e1 e2) | (rsub ?t1 ?t2) => fun _ => let e1 := mkP t1 in let e2 := mkP t2 in constr:(@PEsub C e1 e2) | (ropp ?t1) => fun _ => let e1 := mkP t1 in constr:(@PEopp C e1) | (rpow ?t1 ?n) => match CstPow n with | InitialRing.NotConstant => fun _ => let p := Find_at t fv in constr:(PEX C p) | ?c => fun _ => let e1 := mkP t1 in constr:(@PEpow C e1 c) end | _ => fun _ => let p := Find_at t fv in constr:(PEX C p) end | ?c => fun _ => constr:(@PEc C c) end in f () in mkP t. (* packaging the ring structure *) Ltac PackRing F req sth ext morph arth cst_tac pow_tac lemma1 lemma2 pre post := let RNG := match type of lemma1 with | context [@PEeval ?R ?r0 ?r1 ?add ?mul ?sub ?opp ?C ?phi ?Cpow ?powphi ?pow _ _] => (fun proj => proj cst_tac pow_tac pre post R req r0 r1 add mul sub opp C Cpow powphi pow lemma1 lemma2) | _ => fail 1 "field anomaly: bad correctness lemma (parse)" end in F RNG. Ltac get_Carrier RNG := RNG ltac:(fun cst_tac pow_tac pre post R req r0 r1 add mul sub opp C Cpow powphi pow lemma1 lemma2 => R). Ltac get_Eq RNG := RNG ltac:(fun cst_tac pow_tac pre post R req r0 r1 add mul sub opp C Cpow powphi pow lemma1 lemma2 => req). Ltac get_Pre RNG := RNG ltac:(fun cst_tac pow_tac pre post R req r0 r1 add mul sub opp C Cpow powphi pow lemma1 lemma2 => pre). Ltac get_Post RNG := RNG ltac:(fun cst_tac pow_tac pre post R req r0 r1 add mul sub opp C Cpow powphi pow lemma1 lemma2 => post). Ltac get_NormLemma RNG := RNG ltac:(fun cst_tac pow_tac pre post R req r0 r1 add mul sub opp C Cpow powphi pow lemma1 lemma2 => lemma1). Ltac get_SimplifyLemma RNG := RNG ltac:(fun cst_tac pow_tac pre post R req r0 r1 add mul sub opp C Cpow powphi pow lemma1 lemma2 => lemma2). Ltac get_RingFV RNG := RNG ltac:(fun cst_tac pow_tac pre post R req r0 r1 add mul sub opp C Cpow powphi pow lemma1 lemma2 => FV cst_tac pow_tac r0 r1 add mul sub opp pow). Ltac get_RingMeta RNG := RNG ltac:(fun cst_tac pow_tac pre post R req r0 r1 add mul sub opp C Cpow powphi pow lemma1 lemma2 => mkPolexpr C cst_tac pow_tac r0 r1 add mul sub opp pow). Ltac get_RingHypTac RNG := RNG ltac:(fun cst_tac pow_tac pre post R req r0 r1 add mul sub opp C Cpow powphi pow lemma1 lemma2 => let mkPol := mkPolexpr C cst_tac pow_tac r0 r1 add mul sub opp pow in fun fv lH => mkHyp_tac C req ltac:(fun t => mkPol t fv) lH). (* ring tactics *) Definition ring_subst_niter := (10*10*10)%nat. Ltac Ring RNG lemma lH := let req := get_Eq RNG in OnEquation req ltac:(fun lhs rhs => let mkFV := get_RingFV RNG in let mkPol := get_RingMeta RNG in let mkHyp := get_RingHypTac RNG in let fv := FV_hypo_tac mkFV ltac:(get_Eq RNG) lH in let fv := mkFV lhs fv in let fv := mkFV rhs fv in check_fv fv; let pe1 := mkPol lhs fv in let pe2 := mkPol rhs fv in let lpe := mkHyp fv lH in let vlpe := fresh "hyp_list" in let vfv := fresh "fv_list" in pose (vlpe := lpe); pose (vfv := fv); (apply (lemma vfv vlpe pe1 pe2) || fail "typing error while applying ring"); [ ((let prh := proofHyp_tac lH in exact prh) || idtac "can not automatically prove hypothesis :"; [> idtac " maybe a left member of a hypothesis is not a monomial"..]) | vm_compute; (exact (eq_refl true) || fail "not a valid ring equation")]). Ltac Ring_norm_gen f RNG lemma lH rl := let mkFV := get_RingFV RNG in let mkPol := get_RingMeta RNG in let mkHyp := get_RingHypTac RNG in let mk_monpol := get_MonPol lemma in let fv := FV_hypo_tac mkFV ltac:(get_Eq RNG) lH in let lemma_tac fv kont := let lpe := mkHyp fv lH in let vlpe := fresh "list_hyp" in let vlmp := fresh "list_hyp_norm" in let vlmp_eq := fresh "list_hyp_norm_eq" in let prh := proofHyp_tac lH in pose (vlpe := lpe); compute_assertion vlmp_eq vlmp (mk_monpol vlpe); let H := fresh "ring_lemma" in (assert (H := lemma vlpe fv prh vlmp vlmp_eq) || fail "type error when build the rewriting lemma"); clear vlmp_eq; kont H; (clear H||idtac"Ring_norm_gen: cleanup failed"); subst vlpe vlmp in let simpl_ring H := (protect_fv "ring" in H; f H) in ReflexiveRewriteTactic mkFV mkPol lemma_tac simpl_ring fv rl. Ltac Ring_gen RNG lH rl := let lemma := get_NormLemma RNG in get_Pre RNG (); Ring RNG (lemma ring_subst_niter) lH. Tactic Notation (at level 0) "ring" := let G := Get_goal in ring_lookup (PackRing Ring_gen) [] G. Tactic Notation (at level 0) "ring" "[" constr_list(lH) "]" := let G := Get_goal in ring_lookup (PackRing Ring_gen) [lH] G. (* Simplification *) Ltac Ring_simplify_gen f RNG lH rl := let lemma := get_SimplifyLemma RNG in let l := fresh "to_rewrite" in pose (l:= rl); generalize (eq_refl l); unfold l at 2; get_Pre RNG (); let rl := match goal with | [|- l = ?RL -> _ ] => RL | _ => fail 1 "ring_simplify anomaly: bad goal after pre" end in let Heq := fresh "Heq" in intros Heq;clear Heq l; Ring_norm_gen f RNG (lemma ring_subst_niter) lH rl; get_Post RNG (). Ltac Ring_simplify := Ring_simplify_gen ltac:(fun H => rewrite H). Tactic Notation (at level 0) "ring_simplify" constr_list(rl) := let G := Get_goal in ring_lookup (PackRing Ring_simplify) [] rl G. Tactic Notation (at level 0) "ring_simplify" "[" constr_list(lH) "]" constr_list(rl) := let G := Get_goal in ring_lookup (PackRing Ring_simplify) [lH] rl G. Tactic Notation "ring_simplify" constr_list(rl) "in" hyp(H):= let G := Get_goal in let t := type of H in let g := fresh "goal" in set (g:= G); generalize H; ring_lookup (PackRing Ring_simplify) [] rl t; (* Correction of bug 1859: we want to leave H at its initial position this is obtained by adding a copy of H (H'), move it just after H, remove H and finally rename H into H' *) let H' := fresh "H" in intro H'; move H' after H; clear H;rename H' into H; unfold g;clear g. Tactic Notation "ring_simplify" "["constr_list(lH)"]" constr_list(rl) "in" hyp(H):= let G := Get_goal in let t := type of H in let g := fresh "goal" in set (g:= G); generalize H; ring_lookup (PackRing Ring_simplify) [lH] rl t; (* Correction of bug 1859: we want to leave H at its initial position this is obtained by adding a copy of H (H'), move it just after H, remove H and finally rename H into H' *) let H' := fresh "H" in intro H'; move H' after H; clear H;rename H' into H; unfold g;clear g. coq-8.20.0/theories/setoid_ring/Ring_theory.v000066400000000000000000000454231466560755400212250ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* R -> R. Variable req : R -> R -> Prop. Variable Rsth : Equivalence req. Infix "*" := rmul. Infix "==" := req. Hypothesis mul_ext : Proper (req ==> req ==> req) rmul. Hypothesis mul_assoc : forall x y z, x * (y * z) == (x * y) * z. Fixpoint pow_pos (x:R) (i:positive) : R := match i with | xH => x | xO i => let p := pow_pos x i in p * p | xI i => let p := pow_pos x i in x * (p * p) end. Lemma pow_pos_swap x j : pow_pos x j * x == x * pow_pos x j. Proof. induction j as [j IHj|j IHj|]; simpl; rewrite <- ?mul_assoc. - f_equiv. now do 2 (rewrite IHj, mul_assoc). - now do 2 (rewrite IHj, mul_assoc). - reflexivity. Qed. Lemma pow_pos_succ x j : pow_pos x (Pos.succ j) == x * pow_pos x j. Proof. induction j as [j IHj|j IHj|]; simpl; try reflexivity. rewrite IHj, <- mul_assoc; f_equiv. now rewrite mul_assoc, pow_pos_swap, mul_assoc. Qed. Lemma pow_pos_add x i j : pow_pos x (i + j) == pow_pos x i * pow_pos x j. Proof. induction i as [|i IHi] using Pos.peano_ind. - now rewrite Pos.add_1_l, pow_pos_succ. - now rewrite Pos.add_succ_l, !pow_pos_succ, IHi, mul_assoc. Qed. Definition pow_N (x:R) (p:N) := match p with | N0 => rI | Npos p => pow_pos x p end. Definition id_phi_N (x:N) : N := x. Lemma pow_N_pow_N x n : pow_N x (id_phi_N n) == pow_N x n. Proof. reflexivity. Qed. End Power. Section DEFINITIONS. Variable R : Type. Variable (rO rI : R) (radd rmul rsub: R->R->R) (ropp : R -> R). Variable req : R -> R -> Prop. Notation "0" := rO. Notation "1" := rI. Infix "==" := req. Infix "+" := radd. Infix "*" := rmul. Infix "-" := rsub. Notation "- x" := (ropp x). (** Semi Ring *) Record semi_ring_theory : Prop := mk_srt { SRadd_0_l : forall n, 0 + n == n; SRadd_comm : forall n m, n + m == m + n ; SRadd_assoc : forall n m p, n + (m + p) == (n + m) + p; SRmul_1_l : forall n, 1*n == n; SRmul_0_l : forall n, 0*n == 0; SRmul_comm : forall n m, n*m == m*n; SRmul_assoc : forall n m p, n*(m*p) == (n*m)*p; SRdistr_l : forall n m p, (n + m)*p == n*p + m*p }. (** Almost Ring *) (*Almost ring are no ring : Ropp_def is missing **) Record almost_ring_theory : Prop := mk_art { ARadd_0_l : forall x, 0 + x == x; ARadd_comm : forall x y, x + y == y + x; ARadd_assoc : forall x y z, x + (y + z) == (x + y) + z; ARmul_1_l : forall x, 1 * x == x; ARmul_0_l : forall x, 0 * x == 0; ARmul_comm : forall x y, x * y == y * x; ARmul_assoc : forall x y z, x * (y * z) == (x * y) * z; ARdistr_l : forall x y z, (x + y) * z == (x * z) + (y * z); ARopp_mul_l : forall x y, -(x * y) == -x * y; ARopp_add : forall x y, -(x + y) == -x + -y; ARsub_def : forall x y, x - y == x + -y }. (** Ring *) Record ring_theory : Prop := mk_rt { Radd_0_l : forall x, 0 + x == x; Radd_comm : forall x y, x + y == y + x; Radd_assoc : forall x y z, x + (y + z) == (x + y) + z; Rmul_1_l : forall x, 1 * x == x; Rmul_comm : forall x y, x * y == y * x; Rmul_assoc : forall x y z, x * (y * z) == (x * y) * z; Rdistr_l : forall x y z, (x + y) * z == (x * z) + (y * z); Rsub_def : forall x y, x - y == x + -y; Ropp_def : forall x, x + (- x) == 0 }. (** Equality is extensional *) Record sring_eq_ext : Prop := mk_seqe { (* SRing operators are compatible with equality *) SRadd_ext : Proper (req ==> req ==> req) radd; SRmul_ext : Proper (req ==> req ==> req) rmul }. Record ring_eq_ext : Prop := mk_reqe { (* Ring operators are compatible with equality *) Radd_ext : Proper (req ==> req ==> req) radd; Rmul_ext : Proper (req ==> req ==> req) rmul; Ropp_ext : Proper (req ==> req) ropp }. (** Interpretation morphisms definition*) Section MORPHISM. Variable C:Type. Variable (cO cI : C) (cadd cmul csub : C->C->C) (copp : C->C). Variable ceqb : C->C->bool. (* [phi] est un morphisme de [C] dans [R] *) Variable phi : C -> R. Infix "+!" := cadd. Infix "-!" := csub. Infix "*!" := cmul. Notation "-! x" := (copp x). Infix "?=!" := ceqb. Notation "[ x ]" := (phi x). (*for semi rings*) Record semi_morph : Prop := mkRmorph { Smorph0 : [cO] == 0; Smorph1 : [cI] == 1; Smorph_add : forall x y, [x +! y] == [x]+[y]; Smorph_mul : forall x y, [x *! y] == [x]*[y]; Smorph_eq : forall x y, x?=!y = true -> [x] == [y] }. (* for rings*) Record ring_morph : Prop := mkmorph { morph0 : [cO] == 0; morph1 : [cI] == 1; morph_add : forall x y, [x +! y] == [x]+[y]; morph_sub : forall x y, [x -! y] == [x]-[y]; morph_mul : forall x y, [x *! y] == [x]*[y]; morph_opp : forall x, [-!x] == -[x]; morph_eq : forall x y, x?=!y = true -> [x] == [y] }. Section SIGN. Variable get_sign : C -> option C. Record sign_theory : Prop := mksign_th { sign_spec : forall c c', get_sign c = Some c' -> c ?=! -! c' = true }. End SIGN. Definition get_sign_None (c:C) := @None C. Lemma get_sign_None_th : sign_theory get_sign_None. Proof. constructor;intros;discriminate. Qed. Section DIV. Variable cdiv: C -> C -> C*C. Record div_theory : Prop := mkdiv_th { div_eucl_th : forall a b, let (q,r) := cdiv a b in [a] == [b *! q +! r] }. End DIV. End MORPHISM. (** Identity is a morphism *) Variable Rsth : Equivalence req. Variable reqb : R->R->bool. Hypothesis morph_req : forall x y, (reqb x y) = true -> x == y. Definition IDphi (x:R) := x. Lemma IDmorph : ring_morph rO rI radd rmul rsub ropp reqb IDphi. Proof. now apply (mkmorph rO rI radd rmul rsub ropp reqb IDphi). Qed. (** Specification of the power function *) Section POWER. Variable Cpow : Type. Variable Cp_phi : N -> Cpow. Variable rpow : R -> Cpow -> R. Record power_theory : Prop := mkpow_th { rpow_pow_N : forall r n, req (rpow r (Cp_phi n)) (pow_N rI rmul r n) }. End POWER. Definition pow_N_th := mkpow_th id_phi_N (pow_N rI rmul) (pow_N_pow_N rI rmul Rsth). End DEFINITIONS. Section ALMOST_RING. Variable R : Type. Variable (rO rI : R) (radd rmul rsub: R->R->R) (ropp : R -> R). Variable req : R -> R -> Prop. Notation "0" := rO. Notation "1" := rI. Infix "==" := req. Infix "+" := radd. Infix "* " := rmul. (** Leibniz equality leads to a setoid theory and is extensional*) Lemma Eqsth : Equivalence (@eq R). Proof. exact eq_equivalence. Qed. Lemma Eq_s_ext : sring_eq_ext radd rmul (@eq R). Proof. constructor;solve_proper. Qed. Lemma Eq_ext : ring_eq_ext radd rmul ropp (@eq R). Proof. constructor;solve_proper. Qed. Variable Rsth : Equivalence req. Section SEMI_RING. Variable SReqe : sring_eq_ext radd rmul req. Add Morphism radd with signature (req ==> req ==> req) as radd_ext1. Proof. exact (SRadd_ext SReqe). Qed. Add Morphism rmul with signature (req ==> req ==> req) as rmul_ext1. Proof. exact (SRmul_ext SReqe). Qed. Variable SRth : semi_ring_theory 0 1 radd rmul req. (** Every semi ring can be seen as an almost ring, by taking : [-x = x] and [x - y = x + y] *) Definition SRopp (x:R) := x. Notation "- x" := (SRopp x). Definition SRsub x y := x + -y. Infix "-" := SRsub. Lemma SRopp_ext : forall x y, x == y -> -x == -y. Proof. intros x y H; exact H. Qed. Lemma SReqe_Reqe : ring_eq_ext radd rmul SRopp req. Proof. constructor. - exact (SRadd_ext SReqe). - exact (SRmul_ext SReqe). - exact SRopp_ext. Qed. Lemma SRopp_mul_l : forall x y, -(x * y) == -x * y. Proof. reflexivity. Qed. Lemma SRopp_add : forall x y, -(x + y) == -x + -y. Proof. reflexivity. Qed. Lemma SRsub_def : forall x y, x - y == x + -y. Proof. reflexivity. Qed. Lemma SRth_ARth : almost_ring_theory 0 1 radd rmul SRsub SRopp req. Proof (mk_art 0 1 radd rmul SRsub SRopp req (SRadd_0_l SRth) (SRadd_comm SRth) (SRadd_assoc SRth) (SRmul_1_l SRth) (SRmul_0_l SRth) (SRmul_comm SRth) (SRmul_assoc SRth) (SRdistr_l SRth) SRopp_mul_l SRopp_add SRsub_def). (** Identity morphism for semi-ring equipped with their almost-ring structure*) Variable reqb : R->R->bool. Hypothesis morph_req : forall x y, (reqb x y) = true -> x == y. Definition SRIDmorph : ring_morph 0 1 radd rmul SRsub SRopp req 0 1 radd rmul SRsub SRopp reqb (@IDphi R). Proof. now apply mkmorph. Qed. (* a semi_morph can be extended to a ring_morph for the almost_ring derived from a semi_ring, provided the ring is a setoid (we only need reflexivity) *) Variable C : Type. Variable (cO cI : C) (cadd cmul: C->C->C). Variable (ceqb : C -> C -> bool). Variable phi : C -> R. Variable Smorph : semi_morph rO rI radd rmul req cO cI cadd cmul ceqb phi. Lemma SRmorph_Rmorph : ring_morph rO rI radd rmul SRsub SRopp req cO cI cadd cmul cadd (fun x => x) ceqb phi. Proof. case Smorph; now constructor. Qed. End SEMI_RING. Infix "-" := rsub. Notation "- x" := (ropp x). Variable Reqe : ring_eq_ext radd rmul ropp req. Add Morphism radd with signature (req ==> req ==> req) as radd_ext2. Proof. exact (Radd_ext Reqe). Qed. Add Morphism rmul with signature (req ==> req ==> req) as rmul_ext2. Proof. exact (Rmul_ext Reqe). Qed. Add Morphism ropp with signature (req ==> req) as ropp_ext2. Proof. exact (Ropp_ext Reqe). Qed. Section RING. Variable Rth : ring_theory 0 1 radd rmul rsub ropp req. (** Rings are almost rings*) Lemma Rmul_0_l x : 0 * x == 0. Proof. setoid_replace (0*x) with ((0+1)*x + -x). - now rewrite (Radd_0_l Rth), (Rmul_1_l Rth), (Ropp_def Rth). - rewrite (Rdistr_l Rth), (Rmul_1_l Rth). rewrite <- (Radd_assoc Rth), (Ropp_def Rth). now rewrite (Radd_comm Rth), (Radd_0_l Rth). Qed. Lemma Ropp_mul_l x y : -(x * y) == -x * y. Proof. rewrite <-(Radd_0_l Rth (- x * y)). rewrite (Radd_comm Rth), <-(Ropp_def Rth (x*y)). rewrite (Radd_assoc Rth), <- (Rdistr_l Rth). rewrite (Radd_comm Rth (-x)), (Ropp_def Rth). now rewrite Rmul_0_l, (Radd_0_l Rth). Qed. Lemma Ropp_add x y : -(x + y) == -x + -y. Proof. rewrite <- ((Radd_0_l Rth) (-(x+y))). rewrite <- ((Ropp_def Rth) x). rewrite <- ((Radd_0_l Rth) (x + - x + - (x + y))). rewrite <- ((Ropp_def Rth) y). rewrite ((Radd_comm Rth) x). rewrite ((Radd_comm Rth) y). rewrite <- ((Radd_assoc Rth) (-y)). rewrite <- ((Radd_assoc Rth) (- x)). rewrite ((Radd_assoc Rth) y). rewrite ((Radd_comm Rth) y). rewrite <- ((Radd_assoc Rth) (- x)). rewrite ((Radd_assoc Rth) y). rewrite ((Radd_comm Rth) y), (Ropp_def Rth). rewrite ((Radd_comm Rth) (-x) 0), (Radd_0_l Rth). now apply (Radd_comm Rth). Qed. Lemma Ropp_opp x : - -x == x. Proof. rewrite <- (Radd_0_l Rth (- -x)). rewrite <- (Ropp_def Rth x). rewrite <- (Radd_assoc Rth), (Ropp_def Rth). rewrite ((Radd_comm Rth) x); now apply (Radd_0_l Rth). Qed. Lemma Rth_ARth : almost_ring_theory 0 1 radd rmul rsub ropp req. Proof (mk_art 0 1 radd rmul rsub ropp req (Radd_0_l Rth) (Radd_comm Rth) (Radd_assoc Rth) (Rmul_1_l Rth) Rmul_0_l (Rmul_comm Rth) (Rmul_assoc Rth) (Rdistr_l Rth) Ropp_mul_l Ropp_add (Rsub_def Rth)). (** Every semi morphism between two rings is a morphism*) Variable C : Type. Variable (cO cI : C) (cadd cmul csub: C->C->C) (copp : C -> C). Variable (ceq : C -> C -> Prop) (ceqb : C -> C -> bool). Variable phi : C -> R. Infix "+!" := cadd. Infix "*!" := cmul. Infix "-!" := csub. Notation "-! x" := (copp x). Notation "?=!" := ceqb. Notation "[ x ]" := (phi x). Variable Csth : Equivalence ceq. Variable Ceqe : ring_eq_ext cadd cmul copp ceq. Add Parametric Relation : C ceq reflexivity proved by (@Equivalence_Reflexive _ _ Csth) symmetry proved by (@Equivalence_Symmetric _ _ Csth) transitivity proved by (@Equivalence_Transitive _ _ Csth) as C_setoid. Add Morphism cadd with signature (ceq ==> ceq ==> ceq) as cadd_ext. Proof. exact (Radd_ext Ceqe). Qed. Add Morphism cmul with signature (ceq ==> ceq ==> ceq) as cmul_ext. Proof. exact (Rmul_ext Ceqe). Qed. Add Morphism copp with signature (ceq ==> ceq) as copp_ext. Proof. exact (Ropp_ext Ceqe). Qed. Variable Cth : ring_theory cO cI cadd cmul csub copp ceq. Variable Smorph : semi_morph 0 1 radd rmul req cO cI cadd cmul ceqb phi. Variable phi_ext : forall x y, ceq x y -> [x] == [y]. Add Morphism phi with signature (ceq ==> req) as phi_ext1. Proof. exact phi_ext. Qed. Lemma Smorph_opp x : [-!x] == -[x]. Proof. rewrite <- (Radd_0_l Rth [-!x]). rewrite <- ((Ropp_def Rth) [x]). rewrite ((Radd_comm Rth) [x]). rewrite <- (Radd_assoc Rth). rewrite <- (Smorph_add Smorph). rewrite (Ropp_def Cth). rewrite (Smorph0 Smorph). rewrite (Radd_comm Rth (-[x])). now apply (Radd_0_l Rth). Qed. Lemma Smorph_sub x y : [x -! y] == [x] - [y]. Proof. rewrite (Rsub_def Cth), (Rsub_def Rth). now rewrite (Smorph_add Smorph), Smorph_opp. Qed. Lemma Smorph_morph : ring_morph 0 1 radd rmul rsub ropp req cO cI cadd cmul csub copp ceqb phi. Proof (mkmorph 0 1 radd rmul rsub ropp req cO cI cadd cmul csub copp ceqb phi (Smorph0 Smorph) (Smorph1 Smorph) (Smorph_add Smorph) Smorph_sub (Smorph_mul Smorph) Smorph_opp (Smorph_eq Smorph)). End RING. (** Useful lemmas on almost ring *) Variable ARth : almost_ring_theory 0 1 radd rmul rsub ropp req. Lemma ARth_SRth : semi_ring_theory 0 1 radd rmul req. Proof. elim ARth; intros. constructor; trivial. Qed. Instance ARsub_ext : Proper (req ==> req ==> req) rsub. Proof. intros x1 x2 Ex y1 y2 Ey. now rewrite !(ARsub_def ARth), Ex, Ey. Qed. Ltac mrewrite := repeat first [ rewrite (ARadd_0_l ARth) | rewrite <- ((ARadd_comm ARth) 0) | rewrite (ARmul_1_l ARth) | rewrite <- ((ARmul_comm ARth) 1) | rewrite (ARmul_0_l ARth) | rewrite <- ((ARmul_comm ARth) 0) | rewrite (ARdistr_l ARth) | reflexivity | match goal with | |- context [?z * (?x + ?y)] => rewrite ((ARmul_comm ARth) z (x+y)) end]. Lemma ARadd_0_r x : x + 0 == x. Proof. mrewrite. Qed. Lemma ARmul_1_r x : x * 1 == x. Proof. mrewrite. Qed. Lemma ARmul_0_r x : x * 0 == 0. Proof. mrewrite. Qed. Lemma ARdistr_r x y z : z * (x + y) == z*x + z*y. Proof. mrewrite. now rewrite !(ARmul_comm ARth z). Qed. Lemma ARadd_assoc1 x y z : (x + y) + z == (y + z) + x. Proof. now rewrite <-(ARadd_assoc ARth x), (ARadd_comm ARth x). Qed. Lemma ARadd_assoc2 x y z : (y + x) + z == (y + z) + x. Proof. now rewrite <- !(ARadd_assoc ARth), ((ARadd_comm ARth) x). Qed. Lemma ARmul_assoc1 x y z : (x * y) * z == (y * z) * x. Proof. now rewrite <- ((ARmul_assoc ARth) x), ((ARmul_comm ARth) x). Qed. Lemma ARmul_assoc2 x y z : (y * x) * z == (y * z) * x. Proof. now rewrite <- !(ARmul_assoc ARth), ((ARmul_comm ARth) x). Qed. Lemma ARopp_mul_r x y : - (x * y) == x * -y. Proof. rewrite ((ARmul_comm ARth) x y), (ARopp_mul_l ARth). now apply (ARmul_comm ARth). Qed. Lemma ARopp_zero : -0 == 0. Proof. now rewrite <- (ARmul_0_r 0), (ARopp_mul_l ARth), !ARmul_0_r. Qed. End ALMOST_RING. Section AddRing. (* Variable R : Type. Variable (rO rI : R) (radd rmul rsub: R->R->R) (ropp : R -> R). Variable req : R -> R -> Prop. *) Inductive ring_kind : Type := | Abstract | Computational (R:Type) (req : R -> R -> Prop) (reqb : R -> R -> bool) (_ : forall x y, (reqb x y) = true -> req x y) | Morphism (R : Type) (rO rI : R) (radd rmul rsub: R->R->R) (ropp : R -> R) (req : R -> R -> Prop) (C : Type) (cO cI : C) (cadd cmul csub : C->C->C) (copp : C->C) (ceqb : C->C->bool) phi (_ : ring_morph rO rI radd rmul rsub ropp req cO cI cadd cmul csub copp ceqb phi). End AddRing. (** Some simplification tactics*) Ltac gen_reflexivity Rsth := apply (Seq_refl _ _ Rsth). Ltac gen_srewrite Rsth Reqe ARth := repeat first [ gen_reflexivity Rsth | progress rewrite (ARopp_zero Rsth Reqe ARth) | rewrite (ARadd_0_l ARth) | rewrite (ARadd_0_r Rsth ARth) | rewrite (ARmul_1_l ARth) | rewrite (ARmul_1_r Rsth ARth) | rewrite (ARmul_0_l ARth) | rewrite (ARmul_0_r Rsth ARth) | rewrite (ARdistr_l ARth) | rewrite (ARdistr_r Rsth Reqe ARth) | rewrite (ARadd_assoc ARth) | rewrite (ARmul_assoc ARth) | progress rewrite (ARopp_add ARth) | progress rewrite (ARsub_def ARth) | progress rewrite <- (ARopp_mul_l ARth) | progress rewrite <- (ARopp_mul_r Rsth Reqe ARth) ]. Ltac gen_srewrite_sr Rsth Reqe ARth := repeat first [ gen_reflexivity Rsth | progress rewrite (ARopp_zero Rsth Reqe ARth) | rewrite (ARadd_0_l ARth) | rewrite (ARadd_0_r Rsth ARth) | rewrite (ARmul_1_l ARth) | rewrite (ARmul_1_r Rsth ARth) | rewrite (ARmul_0_l ARth) | rewrite (ARmul_0_r Rsth ARth) | rewrite (ARdistr_l ARth) | rewrite (ARdistr_r Rsth Reqe ARth) | rewrite (ARadd_assoc ARth) | rewrite (ARmul_assoc ARth) ]. Ltac gen_add_push add Rsth Reqe ARth x := repeat (match goal with | |- context [add (add ?y x) ?z] => progress rewrite (ARadd_assoc2 Rsth Reqe ARth x y z) | |- context [add (add x ?y) ?z] => progress rewrite (ARadd_assoc1 Rsth ARth x y z) | |- context [(add x ?y)] => progress rewrite (ARadd_comm ARth x y) end). Ltac gen_mul_push mul Rsth Reqe ARth x := repeat (match goal with | |- context [mul (mul ?y x) ?z] => progress rewrite (ARmul_assoc2 Rsth Reqe ARth x y z) | |- context [mul (mul x ?y) ?z] => progress rewrite (ARmul_assoc1 Rsth ARth x y z) | |- context [(mul x ?y)] => progress rewrite (ARmul_comm ARth x y) end). coq-8.20.0/theories/setoid_ring/Rings_Q.v000066400000000000000000000027641466560755400202770ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* 0%R. discrR. Qed. #[global] Instance Rdi : (Integral_domain (Rcr:=Rcri)). constructor. - exact Rmult_integral. - exact R_one_zero. Defined. coq-8.20.0/theories/setoid_ring/Rings_Z.v000066400000000000000000000017731466560755400203070ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* 0%Z. Proof. discriminate. Qed. #[global] Instance Zdi : (Integral_domain (Rcr:=Zcri)). constructor. - exact Zmult_integral. - exact Z_one_zero. Defined. coq-8.20.0/theories/setoid_ring/ZArithRing.v000066400000000000000000000032341466560755400207470ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* t | _ => constr:(NotConstant) end. Ltac isZpow_coef t := match t with | Zpos ?p => isPcst p | Z0 => constr:(true) | _ => constr:(false) end. Notation N_of_Z := Z.to_N (only parsing). Ltac Zpow_tac t := match isZpow_coef t with | true => constr:(N_of_Z t) | _ => constr:(NotConstant) end. Ltac Zpower_neg := repeat match goal with | [|- ?G] => match G with | context c [Z.pow _ (Zneg _)] => let t := context c [Z0] in change t end end. Add Ring Zr : Zth (decidable Zeq_bool_eq, constants [Zcst], preprocess [Zpower_neg;unfold Z.succ], power_tac Zpower_theory [Zpow_tac], (* The following two options are not needed; they are the default choice when the set of coefficient is the usual ring Z *) div (InitialRing.Ztriv_div_th (@Eqsth Z) (@IDphi Z)), sign get_signZ_th). coq-8.20.0/theories/ssr/000077500000000000000000000000001466560755400150365ustar00rootroot00000000000000coq-8.20.0/theories/ssr/ssrbool.v000066400000000000000000003157561466560755400167310ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* .doc { font-family: monospace; white-space: pre; } # **) Require Bool. Require Import ssreflect ssrfun. (** A theory of boolean predicates and operators. A large part of this file is concerned with boolean reflection. Definitions and notations: is_true b == the coercion of b : bool to Prop (:= b = true). This is just input and displayed as `b''. reflect P b == the reflection inductive predicate, asserting that the logical proposition P : Prop holds iff the formula b : bool is equal to true. Lemmas asserting reflect P b are often referred to as "views". iffP, appP, sameP, rwP :: lemmas for direct manipulation of reflection views: iffP is used to prove reflection from logical equivalence, appP to compose views, and sameP and rwP to perform boolean and setoid rewriting. elimT :: coercion reflect >-> Funclass, which allows the direct application of `reflect' views to boolean assertions. decidable P <-> P is effectively decidable (:= {P} + {~ P}). contra, contraL, ... :: contraposition lemmas. altP my_viewP :: natural alternative for reflection; given lemma myviewP: reflect my_Prop my_formula, have #[#myP | not_myP#]# := altP my_viewP. generates two subgoals, in which my_formula has been replaced by true and false, resp., with new assumptions myP : my_Prop and not_myP: ~~ my_formula. Caveat: my_formula must be an APPLICATION, not a variable, constant, let-in, etc. (due to the poor behaviour of dependent index matching). boolP my_formula :: boolean disjunction, equivalent to altP (idP my_formula) but circumventing the dependent index capture issue; destructing boolP my_formula generates two subgoals with assumptions my_formula and ~~ my_formula. As with altP, my_formula must be an application. \unless C, P <-> we can assume property P when a something that holds under condition C (such as C itself). := forall G : Prop, (C -> G) -> (P -> G) -> G. This is just C \/ P or rather its impredicative encoding, whose usage better fits the above description: given a lemma UCP whose conclusion is \unless C, P we can assume P by writing: wlog hP: / P by apply/UCP; (prove C -> goal). or even apply: UCP id _ => hP if the goal is C. classically P <-> we can assume P when proving is_true b. := forall b : bool, (P -> b) -> b. This is equivalent to ~ (~ P) when P : Prop. implies P Q == wrapper variant type that coerces to P -> Q and can be used as a P -> Q view unambiguously. Useful to avoid spurious insertion of <-> views when Q is a conjunction of foralls, as in Lemma all_and2 below; conversely, avoids confusion in apply views for impredicative properties, such as \unless C, P. Also supports contrapositives. a && b == the boolean conjunction of a and b. a || b == the boolean disjunction of a and b. a ==> b == the boolean implication of b by a. ~~ a == the boolean negation of a. a (+) b == the boolean exclusive or (or sum) of a and b. #[# /\ P1 , P2 & P3 #]# == multiway logical conjunction, up to 5 terms. #[# \/ P1 , P2 | P3 #]# == multiway logical disjunction, up to 4 terms. #[#&& a, b, c & d#]# == iterated, right associative boolean conjunction with arbitrary arity. #[#|| a, b, c | d#]# == iterated, right associative boolean disjunction with arbitrary arity. #[#==> a, b, c => d#]# == iterated, right associative boolean implication with arbitrary arity. and3P, ... == specific reflection lemmas for iterated connectives. andTb, orbAC, ... == systematic names for boolean connective properties (see suffix conventions below). prop_congr == a tactic to move a boolean equality from its coerced form in Prop to the equality in bool. bool_congr == resolution tactic for blindly weeding out like terms from boolean equalities (can fail). This file provides a theory of boolean predicates and relations: pred T == the type of bool predicates (:= T -> bool). simpl_pred T == the type of simplifying bool predicates, based on the simpl_fun type from ssrfun.v. mem_pred T == a specialized form of simpl_pred for "collective" predicates (see below). rel T == the type of bool relations. := T -> pred T or T -> T -> bool. simpl_rel T == type of simplifying relations. := T -> simpl_pred T predType == the generic predicate interface, supported for for lists and sets. pred_sort == the predType >-> Type projection; pred_sort is itself a Coercion target class. Declaring a coercion to pred_sort is an alternative way of equipping a type with a predType structure, which interoperates better with coercion subtyping. This is used, e.g., for finite sets, so that finite groups inherit the membership operation by coercing to sets. {pred T} == a type convertible to pred T, but whose head constant is pred_sort. This type should be used for parameters that can be used as collective predicates (see below), as this will allow passing in directly collections that implement predType by coercion as described above, e.g., finite sets. := pred_sort (predPredType T) If P is a predicate the proposition "x satisfies P" can be written applicatively as (P x), or using an explicit connective as (x \in P); in the latter case we say that P is a "collective" predicate. We use A, B rather than P, Q for collective predicates: x \in A == x satisfies the (collective) predicate A. x \notin A == x doesn't satisfy the (collective) predicate A. The pred T type can be used as a generic predicate type for either kind, but the two kinds of predicates should not be confused. When a "generic" pred T value of one type needs to be passed as the other the following conversions should be used explicitly: SimplPred P == a (simplifying) applicative equivalent of P. mem A == an applicative equivalent of collective predicate A: mem A x simplifies to x \in A, as mem A has in fact type mem_pred T. --> In user notation collective predicates _only_ occur as arguments to mem: A only appears as (mem A). This is hidden by notation, e.g., x \in A := in_mem x (mem A) here, enum A := enum_mem (mem A) in fintype. This makes it possible to unify the various ways in which A can be interpreted as a predicate, for both pattern matching and display. Alternatively one can use the syntax for explicit simplifying predicates and relations (in the following x is bound in E): #[#pred x | E#]# == simplifying (see ssrfun) predicate x => E. #[#pred x : T | E#]# == predicate x => E, with a cast on the argument. #[#pred : T | P#]# == constant predicate P on type T. #[#pred x | E1 & E2#]# == #[#pred x | E1 && E2#]#; an x : T cast is allowed. #[#pred x in A#]# == #[#pred x | x in A#]#. #[#pred x in A | E#]# == #[#pred x | x in A & E#]#. #[#pred x in A | E1 & E2#]# == #[#pred x in A | E1 && E2#]#. #[#predU A & B#]# == union of two collective predicates A and B. #[#predI A & B#]# == intersection of collective predicates A and B. #[#predD A & B#]# == difference of collective predicates A and B. #[#predC A#]# == complement of the collective predicate A. #[#preim f of A#]# == preimage under f of the collective predicate A. predU P Q, ..., preim f P == union, etc of applicative predicates. pred_oapp A == the predicate A lifted to the option type := #[#pred x | oapp (mem A) false x#]#. pred0 == the empty predicate. predT == the total (always true) predicate. if T : predArgType, then T coerces to predT. {: T} == T cast to predArgType (e.g., {: bool * nat}). In the following, x and y are bound in E: #[#rel x y | E#]# == simplifying relation x, y => E. #[#rel x y : T | E#]# == simplifying relation with arguments cast. #[#rel x y in A & B | E#]# == #[#rel x y | #[#&& x \in A, y \in B & E#]# #]#. #[#rel x y in A & B#]# == #[#rel x y | (x \in A) && (y \in B) #]#. #[#rel x y in A | E#]# == #[#rel x y in A & A | E#]#. #[#rel x y in A#]# == #[#rel x y in A & A#]#. relU R S == union of relations R and S. relpre f R == preimage of relation R under f. xpredU, ..., xrelpre == lambda terms implementing predU, ..., etc. Explicit values of type pred T (i.e., lamdba terms) should always be used applicatively, while values of collection types implementing the predType interface, such as sequences or sets should always be used as collective predicates. Defined constants and functions of type pred T or simpl_pred T as well as the explicit simpl_pred T values described below, can generally be used either way. Note however that x \in A will not auto-simplify when A is an explicit simpl_pred T value; the generic simplification rule inE must be used (when A : pred T, the unfold_in rule can be used). Constants of type pred T with an explicit simpl_pred value do not auto-simplify when used applicatively, but can still be expanded with inE. This behavior can be controlled as follows: Let A : collective_pred T := #[#pred x | ... #]#. The collective_pred T type is just an alias for pred T, but this cast stops rewrite inE from expanding the definition of A, thus treating A into an abstract collection (unfold_in or in_collective can be used to expand manually). Let A : applicative_pred T := #[#pred x | ... #]#. This cast causes inE to turn x \in A into the applicative A x form; A will then have to be unfolded explicitly with the /A rule. This will also apply to any definition that reduces to A (e.g., Let B := A). Canonical A_app_pred := ApplicativePred A. This declaration, given after definition of A, similarly causes inE to turn x \in A into A x, but in addition allows the app_predE rule to turn A x back into x \in A; it can be used for any definition of type pred T, which makes it especially useful for ambivalent predicates as the relational transitive closure connect, that are used in both applicative and collective styles. Purely for aesthetics, we provide a subtype of collective predicates: qualifier q T == a pred T pretty-printing wrapper. An A : qualifier q T coerces to pred_sort and thus behaves as a collective predicate, but x \in A and x \notin A are displayed as: x \is A and x \isn't A when q = 0, x \is a A and x \isn't a A when q = 1, x \is an A and x \isn't an A when q = 2, respectively. #[#qualify x | P#]# := Qualifier 0 (fun x => P), constructor for the above. #[#qualify x : T | P#]#, #[#qualify a x | P#]#, #[#qualify an X | P#]#, etc. variants of the above with type constraints and different values of q. We provide an internal interface to support attaching properties (such as being multiplicative) to predicates: pred_key p == phantom type that will serve as a support for properties to be attached to p : {pred _}; instances should be created with Fact/Qed so as to be opaque. KeyedPred k_p == an instance of the interface structure that attaches (k_p : pred_key P) to P; the structure projection is a coercion to pred_sort. KeyedQualifier k_q == an instance of the interface structure that attaches (k_q : pred_key q) to (q : qualifier n T). DefaultPredKey p == a default value for pred_key p; the vernacular command Import DefaultKeying attaches this key to all predicates that are not explicitly keyed. Keys can be used to attach properties to predicates, qualifiers and generic nouns in a way that allows them to be used transparently. The key projection of a predicate property structure such as unsignedPred should be a pred_key, not a pred, and corresponding lemmas will have the form Lemma rpredN R S (oppS : @opprPred R S) (kS : keyed_pred oppS) : {mono -%%R: x / x \in kS}. Because x \in kS will be displayed as x \in S (or x \is S, etc), the canonical instance of opprPred will not normally be exposed (it will also be erased by /= simplification). In addition each predicate structure should have a DefaultPredKey Canonical instance that simply issues the property as a proof obligation (which can be caught by the Prop-irrelevant feature of the ssreflect plugin). Some properties of predicates and relations: A =i B <-> A and B are extensionally equivalent. {subset A <= B} <-> A is a (collective) subpredicate of B. subpred P Q <-> P is an (applicative) subpredicate or Q. subrel R S <-> R is a subrelation of S. In the following R is in rel T: reflexive R <-> R is reflexive. irreflexive R <-> R is irreflexive. symmetric R <-> R (in rel T) is symmetric (equation). pre_symmetric R <-> R is symmetric (implication). antisymmetric R <-> R is antisymmetric. total R <-> R is total. transitive R <-> R is transitive. left_transitive R <-> R is a congruence on its left hand side. right_transitive R <-> R is a congruence on its right hand side. equivalence_rel R <-> R is an equivalence relation. Localization of (Prop) predicates; if P1 is convertible to forall x, Qx, P2 to forall x y, Qxy and P3 to forall x y z, Qxyz : {for y, P1} <-> Qx{y / x}. {in A, P1} <-> forall x, x \in A -> Qx. {in A1 & A2, P2} <-> forall x y, x \in A1 -> y \in A2 -> Qxy. {in A &, P2} <-> forall x y, x \in A -> y \in A -> Qxy. {in A1 & A2 & A3, Q3} <-> forall x y z, x \in A1 -> y \in A2 -> z \in A3 -> Qxyz. {in A1 & A2 &, Q3} := {in A1 & A2 & A2, Q3}. {in A1 && A3, Q3} := {in A1 & A1 & A3, Q3}. {in A &&, Q3} := {in A & A & A, Q3}. {in A, bijective f} <-> f has a right inverse in A. {on C, P1} <-> forall x, (f x) \in C -> Qx when P1 is also convertible to Pf f, e.g., {on C, involutive f}. {on C &, P2} == forall x y, f x \in C -> f y \in C -> Qxy when P2 is also convertible to Pf f, e.g., {on C &, injective f}. {on C, P1' & g} == forall x, (f x) \in cd -> Qx when P1' is convertible to Pf f and P1' g is convertible to forall x, Qx, e.g., {on C, cancel f & g}. {on C, bijective f} == f has a right inverse on C. This file extends the lemma name suffix conventions of ssrfun as follows: A -- associativity, as in andbA : associative andb. AC -- right commutativity. ACA -- self-interchange (inner commutativity), e.g., orbACA : (a || b) || (c || d) = (a || c) || (b || d). b -- a boolean argument, as in andbb : idempotent andb. C -- commutativity, as in andbC : commutative andb, or predicate complement, as in predC. CA -- left commutativity. D -- predicate difference, as in predD. E -- elimination, as in negbFE : ~~ b = false -> b. F or f -- boolean false, as in andbF : b && false = false. I -- left/right injectivity, as in addbI : right_injective addb, or predicate intersection, as in predI. l -- a left-hand operation, as andb_orl : left_distributive andb orb. N or n -- boolean negation, as in andbN : a && (~~ a) = false. P -- a characteristic property, often a reflection lemma, as in andP : reflect (a /\ b) (a && b). r -- a right-hand operation, as orb_andr : right_distributive orb andb. T or t -- boolean truth, as in andbT: right_id true andb. U -- predicate union, as in predU. W -- weakening, as in in1W : (forall x, P) -> {in D, forall x, P}. **) Set Implicit Arguments. Unset Strict Implicit. Unset Printing Implicit Defensive. Notation reflect := Bool.reflect. Notation ReflectT := Bool.ReflectT. Notation ReflectF := Bool.ReflectF. Reserved Notation "~~ b" (at level 35, right associativity). Reserved Notation "b ==> c" (at level 55, right associativity). Reserved Notation "b1 (+) b2" (at level 50, left associativity). Reserved Notation "x \in A" (at level 70, no associativity, format "'[hv' x '/ ' \in A ']'"). Reserved Notation "x \notin A" (at level 70, no associativity, format "'[hv' x '/ ' \notin A ']'"). Reserved Notation "x \is A" (at level 70, no associativity, format "'[hv' x '/ ' \is A ']'"). Reserved Notation "x \isn't A" (at level 70, no associativity, format "'[hv' x '/ ' \isn't A ']'"). Reserved Notation "x \is 'a' A" (at level 70, no associativity, format "'[hv' x '/ ' \is 'a' A ']'"). Reserved Notation "x \isn't 'a' A" (at level 70, no associativity, format "'[hv' x '/ ' \isn't 'a' A ']'"). Reserved Notation "x \is 'an' A" (at level 70, no associativity, format "'[hv' x '/ ' \is 'an' A ']'"). Reserved Notation "x \isn't 'an' A" (at level 70, no associativity, format "'[hv' x '/ ' \isn't 'an' A ']'"). Reserved Notation "p1 =i p2" (at level 70, no associativity, format "'[hv' p1 '/ ' =i p2 ']'"). Reserved Notation "{ 'subset' A <= B }" (at level 0, A, B at level 69, format "'[hv' { 'subset' A '/ ' <= B } ']'"). Reserved Notation "{ : T }" (at level 0, format "{ : T }"). Reserved Notation "{ 'pred' T }" (at level 0, format "{ 'pred' T }"). Reserved Notation "[ 'predType' 'of' T ]" (at level 0, format "[ 'predType' 'of' T ]"). Reserved Notation "[ 'pred' : T | E ]" (at level 0, format "'[hv' [ 'pred' : T | '/ ' E ] ']'"). Reserved Notation "[ 'pred' x | E ]" (at level 0, x name, format "'[hv' [ 'pred' x | '/ ' E ] ']'"). Reserved Notation "[ 'pred' x : T | E ]" (at level 0, x name, format "'[hv' [ 'pred' x : T | '/ ' E ] ']'"). Reserved Notation "[ 'pred' x | E1 & E2 ]" (at level 0, x name, format "'[hv' [ 'pred' x | '/ ' E1 & '/ ' E2 ] ']'"). Reserved Notation "[ 'pred' x : T | E1 & E2 ]" (at level 0, x name, format "'[hv' [ 'pred' x : T | '/ ' E1 & E2 ] ']'"). Reserved Notation "[ 'pred' x 'in' A ]" (at level 0, x name, format "'[hv' [ 'pred' x 'in' A ] ']'"). Reserved Notation "[ 'pred' x 'in' A | E ]" (at level 0, x name, format "'[hv' [ 'pred' x 'in' A | '/ ' E ] ']'"). Reserved Notation "[ 'pred' x 'in' A | E1 & E2 ]" (at level 0, x name, format "'[hv' [ 'pred' x 'in' A | '/ ' E1 & '/ ' E2 ] ']'"). Reserved Notation "[ 'qualify' x | P ]" (at level 0, x at level 99, format "'[hv' [ 'qualify' x | '/ ' P ] ']'"). Reserved Notation "[ 'qualify' x : T | P ]" (at level 0, x at level 99, format "'[hv' [ 'qualify' x : T | '/ ' P ] ']'"). Reserved Notation "[ 'qualify' 'a' x | P ]" (at level 0, x at level 99, format "'[hv' [ 'qualify' 'a' x | '/ ' P ] ']'"). Reserved Notation "[ 'qualify' 'a' x : T | P ]" (at level 0, x at level 99, format "'[hv' [ 'qualify' 'a' x : T | '/ ' P ] ']'"). Reserved Notation "[ 'qualify' 'an' x | P ]" (at level 0, x at level 99, format "'[hv' [ 'qualify' 'an' x | '/ ' P ] ']'"). Reserved Notation "[ 'qualify' 'an' x : T | P ]" (at level 0, x at level 99, format "'[hv' [ 'qualify' 'an' x : T | '/ ' P ] ']'"). Reserved Notation "[ 'rel' x y | E ]" (at level 0, x name, y name, format "'[hv' [ 'rel' x y | '/ ' E ] ']'"). Reserved Notation "[ 'rel' x y : T | E ]" (at level 0, x name, y name, format "'[hv' [ 'rel' x y : T | '/ ' E ] ']'"). Reserved Notation "[ 'rel' x y 'in' A & B | E ]" (at level 0, x name, y name, format "'[hv' [ 'rel' x y 'in' A & B | '/ ' E ] ']'"). Reserved Notation "[ 'rel' x y 'in' A & B ]" (at level 0, x name, y name, format "'[hv' [ 'rel' x y 'in' A & B ] ']'"). Reserved Notation "[ 'rel' x y 'in' A | E ]" (at level 0, x name, y name, format "'[hv' [ 'rel' x y 'in' A | '/ ' E ] ']'"). Reserved Notation "[ 'rel' x y 'in' A ]" (at level 0, x name, y name, format "'[hv' [ 'rel' x y 'in' A ] ']'"). Reserved Notation "[ 'mem' A ]" (at level 0, format "[ 'mem' A ]"). Reserved Notation "[ 'predI' A & B ]" (at level 0, format "[ 'predI' A & B ]"). Reserved Notation "[ 'predU' A & B ]" (at level 0, format "[ 'predU' A & B ]"). Reserved Notation "[ 'predD' A & B ]" (at level 0, format "[ 'predD' A & B ]"). Reserved Notation "[ 'predC' A ]" (at level 0, format "[ 'predC' A ]"). Reserved Notation "[ 'preim' f 'of' A ]" (at level 0, format "[ 'preim' f 'of' A ]"). Reserved Notation "\unless C , P" (at level 200, C at level 100, format "'[hv' \unless C , '/ ' P ']'"). Reserved Notation "{ 'for' x , P }" (at level 0, format "'[hv' { 'for' x , '/ ' P } ']'"). Reserved Notation "{ 'in' d , P }" (at level 0, format "'[hv' { 'in' d , '/ ' P } ']'"). Reserved Notation "{ 'in' d1 & d2 , P }" (at level 0, format "'[hv' { 'in' d1 & d2 , '/ ' P } ']'"). Reserved Notation "{ 'in' d & , P }" (at level 0, format "'[hv' { 'in' d & , '/ ' P } ']'"). Reserved Notation "{ 'in' d1 & d2 & d3 , P }" (at level 0, format "'[hv' { 'in' d1 & d2 & d3 , '/ ' P } ']'"). Reserved Notation "{ 'in' d1 & & d3 , P }" (at level 0, format "'[hv' { 'in' d1 & & d3 , '/ ' P } ']'"). Reserved Notation "{ 'in' d1 & d2 & , P }" (at level 0, format "'[hv' { 'in' d1 & d2 & , '/ ' P } ']'"). Reserved Notation "{ 'in' d & & , P }" (at level 0, format "'[hv' { 'in' d & & , '/ ' P } ']'"). Reserved Notation "{ 'on' cd , P }" (at level 0, format "'[hv' { 'on' cd , '/ ' P } ']'"). Reserved Notation "{ 'on' cd & , P }" (at level 0, format "'[hv' { 'on' cd & , '/ ' P } ']'"). Reserved Notation "{ 'on' cd , P & g }" (at level 0, g at level 8, format "'[hv' { 'on' cd , '/ ' P & g } ']'"). Reserved Notation "{ 'in' d , 'bijective' f }" (at level 0, f at level 8, format "'[hv' { 'in' d , '/ ' 'bijective' f } ']'"). Reserved Notation "{ 'on' cd , 'bijective' f }" (at level 0, f at level 8, format "'[hv' { 'on' cd , '/ ' 'bijective' f } ']'"). (** We introduce a number of n-ary "list-style" notations that share a common format, namely #[#op arg1, arg2, ... last_separator last_arg#]# This usually denotes a right-associative applications of op, e.g., #[#&& a, b, c & d#]# denotes a && (b && (c && d)) The last_separator must be a non-operator token. Here we use &, | or =>; our default is &, but we try to match the intended meaning of op. The separator is a workaround for limitations of the parsing engine; the same limitations mean the separator cannot be omitted even when last_arg can. The Notation declarations are complicated by the separate treatment for some fixed arities (binary for bool operators, and all arities for Prop operators). We also use the square brackets in comprehension-style notations #[#type var separator expr#]# where "type" is the type of the comprehension (e.g., pred) and "separator" is | or => . It is important that in other notations a leading square bracket #[# is always followed by an operator symbol or a fixed identifier. **) Reserved Notation "[ /\ P1 & P2 ]" (at level 0). Reserved Notation "[ /\ P1 , P2 & P3 ]" (at level 0, format "'[hv' [ /\ '[' P1 , '/' P2 ']' '/ ' & P3 ] ']'"). Reserved Notation "[ /\ P1 , P2 , P3 & P4 ]" (at level 0, format "'[hv' [ /\ '[' P1 , '/' P2 , '/' P3 ']' '/ ' & P4 ] ']'"). Reserved Notation "[ /\ P1 , P2 , P3 , P4 & P5 ]" (at level 0, format "'[hv' [ /\ '[' P1 , '/' P2 , '/' P3 , '/' P4 ']' '/ ' & P5 ] ']'"). Reserved Notation "[ \/ P1 | P2 ]" (at level 0). Reserved Notation "[ \/ P1 , P2 | P3 ]" (at level 0, format "'[hv' [ \/ '[' P1 , '/' P2 ']' '/ ' | P3 ] ']'"). Reserved Notation "[ \/ P1 , P2 , P3 | P4 ]" (at level 0, format "'[hv' [ \/ '[' P1 , '/' P2 , '/' P3 ']' '/ ' | P4 ] ']'"). Reserved Notation "[ && b1 & c ]" (at level 0). Reserved Notation "[ && b1 , b2 , .. , bn & c ]" (at level 0, format "'[hv' [ && '[' b1 , '/' b2 , '/' .. , '/' bn ']' '/ ' & c ] ']'"). Reserved Notation "[ || b1 | c ]" (at level 0). Reserved Notation "[ || b1 , b2 , .. , bn | c ]" (at level 0, format "'[hv' [ || '[' b1 , '/' b2 , '/' .. , '/' bn ']' '/ ' | c ] ']'"). Reserved Notation "[ ==> b1 => c ]" (at level 0). Reserved Notation "[ ==> b1 , b2 , .. , bn => c ]" (at level 0, format "'[hv' [ ==> '[' b1 , '/' b2 , '/' .. , '/' bn ']' '/' => c ] ']'"). (** Shorter delimiter **) #[export] Set Warnings "-overwriting-delimiting-key". Delimit Scope bool_scope with B. #[export] Set Warnings "overwriting-delimiting-key". Open Scope bool_scope. (** An alternative to xorb that behaves somewhat better wrt simplification. **) Definition addb b := if b then negb else id. (** Notation for && and || is declared in Init.Datatypes. **) Notation "~~ b" := (negb b) : bool_scope. Notation "b ==> c" := (implb b c) : bool_scope. Notation "b1 (+) b2" := (addb b1 b2) : bool_scope. (** Constant is_true b := b = true is defined in Init.Datatypes. **) Coercion is_true : bool >-> Sortclass. (* Prop *) Lemma prop_congr : forall b b' : bool, b = b' -> b = b' :> Prop. Proof. by move=> b b' ->. Qed. Ltac prop_congr := apply: prop_congr. (** Lemmas for trivial. **) Lemma is_true_true : true. Proof. by []. Qed. Lemma not_false_is_true : ~ false. Proof. by []. Qed. Lemma is_true_locked_true : locked true. Proof. by unlock. Qed. #[global] Hint Resolve is_true_true not_false_is_true is_true_locked_true : core. (** Shorter names. **) Definition isT := is_true_true. Definition notF := not_false_is_true. (** Negation lemmas. **) (** We generally take NEGATION as the standard form of a false condition: negative boolean hypotheses should be of the form ~~ b, rather than ~ b or b = false, as much as possible. **) Lemma negbT b : b = false -> ~~ b. Proof. by case: b. Qed. Lemma negbTE b : ~~ b -> b = false. Proof. by case: b. Qed. Lemma negbF b : (b : bool) -> ~~ b = false. Proof. by case: b. Qed. Lemma negbFE b : ~~ b = false -> b. Proof. by case: b. Qed. Lemma negbK : involutive negb. Proof. by case. Qed. Lemma negbNE b : ~~ ~~ b -> b. Proof. by case: b. Qed. Lemma negb_inj : injective negb. Proof. exact: can_inj negbK. Qed. Lemma negbLR b c : b = ~~ c -> ~~ b = c. Proof. exact: canLR negbK. Qed. Lemma negbRL b c : ~~ b = c -> b = ~~ c. Proof. exact: canRL negbK. Qed. Lemma contra (c b : bool) : (c -> b) -> ~~ b -> ~~ c. Proof. by case: b => //; case: c. Qed. Definition contraNN := contra. Lemma contraL (c b : bool) : (c -> ~~ b) -> b -> ~~ c. Proof. by case: b => //; case: c. Qed. Definition contraTN := contraL. Lemma contraR (c b : bool) : (~~ c -> b) -> ~~ b -> c. Proof. by case: b => //; case: c. Qed. Definition contraNT := contraR. Lemma contraLR (c b : bool) : (~~ c -> ~~ b) -> b -> c. Proof. by case: b => //; case: c. Qed. Definition contraTT := contraLR. Lemma contraT b : (~~ b -> false) -> b. Proof. by case: b => // ->. Qed. Lemma wlog_neg b : (~~ b -> b) -> b. Proof. by case: b => // ->. Qed. Lemma contraFT (c b : bool) : (~~ c -> b) -> b = false -> c. Proof. by move/contraR=> notb_c /negbT. Qed. Lemma contraFN (c b : bool) : (c -> b) -> b = false -> ~~ c. Proof. by move/contra=> notb_notc /negbT. Qed. Lemma contraTF (c b : bool) : (c -> ~~ b) -> b -> c = false. Proof. by move/contraL=> b_notc /b_notc/negbTE. Qed. Lemma contraNF (c b : bool) : (c -> b) -> ~~ b -> c = false. Proof. by move/contra=> notb_notc /notb_notc/negbTE. Qed. Lemma contraFF (c b : bool) : (c -> b) -> b = false -> c = false. Proof. by move/contraFN=> bF_notc /bF_notc/negbTE. Qed. (* additional contra lemmas involving [P,Q : Prop] *) Lemma contra_not (P Q : Prop) : (Q -> P) -> (~ P -> ~ Q). Proof. by auto. Qed. Lemma contraPnot (P Q : Prop) : (Q -> ~ P) -> (P -> ~ Q). Proof. by auto. Qed. Lemma contraTnot (b : bool) (P : Prop) : (P -> ~~ b) -> (b -> ~ P). Proof. by case: b; auto. Qed. Lemma contraNnot (P : Prop) (b : bool) : (P -> b) -> (~~ b -> ~ P). Proof. rewrite -{1}[b]negbK; exact: contraTnot. Qed. Lemma contraPT (P : Prop) (b : bool) : (~~ b -> ~ P) -> P -> b. Proof. by case: b => //= /(_ isT) nP /nP. Qed. Lemma contra_notT (P : Prop) (b : bool) : (~~ b -> P) -> ~ P -> b. Proof. by case: b => //= /(_ isT) HP /(_ HP). Qed. Lemma contra_notN (P : Prop) (b : bool) : (b -> P) -> ~ P -> ~~ b. Proof. rewrite -{1}[b]negbK; exact: contra_notT. Qed. Lemma contraPN (P : Prop) (b : bool) : (b -> ~ P) -> (P -> ~~ b). Proof. by case: b => //=; move/(_ isT) => HP /HP. Qed. Lemma contraFnot (P : Prop) (b : bool) : (P -> b) -> b = false -> ~ P. Proof. by case: b => //; auto. Qed. Lemma contraPF (P : Prop) (b : bool) : (b -> ~ P) -> P -> b = false. Proof. by case: b => // /(_ isT). Qed. Lemma contra_notF (P : Prop) (b : bool) : (b -> P) -> ~ P -> b = false. Proof. by case: b => // /(_ isT). Qed. (** Coercion of sum-style datatypes into bool, which makes it possible to use ssr's boolean if rather than Coq's "generic" if. **) Coercion isSome T (u : option T) := if u is Some _ then true else false. Coercion is_inl A B (u : A + B) := if u is inl _ then true else false. Coercion is_left A B (u : {A} + {B}) := if u is left _ then true else false. Coercion is_inleft A B (u : A + {B}) := if u is inleft _ then true else false. Prenex Implicits isSome is_inl is_left is_inleft. Definition decidable P := {P} + {~ P}. (** Lemmas for ifs with large conditions, which allow reasoning about the condition without repeating it inside the proof (the latter IS preferable when the condition is short). Usage : if the goal contains (if cond then ...) = ... case: ifP => Hcond. generates two subgoal, with the assumption Hcond : cond = true/false Rewrite if_same eliminates redundant ifs Rewrite (fun_if f) moves a function f inside an if Rewrite if_arg moves an argument inside a function-valued if **) Section BoolIf. Variables (A B : Type) (x : A) (f : A -> B) (b : bool) (vT vF : A). Variant if_spec (not_b : Prop) : bool -> A -> Set := | IfSpecTrue of b : if_spec not_b true vT | IfSpecFalse of not_b : if_spec not_b false vF. Lemma ifP : if_spec (b = false) b (if b then vT else vF). Proof. by case def_b: b; constructor. Qed. Lemma ifPn : if_spec (~~ b) b (if b then vT else vF). Proof. by case def_b: b; constructor; rewrite ?def_b. Qed. Lemma ifT : b -> (if b then vT else vF) = vT. Proof. by move->. Qed. Lemma ifF : b = false -> (if b then vT else vF) = vF. Proof. by move->. Qed. Lemma ifN : ~~ b -> (if b then vT else vF) = vF. Proof. by move/negbTE->. Qed. Lemma if_same : (if b then vT else vT) = vT. Proof. by case b. Qed. Lemma if_neg : (if ~~ b then vT else vF) = if b then vF else vT. Proof. by case b. Qed. Lemma fun_if : f (if b then vT else vF) = if b then f vT else f vF. Proof. by case b. Qed. Lemma if_arg (fT fF : A -> B) : (if b then fT else fF) x = if b then fT x else fF x. Proof. by case b. Qed. (** Turning a boolean "if" form into an application. **) Definition if_expr := if b then vT else vF. Lemma ifE : (if b then vT else vF) = if_expr. Proof. by []. Qed. End BoolIf. (** Core (internal) reflection lemmas, used for the three kinds of views. **) Section ReflectCore. Variables (P Q : Prop) (b c : bool). Hypothesis Hb : reflect P b. Lemma introNTF : (if c then ~ P else P) -> ~~ b = c. Proof. by case c; case Hb. Qed. Lemma introTF : (if c then P else ~ P) -> b = c. Proof. by case c; case Hb. Qed. Lemma elimNTF : ~~ b = c -> if c then ~ P else P. Proof. by move <-; case Hb. Qed. Lemma elimTF : b = c -> if c then P else ~ P. Proof. by move <-; case Hb. Qed. Lemma equivPif : (Q -> P) -> (P -> Q) -> if b then Q else ~ Q. Proof. by case Hb; auto. Qed. Lemma xorPif : Q \/ P -> ~ (Q /\ P) -> if b then ~ Q else Q. Proof. by case Hb => [? _ H ? | ? H _]; case: H. Qed. End ReflectCore. (** Internal negated reflection lemmas **) Section ReflectNegCore. Variables (P Q : Prop) (b c : bool). Hypothesis Hb : reflect P (~~ b). Lemma introTFn : (if c then ~ P else P) -> b = c. Proof. by move/(introNTF Hb) <-; case b. Qed. Lemma elimTFn : b = c -> if c then ~ P else P. Proof. by move <-; apply: (elimNTF Hb); case b. Qed. Lemma equivPifn : (Q -> P) -> (P -> Q) -> if b then ~ Q else Q. Proof. by rewrite -if_neg; apply: equivPif. Qed. Lemma xorPifn : Q \/ P -> ~ (Q /\ P) -> if b then Q else ~ Q. Proof. by rewrite -if_neg; apply: xorPif. Qed. End ReflectNegCore. (** User-oriented reflection lemmas **) Section Reflect. Variables (P Q : Prop) (b b' c : bool). Hypotheses (Pb : reflect P b) (Pb' : reflect P (~~ b')). Lemma introT : P -> b. Proof. exact: introTF true _. Qed. Lemma introF : ~ P -> b = false. Proof. exact: introTF false _. Qed. Lemma introN : ~ P -> ~~ b. Proof. exact: introNTF true _. Qed. Lemma introNf : P -> ~~ b = false. Proof. exact: introNTF false _. Qed. Lemma introTn : ~ P -> b'. Proof. exact: introTFn true _. Qed. Lemma introFn : P -> b' = false. Proof. exact: introTFn false _. Qed. Lemma elimT : b -> P. Proof. exact: elimTF true _. Qed. Lemma elimF : b = false -> ~ P. Proof. exact: elimTF false _. Qed. Lemma elimN : ~~ b -> ~P. Proof. exact: elimNTF true _. Qed. Lemma elimNf : ~~ b = false -> P. Proof. exact: elimNTF false _. Qed. Lemma elimTn : b' -> ~ P. Proof. exact: elimTFn true _. Qed. Lemma elimFn : b' = false -> P. Proof. exact: elimTFn false _. Qed. Lemma introP : (b -> Q) -> (~~ b -> ~ Q) -> reflect Q b. Proof. by case b; constructor; auto. Qed. Lemma iffP : (P -> Q) -> (Q -> P) -> reflect Q b. Proof. by case: Pb; constructor; auto. Qed. Lemma equivP : (P <-> Q) -> reflect Q b. Proof. by case; apply: iffP. Qed. Lemma sumboolP (decQ : decidable Q) : reflect Q decQ. Proof. by case: decQ; constructor. Qed. Lemma appP : reflect Q b -> P -> Q. Proof. by move=> Qb; move/introT; case: Qb. Qed. Lemma sameP : reflect P c -> b = c. Proof. by case; [apply: introT | apply: introF]. Qed. Lemma decPcases : if b then P else ~ P. Proof. by case Pb. Qed. Definition decP : decidable P. by case: b decPcases; [left | right]. Defined. Lemma rwP : P <-> b. Proof. by split; [apply: introT | apply: elimT]. Qed. Lemma rwP2 : reflect Q b -> (P <-> Q). Proof. by move=> Qb; split=> ?; [apply: appP | apply: elimT; case: Qb]. Qed. (** Predicate family to reflect excluded middle in bool. **) Variant alt_spec : bool -> Type := | AltTrue of P : alt_spec true | AltFalse of ~~ b : alt_spec false. Lemma altP : alt_spec b. Proof. by case def_b: b / Pb; constructor; rewrite ?def_b. Qed. Lemma eqbLR (b1 b2 : bool) : b1 = b2 -> b1 -> b2. Proof. by move->. Qed. Lemma eqbRL (b1 b2 : bool) : b1 = b2 -> b2 -> b1. Proof. by move->. Qed. End Reflect. Hint View for move/ elimTF|3 elimNTF|3 elimTFn|3 introT|2 introTn|2 introN|2. Hint View for apply/ introTF|3 introNTF|3 introTFn|3 elimT|2 elimTn|2 elimN|2. Hint View for apply// equivPif|3 xorPif|3 equivPifn|3 xorPifn|3. (** Allow the direct application of a reflection lemma to a boolean assertion. **) Coercion elimT : reflect >-> Funclass. #[universes(template)] Variant implies P Q := Implies of P -> Q. Lemma impliesP P Q : implies P Q -> P -> Q. Proof. by case. Qed. Lemma impliesPn (P Q : Prop) : implies P Q -> ~ Q -> ~ P. Proof. by case=> iP ? /iP. Qed. Coercion impliesP : implies >-> Funclass. Hint View for move/ impliesPn|2 impliesP|2. Hint View for apply/ impliesPn|2 impliesP|2. (** Impredicative or, which can emulate a classical not-implies. **) Definition unless condition property : Prop := forall goal : Prop, (condition -> goal) -> (property -> goal) -> goal. Notation "\unless C , P" := (unless C P) : type_scope. Lemma unlessL C P : implies C (\unless C, P). Proof. by split=> hC G /(_ hC). Qed. Lemma unlessR C P : implies P (\unless C, P). Proof. by split=> hP G _ /(_ hP). Qed. Lemma unless_sym C P : implies (\unless C, P) (\unless P, C). Proof. by split; apply; [apply/unlessR | apply/unlessL]. Qed. Lemma unlessP (C P : Prop) : (\unless C, P) <-> C \/ P. Proof. by split=> [|[/unlessL | /unlessR]]; apply; [left | right]. Qed. Lemma bind_unless C P {Q} : implies (\unless C, P) (\unless (\unless C, Q), P). Proof. by split; apply=> [hC|hP]; [apply/unlessL/unlessL | apply/unlessR]. Qed. Lemma unless_contra b C : implies (~~ b -> C) (\unless C, b). Proof. by split; case: b => [_ | hC]; [apply/unlessR | apply/unlessL/hC]. Qed. (** Classical reasoning becomes directly accessible for any bool subgoal. Note that we cannot use "unless" here for lack of universe polymorphism. **) Definition classically P : Prop := forall b : bool, (P -> b) -> b. Lemma classicP (P : Prop) : classically P <-> ~ ~ P. Proof. split=> [cP nP | nnP [] // nP]; last by case nnP; move/nP. by have: P -> false; [move/nP | move/cP]. Qed. Lemma classicW P : P -> classically P. Proof. by move=> hP _ ->. Qed. Lemma classic_bind P Q : (P -> classically Q) -> classically P -> classically Q. Proof. by move=> iPQ cP b /iPQ-/cP. Qed. Lemma classic_EM P : classically (decidable P). Proof. by case=> // undecP; apply/undecP; right=> notP; apply/notF/undecP; left. Qed. Lemma classic_pick T P : classically ({x : T | P x} + (forall x, ~ P x)). Proof. case=> // undecP; apply/undecP; right=> x Px. by apply/notF/undecP; left; exists x. Qed. Lemma classic_imply P Q : (P -> classically Q) -> classically (P -> Q). Proof. move=> iPQ []// notPQ; apply/notPQ=> /iPQ-cQ. by case: notF; apply: cQ => hQ; apply: notPQ. Qed. Lemma classic_sigW T (P : T -> Prop) : classically (exists x, P x) <-> classically ({x | P x}). Proof. by split; apply: classic_bind => -[x Px]; apply/classicW; exists x. Qed. Lemma classic_ex T (P : T -> Prop) : ~ (forall x, ~ P x) -> classically (exists x, P x). Proof. move=> NfNP; apply/classicP => exPF; apply: NfNP => x Px. by apply: exPF; exists x. Qed. (** List notations for wider connectives; the Prop connectives have a fixed width so as to avoid iterated destruction (we go up to width 5 for /\, and width 4 for or). The bool connectives have arbitrary widths, but denote expressions that associate to the RIGHT. This is consistent with the right associativity of list expressions and thus more convenient in most proofs. **) Inductive and3 (P1 P2 P3 : Prop) : Prop := And3 of P1 & P2 & P3. Inductive and4 (P1 P2 P3 P4 : Prop) : Prop := And4 of P1 & P2 & P3 & P4. Inductive and5 (P1 P2 P3 P4 P5 : Prop) : Prop := And5 of P1 & P2 & P3 & P4 & P5. Inductive or3 (P1 P2 P3 : Prop) : Prop := Or31 of P1 | Or32 of P2 | Or33 of P3. Inductive or4 (P1 P2 P3 P4 : Prop) : Prop := Or41 of P1 | Or42 of P2 | Or43 of P3 | Or44 of P4. Notation "[ /\ P1 & P2 ]" := (and P1 P2) (only parsing) : type_scope. Notation "[ /\ P1 , P2 & P3 ]" := (and3 P1 P2 P3) : type_scope. Notation "[ /\ P1 , P2 , P3 & P4 ]" := (and4 P1 P2 P3 P4) : type_scope. Notation "[ /\ P1 , P2 , P3 , P4 & P5 ]" := (and5 P1 P2 P3 P4 P5) : type_scope. Notation "[ \/ P1 | P2 ]" := (or P1 P2) (only parsing) : type_scope. Notation "[ \/ P1 , P2 | P3 ]" := (or3 P1 P2 P3) : type_scope. Notation "[ \/ P1 , P2 , P3 | P4 ]" := (or4 P1 P2 P3 P4) : type_scope. Notation "[ && b1 & c ]" := (b1 && c) (only parsing) : bool_scope. Notation "[ && b1 , b2 , .. , bn & c ]" := (b1 && (b2 && .. (bn && c) .. )) : bool_scope. Notation "[ || b1 | c ]" := (b1 || c) (only parsing) : bool_scope. Notation "[ || b1 , b2 , .. , bn | c ]" := (b1 || (b2 || .. (bn || c) .. )) : bool_scope. Notation "[ ==> b1 , b2 , .. , bn => c ]" := (b1 ==> (b2 ==> .. (bn ==> c) .. )) : bool_scope. Notation "[ ==> b1 => c ]" := (b1 ==> c) (only parsing) : bool_scope. Section AllAnd. Variables (T : Type) (P1 P2 P3 P4 P5 : T -> Prop). Local Notation a P := (forall x, P x). Lemma all_and2 : implies (forall x, [/\ P1 x & P2 x]) [/\ a P1 & a P2]. Proof. by split=> haveP; split=> x; case: (haveP x). Qed. Lemma all_and3 : implies (forall x, [/\ P1 x, P2 x & P3 x]) [/\ a P1, a P2 & a P3]. Proof. by split=> haveP; split=> x; case: (haveP x). Qed. Lemma all_and4 : implies (forall x, [/\ P1 x, P2 x, P3 x & P4 x]) [/\ a P1, a P2, a P3 & a P4]. Proof. by split=> haveP; split=> x; case: (haveP x). Qed. Lemma all_and5 : implies (forall x, [/\ P1 x, P2 x, P3 x, P4 x & P5 x]) [/\ a P1, a P2, a P3, a P4 & a P5]. Proof. by split=> haveP; split=> x; case: (haveP x). Qed. End AllAnd. Arguments all_and2 {T P1 P2}. Arguments all_and3 {T P1 P2 P3}. Arguments all_and4 {T P1 P2 P3 P4}. Arguments all_and5 {T P1 P2 P3 P4 P5}. Lemma pair_andP P Q : P /\ Q <-> P * Q. Proof. by split; case. Qed. Section ReflectConnectives. Variable b1 b2 b3 b4 b5 : bool. Lemma idP : reflect b1 b1. Proof. by case b1; constructor. Qed. Lemma boolP : alt_spec b1 b1 b1. Proof. exact: (altP idP). Qed. (* Left-to-right reflection of ~~b1 to (b1 = false), no-op otherwise. *) Lemma idPn : reflect (~~ b1) (~~ b1). Proof. by case b1; constructor. Qed. Lemma negP : reflect (~ b1) (~~ b1). Proof. by case b1; constructor; auto. Qed. Lemma negPn : reflect b1 (~~ ~~ b1). Proof. by case b1; constructor. Qed. (* Right-to-left reflection, no-op otherwise. C.f., https://github.com/math-comp/math-comp/issues/284 To change `b1 = false` into `~~ b1`, use `apply/negbTE` or `apply/idPn` (goal) or `move/negbT` or `move/idPn` (hypothesis). *) Lemma negPf : reflect (b1 = false) (~~ b1). Proof. by case b1; constructor. Qed. Lemma andP : reflect (b1 /\ b2) (b1 && b2). Proof. by case b1; case b2; constructor=> //; case. Qed. Lemma and3P : reflect [/\ b1, b2 & b3] [&& b1, b2 & b3]. Proof. by case b1; case b2; case b3; constructor; try by case. Qed. Lemma and4P : reflect [/\ b1, b2, b3 & b4] [&& b1, b2, b3 & b4]. Proof. by case b1; case b2; case b3; case b4; constructor; try by case. Qed. Lemma and5P : reflect [/\ b1, b2, b3, b4 & b5] [&& b1, b2, b3, b4 & b5]. Proof. by case b1; case b2; case b3; case b4; case b5; constructor; try by case. Qed. Lemma orP : reflect (b1 \/ b2) (b1 || b2). Proof. by case b1; case b2; constructor; auto; case. Qed. Lemma or3P : reflect [\/ b1, b2 | b3] [|| b1, b2 | b3]. Proof. case b1; first by constructor; constructor 1. case b2; first by constructor; constructor 2. case b3; first by constructor; constructor 3. by constructor; case. Qed. Lemma or4P : reflect [\/ b1, b2, b3 | b4] [|| b1, b2, b3 | b4]. Proof. case b1; first by constructor; constructor 1. case b2; first by constructor; constructor 2. case b3; first by constructor; constructor 3. case b4; first by constructor; constructor 4. by constructor; case. Qed. Lemma nandP : reflect (~~ b1 \/ ~~ b2) (~~ (b1 && b2)). Proof. by case b1; case b2; constructor; auto; case; auto. Qed. Lemma norP : reflect (~~ b1 /\ ~~ b2) (~~ (b1 || b2)). Proof. by case b1; case b2; constructor; auto; case; auto. Qed. Lemma implyP : reflect (b1 -> b2) (b1 ==> b2). Proof. by case b1; case b2; constructor; auto. Qed. End ReflectConnectives. Arguments idP {b1}. Arguments idPn {b1}. Arguments negP {b1}. Arguments negPn {b1}. Arguments negPf {b1}. Arguments andP {b1 b2}. Arguments and3P {b1 b2 b3}. Arguments and4P {b1 b2 b3 b4}. Arguments and5P {b1 b2 b3 b4 b5}. Arguments orP {b1 b2}. Arguments or3P {b1 b2 b3}. Arguments or4P {b1 b2 b3 b4}. Arguments nandP {b1 b2}. Arguments norP {b1 b2}. Arguments implyP {b1 b2}. Prenex Implicits idP idPn negP negPn negPf. Prenex Implicits andP and3P and4P and5P orP or3P or4P nandP norP implyP. Section ReflectCombinators. Variables (P Q : Prop) (p q : bool). Hypothesis rP : reflect P p. Hypothesis rQ : reflect Q q. Lemma negPP : reflect (~ P) (~~ p). Proof. by apply:(iffP negP); apply: contra_not => /rP. Qed. Lemma andPP : reflect (P /\ Q) (p && q). Proof. by apply: (iffP andP) => -[/rP ? /rQ ?]. Qed. Lemma orPP : reflect (P \/ Q) (p || q). Proof. by apply: (iffP orP) => -[/rP ?|/rQ ?]; tauto. Qed. Lemma implyPP : reflect (P -> Q) (p ==> q). Proof. by apply: (iffP implyP) => pq /rP /pq /rQ. Qed. End ReflectCombinators. Arguments negPP {P p}. Arguments andPP {P Q p q}. Arguments orPP {P Q p q}. Arguments implyPP {P Q p q}. Prenex Implicits negPP andPP orPP implyPP. (** Shorter, more systematic names for the boolean connectives laws. **) Lemma andTb : left_id true andb. Proof. by []. Qed. Lemma andFb : left_zero false andb. Proof. by []. Qed. Lemma andbT : right_id true andb. Proof. by case. Qed. Lemma andbF : right_zero false andb. Proof. by case. Qed. Lemma andbb : idempotent andb. Proof. by case. Qed. Lemma andbC : commutative andb. Proof. by do 2!case. Qed. Lemma andbA : associative andb. Proof. by do 3!case. Qed. Lemma andbCA : left_commutative andb. Proof. by do 3!case. Qed. Lemma andbAC : right_commutative andb. Proof. by do 3!case. Qed. Lemma andbACA : interchange andb andb. Proof. by do 4!case. Qed. Lemma orTb : forall b, true || b. Proof. by []. Qed. Lemma orFb : left_id false orb. Proof. by []. Qed. Lemma orbT : forall b, b || true. Proof. by case. Qed. Lemma orbF : right_id false orb. Proof. by case. Qed. Lemma orbb : idempotent orb. Proof. by case. Qed. Lemma orbC : commutative orb. Proof. by do 2!case. Qed. Lemma orbA : associative orb. Proof. by do 3!case. Qed. Lemma orbCA : left_commutative orb. Proof. by do 3!case. Qed. Lemma orbAC : right_commutative orb. Proof. by do 3!case. Qed. Lemma orbACA : interchange orb orb. Proof. by do 4!case. Qed. Lemma andbN b : b && ~~ b = false. Proof. by case: b. Qed. Lemma andNb b : ~~ b && b = false. Proof. by case: b. Qed. Lemma orbN b : b || ~~ b = true. Proof. by case: b. Qed. Lemma orNb b : ~~ b || b = true. Proof. by case: b. Qed. Lemma andb_orl : left_distributive andb orb. Proof. by do 3!case. Qed. Lemma andb_orr : right_distributive andb orb. Proof. by do 3!case. Qed. Lemma orb_andl : left_distributive orb andb. Proof. by do 3!case. Qed. Lemma orb_andr : right_distributive orb andb. Proof. by do 3!case. Qed. Lemma andb_idl (a b : bool) : (b -> a) -> a && b = b. Proof. by case: a; case: b => // ->. Qed. Lemma andb_idr (a b : bool) : (a -> b) -> a && b = a. Proof. by case: a; case: b => // ->. Qed. Lemma andb_id2l (a b c : bool) : (a -> b = c) -> a && b = a && c. Proof. by case: a; case: b; case: c => // ->. Qed. Lemma andb_id2r (a b c : bool) : (b -> a = c) -> a && b = c && b. Proof. by case: a; case: b; case: c => // ->. Qed. Lemma orb_idl (a b : bool) : (a -> b) -> a || b = b. Proof. by case: a; case: b => // ->. Qed. Lemma orb_idr (a b : bool) : (b -> a) -> a || b = a. Proof. by case: a; case: b => // ->. Qed. Lemma orb_id2l (a b c : bool) : (~~ a -> b = c) -> a || b = a || c. Proof. by case: a; case: b; case: c => // ->. Qed. Lemma orb_id2r (a b c : bool) : (~~ b -> a = c) -> a || b = c || b. Proof. by case: a; case: b; case: c => // ->. Qed. Lemma negb_and (a b : bool) : ~~ (a && b) = ~~ a || ~~ b. Proof. by case: a; case: b. Qed. Lemma negb_or (a b : bool) : ~~ (a || b) = ~~ a && ~~ b. Proof. by case: a; case: b. Qed. (** Pseudo-cancellation -- i.e, absorption **) Lemma andbK a b : a && b || a = a. Proof. by case: a; case: b. Qed. Lemma andKb a b : a || b && a = a. Proof. by case: a; case: b. Qed. Lemma orbK a b : (a || b) && a = a. Proof. by case: a; case: b. Qed. Lemma orKb a b : a && (b || a) = a. Proof. by case: a; case: b. Qed. (** Imply **) Lemma implybT b : b ==> true. Proof. by case: b. Qed. Lemma implybF b : (b ==> false) = ~~ b. Proof. by case: b. Qed. Lemma implyFb b : false ==> b. Proof. by []. Qed. Lemma implyTb b : (true ==> b) = b. Proof. by []. Qed. Lemma implybb b : b ==> b. Proof. by case: b. Qed. Lemma negb_imply a b : ~~ (a ==> b) = a && ~~ b. Proof. by case: a; case: b. Qed. Lemma implybE a b : (a ==> b) = ~~ a || b. Proof. by case: a; case: b. Qed. Lemma implyNb a b : (~~ a ==> b) = a || b. Proof. by case: a; case: b. Qed. Lemma implybN a b : (a ==> ~~ b) = (b ==> ~~ a). Proof. by case: a; case: b. Qed. Lemma implybNN a b : (~~ a ==> ~~ b) = b ==> a. Proof. by case: a; case: b. Qed. Lemma implyb_idl (a b : bool) : (~~ a -> b) -> (a ==> b) = b. Proof. by case: a; case: b => // ->. Qed. Lemma implyb_idr (a b : bool) : (b -> ~~ a) -> (a ==> b) = ~~ a. Proof. by case: a; case: b => // ->. Qed. Lemma implyb_id2l (a b c : bool) : (a -> b = c) -> (a ==> b) = (a ==> c). Proof. by case: a; case: b; case: c => // ->. Qed. (** Addition (xor) **) Lemma addFb : left_id false addb. Proof. by []. Qed. Lemma addbF : right_id false addb. Proof. by case. Qed. Lemma addbb : self_inverse false addb. Proof. by case. Qed. Lemma addbC : commutative addb. Proof. by do 2!case. Qed. Lemma addbA : associative addb. Proof. by do 3!case. Qed. Lemma addbCA : left_commutative addb. Proof. by do 3!case. Qed. Lemma addbAC : right_commutative addb. Proof. by do 3!case. Qed. Lemma addbACA : interchange addb addb. Proof. by do 4!case. Qed. Lemma andb_addl : left_distributive andb addb. Proof. by do 3!case. Qed. Lemma andb_addr : right_distributive andb addb. Proof. by do 3!case. Qed. Lemma addKb : left_loop id addb. Proof. by do 2!case. Qed. Lemma addbK : right_loop id addb. Proof. by do 2!case. Qed. Lemma addIb : left_injective addb. Proof. by do 3!case. Qed. Lemma addbI : right_injective addb. Proof. by do 3!case. Qed. Lemma addTb b : true (+) b = ~~ b. Proof. by []. Qed. Lemma addbT b : b (+) true = ~~ b. Proof. by case: b. Qed. Lemma addbN a b : a (+) ~~ b = ~~ (a (+) b). Proof. by case: a; case: b. Qed. Lemma addNb a b : ~~ a (+) b = ~~ (a (+) b). Proof. by case: a; case: b. Qed. Lemma addbP a b : reflect (~~ a = b) (a (+) b). Proof. by case: a; case: b; constructor. Qed. Arguments addbP {a b}. (** Resolution tactic for blindly weeding out common terms from boolean equalities. When faced with a goal of the form (andb/orb/addb b1 b2) = b3 they will try to locate b1 in b3 and remove it. This can fail! **) Ltac bool_congr := match goal with | |- (?X1 && ?X2 = ?X3) => first [ symmetry; rewrite -1?(andbC X1) -?(andbCA X1); congr 1 (andb X1); symmetry | case: (X1); [ rewrite ?andTb ?andbT // | by rewrite ?andbF /= ] ] | |- (?X1 || ?X2 = ?X3) => first [ symmetry; rewrite -1?(orbC X1) -?(orbCA X1); congr 1 (orb X1); symmetry | case: (X1); [ by rewrite ?orbT //= | rewrite ?orFb ?orbF ] ] | |- (?X1 (+) ?X2 = ?X3) => symmetry; rewrite -1?(addbC X1) -?(addbCA X1); congr 1 (addb X1); symmetry | |- (~~ ?X1 = ?X2) => congr 1 negb end. (** Predicates, i.e., packaged functions to bool. - pred T, the basic type for predicates over a type T, is simply an alias for T -> bool. We actually distinguish two kinds of predicates, which we call applicative and collective, based on the syntax used to test them at some x in T: - For an applicative predicate P, one uses prefix syntax: P x Also, most operations on applicative predicates use prefix syntax as well (e.g., predI P Q). - For a collective predicate A, one uses infix syntax: x \in A and all operations on collective predicates use infix syntax as well (e.g., #[#predI A & B#]#). There are only two kinds of applicative predicates: - pred T, the alias for T -> bool mentioned above - simpl_pred T, an alias for simpl_fun T bool with a coercion to pred T that auto-simplifies on application (see ssrfun). On the other hand, the set of collective predicate types is open-ended via - predType T, a Structure that can be used to put Canonical collective predicate interpretation on other types, such as lists, tuples, finite sets, etc. Indeed, we define such interpretations for applicative predicate types, which can therefore also be used with the infix syntax, e.g., x \in predI P Q Moreover these infix forms are convertible to their prefix counterpart (e.g., predI P Q x which in turn simplifies to P x && Q x). The converse is not true, however; collective predicate types cannot, in general, be used applicatively, because of restrictions on implicit coercions. However, we do define an explicit generic coercion - mem : forall (pT : predType), pT -> mem_pred T where mem_pred T is a variant of simpl_pred T that preserves the infix syntax, i.e., mem A x auto-simplifies to x \in A. Indeed, the infix "collective" operators are notation for a prefix operator with arguments of type mem_pred T or pred T, applied to coerced collective predicates, e.g., Notation "x \in A" := (in_mem x (mem A)). This prevents the variability in the predicate type from interfering with the application of generic lemmas. Moreover this also makes it much easier to define generic lemmas, because the simplest type -- pred T -- can be used as the type of generic collective predicates, provided one takes care not to use it applicatively; this avoids the burden of having to declare a different predicate type for each predicate parameter of each section or lemma. In detail, we ensure that the head normal form of mem A is always of the eta-long MemPred (fun x => pA x) form, where pA is the pred interpretation of A following its predType pT, i.e., the _expansion_ of topred A. For a pred T evar ?P, (mem ?P) converts MemPred (fun x => ?P x), whose argument is a Miller pattern and therefore always unify: unifying (mem A) with (mem ?P) always yields ?P = pA, because the rigid constant MemPred aligns the unification. Furthermore, we ensure pA is always either A or toP .... A where toP ... is the expansion of @topred T pT, and toP is declared as a Coercion, so pA will _display_ as A in either case, and the instances of @mem T (predPredType T) pA appearing in the premises or right-hand side of a generic lemma parameterized by ?P will be indistinguishable from @mem T pT A. Users should take care not to inadvertently "strip" (mem A) down to the coerced A, since this will expose the internal toP coercion: Coq could then display terms A x that cannot be typed as such. The topredE lemma can be used to restore the x \in A syntax in this case. While -topredE can conversely be used to change x \in P into P x for an applicative P, it is safer to use the inE, unfold_in or and memE lemmas instead, as they do not run the risk of exposing internal coercions. As a consequence it is better to explicitly cast a generic applicative predicate to simpl_pred using the SimplPred constructor when it is used as a collective predicate (see, e.g., Lemma eq_big in bigop). We also sometimes "instantiate" the predType structure by defining a coercion to the sort of the predPredType structure, conveniently denoted {pred T}. This works better for types such as {set T} that have subtypes that coerce to them, since the same coercion will be inserted by the application of mem, or of any lemma that expects a generic collective predicates with type {pred T} := pred_sort (predPredType T) = pred T; thus {pred T} should be the preferred type for generic collective predicate parameters. This device also lets us turn any Type aT : predArgType into the total predicate over that type, i.e., fun _: aT => true. This allows us to write, e.g., ##|'I_n| for the cardinal of the (finite) type of integers less than n. **) (** Boolean predicates. *) Definition pred T := T -> bool. Identity Coercion fun_of_pred : pred >-> Funclass. Definition subpred T (p1 p2 : pred T) := forall x : T, p1 x -> p2 x. (* Notation for some manifest predicates. *) Notation xpred0 := (fun=> false). Notation xpredT := (fun=> true). Notation xpredI := (fun (p1 p2 : pred _) x => p1 x && p2 x). Notation xpredU := (fun (p1 p2 : pred _) x => p1 x || p2 x). Notation xpredC := (fun (p : pred _) x => ~~ p x). Notation xpredD := (fun (p1 p2 : pred _) x => ~~ p2 x && p1 x). Notation xpreim := (fun f (p : pred _) x => p (f x)). (** The packed class interface for pred-like types. **) Structure predType T := PredType {pred_sort :> Type; topred : pred_sort -> pred T}. Definition clone_pred T U := fun pT & @pred_sort T pT -> U => fun toP (pT' := @PredType T U toP) & phant_id pT' pT => pT'. Notation "[ 'predType' 'of' T ]" := (@clone_pred _ T _ id _ id) : form_scope. Canonical predPredType T := PredType (@id (pred T)). Set Warnings "-redundant-canonical-projection". Canonical boolfunPredType T := PredType (@id (T -> bool)). Set Warnings "redundant-canonical-projection". (** The type of abstract collective predicates. While {pred T} is convertible to pred T, it presents the pred_sort coercion class, which crucially does _not_ coerce to Funclass. Term whose type P coerces to {pred T} cannot be applied to arguments, but they _can_ be used as if P had a canonical predType instance, as the coercion will be inserted if the unification P =~= pred_sort ?pT fails, changing the problem into the trivial {pred T} =~= pred_sort ?pT (solution ?pT := predPredType P). Additional benefits of this approach are that any type coercing to P will also inherit this behaviour, and that the coercion will be apparent in the elaborated expression. The latter may be important if the coercion is also a canonical structure projector - see mathcomp/fingroup/fingroup.v. The main drawback of implementing predType by coercion in this way is that the type of the value must be known when the unification constraint is imposed: if we only register the constraint and then later discover later that the expression had type P it will be too late to insert a coercion, whereas a canonical instance of predType for P would have solved the deferred constraint. Finally, definitions, lemmas and sections should use type {pred T} for their generic collective type parameters, as this will make it possible to apply such definitions and lemmas directly to values of types that implement predType by coercion to {pred T} (values of types that implement predType without coercing to {pred T} will have to be coerced explicitly using topred). **) Notation "{ 'pred' T }" := (pred_sort (predPredType T)) : type_scope. (** The type of self-simplifying collective predicates. **) Definition simpl_pred T := simpl_fun T bool. Definition SimplPred {T} (p : pred T) : simpl_pred T := SimplFun p. (** Some simpl_pred constructors. **) Definition pred0 {T} := @SimplPred T xpred0. Definition predT {T} := @SimplPred T xpredT. Definition predI {T} (p1 p2 : pred T) := SimplPred (xpredI p1 p2). Definition predU {T} (p1 p2 : pred T) := SimplPred (xpredU p1 p2). Definition predC {T} (p : pred T) := SimplPred (xpredC p). Definition predD {T} (p1 p2 : pred T) := SimplPred (xpredD p1 p2). Definition preim {aT rT} (f : aT -> rT) (d : pred rT) := SimplPred (xpreim f d). Notation "[ 'pred' : T | E ]" := (SimplPred (fun _ : T => E%B)) : function_scope. Notation "[ 'pred' x | E ]" := (SimplPred (fun x => E%B)) : function_scope. Notation "[ 'pred' x | E1 & E2 ]" := [pred x | E1 && E2 ] : function_scope. Notation "[ 'pred' x : T | E ]" := (SimplPred (fun x : T => E%B)) (only parsing) : function_scope. Notation "[ 'pred' x : T | E1 & E2 ]" := [pred x : T | E1 && E2 ] (only parsing) : function_scope. (** Coercions for simpl_pred. As simpl_pred T values are used both applicatively and collectively we need simpl_pred to coerce to both pred T _and_ {pred T}. However it is undesirable to have two distinct constants for what are essentially identical coercion functions, as this confuses the SSReflect keyed matching algorithm. While the Coq Coercion declarations appear to disallow such Coercion aliasing, it is possible to work around this limitation with a combination of modules and functors, which we do below. In addition we also give a predType instance for simpl_pred, which will be preferred to the {pred T} coercion to solve simpl_pred T =~= pred_sort ?pT constraints; note however that the pred_of_simpl coercion _will_ be used when a simpl_pred T is passed as a {pred T}, since the simplPredType T structure for simpl_pred T is _not_ convertible to predPredType T. **) Module PredOfSimpl. Definition coerce T (sp : simpl_pred T) : pred T := fun_of_simpl sp. End PredOfSimpl. Notation pred_of_simpl := PredOfSimpl.coerce. Coercion pred_of_simpl : simpl_pred >-> pred. Canonical simplPredType T := PredType (@pred_of_simpl T). Module Type PredSortOfSimplSignature. Parameter coerce : forall T, simpl_pred T -> {pred T}. End PredSortOfSimplSignature. Module DeclarePredSortOfSimpl (PredSortOfSimpl : PredSortOfSimplSignature). Coercion PredSortOfSimpl.coerce : simpl_pred >-> pred_sort. End DeclarePredSortOfSimpl. Module Export PredSortOfSimplCoercion := DeclarePredSortOfSimpl PredOfSimpl. (** Type to pred coercion. This lets us use types of sort predArgType as a synonym for their universal predicate. We define this predicate as a simpl_pred T rather than a pred T or a {pred T} so that /= and inE reduce (T x) and x \in T to true, respectively. Unfortunately, this can't be used for existing types like bool whose sort is already fixed (at least, not without redefining bool, true, false and all bool operations and lemmas); we provide syntax to recast a given type in predArgType as a workaround. **) Definition predArgType := Type. Bind Scope type_scope with predArgType. Identity Coercion sort_of_predArgType : predArgType >-> Sortclass. Coercion pred_of_argType (T : predArgType) : simpl_pred T := predT. Notation "{ : T }" := (T%type : predArgType) : type_scope. (** Boolean relations. Simplifying relations follow the coding pattern of 2-argument simplifying functions: the simplifying type constructor is applied to the _last_ argument. This design choice will let the in_simpl component of inE expand membership in simpl_rel as well. We provide an explicit coercion to rel T to avoid eta-expansion during coercion; this coercion self-simplifies so it should be invisible. **) Definition rel T := T -> pred T. Identity Coercion fun_of_rel : rel >-> Funclass. Definition subrel T (r1 r2 : rel T) := forall x y : T, r1 x y -> r2 x y. Definition simpl_rel T := T -> simpl_pred T. Coercion rel_of_simpl T (sr : simpl_rel T) : rel T := fun x : T => sr x. Arguments rel_of_simpl {T} sr x /. Notation xrelU := (fun (r1 r2 : rel _) x y => r1 x y || r2 x y). Notation xrelpre := (fun f (r : rel _) x y => r (f x) (f y)). Definition SimplRel {T} (r : rel T) : simpl_rel T := fun x => SimplPred (r x). Definition relU {T} (r1 r2 : rel T) := SimplRel (xrelU r1 r2). Definition relpre {aT rT} (f : aT -> rT) (r : rel rT) := SimplRel (xrelpre f r). Notation "[ 'rel' x y | E ]" := (SimplRel (fun x y => E%B)) (only parsing) : function_scope. Notation "[ 'rel' x y : T | E ]" := (SimplRel (fun x y : T => E%B)) (only parsing) : function_scope. Lemma subrelUl T (r1 r2 : rel T) : subrel r1 (relU r1 r2). Proof. by move=> x y r1xy; apply/orP; left. Qed. Lemma subrelUr T (r1 r2 : rel T) : subrel r2 (relU r1 r2). Proof. by move=> x y r2xy; apply/orP; right. Qed. (** Variant of simpl_pred specialised to the membership operator. **) Variant mem_pred T := Mem of pred T. (** We mainly declare pred_of_mem as a coercion so that it is not displayed. Similarly to pred_of_simpl, it will usually not be inserted by type inference, as all mem_pred mp =~= pred_sort ?pT unification problems will be solve by the memPredType instance below; pred_of_mem will however be used if a mem_pred T is used as a {pred T}, which is desirable as it will avoid a redundant mem in a collective, e.g., passing (mem A) to a lemma exception a generic collective predicate p : {pred T} and premise x \in P will display a subgoal x \in A rather than x \in mem A. Conversely, pred_of_mem will _not_ if it is used id (mem A) is used applicatively or as a pred T; there the simpl_of_mem coercion defined below will be used, resulting in a subgoal that displays as mem A x by simplifies to x \in A. **) Coercion pred_of_mem {T} mp : {pred T} := let: Mem p := mp in [eta p]. Canonical memPredType T := PredType (@pred_of_mem T). Definition in_mem {T} (x : T) mp := pred_of_mem mp x. Definition eq_mem {T} mp1 mp2 := forall x : T, in_mem x mp1 = in_mem x mp2. Definition sub_mem {T} mp1 mp2 := forall x : T, in_mem x mp1 -> in_mem x mp2. Arguments in_mem {T} x mp : simpl never. Global Typeclasses Opaque eq_mem sub_mem. (** The [simpl_of_mem; pred_of_simpl] path provides a new mem_pred >-> pred coercion, but does _not_ override the pred_of_mem : mem_pred >-> pred_sort explicit coercion declaration above. **) Coercion simpl_of_mem {T} mp := SimplPred (fun x : T => in_mem x mp). Lemma sub_refl T (mp : mem_pred T) : sub_mem mp mp. Proof. by []. Qed. Arguments sub_refl {T mp} [x] mp_x. (** It is essential to interlock the production of the Mem constructor inside the branch of the predType match, to ensure that unifying mem A with Mem [eta ?p] sets ?p := toP A (or ?p := P if toP = id and A = [eta P]), rather than topred pT A, had we put mem A := Mem (topred A). **) 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)) (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. Notation "[ 'in' A ]" := (in_mem^~ (mem A)) (at level 0, format "[ 'in' A ]") : function_scope. Notation "[ 'mem' A ]" := (pred_of_simpl (simpl_of_mem (mem A))) (only parsing) : function_scope. Notation "[ 'predI' A & B ]" := (predI [in A] [in B]) : function_scope. Notation "[ 'predU' A & B ]" := (predU [in A] [in B]) : function_scope. Notation "[ 'predD' A & B ]" := (predD [in A] [in B]) : function_scope. Notation "[ 'predC' A ]" := (predC [in A]) : function_scope. Notation "[ 'preim' f 'of' A ]" := (preim f [in A]) : function_scope. Notation "[ 'pred' x 'in' A ]" := [pred x | x \in A] : function_scope. Notation "[ 'pred' x 'in' A | E ]" := [pred x | x \in A & E] : function_scope. Notation "[ 'pred' x 'in' A | E1 & E2 ]" := [pred x | x \in A & E1 && E2 ] : function_scope. Notation "[ 'rel' x y 'in' A & B | E ]" := [rel x y | (x \in A) && (y \in B) && E] : function_scope. Notation "[ 'rel' x y 'in' A & B ]" := [rel x y | (x \in A) && (y \in B)] : function_scope. Notation "[ 'rel' x y 'in' A | E ]" := [rel x y in A & A | E] : function_scope. Notation "[ 'rel' x y 'in' A ]" := [rel x y in A & A] : function_scope. (** Aliases of pred T that let us tag instances of simpl_pred as applicative or collective, via bespoke coercions. This tagging will give control over the simplification behaviour of inE and other rewriting lemmas below. For this control to work it is crucial that collective_of_simpl _not_ be convertible to either applicative_of_simpl or pred_of_simpl. Indeed they differ here by a commutative conversion (of the match and lambda). **) Definition applicative_pred T := pred T. Definition collective_pred T := pred T. Coercion applicative_pred_of_simpl T (sp : simpl_pred T) : applicative_pred T := fun_of_simpl sp. Coercion collective_pred_of_simpl T (sp : simpl_pred T) : collective_pred T := let: SimplFun p := sp in p. (** Explicit simplification rules for predicate application and membership. **) Section PredicateSimplification. Variables T : Type. Implicit Types (p : pred T) (pT : predType T) (sp : simpl_pred T). Implicit Types (mp : mem_pred T). (** The following four bespoke structures provide fine-grained control over matching the various predicate forms. While all four follow a common pattern of using a canonical projection to match a particular form of predicate (in pred T, simpl_pred, mem_pred and mem_pred, respectively), and display the matched predicate in the structure type, each is in fact used for a different, specific purpose: - registered_applicative_pred: this user-facing structure is used to declare values of type pred T meant to be used applicatively. The structure parameter merely displays this same value, and is used to avoid undesirable, visible occurrence of the structure in the right hand side of rewrite rules such as app_predE. There is a canonical instance of registered_applicative_pred for values of the applicative_of_simpl coercion, which handles the Definition Apred : applicative_pred T := [pred x | ...] idiom. This instance is mainly intended for the in_applicative component of inE, in conjunction with manifest_mem_pred and applicative_mem_pred. - manifest_simpl_pred: the only instance of this structure matches manifest simpl_pred values of the form SimplPred p, displaying p in the structure type. This structure is used in in_simpl to detect and selectively expand collective predicates of this form. An explicit SimplPred p pattern would _NOT_ work for this purpose, as then the left-hand side of in_simpl would reduce to in_mem ?x (Mem [eta ?p]) and would thus match _any_ instance of \in, not just those arising from a manifest simpl_pred. - manifest_mem_pred: similar to manifest_simpl_pred, the one instance of this structure matches manifest mem_pred values of the form Mem [eta ?p]. The purpose is different however: to match and display in ?p the actual predicate appearing in an ... \in ... expression matched by the left hand side of the in_applicative component of inE; then - applicative_mem_pred is a telescope refinement of manifest_mem_pred p with a default constructor that checks that the predicate p is the value of a registered_applicative_pred; any unfolding occurring during this check does _not_ affect the value of p passed to in_applicative, since that has been fixed earlier by the manifest_mem_pred match. In particular the definition of a predicate using the applicative_pred_of_simpl idiom above will not be expanded - this very case is the reason in_applicative uses a mem_pred telescope in its left hand side. The more straightforward ?x \in applicative_pred_value ?ap (equivalent to in_mem ?x (Mem ?ap)) with ?ap : registered_applicative_pred ?p would set ?p := [pred x | ...] rather than ?p := Apred in the example above. Also note that the in_applicative component of inE must be come before the in_simpl one, as the latter also matches terms of the form x \in Apred. Finally, no component of inE matches x \in Acoll, when Definition Acoll : collective_pred T := [pred x | ...]. as the collective_pred_of_simpl is _not_ convertible to pred_of_simpl. **) Structure registered_applicative_pred p := RegisteredApplicativePred { applicative_pred_value :> pred T; _ : applicative_pred_value = p }. Definition ApplicativePred p := RegisteredApplicativePred (erefl p). Canonical applicative_pred_applicative sp := ApplicativePred (applicative_pred_of_simpl sp). Structure manifest_simpl_pred p := ManifestSimplPred { simpl_pred_value :> simpl_pred T; _ : simpl_pred_value = SimplPred p }. Canonical expose_simpl_pred p := ManifestSimplPred (erefl (SimplPred p)). Structure manifest_mem_pred p := ManifestMemPred { mem_pred_value :> mem_pred T; _ : mem_pred_value = Mem [eta p] }. Canonical expose_mem_pred p := ManifestMemPred (erefl (Mem [eta p])). Structure applicative_mem_pred p := ApplicativeMemPred {applicative_mem_pred_value :> manifest_mem_pred p}. Canonical check_applicative_mem_pred p (ap : registered_applicative_pred p) := [eta @ApplicativeMemPred ap]. Lemma mem_topred pT (pp : pT) : mem (topred pp) = mem pp. Proof. by case: pT pp. Qed. Lemma topredE pT x (pp : pT) : topred pp x = (x \in pp). Proof. by rewrite -mem_topred. Qed. Lemma app_predE x p (ap : registered_applicative_pred p) : ap x = (x \in p). Proof. by case: ap => _ /= ->. Qed. Lemma in_applicative x p (amp : applicative_mem_pred p) : in_mem x amp = p x. Proof. by case: amp => -[_ /= ->]. Qed. Lemma in_collective x p (msp : manifest_simpl_pred p) : (x \in collective_pred_of_simpl msp) = p x. Proof. by case: msp => _ /= ->. Qed. Lemma in_simpl x p (msp : manifest_simpl_pred p) : in_mem x (Mem [eta pred_of_simpl msp]) = p x. Proof. by case: msp => _ /= ->. Qed. (** Because of the explicit eta expansion in the left-hand side, this lemma should only be used in the left-to-right direction. **) Lemma unfold_in x p : (x \in ([eta p] : pred T)) = p x. Proof. by []. Qed. Lemma simpl_predE p : SimplPred p =1 p. Proof. by []. Qed. Definition inE := (in_applicative, in_simpl, simpl_predE). (* to be extended *) Lemma mem_simpl sp : mem sp = sp :> pred T. Proof. by []. Qed. Definition memE := mem_simpl. (* could be extended *) Lemma mem_mem mp : (mem mp = mp) * (mem (mp : simpl_pred T) = mp) * (mem (mp : pred T) = mp). Proof. by case: mp. Qed. End PredicateSimplification. (** Qualifiers and keyed predicates. **) Variant qualifier (q : nat) T := Qualifier of {pred T}. Coercion has_quality n T (q : qualifier n T) : {pred T} := fun x => let: Qualifier _ p := q in p x. 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) (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. Notation "[ 'qualify' x | P ]" := (Qualifier 0 (fun x => P%B)) : form_scope. Notation "[ 'qualify' x : T | P ]" := (Qualifier 0 (fun x : T => P%B)) (only parsing) : form_scope. Notation "[ 'qualify' 'a' x | P ]" := (Qualifier 1 (fun x => P%B)) : form_scope. Notation "[ 'qualify' 'a' x : T | P ]" := (Qualifier 1 (fun x : T => P%B)) (only parsing) : form_scope. Notation "[ 'qualify' 'an' x | P ]" := (Qualifier 2 (fun x => P%B)) : form_scope. Notation "[ 'qualify' 'an' x : T | P ]" := (Qualifier 2 (fun x : T => P%B)) (only parsing) : form_scope. (** Keyed predicates: support for property-bearing predicate interfaces. **) Section KeyPred. Variable T : Type. Variant pred_key (p : {pred T}) : Prop := DefaultPredKey. Variable p : {pred T}. Structure keyed_pred (k : pred_key p) := PackKeyedPred {unkey_pred :> {pred T}; _ : unkey_pred =i p}. Variable k : pred_key p. Definition KeyedPred := @PackKeyedPred k p (frefl _). Variable k_p : keyed_pred k. Lemma keyed_predE : k_p =i p. Proof. by case: k_p. Qed. (** Instances that strip the mem cast; the first one has "pred_of_mem" as its projection head value, while the second has "pred_of_simpl". The latter has the side benefit of preempting accidental misdeclarations. Note: pred_of_mem is the registered mem >-> pred_sort coercion, while [simpl_of_mem; pred_of_simpl] is the mem >-> pred >=> Funclass coercion. We must write down the coercions explicitly as the Canonical head constant computation does not strip casts. **) Canonical keyed_mem := @PackKeyedPred k (pred_of_mem (mem k_p)) keyed_predE. Canonical keyed_mem_simpl := @PackKeyedPred k (pred_of_simpl (mem k_p)) keyed_predE. End KeyPred. Local Notation in_unkey x S := (x \in @unkey_pred _ S _ _) (only parsing). Notation "x \in S" := (in_unkey x S) (only printing) : bool_scope. Section KeyedQualifier. Variables (T : Type) (n : nat) (q : qualifier n T). Structure keyed_qualifier (k : pred_key q) := PackKeyedQualifier {unkey_qualifier; _ : unkey_qualifier = q}. Definition KeyedQualifier k := PackKeyedQualifier k (erefl q). Variables (k : pred_key q) (k_q : keyed_qualifier k). Fact keyed_qualifier_suproof : unkey_qualifier k_q =i q. Proof. by case: k_q => /= _ ->. Qed. Canonical keyed_qualifier_keyed := PackKeyedPred k keyed_qualifier_suproof. End KeyedQualifier. Notation "x \is A" := (in_unkey x (has_quality 0 A)) (only printing) : bool_scope. Notation "x \is 'a' A" := (in_unkey x (has_quality 1 A)) (only printing) : bool_scope. Notation "x \is 'an' A" := (in_unkey x (has_quality 2 A)) (only printing) : bool_scope. Module DefaultKeying. Canonical default_keyed_pred T p := KeyedPred (@DefaultPredKey T p). Canonical default_keyed_qualifier T n (q : qualifier n T) := KeyedQualifier (DefaultPredKey q). End DefaultKeying. (** Skolemizing with conditions. **) Lemma all_tag_cond_dep I T (C : pred I) U : (forall x, T x) -> (forall x, C x -> {y : T x & U x y}) -> {f : forall x, T x & forall x, C x -> U x (f x)}. Proof. move=> f0 fP; apply: all_tag (fun x y => C x -> U x y) _ => x. by case Cx: (C x); [case/fP: Cx => y; exists y | exists (f0 x)]. Qed. Lemma all_tag_cond I T (C : pred I) U : T -> (forall x, C x -> {y : T & U x y}) -> {f : I -> T & forall x, C x -> U x (f x)}. Proof. by move=> y0; apply: all_tag_cond_dep. Qed. Lemma all_sig_cond_dep I T (C : pred I) P : (forall x, T x) -> (forall x, C x -> {y : T x | P x y}) -> {f : forall x, T x | forall x, C x -> P x (f x)}. Proof. by move=> f0 /(all_tag_cond_dep f0)[f]; exists f. Qed. Lemma all_sig_cond I T (C : pred I) P : T -> (forall x, C x -> {y : T | P x y}) -> {f : I -> T | forall x, C x -> P x (f x)}. Proof. by move=> y0; apply: all_sig_cond_dep. Qed. Lemma all_sig2_cond {I T} (C : pred I) P Q : T -> (forall x, C x -> {y : T | P x y & Q x y}) -> {f : I -> T | forall x, C x -> P x (f x) & forall x, C x -> Q x (f x)}. Proof. by move=> /all_sig_cond/[apply]-[f Pf]; exists f => i Di; have [] := Pf i Di. Qed. Section RelationProperties. (** Caveat: reflexive should not be used to state lemmas, as auto and trivial will not expand the constant. **) Variable T : Type. Variable R : rel T. Definition total := forall x y, R x y || R y x. Definition transitive := forall y x z, R x y -> R y z -> R x z. Definition symmetric := forall x y, R x y = R y x. Definition antisymmetric := forall x y, R x y && R y x -> x = y. Definition pre_symmetric := forall x y, R x y -> R y x. Lemma symmetric_from_pre : pre_symmetric -> symmetric. Proof. by move=> symR x y; apply/idP/idP; apply: symR. Qed. Definition reflexive := forall x, R x x. Definition irreflexive := forall x, R x x = false. Definition left_transitive := forall x y, R x y -> R x =1 R y. Definition right_transitive := forall x y, R x y -> R^~ x =1 R^~ y. Section PER. Hypotheses (symR : symmetric) (trR : transitive). Lemma sym_left_transitive : left_transitive. Proof. by move=> x y Rxy z; apply/idP/idP; apply: trR; rewrite // symR. Qed. Lemma sym_right_transitive : right_transitive. Proof. by move=> x y /sym_left_transitive Rxy z; rewrite !(symR z) Rxy. Qed. End PER. (** We define the equivalence property with prenex quantification so that it can be localized using the {in ..., ..} form defined below. **) Definition equivalence_rel := forall x y z, R z z * (R x y -> R x z = R y z). Lemma equivalence_relP : equivalence_rel <-> reflexive /\ left_transitive. Proof. split=> [eqiR | [Rxx trR] x y z]; last by split=> [|/trR->]. by split=> [x | x y Rxy z]; [rewrite (eqiR x x x) | rewrite (eqiR x y z)]. Qed. End RelationProperties. Lemma rev_trans T (R : rel T) : transitive R -> transitive (fun x y => R y x). Proof. by move=> trR x y z Ryx Rzy; apply: trR Rzy Ryx. Qed. (** Property localization **) Local Notation "{ 'all1' P }" := (forall x, P x : Prop) (at level 0). Local Notation "{ 'all2' P }" := (forall x y, P x y : Prop) (at level 0). Local Notation "{ 'all3' P }" := (forall x y z, P x y z: Prop) (at level 0). Local Notation ph := (phantom _). Section LocalProperties. Variables T1 T2 T3 : Type. Variables (d1 : mem_pred T1) (d2 : mem_pred T2) (d3 : mem_pred T3). Local Notation ph := (phantom Prop). Definition prop_for (x : T1) P & ph {all1 P} := P x. Lemma forE x P phP : @prop_for x P phP = P x. Proof. by []. Qed. Definition prop_in1 P & ph {all1 P} := forall x, in_mem x d1 -> P x. Definition prop_in11 P & ph {all2 P} := forall x y, in_mem x d1 -> in_mem y d2 -> P x y. Definition prop_in2 P & ph {all2 P} := forall x y, in_mem x d1 -> in_mem y d1 -> P x y. Definition prop_in111 P & ph {all3 P} := forall x y z, in_mem x d1 -> in_mem y d2 -> in_mem z d3 -> P x y z. Definition prop_in12 P & ph {all3 P} := forall x y z, in_mem x d1 -> in_mem y d2 -> in_mem z d2 -> P x y z. Definition prop_in21 P & ph {all3 P} := forall x y z, in_mem x d1 -> in_mem y d1 -> in_mem z d2 -> P x y z. Definition prop_in3 P & ph {all3 P} := forall x y z, in_mem x d1 -> in_mem y d1 -> in_mem z d1 -> P x y z. Variable f : T1 -> T2. Definition prop_on1 Pf P & phantom T3 (Pf f) & ph {all1 P} := forall x, in_mem (f x) d2 -> P x. Definition prop_on2 Pf P & phantom T3 (Pf f) & ph {all2 P} := forall x y, in_mem (f x) d2 -> in_mem (f y) d2 -> P x y. End LocalProperties. Definition inPhantom := Phantom Prop. Definition onPhantom {T} P (x : T) := Phantom Prop (P x). Definition bijective_in aT rT (d : mem_pred aT) (f : aT -> rT) := exists2 g, prop_in1 d (inPhantom (cancel f g)) & prop_on1 d (Phantom _ (cancel g)) (onPhantom (cancel g) f). Definition bijective_on aT rT (cd : mem_pred rT) (f : aT -> rT) := exists2 g, prop_on1 cd (Phantom _ (cancel f)) (onPhantom (cancel f) g) & prop_in1 cd (inPhantom (cancel g f)). Notation "{ 'for' x , P }" := (prop_for x (inPhantom P)) : type_scope. Notation "{ 'in' d , P }" := (prop_in1 (mem d) (inPhantom P)) : type_scope. Notation "{ 'in' d1 & d2 , P }" := (prop_in11 (mem d1) (mem d2) (inPhantom P)) : type_scope. Notation "{ 'in' d & , P }" := (prop_in2 (mem d) (inPhantom P)) : type_scope. Notation "{ 'in' d1 & d2 & d3 , P }" := (prop_in111 (mem d1) (mem d2) (mem d3) (inPhantom P)) : type_scope. Notation "{ 'in' d1 & & d3 , P }" := (prop_in21 (mem d1) (mem d3) (inPhantom P)) : type_scope. Notation "{ 'in' d1 & d2 & , P }" := (prop_in12 (mem d1) (mem d2) (inPhantom P)) : type_scope. Notation "{ 'in' d & & , P }" := (prop_in3 (mem d) (inPhantom P)) : type_scope. Notation "{ 'on' cd , P }" := (prop_on1 (mem cd) (inPhantom P) (inPhantom P)) : type_scope. Notation "{ 'on' cd & , P }" := (prop_on2 (mem cd) (inPhantom P) (inPhantom P)) : type_scope. Local Arguments onPhantom : clear scopes. Notation "{ 'on' cd , P & g }" := (prop_on1 (mem cd) (Phantom (_ -> Prop) P) (onPhantom P g)) : type_scope. Notation "{ 'in' d , 'bijective' f }" := (bijective_in (mem d) f) : type_scope. Notation "{ 'on' cd , 'bijective' f }" := (bijective_on (mem cd) f) : type_scope. (** Weakening and monotonicity lemmas for localized predicates. Note that using these lemmas in backward reasoning will force expansion of the predicate definition, as Coq needs to expose the quantifier to apply these lemmas. We define a few specialized variants to avoid this for some of the ssrfun predicates. **) Section LocalGlobal. Variables T1 T2 T3 : predArgType. Variables (D1 : {pred T1}) (D2 : {pred T2}) (D3 : {pred T3}). Variables (d1 d1' : mem_pred T1) (d2 d2' : mem_pred T2) (d3 d3' : mem_pred T3). Variables (f f' : T1 -> T2) (g : T2 -> T1) (h : T3). Variables (P1 : T1 -> Prop) (P2 : T1 -> T2 -> Prop). Variable P3 : T1 -> T2 -> T3 -> Prop. Variable Q1 : (T1 -> T2) -> T1 -> Prop. Variable Q1l : (T1 -> T2) -> T3 -> T1 -> Prop. Variable Q2 : (T1 -> T2) -> T1 -> T1 -> Prop. Hypothesis sub1 : sub_mem d1 d1'. Hypothesis sub2 : sub_mem d2 d2'. Hypothesis sub3 : sub_mem d3 d3'. Lemma in1W : {all1 P1} -> {in D1, {all1 P1}}. Proof. by move=> ? ?. Qed. Lemma in2W : {all2 P2} -> {in D1 & D2, {all2 P2}}. Proof. by move=> ? ?. Qed. Lemma in3W : {all3 P3} -> {in D1 & D2 & D3, {all3 P3}}. Proof. by move=> ? ?. Qed. Lemma in1T : {in T1, {all1 P1}} -> {all1 P1}. Proof. by move=> ? ?; auto. Qed. Lemma in2T : {in T1 & T2, {all2 P2}} -> {all2 P2}. Proof. by move=> ? ?; auto. Qed. Lemma in3T : {in T1 & T2 & T3, {all3 P3}} -> {all3 P3}. Proof. by move=> ? ?; auto. Qed. Lemma sub_in1 (Ph : ph {all1 P1}) : prop_in1 d1' Ph -> prop_in1 d1 Ph. Proof. by move=> allP x /sub1; apply: allP. Qed. Lemma sub_in11 (Ph : ph {all2 P2}) : prop_in11 d1' d2' Ph -> prop_in11 d1 d2 Ph. Proof. by move=> allP x1 x2 /sub1 d1x1 /sub2; apply: allP. Qed. Lemma sub_in111 (Ph : ph {all3 P3}) : prop_in111 d1' d2' d3' Ph -> prop_in111 d1 d2 d3 Ph. Proof. by move=> allP x1 x2 x3 /sub1 d1x1 /sub2 d2x2 /sub3; apply: allP. Qed. Let allQ1 f'' := {all1 Q1 f''}. Let allQ1l f'' h' := {all1 Q1l f'' h'}. Let allQ2 f'' := {all2 Q2 f''}. Lemma on1W : allQ1 f -> {on D2, allQ1 f}. Proof. by move=> ? ?. Qed. Lemma on1lW : allQ1l f h -> {on D2, allQ1l f & h}. Proof. by move=> ? ?. Qed. Lemma on2W : allQ2 f -> {on D2 &, allQ2 f}. Proof. by move=> ? ?. Qed. Lemma on1T : {on T2, allQ1 f} -> allQ1 f. Proof. by move=> ? ?; auto. Qed. Lemma on1lT : {on T2, allQ1l f & h} -> allQ1l f h. Proof. by move=> ? ?; auto. Qed. Lemma on2T : {on T2 &, allQ2 f} -> allQ2 f. Proof. by move=> ? ?; auto. Qed. Lemma subon1 (Phf : ph (allQ1 f)) (Ph : ph (allQ1 f)) : prop_on1 d2' Phf Ph -> prop_on1 d2 Phf Ph. Proof. by move=> allQ x /sub2; apply: allQ. Qed. Lemma subon1l (Phf : ph (allQ1l f)) (Ph : ph (allQ1l f h)) : prop_on1 d2' Phf Ph -> prop_on1 d2 Phf Ph. Proof. by move=> allQ x /sub2; apply: allQ. Qed. Lemma subon2 (Phf : ph (allQ2 f)) (Ph : ph (allQ2 f)) : prop_on2 d2' Phf Ph -> prop_on2 d2 Phf Ph. Proof. by move=> allQ x y /sub2=> d2fx /sub2; apply: allQ. Qed. Lemma can_in_inj : {in D1, cancel f g} -> {in D1 &, injective f}. Proof. by move=> fK x y /fK{2}<- /fK{2}<- ->. Qed. Lemma canLR_in x y : {in D1, cancel f g} -> y \in D1 -> x = f y -> g x = y. Proof. by move=> fK D1y ->; rewrite fK. Qed. Lemma canRL_in x y : {in D1, cancel f g} -> x \in D1 -> f x = y -> x = g y. Proof. by move=> fK D1x <-; rewrite fK. Qed. Lemma on_can_inj : {on D2, cancel f & g} -> {on D2 &, injective f}. Proof. by move=> fK x y /fK{2}<- /fK{2}<- ->. Qed. Lemma canLR_on x y : {on D2, cancel f & g} -> f y \in D2 -> x = f y -> g x = y. Proof. by move=> fK D2fy ->; rewrite fK. Qed. Lemma canRL_on x y : {on D2, cancel f & g} -> f x \in D2 -> f x = y -> x = g y. Proof. by move=> fK D2fx <-; rewrite fK. Qed. Lemma inW_bij : bijective f -> {in D1, bijective f}. Proof. by case=> g' fK g'K; exists g' => * ? *; auto. Qed. Lemma onW_bij : bijective f -> {on D2, bijective f}. Proof. by case=> g' fK g'K; exists g' => * ? *; auto. Qed. Lemma inT_bij : {in T1, bijective f} -> bijective f. Proof. by case=> g' fK g'K; exists g' => * ? *; auto. Qed. Lemma onT_bij : {on T2, bijective f} -> bijective f. Proof. by case=> g' fK g'K; exists g' => * ? *; auto. Qed. Lemma sub_in_bij (D1' : pred T1) : {subset D1 <= D1'} -> {in D1', bijective f} -> {in D1, bijective f}. Proof. by move=> subD [g' fK g'K]; exists g' => x; move/subD; [apply: fK | apply: g'K]. Qed. Lemma subon_bij (D2' : pred T2) : {subset D2 <= D2'} -> {on D2', bijective f} -> {on D2, bijective f}. Proof. by move=> subD [g' fK g'K]; exists g' => x; move/subD; [apply: fK | apply: g'K]. Qed. Lemma in_on1P : {in D1, {on D2, allQ1 f}} <-> {in [pred x in D1 | f x \in D2], allQ1 f}. Proof. split => allf x; have := allf x; rewrite inE => Q1f; first by case/andP. by move=> ? ?; apply: Q1f; apply/andP. Qed. Lemma in_on1lP : {in D1, {on D2, allQ1l f & h}} <-> {in [pred x in D1 | f x \in D2], allQ1l f h}. Proof. split => allf x; have := allf x; rewrite inE => Q1f; first by case/andP. by move=> ? ?; apply: Q1f; apply/andP. Qed. Lemma in_on2P : {in D1 &, {on D2 &, allQ2 f}} <-> {in [pred x in D1 | f x \in D2] &, allQ2 f}. Proof. split => allf x y; have := allf x y; rewrite !inE => Q2f. by move=> /andP[? ?] /andP[? ?]; apply: Q2f. by move=> ? ? ? ?; apply: Q2f; apply/andP. Qed. Lemma on1W_in : {in D1, allQ1 f} -> {in D1, {on D2, allQ1 f}}. Proof. by move=> D1f ? /D1f. Qed. Lemma on1lW_in : {in D1, allQ1l f h} -> {in D1, {on D2, allQ1l f & h}}. Proof. by move=> D1f ? /D1f. Qed. Lemma on2W_in : {in D1 &, allQ2 f} -> {in D1 &, {on D2 &, allQ2 f}}. Proof. by move=> D1f ? ? ? ? ? ?; apply: D1f. Qed. Lemma in_on1W : allQ1 f -> {in D1, {on D2, allQ1 f}}. Proof. by move=> allf ? ? ?; apply: allf. Qed. Lemma in_on1lW : allQ1l f h -> {in D1, {on D2, allQ1l f & h}}. Proof. by move=> allf ? ? ?; apply: allf. Qed. Lemma in_on2W : allQ2 f -> {in D1 &, {on D2 &, allQ2 f}}. Proof. by move=> allf ? ? ? ? ? ?; apply: allf. Qed. Lemma on1S : (forall x, f x \in D2) -> {on D2, allQ1 f} -> allQ1 f. Proof. by move=> ? fD1 ?; apply: fD1. Qed. Lemma on1lS : (forall x, f x \in D2) -> {on D2, allQ1l f & h} -> allQ1l f h. Proof. by move=> ? fD1 ?; apply: fD1. Qed. Lemma on2S : (forall x, f x \in D2) -> {on D2 &, allQ2 f} -> allQ2 f. Proof. by move=> ? fD1 ? ?; apply: fD1. Qed. Lemma on1S_in : {homo f : x / x \in D1 >-> x \in D2} -> {in D1, {on D2, allQ1 f}} -> {in D1, allQ1 f}. Proof. by move=> fD fD1 ? ?; apply/fD1/fD. Qed. Lemma on1lS_in : {homo f : x / x \in D1 >-> x \in D2} -> {in D1, {on D2, allQ1l f & h}} -> {in D1, allQ1l f h}. Proof. by move=> fD fD1 ? ?; apply/fD1/fD. Qed. Lemma on2S_in : {homo f : x / x \in D1 >-> x \in D2} -> {in D1 &, {on D2 &, allQ2 f}} -> {in D1 &, allQ2 f}. Proof. by move=> fD fD1 ? ? ? ?; apply: fD1 => //; apply: fD. Qed. Lemma in_on1S : (forall x, f x \in D2) -> {in T1, {on D2, allQ1 f}} -> allQ1 f. Proof. by move=> fD2 fD1 ?; apply: fD1. Qed. Lemma in_on1lS : (forall x, f x \in D2) -> {in T1, {on D2, allQ1l f & h}} -> allQ1l f h. Proof. by move=> fD2 fD1 ?; apply: fD1. Qed. Lemma in_on2S : (forall x, f x \in D2) -> {in T1 &, {on D2 &, allQ2 f}} -> allQ2 f. Proof. by move=> fD2 fD1 ? ?; apply: fD1. Qed. End LocalGlobal. Arguments in_on1P {T1 T2 D1 D2 f Q1}. Arguments in_on1lP {T1 T2 T3 D1 D2 f h Q1l}. Arguments in_on2P {T1 T2 D1 D2 f Q2}. Arguments on1W_in {T1 T2 D1} D2 {f Q1}. Arguments on1lW_in {T1 T2 T3 D1} D2 {f h Q1l}. Arguments on2W_in {T1 T2 D1} D2 {f Q2}. Arguments in_on1W {T1 T2} D1 D2 {f Q1}. Arguments in_on1lW {T1 T2 T3} D1 D2 {f h Q1l}. Arguments in_on2W {T1 T2} D1 D2 {f Q2}. Arguments on1S {T1 T2} D2 {f Q1}. Arguments on1lS {T1 T2 T3} D2 {f h Q1l}. Arguments on2S {T1 T2} D2 {f Q2}. Arguments on1S_in {T1 T2 D1} D2 {f Q1}. Arguments on1lS_in {T1 T2 T3 D1} D2 {f h Q1l}. Arguments on2S_in {T1 T2 D1} D2 {f Q2}. Arguments in_on1S {T1 T2} D2 {f Q1}. Arguments in_on1lS {T1 T2 T3} D2 {f h Q1l}. Arguments in_on2S {T1 T2} D2 {f Q2}. Lemma can_in_pcan [rT aT : Type] (A : {pred aT}) [f : aT -> rT] [g : rT -> aT] : {in A, cancel f g} -> {in A, pcancel f (fun y : rT => Some (g y))}. Proof. by move=> fK x Ax; rewrite fK. Qed. Lemma pcan_in_inj [rT aT : Type] [A : {pred aT}] [f : aT -> rT] [g : rT -> option aT] : {in A, pcancel f g} -> {in A &, injective f}. Proof. by move=> fK x y Ax Ay /(congr1 g); rewrite !fK// => -[]. Qed. Lemma in_inj_comp A B C (f : B -> A) (h : C -> B) (P : pred B) (Q : pred C) : {in P &, injective f} -> {in Q &, injective h} -> {homo h : x / Q x >-> P x} -> {in Q &, injective (f \o h)}. Proof. by move=> Pf Qh QP x y xQ yQ xy; apply Qh => //; apply Pf => //; apply QP. Qed. Lemma can_in_comp [A B C : Type] (D : {pred B}) (D' : {pred C}) [f : B -> A] [h : C -> B] [f' : A -> B] [h' : B -> C] : {homo h : x / x \in D' >-> x \in D} -> {in D, cancel f f'} -> {in D', cancel h h'} -> {in D', cancel (f \o h) (h' \o f')}. Proof. by move=> hD fK hK c cD /=; rewrite fK ?hK ?hD. Qed. Lemma pcan_in_comp [A B C : Type] (D : {pred B}) (D' : {pred C}) [f : B -> A] [h : C -> B] [f' : A -> option B] [h' : B -> option C] : {homo h : x / x \in D' >-> x \in D} -> {in D, pcancel f f'} -> {in D', pcancel h h'} -> {in D', pcancel (f \o h) (obind h' \o f')}. Proof. by move=> hD fK hK c cD /=; rewrite fK/= ?hK ?hD. Qed. Definition pred_oapp T (D : {pred T}) : pred (option T) := [pred x | oapp (mem D) false x]. Lemma ocan_in_comp [A B C : Type] (D : {pred B}) (D' : {pred C}) [f : B -> option A] [h : C -> option B] [f' : A -> B] [h' : B -> C] : {homo h : x / x \in D' >-> x \in pred_oapp D} -> {in D, ocancel f f'} -> {in D', ocancel h h'} -> {in D', ocancel (obind f \o h) (h' \o f')}. Proof. move=> hD fK hK c cD /=; rewrite -[RHS]hK/=; case hcE : (h c) => [b|]//=. have bD : b \in D by have := hD _ cD; rewrite hcE inE. by rewrite -[b in RHS]fK; case: (f b) => //=; have /hK := cD; rewrite hcE. Qed. Section in_sig. Variables T1 T2 T3 : Type. Variables (D1 : {pred T1}) (D2 : {pred T2}) (D3 : {pred T3}). Variable P1 : T1 -> Prop. Variable P2 : T1 -> T2 -> Prop. Variable P3 : T1 -> T2 -> T3 -> Prop. Lemma in1_sig : {in D1, {all1 P1}} -> forall x : sig D1, P1 (sval x). Proof. by move=> DP [x Dx]; have := DP _ Dx. Qed. Lemma in2_sig : {in D1 & D2, {all2 P2}} -> forall (x : sig D1) (y : sig D2), P2 (sval x) (sval y). Proof. by move=> DP [x Dx] [y Dy]; have := DP _ _ Dx Dy. Qed. Lemma in3_sig : {in D1 & D2 & D3, {all3 P3}} -> forall (x : sig D1) (y : sig D2) (z : sig D3), P3 (sval x) (sval y) (sval z). Proof. by move=> DP [x Dx] [y Dy] [z Dz]; have := DP _ _ _ Dx Dy Dz. Qed. End in_sig. Arguments in1_sig {T1 D1 P1}. Arguments in2_sig {T1 T2 D1 D2 P2}. Arguments in3_sig {T1 T2 T3 D1 D2 D3 P3}. Lemma sub_in2 T d d' (P : T -> T -> Prop) : sub_mem d d' -> forall Ph : ph {all2 P}, prop_in2 d' Ph -> prop_in2 d Ph. Proof. by move=> /= sub_dd'; apply: sub_in11. Qed. Lemma sub_in3 T d d' (P : T -> T -> T -> Prop) : sub_mem d d' -> forall Ph : ph {all3 P}, prop_in3 d' Ph -> prop_in3 d Ph. Proof. by move=> /= sub_dd'; apply: sub_in111. Qed. Lemma sub_in12 T1 T d1 d1' d d' (P : T1 -> T -> T -> Prop) : sub_mem d1 d1' -> sub_mem d d' -> forall Ph : ph {all3 P}, prop_in12 d1' d' Ph -> prop_in12 d1 d Ph. Proof. by move=> /= sub1 sub; apply: sub_in111. Qed. Lemma sub_in21 T T3 d d' d3 d3' (P : T -> T -> T3 -> Prop) : sub_mem d d' -> sub_mem d3 d3' -> forall Ph : ph {all3 P}, prop_in21 d' d3' Ph -> prop_in21 d d3 Ph. Proof. by move=> /= sub sub3; apply: sub_in111. Qed. Lemma equivalence_relP_in T (R : rel T) (A : pred T) : {in A & &, equivalence_rel R} <-> {in A, reflexive R} /\ {in A &, forall x y, R x y -> {in A, R x =1 R y}}. Proof. split=> [eqiR | [Rxx trR] x y z *]; last by split=> [|/trR-> //]; apply: Rxx. by split=> [x Ax|x y Ax Ay Rxy z Az]; [rewrite (eqiR x x) | rewrite (eqiR x y)]. Qed. Section MonoHomoMorphismTheory. Variables (aT rT sT : Type) (f : aT -> rT) (g : rT -> aT). Variables (aP : pred aT) (rP : pred rT) (aR : rel aT) (rR : rel rT). Lemma monoW : {mono f : x / aP x >-> rP x} -> {homo f : x / aP x >-> rP x}. Proof. by move=> hf x ax; rewrite hf. Qed. Lemma mono2W : {mono f : x y / aR x y >-> rR x y} -> {homo f : x y / aR x y >-> rR x y}. Proof. by move=> hf x y axy; rewrite hf. Qed. Hypothesis fgK : cancel g f. Lemma homoRL : {homo f : x y / aR x y >-> rR x y} -> forall x y, aR (g x) y -> rR x (f y). Proof. by move=> Hf x y /Hf; rewrite fgK. Qed. Lemma homoLR : {homo f : x y / aR x y >-> rR x y} -> forall x y, aR x (g y) -> rR (f x) y. Proof. by move=> Hf x y /Hf; rewrite fgK. Qed. Lemma homo_mono : {homo f : x y / aR x y >-> rR x y} -> {homo g : x y / rR x y >-> aR x y} -> {mono g : x y / rR x y >-> aR x y}. Proof. move=> mf mg x y; case: (boolP (rR _ _))=> [/mg //|]. by apply: contraNF=> /mf; rewrite !fgK. Qed. Lemma monoLR : {mono f : x y / aR x y >-> rR x y} -> forall x y, rR (f x) y = aR x (g y). Proof. by move=> mf x y; rewrite -{1}[y]fgK mf. Qed. Lemma monoRL : {mono f : x y / aR x y >-> rR x y} -> forall x y, rR x (f y) = aR (g x) y. Proof. by move=> mf x y; rewrite -{1}[x]fgK mf. Qed. Lemma can_mono : {mono f : x y / aR x y >-> rR x y} -> {mono g : x y / rR x y >-> aR x y}. Proof. by move=> mf x y /=; rewrite -mf !fgK. Qed. End MonoHomoMorphismTheory. Section MonoHomoMorphismTheory_in. Variables (aT rT : predArgType) (f : aT -> rT) (g : rT -> aT). Variables (aD : {pred aT}) (rD : {pred rT}). Variable (aP : pred aT) (rP : pred rT) (aR : rel aT) (rR : rel rT). Lemma mono1W_in : {in aD, {mono f : x / aP x >-> rP x}} -> {in aD, {homo f : x / aP x >-> rP x}}. Proof. by move=> hf x hx ax; rewrite hf. Qed. #[deprecated(since="Coq 8.16", note="Use mono1W_in instead.")] Notation mono2W_in := mono1W_in. Lemma monoW_in : {in aD &, {mono f : x y / aR x y >-> rR x y}} -> {in aD &, {homo f : x y / aR x y >-> rR x y}}. Proof. by move=> hf x y hx hy axy; rewrite hf. Qed. Hypothesis fgK : {in rD, {on aD, cancel g & f}}. Hypothesis mem_g : {homo g : x / x \in rD >-> x \in aD}. Lemma homoRL_in : {in aD &, {homo f : x y / aR x y >-> rR x y}} -> {in rD & aD, forall x y, aR (g x) y -> rR x (f y)}. Proof. by move=> Hf x y hx hy /Hf; rewrite fgK ?mem_g// ?inE; apply. Qed. Lemma homoLR_in : {in aD &, {homo f : x y / aR x y >-> rR x y}} -> {in aD & rD, forall x y, aR x (g y) -> rR (f x) y}. Proof. by move=> Hf x y hx hy /Hf; rewrite fgK ?mem_g// ?inE; apply. Qed. Lemma homo_mono_in : {in aD &, {homo f : x y / aR x y >-> rR x y}} -> {in rD &, {homo g : x y / rR x y >-> aR x y}} -> {in rD &, {mono g : x y / rR x y >-> aR x y}}. Proof. move=> mf mg x y hx hy; case: (boolP (rR _ _))=> [/mg //|]; first exact. by apply: contraNF=> /mf; rewrite !fgK ?mem_g//; apply. Qed. Lemma monoLR_in : {in aD &, {mono f : x y / aR x y >-> rR x y}} -> {in aD & rD, forall x y, rR (f x) y = aR x (g y)}. Proof. by move=> mf x y hx hy; rewrite -{1}[y]fgK ?mem_g// mf ?mem_g. Qed. Lemma monoRL_in : {in aD &, {mono f : x y / aR x y >-> rR x y}} -> {in rD & aD, forall x y, rR x (f y) = aR (g x) y}. Proof. by move=> mf x y hx hy; rewrite -{1}[x]fgK ?mem_g// mf ?mem_g. Qed. Lemma can_mono_in : {in aD &, {mono f : x y / aR x y >-> rR x y}} -> {in rD &, {mono g : x y / rR x y >-> aR x y}}. Proof. by move=> mf x y hx hy; rewrite -mf ?mem_g// !fgK ?mem_g. Qed. End MonoHomoMorphismTheory_in. Arguments homoRL_in {aT rT f g aD rD aR rR}. Arguments homoLR_in {aT rT f g aD rD aR rR}. Arguments homo_mono_in {aT rT f g aD rD aR rR}. Arguments monoLR_in {aT rT f g aD rD aR rR}. Arguments monoRL_in {aT rT f g aD rD aR rR}. Arguments can_mono_in {aT rT f g aD rD aR rR}. Section HomoMonoMorphismFlip. Variables (aT rT : Type) (aR : rel aT) (rR : rel rT) (f : aT -> rT). Variable (aD aD' : {pred aT}). Lemma homo_sym : {homo f : x y / aR x y >-> rR x y} -> {homo f : y x / aR x y >-> rR x y}. Proof. by move=> fR y x; apply: fR. Qed. Lemma mono_sym : {mono f : x y / aR x y >-> rR x y} -> {mono f : y x / aR x y >-> rR x y}. Proof. by move=> fR y x; apply: fR. Qed. Lemma homo_sym_in : {in aD &, {homo f : x y / aR x y >-> rR x y}} -> {in aD &, {homo f : y x / aR x y >-> rR x y}}. Proof. by move=> fR y x yD xD; apply: fR. Qed. Lemma mono_sym_in : {in aD &, {mono f : x y / aR x y >-> rR x y}} -> {in aD &, {mono f : y x / aR x y >-> rR x y}}. Proof. by move=> fR y x yD xD; apply: fR. Qed. Lemma homo_sym_in11 : {in aD & aD', {homo f : x y / aR x y >-> rR x y}} -> {in aD' & aD, {homo f : y x / aR x y >-> rR x y}}. Proof. by move=> fR y x yD xD; apply: fR. Qed. Lemma mono_sym_in11 : {in aD & aD', {mono f : x y / aR x y >-> rR x y}} -> {in aD' & aD, {mono f : y x / aR x y >-> rR x y}}. Proof. by move=> fR y x yD xD; apply: fR. Qed. End HomoMonoMorphismFlip. Arguments homo_sym {aT rT} [aR rR f]. Arguments mono_sym {aT rT} [aR rR f]. Arguments homo_sym_in {aT rT} [aR rR f aD]. Arguments mono_sym_in {aT rT} [aR rR f aD]. Arguments homo_sym_in11 {aT rT} [aR rR f aD aD']. Arguments mono_sym_in11 {aT rT} [aR rR f aD aD']. Section CancelOn. Variables (aT rT : predArgType) (aD : {pred aT}) (rD : {pred rT}). Variables (f : aT -> rT) (g : rT -> aT). Lemma onW_can : cancel g f -> {on aD, cancel g & f}. Proof. by move=> fgK x xaD; apply: fgK. Qed. Lemma onW_can_in : {in rD, cancel g f} -> {in rD, {on aD, cancel g & f}}. Proof. by move=> fgK x xrD xaD; apply: fgK. Qed. Lemma in_onW_can : cancel g f -> {in rD, {on aD, cancel g & f}}. Proof. by move=> fgK x xrD xaD; apply: fgK. Qed. Lemma onS_can : (forall x, g x \in aD) -> {on aD, cancel g & f} -> cancel g f. Proof. by move=> mem_g fgK x; apply: fgK. Qed. Lemma onS_can_in : {homo g : x / x \in rD >-> x \in aD} -> {in rD, {on aD, cancel g & f}} -> {in rD, cancel g f}. Proof. by move=> mem_g fgK x x_rD; apply/fgK/mem_g. Qed. Lemma in_onS_can : (forall x, g x \in aD) -> {in rT, {on aD, cancel g & f}} -> cancel g f. Proof. by move=> mem_g fgK x; apply/fgK. Qed. End CancelOn. Arguments onW_can {aT rT} aD {f g}. Arguments onW_can_in {aT rT} aD {rD f g}. Arguments in_onW_can {aT rT} aD rD {f g}. Arguments onS_can {aT rT} aD {f g}. Arguments onS_can_in {aT rT} aD {rD f g}. Arguments in_onS_can {aT rT} aD {f g}. Section inj_can_sym_in_on. Variables (aT rT : predArgType) (aD : {pred aT}) (rD : {pred rT}). Variables (f : aT -> rT) (g : rT -> aT). Lemma inj_can_sym_in_on : {homo f : x / x \in aD >-> x \in rD} -> {in aD, {on rD, cancel f & g}} -> {in rD &, {on aD &, injective g}} -> {in rD, {on aD, cancel g & f}}. Proof. by move=> fD fK gI x x_rD gx_aD; apply: gI; rewrite ?inE ?fK ?fD. Qed. Lemma inj_can_sym_on : {in aD, cancel f g} -> {on aD &, injective g} -> {on aD, cancel g & f}. Proof. by move=> fK gI x gx_aD; apply: gI; rewrite ?inE ?fK. Qed. Lemma inj_can_sym_in : {homo f \o g : x / x \in rD} -> {on rD, cancel f & g} -> {in rD &, injective g} -> {in rD, cancel g f}. Proof. by move=> fgD fK gI x x_rD; apply: gI; rewrite ?fK ?fgD. Qed. End inj_can_sym_in_on. Arguments inj_can_sym_in_on {aT rT aD rD f g}. Arguments inj_can_sym_on {aT rT aD f g}. Arguments inj_can_sym_in {aT rT rD f g}. coq-8.20.0/theories/ssr/ssrclasses.v000066400000000000000000000027011466560755400174120ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* .doc { font-family: monospace; white-space: pre; } # **) (** Compatibility layer for [under] and [setoid_rewrite]. Note: this file does not require [ssreflect]; it is both required by [ssrsetoid] and required by [ssrunder]. Redefine [Coq.Classes.RelationClasses.Reflexive] here, so that doing [Require Import ssreflect] does not [Require Import RelationClasses], and conversely. **) Section Defs. Context {A : Type}. Class Reflexive (R : A -> A -> Prop) := reflexivity : forall x : A, R x x. End Defs. Register Reflexive as plugins.ssreflect.reflexive_type. Register reflexivity as plugins.ssreflect.reflexive_proof. #[global] Instance eq_Reflexive {A : Type} : Reflexive (@eq A) := @eq_refl A. #[global] Instance iff_Reflexive : Reflexive iff := iff_refl. coq-8.20.0/theories/ssr/ssreflect.v000066400000000000000000000761571466560755400172370ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* .doc { font-family: monospace; white-space: pre; } # **) Require Import Bool. (* For bool_scope delimiter 'bool'. *) Require Import ssrmatching. Declare ML Module "ssreflect_plugin:coq-core.plugins.ssreflect". (** This file is the Gallina part of the ssreflect plugin implementation. Files that use the ssreflect plugin should always Require ssreflect and either Import ssreflect or Import ssreflect.SsrSyntax. Part of the contents of this file is technical and will only interest advanced developers; in addition the following are defined: #[#the str of v by f#]# == the Canonical s : str such that f s = v. #[#the str of v#]# == the Canonical s : str that coerces to v. argumentType c == the T such that c : forall x : T, P x. returnType c == the R such that c : T -> R. {type of c for s} == P s where c : forall x : T, P x. nonPropType == an interface for non-Prop Types: a nonPropType coerces to a Type, and only types that do _not_ have sort Prop are canonical nonPropType instances. This is useful for applied views (see mid-file comment). notProp T == the nonPropType instance for type T. phantom T v == singleton type with inhabitant Phantom T v. phant T == singleton type with inhabitant Phant v. =^~ r == the converse of rewriting rule r (e.g., in a rewrite multirule). unkeyed t == t, but treated as an unkeyed matching pattern by the ssreflect matching algorithm. nosimpl t == t, but on the right-hand side of Definition C := nosimpl disables expansion of C by /=. locked t == t, but locked t is not convertible to t. locked_with k t == t, but not convertible to t or locked_with k' t unless k = k' (with k : unit). Coq type-checking will be much more efficient if locked_with with a bespoke k is used for sealed definitions. unlockable v == interface for sealed constant definitions of v. Unlockable def == the unlockable that registers def : C = v. #[#unlockable of C#]# == a clone for C of the canonical unlockable for the definition of C (e.g., if it uses locked_with). #[#unlockable fun C#]# == #[#unlockable of C#]# with the expansion forced to be an explicit lambda expression. -> The usage pattern for ADT operations is: Definition foo_def x1 .. xn := big_foo_expression. Fact foo_key : unit. Proof. by #[# #]#. Qed. Definition foo := locked_with foo_key foo_def. Canonical foo_unlockable := #[#unlockable fun foo#]#. This minimizes the comparison overhead for foo, while still allowing rewrite unlock to expose big_foo_expression. #[#elaborate x#]# == triggers Coq elaboration to fill the holes of the term x The main use case is to trigger typeclass inference in the body of a ssreflect have := #[#elaborate body#]#. Additionally we provide default intro pattern ltac views: - top of the stack actions: => /#[#apply#]# := => hyp {}/hyp => /#[#swap#]# := => x y; move: y x (also swap and preserves let bindings) => /#[#dup#]# := => x; have copy := x; move: copy x (also copies and preserves let bindings) - calling rewrite from an intro pattern, use with parsimony: => /#[#1! rules#]# := rewrite rules => /#[#! rules#]# := rewrite !rules More information about these definitions and their use can be found in the ssreflect manual, and in specific comments below. **) Set Implicit Arguments. Unset Strict Implicit. Unset Printing Implicit Defensive. Module SsrSyntax. (** Declare Ssr keywords: 'is' 'of' '//' '/=' and '//='. We also declare the parsing level 8, as a workaround for a notation grammar factoring problem. Arguments of application-style notations (at level 10) should be declared at level 8 rather than 9 or the camlp5 grammar will not factor properly. **) Reserved Notation "(* x 'is' y 'of' z 'isn't' // /= //= *)". (** Non ambiguous keyword to check if the SsrSyntax module is imported **) Reserved Notation "(* Use to test if 'SsrSyntax_is_Imported' *)". Reserved Notation "" (at level 0, n at level 0, format ""). #[warning="-postfix-notation-not-level-1"] Reserved Notation "T (* n *)" (at level 200, format "T (* n *)"). End SsrSyntax. Export SsrMatchingSyntax. Export SsrSyntax. (** Save primitive notation that will be overloaded. **) Local Notation CoqGenericIf c vT vF := (if c then vT else vF) (only parsing). Local Notation CoqGenericDependentIf c x R vT vF := (if c as x return R then vT else vF) (only parsing). (** Reserve notation that introduced in this file. **) Reserved Notation "'if' c 'then' vT 'else' vF" (at level 200, c, vT, vF at level 200). Reserved Notation "'if' c 'return' R 'then' vT 'else' vF" (at level 200, c, R, vT, vF at level 200). Reserved Notation "'if' c 'as' x 'return' R 'then' vT 'else' vF" (at level 200, c, R, vT, vF at level 200, x name). Reserved Notation "[ 'the' sT 'of' v 'by' f ]" (at level 0, format "[ 'the' sT 'of' v 'by' f ]"). Reserved Notation "[ 'the' sT 'of' v ]" (at level 0, format "[ 'the' sT 'of' v ]"). Reserved Notation "{ 'type' 'of' c 'for' s }" (at level 0, format "{ 'type' 'of' c 'for' s }"). Reserved Notation "=^~ r" (at level 100, format "=^~ r"). Reserved Notation "[ 'unlockable' 'of' C ]" (at level 0, format "[ 'unlockable' 'of' C ]"). Reserved Notation "[ 'unlockable' 'fun' C ]" (at level 0, format "[ 'unlockable' 'fun' C ]"). Reserved Notation "[ 'elaborate' x ]" (at level 0). (** To define notations for tactic in intro patterns. When "=> /t" is parsed, "t:%ssripat" is actually interpreted. **) Declare Scope ssripat_scope. Delimit Scope ssripat_scope with ssripat. (** Make the general "if" into a notation, so that we can override it below. The notations are "only parsing" because the Coq decompiler will not recognize the expansion of the boolean if; using the default printer avoids a spurious trailing %%GEN_IF. **) Declare Scope general_if_scope. Delimit Scope general_if_scope with GEN_IF. Notation "'if' c 'then' vT 'else' vF" := (CoqGenericIf c vT vF) (only parsing) : general_if_scope. Notation "'if' c 'return' R 'then' vT 'else' vF" := (CoqGenericDependentIf c c R vT vF) (only parsing) : general_if_scope. Notation "'if' c 'as' x 'return' R 'then' vT 'else' vF" := (CoqGenericDependentIf c x R vT vF) (only parsing) : general_if_scope. (** Force boolean interpretation of simple if expressions. **) Declare Scope boolean_if_scope. Delimit Scope boolean_if_scope with BOOL_IF. Notation "'if' c 'return' R 'then' vT 'else' vF" := (if c is true as c in bool return R then vT else vF) : boolean_if_scope. Notation "'if' c 'then' vT 'else' vF" := (if c%bool is true as _ in bool return _ then vT else vF) : boolean_if_scope. Notation "'if' c 'as' x 'return' R 'then' vT 'else' vF" := (if c%bool is true as x in bool return R then vT else vF) : boolean_if_scope. Open Scope boolean_if_scope. (** To allow a wider variety of notations without reserving a large number of of identifiers, the ssreflect library systematically uses "forms" to enclose complex mixfix syntax. A "form" is simply a mixfix expression enclosed in square brackets and introduced by a keyword: #[#keyword ... #]# Because the keyword follows a bracket it does not need to be reserved. Non-ssreflect libraries that do not respect the form syntax (e.g., the Coq Lists library) should be loaded before ssreflect so that their notations do not mask all ssreflect forms. **) Declare Scope form_scope. Delimit Scope form_scope with FORM. Open Scope form_scope. (** Constants for abstract: and #[#: name #]# intro pattern **) Definition abstract_lock := unit. Definition abstract_key := tt. Definition abstract (statement : Type) (id : nat) (lock : abstract_lock) := let: tt := lock in statement. Declare Scope ssr_scope. Notation "" := (abstract _ n _) : ssr_scope. Notation "T (* n *)" := (abstract T n abstract_key) : ssr_scope. Open Scope ssr_scope. Register abstract_lock as plugins.ssreflect.abstract_lock. Register abstract_key as plugins.ssreflect.abstract_key. Register abstract as plugins.ssreflect.abstract. (** Constants for tactic-views **) Inductive external_view : Type := tactic_view of Type. (** Syntax for referring to canonical structures: #[#the struct_type of proj_val by proj_fun#]# This form denotes the Canonical instance s of the Structure type struct_type whose proj_fun projection is proj_val, i.e., such that proj_fun s = proj_val. Typically proj_fun will be A record field accessors of struct_type, but this need not be the case; it can be, for instance, a field of a record type to which struct_type coerces; proj_val will likewise be coerced to the return type of proj_fun. In all but the simplest cases, proj_fun should be eta-expanded to allow for the insertion of implicit arguments. In the common case where proj_fun itself is a coercion, the "by" part can be omitted entirely; in this case it is inferred by casting s to the inferred type of proj_val. Obviously the latter can be fixed by using an explicit cast on proj_val, and it is highly recommended to do so when the return type intended for proj_fun is "Type", as the type inferred for proj_val may vary because of sort polymorphism (it could be Set or Prop). Note when using the #[#the _ of _ #]# form to generate a substructure from a telescopes-style canonical hierarchy (implementing inheritance with coercions), one should always project or coerce the value to the BASE structure, because Coq will only find a Canonical derived structure for the Canonical base structure -- not for a base structure that is specific to proj_value. **) Module TheCanonical. Variant put vT sT (v1 v2 : vT) (s : sT) : Prop := Put. Definition get vT sT v s (p : @put vT sT v v s) := let: Put _ _ _ := p in s. Definition get_by vT sT of sT -> vT := @get vT sT. End TheCanonical. Import TheCanonical. (* Note: no export. *) Local Arguments get_by _%_type_scope _%_type_scope _ _ _ _. Notation "[ 'the' sT 'of' v 'by' f ]" := (@get_by _ sT f _ _ ((fun v' (s : sT) => Put v' (f s) s) v _)) (only parsing) : form_scope. Notation "[ 'the' sT 'of' v ]" := (get ((fun s : sT => Put v (*coerce*) s s) _)) (only parsing) : form_scope. (** The following are "format only" versions of the above notations. We need to do this to prevent the formatter from being be thrown off by application collapsing, coercion insertion and beta reduction in the right hand side of the notations above. **) Notation "[ 'the' sT 'of' v 'by' f ]" := (@get_by _ sT f v _ _) (only printing) : form_scope. Notation "[ 'the' sT 'of' v ]" := (@get _ sT v _ _) (only printing) : form_scope. (** We would like to recognize Notation " #[# 'the' sT 'of' v : 'Type' #]#" := (@get Type sT v _ _) (at level 0, format " #[# 'the' sT 'of' v : 'Type' #]#") : form_scope. **) (** Helper notation for canonical structure inheritance support. This is a workaround for the poor interaction between delta reduction and canonical projections in Coq's unification algorithm, by which transparent definitions hide canonical instances, i.e., in Canonical a_type_struct := @Struct a_type ... Definition my_type := a_type. my_type doesn't effectively inherit the struct structure from a_type. Our solution is to redeclare the instance as follows Canonical my_type_struct := Eval hnf in #[#struct of my_type#]#. The special notation #[#str of _ #]# must be defined for each Structure "str" with constructor "Str", typically as follows Definition clone_str s := let: Str _ x y ... z := s return {type of Str for s} -> str in fun k => k _ x y ... z. Notation " #[# 'str' 'of' T 'for' s #]#" := (@clone_str s (@Str T)) (at level 0, format " #[# 'str' 'of' T 'for' s #]#") : form_scope. Notation " #[# 'str' 'of' T #]#" := (repack_str (fun x => @Str T x)) (at level 0, format " #[# 'str' 'of' T #]#") : form_scope. The notation for the match return predicate is defined below; the eta expansion in the second form serves both to distinguish it from the first and to avoid the delta reduction problem. There are several variations on the notation and the definition of the the "clone" function, for telescopes, mixin classes, and join (multiple inheritance) classes. We describe a different idiom for clones in ssrfun; it uses phantom types (see below) and static unification; see fintype and ssralg for examples. **) Definition argumentType T P & forall x : T, P x := T. Definition dependentReturnType T P & forall x : T, P x := P. Definition returnType aT rT & aT -> rT := rT. Notation "{ 'type' 'of' c 'for' s }" := (dependentReturnType c s) : type_scope. (** A generic "phantom" type (actually, a unit type with a phantom parameter). This type can be used for type definitions that require some Structure on one of their parameters, to allow Coq to infer said structure so it does not have to be supplied explicitly or via the " #[#the _ of _ #]#" notation (the latter interacts poorly with other Notation). The definition of a (co)inductive type with a parameter p : p_type, that needs to use the operations of a structure Structure p_str : Type := p_Str {p_repr :> p_type; p_op : p_repr -> ...} should be given as Inductive indt_type (p : p_str) := Indt ... . Definition indt_of (p : p_str) & phantom p_type p := indt_type p. Notation "{ 'indt' p }" := (indt_of (Phantom p)). Definition indt p x y ... z : {indt p} := @Indt p x y ... z. Notation " #[# 'indt' x y ... z #]#" := (indt x y ... z). That is, the concrete type and its constructor should be shadowed by definitions that use a phantom argument to infer and display the true value of p (in practice, the "indt" constructor often performs additional functions, like "locking" the representation -- see below). We also define a simpler version ("phant" / "Phant") of phantom for the common case where p_type is Type. **) Variant phantom T (p : T) : Prop := Phantom. Arguments phantom : clear implicits. Arguments Phantom : clear implicits. Variant phant (p : Type) : Prop := Phant. (** Internal tagging used by the implementation of the ssreflect elim. **) Definition protect_term (A : Type) (x : A) : A := x. Register protect_term as plugins.ssreflect.protect_term. (** The ssreflect idiom for a non-keyed pattern: - unkeyed t will match any subterm that unifies with t, regardless of whether it displays the same head symbol as t. - unkeyed t a b will match any application of a term f unifying with t, to two arguments unifying with a and b, respectively, regardless of apparent head symbols. - unkeyed x where x is a variable will match any subterm with the same type as x (when x would raise the 'indeterminate pattern' error). **) Notation unkeyed x := (let flex := x in flex). (** Ssreflect converse rewrite rule rule idiom. **) Definition ssr_converse R (r : R) := (Logic.I, r). Notation "=^~ r" := (ssr_converse r) : form_scope. (** Term tagging (user-level). The ssreflect library uses four strengths of term tagging to restrict convertibility during type checking: nosimpl t simplifies to t EXCEPT in a definition; more precisely, given Definition foo := nosimpl bar, foo (or foo t') will NOT be expanded by the /= and //= switches unless it is in a forcing context (e.g., in match foo t' with ... end, foo t' will be reduced if this allows the match to be reduced). Note that nosimpl bar is simply notation for a a term that beta-iota reduces to bar; hence rewrite /foo will replace foo by bar, and rewrite -/foo will replace bar by foo. CAVEAT: nosimpl should not be used inside a Section, because the end of section "cooking" removes the iota redex. locked t is provably equal to t, but is not convertible to t; 'locked' provides support for selective rewriting, via the lock t : t = locked t Lemma, and the ssreflect unlock tactic. locked_with k t is equal but not convertible to t, much like locked t, but supports explicit tagging with a value k : unit. This is used to mitigate a flaw in the term comparison heuristic of the Coq kernel, which treats all terms of the form locked t as equal and compares their arguments recursively, leading to an exponential blowup of comparison. For this reason locked_with should be used rather than locked when defining ADT operations. The unlock tactic does not support locked_with but the unlock rewrite rule does, via the unlockable interface. we also use Module Type ascription to create truly opaque constants, because simple expansion of constants to reveal an unreducible term doubles the time complexity of a negative comparison. Such opaque constants can be expanded generically with the unlock rewrite rule. See the definition of card and subset in fintype for examples of this. **) Notation nosimpl t := (let: tt := tt in t). Lemma master_key : unit. Proof. exact tt. Qed. Definition locked A := let: tt := master_key in fun x : A => x. Register master_key as plugins.ssreflect.master_key. Register locked as plugins.ssreflect.locked. Lemma lock A x : x = locked x :> A. Proof. unlock; reflexivity. Qed. (** Needed for locked predicates, in particular for eqType's. **) Lemma not_locked_false_eq_true : locked false <> true. Proof. unlock; discriminate. Qed. (** The basic closing tactic "done". **) Ltac done := trivial; hnf; intros; solve [ do ![solve [trivial | apply: sym_equal; trivial] | discriminate | contradiction | split] | case not_locked_false_eq_true; assumption | match goal with H : ~ _ |- _ => solve [case H; trivial] end ]. (** Quicker done tactic not including split, syntax: /0/ **) Ltac ssrdone0 := trivial; hnf; intros; solve [ do ![solve [trivial | apply: sym_equal; trivial] | discriminate | contradiction ] | case not_locked_false_eq_true; assumption | match goal with H : ~ _ |- _ => solve [case H; trivial] end ]. (** To unlock opaque constants. **) #[universes(template)] Structure unlockable T v := Unlockable {unlocked : T; _ : unlocked = v}. Lemma unlock T x C : @unlocked T x C = x. Proof. by case: C. Qed. Notation "[ 'unlockable' 'of' C ]" := (@Unlockable _ _ C (unlock _)) : form_scope. Notation "[ 'unlockable' 'fun' C ]" := (@Unlockable _ (fun _ => _) C (unlock _)) : form_scope. (** Generic keyed constant locking. **) (** The argument order ensures that k is always compared before T. **) Definition locked_with k := let: tt := k in fun T x => x : T. (** This can be used as a cheap alternative to cloning the unlockable instance below, but with caution as unkeyed matching can be expensive. **) Lemma locked_withE T k x : unkeyed (locked_with k x) = x :> T. Proof. by case: k. Qed. (** Intensionaly, this instance will not apply to locked u. **) Canonical locked_with_unlockable T k x := @Unlockable T x (locked_with k x) (locked_withE k x). (** More accurate variant of unlock, and safer alternative to locked_withE. **) Lemma unlock_with T k x : unlocked (locked_with_unlockable k x) = x :> T. Proof. exact: unlock. Qed. (** Notation to trigger Coq elaboration to fill the holes **) Notation "[ 'elaborate' x ]" := (ltac:(refine x)) (only parsing). (** The internal lemmas for the have tactics. **) Lemma ssr_have (Plemma : Prop) (Pgoal : Prop) (step : Plemma) (rest : Plemma -> Pgoal) : Pgoal. Proof. exact: rest step. Qed. Register ssr_have as plugins.ssreflect.ssr_have. Polymorphic Lemma ssr_have_upoly@{s1 s2|u1 u2|} (Plemma : Type@{s1|u1}) (Pgoal : Type@{s2|u2}) (step : Plemma) (rest : Plemma -> Pgoal) : Pgoal. Proof. exact: rest step. Qed. Register ssr_have_upoly as plugins.ssreflect.ssr_have_upoly. (** Internal N-ary congruence lemmas for the congr tactic. **) Fixpoint nary_congruence_statement (n : nat) : (forall B, (B -> B -> Prop) -> Prop) -> Prop := match n with | O => fun k => forall B, k B (fun x1 x2 : B => x1 = x2) | S n' => let k' A B e (f1 f2 : A -> B) := forall x1 x2, x1 = x2 -> (e (f1 x1) (f2 x2) : Prop) in fun k => forall A, nary_congruence_statement n' (fun B e => k _ (k' A B e)) end. Lemma nary_congruence n (k := fun B e => forall y : B, (e y y : Prop)) : nary_congruence_statement n k. Proof. have: k _ _ := _; rewrite {1}/k. elim: n k => [|n IHn] k k_P /= A; first exact: k_P. by apply: IHn => B e He; apply: k_P => f x1 x2 <-. Qed. Lemma ssr_congr_arrow Plemma Pgoal : Plemma = Pgoal -> Plemma -> Pgoal. Proof. by move->. Qed. Arguments ssr_congr_arrow : clear implicits. Register nary_congruence as plugins.ssreflect.nary_congruence. Register ssr_congr_arrow as plugins.ssreflect.ssr_congr_arrow. (** View lemmas that don't use reflection. **) Section ApplyIff. Variables P Q : Prop. Hypothesis eqPQ : P <-> Q. Lemma iffLR : P -> Q. Proof. by case: eqPQ. Qed. Lemma iffRL : Q -> P. Proof. by case: eqPQ. Qed. Lemma iffLRn : ~P -> ~Q. Proof. by move=> nP tQ; case: nP; case: eqPQ tQ. Qed. Lemma iffRLn : ~Q -> ~P. Proof. by move=> nQ tP; case: nQ; case: eqPQ tP. Qed. End ApplyIff. Hint View for move/ iffLRn|2 iffRLn|2 iffLR|2 iffRL|2. Hint View for apply/ iffRLn|2 iffLRn|2 iffRL|2 iffLR|2. (** To focus non-ssreflect tactics on a subterm, eg vm_compute. Usage: elim/abstract_context: (pattern) => G defG. vm_compute; rewrite {}defG {G}. Note that vm_cast are not stored in the proof term for reductions occurring in the context, hence set here := pattern; vm_compute in (value of here) blows up at Qed time. **) Lemma abstract_context T (P : T -> Type) x : (forall Q, Q = P -> Q x) -> P x. Proof. by move=> /(_ P); apply. Qed. (*****************************************************************************) (* Material for under/over (to rewrite under binders using "context lemmas") *) Require Export ssrunder. #[global] Hint Extern 0 (@Under_rel.Over_rel _ _ _ _) => solve [ apply: Under_rel.over_rel_done ] : core. #[global] Hint Resolve Under_rel.over_rel_done : core. Register Under_rel.Under_rel as plugins.ssreflect.Under_rel. Register Under_rel.Under_rel_from_rel as plugins.ssreflect.Under_rel_from_rel. (** Closing rewrite rule *) Definition over := over_rel. (** Closing tactic *) Ltac over := by [ apply: Under_rel.under_rel_done | rewrite over ]. (** Convenience rewrite rule to unprotect evars, e.g., to instantiate them in another way than with reflexivity. *) Definition UnderE := Under_relE. (*****************************************************************************) (** An interface for non-Prop types; used to avoid improper instantiation of polymorphic lemmas with on-demand implicits when they are used as views. For example: Some_inj {T} : forall x y : T, Some x = Some y -> x = y. Using move/Some_inj on a goal of the form Some n = Some 0 will fail: SSReflect will interpret the view as @Some_inj ?T _top_assumption_ since this is the well-typed application of the view with the minimal number of inserted evars (taking ?T := Some n = Some 0), and then will later complain that it cannot erase _top_assumption_ after having abstracted the viewed assumption. Making x and y maximal implicits would avoid this and force the intended @Some_inj nat x y _top_assumption_ interpretation, but is undesirable as it makes it harder to use Some_inj with the many SSReflect and MathComp lemmas that have an injectivity premise. Specifying {T : nonPropType} solves this more elegantly, as then (?T : Type) no longer unifies with (Some n = Some 0), which has sort Prop. **) Module NonPropType. (** Implementation notes: We rely on three interface Structures: - test_of r, the middle structure, performs the actual check: it has two canonical instances whose 'condition' projection are maybeProj (?P : Prop) and tt, and which set r := true and r := false, respectively. Unifying condition (?t : test_of ?r) with maybeProj T will thus set ?r to true if T is in Prop as the test_Prop T instance will apply, and otherwise simplify maybeProp T to tt and use the test_negative instance and set ?r to false. - call_of c r sets up a call to test_of on condition c with expected result r. It has a default instance for its 'callee' projection to Type, which sets c := maybeProj T and r := false when unifying with a type T. - type is a telescope on call_of c r, which checks that unifying test_of ?r1 with c indeed sets ?r1 := r; the type structure bundles the 'test' instance and its 'result' value along with its call_of c r projection. The default instance essentially provides eta-expansion for 'type'. This is only essential for the first 'result' projection to bool; using the instance for other projection merely avoids spurious delta expansions that would spoil the notProp T notation. In detail, unifying T =~= ?S with ?S : nonPropType, i.e., (1) T =~= @callee (@condition (result ?S) (test ?S)) (result ?S) (frame ?S) first uses the default call instance with ?T := T to reduce (1) to (2a) @condition (result ?S) (test ?S) =~= maybeProp T (3) result ?S =~= false (4) frame ?S =~= call T along with some trivial universe-related checks which are irrelevant here. Then the unification tries to use the test_Prop instance to reduce (2a) to (6a) result ?S =~= true (7a) ?P =~= T with ?P : Prop (8a) test ?S =~= test_Prop ?P Now the default 'check' instance with ?result := true resolves (6a) as (9a) ?S := @check true ?test ?frame Then (7a) can be solved precisely if T has sort at most (hence exactly) Prop, and then (8a) is solved by the check instance, yielding ?test := test_Prop T, and completing the solution of (2a), and _committing_ to it. But now (3) is inconsistent with (9a), and this makes the entire problem (1) fails. If on the other hand T does not have sort Prop then (7a) fails and the unification resorts to delta expanding (2a), which gives (2b) @condition (result ?S) (test ?S) =~= tt which is then reduced, using the test_negative instance, to (6b) result ?S =~= false (8b) test ?S =~= test_negative Both are solved using the check default instance, as in the (2a) branch, giving (9b) ?S := @check false test_negative ?frame Then (3) and (4) are similarly solved using check, giving the final assignment (9) ?S := notProp T Observe that we _must_ perform the actual test unification on the arguments of the initial canonical instance, and not on the instance itself as we do in mathcomp/matrix and mathcomp/vector, because we want the unification to fail when T has sort Prop. If both the test_of _and_ the result check unifications were done as part of the structure telescope then the latter would be a sub-problem of the former, and thus failing the check would merely make the test_of unification backtrack and delta-expand and we would not get failure. **) Structure call_of (condition : unit) (result : bool) := Call {callee : Type}. Definition maybeProp (T : Type) := tt. Definition call T := Call (maybeProp T) false T. Structure test_of (result : bool) := Test {condition :> unit}. Definition test_Prop (P : Prop) := Test true (maybeProp P). Definition test_negative := Test false tt. Structure type := Check {result : bool; test : test_of result; frame : call_of test result}. Definition check result test frame := @Check result test frame. Module Exports. Canonical call. Canonical test_Prop. Canonical test_negative. Canonical check. Notation nonPropType := type. Coercion callee : call_of >-> Sortclass. Coercion frame : type >-> call_of. Notation notProp T := (@check false test_negative (call T)). End Exports. End NonPropType. Export NonPropType.Exports. Module Export ipat. Notation "'[' 'apply' ']'" := (ltac:(let f := fresh "_top_" in move=> f {}/f)) (at level 0, only parsing) : ssripat_scope. (* we try to preserve the naming by matching the names from the goal *) (* we do move to perform a hnf before trying to match *) Notation "'[' 'swap' ']'" := (ltac:(move; let x := lazymatch goal with | |- forall (x : _), _ => fresh x | |- let x := _ in _ => fresh x | _ => fresh "_top_" end in intro x; move; let y := lazymatch goal with | |- forall (y : _), _ => fresh y | |- let y := _ in _ => fresh y | _ => fresh "_top_" end in intro y; revert x; revert y)) (at level 0, only parsing) : ssripat_scope. (* we try to preserve the naming by matching the names from the goal *) (* we do move to perform a hnf before trying to match *) Notation "'[' 'dup' ']'" := (ltac:(move; lazymatch goal with | |- forall (x : _), _ => let x := fresh x in intro x; let copy := fresh x in have copy := x; revert x; revert copy | |- let x := _ in _ => let x := fresh x in intro x; let copy := fresh x in pose copy := x; do [unfold x in (value of copy)]; revert x; revert copy | |- _ => let x := fresh "_top_" in move=> x; let copy := fresh "_top" in have copy := x; revert x; revert copy end)) (at level 0, only parsing) : ssripat_scope. Notation "'[' '1' '!' rules ']'" := (ltac:(rewrite rules)) (at level 0, rules at level 200, only parsing) : ssripat_scope. Notation "'[' '!' rules ']'" := (ltac:(rewrite !rules)) (at level 0, rules at level 200, only parsing) : ssripat_scope. End ipat. (* A class to trigger reduction by rewriting. *) (* Usage: rewrite [pattern]vm_compute. *) (* Alternatively one may redefine a lemma as in algebra/rat.v : *) (* Lemma rat_vm_compute n (x : rat) : vm_compute_eq n%:Q x -> n%:Q = x. *) (* Proof. exact. Qed. *) Class vm_compute_eq {T : Type} (x y : T) := vm_compute : x = y. #[global] Hint Extern 0 (@vm_compute_eq _ _ _) => vm_compute; reflexivity : typeclass_instances. coq-8.20.0/theories/ssr/ssrfun.v000066400000000000000000001044721466560755400165550ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* .doc { font-family: monospace; white-space: pre; } # **) Require Import ssreflect. (** This file contains the basic definitions and notations for working with functions. The definitions provide for: - Pair projections: p.1 == first element of a pair p.2 == second element of a pair These notations also apply to p : P /\ Q, via an and >-> pair coercion. - Simplifying functions, beta-reduced by /= and simpl: #[#fun : T => E#]# == constant function from type T that returns E #[#fun x => E#]# == unary function #[#fun x : T => E#]# == unary function with explicit domain type #[#fun x y => E#]# == binary function #[#fun x y : T => E#]# == binary function with common domain type #[#fun (x : T) y => E#]# \ #[#fun (x : xT) (y : yT) => E#]# | == binary function with (some) explicit, #[#fun x (y : T) => E#]# / independent domain types for each argument - Partial functions using option type: oapp f d ox == if ox is Some x returns f x, d otherwise odflt d ox == if ox is Some x returns x, d otherwise obind f ox == if ox is Some x returns f x, None otherwise omap f ox == if ox is Some x returns Some (f x), None otherwise olift f := Some \o f - Singleton types: all_equal_to x0 == x0 is the only value in its type, so any such value can be rewritten to x0. - A generic wrapper type: wrapped T == the inductive type with values Wrap x for x : T. unwrap w == the projection of w : wrapped T on T. wrap x == the canonical injection of x : T into wrapped T; it is equivalent to Wrap x, but is declared as a (default) Canonical Structure, which lets the Coq HO unification automatically expand x into unwrap (wrap x). The delta reduction of wrap x to Wrap can be exploited to introduce controlled nondeterminism in Canonical Structure inference, as in the implementation of the mxdirect predicate in matrix.v. - The empty type: void == a notation for the Empty_set type of the standard library. of_void T == the canonical injection void -> T. - Sigma types: tag w == the i of w : {i : I & T i}. tagged w == the T i component of w : {i : I & T i}. Tagged T x == the {i : I & T i} with component x : T i. tag2 w == the i of w : {i : I & T i & U i}. tagged2 w == the T i component of w : {i : I & T i & U i}. tagged2' w == the U i component of w : {i : I & T i & U i}. Tagged2 T U x y == the {i : I & T i} with components x : T i and y : U i. sval u == the x of u : {x : T | P x}. s2val u == the x of u : {x : T | P x & Q x}. The properties of sval u, s2val u are given by lemmas svalP, s2valP, and s2valP'. We provide coercions sigT2 >-> sigT and sig2 >-> sig >-> sigT. A suite of lemmas (all_sig, ...) let us skolemize sig, sig2, sigT, sigT2 and pair, e.g., have /all_sig#[#f fP#]# (x : T): {y : U | P y} by ... yields an f : T -> U such that fP : forall x, P (f x). - Identity functions: id == NOTATION for the explicit identity function fun x => x. @id T == notation for the explicit identity at type T. idfun == an expression with a head constant, convertible to id; idfun x simplifies to x. @idfun T == the expression above, specialized to type T. phant_id x y == the function type phantom _ x -> phantom _ y. *** In addition to their casual use in functional programming, identity functions are often used to trigger static unification as part of the construction of dependent Records and Structures. For example, if we need a structure sT over a type T, we take as arguments T, sT, and a "dummy" function T -> sort sT: Definition foo T sT & T -> sort sT := ... We can avoid specifying sT directly by calling foo (@id T), or specify the call completely while still ensuring the consistency of T and sT, by calling @foo T sT idfun. The phant_id type allows us to extend this trick to non-Type canonical projections. It also allows us to sidestep dependent type constraints when building explicit records, e.g., given Record r := R {x; y : T(x)}. if we need to build an r from a given y0 while inferring some x0, such that y0 : T(x0), we pose Definition mk_r .. y .. (x := ...) y' & phant_id y y' := R x y'. Calling @mk_r .. y0 .. id will cause Coq to use y' := y0, while checking the dependent type constraint y0 : T(x0). - Extensional equality for functions and relations (i.e. functions of two arguments): f1 =1 f2 == f1 x is equal to f2 x for all x. f1 =1 f2 :> A == ... and f2 is explicitly typed. f1 =2 f2 == f1 x y is equal to f2 x y for all x y. f1 =2 f2 :> A == ... and f2 is explicitly typed. - Composition for total and partial functions: f^~ y == function f with second argument specialised to y, i.e., fun x => f x y CAVEAT: conditional (non-maximal) implicit arguments of f are NOT inserted in this context @^~ x == application at x, i.e., fun f => f x #[#eta f#]# == the explicit eta-expansion of f, i.e., fun x => f x CAVEAT: conditional (non-maximal) implicit arguments of f are NOT inserted in this context. fun=> v := the constant function fun _ => v. f1 \o f2 == composition of f1 and f2. Note: (f1 \o f2) x simplifies to f1 (f2 x). f1 \; f2 == categorical composition of f1 and f2. This expands to to f2 \o f1 and (f1 \; f2) x simplifies to f2 (f1 x). pcomp f1 f2 == composition of partial functions f1 and f2. - Properties of functions: injective f <-> f is injective. cancel f g <-> g is a left inverse of f / f is a right inverse of g. pcancel f g <-> g is a left inverse of f where g is partial. ocancel f g <-> g is a left inverse of f where f is partial. bijective f <-> f is bijective (has a left and right inverse). involutive f <-> f is involutive. - Properties for operations. left_id e op <-> e is a left identity for op (e op x = x). right_id e op <-> e is a right identity for op (x op e = x). left_inverse e inv op <-> inv is a left inverse for op wrt identity e, i.e., (inv x) op x = e. right_inverse e inv op <-> inv is a right inverse for op wrt identity e i.e., x op (i x) = e. self_inverse e op <-> each x is its own op-inverse (x op x = e). idempotent op <-> op is idempotent for op (x op x = x). associative op <-> op is associative, i.e., x op (y op z) = (x op y) op z. commutative op <-> op is commutative (x op y = y op x). left_commutative op <-> op is left commutative, i.e., x op (y op z) = y op (x op z). right_commutative op <-> op is right commutative, i.e., (x op y) op z = (x op z) op y. left_zero z op <-> z is a left zero for op (z op x = z). right_zero z op <-> z is a right zero for op (x op z = z). left_distributive op1 op2 <-> op1 distributes over op2 to the left: (x op2 y) op1 z = (x op1 z) op2 (y op1 z). right_distributive op1 op2 <-> op distributes over add to the right: x op1 (y op2 z) = (x op1 z) op2 (x op1 z). interchange op1 op2 <-> op1 and op2 satisfy an interchange law: (x op2 y) op1 (z op2 t) = (x op1 z) op2 (y op1 t). Note that interchange op op is a commutativity property. left_injective op <-> op is injective in its left argument: x op y = z op y -> x = z. right_injective op <-> op is injective in its right argument: x op y = x op z -> y = z. left_loop inv op <-> op, inv obey the inverse loop left axiom: (inv x) op (x op y) = y for all x, y, i.e., op (inv x) is always a left inverse of op x rev_left_loop inv op <-> op, inv obey the inverse loop reverse left axiom: x op ((inv x) op y) = y, for all x, y. right_loop inv op <-> op, inv obey the inverse loop right axiom: (x op y) op (inv y) = x for all x, y. rev_right_loop inv op <-> op, inv obey the inverse loop reverse right axiom: (x op (inv y)) op y = x for all x, y. Note that familiar "cancellation" identities like x + y - y = x or x - y + y = x are respectively instances of right_loop and rev_right_loop The corresponding lemmas will use the K and NK/VK suffixes, respectively. - Morphisms for functions and relations: {morph f : x / a >-> r} <-> f is a morphism with respect to functions (fun x => a) and (fun x => r); if r == R#[#x#]#, this states that f a = R#[#f x#]# for all x. {morph f : x / a} <-> f is a morphism with respect to the function expression (fun x => a). This is shorthand for {morph f : x / a >-> a}; note that the two instances of a are often interpreted at different types. {morph f : x y / a >-> r} <-> f is a morphism with respect to functions (fun x y => a) and (fun x y => r). {morph f : x y / a} <-> f is a morphism with respect to the function expression (fun x y => a). {homo f : x / a >-> r} <-> f is a homomorphism with respect to the predicates (fun x => a) and (fun x => r); if r == R#[#x#]#, this states that a -> R#[#f x#]# for all x. {homo f : x / a} <-> f is a homomorphism with respect to the predicate expression (fun x => a). {homo f : x y / a >-> r} <-> f is a homomorphism with respect to the relations (fun x y => a) and (fun x y => r). {homo f : x y / a} <-> f is a homomorphism with respect to the relation expression (fun x y => a). {mono f : x / a >-> r} <-> f is monotone with respect to projectors (fun x => a) and (fun x => r); if r == R#[#x#]#, this states that R#[#f x#]# = a for all x. {mono f : x / a} <-> f is monotone with respect to the projector expression (fun x => a). {mono f : x y / a >-> r} <-> f is monotone with respect to relators (fun x y => a) and (fun x y => r). {mono f : x y / a} <-> f is monotone with respect to the relator expression (fun x y => a). The file also contains some basic lemmas for the above concepts. Lemmas relative to cancellation laws use some abbreviated suffixes: K - a cancellation rule like esymK : cancel (@esym T x y) (@esym T y x). LR - a lemma moving an operation from the left hand side of a relation to the right hand side, like canLR: cancel g f -> x = g y -> f x = y. RL - a lemma moving an operation from the right to the left, e.g., canRL. Beware that the LR and RL orientations refer to an "apply" (back chaining) usage; when using the same lemmas with "have" or "move" (forward chaining) the directions will be reversed!. **) Set Implicit Arguments. Unset Strict Implicit. Unset Printing Implicit Defensive. (** Parsing / printing declarations. *) Reserved Notation "f ^~ y" (at level 10, y at level 8, no associativity, format "f ^~ y"). Reserved Notation "@^~ x" (at level 10, x at level 8, no associativity, format "@^~ x"). Reserved Notation "[ 'eta' f ]" (at level 0, format "[ 'eta' f ]"). Reserved Notation "'fun' => E" (at level 200, format "'fun' => E"). Reserved Notation "[ 'fun' : T => E ]" (at level 0, format "'[hv' [ 'fun' : T => '/ ' E ] ']'"). Reserved Notation "[ 'fun' x => E ]" (at level 0, x name, format "'[hv' [ 'fun' x => '/ ' E ] ']'"). Reserved Notation "[ 'fun' x : T => E ]" (at level 0, x name, format "'[hv' [ 'fun' x : T => '/ ' E ] ']'"). Reserved Notation "[ 'fun' x y => E ]" (at level 0, x name, y name, format "'[hv' [ 'fun' x y => '/ ' E ] ']'"). Reserved Notation "[ 'fun' x y : T => E ]" (at level 0, x name, y name, format "'[hv' [ 'fun' x y : T => '/ ' E ] ']'"). Reserved Notation "[ 'fun' ( x : T ) y => E ]" (at level 0, x name, y name, format "'[hv' [ 'fun' ( x : T ) y => '/ ' E ] ']'"). Reserved Notation "[ 'fun' x ( y : T ) => E ]" (at level 0, x name, y name, format "'[hv' [ 'fun' x ( y : T ) => '/ ' E ] ']'"). Reserved Notation "[ 'fun' ( x : T ) ( y : U ) => E ]" (at level 0, x name, y name, format "[ 'fun' ( x : T ) ( y : U ) => E ]" ). Reserved Notation "f =1 g" (at level 70, no associativity). Reserved Notation "f =1 g :> A" (at level 70, g at next level, A at level 90). Reserved Notation "f =2 g" (at level 70, no associativity). Reserved Notation "f =2 g :> A" (at level 70, g at next level, A at level 90). Reserved Notation "f \o g" (at level 50, format "f \o '/ ' g"). Reserved Notation "f \; g" (at level 60, right associativity, format "f \; '/ ' g"). Reserved Notation "{ 'morph' f : x / a >-> r }" (at level 0, f at level 99, x name, format "{ 'morph' f : x / a >-> r }"). Reserved Notation "{ 'morph' f : x / a }" (at level 0, f at level 99, x name, format "{ 'morph' f : x / a }"). Reserved Notation "{ 'morph' f : x y / a >-> r }" (at level 0, f at level 99, x name, y name, format "{ 'morph' f : x y / a >-> r }"). Reserved Notation "{ 'morph' f : x y / a }" (at level 0, f at level 99, x name, y name, format "{ 'morph' f : x y / a }"). Reserved Notation "{ 'homo' f : x / a >-> r }" (at level 0, f at level 99, x name, format "{ 'homo' f : x / a >-> r }"). Reserved Notation "{ 'homo' f : x / a }" (at level 0, f at level 99, x name, format "{ 'homo' f : x / a }"). Reserved Notation "{ 'homo' f : x y / a >-> r }" (at level 0, f at level 99, x name, y name, format "{ 'homo' f : x y / a >-> r }"). Reserved Notation "{ 'homo' f : x y / a }" (at level 0, f at level 99, x name, y name, format "{ 'homo' f : x y / a }"). Reserved Notation "{ 'homo' f : x y /~ a }" (at level 0, f at level 99, x name, y name, format "{ 'homo' f : x y /~ a }"). Reserved Notation "{ 'mono' f : x / a >-> r }" (at level 0, f at level 99, x name, format "{ 'mono' f : x / a >-> r }"). Reserved Notation "{ 'mono' f : x / a }" (at level 0, f at level 99, x name, format "{ 'mono' f : x / a }"). Reserved Notation "{ 'mono' f : x y / a >-> r }" (at level 0, f at level 99, x name, y name, format "{ 'mono' f : x y / a >-> r }"). Reserved Notation "{ 'mono' f : x y / a }" (at level 0, f at level 99, x name, y name, format "{ 'mono' f : x y / a }"). Reserved Notation "{ 'mono' f : x y /~ a }" (at level 0, f at level 99, x name, y name, format "{ 'mono' f : x y /~ a }"). Reserved Notation "@ 'id' T" (at level 10, T at level 8, format "@ 'id' T"). #[warning="-closed-notation-not-level-0"] Reserved Notation "@ 'sval'" (at level 10, format "@ 'sval'"). (** Syntax for defining auxiliary recursive function. Usage: Section FooDefinition. Variables (g1 : T1) (g2 : T2). (globals) Fixoint foo_auxiliary (a3 : T3) ... := body, using #[#rec e3, ... #]# for recursive calls where " #[# 'rec' a3 , a4 , ... #]#" := foo_auxiliary. Definition foo x y .. := #[#rec e1, ... #]#. + proofs about foo End FooDefinition. **) Reserved Notation "[ 'rec' a ]" (at level 0, format "[ 'rec' a ]"). Reserved Notation "[ 'rec' a , b ]" (at level 0, format "[ 'rec' a , b ]"). Reserved Notation "[ 'rec' a , b , c ]" (at level 0, format "[ 'rec' a , b , c ]"). Reserved Notation "[ 'rec' a , b , c , d ]" (at level 0, format "[ 'rec' a , b , c , d ]"). Reserved Notation "[ 'rec' a , b , c , d , e ]" (at level 0, format "[ 'rec' a , b , c , d , e ]"). Reserved Notation "[ 'rec' a , b , c , d , e , f ]" (at level 0, format "[ 'rec' a , b , c , d , e , f ]"). Reserved Notation "[ 'rec' a , b , c , d , e , f , g ]" (at level 0, format "[ 'rec' a , b , c , d , e , f , g ]"). Reserved Notation "[ 'rec' a , b , c , d , e , f , g , h ]" (at level 0, format "[ 'rec' a , b , c , d , e , f , g , h ]"). Reserved Notation "[ 'rec' a , b , c , d , e , f , g , h , i ]" (at level 0, format "[ 'rec' a , b , c , d , e , f , g , h , i ]"). Reserved Notation "[ 'rec' a , b , c , d , e , f , g , h , i , j ]" (at level 0, format "[ 'rec' a , b , c , d , e , f , g , h , i , j ]"). Declare Scope pair_scope. Delimit Scope pair_scope with PAIR. Open Scope pair_scope. (** Notations for pair/conjunction projections **) Notation "p .1" := (fst p) : pair_scope. Notation "p .2" := (snd p) : pair_scope. Coercion pair_of_and P Q (PandQ : P /\ Q) := (proj1 PandQ, proj2 PandQ). Definition all_pair I T U (w : forall i : I, T i * U i) := (fun i => (w i).1, fun i => (w i).2). (** Complements on the option type constructor, used below to encode partial functions. **) Module Option. Definition apply aT rT (f : aT -> rT) x u := if u is Some y then f y else x. Definition default T := apply (fun x : T => x). Definition bind aT rT (f : aT -> option rT) := apply f None. Definition map aT rT (f : aT -> rT) := bind (fun x => Some (f x)). Definition lift aT rT (f : aT -> rT) := fun x => Some (f x). End Option. Notation oapp := Option.apply. Notation odflt := Option.default. Notation obind := Option.bind. Notation omap := Option.map. Notation olift := Option.lift. Notation some := (@Some _) (only parsing). (** Shorthand for some basic equality lemmas. **) Notation erefl := refl_equal. Notation ecast i T e x := (let: erefl in _ = i := e return T in x). Definition esym := sym_eq. Definition nesym := sym_not_eq. Definition etrans := trans_eq. Definition congr1 := f_equal. Definition congr2 := f_equal2. (** Force at least one implicit when used as a view. **) Prenex Implicits esym nesym. (** A predicate for singleton types. **) Definition all_equal_to T (x0 : T) := forall x, unkeyed x = x0. Lemma unitE : all_equal_to tt. Proof. by case. Qed. (** A generic wrapper type **) #[universes(template)] Structure wrapped T := Wrap {unwrap : T}. Canonical wrap T x := @Wrap T x. Prenex Implicits unwrap wrap Wrap. (** fun_scope below is deprecated and should eventually be removed. Use function_scope instead. **) Declare Scope fun_scope. Delimit Scope fun_scope with FUN. Open Scope fun_scope. Open Scope function_scope. (** Notations for argument transpose **) Notation "f ^~ y" := (fun x => f x y) : function_scope. Notation "@^~ x" := (fun f => f x) : function_scope. (** Definitions and notation for explicit functions with simplification, i.e., which simpl and /= beta expand (this is complementary to nosimpl). **) #[universes(template)] Variant simpl_fun (aT rT : Type) := SimplFun of aT -> rT. Section SimplFun. Variables aT rT : Type. Definition fun_of_simpl (f : simpl_fun aT rT) := fun x => let: SimplFun lam := f in lam x. End SimplFun. Coercion fun_of_simpl : simpl_fun >-> Funclass. Notation "[ 'fun' : T => E ]" := (SimplFun (fun _ : T => E)) : function_scope. Notation "[ 'fun' x => E ]" := (SimplFun (fun x => E)) : function_scope. Notation "[ 'fun' x y => E ]" := (fun x => [fun y => E]) : function_scope. Notation "[ 'fun' x : T => E ]" := (SimplFun (fun x : T => E)) (only parsing) : function_scope. Notation "[ 'fun' x y : T => E ]" := (fun x : T => [fun y : T => E]) (only parsing) : function_scope. Notation "[ 'fun' ( x : T ) y => E ]" := (fun x : T => [fun y => E]) (only parsing) : function_scope. Notation "[ 'fun' x ( y : T ) => E ]" := (fun x => [fun y : T => E]) (only parsing) : function_scope. Notation "[ 'fun' ( x : T ) ( y : U ) => E ]" := (fun x : T => [fun y : U => E]) (only parsing) : function_scope. (** For delta functions in eqtype.v. **) Definition SimplFunDelta aT rT (f : aT -> aT -> rT) := [fun z => f z z]. (** Extensional equality, for unary and binary functions, including syntactic sugar. **) Section ExtensionalEquality. Variables A B C : Type. Definition eqfun (f g : B -> A) : Prop := forall x, f x = g x. Definition eqrel (r s : C -> B -> A) : Prop := forall x y, r x y = s x y. Lemma frefl f : eqfun f f. Proof. by []. Qed. Lemma fsym f g : eqfun f g -> eqfun g f. Proof. by move=> eq_fg x. Qed. Lemma ftrans f g h : eqfun f g -> eqfun g h -> eqfun f h. Proof. by move=> eq_fg eq_gh x; rewrite eq_fg. Qed. Lemma rrefl r : eqrel r r. Proof. by []. Qed. End ExtensionalEquality. Global Typeclasses Opaque eqfun eqrel. #[global] Hint Resolve frefl rrefl : core. Notation "f1 =1 f2" := (eqfun f1 f2) : type_scope. Notation "f1 =1 f2 :> A" := (f1 =1 (f2 : A)) : type_scope. Notation "f1 =2 f2" := (eqrel f1 f2) : type_scope. Notation "f1 =2 f2 :> A" := (f1 =2 (f2 : A)) : type_scope. Section Composition. Variables A B C : Type. Definition comp (f : B -> A) (g : C -> B) x := f (g x). Definition catcomp g f := comp f g. Definition pcomp (f : B -> option A) (g : C -> option B) x := obind f (g x). Lemma eq_comp f f' g g' : f =1 f' -> g =1 g' -> comp f g =1 comp f' g'. Proof. by move=> eq_ff' eq_gg' x; rewrite /comp eq_gg' eq_ff'. Qed. End Composition. Arguments comp {A B C} f g x /. Arguments catcomp {A B C} g f x /. Notation "f1 \o f2" := (comp f1 f2) : function_scope. Notation "f1 \; f2" := (catcomp f1 f2) : function_scope. Lemma compA {A B C D : Type} (f : B -> A) (g : C -> B) (h : D -> C) : f \o (g \o h) = (f \o g) \o h. Proof. by []. Qed. Notation "[ 'eta' f ]" := (fun x => f x) : function_scope. Notation "'fun' => E" := (fun _ => E) : function_scope. Notation id := (fun x => x). Notation "@ 'id' T" := (fun x : T => x) (only parsing) : function_scope. Definition idfun T x : T := x. Arguments idfun {T} x /. Definition phant_id T1 T2 v1 v2 := phantom T1 v1 -> phantom T2 v2. Section OptionTheory. Variables (aT rT sT : Type) (f : aT -> rT) (g : rT -> sT). Lemma obindEapp (fo : aT -> option rT) : obind fo = oapp fo None. Proof. by []. Qed. Lemma omapEbind : omap f = obind (olift f). Proof. by []. Qed. Lemma omapEapp : omap f = oapp (olift f) None. Proof. by []. Qed. Lemma oappEmap (y0 : rT) x : oapp f y0 x = odflt y0 (omap f x). Proof. by case: x. Qed. Lemma omap_comp : omap (g \o f) =1 omap g \o omap f. Proof. by case. Qed. Lemma oapp_comp x : oapp (g \o f) x =1 (@oapp _ _)^~ x g \o omap f. Proof. by case. Qed. Lemma oapp_comp_f (x : rT) : oapp (g \o f) (g x) =1 g \o oapp f x. Proof. by case. Qed. Lemma olift_comp : olift (g \o f) = olift g \o f. Proof. by []. Qed. End OptionTheory. (** The empty type. **) Notation void := Empty_set. Definition of_void T (x : void) : T := match x with end. (** Strong sigma types. **) Section Tag. Variables (I : Type) (i : I) (T_ U_ : I -> Type). Definition tag := projT1. Definition tagged : forall w, T_(tag w) := @projT2 I [eta T_]. Definition Tagged x := @existT I [eta T_] i x. Definition tag2 (w : @sigT2 I T_ U_) := let: existT2 _ _ i _ _ := w in i. Definition tagged2 w : T_(tag2 w) := let: existT2 _ _ _ x _ := w in x. Definition tagged2' w : U_(tag2 w) := let: existT2 _ _ _ _ y := w in y. Definition Tagged2 x y := @existT2 I [eta T_] [eta U_] i x y. End Tag. Arguments Tagged [I i]. Arguments Tagged2 [I i]. Prenex Implicits tag tagged Tagged tag2 tagged2 tagged2' Tagged2. Coercion tag_of_tag2 I T_ U_ (w : @sigT2 I T_ U_) := Tagged (fun i => T_ i * U_ i)%type (tagged2 w, tagged2' w). Lemma all_tag I T U : (forall x : I, {y : T x & U x y}) -> {f : forall x, T x & forall x, U x (f x)}. Proof. by move=> fP; exists (fun x => tag (fP x)) => x; case: (fP x). Qed. Lemma all_tag2 I T U V : (forall i : I, {y : T i & U i y & V i y}) -> {f : forall i, T i & forall i, U i (f i) & forall i, V i (f i)}. Proof. by case/all_tag=> f /all_pair[]; exists f. Qed. (** Refinement types. **) (** Prenex Implicits and renaming. **) Notation sval := (@proj1_sig _ _). Notation "@ 'sval'" := (@proj1_sig) (only parsing) : function_scope. Section Sig. Variables (T : Type) (P Q : T -> Prop). Lemma svalP (u : sig P) : P (sval u). Proof. by case: u. Qed. Definition s2val (u : sig2 P Q) := let: exist2 _ _ x _ _ := u in x. Lemma s2valP u : P (s2val u). Proof. by case: u. Qed. Lemma s2valP' u : Q (s2val u). Proof. by case: u. Qed. End Sig. Prenex Implicits svalP s2val s2valP s2valP'. Coercion tag_of_sig I P (u : @sig I P) := Tagged P (svalP u). Coercion sig_of_sig2 I P Q (u : @sig2 I P Q) := exist (fun i => P i /\ Q i) (s2val u) (conj (s2valP u) (s2valP' u)). Lemma all_sig I T P : (forall x : I, {y : T x | P x y}) -> {f : forall x, T x | forall x, P x (f x)}. Proof. by case/all_tag=> f; exists f. Qed. Lemma all_sig2 I T P Q : (forall x : I, {y : T x | P x y & Q x y}) -> {f : forall x, T x | forall x, P x (f x) & forall x, Q x (f x)}. Proof. by case/all_sig=> f /all_pair[]; exists f. Qed. Section Morphism. Variables (aT rT sT : Type) (f : aT -> rT). (** Morphism property for unary and binary functions **) Definition morphism_1 aF rF := forall x, f (aF x) = rF (f x). Definition morphism_2 aOp rOp := forall x y, f (aOp x y) = rOp (f x) (f y). (** Homomorphism property for unary and binary relations **) Definition homomorphism_1 (aP rP : _ -> Prop) := forall x, aP x -> rP (f x). Definition homomorphism_2 (aR rR : _ -> _ -> Prop) := forall x y, aR x y -> rR (f x) (f y). (** Stability property for unary and binary relations **) Definition monomorphism_1 (aP rP : _ -> sT) := forall x, rP (f x) = aP x. Definition monomorphism_2 (aR rR : _ -> _ -> sT) := forall x y, rR (f x) (f y) = aR x y. End Morphism. Notation "{ 'morph' f : x / a >-> r }" := (morphism_1 f (fun x => a) (fun x => r)) : type_scope. Notation "{ 'morph' f : x / a }" := (morphism_1 f (fun x => a) (fun x => a)) : type_scope. Notation "{ 'morph' f : x y / a >-> r }" := (morphism_2 f (fun x y => a) (fun x y => r)) : type_scope. Notation "{ 'morph' f : x y / a }" := (morphism_2 f (fun x y => a) (fun x y => a)) : type_scope. Notation "{ 'homo' f : x / a >-> r }" := (homomorphism_1 f (fun x => a) (fun x => r)) : type_scope. Notation "{ 'homo' f : x / a }" := (homomorphism_1 f (fun x => a) (fun x => a)) : type_scope. Notation "{ 'homo' f : x y / a >-> r }" := (homomorphism_2 f (fun x y => a) (fun x y => r)) : type_scope. Notation "{ 'homo' f : x y / a }" := (homomorphism_2 f (fun x y => a) (fun x y => a)) : type_scope. Notation "{ 'homo' f : x y /~ a }" := (homomorphism_2 f (fun y x => a) (fun x y => a)) : type_scope. Notation "{ 'mono' f : x / a >-> r }" := (monomorphism_1 f (fun x => a) (fun x => r)) : type_scope. Notation "{ 'mono' f : x / a }" := (monomorphism_1 f (fun x => a) (fun x => a)) : type_scope. Notation "{ 'mono' f : x y / a >-> r }" := (monomorphism_2 f (fun x y => a) (fun x y => r)) : type_scope. Notation "{ 'mono' f : x y / a }" := (monomorphism_2 f (fun x y => a) (fun x y => a)) : type_scope. Notation "{ 'mono' f : x y /~ a }" := (monomorphism_2 f (fun y x => a) (fun x y => a)) : type_scope. (** In an intuitionistic setting, we have two degrees of injectivity. The weaker one gives only simplification, and the strong one provides a left inverse (we show in `fintype' that they coincide for finite types). We also define an intermediate version where the left inverse is only a partial function. **) Section Injections. Variables (rT aT : Type) (f : aT -> rT). Definition injective := forall x1 x2, f x1 = f x2 -> x1 = x2. Definition cancel g := forall x, g (f x) = x. Definition pcancel g := forall x, g (f x) = Some x. Definition ocancel (g : aT -> option rT) h := forall x, oapp h x (g x) = x. Lemma can_pcan g : cancel g -> pcancel (fun y => Some (g y)). Proof. by move=> fK x; congr (Some _). Qed. Lemma pcan_inj g : pcancel g -> injective. Proof. by move=> fK x y /(congr1 g); rewrite !fK => [[]]. Qed. Lemma can_inj g : cancel g -> injective. Proof. by move/can_pcan; apply: pcan_inj. Qed. Lemma canLR g x y : cancel g -> x = f y -> g x = y. Proof. by move=> fK ->. Qed. Lemma canRL g x y : cancel g -> f x = y -> x = g y. Proof. by move=> fK <-. Qed. End Injections. Lemma Some_inj {T : nonPropType} : injective (@Some T). Proof. by move=> x y []. Qed. Lemma of_voidK T : pcancel (of_void T) [fun _ => None]. Proof. by case. Qed. (** cancellation lemmas for dependent type casts. **) Lemma esymK T x y : cancel (@esym T x y) (@esym T y x). Proof. by case: y /. Qed. Lemma etrans_id T x y (eqxy : x = y :> T) : etrans (erefl x) eqxy = eqxy. Proof. by case: y / eqxy. Qed. Section InjectionsTheory. Variables (A B C : Type) (f g : B -> A) (h : C -> B). Lemma inj_id : injective (@id A). Proof. by []. Qed. Lemma inj_can_sym f' : cancel f f' -> injective f' -> cancel f' f. Proof. by move=> fK injf' x; apply: injf'. Qed. Lemma inj_comp : injective f -> injective h -> injective (f \o h). Proof. by move=> injf injh x y /injf; apply: injh. Qed. Lemma inj_compr : injective (f \o h) -> injective h. Proof. by move=> injfh x y /(congr1 f) /injfh. Qed. Lemma can_comp f' h' : cancel f f' -> cancel h h' -> cancel (f \o h) (h' \o f'). Proof. by move=> fK hK x; rewrite /= fK hK. Qed. Lemma pcan_pcomp f' h' : pcancel f f' -> pcancel h h' -> pcancel (f \o h) (pcomp h' f'). Proof. by move=> fK hK x; rewrite /pcomp fK /= hK. Qed. Lemma ocan_comp [fo : B -> option A] [ho : C -> option B] [f' : A -> B] [h' : B -> C] : ocancel fo f' -> ocancel ho h' -> ocancel (obind fo \o ho) (h' \o f'). Proof. move=> fK hK c /=; rewrite -[RHS]hK/=; case hcE : (ho c) => [b|]//=. by rewrite -[b in RHS]fK; case: (fo b) => //=; have := hK c; rewrite hcE. Qed. Lemma eq_inj : injective f -> f =1 g -> injective g. Proof. by move=> injf eqfg x y; rewrite -2!eqfg; apply: injf. Qed. Lemma eq_can f' g' : cancel f f' -> f =1 g -> f' =1 g' -> cancel g g'. Proof. by move=> fK eqfg eqfg' x; rewrite -eqfg -eqfg'. Qed. Lemma inj_can_eq f' : cancel f f' -> injective f' -> cancel g f' -> f =1 g. Proof. by move=> fK injf' gK x; apply: injf'; rewrite fK. Qed. End InjectionsTheory. Section Bijections. Variables (A B : Type) (f : B -> A). Variant bijective : Prop := Bijective g of cancel f g & cancel g f. Hypothesis bijf : bijective. Lemma bij_inj : injective f. Proof. by case: bijf => g fK _; apply: can_inj fK. Qed. Lemma bij_can_sym f' : cancel f' f <-> cancel f f'. Proof. split=> fK; first exact: inj_can_sym fK bij_inj. by case: bijf => h _ hK x; rewrite -[x]hK fK. Qed. Lemma bij_can_eq f' f'' : cancel f f' -> cancel f f'' -> f' =1 f''. Proof. by move=> fK fK'; apply: (inj_can_eq _ bij_inj); apply/bij_can_sym. Qed. End Bijections. Section BijectionsTheory. Variables (A B C : Type) (f : B -> A) (h : C -> B). Lemma eq_bij : bijective f -> forall g, f =1 g -> bijective g. Proof. by case=> f' fK f'K g eqfg; exists f'; eapply eq_can; eauto. Qed. Lemma bij_comp : bijective f -> bijective h -> bijective (f \o h). Proof. by move=> [f' fK f'K] [h' hK h'K]; exists (h' \o f'); apply: can_comp; auto. Qed. Lemma bij_can_bij : bijective f -> forall f', cancel f f' -> bijective f'. Proof. by move=> bijf; exists f; first by apply/(bij_can_sym bijf). Qed. End BijectionsTheory. Section Involutions. Variables (A : Type) (f : A -> A). Definition involutive := cancel f f. Hypothesis Hf : involutive. Lemma inv_inj : injective f. Proof. exact: can_inj Hf. Qed. Lemma inv_bij : bijective f. Proof. by exists f. Qed. End Involutions. Section OperationProperties. Variables S T R : Type. Section SopTisR. Implicit Type op : S -> T -> R. Definition left_inverse e inv op := forall x, op (inv x) x = e. Definition right_inverse e inv op := forall x, op x (inv x) = e. Definition left_injective op := forall x, injective (op^~ x). Definition right_injective op := forall y, injective (op y). End SopTisR. Section SopTisS. Implicit Type op : S -> T -> S. Definition right_id e op := forall x, op x e = x. Definition left_zero z op := forall x, op z x = z. Definition right_commutative op := forall x y z, op (op x y) z = op (op x z) y. Definition left_distributive op add := forall x y z, op (add x y) z = add (op x z) (op y z). Definition right_loop inv op := forall y, cancel (op^~ y) (op^~ (inv y)). Definition rev_right_loop inv op := forall y, cancel (op^~ (inv y)) (op^~ y). End SopTisS. Section SopTisT. Implicit Type op : S -> T -> T. Definition left_id e op := forall x, op e x = x. Definition right_zero z op := forall x, op x z = z. Definition left_commutative op := forall x y z, op x (op y z) = op y (op x z). Definition right_distributive op add := forall x y z, op x (add y z) = add (op x y) (op x z). Definition left_loop inv op := forall x, cancel (op x) (op (inv x)). Definition rev_left_loop inv op := forall x, cancel (op (inv x)) (op x). End SopTisT. Section SopSisT. Implicit Type op : S -> S -> T. Definition self_inverse e op := forall x, op x x = e. Definition commutative op := forall x y, op x y = op y x. End SopSisT. Section SopSisS. Implicit Type op : S -> S -> S. Definition idempotent op := forall x, op x x = x. Definition associative op := forall x y z, op x (op y z) = op (op x y) z. Definition interchange op1 op2 := forall x y z t, op1 (op2 x y) (op2 z t) = op2 (op1 x z) (op1 y t). End SopSisS. End OperationProperties. coq-8.20.0/theories/ssr/ssrsetoid.v000066400000000000000000000030461466560755400172470ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* .doc { font-family: monospace; white-space: pre; } # **) (** Compatibility layer for [under] and [setoid_rewrite]. This file is intended to be required by [Require Import Setoid]. In particular, we can use the [under] tactic with other relations than [eq] or [iff], e.g. a [RewriteRelation], by doing: [Require Import ssreflect. Require Setoid.] This file's instances have priority 12 > other stdlib instances. (Note: this file could be skipped when porting [under] to stdlib2.) *) Require Import ssrclasses. Require Import ssrunder. Require Import RelationClasses. Require Import Relation_Definitions. (** Reconcile [Coq.Classes.RelationClasses.Reflexive] with [Coq.ssr.ssrclasses.Reflexive] *) #[global] Instance compat_Reflexive : forall {A} {R : relation A}, RelationClasses.Reflexive R -> ssrclasses.Reflexive R | 12. Proof. now trivial. Qed. coq-8.20.0/theories/ssr/ssrunder.v000066400000000000000000000056471466560755400171060ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* .doc { font-family: monospace; white-space: pre; } # **) (** Constants for under/over, to rewrite under binders using "context lemmas" Note: this file does not require [ssreflect]; it is both required by [ssrsetoid] and *exported* by [ssrunder]. This preserves the following feature: we can use [Setoid] without requiring [ssreflect] and use [ssreflect] without requiring [Setoid]. *) Require Import ssrclasses. Module Type UNDER_REL. Parameter Under_rel : forall (A : Type) (eqA : A -> A -> Prop), A -> A -> Prop. Parameter Under_rel_from_rel : forall (A : Type) (eqA : A -> A -> Prop) (x y : A), @Under_rel A eqA x y -> eqA x y. Parameter Under_relE : forall (A : Type) (eqA : A -> A -> Prop), @Under_rel A eqA = eqA. (** [Over_rel, over_rel, over_rel_done]: for "by rewrite over_rel" *) Parameter Over_rel : forall (A : Type) (eqA : A -> A -> Prop), A -> A -> Prop. Parameter over_rel : forall (A : Type) (eqA : A -> A -> Prop) (x y : A), @Under_rel A eqA x y = @Over_rel A eqA x y. Parameter over_rel_done : forall (A : Type) (eqA : A -> A -> Prop) (EeqA : Reflexive eqA) (x : A), @Over_rel A eqA x x. (** [under_rel_done]: for Ltac-style over *) Parameter under_rel_done : forall (A : Type) (eqA : A -> A -> Prop) (EeqA : Reflexive eqA) (x : A), @Under_rel A eqA x x. Notation "''Under[' x ]" := (@Under_rel _ _ x _) (at level 8, format "''Under[' x ]", only printing). End UNDER_REL. Module Export Under_rel : UNDER_REL. Definition Under_rel (A : Type) (eqA : A -> A -> Prop) := eqA. Lemma Under_rel_from_rel : forall (A : Type) (eqA : A -> A -> Prop) (x y : A), @Under_rel A eqA x y -> eqA x y. Proof. now trivial. Qed. Lemma Under_relE (A : Type) (eqA : A -> A -> Prop) : @Under_rel A eqA = eqA. Proof. now trivial. Qed. Definition Over_rel := Under_rel. Lemma over_rel : forall (A : Type) (eqA : A -> A -> Prop) (x y : A), @Under_rel A eqA x y = @Over_rel A eqA x y. Proof. now trivial. Qed. Lemma over_rel_done : forall (A : Type) (eqA : A -> A -> Prop) (EeqA : Reflexive eqA) (x : A), @Over_rel A eqA x x. Proof. now unfold Over_rel. Qed. Lemma under_rel_done : forall (A : Type) (eqA : A -> A -> Prop) (EeqA : Reflexive eqA) (x : A), @Under_rel A eqA x x. Proof. now trivial. Qed. End Under_rel. coq-8.20.0/theories/ssrmatching/000077500000000000000000000000001466560755400165515ustar00rootroot00000000000000coq-8.20.0/theories/ssrmatching/ssrmatching.v000066400000000000000000000033161466560755400212650ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* t) (only parsing) : ssrpatternscope. (* Some shortcuts for recurrent "X in t" parts. *) Notation RHS := (X in _ = X)%pattern. Notation LHS := (X in X = _)%pattern. End SsrMatchingSyntax. Export SsrMatchingSyntax. Tactic Notation "ssrpattern" ssrpatternarg(p) := ssrpattern p . coq-8.20.0/tools/000077500000000000000000000000001466560755400135455ustar00rootroot00000000000000coq-8.20.0/tools/CoqMakefile.in000066400000000000000000000771401466560755400162660ustar00rootroot00000000000000########################################################################## ## # The Coq Proof Assistant / The Coq Development Team ## ## v # Copyright INRIA, CNRS and contributors ## ## /dev/null 2>/dev/null; echo $$?)) STDTIME?=command time -f $(TIMEFMT) else ifeq (0,$(shell gtime -f "" true >/dev/null 2>/dev/null; echo $$?)) STDTIME?=gtime -f $(TIMEFMT) else STDTIME?=command time endif endif else STDTIME?=command time -f $(TIMEFMT) endif COQBIN?= ifneq (,$(COQBIN)) # add an ending / COQBIN:=$(COQBIN)/ endif # Coq binaries COQC ?= "$(COQBIN)coqc" COQTOP ?= "$(COQBIN)coqtop" COQCHK ?= "$(COQBIN)coqchk" COQNATIVE ?= "$(COQBIN)coqnative" COQDEP ?= "$(COQBIN)coqdep" COQDOC ?= "$(COQBIN)coqdoc" COQPP ?= "$(COQBIN)coqpp" COQMKFILE ?= "$(COQBIN)coq_makefile" OCAMLLIBDEP ?= "$(COQBIN)ocamllibdep" # Timing scripts COQMAKE_ONE_TIME_FILE ?= "$(COQCORELIB)/tools/make-one-time-file.py" COQMAKE_BOTH_TIME_FILES ?= "$(COQCORELIB)/tools/make-both-time-files.py" COQMAKE_BOTH_SINGLE_TIMING_FILES ?= "$(COQCORELIB)/tools/make-both-single-timing-files.py" BEFORE ?= AFTER ?= # OCaml binaries CAMLC ?= "$(OCAMLFIND)" ocamlc -c CAMLOPTC ?= "$(OCAMLFIND)" opt -c CAMLLINK ?= "$(OCAMLFIND)" ocamlc -linkall CAMLOPTLINK ?= "$(OCAMLFIND)" opt -linkall CAMLDOC ?= "$(OCAMLFIND)" ocamldoc CAMLDEP ?= "$(OCAMLFIND)" ocamldep -slash -ml-synonym .mlpack # DESTDIR is prepended to all installation paths DESTDIR ?= # Debug builds, typically -g to OCaml, -debug to Coq. CAMLDEBUG ?= COQDEBUG ?= # Extra packages to be linked in (as in findlib -package) CAMLPKGS ?= FINDLIBPKGS = -package coq-core.plugins.ltac $(CAMLPKGS) # Option for making timing files TIMING?= # Option for changing sorting of timing output file TIMING_SORT_BY ?= auto # Option for changing the fuzz parameter on the output file TIMING_FUZZ ?= 0 # Option for changing whether to use real or user time for timing tables TIMING_REAL?= # Option for including the memory column(s) TIMING_INCLUDE_MEM?= # Option for sorting by the memory column TIMING_SORT_BY_MEM?= # Output file names for timed builds TIME_OF_BUILD_FILE ?= time-of-build.log TIME_OF_BUILD_BEFORE_FILE ?= time-of-build-before.log TIME_OF_BUILD_AFTER_FILE ?= time-of-build-after.log TIME_OF_PRETTY_BUILD_FILE ?= time-of-build-pretty.log TIME_OF_PRETTY_BOTH_BUILD_FILE ?= time-of-build-both.log TIME_OF_PRETTY_BUILD_EXTRA_FILES ?= - # also output to the command line TGTS ?= # Retro compatibility (DESTDIR is standard on Unix, DSTROOT is not) ifdef DSTROOT DESTDIR := $(DSTROOT) endif # Substitution of the path by appending $(DESTDIR) if needed. # The variable $(COQMF_WINDRIVE) can be needed for Cygwin environments. windrive_path = $(if $(COQMF_WINDRIVE),$(subst $(COQMF_WINDRIVE),/,$(1)),$(1)) destination_path = $(if $(DESTDIR),$(DESTDIR)/$(call windrive_path,$(1)),$(1)) # Installation paths of libraries and documentation. COQLIBINSTALL ?= $(call destination_path,$(COQLIB)/user-contrib) COQDOCINSTALL ?= $(call destination_path,$(DOCDIR)/coq/user-contrib) COQPLUGININSTALL ?= $(call destination_path,$(COQCORELIB)/..) COQTOPINSTALL ?= $(call destination_path,$(COQLIB)/toploop) # FIXME: Unused variable? # findlib files installation FINDLIBPREINST= mkdir -p "$(COQPLUGININSTALL)/" FINDLIBDESTDIR= -destdir "$(COQPLUGININSTALL)/" # we need to move out of sight $(METAFILE) otherwise findlib thinks the # package is already installed findlib_install = \ $(HIDE)if [ "$(METAFILE)" ]; then \ $(FINDLIBPREINST) && \ mv "$(METAFILE)" "$(METAFILE).skip" ; \ "$(OCAMLFIND)" install $(2) $(FINDLIBDESTDIR) $(FINDLIBPACKAGE) $(1); \ rc=$$?; \ mv "$(METAFILE).skip" "$(METAFILE)"; \ exit $$rc; \ fi findlib_remove = \ $(HIDE)if [ ! -z "$(METAFILE)" ]; then\ "$(OCAMLFIND)" remove $(FINDLIBDESTDIR) $(FINDLIBPACKAGE); \ fi ########## End of parameters ################################################## # What follows may be relevant to you only if you need to # extend this Makefile. If so, look for 'Extension point' here and # put in @LOCAL_FILE@ double colon rules accordingly. # E.g. to perform some work after the all target completes you can write # # post-all:: # echo "All done!" # # in @LOCAL_FILE@ # ############################################################################### # Flags ####################################################################### # # We define a bunch of variables combining the parameters. # To add additional flags to coq, coqchk or coqdoc, set the # {COQ,COQCHK,COQDOC}EXTRAFLAGS variable to whatever you want to add. # To overwrite the default choice and set your own flags entirely, set the # {COQ,COQCHK,COQDOC}FLAGS variable. SHOW := $(if $(VERBOSE),@true "",@echo "") HIDE := $(if $(VERBOSE),,@) TIMER=$(if $(TIMED), $(STDTIME), $(TIMECMD)) OPT?= # The DYNOBJ and DYNLIB variables are used by "coqdep -dyndep var" in .v.d ifeq '$(OPT)' '-byte' USEBYTE:=true DYNOBJ:=.cma DYNLIB:=.cma else USEBYTE:= DYNOBJ:=.cmxs DYNLIB:=.cmxs endif # these variables are meant to be overridden if you want to add *extra* flags COQEXTRAFLAGS?= COQCHKEXTRAFLAGS?= COQDOCEXTRAFLAGS?= # Find the last argument of the form "-native-compiler FLAG" COQUSERNATIVEFLAG:=$(strip \ $(subst -native-compiler-,,\ $(lastword \ $(filter -native-compiler-%,\ $(subst -native-compiler ,-native-compiler-,\ $(strip $(COQEXTRAFLAGS))))))) COQFILTEREDEXTRAFLAGS:=$(strip \ $(filter-out -native-compiler-%,\ $(subst -native-compiler ,-native-compiler-,\ $(strip $(COQEXTRAFLAGS))))) COQACTUALNATIVEFLAG:=$(lastword $(COQMF_COQ_NATIVE_COMPILER_DEFAULT) $(COQMF_COQPROJECTNATIVEFLAG) $(COQUSERNATIVEFLAG)) ifeq '$(COQACTUALNATIVEFLAG)' 'yes' COQNATIVEFLAG="-w" "-deprecated-native-compiler-option" "-native-compiler" "ondemand" COQDONATIVE="yes" else ifeq '$(COQACTUALNATIVEFLAG)' 'ondemand' COQNATIVEFLAG="-w" "-deprecated-native-compiler-option" "-native-compiler" "ondemand" COQDONATIVE="no" else COQNATIVEFLAG="-w" "-deprecated-native-compiler-option" "-native-compiler" "no" COQDONATIVE="no" endif endif # these flags do NOT contain the libraries, to make them easier to overwrite COQFLAGS?=-q $(OTHERFLAGS) $(COQFILTEREDEXTRAFLAGS) $(COQNATIVEFLAG) COQCHKFLAGS?=-silent -o $(COQCHKEXTRAFLAGS) COQDOCFLAGS?=-interpolate -utf8 $(COQDOCEXTRAFLAGS) COQDOCLIBS?=$(COQLIBS_NOML) # The version of Coq being run and the version of coq_makefile that # generated this makefile COQ_VERSION:=$(shell $(COQC) --print-version | cut -d " " -f 1) COQMAKEFILE_VERSION:=@COQ_VERSION@ # COQ_SRC_SUBDIRS is for user-overriding, usually to add # `user-contrib/Foo` to the includes, we keep COQCORE_SRC_SUBDIRS for # Coq's own core libraries, which should be replaced by ocamlfind # options at some point. COQ_SRC_SUBDIRS?= COQSRCLIBS?= $(foreach d,$(COQ_SRC_SUBDIRS), -I "$(COQLIB)/$(d)") CAMLFLAGS+=$(OCAMLLIBS) $(COQSRCLIBS) # ocamldoc fails with unknown argument otherwise CAMLDOCFLAGS:=$(filter-out -annot, $(filter-out -bin-annot, $(CAMLFLAGS))) CAMLFLAGS+=$(OCAMLWARN) ifneq (,$(TIMING)) ifeq (after,$(TIMING)) TIMING_EXT=after-timing else ifeq (before,$(TIMING)) TIMING_EXT=before-timing else TIMING_EXT=timing endif endif TIMING_ARG=-time-file $<.$(TIMING_EXT) else TIMING_ARG= endif ifneq (,$(PROFILING)) PROFILE_ARG=-profile $<.prof.json PROFILE_ZIP=gzip -f $<.prof.json else PROFILE_ARG= PROFILE_ZIP=true endif # Files ####################################################################### # # We here define a bunch of variables about the files being part of the # Coq project in order to ease the writing of build target and build rules VDFILE := @DEP_FILE@ ALLSRCFILES := \ $(MLGFILES) \ $(MLFILES) \ $(MLPACKFILES) \ $(MLLIBFILES) \ $(MLIFILES) # helpers vo_to_obj = $(addsuffix .o,\ $(filter-out Warning: Error:,\ $(shell $(COQTOP) -q -noinit -batch -quiet -print-mod-uid $(1)))) strip_dotslash = $(patsubst ./%,%,$(1)) # without this we get undefined variables in the expansion for the # targets of the [deprecated,use-mllib-or-mlpack] rule with_undef = $(if $(filter-out undefined, $(origin $(1))),$($(1))) VO = vo VOS = vos VOFILES = $(VFILES:.v=.$(VO)) GLOBFILES = $(VFILES:.v=.glob) HTMLFILES = $(VFILES:.v=.html) GHTMLFILES = $(VFILES:.v=.g.html) BEAUTYFILES = $(addsuffix .beautified,$(VFILES)) TEXFILES = $(VFILES:.v=.tex) GTEXFILES = $(VFILES:.v=.g.tex) CMOFILES = \ $(MLGFILES:.mlg=.cmo) \ $(MLFILES:.ml=.cmo) \ $(MLPACKFILES:.mlpack=.cmo) CMXFILES = $(CMOFILES:.cmo=.cmx) OFILES = $(CMXFILES:.cmx=.o) CMAFILES = $(MLLIBFILES:.mllib=.cma) $(MLPACKFILES:.mlpack=.cma) CMXAFILES = $(CMAFILES:.cma=.cmxa) CMIFILES = \ $(CMOFILES:.cmo=.cmi) \ $(MLIFILES:.mli=.cmi) # the /if/ is because old _CoqProject did not list a .ml(pack|lib) but just # a .mlg file CMXSFILES = \ $(MLPACKFILES:.mlpack=.cmxs) \ $(CMXAFILES:.cmxa=.cmxs) \ $(if $(MLPACKFILES)$(CMXAFILES),,\ $(MLGFILES:.mlg=.cmxs) $(MLFILES:.ml=.cmxs)) # files that are packed into a plugin (no extension) PACKEDFILES = \ $(call strip_dotslash, \ $(foreach lib, \ $(call strip_dotslash, \ $(MLPACKFILES:.mlpack=_MLPACK_DEPENDENCIES)),$(call with_undef,$(lib)))) # files that are archived into a .cma (mllib) LIBEDFILES = \ $(call strip_dotslash, \ $(foreach lib, \ $(call strip_dotslash, \ $(MLLIBFILES:.mllib=_MLLIB_DEPENDENCIES)),$(call with_undef,$(lib)))) CMIFILESTOINSTALL = $(filter-out $(addsuffix .cmi,$(PACKEDFILES)),$(CMIFILES)) CMOFILESTOINSTALL = $(filter-out $(addsuffix .cmo,$(PACKEDFILES)),$(CMOFILES)) OBJFILES = $(call vo_to_obj,$(VOFILES)) ALLNATIVEFILES = \ $(OBJFILES:.o=.cmi) \ $(OBJFILES:.o=.cmx) \ $(OBJFILES:.o=.cmxs) FINDLIBPACKAGE=$(patsubst .%,%,$(suffix $(METAFILE))) # trick: wildcard filters out non-existing files, so that `install` doesn't show # warnings and `clean` doesn't pass to rm a list of files that is too long for # the shell. NATIVEFILES = $(wildcard $(ALLNATIVEFILES)) FILESTOINSTALL = \ $(VOFILES) \ $(VFILES) \ $(GLOBFILES) \ $(NATIVEFILES) \ $(CMXSFILES) # to be removed when we remove legacy loading FINDLIBFILESTOINSTALL = \ $(CMIFILESTOINSTALL) ifeq '$(HASNATDYNLINK)' 'true' DO_NATDYNLINK = yes FINDLIBFILESTOINSTALL += $(CMXSFILES) $(CMXAFILES) $(CMOFILESTOINSTALL:.cmo=.cmx) else DO_NATDYNLINK = endif ALLDFILES = $(addsuffix .d,$(ALLSRCFILES)) $(VDFILE) # Compilation targets ######################################################### all: $(HIDE)$(MAKE) --no-print-directory -f "$(SELF)" pre-all $(HIDE)$(MAKE) --no-print-directory -f "$(SELF)" real-all $(HIDE)$(MAKE) --no-print-directory -f "$(SELF)" post-all .PHONY: all all.timing.diff: $(HIDE)$(MAKE) --no-print-directory -f "$(SELF)" pre-all $(HIDE)$(MAKE) --no-print-directory -f "$(SELF)" real-all.timing.diff TIME_OF_PRETTY_BUILD_EXTRA_FILES="" $(HIDE)$(MAKE) --no-print-directory -f "$(SELF)" post-all .PHONY: all.timing.diff ifeq (0,$(TIMING_REAL)) TIMING_REAL_ARG := TIMING_USER_ARG := --user else ifeq (1,$(TIMING_REAL)) TIMING_REAL_ARG := --real TIMING_USER_ARG := else TIMING_REAL_ARG := TIMING_USER_ARG := endif endif ifeq (0,$(TIMING_INCLUDE_MEM)) TIMING_INCLUDE_MEM_ARG := --no-include-mem else TIMING_INCLUDE_MEM_ARG := endif ifeq (1,$(TIMING_SORT_BY_MEM)) TIMING_SORT_BY_MEM_ARG := --sort-by-mem else TIMING_SORT_BY_MEM_ARG := endif make-pretty-timed-before:: TIME_OF_BUILD_FILE=$(TIME_OF_BUILD_BEFORE_FILE) make-pretty-timed-after:: TIME_OF_BUILD_FILE=$(TIME_OF_BUILD_AFTER_FILE) make-pretty-timed make-pretty-timed-before make-pretty-timed-after:: $(HIDE)rm -f pretty-timed-success.ok $(HIDE)($(MAKE) --no-print-directory -f "$(PARENT)" $(TGTS) TIMED=1 2>&1 && touch pretty-timed-success.ok) | tee -a $(TIME_OF_BUILD_FILE) $(HIDE)rm pretty-timed-success.ok # must not be -f; must fail if the touch failed print-pretty-timed:: $(HIDE)$(COQMAKE_ONE_TIME_FILE) $(TIMING_INCLUDE_MEM_ARG) $(TIMING_SORT_BY_MEM_ARG) $(TIMING_REAL_ARG) $(TIME_OF_BUILD_FILE) $(TIME_OF_PRETTY_BUILD_FILE) $(TIME_OF_PRETTY_BUILD_EXTRA_FILES) print-pretty-timed-diff:: $(HIDE)$(COQMAKE_BOTH_TIME_FILES) --sort-by=$(TIMING_SORT_BY) $(TIMING_INCLUDE_MEM_ARG) $(TIMING_SORT_BY_MEM_ARG) $(TIMING_REAL_ARG) $(TIME_OF_BUILD_AFTER_FILE) $(TIME_OF_BUILD_BEFORE_FILE) $(TIME_OF_PRETTY_BOTH_BUILD_FILE) $(TIME_OF_PRETTY_BUILD_EXTRA_FILES) ifeq (,$(BEFORE)) print-pretty-single-time-diff:: @echo 'Error: Usage: $(MAKE) print-pretty-single-time-diff AFTER=path/to/file.v.after-timing BEFORE=path/to/file.v.before-timing' $(HIDE)false else ifeq (,$(AFTER)) print-pretty-single-time-diff:: @echo 'Error: Usage: $(MAKE) print-pretty-single-time-diff AFTER=path/to/file.v.after-timing BEFORE=path/to/file.v.before-timing' $(HIDE)false else print-pretty-single-time-diff:: $(HIDE)$(COQMAKE_BOTH_SINGLE_TIMING_FILES) --fuzz=$(TIMING_FUZZ) --sort-by=$(TIMING_SORT_BY) $(TIMING_USER_ARG) $(AFTER) $(BEFORE) $(TIME_OF_PRETTY_BUILD_FILE) $(TIME_OF_PRETTY_BUILD_EXTRA_FILES) endif endif pretty-timed: $(HIDE)$(MAKE) --no-print-directory -f "$(PARENT)" make-pretty-timed $(HIDE)$(MAKE) --no-print-directory -f "$(SELF)" print-pretty-timed .PHONY: pretty-timed make-pretty-timed make-pretty-timed-before make-pretty-timed-after print-pretty-timed print-pretty-timed-diff print-pretty-single-time-diff # Extension points for actions to be performed before/after the all target pre-all:: @# Extension point $(HIDE)if [ "$(COQMAKEFILE_VERSION)" != "$(COQ_VERSION)" ]; then\ echo "W: This Makefile was generated by Coq $(COQMAKEFILE_VERSION)";\ echo "W: while the current Coq version is $(COQ_VERSION)";\ fi .PHONY: pre-all post-all:: @# Extension point .PHONY: post-all real-all: $(VOFILES) $(if $(USEBYTE),bytefiles,optfiles) .PHONY: real-all real-all.timing.diff: $(VOFILES:.vo=.v.timing.diff) .PHONY: real-all.timing.diff bytefiles: $(CMOFILES) $(CMAFILES) .PHONY: bytefiles optfiles: $(if $(DO_NATDYNLINK),$(CMXSFILES)) .PHONY: optfiles vos: $(VOFILES:%.vo=%.vos) .PHONY: vos vok: $(VOFILES:%.vo=%.vok) .PHONY: vok validate: $(VOFILES) $(TIMER) $(COQCHK) $(COQCHKFLAGS) $(COQLIBS_NOML) $^ .PHONY: validate only: $(TGTS) .PHONY: only # Documentation targets ####################################################### html: $(GLOBFILES) $(VFILES) $(SHOW)'COQDOC -d html $(GAL)' $(HIDE)mkdir -p html $(HIDE)$(COQDOC) \ -toc $(COQDOCFLAGS) -html $(GAL) $(COQDOCLIBS) -d html $(VFILES) mlihtml: $(MLIFILES:.mli=.cmi) $(SHOW)'CAMLDOC -d $@' $(HIDE)mkdir $@ || rm -rf $@/* $(HIDE)$(CAMLDOC) -html \ -d $@ -m A $(CAMLDEBUG) $(CAMLDOCFLAGS) $(MLIFILES) $(FINDLIBPKGS) all-mli.tex: $(MLIFILES:.mli=.cmi) $(SHOW)'CAMLDOC -latex $@' $(HIDE)$(CAMLDOC) -latex \ -o $@ -m A $(CAMLDEBUG) $(CAMLDOCFLAGS) $(MLIFILES) $(FINDLIBPKGS) all.ps: $(VFILES) $(SHOW)'COQDOC -ps $(GAL)' $(HIDE)$(COQDOC) \ -toc $(COQDOCFLAGS) -ps $(GAL) $(COQDOCLIBS) \ -o $@ `$(COQDEP) -sort $(VFILES)` all.pdf: $(VFILES) $(SHOW)'COQDOC -pdf $(GAL)' $(HIDE)$(COQDOC) \ -toc $(COQDOCFLAGS) -pdf $(GAL) $(COQDOCLIBS) \ -o $@ `$(COQDEP) -sort $(VFILES)` # FIXME: not quite right, since the output name is different gallinahtml: GAL=-g gallinahtml: html all-gal.ps: GAL=-g all-gal.ps: all.ps all-gal.pdf: GAL=-g all-gal.pdf: all.pdf # ? beautify: $(BEAUTYFILES) for file in $^; do mv $${file%.beautified} $${file%beautified}old && mv $${file} $${file%.beautified}; done @echo 'Do not do "make clean" until you are sure that everything went well!' @echo 'If there were a problem, execute "for file in $$(find . -name \*.v.old -print); do mv $${file} $${file%.old}; done" in your shell/' .PHONY: beautify # Installation targets ######################################################## # # There rules can be extended in @LOCAL_FILE@ # Extensions can't assume when they run. # We use $(file) to avoid generating a very long command string to pass to the shell # (cf https://coq.zulipchat.com/#narrow/stream/250632-Coq-Platform-devs-.26-users/topic/Strange.20command.20length.20limit.20on.20Linux) # However Apple ships old make which doesn't have $(file) so we need a fallback $(file >.hasfile,1) HASFILE:=$(shell if [ -e .hasfile ]; then echo 1; rm .hasfile; fi) MKFILESTOINSTALL= $(if $(HASFILE),$(file >.filestoinstall,$(FILESTOINSTALL)),\ $(shell rm -f .filestoinstall) \ $(foreach x,$(FILESTOINSTALL),$(shell printf '%s\n' "$x" >> .filestoinstall))) # findlib needs the package to not be installed, so we remove it before # installing it (see the call to findlib_remove) install: META @$(MKFILESTOINSTALL) $(HIDE)code=0; for f in $$(cat .filestoinstall); do\ if ! [ -f "$$f" ]; then >&2 echo $$f does not exist; code=1; fi \ done; exit $$code $(HIDE)for f in $$(cat .filestoinstall); do\ df="`$(COQMKFILE) -destination-of "$$f" $(COQLIBS)`";\ if [ "$$?" != "0" -o -z "$$df" ]; then\ echo SKIP "$$f" since it has no logical path;\ else\ install -d "$(COQLIBINSTALL)/$$df" &&\ install -m 0644 "$$f" "$(COQLIBINSTALL)/$$df" &&\ echo INSTALL "$$f" "$(COQLIBINSTALL)/$$df";\ fi;\ done $(call findlib_remove) $(call findlib_install, META $(FINDLIBFILESTOINSTALL)) $(HIDE)$(MAKE) install-extra -f "$(SELF)" @rm -f .filestoinstall install-extra:: @# Extension point .PHONY: install install-extra META: $(METAFILE) $(HIDE)if [ "$(METAFILE)" ]; then \ cat "$(METAFILE)" | grep -v 'directory.*=.*' > META; \ fi install-byte: $(call findlib_install, $(CMAFILES) $(CMOFILESTOINSTALL), -add) install-doc:: html mlihtml @# Extension point $(HIDE)install -d "$(COQDOCINSTALL)/$(INSTALLCOQDOCROOT)/html" $(HIDE)for i in html/*; do \ dest="$(COQDOCINSTALL)/$(INSTALLCOQDOCROOT)/$$i";\ install -m 0644 "$$i" "$$dest";\ echo INSTALL "$$i" "$$dest";\ done $(HIDE)install -d \ "$(COQDOCINSTALL)/$(INSTALLCOQDOCROOT)/mlihtml" $(HIDE)for i in mlihtml/*; do \ dest="$(COQDOCINSTALL)/$(INSTALLCOQDOCROOT)/$$i";\ install -m 0644 "$$i" "$$dest";\ echo INSTALL "$$i" "$$dest";\ done .PHONY: install-doc uninstall:: @# Extension point @$(MKFILESTOINSTALL) $(call findlib_remove) $(HIDE)for f in $$(cat .filestoinstall); do \ df="`$(COQMKFILE) -destination-of "$$f" $(COQLIBS)`" &&\ instf="$(COQLIBINSTALL)/$$df/`basename $$f`" &&\ rm -f "$$instf" &&\ echo RM "$$instf" ;\ done $(HIDE)for f in $$(cat .filestoinstall); do \ df="`$(COQMKFILE) -destination-of "$$f" $(COQLIBS)`" &&\ echo RMDIR "$(COQLIBINSTALL)/$$df/" &&\ (rmdir "$(COQLIBINSTALL)/$$df/" 2>/dev/null || true); \ done @rm -f .filestoinstall .PHONY: uninstall uninstall-doc:: @# Extension point $(SHOW)'RM $(COQDOCINSTALL)/$(INSTALLCOQDOCROOT)/html' $(HIDE)rm -rf "$(COQDOCINSTALL)/$(INSTALLCOQDOCROOT)/html" $(SHOW)'RM $(COQDOCINSTALL)/$(INSTALLCOQDOCROOT)/mlihtml' $(HIDE)rm -rf "$(COQDOCINSTALL)/$(INSTALLCOQDOCROOT)/mlihtml" $(HIDE) rmdir "$(COQDOCINSTALL)/$(INSTALLCOQDOCROOT)/" || true .PHONY: uninstall-doc # Cleaning #################################################################### # # There rules can be extended in @LOCAL_FILE@ # Extensions can't assume when they run. clean:: @# Extension point $(SHOW)'CLEAN' $(HIDE)rm -f $(CMOFILES) $(HIDE)rm -f $(CMIFILES) $(HIDE)rm -f $(CMAFILES) $(HIDE)rm -f $(CMXFILES) $(HIDE)rm -f $(CMXAFILES) $(HIDE)rm -f $(CMXSFILES) $(HIDE)rm -f $(OFILES) $(HIDE)rm -f $(CMXAFILES:.cmxa=.a) $(HIDE)rm -f $(MLGFILES:.mlg=.ml) $(HIDE)rm -f $(CMXFILES:.cmx=.cmt) $(HIDE)rm -f $(MLIFILES:.mli=.cmti) $(HIDE)rm -f $(ALLDFILES) $(HIDE)rm -f $(NATIVEFILES) $(HIDE)find . -name .coq-native -type d -empty -delete $(HIDE)rm -f $(VOFILES) $(HIDE)rm -f $(VOFILES:.vo=.vos) $(HIDE)rm -f $(VOFILES:.vo=.vok) $(HIDE)rm -f $(VOFILES:.vo=.v.prof.json) $(HIDE)rm -f $(VOFILES:.vo=.v.prof.json.gz) $(HIDE)rm -f $(BEAUTYFILES) $(VFILES:=.old) $(HIDE)rm -f all.ps all-gal.ps all.pdf all-gal.pdf all.glob all-mli.tex $(HIDE)rm -f $(VFILES:.v=.glob) $(HIDE)rm -f $(VFILES:.v=.tex) $(HIDE)rm -f $(VFILES:.v=.g.tex) $(HIDE)rm -f pretty-timed-success.ok $(HIDE)rm -f META $(HIDE)rm -rf html mlihtml .PHONY: clean cleanall:: clean @# Extension point $(SHOW)'CLEAN *.aux *.timing' $(HIDE)rm -f $(foreach f,$(VFILES:.v=),$(dir $(f)).$(notdir $(f)).aux) $(HIDE)rm -f $(TIME_OF_BUILD_FILE) $(TIME_OF_BUILD_BEFORE_FILE) $(TIME_OF_BUILD_AFTER_FILE) $(TIME_OF_PRETTY_BUILD_FILE) $(TIME_OF_PRETTY_BOTH_BUILD_FILE) $(HIDE)rm -f $(VOFILES:.vo=.v.timing) $(HIDE)rm -f $(VOFILES:.vo=.v.before-timing) $(HIDE)rm -f $(VOFILES:.vo=.v.after-timing) $(HIDE)rm -f $(VOFILES:.vo=.v.timing.diff) $(HIDE)rm -f .lia.cache .nia.cache .PHONY: cleanall archclean:: @# Extension point $(SHOW)'CLEAN *.cmx *.o' $(HIDE)rm -f $(NATIVEFILES) $(HIDE)rm -f $(CMOFILES:%.cmo=%.cmx) .PHONY: archclean # Compilation rules ########################################################### $(MLIFILES:.mli=.cmi): %.cmi: %.mli $(SHOW)'CAMLC -c $<' $(HIDE)$(TIMER) $(CAMLC) $(CAMLDEBUG) $(CAMLFLAGS) $(FINDLIBPKGS) $< $(MLGFILES:.mlg=.ml): %.ml: %.mlg $(SHOW)'COQPP $<' $(HIDE)$(COQPP) $< # Stupid hack around a deficient syntax: we cannot concatenate two expansions $(filter %.cmo, $(MLFILES:.ml=.cmo) $(MLGFILES:.mlg=.cmo)): %.cmo: %.ml $(SHOW)'CAMLC -c $<' $(HIDE)$(TIMER) $(CAMLC) $(CAMLDEBUG) $(CAMLFLAGS) $(FINDLIBPKGS) $< # Same hack $(filter %.cmx, $(MLFILES:.ml=.cmx) $(MLGFILES:.mlg=.cmx)): %.cmx: %.ml $(SHOW)'CAMLOPT -c $(FOR_PACK) $<' $(HIDE)$(TIMER) $(CAMLOPTC) $(CAMLDEBUG) $(CAMLFLAGS) $(FINDLIBPKGS) $(FOR_PACK) $< $(MLLIBFILES:.mllib=.cmxs): %.cmxs: %.cmxa $(SHOW)'CAMLOPT -shared -o $@' $(HIDE)$(TIMER) $(CAMLOPTLINK) $(CAMLDEBUG) $(CAMLFLAGS) $(FINDLIBPKGS) \ -shared -o $@ $< $(MLLIBFILES:.mllib=.cma): %.cma: | %.mllib $(SHOW)'CAMLC -a -o $@' $(HIDE)$(TIMER) $(CAMLLINK) $(CAMLDEBUG) $(CAMLFLAGS) $(FINDLIBPKGS) -a -o $@ $^ $(MLLIBFILES:.mllib=.cmxa): %.cmxa: | %.mllib $(SHOW)'CAMLOPT -a -o $@' $(HIDE)$(TIMER) $(CAMLOPTLINK) $(CAMLDEBUG) $(CAMLFLAGS) $(FINDLIBPKGS) -a -o $@ $^ $(MLPACKFILES:.mlpack=.cmxs): %.cmxs: %.cmxa $(SHOW)'CAMLOPT -shared -o $@' $(HIDE)$(TIMER) $(CAMLOPTLINK) $(CAMLDEBUG) $(CAMLFLAGS) $(FINDLIBPKGS) \ -shared -o $@ $< $(MLPACKFILES:.mlpack=.cmxa): %.cmxa: %.cmx | %.mlpack $(SHOW)'CAMLOPT -a -o $@' $(HIDE)$(TIMER) $(CAMLOPTLINK) $(CAMLDEBUG) $(CAMLFLAGS) $(FINDLIBPKGS) -a -o $@ $< $(MLPACKFILES:.mlpack=.cma): %.cma: %.cmo | %.mlpack $(SHOW)'CAMLC -a -o $@' $(HIDE)$(TIMER) $(CAMLLINK) $(CAMLDEBUG) $(CAMLFLAGS) $(FINDLIBPKGS) -a -o $@ $^ $(MLPACKFILES:.mlpack=.cmo): %.cmo: | %.mlpack $(SHOW)'CAMLC -pack -o $@' $(HIDE)$(TIMER) $(CAMLLINK) $(CAMLDEBUG) $(CAMLFLAGS) $(FINDLIBPKGS) -pack -o $@ $^ $(MLPACKFILES:.mlpack=.cmx): %.cmx: | %.mlpack $(SHOW)'CAMLOPT -pack -o $@' $(HIDE)$(TIMER) $(CAMLOPTLINK) $(CAMLDEBUG) $(CAMLFLAGS) $(FINDLIBPKGS) -pack -o $@ $^ # This rule is for _CoqProject with no .mllib nor .mlpack $(filter-out $(MLLIBFILES:.mllib=.cmxs) $(MLPACKFILES:.mlpack=.cmxs) $(addsuffix .cmxs,$(PACKEDFILES)) $(addsuffix .cmxs,$(LIBEDFILES)),$(MLFILES:.ml=.cmxs) $(MLGFILES:.mlg=.cmxs)): %.cmxs: %.cmx $(SHOW)'[deprecated,use-mllib-or-mlpack] CAMLOPT -shared -o $@' $(HIDE)$(TIMER) $(CAMLOPTLINK) $(CAMLDEBUG) $(CAMLFLAGS) $(FINDLIBPKGS) \ -shared -o $@ $< # can't make # https://www.gnu.org/software/make/manual/make.html#Static-Pattern # work with multiple target rules # so use eval in a loop instead # with grouped targets https://www.gnu.org/software/make/manual/make.html#Multiple-Targets # if available (GNU Make >= 4.3) ifneq (,$(filter grouped-target,$(.FEATURES))) define globvorule= # take care to $$ variables using $< etc $(1).vo $(1).glob &: $(1).v | $$(VDFILE) $$(SHOW)COQC $(1).v $$(HIDE)$$(TIMER) $$(COQC) $$(COQDEBUG) $$(TIMING_ARG) $$(PROFILE_ARG) $$(COQFLAGS) $$(COQLIBS) $(1).v $$(HIDE)$$(PROFILE_ZIP) ifeq ($(COQDONATIVE), "yes") $$(SHOW)COQNATIVE $(1).vo $$(HIDE)$$(call TIMER,$(1).vo.native) $$(COQNATIVE) $$(COQLIBS) $(1).vo endif endef else $(VOFILES): %.vo: %.v | $(VDFILE) $(SHOW)COQC $< $(HIDE)$(TIMER) $(COQC) $(COQDEBUG) $(TIMING_ARG) $(PROFILE_ARG) $(COQFLAGS) $(COQLIBS) $< $(HIDE)$(PROFILE_ZIP) ifeq ($(COQDONATIVE), "yes") $(SHOW)COQNATIVE $@ $(HIDE)$(call TIMER,$@.native) $(COQNATIVE) $(COQLIBS) $@ endif # this is broken :( todo fix if we ever find a solution that doesn't need grouped targets $(GLOBFILES): %.glob: %.v $(SHOW)'COQC $< (for .glob)' $(HIDE)$(TIMER) $(COQC) $(COQDEBUG) $(COQFLAGS) $(COQLIBS) $< endif $(foreach vfile,$(VFILES:.v=),$(eval $(call globvorule,$(vfile)))) $(VFILES:.v=.vos): %.vos: %.v $(SHOW)COQC -vos $< $(HIDE)$(TIMER) $(COQC) -vos $(COQDEBUG) $(COQFLAGS) $(COQLIBS) $< $(VFILES:.v=.vok): %.vok: %.v $(SHOW)COQC -vok $< $(HIDE)$(TIMER) $(COQC) -vok $(COQDEBUG) $(COQFLAGS) $(COQLIBS) $< $(addsuffix .timing.diff,$(VFILES)): %.timing.diff : %.before-timing %.after-timing $(SHOW)PYTHON TIMING-DIFF $*.{before,after}-timing $(HIDE)$(MAKE) --no-print-directory -f "$(SELF)" print-pretty-single-time-diff BEFORE=$*.before-timing AFTER=$*.after-timing TIME_OF_PRETTY_BUILD_FILE="$@" $(BEAUTYFILES): %.v.beautified: %.v $(SHOW)'BEAUTIFY $<' $(HIDE)$(TIMER) $(COQC) $(COQDEBUG) $(COQFLAGS) $(COQLIBS) -beautify $< $(TEXFILES): %.tex: %.v $(SHOW)'COQDOC -latex $<' $(HIDE)$(COQDOC) $(COQDOCFLAGS) -latex $< -o $@ $(GTEXFILES): %.g.tex: %.v $(SHOW)'COQDOC -latex -g $<' $(HIDE)$(COQDOC) $(COQDOCFLAGS) -latex -g $< -o $@ $(HTMLFILES): %.html: %.v %.glob $(SHOW)'COQDOC -html $<' $(HIDE)$(COQDOC) $(COQDOCFLAGS) -html $< -o $@ $(GHTMLFILES): %.g.html: %.v %.glob $(SHOW)'COQDOC -html -g $<' $(HIDE)$(COQDOC) $(COQDOCFLAGS) -html -g $< -o $@ # Dependency files ############################################################ ifndef MAKECMDGOALS -include $(ALLDFILES) else ifneq ($(filter-out archclean clean cleanall printenv make-pretty-timed make-pretty-timed-before make-pretty-timed-after print-pretty-timed print-pretty-timed-diff print-pretty-single-time-diff,$(MAKECMDGOALS)),) -include $(ALLDFILES) endif endif .SECONDARY: $(ALLDFILES) redir_if_ok = > "$@" || ( RV=$$?; rm -f "$@"; exit $$RV ) GENMLFILES:=$(MLGFILES:.mlg=.ml) $(addsuffix .d,$(ALLSRCFILES)): $(GENMLFILES) $(addsuffix .d,$(MLIFILES)): %.mli.d: %.mli $(SHOW)'CAMLDEP $<' $(HIDE)$(CAMLDEP) $(OCAMLLIBS) "$<" $(redir_if_ok) $(addsuffix .d,$(MLGFILES)): %.mlg.d: %.ml $(SHOW)'CAMLDEP $<' $(HIDE)$(CAMLDEP) $(OCAMLLIBS) "$<" $(redir_if_ok) $(addsuffix .d,$(MLFILES)): %.ml.d: %.ml $(SHOW)'CAMLDEP $<' $(HIDE)$(CAMLDEP) $(OCAMLLIBS) "$<" $(redir_if_ok) $(addsuffix .d,$(MLLIBFILES)): %.mllib.d: %.mllib $(SHOW)'OCAMLLIBDEP $<' $(HIDE)$(OCAMLLIBDEP) -c $(OCAMLLIBS) "$<" $(redir_if_ok) $(addsuffix .d,$(MLPACKFILES)): %.mlpack.d: %.mlpack $(SHOW)'OCAMLLIBDEP $<' $(HIDE)$(OCAMLLIBDEP) -c $(OCAMLLIBS) "$<" $(redir_if_ok) # If this makefile is created using a _CoqProject we have coqdep get # options from it. This avoids argument length limits for pathological # projects. Note that extra options might be on the command line. VDFILE_FLAGS:=$(if @PROJECT_FILE@,-f @PROJECT_FILE@,) $(CMDLINE_COQLIBS) $(CMDLINE_VFILES) $(VDFILE): @PROJECT_FILE@ $(VFILES) $(SHOW)'COQDEP VFILES' $(HIDE)$(COQDEP) $(if $(strip $(METAFILE)),-m "$(METAFILE)") -vos -dyndep var $(VDFILE_FLAGS) $(redir_if_ok) # Misc ######################################################################## byte: $(HIDE)$(MAKE) all "OPT:=-byte" -f "$(SELF)" .PHONY: byte opt: $(HIDE)$(MAKE) all "OPT:=-opt" -f "$(SELF)" .PHONY: opt # This is deprecated. To extend this makefile use # extension points and @LOCAL_FILE@ printenv:: $(warning printenv is deprecated) $(warning write extensions in @LOCAL_FILE@ or include @CONF_FILE@) @echo 'COQLIB = $(COQLIB)' @echo 'COQCORELIB = $(COQCORELIB)' @echo 'DOCDIR = $(DOCDIR)' @echo 'OCAMLFIND = $(OCAMLFIND)' @echo 'HASNATDYNLINK = $(HASNATDYNLINK)' @echo 'SRC_SUBDIRS = $(SRC_SUBDIRS)' @echo 'COQ_SRC_SUBDIRS = $(COQ_SRC_SUBDIRS)' @echo 'COQCORE_SRC_SUBDIRS = $(COQCORE_SRC_SUBDIRS)' @echo 'OCAMLFIND = $(OCAMLFIND)' @echo 'PP = $(PP)' @echo 'COQFLAGS = $(COQFLAGS)' @echo 'COQLIB = $(COQLIBS)' @echo 'COQLIBINSTALL = $(COQLIBINSTALL)' @echo 'COQDOCINSTALL = $(COQDOCINSTALL)' .PHONY: printenv # Generate a .merlin file. If you need to append directives to this # file you can extend the merlin-hook target in @LOCAL_FILE@ .merlin: $(SHOW)'FILL .merlin' $(HIDE)echo 'FLG $(COQMF_CAMLFLAGS)' > .merlin $(HIDE)echo 'B $(COQCORELIB)' >> .merlin $(HIDE)echo 'S $(COQCORELIB)' >> .merlin $(HIDE)$(foreach d,$(COQCORE_SRC_SUBDIRS), \ echo 'B $(COQCORELIB)$(d)' >> .merlin;) $(HIDE)$(foreach d,$(COQ_SRC_SUBDIRS), \ echo 'S $(COQLIB)$(d)' >> .merlin;) $(HIDE)$(foreach d,$(SRC_SUBDIRS), echo 'B $(d)' >> .merlin;) $(HIDE)$(foreach d,$(SRC_SUBDIRS), echo 'S $(d)' >> .merlin;) $(HIDE)$(MAKE) merlin-hook -f "$(SELF)" .PHONY: merlin merlin-hook:: @# Extension point .PHONY: merlin-hook # prints all variables debug: $(foreach v,\ $(sort $(filter-out $(INITIAL_VARS) INITIAL_VARS,\ $(.VARIABLES))),\ $(info $(v) = $($(v)))) .PHONY: debug .DEFAULT_GOAL := all # Users can create @LOCAL_LATE_FILE@ to hook into double-colon rules # or add other needed Makefile code, using defined # variables if necessary. -include @LOCAL_LATE_FILE@ # Local Variables: # mode: makefile-gmake # End: coq-8.20.0/tools/TimeFileMaker.py000066400000000000000000000644221466560755400166050ustar00rootroot00000000000000from __future__ import with_statement from __future__ import division from __future__ import unicode_literals from __future__ import print_function import sys import re import argparse import os import math from io import open # This script parses the output of `make TIMED=1` into a dictionary # mapping names of compiled files to the number of minutes and seconds # that they took to compile. STRIP_REG = re.compile('^(?:%s/)?(coq/|contrib/|)(?:theories/|src/)?' % re.escape(os.getcwd())) STRIP_REP = r'\1' INFINITY = '\u221e' TIME_KEY = 'time' MEM_KEY = 'mem' def nonnegative(arg): v = int(arg) if v < 0: raise argparse.ArgumentTypeError("%s is an invalid non-negative int value" % arg) return v def add_sort_by(parser): return parser.add_argument( '--sort-by', type=str, dest='sort_by', choices=('auto', 'absolute', 'diff'), default='auto', help=('How to sort the table entries.\n' + 'The "auto" method sorts by absolute time differences ' + 'rounded towards zero to a whole-number of seconds, then ' + 'by times in the "after" column, and finally ' + 'lexicographically by file name. This will put the ' + 'biggest changes in either direction first, and will ' + 'prefer sorting by build-time over subsecond changes in ' + 'build time (which are frequently noise); lexicographic ' + 'sorting forces an order on files which take effectively ' + 'no time to compile.\n' + 'The "absolute" method sorts by the total time taken.\n' + 'The "diff" method sorts by the signed difference in time.')) def add_sort_by_mem(parser): return parser.add_argument( '--sort-by-mem', action='store_true', dest='sort_by_mem', help=('Sort the table entries by memory rather than time.')) def add_fuzz(parser): return parser.add_argument( '--fuzz', dest='fuzz', metavar='N', type=nonnegative, default=0, help=('By default, two lines are only considered the same if ' + 'the character offsets and initial code strings match. ' 'This option relaxes this constraint by allowing the ' + 'character offsets to differ by up to N characters, as long ' + 'as the total number of characters and initial code strings ' + 'continue to match. This is useful when there are small changes ' + 'to a file, and you want to match later lines that have not ' + 'changed even though the character offsets have changed.')) def add_real(parser, single_timing=False): return parser.add_argument( '--real', action='store_true', help=(r'''Use real times rather than user times. ''' + ('''By default, the input is expected to contain lines in the format: FILE_NAME (...user: NUMBER_IN_SECONDS...mem: NUMBER ko...) If --real is passed, then the lines are instead expected in the format: FILE_NAME (...real: NUMBER_IN_SECONDS...mem: NUMBER ko...)''' if not single_timing else '''The input is expected to contain lines in the format: Chars START - END COMMAND NUMBER secs (NUMBERu...)'''))) def add_user(parser, single_timing=False): return parser.add_argument( '--user', dest='real', action='store_false', help=(r'''Use user times rather than real times. ''' + ('''By default, the input is expected to contain lines in the format: FILE_NAME (...real: NUMBER_IN_SECONDS...mem: NUMBER ko...) If --user is passed, then the lines are instead expected in the format: FILE_NAME (...user: NUMBER_IN_SECONDS...mem: NUMBER ko...)''' if not single_timing else '''The input is expected to contain lines in the format: Chars START - END COMMAND NUMBER secs (NUMBERu...)'''))) def add_include_mem(parser): return parser.add_argument( '--no-include-mem', dest='include_mem', default=True, action='store_false', help=(r'''Don't include memory in the table.''')) # N.B. We need to include default=None for nargs='*', c.f., https://bugs.python.org/issue28609#msg280180 def add_file_name_gen(parser, prefix='', descr='file containing the build log', stddir='in', defaults=None, **kwargs): extra = ('' if defaults is None else ' (defaults to %s if no argument is passed)' % defaults) return parser.add_argument( prefix + 'FILE_NAME', type=str, help=('The name of the %s (use "-" for std%s)%s.' % (descr, stddir, extra)), **kwargs) def add_file_name(parser): return add_file_name_gen(parser) def add_after_file_name(parser): return add_file_name_gen(parser, 'AFTER_', 'file containing the "after" build log') def add_before_file_name(parser): return add_file_name_gen(parser, 'BEFORE_', 'file containing the "before" build log') def add_output_file_name(parser): return add_file_name_gen(parser, 'OUTPUT_', 'file to write the output table to', stddir='out', defaults='-', nargs='*', default=None) def reformat_time_string(time): try: seconds, milliseconds = time.split('.') except ValueError: print('WARNING: Invalid time string: not the right number of dots (.); expected one: %s' % repr(time), file=sys.stderr) seconds, milliseconds = (time + '.').split('.')[:2] if seconds == '': seconds = 0 seconds = int(seconds) minutes, seconds = divmod(seconds, 60) return '%dm%02d.%ss' % (minutes, seconds, milliseconds) def get_file_lines(file_name): if file_name == '-': if hasattr(sys.stdin, 'buffer'): lines = sys.stdin.buffer.readlines() else: lines = sys.stdin.readlines() else: with open(file_name, 'rb') as f: lines = f.readlines() for line in lines: try: # Since we read the files in binary mode, we have to # normalize Windows line endings from \r\n to \n yield line.decode('utf-8').replace('\r\n', '\n') except UnicodeDecodeError: # invalid utf-8 pass def get_file(file_name): return ''.join(get_file_lines(file_name)) def merge_dicts(d1, d2): if d2 is None: return d1 if d1 is None: return d2 assert(isinstance(d1, dict)) assert(isinstance(d2, dict)) ret = {} for k in set(list(d1.keys()) + list(d2.keys())): ret[k] = merge_dicts(d1.get(k), d2.get(k)) return ret def get_mems_of_lines(lines): reg = re.compile(r'^([^\s]+) \([^\)]*?mem: ([0-9]+) ko[^\)]*?\)\s*$', re.MULTILINE) mems = reg.findall(lines) if all(STRIP_REG.search(name.strip()) for name, mem in mems): mems = tuple((STRIP_REG.sub(STRIP_REP, name.strip()), mem) for name, mem in mems) return dict((name, {MEM_KEY:int(mem)}) for name, mem in mems) def get_times_of_lines(lines, use_real=False): reg_user = re.compile(r'^([^\s]+) \([^\)]*?user: ([0-9\.]+)[^\)]*?\)\s*$', re.MULTILINE) reg_real = re.compile(r'^([^\s]+) \([^\)]*?real: ([0-9\.]+)[^\)]*?\)\s*$', re.MULTILINE) reg = reg_real if use_real else reg_user times = reg.findall(lines) if all(time in ('0.00', '0.01') for name, time in times): reg = reg_real times = reg.findall(lines) if all(STRIP_REG.search(name.strip()) for name, time in times): times = tuple((STRIP_REG.sub(STRIP_REP, name.strip()), time) for name, time in times) return dict((name, {TIME_KEY:reformat_time_string(time)}) for name, time in times) def get_times_and_mems(file_name, use_real=False, include_mem=True): # we only get the file once, in case it is a stream like stdin lines = get_file(file_name) return merge_dicts(get_times_of_lines(lines, use_real=use_real), (get_mems_of_lines(lines) if include_mem else None)) def get_mems(file_name): ''' Reads the contents of file_name, which should be the output of 'make TIMED=1', and parses it to construct a dict mapping file names to peak memory usage, as integers. Removes common prefixes using STRIP_REG and STRIP_REP. ''' return get_mems_of_lines(get_file(file_name)) def get_times(file_name, use_real=False): ''' Reads the contents of file_name, which should be the output of 'make TIMED=1', and parses it to construct a dict mapping file names to compile durations, as strings. Removes common prefixes using STRIP_REG and STRIP_REP. ''' return get_times_of_lines(get_file(file_name)) def get_single_file_times(file_name, use_real=False): ''' Reads the contents of file_name, which should be the output of 'coqc -time', and parses it to construct a dict mapping lines to to compile durations, as strings. ''' lines = get_file(file_name) reg = re.compile(r'^Chars ([0-9]+) - ([0-9]+) ([^ ]+) ([0-9\.]+) secs \(([0-9\.]+)u(.*)\)$', re.MULTILINE) times = reg.findall(lines) if len(times) == 0: return dict() longest = max(max((len(start), len(stop))) for start, stop, name, real, user, extra in times) FORMAT = 'Chars %%0%dd - %%0%dd %%s' % (longest, longest) return dict((FORMAT % (int(start), int(stop), name), {TIME_KEY:reformat_time_string(real if use_real else user)}) for start, stop, name, real, user, extra in times) def fuzz_merge(l1, l2, fuzz): '''Takes two iterables of ((start, end, code), times) and a fuzz parameter, and yields a single iterable of ((start, stop, code), times1, times2) We only give both left and right if (a) the codes are the same, (b) the number of characters (stop - start) is the same, and (c) the difference between left and right code locations is <= fuzz. We keep a current guess at the overall offset, and prefer drawing from whichever list is earliest after correcting for current offset. ''' assert(fuzz >= 0) cur_fuzz = 0 l1 = list(l1) l2 = list(l2) cur1, cur2 = None, None while (len(l1) > 0 or cur1 is not None) and (len(l2) > 0 or cur2 is not None): if cur1 is None: cur1 = l1.pop(0) if cur2 is None: cur2 = l2.pop(0) ((s1, e1, c1), t1), ((s2, e2, c2), t2) = cur1, cur2 assert(t1 is not None) assert(t2 is not None) s2_adjusted, e2_adjusted = s2 + cur_fuzz, e2 + cur_fuzz if cur1[0] == cur2[0]: yield (cur1, cur2) cur1, cur2 = None, None cur_fuzz = 0 elif c1 == c2 and e1-s1 == e2-s2 and abs(s1 - s2) <= fuzz: yield (((s1, e1, c1), t1), ((s2, e2, c2), t2)) cur1, cur2 = None, None cur_fuzz = s1 - s2 elif s1 < s2_adjusted or (s1 == s2_adjusted and e1 <= e2): yield (((s1, e1, c1), t1), ((s1 - cur_fuzz, e1 - cur_fuzz, c1), None)) cur1 = None else: yield (((s2 + cur_fuzz, e2 + cur_fuzz, c2), None), ((s2, e2, c2), t2)) cur2 = None if len(l1) > 0: for i in l1: yield (i, (i[0], None)) elif len(l2) > 0: for i in l2: yield ((i[0], None), i) def adjust_fuzz(left_dict, right_dict, fuzz): reg = re.compile(r'Chars ([0-9]+) - ([0-9]+) (.*)$') left_dict_list = sorted(((int(s), int(e), c), v) for ((s, e, c), v) in ((reg.match(k).groups(), v) for k, v in left_dict.items())) right_dict_list = sorted(((int(s), int(e), c), v) for ((s, e, c), v) in ((reg.match(k).groups(), v) for k, v in right_dict.items())) merged = list(fuzz_merge(left_dict_list, right_dict_list, fuzz)) if len(merged) == 0: # assert that both left and right dicts are empty assert(not left_dict) assert(not right_dict) return left_dict, right_dict longest = max(max((len(str(start1)), len(str(stop1)), len(str(start2)), len(str(stop2)))) for ((start1, stop1, code1), t1), ((start2, stop2, code2), t2) in merged) FORMAT1 = 'Chars %%0%dd - %%0%dd %%s' % (longest, longest) FORMAT2 = 'Chars %%0%dd-%%0%dd ~ %%0%dd-%%0%dd %%s' % (longest, longest, longest, longest) if fuzz == 0: left_dict = dict((FORMAT1 % k, t1) for (k, t1), _ in merged if t1 is not None) right_dict = dict((FORMAT1 % k, t2) for _, (k, t2) in merged if t2 is not None) else: left_dict = dict((FORMAT2 % (s1, e1, s2, e2, c1), t1) for ((s1, e1, c1), t1), ((s2, e2, c2), t2) in merged if t1 is not None) right_dict = dict((FORMAT2 % (s1, e1, s2, e2, c1), t2) for ((s1, e1, c1), t1), ((s2, e2, c2), t2) in merged if t2 is not None) return left_dict, right_dict def fix_sign_for_sorting(num, descending=True): return -num if descending else num def make_sorting_key(stats_dict, descending=True, sort_by_mem=False): if sort_by_mem: def get_key(name): if MEM_KEY not in stats_dict[name].keys(): print('WARNING: %s has no mem key: %s' % (name, repr(stats_dict[name])), file=sys.stderr) mem = stats_dict[name].get(MEM_KEY, '0') return (fix_sign_for_sorting(int(mem), descending=descending), name) else: def get_key(name): if TIME_KEY not in stats_dict[name].keys(): print('WARNING: %s has no time key: %s' % (name, repr(stats_dict[name])), file=sys.stderr) minutes, seconds = stats_dict[name].get(TIME_KEY, '0m00s').replace('s', '').split('m') return (fix_sign_for_sorting(int(minutes), descending=descending), fix_sign_for_sorting(float(seconds), descending=descending), name) return get_key def get_sorted_file_list_from_stats_dict(stats_dict, descending=True, sort_by_mem=False): ''' Takes the output dict of get_times and returns the list of keys, sorted by duration. ''' return sorted(stats_dict.keys(), key=make_sorting_key(stats_dict, descending=descending, sort_by_mem=sort_by_mem)) def to_seconds(time): ''' Converts a string time into a number of seconds. ''' minutes, seconds = time.replace('s', '').split('m') sign = -1 if time[0] == '-' else 1 return sign * (abs(int(minutes)) * 60 + float(seconds)) def from_seconds(seconds, signed=False): ''' Converts a number of seconds into a string time. ''' sign = ('-' if seconds < 0 else '+') if signed else '' full_centiseconds = round(abs(seconds) * 100) seconds = int(full_centiseconds) // 100 centiseconds = full_centiseconds - (seconds * 100) minutes = int(seconds) // 60 seconds -= minutes * 60 return sign + '%dm%02d.%02ds' % (minutes, seconds, centiseconds) def sum_times(times, signed=False): ''' Takes the values of an output from get_times, parses the time strings, and returns their sum, in the same string format. ''' # sort the times before summing because floating point addition is not associative return from_seconds(math.fsum(sorted(map(to_seconds, times))), signed=signed) def format_percentage(num, signed=True): sign = ('-' if num < 0 else '+') if signed else '' num = abs(num) whole_part = int(num * 100) frac_part = int(100 * (num * 100 - whole_part)) return sign + '%d.%02d%%' % (whole_part, frac_part) def make_diff_table_string(left_dict, right_dict, sort_by='auto', descending=True, sort_by_mem=False, left_tag='After', tag='File Name', right_tag='Before', with_percent=True, left_mem_tag='Peak Mem', right_mem_tag='Peak Mem', include_mem=False, change_tag='Change', percent_change_tag='% Change', change_mem_tag='Change (mem)', percent_change_mem_tag='% Change (mem)', mem_fmt='%d ko'): # We first get the names of all of the compiled files: all files # that were compiled either before or after. all_names_dict = dict() all_names_dict.update(right_dict) all_names_dict.update(left_dict) # do the left (after) last, so that we give precedence to those ones if len(all_names_dict.keys()) == 0: return 'No timing data' get_time = (lambda d, name: to_seconds(d.get(name, {}).get(TIME_KEY, '0m0.0s'))) prediff_times = tuple((name, get_time(left_dict, name), get_time(right_dict, name)) for name in all_names_dict.keys()) diff_times_dict = dict((name, from_seconds(lseconds - rseconds, signed=True)) for name, lseconds, rseconds in prediff_times) percent_diff_times_dict = dict((name, ((format_percentage((lseconds - rseconds) / rseconds)) if rseconds != 0 else (INFINITY if lseconds > 0 else 'N/A'))) for name, lseconds, rseconds in prediff_times) get_mem = (lambda d, name: d.get(name, {}).get(MEM_KEY, 0)) prediff_mems = tuple((name, get_mem(left_dict, name), get_mem(right_dict, name)) for name in all_names_dict.keys()) diff_mems_dict = dict((name, lmem - rmem) for name, lmem, rmem in prediff_mems) percent_diff_mems_dict = dict((name, ((format_percentage((lmem - rmem) / float(rmem))) if rmem != 0 else (INFINITY if lmem > 0 else 'N/A'))) for name, lmem, rmem in prediff_mems) # update to sort by approximate difference, first if sort_by_mem: get_prekey = (lambda name: diff_mems_dict[name]) else: get_prekey = (lambda name: to_seconds(diff_times_dict[name])) get_key_abs = make_sorting_key(all_names_dict, descending=descending, sort_by_mem=sort_by_mem) get_key_diff_float = (lambda name: fix_sign_for_sorting(get_prekey(name), descending=descending)) get_key_diff_absint = (lambda name: fix_sign_for_sorting(int(abs(get_prekey(name))), descending=descending)) get_key_with_name = (lambda get_key: lambda name: (get_key(name), name)) if sort_by == 'absolute': get_key = get_key_with_name(get_key_abs) elif sort_by == 'diff': get_key = get_key_with_name(get_key_diff_float) else: # sort_by == 'auto' get_key = get_key_with_name((lambda name: (get_key_diff_absint(name), get_key_abs(name)))) names = sorted(all_names_dict.keys(), key=get_key) #names = get_sorted_file_list_from_stats_dict(all_names_dict, descending=descending) # set the widths of each of the columns by the longest thing to go in that column left_sum = sum_times(v[TIME_KEY] for v in left_dict.values() if TIME_KEY in v.keys()) right_sum = sum_times(v[TIME_KEY] for v in right_dict.values() if TIME_KEY in v.keys()) left_sum_float = sum(sorted(to_seconds(v[TIME_KEY]) for v in left_dict.values() if TIME_KEY in v.keys())) right_sum_float = sum(sorted(to_seconds(v[TIME_KEY]) for v in right_dict.values() if TIME_KEY in v.keys())) diff_sum = from_seconds(left_sum_float - right_sum_float, signed=True) percent_diff_sum = (format_percentage((left_sum_float - right_sum_float) / right_sum_float) if right_sum_float > 0 else 'N/A') left_width = max(max(map(len, ['N/A', left_tag] + [v[TIME_KEY] for v in left_dict.values() if TIME_KEY in v.keys()])), len(left_sum)) right_width = max(max(map(len, ['N/A', right_tag] + [v[TIME_KEY] for v in right_dict.values() if TIME_KEY in v.keys()])), len(right_sum)) far_right_width = max(max(map(len, ['N/A', change_tag] + list(diff_times_dict.values()))), len(diff_sum)) far_far_right_width = max(max(map(len, ['N/A', percent_change_tag] + list(percent_diff_times_dict.values()))), len(percent_diff_sum)) total_string = 'Total' if not include_mem else 'Total Time / Peak Mem' middle_width = max(map(len, names + [tag, total_string])) left_peak = max([0] + [v.get(MEM_KEY, 0) for v in left_dict.values()]) right_peak = max([0] + [v.get(MEM_KEY, 0) for v in right_dict.values()]) diff_peak = left_peak - right_peak percent_diff_peak = (format_percentage((left_peak - right_peak) / float(right_peak)) if right_peak != 0 else (INFINITY if left_peak > 0 else 'N/A')) left_mem_width = max(max(map(len, ['N/A', left_mem_tag] + [mem_fmt % v.get(MEM_KEY, 0) for v in left_dict.values()])), len(mem_fmt % left_peak)) right_mem_width = max(max(map(len, ['N/A', right_mem_tag] + [mem_fmt % v.get(MEM_KEY, 0) for v in right_dict.values()])), len(mem_fmt % right_peak)) far_right_mem_width = max(max(map(len, ['N/A', change_mem_tag] + [mem_fmt % v for v in diff_mems_dict.values()])), len(mem_fmt % diff_peak)) far_far_right_mem_width = max(max(map(len, ['N/A', percent_change_mem_tag] + list(percent_diff_mems_dict.values()))), len(percent_diff_peak)) if include_mem: format_string = ("%%(left)%ds | %%(left_mem)%ds | %%(middle)-%ds | %%(right)%ds | %%(right_mem)%ds || %%(far_right)%ds || %%(far_right_mem)%ds" % (left_width, left_mem_width, middle_width, right_width, right_mem_width, far_right_width, far_right_mem_width)) else: format_string = ("%%(left)%ds | %%(middle)-%ds | %%(right)%ds || %%(far_right)%ds" % (left_width, middle_width, right_width, far_right_width)) if with_percent: format_string += " | %%(far_far_right)%ds" % far_far_right_width if include_mem: format_string += " | %%(far_far_right_mem)%ds" % far_far_right_mem_width header = format_string % {'left': left_tag, 'left_mem': left_mem_tag, 'middle': tag, 'right': right_tag, 'right_mem': right_mem_tag, 'far_right': change_tag, 'far_right_mem': change_mem_tag, 'far_far_right': percent_change_tag, 'far_far_right_mem': percent_change_mem_tag} total = format_string % {'left': left_sum, 'left_mem': mem_fmt % left_peak, 'middle': total_string, 'right': right_sum, 'right_mem': mem_fmt % right_peak, 'far_right': diff_sum, 'far_right_mem': mem_fmt % diff_peak, 'far_far_right': percent_diff_sum, 'far_far_right_mem': percent_diff_peak} # separator to go between headers and body sep = '-' * len(header) # the representation of the default value (0), to get replaced by N/A left_rep, right_rep, far_right_rep, far_far_right_rep = ("%%%ds | " % left_width) % 'N/A', (" | %%%ds |" % right_width) % 'N/A', ("|| %%%ds" % far_right_width) % 'N/A', ("| %%%ds" % far_far_right_width) % 'N/A' left_mem_rep, right_mem_rep, far_right_mem_rep, far_far_right_mem_rep = ("%%%ds | " % left_mem_width) % 'N/A', (" | %%%ds |" % right_mem_width) % 'N/A', ("|| %%%ds" % far_right_mem_width) % 'N/A', ("| %%%ds" % far_far_right_mem_width) % 'N/A' get_formatted_mem = (lambda k, v: (mem_fmt % v[k]) if k in v.keys() else 'N/A') return '\n'.join([header, sep, total, sep] + [format_string % {'left': left_dict.get(name, {}).get(TIME_KEY, 'N/A'), 'left_mem': get_formatted_mem(MEM_KEY, left_dict.get(name, {})), 'middle': name, 'right': right_dict.get(name, {}).get(TIME_KEY, 'N/A'), 'right_mem': get_formatted_mem(MEM_KEY, right_dict.get(name, {})), 'far_right': diff_times_dict.get(name, 'N/A'), 'far_right_mem': get_formatted_mem(name, diff_mems_dict), 'far_far_right': percent_diff_times_dict.get(name, 'N/A'), 'far_far_right_mem': percent_diff_mems_dict.get(name, 'N/A')} for name in names]).replace(left_rep, 'N/A'.center(len(left_rep) - 3) + ' | ').replace(right_rep, ' | ' + 'N/A'.center(len(right_rep) - 5) + ' |').replace(far_right_rep, '|| ' + 'N/A'.center(len(far_right_rep) - 3)).replace(far_far_right_rep, '| ' + 'N/A'.center(len(far_far_right_rep) - 2)).replace(left_mem_rep, 'N/A'.center(len(left_mem_rep) - 3) + ' | ').replace(right_mem_rep, ' | ' + 'N/A'.center(len(right_mem_rep) - 5) + ' |').replace(far_right_mem_rep, '|| ' + 'N/A'.center(len(far_right_mem_rep) - 3)).replace(far_far_right_mem_rep, '| ' + 'N/A'.center(len(far_far_right_mem_rep) - 2)) def make_table_string(stats_dict, descending=True, sort_by_mem=False, tag="Time", mem_tag="Peak Mem", mem_fmt='%d ko', include_mem=False): if len(stats_dict.keys()) == 0: return 'No timing data' # We first get the names of all of the compiled files, sorted by # duration names = get_sorted_file_list_from_stats_dict(stats_dict, descending=descending, sort_by_mem=sort_by_mem) # compute the widths of the columns times_width = max(len('N/A'), len(tag), max(len(v[TIME_KEY]) for v in stats_dict.values() if TIME_KEY in v.keys()), len(sum_times(v[TIME_KEY] for v in stats_dict.values() if TIME_KEY in v.keys()))) mems_width = max(len('N/A'), len(mem_tag), max(len(mem_fmt % v.get(MEM_KEY, 0)) for v in stats_dict.values()), len(mem_fmt % (max(v.get(MEM_KEY, 0) for v in stats_dict.values())))) total_string = 'Total' if not include_mem else 'Total Time / Peak Mem' names_width = max(map(len, names + ["File Name", total_string])) if include_mem: format_string = "%%(time)%ds | %%(mem)%ds | %%(name)-%ds" % (times_width, mems_width, names_width) else: format_string = "%%(time)%ds | %%(name)-%ds" % (times_width, names_width) get_formatted_mem = (lambda k, v: (mem_fmt % v[k]) if k in v.keys() else 'N/A') header = format_string % {'time': tag, 'mem': mem_tag, 'name': 'File Name'} total = format_string % {'time': sum_times(v[TIME_KEY] for v in stats_dict.values() if TIME_KEY in v.keys()), 'mem': ((mem_fmt % max(v[MEM_KEY] for v in stats_dict.values() if MEM_KEY in v.keys())) if any(MEM_KEY in v.keys() for v in stats_dict.values()) else 'N/A'), 'name': total_string} sep = '-' * len(header) return '\n'.join([header, sep, total, sep] + [format_string % {'time': stats_dict[name].get(TIME_KEY, 'N/A'), 'mem': get_formatted_mem(MEM_KEY, stats_dict[name]), 'name': name} for name in names]) def print_or_write_table(table, files): if table[-1] != '\n': table += '\n' if len(files) == 0 or '-' in files: if hasattr(sys.stdout, 'buffer'): sys.stdout.buffer.write(table.encode("utf-8")) else: sys.stdout.write(table.encode("utf-8")) for file_name in files: if file_name != '-': with open(file_name, 'w', encoding="utf-8") as f: f.write(table) coq-8.20.0/tools/beautify-archive000077500000000000000000000040431466560755400167230ustar00rootroot00000000000000#!/bin/sh #This script compiles and beautifies an archive, check the correctness #of beautified files, then replace the original files by the #beautified ones, keeping a copy of original files in $OLDARCHIVE. #The script assumes: #- that the archive provides a Makefile built by coq_makefile, #- that coqc is in the path or that variables COQTOP and COQBIN are set. OLDARCHIVE=old_files NEWARCHIVE=beautify_files BEAUTIFYSUFFIX=.beautified if [ -e $OLDARCHIVE ]; then echo "Warning: $OLDARCHIVE directory found, the files are maybe already beautified"; sleep 5; fi echo ---- Producing beautified files in the beautification directory ------- if [ -e $NEWARCHIVE ]; then rm -r $NEWARCHIVE; fi if [ -e /tmp/$OLDARCHIVE.$$ ]; then rm -r /tmp/$OLDARCHIVE.$$; fi cp -pr . /tmp/$OLDARCHIVE.$$ cp -pr /tmp/$OLDARCHIVE.$$ $NEWARCHIVE cd $NEWARCHIVE rm description || true make clean make COQFLAGS='-beautify -q $(OPT) $(COQLIBS) $(OTHERFLAGS)' || \ { echo ---- Failed to beautify; exit 1; } echo -------- Upgrading files in the beautification directory -------------- beaufiles=`find . -name \*.v$BEAUTIFYSUFFIX` for i in $beaufiles; do j=`dirname $i`/`basename $i .v$BEAUTIFYSUFFIX`.v echo Upgrading $j in the beautification directory if [ $i -nt $j ]; then mv -f $i $j; fi done echo ---- Recompiling beautified files in the beautification directory ----- make clean make || { echo ---- Failed to recompile; exit 1; } echo ----- Saving old files in directory $OLDARCHIVE ------------------------- /bin/rm -r ../$OLDARCHIVE mv /tmp/$OLDARCHIVE.$$ ../$OLDARCHIVE echo Saving $OLDARCHIVE files done echo --------- Upgrading files in current directory ------------------------ vfiles=`find . -name \*.v` cd .. for i in $vfiles; do echo Upgrading $i in current directory if [ $NEWARCHIVE/$i -nt $i ]; then mv -f $NEWARCHIVE/$i $i; fi done echo -------- Beautification completed ------------------------------------- echo Old files are in directory '"'$OLDARCHIVE'"' echo New files are in current directory echo You can now remove the beautification directory '"'$NEWARCHIVE'"' coq-8.20.0/tools/configure/000077500000000000000000000000001466560755400155265ustar00rootroot00000000000000coq-8.20.0/tools/configure/cmdArgs.ml000066400000000000000000000121041466560755400174360ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* true | "false" | "no" | "n" -> false | s -> raise (Arg.Bad ("boolean argument expected instead of "^s)) let get_native = function | "yes" -> NativeYes | "no" -> NativeNo | "ondemand" -> NativeOndemand | s -> raise (Arg.Bad ("(yes|no|ondemand) argument expected instead of "^s)) let prefs = ref default_prefs let arg_bool f = Arg.String (fun s -> prefs := f !prefs (get_bool s)) let arg_string f = Arg.String (fun s -> prefs := f !prefs s) let arg_string_option f = Arg.String (fun s -> prefs := f !prefs (Some s)) let arg_set f = Arg.Unit (fun () -> prefs := f !prefs) let arg_native f = Arg.String (fun s -> prefs := f !prefs (get_native s)) (* TODO : earlier any option -foo was also available as --foo *) let warn_warn_error () = Format.eprintf "****** the -warn-error option is deprecated, \ warnings are not set in the config section of the \ corresponding build tool [coq_makefile, dune]@\n%!" let check_absolute = function | None -> () | Some path -> if Filename.is_relative path then die "argument to -prefix must be an absolute path" else () let args_options = Arg.align [ "-prefix", arg_string_option (fun p prefix -> check_absolute prefix; { p with prefix }), "

 Set installation directory to (absolute path required)"; "-no-ask", arg_set (fun p -> { p with interactive = false }), " Don't ask questions / print variables during configure [questions will be filled with defaults]"; "-libdir", arg_string_option (fun p libdir -> { p with libdir }), " Where to install lib files"; "-configdir", arg_string_option (fun p configdir -> { p with configdir }), " Where to install config files"; "-datadir", arg_string_option (fun p datadir -> { p with datadir }), " Where to install data files"; "-mandir", arg_string_option (fun p mandir -> { p with mandir }), " Where to install man files"; "-docdir", arg_string_option (fun p docdir -> { p with docdir }), " Where to install doc files"; "-arch", arg_string_option (fun p arch -> { p with arch }), " Specifies the architecture"; "-natdynlink", arg_bool (fun p natdynlink -> { p with natdynlink }), "(yes|no) Use dynamic loading of native code or not"; "-browser", arg_string_option (fun p browser -> { p with browser }), " Use to open URL %s"; "-bytecode-compiler", arg_bool (fun p bytecodecompiler -> { p with bytecodecompiler }), "(yes|no) Enable Coq's bytecode reduction machine (VM)"; "-native-compiler", arg_native (fun p nativecompiler -> { p with nativecompiler }), "(yes|no|ondemand) Compilation to native code for conversion and normalization yes: -native-compiler option of coqc will default to 'yes', stdlib will be precompiled no (default): no native compilation available at all ondemand: -native-compiler option of coqc will default to 'ondemand', stdlib will not be precompiled"; "-warn-error", arg_bool (fun p _warn_error -> warn_warn_error (); p), "Deprecated option: warnings are now adjusted in the corresponding build tool."; "-coqwebsite", arg_string (fun p coqwebsite -> { p with coqwebsite }), " URL of the coq website"; "-debug", arg_set (fun p -> { p with debug = true }), " Enable debug information for package detection" ] let parse_args () = Arg.parse args_options (fun s -> raise (Arg.Bad ("Unknown option: "^s))) "Available options for configure are:"; !prefs (* Support don't ask *) let cprintf prefs x = if prefs.interactive then cprintf x else Printf.ifprintf stdout x coq-8.20.0/tools/configure/cmdArgs.mli000066400000000000000000000035471466560755400176220ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* Prefs.t val cprintf : Prefs.t -> ('a, out_channel, unit, unit) format4 -> 'a coq-8.20.0/tools/configure/configure.ml000066400000000000000000000502031466560755400200410ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* b | None when arch_is_win32 arch -> "start %s" | None when arch = "Darwin" -> "open %s" | _ -> "firefox -remote \"OpenURL(%s,new-tab)\" || firefox %s &" (** * OCaml programs *) module CamlConf = struct type t = { camlbin : string ; caml_version : string ; camllib : string ; findlib_version : string } end let resolve_caml () = let () = try reset_caml_find camlexec (which camlexec.find) with Not_found -> die (sprintf "Error: cannot find '%s' in your path!\n" camlexec.find ^ "Please adjust your path or use the -ocamlfind option of ./configure") in if not (is_executable camlexec.find) then die ("Error: cannot find the executable '"^camlexec.find^"'.") else let findlib_version, _ = run camlexec.find ["query"; "findlib"; "-format"; "%v"] in let caml_version, _ = run camlexec.find ["ocamlc";"-version"] in let camllib, _ = run camlexec.find ["printconf";"stdlib"] in let camlbin = (* TODO beurk beurk beurk *) Filename.dirname (Filename.dirname camllib) / "bin/" in { CamlConf.camlbin; caml_version; camllib; findlib_version } (** Caml version as a list of ints [4;0;1] *) let caml_version_nums { CamlConf.caml_version; _ } = generic_version_nums ~name:"the OCaml compiler" caml_version let check_caml_version prefs caml_version caml_version_nums = if caml_version_nums >= [5;0;0] && prefs.nativecompiler <> NativeNo then let () = cprintf prefs "Your version of OCaml is %s." caml_version in die "You have enabled Coq's native compiler, however it is not compatible with OCaml >= 5.0.0" else if caml_version_nums >= [4;9;0] then cprintf prefs "You have OCaml %s. Good!" caml_version else let () = cprintf prefs "Your version of OCaml is %s." caml_version in die "You need OCaml 4.09.0 or later." let check_findlib_version prefs { CamlConf.findlib_version; _ } = let findlib_version_nums = generic_version_nums ~name:"findlib" findlib_version in if findlib_version_nums >= [1;8;1] then cprintf prefs "You have OCamlfind %s. Good!" findlib_version else let () = cprintf prefs "Your version of OCamlfind is %s." findlib_version in die "You need OCamlfind 1.8.1 or later." (** Note, these warnings are only used in Coq Makefile *) (** Explanation of enabled/disabled warnings: 4: fragile pattern matching: too common in the code and too annoying to avoid in general 9: missing fields in a record pattern: too common in the code and not worth the bother 27: innocuous unused variable: innocuous 40: constructor or label name used out of scope: gets in the way of putting types in modules 41: ambiguous constructor or label: too common 42: disambiguated counstructor or label: too common 44: "open" shadowing already defined identifier: too common, especially when some are aliases 45: "open" shadowing a label or constructor: see 44 48: implicit elimination of optional arguments: too common 58: "no cmx file was found in path": See https://github.com/ocaml/num/issues/9 67: "unused functor parameter" seems totally bogus 68: "This pattern depends on mutable state" no idea what it means, dune builds don't display it 70: ".ml file without .mli file" bogus warning when used generally *) (* Note, we list all warnings to be complete *) let coq_warnings = "-w -a+1..3-4+5..8-9+10..26-27+28..39-40-41-42+43-44-45+46..47-48+49..57-58+59..66-67-68+69-70" (* Flags used to compile Coq and plugins (via coq_makefile) *) let caml_flags = Printf.sprintf "-thread -bin-annot -strict-sequence %s" coq_warnings (** * Native compiler *) let msg_byteonly = "Only the bytecode version of Coq will be available." let msg_no_ocamlopt () = warn "Cannot find the OCaml native-code compiler.\n%s" msg_byteonly let msg_no_dynlink_cmxa prefs = warn "Cannot find native-code dynlink library.\n%s" msg_byteonly; cprintf prefs "For building a native-code Coq, you may try to first"; cprintf prefs "compile and install a dummy dynlink.cmxa (see dev/dynlink.ml)"; cprintf prefs "and then run ./configure -natdynlink no" let check_native prefs camlenv = let version, _ = tryrun camlexec.find ["opt";"-version"] in if version = "" then let () = msg_no_ocamlopt () in raise Not_found else if fst (tryrun camlexec.find ["query";"dynlink"]) = "" then let () = msg_no_dynlink_cmxa prefs in raise Not_found else let () = let { CamlConf.caml_version; _ } = camlenv in if version <> caml_version then warn "Native and bytecode compilers do not have the same version!" in cprintf prefs "You have native-code compilation. Good!" let best_compiler prefs camlenv = try check_native prefs camlenv; "opt" with Not_found -> "byte" (** * Native dynlink *) let hasnatdynlink prefs best_compiler = prefs.natdynlink && best_compiler = "opt" (** * OS dependent libraries *) (** Zarith library *) let check_for_zarith prefs = let zarith,_ = tryrun camlexec.find ["query";"zarith"] in let zarith_cmai base = Sys.file_exists (base / "z.cmi") && Sys.file_exists (base / "zarith.cma") in let zarith_version, _ = run camlexec.find ["query"; "zarith"; "-format"; "%v"] in match zarith with | "" -> die "Zarith library not installed, required" | _ when not (zarith_cmai zarith) -> die "Zarith library installed but no development files found (try installing the -dev package)" | _ -> let zarith_version_int = generic_version_nums ~name:"Zarith" zarith_version in if zarith_version_int >= [1;11;0] then cprintf prefs "You have the Zarith library %s installed. Good!" zarith_version else die ("Zarith version 1.11 is required, you have " ^ zarith_version) (** * Installation directories : bindir, libdir, mandir, docdir, etc *) (* Source code root *) let coqsrc = Sys.getcwd () (** Variable name, description, ref in prefs, default dir, prefix-relative *) type path_style = | Absolute of string (* Should start with a "/" *) | Relative of string (* Should not start with a "/" *) module InstallDir = struct type t = { var : string (** Makefile variable to write *) ; msg : string (** Description of the directory *) ; uservalue : string option (** Value given explictly by the user *) ; selfcontainedlayout : path_style (** Path style when layout is "local" *) ; unixlayout : path_style (** Path style for installation *) } let make var msg uservalue selfcontainedlayout unixlayout = { var; msg; uservalue; selfcontainedlayout; unixlayout } end let install prefs = [ InstallDir.make "COQPREFIX" "Coq" prefs.prefix (Relative "") (Relative "") ; InstallDir.make "COQLIBINSTALL" "the Coq library" prefs.libdir (Relative "lib/coq") (Relative "lib/coq") ; InstallDir.make "CONFIGDIR" "the Coqide configuration files" prefs.configdir (Relative "config") (Absolute "/etc/xdg/coq") ; InstallDir.make "DATADIR" "the Coqide data files" prefs.datadir (Relative "share/coq") (Relative "share/coq") ; InstallDir.make "MANDIR" "the Coq man pages" prefs.mandir (Relative "share/man") (Relative "share/man") ; InstallDir.make "DOCDIR" "documentation prefix path for all Coq packages" prefs.docdir (Relative "share/doc") (Relative "share/doc") ] let strip_trailing_slash_if_any p = if p.[String.length p - 1] = '/' then String.sub p 0 (String.length p - 1) else p let use_suffix prefix = function | Relative "" -> prefix | Relative suff -> prefix ^ "/" ^ suff | Absolute path -> path let relativize = function (* Turn a global layout based on some prefix to a relative layout *) | Relative _ as suffix -> suffix | Absolute path -> Relative (String.sub path 1 (String.length path - 1)) let find_suffix prefix path = match prefix with | None -> Absolute path | Some p -> let p = strip_trailing_slash_if_any p in let lpath = String.length path in let lp = String.length p in if lpath > lp && String.sub path 0 lp = p then Relative (String.sub path (lp+1) (lpath - lp - 1)) else Absolute path (* This computes the actual effective path for an install directory, based on the given prefix; if prefix is absent, it is assumed that the profile is "local" *) let do_one_instdir ~prefix ~arch InstallDir.{var; msg; uservalue; selfcontainedlayout; unixlayout} = (var,msg), match uservalue, prefix with | Some d, p -> d, find_suffix p d | None, Some p -> let suffix = if (arch_is_win32 arch) then selfcontainedlayout else relativize unixlayout in use_suffix p suffix, suffix | None, None -> let suffix = if (unix arch) then unixlayout else selfcontainedlayout in let base = if (unix arch) then "/usr/local" else "C:/coq" in let dflt = use_suffix base suffix in let () = printf "Where should I install %s [%s]? " msg dflt in let line = read_line () in if line = "" then (dflt,suffix) else (line,find_suffix None line) let install_dirs prefs arch = let prefix = match prefs.prefix with | None -> begin try Some (Sys.getenv "COQ_CONFIGURE_PREFIX") with | Not_found when prefs.interactive -> None | Not_found -> Some Sys.(getcwd () ^ "/../install/default") end | p -> p in List.map (do_one_instdir ~prefix ~arch) (install prefs) let select var install_dirs = List.find (fun ((v,_),_) -> v=var) install_dirs |> snd module CoqEnv = struct (** Coq core paths, for libraries, documentation, configuration, and data *) type t = { coqlib : string ; coqlibsuffix : path_style ; docdir : string ; docdirsuffix : path_style ; configdir : string ; configdirsuffix : path_style ; datadir : string ; datadirsuffix : path_style } end let resolve_coqenv install_dirs = let coqlib, coqlibsuffix = select "COQLIBINSTALL" install_dirs in let docdir, docdirsuffix = select "DOCDIR" install_dirs in let configdir, configdirsuffix = select "CONFIGDIR" install_dirs in let datadir,datadirsuffix = select "DATADIR" install_dirs in { CoqEnv.coqlib; coqlibsuffix; docdir; docdirsuffix ; configdir; configdirsuffix; datadir; datadirsuffix } (** * CC runtime flags *) (* Note that Coq's VM requires at least C99-compliant floating-point arithmetic; this should be ensured by OCaml's own C flags, which set a minimum of [--std=gnu99] ; modern compilers by default assume C11 or later, so no explicit [--std=] flags are added by OCaml *) let cflags_dflt = "-Wall -Wno-unused -g -O2" let cflags_sse2 = "-msse2 -mfpmath=sse" (* cflags, sse2_math = *) let compute_cflags () = let _, slurp = (* Test SSE2_MATH support *) tryrun camlexec.find ["ocamlc"; "-ccopt"; cflags_dflt ^ " -march=native -dM -E " ^ cflags_sse2; "-c"; coqsrc/"dev/header.c"] in (* any file *) if List.exists (fun line -> starts_with line "#define __SSE2_MATH__ 1") slurp then (cflags_dflt ^ " " ^ cflags_sse2, true) else (cflags_dflt, false) (** Test at configure time that no harmful double rounding seems to be performed with an intermediate 80-bit representation (x87). If this test fails but SSE2_MATH is available, the build can go further as Coq's primitive floats will use it through a dedicated external C implementation (instead of relying on OCaml operations) If this test fails and SSE2_MATH is not available, abort. *) let check_fmath sse2_math = let add = (+.) in 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.) && not sse2_math then die "Detected non IEEE-754 compliant architecture (or wrong \ rounding mode). Use of Float is thus unsafe." let esc s = if String.contains s ' ' then "\"" ^ s ^ "\"" else s (** * Summary of the configuration *) let pr_native = function | NativeYes -> "yes" | NativeNo -> "no" | NativeOndemand -> "ondemand" let print_summary prefs arch camlenv install_dirs browser = let { CamlConf.caml_version; camlbin; camllib; _ } = camlenv in let pr s = printf s in pr "\n"; pr " Architecture : %s\n" arch; pr " Sys.os_type : %s\n" Sys.os_type; pr " OCaml version : %s\n" caml_version; pr " OCaml binaries in : %s\n" (esc camlbin); pr " OCaml library in : %s\n" (esc camllib); pr " Web browser : %s\n" browser; pr " Coq web site : %s\n" prefs.coqwebsite; pr " Bytecode VM enabled : %B\n" prefs.bytecodecompiler; pr " Native Compiler enabled : %s\n\n" (pr_native prefs.nativecompiler); (pr " Paths where installation is expected by Coq Makefile:\n"; List.iter (fun ((_,msg),(dir,_)) -> pr " - %s is expected in %s\n" msg (esc dir)) install_dirs); pr "\n"; pr "If anything is wrong above, please restart './configure'.\n\n"; pr "*Warning* To compile the system for a new architecture\n"; pr " don't forget to do a 'make clean' before './configure'.\n" (** Build the [config/coq_config.ml] file *) let write_coq_config_ml install_prefix camlenv coqenv caml_flags caml_version_nums arch arch_is_win32 hasnatdynlink browser prefs o = let { CoqEnv.coqlib; coqlibsuffix; configdir; configdirsuffix; docdir; docdirsuffix; datadir; datadirsuffix } = coqenv in let { CamlConf.caml_version; _ } = camlenv in let pr s = fprintf o s in let pr_s = pr "let %s = %S\n" in let pr_b = pr "let %s = %B\n" in let pr_i32 = pr "let %s = %dl\n" in let pr_p s o = pr "let %s = %S\n" s (match o with Relative s -> s | Absolute s -> s) in let pr_li n l = pr "let %s = [%s]\n" n (String.concat ";" (List.map string_of_int l)) in pr "(* DO NOT EDIT THIS FILE: automatically generated by ../configure *)\n"; pr "(* Exact command that generated this file: *)\n"; pr "(* %s *)\n\n" (String.concat " " (Array.to_list Sys.argv)); pr_s "install_prefix" install_prefix; pr_s "coqlib" coqlib; pr_s "configdir" configdir; pr_s "datadir" datadir; pr_s "docdir" docdir; pr_p "coqlibsuffix" coqlibsuffix; pr_p "configdirsuffix" configdirsuffix; pr_p "datadirsuffix" datadirsuffix; pr_p "docdirsuffix" docdirsuffix; pr_s "ocamlfind" camlexec.find; pr_s "caml_flags" caml_flags; pr_s "version" coq_version; pr_s "caml_version" caml_version; pr_li "caml_version_nums" caml_version_nums; pr_s "arch" arch; pr_b "arch_is_win32" arch_is_win32; pr_s "exec_extension" !exe; pr_b "has_natdynlink" hasnatdynlink; pr_i32 "vo_version" vo_magic; pr_s "browser" browser; pr_s "wwwcoq" prefs.coqwebsite; pr_s "wwwbugtracker" (prefs.coqwebsite ^ "bugs/"); pr_s "wwwrefman" (prefs.coqwebsite ^ "doc/V" ^ coq_version ^ "/refman/"); pr_s "wwwstdlib" (prefs.coqwebsite ^ "doc/V" ^ coq_version ^ "/stdlib/"); pr_b "bytecode_compiler" prefs.bytecodecompiler; pr "type native_compiler = NativeOff | NativeOn of { ondemand : bool }\n"; pr "let native_compiler = %s\n" (match prefs.nativecompiler with | NativeYes -> "NativeOn {ondemand=false}" | NativeNo -> "NativeOff" | NativeOndemand -> "NativeOn {ondemand=true}"); let core_src_dirs = [ "boot"; "config"; "lib"; "clib"; "kernel"; "library"; "engine"; "pretyping"; "interp"; "gramlib"; "parsing"; "proofs"; "tactics"; "toplevel"; "printing"; "ide"; "stm"; "vernac" ] in let core_src_dirs = List.fold_left (fun acc core_src_subdir -> acc ^ " \"" ^ core_src_subdir ^ "\";\n") "" core_src_dirs in pr "\nlet core_src_dirs = [\n%s]\n" core_src_dirs; pr "\nlet plugins_dirs = [\n"; let plugins = match open_in "config/plugin_list" with | exception Sys_error _ -> let plugins = try Sys.readdir "plugins" with _ -> [||] in Array.sort compare plugins; plugins | ch -> Array.of_list (snd (read_lines_and_close ch)) in Array.iter (fun f -> let f' = "plugins/"^f in if Sys.is_directory f' && f.[0] <> '.' then pr " %S;\n" f') plugins; pr "]\n"; pr "\nlet all_src_dirs = core_src_dirs @ plugins_dirs\n" (** Build the config/coq_byte_config.ml file *) let write_coq_byte_config_ml caml_version_nums o = let pr s = fprintf o s in pr "let toploop_use_silently ppf f = %s\n" (if caml_version_nums >= [4;14;0] then "Toploop.use_silently ppf (Toploop.File f)" else "Toploop.use_silently ppf f"); pr "let compenv_handle_exit_with_status_0 f = %s\n" (if caml_version_nums >= [4;12;0] then "try f () with Compenv.Exit_with_status(0) -> ()" else "f ()") (** Build the [config/dune.c_flags] file *) let write_dune_c_flags cflags o = let pr s = fprintf o s in pr "(%s)\n" cflags (** Build the [config/coq_config.py] file *) let write_coq_config_py o = let pr s = fprintf o s in pr "# DO NOT EDIT THIS FILE: automatically generated by ../configure\n"; pr "version = '%s'\n" coq_version; pr "is_a_released_version = %s\n" (if is_a_released_version then "True" else "False") (* Main configure routine *) let main () = let prefs = CmdArgs.parse_args () in Util.debug := prefs.debug; let arch = arch prefs in let arch_is_win32 = arch_is_win32 arch in let exe = resolve_binary_suffix arch in Util.exe := exe; install_precommit_hook prefs; let browser = browser prefs arch in let camlenv = resolve_caml () in let caml_version_nums = caml_version_nums camlenv in check_caml_version prefs camlenv.CamlConf.caml_version caml_version_nums; check_findlib_version prefs camlenv; let best_compiler = best_compiler prefs camlenv in let hasnatdynlink = hasnatdynlink prefs best_compiler in check_for_zarith prefs; let install_dirs = install_dirs prefs arch in let install_prefix = select "COQPREFIX" install_dirs |> fst in let coqenv = resolve_coqenv install_dirs in let cflags, sse2_math = compute_cflags () in check_fmath sse2_math; if prefs.interactive then print_summary prefs arch camlenv install_dirs browser; write_config_file ~file:"config/coq_config.ml" (write_coq_config_ml install_prefix camlenv coqenv caml_flags caml_version_nums arch arch_is_win32 hasnatdynlink browser prefs); write_config_file ~file:"config/coq_byte_config.ml" (write_coq_byte_config_ml caml_version_nums); write_config_file ~file:"config/dune.c_flags" (write_dune_c_flags cflags); write_config_file ~file:"config/coq_config.py" write_coq_config_py; () let _ = main () coq-8.20.0/tools/configure/configure.mli000066400000000000000000000012431466560755400202120ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* fprintf oc "\n%!") oc let cprintf s = cfprintf stdout s let ceprintf s = cfprintf stderr s let die msg = ceprintf "%s%s%s\nConfiguration script failed!" red msg reset; exit 1 let warn s = kfprintf (fun oc -> cfprintf oc "%s" reset) stdout ("%sWarning: " ^^ s) yellow let i2s = string_of_int let (/) x y = x ^ "/" ^ y (** Remove the final '\r' that may exists on Win32 *) let remove_final_cr s = let n = String.length s in if n<>0 && s.[n-1] = '\r' then String.sub s 0 (n-1) else s let check_exit_code (_,code) = match code with | Unix.WEXITED 0 -> () | Unix.WEXITED 127 -> failwith "no such command" | Unix.WEXITED n -> failwith ("exit code " ^ i2s n) | Unix.WSIGNALED n -> failwith ("killed by signal " ^ i2s n) | Unix.WSTOPPED n -> failwith ("stopped by signal " ^ i2s n) (** As for Unix.close_process, our Unix.waipid will ignore all EINTR *) let rec waitpid_non_intr pid = try Unix.waitpid [] pid with Unix.Unix_error (Unix.EINTR, _, _) -> waitpid_non_intr pid (** Below, we'd better read all lines on a channel before closing it, otherwise a SIGPIPE could be encountered by the sub-process *) let read_lines_and_close cin = let lines = ref [] in begin try while true do lines := remove_final_cr (input_line cin) :: !lines done with End_of_file -> () end; close_in cin; let lines = List.rev !lines in try List.hd lines, lines with Failure _ -> "", [] let read_lines_and_close_fd fd = read_lines_and_close (Unix.in_channel_of_descr fd) (** Run some unix command and read the first line of its output. We avoid Unix.open_process and its non-fully-portable /bin/sh, especially when it comes to quoting the filenames. See open_process_pid in ide/coqide/coq.ml for more details. Error messages: - if err=StdErr, any error message goes in the stderr of our script. - if err=StdOut, we merge stderr and stdout (just as 2>&1). - if err=DevNull, we drop the error messages (same as 2>/dev/null). *) type err = StdErr | StdOut | DevNull let exe = ref "" (* Will be set later on, when the call to uname is done *) let run ?(fatal=true) ?(verbose=false) ?(err=StdErr) prog args = let prog = (* Ensure prog ends with exe *) if Str.string_match (Str.regexp ("^.*" ^ !exe ^ "$")) prog 0 then prog else (prog ^ !exe) in let argv = Array.of_list (prog::args) in try let out_r,out_w = Unix.pipe () in let nul_r,nul_w = Unix.pipe () in let () = Unix.set_close_on_exec out_r in let () = Unix.set_close_on_exec nul_r in let fd_err = match err with | StdErr -> Unix.stderr | StdOut -> out_w | DevNull -> nul_w in let pid = Unix.create_process prog argv Unix.stdin out_w fd_err in let () = Unix.close out_w in let () = Unix.close nul_w in let line, all = read_lines_and_close_fd out_r in let _ = read_lines_and_close_fd nul_r in let () = check_exit_code (waitpid_non_intr pid) in line, all with | _ when not fatal && not verbose -> "", [] | e -> let cmd = String.concat " " (prog::args) in let exn = match e with Failure s -> s | _ -> Printexc.to_string e in let msg = sprintf "Error while running '%s' (%s)" cmd exn in if fatal then die msg else (warn "%s" msg; "", []) let tryrun prog args = run ~fatal:false ~err:DevNull prog args (** Splitting a string at some character *) let string_split c s = let len = String.length s in let rec split n = try let pos = String.index_from s n c in let dir = String.sub s n (pos-n) in dir :: split (succ pos) with | Not_found -> [String.sub s n (len-n)] in if len = 0 then [] else split 0 (** String prefix test : does [s1] starts with [s2] ? *) let starts_with s1 s2 = let l1 = String.length s1 and l2 = String.length s2 in l2 <= l1 && s2 = String.sub s1 0 l2 (** Turn a version string such as "4.01.0+rc2" into the list ["4";"01";"1"], stopping at the first non-digit or "." *) let numeric_prefix_list s = let isnum c = (c = '.' || (c >= '0' && c <= '9')) in let max = String.length s in let i = ref 0 in while !i < max && isnum s.[!i] do incr i done; match string_split '.' (String.sub s 0 !i) with | [v] -> [v;"0";"0"] | [v1;v2] -> [v1;v2;"0"] | [v1;v2;""] -> [v1;v2;"0"] (* e.g. because it ends with ".beta" *) | v -> v let generic_version_nums ~name version_string = let version_list = numeric_prefix_list version_string in if !debug then begin let pp_sep = Format.pp_print_space in Format.(eprintf "Parsing version info for %s: @[raw: %s / split: %a@]@\n%!" name version_string (pp_print_list ~pp_sep pp_print_string) version_list) end; try List.map int_of_string version_list with _ -> "I found " ^ name ^ " but cannot read its version number!\n" ^ "Is it installed properly?" |> die (** Combined existence and directory tests *) let dir_exists f = Sys.file_exists f && Sys.is_directory f (** Does a file exist and is executable ? *) let is_executable f = try let () = Unix.access f [Unix.X_OK] in true with Unix.Unix_error _ -> false (** Equivalent of rm -f *) let safe_remove f = try Unix.chmod f 0o644; Sys.remove f with _ -> () (** The PATH list for searching programs *) let os_type_win32 = (Sys.os_type = "Win32") let os_type_cygwin = (Sys.os_type = "Cygwin") let global_path = try string_split (if os_type_win32 then ';' else ':') (Sys.getenv "PATH") with Not_found -> [] (** A "which" command. May raise [Not_found] *) let which prog = let rec search = function | [] -> raise Not_found | dir :: path -> let file = if os_type_win32 then dir/prog^".exe" else dir/prog in if is_executable file then file else search path in search global_path let program_in_path prog = try let _ = which prog in true with Not_found -> false (** * Architecture *) let arch_progs = [("/bin/uname",["-s"]); ("/usr/bin/uname",["-s"]); ("/bin/arch", []); ("/usr/bin/arch", []); ("/usr/ucb/arch", []) ] let query_arch () = cprintf "I can not automatically find the name of your architecture."; cprintf "Give me a name, please [win32 for Win95, Win98 or WinNT]: %!"; read_line () let rec try_archs = function | (prog,args)::rest when is_executable prog -> let arch, _ = tryrun prog args in if arch <> "" then arch else try_archs rest | _ :: rest -> try_archs rest | [] -> query_arch () let arch = function | Some a -> a | None -> let arch,_ = tryrun "uname" ["-s"] in if starts_with arch "CYGWIN" then "win32" else if starts_with arch "MINGW32" then "win32" else if arch <> "" then arch else try_archs arch_progs let write_config_file ~file ?(bin=false) action = safe_remove file; let o = if bin then open_out_bin file else open_out file in try action o; close_out o; Unix.chmod file 0o444 with _ -> close_out o; safe_remove file coq-8.20.0/tools/configure/util.mli000066400000000000000000000032141466560755400172060ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* 'a val string_split : char -> string -> string list val starts_with : string -> string -> bool val generic_version_nums : name:string -> string -> int list val warn : ('a, out_channel, unit, unit, unit, unit) format6 -> 'a val die : string -> 'a val is_executable : string -> bool val dir_exists : string -> bool val which : string -> string val program_in_path : string -> bool val exe : string ref type err = StdErr | StdOut | DevNull val run : ?fatal:bool -> ?verbose:bool -> ?err:err -> string -> string list -> string * string list val tryrun : string -> string list -> string * string list val read_lines_and_close : in_channel -> string * string list val arch : string option -> string (* bin is used to avoid adding \r on Cygwin/Windows *) val write_config_file : file:string -> ?bin:bool -> (out_channel -> unit) -> unit (* enable debug mode *) val debug : bool ref coq-8.20.0/tools/coq_makefile.ml000066400000000000000000000424621466560755400165260ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* ) f g = fun x -> g (f x) let usage_coq_makefile ~ok = let out = if ok then stdout else stderr in output_string out "Usage summary:\ \n\ \ncoq_makefile .... [file.v] ... [file.ml[ig]?] ... [file.ml{lib,pack}]\ \n ... [-I dir] ... [-R physicalpath logicalpath]\ \n ... [-Q physicalpath logicalpath] ... [VARIABLE = value]\ \n ... [-arg opt] ... [-docroot path] [-f file] [-o file]\ \n ... [-generate-meta-for-package project-name]\ \n [-h] [--help] [-v] [--version]\ \n"; output_string out "\ \nFull list of options:\ \n\ \n[file.v]: Coq file to be compiled\ \n[file.ml[ig]?]: Objective Caml file to be compiled\ \n[file.ml{lib,pack}]: ocamlbuild-style file that describes a Objective Caml\ \n library/module\ \n[-I dir]: look for Objective Caml dependencies in \"dir\"\ \n[-R physicalpath logicalpath]: look for Coq dependencies recursively\ \n starting from \"physicalpath\". The logical path associated to the\ \n physical path is \"logicalpath\".\ \n[-Q physicalpath logicalpath]: look for Coq dependencies starting from\ \n \"physicalpath\". The logical path associated to the physical path\ \n is \"logicalpath\".\ \n[VARIABLE = value]: Add the variable definition \"VARIABLE=value\"\ \n[-arg opt]: send option \"opt\" to coqc\ \n[-docroot path]: Install the documentation in this folder, relative to\ \n \"user-contrib\".\ \n[-f file]: take the contents of file as arguments\ \n[-o file]: output should go in file file (recommended)\ \n Output file outside the current directory is forbidden.\ \n[-generate-meta-for-package project-name]: generate META.project-name.\ \n[-h]: print this usage summary\ \n[--help]: equivalent to [-h]\ \n[-v]: print version information\ \n[--version]: equivalent to [-v]\ \n"; exit (if ok then 0 else 1) let is_prefix dir1 dir2 = let l1 = String.length dir1 in let l2 = String.length dir2 in let sep = Filename.dir_sep in if dir1 = dir2 then true else if l1 + String.length sep <= l2 then let dir1' = String.sub dir2 0 l1 in let sep' = String.sub dir2 l1 (String.length sep) in dir1' = dir1 && sep' = sep else false let physical_dir_of_logical_dir ldir = let ldir = Bytes.of_string ldir in let le = Bytes.length ldir - 1 in let pdir = if le >= 0 && Bytes.get ldir le = '.' then Bytes.sub ldir 0 (le - 1) else Bytes.copy ldir in for i = 0 to le - 1 do if Bytes.get pdir i = '.' then Bytes.set pdir i '/'; done; Bytes.to_string pdir let read_whole_file s = let ic = open_in s in let b = Buffer.create (1 lsl 12) in try while true do let s = input_line ic in Buffer.add_string b s; Buffer.add_char b '\n'; done; assert false; with End_of_file -> close_in ic; Buffer.contents b (* Use this for quoting contents of variables which never appears as target or * pattern. *) let makefile_quote s = let out = Buffer.create 16 in Buffer.add_string out "'"; String.iter (fun c -> match c with | '$' -> Buffer.add_string out "$$" | '#' -> Buffer.add_string out "\\#" | '\'' -> Buffer.add_string out "'\\''" | _ -> Buffer.add_char out c ) s; Buffer.add_string out "'"; Buffer.contents out let quote s = if String.contains s ' ' || CString.is_empty s then "'" ^ s ^ "'" else s let generate_makefile oc conf_file local_file local_late_file dep_file args project = let env = Boot.Env.init () in (* XX coq makefile should ship files on its own dir *) let cmf_dir = Boot.Env.tool env "" in let makefile_template = Boot.Path.relative cmf_dir "CoqMakefile.in" in if not (Boot.Path.exists makefile_template) then begin let makefile_template = Boot.Path.to_string makefile_template in Format.eprintf "Error: cannot find %s" makefile_template; exit 1 end; let makefile_template = Boot.Path.to_string makefile_template in let s = read_whole_file makefile_template in let s = List.fold_left (* We use global_substitute to avoid running into backslash issues due to \1 etc. *) (fun s (k,v) -> Str.global_substitute (Str.regexp_string k) (fun _ -> v) s) s [ "@CONF_FILE@", conf_file; "@LOCAL_FILE@", local_file; "@LOCAL_LATE_FILE@", local_late_file; "@DEP_FILE@", dep_file; "@COQ_VERSION@", Coq_config.version; "@PROJECT_FILE@", (Option.default "" project.project_file); "@COQ_MAKEFILE_INVOCATION@",String.concat " " (List.map quote args); ] in output_string oc s let generate_meta_file p = try match p.meta_file with | Absent -> p | Generate proj -> let cmname = List.map (fun { thing } -> thing) (files_by_suffix p.files [".mllib"; ".mlpack"]) in let dir, cmname = match cmname with | [] -> Printf.eprintf "In order to generate a META file one needs an .mlpack or .mllib file\n"; exit 1 | [x] -> Filename.dirname x, Filename.(basename @@ chop_extension x) | _ -> Printf.eprintf "Automatic META generation only works for one .mlpack or .mllib file, since you have more you need to write the META file by hand\n"; exit 1 in let f = dir ^ "/META." ^ proj in let oc = open_out f in let meta : _ format = {| package "plugin" ( directory = "." requires = "coq-core.plugins.ltac" archive(byte) = "%s.cma" archive(native) = "%s.cmxa" plugin(byte) = "%s.cma" plugin(native) = "%s.cmxs" ) directory = "." |} in let meta = Printf.sprintf meta cmname cmname cmname cmname in output_string oc meta; close_out oc; { p with meta_file = Present f } | Present f -> let ext = Filename.extension f in if ext = ".in" then let meta_file = Filename.chop_extension f in let oc = open_out meta_file in (* META generation is just a renaming for now, we lack some metadata *) output_string oc (read_whole_file f); close_out oc; { p with meta_file = Present meta_file } else p (* already a META.package file *) with Sys_error e -> Printf.eprintf "Error: %s\n" e; exit 1 let section oc s = let pad = String.make (76 - String.length s) ' ' in let sharps = String.make 79 '#' in let spaces = "#" ^ String.make 77 ' ' ^ "#" in fprintf oc "\n%s\n" sharps; fprintf oc "%s\n" spaces; fprintf oc "# %s%s#\n" s pad; fprintf oc "%s\n" spaces; fprintf oc "%s\n\n" sharps ;; let generate_conf_includes oc { ml_includes; r_includes; q_includes } = section oc "Path directives (-I, -R, -Q)."; let module S = String in let map = map_sourced_list in let dash1 opt v = sprintf "-%s %s" opt (quote v) in let dash2 opt v1 v2 = sprintf "-%s %s %s" opt (quote v1) (quote v2) in fprintf oc "COQMF_OCAMLLIBS = %s\n" (S.concat " " (map (fun { path } -> dash1 "I" path) ml_includes)); fprintf oc "COQMF_SRC_SUBDIRS = %s\n" (S.concat " " (map (fun { path } -> quote path) ml_includes)); fprintf oc "COQMF_COQLIBS = %s %s %s\n" (S.concat " " (map (fun { path } -> dash1 "I" path) ml_includes)) (S.concat " " (map (fun ({ path },l) -> dash2 "Q" path l) q_includes)) (S.concat " " (map (fun ({ path },l) -> dash2 "R" path l) r_includes)); fprintf oc "COQMF_COQLIBS_NOML = %s %s\n" (S.concat " " (map (fun ({ path },l) -> dash2 "Q" path l) q_includes)) (S.concat " " (map (fun ({ path },l) -> dash2 "R" path l) r_includes)); fprintf oc "COQMF_CMDLINE_COQLIBS = %s %s %s\n" (S.concat " " (map_cmdline (fun { path } -> dash1 "I" path) ml_includes)) (S.concat " " (map_cmdline (fun ({ path },l) -> dash2 "Q" path l) q_includes)) (S.concat " " (map_cmdline (fun ({ path },l) -> dash2 "R" path l) r_includes)); ;; let windrive s = if Coq_config.arch_is_win32 && Str.(string_match (regexp "^[a-zA-Z]:") s 0) then Str.matched_string s else "" ;; let generate_conf_coq_config oc = section oc "Coq configuration."; Envars.print_config ~prefix_var_name:"COQMF_" oc; let env = Boot.Env.init () in let coqlib = Boot.Env.(coqlib env |> Path.to_string) in (* XXX: FIXME, why does this variable needs the root lib *) fprintf oc "COQMF_WINDRIVE=%s\n" (windrive coqlib) ;; let check_metafile p = if files_by_suffix p.files [".mlpack"; ".mllib"] <> [] && p.meta_file = Absent then begin eprintf "Warning: it is recommended you provide a META.package-name file\n"; eprintf "Warning: since you build plugins. See also -generate-meta-for-package.\n"; end let write_coqbin oc = fprintf oc "%s\n" "COQBIN?=\n\ ifneq (,$(COQBIN))\n\ # add an ending /\n\ COQBIN:=$(COQBIN)/\n\ endif\n\ COQMKFILE ?= \"$(COQBIN)coq_makefile\"" let generate_conf_files oc p = let module S = String in let fout varname suffix = fprintf oc "COQMF_%s := $(filter %%%s, $(COQMF_SOURCES))\n" varname suffix; in section oc "Project files."; let cmdline_vfiles = p.cmd_line_files in fprintf oc "COQMF_CMDLINE_VFILES := %s\n" (S.concat " " (map_sourced_list quote cmdline_vfiles)); let proj_arg = match p.project_file with | Some pfile -> Printf.sprintf "-f %s" pfile | None -> "" in fprintf oc "COQMF_SOURCES := $(shell $(COQMKFILE) -sources-of %s $(COQMF_CMDLINE_VFILES))\n" proj_arg; fout "VFILES" ".v"; fout "MLIFILES" ".mli"; fout "MLFILES" ".ml"; fout "MLGFILES" ".mlg"; fout "MLPACKFILES" ".mlpack"; fout "MLLIBFILES" ".mllib"; fprintf oc "COQMF_METAFILE = %s\n" (match p.meta_file with Present x -> x | _ -> "") let rec all_start_with prefix = function | [] -> true | [] :: _ -> false | (x :: _) :: rest -> x = prefix && all_start_with prefix rest let rec logic_gcd acc = function | [] -> acc | [] :: _ -> acc | (hd :: tl) :: rest -> if all_start_with hd rest then logic_gcd (acc @ [hd]) (tl :: List.map List.tl rest) else acc let generate_conf_doc oc { docroot; q_includes; r_includes } = let includes = List.map (forget_source > snd) (q_includes @ r_includes) in let logpaths = List.map (String.split_on_char '.') includes in let gcd = logic_gcd [] logpaths in let root = match docroot with | None -> if gcd = [] then let destination = "orphan_" ^ (String.concat "_" includes) in eprintf "Warning: No common logical root.\n"; eprintf "Warning: In this case the -docroot option should be given.\n"; eprintf "Warning: Otherwise the install-doc target is going to install files\n"; eprintf "Warning: in %s\n" destination; destination else String.concat Filename.dir_sep gcd | Some p -> p in Printf.fprintf oc "COQMF_INSTALLCOQDOCROOT = %s\n" (quote root) let generate_conf_native oc native_compiler = section oc "Native compiler."; let flag = match native_compiler with | None -> "" | Some NativeYes -> "yes" | Some NativeNo -> "no" | Some NativeOndemand -> "ondemand" in Printf.fprintf oc "COQMF_COQPROJECTNATIVEFLAG = %s\n" flag let generate_conf_defs oc { defs; extra_args } = section oc "Extra variables."; List.iter (forget_source > (fun (k,v) -> Printf.fprintf oc "%s = %s\n" k v)) defs; Printf.fprintf oc "COQMF_OTHERFLAGS = %s\n" (String.concat " " (List.map (forget_source > makefile_quote) extra_args)) let generate_conf oc project args = fprintf oc "# This configuration file was generated by running:\n"; fprintf oc "# %s\n\n" (String.concat " " (List.map quote args)); write_coqbin oc; generate_conf_files oc project; generate_conf_includes oc project; generate_conf_coq_config oc; generate_conf_native oc project.native_compiler; generate_conf_defs oc project; generate_conf_doc oc project; ;; let ensure_root_dir ({ ml_includes; r_includes; q_includes; files } as project) = let exists f = List.exists (forget_source > f) in let here = Sys.getcwd () in let not_tops = List.for_all (fun s -> s.thing <> Filename.basename s.thing) in if exists (fun { canonical_path = x } -> x = here) ml_includes || exists (fun ({ canonical_path = x },_) -> is_prefix x here) r_includes || exists (fun ({ canonical_path = x },_) -> is_prefix x here) q_includes || not_tops files then project else let source x = {thing=x; source=CmdLine} in let here_path = { path = "."; canonical_path = here } in { project with ml_includes = source here_path :: ml_includes; r_includes = source (here_path, "Top") :: r_includes } ;; let check_overlapping_include { q_includes; r_includes } = let pwd = Sys.getcwd () in let aux = function | [] -> () | {thing = { path; canonical_path }, _} :: l -> if not (is_prefix pwd canonical_path) then eprintf "Warning: %s (used in -R or -Q) is not a subdirectory of the current directory\n\n" path; List.iter (fun {thing={ path = p; canonical_path = cp }, _} -> if is_prefix canonical_path cp || is_prefix cp canonical_path then eprintf "Warning: %s and %s overlap (used in -R or -Q)\n\n" path p) l in aux (q_includes @ r_includes) ;; let check_native_compiler = function | None -> () | Some flag -> match Coq_config.native_compiler, flag with | Coq_config.NativeOff, (NativeYes | NativeOndemand) -> eprintf "Warning: native compilation is globally deactivated by the configure flag\n" | _ -> () let chop_prefix p f = let len_p = String.length p in let len_f = String.length f in String.sub f len_p (len_f - len_p) type extra_opts = { only_destination : string option; only_sources : bool; } let empty_extra = { only_destination = None; only_sources = false; } let parse_extra f r opts = match f, r with | "-destination-of", tgt :: r -> Some (r, { opts with only_destination = Some tgt }) | "-sources-of", r -> Some (r, { opts with only_sources = true }) | ("-h"|"--help"), _ -> usage_coq_makefile ~ok:true | ("-v"|"--version"), _ -> Boot.Usage.version (); exit 0 | _ -> None let destination_of { ml_includes; q_includes; r_includes; } file = let file_dir = CUnix.canonical_path_name (Filename.dirname file) in let includes = q_includes @ r_includes in let mk_destination logic canonical_path = Filename.concat (physical_dir_of_logical_dir logic) (chop_prefix canonical_path file_dir) in let candidates = CList.map_filter (fun {thing={ canonical_path }, logic} -> if is_prefix canonical_path file_dir then Some(mk_destination logic canonical_path) else None) includes in match candidates with | [] -> (* BACKWARD COMPATIBILITY: -I into the only logical root *) begin match r_includes, List.find (fun {thing={ canonical_path = p }} -> is_prefix p file_dir) ml_includes with | [{thing={ canonical_path }, logic}], {thing={ canonical_path = p }} -> let destination = Filename.concat (physical_dir_of_logical_dir logic) (chop_prefix p file_dir) in Printf.printf "%s" (quote destination) | _ -> () (* skip *) | exception Not_found -> () (* skip *) end | [s] -> Printf.printf "%s" (quote s) | _ -> assert false let () = let _fhandle = Feedback.(add_feeder (console_feedback_listener Format.err_formatter)) in let prog, args = let args = Array.to_list Sys.argv in let prog = List.hd args in prog, List.tl args in let { extra_data = { only_destination; only_sources } } as project = let warning_fn x = Format.eprintf "%s@\n%!" x in try cmdline_args_to_project ~warning_fn ~curdir:Filename.current_dir_name ~parse_extra empty_extra args with Parsing_error s -> prerr_endline s; usage_coq_makefile ~ok:false in if only_destination <> None then begin destination_of project (Option.get only_destination); exit 0 end; if only_sources then begin let paths = String.concat " " (List.map (fun i -> i.thing) project.files) in Printf.printf "%s" paths; exit 0 end; if project.makefile = None then eprintf "Warning: Omitting -o is deprecated\n\n"; (* We want to know the name of the Makefile (say m) in order to * generate m.conf and include m.local *) let conf_file = Option.default "CoqMakefile" project.makefile ^ ".conf" in let local_file = Option.default "CoqMakefile" project.makefile ^ ".local" in let local_late_file = Option.default "CoqMakefile" project.makefile ^ ".local-late" in let dep_file = "." ^ Option.default "CoqMakefile" project.makefile ^ ".d" in let project = ensure_root_dir project in check_overlapping_include project; check_native_compiler project.native_compiler; check_metafile project; let project = generate_meta_file project in let ocm = Option.cata open_out stdout project.makefile in generate_makefile ocm conf_file local_file local_late_file dep_file (prog :: args) project; close_out ocm; let occ = open_out conf_file in generate_conf occ project (prog :: args); close_out occ; exit 0 coq-8.20.0/tools/coq_makefile.mli000066400000000000000000000000001466560755400166550ustar00rootroot00000000000000coq-8.20.0/tools/coq_tex.ml000066400000000000000000000236531466560755400155520ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* (* a dummy command, just in case the last line was a comment *) output_string chan_out "Set Printing Width 78.\n"; close_in chan_in; close_out chan_out (* Second pass: insert the answers of Coq from [coq_output] into the * TeX file [texfile]. The result goes in file [result]. *) let tex_escaped s = let delims = Str.regexp "[_{}&%#$\\^~ <>'`]" in let adapt_delim = function | "{" | "}" | "&" | "%" | "#" | "$" as c -> "\\"^c | "_" -> "{\\char`\\_}" | "\\" -> "{\\char'134}" | "^" -> "{\\char'136}" | "~" -> "{\\char'176}" | " " -> "~" | "<" -> "{<}" | ">" -> "{>}" | "'" -> "{\\textquotesingle}" | "`" -> "\\`{}" | _ -> assert false in let adapt = function | Str.Text s -> s | Str.Delim s -> adapt_delim s in String.concat "" (List.map adapt (Str.full_split delims s)) let encapsule sl c_out s = if sl then Printf.fprintf c_out "\\texttt{\\textit{%s}}\\\\\n" (tex_escaped s) else Printf.fprintf c_out "\\texttt{%s}\\\\\n" (tex_escaped s) let print_block c_out bl = List.iter (fun s -> if s="" then () else encapsule !slanted c_out s) bl let insert texfile coq_output result = let c_tex = open_in texfile in let c_coq = open_in coq_output in let c_out = open_out result in (* read lines until a prompt is found (starting from the second line), purge prompts on the first line and return their number *) let last_read = ref (input_line c_coq) in let read_output () = let first = !last_read in let nb = ref 0 in (* remove the leading prompts *) let rec skip_prompts pos = if Str.string_match any_prompt first pos then let () = incr nb in skip_prompts (Str.match_end ()) else pos in let first = let start = skip_prompts 0 in String.sub first start (String.length first - start) in (* read and return the following lines until a prompt is found *) let rec read_lines () = let s = input_line c_coq in if Str.string_match any_prompt s 0 then begin last_read := s; [] end else s :: read_lines () in (first :: read_lines (), !nb) in let unhandled_output = ref None in let read_output () = match !unhandled_output with | Some some -> unhandled_output := None; some | None -> read_output () in (* we are inside a \begin{coq_...} ... \end{coq_...} block * show_... tell what kind of block it is *) let rec inside show_answers show_questions not_first discarded = let s = input_line c_tex in if s = "" then inside show_answers show_questions not_first (discarded + 1) else if not (Str.string_match end_coq s 0) then begin let (bl,n) = read_output () in assert (n > discarded); let n = n - discarded in if not_first then output_string c_out "\\medskip\n"; if !verbose then Printf.printf "Coq < %s\n" s; if show_questions then encapsule false c_out ("Coq < " ^ s); let rec read_lines k = if k = 0 then [] else let s = input_line c_tex in if Str.string_match end_coq s 0 then [] else s :: read_lines (k - 1) in let al = read_lines (n - 1) in if !verbose then List.iter (Printf.printf " %s\n") al; if show_questions then List.iter (fun s -> encapsule false c_out (" " ^ s)) al; let la = n - 1 - List.length al in if la <> 0 then (* this happens when the block ends with a comment; the output is for the command at the beginning of the next block *) unhandled_output := Some (bl, la) else begin if !verbose then List.iter print_endline bl; if show_answers then print_block c_out bl; inside show_answers show_questions (show_answers || show_questions) 0 end end else if discarded > 0 then begin (* this happens when the block ends with an empty line *) let (bl,n) = read_output () in assert (n > discarded); unhandled_output := Some (bl, n - discarded) end in (* we are outside of a \begin{coq_...} ... \end{coq_...} block *) let rec outside just_after = let start_block () = if !small then output_string c_out "\\begin{small}\n"; output_string c_out "\\begin{flushleft}\n"; if !hrule then output_string c_out "\\hrulefill\\\\\n" in let end_block () = if !hrule then output_string c_out "\\hrulefill\\\\\n"; output_string c_out "\\end{flushleft}\n"; if !small then output_string c_out "\\end{small}\n" in let s = input_line c_tex in if Str.string_match begin_coq s 0 then begin let kind = Str.matched_group 1 s in if kind = "eval" then begin if just_after then end_block (); inside false false false 0; outside false end else begin let show_answers = kind <> "example*" in let show_questions = kind <> "example#" in if not just_after then start_block (); inside show_answers show_questions just_after 0; outside true end end else begin if just_after then end_block (); output_string c_out (s ^ "\n"); outside false end in try let _ = read_output () in (* to skip the Coq banner *) let _ = read_output () in (* to skip the Coq answer to Set Printing Width *) outside false with End_of_file -> begin close_in c_tex; close_in c_coq; close_out c_out end (* Process of one TeX file *) let rm f = try Sys.remove f with _ -> () let one_file texfile = let inputv = Filename.temp_file "coq_tex" ".v" in let coq_output = Filename.temp_file "coq_tex" ".coq_output"in let result = if !output_specified then !output else if Filename.check_suffix texfile ".tex" then (Filename.chop_suffix texfile ".tex") ^ ".v.tex" else texfile ^ ".v.tex" in try (* 1. extract Coq phrases *) extract texfile inputv; (* 2. run Coq on input *) let _ = Sys.command (Printf.sprintf "%s < %s > %s 2>&1" !image inputv coq_output) in (* 3. insert Coq output into original file *) insert texfile coq_output result; (* 4. clean up *) rm inputv; rm coq_output with reraise -> begin rm inputv; rm coq_output; raise reraise end (* Parsing of the command line, check of the Coq command and process * of all the files in the command line, one by one *) let files = ref [] let parse_cl () = Arg.parse [ "-o", Arg.String (fun s -> output_specified := true; output := s), "output-file Specify the resulting LaTeX file"; "-n", Arg.Int (fun n -> linelen := n), "line-width Set the line width"; "-image", Arg.String (fun s -> image := s), "coq-image Use coq-image as Coq command"; "-w", Arg.Set cut_at_blanks, " Try to cut lines at blanks"; "-v", Arg.Set verbose, " Verbose mode (show Coq answers on stdout)"; "-sl", Arg.Set slanted, " Coq answers in slanted font (only with LaTeX2e)"; "-hrule", Arg.Set hrule, " Coq parts are written between 2 horizontal lines"; "-small", Arg.Set small, " Coq parts are written in small font"; ] (fun s -> files := s :: !files) "coq-tex [options] file ..." let find_coqtop () = let prog = Sys.executable_name in try let size = String.length prog in let i = Str.search_backward (Str.regexp_string "coq-tex") prog (size-7) in (String.sub prog 0 i)^"coqtop"^(String.sub prog (i+7) (size-i-7)) with Not_found -> begin Printf.printf "Warning: preprocessing with default image \"coqtop\"\n"; "coqtop" end let _ = parse_cl (); if !image = "" then image := Filename.quote (find_coqtop ()); if Sys.command (!image ^ " -batch -silent") <> 0 then begin Printf.printf "Error: "; let _ = Sys.command (!image ^ " -batch") in exit 1 end else begin (*Printf.printf "Your version of coqtop seems OK\n";*) flush stdout end; List.iter one_file (List.rev !files) coq-8.20.0/tools/coq_tex.mli000066400000000000000000000000001466560755400157000ustar00rootroot00000000000000coq-8.20.0/tools/coqdep/000077500000000000000000000000001466560755400150205ustar00rootroot00000000000000coq-8.20.0/tools/coqdep/coqdep.ml000066400000000000000000000054241466560755400166320ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* Array.to_list |> List.tl |> Args.parse (Args.make ()) in let v_files = args.Args.files in (* We are in makefile hack mode *) let make_separator_hack = true in let st = init ~make_separator_hack args in let lst = Common.State.loadpath st in List.iter treat_file_command_line v_files; (* XXX: All the code below is just setting loadpaths, refactor to Common coq.boot library *) (* Add current dir with empty logical path if not set by options above. *) (try ignore (Loadpath.find_dir_logpath (Sys.getcwd())) with Not_found -> Loadpath.add_norec_dir_import (Loadpath.add_known lst) "." []); (* We don't setup any loadpath if the -boot is passed *) if not args.Args.boot then begin let env = Boot.Env.init () in let stdlib = Boot.Env.(stdlib env |> Path.to_string) in let plugins = Boot.Env.(plugins env |> Path.to_string) in let user_contrib = Boot.Env.(user_contrib env |> Path.to_string) in Loadpath.add_rec_dir_import (Loadpath.add_coqlib_known lst) stdlib ["Coq"]; Loadpath.add_rec_dir_import (Loadpath.add_coqlib_known lst) plugins ["Coq"]; if Sys.file_exists user_contrib then Loadpath.add_rec_dir_no_import (Loadpath.add_coqlib_known lst) user_contrib []; let add_dir s = Loadpath.add_rec_dir_no_import (Loadpath.add_coqlib_known lst) s [] in List.iter add_dir (Envars.xdg_dirs ~warn:warn_home_dir); List.iter add_dir Envars.coqpath end; if args.Args.sort then sort st else compute_deps st |> List.iter (Makefile.print_dep Format.std_formatter) let () = try coqdep () with exn -> Format.eprintf "*** Error: @[%a@]@\n%!" Pp.pp_with (CErrors.print exn); exit 1 coq-8.20.0/tools/coqdep/coqdep.mli000066400000000000000000000012431466560755400167760ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* str "Unknown option \"" ++ str opt ++ str "\".") let usage () = let open Printf in eprintf " usage: coqdep [options] +\n"; eprintf " options:\n"; eprintf " -boot : For coq developers, prints dependencies over coq library files (omitted by default).\n"; eprintf " -sort : output the given file name ordered by dependencies\n"; eprintf " -noglob | -no-glob : \n"; eprintf " -noinit : currently no effect\n"; eprintf " -f file : read -I, -Q, -R and filenames from _CoqProject-formatted file.\n"; eprintf " -I dir : add (non recursively) dir to ocaml path\n"; eprintf " -R dir logname : add and import dir recursively to coq load path under logical name logname\n"; eprintf " -Q dir logname : add (recursively) and open (non recursively) dir to coq load path under logical name logname\n"; eprintf " -vos : also output dependencies about .vos files\n"; eprintf " -exclude-dir dir : skip subdirectories named 'dir' during -R/-Q search\n"; eprintf " -coqlib dir : set the coq standard library directory\n"; eprintf " -dyndep (opt|byte|both|no|var) : set how dependencies over ML modules are printed\n"; eprintf " -m META : resolve plugins names using the META file\n"; eprintf " -w (w1,..,wn) : configure display of warnings\n"; exit 1 let parse st args = let rec parse st = function | "-boot" :: ll -> parse { st with boot = true } ll | "-sort" :: ll -> parse { st with sort = true } ll | "-vos" :: ll -> parse { st with vos = true } ll | ("-noglob" | "-no-glob") :: ll -> parse { st with noglob = true } ll | "-noinit" :: ll -> (* do nothing *) parse st ll | "-f" :: f :: ll -> parse { st with coqproject = Some f } ll | "-I" :: r :: ll -> parse { st with ml_path = r :: st.ml_path } ll | "-I" :: [] -> usage () | "-R" :: r :: ln :: ll -> parse { st with vo_path = (true, r, ln) :: st.vo_path } ll | "-Q" :: r :: ln :: ll -> parse { st with vo_path = (false, r, ln) :: st.vo_path } ll | "-R" :: ([] | [_]) -> usage () | "-exclude-dir" :: r :: ll -> System.exclude_directory r; parse st ll | "-exclude-dir" :: [] -> usage () | "-coqlib" :: r :: ll -> Boot.Env.set_coqlib r; parse st ll | "-coqlib" :: [] -> usage () | "-dyndep" :: dyndep :: ll -> parse { st with dyndep } ll | "-m" :: m :: ll -> parse { st with meta_files = st.meta_files @ [m]} ll | "-w" :: w :: ll -> let w = if w = "none" then w else CWarnings.get_flags() ^ "," ^ w in CWarnings.set_flags w; parse st ll | ("-h"|"--help"|"-help") :: _ -> usage () | opt :: ll when String.length opt > 0 && opt.[0] = '-' -> warn_unknown_option opt; parse st ll | f :: ll -> parse { st with files = f :: st.files } ll | [] -> st in let st = parse st args in { st with ml_path = List.rev st.ml_path ; vo_path = List.rev st.vo_path ; files = List.rev st.files } coq-8.20.0/tools/coqdep/lib/args.mli000066400000000000000000000017571466560755400172370ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* t val usage : unit -> 'a val parse : t -> string list -> t coq-8.20.0/tools/coqdep/lib/common.ml000066400000000000000000000327361466560755400174230ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* fn (** Coq files specifies on the command line: - first string is the full filename, with only its extension removed - second string is the absolute version of the previous (via getcwd) *) let vAccu = ref ([] : (string * string) list) let separator_hack = ref true let filename_concat dir name = if !separator_hack then System.(dir // name) else Filename.concat dir name (* This is used to overcome makefile limitations w.r.t. filenames, (bar/../foo is not the same than ./foo for make) but it is a crude hack and we should remove it, and instead require users to follow the same naming convention *) let canonize f = let f' = filename_concat (Loadpath.absolute_dir (Filename.dirname f)) (Filename.basename f) in match List.filter (fun (_,full) -> f' = full) !vAccu with | (f,_) :: _ -> f | _ -> f (** Queue operations *) let addQueue q v = q := v :: !q type what = Library | External let str_of_what = function Library -> "library" | External -> "external file" let warning_module_notfound = let warn (what, from, f, s) = let open Pp in str "in file " ++ str f ++ str ", " ++ str (str_of_what what) ++ spc () ++ str (String.concat "." s) ++ str " is required" ++ pr_opt (fun pth -> str "from root " ++ str (String.concat "." pth)) from ++ str " and has not been found in the loadpath!" in CWarnings.create ~name:"module-not-found" ~category:CWarnings.CoreCategories.filesystem warn let warning_declare = let warn (f, s) = let open Pp in str "in file " ++ str f ++ str ", declared ML module " ++ str s ++ str " has not been found!" in CWarnings.create ~name:"declared-module-not-found" ~category:CWarnings.CoreCategories.filesystem warn let warn_if_clash ?(what=Library) exact file dir f1 = let open Format in function | f2::fl -> let f = match what with | Library -> Filename.basename f1 ^ ".v" | External -> Filename.basename f1 in let what = str_of_what what in let d1 = Filename.dirname f1 in let d2 = Filename.dirname f2 in let dl = List.rev_map Filename.dirname fl in if exact then begin eprintf "*** Warning: in file %s, \n required %s %s exactly matches several files in path\n (found %s in " file what (String.concat "." dir) f; List.iter (fun s -> eprintf "%s, " s) dl; eprintf "%s and %s; used the latter).\n" d2 d1 end else begin eprintf "*** Warning: in file %s, \n required %s %s matches several files in path\n (found %s in " file what (String.concat "." dir) f; List.iter (fun s -> eprintf "%s, " s) dl; eprintf "%s and %s; Require will fail).\n" d2 d1 end | [] -> () let safe_assoc st ?(what=Library) from verbose file k = let search = match what with | Library -> Loadpath.search_v_known st | External -> Loadpath.search_other_known st in match search ?from k with | None -> None | Some (Loadpath.ExactMatches (f :: l)) -> if verbose then warn_if_clash ~what true file k f l; Some [f] | Some (Loadpath.PartialMatchesInSameRoot (root, l)) -> (match List.sort String.compare l with [] -> assert false | f :: l as all -> (* If several files match, it will fail at Require; To be "fair", in coqdep, we add dependencies on all matching files *) if verbose then warn_if_clash ~what false file k f l; Some all) | Some (Loadpath.ExactMatches []) -> assert false let file_name s = function | None -> s | Some d -> filename_concat d s module VData = struct type t = string list option * string list let compare = compare end module VCache = Set.Make(VData) (** To avoid reading .v files several times for computing dependencies, once for .vo, and once for .vos extensions, the following code performs a single pass and produces a structured list of dependencies, separating dependencies on compiled Coq files (those loaded by [Require]) from other dependencies, e.g. dependencies on ".v" files (for [Load]) or ".cmx", ".cmo", etc... (for [Declare]). *) let legacy_mapping = Core_plugins_findlib_compat.legacy_to_findlib let meta_files = ref [] (* Transform "Declare ML %DECL" to a pair of (meta, cmxs). Something very similar is in ML top *) let declare_ml_to_file file decl = let decl = String.split_on_char ':' decl in let decl = List.map (String.split_on_char '.') decl in let meta_files = !meta_files in match decl with | [[x]] when List.mem_assoc x legacy_mapping -> None, x (* This case only exists for 3rd party packages, should remove in 8.17 *) | [[x]] -> Error.findlib_name file x | [[legacy]; package :: plugin_name] -> None, legacy | [package :: plugin_name] -> let meta, cmxs = Fl.findlib_resolve ~meta_files ~file ~package ~plugin_name in Some meta, cmxs | plist -> CErrors.user_err Pp.(str "Failed to resolve plugin " ++ pr_sequence (pr_sequence str) plist) let rec find_dependencies st basename = let verbose = true in (* for past/future use? *) try (* Visited marks *) let visited_ml = ref StrSet.empty in let visited_v = ref VCache.empty in let should_visit_v_and_mark from str = if not (VCache.mem (from, str) !visited_v) then begin visited_v := VCache.add (from, str) !visited_v; true end else false in (* Output: dependencies found *) let dependencies = ref [] in let add_dep dep = dependencies := dep :: !dependencies in let add_dep_other s = add_dep (Dep_info.Dep.Other s) in (* Reading file contents *) let f = basename ^ ".v" in let chan = open_in f in let buf = Lexing.from_channel chan in let open Lexer in try while true do let tok = coq_action buf in match tok with | Require (from, strl) -> let decl str = if should_visit_v_and_mark from str then begin match safe_assoc st from verbose f str with | Some files -> List.iter (fun file_str -> let file_str = canonize file_str in add_dep (Dep_info.Dep.Require file_str)) files | None -> if verbose && not (Loadpath.is_in_coqlib st ?from str) then warning_module_notfound (Library, from, f, str) end in List.iter decl strl | Declare sl -> let sl = List.map (declare_ml_to_file f) sl in let declare suff dir s = let base = file_name s dir in add_dep (Dep_info.Dep.Ml (base,suff)) in let decl (meta_file,str) = Option.iter add_dep_other meta_file; let s = basename_noext str in if not (StrSet.mem s !visited_ml) then begin visited_ml := StrSet.add s !visited_ml; let pick_mldir mldir = match meta_file with | None -> mldir | Some _ -> Some(Filename.dirname str) in match Loadpath.search_mllib_known st s with | Some mldir -> declare ".cma" (pick_mldir mldir) s | None -> match Loadpath.search_mlpack_known st s with | Some mldir -> declare ".cmo" (pick_mldir mldir) s | None -> warning_declare (f,str) end in List.iter decl sl | Load file -> let canon = match file with | Logical str -> if should_visit_v_and_mark None [str] then safe_assoc st None verbose f [str] else None | Physical str -> if String.equal (Filename.basename str) str then if should_visit_v_and_mark None [str] then safe_assoc st None verbose f [str] else None else Some [canonize str] in (match canon with | None -> () | Some l -> let decl canon = add_dep_other (Format.sprintf "%s.v" canon); let deps = find_dependencies st canon in List.iter add_dep deps in List.iter decl l) | External(from,str) -> begin match safe_assoc st ~what:External (Some from) verbose f [str] with | Some (file :: _) -> add_dep (Dep_info.Dep.Other (canonize file)) | Some [] -> assert false | None -> warning_module_notfound (External, Some from, f, [str]) end done; List.rev !dependencies with | Fin_fichier -> close_in chan; List.rev !dependencies | Syntax_error (i,j) -> close_in chan; Error.cannot_parse f (i,j) with Sys_error msg -> Error.cannot_open (basename ^ ".v") msg module State = struct type t = Loadpath.State.t let loadpath x = x end let compute_deps st = let mk_dep (name, _orig_path) = Dep_info.make ~name ~deps:(find_dependencies st name) in !vAccu |> List.rev |> List.map mk_dep let rec treat_file old_dirname old_name = let name = Filename.basename old_name and new_dirname = Filename.dirname old_name in let dirname = match (old_dirname,new_dirname) with | (d, ".") -> d (* EGJA: We should disable this buggy normalization stuff for "./foo -> foo" but it breaks dune coq.theory! *) | (None,d) -> Some d | (Some d1,d2) -> Some (filename_concat d1 d2) in let complete_name = file_name name dirname in let stat_res = try Unix.stat complete_name with Unix.Unix_error(error, _, _) -> Error.cannot_open complete_name (Unix.error_message error) in match stat_res.Unix.st_kind with | Unix.S_DIR -> (if name.[0] <> '.' then let newdirname = match dirname with | None -> name | Some d -> filename_concat d name in Array.iter (treat_file (Some newdirname)) (Sys.readdir complete_name)) | Unix.S_REG -> (match Loadpath.get_extension name [".v"] with | base,".v" -> let name = file_name base dirname in let absname = Loadpath.absolute_file_name ~filename_concat base dirname in addQueue vAccu (name, absname) | _ -> ()) | _ -> () let treat_file_command_line old_name = treat_file None old_name let treat_file_coq_project where old_name = treat_file None old_name (* "[sort]" outputs `.v` files required by others *) let sort st = let seen = Hashtbl.create 97 in let rec loop file = let file = canonize file in if not (Hashtbl.mem seen file) then begin Hashtbl.add seen file (); let cin = open_in (file ^ ".v") in let lb = Lexing.from_channel cin in try while true do match Lexer.coq_action lb with | Lexer.Require (from, sl) -> List.iter (fun s -> match safe_assoc st from false file s with | None -> () | Some l -> List.iter loop l) sl | _ -> () done with Lexer.Fin_fichier -> close_in cin; Format.printf "%s.v " file end in List.iter (fun (name, _) -> loop name) !vAccu let warn_project_file = let category = CWarnings.CoreCategories.filesystem in CWarnings.create ~name:"project-file" ~category Pp.str let treat_coqproject st f = let open CoqProject_file in let iter_sourced f = List.iter (fun {thing} -> f thing) in let project = try read_project_file ~warning_fn:warn_project_file f with | Parsing_error msg -> Error.cannot_parse_project_file f msg | UnableToOpenProjectFile msg -> Error.cannot_open_project_file msg in iter_sourced (fun { path } -> Loadpath.add_caml_dir st path) project.ml_includes; iter_sourced (fun ({ path }, l) -> Loadpath.add_q_include st path l) project.q_includes; iter_sourced (fun ({ path }, l) -> Loadpath.add_r_include st path l) project.r_includes; iter_sourced (fun f' -> treat_file_coq_project f f') (all_files project) let add_include st (rc, r, ln) = if rc then Loadpath.add_r_include st r ln else Loadpath.add_q_include st r ln let init ~make_separator_hack args = separator_hack := make_separator_hack; vAccu := []; if not Coq_config.has_natdynlink then Makefile.set_dyndep "no"; let st = Loadpath.State.make ~boot:args.Args.boot in Makefile.set_write_vos args.Args.vos; Makefile.set_noglob args.Args.noglob; Option.iter (treat_coqproject st) args.Args.coqproject; List.iter (Loadpath.add_caml_dir st) args.Args.ml_path; List.iter (add_include st) args.Args.vo_path; Makefile.set_dyndep args.Args.dyndep; meta_files := args.Args.meta_files; st coq-8.20.0/tools/coqdep/lib/common.mli000066400000000000000000000021251466560755400175610ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* Loadpath.State.t end (** [init args] Init coqdep, setting arguments from [args]. *) val init : make_separator_hack:bool -> Args.t -> State.t (** [treat_file_command_line file] Add an input file to be considered *) val treat_file_command_line : string -> unit val sort : State.t -> unit val compute_deps : State.t -> Dep_info.t list coq-8.20.0/tools/coqdep/lib/dep_info.ml000066400000000000000000000020231466560755400177000ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* deps:Dep.t list -> t coq-8.20.0/tools/coqdep/lib/dune000066400000000000000000000001471466560755400164460ustar00rootroot00000000000000(library (name coqdeplib) (libraries coq-core.boot coq-core.lib findlib.internal)) (ocamllex lexer) coq-8.20.0/tools/coqdep/lib/error.ml000066400000000000000000000047721466560755400172630ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* Some Pp.(str "File \"" ++ str s ++ str "\"," ++ str "characters" ++ spc () ++ int i ++ str "-" ++ int j ++ str ":" ++ spc () ++ str "Syntax error") | CannotParseProjectFile (file, msg) -> Some Pp.(str "Project file" ++ spc () ++ str "\"" ++ str file ++ str "\":" ++ spc () ++ str "Syntax error:" ++ str msg) | CannotOpenFile (s, msg) -> Some Pp.(str s ++ str ":" ++ spc () ++ str msg) | CannotOpenProjectFile msg -> (* TODO: more info? *) Some Pp.(str msg) | InvalidFindlibPluginName (f, s) -> Some Pp.(str "in file " ++ quote (str f) ++ str "." ++ spc () ++ str "The name " ++ quote (str s) ++ strbrk " is no longer a valid plugin name." ++ spc () ++ strbrk "Plugins should be loaded using their public name according to \ findlib, for example " ++ quote (str "package-name.foo") ++ str " and not " ++ quote (str "foo_plugin") ++ str "." ++ spc () ++ strbrk "If you are \ using a build system that does not yet support the new loading method \ (such as Dune) you must specify both the legacy and the findlib plugin \ name as in:" ++ spc () ++ str " Declare ML Module \"foo_plugin:package-name.foo\".") | _ -> None let cannot_parse s ij = raise @@ CannotParseFile (s, ij) let cannot_open_project_file msg = raise @@ CannotOpenProjectFile msg let cannot_parse_project_file file msg = raise @@ CannotParseProjectFile (file, msg) let cannot_open s msg = raise @@ CannotOpenFile (s, msg) let findlib_name f s = raise @@ InvalidFindlibPluginName (f, s) coq-8.20.0/tools/coqdep/lib/error.mli000066400000000000000000000021721466560755400174240ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* int * int -> 'a val cannot_open_project_file : string -> 'a val cannot_parse_project_file : string -> string -> 'a val cannot_open : string -> string -> 'a val findlib_name : string -> string -> 'a coq-8.20.0/tools/coqdep/lib/file_util.ml000066400000000000000000000036271466560755400201040ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* string = fun full_path -> if Filename.is_relative full_path then full_path else let cwd = String.split_on_char '/' (Sys.getcwd ()) in let path = String.split_on_char '/' full_path in let rec remove_common_prefix l1 l2 = match (l1, l2) with | (x1 :: l1, x2 :: l2) when x1 = x2 -> remove_common_prefix l1 l2 | (_ , _ ) -> (l1, String.concat "/" l2) in let (cwd, path) = remove_common_prefix cwd path in let add_parent path _ = Filename.concat Filename.parent_dir_name path in List.fold_left add_parent path cwd let normalize_path : string -> string = fun path -> let re_delim = if Sys.win32 then "[/\\]" else "/" in let path = Str.split_delim (Str.regexp re_delim) path in let rec normalize acc path = match (path, acc) with | ([] , _ ) -> List.rev acc | ("." :: path, _ ) -> normalize acc path | (".." :: path, [] ) -> normalize (".." :: []) path | (".." :: path, ".." :: _ ) -> normalize (".." :: acc) path | (".." :: path, _ :: acc) -> normalize acc path | (dir :: path, _ ) -> normalize (dir :: acc) path in match normalize [] path with | [] -> "." | path -> String.concat "/" path coq-8.20.0/tools/coqdep/lib/file_util.mli000066400000000000000000000030621466560755400202460ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* string (** [normalize_path path] takes as input a file path [path], and returns an equivalent path that: (1) does not contain the current directory member ["."] unless the path is to the current directory (in which case ["."] is returned, or ["./"] if [path] has a trailing ["/"]), (2) only uses parent directory members [".."] for a prefix of the path, and (3), has a trailing ["/"] only if and only if [path] does. For example, paths ["dir1/dir2/file.v"], ["."], ["dir1/dir2/dir3/"] and ["../../dir/file.v"] are possible return values, but ["./file.v"] and ["dir1/../dir2"] are not. *) val normalize_path : string -> string coq-8.20.0/tools/coqdep/lib/fl.ml000066400000000000000000000116041466560755400165230ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* Some Pp.(str "in file" ++ spc () ++ str f ++ str "," ++ spc () ++ str "could not find META." ++ str package ++ str ".") | CannotParseMetaFile (file, msg) -> Some Pp.(str "META file \"" ++ str file ++ str "\":" ++ spc () ++ str "Syntax error:" ++ spc () ++ str msg) | DeclaredMLModuleNotFound (f, s, m) -> Some Pp.(str "in file " ++ str f ++ str "," ++ spc() ++ str "declared ML module" ++ spc () ++ str s ++ spc () ++ str "has not been found in" ++ spc () ++ str m ++ str ".") | MetaLacksFieldForPackage (meta_file, package, field) -> Some Pp.(str "META file \"" ++ str meta_file ++ str "\"" ++ spc () ++ str "lacks field" ++ spc () ++ str field ++ spc () ++ str "for package" ++ spc () ++ str package ++ str ".") | _ -> None end (* Platform build is doing something weird with META, hence we parse when finding, but at some point we should find, then parse. *) let parse_META meta_file package = try let ic = open_in meta_file in let m = Fl_metascanner.parse ic in close_in ic; Some m with (* This should not be necessary, but there's a problem in the platform build *) | Sys_error _msg -> None (* findlib >= 1.9.3 uses its own Error exception, so we can't catch it without bumping our version requirements. TODO pass the message on once we bump. *) | _ -> Error.cannot_parse_meta_file package "" let rec find_parsable_META meta_files package = match meta_files with | [] -> (try let meta_file = Findlib.package_meta_file package in Option.map (fun meta -> meta_file, meta) (parse_META meta_file package) with Fl_package_base.No_such_package _ -> None) | meta_file :: ms -> if String.equal (Filename.extension meta_file) ("." ^ package) then Option.map (fun meta -> meta_file, meta) (parse_META meta_file package) else find_parsable_META ms package let rec find_plugin_field_opt fld = function | [] -> None | { Fl_metascanner.def_var; def_value; _ } :: rest -> if String.equal def_var fld then Some def_value else find_plugin_field_opt fld rest let find_plugin_field fld def pkgs = Option.default def (find_plugin_field_opt fld pkgs) let rec find_plugin meta_file plugin_name path p { Fl_metascanner.pkg_defs ; pkg_children } = match p with | [] -> path, pkg_defs | p :: ps -> let c = match CList.assoc_f_opt String.equal p pkg_children with | None -> Error.declare_in_META meta_file (String.concat "." plugin_name) meta_file | Some c -> c in let path = path @ [find_plugin_field "directory" "." c.Fl_metascanner.pkg_defs] in find_plugin meta_file plugin_name path ps c let findlib_resolve ~meta_files ~file ~package ~plugin_name = let (meta_file, meta) = match find_parsable_META meta_files package with | None -> Error.no_meta file package | Some v -> v in let path = [find_plugin_field "directory" "." meta.Fl_metascanner.pkg_defs] in let path, plug = find_plugin meta_file plugin_name path plugin_name meta in let cmxs_file = let file = match find_plugin_field_opt "plugin" plug with | None -> Error.meta_file_lacks_field meta_file package "plugin" | Some file -> file in let add d file = if d = Filename.current_dir_name then file else Filename.concat d file in List.fold_right add path file in let meta_file = normalize_path (to_relative_path meta_file) in let cmxs_file = let meta_dir = Filename.dirname meta_file in normalize_path (Filename.concat meta_dir cmxs_file) in (meta_file, cmxs_file) coq-8.20.0/tools/coqdep/lib/fl.mli000066400000000000000000000025211466560755400166720ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* file:string -> package:string -> plugin_name:string list -> string * string coq-8.20.0/tools/coqdep/lib/lexer.mli000066400000000000000000000017431466560755400174150ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* coq_token coq-8.20.0/tools/coqdep/lib/lexer.mll000066400000000000000000000164231466560755400174210ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* s | Some _ -> syntax_error lexbuf let get_ident lexbuf = let s = Lexing.lexeme lexbuf in check_valid lexbuf s let get_field_name lexbuf = let s = Lexing.lexeme lexbuf in check_valid lexbuf (String.sub s 1 (String.length s - 1)) } let space = [' ' '\t' '\n' '\r'] let lowercase = ['a'-'z'] let uppercase = ['A'-'Z'] let identchar = ['A'-'Z' 'a'-'z' '_' '\'' '0'-'9'] let caml_up_ident = uppercase identchar* let caml_low_ident = lowercase identchar* (* This is an overapproximation, we check correctness afterwards *) let coq_ident = ['A'-'Z' 'a'-'z' '_' '\128'-'\255'] ['A'-'Z' 'a'-'z' '_' '\'' '0'-'9' '\128'-'\255']* let coq_field = '.' coq_ident let coq_qual_id_rex = coq_ident coq_field+ let dot = '.' ( space+ | eof) rule coq_action = parse | "Require" space+ { require_modifiers None lexbuf } | "Local" space+ "Declare" space+ "ML" space+ "Module" space+ { modules [] lexbuf } | "Declare" space+ "ML" space+ "Module" space+ { modules [] lexbuf } | "Load" space+ { load_file lexbuf } | "Time" space+ { coq_action lexbuf } | "Timeout" space+ ['0'-'9']+ space+ { coq_action lexbuf } | "From" space+ { from_rule false lexbuf } | "Comments" space+ "From" space+ { from_rule true lexbuf } | space+ { coq_action lexbuf } | "(*" { comment lexbuf; coq_action lexbuf } | eof { raise Fin_fichier} | _ { skip_to_dot lexbuf; coq_action lexbuf } and from_rule only_extra_dep = parse | "(*" { comment lexbuf; from_rule only_extra_dep lexbuf } | space+ { from_rule only_extra_dep lexbuf } | coq_ident { let from = coq_qual_id_tail [get_ident lexbuf] lexbuf in consume_require_or_extradeps only_extra_dep (Some from) lexbuf } | eof { syntax_error lexbuf } | _ { syntax_error lexbuf } and extra_dep_rule from = parse | "(*" { comment lexbuf; extra_dep_rule from lexbuf } | space+ { extra_dep_rule from lexbuf } | eof { syntax_error lexbuf } | '"' ([^ '"']+ as f) '"' (*'"'*) { skip_to_dot lexbuf; External (from,f) } and require_modifiers from = parse | "(*" { comment lexbuf; require_modifiers from lexbuf } | "Import" space* { require_file from lexbuf } | "Export" space* { require_file from lexbuf } | space+ { require_modifiers from lexbuf } | eof { syntax_error lexbuf } | _ { backtrack lexbuf ; require_file from lexbuf } and consume_require_or_extradeps only_extra_dep from = parse | "(*" { comment lexbuf; consume_require_or_extradeps only_extra_dep from lexbuf } | space+ { consume_require_or_extradeps only_extra_dep from lexbuf } | "Require" space+ { if only_extra_dep then syntax_error lexbuf; require_modifiers from lexbuf } | "Extra" space+ "Dependency" space+ { match from with | None -> syntax_error lexbuf (* Extra Dependency requires From *) | Some from -> extra_dep_rule from lexbuf } | _ { syntax_error lexbuf } and comment = parse | "(*" { comment lexbuf; comment lexbuf } | "*)" { () } | "'" [^ '\\' '\''] "'" { comment lexbuf } | "'" '\\' ['\\' '\'' 'n' 't' 'b' 'r'] "'" { comment lexbuf } | "'" '\\' ['0'-'9'] ['0'-'9'] ['0'-'9'] "'" { comment lexbuf } | eof { raise Fin_fichier } | _ { comment lexbuf } and skip_parenthesized = parse | "(*" { comment lexbuf; skip_parenthesized lexbuf } | "(" { skip_parenthesized lexbuf; skip_parenthesized lexbuf } | ")" { () } | eof { raise Fin_fichier } | _ { skip_parenthesized lexbuf } and load_file = parse | '"' [^ '"']* '"' (*'"'*) { let s = lexeme lexbuf in parse_dot lexbuf; Load (Physical (unquote_vfile_string s)) } | coq_ident { let s = get_ident lexbuf in skip_to_dot lexbuf; Load (Logical s) } | eof { syntax_error lexbuf } | _ { syntax_error lexbuf } and require_file from = parse | "(*" { comment lexbuf; require_file from lexbuf } | ("-" space*)? "(" { skip_parenthesized lexbuf; require_file from lexbuf } | space+ { require_file from lexbuf } | coq_ident { let name = coq_qual_id_tail [get_ident lexbuf] lexbuf in let qid = coq_qual_id_list [name] lexbuf in parse_dot lexbuf; Require (from, qid) } | eof { syntax_error lexbuf } | _ { syntax_error lexbuf } and skip_to_dot = parse | "(*" { comment lexbuf; skip_to_dot lexbuf } | dot { () } | eof { syntax_error lexbuf } | _ { skip_to_dot lexbuf } and parse_dot = parse | dot { () } | eof { syntax_error lexbuf } | _ { syntax_error lexbuf } and coq_qual_id_tail module_name = parse | "(*" { comment lexbuf; coq_qual_id_tail module_name lexbuf } | space+ { coq_qual_id_tail module_name lexbuf } | coq_field { coq_qual_id_tail (get_field_name lexbuf :: module_name) lexbuf } | eof { syntax_error lexbuf } | _ { backtrack lexbuf; List.rev module_name } and coq_qual_id_list module_names = parse | "(*" { comment lexbuf; coq_qual_id_list module_names lexbuf } | "(" { skip_parenthesized lexbuf; coq_qual_id_list module_names lexbuf } | space+ { coq_qual_id_list module_names lexbuf } | coq_ident { let name = coq_qual_id_tail [get_ident lexbuf] lexbuf in coq_qual_id_list (name :: module_names) lexbuf } | eof { syntax_error lexbuf } | _ { backtrack lexbuf; List.rev module_names } and modules mllist = parse | space+ { modules mllist lexbuf } | "(*" { comment lexbuf; modules mllist lexbuf } | '"' [^'"']* '"' { let lex = (Lexing.lexeme lexbuf) in let str = String.sub lex 1 (String.length lex - 2) in modules (str :: mllist) lexbuf} | eof { syntax_error lexbuf } | _ { Declare (List.rev mllist) } coq-8.20.0/tools/coqdep/lib/loadpath.ml000066400000000000000000000261601466560755400177210ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* dir | None -> "." in (* XXX: Attention to System.(//) which does weird things and it is not the same than Filename.concat ; using Filename.concat here makes the windows build fail *) filename_concat (absolute_dir dir) basename let equal_file f1 f2 = let filename_concat = Filename.concat in String.equal (absolute_file_name ~filename_concat (Filename.basename f1) (Some (Filename.dirname f1))) (absolute_file_name ~filename_concat (Filename.basename f2) (Some (Filename.dirname f2))) (** Files found in the loadpaths. For the ML files, the string is the basename without extension. *) let same_path_opt s s' = let nf s = (* ./foo/a.ml and foo/a.ml are the same file *) if Filename.is_implicit s then System.("." // s) else s in let s = match s with None -> "." | Some s -> nf s in let s' = match s' with None -> "." | Some s' -> nf s' in s = s' (** [find_dir_logpath dir] Return the logical path of directory [dir] if it has been given one. Raise [Not_found] otherwise. In particular we can check if "." has been attributed a logical path after processing all options and silently give the default one if it hasn't. We may also use this to warn if a physical path is met twice. *) let register_dir_logpath, find_dir_logpath = let tbl: (string, string list) Hashtbl.t = Hashtbl.create 19 in let reg physdir logpath = Hashtbl.add tbl (absolute_dir physdir) logpath in let fnd physdir = Hashtbl.find tbl (absolute_dir physdir) in reg,fnd (** Visit all the directories under [dir], including [dir], in the same order as for [coqc]/[coqtop] in [System.all_subdirs], that is, assuming Sys.readdir to have this structure: ├── B │ └── E.v │ └── C1 │ │ └── E.v │ │ └── D1 │ │ └── E.v │ │ └── F.v │ │ └── D2 │ │ └── E.v │ │ └── G.v │ └── F.v │ └── C2 │ │ └── E.v │ │ └── D1 │ │ └── E.v │ │ └── F.v │ │ └── D2 │ │ └── E.v │ │ └── G.v │ └── G.v it goes in this (reverse) order: B.C2.D1.E, B.C2.D2.E, B.C2.E, B.C2.F, B.C2.G B.C1.D1.E, B.C1.D2.E, B.C1.E, B.C1.F, B.C1.G, B.E, B.F, B.G, (see discussion at PR #14718) *) let add_directory recur add_file phys_dir log_dir = let root = (phys_dir, log_dir) in let stack = ref [] in let curdirfiles = ref [] in let subdirfiles = ref [] in let rec aux phys_dir log_dir = if System.exists_dir phys_dir then begin register_dir_logpath phys_dir log_dir; let f = function | System.FileDir (phys_f,f) -> if recur then begin stack := (!curdirfiles, !subdirfiles) :: !stack; curdirfiles := []; subdirfiles := []; aux phys_f (log_dir @ [f]); let curdirfiles', subdirfiles' = List.hd !stack in subdirfiles := subdirfiles' @ !subdirfiles @ !curdirfiles; curdirfiles := curdirfiles'; stack := List.tl !stack end | System.FileRegular f -> curdirfiles := (phys_dir, log_dir, f) :: !curdirfiles in System.process_directory f phys_dir end else System.warn_cannot_open_dir phys_dir in aux phys_dir log_dir; List.iter (fun (phys_dir, log_dir, f) -> add_file root phys_dir log_dir f) !subdirfiles; List.iter (fun (phys_dir, log_dir, f) -> add_file root phys_dir log_dir f) !curdirfiles (** [get_extension f l] checks whether [f] has one of the extensions listed in [l]. It returns [f] without its extension, alongside with the extension. When no extension match, [(f,"")] is returned *) let rec get_extension f = function | [] -> (f, "") | s :: _ when Filename.check_suffix f s -> (Filename.chop_suffix f s, s) | _ :: l -> get_extension f l (** Compute the suffixes of a logical path together with the length of the missing part *) let rec suffixes full = function | [] -> assert false | [name] -> [full,[name]] | dir::suffix as l -> (full,l)::suffixes false suffix (** Compute all the pairs [(from,suffs)] such that a logical path decomposes into [from @ ... @ suff] for some [suff] in [suffs], i.e. such that once [from] is fixed, [From from Require suff] refers (in the absence of ambiguity) to this logical path for exactly the [suff] in [suffs] *) let rec cuts recur = function | [] -> [] | [dir] -> [[],[true,[dir]]] | dir::tail as l -> ([],if recur then suffixes true l else [true,l]) :: List.map (fun (fromtail,suffixes) -> (dir::fromtail,suffixes)) (cuts true tail) let warning_ml_clash = let category = CWarnings.CoreCategories.filesystem in CWarnings.create ~name:"multiple-matching-files" ~category Pp.(fun (basename, suff, dir, dir') -> str (basename ^ suff) ++ str " already found in " ++ str (match dir with None -> "." | Some d -> d) ++ str " (discarding " ++ str (System.((match dir' with None -> "." | Some d -> d) // basename)) ++ str suff ++ str ")" ) let warning_ml_clash x s suff s' suff' = if suff = suff' && not (same_path_opt s s') then warning_ml_clash (x,suff,s,s') type result = | ExactMatches of filename list | PartialMatchesInSameRoot of root * filename list module State = struct type t = { mllib : (string, dir * string) Hashtbl.t ; mlpack : (string, dir * string) Hashtbl.t ; vfiles : (dirpath * dirpath, result) Hashtbl.t ; coqlib : (dirpath * dirpath, result) Hashtbl.t ; other : (dirpath * dirpath, result) Hashtbl.t ; boot : bool } let make ~boot = { mllib = Hashtbl.create 19 ; mlpack = Hashtbl.create 19 ; vfiles = Hashtbl.create 19 ; coqlib = Hashtbl.create 19 ; other = Hashtbl.create 19 ; boot } let gen_add h x s suff = let s = Option.map File_util.normalize_path s in try let s',suff' = Hashtbl.find h x in warning_ml_clash x s' suff' s suff with Not_found -> Hashtbl.add h x (s,suff) let gen_search h x = try Some (fst (Hashtbl.find h x)) with Not_found -> None end let add_mllib_known { State.mllib ; _ } = State.gen_add mllib let search_mllib_known { State.mllib ; _ } = State.gen_search mllib let add_mlpack_known { State.mlpack ; _ } = State.gen_add mlpack let search_mlpack_known { State.mlpack ; _ } = State.gen_search mlpack let add_set f l = f :: CList.remove equal_file f l let insert_key root (full,f) m = (* An exact match takes precedence over non-exact matches *) match full, m with | true, ExactMatches l -> (* We add a conflict *) ExactMatches (add_set f l) | true, PartialMatchesInSameRoot _ -> (* We give priority to exact match *) ExactMatches [f] | false, ExactMatches l -> (* We keep the exact match *) m | false, PartialMatchesInSameRoot (root',l) -> PartialMatchesInSameRoot (root, if root = root' then add_set f l else [f]) let safe_add_key q root key (full,f as file) = try let l = Hashtbl.find q key in Hashtbl.add q key (insert_key root file l) with Not_found -> Hashtbl.add q key (if full then ExactMatches [f] else PartialMatchesInSameRoot (root,[f])) let safe_add q root ((from, suffixes), file) = List.iter (fun (full,suff) -> safe_add_key q root (from,suff) (full,file)) suffixes let search_table table ?(from=[]) s = Hashtbl.find table (from, s) let search_v_known st ?from s = try Some (search_table st.State.vfiles ?from s) with Not_found -> None let search_other_known st ?from s = try Some (search_table st.State.other ?from s) with Not_found -> None let is_in_coqlib st ?from s = try let _ = search_table st.State.coqlib ?from s in true with Not_found -> false let add_caml_known st _ phys_dir _ f = let basename, suff = get_extension f [".mllib"; ".mlpack"; ".cmxs"] in match suff with | ".mllib" -> add_mllib_known st basename (Some phys_dir) suff | ".mlpack" -> add_mlpack_known st basename (Some phys_dir) suff (* Installed gloally *) | ".cmxs" -> add_mlpack_known st basename (Some phys_dir) suff | _ -> () let add_paths recur root table phys_dir log_dir basename = let name = log_dir@[basename] in let file = System.(phys_dir // basename) in let paths = cuts recur name in let iter n = safe_add table root (n, file) in List.iter iter paths let add_coqlib_known st recur root phys_dir log_dir f = let root = (phys_dir, log_dir) in match get_extension f [".vo"; ".vos"] with | (basename, (".vo" | ".vos")) -> add_paths recur root st.State.coqlib phys_dir log_dir basename | _ -> () let add_known st recur root phys_dir log_dir f = match get_extension f [".v"; ".vo"; ".vos"] with | (basename,".v") -> add_paths recur root st.State.vfiles phys_dir log_dir basename | (basename, (".vo" | ".vos")) when not st.State.boot -> add_paths recur root st.State.vfiles phys_dir log_dir basename | (f,_) -> add_paths recur root st.State.other phys_dir log_dir f (** Simply add this directory and imports it, no subdirs. This is used by the implicit adding of the current path (which is not recursive). *) let add_norec_dir_import add_file phys_dir log_dir = add_directory false (add_file true) phys_dir log_dir (** -Q semantic: go in subdirs but only full logical paths are known. *) let add_rec_dir_no_import add_file phys_dir log_dir = add_directory true (add_file false) phys_dir log_dir (** -R semantic: go in subdirs and suffixes of logical paths are known. *) let add_rec_dir_import add_file phys_dir log_dir = add_directory true (add_file true) phys_dir log_dir (** -I semantic: do not go in subdirs. *) let add_caml_dir st phys_dir = add_directory false (add_caml_known st) phys_dir [] let split_period = Str.split (Str.regexp (Str.quote ".")) let add_current_dir st dir = add_norec_dir_import (add_known st) dir [] let add_q_include st path l = add_rec_dir_no_import (add_known st) path (split_period l) let add_r_include st path l = add_rec_dir_import (add_known st) path (split_period l) coq-8.20.0/tools/coqdep/lib/loadpath.mli000066400000000000000000000060171466560755400200710ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* string list -> string * string (* Loadpaths *) type basename = string type dirname = string type dir = string option type filename = string type dirpath = string list type root = filename * dirpath type result = | ExactMatches of filename list | PartialMatchesInSameRoot of root * filename list module State : sig type t val make : boot:bool -> t end val search_v_known : State.t -> ?from:dirpath -> dirpath -> result option val search_other_known : State.t -> ?from:dirpath -> dirpath -> result option val search_mllib_known : State.t -> string -> dir option val search_mlpack_known : State.t -> string -> dir option val is_in_coqlib : State.t -> ?from:dirpath -> dirpath -> bool val add_caml_dir : State.t -> System.unix_path -> unit val add_current_dir : State.t -> System.unix_path -> unit val add_q_include : State.t -> System.unix_path -> string -> unit val add_r_include : State.t -> System.unix_path -> string -> unit (* These should disappear in favor of add_q / add_r *) (** Simply add this directory and imports it, no subdirs. This is used by the implicit adding of the current path. *) val add_norec_dir_import : (bool -> root -> dirname -> dirpath -> basename -> unit) -> dirname -> dirpath -> unit (** -Q semantic: go in subdirs but only full logical paths are known. *) val add_rec_dir_no_import : (bool -> root -> dirname -> dirpath -> basename -> unit) -> dirname -> dirpath -> unit (** -R semantic: go in subdirs and suffixes of logical paths are known. *) val add_rec_dir_import : (bool -> root -> dirname -> dirpath -> basename -> unit) -> dirname -> dirpath -> unit val add_known : State.t -> bool -> root -> dirname -> dirpath -> basename -> unit val add_coqlib_known : State.t -> bool -> root -> dirname -> dirpath -> basename -> unit (** [find_dir_logpath phys_dir] Return the logical path of directory [dir] if it has been given one. Raise [Not_found] otherwise. In particular we can check if "." has been attributed a logical path after processing all options and silently give the default one if it hasn't. We may also use this to warn if ap hysical path is met twice.*) val find_dir_logpath : string -> string list (* Used only in "canonize" *) val absolute_dir : string -> string val absolute_file_name : filename_concat:(string -> string -> string) -> string -> string option -> string coq-8.20.0/tools/coqdep/lib/makefile.ml000066400000000000000000000067461466560755400177120ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* Buffer.clear s'; for i = 0 to String.length s - 1 do let c = s.[i] in if c = ' ' || c = '#' || c = ':' (* separators and comments *) || c = '%' (* pattern *) || c = '?' || c = '[' || c = ']' || c = '*' (* expansion in filenames *) || i=0 && c = '~' && (String.length s = 1 || s.[1] = '/' || 'A' <= s.[1] && s.[1] <= 'Z' || 'a' <= s.[1] && s.[1] <= 'z') (* homedir expansion *) then begin let j = ref (i-1) in while !j >= 0 && s.[!j] = '\\' do Buffer.add_char s' '\\'; decr j (* escape all preceding '\' *) done; Buffer.add_char s' '\\'; end; if c = '$' then Buffer.add_char s' '$'; Buffer.add_char s' c done; Buffer.contents s' open Format type dynlink = Opt | Byte | Both | No | Variable let option_dynlink = ref Both let set_dyndep = function | "no" -> option_dynlink := No | "opt" -> option_dynlink := Opt | "byte" -> option_dynlink := Byte | "both" -> option_dynlink := Both | "var" -> option_dynlink := Variable | o -> CErrors.user_err Pp.(str "Incorrect -dyndep option: " ++ str o) let mldep_to_make (base, suff) = match !option_dynlink with | No -> [] | Byte -> [sprintf "%s%s" base suff] | Opt -> [sprintf "%s.cmxs" base] | Both -> [sprintf "%s%s" base suff ; sprintf "%s.cmxs" base] | Variable -> [sprintf "%s%s" base (if suff=".cmo" then "$(DYNOBJ)" else "$(DYNLIB)")] let string_of_dep ~suffix = let open Dep_info.Dep in function | Require basename -> [escape basename ^ suffix] | Ml (base,suff) -> mldep_to_make (escape base,suff) | Other s -> [escape s] let string_of_dependency_list ~suffix deps = List.map (string_of_dep ~suffix) deps |> List.concat |> String.concat " " let option_noglob = ref false let option_write_vos = ref false let set_noglob glob = option_noglob := glob let set_write_vos vos = option_write_vos := vos let print_dep fmt { Dep_info.name; deps } = let ename = escape name in let glob = if !option_noglob then "" else ename^".glob " in fprintf fmt "%s.vo %s%s.v.beautified %s.required_vo: %s.v %s\n" ename glob ename ename ename (string_of_dependency_list ~suffix:".vo" deps); if !option_write_vos then fprintf fmt "%s.vos %s.vok %s.required_vos: %s.v %s\n" ename ename ename ename (string_of_dependency_list ~suffix:".vos" deps); fprintf fmt "%!" coq-8.20.0/tools/coqdep/lib/makefile.mli000066400000000000000000000015011466560755400200430ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* Dep_info.t -> unit val set_dyndep : string -> unit val set_noglob : bool -> unit val set_write_vos : bool -> unit coq-8.20.0/tools/coqdoc/000077500000000000000000000000001466560755400150155ustar00rootroot00000000000000coq-8.20.0/tools/coqdoc/alpha.ml000066400000000000000000000032211466560755400164320ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* 'A' | '\199' -> 'C' | '\200'..'\203' -> 'E' | '\204'..'\207' -> 'I' | '\209' -> 'N' | '\210'..'\214' -> 'O' | '\217'..'\220' -> 'U' | '\221' -> 'Y' | c -> c let norm_char_utf8 c = Char.uppercase_ascii c let norm_char c = if !prefs.encoding.utf8 then norm_char_utf8 c else if !prefs.encoding.latin1 then norm_char_latin1 c else Char.uppercase_ascii c let norm_string = String.map (fun s -> norm_char s) let compare_char c1 c2 = match norm_char c1, norm_char c2 with | ('A'..'Z' as c1), ('A'..'Z' as c2) -> compare c1 c2 | 'A'..'Z', _ -> -1 | _, 'A'..'Z' -> 1 | '_', _ -> -1 | _, '_' -> 1 | c1, c2 -> compare c1 c2 let compare_string s1 s2 = let n1 = String.length s1 in let n2 = String.length s2 in let rec cmp i = if i == n1 || i == n2 then n1 - n2 else let c = compare_char s1.[i] s2.[i] in if c == 0 then cmp (succ i) else c in cmp 0 coq-8.20.0/tools/coqdoc/alpha.mli000066400000000000000000000015631466560755400166120ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* char -> int val compare_string : string -> string -> int (* Alphabetic normalization. *) val norm_char : char -> char val norm_string : string -> string coq-8.20.0/tools/coqdoc/cmdArgs.ml000066400000000000000000000314231466560755400167320ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* raise (Arg.Bad (Printf.sprintf "Not a valid filename: %s" fname)) | None -> () in let rec change_prefix = function (* Follow coqc: if in scope of -R, substitute logical name *) (* otherwise, keep only base name *) | [] -> fname | (p, name) :: rem -> try name_of_path p name dirname [fname] with Not_found -> change_prefix rem in change_prefix !prefs.paths let what_file f = FileUtil.check_if_file_exists f; if Filename.check_suffix f ".v" || Filename.check_suffix f ".g" then Vernac_file (f, coq_module f) else if Filename.check_suffix f ".tex" then Latex_file f else raise (Arg.Bad (Printf.sprintf "Expected a .v, .g, or .tex file: %s" f)) let arg_set f = Arg.Unit (fun () -> prefs := f !prefs) let arg_string f = Arg.String (fun s -> prefs := f !prefs s) let arg_file f = Arg.String (fun s -> FileUtil.check_if_file_exists s; prefs := f !prefs s) let arg_int f = Arg.Int (fun d -> prefs := f !prefs d) (* TODO: replace these hacks with Arg.Rest_all, when coq moves to a newer version of OCaml stdlib *) let arg_path f = Arg.String (fun s -> if Array.length Sys.argv < !Arg.current + 3 || CString.is_prefix "-" Sys.argv.(!Arg.current + 2) then raise (Arg.Bad ("Two arguments expected: and ")) else Arg.current := !Arg.current + 1; prefs := f !prefs (normalize_path s, Sys.argv.(!Arg.current + 1))) let arg_url_path f = Arg.String (fun s -> if Array.length Sys.argv < !Arg.current + 3 || CString.is_prefix "-" Sys.argv.(!Arg.current + 2) then raise (Arg.Bad ("Two arguments expected: and ")) else Arg.current := !Arg.current + 1; f s Sys.argv.(!Arg.current + 1)) let args_options = Arg.align [ "--html", arg_set (fun p -> { p with targetlang = HTML }), " Produce a HTML document (default)"; "--latex", arg_set (fun p -> { p with targetlang = LaTeX }), " Produce a LaTeX document"; "--texmacs",arg_set (fun p -> { p with targetlang = TeXmacs }), " Produce a TeXmacs document"; "--raw", arg_set (fun p -> { p with targetlang = Raw }), " Produce a text document"; "--dvi", arg_set (fun p -> { { p with targetlang = LaTeX } with compile_targets = Dvi :: !prefs.compile_targets }), " Output the DVI"; "--ps", arg_set (fun p -> { { p with targetlang = LaTeX } with compile_targets = Ps :: !prefs.compile_targets }), " Output the PostScript"; "--pdf", arg_set (fun p -> { { p with targetlang = LaTeX } with compile_targets = Pdf :: !prefs.compile_targets }), " Output the Pdf"; "--stdout", arg_set (fun p -> { p with out_to = StdOut }), " Write output to stdout"; "-o", arg_string (fun p f -> { { p with out_to = File (Filename.basename f) } with output_dir = Filename.dirname f }), " Write output to file "; "--output", arg_string (fun p f -> { { p with out_to = File (Filename.basename f) } with output_dir = Filename.dirname f }), " Write output to file "; "-d", arg_string (fun p f -> { p with output_dir = f }), " Output files into directory "; "--directory", arg_string (fun p f -> { p with output_dir = f }), " Output files into directory "; "-g", arg_set (fun p -> { p with gallina = true }), " Skip proofs (gallina)"; "--gallina", arg_set (fun p -> { p with gallina = true }), " Skip proofs"; "-s", arg_set (fun p -> { p with short = true }), " No titles for files (short)"; "--short", arg_set (fun p -> { p with short = true }), " No titles for files"; "-l", arg_set (fun p -> { { p with gallina = true } with light = true }), " Light mode (only defs and statements)"; "--light", arg_set (fun p -> { { p with gallina = true } with light = true }), " Light mode (only defs and statements)"; "-t", arg_string (fun p s -> { p with title = s }), " Give a title to the document"; "--title", arg_string (fun p s -> { p with title = s }), " Give a title to the document"; "--body-only", arg_set (fun p -> { p with header_trailer = false }), " Suppress LaTeX/HTML header and trailer"; "--no-preamble", arg_set (fun p -> { p with header_trailer = false }), " Suppress LaTeX/HTML header and trailer"; "--with-header", arg_file (fun p f -> { p with header_trailer = true; header_file_spec = true; header_file = f }), " Prepend as html header"; "--with-footer", arg_file (fun p f -> { p with header_trailer = true; footer_file_spec = true; footer_file = f }), " append as html footer"; "--no-index", arg_set (fun p -> { p with index = false }), " Do not output the index"; "--binder-index", arg_set (fun p -> { p with binder_index = true }), " Include variable binders in index"; "--multi-index", arg_set (fun p -> { p with multi_index = true }), " Index split in multiple files"; "--index", arg_string (fun p s -> { p with index_name = s }), " Set index name to (default is index)"; "--toc", arg_set (fun p -> { p with toc = true }), " Output a table of contents"; "--table-of-contents", arg_set (fun p -> { p with toc = true }), " Output a table of contents"; "--vernac-file", arg_file (fun p f -> { p with files = Vernac_file (f, coq_module f) :: !prefs.files }), " consider as a .v file"; "--tex-file", arg_file (fun p f -> { p with files = Latex_file f :: !prefs.files }), " Consider as a .tex file"; "-p", Arg.String (fun f -> Output.push_in_preamble f), " Insert in LaTeX preamble"; "--preamble", Arg.String (fun f -> Output.push_in_preamble f), " Insert in LaTeX preamble"; "--files-from", arg_file (fun p f -> { p with files = List.append (List.map what_file (FileUtil.files_from_file f)) !prefs.files }), " Read file names to process in "; "--files", arg_file (fun p f -> { p with files = List.append (List.map what_file (FileUtil.files_from_file f)) !prefs.files }), " Read file names to process in "; "--glob-from", arg_file (fun p f -> { p with glob_source = GlobFile f }), " Read globalization information from "; "--no-glob", arg_set (fun p -> { p with glob_source = NoGlob }), " Don't use any globalization information (no links will be inserted at identifiers)"; "-q", arg_set (fun p -> { p with quiet = true }), " Quiet mode (default)"; "--quiet", arg_set (fun p -> { p with quiet = true }), " Quiet mode (default)"; "--verbose", arg_set (fun p -> { p with quiet = false }), " Verbose mode"; "--no-externals", arg_set (fun p -> { p with externals = false }), " No links to Coq standard library"; "--external", arg_url_path (fun url lp -> Index.add_external_library lp url), "+ set URL for external library "; "--coqlib_url", arg_string (fun p u -> { p with coqlib_url = u }), " Set URL for Coq standard library (default: " ^ Coq_config.wwwstdlib ^ ")"; "--coqlib", Arg.String (fun d -> Boot.Env.set_coqlib d), " Set the path where Coq files are installed"; "-R", arg_path (fun p l -> { p with paths = l :: !prefs.paths }), "+ map physical dir to Coq dir"; "-Q", arg_path (fun p l -> { p with paths = l :: !prefs.paths }), "+ Map physical dir to Coq dir"; "--latin1", arg_set (fun p -> {p with encoding = { charset = "iso-8859-1"; inputenc = "latin1"; latin1 = true; utf8 = false } }), " Set ISO-8859-1 mode"; "--utf8", arg_set (fun p -> {p with encoding = { charset = "utf-8"; inputenc = "utf8x"; latin1 = false; utf8 = true } }), " Set UTF-8 mode"; "--charset", arg_string (fun p s -> { p with encoding = { !prefs.encoding with charset = s } }), " Set HTML charset"; "--inputenc", arg_string (fun p s -> { p with encoding = { !prefs.encoding with inputenc = s } }), " Set LaTeX input encoding"; "--interpolate", arg_set (fun p -> {p with interpolate = true }), " Try to typeset identifiers in comments using definitions in the same module"; "--raw-comments", arg_set (fun p -> {p with raw_comments = true }), " Raw comments"; "--parse-comments", arg_set (fun p -> {p with parse_comments = true }), " Parse regular comments"; "--plain-comments", arg_set (fun p -> {p with plain_comments = true }), " Consider comments as non-literate text"; "--toc-depth", arg_int (fun p d -> { p with toc_depth = Some d }), " Don't include TOC entries for sections below level "; "--no-lib-name", arg_set (fun p -> { p with lib_name = "" }), " Don't display \"Library\" before library names in the toc"; "--lib-name", arg_string (fun p s -> { p with lib_name = s }), " Call top level toc entries instead of \"Library\""; "--lib-subtitles", arg_set (fun p -> { p with lib_subtitles = true }), " First line comments of the form (** * ModuleName : text *) will be interpreted as subtitles"; "--inline-notmono", arg_set (fun p -> { p with inline_notmono = true }), " Use a proportional width font for inline code (possibly with a different color)"; "--version", Arg.Unit (fun () -> banner()), " Display coqdoc version"; ] let add_input_files f = prefs := { !prefs with files = what_file f :: !prefs.files } let usage_msg = "coqdoc [options] ...\nAvailable options are:" let parse_args () = (* Deprecated options *) let single_hyphen_opts = ["-html"; "-latex"; "-texmacs"; "-raw"; "-dvi"; "-ps"; "-pdf"; "-stdout"; "-output"; "-directory"; "-gallina"; "-short"; "-light"; "-title"; "-body-only"; "-no-preamble"; "-with-header"; "-with-footer"; "-no-index"; "-multi-index"; "-index"; "-toc"; "-table-of-contents"; "-vernac-file"; "-tex-file"; "-preamble"; "-files-from"; "-files"; "-glob-from"; "-no-glob"; "-quiet"; "-verbose"; "-no-externals"; "-external"; "-coqlib_url"; "-coqlib"; "-latin1"; "-utf8"; "-charset"; "-inputenc"; "-interpolate"; "-raw-comments"; "-parse-comments"; "-plain-comments"; "-toc-depth"; "-no-lib-name"; "-lib-name"; "-lib-subtitles"; "-inline-notmono"; "-version"] in let deprecated_mapper_opts = [("-noindex", "--no-index"); ("-nopreamble", "--no-preamble"); ("-noexternals", "--no-externals"); ("-V", "--version")] in let new_argv = Array.map (fun s -> match List.find_opt (fun m -> m = s) single_hyphen_opts with | Some _ -> Printf.sprintf "-%s" s | None -> (match List.assoc_opt s deprecated_mapper_opts with | Some b -> b | None -> s)) Sys.argv in try Arg.parse_argv new_argv args_options add_input_files usage_msg with | Arg.Bad s -> Printf.eprintf "%s" s | Arg.Help s -> Printf.printf "%s" s coq-8.20.0/tools/coqdoc/cmdArgs.mli000066400000000000000000000013561466560755400171050ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* unit coq-8.20.0/tools/coqdoc/common.ml000066400000000000000000000073251466560755400166460ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* "" && Filename.is_relative f then if not (Sys.file_exists !prefs.output_dir) then (Printf.eprintf "No such directory: %s\n" !prefs.output_dir; exit 1) else !prefs.output_dir / f else f let open_out_file f = out_channel := try open_out (coqdoc_out f) with Sys_error s -> Printf.eprintf "%s\n" s; exit 1 let close_out_file () = close_out !out_channel (* End little helpers **************************************************************) coq-8.20.0/tools/coqdoc/common.mli000066400000000000000000000052641466560755400170170ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* string -> string val coqdoc_out : string -> string val open_out_file : string -> unit val close_out_file : unit -> unit (* End little helpers **************************************************************) coq-8.20.0/tools/coqdoc/coqdoc.css000066400000000000000000000137731466560755400170120ustar00rootroot00000000000000body { padding: 0px 0px; margin: 0px 0px; background-color: white } #page { display: block; padding: 0px; margin: 0px; padding-bottom: 10px; } #header { display: block; position: relative; padding: 0; margin: 0; vertical-align: middle; border-bottom-style: solid; border-width: thin } #header h1 { padding: 0; margin: 0;} /* Contents */ #main{ display: block; padding: 10px; font-family: sans-serif; font-size: 100%; line-height: 100% } #main h1 { line-height: 95% } /* allow for multi-line headers */ #main a.idref:visited {color : #416DFF; text-decoration : none; } #main a.idref:link {color : #416DFF; text-decoration : none; } #main a.idref:hover {text-decoration : none; } #main a.idref:active {text-decoration : none; } #main a.modref:visited {color : #416DFF; text-decoration : none; } #main a.modref:link {color : #416DFF; text-decoration : none; } #main a.modref:hover {text-decoration : none; } #main a.modref:active {text-decoration : none; } #main .keyword { color : #cf1d1d } #main { color: black } .section { background-color: rgb(60%,60%,100%); padding-top: 13px; padding-bottom: 13px; padding-left: 3px; margin-top: 5px; margin-bottom: 5px; font-size : 175% } h2.section { background-color: rgb(80%,80%,100%); padding-left: 3px; padding-top: 12px; padding-bottom: 10px; font-size : 130% } h3.section { background-color: rgb(90%,90%,100%); padding-left: 3px; padding-top: 7px; padding-bottom: 7px; font-size : 115% } h4.section { /* background-color: rgb(80%,80%,80%); max-width: 20em; padding-left: 5px; padding-top: 5px; padding-bottom: 5px; */ background-color: white; padding-left: 0px; padding-top: 0px; padding-bottom: 0px; font-size : 100%; font-weight : bold; text-decoration : underline; } #main .doc { margin: 0px; font-family: sans-serif; font-size: 100%; line-height: 125%; max-width: 40em; color: black; padding: 10px; background-color: #90bdff } .inlinecode { display: inline; /* font-size: 125%; */ color: #666666; font-family: monospace } .doc .inlinecode { display: inline; font-size: 120%; color: rgb(30%,30%,70%); font-family: monospace } .doc .inlinecode .id { color: rgb(30%,30%,70%); } .inlinecodenm { display: inline; color: #444444; } .doc .code { display: inline; font-size: 120%; color: rgb(30%,30%,70%); font-family: monospace } .comment { display: inline; font-family: monospace; color: rgb(50%,50%,80%); } .code { display: block; /* padding-left: 15px; */ font-size: 110%; font-family: monospace; } table.infrule { border: 0px; margin-left: 50px; margin-top: 10px; margin-bottom: 10px; } td.infrule { font-family: monospace; text-align: center; /* color: rgb(35%,35%,70%); */ padding: 0px; line-height: 100%; } tr.infrulemiddle hr { margin: 1px 0 1px 0; } .infrulenamecol { color: rgb(60%,60%,60%); font-size: 80%; padding-left: 1em; padding-bottom: 0.1em } /* Pied de page */ #footer { font-size: 65%; font-family: sans-serif; } /* Identifiers: ) */ .id { display: inline; } .id[title="constructor"] { color: rgb(60%,0%,0%); } .id[title="var"] { color: rgb(40%,0%,40%); } .id[title="variable"] { color: rgb(40%,0%,40%); } .id[title="definition"] { color: rgb(0%,40%,0%); } .id[title="abbreviation"] { color: rgb(0%,40%,0%); } .id[title="lemma"] { color: rgb(0%,40%,0%); } .id[title="instance"] { color: rgb(0%,40%,0%); } .id[title="projection"] { color: rgb(0%,40%,0%); } .id[title="method"] { color: rgb(0%,40%,0%); } .id[title="inductive"] { color: rgb(0%,0%,80%); } .id[title="record"] { color: rgb(0%,0%,80%); } .id[title="class"] { color: rgb(0%,0%,80%); } .id[title="keyword"] { color : #cf1d1d; /* color: black; */ } /* Deprecated rules using the 'type' attribute of (not xhtml valid) */ .id[type="constructor"] { color: rgb(60%,0%,0%); } .id[type="var"] { color: rgb(40%,0%,40%); } .id[type="variable"] { color: rgb(40%,0%,40%); } .id[title="binder"] { color: rgb(40%,0%,40%); } .id[type="definition"] { color: rgb(0%,40%,0%); } .id[type="abbreviation"] { color: rgb(0%,40%,0%); } .id[type="lemma"] { color: rgb(0%,40%,0%); } .id[type="instance"] { color: rgb(0%,40%,0%); } .id[type="projection"] { color: rgb(0%,40%,0%); } .id[type="method"] { color: rgb(0%,40%,0%); } .id[type="inductive"] { color: rgb(0%,0%,80%); } .id[type="record"] { color: rgb(0%,0%,80%); } .id[type="class"] { color: rgb(0%,0%,80%); } .id[type="keyword"] { color : #cf1d1d; /* color: black; */ } .inlinecode .id { color: rgb(0%,0%,0%); } /* TOC */ #toc h2 { padding: 10px; background-color: rgb(60%,60%,100%); } #toc li { padding-bottom: 8px; } /* Index */ #index { margin: 0; padding: 0; width: 100%; } #index #frontispiece { margin: 1em auto; padding: 1em; width: 60%; } .booktitle { font-size : 140% } .authors { font-size : 90%; line-height: 115%; } .moreauthors { font-size : 60% } #index #entrance { text-align: center; } #index #entrance .spacer { margin: 0 30px 0 30px; } #index #footer { position: absolute; bottom: 0; } .paragraph { height: 0.75em; } ul.doclist { margin-top: 0em; margin-bottom: 0em; } .code :target { border: 2px solid #D4D4D4; background-color: #e5eecc; } coq-8.20.0/tools/coqdoc/coqdoc.sty000066400000000000000000000126441466560755400170350ustar00rootroot00000000000000 % This is coqdoc.sty, by Jean-Christophe Filliâtre % This LaTeX package is used by coqdoc (http://www.lri.fr/~filliatr/coqdoc) % % You can modify the following macros to customize the appearance % of the document. \NeedsTeXFormat{LaTeX2e} \ProvidesPackage{coqdoc}[2002/02/11] % % Headings % \usepackage{fancyhdr} % \newcommand{\coqdocleftpageheader}{\thepage\ -- \today} % \newcommand{\coqdocrightpageheader}{\today\ -- \thepage} % \pagestyle{fancyplain} % %BEGIN LATEX % \headsep 8mm % \renewcommand{\plainheadrulewidth}{0.4pt} % \renewcommand{\plainfootrulewidth}{0pt} % \lhead[\coqdocleftpageheader]{\leftmark} % \rhead[\leftmark]{\coqdocrightpageheader} % \cfoot{} % %END LATEX % Hevea puts to much space with \medskip and \bigskip %HEVEA\renewcommand{\medskip}{} %HEVEA\renewcommand{\bigskip}{} %HEVEA\newcommand{\lnot}{\coqwkw{not}} %HEVEA\newcommand{\lor}{\coqwkw{or}} %HEVEA\newcommand{\land}{\&} % own name \newcommand{\coqdoc}{\textsf{coqdoc}} % pretty underscores (the package fontenc causes ugly underscores) %BEGIN LATEX \def\_{\kern.08em\vbox{\hrule width.35em height.6pt}\kern.08em} %END LATEX % macro for typesetting keywords \newcommand{\coqdockw}[1]{\texttt{#1}} % macro for typesetting variable identifiers \newcommand{\coqdocvar}[1]{\textit{#1}} % macro for typesetting constant identifiers \newcommand{\coqdoccst}[1]{\textsf{#1}} % macro for typesetting module identifiers \newcommand{\coqdocmod}[1]{\textsc{\textsf{#1}}} % macro for typesetting module constant identifiers (e.g. Parameters in % module types) \newcommand{\coqdocax}[1]{\textsl{\textsf{#1}}} % macro for typesetting inductive type identifiers \newcommand{\coqdocind}[1]{\textbf{\textsf{#1}}} % macro for typesetting constructor identifiers \newcommand{\coqdocconstr}[1]{\textsf{#1}} % macro for typesetting tactic identifiers \newcommand{\coqdoctac}[1]{\texttt{#1}} % These are the real macros used by coqdoc, their typesetting is % based on the above macros by default. \newcommand{\coqdoclibrary}[1]{\coqdoccst{#1}} \newcommand{\coqdocinductive}[1]{\coqdocind{#1}} \newcommand{\coqdocdefinition}[1]{\coqdoccst{#1}} \newcommand{\coqdocvariable}[1]{\coqdocvar{#1}} \newcommand{\coqdocbinder}[1]{\coqdocvar{#1}} \newcommand{\coqdocconstructor}[1]{\coqdocconstr{#1}} \newcommand{\coqdoclemma}[1]{\coqdoccst{#1}} \newcommand{\coqdocclass}[1]{\coqdocind{#1}} \newcommand{\coqdocinstance}[1]{\coqdoccst{#1}} \newcommand{\coqdocmethod}[1]{\coqdoccst{#1}} \newcommand{\coqdocabbreviation}[1]{\coqdoccst{#1}} \newcommand{\coqdocrecord}[1]{\coqdocind{#1}} \newcommand{\coqdocprojection}[1]{\coqdoccst{#1}} \newcommand{\coqdocnotation}[1]{\coqdockw{#1}} \newcommand{\coqdocsection}[1]{\coqdoccst{#1}} \newcommand{\coqdocaxiom}[1]{\coqdocax{#1}} \newcommand{\coqdocmodule}[1]{\coqdocmod{#1}} % Environment encompassing code fragments % !!! CAUTION: This environment may have empty contents \newenvironment{coqdoccode}{}{} % Environment for comments \newenvironment{coqdoccomment}{\tt(*}{*)} % newline and indentation %BEGIN LATEX % Base indentation length \newlength{\coqdocbaseindent} \setlength{\coqdocbaseindent}{0em} % Beginning of a line without any Coq indentation \newcommand{\coqdocnoindent}{\noindent\kern\coqdocbaseindent} % Beginning of a line with a given Coq indentation \newcommand{\coqdocindent}[1]{\noindent\kern\coqdocbaseindent\noindent\kern#1} % End-of-the-line \newcommand{\coqdoceol}{\hspace*{\fill}\setlength\parskip{0pt}\par} % Empty lines (in code only) \newcommand{\coqdocemptyline}{\vskip 0.4em plus 0.1em minus 0.1em} \usepackage{ifpdf} \ifpdf \RequirePackage{hyperref} \hypersetup{raiselinks=true,colorlinks=true,linkcolor=black} % To do indexing, use something like: % \usepackage{multind} % \newcommand{\coqdef}[3]{\hypertarget{coq:#1}{\index{coq}{#1@#2|hyperpage}#3}} \newcommand{\coqdef}[3]{\phantomsection\hypertarget{coq:#1}{#3}} \newcommand{\coqref}[2]{\hyperlink{coq:#1}{#2}} \newcommand{\coqexternalref}[3]{\href{#1.html\##2}{#3}} \newcommand{\identref}[2]{\hyperlink{coq:#1}{\textsf {#2}}} \newcommand{\coqlibrary}[3]{\cleardoublepage\phantomsection \hypertarget{coq:#1}{\chapter{#2\texorpdfstring{\coqdoccst}{}{#3}}}} \else \newcommand{\coqdef}[3]{#3} \newcommand{\coqref}[2]{#2} \newcommand{\coqexternalref}[3]{#3} \newcommand{\texorpdfstring}[2]{#1} \newcommand{\identref}[2]{\textsf{#2}} \newcommand{\coqlibrary}[3]{\cleardoublepage\chapter{#2\coqdoccst{#3}}} \fi \usepackage{xr} \newif\if@coqdoccolors \@coqdoccolorsfalse \DeclareOption{color}{\@coqdoccolorstrue} \ProcessOptions \if@coqdoccolors \RequirePackage{xcolor} \definecolor{varpurple}{rgb}{0.4,0,0.4} \definecolor{constrmaroon}{rgb}{0.6,0,0} \definecolor{defgreen}{rgb}{0,0.4,0} \definecolor{indblue}{rgb}{0,0,0.8} \definecolor{kwred}{rgb}{0.8,0.1,0.1} \def\coqdocvarcolor{varpurple} \def\coqdockwcolor{kwred} \def\coqdoccstcolor{defgreen} \def\coqdocindcolor{indblue} \def\coqdocconstrcolor{constrmaroon} \def\coqdocmodcolor{defgreen} \def\coqdocaxcolor{varpurple} \def\coqdoctaccolor{black} \def\coqdockw#1{{\color{\coqdockwcolor}{\texttt{#1}}}} \def\coqdocvar#1{{\color{\coqdocvarcolor}{\textit{#1}}}} \def\coqdoccst#1{{\color{\coqdoccstcolor}{\textrm{#1}}}} \def\coqdocind#1{{\color{\coqdocindcolor}{\textsf{#1}}}} \def\coqdocconstr#1{{\color{\coqdocconstrcolor}{\textsf{#1}}}} \def\coqdocmod#1{{{\color{\coqdocmodcolor}{\textsc{\textsf{#1}}}}}} \def\coqdocax#1{{{\color{\coqdocaxcolor}{\textsl{\textrm{#1}}}}}} \def\coqdoctac#1{{\color{\coqdoctaccolor}{\texttt{#1}}}} \fi \endinput coq-8.20.0/tools/coqdoc/cpretty.mli000066400000000000000000000014321466560755400172120ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* Common.coq_module -> unit val detect_subtitle : string -> Common.coq_module -> string option coq-8.20.0/tools/coqdoc/cpretty.mll000066400000000000000000001353321466560755400172240ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* [] | (l :: ls) -> l :: (take (n-1) ls) (* count the number of spaces at the beginning of a string *) let count_spaces s = let n = String.length s in let rec count c i = if i == n then c,i else match s.[i] with | '\t' -> count (c + (8 - (c mod 8))) (i + 1) | ' ' -> count (c + 1) (i + 1) | _ -> c,i in count 0 0 let count_newlines s = let len = String.length s in let n = ref 0 in String.iteri (fun i c -> match c with (* skip "\r\n" *) | '\r' when i + 1 = len || s.[i+1] = '\n' -> incr n | '\n' -> incr n | _ -> ()) s; !n (* Whether a string starts with a newline (used on strings that might match the [nl] regexp) *) let is_nl s = String.length s = 0 || let c = s.[0] in c = '\n' || c = '\r' let remove_newline s = let n = String.length s in let rec count i = if i == n || s.[i] <> '\n' then i else count (i + 1) in let i = count 0 in i, String.sub s i (n - i) let count_dashes s = let c = ref 0 in for i = 0 to String.length s - 1 do if s.[i] = '-' then incr c done; !c let cut_head_tail_spaces s = let n = String.length s in let rec look_up i = if i == n || s.[i] <> ' ' then i else look_up (i+1) in let rec look_dn i = if i == -1 || s.[i] <> ' ' then i else look_dn (i-1) in let l = look_up 0 in let r = look_dn (n-1) in if l <= r then String.sub s l (r-l+1) else s let sec_title s = let rec count lev i = if s.[i] = '*' then count (succ lev) (succ i) else let t = String.sub s i (String.length s - i) in lev, cut_head_tail_spaces t in count 0 (String.index s '*') let strip_eol s = let eol = s.[String.length s - 1] = '\n' in (eol, if eol then String.sub s 1 (String.length s - 1) else s) let is_none x = match x with | None -> true | Some _ -> false let formatted : position option ref = ref None let brackets = ref 0 let comment_level = ref 0 let in_proof = ref None let in_env start stop = let r = ref false in let start_env () = r := true; start () in let stop_env () = if !r then stop (); r := false in (fun x -> !r), start_env, stop_env let _, start_emph, stop_emph = in_env Output.start_emph Output.stop_emph let in_quote, start_quote, stop_quote = in_env Output.start_quote Output.stop_quote let url_buffer = Buffer.create 40 let url_name_buffer = Buffer.create 40 let backtrack lexbuf = lexbuf.lex_curr_pos <- lexbuf.lex_start_pos; lexbuf.lex_curr_p <- lexbuf.lex_start_p let backtrack_past_newline lexbuf = let buf = lexeme lexbuf in let splits = Str.bounded_split_delim (Str.regexp "['\n']") buf 2 in match splits with | [] -> () | (_ :: []) -> () | (s1 :: rest :: _) -> let length_skip = 1 + String.length s1 in lexbuf.lex_curr_pos <- lexbuf.lex_start_pos + length_skip (* saving/restoring the PP state *) type state = { st_gallina : bool; st_light : bool } let state_stack = Stack.create () let save_state () = Stack.push { st_gallina = !prefs.gallina; st_light = !prefs.light } state_stack let restore_state () = let s = Stack.pop state_stack in prefs := { !prefs with gallina = s.st_gallina }; prefs := { !prefs with light = s.st_light } let begin_show () = save_state (); prefs := { { !prefs with gallina = false } with light = false } let end_show () = restore_state () let begin_details s = save_state (); prefs := { { !prefs with gallina = false } with light = false }; Output.start_details s let end_details () = Output.stop_details (); restore_state () (* Reset the globals *) let reset () = formatted := None; brackets := 0; comment_level := 0 (* erasing of Section/End *) let section_re = Str.regexp "[ \t]*Section" let end_re = Str.regexp "[ \t]*End" let is_section s = Str.string_match section_re s 0 let is_end s = Str.string_match end_re s 0 let sections_to_close = ref 0 let section_or_end s = if is_section s then begin incr sections_to_close; true end else if is_end s then begin if !sections_to_close > 0 then begin decr sections_to_close; true end else false end else true (* for item lists *) type list_compare = | Before | StartLevel of int | InLevel of int * bool (* Before : we're before any levels StartLevel : at the same column as the dash in a level InLevel : after the dash of this level, but before any deeper dashes. bool is true if this is the last level *) let find_level levels cur_indent = match levels with | [] -> Before | (l::ls) -> if cur_indent < l then Before else (* cur_indent will never be less than the head of the list *) let rec findind ls n = match ls with | [] -> InLevel (n,true) | (l :: []) -> if cur_indent = l then StartLevel n else InLevel (n,true) | (l1 :: l2 :: ls) -> if cur_indent = l1 then StartLevel n else if cur_indent < l2 then InLevel (n,false) else findind (l2 :: ls) (n+1) in findind (l::ls) 1 type is_start_list = | Rule | List of int | Neither let check_start_list str = let n_dashes = count_dashes str in let (n_spaces,_) = count_spaces str in if n_dashes >= 4 && not !prefs.plain_comments then Rule else if n_dashes = 1 && not !prefs.plain_comments then List n_spaces else Neither (* examine a string for subtitleness *) let subtitle m s = match Str.split_delim (Str.regexp ":") s with | [] -> false | (name::_) -> if (cut_head_tail_spaces name) = m then true else false (* tokens pretty-print *) let token_buffer = Buffer.create 1024 let token_re = Str.regexp "[ \t]*(\\*\\*[ \t]+printing[ \t]+\\([^ \t]+\\)" let printing_token_re = Str.regexp "[ \t]*\\(\\(%\\([^%]*\\)%\\)\\|\\(\\$[^$]*\\$\\)\\)?[ \t]*\\(#\\(\\(&#\\|[^#]\\)*\\)#\\)?" let add_printing_token toks pps = try if Str.string_match token_re toks 0 then let tok = Str.matched_group 1 toks in if Str.string_match printing_token_re pps 0 then let pp = (try Some (Str.matched_group 3 pps) with _ -> try Some (Str.matched_group 4 pps) with _ -> None), (try Some (Str.matched_group 6 pps) with _ -> None) in Output.add_printing_token tok pp with _ -> () let remove_token_re = Str.regexp "[ \t]*(\\*\\*[ \t]+remove[ \t]+printing[ \t]+\\([^ \t]+\\)[ \t]*\\*)" let remove_printing_token toks = try if Str.string_match remove_token_re toks 0 then let tok = Str.matched_group 1 toks in Output.remove_printing_token tok with _ -> () let output_indented_keyword s lexbuf = let nbsp,isp = count_spaces s in Output.indentation nbsp; let s = String.sub s isp (String.length s - isp) in Output.keyword s (lexeme_start lexbuf + isp) let only_gallina () = !prefs.gallina && !in_proof <> None let parse_comments () = !prefs.parse_comments && not (only_gallina ()) (* Advance lexbuf by n lines. Equivalent to calling [Lexing.new_line lexbuf] n times *) let new_lines n lexbuf = let lcp = lexbuf.lex_curr_p in if lcp != dummy_pos then lexbuf.lex_curr_p <- { lcp with pos_lnum = lcp.pos_lnum + n; pos_bol = lcp.pos_cnum } let print_position_p chan p = Printf.fprintf chan "%s%d, character %d" (if p.pos_fname = "" then "Line " else "File \"" ^ p.pos_fname ^ "\", line ") p.pos_lnum (p.pos_cnum - p.pos_bol) let print_position chan {lex_start_p = p} = print_position_p chan p let warn msg lexbuf = eprintf "%a, warning: %s\n" print_position lexbuf msg; flush stderr exception MismatchPreformatted of position (* let debug lexbuf msg = Printf.printf "%a %s\n" print_position lexbuf.lex_start_p msg *) } (*s Regular expressions *) let space = [' ' '\t'] let nl = "\r\n" | '\n' | '\r' let space_nl = space | nl let firstchar = ['A'-'Z' 'a'-'z' '_'] | (* superscript 1 *) '\194' '\185' | (* utf-8 latin 1 supplement *) '\195' ['\128'-'\150'] | '\195' ['\152'-'\182'] | '\195' ['\184'-'\191'] | (* utf-8 letterlike symbols *) '\206' (['\145'-'\161'] | ['\163'-'\191']) | '\207' (['\145'-'\191']) | '\226' ('\130' [ '\128'-'\137' ] (* subscripts *) | '\129' [ '\176'-'\187' ] (* superscripts *) | '\132' ['\128'-'\191'] | '\133' ['\128'-'\143']) let identchar = firstchar | ['\'' '0'-'9' '@' ] let id = firstchar identchar* let pfx_id = (id '.')* let identifier = id | pfx_id id (* This misses unicode stuff, and it adds "[" and "]". It's only an approximation of idents - used for detecting whether an underscore is part of an identifier or meant to indicate emphasis *) let nonidentchar = [^ 'A'-'Z' 'a'-'z' '_' '[' ']' '\'' '0'-'9' '@' '\"' '\'' '`'] let printing_token = [^ ' ' '\t']* let thm_token = "Theorem" | "Lemma" | "Fact" | "Remark" | "Corollary" | "Proposition" | "Property" | "Goal" let prf_token = "Next" space+ "Obligation" | "Proof" (space* "." | space+ "with" | space+ "using") let immediate_prf_token = (* Approximation of a proof term, if not in the prf_token case *) (* To be checked after prf_token *) "Proof" space* [^ '.' 'w' 'u'] let def_token = "Definition" | "Let" | "Let" space* "Fixpoint" | "Let" space* "CoFixpoint" | "Class" | "SubClass" | "Example" | "Fixpoint" | "Function" | "Boxed" | "CoFixpoint" | "Record" | "Variant" | "Structure" | "Scheme" | "Combined" space+ "Scheme" | "Inductive" | "CoInductive" | "Equations" | "Instance" | "Existing" space+ ("Instance" | "Instances" | "Class") | "Declare" space+ "Instance" | "Functional" space+ "Scheme" let decl_token = "Hypothesis" | "Hypotheses" | "Parameter" 's'? | "Axiom" 's'? | "Conjecture" | "Primitive" | "Constraint" | "Universe" | "Universes" | "Register" let gallina_ext = "Module" | "Include" space+ "Type" | "Include" | "Declare" space+ "Module" | "Transparent" | "Opaque" | "Typeclasses" space+ "Transparent" | "Typeclasses" space+ "Opaque" | "Canonical" | "Coercion" | "Identity" | "Implicit" | "Tactic" space+ "Notation" | "Section" | "Context" | "Variable" 's'? | ("Hypothesis" | "Hypotheses") | "End" let notation_kw = "Notation" | "Infix" | "Reserved" space+ "Notation" | "Reserved" space+ "Infix" | "Number" space+ "Notation" | "String" space+ "Notation" | "Enable" space+ "Notation" | "Disable" space+ "Notation" let commands = "Pwd" | "Cd" | "Drop" | "ProtectedLoop" | "Quit" | "Restart" | "Load" | "Add" | "Remove" space+ "Loadpath" | "Print" | "Inspect" | "About" | "SearchAbout" | "SearchRewrite" | "Search" | "Locate" | "Eval" | "Reset" | "Check" | "Type" | "Section" | "Chapter" | "Variable" 's'? | ("Hypothesis" | "Hypotheses") | "End" let end_kw = immediate_prf_token | "Qed" | "Defined" | "Save" | "Admitted" | "Abort" let extraction = "Extraction" | "Recursive" space+ "Extraction" | "Extract" let gallina_kw = thm_token | def_token | decl_token | gallina_ext | commands | extraction let legacy_attr_kw = "Local" | "Global" | "Polymorphic" | "Monomorphic" | "Cumulative" | "NonCumulative" | "Private" let prog_kw = "Program" space+ (legacy_attr_kw space+)* gallina_kw | "Obligation" | "Obligations" | "Solve" let hint_kw = "Extern" | "Rewrite" | "Resolve" | "Immediate" | "Transparent" | "Opaque" | "Unfold" | "Constructors" let set_kw = "Printing" space+ ("Coercions" | "Universes" | "All") | "Implicit" space+ "Arguments" let gallina_kw_to_hide = "Implicit" space+ "Arguments" | "Arguments" | "Ltac" | "From" | "Require" | "Import" | "Export" | "Load" | "Hint" space+ hint_kw | "Create" space+ "HintDb" | "Removed" space+ "Hints" | "Open" | "Close" | "Delimit" | "Undelimit" | "Declare" space+ "Scope" | "Bind" space+ "Scope" | "Format" | "Transparent" | "Opaque" | "Strategy" | "Derive" | "Generalizable" space+ ("All" space+ "Variables" | "No" space+ "Variables" | "Variable" | "Variables") | ("Declare" space+ ("Morphism" | "Step") ) | ("Set" | "Unset") space+ set_kw | "Declare" space+ ("Left" | "Right") space+ "Step" | "Debug" space+ ("On" | "Off") | "Collection" let section = "*" | "**" | "***" | "****" let item_space = " " let begin_hide = "(*" space* "begin" space+ "hide" space* "*)" space* let end_hide = "(*" space* "end" space+ "hide" space* "*)" space* let begin_show = "(*" space* "begin" space+ "show" space* "*)" space* let end_show = "(*" space* "end" space+ "show" space* "*)" space* let begin_details = "(*" space* "begin" space+ "details" space* let end_details = "(*" space* "end" space+ "details" space* "*)" space* (* let begin_verb = "(*" space* "begin" space+ "verb" space* "*)" let end_verb = "(*" space* "end" space+ "verb" space* "*)" *) (*s Scanning Coq, at beginning of line *) rule coq_bol = parse | space* (nl+ as s) { new_lines (String.length s) lexbuf; if not (!in_proof <> None && (!prefs.gallina || !prefs.light)) then Output.empty_line_of_code (); coq_bol lexbuf } | space* "(**" (space_nl as s) { if is_nl s then new_lines 1 lexbuf; Output.end_coq (); Output.start_doc (); let eol = doc_bol lexbuf in Output.end_doc (); Output.start_coq (); if eol then coq_bol lexbuf else coq lexbuf } | space* "Comments" (space_nl as s) { if is_nl s then new_lines 1 lexbuf; Output.end_coq (); Output.start_doc (); comments lexbuf; Output.end_doc (); Output.start_coq (); coq lexbuf } | space* begin_hide nl { new_lines 1 lexbuf; skip_hide lexbuf; coq_bol lexbuf } | space* begin_show nl { new_lines 1 lexbuf; begin_show (); coq_bol lexbuf } | space* end_show nl { new_lines 1 lexbuf; end_show (); coq_bol lexbuf } | space* begin_details (* At this point, the comment remains open, and will be closed by [details_body] *) { let s = details_body lexbuf in Output.end_coq (); begin_details s; Output.start_coq (); coq_bol lexbuf } | space* end_details nl { new_lines 1 lexbuf; Output.end_coq (); end_details (); Output.start_coq (); coq_bol lexbuf } | space* (legacy_attr_kw space+)* gallina_kw_to_hide { let s = lexeme lexbuf in if !prefs.light && section_or_end s then let eol = skip_to_dot lexbuf in if eol then (coq_bol lexbuf) else coq lexbuf else begin output_indented_keyword s lexbuf; let eol = body lexbuf in if eol then coq_bol lexbuf else coq lexbuf end } | space* (legacy_attr_kw space+)* thm_token { let s = lexeme lexbuf in output_indented_keyword s lexbuf; let eol = body lexbuf in in_proof := Some eol; if eol then coq_bol lexbuf else coq lexbuf } | space* prf_token { in_proof := Some true; let eol = if not !prefs.gallina then begin backtrack lexbuf; body_bol lexbuf end else let s = lexeme lexbuf in if s.[String.length s - 1] = '.' then false else skip_to_dot lexbuf in if eol then coq_bol lexbuf else coq lexbuf } | space* end_kw { let eol = if not (only_gallina ()) then begin backtrack lexbuf; body_bol lexbuf end else skip_to_dot lexbuf in in_proof := None; if eol then coq_bol lexbuf else coq lexbuf } | space* (legacy_attr_kw space+)* gallina_kw { in_proof := None; let s = lexeme lexbuf in output_indented_keyword s lexbuf; let eol= body lexbuf in if eol then coq_bol lexbuf else coq lexbuf } | space* (legacy_attr_kw space+)* prog_kw { in_proof := None; let s = lexeme lexbuf in output_indented_keyword s lexbuf; let eol= body lexbuf in if eol then coq_bol lexbuf else coq lexbuf } | space* (legacy_attr_kw space+)* notation_kw { let s = lexeme lexbuf in output_indented_keyword s lexbuf; let eol= start_notation_string lexbuf in if eol then coq_bol lexbuf else coq lexbuf } | space* "(**" space+ "printing" space+ printing_token space+ { let tok = lexeme lexbuf in let s = printing_token_body lexbuf in add_printing_token tok s; coq_bol lexbuf } | space* "(**" space+ "printing" space+ { warn "bad 'printing' command" lexbuf; comment_level := 1; ignore (comment lexbuf); coq_bol lexbuf } | space* "(**" space+ "remove" space+ "printing" space+ printing_token space* "*)" { remove_printing_token (lexeme lexbuf); coq_bol lexbuf } | space* "(**" space+ "remove" space+ "printing" space+ { warn "bad 'remove printing' command" lexbuf; comment_level := 1; ignore (comment lexbuf); coq_bol lexbuf } | space* "(*" { comment_level := 1; let eol = if parse_comments () then begin let s = lexeme lexbuf in let nbsp, isp = count_spaces s in Output.indentation nbsp; Output.start_comment (); comment lexbuf end else skipped_comment lexbuf in if eol then coq_bol lexbuf else coq lexbuf } | space* "#[" { let eol = begin backtrack lexbuf; body_bol lexbuf end in if eol then coq_bol lexbuf else coq lexbuf } | eof { () } | _ { let eol = if not !prefs.gallina then begin backtrack lexbuf; body_bol lexbuf end else skip_to_dot_or_brace lexbuf in if eol then coq_bol lexbuf else coq lexbuf } (*s Scanning Coq elsewhere *) and coq = parse | nl { new_lines 1 lexbuf; if not (only_gallina ()) then Output.line_break(); coq_bol lexbuf } | "(**" (space_nl as s) { if is_nl s then new_lines 1 lexbuf; Output.end_coq (); Output.start_doc (); let eol = doc_bol lexbuf in Output.end_doc (); Output.start_coq (); if eol then coq_bol lexbuf else coq lexbuf } | "(*" { comment_level := 1; let eol = if parse_comments () then begin Output.start_comment (); comment lexbuf end else skipped_comment lexbuf in if eol then coq_bol lexbuf else coq lexbuf } | (nl+ as s) space* "]]" { new_lines (count_newlines s) lexbuf; if is_none !formatted then begin (* Isn't this an anomaly *) let s = lexeme lexbuf in let nlsp,s = remove_newline s in let nbsp,isp = count_spaces s in Output.indentation nbsp; let loc = lexeme_start lexbuf + isp + nlsp in Output.sublexer ']' loc; Output.sublexer ']' (loc+1); coq lexbuf end } | eof { () } | (legacy_attr_kw space+)* gallina_kw_to_hide { let s = lexeme lexbuf in if !prefs.light && section_or_end s then begin let eol = skip_to_dot lexbuf in if eol then coq_bol lexbuf else coq lexbuf end else begin Output.ident s None; let eol=body lexbuf in if eol then coq_bol lexbuf else coq lexbuf end } | prf_token { let eol = if not !prefs.gallina then begin backtrack lexbuf; body lexbuf end else let s = lexeme lexbuf in let eol = if s.[String.length s - 1] = '.' then false else skip_to_dot lexbuf in eol in if eol then coq_bol lexbuf else coq lexbuf } | end_kw { let eol = if not !prefs.gallina then begin backtrack lexbuf; body lexbuf end else let eol = skip_to_dot lexbuf in if !in_proof <> Some true && eol then Output.line_break (); eol in in_proof := None; if eol then coq_bol lexbuf else coq lexbuf } | (legacy_attr_kw space+)* gallina_kw { let s = lexeme lexbuf in Output.ident s None; let eol = body lexbuf in if eol then coq_bol lexbuf else coq lexbuf } | (legacy_attr_kw space+)* notation_kw { let s = lexeme lexbuf in Output.ident s None; let eol= start_notation_string lexbuf in if eol then coq_bol lexbuf else coq lexbuf } | (legacy_attr_kw space+)* prog_kw { let s = lexeme lexbuf in Output.ident s None; let eol = body lexbuf in if eol then coq_bol lexbuf else coq lexbuf } | "#[" { ignore(lexeme lexbuf); Output.char '#'; Output.char '['; let eol = body lexbuf in if eol then coq_bol lexbuf else coq lexbuf } | space+ { Output.char ' '; coq lexbuf } | eof { () } | _ { let eol = if not !prefs.gallina then begin backtrack lexbuf; body lexbuf end else skip_to_dot_or_brace lexbuf in if eol then coq_bol lexbuf else coq lexbuf} (*s Scanning documentation, at beginning of line *) and doc_bol = parse | space* section space+ ([^'\n' '\r' '*'] | '*'+ [^'\n' '\r' ')' '*'])* ('*'+ (nl as s))? { if not (is_none s) then new_lines 1 lexbuf; let eol, lex = strip_eol (lexeme lexbuf) in let lev, s = sec_title lex in if (!prefs.lib_subtitles) && (subtitle (Output.get_module false) s) then () else Output.section lev (fun () -> ignore (doc None (from_string s))); if eol then doc_bol lexbuf else doc None lexbuf } | ((space_nl* nl)? as s) (space* '-'+ as line) { let nl_count = count_newlines s in match check_start_list line with | Neither -> backtrack_past_newline lexbuf; new_lines 1 lexbuf; doc None lexbuf | List n -> new_lines nl_count lexbuf; if nl_count > 0 then Output.paragraph (); Output.item 1; doc (Some [n]) lexbuf | Rule -> new_lines nl_count lexbuf; Output.rule (); doc None lexbuf } | (space_nl* nl) as s { new_lines (count_newlines s) lexbuf; Output.paragraph (); doc_bol lexbuf } | "<<" space* nl { new_lines 1 lexbuf; Output.start_verbatim false; verbatim_block lexbuf; doc_bol lexbuf } | "<<" { Output.start_verbatim true; verbatim_inline lexbuf; doc None lexbuf } | eof { true } | '_' { if !prefs.plain_comments then Output.char '_' else start_emph (); doc None lexbuf } | "" { doc None lexbuf } (*s Scanning lists - using whitespace *) and doc_list_bol indents = parse | space* '-' { let (n_spaces,_) = count_spaces (lexeme lexbuf) in match find_level indents n_spaces with | Before -> backtrack lexbuf; doc_bol lexbuf | StartLevel n -> Output.item n; doc (Some (take n indents)) lexbuf | InLevel (n,true) -> let items = List.length indents in Output.item (items+1); doc (Some (List.append indents [n_spaces])) lexbuf | InLevel (_,false) -> backtrack lexbuf; doc_bol lexbuf } | "<<" space* nl { new_lines 1 lexbuf; Output.start_verbatim false; verbatim_block lexbuf; doc_list_bol indents lexbuf } | "<<" space* { Output.start_verbatim true; verbatim_inline lexbuf; doc (Some indents) lexbuf } | "[[" nl { new_lines 1 lexbuf; formatted := Some lexbuf.lex_start_p; Output.start_inline_coq_block (); ignore(body_bol lexbuf); Output.end_inline_coq_block (); formatted := None; doc_list_bol indents lexbuf } | "[[[" nl { new_lines 1 lexbuf; inf_rules (Some indents) lexbuf } | space* nl space* '-' { (* Like in the doc_bol production, these two productions exist only to deal properly with whitespace *) new_lines 1 lexbuf; Output.paragraph (); backtrack_past_newline lexbuf; doc_list_bol indents lexbuf } | space* nl space* _ { new_lines 1 lexbuf; let buf' = lexeme lexbuf in let buf = let bufs = Str.split_delim (Str.regexp "['\n']") buf' in match bufs with | (_ :: s :: []) -> s | (_ :: _ :: s :: _) -> s | _ -> eprintf "Internal error bad_split2 - please report\n"; exit 1 in let (n_spaces,_) = count_spaces buf in match find_level indents n_spaces with | StartLevel 1 | Before -> (* Here we were at the beginning of a line, and it was blank. The next line started before any list items. So: insert a paragraph for the empty line, rewind to whatever's just after the newline, then toss over to doc_bol for whatever comes next. *) Output.stop_item (); Output.paragraph (); backtrack_past_newline lexbuf; doc_bol lexbuf | StartLevel _ | InLevel _ -> Output.paragraph (); backtrack_past_newline lexbuf; doc_list_bol indents lexbuf } | space* _ { let (n_spaces,_) = count_spaces (lexeme lexbuf) in match find_level indents n_spaces with | Before -> Output.stop_item (); backtrack lexbuf; doc_bol lexbuf | StartLevel n -> Output.reach_item_level (n-1); backtrack lexbuf; doc (Some (take (n-1) indents)) lexbuf | InLevel (n,_) -> Output.reach_item_level n; backtrack lexbuf; doc (Some (take n indents)) lexbuf } (*s Scanning documentation elsewhere *) and doc indents = parse | nl { new_lines 1 lexbuf; Output.char '\n'; match indents with | Some ls -> doc_list_bol ls lexbuf | None -> doc_bol lexbuf } | "[[" nl { new_lines 1 lexbuf; if !prefs.plain_comments then (Output.char '['; Output.char '['; doc indents lexbuf) else (formatted := Some lexbuf.lex_start_p; Output.start_inline_coq_block (); let eol = body_bol lexbuf in Output.end_inline_coq_block (); formatted := None; if eol then match indents with | Some ls -> doc_list_bol ls lexbuf | None -> doc_bol lexbuf else doc indents lexbuf)} | "[[[" nl { new_lines 1 lexbuf; inf_rules indents lexbuf } | "[]" { Output.proofbox (); doc indents lexbuf } | "{{" { url lexbuf; doc indents lexbuf } | "[" { if !prefs.plain_comments then Output.char '[' else (brackets := 1; Output.start_inline_coq (); escaped_coq lexbuf; Output.end_inline_coq ()); doc indents lexbuf } | "(*" { backtrack lexbuf ; let bol_parse = match indents with | Some is -> doc_list_bol is | None -> doc_bol in let eol = if !prefs.parse_comments then comment lexbuf else skipped_comment lexbuf in if eol then bol_parse lexbuf else doc indents lexbuf } | '*'* "*)" (space_nl* as s) "(**" { let nl_count = count_newlines s in new_lines nl_count lexbuf; (match indents with | Some _ -> Output.stop_item () | None -> ()); (* this says - if there is a blank line between the two comments, insert one in the output too *) if nl_count > 1 then Output.paragraph (); doc_bol lexbuf } | '*'* "*)" space* nl { new_lines 1 lexbuf; Output.char '\n'; true } | '*'* "*)" { false } | "$" { if !prefs.plain_comments then Output.char '$' else (Output.start_latex_math (); escaped_math_latex lexbuf); doc indents lexbuf } | "$$" { if !prefs.plain_comments then Output.char '$'; Output.char '$'; doc indents lexbuf } | "%" { if !prefs.plain_comments then Output.char '%' else escaped_latex lexbuf; doc indents lexbuf } | "%%" { if !prefs.plain_comments then Output.char '%'; Output.char '%'; doc indents lexbuf } | "#" { if !prefs.plain_comments then Output.char '#' else escaped_html lexbuf; doc indents lexbuf } | "##" { if !prefs.plain_comments then Output.char '#'; Output.char '#'; doc indents lexbuf } | nonidentchar '_' nonidentchar { List.iter (fun x -> Output.char (lexeme_char lexbuf x)) [0;1;2]; doc indents lexbuf} | nonidentchar '_' { Output.char (lexeme_char lexbuf 0); if !prefs.plain_comments then Output.char '_' else start_emph () ; doc indents lexbuf } | '_' nonidentchar { if !prefs.plain_comments then Output.char '_' else stop_emph () ; Output.char (lexeme_char lexbuf 1); doc indents lexbuf } | "<<" space* { Output.start_verbatim true; verbatim_inline lexbuf; doc indents lexbuf } | '"' { if !prefs.plain_comments then Output.char '"' else if in_quote () then stop_quote () else start_quote (); doc indents lexbuf } | eof { false } | _ { Output.char (lexeme_char lexbuf 0); doc indents lexbuf } (*s Various escapings *) and escaped_math_latex = parse | "$" { Output.stop_latex_math () } | eof { Output.stop_latex_math () } | "*)" { Output.stop_latex_math (); backtrack lexbuf } | _ { Output.latex_char (lexeme_char lexbuf 0); escaped_math_latex lexbuf } and escaped_latex = parse | "%" { () } | eof { () } | "*)" { backtrack lexbuf } | _ { Output.latex_char (lexeme_char lexbuf 0); escaped_latex lexbuf } and escaped_html = parse | "#" { () } | "&#" { Output.html_char '&'; Output.html_char '#'; escaped_html lexbuf } | "##" { Output.html_char '#'; escaped_html lexbuf } | eof { () } | "*)" { backtrack lexbuf } | _ { Output.html_char (lexeme_char lexbuf 0); escaped_html lexbuf } and verbatim_block = parse | nl ">>" space* nl { new_lines 2 lexbuf; Output.verbatim_char false '\n'; Output.stop_verbatim false } | nl ">>" { new_lines 1 lexbuf; warn "missing newline after \">>\" block" lexbuf; Output.verbatim_char false '\n'; Output.stop_verbatim false } | eof { warn "unterminated \">>\" block" lexbuf; Output.stop_verbatim false } | nl { new_lines 1 lexbuf; Output.verbatim_char false (lexeme_char lexbuf 0); verbatim_block lexbuf } | _ { Output.verbatim_char false (lexeme_char lexbuf 0); verbatim_block lexbuf } and verbatim_inline = parse | nl { new_lines 1 lexbuf; warn "unterminated inline \">>\"" lexbuf; Output.char '\n'; Output.stop_verbatim true } | ">>" { Output.stop_verbatim true } | eof { warn "unterminated inline \">>\"" lexbuf; Output.stop_verbatim true } | _ { Output.verbatim_char true (lexeme_char lexbuf 0); verbatim_inline lexbuf } and url = parse | "}}" { Output.url (Buffer.contents url_buffer) None; Buffer.clear url_buffer } | "}" { url_name lexbuf } | _ { Buffer.add_char url_buffer (lexeme_char lexbuf 0); url lexbuf } and url_name = parse | "}" { Output.url (Buffer.contents url_buffer) (Some (Buffer.contents url_name_buffer)); Buffer.clear url_buffer; Buffer.clear url_name_buffer } | _ { Buffer.add_char url_name_buffer (lexeme_char lexbuf 0); url_name lexbuf } (*s Coq, inside quotations *) and escaped_coq = parse | "]" { decr brackets; if !brackets > 0 then (Output.sublexer_in_doc ']'; escaped_coq lexbuf) else Tokens.flush_sublexer () } | "[" { incr brackets; Output.sublexer_in_doc '['; escaped_coq lexbuf } | "(*" { Tokens.flush_sublexer (); comment_level := 1; ignore (if !prefs.parse_comments then comment lexbuf else skipped_comment lexbuf); escaped_coq lexbuf } | "*)" { (* likely to be a syntax error *) warn "unterminated \"]\"" lexbuf; backtrack lexbuf } | eof { Tokens.flush_sublexer () } | identifier { Tokens.flush_sublexer(); Output.ident (lexeme lexbuf) None; escaped_coq lexbuf } | space_nl* { let str = lexeme lexbuf in Tokens.flush_sublexer(); (if !prefs.inline_notmono then () else Output.end_inline_coq ()); String.iter Output.char str; (if !prefs.inline_notmono then () else Output.start_inline_coq ()); escaped_coq lexbuf } | _ { Output.sublexer_in_doc (lexeme_char lexbuf 0); escaped_coq lexbuf } (*s Coq "Comments" command. *) and comments = parse | space_nl+ { Output.char ' '; comments lexbuf } | '"' [^ '"']* '"' { let s = lexeme lexbuf in let s = String.sub s 1 (String.length s - 2) in ignore (doc None (from_string s)); comments lexbuf } | ([^ '.' '"'] | '.' [^ ' ' '\t' '\n'])+ { escaped_coq (from_string (lexeme lexbuf)); comments lexbuf } | "." (space_nl | eof) { () } | eof { () } | _ { Output.char (lexeme_char lexbuf 0); comments lexbuf } and skipped_comment = parse | "(*" { incr comment_level; skipped_comment lexbuf } | "*)" space* nl { new_lines 1 lexbuf; decr comment_level; if !comment_level > 0 then skipped_comment lexbuf else true } | "*)" { decr comment_level; if !comment_level > 0 then skipped_comment lexbuf else false } | eof { false } | _ { skipped_comment lexbuf } and comment = parse | "(*" { incr comment_level; Output.start_comment (); comment lexbuf } | "*)" space* nl { new_lines 1 lexbuf; Output.end_comment (); Output.line_break (); decr comment_level; if !comment_level > 0 then comment lexbuf else true } | "*)" { Output.end_comment (); decr comment_level; if !comment_level > 0 then comment lexbuf else false } | "[" { if !prefs.plain_comments then Output.char '[' else (brackets := 1; Output.start_inline_coq (); escaped_coq lexbuf; Output.end_inline_coq ()); comment lexbuf } | "[[" nl { new_lines 1 lexbuf; if !prefs.plain_comments then (Output.char '['; Output.char '[') else (formatted := Some lexbuf.lex_start_p; Output.start_inline_coq_block (); let _ = body_bol lexbuf in Output.end_inline_coq_block (); formatted := None); comment lexbuf } | "$" { if !prefs.plain_comments then Output.char '$' else (Output.start_latex_math (); escaped_math_latex lexbuf); comment lexbuf } | "$$" { if !prefs.plain_comments then Output.char '$'; Output.char '$'; comment lexbuf } | "%" { if !prefs.plain_comments then Output.char '%' else escaped_latex lexbuf; comment lexbuf } | "%%" { if !prefs.plain_comments then Output.char '%'; Output.char '%'; comment lexbuf } | "#" { if !prefs.plain_comments then Output.char '#' else escaped_html lexbuf; comment lexbuf } | "##" { if !prefs.plain_comments then Output.char '#'; Output.char '#'; comment lexbuf } | eof { false } | space+ { Output.indentation (fst (count_spaces (lexeme lexbuf))); comment lexbuf } | nl { new_lines 1 lexbuf; Output.line_break (); comment lexbuf } | _ { Output.char (lexeme_char lexbuf 0); comment lexbuf } and skip_to_dot = parse | '.' space* nl { new_lines 1 lexbuf; true } | eof | '.' space+ { false } | "(*" { comment_level := 1; ignore (skipped_comment lexbuf); skip_to_dot lexbuf } | _ { skip_to_dot lexbuf } and skip_to_dot_or_brace = parse | '.' space* nl { new_lines 1 lexbuf; true } | eof | '.' space+ { false } | "(*" { comment_level := 1; ignore (skipped_comment lexbuf); skip_to_dot_or_brace lexbuf } | "}" space* nl { new_lines 1 lexbuf; true } | "}" { false } | space* { skip_to_dot_or_brace lexbuf } | _ { skip_to_dot lexbuf } and body_bol = parse | space+ { Output.indentation (fst (count_spaces (lexeme lexbuf))); body lexbuf } | "" { Output.indentation 0; body lexbuf } and body = parse | nl { Tokens.flush_sublexer(); Output.line_break(); new_lines 1 lexbuf; body_bol lexbuf} | (nl+ as s) space* "]]" space* nl { new_lines (count_newlines s + 1) lexbuf; Tokens.flush_sublexer(); if is_none !formatted then begin let s = lexeme lexbuf in let nlsp,s = remove_newline s in let _,isp = count_spaces s in let loc = lexeme_start lexbuf + nlsp + isp in Output.sublexer ']' loc; Output.sublexer ']' (loc+1); Tokens.flush_sublexer(); body lexbuf end else begin Output.paragraph (); true end } | "]]" space* nl { Tokens.flush_sublexer(); new_lines 1 lexbuf; if is_none !formatted then begin let loc = lexeme_start lexbuf in Output.sublexer ']' loc; Output.sublexer ']' (loc+1); Tokens.flush_sublexer(); Output.line_break(); body lexbuf end else begin Output.paragraph (); true end } | eof { Tokens.flush_sublexer(); match !formatted with | None -> false | Some p -> raise (MismatchPreformatted p) } | '.' space* (nl as s | eof) { if not (is_none s) then new_line lexbuf; Tokens.flush_sublexer(); Output.char '.'; Output.line_break(); if is_none !formatted then true else body_bol lexbuf } | '.' space* nl "]]" space* nl { new_lines 2 lexbuf; Tokens.flush_sublexer(); Output.char '.'; if is_none !formatted then begin eprintf "Error: stray ]] at %d\n" (lexeme_start lexbuf); flush stderr; exit 1 end else begin Output.paragraph (); true end } | '.' space+ { Tokens.flush_sublexer(); Output.char '.'; Output.char ' '; if is_none !formatted then false else body lexbuf } | "(**" (space_nl as s) { if is_nl s then new_line lexbuf; Tokens.flush_sublexer(); Output.end_coq (); Output.start_doc (); let eol = doc_bol lexbuf in Output.end_doc (); Output.start_coq (); if eol then body_bol lexbuf else body lexbuf } | "(*" { Tokens.flush_sublexer(); comment_level := 1; let eol = if parse_comments () then begin Output.start_comment (); comment lexbuf end else begin let eol = skipped_comment lexbuf in if eol then Output.line_break(); eol end in if eol then body_bol lexbuf else body lexbuf } | "where" { Tokens.flush_sublexer(); Output.ident (lexeme lexbuf) None; start_notation_string lexbuf } | identifier { Tokens.flush_sublexer(); Output.ident (lexeme lexbuf) (Some (lexeme_start lexbuf)); body lexbuf } | ".." { Tokens.flush_sublexer(); Output.char '.'; Output.char '.'; body lexbuf } | '"' { Tokens.flush_sublexer(); Output.char '"'; string lexbuf; body lexbuf } | space { Tokens.flush_sublexer(); Output.char (lexeme_char lexbuf 0); body lexbuf } | _ { let c = lexeme_char lexbuf 0 in Output.sublexer c (lexeme_start lexbuf); body lexbuf } and start_notation_string = parse | space { Tokens.flush_sublexer(); Output.char (lexeme_char lexbuf 0); start_notation_string lexbuf } | '"' (* a true notation *) { Output.sublexer '"' (lexeme_start lexbuf); notation_string lexbuf; body lexbuf } | _ (* an abbreviation *) { backtrack lexbuf; body lexbuf } and notation_string = parse | "\"\"" { Output.char '"'; Output.char '"'; (* Unlikely! *) notation_string lexbuf } | '"' { Tokens.flush_sublexer(); Output.char '"' } | _ { let c = lexeme_char lexbuf 0 in Output.sublexer c (lexeme_start lexbuf); notation_string lexbuf } and string = parse | "\"\"" { Output.char '"'; Output.char '"'; string lexbuf } | '"' { Output.char '"' } | _ { let c = lexeme_char lexbuf 0 in Output.char c; string lexbuf } and skip_hide = parse | eof | end_hide nl { new_lines 1 lexbuf; () } | _ { skip_hide lexbuf } (*s Reading token pretty-print *) and printing_token_body = parse | "*)" (nl as s)? | eof { if not (is_none s) then new_lines 1 lexbuf; let s = Buffer.contents token_buffer in Buffer.clear token_buffer; s } | (nl | _) as s { if is_nl s then new_lines 1 lexbuf; Buffer.add_string token_buffer (lexeme lexbuf); printing_token_body lexbuf } and details_body = parse | "*)" space* (nl as s)? | eof { if not (is_none s) then new_lines 1 lexbuf; None } | ":" space* { details_body_rec lexbuf } and details_body_rec = parse | "*)" space* (nl as s)? | eof { if not (is_none s) then new_lines 1 lexbuf; let s = Buffer.contents token_buffer in Buffer.clear token_buffer; Some s } | _ { Buffer.add_string token_buffer (lexeme lexbuf); details_body_rec lexbuf } (*s These handle inference rules, parsing the body segments of things enclosed in [[[ ]]] brackets *) and inf_rules indents = parse | space* nl (* blank line, before or between definitions *) { new_lines 1 lexbuf; inf_rules indents lexbuf } | "]]]" nl (* end of the inference rules block *) { new_lines 1 lexbuf; match indents with | Some ls -> doc_list_bol ls lexbuf | None -> doc_bol lexbuf } | _ { backtrack lexbuf; (* anything else must be the first line in a rule *) inf_rules_assumptions indents [] lexbuf} (* The inference rule parsing just collects the inference rule and then calls the output function once, instead of doing things incrementally like the rest of the lexer. If only there were a real parsing phase... *) and inf_rules_assumptions indents assumptions = parse | space* "---" '-'* [^ '\n']* nl (* hit the horizontal line *) { new_lines 1 lexbuf; let line = lexeme lexbuf in let (spaces,_) = count_spaces line in let dashes_and_name = cut_head_tail_spaces (String.sub line 0 (String.length line - 1)) in let ldn = String.length dashes_and_name in let (dashes,name) = try (let i = String.index dashes_and_name ' ' in let d = String.sub dashes_and_name 0 i in let n = cut_head_tail_spaces (String.sub dashes_and_name (i+1) (ldn-i-1)) in (d, Some n)) with _ -> (dashes_and_name, None) in inf_rules_conclusion indents (List.rev assumptions) (spaces, dashes, name) [] lexbuf } | [^ '\n']* nl (* if it's not the horizontal line, it's an assumption *) { new_lines 1 lexbuf; let line = lexeme lexbuf in let (spaces,_) = count_spaces line in let assumption = cut_head_tail_spaces (String.sub line 0 (String.length line - 1)) in inf_rules_assumptions indents ((spaces,assumption)::assumptions) lexbuf } (*s The conclusion is required to come immediately after the horizontal bar. It is allowed to contain multiple lines of text, like the assumptions. The conclusion ends when we spot a blank line or a ']]]'. *) and inf_rules_conclusion indents assumptions middle conclusions = parse | space* nl | space* "]]]" nl (* end of conclusions. *) { new_lines 2 lexbuf; backtrack lexbuf; Output.inf_rule assumptions middle (List.rev conclusions); inf_rules indents lexbuf } | space* [^ '\n']+ nl (* this is a line in the conclusion *) { new_lines 1 lexbuf; let line = lexeme lexbuf in let (spaces,_) = count_spaces line in let conc = cut_head_tail_spaces (String.sub line 0 (String.length line - 1)) in inf_rules_conclusion indents assumptions middle ((spaces,conc) :: conclusions) lexbuf } (*s A small scanner to support the chapter subtitle feature *) and st_start m = parse | "(*" "*"+ space+ "*" space+ { st_modname m lexbuf } | _ { None } and st_modname m = parse | identifier space* ":" space* { if subtitle m (lexeme lexbuf) then st_subtitle lexbuf else None } | _ { None } and st_subtitle = parse | [^ '\n']* '\n' { let st = lexeme lexbuf in let i = try Str.search_forward (Str.regexp "\\**)") st 0 with Not_found -> (eprintf "unterminated comment at beginning of file\n"; exit 1) in Some (cut_head_tail_spaces (String.sub st 0 i)) } | _ { None } (*s Applying the scanners to files *) { (* coq_bol with error handling *) let coq_bol' f lb = try coq_bol lb with | MismatchPreformatted p -> Printf.eprintf "%a: mismatched \"[[\"\n" print_position_p p; exit 1 let coq_file f m = reset (); let c = open_in f in let lb = from_channel c in let lb = { lb with lex_curr_p = { lb.lex_curr_p with pos_fname = f }; lex_start_p = { lb.lex_start_p with pos_fname = f } } in (Index.current_library := m; Output.initialize (); Output.start_module (); Output.start_coq (); coq_bol' f lb; Output.end_coq (); close_in c) let detect_subtitle f m = let c = open_in f in let lb = from_channel c in let sub = st_start m lb in close_in c; sub } coq-8.20.0/tools/coqdoc/dune000066400000000000000000000006551466560755400157010ustar00rootroot00000000000000(install (section lib) (package coq-core) (files (coqdoc.css as tools/coqdoc/coqdoc.css) (coqdoc.sty as tools/coqdoc/coqdoc.sty))) ; File needs to be here too. (install (section share_root) (package coq-core) (files (coqdoc.sty as texmf/tex/latex/misc/coqdoc.sty))) (executable (name main) (public_name coqdoc) (package coq-core) (libraries str coq-core.boot coq-core.config coq-core.clib)) (ocamllex cpretty) coq-8.20.0/tools/coqdoc/fileUtil.ml000066400000000000000000000035141466560755400171270ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* close_out cout; close_in cin with Sys_error e -> Printf.eprintf "%s\n" e; exit 1 let check_if_file_exists f = if not (Sys.file_exists f) then begin Printf.eprintf "coqdoc: %s: no such file\n" f; exit 1 end (* [files_from_file f] returns the list of file names contained in the file named [f]. These file names must be separated by spaces, tabulations or newlines. *) let files_from_file f = let files_from_channel ch = let buf = Buffer.create 80 in let l = ref [] in try while true do match input_char ch with | ' ' | '\t' | '\n' -> if Buffer.length buf > 0 then l := Buffer.contents buf :: !l; Buffer.clear buf | c -> Buffer.add_char buf c done; [] with End_of_file -> List.rev !l in try check_if_file_exists f; let ch = open_in f in let l = files_from_channel ch in close_in ch; l with Sys_error s -> Printf.eprintf "coqdoc: cannot read from file %s (%s)\n" f s; exit 1 coq-8.20.0/tools/coqdoc/fileUtil.mli000066400000000000000000000020031466560755400172700ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* string -> unit (** [files_from_file f] returns the list of file names contained in the file named [f]. These file names must be separated by spaces, tabulations or newlines. *) val files_from_file : string -> string list (** Version of [Sys.file_exists] but will exit on error *) val check_if_file_exists : string -> unit coq-8.20.0/tools/coqdoc/glob_file.ml000066400000000000000000000072051466560755400172750ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* Definition | "prf" | "thm" -> Lemma | "ind" | "variant" | "coind" -> Inductive | "constr" -> Constructor | "indrec" | "rec" | "corec" -> Record | "proj" -> Projection | "class" -> Class | "meth" -> Method | "inst" -> Instance | "var" -> Variable | "defax" | "prfax" | "ax" -> Axiom | "abbrev" | "syndef" -> Abbreviation | "not" -> Notation | "lib" -> Library | "mod" | "modtype" -> Module | "tac" -> TacticDefinition | "sec" -> Section | "binder" -> Binder | s -> invalid_arg ("type_of_string:" ^ s) let ill_formed_glob_file f = eprintf "Warning: ill-formed file %s (links will not be available)\n" f let outdated_glob_file f = eprintf "Warning: %s not consistent with corresponding .v file (links will not be \ available)\n" f let correct_file vfile f c = let s = input_line c in if String.length s < 7 || String.sub s 0 7 <> "DIGEST " then ( ill_formed_glob_file f; false ) else let s = String.sub s 7 (String.length s - 7) in match (vfile, s) with | None, "NO" -> true | Some _, "NO" -> ill_formed_glob_file f; false | None, _ -> ill_formed_glob_file f; false | Some vfile, s -> s = Digest.to_hex (Digest.file vfile) || (outdated_glob_file f; false) let read_glob vfile f = let c = open_in f in if correct_file vfile f c then let cur_mod = ref "" in try while true do let s = input_line c in let n = String.length s in if n > 0 then match s.[0] with | 'F' -> cur_mod := String.sub s 1 (n - 1); current_library := !cur_mod | 'R' -> ( try Scanf.sscanf s "R%d:%d %s %s %s %s" (fun loc1 loc2 lib_dp sp id ty -> for loc = loc1 to loc2 do add_ref !cur_mod loc lib_dp sp id (type_of_string ty); (* Also add an entry for each module mentioned in [lib_dp], * to use in interpolation. *) ignore (List.fold_right (fun thisPiece priorPieces -> let newPieces = match priorPieces with | "" -> thisPiece | _ -> thisPiece ^ "." ^ priorPieces in add_ref !cur_mod loc "" "" newPieces Library; newPieces) (Str.split (Str.regexp_string ".") lib_dp) "") done) with _ -> () ) | _ -> ( try Scanf.sscanf s "%s %d:%d %s %s" (fun ty loc1 loc2 sp id -> add_def loc1 loc2 (type_of_string ty) sp id) with Scanf.Scan_failure _ -> () ) done; assert false with End_of_file -> close_in c coq-8.20.0/tools/coqdoc/glob_file.mli000066400000000000000000000015041466560755400174420ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* string -> unit coq-8.20.0/tools/coqdoc/index.ml000066400000000000000000000207441466560755400164650ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* "<>" then if id <> "<>" then sp ^ "." ^ id else sp else if id <> "<>" then id else "" let hashtbl_append_def t k v = try match Hashtbl.find t k with | Def l -> Hashtbl.replace t k (Def (l @ [v])) | Ref _ -> Hashtbl.add t k (Def [v]) with Not_found -> Hashtbl.add t k (Def [v]) let add_def loc1 loc2 ty sp id = let fullid = full_ident sp id in let def = (fullid, ty) in for loc = loc1 to loc2 do hashtbl_append_def reftable (!current_library, loc) def done; Hashtbl.add deftable !current_library (fullid, ty); Hashtbl.add byidtable id (!current_library, fullid, ty) let add_ref m loc m' sp id ty = let fullid = full_ident sp id in if Hashtbl.mem reftable (m, loc) then () else Hashtbl.add reftable (m, loc) (Ref (m', fullid, ty)); let idx = if id = "<>" then m' else id in if Hashtbl.mem byidtable idx then () else Hashtbl.add byidtable idx (m', fullid, ty) let find m l = Hashtbl.find reftable (m, l) let find_string s = let (m,s,t) = Hashtbl.find byidtable s in Ref (m,s,t) (* Coq modules *) let split_sp s = try let i = String.rindex s '.' in String.sub s 0 i, String.sub s (i + 1) (String.length s - i - 1) with Not_found -> "", s let modules = Hashtbl.create 97 let local_modules = Hashtbl.create 97 let add_module m = let _,id = split_sp m in Hashtbl.add modules id m; Hashtbl.add local_modules m () type module_kind = Local | External of string | Unknown let external_libraries = ref [] let add_external_library logicalpath url = external_libraries := (logicalpath,url) :: !external_libraries let find_external_library logicalpath = let rec aux = function | [] -> raise Not_found | (l,u)::rest -> if String.length logicalpath > String.length l && String.sub logicalpath 0 (String.length l + 1) = l ^"." then u else aux rest in aux !external_libraries let init_coqlib_library () = add_external_library "Coq" !prefs.coqlib_url let find_module m = if Hashtbl.mem local_modules m then Local else try External (find_external_library m ^ "/" ^ m) with Not_found -> Unknown (* Building indexes *) type 'a index = { idx_name : string; idx_entries : (char * (string * 'a) list) list; idx_size : int } let map f i = { i with idx_entries = List.map (fun (c,l) -> (c, List.map (fun (s,x) -> (s,f s x)) l)) i.idx_entries } let compare_entries (s1,_) (s2,_) = Alpha.compare_string s1 s2 let sort_entries el = let t = Hashtbl.create 97 in List.iter (fun c -> Hashtbl.add t c []) ['A'; 'B'; 'C'; 'D'; 'E'; 'F'; 'G'; 'H'; 'I'; 'J'; 'K'; 'L'; 'M'; 'N'; 'O'; 'P'; 'Q'; 'R'; 'S'; 'T'; 'U'; 'V'; 'W'; 'X'; 'Y'; 'Z'; '_'; '*']; List.iter (fun ((s,_) as e) -> let c = Alpha.norm_char s.[0] in let c,l = try c,Hashtbl.find t c with Not_found -> '*',Hashtbl.find t '*' in Hashtbl.replace t c (e :: l)) el; let res = ref [] in Hashtbl.iter (fun c l -> res := (c, List.sort compare_entries l) :: !res) t; List.sort (fun (c1,_) (c2,_) -> Alpha.compare_char c1 c2) !res let display_letter c = if c = '*' then "other" else String.make 1 c let type_name = function | Library -> let ln = !prefs.lib_name in if ln <> "" then String.lowercase_ascii ln else "library" | Module -> "module" | Definition -> "definition" | Inductive -> "inductive" | Constructor -> "constructor" | Lemma -> "lemma" | Record -> "record" | Projection -> "projection" | Instance -> "instance" | Class -> "class" | Method -> "method" | Variable -> "variable" | Axiom -> "axiom" | TacticDefinition -> "tactic" | Abbreviation -> "abbreviation" | Notation -> "notation" | Section -> "section" | Binder -> "binder" let prepare_entry s = function | Notation -> (* We decode the encoding done in Dumpglob.cook_notation of coqtop *) (* Encoded notations have the form section:entry:sc:x_'++'_x *) (* where: *) (* - the section, if any, ends with a "." *) (* - the scope can be empty *) (* - tokens are separated with "_" *) (* - non-terminal symbols are conventionally represented by "x" *) (* - terminals are enclosed within simple quotes *) (* - existing simple quotes (that necessarily are parts of *) (* terminals) are doubled *) (* (as a consequence, when a terminal contains "_" or "x", these *) (* necessarily appear enclosed within non-doubled simple quotes) *) (* - non-printable characters < 32 are left encoded so that they *) (* are human-readable in index files *) (* Example: "x ' %x _% y %'x %'_' z" is encoded as *) (* "x_''''_'%x'_'_%'_x_'%''x'_'%''_'''_x" *) let err () = eprintf "Invalid notation in globalization file\n"; exit 1 in let h = try String.index_from s 0 ':' with _ -> err () in let i = try String.index_from s (h+1) ':' with _ -> err () in let m = try String.index_from s (i+1) ':' with _ -> err () in let entry = String.sub s (h+1) (i-h-1) in let sc = String.sub s (i+1) (m-i-1) in let ntn = Bytes.make (String.length s - m) ' ' in let k = ref 0 in let j = ref (m+1) in let quoted = ref false in let l = String.length s - 1 in while !j <= l do if not !quoted then begin (match s.[!j] with | '_' -> Bytes.set ntn !k ' '; incr k | 'x' -> Bytes.set ntn !k '_'; incr k | '\'' -> quoted := true | _ -> assert false) end else if s.[!j] = '\'' then if (!j = l || s.[!j+1] = '_') then quoted := false else (incr j; Bytes.set ntn !k s.[!j]; incr k) else begin Bytes.set ntn !k s.[!j]; incr k end; incr j done; let ntn = Bytes.sub_string ntn 0 !k in let ntn = if sc = "" then ntn else ntn ^ " (" ^ sc ^ ")" in if entry = "" then ntn else entry ^ ":" ^ ntn | _ -> s let include_entry = function | Binder -> !prefs.binder_index | _ -> true let all_entries () = let gl = ref [] in let add_g s m t = gl := (s,(m,t)) :: !gl in let bt = Hashtbl.create 11 in let add_bt t s m = let l = try Hashtbl.find bt t with Not_found -> [] in Hashtbl.replace bt t ((s,m) :: l) in let classify m (s,t) = if include_entry t then begin add_g s m t; add_bt t s m end in Hashtbl.iter classify deftable; Hashtbl.iter (fun id m -> add_g id m Library; add_bt Library id m) modules; { idx_name = "global"; idx_entries = sort_entries !gl; idx_size = List.length !gl }, Hashtbl.fold (fun t e l -> (t, { idx_name = type_name t; idx_entries = sort_entries e; idx_size = List.length e }) :: l) bt [] coq-8.20.0/tools/coqdoc/index.mli000066400000000000000000000043261466560755400166340ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* string type index_entry = | Def of (string * entry_type) list | Ref of coq_module * string * entry_type (* Find what symbol coqtop said is located at loc in the source file *) val find : coq_module -> loc -> index_entry (* Find what data is referred to by some string in some coq module *) val find_string : string -> index_entry (** [add_ref cur_mod loc lib_dp sp id entry_type] *) val add_ref : string -> int -> coq_module -> coq_module -> string -> entry_type -> unit (** [add_def loc1 loc2 entry_type sp id] *) val add_def : int -> int -> entry_type -> coq_module -> string -> unit (* Add a Coq module *) val add_module : coq_module -> unit type module_kind = Local | External of coq_module | Unknown val find_module : coq_module -> module_kind val init_coqlib_library : unit -> unit val add_external_library : string -> coq_module -> unit (*s Indexes *) type 'a index = { idx_name : string; idx_entries : (char * (string * 'a) list) list; idx_size : int } val current_library : string ref val display_letter : char -> string val prepare_entry : string -> entry_type -> string val all_entries : unit -> (coq_module * entry_type) index * (entry_type * coq_module index) list val map : (string -> 'a -> 'b) -> 'a index -> 'b index coq-8.20.0/tools/coqdoc/latexCompiler.ml000066400000000000000000000061041466560755400201600ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* Sys.chdir cwd; raise e let clean_temp_files basefile = let remove f = try Sys.remove f with _ -> () in remove (basefile ^ ".tex"); remove (basefile ^ ".log"); remove (basefile ^ ".aux"); remove (basefile ^ ".toc"); remove (basefile ^ ".dvi"); remove (basefile ^ ".ps"); remove (basefile ^ ".pdf"); remove (basefile ^ ".haux"); remove (basefile ^ ".html") let clean_and_exit file res = clean_temp_files file; exit res let cat file = let c = open_in file in try while true do print_char (input_char c) done with End_of_file -> close_in c let compile ~otypes ~produce_document fl = let texfile = Filename.temp_file "coqdoc" ".tex" in let basefile = Filename.chop_suffix texfile ".tex" in let final_out_to = !prefs.out_to in prefs := { !prefs with out_to = File texfile }; prefs := { !prefs with output_dir = Filename.dirname texfile }; produce_document fl; let latexexe = if List.mem Pdf otypes then "pdflatex" else "latex" in let latexcmd = let file = Filename.basename texfile in let file = if !prefs.quiet then sprintf "'\\nonstopmode\\input{%s}'" file else file in sprintf "%s %s && %s %s 1>&2 %s" latexexe file latexexe file (if !prefs.quiet then "> /dev/null" else "") in let res = locally (Filename.dirname texfile) Sys.command latexcmd in if res <> 0 then begin eprintf "Couldn't run LaTeX successfully\n"; clean_and_exit basefile res end; let dvifile = basefile ^ ".dvi" in ( if List.mem Dvi otypes then match final_out_to with | MultFiles | StdOut -> cat dvifile | File f -> FileUtil.copy dvifile f ); let pdffile = basefile ^ ".pdf" in ( if List.mem Pdf otypes then match final_out_to with | MultFiles | StdOut -> cat pdffile | File f -> FileUtil.copy pdffile f ); if List.mem Ps otypes then begin let psfile = basefile ^ ".ps" in let command = sprintf "dvips %s -o %s %s" dvifile psfile (if !prefs.quiet then "> /dev/null 2>&1" else "") in let res = Sys.command command in if res <> 0 then begin eprintf "Couldn't run dvips successfully\n"; clean_and_exit basefile res end; match final_out_to with | MultFiles | StdOut -> cat psfile | File f -> FileUtil.copy psfile f end; clean_temp_files basefile coq-8.20.0/tools/coqdoc/latexCompiler.mli000066400000000000000000000014451466560755400203340ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* produce_document:(Common.file_t list -> unit) -> Common.file_t list -> unit coq-8.20.0/tools/coqdoc/main.ml000066400000000000000000000124341466560755400162770ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* f ^ ".html" | Raw -> f ^ ".txt" | _ -> f ^ ".tex" (*s The following function produces the output. The default output is the \LaTeX\ document: in that case, we just call [Web.produce_document]. If option \verb!-dvi!, \verb!-ps! or \verb!-html! is invoked, then we make calls to \verb!latex! or \verb!dvips! or \verb!pdflatex! accordingly. *) (*s Functions for generating output files *) let gen_one_file l = let file = function | Vernac_file (f,m) -> let sub = if !prefs.lib_subtitles then Cpretty.detect_subtitle f m else None in Output.set_module m sub; Cpretty.coq_file f m | Latex_file _ -> () in if (!prefs.header_trailer) then Output.header (); if !prefs.toc then Output.make_toc (); List.iter file l; if !prefs.index then Output.make_index(); if (!prefs.header_trailer) then Output.trailer () let gen_mult_files l = let file = function | Vernac_file (f,m) -> let sub = if !prefs.lib_subtitles then Cpretty.detect_subtitle f m else None in let hf = target_full_name m in Output.set_module m sub; open_out_file hf; if (!prefs.header_trailer) then Output.header (); Cpretty.coq_file f m; if (!prefs.header_trailer) then Output.trailer (); close_out_file() | Latex_file _ -> () in List.iter file l; if (!prefs.index && !prefs.targetlang=HTML) then begin if (!prefs.multi_index) then Output.make_multi_index (); open_out_file (!prefs.index_name^".html"); page_title := (if !prefs.title <> "" then !prefs.title else "Index"); if (!prefs.header_trailer) then Output.header (); Output.make_index (); if (!prefs.header_trailer) then Output.trailer (); close_out_file() end; if (!prefs.toc && !prefs.targetlang=HTML) then begin open_out_file "toc.html"; page_title := (if !prefs.title <> "" then !prefs.title else "Table of contents"); if (!prefs.header_trailer) then Output.header (); if !prefs.title <> "" then printf "

%s

\n" !prefs.title; Output.make_toc (); if (!prefs.header_trailer) then Output.trailer (); close_out_file() end (* NB: for latex and texmacs, a separated toc or index is meaningless... *) let read_glob_file vfile f = try Glob_file.read_glob vfile f with Sys_error s -> eprintf "Warning: %s (links will not be available)\n" s let read_glob_file_of = function | Vernac_file (f,_) -> read_glob_file (Some f) (Filename.chop_extension f ^ ".glob") | Latex_file _ -> () let index_module = function | Vernac_file (f,m) -> Index.add_module m | Latex_file _ -> () module E = Boot.Env let copy_style_file file = (* We give preference to coqlib in case it is overriden *) let env = E.init () in let coqdoc = E.tool env "coqdoc" in let sty_file = E.Path.relative coqdoc file in if not (E.Path.exists sty_file) then begin let sty_file = E.Path.to_string sty_file in eprintf "coqdoc: cannot find coqdoc style file: %s\n" sty_file; exit 1 end; let sty_file_s = E.Path.to_string sty_file in let dst = coqdoc_out file in FileUtil.copy sty_file_s dst let produce_document l = if !prefs.targetlang=HTML then copy_style_file "coqdoc.css"; if !prefs.targetlang=LaTeX then copy_style_file "coqdoc.sty"; (match !prefs.glob_source with | NoGlob -> () | DotGlob -> List.iter read_glob_file_of l | GlobFile f -> read_glob_file None f); List.iter index_module l; match !prefs.out_to with | StdOut -> Common.out_channel := stdout; gen_one_file l | File f -> open_out_file f; gen_one_file l; close_out_file() | MultFiles -> gen_mult_files l let produce_output fl = if List.length !prefs.compile_targets = 0 then produce_document fl else let otypes = !prefs.compile_targets in LatexCompiler.compile ~otypes ~produce_document fl (*s \textbf{Main program.} Print the banner, parse the command line, read the files and then call [produce_document] from module [Web]. *) let _ = CmdArgs.parse_args (); (* Sets prefs *) let files = List.rev !prefs.files in Index.init_coqlib_library (); if not !prefs.quiet then banner (); if files <> [] then produce_output files coq-8.20.0/tools/coqdoc/main.mli000066400000000000000000000012431466560755400164440ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* Hashtbl.add h key ()) l; function s -> try Hashtbl.find h s; true with Not_found -> false let is_keyword = build_table [ "About"; "Axiom"; "Abort"; "Chapter"; "Check"; "Coercion"; "Compute"; "CoFixpoint"; "CoInductive"; "Corollary"; "Defined"; "Definition"; "End"; "Eval"; "Example"; "Export"; "Fact"; "Fix"; "Fixpoint"; "From"; "Function"; "Generalizable"; "Global"; "Grammar"; "Guarded"; "Goal"; "Hint"; "Debug"; "On"; "Hypothesis"; "Hypotheses"; "Resolve"; "Unfold"; "Immediate"; "Extern"; "Constructors"; "Rewrite"; "Implicit"; "Import"; "Inductive"; "Infix"; "Lemma"; "Let"; "Load"; "Local"; "Locate"; "Ltac"; "Module"; "Module Type"; "Declare Module"; "Include"; "Mutual"; "Parameter"; "Parameters"; "Print"; "Printing"; "All"; "Proof"; "Proof with"; "Qed"; "Record"; "Recursive"; "Remark"; "Require"; "Save"; "Scheme"; "Assumptions"; "Axioms"; "Universes"; "Induction"; "for"; "Sort"; "Section"; "Show"; "Structure"; "Syntactic"; "Syntax"; "Tactic"; "Theorem"; "Search"; "SearchPattern"; "SearchRewrite"; "Set"; "Types"; "Undo"; "Unset"; "Variable"; "Variables"; "Context"; "Notation"; "Reserved Notation"; "Tactic Notation"; "Number Notation"; "String Notation"; "Enable Notation"; "Disable Notation"; "Delimit"; "Bind"; "Open"; "Scope"; "Inline"; "Implicit Arguments"; "Add"; "Strict"; "Typeclasses"; "Instance"; "Global Instance"; "Class"; "Instantiation"; "goal"; "goals"; "vm_compute"; "Opaque"; "Transparent"; "Time"; "Extraction"; "Extract"; "Variant"; (* Program *) "Program Definition"; "Program Example"; "Program Fixpoint"; "Program Lemma"; "Obligation"; "Obligations"; "Solve"; "using"; "Next Obligation"; "Next"; "Program Instance"; "Equations"; "Equations_nocomp"; (*i (* coq terms *) *) "forall"; "match"; "as"; "in"; "return"; "with"; "end"; "let"; "fun"; "if"; "then"; "else"; "Prop"; "Set"; "Type"; ":="; "where"; "struct"; "wf"; "measure"; "fix"; "cofix"; "is"; (* Ltac *) "before"; "after"; "constr"; "ltac"; "goal"; "context"; "beta"; "delta"; "iota"; "zeta"; "lazymatch"; "type"; "of"; "rec"; (* Notations *) "level"; "associativity"; "no" ] let is_tactic = build_table [ "intro"; "intros"; "apply"; "rewrite"; "refine"; "case"; "clear"; "injection"; "progress"; "setoid_rewrite"; "left"; "right"; "constructor"; "econstructor"; "decide equality"; "abstract"; "exists"; "cbv"; "simple destruct"; "info"; "field"; "specialize"; "evar"; "solve"; "instantiate"; "info_auto"; "info_eauto"; "quote"; "eexact"; "autorewrite"; "destruct"; "destruction"; "destruct_call"; "dependent"; "elim"; "extensionality"; "f_equal"; "generalize"; "generalize_eqs"; "generalize_eqs_vars"; "induction"; "rename"; "move"; "set"; "assert"; "do"; "repeat"; "cut"; "assumption"; "exact"; "split"; "subst"; "try"; "discriminate"; "simpl"; "unfold"; "red"; "compute"; "at"; "in"; "by"; "reflexivity"; "symmetry"; "transitivity"; "replace"; "setoid_replace"; "inversion"; "inversion_clear"; "pattern"; "intuition"; "congruence"; "fail"; "fresh"; "trivial"; "tauto"; "firstorder"; "ring"; "clapply"; "program_simpl"; "program_simplify"; "eapply"; "auto"; "eauto"; "change"; "fold"; "hnf"; "lazy"; "simple"; "eexists"; "debug"; "idtac"; "first"; "type of"; "pose"; "eval"; "instantiate"; "until" ] (*s Current Coq module *) let current_module : (string * string option) ref = ref ("",None) let get_module withsub = let (m,sub) = !current_module in if withsub then match sub with | None -> m | Some sub -> m ^ ": " ^ sub else m let set_module m sub = current_module := (m,sub); page_title := get_module true (*s Common to both LaTeX and HTML *) let item_level = ref 0 let in_doc = ref false (*s Customized and predefined pretty-print *) let initialize_texmacs () = let ensuremath x = sprintf ">" x in List.fold_right (fun (s,t) tt -> Tokens.ttree_add tt s t) [ "*", ensuremath "times"; "->", ensuremath "rightarrow"; "<-", ensuremath "leftarrow"; "<->", ensuremath "leftrightarrow"; "=>", ensuremath "Rightarrow"; "<=", ensuremath "le"; ">=", ensuremath "ge"; "<>", ensuremath "noteq"; "~", ensuremath "lnot"; "/\\", ensuremath "land"; "\\/", ensuremath "lor"; "|-", ensuremath "vdash" ] Tokens.empty_ttree let token_tree_texmacs = ref (initialize_texmacs ()) let token_tree_latex = ref Tokens.empty_ttree let token_tree_html = ref Tokens.empty_ttree let initialize_tex_html () = let if_utf8 = if !prefs.encoding.utf8 then fun x -> Some x else fun _ -> None in let (tree_latex, tree_html) = List.fold_right (fun (s,l,l') (tt,tt') -> (Tokens.ttree_add tt s l, match l' with None -> tt' | Some l' -> Tokens.ttree_add tt' s l')) [ "*" , "\\ensuremath{\\times}", if_utf8 "×"; "|", "\\ensuremath{|}", None; "->", "\\ensuremath{\\rightarrow}", if_utf8 "→"; "->~", "\\ensuremath{\\rightarrow\\lnot}", None; "->~~", "\\ensuremath{\\rightarrow\\lnot\\lnot}", None; "<-", "\\ensuremath{\\leftarrow}", None; "<->", "\\ensuremath{\\leftrightarrow}", if_utf8 "↔"; "=>", "\\ensuremath{\\Rightarrow}", if_utf8 "⇒"; "<=", "\\ensuremath{\\le}", if_utf8 "≤"; ">=", "\\ensuremath{\\ge}", if_utf8 "≥"; "<>", "\\ensuremath{\\not=}", if_utf8 "≠"; "~", "\\ensuremath{\\lnot}", if_utf8 "¬"; "/\\", "\\ensuremath{\\land}", if_utf8 "∧"; "\\/", "\\ensuremath{\\lor}", if_utf8 "∨"; "|-", "\\ensuremath{\\vdash}", None; "forall", "\\ensuremath{\\forall}", if_utf8 "∀"; "exists", "\\ensuremath{\\exists}", if_utf8 "∃"; "Π", "\\ensuremath{\\Pi}", if_utf8 "Π"; "λ", "\\ensuremath{\\lambda}", if_utf8 "λ"; (* "fun", "\\ensuremath{\\lambda}" ? *) ] (Tokens.empty_ttree,Tokens.empty_ttree) in token_tree_latex := tree_latex; token_tree_html := tree_html let add_printing_token s (t1,t2) = (match t1 with None -> () | Some t1 -> token_tree_latex := Tokens.ttree_add !token_tree_latex s t1); (match t2 with None -> () | Some t2 -> token_tree_html := Tokens.ttree_add !token_tree_html s t2) let remove_printing_token s = token_tree_latex := Tokens.ttree_remove !token_tree_latex s; token_tree_html := Tokens.ttree_remove !token_tree_html s (*s Table of contents *) type toc_entry = | Toc_library of string * string option | Toc_section of int * (unit -> unit) * string let (toc_q : toc_entry Queue.t) = Queue.create () let add_toc_entry e = Queue.add e toc_q let new_label = let r = ref 0 in fun () -> incr r; "lab" ^ string_of_int !r (*s LaTeX output *) module Latex = struct let in_title = ref false (*s Latex preamble *) let (preamble : string Queue.t) = Queue.create () let push_in_preamble s = Queue.add s preamble let utf8x_extra_support () = printf "\n"; printf "%%Warning: tipa declares many non-standard macros used by utf8x to\n"; printf "%%interpret utf8 characters but extra packages might have to be added\n"; printf "%%such as \"textgreek\" for Greek letters not already in tipa\n"; printf "%%or \"stmaryrd\" for mathematical symbols.\n"; printf "%%Utf8 codes missing a LaTeX interpretation can be defined by using\n"; printf "%%\\DeclareUnicodeCharacter{code}{interpretation}.\n"; printf "%%Use coqdoc's option -p to add new packages or declarations.\n"; printf "\\usepackage{tipa}\n"; printf "\n" let header () = if !prefs.header_trailer then begin printf "\\documentclass[12pt]{report}\n"; if !prefs.encoding.inputenc != "" then printf "\\usepackage[%s]{inputenc}\n" !prefs.encoding.inputenc; if !prefs.encoding.inputenc = "utf8x" then utf8x_extra_support (); printf "\\usepackage[T1]{fontenc}\n"; printf "\\usepackage{fullpage}\n"; printf "\\usepackage{coqdoc}\n"; printf "\\usepackage{amsmath,amssymb}\n"; printf "\\usepackage{url}\n"; (match !prefs.toc_depth with | None -> () | Some n -> printf "\\setcounter{tocdepth}{%i}\n" n); Queue.iter (fun s -> printf "%s\n" s) preamble; printf "\\begin{document}\n" end; output_string "%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%\n"; output_string "%% This file has been automatically generated with the command\n"; output_string "%% "; Array.iter (fun s -> printf "%s " s) Sys.argv; printf "\n"; output_string "%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%\n" let trailer () = if !prefs.header_trailer then begin printf "\\end{document}\n" end (*s Latex low-level translation *) let nbsp () = output_char '~' let char c = match c with | '\\' -> printf "\\symbol{92}" | '$' | '#' | '%' | '&' | '{' | '}' | '_' -> output_char '\\'; output_char c | '^' | '~' -> output_char '\\'; output_char c; printf "{}" | _ -> output_char c let label_char c = match c with | '_' -> output_char ' ' | '\\' | '$' | '#' | '%' | '&' | '{' | '}' | '^' | '~' -> printf "x%X" (Char.code c) | _ -> if c >= '\x80' then printf "x%X" (Char.code c) else output_char c let label_ident s = for i = 0 to String.length s - 1 do label_char s.[i] done let latex_char = output_char let latex_string = output_string let html_char _ = () let html_string _ = () (*s Latex char escaping *) let escaped = let buff = Buffer.create 5 in fun s -> Buffer.clear buff; for i = 0 to String.length s - 1 do match s.[i] with | '\\' -> Buffer.add_string buff "\\symbol{92}" | '$' | '#' | '%' | '&' | '{' | '}' | '_' as c -> Buffer.add_char buff '\\'; Buffer.add_char buff c | '^' | '~' as c -> Buffer.add_char buff '\\'; Buffer.add_char buff c; Buffer.add_string buff "{}" | '\'' -> if i < String.length s - 1 && s.[i+1] = '\'' then begin Buffer.add_char buff '\''; Buffer.add_char buff '{'; Buffer.add_char buff '}' end else Buffer.add_char buff '\'' | c -> Buffer.add_char buff c done; Buffer.contents buff (*s Latex reference and symbol translation *) let start_module () = let ln = !prefs.lib_name in if not !prefs.short then begin printf "\\coqlibrary{"; label_ident (get_module false); printf "}{"; if ln <> "" then printf "%s " ln; printf "}{%s}\n\n" (escaped (get_module true)) end let start_latex_math () = output_char '$' let stop_latex_math () = output_char '$' let start_quote () = output_char '`'; output_char '`' let stop_quote () = output_char '\''; output_char '\'' let start_verbatim inline = if inline then printf "\\texttt{" else printf "\\begin{verbatim}\n" let stop_verbatim inline = if inline then printf "}" else printf "\\end{verbatim}\n" let url addr name = printf "%s\\footnote{\\url{%s}}" (match name with | None -> "" | Some n -> n) addr let indentation n = if n == 0 then printf "\\coqdocnoindent\n" else let space = 0.5 *. (float n) in printf "\\coqdocindent{%2.2fem}\n" space let ident_ref m fid typ s = let id = if fid <> "" then (m ^ "." ^ fid) else m in match find_module m with | Local -> printf "\\coqref{"; label_ident id; printf "}{\\coqdoc%s{%s}}" (type_name typ) s | External m when !prefs.externals -> printf "\\coqexternalref{"; label_ident fid; printf "}{%s}{\\coqdoc%s{%s}}" (escaped m) (type_name typ) s | External _ | Unknown -> printf "\\coqdoc%s{%s}" (type_name typ) s let defref m id ty s = if ty <> Notation then (printf "\\coqdef{"; label_ident (m ^ "." ^ id); printf "}{%s}{\\coqdoc%s{%s}}" s (type_name ty) s) else (* Glob file still not able to say the exact extent of the definition *) (* so we currently renounce to highlight the notation location *) (printf "\\coqdef{"; label_ident (m ^ "." ^ id); printf "}{%s}{%s}" s s) let reference s = function | Def [] -> assert false | Def ((fullid,typ) :: _) -> defref (get_module false) fullid typ s | Ref (m,fullid,typ) -> ident_ref m fullid typ s (*s The sublexer buffers symbol characters and attached uninterpreted ident and try to apply special translation such as, predefined, translation "->" to "\ensuremath{\rightarrow}" or, virtually, a user-level translation from "=_h" to "\ensuremath{=_{h}}" *) let output_sublexer_string doescape issymbchar tag s = let s = if doescape then escaped s else s in match tag with | Some ref -> reference s ref | None -> if issymbchar then output_string s else printf "\\coqdocvar{%s}" s let last_was_in = ref false let sublexer c loc = if c = '*' && !last_was_in then begin Tokens.flush_sublexer (); output_char '*' end else begin let tag = try Some (Index.find (get_module false) loc) with Not_found -> None in Tokens.output_tagged_symbol_char tag c end; last_was_in := false let sublexer_in_doc c = if c = '*' && !last_was_in then begin Tokens.flush_sublexer (); output_char '*' end else Tokens.output_tagged_symbol_char None c; last_was_in := false let initialize () = initialize_tex_html (); Tokens.token_tree := token_tree_latex; Tokens.outfun := output_sublexer_string (*s Interpreting ident with fallback on sublexer if unknown ident *) let translate s = match Tokens.translate s with Some s -> s | None -> escaped s let keyword s loc = printf "\\coqdockw{%s}" (translate s) let ident s loc = last_was_in := s = "in"; try match loc with | None -> raise Not_found | Some loc -> let tag = Index.find (get_module false) loc in reference (translate s) tag with Not_found -> if is_tactic s then printf "\\coqdoctac{%s}" (translate s) else if is_keyword s then printf "\\coqdockw{%s}" (translate s) else if !prefs.interpolate && !in_doc (* always a var otherwise *) then try let tag = Index.find_string s in reference (translate s) tag with _ -> Tokens.output_tagged_ident_string s else Tokens.output_tagged_ident_string s let ident s l = if !in_title then ( printf "\\texorpdfstring{\\protect"; ident s l; printf "}{%s}" (translate s)) else ident s l (*s Translating structure *) let proofbox () = printf "\\ensuremath{\\Box}" let rec reach_item_level n = if !item_level < n then begin printf "\n\\begin{itemize}\n\\item "; incr item_level; reach_item_level n end else if !item_level > n then begin printf "\n\\end{itemize}\n"; decr item_level; reach_item_level n end let item n = let old_level = !item_level in reach_item_level n; if n <= old_level then printf "\n\\item " let stop_item () = reach_item_level 0 let start_doc () = in_doc := true let end_doc () = in_doc := false; stop_item () (* This is broken if we are in math mode, but coqdoc currently isn't tracking that *) let start_emph () = printf "\\textit{" let stop_emph () = printf "}" let start_details _ = () let stop_details () = () let start_comment () = printf "\\begin{coqdoccomment}\n" let end_comment () = printf "\\end{coqdoccomment}\n" let start_coq () = printf "\\begin{coqdoccode}\n" let end_coq () = printf "\\end{coqdoccode}\n" let section_kind = function | 1 -> "\\section{" | 2 -> "\\subsection{" | 3 -> "\\subsubsection{" | 4 -> "\\paragraph{" | _ -> assert false let section lev f = stop_item (); output_string (section_kind lev); in_title := true; f (); in_title := false; printf "}\n\n" let rule () = printf "\\par\n\\noindent\\hrulefill\\par\n\\noindent{}" let paragraph () = printf "\n\n" let line_break () = printf "\\coqdoceol\n" let empty_line_of_code () = printf "\\coqdocemptyline\n" let start_inline_coq_block () = line_break (); empty_line_of_code () let end_inline_coq_block () = empty_line_of_code () let start_inline_coq () = () let end_inline_coq () = () let make_multi_index () = () let make_index () = () let make_toc () = printf "\\tableofcontents\n" end (*s HTML output *) module Html = struct let header () = if !prefs.header_trailer then if !prefs.header_file_spec then let cin = open_in !prefs.header_file in try while true do let s = input_line cin in printf "%s\n" s done with End_of_file -> close_in cin else begin printf "\n"; printf "\n\n"; printf "\n" !prefs.encoding.charset; printf "\n"; printf "%s\n\n\n" !page_title; printf "\n\n\n\n\n" end let start_module () = let ln = !prefs.lib_name in if not !prefs.short then begin let (m,sub) = !current_module in add_toc_entry (Toc_library (m,sub)); if ln = "" then printf "

%s

\n\n" (get_module true) else printf "

%s %s

\n\n" ln (get_module true) end let indentation n = for _i = 1 to n do printf " " done let line_break () = printf "
\n" let empty_line_of_code () = printf "\n
\n" let nbsp () = printf " " let char = function | '<' -> printf "<" | '>' -> printf ">" | '&' -> printf "&" | c -> output_char c let escaped = let buff = Buffer.create 5 in fun s -> Buffer.clear buff; for i = 0 to String.length s - 1 do match s.[i] with | '<' -> Buffer.add_string buff "<" | '>' -> Buffer.add_string buff ">" | '&' -> Buffer.add_string buff "&" | '\"' -> Buffer.add_string buff """ | c -> Buffer.add_char buff c done; Buffer.contents buff let sanitize_name s = let rec loop esc i = if i < 0 then if esc then escaped s else s else match s.[i] with | 'a'..'z' | 'A'..'Z' | '0'..'9' | '.' | '_' -> loop esc (i-1) | '<' | '>' | '&' | '\'' | '\"' -> loop true (i-1) | '-' | ':' -> loop esc (i-1) (* should be safe in HTML5 attribute name syntax *) | _ -> (* This name contains complex characters: this is probably a notation string, we simply hash it. *) Digest.to_hex (Digest.string s) in loop false (String.length s - 1) let latex_char _ = () let latex_string _ = () let html_char = output_char let html_string = output_string let start_latex_math () = () let stop_latex_math () = () let start_quote () = char '"' let stop_quote () = start_quote () let start_verbatim inline = if inline then printf "" else printf "
\n"

  let stop_verbatim inline =
    if inline then printf ""
    else printf "
\n" let url addr name = printf "%s" addr (match name with | Some n -> n | None -> addr) let ident_ref m fid typ s = match find_module m with | Local -> printf "" m (sanitize_name fid); printf "%s" typ s | External m when !prefs.externals -> printf "" m (sanitize_name fid); printf "%s" typ s | External _ | Unknown -> printf "%s" typ s let reference s r = match r with | Def [] -> assert false | Def [fullid,ty] -> let s' = sanitize_name fullid in printf "" s' s'; printf "%s" (type_name ty) s | Def ((hd_id,_) :: tail as all) -> let hd = sanitize_name hd_id in let all_tys = all |> List.map (fun (_,ty) -> type_name ty) |> CList.sort_uniquize String.compare |> String.concat ", " in printf "" hd hd all_tys; List.iter (fun (fullid,_) -> let s' = sanitize_name fullid in printf "" s') tail; printf "%s" s; List.iter (fun _ -> printf "") tail; printf ""; | Ref (m,fullid,ty) -> ident_ref m fullid (type_name ty) s let output_sublexer_string doescape issymbchar tag s = let s = if doescape then escaped s else s in match tag with | Some ref -> reference s ref | None -> if issymbchar then output_string s else printf "%s" s let sublexer c loc = let tag = try Some (Index.find (get_module false) loc) with Not_found -> None in Tokens.output_tagged_symbol_char tag c let sublexer_in_doc c = Tokens.output_tagged_symbol_char None c let initialize () = initialize_tex_html(); Tokens.token_tree := token_tree_html; Tokens.outfun := output_sublexer_string let translate s = match Tokens.translate s with Some s -> s | None -> escaped s let keyword s loc = printf "%s" (translate s) let ident s loc = try match loc with | None -> raise Not_found | Some loc -> reference (translate s) (Index.find (get_module false) loc) with Not_found -> if is_tactic s then printf "%s" (translate s) else if is_keyword s then printf "%s" (translate s) else if !prefs.interpolate && !in_doc (* always a var otherwise *) then try reference (translate s) (Index.find_string s) with Not_found -> Tokens.output_tagged_ident_string s else Tokens.output_tagged_ident_string s let proofbox () = printf "☐" let rec reach_item_level n = if !item_level < n then begin printf "
    \n
  • "; incr item_level; reach_item_level n end else if !item_level > n then begin printf "\n
    • \n
\n"; decr item_level; reach_item_level n end let item n = let old_level = !item_level in reach_item_level n; if n <= old_level then printf "\n\n
  • " let stop_item () = reach_item_level 0 let start_coq () = if not !prefs.raw_comments then printf "
    \n" let end_coq () = if not !prefs.raw_comments then printf "
    \n" let start_doc () = in_doc := true; if not !prefs.raw_comments then printf "\n
    \n" let end_doc () = in_doc := false; stop_item (); if not !prefs.raw_comments then printf "
    \n" let start_emph () = printf "" let stop_emph () = printf "" let start_details = function | Some s -> printf "
    %s" s | _ -> printf "
    " let stop_details () = printf "
    " let start_comment () = printf "(*" let end_comment () = printf "*)" let start_inline_coq () = if !prefs.inline_notmono then printf "" else printf "" let end_inline_coq () = printf "" let start_inline_coq_block () = line_break (); start_inline_coq () let end_inline_coq_block () = end_inline_coq () let paragraph () = printf "\n
    \n\n" (* inference rules *) let inf_rule assumptions (_,_,midnm) conclusions = (* this first function replaces any occurrence of 3 or more spaces in a row with " "s. We do this to the assumptions so that people can put multiple rules on a line with nice formatting *) let replace_spaces str = let rec copy a n = match n with 0 -> [] | n -> (a :: copy a (n - 1)) in let results = Str.full_split (Str.regexp "[' '][' '][' ']+") str in let strs = List.map (fun r -> match r with | Str.Text s -> [s] | Str.Delim s -> copy " " (String.length s)) results in String.concat "" (List.concat strs) in let start_assumption line = (printf "\n"; printf " %s\n" (replace_spaces line)) in let end_assumption () = (printf " \n"; printf "\n") in let rec print_assumptions hyps = match hyps with | [] -> start_assumption "  " | [(_,hyp)] -> start_assumption hyp | ((_,hyp) :: hyps') -> (start_assumption hyp; end_assumption (); print_assumptions hyps') in printf "
    \n"; print_assumptions assumptions; printf " " | Some s -> printf " %s  \n " s); printf "\n"; printf "\n"; printf " \n"; printf "\n"; print_assumptions conclusions; end_assumption (); printf "
    \n"; (match midnm with | None -> printf "  \n
    " let section lev f = let lab = new_label () in let r = sprintf "%s.html#%s" (get_module false) lab in (match !prefs.toc_depth with | None -> add_toc_entry (Toc_section (lev, f, r)) | Some n -> if lev <= n then add_toc_entry (Toc_section (lev, f, r)) else ()); stop_item (); printf "" lab lev; f (); printf "\n" lev let rule () = printf "
    \n" (* make a HTML index from a list of triples (name,text,link) *) let index_ref i c = let idxc = sprintf "%s_%c" i.idx_name c in !prefs.index_name ^ (if !prefs.multi_index then "_" ^ idxc ^ ".html" else ".html#" ^ idxc) let letter_index category idx (c,l) = if l <> [] then begin let cat = if category && idx <> "global" then "(" ^ idx ^ ")" else "" in printf "

    %s %s

    \n" idx c (display_letter c) cat; List.iter (fun (id,(text,link,t)) -> let id' = escaped (prepare_entry id t) in printf "%s %s
    \n" link id' text) l; printf "

    " end let all_letters i = List.iter (letter_index false i.idx_name) i.idx_entries (* Construction d'une liste des index (1 index global, puis 1 index par catégorie) *) let format_global_index = Index.map (fun s (m,t) -> if t = Library then let ln = !prefs.lib_name in if ln <> "" then "[" ^ String.lowercase_ascii ln ^ "]", m ^ ".html", t else "[library]", m ^ ".html", t else sprintf "[%s, in %s]" (type_name t) m m , sprintf "%s.html#%s" m (sanitize_name s), t) let format_bytype_index = function | Library, idx -> Index.map (fun id m -> "", m ^ ".html", Library) idx | (t,idx) -> Index.map (fun s m -> let text = sprintf "[in %s]" m m in (text, sprintf "%s.html#%s" m (sanitize_name s), t)) idx (* Impression de la table d'index *) let print_index_table_item i = printf "\n%s Index\n" (String.capitalize_ascii i.idx_name); List.iter (fun (c,l) -> if l <> [] then printf "%s\n" (index_ref i c) (display_letter c) else printf "%s\n" (display_letter c)) i.idx_entries; let n = i.idx_size in printf "(%d %s)\n" n (if n > 1 then "entries" else "entry"); printf "\n" let print_index_table idxl = printf "\n"; List.iter print_index_table_item idxl; printf "
    \n" let make_one_multi_index prt_tbl i = (* Attn: make_one_multi_index crée un nouveau fichier... *) let idx = i.idx_name in let one_letter ((c,l) as cl) = open_out_file (sprintf "%s_%s_%c.html" !prefs.index_name idx c); if (!prefs.header_trailer) then header (); prt_tbl (); printf "
    "; letter_index true idx cl; if List.length l > 30 then begin printf "
    "; prt_tbl () end; if (!prefs.header_trailer) then trailer (); close_out_file () in List.iter one_letter i.idx_entries let make_multi_index () = let all_index = let glob,bt = Index.all_entries () in (format_global_index glob) :: (List.map format_bytype_index bt) in let print_table () = print_index_table all_index in List.iter (make_one_multi_index print_table) all_index let make_index () = let all_index = let glob,bt = Index.all_entries () in (format_global_index glob) :: (List.map format_bytype_index bt) in let print_table () = print_index_table all_index in let print_one_index i = if i.idx_size > 0 then begin printf "
    \n

    %s Index

    \n" (String.capitalize_ascii i.idx_name); all_letters i end in set_module "Index" None; if !prefs.title <> "" then printf "

    %s

    \n" !prefs.title; print_table (); if not (!prefs.multi_index) then begin List.iter print_one_index all_index; printf "
    "; print_table () end let make_toc () = let ln = !prefs.lib_name in let make_toc_entry = function | Toc_library (m,sub) -> stop_item (); let ms = match sub with | None -> m | Some s -> m ^ ": " ^ s in if ln = "" then printf "

    %s

    \n" m ms else printf "

    %s %s

    \n" m ln ms | Toc_section (n, f, r) -> item n; printf "" r; f (); printf "\n" in printf "
    \n"; Queue.iter make_toc_entry toc_q; stop_item (); printf "
    \n" end (*s TeXmacs-aware output *) module TeXmacs = struct (*s Latex preamble *) let (_ : string Queue.t) = in_doc := false; Queue.create () let header () = output_string "(*i This file has been automatically generated with the command \n"; output_string " "; Array.iter (fun s -> printf "%s " s) Sys.argv; printf " *)\n" let trailer () = () let nbsp () = output_char ' ' let char_true c = match c with | '\\' -> printf "\\\\" | '<' -> printf "\\<" | '|' -> printf "\\|" | '>' -> printf "\\>" | _ -> output_char c let char c = if !in_doc then char_true c else output_char c let latex_char = char_true let latex_string = String.iter latex_char let html_char _ = () let html_string _ = () let raw_ident s = for i = 0 to String.length s - 1 do char s.[i] done let start_module () = () let start_latex_math () = printf "' let start_verbatim inline = in_doc := true; printf "<\\verbatim>" let stop_verbatim inline = in_doc := false; printf "" let url addr name = printf "%s<\\footnote><\\url>%s" addr (match name with | None -> "" | Some n -> n) let start_quote () = output_char '`'; output_char '`' let stop_quote () = output_char '\''; output_char '\'' let indentation n = () let keyword s = printf "" let ident_true s = if is_keyword s then keyword s else raw_ident s let keyword s loc = keyword s let ident s _ = if !in_doc then ident_true s else raw_ident s let output_sublexer_string doescape issymbchar tag s = if doescape then raw_ident s else output_string s let sublexer c l = if !in_doc then Tokens.output_tagged_symbol_char None c else char c let sublexer_in_doc c = char c let initialize () = Tokens.token_tree := token_tree_texmacs; Tokens.outfun := output_sublexer_string let proofbox () = printf "QED" let rec reach_item_level n = if !item_level < n then begin printf "\n<\\itemize>\n"; incr item_level; reach_item_level n end else if !item_level > n then begin printf "\n"; decr item_level; reach_item_level n end let item n = let old_level = !item_level in reach_item_level n; if n <= old_level then printf "\n\n" let stop_item () = reach_item_level 0 let start_doc () = in_doc := true; printf "(** texmacs: " let end_doc () = stop_item (); in_doc := false; printf " *)" let start_coq () = () let end_coq () = () let start_emph () = printf "" let start_details _ = () let stop_details () = () let start_comment () = () let end_comment () = () let section_kind = function | 1 -> "section" | 2 -> "subsection" | 3 -> "subsubsection" | 4 -> "paragraph" | _ -> assert false let section lev f = stop_item (); printf "<"; output_string (section_kind lev); printf "|"; f (); printf ">\n\n" let rule () = printf "\n\n" let paragraph () = printf "\n\n" let line_break () = printf "\n" let empty_line_of_code () = printf "\n" let start_inline_coq () = printf "" let start_inline_coq_block () = line_break (); start_inline_coq () let end_inline_coq_block () = end_inline_coq () let make_multi_index () = () let make_index () = () let make_toc () = () end (*s Raw output *) module Raw = struct let header () = () let trailer () = () let nbsp () = output_char ' ' let char = output_char let latex_char = output_char let latex_string = output_string let html_char _ = () let html_string _ = () let raw_ident s = for i = 0 to String.length s - 1 do char s.[i] done let start_module () = () let start_latex_math () = () let stop_latex_math () = () let start_verbatim inline = () let stop_verbatim inline = () let url addr name = match name with | Some n -> printf "%s (%s)" n addr | None -> printf "%s" addr let start_quote () = printf "\"" let stop_quote () = printf "\"" let indentation n = for _i = 1 to n do printf " " done let keyword s loc = raw_ident s let ident s loc = raw_ident s let sublexer c l = char c let sublexer_in_doc c = char c let initialize () = Tokens.token_tree := ref Tokens.empty_ttree; Tokens.outfun := (fun _ _ _ _ -> failwith "Useless") let proofbox () = printf "[]" let item n = printf "- " let stop_item () = () let reach_item_level _ = () let start_doc () = printf "(** " let end_doc () = printf " *)\n" let start_emph () = printf "_" let stop_emph () = printf "_" let start_details _ = () let stop_details () = () let start_comment () = printf "(*" let end_comment () = printf "*)" let start_coq () = () let end_coq () = () let section_kind = function | 1 -> "* " | 2 -> "** " | 3 -> "*** " | 4 -> "**** " | _ -> assert false let section lev f = output_string (section_kind lev); f () let rule () = () let paragraph () = printf "\n\n" let line_break () = printf "\n" let empty_line_of_code () = printf "\n" let start_inline_coq () = () let end_inline_coq () = () let start_inline_coq_block () = line_break (); start_inline_coq () let end_inline_coq_block () = end_inline_coq () let make_multi_index () = () let make_index () = () let make_toc () = () end (*s Generic output *) let select f1 f2 f3 f4 x = match !prefs.targetlang with LaTeX -> f1 x | HTML -> f2 x | TeXmacs -> f3 x | Raw -> f4 x let push_in_preamble = Latex.push_in_preamble let header = select Latex.header Html.header TeXmacs.header Raw.header let trailer = select Latex.trailer Html.trailer TeXmacs.trailer Raw.trailer let start_module = select Latex.start_module Html.start_module TeXmacs.start_module Raw.start_module let start_doc = select Latex.start_doc Html.start_doc TeXmacs.start_doc Raw.start_doc let end_doc = select Latex.end_doc Html.end_doc TeXmacs.end_doc Raw.end_doc let start_comment = select Latex.start_comment Html.start_comment TeXmacs.start_comment Raw.start_comment let end_comment = select Latex.end_comment Html.end_comment TeXmacs.end_comment Raw.end_comment let start_coq = select Latex.start_coq Html.start_coq TeXmacs.start_coq Raw.start_coq let end_coq = select Latex.end_coq Html.end_coq TeXmacs.end_coq Raw.end_coq let start_inline_coq = select Latex.start_inline_coq Html.start_inline_coq TeXmacs.start_inline_coq Raw.start_inline_coq let end_inline_coq = select Latex.end_inline_coq Html.end_inline_coq TeXmacs.end_inline_coq Raw.end_inline_coq let start_inline_coq_block = select Latex.start_inline_coq_block Html.start_inline_coq_block TeXmacs.start_inline_coq_block Raw.start_inline_coq_block let end_inline_coq_block = select Latex.end_inline_coq_block Html.end_inline_coq_block TeXmacs.end_inline_coq_block Raw.end_inline_coq_block let indentation = select Latex.indentation Html.indentation TeXmacs.indentation Raw.indentation let paragraph = select Latex.paragraph Html.paragraph TeXmacs.paragraph Raw.paragraph let line_break = select Latex.line_break Html.line_break TeXmacs.line_break Raw.line_break let empty_line_of_code = select Latex.empty_line_of_code Html.empty_line_of_code TeXmacs.empty_line_of_code Raw.empty_line_of_code let section = select Latex.section Html.section TeXmacs.section Raw.section let item = select Latex.item Html.item TeXmacs.item Raw.item let stop_item = select Latex.stop_item Html.stop_item TeXmacs.stop_item Raw.stop_item let reach_item_level = select Latex.reach_item_level Html.reach_item_level TeXmacs.reach_item_level Raw.reach_item_level let rule = select Latex.rule Html.rule TeXmacs.rule Raw.rule let nbsp = select Latex.nbsp Html.nbsp TeXmacs.nbsp Raw.nbsp let char = select Latex.char Html.char TeXmacs.char Raw.char let keyword = select Latex.keyword Html.keyword TeXmacs.keyword Raw.keyword let ident = select Latex.ident Html.ident TeXmacs.ident Raw.ident let sublexer = select Latex.sublexer Html.sublexer TeXmacs.sublexer Raw.sublexer let sublexer_in_doc = select Latex.sublexer_in_doc Html.sublexer_in_doc TeXmacs.sublexer_in_doc Raw.sublexer_in_doc let initialize = select Latex.initialize Html.initialize TeXmacs.initialize Raw.initialize let proofbox = select Latex.proofbox Html.proofbox TeXmacs.proofbox Raw.proofbox let latex_char = select Latex.latex_char Html.latex_char TeXmacs.latex_char Raw.latex_char let latex_string = select Latex.latex_string Html.latex_string TeXmacs.latex_string Raw.latex_string let html_char = select Latex.html_char Html.html_char TeXmacs.html_char Raw.html_char let html_string = select Latex.html_string Html.html_string TeXmacs.html_string Raw.html_string let start_emph = select Latex.start_emph Html.start_emph TeXmacs.start_emph Raw.start_emph let stop_emph = select Latex.stop_emph Html.stop_emph TeXmacs.stop_emph Raw.stop_emph let start_details = select Latex.start_details Html.start_details TeXmacs.start_details Raw.start_details let stop_details = select Latex.stop_details Html.stop_details TeXmacs.stop_details Raw.stop_details let start_latex_math = select Latex.start_latex_math Html.start_latex_math TeXmacs.start_latex_math Raw.start_latex_math let stop_latex_math = select Latex.stop_latex_math Html.stop_latex_math TeXmacs.stop_latex_math Raw.stop_latex_math let start_verbatim = select Latex.start_verbatim Html.start_verbatim TeXmacs.start_verbatim Raw.start_verbatim let stop_verbatim = select Latex.stop_verbatim Html.stop_verbatim TeXmacs.stop_verbatim Raw.stop_verbatim let verbatim_char inline = select (if inline then Latex.char else output_char) Html.char TeXmacs.char Raw.char let hard_verbatim_char = output_char let url = select Latex.url Html.url TeXmacs.url Raw.url let start_quote = select Latex.start_quote Html.start_quote TeXmacs.start_quote Raw.start_quote let stop_quote = select Latex.stop_quote Html.stop_quote TeXmacs.stop_quote Raw.stop_quote let inf_rule_dumb assumptions (midsp,midln,midnm) conclusions = start_verbatim false; let dumb_line = function (sp,ln) -> (String.iter char ((String.make sp ' ') ^ ln); char '\n') in (List.iter dumb_line assumptions; dumb_line (midsp, midln ^ (match midnm with | Some s -> " " ^ s | None -> "")); List.iter dumb_line conclusions); stop_verbatim false let inf_rule = select inf_rule_dumb Html.inf_rule inf_rule_dumb inf_rule_dumb let make_multi_index = select Latex.make_multi_index Html.make_multi_index TeXmacs.make_multi_index Raw.make_multi_index let make_index = select Latex.make_index Html.make_index TeXmacs.make_index Raw.make_index let make_toc = select Latex.make_toc Html.make_toc TeXmacs.make_toc Raw.make_toc coq-8.20.0/tools/coqdoc/output.mli000066400000000000000000000063241466560755400170650ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* unit val add_printing_token : string -> string option * string option -> unit val remove_printing_token : string -> unit val set_module : coq_module -> string option -> unit val get_module : bool -> string val header : unit -> unit val trailer : unit -> unit val push_in_preamble : string -> unit val start_module : unit -> unit val start_doc : unit -> unit val end_doc : unit -> unit val start_details : string option -> unit val stop_details : unit -> unit val start_emph : unit -> unit val stop_emph : unit -> unit val start_comment : unit -> unit val end_comment : unit -> unit val start_coq : unit -> unit val end_coq : unit -> unit val start_inline_coq : unit -> unit val end_inline_coq : unit -> unit val start_inline_coq_block : unit -> unit val end_inline_coq_block : unit -> unit val indentation : int -> unit val line_break : unit -> unit val paragraph : unit -> unit val empty_line_of_code : unit -> unit val section : int -> (unit -> unit) -> unit val item : int -> unit val stop_item : unit -> unit val reach_item_level : int -> unit val rule : unit -> unit val nbsp : unit -> unit val char : char -> unit val keyword : string -> loc -> unit val ident : string -> loc option -> unit val sublexer : char -> loc -> unit val sublexer_in_doc : char -> unit val proofbox : unit -> unit val latex_char : char -> unit val latex_string : string -> unit val html_char : char -> unit val html_string : string -> unit val verbatim_char : bool -> char -> unit val hard_verbatim_char : char -> unit val start_latex_math : unit -> unit val stop_latex_math : unit -> unit val start_verbatim : bool -> unit val stop_verbatim : bool -> unit val start_quote : unit -> unit val stop_quote : unit -> unit val url : string -> string option -> unit (* this outputs an inference rule in one go. You pass it the list of assumptions, then the middle line info, then the conclusion (which is allowed to span multiple lines). In each case, the int is the number of spaces before the start of the line's text and the string is the text of the line with the leading trailing space trimmed. For the middle rule, you can also optionally provide a name. We need the space info so that in modes where we aren't doing something smart we can just format the rule verbatim like the user did *) val inf_rule : (int * string) list -> (int * string * (string option)) -> (int * string) list -> unit val make_multi_index : unit -> unit val make_index : unit -> unit val make_toc : unit -> unit coq-8.20.0/tools/coqdoc/style.css000066400000000000000000000020131466560755400166630ustar00rootroot00000000000000a:visited {color : #416DFF; text-decoration : none; } a:link {color : #416DFF; text-decoration : none; font-weight : bold} a:hover {color : Red; text-decoration : underline; } a:active {color : Red; text-decoration : underline; } .keyword { font-weight : bold ; color : Red } .keywordsign { color : #C04600 } .superscript { font-size : 4 } .subscript { font-size : 4 } .comment { color : Green } .constructor { color : Blue } .string { color : Maroon } .warning { color : Red ; font-weight : bold } .info { margin-left : 3em; margin-right : 3em } .title1 { font-size : 20pt ; background-color : #416DFF } .title2 { font-size : 20pt ; background-color : #418DFF } .title3 { font-size : 20pt ; background-color : #41ADFF } .title4 { font-size : 20pt ; background-color : #41CDFF } .title5 { font-size : 20pt ; background-color : #41EDFF } .title6 { font-size : 20pt ; background-color : #41FFFF } body { background-color : White } tr { background-color : White } # .doc { background-color :#aaeeff } .doc { background-color :#66ff66 } coq-8.20.0/tools/coqdoc/tokens.ml000066400000000000000000000140001466560755400166450ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* None with | Some tt' -> CharMap.add c (insert tt' (i + 1)) (CharMap.remove c tt.branch) | None -> let tt' = {node = None; branch = CharMap.empty} in CharMap.add c (insert tt' (i + 1)) tt.branch in { node = tt.node; branch = br } in insert ttree 0 (* Removes a string from a dictionary: returns an equal dictionary if the word not present. *) let ttree_remove ttree str = let rec remove tt i = if i == String.length str then {node = None; branch = tt.branch} else let c = str.[i] in let br = match try Some (CharMap.find c tt.branch) with Not_found -> None with | Some tt' -> CharMap.add c (remove tt' (i + 1)) (CharMap.remove c tt.branch) | None -> tt.branch in { node = tt.node; branch = br } in remove ttree 0 let ttree_descend ttree c = CharMap.find c ttree.branch let ttree_find ttree str = let rec proc_rec tt i = if i == String.length str then tt else proc_rec (CharMap.find str.[i] tt.branch) (i+1) in proc_rec ttree 0 (*s Parameters of the translation automaton *) type out_function = bool -> bool -> Index.index_entry option -> string -> unit let token_tree = ref (ref empty_ttree) let outfun = ref (fun _ _ _ _ -> failwith "outfun not initialized") (*s Translation automaton *) let buff = Buffer.create 4 let flush_buffer was_symbolchar tag tok = let hastr = String.length tok <> 0 in if hastr then !outfun false was_symbolchar tag tok; if Buffer.length buff <> 0 then !outfun true (if hastr then not was_symbolchar else was_symbolchar) tag (Buffer.contents buff); Buffer.clear buff type sublexer_state = | Neutral | Buffering of bool * Index.index_entry option * string * ttree let translation_state = ref Neutral let buffer_char is_symbolchar ctag c = let rec aux = function | Neutral -> restart_buffering () | Buffering (was_symbolchar,tag,translated,tt) -> if tag <> ctag then (* A strong tag comes from Coq; if different Coq tags *) (* hence, we don't try to see the chars as part of a single token *) let translated = match tt.node with | Some tok -> Buffer.clear buff; tok | None -> translated in flush_buffer was_symbolchar tag translated; restart_buffering () else begin (* If we change the category of characters (symbol vs ident) *) (* we accept this as a possible token cut point and remember the *) (* translated token up to that point *) let translated = if is_symbolchar <> was_symbolchar then match tt.node with | Some tok -> Buffer.clear buff; tok | None -> translated else translated in (* We try to make a significant token from the current *) (* buffer and the new character *) try let tt = ttree_descend tt c in Buffer.add_char buff c; Buffering (is_symbolchar,ctag,translated,tt) with Not_found -> (* No existing translation for the given set of chars *) if is_symbolchar <> was_symbolchar then (* If we changed the category of character read, we accept it *) (* as a possible cut point and restart looking for a translation *) (flush_buffer was_symbolchar tag translated; restart_buffering ()) else (* If we did not change the category of character read, we do *) (* not want to cut arbitrarily in the middle of the sequence of *) (* symbol characters or identifier characters *) (Buffer.add_char buff c; Buffering (is_symbolchar,tag,translated,empty_ttree)) end and restart_buffering () = let tt = try ttree_descend !(!token_tree) c with Not_found -> empty_ttree in Buffer.add_char buff c; Buffering (is_symbolchar,ctag,"",tt) in translation_state := aux !translation_state let output_tagged_ident_string s = for i = 0 to String.length s - 1 do buffer_char false None s.[i] done let output_tagged_symbol_char tag c = buffer_char true tag c let flush_sublexer () = match !translation_state with | Neutral -> () | Buffering (was_symbolchar,tag,translated,tt) -> let translated = match tt.node with | Some tok -> Buffer.clear buff; tok | None -> translated in flush_buffer was_symbolchar tag translated; translation_state := Neutral (* Translation not using the automaton *) let translate s = try (ttree_find !(!token_tree) s).node with Not_found -> None coq-8.20.0/tools/coqdoc/tokens.mli000066400000000000000000000064071466560755400170320ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* string -> string -> ttree (* Remove a translation from a dictionary: returns an equal dictionary if the word not present *) val ttree_remove : ttree -> string -> ttree (* Translate a string *) val translate : string -> string option (* Sublexer automaton *) (* The sublexer buffers the chars it receives; if after some time, it recognizes that a sequence of chars has a translation in the current dictionary, it replaces the buffer by the translation *) (* Received chars can come with a "tag" (usually made from informations from the globalization file). A sequence of chars can be considered a word only, if all chars have the same "tag". Rules for cutting words are the following: - in a sequence like "**" where * is in the dictionary but not **, "**" is not translated; otherwise said, to be translated, a sequence must not be surrounded by other symbol-like chars - in a sequence like "<>_h*", where <>_h is in the dictionary, the translation is done because the switch from a letter to a symbol char is an acceptable cutting point - in a sequence like "<>_ha", where <>_h is in the dictionary, the translation is not done because it is considered that h and a are not separable (however, if h and a have different tags, and h has the same tags as <, > and _, the translation happens) - in a sequence like "<>_ha", where <> but not <>_h is in the dictionary, the translation is done for <> and _ha is considered independently because the switch from a symbol char to a letter is considered to be an acceptable cutting point - the longest-word rule applies: if both <> and <>_h are in the dictionary, "<>_h" is one word and gets translated *) (* Warning: do not output anything on output channel in between a call to [output_tagged_*] and [flush_sublexer]!! *) type out_function = bool (* needs escape *) -> bool (* it is a symbol, not a pure ident *) -> Index.index_entry option (* the index type of the token if any *) -> string -> unit (* This must be initialized before calling the sublexer *) val token_tree : ttree ref ref val outfun : out_function ref (* Process an ident part that might be a symbol part *) val output_tagged_ident_string : string -> unit (* Process a non-ident char (possibly equipped with a tag) *) val output_tagged_symbol_char : Index.index_entry option -> char -> unit (* Flush the buffered content of the lexer using [outfun] *) val flush_sublexer : unit -> unit coq-8.20.0/tools/coqwc.mli000066400000000000000000000000001466560755400153520ustar00rootroot00000000000000coq-8.20.0/tools/coqwc.mll000066400000000000000000000216731466560755400154000ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* printf " %s" f | _ -> ()); if !percentage then begin let s = sl + pl + dl in let p = if s > 0 then 100 * dl / s else 0 in printf " (%d%%)" p end; print_newline () let print_file fo = print_line !slines !plines !dlines fo let print_totals () = print_line !tslines !tplines !tdlines (Some "total") (*i*)}(*i*) (*s Shortcuts for regular expressions. The [rcs] regular expression is used to skip the CVS infos possibly contained in some comments, in order not to consider it as documentation. *) let space = [' ' '\t' '\r'] let character = "'" ([^ '\\' '\''] | '\\' (['\\' '\'' 'n' 't' 'b' 'r'] | ['0'-'9'] ['0'-'9'] ['0'-'9'])) "'" let rcs_keyword = "Author" | "Date" | "Header" | "Id" | "Name" | "Locker" | "Log" | "RCSfile" | "Revision" | "Source" | "State" let rcs = "\036" rcs_keyword [^ '$']* "\036" let stars = "(*" '*'* "*)" let dot = '.' (' ' | '\t' | '\n' | '\r' | eof) let proof_start = "Theorem" | "Lemma" | "Fact" | "Remark" | "Goal" | "Correctness" | "Obligation" space+ (['0' - '9'])+ | "Next" space+ "Obligation" let def_start = "Definition" | "Fixpoint" | "Instance" let proof_end = ("Save" | "Qed" | "Defined" | "Abort" | "Admitted") [^'.']* '.' (*s [spec] scans the specification. *) rule spec = parse | "(*" { comment lexbuf; spec lexbuf } | '"' { let n = string lexbuf in slines := !slines + n; seen_spec := true; spec lexbuf } | '\n' { newline (); spec lexbuf } | space+ | stars { spec lexbuf } | proof_start { seen_spec := true; spec_to_dot lexbuf; proof lexbuf } | def_start { seen_spec := true; definition lexbuf } | character | _ { seen_spec := true; spec lexbuf } | eof { () } (*s [spec_to_dot] scans a spec until a dot is reached and returns. *) and spec_to_dot = parse | "(*" { comment lexbuf; spec_to_dot lexbuf } | '"' { let n = string lexbuf in slines := !slines + n; seen_spec := true; spec_to_dot lexbuf } | '\n' { newline (); spec_to_dot lexbuf } | dot { () } | space+ | stars { spec_to_dot lexbuf } | character | _ { seen_spec := true; spec_to_dot lexbuf } | eof { () } (*s [definition] scans a definition; passes to [proof] if the body is absent, and to [spec] otherwise *) and definition = parse | "(*" { comment lexbuf; definition lexbuf } | '"' { let n = string lexbuf in slines := !slines + n; seen_spec := true; definition lexbuf } | '\n' { newline (); definition lexbuf } | ":=" { seen_spec := true; spec lexbuf } | dot { proof lexbuf } | space+ | stars { definition lexbuf } | character | _ { seen_spec := true; definition lexbuf } | eof { () } (*s Scans a proof, then returns to [spec]. *) and proof = parse | "(*" { comment lexbuf; proof lexbuf } | '"' { let n = string lexbuf in plines := !plines + n; seen_proof := true; proof lexbuf } | space+ | stars { proof lexbuf } | '\n' { newline (); proof lexbuf } | "Proof" space* '.' | "Proof" space+ "with" | "Proof" space+ "using" { seen_proof := true; proof lexbuf } | "Proof" space { proof_term lexbuf } | proof_end { seen_proof := true; spec lexbuf } | character | _ { seen_proof := true; proof lexbuf } | eof { () } and proof_term = parse | "(*" { comment lexbuf; proof_term lexbuf } | '"' { let n = string lexbuf in plines := !plines + n; seen_proof := true; proof_term lexbuf } | space+ | stars { proof_term lexbuf } | '\n' { newline (); proof_term lexbuf } | dot { spec lexbuf } | character | _ { seen_proof := true; proof_term lexbuf } | eof { () } (*s Scans a comment. *) and comment = parse | "(*" { comment lexbuf; comment lexbuf } | "*)" { () } | '"' { let n = string lexbuf in dlines := !dlines + n; seen_comment := true; comment lexbuf } | '\n' { newline (); comment lexbuf } | space+ | stars { comment lexbuf } | character | _ { seen_comment := true; comment lexbuf } | eof { () } (*s The entry [string] reads a string until its end and returns the number of newlines it contains. *) and string = parse | '"' { 0 } | '\\' ('\\' | 'n' | '"') { string lexbuf } | '\n' { succ (string lexbuf) } | _ { string lexbuf } | eof { 0 } (*s The following entry [read_header] is used to skip the possible header at the beginning of files (unless option \texttt{-e} is specified). It stops whenever it encounters an empty line or any character outside a comment. In this last case, it correctly resets the lexer position on that character (decreasing [lex_curr_pos] by 1). *) and read_header = parse | "(*" { skip_comment lexbuf; skip_until_nl lexbuf; read_header lexbuf } | "\n" { () } | space+ { read_header lexbuf } | _ { lexbuf.lex_curr_pos <- lexbuf.lex_curr_pos - 1 } | eof { () } and skip_comment = parse | "*)" { () } | "(*" { skip_comment lexbuf; skip_comment lexbuf } | _ { skip_comment lexbuf } | eof { () } and skip_until_nl = parse | '\n' { () } | _ { skip_until_nl lexbuf } | eof { () } (*i*){(*i*) (*s Processing files and channels. *) let process_channel ch = let lb = Lexing.from_channel ch in reset_counters (); if !skip_header then read_header lb; spec lb let process_file f = try let ch = open_in f in process_channel ch; close_in ch; print_file (Some f); update_totals () with | Sys_error s -> flush stdout; eprintf "coqwc: %s: %s\n" f s; flush stderr (*s Parsing of the command line. *) let usage () = prerr_endline "usage: coqwc [options] [files]"; prerr_endline "Options are:"; prerr_endline " -p print percentage of comments"; prerr_endline " -s print only the spec size"; prerr_endline " -r print only the proof size"; prerr_endline " -e (everything) do not skip headers"; exit 1 let rec parse = function | [] -> [] | ("-h" | "-?" | "-help" | "--help") :: _ -> usage () | ("-s" | "--spec-only") :: args -> proof_only := false; spec_only := true; parse args | ("-r" | "--proof-only") :: args -> spec_only := false; proof_only := true; parse args | ("-p" | "--percentage") :: args -> percentage := true; parse args | ("-e" | "--header") :: args -> skip_header := false; parse args | f :: args -> f :: (parse args) (*s Main program. *) let _ = let files = parse (List.tl (Array.to_list Sys.argv)) in if not (!spec_only || !proof_only) then printf " spec proof comments\n"; match files with | [] -> process_channel stdin; print_file None | [f] -> process_file f | _ -> List.iter process_file files; print_totals () (*i*)}(*i*) coq-8.20.0/tools/coqworkmgr/000077500000000000000000000000001466560755400157405ustar00rootroot00000000000000coq-8.20.0/tools/coqworkmgr/coqworkmgr.ml000066400000000000000000000160441466560755400204720ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* s, string_of_inet_addr host ^":"^ string_of_int port | _ -> assert false module Queue : sig type t val is_empty : t -> bool val push : int * party -> t -> unit val pop : t -> int * party val create : unit -> t end = struct type t = (int * party) list ref let create () = ref [] let is_empty q = !q = [] let rec split acc = function | [] -> List.rev acc, [] | (_, { priority = Low }) :: _ as l -> List.rev acc, l | x :: xs -> split (x :: acc) xs let push (_,{ priority } as item) q = if priority = Low then q := !q @ [item] else let high, low = split [] !q in q := high @ (item :: low) let pop q = match !q with x :: xs -> q := xs; x | _ -> assert false end let read_fd fd s ~off ~len = let rec loop () = try Unix.read fd s off len with Unix.Unix_error(Unix.EAGAIN,_,_) -> loop () in loop () let really_read_fd fd s off len = let i = ref 0 in while !i < len do let off = off + !i in let len = len - !i in let r = read_fd fd s ~off ~len in if r = 0 then raise End_of_file; i := !i + r done let raw_input_line fd = try let b = Buffer.create 80 in let s = Bytes.make 1 '\000' in let endl = Bytes.of_string "\n" in let endr = Bytes.of_string "\r" in while Bytes.compare s endl <> 0 do really_read_fd fd s 0 1; if Bytes.compare s endl <> 0 && Bytes.compare s endr <> 0 then Buffer.add_bytes b s; done; Buffer.contents b with Unix.Unix_error _ -> raise End_of_file let accept s = let cs, _ = Unix.accept s in let cout = Unix.out_channel_of_descr cs in set_binary_mode_out cout true; match parse_request (raw_input_line cs) with | Hello p -> { sock=cs; cout; tokens=0; priority=p } | _ -> (try Unix.close cs with _ -> ()); raise End_of_file let parties = ref [] let max_tokens = ref 2 let cur_tokens = ref 0 let queue = Queue.create () let rec allocate n party = let extra = min n (!max_tokens - !cur_tokens) in cur_tokens := !cur_tokens + extra; party.tokens <- party.tokens + extra; answer party (Tokens extra) and de_allocate n party = let back = min party.tokens n in party.tokens <- party.tokens - back; cur_tokens := min (!cur_tokens - back) !max_tokens; eventually_dequeue () and eventually_dequeue () = if Queue.is_empty queue || !cur_tokens >= !max_tokens then () else let req, party = Queue.pop queue in if List.exists (fun { sock } -> sock = party.sock) !parties then allocate req party else eventually_dequeue () let chat s = let party = try List.find (fun { sock } -> sock = s) !parties with Not_found -> Printf.eprintf "Internal error"; exit 1 in try match parse_request (raw_input_line party.sock) with | Get n -> if !cur_tokens < !max_tokens then allocate n party else Queue.push (n,party) queue | TryGet n -> if !cur_tokens < !max_tokens then allocate n party else answer party Noluck | GiveBack n -> de_allocate n party | Ping -> answer party (Pong (!cur_tokens,!max_tokens,Unix.getpid ())); raise End_of_file | Hello _ -> raise End_of_file with Failure _ | ParseError | Sys_error _ | End_of_file -> (try Unix.close party.sock with _ -> ()); parties := List.filter (fun { sock } -> sock <> s) !parties; de_allocate party.tokens party; eventually_dequeue () let check_alive s = match CoqworkmgrApi.connect s with | Some s -> let cout = Unix.out_channel_of_descr s in set_binary_mode_out cout true; output_string cout (print_request (Hello Low)); flush cout; output_string cout (print_request Ping); flush cout; begin match Unix.select [s] [] [] 1.0 with | [s],_,_ -> let cin = Unix.in_channel_of_descr s in set_binary_mode_in cin true; begin match parse_response (input_line cin) with | Pong (n,m,pid) -> n, m, pid | _ -> raise Not_found end | _ -> raise Not_found end | _ -> raise Not_found let main () = let args = [ "-j",Arg.Set_int max_tokens, "max number of concurrent jobs"; "-d",Arg.Set debug, "do not detach (debug)"] in let usage = "Prints on stdout an env variable assignment to be picked up by coq\n"^ "instances in order to limit the maximum number of concurrent workers.\n"^ "The default value is 2.\n"^ "Usage:" in Arg.parse args (fun extra -> Arg.usage args ("Unexpected argument "^extra^".\n"^usage)) usage; try let sock = Sys.getenv "COQWORKMGR_SOCK" in if !debug then Printf.eprintf "Contacting %s\n%!" sock; let cur, max, pid = check_alive sock in Printf.printf "COQWORKMGR_SOCK=%s\n%!" sock; Printf.eprintf "coqworkmgr already up and running (pid=%d, socket=%s, j=%d/%d)\n%!" pid sock cur max; exit 0 with Not_found | Failure _ | Invalid_argument _ | Unix.Unix_error _ -> if !debug then Printf.eprintf "No running instance. Starting a new one\n%!"; let master, str = mk_socket_channel () in if not !debug then begin let pid = Unix.fork () in if pid <> 0 then begin Printf.printf "COQWORKMGR_SOCK=%s\n%!" str; exit 0 end else begin ignore(Unix.setsid ()); Unix.close Unix.stdin; Unix.close Unix.stdout; end; end else begin Printf.printf "COQWORKMGR_SOCK=%s\n%!" str; end; Sys.catch_break true; try while true do if !debug then Printf.eprintf "Status: #parties=%d tokens=%d/%d \n%!" (List.length !parties) !cur_tokens !max_tokens; let socks = master :: List.map (fun { sock } -> sock) !parties in let r, _, _ = Unix.select socks [] [] (-1.0) in List.iter (fun s -> if s = master then begin try parties := accept master :: !parties with _ -> () end else chat s) r done; exit 0 with Sys.Break -> if !parties <> [] then begin Printf.eprintf "Some coq processes still need me\n%!"; exit 1; end else exit 0 let () = main () coq-8.20.0/tools/coqworkmgr/coqworkmgr.mli000066400000000000000000000000001466560755400206240ustar00rootroot00000000000000coq-8.20.0/tools/coqworkmgr/coqworkmgrApi.ml000066400000000000000000000106301466560755400211170ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* "low" | High -> "high" let priority_of_string = function | "low" -> Low | "high" -> High | _ -> raise (Invalid_argument "priority_of_string") type request = | Hello of priority | Get of int | TryGet of int | GiveBack of int | Ping type response = | Tokens of int | Noluck | Pong of int * int * int exception ParseError (* make it work with telnet: strip trailing \r *) let strip_r s = let len = String.length s in if s.[len - 1] <> '\r' then s else String.sub s 0 (len - 1) let positive_int_of_string n = try let n = int_of_string n in if n <= 0 then raise ParseError else n with Invalid_argument _ | Failure _ -> raise ParseError let parse_request s = if debug then Printf.eprintf "parsing '%s'\n" s; match Str.split (Str.regexp " ") (strip_r s) with | [ "HELLO"; "LOW" ] -> Hello Low | [ "HELLO"; "HIGH" ] -> Hello High | [ "GET"; n ] -> Get (positive_int_of_string n) | [ "TRYGET"; n ] -> TryGet (positive_int_of_string n) | [ "GIVEBACK"; n ] -> GiveBack (positive_int_of_string n) | [ "PING" ] -> Ping | _ -> raise ParseError let parse_response s = if debug then Printf.eprintf "parsing '%s'\n" s; match Str.split (Str.regexp " ") (strip_r s) with | [ "TOKENS"; n ] -> Tokens (positive_int_of_string n) | [ "NOLUCK" ] -> Noluck | [ "PONG"; n; m; p ] -> let n = try int_of_string n with Failure _ -> raise ParseError in let m = try int_of_string m with Failure _ -> raise ParseError in let p = try int_of_string p with Failure _ -> raise ParseError in Pong (n,m,p) | _ -> raise ParseError let print_request = function | Hello Low -> "HELLO LOW\n" | Hello High -> "HELLO HIGH\n" | Get n -> Printf.sprintf "GET %d\n" n | TryGet n -> Printf.sprintf "TRYGET %d\n" n | GiveBack n -> Printf.sprintf "GIVEBACK %d\n" n | Ping -> "PING\n" let print_response = function | Tokens n -> Printf.sprintf "TOKENS %d\n" n | Noluck -> "NOLUCK\n" | Pong (n,m,p) -> Printf.sprintf "PONG %d %d %d\n" n m p let connect s = try match Str.split (Str.regexp ":") s with | [ h; p ] -> let open Unix in let s = socket PF_INET SOCK_STREAM 0 in connect s (ADDR_INET (inet_addr_of_string h,int_of_string p)); Some s | _ -> None with Unix.Unix_error _ -> None let manager = ref None let option_map f = function None -> None | Some x -> Some (f x) let init p = try let sock = Sys.getenv "COQWORKMGR_SOCK" in manager := option_map (fun s -> let cout = Unix.out_channel_of_descr s in set_binary_mode_out cout true; let cin = Unix.in_channel_of_descr s in set_binary_mode_in cin true; output_string cout (print_request (Hello p)); flush cout; cin, cout) (connect sock) with Not_found | End_of_file -> () let with_manager f g = try match !manager with | None -> f () | Some (cin, cout) -> g cin cout with | ParseError | End_of_file -> manager := None; f () let get n = with_manager (fun () -> n) (fun cin cout -> output_string cout (print_request (Get n)); flush cout; let l = input_line cin in match parse_response l with | Tokens m -> m | _ -> raise (Failure "coqworkmgr protocol error")) let tryget n = with_manager (fun () -> Some n) (fun cin cout -> output_string cout (print_request (TryGet n)); flush cout; let l = input_line cin in match parse_response l with | Tokens m -> Some m | Noluck -> None | _ -> raise (Failure "coqworkmgr protocol error")) let giveback n = with_manager (fun () -> ()) (fun cin cout -> output_string cout (print_request (GiveBack n)); flush cout) coq-8.20.0/tools/coqworkmgr/coqworkmgrApi.mli000066400000000000000000000032361466560755400212740ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* string val priority_of_string : string -> priority (* Default priority *) val default_async_proofs_worker_priority : priority (* Connects to a work manager if any. If no worker manager, then -async-proofs-j and -async-proofs-tac-j are used *) val init : priority -> unit (* blocking *) val get : int -> int (* not blocking *) val tryget : int -> int option val giveback : int -> unit (* Low level *) type request = | Hello of priority | Get of int | TryGet of int | GiveBack of int | Ping type response = | Tokens of int | Noluck | Pong of int * int * int (* cur, max, pid *) val connect : string -> Unix.file_descr option exception ParseError (* Intended to be used with input_line and output_string *) val parse_request : string -> request val parse_response : string -> response val print_request : request -> string val print_response : response -> string coq-8.20.0/tools/coqworkmgr/dune000066400000000000000000000004061466560755400166160ustar00rootroot00000000000000(library (name coqworkmgrlib) (public_name coq-core.coqworkmgrapi) (modules coqworkmgrApi) (wrapped false) (libraries str unix)) (executable (name coqworkmgr) (public_name coqworkmgr) (package coq-core) (modules coqworkmgr) (libraries coqworkmgrlib)) coq-8.20.0/tools/dune000066400000000000000000000016731466560755400144320ustar00rootroot00000000000000(install (section lib) (package coq-core) (files (CoqMakefile.in as tools/CoqMakefile.in))) (install (section libexec) (package coq-core) (files (TimeFileMaker.py as tools/TimeFileMaker.py) (make-one-time-file.py as tools/make-one-time-file.py) (make-both-time-files.py as tools/make-both-time-files.py) (make-both-single-timing-files.py as tools/make-both-single-timing-files.py))) (executable (name coq_makefile) (public_name coq_makefile) (package coq-core) (modules coq_makefile) (libraries coq-core.boot coq-core.lib)) ; Bare-bones mllib/mlpack parser (executable (name ocamllibdep) (public_name ocamllibdep) (package coq-core) (modules ocamllibdep) (libraries unix)) (ocamllex ocamllibdep) (executable (name coqwc) (public_name coqwc) (package coq-core) (modules coqwc) (libraries)) (ocamllex coqwc) (executables (names coq_tex) (public_names coq-tex) (package coq-core) (modules coq_tex) (libraries str)) coq-8.20.0/tools/dune_rule_gen/000077500000000000000000000000001466560755400163605ustar00rootroot00000000000000coq-8.20.0/tools/dune_rule_gen/LICENSE000066400000000000000000000022061466560755400173650ustar00rootroot00000000000000The MIT License Copyright (c) 2016 Jane Street Group, LLC Copyright (c) 2018-2019 Mines ParisTech Copyright (c) 2019-2022 Inria Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal in the Software without restriction, including without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to the following conditions: The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. coq-8.20.0/tools/dune_rule_gen/arg.ml000066400000000000000000000011141466560755400174600ustar00rootroot00000000000000(************************************************************************) (* This file is licensed under The MIT License *) (* See LICENSE for more information *) (************************************************************************) type t = A of string | Path of Path.t let adjust ~lvl = function | A arg -> A arg | Path p -> Path (Path.adjust ~lvl p) let to_string = function A arg -> arg | Path p -> Path.to_string p module List = struct let to_string args = List.map to_string args |> String.concat " " end coq-8.20.0/tools/dune_rule_gen/arg.mli000066400000000000000000000007761466560755400176460ustar00rootroot00000000000000(************************************************************************) (* This file is licensed under The MIT License *) (* See LICENSE for more information *) (************************************************************************) type t = A of string | Path of Path.t (** Similar to [Path.adjust] , noop for [A] case *) val adjust : lvl:int -> t -> t val to_string : t -> string module List : sig val to_string : t list -> string end coq-8.20.0/tools/dune_rule_gen/coq_module.ml000066400000000000000000000057421466560755400210510ustar00rootroot00000000000000(************************************************************************) (* This file is licensed under The MIT License *) (* See LICENSE for more information *) (* (c) MINES ParisTech 2018-2019 *) (* (c) INRIA 2020-2022 *) (* Written by: Emilio Jesús Gallego Arias *) (* Written by: Rudi Grinberg *) (************************************************************************) let with_timing = true type t = { source : Path.t ; prefix : string list ; name : string } let pp fmt { source; prefix; name } = Format.fprintf fmt "@[{%s : %a}@]" (String.concat "." (prefix@[name]) ) Path.pp source let make ~source ~prefix ~name = { source; prefix; name } let source { source; _ } = source let prefix { prefix; _ } = prefix let mod_to_obj ~ext { name; _ } = name ^ ext module Rule_type = struct type native = Disabled | Coqc | CoqNative type t = | Regular of { native : native } let native_coqc = function | Regular { native = Coqc } -> true | Regular { native = CoqNative } | Regular { native = Disabled } -> false end let native_obj_files ~install ~tname { prefix; name; _ } = let base_theory = tname in let native_base = "N" ^ String.concat "_" (base_theory @ prefix @ [name]) in let prefix file = if install then Filename.concat ".coq-native" file else file in [ prefix @@ native_base ^ ".cmi"; prefix @@ native_base ^ ".cmxs" ] let base_obj_files coq_module = [ mod_to_obj coq_module ~ext:".glob" ; mod_to_obj coq_module ~ext:".vos" ; mod_to_obj coq_module ~ext:".vo" ] let obj_files ~tname ~rule coq_module = let native = Rule_type.native_coqc rule in let native_objs = if native then native_obj_files ~tname ~install:false coq_module else [] in let timing_objs = if with_timing then [ mod_to_obj coq_module ~ext:".timing" ] else [] in timing_objs @ native_objs @ base_obj_files coq_module let prefix_to_dir = String.concat Filename.dir_sep let native_install_files ~tname ~rule coq_module = match rule with | Rule_type.Regular { native = CoqNative } | Regular { native = Coqc } -> native_obj_files ~tname ~install:false coq_module , native_obj_files ~tname ~install:true coq_module | Regular { native = Disabled } -> [], [] (* quick/vio woes... it does produce a different set of targets than regular compilation *) let base_install_files coq_module = mod_to_obj coq_module ~ext:".v" :: base_obj_files coq_module let install_files ~tname ~rule coq_module = let src_base = base_install_files coq_module in let src_native, dst_native = native_install_files ~tname ~rule coq_module in let src = src_base @ src_native in let ppath = prefix_to_dir (prefix coq_module) in let dst = List.map (Filename.concat ppath) (src_base @ dst_native) in List.combine src dst let native_obj_files = native_obj_files ~install:false coq-8.20.0/tools/dune_rule_gen/coq_module.mli000066400000000000000000000026261466560755400212200ustar00rootroot00000000000000(************************************************************************) (* This file is licensed under The MIT License *) (* See LICENSE for more information *) (* (c) MINES ParisTech 2018-2019 *) (* (c) INRIA 2020-2022 *) (* Written by: Emilio Jesús Gallego Arias *) (* Written by: Rudi Grinberg *) (************************************************************************) type t val make : source:Path.t -> prefix:string list -> name:string -> t val source : t -> Path.t val prefix : t -> string list val prefix_to_dir : string list -> string (** We support two build modes for now *) module Rule_type : sig type native = Disabled | Coqc | CoqNative type t = | Regular of { native : native } val native_coqc : t -> bool end (** Return the native object files for a module *) val native_obj_files : tname:string list -> t -> string list (** Return the object files for a module *) val obj_files : tname:string list -> rule:Rule_type.t -> t -> string list (** Return pairs of object files and install locations *) val install_files : tname:string list -> rule:Rule_type.t -> t -> (string * string) list val pp : Format.formatter -> t -> unit val with_timing : bool coq-8.20.0/tools/dune_rule_gen/coq_rules.ml000066400000000000000000000276331466560755400207210ustar00rootroot00000000000000(************************************************************************) (* This file is licensed under The MIT License *) (* See LICENSE for more information *) (* (c) MINES ParisTech 2018-2019 *) (* (c) INRIA 2020-2022 *) (* Written by: Emilio Jesús Gallego Arias *) (* Written by: Rudi Grinberg *) (************************************************************************) (* coq_rules: generate dune build rules for Coq's test-suite and stdlib *) (* Originally written by Emilio Jesús Gallego Arias and Rudi Grinberg for Dune's coq_rules.ml , which followed a first coq_dune.exe implementation by Emilio Jesús Gallego Arias *) (* note that this file closely follows Dune's own coq_rules.ml [and eventually they could be merged], hence the license. Other modules such as Arg or Path are straight copies from Dune's *) let _debug = false module FlagUtil = struct let read_plugin_dir () = let plugins_dir = Path.make "plugins" in Sys.readdir (Path.to_string plugins_dir) |> Array.to_list (* XXX: This should go away once we fully use findlib in coqdep; for that, we must depend on the META file and pass -m to coqdep. Left for a future PR. *) let local_plugin_flags () = let plugins_dir = Path.make "plugins" in read_plugin_dir () |> List.map (Path.relative plugins_dir) |> Util.list_concat_map (fun p -> [Arg.A "-I"; Arg.Path p]) let findlib_plugin_fixup p = ["number_string_notation"; "zify"; "tauto"; "ssreflect"; "micromega_core"] @ (List.filter (fun s -> not (String.equal s "syntax" || String.equal s "ssr")) p) (* This can also go when the -I flags are gone, by passing the meta file for coq-core *) (* Use non-local libs for split build *) let findlib_plugin_flags () = let () = Findlib.init () in read_plugin_dir () |> findlib_plugin_fixup |> List.map (fun p -> Findlib.package_directory ("coq-core.plugins."^p)) |> Util.list_concat_map (fun p -> [Arg.A "-I"; Arg.Path (Path.make p)]) let findlib_plugin_flags () = try findlib_plugin_flags () with Fl_package_base.No_such_package (p,_) -> raise (Invalid_argument ("failed to locate Coq plugins in split build mode: " ^ p)) let plugin_flags ~split () = if split then findlib_plugin_flags () else local_plugin_flags () (* Native flag *) let findlib_native_dir () = try Findlib.package_directory ("coq-core.kernel") |> Path.make with Fl_package_base.No_such_package (p,_) -> raise (Invalid_argument ("failed to locate Coq kernel package in split build mode: " ^ p)) let local_native_dir = Path.make "kernel/.kernel.objs/byte" let kernel_cmi_dir ~split () = if split then findlib_native_dir () else local_native_dir end (* dep to vo *) let path_of_dep ~vo_ext dep = let open Coqdeplib.Dep_info in let file = match dep with | Dep.Require dep -> dep ^ vo_ext | Dep.Ml (dep, _ext)-> dep ^ ".cmxs" | Dep.Other dep -> dep in Path.make file (* dep to cmi, this is hacky, cleanup. A better way is to keep a reverse map from files to modules *) let dot_path s = String.equal s "." || String.equal s ".." let not_dot_path s = not (dot_path s) let translate_to_native ~tname dep = let dir = Filename.dirname dep in let components = String.split_on_char '/' dep |> List.filter not_dot_path in let name = String.concat "_" (tname @ components) in Filename.concat dir ("N" ^ name ^ ".cmi") (* Case for prelude.vo *) let not_dot_path_or_coqlib s = not (dot_path s) && not (String.equal "theories" s) let translate_boot_to_native dep = let dep = Path.to_string dep |> Filename.remove_extension in let dir = Filename.dirname dep in let components = String.split_on_char '/' dep |> List.filter not_dot_path_or_coqlib in let name = String.concat "_" ("Coq"::components) in Filename.concat dir ("N" ^ name ^ ".cmi") |> Path.make let cmi_of_dep ~tname dep = let open Coqdeplib.Dep_info in let file = match dep with | Dep.Require dep -> Some (translate_to_native ~tname dep) | Dep.Ml (_dep, _ext)-> None | Dep.Other _ -> None in Option.map Path.make file module Theory = struct (** A theory binding; directories should be relative to Coq's sources root *) type t = { directory : Path.t (** Directory of the theory *) ; dirname: string list (** Coq's logical path *) ; implicit : bool (** Use -R or -Q *) } let args { directory; dirname; implicit } = let barg = if implicit then "-R" else "-Q" in Arg.[ A barg; Path directory; A (String.concat "." dirname) ] end (** [Regular theory] contains the info about the stdlib theory, see documentation in the .mli file *) module Boot_type = struct type t = Stdlib | NoInit | Regular of Theory.t end (* Context for a Coq theory *) module Context = struct module Flags = struct type t = { user : Arg.t list ; loadpath : Arg.t list ; common : Arg.t list ; native_common : Arg.t list ; native_coqc : Arg.t list } end type t = { theory : Theory.t ; flags : Flags.t (* flags *) ; rule : Coq_module.Rule_type.t (* rule kind *) ; boot : Boot_type.t (* type of library *) ; dep_info : Dep_info.t ; async_deps : string list (* whether coqc needs the workers *) ; root_lvl : int } let native_common ~split () = let path_coq_kernel_cmi = FlagUtil.kernel_cmi_dir ~split () in [ Arg.A "-nI"; Path path_coq_kernel_cmi ; A "-native-output-dir"; A "." ] let native_coqc ~native_common ~native = let native_string = if native then "on" else "off" in (if native then native_common else []) @ Arg.[ A "-w"; A "-deprecated-native-compiler-option" ; A "-native-compiler"; A native_string ] (* XXX: we could put the workers here, but they need a complete OCaml runtime so this is better *) let build_async_deps = ["(package coq-core)"] (* args are for coqdep *) let build_dep_info ~coqdep_args dir_info = Dep_info.make ~args:coqdep_args ~dir_info let make ~root_lvl ~theory ~user_flags ~boot ~rule ~async ~dir_info ~split = let flags = (* both coqdep and coqc need the -I flags, coqc otherwise doesn't use the legacy plugin resolution method *) let plugin_flags = FlagUtil.plugin_flags ~split () in let boot_paths = match boot with | Boot_type.NoInit -> [] | Stdlib -> Theory.args theory | Regular stdlib -> Theory.args stdlib @ Theory.args theory in let loadpath = Arg.(A "-boot") :: boot_paths @ plugin_flags in let native_common = native_common ~split () in let native_coqc = native_coqc ~native_common ~native:(Coq_module.Rule_type.native_coqc rule) in let common = Arg.[ A "-w"; A "+default"; A "-q" ] in { Flags.user = user_flags; common; loadpath; native_common; native_coqc } in (* coqdep and dep info *) let coqdep_args = flags.loadpath in let dep_info = build_dep_info ~coqdep_args dir_info in let async_deps = if async then build_async_deps else [] in { theory; flags; rule; boot; dep_info; async_deps; root_lvl } end (* Return flags and deps to inject *) let prelude_path = "Init/Prelude.vo" (* Return extra flags and deps for a concrete file; the case of interest is to determine when a file needs [-nonit]. If it doesn't, we must inject the [Init/Prelude] dependency. Note that we can't compute this in Context.make due to the per-file check for "Init" *) let boot_module_setup ~cctx coq_module = match cctx.Context.boot with | Boot_type.NoInit -> [Arg.A "-noinit"], [] | Stdlib -> (match Coq_module.prefix coq_module with | ["Init"] -> [ Arg.A "-noinit" ], [] | _ -> [ ], [ Path.relative (Path.make "theories") prelude_path ] ) | Regular stdlib -> [], [ Path.relative stdlib.directory prelude_path ] (* rule generation for a module *) let module_rule ~(cctx : Context.t) coq_module = let tname, rule = cctx.theory.dirname, cctx.rule in (* retrieve deps *) let vfile = Coq_module.source coq_module in let vo_ext = ".vo" in let vfile_deps = Dep_info.lookup ~dep_info:cctx.dep_info vfile |> List.map (path_of_dep ~vo_ext) in (* handle -noinit, inject prelude.vo if needed *) let boot_flags, boot_deps = boot_module_setup ~cctx coq_module in let coqc_flags = cctx.flags.loadpath @ cctx.flags.user @ cctx.flags.common @ cctx.flags.native_coqc in let vfile_deps, flags = boot_deps @ vfile_deps, boot_flags @ coqc_flags in let vfile_base = Path.basename vfile in let timeflags = if Coq_module.with_timing then Arg.[A "-time-file"; Path Path.(replace_ext vfile ~ext:".timing")] else [] in (* Adjust paths *) let lvl = cctx.root_lvl + (Coq_module.prefix coq_module |> List.length) in let flags = (* flags are relative to the root path *) Arg.List.to_string (flags @ timeflags) in let deps = List.map (Path.adjust ~lvl) vfile_deps |> List.map Path.to_string in (* Depend on the workers if async *) let deps = cctx.async_deps @ deps in (* Build rule *) let updir = Path.(to_string (adjust ~lvl (make "."))) in let action = Format.asprintf "(chdir %s (run coqc %s %%{dep:%s}))" updir flags vfile_base in let targets = Coq_module.obj_files ~tname ~rule coq_module in let alias = None in { Dune_file.Rule.targets; deps; action; alias } (* Helper for Dir_info to Subdir *) let gen_rules ~dir_info ~cctx ~f = let f ~prefix sub_acc mods = let subdir = Coq_module.prefix_to_dir prefix in let payload = List.map (f ~cctx) mods in Dune_file.Subdir.{ subdir; payload } :: List.concat sub_acc in Dir_info.fold ~f ~init:[] dir_info (* Has to be called in the current dir *) let vo_rules ~dir_info ~cctx = gen_rules ~dir_info ~cctx ~f:module_rule (* rule generation for .vo -> .{cmi,cmxs} *) let coqnative_module_rule ~(cctx: Context.t) coq_module = let tname = cctx.theory.dirname in (* deps *) let vfile = Coq_module.source coq_module in let vofile_deps = Dep_info.lookup ~dep_info:cctx.dep_info vfile |> Util.pmap (cmi_of_dep ~tname) in (* base [maybe this should go to coq_module] *) let vofile_base = Path.(replace_ext ~ext:".vo" vfile |> basename) in (* handle -noinit, inject prelude.vo if needed *) let boot_flags, boot_deps = boot_module_setup ~cctx coq_module in (* Improve this code *) let boot_deps = List.map translate_boot_to_native boot_deps in (* Should we pass user and common flags here? They are ignored as of today so we don't *) let flags = boot_flags @ cctx.flags.loadpath @ cctx.flags.native_common in let vofile_deps = boot_deps @ vofile_deps in (* Adjust paths *) let lvl = cctx.root_lvl + (Coq_module.prefix coq_module |> List.length) in let flags = (* flags are relative to the root path *) Arg.List.to_string flags in let deps = List.map (Path.adjust ~lvl) vofile_deps |> List.map Path.to_string in (* Build rule *) let updir = Path.(to_string (adjust ~lvl (make "."))) in let action = Format.asprintf "(chdir %s (run coqnative %s %s))" updir flags vofile_base in let targets = Coq_module.native_obj_files ~tname coq_module in let deps = vofile_base :: deps in let alias = None in { Dune_file.Rule.targets; deps; action; alias } let coqnative_rules ~dir_info ~cctx = gen_rules ~dir_info ~cctx ~f:coqnative_module_rule let install_rule ~(cctx : Context.t) coq_module = let tname, rule, package = cctx.theory.dirname, cctx.rule, cctx.theory.directory in let dst_base = Filename.concat "coq" (Path.to_string package) in let files = Coq_module.install_files ~tname ~rule coq_module |> List.map (fun (src,dst) -> src, Filename.concat dst_base dst) in (* May need to woraround invalid empty `(install )` stanza if that happens *) Dune_file.Install.{ section = "lib_root"; package = "coq-stdlib"; files } let install_rules ~dir_info ~cctx = gen_rules ~dir_info ~cctx ~f:install_rule coq-8.20.0/tools/dune_rule_gen/coq_rules.mli000066400000000000000000000044511466560755400210630ustar00rootroot00000000000000(************************************************************************) (* This file is licensed under The MIT License *) (* See LICENSE for more information *) (* (c) MINES ParisTech 2018-2019 *) (* (c) INRIA 2020-2022 *) (* Written by: Emilio Jesús Gallego Arias *) (* Written by: Rudi Grinberg *) (************************************************************************) module Theory : sig (** A theory binding; directories should be relative to Coq's sources root *) type t = { directory : Path.t (** Directory of the theory *) ; dirname: string list (** Coq's logical path *) ; implicit : bool (** Use -R or -Q *) } end (** theory kind *) module Boot_type : sig type t = Stdlib (** Standard library *) | NoInit (** Standalone library (without Coq's stdlib, for example the prelude) *) | Regular of Theory.t (** Regular library, qualified with -Q, path controls where the Coq stdlib is *) end module Context : sig type t (** *) val make : root_lvl:int -> theory:Theory.t -> user_flags:Arg.t list -> boot:Boot_type.t -> rule:Coq_module.Rule_type.t (* quick, native, etc... *) -> async:bool -> dir_info:Coq_module.t Dir_info.t (* contents of the directory scan *) -> split:bool (* whether we are building coq-core + coq-stdlib or only coq-stdlib *) -> t end (** [gen_vo_rules root_lvl rule flags tname boot] Builds dune rules for the *current* directory, assuming that we will do [-R . tname]. The parameter [boot] controls the kind of the current theory. [root_lvl] tells the rule generator how many levels up the root Coq sources are. [flags] add extra flags to coqc, such as `-async on` *) val vo_rules : dir_info :Coq_module.t Dir_info.t -> cctx:Context.t -> Dune_file.Rule.t list Dune_file.Subdir.t list val coqnative_rules : dir_info :Coq_module.t Dir_info.t -> cctx:Context.t -> Dune_file.Rule.t list Dune_file.Subdir.t list val install_rules : dir_info :Coq_module.t Dir_info.t -> cctx:Context.t -> Dune_file.Install.t list Dune_file.Subdir.t list coq-8.20.0/tools/dune_rule_gen/dep_info.ml000066400000000000000000000037601466560755400205030ustar00rootroot00000000000000(************************************************************************) (* This file is licensed under The MIT License *) (* See LICENSE for more information *) (************************************************************************) module CD = Coqdeplib module Dep_map = Map.Make(Path) type t = CD.Dep_info.Dep.t list Dep_map.t (* What a pita OCaml's stdlib missing basic stuff ... *) let from_list l = List.fold_left (fun map { CD.Dep_info.name; deps } -> let name = Path.make name in let path = Path.add_extension ~ext:".v" name in Dep_map.add path deps map) Dep_map.empty l let debug_coqdep = false let debug = false let coqdep_register_file file = (* if debug then Format.eprintf "cd regfile: %s@\n%!" file; *) CD.Common.treat_file_command_line (Path.to_string file) (* From dir info + context *) let make ~args ~(dir_info : _ Dir_info.t) = let args = "-dyndep" :: "opt" :: List.map Arg.to_string args in if debug_coqdep then Format.eprintf "coqdep: %s@\n%!" (String.concat " " args); let args = Coqdeplib.Args.parse (Coqdeplib.Args.make ()) args in (* We are sane w.r.t. path separators *) let make_separator_hack = false in let st = CD.Common.init ~make_separator_hack args in let () = Dir_info.iter dir_info ~f:(fun ~prefix:_ files -> let files = List.map Coq_module.source files in List.iter coqdep_register_file files) in CD.Common.compute_deps st |> from_list let lookup ~dep_info file = if debug then Format.eprintf "lookup: %a@\n%!" Path.pp file; let file = Path.coqdep_fixup_dir file in Dep_map.find file dep_info let pp_binding fmt (s, _) = Format.fprintf fmt "%a" Path.pp s let lookup ~dep_info x = try lookup ~dep_info x with | Not_found -> if debug then begin Format.eprintf "@[%a@]@\n%!" (Format.pp_print_list pp_binding) (Dep_map.bindings dep_info); Format.eprintf "@[dep: %a@\n%!@]" Path.pp x end; raise Not_found coq-8.20.0/tools/dune_rule_gen/dep_info.mli000066400000000000000000000011361466560755400206470ustar00rootroot00000000000000(************************************************************************) (* This file is licensed under The MIT License *) (* See LICENSE for more information *) (************************************************************************) type t (** [make ~cctx:args ~base_dir ~dir_info] compute dependency information for Coq modules in [dir_info] *) val make : args:Arg.t list -> dir_info:Coq_module.t Dir_info.t -> t (** [lookup di filename] return deps of filename *) val lookup : dep_info:t -> Path.t -> Coqdeplib.Dep_info.Dep.t list coq-8.20.0/tools/dune_rule_gen/dir_info.ml000066400000000000000000000047321466560755400205110ustar00rootroot00000000000000(************************************************************************) (* This file is licensed under The MIT License *) (* See LICENSE for more information *) (************************************************************************) let debug = false (* Information about a directory containing .v files *) type 'a t = { prefix : string list (** prefix of the directory, [] when root *) ; children : 'a t list (** List of children, this could be scanned lazily *) ; modules : 'a list (** modules [without the .v suffix] *) } (* Scan a single directory *) let to_module ~dir ~prefix file = let source = Path.make (Filename.concat dir file) in let name = Filename.remove_extension file in Coq_module.make ~source ~prefix ~name let scan_dir ~prefix dir = let contents = Sys.readdir dir |> Array.to_list in let dirs, files = List.partition (fun f -> Filename.concat dir f |> Sys.is_directory) contents in let files = List.filter (fun f -> Filename.(check_suffix (concat dir f) ".v")) files in let modules = List.map (to_module ~dir ~prefix) files in dirs, modules (* Scan a tree *) let rec scan_subtree ~base_dir ~prefix children = let prefix = prefix @ [children] in scan ~prefix (Filename.concat base_dir children) and scan ~prefix base_dir = if debug then Format.eprintf "[debug] [scan] Enter: %s @\n%!" base_dir; let children, modules = scan_dir ~prefix base_dir in let children = List.map (scan_subtree ~base_dir ~prefix) children in { prefix; children; modules } let rec map ~(f : prefix:string list -> 'a -> 'b) di = { di with children = List.map (map ~f) di.children ; modules = List.map (f ~prefix:di.prefix) di.modules } let rec iter ~(f : prefix:string list -> 'a -> unit) di : unit = f ~prefix:di.prefix di.modules; List.iter (iter ~f) di.children let rec fold ~(f : prefix:string list -> 'b list -> 'a list -> 'b) ~init di = let res = List.map (fold ~f ~init) di.children in f ~prefix:di.prefix res di.modules let rec coq_modules { modules; children; _ } = modules @ List.concat (List.map coq_modules children) (* let rec fold ~(f : prefix:string list -> 'a -> 'b) di = *) let rec pp pp_module fmt { prefix; children; modules } = let open Format in fprintf fmt "@[ { prefix = %a; children = %a; modules = %a }@]" (pp_print_list pp_print_string) prefix (pp_print_list (pp pp_module)) children (pp_print_list pp_module) modules let pp = pp Coq_module.pp coq-8.20.0/tools/dune_rule_gen/dir_info.mli000066400000000000000000000017761466560755400206670ustar00rootroot00000000000000(************************************************************************) (* This file is licensed under The MIT License *) (* See LICENSE for more information *) (************************************************************************) (** Recursive scan of a directory *) type 'a t (** [scan ~prefix dir] scan for coq modules in dir [prefix] will inject a dir *) val scan : prefix:string list -> string -> Coq_module.t t (** [iter ~f dir_info] iterate contents, [prefix] denotes the sub-tree we are in *) val iter : f:(prefix:string list -> 'a list -> unit) -> 'a t -> unit (** [fold ~f ~init dir_info] fold over each folder's contents *) val fold : f:(prefix:string list -> 'b list -> 'a list -> 'b) -> init:'b -> 'a t -> 'b (** Flatten the list of objects of a recursive scan *) val coq_modules : 'a t -> 'a list val pp : Format.formatter -> Coq_module.t t -> unit (* To remove *) val map : f:(prefix:string list -> 'a -> 'b) -> 'a t -> 'b t coq-8.20.0/tools/dune_rule_gen/dune000066400000000000000000000003441466560755400172370ustar00rootroot00000000000000(library (name coq_dune) (modules :standard \ gen_rules) (flags :standard -w +a-40-42) (libraries coqdeplib findlib)) (executable (name gen_rules) (modules gen_rules) (flags :standard -w +a-40-42) (libraries coq_dune)) coq-8.20.0/tools/dune_rule_gen/dune_file.ml000066400000000000000000000033011466560755400206410ustar00rootroot00000000000000(************************************************************************) (* This file is licensed under The MIT License *) (* See LICENSE for more information *) (************************************************************************) module F = Format type 'a pp = Format.formatter -> 'a -> unit module Rule = struct type t = { targets : string list ; deps : string list ; action : string ; alias : string option } let pp_sep fmt () = F.fprintf fmt "@;" let ppl = F.pp_print_list ~pp_sep F.pp_print_string let pp_alias fmt = function | None -> () | Some alias -> F.fprintf fmt "(alias %s)@\n" alias let pp fmt { alias; targets; deps; action } = F.fprintf fmt "@[(rule@\n @[%a(targets @[%a@])@\n(deps @[%a@])@\n(action @[%a@])@])@]@\n" pp_alias alias ppl targets ppl deps F.pp_print_string action end module Install = struct type t = { section : string ; package : string ; files : (string * string) list (* (source as target) *) } let pp_install_file fmt (source, target) = F.fprintf fmt "(%s as %s)" source target let pp fmt { section; package; files } = F.fprintf fmt "@[(install@\n @[(section @[%s@])@\n(package @[%s@])@\n(files @[%a@])@])@]@\n" section package (F.pp_print_list pp_install_file) files end module Subdir = struct type 'a t = { subdir : string; payload : 'a } let pp ppf fmt { subdir; payload } = if String.equal subdir "" then ppf fmt payload else Fun.protect ~finally:(fun () -> F.fprintf fmt "@])@\n") (fun () -> F.fprintf fmt "(subdir %s@\n @[" subdir; ppf fmt payload) end coq-8.20.0/tools/dune_rule_gen/dune_file.mli000066400000000000000000000014141466560755400210150ustar00rootroot00000000000000(************************************************************************) (* This file is licensed under The MIT License *) (* See LICENSE for more information *) (************************************************************************) type 'a pp = Format.formatter -> 'a -> unit module Rule : sig type t = { targets : string list ; deps : string list ; action : string ; alias : string option } val pp : t pp end module Install : sig type t = { section : string ; package : string ; files : (string * string) list (* (source as target) *) } val pp : t pp end module Subdir : sig type 'a t = { subdir : string; payload : 'a } val pp : 'a pp -> 'a t pp end coq-8.20.0/tools/dune_rule_gen/gen_rules.ml000066400000000000000000000063501466560755400207010ustar00rootroot00000000000000open! Coq_dune (* Coqnative overhead is more than 33% in build time :( :( *) (* in a 16-core system: - coqnative: real 2m29,860s user 19m44,997s sys 2m19,618s real 2m30,940s user 20m6,945s sys 2m22,057s - coqc -native-compiler on real 2m30,567s user 14m17,062s sys 1m47,661s real 2m29,008s user 14m15,293s sys 1m48,194s *) (* let native_mode = Coq_module.Rule_type.CoqNative *) let native_mode = Coq_module.Rule_type.Coqc let native = match Coq_config.native_compiler with | Coq_config.NativeOff -> Coq_module.Rule_type.Disabled | Coq_config.NativeOn _ -> native_mode (** arguments are [gen_rules theory_name dir flags] *) let parse_args () = let tname = String.split_on_char '.' Sys.argv.(1) in let base_dir = Sys.argv.(2) in let _backtrace = [Arg.A "-d"; Arg.A "backtrace"] in let default = false, false, Coq_module.Rule_type.Regular { native }, [] in let split, async, rule, user_flags = if Array.length Sys.argv > 3 then match Sys.argv.(3) with | "-async" -> false, true, Coq_module.Rule_type.Regular { native }, Arg.[A "-async-proofs"; A "on"] | "-split" -> true, false, Coq_module.Rule_type.Regular { native }, [] (* Dune will sometimes pass this option as "" *) | "" -> default | opt -> raise (Invalid_argument ("unrecognized option: " ^ opt)) else default in tname, base_dir, async, rule, user_flags, split let ppr fmt = List.iter (Dune_file.Rule.pp fmt) let ppi fmt = List.iter (Dune_file.Install.pp fmt) let main () = let tname, base_dir, async, rule, user_flags, split = parse_args () in let root_lvl = List.length (String.split_on_char '/' base_dir) in let stdlib = let directory = Path.make "theories" in Coq_rules.Theory.{ directory; dirname = ["Coq"]; implicit = true } in (* usually the else case here is Ltac2, but other libraries could be handled as well *) let boot, implicit = if tname = ["Coq"] then Coq_rules.Boot_type.Stdlib, true else Coq_rules.Boot_type.Regular stdlib, false in (* Rule generation *) let dir_info = Dir_info.scan ~prefix:[] base_dir in let directory = Path.make base_dir in let theory = Coq_rules.Theory.{ directory; dirname = tname; implicit } in let cctx = Coq_rules.Context.make ~root_lvl ~theory ~user_flags ~rule ~boot ~dir_info ~async ~split in let vo_rules = Coq_rules.vo_rules ~dir_info ~cctx in let install_rules = Coq_rules.install_rules ~dir_info ~cctx in (* Rule printing *) let fmt = Format.std_formatter in List.iter (Dune_file.Subdir.pp ppr fmt) vo_rules; List.iter (Dune_file.Subdir.pp ppi fmt) install_rules; (* Rules for coqnative (not always setup for now, need to think about this) *) begin match native_mode with (* cmxs files are already generated in coqc *) | Coq_module.Rule_type.Disabled | Coq_module.Rule_type.Coqc -> () | Coq_module.Rule_type.CoqNative -> let coqnative_rules = Coq_rules.coqnative_rules ~dir_info ~cctx in List.iter (Dune_file.Subdir.pp ppr fmt) coqnative_rules end; Format.pp_print_flush fmt (); () let () = Printexc.record_backtrace true; try main () with exn -> let bt = Printexc.get_backtrace () in let exn = Printexc.to_string exn in Format.eprintf "[gen_rules] Fatal error: %s@\n%s@\n%!" exn bt; exit 1 coq-8.20.0/tools/dune_rule_gen/gen_rules.mli000066400000000000000000000000001466560755400210340ustar00rootroot00000000000000coq-8.20.0/tools/dune_rule_gen/path.ml000066400000000000000000000032311466560755400176450ustar00rootroot00000000000000(************************************************************************) (* This file is licensed under The MIT License *) (* See LICENSE for more information *) (************************************************************************) (* We distinguish Path arguments as to adjust for subdirs in Coq theory evaluation *) type t = Rel of string | Abs of string let to_string = function Rel p -> p | Abs p -> p let make path = if Filename.is_relative path then Rel path else Abs path let map ~f = function Rel p -> Rel (f p) | Abs p -> Abs (f p) let fold ~f = function Rel p -> f p | Abs p -> f p let relative dir path = map dir ~f:(fun dir -> Filename.concat dir path) let gen_sub n = String.concat Filename.dir_sep @@ List.init n (fun _ -> "..") let adjust ~lvl = function | Rel path -> Rel (Filename.concat (gen_sub lvl) path) | Abs path -> Abs path let compare p1 p2 = match p1, p2 with | Rel p1, Rel p2 -> String.compare p1 p2 | Abs p1, Abs p2 -> String.compare p1 p2 | Rel _, Abs _ -> -1 | Abs _, Rel _ -> 1 let pp fmt = function | Rel p -> Format.fprintf fmt "%s" p | Abs p -> Format.fprintf fmt "%s" p let basename = fold ~f:Filename.basename let add_extension ~ext = map ~f:(fun p -> p ^ ext) let replace_ext ~ext = map ~f:(fun p -> Filename.remove_extension p ^ ext) (* Coqdep strips files with dirname "." of the basename, so we need to fixup that until we can fix coqdep... [fixing coqdep breaks dune] *) let coqdep_fixup_dir = function | Abs file -> Abs file | Rel file -> match Filename.dirname file with | "." -> Rel (Filename.basename file) | _ -> Rel file coq-8.20.0/tools/dune_rule_gen/path.mli000066400000000000000000000017771466560755400200330ustar00rootroot00000000000000(************************************************************************) (* This file is licensed under The MIT License *) (* See LICENSE for more information *) (************************************************************************) type t (** [make path] build a path from a string *) val make : string -> t (** [relative path s] append [s] to [path] to build [path/s] *) val relative : t -> string -> t (** [basename path] returns the basename *) val basename : t -> string (** [adjust ~lvl path] adjusts a path to refer to [lvl] lower directories, that is to say [adjust ~lvl:2 p] will do [../../p] *) val adjust : lvl:int -> t -> t (** [add_extension ext p] builds [p^ext] *) val add_extension : ext:string -> t -> t val replace_ext : ext:string -> t -> t val to_string : t -> string val compare : t -> t -> int val pp : Format.formatter -> t -> unit (* Hack for coqdep, see comments in the implementation *) val coqdep_fixup_dir : t -> t coq-8.20.0/tools/dune_rule_gen/util.ml000066400000000000000000000030461466560755400176720ustar00rootroot00000000000000(**************************************************************************) (* *) (* OCaml *) (* *) (* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) (* *) (* Copyright 1996 Institut National de Recherche en Informatique et *) (* en Automatique. *) (* *) (* All rights reserved. This file is distributed under the terms of *) (* the GNU Lesser General Public License version 2.1, with the *) (* special exception on linking described in the file LICENSE. *) (* *) (**************************************************************************) (* This file keeps coq_dune self-contained as it is a "bootstrap" utility *) (* Taken from OCaml's stdlib *) (* From OCaml's Stdlib >= 4.10 *) let list_concat_map f l = let rec aux f acc = function | [] -> List.rev acc | x :: l -> let xs = f x in aux f (List.rev_append xs acc) l in aux f [] l let rec pmap f = function | [] -> [] | x :: xs -> match f x with | None -> pmap f xs | Some x -> x :: pmap f xs coq-8.20.0/tools/dune_rule_gen/util.mli000066400000000000000000000002241466560755400200360ustar00rootroot00000000000000(* Utilities missing from stdlib *) val list_concat_map : ('a -> 'b list) -> 'a list -> 'b list val pmap : ('a -> 'b option) -> 'a list -> 'b list coq-8.20.0/tools/make-both-single-timing-files.py000077500000000000000000000015051466560755400216360ustar00rootroot00000000000000#!/usr/bin/env python3 from TimeFileMaker import * if __name__ == '__main__': parser = argparse.ArgumentParser(description=r'''Formats timing information from the output of two invocations of `coqc -time` into a sorted table''') add_sort_by(parser) add_user(parser, single_timing=True) add_fuzz(parser) add_after_file_name(parser) add_before_file_name(parser) add_output_file_name(parser) args = parser.parse_args() left_dict = get_single_file_times(args.AFTER_FILE_NAME, use_real=args.real) right_dict = get_single_file_times(args.BEFORE_FILE_NAME, use_real=args.real) left_dict, right_dict = adjust_fuzz(left_dict, right_dict, fuzz=args.fuzz) table = make_diff_table_string(left_dict, right_dict, tag="Code", sort_by=args.sort_by) print_or_write_table(table, args.OUTPUT_FILE_NAME) coq-8.20.0/tools/make-both-time-files.py000077500000000000000000000015561466560755400200340ustar00rootroot00000000000000#!/usr/bin/env python3 from TimeFileMaker import * if __name__ == '__main__': parser = argparse.ArgumentParser(description=r'''Formats timing information from the output of two invocations of `make TIMED=1` into a sorted table.''') add_sort_by(parser) add_real(parser) add_include_mem(parser) add_sort_by_mem(parser) add_after_file_name(parser) add_before_file_name(parser) add_output_file_name(parser) args = parser.parse_args() left_dict = get_times_and_mems(args.AFTER_FILE_NAME, use_real=args.real, include_mem=args.include_mem) right_dict = get_times_and_mems(args.BEFORE_FILE_NAME, use_real=args.real, include_mem=args.include_mem) table = make_diff_table_string(left_dict, right_dict, sort_by=args.sort_by, include_mem=args.include_mem, sort_by_mem=args.sort_by_mem) print_or_write_table(table, args.OUTPUT_FILE_NAME) coq-8.20.0/tools/make-one-time-file.py000077500000000000000000000012171466560755400174700ustar00rootroot00000000000000#!/usr/bin/env python3 import sys from TimeFileMaker import * if __name__ == '__main__': parser = argparse.ArgumentParser(description=r'''Formats timing information from the output of `make TIMED=1` into a sorted table.''') add_real(parser) add_file_name(parser) add_output_file_name(parser) add_include_mem(parser) add_sort_by_mem(parser) args = parser.parse_args() stats_dict = get_times_and_mems(args.FILE_NAME, use_real=args.real, include_mem=args.include_mem) table = make_table_string(stats_dict, include_mem=args.include_mem, sort_by_mem=args.sort_by_mem) print_or_write_table(table, args.OUTPUT_FILE_NAME) coq-8.20.0/tools/ocamllibdep.mli000066400000000000000000000000001466560755400165110ustar00rootroot00000000000000coq-8.20.0/tools/ocamllibdep.mll000066400000000000000000000207201466560755400165270ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* Buffer.clear s'; for i = 0 to String.length s - 1 do let c = s.[i] in if c = ' ' || c = '#' || c = ':' (* separators and comments *) || c = '%' (* pattern *) || c = '?' || c = '[' || c = ']' || c = '*' (* expansion in filenames *) || i=0 && c = '~' && (String.length s = 1 || s.[1] = '/' || 'A' <= s.[1] && s.[1] <= 'Z' || 'a' <= s.[1] && s.[1] <= 'z') (* homedir expansion *) then begin let j = ref (i-1) in while !j >= 0 && s.[!j] = '\\' do Buffer.add_char s' '\\'; decr j (* escape all preceding '\' *) done; Buffer.add_char s' '\\'; end; if c = '$' then Buffer.add_char s' '$'; Buffer.add_char s' c done; Buffer.contents s' (* Filename.concat but always with a '/' *) let is_dir_sep s i = match Sys.os_type with | "Unix" -> s.[i] = '/' | "Cygwin" | "Win32" -> let c = s.[i] in c = '/' || c = '\\' || c = ':' | _ -> assert false let (//) dirname filename = let l = String.length dirname in if l = 0 || is_dir_sep dirname (l-1) then dirname ^ filename else dirname ^ "/" ^ filename (** [get_extension f l] checks whether [f] has one of the extensions listed in [l]. It returns [f] without its extension, alongside with the extension. When no extension match, [(f,"")] is returned *) let rec get_extension f = function | [] -> (f, "") | s :: _ when Filename.check_suffix f s -> (Filename.chop_suffix f s, s) | _ :: l -> get_extension f l let file_name s = function | None -> s | Some "." -> s | Some d -> d // s type dir = string option let add_directory add_file phys_dir = let open Unix in let files = Sys.readdir phys_dir in Array.iter (fun f -> (* we avoid all files starting by '.' *) if f.[0] <> '.' then let phys_f = if phys_dir = "." then f else phys_dir//f in match try (stat phys_f).st_kind with _ -> S_BLK with | S_REG -> add_file phys_dir f | _ -> ()) files let error_cannot_parse s (i,j) = Printf.eprintf "File \"%s\", characters %i-%i: Syntax error\n" s i j; exit 1 let error_unknown_extension name = Printf.eprintf "Don't know what to do with \"%s\"\n" name; Printf.eprintf "Usage: ocamllibdep [-I dir] [-c] [file.mllib] [file.mlpack]\n"; exit 1 let error_cannot_open msg = Format.eprintf "Error: @[%s@].@\n%!" msg; exit 1 let error_cannot_stat err name = Format.eprintf "Error: @[cannot stat %s (%s)@].@\n%!" name (Unix.error_message err); exit 1 let same_path_opt s s' = let nf s = (* ./foo/a.ml and foo/a.ml are the same file *) if Filename.is_implicit s then "." // s else s in let s = match s with None -> "." | Some s -> nf s in let s' = match s' with None -> "." | Some s' -> nf s' in s = s' let warning_ml_clash x s suff s' suff' = if suff = suff' && not (same_path_opt s s') then eprintf "*** Warning: %s%s already found in %s (discarding %s%s)\n" x suff (match s with None -> "." | Some d -> d) ((match s' with None -> "." | Some d -> d) // x) suff let mkknown () = let h = (Hashtbl.create 19 : (string, dir * string) Hashtbl.t) in let add x s suff = try let s',suff' = Hashtbl.find h x in warning_ml_clash x s' suff' s suff with Not_found -> Hashtbl.add h x (s,suff) and search x = try Some (fst (Hashtbl.find h x)) with Not_found -> None in add, search let add_ml_known, search_ml_known = mkknown () let add_mlpack_known, search_mlpack_known = mkknown () let mllibAccu = ref ([] : (string * dir) list) let mlpackAccu = ref ([] : (string * dir) list) let add_caml_known phys_dir f = let basename,suff = get_extension f [".ml";".mlg";".mlpack"] in match suff with | ".ml"|".mlg" -> add_ml_known basename (Some phys_dir) suff | ".mlpack" -> add_mlpack_known basename (Some phys_dir) suff | _ -> () let add_caml_dir phys_dir = try add_directory add_caml_known phys_dir with | Sys_error msg -> error_cannot_open msg | Unix.Unix_error (e, "stat", a) -> error_cannot_stat e a let treat_file_modules md ext = try let chan = open_in (md ^ ext) in let list = mllib_list (Lexing.from_channel chan) in List.fold_left (fun acc str -> match search_mlpack_known str with | Some mldir -> (file_name str mldir) :: acc | None -> match search_ml_known str with | Some mldir -> (file_name str mldir) :: acc | None -> acc) [] (List.rev list) with | Sys_error _ -> [] | Syntax_error (i,j) -> error_cannot_parse (md^ext) (i,j) let addQueue q v = q := v :: !q let treat_file old_name = let name = Filename.basename old_name in let dirname = Some (Filename.dirname old_name) in match get_extension name [".mllib";".mlpack"] with | (base,".mllib") -> addQueue mllibAccu (base,dirname) | (base,".mlpack") -> addQueue mlpackAccu (base,dirname) | _ -> error_unknown_extension old_name let mllib_dependencies () = List.iter (fun (name,dirname) -> let fullname = file_name name dirname in let deps = treat_file_modules fullname ".mllib" in let sdeps = String.concat " " deps in let efullname = escape fullname in printf "%s_MLLIB_DEPENDENCIES:=%s\n" efullname sdeps; printf "%s.cma:$(addsuffix .cmo,$(%s_MLLIB_DEPENDENCIES))\n" efullname efullname; printf "%s.cmxa:$(addsuffix .cmx,$(%s_MLLIB_DEPENDENCIES))\n" efullname efullname; flush stdout) (List.rev !mllibAccu) let coq_makefile_mode = ref false let print_for_pack modname d = if !coq_makefile_mode then printf "%s.cmx : FOR_PACK=-for-pack %s\n" d modname else printf "%s_FORPACK:= -for-pack %s\n" d modname let mlpack_dependencies () = List.iter (fun (name,dirname) -> let fullname = file_name name dirname in let modname = String.capitalize_ascii name in let deps = treat_file_modules fullname ".mlpack" in let sdeps = String.concat " " deps in let efullname = escape fullname in printf "%s_MLPACK_DEPENDENCIES:=%s\n" efullname sdeps; List.iter (print_for_pack modname) deps; printf "%s.cmo:$(addsuffix .cmo,$(%s_MLPACK_DEPENDENCIES))\n" efullname efullname; printf "%s.cmx:$(addsuffix .cmx,$(%s_MLPACK_DEPENDENCIES))\n" efullname efullname; flush stdout) (List.rev !mlpackAccu) let rec parse = function | "-c" :: r -> coq_makefile_mode := true; parse r | "-I" :: r :: ll -> (* To solve conflict (e.g. same filename in kernel and checker) we allow to state an explicit order *) add_caml_dir r; parse ll | f :: ll -> treat_file f; parse ll | [] -> () let main () = if Array.length Sys.argv < 2 then exit 1; parse (List.tl (Array.to_list Sys.argv)); mllib_dependencies (); mlpack_dependencies () let _ = main () } coq-8.20.0/tools/update-require000077500000000000000000000042541466560755400164340ustar00rootroot00000000000000#!/bin/sh # This script fully qualifies all the 'Require' statements of the given # targets (or the current directory if none). # # It assumes that all the prerequisites are already installed. The # install location is found using the COQLIB, COQC, COQBIN variables if # set, 'coqc' otherwise. # # Option --exclude can be used to ignore a given user contribution. In # particular, it can be used to ignore the current set of files if it # happens to be already installed. # # Option --stdlib can be used to also qualify the files from the standard # library. if test ! "$COQLIB"; then if test ${COQBIN##*/}; then COQBIN=$COQBIN/; fi if test ! "$COQC"; then COQC=`which ${COQBIN}coqc`; fi COQLIB=`"$COQC" -where` fi stdlib=no exclude="" scan_dir () { (cd $1 ; find $3 -name '*.vo' | sed -e "s,^./,$2,;s,\([^./]*\)/,\1.,g;s,\([^.]*\).vo,\1,") } scan_all_dir () { if test $stdlib = yes; then scan_dir "$COQLIB/theories" "Coq." scan_dir "$COQLIB/plugins" "Coq." fi scan_dir "$COQLIB/user-contrib" "" "$exclude" } create_script () { echo "BEGIN {" scan_all_dir | while read file ; do echo $file | sed -e "s,\(.*\)[.]\([^.]*\), t[\"\2\"] = \"\1.\2\"," done cat <&2 exit 1;; *) dir="$dir $1";; esac shift done script=`tempfile` create_script > $script find $dir -name '*.v' | while read file; do mv $file $file.bak awk -f $script $file.bak > $file done coq-8.20.0/topbin/000077500000000000000000000000001466560755400137005ustar00rootroot00000000000000coq-8.20.0/topbin/coqc_bin.ml000066400000000000000000000013331466560755400160070ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* unit val default_root_prefix : DirPath.t val dirpath_of_string : string -> DirPath.t val locate_absolute_library : DirPath.t -> string end = struct let pr_dirpath dp = str (DirPath.to_string dp) let default_root_prefix = DirPath.empty let split_dirpath d = let l = DirPath.repr d in (DirPath.make (List.tl l), List.hd l) type logical_path = DirPath.t let load_paths = ref ([],[] : CUnix.physical_path list * logical_path list) let remove_load_path dir = let physical, logical = !load_paths in load_paths := List.filter2 (fun p d -> p <> dir) physical logical let add_load_path (phys_path,coq_path) = if CDebug.(get_flag misc) then Feedback.msg_notice (str "path: " ++ pr_dirpath coq_path ++ str " ->" ++ spc() ++ str phys_path); let phys_path = CUnix.canonical_path_name phys_path in let physical, logical = !load_paths in match List.filter2 (fun p d -> p = phys_path) physical logical with | _,[dir] -> if coq_path <> dir (* If this is not the default -I . to coqtop *) && not (phys_path = CUnix.canonical_path_name Filename.current_dir_name && coq_path = default_root_prefix) then begin (* Assume the user is concerned by library naming *) if dir <> default_root_prefix then Feedback.msg_warning (str phys_path ++ strbrk " was previously bound to " ++ pr_dirpath dir ++ strbrk "; it is remapped to " ++ pr_dirpath coq_path); remove_load_path phys_path; load_paths := (phys_path::fst !load_paths, coq_path::snd !load_paths) end | _,[] -> load_paths := (phys_path :: fst !load_paths, coq_path :: snd !load_paths) | _ -> anomaly (Pp.str ("Two logical paths are associated to "^phys_path^".")) let load_paths_of_dir_path dir = let physical, logical = !load_paths in fst (List.filter2 (fun p d -> d = dir) physical logical) let locate_absolute_library dir = (* Search in loadpath *) let pref, base = split_dirpath dir in let loadpath = load_paths_of_dir_path pref in if loadpath = [] then CErrors.user_err (str "No loadpath for " ++ DirPath.print pref); let name = Id.to_string base^".vo" in try let _, file = System.where_in_path ~warn:false loadpath name in file with Not_found -> CErrors.user_err (str "File " ++ str name ++ str " not found in loadpath") let dirpath_of_string s = match String.split_on_char '.' s with | [""] -> default_root_prefix | dir -> DirPath.make (List.rev_map Id.of_string dir) end module Library = struct type library_objects type compilation_unit_name = DirPath.t (* The [*_disk] types below must be kept in sync with the vo representation. *) type library_disk = { md_compiled : Safe_typing.compiled_library; md_syntax_objects : library_objects; md_objects : library_objects; } type library_info type summary_disk = { md_name : compilation_unit_name; md_deps : (compilation_unit_name * Safe_typing.vodigest) array; md_ocaml : string; md_info : library_info; } type library_t = { library_name : compilation_unit_name; library_file : string; library_data : Safe_typing.compiled_library; library_deps : (compilation_unit_name * Safe_typing.vodigest) array; library_digests : Safe_typing.vodigest; library_vm : Vmlibrary.on_disk; } let libraries_table : string DPmap.t ref = ref DPmap.empty let register_loaded_library senv libname file = let () = assert (not @@ DPmap.mem libname !libraries_table) in let () = libraries_table := DPmap.add libname file !libraries_table in let prefix = Nativecode.mod_uid_of_dirpath libname ^ "." in let () = Nativecode.register_native_file prefix in senv let mk_library sd f md digests vm = { library_name = sd.md_name; library_file = f; library_data = md; library_deps = sd.md_deps; library_digests = digests; library_vm = vm; } let summary_seg : summary_disk ObjFile.id = ObjFile.make_id "summary" let library_seg : library_disk ObjFile.id = ObjFile.make_id "library" let intern_from_file f = let ch = System.with_magic_number_check (fun file -> ObjFile.open_in ~file) f in let lsd, digest_lsd = ObjFile.marshal_in_segment ch ~segment:summary_seg in let lmd, digest_lmd = ObjFile.marshal_in_segment ch ~segment:library_seg in let vmlib = Vmlibrary.load ~file:f lsd.md_name ch in ObjFile.close_in ch; System.check_caml_version ~caml:lsd.md_ocaml ~file:f; let open Safe_typing in mk_library lsd f lmd.md_compiled (Dvo_or_vi digest_lmd) vmlib let rec intern_library (needed, contents) dir = (* Look if already listed and consequently its dependencies too *) match DPmap.find dir contents with | lib -> lib.library_digests, (needed, contents) | exception Not_found -> let f = Loadpath.locate_absolute_library dir in let m = intern_from_file f in if not (DirPath.equal dir m.library_name) then user_err (str "The file " ++ str f ++ str " contains library" ++ spc () ++ DirPath.print m.library_name ++ spc () ++ str "and not library" ++ spc() ++ DirPath.print dir ++ str "."); let (needed, contents) = intern_library_deps (needed, contents) dir m f in m.library_digests, (dir :: needed, DPmap.add dir m contents) and intern_library_deps libs dir m from = Array.fold_left (intern_mandatory_library dir from) libs m.library_deps and intern_mandatory_library caller from libs (dir,d) = let digest, libs = intern_library libs dir in if not (Safe_typing.digest_match ~actual:digest ~required:d) then user_err (str "Compiled library " ++ DirPath.print caller ++ str " (in file " ++ str from ++ str ") makes inconsistent assumptions \ over library " ++ DirPath.print dir); libs let register_library senv m = let mp = MPfile m.library_name in let mp', senv = Safe_typing.import m.library_data m.library_vm m.library_digests senv in let () = if not (ModPath.equal mp mp') then anomaly (Pp.str "Unexpected disk module name.") in register_loaded_library senv m.library_name m.library_file let save_library_to env dir f lib = let mp = MPfile dir in let ast = Nativelibrary.dump_library mp env lib in let fn = Filename.dirname f ^"/"^ Nativecode.mod_uid_of_dirpath dir in Nativelib.compile_library ast fn let get_used_load_paths () = String.Set.elements (DPmap.fold (fun m f acc -> String.Set.add (Filename.dirname f) acc) !libraries_table String.Set.empty) let _ = Nativelib.get_load_paths := get_used_load_paths end let add_path ~unix_path:dir ~coq_root:coq_dirpath = let open System in if exists_dir dir then begin Loadpath.add_load_path (dir,coq_dirpath) end else Feedback.msg_warning (str "Cannot open " ++ str dir) let convert_string d = try Id.of_string d with CErrors.UserError _ -> Flags.if_verbose Feedback.msg_warning (str "Directory " ++ str d ++ str " cannot be used as a Coq identifier (skipped)"); raise_notrace Exit let coq_root = Id.of_string "Coq" let add_rec_path ~unix_path ~coq_root = let open System in if exists_dir unix_path then let dirs = all_subdirs ~unix_path in let prefix = DirPath.repr coq_root in let convert_dirs (lp, cp) = try let path = List.rev_map convert_string cp @ prefix in Some (lp, Names.DirPath.make path) with Exit -> None in let dirs = List.map_filter convert_dirs dirs in List.iter Loadpath.add_load_path dirs; Loadpath.add_load_path (unix_path, coq_root) else Feedback.msg_warning (str "Cannot open " ++ str unix_path) let init_load_path_std () = let env = Boot.Env.init () in let stdlib = Boot.Env.stdlib env |> Boot.Path.to_string in let user_contrib = Boot.Env.user_contrib env |> Boot.Path.to_string in let xdg_dirs = Envars.xdg_dirs in let coqpath = Envars.coqpath in (* NOTE: These directories are searched from last to first *) (* first standard library *) add_rec_path ~unix_path:stdlib ~coq_root:(Names.DirPath.make[coq_root]); (* then user-contrib *) if Sys.file_exists user_contrib then add_rec_path ~unix_path:user_contrib ~coq_root:Loadpath.default_root_prefix; (* then directories in XDG_DATA_DIRS and XDG_DATA_HOME *) List.iter (fun s -> add_rec_path ~unix_path:s ~coq_root:Loadpath.default_root_prefix) (xdg_dirs ~warn:(fun x -> Feedback.msg_warning (str x))); (* then directories in COQPATH *) List.iter (fun s -> add_rec_path ~unix_path:s ~coq_root:Loadpath.default_root_prefix) coqpath let init_load_path ~boot ~vo_path = if not boot then init_load_path_std (); (* always add current directory *) add_path ~unix_path:"." ~coq_root:Loadpath.default_root_prefix; (* additional loadpath, given with -R/-Q options *) List.iter (fun (unix_path, coq_root) -> add_rec_path ~unix_path ~coq_root) (List.rev vo_path) let fb_handler = function | Feedback.{ contents; _ } -> match contents with | Feedback.Message(_lvl,_loc,msg)-> Format.printf "%s@\n%!" Pp.(string_of_ppcmds msg) | _ -> () let init_coq () = let senv = Safe_typing.empty_environment in let senv = Safe_typing.set_native_compiler true senv in let () = Safe_typing.allow_delayed_constants := false in let dummy = Names.DirPath.make [Names.Id.of_string_soft "@native"] in let _, senv = Safe_typing.start_library dummy senv in senv let compile senv ~in_file = let lib = Library.intern_from_file in_file in let dir = lib.Library.library_name in (* Require the dependencies **only once** *) let deps, contents = Library.intern_library_deps ([], DPmap.empty) dir lib in_file in let fold senv dep = Library.register_library senv (DPmap.find dep contents) in let senv = List.fold_left fold senv (List.rev deps) in (* Extract the native code and compile it *) let modl = (Safe_typing.module_of_library lib.Library.library_data).Declarations.mod_type in let out_vo = Filename.(remove_extension in_file) ^ ".vo" in Library.save_library_to (Safe_typing.env_of_safe_env senv) dir out_vo modl module Usage : sig val usage : unit -> 'a end = struct let print_usage_channel co command = output_string co command; output_string co "coqnative options are:\n"; output_string co " -Q dir coqdir map physical dir to logical coqdir\ \n -R dir coqdir synonymous for -Q\ \n\ \n\ \n -boot boot mode\ \n -coqlib dir set coqnative's standard library location\ \n -native-output-dir set the output directory for native objects\ \n -nI dir OCaml include directories for the native compiler (default if not set) \ \n\ \n -h, --help print this list of options\ \n" (* print the usage on standard error *) let print_usage = print_usage_channel stderr let print_usage_coqnative () = print_usage "Usage: coqnative file\n\n" let usage () = print_usage_coqnative (); flush stderr; exit 1 end type opts = { boot : bool; vo_path : (string * DirPath.t) list; ml_path : string list; } let rec parse_args (args : string list) accu = match args with | [] -> CErrors.user_err (Pp.str "parse args error: missing argument") | "-boot" :: rem -> parse_args rem { accu with boot = true} (* We ignore as we don't require Prelude explicitly *) | "-noinit" :: rem -> parse_args rem accu | ("-Q" | "-R") :: d :: p :: rem -> let p = Loadpath.dirpath_of_string p in let accu = { accu with vo_path = (d, p) :: accu.vo_path } in parse_args rem accu | "-I" :: _d :: rem -> (* Ignore *) parse_args rem accu | "-nI" :: dir :: rem -> let accu = { accu with ml_path = dir :: accu.ml_path } in parse_args rem accu |"-native-output-dir" :: dir :: rem -> Nativelib.output_dir := dir; parse_args rem accu | "-coqlib" :: s :: rem -> if not (System.exists_dir s) then fatal_error (str "Directory '" ++ str s ++ str "' does not exist") false; Boot.Env.set_coqlib s; parse_args rem accu | ("-?"|"-h"|"-H"|"-help"|"--help") :: _ -> Usage.usage () | [file] -> accu, file | args -> let args_msg = String.concat " " args in CErrors.user_err Pp.(str "parse args error, too many arguments: " ++ str args_msg) let () = let _ = Feedback.add_feeder fb_handler in try let opts = { boot = false; vo_path = []; ml_path = [] } in let opts, in_file = parse_args (List.tl @@ Array.to_list Sys.argv) opts in let () = init_load_path ~boot:opts.boot ~vo_path:(List.rev opts.vo_path) in let () = Nativelib.include_dirs := List.rev opts.ml_path in let senv = init_coq () in compile senv ~in_file with exn -> Format.eprintf "Error: @[%a@]@\n%!" Pp.pp_with (CErrors.print exn); let exit_code = if (CErrors.is_anomaly exn) then 129 else 1 in exit exit_code coq-8.20.0/topbin/coqnative_bin.mli000066400000000000000000000000001466560755400172120ustar00rootroot00000000000000coq-8.20.0/topbin/coqtop_bin.ml000066400000000000000000000013561466560755400163740ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* Some (Pp.str (Format.asprintf "%a" Symtable.report_error e)) | _ -> None ) (* Another bit of text is printed in the [include_utilities] file, so the default one is not need *) let () = Clflags.noversion := true let load_module fmt name = if not ((Topdirs.load_file [@ocaml.warning "-3"]) fmt name) then CErrors.user_err Pp.(str ("Could not load plugin " ^ name)) let load_plugin fmt ps = match Mltop.PluginSpec.repr ps with | (Some file, _) -> let file = file ^ ".cma" in load_module fmt file | (None, lib ) -> Topfind.load_deeply [lib] let ml_loop fmt ?init_file () = let init_file = ref init_file in Toploop.add_hook (fun event -> if event = Toploop.After_setup then begin match !init_file with | None -> () | Some f -> init_file := None; (* Run the initialization file only once *) ignore (Coq_byte_config.toploop_use_silently fmt f) end ); Coq_byte_config.compenv_handle_exit_with_status_0 (fun () -> Toploop.loop fmt) let drop_setup () = let ppf = Format.std_formatter in Mltop.set_top { load_plugin = load_plugin ppf ; load_module = load_module ppf ; add_dir = Topdirs.dir_directory ; ml_loop = ml_loop ppf } (* Main coqtop initialization *) let _ = drop_setup (); Coqtop.(start_coq coqtop_toplevel) coq-8.20.0/topbin/coqtop_byte_bin.mli000066400000000000000000000000001466560755400175510ustar00rootroot00000000000000coq-8.20.0/topbin/coqworker_bin.ml000066400000000000000000000025201466560755400170750ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* WProof.init_stdout, WProof.main_loop | "--kind=query" -> WQuery.init_stdout, WQuery.main_loop | "--kind=tactic" -> WTactic.init_stdout, WTactic.main_loop | s -> error s () in WorkerLoop.start ~init ~loop coq-8.20.0/topbin/coqworker_bin.mli000066400000000000000000000000001466560755400172350ustar00rootroot00000000000000coq-8.20.0/topbin/dune000066400000000000000000000020361466560755400145570ustar00rootroot00000000000000(executable (name coqtop_bin) (public_name coqtop) (package coq-core) (modules coqtop_bin) (libraries coq-core.toplevel)) (executable (name coqtop_byte_bin) (public_name coqtop.byte) (package coq-core) (modules coqtop_byte_bin) (libraries compiler-libs.toplevel coq-core.config.byte coq-core.toplevel coq-core.dev findlib.top) (modes byte)) (executable (name coqc_bin) (public_name coqc) (package coq-core) (modules coqc_bin) (libraries coq-core.toplevel)) ; Adding -ccopt -flto to links options could be interesting, however, ; it doesn't work on Windows (executable (name coqc_byte_bin) (public_name coqc.byte) (package coq-core) (modules coqc_byte_bin) (libraries coq-core.toplevel) (modes byte)) (executable (name coqnative_bin) (public_name coqnative) (package coq-core) (modules coqnative_bin) (libraries coq-core.kernel) (modes exe byte) (link_flags -linkall)) ; Workers (executable (name coqworker_bin) (public_name coqworker.opt) (package coq-core) (modules coqworker_bin) (libraries coq-core.toplevel)) coq-8.20.0/toplevel/000077500000000000000000000000001466560755400142375ustar00rootroot00000000000000coq-8.20.0/toplevel/ccompile.ml000066400000000000000000000122031466560755400163620ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* false | NativeOn {ondemand} -> not ondemand in let mode = copts.compilation_mode in let ext_in, ext_out = match mode with | BuildVo -> ".v", ".vo" | BuildVos -> ".v", ".vos" | BuildVok -> ".v", ".vok" in let long_f_dot_in, long_f_dot_out = ensure_exists_with_prefix ~src:f_in ~tgt:f_out ~src_ext:ext_in ~tgt_ext:ext_out in let dump_empty_vos () = let long_f_dot_vos = (safe_chop_extension long_f_dot_out) ^ ".vos" in create_empty_file long_f_dot_vos in let dump_empty_vok () = let long_f_dot_vok = (safe_chop_extension long_f_dot_out) ^ ".vok" in create_empty_file long_f_dot_vok in match mode with | BuildVo | BuildVok -> let doc, sid = Topfmt.(in_phase ~phase:LoadingPrelude) Stm.new_doc Stm.{ doc_type = VoDoc long_f_dot_out; injections; } in let state = { doc; sid; proof = None; time = Option.map Vernac.make_time_output opts.config.time } in let state = Load.load_init_vernaculars opts ~state in let ldir = Stm.get_ldir ~doc:state.doc in Aux_file.(start_aux_file ~aux_file:(aux_file_name_for long_f_dot_out) ~v_file:long_f_dot_in); Dumpglob.push_output copts.glob_out; Dumpglob.start_dump_glob ~vfile:long_f_dot_in ~vofile:long_f_dot_out; Dumpglob.dump_string ("F" ^ Names.DirPath.to_string ldir ^ "\n"); let wall_clock1 = Unix.gettimeofday () in let check = Stm.AsyncOpts.(stm_options.async_proofs_mode = APoff) in let source = source ldir long_f_dot_in in let state = Vernac.load_vernac ~echo ~check ~state ~source long_f_dot_in in let fullstate = Stm.finish ~doc:state.doc in ensure_no_pending_proofs ~filename:long_f_dot_in fullstate; let () = Stm.join ~doc:state.doc in let wall_clock2 = Unix.gettimeofday () in (* In .vo production, dump a complete .vo file. *) if mode = BuildVo then Library.save_library_to ~output_native_objects Library.ProofsTodoNone ldir long_f_dot_out; Aux_file.record_in_aux_at "vo_compile_time" (Printf.sprintf "%.3f" (wall_clock2 -. wall_clock1)); Aux_file.stop_aux_file (); (* Additionally, dump an empty .vos file to make sure that stale ones are never loaded *) if mode = BuildVo then dump_empty_vos(); (* In both .vo, and .vok production mode, dump an empty .vok file to indicate that proofs are ok. *) dump_empty_vok(); Dumpglob.end_dump_glob () | BuildVos -> let doc, sid = Topfmt.(in_phase ~phase:LoadingPrelude) Stm.new_doc Stm.{ doc_type = VosDoc long_f_dot_out; injections; } in let state = { doc; sid; proof = None; time = Option.map Vernac.make_time_output opts.config.time } in let state = Load.load_init_vernaculars opts ~state in let ldir = Stm.get_ldir ~doc:state.doc in let source = source ldir long_f_dot_in in let state = Vernac.load_vernac ~echo ~check:false ~source ~state long_f_dot_in in let state = Stm.finish ~doc:state.doc in ensure_no_pending_proofs state ~filename:long_f_dot_in; let () = Stm.snapshot_vos ~doc ~output_native_objects ldir long_f_dot_out in Stm.reset_task_queue (); () let compile opts stm_opts copts injections ~echo ~f_in ~f_out = ignore(CoqworkmgrApi.get 1); compile opts stm_opts injections copts ~echo ~f_in ~f_out; CoqworkmgrApi.giveback 1 let compile_file opts stm_opts copts injections (f_in, echo) = let f_out = copts.compilation_output_name in if !Flags.beautify then Flags.with_option Flags.beautify_file (fun f_in -> compile opts stm_opts copts injections ~echo ~f_in ~f_out) f_in else compile opts stm_opts copts injections ~echo ~f_in ~f_out let compile_file opts stm_opts copts injections = Option.iter (compile_file opts stm_opts copts injections) copts.compile_file coq-8.20.0/toplevel/ccompile.mli000066400000000000000000000015161466560755400165400ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* Stm.AsyncOpts.stm_opt -> Coqcargs.t -> Coqargs.injection_command list -> unit coq-8.20.0/toplevel/colors.ml000066400000000000000000000055721466560755400161030ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* false | `EMACS -> false | `ON -> true | `AUTO -> Terminal.has_style Unix.stdout && Terminal.has_style Unix.stderr && (* emacs compilation buffer does not support colors by default, its TERM variable is set to "dumb". *) try Sys.getenv "TERM" <> "dumb" with Not_found -> false in let term_color = if has_color then begin let colors = try Some (Sys.getenv "COQ_COLORS") with Not_found -> None in match colors with | None -> Topfmt.default_styles (); true (* Default colors *) | Some "" -> false (* No color output *) | Some s -> Topfmt.parse_color_config s; true (* Overwrite all colors *) end else begin Topfmt.default_styles (); false (* textual markers, no color *) end in if opts = `EMACS then Topfmt.set_emacs_print_strings () else if not term_color then begin Proof_diffs.write_color_enabled term_color; if Proof_diffs.show_diffs () then (prerr_endline "Error: -diffs requires enabling -color"; exit 1) end; Topfmt.init_terminal_output ~color:term_color let print_style_tags opts = let () = init_color opts in let tags = Topfmt.dump_tags () in let iter (t, st) = let opt = Terminal.eval st ^ t ^ Terminal.reset ^ "\n" in print_string opt in let make (t, st) = let tags = List.map string_of_int (Terminal.repr st) in (t ^ "=" ^ String.concat ";" tags) in let repr = List.map make tags in let () = Printf.printf "COQ_COLORS=\"%s\"\n" (String.concat ":" repr) in let () = List.iter iter tags in flush_all () let set_color = function | "yes" | "on" -> `ON | "no" | "off" -> `OFF | "auto" ->`AUTO | _ -> Coqargs.error_wrong_arg ("Error: on/off/auto expected after option color") let parse_extra_colors extras = let rec parse_extra color_mode = function | "-color" :: next :: rest -> parse_extra (set_color next) rest | "-list-tags" :: rest -> parse_extra color_mode rest | x :: rest -> let color_mode, rest = parse_extra color_mode rest in color_mode, x :: rest | [] -> color_mode, [] in parse_extra `AUTO extras coq-8.20.0/toplevel/colors.mli000066400000000000000000000015651466560755400162520ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* unit val parse_extra_colors : string list -> color * string list val print_style_tags : color -> unit coq-8.20.0/toplevel/common_compile.ml000066400000000000000000000054601466560755400175760ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* str "File \"" ++ str f ++ strbrk "\" has been implicitly expanded to \"" ++ str f ++ str ext ++ str "\"") let ensure_ext ext f = if Filename.check_suffix f ext then f else begin warn_file_no_extension (f,ext); f ^ ext end let safe_chop_extension f = try Filename.chop_extension f with _ -> f let ensure_bname src tgt = let src, tgt = Filename.basename src, Filename.basename tgt in let src, tgt = safe_chop_extension src, safe_chop_extension tgt in if src <> tgt then fatal_error (str "Source and target file names must coincide, directories can differ" ++ fnl () ++ str "Source: " ++ str src ++ fnl () ++ str "Target: " ++ str tgt) let ensure ~ext ~src ~tgt = ensure_bname src tgt; ensure_ext ext tgt let ensure_exists f = if not (Sys.file_exists f) then fatal_error (hov 0 (str "Can't find file" ++ spc () ++ str f)) let ensure_exists_with_prefix ~src ~tgt:f_out ~src_ext ~tgt_ext = let long_f_dot_src = ensure ~ext:src_ext ~src ~tgt:src in ensure_exists long_f_dot_src; let long_f_dot_tgt = match f_out with | None -> safe_chop_extension long_f_dot_src ^ tgt_ext | Some f -> ensure ~ext:tgt_ext ~src:long_f_dot_src ~tgt:f in long_f_dot_src, long_f_dot_tgt let ensure_no_pending_proofs ~filename s = match s.Vernacstate.interp.lemmas with | Some lemmas -> let pfs = Vernacstate.LemmaStack.get_all_proof_names lemmas in fatal_error (str "There are pending proofs in file " ++ str filename ++ str": " ++ (pfs |> List.rev |> prlist_with_sep pr_comma Names.Id.print) ++ str "."); | None -> let pm = s.Vernacstate.interp.program in let what_for = Pp.str ("file " ^ filename) in NeList.iter (fun pm -> Declare.Obls.check_solved_obligations ~what_for ~pm) pm coq-8.20.0/toplevel/common_compile.mli000066400000000000000000000035361466560755400177510ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* 'a (* [ensure ext src tgt] checks that, once stripped by ext, both [src] and [tgt] have the same basename, and returns [tgt] with the extension. [ext] is expected to begin with dot, eg [".v"]. *) val ensure : ext:string -> src:string -> tgt:string -> string (* [ensure_exists f] fails if f does not exist *) val ensure_exists : string -> unit (* [ensure_exists_with_prefix src tgt src_ext tgt_ext] checks that [src] exists (if needed adding the extension) and that [tgt] exists (if needed adding the extension) and returns [src] and [tgt] with their respective extensions. If [tgt] is [None], then it defaults to [src] (with [tgt_ext] as extension). [src_ext] and [tgt_ext] are expected to begin with dot, eg [".v"]. *) val ensure_exists_with_prefix : src:string -> tgt:string option -> src_ext:string -> tgt_ext:string -> string * string (* [chop_extension f] is like Filename.chop_extension but fail safe *) val safe_chop_extension : string -> string (* [ensure_no_pending_proofs ~filename] checks that no proof or obligation is open *) val ensure_no_pending_proofs : filename:string -> Vernacstate.t -> unit coq-8.20.0/toplevel/coqc.ml000066400000000000000000000072111466560755400155170ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* Prettyp.print_full_pure_context access env sigma) ()) ++ fnl ()) end; () let coqc_run copts ~opts injections = let _feeder = Feedback.add_feeder Coqloop.coqloop_feed in try coqc_main ~opts copts injections; exit 0 with exn -> flush_all(); Topfmt.print_err_exn exn; flush_all(); let exit_code = if (CErrors.is_anomaly exn) then 129 else 1 in exit exit_code let fix_stm_opts opts stm_opts = match opts.Coqcargs.compilation_mode with | BuildVos -> (* We need to disable error resiliency, otherwise some errors will be ignored in batch mode. c.f. #6707 This is not necessary in the vo case as it fully checks the document anyways. *) let open Stm.AsyncOpts in { stm_opts with async_proofs_mode = APon; async_proofs_n_workers = 0; async_proofs_cmd_error_resilience = false; async_proofs_tac_error_resilience = FNone; } | BuildVo | BuildVok -> stm_opts let custom_coqc : ((Coqcargs.t * Colors.color) * Stm.AsyncOpts.stm_opt, 'b) Coqtop.custom_toplevel = Coqtop.{ parse_extra = (fun extras -> let color_mode, extras = Colors.parse_extra_colors extras in let stm_opts, extras = Stmargs.parse_args ~init:Stm.AsyncOpts.default_opts extras in let coqc_opts = Coqcargs.parse extras in let stm_opts = fix_stm_opts coqc_opts stm_opts in ((coqc_opts, color_mode), stm_opts), []); usage = coqc_specific_usage; init_extra = coqc_init; run = coqc_run; initial_args = Coqargs.default; } let main () = let () = Memtrace_init.init () in Coqtop.start_coq custom_coqc coq-8.20.0/toplevel/coqc.mli000066400000000000000000000012741466560755400156730ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* unit coq-8.20.0/toplevel/coqcargs.ml000066400000000000000000000076421466560755400164040ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* 0 && s.[0] = '-' let add_compile ?echo copts s = if is_dash_argument s then arg_error Pp.(str "Unknown option " ++ str s); (* make the file name explicit; needed not to break up Coq loadpath stuff. *) let echo = Option.default copts.echo echo in let s = let open Filename in if is_implicit s then concat current_dir_name s else s in { copts with compile_file = Some (s,echo) } let add_compile ?echo copts v_file = match copts.compile_file with | Some _ -> arg_error Pp.(str "More than one file to compile: " ++ str v_file) | None -> add_compile ?echo copts v_file let parse arglist : t = let echo = ref false in let args = ref arglist in let extras = ref [] in let rec parse (oval : t) = match !args with | [] -> (oval, List.rev !extras) | opt :: rem -> args := rem; let next () = match !args with | x::rem -> args := rem; x | [] -> error_missing_arg opt in let noval : t = begin match opt with (* Deprecated options *) | "-opt" | "-byte" as opt -> depr opt; oval | "-image" as opt -> depr opt; let _ = next () in oval (* Non deprecated options *) | "-output-context" -> { oval with output_context = true } (* Verbose == echo mode *) | "-verbose" -> echo := true; oval (* Output filename *) | "-o" -> { oval with compilation_output_name = Some (next ()) } |"-vos" -> Flags.load_vos_libraries := true; { oval with compilation_mode = BuildVos } |"-vok" -> Flags.load_vos_libraries := true; { oval with compilation_mode = BuildVok } (* Glob options *) |"-no-glob" | "-noglob" -> { oval with glob_out = Dumpglob.NoGlob } |"-dump-glob" -> let file = next () in { oval with glob_out = Dumpglob.File file } (* Rest *) | s -> extras := s :: !extras; oval end in parse noval in try let opts, extra = parse default in let args = List.fold_left add_compile opts extra in args with any -> fatal_error any coq-8.20.0/toplevel/coqcargs.mli000066400000000000000000000032071466560755400165460ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* t coq-8.20.0/toplevel/coqloop.ml000066400000000000000000000455311466560755400162550ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* string; mutable str : Bytes.t; (* buffer of already read characters *) mutable len : int; (* number of chars in the buffer *) mutable bols : int list; (* offsets in str of beginning of lines *) mutable tokens : Pcoq.Parsable.t; (* stream of tokens *) mutable start : int } (* stream count of the first char of the buffer *) (* Double the size of the buffer. *) let resize_buffer ibuf = let open Bytes in let nstr = create (2 * length ibuf.str + 1) in blit ibuf.str 0 nstr 0 (length ibuf.str); ibuf.str <- nstr (* Delete all irrelevant lines of the input buffer. Keep the last line in the buffer (useful when there are several commands on the same line). *) let resynch_buffer ibuf = match ibuf.bols with | ll::_ -> let new_len = ibuf.len - ll in Bytes.blit ibuf.str ll ibuf.str 0 new_len; ibuf.len <- new_len; ibuf.bols <- []; ibuf.start <- ibuf.start + ll | _ -> () (* emacs special prompt tag for easy detection. No special character, to avoid interfering with utf8. Compatibility code removed. *) let emacs_prompt_startstring () = if !print_emacs then "" else "" let emacs_prompt_endstring () = if !print_emacs then "" else "" (* Read a char in an input channel, displaying a prompt at every beginning of line. *) let prompt_char doc ic ibuf count = let bol = match ibuf.bols with | ll::_ -> Int.equal ibuf.len ll | [] -> Int.equal ibuf.len 0 in if bol && not !print_emacs then top_stderr (str (ibuf.prompt doc)); try let c = input_char ic in if c == '\n' then ibuf.bols <- (ibuf.len+1) :: ibuf.bols; if ibuf.len == Bytes.length ibuf.str then resize_buffer ibuf; Bytes.set ibuf.str ibuf.len c; ibuf.len <- ibuf.len + 1; Some c with End_of_file -> None (* Functions to print underlined locations from an input buffer. *) module TopErr = struct (* Given a location, returns the list of locations of each line. The last line is returned separately. It also checks the location bounds. *) let get_bols_of_loc ibuf (bp,ep) = let add_line (b,e) lines = if b < 0 || e < b then CErrors.anomaly (Pp.str "Bad location."); match lines with | ([],None) -> ([], Some (b,e)) | (fl,oe) -> ((b,e)::fl, oe) in let rec lines_rec ba after = function | [] -> add_line (0,ba) after | ll::_ when ll <= bp -> add_line (ll,ba) after | ll::fl -> let nafter = if ll < ep then add_line (ll,ba) after else after in lines_rec ll nafter fl in let (fl,ll) = lines_rec ibuf.len ([],None) ibuf.bols in (fl,Option.get ll) let dotted_location (b,e) = if e-b < 3 then ("", String.make (e-b) ' ') else (String.make (e-b-1) '.', " ") let blanch_utf8_string s bp ep = let open Bytes in let s' = make (ep-bp) ' ' in let j = ref 0 in for i = bp to ep - 1 do let n = Char.code (get s i) in (* Heuristic: assume utf-8 chars are printed using a single fixed-size char and therefore contract all utf-8 code into one space; in any case, preserve tabulation so that its effective interpretation in terms of spacing is preserved *) if get s i == '\t' then set s' !j '\t'; if n < 0x80 || 0xC0 <= n then incr j done; Bytes.sub_string s' 0 !j let adjust_loc_buf ib loc = let open Loc in { loc with ep = loc.ep - ib.start; bp = loc.bp - ib.start } let print_highlight_location ib loc = let (bp,ep) = Loc.unloc loc in let highlight_lines = match get_bols_of_loc ib (bp,ep) with | ([],(bl,el)) -> let shift = blanch_utf8_string ib.str bl bp in let span = String.length (blanch_utf8_string ib.str bp ep) in (str"> " ++ str(Bytes.sub_string ib.str bl (el-bl-1)) ++ fnl () ++ str"> " ++ str(shift) ++ str(String.make span '^')) | ((b1,e1)::ml,(bn,en)) -> let (d1,s1) = dotted_location (b1,bp) in let (dn,sn) = dotted_location (ep,en) in let l1 = (str"> " ++ str d1 ++ str s1 ++ str(Bytes.sub_string ib.str bp (e1-bp))) in let li = prlist (fun (bi,ei) -> (str"> " ++ str(Bytes.sub_string ib.str bi (ei-bi)))) ml in let ln = (str"> " ++ str(Bytes.sub_string ib.str bn (ep-bn)) ++ str sn ++ str dn) in (l1 ++ li ++ ln) in highlight_lines let valid_buffer_loc ib loc = let (b,e) = Loc.unloc loc in b-ib.start >= 0 && e-ib.start < ib.len && b<=e (* Toplevel error explanation. *) let error_info_for_buffer ?loc buf = match loc with | None -> Topfmt.pr_phase ?loc () | Some loc -> let fname = loc.Loc.fname in (* We are in the toplevel *) match fname with | Loc.ToplevelInput -> let nloc = adjust_loc_buf buf loc in if valid_buffer_loc buf loc then match Topfmt.pr_phase ~loc:nloc () with | None -> None | Some hd -> Some (hd ++ fnl () ++ print_highlight_location buf nloc) (* in the toplevel, but not a valid buffer *) else Topfmt.pr_phase ~loc () (* we are in batch mode, don't adjust location *) | Loc.InFile _ -> Topfmt.pr_phase ~loc () (* Actual printing routine *) let print_error_for_buffer ?loc lvl msg buf = let pre_hdr = error_info_for_buffer ?loc buf in if !print_emacs then Topfmt.emacs_logger ?pre_hdr lvl msg else Topfmt.std_logger ?pre_hdr lvl msg (* let print_toplevel_parse_error (e, info) buf = let loc = Loc.get_loc info in let lvl = Feedback.Error in let msg = CErrors.iprint (e, info) in print_error_for_buffer ?loc lvl msg buf *) end (*s The Coq prompt is the name of the focused proof, if any, and "Coq" otherwise. We trap all exceptions to prevent the error message printing from cycling. *) let make_prompt () = try (Names.Id.to_string (Vernacstate.Declare.get_current_proof_name ())) ^ " < " with Vernacstate.Declare.NoCurrentProof -> "Coq < " [@@ocaml.warning "-3"] (* the coq prompt added to the default one when in emacs mode The prompt contains the current state label [n] (for global backtracking) and the current proof state [p] (for proof backtracking) plus the list of open (nested) proofs (for proof aborting when backtracking). It looks like: "n |lem1|lem2|lem3| p < " *) let make_emacs_prompt doc = let statnum = Stateid.to_string (Stm.get_current_state ~doc) in let dpth = Stm.current_proof_depth ~doc in let pending = Stm.get_all_proof_names ~doc in let pendingprompt = List.fold_left (fun acc x -> acc ^ (if CString.is_empty acc then "" else "|") ^ Names.Id.to_string x) "" pending in let proof_info = if dpth >= 0 then string_of_int dpth else "0" in if !print_emacs then statnum ^ " |" ^ pendingprompt ^ "| " ^ proof_info ^ " < " else "" (* A buffer to store the current command read on stdin. It is * initialized when a vernac command is immediately followed by "\n", * or after a Drop. *) let top_buffer = let pr doc = emacs_prompt_startstring() ^ make_prompt() ^ make_emacs_prompt doc ^ emacs_prompt_endstring() in { prompt = pr; str = Bytes.empty; len = 0; bols = []; tokens = Pcoq.Parsable.make (Gramlib.Stream.empty ()); start = 0 } (* Intialize or reinitialize the char stream *) let reset_input_buffer ~state = top_buffer.str <- Bytes.empty; top_buffer.len <- 0; top_buffer.bols <- []; top_buffer.tokens <- Pcoq.Parsable.make (Gramlib.Stream.from (prompt_char state.Vernac.State.doc stdin top_buffer)); top_buffer.start <- 0 let set_prompt prompt = top_buffer.prompt <- (fun doc -> emacs_prompt_startstring() ^ prompt () ^ emacs_prompt_endstring()) (* Read the input stream until a dot is encountered *) let parse_to_dot = let rec dot kwstate st = match Gramlib.LStream.next kwstate st with | Tok.KEYWORD ("."|"...") -> () | Tok.EOI -> () | _ -> dot kwstate st in Pcoq.Entry.(of_parser "Coqtoplevel.dot" { parser_fun = dot }) (* If an error occurred while parsing, we try to read the input until a dot token is encountered. We assume that when a lexer error occurs, at least one char was eaten *) let rec discard_to_dot () = try Pcoq.Entry.parse parse_to_dot top_buffer.tokens with | CLexer.Error.E _ -> (* Lexer failed *) discard_to_dot () | e when CErrors.noncritical e -> () let read_sentence ~state input = (* XXX: careful with ignoring the state Eugene!*) let open Vernac.State in try Stm.parse_sentence ~doc:state.doc state.sid ~entry:G_toplevel.vernac_toplevel input with reraise -> let reraise = Exninfo.capture reraise in (* When typing Ctrl-C, two situations may arise: - if a lexer/parsing arrived first, the rest of the ill-formed sentence needs to be discarded, and, if Ctrl-C is found while trying to discarding (in discard_to_dot), let it bypass the reporting of the parsing error and report the Sys.Break instead. - if a Ctrl-C arrives after a valid start of sentence, do not discard_to_dot since Ctrl-C is the last read character and there is nothing left to discard. *) (match fst reraise with | Sys.Break -> Pp.pp_with !Topfmt.err_ft (Pp.fnl ()) | _ -> try discard_to_dot () with Sys.Break -> Pp.pp_with !Topfmt.err_ft (Pp.fnl ()); raise Sys.Break); (* The caller of read_sentence does the error printing now, this should be re-enabled once we rely on the feedback error printer again *) (* TopErr.print_toplevel_parse_error reraise top_buffer; *) Exninfo.iraise reraise let extract_default_loc loc doc_id sid : Loc.t option = match loc with | Some _ -> loc | None -> try let doc = Stm.get_doc doc_id in Option.cata (fun {CAst.loc} -> loc) None Stm.(get_ast ~doc sid) with _ -> loc (** Coqloop Console feedback handler *) let coqloop_feed (fb : Feedback.feedback) = let open Feedback in match fb.contents with | Processed -> () | Incomplete -> () | Complete -> () | ProcessingIn _ -> () | InProgress _ -> () | WorkerStatus (_,_) -> () | AddedAxiom -> () | GlobRef (_,_,_,_,_) -> () | GlobDef (_,_,_,_) -> () | FileDependency (_,_) -> () | FileLoaded (_,_) -> () | Custom (_,_,_) -> () (* Re-enable when we switch back to feedback-based error printing *) | Message (Error,loc,msg) -> () (* TopErr.print_error_for_buffer ?loc lvl msg top_buffer *) | Message (Warning,loc,msg) -> let loc = extract_default_loc loc fb.doc_id fb.span_id in TopErr.print_error_for_buffer ?loc Warning msg top_buffer | Message (lvl,loc,msg) -> TopErr.print_error_for_buffer ?loc lvl msg top_buffer (** Main coq loop : read vernacular expressions until Drop is entered. Ctrl-C is handled internally as Sys.Break instead of aborting Coq. Normally, the only exceptions that can come out of [do_vernac] and exit the loop are Drop and Quit. Any other exception there indicates an issue with [print_toplevel_error] above. *) (* Flush in a compatible order with 8.5 *) (* This mimics the semantics of the old Pp.flush_all *) let loop_flush_all () = flush stderr; flush stdout; Format.pp_print_flush !Topfmt.std_ft (); Format.pp_print_flush !Topfmt.err_ft () (* Goal equality heuristic. *) let pequal cmp1 cmp2 (a1,a2) (b1,b2) = cmp1 a1 b1 && cmp2 a2 b2 let evleq e1 e2 = CList.equal Evar.equal e1 e2 let cproof p1 p2 = let Proof.{goals=a1;stack=a2;sigma=sigma1} = Proof.data p1 in let Proof.{goals=b1;stack=b2;sigma=sigma2} = Proof.data p2 in evleq a1 b1 && CList.equal (pequal evleq evleq) a2 b2 && CList.equal Evar.equal (Evd.shelf sigma1) (Evd.shelf sigma2) && Evar.Set.equal (Evd.given_up sigma1) (Evd.given_up sigma2) (* todo: could add other Set/Unset commands, such as "Printing Universes" *) let print_anyway_opts = [ [ "Diffs" ]; ] let print_anyway c = let open Vernacexpr in match c.expr with | VernacSynterp (VernacSetOption (_, opt, _)) -> List.mem opt print_anyway_opts | _ -> false (* print the proof step, possibly with diffs highlighted, *) let print_and_diff oldp proof = let output = if Proof_diffs.show_diffs () then try Printer.pr_open_subgoals ~diffs:oldp proof with 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" ); Printer.pr_open_subgoals proof end else Printer.pr_open_subgoals proof in Feedback.msg_notice output (* We try to behave better when goal printing raises an exception [usually Ctrl-C] This is mostly a hack as we should protect printing in a more generic way, but that'll do for now *) let top_goal_print ~doc c oldp newp = try let proof_changed = not (Option.equal cproof oldp (Some newp)) in let print_goals = proof_changed && Vernacstate.Declare.there_are_pending_proofs () || print_anyway c in if not !Flags.quiet && print_goals then begin let dproof = Stm.get_prev_proof ~doc (Stm.get_current_state ~doc) in print_and_diff dproof newp end with | exn -> let (e, info) = Exninfo.capture exn in let loc = Loc.get_loc info in let msg = CErrors.iprint (e, info) in TopErr.print_error_for_buffer ?loc Feedback.Error msg top_buffer [@@ocaml.warning "-3"] let { Goptions.get = exit_on_error } = let open Goptions in declare_bool_option_and_ref ~key:["Coqtop";"Exit";"On";"Error"] ~value:false () let show_proof_diff_cmd ~state diff_opt = let open Vernac.State in 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 ml_toplevel_state = ref None let ml_toplevel_include_ran = ref false (* Initialises the Ocaml toplevel before launching it, so that it can find the "include" file in the *source* directory *) let init_ocaml_path () = let env = Boot.Env.init () in let corelib = Boot.Env.corelib env |> Boot.Path.to_string in let add_subdir dl = Mltop.add_ml_dir (Filename.concat corelib dl) in List.iter add_subdir ("dev" :: Coq_config.all_src_dirs) let init_and_run_ml_toploop () = init_ocaml_path (); Flags.with_option Flags.in_ml_toplevel (Mltop.ocaml_toploop ~init_file:"ml_toplevel/include") () (* We return whether the execution should continue and a new state *) let process_toplevel_command ~state stm = let open Vernac.State in let open G_toplevel in match stm with | VernacDrop -> if Mltop.is_ocaml_top() then begin (* Save the last state for [go ()] *) ml_toplevel_state := Some state; (* Initialise and launch the OCaml toplevel *) init_and_run_ml_toploop (); (* Reinitialize the char stream *) reset_input_buffer ~state; (* [go ()] was potentially executed — get the new state *) let state = Option.get !ml_toplevel_state in true, state end else begin Feedback.msg_warning (str "There is no ML toplevel."); true, state end | VernacBackTo bid -> let bid = Stateid.of_int bid in let doc, res = Stm.edit_at ~doc:state.doc bid in assert (res = Stm.NewTip); true, { state with doc; sid = bid } | VernacQuit -> false, state | VernacControl { CAst.loc; v=c } -> let nstate = Vernac.process_expr ~state (CAst.make ?loc c) in let () = match nstate.proof with | None -> () | Some proof -> top_goal_print ~doc:state.doc c state.proof proof in true, nstate | VernacShowGoal { gid; sid } -> let proof = Stm.get_proof ~doc:state.doc (Stateid.of_int sid) in let goal = Printer.pr_goal_emacs ~proof gid sid in let () = Feedback.msg_notice goal in true, state | 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 diff_opt in Feedback.msg_notice out; true, state let read_and_execute ~state = try let input = top_buffer.tokens in match read_sentence ~state input with | Some stm -> process_toplevel_command ~state stm (* End of file *) | None -> top_stderr (fnl ()); false, state with (* Exception printing should be done by the feedback listener, however this is not yet ready so we rely on the exception for now. *) | Sys_blocked_io -> (* the parser doesn't like nonblocking mode, cf #10918 *) let msg = Pp.(strbrk "Coqtop needs the standard input to be in blocking mode." ++ spc() ++ str "One way of clearing the non-blocking flag is through Python:" ++ fnl() ++ str " import os" ++ fnl() ++ str " os.set_blocking(0, True)") in TopErr.print_error_for_buffer Feedback.Error msg top_buffer; exit 1 | any -> let (e, info) = Exninfo.capture any in let loc = Loc.get_loc info in let msg = CErrors.iprint (e, info) in TopErr.print_error_for_buffer ?loc Feedback.Error msg top_buffer; if exit_on_error () then exit 1; true, state let loop ~state = (* Initialize buffer *) reset_input_buffer ~state; Flags.without_option Flags.in_ml_toplevel (fun () -> (* The main loop, as a tail-recursive function *) let rec aux state = loop_flush_all (); top_stderr (fnl()); let open Vernac.State in if !print_emacs then top_stderr (str (top_buffer.prompt state.doc)); resynch_buffer top_buffer; let new_running, new_state = read_and_execute ~state:state in if new_running then (aux [@ocaml.tailcall]) new_state else new_state in aux state ) () let run ~opts ~state = let open Coqargs in print_emacs := opts.config.print_emacs; (* We initialize the console only if we run the toploop_run *) let tl_feed = Feedback.add_feeder coqloop_feed in let _ : Vernac.State.t = loop ~state in Feedback.del_feeder tl_feed coq-8.20.0/toplevel/coqloop.mli000066400000000000000000000034461466560755400164250ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* string; mutable str : Bytes.t; (** buffer of already read characters *) mutable len : int; (** number of chars in the buffer *) mutable bols : int list; (** offsets in str of beginning of lines *) mutable tokens : Pcoq.Parsable.t; (** stream of tokens *) mutable start : int } (** stream count of the first char of the buffer *) (** The input buffer of stdin. *) val top_buffer : input_buffer val set_prompt : (unit -> string) -> unit (** Toplevel feedback printer. *) val coqloop_feed : Feedback.feedback -> unit (** State tracked while in the OCaml toplevel *) val ml_toplevel_state : Vernac.State.t option ref (** Whether the "include" file was already run at least once *) val ml_toplevel_include_ran : bool ref (** The main loop *) val loop : state:Vernac.State.t -> Vernac.State.t (** Main entry point of Coq: read and execute vernac commands. *) val run : opts:Coqargs.t -> state:Vernac.State.t -> unit coq-8.20.0/toplevel/coqrc.ml000066400000000000000000000037471466560755400157130ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* if CUnix.file_readable_p rcfile then Vernac.load_vernac ~echo:false ~check:true ~state rcfile else raise (Sys_error ("Cannot read rcfile: "^ rcfile)) | None -> try let warn x = Feedback.msg_warning (Pp.str x) in let inferedrc = List.find CUnix.file_readable_p [ Envars.xdg_config_home warn / rcdefaultname^"."^Coq_config.version; Envars.xdg_config_home warn / rcdefaultname; Envars.home ~warn / "."^rcdefaultname^"."^Coq_config.version; Envars.home ~warn / "."^rcdefaultname ] in Vernac.load_vernac ~echo:false ~check:true ~state inferedrc with Not_found -> state (* Flags.if_verbose mSGNL (str ("No coqrc or coqrc."^Coq_config.version^ " found. Skipping rcfile loading.")) *) with reraise -> let reraise = Exninfo.capture reraise in let () = Feedback.msg_info (Pp.str"Load of rcfile failed.") in Exninfo.iraise reraise coq-8.20.0/toplevel/coqrc.mli000066400000000000000000000013671466560755400160600ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* state:Vernac.State.t -> Vernac.State.t coq-8.20.0/toplevel/coqtop.ml000066400000000000000000000155361466560755400161100ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* Boot.Path.to_string in let ch = open_in revision in let ver = input_line ch in let rev = input_line ch in let () = close_in ch in Printf.sprintf "%s (%s)" ver rev with _ -> Coq_config.version let print_header ~boot () = Feedback.msg_info (str "Welcome to Coq " ++ str (get_version ~boot)); flush_all () (******************************************************************************) (* Fatal Errors *) (******************************************************************************) (** Prints info which is either an error or an anomaly and then exits with the appropriate error code *) let fatal_error_exn exn = Topfmt.(in_phase ~phase:Initialization print_err_exn exn); flush_all (); let exit_code = if (CErrors.is_anomaly exn) then 129 else 1 in exit exit_code type ('a,'b) custom_toplevel = { parse_extra : string list -> 'a * string list ; usage : Boot.Usage.specific_usage ; init_extra : 'a -> Coqargs.injection_command list -> opts:Coqargs.t -> 'b ; initial_args : Coqargs.t ; run : 'a -> opts:Coqargs.t -> 'b -> unit } (** Main init routine *) let init_toplevel { parse_extra; init_extra; usage; initial_args } = Coqinit.init_ocaml (); let opts, customopts = Coqinit.parse_arguments ~parse_extra ~usage ~initial_args () in Stm.init_process (snd customopts); let injections = Coqinit.init_runtime opts in (* This state will be shared by all the documents *) Stm.init_core (); let customstate = init_extra ~opts customopts injections in opts, customopts, customstate let start_coq custom = let init_feeder = Feedback.add_feeder Coqloop.coqloop_feed in (* Init phase *) let opts, custom_opts, state = try init_toplevel custom with any -> flush_all(); fatal_error_exn any in Feedback.del_feeder init_feeder; (* Run phase *) custom.run ~opts custom_opts state (** ****************************************) (** Specific support for coqtop executable *) let ltac_debug_answer = let open DebugHook.Answer in function | Prompt prompt -> (* No newline *) Format.fprintf !Topfmt.err_ft "@[%a@]%!" Pp.pp_with prompt | Goal g -> Format.fprintf !Topfmt.err_ft "@[%a@]@\n%!" Pp.pp_with g | Output o -> Format.fprintf !Topfmt.err_ft "@[%a@]@\n%!" Pp.pp_with o | Init -> Format.fprintf !Topfmt.err_ft "@[%a@]@\n%!" Pp.pp_with (str "Init") | Stack _ | Vars _ -> CErrors.anomaly (str "ltac_debug_answer: unsupported Answer type") let ltac_debug_parse () = let open DebugHook in let act = try Action.parse (read_line ()) with End_of_file -> Ok Action.Interrupt in match act with | Ok act -> act | Error error -> ltac_debug_answer (Answer.Output (str error)); Action.Failed type query = PrintTags | PrintModUid of string list type run_mode = Interactive | Batch | Query of query type toplevel_options = { run_mode : run_mode; color_mode : Colors.color; } let init_document opts stm_options injections = (* Coq init process, phase 3: Stm initialization, backtracking state. It is essential that the module system is in a consistent state before we take the first snapshot. This was not guaranteed in the past, but now is thanks to the STM API. *) (* Next line allows loading .vos files when in interactive mode *) Flags.load_vos_libraries := true; let open Vernac.State in let doc, sid = Stm.(new_doc { doc_type = Interactive opts.config.logic.toplevel_name; injections; }) in { doc; sid; proof = None; time = Option.map Vernac.make_time_output opts.config.time } let init_toploop opts stm_opts injections = let state = init_document opts stm_opts injections in let state = Load.load_init_vernaculars opts ~state in state let coqtop_init ({ run_mode; color_mode }, async_opts) injections ~opts = if run_mode != Interactive then Flags.quiet := true; Colors.init_color (if opts.config.print_emacs then `EMACS else color_mode); Flags.if_verbose (print_header ~boot:opts.pre.boot) (); DebugHook.Intf.(set { read_cmd = ltac_debug_parse ; submit_answer = ltac_debug_answer ; isTerminal = true }); init_toploop opts async_opts injections let coqtop_parse_extra extras = let rec parse_extra run_mode = function | "-batch" :: rest -> parse_extra Batch rest | "-print-mod-uid" :: rest -> Query (PrintModUid rest), [] | x :: rest -> let run_mode, rest = parse_extra run_mode rest in run_mode, x :: rest | [] -> run_mode, [] in let run_mode, extras = parse_extra Interactive extras in let color_mode, extras = Colors.parse_extra_colors extras in let async_opts, extras = Stmargs.parse_args ~init:Stm.AsyncOpts.default_opts extras in ({ run_mode; color_mode}, async_opts), extras let fix_windows_dirsep s = if Sys.win32 then Str.(global_replace (regexp "\\(.\\)\\") "\\1/" s) else s let get_native_name s = (* We ignore even critical errors because this mode has to be super silent *) try fix_windows_dirsep @@ Filename.(List.fold_left concat (dirname s) [ !Nativelib.output_dir ; Library.native_name_from_filename s ]) with _ -> "" let coqtop_run ({ run_mode; color_mode },_) ~opts state = match run_mode with | Interactive -> Coqloop.run ~opts ~state; | Query PrintTags -> Colors.print_style_tags color_mode; exit 0 | Query (PrintModUid sl) -> let s = String.concat " " (List.map get_native_name sl) in print_endline s; exit 0 | Batch -> exit 0 let coqtop_specific_usage = Boot.Usage.{ executable_name = "coqtop"; extra_args = ""; extra_options = "\n\ coqtop specific options:\n\ \n -batch batch mode (exits after interpretation of command line)\ \n" } let coqtop_toplevel = { parse_extra = coqtop_parse_extra ; usage = coqtop_specific_usage ; init_extra = coqtop_init ; run = coqtop_run ; initial_args = Coqargs.default } coq-8.20.0/toplevel/coqtop.mli000066400000000000000000000040001466560755400162410ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* 'a * string list ; usage : Boot.Usage.specific_usage ; init_extra : 'a -> Coqargs.injection_command list -> opts:Coqargs.t -> 'b ; initial_args : Coqargs.t ; run : 'a -> opts:Coqargs.t -> 'b -> unit } (** The generic Coq main module. [start custom] will parse the command line, print the banner, initialize the load path, load the input state, load the files given on the command line, load the resource file, produce the output state if any, and finally will launch [custom.run]. *) val start_coq : ('a * Stm.AsyncOpts.stm_opt,'b) custom_toplevel -> unit (** Prepare state for interactive loop *) val init_toploop : Coqargs.t -> Stm.AsyncOpts.stm_opt -> Coqargs.injection_command list -> Vernac.State.t (** The specific characterization of the coqtop_toplevel *) type query = PrintTags | PrintModUid of string list type run_mode = Interactive | Batch | Query of query type toplevel_options = { run_mode : run_mode; color_mode : Colors.color; } val coqtop_toplevel : (toplevel_options * Stm.AsyncOpts.stm_opt,Vernac.State.t) custom_toplevel val ltac_debug_answer : DebugHook.Answer.t -> unit val ltac_debug_parse : unit -> DebugHook.Action.t coq-8.20.0/toplevel/dune000066400000000000000000000007521466560755400151210ustar00rootroot00000000000000(library (name toplevel) (public_name coq-core.toplevel) (synopsis "Coq's Interactive Shell [terminal-based]") (wrapped false) ; until ocaml/dune#4892 fixed ; (private_modules g_toplevel) (libraries coq-core.stm (select memtrace_init.ml from (memtrace -> memtrace_init.memtrace.ml) (!memtrace -> memtrace_init.default.ml)))) ; Interp provides the `zarith` library to plugins, we could also use ; -linkall in the plugins file, to be discussed. (coq.pp (modules g_toplevel)) coq-8.20.0/toplevel/g_toplevel.mlg000066400000000000000000000042001466560755400170740ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* > lk_kw "Goal" >> lk_nat end } GRAMMAR EXTEND Gram GLOBAL: vernac_toplevel; vernac_toplevel: FIRST [ [ IDENT "Drop"; "." -> { Some VernacDrop } | IDENT "Quit"; "." -> { Some VernacQuit } | IDENT "BackTo"; n = natural; "." -> { Some (VernacBackTo n) } (* show a goal for the specified proof state *) | 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 (if removed = None then Proof_diffs.DiffOn else Proof_diffs.DiffRemoved)) } | cmd = Pvernac.Vernac_.main_entry -> { match cmd with | None -> None | Some v -> Some (VernacControl v) } ] ] ; END { let vernac_toplevel pm = Pvernac.Unsafe.set_tactic_entry pm; vernac_toplevel } coq-8.20.0/toplevel/g_toplevel.mli000066400000000000000000000005651466560755400171100ustar00rootroot00000000000000 type vernac_toplevel = VernacBackTo of int | VernacDrop | VernacQuit | VernacControl of Vernacexpr.vernac_control | VernacShowGoal of { gid : int; sid : int; } | VernacShowProofDiffs of Proof_diffs.diffOpt val err : unit -> 'a val test_show_goal : unit Pcoq.Entry.t val vernac_toplevel : Pvernac.proof_mode option -> vernac_toplevel option Pcoq.Entry.t coq-8.20.0/toplevel/load.ml000066400000000000000000000033551466560755400155160ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* Coqrc.load_rcfile ~rcfile:opts.config.rcfile ~state) () else begin Flags.if_verbose Feedback.msg_info (str"Skipping rcfile loading."); state end let load_vernacular opts ~state = List.fold_left (fun state (f_in, echo) -> let s = Loadpath.locate_file f_in in (* Should make the beautify logic clearer *) let load_vernac f = Vernac.load_vernac ~echo ~check:true ~state f in if !Flags.beautify then Flags.with_option Flags.beautify_file load_vernac f_in else load_vernac s ) state opts.pre.load_vernacular_list let load_init_vernaculars opts ~state = let state = load_init_file opts ~state in let state = load_vernacular opts ~state in state coq-8.20.0/toplevel/load.mli000066400000000000000000000015141466560755400156620ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* state:Vernac.State.t-> Vernac.State.t coq-8.20.0/toplevel/memtrace_init.default.ml000066400000000000000000000000211466560755400210250ustar00rootroot00000000000000let init () = () coq-8.20.0/toplevel/memtrace_init.memtrace.ml000066400000000000000000000000551466560755400212050ustar00rootroot00000000000000let init () = Memtrace.trace_if_requested () coq-8.20.0/toplevel/memtrace_init.mli000066400000000000000000000000301466560755400175530ustar00rootroot00000000000000val init : unit -> unit coq-8.20.0/toplevel/vernac.ml000066400000000000000000000203621466560755400160520ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* let len = loc.ep - loc.bp in seek_in in_chan loc.bp; Feedback.msg_notice @@ str @@ really_input_string in_chan len ) loc type time_output = | ToFeedback | ToChannel of Format.formatter let make_time_output = function | Coqargs.ToFeedback -> ToFeedback | ToFile f -> let ch = open_out f in let fch = Format.formatter_of_out_channel ch in let close () = Format.pp_print_flush fch (); close_out ch in at_exit close; ToChannel fch module State = struct type t = { doc : Stm.doc; sid : Stateid.t; proof : Proof.t option; time : time_output option; } end let emit_time state com tstart tend = match state.State.time with | None -> () | Some time -> let pp = Topfmt.pr_cmd_header com ++ System.fmt_time_difference tstart tend in match time with | ToFeedback -> Feedback.msg_notice pp | ToChannel ch -> Pp.pp_with ch (pp ++ fnl()) let interp_vernac ~check ~state ({CAst.loc;_} as com) = let open State in try let doc, nsid, ntip = Stm.add ~doc:state.doc ~ontop:state.sid (not !Flags.quiet) com in (* Main STM interaction *) if ntip <> Stm.NewAddTip then anomaly (str "vernac.ml: We got an unfocus operation on the toplevel!"); (* Force the command *) let () = if check then Stm.observe ~doc nsid in let new_proof = Vernacstate.Declare.give_me_the_proof_opt () [@ocaml.warning "-3"] in { state with doc; sid = nsid; proof = new_proof; } with reraise -> let (reraise, info) = Exninfo.capture reraise in let info = (* Set the loc to the whole command if no loc *) match Loc.get_loc info, loc with | None, Some loc -> Loc.add_loc info loc | Some _, _ | _, None -> info in Exninfo.iraise (reraise, info) (* Load a vernac file. CErrors are annotated with file and location *) let load_vernac_core ~echo ~check ~state ?source file = (* Keep in sync *) let in_chan = open_utf8_file_in file in let in_echo = if echo then Some (open_utf8_file_in file) else None in let input_cleanup () = close_in in_chan; Option.iter close_in in_echo in let source = Option.default (Loc.InFile {dirpath=None; file}) source in let in_pa = Pcoq.Parsable.make ~loc:Loc.(initial source) (Gramlib.Stream.of_channel in_chan) in let open State in (* ids = For beautify, list of parsed sids *) let rec loop state ids = let tstart = System.get_time () in match NewProfile.profile "parse_command" (fun () -> Stm.parse_sentence ~doc:state.doc ~entry:Pvernac.main_entry state.sid in_pa) () with | None -> input_cleanup (); state, ids, Pcoq.Parsable.comments in_pa | Some ast -> (* Printing of AST for -compile-verbose *) Option.iter (vernac_echo ?loc:ast.CAst.loc) in_echo; checknav ast; let state = try_finally (fun () -> NewProfile.profile "command" ~args:(fun () -> let lnum = match ast.loc with | None -> "unknown" | Some loc -> string_of_int loc.line_nb in [("cmd", `String (Pp.string_of_ppcmds (Topfmt.pr_cmd_header ast))); ("line", `String lnum)]) (fun () -> Flags.silently (interp_vernac ~check ~state) ast) ()) () (fun () -> let tend = System.get_time () in (* The -time option is only supported from console-based clients due to the way it prints. *) emit_time state ast tstart tend) () in (loop [@ocaml.tailcall]) state (state.sid :: ids) in try loop state [] with any -> (* whatever the exception *) let (e, info) = Exninfo.capture any in input_cleanup (); Exninfo.iraise (e, info) let process_expr ~state loc_ast = try interp_vernac ~check:true ~state loc_ast with reraise -> let reraise, info = Exninfo.capture reraise in (* Exceptions don't carry enough state to print themselves (typically missing the nametab) so we need to print before resetting to an older state. See eg #16745 *) let reraise = UserError (CErrors.iprint (reraise, info)) in (* Keep just the loc in the info as it's printed separately *) let info = Option.cata (Loc.add_loc Exninfo.null) Exninfo.null (Loc.get_loc info) in ignore(Stm.edit_at ~doc:state.doc state.sid); Exninfo.iraise (reraise, info) let process_expr ~state loc_ast = let tstart = System.get_time () in try_finally (fun () -> process_expr ~state loc_ast) () (fun () -> let tend = System.get_time () in emit_time state loc_ast tstart tend) () (******************************************************************************) (* Beautify-specific code *) (******************************************************************************) (* vernac parses the given stream, executes interpfun on the syntax tree it * parses, and is verbose on "primitives" commands if verbosely is true *) let beautify_suffix = ".beautified" let set_formatter_translator ch = let out s b e = output_substring ch s b e in let ft = Format.make_formatter out (fun () -> flush ch) in Format.pp_set_max_boxes ft max_int; ft let pr_new_syntax ?loc ft_beautify ocom = let loc = Option.append loc (Option.bind ocom (fun x -> x.CAst.loc)) in let loc = Option.cata Loc.unloc (0,0) loc in let before = comment (Pputils.extract_comments (fst loc)) in let com = Option.cata (fun com -> Ppvernac.pr_vernac com ++ fnl()) (mt ()) ocom in let after = comment (Pputils.extract_comments (snd loc)) in if !Flags.beautify_file then (Pp.pp_with ft_beautify (hov 0 (before ++ com ++ after)); Format.pp_print_flush ft_beautify ()) else Feedback.msg_info (hov 4 (str"New Syntax:" ++ fnl() ++ (hov 0 com))) (* load_vernac with beautify *) let beautify_pass ~doc ~comments ~ids ~filename = let ft_beautify, close_beautify = if !Flags.beautify_file then let chan_beautify = open_out (filename^beautify_suffix) in set_formatter_translator chan_beautify, fun () -> close_out chan_beautify; else !Topfmt.std_ft, fun () -> () in (* The interface to the comment printer is imperative, so we first set the comments, then we call print. This has to be done for each file. *) Pputils.beautify_comments := comments; List.iter (fun id -> pr_new_syntax ft_beautify (Stm.get_ast ~doc id)) ids; (* Is this called so comments at EOF are printed? *) pr_new_syntax ~loc:(Loc.make_loc (max_int,max_int)) ft_beautify None; close_beautify () (* Main driver for file loading. For now, we only do one beautify pass. *) let load_vernac ~echo ~check ~state ?source filename = let ostate, ids, comments = load_vernac_core ~echo ~check ~state ?source filename in (* Pass for beautify *) if !Flags.beautify then beautify_pass ~doc:ostate.State.doc ~comments ~ids:(List.rev ids) ~filename; (* End pass *) ostate coq-8.20.0/toplevel/vernac.mli000066400000000000000000000027421466560755400162250ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* time_output (** Parsing of vernacular. *) module State : sig type t = { doc : Stm.doc; sid : Stateid.t; proof : Proof.t option; time : time_output option; } end (** [process_expr sid cmd] Executes vernac command [cmd]. Callers are expected to handle and print errors in form of exceptions, however care is taken so the state machine is left in a consistent state. *) val process_expr : state:State.t -> Vernacexpr.vernac_control -> State.t (** [load_vernac echo sid file] Loads [file] on top of [sid], will echo the commands if [echo] is set. Callers are expected to handle and print errors in form of exceptions. *) val load_vernac : echo:bool -> check:bool -> state:State.t -> ?source:Loc.source -> string -> State.t coq-8.20.0/toplevel/workerLoop.ml000066400000000000000000000033671466560755400167450ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* (* the state is not used since the worker will receive one from master *) loop ()); } in start_coq custom coq-8.20.0/toplevel/workerLoop.mli000066400000000000000000000014361466560755400171110ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* unit) -> loop:(unit -> unit) -> unit coq-8.20.0/user-contrib/000077500000000000000000000000001466560755400150215ustar00rootroot00000000000000coq-8.20.0/user-contrib/Ltac2/000077500000000000000000000000001466560755400157665ustar00rootroot00000000000000coq-8.20.0/user-contrib/Ltac2/Array.v000066400000000000000000000234231466560755400172370ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* 'a -> 'a array := "coq-core.plugins.ltac2" "array_make". Ltac2 @external length : 'a array -> int := "coq-core.plugins.ltac2" "array_length". Ltac2 @external get : 'a array -> int -> 'a := "coq-core.plugins.ltac2" "array_get". Ltac2 @external set : 'a array -> int -> 'a -> unit := "coq-core.plugins.ltac2" "array_set". Ltac2 @external lowlevel_blit : 'a array -> int -> 'a array -> int -> int -> unit := "coq-core.plugins.ltac2" "array_blit". Ltac2 @external lowlevel_fill : 'a array -> int -> int -> 'a -> unit := "coq-core.plugins.ltac2" "array_fill". Ltac2 @external concat : ('a array) list -> 'a array := "coq-core.plugins.ltac2" "array_concat". (* Low level array operations *) Ltac2 lowlevel_sub (arr : 'a array) (start : int) (len : int) := let l := length arr in match Int.equal l 0 with | true => empty | false => let newarr:=make len (get arr 0) in lowlevel_blit arr start newarr 0 len; newarr end. (* Array functions as defined in the OCaml library *) Ltac2 init (l : int) (f : int->'a) := let rec init_aux (dst : 'a array) (pos : int) (len : int) (f : int->'a) := match Int.equal len 0 with | true => () | false => set dst pos (f pos); init_aux dst (Int.add pos 1) (Int.sub len 1) f end in match Int.le l 0 with | true => empty | false => let arr:=make l (f 0) in init_aux arr 1 (Int.sub l 1) f; arr end. Ltac2 make_matrix (sx : int) (sy : int) (v : 'a) := let init1 _ := v in let initr _ := init sy init1 in init sx initr. Ltac2 copy a := lowlevel_sub a 0 (length a). Ltac2 append (a1 : 'a array) (a2 : 'a array) := match Int.equal (length a1) 0 with | true => copy a2 | false => match Int.equal (length a2) 0 with | true => copy a1 | false => let newarr:=make (Int.add (length a1) (length a2)) (get a1 0) in lowlevel_blit a1 0 newarr 0 (length a1); lowlevel_blit a2 0 newarr (length a1) (length a2); newarr end end. Ltac2 sub (a : 'a array) (ofs : int) (len : int) := Control.assert_valid_argument "Array.sub ofs<0" (Int.ge ofs 0); Control.assert_valid_argument "Array.sub len<0" (Int.ge len 0); Control.assert_bounds "Array.sub" (Int.le ofs (Int.sub (length a) len)); lowlevel_sub a ofs len. Ltac2 fill (a : 'a array) (ofs : int) (len : int) (v : 'a) := Control.assert_valid_argument "Array.fill ofs<0" (Int.ge ofs 0); Control.assert_valid_argument "Array.fill len<0" (Int.ge len 0); Control.assert_bounds "Array.fill" (Int.le ofs (Int.sub (length a) len)); lowlevel_fill a ofs len v. Ltac2 blit (a1 : 'a array) (ofs1 : int) (a2 : 'a array) (ofs2 : int) (len : int) := Control.assert_valid_argument "Array.blit ofs1<0" (Int.ge ofs1 0); Control.assert_valid_argument "Array.blit ofs2<0" (Int.ge ofs2 0); Control.assert_valid_argument "Array.blit len<0" (Int.ge len 0); Control.assert_bounds "Array.blit ofs1+len>len a1" (Int.le ofs1 (Int.sub (length a1) len)); Control.assert_bounds "Array.blit ofs2+len>len a2" (Int.le ofs2 (Int.sub (length a2) len)); lowlevel_blit a1 ofs1 a2 ofs2 len. Ltac2 rec iter_aux (f : 'a -> unit) (a : 'a array) (pos : int) (len : int) := match Int.equal len 0 with | true => () | false => f (get a pos); iter_aux f a (Int.add pos 1) (Int.sub len 1) end. Ltac2 iter (f : 'a -> unit) (a : 'a array) := iter_aux f a 0 (length a). Ltac2 rec iter2_aux (f : 'a -> 'b -> unit) (a : 'a array) (b : 'b array) (pos : int) (len : int) := match Int.equal len 0 with | true => () | false => f (get a pos) (get b pos); iter2_aux f a b (Int.add pos 1) (Int.sub len 1) end. Ltac2 rec iter2 (f : 'a -> 'b -> unit) (a : 'a array) (b : 'b array) := Control.assert_valid_argument "Array.iter2" (Int.equal (length a) (length b)); iter2_aux f a b 0 (length a). Ltac2 map (f : 'a -> 'b) (a : 'a array) := init (length a) (fun i => f (get a i)). Ltac2 map2 (f : 'a -> 'b -> 'c) (a : 'a array) (b : 'b array) := Control.assert_valid_argument "Array.map2" (Int.equal (length a) (length b)); init (length a) (fun i => f (get a i) (get b i)). Ltac2 rec iteri_aux (f : int -> 'a -> unit) (a : 'a array) (pos : int) (len : int) := match Int.equal len 0 with | true => () | false => f pos (get a pos); iteri_aux f a (Int.add pos 1) (Int.sub len 1) end. Ltac2 iteri (f : int -> 'a -> unit) (a : 'a array) := iteri_aux f a 0 (length a). Ltac2 mapi (f : int -> 'a -> 'b) (a : 'a array) := init (length a) (fun i => f i (get a i)). Ltac2 rec to_list_aux (a : 'a array) (pos : int) (len : int) := match Int.equal len 0 with | true => [] | false => get a pos :: to_list_aux a (Int.add pos 1) (Int.sub len 1) end. Ltac2 to_list (a : 'a array) := to_list_aux a 0 (length a). Ltac2 rec of_list_aux (ls : 'a list) (dst : 'a array) (pos : int) := match ls with | [] => () | hd::tl => set dst pos hd; of_list_aux tl dst (Int.add pos 1) end. Ltac2 of_list (ls : 'a list) := (* Don't use List.length here because the List module might depend on Array some day *) let rec list_length (ls : 'a list) := match ls with | [] => 0 | _ :: tl => Int.add 1 (list_length tl) end in match ls with | [] => empty | hd :: _ => let anew := make (list_length ls) hd in of_list_aux ls anew 0; anew end. Ltac2 rec fold_left_aux (f : 'a -> 'b -> 'a) (x : 'a) (a : 'b array) (pos : int) (len : int) := match Int.equal len 0 with | true => x | false => fold_left_aux f (f x (get a pos)) a (Int.add pos 1) (Int.sub len 1) end. Ltac2 fold_left (f : 'a -> 'b -> 'a) (x : 'a) (a : 'b array) : 'a := fold_left_aux f x a 0 (length a). Ltac2 rec fold_right_aux (f : 'a -> 'b -> 'b) (a : 'a array) (x : 'b) (pos : int) (len : int) := (* Note: one could compare pos<0. We keep an extra len parameter so that the function can be used for any sub array *) match Int.equal len 0 with | true => x | false => fold_right_aux f a (f (get a pos) x) (Int.sub pos 1) (Int.sub len 1) end. Ltac2 fold_right (f : 'a -> 'b -> 'b) (a : 'a array) (x : 'b) : 'b := fold_right_aux f a x (Int.sub (length a) 1) (length a). Ltac2 rec exist_aux (p : 'a -> bool) (a : 'a array) (pos : int) (len : int) := match Int.equal len 0 with | true => false | false => match p (get a pos) with | true => true | false => exist_aux p a (Int.add pos 1) (Int.sub len 1) end end. (* Note: named exist (as in Coq library) rather than exists cause exists is a notation *) Ltac2 exist (p : 'a -> bool) (a : 'a array) := exist_aux p a 0 (length a). Ltac2 rec for_all_aux (p : 'a -> bool) (a : 'a array) (pos : int) (len : int) := match Int.equal len 0 with | true => true | false => match p (get a pos) with | true => for_all_aux p a (Int.add pos 1) (Int.sub len 1) | false => false end end. Ltac2 for_all (p : 'a -> bool) (a : 'a array) := for_all_aux p a 0 (length a). (* Note: we don't have (yet) a generic equality function in Ltac2 *) Ltac2 mem (eq : 'a -> 'a -> bool) (x : 'a) (a : 'a array) := exist (eq x) a. Ltac2 rec for_all2_aux (p : 'a -> 'b -> bool) (a : 'a array) (b : 'b array) (pos : int) (len : int) := if Int.equal len 0 then true else if p (get a pos) (get b pos) then for_all2_aux p a b (Int.add pos 1) (Int.sub len 1) else false. Ltac2 for_all2 p a b := let lena := length a in let lenb := length b in if Int.equal lena lenb then for_all2_aux p a b 0 lena else Control.throw_invalid_argument "Array.for_all2". Ltac2 equal p a b := let lena := length a in let lenb := length b in if Int.equal lena lenb then for_all2_aux p a b 0 lena else false. Ltac2 rev (ar : 'a array) : 'a array := let len := length ar in init len (fun i => get ar (Int.sub (Int.sub len i) 1)). coq-8.20.0/user-contrib/Ltac2/Bool.v000066400000000000000000000035261466560755400170560ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* y | false => false end. Ltac2 or x y := match x with | true => true | false => y end. Ltac2 impl x y := match x with | true => y | false => true end. Ltac2 neg x := match x with | true => false | false => true end. Ltac2 xor x y := match x with | true => match y with | true => false | false => true end | false => match y with | true => true | false => false end end. Ltac2 equal x y := match x with | true => match y with | true => true | false => false end | false => match y with | true => false | false => true end end. (** * Boolean operators with lazy evaluation of the second argument *) (** We place the notations in a separate module so that we can import them separately *) Module Export BoolNotations. Ltac2 Notation x(self) "&&" y(thunk(self)) : 2 := match x with | true => y () | false => false end. Ltac2 Notation x(self) "||" y(thunk(self)) : 3 := match x with | true => true | false => y () end. End BoolNotations. coq-8.20.0/user-contrib/Ltac2/Char.v000066400000000000000000000021271466560755400170340ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* char := "coq-core.plugins.ltac2" "char_of_int". (** Throws if the integer is not a valid char (in range [0-255]). *) Ltac2 @external to_int : char -> int := "coq-core.plugins.ltac2" "char_to_int". Ltac2 equal (x : char) (y : char) : bool := Int.equal (to_int x) (to_int y). Ltac2 compare (x : char) (y : char) : int := Int.compare (to_int x) (to_int y). coq-8.20.0/user-contrib/Ltac2/Compat/000077500000000000000000000000001466560755400172115ustar00rootroot00000000000000coq-8.20.0/user-contrib/Ltac2/Compat/Coq818.v000066400000000000000000000003331466560755400203620ustar00rootroot00000000000000Local Set Warnings "-masking-absolute-name". Require Export Ltac2.Compat.Coq819. Require Ltac2.Array. Module Export Ltac2. Module Array. Export Ltac2.Array. Ltac2 empty () := empty. End Array. End Ltac2. coq-8.20.0/user-contrib/Ltac2/Compat/Coq819.v000066400000000000000000000000741466560755400203650ustar00rootroot00000000000000Require Ltac2.Init. #[export] Unset Ltac2 Typed Notations. coq-8.20.0/user-contrib/Ltac2/Constant.v000066400000000000000000000016521466560755400177520ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* constant -> bool := "coq-core.plugins.ltac2" "constant_equal". (** Constants obtained through module aliases or Include are not considered equal by this function. *) coq-8.20.0/user-contrib/Ltac2/Constr.v000066400000000000000000000343341466560755400174340ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* constr := "coq-core.plugins.ltac2" "constr_type". (** Return the type of a term *) Ltac2 @ external equal : constr -> constr -> bool := "coq-core.plugins.ltac2" "constr_equal". (** Strict syntactic equality: only up to α-conversion and evar expansion *) Module Binder. Ltac2 Type relevance_var. Ltac2 Type relevance := [ Relevant | Irrelevant | RelevanceVar (relevance_var) ]. Ltac2 @ external make : ident option -> constr -> binder := "coq-core.plugins.ltac2" "constr_binder_make". (** Create a binder given the name and the type of the bound variable. Fails if the type is not a type in the current goal. *) Ltac2 @ external unsafe_make : ident option -> relevance -> constr -> binder := "coq-core.plugins.ltac2" "constr_binder_unsafe_make". (** Create a binder given the name and the type and relevance of the bound variable. *) Ltac2 @ external name : binder -> ident option := "coq-core.plugins.ltac2" "constr_binder_name". (** Retrieve the name of a binder. *) Ltac2 @ external type : binder -> constr := "coq-core.plugins.ltac2" "constr_binder_type". (** Retrieve the type of a binder. *) Ltac2 @ external relevance : binder -> relevance := "coq-core.plugins.ltac2" "constr_binder_relevance". (** Retrieve the relevance of a binder. *) End Binder. Module Unsafe. (** Low-level access to kernel terms. Use with care! *) Ltac2 Type case. Ltac2 Type case_invert := [ | NoInvert | CaseInvert (constr array) ]. Ltac2 Type kind := [ | Rel (int) | Var (ident) | Meta (meta) | Evar (evar, constr array) | Sort (sort) | Cast (constr, cast, constr) | Prod (binder, constr) | Lambda (binder, constr) | LetIn (binder, constr, constr) | App (constr, constr array) | Constant (constant, instance) | Ind (inductive, instance) | Constructor (constructor, instance) | Case (case, (constr * Binder.relevance), case_invert, constr, constr array) | Fix (int array, int, binder array, constr array) | CoFix (int, binder array, constr array) | Proj (projection, Binder.relevance, constr) | Uint63 (uint63) | Float (float) | String (pstring) | Array (instance, constr array, constr, constr) ]. Ltac2 @ external kind : constr -> kind := "coq-core.plugins.ltac2" "constr_kind". Ltac2 rec kind_nocast c := match kind c with | Cast c _ _ => kind_nocast c | k => k end. Ltac2 @ external make : kind -> constr := "coq-core.plugins.ltac2" "constr_make". Ltac2 @ external check : constr -> constr result := "coq-core.plugins.ltac2" "constr_check". (** Checks that a constr generated by unsafe means is indeed safe in the current environment, and returns it, or the error otherwise. Panics if not focused. *) Ltac2 @ external liftn : int -> int -> constr -> constr := "coq-core.plugins.ltac2" "constr_liftn". (** [liftn n k c] lifts by [n] indices greater than or equal to [k] in [c] Note that with respect to substitution calculi's terminology, [n] is the _shift_ and [k] is the _lift_. *) Ltac2 @ external substnl : constr list -> int -> constr -> constr := "coq-core.plugins.ltac2" "constr_substnl". (** [substnl [r₁;...;rₙ] k c] substitutes in parallel [Rel(k+1); ...; Rel(k+n)] with [r₁;...;rₙ] in [c]. *) Ltac2 @ external closenl : ident list -> int -> constr -> constr := "coq-core.plugins.ltac2" "constr_closenl". (** [closenl [x₁;...;xₙ] k c] abstracts over variables [x₁;...;xₙ] and replaces them with [Rel(k); ...; Rel(k+n-1)] in [c]. If two names are identical, the one of least index is kept. *) Ltac2 @ external closedn : int -> constr -> bool := "coq-core.plugins.ltac2" "constr_closedn". (** [closedn n c] is true iff [c] is a closed term under [n] binders *) Ltac2 is_closed (c : constr) : bool := closedn 0 c. (** [is_closed c] is true iff [c] is a closed term (contains no [Rel]s) *) Ltac2 @ external occur_between : int -> int -> constr -> bool := "coq-core.plugins.ltac2" "constr_occur_between". (** [occur_between n m c] returns true iff [Rel p] occurs in term [c] for [n <= p < n+m] *) Ltac2 occurn (n : int) (c : constr) : bool := occur_between n 1 c. (** [occurn n c] returns true iff [Rel n] occurs in term [c] *) Ltac2 @ external case : inductive -> case := "coq-core.plugins.ltac2" "constr_case". (** Generate the case information for a given inductive type. *) Ltac2 constructor (ind : inductive) (i : int) : constructor := Ind.get_constructor (Ind.data ind) i. (** Generate the i-th constructor for a given inductive type. Indexing starts at 0. Panics if there is no such constructor. *) Module Case. Ltac2 @ external equal : case -> case -> bool := "coq-core.plugins.ltac2" "constr_case_equal". (** Checks equality of the inductive components of the case info. When comparing the inductives, those obtained through module aliases or Include are not considered equal by this function. *) End Case. (** Open recursion combinators *) Local Ltac2 iter_invert (f : constr -> unit) (ci : case_invert) : unit := match ci with | NoInvert => () | CaseInvert indices => Array.iter f indices end. (** [iter f c] iters [f] on the immediate subterms of [c]; it is not recursive and the order with which subterms are processed is not specified *) Ltac2 iter (f : constr -> unit) (c : constr) : unit := match kind c with | Rel _ | Meta _ | Var _ | Sort _ | Constant _ _ | Ind _ _ | Constructor _ _ | Uint63 _ | Float _ | String _ => () | Cast c _ t => f c; f t | Prod b c => f (Binder.type b); f c | Lambda b c => f (Binder.type b); f c | LetIn b t c => f (Binder.type b); f t; f c | App c l => f c; Array.iter f l | Evar _ l => Array.iter f l | Case _ x iv y bl => match x with (x,_) => f x end; iter_invert f iv; f y; Array.iter f bl | Proj _p _ c => f c | Fix _ _ tl bl => Array.iter (fun b => f (Binder.type b)) tl; Array.iter f bl | CoFix _ tl bl => Array.iter (fun b => f (Binder.type b)) tl; Array.iter f bl | Array _u t def ty => f ty; Array.iter f t; f def end. (** [iter_with_binders g f n c] iters [f n] on the immediate subterms of [c]; it carries an extra data [n] (typically a lift index) which is processed by [g] (which typically add 1 to [n]) at each binder traversal; it is not recursive and the order with which subterms are processed is not specified *) Ltac2 iter_with_binders (g : 'a -> binder -> 'a) (f : 'a -> constr -> unit) (n : 'a) (c : constr) : unit := match kind c with | Rel _ | Meta _ | Var _ | Sort _ | Constant _ _ | Ind _ _ | Constructor _ _ | Uint63 _ | Float _ | String _ => () | Cast c _ t => f n c; f n t | Prod b c => f n (Binder.type b); f (g n b) c | Lambda b c => f n (Binder.type b); f (g n b) c | LetIn b t c => f n (Binder.type b); f n t; f (g n b) c | App c l => f n c; Array.iter (f n) l | Evar _ l => Array.iter (f n) l | Case _ x iv y bl => match x with (x,_) => f n x end; iter_invert (f n) iv; f n y; Array.iter (f n) bl | Proj _p _ c => f n c | Fix _ _ tl bl => Array.iter (fun b => f n (Binder.type b)) tl; let n := Array.fold_left g n tl in Array.iter (f n) bl | CoFix _ tl bl => Array.iter (fun b => f n (Binder.type b)) tl; let n := Array.fold_left g n tl in Array.iter (f n) bl | Array _u t def ty => f n ty; Array.iter (f n) t; f n def end. Local Ltac2 binder_map (f : constr -> constr) (b : binder) : binder := Binder.unsafe_make (Binder.name b) (Binder.relevance b) (f (Binder.type b)). Local Ltac2 map_invert (f : constr -> constr) (iv : case_invert) : case_invert := match iv with | NoInvert => NoInvert | CaseInvert indices => CaseInvert (Array.map f indices) end. (** [map f c] maps [f] on the immediate subterms of [c]; it is not recursive and the order with which subterms are processed is not specified *) Ltac2 map (f : constr -> constr) (c : constr) : constr := match kind c with | Rel _ | Meta _ | Var _ | Sort _ | Constant _ _ | Ind _ _ | Constructor _ _ | Uint63 _ | Float _ | String _ => c | Cast c k t => let c := f c with t := f t in make (Cast c k t) | Prod b c => let b := binder_map f b with c := f c in make (Prod b c) | Lambda b c => let b := binder_map f b with c := f c in make (Lambda b c) | LetIn b t c => let b := binder_map f b with t := f t with c := f c in make (LetIn b t c) | App c l => let c := f c with l := Array.map f l in make (App c l) | Evar e l => let l := Array.map f l in make (Evar e l) | Case info x iv y bl => let x := match x with (x,x') => (f x, x') end with iv := map_invert f iv with y := f y with bl := Array.map f bl in make (Case info x iv y bl) | Proj p r c => let c := f c in make (Proj p r c) | Fix structs which tl bl => let tl := Array.map (binder_map f) tl with bl := Array.map f bl in make (Fix structs which tl bl) | CoFix which tl bl => let tl := Array.map (binder_map f) tl with bl := Array.map f bl in make (CoFix which tl bl) | Array u t def ty => let ty := f ty with t := Array.map f t with def := f def in make (Array u t def ty) end. End Unsafe. Module Cast. Ltac2 @ external default : cast := "coq-core.plugins.ltac2" "constr_cast_default". Ltac2 @ external vm : cast := "coq-core.plugins.ltac2" "constr_cast_vm". Ltac2 @ external native : cast := "coq-core.plugins.ltac2" "constr_cast_native". Ltac2 @ external equal : cast -> cast -> bool := "coq-core.plugins.ltac2" "constr_cast_equal". End Cast. Ltac2 @ external in_context : ident -> constr -> (unit -> unit) -> constr := "coq-core.plugins.ltac2" "constr_in_context". (** On a focused goal [Γ ⊢ A], [in_context id c tac] evaluates [tac] in a focused goal [Γ, id : c ⊢ ?X] and returns [fun (id : c) => t] where [t] is the proof built by the tactic. *) Module Pretype. Module Flags. Ltac2 Type t. Ltac2 @ external constr_flags : t := "coq-core.plugins.ltac2" "constr_flags". (** The flags used by constr:(). *) Ltac2 @external set_use_coercions : bool -> t -> t := "coq-core.plugins.ltac2" "pretype_flags_set_use_coercions". (** Use coercions during pretyping. [true] in [constr_flags]. *) Ltac2 @external set_use_typeclasses : bool -> t -> t := "coq-core.plugins.ltac2" "pretype_flags_set_use_typeclasses". (** Run typeclass inference at the end of pretyping and when needed according to flag "Typeclass Resolution For Conversion". [true] in [constr_flags]. *) Ltac2 @external set_allow_evars : bool -> t -> t := "coq-core.plugins.ltac2" "pretype_flags_set_allow_evars". (** Allow pretyping to produce new unresolved evars. [false] in [constr_flags]. *) Ltac2 @external set_nf_evars : bool -> t -> t := "coq-core.plugins.ltac2" "pretype_flags_set_nf_evars". (** Evar-normalize the result of pretyping. This should not impact anything other than performance. [true] in [constr_flags]. *) Ltac2 Notation open_constr_flags_with_tc := set_nf_evars false (set_allow_evars true constr_flags). Local Ltac2 open_constr_flags_with_tc_kn () := open_constr_flags_with_tc. (** Code generation uses this as using the notation is not convenient. *) Ltac2 Notation open_constr_flags_no_tc := set_use_typeclasses false open_constr_flags_with_tc. (** The flags used by open_constr:() and its alias [']. *) #[deprecated(since="8.20", note="use open_constr_flags_with_tc (or no_tc as desired)")] Ltac2 Notation open_constr_flags := open_constr_flags_with_tc. End Flags. Ltac2 Type expected_type. Ltac2 @ external expected_istype : expected_type := "coq-core.plugins.ltac2" "expected_istype". Ltac2 @ external expected_oftype : constr -> expected_type := "coq-core.plugins.ltac2" "expected_oftype". Ltac2 @ external expected_without_type_constraint : expected_type := "coq-core.plugins.ltac2" "expected_without_type_constraint". Ltac2 @ external pretype : Flags.t -> expected_type -> preterm -> constr := "coq-core.plugins.ltac2" "constr_pretype". (** Pretype the provided preterm. Assumes the goal to be focussed. *) End Pretype. Ltac2 pretype (c : preterm) : constr := Pretype.pretype Pretype.Flags.constr_flags Pretype.expected_without_type_constraint c. (** Pretype the provided preterm. Assumes the goal to be focussed. *) Ltac2 is_evar(c: constr) := match Unsafe.kind c with | Unsafe.Evar _ _ => true | _ => false end. Ltac2 @ external has_evar : constr -> bool := "coq-core.plugins.ltac2" "constr_has_evar". Ltac2 is_var(c: constr) := match Unsafe.kind c with | Unsafe.Var _ => true | _ => false end. Ltac2 is_fix(c: constr) := match Unsafe.kind c with | Unsafe.Fix _ _ _ _ => true | _ => false end. Ltac2 is_cofix(c: constr) := match Unsafe.kind c with | Unsafe.CoFix _ _ _ => true | _ => false end. Ltac2 is_ind(c: constr) := match Unsafe.kind c with | Unsafe.Ind _ _ => true | _ => false end. Ltac2 is_constructor(c: constr) := match Unsafe.kind c with | Unsafe.Constructor _ _ => true | _ => false end. Ltac2 is_proj(c: constr) := match Unsafe.kind c with | Unsafe.Proj _ _ _ => true | _ => false end. Ltac2 is_const(c: constr) := match Unsafe.kind c with | Unsafe.Constant _ _ => true | _ => false end. Ltac2 is_float(c: constr) := match Unsafe.kind c with | Unsafe.Float _ => true | _ => false end. Ltac2 is_uint63(c: constr) := match Unsafe.kind c with | Unsafe.Uint63 _ => true | _ => false end. Ltac2 is_array(c: constr) := match Unsafe.kind c with | Unsafe.Array _ _ _ _ => true | _ => false end. coq-8.20.0/user-contrib/Ltac2/Constructor.v000066400000000000000000000024431466560755400205050ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* t -> bool := "coq-core.plugins.ltac2" "constructor_equal". (** Constructors obtained through module aliases or Include are not considered equal by this function. *) Ltac2 @ external inductive : t -> inductive := "coq-core.plugins.ltac2" "constructor_inductive". (** Returns the inductive to which the given constructor belongs. *) Ltac2 @ external index : t -> int := "coq-core.plugins.ltac2" "constructor_index". (** Returns the index of the given constructor (such that [c] is [Ind.get_constructor (Ind.data (inductive c)) (index c)]). *) coq-8.20.0/user-contrib/Ltac2/Control.v000066400000000000000000000155271466560755400176070ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* 'a := "coq-core.plugins.ltac2" "throw". (** Fatal exception throwing. This does not induce backtracking. *) (** Generic backtracking control *) Ltac2 @ external zero : exn -> 'a := "coq-core.plugins.ltac2" "zero". Ltac2 @ external plus : (unit -> 'a) -> (exn -> 'a) -> 'a := "coq-core.plugins.ltac2" "plus". Ltac2 @ external once : (unit -> 'a) -> 'a := "coq-core.plugins.ltac2" "once". Ltac2 @ external case : (unit -> 'a) -> ('a * (exn -> 'a)) result := "coq-core.plugins.ltac2" "case". Ltac2 once_plus (run : unit -> 'a) (handle : exn -> 'a) : 'a := once (fun () => plus run handle). (** Proof state manipulation *) Ltac2 @ external numgoals : unit -> int := "coq-core.plugins.ltac2" "numgoals". (** Return the number of goals currently focused. *) Ltac2 @ external dispatch : (unit -> unit) list -> unit := "coq-core.plugins.ltac2" "dispatch". Ltac2 @ external extend : (unit -> unit) list -> (unit -> unit) -> (unit -> unit) list -> unit := "coq-core.plugins.ltac2" "extend". Ltac2 @ external enter : (unit -> unit) -> unit := "coq-core.plugins.ltac2" "enter". Ltac2 @ external focus : int -> int -> (unit -> 'a) -> 'a := "coq-core.plugins.ltac2" "focus". Ltac2 @ external shelve : unit -> unit := "coq-core.plugins.ltac2" "shelve". Ltac2 @ external shelve_unifiable : unit -> unit := "coq-core.plugins.ltac2" "shelve_unifiable". Ltac2 @ external new_goal : evar -> unit := "coq-core.plugins.ltac2" "new_goal". (** Adds the given evar to the list of goals as the last one. If it is already defined in the current state, don't do anything. Panics if the evar is not in the current state. *) Ltac2 @ external unshelve : (unit -> 'a) -> 'a := "coq-core.plugins.ltac2" "unshelve". (** Runs the closure, then unshelves existential variables added to the shelf by its execution, prepending them to the current goal. Returns the value produced by the closure. *) Ltac2 @ external progress : (unit -> 'a) -> 'a := "coq-core.plugins.ltac2" "progress". (** Goal inspection *) Ltac2 @ external goal : unit -> constr := "coq-core.plugins.ltac2" "goal". (** Panics if there is not exactly one goal under focus. Otherwise returns the conclusion of this goal. *) Ltac2 @ external hyp : ident -> constr := "coq-core.plugins.ltac2" "hyp". (** Panics if there is more than one goal under focus. If there is no goal under focus, looks for the section variable with the given name. If there is one, looks for the hypothesis with the given name. *) Ltac2 @ external hyps : unit -> (ident * constr option * constr) list := "coq-core.plugins.ltac2" "hyps". (** Panics if there is more than one goal under focus. If there is no goal under focus, returns the list of section variables. If there is one, returns the list of hypotheses. In both cases, the list is ordered with rightmost values being last introduced. *) (** Refinement *) Ltac2 @ external refine : (unit -> constr) -> unit := "coq-core.plugins.ltac2" "refine". (** Evars *) Ltac2 @ external with_holes : (unit -> 'a) -> ('a -> 'b) -> 'b := "coq-core.plugins.ltac2" "with_holes". (** [with_holes x f] evaluates [x], then apply [f] to the result, and fails if all evars generated by the call to [x] have not been solved when [f] returns. *) (** Misc *) Ltac2 @ external time : string option -> (unit -> 'a) -> 'a := "coq-core.plugins.ltac2" "time". (** Displays the time taken by a tactic to evaluate. *) Ltac2 @ external abstract : ident option -> (unit -> unit) -> unit := "coq-core.plugins.ltac2" "abstract". (** Abstract a subgoal. *) Ltac2 @ external check_interrupt : unit -> unit := "coq-core.plugins.ltac2" "check_interrupt". (** For internal use. *) (** Assertions throwing exceptions and short form throws *) Ltac2 throw_invalid_argument (msg : string) := Control.throw (Invalid_argument (Some (Message.of_string msg))). Ltac2 throw_out_of_bounds (msg : string) := Control.throw (Out_of_bounds (Some (Message.of_string msg))). Ltac2 assert_valid_argument (msg : string) (test : bool) := match test with | true => () | false => throw_invalid_argument msg end. Ltac2 assert_bounds (msg : string) (test : bool) := match test with | true => () | false => throw_out_of_bounds msg end. Ltac2 assert_true b := if b then () else throw Assertion_failure. Ltac2 assert_false b := if b then throw Assertion_failure else (). (** Short form backtracks *) Ltac2 backtrack_tactic_failure (msg : string) := Control.zero (Tactic_failure (Some (Message.of_string msg))). (** Backtraces. *) (** [throw_bt info e] is similar to [throw e], but raises [e] with the backtrace represented by [info]. *) Ltac2 @ external throw_bt : exn -> exninfo -> 'a := "coq-core.plugins.ltac2" "throw_bt". (** [zero_bt info e] is similar to [zero e], but raises [e] with the backtrace represented by [info]. *) Ltac2 @ external zero_bt : exn -> exninfo -> 'a := "coq-core.plugins.ltac2" "zero_bt". (** [plus_bt run handle] is similar to [plus run handle] (up to the type missmatch for [handle]), but it calls [handle] with an extra argument representing the backtrace at the point of the exception. The [handle] function can thus decide to re-attach that backtrace when using the [throw_bt] or [zero_bt] functions. *) Ltac2 @ external plus_bt : (unit -> 'a) -> (exn -> exninfo -> 'a) -> 'a := "coq-core.plugins.ltac2" "plus_bt". (** [once_plus_bt run handle] is a non-backtracking variant of [once_plus] that has backtrace support similar to that of [plus_bt]. *) Ltac2 once_plus_bt (run : unit -> 'a) (handle : exn -> exninfo -> 'a) : 'a := once (fun _ => plus_bt run handle). Ltac2 @ external clear_err_info : err -> err := "coq-core.plugins.ltac2" "clear_err_info". Ltac2 clear_exn_info (e : exn) : exn := match e with | Init.Internal err => Init.Internal (clear_err_info err) | e => e end. (** Timeout. *) (** [timeout t thunk] calls [thunk ()] with a timeout of [t] seconds. *) Ltac2 @ external timeout : int -> (unit -> 'a) -> 'a := "coq-core.plugins.ltac2" "timeout". (** [timeoutf t thunk] calls [thunk ()] with a timeout of [t] seconds. *) Ltac2 @ external timeoutf : float -> (unit -> 'a) -> 'a := "coq-core.plugins.ltac2" "timeoutf". coq-8.20.0/user-contrib/Ltac2/Env.v000066400000000000000000000031141466560755400167040ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* Std.reference option := "coq-core.plugins.ltac2" "env_get". (** Returns the global reference corresponding to the absolute name given as argument if it exists. *) Ltac2 @ external expand : ident list -> Std.reference list := "coq-core.plugins.ltac2" "env_expand". (** Returns the list of all global references whose absolute name contains the argument list as a suffix. *) Ltac2 @ external path : Std.reference -> ident list := "coq-core.plugins.ltac2" "env_path". (** Returns the absolute name of the given reference. Panics if the reference does not exist. *) Ltac2 @ external instantiate : Std.reference -> constr := "coq-core.plugins.ltac2" "env_instantiate". (** Returns a fresh instance of the corresponding reference, in particular generating fresh universe variables and constraints when this reference is universe-polymorphic. *) coq-8.20.0/user-contrib/Ltac2/Evar.v000066400000000000000000000014511466560755400170530ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* t -> bool := "coq-core.plugins.ltac2" "evar_equal". coq-8.20.0/user-contrib/Ltac2/FMap.v000066400000000000000000000035241466560755400170040ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* ('k, 'v) t := "coq-core.plugins.ltac2" "fmap_empty". Ltac2 @ external is_empty : ('k, 'v) t -> bool := "coq-core.plugins.ltac2" "fmap_is_empty". Ltac2 @ external mem : 'k -> ('k, 'v) t -> bool := "coq-core.plugins.ltac2" "fmap_mem". Ltac2 @ external add : 'k -> 'v -> ('k, 'v) t -> ('k, 'v) t := "coq-core.plugins.ltac2" "fmap_add". Ltac2 @ external remove : 'k -> ('k, 'v) t -> ('k, 'v) t := "coq-core.plugins.ltac2" "fmap_remove". Ltac2 @ external find_opt : 'k -> ('k, 'v) t -> 'v option := "coq-core.plugins.ltac2" "fmap_find_opt". Ltac2 @ external mapi : ('k -> 'v -> 'r) -> ('k, 'v) t -> ('k, 'r) t := "coq-core.plugins.ltac2" "fmap_mapi". Ltac2 @ external fold : ('k -> 'v -> 'acc -> 'acc) -> ('k, 'v) t -> 'acc -> 'acc := "coq-core.plugins.ltac2" "fmap_fold". Ltac2 @ external cardinal : ('k, 'v) t -> int := "coq-core.plugins.ltac2" "fmap_cardinal". Ltac2 @ external bindings : ('k, 'v) t -> ('k * 'v) list := "coq-core.plugins.ltac2" "fmap_bindings". Ltac2 @ external domain : ('k, 'v) t -> 'k FSet.t := "coq-core.plugins.ltac2" "fmap_domain". coq-8.20.0/user-contrib/Ltac2/FSet.v000066400000000000000000000046401466560755400170220ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* 'a t := "coq-core.plugins.ltac2" "fset_empty". Ltac2 @ external is_empty : 'a t -> bool := "coq-core.plugins.ltac2" "fset_is_empty". Ltac2 @ external mem : 'a -> 'a t -> bool := "coq-core.plugins.ltac2" "fset_mem". Ltac2 @ external add : 'a -> 'a t -> 'a t := "coq-core.plugins.ltac2" "fset_add". Ltac2 @ external remove : 'a -> 'a t -> 'a t := "coq-core.plugins.ltac2" "fset_remove". Ltac2 @ external union : 'a t -> 'a t -> 'a t := "coq-core.plugins.ltac2" "fset_union". Ltac2 @ external inter : 'a t -> 'a t -> 'a t := "coq-core.plugins.ltac2" "fset_inter". Ltac2 @ external diff : 'a t -> 'a t -> 'a t := "coq-core.plugins.ltac2" "fset_diff". Ltac2 @ external equal : 'a t -> 'a t -> bool := "coq-core.plugins.ltac2" "fset_equal". Ltac2 @ external subset : 'a t -> 'a t -> bool := "coq-core.plugins.ltac2" "fset_subset". Ltac2 @ external cardinal : 'a t -> int := "coq-core.plugins.ltac2" "fset_cardinal". Ltac2 @ external elements : 'a t -> 'a list := "coq-core.plugins.ltac2" "fset_elements". coq-8.20.0/user-contrib/Ltac2/Float.v000066400000000000000000000014531466560755400172250ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* t -> bool := "coq-core.plugins.ltac2" "float_equal". coq-8.20.0/user-contrib/Ltac2/Fresh.v000066400000000000000000000026531466560755400172320ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* t -> t := "coq-core.plugins.ltac2" "fresh_free_union". Ltac2 @ external of_ids : ident list -> t := "coq-core.plugins.ltac2" "fresh_free_of_ids". Ltac2 @ external of_constr : constr -> t := "coq-core.plugins.ltac2" "fresh_free_of_constr". Ltac2 of_goal () := of_ids (List.map (fun (id, _, _) => id) (Control.hyps ())). End Free. Ltac2 @ external fresh : Free.t -> ident -> ident := "coq-core.plugins.ltac2" "fresh_fresh". (** Generate a fresh identifier with the given base name which is not a member of the provided set of free variables. *) Ltac2 in_goal id := Fresh.fresh (Free.of_goal ()) id. coq-8.20.0/user-contrib/Ltac2/Ident.v000066400000000000000000000017441466560755400172260ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* t -> bool := "coq-core.plugins.ltac2" "ident_equal". Ltac2 @ external of_string : string -> t option := "coq-core.plugins.ltac2" "ident_of_string". Ltac2 @ external to_string : t -> string := "coq-core.plugins.ltac2" "ident_to_string". coq-8.20.0/user-contrib/Ltac2/Ind.v000066400000000000000000000050701466560755400166710ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* t -> bool := "coq-core.plugins.ltac2" "ind_equal". (** Equality test. *) Ltac2 Type data. (** Type of data representing inductive blocks. *) Ltac2 @ external data : t -> data := "coq-core.plugins.ltac2" "ind_data". (** Get the mutual blocks corresponding to an inductive type in the current environment. Panics if there is no such inductive. *) Ltac2 @ external repr : data -> t := "coq-core.plugins.ltac2" "ind_repr". (** Returns the inductive corresponding to the block. Inverse of [data]. *) Ltac2 @ external index : t -> int := "coq-core.plugins.ltac2" "ind_index". (** Returns the index of the inductive type inside its mutual block. Guaranteed to range between [0] and [nblocks data - 1] where [data] was retrieved using the above function. *) Ltac2 @ external nblocks : data -> int := "coq-core.plugins.ltac2" "ind_nblocks". (** Returns the number of inductive types appearing in a mutual block. *) Ltac2 @ external nconstructors : data -> int := "coq-core.plugins.ltac2" "ind_nconstructors". (** Returns the number of constructors appearing in the current block. *) Ltac2 @ external get_block : data -> int -> data := "coq-core.plugins.ltac2" "ind_get_block". (** Returns the block corresponding to the nth inductive type. Index must range between [0] and [nblocks data - 1], otherwise the function panics. *) Ltac2 @ external get_constructor : data -> int -> constructor := "coq-core.plugins.ltac2" "ind_get_constructor". (** Returns the nth constructor of the inductive type. Index must range between [0] and [nconstructors data - 1], otherwise the function panics. *) Ltac2 @ external get_projections : data -> projection array option := "coq-core.plugins.ltac2" "ind_get_projections". (** Returns the list of projections for a primitive record, or [None] if the inductive is not a primitive record. *) coq-8.20.0/user-contrib/Ltac2/Init.v000066400000000000000000000061251466560755400170640ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* int -> bool := "coq-core.plugins.ltac2" "int_equal". Ltac2 @ external compare : int -> int -> int := "coq-core.plugins.ltac2" "int_compare". Ltac2 @ external add : int -> int -> int := "coq-core.plugins.ltac2" "int_add". Ltac2 @ external sub : int -> int -> int := "coq-core.plugins.ltac2" "int_sub". Ltac2 @ external mul : int -> int -> int := "coq-core.plugins.ltac2" "int_mul". (* Note: unlike Coq Z division, Ltac2 matches OCaml division and rounds towards 0, so 1/-2 = 0 *) Ltac2 @ external div : int -> int -> int := "coq-core.plugins.ltac2" "int_div". Ltac2 @ external mod : int -> int -> int := "coq-core.plugins.ltac2" "int_mod". Ltac2 @ external neg : int -> int := "coq-core.plugins.ltac2" "int_neg". Ltac2 @ external abs : int -> int := "coq-core.plugins.ltac2" "int_abs". Ltac2 @ external asr : int -> int -> int := "coq-core.plugins.ltac2" "int_asr". Ltac2 @ external lsl : int -> int -> int := "coq-core.plugins.ltac2" "int_lsl". Ltac2 @ external lsr : int -> int -> int := "coq-core.plugins.ltac2" "int_lsr". Ltac2 @ external land : int -> int -> int := "coq-core.plugins.ltac2" "int_land". Ltac2 @ external lor : int -> int -> int := "coq-core.plugins.ltac2" "int_lor". Ltac2 @ external lxor : int -> int -> int := "coq-core.plugins.ltac2" "int_lxor". Ltac2 @ external lnot : int -> int := "coq-core.plugins.ltac2" "int_lnot". Ltac2 lt (x : int) (y : int) := equal (compare x y) -1. Ltac2 gt (x : int) (y : int) := equal (compare x y) 1. Ltac2 le (x : int) (y : int) := (* we might use [lt x (add y 1)], but that has the wrong behavior on MAX_INT *) match equal x y with | true => true | false => lt x y end. Ltac2 ge (x : int) (y : int) := (* we might use [lt (add x 1) y], but that has the wrong behavior on MAX_INT *) match equal x y with | true => true | false => gt x y end. coq-8.20.0/user-contrib/Ltac2/Lazy.v000066400000000000000000000076121466560755400171020ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* 'a) ]. (** Type of a lazy cell, similar to OCaml's ['a Lazy.t] type. The functions of this module do not have any specific backtracking support, so any function passed to primitives of this module is handled as if it had one success at most (potential other successes are ignored). *) Ltac2 Type 'a t := 'a lazy_data Ref.ref. (** [from_val v] creates a new lazy cell storing (already-computed) value [v]. Forcing (i.e., using the [force] function on) the produced cell gives back value [v], and never gives an exception. *) Ltac2 from_val (v : 'a) : 'a t := Ref.ref (Value v). (** [from_fun f] creates a new lazy cell from the given thunk [f]. There is no specific support for backtracking in the [Lazy] module, so if [f] has more than one success, only the first one will be considered. *) Ltac2 from_fun (f : unit -> 'a) : 'a t := Ref.ref (Thunk f). (** [is_val r] indicates whether the given lazy cell [r] holds a forced value. In particular, [is_val r] always returns [true] if [r] was created via the [from_val] function. If [r] was created using [from_fun], then [true] will only be returned if the value of [r] was previously forced (e.g., with the [force] function), and if no exception was produced by said forcing. *) Ltac2 is_val (r : 'a t) : bool := match Ref.get r with | Value _ => true | Thunk _ => false end. (** Exception raised in case of a "cyclic" lazy cell. *) Ltac2 Type exn ::= [ Undefined ]. (** [force r] gives the value represented by the lazy cell [r], which requires forcing a thunk and updating [r] to the produced value if [r] does not yet have a value. Note that if forcing produces an exception, subsequent calls to [force] will immediately yield the same exception (without re-computing the whole thunk). Additionally, the [Undefined] exception is produced (and set to be produced by [r] on subsequent calls to [force]) if [r] relies on its own value for its definition (i.e., if [r] is "cyclic"). *) Ltac2 force (r : 'a t) : 'a := match Ref.get r with | Value v => v | Thunk f => Ref.set r (Thunk (fun () => Control.throw Undefined)); match Control.case f with | Val (v, _) => Ref.set r (Value v); v | Err e => Ref.set r (Thunk (fun () => Control.zero e)); Control.zero e end end. (** [map f r] is equivalent to [from_fun (fun () => f (force r))]. *) Ltac2 map (f : 'a -> 'b) (r : 'a t) : 'b t := from_fun (fun () => f (force r)). (** [map_val f r] is similar to [map f r], but the function [f] is immediately applied if [r] contains a forced value. If the immediate application gives an exception, then any subsequent forcing of produced lazy cell will raise the same exception. *) Ltac2 map_val (f : 'a -> 'b) (r : 'a t) : 'b t := match Ref.get r with | Value v => match Control.case (fun () => f v) with | Val (v, _) => from_val v | Err e => from_fun (fun () => Control.zero e) end | Thunk t => from_fun (fun () => f (t ())) end. Module Export Notations. Ltac2 Notation "lazy!" f(thunk(self)) := from_fun f. End Notations. coq-8.20.0/user-contrib/Ltac2/List.v000066400000000000000000000416771466560755400171070ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* 0 | _ :: xs => Int.add 1 (length xs) end. Ltac2 rec compare_lengths (ls1 : 'a list) (ls2 : 'b list) := match ls1 with | [] => match ls2 with | [] => 0 | _ :: _ => -1 end | _ :: ls1 => match ls2 with | [] => 1 | _ :: ls2 => compare_lengths ls1 ls2 end end. Ltac2 rec compare_length_with (ls : 'a list) (n : int) := match Int.lt n 0 with | true => 1 | false => match ls with | [] => Int.compare 0 n | _ :: ls => compare_length_with ls (Int.sub n 1) end end. Ltac2 cons (x : 'a) (xs : 'a list) := x :: xs. (* Since Ltac-2 distinguishes between backtracking and fatal exceptions, we provide option and default variants of functions which throw in the OCaml stdlib. *) Ltac2 hd_opt (ls : 'a list) := match ls with | [] => None | x :: _ => Some x end. Ltac2 hd (ls : 'a list) := match ls with | [] => Control.throw_invalid_argument "List.hd" | x :: _ => x end. Ltac2 tl (ls : 'a list) := match ls with | [] => [] | _ :: xs => xs end. Ltac2 dest (xs : 'a list) : 'a * 'a list := match xs with | x :: xs => (x, xs) | [] => Control.throw_invalid_argument "List.dest: list empty" end. Ltac2 is_empty (xs : 'a list) : bool := match xs with | _ :: _ => false | _ => true end. Ltac2 rec last_opt (ls : 'a list) := match ls with | [] => None | x :: xs => match xs with | [] => Some x | _ :: _ => last_opt xs end end. Ltac2 last (ls : 'a list) := match last_opt ls with | None => Control.throw_invalid_argument "List.last" | Some v => v end. Ltac2 rec removelast (ls : 'a list) := match ls with | [] => [] | x :: xs => match xs with | [] => [] | _ :: _ => x :: removelast xs end end. Ltac2 rec nth_opt_aux (ls : 'a list) (n : int) := match ls with | [] => None | x :: xs => match Int.equal n 0 with | true => Some x | false => nth_opt_aux xs (Int.sub n 1) end end. Ltac2 nth_opt (ls : 'a list) (n : int) := Control.assert_valid_argument "List.nth" (Int.ge n 0); nth_opt_aux ls n. Ltac2 nth (ls : 'a list) (n : int) := match nth_opt ls n with | Some v => v | None => Control.throw_out_of_bounds "List.nth" end. Ltac2 rec rev_append (l1 : 'a list) (l2 : 'a list) := match l1 with | [] => l2 | a :: l => rev_append l (a :: l2) end. Ltac2 rev l := rev_append l []. Ltac2 rec append ls1 ls2 := match ls1 with | [] => ls2 | x :: xs => x :: append xs ls2 end. Ltac2 rec concat (ls : 'a list list) := match ls with | [] => [] | x :: xs => append x (concat xs) end. Ltac2 flatten (ls : 'a list list) := concat ls. Ltac2 rec iter (f : 'a -> unit) (ls : 'a list) := match ls with | [] => () | l :: ls => f l; iter f ls end. Ltac2 rec iteri_aux (i : int) (f : int -> 'a -> unit) (ls : 'a list) := match ls with | [] => () | l :: ls => f i l; iteri_aux (Int.add i 1) f ls end. Ltac2 iteri (f : int -> 'a -> unit) (ls : 'a list) := iteri_aux 0 f ls. Ltac2 rec map (f : 'a -> 'b) (ls : 'a list) := match ls with | [] => [] | l :: ls => f l :: map f ls end. Ltac2 rec mapi_aux (i : int) (f : int -> 'a -> 'b) (ls : 'a list) := match ls with | [] => [] | l :: ls => f i l :: mapi_aux (Int.add i 1) f ls end. Ltac2 mapi (f : int -> 'a -> 'b) (ls : 'a list) := mapi_aux 0 f ls. Ltac2 rec flat_map (f : 'a -> 'b list) (xs : 'a list) := match xs with | [] => [] | x :: xs => append (f x) (flat_map f xs) end. (* from the OCaml std lib *) Ltac2 rev_map (f : 'a -> 'b) (ls : 'a list) := let rec rmap_f accu ls := match ls with | [] => accu | a::l => rmap_f (f a :: accu) l end in rmap_f [] ls. Ltac2 rec fold_right (f : 'a -> 'b -> 'b) (ls : 'a list) (a : 'b) : 'b := match ls with | [] => a | l :: ls => f l (fold_right f ls a) end. Ltac2 rec fold_left (f : 'a -> 'b -> 'a) (a : 'a) (xs : 'b list) : 'a := match xs with | [] => a | x :: xs => fold_left f (f a x) xs end. Ltac2 fold_lefti (f : int -> 'a -> 'b -> 'a) (a : 'a) (xs : 'b list) : 'a := let rec go i a xs := match xs with | [] => a | x :: xs => go (Int.add i 1) (f i a x) xs end in go 0 a xs. Ltac2 rec iter2 (f : 'a -> 'b -> unit) (ls1 : 'a list) (ls2 : 'b list) := match ls1 with | [] => match ls2 with | [] => () | _ :: _ => Control.throw_invalid_argument "List.iter2" end | l1 :: ls1 => match ls2 with | [] => Control.throw_invalid_argument "List.iter2" | l2 :: ls2 => f l1 l2; iter2 f ls1 ls2 end end. Ltac2 rec map2 (f : 'a -> 'b -> 'c) (ls1 : 'a list) (ls2 : 'b list) := match ls1 with | [] => match ls2 with | [] => [] | _ :: _ => Control.throw_invalid_argument "List.map2" end | l1 :: ls1 => match ls2 with | [] => Control.throw_invalid_argument "List.map2" | l2 :: ls2 => f l1 l2 :: map2 f ls1 ls2 end end. (* from the OCaml std lib *) Ltac2 rev_map2 (f : 'a -> 'b -> 'c) (ls1 : 'a list) (ls2 : 'b list) := let rec rmap2_f accu ls1 ls2 := match ls1 with | [] => match ls2 with | [] => accu | _ :: _ => Control.throw_invalid_argument "List.rev_map2" end | l1 :: ls1 => match ls2 with | [] => Control.throw_invalid_argument "List.rev_map2" | l2 :: ls2 => rmap2_f (f l1 l2 :: accu) ls1 ls2 end end in rmap2_f [] ls1 ls2. Ltac2 rec fold_right2 (f : 'a -> 'b -> 'c -> 'c) (ls1 : 'a list) (ls2 : 'b list) (a : 'c) := match ls1 with | [] => match ls2 with | [] => a | _ :: _ => Control.throw_invalid_argument "List.fold_right2" end | l1 :: ls1 => match ls2 with | [] => Control.throw_invalid_argument "List.fold_right2" | l2 :: ls2 => f l1 l2 (fold_right2 f ls1 ls2 a) end end. Ltac2 rec fold_left2 (f : 'a -> 'b -> 'c -> 'a) (a : 'a) (ls1 : 'b list) (ls2 : 'c list) := match ls1 with | [] => match ls2 with | [] => a | _ :: _ => Control.throw_invalid_argument "List.fold_left2" end | l1 :: ls1 => match ls2 with | [] => Control.throw_invalid_argument "List.fold_left2" | l2 :: ls2 => fold_left2 f (f a l1 l2) ls1 ls2 end end. Ltac2 rec for_all f ls := match ls with | [] => true | x :: xs => match f x with | true => for_all f xs | false => false end end. (* we would call this [exists] a la OCaml's [List.exists], but that's a syntax error, so instead we name it exist *) Ltac2 rec exist f ls := match ls with | [] => false | x :: xs => match f x with | true => true | false => exist f xs end end. Ltac2 rec for_all2_aux (on_length_mismatch : 'a list -> 'b list -> bool) f xs ys := match xs with | [] => match ys with | [] => true | _ :: _ => on_length_mismatch xs ys end | x :: xs' => match ys with | [] => on_length_mismatch xs ys | y :: ys' => match f x y with | true => for_all2_aux on_length_mismatch f xs' ys' | false => false end end end. Ltac2 for_all2 f xs ys := for_all2_aux (fun _ _ => Control.throw_invalid_argument "List.for_all2") f xs ys. Ltac2 equal f xs ys := for_all2_aux (fun _ _ => false) f xs ys. Ltac2 rec exist2 f xs ys := match xs with | [] => match ys with | [] => false | _ :: _ => Control.throw_invalid_argument "List.exist2" end | x :: xs' => match ys with | [] => Control.throw_invalid_argument "List.exist2" | y :: ys' => match f x y with | true => true | false => exist2 f xs' ys' end end end. Ltac2 rec find_opt f xs := match xs with | [] => None | x :: xs => match f x with | true => Some x | false => find_opt f xs end end. Ltac2 find f xs := match find_opt f xs with | Some v => v | None => Control.throw Not_found end. Ltac2 rec find_rev_opt f xs := match xs with | [] => None | x :: xs => match find_rev_opt f xs with | Some v => Some v | None => match f x with | true => Some x | false => None end end end. Ltac2 find_rev f xs := match find_rev_opt f xs with | Some v => v | None => Control.throw Not_found end. Ltac2 mem (eq : 'a -> 'a -> bool) (a : 'a) (ls : 'a list) := exist (eq a) ls. Ltac2 rec filter f xs := match xs with | [] => [] | x :: xs => match f x with | true => x :: filter f xs | false => filter f xs end end. Ltac2 rec filter_out f xs := filter (fun x => Bool.neg (f x)) xs. Ltac2 find_all (f : 'a -> bool) (ls : 'a list) := filter f ls. Ltac2 remove (eqb : 'a -> 'a -> bool) (x : 'a) (ls : 'a list) := filter_out (eqb x) ls. Ltac2 count_occ (eqb : 'a -> 'a -> bool) (x : 'a) (ls : 'a list) := length (filter (eqb x) ls). (* from the Coq stdlib *) Ltac2 rec list_power (ls1 : 'a list) (ls2 : 'b list) := match ls1 with | [] => [] :: [] | x :: t => flat_map (fun f => map (fun y => (x, y) :: f) ls2) (list_power t ls2) end. Ltac2 rec partition (f : 'a -> bool) (l : 'a list) := match l with | [] => ([], []) | x :: tl => let (g, d) := partition f tl in match f x with | true => ((x::g), d) | false => (g, (x::d)) end end. (* from the Coq stdlib *) (** [list_prod] has the same signature as [combine], but unlike [combine], it adds every possible pairs, not only those at the same position. *) Ltac2 rec list_prod (ls1 : 'a list) (ls2 : 'b list) := match ls1 with | [] => [] | x :: t => append (map (fun y => (x, y)) ls2) (list_prod t ls2) end. Ltac2 rec firstn (n : int) (ls : 'a list) := Control.assert_valid_argument "List.firstn" (Int.ge n 0); match Int.equal n 0 with | true => [] | false => match ls with | [] => Control.throw_out_of_bounds "List.firstn" | x :: xs => x :: firstn (Int.sub n 1) xs end end. Ltac2 rec skipn (n : int) (ls : 'a list) := Control.assert_valid_argument "List.skipn" (Int.ge n 0); match Int.equal n 0 with | true => ls | false => match ls with | [] => Control.throw_out_of_bounds "List.skipn" | _ :: xs => skipn (Int.sub n 1) xs end end. Ltac2 lastn (n : int) (ls : 'a list) := let l := length ls in Control.assert_valid_argument "List.lastn" (Int.ge n 0); Control.assert_bounds "List.lastn" (Int.le n l); skipn (Int.sub l n) ls. Ltac2 rec nodup (eqb : 'a -> 'a -> bool) (ls : 'a list) := match ls with | [] => [] | x :: xs => match mem eqb x xs with | true => nodup eqb xs | false => x :: nodup eqb xs end end. (* seq start 1 last = start :: start + 1 :: ... :: (last - 1) *) Ltac2 rec seq (start : int) (step : int) (last : int) := match Int.lt (Int.sub last start) step with | true => [] | false => start :: seq (Int.add start step) step last end. Ltac2 init (len : int) (f : int -> 'a) := Control.assert_valid_argument "List.init" (Int.ge len 0); map f (seq 0 1 len). Ltac2 repeat (x : 'a) (n : 'int) := init n (fun _ => x). Ltac2 assoc (eqk : 'k -> 'k -> bool) (k : 'k) (l : ('k * 'v) list) := let eq_key kv := let (k', _) := kv in eqk k k' in let (_, v) := find eq_key l in v. Ltac2 assoc_opt (eqk : 'k -> 'k -> bool) (k : 'k) (l : ('k * 'v) list) := let eq_key kv := let (k', _) := kv in eqk k k' in match find_opt eq_key l with | Some kv => let (_, v) := kv in Some v | None => None end. Ltac2 mem_assoc (eqk : 'k -> 'k -> bool) (k : 'k) (l : ('k * 'v) list) := let eq_key kv := let (k', _) := kv in eqk k k' in exist eq_key l. Ltac2 remove_assoc (eqk : 'k -> 'k -> bool) (k : 'k) (l : ('k * 'v) list) := let eq_key kv := let (k', _) := kv in eqk k k' in filter_out eq_key l. Ltac2 rec split (ls : ('a * 'b) list) := match ls with | [] => ([], []) | xy :: tl => let (x, y) := xy in let (left, right) := split tl in ((x::left), (y::right)) end. Ltac2 rec combine (ls1 : 'a list) (ls2 : 'b list) := match ls1 with | [] => match ls2 with | [] => [] | _ :: _ => Control.throw_invalid_argument "List.combine" end | x :: xs => match ls2 with | y :: ys => (x, y) :: combine xs ys | [] => Control.throw_invalid_argument "List.combine" end end. Ltac2 enumerate (ls : 'a list) := combine (seq 0 1 (length ls)) ls. (* from Coq stdlib *) Ltac2 rec merge (cmp : 'a -> 'a -> int) (l1 : 'a list) (l2 : 'b list) := let rec merge_aux l2 := match l1 with | [] => l2 | a1 :: l1' => match l2 with | [] => l1 | a2 :: l2' => match Int.le (cmp a1 a2) 0 with | true => a1 :: merge cmp l1' l2 | false => a2 :: merge_aux l2' end end end in merge_aux l2. Ltac2 rec merge_list_to_stack cmp stack l := match stack with | [] => [Some l] | l' :: stack' => match l' with | None => Some l :: stack' | Some l' => None :: merge_list_to_stack cmp stack' (merge cmp l' l) end end. Ltac2 rec merge_stack cmp stack := match stack with | [] => [] | l :: stack' => match l with | None => merge_stack cmp stack' | Some l => merge cmp l (merge_stack cmp stack') end end. Ltac2 rec iter_merge cmp stack l := match l with | [] => merge_stack cmp stack | a::l' => iter_merge cmp (merge_list_to_stack cmp stack [a]) l' end. Ltac2 sort cmp l := iter_merge cmp [] l. (* TODO: maybe replace this with a faster implementation *) Ltac2 sort_uniq (cmp : 'a -> 'a -> int) (l : 'a list) := let rec uniq l := match l with | [] => [] | x1 :: xs => match xs with | [] => x1 :: xs | x2 :: _ => match Int.equal (cmp x1 x2) 0 with | true => uniq xs | false => x1 :: uniq xs end end end in uniq (sort cmp l). Ltac2 inclusive_range (lb : int) (ub : int) : int list := let rec go lb ub := if Int.gt lb ub then [] else lb :: go (Int.add lb 1) ub in go lb ub. Ltac2 range (lb : int) (ub : int) : int list := inclusive_range lb (Int.sub ub 1). (** [concat_rev [x1; ..; xN-1; xN]] computes [rev xN ++ rev xN-1 ++ .. x1]. Note that [x1] is not reversed and appears in its original order. [concat_rev] is faster than [concat] and should be preferred over [concat] when the order of items does not matter. *) Ltac2 concat_rev (ls : 'a list list) : 'a list := let rec go ls acc := match ls with | [] => acc | l :: ls => go ls (rev_append l acc) end in match ls with | [] => [] | l :: ls => go ls l end. Ltac2 rec map_filter (f : 'a -> 'b option) (l : 'a list) : 'b list := match l with | [] => [] | x :: l => match f x with | Some y => y :: map_filter f l | None => map_filter f l end end. coq-8.20.0/user-contrib/Ltac2/Ltac1.v000066400000000000000000000073131466560755400171250ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* t := "coq-core.plugins.ltac2_ltac1" "ltac1_ref". (** Returns the Ltac1 definition with the given absolute name. *) Ltac2 @ external run : t -> unit := "coq-core.plugins.ltac2_ltac1" "ltac1_run". (** Runs an Ltac1 value, assuming it is a 'tactic', i.e. not returning anything. *) Ltac2 @ external lambda : (t -> t) -> t := "coq-core.plugins.ltac2_ltac1" "ltac1_lambda". (** Embed an Ltac2 function into Ltac1 values. Contrarily to the ltac1:(...) quotation, this function allows both to capture an Ltac2 context inside the closure and to return an Ltac1 value. Returning values in Ltac1 is a intrepid endeavour prone to weird runtime semantics. *) Ltac2 @ external apply : t -> t list -> (t -> unit) -> unit := "coq-core.plugins.ltac2_ltac1" "ltac1_apply". (** Applies an Ltac1 value to a list of arguments, and provides the result in CPS style. It does **not** run the returned value. *) (** Conversion functions *) Ltac2 @ external of_int : int -> t := "coq-core.plugins.ltac2_ltac1" "ltac1_of_int". (** Converts an Ltac2 int into an Ltac1 value. *) Ltac2 @ external to_int : t -> int option := "coq-core.plugins.ltac2_ltac1" "ltac1_to_int". (** Converts an Ltac1 int into an Ltac2 value. *) Ltac2 @ external of_constr : constr -> t := "coq-core.plugins.ltac2_ltac1" "ltac1_of_constr". (** Converts an Ltac2 constr into an Ltac1 value. *) Ltac2 @ external to_constr : t -> constr option := "coq-core.plugins.ltac2_ltac1" "ltac1_to_constr". (** Converts an Ltac1 constr (which includes terms created via open_constr) into an Ltac2 value. *) (** [preterm] is called [uconstr] in Ltac1. *) Ltac2 @ external of_preterm : preterm -> t := "coq-core.plugins.ltac2_ltac1" "ltac1_of_preterm". Ltac2 @ external to_preterm : t -> preterm option := "coq-core.plugins.ltac2_ltac1" "ltac1_to_preterm". Ltac2 @ external of_ident : ident -> t := "coq-core.plugins.ltac2_ltac1" "ltac1_of_ident". Ltac2 @ external to_ident : t -> ident option := "coq-core.plugins.ltac2_ltac1" "ltac1_to_ident". Ltac2 @ external of_list : t list -> t := "coq-core.plugins.ltac2_ltac1" "ltac1_of_list". Ltac2 @ external to_list : t -> t list option := "coq-core.plugins.ltac2_ltac1" "ltac1_to_list". Ltac2 @ external of_intro_pattern : intro_pattern -> t := "coq-core.plugins.ltac2_ltac1" "ltac1_of_intro_pattern". Ltac2 @ external to_intro_pattern : t -> intro_pattern option := "coq-core.plugins.ltac2_ltac1" "ltac1_to_intro_pattern". (** Debug information *) Ltac2 @ external tag_name : t -> string := "coq-core.plugins.ltac2_ltac1" "ltac1_tag_name". (** Name of the ltac1 value class the argument belongs to. Should be used only for error printing, typically "expected a constr but got a $tag_name". *) coq-8.20.0/user-contrib/Ltac2/Ltac2.v000066400000000000000000000026261466560755400171300ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* unit := "coq-core.plugins.ltac2" "print". Ltac2 @ external of_string : string -> message := "coq-core.plugins.ltac2" "message_of_string". Ltac2 @ external to_string : message -> string := "coq-core.plugins.ltac2" "message_to_string". Ltac2 @ external of_int : int -> message := "coq-core.plugins.ltac2" "message_of_int". Ltac2 @ external of_ident : ident -> message := "coq-core.plugins.ltac2" "message_of_ident". Ltac2 @ external of_constr : constr -> message := "coq-core.plugins.ltac2" "message_of_constr". (** Panics if there is more than one goal under focus. *) Ltac2 @ external of_exn : exn -> message := "coq-core.plugins.ltac2" "message_of_exn". (** Panics if there is more than one goal under focus. *) Ltac2 @ external concat : message -> message -> message := "coq-core.plugins.ltac2" "message_concat". (** Boxing primitives. They are translated to OCaml "Format" boxes, see https://ocaml.org/docs/formatting-text **) Ltac2 @external force_new_line : message := "coq-core.plugins.ltac2" "message_force_new_line". (** Force writing on a new line after this. Warning: partially reinitialises the pretty-printing engine, potentially leading to bad printing afterwards. Prefer using a break hint inside a vertical box. *) Ltac2 @external break : int -> int -> message := "coq-core.plugins.ltac2" "message_break". (** General break hint: [break n i] either prints [n] spaces or splits the line adding [i] to the current indentation. *) Ltac2 @external space : message := "coq-core.plugins.ltac2" "message_space". (** Breaking space. Equivalent to [break 1 0]. *) Ltac2 @external hbox : message -> message := "coq-core.plugins.ltac2" "message_hbox". (** Horizontal box. Break hints in a horizontal box never split the line (nested boxes inside the horizontal box may allow line splitting). *) Ltac2 @external vbox : int -> message -> message := "coq-core.plugins.ltac2" "message_vbox". (** Vertical box. Every break hint in a vertical box splits the line. The [int] is added to the current indentation when splitting the line. *) Ltac2 @external hvbox : int -> message -> message := "coq-core.plugins.ltac2" "message_hvbox". (** Horizontal/vertical box. Behaves as a horizontal box if it fits on a single line, otherwise behaves as a vertical box (using the given [int]). *) Ltac2 @external hovbox : int -> message -> message := "coq-core.plugins.ltac2" "message_hovbox". (** Horizonal-or-vertical box. Prints as much as possible on each line, splitting the line at break hints when there is no more room on the line (see "Printing Width" option). The [int] is added to the indentation when splitting the line. *) Module Format. (** Only for internal use. *) Ltac2 @ external stop : ('a, 'b, 'c, 'a) format := "coq-core.plugins.ltac2" "format_stop". Ltac2 @ external string : ('a, 'b, 'c, 'd) format -> (string -> 'a, 'b, 'c, 'd) format := "coq-core.plugins.ltac2" "format_string". Ltac2 @ external int : ('a, 'b, 'c, 'd) format -> (int -> 'a, 'b, 'c, 'd) format := "coq-core.plugins.ltac2" "format_int". Ltac2 @ external constr : ('a, 'b, 'c, 'd) format -> (constr -> 'a, 'b, 'c, 'd) format := "coq-core.plugins.ltac2" "format_constr". Ltac2 @ external ident : ('a, 'b, 'c, 'd) format -> (ident -> 'a, 'b, 'c, 'd) format := "coq-core.plugins.ltac2" "format_ident". Ltac2 @ external literal : string -> ('a, 'b, 'c, 'd) format -> ('a, 'b, 'c, 'd) format := "coq-core.plugins.ltac2" "format_literal". Ltac2 @ external alpha : ('a, 'b, 'c, 'd) format -> (('b -> 'r -> 'c) -> 'r -> 'a, 'b, 'c, 'd) format := "coq-core.plugins.ltac2" "format_alpha". Ltac2 @ external kfprintf : (message -> 'r) -> ('a, unit, message, 'r) format -> 'a := "coq-core.plugins.ltac2" "format_kfprintf". Ltac2 @ external ikfprintf : ('v -> 'r) -> 'v -> ('a, unit, 'v, 'r) format -> 'a := "coq-core.plugins.ltac2" "format_ikfprintf". End Format. coq-8.20.0/user-contrib/Ltac2/Meta.v000066400000000000000000000014511466560755400170440ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* t -> bool := "coq-core.plugins.ltac2" "meta_equal". coq-8.20.0/user-contrib/Ltac2/Notations.v000066400000000000000000000437771466560755400201550ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* f e | Val ans => let (x, k) := ans in Control.plus (fun _ => x) k end. Ltac2 ifcatch t s f := match Control.case t with | Err e => f e | Val ans => let (x, k) := ans in Control.plus (fun _ => s x) (fun e => s (k e)) end. Ltac2 fail0 (_ : unit) := Control.enter (fun _ => Control.zero (Tactic_failure None)). Ltac2 Notation fail := fail0 (). Ltac2 try0 t := Control.enter (fun _ => orelse t (fun _ => ())). Ltac2 Notation try := try0. Ltac2 rec repeat0 (t : unit -> unit) := Control.enter (fun () => ifcatch (fun _ => Control.progress t) (fun _ => Control.check_interrupt (); repeat0 t) (fun _ => ())). Ltac2 Notation repeat := repeat0. Ltac2 dispatch0 t (head, tail) := match tail with | None => Control.enter (fun _ => t (); Control.dispatch head) | Some tacs => let (def, rem) := tacs in Control.enter (fun _ => t (); Control.extend head def rem) end. Ltac2 Notation t(thunk(self)) ">" "[" l(dispatch) "]" : 4 := dispatch0 t l. Ltac2 do0 n t := let rec aux n t := match Int.equal n 0 with | true => () | false => t (); aux (Int.sub n 1) t end in aux (n ()) t. Ltac2 Notation do := do0. Ltac2 Notation once := Control.once. Ltac2 Notation unshelve := Control.unshelve. Ltac2 progress0 tac := Control.enter (fun _ => Control.progress tac). Ltac2 Notation progress := progress0. Ltac2 rec first0 tacs := match tacs with | [] => Control.zero (Tactic_failure None) | tac :: tacs => Control.enter (fun _ => orelse tac (fun _ => first0 tacs)) end. Ltac2 Notation "first" "[" tacs(list0(thunk(tactic(6)), "|")) "]" := first0 tacs. Ltac2 complete tac := let ans := tac () in Control.enter (fun () => Control.zero (Tactic_failure None)); ans. Ltac2 rec solve0 tacs := match tacs with | [] => Control.zero (Tactic_failure None) | tac :: tacs => Control.enter (fun _ => orelse (fun _ => complete tac) (fun _ => solve0 tacs)) end. Ltac2 Notation "solve" "[" tacs(list0(thunk(tactic(6)), "|")) "]" := solve0 tacs. Ltac2 time0 tac := Control.time None tac. Ltac2 Notation time := time0. Ltac2 abstract0 tac := Control.abstract None tac. Ltac2 Notation abstract := abstract0. (** Base tactics *) (** Note that we redeclare notations that can be parsed as mere identifiers as abbreviations, so that it allows to parse them as function arguments without having to write them within parentheses. *) (** Enter and check evar resolution *) Ltac2 enter_h ev f arg := match ev with | true => Control.enter (fun () => f ev (arg ())) | false => Control.enter (fun () => Control.with_holes arg (fun x => f ev x)) end. Ltac2 intros0 ev p := Control.enter (fun () => Std.intros ev p). Ltac2 Notation "intros" p(intropatterns) := intros0 false p. Ltac2 Notation intros := intros. Ltac2 Notation "eintros" p(intropatterns) := intros0 true p. Ltac2 Notation eintros := eintros. Ltac2 split0 ev bnd := enter_h ev Std.split bnd. Ltac2 Notation "split" bnd(thunk(with_bindings)) := split0 false bnd. Ltac2 Notation split := split. Ltac2 Notation "esplit" bnd(thunk(with_bindings)) := split0 true bnd. Ltac2 Notation esplit := esplit. Ltac2 exists0 ev bnds := match bnds with | [] => split0 ev (fun () => Std.NoBindings) | _ => let rec aux bnds := match bnds with | [] => () | bnd :: bnds => split0 ev bnd; aux bnds end in aux bnds end. Ltac2 Notation "exists" bnd(list0(thunk(bindings), ",")) := exists0 false bnd. (* Ltac2 Notation exists := exists. *) Ltac2 Notation "eexists" bnd(list0(thunk(bindings), ",")) := exists0 true bnd. Ltac2 Notation eexists := eexists. Ltac2 left0 ev bnd := enter_h ev Std.left bnd. Ltac2 Notation "left" bnd(thunk(with_bindings)) := left0 false bnd. Ltac2 Notation left := left. Ltac2 Notation "eleft" bnd(thunk(with_bindings)) := left0 true bnd. Ltac2 Notation eleft := eleft. Ltac2 right0 ev bnd := enter_h ev Std.right bnd. Ltac2 Notation "right" bnd(thunk(with_bindings)) := right0 false bnd. Ltac2 Notation right := right. Ltac2 Notation "eright" bnd(thunk(with_bindings)) := right0 true bnd. Ltac2 Notation eright := eright. Ltac2 constructor0 ev n bnd := enter_h ev (fun ev bnd => Std.constructor_n ev n bnd) bnd. Ltac2 Notation "constructor" := Control.enter (fun () => Std.constructor false). Ltac2 Notation constructor := constructor. Ltac2 Notation "constructor" n(tactic) bnd(thunk(with_bindings)) := constructor0 false n bnd. Ltac2 Notation "econstructor" := Control.enter (fun () => Std.constructor true). Ltac2 Notation econstructor := econstructor. Ltac2 Notation "econstructor" n(tactic) bnd(thunk(with_bindings)) := constructor0 true n bnd. Ltac2 specialize0 c pat := enter_h false (fun _ c => Std.specialize c pat) c. Ltac2 Notation "specialize" c(thunk(seq(constr, with_bindings))) ipat(opt(seq("as", intropattern))) := specialize0 c ipat. Ltac2 elim0 ev c bnd use := let f ev (c, bnd, use) := Std.elim ev (c, bnd) use in enter_h ev f (fun () => c (), bnd (), use ()). Ltac2 Notation "elim" c(thunk(constr)) bnd(thunk(with_bindings)) use(thunk(opt(seq("using", constr, with_bindings)))) := elim0 false c bnd use. Ltac2 Notation "eelim" c(thunk(constr)) bnd(thunk(with_bindings)) use(thunk(opt(seq("using", constr, with_bindings)))) := elim0 true c bnd use. Ltac2 apply0 adv ev cb cl := Std.apply adv ev cb cl. Ltac2 Notation "eapply" cb(list1(thunk(seq(open_constr, with_bindings)), ",")) cl(opt(seq("in", ident, opt(seq("as", intropattern))))) := apply0 true true cb cl. Ltac2 Notation "apply" cb(list1(thunk(seq(open_constr, with_bindings)), ",")) cl(opt(seq("in", ident, opt(seq("as", intropattern))))) := apply0 true false cb cl. Ltac2 default_on_concl cl := match cl with | None => { Std.on_hyps := Some []; Std.on_concl := Std.AllOccurrences } | Some cl => cl end. Ltac2 pose0 ev p := enter_h ev (fun _ (na, p) => Std.pose na p) p. Ltac2 Notation "pose" p(thunk(pose)) := pose0 false p. Ltac2 Notation "epose" p(thunk(pose)) := pose0 true p. Ltac2 Notation "set" p(thunk(pose)) cl(opt(clause)) := Std.set false p (default_on_concl cl). Ltac2 Notation "eset" p(thunk(pose)) cl(opt(clause)) := Std.set true p (default_on_concl cl). Ltac2 assert0 ev ast := enter_h ev (fun _ ast => Std.assert ast) ast. Ltac2 Notation "assert" ast(thunk(assert)) := assert0 false ast. Ltac2 Notation "eassert" ast(thunk(assert)) := assert0 true ast. Ltac2 enough_from_assertion(a : Std.assertion) := match a with | Std.AssertType ip_opt term tac_opt => Std.enough term (Some tac_opt) ip_opt | Std.AssertValue ident constr => Std.pose (Some ident) constr end. Ltac2 enough0 ev ast := enter_h ev (fun _ ast => enough_from_assertion ast) ast. Ltac2 Notation "enough" ast(thunk(assert)) := enough0 false ast. Ltac2 Notation "eenough" ast(thunk(assert)) := enough0 true ast. Ltac2 default_everywhere cl := match cl with | None => { Std.on_hyps := None; Std.on_concl := Std.AllOccurrences } | Some cl => cl end. Ltac2 Notation "remember" c(thunk(open_constr)) na(opt(seq("as", ident))) pat(opt(seq("eqn", ":", intropattern))) cl(opt(clause)) := Std.remember false na c pat (default_everywhere cl). Ltac2 Notation "eremember" c(thunk(open_constr)) na(opt(seq("as", ident))) pat(opt(seq("eqn", ":", intropattern))) cl(opt(clause)) := Std.remember true na c pat (default_everywhere cl). Ltac2 induction0 ev ic use := let f ev use := Std.induction ev ic use in enter_h ev f use. Ltac2 Notation "induction" ic(list1(induction_clause, ",")) use(thunk(opt(seq("using", constr, with_bindings)))) := induction0 false ic use. Ltac2 Notation "einduction" ic(list1(induction_clause, ",")) use(thunk(opt(seq("using", constr, with_bindings)))) := induction0 true ic use. Ltac2 generalize0 gen := enter_h false (fun _ gen => Std.generalize gen) gen. Ltac2 Notation "generalize" gen(thunk(list1(seq (open_constr, occurrences, opt(seq("as", ident))), ","))) := generalize0 gen. Ltac2 destruct0 ev ic use := let f ev use := Std.destruct ev ic use in enter_h ev f use. Ltac2 Notation "destruct" ic(list1(induction_clause, ",")) use(thunk(opt(seq("using", constr, with_bindings)))) := destruct0 false ic use. Ltac2 Notation "edestruct" ic(list1(induction_clause, ",")) use(thunk(opt(seq("using", constr, with_bindings)))) := destruct0 true ic use. Ltac2 Notation "simple" "inversion" arg(destruction_arg) pat(opt(seq("as", intropattern))) ids(opt(seq("in", list1(ident)))) := Std.inversion Std.SimpleInversion arg pat ids. Ltac2 Notation "inversion" arg(destruction_arg) pat(opt(seq("as", intropattern))) ids(opt(seq("in", list1(ident)))) := Std.inversion Std.FullInversion arg pat ids. Ltac2 Notation "inversion_clear" arg(destruction_arg) pat(opt(seq("as", intropattern))) ids(opt(seq("in", list1(ident)))) := Std.inversion Std.FullInversionClear arg pat ids. Ltac2 Notation "red" cl(opt(clause)) := Std.red (default_on_concl cl). Ltac2 Notation red := red. Ltac2 Notation "hnf" cl(opt(clause)) := Std.hnf (default_on_concl cl). Ltac2 Notation hnf := hnf. Ltac2 Notation "simpl" s(strategy) pl(opt(seq(pattern, occurrences))) cl(opt(clause)) := Std.simpl s pl (default_on_concl cl). Ltac2 Notation simpl := simpl. Ltac2 Notation "cbv" s(strategy) cl(opt(clause)) := Std.cbv s (default_on_concl cl). Ltac2 Notation cbv := cbv. Ltac2 Notation "cbn" s(strategy) cl(opt(clause)) := Std.cbn s (default_on_concl cl). Ltac2 Notation cbn := cbn. Ltac2 Notation "lazy" s(strategy) cl(opt(clause)) := Std.lazy s (default_on_concl cl). Ltac2 Notation lazy := lazy. Ltac2 Notation "unfold" pl(list1(seq(reference, occurrences), ",")) cl(opt(clause)) := Std.unfold pl (default_on_concl cl). Ltac2 fold0 pl cl := let cl := default_on_concl cl in Control.enter (fun () => Control.with_holes pl (fun pl => Std.fold pl cl)). Ltac2 Notation "fold" pl(thunk(list1(open_constr))) cl(opt(clause)) := fold0 pl cl. Ltac2 Notation "pattern" pl(list1(seq(constr, occurrences), ",")) cl(opt(clause)) := Std.pattern pl (default_on_concl cl). Ltac2 Notation "vm_compute" pl(opt(seq(pattern, occurrences))) cl(opt(clause)) := Std.vm pl (default_on_concl cl). Ltac2 Notation vm_compute := vm_compute. Ltac2 Notation "native_compute" pl(opt(seq(pattern, occurrences))) cl(opt(clause)) := Std.native pl (default_on_concl cl). Ltac2 Notation native_compute := native_compute. Ltac2 Notation "eval" "red" "in" c(constr) := Std.eval_red c. Ltac2 Notation "eval" "hnf" "in" c(constr) := Std.eval_hnf c. Ltac2 Notation "eval" "simpl" s(strategy) pl(opt(seq(pattern, occurrences))) "in" c(constr) := Std.eval_simpl s pl c. Ltac2 Notation "eval" "cbv" s(strategy) "in" c(constr) := Std.eval_cbv s c. Ltac2 Notation "eval" "cbn" s(strategy) "in" c(constr) := Std.eval_cbn s c. Ltac2 Notation "eval" "lazy" s(strategy) "in" c(constr) := Std.eval_lazy s c. Ltac2 Notation "eval" "unfold" pl(list1(seq(reference, occurrences), ",")) "in" c(constr) := Std.eval_unfold pl c. Ltac2 Notation "eval" "fold" pl(thunk(list1(open_constr))) "in" c(constr) := Std.eval_fold (pl ()) c. Ltac2 Notation "eval" "pattern" pl(list1(seq(constr, occurrences), ",")) "in" c(constr) := Std.eval_pattern pl c. Ltac2 Notation "eval" "vm_compute" pl(opt(seq(pattern, occurrences))) "in" c(constr) := Std.eval_vm pl c. Ltac2 Notation "eval" "native_compute" pl(opt(seq(pattern, occurrences))) "in" c(constr) := Std.eval_native pl c. Ltac2 change0 p cl := let (pat, c) := p in Std.change pat c (default_on_concl cl). Ltac2 Notation "change" c(conversion) cl(opt(clause)) := change0 c cl. Ltac2 rewrite0 ev rw cl tac := let cl := default_on_concl cl in Std.rewrite ev rw cl tac. Ltac2 Notation "rewrite" rw(list1(rewriting, ",")) cl(opt(clause)) tac(opt(seq("by", thunk(tactic)))) := rewrite0 false rw cl tac. Ltac2 Notation "setoid_rewrite" ori(orient) c(thunk(seq(open_constr, with_bindings))) occs(occurrences) id(opt(seq("in", ident))) := Std.setoid_rewrite (Option.default Std.LTR ori) c occs id. Ltac2 Notation "erewrite" rw(list1(rewriting, ",")) cl(opt(clause)) tac(opt(seq("by", thunk(tactic)))) := rewrite0 true rw cl tac. (** coretactics *) (** Provided for backwards compat *) #[deprecated(since="8.19")] Ltac2 exact0 ev c := Control.enter (fun _ => match ev with | true => let c := c () in Control.refine (fun _ => c) | false => Control.with_holes c (fun c => Control.refine (fun _ => c)) end ). Ltac2 exact1 ev c := Control.enter (fun () => let c := Constr.Pretype.pretype (if ev then Constr.Pretype.Flags.open_constr_flags_with_tc else Constr.Pretype.Flags.constr_flags) (Constr.Pretype.expected_oftype (Control.goal())) c in Std.exact_no_check c). Ltac2 Notation "exact" c(preterm) := exact1 false c. Ltac2 Notation "eexact" c(preterm) := exact1 true c. (** Like [refine] but new evars are shelved instead of becoming subgoals. *) Ltac2 Notation "intro" id(opt(ident)) mv(opt(move_location)) := Std.intro id mv. Ltac2 Notation intro := intro. Ltac2 Notation "move" id(ident) mv(move_location) := Std.move id mv. Ltac2 Notation reflexivity := Std.reflexivity (). Ltac2 symmetry0 cl := Std.symmetry (default_on_concl cl). Ltac2 Notation "symmetry" cl(opt(clause)) := symmetry0 cl. Ltac2 Notation symmetry := symmetry. Ltac2 Notation "revert" ids(list1(ident)) := Std.revert ids. Ltac2 Notation assumption := Std.assumption (). Ltac2 Notation etransitivity := Std.etransitivity (). Ltac2 Notation admit := Std.admit (). Ltac2 clear0 ids := match ids with | [] => Std.keep [] | _ => Std.clear ids end. Ltac2 Notation "clear" ids(list0(ident)) := clear0 ids. Ltac2 Notation "clear" "-" ids(list1(ident)) := Std.keep ids. Ltac2 Notation clear := clear. Ltac2 Notation refine := Control.refine. (** extratactics *) Ltac2 absurd0 c := Control.enter (fun _ => Std.absurd (c ())). Ltac2 Notation "absurd" c(thunk(open_constr)) := absurd0 c. Ltac2 subst0 ids := match ids with | [] => Std.subst_all () | _ => Std.subst ids end. Ltac2 Notation "subst" ids(list0(ident)) := subst0 ids. Ltac2 Notation subst := subst. Ltac2 Notation "discriminate" arg(opt(destruction_arg)) := Std.discriminate false arg. Ltac2 Notation discriminate := discriminate. Ltac2 Notation "ediscriminate" arg(opt(destruction_arg)) := Std.discriminate true arg. Ltac2 Notation ediscriminate := ediscriminate. Ltac2 Notation "injection" arg(opt(destruction_arg)) ipat(opt(seq("as", intropatterns))):= Std.injection false ipat arg. Ltac2 Notation "einjection" arg(opt(destruction_arg)) ipat(opt(seq("as", intropatterns))):= Std.injection true ipat arg. (** Auto *) Ltac2 default_db dbs := match dbs with | None => Some [] | Some dbs => match dbs with | None => None | Some l => Some l end end. Ltac2 default_list use := match use with | None => [] | Some use => use end. Ltac2 trivial0 use dbs := let dbs := default_db dbs in let use := default_list use in Std.trivial Std.Off use dbs. Ltac2 Notation "trivial" use(opt(seq("using", list1(reference, ",")))) dbs(opt(seq("with", hintdb))) := trivial0 use dbs. Ltac2 Notation trivial := trivial. Ltac2 auto0 n use dbs := let dbs := default_db dbs in let use := default_list use in Std.auto Std.Off n use dbs. Ltac2 Notation "auto" n(opt(tactic(0))) use(opt(seq("using", list1(reference, ",")))) dbs(opt(seq("with", hintdb))) := auto0 n use dbs. Ltac2 Notation auto := auto. Ltac2 eauto0 n use dbs := let dbs := default_db dbs in let use := default_list use in Std.eauto Std.Off n use dbs. Ltac2 Notation "eauto" n(opt(tactic(0))) use(opt(seq("using", list1(reference, ",")))) dbs(opt(seq("with", hintdb))) := eauto0 n use dbs. Ltac2 Notation eauto := eauto. Ltac2 Notation "typeclasses_eauto" n(opt(tactic(0))) dbs(opt(seq("with", list1(ident)))) := Std.typeclasses_eauto None n dbs. Ltac2 Notation "typeclasses_eauto" "bfs" n(opt(tactic(0))) dbs(opt(seq("with", list1(ident)))) := Std.typeclasses_eauto (Some Std.BFS) n dbs. Ltac2 Notation typeclasses_eauto := typeclasses_eauto. Ltac2 Notation "unify" x(constr) y(constr) := Std.unify x y. (** Congruence *) Ltac2 f_equal0 () := ltac1:(f_equal). Ltac2 Notation f_equal := f_equal0 (). (** now *) Ltac2 now0 t := t (); ltac1:(easy). Ltac2 Notation "now" t(thunk(self)) : 6 := now0 t. (** profiling *) Ltac2 start_profiling () := ltac1:(start ltac profiling). Ltac2 stop_profiling () := ltac1:(stop ltac profiling). Ltac2 show_profile () := ltac1:(show ltac profile). coq-8.20.0/user-contrib/Ltac2/Option.v000066400000000000000000000036611466560755400174330ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* unit) (ov : 'a option) := match ov with | Some v => f v | None => () end. Ltac2 map (f : 'a -> 'b) (ov : 'a option) := match ov with | Some v => Some (f v) | None => None end. Ltac2 default (def : 'a) (ov : 'a option) := match ov with | Some v => v | None => def end. Ltac2 map_default (f : 'a -> 'b) (def : 'b) (ov : 'a option) := match ov with | Some v => f v | None => def end. Ltac2 get (ov : 'a option) := match ov with | Some v => v | None => Control.throw No_value end. Ltac2 get_bt (ov : 'a option) := match ov with | Some v => v | None => Control.zero No_value end. Ltac2 bind (x : 'a option) (f : 'a -> 'b option) := match x with | Some x => f x | None => None end. Ltac2 ret (x : 'a) := Some x. Ltac2 lift (f : 'a -> 'b) (x : 'a option) := map f x. Ltac2 equal (eq : 'a -> 'b -> bool) (a : 'a option) (b : 'b option) : bool := match a with | None => match b with | None => true | _ => false end | Some a => match b with | Some b => eq a b | _ => false end end. coq-8.20.0/user-contrib/Ltac2/Pattern.v000066400000000000000000000143541466560755400176010ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* constr -> (ident * constr) list := "coq-core.plugins.ltac2" "pattern_matches". (** If the term matches the pattern, returns the bound variables. If it doesn't, fail with [Match_failure]. Panics if not focused. *) Ltac2 @ external matches_subterm : t -> constr -> context * ((ident * constr) list) := "coq-core.plugins.ltac2" "pattern_matches_subterm". (** Returns a stream of results corresponding to all of the subterms of the term that matches the pattern as in [matches]. The stream is encoded as a backtracking value whose last exception is [Match_failure]. The additional value compared to [matches] is the context of the match, to be filled with the instantiate function. *) Ltac2 @ external matches_vect : t -> constr -> constr array := "coq-core.plugins.ltac2" "pattern_matches_vect". (** Internal version of [matches] that does not return the identifiers. *) Ltac2 @ external matches_subterm_vect : t -> constr -> context * constr array := "coq-core.plugins.ltac2" "pattern_matches_subterm_vect". (** Internal version of [matches_subterms] that does not return the identifiers. *) Ltac2 @ external matches_goal : bool -> ((match_kind * t) option * (match_kind * t)) list -> (match_kind * t) -> ident array * context array * context array * constr array * context := "coq-core.plugins.ltac2" "pattern_matches_goal". (** Given a list of patterns [hpats] for hypotheses and one pattern [cpat] for the conclusion, [matches_goal rev hpats cpat] produces (a stream of) tuples of: - An array of idents, whose size is the length of [hpats], corresponding to the name of matched hypotheses. - An array of contexts, whose size is the number of [hpats] which have non empty body pattern, corresponding to the contexts matched for every body pattern. In case the match kind of a body pattern was [MatchPattern], the corresponding context is ensured to be empty. - An array of contexts, whose size is the length of [hpats], corresponding to the contexts matched for every hypothesis pattern. In case the match kind of a hypothesis was [MatchPattern], the corresponding context is ensured to be empty. - An array of terms, whose size is the total number of pattern variables without duplicates. Terms are ordered by identifier order, e.g. ?a comes before ?b. - A context corresponding to the conclusion, which is ensured to be empty if the kind of [cpat] was [MatchPattern]. This produces a backtracking stream of results containing all the possible result combinations. The order of considered hypotheses is reversed if [rev] is true. *) Ltac2 @ external instantiate : context -> constr -> constr := "coq-core.plugins.ltac2" "pattern_instantiate". (** Fill the hole of a context with the given term. *) (** Implementation of Ltac matching over terms and goals *) Ltac2 Type 'a constr_matching := (match_kind * t * (context -> constr array -> 'a)) list. Ltac2 lazy_match0 t (pats:'a constr_matching) := let rec interp m := match m with | [] => Control.zero Match_failure | p :: m => let next _ := interp m in let (knd, pat, f) := p in let p := match knd with | MatchPattern => (fun _ => let context := empty_context in let bind := matches_vect pat t in fun _ => f context bind) | MatchContext => (fun _ => let (context, bind) := matches_subterm_vect pat t in fun _ => f context bind) end in Control.plus p next end in Control.once (fun () => interp pats) (). Ltac2 multi_match0 t (pats:'a constr_matching) := let rec interp e m := match m with | [] => Control.zero e | p :: m => let next e := interp e m in let (knd, pat, f) := p in let p := match knd with | MatchPattern => (fun _ => let context := empty_context in let bind := matches_vect pat t in f context bind) | MatchContext => (fun _ => let (context, bind) := matches_subterm_vect pat t in f context bind) end in Control.plus p next end in interp Match_failure pats. Ltac2 one_match0 t m := Control.once (fun _ => multi_match0 t m). Ltac2 Type 'a goal_matching := ((((match_kind * t) option * (match_kind * t)) list * (match_kind * t)) * (ident array -> context array -> context array -> constr array -> context -> 'a)) list. Ltac2 lazy_goal_match0 rev (pats:'a goal_matching) := let rec interp m := match m with | [] => Control.zero Match_failure | p :: m => let next _ := interp m in let (pat, f) := p in let (phyps, pconcl) := pat in let cur _ := let (hids, hbctx, hctx, subst, cctx) := matches_goal rev phyps pconcl in fun _ => f hids hbctx hctx subst cctx in Control.plus cur next end in Control.once (fun () => interp pats) (). Ltac2 multi_goal_match0 rev (pats:'a goal_matching) := let rec interp e m := match m with | [] => Control.zero e | p :: m => let next e := interp e m in let (pat, f) := p in let (phyps, pconcl) := pat in let cur _ := let (hids, hbctx, hctx, subst, cctx) := matches_goal rev phyps pconcl in f hids hbctx hctx subst cctx in Control.plus cur next end in interp Match_failure pats. Ltac2 one_goal_match0 rev pats := Control.once (fun _ => multi_goal_match0 rev pats). coq-8.20.0/user-contrib/Ltac2/Printf.v000066400000000000000000000046331466560755400174250ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* > where the type value defines which kind of arguments will be accepted and how they will be printed. They can take the following values. - << i >>: takes an argument of type int and behaves as Message.of_int - << I >>: takes an argument of type ident and behaves as Message.of_ident - << s >>: takes an argument of type string and behaves as Message.of_string - << t >>: takes an argument of type constr and behaves as Message.of_constr - << a >>: takes two arguments << f >> of type << (unit -> 'a -> message) >> and << x >> of type << 'a >> and behaves as << f () x >> - << % >>: outputs << % >> verbatim TODO: add printing modifiers. *) Ltac2 printf fmt := Format.kfprintf print fmt. Ltac2 fprintf fmt := Format.kfprintf (fun x => x) fmt. (** The two following notations are made available when this module is imported. - printf will parse a format and generate a function taking the corresponding arguments ant printing the resulting message as per Message.print. In particular when fully applied it has type unit. - fprintf behaves similarly but return the message as a value instead of printing it. *) Ltac2 Notation "printf" fmt(format) := printf fmt. Ltac2 Notation "fprintf" fmt(format) := fprintf fmt. coq-8.20.0/user-contrib/Ltac2/Proj.v000066400000000000000000000041331466560755400170700ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* t -> bool := "coq-core.plugins.ltac2" "projection_equal". (** Projections obtained through module aliases or Include are not considered equal by this function. The unfolding boolean is not ignored. *) Ltac2 @ external ind : t -> inductive := "coq-core.plugins.ltac2" "projection_ind". (** Get the inductive to which the projectin belongs. *) Ltac2 @ external index : t -> int := "coq-core.plugins.ltac2" "projection_index". (** The index of the projection indicates which field it projects. *) Ltac2 @ external unfolded : t -> bool := "coq-core.plugins.ltac2" "projection_unfolded". (** Get the unfolding boolean. *) Ltac2 @ external set_unfolded : t -> bool -> t := "coq-core.plugins.ltac2" "projection_set_unfolded". (** Set the unfolding boolean. *) Ltac2 @ external of_constant : constant -> t option := "coq-core.plugins.ltac2" "projection_of_constant". (** Get the primitive projection associated to the constant. The returned projection is folded. Returns [None] when the constant is not associated to a primitive projection. *) Ltac2 @ external to_constant : t -> constant option := "coq-core.plugins.ltac2" "projection_to_constant". (** Get the constant associated to the primitive projection. Currently always returns [Some] but this may change in the future. *) coq-8.20.0/user-contrib/Ltac2/Pstring.v000066400000000000000000000031531466560755400176050ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* string := "coq-core.plugins.ltac2" "pstring_to_string". Ltac2 @ external of_string : string -> t option := "coq-core.plugins.ltac2" "pstring_of_string". Ltac2 @ external make : uint63 -> char63 -> t := "coq-core.plugins.ltac2" "pstring_make". Ltac2 @ external length : t -> uint63 := "coq-core.plugins.ltac2" "pstring_length". Ltac2 @ external get : t -> uint63 -> char63 := "coq-core.plugins.ltac2" "pstring_get". Ltac2 @ external sub : t -> uint63 -> uint63 -> t := "coq-core.plugins.ltac2" "pstring_sub". Ltac2 @ external cat : t -> t -> t := "coq-core.plugins.ltac2" "pstring_cat". Ltac2 @ external equal : t -> t -> bool := "coq-core.plugins.ltac2" "pstring_equal". Ltac2 @ external compare : t -> t -> int := "coq-core.plugins.ltac2" "pstring_compare". coq-8.20.0/user-contrib/Ltac2/RedFlags.v000066400000000000000000000027111466560755400176450ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* 'a) : unit := r.(contents) := f (r.(contents)). coq-8.20.0/user-contrib/Ltac2/Std.v000066400000000000000000000275651466560755400167260ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* constr), intro_pattern) | IntroRewrite (bool) ] with or_and_intro_pattern := [ | IntroOrPattern (intro_pattern list list) | IntroAndPattern (intro_pattern list) ]. Ltac2 Type destruction_arg := [ | ElimOnConstr (unit -> constr_with_bindings) | ElimOnIdent (ident) | ElimOnAnonHyp (int) ]. Ltac2 Type induction_clause := { indcl_arg : destruction_arg; indcl_eqn : intro_pattern_naming option; indcl_as : or_and_intro_pattern option; indcl_in : clause option; }. Ltac2 Type assertion := [ | AssertType (intro_pattern option, constr, (unit -> unit) option) | AssertValue (ident, constr) ]. Ltac2 Type repeat := [ | Precisely (int) | UpTo (int) | RepeatStar | RepeatPlus ]. Ltac2 Type orientation := [ LTR | RTL ]. Ltac2 Type rewriting := { rew_orient : orientation option; rew_repeat : repeat; rew_equatn : (unit -> constr_with_bindings); }. Ltac2 Type evar_flag := bool. Ltac2 Type advanced_flag := bool. Ltac2 Type move_location := [ | MoveAfter (ident) | MoveBefore (ident) | MoveFirst | MoveLast ]. Ltac2 Type inversion_kind := [ | SimpleInversion | FullInversion | FullInversionClear ]. (** Standard, built-in tactics. See Ltac1 for documentation. *) Ltac2 @ external intros : evar_flag -> intro_pattern list -> unit := "coq-core.plugins.ltac2" "tac_intros". Ltac2 @ external apply : advanced_flag -> evar_flag -> (unit -> constr_with_bindings) list -> (ident * (intro_pattern option)) option -> unit := "coq-core.plugins.ltac2" "tac_apply". Ltac2 @ external elim : evar_flag -> constr_with_bindings -> constr_with_bindings option -> unit := "coq-core.plugins.ltac2" "tac_elim". Ltac2 @ external case : evar_flag -> constr_with_bindings -> unit := "coq-core.plugins.ltac2" "tac_case". Ltac2 @ external generalize : (constr * occurrences * ident option) list -> unit := "coq-core.plugins.ltac2" "tac_generalize". Ltac2 @ external assert : assertion -> unit := "coq-core.plugins.ltac2" "tac_assert". Ltac2 @ external enough : constr -> (unit -> unit) option option -> intro_pattern option -> unit := "coq-core.plugins.ltac2" "tac_enough". Ltac2 @ external pose : ident option -> constr -> unit := "coq-core.plugins.ltac2" "tac_pose". Ltac2 @ external set : evar_flag -> (unit -> ident option * constr) -> clause -> unit := "coq-core.plugins.ltac2" "tac_set". Ltac2 @ external remember : evar_flag -> ident option -> (unit -> constr) -> intro_pattern option -> clause -> unit := "coq-core.plugins.ltac2" "tac_remember". Ltac2 @ external destruct : evar_flag -> induction_clause list -> constr_with_bindings option -> unit := "coq-core.plugins.ltac2" "tac_destruct". Ltac2 @ external induction : evar_flag -> induction_clause list -> constr_with_bindings option -> unit := "coq-core.plugins.ltac2" "tac_induction". Ltac2 @ external red : clause -> unit := "coq-core.plugins.ltac2" "tac_red". Ltac2 @ external hnf : clause -> unit := "coq-core.plugins.ltac2" "tac_hnf". Ltac2 @ external simpl : red_flags -> (pattern * occurrences) option -> clause -> unit := "coq-core.plugins.ltac2" "tac_simpl". Ltac2 @ external cbv : red_flags -> clause -> unit := "coq-core.plugins.ltac2" "tac_cbv". Ltac2 @ external cbn : red_flags -> clause -> unit := "coq-core.plugins.ltac2" "tac_cbn". Ltac2 @ external lazy : red_flags -> clause -> unit := "coq-core.plugins.ltac2" "tac_lazy". Ltac2 @ external unfold : (reference * occurrences) list -> clause -> unit := "coq-core.plugins.ltac2" "tac_unfold". Ltac2 @ external fold : constr list -> clause -> unit := "coq-core.plugins.ltac2" "tac_fold". Ltac2 @ external pattern : (constr * occurrences) list -> clause -> unit := "coq-core.plugins.ltac2" "tac_pattern". Ltac2 @ external vm : (pattern * occurrences) option -> clause -> unit := "coq-core.plugins.ltac2" "tac_vm". Ltac2 @ external native : (pattern * occurrences) option -> clause -> unit := "coq-core.plugins.ltac2" "tac_native". Ltac2 @ external eval_red : constr -> constr := "coq-core.plugins.ltac2" "eval_red". Ltac2 @ external eval_hnf : constr -> constr := "coq-core.plugins.ltac2" "eval_hnf". Ltac2 @ external eval_red : constr -> constr := "coq-core.plugins.ltac2" "eval_red". Ltac2 @ external eval_simpl : red_flags -> (pattern * occurrences) option -> constr -> constr := "coq-core.plugins.ltac2" "eval_simpl". Ltac2 @ external eval_cbv : red_flags -> constr -> constr := "coq-core.plugins.ltac2" "eval_cbv". Ltac2 @ external eval_cbn : red_flags -> constr -> constr := "coq-core.plugins.ltac2" "eval_cbn". Ltac2 @ external eval_lazy : red_flags -> constr -> constr := "coq-core.plugins.ltac2" "eval_lazy". Ltac2 @ external eval_unfold : (reference * occurrences) list -> constr -> constr := "coq-core.plugins.ltac2" "eval_unfold". Ltac2 @ external eval_fold : constr list -> constr -> constr := "coq-core.plugins.ltac2" "eval_fold". Ltac2 @ external eval_pattern : (constr * occurrences) list -> constr -> constr := "coq-core.plugins.ltac2" "eval_pattern". Ltac2 @ external eval_vm : (pattern * occurrences) option -> constr -> constr := "coq-core.plugins.ltac2" "eval_vm". Ltac2 @ external eval_native : (pattern * occurrences) option -> constr -> constr := "coq-core.plugins.ltac2" "eval_native". Ltac2 @ external change : pattern option -> (constr array -> constr) -> clause -> unit := "coq-core.plugins.ltac2" "tac_change". Ltac2 @ external rewrite : evar_flag -> rewriting list -> clause -> (unit -> unit) option -> unit := "coq-core.plugins.ltac2" "tac_rewrite". Ltac2 @ external setoid_rewrite : orientation -> (unit -> constr_with_bindings) -> occurrences -> ident option -> unit := "coq-core.plugins.ltac2" "tac_setoid_rewrite". Ltac2 @ external reflexivity : unit -> unit := "coq-core.plugins.ltac2" "tac_reflexivity". Ltac2 @ external assumption : unit -> unit := "coq-core.plugins.ltac2" "tac_assumption". Ltac2 @ external transitivity : constr -> unit := "coq-core.plugins.ltac2" "tac_transitivity". Ltac2 @ external etransitivity : unit -> unit := "coq-core.plugins.ltac2" "tac_etransitivity". Ltac2 @ external cut : constr -> unit := "coq-core.plugins.ltac2" "tac_cut". Ltac2 @ external left : evar_flag -> bindings -> unit := "coq-core.plugins.ltac2" "tac_left". Ltac2 @ external right : evar_flag -> bindings -> unit := "coq-core.plugins.ltac2" "tac_right". Ltac2 @ external constructor : evar_flag -> unit := "coq-core.plugins.ltac2" "tac_constructor". Ltac2 @ external split : evar_flag -> bindings -> unit := "coq-core.plugins.ltac2" "tac_split". Ltac2 @ external constructor_n : evar_flag -> int -> bindings -> unit := "coq-core.plugins.ltac2" "tac_constructorn". Ltac2 @ external intros_until : hypothesis -> unit := "coq-core.plugins.ltac2" "tac_introsuntil". Ltac2 @ external symmetry : clause -> unit := "coq-core.plugins.ltac2" "tac_symmetry". Ltac2 @ external rename : (ident * ident) list -> unit := "coq-core.plugins.ltac2" "tac_rename". Ltac2 @ external revert : ident list -> unit := "coq-core.plugins.ltac2" "tac_revert". Ltac2 @ external admit : unit -> unit := "coq-core.plugins.ltac2" "tac_admit". Ltac2 @ external fix_ : ident -> int -> unit := "coq-core.plugins.ltac2" "tac_fix". Ltac2 @ external cofix_ : ident -> unit := "coq-core.plugins.ltac2" "tac_cofix". Ltac2 @ external clear : ident list -> unit := "coq-core.plugins.ltac2" "tac_clear". Ltac2 @ external keep : ident list -> unit := "coq-core.plugins.ltac2" "tac_keep". Ltac2 @ external clearbody : ident list -> unit := "coq-core.plugins.ltac2" "tac_clearbody". Ltac2 @ external exact_no_check : constr -> unit := "coq-core.plugins.ltac2" "tac_exactnocheck". Ltac2 @ external vm_cast_no_check : constr -> unit := "coq-core.plugins.ltac2" "tac_vmcastnocheck". Ltac2 @ external native_cast_no_check : constr -> unit := "coq-core.plugins.ltac2" "tac_nativecastnocheck". Ltac2 @ external inversion : inversion_kind -> destruction_arg -> intro_pattern option -> ident list option -> unit := "coq-core.plugins.ltac2" "tac_inversion". (** coretactics *) Ltac2 @ external move : ident -> move_location -> unit := "coq-core.plugins.ltac2" "tac_move". Ltac2 @ external intro : ident option -> move_location option -> unit := "coq-core.plugins.ltac2" "tac_intro". Ltac2 @ external specialize : constr_with_bindings -> intro_pattern option -> unit := "coq-core.plugins.ltac2" "tac_specialize". (** extratactics *) Ltac2 @ external discriminate : evar_flag -> destruction_arg option -> unit := "coq-core.plugins.ltac2" "tac_discriminate". Ltac2 @ external injection : evar_flag -> intro_pattern list option -> destruction_arg option -> unit := "coq-core.plugins.ltac2" "tac_injection". Ltac2 @ external absurd : constr -> unit := "coq-core.plugins.ltac2" "tac_absurd". Ltac2 @ external contradiction : constr_with_bindings option -> unit := "coq-core.plugins.ltac2" "tac_contradiction". Ltac2 @ external autorewrite : bool -> (unit -> unit) option -> ident list -> clause -> unit := "coq-core.plugins.ltac2" "tac_autorewrite". Ltac2 @ external subst : ident list -> unit := "coq-core.plugins.ltac2" "tac_subst". Ltac2 @ external subst_all : unit -> unit := "coq-core.plugins.ltac2" "tac_substall". (** auto *) Ltac2 Type debug := [ Off | Info | Debug ]. Ltac2 Type strategy := [ BFS | DFS ]. Ltac2 @ external trivial : debug -> reference list -> ident list option -> unit := "coq-core.plugins.ltac2" "tac_trivial". Ltac2 @ external auto : debug -> int option -> reference list -> ident list option -> unit := "coq-core.plugins.ltac2" "tac_auto". Ltac2 @ external eauto : debug -> int option -> reference list -> ident list option -> unit := "coq-core.plugins.ltac2" "tac_eauto". Ltac2 @ external typeclasses_eauto : strategy option -> int option -> ident list option -> unit := "coq-core.plugins.ltac2" "tac_typeclasses_eauto". Ltac2 @ external resolve_tc : constr -> unit := "coq-core.plugins.ltac2" "tac_resolve_tc". (** Resolve the existential variables appearing in the constr whose types are typeclasses. Fail if any of them cannot be resolved. Does not focus. *) Ltac2 @ external unify : constr -> constr -> unit := "coq-core.plugins.ltac2" "tac_unify". coq-8.20.0/user-contrib/Ltac2/String.v000066400000000000000000000031251466560755400174240ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* char -> string := "coq-core.plugins.ltac2" "string_make". Ltac2 @external length : string -> int := "coq-core.plugins.ltac2" "string_length". Ltac2 @external get : string -> int -> char := "coq-core.plugins.ltac2" "string_get". Ltac2 @external set : string -> int -> char -> unit := "coq-core.plugins.ltac2" "string_set". Ltac2 @external concat : string -> string list -> string := "coq-core.plugins.ltac2" "string_concat". Ltac2 @external app : string -> string -> string := "coq-core.plugins.ltac2" "string_app". Ltac2 @external sub : string -> int -> int -> string := "coq-core.plugins.ltac2" "string_sub". Ltac2 @external equal : string -> string -> bool := "coq-core.plugins.ltac2" "string_equal". Ltac2 @external compare : string -> string -> int := "coq-core.plugins.ltac2" "string_compare". Ltac2 is_empty s := match s with "" => true | _ => false end. coq-8.20.0/user-contrib/Ltac2/TransparentState.v000066400000000000000000000025041466560755400214600ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* t := "coq-core.plugins.ltac2" "current_transparent_state". coq-8.20.0/user-contrib/Ltac2/Uint63.v000066400000000000000000000014551466560755400172520ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* t -> bool := "coq-core.plugins.ltac2" "uint63_equal". coq-8.20.0/user-contrib/Ltac2/Unification.v000066400000000000000000000026311466560755400204270ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* constr -> constr -> unit := "coq-core.plugins.ltac2" "evarconv_unify". (** [unify_with_full_ts] is like [unify TransparentState.full]. *) Ltac2 unify_with_full_ts : constr -> constr -> unit := fun c1 c2 => unify TransparentState.full c1 c2. (** [unify_with_current_ts] is like [unify (TransparentState.current ())]. *) Ltac2 unify_with_current_ts : constr -> constr -> unit := fun c1 c2 => unify (TransparentState.current ()) c1 c2. coq-8.20.0/user-contrib/Ltac2/dune.disabled000066400000000000000000000003111466560755400204050ustar00rootroot00000000000000(coq.theory (name Ltac2) (package coq-stdlib) (synopsis "Ltac2 tactic language") (flags -w -deprecated-native-compiler-option) (plugins coq-core.plugins.ltac2_ltac1 coq-core.plugins.ltac2)) coq-8.20.0/vernac/000077500000000000000000000000001466560755400136635ustar00rootroot00000000000000coq-8.20.0/vernac/assumptions.ml000066400000000000000000000403771466560755400166150ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* raise Not_found | (l, SFBmodule mb) :: _ when Label.equal l lab -> mb | _ :: fields -> search_mod_label lab fields let rec search_cst_label lab = function | [] -> raise Not_found | (l, SFBconst cb) :: _ when Label.equal l lab -> cb | _ :: fields -> search_cst_label lab fields let rec search_mind_label lab = function | [] -> raise Not_found | (l, SFBmind mind) :: _ when Label.equal l lab -> mind | _ :: fields -> search_mind_label lab fields (* TODO: using [empty_delta_resolver] below is probably slightly incorrect. But: a) I don't see currently what should be used instead b) this shouldn't be critical for Print Assumption. At worse some constants will have a canonical name which is non-canonical, leading to failures in [Global.lookup_constant], but our own [lookup_constant] should work. *) let rec fields_of_functor f subs mp0 args = function | NoFunctor a -> f subs mp0 args a | MoreFunctor (mbid,_,e) -> let open Mod_subst in match args with | [] -> assert false (* we should only encounter applied functors *) | mpa :: args -> let subs = join (map_mbid mbid mpa empty_delta_resolver (*TODO*)) subs in fields_of_functor f subs mp0 args e let rec lookup_module_in_impl mp = match mp with | MPfile _ -> Global.lookup_module mp | MPbound _ -> Global.lookup_module mp | MPdot (mp',lab') -> if ModPath.equal mp' (Global.current_modpath ()) then Global.lookup_module mp else let fields = memoize_fields_of_mp mp' in search_mod_label lab' fields and memoize_fields_of_mp mp = try MPmap.find mp !modcache with Not_found -> let l = fields_of_mp mp in modcache := MPmap.add mp l !modcache; l and fields_of_mp mp = let open Mod_subst in let mb = lookup_module_in_impl mp in let fields,inner_mp,subs = fields_of_mb empty_subst mb [] in let subs = if ModPath.equal inner_mp mp then subs else add_mp inner_mp mp mb.mod_delta subs in Modops.subst_structure subs fields and fields_of_mb subs mb args = match mb.mod_expr with | Algebraic expr -> fields_of_expression subs mb.mod_mp args mb.mod_type expr | Struct sign -> let sign = Modops.annotate_struct_body sign mb.mod_type in fields_of_signature subs mb.mod_mp args sign | Abstract|FullStruct -> fields_of_signature subs mb.mod_mp args mb.mod_type (** The Abstract case above corresponds to [Declare Module] *) and fields_of_signature x = fields_of_functor (fun subs mp0 args struc -> assert (List.is_empty args); (struc, mp0, subs)) x and fields_of_expr subs mp0 args = function | MEident mp -> let mb = lookup_module_in_impl (Mod_subst.subst_mp subs mp) in fields_of_mb subs mb args | MEapply (me1,mp2) -> fields_of_expr subs mp0 (mp2::args) me1 | MEwith _ -> assert false (* no 'with' in [mod_expr] *) and fields_of_expression subs mp args mty me = let me = Modops.annotate_module_expression me mty in fields_of_functor fields_of_expr subs mp args me let lookup_constant_in_impl cst fallback = try let mp,lab = KerName.repr (Constant.canonical cst) in let fields = memoize_fields_of_mp mp in (* A module found this way is necessarily closed, in particular our constant cannot be in an opened section : *) search_cst_label lab fields with Not_found -> (* Either: - The module part of the constant isn't registered yet : we're still in it, so the [constant_body] found earlier (if any) was a true axiom. - The label has not been found in the structure. This is an error *) match fallback with | Some cb -> cb | None -> CErrors.anomaly Pp.(str "Print Assumption: unknown constant " ++ Constant.print cst ++ str ".") let lookup_constant cst = let env = Global.env() in if not (Environ.mem_constant cst env) then lookup_constant_in_impl cst None else let cb = Environ.lookup_constant cst env in if Declareops.constant_has_body cb then cb else lookup_constant_in_impl cst (Some cb) let lookup_mind_in_impl mind = try let mp,lab = KerName.repr (MutInd.canonical mind) in let fields = memoize_fields_of_mp mp in search_mind_label lab fields with Not_found -> CErrors.anomaly Pp.(str "Print Assumption: unknown inductive " ++ MutInd.print mind ++ str ".") let lookup_mind mind = let env = Global.env() in if Environ.mem_mind mind env then Environ.lookup_mind mind env else lookup_mind_in_impl mind (** Graph traversal of an object, collecting on the way the dependencies of traversed objects *) let label_of = let open GlobRef in function | ConstRef kn -> Constant.label kn | IndRef (kn,_) | ConstructRef ((kn,_),_) -> MutInd.label kn | VarRef id -> Label.of_id id let fold_with_full_binders g f n acc c = let open Context.Rel.Declaration in let open Constr in match kind c with | Rel _ | Meta _ | Var _ | Sort _ | Const _ | Ind _ | Construct _ | Int _ | Float _ | String _ -> acc | Cast (c,_, t) -> f n (f n acc c) t | Prod (na,t,c) -> f (g (LocalAssum (na,t)) n) (f n acc t) c | Lambda (na,t,c) -> f (g (LocalAssum (na,t)) n) (f n acc t) c | LetIn (na,b,t,c) -> f (g (LocalDef (na,b,t)) n) (f n (f n acc b) t) c | App (c,l) -> Array.fold_left (f n) (f n acc c) l | Proj (_,_,c) -> f n acc c | Evar _ -> assert false | Case (ci, u, pms, p, iv, c, bl) -> let mib = lookup_mind (fst ci.ci_ind) in let (ci, (p,_), iv, c, bl) = Inductive.expand_case_specif mib (ci, u, pms, p, iv, c, bl) in Array.fold_left (f n) (f n (fold_invert (f n) (f n acc p) iv) c) bl | Fix (_,(lna,tl,bl)) -> let n' = CArray.fold_left2_i (fun i c n t -> g (LocalAssum (n,lift i t)) c) n lna tl in let fd = Array.map2 (fun t b -> (t,b)) tl bl in Array.fold_left (fun acc (t,b) -> f n' (f n acc t) b) acc fd | CoFix (_,(lna,tl,bl)) -> let n' = CArray.fold_left2_i (fun i c n t -> g (LocalAssum (n,lift i t)) c) n lna tl in let fd = Array.map2 (fun t b -> (t,b)) tl bl in Array.fold_left (fun acc (t,b) -> f n' (f n acc t) b) acc fd | Array(_u,t,def,ty) -> f n (f n (Array.fold_left (f n) acc t) def) ty let get_constant_body access kn = let cb = lookup_constant kn in match cb.const_body with | Undef _ | Primitive _ | Symbol _ -> None | Def c -> Some c | OpaqueDef o -> match Global.force_proof access o with | c, _ -> Some c | exception e when CErrors.noncritical e -> None (* missing delayed body, e.g. in vok mode *) let rec traverse access current ctx accu t = let open GlobRef in let open Constr in match Constr.kind t with | Var id -> let body () = id |> Global.lookup_named |> NamedDecl.get_value in traverse_object access accu body (VarRef id) | Const (kn, _) -> let body () = get_constant_body access kn in traverse_object access accu body (ConstRef kn) | Ind ((mind, _) as ind, _) -> traverse_inductive access accu mind (IndRef ind) | Construct (((mind, _), _) as cst, _) -> traverse_inductive access accu mind (ConstructRef cst) | Meta _ | Evar _ -> assert false | Case (_, _, _, (([|_|], oty),_), _, c, [||]) when Vars.noccurn 1 oty -> (* non dependent match on an inductive with no constructors *) begin match Constr.kind c with | Const (kn, _) when not (Declareops.constant_has_body (lookup_constant kn)) -> let (curr, data, ax2ty) = accu in let obj = ConstRef kn in let already_in = GlobRef.Map_env.mem obj data in let data = if not already_in then GlobRef.Map_env.add obj None data else data in let ty = (current, ctx, Vars.subst1 mkProp oty) in let ax2ty = try let l = GlobRef.Map_env.find obj ax2ty in GlobRef.Map_env.add obj (ty::l) ax2ty with Not_found -> GlobRef.Map_env.add obj [ty] ax2ty in (GlobRef.Set_env.add obj curr, data, ax2ty) | _ -> fold_with_full_binders Context.Rel.add (traverse access current) ctx accu t end | _ -> fold_with_full_binders Context.Rel.add (traverse access current) ctx accu t and traverse_object access (curr, data, ax2ty) body obj = let data, ax2ty = let already_in = GlobRef.Map_env.mem obj data in if already_in then data, ax2ty else match body () (* Beware: this can be very costly *) with | None -> GlobRef.Map_env.add obj None data, ax2ty | Some body -> let contents,data,ax2ty = traverse access (label_of obj) Context.Rel.empty (GlobRef.Set_env.empty,data,ax2ty) body in GlobRef.Map_env.add obj (Some contents) data, ax2ty in (GlobRef.Set_env.add obj curr, data, ax2ty) (** Collects the references occurring in the declaration of mutual inductive definitions. All the constructors and names of a mutual inductive definition share exactly the same dependencies. Also, there is no explicit dependency between mutually defined inductives and constructors. *) and traverse_inductive access (curr, data, ax2ty) mind obj = let firstind_ref = (GlobRef.IndRef (mind, 0)) in let label = label_of obj in let data, ax2ty = (* Invariant : I_0 \in data iff I_i \in data iff c_ij \in data where I_0, I_1, ... are in the same mutual definition and c_ij are all their constructors. *) if (* recursive call: *) GlobRef.Set_env.mem firstind_ref curr || (* already in: *) GlobRef.Map_env.mem firstind_ref data then data, ax2ty else (* Take into account potential recursivity of ind in itself *) let curr = GlobRef.Set_env.add firstind_ref GlobRef.Set_env.empty in let accu = (curr, data, ax2ty) in let mib = lookup_mind mind in (* Collects references of parameters *) let param_ctx = mib.mind_params_ctxt in let nparam = List.length param_ctx in let accu = traverse_context access label Context.Rel.empty accu param_ctx in (* For each inductive, collects references in their arity and in the type of constructors*) let (contents, data, ax2ty) = Array.fold_left (fun accu oib -> let arity_wo_param = List.rev (List.skipn nparam (List.rev oib.mind_arity_ctxt)) in let accu = traverse_context access label param_ctx accu arity_wo_param in Array.fold_left (fun accu cst_typ -> let param_ctx, cst_typ_wo_param = Term.decompose_prod_n_decls nparam cst_typ in traverse access label param_ctx accu cst_typ_wo_param) accu oib.mind_user_lc) accu mib.mind_packets in (* Maps all these dependencies to inductives and constructors*) let data = let contents = GlobRef.Set_env.remove firstind_ref contents in Array.fold_left_i (fun n data oib -> let ind = (mind, n) in let data = GlobRef.Map_env.add (GlobRef.IndRef ind) (Some contents) data in Array.fold_left_i (fun k data _ -> GlobRef.Map_env.add (GlobRef.ConstructRef (ind, k+1)) (Some contents) data ) data oib.mind_consnames) data mib.mind_packets in (data, ax2ty) in (GlobRef.Set_env.add obj curr, data, ax2ty) (** Collects references in a rel_context. *) and traverse_context access current ctx accu ctxt = snd (Context.Rel.fold_outside (fun decl (ctx, accu) -> match decl with | Context.Rel.Declaration.LocalDef (_,c,t) -> let accu = traverse access current ctx (traverse access current ctx accu t) c in let ctx = Context.Rel.add decl ctx in ctx, accu | Context.Rel.Declaration.LocalAssum (_,t) -> let accu = traverse access current ctx accu t in let ctx = Context.Rel.add decl ctx in ctx, accu) ctxt ~init:(ctx, accu)) let traverse access current t = let () = modcache := MPmap.empty in traverse access current Context.Rel.empty (GlobRef.Set_env.empty, GlobRef.Map_env.empty, GlobRef.Map_env.empty) t (** Hopefully bullet-proof function to recover the type of a constant. It just ignores all the universe stuff. There are many issues that can arise when considering terms out of any valid environment, so use with caution. *) let type_of_constant cb = cb.Declarations.const_type let uses_uip mib = Array.exists (fun mip -> Option.is_empty mip.mind_squashed && mip.mind_relevance == Sorts.Irrelevant && Array.length mip.mind_nf_lc = 1 && List.length (fst mip.mind_nf_lc.(0)) = List.length mib.mind_params_ctxt) mib.mind_packets let assumptions ?(add_opaque=false) ?(add_transparent=false) access st gr t = let open Printer in (* Only keep the transitive dependencies *) let (_, graph, ax2ty) = traverse access (label_of gr) t in let open GlobRef in let fold obj contents accu = match obj with | VarRef id -> let decl = Global.lookup_named id in if Context.Named.Declaration.is_local_assum decl then let t = Context.Named.Declaration.get_type decl in ContextObjectMap.add (Variable id) t accu else accu | ConstRef kn -> let cb = lookup_constant kn in let accu = if cb.const_typing_flags.check_guarded then accu else let l = try GlobRef.Map_env.find obj ax2ty with Not_found -> [] in ContextObjectMap.add (Axiom (Guarded obj, l)) Constr.mkProp accu in let accu = if cb.const_typing_flags.check_universes then accu else let l = try GlobRef.Map_env.find obj ax2ty with Not_found -> [] in ContextObjectMap.add (Axiom (TypeInType obj, l)) Constr.mkProp accu in if not (Option.has_some contents) then let t = type_of_constant cb in let l = try GlobRef.Map_env.find obj ax2ty with Not_found -> [] in ContextObjectMap.add (Axiom (Constant kn,l)) t accu else if add_opaque && (Declareops.is_opaque cb || not (Structures.PrimitiveProjections.is_transparent_constant st kn)) then let t = type_of_constant cb in ContextObjectMap.add (Opaque kn) t accu else if add_transparent then let t = type_of_constant cb in ContextObjectMap.add (Transparent kn) t accu else accu | IndRef (m,_) | ConstructRef ((m,_),_) -> let mind = lookup_mind m in let accu = if mind.mind_typing_flags.check_positive then accu else let l = try GlobRef.Map_env.find obj ax2ty with Not_found -> [] in ContextObjectMap.add (Axiom (Positive m, l)) Constr.mkProp accu in let accu = if mind.mind_typing_flags.check_guarded then accu else let l = try GlobRef.Map_env.find obj ax2ty with Not_found -> [] in ContextObjectMap.add (Axiom (Guarded obj, l)) Constr.mkProp accu in let accu = if mind.mind_typing_flags.check_universes then accu else let l = try GlobRef.Map_env.find obj ax2ty with Not_found -> [] in ContextObjectMap.add (Axiom (TypeInType obj, l)) Constr.mkProp accu in let accu = if not (uses_uip mind) then accu else let l = try GlobRef.Map_env.find obj ax2ty with Not_found -> [] in ContextObjectMap.add (Axiom (UIP m, l)) Constr.mkProp accu in accu in GlobRef.Map_env.fold fold graph ContextObjectMap.empty coq-8.20.0/vernac/assumptions.mli000066400000000000000000000032551466560755400167600ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* Label.t -> constr -> (GlobRef.Set_env.t * GlobRef.Set_env.t option GlobRef.Map_env.t * (Label.t * Constr.rel_context * types) list GlobRef.Map_env.t) (** Collects all the assumptions (optionally including opaque definitions) on which a term relies (together with their type). The above warning of {!traverse} also applies. *) val assumptions : ?add_opaque:bool -> ?add_transparent:bool -> Global.indirect_accessor -> TransparentState.t -> GlobRef.t -> constr -> types ContextObjectMap.t coq-8.20.0/vernac/attributes.ml000066400000000000000000000340741466560755400164130ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* Pp.str b | FlagString s -> Pp.(quote (str s)) let rec pr_vernac_flag_value = let open Pp in function | VernacFlagEmpty -> mt () | VernacFlagLeaf l -> str "=" ++ pr_vernac_flag_leaf l | VernacFlagList s -> surround (prlist_with_sep pr_comma pr_vernac_flag s) and pr_vernac_flag_r (s, arguments) = let open Pp in str s ++ (pr_vernac_flag_value arguments) and pr_vernac_flag {CAst.v} = pr_vernac_flag_r v let warn_unsupported_attributes = CWarnings.create ~name:"unsupported-attributes" ~category:CWarnings.CoreCategories.parsing ~default:CWarnings.AsError (fun atts -> let keys = List.map (fun x -> fst x.CAst.v) atts in let keys = List.sort_uniq String.compare keys in let conj = match keys with [_] -> "this attribute: " | _ -> "these attributes: " in Pp.(str "This command does not support " ++ str conj ++ prlist_with_sep (fun () -> strbrk ", ") str keys ++ str".")) let unsupported_attributes = function | [] -> () | atts -> let loc = List.fold_left (fun loc att -> Loc.merge_opt loc att.CAst.loc) None atts in warn_unsupported_attributes ?loc atts type 'a key_parser = ?loc:Loc.t -> 'a option -> vernac_flag_value -> 'a type 'a attribute = vernac_flags -> vernac_flags * 'a let parse_with_extra (p:'a attribute) (atts:vernac_flags) : vernac_flags * 'a = p atts let parse_drop_extra att atts = snd (parse_with_extra att atts) let parse (p:'a attribute) atts : 'a = let extra, v = parse_with_extra p atts in unsupported_attributes extra; v let make_attribute x = x module Notations = struct type 'a t = 'a attribute let return x = fun atts -> atts, x let (>>=) att f = fun atts -> let atts, v = att atts in f v atts let (>>) p1 p2 = fun atts -> let atts, () = p1 atts in p2 atts let map f att = fun atts -> let atts, v = att atts in atts, f v let (++) (p1:'a attribute) (p2:'b attribute) : ('a*'b) attribute = fun atts -> let atts, v1 = p1 atts in let atts, v2 = p2 atts in atts, (v1, v2) end open Notations let assert_empty ?loc k v = if v <> VernacFlagEmpty then CErrors.user_err ?loc Pp.(str "Attribute " ++ str k ++ str " does not accept arguments") let error_twice ?loc ~name : 'a = CErrors.user_err ?loc Pp.(str "Attribute for " ++ str name ++ str " specified twice.") let assert_once ?loc ~name prev = if Option.has_some prev then error_twice ?loc ~name let attribute_of_list (l:(string * 'a key_parser) list) : 'a option attribute = let rec p extra v = function | [] -> List.rev extra, v | ({CAst.v=key, attv; loc} as att) :: rem -> (match CList.assoc_f String.equal key l with | exception Not_found -> p (att::extra) v rem | parser -> let v = Some (parser ?loc v attv) in p extra v rem) in p [] None let single_key_parser ~name ~key v ?loc prev args = assert_empty ?loc key args; assert_once ?loc ~name prev; v let pr_possible_values ~values = Pp.(str "{" ++ prlist_with_sep pr_comma str (List.map fst values) ++ str "}") (** [key_value_attribute ~key ~default ~values] parses a attribute [key=value] with possible [key] [value] in [values], [default] is for compatibility for users doing [qualif(key)] which is parsed as [qualif(key=default)] *) let key_value_attribute ~key ~default ~(values : (string * 'a) list) : 'a option attribute = let parser ?loc = function | Some v -> CErrors.user_err ?loc Pp.(str "key '" ++ str key ++ str "' has been already set.") | None -> begin function | VernacFlagLeaf (FlagIdent b) -> begin match CList.assoc_f String.equal b values with | exception Not_found -> CErrors.user_err ?loc Pp.(str "Invalid value '" ++ str b ++ str "' for key " ++ str key ++ fnl () ++ str "use one of " ++ pr_possible_values ~values) | value -> value end | VernacFlagEmpty -> default | err -> CErrors.user_err ?loc Pp.(str "Invalid syntax " ++ pr_vernac_flag_r (key, err) ++ str ", try " ++ str key ++ str "=" ++ pr_possible_values ~values ++ str " instead.") end in attribute_of_list [key, parser] let bool_attribute ~name : bool option attribute = let values = ["yes", true; "no", false] in key_value_attribute ~key:name ~default:true ~values (* Variant of the [bool] attribute with only two values (bool has three). *) let get_bool_value ?loc ~key ~default = function | VernacFlagEmpty -> default | VernacFlagLeaf (FlagIdent "yes") -> true | VernacFlagLeaf (FlagIdent "no") -> false | _ -> CErrors.user_err ?loc Pp.(str "Attribute " ++ str key ++ str " only accepts boolean values.") let enable_attribute ~key ~default : bool attribute = fun atts -> let this, extra = List.partition (fun {CAst.v=k, _} -> String.equal key k) atts in extra, match this with | [] -> default () | [ {CAst.v=_, value; loc} ] -> get_bool_value ?loc ~key ~default:true value | _ :: {CAst.loc} :: _ -> (* We report the location of the 2nd item *) error_twice ?loc ~name:key let qualify_attribute qual (parser:'a attribute) : 'a attribute = fun atts -> let rec extract extra qualified = function | [] -> List.rev extra, List.flatten (List.rev qualified) | {CAst.v=key,attv; loc} :: rem when String.equal key qual -> (match attv with | VernacFlagEmpty | VernacFlagLeaf _ -> CErrors.user_err ?loc Pp.(str "Malformed attribute " ++ str qual ++ str ": attribute list expected.") | VernacFlagList atts -> extract extra (atts::qualified) rem) | att :: rem -> extract (att::extra) qualified rem in let extra, qualified = extract [] [] atts in let rem, v = parser qualified in let rem = List.rev_map (fun rem -> CAst.make ?loc:rem.CAst.loc (qual, VernacFlagList [rem])) rem in let extra = List.rev_append rem extra in extra, v (** [program_mode] tells that Program mode has been activated, either globally via [Set Program] or locally via the Program command prefix. *) let program_mode_option_name = ["Program";"Mode"] let program_mode = ref false let () = let open Goptions in declare_bool_option { optstage = Summary.Stage.Interp; optdepr = None; optkey = program_mode_option_name; optread = (fun () -> !program_mode); optwrite = (fun b -> program_mode:=b) } let program = enable_attribute ~key:"program" ~default:(fun () -> !program_mode) (* This is a bit complex as the grammar in g_vernac.mlg doesn't distingish between the boolean and ternary case.*) let option_locality_parser = let name = "Locality" in attribute_of_list [ ("local", single_key_parser ~name ~key:"local" Goptions.OptLocal); ("global", single_key_parser ~name ~key:"global" Goptions.OptGlobal); ("export", single_key_parser ~name ~key:"export" Goptions.OptExport); ] let option_locality = option_locality_parser >>= function | None -> return Goptions.OptDefault | Some l -> return l let explicit_hint_locality = let open Hints in let name = "Locality" in attribute_of_list [ ("local", single_key_parser ~name ~key:"local" Local); ("global", single_key_parser ~name ~key:"global" SuperGlobal); ("export", single_key_parser ~name ~key:"export" Export); ] let default_hint_locality () = if Lib.sections_are_opened () then Hints.Local else Hints.Export let hint_locality = explicit_hint_locality >>= function | Some v -> return v | None -> return (default_hint_locality()) (* locality is supposed to be true when local, false when global *) let locality = let name = "Locality" in attribute_of_list [ ("local", single_key_parser ~name ~key:"local" true); ("global", single_key_parser ~name ~key:"global" false); ] let ukey = "universes" let universe_polymorphism_option_name = ["Universe"; "Polymorphism"] let is_universe_polymorphism = let b = ref false in let () = let open Goptions in declare_bool_option { optstage = Summary.Stage.Interp; optdepr = None; optkey = universe_polymorphism_option_name; optread = (fun () -> !b); optwrite = ((:=) b) } in fun () -> !b let polymorphic = qualify_attribute ukey (bool_attribute ~name:"polymorphic") >>= function | Some b -> return b | None -> return (is_universe_polymorphism()) let template = qualify_attribute ukey (bool_attribute ~name:"template") let unfold_fix = enable_attribute ~key:"unfold_fix" ~default:(fun () -> false) let deprecation_parser : Deprecation.t key_parser = fun ?loc orig args -> assert_once ?loc ~name:"deprecation" orig; match args with | VernacFlagList [ {CAst.v="since", VernacFlagLeaf (FlagString since)}; {CAst.v="note", VernacFlagLeaf (FlagString note)} ] | VernacFlagList [ {CAst.v="note", VernacFlagLeaf (FlagString note)}; {CAst.v="since", VernacFlagLeaf (FlagString since)} ] -> Deprecation.make ~since ~note () | VernacFlagList [ {CAst.v="since", VernacFlagLeaf (FlagString since)} ] -> Deprecation.make ~since () | VernacFlagList [ {CAst.v="note", VernacFlagLeaf (FlagString note)} ] -> Deprecation.make ~note () | _ -> CErrors.user_err ?loc (Pp.str "Ill formed “deprecated” attribute.") let deprecation = attribute_of_list ["deprecated",deprecation_parser] let user_warn_parser : UserWarn.warn list key_parser = fun ?loc orig args -> let orig = Option.default [] orig in match args with | VernacFlagList [ {CAst.v="note", VernacFlagLeaf (FlagString note)}; {CAst.v="cats", VernacFlagLeaf (FlagString cats)} ] | VernacFlagList [ {CAst.v="cats", VernacFlagLeaf (FlagString cats)}; {CAst.v="note", VernacFlagLeaf (FlagString note)} ] -> UserWarn.make_warn ~note ~cats () :: orig | VernacFlagList [ {CAst.v="note", VernacFlagLeaf (FlagString note)} ] -> UserWarn.make_warn ~note () :: orig | _ -> CErrors.user_err ?loc (Pp.str "Ill formed “warn” attribute.") let user_warn_warn = attribute_of_list ["warn",user_warn_parser] >>= function | None -> return [] | Some l -> return (List.rev l) let user_warns = (deprecation ++ user_warn_warn) >>= function | None, [] -> return None | depr, warn -> return (Some UserWarn.{ depr; warn }) let only_locality atts = parse locality atts let only_polymorphism atts = parse polymorphic atts let vernac_polymorphic_flag loc = CAst.make ?loc (ukey, VernacFlagList [CAst.make ?loc ("polymorphic", VernacFlagEmpty)]) let vernac_monomorphic_flag loc = CAst.make ?loc (ukey, VernacFlagList [CAst.make ?loc ("polymorphic", VernacFlagLeaf (FlagIdent "no"))]) let reversible = bool_attribute ~name:"reversible" let canonical_field = enable_attribute ~key:"canonical" ~default:(fun () -> true) let canonical_instance = enable_attribute ~key:"canonical" ~default:(fun () -> false) let payload_parser ?cat ~name : string key_parser = fun ?loc orig args -> match args with | VernacFlagLeaf (FlagString str) -> begin match orig, cat with | None, _ -> str | Some orig, Some cat -> cat orig str | Some _, None -> error_twice ?loc ~name end | _ -> CErrors.user_err ?loc Pp.(str "Ill formed \"" ++ str name ++ str"\" attribute") let payload_attribute ?cat ~name = attribute_of_list [name, payload_parser ?cat ~name] let using = payload_attribute ?cat:None ~name:"using" let process_typing_att ?loc ~typing_flags att disable = let enable = not disable in match att with | "universes" -> { typing_flags with Declarations.check_universes = enable } | "guard" -> { typing_flags with Declarations.check_guarded = enable } | "positivity" -> { typing_flags with Declarations.check_positive = enable } | att -> CErrors.user_err ?loc Pp.(str "Unknown “typing” attribute: " ++ str att) let process_typing_disable ?loc ~key = function | VernacFlagEmpty | VernacFlagLeaf (FlagIdent "yes") -> true | VernacFlagLeaf (FlagIdent "no") -> false | _ -> CErrors.user_err ?loc Pp.(str "Ill-formed attribute value, must be " ++ str key ++ str "={yes, no}") let typing_flags_parser : Declarations.typing_flags key_parser = fun ?loc orig args -> let rec flag_parser typing_flags = function | [] -> typing_flags | {CAst.v=typing_att, disable; loc} :: rest -> let disable = process_typing_disable ?loc ~key:typing_att disable in let typing_flags = process_typing_att ?loc ~typing_flags typing_att disable in flag_parser typing_flags rest in match args with | VernacFlagList atts -> let typing_flags = Global.typing_flags () in flag_parser typing_flags atts | att -> CErrors.user_err ?loc Pp.(str "Ill-formed “typing” attribute: " ++ pr_vernac_flag_value att) let typing_flags = attribute_of_list ["bypass_check", typing_flags_parser] let bind_scope_where = let name = "where to bind scope" in attribute_of_list [ ("add_top", single_key_parser ~name ~key:"add_top" Notation.AddScopeTop); ("add_bottom", single_key_parser ~name ~key:"add_bottom" Notation.AddScopeBottom); ] let raw_attributes : _ attribute = fun flags -> [], flags coq-8.20.0/vernac/attributes.mli000066400000000000000000000142551466560755400165630ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* Pp.t type +'a attribute (** The type of attributes. When parsing attributes if an ['a attribute] is present then an ['a] value will be produced. In the most general case, an attribute transforms the raw flags along with its value. *) val parse : 'a attribute -> vernac_flags -> 'a (** Errors on unsupported attributes. *) val unsupported_attributes : vernac_flags -> unit (** Errors if the list of flags is nonempty. *) module Notations : sig (** Notations to combine attributes. *) include Monad.Def with type 'a t = 'a attribute (** Attributes form a monad. [a1 >>= f] means [f] will be run on the flags transformed by [a1] and using the value produced by [a1]. The trivial attribute [return x] does no action on the flags. *) val (++) : 'a attribute -> 'b attribute -> ('a * 'b) attribute (** Combine 2 attributes. If any keys are in common an error will be raised. *) end (** Definitions for some standard attributes. *) val raw_attributes : vernac_flags attribute val polymorphic : bool attribute val program : bool attribute val template : bool option attribute val unfold_fix : bool attribute val locality : bool option attribute val option_locality : Goptions.option_locality attribute val deprecation : Deprecation.t option attribute val user_warn_warn : UserWarn.warn list attribute val user_warns : UserWarn.t option attribute val reversible : bool option attribute val canonical_field : bool attribute val canonical_instance : bool attribute val using : string option attribute val explicit_hint_locality : Hints.hint_locality option attribute val bind_scope_where : Notation.add_scope_where option attribute (** Default: if sections are opened then Local otherwise Export. Although this is named and uses the type [hint_locality] it may be used as the standard 3-valued locality attribute. *) val hint_locality : Hints.hint_locality attribute (** Enable/Disable universe checking *) val typing_flags : Declarations.typing_flags option attribute val program_mode_option_name : string list (** For internal use when messing with the global option. *) val only_locality : vernac_flags -> bool option (** Parse attributes allowing only locality. *) val only_polymorphism : vernac_flags -> bool (** Parse attributes allowing only polymorphism. Uses the global flag for the default value. *) val parse_drop_extra : 'a attribute -> vernac_flags -> 'a (** Ignores unsupported attributes. *) val parse_with_extra : 'a attribute -> vernac_flags -> vernac_flags * 'a (** Returns unsupported attributes. *) (** * Defining attributes. *) type 'a key_parser = ?loc:Loc.t -> 'a option -> vernac_flag_value -> 'a (** A parser for some key in an attribute. It is given a nonempty ['a option] when the attribute is multiply set for some command. eg in [#[polymorphic] Monomorphic Definition foo := ...], when parsing [Monomorphic] it will be given [Some true]. *) val attribute_of_list : (string * 'a key_parser) list -> 'a option attribute (** Make an attribute from a list of key parsers together with their associated key. *) val payload_parser : ?cat:(string -> string -> string) -> name:string -> string key_parser (** [payload_parser ?cat ~name] parses attributes like [#[name="payload"]]. If the attribute is used multiple times and [cat] is non-None, the payloads are concatenated using it. If [cat] is None, having multiple occurences of the attribute is forbidden. *) val payload_attribute : ?cat:(string -> string -> string) -> name:string -> string option attribute (** This is just [attribute_of_list] for a single [payload_parser]. *) (** Define boolean attribute [name], of the form [name={yes,no}]. The attribute may only be set once for a command. *) val bool_attribute : name:string -> bool option attribute val qualify_attribute : string -> 'a attribute -> 'a attribute (** [qualified_attribute qual att] treats [#[qual(atts)]] like [att] treats [atts]. *) (** Combinators to help define your own parsers. See the implementation of [bool_attribute] for practical use. *) val assert_empty : ?loc:Loc.t -> string -> vernac_flag_value -> unit (** [assert_empty key v] errors if [v] is not empty. [key] is used in the error message as the name of the attribute. *) val assert_once : ?loc:Loc.t -> name:string -> 'a option -> unit (** [assert_once ~name v] errors if [v] is not empty. [name] is used in the error message as the name of the attribute. Used to ensure that a given attribute is not reapeated. *) val single_key_parser : name:string -> key:string -> 'a -> 'a key_parser (** [single_key_parser ~name ~key v] makes a parser for attribute [name] giving the constant value [v] for key [key] taking no arguments. [name] may only be given once. *) val make_attribute : (vernac_flags -> vernac_flags * 'a) -> 'a attribute (** Make an attribute using the internal representation, thus with access to the full power of attributes. Unstable. *) (** Compatibility values for parsing [Polymorphic]. *) val vernac_polymorphic_flag : Loc.t option -> vernac_flag val vernac_monomorphic_flag : Loc.t option -> vernac_flag (** For internal use. *) val universe_polymorphism_option_name : string list val is_universe_polymorphism : unit -> bool coq-8.20.0/vernac/auto_ind_decl.ml000066400000000000000000002044021466560755400170100ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* RelDecl.LocalAssum (Context.map_annot (named_hd env t) na, t) | RelDecl.LocalDef (na,c,t) -> RelDecl.LocalDef (Context.map_annot (named_hd env c) na, c, t) let name_context env ctxt = snd (List.fold_left (fun (env,hyps) d -> let d' = name_assumption env d in (Environ.push_rel d' env, d' :: hyps)) (env,[]) (List.rev ctxt)) (* Some pre declaration of constant we are going to use *) let andb_prop = fun _ -> UnivGen.constr_of_monomorphic_global (Global.env ()) (Coqlib.lib_ref "core.bool.andb_prop") let andb_true_intro = fun _ -> UnivGen.constr_of_monomorphic_global (Global.env ()) (Coqlib.lib_ref "core.bool.andb_true_intro") (* We avoid to use lazy as the binding of constants can change *) let bb () = UnivGen.constr_of_monomorphic_global (Global.env ()) (Coqlib.lib_ref "core.bool.type") let tt () = UnivGen.constr_of_monomorphic_global (Global.env ()) (Coqlib.lib_ref "core.bool.true") let ff () = UnivGen.constr_of_monomorphic_global (Global.env ()) (Coqlib.lib_ref "core.bool.false") let eq () = UnivGen.constr_of_monomorphic_global (Global.env ()) (Coqlib.lib_ref "core.eq.type") let int63_eqb () = UnivGen.constr_of_monomorphic_global (Global.env ()) (Coqlib.lib_ref "num.int63.eqb") let float64_eqb () = UnivGen.constr_of_monomorphic_global (Global.env ()) (Coqlib.lib_ref "num.float.leibniz.eqb") let sumbool () = UnivGen.constr_of_monomorphic_global (Global.env ()) (Coqlib.lib_ref "core.sumbool.type") let andb = fun _ -> UnivGen.constr_of_monomorphic_global (Global.env ()) (Coqlib.lib_ref "core.bool.andb") let induct_on c = Induction.induction false None c None None let destruct_on c = Induction.destruct false None c None None let destruct_on_using c id = let open Tactypes in Induction.destruct false None c (Some (CAst.make @@ IntroOrPattern [[CAst.make @@ IntroNaming IntroAnonymous]; [CAst.make @@ IntroNaming (IntroIdentifier id)]])) None let destruct_on_as c l = Induction.destruct false None c (Some (CAst.make l)) None let inj_flags = Some { Equality.keep_proof_equalities = true; (* necessary *) Equality.injection_pattern_l2r_order = true; (* does not matter here *) } let my_discr_tac = Equality.discr_tac false None let my_inj_tac x = Equality.inj inj_flags None false None (EConstr.mkVar x,NoBindings) (* reconstruct the inductive with the correct de Bruijn indexes *) let mkFullInd env (ind,u) n = let mib = Environ.lookup_mind (fst ind) env in mkApp (mkIndU (ind,u), Context.Rel.instance mkRel n mib.mind_params_ctxt) let mkPartialInd env (ind,u) n = let mib = Environ.lookup_mind (fst ind) env in let _, recparams_ctx = Inductive.inductive_nonrec_rec_paramdecls (mib,u) in mkApp (mkIndU (ind,u), Context.Rel.instance mkRel n recparams_ctx) let name_X = Context.make_annot (Name (Id.of_string "X")) Sorts.Relevant let name_Y = Context.make_annot (Name (Id.of_string "Y")) Sorts.Relevant let mk_eqb_over u = mkProd (name_X, u, (mkProd (name_Y, lift 1 u, bb ()))) let check_bool_is_defined () = if not (Coqlib.has_ref "core.bool.type") then raise (UndefinedCst "bool") let check_no_indices mib = if Array.exists (fun mip -> mip.mind_nrealargs <> 0) mib.mind_packets then raise DecidabilityIndicesNotSupported let is_irrelevant env c = match kind (EConstr.Unsafe.to_constr (Retyping.get_type_of env (Evd.from_env env) (EConstr.of_constr c))) with | Sort SProp -> true | _ -> false let get_scheme handle k ind = match Ind_tables.local_lookup_scheme handle k ind with | None -> assert false | Some c -> c let beq_scheme_kind_aux = ref (fun _ -> failwith "Undefined") let get_inductive_deps ~noprop env kn = (* fetching the mutual inductive body *) let mib = Environ.lookup_mind kn env in (* number of params in the type *) check_no_indices mib; let env = Environ.push_rel_context mib.mind_params_ctxt env in let sigma = Evd.from_env env in let get_deps_one accu i mip = (* This function is only trying to recursively compute the inductive types appearing as arguments of the constructors. This is done to support equality decision over hereditarily first-order types. It could be performed in a much cleaner way, e.g. using the kernel normal form of constructor types and kernel whd_all for the argument types. *) let rec aux env accu c = let (c,a) = Reductionops.whd_all_stack env sigma c in match EConstr.kind sigma c with | Cast (x,_,_) -> aux env accu (EConstr.applist (x,a)) | App _ -> assert false | Ind ((kn', _ as ind), _) -> if Environ.QMutInd.equal env kn kn' then (* Example: Inductive T A := C : T (option A) -> T A. *) List.fold_left (aux env) accu a else let _,mip = Inductive.lookup_mind_specif env ind in (* Types in SProp have trivial equality and are skipped *) if match mip.mind_arity with RegularArity {mind_sort = SProp} -> true | _ -> false then List.fold_left (aux env) accu a else List.fold_left (aux env) (kn' :: accu) a | Const (kn, u) -> (match Environ.constant_opt_value_in env (kn, EConstr.EInstance.kind sigma u) with | Some c -> aux env accu (EConstr.applist (EConstr.of_constr c,a)) | None -> accu) | Rel _ | Var _ | Sort _ | Prod _ | Lambda _ | LetIn _ | Proj _ | Construct _ | Case _ | CoFix _ | Fix _ | Meta _ | Evar _ | Int _ | Float _ | String _ | Array _ -> Termops.fold_constr_with_full_binders env sigma EConstr.push_rel aux env (List.fold_left (aux env) accu a) c in let fold i accu (constr_ctx,_) = let constr_ctx, _ = List.chop mip.mind_consnrealdecls.(i) constr_ctx in let rec fold env accu = function | [] -> env, accu | decl::ctx -> let env, accu = fold env accu ctx in let t = Context.Rel.Declaration.get_type decl in Environ.push_rel decl env, (if noprop && is_irrelevant env t then accu else aux env accu (EConstr.of_constr t)) in snd (fold env accu constr_ctx) in Array.fold_left_i fold accu mip.mind_nf_lc in Array.fold_left_i (fun i accu mip -> get_deps_one accu i mip) [] mib.mind_packets (** A compact data structure to remember for each declaration of the context if it is a type and comes with a Boolean equality; if it comes with an equality we remember the integer to subtract to the de Bruijn indices of the binder to get the equality *) type eq_status = | End (* int is the number of consecutive declarations without an equality *) | WithoutEq of int * eq_status (* list is the list of shifts for consecutive declarations with an equality *) | WithEq of int list * eq_status let add_eq_status_no = function | WithEq _ | End as s -> WithoutEq (1, s) | WithoutEq (n, s) -> WithoutEq (n+1, s) let set_eq_status_yes n q s = let rec aux n = function | WithoutEq (p,End) when Int.equal n p -> WithoutEq (p-1, WithEq ([q],End)) | WithoutEq (p,WithEq (l,s)) when Int.equal n p -> WithoutEq (p-1, WithEq (q::l,s)) | WithoutEq (p,s) when n < p -> WithoutEq (n-1, WithEq ([q], WithoutEq (p-n, s))) | WithoutEq (p,s) when Int.equal n 1 -> WithEq ([q], WithoutEq (p-1, s)) | WithoutEq (p,s) -> WithoutEq (p, aux (n-p) s) | WithEq (l,s) -> WithEq (l,aux (n-List.length l) s) | End -> assert false in aux n s let rec has_decl_equality n status = match n, status with | p, WithEq (l,s) when p <= List.length l -> Some (List.nth l (p-1)) | p, WithEq (l,s) -> has_decl_equality (p-List.length l) s | p, WithoutEq (n,s) when p <= n -> None | p, WithoutEq (n,s) -> has_decl_equality (p-n) s | _, End -> assert false (** The reallocation of variables to be done during the translation: [env] is the current env at the corresponding step of the translation [lift] is the lift for the original variables [eq_status] tells how to get the equality associated with a variable if any [ind_pos] tells the position of recursive calls (it could have been avoided by replacing the recursive occurrences of ind in an inductive definition by variables *) type env_lift = { env : Environ.env; (* Gamma *) lift : Esubst.lift; (* lift : Gamma + Gamma_eq |- Gamma *) eq_status : eq_status; ind_pos : ((MutInd.t * int * rel_context * int) * int) option; } let lift_ind_pos n = Option.map (fun (ind,k) -> (ind,k+n)) let empty_env_lift env = { env = env; lift = Esubst.el_id; eq_status = End; ind_pos = None; } let push_env_lift decl env_lift = { env = Environ.push_rel decl env_lift.env; lift = Esubst.el_lift env_lift.lift; eq_status = add_eq_status_no env_lift.eq_status; ind_pos = lift_ind_pos 1 env_lift.ind_pos; } let set_replicate n q env_lift = { env = env_lift.env; lift = env_lift.lift; eq_status = set_eq_status_yes n q env_lift.eq_status; ind_pos = env_lift.ind_pos; } let shiftn_env_lift n env_lift = { env_lift with lift = Esubst.el_shft n (Esubst.el_liftn n env_lift.lift); ind_pos = lift_ind_pos n env_lift.ind_pos; } let find_ind_env_lift env_lift (mind,i) = match env_lift.ind_pos with | Some ((mind',nrecparams,recparamsctx,nb_ind),n) when Environ.QMutInd.equal env_lift.env mind mind' -> Some (nrecparams,recparamsctx,n+nb_ind-i) | _ -> None let shift_fix_env_lift ind nrecparams recparamsctx nb_ind env_lift = { env = env_lift.env; lift = Esubst.el_shft nb_ind env_lift.lift; eq_status = env_lift.eq_status; ind_pos = Some ((ind,nrecparams,recparamsctx,nb_ind),0) } let push_rec_env_lift recdef env_lift = let n = Array.length (pi1 recdef) in { env = Environ.push_rec_types recdef env_lift.env; lift = Esubst.el_liftn n env_lift.lift; eq_status = add_eq_status_no env_lift.eq_status; ind_pos = lift_ind_pos n env_lift.ind_pos; } let dest_lam_assum_expand env c = let ctx, c = Reduction.whd_decompose_lambda_decls env c in if List.is_empty ctx then ctx, c else let t = EConstr.Unsafe.to_constr (Retyping.get_type_of (Environ.push_rel_context ctx env) (Evd.from_env env) (EConstr.of_constr c)) in let ctx', _ = Reduction.whd_decompose_prod_decls env t in ctx'@ctx, mkApp (lift (Context.Rel.length ctx') c, Context.Rel.instance mkRel 0 ctx') let pred_context env ci params u nas = let mib, mip = Inductive.lookup_mind_specif env ci.ci_ind in let paramdecl = Vars.subst_instance_context u mib.mind_params_ctxt in let paramsubst = Vars.subst_of_rel_context_instance paramdecl params in let realdecls, _ = List.chop mip.mind_nrealdecls mip.mind_arity_ctxt in let self = let args = Context.Rel.instance mkRel 0 mip.mind_arity_ctxt in let inst = UVars.Instance.(abstract_instance (length u)) in mkApp (mkIndU (ci.ci_ind, inst), args) in let realdecls = RelDecl.LocalAssum (Context.anonR, self) :: realdecls in Inductive.instantiate_context u paramsubst nas realdecls let branch_context env ci params u nas i = let mib, mip = Inductive.lookup_mind_specif env ci.ci_ind in let paramdecl = Vars.subst_instance_context u mib.mind_params_ctxt in let paramsubst = Vars.subst_of_rel_context_instance paramdecl params in let ctx, _ = List.chop mip.mind_consnrealdecls.(i) (fst mip.mind_nf_lc.(i)) in Inductive.instantiate_context u paramsubst nas ctx let build_beq_scheme_deps env kn = let inds = get_inductive_deps ~noprop:true env kn in List.map (fun ind -> Ind_tables.SchemeMutualDep (ind, !beq_scheme_kind_aux ())) inds let build_beq_scheme env handle kn = check_bool_is_defined (); (* predef coq's boolean type *) (* here I leave the Naming thingy so that the type of the function is more readable for the user *) let eqName = Context.map_annot (function | Name s -> Name (Id.of_string ("eq_"^(Id.to_string s))) | Anonymous -> Name (Id.of_string "eq_A")) in (* The Boolean equality translation is a parametricity translation where each type T is interpreted as the pair of: - a (possibly degenerate) predicate T_R in Type over T (i.e. T_R : T->Type) - when T is decidable, a Boolean equality T_E over (i.e. T_E : option (T->T->bool) where None means not decidable, that is, at worst, unknown to be decidable) This generalizes into an interpretation of each term M:T as: - an inhabitant [|M|] of T_R M by setting for sort s: - s_R := \T:s.{R:T->s ; E:option (T->T->bool)} and - s_E := None so that types T:s are indeed interpreted as a pair, namely by: - [|T|] := {R:=T_R; E:=T_E} : s_R T and, in particular: - [|Type(n)|] := {R:=Type(n)_R; E:=Type(n)_E) : Type(n+1)_R Type(n) In practice, to have simpler schemes, we won't support here the full hierarchy of sorts. That is, we assume that type parameters of a type will be instantiated only by small types (i.e. not containing sorts). This makes sense since equality on large types is anyway not decidable in the general case [*]. Now, it happens that several parts of the translation are degenerate. For instance, if T is a small type (not containing sorts), then T_R M, which expresses that M realizes T, is a singleton for all M (we assume functional extensionality to treat the case of dependent product types). Therefore, M_T does not need to be defined in this case. Conversely, if T is not small, it is not decidable and T_E will be None. This means that at least T_R is degenerate or T_E is None and this also means that for M:T with degenerate T_R, we don't need to compute [|M|].R This further means that when translating a variable x:T with T small, it can just be translated to x:T without requiring the trivial information that T_R x is inhabited. Similarly for types T of the form [forall X, (forall Y ...) ... Y args] based on the assumption [*] that Y is instantiated only by small functorial types for which (Y args)_R would be degenerate. Similarly, based on the restriction above [*] that parameters are instantiated by small types, when translating a variable x:T with T an arity, i.e. of the form [... -> Type] (or at worst [... -> Type*Type] etc.), we can assume x to be instantiated by a small functorial type whose R translation is degenerate. It remains the declarations of the form X:T for T of the form [forall X, ... X args] where X is in negative position of a dependent product. If such X is instantiated by a large type in the definition, as in [Inductive I (F:forall X:Type, X->X) (B:F Type nat) := C : B -> I F B], we give up. Otherwise said, we support only the case when `X`is instantiated by a small type. Eventually, we thus need two translations: - T_R when T is large and it does not need to go under applicative subterms since subterms [X args] are considered small by assumption [*] - T_E when T is small which needs to go under subterms and which thus needs to be generalized into a translation M_E : T_R.E whenever T is detected as decidable (in which case, T_R.E is typically of the form T->T->bool or of the form (T.1->T.1->bool)*(T.2->T.2->bool), etc.) Below, the first translation is called [translate_type_eq] and the second [translate_term_eq]. Additionally, there is a copy-cat translation called "translate_term" that lifts M in the typing context of M_R. The function [translate_type_eq] takes as input a type T and a term M of type T and it returns T_R M. For M of type T, the function [translate_term_eq M] returns an object of type term T_R M, that is, when M is itself some type U, an object of type U->U->bool. Note that we don't use an option type for non-decidable types but instead raises an exception whenever a type is not detected as decidable. Future work might support: - exotic types such as [Inductive I (F:forall X:Type, X->X) (B:F Type nat) := C : B -> I F B] - types with invertible indices like listn - dependent products over finite types (e.g. over bool->bool), and more generally compact types whose equality is decidable (see Escardo-Oliva) *) let rec translate_type_eq env_lift na c t = let ctx, t = Reduction.whd_decompose_prod_decls env t in let env_lift', ctx_eq = translate_context_eq env_lift ctx in let inst = Array.map (translate_term env_lift') (Context.Rel.instance mkRel 0 ctx) in let env_lift'' = shiftn_env_lift (Context.Rel.length ctx_eq) env_lift in let c = mkApp (translate_term env_lift'' c, inst) in let c = match kind t with | Sort _ -> Some (mk_eqb_over c) | Prod _ | LetIn _ -> assert false (* [s] is necessaritly a sort *) | Cast (t,k,s) -> begin match translate_type_eq env_lift' na c t with | None -> None | Some t -> Some (mkCast (t, k, mkProd (na, t, c))) end (* TODO: take into account situations like (P:Type * Type) which could be translated into (fst P->fst P>bool)*(snd P->snd P->bool); to be done in parallel with preserving the types in Proj/Construct/CoFix *) | Ind _ -> None | Array _ -> None (* We assume references to be references to small types and thus to types with singleton realizability predicate; to support references to large types, see comments above for the full translation *) | App _ | Rel _ | Var _ | Const _ -> None (* The restricted translation translates only types *) | Lambda _ | Construct _ -> assert false | Case (ci, u, pms, ((pnames,p),r), iv, tm, lbr) -> let env_lift_pred = shiftn_env_lift (Array.length pnames) env_lift in let t = mkCase (ci, u, Array.map (translate_term env_lift_pred) pms, (translate_term_with_binders env_lift_pred (pnames,p), r), Constr.map_invert (translate_term env_lift_pred) iv, mkRel 1, Array.map (translate_term_with_binders env_lift_pred) lbr) in (* in the restricted translation, only types are translated and the return predicate is necessarily a type *) let p = mkProd (Context.anonR, t, p) in let lbr = Array.mapi (fun i (names, t) -> let ctx = branch_context env ci pms u names i in let env_lift' = List.fold_right push_env_lift ctx env_lift in match translate_type_eq env_lift' na (mkRel 1) t with | None -> None | Some t_eq -> Some (names, mkLambda (na, t, t_eq))) lbr in if Array.for_all Option.has_some lbr then let lbr = Array.map Option.get lbr in let case = mkCase (ci, u, pms, ((pnames, p), r), iv, translate_term env_lift tm, lbr) in Some (mkApp (case, [|c|])) else None (* TODO: in parallel with traversing Fix in translate_term_eq to look for types, traverse Fix to look for Type here *) | Fix _ -> None (* Not building a type *) | Proj _ | CoFix _ | Int _ | Float _ | String _ -> None | Meta _ | Evar _ -> assert false (* kernel terms *) in Option.map (fun c -> Term.it_mkProd_or_LetIn c ctx_eq) c and translate_term_eq env_lift c = let ctx, c = dest_lam_assum_expand env_lift.env c in let env_lift, ctx = translate_context_eq env_lift ctx in let c = match Constr.kind c with | Rel x -> (match has_decl_equality x env_lift.eq_status with | Some n -> Some (mkRel (Esubst.reloc_rel x env_lift.lift - n)) | None -> None) | Var x -> if Reduction.is_arity env (Typeops.type_of_variable env x) then (* Support for working in a context with "eq_x : x -> x -> bool" *) let eid = Id.of_string ("eq_"^(Id.to_string x)) in let () = try ignore (Environ.lookup_named eid env) with Not_found -> raise (ParameterWithoutEquality (GlobRef.VarRef x)) in Some (mkVar eid) else None | Cast (c,k,t) -> begin match translate_term_eq env_lift c, translate_type_eq env_lift Context.anonR c t with | Some c, Some t -> Some (mkCast (c,k,t)) | None, None -> None | (None | Some _), _ -> assert false end | Lambda _ | LetIn _ -> assert false | App (f,args) -> begin let f, args = match kind f with | Ind (ind',_) -> (match find_ind_env_lift env_lift ind' with | Some (nrecparams,_,n) when Array.length args >= nrecparams -> Some (mkRel n), Array.sub args nrecparams (Array.length args - nrecparams) | _ -> translate_term_eq env_lift f, args) | Const (kn,u) -> (match Environ.constant_opt_value_in env (kn, u) with | Some c -> translate_term_eq env_lift (mkApp (c,args)), [||] | None -> translate_term_eq env_lift f, args) | _ -> translate_term_eq env_lift f, args in match f with | Some f -> Some (mkApp (f, translate_arguments_eq env_lift args)) | None -> None end | Ind (ind',u) -> begin match find_ind_env_lift env_lift ind' with | Some (_,recparamsctx,n) -> Some (Term.it_mkLambda_or_LetIn (mkRel n) (translate_context env_lift recparamsctx)) | None -> try Some (mkConstU (get_scheme handle (!beq_scheme_kind_aux()) ind',u)) with Not_found -> raise(EqNotFound ind') end | Const (kn,u as cst) -> if Environ.is_int63_type env kn then Some (int63_eqb ()) else if Environ.is_float64_type env kn then Some (float64_eqb ()) else if Environ.is_array_type env kn then (* TODO *) raise (ParameterWithoutEquality (GlobRef.ConstRef kn)) else (match Environ.constant_opt_value_in env (kn, u) with | Some c -> translate_term_eq env_lift c | None -> if Reduction.is_arity env (Typeops.type_of_constant_in env cst) then (* Support for working in a context with "eq_x : x -> x -> bool" *) (* Needs Hints, see test suite *) let eq_lbl = Label.make ("eq_" ^ Label.to_string (Constant.label kn)) in let kneq = Constant.change_label kn eq_lbl in if Environ.mem_constant kneq env then let _ = Environ.constant_opt_value_in env (kneq, u) in Some (mkConstU (kneq,u)) else raise (ParameterWithoutEquality (GlobRef.ConstRef kn)) else None) (* TODO: in parallel with preserving Type for Ind in translate_type_eq, preserve the types in Construct/CoFix *) | Proj _ | Construct _ | CoFix _ -> None | Case (ci, u, pms, ((pnames,p), r), iv, tm, lbr) -> let pctx = pred_context env ci pms u pnames in let env_lift_pred = List.fold_right push_env_lift pctx env_lift in let n = Array.length pnames in let c = mkCase (ci, u, Array.map (lift n) pms, ((pnames, liftn n (n+1) p), r), Constr.map_invert (lift n) iv, mkRel 1, Array.map (fun (names, br) -> (names, let q = Array.length names in liftn n (n+q+1) br)) lbr) in let p = translate_type_eq env_lift_pred Context.anonR c p in let lbr = Array.mapi (fun i (names, t) -> let ctx = branch_context env ci pms u names i in let env_lift' = List.fold_right push_env_lift ctx env_lift in match translate_term_eq env_lift' t with | None -> None | Some t_eq -> Some (names, t_eq)) lbr in if Array.for_all Option.has_some lbr && Option.has_some p then let lbr = Array.map Option.get lbr in Some (mkCase (ci, u, pms, ((pnames, Option.get p), r), iv, translate_term env_lift tm, lbr)) else None | Fix ((recindxs,i),(names,typarray,bodies as recdef)) -> let _ = (* Almost work: would need: 1. that the generated fix has an eq_status registration telling that an original recursive call should be interpreted as the pair of the whole fix and of the translated recursive call building the equality 2. something to do around either packaging the type with its equality, or begin able for a match to have a return predicate different though convertible to itself, namely here a fix of match (see test-suite) *) let mkfix j = mkFix ((recindxs,j),recdef) in let typarray = Array.mapi (fun i -> translate_type_eq env_lift Context.anonR (mkfix i)) typarray in let env_lift_types = push_rec_env_lift recdef env_lift in let bodies = Array.map (translate_term_eq env_lift_types) bodies in if Array.for_all Option.has_some bodies && Array.for_all Option.has_some typarray then let bodies = Array.map Option.get bodies in let typarray = Array.map Option.get typarray in Some (mkFix ((recindxs,i),(names,typarray,bodies))) else None in None | Sort _ -> raise InductiveWithSort (* would require a more sophisticated translation *) | Prod _ -> raise InductiveWithProduct (* loss of decidable if uncountable domain *) | Meta _ | Evar _ -> None (* assert false! *) | Int _ | Float _ | String _ | Array _ -> None in Option.map (fun c -> Term.it_mkLambda_or_LetIn c ctx) c (* Translate context by adding a context of Boolean equalities for each type argument Example of translated context: (F : (U -> U) -> nat -> U) (eq_F : forall G, (forall A, eq A -> eq (G A)) -> nat -> eq (F G)) *) and translate_context_eq env_lift ctx = let ctx = name_context env_lift.env ctx in let (env_lift_ctx,nctx_eq,ctx_with_eq) = List.fold_right (fun decl (env_lift,n,ctx) -> let env_lift = push_env_lift decl env_lift in let env_lift' = shiftn_env_lift (n-1) env_lift in match decl with | RelDecl.LocalDef (na,c,t) -> (match translate_term_eq env_lift' (lift 1 c), translate_type_eq env_lift' na (mkRel 1) (lift 1 t) with | Some eq_c, Some eq_typ -> (set_replicate 1 n env_lift, n, RelDecl.LocalDef (eqName na,eq_c,eq_typ) :: ctx) | None, None -> (env_lift, n-1, ctx) | (None | Some _), _ -> assert false) | RelDecl.LocalAssum (na,t) -> match translate_type_eq env_lift' na (mkRel 1) (lift 1 t) with | Some eq_typ -> (set_replicate 1 n env_lift, n, RelDecl.LocalAssum (eqName na,eq_typ) :: ctx) | None -> (env_lift, n-1, ctx) ) ctx (env_lift, Context.Rel.length ctx, ctx) in shiftn_env_lift nctx_eq env_lift_ctx, ctx_with_eq (* Translate arguments by adding Boolean equality when relevant Examples of translated applications: F (fun A => A) 0 eq_F (fun A => A) (fun A eq_A => eq_A) 0 F (fun A => list A) 0 eq_F (fun A => list A) (fun A eq_A => eq_list A eq_A) 0 *) and translate_arguments_eq env_lift args = let args' = Array.map (translate_term env_lift) args in let eq_args = Array.of_list (List.map_filter (translate_term_eq env_lift) (Array.to_list args)) in Array.append args' eq_args (* Copy-cat translation with relocation *) and translate_term env_lift c = exliftn env_lift.lift c and translate_context env_lift ctx = Context.Rel.map_with_binders (fun i -> translate_term (shiftn_env_lift i env_lift)) ctx and translate_term_with_binders env_lift (names,c) = (names, translate_term (shiftn_env_lift (Array.length names) env_lift) c) in (* Starting translating the inductive block to Boolean equalities; Morally corresponds to the Ind case of translate_term_eq *) (* fetching the mutual inductive body *) let mib = Environ.lookup_mind kn env in (* Setting universes *) let auctx = Declareops.universes_context mib.mind_universes in let u, uctx = UnivGen.fresh_instance_from auctx None in let uctx = UState.of_context_set uctx in (* number of inductives in the mutual *) let nb_ind = Array.length mib.mind_packets in let truly_recursive = let open Declarations in let is_rec ra = match Declareops.dest_recarg ra with Mrec _ -> true | Norec -> false in Array.exists (fun mip -> Array.exists (List.exists is_rec) (Declareops.dest_subterms mip.mind_recargs)) mib.mind_packets in (* params context divided *) let nonrecparams_ctx,recparams_ctx = Inductive.inductive_nonrec_rec_paramdecls (mib,u) in let params_ctx = nonrecparams_ctx @ recparams_ctx in let nparamsdecls = Context.Rel.length params_ctx in check_no_indices mib; let env_lift_recparams, recparams_ctx_with_eqs = translate_context_eq (empty_env_lift env) recparams_ctx in let env_lift_recparams_fix, fix_ctx, names, types = match mib.mind_finite with | CoFinite -> raise NoDecidabilityCoInductive | Finite when truly_recursive || nb_ind > 1 (* Hum, there exist non-recursive mutual types... *) -> (* rec name *) let rec_name i = (Id.to_string (Array.get mib.mind_packets i).mind_typename)^"_eqrec" in let names = Array.init nb_ind (fun i -> Context.make_annot (Name (Id.of_string (rec_name i))) Sorts.Relevant) in let types = Array.init nb_ind (fun i -> Option.get (translate_type_eq env_lift_recparams Context.anonR (mkPartialInd env ((kn,i),u) 0) (Term.it_mkProd_or_LetIn (*any sort:*) mkSet nonrecparams_ctx))) in let fix_ctx = List.rev (Array.to_list (Array.map2 (fun na t -> RelDecl.LocalAssum (na,t)) names types)) in shift_fix_env_lift kn mib.mind_nparams_rec recparams_ctx nb_ind env_lift_recparams, fix_ctx, names, types | Finite | BiFinite -> env_lift_recparams, [], [||], [||] in let env_lift_recparams_fix_nonrecparams, nonrecparams_ctx_with_eqs = translate_context_eq env_lift_recparams_fix nonrecparams_ctx in let make_one_eq cur = (* construct the "fun A B ... N, eqA eqB eqC ... N => fixpoint" part *) let ind = (kn,cur) in let indu = (ind,u) in let tomatch_ctx = RelDecl.[ LocalAssum (name_Y, translate_term (shiftn_env_lift 1 env_lift_recparams_fix_nonrecparams) (mkFullInd env indu 0)); LocalAssum (name_X, translate_term env_lift_recparams_fix_nonrecparams (mkFullInd env indu 0)) ] in let env_lift_recparams_fix_nonrecparams_tomatch = shiftn_env_lift 2 env_lift_recparams_fix_nonrecparams in (* current inductive we are working on *) let open Term in let pred = let cur_packet = mib.mind_packets.(cur) in (* Inductive toto : [rettyp] := *) let rettyp = Inductive.type_of_inductive ((mib,cur_packet),u) in (* split rettyp in a list without the non rec params and the last -> e.g. Inductive vec (A:Set) : nat -> Set := ... will do [nat] *) let _, rettyp = decompose_prod_n_decls nparamsdecls rettyp in let rettyp_l, _ = decompose_prod_decls rettyp in (* construct the predicate for the Case part*) Term.it_mkLambda_or_LetIn (mkLambda (Context.make_annot Anonymous Sorts.Relevant, mkFullInd env indu (List.length rettyp_l), (bb ()))) rettyp_l in (* make_one_eq *) (* do the [| C1 ... => match Y with ... end ... Cn => match Y with ... end |] part *) let rci = EConstr.ERelevance.relevant in (* returning a boolean, hence relevant *) let open Inductiveops in let constrs = let params = Context.Rel.instance_list EConstr.mkRel 0 params_ctx in get_constructors env (make_ind_family (on_snd EConstr.EInstance.make indu, params)) in let make_andb_list = function | [] -> tt () | eq :: eqs -> List.fold_left (fun eqs eq -> mkApp (andb(),[|eq;eqs|])) eq eqs in let body = match Environ.get_projections env ind with | Some projs -> (* A primitive record *) let nb_cstr_args = List.length constrs.(0).cs_args in let _,_,eqs = List.fold_right (fun decl (ndx,env_lift,l) -> let decl = EConstr.Unsafe.to_rel_decl decl in let env_lift' = push_env_lift decl env_lift in match decl with | RelDecl.LocalDef (na,b,t) -> (ndx-1,env_lift',l) | RelDecl.LocalAssum (na,cc) -> if is_irrelevant env_lift.env cc then (ndx-1,env_lift',l) else if Vars.noccur_between 1 (nb_cstr_args-ndx) cc then let cc = lift (ndx-nb_cstr_args) cc in match translate_term_eq env_lift_recparams_fix_nonrecparams_tomatch cc with | None -> raise (EqUnknown "type") (* A supported type should have an eq *) | Some eqA -> let proj, relevance = projs.(nb_cstr_args-ndx) in let proj = Projection.make proj true in (ndx-1,env_lift',mkApp (eqA, [|mkProj (proj, relevance, mkRel 2); mkProj (proj, relevance, mkRel 1)|])::l) else raise InternalDependencies) constrs.(0).cs_args (nb_cstr_args,env_lift_recparams_fix_nonrecparams_tomatch,[]) in make_andb_list eqs | None -> (* An inductive type *) let ci = make_case_info env ind MatchStyle in let nconstr = Array.length constrs in let ar = Array.init nconstr (fun i -> let nb_cstr_args = List.length constrs.(i).cs_args in let env_lift_recparams_fix_nonrecparams_tomatch_csargsi = shiftn_env_lift nb_cstr_args env_lift_recparams_fix_nonrecparams_tomatch in let ar2 = Array.init nconstr (fun j -> let env_lift_recparams_fix_nonrecparams_tomatch_csargsij = shiftn_env_lift nb_cstr_args env_lift_recparams_fix_nonrecparams_tomatch_csargsi in let cc = if Int.equal i j then let _,_,eqs = List.fold_right (fun decl (ndx,env_lift,l) -> let decl = EConstr.Unsafe.to_rel_decl decl in let env_lift' = push_env_lift decl env_lift in match decl with | RelDecl.LocalDef (na,b,t) -> (ndx-1,env_lift',l) | RelDecl.LocalAssum (na,cc) -> if is_irrelevant env_lift.env cc then (ndx-1,env_lift',l) else if Vars.noccur_between 1 (nb_cstr_args-ndx) cc then let cc = lift (ndx-nb_cstr_args) cc in match translate_term_eq env_lift_recparams_fix_nonrecparams_tomatch_csargsij cc with | None -> raise (EqUnknown "type") (* A supported type should have an eq *) | Some eqA -> (ndx-1,env_lift',mkApp (eqA, [|mkRel (ndx+nb_cstr_args);mkRel ndx|])::l) else raise InternalDependencies) constrs.(j).cs_args (nb_cstr_args,env_lift_recparams_fix_nonrecparams_tomatch_csargsij,[]) in make_andb_list eqs else ff () in let cs_argsj = translate_context env_lift_recparams_fix_nonrecparams_tomatch_csargsi (EConstr.Unsafe.to_rel_context constrs.(j).cs_args) in Term.it_mkLambda_or_LetIn cc cs_argsj) in let predj = EConstr.of_constr (translate_term env_lift_recparams_fix_nonrecparams_tomatch_csargsi pred) in let case = simple_make_case_or_project env (Evd.from_env env) ci (predj,rci) NoInvert (EConstr.mkRel (nb_cstr_args + 1)) (EConstr.of_constr_array ar2) in let cs_argsi = translate_context env_lift_recparams_fix_nonrecparams_tomatch (EConstr.Unsafe.to_rel_context constrs.(i).cs_args) in Term.it_mkLambda_or_LetIn (EConstr.Unsafe.to_constr case) cs_argsi) in let predi = EConstr.of_constr (translate_term env_lift_recparams_fix_nonrecparams_tomatch pred) in let case = simple_make_case_or_project env (Evd.from_env env) ci (predi,rci) NoInvert (EConstr.mkRel 2) (EConstr.of_constr_array ar) in EConstr.Unsafe.to_constr case in Term.it_mkLambda_or_LetIn (Term.it_mkLambda_or_LetIn body tomatch_ctx) nonrecparams_ctx_with_eqs in (* build_beq_scheme *) let res = match mib.mind_finite with | CoFinite -> raise NoDecidabilityCoInductive | Finite when truly_recursive || nb_ind > 1 (* Hum... *) -> let cores = Array.init nb_ind make_one_eq in Array.init nb_ind (fun i -> let kelim = Inductiveops.elim_sort (mib,mib.mind_packets.(i)) in if not (Sorts.family_leq InSet kelim) then raise (NonSingletonProp (kn,i)); let decrArg = Context.Rel.length nonrecparams_ctx_with_eqs in let fix = mkFix (((Array.make nb_ind decrArg),i),(names,types,cores)) in Term.it_mkLambda_or_LetIn fix recparams_ctx_with_eqs) | Finite | BiFinite -> assert (Int.equal nb_ind 1); (* If the inductive type is not recursive, the fixpoint is not used, so let's replace it with garbage *) let kelim = Inductiveops.elim_sort (mib,mib.mind_packets.(0)) in if not (Sorts.family_leq InSet kelim) then raise (NonSingletonProp (kn,0)); [|Term.it_mkLambda_or_LetIn (make_one_eq 0) recparams_ctx_with_eqs|] in res, uctx let beq_scheme_kind = Ind_tables.declare_mutual_scheme_object "beq" ~deps:build_beq_scheme_deps build_beq_scheme let _ = beq_scheme_kind_aux := fun () -> beq_scheme_kind (* This function tryies to get the [inductive] between a constr the constr should be Ind i or App(Ind i,[|args|]) *) let destruct_ind env sigma c = let open EConstr in let (c,v) = Reductionops.whd_all_stack env sigma c in destInd sigma c, Array.of_list v let bl_scheme_kind_aux = ref (fun () -> failwith "Undefined") let lb_scheme_kind_aux = ref (fun () -> failwith "Undefined") (* In the following, avoid is the list of names to avoid. If the args of the Inductive type are A1 ... An then avoid should be [| lb_An ... lb _A1 (resp. bl_An ... bl_A1) eq_An .... eq_A1 An ... A1 |] so from Ai we can find the correct eq_Ai bl_ai or lb_ai *) (* used in the leib -> bool side*) let do_replace_lb handle aavoid narg p q = let open EConstr in let avoid = Array.of_list aavoid in let do_arg env sigma hd v offset = match kind sigma v with | Var s -> let x = narg*offset in let n = Array.length avoid in let rec find i = if Id.equal avoid.(n-i) s then avoid.(n-i-x) else (if i (* Works in specific situations where the args have to be already declared as a Parameter (see example "J" in test file SchemeEquality.v); We assume the parameter to have the same polymorphic arity as cst *) let lbl = Label.to_string (Constant.label cst) in let newlbl = if Int.equal offset 1 then ("eq_" ^ lbl) else (lbl ^ "_lb") in let newcst = Constant.change_label cst (Label.make newlbl) in if Environ.mem_constant newcst env then mkConstU (newcst,u) else raise (ConstructorWithNonParametricInductiveType (fst hd)) | _ -> raise (ConstructorWithNonParametricInductiveType (fst hd)) in Proofview.Goal.enter begin fun gl -> let type_of_pq = Tacmach.pf_get_type_of gl p in let sigma = Tacmach.project gl in let env = Tacmach.pf_env gl in let (ind,u as indu),v = destruct_ind env sigma type_of_pq in let c = get_scheme handle (!lb_scheme_kind_aux ()) ind in let open Proofview.Notations in let lb_type_of_p = mkConstU (c,u) in Proofview.tclEVARMAP >>= fun sigma -> let lb_args = Array.append (Array.append v (Array.Smart.map (fun x -> do_arg env sigma indu x 1) v)) (Array.Smart.map (fun x -> do_arg env sigma indu x 2) v) in let app = if Array.is_empty lb_args then lb_type_of_p else mkApp (lb_type_of_p,lb_args) in Tacticals.tclTHENLIST [ Equality.replace p q ; Tactics.apply app ; Auto.default_auto] end (* used in the bool -> leb side *) let do_replace_bl handle (ind,u as indu) aavoid narg lft rgt = let open EConstr in let avoid = Array.of_list aavoid in let do_arg env sigma hd v offset = match kind sigma v with | Var s -> let x = narg*offset in let n = Array.length avoid in let rec find i = if Id.equal avoid.(n-i) s then avoid.(n-i-x) else (if i (* Works in specific situations where the args have to be already declared as a Parameter (see example "J" in test file SchemeEquality.v) We assume the parameter to have the same polymorphic arith as cst *) let lbl = Label.to_string (Constant.label cst) in let newlbl = if Int.equal offset 1 then ("eq_" ^ lbl) else (lbl ^ "_bl") in let newcst = Constant.change_label cst (Label.make newlbl) in if Environ.mem_constant newcst env then mkConstU (newcst,u) else raise (ConstructorWithNonParametricInductiveType (fst hd)) | _ -> raise (ConstructorWithNonParametricInductiveType (fst hd)) in let rec aux l1 l2 = match (l1,l2) with | (t1::q1,t2::q2) -> Proofview.Goal.enter begin fun gl -> let sigma = Tacmach.project gl in let env = Tacmach.pf_env gl in if EConstr.eq_constr sigma t1 t2 then aux q1 q2 else ( let tt1 = Tacmach.pf_get_type_of gl t1 in let (ind',u as indu),v = try destruct_ind env sigma tt1 (* trick so that the good sequence is returned*) with e when CErrors.noncritical e -> indu,[||] in if Environ.QInd.equal env ind' ind then Tacticals.tclTHENLIST [Equality.replace t1 t2; Auto.default_auto ; aux q1 q2 ] else ( let c = get_scheme handle (!bl_scheme_kind_aux ()) ind' in let bl_t1 = mkConstU (c,u) in let bl_args = Array.append (Array.append v (Array.Smart.map (fun x -> do_arg env sigma indu x 1) v)) (Array.Smart.map (fun x -> do_arg env sigma indu x 2) v ) in let app = if Array.is_empty bl_args then bl_t1 else mkApp (bl_t1,bl_args) in Tacticals.tclTHENLIST [ Equality.replace_by t1 t2 (Tacticals.tclTHEN (Tactics.apply app) (Auto.default_auto)) ; aux q1 q2 ] ) ) end | ([],[]) -> Proofview.tclUNIT () | _ -> Tacticals.tclZEROMSG Pp.(str "Both side of the equality must have the same arity.") in let open Proofview.Notations in Proofview.tclEVARMAP >>= fun sigma -> begin try Proofview.tclUNIT (destApp sigma lft) with DestKO -> Tacticals.tclZEROMSG Pp.(str "replace failed.") end >>= fun (ind1,ca1) -> begin try Proofview.tclUNIT (destApp sigma rgt) with DestKO -> Tacticals.tclZEROMSG Pp.(str "replace failed.") end >>= fun (ind2,ca2) -> begin try Proofview.tclUNIT (fst (destInd sigma ind1)) with DestKO -> begin try Proofview.tclUNIT (fst (fst (destConstruct sigma ind1))) with DestKO -> Tacticals.tclZEROMSG Pp.(str "The expected type is an inductive one.") end end >>= fun (sp1,i1) -> begin try Proofview.tclUNIT (fst (destInd sigma ind2)) with DestKO -> begin try Proofview.tclUNIT (fst (fst (destConstruct sigma ind2))) with DestKO -> Tacticals.tclZEROMSG Pp.(str "The expected type is an inductive one.") end end >>= fun (sp2,i2) -> Proofview.tclENV >>= fun env -> if not (Environ.QMutInd.equal env sp1 sp2) || not (Int.equal i1 i2) then Tacticals.tclZEROMSG Pp.(str "Eq should be on the same type") else aux (Array.to_list ca1) (Array.to_list ca2) (* create, from a list of ids [i1,i2,...,in] the list [(in,eq_in,in_bl,in_al),,...,(i1,eq_i1,i1_bl_i1_al )] *) let list_id l = List.fold_left ( fun a decl -> let s' = match RelDecl.get_name decl with Name s -> Id.to_string s | Anonymous -> "A" in (Id.of_string s',Id.of_string ("eq_"^s'), Id.of_string (s'^"_bl"), Id.of_string (s'^"_lb")) ::a ) [] l let avoid_of_list_id list_id = List.fold_left (fun avoid (s,seq,sbl,slb) -> List.fold_left (fun avoid id -> Id.Set.add id avoid) avoid [s;seq;sbl;slb]) Id.Set.empty list_id (* build the right eq_I A B.. N eq_A .. eq_N *) let eqI handle (ind,u) list_id = let eA = Array.of_list((List.map (fun (s,_,_,_) -> mkVar s) list_id)@ (List.map (fun (_,seq,_,_)-> mkVar seq) list_id )) and e = mkConstU (get_scheme handle beq_scheme_kind ind,u) in mkApp(e,eA) (**********************************************************************) (* Boolean->Leibniz *) open Namegen let compute_bl_goal env handle (ind,u) lnamesparrec nparrec = let list_id = list_id lnamesparrec in let eqI = eqI handle (ind,u) list_id in let avoid = avoid_of_list_id list_id in let x = next_ident_away (Id.of_string "x") avoid in let y = next_ident_away (Id.of_string "y") (Id.Set.add x avoid) in let open Term in let create_input c = let bl_typ = List.map (fun (s,seq,_,_) -> mkNamedProd (Context.make_annot x Sorts.Relevant) (mkVar s) ( mkNamedProd (Context.make_annot y Sorts.Relevant) (mkVar s) ( mkArrow ( mkApp(eq (),[|bb (); mkApp(mkVar seq,[|mkVar x;mkVar y|]);tt () |])) Sorts.Relevant ( mkApp(eq (),[|mkVar s;mkVar x;mkVar y|])) )) ) list_id in let bl_input = List.fold_left2 ( fun a (s,_,sbl,_) b -> mkNamedProd (Context.make_annot sbl Sorts.Relevant) b a ) c (List.rev list_id) (List.rev bl_typ) in let eqs_typ = List.map (fun (s,_,_,_) -> mkProd(Context.make_annot Anonymous Sorts.Relevant,mkVar s,mkProd(Context.make_annot Anonymous Sorts.Relevant,mkVar s,(bb ()))) ) list_id in let eq_input = List.fold_left2 ( fun a (s,seq,_,_) b -> mkNamedProd (Context.make_annot seq Sorts.Relevant) b a ) bl_input (List.rev list_id) (List.rev eqs_typ) in List.fold_left (fun a decl -> let x = Context.map_annot (function Name s -> s | Anonymous -> next_ident_away (Id.of_string "A") avoid) (RelDecl.get_annot decl) in mkNamedProd x (RelDecl.get_type decl) a) eq_input lnamesparrec in create_input ( mkNamedProd (Context.make_annot x Sorts.Relevant) (mkFullInd env (ind,u) (2*nparrec)) ( mkNamedProd (Context.make_annot y Sorts.Relevant) (mkFullInd env (ind,u) (2*nparrec+1)) ( mkArrow (mkApp(eq (),[|bb ();mkApp(eqI,[|mkVar x;mkVar y|]);tt ()|])) Sorts.Relevant (mkApp(eq (),[|mkFullInd env (ind,u) (2*nparrec+3);mkVar x;mkVar y|])) ))) let compute_bl_tact handle ind lnamesparrec nparrec = let list_id = list_id lnamesparrec in let first_intros = ( List.map (fun (s,_,_,_) -> s ) list_id ) @ ( List.map (fun (_,seq,_,_ ) -> seq) list_id ) @ ( List.map (fun (_,_,sbl,_ ) -> sbl) list_id ) in let open Tactics in intros_using_then first_intros begin fun fresh_first_intros -> Tacticals.tclTHENLIST [ intro_using_then (Id.of_string "x") (fun freshn -> induct_on (EConstr.mkVar freshn)); intro_using_then (Id.of_string "y") (fun freshm -> destruct_on (EConstr.mkVar freshm)); intro_using_then (Id.of_string "Z") begin fun freshz -> Tacticals.tclTHENLIST [ intros; Tacticals.tclTRY ( Tacticals.tclORELSE reflexivity my_discr_tac ); simpl_in_hyp (freshz,Locus.InHyp); (* repeat ( apply andb_prop in z;let z1:= fresh "Z" in destruct z as [z1 z]). *) Tacticals.tclREPEAT ( Tacticals.tclTHENLIST [ Simple.apply_in freshz (EConstr.of_constr (andb_prop())); let open Tactypes in destruct_on_as (EConstr.mkVar freshz) (IntroOrPattern [[CAst.make @@ IntroNaming (IntroFresh (Id.of_string "Z")); CAst.make @@ IntroNaming (IntroIdentifier freshz)]]) ]); (* Ci a1 ... an = Ci b1 ... bn replace bi with ai; auto || replace bi with ai by apply typeofbi_prod ; auto *) Proofview.Goal.enter begin fun gl -> let env = Proofview.Goal.env gl in let concl = Proofview.Goal.concl gl in let sigma = Tacmach.project gl in match EConstr.kind sigma concl with | App (c,ca) -> ( match EConstr.kind sigma c with | Ind (indeq, u) -> if Environ.QGlobRef.equal env (GlobRef.IndRef indeq) Coqlib.(lib_ref "core.eq.type") then Tacticals.tclTHEN (do_replace_bl handle ind (List.rev fresh_first_intros) nparrec (ca.(2)) (ca.(1))) Auto.default_auto else Tacticals.tclZEROMSG Pp.(str "Failure while solving Boolean->Leibniz.") | _ -> Tacticals.tclZEROMSG Pp.(str" Failure while solving Boolean->Leibniz.") ) | _ -> Tacticals.tclZEROMSG Pp.(str "Failure while solving Boolean->Leibniz.") end ] end ] end let make_bl_scheme env handle mind = let mib = Environ.lookup_mind mind env in if not (Int.equal (Array.length mib.mind_packets) 1) then CErrors.user_err Pp.(str "Automatic building of boolean->Leibniz lemmas not supported"); (* Setting universes *) let auctx = Declareops.universes_context mib.mind_universes in let u, uctx = UnivGen.fresh_instance_from auctx None in let uctx = UState.merge_sort_context ~sideff:false UState.univ_rigid (UState.from_env env) uctx in let ind = (mind,0) in let nparrec = mib.mind_nparams_rec in let lnonparrec,lnamesparrec = Inductive.inductive_nonrec_rec_paramdecls (mib,u) in let bl_goal = compute_bl_goal env handle (ind,u) lnamesparrec nparrec in let bl_goal = EConstr.of_constr bl_goal in let poly = Declareops.inductive_is_polymorphic mib in let uctx = if poly then Evd.evar_universe_context (fst (Typing.sort_of env (Evd.from_ctx uctx) bl_goal)) else uctx in let (ans, _, _, _, uctx) = Declare.build_by_tactic ~poly env ~uctx ~typ:bl_goal (compute_bl_tact handle (ind, EConstr.EInstance.make u) lnamesparrec nparrec) in ([|ans|], uctx) let make_bl_scheme_deps env ind = let inds = get_inductive_deps ~noprop:false env ind in let map ind = Ind_tables.SchemeMutualDep (ind, !bl_scheme_kind_aux ()) in Ind_tables.SchemeMutualDep (ind, beq_scheme_kind) :: List.map map inds let bl_scheme_kind = Ind_tables.declare_mutual_scheme_object "dec_bl" ~deps:make_bl_scheme_deps make_bl_scheme let _ = bl_scheme_kind_aux := fun () -> bl_scheme_kind (**********************************************************************) (* Leibniz->Boolean *) let compute_lb_goal env handle (ind,u) lnamesparrec nparrec = let list_id = list_id lnamesparrec in let eq = eq () and tt = tt () and bb = bb () in let avoid = avoid_of_list_id list_id in let eqI = eqI handle (ind,u) list_id in let x = next_ident_away (Id.of_string "x") avoid in let y = next_ident_away (Id.of_string "y") (Id.Set.add x avoid) in let open Term in let create_input c = let lb_typ = List.map (fun (s,seq,_,_) -> mkNamedProd (Context.make_annot x Sorts.Relevant) (mkVar s) ( mkNamedProd (Context.make_annot y Sorts.Relevant) (mkVar s) ( mkArrow ( mkApp(eq,[|mkVar s;mkVar x;mkVar y|])) Sorts.Relevant ( mkApp(eq,[|bb;mkApp(mkVar seq,[|mkVar x;mkVar y|]);tt|])) )) ) list_id in let lb_input = List.fold_left2 ( fun a (s,_,_,slb) b -> mkNamedProd (Context.make_annot slb Sorts.Relevant) b a ) c (List.rev list_id) (List.rev lb_typ) in let eqs_typ = List.map (fun (s,_,_,_) -> mkProd(Context.make_annot Anonymous Sorts.Relevant,mkVar s, mkProd(Context.make_annot Anonymous Sorts.Relevant,mkVar s,bb)) ) list_id in let eq_input = List.fold_left2 ( fun a (s,seq,_,_) b -> mkNamedProd (Context.make_annot seq Sorts.Relevant) b a ) lb_input (List.rev list_id) (List.rev eqs_typ) in List.fold_left (fun a decl -> let x = Context.map_annot (function Name s -> s | Anonymous -> Id.of_string "A") (RelDecl.get_annot decl) in mkNamedProd x (RelDecl.get_type decl) a) eq_input lnamesparrec in create_input ( mkNamedProd (Context.make_annot x Sorts.Relevant) (mkFullInd env (ind,u) (2*nparrec)) ( mkNamedProd (Context.make_annot y Sorts.Relevant) (mkFullInd env (ind,u) (2*nparrec+1)) ( mkArrow (mkApp(eq,[|mkFullInd env (ind,u) (2*nparrec+2);mkVar x;mkVar y|])) Sorts.Relevant (mkApp(eq,[|bb;mkApp(eqI,[|mkVar x;mkVar y|]);tt|])) ))) let compute_lb_tact handle ind lnamesparrec nparrec = let list_id = list_id lnamesparrec in let first_intros = ( List.map (fun (s,_,_,_) -> s ) list_id ) @ ( List.map (fun (_,seq,_,_) -> seq) list_id ) @ ( List.map (fun (_,_,_,slb) -> slb) list_id ) in let open Tactics in intros_using_then first_intros begin fun fresh_first_intros -> Tacticals.tclTHENLIST [ intro_using_then (Id.of_string "x") (fun freshn -> induct_on (EConstr.mkVar freshn)); intro_using_then (Id.of_string "y") (fun freshm -> destruct_on (EConstr.mkVar freshm)); intro_using_then (Id.of_string "Z") begin fun freshz -> Tacticals.tclTHENLIST [ intros; Tacticals.tclTRY ( Tacticals.tclORELSE reflexivity my_discr_tac ); my_inj_tac freshz; intros; simpl_in_concl; Auto.default_auto; Tacticals.tclREPEAT ( Tacticals.tclTHENLIST [apply (EConstr.of_constr (andb_true_intro())); simplest_split ;Auto.default_auto ] ); Proofview.Goal.enter begin fun gls -> let concl = Proofview.Goal.concl gls in let sigma = Tacmach.project gls in (* assume the goal to be eq (eq_type ...) = true *) match EConstr.kind sigma concl with | App(c,ca) -> (match (EConstr.kind sigma ca.(1)) with | App(c',ca') -> let n = Array.length ca' in do_replace_lb handle (List.rev fresh_first_intros) nparrec ca'.(n-2) ca'.(n-1) | _ -> Tacticals.tclZEROMSG Pp.(str "Failure while solving Leibniz->Boolean.") ) | _ -> Tacticals.tclZEROMSG Pp.(str "Failure while solving Leibniz->Boolean.") end ] end ] end let make_lb_scheme env handle mind = let mib = Environ.lookup_mind mind env in if not (Int.equal (Array.length mib.mind_packets) 1) then CErrors.user_err Pp.(str "Automatic building of Leibniz->boolean lemmas not supported"); let ind = (mind,0) in (* Setting universes *) let auctx = Declareops.universes_context mib.mind_universes in let u, uctx = UnivGen.fresh_instance_from auctx None in let uctx = UState.merge_sort_context ~sideff:false UState.univ_rigid (UState.from_env env) uctx in let nparrec = mib.mind_nparams_rec in let lnonparrec,lnamesparrec = Inductive.inductive_nonrec_rec_paramdecls (mib,u) in let lb_goal = compute_lb_goal env handle (ind,u) lnamesparrec nparrec in let lb_goal = EConstr.of_constr lb_goal in let poly = Declareops.inductive_is_polymorphic mib in let uctx = if poly then Evd.evar_universe_context (fst (Typing.sort_of env (Evd.from_ctx uctx) lb_goal)) else uctx in let (ans, _, _, _, ctx) = Declare.build_by_tactic ~poly env ~uctx ~typ:lb_goal (compute_lb_tact handle ind lnamesparrec nparrec) in ([|ans|], ctx) let make_lb_scheme_deps env ind = let inds = get_inductive_deps ~noprop:false env ind in let map ind = Ind_tables.SchemeMutualDep (ind, !lb_scheme_kind_aux ()) in Ind_tables.SchemeMutualDep (ind, beq_scheme_kind) :: List.map map inds let lb_scheme_kind = Ind_tables.declare_mutual_scheme_object "dec_lb" ~deps:make_lb_scheme_deps make_lb_scheme let _ = lb_scheme_kind_aux := fun () -> lb_scheme_kind (**********************************************************************) (* Decidable equality *) let check_not_is_defined () = if not (Coqlib.has_ref "core.not.type") then raise (UndefinedCst "not") (* {n=m}+{n<>m} part *) let compute_dec_goal env ind lnamesparrec nparrec = check_not_is_defined (); let eq = eq () and tt = tt () and bb = bb () in let list_id = list_id lnamesparrec in let avoid = avoid_of_list_id list_id in let x = next_ident_away (Id.of_string "x") avoid in let y = next_ident_away (Id.of_string "y") (Id.Set.add x avoid) in let open Term in let create_input c = let lb_typ = List.map (fun (s,seq,_,_) -> mkNamedProd (Context.make_annot x Sorts.Relevant) (mkVar s) ( mkNamedProd (Context.make_annot y Sorts.Relevant) (mkVar s) ( mkArrow ( mkApp(eq,[|mkVar s;mkVar x;mkVar y|])) Sorts.Relevant ( mkApp(eq,[|bb;mkApp(mkVar seq,[|mkVar x;mkVar y|]);tt|])) )) ) list_id in let bl_typ = List.map (fun (s,seq,_,_) -> mkNamedProd (Context.make_annot x Sorts.Relevant) (mkVar s) ( mkNamedProd (Context.make_annot y Sorts.Relevant) (mkVar s) ( mkArrow ( mkApp(eq,[|bb;mkApp(mkVar seq,[|mkVar x;mkVar y|]);tt|])) Sorts.Relevant ( mkApp(eq,[|mkVar s;mkVar x;mkVar y|])) )) ) list_id in let lb_input = List.fold_left2 ( fun a (s,_,_,slb) b -> mkNamedProd (Context.make_annot slb Sorts.Relevant) b a ) c (List.rev list_id) (List.rev lb_typ) in let bl_input = List.fold_left2 ( fun a (s,_,sbl,_) b -> mkNamedProd (Context.make_annot sbl Sorts.Relevant) b a ) lb_input (List.rev list_id) (List.rev bl_typ) in let eqs_typ = List.map (fun (s,_,_,_) -> mkProd(Context.make_annot Anonymous Sorts.Relevant,mkVar s, mkProd(Context.make_annot Anonymous Sorts.Relevant,mkVar s,bb)) ) list_id in let eq_input = List.fold_left2 ( fun a (s,seq,_,_) b -> mkNamedProd (Context.make_annot seq Sorts.Relevant) b a ) bl_input (List.rev list_id) (List.rev eqs_typ) in List.fold_left (fun a decl -> let x = Context.map_annot (function Name s -> s | Anonymous -> Id.of_string "A") (RelDecl.get_annot decl) in mkNamedProd x (RelDecl.get_type decl) a) eq_input lnamesparrec in let eqnm = mkApp(eq,[|mkFullInd env ind (3*nparrec+2);mkVar x;mkVar y|]) in create_input ( mkNamedProd (Context.make_annot x Sorts.Relevant) (mkFullInd env ind (3*nparrec)) ( mkNamedProd (Context.make_annot y Sorts.Relevant) (mkFullInd env ind (3*nparrec+1)) ( mkApp(sumbool(),[|eqnm;mkApp (UnivGen.constr_of_monomorphic_global (Global.env ()) @@ Coqlib.lib_ref "core.not.type",[|eqnm|])|]) ) ) ) let compute_dec_tact handle (ind,u) lnamesparrec nparrec = let eq = eq () and tt = tt () and ff = ff () and bb = bb () in let list_id = list_id lnamesparrec in let _ = get_scheme handle beq_scheme_kind ind in (* This is just an assertion? *) let _non_fresh_eqI = eqI handle (ind,u) list_id in let eqtrue x = mkApp(eq,[|bb;x;tt|]) in let eqfalse x = mkApp(eq,[|bb;x;ff|]) in let first_intros = ( List.map (fun (s,_,_,_) -> s ) list_id ) @ ( List.map (fun (_,seq,_,_) -> seq) list_id ) @ ( List.map (fun (_,_,sbl,_) -> sbl) list_id ) @ ( List.map (fun (_,_,_,slb) -> slb) list_id ) in let open Tactics in let fresh_id s gl = fresh_id_in_env (Id.Set.empty) s (Proofview.Goal.env gl) in intros_using_then first_intros begin fun fresh_first_intros -> let eqI = let a = Array.of_list fresh_first_intros in let n = List.length list_id in assert (Int.equal (Array.length a) (4 * n)); let fresh_list_id = List.init n (fun i -> (Array.get a i, Array.get a (i+n), Array.get a (i+2*n), Array.get a (i+3*n))) in eqI handle (ind,u) fresh_list_id in intro_using_then (Id.of_string "x") begin fun freshn -> intro_using_then (Id.of_string "y") begin fun freshm -> Proofview.Goal.enter begin fun gl -> let freshH = fresh_id (Id.of_string "H") gl in let eqbnm = mkApp(eqI,[|mkVar freshn;mkVar freshm|]) in let arfresh = Array.of_list fresh_first_intros in let xargs = Array.sub arfresh 0 (2*nparrec) in let c = get_scheme handle bl_scheme_kind ind in let blI = mkConstU (c,u) in let c = get_scheme handle lb_scheme_kind ind in let lbI = mkConstU (c,u) in Tacticals.tclTHENLIST [ (*we do this so we don't have to prove the same goal twice *) assert_by (Name freshH) (EConstr.of_constr ( mkApp(sumbool(),[|eqtrue eqbnm; eqfalse eqbnm|]) )) (Tacticals.tclTHEN (destruct_on (EConstr.of_constr eqbnm)) Auto.default_auto); Proofview.Goal.enter begin fun gl -> let freshH2 = fresh_id (Id.of_string "H") gl in Tacticals.tclTHENS (destruct_on_using (EConstr.mkVar freshH) freshH2) [ (* left *) Tacticals.tclTHENLIST [ simplest_left; apply (EConstr.of_constr (mkApp(blI,Array.map mkVar xargs))); Auto.default_auto ] ; (*right *) Proofview.Goal.enter begin fun gl -> let freshH3 = fresh_id (Id.of_string "H") gl in Tacticals.tclTHENLIST [ simplest_right ; unfold_constr (Coqlib.lib_ref "core.not.type"); intro; Equality.subst_all (); assert_by (Name freshH3) (EConstr.of_constr (mkApp(eq,[|bb;mkApp(eqI,[|mkVar freshm;mkVar freshm|]);tt|]))) (Tacticals.tclTHENLIST [ apply (EConstr.of_constr (mkApp(lbI,Array.map mkVar xargs))); Auto.default_auto ]); Equality.general_rewrite ~where:(Some freshH3) ~l2r:true Locus.AllOccurrences ~freeze:true ~dep:false ~with_evars:true ((EConstr.mkVar freshH2), NoBindings ) ; my_discr_tac ] end ] end ] end end end end let make_eq_decidability env handle mind = let mib = Environ.lookup_mind mind env in if not (Int.equal (Array.length mib.mind_packets) 1) then raise DecidabilityMutualNotSupported; let ind = (mind,0) in let nparrec = mib.mind_nparams_rec in (* Setting universes *) let auctx = Declareops.universes_context mib.mind_universes in let u, uctx = UnivGen.fresh_instance_from auctx None in let uctx = UState.merge_sort_context ~sideff:false UState.univ_rigid (UState.from_env env) uctx in let lnonparrec,lnamesparrec = Inductive.inductive_nonrec_rec_paramdecls (mib,u) in let dec_goal = EConstr.of_constr (compute_dec_goal env (ind,u) lnamesparrec nparrec) in let poly = Declareops.inductive_is_polymorphic mib in let uctx = if poly then Evd.evar_universe_context (fst (Typing.sort_of env (Evd.from_ctx uctx) dec_goal)) else uctx in let (ans, _, _, _, ctx) = Declare.build_by_tactic ~poly env ~uctx ~typ:dec_goal (compute_dec_tact handle (ind,u) lnamesparrec nparrec) in ([|ans|], ctx) let eq_dec_scheme_kind = Ind_tables.declare_mutual_scheme_object "eq_dec" ~deps:(fun _ ind -> [SchemeMutualDep (ind, bl_scheme_kind); SchemeMutualDep (ind, lb_scheme_kind)]) make_eq_decidability (* The eq_dec_scheme proofs depend on the equality and discr tactics but the inj tactics, that comes with discr, depends on the eq_dec_scheme... *) let _ = Equality.set_eq_dec_scheme_kind eq_dec_scheme_kind coq-8.20.0/vernac/auto_ind_decl.mli000066400000000000000000000027331466560755400171640ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* obj = declare_object {(default_object "CANONICAL-STRUCTURE") with open_function = simple_open ~cat:canon_cat open_canonical_structure; cache_function = cache_canonical_structure; subst_function = (fun (subst,(c,local)) -> Instance.subst subst c, local); classify_function = (fun x -> Substitute); discharge_function = discharge_canonical_structure } let add_canonical_structure x = Lib.add_leaf (inCanonStruc x) let declare_canonical_structure ?(local=false) ref = let env = Global.env () in let sigma = Evd.from_env env in add_canonical_structure (Instance.make env sigma ref, local) coq-8.20.0/vernac/canonical.mli000066400000000000000000000013621466560755400163170ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* GlobRef.t -> unit coq-8.20.0/vernac/classes.ml000066400000000000000000000544251466560755400156640ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* Tacred.evaluable_of_global_reference (Global.env ()) (Smartlocate.global_with_alias x)) refs in set_typeclass_transparency ~locality refs b let add_instance_hint gr ~locality info = let inst = Hints.hint_globref gr in Flags.silently (fun () -> Hints.add_hints ~locality [typeclasses_db] (Hints.HintsResolveEntry [info, false, inst])) () (* short names without opening all Hints *) type locality = Hints.hint_locality = Local | Export | SuperGlobal type instance = { class_name : GlobRef.t; instance : GlobRef.t; info : Typeclasses.hint_info; (* Sections where the instance should be redeclared, None for discard, Some 0 for none. *) locality : Hints.hint_locality; } let add_instance_base inst = let locality = match inst.locality with | Local -> Local | SuperGlobal -> (* i.e. in a section, declare the hint as local since discharge is managed by rebuild_instance which calls again add_instance_hint; don't ask hints to take discharge into account itself *) if Global.sections_are_opened () then Local else SuperGlobal | Export -> (* Same as above for export *) if Global.sections_are_opened () then Local else Export in add_instance_hint inst.instance ~locality inst.info (* * instances persistent object *) let perform_instance i = let i = { is_class = i.class_name; is_info = i.info; is_impl = i.instance } in Typeclasses.load_instance i let cache_instance inst = perform_instance inst; add_instance_base inst let load_instance _ inst = match inst.locality with | Local -> assert false | SuperGlobal -> perform_instance inst | Export -> () let open_instance i inst = match inst.locality with | Local -> assert false | SuperGlobal -> perform_instance inst | Export -> if Int.equal i 1 then perform_instance inst let subst_instance (subst, inst) = { inst with class_name = fst (subst_global subst inst.class_name); instance = fst (subst_global subst inst.instance) } let discharge_instance inst = match inst.locality with | Local -> None | SuperGlobal | Export -> assert (not (isVarRef inst.instance)); Some inst let classify_instance inst = match inst.locality with | Local -> Dispose | SuperGlobal | Export -> Substitute let instance_input : instance -> obj = declare_object { (default_object "type classes instances state") with cache_function = cache_instance; load_function = load_instance; open_function = simple_open ~cat:Hints.hint_cat open_instance; classify_function = classify_instance; discharge_function = discharge_instance; subst_function = subst_instance } module Event = struct type t = | NewClass of typeclass | NewInstance of instance end type observer = string let observers = ref CString.Map.empty let active_observers = Summary.ref ~name:"active typeclass observers" [] let register_observer ~name ?(override=false) o = if not override && CString.Map.mem name !observers then CErrors.anomaly Pp.(str "Typeclass observer " ++ str name ++ str " already registered."); observers := CString.Map.add name o !observers; name let deactivate_observer name = active_observers := List.remove String.equal name !active_observers let activate_observer name = assert (CString.Map.mem name !observers); deactivate_observer name; active_observers := name :: !active_observers let observe event = List.iter (fun name -> (CString.Map.get name !observers) event) !active_observers let add_instance cl info global impl = let () = match global with | Local -> () | SuperGlobal -> if Lib.sections_are_opened () && isVarRef impl then CErrors.user_err (Pp.str "Cannot set Global an instance referring to a section variable.") | Export -> if Lib.sections_are_opened () && isVarRef impl then CErrors.user_err (Pp.str "The export attribute cannot be applied to an instance referring to a section variable.") in let i = { class_name = cl.cl_impl; info = info ; locality = global ; instance = impl; } in Lib.add_leaf (instance_input i); observe (Event.NewInstance { class_name = cl.cl_impl; instance = impl; info; locality = global }) let warning_not_a_class = CWarnings.create ~name:"not-a-class" (fun (n, ty) -> let env = Global.env () in let evd = Evd.from_env env in Pp.(str "Ignored instance declaration for “" ++ Nametab.pr_global_env Id.Set.empty n ++ str "”: “" ++ Termops.Internal.print_constr_env env evd (EConstr.of_constr ty) ++ str "” is not a class") ) let declare_instance ?(warn = false) env sigma info local glob = let ty, _ = Typeops.type_of_global_in_context env glob in let info = Option.default {hint_priority = None; hint_pattern = None} info in match class_of_constr env sigma (EConstr.of_constr ty) with | Some (rels, ((tc,_), args) as _cl) -> add_instance tc info local glob | None -> if warn then warning_not_a_class (glob, ty) (* * classes persistent object *) let cache_class c = load_class c let subst_class (subst,cl) = let do_subst_con c = Mod_subst.subst_constant subst c 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_meth m = let c = Option.Smart.map do_subst_con m.meth_const in if c == m.meth_const then m else { meth_name = m.meth_name; meth_info = m.meth_info; meth_const = c; } in 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_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; cl_unique = cl.cl_unique } let discharge_class cl = try let info = Lib.section_segment_of_reference cl.cl_impl in let info, _, cl_univs' = Cooking.lift_poly_univs info cl.cl_univs in let nprops = List.length cl.cl_props in let props, context = List.chop nprops (Discharge.cook_rel_context info (cl.cl_props @ cl.cl_context)) in let discharge_proj x = x in { cl_univs = cl_univs'; cl_impl = cl.cl_impl; cl_context = context; cl_props = props; cl_projs = List.Smart.map discharge_proj cl.cl_projs; cl_strict = cl.cl_strict; cl_unique = cl.cl_unique } with Not_found -> (* not defined in the current section *) cl let rebuild_class cl = try let cst = Tacred.evaluable_of_global_reference (Global.env ()) cl.cl_impl in set_typeclass_transparency ~locality:Hints.Local [cst] false; cl with e when CErrors.noncritical e -> cl let class_input : typeclass -> obj = declare_object { (default_object "type classes state") with cache_function = cache_class; load_function = (fun _ -> cache_class); classify_function = (fun x -> Substitute); discharge_function = (fun a -> Some (discharge_class a)); rebuild_function = rebuild_class; subst_function = subst_class } let add_class cl = Lib.add_leaf (class_input cl); observe (Event.NewClass cl) let intern_info {hint_priority;hint_pattern} = let env = Global.env() in let sigma = Evd.from_env env in let hint_pattern = Option.map (Constrintern.intern_constr_pattern env sigma) hint_pattern in {hint_priority;hint_pattern} (** TODO: add subinstances *) let existing_instance ?loc glob c info = let info = Option.default Hints.empty_hint_info info in let info = intern_info info in let env = Global.env() in let sigma = Evd.from_env env in let instance, _ = Typeops.type_of_global_in_context env c in let ctx, r = Term.decompose_prod_decls instance in match class_of_constr (Environ.push_rel_context ctx env) sigma (EConstr.of_constr r) with | Some (_, ((tc,u), _)) -> add_instance tc info glob c | None -> user_err ?loc (Pp.str "Constant does not build instances of a declared type class.") (* Declare everything in the parameters as implicit, and the class instance as well *) let type_ctx_instance ~program_mode env sigma ctx inst subst = let open Vars in let rec aux (sigma, subst, instctx) l = function decl :: ctx -> let t' = substl subst (RelDecl.get_type decl) in let (sigma, c'), l = match decl with | LocalAssum _ -> interp_casted_constr_evars ~program_mode env sigma (List.hd l) t', List.tl l | LocalDef (_,b,_) -> (sigma, substl subst b), l in let d = RelDecl.get_name decl, Some c', t' in aux (sigma, c' :: subst, d :: instctx) l ctx | [] -> sigma, subst in aux (sigma, subst, []) inst (List.rev ctx) let id_of_class cl = let open GlobRef in match cl.cl_impl with | ConstRef kn -> Label.to_id @@ Constant.label kn | IndRef (kn,i) -> let mip = (Environ.lookup_mind kn (Global.env ())).Declarations.mind_packets in mip.(0).Declarations.mind_typename | _ -> assert false let instance_hook info global ?hook cst = let info = intern_info info in let env = Global.env () in let sigma = Evd.from_env env in declare_instance env sigma (Some info) global cst; (match hook with Some h -> h cst | None -> ()) let declare_instance_constant iinfo global impargs ?hook name udecl poly sigma term termtype = let kind = Decls.(IsDefinition Instance) in let cinfo = Declare.CInfo.make ~name ~impargs ~typ:(Some termtype) () in let info = Declare.Info.make ~kind ~poly ~udecl () in let kn = Declare.declare_definition ~cinfo ~info ~opaque:false ~body:term sigma in instance_hook iinfo global ?hook kn let do_declare_instance sigma ~locality ~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 k.cl_context in let (_, ty_constr) = instance_constructor (k,u) subst in let termtype = it_mkProd_or_LetIn ty_constr (ctx' @ ctx) in let sigma, entry = Declare.prepare_parameter ~poly sigma ~udecl ~types:termtype in let cst = Declare.declare_constant ~name ~kind:Decls.(IsAssumption Logical) (Declare.ParameterEntry entry) in let cst = (GlobRef.ConstRef cst) in Impargs.maybe_declare_manual_implicits false cst impargs; instance_hook pri locality cst let declare_instance_program pm env sigma ~locality ~poly name pri impargs udecl term termtype = let hook { Declare.Hook.S.scope; dref; _ } = let cst = match dref with GlobRef.ConstRef kn -> kn | _ -> assert false in let pri = intern_info pri in let env = Global.env () in let sigma = Evd.from_env env in declare_instance env sigma (Some pri) locality (GlobRef.ConstRef cst) in let obls, _, body, typ = RetrieveObl.retrieve_obligations env name sigma 0 term termtype in let hook = Declare.Hook.make hook in let uctx = Evd.evar_universe_context sigma in let kind = Decls.IsDefinition Decls.Instance in let cinfo = Declare.CInfo.make ~name ~typ ~impargs () in let info = Declare.Info.make ~udecl ~poly ~kind ~hook () in let pm, _ = Declare.Obls.add_definition ~pm ~info ~cinfo ~opaque:false ~uctx ~body obls in pm let declare_instance_open sigma ?hook ~tac ~locality ~poly id pri impargs udecl ids term termtype = (* spiwack: it is hard to reorder the actions to do the pretyping after the proof has opened. As a consequence, we use the low-level primitives to code the refinement manually.*) let future_goals, sigma = Evd.pop_future_goals sigma in let gls = List.rev (Evd.FutureGoals.comb future_goals) in let sigma = Evd.push_future_goals sigma in let kind = Decls.(IsDefinition Instance) in let hook = Declare.Hook.(make (fun { S.dref ; _ } -> instance_hook pri locality ?hook dref)) in let info = Declare.Info.make ~hook ~kind ~udecl ~poly () in (* XXX: We need to normalize the type, otherwise Admitted / Qed will fails! This is due to a bug in proof_global :( *) let termtype = Evarutil.nf_evar sigma termtype in let cinfo = Declare.CInfo.make ~name:id ~impargs ~typ:termtype () in let lemma = Declare.Proof.start ~cinfo ~info sigma in (* spiwack: I don't know what to do with the status here. *) let lemma = match term with | Some term -> let init_refine = Tacticals.tclTHENLIST [ Refine.refine ~typecheck:false (fun sigma -> sigma, term); Proofview.Unsafe.tclNEWGOALS (CList.map Proofview.with_empty_state gls); Tactics.reduce_after_refine; ] in let lemma, _ = Declare.Proof.by init_refine lemma in lemma | None -> let lemma, _ = Declare.Proof.by (Tactics.auto_intros_tac ids) lemma in lemma in match tac with | Some tac -> let lemma, _ = Declare.Proof.by tac lemma in lemma | None -> lemma 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 @ k.cl_context) in let (app, ty_constr) = instance_constructor (k,u) subst in let termtype = it_mkProd_or_LetIn ty_constr ctx in let term = it_mkLambda_or_LetIn (Option.get app) ctx in term, termtype let do_instance_resolve_TC termtype sigma env = let sigma = Evarutil.nf_evar_map sigma in let sigma = Typeclasses.resolve_typeclasses ~filter:Typeclasses.no_goals_or_obligations ~fail:true env sigma in (* Try resolving fields that are typeclasses automatically. *) let sigma = Typeclasses.resolve_typeclasses ~filter:Typeclasses.all_evars ~fail:false env sigma in let sigma = Evarutil.nf_evar_map_undefined sigma in (* Beware of this step, it is required as to minimize universes. *) let sigma = Evd.minimize_universes sigma in (* Check that the type is free of evars now. *) Pretyping.check_evars env sigma termtype; termtype, sigma let do_instance_type_ctx_instance props k env' ctx' sigma ~program_mode subst = let get_id qid = CAst.make ?loc:qid.CAst.loc @@ qualid_basename qid in let props, rest = List.fold_left (fun (props, rest) decl -> if is_local_assum decl then try let is_id (id', _) = match RelDecl.get_name decl, get_id id' with | Name id, {CAst.v=id'} -> Id.equal id id' | Anonymous, _ -> false in let (loc_mid, c) = List.find is_id rest in let rest' = List.filter (fun v -> not (is_id v)) rest in let {CAst.loc;v=mid} = get_id loc_mid in List.iter (fun m -> if Name.equal m.meth_name (Name mid) then Option.iter (fun x -> Dumpglob.add_glob ?loc (GlobRef.ConstRef x)) m.meth_const) k.cl_projs; c :: props, rest' with Not_found -> ((CAst.make @@ CHole (None)) :: props), rest else props, rest) ([], props) k.cl_props in match rest with | (n, _) :: _ -> unbound_method env' sigma k.cl_impl (get_id n) | _ -> let kcl_props = of_rel_context k.cl_props in let sigma, res = type_ctx_instance ~program_mode (push_rel_context ctx' env') sigma kcl_props props subst in res, sigma let interp_props ~program_mode env' cty k u ctx ctx' subst sigma = function | (true, { CAst.v = CRecord fs; loc }) -> check_duplicate ?loc fs; let subst, sigma = do_instance_type_ctx_instance fs k env' ctx' sigma ~program_mode subst in let term, termtype = do_instance_subst_constructor_and_ty subst k u (ctx' @ ctx) in term, termtype, sigma | (_, term) -> let sigma, def = interp_casted_constr_evars ~program_mode env' sigma term cty in let termtype = it_mkProd_or_LetIn cty ctx in let term = it_mkLambda_or_LetIn def ctx in term, termtype, sigma let do_instance_interactive env env' sigma ?hook ~tac ~locality ~poly cty k u ctx ctx' pri decl imps subst id opt_props = let term, termtype, sigma = match opt_props with | Some props -> on_pi1 (fun x -> Some x) (interp_props ~program_mode:false env' cty k u ctx ctx' subst sigma props) | None -> let term, termtype = if List.is_empty k.cl_props then let term, termtype = do_instance_subst_constructor_and_ty subst k u (ctx' @ ctx) in Some term, termtype else None, it_mkProd_or_LetIn cty ctx in let termtype, sigma = do_instance_resolve_TC termtype sigma env in term, termtype, sigma in Flags.silently (fun () -> declare_instance_open sigma ?hook ~tac ~locality ~poly id pri imps decl (List.map RelDecl.get_name ctx) term termtype) () let do_instance env env' sigma ?hook ~locality ~poly cty k u ctx ctx' pri decl imps subst id props = let term, termtype, sigma = interp_props ~program_mode:false env' cty k u ctx ctx' subst sigma props in let termtype, sigma = do_instance_resolve_TC termtype sigma env in Pretyping.check_evars_are_solved ~program_mode:false env sigma; declare_instance_constant pri locality imps ?hook id decl poly sigma term termtype let do_instance_program ~pm env env' sigma ?hook ~locality ~poly cty k u ctx ctx' pri decl imps subst id opt_props = let term, termtype, sigma = match opt_props with | Some props -> interp_props ~program_mode:true env' cty k u ctx ctx' subst sigma props | None -> let subst, sigma = do_instance_type_ctx_instance [] k env' ctx' sigma ~program_mode:true subst in let term, termtype = do_instance_subst_constructor_and_ty subst k u (ctx' @ ctx) in term, termtype, sigma in let termtype, sigma = do_instance_resolve_TC termtype sigma env in if not (Evd.has_undefined sigma) && not (Option.is_empty opt_props) then let () = declare_instance_constant pri locality imps ?hook id decl poly sigma term termtype in pm else declare_instance_program pm env sigma ~locality ~poly id pri imps decl term termtype let interp_instance_context ~program_mode env ctx pl tclass = let sigma, decl = interp_univ_decl_opt env pl in let sigma, (impls, ((env', ctx), imps)) = interp_context_evars ~program_mode env sigma ctx in let flags = Pretyping.{ all_no_fail_flags with program_mode } in let sigma, (c', imps') = interp_type_evars_impls ~flags ~impls env' sigma tclass in let imps = imps @ imps' in let ctx', c = decompose_prod_decls sigma c' in let ctx'' = ctx' @ ctx in let (k, u), args = Typeclasses.dest_class_app (push_rel_context ctx'' env) sigma c in 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 = of_rel_context cl.cl_context in let _, args = List.fold_right (fun decl (args, args') -> match decl with | LocalAssum _ -> (List.tl args, List.hd args :: args') | LocalDef (_,b,_) -> (args, Vars.substl args' b :: args')) cl_context (args, []) in let sigma = Evarutil.nf_evar_map sigma in let sigma = resolve_typeclasses ~filter:Typeclasses.all_evars ~fail:true env sigma in sigma, cl, u, c', ctx', ctx, imps, args, decl let new_instance_common ~program_mode env instid ctx cl = let ({CAst.loc;v=instid}, pl) = instid in let sigma, k, u, cty, ctx', ctx, imps, subst, decl = interp_instance_context ~program_mode env ctx pl cl in (* The name generator should not be here *) let id = match instid with | Name id -> id | Anonymous -> let i = Nameops.add_suffix (id_of_class k) "_instance_0" in Namegen.next_global_ident_away i (Termops.vars_of_env env) in let env' = push_rel_context ctx env in id, env', sigma, k, u, cty, ctx', ctx, imps, subst, decl let new_instance_interactive ~locality ~poly instid ctx cl ?(tac:unit Proofview.tactic option) ?hook pri opt_props = let env = Global.env() in let id, env', sigma, k, u, cty, ctx', ctx, imps, subst, decl = new_instance_common ~program_mode:false env instid ctx cl in id, do_instance_interactive env env' sigma ?hook ~tac ~locality ~poly cty k u ctx ctx' pri decl imps subst id opt_props let new_instance_program ~locality ~pm ~poly instid ctx cl opt_props ?hook pri = let env = Global.env() in let id, env', sigma, k, u, cty, ctx', ctx, imps, subst, decl = new_instance_common ~program_mode:true env instid ctx cl in let pm = do_instance_program ~pm env env' sigma ?hook ~locality ~poly cty k u ctx ctx' pri decl imps subst id opt_props in pm, id let new_instance ~locality ~poly instid ctx cl props ?hook pri = let env = Global.env() in let id, env', sigma, k, u, cty, ctx', ctx, imps, subst, decl = new_instance_common ~program_mode:false env instid ctx cl in do_instance env env' sigma ?hook ~locality ~poly cty k u ctx ctx' pri decl imps subst id props; id let declare_new_instance ~locality ~program_mode ~poly instid ctx cl pri = let env = Global.env() in let ({CAst.loc;v=instid}, pl) = instid in let sigma, k, u, cty, ctx', ctx, imps, subst, decl = interp_instance_context ~program_mode env ctx pl cl in do_declare_instance sigma ~locality ~poly k u ctx ctx' pri decl imps subst instid let refine_att = let open Attributes in let open Notations in attribute_of_list ["refine",single_key_parser ~name:"refine" ~key:"refine" ()] >>= function | None -> return false | Some () -> return true module Internal = struct let add_instance = add_instance end coq-8.20.0/vernac/classes.mli000066400000000000000000000071411466560755400160260ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* env -> Evd.evar_map -> hint_info option -> Hints.hint_locality -> GlobRef.t -> unit (** Declares the given global reference as an instance of its type. Does nothing — or emit a “not-a-class” warning if the [warn] argument is set — when said type is not a registered type class. *) val existing_instance : ?loc:Loc.t -> Hints.hint_locality -> GlobRef.t -> Vernacexpr.hint_info_expr option -> unit (** globality, reference, optional priority and pattern information *) val new_instance_interactive : locality:Hints.hint_locality -> poly:bool -> name_decl -> local_binder_expr list -> constr_expr -> ?tac:unit Proofview.tactic -> ?hook:(GlobRef.t -> unit) -> Vernacexpr.hint_info_expr -> (bool * constr_expr) option -> Id.t * Declare.Proof.t val new_instance : locality:Hints.hint_locality -> poly:bool -> name_decl -> local_binder_expr list -> constr_expr -> (bool * constr_expr) -> ?hook:(GlobRef.t -> unit) -> Vernacexpr.hint_info_expr -> Id.t val new_instance_program : locality:Hints.hint_locality -> pm:Declare.OblState.t -> poly:bool -> name_decl -> local_binder_expr list -> constr_expr -> (bool * constr_expr) option -> ?hook:(GlobRef.t -> unit) -> Vernacexpr.hint_info_expr -> Declare.OblState.t * Id.t val declare_new_instance : locality:Hints.hint_locality -> program_mode:bool -> poly:bool -> ident_decl -> local_binder_expr list -> constr_expr -> Vernacexpr.hint_info_expr -> unit val add_class : typeclass -> unit type instance = { class_name : GlobRef.t; instance : GlobRef.t; info : Typeclasses.hint_info; locality : Hints.hint_locality; } module Event : sig type t = | NewClass of typeclass | NewInstance of instance end (** Activated observers are called whenever a class or an instance are declared. [register_observer] is to be called once per process for a given string, unless [override] is [true]. The registered observer is not activated. Activation state is part of the summary. It is up to the caller to use libobject for persistence if desired. *) type observer val register_observer : name:string -> ?override:bool -> (Event.t -> unit) -> observer val activate_observer : observer -> unit val deactivate_observer : observer -> unit (** Setting opacity *) val set_typeclass_transparency : locality:Hints.hint_locality -> Evaluable.t list -> bool -> unit val set_typeclass_transparency_com : locality:Hints.hint_locality -> Libnames.qualid list -> bool -> unit (** For generation on names based on classes only *) val id_of_class : typeclass -> Id.t val refine_att : bool Attributes.attribute (** {6 Low level interface used by Add Morphism, do not use } *) module Internal : sig val add_instance : typeclass -> hint_info -> Hints.hint_locality -> GlobRef.t -> unit end coq-8.20.0/vernac/comArguments.ml000066400000000000000000000303511466560755400166630ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* Pretyping.clear_bidirectionality_hint gr | Some nargs -> Pretyping.add_bidirectionality_hint gr nargs let load_bidi_hints _ r = cache_bidi_hints r let subst_bidi_hints (subst, (gr, ohint as orig)) = let gr' = Globnames.subst_global_reference subst gr in if gr == gr' then orig else (gr', ohint) let discharge_bidi_hints (gr, ohint) = if Globnames.isVarRef gr && Lib.is_in_section gr then None else let vars = Lib.section_instance gr in let n = Array.length vars in Some (gr, Option.map ((+) n) ohint) let inBidiHints = let open Libobject in declare_object { (default_object "BIDIRECTIONALITY-HINTS" ) with load_function = load_bidi_hints; cache_function = cache_bidi_hints; classify_function = (fun o -> Substitute); subst_function = subst_bidi_hints; discharge_function = discharge_bidi_hints; } let warn_arguments_assert = CWarnings.create ~name:"arguments-assert" ~category:CWarnings.CoreCategories.vernacular Pp.(fun sr -> strbrk "This command is just asserting the names of arguments of " ++ Printer.pr_global sr ++ strbrk". If this is what you want, add " ++ strbrk "': assert' to silence the warning. If you want " ++ strbrk "to clear implicit arguments, add ': clear implicits'. " ++ strbrk "If you want to clear notation scopes, add ': clear scopes'") let warn_scope_delimiter_depth = CWarnings.create ~name:"argument-scope-delimiter" ~category:Deprecation.Version.v8_19 Pp.(fun () -> strbrk "The '%' scope delimiter in 'Arguments' commands is deprecated, " ++ strbrk "use '%_' instead (available since 8.19). The '%' syntax will be " ++ strbrk "reused in a future version with the same semantics as in terms, " ++ strbrk "that is adding scope to the stack for all subterms. " ++ strbrk "Code can be adapted with a script like: " ++ strbrk "for f in $(find . -name '*.v'); do sed '/Arguments/ s/%/%_/g' -i $f ; done") (* [nargs_for_red] is the number of arguments required to trigger reduction, [args] is the main list of arguments statuses, [more_implicits] is a list of extra lists of implicit statuses *) let vernac_arguments ~section_local reference args more_implicits flags = let env = Global.env () in let sigma = Evd.from_env env in let assert_flag = List.mem `Assert flags in let rename_flag = List.mem `Rename flags in let clear_scopes_flag = List.mem `ClearScopes flags in let extra_scopes_flag = List.mem `ExtraScopes flags in let clear_implicits_flag = List.mem `ClearImplicits flags in let default_implicits_flag = List.mem `DefaultImplicits flags in let never_unfold_flag = List.mem `ReductionNeverUnfold flags in let nomatch_flag = List.mem `ReductionDontExposeCase flags in let clear_bidi_hint = List.mem `ClearBidiHint flags in let err_incompat x y = CErrors.user_err Pp.(str ("Options \""^x^"\" and \""^y^"\" are incompatible.")) in if assert_flag && rename_flag then err_incompat "assert" "rename"; if clear_scopes_flag && extra_scopes_flag then err_incompat "clear scopes" "extra scopes"; if clear_implicits_flag && default_implicits_flag then err_incompat "clear implicits" "default implicits"; let args, nargs_for_red, nargs_before_bidi, _i = List.fold_left (fun (args,red,bidi,i) arg -> match arg with | RealArg arg -> (arg::args,red,bidi,i+1) | VolatileArg -> if Option.has_some red then CErrors.user_err Pp.(str "The \"/\" modifier may only occur once."); (args,Some i,bidi,i) | BidiArg -> if Option.has_some bidi then CErrors.user_err Pp.(str "The \"&\" modifier may only occur once."); (args,red,Some i,i)) ([],None,None,0) args in let args = List.rev args in let sr = smart_global reference in let inf_names = let ty, _ = Typeops.type_of_global_in_context env sr in List.map pi1 (Impargs.compute_implicits_names env sigma (EConstr.of_constr ty)) in let prev_names = try Arguments_renaming.arguments_names sr with Not_found -> inf_names in let num_args = List.length inf_names in assert (Int.equal num_args (List.length prev_names)); let names_of args = List.map (fun a -> a.name) args in (* Checks *) let err_extra_args names = CErrors.user_err Pp.(strbrk "Extra arguments: " ++ prlist_with_sep pr_comma Name.print names ++ str ".") in let err_missing_args names = CErrors.user_err Pp.(strbrk "The following arguments are not declared: " ++ prlist_with_sep pr_comma Name.print names ++ str ".") in let rec check_extra_args extra_args = match extra_args with | [] -> () | { notation_scope = [] } :: _ -> CErrors.user_err Pp.(str"Extra arguments should specify scopes.") | { notation_scope = _ :: _ } :: args -> check_extra_args args in let args, scopes = let scopes = List.map (fun { notation_scope = s } -> s) args in if List.length args > num_args then let args, extra_args = List.chop num_args args in if extra_scopes_flag then (check_extra_args extra_args; (args, scopes)) else err_extra_args (names_of extra_args) else args, scopes in if Option.cata (fun n -> n > num_args) false nargs_for_red then CErrors.user_err Pp.(str "The \"/\" modifier should be put before any extra scope."); if Option.cata (fun n -> n > num_args) false nargs_before_bidi then CErrors.user_err Pp.(str "The \"&\" modifier should be put before any extra scope."); let scopes_specified = List.exists ((<>) []) scopes in if scopes_specified && clear_scopes_flag then CErrors.user_err Pp.(str "The \"clear scopes\" flag is incompatible with scope annotations."); let names = List.map (fun { name } -> name) args in let names = names :: List.map (List.map fst) more_implicits in let rename_flag_required = ref false in let example_renaming = ref None in let save_example_renaming renaming = rename_flag_required := !rename_flag_required || not (Name.equal (fst renaming) Anonymous); if Option.is_empty !example_renaming then example_renaming := Some renaming in let rec names_union names1 names2 = match names1, names2 with | [], [] -> [] | _ :: _, [] -> names1 | [], _ :: _ -> names2 | (Name _ as name) :: names1, Anonymous :: names2 | Anonymous :: names1, (Name _ as name) :: names2 -> name :: names_union names1 names2 | name1 :: names1, name2 :: names2 -> if Name.equal name1 name2 then name1 :: names_union names1 names2 else CErrors.user_err Pp.(str "Argument lists should agree on the names they provide.") in let names = List.fold_left names_union [] names in let rec rename prev_names names = match prev_names, names with | [], [] -> [] | [], _ :: _ -> err_extra_args names | _ :: _, [] when assert_flag -> (* Error messages are expressed in terms of original names, not renamed ones. *) err_missing_args (List.lastn (List.length prev_names) inf_names) | _ :: _, [] -> prev_names | prev :: prev_names, Anonymous :: names -> prev :: rename prev_names names | prev :: prev_names, (Name id as name) :: names -> if not (Name.equal prev name) then save_example_renaming (prev,name); name :: rename prev_names names in let names = rename prev_names names in let renaming_specified = Option.has_some !example_renaming in if !rename_flag_required && not rename_flag then begin let msg = let open Pp in match !example_renaming with | None -> strbrk "To rename arguments the \"rename\" flag must be specified." | Some (o,n) -> strbrk "Flag \"rename\" expected to rename " ++ Name.print o ++ strbrk " into " ++ Name.print n ++ str "." in CErrors.user_err msg end; let implicits = List.map (fun { name; implicit_status = i } -> (name,i)) args in let implicits = implicits :: more_implicits in let implicits_specified = match implicits with | [l] -> List.exists (function _, Glob_term.Explicit -> false | _ -> true) l | _ -> true in if implicits_specified && clear_implicits_flag then CErrors.user_err Pp.(str "The \"clear implicits\" flag must be omitted if implicit annotations are given."); if implicits_specified && default_implicits_flag then CErrors.user_err Pp.(str "The \"default implicits\" flag is incompatible with implicit annotations."); let rargs = Util.List.map_filter (function (n, true) -> Some n | _ -> None) (Util.List.map_i (fun i { recarg_like = b } -> i, b) 0 args) in let red_behavior = let open Reductionops.ReductionBehaviour in match never_unfold_flag, nomatch_flag, rargs, nargs_for_red with | true, false, [], None -> Some NeverUnfold | true, true, _, _ -> err_incompat "simpl never" "simpl nomatch" | true, _, _::_, _ -> err_incompat "simpl never" "!" | true, _, _, Some _ -> err_incompat "simpl never" "/" | false, false, [], None -> None | false, false, _, _ -> Some (UnfoldWhen { nargs = nargs_for_red; recargs = rargs; }) | false, true, _, _ -> Some (UnfoldWhenNoMatch { nargs = nargs_for_red; recargs = rargs; }) in let red_modifiers_specified = Option.has_some red_behavior in let bidi_hint_specified = Option.has_some nargs_before_bidi in if bidi_hint_specified && clear_bidi_hint then err_incompat "clear bidirectionality hint" "&"; (* Actions *) if renaming_specified then begin Arguments_renaming.rename_arguments section_local sr names end; if scopes_specified || clear_scopes_flag then begin if List.exists (fun {v=d,_} -> d = Constrexpr.DelimUnboundedScope) (List.flatten scopes) then warn_scope_delimiter_depth (); let scopes = List.map (List.map (fun {loc;v=_d,k} -> try ignore (Notation.find_scope k); k with CErrors.UserError _ -> Notation.find_delimiters_scope ?loc k)) scopes in Notation.declare_arguments_scope section_local (smart_global reference) scopes end; if implicits_specified || clear_implicits_flag then Impargs.set_implicits section_local (smart_global reference) implicits; if default_implicits_flag then Impargs.declare_implicits section_local (smart_global reference); if red_modifiers_specified then begin match sr with | GlobRef.ConstRef c -> Reductionops.ReductionBehaviour.set ~local:section_local c (Option.get red_behavior) | _ -> CErrors.user_err Pp.(strbrk "Modifiers of the behavior of the simpl tactic "++ strbrk "are relevant for constants only.") end; if bidi_hint_specified then begin let n = Option.get nargs_before_bidi in if section_local then Pretyping.add_bidirectionality_hint sr n else Lib.add_leaf (inBidiHints (sr, Some n)) end; if clear_bidi_hint then begin if section_local then Pretyping.clear_bidirectionality_hint sr else Lib.add_leaf (inBidiHints (sr, None)) end; if not (renaming_specified || implicits_specified || scopes_specified || red_modifiers_specified || bidi_hint_specified) && (List.is_empty flags) then warn_arguments_assert sr coq-8.20.0/vernac/comArguments.mli000066400000000000000000000016241466560755400170350ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* Libnames.qualid Constrexpr.or_by_notation -> Vernacexpr.vernac_argument_status list -> (Names.Name.t * Glob_term.binding_kind) list list -> Vernacexpr.arguments_modifier list -> unit coq-8.20.0/vernac/comAssumption.ml000066400000000000000000000307361466560755400170670ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* Declare.SectionLocalAssum {typ; impl; univs} | Some b -> Declare.SectionLocalDef {clearbody = (* TODO *) false; entry = Declare.definition_entry ~univs ~types:typ b} in let () = Declare.declare_variable ~name ~kind ~typing_flags:None decl in let () = if body = None then Declare.assumption_message name else Declare.definition_message name in let r = GlobRef.VarRef name in let () = maybe_declare_manual_implicits true r impargs in let _ = if try_assum_as_instance && Option.is_empty body then let env = Global.env () in let sigma = Evd.from_env env in Classes.declare_instance env sigma None Hints.Local r in let () = if coe = Vernacexpr.AddCoercion then ComCoercion.try_add_new_coercion r ~local:true ~reversible:false in (r, UVars.Instance.empty) let declare_variable ~coe ~kind ~univs ~impargs ~impl ~name typ = declare_local ~coe ~try_assum_as_instance:true ~kind:(Decls.IsAssumption kind) ~univs ~impargs ~impl ~name None typ let instance_of_univ_entry = function | UState.Polymorphic_entry univs -> UVars.UContext.instance univs | UState.Monomorphic_entry _ -> UVars.Instance.empty (** Declares a global axiom/parameter, possibly declaring it: - as a coercion - as a type class instance - with implicit arguments - with inlining for functor application - with named universes *) let declare_global ~coe ~try_assum_as_instance ~local ~kind ?user_warns ~univs ~impargs ~inline ~name body typ = let (uentry, ubinders) = univs in let inl = let open Declaremods in match inline with | NoInline -> None | DefaultInline -> Some (Flags.get_inline_level()) | InlineAt i -> Some i in let decl = match body with | None -> Declare.ParameterEntry (Declare.parameter_entry ~univs:(uentry, ubinders) ?inline:inl typ) | Some b -> Declare.DefinitionEntry (Declare.definition_entry ~univs ~types:typ b) in let kn = Declare.declare_constant ~name ~local ~kind ?user_warns decl in let gr = GlobRef.ConstRef kn in let () = maybe_declare_manual_implicits false gr impargs in let () = match body with None -> Declare.assumption_message name | Some _ -> Declare.definition_message name in let local = match local with | Locality.ImportNeedQualified -> true | Locality.ImportDefaultBehavior -> false in let () = if try_assum_as_instance && Option.is_empty body then (* why local when is_modtype? *) let env = Global.env () in let sigma = Evd.from_env env in Classes.declare_instance env sigma None Hints.SuperGlobal gr in let () = if coe = Vernacexpr.AddCoercion then ComCoercion.try_add_new_coercion gr ~local ~reversible:false in let inst = instance_of_univ_entry uentry in (gr,inst) let declare_axiom ~coe ~local ~kind ?user_warns ~univs ~impargs ~inline ~name typ = declare_global ~coe ~try_assum_as_instance:false ~local ~kind:(Decls.IsAssumption kind) ?user_warns ~univs ~impargs ~inline ~name None typ let interp_assumption ~program_mode env sigma impl_env bl c = let flags = { Pretyping.all_no_fail_flags with program_mode } in 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 let empty_poly_univ_entry = UState.Polymorphic_entry UVars.UContext.empty, UnivNames.empty_binders let empty_mono_univ_entry = UState.Monomorphic_entry Univ.ContextSet.empty, UnivNames.empty_binders let empty_univ_entry poly = if poly then empty_poly_univ_entry else empty_mono_univ_entry let clear_univs scope univ = match scope, univ with | Locality.Global _, (UState.Polymorphic_entry _, _ as univs) -> univs | _, (UState.Monomorphic_entry _, _) -> empty_univ_entry false | Locality.Discharge, (UState.Polymorphic_entry _, _) -> empty_univ_entry true let context_subst subst (id,b,t,infos) = id, Option.map (Vars.replace_vars subst) b, Vars.replace_vars subst t, infos let declare_context ~try_global_assum_as_instance ~scope ~univs ?user_warns ~inline ctx = let fn i subst d = let (name,b,t,(impl,kind,coe,impargs)) = context_subst subst d in let univs = if i = 0 then univs else clear_univs scope univs in let refu = match scope with | Locality.Discharge -> declare_local ~coe ~try_assum_as_instance:true ~kind ~univs ~impargs ~impl ~name b t | Locality.Global local -> declare_global ~coe ~try_assum_as_instance:try_global_assum_as_instance ~local ~kind ?user_warns ~univs ~impargs ~inline ~name b t in (name, Constr.mkRef refu) :: subst in let _ = List.fold_left_i fn 0 [] ctx in () let error_extra_universe_decl ?loc () = user_err ?loc Pp.(strbrk "When declaring multiple assumptions in one command, " ++ strbrk "only the first name is allowed to mention a universe binder " ++ strbrk "(which will be shared by the whole block).") let extract_assumption_names = function | ({CAst.loc;v=id}, Some _) -> error_extra_universe_decl ?loc () | (id, None) -> id let process_assumptions_udecls = function | (coe, ((id, udecl)::ids, c))::assums -> let ids = List.map extract_assumption_names ids in let assums = List.map (fun (coe, (idl, c)) -> (coe, (List.map extract_assumption_names idl, c))) assums in udecl, (coe,(id::ids,c))::assums | (_, ([], _))::_ | [] -> assert false let error_polymorphic_section_variable ?loc () = user_err ?loc (Pp.str "Section variables cannot be polymorphic.") let process_assumptions_no_udecls l = List.map (fun (coe, (ids, c)) -> (coe, (List.map (function | ({CAst.loc}, Some _) -> error_polymorphic_section_variable ?loc () | (id, None) -> id) ids, c))) l let extract_manual_implicit e = CAst.make (match e with | Some {impl_pos = (na,_,_); impl_expl = Manual; impl_max = max} -> Some (na,max) | Some {impl_expl = (DepFlexAndRigid _ | DepFlex _ | DepRigid _ )} | None -> None) let find_implicits id ienv = try let impls = implicits_of_decl_in_internalization_env id ienv in List.map extract_manual_implicit impls with Not_found -> [] let local_binders_of_decls ~poly l = let coercions, l = List.fold_left_map (fun coercions (is_coe,(idl,c)) -> let coercions = match is_coe with | Vernacexpr.NoCoercion -> coercions | Vernacexpr.AddCoercion -> List.fold_right (fun id -> Id.Set.add id.CAst.v) idl coercions in let make_name id = CAst.make ?loc:id.CAst.loc (Name id.CAst.v) in let make_assum idl = Constrexpr.(CLocalAssum (List.map make_name idl,None,Default Glob_term.Explicit,c)) in let decl = if poly then (* Separate declarations so that A B : Type puts A and B in different levels. *) List.map (fun id -> make_assum [id]) idl else [make_assum idl] in (coercions,decl)) Id.Set.empty l in coercions, List.flatten l let find_binding_kind id impls = let open Glob_term in let find x = match x.CAst.v with | Some (Name id',max) when Id.equal id id' -> Some (if max then MaxImplicit else NonMaxImplicit) | _ -> None in Option.default Explicit (CList.find_map find impls) let interp_context_gen ~program_mode ~kind ~share ~autoimp_enable ~coercions env sigma l = let sigma, (ienv, ((env, ctx), impls)) = interp_named_context_evars ~program_mode ~share ~autoimp_enable env sigma l in (* Note, we must use the normalized evar from now on! *) let sigma = solve_remaining_evars all_and_fail_flags env sigma in let sigma, ctx = Evarutil.finalize sigma @@ fun nf -> List.map (NamedDecl.map_constr_het (fun x -> x) nf) ctx in (* reorder, evar-normalize and add implicit status *) let ctx = List.rev_map (fun d -> let {binder_name=id}, b, t = NamedDecl.to_tuple d in let impl = find_binding_kind id impls in let kind = Decls.(if b = None then IsAssumption kind else IsDefinition (match kind with Context -> LetContext | _ -> Let)) in let is_coe = if Id.Set.mem id coercions then Vernacexpr.AddCoercion else Vernacexpr.NoCoercion in let impls = if autoimp_enable then find_implicits id ienv else [] in let data = (impl,kind,is_coe,impls) in (id,b,t,data)) ctx in sigma, ctx let do_assumptions ~program_mode ~poly ~scope ~kind ?user_warns ~inline l = let sec = Lib.sections_are_opened () in if Dumpglob.dump () then begin List.iter (fun (_,(idl,_)) -> List.iter (fun (lid, _) -> let ty = if sec then "var" else "ax" in Dumpglob.dump_definition lid sec ty) idl) l end; let env = Global.env () in let udecl, l = match scope with | Locality.Global import_behavior -> process_assumptions_udecls l | Locality.Discharge -> None, process_assumptions_no_udecls l in let sigma, udecl = interp_univ_decl_opt env udecl in let coercions, ctx = local_binders_of_decls ~poly l in let sigma, ctx = interp_context_gen ~program_mode ~kind ~share:true ~autoimp_enable:true ~coercions env sigma ctx in let univs = Evd.check_univ_decl ~poly sigma udecl in declare_context ~try_global_assum_as_instance:false ~scope ~univs ?user_warns ~inline ctx let warn_context_outside_section = CWarnings.create ~name:"context-outside-section" ~category:CWarnings.CoreCategories.vernacular ~default:CWarnings.AsError Pp.(fun () -> strbrk "Use of \"Context\" outside sections behaves \ as \"#[local] Parameter\" or \"#[local] \ Axiom\" followed by \"Existing Instance\" \ for typeclasses.") let do_context ~program_mode ~poly ctx = let sec = Lib.sections_are_opened () in if not sec then warn_context_outside_section (); if Dumpglob.dump () then begin let l = List.map (function | Constrexpr.CLocalAssum (l, _, _, _) -> let ty = if sec then "var "else "ax" in List.map (fun n -> ty, n) l | Constrexpr.CLocalDef (n, _, _, _) -> let ty = if sec then "var "else "def" in [ty, n] | Constrexpr.CLocalPattern _ -> []) ctx in List.iter (function | ty, {CAst.v = Names.Name.Anonymous; _} -> () | ty, {CAst.v = Names.Name.Name id; loc} -> Dumpglob.dump_definition (CAst.make ?loc id) sec ty) (List.flatten l) end; let env = Global.env() in let sigma = Evd.from_env env in let scope = let open Locality in if sec then Discharge else Global (if Lib.is_modtype () then ImportDefaultBehavior else ImportNeedQualified) in let sigma, ctx = interp_context_gen ~program_mode ~kind:Context ~share:false ~autoimp_enable:false ~coercions:Id.Set.empty env sigma ctx in let univs = Evd.univ_entry ~poly sigma in declare_context ~try_global_assum_as_instance:true ~scope ~univs ~inline:Declaremods.NoInline ctx (* API compatibility (used in Elpi) *) let interp_context env sigma ctx = let reverse_rel_context_of_reverse_named_context ctx = List.rev (snd (List.fold_left_i (fun n (subst, ctx) (id,b,t,impl) -> let decl = (id, Option.map (Vars.subst_vars subst) b, Vars.subst_vars subst t, impl) in (id :: subst, decl :: ctx)) 1 ([],[]) ctx)) in let sigma, ctx = interp_context_gen ~program_mode:false ~kind:Context ~share:false ~autoimp_enable:false ~coercions:Id.Set.empty env sigma ctx in let ctx = List.map (fun (id,b,t,(impl,_,_,_)) -> (id,b,t,impl)) ctx in sigma, reverse_rel_context_of_reverse_named_context ctx coq-8.20.0/vernac/comAssumption.mli000066400000000000000000000066471466560755400172440ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* kind:Decls.assumption_object_kind -> univs:UState.named_universes_entry -> impargs:Impargs.manual_implicits -> impl:Glob_term.binding_kind -> name:variable -> Constr.types -> GlobRef.t * UVars.Instance.t (** Declaration of a local construction (Variable/Hypothesis/Let) *) val declare_local : coe:coercion_flag -> try_assum_as_instance:bool (* true = declare a variable of type a class as an instance *) -> kind:Decls.logical_kind -> univs:UState.named_universes_entry -> impargs:Impargs.manual_implicits -> impl:Glob_term.binding_kind -> name:variable -> Constr.constr option -> Constr.types -> GlobRef.t * UVars.Instance.t (** Declaration of a global assumption (Axiom/Parameter) *) val declare_axiom : coe:coercion_flag -> local:Locality.import_status -> kind:Decls.assumption_object_kind -> ?user_warns:UserWarn.t -> univs:UState.named_universes_entry -> impargs:Impargs.manual_implicits -> inline:Declaremods.inline -> name:variable -> Constr.types -> GlobRef.t * UVars.Instance.t (** Declaration of a global construction (Axiom/Parameter/Definition) *) val declare_global : coe:coercion_flag -> try_assum_as_instance:bool (* true = declare a parameter of type a class as an instance *) -> local:Locality.import_status -> kind:Decls.logical_kind -> ?user_warns:UserWarn.t -> univs:UState.named_universes_entry -> impargs:Impargs.manual_implicits -> inline:Declaremods.inline -> name:variable -> Constr.constr option -> Constr.types -> GlobRef.t * UVars.Instance.t (** Interpret the commands Variable/Hypothesis/Axiom/Parameter *) val do_assumptions : program_mode:bool -> poly:bool -> scope:Locality.definition_scope -> kind:Decls.assumption_object_kind -> ?user_warns:UserWarn.t -> inline:Declaremods.inline -> (ident_decl list * constr_expr) with_coercion list -> unit (** Interpret the command Context *) val do_context : program_mode:bool -> poly:bool -> local_binder_expr list -> unit (** Interpret a declaration of the form [binders |- typ] as a type *) 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.types * Impargs.manual_implicits (** The first half of the context command, returning the declarations in the same order as [Context], using de Bruijn indices (used by Elpi) *) val interp_context : Environ.env -> Evd.evar_map -> local_binder_expr list -> Evd.evar_map * (Id.t * Constr.t option * Constr.t * Glob_term.binding_kind) list coq-8.20.0/vernac/comCoercion.ml000066400000000000000000000331501466560755400164570ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* (Printer.pr_global g ++ str" is already a coercion") | NotAFunction -> (Printer.pr_global g ++ str" is not a function") | NoSource (Some cl) -> (str "Cannot recognize " ++ pr_class cl ++ str " as a source class of " ++ Printer.pr_global g) | NoSource None -> (str ": cannot find the source class of " ++ Printer.pr_global g) | ForbiddenSourceClass cl -> pr_class cl ++ str " cannot be a source class" | NoTarget -> (str"Cannot find the target class") | WrongTarget (clt,cl) -> (str"Found target class " ++ pr_class cl ++ str " instead of " ++ pr_class clt) | NotAClass ref -> (str "Type of " ++ Printer.pr_global ref ++ str " does not end with a sort") (* Verifications pour l'ajout d'une classe *) let check_reference_arity ref = let env = Global.env () in let c, _ = Typeops.type_of_global_in_context env ref in if not (Reductionops.is_arity env (Evd.from_env env) (EConstr.of_constr c)) (* FIXME *) then raise (CoercionError (NotAClass ref)) let check_arity = function | CL_FUN | CL_SORT -> () | CL_CONST cst -> check_reference_arity (GlobRef.ConstRef cst) | CL_PROJ p -> check_reference_arity (GlobRef.ConstRef (Projection.Repr.constant p)) | CL_SECVAR id -> check_reference_arity (GlobRef.VarRef id) | CL_IND kn -> check_reference_arity (GlobRef.IndRef kn) (* Coercions *) (* check that the computed target is the provided one *) let check_target clt = function | Some cl when not (cl_typ_eq cl clt) -> raise (CoercionError (WrongTarget(clt,cl))) | _ -> () (* condition d'heritage uniforme *) let uniform_cond sigma ctx lt = List.for_all2eq (EConstr.eq_constr sigma) lt (Context.Rel.instance_list EConstr.mkRel 0 ctx) let class_of_global = function | GlobRef.ConstRef sp -> (match Structures.PrimitiveProjections.find_opt sp with | Some p -> CL_PROJ p | None -> CL_CONST sp) | GlobRef.IndRef sp -> CL_IND sp | GlobRef.VarRef id -> CL_SECVAR id | GlobRef.ConstructRef _ as c -> user_err (str "Constructors, such as " ++ Printer.pr_global c ++ str ", cannot be used as a class.") (* lp est la liste (inverse'e) des arguments de la coercion ids est le nom de la classe source sps_opt est le sp de la classe source dans le cas des structures retourne: la classe source nbre d'arguments de la classe le constr de la class la liste des variables dont depend la classe source l'indice de la classe source dans la liste lp *) let get_source env lp source = let open Context.Rel.Declaration in match source with | None -> (* Take the latest non let-in argument *) let rec aux = function | [] -> raise Not_found | LocalDef _ :: lt -> aux lt | LocalAssum (_,t1) :: lt -> let cl1,u1,lv1 = find_class_type (push_rel_context lt env) Evd.empty (EConstr.of_constr t1) in cl1,lt,lv1,1 in aux lp | Some cl -> (* Take the first argument that matches *) let rec aux env acc = function | [] -> raise Not_found | LocalDef _ as decl :: lt -> aux (push_rel decl env) (decl::acc) lt | LocalAssum (_,t1) as decl :: lt -> try let cl1,u1,lv1 = find_class_type env Evd.empty (EConstr.of_constr t1) in if cl_typ_eq cl cl1 then cl1,acc,lv1,Context.Rel.nhyps lt+1 else raise Not_found with Not_found -> aux (push_rel decl env) (decl::acc) lt in aux env [] (List.rev lp) let get_target env lp t ind = if (ind > 1) then CL_FUN else match pi1 (find_class_type (push_rel_context lp env) Evd.empty (EConstr.of_constr t)) with | CL_CONST p when Structures.PrimitiveProjections.mem p -> CL_PROJ (Option.get @@ Structures.PrimitiveProjections.find_opt p) | x -> x let strength_of_cl = function | CL_CONST kn -> `GLOBAL | CL_SECVAR id -> `LOCAL | _ -> `GLOBAL let strength_of_global = function | GlobRef.VarRef _ -> `LOCAL | _ -> `GLOBAL let get_strength stre ref cls clt = let stres = strength_of_cl cls in let stret = strength_of_cl clt in let stref = strength_of_global ref in strength_min [stre;stres;stret;stref] let ident_key_of_class = function | CL_FUN -> "Funclass" | CL_SORT -> "Sortclass" | CL_CONST sp -> Label.to_string (Constant.label sp) | CL_PROJ sp -> Label.to_string (Projection.Repr.label sp) | CL_IND (sp,_) -> Label.to_string (MutInd.label sp) | CL_SECVAR id -> Id.to_string id (* Identity coercion *) let error_not_transparent source = user_err (pr_class source ++ str " must be a transparent constant.") let build_id_coercion idf_opt source poly = let env = Global.env () in let sigma = Evd.from_env env in let sigma, vs = match source with | CL_CONST sp -> Evd.fresh_global env sigma (GlobRef.ConstRef sp) | _ -> error_not_transparent source in let vs = EConstr.Unsafe.to_constr vs in let c = match constant_opt_value_in env (destConst vs) with | Some c -> c | None -> error_not_transparent source in let lams,t = decompose_lambda_decls c in let val_f = Term.it_mkLambda_or_LetIn (mkLambda (make_annot (Name Namegen.default_dependent_ident) Sorts.Relevant, applistc vs (Context.Rel.instance_list mkRel 0 lams), mkRel 1)) lams in let typ_f = List.fold_left (fun d c -> Term.mkProd_wo_LetIn c d) (mkProd (make_annot Anonymous Sorts.Relevant, applistc vs (Context.Rel.instance_list mkRel 0 lams), lift 1 t)) lams in (* juste pour verification *) let sigma, val_t = Typing.type_of env sigma (EConstr.of_constr val_f) in let () = if not (Reductionops.is_conv_leq env sigma val_t (EConstr.of_constr typ_f)) then user_err (strbrk "Cannot be defined as coercion (maybe a bad number of arguments).") in let name = match idf_opt with | Some idf -> idf | None -> let cl,u,_ = find_class_type env sigma (EConstr.of_constr t) in Id.of_string ("Id_"^(ident_key_of_class source)^"_"^ (ident_key_of_class cl)) in let univs = Evd.univ_entry ~poly sigma in let constr_entry = (* Cast is necessary to express [val_f] is identity *) DefinitionEntry (definition_entry ~types:typ_f ~univs ~inline:true (mkCast (val_f, DEFAULTcast, typ_f))) in let kind = Decls.(IsDefinition IdentityCoercion) in let kn = declare_constant ~name ~kind constr_entry in GlobRef.ConstRef kn let check_source = function | Some (CL_FUN as s) -> raise (CoercionError (ForbiddenSourceClass s)) | _ -> () let cache_coercion ?(update=false) c = let env = Global.env () in let sigma = Evd.from_env env in Coercionops.declare_coercion env sigma ~update c let open_coercion i o = if Int.equal i 1 then cache_coercion o let discharge_coercion c = if c.coe_local then None else let n = try Array.length (Lib.section_instance c.coe_value) with Not_found -> 0 in let nc = { c with coe_param = n + c.coe_param; coe_is_projection = Option.map Lib.discharge_proj_repr c.coe_is_projection; } in Some nc let rebuild_coercion c = { c with coe_typ = fst (Typeops.type_of_global_in_context (Global.env ()) c.coe_value) } let classify_coercion obj = if obj.coe_local then Dispose else Substitute let coe_cat = create_category "coercions" let inCoercion : coe_info_typ -> obj = declare_object {(default_object "COERCION") with open_function = simple_open ~cat:coe_cat open_coercion; cache_function = cache_coercion; subst_function = (fun (subst,c) -> subst_coercion subst c); classify_function = classify_coercion; discharge_function = discharge_coercion; rebuild_function = rebuild_coercion } let declare_coercion coef typ ?(local = false) ~reversible ~isid ~src:cls ~target:clt ~params:ps () = let isproj = match coef with | GlobRef.ConstRef c -> Structures.PrimitiveProjections.find_opt c | _ -> None in let c = { coe_value = coef; coe_typ = typ; coe_local = local; coe_reversible = reversible; coe_is_identity = isid; coe_is_projection = isproj; coe_source = cls; coe_target = clt; coe_param = ps; } in Lib.add_leaf (inCoercion c) (* nom de la fonction coercion strength de f nom de la classe source (optionnel) sp de la classe source (dans le cas des structures) nom de la classe target (optionnel) booleen "coercion identite'?" lorque source est None alors target est None aussi. *) let warn_uniform_inheritance = CWarnings.create ~name:"uniform-inheritance" ~category:CWarnings.CoreCategories.coercions (fun g -> Printer.pr_global g ++ strbrk" does not respect the uniform inheritance condition.") let add_new_coercion_core coef stre ~reversible source target isid : unit = check_source source; let env = Global.env () in let t, _ = Typeops.type_of_global_in_context env coef in if coercion_exists coef then raise (CoercionError AlreadyExists); let lp,tg = decompose_prod_decls t in let llp = List.length lp in if Int.equal llp 0 then raise (CoercionError NotAFunction); let (cls,ctx,lvs,ind) = try get_source env lp source with Not_found -> raise (CoercionError (NoSource source)) in check_source (Some cls); if not (uniform_cond Evd.empty (* FIXME - for when possibly called with unresolved evars in the future *) ctx lvs) then warn_uniform_inheritance coef; let clt = try get_target env lp tg ind with Not_found -> raise (CoercionError NoTarget) in check_target clt target; check_arity cls; check_arity clt; let local = match get_strength stre coef cls clt with | `LOCAL -> true | `GLOBAL -> false in let params = List.length (Context.Rel.instance_list EConstr.mkRel 0 ctx) in declare_coercion coef t ~local ~reversible ~isid ~src:cls ~target:clt ~params () let try_add_new_coercion_core ref ~local c ~reversible d e = try add_new_coercion_core ref (loc_of_bool local) c ~reversible d e with CoercionError e -> user_err (explain_coercion_error ref e ++ str ".") let try_add_new_coercion ref ~local ~reversible = try_add_new_coercion_core ref ~local ~reversible None None false let try_add_new_coercion_subclass cl ~local ~poly ~reversible = let coe_ref = build_id_coercion None cl poly in try_add_new_coercion_core coe_ref ~local ~reversible (Some cl) None true let try_add_new_coercion_with_target ref ~local ~reversible ~source ~target = try_add_new_coercion_core ref ~local ~reversible (Some source) (Some target) false let try_add_new_identity_coercion id ~local ~poly ~source ~target = let ref = build_id_coercion (Some id) source poly in try_add_new_coercion_core ref ~local ~reversible:true (Some source) (Some target) true let try_add_new_coercion_with_source ref ~local ~reversible ~source = try_add_new_coercion_core ref ~local ~reversible (Some source) None false let add_coercion_hook reversible { Declare.Hook.S.scope; dref; _ } = let open Locality in let local = match scope with | Discharge -> assert false (* Local Coercion in section behaves like Local Definition *) | Global ImportNeedQualified -> true | Global ImportDefaultBehavior -> false in let () = try_add_new_coercion dref ~local ~reversible in let msg = Nametab.pr_global_env Id.Set.empty dref ++ str " is now a coercion" in Flags.if_verbose Feedback.msg_info msg let add_coercion_hook ~reversible = Declare.Hook.make (add_coercion_hook reversible) let add_subclass_hook ~poly { Declare.Hook.S.scope; dref; _ } = let open Locality in let stre = match scope with | Discharge -> assert false (* Local Subclass in section behaves like Local Definition *) | Global ImportNeedQualified -> true | Global ImportDefaultBehavior -> false in let cl = class_of_global dref in try_add_new_coercion_subclass cl ~local:stre ~poly let nonuniform = Attributes.bool_attribute ~name:"nonuniform" let add_subclass_hook ~poly ~reversible = Declare.Hook.make (add_subclass_hook ~poly ~reversible) let warn_reverse_no_change = CWarnings.create ~name:"reversible-no-change" ~category:CWarnings.CoreCategories.coercions (fun () -> str "The reversible attribute is unchanged.") let change_reverse ref ~reversible = if not (coercion_exists ref) then user_err (Printer.pr_global ref ++ str" is not a coercion."); let coe_info = coercion_info ref in if reversible = coe_info.coe_reversible then warn_reverse_no_change () else cache_coercion ~update:true { coe_info with coe_reversible = reversible } coq-8.20.0/vernac/comCoercion.mli000066400000000000000000000046701466560755400166350ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* local:bool -> reversible:bool -> source:cl_typ -> target:cl_typ -> unit (** [try_add_new_coercion ref s] declares [ref], assumed to be of type [(x1:T1)...(xn:Tn)src->tg], as a coercion from [src] to [tg] *) val try_add_new_coercion : GlobRef.t -> local:bool -> reversible:bool -> unit (** [try_add_new_coercion_subclass cst s] expects that [cst] denotes a transparent constant which unfolds to some class [tg]; it declares an identity coercion from [cst] to [tg], named something like ["Id_cst_tg"] *) val try_add_new_coercion_subclass : cl_typ -> local:bool -> poly:bool -> reversible:bool -> unit (** [try_add_new_coercion_with_source ref s src] declares [ref] as a coercion from [src] to [tg] where the target is inferred from the type of [ref] *) val try_add_new_coercion_with_source : GlobRef.t -> local:bool -> reversible:bool -> source:cl_typ -> unit (** [try_add_new_identity_coercion id s src tg] enriches the environment with a new definition of name [id] declared as an identity coercion from [src] to [tg] *) val try_add_new_identity_coercion : Id.t -> local:bool -> poly:bool -> source:cl_typ -> target:cl_typ -> unit val add_coercion_hook : reversible:bool -> Declare.Hook.t val add_subclass_hook : poly:bool -> reversible:bool -> Declare.Hook.t val class_of_global : GlobRef.t -> cl_typ (** Attribute to silence warning for coercions that don't satisfy the uniform inheritance condition. (deprecated in 8.18) *) val nonuniform : bool option Attributes.attribute val change_reverse : GlobRef.t -> reversible:bool -> unit coq-8.20.0/vernac/comDefinition.ml000066400000000000000000000156401466560755400170120ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* sigma, body | Some red -> let red, _ = reduction_of_red_expr env red in red env sigma body let warn_implicits_in_term = CWarnings.create ~name:"implicits-in-term" ~category:CWarnings.CoreCategories.implicits (fun () -> strbrk "Implicit arguments declaration relies on type." ++ spc () ++ strbrk "Discarding incompatible declaration in term.") let check_imps ~impsty ~impsbody = let rec aux impsty impsbody = match impsty, impsbody with | a1 :: impsty, a2 :: impsbody -> let () = match a1.CAst.v, a2.CAst.v with | None , None | Some _, None -> () | Some (_,b1) , Some (_,b2) -> if not ((b1:bool) = b2) then warn_implicits_in_term ?loc:a2.CAst.loc () | None, Some _ -> warn_implicits_in_term ?loc:a2.CAst.loc () in aux impsty impsbody | _ :: _, [] | [], _ :: _ -> (* Information only on one side *) () | [], [] -> () in aux impsty impsbody let protect_pattern_in_binder bl c ctypopt = (* We turn "Definition d binders := body : typ" into *) (* "Definition d := fun binders => body:type" *) (* This is a hack while waiting for LocalPattern in regular environments *) if List.exists (function Constrexpr.CLocalPattern _ -> true | _ -> false) bl then let t = match ctypopt with | None -> CAst.make ?loc:c.CAst.loc (Constrexpr.CHole (None)) | Some t -> t in let loc = Loc.merge_opt c.CAst.loc t.CAst.loc in let c = CAst.make ?loc @@ Constrexpr.CCast (c, Some Constr.DEFAULTcast, t) in let loc = match List.hd bl with | Constrexpr.CLocalAssum (a::_,_,_,_) | Constrexpr.CLocalDef (a,_,_,_) -> a.CAst.loc | Constrexpr.CLocalPattern {CAst.loc} -> loc | Constrexpr.CLocalAssum ([],_,_,_) -> assert false in let apply_under_binders f env evd c = let rec aux env evd c = let open Constr in let open EConstr in let open Context.Rel.Declaration in match kind evd c with | Lambda (x,t,c) -> let evd,c = aux (push_rel (LocalAssum (x,t)) env) evd c in evd, mkLambda (x,t,c) | LetIn (x,b,t,c) -> let evd,c = aux (push_rel (LocalDef (x,b,t)) env) evd c in evd, mkLetIn (x,t,b,c) | Case (ci,u,pms,p,iv,a,bl) -> let (ci, p, iv, a, bl) = EConstr.expand_case env evd (ci, u, pms, p, iv, a, bl) in let evd,bl = Array.fold_left_map (aux env) evd bl in evd, mkCase (EConstr.contract_case env evd (ci, p, iv, a, bl)) | Cast (c,_,_) -> f env evd c (* we remove the cast we had set *) (* This last case may happen when reaching the proof of an impossible case, as when pattern-matching on a vector of length 1 *) | _ -> (evd,c) in aux env evd c in ([], Constrexpr_ops.mkLambdaCN ?loc:(Loc.merge_opt loc c.CAst.loc) bl c, None, apply_under_binders) else (bl, c, ctypopt, fun f env evd c -> f env evd c) 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 (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 ~impl_env env evd bl in (* Build the type *) let evd, tyopt = Option.fold_left_map (interp_type_evars_impls ~flags ~impls env_bl) evd ctypopt in (* Build the body, and merge implicits from parameters and from type/body *) let evd, c, imps, tyopt = match tyopt with | None -> let evd, (c, impsbody) = interp_constr_evars_impls ~program_mode ~impls env_bl evd c in evd, c, imps1@impsbody, None | Some (ty, impsty) -> let evd, (c, impsbody) = interp_casted_constr_evars_impls ~program_mode ~impls env_bl evd c ty in check_imps ~impsty ~impsbody; evd, c, imps1@impsty, Some ty in (* Do the reduction *) let evd, c = apply_under_binders (red_constant_body red_option) env_bl evd c in (* 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 evd, (c, tyopt), imps let do_definition ?hook ~name ?scope ?clearbody ~poly ?typing_flags ~kind ?using ?user_warns udecl bl red_option c ctypopt = let program_mode = false in let env = Global.env() in let env = Environ.update_typing_flags ?typing_flags env in (* Explicitly bound universes and constraints *) let evd, udecl = 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 let info = Declare.Info.make ?scope ?clearbody ~kind ?hook ~udecl ~poly ?typing_flags ?user_warns () in let _ : Names.GlobRef.t = Declare.declare_definition ~info ~cinfo ~opaque:false ~body ?using evd in () let do_definition_program ?hook ~pm ~name ~scope ?clearbody ~poly ?typing_flags ~kind ?using ?user_warns udecl bl red_option c ctypopt = let () = if not poly then udecl |> Option.iter (fun udecl -> if not udecl.UState.univdecl_extensible_instance || not udecl.UState.univdecl_extensible_constraints then CErrors.user_err Pp.(str "Non extensible universe declaration not supported \ with monomorphic Program Definition.")) in let env = Global.env() in let env = Environ.update_typing_flags ?typing_flags env in (* Explicitly bound universes and constraints *) let evd, udecl = interp_univ_decl_opt env udecl in let evd, (body, types), impargs = interp_definition ~program_mode:true env evd empty_internalization_env bl red_option c ctypopt in let body, typ, uctx, _, obls = Declare.Obls.prepare_obligations ~name ~body ?types env evd in let pm, _ = let cinfo = Declare.CInfo.make ~name ~typ ~impargs () in let info = Declare.Info.make ~udecl ~scope ?clearbody ~poly ~kind ?hook ?typing_flags ?user_warns () in Declare.Obls.add_definition ~pm ~info ~cinfo ~opaque:false ~body ~uctx ?using obls in pm coq-8.20.0/vernac/comDefinition.mli000066400000000000000000000036001466560755400171540ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* 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 -> ?scope:Locality.definition_scope -> ?clearbody:bool -> poly:bool -> ?typing_flags:Declarations.typing_flags -> kind:Decls.definition_object_kind -> ?using:Vernacexpr.section_subset_expr -> ?user_warns:UserWarn.t -> universe_decl_expr option -> local_binder_expr list -> red_expr option -> constr_expr -> constr_expr option -> unit val do_definition_program : ?hook:Declare.Hook.t -> pm:Declare.OblState.t -> name:Id.t -> scope:Locality.definition_scope -> ?clearbody:bool -> poly:bool -> ?typing_flags:Declarations.typing_flags -> kind:Decls.logical_kind -> ?using:Vernacexpr.section_subset_expr -> ?user_warns:UserWarn.t -> universe_decl_expr option -> local_binder_expr list -> red_expr option -> constr_expr -> constr_expr option -> Declare.OblState.t coq-8.20.0/vernac/comExtraDeps.ml000066400000000000000000000025311466560755400166140ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* user_err Pp.(str "Extra dependency " ++ Id.print id ++ str " already bound to " ++ str other ++ pr_opt (fun x -> str " at " ++ Loc.pr x) loc ++ str ".") | None -> extra_deps := Id.Map.add id (path,loc) !extra_deps let declare_extra_dep ?loc ~from ~file id = let file_path = Loadpath.find_extra_dep_with_logical_path ?loc ~from ~file () in Option.iter (bind_extra_dep ?loc file_path) id let query_extra_dep id = fst @@ Id.Map.find id !extra_deps coq-8.20.0/vernac/comExtraDeps.mli000066400000000000000000000015201466560755400167620ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* from:Names.DirPath.t -> file:string -> Names.Id.t option -> unit val query_extra_dep : Names.Id.t -> string (* @raise Not_found *) coq-8.20.0/vernac/comFixpoint.ml000066400000000000000000000357641466560755400165330ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* ('a * ('a,'a list) union) list *) let rec partial_order cmp = function | [] -> [] | (x,xge)::rest -> let rec browse res xge' = function | [] -> let res = List.map (function | (z, Inr zge) when List.mem_f cmp x zge -> (z, Inr (List.union cmp zge xge')) | r -> r) res in (x,Inr xge')::res | y::xge -> let rec link y = try match List.assoc_f cmp y res with | Inl z -> link z | Inr yge -> if List.mem_f cmp x yge then let res = List.remove_assoc_f cmp y res in let res = List.map (function | (z, Inl t) -> if cmp t y then (z, Inl x) else (z, Inl t) | (z, Inr zge) -> if List.mem_f cmp y zge then (z, Inr (List.add_set cmp x (List.remove cmp y zge))) else (z, Inr zge)) res in browse ((y,Inl x)::res) xge' (List.union cmp xge yge) else browse res (List.add_set cmp y (List.union cmp xge' yge)) xge with Not_found -> browse res (List.add_set cmp y xge') xge in link y in browse (partial_order cmp rest) [] xge let non_full_mutual_message x xge y yge isfix rest = let reason = if Id.List.mem x yge then Id.print y ++ str " depends on " ++ Id.print x ++ strbrk " but not conversely" else if Id.List.mem y xge then Id.print x ++ str " depends on " ++ Id.print y ++ strbrk " but not conversely" else Id.print y ++ str " and " ++ Id.print x ++ strbrk " are not mutually dependent" in let e = if List.is_empty rest then reason else strbrk "e.g., " ++ reason in let k = if isfix then "fixpoint" else "cofixpoint" in let w = if isfix then strbrk "Well-foundedness check may fail unexpectedly." ++ fnl() else mt () in strbrk "Not a fully mutually defined " ++ str k ++ fnl () ++ str "(" ++ e ++ str ")." ++ fnl () ++ w let warn_non_full_mutual = CWarnings.create ~name:"non-full-mutual" ~category:CWarnings.CoreCategories.fixpoints (fun (x,xge,y,yge,isfix,rest) -> non_full_mutual_message x xge y yge isfix rest) let warn_non_recursive = CWarnings.create ~name:"non-recursive" ~category:CWarnings.CoreCategories.fixpoints (fun (x,isfix) -> let k = if isfix then "fixpoint" else "cofixpoint" in strbrk "Not a truly recursive " ++ str k ++ str ".") let check_true_recursivity env evd ~isfix fixl = let names = List.map fst fixl in let preorder = List.map (fun (id,def) -> (id, List.filter (fun id' -> Termops.occur_var env evd id' def) names)) fixl in let po = partial_order Id.equal preorder in match List.filter (function (_,Inr _) -> true | _ -> false) po with | (x,Inr xge)::(y,Inr yge)::rest -> warn_non_full_mutual (x,xge,y,yge,isfix,rest) | _ -> match po with | [x,Inr []] -> warn_non_recursive (x,isfix) | _ -> () (* Interpret the index of a recursion order annotation *) exception Found of int let find_rec_annot bl ctx na = let name = Name na.CAst.v in try Context.Rel.fold_outside (fun decl n -> match Context.Rel.Declaration.(get_value decl, Name.equal (get_name decl) name) with | None, true -> raise (Found n) | Some _, true -> let loc = List.find_map (fun id -> if Name.equal name id.CAst.v then Some id.CAst.loc else None) (Constrexpr_ops.names_of_local_binders bl) in let loc = Option.default na.CAst.loc loc in CErrors.user_err ?loc (Name.print name ++ str" must be a proper parameter and not a local definition.") | None, false -> n + 1 | Some _, false -> n (* let-ins don't count *)) ~init:0 ctx |> ignore; CErrors.user_err ?loc:na.loc (str "No parameter named " ++ Id.print na.v ++ str"."); with Found k -> k let interp_fix_context ~program_mode ~cofix env sigma fix = let sigma, (impl_env, ((env', ctx), imps)) = interp_context_evars ~program_mode env sigma fix.Vernacexpr.binders in if not cofix && Context.Rel.nhyps ctx = 0 then CErrors.user_err Pp.(str "A fixpoint needs at least one parameter."); let annot = Option.map (find_rec_annot fix.Vernacexpr.binders ctx) fix.Vernacexpr.rec_order in sigma, ((env', ctx), (impl_env, imps), annot) let interp_fix_ccl ~program_mode sigma impls (env,_) fix = let flags = Pretyping.{ all_no_fail_flags with program_mode } in let sigma, (c, impl) = interp_type_evars_impls ~flags ~impls env sigma fix.Vernacexpr.rtype in let r = Retyping.relevance_of_type env sigma c in sigma, (c, r, impl) let interp_fix_body ~program_mode env_rec sigma impls (_,ctx) fix ccl = let open EConstr in Option.cata (fun body -> let env = push_rel_context ctx env_rec in let sigma, body = interp_casted_constr_evars ~program_mode env sigma ~impls body ccl in sigma, Some (it_mkLambda_or_LetIn body ctx)) (sigma, None) fix.Vernacexpr.body_def let build_fix_type (_,ctx) ccl = EConstr.it_mkProd_or_LetIn ccl ctx (* Jump over let-bindings. *) let compute_possible_guardness_evidences (ctx,_,recindex) = (* A recursive index is characterized by the number of lambdas to skip before finding the relevant inductive argument *) match recindex with | Some i -> [i] | None -> (* If recursive argument was not given by user, we try all args. An earlier approach was to look only for inductive arguments, but doing it properly involves delta-reduction, and it finally doesn't seem to worth the effort (except for huge mutual fixpoints ?) *) List.interval 0 (Context.Rel.nhyps ctx - 1) type ('constr, 'types, 'r) recursive_preentry = Id.t list * 'r list * 'constr option list * 'types list (* Wellfounded definition *) let fix_proto sigma = Evd.fresh_global (Global.env ()) sigma (Coqlib.lib_ref "program.tactic.fix_proto") let fix_proto_relevance = EConstr.ERelevance.relevant (* Would probably be overkill to use a specific fix_proto in SProp when in SProp?? *) let interp_recursive_evars env ~program_mode ~cofix (fixl : 'a Vernacexpr.fix_expr_gen list) = let open Context.Named.Declaration in let open EConstr in let fixnames = List.map (fun fix -> fix.Vernacexpr.fname.CAst.v) fixl in (* Interp arities allowing for unresolved types *) let sigma, decl = interp_mutual_univ_decl_opt env (List.map (fun Vernacexpr.{univs} -> univs) fixl) in let sigma, (fixctxs, fiximppairs, fixannots) = on_snd List.split3 @@ List.fold_left_map (fun sigma -> interp_fix_context ~program_mode env sigma ~cofix) sigma fixl in let fixctximpenvs, fixctximps = List.split fiximppairs in let sigma, (fixccls,fixrs,fixcclimps) = on_snd List.split3 @@ List.fold_left3_map (interp_fix_ccl ~program_mode) sigma fixctximpenvs fixctxs fixl in let fixtypes = List.map2 build_fix_type fixctxs fixccls in let fixtypes = List.map (fun c -> Evarutil.nf_evar sigma c) fixtypes in let fiximps = List.map3 (fun ctximps cclimps (_,ctx) -> ctximps@cclimps) fixctximps fixcclimps fixctxs in let sigma, rec_sign = List.fold_left3 (fun (sigma, env') id r t -> if program_mode then let sigma, sort = Typing.type_of ~refresh:true env sigma t in let sigma, fixprot = try let sigma, h_term = fix_proto sigma in let app = mkApp (h_term, [|sort; t|]) in Typing.solve_evars env sigma app with e when CErrors.noncritical e -> sigma, t in sigma, LocalAssum (Context.make_annot id fix_proto_relevance, fixprot) :: env' else sigma, LocalAssum (Context.make_annot id r, t) :: env') (sigma,[]) fixnames fixrs fixtypes in let env_rec = push_named_context rec_sign env in (* Get interpretation metadatas *) let impls = compute_internalization_env env sigma Recursive fixnames fixtypes fiximps in (* Interp bodies with rollback because temp use of notations/implicit *) let sigma, fixdefs = Metasyntax.with_syntax_protection (fun () -> let notations = List.map_append (fun { Vernacexpr.notations } -> List.map Metasyntax.prepare_where_notation notations) fixl in List.iter (Metasyntax.set_notation_for_interpretation env_rec impls) notations; List.fold_left4_map (fun sigma fixctximpenv -> interp_fix_body ~program_mode env_rec sigma (Id.Map.fold Id.Map.add fixctximpenv impls)) sigma fixctximpenvs fixctxs fixl fixccls) () in (* Instantiate evars and check all are resolved *) let sigma = Evarconv.solve_unif_constraints_with_heuristics env_rec sigma in let sigma = Evd.minimize_universes sigma in let fixctxs = List.map (fun (_,ctx) -> ctx) fixctxs in (* Build the fix declaration block *) (env,rec_sign,decl,sigma), (fixnames,fixrs,fixdefs,fixtypes), List.combine3 fixctxs fiximps fixannots let check_recursive ~isfix env evd (fixnames,_,fixdefs,_) = if List.for_all Option.has_some fixdefs then begin let fixdefs = List.map Option.get fixdefs in check_true_recursivity env evd ~isfix (List.combine fixnames fixdefs) end let ground_fixpoint env evd (fixnames,fixrs,fixdefs,fixtypes) = Pretyping.check_evars_are_solved ~program_mode:false env evd; let fixrs = List.map (fun r -> EConstr.ERelevance.kind evd r) fixrs in let fixdefs = List.map (fun c -> Option.map EConstr.(to_constr evd) c) fixdefs in let fixtypes = List.map EConstr.(to_constr evd) fixtypes in Evd.evar_universe_context evd, (fixnames,fixrs,fixdefs,fixtypes) (* XXX: Unify with interp_recursive *) let interp_recursive ?(check_recursivity=true) ?typing_flags ~cofix l : ( (Constr.t, Constr.types, Sorts.relevance) recursive_preentry * UState.universe_decl * UState.t * (EConstr.rel_context * Impargs.manual_implicits * int option) list) = let env = Global.env () in let env = Environ.update_typing_flags ?typing_flags env in let (env,_,pl,evd),fix,info = interp_recursive_evars env ~program_mode:false ~cofix l in if check_recursivity then check_recursive ~isfix:(not cofix) env evd fix; let evd = Pretyping.(solve_remaining_evars all_no_fail_flags env evd) in let uctx,fix = ground_fixpoint env evd fix in (fix,pl,uctx,info) let build_recthms ~indexes fixnames fixtypes fiximps = let fix_kind, possible_guard = match indexes with | Some possible_fix_indices -> Decls.Fixpoint, Pretyping.{possibly_cofix = false; possible_fix_indices} | None -> Decls.CoFixpoint, Pretyping.{possibly_cofix = true; possible_fix_indices = List.map (fun _ -> []) fixtypes} in let thms = List.map3 (fun name typ (ctx,impargs,_) -> let args = List.map Context.Rel.Declaration.get_name ctx in Declare.CInfo.make ~name ~typ ~args ~impargs () ) fixnames fixtypes fiximps in fix_kind, possible_guard, thms let declare_recursive ?indexes ?scope ?clearbody ~poly ?typing_flags ?user_warns ?using ((fixnames,fixrs,fixdefs,fixtypes),udecl,uctx,fiximps) ntns = let fix_kind, possible_guard, cinfo = build_recthms ~indexes fixnames fixtypes fiximps in let kind = Decls.IsDefinition fix_kind in let info = Declare.Info.make ?scope ?clearbody ~kind ~poly ~udecl ?typing_flags ?user_warns ~ntns () in match Option.List.map (fun x -> x) fixdefs with | Some fixdefs -> (* All bodies are defined *) let _ : GlobRef.t list = Declare.declare_mutual_definitions ~cinfo ~info ~opaque:false ~uctx ~possible_guard ~bodies:(fixdefs,fixrs) ?using () in None | None -> (* At least one undefined body *) let evd = Evd.from_ctx uctx in let lemma = Declare.Proof.start_mutual_definitions ~info ~cinfo ~bodies:fixdefs ~possible_guard ?using evd in Some lemma let extract_decreasing_argument ~structonly { CAst.v = v; _ } = let open Constrexpr in match v with | CStructRec na -> na | (CWfRec (na,_) | CMeasureRec (Some na,_,_)) when not structonly -> na | CMeasureRec (None,_,_) when not structonly -> CErrors.user_err Pp.(str "Decreasing argument must be specified in measure clause.") | _ -> CErrors.user_err Pp.(str "Well-founded induction requires Program Fixpoint or Function.") (* This is a special case: if there's only one binder, we pick it as the recursive argument if none is provided. *) let adjust_rec_order ~structonly binders rec_order = let rec_order = Option.map (fun rec_order -> let open Constrexpr in match binders, rec_order with | [CLocalAssum([{ CAst.v = Name x }],_,_,_)], { CAst.v = CMeasureRec(None, mes, rel); CAst.loc } -> CAst.make ?loc @@ CMeasureRec(Some (CAst.make x), mes, rel) | [CLocalDef({ CAst.v = Name x },_,_,_)], { CAst.v = CMeasureRec(None, mes, rel); CAst.loc } -> CAst.make ?loc @@ CMeasureRec(Some (CAst.make x), mes, rel) | _, x -> x) rec_order in Option.map (extract_decreasing_argument ~structonly) rec_order let do_fixpoint ?scope ?clearbody ~poly ?typing_flags ?user_warns ?using (fixl : Vernacexpr.fixpoint_expr list) : Declare.Proof.t option = let fixl = List.map (fun fix -> Vernacexpr.{ fix with rec_order = adjust_rec_order ~structonly:true fix.binders fix.rec_order }) fixl in let ntns = List.map_append (fun { Vernacexpr.notations } -> List.map Metasyntax.prepare_where_notation notations ) fixl in let (_, _, _, info as fix) = interp_recursive ~cofix:false ?typing_flags fixl in let possible_indexes = List.map compute_possible_guardness_evidences info in declare_recursive ~indexes:possible_indexes ?scope ?clearbody ~poly ?typing_flags ?user_warns ?using fix ntns let do_cofixpoint ?scope ?clearbody ~poly ?typing_flags ?user_warns ?using (fixl : Vernacexpr.cofixpoint_expr list) = let fixl = List.map (fun fix -> {fix with Vernacexpr.rec_order = None}) fixl in let ntns = List.map_append (fun { Vernacexpr.notations } -> List.map Metasyntax.prepare_where_notation notations ) fixl in let cofix, ntns = interp_recursive ~cofix:true fixl, ntns in declare_recursive ?scope ?clearbody ~poly ?typing_flags ?user_warns ?using cofix ntns coq-8.20.0/vernac/comFixpoint.mli000066400000000000000000000056161466560755400166750ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* ?clearbody:bool -> poly:bool -> ?typing_flags:Declarations.typing_flags -> ?user_warns:UserWarn.t -> ?using:Vernacexpr.section_subset_expr -> fixpoint_expr list -> Declare.Proof.t option val do_cofixpoint : ?scope:Locality.definition_scope -> ?clearbody:bool -> poly:bool -> ?typing_flags:Declarations.typing_flags -> ?user_warns:UserWarn.t -> ?using:Vernacexpr.section_subset_expr -> cofixpoint_expr list -> Declare.Proof.t option (************************************************************************) (** Internal API *) (************************************************************************) (** Typing global fixpoints and cofixpoint_expr *) val adjust_rec_order : structonly:bool -> Constrexpr.local_binder_expr list -> Constrexpr.recursion_order_expr option -> lident option (** names / relevance / defs / types *) type ('constr, 'types, 'r) recursive_preentry = Id.t list * 'r list * 'constr option list * 'types list (** Exported for Program *) val interp_recursive_evars : Environ.env -> (* Misc arguments *) program_mode:bool -> cofix:bool -> (* Notations of the fixpoint / should that be folded in the previous argument? *) lident option fix_expr_gen list -> (* env / signature / univs / evar_map *) (Environ.env * EConstr.named_context * UState.universe_decl * Evd.evar_map) * (* names / defs / types *) (EConstr.t, EConstr.types, EConstr.ERelevance.t) recursive_preentry * (* ctx per mutual def / implicits / struct annotations *) (EConstr.rel_context * Impargs.manual_implicits * int option) list (** Exported for Funind *) val interp_recursive : ?check_recursivity:bool -> ?typing_flags:Declarations.typing_flags -> cofix:bool -> lident option fix_expr_gen list -> (Constr.t, Constr.types, Sorts.relevance) recursive_preentry * UState.universe_decl * UState.t * (EConstr.rel_context * Impargs.manual_implicits * int option) list (** Very private function, do not use *) val compute_possible_guardness_evidences : ('a, 'b, 'r) Context.Rel.pt * 'c * int option -> int list coq-8.20.0/vernac/comHints.ml000066400000000000000000000142461466560755400160100ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* (a, b) | _ -> assert false in let p = if l2r then lib_ref "core.iff.proj1" else lib_ref "core.iff.proj2" in let sigma, p = Evd.fresh_global env sigma p in let c = Reductionops.whd_beta env sigma (mkApp (c, Context.Rel.instance mkRel 0 sign)) in let c = it_mkLambda_or_LetIn (mkApp ( p , [| mkArrow a ERelevance.relevant (Vars.lift 1 b) ; mkArrow b ERelevance.relevant (Vars.lift 1 a) ; c |] )) sign in let name = Nameops.add_suffix (Nametab.basename_of_global gr) ("_proj_" ^ if l2r then "l2r" else "r2l") in let ctx = Evd.univ_entry ~poly sigma in let c = EConstr.to_constr sigma c in let cb = Declare.(DefinitionEntry (definition_entry ~univs:ctx ~opaque:false c)) in let c = Declare.declare_constant ~local:Locality.ImportDefaultBehavior ~name ~kind:Decls.(IsDefinition Definition) cb in let info = {Typeclasses.hint_priority = pri; hint_pattern = None} in (info, true, Hints.hint_globref (GlobRef.ConstRef c)) let warning_deprecated_hint_constr = CWarnings.create_warning ~from:[CWarnings.CoreCategories.automation; Deprecation.Version.v8_20] ~name:"fragile-hint-constr" ~default:AsError () let warn_deprecated_hint_constr = CWarnings.create_in warning_deprecated_hint_constr (fun () -> Pp.strbrk "Declaring arbitrary terms as hints is fragile and deprecated; it is \ recommended to declare a toplevel constant instead") (* Only error when we have to (axioms may be instantiated if from functors) XXX maybe error if not from a functor argument? *) let soft_evaluable = Tacred.soft_evaluable_of_global_reference (* Slightly more lenient global hint syntax for backwards compatibility *) let rectify_hint_constr h = match h with | Vernacexpr.HintsReference _ -> h | Vernacexpr.HintsConstr c -> let open Constrexpr in match c.CAst.v with | CAppExpl ((qid, None), []) -> Vernacexpr.HintsReference qid | _ -> Vernacexpr.HintsConstr c let interp_hints ~poly h = let env = Global.env () in let sigma = Evd.from_env env in let fref r = let gr = Smartlocate.global_with_alias r in Dumpglob.add_glob ?loc:r.CAst.loc gr; gr in let fr r = soft_evaluable ?loc:r.CAst.loc (fref r) in let fi c = let open Hints in let open Vernacexpr in match rectify_hint_constr c with | HintsReference c -> let gr = Smartlocate.global_with_alias c in (hint_globref gr) | HintsConstr c -> let () = warn_deprecated_hint_constr () in let env = Global.env () in let sigma = Evd.from_env env in let c, uctx = Constrintern.interp_constr env sigma c in let uctx = UState.normalize_variables uctx in let c = Evarutil.nf_evar (Evd.from_ctx uctx) c in let c = if poly then (c, Some (UState.sort_context_set uctx)) else let () = Global.push_context_set ~strict:true (UState.context_set uctx) in (c, None) in (Hints.hint_constr c) [@ocaml.warning "-3"] in let fp = Constrintern.intern_constr_pattern env sigma in let fres (info, b, r) = let gr = fi r in let info = { info with Typeclasses.hint_pattern = Option.map fp info.Typeclasses.hint_pattern } in (info, b, gr) in let open Hints in let open Vernacexpr in let ft = function | HintsVariables -> HintsVariables | HintsConstants -> HintsConstants | HintsProjections -> HintsProjections | HintsReferences lhints -> HintsReferences (List.map fr lhints) in let fp = Constrintern.intern_constr_pattern (Global.env ()) in match h with | HintsResolve lhints -> HintsResolveEntry (List.map fres lhints) | HintsResolveIFF (l2r, lc, n) -> HintsResolveEntry (List.map (project_hint ~poly n l2r) lc) | HintsImmediate lhints -> HintsImmediateEntry (List.map fi lhints) | HintsUnfold lhints -> HintsUnfoldEntry (List.map fr lhints) | HintsTransparency (t, b) -> HintsTransparencyEntry (ft t, b) | HintsMode (r, l) -> HintsModeEntry (fref r, l) | HintsConstructors lqid -> let constr_hints_of_ind qid = let ind = Smartlocate.global_inductive_with_alias qid in Dumpglob.dump_reference ?loc:qid.CAst.loc "<>" (Libnames.string_of_qualid qid) "ind"; List.init (Inductiveops.nconstructors env ind) (fun i -> let c = (ind, i + 1) in let gr = GlobRef.ConstructRef c in ( empty_hint_info , true , hint_globref gr )) in HintsResolveEntry (List.flatten (List.map constr_hints_of_ind lqid)) | HintsExtern (pri, patcom, tacexp) -> let pat = Option.map (fp sigma) patcom in let ltacvars = match pat with None -> Id.Set.empty | Some (l, _) -> l in let env = Genintern.{(empty_glob_sign ~strict:true env) with ltacvars} in let _, tacexp = Genintern.generic_intern env tacexp in HintsExternEntry ({Typeclasses.hint_priority = Some pri; hint_pattern = pat}, tacexp) coq-8.20.0/vernac/comHints.mli000066400000000000000000000013571466560755400161600ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* Vernacexpr.hints_expr -> Hints.hints_entry coq-8.20.0/vernac/comInductive.ml000066400000000000000000001106121466560755400166470ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* Pp.(strbrk "Automatically declaring " ++ Id.print id ++ strbrk " as template polymorphic. Use attributes or " ++ strbrk "disable Auto Template Polymorphism to avoid this warning.")) let should_auto_template = let open Goptions in let auto = ref true in let () = declare_bool_option { optstage = Summary.Stage.Interp; optdepr = None; optkey = ["Auto";"Template";"Polymorphism"]; optread = (fun () -> !auto); optwrite = (fun b -> auto := b); } in fun id would_auto -> let b = !auto && would_auto in if b then warn_auto_template id; b let push_types env idl rl tl = List.fold_left3 (fun env id r t -> EConstr.push_rel (LocalAssum (make_annot (Name id) r,t)) env) env idl rl tl type structured_one_inductive_expr = { ind_name : Id.t; ind_arity_explicit : bool; ind_arity : constr_expr; ind_lc : (Id.t * constr_expr) list } exception Same of Id.t let check_all_names_different indl = let rec elements = function | [] -> Id.Set.empty | id :: l -> let s = elements l in if Id.Set.mem id s then raise (Same id) else Id.Set.add id s in let ind_names = List.map (fun ind -> ind.ind_name) indl in let cstr_names = List.map_append (fun ind -> List.map fst ind.ind_lc) indl in let ind_names = match elements ind_names with | s -> s | exception (Same t) -> raise (InductiveError (SameNamesTypes t)) in let cstr_names = match elements cstr_names with | s -> s | exception (Same c) -> raise (InductiveError (SameNamesConstructors c)) in let l = Id.Set.inter ind_names cstr_names in if not (Id.Set.is_empty l) then raise (InductiveError (SameNamesOverlap (Id.Set.elements l))) (** Make the arity conclusion flexible to avoid generating an upper bound universe now, only if the universe does not appear anywhere else. This is really a hack to stay compatible with the semantics of template polymorphic inductives which are recognized when a "Type" appears at the end of the conlusion in the source syntax. *) let rec check_type_conclusion ind = let open Glob_term in match DAst.get ind with | GSort s -> (* not sure what this check is expected to be exactly *) begin match s with | (None, UAnonymous {rigid=UnivRigid}) -> (* should have been made flexible *) assert false | (None, UAnonymous {rigid=UnivFlexible _}) -> false | _ -> true end | GProd (_, _, _, _, e) | GLetIn (_, _, _, _, e) -> check_type_conclusion e | _ -> false let rec make_anonymous_conclusion_flexible ind = let open Glob_term in match DAst.get ind with | GSort (None, UAnonymous {rigid=UnivRigid}) -> Some (DAst.make ?loc:ind.loc (GSort (None, UAnonymous {rigid=UnivFlexible true}))) | GSort _ -> None | GProd (a, b, c, d, e) -> begin match make_anonymous_conclusion_flexible e with | None -> None | Some e -> Some (DAst.make ?loc:ind.loc (GProd (a, b, c, d, e))) end | GLetIn (a, b, c, d, e) -> begin match make_anonymous_conclusion_flexible e with | None -> None | Some e -> Some (DAst.make ?loc:ind.loc (GLetIn (a, b, c, d, e))) end | _ -> None type syntax_allows_template_poly = SyntaxAllowsTemplatePoly | SyntaxNoTemplatePoly let intern_ind_arity env sigma ind = let c = intern_gen IsType env sigma ind.ind_arity in let impls = Implicit_quantifiers.implicits_of_glob_constr ~with_products:true c in let pseudo_poly, c = match make_anonymous_conclusion_flexible c with | None -> check_type_conclusion c, c | Some c -> true, c in let template_syntax = if pseudo_poly then SyntaxAllowsTemplatePoly else SyntaxNoTemplatePoly in (constr_loc ind.ind_arity, c, impls, template_syntax) let pretype_ind_arity ~unconstrained_sorts env sigma (loc, c, impls, template_syntax) = let flags = { Pretyping.all_no_fail_flags with unconstrained_sorts } in let sigma,t = understand_tcc ~flags env sigma ~expected_type:IsType c in match Reductionops.sort_of_arity env sigma t with | exception Reduction.NotArity -> user_err ?loc (str "Not an arity") | s -> sigma, (t, Retyping.relevance_of_sort s, template_syntax, impls) (* ind_rel is the Rel for this inductive in the context without params. n is how many arguments there are in the constructor. *) let model_conclusion env sigma ind_rel params n arity_indices = let model_head = EConstr.mkRel (n + Context.Rel.length params + ind_rel) in let model_params = Context.Rel.instance EConstr.mkRel n params in let sigma,model_indices = List.fold_right (fun (_,t) (sigma, subst) -> let t = EConstr.Vars.substl subst (EConstr.Vars.liftn n (List.length subst + 1) t) in let sigma, c = Evarutil.new_evar env sigma t in sigma, c::subst) arity_indices (sigma, []) in sigma, mkApp (mkApp (model_head, model_params), Array.of_list (List.rev model_indices)) let interp_cstrs env (sigma, ind_rel) impls params ind arity = let cnames,ctyps = List.split ind.ind_lc in let arity_indices, cstr_sort = Reductionops.splay_arity env sigma arity in (* Interpret the constructor types *) let interp_cstr sigma ctyp = let flags = Pretyping.{ all_no_fail_flags with use_typeclasses = UseTCForConv; solve_unification_constraints = false } in let sigma, (ctyp, cimpl) = interp_type_evars_impls ~flags env sigma ~impls ctyp in let ctx, concl = Reductionops.whd_decompose_prod_decls env sigma ctyp in let concl_env = EConstr.push_rel_context ctx env in let sigma_with_model_evars, model = model_conclusion concl_env sigma ind_rel params (Context.Rel.length ctx) arity_indices in (* unify the expected with the provided conclusion *) let sigma = try Evarconv.unify concl_env sigma_with_model_evars Conversion.CONV concl model with Evarconv.UnableToUnify (sigma,e) -> user_err (Himsg.explain_pretype_error concl_env sigma (Pretype_errors.CannotUnify (concl, model, (Some e)))) in sigma, (ctyp, cimpl) in let sigma, (ctyps, cimpls) = on_snd List.split @@ List.fold_left_map interp_cstr sigma ctyps in (sigma, pred ind_rel), (cnames, ctyps, cimpls) (***** Generate constraints from constructor arguments *****) let compute_constructor_levels env evd sign = fst (List.fold_right (fun d (lev,env) -> match d with | LocalDef _ -> lev, EConstr.push_rel d env | LocalAssum _ -> let s = Retyping.get_sort_of env evd (RelDecl.get_type d) in (s :: lev, EConstr.push_rel d env)) sign ([],env)) let do_auto_prop_lowering = ref true let () = Goptions.declare_bool_option { optstage = Interp; optdepr = None; optkey = ["Automatic";"Proposition";"Inductives"]; optread = (fun () -> !do_auto_prop_lowering); optwrite = (fun b -> do_auto_prop_lowering := b); } let warn_auto_prop_lowering = CWarnings.create ~name:"automatic-prop-lowering" ~category:Deprecation.Version.v8_20 Pp.(fun na -> strbrk "Automatically putting " ++ Id.print na ++ strbrk " in Prop" ++ spc() ++ strbrk "even though it was declared with Type." ++ fnl() ++ strbrk "Unset Automatic Proposition Inductives to prevent this" ++ spc() ++ strbrk "(it will become the default in a future version)." ++ fnl() ++ strbrk "If you instead put " ++ Id.print na ++ strbrk " explicitly in Prop," ++ spc() ++ strbrk "set Dependent Proposition Eliminators around the declaration for full backwards compatibility.") let is_flexible_sort evd s = match ESorts.kind evd s with | Set | Prop | SProp -> false | Type u | QSort (_, u) -> match Univ.Universe.level u with | Some l -> Evd.is_flexible_level evd l | None -> false let prop_lowering_candidates evd ~arities_explicit inds = let less_than_2 = function [] | [_] -> true | _ :: _ :: _ -> false in (* handle automatic lowering to Prop We repeatedly add information about which inductives should not be Prop until no more progress can be made *) let is_prop_candidate_arity (raw_arity,(_,s),indices,ctors) = less_than_2 ctors && EConstr.isArity evd raw_arity && is_flexible_sort evd s && not (Evd.check_leq evd ESorts.set s) in let candidates = List.filter_map (fun (explicit,(_,(_,s),_,_ as ind)) -> if (!do_auto_prop_lowering || not explicit) && is_prop_candidate_arity ind then Some s else None) (List.combine arities_explicit inds) in let in_candidates s candidates = List.mem_f (ESorts.equal evd) s candidates in let is_prop_candidate_size candidates (_,_,indices,ctors) = List.for_all (List.for_all (fun s -> match ESorts.kind evd s with | SProp | Prop -> true | Set -> false | Type _ | QSort _ -> not (Evd.check_leq evd ESorts.set s) && in_candidates s candidates)) (Option.List.cons indices ctors) in let rec spread_nonprop candidates = let (changed, candidates) = List.fold_left (fun (changed, candidates as acc) (raw_arity,(_,s),indices,ctors as ind) -> if is_prop_candidate_size candidates ind then acc (* still a Prop candidate *) else if in_candidates s candidates then (true, List.remove (ESorts.equal evd) s candidates) else acc) (false,candidates) inds in if changed then spread_nonprop candidates else candidates in let candidates = spread_nonprop candidates in candidates let include_constructor_argument env evd ~poly ~ctor_sort ~inductive_sort = if poly then (* We ignore the quality when comparing the sorts: it has an impact on squashing in the kernel but cannot cause a universe error. *) let univ_of_sort s = match ESorts.kind evd s with | SProp | Prop -> None | Set -> Some Univ.Universe.type0 | Type u | QSort (_,u) -> Some u in match univ_of_sort ctor_sort, univ_of_sort inductive_sort with | _, None -> (* This function is only called when [s] is not impredicative *) assert false | None, Some _ -> evd | Some uctor, Some uind -> let mk u = ESorts.make (Sorts.sort_of_univ u) in Evd.set_leq_sort env evd (mk uctor) (mk uind) else match ESorts.kind evd ctor_sort with | SProp | Prop -> evd | Set | Type _ | QSort _ -> Evd.set_leq_sort env evd ctor_sort inductive_sort type default_dep_elim = DeclareInd.default_dep_elim = DefaultElim | PropButDepElim let inductive_levels env evd ~poly ~indnames ~arities_explicit arities ctors = let inds = List.map2 (fun x ctors -> let ctx, s = Reductionops.dest_arity env evd x in x, (ctx, s), List.map (compute_constructor_levels env evd) ctors) arities ctors in (* Inductives explicitly put in an impredicative sort can be squashed, so there are no constraints to get from them. *) let is_impredicative_sort evd s = is_impredicative_sort env (ESorts.kind evd s) in (* Inductives with >= 2 constructors are >= Set *) let less_than_2 = function [] | [_] -> true | _ :: _ :: _ -> false in let evd = List.fold_left (fun evd (raw_arity,(_,s),ctors) -> if less_than_2 ctors || is_impredicative_sort evd s then evd else (* >=2 constructors is like having a bool argument *) include_constructor_argument env evd ~poly ~ctor_sort:ESorts.set ~inductive_sort:s) evd inds in (* If indices_matter, the index telescope acts like an extra constructor except for constructor count checks. *) let inds = List.map (fun (raw_arity,(ctx,_ as arity),ctors) -> let indices = if indices_matter env then Some (compute_constructor_levels env evd ctx) else None in (raw_arity,arity,indices,ctors)) inds in let candidates = prop_lowering_candidates evd ~arities_explicit inds in (* Do the lowering. We forget about the generated universe for the lowered inductive and rely on universe restriction to get rid of it. NB: it would probably be less hacky to use the sort polymorphism system ie lowering to Prop by setting a qvar equal to prop. However this means we wouldn't lower "Inductive foo : Type := ." as "Type" doesn't produce a qvar. Perhaps someday we can stop lowering these explicit ": Type". *) let inds = List.map3 (fun na explicit (raw_arity,(ctx,s),indices,ctors) -> if List.mem_f (ESorts.equal evd) s candidates then (* NB: is_prop_candidate requires is_flexible_sort so in this branch we know s <> Prop *) let () = if explicit then warn_auto_prop_lowering na in ((PropButDepElim, mkArity (ctx, ESorts.prop)),ESorts.prop,indices,ctors) else ((DefaultElim, raw_arity), s, indices, ctors)) indnames arities_explicit inds in (* Add constraints from constructor arguments and indices. We must do this after Prop lowering as otherwise we risk unifying sorts eg on "Box (A:Type)" we risk unifying the parameter sort and the output sort then ESorts.equal would make us believe that the constructor argument is a lowering candidate. *) let evd = List.fold_left (fun evd (_,s,indices,ctors) -> if is_impredicative_sort evd s then evd else List.fold_left (List.fold_left (fun evd ctor_sort -> include_constructor_argument env evd ~poly ~ctor_sort ~inductive_sort:s)) evd (Option.List.cons indices ctors)) evd inds in let arities = List.map (fun (arity,_,_,_) -> arity) inds in evd, List.split arities (** Template poly ***) let check_named {CAst.loc;v=na} = match na with | Name _ -> () | Anonymous -> let msg = str "Parameters must be named." in user_err ?loc msg (* Returns the list [x_1, ..., x_n] of levels contributing to template polymorphism. The elements x_k is None if the k-th parameter (starting from the most recent and ignoring let-definitions) is not contributing to the inductive type's sort or is Some u_k if its level is u_k and is contributing. *) let template_polymorphic_univs ~ctor_levels uctx paramsctxt u = let unbounded_from_below u cstrs = let open Univ in Univ.Constraints.for_all (fun (l, d, r) -> match d with | Eq -> not (Univ.Level.equal l u) && not (Univ.Level.equal r u) | Lt | Le -> not (Univ.Level.equal r u)) cstrs in let fold_params accu decl = match decl with | LocalAssum (_, p) -> let c = Term.strip_prod_decls p in begin match Constr.kind c with | Constr.Sort (Type u) -> begin match Univ.Universe.level u with | Some l -> Univ.Level.Set.add l accu | None -> accu end | _ -> accu end | LocalDef _ -> accu in let paramslevels = List.fold_left fold_params Univ.Level.Set.empty paramsctxt in let check_level l = Univ.Level.Set.mem l (Univ.ContextSet.levels uctx) && Univ.Level.Set.mem l paramslevels && (let () = assert (not @@ Univ.Level.is_set l) in true) && unbounded_from_below l (Univ.ContextSet.constraints uctx) && not (Univ.Level.Set.mem l ctor_levels) in let univs = Univ.Universe.levels u in let univs = Univ.Level.Set.filter (fun l -> check_level l) univs in univs let template_polymorphism_candidate uctx params entry template_syntax = match template_syntax with | SyntaxNoTemplatePoly -> Univ.Level.Set.empty | SyntaxAllowsTemplatePoly -> let _, concl = Term.destArity entry.mind_entry_arity in match concl with | Set | SProp | Prop -> Univ.Level.Set.empty | Type u -> let ctor_levels = let add_levels c levels = Univ.Level.Set.union levels (CVars.universes_of_constr c) in let param_levels = List.fold_left (fun levels d -> match d with | LocalAssum _ -> levels | LocalDef (_,b,t) -> add_levels b (add_levels t levels)) Univ.Level.Set.empty params in List.fold_left (fun levels c -> add_levels c levels) param_levels entry.mind_entry_lc in let univs = template_polymorphic_univs ~ctor_levels uctx params u in univs | QSort _ -> assert false let split_universe_context subset (univs, csts) = let subfilter (l, _, r) = let () = assert (not @@ Univ.Level.Set.mem r subset) in Univ.Level.Set.mem l subset in let subcst = Univ.Constraints.filter subfilter csts in let rem = Univ.Level.Set.diff univs subset in let remfilter (l, _, r) = not (Univ.Level.Set.mem l subset) && not (Univ.Level.Set.mem r subset) in let remcst = Univ.Constraints.filter remfilter csts in (subset, subcst), (rem, remcst) let warn_no_template_universe = CWarnings.create ~name:"no-template-universe" (fun () -> Pp.str "This inductive type has no template universes.") let compute_template_inductive ~user_template ~ctx_params ~univ_entry entry template_syntax = match user_template, univ_entry with | Some false, UState.Monomorphic_entry uctx -> Monomorphic_ind_entry, uctx | Some false, UState.Polymorphic_entry uctx -> Polymorphic_ind_entry uctx, Univ.ContextSet.empty | Some true, UState.Monomorphic_entry uctx -> let template_universes = template_polymorphism_candidate uctx ctx_params entry template_syntax in let template, global = split_universe_context template_universes uctx in let () = if Univ.Level.Set.is_empty (fst template) then warn_no_template_universe () in Template_ind_entry template, global | Some true, UState.Polymorphic_entry _ -> user_err Pp.(strbrk "Template-polymorphism and universe polymorphism are not compatible.") | None, UState.Polymorphic_entry uctx -> Polymorphic_ind_entry uctx, Univ.ContextSet.empty | None, UState.Monomorphic_entry uctx -> let template_candidate = template_polymorphism_candidate uctx ctx_params entry template_syntax in let has_template = not @@ Univ.Level.Set.is_empty template_candidate in let template = should_auto_template entry.mind_entry_typename has_template in if template then let template, global = split_universe_context template_candidate uctx in Template_ind_entry template, global else Monomorphic_ind_entry, uctx let check_param = function | CLocalDef (na, _, _, _) -> check_named na | CLocalAssum (nas, _, Default _, _) -> List.iter check_named nas | CLocalAssum (nas, _, Generalized _, _) -> () | CLocalPattern {CAst.loc} -> Loc.raise ?loc (Gramlib.Grammar.Error "pattern with quote not allowed here") let restrict_inductive_universes ~lbound sigma ctx_params arities constructors = let merge_universes_of_constr c = Univ.Level.Set.union (snd (EConstr.universes_of_constr sigma (EConstr.of_constr c))) in let uvars = Univ.Level.Set.empty in let uvars = Context.Rel.(fold_outside (Declaration.fold_constr merge_universes_of_constr) ctx_params ~init:uvars) in let uvars = List.fold_right merge_universes_of_constr arities uvars in let uvars = List.fold_right (fun (_,ctypes) -> List.fold_right merge_universes_of_constr ctypes) constructors uvars in Evd.restrict_universe_context ~lbound sigma uvars let check_trivial_variances variances = Array.iter (function | None | Some UVars.Variance.Invariant -> () | Some _ -> CErrors.user_err Pp.(strbrk "Universe variance was specified but this inductive will not be cumulative.")) variances let variance_of_entry ~cumulative ~variances uctx = match uctx with | Monomorphic_ind_entry | Template_ind_entry _ -> check_trivial_variances variances; None | Polymorphic_ind_entry uctx -> if not cumulative then begin check_trivial_variances variances; None end else let lvs = Array.length variances in let _, lus = UVars.UContext.size uctx in assert (lvs <= lus); Some (Array.append variances (Array.make (lus - lvs) None)) let interp_mutual_inductive_constr ~sigma ~template ~udecl ~variances ~ctx_params ~indnames ~arities_explicit ~arities ~template_syntax ~constructors ~env_ar_params ~cumulative ~poly ~private_ind ~finite = (* Compute renewed arities *) let ctor_args = List.map (fun (_,tys) -> List.map (fun ty -> let ctx = fst (Reductionops.whd_decompose_prod_decls env_ar_params sigma ty) in ctx) tys) constructors in let sigma, (default_dep_elim, arities) = inductive_levels env_ar_params sigma ~poly ~indnames ~arities_explicit arities ctor_args in let lbound = if poly then UGraph.Bound.Set else UGraph.Bound.Prop in let sigma = Evd.minimize_universes ~lbound sigma in let arities = List.map EConstr.(to_constr sigma) arities in let constructors = List.map (on_snd (List.map (EConstr.to_constr sigma))) constructors in let ctx_params = List.map (fun d -> EConstr.to_rel_decl sigma d) ctx_params in let sigma = restrict_inductive_universes ~lbound sigma ctx_params arities constructors in let univ_entry, binders = Evd.check_univ_decl ~poly sigma udecl in (* Build the inductive entries *) let entries = List.map3 (fun indname arity (cnames,ctypes) -> { mind_entry_typename = indname; mind_entry_arity = arity; mind_entry_consnames = cnames; mind_entry_lc = ctypes }) indnames arities constructors in let univ_entry, ctx = match entries, template_syntax with | [entry], [template_syntax] -> compute_template_inductive ~user_template:template ~ctx_params ~univ_entry entry template_syntax | _ -> let () = match template with | Some true -> user_err Pp.(str "Template-polymorphism not allowed with mutual inductives.") | _ -> () in match univ_entry with | UState.Monomorphic_entry ctx -> Monomorphic_ind_entry, ctx | UState.Polymorphic_entry uctx -> Polymorphic_ind_entry uctx, Univ.ContextSet.empty in let variance = variance_of_entry ~cumulative ~variances univ_entry in (* Build the mutual inductive entry *) let mind_ent = { mind_entry_params = ctx_params; mind_entry_record = None; mind_entry_finite = finite; mind_entry_inds = entries; mind_entry_private = if private_ind then Some false else None; mind_entry_universes = univ_entry; mind_entry_variance = variance; } in default_dep_elim, mind_ent, binders, ctx let interp_params ~unconstrained_sorts env udecl uparamsl paramsl = let sigma, udecl, variances = interp_cumul_univ_decl_opt env udecl in let sigma, (uimpls, ((env_uparams, ctx_uparams), useruimpls)) = interp_context_evars ~program_mode:false ~unconstrained_sorts env sigma uparamsl in let sigma, (impls, ((env_params, ctx_params), userimpls)) = interp_context_evars ~program_mode:false ~unconstrained_sorts ~impl_env:uimpls env_uparams sigma paramsl in (* Names of parameters as arguments of the inductive type (defs removed) *) sigma, env_params, (ctx_params, env_uparams, ctx_uparams, userimpls, useruimpls, impls, udecl, variances) (* When a hole remains for a param, pretend the param is uniform and do the unification. [env_ar_par] is [uparams; inds; params] *) let maybe_unify_params_in env_ar_par sigma ~ninds ~nparams ~binders:k c = let is_ind sigma k c = match EConstr.kind sigma c with | Constr.Rel n -> (* env is [uparams; inds; params; k other things] *) n > k + nparams && n <= k + nparams + ninds | _ -> false in let rec aux (env,k as envk) sigma c = match EConstr.kind sigma c with | Constr.App (h,args) when is_ind sigma k h -> Array.fold_left_i (fun i sigma arg -> if i >= nparams || not (EConstr.isEvar sigma arg) then sigma else begin try Evarconv.unify_delay env sigma arg (EConstr.mkRel (k+nparams-i)) with Evarconv.UnableToUnify _ -> (* ignore errors, we will get a "Cannot infer ..." error instead *) sigma end) sigma args | _ -> Termops.fold_constr_with_full_binders env sigma (fun d (env,k) -> EConstr.push_rel d env, k+1) aux envk sigma c in aux (env_ar_par,k) sigma c let interp_mutual_inductive_gen env0 ~template udecl (uparamsl,paramsl,indl) notations ~cumulative ~poly ~private_ind finite = check_all_names_different indl; List.iter check_param paramsl; if not (List.is_empty uparamsl) && not (List.is_empty notations) then user_err (str "Inductives with uniform parameters may not have attached notations."); let indnames = List.map (fun ind -> ind.ind_name) indl in let ninds = List.length indl in (* In case of template polymorphism, we need to compute more constraints *) let unconstrained_sorts = not poly in let sigma, env_params, (ctx_params, env_uparams, ctx_uparams, userimpls, useruimpls, impls, udecl, variances) = interp_params ~unconstrained_sorts env0 udecl uparamsl paramsl in (* Interpret the arities *) let arities = List.map (intern_ind_arity env_params sigma) indl in let sigma, arities = List.fold_left_map (pretype_ind_arity ~unconstrained_sorts env_params) sigma arities in let arities, relevances, template_syntax, indimpls = List.split4 arities in let lift_ctx n ctx = let t = EConstr.it_mkProd_or_LetIn EConstr.mkProp ctx in let t = EConstr.Vars.lift n t in let ctx, _ = EConstr.decompose_prod_decls sigma t in ctx in let ctx_params_lifted, fullarities = lift_ctx ninds ctx_params, CList.map_i (fun i c -> EConstr.Vars.lift i (EConstr.it_mkProd_or_LetIn c ctx_params)) 0 arities in let env_ar = push_types env_uparams indnames relevances fullarities in let env_ar_params = EConstr.push_rel_context ctx_params_lifted env_ar in (* Compute interpretation metadatas *) let indimpls = List.map (fun impls -> userimpls @ impls) indimpls in let impls = compute_internalization_env env_uparams sigma ~impls Inductive indnames fullarities indimpls in let ntn_impls = compute_internalization_env env_uparams sigma Inductive indnames fullarities indimpls in let (sigma, _), constructors = Metasyntax.with_syntax_protection (fun () -> (* Temporary declaration of notations and scopes *) List.iter (Metasyntax.set_notation_for_interpretation env_params ntn_impls) notations; (* Interpret the constructor types *) List.fold_left2_map (fun (sigma, ind_rel) ind arity -> interp_cstrs env_ar_params (sigma, ind_rel) impls ctx_params_lifted ind (EConstr.Vars.liftn ninds (Rel.length ctx_params + 1) arity)) (sigma, ninds) indl arities) () in let nparams = Context.Rel.length ctx_params in let sigma = List.fold_left (fun sigma (_,ctyps,_) -> List.fold_left (fun sigma ctyp -> maybe_unify_params_in env_ar_params sigma ~ninds ~nparams ~binders:0 ctyp) sigma ctyps) sigma constructors in (* generalize over the uniform parameters *) let nuparams = Context.Rel.length ctx_uparams in let uargs = Context.Rel.instance EConstr.mkRel 0 ctx_uparams in let uparam_subst = List.init ninds EConstr.(fun i -> mkApp (mkRel (i + 1 + nuparams), uargs)) @ List.init nuparams EConstr.(fun i -> mkRel (i + 1)) in let generalize_constructor c = EConstr.Vars.substnl uparam_subst nparams c in let cimpls = List.map pi3 constructors in let constructors = List.map (fun (cnames,ctypes,cimpls) -> (cnames,List.map generalize_constructor ctypes)) constructors in let ctx_params = ctx_params @ ctx_uparams in let userimpls = useruimpls @ userimpls in let indimpls = List.map (fun iimpl -> useruimpls @ iimpl) indimpls in let fullarities = List.map (fun c -> EConstr.it_mkProd_or_LetIn c ctx_uparams) fullarities in let env_ar = push_types env0 indnames relevances fullarities in let env_ar_params = EConstr.push_rel_context ctx_params env_ar in (* Try further to solve evars, and instantiate them *) let sigma = solve_remaining_evars all_and_fail_flags env_params sigma in let impls = List.map2 (fun indimpls cimpls -> indimpls, List.map (fun impls -> userimpls @ impls) cimpls) indimpls cimpls in let arities_explicit = List.map (fun ar -> ar.ind_arity_explicit) indl in let default_dep_elim, mie, binders, ctx = interp_mutual_inductive_constr ~template ~sigma ~ctx_params ~udecl ~variances ~arities_explicit ~arities ~template_syntax ~constructors ~env_ar_params ~poly ~finite ~cumulative ~private_ind ~indnames in (default_dep_elim, mie, binders, impls, ctx) (* Very syntactical equality *) let eq_local_binders bl1 bl2 = List.equal local_binder_eq bl1 bl2 let eq_params (up1,p1) (up2,p2) = eq_local_binders up1 up2 && Option.equal eq_local_binders p1 p2 let extract_coercions indl = let mkqid (_,({CAst.v=id},_)) = qualid_of_ident id in let iscoe (_, coe, inst) = match inst with (* remove BackInstanceWarning after deprecation phase *) | Vernacexpr.(NoInstance | BackInstanceWarning) -> coe = Vernacexpr.AddCoercion | _ -> user_err (Pp.str "'::' not allowed in inductives.") in let extract lc = List.filter (fun (coe,_) -> iscoe coe) lc in List.map mkqid (List.flatten(List.map (fun (_,_,_,lc) -> extract lc) indl)) exception DifferingParams of string (* inductive or record *) * (Id.t * Vernacexpr.inductive_params_expr) * (Id.t * Vernacexpr.inductive_params_expr) let explain_differing_params kind (ind,p) (ind',p') = let pr_params = function | ([],None) -> str "no parameters" | (up,p) -> let env = Global.env() in let sigma = Evd.from_env env in let pr_binders = Ppconstr.pr_binders env sigma in str "parameters" ++ spc() ++ hov 1 (quote (pr_binders up ++ pr_opt (fun p -> str "|" ++ spc() ++ pr_binders p) p)) in v 0 (str "Parameters should be syntactically the same for each " ++ str kind ++ str " type." ++ spc() ++ hov 0 (str "Type " ++ quote (Id.print ind) ++ str " has " ++ pr_params p) ++ spc() ++ hov 0 (str "but type " ++ quote (Id.print ind') ++ str " has " ++ pr_params p') ++ str ".") let () = CErrors.register_handler (function | DifferingParams (kind, a, b) -> Some (explain_differing_params kind a b) | _ -> None) let error_differing_params ~kind (ind,p) (ind',p') = Loc.raise ?loc:ind'.CAst.loc (DifferingParams (kind, (ind.CAst.v,p), (ind'.CAst.v,p'))) let extract_params indl = match indl with | [] -> anomaly (Pp.str "empty list of inductive types.") | (ind,params,_,_)::rest -> match List.find_opt (fun (_,p',_,_) -> not @@ eq_params params p') rest with | None -> params | Some (ind',p',_,_) -> error_differing_params ~kind:"inductive" (ind,params) (ind',p') let extract_inductive indl = List.map (fun ({CAst.v=indname},_,ar,lc) -> { ind_name = indname; ind_arity_explicit = Option.has_some ar; ind_arity = Option.default (CAst.make @@ CSort Constrexpr_ops.expr_Type_sort) ar; ind_lc = List.map (fun (_,({CAst.v=id},t)) -> (id,t)) lc }) indl let extract_mutual_inductive_declaration_components indl = let indl,ntnl = List.split indl in let params = extract_params indl in let coes = extract_coercions indl in let indl = extract_inductive indl in (params,indl), coes, List.flatten ntnl type uniform_inductive_flag = | UniformParameters | NonUniformParameters module Mind_decl = struct type t = { mie : Entries.mutual_inductive_entry; default_dep_elim : default_dep_elim list; nuparams : int option; univ_binders : UnivNames.universe_binders; implicits : DeclareInd.one_inductive_impls list; uctx : Univ.ContextSet.t; where_notations : Metasyntax.notation_interpretation_decl list; coercions : Libnames.qualid list; indlocs : Loc.t option list; } end let rec count_binder_expr = function | [] -> 0 | CLocalAssum(l,_,_,_) :: rest -> List.length l + count_binder_expr rest | CLocalDef _ :: rest -> 1 + count_binder_expr rest | CLocalPattern {CAst.loc} :: _ -> Loc.raise ?loc (Gramlib.Grammar.Error "pattern with quote not allowed here") let interp_mutual_inductive ~env ~template udecl indl ~cumulative ~poly ?typing_flags ~private_ind ~uniform finite = let indlocs = List.map (fun ((n,_,_,_),_) -> n.CAst.loc) indl in let (params,indl),coercions,ntns = extract_mutual_inductive_declaration_components indl in let where_notations = List.map Metasyntax.prepare_where_notation ntns in (* Interpret the types *) let indl, nuparams = match params with | uparams, Some params -> (uparams, params, indl), Some (count_binder_expr params) | params, None -> match uniform with | UniformParameters -> (params, [], indl), Some 0 | NonUniformParameters -> ([], params, indl), None in let env = Environ.update_typing_flags ?typing_flags env in let default_dep_elim, mie, univ_binders, implicits, uctx = interp_mutual_inductive_gen env ~template udecl indl where_notations ~cumulative ~poly ~private_ind finite in let open Mind_decl in { mie; default_dep_elim; nuparams; univ_binders; implicits; uctx; where_notations; coercions; indlocs } let do_mutual_inductive ~template udecl indl ~cumulative ~poly ?typing_flags ~private_ind ~uniform finite = let open Mind_decl in let env = Global.env () in let { mie; default_dep_elim; univ_binders; implicits; uctx; where_notations; coercions; indlocs} = interp_mutual_inductive ~env ~template udecl indl ~cumulative ~poly ?typing_flags ~private_ind ~uniform finite in (* Slightly hackish global universe declaration due to template types. *) let binders = match mie.mind_entry_universes with | Monomorphic_ind_entry -> (UState.Monomorphic_entry uctx, univ_binders) | Template_ind_entry ctx -> (UState.Monomorphic_entry ctx, univ_binders) | Polymorphic_ind_entry uctx -> (UState.Polymorphic_entry uctx, UnivNames.empty_binders) in (* Declare the global universes *) Global.push_context_set ~strict:true uctx; (* Declare the mutual inductive block with its associated schemes *) ignore (DeclareInd.declare_mutual_inductive_with_eliminations ~default_dep_elim ?typing_flags ~indlocs mie binders implicits); (* Declare the possible notations of inductive types *) List.iter (Metasyntax.add_notation_interpretation ~local:false (Global.env ())) where_notations; (* Declare the coercions *) List.iter (fun qid -> ComCoercion.try_add_new_coercion (Nametab.locate qid) ~local:false ~reversible:true) coercions (** Prepare a "match" template for a given inductive type. For each branch of the match, we list the constructor name followed by enough pattern variables. [Not_found] is raised if the given string isn't the qualid of a known inductive type. *) (* HH notes in PR #679: The Show Match could also be made more robust, for instance in the presence of let in the branch of a constructor. A decompose_prod_decls would probably suffice for that, but then, it is a Context.Rel.Declaration.t which needs to be matched and not just a pair (name,type). Otherwise, this is OK. After all, the API on inductive types is not so canonical in general, and in this simple case, working at the low-level of mind_nf_lc seems reasonable (compared to working at the higher-level of Inductiveops). *) let make_cases ind = let open Declarations in let mib, mip = Global.lookup_inductive ind in Util.Array.fold_right_i (fun i (ctx, _) l -> let al = Util.List.skipn (List.length mib.mind_params_ctxt) (List.rev ctx) in let rec rename avoid = function | [] -> [] | RelDecl.LocalDef _ :: l -> "_" :: rename avoid l | RelDecl.LocalAssum (n, _)::l -> let n' = Namegen.next_name_away_with_default (Id.to_string Namegen.default_dependent_ident) n.Context.binder_name avoid in Id.to_string n' :: rename (Id.Set.add n' avoid) l in let al' = rename Id.Set.empty al in let consref = GlobRef.ConstructRef (ith_constructor_of_inductive ind (i + 1)) in (Libnames.string_of_qualid (Nametab.shortest_qualid_of_global Id.Set.empty consref) :: al') :: l) mip.mind_nf_lc [] module Internal = struct let inductive_levels = inductive_levels let do_auto_prop_lowering = do_auto_prop_lowering let error_differing_params = error_differing_params end coq-8.20.0/vernac/comInductive.mli000066400000000000000000000124271466560755400170250ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* cumul_univ_decl_expr option -> (one_inductive_expr * notation_declaration list) list -> cumulative:bool -> poly:bool -> ?typing_flags:Declarations.typing_flags -> private_ind:bool -> uniform:uniform_inductive_flag -> Declarations.recursivity_kind -> unit (** User-interface API *) (** Prepare a "match" template for a given inductive type. For each branch of the match, we list the constructor name followed by enough pattern variables. [Not_found] is raised if the given string isn't the qualid of a known inductive type. *) val make_cases : Names.inductive -> string list list module Mind_decl : sig (** inductive_expr at the constr level *) type t = { mie : Entries.mutual_inductive_entry; default_dep_elim : DeclareInd.default_dep_elim list; nuparams : int option; univ_binders : UnivNames.universe_binders; implicits : DeclareInd.one_inductive_impls list; uctx : Univ.ContextSet.t; where_notations : Metasyntax.notation_interpretation_decl list; coercions : Libnames.qualid list; indlocs : Loc.t option list; } end (** elaborates an inductive declaration (the first half of do_mutual_inductive) *) val interp_mutual_inductive : env:Environ.env -> template:bool option -> cumul_univ_decl_expr option -> (one_inductive_expr * notation_declaration list) list -> cumulative:bool -> poly:bool -> ?typing_flags:Declarations.typing_flags -> private_ind:bool -> uniform:uniform_inductive_flag -> Declarations.recursivity_kind -> Mind_decl.t type syntax_allows_template_poly = SyntaxAllowsTemplatePoly | SyntaxNoTemplatePoly (** the post-elaboration part of interp_mutual_inductive, mainly dealing with universe levels *) val interp_mutual_inductive_constr : sigma:Evd.evar_map -> template:bool option -> udecl:UState.universe_decl -> variances:Entries.variance_entry -> ctx_params:EConstr.rel_context -> indnames:Names.Id.t list -> arities_explicit:bool list -> arities:EConstr.t list -> template_syntax:syntax_allows_template_poly list -> constructors:(Names.Id.t list * EConstr.constr list) list -> env_ar_params:Environ.env (** Environment with the inductives and parameters in the rel_context *) -> cumulative:bool -> poly:bool -> private_ind:bool -> finite:Declarations.recursivity_kind -> DeclareInd.default_dep_elim list * Entries.mutual_inductive_entry * UnivNames.universe_binders * Univ.ContextSet.t (************************************************************************) (** Internal API, exported for Record *) (************************************************************************) val compute_template_inductive : user_template:bool option -> ctx_params:Constr.rel_context -> univ_entry:UState.universes_entry -> Entries.one_inductive_entry -> syntax_allows_template_poly -> Entries.inductive_universes_entry * Univ.ContextSet.t (** [compute_template_inductive] computes whether an inductive can be template polymorphic. *) val maybe_unify_params_in : Environ.env -> Evd.evar_map -> ninds:int -> nparams:int -> binders:int -> EConstr.t -> Evd.evar_map (** [nparams] is the number of parameters which aren't treated as uniform, ie the length of params (including letins) where the env is [uniform params, inductives, params, binders]. *) val variance_of_entry : cumulative:bool -> variances:Entries.variance_entry -> Entries.inductive_universes_entry -> Entries.variance_entry option (** Will return None if non-cumulative, and resize if there are more universes than originally specified. If monomorphic, [cumulative] is treated as [false]. *) module Internal : sig (** Returns the modified arities (the result sort may be replaced by Prop). Should be called with minimized universes. *) val inductive_levels : Environ.env -> Evd.evar_map -> poly:bool -> indnames:Names.Id.t list -> arities_explicit:bool list (* whether the arities were explicit from the user (for auto Prop lowering) *) -> EConstr.constr list (* arities *) -> EConstr.rel_context list list (* constructors *) -> Evd.evar_map * (DeclareInd.default_dep_elim list * EConstr.t list) val error_differing_params : kind:string -> (Names.lident * Vernacexpr.inductive_params_expr) -> (Names.lident * Vernacexpr.inductive_params_expr) -> 'a val do_auto_prop_lowering : bool ref end coq-8.20.0/vernac/comPrimitive.ml000066400000000000000000000052031466560755400166640ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* if Option.has_some udecl then CErrors.user_err ?loc Pp.(strbrk "Cannot use a universe declaration without a type when declaring primitives."); let e = Declare.primitive_entry prim in declare id e | Some typ -> let env = Global.env () in let evd, udecl = Constrintern.interp_univ_decl_opt env udecl in let auctx = CPrimitives.op_or_type_univs prim in let evd, u = Evd.with_sort_context_set UState.univ_flexible evd (UnivGen.fresh_instance auctx) in let expected_typ = EConstr.of_constr @@ Typeops.type_of_prim_or_type env u prim in let evd, (typ,impls) = Constrintern.(interp_type_evars_impls ~impls:empty_internalization_env) env evd typ in let evd = try Evarconv.unify_delay env evd typ expected_typ with Evarconv.UnableToUnify (evd,e) as exn -> let _, info = Exninfo.capture exn in Exninfo.iraise (Pretype_errors.( PretypeError (env,evd,CannotUnify (typ,expected_typ,Some e)),info)) in Pretyping.check_evars_are_solved ~program_mode:false env evd; let evd = Evd.minimize_universes evd in let _qvars, uvars = EConstr.universes_of_constr evd typ in let evd = Evd.restrict_universe_context evd uvars in let typ = EConstr.to_constr evd typ in let univ_entry = Evd.check_univ_decl ~poly:(not (UVars.AbstractContext.is_empty auctx)) evd udecl in let entry = Declare.primitive_entry ~types:(typ, univ_entry) prim in declare id entry coq-8.20.0/vernac/comPrimitive.mli000066400000000000000000000014711466560755400170400ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* Constrexpr.universe_decl_expr option -> CPrimitives.op_or_type -> Constrexpr.constr_expr option -> unit coq-8.20.0/vernac/comProgramFixpoint.ml000066400000000000000000000354761466560755400200630ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* CErrors.user_err Pp.(str r ++ spc() ++ str "not registered," ++ spc() ++ str "you should try requiring library Coq.Program.Wf.") in let env = Global.env() in let sigma, udecl = interp_univ_decl_opt env pl in let sigma, (impls_env, ((env', binders_rel), impls)) = interp_context_evars ~program_mode:true env sigma bl in let len = List.length binders_rel in let top_env = push_rel_context binders_rel env in let flags = Pretyping.{ all_no_fail_flags with program_mode = true } in let sigma, (top_arity, arityimpls) = interp_type_evars_impls ~flags top_env sigma arityc in let sigma, letbinders, { telescope_type = argtyp; telescope_value = make } = telescope env sigma binders_rel in let argname = Id.of_string "recarg" in let arg = LocalAssum (make_annot (Name argname) ERelevance.relevant, argtyp) in let binders = letbinders @ [arg] in let binders_env = push_rel_context binders_rel env in let sigma, (rel, _) = interp_constr_evars_impls ~program_mode:true env sigma r in let relargty = Hipattern.is_homogeneous_relation ?loc:(constr_loc r) env sigma rel in let sigma, measure = interp_casted_constr_evars ~program_mode:true binders_env sigma measure relargty in let sigma, wf_rel, wf_rel_fun, measure_fn = let measure_body, measure = it_mkLambda_or_LetIn measure letbinders, it_mkLambda_or_LetIn measure binders in let sigma, comb = Evd.fresh_global (Global.env ()) sigma measure_on_R_ref in let wf_rel = mkApp (comb, [| argtyp; relargty; rel; measure |]) in let wf_rel_fun x y = mkApp (rel, [| subst1 x measure_body; subst1 y measure_body |]) in sigma, wf_rel, wf_rel_fun, measure in let sigma, wf_term = well_founded sigma in let wf_proof = mkApp (wf_term, [| argtyp ; wf_rel |]) in let argid' = Id.of_string (Id.to_string argname ^ "'") in let wfarg sigma len = let sigma, ss_term = mkSubset sigma (Name argid') argtyp (wf_rel_fun (mkRel 1) (mkRel (len + 1))) in sigma, LocalAssum (make_annot (Name argid') ERelevance.relevant, ss_term) in let sigma, intern_bl = let sigma, wfa = wfarg sigma 1 in sigma, wfa :: [arg] in let _intern_env = push_rel_context intern_bl env in let sigma, proj = Evd.fresh_global (Global.env ()) sigma (delayed_force build_sigma).Coqlib.proj1 in let wfargpred = mkLambda (make_annot (Name argid') ERelevance.relevant, argtyp, wf_rel_fun (mkRel 1) (mkRel 3)) in let projection = (* in wfarg :: arg :: before *) mkApp (proj, [| argtyp ; wfargpred ; mkRel 1 |]) in let top_arity_let = it_mkLambda_or_LetIn top_arity letbinders in let intern_arity = substl [projection] top_arity_let in (* substitute the projection of wfarg for something, now intern_arity is in wfarg :: arg *) let sigma, wfa = wfarg sigma 1 in let intern_fun_arity_prod = it_mkProd_or_LetIn intern_arity [wfa] in let intern_fun_binder = LocalAssum (make_annot (Name (add_suffix recname "'")) ERelevance.relevant, intern_fun_arity_prod) in let recproofid = Id.of_string "recproof" in let sigma, curry_fun = let wfpred = mkLambda (make_annot (Name argid') ERelevance.relevant, argtyp, wf_rel_fun (mkRel 1) (mkRel (2 * len + 4))) in let sigma, intro = Evd.fresh_global (Global.env ()) sigma (delayed_force build_sigma).Coqlib.intro in let arg = mkApp (intro, [| argtyp; wfpred; lift 1 make; mkRel 1 |]) in let app = mkApp (mkRel (2 * len + 2 (* recproof + orig binders + current binders *)), [| arg |]) in let rcurry = mkApp (rel, [| measure; lift len measure |]) in let lam = LocalAssum (make_annot (Name recproofid) ERelevance.relevant, rcurry) in let body = it_mkLambda_or_LetIn app (lam :: binders_rel) in let ty = it_mkProd_or_LetIn (lift 1 top_arity) (lam :: binders_rel) in sigma, LocalDef (make_annot (Name recname) ERelevance.relevant, body, ty) in let fun_bl = intern_fun_binder :: [arg] in let lift_lets = lift_rel_context 1 letbinders in let sigma, intern_body = let ctx = LocalAssum (make_annot (Name recname) ERelevance.relevant, get_type curry_fun) :: binders_rel in let impl = CAst.make (Some (Name recproofid, true)) in let newimpls = impls @ impl :: arityimpls in let dummy_decl = (* Ensure the measure argument does not contribute to the computation of automatic implicit arguments *) LocalAssum (make_annot (Name recproofid) ERelevance.relevant, mkProp) in let full_arity = it_mkProd_or_LetIn top_arity (dummy_decl :: binders_rel) in let interning_data = Constrintern.compute_internalization_data env sigma recname Constrintern.Recursive full_arity newimpls in let interning_data = (* Force the obligation status of "recproof" *) set_obligation_internalization_data recproofid interning_data in let newimpls = Id.Map.add recname interning_data impls_env in Metasyntax.with_syntax_protection (fun () -> let env_ctx = push_rel_context ctx env in List.iter (Metasyntax.set_notation_for_interpretation env_ctx newimpls) ntns; interp_casted_constr_evars ~program_mode:true env_ctx sigma ~impls:newimpls body (lift 1 top_arity)) () in let intern_body_lam = it_mkLambda_or_LetIn intern_body (curry_fun :: lift_lets @ fun_bl) in let prop = mkLambda (make_annot (Name argname) ERelevance.relevant, argtyp, top_arity_let) in (* XXX: Previous code did parallel evdref update, so possible old weak ordering semantics may bite here. *) let sigma, def = let sigma, h_a_term = Evd.fresh_global (Global.env ()) sigma fix_sub_ref in let sigma, h_e_term = Evarutil.new_evar env sigma ~src:(Loc.tag @@ Evar_kinds.QuestionMark { Evar_kinds.default_question_mark with Evar_kinds.qm_obligation=Evar_kinds.Define false; }) wf_proof in let sigma = Evd.set_obligation_evar sigma (fst (destEvar sigma h_e_term)) in sigma, mkApp (h_a_term, [| argtyp ; wf_rel ; h_e_term; prop |]) in let sigma, def = Typing.solve_evars env sigma def in let sigma = Evarutil.nf_evar_map sigma in let def = mkApp (def, [|intern_body_lam|]) in let binders_rel = Evarutil.nf_rel_context_evar sigma binders_rel in let binders = Evarutil.nf_rel_context_evar sigma binders in let top_arity = Evarutil.nf_evar sigma top_arity in let make = Evarutil.nf_evar sigma make in let recname_func, typ = if List.length binders_rel > 1 then add_suffix recname "_func", it_mkProd_or_LetIn top_arity binders else recname, it_mkProd_or_LetIn top_arity binders_rel in let evars_def, evars_typ, uctx, evmap, evars = Declare.Obls.prepare_obligations ~name:recname_func ~body:def ~types:typ env sigma in let hook = if List.length binders_rel > 1 then let hook { Declare.Hook.S.dref; uctx; obls; _ } = let update c = CVars.replace_vars obls (evmap mkVar (Evarutil.nf_evar (Evd.from_ctx uctx) c)) in let make = update make in let top_arity = update top_arity in let binders_rel = Context.Rel.map_het (ERelevance.kind sigma) update binders_rel in let univs = UState.check_univ_decl ~poly uctx udecl in let h_body = let inst = UState.(match fst univs with | Polymorphic_entry uctx -> UVars.UContext.instance uctx | Monomorphic_entry _ -> UVars.Instance.empty) in Constr.mkRef (dref, inst) in let body = Term.it_mkLambda_or_LetIn (Constr.mkApp (h_body, [|make|])) binders_rel in let ty = Term.it_mkProd_or_LetIn top_arity binders_rel in let ce = definition_entry ~types:ty ~univs body in (* FIXME: include locality *) let c = Declare.declare_constant ~name:recname ~kind:Decls.(IsDefinition Definition) (DefinitionEntry ce) in let gr = GlobRef.ConstRef c in if Impargs.is_implicit_args () || not (List.is_empty impls) then Impargs.declare_manual_implicits false gr impls in hook else let hook { Declare.Hook.S.dref; _ } = if Impargs.is_implicit_args () || not (List.is_empty impls) then Impargs.declare_manual_implicits false dref impls in hook in let hook = Declare.Hook.make hook in let cinfo = Declare.CInfo.make ~name:recname_func ~typ:evars_typ () in let kind = Decls.(IsDefinition Fixpoint) in let info = Declare.Info.make ?scope ?clearbody ~kind ~poly ~udecl ~hook ?typing_flags ?user_warns ~ntns () in let pm, _ = Declare.Obls.add_definition ~pm ~cinfo ~info ~opaque:false ~body:evars_def ~uctx ?using evars in pm let out_def = function | Some def -> def | None -> user_err Pp.(str "Program Fixpoint needs defined bodies.") let collect_evars_of_term evd c ty = Evar.Set.union (Evd.evars_of_term evd c) (Evd.evars_of_term evd ty) let do_program_recursive ~pm ~scope ?clearbody ~poly ?typing_flags ?user_warns ?using kind fixl = let cofix = kind = Decls.CoFixpoint in let (env, rec_sign, udecl, evd), fix, info = let env = Global.env () in let env = Environ.update_typing_flags ?typing_flags env in interp_recursive_evars env ~cofix ~program_mode:true fixl in (* Program-specific code *) (* Get the interesting evars, those that were not instantiated *) let evd = Typeclasses.resolve_typeclasses ~filter:Typeclasses.no_goals ~fail:true env evd in (* Solve remaining evars *) let evd = nf_evar_map_undefined evd in let (fixnames,fixrs,fixdefs,fixtypes) = fix in let collect_evars name def typ impargs = (* Generalize by the recursive prototypes *) let def = nf_evar evd def in let typ = nf_evar evd typ in let deps = collect_evars_of_term evd def typ in let evars, _, def, typ = RetrieveObl.retrieve_obligations env name evd (List.length rec_sign) ~deps def typ in (def, evars, typ) in let fiximps = List.map pi2 info in let fixdefs = List.map out_def fixdefs in let bodies, obls, typs = List.split3 (List.map4 collect_evars fixnames fixdefs fixtypes fiximps) in let cinfo = List.map3 (fun name typ impargs -> Declare.CInfo.make ~name ~typ ~impargs ()) fixnames typs fiximps in let possible_guard = if cofix then Pretyping.{possibly_cofix = true; possible_fix_indices = List.map (fun _ -> []) info} else Pretyping.{possibly_cofix = false; possible_fix_indices = List.map ComFixpoint.compute_possible_guardness_evidences info} in let () = (* An early check of guardedness before working on the obligations *) let fixdecls = Array.of_list (List.map2 (fun x r -> make_annot (Name x) r) fixnames fixrs), Array.of_list fixtypes, Array.of_list fixdefs in ignore (Pretyping.esearch_guard env evd possible_guard fixdecls) in let uctx = Evd.evar_universe_context evd in let kind = Decls.(IsDefinition kind) in let ntns = List.map_append (fun { Vernacexpr.notations } -> List.map Metasyntax.prepare_where_notation notations ) fixl in let info = Declare.Info.make ~poly ~scope ?clearbody ~kind ~udecl ?typing_flags ?user_warns ~ntns () in Declare.Obls.add_mutual_definitions ~pm ~info ~cinfo ~opaque:false ~uctx ~bodies ~possible_guard ?using obls let do_fixpoint ~pm ~scope ?clearbody ~poly ?typing_flags ?user_warns ?using l = let g = List.map (fun { Vernacexpr.rec_order } -> rec_order) l in match g, l with | [Some { CAst.v = CWfRec (n,r) }], [ Vernacexpr.{fname={CAst.v=id}; univs; binders; rtype; body_def; notations} ] -> let recarg = mkIdentC n.CAst.v in build_wellfounded pm (id, univs, binders, rtype, out_def body_def) ~scope ?clearbody poly ?typing_flags ?user_warns r recarg notations | [Some { CAst.v = CMeasureRec (n, m, r) }], [Vernacexpr.{fname={CAst.v=id}; univs; binders; rtype; body_def; notations }] -> (* We resolve here a clash between the syntax of Program Fixpoint and the one of funind *) let r = match n, r with | Some id, None -> let loc = id.CAst.loc in Some (CAst.make ?loc @@ CRef(qualid_of_ident ?loc id.CAst.v,None)) | Some _, Some _ -> user_err Pp.(str"Measure takes only two arguments in Program Fixpoint.") | _, _ -> r in build_wellfounded pm (id, univs, binders, rtype, out_def body_def) ~scope ?clearbody poly ?typing_flags ?user_warns (Option.default (CAst.make @@ CRef (lt_ref,None)) r) m notations | _, _ when List.for_all (fun ro -> match ro with None | Some { CAst.v = CStructRec _} -> true | _ -> false) g -> let annots = List.map (fun fix -> Vernacexpr.(ComFixpoint.adjust_rec_order ~structonly:true fix.binders fix.rec_order)) l in let kind = Decls.Fixpoint in let l = List.map2 (fun fix rec_order -> { fix with Vernacexpr.rec_order }) l annots in do_program_recursive ~pm ~scope ?clearbody ~poly ?typing_flags ?user_warns ?using kind l | _, _ -> CErrors.user_err (str "Well-founded fixpoints not allowed in mutually recursive blocks.") let do_cofixpoint ~pm ~scope ?clearbody ~poly ?typing_flags ?user_warns ?using fixl = let fixl = List.map (fun fix -> { fix with Vernacexpr.rec_order = None }) fixl in do_program_recursive ~pm ~scope ?clearbody ~poly ?typing_flags ?user_warns ?using Decls.CoFixpoint fixl coq-8.20.0/vernac/comProgramFixpoint.mli000066400000000000000000000024521466560755400202200ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* scope:Locality.definition_scope -> ?clearbody:bool -> poly:bool -> ?typing_flags:Declarations.typing_flags -> ?user_warns:UserWarn.t -> ?using:Vernacexpr.section_subset_expr -> fixpoint_expr list -> Declare.OblState.t val do_cofixpoint : pm:Declare.OblState.t -> scope:Locality.definition_scope -> ?clearbody:bool -> poly:bool -> ?typing_flags:Declarations.typing_flags -> ?user_warns:UserWarn.t -> ?using:Vernacexpr.section_subset_expr -> cofixpoint_expr list -> Declare.OblState.t coq-8.20.0/vernac/comRewriteRule.ml000066400000000000000000000601271466560755400171730ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* CErrors.user_err ?loc Pp.(strbrk "When declaring multiple symbols in one command, " ++ strbrk "only the first is allowed a universe binder " ++ strbrk "(which will be shared by the whole block).") | (_, None) -> () let preprocess_symbols l = let open Vernacexpr in if Global.sections_are_opened () then CErrors.user_err Pp.(str "Declaring a symbol is not allowed in sections."); let udecl = match l with | (coe, ((id, udecl)::rest, c))::rest' -> List.iter maybe_error_many_udecls rest; List.iter (fun (coe, (idl, c)) -> List.iter maybe_error_many_udecls idl) rest'; udecl | (_, ([], _))::_ | [] -> assert false in let no_coercion_msg = Pp.(str "Cannot deal with coercions in symbols") in List.iter (function AddCoercion, (({CAst.loc; _}, _) :: _, _) -> CErrors.user_err ?loc no_coercion_msg | AddCoercion, _ -> assert false | _ -> ()) l; udecl, List.concat_map (fun (coe, (idl, c)) -> List.map (fun (id, _) -> id, c) idl) l let do_symbol ~poly ~unfold_fix udecl (id, typ) = if Dumpglob.dump () then Dumpglob.dump_definition id false "symb"; let id = id.CAst.v in let env = Global.env () in let evd, udecl = Constrintern.interp_univ_decl_opt env udecl in let evd, (typ, impls) = Constrintern.(interp_type_evars_impls ~impls:empty_internalization_env) env evd typ in Pretyping.check_evars_are_solved ~program_mode:false env evd; let evd = Evd.minimize_universes evd in let _qvars, uvars = EConstr.universes_of_constr evd typ in let evd = Evd.restrict_universe_context evd uvars in let typ = EConstr.to_constr evd typ in let univs = Evd.check_univ_decl ~poly evd udecl in let entry = Declare.symbol_entry ~univs ~unfold_fix typ in let kn = Declare.declare_constant ~name:id ~kind:Decls.IsSymbol (Declare.SymbolEntry entry) in let () = Impargs.maybe_declare_manual_implicits false (GlobRef.ConstRef kn) impls in let () = Declare.assumption_message id in () let do_symbols ~poly ~unfold_fix l = let env = Global.env () in if not @@ Environ.rewrite_rules_allowed env then raise Environ.(RewriteRulesNotAllowed Symb); let udecl, l = preprocess_symbols l in List.iter (do_symbol ~poly ~unfold_fix udecl) l open Util open Constr open Declarations type state = (int * int Evar.Map.t) * (int * int Int.Map.t) * (int * int Int.Map.t) let rec is_rel_inst k = function | SList.Nil -> true | SList.Default _ -> false | SList.Cons (t, l) -> kind t = Rel k && is_rel_inst (succ k) l let update_invtbl ~loc env evd evk (curvar, tbl) = curvar, (succ curvar, tbl |> Evar.Map.update evk @@ function | None -> Some curvar | Some k as c when k = curvar -> c | Some k -> CErrors.user_err ?loc Pp.(str "Variable " ++ Termops.pr_existential_key env evd evk ++ str" is bound multiple times in the pattern (holes number " ++ int k ++ str" and " ++ int curvar ++ str").")) let update_invtblu1 ~loc evd lvlold lvl (curvaru, tbl) = succ curvaru, tbl |> Int.Map.update lvl @@ function | None -> Some curvaru | Some k as c when k = curvaru -> c | Some k -> CErrors.user_err ?loc Pp.(str "Universe variable " ++ Termops.pr_evd_level evd lvlold ++ str" is bound multiple times in the pattern (holes number " ++ int k ++ str" and " ++ int curvaru ++ str").") let update_invtblq1 ~loc evd qold qvar (curvarq, tbl) = succ curvarq, tbl |> Int.Map.update qvar @@ function | None -> Some curvarq | Some k as c when k = curvarq -> c | Some k -> CErrors.user_err ?loc Pp.(str "Sort variable " ++ Sorts.Quality.pr (Termops.pr_evd_qvar evd) qold ++ str" is bound multiple times in the pattern (holes number " ++ int k ++ str" and " ++ int curvarq ++ str").") let safe_quality_pattern_of_quality ~loc evd qsubst stateq q = match Sorts.Quality.(subst (subst_fn qsubst) q) with | QConstant qc -> stateq, PQConstant qc | QVar qv -> let qio = Sorts.QVar.var_index qv in let stateq = Option.fold_right (update_invtblq1 ~loc evd q) qio stateq in stateq, PQVar qio let update_invtblu ~loc evd (qsubst, usubst) (state, stateq, stateu : state) u : state * _ = let (q, u) = u |> UVars.Instance.to_array in let stateq, maskq = Array.fold_left_map (safe_quality_pattern_of_quality ~loc evd qsubst) stateq q in let stateu, masku = Array.fold_left_map (fun stateu lvlold -> let lvlnew = Univ.Level.var_index @@ Univ.subst_univs_level_level usubst lvlold in Option.fold_right (update_invtblu1 ~loc evd lvlold) lvlnew stateu, lvlnew ) stateu u in (state, stateq, stateu), (maskq, masku) let universe_level_subst_var_index usubst u = match Univ.Universe.level u with | None -> None | Some lvlold -> let lvl = Univ.subst_univs_level_level usubst lvlold in Option.map (fun lvl -> lvlold, lvl) @@ Univ.Level.var_index lvl let safe_sort_pattern_of_sort ~loc evd (qsubst, usubst) (st, sq, su as state) s = let open Sorts in match s with | Type u -> begin match universe_level_subst_var_index usubst u with | None -> state, PSType None | Some (lvlold, lvl) -> (st, sq, update_invtblu1 ~loc evd lvlold lvl su), PSType (Some lvl) end | SProp -> state, PSSProp | Prop -> state, PSProp | Set -> state, PSSet | QSort (qold, u) -> let sq, bq = match Sorts.Quality.(var_index @@ subst_fn qsubst qold) with | Some q -> update_invtblq1 ~loc evd (QVar qold) q sq, Some q | None -> sq, None in let su, ba = match universe_level_subst_var_index usubst u with | Some (lvlold, lvl) -> update_invtblu1 ~loc evd lvlold lvl su, Some lvl | None -> su, None in (st, sq, su), PSQSort (bq, ba) let warn_irrelevant_pattern = CWarnings.create ~name:"irrelevant-pattern" (fun () -> Pp.(str "This subpattern is irrelevant and can never be matched against.")) let warn_eta_in_pattern = CWarnings.create ~name:"eta-in-pattern" Fun.id let warn_redex_in_rewrite_rules = CWarnings.create ~name:"redex-in-rewrite-rules" (fun redex -> Pp.(str "This pattern contains a" ++ redex ++ str " which may prevent this rule from being triggered.")) let rec check_may_eta ~loc env evd t = match EConstr.kind evd (Reductionops.whd_all env evd t) with | Prod _ -> warn_eta_in_pattern ?loc Pp.(str "This subpattern has a product type, but pattern-matching is not done modulo eta, so this rule may not trigger at required times.") | Sort _ -> () | Ind (ind, u) -> let specif = Inductive.lookup_mind_specif env ind in if not @@ Inductive.is_primitive_record specif then () else warn_eta_in_pattern ?loc Pp.(str "This subpattern has a primitive record type, but pattern-matching is not done modulo eta, so this rule may not trigger at required times.") | App (i, _) -> check_may_eta ~loc env evd i | _ -> warn_eta_in_pattern ?loc Pp.(str "This subpattern has a yet unknown type, which may be a product type, but pattern-matching is not done modulo eta, so this rule may not trigger at required times.") let test_may_eta ~loc env evd constr = let t = Retyping.get_type_of env evd constr in let () = check_may_eta ~loc env evd t in () let rec safe_pattern_of_constr_aux ~loc env evd usubst depth state t = Constr.kind t |> function | App (f, args) -> let state, (head, elims) = safe_pattern_of_constr_aux ~loc env evd usubst depth state f in let state, pargs = Array.fold_left_map (safe_arg_pattern_of_constr ~loc env evd usubst depth) state args in state, (head, elims @ [PEApp pargs]) | Case (ci, u, params, (ret, _), _, c, brs) -> let mib, mip = Inductive.lookup_mind_specif env ci.ci_ind in let state, mask = update_invtblu ~loc evd usubst state u in let state, (head, elims) = safe_pattern_of_constr_aux ~loc env evd usubst depth state c in let paramdecl = Vars.subst_instance_context u mib.mind_params_ctxt in let paramsubst = Vars.subst_of_rel_context_instance paramdecl params in let state, pret = let (nas, p) = ret in let realdecls, _ = List.chop mip.mind_nrealdecls mip.mind_arity_ctxt in let self = let args = Context.Rel.instance mkRel 0 mip.mind_arity_ctxt in let inst = UVars.Instance.(abstract_instance (length u)) in mkApp (mkIndU (ci.ci_ind, inst), args) in let realdecls = Context.Rel.Declaration.LocalAssum (Context.make_annot Anonymous mip.mind_relevance, self) :: realdecls in let realdecls = Inductive.instantiate_context u paramsubst nas realdecls in let p_env = Environ.push_rel_context realdecls env in safe_arg_pattern_of_constr ~loc p_env evd usubst (depth + Array.length nas) state p in let do_one_branch i state (nas, br) = let (ctx, cty) = mip.mind_nf_lc.(i) in let bctx, _ = List.chop mip.mind_consnrealdecls.(i) ctx in let bctx = Inductive.instantiate_context u paramsubst nas bctx in let br_env = Environ.push_rel_context bctx env in safe_arg_pattern_of_constr ~loc br_env evd usubst (depth + Array.length nas) state br in let state, pbrs = Array.fold_left_map_i do_one_branch state brs in state, (head, elims @ [PECase (ci.ci_ind, mask, pret, pbrs)]) | Proj (p, _, c) -> let state, (head, elims) = safe_pattern_of_constr_aux ~loc env evd usubst depth state c in state, (head, elims @ [PEProj p]) | _ -> let state, head = safe_head_pattern_of_constr ~loc env evd usubst depth state t in state, (head, []) and safe_pattern_of_constr ~loc env evd usubst depth state t = begin match EConstr.ERelevance.kind evd @@ Retyping.relevance_of_term env evd (EConstr.of_constr t) with | Sorts.Irrelevant -> warn_irrelevant_pattern ?loc () | Sorts.RelevanceVar _ -> () (* FIXME *) | Sorts.Relevant -> () end; safe_pattern_of_constr_aux ~loc env evd usubst depth state t and safe_head_pattern_of_constr ~loc env evd usubst depth state t = Constr.kind t |> function | Const (c, u) when Environ.is_symbol env c -> let state, mask = update_invtblu ~loc evd usubst state u in state, PHSymbol (c, mask) | Rel i -> assert (i <= depth); state, PHRel i | Sort s -> let state, ps = safe_sort_pattern_of_sort ~loc evd usubst state s in state, PHSort ps | Ind (ind, u) -> let state, mask = update_invtblu ~loc evd usubst state u in state, PHInd (ind, mask) | Construct (c, u) -> let state, mask = update_invtblu ~loc evd usubst state u in state, PHConstr (c, mask) | Int i -> state, PHInt i | Float f -> state, PHFloat f | String s -> state, PHString s | Lambda _ -> let (ntys, b) = Term.decompose_lambda t in let tys = Array.rev_of_list ntys in let (state, env), ptys = Array.fold_left_map_i (fun i (state, env) (na, ty) -> let state, p = safe_arg_pattern_of_constr ~loc env evd usubst (depth+i) state ty in (state, Environ.push_rel (LocalAssum (na, ty)) env), p) (state, env) tys in let state, pbod = safe_arg_pattern_of_constr ~loc env evd usubst (depth + Array.length tys) state b in state, PHLambda (ptys, pbod) | Prod _ -> let (ntys, b) = Term.decompose_prod t in let tys = Array.rev_of_list ntys in let (state, env), ptys = Array.fold_left_map_i (fun i (state, env) (na, ty) -> let state, p = safe_arg_pattern_of_constr ~loc env evd usubst (depth+i) state ty in (state, Environ.push_rel (LocalAssum (na, ty)) env), p) (state, env) tys in let state, pbod = safe_arg_pattern_of_constr ~loc env evd usubst (depth + Array.length tys) state b in state, PHProd (ptys, pbod) | _ -> CErrors.user_err ?loc Pp.(str "Subterm not recognised as pattern: " ++ Printer.safe_pr_lconstr_env env evd t) and safe_arg_pattern_of_constr ~loc env evd usubst depth (st, stateq, stateu as state) t = Constr.kind t |> function | Evar (evk, inst) -> let EvarInfo evi = Evd.find evd evk in (match snd (Evd.evar_source evi) with | Evar_kinds.MatchingVar (Evar_kinds.FirstOrderPatVar id) -> let holei, st = update_invtbl ~loc env evd evk st in if not @@ is_rel_inst 1 inst then CErrors.user_err ?loc Pp.(str "In " ++ Printer.safe_pr_lconstr_env env evd (of_kind (Evar (evk, inst))) ++ str ", variable " ++ Termops.pr_existential_key env evd evk ++ str" appears with a non-trivial instantiation."); if Evd.evar_hyps evi |> Environ.named_context_of_val |> Context.Named.length <> SList.length inst then CErrors.user_err ?loc Pp.(str "Pattern variable cannot access the whole context: " ++ Printer.safe_pr_lconstr_env env evd t); (st, stateq, stateu), EHole holei | Evar_kinds.NamedHole _ -> CErrors.user_err ?loc Pp.(str "Named holes are not supported, you must use regular evars: " ++ Printer.safe_pr_lconstr_env env evd t) | _ -> if Option.is_empty @@ Evd.evar_ident evk evd then state, EHoleIgnored else CErrors.user_err ?loc Pp.(str "Named evar in unsupported context: " ++ Printer.safe_pr_lconstr_env env evd t) ) | _ -> test_may_eta ~loc env evd (EConstr.of_constr t); let state, p = safe_pattern_of_constr ~loc env evd usubst depth state t in state, ERigid p (* relocation of evars into de Bruijn indices *) let rec evar_subst evmap evd k t = match EConstr.kind evd t with | Evar (evk, inst) -> begin match Evar.Map.find_opt evk evmap with | None -> t | Some (n, vars) -> let head = EConstr.mkRel (n + k) in let Evd.EvarInfo evi = Evd.find evd evk in let body = EConstr.mkApp (head, vars) in let inst = inst |> SList.Smart.map (evar_subst evmap evd k) in Evd.instantiate_evar_array evd evi body inst end | _ -> EConstr.map_with_binders evd succ (evar_subst evmap evd) k t let test_projection_apps env evd ~loc ind args = let specif = Inductive.lookup_mind_specif env ind in if not @@ Inductive.is_primitive_record specif then () else if Array.for_all_i (fun i arg -> match arg with | EHole _ | EHoleIgnored -> true | ERigid (_, []) -> false | ERigid (_, elims) -> match List.last elims with | PEProj p -> Ind.CanOrd.equal (Projection.inductive p) ind && Projection.arg p = i | _ -> false ) 0 args then warn_redex_in_rewrite_rules ?loc Pp.(str " subpattern compatible with an eta-long form for " ++ Id.print (snd specif).mind_typename ++ str"," ) let rec test_pattern_redex env evd ~loc = function | PHLambda _, PEApp _ :: _ -> warn_redex_in_rewrite_rules ?loc (Pp.str " beta redex") | PHConstr _, (PECase _ | PEProj _) :: _ -> warn_redex_in_rewrite_rules ?loc (Pp.str " iota redex") | PHConstr _, PEApp _ :: (PECase _ | PEProj _) :: _ -> warn_redex_in_rewrite_rules ?loc (Pp.str " iota redex") | PHLambda _, _ -> warn_redex_in_rewrite_rules ?loc (Pp.str " lambda pattern") | PHConstr (c, _) as head, PEApp args :: elims -> test_projection_apps env evd ~loc (fst c) args; Array.iter (test_pattern_redex_aux env evd ~loc) args; test_pattern_redex env evd ~loc (head, elims) | head, PEApp args :: elims -> Array.iter (test_pattern_redex_aux env evd ~loc) args; test_pattern_redex env evd ~loc (head, elims) | head, PECase (_, _, ret, brs) :: elims -> test_pattern_redex_aux env evd ~loc ret; Array.iter (test_pattern_redex_aux env evd ~loc) brs; test_pattern_redex env evd ~loc (head, elims) | head, PEProj _ :: elims -> test_pattern_redex env evd ~loc (head, elims) | PHProd (tys, bod), [] -> Array.iter (test_pattern_redex_aux env evd ~loc) tys; test_pattern_redex_aux env evd ~loc bod | (PHRel _ | PHInt _ | PHFloat _ | PHString _ | PHSort _ | PHInd _ | PHConstr _ | PHSymbol _), [] -> () and test_pattern_redex_aux env evd ~loc = function | EHole _ | EHoleIgnored -> () | ERigid p -> test_pattern_redex env evd ~loc p let warn_rewrite_rules_break_SR = "rewrite-rules-break-SR" let rewrite_rules_break_SR_warning = CWarnings.create_warning ~name:warn_rewrite_rules_break_SR ~default:CWarnings.Enabled () let rewrite_rules_break_SR_msg = CWarnings.create_msg rewrite_rules_break_SR_warning () let warn_rewrite_rules_break_SR ~loc reason = CWarnings.warn rewrite_rules_break_SR_msg ?loc reason let () = CWarnings.register_printer rewrite_rules_break_SR_msg (fun reason -> Pp.(str "This rewrite rule breaks subject reduction (" ++ reason ++ str ").")) let interp_rule (udecl, lhs, rhs: Constrexpr.universe_decl_expr option * _ * _) = let env = Global.env () in let evd = Evd.from_env env in (* 1. Read universe level binders, leaving out the constraints for now *) (* Inlined the relevant part of Constrintern.interp_univ_decl *) let evd, udecl = let open CAst in let open UState in match udecl with | None -> evd, default_univ_decl | Some udecl -> let evd, qualities = List.fold_left_map (fun evd lid -> Evd.new_quality_variable ?loc:lid.loc ~name:lid.v evd) evd udecl.univdecl_qualities in let evd, instance = List.fold_left_map (fun evd lid -> Evd.new_univ_level_variable ?loc:lid.loc univ_rigid ~name:lid.v evd) evd udecl.univdecl_instance in let cstrs = udecl.univdecl_constraints |> List.to_seq |> Seq.map (Constrintern.interp_univ_constraint evd) |> Univ.Constraints.of_seq in let decl = { univdecl_qualities = qualities; univdecl_extensible_qualities = udecl.univdecl_extensible_qualities; univdecl_instance = instance; univdecl_extensible_instance = udecl.univdecl_extensible_instance; univdecl_constraints = cstrs; univdecl_extensible_constraints = udecl.univdecl_extensible_constraints; } in evd, decl in let nvarqs = List.length udecl.univdecl_qualities in let nvarus = List.length udecl.univdecl_instance in (* 2. Read left hand side, into a pattern *) (* The udecl constraints must be implied by the lhs (and not the reverse) *) let lhs_loc = lhs.CAst.loc in let rhs_loc = rhs.CAst.loc in let lhs = Constrintern.(intern_gen WithoutTypeConstraint env evd lhs) in let flags = { Pretyping.no_classes_no_fail_inference_flags with undeclared_evars_patvars = true; patvars_abstract = true; expand_evars = false; solve_unification_constraints = false } in let evd, lhs, typ = Pretyping.understand_tcc_ty ~flags env evd lhs in let evd = Evd.minimize_universes evd in let _qvars, uvars = EConstr.universes_of_constr evd lhs in let evd = Evd.restrict_universe_context evd uvars in let uctx, uctx' = UState.check_univ_decl_rev (Evd.evar_universe_context evd) udecl in let usubst = let inst, auctx = UVars.abstract_universes uctx' in UVars.make_instance_subst inst in let ((nvars', invtbl), (nvarqs', invtblq), (nvarus', invtblu)), (head_pat, elims) = safe_pattern_of_constr ~loc:lhs_loc env evd usubst 0 ((1, Evar.Map.empty), (0, Int.Map.empty), (0, Int.Map.empty)) (EConstr.Unsafe.to_constr lhs) in let () = test_pattern_redex env evd ~loc:lhs_loc (head_pat, elims) in let head_symbol, head_umask = match head_pat with PHSymbol (symb, mask) -> symb, mask | _ -> CErrors.user_err ?loc:lhs_loc Pp.(str "Head head-pattern is not a symbol.") in if nvarus <> nvarus' then begin assert (nvarus' < nvarus); CErrors.user_err ?loc:lhs_loc Pp.(str "Not all universe level variables appear in the pattern.") end; if nvarqs <> nvarqs' then begin assert (nvarqs' < nvarqs); CErrors.user_err ?loc:lhs_loc Pp.(str "Not all sort variables appear in the pattern.") end; let update_invtbl evd evk n = let Evd.EvarInfo evi = Evd.find evd evk in let vars = Evd.evar_hyps evi |> Environ.named_context_of_val |> Context.Named.instance EConstr.mkVar in (n, vars) in let invtbl = Evar.Map.mapi (update_invtbl evd) invtbl in (* 3. Read right hand side *) (* The udecl constraints (or, if none, the lhs constraints) must imply those of the rhs *) let evd = Evd.set_universe_context evd uctx in let rhs = Constrintern.(intern_gen WithoutTypeConstraint env evd rhs) in let flags = { Pretyping.no_classes_no_fail_inference_flags with patvars_abstract = true } in let evd', rhs = try Pretyping.understand_tcc ~flags env evd ~expected_type:(OfType typ) rhs with Type_errors.TypeError _ | Pretype_errors.PretypeError _ -> warn_rewrite_rules_break_SR ~loc:rhs_loc (Pp.str "the replacement term doesn't have the type of the pattern"); Pretyping.understand_tcc ~flags env evd rhs in let evd' = Evd.minimize_universes evd' in let _qvars', uvars' = EConstr.universes_of_constr evd' rhs in let evd' = Evd.restrict_universe_context evd' (Univ.Level.Set.union uvars uvars') in let fail pp = warn_rewrite_rules_break_SR ~loc:rhs_loc Pp.(str "universe inconsistency, missing constraints: " ++ pp) in let () = UState.check_uctx_impl ~fail (Evd.evar_universe_context evd) (Evd.evar_universe_context evd') in let evd = evd' in let rhs = let rhs' = evar_subst invtbl evd 0 rhs in match EConstr.to_constr_opt evd rhs' with | Some rhs -> rhs | None -> let pr_unresolved_evar e = Pp.(hov 2 (str"- " ++ Printer.pr_existential_key env evd e ++ str ": " ++ Himsg.explain_pretype_error env evd (Pretype_errors.UnsolvableImplicit (e,None)))) in CErrors.user_err ?loc:rhs_loc Pp.(hov 0 begin str "The replacement term contains unresolved implicit arguments:"++ fnl () ++ str " " ++ Printer.pr_econstr_env env evd rhs ++ fnl () ++ str "More precisely: " ++ fnl () ++ v 0 (prlist_with_sep cut pr_unresolved_evar (Evar.Set.elements (Evarutil.undefined_evars_of_term evd rhs'))) end) in let rhs = Vars.subst_univs_level_constr usubst rhs in let test_qvar q = match Sorts.QVar.var_index q with | Some -1 -> CErrors.user_err ?loc:rhs_loc Pp.(str "Sort variable " ++ Termops.pr_evd_qvar evd q ++ str " appears in the replacement but does not appear in the pattern.") | Some n when n < 0 || n > nvarqs' -> CErrors.anomaly Pp.(str "Unknown sort variable in rewrite rule.") | Some _ -> () | None -> if not @@ Sorts.QVar.Set.mem q (evd |> Evd.sort_context_set |> fst |> fst) then CErrors.user_err ?loc:rhs_loc Pp.(str "Sort variable " ++ Termops.pr_evd_qvar evd q ++ str " appears in the replacement but does not appear in the pattern.") in let test_level ?(alg_ok=false) lvl = match Univ.Level.var_index lvl with | Some -1 -> CErrors.user_err ?loc:rhs_loc Pp.(str "Universe level variable " ++ Termops.pr_evd_level evd lvl ++ str " appears in the replacement but does not appear in the pattern.") | Some n when n < 0 || n > nvarus' -> CErrors.anomaly Pp.(str "Unknown universe level variable in rewrite rule") | Some _ -> () | None -> try UGraph.check_declared_universes (Environ.universes env) (Univ.Level.Set.singleton lvl) with UGraph.UndeclaredLevel lvl -> CErrors.user_err ?loc:rhs_loc Pp.(str "Universe level " ++ Termops.pr_evd_level evd lvl ++ str " appears in the replacement but does not appear in the pattern.") in let () = let qs, us = Vars.sort_and_universes_of_constr rhs in Sorts.QVar.Set.iter test_qvar qs; Univ.Level.Set.iter test_level us in head_symbol, { nvars = (nvars' - 1, nvarqs', nvarus'); lhs_pat = head_umask, elims; rhs } let do_rules id rules = let env = Global.env () in if not @@ Environ.rewrite_rules_allowed env then raise Environ.(RewriteRulesNotAllowed Rule); let body = { rewrules_rules = List.map interp_rule rules } in Global.add_rewrite_rules id body coq-8.20.0/vernac/comRewriteRule.mli000066400000000000000000000004771466560755400173460ustar00rootroot00000000000000val do_symbols : poly:bool -> unfold_fix:bool -> (Vernacexpr.coercion_flag * ((Names.lident * Constrexpr.universe_decl_expr option) list * Constrexpr.constr_expr)) list -> unit val do_rules : Names.Id.t -> (Constrexpr.universe_decl_expr option * Constrexpr.constr_expr * Constrexpr.constr_expr) list -> unit coq-8.20.0/vernac/comSearch.ml000066400000000000000000000154221466560755400161250ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* user_err ?loc:qid.CAst.loc (str "Module/Section " ++ Ppconstr.pr_qualid qid ++ str " not found.") let interp_search_restriction = function | SearchOutside l -> SearchOutside (List.map global_module l) | SearchInside l -> SearchInside (List.map global_module l) let kind_searcher env = Decls.(function (* Kinds referring to the keyword introducing the object *) | IsAssumption _ | IsDefinition (Definition | Example | Fixpoint | CoFixpoint | Method | StructureComponent | Let | LetContext) | IsProof _ | IsPrimitive | IsSymbol as k -> Inl k (* Kinds referring to the status of the object *) | IsDefinition (Coercion | SubClass | IdentityCoercion as k') -> let coercions = Coercionops.coercions () in Inr (fun gr -> List.exists (fun c -> Environ.QGlobRef.equal env c.Coercionops.coe_value gr && (k' <> SubClass && k' <> IdentityCoercion || c.Coercionops.coe_is_identity)) coercions) | IsDefinition CanonicalStructure -> let canonproj = Structures.CSTable.entries () in Inr (fun gr -> List.exists (fun c -> Environ.QGlobRef.equal env c.Structures.CSTable.solution gr) canonproj) | IsDefinition Scheme -> let schemes = DeclareScheme.all_schemes () in let schemes = lazy begin Indmap.fold (fun _ schemes acc -> CString.Map.fold (fun _ c acc -> Cset.add c acc) schemes acc) schemes Cset.empty end in Inr (function | ConstRef c -> Cset.mem c (Lazy.force schemes) | _ -> false) | IsDefinition Instance -> let instances = Typeclasses.all_instances () in Inr (fun gr -> List.exists (fun c -> Environ.QGlobRef.equal env c.Typeclasses.is_impl gr) instances)) let interp_constr_pattern env sigma ?(expected_type=Pretyping.WithoutTypeConstraint) c = let c = Constrintern.intern_gen expected_type ~pattern_mode:true env sigma c in let flags = { Pretyping.no_classes_no_fail_inference_flags with expand_evars = false } in let sigma, c = Pretyping.understand_tcc ~flags env sigma ~expected_type c in (* FIXME: it is necessary to be unsafe here because of the way we handle evars in the pretyper. Sometimes they get solved eagerly. *) Patternops.legacy_bad_pattern_of_constr env sigma c let interp_search_item env sigma = function | SearchSubPattern ((where,head),pat) -> let expected_type = Pretyping.(if head then IsType else WithoutTypeConstraint) in let pat = try interp_constr_pattern env sigma ~expected_type pat with e when CErrors.noncritical e -> (* We cannot ensure (yet?) that a typable pattern will actually be typed, consider e.g. (forall A, A -> A /\ A) which fails, not seeing that A can be Prop; so we use an untyped pattern as a fallback (i.e w/o no insertion of coercions, no compilation of pattern-matching) *) snd (Constrintern.intern_constr_pattern env sigma ~as_type:head pat) in GlobSearchSubPattern (where,head,pat) | SearchString ((Anywhere,false),s,None) when Id.is_valid_ident_part s && String.equal (String.drop_simple_quotes s) s -> GlobSearchString s | SearchString ((where,head),s,sc) -> let sc = Option.map snd sc in let ref = Notation.interp_notation_as_global_reference ~head:false (fun _ -> true) s sc in GlobSearchSubPattern (where,head,Pattern.PRef ref) | SearchKind k -> match kind_searcher env k with | Inl k -> GlobSearchKind k | Inr f -> GlobSearchFilter f let rec interp_search_request env sigma = function | b, SearchLiteral i -> b, GlobSearchLiteral (interp_search_item env sigma i) | b, SearchDisjConj l -> b, GlobSearchDisjConj (List.map (List.map (interp_search_request env sigma)) l) (* 05f22a5d6d5b8e3e80f1a37321708ce401834430 introduced the `search_output_name_only` option to avoid excessive printing when searching. The motivation was to make search usable for IDE completion, however, it is still too slow due to the non-indexed nature of the underlying search mechanism. In the future we should deprecate the option and provide a fast, indexed name-searching interface. *) let search_output_name_only = ref false let () = declare_bool_option { optstage = Summary.Stage.Interp; optdepr = None; optkey = ["Search";"Output";"Name";"Only"]; optread = (fun () -> !search_output_name_only); optwrite = (:=) search_output_name_only } let interp_search env sigma s r = let r = interp_search_restriction r in let get_pattern c = snd (Constrintern.intern_constr_pattern env sigma c) in let warnlist = ref [] in let pr_search ref kind env sigma c = let pr = pr_global ref in let pp = if !search_output_name_only then pr else begin let open Impargs in let impls = implicits_of_global ref in let impargs = select_stronger_impargs impls in let impargs = List.map binding_kind_of_status impargs in if List.length impls > 1 || List.exists Glob_term.(function Explicit -> false | MaxImplicit | NonMaxImplicit -> true) (List.skipn_at_best (Termops.nb_prod_modulo_zeta sigma (EConstr.of_constr c)) impargs) then warnlist := pr :: !warnlist; let pc = pr_ltype_env env sigma ~impargs c in hov 2 (pr ++ str":" ++ spc () ++ pc) end in Feedback.msg_notice pp in (match s with | SearchPattern c -> (Search.search_pattern env sigma (get_pattern c) r |> Search.prioritize_search) pr_search | SearchRewrite c -> (Search.search_rewrite env sigma (get_pattern c) r |> Search.prioritize_search) pr_search | Search sl -> (Search.search env sigma (List.map (interp_search_request env Evd.(from_env env)) sl) r |> Search.prioritize_search) pr_search); if !warnlist <> [] then Feedback.msg_notice (str "(" ++ hov 0 (strbrk "use \"About\" for full details on the implicit arguments of " ++ pr_enum (fun x -> x) !warnlist ++ str ")")) coq-8.20.0/vernac/comSearch.mli000066400000000000000000000021171466560755400162730ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* Evd.evar_map -> bool * Vernacexpr.search_request -> bool * Search.glob_search_request val interp_search_restriction : Libnames.qualid list search_restriction -> Names.DirPath.t list search_restriction val interp_search : Environ.env -> Evd.evar_map -> searchable -> Libnames.qualid list search_restriction -> unit coq-8.20.0/vernac/comTactic.ml000066400000000000000000000062721466560755400161320ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* interpretable type 'a tactic_interpreter = Interpreter of ('a -> interpretable) let register_tactic_interpreter na f = let t = Dyn.create na in interp_map := DMap.add t f !interp_map; Interpreter (fun x -> I (t,x)) 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 { Goptions.get = print_info_trace } = declare_intopt_option_and_ref ~key:["Info" ; "Level"] ~value:None () 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_undefined 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 coq-8.20.0/vernac/comTactic.mli000066400000000000000000000043041466560755400162750ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* interpretable) (** ['a] should be marshallable if ever used with [par:]. Must be called no more than once per process with a particular string: make sure to use partial application. *) 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 coq-8.20.0/vernac/debugHook.ml000066400000000000000000000053341466560755400161310ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* = 2 && s.[0] == '"' && s.[String.length s - 1] == '"' then String.sub s 1 (String.length s - 2) else s let parse_complex inst : (t, string) result = if 'r' = String.get inst 0 then let arg = String.(trim (sub inst 1 (length inst - 1))) in if arg <> "" then match int_of_string_opt arg with | Some num -> if num < 0 then Error "number must be positive" else Ok (RunCnt num) | None -> Ok (RunBreakpoint (possibly_unquote arg)) else Error ("invalid input: " ^ inst) else Error ("invalid input: " ^ inst) (* XXX: Should be moved to the clients *) let parse inst : (t, string) result = match inst with | "" -> Ok StepIn | "s" -> Ok Skip | "x" -> Ok Interrupt | "h"| "?" -> Ok Help | _ -> parse_complex inst end module Answer = struct type t = | Prompt of Pp.t | Goal of Pp.t | Output of Pp.t | Init | Stack of (string * (string * int list) option) list | Vars of (string * Pp.t) list end module Intf = struct type t = { read_cmd : unit -> Action.t (** request a debugger command from the client *) ; submit_answer : Answer.t -> unit (** receive a debugger answer from Ltac *) ; isTerminal : bool (** whether the debugger is running as a terminal (non-visual) *) } let ltac_debug_ref : t option ref = ref None let set hooks = ltac_debug_ref := Some hooks let get () = !ltac_debug_ref end coq-8.20.0/vernac/debugHook.mli000066400000000000000000000107551466560755400163050ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* Coq sends Answer.Init <- IDE sends zero or more initialization requests such as Action.UpdBpts <- IDE sends Action.Configd Stopping in the debugger generates Answer.Prompt and Answer.Goal messages, at which point the IDE will typically call GetStack and GetVars. When the IDE sends with StepIn..Continue, the debugger will execute more code. At that point, Coq won't try to read more messages from the IDE until the debugger stops again or exits. *) module Action : sig type t = | StepIn (* execute a single step in the tactic *) | StepOver (* execute steps until DB is back in the current stack frame *) | StepOut (* execute steps until DB exits current stack frame *) | Continue (* execute steps until a breakpoint or the debugger exits *) | Skip (* legacy: continue execution with no further debugging *) | Interrupt (* exit the debugger *) | Help (* legacy: print help text *) | UpdBpts of ((string * int) * bool) list (* sets or clears breakpoints. Values are: - absolute pathname of the the file - byte offset in the UTF-8 representation of the file - true to set, false to clear *) | Configd (* "config done" - indicates that the debugger has been configured, debugger does a Continue *) | GetStack (* request the call stack, returned as Answer.Stack *) | GetVars of int (* request the variables defined for stack frame N, returned as Answer.Vars. 0 is the topmost frame, followed by 1,2,3, ... *) | RunCnt of int (* legacy: run for N steps *) | RunBreakpoint of string (* legacy: run until an idtac prints the string *) | Command of string (* legacy: user-typed command to the debugger *) | Failed (* legacy: user command doesn't parse *) | Ignore (* internal: do nothing, read another command *) (* XXX: Should be moved to the clients *) val parse : string -> (t, string) result end module Answer : sig type t = | Prompt of Pp.t (* output signalling the debugger has stopped Should be printed as a prompt for user input, e.g. in color without a newline at the end *) | Goal of Pp.t (* goal for the current proof state *) | Output of Pp.t (* general output *) | Init (* signals initialization of the debugger *) | Stack of (string * (string * int list) option) list (* The call stack, starting from TOS. Values are: - description of the frame (eg tactic name, line number, module) - absolute pathname of the file - array containing Loc.bp and Loc.ep of the corresponding code *) | Vars of (string * Pp.t) list (* The variable values for the specified stack frame. Values are variable name and variable value *) end module Intf : sig type t = { read_cmd : unit -> Action.t (** request a debugger command from the client *) ; submit_answer : Answer.t -> unit (** receive a debugger answer from Ltac *) ; isTerminal : bool (** whether the debugger is running as a terminal (non-visual) *) } val set : t -> unit val get : unit -> t option end coq-8.20.0/vernac/declare.ml000066400000000000000000003161421466560755400156230ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* 'a -> 'a) CEphemeron.key type t = unit g let make_g hook = CEphemeron.create hook let make (hook : S.t -> unit) : t = CEphemeron.create (fun x () -> hook x) let hcall hook x s = CEphemeron.default hook (fun _ x -> x) x s let call_g ?hook x s = Option.cata (fun hook -> hcall hook x s) s hook let call ?hook x = Option.iter (fun hook -> hcall hook x ()) hook end module CInfo = struct type 'constr t = { name : Id.t (** Name of theorem *) ; typ : 'constr (** Type of theorem *) ; args : Name.t list (** Names to pre-introduce *) ; impargs : Impargs.manual_implicits (** Explicitily declared implicit arguments *) } let make ~name ~typ ?(args=[]) ?(impargs=[]) () = { name; typ; args; impargs } let to_constr sigma thm = { thm with typ = EConstr.to_constr sigma thm.typ } let get_typ { typ; _ } = typ let get_name { name; _ } = name end (** Information for a declaration, interactive or not, includes parameters shared by mutual constants *) module Info = struct type t = { poly : bool ; inline : bool ; kind : Decls.logical_kind ; udecl : UState.universe_decl ; scope : Locality.definition_scope ; clearbody : bool (* always false for non Discharge scope *) ; hook : Hook.t option ; typing_flags : Declarations.typing_flags option ; user_warns : UserWarn.t option ; ntns : Metasyntax.notation_interpretation_decl list } (** Note that [opaque] doesn't appear here as it is not known at the start of the proof in the interactive case. *) let make ?(poly=false) ?(inline=false) ?(kind=Decls.(IsDefinition Definition)) ?(udecl=UState.default_univ_decl) ?(scope=Locality.default_scope) ?(clearbody=false) ?hook ?typing_flags ?user_warns ?(ntns=[]) () = { poly; inline; kind; udecl; scope; hook; typing_flags; clearbody; user_warns; ntns } end (** Declaration of constants and parameters *) type 'a pproof_entry = { proof_entry_body : 'a; (* List of section variables *) proof_entry_secctx : Id.Set.t option; (* State id on which the completion of type checking is reported *) proof_entry_feedback : Stateid.t option; proof_entry_type : Constr.types option; proof_entry_universes : UState.named_universes_entry; proof_entry_opaque : bool; proof_entry_inline_code : bool; } type proof_entry = Evd.side_effects Opaques.const_entry_body pproof_entry type parameter_entry = { parameter_entry_secctx : Id.Set.t option; parameter_entry_type : Constr.types; parameter_entry_universes : UState.named_universes_entry; parameter_entry_inline_code : Entries.inline; } type primitive_entry = { prim_entry_type : (Constr.types * UState.named_universes_entry) option; prim_entry_content : CPrimitives.op_or_type; } type symbol_entry = { symb_entry_type : Constr.types; symb_entry_unfold_fix: bool; symb_entry_universes : UState.named_universes_entry; } let default_univ_entry = UState.Monomorphic_entry Univ.ContextSet.empty let default_named_univ_entry = default_univ_entry, UnivNames.empty_binders (** [univsbody] are universe-constraints attached to the body-only, used in vio-delayed opaque constants and private poly universes *) let definition_entry_core ?(opaque=false) ?using ?(inline=false) ?types ?(univs=default_named_univ_entry) ?(eff=Evd.empty_side_effects) ?(univsbody=Univ.ContextSet.empty) body = { proof_entry_body = Future.from_val ((body,univsbody), eff); proof_entry_secctx = using; proof_entry_type = types; proof_entry_universes = univs; proof_entry_opaque = opaque; proof_entry_feedback = None; proof_entry_inline_code = inline} let definition_entry = definition_entry_core ?eff:None ?univsbody:None let parameter_entry ?inline ?(univs=default_named_univ_entry) typ = { parameter_entry_secctx = None; parameter_entry_type = typ; parameter_entry_universes = univs; parameter_entry_inline_code = inline; } let primitive_entry ?types c = { prim_entry_type = types; prim_entry_content = c; } let symbol_entry ?(univs=default_named_univ_entry) ~unfold_fix symb_entry_type = { symb_entry_universes = univs; symb_entry_unfold_fix = unfold_fix; symb_entry_type; } type constant_entry = | DefinitionEntry of proof_entry | ParameterEntry of parameter_entry | PrimitiveEntry of primitive_entry | SymbolEntry of symbol_entry let local_csts = Summary.ref ~name:"local-csts" Cset_env.empty let is_local_constant c = Cset_env.mem c !local_csts type constant_obj = { cst_kind : Decls.logical_kind; cst_locl : Locality.import_status; cst_warn : UserWarn.t option; } let load_constant i ((sp,kn), obj) = if Nametab.exists_cci sp then raise (DeclareUniv.AlreadyDeclared (None, Libnames.basename sp)); let con = Global.constant_of_delta_kn kn in Nametab.push ?user_warns:obj.cst_warn (Nametab.Until i) sp (GlobRef.ConstRef con); Dumpglob.add_constant_kind con obj.cst_kind; begin match obj.cst_locl with | Locality.ImportNeedQualified -> local_csts := Cset_env.add con !local_csts | Locality.ImportDefaultBehavior -> () end (* Opening means making the name without its module qualification available *) let open_constant i ((sp,kn), obj) = (* Never open a local definition *) match obj.cst_locl with | Locality.ImportNeedQualified -> () | Locality.ImportDefaultBehavior -> let con = Global.constant_of_delta_kn kn in Nametab.push (Nametab.Exactly i) sp (GlobRef.ConstRef con) let exists_name id = Decls.variable_exists id || Global.exists_objlabel (Label.of_id id) let check_exists id = if exists_name id then raise (DeclareUniv.AlreadyDeclared (None, id)) let cache_constant ((sp,kn), obj) = let kn = Global.constant_of_delta_kn kn in Nametab.push ?user_warns:obj.cst_warn (Nametab.Until 1) sp (GlobRef.ConstRef kn); Dumpglob.add_constant_kind kn obj.cst_kind let discharge_constant obj = Some obj let classify_constant cst = Libobject.Substitute let (objConstant : (Id.t * constant_obj) Libobject.Dyn.tag) = let open Libobject in declare_named_object_full { (default_object "CONSTANT") with cache_function = cache_constant; load_function = load_constant; open_function = simple_open open_constant; classify_function = classify_constant; subst_function = ident_subst_function; discharge_function = discharge_constant } let inConstant v = Libobject.Dyn.Easy.inj v objConstant let update_tables c = Impargs.declare_constant_implicits c; Notation.declare_ref_arguments_scope (GlobRef.ConstRef c) let register_constant kn kind ?user_warns local = let id = Label.to_id (Constant.label kn) in let o = inConstant (id, { cst_kind = kind; cst_locl = local; cst_warn = user_warns }) in let () = Lib.add_leaf o in update_tables kn let register_side_effect (c, body, role) = (* Register the body in the opaque table *) let () = match body with | None -> () | Some opaque -> Opaques.declare_private_opaque opaque in let () = register_constant c Decls.(IsProof Theorem) Locality.ImportDefaultBehavior in match role with | None -> () | Some (Evd.Schema (ind, kind)) -> DeclareScheme.declare_scheme kind (ind,c) let get_roles export eff = let map (c, body) = let role = try Some (Cmap.find c eff.Evd.seff_roles) with Not_found -> None in (c, body, role) in List.map map export let export_side_effects eff = let export = Global.export_private_constants eff.Evd.seff_private in let export = get_roles export eff in List.iter register_side_effect export let record_aux env s_ty s_bo = let open Environ in let in_ty = keep_hyps env s_ty in let v = String.concat " " (CList.map_filter (fun decl -> let id = NamedDecl.get_id decl in if List.exists (NamedDecl.get_id %> Id.equal id) in_ty then None else Some (Id.to_string id)) (keep_hyps env s_bo)) in Aux_file.record_in_aux "context_used" v let pure_definition_entry ?(opaque=false) ?(inline=false) ?types ?(univs=default_named_univ_entry) body = { proof_entry_body = ((body,Univ.ContextSet.empty), ()); proof_entry_secctx = None; proof_entry_type = types; proof_entry_universes = univs; proof_entry_opaque = opaque; proof_entry_feedback = None; proof_entry_inline_code = inline} let delayed_definition_entry ~opaque ?feedback_id ~using ~univs ?types body = { proof_entry_body = body ; proof_entry_secctx = using ; proof_entry_type = types ; proof_entry_universes = univs ; proof_entry_opaque = opaque ; proof_entry_feedback = feedback_id ; proof_entry_inline_code = false } let extract_monomorphic = function | UState.Monomorphic_entry ctx -> Entries.Monomorphic_entry, ctx | UState.Polymorphic_entry uctx -> Entries.Polymorphic_entry uctx, Univ.ContextSet.empty let cast_proof_entry e = let (body, ctx), () = e.proof_entry_body in let univ_entry = if Univ.ContextSet.is_empty ctx then fst (e.proof_entry_universes) else match fst (e.proof_entry_universes) with | UState.Monomorphic_entry ctx' -> (* This can actually happen, try compiling EqdepFacts for instance *) UState.Monomorphic_entry (Univ.ContextSet.union ctx' ctx) | UState.Polymorphic_entry _ -> CErrors.anomaly Pp.(str "Local universes in non-opaque polymorphic definition."); in let univ_entry, ctx = extract_monomorphic univ_entry in { Entries.const_entry_body = body; const_entry_secctx = e.proof_entry_secctx; const_entry_type = e.proof_entry_type; const_entry_universes = univ_entry; const_entry_inline_code = e.proof_entry_inline_code; }, ctx type ('a, 'b) effect_entry = | EffectEntry : (private_constants Opaques.const_entry_body, unit) effect_entry | PureEntry : (unit Entries.proof_output, Constr.constr) effect_entry let cast_opaque_proof_entry (type a b) (entry : (a, b) effect_entry) (e : a pproof_entry) : b Entries.opaque_entry * _ = let typ = match e.proof_entry_type with | None -> assert false | Some typ -> typ in let secctx = match e.proof_entry_secctx with | None -> let open Environ in let env = Global.env () in let hyp_typ, hyp_def = if List.is_empty (Environ.named_context env) then Id.Set.empty, Id.Set.empty else let ids_typ = global_vars_set env typ in let pf, env = match entry with | PureEntry -> let (pf, _), () = e.proof_entry_body in pf, env | EffectEntry -> let (pf, _), eff = Future.force e.proof_entry_body in let env = Safe_typing.push_private_constants env eff in pf, env in let vars = global_vars_set env pf in ids_typ, vars in let () = if Aux_file.recording () then record_aux env hyp_typ hyp_def in Environ.really_needed env (Id.Set.union hyp_typ hyp_def) | Some hyps -> hyps in let (body, (univ_entry, ctx) : b * _) = match entry with | PureEntry -> let (body, uctx), () = e.proof_entry_body in let univ_entry = match fst (e.proof_entry_universes) with | UState.Monomorphic_entry uctx' -> Entries.Monomorphic_entry, (Univ.ContextSet.union uctx uctx') | UState.Polymorphic_entry uctx' -> assert (Univ.ContextSet.is_empty uctx); Entries.Polymorphic_entry uctx', Univ.ContextSet.empty in body, univ_entry | EffectEntry -> (), extract_monomorphic (fst (e.proof_entry_universes)) in { Entries.opaque_entry_body = body; opaque_entry_secctx = secctx; opaque_entry_type = typ; opaque_entry_universes = univ_entry; }, ctx let feedback_axiom () = Feedback.(feedback AddedAxiom) let is_unsafe_typing_flags flags = let flags = Option.default (Global.typing_flags ()) flags in let open Declarations in not (flags.check_universes && flags.check_guarded && flags.check_positive) let make_ubinders uctx (univs, ubinders as u) = match univs with | UState.Polymorphic_entry _ -> u | UState.Monomorphic_entry _ -> (UState.Monomorphic_entry uctx, ubinders) let declare_constant_core ~name ~typing_flags cd = (* Logically define the constant and its subproofs, no libobject tampering *) let decl, unsafe, ubinders, delayed = match cd with | DefinitionEntry de -> (* We deal with side effects *) if not de.proof_entry_opaque then let body, eff = Future.force de.proof_entry_body in (* This globally defines the side-effects in the environment and registers their libobjects. *) let () = export_side_effects eff in let de = { de with proof_entry_body = body, () } in let e, ctx = cast_proof_entry de in let ubinders = make_ubinders ctx de.proof_entry_universes in (* We register the global universes after exporting side-effects, since the latter depend on the former. *) let () = Global.push_context_set ~strict:true ctx in let cd = Entries.DefinitionEntry e in ConstantEntry cd, false, ubinders, None else let map (body, eff) = body, eff.Evd.seff_private in let body = Future.chain de.proof_entry_body map in let feedback_id = de.proof_entry_feedback in let de = { de with proof_entry_body = body } in let cd, ctx = cast_opaque_proof_entry EffectEntry de in let ubinders = make_ubinders ctx de.proof_entry_universes in let () = Global.push_context_set ~strict:true ctx in OpaqueEntry cd, false, ubinders, Some (body, feedback_id) | ParameterEntry e -> let univ_entry, ctx = extract_monomorphic (fst e.parameter_entry_universes) in let ubinders = make_ubinders ctx e.parameter_entry_universes in let () = Global.push_context_set ~strict:true ctx in let e = { Entries.parameter_entry_secctx = e.parameter_entry_secctx; Entries.parameter_entry_type = e.parameter_entry_type; Entries.parameter_entry_universes = univ_entry; Entries.parameter_entry_inline_code = e.parameter_entry_inline_code; } in ConstantEntry (Entries.ParameterEntry e), not (Lib.is_modtype_strict()), ubinders, None | PrimitiveEntry e -> let typ, univ_entry, ctx = match e.prim_entry_type with | None -> None, (UState.Monomorphic_entry Univ.ContextSet.empty, UnivNames.empty_binders), Univ.ContextSet.empty | Some (typ, entry_univs) -> let univ_entry, ctx = extract_monomorphic (fst entry_univs) in Some (typ, univ_entry), entry_univs, ctx in let () = Global.push_context_set ~strict:true ctx in let e = { Entries.prim_entry_type = typ; Entries.prim_entry_content = e.prim_entry_content; } in let ubinders = make_ubinders ctx univ_entry in ConstantEntry (Entries.PrimitiveEntry e), false, ubinders, None | SymbolEntry { symb_entry_type=typ; symb_entry_unfold_fix=un_fix; symb_entry_universes=entry_univs } -> let univ_entry, ctx = extract_monomorphic (fst entry_univs) in let () = Global.push_context_set ~strict:true ctx in let e = { Entries.symb_entry_type = typ; Entries.symb_entry_unfold_fix = un_fix; Entries.symb_entry_universes = univ_entry; } in let ubinders = make_ubinders ctx entry_univs in ConstantEntry (Entries.SymbolEntry e), false, ubinders, None in let kn = Global.add_constant ?typing_flags name decl in let () = DeclareUniv.declare_univ_binders (GlobRef.ConstRef kn) ubinders in if unsafe || is_unsafe_typing_flags typing_flags then feedback_axiom(); kn, delayed let declare_constant ?(local = Locality.ImportDefaultBehavior) ~name ~kind ~typing_flags ?user_warns cd = let () = check_exists name in let kn, delayed = declare_constant_core ~typing_flags ~name cd in (* Register the libobjects attached to the constants *) let () = match delayed with | None -> () | Some (body, feedback_id) -> let open Declarations in match (Global.lookup_constant kn).const_body with | OpaqueDef o -> let (_, _, _, i) = Opaqueproof.repr o in Opaques.declare_defined_opaque ?feedback_id i body | Def _ | Undef _ | Primitive _ | Symbol _ -> assert false in let () = register_constant kn kind local ?user_warns in kn let declare_private_constant ?role ?(local = Locality.ImportDefaultBehavior) ~name ~kind de = let de, ctx = if not de.proof_entry_opaque then let de, ctx = cast_proof_entry de in DefinitionEff de, ctx else let de, ctx = cast_opaque_proof_entry PureEntry de in OpaqueEff de, ctx in let kn, eff = Global.add_private_constant name ctx de in let () = register_constant kn kind local in let seff_roles = match role with | None -> Cmap.empty | Some r -> Cmap.singleton kn r in let eff = { Evd.seff_private = eff; Evd.seff_roles; } in kn, eff let inline_private_constants ~uctx env ce = let body, eff = ce.proof_entry_body in let cb, ctx = Safe_typing.inline_private_constants env (body, eff.Evd.seff_private) in let uctx = UState.merge ~sideff:true Evd.univ_rigid uctx ctx in cb, uctx (** Declaration of section variables and local definitions *) type variable_declaration = | SectionLocalDef of { clearbody : bool; entry : proof_entry; } | SectionLocalAssum of { typ : Constr.types; impl : Glob_term.binding_kind; univs : UState.named_universes_entry; } (* This object is only for things which iterate over objects to find variables (only Prettyp.print_context AFAICT) *) let objVariable : Id.t Libobject.Dyn.tag = let open Libobject in declare_object_full { (default_object "VARIABLE") with classify_function = (fun _ -> Dispose)} let inVariable v = Libobject.Dyn.Easy.inj v objVariable let declare_variable ~name ~kind ~typing_flags d = (* Variables are distinguished by only short names *) if Decls.variable_exists name then raise (DeclareUniv.AlreadyDeclared (None, name)); let impl,opaque = match d with (* Fails if not well-typed *) | SectionLocalAssum {typ;impl;univs} -> let () = match fst univs with | UState.Monomorphic_entry uctx -> Global.push_context_set ~strict:true uctx | UState.Polymorphic_entry uctx -> Global.push_section_context uctx in let () = Global.push_named_assum (name,typ) in impl, true | SectionLocalDef { clearbody; entry = de } -> (* The body should already have been forced upstream because it is a section-local definition, but it's not enforced by typing *) let ((body, body_uctx), eff) = Future.force de.proof_entry_body in let () = export_side_effects eff in (* We must declare the universe constraints before type-checking the term. *) let () = match fst de.proof_entry_universes with | UState.Monomorphic_entry uctx -> Global.push_context_set ~strict:true (Univ.ContextSet.union uctx body_uctx) | UState.Polymorphic_entry uctx -> Global.push_section_context uctx; let mk_anon_names u = let qs, us = UVars.Instance.to_array u in Array.make (Array.length qs) Anonymous, Array.make (Array.length us) Anonymous in Global.push_section_context (UVars.UContext.of_context_set mk_anon_names Sorts.QVar.Set.empty body_uctx) in let opaque = de.proof_entry_opaque in let se = if opaque then let cname = Id.of_string (Id.to_string name ^ "_subproof") in let cname = Namegen.next_global_ident_away cname Id.Set.empty in let poly = match fst de.proof_entry_universes with | Monomorphic_entry _ -> false | Polymorphic_entry _ -> true in let de = { proof_entry_body = Future.from_val ((body, Univ.ContextSet.empty), Evd.empty_side_effects); proof_entry_secctx = None; (* de.proof_entry_secctx is NOT respected *) proof_entry_feedback = de.proof_entry_feedback; proof_entry_type = de.proof_entry_type; proof_entry_universes = UState.univ_entry ~poly UState.empty; proof_entry_opaque = true; proof_entry_inline_code = de.proof_entry_inline_code; } in let kn = declare_constant ~name:cname ~local:ImportNeedQualified ~kind:(IsProof Lemma) ~typing_flags (DefinitionEntry de) in { Entries.secdef_body = Constr.mkConstU (kn, UVars.Instance.empty); secdef_type = None; } else { Entries.secdef_body = body; secdef_type = de.proof_entry_type; } in let () = Global.push_named_def (name, se) in (* opaque implies clearbody, so we don't see useless "foo := foo_subproof" in the context *) Glob_term.Explicit, opaque || clearbody in Nametab.push (Nametab.Until 1) (Libnames.make_path DirPath.empty name) (GlobRef.VarRef name); Decls.(add_variable_data name {opaque;kind}); Lib.add_leaf (inVariable name); Impargs.declare_var_implicits ~impl name; Notation.declare_ref_arguments_scope (GlobRef.VarRef name) (* Declaration messages *) let pr_rank i = pr_nth (i+1) let fixpoint_message indexes l = Flags.if_verbose Feedback.msg_info (match l with | [] -> CErrors.anomaly (Pp.str "no recursive definition.") | [id] -> Id.print id ++ str " is recursively defined" ++ (match indexes with | Some [|i|] -> str " (guarded on "++pr_rank i++str " argument)" | _ -> mt ()) | l -> hov 0 (prlist_with_sep pr_comma Id.print l ++ spc () ++ str "are recursively defined" ++ match indexes with | Some a -> spc () ++ str "(guarded respectively on " ++ prvect_with_sep pr_comma pr_rank a ++ str " arguments)" | None -> mt ())) let cofixpoint_message l = Flags.if_verbose Feedback.msg_info (match l with | [] -> CErrors.anomaly (Pp.str "No corecursive definition.") | [id] -> Id.print id ++ str " is corecursively defined" | l -> hov 0 (prlist_with_sep pr_comma Id.print l ++ spc () ++ str "are corecursively defined")) let recursive_message isfix indexes l = (if isfix then fixpoint_message indexes else cofixpoint_message) l let definition_message id = Flags.if_verbose Feedback.msg_info (Id.print id ++ str " is defined") let assumption_message id = (* Changing "assumed" to "declared", "assuming" referring more to the type of the object than to the name of the object (see discussion on coqdev: "Chapter 4 of the Reference Manual", 8/10/2015) *) Flags.if_verbose Feedback.msg_info (Id.print id ++ str " is declared") module Internal = struct let pmap_entry_body ~f entry = { entry with proof_entry_body = f entry.proof_entry_body } let map_entry_body ~f entry = { entry with proof_entry_body = Future.chain entry.proof_entry_body f } let map_entry_type ~f entry = { entry with proof_entry_type = f entry.proof_entry_type } let set_opacity ~opaque entry = { entry with proof_entry_opaque = opaque } let rec shrink ctx sign c t accu = let open Constr in let open Vars in match ctx, sign with | [], [] -> (c, t, accu) | p :: ctx, decl :: sign -> if noccurn 1 c && noccurn 1 t then let c = subst1 mkProp c in let t = subst1 mkProp t in shrink ctx sign c t accu else let c = Term.mkLambda_or_LetIn p c in let t = Term.mkProd_or_LetIn p t in let accu = if Context.Rel.Declaration.is_local_assum p then mkVar (NamedDecl.get_id decl) :: accu else accu in shrink ctx sign c t accu | _ -> assert false let shrink_entry sign const = let typ = match const.proof_entry_type with | None -> assert false | Some t -> t in let ((body, uctx), eff) = const.proof_entry_body in let (ctx, body, typ) = Term.decompose_lambda_prod_n_decls (List.length sign) body typ in let (body, typ, args) = shrink ctx sign body typ [] in { const with proof_entry_body = ((body, uctx), eff) ; proof_entry_type = Some typ }, args module Constant = struct type t = constant_obj let tag = objConstant let kind obj = obj.cst_kind end let objVariable = objVariable let export_side_effects = export_side_effects end let declare_definition_scheme ~internal ~univs ~role ~name ?loc c = let kind = Decls.(IsDefinition Scheme) in let entry = pure_definition_entry ~univs c in let kn, eff = declare_private_constant ~role ~kind ~name entry in Dumpglob.dump_definition (CAst.make ?loc (Constant.label kn |> Label.to_id)) false "scheme"; let () = if internal then () else definition_message name in kn, eff (* Locality stuff *) let declare_entry_core ~name ?(scope=Locality.default_scope) ?(clearbody=false) ~kind ~typing_flags ~user_warns ?hook ~obls ~impargs ~uctx entry = let should_suggest = entry.proof_entry_opaque && not (List.is_empty (Global.named_context())) && Option.is_empty entry.proof_entry_secctx in let dref = match scope with | Locality.Discharge -> let () = declare_variable ~typing_flags ~name ~kind (SectionLocalDef {clearbody; entry}) in if should_suggest then Proof_using.suggest_variable (Global.env ()) name; Names.GlobRef.VarRef name | Locality.Global local -> assert (not clearbody); let kn = declare_constant ~name ~local ~kind ~typing_flags ?user_warns (DefinitionEntry entry) in let gr = Names.GlobRef.ConstRef kn in if should_suggest then Proof_using.suggest_constant (Global.env ()) kn; gr in let () = Impargs.maybe_declare_manual_implicits false dref impargs in let () = definition_message name in Hook.call ?hook { Hook.S.uctx; obls; scope; dref }; dref let declare_entry = declare_entry_core ~obls:[] (* Using processing *) let interp_proof_using_gen f env evd cinfo using = let cextract v (fixnames, terms) = let name, new_terms = f v in name :: fixnames, new_terms @ terms in let fixnames, terms = CList.fold_right cextract cinfo ([],[]) in Proof_using.definition_using env evd ~fixnames ~terms ~using let interp_proof_using_cinfo env evd cinfo using = let f { CInfo.name; typ; _ } = name, [EConstr.of_constr typ] in interp_proof_using_gen f env evd cinfo using let make_recursive_body env possible_guard rec_declaration = let indexes = Pretyping.search_guard env possible_guard rec_declaration in let body = match indexes with | Some indexes -> Constr.mkFix ((indexes,0), rec_declaration) | None -> Constr.mkCoFix (0, rec_declaration) in body, indexes let gather_mutual_using_data = List.fold_left2 (fun acc CInfo.{ name; typ; _ } body -> let typ, body = EConstr.(of_constr typ, of_constr body) in (name, [typ; body]) :: acc) [] let select_body i t = let open Constr in match Constr.kind t with | Fix ((nv,0),decls) -> mkFix ((nv,i),decls) | CoFix (0,decls) -> mkCoFix (i,decls) | _ -> assert false let make_mutual_bodies env ~typing_flags ~rec_declaration ~possible_guard = let env = Environ.update_typing_flags ?typing_flags env in let body, indexes = make_recursive_body env possible_guard rec_declaration in let vars = Vars.universes_of_constr body in let nfix = Array.length (pi1 rec_declaration) in let fixdecls = List.init nfix (fun i -> select_body i body) in vars, fixdecls, indexes let prepare_recursive_declaration fixitems (fixdefs,fixrs) = let fixnames = List.map (fun CInfo.{name} -> name) fixitems in let names = List.map2 (fun CInfo.{name} r -> Context.make_annot (Name name) r) fixitems fixrs in let fixtypes = List.map (fun CInfo.{typ} -> typ) fixitems in let defs = List.map (Vars.subst_vars (List.rev fixnames)) fixdefs in (Array.of_list names, Array.of_list fixtypes, Array.of_list defs) let declare_mutual_definitions ~info ~cinfo ~opaque ~uctx ~bodies ~possible_guard ?using () = let { Info.poly; udecl; scope; clearbody; kind; typing_flags; user_warns; ntns; _ } = info in let env = Global.env() in let rec_declaration = prepare_recursive_declaration cinfo bodies in let vars, fixdecls, indexes = make_mutual_bodies env ~typing_flags ~rec_declaration ~possible_guard in let uctx = UState.restrict uctx vars in let univs = UState.check_univ_decl ~poly uctx udecl in let evd = Evd.from_env env in let using = Option.map (fun using -> let cinfos = gather_mutual_using_data cinfo fixdecls in let f x = x in interp_proof_using_gen f env evd cinfos using) using in let csts = CList.map2 (fun CInfo.{ name; typ; impargs } body -> let entry = definition_entry ~opaque ~types:typ ~univs ?using body in declare_entry ~name ~scope ~clearbody ~kind ~impargs ~uctx ~typing_flags ~user_warns entry) cinfo fixdecls in let isfix = Option.has_some indexes in let fixnames = List.map (fun { CInfo.name } -> name) cinfo in recursive_message isfix indexes fixnames; List.iter (Metasyntax.add_notation_interpretation ~local:(scope=Locality.Discharge) (Global.env())) ntns; csts let warn_let_as_axiom = CWarnings.create ~name:"let-as-axiom" ~category:CWarnings.CoreCategories.vernacular Pp.(fun id -> strbrk "Let definition" ++ spc () ++ Names.Id.print id ++ spc () ++ strbrk "declared as an axiom.") (* Declare an assumption when not in a section: Parameter/Axiom but also Variable/Hypothesis seen as Local Parameter/Axiom *) let declare_parameter ~name ~scope ~hook ~impargs ~uctx pe = let local = match scope with | Locality.Discharge -> warn_let_as_axiom name; Locality.ImportNeedQualified | Locality.Global local -> local in let kind = Decls.(IsAssumption Conjectural) in let decl = ParameterEntry pe in let kn = declare_constant ~name ~local ~kind ~typing_flags:None decl in let dref = Names.GlobRef.ConstRef kn in let () = Impargs.maybe_declare_manual_implicits false dref impargs in let () = assumption_message name in let () = Hook.(call ?hook { S.uctx; obls = []; scope; dref}) in dref (* Preparing proof entries *) let error_unresolved_evars env sigma t evars = let pr_unresolved_evar e = hov 2 (str"- " ++ Printer.pr_existential_key env sigma e ++ str ": " ++ Himsg.explain_pretype_error env sigma (Pretype_errors.UnsolvableImplicit (e,None))) in CErrors.user_err (hov 0 begin str "The following term contains unresolved implicit arguments:"++ fnl () ++ str " " ++ Printer.pr_econstr_env env sigma t ++ fnl () ++ str "More precisely: " ++ fnl () ++ v 0 (prlist_with_sep cut pr_unresolved_evar (Evar.Set.elements evars)) end) let check_evars_are_solved env sigma t = let evars = Evarutil.undefined_evars_of_term sigma t in if not (Evar.Set.is_empty evars) then error_unresolved_evars env sigma t evars let prepare_definition ~info ~opaque ?using ~name ~body ~typ sigma = let { Info.poly; udecl; inline; _ } = info in let env = Global.env () in Option.iter (check_evars_are_solved env sigma) typ; check_evars_are_solved env sigma body; let sigma, (body, types) = Evarutil.finalize sigma (fun nf -> nf body, Option.map nf typ) in let univs = Evd.check_univ_decl ~poly sigma udecl in let using = let f (name, body, typ) = name, Option.List.flatten [ Some (EConstr.of_constr body); typ ] in Option.map (interp_proof_using_gen f env sigma [name, body, typ]) using in let entry = definition_entry ~opaque ?using ~inline ?types ~univs body in let uctx = Evd.evar_universe_context sigma in entry, uctx let declare_definition_core ~info ~cinfo ~opaque ~obls ~body ?using sigma = let { CInfo.name; impargs; typ; _ } = cinfo in let entry, uctx = prepare_definition ~info ~opaque ?using ~name ~body ~typ sigma in let { Info.scope; clearbody; kind; hook; typing_flags; user_warns; ntns; _ } = info in let gref = declare_entry_core ~name ~scope ~clearbody ~kind ~impargs ~typing_flags ~user_warns ~obls ?hook ~uctx entry in List.iter (Metasyntax.add_notation_interpretation ~local:(info.scope=Locality.Discharge) (Global.env ())) ntns; gref, uctx let declare_definition ~info ~cinfo ~opaque ~body ?using sigma = declare_definition_core ~obls:[] ~info ~cinfo ~opaque ~body ?using sigma |> fst let prepare_obligations ~name ?types ~body env sigma = let env = Global.env () in let types = match types with | Some t -> t | None -> Retyping.get_type_of env sigma body in let sigma, (body, types) = Evarutil.finalize ~abort_on_undefined_evars:false sigma (fun nf -> nf body, nf types) in RetrieveObl.check_evars env sigma; let body, types = EConstr.(of_constr body, of_constr types) in let obls, (_, evmap), body, cty = RetrieveObl.retrieve_obligations env name sigma 0 body types in let uctx = Evd.evar_universe_context sigma in body, cty, uctx, evmap, obls let prepare_parameter ~poly ~udecl ~types sigma = let env = Global.env () in Pretyping.check_evars_are_solved ~program_mode:false env sigma; let sigma, typ = Evarutil.finalize ~abort_on_undefined_evars:true sigma (fun nf -> nf types) in let univs = Evd.check_univ_decl ~poly sigma udecl in let pe = { parameter_entry_secctx = None; parameter_entry_type = typ; parameter_entry_universes = univs; parameter_entry_inline_code = None; } in sigma, pe type progress = Remain of int | Dependent | Defined of GlobRef.t module Obls_ = struct open Constr type 'a obligation_body = DefinedObl of 'a | TermObl of constr module Obligation = struct type t = { obl_name : Id.t ; obl_type : types ; obl_location : Evar_kinds.t Loc.located ; obl_body : pconstant obligation_body option ; obl_status : bool * Evar_kinds.obligation_definition_status ; obl_deps : Int.Set.t ; obl_tac : unit Proofview.tactic option } let set_type ~typ obl = {obl with obl_type = typ} end type obligations = {obls : Obligation.t array; remaining : int} type fixpoint_kind = IsFixpoint of lident option list | IsCoFixpoint module ProgramDecl = struct type 'a t = { prg_cinfo : constr CInfo.t ; prg_info : Info.t ; prg_using : Vernacexpr.section_subset_expr option ; prg_opaque : bool ; prg_hook : 'a option ; prg_body : constr ; prg_uctx : UState.t ; prg_obligations : obligations ; prg_deps : Id.t list ; prg_possible_guard : Pretyping.possible_guard option (* None = not recursive *) ; prg_reduce : constr -> constr } open Obligation let make ~info ~cinfo ~opaque ~reduce ~deps ~uctx ~body ~possible_guard ?obl_hook ?using obls = let obls', body = match body with | None -> assert (Int.equal (Array.length obls) 0); let n = Nameops.add_suffix cinfo.CInfo.name "_obligation" in ( [| { obl_name = n ; obl_body = None ; obl_location = Loc.tag Evar_kinds.InternalHole ; obl_type = cinfo.CInfo.typ ; obl_status = (false, Evar_kinds.Expand) ; obl_deps = Int.Set.empty ; obl_tac = None } |] , mkVar n ) | Some b -> ( Array.mapi (fun i (n, t, l, o, d, tac) -> { obl_name = n ; obl_body = None ; obl_location = l ; obl_type = t ; obl_status = o ; obl_deps = d ; obl_tac = tac }) obls , b ) in let prg_uctx = UState.make_flexible_nonalgebraic uctx in { prg_cinfo = { cinfo with CInfo.typ = reduce cinfo.CInfo.typ } ; prg_info = info ; prg_using = using ; prg_hook = obl_hook ; prg_opaque = opaque ; prg_body = body ; prg_uctx ; prg_obligations = {obls = obls'; remaining = Array.length obls'} ; prg_deps = deps ; prg_possible_guard = possible_guard ; prg_reduce = reduce } let show prg = let { CInfo.name; typ; _ } = prg.prg_cinfo in let env = Global.env () in let sigma = Evd.from_env env in Id.print name ++ spc () ++ str ":" ++ spc () ++ Printer.pr_constr_env env sigma typ ++ spc () ++ str ":=" ++ fnl () ++ Printer.pr_constr_env env sigma prg.prg_body module Internal = struct let get_name prg = prg.prg_cinfo.CInfo.name let get_uctx prg = prg.prg_uctx let set_uctx ~uctx prg = {prg with prg_uctx = uctx} let get_poly prg = prg.prg_info.Info.poly let get_obligations prg = prg.prg_obligations let get_using prg = prg.prg_using end end open Obligation open ProgramDecl (* Saving an obligation *) (* XXX: Is this the right place for this? *) let it_mkLambda_or_LetIn_or_clean t ctx = let open Context.Rel.Declaration in let fold t decl = if is_local_assum decl then Term.mkLambda_or_LetIn decl t else if Vars.noccurn 1 t then Vars.subst1 mkProp t else Term.mkLambda_or_LetIn decl t in Context.Rel.fold_inside fold ctx ~init:t (* XXX: Is this the right place for this? *) let decompose_lam_prod c ty = let open Context.Rel.Declaration in let rec aux ctx c ty = match (Constr.kind c, Constr.kind ty) with | LetIn (x, b, t, c), LetIn (x', b', t', ty) when Constr.equal b b' && Constr.equal t t' -> let ctx' = Context.Rel.add (LocalDef (x, b', t')) ctx in aux ctx' c ty | _, LetIn (x', b', t', ty) -> let ctx' = Context.Rel.add (LocalDef (x', b', t')) ctx in aux ctx' (lift 1 c) ty | LetIn (x, b, t, c), _ -> let ctx' = Context.Rel.add (LocalDef (x, b, t)) ctx in aux ctx' c (lift 1 ty) | Lambda (x, b, t), Prod (x', b', t') (* By invariant, must be convertible *) -> let ctx' = Context.Rel.add (LocalAssum (x, b')) ctx in aux ctx' t t' | Cast (c, _, _), _ -> aux ctx c ty | _, _ -> (ctx, c, ty) in aux Context.Rel.empty c ty (* XXX: What's the relation of this with Abstract.shrink ? *) let shrink_body c ty = let ctx, b, ty = match ty with | None -> let ctx, b = Term.decompose_lambda_decls c in (ctx, b, None) | Some ty -> let ctx, b, ty = decompose_lam_prod c ty in (ctx, b, Some ty) in let b', ty', n, args = List.fold_left (fun (b, ty, i, args) decl -> if Vars.noccurn 1 b && Option.cata (Vars.noccurn 1) true ty then (Vars.subst1 mkProp b, Option.map (Vars.subst1 mkProp) ty, succ i, args) else let open Context.Rel.Declaration in let args = if is_local_assum decl then mkRel i :: args else args in ( Term.mkLambda_or_LetIn decl b , Option.map (Term.mkProd_or_LetIn decl) ty , succ i , args )) (b, ty, 1, []) ctx in (ctx, b', ty', Array.of_list args) (***********************************************************************) (* Saving an obligation *) (***********************************************************************) let universes_of_decl body typ = let univs_typ = match typ with None -> Univ.Level.Set.empty | Some ty -> Vars.universes_of_constr ty in let univs_body = Vars.universes_of_constr body in Univ.Level.Set.union univs_body univs_typ let current_obligation_uctx prg uctx vars = let uctx = UState.restrict uctx vars in if prg.prg_info.Info.poly then uctx else (* We let the first obligation declare the monomorphic universe context of the main constant (goes together with update_global_obligation_uctx) *) UState.union prg.prg_uctx uctx let update_global_obligation_uctx prg uctx = let uctx = if prg.prg_info.Info.poly then (* Accumulate the polymorphic constraints *) UState.union prg.prg_uctx uctx else (* The monomorphic universe context of the main constant has been declared by the first obligation; it is now in the global env and we now remove it for the further declarations *) UState.Internal.reboot (Global.env ()) prg.prg_uctx in ProgramDecl.Internal.set_uctx ~uctx prg let instance_of_univs = function | UState.Polymorphic_entry uctx, _ -> UVars.UContext.instance uctx | UState.Monomorphic_entry _, _ -> UVars.Instance.empty let declare_obligation prg obl ~uctx ~types ~body = let body = prg.prg_reduce body in let types = Option.map prg.prg_reduce types in match obl.obl_status with | _, Evar_kinds.Expand -> let prg_uctx = UState.union prg.prg_uctx uctx in let prg = ProgramDecl.Internal.set_uctx ~uctx:prg_uctx prg in (prg, {obl with obl_body = Some (TermObl body)}, []) | force, Evar_kinds.Define opaque -> let opaque = (not force) && opaque in let poly = prg.prg_info.Info.poly in let ctx, body, ty, args = if not poly then shrink_body body types else ([], body, types, [||]) in let uctx' = current_obligation_uctx prg uctx (universes_of_decl body types) in let univs = UState.univ_entry ~poly uctx' in let inst = instance_of_univs univs in let ce = definition_entry ?types:ty ~opaque ~univs body in (* ppedrot: seems legit to have obligations as local *) let constant = declare_constant ~name:obl.obl_name ~typing_flags:prg.prg_info.Info.typing_flags ~local:Locality.ImportNeedQualified ~kind:Decls.(IsProof Property) (DefinitionEntry ce) in definition_message obl.obl_name; let prg = update_global_obligation_uctx prg uctx in let body = if poly then DefinedObl (constant, inst) else let const = mkConstU (constant, inst) in TermObl (it_mkLambda_or_LetIn_or_clean (mkApp (const, args)) ctx) in (prg, {obl with obl_body = Some body}, [GlobRef.ConstRef constant]) (* Updating the obligation meta-info on close *) let not_transp_msg = Pp.( str "Obligation should be transparent but was declared opaque." ++ spc () ++ str "Use 'Defined' instead.") let err_not_transp () = CErrors.user_err not_transp_msg module ProgMap = Id.Map module State = struct type t = prg_hook ProgramDecl.t CEphemeron.key ProgMap.t and prg_hook = PrgHook of t Hook.g let call_prg_hook { prg_hook=hook } x pm = let hook = Option.map (fun (PrgHook h) -> h) hook in Hook.call_g ?hook x pm let empty = ProgMap.empty let pending pm = ProgMap.filter (fun _ v -> (CEphemeron.get v).prg_obligations.remaining > 0) pm let num_pending pm = pending pm |> ProgMap.cardinal let first_pending pm = pending pm |> ProgMap.choose_opt |> Option.map (fun (_, v) -> CEphemeron.get v) let get_unique_open_prog pm name : (_, Id.t list) result = match name with | Some n -> Option.cata (fun p -> Ok (CEphemeron.get p)) (Error []) (ProgMap.find_opt n pm) | None -> ( let n = num_pending pm in match n with | 0 -> Error [] | 1 -> Option.cata (fun p -> Ok p) (Error []) (first_pending pm) | _ -> let progs = Id.Set.elements (ProgMap.domain pm) in Error progs ) let add t key prg = ProgMap.add key (CEphemeron.create prg) t let fold t ~f ~init = let f k v acc = f k (CEphemeron.get v) acc in ProgMap.fold f t init let all pm = ProgMap.bindings pm |> List.map (fun (_,v) -> CEphemeron.get v) let find m t = ProgMap.find_opt t m |> Option.map CEphemeron.get module View = struct module Obl = struct type t = { name : Id.t ; loc : Loc.t option ; status : bool * Evar_kinds.obligation_definition_status ; solved : bool } let make (o : Obligation.t) = let { obl_name; obl_location; obl_status; obl_body; _ } = o in { name = obl_name ; loc = fst obl_location ; status = obl_status ; solved = Option.has_some obl_body } end type t = { opaque : bool ; remaining : int ; obligations : Obl.t array } let make { prg_opaque; prg_obligations; _ } = { opaque = prg_opaque ; remaining = prg_obligations.remaining ; obligations = Array.map Obl.make prg_obligations.obls } let make eph = CEphemeron.get eph |> make end let view s = Id.Map.map View.make s end (* In all cases, the use of the map is read-only so we don't expose the ref *) let map_non_empty_keys is_empty m = ProgMap.fold (fun k prg l -> if is_empty prg then l else k :: l) m [] let check_solved_obligations is_empty ~pm ~what_for : unit = if not (ProgMap.is_empty pm) then let keys = map_non_empty_keys is_empty pm in let have_string = if Int.equal (List.length keys) 1 then " has " else " have " in CErrors.user_err Pp.( str "Unsolved obligations when closing " ++ what_for ++ str ":" ++ spc () ++ prlist_with_sep spc (fun x -> Id.print x) keys ++ str have_string ++ str "unsolved obligations." ) let map_replace k v m = ProgMap.add k (CEphemeron.create v) (ProgMap.remove k m) let progmap_remove pm prg = ProgMap.remove prg.prg_cinfo.CInfo.name pm let progmap_replace prg' pm = map_replace prg'.prg_cinfo.CInfo.name prg' pm let obligations_solved prg = Int.equal prg.prg_obligations.remaining 0 let obligations_message rem = Format.asprintf "%s %s remaining" (if rem > 0 then string_of_int rem else "No more") (CString.plural rem "obligation") |> Pp.str |> Flags.if_verbose Feedback.msg_info let get_obligation_body expand obl = match obl.obl_body with | None -> None | Some c -> ( if expand && snd obl.obl_status == Evar_kinds.Expand then match c with | DefinedObl pc -> Some (Environ.constant_value_in (Global.env ()) pc) | TermObl c -> Some c else match c with DefinedObl pc -> Some (mkConstU pc) | TermObl c -> Some c ) let obl_substitution expand obls deps = Int.Set.fold (fun x acc -> let xobl = obls.(x) in match get_obligation_body expand xobl with | None -> acc | Some oblb -> (xobl.obl_name, (xobl.obl_type, oblb)) :: acc) deps [] let rec intset_to = function | -1 -> Int.Set.empty | n -> Int.Set.add n (intset_to (pred n)) let obligation_substitution expand prg = let obls = prg.prg_obligations.obls in let ints = intset_to (pred (Array.length obls)) in obl_substitution expand obls ints let subst_prog subst prg = let subst' = List.map (fun (n, (_, b)) -> (n, b)) subst in ( Vars.replace_vars subst' prg.prg_body , Vars.replace_vars subst' (* Termops.refresh_universes *) prg.prg_cinfo.CInfo.typ ) let declare_definition ~pm prg = let varsubst = obligation_substitution true prg in let sigma = Evd.from_ctx prg.prg_uctx in let body, types = subst_prog varsubst prg in let body, types = EConstr.(of_constr body, of_constr types) in let cinfo = { prg.prg_cinfo with CInfo.typ = Some types } in let name, info, opaque, using = prg.prg_cinfo.CInfo.name, prg.prg_info, prg.prg_opaque, prg.prg_using in let obls = List.map (fun (id, (_, c)) -> (id, c)) varsubst in (* XXX: This is doing normalization twice *) let kn, uctx = declare_definition_core ~cinfo ~info ~obls ~body ~opaque ?using sigma in (* XXX: We call the obligation hook here, by consistency with the previous imperative behaviour, however I'm not sure this is right *) let pm = State.call_prg_hook prg { Hook.S.uctx; obls; scope = prg.prg_info.Info.scope; dref = kn} pm in let pm = progmap_remove pm prg in pm, kn let declare_mutual_definitions ~pm l = let first = List.hd l in let defobl x = let oblsubst = obligation_substitution true x in let subs, typ = subst_prog oblsubst x in let env = Global.env () in let sigma = Evd.from_ctx x.prg_uctx in let r = Retyping.relevance_of_type env sigma (EConstr.of_constr typ) in let term = EConstr.of_constr subs in let typ = EConstr.of_constr typ in let term = EConstr.to_constr sigma term in let typ = EConstr.to_constr sigma typ in let r = EConstr.ERelevance.kind sigma r in let def = (x.prg_reduce term, r, x.prg_reduce typ, x.prg_cinfo.CInfo.impargs) in let oblsubst = List.map (fun (id, (_, c)) -> (id, c)) oblsubst in (def, oblsubst) in let defs, obls = List.split (List.map defobl l) in let obls = List.flatten obls in let fixitems = List.map2 (fun (d, relevance, typ, impargs) name -> CInfo.make ~name ~typ ~impargs ()) defs first.prg_deps in let fixdefs, fixrs, fixtypes, _ = List.split4 defs in let possible_guard = Option.get first.prg_possible_guard in (* Declare the recursive definitions *) let kns = declare_mutual_definitions ~info:first.prg_info ~uctx:first.prg_uctx ~bodies:(fixdefs, fixrs) ~possible_guard ~opaque:first.prg_opaque ~cinfo:fixitems ?using:first.prg_using () in (* Only for the first constant *) let dref = List.hd kns in let scope = first.prg_info.Info.scope in let s_hook = {Hook.S.uctx = first.prg_uctx; obls; scope; dref} in Hook.call ?hook:first.prg_info.Info.hook s_hook; (* XXX: We call the obligation hook here, by consistency with the previous imperative behaviour, however I'm not sure this is right *) let pm = State.call_prg_hook first s_hook pm in let pm = List.fold_left progmap_remove pm l in pm, dref let update_obls ~pm prg obls rem = let prg_obligations = {obls; remaining = rem} in let prg' = {prg with prg_obligations} in let pm = progmap_replace prg' pm in obligations_message rem; if rem > 0 then pm, Remain rem else match prg'.prg_deps with | [] -> let pm, kn = declare_definition ~pm prg' in pm, Defined kn | l -> let progs = List.map (fun x -> CEphemeron.get (ProgMap.find x pm)) prg'.prg_deps in if List.for_all (fun x -> obligations_solved x) progs then let pm, kn = declare_mutual_definitions ~pm progs in pm, Defined kn else pm, Dependent let dependencies obls n = let res = ref Int.Set.empty in Array.iteri (fun i obl -> if (not (Int.equal i n)) && Int.Set.mem n obl.obl_deps then res := Int.Set.add i !res) obls; !res let update_program_decl_on_defined ~pm prg obls num obl rem ~auto = let obls = Array.copy obls in let () = obls.(num) <- obl in let pm, _progress = update_obls ~pm prg obls (pred rem) in let pm = if pred rem > 0 then let deps = dependencies obls num in if not (Int.Set.is_empty deps) then let pm, _progress = auto ~pm (Some prg.prg_cinfo.CInfo.name) deps None in pm else pm else pm in pm type obligation_resolver = pm:State.t -> Id.t option -> Int.Set.t -> unit Proofview.tactic option -> State.t * progress type obl_check_final = AllFinal | SpecificFinal of Id.t type obligation_qed_info = { name : Id.t; num : int; auto : obligation_resolver; check_final : obl_check_final option; } let not_final_obligation n = let msg = match n with | AllFinal -> str "This obligation is not final." | SpecificFinal n -> str "This obligation is not final for program " ++ Id.print n ++ str "." in CErrors.user_err msg let do_check_final ~pm = function | None -> () | Some check_final -> let final = match check_final with | AllFinal -> begin match State.first_pending pm with | Some _ -> false | None -> true end | SpecificFinal n -> begin match State.get_unique_open_prog pm (Some n) with | Error _ -> true | Ok _ -> false end in if not final then not_final_obligation check_final let obligation_terminator ~pm ~entry ~uctx ~oinfo:{name; num; auto; check_final} = let env = Global.env () in let ty = entry.proof_entry_type in let body, uctx = inline_private_constants ~uctx env entry in let sigma = Evd.from_ctx uctx in Inductiveops.control_only_guard (Global.env ()) sigma (EConstr.of_constr body); (* Declare the obligation ourselves and drop the hook *) let prg = Option.get (State.find pm name) in let {obls; remaining = rem} = prg.prg_obligations in let obl = obls.(num) in let status = match (obl.obl_status, entry.proof_entry_opaque) with | (_, Evar_kinds.Expand), true -> err_not_transp () | (true, _), true -> err_not_transp () | (false, _), true -> Evar_kinds.Define true | (_, Evar_kinds.Define true), false -> Evar_kinds.Define false | (_, status), false -> status in let obl = {obl with obl_status = (false, status)} in let prg, obl, cst = declare_obligation prg obl ~body ~types:ty ~uctx in let pm = update_program_decl_on_defined ~pm prg obls num obl rem ~auto in let () = do_check_final ~pm check_final in pm, cst (* Similar to the terminator but for the admitted path; this assumes the admitted constant was already declared. FIXME: There is duplication of this code with obligation_terminator and Obligations.admit_obligations *) let obligation_admitted_terminator ~pm typ {name; num; auto; check_final} declare_fun uctx = let prg = Option.get (State.find pm name) in let {obls; remaining = rem} = prg.prg_obligations in let obl = obls.(num) in let () = match obl.obl_status with | true, Evar_kinds.Expand | true, Evar_kinds.Define true -> err_not_transp () | _ -> () in let uctx' = current_obligation_uctx prg uctx (Vars.universes_of_constr typ) in let sec_vars = None in (* Not using "using" for obligations *) let univs = UState.univ_entry ~poly:prg.prg_info.Info.poly uctx' in let cst = declare_fun ~uctx ~sec_vars ~univs in let inst = instance_of_univs univs in let obl = {obl with obl_body = Some (DefinedObl (cst, inst))} in let prg = update_global_obligation_uctx prg uctx in let pm = update_program_decl_on_defined ~pm prg obls num obl rem ~auto in let () = do_check_final ~pm check_final in pm end (************************************************************************) (* Handling of interactive proofs *) (************************************************************************) module Proof_ending = struct type t = | Regular | End_obligation of Obls_.obligation_qed_info | End_derive of { f : Id.t; name : Id.t } | End_equations of { hook : pm:Obls_.State.t -> Constant.t list -> Evd.evar_map -> Obls_.State.t ; i : Id.t ; types : (Environ.env * Evar.t * Evd.undefined Evd.evar_info * EConstr.named_context * Evd.econstr) list ; sigma : Evd.evar_map } end (* Alias *) module Proof = struct module Proof_info = struct type t = { cinfo : Constr.t CInfo.t list (** cinfo contains each individual constant info in a mutual decl *) ; info : Info.t ; proof_ending : Proof_ending.t CEphemeron.key (* This could be improved and the CEphemeron removed *) ; possible_guard : Pretyping.possible_guard option (* None = not recursive *) (** thms and compute guard are specific only to start_definition + regular terminator, so we could make this per-proof kind *) } let make ~cinfo ~info ?possible_guard ?(proof_ending=Proof_ending.Regular) () = { cinfo ; info ; possible_guard ; proof_ending = CEphemeron.create proof_ending } end type t = { endline_tactic : Genarg.glob_generic_argument option ; using : Id.Set.t option ; proof : Proof.t ; initial_euctx : UState.t (** The initial universe context (for the statement) *) ; pinfo : Proof_info.t } (*** Proof Global manipulation ***) let get ps = ps.proof let get_name ps = (Proof.data ps.proof).Proof.name let get_initial_euctx ps = ps.initial_euctx let fold ~f p = f p.proof let map ~f p = { p with proof = f p.proof } let map_fold ~f p = let proof, res = f p.proof in { p with proof }, res let map_fold_endline ~f ps = let et = match ps.endline_tactic with | None -> Proofview.tclUNIT () | Some tac -> let open Geninterp in let {Proof.poly} = Proof.data ps.proof in let ist = { lfun = Id.Map.empty; poly; extra = TacStore.empty } in let Genarg.GenArg (Genarg.Glbwit tag, tac) = tac in let tac = Geninterp.interp tag ist tac in Ftactic.run tac (fun _ -> Proofview.tclUNIT ()) in let (newpr,ret) = f et ps.proof in let ps = { ps with proof = newpr } in ps, ret let compact pf = map ~f:Proof.compact pf (* Sets the tactic to be used when a tactic line is closed with [...] *) let set_endline_tactic tac ps = { ps with endline_tactic = Some tac } let initialize_named_context_for_proof () = let sign = Global.named_context () in List.fold_right (fun d signv -> let id = NamedDecl.get_id d in let d = if Decls.variable_opacity id then NamedDecl.drop_body d else d in Environ.push_named_context_val d signv) sign Environ.empty_named_context_val let start_proof_core ~name ~typ ~pinfo ?(sign=initialize_named_context_for_proof ()) ?using sigma = (* In ?sign, we remove the bodies of variables in the named context marked "opaque", this is a hack tho, see #10446, and build_constant_by_tactic uses a different method that would break program_inference_hook *) let { Proof_info.info = { Info.poly; typing_flags; _ }; _ } = pinfo in let goals = [Global.env_of_context sign, typ] in let proof = Proof.start ~name ~poly ?typing_flags sigma goals in let initial_euctx = Evd.evar_universe_context Proof.((data proof).sigma) in { proof ; endline_tactic = None ; using ; initial_euctx ; pinfo } (** [start_proof ~info ~cinfo sigma] starts a proof of [cinfo]. The proof is started in the evar map [sigma] (which can typically contain universe constraints) *) let start_core ~info ~cinfo ?proof_ending ?using sigma = let { CInfo.name; typ; _ } = cinfo in check_exists name; let cinfo = [{ cinfo with CInfo.typ = EConstr.Unsafe.to_constr cinfo.CInfo.typ }] in let pinfo = Proof_info.make ~cinfo ~info ?proof_ending () in start_proof_core ~name ~typ ~pinfo ?sign:None ?using sigma let start = start_core ?proof_ending:None let start_dependent ~info ~name ~proof_ending goals = let { Info.poly; typing_flags; _ } = info in let proof = Proof.dependent_start ~name ~poly ?typing_flags goals in let initial_euctx = Evd.evar_universe_context Proof.((data proof).sigma) in let cinfo = [] in let pinfo = Proof_info.make ~info ~cinfo ~proof_ending () in { proof ; endline_tactic = None ; using = None ; initial_euctx ; pinfo } let start_derive ~f ~name ~info goals = let proof_ending = Proof_ending.End_derive {f; name} in start_dependent ~info ~name ~proof_ending goals let start_equations ~name ~info ~hook ~types sigma goals = let proof_ending = Proof_ending.End_equations {hook; i=name; types; sigma} in start_dependent ~name ~info ~proof_ending goals let rec_tac_initializer Pretyping.{possibly_cofix; possible_fix_indices} thms = if possibly_cofix then match List.map (fun { CInfo.name; typ } -> name, (EConstr.of_constr typ)) thms with | (id,_)::l -> Tactics.mutual_cofix id l 0 | _ -> assert false else (* nl is set to its maximal possible value for the purpose of mutual_fix; it will then be recomputed at Qed-time *) let nl = List.map succ (List.map List.last possible_fix_indices) in match List.map2 (fun { CInfo.name; typ } n -> (name, n, (EConstr.of_constr typ))) thms nl with | (id,n,_)::l -> Tactics.mutual_fix id n l 0 | _ -> assert false let start_definition ~info ~cinfo ?using sigma = let { CInfo.name; typ; args } = cinfo in let init_tac = Tactics.auto_intros_tac args in let pinfo = Proof_info.make ~cinfo:[cinfo] ~info () in let env = Global.env () in let using = Option.map (interp_proof_using_cinfo env sigma [cinfo]) using in let lemma = start_proof_core ~name ~typ:(EConstr.of_constr typ) ~pinfo ?sign:None ?using sigma in map lemma ~f:(fun p -> pi1 @@ Proof.run_tactic Global.(env ()) init_tac p) let start_mutual_definitions ~info ~cinfo ?bodies ~possible_guard ?using sigma = let intro_tac { CInfo.args; _ } = Tactics.auto_intros_tac args in let init_tac = let rec_tac = rec_tac_initializer possible_guard cinfo in let term_tac = match bodies with | None -> List.map intro_tac cinfo | Some bodies -> (* This is the case for hybrid proof mode / definition fixpoint, where terms for some constants are given with := *) let tacl = List.map (Option.cata (EConstr.of_constr %> Tactics.exact_no_check) Tacticals.tclIDTAC) bodies in List.map2 (fun tac thm -> Tacticals.tclTHEN tac (intro_tac thm)) tacl cinfo in Tacticals.tclTHENS rec_tac term_tac in match cinfo with | [] -> CErrors.anomaly (Pp.str "No proof to start.") | { CInfo.name; typ; _} :: thms -> let pinfo = Proof_info.make ~cinfo ~info ~possible_guard () in (* start_lemma has the responsibility to add (name, impargs, typ) to thms, once Info.t is more refined this won't be necessary *) let typ = EConstr.of_constr typ in let env = Global.env () in let using = Option.map (interp_proof_using_cinfo env sigma cinfo) using in let lemma = start_proof_core ~name ~typ ~pinfo ?using sigma in let lemma = map lemma ~f:(fun p -> pi1 @@ Proof.run_tactic Global.(env ()) init_tac p) in let () = (* Temporary declaration of notations for the time of the proofs *) let ntn_env = (* We simulate the goal context in which the fixpoint bodies have to be proved (exact relevance does not matter) *) let make_decl CInfo.{name; typ} = Context.Named.Declaration.LocalAssum (Context.annotR name, typ) in Environ.push_named_context (List.map make_decl cinfo) (Global.env()) in List.iter (Metasyntax.add_notation_interpretation ~local:(info.scope=Locality.Discharge) ntn_env) info.ntns in lemma let get_used_variables pf = pf.using let get_universe_decl pf = pf.pinfo.Proof_info.info.Info.udecl let definition_scope ps = ps.pinfo.info.scope let set_used_variables ps ~using = let open Context.Named.Declaration in let env = Global.env () in let ctx = Environ.keep_hyps env using in let ctx_set = List.fold_right Id.Set.add (List.map NamedDecl.get_id ctx) Id.Set.empty in let vars_of = Environ.global_vars_set in let aux env entry (ctx, all_safe as orig) = match entry with | LocalAssum ({Context.binder_name=x},_) -> if Id.Set.mem x all_safe then orig else (ctx, all_safe) | LocalDef ({Context.binder_name=x},bo, ty) as decl -> if Id.Set.mem x all_safe then orig else let vars = Id.Set.union (vars_of env bo) (vars_of env ty) in if Id.Set.subset vars all_safe then (decl :: ctx, Id.Set.add x all_safe) else (ctx, all_safe) in let ctx, _ = Environ.fold_named_context aux env ~init:(ctx,ctx_set) in if not (Option.is_empty ps.using) then CErrors.user_err Pp.(str "Used section variables can be declared only once"); ctx, { ps with using = Some (Context.Named.to_vars ctx) } (* Interprets the expression in the current proof context, from vernacentries *) let get_recnames pf = if Option.has_some pf.pinfo.Proof_info.possible_guard then List.map (fun c -> c.CInfo.name) pf.pinfo.Proof_info.cinfo else [] let interpret_proof_using pstate using = let env = Global.env () in let pf = get pstate in let sigma, _ = Proof.get_proof_context pf in let fixnames = get_recnames pstate in let initial_goals pf = Proofview.initial_goals Proof.((data pf).entry) in let terms = List.map pi3 (initial_goals (get pstate)) in Proof_using.definition_using env sigma ~fixnames ~using ~terms let set_proof_using pstate using = let using = interpret_proof_using pstate using in set_used_variables pstate ~using let get_open_goals ps = let Proof.{ goals; stack; sigma } = Proof.data ps.proof in List.length goals + List.fold_left (+) 0 (List.map (fun (l1,l2) -> List.length l1 + List.length l2) stack) + List.length (Evd.shelf sigma) type proof_object = { entries : proof_entry list ; uctx: UState.t ; pinfo : Proof_info.t } let { Goptions.get = private_poly_univs } = Goptions.declare_bool_option_and_ref ~key:["Private";"Polymorphic";"Universes"] ~value:true () let warn_remaining_shelved_goals = CWarnings.create ~name:"remaining-shelved-goals" ~category:CWarnings.CoreCategories.tactics (fun () -> Pp.str"The proof has remaining shelved goals.") let warn_given_up = CWarnings.create ~name:"remaining-given-up" ~category:CWarnings.CoreCategories.tactics (fun () -> Pp.str"The proof has given up (admitted) goals." ) let warn_remaining_unresolved_evars = CWarnings.create ~name:"remaining-unresolved-evars" ~category:CWarnings.CoreCategories.tactics (fun () -> Pp.str"The proof has unresolved variables.") type open_proof_kind = | OpenGoals | NonGroundResult of bool (* true = at least some of the evars in the proof term are given up *) exception OpenProof of Names.Id.t * open_proof_kind let () = CErrors.register_handler begin function | OpenProof (pid, reason) -> let open Pp in let ppreason = match reason with | OpenGoals -> str "(there are remaining open goals)" | NonGroundResult has_given_up -> str "(the proof term is not complete" ++ (if has_given_up then str " because of given up (admitted) goals" else mt()) ++ str ")" in let how_to_admit = match reason with | OpenGoals | NonGroundResult false -> mt() | NonGroundResult true -> fnl() ++ str "If this is really what you want to do, use Admitted in place of Qed." in Some (str " (in proof " ++ Names.Id.print pid ++ str "): " ++ str "Attempt to save an incomplete proof" ++ spc() ++ ppreason ++ str "." ++ how_to_admit) | _ -> None end (* XXX: This is still separate from close_proof below due to drop_pt in the STM *) let prepare_proof ?(warn_incomplete=true) { proof } = let Proof.{name=pid;entry;poly;sigma=evd} = Proof.data proof in let initial_goals = Proofview.initial_goals entry in let () = if not @@ Proof.is_done proof then raise (OpenProof (pid, OpenGoals)) in let _ : Proof.t = (* checks that we closed all brackets ("}") *) Proof.unfocus_all proof in let eff = Evd.eval_side_effects evd in let evd = Evd.minimize_universes evd in let to_constr c = match EConstr.to_constr_opt evd c with | Some p -> Vars.universes_of_constr p, p | None -> let has_given_up = let exception Found in let rec aux c = let () = match EConstr.kind evd c with | Evar (e,_) -> if Evar.Set.mem e (Evd.given_up evd) then raise Found | _ -> () in EConstr.iter evd aux c in try aux c; false with Found -> true in raise (OpenProof (pid, NonGroundResult has_given_up)) in (* ppedrot: FIXME, this is surely wrong. There is no reason to duplicate side-effects... This may explain why one need to uniquize side-effects thereafter... *) (* EJGA: actually side-effects de-duplication and this codepath is unrelated. Duplicated side-effects arise from incorrect scheme generation code, the main bulk of it was mostly fixed by #9836 but duplication can still happen because of rewriting schemes I think; however the code below is mostly untested, the only code-paths that generate several proof entries are derive and equations and so far there is no code in the CI that will actually call those and do a side-effect, TTBOMK *) (* EJGA: likely the right solution is to attach side effects to the first constant only? *) let proofs = List.map (fun (_, body, typ) -> (to_constr body, eff), to_constr typ) initial_goals in let () = if warn_incomplete then begin if Evd.has_shelved evd then warn_remaining_shelved_goals () else if Evd.has_given_up evd then warn_given_up () else if Evd.has_undefined evd then warn_remaining_unresolved_evars () end in proofs, Evd.evar_universe_context evd let make_univs_deferred ~poly ~initial_euctx ~uctx ~udecl (used_univs_typ, typ) (used_univs_body, body) = let used_univs = Univ.Level.Set.union used_univs_body used_univs_typ in let utyp = UState.univ_entry ~poly initial_euctx in let uctx = UState.constrain_variables (fst (UState.context_set initial_euctx)) uctx in (* For vi2vo compilation proofs are computed now but we need to complement the univ constraints of the typ with the ones of the body. So we keep the two sets distinct. *) let uctx_body = UState.restrict uctx used_univs in let ubody = UState.check_mono_univ_decl uctx_body udecl in utyp, ubody let make_univs_private_poly ~poly ~uctx ~udecl (used_univs_typ, typ) (used_univs_body, body) = let used_univs = Univ.Level.Set.union used_univs_body used_univs_typ in let uctx = UState.restrict uctx used_univs in let uctx' = UState.restrict uctx used_univs_typ in let utyp = UState.check_univ_decl ~poly uctx' udecl in let ubody = Univ.ContextSet.diff (UState.context_set uctx) (UState.context_set uctx') in utyp, ubody let make_univs ~poly ~uctx ~udecl eff (used_univs_typ, typ) (used_univs_body, body) = let used_univs = Univ.Level.Set.union used_univs_body used_univs_typ in (* Since the proof is computed now, we can simply have 1 set of constraints in which we merge the ones for the body and the ones for the typ. We recheck the declaration after restricting with the actually used universes. TODO: check if restrict is really necessary now. *) let uctx = UState.restrict uctx used_univs in let utyp = UState.check_univ_decl ~poly uctx udecl in let utyp = match fst utyp with | Polymorphic_entry _ -> utyp | Monomorphic_entry uctx -> (* the constraints from the body may depend on universes from the side effects, so merge it all together. Example failure if we don't is "l1" in test-suite/success/rewrite.v. Not sure if it makes more sense to merge them in the ustate before restrict/check_univ_decl or here. Since we only do it when monomorphic it shouldn't really matter. *) Monomorphic_entry (Univ.ContextSet.union uctx (Safe_typing.universes_of_private eff)), snd utyp in utyp, Univ.ContextSet.empty let close_proof ?warn_incomplete ~opaque ~keep_body_ucst_separate ps = let { using; proof; initial_euctx; pinfo } = ps in let { Proof_info.info = { Info.udecl } } = pinfo in let { Proof.poly } = Proof.data proof in let elist, uctx = prepare_proof ?warn_incomplete ps in let opaque = match opaque with | Vernacexpr.Opaque -> true | Vernacexpr.Transparent -> false in let make_entry ((((_ub, body) as b), eff), ((_ut, typ) as t)) = let utyp, ubody = (* allow_deferred case *) if not poly && keep_body_ucst_separate then make_univs_deferred ~initial_euctx ~poly ~uctx ~udecl t b (* private_poly_univs case *) else if poly && opaque && private_poly_univs () then make_univs_private_poly ~poly ~uctx ~udecl t b else make_univs ~poly ~uctx ~udecl eff.Evd.seff_private t b in definition_entry_core ~opaque ?using ~univs:utyp ~univsbody:ubody ~types:typ ~eff body in let entries = CList.map make_entry elist in { entries; uctx; pinfo } type closed_proof_output = (Constr.t * Evd.side_effects) list * UState.t let close_proof_delayed ~feedback_id ps (fpl : closed_proof_output Future.computation) = let { using; proof; initial_euctx; pinfo } = ps in let { Proof_info.info = { Info.udecl } } = pinfo in let { Proof.poly; entry; sigma } = Proof.data proof in (* We don't allow poly = true in this path *) if poly then CErrors.anomaly (Pp.str "Cannot delay universe-polymorphic constants."); (* Because of dependent subgoals at the beginning of proofs, we could have existential variables in the initial types of goals, we need to normalise them for the kernel. *) let nf = Evarutil.nf_evars_universes (Evd.set_universe_context sigma initial_euctx) in (* We only support opaque proofs, this will be enforced by using different entries soon *) let opaque = true in let make_entry i (_, _, types) = (* Already checked the univ_decl for the type universes when starting the proof. *) let univs = UState.univ_entry ~poly:false initial_euctx in let types = nf (EConstr.Unsafe.to_constr types) in (* NB: for Admitted proofs [fpl] is not valid (raises anomaly when forced) *) Future.chain fpl (fun (pf, uctx) -> let (pt, eff) = List.nth pf i in (* Deferred proof, we already checked the universe declaration with the initial universes, ensure that the final universes respect the declaration as well. If the declaration is non-extensible, this will prevent the body from adding universes and constraints. *) let uctx = UState.constrain_variables (fst (UState.context_set initial_euctx)) uctx in let used_univs = Univ.Level.Set.union (Vars.universes_of_constr types) (Vars.universes_of_constr pt) in let uctx = UState.restrict uctx used_univs in let uctx = UState.check_mono_univ_decl uctx udecl in (pt,uctx),eff) |> delayed_definition_entry ~opaque ~feedback_id ~using ~univs ~types in let entries = CList.map_i make_entry 0 (Proofview.initial_goals entry) in { entries; uctx = initial_euctx; pinfo } let close_future_proof = close_proof_delayed let return_proof ps = let p, uctx = prepare_proof ps in List.map (fun (((_ub, body),eff),_) -> (body,eff)) p, uctx let update_sigma_univs ugraph p = map ~f:(Proof.update_sigma_univs ugraph) p let next = let n = ref 0 in fun () -> incr n; !n let by tac = map_fold ~f:(Proof.solve (Goal_select.SelectNth 1) None tac) let build_constant_by_tactic ~name ?warn_incomplete ?(opaque=Vernacexpr.Transparent) ~sigma ~sign ~poly (typ : EConstr.t) tac = let typ_ = EConstr.Unsafe.to_constr typ in let cinfo = [CInfo.make ~name ~typ:typ_ ()] in let info = Info.make ~poly () in let pinfo = Proof_info.make ~cinfo ~info () in let pf = start_proof_core ~name ~typ ~pinfo ~sign sigma in let pf, status = by tac pf in let { entries; uctx } = close_proof ?warn_incomplete ~opaque ~keep_body_ucst_separate:false pf in let { Proof.sigma } = Proof.data pf.proof in let sigma = Evd.set_universe_context sigma uctx in match entries with | [entry] -> let entry = Internal.pmap_entry_body ~f:Future.force entry in entry, status, sigma | _ -> CErrors.anomaly Pp.(str "[build_constant_by_tactic] close_proof returned more than one proof term") let build_by_tactic env ~uctx ~poly ~typ tac = let name = Id.of_string ("temporary_proof"^string_of_int (next())) in let sign = Environ.(val_of_named_context (named_context env)) in let sigma = Evd.from_ctx uctx in let ce, status, sigma = build_constant_by_tactic ~name ~sigma ~sign ~poly typ tac in let uctx = Evd.evar_universe_context sigma in (* ignore side effect universes: we don't reset the global env in this code path so the side effects are still present cf #13271 and discussion in #18874 (but due to #13324 we still want to inline them) *) let cb, _uctx = inline_private_constants ~uctx env ce in cb, ce.proof_entry_type, ce.proof_entry_universes, status, uctx let declare_abstract ~name ~poly ~kind ~sign ~secsign ~opaque ~solve_tac sigma concl = let (const, safe, sigma') = try build_constant_by_tactic ~warn_incomplete:false ~name ~opaque:Vernacexpr.Transparent ~poly ~sigma ~sign:secsign concl solve_tac with Logic_monad.TacticFailure e as src -> (* if the tactic [tac] fails, it reports a [TacticFailure e], which is an error irrelevant to the proof system (in fact it means that [e] comes from [tac] failing to yield enough success). Hence it reraises [e]. *) let (_, info) = Exninfo.capture src in Exninfo.iraise (e, info) in let sigma = Evd.drop_new_defined ~original:sigma sigma' in let body, effs = const.proof_entry_body in (* We drop the side-effects from the entry, they already exist in the ambient environment *) let const = Internal.pmap_entry_body const ~f:(fun _ -> body, ()) in (* EJGA: Hack related to the above call to `build_constant_by_tactic` with `~opaque:Transparent`. Even if the abstracted term is destined to be opaque, if we trigger the `if poly && opaque && private_poly_univs ()` in `close_proof` kernel will boom. This deserves more investigation. *) let const = Internal.set_opacity ~opaque const in let const, args = Internal.shrink_entry sign const in let cst () = (* do not compute the implicit arguments, it may be costly *) let () = Impargs.make_implicit_args false in (* ppedrot: seems legit to have abstracted subproofs as local*) declare_private_constant ~local:Locality.ImportNeedQualified ~name ~kind const in let cst, eff = Impargs.with_implicit_protection cst () in let inst = match fst const.proof_entry_universes with | UState.Monomorphic_entry _ -> EConstr.EInstance.empty | UState.Polymorphic_entry ctx -> (* We mimic what the kernel does, that is ensuring that no additional constraints appear in the body of polymorphic constants. Ideally this should be enforced statically. *) let (_, body_uctx), _ = const.proof_entry_body in let () = assert (Univ.ContextSet.is_empty body_uctx) in EConstr.EInstance.make (UVars.UContext.instance ctx) in let args = List.map EConstr.of_constr args in let lem = EConstr.mkConstU (cst, inst) in let effs = Evd.concat_side_effects eff effs in effs, sigma, lem, args, safe let get_goal_context pf i = let p = get pf in Proof.get_goal_context_gen p i let get_current_goal_context pf = let p = get pf in try Proof.get_goal_context_gen p 1 with | Proof.NoSuchGoal _ -> (* spiwack: returning empty evar_map, since if there is no goal, under focus, there is no accessible evar either. EJGA: this seems strange, as we have pf *) let env = Global.env () in Evd.from_env env, env let get_current_context pf = let p = get pf in Proof.get_proof_context p (* Support for mutually proved theorems *) (* XXX: this should be unified with the code for non-interactive mutuals previously on this file. *) module MutualEntry : sig val declare_possibly_mutual_parameters : pinfo:Proof_info.t -> uctx:UState.t -> sec_vars:Id.Set.t option -> univs:UState.named_universes_entry -> Names.GlobRef.t list val declare_possibly_mutual_definitions (* Common to all recthms *) : pinfo:Proof_info.t -> uctx:UState.t -> entry:proof_entry -> Names.GlobRef.t list end = struct (* XXX: Refactor this with the code in [Declare.declare_possibly_mutual_definitions] *) let guess_decreasing env possible_guard ((body, ctx), eff) = let open Constr in match Constr.kind body with | Fix (_,(_,_,fixdefs as fixdecls)) | CoFix (_,(_,_,fixdefs as fixdecls)) -> let env = Safe_typing.push_private_constants env eff.Evd.seff_private in let body, _ = make_recursive_body env possible_guard fixdecls in (body, ctx), eff | _ -> assert false let update_mutual_entry i entry uctx typ = { entry with proof_entry_body = Future.chain entry.proof_entry_body (fun ((body, uctx), eff) -> ((select_body i body, uctx), eff)); proof_entry_type = Some (UState.nf_universes uctx typ) } let declare_possibly_mutual_definitions ~pinfo ~uctx ~entry = let entries = match pinfo.Proof_info.possible_guard with | None -> (* Not a recursive statement *) [entry] | Some possible_guard -> (* Try all combinations... not optimal *) let env = Global.env() in let typing_flags = pinfo.Proof_info.info.Info.typing_flags in let env = Environ.update_typing_flags ?typing_flags env in let entry = Internal.map_entry_body entry ~f:(guess_decreasing env possible_guard) in List.map_i (fun i CInfo.{typ} -> update_mutual_entry i entry uctx typ) 0 pinfo.Proof_info.cinfo in let { Proof_info.info = { Info.hook; scope; clearbody; kind; typing_flags; user_warns; _ } } = pinfo in let refs = List.map2 (fun CInfo.{name; impargs} -> declare_entry ~name ~scope ~clearbody ~kind ?hook ~impargs ~typing_flags ~user_warns ~uctx) pinfo.Proof_info.cinfo entries in let () = (* We override the temporary notations used while proving, now using the global names *) let local = pinfo.info.scope=Locality.Discharge in CWarnings.with_warn ("-"^Notation.warning_overridden_name) (List.iter (Metasyntax.add_notation_interpretation ~local (Global.env()))) pinfo.info.ntns in refs let declare_possibly_mutual_parameters ~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 = { parameter_entry_secctx = sec_vars; parameter_entry_type = Evarutil.nf_evars_universes (Evd.from_ctx uctx) typ; parameter_entry_universes = univs; parameter_entry_inline_code = None; } in declare_parameter ~name ~scope ~hook ~impargs ~uctx pe ) 0 pinfo.Proof_info.cinfo end (************************************************************************) (* Admitting a lemma-like constant *) (************************************************************************) (* Admitted *) let { Goptions.get = get_keep_admitted_vars } = Goptions.declare_bool_option_and_ref ~key:["Keep"; "Admitted"; "Variables"] ~value:true () let compute_proof_using_for_admitted proof typ iproof = if not (get_keep_admitted_vars ()) || not (Lib.sections_are_opened()) then None else match get_used_variables proof with | Some _ as x -> x | None -> match Proof.partial_proof iproof with | pproof :: _ -> let env = Global.env () in let sigma = (Proof.data iproof).Proof.sigma in let ids_typ = Termops.global_vars_set env sigma typ in (* [pproof] is evar-normalized by [partial_proof]. We don't count variables appearing only in the type of evars. *) let ids_def = Termops.global_vars_set env sigma pproof in Some (Environ.really_needed env (Id.Set.union ids_typ ids_def)) | [] -> None let finish_admitted ~pm ~pinfo ~uctx ~sec_vars ~univs = (* If the constant was an obligation we need to update the program map *) match CEphemeron.default pinfo.Proof_info.proof_ending Proof_ending.Regular with | Proof_ending.End_obligation oinfo -> let declare_fun ~uctx ~sec_vars ~univs = match MutualEntry.declare_possibly_mutual_parameters ~pinfo ~uctx ~sec_vars ~univs with | [GlobRef.ConstRef cst] -> cst | _ -> assert false in let typ = Evarutil.nf_evars_universes (Evd.from_ctx uctx) (List.hd pinfo.Proof_info.cinfo).CInfo.typ in Obls_.obligation_admitted_terminator ~pm typ oinfo declare_fun uctx | _ -> let _cst = MutualEntry.declare_possibly_mutual_parameters ~pinfo ~uctx ~sec_vars ~univs in pm let save_admitted ~pm ~proof = let udecl = get_universe_decl proof in let Proof.{ poly; entry } = Proof.data (get proof) in let typ = match Proofview.initial_goals entry with | [_, _, typ] -> typ | _ -> CErrors.anomaly ~label:"Lemmas.save_lemma_admitted" (Pp.str "more than one statement.") in let iproof = get proof in let sec_vars = compute_proof_using_for_admitted proof typ iproof 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 ~univs (************************************************************************) (* Saving a lemma-like constant *) (************************************************************************) let finish_derived ~f ~name ~entries = (* [f] and [name] correspond to the proof of [f] and of [suchthat], respectively. *) let f_def, lemma_def = match entries with | [_;f_def;lemma_def] -> f_def, lemma_def | _ -> assert false in (* The opacity of [f_def] is adjusted to be [false], as it must. Then [f] is declared in the global environment. *) let f_def = Internal.set_opacity ~opaque:false f_def in let f_kind = Decls.(IsDefinition Definition) in let f_def = DefinitionEntry f_def in let f_kn = declare_constant ~name:f ~kind:f_kind f_def ~typing_flags:None in (* Derive does not support univ poly *) let () = assert (not (Global.is_polymorphic (ConstRef f_kn))) in let f_kn_term = Constr.UnsafeMonomorphic.mkConst f_kn in (* In the type and body of the proof of [suchthat] there can be references to the variable [f]. It needs to be replaced by references to the constant [f] declared above. This substitution performs this precise action. *) let substf c = Vars.replace_vars [f,f_kn_term] c in (* Extracts the type of the proof of [suchthat]. *) let lemma_pretype typ = match typ with | Some t -> Some (substf t) | None -> assert false (* Declare always sets type here. *) in (* The references of [f] are subsituted appropriately. *) let lemma_def = Internal.map_entry_type lemma_def ~f:lemma_pretype in (* The same is done in the body of the proof. *) let lemma_def = Internal.map_entry_body lemma_def ~f:(fun ((b,ctx),fx) -> (substf b, ctx), fx) in let lemma_def = DefinitionEntry lemma_def in let ct = declare_constant ~name ~typing_flags:None ~kind:Decls.(IsProof Proposition) lemma_def in [GlobRef.ConstRef f_kn; GlobRef.ConstRef ct] let finish_proved_equations ~pm ~kind ~hook i proof_obj types sigma0 = let obls = ref 1 in let sigma, recobls = CList.fold_left2_map (fun sigma (_evar_env, ev, _evi, local_context, _type) entry -> let id = match Evd.evar_ident ev sigma0 with | Some id -> id | None -> let n = !obls in incr obls; Nameops.add_suffix i ("_obligation_" ^ string_of_int n) in let entry = Internal.pmap_entry_body ~f:Future.force entry in let entry, args = Internal.shrink_entry local_context entry in let entry = Internal.pmap_entry_body ~f:Future.from_val entry in let cst = declare_constant ~name:id ~kind ~typing_flags:None (DefinitionEntry entry) in let sigma, app = Evd.fresh_global (Global.env ()) sigma (GlobRef.ConstRef cst) in let sigma = Evd.define ev (EConstr.applist (app, List.map EConstr.of_constr args)) sigma in sigma, cst) sigma0 types proof_obj.entries in let pm = hook ~pm recobls sigma in pm, List.map (fun cst -> GlobRef.ConstRef cst) recobls let check_single_entry { entries; uctx } label = match entries with | [entry] -> entry, uctx | _ -> CErrors.anomaly ~label Pp.(str "close_proof returned more than one proof term") let finish_proof ~pm proof_obj proof_info = let open Proof_ending in match CEphemeron.default proof_info.Proof_info.proof_ending Regular with | Regular -> let entry, uctx = check_single_entry proof_obj "Proof.save" in pm, MutualEntry.declare_possibly_mutual_definitions ~entry ~uctx ~pinfo:proof_info | End_obligation oinfo -> let entry, uctx = check_single_entry proof_obj "Obligation.save" in let entry = Internal.pmap_entry_body ~f:Future.force entry in Obls_.obligation_terminator ~pm ~entry ~uctx ~oinfo | End_derive { f ; name } -> pm, finish_derived ~f ~name ~entries:proof_obj.entries | End_equations { hook; i; types; sigma } -> let kind = proof_info.Proof_info.info.Info.kind in finish_proved_equations ~pm ~kind ~hook i proof_obj types sigma let err_save_forbidden_in_place_of_qed () = CErrors.user_err (Pp.str "Cannot use Save with more than one constant or in this proof mode") let process_idopt_for_save ~idopt info = match idopt with | None -> info | Some { CAst.v = save_name } -> (* Save foo was used; we override the info in the first theorem *) let cinfo = match info.Proof_info.cinfo, CEphemeron.default info.Proof_info.proof_ending Proof_ending.Regular with | [ { CInfo.name; _} as decl ], Proof_ending.Regular -> [ { decl with CInfo.name = save_name } ] | _ -> err_save_forbidden_in_place_of_qed () in { info with Proof_info.cinfo } let save ~pm ~proof ~opaque ~idopt = (* Env and sigma are just used for error printing in save_remaining_recthms *) let proof_obj = close_proof ~opaque ~keep_body_ucst_separate:false proof in let proof_info = process_idopt_for_save ~idopt proof.pinfo in finish_proof ~pm proof_obj proof_info let save_regular ~(proof : t) ~opaque ~idopt = let open Proof_ending in match CEphemeron.default proof.pinfo.Proof_info.proof_ending Regular with | Regular -> let (_, grs) : Obls_.State.t * _ = save ~pm:Obls_.State.empty ~proof ~opaque ~idopt in grs | _ -> CErrors.anomaly Pp.(str "save_regular: unexpected proof ending") (***********************************************************************) (* Special case to close a lemma without forcing a proof *) (***********************************************************************) let save_lemma_admitted_delayed ~pm ~proof = let { entries; uctx; pinfo } = proof in if List.length entries <> 1 then CErrors.user_err Pp.(str "Admitted does not support multiple statements"); let { proof_entry_secctx; proof_entry_type; proof_entry_universes } = List.hd entries in let poly = match fst (proof_entry_universes) with | UState.Monomorphic_entry _ -> false | UState.Polymorphic_entry _ -> true 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 ~univs let save_lemma_proved_delayed ~pm ~proof ~idopt = (* vio2vo used to call this with invalid [pinfo], now it should work fine. *) let pinfo = process_idopt_for_save ~idopt proof.pinfo in let pm, _ = finish_proof ~pm proof pinfo in pm end (* Proof module *) let _ = Ind_tables.declare_definition_scheme := declare_definition_scheme let _ = Abstract.declare_abstract := Proof.declare_abstract let build_by_tactic = Proof.build_by_tactic (* This module could be merged with Obl, and placed before [Proof], however there is a single dependency on [Proof.start] for the interactive case *) module Obls = struct (* For the records fields, opens should go away one these types are private *) open Obls_ open Obls_.Obligation open Obls_.ProgramDecl let reduce c = let env = Global.env () in let sigma = Evd.from_env env in EConstr.Unsafe.to_constr (Reductionops.clos_norm_flags RedFlags.betaiota env sigma (EConstr.of_constr c)) let explain_no_obligations = function Some ident -> str "No obligations for program " ++ Id.print ident | None -> str "No obligations remaining" module Error = struct let no_obligations n = CErrors.user_err (explain_no_obligations n) let ambiguous_program id ids = CErrors.user_err Pp.(str "More than one program with unsolved obligations: " ++ prlist Id.print ids ++ str "; use the \"of\" clause to specify, as in \"Obligation 1 of " ++ Id.print id ++ str "\"") let unknown_obligation num = CErrors.user_err (Pp.str (Printf.sprintf "Unknown obligation number %i" (succ num))) let already_solved num = CErrors.user_err Pp.(str "Obligation " ++ int num ++ str " already solved." ) let depends num rem = CErrors.user_err ( str "Obligation " ++ int num ++ str " depends on obligation(s) " ++ pr_sequence (fun x -> int (succ x)) rem) end let default_tactic = ref (Proofview.tclUNIT ()) let subst_deps expand obls deps t = let osubst = Obls_.obl_substitution expand obls deps in (Vars.replace_vars (List.map (fun (n, (_, b)) -> n, b) osubst) t) let subst_deps_obl obls obl = let t' = subst_deps true obls obl.obl_deps obl.obl_type in Obligation.set_type ~typ:t' obl let is_defined obls x = not (Option.is_empty obls.(x).obl_body) let deps_remaining obls deps = Int.Set.fold (fun x acc -> if is_defined obls x then acc else x :: acc) deps [] let goal_kind = Decls.(IsDefinition Definition) let goal_proof_kind = Decls.(IsProof Lemma) let kind_of_obligation o = match o with | Evar_kinds.Define false | Evar_kinds.Expand -> goal_kind | _ -> goal_proof_kind (* Solve an obligation using tactics, return the corresponding proof term *) let warn_solve_errored = CWarnings.create ~name:"solve_obligation_error" ~category:CWarnings.CoreCategories.tactics (fun err -> Pp.seq [ str "Solve Obligations tactic returned error: " ; err ; fnl () ; str "This will become an error in the future" ]) 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 (* 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:(EConstr.of_constr obl.obl_type) 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 (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 prg, obl', _cst = declare_obligation prg obl ~body:t ~types:ty ~uctx in obls.(i) <- obl'; 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 | Error [] -> Error.no_obligations None | Error ((id :: _) as ids) -> Error.ambiguous_program id ids let solve_prg_obligations ~pm prg ?oblset tac = let { obls; remaining } = Internal.get_obligations prg in let rem = ref remaining in let obls' = Array.copy obls in let set = ref Int.Set.empty in let p = match oblset with | None -> (fun _ -> true) | Some s -> set := s; (fun i -> Int.Set.mem i !set) in let prg = Array.fold_left_i (fun i prg x -> if p i then ( match solve_obligation_by_tac prg obls' i tac with | None -> prg | Some prg -> let deps = dependencies obls i in set := Int.Set.union !set deps; decr rem; prg) else prg) prg obls' in update_obls ~pm prg obls' !rem let 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_obligation ?check_final prg num tac = let user_num = succ num in let { obls; remaining=rem } = Internal.get_obligations prg in let obl = obls.(num) in let remaining = deps_remaining obls obl.obl_deps in let () = if not (Option.is_empty obl.obl_body) then Error.already_solved user_num; if not (List.is_empty remaining) then Error.depends user_num remaining in let obl = subst_deps_obl obls obl in let kind = kind_of_obligation (snd obl.obl_status) in let evd = Evd.from_ctx (Internal.get_uctx prg) in let evd = Evd.update_sigma_univs (Global.universes ()) evd in let auto ~pm n oblset tac = auto_solve_obligations ~pm n ~oblset tac in let proof_ending = let name = Internal.get_name prg in Proof_ending.End_obligation {name; num; auto; check_final} in let cinfo = CInfo.make ~name:obl.obl_name ~typ:(EConstr.of_constr obl.obl_type) () in let using = let using = Internal.get_using prg in let env = Global.env () in let f {CInfo.name; typ; _} = name, [typ] in Option.map (interp_proof_using_gen f env evd [cinfo]) using in let poly = Internal.get_poly prg in let info = Info.make ~kind ~poly () in let lemma = Proof.start_core ~cinfo ~info ~proof_ending ?using evd in let lemma = fst @@ Proof.by !default_tactic lemma in let lemma = Option.cata (fun tac -> Proof.set_endline_tactic tac lemma) lemma tac in lemma let solve_obligations ~pm n tac = let prg = get_unique_prog ~pm n in solve_prg_obligations ~pm prg tac let solve_all_obligations ~pm tac = State.fold pm ~init:pm ~f:(fun k v pm -> solve_prg_obligations ~pm v tac |> fst) let try_solve_obligations ~pm n tac = solve_obligations ~pm n tac |> fst 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 user_num else Error.unknown_obligation num let show_single_obligation i n obls x = let x = subst_deps_obl obls x in let env = Global.env () in let sigma = Evd.from_env env in let msg = str "Obligation" ++ spc () ++ int (succ i) ++ spc () ++ str "of" ++ spc () ++ Id.print n ++ str ":" ++ spc () ++ hov 1 (Printer.pr_constr_env env sigma x.obl_type ++ str "." ++ fnl ()) in Feedback.msg_info msg let show_obligations_of_prg ?(msg = true) prg = let n = Internal.get_name prg in let {obls; remaining} = Internal.get_obligations prg in let showed = ref 5 in if msg then Feedback.msg_info (int remaining ++ str " obligation(s) remaining: "); Array.iteri (fun i x -> match x.obl_body with | None -> if !showed > 0 then begin decr showed; show_single_obligation i n obls x end | Some _ -> ()) obls let show_obligations ~pm ?(msg = true) n = let progs = match n with | None -> State.all pm | Some n -> (match State.find pm n with | Some prg -> [prg] | None -> Error.no_obligations (Some n)) in List.iter (fun x -> show_obligations_of_prg ~msg x) progs let show_term ~pm n = let prg = get_unique_prog ~pm n in ProgramDecl.show prg let msg_generating_obl name obls = let len = Array.length obls in let info = Id.print name ++ str " has type-checked" in Feedback.msg_info (if len = 0 then info ++ str "." else info ++ str ", generating " ++ int len ++ str (String.plural len " obligation")) let add_definition ~pm ~info ~cinfo ~opaque ~uctx ?body ?tactic ?(reduce = reduce) ?using ?obl_hook obls = let obl_hook = Option.map (fun h -> State.PrgHook h) obl_hook in let prg = ProgramDecl.make ~info ~cinfo ~body ~opaque ~uctx ~reduce ~deps:[] ~possible_guard:None ?obl_hook ?using obls in let name = CInfo.get_name cinfo in let {obls;_} = Internal.get_obligations prg in if Int.equal (Array.length obls) 0 then ( Flags.if_verbose (msg_generating_obl name) obls; let pm, cst = Obls_.declare_definition ~pm prg in pm, Defined cst) else let () = Flags.if_verbose (msg_generating_obl name) obls in let pm = State.add pm name prg in let pm, res = auto_solve_obligations ~pm (Some name) tactic in match res with | Remain rem -> Flags.if_verbose (show_obligations ~pm ~msg:false) (Some name); pm, res | _ -> pm, res let add_mutual_definitions ~pm ~info ~cinfo ~opaque ~uctx ~bodies ~possible_guard ?tactic ?(reduce = reduce) ?using ?obl_hook obls = let obl_hook = Option.map (fun h -> State.PrgHook h) obl_hook in let deps = List.map CInfo.get_name cinfo in let pm = List.fold_left3 (fun pm cinfo body obls -> let prg = ProgramDecl.make ~info ~cinfo ~opaque ~body:(Some body) ~uctx ~deps ~possible_guard:(Some possible_guard) ~reduce ?obl_hook ?using obls in State.add pm (CInfo.get_name cinfo) prg) pm cinfo bodies obls in let pm, _defined = List.fold_left (fun (pm, finished) x -> if finished then (pm, finished) else let pm, res = auto_solve_obligations ~pm (Some x) tactic in match res with | Defined _ -> (* If one definition is turned into a constant, the whole block is defined. *) (pm, true) | _ -> (pm, false)) (pm, false) deps in pm let rec admit_prog ~pm prg = let {obls} = Internal.get_obligations prg in let is_open _ x = Option.is_empty x.obl_body && List.is_empty (deps_remaining obls x.obl_deps) in let i = match Array.findi is_open obls with | Some i -> i | None -> CErrors.anomaly (Pp.str "Could not find a solvable obligation.") in let proof = solve_obligation prg i None in let pm = Proof.save_admitted ~pm ~proof in match ProgMap.find_opt (Internal.get_name prg) pm with | Some prg -> admit_prog ~pm (CEphemeron.get prg) | None -> pm let rec admit_all_obligations ~pm = let prg = State.first_pending pm in match prg with | None -> pm | Some prg -> let pm = admit_prog ~pm prg in admit_all_obligations ~pm let admit_obligations ~pm n = match n with | None -> admit_all_obligations ~pm | Some _ -> let prg = get_unique_prog ~pm n in let pm = admit_prog ~pm prg in pm let next_obligation ~pm ?(final=false) n tac = let prg = match n with | None -> begin match State.first_pending pm with | Some prg -> prg | None -> Error.no_obligations None end | Some _ -> get_unique_prog ~pm n in let {obls; remaining} = Internal.get_obligations prg in let is_open _ x = Option.is_empty x.obl_body && List.is_empty (deps_remaining obls x.obl_deps) in let i = match Array.findi is_open obls with | Some i -> i | None -> match n with | None -> CErrors.anomaly (Pp.str "Could not find a solvable obligation.") | Some n -> CErrors.user_err (str "No more obligations for " ++ Id.print n ++ str ".") in let check_final = if not final then None else match n with | None -> Some AllFinal | Some n -> Some (SpecificFinal n) in solve_obligation ?check_final prg i tac let check_program_libraries () = Coqlib.check_required_library Coqlib.datatypes_module_name; Coqlib.check_required_library ["Coq";"Init";"Specif"] (* aliases *) let prepare_obligations = prepare_obligations let check_solved_obligations = let is_empty prg = let obls = (Internal.get_obligations (CEphemeron.get prg)).obls in let is_open x = Option.is_empty x.obl_body && List.is_empty (deps_remaining obls x.obl_deps) in Array.exists is_open obls in Obls_.check_solved_obligations is_empty type fixpoint_kind = Obls_.fixpoint_kind = | IsFixpoint of lident option list | IsCoFixpoint type nonrec progress = progress = | Remain of int | Dependent | Defined of GlobRef.t end module OblState = Obls_.State let declare_constant ?local ~name ~kind ?typing_flags = declare_constant ?local ~name ~kind ~typing_flags let declare_entry ~name ?scope ~kind ?user_warns = declare_entry ~name ?scope ~kind ~typing_flags:None ?clearbody:None ~user_warns coq-8.20.0/vernac/declare.mli000066400000000000000000000502711466560755400157720ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* 'a -> 'a) -> 'a g val make : (S.t -> unit) -> t val call : ?hook:t -> S.t -> unit end (** {2 One-go, non-interactive declaration API } *) (** Information for a single top-level named constant *) module CInfo : sig type 'constr t val make : name : Id.t -> typ:'constr -> ?args:Name.t list -> ?impargs:Impargs.manual_implicits -> unit -> 'constr t (* Used only in Vernacentries, may disappear from public API *) val to_constr : Evd.evar_map -> EConstr.t t -> Constr.t t (* Used only in RecLemmas, may disappear from public API *) val get_typ : 'constr t -> 'constr end (** Information for a declaration, interactive or not, includes parameters shared by mutual constants *) module Info : sig type t (** Note that [opaque] doesn't appear here as it is not known at the start of the proof in the interactive case. *) val make : ?poly:bool -> ?inline : bool -> ?kind : Decls.logical_kind (** Theorem, etc... *) -> ?udecl : UState.universe_decl -> ?scope : Locality.definition_scope (** locality *) -> ?clearbody:bool -> ?hook : Hook.t (** Callback to be executed after saving the constant *) -> ?typing_flags:Declarations.typing_flags -> ?user_warns : UserWarn.t -> ?ntns : Metasyntax.notation_interpretation_decl list -> unit -> t end (** Declares a non-interactive constant; [body] and [types] will be normalized w.r.t. the passed [evar_map] [sigma]. Universes should be handled properly, including minimization and restriction. Note that [sigma] is checked for unresolved evars, thus you should be careful not to submit open terms *) val declare_definition : info:Info.t -> cinfo:EConstr.t option CInfo.t -> opaque:bool -> body:EConstr.t -> ?using:Vernacexpr.section_subset_expr -> Evd.evar_map -> GlobRef.t val declare_mutual_definitions : info:Info.t -> cinfo: Constr.t CInfo.t list -> opaque:bool -> uctx:UState.t -> bodies:(Constr.t list * Sorts.relevance list) -> possible_guard:Pretyping.possible_guard -> ?using:Vernacexpr.section_subset_expr -> unit -> Names.GlobRef.t list (** {2 Declaration of interactive constants } *) (** [save] / [save_admitted] can update obligations state, so we need to expose the state here *) module OblState : sig type t val empty : t module View : sig module Obl : sig type t = private { name : Id.t ; loc : Loc.t option ; status : bool * Evar_kinds.obligation_definition_status ; solved : bool } end type t = private { opaque : bool ; remaining : int ; obligations : Obl.t array } end val view : t -> View.t Id.Map.t end (** [Declare.Proof.t] Construction of constants using interactive proofs. *) module Proof : sig type t (** [start_proof ~info ~cinfo sigma] starts a proof of [cinfo]. The proof is started in the evar map [sigma] (which can typically contain universe constraints) *) val start : info:Info.t -> cinfo:EConstr.t CInfo.t -> ?using:Id.Set.t -> Evd.evar_map -> t (** [start_{derive,equations}] are functions meant to handle interactive proofs with multiple goals, they should be considered experimental until we provide a more general API encompassing both of them. Please, get in touch with the developers if you would like to experiment with multi-goal dependent proofs so we can use your input on the design of the new API. *) val start_derive : f:Id.t -> name:Id.t -> info:Info.t -> Proofview.telescope -> t val start_equations : name:Id.t -> info:Info.t -> hook:(pm:OblState.t -> Constant.t list -> Evd.evar_map -> OblState.t) -> types:(Environ.env * Evar.t * Evd.undefined Evd.evar_info * EConstr.named_context * Evd.econstr) list -> Evd.evar_map -> Proofview.telescope -> t (** Pretty much internal, used by the Lemma vernaculars *) val start_definition : info:Info.t -> cinfo:Constr.t CInfo.t -> ?using:Vernacexpr.section_subset_expr -> Evd.evar_map -> t (** Pretty much internal, used by mutual Lemma / Fixpoint vernaculars *) val start_mutual_definitions : info:Info.t -> cinfo:Constr.t CInfo.t list -> ?bodies:Constr.t option list -> possible_guard:Pretyping.possible_guard -> ?using:Vernacexpr.section_subset_expr -> Evd.evar_map -> t (** Qed a proof *) val save : pm:OblState.t -> proof:t -> opaque:Vernacexpr.opacity_flag -> idopt:Names.lident option -> OblState.t * GlobRef.t list (** For proofs known to have [Regular] ending, no need to touch program state. *) val save_regular : proof:t -> opaque:Vernacexpr.opacity_flag -> idopt:Names.lident option -> GlobRef.t list (** Admit a proof *) val save_admitted : pm:OblState.t -> proof:t -> OblState.t (** [by tac] applies tactic [tac] to the 1st subgoal of the current focused proof. Returns [false] if an unsafe tactic has been used. *) val by : unit Proofview.tactic -> t -> t * bool (** Operations on ongoing proofs *) val get : t -> Proof.t val get_name : t -> Names.Id.t val fold : f:(Proof.t -> 'a) -> t -> 'a val map : f:(Proof.t -> Proof.t) -> t -> t val map_fold : f:(Proof.t -> Proof.t * 'a) -> t -> t * 'a val map_fold_endline : f:(unit Proofview.tactic -> Proof.t -> Proof.t * 'a) -> t -> t * 'a (** Sets the tactic to be used when a tactic line is closed with [...] *) val set_endline_tactic : Genarg.glob_generic_argument -> t -> t val definition_scope : t -> Locality.definition_scope (** Sets the section variables assumed by the proof, returns its closure * (w.r.t. type dependencies and let-ins covered by it) *) val set_proof_using : t -> Vernacexpr.section_subset_expr -> Constr.named_context * t (** Gets the set of variables declared to be used by the proof. None means no "Proof using" or #[using] was given *) val get_used_variables : t -> Id.Set.t option (** Compacts the representation of the proof by pruning all intermediate terms *) val compact : t -> t (** Update the proof's universe information typically after a side-effecting command (e.g. a sublemma definition) has been run inside it. *) val update_sigma_univs : UGraph.t -> t -> t val get_open_goals : t -> int (** Helpers to obtain proof state when in an interactive proof *) (** [get_goal_context n] returns the context of the [n]th subgoal of the current focused proof or raises a [UserError] if there is no focused proof or if there is no more subgoals *) val get_goal_context : t -> int -> Evd.evar_map * Environ.env (** [get_current_goal_context ()] works as [get_goal_context 1] *) val get_current_goal_context : t -> Evd.evar_map * Environ.env (** [get_current_context ()] returns the context of the current focused goal. If there is no focused goal but there is a proof in progress, it returns the corresponding evar_map. If there is no pending proof then it returns the current global environment and empty evar_map. *) val get_current_context : t -> Evd.evar_map * Environ.env (** {2 Proof delay API, warning, internal, not stable} *) (* Intermediate step necessary to delegate the future. * Both access the current proof state. The former is supposed to be * chained with a computation that completed the proof *) type closed_proof_output (** Requires a complete proof. *) val return_proof : t -> closed_proof_output (** XXX: This is an internal, low-level API and could become scheduled for removal from the public API, use higher-level declare APIs instead *) type proof_object val close_proof : ?warn_incomplete:bool -> opaque:Vernacexpr.opacity_flag -> keep_body_ucst_separate:bool -> t -> proof_object val close_future_proof : feedback_id:Stateid.t -> t -> closed_proof_output Future.computation -> proof_object (** Special cases for delayed proofs, in this case we must provide the proof information so the proof won't be forced. *) val save_lemma_admitted_delayed : pm:OblState.t -> proof:proof_object -> OblState.t val save_lemma_proved_delayed : pm:OblState.t -> proof:proof_object -> idopt:Names.lident option -> OblState.t end (** {2 low-level, internal API, avoid using unless you have special needs } *) (** Proof entries represent a proof that has been finished, but still not registered with the kernel. XXX: This is an internal, low-level API and could become scheduled for removal from the public API, use higher-level declare APIs instead *) type proof_entry type parameter_entry type primitive_entry type symbol_entry val definition_entry : ?opaque:bool -> ?using:Names.Id.Set.t -> ?inline:bool -> ?types:Constr.types -> ?univs:UState.named_universes_entry -> Constr.constr -> proof_entry val parameter_entry : ?inline:int -> ?univs:UState.named_universes_entry -> Constr.constr -> parameter_entry val primitive_entry : ?types:(Constr.types * UState.named_universes_entry) -> CPrimitives.op_or_type -> primitive_entry val symbol_entry : ?univs:UState.named_universes_entry -> unfold_fix:bool -> Constr.types -> symbol_entry (** XXX: This is an internal, low-level API and could become scheduled for removal from the public API, use higher-level declare APIs instead *) val declare_entry : name:Id.t -> ?scope:Locality.definition_scope -> kind:Decls.logical_kind -> ?user_warns:UserWarn.t -> ?hook:Hook.t -> impargs:Impargs.manual_implicits -> uctx:UState.t -> proof_entry -> GlobRef.t (** Declaration of section variables and local definitions *) type variable_declaration = | SectionLocalDef of { clearbody : bool; entry : proof_entry; } | SectionLocalAssum of { typ : Constr.types; impl : Glob_term.binding_kind; univs : UState.named_universes_entry; } (** Declaration of local constructions (Variable/Hypothesis/Local) *) val declare_variable : name:variable -> kind:Decls.logical_kind -> typing_flags:Declarations.typing_flags option -> variable_declaration -> unit (** Declaration of global constructions i.e. Definition/Theorem/Axiom/Parameter/... XXX: This is an internal, low-level API and could become scheduled for removal from the public API, use higher-level declare APIs instead *) type constant_entry = | DefinitionEntry of proof_entry | ParameterEntry of parameter_entry | PrimitiveEntry of primitive_entry | SymbolEntry of symbol_entry val prepare_parameter : poly:bool -> udecl:UState.universe_decl -> types:EConstr.types -> Evd.evar_map -> Evd.evar_map * parameter_entry (** [declare_constant id cd] declares a global declaration (constant/parameter) with name [id] in the current section; it returns the full path of the declaration XXX: This is an internal, low-level API and could become scheduled for removal from the public API, use higher-level declare APIs instead *) val declare_constant : ?local:Locality.import_status -> name:Id.t -> kind:Decls.logical_kind -> ?typing_flags:Declarations.typing_flags -> ?user_warns:UserWarn.t -> constant_entry -> Constant.t (** Declaration messages, for internal use *) (** XXX: Scheduled for removal from public API, do not use *) val definition_message : Id.t -> unit val assumption_message : Id.t -> unit val fixpoint_message : int array option -> Id.t list -> unit val check_exists : Id.t -> unit (** Semantics of this function is a bit dubious, use with care *) val build_by_tactic : Environ.env -> uctx:UState.t -> poly:bool -> typ:EConstr.types -> unit Proofview.tactic -> Constr.constr * Constr.types option * UState.named_universes_entry * bool * UState.t (** {2 Program mode API} *) (** Coq's Program mode support. This mode extends declarations of constants and fixpoints with [Program Definition] and [Program Fixpoint] to support incremental construction of terms using delayed proofs, called "obligations" The mode also provides facilities for managing and auto-solving sets of obligations. The basic code flow of programs/obligations is as follows: - [add_definition] / [add_mutual_definitions] are called from the respective [Program] vernacular command interpretation; at this point the only extra work we do is to prepare the new definition [d] using [RetrieveObl], which consists in turning unsolved evars into obligations. [d] is not sent to the kernel yet, as it is not complete and cannot be typchecked, but saved in a special data-structure. Auto-solving of obligations is tried at this stage (see below) - [next_obligation] will retrieve the next obligation ([RetrieveObl] sorts them by topological order) and will try to solve it. When all obligations are solved, the original constant [d] is grounded and sent to the kernel for addition to the global environment. Auto-solving of obligations is also triggered on obligation completion. {2} Solving of obligations: Solved obligations are stored as regular global declarations in the global environment, usually with name [constant_obligation_number] where [constant] is the original [constant] and [number] is the corresponding (internal) number. Solving an obligation can trigger a bit of a complex cascaded callback path; closing an obligation can indeed allow all other obligations to be closed, which in turn may trigged the declaration of the original constant. Care must be taken, as this can modify [Global.env] in arbitrarily ways. Current code takes some care to refresh the [env] in the proper boundaries, but the invariants remain delicate. {2} Saving of obligations: as open obligations use the regular proof mode, a `Qed` will call `Lemmas.save_lemma` first. For this reason obligations code is split in two: this file, [Obligations], taking care of the top-level vernac commands, and [Declare], which is called by `Lemmas` to close an obligation proof and eventually to declare the top-level [Program]ed constant. *) module Obls : sig type fixpoint_kind = IsFixpoint of lident option list | IsCoFixpoint (** Check obligations are properly solved before closing the [what_for] section / module *) val check_solved_obligations : pm:OblState.t -> what_for:Pp.t -> unit val default_tactic : unit Proofview.tactic ref (** Resolution status of a program *) type progress = | Remain of int (** n obligations remaining *) | Dependent (** Dependent on other definitions *) | Defined of GlobRef.t (** Defined as id *) (** Prepare API, to be removed once we provide the corresponding 1-step API *) val prepare_obligations : name:Id.t -> ?types:EConstr.t -> body:EConstr.t -> Environ.env -> Evd.evar_map -> Constr.constr * Constr.types * UState.t * RetrieveObl.obligation_name_lifter * RetrieveObl.obligation_info (** Start a [Program Definition c] proof. [uctx] [udecl] [impargs] [kind] [scope] [poly] etc... come from the interpretation of the vernacular; `obligation_info` was generated by [RetrieveObl] It will return whether all the obligations were solved; if so, it will also register [c] with the kernel. *) val add_definition : pm:OblState.t -> info:Info.t -> cinfo:Constr.types CInfo.t -> opaque:bool -> uctx:UState.t -> ?body:Constr.t -> ?tactic:unit Proofview.tactic -> ?reduce:(Constr.t -> Constr.t) -> ?using:Vernacexpr.section_subset_expr -> ?obl_hook: OblState.t Hook.g -> RetrieveObl.obligation_info -> OblState.t * progress (* XXX: unify with MutualEntry *) (** Start a [Program Fixpoint] declaration, similar to the above, except it takes a list now. *) val add_mutual_definitions : pm:OblState.t -> info:Info.t -> cinfo:Constr.types CInfo.t list -> opaque:bool -> uctx:UState.t -> bodies:Constr.t list -> possible_guard:Pretyping.possible_guard -> ?tactic:unit Proofview.tactic -> ?reduce:(Constr.t -> Constr.t) -> ?using:Vernacexpr.section_subset_expr -> ?obl_hook: OblState.t Hook.g -> RetrieveObl.obligation_info list -> OblState.t (** Implementation of the [Obligation] command *) val obligation : int * Names.Id.t option * Constrexpr.constr_expr option -> pm:OblState.t -> Genarg.glob_generic_argument option -> Proof.t (** Implementation of the [Next Obligation] and [Final Obligation] commands *) val next_obligation : pm:OblState.t -> ?final:bool -> Names.Id.t option -> Genarg.glob_generic_argument option -> Proof.t (** Implementation of the [Solve Obligation] command *) val solve_obligations : pm:OblState.t -> Names.Id.t option -> unit Proofview.tactic option -> OblState.t * progress val solve_all_obligations : pm:OblState.t -> unit Proofview.tactic option -> OblState.t val try_solve_obligations : pm:OblState.t -> Names.Id.t option -> unit Proofview.tactic option -> OblState.t val show_obligations : pm:OblState.t -> ?msg:bool -> Names.Id.t option -> unit val show_term : pm:OblState.t -> Names.Id.t option -> Pp.t val admit_obligations : pm:OblState.t -> Names.Id.t option -> OblState.t val check_program_libraries : unit -> unit end val is_local_constant : Constant.t -> bool (** {6 For internal support, do not use} *) module Internal : sig (* Libobject exports *) module Constant : sig type t val tag : (Id.t * t) Libobject.Dyn.tag val kind : t -> Decls.logical_kind end val objVariable : Id.t Libobject.Dyn.tag (** [export_side_effects eff] makes the side effects [eff] global. This usually happens at the end of a proof (during Qed or Defined), but one may need to declare them by hand, for example because the tactic was run as part of a command *) val export_side_effects : Evd.side_effects -> unit end coq-8.20.0/vernac/declareInd.ml000066400000000000000000000211341466560755400162500ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* Notation.declare_ref_arguments_scope (GlobRef.IndRef (kn,i)); for j=1 to List.length lc do Notation.declare_ref_arguments_scope (GlobRef.ConstructRef ((kn,i),j)); done) mie.mind_entry_inds type inductive_obj = { ind_names : (Id.t * Id.t list) list (* For each block, name of the type + name of constructors *) } let inductive_names sp kn obj = let (dp,_) = Libnames.repr_path sp in let kn = Global.mind_of_delta_kn kn in let names, _ = List.fold_left (fun (names, n) (typename, consnames) -> let ind_p = (kn,n) in let names, _ = List.fold_left (fun (names, p) l -> let sp = Libnames.make_path dp l in ((sp, GlobRef.ConstructRef (ind_p,p)) :: names, p+1)) (names, 1) consnames in let sp = Libnames.make_path dp typename in ((sp, GlobRef.IndRef ind_p) :: names, n+1)) ([], 0) obj.ind_names in names let load_inductive i ((sp, kn), names) = let names = inductive_names sp kn names in List.iter (fun (sp, ref) -> Nametab.push (Nametab.Until i) sp ref ) names let open_inductive i ((sp, kn), names) = let names = inductive_names sp kn names in List.iter (fun (sp, ref) -> Nametab.push (Nametab.Exactly i) sp ref) names let cache_inductive ((sp, kn), names) = let names = inductive_names sp kn names in List.iter (fun (sp, ref) -> Nametab.push (Nametab.Until 1) sp ref) names let discharge_inductive names = Some names let objInductive : (Id.t * inductive_obj) Libobject.Dyn.tag = let open Libobject in declare_named_object_full {(default_object "INDUCTIVE") with cache_function = cache_inductive; load_function = load_inductive; open_function = simple_open open_inductive; classify_function = (fun a -> Substitute); subst_function = ident_subst_function; discharge_function = discharge_inductive; } let inInductive v = Libobject.Dyn.Easy.inj v objInductive let cache_prim (p,c) = Structures.PrimitiveProjections.register p c let load_prim _ p = cache_prim p let subst_prim (subst,(p,c)) = Mod_subst.subst_proj_repr subst p, Mod_subst.subst_constant subst c let discharge_prim (p,c) = Some (Lib.discharge_proj_repr p, c) let inPrim : (Projection.Repr.t * Constant.t) -> Libobject.obj = let open Libobject in declare_object { (default_object "PRIMPROJS") with cache_function = cache_prim ; load_function = load_prim; subst_function = subst_prim; classify_function = (fun x -> Substitute); discharge_function = discharge_prim } let declare_primitive_projection p c = Lib.add_leaf (inPrim (p,c)) let feedback_axiom () = Feedback.(feedback AddedAxiom) let is_unsafe_typing_flags () = let open Declarations in let flags = Environ.typing_flags (Global.env()) in not (flags.check_universes && flags.check_guarded && flags.check_positive) (* for initial declaration *) let declare_mind ?typing_flags mie = let id = match mie.mind_entry_inds with | ind::_ -> ind.mind_entry_typename | [] -> CErrors.anomaly (Pp.str "cannot declare an empty list of inductives.") in let map_names mip = (mip.mind_entry_typename, mip.mind_entry_consnames) in let names = List.map map_names mie.mind_entry_inds in List.iter (fun (typ, cons) -> Declare.check_exists typ; List.iter Declare.check_exists cons) names; let mind = Global.add_mind ?typing_flags id mie in let () = Lib.add_leaf (inInductive (id, { ind_names = names })) in if is_unsafe_typing_flags() then feedback_axiom (); let isprim = Inductive.is_primitive_record (Inductive.lookup_mind_specif (Global.env()) (mind,0)) in Impargs.declare_mib_implicits mind; declare_inductive_argument_scopes mind mie; mind, isprim let is_recursive mie = let open Constr in let rec is_recursive_constructor lift n typ = match Constr.kind typ with | Prod (_,arg,rest) -> not (Vars.noccur_between lift n arg) || is_recursive_constructor (lift+1) n rest | LetIn (na,b,t,rest) -> is_recursive_constructor (lift+1) n rest | _ -> false in let nind = List.length mie.mind_entry_inds in let nparams = List.length mie.mind_entry_params in List.exists (fun ind -> List.exists (fun t -> is_recursive_constructor (nparams+1) nind t) ind.mind_entry_lc) mie.mind_entry_inds let warn_non_primitive_record = CWarnings.create ~name:"non-primitive-record" ~category:CWarnings.CoreCategories.records (fun indsp -> Pp.(hov 0 (str "The record " ++ Nametab.pr_global_env Id.Set.empty (GlobRef.IndRef indsp) ++ strbrk" could not be defined as a primitive record."))) let minductive_message = function | [] -> CErrors.user_err Pp.(str "No inductive definition.") | [x] -> Pp.(Id.print x ++ str " is defined") | l -> Pp.(hov 0 (prlist_with_sep pr_comma Id.print l ++ spc () ++ str "are defined")) type one_inductive_impls = Impargs.manual_implicits (* for inds *) * Impargs.manual_implicits list (* for constrs *) let { Goptions.get = default_prop_dep_elim } = Goptions.declare_bool_option_and_ref ~key:["Dependent";"Proposition";"Eliminators"] ~value:false () type default_dep_elim = DefaultElim | PropButDepElim let declare_mutual_inductive_with_eliminations ?(primitive_expected=false) ?typing_flags ?(indlocs=[]) ?default_dep_elim mie ubinders impls = (* spiwack: raises an error if the structure is supposed to be non-recursive, but isn't *) begin match mie.mind_entry_finite with | Declarations.BiFinite -> if is_recursive mie then if Option.has_some mie.mind_entry_record then CErrors.user_err Pp.(strbrk "Records declared with the keywords Record or Structure cannot be recursive. You can, however, define recursive records using the Inductive or CoInductive command.") else CErrors.user_err Pp.(strbrk "Types declared with the keyword Variant cannot be recursive. Recursive types are defined with the Inductive and CoInductive command."); if not (Int.equal (List.length mie.mind_entry_inds) 1) then if Option.has_some mie.mind_entry_record then CErrors.user_err Pp.(strbrk "Keywords Record and Structure are to define a single type at once.") else CErrors.user_err Pp.(strbrk "Keyword Variant is to define a single type at once.") | _ -> () end; let names = List.map (fun e -> e.mind_entry_typename) mie.mind_entry_inds in let mind, prim = declare_mind ?typing_flags mie in if primitive_expected && not prim then warn_non_primitive_record (mind,0); DeclareUniv.declare_univ_binders (GlobRef.IndRef (mind,0)) ubinders; List.iteri (fun i (indimpls, constrimpls) -> let ind = (mind,i) in let gr = GlobRef.IndRef ind in Impargs.maybe_declare_manual_implicits false gr indimpls; List.iteri (fun j impls -> Impargs.maybe_declare_manual_implicits false (GlobRef.ConstructRef (ind, succ j)) impls) constrimpls) impls; let () = match default_dep_elim with | None -> () | Some defaults -> List.iteri (fun i default -> let ind = (mind, i) in let prop_but_default_dep_elim = match default with | PropButDepElim -> true | DefaultElim -> default_prop_dep_elim () && let _, mip = Global.lookup_inductive ind in match mip.mind_arity with | RegularArity ar -> Sorts.is_prop ar.mind_sort | TemplateArity _ -> false in if prop_but_default_dep_elim then Indrec.declare_prop_but_default_dependent_elim ind) defaults in Flags.if_verbose Feedback.msg_info (minductive_message names); let locmap = Ind_tables.Locmap.make mind indlocs in if mie.mind_entry_private == None then Indschemes.declare_default_schemes mind ~locmap; mind module Internal = struct type nonrec inductive_obj = inductive_obj let objInductive = objInductive end coq-8.20.0/vernac/declareInd.mli000066400000000000000000000031031466560755400164150ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* ?typing_flags:Declarations.typing_flags -> ?indlocs:Loc.t option list (* Inductive type locs, for .glob *) -> ?default_dep_elim:default_dep_elim list -> Entries.mutual_inductive_entry (* Inductive types declaration *) -> UState.named_universes_entry -> one_inductive_impls list (* Implicit arguments *) -> Names.MutInd.t (** {6 For legacy support, do not use} *) module Internal : sig type inductive_obj val objInductive : (Names.Id.t * inductive_obj) Libobject.Dyn.tag end val declare_primitive_projection : Names.Projection.Repr.t -> Names.Constant.t -> unit coq-8.20.0/vernac/declareUniv.ml000066400000000000000000000146261466560755400164670ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* Some Pp.(seq [ Pp.pr_opt_no_spc (fun s -> str s ++ spc ()) kind ; Id.print id; str " already exists."]) | _ -> None) type universe_source = | BoundUniv (* polymorphic universe, bound in a function (this will go away someday) *) | QualifiedUniv of Id.t (* global universe introduced by some global value *) | UnqualifiedUniv (* other global universe *) type universe_name_decl = { udecl_src : universe_source; udecl_named : (Id.t * UGlobal.t) list; udecl_anon : UGlobal.t list; } let check_exists_universe sp = if Nametab.exists_universe sp then raise (AlreadyDeclared (Some "Universe", Libnames.basename sp)) else () let qualify_univ i dp src id = match src with | BoundUniv | UnqualifiedUniv -> i, Libnames.make_path dp id | QualifiedUniv l -> let dp = DirPath.repr dp in Nametab.map_visibility succ i, Libnames.make_path (DirPath.make (l::dp)) id let do_univ_name ~check i dp src (id,univ) = let i, sp = qualify_univ i dp src id in if check then check_exists_universe sp; Nametab.push_universe i sp univ let get_names decl = let fold accu (id, _) = Id.Set.add id accu in let names = List.fold_left fold Id.Set.empty decl.udecl_named in (* create fresh names for anonymous universes *) let fold u ((names, cnt), accu) = let rec aux i = let na = Id.of_string ("u"^(string_of_int i)) in if Id.Set.mem na names then aux (i+1) else (na, i) in let (id, cnt) = aux cnt in ((Id.Set.add id names, cnt + 1), ((id, u) :: accu)) in let _, univs = List.fold_right fold decl.udecl_anon ((names, 0), decl.udecl_named) in univs let cache_univ_names (prefix, decl) = let depth = Lib.sections_depth () in let dp = Libnames.pop_dirpath_n depth prefix.Nametab.obj_dir in let names = get_names decl in List.iter (do_univ_name ~check:true (Nametab.Until 1) dp decl.udecl_src) names let load_univ_names i (prefix, decl) = let names = get_names decl in List.iter (do_univ_name ~check:false (Nametab.Until i) prefix.Nametab.obj_dir decl.udecl_src) names let open_univ_names i (prefix, decl) = let names = get_names decl in List.iter (do_univ_name ~check:false (Nametab.Exactly i) prefix.Nametab.obj_dir decl.udecl_src) names let discharge_univ_names decl = match decl.udecl_src with | BoundUniv -> None | (QualifiedUniv _ | UnqualifiedUniv) -> Some decl let input_univ_names : universe_name_decl -> Libobject.obj = let open Libobject in declare_named_object_gen { (default_object "Global universe name state") with cache_function = cache_univ_names; load_function = load_univ_names; open_function = simple_open open_univ_names; discharge_function = discharge_univ_names; subst_function = (fun (subst, a) -> (* Actually the name is generated once and for all. *) a); classify_function = (fun a -> Substitute) } let input_univ_names (src, l, a) = if CList.is_empty l && CList.is_empty a then () else Lib.add_leaf (input_univ_names { udecl_src = src; udecl_named = l; udecl_anon = a }) let label_of = let open GlobRef in function | ConstRef c -> Label.to_id @@ Constant.label c | IndRef (c,_) -> Label.to_id @@ MutInd.label c | VarRef id -> id | ConstructRef _ -> CErrors.anomaly ~label:"declare_univ_binders" Pp.(str "declare_univ_binders on a constructor reference") let declare_univ_binders gr (univs, pl) = let l = label_of gr in match univs with | UState.Polymorphic_entry _ -> () | UState.Monomorphic_entry (levels, _) -> let qs, pl = pl in assert (Id.Map.is_empty qs); (* First the explicitly named universes *) let named, univs = Id.Map.fold (fun id univ (named,univs) -> let univs = match Level.name univ with | None -> assert false (* having Prop/Set/Var as binders is nonsense *) | Some univ -> (id,univ)::univs in let named = Level.Set.add univ named in named, univs) pl (Level.Set.empty,[]) in (* then keep the anonymous ones *) let fold u accu = Option.get (Level.name u) :: accu in let anonymous = Level.Set.fold fold (Level.Set.diff levels named) [] in input_univ_names (QualifiedUniv l, univs, anonymous) let do_universe ~poly l = let in_section = Lib.sections_are_opened () in let () = if poly && not in_section then CErrors.user_err (Pp.str"Cannot declare polymorphic universes outside sections.") in let l = List.map (fun {CAst.v=id} -> (id, UnivGen.new_univ_global ())) l in let src = if poly then BoundUniv else UnqualifiedUniv in let () = input_univ_names (src, l, []) in match poly with | false -> let ctx = List.fold_left (fun ctx (_,qid) -> Level.Set.add (Level.make qid) ctx) Level.Set.empty l, Constraints.empty in Global.push_context_set ~strict:true ctx | true -> let names = CArray.map_of_list (fun (na,_) -> Name na) l in let us = CArray.map_of_list (fun (_,l) -> Level.make l) l in let ctx = UVars.UContext.make ([||],names) (UVars.Instance.of_array ([||],us), Constraints.empty) in Global.push_section_context ctx let do_constraint ~poly l = let open Univ in let evd = Evd.from_env (Global.env ()) in let constraints = List.fold_left (fun acc cst -> let cst = Constrintern.interp_univ_constraint evd cst in Constraints.add cst acc) Constraints.empty l in match poly with | false -> let uctx = ContextSet.add_constraints constraints ContextSet.empty in Global.push_context_set ~strict:true uctx | true -> let uctx = UVars.UContext.make ([||],[||]) (UVars.Instance.empty,constraints) in Global.push_section_context uctx coq-8.20.0/vernac/declareUniv.mli000066400000000000000000000023361466560755400166330ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* UState.named_universes_entry -> unit (** Command [Universes]. *) val do_universe : poly:bool -> lident list -> unit (** Command [Constraint]. *) val do_constraint : poly:bool -> Constrexpr.univ_constraint_expr list -> unit coq-8.20.0/vernac/declaremods.ml000066400000000000000000001641161466560755400165100ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* None | InlineAt i -> Some i | DefaultInline -> default_inline () (** These functions register the visibility of the module and iterates through its components. They are called by plenty of module functions *) let consistency_checks exists dir = if exists then let _ = try Nametab.locate_module (qualid_of_dirpath dir) with Not_found -> user_err (DirPath.print dir ++ str " should already exist!") in () else if Nametab.exists_module dir then user_err (DirPath.print dir ++ str " already exists.") let rec get_module_path = function | MEident mp -> mp | MEwith (me,_) -> get_module_path me | MEapply (me,_) -> get_module_path me let type_of_mod mp env = function | true -> (Environ.lookup_module mp env).mod_type | false -> (Environ.lookup_modtype mp env).mod_type (** {6 Name management} Auxiliary functions to transform full_path and kernel_name given by Lib into ModPath.t and DirPath.t needed for modules *) let mp_of_kn kn = let mp,l = KerName.repr kn in MPdot (mp,l) let dir_of_sp sp = let dir,id = repr_path sp in add_dirpath_suffix dir id (** The [ModActions] abstraction represent operations on modules that are specific to a given stage. Two instances are defined below, for Synterp and Interp. *) module type ModActions = sig type typexpr type env val stage : Summary.Stage.t val substobjs_table_name : string val modobjs_table_name : string val enter_module : ModPath.t -> DirPath.t -> int -> unit val enter_modtype : ModPath.t -> full_path -> int -> unit val open_module : open_filter -> ModPath.t -> DirPath.t -> int -> unit module Lib : Lib.StagedLibS (** Create the substitution corresponding to some functor applications *) val compute_subst : is_mod:bool -> env -> MBId.t list -> ModPath.t -> ModPath.t list -> Entries.inline -> MBId.t list * substitution end module SynterpActions : ModActions with type env = unit with type typexpr = Constrexpr.universe_decl_expr option * Constrexpr.constr_expr = struct type typexpr = Constrexpr.universe_decl_expr option * Constrexpr.constr_expr type env = unit let stage = Summary.Stage.Synterp let substobjs_table_name = "MODULE-SYNTAX-SUBSTOBJS" let modobjs_table_name = "MODULE-SYNTAX-OBJS" let enter_module obj_mp obj_dir i = consistency_checks false obj_dir; Nametab.push_module (Until i) obj_dir obj_mp let enter_modtype mp sp i = if Nametab.exists_modtype sp then anomaly (pr_path sp ++ str " already exists."); Nametab.push_modtype (Nametab.Until i) sp mp let open_module f obj_mp obj_dir i = consistency_checks true obj_dir; if in_filter ~cat:None f then Nametab.push_module (Nametab.Exactly i) obj_dir obj_mp module Lib = Lib.Synterp let rec compute_subst () mbids mp_l inl = match mbids,mp_l with | _,[] -> mbids,empty_subst | [],r -> user_err Pp.(str "Application of a functor with too few arguments.") | mbid::mbids,mp::mp_l -> let mbid_left,subst = compute_subst () mbids mp_l inl in mbid_left,join (map_mbid mbid mp empty_delta_resolver) subst let compute_subst ~is_mod () mbids mp1 mp_l inl = compute_subst () mbids mp_l inl end module InterpActions : ModActions with type env = Environ.env with type typexpr = Constr.t * UVars.AbstractContext.t option = struct type typexpr = Constr.t * UVars.AbstractContext.t option type env = Environ.env let stage = Summary.Stage.Interp let substobjs_table_name = "MODULE-SUBSTOBJS" let modobjs_table_name = "MODULE-OBJS" (** {6 Current module type information} This information is stored by each [start_modtype] for use in a later [end_modtype]. *) let enter_module obj_mp obj_dir i = () let enter_modtype mp sp i = () let open_module f obj_mp obj_dir i = () module Lib = Lib.Interp let rec compute_subst env mbids sign mp_l inl = match mbids,mp_l with | _,[] -> mbids,empty_subst | [],r -> user_err Pp.(str "Application of a functor with too few arguments.") | mbid::mbids,mp::mp_l -> let farg_id, farg_b, fbody_b = Modops.destr_functor sign in let mb = Environ.lookup_module mp env in let mbid_left,subst = compute_subst env mbids fbody_b mp_l inl in let resolver = if Modops.is_functor mb.mod_type then empty_delta_resolver else Modops.inline_delta_resolver env inl mp farg_id farg_b mb.mod_delta in mbid_left,join (map_mbid mbid mp resolver) subst let compute_subst ~is_mod env mbids mp1 mp_l inl = let typ = type_of_mod mp1 env is_mod in compute_subst env mbids typ mp_l inl end type module_objects = { module_prefix : Nametab.object_prefix; module_substituted_objects : Libobject.t list; module_keep_objects : Libobject.t list; } (** The [StagedModS] abstraction describes module operations at a given stage. *) module type StagedModS = sig type typexpr type env val get_module_sobjs : bool -> env -> Entries.inline -> typexpr module_alg_expr -> substitutive_objects val load_module : int -> DirPath.t -> ModPath.t -> substitutive_objects -> Libobject.t list -> unit val import_modules : export:Lib.export_flag -> (open_filter * ModPath.t) list -> unit val add_leaf : Libobject.t -> unit val add_leaves : Libobject.t list -> unit val expand_aobjs : Libobject.algebraic_objects -> Libobject.t list val get_applications : typexpr module_alg_expr -> ModPath.t * ModPath.t list val debug_print_modtab : unit -> Pp.t module ModObjs : sig val all : unit -> module_objects MPmap.t end end (** Some utilities about substitutive objects : substitution, expansion *) let sobjs_no_functor (mbids,_) = List.is_empty mbids let subst_filtered sub (f,mp as x) = let mp' = subst_mp sub mp in if mp == mp' then x else f, mp' let rec subst_aobjs sub = function | Objs o as objs -> let o' = subst_objects sub o in if o == o' then objs else Objs o' | Ref (mp, sub0) as r -> let sub0' = join sub0 sub in if sub0' == sub0 then r else Ref (mp, sub0') and subst_sobjs sub (mbids,aobjs as sobjs) = let aobjs' = subst_aobjs sub aobjs in if aobjs' == aobjs then sobjs else (mbids, aobjs') and subst_objects subst seg = let subst_one node = match node with | AtomicObject obj -> let obj' = Libobject.subst_object (subst,obj) in if obj' == obj then node else AtomicObject obj' | ModuleObject (id, sobjs) -> let sobjs' = subst_sobjs subst sobjs in if sobjs' == sobjs then node else ModuleObject (id, sobjs') | ModuleTypeObject (id, sobjs) -> let sobjs' = subst_sobjs subst sobjs in if sobjs' == sobjs then node else ModuleTypeObject (id, sobjs') | IncludeObject aobjs -> let aobjs' = subst_aobjs subst aobjs in if aobjs' == aobjs then node else IncludeObject aobjs' | ExportObject { mpl } -> let mpl' = List.Smart.map (subst_filtered subst) mpl in if mpl'==mpl then node else ExportObject { mpl = mpl' } | KeepObject _ -> assert false in List.Smart.map subst_one seg (** The [StagedMod] abstraction factors out the code dealing with modules that is common to all stages. *) module StagedMod(Actions : ModActions) = struct type typexpr = Actions.typexpr type env = Actions.env (** ModSubstObjs : a cache of module substitutive objects This table is common to modules and module types. - For a Module M:=N, the objects of N will be reloaded with M after substitution. - For a Module M:SIG:=..., the module M gets its objects from SIG Invariants: - A alias (i.e. a module path inside a Ref constructor) should never lead to another alias, but rather to a concrete Objs constructor. We will plug later a handler dealing with missing entries in the cache. Such missing entries may come from inner parts of module types, which aren't registered by the standard libobject machinery. *) module ModSubstObjs : sig val set : ModPath.t -> substitutive_objects -> unit val get : ModPath.t -> substitutive_objects val set_missing_handler : (ModPath.t -> substitutive_objects) -> unit end = struct let table = Summary.ref ~stage:Actions.stage (MPmap.empty : substitutive_objects MPmap.t) ~name:Actions.substobjs_table_name let missing_handler = ref (fun mp -> assert false) let set_missing_handler f = (missing_handler := f) let set mp objs = (table := MPmap.add mp objs !table) let get mp = try MPmap.find mp !table with Not_found -> !missing_handler mp end let expand_aobjs = function | Objs o -> o | Ref (mp, sub) -> match ModSubstObjs.get mp with | (_,Objs o) -> subst_objects sub o | _ -> assert false (* Invariant : any alias points to concrete objs *) let expand_sobjs (_,aobjs) = expand_aobjs aobjs (** {6 ModObjs : a cache of module objects} For each module, we also store a cache of "prefix", "substituted objects", "keep objects". This is used for instance to implement the "Import" command. substituted objects : roughly the objects above after the substitution - we need to keep them to call open_object when the module is opened (imported) keep objects : The list of non-substitutive objects - as above, for each of them we will call open_object when the module is opened (Some) Invariants: * If the module is a functor, it won't appear in this cache. * Module objects in substitutive_objects part have empty substituted objects. * Modules which where created with Module M:=mexpr or with Module M:SIG. ... End M. have the keep list empty. *) module ModObjs : sig val set : ModPath.t -> module_objects -> unit val get : ModPath.t -> module_objects (* may raise Not_found *) val all : unit -> module_objects MPmap.t end = struct let table = Summary.ref ~stage:Actions.stage (MPmap.empty : module_objects MPmap.t) ~name:Actions.modobjs_table_name let set mp objs = (table := MPmap.add mp objs !table) let get mp = MPmap.find mp !table let all () = !table end (** {6 Declaration of module substitutive objects} *) (** Nota: Interactive modules and module types cannot be recached! This used to be checked here via a flag along the substobjs. *) (** {6 Declaration of module type substitutive objects} *) (** Nota: Interactive modules and module types cannot be recached! This used to be checked more properly here. *) let load_modtype i sp mp sobjs = Actions.enter_modtype mp sp i; ModSubstObjs.set mp sobjs (** {6 Declaration of substitutive objects for Include} *) let rec load_object i (prefix, obj) = match obj with | AtomicObject o -> Libobject.load_object i (prefix, o) | ModuleObject (id,sobjs) -> let sp, kn as name = Lib.make_oname prefix id in load_module i (dir_of_sp sp) (mp_of_kn kn) sobjs [] | ModuleTypeObject (id,sobjs) -> let name = Lib.make_oname prefix id in let (sp,kn) = name in load_modtype i sp (mp_of_kn kn) sobjs | IncludeObject aobjs -> load_include i (prefix, aobjs) | ExportObject _ -> () | KeepObject (id,objs) -> let name = Lib.make_oname prefix id in load_keep i (name, objs) and load_objects i prefix objs = List.iter (fun obj -> load_object i (prefix, obj)) objs and load_include i (prefix, aobjs) = let o = expand_aobjs aobjs in load_objects i prefix o and load_keep i ((sp,kn),kobjs) = (* Invariant : seg isn't empty *) let obj_dir = dir_of_sp sp and obj_mp = mp_of_kn kn in let prefix = Nametab.{ obj_dir ; obj_mp; } in let modobjs = try ModObjs.get obj_mp with Not_found -> assert false (* a substobjs should already be loaded *) in assert Nametab.(eq_op modobjs.module_prefix prefix); assert (List.is_empty modobjs.module_keep_objects); ModObjs.set obj_mp { modobjs with module_keep_objects = kobjs }; load_objects i prefix kobjs and load_module i obj_dir obj_mp sobjs kobjs = let prefix = Nametab.{ obj_dir ; obj_mp; } in Actions.enter_module obj_mp obj_dir i; ModSubstObjs.set obj_mp sobjs; (* If we're not a functor, let's iter on the internal components *) if sobjs_no_functor sobjs then begin let objs = expand_sobjs sobjs in let module_objects = { module_prefix = prefix; module_substituted_objects = objs; module_keep_objects = kobjs; } in ModObjs.set obj_mp module_objects; load_objects (i+1) prefix objs; load_objects (i+1) prefix kobjs end (** {6 Implementation of Import and Export commands} *) let mark_object f obj (exports,acc) = (exports, (f,obj)::acc) let rec collect_module (f,mp) acc = try (* May raise Not_found for unknown module and for functors *) let modobjs = ModObjs.get mp in let prefix = modobjs.module_prefix in let acc = collect_objects f 1 prefix modobjs.module_keep_objects acc in collect_objects f 1 prefix modobjs.module_substituted_objects acc with Not_found when Actions.stage = Summary.Stage.Synterp -> acc and collect_object f i prefix obj acc = match obj with | ExportObject { mpl } -> collect_exports f i mpl acc | AtomicObject _ | IncludeObject _ | KeepObject _ | ModuleObject _ | ModuleTypeObject _ -> mark_object f (prefix,obj) acc and collect_objects f i prefix objs acc = List.fold_left (fun acc obj -> collect_object f i prefix obj acc) acc (List.rev objs) and collect_export f (f',mp) (exports,objs as acc) = match filter_and f f' with | None -> acc | Some f -> let exports' = MPmap.update mp (function | None -> Some f | Some f0 -> let f' = filter_or f f0 in if filter_eq f' f0 then Some f0 else Some f') exports in (* If the map doesn't change there is nothing new to export. *) if exports == exports' then acc else collect_module (f,mp) (exports', objs) and collect_exports f i mpl acc = if Int.equal i 1 then List.fold_left (fun acc fmp -> collect_export f fmp acc) acc (List.rev mpl) else acc let collect_modules mpl = List.fold_left (fun acc fmp -> collect_module fmp acc) (MPmap.empty, []) (List.rev mpl) let open_modtype i ((sp,kn),_) = let mp = mp_of_kn kn in let mp' = try Nametab.locate_modtype (qualid_of_path sp) with Not_found -> anomaly (pr_path sp ++ str " should already exist!"); in assert (ModPath.equal mp mp'); Nametab.push_modtype (Nametab.Exactly i) sp mp let rec open_object f i (prefix, obj) = match obj with | AtomicObject o -> Libobject.open_object f i (prefix, o) | ModuleObject (id,sobjs) -> let name = Lib.make_oname prefix id in let dir = dir_of_sp (fst name) in let mp = mp_of_kn (snd name) in open_module f i dir mp sobjs | ModuleTypeObject (id,sobjs) -> let name = Lib.make_oname prefix id in open_modtype i (name, sobjs) | IncludeObject aobjs -> open_include f i (prefix, aobjs) | ExportObject { mpl } -> open_export f i mpl | KeepObject (id,objs) -> let name = Lib.make_oname prefix id in open_keep f i (name, objs) and open_module f i obj_dir obj_mp sobjs = Actions.open_module f obj_mp obj_dir i; (* If we're not a functor, let's iter on the internal components *) if sobjs_no_functor sobjs then begin let modobjs = ModObjs.get obj_mp in open_objects f (i+1) modobjs.module_prefix modobjs.module_substituted_objects end and open_objects f i prefix objs = List.iter (fun obj -> open_object f i (prefix, obj)) objs and open_include f i (prefix, aobjs) = let o = expand_aobjs aobjs in open_objects f i prefix o and open_export f i mpl = let _,objs = collect_exports f i mpl (MPmap.empty, []) in List.iter (fun (f,o) -> open_object f 1 o) objs and open_keep f i ((sp,kn),kobjs) = let obj_dir = dir_of_sp sp and obj_mp = mp_of_kn kn in let prefix = Nametab.{ obj_dir; obj_mp; } in open_objects f i prefix kobjs let cache_include (prefix, aobjs) = let o = expand_aobjs aobjs in load_objects 1 prefix o; open_objects unfiltered 1 prefix o let cache_object (prefix, obj) = match obj with | AtomicObject o -> Libobject.cache_object (prefix, o) | ModuleObject _ -> load_object 1 (prefix,obj) | ModuleTypeObject _ -> load_object 0 (prefix,obj) | IncludeObject aobjs -> cache_include (prefix, aobjs) | ExportObject { mpl } -> anomaly Pp.(str "Export should not be cached") | KeepObject _ -> anomaly (Pp.str "This module should not be cached!") (* Adding operations with containers *) let add_leaf_entry = match Actions.stage with | Summary.Stage.Synterp -> Lib.Synterp.add_leaf_entry | Summary.Stage.Interp -> Lib.Interp.add_leaf_entry let add_leaf obj = cache_object (Lib.prefix (),obj); add_leaf_entry obj let add_leaves objs = let add_obj obj = add_leaf_entry obj; load_object 1 (Lib.prefix (),obj) in List.iter add_obj objs let import_modules ~export mpl = let _,objs = collect_modules mpl in List.iter (fun (f,o) -> open_object f 1 o) objs; match export with | Lib.Import -> () | Lib.Export -> let entry = ExportObject { mpl } in add_leaf_entry entry (** {6 Handler for missing entries in ModSubstObjs} *) (** Since the inner of Module Types are not added by default to the ModSubstObjs table, we compensate this by explicit traversal of Module Types inner objects when needed. Quite a hack... *) let mp_id mp id = MPdot (mp, Label.of_id id) let rec register_mod_objs mp obj = match obj with | ModuleObject (id,sobjs) -> ModSubstObjs.set (mp_id mp id) sobjs | ModuleTypeObject (id,sobjs) -> ModSubstObjs.set (mp_id mp id) sobjs | IncludeObject aobjs -> List.iter (register_mod_objs mp) (expand_aobjs aobjs) | _ -> () let handle_missing_substobjs mp = match mp with | MPdot (mp',l) -> let objs = expand_sobjs (ModSubstObjs.get mp') in List.iter (register_mod_objs mp') objs; ModSubstObjs.get mp | _ -> assert false (* Only inner parts of module types should be missing *) let () = ModSubstObjs.set_missing_handler handle_missing_substobjs (** {6 From module expression to substitutive objects} *) (** Turn a chain of [MSEapply] into the head ModPath.t and the list of ModPath.t parameters (deepest param coming first). The left part of a [MSEapply] must be either [MSEident] or another [MSEapply]. *) let get_applications mexpr = let rec get params = function | MEident mp -> mp, params | MEapply (fexpr, mp) -> get (mp::params) fexpr | MEwith _ -> user_err Pp.(str "Non-atomic functor application.") in get [] mexpr (** Create the objects of a "with Module" structure. *) let rec replace_module_object idl mp0 objs0 mp1 objs1 = match idl, objs0 with | _,[] -> [] | id::idl,(ModuleObject (id', sobjs))::tail when Id.equal id id' -> begin let mp_id = MPdot(mp0, Label.of_id id) in let objs = match idl with | [] -> subst_objects (map_mp mp1 mp_id empty_delta_resolver) objs1 | _ -> let objs_id = expand_sobjs sobjs in replace_module_object idl mp_id objs_id mp1 objs1 in (ModuleObject (id, ([], Objs objs)))::tail end | idl,lobj::tail -> lobj::replace_module_object idl mp0 tail mp1 objs1 (** Substitutive objects of a module expression (or module type) *) let rec get_module_sobjs is_mod env inl = function | MEident mp -> begin match ModSubstObjs.get mp with | (mbids,Objs _) when not (ModPath.is_bound mp) -> (mbids,Ref (mp, empty_subst)) (* we create an alias *) | sobjs -> sobjs end | MEwith (mty, WithDef _) -> get_module_sobjs is_mod env inl mty | MEwith (mty, WithMod (idl,mp1)) -> assert (not is_mod); let sobjs0 = get_module_sobjs is_mod env inl mty in if not (sobjs_no_functor sobjs0) then user_err Pp.(str "Illegal use of a functor."); (* For now, we expand everything, to be safe *) let mp0 = get_module_path mty in let objs0 = expand_sobjs sobjs0 in let objs1 = expand_sobjs (ModSubstObjs.get mp1) in ([], Objs (replace_module_object idl mp0 objs0 mp1 objs1)) | MEapply _ as me -> let mp1, mp_l = get_applications me in let mbids, aobjs = get_module_sobjs is_mod env inl (MEident mp1) in let mbids_left,subst = Actions.compute_subst ~is_mod env mbids mp1 mp_l inl in (mbids_left, subst_aobjs subst aobjs) let debug_print_modtab () = let pr_seg = function | [] -> str "[]" | l -> str "[." ++ int (List.length l) ++ str ".]" in let pr_modinfo mp modobjs s = let objs = modobjs.module_substituted_objects @ modobjs.module_keep_objects in s ++ str (ModPath.to_string mp) ++ spc () ++ pr_seg objs in let modules = MPmap.fold pr_modinfo (ModObjs.all ()) (mt ()) in hov 0 modules end module SynterpVisitor : StagedModS with type env = SynterpActions.env with type typexpr = Constrexpr.universe_decl_expr option * Constrexpr.constr_expr = StagedMod(SynterpActions) module InterpVisitor : StagedModS with type env = InterpActions.env with type typexpr = Constr.t * UVars.AbstractContext.t option = StagedMod(InterpActions) (** {6 Modules : start, end, declare} *) type current_module_syntax_info = { cur_mp : ModPath.t; cur_typ : ((Constrexpr.universe_decl_expr option * Constrexpr.constr_expr) module_alg_expr * int option) option; cur_mbids : MBId.t list; } let default_module_syntax_info mp = { cur_mp = mp; cur_typ = None; cur_mbids = [] } let openmod_syntax_info = Summary.ref None ~stage:Summary.Stage.Synterp ~name:"MODULE-SYNTAX-INFO" (** {6 Current module information} This information is stored by each [start_module] for use in a later [end_module]. *) type current_module_info = { cur_typ : (module_struct_entry * int option) option; (** type via ":" *) cur_typs : module_type_body list (** types via "<:" *) } let default_module_info = { cur_typ = None; cur_typs = [] } let openmod_info = Summary.ref default_module_info ~name:"MODULE-INFO" let start_library dir = let mp = Global.start_library dir in openmod_info := default_module_info; openmod_syntax_info := Some (default_module_syntax_info mp); Lib.start_compilation dir mp let set_openmod_syntax_info info = match !openmod_syntax_info with | None -> anomaly Pp.(str "bad init of openmod_syntax_info") | Some _ -> openmod_syntax_info := Some info let openmod_syntax_info () = match !openmod_syntax_info with | None -> anomaly Pp.(str "missing init of openmod_syntax_info") | Some v -> v let vm_state = (* VM bytecode is not needed here *) let vm_handler _ _ _ () = (), None in ((), { Mod_typing.vm_handler }) module RawModOps = struct module Synterp = struct let build_subtypes mtys = List.map (fun (m,ann) -> let inl = inl2intopt ann in let mte, base, kind = Modintern.intern_module_ast Modintern.ModType m in (mte, base, kind, inl)) mtys let intern_arg (idl,(typ,ann)) = let inl = inl2intopt ann in let lib_dir = Lib.library_dp() in let (mty, base, kind) = Modintern.intern_module_ast Modintern.ModType typ in let sobjs = SynterpVisitor.get_module_sobjs false () inl mty in let mp0 = get_module_path mty in let map {CAst.v=id} = let dir = DirPath.make [id] in let mbid = MBId.make lib_dir id in let mp = MPbound mbid in (* We can use an empty delta resolver because we load only syntax objects *) let sobjs = subst_sobjs (map_mp mp0 mp empty_delta_resolver) sobjs in SynterpVisitor.load_module 1 dir mp sobjs []; mbid in List.map map idl, (mty, base, kind, inl) let intern_args params = List.map intern_arg params let start_module_core id args res = (* Loads the parsing objects in arguments *) let args = intern_args args in let mbids = List.flatten @@ List.map (fun (mbidl,_) -> mbidl) args in let res_entry_o, sign = match res with | Enforce (res,ann) -> let inl = inl2intopt ann in let (mte, base, kind) = Modintern.intern_module_ast Modintern.ModType res in Some (mte, inl), Enforce (mte, base, kind, inl) | Check resl -> None, Check (build_subtypes resl) in let mp = ModPath.MPdot((openmod_syntax_info ()).cur_mp, Label.of_id id) in mp, res_entry_o, mbids, sign, args let start_module export id args res = let () = if Option.has_some export && not (CList.is_empty args) then user_err Pp.(str "Cannot import functors.") in let fs = Summary.Synterp.freeze_summaries () in let mp, res_entry_o, mbids, sign, args = start_module_core id args res in set_openmod_syntax_info { cur_mp = mp; cur_typ = res_entry_o; cur_mbids = mbids }; let prefix = Lib.Synterp.start_module export id mp fs in Nametab.(push_dir (Until 1) (prefix.obj_dir) (GlobDirRef.DirOpenModule prefix.obj_mp)); mp, args, sign let end_module_core id (m_info : current_module_syntax_info) objects fs = let {Lib.Synterp.substobjs = substitute; keepobjs = keep; anticipateobjs = special; } = objects in (* For sealed modules, we use the substitutive objects of their signatures *) let sobjs0, keep, special = match m_info.cur_typ with | None -> ([], Objs substitute), keep, special | Some (mty, inline) -> SynterpVisitor.get_module_sobjs false () inline mty, [], special in Summary.Synterp.unfreeze_summaries fs; let sobjs = let (ms,objs) = sobjs0 in (m_info.cur_mbids@ms,objs) in (* We substitute objects if the module is sealed by a signature *) let sobjs = match m_info.cur_typ with | None -> sobjs | Some (mty, _) -> subst_sobjs (map_mp (get_module_path mty) m_info.cur_mp empty_delta_resolver) sobjs in let node = ModuleObject (id,sobjs) in (* We add the keep objects, if any, and if this isn't a functor *) let objects = match keep, m_info.cur_mbids with | [], _ | _, _ :: _ -> special@[node] | _ -> special@[node;KeepObject (id,keep)] in (* Name consistency check : start_ vs. end_module *) (* Printf.eprintf "newoname=%s, oldoname=%s\n" (string_of_path (fst newoname)) (string_of_path (fst oldoname)); assert (DirPath.equal (Lib.prefix()).Nametab.obj_dir olddp); assert (ModPath.equal oldprefix.Nametab.obj_mp mp); *) (* Printf.eprintf "newoname=%s, oldoname=%s\n" (string_of_path (fst newoname)) (string_of_path (fst oldoname)); *) (* Printf.eprintf "newoname=%s, cur_mp=%s\n" (ModPath.debug_to_string (mp_of_kn (snd newoname))) (ModPath.debug_to_string m_info.cur_mp); *) m_info.cur_mp, objects let end_module () = let oldprefix,fs,objects = Lib.Synterp.end_module () in let m_info = openmod_syntax_info () in let olddp, id = split_dirpath oldprefix.Nametab.obj_dir in let mp,objects = end_module_core id m_info objects fs in let () = SynterpVisitor.add_leaves objects in (* Name consistency check : kernel vs. library *) (* CDebug.debug_synterp (fun () -> Pp.(str"prefix=" ++ DirPath.print ((Lib.prefix()).Nametab.obj_dir) ++ str", olddp=" ++ DirPath.print olddp)); *) assert (DirPath.equal (Lib.prefix()).Nametab.obj_dir olddp); mp let get_functor_sobjs is_mod inl (mbids,mexpr) = let (mbids0, aobjs) = SynterpVisitor.get_module_sobjs is_mod () inl mexpr in (mbids @ mbids0, aobjs) let declare_module id args res mexpr_o = let fs = Summary.Synterp.freeze_summaries () in (* We simulate the beginning of an interactive module, then we adds the module parameters to the global env. *) let mp = ModPath.MPdot((openmod_syntax_info ()).cur_mp, Label.of_id id) in let args = intern_args args in let mbids = List.flatten @@ List.map fst args in let mty_entry_o = match res with | Enforce (mty,ann) -> let inl = inl2intopt ann in let (mte, base, kind) = Modintern.intern_module_ast Modintern.ModType mty in Enforce (mte, base, kind, inl) | Check mtys -> Check (build_subtypes mtys) in let mexpr_entry_o = match mexpr_o with | None -> None | Some (mexpr,ann) -> let (mte, base, kind) = Modintern.intern_module_ast Modintern.Module mexpr in Some (mte, base, kind, inl2intopt ann) in let sobjs, mp0 = match mexpr_entry_o, mty_entry_o with | None, Check _ -> assert false (* No body, no type ... *) | _, Enforce (typ,_,_,inl_res) -> get_functor_sobjs false inl_res (mbids,typ), get_module_path typ | Some (body, _, _, inl_expr), Check _ -> get_functor_sobjs true inl_expr (mbids,body), get_module_path body in (* Undo the simulated interactive building of the module and declare the module as a whole *) Summary.Synterp.unfreeze_summaries fs; (* We can use an empty delta resolver on syntax objects *) let sobjs = subst_sobjs (map_mp mp0 mp empty_delta_resolver) sobjs in ignore (SynterpVisitor.add_leaf (ModuleObject (id,sobjs))); mp, args, mexpr_entry_o, mty_entry_o end module Interp = struct (** {6 Auxiliary functions concerning subtyping checks} *) let check_sub mtb sub_mtb_l = let fold sub_mtb (cst, env) = let state = ((Environ.universes env, cst), Reductionops.inferred_universes) in let graph, cst = Subtyping.check_subtypes state env mtb sub_mtb in (cst, Environ.set_universes graph env) in let cst, _ = List.fold_right fold sub_mtb_l (Univ.Constraints.empty, Global.env ()) in Global.add_constraints cst (** This function checks if the type calculated for the module [mp] is a "<:"-like subtype of all signatures in [sub_mtb_l]. Uses only the global environment. *) let check_subtypes mp sub_mtb_l = let mb = try Global.lookup_module mp with Not_found -> assert false in let mtb = Modops.module_type_of_module mb in check_sub mtb sub_mtb_l (** Same for module type [mp] *) let check_subtypes_mt mp sub_mtb_l = let mtb = try Global.lookup_modtype mp with Not_found -> assert false in check_sub mtb sub_mtb_l let current_modresolver () = fst @@ Safe_typing.delta_of_senv @@ Global.safe_env () let current_struct () = let struc = Safe_typing.structure_body_of_safe_env @@ Global.safe_env () in NoFunctor (List.rev struc) (** Prepare the module type list for check of subtypes *) let build_subtypes env mp args mtys = let (ctx, ans) = List.fold_left_map (fun ctx (mte,base,kind,inl) -> let mte, ctx' = Modintern.interp_module_ast env Modintern.ModType base mte in let env = Environ.push_context_set ~strict:true ctx' env in let ctx = Univ.ContextSet.union ctx ctx' in let state = ((Environ.universes env, Univ.Constraints.empty), Reductionops.inferred_universes) in let mtb, (_, cst), _ = Mod_typing.translate_modtype state vm_state env mp inl (args,mte) in let ctx = Univ.ContextSet.add_constraints cst ctx in ctx, mtb) Univ.ContextSet.empty mtys in (ans, ctx) (** Process a declaration of functor parameter(s) (Id1 .. Idn : Typ) i.e. possibly multiple names with the same module type. Global environment is updated on the fly. Objects in these parameters are also loaded. Output is accumulated on top of [acc] (in reverse order). *) let intern_arg (acc, cst) (mbidl,(mty, base, kind, inl)) = let env = Global.env() in let (mty, cst') = Modintern.interp_module_ast env kind base mty in let () = Global.push_context_set ~strict:true cst' in let () = let state = ((Global.universes (), Univ.Constraints.empty), Reductionops.inferred_universes) in let _, (_, cst), _ = Mod_typing.translate_modtype state vm_state (Global.env ()) base inl ([], mty) in Global.add_constraints cst in let env = Global.env () in let sobjs = InterpVisitor.get_module_sobjs false env inl mty in let mp0 = get_module_path mty in let fold acc mbid = let id = MBId.to_id mbid in let dir = DirPath.make [id] in let mp = MPbound mbid in let resolver = Global.add_module_parameter mbid mty inl in let sobjs = subst_sobjs (map_mp mp0 mp resolver) sobjs in InterpVisitor.load_module 1 dir mp sobjs []; (mbid,mty,inl)::acc in let acc = List.fold_left fold acc mbidl in (acc, Univ.ContextSet.union cst cst') (** Process a list of declarations of functor parameters (Id11 .. Id1n : Typ1)..(Idk1 .. Idkm : Typk) Global environment is updated on the fly. The calls to [interp_modast] should be interleaved with these env updates, otherwise some "with Definition" could be rejected. Returns a list of mbids and entries (in reversed order). This used to be a [List.concat (List.map ...)], but this should be more efficient and independent of [List.map] eval order. *) let intern_args params = let args, ctx = List.fold_left intern_arg ([], Univ.ContextSet.empty) params in List.rev args, ctx let start_module_core id args res = let mp = Global.start_module id in let params, ctx = intern_args args in let () = Global.push_context_set ~strict:true ctx in let env = Global.env () in let res_entry_o, subtyps, ctx' = match res with | Enforce (mte, base, kind, inl) -> let (mte, ctx) = Modintern.interp_module_ast env kind base mte in let env = Environ.push_context_set ~strict:true ctx env in (* We check immediately that mte is well-formed *) let state = ((Environ.universes env, Univ.Constraints.empty), Reductionops.inferred_universes) in let _, (_, cst), _ = Mod_typing.translate_modtype state vm_state env mp inl ([], mte) in let ctx = Univ.ContextSet.add_constraints cst ctx in Some (mte, inl), [], ctx | Check resl -> let typs, ctx = build_subtypes env mp params resl in None, typs, ctx in let () = Global.push_context_set ~strict:true ctx' in mp, res_entry_o, subtyps, params, Univ.ContextSet.union ctx ctx' let start_module export id args res = let fs = Summary.Interp.freeze_summaries () in let mp, res_entry_o, subtyps, _, _ = start_module_core id args res in openmod_info := { cur_typ = res_entry_o; cur_typs = subtyps }; let _ : Nametab.object_prefix = Lib.Interp.start_module export id mp fs in mp let end_module_core id m_info objects fs = let {Lib.Interp.substobjs = substitute; keepobjs = keep; anticipateobjs = special; } = objects in (* For sealed modules, we use the substitutive objects of their signatures *) let sobjs0, keep = match m_info.cur_typ with | None -> ([], Objs substitute), keep | Some (mty, inline) -> InterpVisitor.get_module_sobjs false (Global.env()) inline mty, [] in let struc = current_struct () in let restype' = Option.map (fun (ty,inl) -> (([],ty),inl)) m_info.cur_typ in let state = ((Global.universes (), Univ.Constraints.empty), Reductionops.inferred_universes) in let _, (_, cst), _ = Mod_typing.finalize_module state vm_state (Global.env ()) (Global.current_modpath ()) (struc, current_modresolver ()) restype' in let () = Global.add_constraints cst in let mp,mbids,resolver = Global.end_module fs id m_info.cur_typ in let sobjs = let (ms,objs) = sobjs0 in (mbids@ms,objs) in let () = check_subtypes mp m_info.cur_typs in (* We substitute objects if the module is sealed by a signature *) let sobjs = match m_info.cur_typ with | None -> sobjs | Some (mty, _) -> subst_sobjs (map_mp (get_module_path mty) mp resolver) sobjs in let node = ModuleObject (id,sobjs) in (* We add the keep objects, if any, and if this isn't a functor *) let objects = match keep, mbids with | [], _ | _, _ :: _ -> special@[node] | _ -> special@[node;KeepObject (id,keep)] in mp, objects let end_module () = let oldprefix,fs,objects = Lib.Interp.end_module () in let m_info = !openmod_info in let olddp, id = split_dirpath oldprefix.Nametab.obj_dir in let mp,objects = end_module_core id m_info objects fs in let () = InterpVisitor.add_leaves objects in (* Name consistency check : kernel vs. library *) assert (ModPath.equal oldprefix.Nametab.obj_mp mp); mp let get_functor_sobjs is_mod env inl (params,mexpr) = let (mbids, aobjs) = InterpVisitor.get_module_sobjs is_mod env inl mexpr in (List.map pi1 params @ mbids, aobjs) (* TODO cleanup push universes directly to global env *) let declare_module id args res mexpr_o = let fs = Summary.Interp.freeze_summaries () in (* We simulate the beginning of an interactive module, then we adds the module parameters to the global env. *) let mp, mty_entry_o, subs, params, ctx = start_module_core id args res in let env = Global.env () in let mexpr_entry_o, inl_expr, ctx' = match mexpr_o with | None -> None, default_inline (), Univ.ContextSet.empty | Some (mte, base, kind, inl) -> let (mte, ctx) = Modintern.interp_module_ast env kind base mte in Some mte, inl, ctx in let env = Environ.push_context_set ~strict:true ctx' env in let ctx = Univ.ContextSet.union ctx ctx' in let entry, inl_res = match mexpr_entry_o, mty_entry_o with | None, None -> assert false (* No body, no type ... *) | None, Some (typ, inl) -> MType (params, typ), inl | Some body, otyp -> MExpr (params, body, Option.map fst otyp), Option.cata snd (default_inline ()) otyp in let sobjs, mp0 = match entry with | MType (_,mte) | MExpr (_,_,Some mte) -> get_functor_sobjs false env inl_res (params,mte), get_module_path mte | MExpr (_,me,None) -> get_functor_sobjs true env inl_expr (params,me), get_module_path me in (* Undo the simulated interactive building of the module and declare the module as a whole *) Summary.Interp.unfreeze_summaries fs; let inl = match inl_expr with | None -> None | _ -> inl_res in let () = Global.push_context_set ~strict:true ctx in let state = ((Global.universes (), Univ.Constraints.empty), Reductionops.inferred_universes) in let _, (_, cst), _ = Mod_typing.translate_module state vm_state (Global.env ()) mp inl entry in let () = Global.add_constraints cst in let mp_env,resolver = Global.add_module id entry inl in (* Name consistency check : kernel vs. library *) assert (ModPath.equal mp (mp_of_kn (Lib.make_kn id))); assert (ModPath.equal mp mp_env); let () = check_subtypes mp subs in let sobjs = subst_sobjs (map_mp mp0 mp resolver) sobjs in InterpVisitor.add_leaf (ModuleObject (id,sobjs)); mp end end (** {6 Module types : start, end, declare} *) module RawModTypeOps = struct module Synterp = struct let start_modtype_core id cur_mp args mtys = let mp = ModPath.MPdot(cur_mp, Label.of_id id) in let args = RawModOps.Synterp.intern_args args in let mbids = List.flatten @@ List.map (fun (mbidl,_) -> mbidl) args in let sub_mty_l = RawModOps.Synterp.build_subtypes mtys in mp, mbids, args, sub_mty_l let start_modtype id args mtys = let fs = Summary.Synterp.freeze_summaries () in let mp, mbids, args, sub_mty_l = start_modtype_core id (openmod_syntax_info ()).cur_mp args mtys in set_openmod_syntax_info { cur_mp = mp; cur_typ = None; cur_mbids = mbids }; let prefix = Lib.Synterp.start_modtype id mp fs in Nametab.(push_dir (Until 1) (prefix.obj_dir) (GlobDirRef.DirOpenModtype prefix.obj_mp)); mp, args, sub_mty_l let end_modtype_core id mbids objects fs = let {Lib.Synterp.substobjs = substitute; keepobjs = _; anticipateobjs = special; } = objects in Summary.Synterp.unfreeze_summaries fs; let modtypeobjs = (mbids, Objs substitute) in (special@[ModuleTypeObject (id,modtypeobjs)]) let end_modtype () = let oldprefix,fs,objects = Lib.Synterp.end_modtype () in let olddp, id = split_dirpath oldprefix.Nametab.obj_dir in let objects = end_modtype_core id (openmod_syntax_info ()).cur_mbids objects fs in SynterpVisitor.add_leaves objects; (openmod_syntax_info ()).cur_mp let declare_modtype id args mtys (mty,ann) = let fs = Summary.Synterp.freeze_summaries () in let inl = inl2intopt ann in (* We simulate the beginning of an interactive module, then we adds the module parameters to the global env. *) let mp, mbids, args, sub_mty_l = start_modtype_core id (openmod_syntax_info ()).cur_mp args mtys in let mte, base, kind = Modintern.intern_module_ast Modintern.ModType mty in let entry = mbids, mte in let sobjs = RawModOps.Synterp.get_functor_sobjs false inl entry in let subst = map_mp (get_module_path (snd entry)) mp empty_delta_resolver in let sobjs = subst_sobjs subst sobjs in (* Undo the simulated interactive building of the module type and declare the module type as a whole *) Summary.Synterp.unfreeze_summaries fs; ignore (SynterpVisitor.add_leaf (ModuleTypeObject (id,sobjs))); mp, args, (mte, base, kind, inl), sub_mty_l end module Interp = struct let openmodtype_info = Summary.ref ([] : module_type_body list) ~name:"MODTYPE-INFO" let start_modtype_core id args mtys = let mp = Global.start_modtype id in let params, params_ctx = RawModOps.Interp.intern_args args in let () = Global.push_context_set ~strict:true params_ctx in let env = Global.env () in let sub_mty_l, sub_mty_ctx = RawModOps.Interp.build_subtypes env mp params mtys in let () = Global.push_context_set ~strict:true sub_mty_ctx in mp, params, sub_mty_l, Univ.ContextSet.union params_ctx sub_mty_ctx let start_modtype id args mtys = let fs = Summary.Interp.freeze_summaries () in let mp, _, sub_mty_l, _ = start_modtype_core id args mtys in openmodtype_info := sub_mty_l; let prefix = Lib.Interp.start_modtype id mp fs in Nametab.(push_dir (Until 1) (prefix.obj_dir) (GlobDirRef.DirOpenModtype mp)); mp let end_modtype_core id sub_mty_l objects fs = let {Lib.Interp.substobjs = substitute; keepobjs = _; anticipateobjs = special; } = objects in let mp, mbids = Global.end_modtype fs id in let () = RawModOps.Interp.check_subtypes_mt mp sub_mty_l in let modtypeobjs = (mbids, Objs substitute) in let objects = special@[ModuleTypeObject (id,modtypeobjs)] in mp, objects let end_modtype () = let oldprefix,fs,objects = Lib.Interp.end_modtype () in let olddp, id = split_dirpath oldprefix.Nametab.obj_dir in let sub_mty_l = !openmodtype_info in let mp, objects = end_modtype_core id sub_mty_l objects fs in let () = InterpVisitor.add_leaves objects in (* Check name consistence : start_ vs. end_modtype, kernel vs. library *) assert (DirPath.equal (Lib.prefix()).Nametab.obj_dir olddp); assert (ModPath.equal oldprefix.Nametab.obj_mp mp); mp let declare_modtype id args mtys (mte,base,kind,inl) = let fs = Summary.Interp.freeze_summaries () in (* We simulate the beginning of an interactive module, then we adds the module parameters to the global env. *) let mp, params, sub_mty_l, ctx = start_modtype_core id args mtys in let env = Global.env () in let mte, mte_ctx = Modintern.interp_module_ast env kind base mte in let () = Global.push_context_set ~strict:true mte_ctx in let env = Global.env () in (* We check immediately that mte is well-formed *) let state = ((Global.universes (), Univ.Constraints.empty), Reductionops.inferred_universes) in let _, (_, mte_cst), _ = Mod_typing.translate_modtype state vm_state env mp inl ([], mte) in let () = Global.push_context_set ~strict:true (Univ.Level.Set.empty,mte_cst) in let entry = params, mte in let env = Global.env () in let sobjs = RawModOps.Interp.get_functor_sobjs false env inl entry in let subst = map_mp (get_module_path (snd entry)) mp empty_delta_resolver in let sobjs = subst_sobjs subst sobjs in (* Undo the simulated interactive building of the module type and declare the module type as a whole *) Summary.Interp.unfreeze_summaries fs; (* We enrich the global environment *) let () = Global.push_context_set ~strict:true ctx in let () = Global.push_context_set ~strict:true mte_ctx in let () = Global.push_context_set ~strict:true (Univ.Level.Set.empty,mte_cst) in let mp_env = Global.add_modtype id entry inl in (* Name consistency check : kernel vs. library *) assert (ModPath.equal mp_env mp); (* Subtyping checks *) let () = RawModOps.Interp.check_subtypes_mt mp sub_mty_l in InterpVisitor.add_leaf (ModuleTypeObject (id, sobjs)); mp end end (** {6 Include} *) module RawIncludeOps = struct exception NoIncludeSelf module Synterp = struct let rec include_subst mp mbids = match mbids with | [] -> empty_subst | mbid::mbids -> let subst = include_subst mp mbids in join (map_mbid mbid mp empty_delta_resolver) subst let declare_one_include_core cur_mp (me_ast,annot) = let me, base, kind = Modintern.intern_module_ast Modintern.ModAny me_ast in let is_mod = (kind == Modintern.Module) in let inl = inl2intopt annot in let mbids,aobjs = SynterpVisitor.get_module_sobjs is_mod () inl me in let subst_self = try if List.is_empty mbids then raise NoIncludeSelf; include_subst cur_mp mbids with NoIncludeSelf -> empty_subst in let base_mp = get_module_path me in (* We can use an empty delta resolver on syntax objects *) let subst = join subst_self (map_mp base_mp cur_mp empty_delta_resolver) in let aobjs = subst_aobjs subst aobjs in (me, base, kind, inl), aobjs let declare_one_include (me_ast,annot) = let res, aobjs = declare_one_include_core (openmod_syntax_info ()).cur_mp (me_ast,annot) in SynterpVisitor.add_leaf (IncludeObject aobjs); res let declare_include me_asts = List.map declare_one_include me_asts end module Interp = struct let rec include_subst env mp reso mbids sign inline = match mbids with | [] -> empty_subst | mbid::mbids -> let farg_id, farg_b, fbody_b = Modops.destr_functor sign in let subst = include_subst env mp reso mbids fbody_b inline in let mp_delta = Modops.inline_delta_resolver env inline mp farg_id farg_b reso in join (map_mbid mbid mp mp_delta) subst let rec decompose_functor mpl typ = match mpl, typ with | [], _ -> typ | _::mpl, MoreFunctor(_,_,str) -> decompose_functor mpl str | _ -> user_err Pp.(str "Application of a functor with too much arguments.") let type_of_incl env is_mod = function | MEident mp -> type_of_mod mp env is_mod | MEapply _ as me -> let mp0, mp_l = InterpVisitor.get_applications me in decompose_functor mp_l (type_of_mod mp0 env is_mod) | MEwith _ -> raise NoIncludeSelf (** Implements [Include F] where [F] has parameters [mbids] to be instantiated by fields of the current "self" module, i.e. using subtyping, by the current module itself. *) let declare_one_include_core (me,base,kind,inl) = let env = Global.env() in let me, cst = Modintern.interp_module_ast env kind base me in let () = Global.push_context_set ~strict:true cst in let env = Global.env () in let is_mod = (kind == Modintern.Module) in let cur_mp = Global.current_modpath () in let mbids,aobjs = InterpVisitor.get_module_sobjs is_mod env inl me in let subst_self = try if List.is_empty mbids then raise NoIncludeSelf; let typ = type_of_incl env is_mod me in let reso = RawModOps.Interp.current_modresolver () in include_subst env cur_mp reso mbids typ inl with NoIncludeSelf -> empty_subst in let base_mp = get_module_path me in let state = ((Global.universes (), Univ.Constraints.empty), Reductionops.inferred_universes) in let sign, (), resolver, (_, cst), _ = Mod_typing.translate_mse_include is_mod state vm_state (Global.env ()) (Global.current_modpath ()) inl me in let () = Global.add_constraints cst in let () = assert (ModPath.equal cur_mp (Global.current_modpath ())) in (* Include Self support *) let mb = { mod_mp = cur_mp; mod_expr = (); mod_type = RawModOps.Interp.current_struct (); mod_type_alg = None; mod_delta = RawModOps.Interp.current_modresolver (); mod_retroknowledge = ModTypeRK } in let rec compute_sign sign = match sign with | MoreFunctor(mbid,mtb,str) -> let state = ((Global.universes (), Univ.Constraints.empty), Reductionops.inferred_universes) in let (_, cst) = Subtyping.check_subtypes state (Global.env ()) mb mtb in let () = Global.add_constraints cst in let mpsup_delta = Modops.inline_delta_resolver (Global.env ()) inl cur_mp mbid mtb mb.mod_delta in let subst = Mod_subst.map_mbid mbid cur_mp mpsup_delta in compute_sign (Modops.subst_signature subst str) | NoFunctor str -> () in let () = compute_sign sign in let resolver = Global.add_include me is_mod inl in let subst = join subst_self (map_mp base_mp cur_mp resolver) in subst_aobjs subst aobjs let declare_one_include (me,base,kind,inl) = let aobjs = declare_one_include_core (me,base,kind,inl) in InterpVisitor.add_leaf (IncludeObject aobjs) let declare_include me_asts = List.iter declare_one_include me_asts end end (** {6 Libraries} *) type library_name = DirPath.t (** A library object is made of some substitutive objects and some "keep" objects. *) type library_objects = Libobject.t list * Libobject.t list module Synterp = struct let start_module export id args res = RawModOps.Synterp.start_module export id args res let end_module = RawModOps.Synterp.end_module (** Declare a module in terms of a list of module bodies, by including them. Typically used for `Module M := N <+ P`. *) let declare_module_includes id args res mexpr_l = let fs = Summary.Synterp.freeze_summaries () in let mp, res_entry_o, mbids, sign, args = RawModOps.Synterp.start_module_core id args res in let mod_info = { cur_mp = mp; cur_typ = res_entry_o; cur_mbids = mbids } in let includes = List.map_left (RawIncludeOps.Synterp.declare_one_include_core mp) mexpr_l in let bodies, incl_objs = List.split includes in let incl_objs = List.map (fun x -> IncludeObject x) incl_objs in let objects = Lib.Synterp.{ substobjs = incl_objs; keepobjs = []; anticipateobjs = []; } in let mp, objects = RawModOps.Synterp.end_module_core id mod_info objects fs in SynterpVisitor.add_leaves objects; mp, args, bodies, sign (** Declare a module type in terms of a list of module bodies, by including them. Typically used for `Module Type M := N <+ P`. *) let declare_modtype_includes id args res mexpr_l = let fs = Summary.Synterp.freeze_summaries () in let mp, mbids, args, subtyps = RawModTypeOps.Synterp.start_modtype_core id (openmod_syntax_info ()).cur_mp args res in let includes = List.map_left (RawIncludeOps.Synterp.declare_one_include_core mp) mexpr_l in let bodies, incl_objs = List.split includes in let incl_objs = List.map (fun x -> IncludeObject x) incl_objs in let objects = Lib.Synterp.{ substobjs = incl_objs; keepobjs = []; anticipateobjs = []; } in let objects = RawModTypeOps.Synterp.end_modtype_core id mbids objects fs in SynterpVisitor.add_leaves objects; mp, args, bodies, subtyps let declare_module id args mtys me_l = match me_l with | [] -> let mp, args, body, sign = RawModOps.Synterp.declare_module id args mtys None in assert (Option.is_empty body); mp, args, [], sign | [me] -> let mp, args, body, sign = RawModOps.Synterp.declare_module id args mtys (Some me) in mp, args, [Option.get body], sign | me_l -> declare_module_includes id args mtys me_l let start_modtype id args mtys = RawModTypeOps.Synterp.start_modtype id args mtys let end_modtype = RawModTypeOps.Synterp.end_modtype let declare_modtype id args mtys mty_l = match mty_l with | [] -> assert false | [mty] -> let mp, args, body, sign = RawModTypeOps.Synterp.declare_modtype id args mtys mty in mp, args, [body], sign | mty_l -> declare_modtype_includes id args mtys mty_l let declare_include = RawIncludeOps.Synterp.declare_include let register_library dir (objs:library_objects) = let mp = MPfile dir in let sobjs,keepobjs = objs in SynterpVisitor.load_module 1 dir mp ([],Objs sobjs) keepobjs let import_modules = SynterpVisitor.import_modules let import_module f ~export mp = import_modules ~export [f,mp] end module Interp = struct let start_module = RawModOps.Interp.start_module let end_module = RawModOps.Interp.end_module (** Declare a module in terms of a list of module bodies, by including them. Typically used for `Module M := N <+ P`. *) let declare_module_includes id args res mexpr_l = let fs = Summary.Interp.freeze_summaries () in let mp, res_entry_o, subtyps, _, _ = RawModOps.Interp.start_module_core id args res in let mod_info = { cur_typ = res_entry_o; cur_typs = subtyps } in let incl_objs = List.map_left (fun x -> IncludeObject (RawIncludeOps.Interp.declare_one_include_core x)) mexpr_l in let objects = Lib.Interp.{ substobjs = incl_objs; keepobjs = []; anticipateobjs = []; } in let mp, objects = RawModOps.Interp.end_module_core id mod_info objects fs in InterpVisitor.add_leaves objects; mp (** Declare a module type in terms of a list of module bodies, by including them. Typically used for `Module Type M := N <+ P`. *) let declare_modtype_includes id args res mexpr_l = let fs = Summary.Interp.freeze_summaries () in let mp, _, subtyps, _ = RawModTypeOps.Interp.start_modtype_core id args res in let incl_objs = List.map_left (fun x -> IncludeObject (RawIncludeOps.Interp.declare_one_include_core x)) mexpr_l in let objects = Lib.Interp.{ substobjs = incl_objs; keepobjs = []; anticipateobjs = []; } in let mp, objects = RawModTypeOps.Interp.end_modtype_core id subtyps objects fs in InterpVisitor.add_leaves objects; mp let declare_module id args mtys me_l = match me_l with | [] -> RawModOps.Interp.declare_module id args mtys None | [me] -> RawModOps.Interp.declare_module id args mtys (Some me) | me_l -> declare_module_includes id args mtys me_l let start_modtype = RawModTypeOps.Interp.start_modtype let end_modtype = RawModTypeOps.Interp.end_modtype let declare_modtype id args mtys mty_l = match mty_l with | [] -> assert false | [mty] -> RawModTypeOps.Interp.declare_modtype id args mtys mty | mty_l -> declare_modtype_includes id args mtys mty_l let declare_include me_asts = if Lib.sections_are_opened () then user_err Pp.(str "Include is not allowed inside sections."); RawIncludeOps.Interp.declare_include me_asts (** For the native compiler, we cache the library values *) let register_library dir cenv (objs:library_objects) digest vmtab = let mp = MPfile dir in let () = try (* Is this library already loaded ? *) ignore(Global.lookup_module mp); with Not_found -> begin (* If not, let's do it now ... *) let mp' = Global.import cenv vmtab digest in if not (ModPath.equal mp mp') then anomaly (Pp.str "Unexpected disk module name.") end in let sobjs,keepobjs = objs in InterpVisitor.load_module 1 dir mp ([],Objs sobjs) keepobjs let import_modules = InterpVisitor.import_modules let import_module f ~export mp = import_modules ~export [f,mp] end let end_library_hook = ref [] let append_end_library_hook f = end_library_hook := f :: !end_library_hook let end_library_hook () = List.iter (fun f -> f ()) (List.rev !end_library_hook) let end_library ~output_native_objects dir = end_library_hook(); let prefix, info, lib_stack, lib_stack_syntax = Lib.end_compilation dir in let mp,cenv,vmlib,ast = Global.export ~output_native_objects dir in assert (ModPath.equal mp (MPfile dir)); let {Lib.Interp.substobjs = substitute; keepobjs = keep; anticipateobjs = _; } = lib_stack in let {Lib.Synterp.substobjs = substitute_syntax; keepobjs = keep_syntax; anticipateobjs = _; } = lib_stack_syntax in cenv,(substitute,keep),(substitute_syntax,keep_syntax),vmlib,ast,info (** {6 Iterators} *) let iter_all_interp_segments f = let rec apply_obj prefix obj = match obj with | IncludeObject aobjs -> let objs = InterpVisitor.expand_aobjs aobjs in List.iter (apply_obj prefix) objs | _ -> f prefix obj in let apply_mod_obj _ modobjs = let prefix = modobjs.module_prefix in List.iter (apply_obj prefix) modobjs.module_substituted_objects; List.iter (apply_obj prefix) modobjs.module_keep_objects in let apply_nodes (node, os) = List.iter (fun o -> apply_obj (Lib.node_prefix node) o) os in MPmap.iter apply_mod_obj (InterpVisitor.ModObjs.all ()); List.iter apply_nodes (Lib.contents ()) (** {6 Some types used to shorten declaremods.mli} *) type module_params = (lident list * (Constrexpr.module_ast * inline)) list type module_expr = (Modintern.module_struct_expr * ModPath.t * Modintern.module_kind * Entries.inline) type module_params_expr = (MBId.t list * module_expr) list (** {6 Debug} *) let debug_print_modtab () = InterpVisitor.debug_print_modtab () (** For printing modules, [process_module_binding] adds names of bound module (and its components) to Nametab. It also loads objects associated to it. *) let process_module_binding mbid me = let dir = DirPath.make [MBId.to_id mbid] in let mp = MPbound mbid in let sobjs = InterpVisitor.get_module_sobjs false (Global.env()) (default_inline ()) me in let subst = map_mp (get_module_path me) mp empty_delta_resolver in let sobjs = subst_sobjs subst sobjs in SynterpVisitor.load_module 1 dir mp sobjs []; InterpVisitor.load_module 1 dir mp sobjs [] (** Compatibility layer *) let import_module f ~export mp = Synterp.import_module f ~export mp; Interp.import_module f ~export mp let declare_module id args mtys me_l = let mp, args, bodies, sign = Synterp.declare_module id args mtys me_l in Interp.declare_module id args sign bodies let start_module export id args res = let mp, args, sign = Synterp.start_module export id args res in Interp.start_module export id args sign let end_module () = let _mp = Synterp.end_module () in Interp.end_module () let declare_modtype id args mtys mty_l = let mp, args, bodies, subtyps = Synterp.declare_modtype id args mtys mty_l in Interp.declare_modtype id args subtyps bodies let start_modtype id args mtys = let mp, args, sub_mty_l = Synterp.start_modtype id args mtys in Interp.start_modtype id args sub_mty_l let end_modtype () = let _mp = Synterp.end_modtype () in Interp.end_modtype () let declare_include me_asts = let l = Synterp.declare_include me_asts in Interp.declare_include l let () = append_end_library_hook Profile_tactic.do_print_results_at_close coq-8.20.0/vernac/declaremods.mli000066400000000000000000000144701466560755400166560ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* module_params -> (Constrexpr.module_ast * inline) module_signature -> (Constrexpr.module_ast * inline) list -> ModPath.t * module_params_expr * module_expr list * module_expr module_signature val start_module : Lib.export -> Id.t -> module_params -> (Constrexpr.module_ast * inline) module_signature -> ModPath.t * module_params_expr * module_expr module_signature val end_module : unit -> ModPath.t val declare_include : (Constrexpr.module_ast * inline) list -> module_expr list val declare_modtype : Id.t -> module_params -> (Constrexpr.module_ast * inline) list -> (Constrexpr.module_ast * inline) list -> ModPath.t * module_params_expr * module_expr list * module_expr list val start_modtype : Id.t -> module_params -> (Constrexpr.module_ast * inline) list -> ModPath.t * module_params_expr * module_expr list val end_modtype : unit -> ModPath.t val import_module : Libobject.open_filter -> export:Lib.export_flag -> ModPath.t -> unit val import_modules : export:Lib.export_flag -> (Libobject.open_filter * ModPath.t) list -> unit val register_library : library_name -> library_objects -> unit end module Interp : sig (** [declare_module id fargs typ exprs] declares module [id], from functor arguments [fargs], with final type [typ]. [exprs] is usually of length 1 (Module definition with a concrete body), but it could also be empty ("Declare Module", with non-empty [typ]), or multiple (body of the shape M <+ N <+ ...). *) val declare_module : Id.t -> module_params_expr -> module_expr module_signature -> module_expr list -> ModPath.t val start_module : Lib.export -> Id.t -> module_params_expr -> module_expr module_signature -> ModPath.t val end_module : unit -> ModPath.t (** {6 Module types } *) (** [declare_modtype interp_modast id fargs typs exprs] Similar to [declare_module], except that the types could be multiple *) val declare_modtype : Id.t -> module_params_expr -> module_expr list -> module_expr list -> ModPath.t val start_modtype : Id.t -> module_params_expr -> module_expr list -> ModPath.t val end_modtype : unit -> ModPath.t val register_library : library_name -> Safe_typing.compiled_library -> library_objects -> Safe_typing.vodigest -> Vmlibrary.on_disk -> unit (** [import_module export mp] imports the module [mp]. It modifies Nametab and performs the [open_object] function for every object of the module. Raises [Not_found] when [mp] is unknown or when [mp] corresponds to a functor. If [export] is [true], the module is also opened every time the module containing it is. *) val import_module : Libobject.open_filter -> export:Lib.export_flag -> ModPath.t -> unit (** Same as [import_module] but for multiple modules, and more optimized than iterating [import_module]. *) val import_modules : export:Lib.export_flag -> (Libobject.open_filter * ModPath.t) list -> unit (** Include *) val declare_include : module_expr list -> unit end val start_library : library_name -> unit val end_library : output_native_objects:bool -> library_name -> Safe_typing.compiled_library * library_objects * library_objects * Vmlibrary.compiled_library * Nativelib.native_library * Library_info.t (** append a function to be executed at end_library *) val append_end_library_hook : (unit -> unit) -> unit (** {6 ... } *) (** [iter_all_interp_segments] iterate over all segments, the modules' segments first and then the current segment. Modules are presented in an arbitrary order. The given function is applied to all leaves (together with their section path). Ignores synterp objects. *) val iter_all_interp_segments : (Nametab.object_prefix -> Libobject.t -> unit) -> unit val debug_print_modtab : unit -> Pp.t (** For printing modules, [process_module_binding] adds names of bound module (and its components) to Nametab. It also loads objects associated to it. It may raise a [Failure] when the bound module hasn't an atomic type. *) val process_module_binding : MBId.t -> (Constr.t * UVars.AbstractContext.t option) Declarations.module_alg_expr -> unit (** Compatibility layer *) val import_module : Libobject.open_filter -> export:Lib.export_flag -> ModPath.t -> unit val declare_module : Id.t -> module_params -> (Constrexpr.module_ast * inline) module_signature -> (Constrexpr.module_ast * inline) list -> ModPath.t val start_module : Lib.export -> Id.t -> module_params -> (Constrexpr.module_ast * inline) module_signature -> ModPath.t val end_module : unit -> ModPath.t val declare_modtype : Id.t -> module_params -> (Constrexpr.module_ast * inline) list -> (Constrexpr.module_ast * inline) list -> ModPath.t val start_modtype : Id.t -> module_params -> (Constrexpr.module_ast * inline) list -> ModPath.t val end_modtype : unit -> ModPath.t val declare_include : (Constrexpr.module_ast * inline) list -> unit coq-8.20.0/vernac/dune000066400000000000000000000005131466560755400145400ustar00rootroot00000000000000(library (name vernac) (synopsis "Coq's Vernacular Language") (public_name coq-core.vernac) (wrapped false) (modules_without_implementation vernacexpr) ; until ocaml/dune#4892 fixed ; (private_modules comProgramFixpoint egramcoq) (libraries tactics parsing findlib.dynload)) (coq.pp (modules g_proofs g_vernac g_redexpr)) coq-8.20.0/vernac/egramcoq.ml000066400000000000000000000670561466560755400160310ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* levels, String.Map.find "constr" levels | InCustomEntry s -> try levels, String.Map.find s levels with Not_found -> String.Map.add s ([],[]) levels, ([],[]) let save_levels levels custom lev = let s = match custom with InConstrEntry -> "constr" | InCustomEntry s -> s in String.Map.add s lev levels (* At a same level, LeftA takes precedence over RightA and NoneA *) (* In case, several associativity exists for a level, we make two levels, *) (* first LeftA, then RightA and NoneA together *) let admissible_assoc = function | Gramlib.Gramext.LeftA, Some (Gramlib.Gramext.RightA | Gramlib.Gramext.NonA) -> false | Gramlib.Gramext.RightA, Some Gramlib.Gramext.LeftA -> false | _ -> true let create_assoc = function | None -> Gramlib.Gramext.RightA | Some a -> a exception NotationLevelMismatch of entry_level * Gramlib.Gramext.g_assoc * Gramlib.Gramext.g_assoc let () = CErrors.register_handler (function | NotationLevelMismatch (p, current, expected) -> Some Pp.(str "Level " ++ int p ++ str " is already declared to have " ++ Gramlib.Gramext.pr_assoc current ++ str " while it is now expected to have " ++ Gramlib.Gramext.pr_assoc expected ++ str ".") | _ -> None) let error_level_assoc p current expected = raise @@ NotationLevelMismatch (p, current, expected) type position = NewFirst | NewAfter of int | ReuseFirst | ReuseLevel of int let create_pos = function | None -> NewFirst | Some lev -> NewAfter lev let find_position_gen current ensure assoc lev = match lev with | None -> current, (ReuseFirst, None, None, None) | Some n -> let after = ref None in let init = ref None in let rec add_level q = function | (p,_,_ as pa)::l when p > n -> pa :: add_level (Some p) l | (p,a,reinit)::l when Int.equal p n -> if reinit then let a' = create_assoc assoc in (init := Some (a', q); (p,a',false)::l) else if admissible_assoc (a,assoc) then raise_notrace Exit else error_level_assoc p a (Option.get assoc) | l -> after := q; (n,create_assoc assoc,ensure)::l in try let updated = add_level None current in let assoc = create_assoc assoc in begin match !init with | None -> (* Create the entry *) updated, (create_pos !after, Some assoc, Some (constr_level n), None) | _ -> (* The reinit flag has been updated *) updated, (ReuseLevel n, None, None, !init) end with (* Nothing has changed *) Exit -> (* Just inherit the existing associativity and name (None) *) current, (ReuseLevel n, None, None, None) let rec list_mem_assoc_triple x = function | [] -> false | (a,b,c) :: l -> Int.equal a x || list_mem_assoc_triple x l let register_empty_levels accu forpat levels = let rec filter accu = function | [] -> ([], accu) | (where,n) :: rem -> let rem, accu = filter accu rem in let accu, (clev, plev) = find_levels accu where in let levels = if forpat then plev else clev in if not (list_mem_assoc_triple n levels) then let nlev, ans = find_position_gen levels true None (Some n) in let nlev = if forpat then (clev, nlev) else (nlev, plev) in (where, ans) :: rem, save_levels accu where nlev else rem, accu in let (l,accu) = filter accu levels in List.rev l, accu let find_position accu custom forpat assoc level = let accu, (clev, plev) = find_levels accu custom in let levels = if forpat then plev else clev in let nlev, ans = find_position_gen levels false assoc level in let nlev = if forpat then (clev, nlev) else (nlev, plev) in (ans, save_levels accu custom nlev) (**************************************************************************) (* * --- Note on the mapping of grammar productions to camlp5 actions --- * * Translation of environments: a production * [ nt1(x1) ... nti(xi) ] -> act(x1..xi) * is written (with camlp5 conventions): * (fun vi -> .... (fun v1 -> act(v1 .. vi) )..) * where v1..vi are the values generated by non-terminals nt1..nti. * Since the actions are executed by substituting an environment, * the make_*_action family build the following closure: * * ((fun env -> * (fun vi -> * (fun env -> ... * * (fun v1 -> * (fun env -> gram_action .. env act) * ((x1,v1)::env)) * ...) * ((xi,vi)::env))) * []) *) (**********************************************************************) (** Declare Notations grammar rules *) (**********************************************************************) (* Binding constr entry keys to entries *) (* Camlp5 levels do not treat NonA: use RightA with a NEXT on the left *) let camlp5_assoc = let open Gramlib.Gramext in function | Some NonA | Some RightA -> RightA | None | Some LeftA -> LeftA let assoc_eq al ar = let open Gramlib.Gramext in match al, ar with | NonA, NonA | RightA, RightA | LeftA, LeftA -> true | _, _ -> false (** [adjust_level assoc fromlev prod] where [assoc] and [fromlev] are the name and associativity of the level where to add the rule; the meaning of the result is DefaultLevel = entry name NextLevel = NEXT NumLevel n = constr LEVEL n *) let adjust_level custom assoc {notation_entry = custom'; notation_level = fromlev} p = let open Gramlib.Gramext in match p with (* If a level in a different grammar, no other choice than denoting it by absolute level *) | (NumLevel n,_) when not (notation_entry_eq custom custom') -> NumLevel n (* If a default level in a different grammar, the entry name is ok *) | (DefaultLevel,InternalProd) -> if notation_entry_eq custom InConstrEntry then NumLevel 200 else DefaultLevel | (DefaultLevel,BorderProd _) when not (notation_entry_eq custom custom') -> if notation_entry_eq custom InConstrEntry then NumLevel 200 else DefaultLevel (* Associativity is None means force the level *) | (NumLevel n,BorderProd (_,None)) -> NumLevel n | (DefaultLevel,BorderProd (_,None)) -> assert false (* Compute production name on the right side *) (* If NonA or LeftA on the right-hand side, set to NEXT *) | ((NumLevel _ | DefaultLevel),BorderProd (Right,Some (NonA|LeftA))) -> NextLevel (* If RightA on the right-hand side, set to the explicit (current) level *) | (NumLevel n,BorderProd (Right,Some RightA)) -> NumLevel n | (DefaultLevel,BorderProd (Right,Some RightA)) -> NumLevel fromlev (* Compute production name on the left side *) (* If NonA on the left-hand side, adopt the current assoc ?? *) | ((NumLevel _ | DefaultLevel),BorderProd (Left,Some NonA)) -> DefaultLevel (* If the expected assoc is the current one, set to SELF *) | ((NumLevel _ | DefaultLevel),BorderProd (Left,Some a)) when assoc_eq a (camlp5_assoc assoc) -> DefaultLevel (* Otherwise, force the level, n or n-1, according to expected assoc *) | (NumLevel n,BorderProd (Left,Some LeftA)) -> NumLevel n | ((NumLevel _ | DefaultLevel),BorderProd (Left,Some _)) -> NextLevel (* None means NEXT *) | (NextLevel,_) -> assert (notation_entry_eq custom custom'); NextLevel (* Compute production name elsewhere *) | (NumLevel n,InternalProd) -> if fromlev = n + 1 then NextLevel else NumLevel n type _ target = | ForConstr : constr_expr target | ForPattern : cases_pattern_expr target type prod_info = production_level * production_position type (_, _) entry = | TTIdent : ('self, lident) entry | TTName : ('self, lname) entry | TTGlobal : ('r, qualid) entry | TTBigint : ('r, string) entry | TTBinder : bool -> ('self, kinded_cases_pattern_expr) entry | TTConstr : notation_entry * prod_info * 'r target -> ('r, 'r) entry | TTConstrList : notation_entry * prod_info * (bool * string) list * 'r target -> ('r, 'r list) entry | TTPattern : int -> ('self, cases_pattern_expr) entry | TTOpenBinderList : ('self, local_binder_expr list) entry | TTClosedBinderListPure : (bool * string) list -> ('self, local_binder_expr list list) entry | TTClosedBinderListOther : ('self, 'a) entry * (bool * string) list -> ('self, 'a list) entry type _ any_entry = TTAny : ('s, 'r) entry -> 's any_entry let constr_custom_entry : (string, Constrexpr.constr_expr) entry_command = create_entry_command "constr" { eext_fun = (fun s st -> [s], st); eext_eq = (==) (* FIXME *) } let pattern_custom_entry : (string, Constrexpr.cases_pattern_expr) entry_command = create_entry_command "pattern" { eext_fun = (fun s st -> [s], st); eext_eq = (==) (* FIXME *) } let custom_entry_locality = Summary.ref ~name:"LOCAL-CUSTOM-ENTRY" String.Set.empty (** If the entry is present then local *) let create_custom_entry ~local s = if List.mem s ["constr";"pattern";"ident";"global";"binder";"bigint"] then user_err Pp.(quote (str s) ++ str " is a reserved entry name."); let sc = "custom:"^s in let sp = "custom_pattern:"^s in let _ = extend_entry_command constr_custom_entry sc in let _ = extend_entry_command pattern_custom_entry sp in let () = if local then custom_entry_locality := String.Set.add s !custom_entry_locality in () let find_custom_entry s = let sc = "custom:"^s in let sp = "custom_pattern:"^s in try (find_custom_entry constr_custom_entry sc, find_custom_entry pattern_custom_entry sp) with Not_found -> user_err Pp.(str "Undeclared custom entry: " ++ str s ++ str ".") let exists_custom_entry s = match find_custom_entry s with | _ -> true | exception e when CErrors.noncritical e -> false let locality_of_custom_entry s = String.Set.mem s !custom_entry_locality (** This computes the name of the level where to add a new rule *) let interp_constr_entry_key : type r. _ -> r target -> r Entry.t * int option = fun {notation_entry = custom; notation_level = level} forpat -> match custom with | InCustomEntry s -> (let (entry_for_constr, entry_for_patttern) = find_custom_entry s in match forpat with | ForConstr -> entry_for_constr, Some level | ForPattern -> entry_for_patttern, Some level) | InConstrEntry -> match forpat with | ForConstr -> if level = 200 then Constr.binder_constr, None else Constr.term, Some level | ForPattern -> Constr.pattern, Some level let target_entry : type s. notation_entry -> s target -> s Entry.t = function | InConstrEntry -> (function | ForConstr -> Constr.term | ForPattern -> Constr.pattern) | InCustomEntry s -> let (entry_for_constr, entry_for_patttern) = find_custom_entry s in function | ForConstr -> entry_for_constr | ForPattern -> entry_for_patttern let is_self custom {notation_entry = custom'; notation_level = fromlev} e = notation_entry_eq custom custom' && match e with | (NumLevel n, BorderProd (Right, _ (* Some(NonA|LeftA) *))) -> false | (NumLevel n, BorderProd (Left, _)) -> Int.equal fromlev n | _ -> false let is_binder_level custom {notation_entry = custom'; notation_level = fromlev} e = match e with | (NumLevel 200, (BorderProd (Right, _) | InternalProd)) -> custom = InConstrEntry && custom' = InConstrEntry && fromlev = 200 | _ -> false let make_pattern (keyword,s) = if keyword then TPattern (Tok.PKEYWORD s) else match NumTok.Unsigned.parse_string s with | Some n -> TPattern (Tok.PNUMBER (Some n)) | None -> match String.unquote_coq_string s with | Some s -> TPattern (Tok.PSTRING (Some s)) | None -> TPattern (Tok.PIDENT (Some s)) let make_sep_rules tkl = Pcoq.Symbol.tokens (List.map make_pattern tkl) type ('s, 'a) mayrec_symbol = | MayRecNo : ('s, Gramlib.Grammar.norec, 'a) Symbol.t -> ('s, 'a) mayrec_symbol | MayRecMay : ('s, Gramlib.Grammar.mayrec, 'a) Symbol.t -> ('s, 'a) mayrec_symbol let symbol_of_target : type s. _ -> _ -> _ -> _ -> s target -> (s, s) mayrec_symbol = fun custom p assoc from forpat -> if is_binder_level custom from p then (* Prevent self *) MayRecNo (Pcoq.Symbol.nterml (target_entry custom forpat) "200") else if is_self custom from p then MayRecMay Pcoq.Symbol.self else let g = target_entry custom forpat in let lev = adjust_level custom assoc from p in begin match lev with | DefaultLevel -> MayRecNo (Pcoq.Symbol.nterm g) | NextLevel -> MayRecMay Pcoq.Symbol.next | NumLevel lev -> MayRecNo (Pcoq.Symbol.nterml g (string_of_int lev)) end let rec symbol_of_entry : type s r. _ -> _ -> (s, r) entry -> (s, r) mayrec_symbol = fun assoc from typ -> match typ with | TTConstr (s, p, forpat) -> symbol_of_target s p assoc from forpat | TTConstrList (s, typ', [], forpat) -> begin match symbol_of_target s typ' assoc from forpat with | MayRecNo s -> MayRecNo (Pcoq.Symbol.list1 s) | MayRecMay s -> MayRecMay (Pcoq.Symbol.list1 s) end | TTConstrList (s, typ', tkl, forpat) -> begin match symbol_of_target s typ' assoc from forpat with | MayRecNo s -> MayRecNo (Pcoq.Symbol.list1sep s (make_sep_rules tkl) false) | MayRecMay s -> MayRecMay (Pcoq.Symbol.list1sep s (make_sep_rules tkl) false) end | TTPattern p -> MayRecNo (Pcoq.Symbol.nterml Constr.pattern (string_of_int p)) | TTOpenBinderList -> MayRecNo (Pcoq.Symbol.nterm Constr.open_binders) | TTClosedBinderListPure [] -> MayRecNo (Pcoq.Symbol.list1 (Pcoq.Symbol.nterm Constr.binder)) | TTClosedBinderListPure tkl -> MayRecNo (Pcoq.Symbol.list1sep (Pcoq.Symbol.nterm Constr.binder) (make_sep_rules tkl) false) | TTClosedBinderListOther (typ,[]) -> begin match symbol_of_entry assoc from typ with | MayRecNo s -> MayRecNo (Pcoq.Symbol.list1 s) | MayRecMay s -> MayRecMay (Pcoq.Symbol.list1 s) end | TTClosedBinderListOther (typ,tkl) -> begin match symbol_of_entry assoc from typ with | MayRecNo s -> MayRecNo (Pcoq.Symbol.list1sep s (make_sep_rules tkl) false) | MayRecMay s -> MayRecMay (Pcoq.Symbol.list1sep s (make_sep_rules tkl) false) end | TTIdent -> MayRecNo (Pcoq.Symbol.nterm Prim.identref) | TTName -> MayRecNo (Pcoq.Symbol.nterm Prim.name) | TTBinder true -> MayRecNo (Pcoq.Symbol.nterm Constr.one_open_binder) | TTBinder false -> MayRecNo (Pcoq.Symbol.nterm Constr.one_closed_binder) | TTBigint -> MayRecNo (Pcoq.Symbol.nterm Prim.bignat) | TTGlobal -> MayRecNo (Pcoq.Symbol.nterm Constr.global) let rec interp_entry forpat e = match e with | ETProdIdent -> TTAny TTIdent | ETProdName -> TTAny TTName | ETProdGlobal -> TTAny TTGlobal | ETProdBigint -> TTAny TTBigint | ETProdOneBinder o -> TTAny (TTBinder o) | ETProdConstr (s,p) -> TTAny (TTConstr (s, p, forpat)) | ETProdPattern p -> TTAny (TTPattern p) | ETProdConstrList (s, p, tkl) -> TTAny (TTConstrList (s, p, tkl, forpat)) | ETProdBinderList ETBinderOpen -> TTAny TTOpenBinderList | ETProdBinderList (ETBinderClosed (None, tkl)) -> TTAny (TTClosedBinderListPure tkl) | ETProdBinderList (ETBinderClosed (Some e, tkl)) -> let TTAny e = interp_entry forpat e in TTAny (TTClosedBinderListOther (e, tkl)) let cases_pattern_expr_of_id { CAst.loc; v = id } = CAst.make ?loc @@ CPatAtom (Some (qualid_of_ident ?loc id)) let cases_pattern_expr_of_name { CAst.loc; v = na } = CAst.make ?loc @@ match na with | Anonymous -> CPatAtom None | Name id -> CPatAtom (Some (qualid_of_ident ?loc id)) type 'r env = { constrs : 'r list; constrlists : 'r list list; binders : kinded_cases_pattern_expr list; binderlists : local_binder_expr list list; } let push_constr subst v = { subst with constrs = v :: subst.constrs } let push_item : type s r. s target -> (s, r) entry -> s env -> r -> s env = fun forpat e subst v -> match e with | TTConstr _ -> push_constr subst v | TTIdent -> { subst with binders = (cases_pattern_expr_of_id v, Glob_term.Explicit) :: subst.binders } | TTName -> { subst with binders = (cases_pattern_expr_of_name v, Glob_term.Explicit) :: subst.binders } | TTPattern _ -> { subst with binders = (v, Glob_term.Explicit) :: subst.binders } | TTBinder o -> { subst with binders = v :: subst.binders } | TTOpenBinderList -> { subst with binderlists = v :: subst.binderlists } | TTClosedBinderListPure _ -> { subst with binderlists = List.flatten v :: subst.binderlists } | TTClosedBinderListOther (TTIdent, _) -> { subst with binderlists = List.map (fun a -> CLocalPattern (cases_pattern_expr_of_id a)) v :: subst.binderlists } | TTClosedBinderListOther (TTName, _) -> { subst with binderlists = List.map (fun a -> CLocalPattern (cases_pattern_expr_of_name a)) v :: subst.binderlists } | TTClosedBinderListOther (TTPattern _, _) -> { subst with binderlists = List.map (fun a -> CLocalPattern a) v :: subst.binderlists } | TTClosedBinderListOther _ -> user_err (Pp.str "Invalid binder list entry.") | TTBigint -> begin match forpat with | ForConstr -> push_constr subst (CAst.make @@ CPrim (Number (NumTok.Signed.of_int_string v))) | ForPattern -> push_constr subst (CAst.make @@ CPatPrim (Number (NumTok.Signed.of_int_string v))) end | TTGlobal -> begin match forpat with | ForConstr -> push_constr subst (CAst.make @@ CRef (v, None)) | ForPattern -> push_constr subst (CAst.make @@ CPatAtom (Some v)) end | TTConstrList _ -> { subst with constrlists = v :: subst.constrlists } type (_, _) ty_symbol = | TyTerm : 'a Tok.p -> ('s, 'a) ty_symbol | TyNonTerm : 's target * ('s, 'a) entry * ('s, 'a) mayrec_symbol * bool -> ('s, 'a) ty_symbol type ('self, _, 'r) ty_rule = | TyStop : ('self, 'r, 'r) ty_rule | TyNext : ('self, 'a, 'r) ty_rule * ('self, 'b) ty_symbol -> ('self, 'b -> 'a, 'r) ty_rule | TyMark : int * bool * int * ('self, 'a, 'r) ty_rule -> ('self, 'a, 'r) ty_rule type 'r gen_eval = Loc.t -> 'r env -> 'r let rec ty_eval : type s a. (s, a, Loc.t -> s) ty_rule -> s gen_eval -> s env -> a = function | TyStop -> fun f env loc -> f loc env | TyNext (rem, TyTerm _) -> fun f env _ -> ty_eval rem f env | TyNext (rem, TyNonTerm (_, _, _, false)) -> fun f env _ -> ty_eval rem f env | TyNext (rem, TyNonTerm (forpat, e, _, true)) -> fun f env v -> ty_eval rem f (push_item forpat e env v) | TyMark (n, b, p, rem) -> fun f env -> let heads, constrs = List.chop n env.constrs in let constrlists, constrs = if b then (* We rearrange constrs = c1..cn rem and constrlists = [d1..dr e1..ep] rem' into constrs = e1..ep rem and constrlists [c1..cn d1..dr] rem' *) let constrlist = List.hd env.constrlists in let constrlist, tail = List.chop (List.length constrlist - p) constrlist in (heads @ constrlist) :: List.tl env.constrlists, tail @ constrs else (* We rearrange constrs = c1..cn e1..ep rem into constrs = e1..ep rem and add a constr list [c1..cn] *) let constrlist, tail = List.chop (n - p) heads in constrlist :: env.constrlists, tail @ constrs in ty_eval rem f { env with constrs; constrlists; } type ('s, 'a, 'r) mayrec_rule = | MayRecRNo : ('s, Gramlib.Grammar.norec, 'a, 'r) Rule.t -> ('s, 'a, 'r) mayrec_rule | MayRecRMay : ('s, Gramlib.Grammar.mayrec, 'a, 'r) Rule.t -> ('s, 'a, 'r) mayrec_rule let rec ty_erase : type s a r. (s, a, r) ty_rule -> (s, a, r) mayrec_rule = function | TyStop -> MayRecRNo Rule.stop | TyMark (_, _, _, r) -> ty_erase r | TyNext (rem, TyTerm tok) -> begin match ty_erase rem with | MayRecRNo rem -> MayRecRMay (Rule.next rem (Symbol.token tok)) | MayRecRMay rem -> MayRecRMay (Rule.next rem (Symbol.token tok)) end | TyNext (rem, TyNonTerm (_, _, s, _)) -> begin match ty_erase rem, s with | MayRecRNo rem, MayRecNo s -> MayRecRMay (Rule.next rem s) | MayRecRNo rem, MayRecMay s -> MayRecRMay (Rule.next rem s) | MayRecRMay rem, MayRecNo s -> MayRecRMay (Rule.next rem s) | MayRecRMay rem, MayRecMay s -> MayRecRMay (Rule.next rem s) end type ('self, 'r) any_ty_rule = | AnyTyRule : ('self, 'act, Loc.t -> 'r) ty_rule -> ('self, 'r) any_ty_rule let make_ty_rule assoc from forpat prods = let rec make_ty_rule = function | [] -> AnyTyRule TyStop | GramConstrTerminal (kw,s) :: rem -> let AnyTyRule r = make_ty_rule rem in let TPattern tk = make_pattern (kw,s) in AnyTyRule (TyNext (r, TyTerm tk)) | GramConstrNonTerminal (e, var) :: rem -> let AnyTyRule r = make_ty_rule rem in let TTAny e = interp_entry forpat e in let s = symbol_of_entry assoc from e in let bind = match var with None -> false | Some _ -> true in AnyTyRule (TyNext (r, TyNonTerm (forpat, e, s, bind))) | GramConstrListMark (n, b, p) :: rem -> let AnyTyRule r = make_ty_rule rem in AnyTyRule (TyMark (n, b, p, r)) in make_ty_rule (List.rev prods) let target_to_bool : type r. r target -> bool = function | ForConstr -> false | ForPattern -> true let prepare_empty_levels forpat (where,(pos,p4assoc,name,reinit)) = let empty = match pos with | ReuseFirst -> Pcoq.Reuse (None, []) | ReuseLevel n -> Pcoq.Reuse (Some (constr_level n), []) | NewFirst -> Pcoq.Fresh (Gramlib.Gramext.First, [(name, p4assoc, [])]) | NewAfter n -> Pcoq.Fresh (Gramlib.Gramext.After (constr_level n), [(name, p4assoc, [])]) in match reinit with | None -> ExtendRule (target_entry where forpat, empty) | Some (assoc, pos) -> let pos = match pos with None -> Gramlib.Gramext.First | Some n -> Gramlib.Gramext.After (constr_level n) in let reinit = (assoc, pos) in ExtendRuleReinit (target_entry where forpat, reinit, empty) let different_levels (custom,opt_level) (custom',string_level) = match opt_level with | None -> true | Some level -> not (notation_entry_eq custom custom') || level <> int_of_string string_level let rec pure_sublevels' assoc from forpat level = function | [] -> [] | GramConstrNonTerminal (e,_) :: rem -> let rem = pure_sublevels' assoc from forpat level rem in let push where p rem = match symbol_of_target where p assoc from forpat with | MayRecNo sym -> (match Pcoq.level_of_nonterm sym with | None -> rem | Some i -> if different_levels (from.notation_entry,level) (where,i) then (where,int_of_string i) :: rem else rem) | _ -> rem in (match e with | ETProdPattern i -> push InConstrEntry (NumLevel i,InternalProd) rem | ETProdConstr (s,p) -> push s p rem | _ -> rem) | (GramConstrTerminal _ | GramConstrListMark _) :: rem -> pure_sublevels' assoc from forpat level rem let make_act : type r. r target -> _ -> r gen_eval = function | ForConstr -> fun notation loc env -> let env = (env.constrs, env.constrlists, env.binders, env.binderlists) in CAst.make ~loc @@ CNotation (None, notation, env) | ForPattern -> fun notation loc env -> let env = (env.constrs, env.constrlists, env.binders) in CAst.make ~loc @@ CPatNotation (None, notation, env, []) let extend_constr state forpat ng = let {notation_entry = custom; notation_level = _} as fromlev,_ = ng.notgram_level in let assoc = ng.notgram_assoc in let (entry, level) = interp_constr_entry_key fromlev forpat in let fold (accu, state) pt = let AnyTyRule r = make_ty_rule assoc fromlev forpat pt in let pure_sublevels = pure_sublevels' assoc fromlev forpat level pt in let isforpat = target_to_bool forpat in let needed_levels, state = register_empty_levels state isforpat pure_sublevels in let (pos,p4assoc,name,reinit), state = find_position state custom isforpat assoc level in let empty_rules = List.map (prepare_empty_levels forpat) needed_levels in let empty = { constrs = []; constrlists = []; binders = []; binderlists = [] } in let act = ty_eval r (make_act forpat ng.notgram_notation) empty in let rule = let r = match ty_erase r with | MayRecRNo symbs -> Pcoq.Production.make symbs act | MayRecRMay symbs -> Pcoq.Production.make symbs act in let rule = name, p4assoc, [r] in match pos with | NewFirst -> Pcoq.Fresh (Gramlib.Gramext.First, [rule]) | NewAfter n -> Pcoq.Fresh (Gramlib.Gramext.After (constr_level n), [rule]) | ReuseFirst -> Pcoq.Reuse (None, [r]) | ReuseLevel n -> Pcoq.Reuse (Some (constr_level n), [r]) in let r = match reinit with | None -> ExtendRule (entry, rule) | Some (assoc, pos) -> let pos = match pos with None -> Gramlib.Gramext.First | Some n -> Gramlib.Gramext.After (constr_level n) in let reinit = (assoc, pos) in ExtendRuleReinit (entry, reinit, rule) in (accu @ empty_rules @ [r], state) in List.fold_left fold ([], state) ng.notgram_prods let constr_levels = GramState.field "constr_levels" let is_disjunctive_pattern_rule ng = String.is_sub "( _ | " (snd ng.notgram_notation) 0 let warn_disj_pattern_notation = let open Pp in let pp ng = str "Use of " ++ Notation.pr_notation ng.notgram_notation ++ str " Notation is deprecated as it is inconsistent with pattern syntax." in CWarnings.create ~name:"disj-pattern-notation" ~category:CWarnings.CoreCategories.syntax ~default:CWarnings.Disabled pp let extend_constr_notation ng state = let levels = match GramState.get state constr_levels with | None -> String.Map.add "constr" default_constr_levels String.Map.empty | Some lev -> lev in (* Add the notation in constr *) let (r, levels) = extend_constr levels ForConstr ng in (* Add the notation in cases_pattern, unless it would disrupt *) (* parsing nested disjunctive patterns. *) let (r', levels) = if is_disjunctive_pattern_rule ng then begin warn_disj_pattern_notation ng; ([], levels) end else extend_constr levels ForPattern ng in let state = GramState.set state constr_levels levels in (r @ r', state) let constr_grammar : one_notation_grammar grammar_command = create_grammar_command "Notation" { gext_fun = extend_constr_notation; gext_eq = (==) (* FIXME *) } let extend_constr_grammar ntn = extend_grammar_command constr_grammar ntn coq-8.20.0/vernac/egramcoq.mli000066400000000000000000000022261466560755400161660ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* unit (** Add a term notation rule to the parsing system. *) val create_custom_entry : local:bool -> string -> unit val exists_custom_entry : string -> bool val locality_of_custom_entry : string -> bool coq-8.20.0/vernac/egramml.ml000066400000000000000000000116471466560755400156520ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* 's grammar_prod_item type 'a ty_arg = ('a -> raw_generic_argument) type ('self, 'tr, _, 'r) ty_rule = | TyStop : ('self, Gramlib.Grammar.norec, 'r, 'r) ty_rule | TyNext : ('self, _, 'a, 'r) ty_rule * ('self, _, 'b) Symbol.t * 'b ty_arg option -> ('self, Gramlib.Grammar.mayrec, 'b -> 'a, 'r) ty_rule type ('self, 'r) any_ty_rule = | AnyTyRule : ('self, _, 'act, Loc.t -> 'r) ty_rule -> ('self, 'r) any_ty_rule let rec ty_rule_of_gram = function | [] -> AnyTyRule TyStop | GramTerminal s :: rem -> let AnyTyRule rem = ty_rule_of_gram rem in let tok = Pcoq.Symbol.token (Pcoq.terminal s) in let r = TyNext (rem, tok, None) in AnyTyRule r | GramNonTerminal (_, (t, tok)) :: rem -> let AnyTyRule rem = ty_rule_of_gram rem in let inj = Some (fun obj -> Genarg.in_gen t obj) in let r = TyNext (rem, tok, inj) in AnyTyRule r let rec ty_erase : type s tr a r. (s, tr, a, r) ty_rule -> (s, tr, a, r) Pcoq.Rule.t = function | TyStop -> Pcoq.Rule.stop | TyNext (rem, tok, _) -> Pcoq.Rule.next (ty_erase rem) tok type 'r gen_eval = Loc.t -> raw_generic_argument list -> 'r let rec ty_eval : type s tr a. (s, tr, a, Loc.t -> s) ty_rule -> s gen_eval -> a = function | TyStop -> fun f loc -> f loc [] | TyNext (rem, tok, None) -> fun f _ -> ty_eval rem f | TyNext (rem, tok, Some inj) -> fun f x -> let f loc args = f loc (inj x :: args) in ty_eval rem f let make_rule f prod = let AnyTyRule ty_rule = ty_rule_of_gram (List.rev prod) in let symb = ty_erase ty_rule in let f loc l = f loc (List.rev l) in let act = ty_eval ty_rule f in Pcoq.Production.make symb act let rec proj_symbol : type a b c. (a, b, c) ty_user_symbol -> (a, b, c) genarg_type = function | TUentry a -> ExtraArg a | TUentryl (a,l) -> ExtraArg a | TUopt(o) -> OptArg (proj_symbol o) | TUlist1 l -> ListArg (proj_symbol l) | TUlist1sep (l,_) -> ListArg (proj_symbol l) | TUlist0 l -> ListArg (proj_symbol l) | TUlist0sep (l,_) -> ListArg (proj_symbol l) (** Vernac grammar extensions *) let vernac_exts = Hashtbl.create 211 let get_extend_vernac_rule s = snd (Hashtbl.find vernac_exts s) let declare_vernac_command_grammar ~allow_override s nt gl = let () = if not allow_override && Hashtbl.mem vernac_exts s then CErrors.anomaly Pp.(str "bad vernac extend: " ++ str s.ext_entry ++ str ", " ++ int s.ext_index) in let nt = Option.default Pvernac.Vernac_.command nt in Hashtbl.add vernac_exts s (nt, gl) type any_extend_statement = Extend : 'a Entry.t * 'a extend_statement -> any_extend_statement let extend_vernac_command_grammar s = let nt, gl = Hashtbl.find vernac_exts s in let mkact loc l = VernacSynterp (VernacExtend (s, l)) in let rules = [make_rule mkact gl] in if Pcoq.Entry.is_empty nt then (* Small hack to tolerate empty entries in VERNAC { ... } EXTEND *) Extend (nt, (Pcoq.Fresh (Gramlib.Gramext.First, [None, None, rules]))) else Extend (nt, (Pcoq.Reuse (None, rules))) let to_extend_rules (Extend (nt, r)) = [ExtendRule (nt,r)] let extend_vernac = Pcoq.create_grammar_command "VernacExtend" { gext_fun = (fun s st -> to_extend_rules @@ extend_vernac_command_grammar s, st); gext_eq = (==); (* FIXME *) } let extend_vernac_command_grammar ~undoable s = if undoable then Pcoq.extend_grammar_command extend_vernac s else let Extend (nt, r) = extend_vernac_command_grammar s in grammar_extend nt r let grammar_exts = Hashtbl.create 21 let declare_grammar_ext ~uid e = let () = if Hashtbl.mem grammar_exts uid then CErrors.anomaly Pp.(str "bad grammar extend uid: " ++ str uid) in Hashtbl.add grammar_exts uid e let extend_grammar = Pcoq.create_grammar_command "GrammarExtend" { gext_fun = (fun s st -> to_extend_rules @@ Hashtbl.find grammar_exts s, st); gext_eq = (==); (* FIXME *) } let grammar_extend ?plugin_uid nt r = match plugin_uid with | None -> Pcoq.grammar_extend nt r | Some (plugin,uid) -> let uid = plugin^":"^uid in declare_grammar_ext ~uid (Extend (nt, r)); Mltop.add_init_function plugin (fun () -> Pcoq.extend_grammar_command extend_grammar uid) coq-8.20.0/vernac/egramml.mli000066400000000000000000000033231466560755400160130ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* 's grammar_prod_item val declare_vernac_command_grammar : allow_override:bool -> extend_name -> vernac_expr Pcoq.Entry.t option -> vernac_expr grammar_prod_item list -> unit val extend_vernac_command_grammar : undoable:bool -> extend_name -> unit val grammar_extend : ?plugin_uid:(string * string) -> 'a Pcoq.Entry.t -> 'a Pcoq.extend_statement -> unit val get_extend_vernac_rule : extend_name -> vernac_expr grammar_prod_item list val proj_symbol : ('a, 'b, 'c) Extend.ty_user_symbol -> ('a, 'b, 'c) Genarg.genarg_type (** Utility function reused in Egramcoq : *) val make_rule : (Loc.t -> Genarg.raw_generic_argument list -> 'a) -> 'a grammar_prod_item list -> 'a Pcoq.Production.t coq-8.20.0/vernac/future.ml000066400000000000000000000134451466560755400155360ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* Pp.strbrk("The value you are asking for ("^name^") is not ready yet. "^ "Please wait or pass "^ "the \"-async-proofs off\" option to CoqIDE to disable "^ "asynchronous script processing and don't pass \"-vio\" to "^ "coqc.")) let not_here_msg = ref (fun name -> Pp.strbrk("The value you are asking for ("^name^") is not available "^ "in this process. If you really need this, pass "^ "the \"-async-proofs off\" option to CoqIDE to disable "^ "asynchronous script processing and don't pass \"-vio\" to "^ "coqc.")) exception NotReady of string exception NotHere of string let _ = CErrors.register_handler (function | NotReady name -> Some (!not_ready_msg name) | NotHere name -> Some (!not_here_msg name) | _ -> None) type fix_exn = Stateid.exn_info option let eval_fix_exn f (e, info) = match f with | None -> (e, info) | Some { Stateid.id; valid } -> match Stateid.get info with | Some _ -> (e, info) | None -> let loc = Loc.get_loc info in let msg = CErrors.iprint (e, info) in let () = Feedback.(feedback ~id (Message (Error, loc, msg))) in (e, Stateid.add info ~valid id) module UUID = struct type t = int let invalid = 0 let fresh = let count = ref invalid in fun () -> incr count; !count let compare = compare let equal = (==) end module UUIDMap = Map.Make(UUID) module UUIDSet = Set.Make(UUID) type 'a assignment = [ `Val of 'a | `Exn of Exninfo.iexn | `Comp of (unit -> 'a)] (* Val is not necessarily a final state, so the computation restarts from the state stocked into Val *) and 'a comp = | Delegated of (Mutex.t * Condition.t) option | Closure of (unit -> 'a) | Val of 'a | Exn of Exninfo.iexn (* Invariant: this exception is always "fixed" as in fix_exn *) and 'a computation = | Ongoing of string * (UUID.t * fix_exn * 'a comp ref) CEphemeron.key let unnamed = "unnamed" let create ?(name=unnamed) ?(uuid=UUID.fresh ()) ~fix_exn x = Ongoing (name, CEphemeron.create (uuid, fix_exn, ref x)) let get x = match x with | Ongoing (name, x) -> try let uuid, fix, c = CEphemeron.get x in name, uuid, fix, c with CEphemeron.InvalidKey -> name, UUID.invalid, None, ref (Exn (NotHere name, Exninfo.null)) type 'a value = [ `Val of 'a | `Exn of Exninfo.iexn ] let is_over kx = let _, _, _, x = get kx in match !x with | Val _ | Exn _ -> true | Closure _ | Delegated _ -> false let is_exn kx = let _, _, _, x = get kx in match !x with | Exn _ -> true | Val _ | Closure _ | Delegated _ -> false let peek_val kx = let _, _, _, x = get kx in match !x with | Val v -> Some v | Exn _ | Closure _ | Delegated _ -> None let uuid kx = let _, id, _, _ = get kx in id let from_val v = create ~fix_exn:None (Val v) let create_delegate ?(blocking=true) ~name fix_exn = let sync = if blocking then Some (Mutex.create (), Condition.create ()) else None in let ck = create ~name ~fix_exn (Delegated sync) in let assignment = fun v -> let _, _, fix_exn, c = get ck in let sync = match !c with Delegated s -> s | _ -> assert false in begin match v with | `Val v -> c := Val v | `Exn e -> c := Exn (eval_fix_exn fix_exn e) | `Comp f -> c := Closure f end; let iter (lock, cond) = CThread.with_lock lock ~scope:(fun () -> Condition.broadcast cond) in Option.iter iter sync in ck, assignment (* TODO: get rid of try/catch to be stackless *) let rec compute ck : 'a value = let name, _, fix_exn, c = get ck in match !c with | Val x -> `Val x | Exn (e, info) -> `Exn (e, info) | Delegated None -> raise (NotReady name) | Delegated (Some (lock, cond)) -> CThread.with_lock lock ~scope:(fun () -> Condition.wait cond lock); compute ck | Closure f -> try let data = f () in c := Val data; `Val data with e -> let e = Exninfo.capture e in let e = eval_fix_exn fix_exn e in match e with | (NotReady _, _) -> `Exn e | _ -> c := Exn e; `Exn e let force x = match compute x with | `Val v -> v | `Exn e -> Exninfo.iraise e let chain ck f = let name, uuid, fix_exn, c = get ck in create ~uuid ~name ~fix_exn (match !c with | Closure _ | Delegated _ -> Closure (fun () -> f (force ck)) | Exn _ as x -> x | Val v -> Val (f v)) let create ~fix_exn f = create ~fix_exn (Closure f) let replace kx y = let _, _, _, x = get kx in match !x with | Exn _ -> x := Closure (fun () -> force y) | _ -> CErrors.anomaly (Pp.str "A computation can be replaced only if is_exn holds.") let chain x f = let y = chain x f in if is_over x then ignore(force y); y let print f kx = let open Pp in let name, uid, _, x = get kx in let uid = if UUID.equal uid UUID.invalid then str "[#:" ++ str name ++ str "]" else str "[" ++ int uid ++ str":" ++ str name ++ str "]" in match !x with | Delegated _ -> str "Delegated" ++ uid | Closure _ -> str "Closure" ++ uid | Val x -> str "PureVal" ++ uid ++ spc () ++ hov 0 (f x) | Exn (e, _) -> str "Exn" ++ uid ++ spc () ++ hov 0 (str (Printexc.to_string e)) coq-8.20.0/vernac/future.mli000066400000000000000000000070571466560755400157110ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* t -> int val equal : t -> t -> bool end module UUIDMap : Map.S with type key = UUID.t module UUIDSet : Set.S with type elt = UUID.t exception NotReady of string type 'a computation type 'a value = [ `Val of 'a | `Exn of Exninfo.iexn ] type fix_exn = Stateid.exn_info option (* Build a computation, no snapshot of the global state is taken. If you need to grab a copy of the state start with from_here () and then chain. fix_exn is used to enrich any exception raised by forcing the computations or any computation that is chained after it. It is used by STM to attach errors to their corresponding states, and to communicate to the code catching the exception a valid state id. *) val create : fix_exn:fix_exn -> (unit -> 'a) -> 'a computation (* Usually from_val is used to create "fake" futures, to use the same API as if a real asynchronous computations was there. *) val from_val : 'a -> 'a computation (* Run remotely, returns the function to assign. If not blocking (the default) it raises NotReady if forced before the delegate assigns it. *) type 'a assignment = [ `Val of 'a | `Exn of Exninfo.iexn | `Comp of (unit -> 'a)] val create_delegate : ?blocking:bool -> name:string -> fix_exn -> 'a computation * ('a assignment -> unit) (* Given a computation that is_exn, replace it by another one *) val replace : 'a computation -> 'a computation -> unit (* Inspect a computation *) val is_over : 'a computation -> bool val is_exn : 'a computation -> bool val peek_val : 'a computation -> 'a option val uuid : 'a computation -> UUID.t (* [chain c f] chains computation [c] with [f]. * [chain] is eager, that is to say, it won't suspend the new computation * if the old one is_over (Exn or Val). *) val chain : 'a computation -> ('a -> 'b) -> 'b computation (* Forcing a computation *) val force : 'a computation -> 'a val compute : 'a computation -> 'a value (** Debug: print a computation given an inner printing function. *) val print : ('a -> Pp.t) -> 'a computation -> Pp.t coq-8.20.0/vernac/g_proofs.mlg000066400000000000000000000155141466560755400162100ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* strbrk "The Focus command is deprecated; use bullets or focusing brackets instead." | Some n -> str "The Focus command is deprecated;" ++ spc () ++ str "use '" ++ int n ++ str ": {' instead.") let warn_deprecated_focus_n ?loc n = warn_deprecated_focus ?loc (Some n) let warn_deprecated_focus ?loc () = warn_deprecated_focus ?loc None let warn_deprecated_unfocus = CWarnings.create ~name:"deprecated-unfocus" ~category:Deprecation.Version.v8_8 (fun () -> Pp.strbrk "The Unfocus command is deprecated") } (* Proof commands *) GRAMMAR EXTEND Gram GLOBAL: hint command; opt_hintbases: [ [ -> { [] } | ":"; l = LIST1 [id = IDENT -> { id } ] -> { l } ] ] ; command: TOP [ [ IDENT "Goal"; c = lconstr -> { VernacSynPure (VernacDefinition (Decls.(NoDischarge, Definition), ((CAst.make ~loc Names.Anonymous), None), ProveBody ([], c))) } | IDENT "Proof" -> { VernacSynPure (VernacProof (None,None)) } | IDENT "Proof"; IDENT "using"; l = G_vernac.section_subset_expr -> { VernacSynPure (VernacProof (None,Some l)) } | IDENT "Proof" ; IDENT "Mode" ; mn = string -> { VernacSynterp (VernacProofMode mn) } | IDENT "Proof"; c = lconstr -> { VernacSynPure (VernacExactProof c) } | IDENT "Abort" -> { VernacSynPure VernacAbort } | IDENT "Abort"; IDENT "All" -> { VernacSynPure VernacAbortAll } | IDENT "Admitted" -> { VernacSynPure (VernacEndProof Admitted) } | IDENT "Qed" -> { VernacSynPure (VernacEndProof (Proved (Opaque,None))) } | IDENT "Save"; id = identref -> { VernacSynPure (VernacEndProof (Proved (Opaque, Some id))) } | IDENT "Defined" -> { VernacSynPure (VernacEndProof (Proved (Transparent,None))) } | IDENT "Defined"; id=identref -> { VernacSynPure (VernacEndProof (Proved (Transparent,Some id))) } | IDENT "Restart" -> { VernacSynPure VernacRestart } | IDENT "Undo" -> { VernacSynPure (VernacUndo 1) } | IDENT "Undo"; n = natural -> { VernacSynPure (VernacUndo n) } | IDENT "Undo"; IDENT "To"; n = natural -> { VernacSynPure (VernacUndoTo n) } | IDENT "Focus" -> { warn_deprecated_focus ~loc (); VernacSynPure (VernacFocus None) } | IDENT "Focus"; n = natural -> { warn_deprecated_focus_n n ~loc; VernacSynPure (VernacFocus (Some n)) } | IDENT "Unfocus" -> { warn_deprecated_unfocus ~loc (); VernacSynPure VernacUnfocus } | IDENT "Unfocused" -> { VernacSynPure VernacUnfocused } | IDENT "Show" -> { VernacSynPure (VernacShow (ShowGoal OpenSubgoals)) } | IDENT "Show"; n = natural -> { VernacSynPure (VernacShow (ShowGoal (NthGoal n))) } | IDENT "Show"; id = ident -> { VernacSynPure (VernacShow (ShowGoal (GoalId id))) } | IDENT "Show"; IDENT "Existentials" -> { VernacSynPure (VernacShow ShowExistentials) } | IDENT "Show"; IDENT "Universes" -> { VernacSynPure (VernacShow ShowUniverses) } | IDENT "Show"; IDENT "Conjectures" -> { VernacSynPure (VernacShow ShowProofNames) } | IDENT "Show"; IDENT "Proof" -> { VernacSynPure (VernacShow ShowProof) } | IDENT "Show"; IDENT "Intro" -> { VernacSynPure (VernacShow (ShowIntros false)) } | IDENT "Show"; IDENT "Intros" -> { VernacSynPure (VernacShow (ShowIntros true)) } | IDENT "Show"; IDENT "Match"; id = reference -> { VernacSynPure (VernacShow (ShowMatch id)) } | IDENT "Guarded" -> { VernacSynPure VernacCheckGuard } | IDENT "Validate"; IDENT "Proof" -> { VernacSynPure VernacValidateProof } (* Hints for Auto and EAuto *) | IDENT "Create"; IDENT "HintDb" ; id = IDENT ; b = [ IDENT "discriminated" -> { true } | -> { false } ] -> { VernacSynPure (VernacCreateHintDb (id, b)) } | IDENT "Remove"; IDENT "Hints"; ids = LIST1 global; dbnames = opt_hintbases -> { VernacSynPure (VernacRemoveHints (dbnames, ids)) } | IDENT "Hint"; h = hint; dbnames = opt_hintbases -> { VernacSynPure (VernacHints (dbnames, h)) } ] ]; reference_or_constr: [ [ r = global -> { HintsReference r } | c = constr -> { HintsConstr c } ] ] ; hint: [ [ IDENT "Resolve"; lc = LIST1 reference_or_constr; info = hint_info -> { HintsResolve (List.map (fun x -> (info, true, x)) lc) } | IDENT "Resolve"; "->"; lc = LIST1 global; n = OPT natural -> { HintsResolveIFF (true, lc, n) } | IDENT "Resolve"; "<-"; lc = LIST1 global; n = OPT natural -> { HintsResolveIFF (false, lc, n) } | IDENT "Immediate"; lc = LIST1 reference_or_constr -> { HintsImmediate lc } | IDENT "Variables"; IDENT "Transparent" -> { HintsTransparency (HintsVariables, true) } | IDENT "Variables"; IDENT "Opaque" -> { HintsTransparency (HintsVariables, false) } | IDENT "Constants"; IDENT "Transparent" -> { HintsTransparency (HintsConstants, true) } | IDENT "Constants"; IDENT "Opaque" -> { HintsTransparency (HintsConstants, false) } | IDENT "Projections"; IDENT "Transparent" -> { HintsTransparency (HintsProjections, true) } | IDENT "Projections"; IDENT "Opaque" -> { HintsTransparency (HintsProjections, false) } | IDENT "Transparent"; lc = LIST1 global -> { HintsTransparency (HintsReferences lc, true) } | IDENT "Opaque"; lc = LIST1 global -> { HintsTransparency (HintsReferences lc, false) } | IDENT "Mode"; l = global; m = mode -> { HintsMode (l, m) } | IDENT "Unfold"; lqid = LIST1 global -> { HintsUnfold lqid } | IDENT "Constructors"; lc = LIST1 global -> { HintsConstructors lc } ] ] ; constr_body: [ [ ":="; c = lconstr -> { c } | ":"; t = lconstr; ":="; c = lconstr -> { CAst.make ~loc @@ CCast(c,Some C.DEFAULTcast, t) } ] ] ; mode: [ [ l = LIST1 [ "+" -> { ModeInput } | "!" -> { ModeNoHeadEvar } | "-" -> { ModeOutput } ] -> { l } ] ] ; END coq-8.20.0/vernac/g_proofs.mli000066400000000000000000000014031466560755400162020ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* { ArgArg n } | id = identref -> { ArgVar id } ] ] ; nat_or_var: [ [ n = natural -> { ArgArg n } | id = identref -> { ArgVar id } ] ] ; occs_nums: [ [ nl = LIST1 nat_or_var -> { OnlyOccurrences nl } | "-"; nl = LIST1 nat_or_var -> { AllOccurrencesBut nl } ] ] ; occs: [ [ "at"; occs = occs_nums -> { occs } | -> { AllOccurrences } ] ] ; pattern_occ: [ [ c = constr; nl = occs -> { (nl,c) } ] ] ; ref_or_pattern_occ: (* If a string, it is interpreted as a ref (anyway a Coq string does not reduce) *) [ [ c = smart_global; nl = occs -> { nl,Inl c } | c = constr; nl = occs -> { nl,Inr c } ] ] ; unfold_occ: [ [ c = smart_global; nl = occs -> { (nl,c) } ] ] ; red_flag: [ [ IDENT "beta" -> { [FBeta] } | IDENT "iota" -> { [FMatch;FFix;FCofix] } | IDENT "match" -> { [FMatch] } | IDENT "fix" -> { [FFix] } | IDENT "cofix" -> { [FCofix] } | IDENT "zeta" -> { [FZeta] } | IDENT "delta"; d = delta_flag -> { [d] } | IDENT "head" -> { [FHead] } ] ] ; delta_flag: [ [ "-"; "["; idl = LIST1 smart_global; "]" -> { FDeltaBut idl } | "["; idl = LIST1 smart_global; "]" -> { FConst idl } | -> { FDeltaBut [] } ] ] ; strategy_flag: [ [ s = LIST1 red_flag -> { Redops.make_red_flag (List.flatten s) } | h = OPT [ IDENT "head" -> { () } ]; d = delta_flag -> { all_with ~head:(Option.has_some h) d } ] ] ; red_expr: [ [ IDENT "red" -> { Red } | IDENT "hnf" -> { Hnf } | IDENT "simpl"; h = OPT [ IDENT "head" -> { () } ]; d = delta_flag; po = OPT ref_or_pattern_occ -> { Simpl (all_with ~head:(Option.has_some h) d,po) } | IDENT "cbv"; s = strategy_flag -> { Cbv s } | IDENT "cbn"; s = strategy_flag -> { Cbn s } | IDENT "lazy"; s = strategy_flag -> { Lazy s } | IDENT "compute"; delta = delta_flag -> { Cbv (all_with ~head:false delta) } | IDENT "vm_compute"; po = OPT ref_or_pattern_occ -> { CbvVm po } | IDENT "native_compute"; po = OPT ref_or_pattern_occ -> { CbvNative po } | IDENT "unfold"; ul = LIST1 unfold_occ SEP "," -> { Unfold ul } | IDENT "fold"; cl = LIST1 constr -> { Fold cl } | IDENT "pattern"; pl = LIST1 pattern_occ SEP"," -> { Pattern pl } | s = IDENT -> { ExtraRedExpr s } ] ] ; END coq-8.20.0/vernac/g_redexpr.mli000066400000000000000000000022211466560755400163420ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* Dash n | '+' -> Plus n | '*' -> Star n | _ -> assert false (* For now we just keep the top-level location of the whole vernacular, that is to say, including attributes and control flags; this is not very convenient for advanced clients tho, so in the future it'd be cool to actually locate the attributes and control flags individually too. *) let add_control_flag ~loc ~flag { CAst.v = cmd } = CAst.make ~loc { cmd with control = flag :: cmd.control } let test_hash_ident = let open Pcoq.Lookahead in to_entry "test_hash_ident" begin lk_kw "#" >> lk_ident >> check_no_space end let test_id_colon = let open Pcoq.Lookahead in to_entry "test_id_colon" begin lk_ident >> lk_kw ":" end let warn_chdir_pwd = CWarnings.create ~name:"change-dir-pwd-deprecated" ~category:Deprecation.Version.v8_20 (fun () -> strbrk "Command \"Cd\" as a synonym of \"Pwd\" is deprecated." ++ spc () ++ strbrk "Use \"Pwd\" instead.") } GRAMMAR EXTEND Gram GLOBAL: vernac_control quoted_attributes attribute_list gallina_ext noedit_mode subprf subprf_with_selector; vernac_control: FIRST [ [ IDENT "Time"; c = vernac_control -> { add_control_flag ~loc ~flag:ControlTime c } | IDENT "Instructions"; c = vernac_control -> { add_control_flag ~loc ~flag:ControlInstructions c } | IDENT "Redirect"; s = ne_string; c = vernac_control -> { add_control_flag ~loc ~flag:(ControlRedirect s) c } | IDENT "Timeout"; n = natural; c = vernac_control -> { add_control_flag ~loc ~flag:(ControlTimeout n) c } | IDENT "Fail"; c = vernac_control -> { add_control_flag ~loc ~flag:ControlFail c } | IDENT "Succeed"; c = vernac_control -> { add_control_flag ~loc ~flag:ControlSucceed c } | v = decorated_vernac -> { let (attrs, expr) = v in CAst.make ~loc { control = []; attrs; expr = expr } } ] ] ; decorated_vernac: [ [ a = quoted_attributes ; fv = vernac -> { let (f, v) = fv in (List.append a f, v) } ] ] ; quoted_attributes: [ [ l = LIST0 [ "#[" ; a = attribute_list ; "]" -> { a } ] -> { List.flatten l } ] ] ; attribute_list: [ [ a = LIST1 attribute SEP "," -> { a } ] ] ; attribute: [ [ k = ident ; v = attr_value -> { CAst.make ~loc (Names.Id.to_string k, v) } (* Required because "ident" is declared a keyword when loading Ltac. *) | IDENT "using" ; v = attr_value -> { CAst.make ~loc ("using", v) } ] ] ; attr_value: [ [ "=" ; v = string -> { VernacFlagLeaf (FlagString v) } | "=" ; v = IDENT -> { VernacFlagLeaf (FlagIdent v) } | "(" ; a = attribute_list ; ")" -> { VernacFlagList a } | -> { VernacFlagEmpty } ] ] ; legacy_attr: [ [ IDENT "Local" -> { CAst.make ~loc ("local", VernacFlagEmpty) } | IDENT "Global" -> { CAst.make ~loc ("global", VernacFlagEmpty) } | IDENT "Polymorphic" -> { Attributes.vernac_polymorphic_flag (Some loc) } | IDENT "Monomorphic" -> { Attributes.vernac_monomorphic_flag (Some loc) } | IDENT "Cumulative" -> { CAst.make ~loc ("universes", VernacFlagList [CAst.make ~loc ("cumulative", VernacFlagEmpty)]) } | IDENT "NonCumulative" -> { CAst.make ~loc ("universes", VernacFlagList [CAst.make ~loc ("cumulative", VernacFlagLeaf (FlagIdent "no"))]) } | IDENT "Private" -> { CAst.make ~loc ("private", VernacFlagList [CAst.make ~loc ("matching", VernacFlagEmpty)]) } | IDENT "Program" -> { CAst.make ~loc ("program", VernacFlagEmpty) } ] ] ; vernac: [ [ attrs = LIST0 legacy_attr; v = vernac_aux -> { (attrs, v) } ] ] ; vernac_aux: (* Better to parse "." here: in case of failure (e.g. in coerce_to_var), *) (* "." is still in the stream and discard_to_dot works correctly *) [ [ g = gallina; "." -> { VernacSynPure g } | g = gallina_ext; "." -> { g } | c = command; "." -> { c } | c = syntax; "." -> { c } ] ] ; vernac_aux: LAST [ [ prfcom = command_entry -> { prfcom } ] ] ; noedit_mode: [ [ c = query_command -> { VernacSynPure (c None) } ] ] ; subprf: [ [ s = BULLET -> { VernacBullet (make_bullet s) } | "}" -> { VernacEndSubproof } ] ] ; subprf_with_selector: [ [ "{" -> { fun g -> VernacSubproof g } (* query_command needs to be here to factor with VernacSubproof *) | c = query_command -> { c } ] ] ; END { let warn_plural_command = CWarnings.create ~name:"plural-command" ~category:CWarnings.CoreCategories.pedantic ~default:CWarnings.Disabled (fun kwd -> strbrk (Printf.sprintf "Command \"%s\" expects more than one assumption." kwd)) let test_plural_form loc kwd = function | [(_,([_],_))] -> warn_plural_command ~loc kwd | _ -> () let test_plural_form_types loc kwd = function | [([_],_)] -> warn_plural_command ~loc kwd | _ -> () let test_plural_form_rules loc kwd = function | [_] -> warn_plural_command ~loc kwd | _ -> () let lname_of_lident : lident -> lname = CAst.map (fun s -> Name s) let name_of_ident_decl : ident_decl -> name_decl = on_fst lname_of_lident let test_variance_ident = let open Pcoq.Lookahead in to_entry "test_variance_ident" begin lk_kws ["=";"+";"*"] >> lk_ident end let test_univ_decl = let open Pcoq.Lookahead in to_entry "test_univ_decl" (lk_ident_list >> lk_kw "|" >> lk_ident_list >> (lk_kw "+" <+> lk_empty) >> (lk_kw "|" <+> lk_kw "|}")) let test_cumul_univ_decl = let open Pcoq.Lookahead in let lk_list_variance_ident = lk_list (lk_kw "+" <+> lk_kw "*" <+> lk_kw "=" <+> lk_ident) in to_entry "test_cumul_univ_decl" (lk_ident_list >> lk_kw "|" >> lk_list_variance_ident >> (lk_kw "+" <+> lk_empty) >> (lk_kw "|" <+> lk_kw "|}")) } (* Gallina declarations *) GRAMMAR EXTEND Gram GLOBAL: gallina gallina_ext thm_token def_token assumption_token def_body of_type of_type_inst record_field notation_declaration decl_notations fix_definition ident_decl univ_decl inductive_or_record_definition; gallina: (* Definition, Theorem, Variable, Axiom, ... *) [ [ thm = thm_token; id = ident_decl; bl = binders; ":"; c = lconstr; l = LIST0 [ "with"; id = ident_decl; bl = binders; ":"; c = lconstr -> { (id,(bl,c)) } ] -> { VernacStartTheoremProof (thm, (id,(bl,c))::l) } | stre = assumption_token; nl = inline; bl = assum_list -> { VernacAssumption (stre, nl, bl) } | tk = assumptions_token; nl = inline; bl = assum_list -> { let (kwd,stre) = tk in test_plural_form loc kwd bl; VernacAssumption (stre, nl, bl) } | d = def_token; id = ident_decl; b = def_body -> { VernacDefinition (d, name_of_ident_decl id, b) } | IDENT "Symbol"; bl = assum_list -> { VernacSymbol bl } | IDENT "Symbols"; bl = assum_list -> { test_plural_form loc "Symbols" bl; VernacSymbol bl } | IDENT "Let"; id = ident_decl; b = def_body -> { VernacDefinition ((DoDischarge, Let), name_of_ident_decl id, b) } (* Gallina inductive declarations *) | f = finite_token; ind = inductive_or_record_definition -> { VernacInductive (f, [ind]) } | f = inductive_token; indl = LIST1 inductive_or_record_definition SEP "with" -> { VernacInductive (f, indl) } | "Fixpoint"; recs = LIST1 fix_definition SEP "with" -> { VernacFixpoint (NoDischarge, recs) } | IDENT "Let"; "Fixpoint"; recs = LIST1 fix_definition SEP "with" -> { VernacFixpoint (DoDischarge, recs) } | "CoFixpoint"; corecs = LIST1 cofix_definition SEP "with" -> { VernacCoFixpoint (NoDischarge, corecs) } | IDENT "Let"; "CoFixpoint"; corecs = LIST1 cofix_definition SEP "with" -> { VernacCoFixpoint (DoDischarge, corecs) } | IDENT "Scheme"; l = LIST1 scheme SEP "with" -> { VernacScheme l } | IDENT "Scheme"; IDENT "Equality"; IDENT "for" ; id = smart_global -> { VernacSchemeEquality (SchemeEquality,id) } | IDENT "Scheme"; IDENT "Boolean"; IDENT "Equality"; IDENT "for" ; id = smart_global -> { VernacSchemeEquality (SchemeBooleanEquality,id) } | IDENT "Combined"; IDENT "Scheme"; id = identref; IDENT "from"; l = LIST1 identref SEP "," -> { VernacCombinedScheme (id, l) } | IDENT "Register"; g = global; "as"; quid = qualid -> { VernacRegister(g, RegisterCoqlib quid) } | IDENT "Register"; IDENT "Scheme"; g = global; "as"; qid = qualid; IDENT "for"; g' = global -> { VernacRegister(g, RegisterScheme {inductive = g'; scheme_kind = qid}) } | IDENT "Register"; IDENT "Inline"; g = global -> { VernacRegister(g, RegisterInline) } | IDENT "Primitive"; id = ident_decl; typopt = OPT [ ":"; typ = lconstr -> { typ } ]; ":="; r = register_token -> { VernacPrimitive(id, r, typopt) } | IDENT "Universe"; l = LIST1 identref -> { VernacUniverse l } | IDENT "Universes"; l = LIST1 identref -> { VernacUniverse l } | IDENT "Constraint"; l = LIST1 univ_constraint SEP "," -> { VernacConstraint l } | IDENT "Rewrite"; IDENT "Rule"; id = identref; ":="; OPT"|"; rules = LIST1 rewrite_rule SEP "|" -> { VernacAddRewRule (id, rules) } | IDENT "Rewrite"; IDENT "Rules"; id = identref; ":="; OPT"|"; rules = LIST1 rewrite_rule SEP "|" -> { test_plural_form_rules loc "Rewrite Rules" rules; VernacAddRewRule (id, rules) } ] ] ; register_token: [ [ test_hash_ident; "#"; r = IDENT -> { CPrimitives.parse_op_or_type ~loc r } ] ] ; thm_token: [ [ "Theorem" -> { Theorem } | IDENT "Lemma" -> { Lemma } | IDENT "Fact" -> { Fact } | IDENT "Remark" -> { Remark } | IDENT "Corollary" -> { Corollary } | IDENT "Proposition" -> { Proposition } | IDENT "Property" -> { Property } ] ] ; def_token: [ [ "Definition" -> { (NoDischarge,Definition) } | IDENT "Example" -> { (NoDischarge,Example) } | IDENT "SubClass" -> { (NoDischarge,SubClass) } ] ] ; assumption_token: [ [ "Hypothesis" -> { (DoDischarge, Logical) } | "Variable" -> { (DoDischarge, Definitional) } | "Axiom" -> { (NoDischarge, Logical) } | "Parameter" -> { (NoDischarge, Definitional) } | IDENT "Conjecture" -> { (NoDischarge, Conjectural) } ] ] ; assumptions_token: [ [ IDENT "Hypotheses" -> { ("Hypotheses", (DoDischarge, Logical)) } | IDENT "Variables" -> { ("Variables", (DoDischarge, Definitional)) } | IDENT "Axioms" -> { ("Axioms", (NoDischarge, Logical)) } | IDENT "Parameters" -> { ("Parameters", (NoDischarge, Definitional)) } | IDENT "Conjectures" -> { ("Conjectures", (NoDischarge, Conjectural)) } ] ] ; inline: [ [ IDENT "Inline"; "("; i = natural; ")" -> { InlineAt i } | IDENT "Inline" -> { DefaultInline } | -> { NoInline } ] ] ; univ_constraint: [ [ l = universe_name; ord = [ "<" -> { Univ.Lt } | "=" -> { Univ.Eq } | "<=" -> { Univ.Le } ]; r = universe_name -> { (l, ord, r) } ] ] ; univ_decl_constraints: [ [ "|"; l' = LIST0 univ_constraint SEP ","; ext = [ "+" -> { true } | -> { false } ]; "}" -> { (l',ext) } | ext = [ "}" -> { true } | bar_cbrace -> { false } ] -> { ([], ext) } ] ] ; univ_decl: [ [ "@{" ; test_univ_decl; l0 = LIST0 identref; "|"; l = LIST0 identref; ext = [ "+" -> { true } | -> { false } ]; cs = univ_decl_constraints -> { let open UState in { univdecl_qualities = l0; univdecl_extensible_qualities = false; univdecl_instance = l; univdecl_extensible_instance = ext; univdecl_constraints = fst cs; univdecl_extensible_constraints = snd cs } } | "@{" ; l = LIST0 identref; ext = [ "+" -> { true } | -> { false } ]; cs = univ_decl_constraints -> { let open UState in { univdecl_qualities = []; univdecl_extensible_qualities = false; univdecl_instance = l; univdecl_extensible_instance = ext; univdecl_constraints = fst cs; univdecl_extensible_constraints = snd cs } } ] ] ; variance: [ [ "+" -> { UVars.Variance.Covariant } | "=" -> { UVars.Variance.Invariant } | "*" -> { UVars.Variance.Irrelevant } ] ] ; variance_identref: [ [ id = identref -> { (id, None) } | test_variance_ident; v = variance; id = identref -> { (id, Some v) } (* We need this test to help the parser avoid the conflict between "+" before ident (covariance) and trailing "+" (extra univs allowed) *) ] ] ; cumul_univ_decl: [ [ "@{" ; test_cumul_univ_decl; l0 = LIST0 identref; "|"; l = LIST0 variance_identref; ext = [ "+" -> { true } | -> { false } ]; cs = univ_decl_constraints -> { let open UState in { univdecl_qualities = l0; univdecl_extensible_qualities = false; univdecl_instance = l; univdecl_extensible_instance = ext; univdecl_constraints = fst cs; univdecl_extensible_constraints = snd cs } } | "@{" ; l = LIST0 variance_identref; ext = [ "+" -> { true } | -> { false } ]; cs = univ_decl_constraints -> { let open UState in { univdecl_qualities = []; univdecl_extensible_qualities = false; univdecl_instance = l; univdecl_extensible_instance = ext; univdecl_constraints = fst cs; univdecl_extensible_constraints = snd cs } } ] ] ; ident_decl: [ [ i = identref; l = OPT univ_decl -> { (i, l) } ] ] ; cumul_ident_decl: [ [ i = identref; l = OPT cumul_univ_decl -> { (i, l) } ] ] ; inductive_token: [ [ IDENT "Inductive" -> { Inductive_kw } | IDENT "CoInductive" -> { CoInductive } ] ] ; finite_token: [ [ IDENT "Variant" -> { Variant } | IDENT "Record" -> { Record } | IDENT "Structure" -> { Structure } | IDENT "Class" -> { Class true } ] ] ; (* Simple definitions *) def_body: [ [ bl = binders; ":="; red = reduce; c = lconstr -> { match c.CAst.v with | CCast(c, Some C.DEFAULTcast, t) -> DefineBody (bl, red, c, Some t) | _ -> DefineBody (bl, red, c, None) } | bl = binders; ":"; t = lconstr; ":="; red = reduce; c = lconstr -> { DefineBody (bl, red, c, Some t) } | bl = binders; ":"; t = lconstr -> { ProveBody (bl, t) } ] ] ; reduce: [ [ IDENT "Eval"; r = red_expr; "in" -> { Some r } | -> { None } ] ] ; notation_declaration: [ [ ntn = lstring; ":="; c = constr; modl = syntax_modifiers; scopt = OPT [ ":"; sc = IDENT -> { sc } ] -> { { ntn_decl_string = ntn; ntn_decl_interp = c; ntn_decl_scope = scopt; ntn_decl_modifiers = modl; } } ] ] ; decl_sep: [ [ IDENT "and" -> { () } ] ] ; decl_notations: [ [ "where"; l = LIST1 notation_declaration SEP decl_sep -> { l } | -> { [] } ] ] ; (* Inductives and records *) opt_constructors_or_fields: [ [ ":="; lc = constructors_or_record -> { lc } | ":=" -> { Constructors [] } | -> { RecordDecl (None, [], None) } ] ] ; inductive_or_record_definition: [ [ oc = opt_coercion; id = cumul_ident_decl; indpar = binders; extrapar = OPT [ "|"; p = binders -> { p } ]; c = OPT [ ":"; c = lconstr -> { c } ]; lc=opt_constructors_or_fields; ntn = decl_notations -> { (((oc,id),(indpar,extrapar),c,lc),ntn) } ] ] ; constructors_or_record: [ [ "|"; l = LIST1 constructor SEP "|" -> { Constructors l } | attr = quoted_attributes ; id = identref ; c = constructor_type; "|"; l = LIST1 constructor SEP "|" -> { Constructors ((c attr id)::l) } | attr = quoted_attributes ; id = identref ; c = constructor_type -> { Constructors [ c attr id ] } | attr = quoted_attributes ; cstr = identref; "{"; fs = record_fields; "}"; id = default_inhabitant_ident -> { let () = unsupported_attributes attr in RecordDecl (Some cstr,fs,id) } | "{";fs = record_fields; "}"; id = default_inhabitant_ident -> { RecordDecl (None,fs,id) } ] ] ; default_inhabitant_ident: [ [ "as"; id = identref -> { Some id } | -> { None } ] ] ; (* csort: [ [ s = sort -> CSort (loc,s) ] ] ; *) opt_coercion: [ [ ">" -> { AddCoercion } | -> { NoCoercion } ] ] ; (* (co)-fixpoints *) fix_definition: [ [ id_decl = ident_decl; bl = binders_fixannot; rtype = type_cstr; body_def = OPT [":="; def = lconstr -> { def } ]; notations = decl_notations -> { let binders, rec_order = bl in {fname = fst id_decl; univs = snd id_decl; rec_order; binders; rtype; body_def; notations} } ] ] ; cofix_definition: [ [ id_decl = ident_decl; binders = binders; rtype = type_cstr; body_def = OPT [":="; def = lconstr -> { def }]; notations = decl_notations -> { {fname = fst id_decl; univs = snd id_decl; rec_order = (); binders; rtype; body_def; notations} } ]] ; (* Rewrite Rules *) rw_pattern: [ [ p = lconstr -> { p } ] ]; rewrite_rule: [ [ u = OPT [ u = univ_decl; "|-" -> { u }]; lhs = rw_pattern; "=>" ; rhs = lconstr -> { (u, lhs, rhs) } ] ] ; (* Inductive schemes *) scheme: [ [ kind = scheme_kind -> { (None,kind) } | id = identref; ":="; kind = scheme_kind -> { (Some id,kind) } ] ] ; scheme_kind: [ [sch_type = scheme_type; "for"; sch_qualid = smart_global; IDENT "Sort"; sch_sort = sort_family -> { {sch_type; sch_qualid; sch_sort} } ] ] ; scheme_type: [ [ IDENT "Induction" -> { SchemeInduction } | IDENT "Minimality" -> { SchemeMinimality } | IDENT "Elimination" -> { SchemeElimination } | IDENT "Case" -> { SchemeCase } ] ] ; (* Various Binders *) (* (* ... without coercions *) binder_nodef: [ [ b = binder_let -> (match b with CLocalAssum(l,ty) -> (l,ty) | CLocalDef _ -> user_err ~loc (Pp.str"defined binder not allowed here.")) ] ] ; *) (* ... with coercions *) record_field: [ [ rfu_attrs = quoted_attributes ; bd = record_binder; rfu_priority = OPT [ "|"; n = natural -> { n } ]; rfu_notation = decl_notations -> { let (rfu_coercion, rfu_instance), rf_decl = bd in rf_decl, { rfu_attrs ; rfu_coercion ; rfu_instance ; rfu_priority ; rfu_notation } } ] ] ; record_fields: [ [ f = record_field; ";"; fs = record_fields -> { f :: fs } | f = record_field -> { [f] } | -> { [] } ] ] ; field_body: [ [ l = binders; oc = of_type_inst; t = lconstr -> { fun id -> (oc,AssumExpr (id,l,t)) } | l = binders; oc = of_type_inst; t = lconstr; ":="; b = lconstr -> { fun id -> (oc,DefExpr (id,l,b,Some t)) } | l = binders; ":="; b = lconstr -> { fun id -> (* Why are we dropping cast info here? *) match b.CAst.v with | CCast(b', _, t) -> ((NoCoercion,NoInstance),DefExpr(id,l,b',Some t)) | _ -> ((NoCoercion,NoInstance),DefExpr(id,l,b,None)) } ] ] ; record_binder: [ [ id = name -> { ((NoCoercion,NoInstance),AssumExpr(id, [], CAst.make ~loc @@ CHole (None))) } | id = name; f = field_body -> { f id } ] ] ; assum_list: [ [ bl = LIST1 assum_coe -> { bl } | b = assumpt -> { [b] } ] ] ; assum_coe: [ [ "("; a = assumpt; ")" -> { a } ] ] ; assumpt: [ [ idl = LIST1 ident_decl; oc = of_type; c = lconstr -> { (oc,(idl,c)) } ] ] ; constructor_type: [[ l = binders; t= [ coe = of_type_inst; c = lconstr -> { fun l attr id -> ((attr, fst coe, snd coe),(id,mkProdCN ~loc l c)) } | -> { fun l attr id -> ((attr,NoCoercion,NoInstance),(id,mkProdCN ~loc l (CAst.make ~loc @@ CHole (None)))) } ] -> { t l } ]] ; constructor: [ [ attr = quoted_attributes ; id = identref; c=constructor_type -> { c attr id } ] ] ; of_type: [ [ ":>" -> { AddCoercion } | ":"; ">" -> { AddCoercion } | ":" -> { NoCoercion } ] ] ; of_type_inst: [ [ ":>" -> { (AddCoercion, BackInstanceWarning) (* replace with NoInstance at end of deprecation phase *) } | ":"; ">" -> { (AddCoercion, BackInstanceWarning) (* replace with NoInstance at end of deprecation phase *) } | "::" -> { (NoCoercion, BackInstance) } | "::>" -> { (AddCoercion, BackInstance) } | ":" -> { (NoCoercion, NoInstance) } ] ] ; END { let test_only_starredidentrefs = let open Pcoq.Lookahead in to_entry "test_only_starredidentrefs" begin lk_list (lk_ident <+> lk_kws ["Type"; "*"]) >> (lk_kws [".";")"]) end let starredidentreflist_to_expr l = match l with | [] -> SsEmpty | x :: xs -> List.fold_right (fun i acc -> SsUnion(i,acc)) xs x let warn_deprecated_include_type = CWarnings.create ~name:"deprecated-include-type" ~category:Deprecation.Version.v8_3 (fun () -> strbrk "Include Type is deprecated; use Include instead") let warn_deprecated_as_ident_kind = CWarnings.create ~name:"deprecated-as-ident-kind" ~category:Deprecation.Version.v8_14 (fun () -> strbrk "grammar kind \"as ident\" no longer accepts \"_\"; use \"as name\" instead to accept \"_\", too, or silence the warning if you actually intended to accept only identifiers.") } (* Modules and Sections *) GRAMMAR EXTEND Gram GLOBAL: gallina_ext module_expr module_type section_subset_expr; gallina_ext: [ [ (* Interactive module declaration *) IDENT "Module"; export = export_token; id = identref; bl = LIST0 module_binder; sign = of_module_type; body = is_module_expr -> { VernacSynterp (VernacDefineModule (export, id, bl, sign, body)) } | IDENT "Module"; "Type"; id = identref; bl = LIST0 module_binder; sign = check_module_types; body = is_module_type -> { VernacSynterp (VernacDeclareModuleType (id, bl, sign, body)) } | IDENT "Declare"; IDENT "Module"; export = export_token; id = identref; bl = LIST0 module_binder; ":"; mty = module_type_inl -> { VernacSynterp (VernacDeclareModule (export, id, bl, mty)) } (* Section beginning *) | IDENT "Section"; id = identref -> { VernacSynterp (VernacBeginSection id) } (* This end a Section a Module or a Module Type *) | IDENT "End"; id = identref -> { VernacSynterp (VernacEndSegment id) } (* Naming a set of section hyps *) | IDENT "Collection"; id = identref; ":="; expr = section_subset_expr -> { VernacSynPure (VernacNameSectionHypSet (id, expr)) } (* Requiring an external file *) | IDENT "From" ; ns = global ; IDENT "Extra"; IDENT "Dependency"; f = ne_string ; id = OPT [ "as"; id = IDENT -> { id } ] -> { VernacSynterp (VernacExtraDependency (ns, f, Option.map Id.of_string id)) } (* Requiring an already compiled module *) | IDENT "Require"; export = export_token; qidl = LIST1 filtered_import -> { VernacSynterp (VernacRequire (None, export, qidl)) } | IDENT "From" ; ns = global ; IDENT "Require"; export = export_token ; qidl = LIST1 filtered_import -> { VernacSynterp (VernacRequire (Some ns, export, qidl)) } | IDENT "Import"; cats = OPT import_categories; qidl = LIST1 filtered_import -> { VernacSynterp (VernacImport ((Import,cats),qidl)) } | IDENT "Export"; cats = OPT import_categories; qidl = LIST1 filtered_import -> { VernacSynterp (VernacImport ((Export,cats),qidl)) } | IDENT "Include"; e = module_type_inl; l = LIST0 ext_module_type -> { VernacSynterp (VernacInclude(e::l)) } | IDENT "Include"; "Type"; e = module_type_inl; l = LIST0 ext_module_type -> { warn_deprecated_include_type ~loc (); VernacSynterp (VernacInclude(e::l)) } ] ] ; import_categories: [ [ negative = OPT "-"; "("; cats = LIST1 qualid SEP ","; ")" -> { let cats = List.map (fun cat -> CAst.make ?loc:cat.CAst.loc (Libnames.string_of_qualid cat)) cats in { negative=Option.has_some negative; import_cats = cats } } ] ] ; filtered_import: [ [ m = global -> { (m, ImportAll) } | m = global; "("; ns = LIST1 one_import_filter_name SEP ","; ")" -> { (m, ImportNames ns) } ] ] ; one_import_filter_name: [ [ n = global; etc = OPT [ "("; ".."; ")" -> { () } ] -> { n, Option.has_some etc } ] ] ; export_token: [ [ IDENT "Import"; cats = OPT import_categories -> { Some (Import,cats) } | IDENT "Export"; cats = OPT import_categories -> { Some (Export,cats) } | -> { None } ] ] ; ext_module_type: [ [ "<+"; mty = module_type_inl -> { mty } ] ] ; ext_module_expr: [ [ "<+"; mexpr = module_expr_inl -> { mexpr } ] ] ; check_module_type: [ [ "<:"; mty = module_type_inl -> { mty } ] ] ; check_module_types: [ [ mtys = LIST0 check_module_type -> { mtys } ] ] ; of_module_type: [ [ ":"; mty = module_type_inl -> { Enforce mty } | mtys = check_module_types -> { Check mtys } ] ] ; is_module_type: [ [ ":="; mty = module_type_inl ; l = LIST0 ext_module_type -> { (mty::l) } | -> { [] } ] ] ; is_module_expr: [ [ ":="; mexpr = module_expr_inl; l = LIST0 ext_module_expr -> { (mexpr::l) } | -> { [] } ] ] ; functor_app_annot: [ [ "["; IDENT "inline"; "at"; IDENT "level"; i = natural; "]" -> { InlineAt i } | "["; IDENT "no"; IDENT "inline"; "]" -> { NoInline } | -> { DefaultInline } ] ] ; module_expr_inl: [ [ "!"; me = module_expr -> { (me,NoInline) } | me = module_expr; a = functor_app_annot -> { (me,a) } ] ] ; module_type_inl: [ [ "!"; me = module_type -> { (me,NoInline) } | me = module_type; a = functor_app_annot -> { (me,a) } ] ] ; (* Module binder *) module_binder: [ [ "("; export = export_token; idl = LIST1 identref; ":"; mty = module_type_inl; ")" -> { (export,idl,mty) } ] ] ; (* Module expressions *) module_expr: [ [ me = module_expr_atom -> { CAst.make ~loc @@ CMident me } | me1 = module_expr; me2 = module_expr_atom -> { CAst.make ~loc @@ CMapply (me1,me2) } ] ] ; module_expr_atom: [ [ qid = qualid -> { qid } | "("; me = module_expr_atom; ")" -> { me } ] ] ; with_declaration: [ [ "Definition"; fqid = fullyqualid; udecl = OPT univ_decl; ":="; c = Constr.lconstr -> { CWith_Definition (fqid,udecl,c) } | IDENT "Module"; fqid = fullyqualid; ":="; qid = qualid -> { CWith_Module (fqid,qid) } ] ] ; module_type: [ [ qid = qualid -> { CAst.make ~loc @@ CMident qid } | "("; mt = module_type; ")" -> { mt } | mty = module_type; me = module_expr_atom -> { CAst.make ~loc @@ CMapply (mty,me) } | mty = module_type; "with"; decl = with_declaration -> { CAst.make ~loc @@ CMwith (mty,decl) } ] ] ; (* Proof using *) section_subset_expr: [ [ test_only_starredidentrefs; l = LIST0 starredidentref -> { starredidentreflist_to_expr l } | e = ssexpr -> { e } ]] ; starredidentref: [ [ i = identref -> { SsSingl i } | i = identref; "*" -> { SsFwdClose(SsSingl i) } | "Type" -> { SsType } | "Type"; "*" -> { SsFwdClose SsType } ]] ; ssexpr: [ "35" [ "-"; e = ssexpr -> { SsCompl e } ] | "50" [ e1 = ssexpr; "-"; e2 = ssexpr-> { SsSubstr(e1,e2) } | e1 = ssexpr; "+"; e2 = ssexpr-> { SsUnion(e1,e2) } ] | "0" [ i = starredidentref -> { i } | "()" -> { SsEmpty } | "("; test_only_starredidentrefs; l = LIST0 starredidentref; ")"-> { starredidentreflist_to_expr l } | "("; test_only_starredidentrefs; l = LIST0 starredidentref; ")"; "*" -> { SsFwdClose(starredidentreflist_to_expr l) } | "("; e = ssexpr; ")"-> { e } | "("; e = ssexpr; ")"; "*" -> { SsFwdClose e } ] ] ; END (* Extensions: implicits, coercions, etc. *) GRAMMAR EXTEND Gram GLOBAL: gallina_ext hint_info scope_delimiter; gallina_ext: TOP [ [ (* Transparent and Opaque *) IDENT "Transparent"; o = OPT [ "!" -> {()} ]; l = LIST1 smart_global -> { VernacSynPure (VernacSetOpacity ((Conv_oracle.transparent, l), o <> None)) } | IDENT "Opaque"; o = OPT [ "!" -> {()} ]; l = LIST1 smart_global -> { VernacSynPure (VernacSetOpacity ((Conv_oracle.Opaque, l), o <> None)) } | IDENT "Strategy"; l = LIST1 [ v=strategy_level; "["; q=LIST1 smart_global; "]" -> { (v,q) } ] -> { VernacSynPure (VernacSetStrategy l) } (* Canonical structure *) | IDENT "Canonical"; OPT [ IDENT "Structure" -> {()} ]; qid = global; ud = OPT [ u = OPT univ_decl; d = def_body -> { (u,d) } ] -> { match ud with | None -> VernacSynPure (VernacCanonical CAst.(make ?loc:qid.CAst.loc @@ AN qid)) | Some (u,d) -> let s = coerce_reference_to_id qid in VernacSynPure (VernacDefinition ((NoDischarge,CanonicalStructure),((CAst.make ?loc:qid.CAst.loc (Name s)),u),d)) } | IDENT "Canonical"; OPT [ IDENT "Structure" -> {()} ]; ntn = by_notation -> { VernacSynPure (VernacCanonical CAst.(make ~loc @@ ByNotation ntn)) } (* Coercions *) | IDENT "Coercion"; qid = global; ud = OPT [ u = OPT univ_decl; d = def_body -> { u, d } ] -> { match ud with Some (u, d) -> let s = coerce_reference_to_id qid in VernacSynPure (VernacDefinition ((NoDischarge,Coercion),((CAst.make ?loc:qid.CAst.loc (Name s)),u),d)) | None -> VernacSynPure (VernacCoercion (CAst.make ~loc @@ AN qid, None)) } | IDENT "Identity"; IDENT "Coercion"; f = identref; ":"; s = coercion_class; ">->"; t = coercion_class -> { VernacSynPure (VernacIdentityCoercion (f, s, t)) } | IDENT "Coercion"; qid = global; ":"; s = coercion_class; ">->"; t = coercion_class -> { VernacSynPure (VernacCoercion (CAst.make ~loc @@ AN qid, Some(s, t))) } | IDENT "Coercion"; ntn = by_notation; ":"; s = coercion_class; ">->"; t = coercion_class -> { VernacSynPure (VernacCoercion (CAst.make ~loc @@ ByNotation ntn, Some (s, t))) } | IDENT "Context"; c = LIST1 binder -> { VernacSynPure (VernacContext (List.flatten c)) } | IDENT "Instance"; namesup = instance_name; ":"; t = term LEVEL "200"; info = hint_info ; props = [ ":="; "{"; r = record_declaration; "}" -> { Some (true,r) } | ":="; c = lconstr -> { Some (false,c) } | -> { None } ] -> { VernacSynPure (VernacInstance (fst namesup,snd namesup,t,props,info)) } | IDENT "Existing"; IDENT "Instance"; id = global; info = hint_info -> { VernacSynPure (VernacExistingInstance [id, info]) } | IDENT "Existing"; IDENT "Instances"; ids = LIST1 global; pri = OPT [ "|"; i = natural -> { i } ] -> { let info = { Typeclasses.hint_priority = pri; hint_pattern = None } in let insts = List.map (fun i -> (i, info)) ids in VernacSynPure (VernacExistingInstance insts) } | IDENT "Existing"; IDENT "Class"; is = global -> { VernacSynPure (VernacExistingClass is) } (* Arguments *) | IDENT "Arguments"; qid = smart_global; args = LIST0 arg_specs; more_implicits = OPT [ ","; impl = LIST1 [ impl = LIST0 implicits_alt -> { List.flatten impl } ] SEP "," -> { impl } ]; mods = OPT [ ":"; l = LIST1 args_modifier SEP "," -> { l } ] -> { let mods = match mods with None -> [] | Some l -> List.flatten l in let more_implicits = Option.default [] more_implicits in VernacSynPure (VernacArguments (qid, List.flatten args, more_implicits, mods)) } | IDENT "Implicit"; "Type"; bl = reserv_list -> { VernacSynPure (VernacReserve bl) } | IDENT "Implicit"; IDENT "Types"; bl = reserv_list -> { test_plural_form_types loc "Implicit Types" bl; VernacSynPure (VernacReserve bl) } | IDENT "Generalizable"; gen = [IDENT "All"; IDENT "Variables" -> { Some [] } | IDENT "No"; IDENT "Variables" -> { None } | ["Variable" -> { () } | IDENT "Variables" -> { () } ]; idl = LIST1 identref -> { Some idl } ] -> { VernacSynPure (VernacGeneralizable gen) } ] ] ; args_modifier: [ [ IDENT "simpl"; IDENT "nomatch" -> { [`ReductionDontExposeCase] } | IDENT "simpl"; IDENT "never" -> { [`ReductionNeverUnfold] } | IDENT "default"; IDENT "implicits" -> { [`DefaultImplicits] } | IDENT "clear"; IDENT "implicits" -> { [`ClearImplicits] } | IDENT "clear"; IDENT "scopes" -> { [`ClearScopes] } | IDENT "clear"; IDENT "bidirectionality"; IDENT "hint" -> { [`ClearBidiHint] } | IDENT "rename" -> { [`Rename] } | IDENT "assert" -> { [`Assert] } | IDENT "extra"; IDENT "scopes" -> { [`ExtraScopes] } | IDENT "clear"; IDENT "scopes"; IDENT "and"; IDENT "implicits" -> { [`ClearImplicits; `ClearScopes] } | IDENT "clear"; IDENT "implicits"; IDENT "and"; IDENT "scopes" -> { [`ClearImplicits; `ClearScopes] } ] ] ; scope_delimiter: [ [ "%"; key = IDENT -> { DelimUnboundedScope, key } | "%_"; key = IDENT -> { DelimOnlyTmpScope, key } ] ] ; argument_spec: [ [ b = OPT "!"; id = name ; s = LIST0 scope_delimiter -> { id.CAst.v, not (Option.is_empty b), List.map (fun x -> CAst.make ~loc x) s } ] ]; (* List of arguments implicit status, scope, modifiers *) arg_specs: [ [ item = argument_spec -> { let name, recarg_like, notation_scope = item in [RealArg { name=name; recarg_like=recarg_like; notation_scope=notation_scope; implicit_status = Explicit}] } | "/" -> { [VolatileArg] } | "&" -> { [BidiArg] } | "("; items = LIST1 argument_spec; ")"; scl = LIST0 scope_delimiter -> { let scl = List.map (CAst.make ~loc) scl in List.map (fun (name,recarg_like,notation_scope) -> RealArg { name=name; recarg_like=recarg_like; notation_scope = notation_scope @ scl; implicit_status = Explicit}) items } | "["; items = LIST1 argument_spec; "]"; scl = LIST0 scope_delimiter -> { let scl = List.map (CAst.make ~loc) scl in List.map (fun (name,recarg_like,notation_scope) -> RealArg { name=name; recarg_like=recarg_like; notation_scope = notation_scope @ scl; implicit_status = NonMaxImplicit}) items } | "{"; items = LIST1 argument_spec; "}"; scl = LIST0 scope_delimiter -> { let scl = List.map (CAst.make ~loc) scl in List.map (fun (name,recarg_like,notation_scope) -> RealArg { name=name; recarg_like=recarg_like; notation_scope = notation_scope @ scl; implicit_status = MaxImplicit}) items } ] ]; (* Same as [arg_specs], but with only implicit status and names *) implicits_alt: [ [ name = name -> { [(name.CAst.v, Explicit)] } | "["; items = LIST1 name; "]" -> { List.map (fun name -> (name.CAst.v, NonMaxImplicit)) items } | "{"; items = LIST1 name; "}" -> { List.map (fun name -> (name.CAst.v, MaxImplicit)) items } ] ]; instance_name: [ [ name = ident_decl; bl = binders -> { (CAst.map (fun id -> Name id) (fst name), snd name), bl } | -> { ((CAst.make ~loc Anonymous), None), [] } ] ] ; hint_info: [ [ "|"; i = OPT natural; pat = OPT constr_pattern -> { { Typeclasses.hint_priority = i; hint_pattern = pat } } | -> { { Typeclasses.hint_priority = None; hint_pattern = None } } ] ] ; reserv_list: [ [ bl = LIST1 reserv_tuple -> { bl } | b = simple_reserv -> { [b] } ] ] ; reserv_tuple: [ [ "("; a = simple_reserv; ")" -> { a } ] ] ; simple_reserv: [ [ idl = LIST1 identref; ":"; c = lconstr -> { (idl,c) } ] ] ; END { (* Hack to parse "[ id" without dropping [ *) let test_bracket_ident = let open Pcoq.Lookahead in to_entry "test_bracket_ident" begin lk_kw "[" >> lk_ident end } GRAMMAR EXTEND Gram GLOBAL: toplevel_selector goal_selector; range_selector: [ [ n = natural ; "-" ; m = natural -> { (n, m) } | n = natural -> { (n, n) } ] ] ; (* We unfold a range selectors list once so that we can make a special case * for a unique SelectNth selector. *) range_selector_or_nth: [ [ n = natural ; "-" ; m = natural; l = OPT [","; l = LIST1 range_selector SEP "," -> { l } ] -> { Goal_select.SelectList ((n, m) :: Option.default [] l) } | n = natural; l = OPT [","; l = LIST1 range_selector SEP "," -> { l } ] -> { let open Goal_select in Option.cata (fun l -> SelectList ((n, n) :: l)) (SelectNth n) l } ] ] ; goal_selector: [ [ l = range_selector_or_nth -> { l } | test_bracket_ident; "["; id = ident; "]" -> { Goal_select.SelectId id } ] ] ; toplevel_selector: [ [ sel = goal_selector; ":" -> { sel } | "!"; ":" -> { Goal_select.SelectAlreadyFocused } | IDENT "all"; ":" -> { Goal_select.SelectAll } ] ] ; END GRAMMAR EXTEND Gram GLOBAL: command query_command coercion_class gallina_ext search_query search_queries; gallina_ext: TOP [ [ IDENT "Export"; "Set"; table = setting_name; v = option_setting -> { VernacSynterp (VernacSetOption (true, table, v)) } | IDENT "Export"; IDENT "Unset"; table = setting_name -> { VernacSynterp (VernacSetOption (true, table, OptionUnset)) } ] ]; command: [ [ IDENT "Comments"; l = LIST0 comment -> { VernacSynPure (VernacComments l) } | IDENT "Attributes"; attr = attribute_list -> { VernacSynPure (VernacAttributes attr) } (* Hack! Should be in grammar_ext, but camlp5 factorizes badly *) | IDENT "Declare"; IDENT "Instance"; id = ident_decl; bl = binders; ":"; t = term LEVEL "200"; info = hint_info -> { VernacSynPure (VernacDeclareInstance (id, bl, t, info)) } (* Should be in syntax, but camlp5 would not factorize *) | IDENT "Declare"; IDENT "Scope"; sc = IDENT -> { VernacSynPure (VernacDeclareScope sc) } (* System directory *) | IDENT "Pwd" -> { VernacSynterp (VernacChdir None) } | IDENT "Cd" -> { warn_chdir_pwd (); VernacSynterp (VernacChdir None) } | IDENT "Cd"; dir = ne_string -> { VernacSynterp (VernacChdir (Some dir)) } | IDENT "Load"; verbosely = [ IDENT "Verbose" -> { true } | -> { false } ]; s = [ s = ne_string -> { s } | s = IDENT -> { s } ] -> { VernacSynterp (VernacLoad (verbosely, s)) } | IDENT "Declare"; IDENT "ML"; IDENT "Module"; l = LIST1 ne_string -> { VernacSynterp (VernacDeclareMLModule l) } | IDENT "Locate"; l = locatable -> { VernacSynPure (VernacLocate l) } (* Type-Checking *) | "Type"; c = lconstr -> { VernacSynPure (VernacGlobalCheck c) } (* Printing (careful factorization of entries) *) | IDENT "Print"; p = printable -> { VernacSynPure (VernacPrint p) } | IDENT "Print"; qid = smart_global; l = OPT univ_name_list -> { VernacSynPure (VernacPrint (PrintName (qid,l))) } | IDENT "Print"; IDENT "Module"; "Type"; qid = global -> { VernacSynPure (VernacPrint (PrintModuleType qid)) } | IDENT "Print"; IDENT "Module"; qid = global -> { VernacSynPure (VernacPrint (PrintModule qid)) } | IDENT "Print"; IDENT "Namespace" ; ns = dirpath -> { VernacSynPure (VernacPrint (PrintNamespace ns)) } | IDENT "Inspect"; n = natural -> { VernacSynPure (VernacPrint (PrintInspect n)) } (* For acting on parameter tables *) | "Set"; table = setting_name; v = option_setting -> { VernacSynterp (VernacSetOption (false, table, v)) } | IDENT "Unset"; table = setting_name -> { VernacSynterp (VernacSetOption (false, table, OptionUnset)) } | IDENT "Print"; IDENT "Table"; table = setting_name -> { VernacSynPure (VernacPrintOption table) } | IDENT "Add"; table = IDENT; field = IDENT; v = LIST1 table_value -> { VernacSynPure (VernacAddOption ([table;field], v)) } (* A global value below will be hidden by a field above! *) (* In fact, we give priority to secondary tables *) (* No syntax for tertiary tables due to conflict *) (* (but they are unused anyway) *) | IDENT "Add"; table = IDENT; v = LIST1 table_value -> { VernacSynPure (VernacAddOption ([table], v)) } | IDENT "Test"; table = setting_name; "for"; v = LIST1 table_value -> { VernacSynPure (VernacMemOption (table, v)) } | IDENT "Test"; table = setting_name -> { VernacSynPure (VernacPrintOption table) } | IDENT "Remove"; table = IDENT; field = IDENT; v= LIST1 table_value -> { VernacSynPure (VernacRemoveOption ([table;field], v)) } | IDENT "Remove"; table = IDENT; v = LIST1 table_value -> { VernacSynPure (VernacRemoveOption ([table], v)) } ]] ; query_command: [ [ IDENT "Eval"; r = red_expr; "in"; c = lconstr; "." -> { fun g -> VernacCheckMayEval (Some r, g, c) } | IDENT "Compute"; c = lconstr; "." -> { fun g -> VernacCheckMayEval (Some (Genredexpr.CbvVm None), g, c) } | IDENT "Check"; c = lconstr; "." -> { fun g -> VernacCheckMayEval (None, g, c) } (* Searching the environment *) | IDENT "About"; qid = smart_global; l = OPT univ_name_list; "." -> { fun g -> VernacPrint (PrintAbout (qid,l,g)) } | IDENT "SearchPattern"; c = constr_pattern; l = in_or_out_modules; "." -> { fun g -> VernacSearch (SearchPattern c,g, l) } | IDENT "SearchRewrite"; c = constr_pattern; l = in_or_out_modules; "." -> { fun g -> VernacSearch (SearchRewrite c,g, l) } | IDENT "Search"; s = search_query; l = search_queries; "." -> { let (sl,m) = l in fun g -> VernacSearch (Search (s::sl),g, m) } ] ] ; printable: [ [ IDENT "Term"; qid = smart_global; l = OPT univ_name_list -> { PrintName (qid,l) } | IDENT "All" -> { PrintFullContext } | IDENT "Section"; s = global -> { PrintSectionContext s } | IDENT "Grammar"; ents = LIST0 IDENT -> (* This should be in "syntax" section but is here for factorization*) { PrintGrammar ents } | IDENT "Custom"; IDENT "Grammar"; ent = IDENT -> (* Should also be in "syntax" section *) { PrintCustomGrammar ent } | IDENT "Keywords" -> { PrintKeywords } | IDENT "LoadPath"; dir = OPT dirpath -> { PrintLoadPath dir } | IDENT "Libraries" -> { PrintLibraries } | IDENT "Notation"; ntn = string -> { PrintNotation (Constrexpr.InConstrEntry, ntn) } | IDENT "Notation"; ntn = string; IDENT "in"; IDENT "custom"; ent = IDENT -> { PrintNotation (Constrexpr.InCustomEntry ent, ntn) } | IDENT "ML"; IDENT "Path" -> { PrintMLLoadPath } | IDENT "ML"; IDENT "Modules" -> { PrintMLModules } | IDENT "Debug"; IDENT "GC" -> { PrintDebugGC } | IDENT "Graph" -> { PrintGraph } | IDENT "Classes" -> { PrintClasses } | IDENT "Typeclasses" -> { PrintTypeclasses } | IDENT "Instances"; qid = smart_global -> { PrintInstances qid } | IDENT "Coercions" -> { PrintCoercions } | IDENT "Coercion"; IDENT "Paths"; s = coercion_class; t = coercion_class -> { PrintCoercionPaths (s,t) } | IDENT "Canonical"; IDENT "Projections"; qids = LIST0 smart_global -> { PrintCanonicalConversions qids } | IDENT "Typing"; IDENT "Flags" -> { PrintTypingFlags } | IDENT "Tables" -> { PrintTables } | IDENT "Options" -> { PrintTables (* A Synonymous to Tables *) } | IDENT "Hint" -> { PrintHintGoal } | IDENT "Hint"; qid = smart_global -> { PrintHint qid } | IDENT "Hint"; "*" -> { PrintHintDb } | IDENT "HintDb"; s = IDENT -> { PrintHintDbName s } | IDENT "Scopes" -> { PrintScopes } | IDENT "Scope"; s = IDENT -> { PrintScope s } | IDENT "Visibility"; s = OPT IDENT -> { PrintVisibility s } | IDENT "Implicit"; qid = smart_global -> { PrintImplicit qid } | b = [ IDENT "Sorted" -> { true } | -> { false } ]; IDENT "Universes"; g = OPT printunivs_subgraph; fopt = OPT ne_string -> { PrintUniverses (b, g, fopt) } | IDENT "Assumptions"; qid = smart_global -> { PrintAssumptions (false, false, qid) } | IDENT "Opaque"; IDENT "Dependencies"; qid = smart_global -> { PrintAssumptions (true, false, qid) } | IDENT "Transparent"; IDENT "Dependencies"; qid = smart_global -> { PrintAssumptions (false, true, qid) } | IDENT "All"; IDENT "Dependencies"; qid = smart_global -> { PrintAssumptions (true, true, qid) } | IDENT "Strategy"; qid = smart_global -> { PrintStrategy (Some qid) } | IDENT "Strategies" -> { PrintStrategy None } | IDENT "Registered" -> { PrintRegistered } | IDENT "Registered"; IDENT "Schemes" -> { PrintRegisteredSchemes } ] ] ; printunivs_subgraph: [ [ IDENT "Subgraph"; "("; l = LIST0 reference; ")" -> { l } ] ] ; coercion_class: [ [ IDENT "Funclass" -> { FunClass } | IDENT "Sortclass" -> { SortClass } | qid = smart_global -> { RefClass qid } ] ] ; locatable: [ [ qid = smart_global -> { LocateAny qid } | IDENT "Term"; qid = smart_global -> { LocateTerm qid } | IDENT "File"; f = ne_string -> { LocateFile f } | IDENT "Library"; qid = global -> { LocateLibrary qid } | IDENT "Module"; qid = global -> { LocateModule qid } ] ] ; option_setting: [ [ -> { OptionSetTrue } | n = integer -> { OptionSetInt n } | s = STRING -> { OptionSetString s } ] ] ; table_value: [ [ id = global -> { Goptions.QualidRefValue id } | s = STRING -> { Goptions.StringRefValue s } ] ] ; setting_name: [ [ fl = LIST1 [ x = IDENT -> { x } ] -> { fl } ]] ; ne_in_or_out_modules: [ [ IDENT "inside"; l = LIST1 global -> { SearchInside l } | "in"; l = LIST1 global -> { SearchInside l } | IDENT "outside"; l = LIST1 global -> { SearchOutside l } ] ] ; in_or_out_modules: [ [ m = ne_in_or_out_modules -> { m } | -> { SearchOutside [] } ] ] ; comment: [ [ c = constr -> { CommentConstr c } | s = STRING -> { CommentString s } | n = natural -> { CommentInt n } ] ] ; positive_search_mark: [ [ "-" -> { false } | -> { true } ] ] ; search_query: [ [ b = positive_search_mark; s = search_item -> { (b, SearchLiteral s) } | b = positive_search_mark; "["; l = LIST1 (LIST1 search_query) SEP "|"; "]" -> { (b, SearchDisjConj l) } ] ] ; search_item: [ [ test_id_colon; where = search_where; ":"; s = ne_string; sc = OPT scope_delimiter -> { SearchString (where,s,sc) } | IDENT "is"; ":"; kl = logical_kind -> { SearchKind kl } | s = ne_string; sc = OPT scope_delimiter -> { SearchString ((Anywhere,false),s,sc) } | test_id_colon; where = search_where; ":"; p = constr_pattern -> { SearchSubPattern (where,p) } | p = constr_pattern -> { SearchSubPattern ((Anywhere,false),p) } ] ] ; logical_kind: [ [ k = thm_token -> { IsProof k } | k = assumption_token -> { IsAssumption (snd k) } | k = IDENT "Context" -> { IsAssumption Context } | k = extended_def_token -> { IsDefinition k } | IDENT "Primitive" -> { IsPrimitive } | IDENT "Symbol" -> { IsSymbol } ] ] ; extended_def_token: [ [ k = def_token -> { snd k } | IDENT "Coercion" -> { Coercion } | IDENT "Fixpoint" -> { Fixpoint } | IDENT "CoFixpoint" -> { CoFixpoint } | IDENT "Instance" -> { Instance } | IDENT "Scheme" -> { Scheme } | IDENT "Canonical" -> { CanonicalStructure } | IDENT "Field" -> { StructureComponent } | IDENT "Method" -> { Method } ] ] ; search_where: [ [ IDENT "head" -> { Anywhere, true } | IDENT "hyp" -> { InHyp, false } | IDENT "concl" -> { InConcl, false } | IDENT "headhyp" -> { InHyp, true } | IDENT "headconcl" -> { InConcl, true } ] ] ; search_queries: [ [ m = ne_in_or_out_modules -> { ([],m) } | s = search_query; l = search_queries -> { let (sl,m) = l in (s::sl,m) } | -> { ([],SearchOutside []) } ] ] ; univ_name_list: [ [ "@{" ; l = LIST0 name; "}" -> { [],l } ] ] ; END GRAMMAR EXTEND Gram GLOBAL: command; command: TOP [ [ (* Resetting *) IDENT "Reset"; IDENT "Initial" -> { VernacSynPure (VernacResetInitial) } | IDENT "Reset"; id = identref -> { VernacSynPure (VernacResetName id) } | IDENT "Back" -> { VernacSynPure (VernacBack 1) } | IDENT "Back"; n = natural -> { VernacSynPure (VernacBack n) } (* Tactic Debugger *) | IDENT "Debug"; IDENT "On" -> { VernacSynterp (VernacSetOption (false, ["Ltac";"Debug"], OptionSetTrue)) } | IDENT "Debug"; IDENT "Off" -> { VernacSynterp (VernacSetOption (false, ["Ltac";"Debug"], OptionUnset)) } (* registration of a custom reduction *) | IDENT "Declare"; IDENT "Reduction"; s = IDENT; ":="; r = red_expr -> { VernacSynPure (VernacDeclareReduction (s,r)) } (* factorized here, though relevant for syntax extensions *) | IDENT "Declare"; IDENT "Custom"; IDENT "Entry"; s = IDENT -> { VernacSynterp (VernacDeclareCustomEntry s) } ] ]; END (* Grammar extensions *) GRAMMAR EXTEND Gram GLOBAL: syntax syntax_modifiers; syntax: [ [ IDENT "Open"; IDENT "Scope"; sc = IDENT -> { VernacSynPure (VernacOpenCloseScope (true,sc)) } | IDENT "Close"; IDENT "Scope"; sc = IDENT -> { VernacSynPure (VernacOpenCloseScope (false,sc)) } | IDENT "Delimit"; IDENT "Scope"; sc = IDENT; "with"; key = IDENT -> { VernacSynPure(VernacDelimiters (sc, Some key)) } | IDENT "Undelimit"; IDENT "Scope"; sc = IDENT -> { VernacSynPure(VernacDelimiters (sc, None)) } | IDENT "Bind"; IDENT "Scope"; sc = IDENT; "with"; refl = LIST1 coercion_class -> { VernacSynPure (VernacBindScope (sc,refl)) } | IDENT "Infix"; ntn_decl = notation_declaration -> { VernacSynterp (VernacNotation (true,ntn_decl)) } | IDENT "Notation"; id = identref; idl = LIST0 ident; ":="; c = constr; modl = syntax_modifiers -> { VernacSynPure (VernacSyntacticDefinition (id,(idl,c), modl)) } | IDENT "Notation"; ntn_decl = notation_declaration -> { VernacSynterp (VernacNotation (false,ntn_decl)) } | IDENT "Reserved"; IDENT "Infix"; s = ne_lstring; l = syntax_modifiers -> { VernacSynterp (VernacReservedNotation (true,(s,l))) } | IDENT "Reserved"; IDENT "Notation"; s = ne_lstring; l = syntax_modifiers -> { VernacSynterp (VernacReservedNotation (false,(s,l))) } | on = enable_enable_disable; IDENT "Notation"; rule = enable_notation_rule; interp = enable_notation_interpretation; flags = enable_notation_flags; scope = opt_scope -> { VernacSynPure (VernacEnableNotation (on, rule, interp, flags, scope)) } (* "Print" "Grammar" and "Declare" "Scope" should be here but are in "command" entry in order to factorize with other "Print"-based or "Declare"-based vernac entries *) ] ] ; enable_enable_disable: [ [ IDENT "Enable" -> { true } | IDENT "Disable" -> { false } ] ] ; enable_notation_rule: [ [ s = ne_string -> { Some (Inl s) } | qid = global; idl = LIST0 ident -> { Some (Inr (idl,qid)) } | -> { None } ] ] ; enable_notation_interpretation: [ [ ":="; c = constr -> { Some c } | -> { None } ] ] ; enable_notation_flags: [ [ "("; l = LIST1 enable_notation_flag SEP ","; ")" -> { l } | -> { [] } ] ] ; enable_notation_flag: [ [ IDENT "all" -> { EnableNotationAll } | IDENT "only"; IDENT "parsing" -> { EnableNotationOnly Notationextern.OnlyParsing } | IDENT "only"; IDENT "printing" -> { EnableNotationOnly Notationextern.OnlyPrinting } | "in"; IDENT "custom"; x = identref -> { EnableNotationEntry CAst.(make ?loc:x.loc (InCustomEntry (Id.to_string x.v))) } | "in"; IDENT "constr" -> { EnableNotationEntry (CAst.make ~loc InConstrEntry) } ] ] ; opt_scope: [ [ ":"; sc = IDENT -> { Some (NotationInScope sc) } | ":"; IDENT "no"; IDENT "scope" -> { Some LastLonelyNotation } | -> { None } ] ] ; level: [ [ IDENT "level"; n = natural -> { NumLevel n } | IDENT "next"; IDENT "level" -> { NextLevel } ] ] ; syntax_modifier: [ [ "at"; IDENT "level"; n = natural -> { SetLevel n } | "in"; IDENT "custom"; x = IDENT -> { SetCustomEntry (x,None) } | "in"; IDENT "custom"; x = IDENT; "at"; IDENT "level"; n = natural -> { SetCustomEntry (x,Some n) } | IDENT "left"; IDENT "associativity" -> { SetAssoc Gramlib.Gramext.LeftA } | IDENT "right"; IDENT "associativity" -> { SetAssoc Gramlib.Gramext.RightA } | IDENT "no"; IDENT "associativity" -> { SetAssoc Gramlib.Gramext.NonA } | IDENT "only"; IDENT "printing" -> { SetOnlyPrinting } | IDENT "only"; IDENT "parsing" -> { SetOnlyParsing } | IDENT "format"; s = lstring -> { SetFormat (TextFormat s) } | x = IDENT; ","; l = LIST1 IDENT SEP ","; v = [ "at"; lev = level -> { fun x l -> SetItemLevel (x::l,None,lev) } | "in"; IDENT "scope"; k = IDENT -> { fun x l -> SetItemScope(x::l,k) } ] -> { v x l } | x = IDENT; "at"; lev = level; b = OPT binder_interp -> { SetItemLevel ([x],b,lev) } | x = IDENT; "in"; IDENT "scope"; k = IDENT -> { SetItemScope([x],k) } | x = IDENT; b = binder_interp -> { SetItemLevel ([x],Some b,DefaultLevel) } | x = IDENT; typ = explicit_subentry -> { SetEntryType (x,typ) } ] ] ; syntax_modifiers: [ [ "("; l = LIST1 [ s = syntax_modifier -> { CAst.make ~loc s } ] SEP ","; ")" -> { l } | -> { [] } ] ] ; explicit_subentry: [ [ IDENT "ident" -> { ETIdent } | IDENT "name" -> { ETName } | IDENT "global" -> { ETGlobal } | IDENT "bigint" -> { ETBigint } | IDENT "binder" -> { ETBinder true } | IDENT "constr" -> { ETConstr (InConstrEntry,None,DefaultLevel) } | IDENT "constr"; n = at_level_opt; b = OPT binder_interp -> { ETConstr (InConstrEntry,b,n) } | IDENT "pattern" -> { ETPattern (false,None) } | IDENT "pattern"; "at"; IDENT "level"; n = natural -> { ETPattern (false,Some n) } | IDENT "strict"; IDENT "pattern" -> { ETPattern (true,None) } | IDENT "strict"; IDENT "pattern"; "at"; IDENT "level"; n = natural -> { ETPattern (true,Some n) } | IDENT "closed"; IDENT "binder" -> { ETBinder false } | IDENT "custom"; x = IDENT; n = at_level_opt; b = OPT binder_interp -> { ETConstr (InCustomEntry x,b,n) } ] ] ; at_level_opt: [ [ "at"; n = level -> { n } | -> { DefaultLevel } ] ] ; binder_interp: [ [ "as"; IDENT "ident" -> { warn_deprecated_as_ident_kind (); Notation_term.AsIdent } | "as"; IDENT "name" -> { Notation_term.AsName } | "as"; IDENT "pattern" -> { Notation_term.AsAnyPattern } | "as"; IDENT "strict"; IDENT "pattern" -> { Notation_term.AsStrictPattern } ] ] ; END coq-8.20.0/vernac/g_vernac.mli000066400000000000000000000047201466560755400161550ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* Vernacexpr.synpure_vernac_expr) Pcoq.Entry.t val search_query : (bool * Vernacexpr.search_request) Pcoq.Entry.t val search_queries : ((bool * Vernacexpr.search_request) list * Libnames.qualid list Vernacexpr.search_restriction) Pcoq.Entry.t val subprf : Vernacexpr.synpure_vernac_expr Pcoq.Entry.t val subprf_with_selector : (Goal_select.t option -> Vernacexpr.synpure_vernac_expr) Pcoq.Entry.t val quoted_attributes : Attributes.vernac_flags Pcoq.Entry.t val coercion_class : Vernacexpr.coercion_class Pcoq.Entry.t val thm_token : Decls.theorem_kind Pcoq.Entry.t val def_token : (Vernacexpr.discharge * Decls.definition_object_kind) Pcoq.Entry.t val assumption_token : (Vernacexpr.discharge * Decls.assumption_object_kind) Pcoq.Entry.t val def_body : Vernacexpr.definition_expr Pcoq.Entry.t val notation_declaration : Vernacexpr.notation_declaration Pcoq.Entry.t val decl_notations : Vernacexpr.notation_declaration list Pcoq.Entry.t val record_field : (Vernacexpr.local_decl_expr * Vernacexpr.record_field_attr_unparsed) Pcoq.Entry.t val of_type : Vernacexpr.coercion_flag Pcoq.Entry.t val of_type_inst : (Vernacexpr.coercion_flag * Vernacexpr.instance_flag) Pcoq.Entry.t val section_subset_expr : Vernacexpr.section_subset_expr Pcoq.Entry.t val scope_delimiter : Vernacexpr.scope_delimiter Pcoq.Entry.t val syntax_modifiers : Vernacexpr.syntax_modifier CAst.t list Pcoq.Entry.t val make_bullet : string -> Proof_bullet.t val test_hash_ident : unit Pcoq.Entry.t val test_id_colon : unit Pcoq.Entry.t val warn_plural_command : ?loc:Loc.t -> string -> unit val test_variance_ident : unit Pcoq.Entry.t val test_only_starredidentrefs : unit Pcoq.Entry.t val goal_selector : Goal_select.t Pcoq.Entry.t val toplevel_selector : Goal_select.t Pcoq.Entry.t coq-8.20.0/vernac/himsg.ml000066400000000000000000002144351466560755400153350ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* l := (Vars.substl !l c') :: !l; env | _ -> let t = Vars.substl !l (RelDecl.get_type decl) in let decl = decl |> RelDecl.map_name (named_hd env sigma t) |> RelDecl.map_value (Vars.substl !l) |> RelDecl.set_type t in l := (mkRel 1) :: List.map (Vars.lift 1) !l; push_rel decl env in let env = process_rel_context contract_context env in (env, List.map (Vars.substl !l) lc) let contract2 env sigma a b = match contract env sigma [a;b] with | env, [a;b] -> env,a,b | _ -> assert false let contract3 env sigma a b c = match contract env sigma [a;b;c] with | env, [a;b;c] -> env,a,b,c | _ -> assert false let contract4 env sigma a b c d = match contract env sigma [a;b;c;d] with | env, [a;b;c;d] -> (env,a,b,c),d | _ -> assert false let contract1 env sigma a v = match contract env sigma (a :: v) with | env, a::l -> env,a,l | _ -> assert false let rec contract3' env sigma a b c = function | OccurCheck (evk,d) -> let x,d = contract4 env sigma a b c d in x,OccurCheck(evk, d) | NotClean ((evk,args),env',d) -> let args = Evd.expand_existential sigma (evk, args) in let env',d,args = contract1 env' sigma d args in let args = SList.of_full_list args in contract3 env sigma a b c,NotClean((evk,args),env',d) | ConversionFailed (env',t1,t2) -> let (env',t1,t2) = contract2 env' sigma t1 t2 in contract3 env sigma a b c, ConversionFailed (env',t1,t2) | IncompatibleInstances (env',ev,t1,t2) -> let (env',ev,t1,t2) = contract3 env' sigma (EConstr.mkEvar ev) t1 t2 in contract3 env sigma a b c, IncompatibleInstances (env',EConstr.destEvar sigma ev,t1,t2) | NotSameArgSize | NotSameHead | NoCanonicalStructure | MetaOccurInBody _ | InstanceNotSameType _ | InstanceNotFunctionalType _ | ProblemBeyondCapabilities | UnifUnivInconsistency _ as x -> contract3 env sigma a b c, x | CannotSolveConstraint ((pb,env',t,u),x) -> let env',t,u = contract2 env' sigma t u in let y,x = contract3' env sigma a b c x in y,CannotSolveConstraint ((pb,env',t,u),x) (** Ad-hoc reductions *) let j_nf_betaiotaevar env sigma j = { uj_val = j.uj_val; uj_type = Reductionops.nf_betaiota env sigma j.uj_type } let jv_nf_betaiotaevar env sigma jl = Array.Smart.map (fun j -> j_nf_betaiotaevar env sigma j) jl (** Printers *) let pr_lconstr_env e s c = quote (pr_lconstr_env e s c) let pr_leconstr_env e s c = quote (pr_leconstr_env e s c) let pr_ljudge_env e s c = let v,t = pr_ljudge_env e s c in (quote v,quote t) (** A canonisation procedure for constr such that comparing there externalisation catches more equalities *) let canonize_constr sigma c = (* replaces all the names in binders by [dn] ("default name"), ensures that [alpha]-equivalent terms will have the same externalisation. *) let open EConstr in let dn = Name.Anonymous in let rec canonize_binders c = match EConstr.kind sigma c with | Prod (x,t,b) -> mkProd({x with binder_name=dn},t,b) | Lambda (x,t,b) -> mkLambda({x with binder_name=dn},t,b) | LetIn (x,u,t,b) -> mkLetIn({x with binder_name=dn},u,t,b) | _ -> EConstr.map sigma canonize_binders c in canonize_binders c let rec display_expr_eq c1 c2 = let open Constrexpr in match CAst.(c1.v, c2.v) with | (CHole _ | CEvar _), _ | _, (CEvar _ | CHole _) -> true | _ -> Constrexpr_ops.constr_expr_eq_gen display_expr_eq c1 c2 (** Tries to realize when the two terms, albeit different are printed the same. *) let display_eq ~flags env sigma t1 t2 = (* terms are canonized, then their externalisation is compared syntactically *) let open Constrextern in let t1 = canonize_constr sigma t1 in let t2 = canonize_constr sigma t2 in let ct1 = Flags.with_options flags (fun () -> extern_constr env sigma t1) () in let ct2 = Flags.with_options flags (fun () -> extern_constr env sigma t2) () in display_expr_eq ct1 ct2 (** This function adds some explicit printing flags if the two arguments are printed alike. *) let rec pr_explicit_aux env sigma t1 t2 = function | [] -> (* no specified flags: default. *) Printer.pr_leconstr_env env sigma t1, Printer.pr_leconstr_env env sigma t2 | flags :: rem -> let equal = display_eq ~flags env sigma t1 t2 in if equal then (* The two terms are the same from the user point of view *) pr_explicit_aux env sigma t1 t2 rem else let open Constrextern in let ct1 = Flags.with_options flags (fun () -> extern_constr env sigma t1) () in let ct2 = Flags.with_options flags (fun () -> extern_constr env sigma t2) () in Ppconstr.pr_lconstr_expr env sigma ct1, Ppconstr.pr_lconstr_expr env sigma ct2 let explicit_flags = let open Constrextern in [ []; (* First, try with the current flags *) [print_implicits]; (* Then with implicit *) [print_universes]; (* Then with universes *) [print_universes; print_implicits]; (* With universes AND implicits *) [print_implicits; print_coercions; print_no_symbol]; (* Then more! *) [print_universes; print_implicits; print_coercions; print_no_symbol] (* and more! *) ] let with_diffs pm pn = if not (Proof_diffs.show_diffs ()) then pm, pn else try let tokenize_string = Proof_diffs.tokenize_string in Pp_diff.diff_pp ~tokenize_string pm pn with Pp_diff.Diff_Failure msg -> begin try ignore(Sys.getenv("HIDEDIFFFAILUREMSG")) with Not_found -> Proof_diffs.notify_proof_diff_failure msg end; pm, pn let pr_explicit env sigma t1 t2 = let p1, p2 = pr_explicit_aux env sigma t1 t2 explicit_flags in let p1, p2 = with_diffs p1 p2 in quote p1, quote p2 let pr_db env i = try match env |> lookup_rel i |> get_name with | Name id -> Id.print id | Anonymous -> str "<>" with Not_found -> str "UNBOUND_REL_" ++ int i let explain_unbound_rel env sigma n = let pe = pr_ne_context_of (str "In environment") env sigma in str "Unbound reference: " ++ pe ++ str "The reference " ++ int n ++ str " is free." let explain_unbound_var env v = let var = Id.print v in str "No such section variable or assumption: " ++ var ++ str "." let explain_not_type env sigma j = let pe = pr_ne_context_of (str "In environment") env sigma in let pc,pt = pr_ljudge_env env sigma j in pe ++ str "The term" ++ brk(1,1) ++ pc ++ spc () ++ str "has type" ++ spc () ++ pt ++ spc () ++ str "which should be Set, Prop or Type." let explain_bad_assumption env sigma j = let pe = pr_ne_context_of (str "In environment") env sigma in let pc,pt = pr_ljudge_env env sigma j in pe ++ str "Cannot declare a variable or hypothesis over the term" ++ brk(1,1) ++ pc ++ spc () ++ str "of type" ++ spc () ++ pt ++ spc () ++ str "because this term is not a type." let explain_reference_variables sigma id c = pr_global c ++ strbrk " depends on the variable " ++ Id.print id ++ strbrk " which is not declared in the context." let explain_elim_arity env sigma ind c okinds = let open EConstr in let env = make_all_name_different env sigma in let mib, mip as specif = Inductive.lookup_mind_specif env (fst ind) in let pi = let pp () = pr_pinductive env sigma ind in match mip.mind_squashed with | None | Some AlwaysSquashed -> pp () | Some (SometimesSquashed _) -> (* universe instance matters, so print it regardless of Printing Universes *) Flags.with_option Constrextern.print_universes pp () in let pc = Option.map (pr_leconstr_env env sigma) c in let msg = match okinds with | None -> str "ill-formed elimination predicate." | Some sp -> let ppt ?(ppunivs=false) () = let pp () = pr_leconstr_env env sigma (mkSort (ESorts.make sp)) in if ppunivs then Flags.with_option Constrextern.print_universes pp () else pp () in let squash = Option.get (Inductive.is_squashed (specif, snd ind)) in match squash with | SquashToSet -> let ppt = ppt () in hov 0 (str "the return type has sort" ++ spc () ++ ppt ++ spc () ++ str "while it should be SProp, Prop or Set.") ++ fnl () ++ hov 0 (str "Elimination of an inductive object of sort Set" ++ spc() ++ str "is not allowed on a predicate in sort " ++ ppt ++ fnl () ++ str "because" ++ spc () ++ str "strong elimination on non-small inductive types leads to paradoxes.") | SquashToQuality (QConstant (QSProp | QProp as squashq)) -> let ppt = ppt () in let inds, sorts, explain = match squashq with | QSProp -> "SProp", "SProp", "strict proofs can be eliminated only to build strict proofs" | QProp -> "Prop", "SProp or Prop", "proofs can be eliminated only to build proofs" | QType -> assert false in hov 0 (str "the return type has sort" ++ spc () ++ ppt ++ spc () ++ str "while it should be " ++ str sorts ++ str ".") ++ fnl () ++ hov 0 (str "Elimination of an inductive object of sort " ++ str inds ++ spc() ++ str "is not allowed on a predicate in sort " ++ ppt ++ fnl () ++ str "because" ++ spc () ++ str explain ++ str ".") | SquashToQuality (QConstant QType) -> let ppt = ppt ~ppunivs:true () in hov 0 (str "the return type has sort" ++ spc () ++ ppt ++ spc () ++ str "while it may not be of a variable sort quality.") ++ fnl () ++ hov 0 (str "Elimination of a sort polymorphic inductive object instantiated to sort Type" ++ spc() ++ (* NB: this restriction is only for forward compat with possible future sort qualities *) str "is not allowed on a predicate in a variable sort quality.") | SquashToQuality (QVar squashq) -> let ppt = ppt ~ppunivs:true () in hov 0 (str "the return type has sort" ++ spc () ++ ppt ++ spc () ++ str "while it should be in sort quality " ++ pr_evd_qvar sigma squashq ++ str ".") ++ fnl () ++ hov 0 (str "Elimination of a sort polymorphic inductive object instantiated to a variable sort quality" ++ spc() ++ str "is only allowed on a predicate in the same sort quality.") in hov 0 ( str "Incorrect elimination" ++ (match pc with None -> mt() | Some pc -> str " of" ++ spc () ++ pc) ++ spc () ++ str "in the inductive type" ++ spc () ++ quote pi ++ str ":") ++ fnl () ++ msg let explain_case_not_inductive env sigma cj = let env = make_all_name_different env sigma in let pc = pr_leconstr_env env sigma cj.uj_val in let pct = pr_leconstr_env env sigma cj.uj_type in match EConstr.kind sigma cj.uj_type with | Evar _ -> str "Cannot infer a type for this expression." | _ -> str "The term" ++ brk(1,1) ++ pc ++ spc () ++ str "has type" ++ brk(1,1) ++ pct ++ spc () ++ str "which is not a (co-)inductive type." let explain_case_on_private_ind env sigma ind = str "Case analysis on private inductive "++pr_inductive env ind let explain_number_branches env sigma cj expn = let env = make_all_name_different env sigma in let pc = pr_leconstr_env env sigma cj.uj_val in let pct = pr_leconstr_env env sigma cj.uj_type in str "Matching on term" ++ brk(1,1) ++ pc ++ spc () ++ str "of type" ++ brk(1,1) ++ pct ++ spc () ++ str "expects " ++ int expn ++ str " branches." let explain_ill_formed_case_params env sigma = str "Ill formed case parameters (bugged tactic?)." let explain_ill_formed_branch env sigma c ci actty expty = let simp t = Reductionops.nf_betaiota env sigma t in let env = make_all_name_different env sigma in let pc = pr_leconstr_env env sigma c in let pa, pe = pr_explicit env sigma (simp actty) (simp expty) in strbrk "In pattern-matching on term" ++ brk(1,1) ++ pc ++ spc () ++ strbrk "the branch for constructor" ++ spc () ++ quote (pr_pconstructor env sigma ci) ++ spc () ++ str "has type" ++ brk(1,1) ++ pa ++ spc () ++ str "which should be" ++ brk(1,1) ++ pe ++ str "." let explain_generalization env sigma (name,var) j = let pe = pr_ne_context_of (str "In environment") env sigma in let pv = pr_letype_env env sigma var in let (pc,pt) = pr_ljudge_env (push_rel_assum (make_annot name EConstr.ERelevance.relevant,var) env) sigma j in pe ++ str "Cannot generalize" ++ brk(1,1) ++ pv ++ spc () ++ str "over" ++ brk(1,1) ++ pc ++ str "," ++ spc () ++ str "it has type" ++ spc () ++ pt ++ spc () ++ str "which should be Set, Prop or Type." let explain_unification_error env sigma p1 p2 = function | None -> mt() | Some e -> let rec aux p1 p2 = function | OccurCheck (evk,rhs) -> [str "cannot define " ++ quote (pr_existential_key env sigma evk) ++ strbrk " with term " ++ pr_leconstr_env env sigma rhs ++ strbrk " that would depend on itself"] | NotClean ((evk,args),env,c) -> let args = Evd.expand_existential sigma (evk, args) in let env = make_all_name_different env sigma in [str "cannot instantiate " ++ quote (pr_existential_key env sigma evk) ++ strbrk " because " ++ pr_leconstr_env env sigma c ++ strbrk " is not in its scope" ++ (if List.is_empty args then mt() else strbrk ": available arguments are " ++ pr_sequence (pr_leconstr_env env sigma) (List.rev args))] | NotSameArgSize | NotSameHead | NoCanonicalStructure -> (* Error speaks from itself *) [] | ConversionFailed (env,t1,t2) -> let t1 = Reductionops.nf_betaiota env sigma t1 in let t2 = Reductionops.nf_betaiota env sigma t2 in if EConstr.eq_constr sigma t1 p1 && EConstr.eq_constr sigma t2 p2 then [] else let env = make_all_name_different env sigma in if not (EConstr.eq_constr sigma t1 p1) || not (EConstr.eq_constr sigma t2 p2) then let t1, t2 = pr_explicit env sigma t1 t2 in [str "cannot unify " ++ t1 ++ strbrk " and " ++ t2] else [] | IncompatibleInstances (env,ev,t1,t2) -> let env = make_all_name_different env sigma in let ev = pr_leconstr_env env sigma (EConstr.mkEvar ev) in let t1 = Reductionops.nf_betaiota env sigma t1 in let t2 = Reductionops.nf_betaiota env sigma t2 in let t1, t2 = pr_explicit env sigma t1 t2 in [ev ++ strbrk " has otherwise to unify with " ++ t1 ++ str " which is incompatible with " ++ t2] | MetaOccurInBody evk -> [str "instance for " ++ quote (pr_existential_key env sigma evk) ++ strbrk " refers to a metavariable - please report your example" ++ strbrk "at " ++ str Coq_config.wwwbugtracker ++ str "."] | InstanceNotSameType (evk,env,t,u) -> let t, u = pr_explicit env sigma t u in [str "unable to find a well-typed instantiation for " ++ quote (pr_existential_key env sigma evk) ++ strbrk ": cannot ensure that " ++ t ++ strbrk " is a subtype of " ++ u] | InstanceNotFunctionalType (evk,env,f,u) -> let env = make_all_name_different env sigma in let f = pr_leconstr_env env sigma f in let u = pr_leconstr_env env sigma u in [str "unable to find a well-typed instantiation for " ++ quote (pr_existential_key env sigma evk) ++ strbrk ": " ++ f ++ strbrk " is expected to have a functional type but it has type " ++ u] | UnifUnivInconsistency p -> [str "universe inconsistency: " ++ UGraph.explain_universe_inconsistency (Termops.pr_evd_qvar sigma) (Termops.pr_evd_level sigma) p] | CannotSolveConstraint ((pb,env,t,u),e) -> let env = make_all_name_different env sigma in (strbrk "cannot satisfy constraint " ++ pr_leconstr_env env sigma t ++ str " == " ++ pr_leconstr_env env sigma u) :: aux t u e | ProblemBeyondCapabilities -> [] in match aux p1 p2 e with | [] -> mt () | l -> spc () ++ str "(" ++ prlist_with_sep pr_semicolon (fun x -> x) l ++ str ")" let explain_actual_type env sigma j t reason = let env = make_all_name_different env sigma in let j = j_nf_betaiotaevar env sigma j in let t = Reductionops.nf_betaiota env sigma t in (* Actually print *) let pe = pr_ne_context_of (str "In environment") env sigma in let pc = pr_leconstr_env env sigma (Environ.j_val j) in let (pt, pct) = pr_explicit env sigma t (Environ.j_type j) in let ppreason = explain_unification_error env sigma j.uj_type t reason in pe ++ hov 0 ( str "The term" ++ brk(1,1) ++ pc ++ spc () ++ str "has type" ++ brk(1,1) ++ pct ++ spc () ++ str "while it is expected to have type" ++ brk(1,1) ++ pt ++ ppreason ++ str ".") let explain_incorrect_primitive env sigma j exp = let env = make_all_name_different env sigma in let {uj_val=p;uj_type=t} = j in let t = Reductionops.nf_betaiota env sigma t in let exp = Reductionops.nf_betaiota env sigma exp in (* Actually print *) let pe = pr_ne_context_of (str "In environment") env sigma in let (pt, pct) = pr_explicit env sigma exp t in pe ++ hov 0 ( str "The primitive" ++ brk(1,1) ++ str (CPrimitives.op_or_type_to_string p) ++ spc () ++ str "has type" ++ brk(1,1) ++ pct ++ spc () ++ str "while it is expected to have type" ++ brk(1,1) ++ pt ++ str ".") let explain_cant_apply_bad_type env sigma ?error (n,exptyp,actualtyp) rator randl = let randl = jv_nf_betaiotaevar env sigma randl in let actualtyp = Reductionops.nf_betaiota env sigma actualtyp in let env = make_all_name_different env sigma in let error = explain_unification_error env sigma actualtyp exptyp error in let actualtyp, exptyp = pr_explicit env sigma actualtyp exptyp in let nargs = Array.length randl in (* let pe = pr_ne_context_of (str "in environment") env sigma in*) let pr,prt = pr_ljudge_env env sigma rator in let term_string1 = str (String.plural nargs "term") in let term_string2 = if nargs>1 then str "The " ++ pr_nth n ++ str " term" else str "This term" in let appl = prvect_with_sep fnl (fun c -> let pc,pct = pr_ljudge_env env sigma c in hov 2 (pc ++ spc () ++ str ": " ++ pct)) randl in str "Illegal application: " ++ (* pe ++ *) fnl () ++ str "The term" ++ brk(1,1) ++ pr ++ spc () ++ str "of type" ++ brk(1,1) ++ prt ++ spc () ++ str "cannot be applied to the " ++ term_string1 ++ fnl () ++ str " " ++ v 0 appl ++ fnl () ++ term_string2 ++ str " has type" ++ brk(1,1) ++ actualtyp ++ spc () ++ str "which should be a subtype of" ++ brk(1,1) ++ exptyp ++ str "." ++ error let explain_cant_apply_not_functional env sigma rator randl = let env = make_all_name_different env sigma in let nargs = Array.length randl in (* let pe = pr_ne_context_of (str "in environment") env sigma in*) let pr = pr_leconstr_env env sigma rator.uj_val in let prt = pr_leconstr_env env sigma rator.uj_type in let appl = prvect_with_sep fnl (fun c -> let pc = pr_leconstr_env env sigma c.uj_val in let pct = pr_leconstr_env env sigma c.uj_type in hov 2 (pc ++ spc () ++ str ": " ++ pct)) randl in str "Illegal application (Non-functional construction): " ++ (* pe ++ *) fnl () ++ str "The expression" ++ brk(1,1) ++ pr ++ spc () ++ str "of type" ++ brk(1,1) ++ prt ++ spc () ++ str "cannot be applied to the " ++ str (String.plural nargs "term") ++ fnl () ++ str " " ++ v 0 appl let explain_unexpected_type env sigma actual_type expected_type e = let pract, prexp = pr_explicit env sigma actual_type expected_type in str "Found type" ++ spc () ++ pract ++ spc () ++ str "where" ++ spc () ++ prexp ++ str " was expected" ++ explain_unification_error env sigma actual_type expected_type (Some e) ++ str"." let explain_not_product env sigma c = let pr = pr_econstr_env env sigma c in str "The type of this term is a product" ++ spc () ++ str "while it is expected to be" ++ (if EConstr.isType sigma c then str " a sort" else (brk(1,1) ++ pr)) ++ str "." let explain_ill_formed_fix_body env sigma names i = function (* Fixpoint guard errors *) | NotEnoughAbstractionInFixBody -> str "Not enough abstractions in the definition" | RecursionNotOnInductiveType c -> str "Recursive definition on" ++ spc () ++ pr_leconstr_env env sigma c ++ spc () ++ str "which should be a recursive inductive type" | RecursionOnIllegalTerm(j,(arg_env, arg),le_lt) -> let arg_env = make_all_name_different arg_env sigma in let called = match names.(j).binder_name with Name id -> Id.print id | Anonymous -> str "the " ++ pr_nth i ++ str " definition" in let pr_db x = quote (pr_db env x) in let vars = match Lazy.force le_lt with ([],[]) -> assert false | ([x],[]) -> str "a subterm of " ++ pr_db x | (le,[]) -> str "a subterm of the following variables: " ++ pr_sequence pr_db le | (_,[x]) -> pr_db x | (_,lt) -> str "one of the following variables: " ++ pr_sequence pr_db lt in str "Recursive call to " ++ called ++ spc () ++ strbrk "has principal argument equal to" ++ spc () ++ pr_leconstr_env arg_env sigma arg ++ strbrk " instead of " ++ vars | NotEnoughArgumentsForFixCall j -> let called = match names.(j).binder_name with Name id -> Id.print id | Anonymous -> str "the " ++ pr_nth i ++ str " definition" in str "Recursive call to " ++ called ++ str " has not enough arguments" | FixpointOnIrrelevantInductive -> strbrk "Fixpoints on proof irrelevant inductive types should produce proof irrelevant values" let explain_ill_formed_cofix_body env sigma = function (* CoFixpoint guard errors *) | CodomainNotInductiveType c -> str "The codomain is" ++ spc () ++ pr_leconstr_env env sigma c ++ spc () ++ str "which should be a coinductive type" | NestedRecursiveOccurrences -> str "Nested recursive occurrences" | UnguardedRecursiveCall c -> str "Unguarded recursive call in" ++ spc () ++ pr_leconstr_env env sigma c | RecCallInTypeOfAbstraction c -> str "Recursive call forbidden in the domain of an abstraction:" ++ spc () ++ pr_leconstr_env env sigma c | RecCallInNonRecArgOfConstructor c -> str "Recursive call on a non-recursive argument of constructor" ++ spc () ++ pr_leconstr_env env sigma c | RecCallInTypeOfDef c -> str "Recursive call forbidden in the type of a recursive definition" ++ spc () ++ pr_leconstr_env env sigma c | RecCallInCaseFun c -> str "Invalid recursive call in a branch of" ++ spc () ++ pr_leconstr_env env sigma c | RecCallInCaseArg c -> str "Invalid recursive call in the argument of \"match\" in" ++ spc () ++ pr_leconstr_env env sigma c | RecCallInCasePred c -> str "Invalid recursive call in the \"return\" clause of \"match\" in" ++ spc () ++ pr_leconstr_env env sigma c | NotGuardedForm c -> str "Sub-expression " ++ pr_leconstr_env env sigma c ++ strbrk " not in guarded form (should be a constructor," ++ strbrk " an abstraction, a match, a cofix or a recursive call)" | ReturnPredicateNotCoInductive c -> str "The return clause of the following pattern matching should be" ++ strbrk " a coinductive type:" ++ spc () ++ pr_leconstr_env env sigma c (* TODO: use the names *) (* (co)fixpoints *) let explain_ill_formed_rec_body env sigma err names i fixenv vdefj = let prt_name i = match names.(i).binder_name with Name id -> str "Recursive definition of " ++ Id.print id | Anonymous -> str "The " ++ pr_nth i ++ str " definition" in let st = match err with | FixGuardError err -> explain_ill_formed_fix_body env sigma names i err | CoFixGuardError err -> explain_ill_formed_cofix_body env sigma err in prt_name i ++ str " is ill-formed." ++ fnl () ++ pr_ne_context_of (str "In environment") env sigma ++ st ++ str "." ++ fnl () ++ (try (* May fail with unresolved globals. *) let fixenv = make_all_name_different fixenv sigma in let pvd = pr_leconstr_env fixenv sigma vdefj.(i).uj_val in str"Recursive definition is:" ++ spc () ++ pvd ++ str "." with e when CErrors.noncritical e -> mt ()) let explain_ill_typed_rec_body env sigma i names vdefj vargs = let env = make_all_name_different env sigma in let pvd = pr_leconstr_env env sigma vdefj.(i).uj_val in let pvdt, pv = pr_explicit env sigma vdefj.(i).uj_type vargs.(i) in str "The " ++ (match vdefj with [|_|] -> mt () | _ -> pr_nth (i+1) ++ spc ()) ++ str "recursive definition" ++ spc () ++ pvd ++ spc () ++ str "has type" ++ spc () ++ pvdt ++ spc () ++ str "while it should be" ++ spc () ++ pv ++ str "." let explain_cant_find_case_type env sigma c = let env = make_all_name_different env sigma in let pe = pr_leconstr_env env sigma c in str "Cannot infer the return type of pattern-matching on" ++ ws 1 ++ pe ++ str "." let explain_occur_check env sigma ev rhs = let env = make_all_name_different env sigma in let pt = pr_leconstr_env env sigma rhs in str "Cannot define " ++ pr_existential_key env sigma ev ++ str " with term" ++ brk(1,1) ++ pt ++ spc () ++ str "that would depend on itself." let pr_trailing_ne_context_of env sigma = if List.is_empty (Environ.rel_context env) && List.is_empty (Environ.named_context env) then str "." else (strbrk " in environment:" ++ pr_context_unlimited env sigma) let rec explain_evar_kind env sigma evk ty = let open Evar_kinds in function | Evar_kinds.NamedHole id -> strbrk "the existential variable named " ++ Id.print id | Evar_kinds.QuestionMark {qm_record_field=None} -> strbrk "this placeholder of type " ++ ty | Evar_kinds.QuestionMark {qm_record_field=Some {fieldname; recordname}} -> str "field " ++ (Printer.pr_constant env fieldname) ++ str " of record " ++ (Printer.pr_inductive env recordname) | Evar_kinds.CasesType false -> strbrk "the type of this pattern-matching problem" | Evar_kinds.CasesType true -> strbrk "a subterm of type " ++ ty ++ strbrk " in the type of this pattern-matching problem" | Evar_kinds.BinderType (Name id) -> strbrk "the type of " ++ Id.print id | Evar_kinds.BinderType Anonymous -> strbrk "the type of this anonymous binder" | Evar_kinds.EvarType (ido,evk) -> let pp = match ido with | Some id -> str "?" ++ Id.print id | None -> try pr_existential_key env sigma evk with (* defined *) Not_found -> strbrk "an internal placeholder" in strbrk "the type of " ++ pp | Evar_kinds.ImplicitArg (c,(n,ido),b) -> let id = Option.get ido in strbrk "the implicit parameter " ++ Id.print id ++ spc () ++ str "of" ++ spc () ++ Nametab.pr_global_env Id.Set.empty c ++ strbrk " whose type is " ++ ty | Evar_kinds.InternalHole -> strbrk "an internal placeholder of type " ++ ty | Evar_kinds.TomatchTypeParameter (tyi,n) -> strbrk "the " ++ pr_nth n ++ strbrk " argument of the inductive type (" ++ pr_inductive env tyi ++ strbrk ") of this term" | Evar_kinds.GoalEvar -> strbrk "an existential variable of type " ++ ty | Evar_kinds.ImpossibleCase -> strbrk "the type of an impossible pattern-matching clause" | Evar_kinds.MatchingVar _ -> assert false | Evar_kinds.VarInstance id -> strbrk "an instance of type " ++ ty ++ str " for the variable " ++ Id.print id | Evar_kinds.SubEvar (where,evk') -> let rec find_source evk = let EvarInfo evi = Evd.find sigma evk in match snd (Evd.evar_source evi) with | Evar_kinds.SubEvar (_,evk) -> find_source evk | src -> EvarInfo evi, src in let EvarInfo evi, src = find_source evk' in let pc = match Evd.evar_body evi with | Evar_defined c -> pr_leconstr_env env sigma c | Evar_empty -> assert false in let ty' = match Evd.evar_body evi with | Evar_empty -> Evd.evar_concl evi | Evar_defined b -> Retyping.get_type_of env sigma b in pr_existential_key env sigma evk ++ strbrk " in the partial instance " ++ pc ++ strbrk " found for " ++ explain_evar_kind env sigma evk (pr_leconstr_env env sigma ty') src let explain_typeclass_resolution env sigma evi k = match Typeclasses.class_of_constr env sigma (Evd.evar_concl evi) with | Some _ -> let env = Evd.evar_filtered_env env evi in str "Could not find an instance for " ++ pr_leconstr_env env sigma (Evd.evar_concl evi) ++ pr_trailing_ne_context_of env sigma | _ -> mt() let explain_placeholder_kind env sigma c e = match e with | Some (SeveralInstancesFound n) -> strbrk " (several distinct possible type class instances found)" | None -> match Typeclasses.class_of_constr env sigma c with | Some _ -> strbrk " (no type class instance found)" | _ -> mt () let explain_unsolvable_implicit env sigma evk explain = let evi = Evarutil.nf_evar_info sigma (Evd.find_undefined sigma evk) in let env = Evd.evar_filtered_env env evi in let type_of_hole = pr_leconstr_env env sigma (Evd.evar_concl evi) in let pe = pr_trailing_ne_context_of env sigma in strbrk "Cannot infer " ++ explain_evar_kind env sigma evk type_of_hole (snd (Evd.evar_source evi)) ++ explain_placeholder_kind env sigma (Evd.evar_concl evi) explain ++ pe let explain_var_not_found env id = str "The variable" ++ spc () ++ Id.print id ++ spc () ++ str "was not found" ++ spc () ++ str "in the current" ++ spc () ++ str "environment" ++ str "." let explain_evar_not_found env sigma id = let undef = Evar.Map.domain (Evd.undefined_map sigma) in let all_undef_evars = Evar.Set.elements undef in let f ev = Id.equal id (Termops.evar_suggested_name (Global.env ()) sigma ev) in if List.exists f all_undef_evars then (* The name is used for printing but is not user-given *) str "?" ++ Id.print id ++ strbrk " is a generated name. Only user-given names for existential variables" ++ strbrk " can be referenced. To give a user name to an existential variable," ++ strbrk " introduce it with the ?[name] syntax." else str "Unknown existential variable." let explain_wrong_case_info env (ind,u) ci = let pi = pr_inductive env ind in if QInd.equal env ci.ci_ind ind then str "Pattern-matching expression on an object of inductive type" ++ spc () ++ pi ++ spc () ++ str "has invalid information." else let pc = pr_inductive env ci.ci_ind in str "A term of inductive type" ++ spc () ++ pi ++ spc () ++ str "was given to a pattern-matching expression on the inductive type" ++ spc () ++ pc ++ str "." let explain_cannot_unify env sigma m n e = let env = make_all_name_different env sigma in let pm, pn = pr_explicit env sigma m n in let ppreason = explain_unification_error env sigma m n e in let pe = pr_ne_context_of (str "In environment") env sigma in pe ++ str "Unable to unify" ++ brk(1,1) ++ pm ++ spc () ++ str "with" ++ brk(1,1) ++ pn ++ ppreason ++ str "." let explain_cannot_unify_local env sigma m n subn = let pm = pr_leconstr_env env sigma m in let pn = pr_leconstr_env env sigma n in let psubn = pr_leconstr_env env sigma subn in str "Unable to unify" ++ brk(1,1) ++ pm ++ spc () ++ str "with" ++ brk(1,1) ++ pn ++ spc () ++ str "as" ++ brk(1,1) ++ psubn ++ str " contains local variables." let explain_refiner_cannot_generalize env sigma ty = str "Cannot find a well-typed generalisation of the goal with type: " ++ pr_leconstr_env env sigma ty ++ str "." let explain_no_occurrence_found env sigma c id = str "Found no subterm matching" ++ spc() ++ pr_leconstr_env env sigma c ++ spc() ++ str "in " ++ (match id with | Some id -> Id.print id | None -> str"the current goal") ++ str "." let explain_cannot_unify_binding_type env sigma m n = let pm = pr_leconstr_env env sigma m in let pn = pr_leconstr_env env sigma n in str "This binding has type" ++ brk(1,1) ++ pm ++ spc () ++ str "which should be unifiable with" ++ brk(1,1) ++ pn ++ str "." let explain_cannot_find_well_typed_abstraction env sigma p l e = str "Abstracting over the " ++ str (String.plural (List.length l) "term") ++ spc () ++ hov 0 (pr_enum (fun c -> pr_leconstr_env env sigma c) l) ++ spc () ++ str "leads to a term" ++ spc () ++ pr_letype_env ~goal_concl_style:true env sigma p ++ spc () ++ str "which is ill-typed." ++ (match e with None -> mt () | Some e -> fnl () ++ str "Reason is: " ++ e) let explain_wrong_abstraction_type env sigma na abs expected result = let ppname = match na with Name id -> Id.print id ++ spc () | _ -> mt () in str "Cannot instantiate metavariable " ++ ppname ++ strbrk "of type " ++ pr_leconstr_env env sigma expected ++ strbrk " with abstraction " ++ pr_leconstr_env env sigma abs ++ strbrk " of incompatible type " ++ pr_leconstr_env env sigma result ++ str "." let explain_abstraction_over_meta _ m n = strbrk "Too complex unification problem: cannot find a solution for both " ++ Name.print m ++ spc () ++ str "and " ++ Name.print n ++ str "." let explain_non_linear_unification env sigma m t = strbrk "Cannot unambiguously instantiate " ++ Name.print m ++ str ":" ++ strbrk " which would require to abstract twice on " ++ pr_leconstr_env env sigma t ++ str "." let explain_unsatisfied_constraints env sigma cst = strbrk "Unsatisfied constraints: " ++ Univ.Constraints.pr (Termops.pr_evd_level sigma) cst ++ spc () ++ str "(maybe a bugged tactic)." let explain_unsatisfied_qconstraints env sigma cst = strbrk "Unsatisfied quality constraints: " ++ Sorts.QConstraints.pr (Termops.pr_evd_qvar sigma) cst ++ spc() ++ str "(maybe a bugged tactic)." let explain_undeclared_universe env sigma l = strbrk "Undeclared universe: " ++ Termops.pr_evd_level sigma l ++ spc () ++ str "(maybe a bugged tactic)." let explain_undeclared_qualities env sigma l = let n = Sorts.QVar.Set.cardinal l in strbrk "Undeclared " ++ str (if n = 1 then "quality" else "qualities") ++ strbrk": " ++ prlist_with_sep spc (Termops.pr_evd_qvar sigma) (Sorts.QVar.Set.elements l) ++ spc () ++ str "(maybe a bugged tactic)." let explain_disallowed_sprop () = Pp.(strbrk "SProp is disallowed because the " ++ str "\"Allow StrictProp\"" ++ strbrk " flag is off.") let pr_relevance sigma r = let r = EConstr.ERelevance.kind sigma r in match r with | Sorts.Relevant -> str "relevant" | Sorts.Irrelevant -> str "irrelevant" | Sorts.RelevanceVar q -> str "a variable " ++ (* TODO names *) Sorts.QVar.raw_pr q let pr_binder env sigma = function | LocalAssum (na, t) -> Pp.hov 2 (str "(" ++ (Name.print @@ na.binder_name) ++ str " : " ++ pr_leconstr_env env sigma t ++ str ")") | LocalDef (na, b, t) -> Pp.hov 2 (str "(" ++ (Name.print @@ na.binder_name) ++ str " : " ++ pr_leconstr_env env sigma t ++ str " := " ++ pr_leconstr_env env sigma b ++ str ")") let explain_bad_binder_relevance env sigma rlv decl = strbrk "Binder" ++ spc () ++ pr_binder env sigma decl ++ strbrk " has relevance mark set to " ++ pr_relevance sigma (RelDecl.get_relevance decl) ++ strbrk " but was expected to be " ++ pr_relevance sigma rlv ++ spc () ++ str "(maybe a bugged tactic)." let explain_bad_case_relevance env sigma rlv case = let (_, _, _, (_,badr), _, _, _) = EConstr.destCase sigma case in strbrk "Pattern-matching" ++ spc () ++ pr_leconstr_env env sigma case ++ strbrk " has relevance mark set to " ++ pr_relevance sigma badr ++ strbrk " but was expected to be " ++ pr_relevance sigma rlv ++ spc () ++ str "(maybe a bugged tactic)." let explain_bad_relevance env sigma = function | Typeops.BadRelevanceCase (r,c) -> explain_bad_case_relevance env sigma r c | BadRelevanceBinder (r,d) -> explain_bad_binder_relevance env sigma r d let ecast_bad_relevance = let open Typeops in function | BadRelevanceCase (r,c) -> BadRelevanceCase (EConstr.ERelevance.make r, EConstr.of_constr c) | BadRelevanceBinder (r,d) -> BadRelevanceBinder (EConstr.ERelevance.make r, EConstr.of_rel_decl d) let () = CWarnings.register_printer Typeops.bad_relevance_msg (fun (env, b) -> let sigma = Evd.from_env env in explain_bad_relevance env sigma (ecast_bad_relevance b)) let () = CWarnings.register_printer Typing.bad_relevance_msg (fun (env, sigma, b) -> explain_bad_relevance env sigma b) let explain_bad_invert env = strbrk "Bad case inversion (maybe a bugged tactic)." let explain_bad_variance env sigma ~lev ~expected ~actual = str "Incorrect variance for universe " ++ Termops.pr_evd_level sigma lev ++ str": expected " ++ UVars.Variance.pr expected ++ str " but cannot be less restrictive than " ++ UVars.Variance.pr actual ++ str "." let explain_undeclared_used_variables env sigma ~declared_vars ~inferred_vars = let l = Id.Set.elements (Id.Set.diff inferred_vars declared_vars) in let n = List.length l in let declared_vars = Pp.pr_sequence Id.print (Id.Set.elements declared_vars) in let inferred_vars = Pp.pr_sequence Id.print (Id.Set.elements inferred_vars) in let missing_vars = Pp.pr_sequence Id.print (List.rev l) in Pp.(prlist str ["The following section "; (String.plural n "variable"); " "; (String.conjugate_verb_to_be n); " used but not declared:"] ++ fnl () ++ missing_vars ++ str "." ++ fnl () ++ fnl () ++ str "You can either update your proof to not depend on " ++ missing_vars ++ str ", or you can update your Proof line from" ++ fnl () ++ str "Proof using " ++ declared_vars ++ fnl () ++ str "to" ++ fnl () ++ str "Proof using " ++ inferred_vars) let explain_type_error env sigma err = let env = make_all_name_different env sigma in match err with | UnboundRel n -> explain_unbound_rel env sigma n | UnboundVar v -> explain_unbound_var env v | NotAType j -> explain_not_type env sigma j | BadAssumption c -> explain_bad_assumption env sigma c | ReferenceVariables (id,c) -> explain_reference_variables sigma id c | ElimArity (ind, c, okinds) -> explain_elim_arity env sigma ind (Some c) okinds | CaseNotInductive cj -> explain_case_not_inductive env sigma cj | CaseOnPrivateInd ind -> explain_case_on_private_ind env sigma ind | NumberBranches (cj, n) -> explain_number_branches env sigma cj n | IllFormedCaseParams -> explain_ill_formed_case_params env sigma | IllFormedBranch (c, i, actty, expty) -> explain_ill_formed_branch env sigma c i actty expty | Generalization (nvar, c) -> explain_generalization env sigma nvar c | ActualType (j, pt) -> explain_actual_type env sigma j pt None | IncorrectPrimitive (j, t) -> explain_incorrect_primitive env sigma j t | CantApplyBadType (t, rator, randl) -> explain_cant_apply_bad_type env sigma t rator randl | CantApplyNonFunctional (rator, randl) -> explain_cant_apply_not_functional env sigma rator randl | IllFormedRecBody (err, lna, i, fixenv, vdefj) -> explain_ill_formed_rec_body env sigma err lna i fixenv vdefj | IllTypedRecBody (i, lna, vdefj, vargs) -> explain_ill_typed_rec_body env sigma i lna vdefj vargs | WrongCaseInfo (ind,ci) -> explain_wrong_case_info env ind ci | UnsatisfiedConstraints cst -> explain_unsatisfied_constraints env sigma cst | UnsatisfiedQConstraints cst -> explain_unsatisfied_qconstraints env sigma cst | UndeclaredUniverse l -> explain_undeclared_universe env sigma l | UndeclaredQualities l -> explain_undeclared_qualities env sigma l | DisallowedSProp -> explain_disallowed_sprop () | BadBinderRelevance (rlv, decl) -> explain_bad_binder_relevance env sigma rlv decl | BadCaseRelevance (rlv, case) -> explain_bad_case_relevance env sigma rlv case | BadInvert -> explain_bad_invert env | BadVariance {lev;expected;actual} -> explain_bad_variance env sigma ~lev ~expected ~actual | UndeclaredUsedVariables {declared_vars;inferred_vars} -> explain_undeclared_used_variables env sigma ~declared_vars ~inferred_vars let pr_position (cl,pos) = let clpos = match cl with | None -> str " of the goal" | Some (id,Locus.InHyp) -> str " of hypothesis " ++ Id.print id | Some (id,Locus.InHypTypeOnly) -> str " of the type of hypothesis " ++ Id.print id | Some (id,Locus.InHypValueOnly) -> str " of the body of hypothesis " ++ Id.print id in int pos ++ clpos let explain_cannot_unify_occurrences env sigma nested ((cl2,pos2),t2) ((cl1,pos1),t1) = if nested then str "Found nested occurrences of the pattern at positions " ++ int pos1 ++ strbrk " and " ++ pr_position (cl2,pos2) ++ str "." else str "Found incompatible occurrences of the pattern" ++ str ":" ++ spc () ++ str "Matched term " ++ pr_leconstr_env env sigma t2 ++ strbrk " at position " ++ pr_position (cl2,pos2) ++ strbrk " is not compatible with matched term " ++ pr_leconstr_env env sigma t1 ++ strbrk " at position " ++ pr_position (cl1,pos1) ++ str "." let pr_constraints printenv msg env sigma evars cstrs = let (ev, evi) = Evar.Map.choose evars in if Evar.Map.for_all (fun ev' evi' -> eq_named_context_val (Evd.evar_hyps evi) (Evd.evar_hyps evi')) evars then let l = Evar.Map.bindings evars in let env' = Evd.evar_env env evi in let pe = if printenv then pr_ne_context_of (str "In environment:") env' sigma else mt () in let env = Global.env () in let evs = prlist_with_sep (fun () -> fnl () ++ fnl ()) (fun (ev, evi) -> hov 2 (pr_existential_key env sigma ev ++ str " :" ++ spc () ++ Printer.pr_leconstr_env env' sigma (Evd.evar_concl evi))) l in h (pe ++ str msg ++ fnl () ++ 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 let explain_unsatisfiable_constraints env sigma constr comp = let (_, constraints) = Evd.extract_all_conv_pbs sigma in let tcs = Evd.get_typeclass_evars sigma in let undef = Evd.undefined_map sigma in (* Only keep evars that are subject to resolution and members of the given component. *) let is_kept evk _ = Evar.Set.mem evk tcs && Evar.Set.mem evk comp in let undef = let m = Evar.Map.filter is_kept undef in if Evar.Map.is_empty m then undef else m in match constr with | None -> if List.is_empty constraints then let msg = "Could not find an instance for the following existential variables:" in pr_constraints true msg env sigma undef constraints else let msg = "Unable to satisfy the following constraints:" in pr_constraints true msg env sigma undef constraints | Some (ev, k) -> let cstr = let remaining = Evar.Map.remove ev undef in if not (Evar.Map.is_empty remaining) then let msg = "With the following constraints:" in pr_constraints false msg env sigma remaining constraints else mt () in let info = Evar.Map.find ev undef in explain_typeclass_resolution env sigma info k ++ fnl () ++ cstr 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 | CantFindCaseType c -> explain_cant_find_case_type env sigma c | ActualTypeNotCoercible (j,t,e) -> let {uj_val = c; uj_type = actty} = j in let (env, c, actty, expty), e = contract3' env sigma c actty t e in let j = {uj_val = c; uj_type = actty} in explain_actual_type env sigma j expty (Some e) | UnifOccurCheck (ev,rhs) -> explain_occur_check env sigma ev rhs | UnsolvableImplicit (evk,exp) -> explain_unsolvable_implicit env sigma evk exp | VarNotFound id -> explain_var_not_found env id | EvarNotFound id -> explain_evar_not_found env sigma id | UnexpectedType (actual,expect,e) -> let env, actual, expect = contract2 env sigma actual expect in explain_unexpected_type env sigma actual expect e | NotProduct c -> explain_not_product env sigma c | CannotUnify (m,n,e) -> let env, m, n = contract2 env sigma m n in explain_cannot_unify env sigma m n e | CannotUnifyLocal (m,n,sn) -> explain_cannot_unify_local env sigma m n sn | CannotGeneralize ty -> explain_refiner_cannot_generalize env sigma ty | NoOccurrenceFound (c, id) -> explain_no_occurrence_found env sigma c id | 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_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 | NonLinearUnification (m,c) -> explain_non_linear_unification env sigma m c | TypingError t -> explain_type_error env sigma t | CantApplyBadTypeExplained ((t, rator, randl),error) -> explain_cant_apply_bad_type env sigma ~error t rator randl | CannotUnifyOccurrences (b,c1,c2) -> explain_cannot_unify_occurrences env sigma b c1 c2 | UnsatisfiableConstraints (c,comp) -> explain_unsatisfiable_constraints env sigma c comp | DisallowedSProp -> explain_disallowed_sprop () (* Module errors *) let pr_modpath mp = Libnames.pr_qualid (Nametab.shortest_qualid_of_module mp) let pr_modtype_subpath upper mp = let rec aux mp = try let (dir,id) = Libnames.repr_qualid (Nametab.shortest_qualid_of_modtype mp) in Libnames.add_dirpath_suffix dir id, [] with Not_found -> match mp with | MPdot (mp',id) -> let mp, suff = aux mp' in mp, Label.to_id id::suff | _ -> assert false in let mp, suff = aux mp in (if suff = [] then mt () else str (if upper then "Module " else "module ") ++ DirPath.print (DirPath.make suff) ++ str " of ") ++ DirPath.print mp open Modops let explain_not_match_error = function | InductiveFieldExpected _ -> strbrk "an inductive definition is expected" | DefinitionFieldExpected -> strbrk "a definition is expected. Hint: you can rename the \ inductive or constructor and add a definition mapping the \ old name to the new name" | ModuleFieldExpected -> strbrk "a module is expected" | ModuleTypeFieldExpected -> strbrk "a module type is expected" | NotConvertibleInductiveField id | NotConvertibleConstructorField id -> str "types given to " ++ Id.print id ++ str " differ" | NotConvertibleBodyField -> str "the body of definitions differs" | NotConvertibleTypeField (env, typ1, typ2) -> str "expected type" ++ spc () ++ quote (Printer.safe_pr_lconstr_env env (Evd.from_env env) typ2) ++ spc () ++ str "but found type" ++ spc () ++ quote (Printer.safe_pr_lconstr_env env (Evd.from_env env) typ1) | NotSameConstructorNamesField -> str "constructor names differ" | NotSameInductiveNameInBlockField -> str "inductive types names differ" | FiniteInductiveFieldExpected isfinite -> str "type is expected to be " ++ str (if isfinite then "coinductive" else "inductive") | InductiveNumbersFieldExpected n -> str "number of inductive types differs" | InductiveParamsNumberField n -> str "inductive type has not the right number of parameters" | RecordFieldExpected isrecord -> str "type is expected " ++ str (if isrecord then "" else "not ") ++ str "to be a record" | RecordProjectionsExpected nal -> (if List.length nal >= 2 then str "expected projection names are " else str "expected projection name is ") ++ pr_enum (function Name id -> Id.print id | _ -> str "_") nal | NotEqualInductiveAliases -> str "Aliases to inductive types do not match" | CumulativeStatusExpected b -> let status b = if b then str"cumulative" else str"non-cumulative" in str "a " ++ status b ++ str" declaration was expected, but a " ++ status (not b) ++ str" declaration was found" | PolymorphicStatusExpected b -> let status b = if b then str"polymorphic" else str"monomorphic" in str "a " ++ status b ++ str" declaration was expected, but a " ++ status (not b) ++ str" declaration was found" | IncompatibleUniverses incon -> str"the universe constraints are inconsistent: " ++ UGraph.explain_universe_inconsistency Sorts.QVar.raw_pr UnivNames.pr_level_with_global_universes incon | IncompatiblePolymorphism (env, t1, t2) -> str "conversion of polymorphic values generates additional constraints: " ++ quote (Printer.safe_pr_lconstr_env env (Evd.from_env env) t1) ++ spc () ++ str "compared to " ++ spc () ++ quote (Printer.safe_pr_lconstr_env env (Evd.from_env env) t2) | IncompatibleConstraints { got; expect } -> let open UVars in let pr_auctx auctx = let sigma = Evd.from_ctx (UState.of_names (Printer.universe_binders_with_opt_names auctx None)) in let uctx = AbstractContext.repr auctx in Printer.pr_universe_instance_constraints sigma (UContext.instance uctx) (UContext.constraints uctx) in str "incompatible polymorphic binders: got" ++ spc () ++ h (pr_auctx got) ++ spc() ++ str "but expected" ++ spc() ++ h (pr_auctx expect) ++ (if not (UVars.eq_sizes (AbstractContext.size got) (AbstractContext.size expect)) then mt() else fnl() ++ str "(incompatible constraints)") | IncompatibleVariance -> str "incompatible variance information" | NoRewriteRulesSubtyping -> strbrk "subtyping for rewrite rule blocks is not supported" let rec get_submodules acc = function | [] -> acc, [] | Submodule l :: trace -> get_submodules (l::acc) trace | (FunctorArgument _ :: _) as trace -> acc, trace let get_submodules trace = let submodules, trace = get_submodules [] trace in (String.concat "." (List.map Label.to_string submodules)), trace let rec print_trace = function | [] -> assert false | (Submodule _ :: _) as trace -> let submodules, trace = get_submodules trace in str submodules ++ (if List.is_empty trace then mt() else spc() ++ str "in " ++ print_trace trace) | FunctorArgument n :: trace -> str "the " ++ str (CString.ordinal n) ++ str " functor argument" ++ (if List.is_empty trace then mt() else spc() ++ str "of " ++ print_trace trace) let explain_signature_mismatch trace l why = let submodules, trace = get_submodules trace in let l = if String.is_empty submodules then Label.print l else str submodules ++ str"." ++ Label.print l in str "Signature components for field " ++ l ++ (if List.is_empty trace then mt() else str " in " ++ print_trace trace) ++ str " do not match:" ++ spc () ++ explain_not_match_error why ++ str "." let explain_label_already_declared l = str "The label " ++ Label.print l ++ str " is already declared." let explain_not_a_functor () = str "Application of a non-functor." let explain_is_a_functor mp = pr_modtype_subpath true mp ++ str " not expected to be a functor." let explain_incompatible_module_types mexpr1 mexpr2 = let open Declarations in let rec get_arg = function | NoFunctor _ -> 0 | MoreFunctor (_, _, ty) -> succ (get_arg ty) in let len1 = get_arg mexpr1.mod_type in let len2 = get_arg mexpr2.mod_type in if len1 <> len2 then str "Incompatible module types: module expects " ++ int len2 ++ str " arguments, found " ++ int len1 ++ str "." else str "Incompatible module types." let explain_not_equal_module_paths mp1 mp2 = str "Module " ++ pr_modpath mp1 ++ strbrk " is not equal to " ++ pr_modpath mp2 ++ str "." let explain_no_such_label l mp = str "No field named " ++ Label.print l ++ str " in " ++ pr_modtype_subpath false mp ++ str "." let explain_not_a_module_label l = Label.print l ++ str " is not the name of a module field." let explain_not_a_constant l = quote (Label.print l) ++ str " is not a constant." let explain_incorrect_label_constraint l = str "Incorrect constraint for label " ++ quote (Label.print l) ++ str "." let explain_generative_module_expected l = str "The module " ++ Label.print l ++ str " is not generative." ++ strbrk " Only components of generative modules can be changed" ++ strbrk " using the \"with\" construct." let explain_label_missing l s = str "The field " ++ Label.print l ++ str " is missing in " ++ str s ++ str "." let explain_include_restricted_functor mp = str "Cannot include the functor " ++ pr_modpath mp ++ strbrk " since it has a restricted signature. " ++ strbrk "You may name first an instance of this functor, and include it." let explain_module_error = function | SignatureMismatch (trace,l,err) -> explain_signature_mismatch trace l err | LabelAlreadyDeclared l -> explain_label_already_declared l | NotAFunctor -> explain_not_a_functor () | IsAFunctor mp -> explain_is_a_functor mp | IncompatibleModuleTypes (m1,m2) -> explain_incompatible_module_types m1 m2 | NotEqualModulePaths (mp1,mp2) -> explain_not_equal_module_paths mp1 mp2 | NoSuchLabel (l,mp) -> explain_no_such_label l mp | NotAModuleLabel l -> explain_not_a_module_label l | NotAConstant l -> explain_not_a_constant l | IncorrectWithConstraint l -> explain_incorrect_label_constraint l | GenerativeModuleExpected l -> explain_generative_module_expected l | LabelMissing (l,s) -> explain_label_missing l s | IncludeRestrictedFunctor mp -> explain_include_restricted_functor mp (* Module internalization errors *) (* let explain_declaration_not_path _ = str "Declaration is not a path." *) let explain_not_module_nor_modtype qid = Libnames.pr_qualid qid ++ str " is not a module or module type." let explain_not_a_module qid = Libnames.pr_qualid qid ++ str " is not a module." let explain_not_a_module_type qid = Libnames.pr_qualid qid ++ str " is not a module type." let explain_incorrect_with_in_module () = str "The syntax \"with\" is not allowed for modules." let explain_incorrect_module_application () = str "Illegal application to a module type." let explain_module_internalization_error = let open Modintern in function | NotAModuleNorModtype qid -> explain_not_module_nor_modtype qid | NotAModule qid -> explain_not_a_module qid | NotAModuleType qid -> explain_not_a_module_type qid | IncorrectWithInModule -> explain_incorrect_with_in_module () | IncorrectModuleApplication -> explain_incorrect_module_application () (* Typeclass errors *) let explain_not_a_class env sigma c = pr_econstr_env env sigma c ++ str" is not a declared type class." let explain_unbound_method env sigma cid { CAst.v = id } = str "Unbound method name " ++ Id.print (id) ++ spc () ++ str"of class" ++ spc () ++ pr_global cid ++ str "." let explain_typeclass_error env sigma = function | NotAClass c -> explain_not_a_class env sigma c | UnboundMethod (cid, id) -> explain_unbound_method env sigma cid id (* Refiner errors *) let explain_refiner_unresolved_bindings l = str "Unable to find an instance for the " ++ str (String.plural (List.length l) "variable") ++ spc () ++ prlist_with_sep pr_comma Name.print l ++ str"." let explain_refiner_cannot_apply env sigma t harg = str "In refiner, a term of type" ++ brk(1,1) ++ pr_leconstr_env env sigma t ++ spc () ++ str "could not be applied to" ++ brk(1,1) ++ pr_leconstr_env env sigma harg ++ str "." let explain_intro_needs_product () = str "Introduction tactics needs products." let explain_non_linear_proof env sigma c = str "Cannot refine with term" ++ brk(1,1) ++ pr_leconstr_env env sigma c ++ spc () ++ str "because a metavariable has several occurrences." let explain_no_such_hyp id = str "No such hypothesis: " ++ Id.print id let explain_refiner_error env sigma = function | UnresolvedBindings t -> explain_refiner_unresolved_bindings t | CannotApply (t,harg) -> explain_refiner_cannot_apply env sigma t harg | IntroNeedsProduct -> explain_intro_needs_product () | NonLinearProof c -> explain_non_linear_proof env sigma c | NoSuchHyp id -> explain_no_such_hyp id (* Inductive errors *) let error_non_strictly_positive env c v = let pc = pr_lconstr_env env (Evd.from_env env) c in let pv = pr_lconstr_env env (Evd.from_env env) v in str "Non strictly positive occurrence of " ++ pv ++ str " in" ++ brk(1,1) ++ pc ++ str "." let error_ill_formed_inductive env c v = let pc = pr_lconstr_env env (Evd.from_env env) c in let pv = pr_lconstr_env env (Evd.from_env env) v in str "Not enough arguments applied to the " ++ pv ++ str " in" ++ brk(1,1) ++ pc ++ str "." let error_ill_formed_constructor env id c v nparams nargs = let pv = pr_lconstr_env env (Evd.from_env env) v in let atomic = Int.equal (nb_prod Evd.empty (EConstr.of_constr c)) (* FIXME *) 0 in str "The type of constructor" ++ brk(1,1) ++ Id.print id ++ brk(1,1) ++ str "is not valid;" ++ brk(1,1) ++ strbrk (if atomic then "it must be " else "its conclusion must be ") ++ pv ++ (* warning: because of implicit arguments it is difficult to say which parameters must be explicitly given *) (if not (Int.equal nparams 0) then strbrk " applied to its " ++ str (String.plural nparams "parameter") else mt()) ++ (if not (Int.equal nargs 0) then str (if not (Int.equal nparams 0) then " and" else " applied") ++ strbrk " to some " ++ str (String.plural nargs "argument") else mt()) ++ str "." let pr_ltype_using_barendregt_convention_env env c = (* Use goal_concl_style as an approximation of Barendregt's convention (?) *) quote (pr_ltype_env ~goal_concl_style:true env (Evd.from_env env) c) let error_bad_ind_parameters env c n v1 v2 = let pc = pr_ltype_using_barendregt_convention_env env c in let pv1 = pr_lconstr_env env (Evd.from_env env) v1 in let pv2 = pr_lconstr_env env (Evd.from_env env) v2 in str "Last occurrence of " ++ pv2 ++ str " must have " ++ pv1 ++ str " as " ++ pr_nth n ++ str " argument in" ++ brk(1,1) ++ pc ++ str "." let error_same_names_types id = str "The name" ++ spc () ++ Id.print id ++ spc () ++ str "is used more than once." let error_same_names_constructors id = str "The constructor name" ++ spc () ++ Id.print id ++ spc () ++ str "is used more than once." let error_same_names_overlap idl = strbrk "The following names are used both as type names and constructor " ++ str "names:" ++ spc () ++ prlist_with_sep pr_comma Id.print idl ++ str "." let error_not_an_arity env c = str "The type" ++ spc () ++ pr_lconstr_env env (Evd.from_env env) c ++ spc () ++ str "is not an arity." let error_bad_entry () = str "Bad inductive definition." let error_large_non_prop_inductive_not_in_type () = str "Large non-propositional inductive types must be in Type." let error_inductive_missing_constraints (us,ind_univ) = str "Missing universe constraint declared for inductive type:" ++ spc() ++ v 0 (prlist_with_sep spc (fun u -> hov 0 (Printer.pr_sort Evd.empty u ++ str " <= " ++ Printer.pr_sort Evd.empty ind_univ)) us) (* Recursion schemes errors *) let error_not_allowed_dependent_analysis env isrec i = str "Dependent " ++ str (if isrec then "induction" else "case analysis") ++ strbrk " is not allowed for inductive definition " ++ pr_inductive env i ++ str "." let error_not_mutual_in_scheme env ind ind' = if QInd.equal env ind ind' then str "The inductive type " ++ pr_inductive env ind ++ str " occurs twice." else str "The inductive types " ++ pr_inductive env ind ++ spc () ++ str "and" ++ spc () ++ pr_inductive env ind' ++ spc () ++ str "are not mutually defined." (* Inductive constructions errors *) let explain_inductive_error = function | NonPos (env,c,v) -> error_non_strictly_positive env c v | NotEnoughArgs (env,c,v) -> error_ill_formed_inductive env c v | NotConstructor (env,id,c,v,n,m) -> error_ill_formed_constructor env id c v n m | NonPar (env,c,n,v1,v2) -> error_bad_ind_parameters env c n v1 v2 | SameNamesTypes id -> error_same_names_types id | SameNamesConstructors id -> error_same_names_constructors id | SameNamesOverlap idl -> error_same_names_overlap idl | NotAnArity (env, c) -> error_not_an_arity env c | BadEntry -> error_bad_entry () | LargeNonPropInductiveNotInType -> error_large_non_prop_inductive_not_in_type () | MissingConstraints csts -> error_inductive_missing_constraints csts (* Primitive errors *) let explain_incompatible_prim_declarations (type a) (act:a Primred.action_kind) (x:a) (y:a) = let open Primred in let env = Global.env() in (* The newer constant/inductive (either coming from Primitive or a Require) may be absent from the nametab as the error got raised while adding it to the safe_env. In that case we can't use nametab printing. There are still cases where the constant/inductive is added separately from its retroknowledge (using Register), so we still try nametab based printing. *) match act with | IncompatTypes typ -> let px = try pr_constant env x with Not_found -> Constant.print x in str "Cannot declare " ++ px ++ str " as primitive " ++ str (CPrimitives.prim_type_to_string typ) ++ str ": " ++ pr_constant env y ++ str " is already declared." | IncompatInd ind -> let px = try pr_inductive env x with Not_found -> MutInd.print (fst x) in str "Cannot declare " ++ px ++ str " as primitive " ++ str (CPrimitives.prim_ind_to_string ind) ++ str ": " ++ pr_inductive env y ++ str " is already declared." (* Recursion schemes errors *) let explain_recursion_scheme_error env = function | NotAllowedCaseAnalysis (isrec,k,i) -> explain_elim_arity env (Evd.from_env env) i None (Some k) (* error_not_allowed_case_analysis env isrec k i *) | NotMutualInScheme (ind,ind')-> error_not_mutual_in_scheme env ind ind' | NotAllowedDependentAnalysis (isrec, i) -> error_not_allowed_dependent_analysis env isrec i (* Pattern-matching errors *) let explain_bad_pattern env sigma cstr ty = let env = make_all_name_different env sigma in let pt = pr_leconstr_env env sigma ty in let pc = pr_constructor env cstr in str "Found the constructor " ++ pc ++ brk(1,1) ++ str "while matching a term of type " ++ pt ++ brk(1,1) ++ str "which is not an inductive type." let explain_bad_constructor env cstr ind = let pi = pr_inductive env ind in (* let pc = pr_constructor env cstr in*) let pt = pr_inductive env (inductive_of_constructor cstr) in str "Found a constructor of inductive type " ++ pt ++ brk(1,1) ++ str "while a constructor of " ++ pi ++ brk(1,1) ++ str "is expected." let decline_string n s = if Int.equal n 0 then str "no " ++ str s ++ str "s" else if Int.equal n 1 then str "1 " ++ str s else (int n ++ str " " ++ str s ++ str "s") let explain_wrong_numarg_pattern expanded nargs expected_nassums expected_ndecls pp = (if expanded then strbrk "Once notations are expanded, the resulting " else strbrk "The ") ++ pp ++ strbrk " is expected to be applied to " ++ decline_string expected_nassums "argument" ++ (if expected_nassums = expected_ndecls then mt () else strbrk " (or " ++ decline_string expected_ndecls "argument" ++ strbrk " when including variables for local definitions)") ++ strbrk " while it is actually applied to " ++ decline_string nargs "argument" ++ str "." let explain_wrong_numarg_constructor env cstr expanded nargs expected_nassums expected_ndecls = let pp = strbrk "constructor " ++ pr_constructor env cstr ++ strbrk " (in type " ++ pr_inductive env (inductive_of_constructor cstr) ++ strbrk ")" in explain_wrong_numarg_pattern expanded nargs expected_nassums expected_ndecls pp let explain_wrong_numarg_inductive env ind expanded nargs expected_nassums expected_ndecls = let pp = strbrk "inductive type " ++ pr_inductive env ind in explain_wrong_numarg_pattern expanded nargs expected_nassums expected_ndecls pp let explain_unused_clause env pats = str "Pattern \"" ++ hov 0 (prlist_with_sep pr_comma pr_cases_pattern pats) ++ strbrk "\" is redundant in this clause." let explain_non_exhaustive env pats = str "Non exhaustive pattern-matching: no clause found for " ++ str (String.plural (List.length pats) "pattern") ++ spc () ++ hov 0 (prlist_with_sep pr_comma pr_cases_pattern pats) let explain_cannot_infer_predicate env sigma typs = let typs = Array.to_list typs in let env = make_all_name_different env sigma in let pr_branch (cstr,typ) = let cstr,_ = EConstr.decompose_app sigma cstr in str "For " ++ pr_leconstr_env env sigma cstr ++ str ": " ++ pr_leconstr_env env sigma typ in str "Unable to unify the types found in the branches:" ++ spc () ++ hov 0 (prlist_with_sep fnl pr_branch typs) let explain_pattern_matching_error env sigma = function | BadPattern (c,t) -> explain_bad_pattern env sigma c t | BadConstructor (c,ind) -> explain_bad_constructor env c ind | WrongNumargConstructor {cstr; expanded; nargs; expected_nassums; expected_ndecls} -> explain_wrong_numarg_constructor env cstr expanded nargs expected_nassums expected_ndecls | WrongNumargInductive {ind; expanded; nargs; expected_nassums; expected_ndecls} -> explain_wrong_numarg_inductive env ind expanded nargs expected_nassums expected_ndecls | UnusedClause tms -> explain_unused_clause env tms | NonExhaustive tms -> explain_non_exhaustive env tms | CannotInferPredicate typs -> explain_cannot_infer_predicate env sigma typs let explain_reduction_tactic_error = function | Tacred.InvalidAbstraction (env,sigma,c,(env',e)) -> let e = of_type_error e in str "The abstracted term" ++ spc () ++ quote (pr_letype_env ~goal_concl_style:true env sigma c) ++ spc () ++ str "is not well typed." ++ fnl () ++ explain_type_error env' (Evd.from_env env') e let explain_prim_token_notation_error kind env sigma = function | Notation.UnexpectedTerm c -> (strbrk "Unexpected term " ++ pr_constr_env env sigma c ++ strbrk (" while parsing a "^kind^" notation.")) | Notation.UnexpectedNonOptionTerm c -> (strbrk "Unexpected non-option term " ++ pr_constr_env env sigma c ++ strbrk (" while parsing a "^kind^" notation.")) (* Rewrite rules errors *) let error_not_allowed_rewrite_rules symb_or_rule = str (match symb_or_rule with Rule -> "Rewrite rule" | Symb -> "Symbol") ++ spc () ++ strbrk "declaration requires passing the flag " ++ strbrk "\"-allow-rewrite-rules\"." (** Registration of generic errors Nota: explain_exn does NOT end with a newline anymore! *) exception Unhandled let wrap_unhandled f e = try Some (f e) with Unhandled -> None let explain_exn_default = function (* Basic interaction exceptions *) | Gramlib.Grammar.Error txt -> hov 0 (str "Syntax error: " ++ str txt ++ str ".") | CLexer.Error.E err -> hov 0 (str (CLexer.Error.to_string err)) | Sys_error msg -> hov 0 (str "System error: " ++ quote (str msg)) | Out_of_memory -> hov 0 (str "Out of memory.") | Stack_overflow -> hov 0 (str "Stack overflow.") | CErrors.Timeout -> hov 0 (str "Timeout!") | Sys.Break -> hov 0 (str "User interrupt.") (* Otherwise, not handled here *) | _ -> raise Unhandled let _ = CErrors.register_handler (wrap_unhandled explain_exn_default) let rec vernac_interp_error_handler = function | UGraph.UniverseInconsistency i -> str "Universe inconsistency." ++ spc() ++ UGraph.explain_universe_inconsistency Sorts.QVar.raw_pr UnivNames.pr_level_with_global_universes i ++ str "." | TypeError(env,te) -> let te = of_type_error te in explain_type_error env (Evd.from_env env) te | PretypeError(ctx,sigma,te) -> explain_pretype_error ctx sigma te | Notation.PrimTokenNotationError(kind,ctx,sigma,te) -> explain_prim_token_notation_error kind ctx sigma te | Typeclasses_errors.TypeClassError(env, sigma, te) -> explain_typeclass_error env sigma te | InductiveError e -> explain_inductive_error e | Primred.IncompatibleDeclarations (act,x,y) -> explain_incompatible_prim_declarations act x y | Modops.ModuleTypingError e -> explain_module_error e | Modintern.ModuleInternalizationError e -> explain_module_internalization_error e | RecursionSchemeError (env,e) -> explain_recursion_scheme_error env e | Cases.PatternMatchingError (env,sigma,e) -> explain_pattern_matching_error env sigma e | Tacred.ReductionTacticError e -> explain_reduction_tactic_error e | Logic.RefinerError (env, sigma, e) -> explain_refiner_error env sigma e | Nametab.GlobalizationError q -> str "The reference" ++ spc () ++ Libnames.pr_qualid q ++ spc () ++ str "was not found" ++ spc () ++ str "in the current" ++ spc () ++ str "environment." | Tacticals.FailError (i,s) -> let s = Lazy.force s in str "Tactic failure" ++ (if Pp.ismt s then s else str ": " ++ s) ++ if Int.equal i 0 then str "." else str " (level " ++ int i ++ str")." | Logic_monad.TacticFailure e -> vernac_interp_error_handler e | Environ.RewriteRulesNotAllowed symb_or_rule -> error_not_allowed_rewrite_rules symb_or_rule | _ -> raise Unhandled let _ = CErrors.register_handler (wrap_unhandled vernac_interp_error_handler) (* Locating errors *) let explain_notation_not_reference = function | Notation.AmbiguousNotationAsReference _ -> str "Ambiguous notation." | Notation.NotationNotReference (env,sigma,ntn,ntns) -> match ntns with | [] -> str "Unable to interpret " ++ quote (str ntn) ++ str " as a reference." | ntns -> let f (df, r) = str "Notation" ++ brk (1,2) ++ Notation_ops.pr_notation_info (Printer.pr_notation_interpretation_env env sigma) df r in str "Unable to unambiguously interpret " ++ quote (str ntn) ++ str " as a reference. Found:" ++ fnl () ++ v 0 (hov 0 (prlist_with_sep spc f ntns)) let _ = CErrors.register_handler (function | Notation.NotationAsReferenceError e -> Some (explain_notation_not_reference e) | _ -> None) coq-8.20.0/vernac/himsg.mli000066400000000000000000000020221466560755400154710ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* Evd.evar_map -> Pretype_errors.type_error -> Pp.t val explain_pretype_error : Environ.env -> Evd.evar_map -> Pretype_errors.pretype_error -> Pp.t val explain_refiner_error : Environ.env -> Evd.evar_map -> Logic.refiner_error -> Pp.t coq-8.20.0/vernac/indschemes.ml000066400000000000000000000531631466560755400163470ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* !elim_flag) ; optwrite = (fun b -> elim_flag := b) } let bifinite_elim_flag = ref false let () = declare_bool_option { optstage = Summary.Stage.Interp; optdepr = None; optkey = ["Nonrecursive";"Elimination";"Schemes"]; optread = (fun () -> !bifinite_elim_flag) ; optwrite = (fun b -> bifinite_elim_flag := b) } let case_flag = ref false let () = declare_bool_option { optstage = Summary.Stage.Interp; optdepr = None; optkey = ["Case";"Analysis";"Schemes"]; optread = (fun () -> !case_flag) ; optwrite = (fun b -> case_flag := b) } let eq_flag = ref false let () = declare_bool_option { optstage = Summary.Stage.Interp; optdepr = None; optkey = ["Boolean";"Equality";"Schemes"]; optread = (fun () -> !eq_flag) ; optwrite = (fun b -> eq_flag := b) } let is_eq_flag () = !eq_flag let eq_dec_flag = ref false let () = declare_bool_option { optstage = Summary.Stage.Interp; optdepr = None; optkey = ["Decidable";"Equality";"Schemes"]; optread = (fun () -> !eq_dec_flag) ; optwrite = (fun b -> eq_dec_flag := b) } let rewriting_flag = ref false let () = declare_bool_option { optstage = Summary.Stage.Interp; optdepr = None; optkey = ["Rewriting";"Schemes"]; optread = (fun () -> !rewriting_flag) ; optwrite = (fun b -> rewriting_flag := b) } (* Util *) let define ~poly name sigma c types = let univs = Evd.univ_entry ~poly sigma in let entry = Declare.definition_entry ~univs ?types c in let kind = Decls.(IsDefinition Scheme) in let kn = Declare.declare_constant ~kind ~name (Declare.DefinitionEntry entry) in Declare.definition_message name; kn (* Boolean equality *) let declare_beq_scheme_gen ?locmap names kn = ignore (define_mutual_scheme ?locmap beq_scheme_kind names kn) let debug = CDebug.create ~name:"indschemes" () let alarm what internal msg = match internal with | UserAutomaticRequest -> debug Pp.(fun () -> hov 0 msg ++ fnl () ++ what ++ str " not defined."); None | UserIndividualRequest -> Some msg let try_declare_scheme ?locmap what f internal names kn = try f ?locmap names kn with e -> let e = Exninfo.capture e in let rec extract_exn = function Logic_monad.TacticFailure e -> extract_exn e | e -> e in let msg = match extract_exn (fst e) with | ParameterWithoutEquality cst -> alarm what internal (str "Boolean equality not found for parameter " ++ Printer.pr_global cst ++ str".") | InductiveWithProduct -> alarm what internal (str "Unable to decide equality of functional arguments.") | InductiveWithSort -> alarm what internal (str "Unable to decide equality of type arguments.") | NonSingletonProp ind -> alarm what internal (str "Cannot extract computational content from proposition " ++ quote (Printer.pr_inductive (Global.env()) ind) ++ str ".") | EqNotFound ind' -> alarm what internal (str "Boolean equality on " ++ quote (Printer.pr_inductive (Global.env()) ind') ++ strbrk " is missing.") | UndefinedCst s -> alarm what internal (strbrk "Required constant " ++ str s ++ str " undefined.") | DeclareUniv.AlreadyDeclared (kind, id) as exn -> let msg = CErrors.print exn in alarm what internal msg | DecidabilityMutualNotSupported -> alarm what internal (str "Decidability lemma for mutual inductive types not supported.") | EqUnknown s -> alarm what internal (str "Found unsupported " ++ str s ++ str " while building Boolean equality.") | NoDecidabilityCoInductive -> alarm what internal (str "Scheme Equality is only for inductive types.") | DecidabilityIndicesNotSupported -> alarm what internal (str "Inductive types with indices not supported.") | ConstructorWithNonParametricInductiveType ind -> alarm what internal (strbrk "Unsupported constructor with an argument whose type is a non-parametric inductive type." ++ strbrk " Type " ++ quote (Printer.pr_inductive (Global.env()) ind) ++ str " is applied to an argument which is not a variable.") | InternalDependencies -> alarm what internal (strbrk "Inductive types with internal dependencies in constructors not supported.") | e when CErrors.noncritical e -> alarm what internal (str "Unexpected error during scheme creation: " ++ CErrors.print e) | _ -> Exninfo.iraise e in match msg with | None -> () | Some msg -> Exninfo.iraise (CErrors.UserError msg, snd e) let beq_scheme_msg mind = let mib = Global.lookup_mind mind in (* TODO: mutual inductive case *) str "Boolean equality on " ++ pr_enum (fun ind -> quote (Printer.pr_inductive (Global.env()) ind)) (List.init (Array.length mib.mind_packets) (fun i -> (mind,i))) let declare_beq_scheme_with ?locmap l kn = try_declare_scheme (beq_scheme_msg kn) declare_beq_scheme_gen UserIndividualRequest l kn let try_declare_beq_scheme ?locmap kn = (* TODO: handle Fix, eventually handle proof-irrelevance; improve decidability by depending on decidability for the parameters rather than on the bl and lb properties *) try_declare_scheme (beq_scheme_msg kn) declare_beq_scheme_gen UserAutomaticRequest [] kn let declare_beq_scheme ?locmap mi = declare_beq_scheme_with ?locmap [] mi (* Case analysis schemes *) let declare_one_case_analysis_scheme ?loc ind = let (mib, mip) as specif = Global.lookup_inductive ind in let kind = Indrec.pseudo_sort_family_for_elim ind mip in let dep, suff = if kind == InProp then case_nodep, Some "case" else if not (Inductiveops.has_dependent_elim specif) then case_nodep, None else case_dep, Some "case" in let id = match suff with | None -> None | Some suff -> (* the auto generated eliminator may be called "case" instead of eg "case_nodep" *) Some Names.(Id.of_string (Id.to_string mip.mind_typename ^ "_" ^ suff)) in let kelim = Inductiveops.elim_sort (mib,mip) in (* in case the inductive has a type elimination, generates only one induction scheme, the other ones share the same code with the appropriate type *) if Sorts.family_leq InType kelim then define_individual_scheme ?loc dep id ind (* Induction/recursion schemes *) let declare_one_induction_scheme ?loc ind = let (mib,mip) as specif = Global.lookup_inductive ind in let kind = Indrec.pseudo_sort_family_for_elim ind mip in let from_prop = kind == InProp in let depelim = Inductiveops.has_dependent_elim specif in let kelim = Inductiveops.sorts_below (Inductiveops.elim_sort (mib,mip)) in let kelim = if Global.sprop_allowed () then kelim else List.filter (fun s -> s <> InSProp) kelim in let elims = List.filter (fun (sort,_) -> List.mem_f Sorts.family_equal sort kelim) (* NB: the order is important, it makes it so that _rec is defined using _rect but _ind is not. *) [(InType, "rect"); (InProp, "ind"); (InSet, "rec"); (InSProp, "sind")] in let elims = List.map (fun (to_kind,dflt_suff) -> if from_prop then elim_scheme ~dep:false ~to_kind, Some dflt_suff else if depelim then elim_scheme ~dep:true ~to_kind, Some dflt_suff else elim_scheme ~dep:false ~to_kind, None) elims in List.iter (fun (kind, suff) -> let id = match suff with | None -> None | Some suff -> (* the auto generated eliminator may be called "rect" instead of eg "rect_dep" *) Some Names.(Id.of_string (Id.to_string mip.mind_typename ^ "_" ^ suff)) in define_individual_scheme ?loc kind id ind) elims let declare_induction_schemes ?(locmap=Locmap.default None) kn = let mib = Global.lookup_mind kn in if mib.mind_finite <> Declarations.CoFinite then begin for i = 0 to Array.length mib.mind_packets - 1 do let loc = Ind_tables.Locmap.lookup ~locmap (kn,i) in declare_one_induction_scheme (kn,i) ?loc; done; end (* Decidable equality *) let declare_eq_decidability_gen ?locmap names kn = let mib = Global.lookup_mind kn in if mib.mind_finite <> Declarations.CoFinite then define_mutual_scheme ?locmap eq_dec_scheme_kind names kn let eq_dec_scheme_msg ind = (* TODO: mutual inductive case *) str "Decidable equality on " ++ quote (Printer.pr_inductive (Global.env()) ind) let declare_eq_decidability_scheme_with ?locmap l kn = try_declare_scheme ?locmap (eq_dec_scheme_msg (kn,0)) declare_eq_decidability_gen UserIndividualRequest l kn let try_declare_eq_decidability ?locmap kn = try_declare_scheme ?locmap (eq_dec_scheme_msg (kn,0)) declare_eq_decidability_gen UserAutomaticRequest [] kn let declare_eq_decidability ?locmap mi = declare_eq_decidability_scheme_with ?locmap [] mi let ignore_error f x = try f x with e when CErrors.noncritical e -> () let declare_rewriting_schemes ?loc ind = if Hipattern.is_inductive_equality (Global.env ()) ind then begin define_individual_scheme ?loc rew_r2l_scheme_kind None ind; define_individual_scheme ?loc rew_r2l_dep_scheme_kind None ind; define_individual_scheme ?loc rew_r2l_forward_dep_scheme_kind None ind; (* These ones expect the equality to be symmetric; the first one also *) (* needs eq *) ignore_error (define_individual_scheme rew_l2r_scheme_kind None) ind; ignore_error (define_individual_scheme ?loc sym_involutive_scheme_kind None) ind; ignore_error (define_individual_scheme ?loc rew_l2r_dep_scheme_kind None) ind; ignore_error (define_individual_scheme ?loc rew_l2r_forward_dep_scheme_kind None) ind end let warn_cannot_build_congruence = CWarnings.create ~name:"cannot-build-congruence" ~category:CWarnings.CoreCategories.automation (fun () -> strbrk "Cannot build congruence scheme because eq is not found") let declare_congr_scheme ?loc ind = let env = Global.env () in if Hipattern.is_inductive_equality env ind then begin if try Coqlib.check_required_library Coqlib.logic_module_name; true with e when CErrors.noncritical e -> false then define_individual_scheme ?loc congr_scheme_kind None ind else warn_cannot_build_congruence () end let declare_sym_scheme ?loc ind = if Hipattern.is_inductive_equality (Global.env ()) ind then (* Expect the equality to be symmetric *) ignore_error (define_individual_scheme ?loc sym_scheme_kind None) ind (* Scheme command *) (* Boolean on scheme_type cheking if it considered dependent *) let sch_isdep = function | SchemeInduction | SchemeElimination -> true | SchemeMinimality | SchemeCase -> false let sch_isrec = function | SchemeInduction | SchemeMinimality -> true | SchemeElimination | SchemeCase -> false (* Generate suffix for scheme given a target sort *) let scheme_suffix_gen {sch_type; sch_sort} sort = (* The _ind/_rec_/case suffix *) let ind_suffix = match sch_isrec sch_type, sch_sort with | true , InSProp | true , InProp -> "_ind" | true , _ -> "_rec" | false , _ -> "_case" in (* SProp and Type have an auxillary ending to the _ind suffix *) let aux_suffix = match sch_sort with | InSProp -> "s" | InType -> "t" | _ -> "" in (* Some schemes are deliminated with _dep or no_dep *) let dep_suffix = match sch_isdep sch_type , sort with | true , InProp -> "_dep" | false , InSet | false , InType | false , InSProp -> "_nodep" | _ , _ -> "" in ind_suffix ^ aux_suffix ^ dep_suffix let smart_ind qid = let ind = Smartlocate.smart_global_inductive qid in if Dumpglob.dump() then Dumpglob.add_glob ?loc:qid.loc (IndRef ind); ind (* Resolve the name of a scheme using an environment and extract some important data such as the inductive type involved, whether it is a dependent eliminator and its sort. *) let name_and_process_scheme env = function | (Some id, {sch_type; sch_qualid; sch_sort}) -> (id, sch_isdep sch_type, smart_ind sch_qualid, sch_sort) | (None, ({sch_type; sch_qualid; sch_sort} as sch)) -> (* If no name has been provided, we build one from the types of the ind requested *) let ind = smart_ind sch_qualid in let sort_of_ind = Indrec.pseudo_sort_family_for_elim ind (snd (Inductive.lookup_mind_specif env ind)) in let suffix = scheme_suffix_gen sch sort_of_ind in let newid = Nameops.add_suffix (Nametab.basename_of_global (Names.GlobRef.IndRef ind)) suffix in let newref = CAst.make newid in (newref, sch_isdep sch_type, ind, sch_sort) let do_mutual_induction_scheme ?(force_mutual=false) env ?(isrec=true) l = let sigma, inst = let _,_,ind,_ = match l with | x::_ -> x | [] -> assert false in let _, ctx = Typeops.type_of_global_in_context env (Names.GlobRef.IndRef ind) in let u, ctx = UnivGen.fresh_instance_from ctx None in let u = EConstr.EInstance.make u in let sigma = Evd.from_ctx (UState.of_context_set ctx) in sigma, u in let sigma, lrecspec = List.fold_left_map (fun sigma (_,dep,ind,sort) -> let sigma, sort = Evd.fresh_sort_in_family ~rigid:UnivRigid sigma sort in (sigma, ((ind,inst),dep,sort))) sigma l in let sigma, listdecl = if isrec then Indrec.build_mutual_induction_scheme env sigma ~force_mutual lrecspec else List.fold_left_map (fun sigma (ind,dep,sort) -> let sigma, c = Indrec.build_case_analysis_scheme env sigma ind dep sort in let c, _ = Indrec.eval_case_analysis c in sigma, c) sigma lrecspec in let poly = (* NB: build_mutual_induction_scheme forces nonempty list of mutual inductives (force_mutual is about the generated schemes) *) let _,_,ind,_ = List.hd l in Global.is_polymorphic (Names.GlobRef.IndRef ind) in let declare decl ({CAst.v=fi},dep,ind,sort) = let decltype = Retyping.get_type_of env sigma decl in let decltype = EConstr.to_constr sigma decltype in let decl = EConstr.to_constr sigma decl in let cst = define ~poly fi sigma decl (Some decltype) in let kind = let open Elimschemes in if isrec then Some (elim_scheme ~dep ~to_kind:sort) else match sort with | InType -> Some (if dep then case_dep else case_nodep) | InProp -> Some (if dep then casep_dep else casep_nodep) | InSProp | InSet | InQSort -> (* currently we don't have standard scheme kinds for this *) None in match kind with | None -> () | Some kind -> DeclareScheme.declare_scheme (Ind_tables.scheme_kind_name kind) (ind,cst) in let () = List.iter2 declare listdecl l in let lrecnames = List.map (fun ({CAst.v},_,_,_) -> v) l in Declare.fixpoint_message None lrecnames let do_scheme env l = let isrec = match l with | [_, sch] -> sch_isrec sch.sch_type | _ -> if List.for_all (fun (_,sch) -> sch_isrec sch.sch_type) l then true else CErrors.user_err Pp.(str "Mutually defined schemes should be recursive.") in let lnamedepindsort = List.map (name_and_process_scheme env) l in do_mutual_induction_scheme env ~isrec lnamedepindsort let do_scheme_equality ?locmap sch id = let mind,_ = smart_ind id in let dec = match sch with SchemeBooleanEquality -> false | SchemeEquality -> true in declare_beq_scheme ?locmap mind; if dec then declare_eq_decidability ?locmap mind (**********************************************************************) (* Combined scheme *) (* Matthieu Sozeau, Dec 2006 *) let list_split_rev_at index l = let rec aux i acc = function hd :: tl when Int.equal i index -> acc, tl | hd :: tl -> aux (succ i) (hd :: acc) tl | [] -> failwith "List.split_when: Invalid argument" in aux 0 [] l let fold_left' f = function [] -> invalid_arg "fold_left'" | hd :: tl -> List.fold_left f hd tl let mk_coq_and sigma = Evd.fresh_global (Global.env ()) sigma (Coqlib.lib_ref "core.and.type") let mk_coq_conj sigma = Evd.fresh_global (Global.env ()) sigma (Coqlib.lib_ref "core.and.conj") let mk_coq_prod sigma = Evd.fresh_global (Global.env ()) sigma (Coqlib.lib_ref "core.prod.type") let mk_coq_pair sigma = Evd.fresh_global (Global.env ()) sigma (Coqlib.lib_ref "core.prod.intro") let build_combined_scheme env schemes = let sigma = Evd.from_env env in let sigma, defs = List.fold_left_map (fun sigma cst -> let sigma, c = Evd.fresh_constant_instance env sigma cst in sigma, (c, Typeops.type_of_constant_in env c)) sigma schemes in let find_inductive ty = let (ctx, arity) = decompose_prod ty in let (_, last) = List.hd ctx in match Constr.kind last with | Constr.App (ind, args) -> let ind = Constr.destInd ind in let (_,spec) = Inductive.lookup_mind_specif env (fst ind) in ctx, ind, spec.mind_nrealargs | _ -> ctx, Constr.destInd last, 0 in let (c, t) = List.hd defs in let ctx, ind, nargs = find_inductive t in (* We check if ALL the predicates are in Prop, if so we use propositional conjunction '/\', otherwise we use the simple product '*'. *) let inprop = let inprop (_,t) = Retyping.get_sort_family_of env sigma (EConstr.of_constr t) == Sorts.InProp in List.for_all inprop defs in let mk_and, mk_conj = if inprop then (mk_coq_and, mk_coq_conj) else (mk_coq_prod, mk_coq_pair) in (* Number of clauses, including the predicates quantification *) let prods = Termops.nb_prod sigma (EConstr.of_constr t) - (nargs + 1) in let sigma, coqand = mk_and sigma in let sigma, coqconj = mk_conj sigma in let relargs = Termops.rel_vect 0 prods in let concls = List.rev_map (fun (cst, t) -> Constr.mkApp(Constr.mkConstU cst, relargs), snd (decompose_prod_n prods t)) defs in let concl_bod, concl_typ = fold_left' (fun (accb, acct) (cst, x) -> Constr.mkApp (EConstr.to_constr sigma coqconj, [| x; acct; cst; accb |]), Constr.mkApp (EConstr.to_constr sigma coqand, [| x; acct |])) concls in let ctx, _ = list_split_rev_at prods (List.rev_map (fun (x, y) -> Context.Rel.Declaration.LocalAssum (x, y)) ctx) in let typ = List.fold_left (fun d c -> Term.mkProd_wo_LetIn c d) concl_typ ctx in let body = it_mkLambda_or_LetIn concl_bod ctx in let sigma = Typing.check env sigma (EConstr.of_constr body) (EConstr.of_constr typ) in (sigma, body, typ) let do_combined_scheme name csts = let open CAst in let sigma,body,typ = build_combined_scheme (Global.env ()) csts in (* It is possible for the constants to have different universe polymorphism from each other, however that is only when the user manually defined at least one of them (as Scheme would pick the polymorphism of the inductive block). In that case if they want some other polymorphism they can also manually define the combined scheme. *) let poly = Global.is_polymorphic (Names.GlobRef.ConstRef (List.hd csts)) in ignore (define ~poly name.v sigma body (Some typ)); Declare.fixpoint_message None [name.v] (**********************************************************************) let map_inductive_block ?(locmap=Locmap.default None) f kn n = for i=0 to n-1 do let loc = Ind_tables.Locmap.lookup ~locmap (kn,i) in f ?loc (kn,i) done let declare_default_schemes ?locmap kn = let mib = Global.lookup_mind kn in let n = Array.length mib.mind_packets in if !elim_flag && (mib.mind_finite <> Declarations.BiFinite || !bifinite_elim_flag) && mib.mind_typing_flags.check_positive then declare_induction_schemes kn ?locmap; if !case_flag then map_inductive_block ?locmap declare_one_case_analysis_scheme kn n; if is_eq_flag() then try_declare_beq_scheme kn ?locmap; if !eq_dec_flag then try_declare_eq_decidability kn ?locmap; if !rewriting_flag then map_inductive_block ?locmap declare_congr_scheme kn n; if !rewriting_flag then map_inductive_block ?locmap declare_sym_scheme kn n; if !rewriting_flag then map_inductive_block ?locmap declare_rewriting_schemes kn n coq-8.20.0/vernac/indschemes.mli000066400000000000000000000047111466560755400165130ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* MutInd.t -> unit val declare_eq_decidability : ?locmap:Ind_tables.Locmap.t -> MutInd.t -> unit (** Build and register a congruence scheme for an equality-like inductive type *) val declare_congr_scheme : ?loc:Loc.t -> inductive -> unit (** Build and register rewriting schemes for an equality-like inductive type *) val declare_rewriting_schemes : ?loc:Loc.t -> inductive -> unit (** Mutual Minimality/Induction scheme. [force_mutual] forces the construction of eliminators having the same predicates and methods even if some of the inductives are not recursive. By default it is [false] and some of the eliminators are defined as simple case analysis. By default [isrec] is [true]. *) val do_mutual_induction_scheme : ?force_mutual:bool -> Environ.env -> ?isrec:bool -> resolved_scheme list -> unit (** Main calls to interpret the Scheme command *) val do_scheme : Environ.env -> (Names.Id.t CAst.t option * Vernacexpr.scheme) list -> unit (** Main call to Scheme Equality command *) val do_scheme_equality : ?locmap:Ind_tables.Locmap.t -> Vernacexpr.equality_scheme_type -> Libnames.qualid Constrexpr.or_by_notation -> unit (** Combine a list of schemes into a conjunction of them *) val build_combined_scheme : env -> Constant.t list -> Evd.evar_map * constr * types val do_combined_scheme : lident -> Constant.t list -> unit (** Hook called at each inductive type definition *) val declare_default_schemes : ?locmap:Ind_tables.Locmap.t -> MutInd.t -> unit coq-8.20.0/vernac/library.ml000066400000000000000000000466071466560755400156760ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* ObjFile.open_in ~file) f (************************************************************************) (** Serialized objects loaded on-the-fly *) exception Faulty of string module Delayed : sig type 'a delayed val in_delayed : string -> ObjFile.in_handle -> segment:'a ObjFile.id -> 'a delayed * Digest.t val fetch_delayed : 'a delayed -> 'a end = struct type 'a delayed = { del_file : string; del_off : int64; del_digest : Digest.t; } let in_delayed f ch ~segment = let seg = ObjFile.get_segment ch ~segment in let digest = seg.ObjFile.hash in { del_file = f; del_digest = digest; del_off = seg.ObjFile.pos; }, digest (** Fetching a table of opaque terms at position [pos] in file [f], expecting to find first a copy of [digest]. *) let fetch_delayed del = let { del_digest = digest; del_file = f; del_off = pos; } = del in let ch = open_in_bin f in let obj, digest' = try let () = LargeFile.seek_in ch pos in let obj = System.marshal_in f ch in let digest' = Digest.input ch in obj, digest' with e -> close_in ch; raise e in close_in ch; if not (String.equal digest digest') then raise (Faulty f); obj end open Delayed (************************************************************************) (*s Modules on disk contain the following informations (after the magic number, and before the digest). *) type compilation_unit_name = DirPath.t type library_disk = { md_compiled : Safe_typing.compiled_library; md_syntax_objects : Declaremods.library_objects; md_objects : Declaremods.library_objects; } type summary_disk = { md_name : compilation_unit_name; md_deps : (compilation_unit_name * Safe_typing.vodigest) array; md_ocaml : string; md_info : Library_info.t; } (*s Modules loaded in memory contain the following informations. They are kept in the global table [libraries_table]. *) type library_t = { library_name : compilation_unit_name; library_data : library_disk; library_deps : (compilation_unit_name * Safe_typing.vodigest) array; library_digests : Safe_typing.vodigest; library_info : Library_info.t; library_vm : Vmlibrary.on_disk; } type library_summary = { libsum_name : compilation_unit_name; libsum_digests : Safe_typing.vodigest; libsum_info : Library_info.t; } (* This is a map from names to loaded libraries *) let libraries_table : library_summary DPmap.t ref = Summary.ref DPmap.empty ~stage:Summary.Stage.Synterp ~name:"LIBRARY" (* This is the map of loaded libraries filename *) (* (not synchronized so as not to be caught in the states on disk) *) let libraries_filename_table = ref DPmap.empty (* These are the _ordered_ sets of loaded, imported and exported libraries *) let libraries_loaded_list = Summary.ref [] ~stage:Summary.Stage.Synterp ~name:"LIBRARY-LOAD" let loaded_native_libraries = Summary.ref DPset.empty ~stage:Summary.Stage.Interp ~name:"NATIVE-LIBRARY-LOAD" (* Opaque proof tables *) (* various requests to the tables *) let find_library dir = DPmap.find_opt dir !libraries_table let try_find_library dir = match find_library dir with | Some lib -> lib | None -> user_err (str "Unknown library " ++ DirPath.print dir ++ str ".") let register_library_filename dir f = (* Not synchronized: overwrite the previous binding if one existed *) (* from a previous play of the session *) libraries_filename_table := DPmap.add dir f !libraries_filename_table let library_full_filename dir = try DPmap.find dir !libraries_filename_table with Not_found -> "" let library_is_loaded dir = try let _ = find_library dir in true with Not_found -> false (* If a library is loaded several time, then the first occurrence must be performed first, thus the libraries_loaded_list ... *) let register_loaded_library ~root m = let libname = m.libsum_name in let rec aux = function | [] -> [root, libname] | (_, m') ::_ as l when DirPath.equal m' libname -> l | m'::l' -> m' :: aux l' in libraries_loaded_list := aux !libraries_loaded_list; libraries_table := DPmap.add libname m !libraries_table let register_native_library libname = if (Global.typing_flags ()).enable_native_compiler && not (DPset.mem libname !loaded_native_libraries) then begin let dirname = Filename.dirname (library_full_filename libname) in loaded_native_libraries := DPset.add libname !loaded_native_libraries; Nativelib.enable_library dirname libname end let loaded_libraries () = List.map snd !libraries_loaded_list (** Delayed / available tables of opaque terms *) type table_status = | ToFetch of Opaques.opaque_disk delayed | Fetched of Opaques.opaque_disk let opaque_tables = ref (DPmap.empty : table_status DPmap.t) let add_opaque_table dp st = opaque_tables := DPmap.add dp st !opaque_tables let access_table what tables dp i = let t = match DPmap.find dp !tables with | Fetched t -> t | ToFetch f -> let dir_path = Names.DirPath.to_string dp in Flags.if_verbose Feedback.msg_info (str"Fetching " ++ str what++str" from disk for " ++ str dir_path); let t = try fetch_delayed f with Faulty f -> user_err (str "The file " ++ str f ++ str " (bound to " ++ str dir_path ++ str ") is corrupted,\ncannot load some " ++ str what ++ str " in it.\n") in tables := DPmap.add dp (Fetched t) !tables; t in Opaques.get_opaque_disk i t let access_opaque_table o = let (sub, ci, dp, i) = Opaqueproof.repr o in let ans = if DirPath.equal dp (Global.current_dirpath ()) then Opaques.get_current_opaque i else let what = "opaque proofs" in access_table what opaque_tables dp i in match ans with | None -> None | Some (c, ctx) -> let (c, ctx) = Discharge.cook_opaque_proofterm ci (c, ctx) in let c = Mod_subst.subst_mps_list sub c in Some (c, ctx) let indirect_accessor = { Global.access_proof = access_opaque_table; } (************************************************************************) (* Internalise libraries *) type seg_sum = summary_disk type seg_lib = library_disk type seg_proofs = Opaques.opaque_disk type seg_vm = Vmlibrary.compiled_library let mk_library sd md digests vm = { library_name = sd.md_name; library_data = md; library_deps = sd.md_deps; library_digests = digests; library_info = sd.md_info; library_vm = vm; } let mk_summary m = { libsum_name = m.library_name; libsum_digests = m.library_digests; libsum_info = m.library_info; } let mk_intern_library sum lib digest_lib proofs vm = add_opaque_table sum.md_name (ToFetch proofs); let open Safe_typing in mk_library sum lib (Dvo_or_vi digest_lib) vm let summary_seg : seg_sum ObjFile.id = ObjFile.make_id "summary" let library_seg : seg_lib ObjFile.id = ObjFile.make_id "library" let opaques_seg : seg_proofs ObjFile.id = ObjFile.make_id "opaques" let vm_seg : seg_vm ObjFile.id = Vmlibrary.vm_segment module Intern = struct module Provenance = struct type t = string * string (** A pair of [kind, object], for example ["file", "/usr/local/foo.vo"], used for error messages. *) end type t = DirPath.t -> (library_t, Exninfo.iexn) Result.t * Provenance.t end let intern_from_file file = let ch = raw_intern_library file in let lsd, digest_lsd = ObjFile.marshal_in_segment ch ~segment:summary_seg in let lmd, digest_lmd = ObjFile.marshal_in_segment ch ~segment:library_seg in let del_opaque, _ = in_delayed file ch ~segment:opaques_seg in let vmlib = Vmlibrary.load lsd.md_name ~file ch in ObjFile.close_in ch; System.check_caml_version ~caml:lsd.md_ocaml ~file; register_library_filename lsd.md_name file; Library_info.warn_library_info ~transitive:true lsd.md_name lsd.md_info; mk_intern_library lsd lmd digest_lmd del_opaque vmlib let intern_from_file file = let provenance = ("file", file) in (* This is a barrier to catch IO / Marshal exceptions in a more structured way, as to provide better error messages. *) (match CErrors.to_result ~f:intern_from_file file with | Ok res -> Ok res | Error iexn -> Error iexn), provenance let check_library_expected_name ~provenance dir library_name = if not (DirPath.equal dir library_name) then let kind, obj = provenance in user_err (str "The " ++ str kind ++ str " " ++ str obj ++ str " contains library" ++ spc () ++ DirPath.print library_name ++ spc () ++ str "and not library" ++ spc() ++ DirPath.print dir ++ str ".") exception InternError of { exn : exn; provenance : Intern.Provenance.t; dir : DirPath.t } let () = CErrors.register_handler (function | InternError { exn; provenance; dir } -> let err = CErrors.print exn in Some (Pp.(str "Error when parsing .vo (from " ++ str (fst provenance) ++ str " " ++ str (snd provenance) ++ str ") for library " ++ Names.DirPath.print dir ++ str ": " ++ err)) | _ -> None) let error_in_intern provenance dir (exn, info) = Exninfo.iraise (InternError { exn; provenance; dir }, info) (* Returns the digest of a library, checks both caches to see what is loaded *) let rec intern_library ~root ~intern (needed, contents as acc) dir = (* Look if in the current logical environment *) match find_library dir with | Some loaded_lib -> loaded_lib, acc | None -> (* Look if already listed in the accumulator *) match DPmap.find_opt dir contents with | Some interned_lib -> mk_summary interned_lib, acc | None -> (* We intern the library, and then intern the deps *) match intern dir with | Ok m, provenance -> check_library_expected_name ~provenance dir m.library_name; mk_summary m, intern_library_deps ~root ~intern acc dir m | Error iexn, provenance -> error_in_intern provenance dir iexn and intern_library_deps ~root ~intern libs dir m = let needed, contents = Array.fold_left (intern_mandatory_library ~intern dir) libs m.library_deps in ((root, dir) :: needed, DPmap.add dir m contents ) and intern_mandatory_library ~intern caller libs (dir,d) = let m, libs = intern_library ~root:false ~intern libs dir in let digest = m.libsum_digests in let () = if not (Safe_typing.digest_match ~actual:digest ~required:d) then let from = library_full_filename caller in user_err (str "Compiled library " ++ DirPath.print caller ++ str " (in file " ++ str from ++ str ") makes inconsistent assumptions over library " ++ DirPath.print dir) in libs let rec_intern_library ~intern libs (loc, dir) = let m, libs = intern_library ~root:true ~intern libs dir in Library_info.warn_library_info m.libsum_name m.libsum_info; libs let native_name_from_filename f = let ch = raw_intern_library f in let lmd, digest_lmd = ObjFile.marshal_in_segment ch ~segment:summary_seg in Nativecode.mod_uid_of_dirpath lmd.md_name (**********************************************************************) (*s [require_library] loads and possibly opens a library. This is a synchronized operation. It is performed as follows: preparation phase: (functions require_library* ) the library and its dependencies are read from to disk (using intern_* ) [they are read from disk to ensure that at section/module discharging time, the physical library referred to outside the section/module is the one that was used at type-checking time in the section/module] execution phase: (through add_leaf and cache_require) the library is loaded in the environment and Nametab, the objects are registered etc, using functions from Declaremods (via load_library, which recursively loads its dependencies) *) let register_library m = let l = m.library_data in Declaremods.Interp.register_library m.library_name l.md_compiled l.md_objects m.library_digests m.library_vm ; register_native_library m.library_name let register_library_syntax (root, m) = let l = m.library_data in Declaremods.Synterp.register_library m.library_name l.md_syntax_objects; register_loaded_library ~root (mk_summary m) (* Follow the semantics of Anticipate object: - called at module or module type closing when a Require occurs in the module or module type - not called from a library (i.e. a module identified with a file) *) let load_require _ needed = List.iter register_library needed (* [needed] is the ordered list of libraries not already loaded *) let cache_require o = load_require 1 o let discharge_require o = Some o (* open_function is never called from here because an Anticipate object *) type require_obj = library_t list let in_require : require_obj -> obj = declare_object {(default_object "REQUIRE") with cache_function = cache_require; load_function = load_require; open_function = (fun _ _ -> assert false); discharge_function = discharge_require; classify_function = (fun o -> Anticipate) } let load_require_syntax _ needed = List.iter register_library_syntax needed let cache_require_syntax o = load_require_syntax 1 o let discharge_require_syntax o = Some o (* open_function is never called from here because an Anticipate object *) type require_obj_syntax = (bool * library_t) list let in_require_syntax : require_obj_syntax -> obj = declare_object {(default_object "REQUIRE-SYNTAX") with object_stage = Summary.Stage.Synterp; cache_function = cache_require_syntax; load_function = load_require_syntax; open_function = (fun _ _ -> assert false); discharge_function = discharge_require_syntax; classify_function = (fun o -> Anticipate) } (* Require libraries, import them if [export <> None], mark them for export if [export = Some true] *) let warn_require_in_module = CWarnings.create ~name:"require-in-module" ~category:CWarnings.CoreCategories.fragile (fun () -> strbrk "Use of “Require” inside a module is fragile." ++ spc() ++ strbrk "It is not recommended to use this functionality in finished proof scripts.") let require_library_from_dirpath needed = if Lib.is_module_or_modtype () then warn_require_in_module (); Lib.add_leaf (in_require needed) let require_library_syntax_from_dirpath ~intern modrefl = let needed, contents = List.fold_left (rec_intern_library ~intern) ([], DPmap.empty) modrefl in let needed = List.rev_map (fun (root, dir) -> root, DPmap.find dir contents) needed in Lib.add_leaf (in_require_syntax needed); List.map snd needed (************************************************************************) (*s [save_library dir] ends library [dir] and save it to the disk. *) let current_deps () = (* Only keep the roots of the dependency DAG *) let map (root, m) = if root then let m = try_find_library m in Some (m.libsum_name, m.libsum_digests) else None in List.map_filter map !libraries_loaded_list let error_recursively_dependent_library dir = user_err (strbrk "Unable to use logical name " ++ DirPath.print dir ++ strbrk " to save current library because" ++ strbrk " it already depends on a library of this name.") type 'doc todo_proofs = | ProofsTodoNone (* for .vo *) | ProofsTodoSomeEmpty of Future.UUIDSet.t (* for .vos *) (* We now use two different digests in a .vo file. The first one only covers half of the file, without the opaque table. It is used for identifying this version of this library : this digest is the one leading to "inconsistent assumptions" messages. The other digest comes at the very end, and covers everything before it. This one is used for integrity check of the whole file when loading the opaque table. *) (* Security weakness: file might have been changed on disk between writing the content and computing the checksum... *) let save_library_base f sum lib proofs vmlib = let ch = raw_extern_library f in try ObjFile.marshal_out_segment ch ~segment:summary_seg sum; ObjFile.marshal_out_segment ch ~segment:library_seg lib; ObjFile.marshal_out_segment ch ~segment:opaques_seg proofs; ObjFile.marshal_out_segment ch ~segment:vm_seg vmlib; ObjFile.close_out ch with reraise -> let reraise = Exninfo.capture reraise in ObjFile.close_out ch; Feedback.msg_warning (str "Removed file " ++ str f); Sys.remove f; Exninfo.iraise reraise (* This is the basic vo save structure *) let save_library_struct ~output_native_objects dir = let md_compiled, md_objects, md_syntax_objects, vmlib, ast, info = Declaremods.end_library ~output_native_objects dir in let sd = { md_name = dir ; md_deps = Array.of_list (current_deps ()) ; md_ocaml = Coq_config.caml_version ; md_info = info } in let md = { md_compiled ; md_syntax_objects ; md_objects } in if Array.exists (fun (d,_) -> DirPath.equal d dir) sd.md_deps then error_recursively_dependent_library dir; sd, md, vmlib, ast let save_library dir : library_t = let sd, md, vmlib, _ast = save_library_struct ~output_native_objects:false dir in (* Digest for .vo files is on the md part, for now we also play it safe when we work on-memory and compute the digest for the lib part, even if that's slow. Better safe than sorry. *) let digest = Marshal.to_string md [] |> Digest.string in mk_library sd md (Dvo_or_vi digest) (Vmlibrary.inject vmlib) let save_library_to todo_proofs ~output_native_objects dir f = assert( let expected_extension = match todo_proofs with | ProofsTodoNone -> ".vo" | ProofsTodoSomeEmpty _ -> ".vos" in Filename.check_suffix f expected_extension); let except = match todo_proofs with | ProofsTodoNone -> Future.UUIDSet.empty | ProofsTodoSomeEmpty except -> except in (* Ensure that the call below is performed with all opaques joined *) let () = Opaques.Summary.join ~except () in let opaque_table, f2t_map = Opaques.dump ~except () in let () = assert (not (Future.UUIDSet.is_empty except) || Safe_typing.is_joined_environment (Global.safe_env ())) in let sd, md, vmlib, ast = save_library_struct ~output_native_objects dir in (* Writing vo payload *) save_library_base f sd md opaque_table vmlib; (* Writing native code files *) if output_native_objects then let fn = Filename.dirname f ^"/"^ Nativecode.mod_uid_of_dirpath dir in Nativelib.compile_library ast fn let get_used_load_paths () = String.Set.elements (List.fold_left (fun acc (root, m) -> String.Set.add (Filename.dirname (library_full_filename m)) acc) String.Set.empty !libraries_loaded_list) let _ = Nativelib.get_load_paths := get_used_load_paths coq-8.20.0/vernac/library.mli000066400000000000000000000054711466560755400160410ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* unit (** Intern from a .vo file located by libresolver *) module Intern : sig module Provenance : sig type t = string * string (** A pair of [kind, object], for example ["file", "/usr/local/foo.vo"], used for error messages. *) end type t = DirPath.t -> (library_t, Exninfo.iexn) Result.t * Provenance.t end val intern_from_file : CUnix.physical_path -> (library_t, Exninfo.iexn) Result.t * Intern.Provenance.t val require_library_syntax_from_dirpath : intern:Intern.t -> DirPath.t Loc.located list -> library_t list (** {6 Start the compilation of a library } *) (** End the compilation of a library and save it to a ".vo" file, or a ".vos" file, depending on the todo_proofs argument. [output_native_objects]: when producing vo objects, also compile the native-code version. *) type 'doc todo_proofs = | ProofsTodoNone (* for .vo *) | ProofsTodoSomeEmpty of Future.UUIDSet.t (* for .vos *) val save_library_to : 'document todo_proofs -> output_native_objects:bool -> DirPath.t -> string -> unit (** Save library to library_t format, that can be used later in [require_library_syntax_from_dirpath] *) val save_library : DirPath.t -> library_t (** {6 Interrogate the status of libraries } *) (** - Tell if a library is loaded *) val library_is_loaded : DirPath.t -> bool (** - Tell which libraries are loaded *) val loaded_libraries : unit -> DirPath.t list (** {6 Native compiler. } *) val native_name_from_filename : string -> string (** {6 Opaque accessors} *) val indirect_accessor : Global.indirect_accessor [@@deprecated "Most commands should not be accessing opaque data."] coq-8.20.0/vernac/loadpath.ml000066400000000000000000000274541466560755400160250ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* raise Not_found | [p] -> p | _ -> anomaly_too_many_paths phys_dir (* get the list of load paths that correspond to a given logical path *) let find_with_logical_path dirpath = List.filter (fun p -> Names.DirPath.equal p.path_logical dirpath) !load_paths let warn_file_found_multiple_times = CWarnings.create ~name:"ambiguous-extra-dep" ~category:CWarnings.CoreCategories.filesystem (fun (file,from,other,extra) -> Pp.(str "File " ++ str file ++ str " found twice in " ++ Names.DirPath.print from ++ str":" ++ spc () ++ str other ++ str " (selected)," ++ spc() ++ str extra ++ str ".") ) let rec first_path_containing ?loc from file acc = function | [] -> begin match acc with | Some x -> x | None -> CErrors.user_err Pp.(str "File " ++ str file ++ str " not found in " ++ Names.DirPath.print from ++ str".") end | x :: xs -> let abspath = x ^ "/" ^ file in if Sys.file_exists abspath then begin match acc with | None -> first_path_containing ?loc from file (Some abspath) xs | Some other -> warn_file_found_multiple_times ?loc (file,from,other,abspath); first_path_containing ?loc from file acc xs end else first_path_containing ?loc from file acc xs let find_extra_dep_with_logical_path ?loc ~from ~file () = match find_with_logical_path from with | _ :: _ as paths -> let paths = List.map physical paths in first_path_containing ?loc from file None paths | [] -> CErrors.user_err Pp.(str "No LoadPath found for " ++ Names.DirPath.print from ++ str".") let remove_load_path dir = let filter p = not (String.equal p.path_physical dir) in load_paths := List.filter filter !load_paths let warn_overriding_logical_loadpath = CWarnings.create ~name:"overriding-logical-loadpath" ~category:CWarnings.CoreCategories.filesystem (fun (phys_path, old_path, coq_path) -> Pp.(seq [str phys_path; strbrk " was previously bound to " ; DP.print old_path; strbrk "; it is remapped to " ; DP.print coq_path])) let add_load_path root phys_path coq_path ~implicit = let phys_path = CUnix.canonical_path_name phys_path in let filter p = String.equal p.path_physical phys_path in let binding = { path_logical = coq_path; path_physical = phys_path; path_implicit = implicit; path_root = root; } in match List.filter filter !load_paths with | [] -> load_paths := binding :: !load_paths | [{ path_logical = old_path; path_implicit = old_implicit }] -> let replace = if DP.equal coq_path old_path then implicit <> old_implicit else let () = (* Do not warn when overriding the default "-I ." path *) if not (DP.equal old_path Libnames.default_root_prefix) then warn_overriding_logical_loadpath (phys_path, old_path, coq_path) in true in if replace then begin remove_load_path phys_path; load_paths := binding :: !load_paths; end | _ -> anomaly_too_many_paths phys_path let filter_path f = let rec aux = function | [] -> [] | p :: l -> if f p.path_logical then (p.path_physical, p.path_logical) :: aux l else aux l in aux !load_paths let eq_root (phys,log_path) (phys',log_path') = String.equal phys phys' && Names.DirPath.equal log_path log_path' let add_path root file = function | [] -> [root,[file]] | (root',l) :: l' as l'' -> if eq_root root root' then (root', file::l) :: l' else (root,[file]) :: l'' let expand_path ?root dir = let exact_path = match root with None -> dir | Some root -> Libnames.append_dirpath root dir in let rec aux = function | [] -> [], [] | { path_physical = ph; path_logical = lg; path_implicit = implicit; path_root } :: l -> let full, others = aux l in if DP.equal exact_path lg then (* Most recent full match comes first *) (ph, lg) :: full, others else let success = match root with | None -> implicit && Libnames.is_dirpath_suffix_of dir lg | Some root -> Libnames.(is_dirpath_prefix_of root lg && is_dirpath_suffix_of dir (drop_dirpath_prefix root lg)) in if success then (* Only keep partial path in the same "-R" block *) full, add_path path_root (ph, lg) others else full, others in let full, others = aux !load_paths in (* Returns the dirpath matching exactly and the ordered list of -R/-Q blocks with subdirectories that matches *) full, List.map snd others let locate_file fname = let paths = List.map physical !load_paths in let _,longfname = System.find_file_in_path ~warn:(not !Flags.quiet) paths fname in longfname (************************************************************************) (*s Locate absolute or partially qualified library names in the path *) module Error = struct type t = LibUnmappedDir | LibNotFound let unmapped_dir qid = let prefix, _ = Libnames.repr_qualid qid in CErrors.user_err Pp.(seq [ str "Cannot load "; Libnames.pr_qualid qid; str ":"; spc () ; str "no physical path bound to"; spc () ; Names.DirPath.print prefix; fnl () ]) let lib_not_found dir = let vos = !Flags.load_vos_libraries in let vos_msg = if vos then [Pp.str " (while searching for a .vos file)"] else [] in CErrors.user_err Pp.(seq ([ str "Cannot find library "; Names.DirPath.print dir; str" in loadpath"]@vos_msg)) let raise dp = function | LibUnmappedDir -> unmapped_dir (Libnames.qualid_of_dirpath dp) | LibNotFound -> lib_not_found dp end (* If [!Flags.load_vos_libraries] and the .vos file exists and this file is not empty Then load this library Else load the .vo file or raise error if both are missing *) let select_vo_file ~find base = let find ext = try let name = Names.Id.to_string base ^ ext in let lpath, file = find name in Ok (lpath, file) with Not_found -> Error Error.LibNotFound in if !Flags.load_vos_libraries then begin match find ".vos" with | Ok (_, vos as resvos) when (Unix.stat vos).Unix.st_size > 0 -> Ok resvos | _ -> find ".vo" end else find ".vo" let find_first loadpath base = match System.all_in_path loadpath base with | [] -> raise Not_found | f :: _ -> f let find_unique fullqid loadpath base = match System.all_in_path loadpath base with | [] -> raise Not_found | [f] -> f | _::_ as l -> CErrors.user_err Pp.(str "Required library " ++ Libnames.pr_qualid fullqid ++ strbrk " matches several files in path (found " ++ pr_enum str (List.map snd l) ++ str ").") let locate_absolute_library dir : (CUnix.physical_path, Error.t) Result.t = (* Search in loadpath *) let pref, base = Libnames.split_dirpath dir in let loadpath = filter_path (fun dir -> DP.equal dir pref) in match loadpath with | [] -> Error LibUnmappedDir | _ -> match select_vo_file ~find:(find_first loadpath) base with | Ok (_, file) -> Ok file | Error fail -> Error fail let locate_qualified_library ?root qid : (DP.t * CUnix.physical_path, Error.t) Result.t = (* Search library in loadpath *) let dir, base = Libnames.repr_qualid qid in match expand_path ?root dir with | [], [] -> Error LibUnmappedDir | full_matches, others -> let result = (* Priority to exact matches *) match select_vo_file ~find:(find_first full_matches) base with | Ok _ as x -> x | Error _ -> (* Looking otherwise in -R/-Q blocks of partial matches *) let rec aux = function | [] -> Error Error.LibUnmappedDir | block :: rest -> match select_vo_file ~find:(find_unique qid block) base with | Ok _ as x -> x | Error _ -> aux rest in aux others in match result with | Ok (dir,file) -> let library = Libnames.add_dirpath_suffix dir base in Ok (library, file) | Error _ as e -> e (** { 5 Extending the load path } *) type vo_path = { unix_path : string (** Filesystem path containing vo/ml files *) ; coq_path : DP.t (** Coq prefix for the path *) ; implicit : bool (** [implicit = true] avoids having to qualify with [coq_path] true for -R, false for -Q in command line *) ; has_ml : bool (** If [has_ml] is true, the directory will also be added to the ml include path *) ; recursive : bool (** [recursive] will determine whether we explore sub-directories *) } let warn_cannot_open_path = CWarnings.create ~name:"cannot-open-path" ~category:CWarnings.CoreCategories.filesystem (fun unix_path -> Pp.(str "Cannot open " ++ str unix_path)) let warn_cannot_use_directory = CWarnings.create ~name:"cannot-use-directory" ~category:CWarnings.CoreCategories.filesystem (fun d -> Pp.(str "Directory " ++ str d ++ strbrk " cannot be used as a Coq identifier (skipped)")) let convert_string d = try Names.Id.of_string d with | CErrors.UserError _ -> let d = Unicode.escaped_if_non_utf8 d in warn_cannot_use_directory d; raise_notrace Exit let add_vo_path lp = let unix_path = lp.unix_path in let implicit = lp.implicit in let recursive = lp.recursive in if System.exists_dir unix_path then let dirs = if recursive then System.all_subdirs ~unix_path else [] in let dirs = List.sort (fun a b -> String.compare (fst a) (fst b)) dirs in let prefix = DP.repr lp.coq_path in let convert_dirs (lp, cp) = try let path = List.rev_map convert_string cp @ prefix in Some (lp, DP.make path) with Exit -> None in let dirs = List.map_filter convert_dirs dirs in let () = if lp.has_ml && not lp.recursive then Mltop.add_ml_dir unix_path else if lp.has_ml && lp.recursive then (List.iter (fun (lp,_) -> Mltop.add_ml_dir lp) dirs; Mltop.add_ml_dir unix_path) else () in let root = (unix_path,lp.coq_path) in let add (path, dir) = add_load_path root path ~implicit dir in (* deeper dirs registered first and thus be found last *) let dirs = List.rev dirs in let () = List.iter add dirs in add_load_path root unix_path ~implicit lp.coq_path else warn_cannot_open_path unix_path coq-8.20.0/vernac/loadpath.mli000066400000000000000000000064261466560755400161720ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* DirPath.t (** Get the logical path (Coq module hierarchy) of a loadpath. *) val physical : t -> CUnix.physical_path (** Get the physical path of a loadpath *) val pp : t -> Pp.t (** Print a load path *) val get_load_paths : unit -> t list (** Get the current loadpath association. *) val remove_load_path : CUnix.physical_path -> unit (** Remove the current logical path binding associated to a given physical path, if any. *) val find_load_path : CUnix.physical_path -> t (** Get the binding associated with a physical path. Raises [Not_found] if there is none. *) val find_with_logical_path : Names.DirPath.t -> t list (** get the list of load paths that correspond to a given logical path *) val find_extra_dep_with_logical_path : ?loc:Loc.t -> from:Names.DirPath.t -> file:string -> unit -> CUnix.physical_path (** finds a file rooted in from. @raise UserError if the file is not found *) val locate_file : string -> string (** Locate a file among the registered paths. Do not use this function, as it does not respect the visibility of paths. *) (** {6 Locate a library in the load path } *) module Error : sig type t = LibUnmappedDir | LibNotFound (** Raise regular Coq errors with default informative message; usually document managers that have more information about the workspace than coqc will override this with a better mechanism / message. *) val raise : DirPath.t -> t -> 'a end val locate_qualified_library : ?root:DirPath.t -> Libnames.qualid -> (DirPath.t * CUnix.physical_path, Error.t) Result.t (** Locates a library by implicit name. @return LibUnmappedDir if the library is not in the path @return LibNotFound if there is no corresponding file in the path *) val locate_absolute_library : DirPath.t -> (CUnix.physical_path, Error.t) Result.t (** {6 Extending the Load Path } *) (** Adds a path to the Coq and ML paths *) type vo_path = { unix_path : string (** Filesystem path containing vo/ml files *) ; coq_path : DirPath.t (** Coq prefix for the path *) ; implicit : bool (** [implicit = true] avoids having to qualify with [coq_path] true for -R, false for -Q in command line *) ; has_ml : bool (** If [has_ml] is true, the directory will also be added to the ml include path *) ; recursive : bool (** [recursive] will determine whether we explore sub-directories *) } val add_vo_path : vo_path -> unit coq-8.20.0/vernac/locality.ml000066400000000000000000000045311466560755400160400ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* false | _ -> true let make_locality = function Some true -> true | _ -> false let enforce_locality locality_flag = make_locality locality_flag (* For commands whose default is to not discharge but to export: Global in sections forces discharge, Global not in section is the default; Local in sections is the default, Local not in section forces non-export *) let make_section_locality = function Some b -> b | None -> Lib.sections_are_opened () let enforce_section_locality locality_flag = make_section_locality locality_flag (** Positioning locality for commands supporting export but not discharge *) (* For commands whose default is to export (if not in section): Global in sections is forbidden, Global not in section is neutral; Local in sections is the default, Local not in section forces non-export *) let make_module_locality = function | Some false -> if Lib.sections_are_opened () then CErrors.user_err Pp.(str "This command does not support the Global option in sections."); false | Some true -> true | None -> false let enforce_module_locality locality_flag = make_module_locality locality_flag coq-8.20.0/vernac/locality.mli000066400000000000000000000040061466560755400162060ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* bool val make_non_locality : bool option -> bool val enforce_locality : bool option -> bool (** For commands whose default is to not discharge but to export: Global in sections forces discharge, Global not in section is the default; Local in sections is the default, Local not in section forces non-export *) val make_section_locality : bool option -> bool val enforce_section_locality : bool option -> bool (** * Positioning locality for commands supporting export but not discharge *) (** For commands whose default is to export (if not in section): Global in sections is forbidden, Global not in section is neutral; Local in sections is the default, Local not in section forces non-export *) val make_module_locality : bool option -> bool val enforce_module_locality : bool option -> bool coq-8.20.0/vernac/metasyntax.ml000066400000000000000000002601441466560755400164210ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* error_unknown_entry name | entries -> let pr_one (Pcoq.Entry.Any e) = str "Entry " ++ str (Pcoq.Entry.name e) ++ str " is" ++ fnl () ++ pr_entry e in prlist pr_one entries let pr_grammar_subset grammar = let pp = String.Map.mapi (fun name l -> match l with | [] -> assert false | entries -> str "Entry " ++ str name ++ str " is" ++ fnl() ++ prlist_with_sep (fun () -> str "or" ++ fnl()) (fun (Pcoq.Entry.Any e) -> pr_entry e) entries) grammar in let pp = CString.Map.bindings pp in prlist_with_sep fnl (fun (_,pp) -> pp) pp let is_known = let open Pcoq.Entry in function | "constr" | "term" | "binder_constr" -> Some [ Any Pcoq.Constr.constr; Any Pcoq.Constr.lconstr; Any Pcoq.Constr.binder_constr; Any Pcoq.Constr.term; ] | "vernac" -> Some Pvernac.Vernac_.[ Any vernac_control; (* main_entry="vernac", included not because it's interesting but because otherwise it's shadowed by the "vernac" group defined here *) Any main_entry; Any command; Any syntax; Any gallina; Any gallina_ext; ] | name -> let gram = Pcoq.find_grammars_by_name name in match gram with | [] -> None | entries -> Some entries let full_grammar () = let open Pvernac.Vernac_ in let open Pcoq.Entry in let proof_modes = List.map (fun (_,e) -> Any e) (CString.Map.bindings (Pvernac.list_proof_modes())) in let entries = (Any vernac_control) :: (Any noedit_mode) :: proof_modes in Pcoq.Entry.accumulate_in entries let same_entry (Pcoq.Entry.Any e) (Pcoq.Entry.Any e') = (Obj.magic e) == (Obj.magic e') let pr_grammar = function | [] -> let grammar = full_grammar () in pr_grammar_subset grammar | names -> let known, other = List.fold_left (fun (known,other) name -> match is_known name with | Some v -> v @ known, other | None -> known, name::other) ([],[]) names in let grammar = if List.is_empty other then String.Map.empty else full_grammar () in let () = List.iter (fun name -> if not (String.Map.mem name grammar) then error_unknown_entry name) other in let other = String.Set.of_list other in let grammar = String.Map.filter (fun name _ -> String.Set.mem name other) grammar in let grammar = List.fold_left (fun grammar (Pcoq.Entry.Any e as any) -> String.Map.update (Pcoq.Entry.name e) (function | None -> Some [any] | Some vl as v -> if List.mem_f same_entry any vl then v else Some (any :: vl)) grammar) grammar known in pr_grammar_subset grammar let pr_custom_grammar name = pr_registered_grammar ("custom:"^name) let pr_keywords () = Pp.prlist_with_sep Pp.fnl Pp.str (CString.Set.elements (CLexer.keywords (Pcoq.get_keyword_state()))) (** **************************************************************** **) (** Parse a format (every terminal starting with a letter or a single quote (except a single quote alone) must be quoted) **) let parse_format ({CAst.loc;v=str} : lstring) = let len = String.length str in (* TODO: update the line of the location when the string contains newlines *) let make_loc i j = Option.map (Loc.shift_loc (i+1) (j-len)) loc in let push_token loc a = function | (i,cur)::l -> (i,(loc,a)::cur)::l | [] -> assert false in let push_white i n l = if Int.equal n 0 then l else push_token (make_loc i (i+n)) (UnpTerminal (String.make n ' ')) l in let close_box start stop b = function | (_,a)::(_::_ as l) -> push_token (make_loc start stop) (UnpBox (b,a)) l | [a] -> user_err ?loc:(make_loc start stop) Pp.(str "Non terminated box in format.") | [] -> assert false in let close_quotation start i = if i < len && str.[i] == '\'' then if (Int.equal (i+1) len || str.[i+1] == ' ') then i+1 else user_err ?loc:(make_loc (i+1) (i+1)) Pp.(str "Space expected after quoted expression.") else user_err ?loc:(make_loc start (i-1)) Pp.(str "Beginning of quoted expression expected to be ended by a quote.") in let rec spaces n i = if i < len && str.[i] == ' ' then spaces (n+1) (i+1) else n in let rec nonspaces quoted n i = if i < len && str.[i] != ' ' then if str.[i] == '\'' && quoted && (i+1 >= len || str.[i+1] == ' ') then if Int.equal n 0 then user_err ?loc:(make_loc (i-1) i) Pp.(str "Empty quoted token.") else n else nonspaces quoted (n+1) (i+1) else if quoted then user_err ?loc:(make_loc i i) Pp.(str "Spaces are not allowed in (quoted) symbols.") else n in let rec parse_non_format i = let n = nonspaces false 0 i in push_token (make_loc i (i+n-1)) (UnpTerminal (String.sub str i n)) (parse_token 1 (i+n)) and parse_quoted n k i = if i < len then match str.[i] with (* Parse " // " *) | '/' when i+1 < len && str.[i+1] == '/' -> (* We discard the useless n spaces... *) push_token (make_loc (i-n) (i+1)) (UnpCut PpFnl) (parse_token 1 (close_quotation i (i+2))) (* Parse " .. / .. " *) | '/' when i+1 < len -> let p = spaces 0 (i+1) in push_token (make_loc (i-n) (i+p)) (UnpCut (PpBrk (n,p))) (parse_token 1 (close_quotation i (i+p+1))) | c -> (* The spaces are real spaces *) push_white (i-n-1-k) n (match c with | '[' -> if i+1 < len then match str.[i+1] with (* Parse " [h .. ", *) | 'h' when i+1 <= len && str.[i+2] == 'v' -> (parse_box i (fun n -> PpHVB n) (i+3)) (* Parse " [v .. ", *) | 'v' -> parse_box i (fun n -> PpVB n) (i+2) (* Parse " [ .. ", *) | ' ' | '\'' -> parse_box i (fun n -> PpHOVB n) (i+1) | _ -> user_err ?loc:(make_loc i i) Pp.(str "\"v\", \"hv\", \" \" expected after \"[\" in format.") else user_err ?loc:(make_loc i i) Pp.(str "\"v\", \"hv\" or \" \" expected after \"[\" in format.") (* Parse "]" *) | ']' -> ((i,[]) :: parse_token 1 (close_quotation i (i+1))) (* Parse a non formatting token *) | c -> let n = nonspaces true 0 i in push_token (make_loc i (i+n-1)) (UnpTerminal (String.sub str (i-1) (n+2))) (parse_token 1 (close_quotation i (i+n)))) else if Int.equal n 0 then [] else user_err ?loc:(make_loc (len-n) len) Pp.(str "Ending spaces non part of a format annotation.") and parse_box start box i = let n = spaces 0 i in close_box start (i+n-1) (box n) (parse_token 1 (close_quotation i (i+n))) and parse_token k i = let n = spaces 0 i in let i = i+n in if i < len then match str.[i] with (* Parse a ' *) | '\'' when i+1 >= len || str.[i+1] == ' ' -> push_white (i-n) (n-k) (push_token (make_loc i (i+1)) (UnpTerminal "'") (parse_token 1 (i+1))) (* Parse the beginning of a quoted expression *) | '\'' -> parse_quoted (n-k) k (i+1) (* Otherwise *) | _ -> push_white (i-n) (n-k) (parse_non_format i) else push_white (i-n) n [(len,[])] in if not (String.is_empty str) then match parse_token 0 0 with | [_,l] -> l | (i,_)::_ -> user_err ?loc:(make_loc i i) Pp.(str "Box closed without being opened.") | [] -> assert false else [] (** **************************************************************** **) (** Analyzing notations **) (* Find non-terminal tokens of notation *) (* To protect alphabetic tokens and quotes from being seen as variables *) let quote_notation_token x = let n = String.length x in let norm = CLexer.is_ident x in if (n > 0 && norm) || (n > 2 && x.[0] == '\'') then "'"^x^"'" else x let analyze_notation_tokens ~onlyprinting ~infix entry df = let df = if infix then quote_notation_token df else df in let { recvars; mainvars; symbols } as res = decompose_raw_notation df in (* don't check for nonlinearity if printing only, see Bug 5526 *) (if not onlyprinting then match List.duplicates Id.equal (mainvars @ List.map snd recvars) with | id :: _ -> user_err (str "Variable " ++ Id.print id ++ str " occurs more than once.") | _ -> ()); let is_prim_token = is_prim_token_constant_in_constr (entry, symbols) in res, is_prim_token let adjust_symbols vars notation_symbols = let x = Namegen.next_ident_away (Id.of_string "x") vars in let y = Namegen.next_ident_away (Id.of_string "y") (Id.Set.add x vars) in let notation_symbols = { recvars = notation_symbols.recvars; mainvars = x::notation_symbols.mainvars@[y]; symbols = NonTerminal x :: notation_symbols.symbols @ [NonTerminal y]; } in x, y, notation_symbols let adjust_reserved_infix_notation notation_symbols = let vars = Id.Set.of_list (List.map_filter (function NonTerminal x -> Some x | _ -> None) notation_symbols.symbols) in let _, _, notation_symbols = adjust_symbols vars notation_symbols in notation_symbols let adjust_infix_notation df notation_symbols c = let vars = names_of_constr_expr c in let x, y, notation_symbols = adjust_symbols vars notation_symbols in let df = Id.to_string x ^ " " ^ df ^ " " ^ Id.to_string y in let inject_var x = CAst.make @@ CRef (qualid_of_ident x,None) in let metas = [inject_var x; inject_var y] in let c = mkAppC (c,metas) in df, notation_symbols, c let warn_unexpected_primitive_token_modifier = CWarnings.create ~name:"primitive-token-modifier" ~category:CWarnings.CoreCategories.parsing (fun () -> str "Notations for numbers or strings are primitive; skipping this modifier.") let check_no_syntax_modifiers_for_numeral = function | [] -> () | l -> List.iter (function {CAst.loc} -> warn_unexpected_primitive_token_modifier ?loc ()) l let error_not_same_scope x y = user_err (str "Variables " ++ Id.print x ++ str " and " ++ Id.print y ++ str " must be in the same scope.") (** **************************************************************** **) (** Build pretty-printing rules **) let pr_notation_entry = function | InConstrEntry -> str "constr" | InCustomEntry s -> str "custom " ++ str s let side = function | BorderProd (b,_) -> Some b | _ -> None let precedence_of_position_and_level from_level = function | NumLevel n, BorderProd (b,Some a) -> let prec = let open Gramlib.Gramext in match a, b with | RightA, Left -> LevelLt n | RightA, Right -> LevelLe n | LeftA, Left -> LevelLe n | LeftA, Right -> LevelLt n | NonA, _ -> LevelLt n in {notation_subentry = InConstrEntry; notation_relative_level = prec; notation_position = Some b} | NumLevel n, b -> {notation_subentry = InConstrEntry; notation_relative_level = LevelLe n; notation_position = side b} | NextLevel, b -> {notation_subentry = InConstrEntry; notation_relative_level = LevelLt from_level; notation_position = side b} | DefaultLevel, b -> {notation_subentry = InConstrEntry; notation_relative_level = LevelSome; notation_position = side b} (** Computing precedences of non-terminals for parsing *) let precedence_of_entry_type { notation_entry = from_custom; notation_level = from_level } = function | ETConstr (custom,_,x) when notation_entry_eq custom from_custom -> (precedence_of_position_and_level from_level x).notation_relative_level | ETConstr (custom,_,(NumLevel n,_)) -> LevelLe n | ETConstr (custom,_,(NextLevel,_)) -> user_err (strbrk "\"next level\" is only for sub-expressions in the same entry as where the notation is (" ++ quote (pr_notation_entry custom) ++ strbrk " is different from " ++ quote (pr_notation_entry from_custom) ++ str ").") | ETPattern (_,n) -> let n = match n with None -> 0 | Some n -> n in LevelLe n | _ -> LevelSome (* should not matter *) let pattern_entry_level = function None -> 0 | Some n -> n (** Computing precedences for future insertion of parentheses at the time of printing using hard-wired constr levels *) let unparsing_precedence_of_entry_type from_level = function | ETConstr (InConstrEntry,_,x) -> (* Possible insertion of parentheses at printing time to deal with precedence in a constr entry is managed using [prec_less] in [ppconstr.ml] *) precedence_of_position_and_level from_level x | ETConstr (custom,_,(_,b)) -> (* Precedence of printing for a custom entry is managed using explicit insertion of entry coercions at the time of building a [constr_expr] *) {notation_subentry = custom; notation_relative_level = LevelSome; notation_position = side b} | ETPattern (_,n) -> (* in constr *) {notation_subentry = InConstrEntry; notation_relative_level = LevelLe (pattern_entry_level n); notation_position = None} | _ -> (* should not matter *) {notation_subentry = InConstrEntry; notation_relative_level = LevelSome; notation_position = None} (** Utilities for building default printing rules *) (* Some breaking examples *) (* "x = y" : "x /1 = y" (breaks before any symbol) *) (* "x =S y" : "x /1 =S /1 y" (protect from confusion; each side for symmetry)*) (* "+ {" : "+ {" may breaks reversibility without space but oth. not elegant *) (* "x y" : "x spc y" *) (* "{ x } + { y }" : "{ x } / + { y }" *) (* "< x , y > { z , t }" : "< x , / y > / { z , / t }" *) let starts_with_left_bracket s = let l = String.length s in not (Int.equal l 0) && (s.[0] == '{' || s.[0] == '[' || s.[0] == '(') let ends_with_right_bracket s = let l = String.length s in not (Int.equal l 0) && (s.[l-1] == '}' || s.[l-1] == ']' || s.[l-1] == ')') let is_left_bracket s = starts_with_left_bracket s && not (ends_with_right_bracket s) let is_right_bracket s = not (starts_with_left_bracket s) && ends_with_right_bracket s let is_comma s = let l = String.length s in not (Int.equal l 0) && (s.[0] == ',' || s.[0] == ';') let is_operator s = let l = String.length s in not (Int.equal l 0) && (s.[0] == '+' || s.[0] == '*' || s.[0] == '=' || s.[0] == '-' || s.[0] == '/' || s.[0] == '<' || s.[0] == '>' || s.[0] == '@' || s.[0] == '\\' || s.[0] == '&' || s.[0] == '~' || s.[0] == '$') let is_non_terminal = function | NonTerminal _ | SProdList _ -> true | _ -> false let is_next_non_terminal b = function | [] -> b | pr :: _ -> is_non_terminal pr let is_next_terminal = function Terminal _ :: _ -> true | _ -> false let is_next_break = function Break _ :: _ -> true | _ -> false let add_break n l = (None,UnpCut (PpBrk(n,0))) :: l let add_break_if_none n b = function | (_,UnpCut (PpBrk _)) :: _ as l -> l | [] when not b -> [] | l -> (None,UnpCut (PpBrk(n,0))) :: l let check_open_binder isopen sl m = let pr_token = function | Terminal s -> str s | Break n -> str "␣" | _ -> assert false in if isopen && not (List.is_empty sl) then user_err (str "as " ++ Id.print m ++ str " is a non-closed binder, no such \"" ++ prlist_with_sep spc pr_token sl ++ strbrk "\" is allowed to occur.") let unparsing_metavar i from typs = let x = List.nth typs (i-1) in let subentry = unparsing_precedence_of_entry_type from x in match x with | ETConstr _ | ETGlobal | ETBigint -> UnpMetaVar subentry | ETPattern _ | ETName | ETIdent -> UnpBinderMetaVar (subentry,NotQuotedPattern) | ETBinder isopen -> UnpBinderMetaVar (subentry,QuotedPattern) (** Heuristics for building default printing rules *) let index_id id l = List.index Id.equal id l let make_hunks etyps symbols from_level = let vars,typs = List.split etyps in let rec make b = function | NonTerminal m :: prods -> let i = index_id m vars in let u = unparsing_metavar i from_level typs in if is_next_non_terminal b prods then (None, u) :: add_break_if_none 1 b (make b prods) else (None, u) :: make_with_space b prods | Terminal s :: prods when (* true to simulate presence of non-terminal *) b || List.exists is_non_terminal prods -> if (is_comma s || is_operator s) then (* Always a breakable space after comma or separator *) (None, UnpTerminal s) :: add_break_if_none 1 b (make b prods) else if is_right_bracket s && is_next_terminal prods then (* Always no space after right bracked, but possibly a break *) (None, UnpTerminal s) :: add_break_if_none 0 b (make b prods) else if is_left_bracket s && is_next_non_terminal b prods then (None, UnpTerminal s) :: make b prods else if not (is_next_break prods) then (* Add rigid space, no break, unless user asked for something *) (None, UnpTerminal (s^" ")) :: make b prods else (* Rely on user spaces *) (None, UnpTerminal s) :: make b prods | Terminal s :: prods -> (* Separate but do not cut a trailing sequence of terminal *) (match prods with | Terminal _ :: _ -> (None,UnpTerminal (s^" ")) :: make b prods | _ -> (None,UnpTerminal s) :: make b prods) | Break n :: prods -> add_break n (make b prods) | SProdList (m,sl) :: prods -> let i = index_id m vars in let typ = List.nth typs (i-1) in let subentry = unparsing_precedence_of_entry_type from_level typ in let sl' = (* If no separator: add a break *) if List.is_empty sl then add_break 1 [] (* We add NonTerminal for simulation but remove it afterwards *) else make true sl in let hunk = match typ with | ETConstr _ -> UnpListMetaVar (subentry,List.map snd sl') | ETBinder isopen -> check_open_binder isopen sl m; UnpBinderListMetaVar (isopen,true,List.map snd sl') | ETName | ETIdent -> UnpBinderListMetaVar (false,true,List.map snd sl') | ETPattern _ -> UnpBinderListMetaVar (false,false,List.map snd sl') | _ -> assert false in (None, hunk) :: make_with_space b prods | [] -> [] and make_with_space b prods = match prods with | Terminal s' :: prods'-> if is_operator s' then (* A rigid space before operator and a breakable after *) (None,UnpTerminal (" "^s')) :: add_break_if_none 1 b (make b prods') else if is_comma s' then (* No space whatsoever before comma *) make b prods else if is_right_bracket s' then make b prods else (* A breakable space between any other two terminals *) add_break_if_none 1 b (make b prods) | (NonTerminal _ | SProdList _) :: _ -> (* A breakable space before a non-terminal *) add_break_if_none 1 b (make b prods) | Break _ :: _ -> (* Rely on user wish *) make b prods | [] -> [] in make false symbols (** Build default printing rules from explicit format *) let error_format ?loc () = user_err ?loc Pp.(str "The format does not match the notation.") let warn_format_break = CWarnings.create ~name:"notation-both-format-and-spaces" ~category:CWarnings.CoreCategories.parsing (fun () -> strbrk "Discarding format implicitly indicated by multiple spaces in notation because an explicit format modifier is given.") let has_ldots l = List.exists (function (_,UnpTerminal s) -> String.equal s (Id.to_string Notation_ops.ldots_var) | _ -> false) l let rec split_format_at_ldots hd = function | (loc,UnpTerminal s) :: fmt when String.equal s (Id.to_string Notation_ops.ldots_var) -> loc, List.rev hd, fmt | u :: fmt -> check_no_ldots_in_box u; split_format_at_ldots (u::hd) fmt | [] -> raise_notrace Exit and check_no_ldots_in_box = function | (_,UnpBox (_,fmt)) -> (try let loc,_,_ = split_format_at_ldots [] fmt in user_err ?loc Pp.(str ("The special symbol \"..\" must occur at the same formatting depth than the variables of which it is the ellipse.")) with Exit -> ()) | _ -> () let error_not_same ?loc () = user_err ?loc Pp.(str "The format is not the same on the right- and left-hand sides of the special token \"..\".") let find_prod_list_loc sfmt fmt = (* [fmt] is some [UnpTerminal x :: sfmt @ UnpTerminal ".." :: sfmt @ UnpTerminal y :: rest] *) if List.is_empty sfmt then (* No separators; we highlight the sequence "x .." *) Loc.merge_opt (fst (List.hd fmt)) (fst (List.hd (List.tl fmt))) else (* A separator; we highlight the separating sequence *) Loc.merge_opt (fst (List.hd sfmt)) (fst (List.last sfmt)) let is_blank s = let n = String.length s in let rec aux i s = i >= n || s.[i] = ' ' && aux (i+1) s in aux 0 s let is_formatting = function | (_,UnpCut _) -> true | (_,UnpTerminal s) -> is_blank s | _ -> false let rec is_var_in_recursive_format = function | (_,UnpTerminal s) when not (is_blank s) -> true | (loc,UnpBox (b,l)) -> (match List.filter (fun a -> not (is_formatting a)) l with | [a] -> is_var_in_recursive_format a | _ -> error_not_same ?loc ()) | _ -> false let rec check_eq_var_upto_name = function | (_,UnpTerminal s1), (_,UnpTerminal s2) when not (is_blank s1 && is_blank s2) || s1 = s2 -> () | (_,UnpBox (b1,l1)), (_,UnpBox (b2,l2)) when b1 = b2 -> List.iter check_eq_var_upto_name (List.combine l1 l2) | (_,UnpCut b1), (_,UnpCut b2) when b1 = b2 -> () | _, (loc,_) -> error_not_same ?loc () let skip_var_in_recursive_format = function | a :: sl when is_var_in_recursive_format a -> a, sl | (loc,_) :: _ -> error_not_same ?loc () | [] -> assert false let read_recursive_format sl fmt = (* Turn [[UnpTerminal s :: some-list @ UnpTerminal ".." :: same-some-list @ UnpTerminal s' :: rest] *) (* into [(some-list,rest)] *) let get_head fmt = let var,sl = skip_var_in_recursive_format fmt in try var, split_format_at_ldots [] sl with Exit -> error_not_same ?loc:(fst (List.last (if sl = [] then fmt else sl))) () in let rec get_tail = function | (loc,a) :: sepfmt, (_,b) :: fmt when (=) a b -> get_tail (sepfmt, fmt) (* FIXME *) | [], tail -> skip_var_in_recursive_format tail | (loc,_) :: _, ([] | (_,UnpTerminal _) :: _)-> error_not_same ?loc () | _, (loc,_)::_ -> error_not_same ?loc () in let var1, (loc, slfmt, fmt) = get_head fmt in let var2, res = get_tail (slfmt, fmt) in check_eq_var_upto_name (var1,var2); (* To do, though not so important: check that the names match the names in the notation *) slfmt, res let hunks_of_format (from_level,(vars,typs)) symfmt = let rec aux = function | symbs, (_,(UnpTerminal s' as u)) :: fmt when String.equal s' (String.make (String.length s') ' ') -> let symbs, l = aux (symbs,fmt) in symbs, u :: l | Terminal s :: symbs, (_,UnpTerminal s') :: fmt when String.equal s (String.drop_simple_quotes s') -> let symbs, l = aux (symbs,fmt) in symbs, UnpTerminal s :: l | NonTerminal s :: symbs, (_,UnpTerminal s') :: fmt when Id.equal s (Id.of_string s') -> let i = index_id s vars in let symbs, l = aux (symbs,fmt) in symbs, unparsing_metavar i from_level typs :: l | symbs, (_,(UnpCut _ as u)) :: fmt -> let symbs, l = aux (symbs,fmt) in symbs, u :: l | SProdList (m,sl) :: symbs, fmt when has_ldots fmt -> let i = index_id m vars in let typ = List.nth typs (i-1) in let subentry = unparsing_precedence_of_entry_type from_level typ in let loc_slfmt,rfmt = read_recursive_format sl fmt in let sl, slfmt = aux (sl,loc_slfmt) in if not (List.is_empty sl) then error_format ?loc:(find_prod_list_loc loc_slfmt fmt) (); let symbs, l = aux (symbs,rfmt) in let hunk = match typ with | ETConstr _ -> UnpListMetaVar (subentry,slfmt) | ETBinder isopen -> check_open_binder isopen sl m; UnpBinderListMetaVar (isopen,true,slfmt) | ETName | ETIdent -> UnpBinderListMetaVar (false,true,slfmt) | ETPattern _ -> UnpBinderListMetaVar (false,false,slfmt) | _ -> assert false in symbs, hunk :: l | symbs, (_,UnpBox (a,b)) :: fmt -> let symbs', b' = aux (symbs,b) in let symbs', l = aux (symbs',fmt) in symbs', UnpBox (a,List.map (fun x -> (None,x)) b') :: l | symbs, [] -> symbs, [] | Break _ :: symbs, fmt -> warn_format_break (); aux (symbs,fmt) | _, fmt -> error_format ?loc:(fst (List.hd fmt)) () in match aux symfmt with | [], l -> l | _ -> error_format () (** **************************************************************** **) (** Build parsing rules **) let assoc_of_type from n (_,typ) = precedence_of_entry_type {notation_entry = from; notation_level = n} typ let is_not_small_constr = function ETProdConstr _ -> true | _ -> false let distribute a ll = List.map (fun l -> a @ l) ll (* Expand LIST1(t,sep);sep;t;...;t (with the trailing pattern occurring p times, possibly p=0) into the combination of t;sep;t;...;t;sep;t (p+1 times) t;sep;t;...;t;sep;t;sep;t (p+2 times) ... t;sep;t;...;t;sep;t;...;t;sep;t (p+n times) t;sep;t;...;t;sep;t;...;t;sep;t;LIST1(t,sep) *) let expand_list_rule s typ tkl x n p ll = let camlp5_message_name = Some (add_suffix x ("_"^string_of_int n)) in let main = GramConstrNonTerminal (ETProdConstr (s,typ), camlp5_message_name) in let tks = List.map (fun (kw,s) -> GramConstrTerminal (kw, s)) tkl in let rec aux i hds ll = if i < p then aux (i+1) (main :: tks @ hds) ll else if Int.equal i (p+n) then let hds = GramConstrListMark (p+n,true,p) :: hds @ [GramConstrNonTerminal (ETProdConstrList (s, typ,tkl), Some x)] in distribute hds ll else distribute (GramConstrListMark (i+1,false,p) :: hds @ [main]) ll @ aux (i+1) (main :: tks @ hds) ll in aux 0 [] ll let is_constr_typ (s,lev) x etyps = match List.assoc x etyps with (* TODO: factorize these rules with the ones computing the effective sublevel sent to camlp5, so as to include the case of DefaultLevel which are valid *) | ETConstr (s',_,(lev',InternalProd | (NumLevel _ | NextLevel as lev'), _)) -> notation_entry_eq s s' && production_level_eq lev lev' | _ -> false let include_possible_similar_trailing_pattern typ etyps sl l = let rec aux n = function | Terminal s :: sl, Terminal s'::l' when s = s' -> aux n (sl,l') | [], NonTerminal x ::l' when is_constr_typ typ x etyps -> try_aux n l' | Break _ :: sl, l -> aux n (sl,l) | sl, Break _ :: l -> aux n (sl,l) | _ -> raise_notrace Exit and try_aux n l = try aux (n+1) (sl,l) with Exit -> n,l in try_aux 0 l let prod_entry_type = function | ETIdent -> ETProdIdent | ETName -> ETProdName | ETGlobal -> ETProdGlobal | ETBigint -> ETProdBigint | ETBinder o -> ETProdOneBinder o | ETConstr (s,_,p) -> ETProdConstr (s,p) | ETPattern (_,n) -> ETProdPattern (pattern_entry_level n) let keyword_needed need s = (* Ensure that IDENT articulation terminal symbols are keywords *) match Pcoq.terminal s with | Tok.PIDENT (Some k) -> if need then Flags.if_verbose Feedback.msg_info (str "Identifier '" ++ str k ++ str "' now a keyword"); need | _ -> match NumTok.Unsigned.parse_string s with | Some n -> if need then Flags.if_verbose Feedback.msg_info (str "Number '" ++ NumTok.Unsigned.print n ++ str "' now a keyword"); need | None -> match String.unquote_coq_string s with | Some _ -> if need then Flags.if_verbose Feedback.msg_info (str "String '" ++ str s ++ str "' now a keyword"); need | _ -> true let make_production ({notation_level = lev}, _) etyps symbols = let rec aux need = function | [] -> [[]] | NonTerminal m :: l -> let typ = prod_entry_type (List.assoc m etyps) in distribute [GramConstrNonTerminal (typ, Some m)] (aux (is_not_small_constr typ) l) | Terminal s :: l -> let keyword = keyword_needed need s in distribute [GramConstrTerminal (keyword,s)] (aux false l) | Break _ :: l -> aux need l | SProdList (x,sl) :: l -> let tkl = List.flatten (List.map (function Terminal s -> [s] | Break _ -> [] | _ -> anomaly (Pp.str "Found a non terminal token in recursive notation separator.")) sl) in let tkl = List.map_i (fun i x -> let need = (i=0) in (keyword_needed need x, x)) 0 tkl in match List.assoc x etyps with | ETConstr (s,_,(lev,_ as typ)) -> let p,l' = include_possible_similar_trailing_pattern (s,lev) etyps sl l in expand_list_rule s typ tkl x 1 p (aux true l') | ETBinder o -> check_open_binder o sl x; let typ = if o then (assert (tkl = []); ETBinderOpen) else ETBinderClosed (None,tkl) in distribute [GramConstrNonTerminal (ETProdBinderList typ, Some x)] (aux false l) | ETIdent -> distribute [GramConstrNonTerminal (ETProdBinderList (ETBinderClosed (Some ETProdIdent,tkl)), Some x)] (aux false l) | ETName -> distribute [GramConstrNonTerminal (ETProdBinderList (ETBinderClosed (Some ETProdName,tkl)), Some x)] (aux false l) | ETPattern (st,n) -> distribute [GramConstrNonTerminal (ETProdBinderList (ETBinderClosed (Some (ETProdPattern (pattern_entry_level n)),tkl)), Some x)] (aux false l) | _ -> user_err Pp.(str "Components of recursive patterns in notation must be terms or binders.") in let need = (* a leading ident/number factorizes iff at level 0 *) lev <> 0 in aux need symbols let rec find_symbols c_current c_next c_last = function | [] -> [] | NonTerminal id :: sl -> let prec = if not (List.is_empty sl) then c_current else c_last in (id, prec) :: (find_symbols c_next c_next c_last sl) | Terminal s :: sl -> find_symbols c_next c_next c_last sl | Break n :: sl -> find_symbols c_current c_next c_last sl | SProdList (x,_) :: sl' -> (x,c_next)::(find_symbols c_next c_next c_last sl') let border = function | (_,(ETConstr(_,_,(_,BorderProd (_,a))))) :: _ -> a | _ -> None let recompute_assoc typs = let open Gramlib.Gramext in match border typs, border (List.rev typs) with | Some LeftA, Some RightA -> assert false | Some LeftA, _ -> Some LeftA | _, Some RightA -> Some RightA | _ -> None (** ******************************************************************** **) (** Registration of syntax extensions **) (** (parsing/printing, no interpretation) **) let pr_arg_level from (lev,typ) = let pplev = function | LevelLt n when Int.equal n from -> spc () ++ str "at next level" | LevelLe n -> spc () ++ str "at level " ++ int n | LevelLt n -> spc () ++ str "at level below " ++ int n | LevelSome -> mt () in Ppvernac.pr_set_entry_type (fun _ -> (*TO CHECK*) mt()) typ ++ pplev lev let pr_level ntn ({notation_entry = from; notation_level = fromlevel}, args) typs = (match from with InConstrEntry -> mt () | InCustomEntry s -> str "in " ++ str s ++ spc()) ++ str "at level " ++ int fromlevel ++ (match args with | [] -> mt () | _ :: _ -> spc () ++ str "with arguments" ++ spc() ++ prlist_with_sep pr_comma (pr_arg_level fromlevel) (List.combine args typs)) let error_incompatible_level ntn oldprec oldtyps prec typs = user_err (str "Notation " ++ pr_notation ntn ++ str " is already defined" ++ spc() ++ pr_level ntn oldprec oldtyps ++ spc() ++ str "while it is now required to be" ++ spc() ++ pr_level ntn prec typs ++ str ".") let error_parsing_incompatible_level ntn ntn' oldprec oldtyps prec typs = user_err (str "Notation " ++ pr_notation ntn ++ str " relies on a parsing rule for " ++ pr_notation ntn' ++ spc() ++ str " which is already defined" ++ spc() ++ pr_level ntn oldprec oldtyps ++ spc() ++ str "while it is now required to be" ++ spc() ++ pr_level ntn prec typs ++ str ".") let warn_incompatible_format = CWarnings.create ~name:"notation-incompatible-format" ~category:CWarnings.CoreCategories.parsing (fun (specific,ntn) -> let head,scope = match specific with | None -> str "Notation", mt () | Some LastLonelyNotation -> str "Lonely notation", mt () | Some (NotationInScope sc) -> str "Notation", strbrk (" in scope " ^ sc) in head ++ spc () ++ pr_notation ntn ++ strbrk " was already defined with a different format" ++ scope ++ str ".") type syntax_extension = { synext_level : level; synext_nottyps : constr_entry_key list; synext_notgram : notation_grammar option; synext_notprint : generic_notation_printing_rules option; } type syntax_rules = | PrimTokenSyntax | SpecificSyntax of syntax_extension let syntax_rules_iter f = function | PrimTokenSyntax -> () | SpecificSyntax synext -> f synext let check_reserved_format ntn rules rules' = try let { notation_printing_reserved = reserved; notation_printing_rules = generic_rules } = rules in if reserved && (not (List.for_all2eq unparsing_eq rules'.notation_printing_unparsing generic_rules.notation_printing_unparsing)) then warn_incompatible_format (None,ntn) with Not_found -> () let specific_format_to_declare (specific,ntn as specific_ntn) rules = try let specific_rules = Ppextend.find_specific_notation_printing_rule specific_ntn in if not (List.for_all2eq unparsing_eq rules.notation_printing_unparsing specific_rules.notation_printing_unparsing) then (warn_incompatible_format (Some specific,ntn); true) else false with Not_found -> true type syntax_extension_obj = locality_flag * (notation * syntax_extension) let check_and_extend_constr_grammar ntn rule = try let ntn_for_grammar = rule.notgram_notation in if notation_eq ntn ntn_for_grammar then raise Not_found; let prec = rule.notgram_level in let typs = rule.notgram_typs in let oldprec = Notation.level_of_notation ntn_for_grammar in let oldparsing = try Some (Notgram_ops.grammar_of_notation ntn_for_grammar) with Not_found -> None in let oldtyps = Notgram_ops.non_terminals_of_notation ntn_for_grammar in if not (level_eq prec oldprec) && oldparsing <> None then error_parsing_incompatible_level ntn ntn_for_grammar oldprec oldtyps prec typs; if oldparsing = None then raise Not_found with Not_found -> Egramcoq.extend_constr_grammar rule let warn_prefix_incompatible_level = CWarnings.create ~name:"notation-incompatible-prefix" ~category:CWarnings.CoreCategories.parsing (fun (pref, ntn, pref_prec, pref_nottyps, prec, nottyps) -> str "Notations " ++ pr_notation pref ++ spc () ++ str "defined " ++ pr_level pref pref_prec pref_nottyps ++ spc () ++ str "and " ++ pr_notation ntn ++ spc () ++ str "defined " ++ pr_level ntn prec nottyps ++ spc () ++ str "have incompatible prefixes." ++ spc () ++ str "One of them will likely not work.") let level_firstn k (lvl, lvls) = lvl, try CList.firstn k lvls with Failure _ -> [] let check_prefix_incompatible_level ntn prec nottyps = match Notgram_ops.longest_common_prefix ntn with | None -> () | Some (pref, k) -> try let pref_prec = Notation.level_of_notation pref in let pref_prec = level_firstn k pref_prec in let prec = level_firstn k prec in let pref_nottyps = Notgram_ops.non_terminals_of_notation pref in let pref_nottyps = CList.firstn k pref_nottyps in let nottyps = CList.firstn k nottyps in if not (level_eq prec pref_prec && List.for_all2 Extend.constr_entry_key_eq nottyps pref_nottyps) then warn_prefix_incompatible_level (pref, ntn, pref_prec, pref_nottyps, prec, nottyps); with Not_found | Failure _ -> () let cache_one_syntax_extension (ntn,synext) = let prec = synext.synext_level in (* Check and ensure that the level and the precomputed parsing rule is declared *) let oldparsing = try let oldprec = Notation.level_of_notation ntn in let oldparsing = try Some (Notgram_ops.grammar_of_notation ntn) with Not_found -> None in let oldtyps = Notgram_ops.non_terminals_of_notation ntn in if not (level_eq prec oldprec && List.for_all2 Extend.constr_entry_key_eq synext.synext_nottyps oldtyps) && (oldparsing <> None || synext.synext_notgram = None) then error_incompatible_level ntn oldprec oldtyps prec synext.synext_nottyps; oldparsing with Not_found -> check_prefix_incompatible_level ntn prec synext.synext_nottyps; (* Declare the level and the precomputed parsing rule *) let () = Notation.declare_notation_level ntn prec in let () = Notgram_ops.declare_notation_non_terminals ntn synext.synext_nottyps in let () = Option.iter (Notgram_ops.declare_notation_grammar ntn) synext.synext_notgram in None in (* Declare the parsing rule *) begin match oldparsing, synext.synext_notgram with | None, Some grams -> List.iter (check_and_extend_constr_grammar ntn) grams | _ -> (* The grammars rules are canonically derived from the string and the precedence*) () end; (* Printing *) Option.iter (declare_generic_notation_printing_rules ntn) synext.synext_notprint let cache_syntax_extension (_, sy) = cache_one_syntax_extension sy let subst_syntax_extension (subst, (local, (ntn, synext))) = (local, (ntn, synext)) let classify_syntax_definition (local, _) = if local then Dispose else Substitute let open_syntax_extension i o = if Int.equal i 1 then cache_syntax_extension o let inSyntaxExtension : syntax_extension_obj -> obj = declare_object {(default_object "SYNTAX-EXTENSION") with object_stage = Summary.Stage.Synterp; open_function = simple_open ~cat:notation_cat open_syntax_extension; cache_function = cache_syntax_extension; subst_function = subst_syntax_extension; classify_function = classify_syntax_definition} (** ******************************************************************** **) (** Precedences **) (* Interpreting user-provided modifiers *) (* XXX: We could move this to the parser itself *) module NotationMods = struct type notation_modifier = { assoc : Gramlib.Gramext.g_assoc option; level : int option; etyps : (Id.t * simple_constr_prod_entry_key) list; (* common to syn_data below *) format : lstring option; } let default = { assoc = None; level = None; etyps = []; format = None; } end exception UnknownCustomEntry of string let () = CErrors.register_handler @@ function | UnknownCustomEntry entry -> Some Pp.(str "Unknown custom entry: " ++ str entry ++ str ".") | _ -> None let check_custom_entry entry = if not (Egramcoq.exists_custom_entry entry) then raise @@ UnknownCustomEntry entry let check_entry_type = function | ETConstr (InCustomEntry entry,_,_) -> check_custom_entry entry | ETConstr (InConstrEntry,_,_) | ETPattern _ | ETIdent | ETGlobal | ETBigint | ETName | ETBinder _-> () let interp_modifiers entry modl = let open NotationMods in let rec interp acc = function | [] -> acc | CAst.{loc;v} :: l -> match v with | SetEntryType (s,typ) -> let id = Id.of_string s in check_entry_type typ; if Id.List.mem_assoc id acc.etyps then user_err ?loc (str s ++ str " is already assigned to an entry or constr level."); interp { acc with etyps = (id,typ) :: acc.etyps; } l | SetItemLevel ([],bko,n) -> interp acc l | SetItemLevel (s::idl,bko,n) -> let id = Id.of_string s in if Id.List.mem_assoc id acc.etyps then user_err ?loc (str s ++ str " is already assigned to an entry or constr level."); interp { acc with etyps = (id,ETConstr (entry,bko,n)) :: acc.etyps } ((CAst.make ?loc @@ SetItemLevel (idl,bko,n))::l) | SetLevel n -> (match entry with | InCustomEntry s -> if acc.level <> None then user_err ?loc (str ("isolated \"at level " ^ string_of_int n ^ "\" unexpected.")) else user_err ?loc (str ("use \"in custom " ^ s ^ " at level " ^ string_of_int n ^ "\"") ++ spc () ++ str "rather than" ++ spc () ++ str ("\"at level " ^ string_of_int n ^ "\"") ++ spc () ++ str "isolated.") | InConstrEntry -> if acc.level <> None then user_err ?loc (str "A level is already assigned."); interp { acc with level = Some n; } l) | SetCustomEntry (s,Some n) -> (* Note: name of entry already registered in interp_non_syntax_modifiers *) if acc.level <> None then user_err ?loc (str ("isolated \"at level " ^ string_of_int (Option.get acc.level) ^ "\" unexpected.")); interp { acc with level = Some n } l | SetAssoc a -> if not (Option.is_empty acc.assoc) then user_err ?loc Pp.(str "An associativity is given more than once."); interp { acc with assoc = Some a; } l | SetOnlyParsing | SetOnlyPrinting | SetCustomEntry (_,None) | SetFormat _ | SetItemScope _ -> (* interpreted in interp_non_syntax_modifiers *) assert false in interp default modl let check_useless_entry_types recvars mainvars etyps = let vars = let (l1,l2) = List.split recvars in l1@l2@mainvars in match List.filter (fun (x,etyp) -> not (List.mem x vars)) etyps with | (x,_)::_ -> user_err (Id.print x ++ str " is unbound in the notation.") | _ -> () type notation_main_data = { onlyparsing : bool; onlyprinting : bool; user_warns : UserWarn.t option; entry : notation_entry; format : unparsing Loc.located list option; itemscopes : (Id.t * scope_name) list; } let warn_only_parsing_reserved_notation = CWarnings.create ~name:"irrelevant-reserved-notation-only-parsing" ~category:CWarnings.CoreCategories.parsing (fun () -> strbrk "The only parsing modifier has no effect in Reserved Notation.") let warn_only_parsing_discarded_format = CWarnings.create ~name:"discarded-format-only-parsing" ~category:CWarnings.CoreCategories.parsing (fun () -> strbrk "The format modifier has no effect for only-parsing notations.") let error_onlyparsing_onlyprinting ?loc = user_err ?loc (str "A notation cannot be both \"only printing\" and \"only parsing\".") let set_onlyparsing ?loc ~reserved main_data = if reserved then (warn_only_parsing_reserved_notation ?loc (); main_data) else (if main_data.onlyparsing then user_err ?loc (str "\"only parsing\" is given more than once."); if main_data.onlyprinting then error_onlyparsing_onlyprinting ?loc; { main_data with onlyparsing = true }) let set_onlyprinting ?loc main_data = if main_data.onlyprinting then user_err ?loc (str "\"only printing\" is given more than once."); if main_data.onlyparsing then error_onlyparsing_onlyprinting ?loc; { main_data with onlyprinting = true } let set_custom_entry ?loc main_data entry' = check_custom_entry entry'; match main_data.entry with | InConstrEntry -> { main_data with entry = InCustomEntry entry' } | _ -> user_err ?loc (str "\"in custom\" is given more than once.") let warn_irrelevant_format = CWarnings.create ~name:"irrelevant-format-only-parsing" ~category:CWarnings.CoreCategories.parsing (fun () -> str "The format modifier is irrelevant for only-parsing rules.") let set_format ?loc main_data format = if not (Option.is_empty main_data.format) then user_err ?loc Pp.(str "A format is given more than once."); let format = if main_data.onlyparsing then (warn_irrelevant_format ?loc (); None) else Some (parse_format format) in { main_data with format } let set_item_scope ?loc main_data ids sc = let itemscopes = List.map (fun id -> (Id.of_string id,sc)) ids @ main_data.itemscopes in match List.duplicates (fun (id1,_) (id2,_) -> Id.equal id1 id2) itemscopes with | (id,_)::_ -> user_err ?loc (str "Notation scope for argument " ++ Id.print id ++ str " can be specified only once.") | [] -> { main_data with itemscopes } let interp_non_syntax_modifiers ~reserved ~infix ~abbrev user_warns mods = let set (main_data,rest) = CAst.with_loc_val (fun ?loc -> function | SetOnlyParsing -> if not (Option.is_empty main_data.format) then (warn_only_parsing_discarded_format ?loc (); (main_data, rest)) else (set_onlyparsing ?loc ~reserved main_data,rest) | SetOnlyPrinting when not abbrev -> (set_onlyprinting ?loc main_data,rest) | SetCustomEntry (entry,None) when not abbrev -> (set_custom_entry ?loc main_data entry,rest) | SetCustomEntry (entry,Some _) as x when not abbrev -> (set_custom_entry main_data entry,CAst.make ?loc x :: rest) | SetEntryType _ when infix -> user_err ?loc Pp.(str "Unexpected entry type in infix notation.") | SetItemLevel _ when infix -> user_err ?loc Pp.(str "Unexpected entry level in infix notation.") | SetFormat (TextFormat s) when not abbrev -> (set_format ?loc main_data s, rest) | SetItemScope (ids,sc) -> (set_item_scope ?loc main_data ids sc, rest) | modif -> (main_data,(CAst.make ?loc modif)::rest)) in let main_data = { onlyparsing = false; onlyprinting = false; user_warns; entry = InConstrEntry; format = None; itemscopes = [] } in let main_data, rest = List.fold_left set (main_data,[]) mods in main_data, List.rev rest (* Compute precedences from modifiers (or find default ones) *) let set_entry_type from n etyps (x,typ) = let make_lev n s = match typ with | BorderProd _ -> NumLevel n | InternalProd -> DefaultLevel in let typ = try match List.assoc x etyps, typ with | ETConstr (s,bko,DefaultLevel), _ -> if notation_entry_eq from s then ETConstr (s,bko,(make_lev n s,typ)) else ETConstr (s,bko,(DefaultLevel,typ)) | ETConstr (s,bko,n), BorderProd (left,_) -> ETConstr (s,bko,(n,BorderProd (left,None))) | ETConstr (s,bko,n), InternalProd -> ETConstr (s,bko,(n,InternalProd)) | ETPattern (b,n), _ -> ETPattern (b,n) | (ETIdent | ETName | ETBigint | ETGlobal | ETBinder _ as x), _ -> x with Not_found -> ETConstr (from,None,(make_lev n from,typ)) in (x,typ) let join_auxiliary_recursive_types recvars etyps = List.fold_right (fun (x,y) typs -> let xtyp = try Some (List.assoc x etyps) with Not_found -> None in let ytyp = try Some (List.assoc y etyps) with Not_found -> None in match xtyp,ytyp with | None, None -> typs | Some _, None -> typs | None, Some ytyp -> (x,ytyp)::typs | Some xtyp, Some ytyp when (=) xtyp ytyp -> typs (* FIXME *) | Some xtyp, Some ytyp -> user_err (strbrk "In " ++ Id.print x ++ str " .. " ++ Id.print y ++ strbrk ", both ends have incompatible types.")) recvars etyps let internalization_type_of_entry_type = function | ETBinder _ | ETConstr (_,Some _,_) -> NtnInternTypeOnlyBinder | ETConstr (_,None,_) | ETBigint | ETGlobal | ETIdent | ETName | ETPattern _ -> NtnInternTypeAny None let make_internalization_vars recvars maintyps = let maintyps = List.map (on_snd internalization_type_of_entry_type) maintyps in let extratyps = List.map (fun (x,y) -> (y,List.assoc x maintyps)) recvars in maintyps @ extratyps let make_interpretation_type isrec isbinding default_if_binding typ = match typ, isrec with (* Parsed as constr, but interpreted as a specific kind of binder *) | ETConstr (_,Some bk,_), true -> NtnTypeBinderList (NtnBinderParsedAsConstr bk) | ETConstr (_,Some bk,_), false -> NtnTypeBinder (NtnBinderParsedAsConstr bk) (* Parsed as constr list but interpreted as the default kind of binder *) | ETConstr (_,None,_), true when isbinding -> NtnTypeBinderList (NtnBinderParsedAsConstr default_if_binding) | ETConstr (_,None,_), false when isbinding -> NtnTypeBinder (NtnBinderParsedAsConstr default_if_binding) (* Parsed as constr, interpreted as constr *) | ETConstr (_,None,_), true -> NtnTypeConstrList | ETConstr (_,None,_), false -> NtnTypeConstr (* Different way of parsing binders, maybe interpreted also as constr, but conventionally internally binders *) | ETIdent, true -> NtnTypeBinderList (NtnBinderParsedAsSomeBinderKind AsIdent) | ETIdent, false -> NtnTypeBinder (NtnBinderParsedAsSomeBinderKind AsIdent) | ETName, true -> NtnTypeBinderList (NtnBinderParsedAsSomeBinderKind AsName) | ETName, false -> NtnTypeBinder (NtnBinderParsedAsSomeBinderKind AsName) (* Parsed as ident/pattern, primarily interpreted as binder; maybe strict at printing *) | ETPattern (ppstrict,_), true -> NtnTypeBinderList (NtnBinderParsedAsSomeBinderKind (if ppstrict then AsStrictPattern else AsAnyPattern)) | ETPattern (ppstrict,_), false -> NtnTypeBinder (NtnBinderParsedAsSomeBinderKind (if ppstrict then AsStrictPattern else AsAnyPattern)) | ETBinder _, true -> NtnTypeBinderList NtnBinderParsedAsBinder | ETBinder _, false -> NtnTypeBinder NtnBinderParsedAsBinder (* Others *) | ETBigint, true | ETGlobal, true -> NtnTypeConstrList | ETBigint, false | ETGlobal, false -> NtnTypeConstr let entry_relative_level_of_constr_prod_entry from_level = function | ETConstr (entry,_,(_,y)) as x -> let side = match y with BorderProd (side,_) -> Some side | _ -> None in { notation_subentry = entry; notation_relative_level = precedence_of_entry_type from_level x; notation_position = side } | _ -> constr_some_level let make_interpretation_vars (* For binders, default is to parse only as an ident *) ?(default_if_binding=AsName) recvars allvars (entry,_) typs = let eq_subscope (sc1, l1) (sc2, l2) = List.equal String.equal sc1 sc2 && List.equal String.equal l1 l2 in let check (x, y) = let (_,scope1,_ntn_binding_ids1) = Id.Map.find x allvars in let (_,scope2,_ntn_binding_ids2) = Id.Map.find y allvars in if not (eq_subscope scope1 scope2) then error_not_same_scope x y (* Note: binding_ids should currently be the same, and even with eventually more complex notations, such as e.g. Notation "!! x .. y , P .. Q" := (fun x => (P, .. (fun y => (Q, True)) ..)). each occurrence of the recursive notation variables may have its own binders *) in let () = List.iter check recvars in let useless_recvars = List.map snd recvars in let mainvars = Id.Map.filter (fun x _ -> not (Id.List.mem x useless_recvars)) allvars in Id.Map.mapi (fun x (isonlybinding, sc, ntn_binding_ids) -> let typ = Id.List.assoc x typs in ((entry_relative_level_of_constr_prod_entry entry typ, sc), ntn_binding_ids, make_interpretation_type (Id.List.mem_assoc x recvars) isonlybinding default_if_binding typ)) mainvars let check_rule_productivity l = if List.for_all (function NonTerminal _ | Break _ -> true | _ -> false) l then user_err Pp.(str "A notation must include at least one symbol."); if (match l with SProdList _ :: _ -> true | _ -> false) then user_err Pp.(str "A recursive notation must start with at least one symbol.") let warn_notation_bound_to_variable = CWarnings.create ~name:"notation-bound-to-variable" ~category:CWarnings.CoreCategories.parsing (fun () -> strbrk "This notation will not be used for printing as it is bound to a single variable.") let warn_non_reversible_notation = CWarnings.create ~name:"non-reversible-notation" ~category:CWarnings.CoreCategories.parsing (function[@warning "+9"] | APrioriReversible -> assert false | Forgetful { forget_ltac=ltac; forget_volatile_cast=cast; } -> let what = (if ltac then ["Ltac expressions"] else []) @ (if cast then ["volatile casts"] else []) in strbrk "This notation contains " ++ prlist_with_sep (fun () -> strbrk " and ") str what ++ str ":" ++ spc() ++ str "it will not be used for printing." | NonInjective ids -> let n = List.length ids in strbrk (String.plural n "Variable") ++ spc () ++ pr_enum Id.print ids ++ spc () ++ strbrk (if n > 1 then "do" else "does") ++ str " not occur in the right-hand side." ++ spc() ++ strbrk "The notation will not be used for printing as it is not reversible.") let is_coercion level typs = match level, typs with | Some ({notation_entry = custom; notation_level = n} as entry,_), [_,e] -> (match e, custom with | ETConstr _, _ -> let entry_relative = entry_relative_level_of_constr_prod_entry entry e in if is_coercion entry entry_relative then Some (IsEntryCoercion (entry,entry_relative)) else None | ETGlobal, InCustomEntry s -> Some (IsEntryGlobal (s,n)) | ETIdent, InCustomEntry s -> Some (IsEntryIdent (s,n)) | _ -> None) | Some _, _ -> assert false | None, _ -> None let printability level typs vars onlyparsing reversibility = function | NVar id when reversibility = APrioriReversible && List.mem_assoc_f Id.equal id vars -> let coe = is_coercion level typs in let onlyparsing = if not onlyparsing && Option.is_empty coe then (warn_notation_bound_to_variable (); true) else onlyparsing in onlyparsing, coe | _ -> (if not onlyparsing && reversibility <> APrioriReversible then (warn_non_reversible_notation reversibility; true) else onlyparsing),None let warn_closed_notation_not_level_0 = CWarnings.create ~name:"closed-notation-not-level-0" ~category:CWarnings.CoreCategories.parsing (fun () -> strbrk "Closed notations (i.e. starting and ending with a \ terminal symbol) should usually be at level 0 \ (default).") let warn_postfix_notation_not_level_1 = CWarnings.create ~name:"postfix-notation-not-level-1" ~category:CWarnings.CoreCategories.parsing (fun () -> strbrk "Postfix notations (i.e. starting with a \ nonterminal symbol and ending with a terminal \ symbol) should usually be at level 1 (default).") let find_precedence custom lev etyps symbols onlyprint = let first_symbol = let rec aux = function | Break _ :: t -> aux t | h :: t -> Some h | [] -> None in aux symbols in let last_is_terminal () = let rec aux b = function | Break _ :: t -> aux b t | Terminal _ :: t -> aux true t | _ :: t -> aux false t | [] -> b in aux false symbols in match first_symbol with | None -> [],0 | Some (NonTerminal x) -> let msgs, lev = match last_is_terminal (), lev with | false, _ -> [], lev | true, None -> [fun () -> Flags.if_verbose (Feedback.msg_info ?loc:None) (strbrk "Setting postfix notation at level 1.")], Some 1 | true, Some 1 -> [], Some 1 | true, Some n -> [fun () -> warn_postfix_notation_not_level_1 ()], Some n in let test () = if onlyprint then if Option.is_empty lev then user_err Pp.(str "Explicit level needed in only-printing mode when the level of the leftmost non-terminal is given.") else msgs,Option.get lev else user_err Pp.(str "The level of the leftmost non-terminal cannot be changed.") in (try match List.assoc x etyps, custom with | ETConstr (s,_,(NumLevel _ | NextLevel)), s' when s = s' -> test () | (ETIdent | ETName | ETBigint | ETGlobal), _ -> begin match lev with | None -> ([fun () -> Flags.if_verbose (Feedback.msg_info ?loc:None) (strbrk "Setting notation at level 0.")],0) | Some 0 -> (msgs,0) | _ -> user_err Pp.(str "A notation starting with an atomic expression must be at level 0.") end | (ETPattern _ | ETBinder _), InConstrEntry when not onlyprint -> (* Don't know exactly if we can make sense of this case *) user_err Pp.(str "Binders or patterns not supported in leftmost position.") | (ETPattern _ | ETBinder _ | ETConstr _), _ -> (* Give a default ? *) if Option.is_empty lev then user_err Pp.(str "Need an explicit level.") else msgs,Option.get lev with Not_found -> if Option.is_empty lev then user_err Pp.(str "A left-recursive notation must have an explicit level.") else msgs,Option.get lev) | Some (Terminal _) when last_is_terminal () -> begin match lev with | None -> [fun () -> Flags.if_verbose (Feedback.msg_info ?loc:None) (strbrk "Setting notation at level 0.")], 0 | Some 0 -> [], 0 | Some n -> [fun () -> warn_closed_notation_not_level_0 ()], n end | Some _ -> if Option.is_empty lev then user_err Pp.(str "Cannot determine the level."); [],Option.get lev let check_curly_brackets_notation_exists () = try let _ = Notation.level_of_notation (InConstrEntry,"{ _ }") in () with Not_found -> user_err Pp.(str "Notations involving patterns of the form \"{ _ }\" are treated \n\ specially and require that the notation \"{ _ }\" is already reserved.") (* Remove patterns of the form "{ _ }", unless it is the "{ _ }" notation *) let remove_curly_brackets l = let rec skip_break acc = function | Break _ as br :: l -> skip_break (br::acc) l | l -> List.rev acc, l in let rec aux deb = function | [] -> [] | Terminal "{" as t1 :: l -> let br,next = skip_break [] l in (match next with | NonTerminal _ as x :: l' -> let br',next' = skip_break [] l' in (match next' with | Terminal "}" as t2 :: l'' -> if deb && List.is_empty l'' then [t1;x;t2] else begin check_curly_brackets_notation_exists (); x :: aux false l'' end | l1 -> t1 :: br @ x :: br' @ aux false l1) | l0 -> t1 :: aux false l0) | x :: l -> x :: aux false l in aux true l let has_implicit_format symbols = List.exists (function Break _ -> true | _ -> false) symbols (* Because of the special treatment for { }, the grammar rule sent to the parser may be different than what the user sees; e.g. for "{ A } + { B }", it is "A + B" which is sent to the parser *) type syn_pa_data = { ntn_for_grammar : notation; prec_for_grammar : level; typs_for_grammar : constr_entry_key list; need_squash : bool; } module SynData = struct type subentry_types = (Id.t * constr_entry_key) list (* XXX: Document *) type syn_data = { (* XXX: Callback to printing, must remove *) msgs : (unit -> unit) list; (* Notation data for parsing *) level : level; subentries : subentry_types; pa_syntax_data : subentry_types * symbol list; pp_syntax_data : subentry_types * symbol list; not_data : syn_pa_data; } end let find_subentry_types from n assoc etyps symbols = let typs = find_symbols (BorderProd(Left,assoc)) (InternalProd) (BorderProd(Right,assoc)) symbols in let sy_typs = List.map (set_entry_type from n etyps) typs in let prec = List.map (assoc_of_type from n) sy_typs in sy_typs, prec let check_locality_compatibility local custom i_typs = if not local then let subcustom = List.map_filter (function _,ETConstr (InCustomEntry s,_,_) -> Some s | _ -> None) i_typs in let allcustoms = match custom with InCustomEntry s -> s::subcustom | _ -> subcustom in List.iter (fun s -> if Egramcoq.locality_of_custom_entry s then user_err (strbrk "Notation has to be declared local as it depends on custom entry " ++ str s ++ strbrk " which is local.")) (List.uniquize allcustoms) let longest_common_prefix_level ntn = Notgram_ops.longest_common_prefix ntn |> Option.map (fun (ntn, sz) -> let level, levels = level_firstn sz (Notation.level_of_notation ntn) in ntn, level.notation_level, levels) let default_prefix_level ntn_prefix = let with_prefix prefix level = Flags.if_verbose Feedback.msg_info (strbrk "Setting notation at level " ++ int level ++ spc () ++ str "to match previous notation with longest common prefix:" ++ spc () ++ str "\"" ++ str (snd prefix) ++ str "\"."); level in function Some n -> Some n | None -> Option.map (fun (prefix, level, _) -> with_prefix prefix level) ntn_prefix let default_prefix_level_subentries ntn ntn_prefix symbols etyps = let with_prefix prefix from_level levels = let default_entry etyps (x, l) = let l' = match l with | LevelLt n when Int.equal n from_level -> NextLevel | LevelLe n | LevelLt n -> NumLevel n | LevelSome -> DefaultLevel in let e = List.assoc_opt x etyps |> Option.default (ETConstr (fst ntn, None, DefaultLevel)) in match l', e with | (NumLevel _ | NextLevel), ETConstr (n, b, DefaultLevel) -> Flags.if_verbose Feedback.msg_info (strbrk "Setting " ++ Id.print x ++ str " " ++ pr_arg_level from_level (l, e) ++ spc () ++ str "to match previous notation with longest common prefix:" ++ spc () ++ str "\"" ++ str (snd prefix) ++ str "\"."); (x, ETConstr (n, b, l')) :: List.remove_assoc x etyps | _ -> etyps in let levels = let rec aux levs symbs = match levs, symbs with | [], _ | _, [] | _, SProdList _ :: _ -> [] (* not handling recursive notations *) | _, (Terminal _ | Break _) :: symbs -> aux levs symbs | l :: levs, NonTerminal x :: symbs -> (x, l) :: aux levs symbs in match levels, symbols with (* don't mess up with level of left border terminal *) | _ :: levs, NonTerminal _ :: symbs | levs, symbs -> aux levs symbs in List.fold_left default_entry etyps levels in match ntn_prefix with | None -> etyps | Some (prefix, from_level, levels) -> with_prefix prefix from_level levels let compute_syntax_data ~local main_data notation_symbols ntn mods = let open SynData in let open NotationMods in if main_data.itemscopes <> [] then user_err (str "General notations don't support 'in scope'."); let {recvars;mainvars;symbols} = notation_symbols in let assoc = Option.append mods.assoc (Some Gramlib.Gramext.NonA) in let _ = check_useless_entry_types recvars mainvars mods.etyps in (* Notations for interp and grammar *) let ntn_prefix = longest_common_prefix_level ntn in let level = default_prefix_level ntn_prefix mods.level in let msgs,n = find_precedence main_data.entry level mods.etyps symbols main_data.onlyprinting in let symbols_for_grammar = if main_data.entry = InConstrEntry then remove_curly_brackets symbols else symbols in let need_squash = not (List.equal Notation.symbol_eq symbols symbols_for_grammar) in let ntn_for_grammar = if need_squash then make_notation_key main_data.entry symbols_for_grammar else ntn in if main_data.entry = InConstrEntry && not main_data.onlyprinting then check_rule_productivity symbols_for_grammar; (* To globalize... *) let etyps = default_prefix_level_subentries ntn ntn_prefix symbols mods.etyps in let etyps = join_auxiliary_recursive_types recvars etyps in let sy_typs, prec = find_subentry_types main_data.entry n assoc etyps symbols in let sy_typs_for_grammar, prec_for_grammar = if need_squash then find_subentry_types main_data.entry n assoc etyps symbols_for_grammar else sy_typs, prec in check_locality_compatibility local main_data.entry sy_typs; let pa_sy_data = (sy_typs_for_grammar,symbols_for_grammar) in let pp_sy_data = (sy_typs,symbols) in let sy_fulldata = { ntn_for_grammar; prec_for_grammar = ({notation_entry = main_data.entry; notation_level = n}, prec_for_grammar); typs_for_grammar = List.map snd sy_typs_for_grammar; need_squash } in (* Return relevant data for interpretation and for parsing/printing *) { msgs; level = ({notation_entry = main_data.entry; notation_level = n}, prec); subentries = sy_typs; pa_syntax_data = pa_sy_data; pp_syntax_data = pp_sy_data; not_data = sy_fulldata; } (** **************************************************************** **) (** Registration of notation interpretation **) type notation_obj = { notobj_local : bool; notobj_scope : scope_name option; notobj_interp : interpretation; notobj_coercion : entry_coercion_kind option; notobj_use : notation_use option; notobj_user_warns : UserWarn.t option; notobj_notation : notation * notation_location; notobj_specific_pp_rules : notation_printing_rules option; } let load_notation_common silently_define_scope_if_undefined _ nobj = (* When the default shall be to require that a scope already exists *) (* the call to ensure_scope will have to be removed *) if silently_define_scope_if_undefined then (* Don't warn if the scope is not defined: *) (* there was already a warning at "cache" time *) Option.iter Notation.declare_scope nobj.notobj_scope else Option.iter Notation.ensure_scope nobj.notobj_scope let load_notation = load_notation_common true let open_notation i nobj = if Int.equal i 1 then begin let scope = nobj.notobj_scope in let (ntn, df) = nobj.notobj_notation in let pat = nobj.notobj_interp in let user_warns = nobj.notobj_user_warns in 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 user_warns | None -> ()); (* Declare specific format if any *) (match nobj.notobj_specific_pp_rules with | Some pp_sy -> if specific_format_to_declare (scope,ntn) pp_sy then Ppextend.declare_specific_notation_printing_rules (scope,ntn) pp_sy | None -> ()) end let cache_notation o = load_notation_common false 1 o; open_notation 1 o let subst_notation (subst, nobj) = { nobj with notobj_interp = subst_interpretation subst nobj.notobj_interp; } let classify_notation nobj = if nobj.notobj_local then Dispose else Substitute let inNotation : notation_obj -> obj = declare_object {(default_object "NOTATION") with open_function = simple_open ~cat:notation_cat open_notation; cache_function = cache_notation; subst_function = subst_notation; load_function = load_notation; classify_function = classify_notation} (**********************************************************************) (* Registration of interpretation scopes opening/closing *) let open_scope i (local,op,sc) = if Int.equal i 1 then if op then Notation.open_scope sc else Notation.close_scope sc let cache_scope o = open_scope 1 o let subst_scope (subst,sc) = sc let discharge_scope (local,_,_ as o) = if local then None else Some o let classify_scope (local,_,_) = if local then Dispose else Substitute let inScope : bool * bool * scope_name -> obj = declare_object {(default_object "SCOPE") with cache_function = cache_scope; open_function = simple_open ~cat:notation_cat open_scope; subst_function = subst_scope; discharge_function = discharge_scope; classify_function = classify_scope } let open_close_scope local ~to_open sc = Lib.add_leaf (inScope (local,to_open,normalize_scope sc)) (**********************************************************************) let with_lib_stk_protection f x = let fs = Lib.Interp.freeze () in try let a = f x in Lib.Interp.unfreeze fs; a with reraise -> let reraise = Exninfo.capture reraise in let () = Lib.Interp.unfreeze fs in Exninfo.iraise reraise let with_syntax_protection f x = with_lib_stk_protection (Pcoq.with_grammar_rule_protection (with_notation_protection f)) x (** **************************************************************** **) (** Recovering existing syntax **) exception NoSyntaxRule let recover_notation_syntax ntn = try let prec = Notation.level_of_notation ntn in let pa_typs = Notgram_ops.non_terminals_of_notation ntn in let pa_rule = try Some (Notgram_ops.grammar_of_notation ntn) with Not_found -> None in let pp_rule = try Some (find_generic_notation_printing_rule ntn) with Not_found -> None in { synext_level = prec; synext_nottyps = pa_typs; synext_notgram = pa_rule; synext_notprint = pp_rule; } with Not_found -> raise NoSyntaxRule let recover_squash_syntax sy = let sq = recover_notation_syntax (InConstrEntry,"{ _ }") in match sq.synext_notgram with | Some gram -> sy :: gram | None -> raise NoSyntaxRule (** **************************************************************** **) (** Main entry point for building parsing and printing rules **) let make_pa_rule (typs,symbols) parsing_data = let { ntn_for_grammar; prec_for_grammar; typs_for_grammar; need_squash } = parsing_data in let assoc = recompute_assoc typs in let prod = make_production prec_for_grammar typs symbols in let sy = { notgram_level = prec_for_grammar; notgram_assoc = assoc; notgram_notation = ntn_for_grammar; notgram_prods = prod; notgram_typs = typs_for_grammar; } in (* By construction, the rule for "{ _ }" is declared, but we need to redeclare it because the file where it is declared needs not be open when the current file opens (especially in presence of -nois) *) if need_squash then recover_squash_syntax sy else [sy] let make_pp_rule level (typs,symbols) fmt = match fmt with | None -> let hunks = make_hunks typs symbols level in if List.exists (function _,(UnpCut (PpBrk _) | UnpListMetaVar _) -> true | _ -> false) hunks then [UnpBox (PpHOVB 0,hunks)] else (* Optimization to work around what seems an ocaml Format bug (see Mantis #7804/#7807) *) List.map snd hunks (* drop locations which are dummy *) | Some fmt -> hunks_of_format (level, List.split typs) (symbols, fmt) let make_parsing_rules main_data (sd : SynData.syn_data) = let open SynData in if main_data.onlyprinting then None else Some (make_pa_rule sd.pa_syntax_data sd.not_data) (** **************************************************************** **) (** Main functions about notations **) let make_generic_printing_rules reserved main_data ntn sd = let open SynData in let {notation_entry = custom; notation_level = level},_ = sd.level in let make_rule rule = { notation_printing_reserved = reserved; notation_printing_rules = { notation_printing_unparsing = rule; notation_printing_level = level; } } in try let rules = (Ppextend.find_generic_notation_printing_rule ntn) in match main_data.format with | None when not (has_implicit_format (snd sd.pp_syntax_data)) -> (* No intent to define a format, we reuse the existing generic rules *) Some rules | _ -> if not reserved && main_data.onlyprinting then (* No intent to define a generic format *) Some rules else let rules' = make_rule (make_pp_rule level sd.pp_syntax_data main_data.format) in let () = check_reserved_format ntn rules rules'.notation_printing_rules in Some rules' with Not_found -> Some (make_rule (make_pp_rule level sd.pp_syntax_data main_data.format)) let make_syntax_rules reserved main_data ntn sd = let open SynData in (* Prepare the parsing and printing rules *) let pa_rules = make_parsing_rules main_data sd in let pp_rules = make_generic_printing_rules reserved main_data ntn sd in { synext_level = sd.level; synext_nottyps = List.map snd sd.subentries; synext_notgram = pa_rules; synext_notprint = pp_rules; } (**********************************************************************) (* Main entry point for building specific printing rules *) let make_specific_printing_rules etyps symbols level pp_rule format = match level with | None -> None | Some ({ notation_level = level},_) -> match format, pp_rule with | None, Some _ when not (has_implicit_format symbols) -> None | _ -> Some { notation_printing_unparsing = make_pp_rule level (etyps,symbols) format; notation_printing_level = level; } (**********************************************************************) (* Miscellaneous *) let warn_unused_interpretation = CWarnings.create ~name:"unused-notation" ~category:CWarnings.CoreCategories.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 *) let make_notation_interpretation ~local main_data notation_symbols ntn syntax_rules df env ?(impls=empty_internalization_env) c scope = let {recvars;mainvars;symbols} = notation_symbols in (* Recover types of variables and pa/pp rules; redeclare them if needed *) let level, i_typs, main_data, sy_pp_rules = match syntax_rules with | PrimTokenSyntax -> None, [], main_data, None | SpecificSyntax sy -> (* If the only printing flag has been explicitly requested, put it back *) let main_data = { main_data with onlyprinting = main_data.onlyprinting || (sy.synext_notgram = None && not main_data.onlyparsing) } in Some sy.synext_level, List.combine mainvars sy.synext_nottyps, main_data, sy.synext_notprint in (* Declare interpretation *) let sy_pp_rules = make_specific_printing_rules i_typs symbols level sy_pp_rules main_data.format in let path = (Lib.library_dp(), Lib.current_dirpath true) in let df' = ntn, (path,df) in let i_vars = make_internalization_vars recvars i_typs in let nenv = { ninterp_var_type = Id.Map.of_list i_vars; ninterp_rec_vars = Id.Map.of_list recvars; } in let (acvars, ac, reversibility) = interp_notation_constr env ~impls nenv c in let plevel = match level with Some (entry,l) -> (entry,l) | None (* numeral: irrelevant )*) -> (constr_lowest_level,[]) in let interp = make_interpretation_vars recvars acvars plevel i_typs in let map (x, _) = try Some (x, Id.Map.find x interp) with Not_found -> None in let vars = List.map_filter map i_vars in (* Order of elements is important here! *) let onlyparsing,coe = printability level i_typs vars main_data.onlyparsing reversibility ac in let main_data = { main_data with onlyparsing } in let use = make_use false onlyparsing main_data.onlyprinting in { notobj_local = local; notobj_scope = scope; notobj_use = use; notobj_interp = (vars, ac); notobj_coercion = coe; notobj_user_warns = main_data.user_warns; notobj_notation = df'; notobj_specific_pp_rules = sy_pp_rules; } (* Notations without interpretation (Reserved Notation) *) let add_reserved_notation ~local ~infix ({CAst.loc;v=df},mods) = let open SynData in let (main_data,mods) = interp_non_syntax_modifiers ~reserved:true ~infix ~abbrev:false None mods in let mods = interp_modifiers main_data.entry mods in let notation_symbols, is_prim_token = analyze_notation_tokens ~onlyprinting:main_data.onlyprinting ~infix main_data.entry df in let notation_symbols = if infix then adjust_reserved_infix_notation notation_symbols else notation_symbols in let ntn = make_notation_key main_data.entry notation_symbols.symbols in if is_prim_token then user_err ?loc (str "Notations for numbers or strings are primitive and need not be reserved."); let sd = compute_syntax_data ~local main_data notation_symbols ntn mods in let synext = make_syntax_rules true main_data ntn sd in List.iter (fun f -> f ()) sd.msgs; Lib.add_leaf (inSyntaxExtension(local,(ntn,synext))) type notation_interpretation_decl = notation_declaration * notation_main_data * notation_symbols * notation * syntax_rules (* Notations associated to a where clause *) let prepare_where_notation ntn_decl = let { ntn_decl_string = { CAst.loc ; v = df }; ntn_decl_interp = c; ntn_decl_modifiers = modifiers; ntn_decl_scope = sc; } = ntn_decl in let (main_data,mods) = interp_non_syntax_modifiers ~reserved:false ~infix:false ~abbrev:false None modifiers in match mods with | _::_ -> CErrors.user_err (str"Only modifiers not affecting parsing are supported here.") | [] -> let notation_symbols, is_prim_token = analyze_notation_tokens ~onlyprinting:main_data.onlyprinting ~infix:false main_data.entry df in let ntn = make_notation_key main_data.entry notation_symbols.symbols in let syntax_rules = if is_prim_token then PrimTokenSyntax else try SpecificSyntax (recover_notation_syntax ntn) with NoSyntaxRule -> user_err Pp.(str "Parsing rule for this notation has to be previously declared.") in (ntn_decl, main_data, notation_symbols, ntn, syntax_rules) let add_notation_interpretation ~local env (ntn_decl, main_data, notation_symbols, ntn, syntax_rules) = let { ntn_decl_string = { CAst.loc ; v = df }; ntn_decl_interp = c; ntn_decl_scope = sc } = ntn_decl in let notation = make_notation_interpretation ~local main_data notation_symbols ntn syntax_rules df env c sc in Lib.add_leaf (inNotation notation); Dumpglob.dump_notation (CAst.make ?loc ntn) sc true (* interpreting a where clause *) let set_notation_for_interpretation env impls (ntn_decl, main_data, notation_symbols, ntn, syntax_rules) = let { ntn_decl_string = { CAst.loc ; v = df }; ntn_decl_interp = c; ntn_decl_scope = sc } = ntn_decl in let notation = make_notation_interpretation ~local:true main_data notation_symbols ntn syntax_rules df env ~impls c sc in Lib.add_leaf (inNotation notation); Option.iter (fun sc -> Lib.add_leaf (inScope (false,true,sc))) sc let build_notation_syntax ~local ~infix user_warns ntn_decl = let { ntn_decl_string = {CAst.loc;v=df}; ntn_decl_modifiers = modifiers; ntn_decl_interp = c } = ntn_decl in (* Extract the modifiers not affecting the parsing rule *) let (main_data,syntax_modifiers) = interp_non_syntax_modifiers ~reserved:false ~infix ~abbrev:false user_warns modifiers in (* Extract the modifiers not affecting the parsing rule *) let notation_symbols, is_prim_token = analyze_notation_tokens ~onlyprinting:main_data.onlyprinting ~infix main_data.entry df in (* Add variables on both sides if an infix notation *) let df, notation_symbols, c = if infix then adjust_infix_notation df notation_symbols c else df, notation_symbols, c in (* Build the canonical identifier of the syntactic part of the notation *) let ntn = make_notation_key main_data.entry notation_symbols.symbols in let syntax_rules = if is_prim_token then (check_no_syntax_modifiers_for_numeral syntax_modifiers; PrimTokenSyntax) else match syntax_modifiers with | [] -> (* No syntax data: try to rely on a previously declared rule *) (try SpecificSyntax (recover_notation_syntax ntn) with NoSyntaxRule -> (* Try to determine a default syntax rule *) let sd = compute_syntax_data ~local main_data notation_symbols ntn NotationMods.default in SpecificSyntax (make_syntax_rules false main_data ntn sd)) | _ -> let mods = interp_modifiers main_data.entry syntax_modifiers in let sd = compute_syntax_data ~local main_data notation_symbols ntn mods in SpecificSyntax (make_syntax_rules false main_data ntn sd) in main_data, notation_symbols, ntn, syntax_rules, c, df let add_notation_syntax ~local ~infix user_warns ntn_decl = (* Build or rebuild the syntax rules *) let main_data, notation_symbols, ntn, syntax_rules, c, df = build_notation_syntax ~local ~infix user_warns ntn_decl in (* Declare syntax *) syntax_rules_iter (fun sy -> Lib.add_leaf (inSyntaxExtension (local,(ntn,sy)))) syntax_rules; let ntn_decl_string = CAst.make ?loc:ntn_decl.ntn_decl_string.CAst.loc df in let ntn_decl = { ntn_decl with ntn_decl_interp = c; ntn_decl_string } in ntn_decl, main_data, notation_symbols, ntn, syntax_rules (** **************************************************************** **) (** Scopes, delimiters and classes bound to scopes **) type scope_command = | ScopeDeclare | ScopeDelimAdd of string | ScopeDelimRemove | ScopeClasses of add_scope_where option * scope_class list let load_scope_command_common silently_define_scope_if_undefined _ (local,scope,o) = let declare_scope_if_needed = if silently_define_scope_if_undefined then Notation.declare_scope else Notation.ensure_scope in match o with | ScopeDeclare -> Notation.declare_scope scope (* When the default shall be to require that a scope already exists *) (* the call to declare_scope_if_needed will have to be removed below *) | ScopeDelimAdd dlm -> declare_scope_if_needed scope | ScopeDelimRemove -> declare_scope_if_needed scope | ScopeClasses _ -> declare_scope_if_needed scope let load_scope_command = load_scope_command_common true let open_scope_command i (noexport,scope,o) = if Int.equal i 1 then match o with | ScopeDeclare -> () | ScopeDelimAdd dlm -> Notation.declare_delimiters scope dlm | ScopeDelimRemove -> Notation.remove_delimiters scope | ScopeClasses (where, cl) -> let local = Lib.sections_are_opened () in List.iter (Notation.declare_scope_class local scope ?where) cl let cache_scope_command o = load_scope_command_common false 1 o; open_scope_command 1 o let subst_scope_command (subst,(noexport,scope,o as x)) = match o with | ScopeClasses (where, cl) -> let env = Global.env () in let cl' = List.map_filter (subst_scope_class env subst) cl in let cl' = if List.for_all2eq (==) cl cl' then cl else cl' in noexport, scope, ScopeClasses (where, cl') | _ -> x let classify_scope_command (noexport, _, _) = if noexport then Dispose else Substitute let inScopeCommand : locality_flag * scope_name * scope_command -> obj = declare_object {(default_object "DELIMITERS") with cache_function = cache_scope_command; open_function = simple_open ~cat:notation_cat open_scope_command; load_function = load_scope_command; subst_function = subst_scope_command; classify_function = classify_scope_command} let declare_scope local scope = Lib.add_leaf (inScopeCommand(local,scope,ScopeDeclare)) let add_delimiters local scope key = Lib.add_leaf (inScopeCommand(local,scope,ScopeDelimAdd key)) let remove_delimiters local scope = Lib.add_leaf (inScopeCommand(local,scope,ScopeDelimRemove)) let add_class_scope local scope where cl = Lib.add_leaf (inScopeCommand(local,scope,ScopeClasses (where, cl))) let interp_abbreviation_modifiers user_warns modl = let mods, skipped = interp_non_syntax_modifiers ~reserved:false ~infix:false ~abbrev:true user_warns modl in if skipped <> [] then (let modifier = List.hd skipped in user_err ?loc:modifier.CAst.loc (str "Abbreviations don't support " ++ Ppvernac.pr_syntax_modifier modifier)); (mods.onlyparsing, mods.itemscopes) let add_abbreviation ~local user_warns env ident (vars,c) modl = let (only_parsing, scopes) = interp_abbreviation_modifiers user_warns modl in let vars = List.map (fun v -> v, List.assoc_opt v scopes) vars in let acvars,pat,reversibility = match vars, intern_name_alias c with | [], Some(r,u) -> (* Check if abbreviation to a name and avoid early insertion of maximal implicit arguments *) Id.Map.empty, NRef(r, u), APrioriReversible | _ -> let fold accu (id,scope) = Id.Map.add id (NtnInternTypeAny scope) accu in let i_vars = List.fold_left fold Id.Map.empty vars in let nenv = { ninterp_var_type = i_vars; ninterp_rec_vars = Id.Map.empty; } in interp_notation_constr env nenv c in let level_arg = NumLevel 9 (* level of arguments of an application *) in let in_pat (id,_) = (id,ETConstr (Constrexpr.InConstrEntry,None,(level_arg,InternalProd))) in let level = (* not relevant *) (constr_lowest_level,[]) in let interp = make_interpretation_vars ~default_if_binding:AsAnyPattern [] acvars level (List.map in_pat vars) in let vars = List.map (fun (x,_) -> (x, Id.Map.find x interp)) vars in let onlyparsing = only_parsing || fst (printability None [] vars false reversibility pat) in Abbreviation.declare_abbreviation ~local user_warns ident ~onlyparsing (vars,pat) (**********************************************************************) (* Activating/deactivating notations *) let load_notation_toggle _ _ = () let open_notation_toggle _ (local,(on,all,pat)) = let env = Global.env () in let sigma = Evd.from_env env in toggle_notations ~on ~all ~verbose:(not !Flags.quiet) (Constrextern.without_symbols (Printer.pr_glob_constr_env env sigma)) pat let cache_notation_toggle o = load_notation_toggle 1 o; open_notation_toggle 1 o let subst_notation_toggle (subst,(local,(on,all,pat))) = let {notation_entry_pattern; interp_rule_key_pattern; use_pattern; scope_pattern; interpretation_pattern} = pat in let interpretation_pattern = Option.map (subst_interpretation subst) interpretation_pattern in let interp_rule_key_pattern = interp_rule_key_pattern in (local,(on,all,{notation_entry_pattern; interp_rule_key_pattern; use_pattern; scope_pattern; interpretation_pattern})) let classify_notation_toggle (local,_) = if local then Dispose else Substitute let inNotationActivation : locality_flag * (bool * bool * notation_query_pattern) -> obj = declare_object {(default_object "NOTATION-TOGGLE") with cache_function = cache_notation_toggle; open_function = simple_open open_notation_toggle; load_function = load_notation_toggle; subst_function = subst_notation_toggle; classify_function = classify_notation_toggle} let declare_notation_toggle local ~on ~all s = Lib.add_leaf (inNotationActivation (local,(on,all,s))) (** **************************************************************** **) (** Declaration of custom entries **) let warn_custom_entry = CWarnings.create ~name:"custom-entry-overridden" ~category:CWarnings.CoreCategories.parsing (fun s -> strbrk "Custom entry " ++ str s ++ strbrk " has been overridden.") let load_custom_entry _ (local,s) = if Egramcoq.exists_custom_entry s then warn_custom_entry s else Egramcoq.create_custom_entry ~local s let cache_custom_entry o = load_custom_entry 1 o let subst_custom_entry (subst,x) = x let classify_custom_entry (local,s) = if local then Dispose else Substitute let inCustomEntry : locality_flag * string -> obj = declare_object {(default_object "CUSTOM-ENTRIES") with object_stage = Summary.Stage.Synterp; cache_function = cache_custom_entry; load_function = load_custom_entry; subst_function = subst_custom_entry; classify_function = classify_custom_entry} let declare_custom_entry local s = if Egramcoq.exists_custom_entry s then user_err Pp.(str "Custom entry " ++ str s ++ str " already exists.") else Lib.add_leaf (inCustomEntry (local,s)) coq-8.20.0/vernac/metasyntax.mli000066400000000000000000000064271466560755400165740ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* infix:bool -> UserWarn.t option -> notation_declaration -> notation_interpretation_decl (** Add syntax rules for a (constr) notation in the environment *) val add_notation_interpretation : local:bool -> env -> notation_interpretation_decl -> unit (** Declare the interpretation of a notation *) (** Declaring scopes, delimiter keys and default scopes *) val declare_scope : locality_flag -> scope_name -> unit val add_delimiters : locality_flag -> scope_name -> string -> unit val remove_delimiters : locality_flag -> scope_name -> unit val add_class_scope : locality_flag -> scope_name -> add_scope_where option -> scope_class list -> unit (** Scope opening *) val open_close_scope : locality_flag -> to_open:bool -> scope_name -> unit (** Add a notation interpretation associated to a "where" clause (already has pa/pp rules) *) val prepare_where_notation : notation_declaration -> notation_interpretation_decl (** Interpret the modifiers of a where-notation *) val set_notation_for_interpretation : env -> Constrintern.internalization_env -> notation_interpretation_decl -> unit (** Set the interpretation of the where-notation for interpreting a mutual block *) (** Add only the parsing/printing rule of a notation *) val add_reserved_notation : local:bool -> infix:bool -> (lstring * syntax_modifier CAst.t list) -> unit (** Add a syntactic definition (as in "Notation f := ...") *) val add_abbreviation : local:bool -> UserWarn.t option -> env -> Id.t -> Id.t list * constr_expr -> syntax_modifier CAst.t list -> unit (** Print the Camlp5 state of a grammar *) val pr_grammar : string list -> Pp.t val pr_custom_grammar : string -> Pp.t val pr_keywords : unit -> Pp.t val with_syntax_protection : ('a -> 'b) -> 'a -> 'b val declare_notation_toggle : locality_flag -> on:bool -> all:bool -> Notation.notation_query_pattern -> unit val declare_custom_entry : locality_flag -> string -> unit (** Declare given string as a custom grammar entry *) val check_custom_entry : string -> unit (** Check that the given string is a valid custom entry that has been declared *) val pr_level : Constrexpr.notation -> Notationextern.level -> Extend.constr_entry_key list -> Pp.t (** Pretty print level information of a notation and all of its arguments *) coq-8.20.0/vernac/mltop.ml000066400000000000000000000410351466560755400153530ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* None (* Fl_split.in_words is not exported *) let fl_split_in_words s = (* splits s in words separated by commas and/or whitespace *) let l = String.length s in let rec split i j = if j < l then match s.[j] with | (' '|'\t'|'\n'|'\r'|',') -> if i split i (j+1) else if i try fst (Findlib.package_property_2 ("plugin"::preds) lib "archive") with Not_found -> "" in fl_split_in_words archive |> List.map (Findlib.resolve_path ~base) (* We register errors at for Dynlink and Findlib, it is possible to do so Symtable too, as we used to do in the bytecode init code. *) let () = CErrors.register_handler (function | Dynlink.Error msg -> Some (hov 0 (str "Dynlink error: " ++ str (Dynlink.error_message msg))) | Fl_package_base.No_such_package(p,msg) -> let paths = Findlib.search_path () in Some (hov 0 (str "Findlib error: " ++ str p ++ str " not found in:" ++ cut () ++ v 0 (prlist_with_sep cut str paths) ++ fnl() ++ str msg)) | _ -> None ) end module PluginSpec : sig type t (* Main constructor, takes the format used in Declare ML Module *) val of_declare_ml_format : string -> t (* repr/unrepr are internal and only needed for the summary and other low-level stuff *) val repr : t -> string option * string val unrepr : string option * string -> t (* Load a plugin, low-level, that is to say, will directly call the loading mechanism in OCaml/findlib *) val load : t -> unit (* Compute a digest, a findlib library name have more than one plugin .cmxs, however this is not the case in Coq. Maybe we should strengthen this invariant. *) val digest : t -> Digest.t list val pp : t -> string module Set : CSet.S with type elt = t module Map : CMap.ExtS with type key = t and module Set := Set end = struct type t = { file : string option; lib : string } module Errors = struct let plugin_name_should_contain_dot m = CErrors.user_err Pp.(str Format.(asprintf "%s is not a valid plugin name anymore." m) ++ spc() ++ str "Plugins should be loaded using their public name" ++ spc () ++ str "according to findlib, for example package-name.foo and not " ++ str "foo_plugin.") let plugin_name_invalid_format m = CErrors.user_err Pp.(str Format.(asprintf "%s is not a valid plugin name." m) ++ spc () ++ str "It should be a public findlib name, e.g. package-name.foo," ++ spc () ++ str "or a legacy name followed by a findlib public name, e.g. "++ spc () ++ str "legacy_plugin:package-name.plugin.") end let legacy_mapping = Core_plugins_findlib_compat.legacy_to_findlib let of_declare_ml_format m = match String.split_on_char ':' m with | [file] when List.mem_assoc file legacy_mapping -> { file = Some file; lib = String.concat "." ("coq-core" :: List.assoc file legacy_mapping) } | [x] when not (Fl_internals.validate_lib_name x) -> Errors.plugin_name_should_contain_dot m | [ file; lib ] -> { file = Some file; lib } | [ lib ] -> { file = None; lib } | [] -> assert false | _ :: _ :: _ -> Errors.plugin_name_invalid_format m (* Adds the corresponding extension .cmo/.cma or .cmxs. Dune and coq_makefile byte plugins do differ in the choice of extension, hence the probing. *) let select_plugin_version base = if Sys.(backend_type = Native) then base ^ ".cmxs" else let name = base ^ ".cmo" in if System.is_in_path !coq_mlpath_copy name then name else base ^ ".cma" let load = function | { file = None; lib } -> Fl_dynload.load_packages [lib] | { file = Some file; lib } -> let file = select_plugin_version file in let _, gname = System.find_file_in_path ~warn:false !coq_mlpath_copy file in Dynlink.loadfile gname; Findlib.(record_package Record_load) lib let digest s = match s with | { file = Some file; _ } -> let file = select_plugin_version file in let _, gname = System.find_file_in_path ~warn:false !coq_mlpath_copy file in [Digest.file gname] | { file = None; lib } -> let plugins = Fl_internals.fl_find_plugins lib in List.map Digest.file plugins let repr { file; lib } = ( file, lib ) let unrepr ( file, lib ) = { file; lib } let compare { lib = l1; _ } { lib = l2; _ } = String.compare l1 l2 let pp = function | { file = None; lib } -> lib | { file = Some file; lib } -> let file = select_plugin_version file in Filename.basename file ^ " (using legacy method)" module Self = struct type nonrec t = t let compare = compare end module Set = CSet.Make(Self) module Map = CMap.Make(Self) end (* If there is a toplevel under Coq *) type toplevel = { load_plugin : PluginSpec.t -> unit (** Load a findlib library, given by public name *) ; load_module : string -> unit (** Load a cmxs / cmo module, used by the native compiler to load objects *) ; add_dir : string -> unit (** Adds a dir to the module search path *) ; ml_loop : ?init_file:string -> unit -> unit (** Run the OCaml toplevel with given initialisation file *) } (* Determines the behaviour of Coq with respect to ML files (compiled or not) *) type kind_load = | WithTop of toplevel | WithoutTop (* Must be always initialized *) let load = ref WithoutTop (* Sets and initializes a toplevel (if any) *) let set_top toplevel = load := WithTop toplevel; Nativelib.load_obj := toplevel.load_module (* Removes the toplevel (if any) *) let remove () = load := WithoutTop; Nativelib.load_obj := (fun x -> () : string -> unit) (* Tests if an Ocaml toplevel runs under Coq *) let is_ocaml_top () = match !load with | WithTop _ -> true |_ -> false (* Tests if we can load ML files *) let has_dynlink = Coq_config.has_natdynlink || not Sys.(backend_type = Native) (* Runs the toplevel loop of Ocaml *) let ocaml_toploop ?init_file () = match !load with | WithTop t -> t.ml_loop ?init_file () | _ -> () let ml_load p = match !load with | WithTop t -> t.load_plugin p | WithoutTop -> PluginSpec.load p let load_module x = match !load with | WithTop t -> t.load_module x | WithoutTop -> () (* Adds a path to the ML paths *) let add_ml_dir s = match !load with | WithTop t -> t.add_dir s; keep_copy_mlpath s | WithoutTop when has_dynlink -> keep_copy_mlpath s | _ -> () (** Is the ML code of the standard library placed into loadable plugins or statically compiled into coqtop ? For the moment this choice is made according to the presence of native dynlink : even if bytecode coqtop could always load plugins, we prefer to have uniformity between bytecode and native versions. *) (* [known_loaded_module] contains the names of the loaded ML modules * (linked or loaded with load_object). It is used not to load a * module twice. It is NOT the list of ML modules Coq knows. *) (* TODO: Merge known_loaded_module and known_loaded_plugins *) let known_loaded_modules : PluginSpec.Set.t ref = ref PluginSpec.Set.empty let add_known_module mname = if not (PluginSpec.Set.mem mname !known_loaded_modules) then known_loaded_modules := PluginSpec.Set.add mname !known_loaded_modules let module_is_known mname = PluginSpec.Set.mem mname !known_loaded_modules let plugin_is_known mname = PluginSpec.Set.mem mname !known_loaded_modules (** Init time functions *) let initialized_plugins = Summary.ref ~stage:Synterp ~name:"inited-plugins" PluginSpec.Set.empty let plugin_init_functions : (unit -> unit) list PluginSpec.Map.t ref = ref PluginSpec.Map.empty let add_init_function name f = let name = PluginSpec.of_declare_ml_format name in if PluginSpec.Set.mem name !initialized_plugins then CErrors.anomaly Pp.(str "Not allowed to add init function for already initialized plugin " ++ str (PluginSpec.pp name)); plugin_init_functions := PluginSpec.Map.update name (function | None -> Some [f] | Some g -> Some (f::g)) !plugin_init_functions (** Registering functions to be used at caching time, that is when the Declare ML module command is issued. *) let cache_objs = ref PluginSpec.Map.empty let declare_cache_obj f name = let name = PluginSpec.of_declare_ml_format name in let objs = try PluginSpec.Map.find name !cache_objs with Not_found -> [] in let objs = f :: objs in cache_objs := PluginSpec.Map.add name objs !cache_objs let perform_cache_obj name = let objs = try PluginSpec.Map.find name !cache_objs with Not_found -> [] in let objs = List.rev objs in List.iter (fun f -> f ()) objs (** ml object = ml module or plugin *) let dinit = CDebug.create ~name:"mltop-init" () let init_ml_object mname = if PluginSpec.Set.mem mname !initialized_plugins then dinit Pp.(fun () -> str "already initialized " ++ str (PluginSpec.pp mname)) else begin dinit Pp.(fun () -> str "initing " ++ str (PluginSpec.pp mname)); let n = match PluginSpec.Map.find mname !plugin_init_functions with | l -> List.iter (fun f -> f()) (List.rev l); List.length l | exception Not_found -> 0 in initialized_plugins := PluginSpec.Set.add mname !initialized_plugins; dinit Pp.(fun () -> str "finished initing " ++ str (PluginSpec.pp mname) ++ str " (" ++ int n ++ str " init functions)") end let load_ml_object mname = ml_load mname; add_known_module mname; init_ml_object mname let add_known_module name = let name = PluginSpec.of_declare_ml_format name in add_known_module name let module_is_known mname = let mname = PluginSpec.of_declare_ml_format mname in module_is_known mname (* Summary of declared ML Modules *) (* List and not String.Set because order is important: most recent first. *) let loaded_modules = ref [] let get_loaded_modules () = List.rev !loaded_modules (* XXX: It seems this should be part of trigger_ml_object, and moreover we should check the guard there *) let add_loaded_module md = if not (List.mem md !loaded_modules) then loaded_modules := md :: !loaded_modules let reset_loaded_modules () = loaded_modules := [] let if_verbose_load verb f name = if not verb then f name else let info = str "[Loading ML file " ++ str (PluginSpec.pp name) ++ str " ..." in try let path = f name in Feedback.msg_info (info ++ str " done]"); path with reraise -> Feedback.msg_info (info ++ str " failed]"); raise reraise (** Load a module for the first time (i.e. dynlink it) or simulate its reload (i.e. doing nothing except maybe an initialization function). *) let trigger_ml_object ~verbose ~cache ~reinit plugin = let () = if plugin_is_known plugin then (if reinit then init_ml_object plugin) else begin if not has_dynlink then CErrors.user_err (str "Dynamic link not supported (module " ++ str (PluginSpec.pp plugin) ++ str ").") else if_verbose_load (verbose && not !Flags.quiet) load_ml_object plugin end in add_loaded_module plugin; if cache then perform_cache_obj plugin let unfreeze_ml_modules x = reset_loaded_modules (); List.iter (fun name -> let name = PluginSpec.unrepr name in trigger_ml_object ~verbose:false ~cache:false ~reinit:false name) x let () = Summary.declare_ml_modules_summary { stage = Summary.Stage.Synterp ; Summary.freeze_function = (fun () -> get_loaded_modules () |> List.map PluginSpec.repr) ; Summary.unfreeze_function = unfreeze_ml_modules ; Summary.init_function = reset_loaded_modules } (* Liboject entries of declared ML Modules *) type ml_module_object = { mlocal : Vernacexpr.locality_flag ; mnames : PluginSpec.t list ; mdigests : Digest.t list } let cache_ml_objects mnames = let iter obj = trigger_ml_object ~verbose:true ~cache:true ~reinit:true obj in List.iter iter mnames let load_ml_objects _ {mnames; _} = let iter obj = trigger_ml_object ~verbose:true ~cache:false ~reinit:true obj in List.iter iter mnames let classify_ml_objects {mlocal=mlocal} = if mlocal then Libobject.Dispose else Libobject.Substitute let inMLModule : ml_module_object -> Libobject.obj = let open Libobject in declare_object {(default_object "ML-MODULE") with object_stage = Summary.Stage.Synterp; cache_function = (fun _ -> ()); load_function = load_ml_objects; subst_function = (fun (_,o) -> o); classify_function = classify_ml_objects } let declare_ml_modules local l = let mnames = List.map PluginSpec.of_declare_ml_format l in if Lib.sections_are_opened() then CErrors.user_err Pp.(str "Cannot Declare ML Module while sections are opened."); (* List.concat_map only available in 4.10 *) let mdigests = List.map PluginSpec.digest mnames |> List.concat in Lib.add_leaf (inMLModule {mlocal=local; mnames; mdigests}); (* We can't put this in cache_function: it may declare other objects, and when the current module is required we want to run the ML-MODULE object before them. *) cache_ml_objects mnames let print_ml_path () = let l = !coq_mlpath_copy in str"ML Load Path:" ++ fnl () ++ str" " ++ hv 0 (prlist_with_sep fnl str l) (* Printing of loaded ML modules *) let print_ml_modules () = let l = get_loaded_modules () in str"Loaded ML Modules: " ++ pr_vertical_list str (List.map PluginSpec.pp l) let print_gc () = let stat = Gc.stat () in let msg = str "minor words: " ++ real stat.Gc.minor_words ++ fnl () ++ str "promoted words: " ++ real stat.Gc.promoted_words ++ fnl () ++ str "major words: " ++ real stat.Gc.major_words ++ fnl () ++ str "minor_collections: " ++ int stat.Gc.minor_collections ++ fnl () ++ str "major_collections: " ++ int stat.Gc.major_collections ++ fnl () ++ str "heap_words: " ++ int stat.Gc.heap_words ++ fnl () ++ str "heap_chunks: " ++ int stat.Gc.heap_chunks ++ fnl () ++ str "live_words: " ++ int stat.Gc.live_words ++ fnl () ++ str "live_blocks: " ++ int stat.Gc.live_blocks ++ fnl () ++ str "free_words: " ++ int stat.Gc.free_words ++ fnl () ++ str "free_blocks: " ++ int stat.Gc.free_blocks ++ fnl () ++ str "largest_free: " ++ int stat.Gc.largest_free ++ fnl () ++ str "fragments: " ++ int stat.Gc.fragments ++ fnl () ++ str "compactions: " ++ int stat.Gc.compactions ++ fnl () ++ str "top_heap_words: " ++ int stat.Gc.top_heap_words ++ fnl () ++ str "stack_size: " ++ int stat.Gc.stack_size in hv 0 msg coq-8.20.0/vernac/mltop.mli000066400000000000000000000103151466560755400155210ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* string option * string val pp : t -> string end type toplevel = { load_plugin : PluginSpec.t -> unit (** Load a findlib library, given by public name *) ; load_module : string -> unit (** Load a cmxs / cmo module, used by the native compiler to load objects *) ; add_dir : string -> unit (** Adds a dir to the module search path *) ; ml_loop : ?init_file:string -> unit -> unit (** Run the OCaml toplevel with given addtitional initialisation file *) } (** Sets and initializes a toplevel (if any) *) val set_top : toplevel -> unit (** Low level module loading, for the native compiler and similar users. *) val load_module : string -> unit (** Removes the toplevel (if any) *) val remove : unit -> unit (** Tests if an Ocaml toplevel runs under Coq *) val is_ocaml_top : unit -> bool (** Starts the Ocaml toplevel loop *) val ocaml_toploop : ?init_file:string -> unit -> unit (** {5 ML Dynlink} *) (** Adds a dir to the plugin search path, this also extends OCamlfind's search path *) val add_ml_dir : string -> unit (** Tests if we can load ML files *) val has_dynlink : bool val module_is_known : string -> bool (** {5 Initialization functions} *) (** Declare a plugin which has been linked. A plugin is a findlib library name. Usually, this will be called automatically when use do [DECLARE PLUGIN "pkg.lib"] in the .mlg file. The main effect is that dynlink will not be attempted for this plugin, so eg if it was statically linked Coq will not try and fail to find the cmxs. *) val add_known_module : string -> unit (* EJGA: Todo, this could take a PluginSpec.t at some point *) (** Declare a initialization function. The initialization function is called in Declare ML Module, including reruns after backtracking over it (either interactive backtrack, module closing backtrack, Require of a file with Declare ML Module). *) val add_init_function : string -> (unit -> unit) -> unit (** Register a callback that will be called when the module is declared with the Declare ML Module command. This is useful to define Coq objects at that time only. Several functions can be defined for one module; they will be called in the order of declaration, and after the ML module has been properly initialized. Unlike the init functions it does not run after closing a module or Requiring a file which contains the Declare ML Module. This allows to have effects which depend on the module when command was run in, eg add a named libobject which will use it for the prefix. *) val declare_cache_obj : (unit -> unit) -> string -> unit (** {5 Declaring modules} *) (** Implementation of the [Declare ML Module] vernacular command. *) val declare_ml_modules : Vernacexpr.locality_flag -> string list -> unit (** {5 Utilities} *) val print_ml_path : unit -> Pp.t val print_ml_modules : unit -> Pp.t val print_gc : unit -> Pp.t coq-8.20.0/vernac/opaques.ml000066400000000000000000000137561466560755400157060ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* anomaly (Pp.str "Context is used only internally.") let pr_params pr_c (xl,(c,t)) = hov 2 (prlist_with_sep sep pr_lident xl ++ spc() ++ (if c then str":>" else str":" ++ spc() ++ pr_c t)) let rec factorize = function | [] -> [] | (c,(idl,t))::l -> match factorize l with | (xl,((c', t') as r))::l' when (c : bool) == c' && (=) t t' -> (* FIXME: we need equality on constr_expr *) (idl@xl,r)::l' | l' -> (idl,(c,t))::l' let pr_ne_params_list pr_c l = match factorize l with | [p] -> pr_params pr_c p | l -> prlist_with_sep spc (fun p -> hov 1 (str "(" ++ pr_params pr_c p ++ str ")")) l (* prlist_with_sep pr_semicolon (pr_params pr_c) *) let pr_thm_token k = keyword (string_of_theorem_kind k) let pr_syntax_modifier = let open Gramlib.Gramext in CAst.with_val (function | SetItemLevel (l,bko,n) -> prlist_with_sep sep_v2 str l ++ spc () ++ pr_at_level n ++ pr_opt pr_constr_as_binder_kind bko | SetItemScope (l,s) -> prlist_with_sep sep_v2 str l ++ spc () ++ str"in scope" ++ str s | SetLevel n -> pr_at_level (NumLevel n) | SetCustomEntry (s,n) -> keyword "in" ++ spc() ++ keyword "custom" ++ spc() ++ str s ++ (match n with None -> mt () | Some n -> pr_at_level (NumLevel n)) | SetAssoc LeftA -> keyword "left associativity" | SetAssoc RightA -> keyword "right associativity" | SetAssoc NonA -> keyword "no associativity" | SetEntryType (x,typ) -> str x ++ spc() ++ pr_set_simple_entry_type typ | SetOnlyPrinting -> keyword "only printing" | SetOnlyParsing -> keyword "only parsing" | SetFormat (TextFormat s) -> keyword "format " ++ pr_ast qs s) let pr_syntax_modifiers = function | [] -> mt() | l -> spc() ++ hov 1 (str"(" ++ prlist_with_sep sep_v2 pr_syntax_modifier l ++ str")") let pr_notation_declaration ntn_decl = let open Vernacexpr in let { ntn_decl_string = {CAst.loc;v=ntn}; ntn_decl_interp = c; ntn_decl_modifiers = modifiers; ntn_decl_scope = scopt } = ntn_decl in qs ntn ++ spc () ++ str ":=" ++ spc () ++ Flags.without_option Flags.beautify pr_constr c ++ pr_syntax_modifiers modifiers ++ pr_opt (fun sc -> spc () ++ str ":" ++ spc () ++ str sc) scopt let pr_where_notation decl_ntn = fnl () ++ keyword "where " ++ pr_notation_declaration decl_ntn let pr_rec_definition { fname; univs; rec_order; binders; rtype; body_def; notations } = let pr_pure_lconstr c = Flags.without_option Flags.beautify pr_lconstr c in let annot = pr_guard_annot pr_lconstr_expr binders rec_order in pr_ident_decl (fname,univs) ++ pr_binders_arg binders ++ annot ++ pr_type_option (fun c -> spc() ++ pr_lconstr_expr c) rtype ++ pr_opt (fun def -> str":=" ++ brk(1,2) ++ pr_pure_lconstr def) body_def ++ prlist pr_where_notation notations let pr_statement head (idpl,(bl,c)) = hov 2 (head ++ spc() ++ pr_ident_decl idpl ++ spc() ++ (match bl with [] -> mt() | _ -> pr_binders bl ++ spc()) ++ str":" ++ pr_spc_lconstr c) let pr_rew_rule (ubinders, lhs, rhs) = let binders = match ubinders with None -> mt() | _ -> pr_universe_decl ubinders ++ spc() ++ str"|-" in let pr_pure_lconstr c = Flags.without_option Flags.beautify pr_lconstr c in binders ++ pr_pure_lconstr lhs ++ str"==>" ++ pr_pure_lconstr rhs (**************************************) (* Pretty printer for vernac commands *) (**************************************) let pr_constrarg c = spc () ++ pr_constr c let pr_lconstrarg c = spc () ++ pr_lconstr c let pr_intarg n = spc () ++ int n let pr_vernac_attributes = function | [] -> mt () | flags -> str "#[" ++ prlist_with_sep pr_comma Attributes.pr_vernac_flag flags ++ str "]" ++ spc () let pr_oc coe ins = match coe, ins with | NoCoercion, NoInstance -> str" :" | AddCoercion, NoInstance -> str" :>" | NoCoercion, BackInstance -> str" ::" | AddCoercion, BackInstance -> str" ::>" | _, BackInstanceWarning -> str" :>" (* remove this line at end of deprecation phase *) let pr_record_field (x, { rfu_attrs = attr ; rfu_coercion = coe ; rfu_instance = ins ; rfu_priority = pri ; rfu_notation = ntn }) = let prx = match x with | AssumExpr (id,binders,t) -> hov 1 (pr_vernac_attributes attr ++ pr_lname id ++ pr_binders_arg binders ++ spc() ++ pr_oc coe ins ++ spc() ++ pr_lconstr_expr t) | DefExpr(id,binders,b,opt) -> (match opt with | Some t -> hov 1 (pr_vernac_attributes attr ++ pr_lname id ++ pr_binders_arg binders ++ spc() ++ pr_oc coe ins ++ spc() ++ pr_lconstr_expr t ++ str" :=" ++ pr_lconstr b) | None -> hov 1 (pr_vernac_attributes attr ++ pr_lname id ++ str" :=" ++ spc() ++ pr_lconstr b)) in let prpri = match pri with None -> mt() | Some i -> str "| " ++ int i in prx ++ prpri ++ prlist pr_where_notation ntn let pr_record_decl c fs obinder = pr_opt pr_lident c ++ pr_record "{" "}" pr_record_field fs ++ pr_opt (fun id -> str "as " ++ pr_lident id) obinder let pr_printable = function | PrintFullContext -> keyword "Print All" | PrintSectionContext s -> keyword "Print Section" ++ spc() ++ Libnames.pr_qualid s | PrintGrammar ent -> keyword "Print Grammar" ++ spc() ++ prlist_with_sep spc str ent | PrintCustomGrammar ent -> keyword "Print Custom Grammar" ++ spc() ++ str ent | PrintKeywords -> keyword "Print Keywords" | PrintLoadPath dir -> keyword "Print LoadPath" ++ pr_opt DirPath.print dir | PrintLibraries -> keyword "Print Libraries" | PrintMLLoadPath -> keyword "Print ML Path" | PrintMLModules -> keyword "Print ML Modules" | PrintDebugGC -> keyword "Print ML GC" | PrintGraph -> keyword "Print Graph" | PrintClasses -> keyword "Print Classes" | PrintTypeclasses -> keyword "Print Typeclasses" | PrintInstances qid -> keyword "Print Instances" ++ spc () ++ pr_smart_global qid | PrintCoercions -> keyword "Print Coercions" | PrintCoercionPaths (s,t) -> keyword "Print Coercion Paths" ++ spc() ++ pr_class_rawexpr s ++ spc() ++ pr_class_rawexpr t | PrintCanonicalConversions qids -> keyword "Print Canonical Structures" ++ prlist pr_smart_global qids | PrintTypingFlags -> keyword "Print Typing Flags" | PrintTables -> keyword "Print Tables" | PrintHintGoal -> keyword "Print Hint" | PrintHint qid -> keyword "Print Hint" ++ spc () ++ pr_smart_global qid | PrintHintDb -> keyword "Print Hint *" | PrintHintDbName s -> keyword "Print HintDb" ++ spc () ++ str s | PrintUniverses (b, g, fopt) -> let cmd = if b then "Print Sorted Universes" else "Print Universes" in let pr_subgraph = prlist_with_sep spc pr_qualid in keyword cmd ++ pr_opt pr_subgraph g ++ pr_opt str fopt | PrintName (qid,udecl) -> keyword "Print" ++ spc() ++ pr_smart_global qid ++ pr_full_univ_name_list udecl | PrintModuleType qid -> keyword "Print Module Type" ++ spc() ++ pr_qualid qid | PrintModule qid -> keyword "Print Module" ++ spc() ++ pr_qualid qid | PrintInspect n -> keyword "Inspect" ++ spc() ++ int n | PrintScopes -> keyword "Print Scopes" | PrintScope s -> keyword "Print Scope" ++ spc() ++ str s | PrintVisibility s -> keyword "Print Visibility" ++ pr_opt str s | PrintAbout (qid,l,gopt) -> pr_opt (fun g -> Goal_select.pr_goal_selector g ++ str ":"++ spc()) gopt ++ keyword "About" ++ spc() ++ pr_smart_global qid ++ pr_full_univ_name_list l | PrintImplicit qid -> keyword "Print Implicit" ++ spc() ++ pr_smart_global qid (* spiwack: command printing all the axioms and section variables used in a term *) | PrintAssumptions (b, t, qid) -> let cmd = match b, t with | true, true -> "Print All Dependencies" | true, false -> "Print Opaque Dependencies" | false, true -> "Print Transparent Dependencies" | false, false -> "Print Assumptions" in keyword cmd ++ spc() ++ pr_smart_global qid | PrintNamespace dp -> keyword "Print Namespace" ++ DirPath.print dp | PrintStrategy None -> keyword "Print Strategies" | PrintStrategy (Some qid) -> keyword "Print Strategy" ++ pr_smart_global qid | PrintRegistered -> keyword "Print Registered" | PrintRegisteredSchemes -> keyword "Print Registered Schemes" | PrintNotation (Constrexpr.InConstrEntry, ntn_key) -> keyword "Print Notation" ++ spc() ++ str ntn_key | PrintNotation (Constrexpr.InCustomEntry ent, ntn_key) -> keyword "Print Notation" ++ spc() ++ str ent ++ str ntn_key let pr_using e = let rec aux = function | SsEmpty -> "()" | SsType -> "(Type)" | SsSingl { v=id } -> "("^Id.to_string id^")" | SsCompl e -> "-" ^ aux e^"" | SsUnion(e1,e2) -> "("^aux e1 ^" + "^ aux e2^")" | SsSubstr(e1,e2) -> "("^aux e1 ^" - "^ aux e2^")" | SsFwdClose e -> "("^aux e^")*" in Pp.str (aux e) let pr_extend s cl = let pr_arg a = try pr_gen a with Failure _ -> str "" in try let rl = Egramml.get_extend_vernac_rule s in let rec aux rl cl = match rl, cl with | Egramml.GramNonTerminal _ :: rl, arg :: cl -> pr_arg arg :: aux rl cl | Egramml.GramTerminal s :: rl, cl -> str s :: aux rl cl | [], [] -> [] | _ -> assert false in hov 1 (pr_sequence identity (aux rl cl)) with Not_found -> hov 1 (str "TODO(" ++ str s.ext_entry ++ spc () ++ prlist_with_sep sep pr_arg cl ++ str ")") let pr_synpure_vernac_expr v = let return = tag_vernac v in match v with (* Proof management *) | VernacAbortAll -> return (keyword "Abort All") | VernacRestart -> return (keyword "Restart") | VernacUnfocus -> return (keyword "Unfocus") | VernacUnfocused -> return (keyword "Unfocused") | VernacAbort -> return (keyword "Abort") | VernacUndo i -> return ( if Int.equal i 1 then keyword "Undo" else keyword "Undo" ++ pr_intarg i ) | VernacUndoTo i -> return (keyword "Undo" ++ spc() ++ keyword "To" ++ pr_intarg i) | VernacFocus i -> return (keyword "Focus" ++ pr_opt int i) | VernacShow s -> let pr_goal_reference = function | OpenSubgoals -> mt () | NthGoal n -> spc () ++ int n | GoalId id -> spc () ++ pr_id id in let pr_showable = function | ShowGoal n -> keyword "Show" ++ pr_goal_reference n | ShowProof -> keyword "Show Proof" | ShowExistentials -> keyword "Show Existentials" | ShowUniverses -> keyword "Show Universes" | ShowProofNames -> keyword "Show Conjectures" | ShowIntros b -> keyword "Show " ++ (if b then keyword "Intros" else keyword "Intro") | ShowMatch id -> keyword "Show Match " ++ pr_qualid id in return (pr_showable s) | VernacCheckGuard -> return (keyword "Guarded") | VernacValidateProof -> return (keyword "Validate Proof") (* Resetting *) | VernacResetName id -> return (keyword "Reset" ++ spc() ++ pr_lident id) | VernacResetInitial -> return (keyword "Reset Initial") | VernacBack i -> return ( if Int.equal i 1 then keyword "Back" else keyword "Back" ++ pr_intarg i ) (* Syntax *) | VernacOpenCloseScope (opening,sc) -> return ( keyword (if opening then "Open " else "Close ") ++ keyword "Scope" ++ spc() ++ str sc ) | VernacDeclareScope sc -> return ( keyword "Declare Scope" ++ spc () ++ str sc ) | VernacDelimiters (sc,Some key) -> return ( keyword "Delimit Scope" ++ spc () ++ str sc ++ spc() ++ keyword "with" ++ spc () ++ str key ) | VernacDelimiters (sc, None) -> return ( keyword "Undelimit Scope" ++ spc () ++ str sc ) | VernacBindScope (sc,cll) -> return ( keyword "Bind Scope" ++ spc () ++ str sc ++ spc() ++ keyword "with" ++ spc () ++ prlist_with_sep spc pr_class_rawexpr cll ) | VernacEnableNotation (on,rule,interp,flags,scope) -> let pr_flag = function | EnableNotationEntry CAst.{v=InConstrEntry} -> str "in constr" | EnableNotationEntry CAst.{v=InCustomEntry s} -> str "in custom " ++ str s | EnableNotationOnly OnlyParsing -> str "only parsing" | EnableNotationOnly OnlyPrinting -> str "only printing" | EnableNotationOnly ParsingAndPrinting -> assert false | EnableNotationAll -> str "all" in let pr_flags = function | [] -> mt () | l -> str "(" ++ prlist_with_sep pr_comma pr_flag l ++ str ")" in let pr_rule = match rule with | None -> mt () | Some (Inl ntn) -> quote (str ntn) | Some (Inr abbrev) -> pr_abbreviation pr_qualid abbrev in let pr_opt_scope = function | None -> mt () | Some (NotationInScope s) -> spc () ++ str ": " ++ str s | Some LastLonelyNotation -> str ":" ++ spc () ++ str "none" in let pp = pr_rule ++ pr_flags flags ++ pr_opt_scope scope in return ( keyword (if on then "Enable Notation " else "Disable Notation ") ++ pp ) (* Gallina *) | VernacDefinition ((discharge,kind),id,b) -> (* A verifier... *) let isgoal = Name.is_anonymous (fst id).v in let pr_def_token = keyword ( if isgoal then "Goal" else string_of_definition_object_kind kind) in let pr_reduce = function | None -> mt() | Some r -> keyword "Eval" ++ spc() ++ pr_red_expr r ++ keyword " in" ++ spc() in let pr_def_body = match b with | DefineBody (bl,red,body,d) -> let ty = match d with | None -> mt() | Some ty -> spc() ++ str":" ++ pr_spc_lconstr ty in pr_binders_arg bl ++ ty ++ str " :=" ++ spc() ++ pr_reduce red ++ pr_lconstr body | ProveBody (bl,t) -> let typ u = if isgoal then (assert (bl = []); u) else (str" :" ++ u) in pr_binders_arg bl ++ typ (pr_spc_lconstr t) in return ( hov 2 ( pr_def_token ++ (if isgoal then mt() else spc() ++ pr_lname_decl id) ++ pr_def_body) ) | VernacStartTheoremProof (ki,l) -> return ( hov 1 (pr_statement (pr_thm_token ki) (List.hd l) ++ prlist (pr_statement (spc () ++ keyword "with")) (List.tl l)) ) | VernacEndProof Admitted -> return (keyword "Admitted") | VernacEndProof (Proved (opac,o)) -> return ( match o with | None -> (match opac with | Transparent -> keyword "Defined" | Opaque -> keyword "Qed") | Some id -> (if opac <> Transparent then keyword "Save" else keyword "Defined") ++ spc() ++ pr_lident id ) | VernacExactProof c -> return (hov 2 (keyword "Proof" ++ pr_lconstrarg c)) | VernacAssumption ((discharge,kind),t,l) -> let n = List.length (List.flatten (List.map fst (List.map snd l))) in let pr_params (c, (xl, t)) = hov 2 (prlist_with_sep sep pr_ident_decl xl ++ spc() ++ str(match c with AddCoercion -> ":>" | NoCoercion -> ":") ++ spc() ++ pr_lconstr_expr t) in let assumptions = prlist_with_sep spc (fun p -> hov 1 (str "(" ++ pr_params p ++ str ")")) l in return (hov 2 (pr_assumption_token (n > 1) discharge kind ++ pr_non_empty_arg pr_assumption_inline t ++ spc() ++ assumptions)) | VernacSymbol l -> let n = List.length (List.flatten (List.map fst (List.map snd l))) in let pr_params (c, (xl, t)) = hov 2 (prlist_with_sep sep pr_ident_decl xl ++ spc() ++ str(match c with AddCoercion -> ":>" | NoCoercion -> ":") ++ spc() ++ pr_lconstr_expr t) in let assumptions = prlist_with_sep spc (fun p -> hov 1 (str "(" ++ pr_params p ++ str ")")) l in return (hov 2 (keyword (if (n > 1) then "Symbols" else "Symbol") ++ spc() ++ assumptions)) | VernacInductive (f,l) -> let pr_constructor ((attr,coe,ins),(id,c)) = hov 2 (pr_vernac_attributes attr ++ pr_lident id ++ pr_oc coe ins ++ Flags.without_option Flags.beautify pr_spc_lconstr c) in let pr_constructor_list l = match l with | Constructors [] -> mt() | Constructors l -> let fst_sep = match l with [_] -> " " | _ -> " | " in pr_com_at (begin_of_inductive l) ++ fnl() ++ str fst_sep ++ prlist_with_sep (fun _ -> fnl() ++ str" | ") pr_constructor l | RecordDecl (c,fs,obinder) -> pr_record_decl c fs obinder in let pr_oneind key (((coe,iddecl),(indupar,indpar),s,lc),ntn) = hov 0 ( str key ++ spc() ++ str(match coe with AddCoercion -> "> " | NoCoercion -> "") ++ pr_cumul_ident_decl iddecl ++ pr_and_type_binders_arg indupar ++ pr_opt (fun p -> str "|" ++ spc() ++ pr_and_type_binders_arg p) indpar ++ pr_opt (fun s -> str":" ++ spc() ++ pr_lconstr_expr s) s ++ str" :=") ++ pr_constructor_list lc ++ prlist pr_where_notation ntn in let kind = match f with | Record -> "Record" | Structure -> "Structure" | Inductive_kw -> "Inductive" | CoInductive -> "CoInductive" | Class _ -> "Class" | Variant -> "Variant" in return ( hov 1 (pr_oneind kind (List.hd l)) ++ (prlist (fun ind -> fnl() ++ hov 1 (pr_oneind "with" ind)) (List.tl l)) ) | VernacFixpoint (local, recs) -> let local = match local with | DoDischarge -> "Let " | NoDischarge -> "" in return ( hov 0 (str local ++ keyword "Fixpoint" ++ spc () ++ prlist_with_sep (fun _ -> fnl () ++ keyword "with" ++ spc ()) pr_rec_definition recs) ) | VernacCoFixpoint (local, corecs) -> let local = match local with | DoDischarge -> keyword "Let" ++ spc () | NoDischarge -> str "" in let pr_onecorec {fname; univs; binders; rtype; body_def; notations } = pr_ident_decl (fname,univs) ++ spc() ++ pr_binders binders ++ spc() ++ str":" ++ spc() ++ pr_lconstr_expr rtype ++ pr_opt (fun def -> str":=" ++ brk(1,2) ++ pr_lconstr def) body_def ++ prlist pr_where_notation notations in return ( hov 0 (local ++ keyword "CoFixpoint" ++ spc() ++ prlist_with_sep (fun _ -> fnl() ++ keyword "with" ++ spc ()) pr_onecorec corecs) ) | VernacScheme l -> return ( hov 2 (keyword "Scheme" ++ spc() ++ prlist_with_sep (fun _ -> fnl() ++ keyword "with" ++ spc ()) pr_onescheme l) ) | VernacSchemeEquality (sch,id) -> return ( hov 2 (keyword "Scheme " ++ pr_equality_scheme_type sch id) ) | VernacCombinedScheme (id, l) -> return ( hov 2 (keyword "Combined Scheme" ++ spc() ++ pr_lident id ++ spc() ++ keyword "from" ++ spc() ++ prlist_with_sep (fun _ -> fnl() ++ str", ") pr_lident l) ) | VernacUniverse v -> return ( hov 2 (keyword "Universe" ++ spc () ++ prlist_with_sep (fun _ -> str",") pr_lident v) ) | VernacConstraint v -> return ( hov 2 (keyword "Constraint" ++ spc () ++ prlist_with_sep (fun _ -> str",") pr_uconstraint v) ) (* Gallina extensions *) | VernacNameSectionHypSet (id,set) -> return (hov 2 (keyword "Collection" ++ spc() ++ pr_lident id ++ spc()++ str ":="++spc()++pr_using set)) | VernacCanonical q -> return ( keyword "Canonical Structure" ++ spc() ++ pr_smart_global q ) | VernacCoercion (id,Some(c1,c2)) -> return ( hov 1 ( keyword "Coercion" ++ spc() ++ pr_smart_global id ++ spc() ++ str":" ++ spc() ++ pr_class_rawexpr c1 ++ spc() ++ str">->" ++ spc() ++ pr_class_rawexpr c2) ) | VernacCoercion (id,None) -> return ( hov 1 ( keyword "Coercion" ++ spc() ++ pr_smart_global id) ) | VernacIdentityCoercion (id,c1,c2) -> return ( hov 1 ( keyword "Identity Coercion" ++ spc() ++ pr_lident id ++ spc() ++ str":" ++ spc() ++ pr_class_rawexpr c1 ++ spc() ++ str">->" ++ spc() ++ pr_class_rawexpr c2) ) | VernacInstance (instid, sup, cl, props, info) -> return ( hov 1 ( keyword "Instance" ++ (match instid with | {loc; v = Name id}, l -> spc () ++ pr_ident_decl (CAst.(make ?loc id),l) ++ spc () | { v = Anonymous }, _ -> mt ()) ++ pr_and_type_binders_arg sup ++ str":" ++ spc () ++ pr_constr cl ++ pr_hint_info pr_constr_pattern_expr info ++ (match props with | 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())) ) | VernacDeclareInstance (instid, sup, cl, info) -> return ( hov 1 ( keyword "Declare Instance" ++ spc () ++ pr_ident_decl instid ++ spc () ++ pr_and_type_binders_arg sup ++ str":" ++ spc () ++ pr_constr cl ++ pr_hint_info pr_constr_pattern_expr info) ) | VernacContext l -> return ( hov 1 ( keyword "Context" ++ pr_and_type_binders_arg l) ) | VernacExistingInstance insts -> let pr_inst (id, info) = pr_qualid id ++ pr_hint_info pr_constr_pattern_expr info in return ( hov 1 (keyword "Existing" ++ spc () ++ keyword(String.plural (List.length insts) "Instance") ++ spc () ++ prlist_with_sep spc pr_inst insts) ) | VernacExistingClass id -> return ( hov 1 (keyword "Existing" ++ spc () ++ keyword "Class" ++ spc () ++ pr_qualid id) ) (* Commands *) | VernacCreateHintDb (dbname,b) -> return ( hov 1 (keyword "Create HintDb" ++ spc () ++ str dbname ++ (if b then str" discriminated" else mt ())) ) | VernacRemoveHints (dbnames, ids) -> return ( hov 1 (keyword "Remove Hints" ++ spc () ++ prlist_with_sep spc (fun r -> pr_qualid r) ids ++ pr_opt_hintbases dbnames) ) | VernacHints (dbnames,h) -> return (pr_hints dbnames h pr_constr pr_constr_pattern_expr) | VernacSyntacticDefinition (id,(ids,c),l) -> return ( hov 2 (keyword "Notation" ++ spc () ++ pr_abbreviation pr_lident (ids,id) ++ str":=" ++ pr_constrarg c ++ pr_syntax_modifiers l) ) | VernacArguments (q, args, more_implicits, mods) -> return ( hov 2 ( keyword "Arguments" ++ spc() ++ pr_smart_global q ++ let pr_s = prlist (fun {v=s} -> pr_scope_delimiter s) in let pr_if b x = if b then x else str "" in let pr_one_arg (x,k) = pr_if k (str"!") ++ Name.print x in let pr_br imp force x = let left,right = match imp with | Glob_term.NonMaxImplicit -> str "[", str "]" | Glob_term.MaxImplicit -> str "{", str "}" | Glob_term.Explicit -> if force then str"(",str")" else mt(),mt() in left ++ x ++ right in let get_arguments_like s imp tl = if s = [] && imp = Glob_term.Explicit then [], tl else let rec fold extra = function | RealArg arg :: tl when List.equal (fun a b -> let da, a = a.CAst.v in let db, b = b.CAst.v in da = db && String.equal a b) arg.notation_scope s && arg.implicit_status = imp -> fold ((arg.name,arg.recarg_like) :: extra) tl | args -> List.rev extra, args in fold [] tl in let rec print_arguments = function | [] -> mt() | VolatileArg :: l -> spc () ++ str"/" ++ print_arguments l | BidiArg :: l -> spc () ++ str"&" ++ print_arguments l | RealArg { name = id; recarg_like = k; notation_scope = s; implicit_status = imp } :: tl -> let extra, tl = get_arguments_like s imp tl in spc() ++ hov 1 (pr_br imp (extra<>[]) (prlist_with_sep spc pr_one_arg ((id,k)::extra)) ++ pr_s s) ++ print_arguments tl in let rec print_implicits = function | [] -> mt () | (name, impl) :: rest -> spc() ++ pr_br impl false (Name.print name) ++ print_implicits rest in print_arguments args ++ if not (List.is_empty more_implicits) then prlist (fun l -> str"," ++ print_implicits l) more_implicits else (mt ()) ++ (if not (List.is_empty mods) then str" : " else str"") ++ prlist_with_sep (fun () -> str", " ++ spc()) (function | `ReductionDontExposeCase -> keyword "simpl nomatch" | `ReductionNeverUnfold -> keyword "simpl never" | `DefaultImplicits -> keyword "default implicits" | `Rename -> keyword "rename" | `Assert -> keyword "assert" | `ExtraScopes -> keyword "extra scopes" | `ClearImplicits -> keyword "clear implicits" | `ClearScopes -> keyword "clear scopes" | `ClearBidiHint -> keyword "clear bidirectionality hint") mods) ) | VernacReserve bl -> let n = List.length (List.flatten (List.map fst bl)) in return ( hov 2 (tag_keyword (str"Implicit Type" ++ str (if n > 1 then "s " else " ")) ++ pr_ne_params_list pr_lconstr_expr (List.map (fun sb -> false,sb) bl)) ) | VernacGeneralizable g -> return ( hov 1 (tag_keyword ( str"Generalizable Variable" ++ match g with | None -> str "s none" | Some [] -> str "s all" | Some idl -> str (if List.length idl > 1 then "s " else " ") ++ prlist_with_sep spc pr_lident idl) )) | VernacSetOpacity((k,l),b) when Conv_oracle.is_transparent k -> return ( hov 1 (keyword (if b then "Transparent!" else "Transparent") ++ spc() ++ prlist_with_sep sep pr_smart_global l) ) | VernacSetOpacity((Conv_oracle.Opaque,l),b) -> return ( hov 1 (keyword (if b then "Opaque!" else "Opaque") ++ spc() ++ prlist_with_sep sep pr_smart_global l) ) | VernacSetOpacity _ -> return ( CErrors.anomaly (keyword "VernacSetOpacity used to set something else.") ) | VernacSetStrategy l -> let pr_lev = function | Conv_oracle.Opaque -> keyword "opaque" | Conv_oracle.Expand -> keyword "expand" | l when Conv_oracle.is_transparent l -> keyword "transparent" | Conv_oracle.Level n -> int n in let pr_line (l,q) = hov 2 (pr_lev l ++ spc() ++ str"[" ++ prlist_with_sep sep pr_smart_global q ++ str"]") in return ( hov 1 (keyword "Strategy" ++ spc() ++ hv 0 (prlist_with_sep sep pr_line l)) ) | VernacAddOption (na,l) -> return ( hov 2 (keyword "Add" ++ spc() ++ pr_printoption na (Some l)) ) | VernacRemoveOption (na,l) -> return ( hov 2 (keyword "Remove" ++ spc() ++ pr_printoption na (Some l)) ) | VernacMemOption (na,l) -> return ( hov 2 (keyword "Test" ++ spc() ++ pr_printoption na (Some l)) ) | VernacPrintOption na -> return ( hov 2 (keyword "Test" ++ spc() ++ pr_printoption na None) ) | VernacCheckMayEval (r,io,c) -> let pr_mayeval r c = match r with | Some r0 -> hov 2 (keyword "Eval" ++ spc() ++ pr_red_expr r0 ++ spc() ++ keyword "in" ++ spc () ++ pr_lconstr c) | None -> hov 2 (keyword "Check" ++ spc() ++ pr_lconstr c) in let pr_i = match io with None -> mt () | Some i -> Goal_select.pr_goal_selector i ++ str ": " in return (pr_i ++ pr_mayeval r c) | VernacGlobalCheck c -> return (hov 2 (keyword "Type" ++ pr_constrarg c)) | VernacDeclareReduction (s,r) -> return ( keyword "Declare Reduction" ++ spc () ++ str s ++ str " := " ++ pr_red_expr r ) | VernacPrint p -> return (pr_printable p) | VernacSearch (sea,g,sea_r) -> return (pr_search sea g sea_r @@ pr_constr_pattern_expr) | VernacLocate loc -> let pr_locate =function | LocateAny qid -> pr_smart_global qid | LocateTerm qid -> keyword "Term" ++ spc() ++ pr_smart_global qid | LocateFile f -> keyword "File" ++ spc() ++ qs f | LocateLibrary qid -> keyword "Library" ++ spc () ++ pr_module qid | LocateModule qid -> keyword "Module" ++ spc () ++ pr_module qid | LocateOther (s, qid) -> keyword s ++ spc () ++ pr_ltac_ref qid in return (keyword "Locate" ++ spc() ++ pr_locate loc) | VernacRegister (qid, RegisterCoqlib name) -> return ( hov 2 (keyword "Register" ++ spc() ++ pr_qualid qid ++ spc () ++ str "as" ++ spc () ++ pr_qualid name) ) | VernacRegister (qid, RegisterScheme {inductive; scheme_kind}) -> return ( hov 2 (keyword "Register" ++ spc() ++ keyword "Scheme" ++ spc() ++ pr_qualid qid ++ spc () ++ str "as" ++ spc () ++ pr_qualid scheme_kind ++ spc() ++ str "for" ++ spc() ++ pr_qualid inductive) ) | VernacRegister (qid, RegisterInline) -> return ( hov 2 (keyword "Register Inline" ++ spc() ++ pr_qualid qid) ) | VernacPrimitive(id,r,typopt) -> hov 2 (keyword "Primitive" ++ spc() ++ pr_ident_decl id ++ (Option.cata (fun ty -> spc() ++ str":" ++ pr_spc_lconstr ty) (mt()) typopt) ++ spc() ++ str ":=" ++ spc() ++ str (CPrimitives.op_or_type_to_string r)) | VernacComments l -> return ( hov 2 (keyword "Comments" ++ spc() ++ prlist_with_sep sep (pr_comment pr_constr) l) ) | VernacAttributes attrs -> return ( hov 2 (keyword "Attributes" ++ spc () ++ pr_vernac_attributes attrs) ) | VernacProof (None, None) -> return (keyword "Proof") | VernacProof (None, Some e) -> return (keyword "Proof " ++ spc () ++ keyword "using" ++ spc() ++ pr_using e) | VernacProof (Some te, None) -> return (keyword "Proof with" ++ spc() ++ pr_gen te) | VernacProof (Some te, Some e) -> return ( keyword "Proof" ++ spc () ++ keyword "using" ++ spc() ++ pr_using e ++ spc() ++ keyword "with" ++ spc() ++ pr_gen te ) | VernacBullet b -> (* XXX: Redundant with Proof_bullet.print *) return (let open Proof_bullet in begin match b with | Dash n -> str (String.make n '-') | Star n -> str (String.make n '*') | Plus n -> str (String.make n '+') end) | VernacSubproof None -> return (str "{") | VernacSubproof (Some i) -> return (Goal_select.pr_goal_selector i ++ str ":" ++ spc () ++ str "{") | VernacEndSubproof -> return (str "}") | VernacAddRewRule (id, l) -> return ( hov 0 (keyword (if List.length l > 1 then "Rewrite Rules" else "Rewrite Rule") ++ spc () ++ pr_lident id ++ str ":=" ++ prlist_with_sep (fun _ -> fnl () ++ keyword "with" ++ spc ()) pr_rew_rule l) ) let pr_synterp_vernac_expr v = let return = tag_vernac v in match v with | VernacLoad (f,s) -> return ( keyword "Load" ++ if f then (spc() ++ keyword "Verbose" ++ spc()) else spc() ++ qs s ) | VernacBeginSection id -> return (hov 2 (keyword "Section" ++ spc () ++ pr_lident id)) | VernacEndSegment id -> return (hov 2 (keyword "End" ++ spc() ++ pr_lident id)) | VernacNotation (infix,ntn_decl) -> return ( hov 2 (hov 0 (keyword (if infix then "Infix" else "Notation") ++ spc() ++ pr_notation_declaration ntn_decl)) ) | VernacReservedNotation (_, (s, l)) -> return ( keyword "Reserved Notation" ++ spc() ++ pr_ast qs s ++ pr_syntax_modifiers l ) | VernacDeclareCustomEntry s -> return ( keyword "Declare Custom Entry " ++ str s ) | VernacRequire (from, exp, l) -> let from = match from with | None -> mt () | Some r -> keyword "From" ++ spc () ++ pr_module r ++ spc () in return ( hov 2 (from ++ keyword "Require" ++ spc() ++ pr_require_token exp ++ prlist_with_sep sep pr_import_module l) ) | VernacImport (f,l) -> return ( pr_export_with_cats f ++ spc() ++ prlist_with_sep sep pr_import_module l ) (* Modules and Module Types *) | VernacDefineModule (export,m,bl,tys,bd) -> let b = pr_module_binders bl pr_lconstr in return ( hov 2 (keyword "Module" ++ spc() ++ pr_require_token export ++ pr_lident m ++ b ++ pr_of_module_type pr_lconstr tys ++ (if List.is_empty bd then mt () else str ":= ") ++ prlist_with_sep (fun () -> str " <+") (pr_module_ast_inl true pr_lconstr) bd) ) | VernacDeclareModule (export,id,bl,m1) -> let b = pr_module_binders bl pr_lconstr in return ( hov 2 (keyword "Declare Module" ++ spc() ++ pr_require_token export ++ pr_lident id ++ b ++ str " :" ++ pr_module_ast_inl true pr_lconstr m1) ) | VernacDeclareModuleType (id,bl,tyl,m) -> let b = pr_module_binders bl pr_lconstr in let pr_mt = pr_module_ast_inl true pr_lconstr in return ( hov 2 (keyword "Module Type " ++ pr_lident id ++ b ++ prlist_strict (fun m -> str " <:" ++ pr_mt m) tyl ++ (if List.is_empty m then mt () else str ":= ") ++ prlist_with_sep (fun () -> str " <+ ") pr_mt m) ) | VernacInclude (mexprs) -> let pr_m = pr_module_ast_inl false pr_lconstr in return ( hov 2 (keyword "Include" ++ spc() ++ prlist_with_sep (fun () -> str " <+ ") pr_m mexprs) ) (* Auxiliary file and library management *) | VernacDeclareMLModule (l) -> return ( hov 2 (keyword "Declare ML Module" ++ spc() ++ prlist_with_sep sep qs l) ) | VernacChdir None -> return (keyword "Pwd") | VernacChdir (Some s) -> return (keyword "Cd " ++ qs s) | VernacSetOption (export, na,v) -> let export = if export then keyword "Export" ++ spc () else mt () in let set = if v == OptionUnset then "Unset" else "Set" in return ( hov 2 (export ++ keyword set ++ spc() ++ pr_set_option na v) ) | VernacExtraDependency(from,file,id) -> return ( hov 2 (keyword "From" ++ spc () ++ pr_module from ++ spc () ++ keyword "Extra" ++ spc() ++ keyword "Dependency" ++ spc() ++ qs file ++ pr_opt (fun x -> spc() ++ keyword "as" ++ spc () ++ pr_id x) id) ) | VernacExtend (s,c) -> return (pr_extend s c) | VernacProofMode s -> return (keyword "Proof Mode" ++ str s) let pr_control_flag (p : control_flag) = let w = match p with | ControlTime -> keyword "Time" | ControlInstructions -> keyword "Instructions" | ControlRedirect s -> keyword "Redirect" ++ spc() ++ qs s | ControlTimeout n -> keyword "Timeout " ++ int n | ControlFail -> keyword "Fail" | ControlSucceed -> keyword "Succeed" in w ++ spc () let pr_vernac_control flags = Pp.prlist pr_control_flag flags let pr_vernac_expr v = match v with | VernacSynPure e -> pr_synpure_vernac_expr e | VernacSynterp e -> pr_synterp_vernac_expr e let pr_vernac ({v = {control; attrs; expr}} as v) = tag_vernac v (pr_vernac_control control ++ pr_vernac_attributes attrs ++ pr_vernac_expr expr ++ sep_end expr) coq-8.20.0/vernac/ppvernac.mli000066400000000000000000000026111466560755400162040ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* Pp.t) -> 'a Extend.constr_entry_key_gen -> Pp.t val pr_syntax_modifier : Vernacexpr.syntax_modifier CAst.t -> Pp.t (** Prints a fixpoint body *) val pr_rec_definition : Vernacexpr.fixpoint_expr -> Pp.t (** Prints a scheme *) val pr_onescheme : Names.lident option * Vernacexpr.scheme -> Pp.t (** Prints a vernac expression without dot *) val pr_vernac_expr : Vernacexpr.vernac_expr -> Pp.t (** Prints a "proof using X" clause. *) val pr_using : Vernacexpr.section_subset_expr -> Pp.t (** Prints a vernac expression and closes it with a dot. *) val pr_vernac : Vernacexpr.vernac_control -> Pp.t coq-8.20.0/vernac/prettyp.ml000066400000000000000000001272771466560755400157440ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* on May-June 2006 for implementation of abstraction of pretty-printing of objects. *) open Pp open CErrors open Util open CAst open Names open Termops open Declarations open Environ open Impargs open Libobject open Libnames open Globnames open Printer open Context.Rel.Declaration module RelDecl = Context.Rel.Declaration module NamedDecl = Context.Named.Declaration let print_module mp = Printmod.print_module ~with_body:true mp let print_modtype = Printmod.print_modtype (**************) (** Utilities *) let print_closed_sections = ref false let pr_infos_list l = v 0 (prlist_with_sep cut (fun x -> x) l) let with_line_skip l = if List.is_empty l then mt() else fnl() ++ fnl () ++ pr_infos_list l let blankline = mt() (* add a blank sentence in the list of infos *) let add_colon prefix = if ismt prefix then mt () else prefix ++ str ": " let int_or_no n = if Int.equal n 0 then str "no" else int n (*******************) (** Basic printing *) let print_basename cst = pr_global (GlobRef.ConstRef cst) let print_ref env reduce ref udecl = let typ, univs = Typeops.type_of_global_in_context env ref in let inst = UVars.make_abstract_instance univs in let bl = Printer.universe_binders_with_opt_names (Environ.universes_of_global env ref) udecl in let sigma = Evd.from_ctx (UState.of_names bl) in let typ = if reduce then let ctx,ccl = Reductionops.whd_decompose_prod_decls env sigma (EConstr.of_constr typ) in EConstr.to_constr sigma (EConstr.it_mkProd_or_LetIn ccl ctx) else typ in let typ = Arguments_renaming.rename_type typ ref in let impargs = select_stronger_impargs (implicits_of_global ref) in let impargs = List.map binding_kind_of_status impargs in let variance = let open GlobRef in match ref with | VarRef _ | ConstRef _ -> None | IndRef (ind,_) | ConstructRef ((ind,_),_) -> let mind = Environ.lookup_mind ind env in mind.Declarations.mind_variance in let inst = if Environ.is_polymorphic env ref then Printer.pr_universe_instance sigma inst else mt () in let priv = None in (* We deliberately don't print private univs in About. *) hov 0 (pr_global ref ++ inst ++ str " :" ++ spc () ++ pr_ltype_env env sigma ~impargs typ ++ Printer.pr_abstract_universe_ctx sigma ?variance univs ?priv) (** Command [Print Implicit], somehow subsumed by [About] *) let pr_impl_name imp = Id.print (name_of_implicit imp) let print_impargs_by_name max = function | [] -> [] | impls -> let n = List.length impls in [hov 0 (str (String.plural n "Argument") ++ spc() ++ prlist_with_sep pr_comma pr_impl_name impls ++ spc() ++ str (String.conjugate_verb_to_be n) ++ str" implicit" ++ (if max then strbrk " and maximally inserted" else mt()))] let print_one_impargs_list l = let imps = List.filter is_status_implicit l in let maximps = List.filter Impargs.maximal_insertion_of imps in let nonmaximps = List.subtract (=) imps maximps in (* FIXME *) print_impargs_by_name false nonmaximps @ print_impargs_by_name true maximps let print_impargs_list prefix l = let l = extract_impargs_data l in List.flatten (List.map (fun (cond,imps) -> match cond with | None -> List.map (fun pp -> add_colon prefix ++ pp) (print_one_impargs_list imps) | Some (n1,n2) -> [v 2 (prlist_with_sep cut (fun x -> x) [(if ismt prefix then str "When" else prefix ++ str ", when") ++ str " applied to " ++ (if Int.equal n1 n2 then int_or_no n2 else if Int.equal n1 0 then str "no more than " ++ int n2 else int n1 ++ str " to " ++ int_or_no n2) ++ str (String.plural n2 " argument") ++ str ":"; v 0 (prlist_with_sep cut (fun x -> x) (if List.exists is_status_implicit imps then print_one_impargs_list imps else [str "No implicit arguments"]))])]) l) let need_expansion env impl ref = let typ, _ = Typeops.type_of_global_in_context env ref in let ctx = Term.prod_decls typ in let nprods = List.count is_local_assum ctx in not (List.is_empty impl) && List.length impl >= nprods && let _,lastimpl = List.chop nprods impl in List.exists is_status_implicit lastimpl let print_impargs env ref = let impl = implicits_of_global ref in let has_impl = not (List.is_empty impl) in (* Need to reduce since implicits are computed with products flattened *) pr_infos_list ([ print_ref env (need_expansion env (select_impargs_size 0 impl) ref) ref None; blankline ] @ (if has_impl then print_impargs_list (mt()) impl else [str "No implicit arguments"])) (** Printing reduction behavior *) let print_reduction_behaviour = function | GlobRef.ConstRef ref -> let p = Reductionops.ReductionBehaviour.print ref in if Pp.ismt p then [] else [p] | _ -> [] (** Printing opacity status *) type opacity = | FullyOpaque | TransparentMaybeOpacified of Conv_oracle.level let opacity env = function | GlobRef.VarRef v when NamedDecl.is_local_def (Environ.lookup_named v env) -> Some(TransparentMaybeOpacified (Conv_oracle.get_strategy (Environ.oracle env) (Conv_oracle.EvalVarRef v))) | GlobRef.ConstRef cst -> let cb = Environ.lookup_constant cst env in (match cb.const_body with | Undef _ | Primitive _ | Symbol _ -> None | OpaqueDef _ -> Some FullyOpaque | Def _ -> Some (TransparentMaybeOpacified (Conv_oracle.get_strategy (Environ.oracle env) (Conv_oracle.EvalConstRef cst)))) | _ -> None let print_opacity env ref = match opacity env ref with | None -> [] | Some s -> [pr_global ref ++ str " is " ++ match s with | FullyOpaque -> str "opaque" | TransparentMaybeOpacified Conv_oracle.Opaque -> str "basically transparent but considered opaque for reduction" | TransparentMaybeOpacified lev when Conv_oracle.is_transparent lev -> str "transparent" | TransparentMaybeOpacified (Conv_oracle.Level n) -> str "transparent (with expansion weight " ++ int n ++ str ")" | TransparentMaybeOpacified Conv_oracle.Expand -> str "transparent (with minimal expansion weight)"] (** Printing coercion status *) let print_if_is_coercion ref = if Coercionops.coercion_exists ref then let i = Coercionops.coercion_info ref in let r = if i.Coercionops.coe_reversible then " reversible" else "" in [pr_global ref ++ str " is a" ++ str r ++ str " coercion"] else [] (** Printing polymorphic status *) let pr_template_variables = function | [] -> mt () | vars -> str " on " ++ prlist_with_sep spc UnivNames.pr_level_with_global_universes vars let print_polymorphism env ref = let poly = Environ.is_polymorphic env ref in let template_poly = Environ.is_template_polymorphic env ref in let template_variables = Environ.get_template_polymorphic_variables env ref in [ pr_global ref ++ str " is " ++ (if poly then str "universe polymorphic" else if template_poly then str "template universe polymorphic" ++ if !Detyping.print_universes then h (pr_template_variables template_variables) else mt() else str "not universe polymorphic") ] let print_prop_but_default_dep_elim ref = match ref with | GlobRef.IndRef ind -> if Indrec.is_prop_but_default_dependent_elim ind then [pr_global ref ++ str " is in Prop but its eliminators are declared dependent by default"] else [] | _ -> [] (** Print projection status *) let print_projection env ref = match ref with | GlobRef.ConstRef cst -> begin match Structures.PrimitiveProjections.find_opt cst with | Some p -> [pr_global ref ++ str " is a primitive projection of " ++ pr_global (IndRef (Projection.Repr.inductive p))] | None -> try let ind = (Structures.Structure.find_from_projection cst).name in [pr_global ref ++ str " is a projection of " ++ pr_global (IndRef ind)] with Not_found -> [] end | _ -> [] (** Printing type-in-type status *) let print_type_in_type env ref = let unsafe = Environ.is_type_in_type env ref in if unsafe then [ pr_global ref ++ str " relies on an unsafe universe hierarchy"] else [] (** Printing primitive projection status *) let print_primitive_record recflag mipv = function | PrimRecord _ -> let eta = match recflag with | CoFinite | Finite -> str" without eta conversion" | BiFinite -> str " with eta conversion" in [Id.print mipv.(0).mind_typename ++ str" has primitive projections" ++ eta ++ str"."] | FakeRecord | NotRecord -> [] let print_primitive env ref = match ref with | GlobRef.IndRef ind -> let mib = Environ.lookup_mind (fst ind) env in print_primitive_record mib.mind_finite mib.mind_packets mib.mind_record | _ -> [] (** Printing arguments status (scopes, implicit, names) *) let needs_extra_scopes env ref scopes = let open Constr in let rec aux env t = function | [] -> false | _::scopes -> match kind (Reduction.whd_all env t) with | Prod (na,dom,codom) -> aux (push_rel (RelDecl.LocalAssum (na,dom)) env) codom scopes | _ -> true in let ty, _ctx = Typeops.type_of_global_in_context env ref in aux env ty scopes let implicit_kind_of_status = function | None -> Anonymous, Glob_term.Explicit | Some imp -> pi1 imp.impl_pos, if imp.impl_max then Glob_term.MaxImplicit else Glob_term.NonMaxImplicit let extra_implicit_kind_of_status imp = let _,imp = implicit_kind_of_status imp in (Anonymous, imp) let dummy = { Vernacexpr.implicit_status = Glob_term.Explicit; name = Anonymous; recarg_like = false; notation_scope = []; } let is_dummy = function | Vernacexpr.(RealArg {implicit_status; name; recarg_like; notation_scope}) -> name = Anonymous && not recarg_like && notation_scope = [] && implicit_status = Glob_term.Explicit | _ -> false let rec main_implicits i renames recargs scopes impls = if renames = [] && recargs = [] && scopes = [] && impls = [] then [] else let recarg_like, recargs = match recargs with | j :: recargs when i = j -> true, recargs | _ -> false, recargs in let (name, implicit_status) = match renames, impls with | _, (Some _ as i) :: _ -> implicit_kind_of_status i | name::_, _ -> (name,Glob_term.Explicit) | [], (None::_ | []) -> (Anonymous, Glob_term.Explicit) in let notation_scope = match scopes with | scope :: _ -> List.map (fun s -> CAst.make (Constrexpr.DelimUnboundedScope, s)) scope | [] -> [] in let status = {Vernacexpr.implicit_status; name; recarg_like; notation_scope} in let tl = function [] -> [] | _::tl -> tl in (* recargs is special -> tl handled above *) let rest = main_implicits (i+1) (tl renames) recargs (tl scopes) (tl impls) in status :: rest let rec insert_fake_args volatile bidi impls = let open Vernacexpr in match volatile, bidi with | Some 0, _ -> VolatileArg :: insert_fake_args None bidi impls | _, Some 0 -> BidiArg :: insert_fake_args volatile None impls | None, None -> List.map (fun a -> RealArg a) impls | _, _ -> let hd, tl = match impls with | impl :: impls -> impl, impls | [] -> dummy, [] in let f = Option.map pred in RealArg hd :: insert_fake_args (f volatile) (f bidi) tl let print_arguments env ref = let qid = Nametab.shortest_qualid_of_global Id.Set.empty ref in let flags, recargs, nargs_for_red = match ref with | ConstRef ref -> begin match Reductionops.ReductionBehaviour.get ref with | None -> [], [], None | Some NeverUnfold -> [`ReductionNeverUnfold], [], None | Some (UnfoldWhen { nargs; recargs }) -> [], recargs, nargs | Some (UnfoldWhenNoMatch { nargs; recargs }) -> [`ReductionDontExposeCase], recargs, nargs end | _ -> [], [], None in let names, not_renamed = try Arguments_renaming.arguments_names ref, false with Not_found -> let ty, _ = Typeops.type_of_global_in_context env ref in List.map pi1 (Impargs.compute_implicits_names env (Evd.from_env env) (EConstr.of_constr ty)), true in let scopes = Notation.find_arguments_scope ref in let flags = if needs_extra_scopes env ref scopes then `ExtraScopes::flags else flags in let impls = Impargs.extract_impargs_data (Impargs.implicits_of_global ref) in let impls, moreimpls = match impls with | (_, impls) :: rest -> impls, rest | [] -> assert false in let impls = main_implicits 0 names recargs scopes impls in let moreimpls = List.map (fun (_,i) -> List.map extra_implicit_kind_of_status i) moreimpls in let bidi = Pretyping.get_bidirectionality_hint ref in let impls = insert_fake_args nargs_for_red bidi impls in if List.for_all is_dummy impls && moreimpls = [] && flags = [] then [] else let open Constrexpr in let open Vernacexpr in [Ppvernac.pr_vernac_expr (VernacSynPure (VernacArguments (CAst.make (AN qid), impls, moreimpls, flags))) ++ (if not_renamed then mt () else fnl () ++ str " (where some original arguments have been renamed)")] (** Printing dependencies in section variables *) let print_section_deps env ref = let hyps = let open GlobRef in match ref with | VarRef _ -> None | ConstRef c -> let bd = Environ.lookup_constant c env in Some bd.const_hyps | IndRef (mind,_) | ConstructRef ((mind,_),_) -> let mb = Environ.lookup_mind mind env in Some mb.mind_hyps in let hyps = Option.map (List.filter NamedDecl.is_local_assum) hyps in match hyps with | None | Some [] -> [] | Some hyps -> [hov 0 (pr_global ref ++ str (String.plural (List.length hyps) " uses section variable") ++ spc () ++ hv 1 (prlist_with_sep spc (fun d -> Id.print (NamedDecl.get_id d)) (List.rev hyps)) ++ str ".")] (** Printing bidirectionality status *) let print_bidi_hints gr = match Pretyping.get_bidirectionality_hint gr with | None -> [] | Some nargs -> [str "Using typing information from context after typing the " ++ int nargs ++ str " first arguments"] (** Printing basic information about references (common to Print and About) *) let print_name_infos env ref = let type_info_for_implicit = if need_expansion env (select_impargs_size 0 (implicits_of_global ref)) ref then (* Need to reduce since implicits are computed with products flattened *) [str "Expanded type for implicit arguments"; print_ref env true ref None; blankline] else [] in print_type_in_type env ref @ print_prop_but_default_dep_elim ref @ print_projection env ref @ print_primitive env ref @ type_info_for_implicit @ print_arguments env ref @ print_section_deps env ref @ print_if_is_coercion ref (******************************************) (**** Printing declarations and judgments *) (**** Gallina layer *****) let print_typed_value_in_env env sigma (trm,typ) = (pr_leconstr_env ~inctx:true env sigma trm ++ fnl () ++ str " : " ++ pr_letype_env env sigma typ) (* To be improved; the type should be used to provide the types in the abstractions. This should be done recursively inside pr_lconstr, so that the pretty-print of a proposition (P:(nat->nat)->Prop)(P [u]u) synthesizes the type nat of the abstraction on u *) let print_named_def env sigma ~impargs name body typ = let pbody = pr_lconstr_env ~inctx:true env sigma body in let ptyp = pr_ltype_env env sigma ~impargs typ in let pbody = if Constr.isCast body then surround pbody else pbody in (str "*** [" ++ str name ++ str " " ++ hov 0 (str ":=" ++ brk (1,2) ++ pbody ++ spc () ++ str ":" ++ brk (1,2) ++ ptyp) ++ str "]") let print_named_assum env sigma ~impargs name typ = str "*** [" ++ str name ++ str " : " ++ pr_ltype_env env sigma ~impargs typ ++ str "]" let print_named_decl env sigma with_implicit id = let open Context.Named.Declaration in let impargs = if with_implicit then select_stronger_impargs (implicits_of_global (VarRef id)) else [] in let impargs = List.map binding_kind_of_status impargs in match lookup_named id env with | LocalAssum (id, typ) -> print_named_assum env sigma ~impargs (Id.to_string id.Context.binder_name) typ | LocalDef (id, body, typ) -> print_named_def env sigma ~impargs (Id.to_string id.Context.binder_name) body typ let assumptions_for_print lna = List.fold_right (fun na env -> add_name na env) lna empty_names_context (*********************) (* *) let print_inductive_args env mind mib = let flatmapi f v = List.flatten (Array.to_list (Array.mapi f v)) in let mips = (* We don't use the PrimRecord field as it misses the projections corresponding to local definition *) try Array.mapi (fun i mip -> let projs = Option.List.flatten (Structures.Structure.find_projections (mind,i)) in (mip.mind_consnames, Array.of_list projs)) mib.mind_packets with Not_found (* find_projections *) -> Array.map (fun mip -> (mip.mind_consnames,[||])) mib.mind_packets in flatmapi (fun i (constructs, projs) -> print_arguments env (GlobRef.IndRef (mind,i)) @ flatmapi (fun j _ -> print_arguments env (GlobRef.ConstructRef ((mind,i),j+1))) constructs @ flatmapi (fun _ cst -> print_arguments env (GlobRef.ConstRef cst)) projs) mips let print_inductive env mind udecl = let mib = Environ.lookup_mind mind env in Printmod.pr_mutual_inductive_body env mind mib udecl let print_inductive_with_infos env mind udecl = let mib = Environ.lookup_mind mind env in let mipv = mib.mind_packets in Printmod.pr_mutual_inductive_body env mind mib udecl ++ with_line_skip (print_primitive_record mib.mind_finite mipv mib.mind_record @ print_inductive_args env mind mib) let print_section_variable_with_infos env sigma id = print_named_decl env sigma true id ++ with_line_skip (print_name_infos env (GlobRef.VarRef id)) let print_typed_body env evd ~impargs (val_0,typ) = (pr_lconstr_env ~inctx:true env evd val_0 ++ fnl () ++ str " : " ++ pr_ltype_env env evd ~impargs typ) let print_instance sigma cb = if Declareops.constant_is_polymorphic cb then let univs = Declareops.constant_polymorphic_context cb in let inst = UVars.make_abstract_instance univs in pr_universe_instance sigma inst else mt() let print_constant env ~with_values with_implicit cst udecl = let cb = Environ.lookup_constant cst env in let typ = cb.const_type in let univs = cb.const_universes in let uctx = UState.of_names (Printer.universe_binders_with_opt_names (Declareops.constant_polymorphic_context cb) udecl) in let val_0 = match cb.const_body with (* XXX print something for primitives? for symbols? *) | Undef _ | Symbol _ | Primitive _ -> None | Def c -> Some ((if Option.has_some with_values then Some c else None), None) | OpaqueDef o -> match with_values with | None -> Some (None, None) | Some access -> let c, priv = Global.force_proof access o in let priv = match priv with | PrivateMonomorphic () -> None | PrivatePolymorphic priv -> Some priv in Some (Some c, priv) in let sigma = Evd.from_ctx uctx in let impargs = if with_implicit then select_stronger_impargs (implicits_of_global (ConstRef cst)) else [] in let impargs = List.map binding_kind_of_status impargs in let pr_ltype = pr_ltype_env env sigma in hov 0 ( match val_0 with | None -> str"*** [ " ++ print_basename cst ++ print_instance sigma cb ++ str " :" ++ spc () ++ pr_ltype ~impargs typ ++ str" ]" ++ Printer.pr_universes sigma univs | Some (optbody, priv) -> print_basename cst ++ print_instance sigma cb ++ str (if Option.has_some optbody then " =" else " :") ++ spc() ++ (match optbody with Some c-> print_typed_body env sigma ~impargs (c,typ) | None -> pr_ltype ~impargs typ)++ Printer.pr_universes sigma univs ?priv) let print_constant_with_infos env access cst udecl = print_constant env ~with_values:(Some access) true cst udecl ++ with_line_skip (print_name_infos env (GlobRef.ConstRef cst)) let print_global_reference access env sigma gref udecl = let open GlobRef in match gref with | ConstRef cst -> (match Structures.PrimitiveProjections.find_opt cst with | Some p -> print_inductive_with_infos env (fst (Projection.Repr.inductive p)) udecl | None -> print_constant_with_infos env access cst udecl) | IndRef (mind,_) -> print_inductive_with_infos env mind udecl | ConstructRef ((mind,_),_) -> print_inductive_with_infos env mind udecl | VarRef id -> print_section_variable_with_infos env sigma id let glob_constr_of_abbreviation kn = let (vars,a) = Abbreviation.search_abbreviation kn in (List.map fst vars, Notation_ops.glob_constr_of_notation_constr a) let print_abbreviation_body env kn (vars,c) = let qid = Nametab.shortest_qualid_of_abbreviation Id.Set.empty kn in hov 2 (hov 4 (str "Notation " ++ pr_qualid qid ++ prlist (fun id -> spc () ++ Id.print id) vars ++ spc () ++ str ":=") ++ spc () ++ Vernacstate.System.protect (fun () -> Abbreviation.toggle_abbreviation ~on:false ~use:ParsingAndPrinting kn; pr_glob_constr_env env (Evd.from_env env) c) ()) let print_abbreviation access env sigma kn = let (vars,c) = glob_constr_of_abbreviation kn in let pp = match DAst.get c with | GRef (gref,_udecl) -> (* TODO: don't drop universes? *) [print_global_reference access env sigma gref None] | _ -> [] in print_abbreviation_body env kn (vars,c) ++ with_line_skip pp (** Unused outside? *) let pr_prefix_name prefix = Id.print (snd (split_dirpath prefix.Nametab.obj_dir)) let print_library_node = function | Lib.OpenedSection (prefix, _) -> str " >>>>>>> Section " ++ pr_prefix_name prefix | Lib.OpenedModule (_,_,prefix,_) -> str " >>>>>>> Module " ++ pr_prefix_name prefix | Lib.CompilingLibrary { Nametab.obj_dir; _ } -> str " >>>>>>> Library " ++ DirPath.print obj_dir (** Printing part of command [Check] *) let print_judgment env sigma {uj_val=trm;uj_type=typ} = print_typed_value_in_env env sigma (trm, typ) let print_safe_judgment {Safe_typing.jdg_env=senv; jdg_val=trm; jdg_type=typ} = let env = Safe_typing.env_of_safe_env senv in let sigma = Evd.from_env env in let trm = EConstr.of_constr trm in let typ = EConstr.of_constr typ in print_typed_value_in_env env sigma (trm, typ) (** Command [Print All] *) module DynHandle = Libobject.Dyn.Map(struct type 'a t = 'a -> Pp.t option end) let handle h (Libobject.Dyn.Dyn (tag, o)) = match DynHandle.find tag h with | f -> f o | exception Not_found -> None (* TODO: this kind of feature should not rely on the Libobject stack. There is no reason that an object in the stack corresponds to a user-facing declaration. It may have been so at the time this was written, but this needs to be done in a more principled way. *) let print_library_leaf env sigma ~with_values mp lobj = match lobj with | AtomicObject o -> let handler = DynHandle.add Declare.Internal.objVariable begin fun id -> (* Outside sections, VARIABLES still exist but only with universes constraints *) (try Some(print_named_decl env sigma false id) with Not_found -> None) end @@ DynHandle.add Declare.Internal.Constant.tag begin fun (id,_) -> let kn = Constant.make2 mp (Label.of_id id) in Some (print_constant env ~with_values false kn None) end @@ DynHandle.add DeclareInd.Internal.objInductive begin fun (id,_) -> let kn = MutInd.make2 mp (Label.of_id id) in Some (print_inductive env kn None) end @@ DynHandle.empty in handle handler o | ModuleObject (id,_) -> Some (Printmod.print_module ~with_body:(Option.has_some with_values) (MPdot (mp,Label.of_id id))) | ModuleTypeObject (id,_) -> Some (print_modtype (MPdot (mp, Label.of_id id))) | IncludeObject _ | KeepObject _ | ExportObject _ -> None let decr = Option.map ((+) (-1)) let is_done = Option.equal Int.equal (Some 0) let print_leaves env sigma ~with_values mp n leaves = let rec prec n = function | [] -> n, [] | o :: rest -> if is_done n then n, [] else begin match print_library_leaf env sigma ~with_values mp o with | Some pp -> let n, prest = prec (decr n) rest in n, pp :: prest | None -> prec n rest end in let n, l = prec n leaves in n, v 0 (pr_sequence (fun x -> x) (List.rev l)) let print_context env sigma ~with_values = let rec prec n = function | [] -> mt() | (node, leaves) :: rest -> if is_done n then mt() else let mp = (Lib.node_prefix node).Nametab.obj_mp in let n, pleaves = print_leaves env sigma ~with_values mp n leaves in if is_done n then pleaves else prec n rest ++ pleaves in prec let print_full_context access env sigma = print_context env sigma ~with_values:(Some access) None (Lib.contents ()) let print_full_context_typ env sigma = (* Command [Print All] *) print_context env sigma ~with_values:None None (Lib.contents ()) (** Command line [-output-context] *) module DynHandleF = Libobject.Dyn.Map(struct type 'a t = 'a -> Pp.t end) let handleF h (Libobject.Dyn.Dyn (tag, o)) = match DynHandleF.find tag h with | f -> f o | exception Not_found -> mt () (* TODO: see the comment for {!print_leaf_entry} *) let print_full_pure_atomic access env sigma mp lobj = let handler = DynHandleF.add Declare.Internal.Constant.tag begin fun (id,_) -> let kn = KerName.make mp (Label.of_id id) in let con = Global.constant_of_delta_kn kn in let cb = Global.lookup_constant con in let typ = cb.const_type in hov 0 ( match cb.const_body with | Undef _ -> str "Parameter " ++ print_basename con ++ str " :" ++ spc () ++ pr_ltype_env env sigma typ | OpaqueDef lc -> str "Theorem " ++ print_basename con ++ cut () ++ str " : " ++ pr_ltype_env env sigma typ ++ str "." ++ fnl () ++ str "Proof " ++ pr_lconstr_env env sigma (fst (Global.force_proof access lc)) | Def c -> str "Definition " ++ print_basename con ++ cut () ++ str " : " ++ pr_ltype_env env sigma typ ++ cut () ++ str " := " ++ pr_lconstr_env env sigma c | Primitive _ -> str "Primitive " ++ print_basename con ++ str " :" ++ spc () ++ pr_ltype_env env sigma typ | Symbol _ -> str "Symbol " ++ print_basename con ++ str " :" ++ spc () ++ pr_ltype_env env sigma typ) ++ str "." ++ fnl () ++ fnl () end @@ DynHandleF.add DeclareInd.Internal.objInductive begin fun (id,_) -> let kn = KerName.make mp (Label.of_id id) in let mind = Global.mind_of_delta_kn kn in let mib = Global.lookup_mind mind in Printmod.pr_mutual_inductive_body (Global.env()) mind mib None ++ str "." ++ fnl () ++ fnl () end @@ DynHandleF.empty in handleF handler lobj let print_full_pure_leaf access env sigma mp = function | AtomicObject lobj -> print_full_pure_atomic access env sigma mp lobj | ModuleObject (id, _) -> (* TODO: make it reparsable *) print_module (MPdot (mp,Label.of_id id)) ++ str "." ++ fnl () ++ fnl () | ModuleTypeObject (id, _) -> (* TODO: make it reparsable *) print_modtype (MPdot (mp,Label.of_id id)) ++ str "." ++ fnl () ++ fnl () | _ -> mt() let print_full_pure_context access env sigma = let rec prec = function | (node,leaves)::rest -> let mp = (Lib.node_prefix node).Nametab.obj_mp in let pp = Pp.prlist (print_full_pure_leaf access env sigma mp) leaves in prec rest ++ pp | [] -> mt () in prec (Lib.contents ()) (** Command [Print Section] *) (* For printing an inductive definition with its constructors and elimination, assume that the declaration of constructors and eliminations follows the definition of the inductive type *) (* This is designed to print the contents of an opened section *) let read_sec_context qid = let dir = try Nametab.locate_section qid with Not_found -> user_err ?loc:qid.loc (str "Unknown section.") in let rec get_cxt in_cxt = function | (Lib.OpenedSection ({Nametab.obj_dir;_},_), _ as hd)::rest -> if DirPath.equal dir obj_dir then (hd::in_cxt) else get_cxt (hd::in_cxt) rest | [] -> [] | hd::rest -> get_cxt (hd::in_cxt) rest in let cxt = Lib.contents () in List.rev (get_cxt [] cxt) let print_sec_context access env sigma sec = print_context env sigma ~with_values:(Some access) None (read_sec_context sec) let print_sec_context_typ env sigma sec = print_context env sigma ~with_values:None None (read_sec_context sec) (** Command [Print] *) type 'a locatable_info = { locate : qualid -> 'a option; locate_all : qualid -> 'a list; shortest_qualid : 'a -> qualid; name : 'a -> Pp.t; print : 'a -> Pp.t; about : 'a -> Pp.t; } type logical_name = | Term of GlobRef.t | Dir of Nametab.GlobDirRef.t | Abbreviation of abbreviation | Module of ModPath.t | ModuleType of ModPath.t | Other : 'a * 'a locatable_info -> logical_name | Undefined of qualid type locatable = Locatable : 'a locatable_info -> locatable (** Generic table for objects that are accessible through a name. *) let locatable_map : locatable String.Map.t ref = ref String.Map.empty let register_locatable name f = locatable_map := String.Map.add name (Locatable f) !locatable_map exception ObjFound of logical_name let locate_any_name qid = try Term (Nametab.locate qid) with Not_found -> try Abbreviation (Nametab.locate_abbreviation qid) with Not_found -> try Dir (Nametab.locate_dir qid) with Not_found -> try Module (Nametab.locate_module qid) with Not_found -> try ModuleType (Nametab.locate_modtype qid) with Not_found -> let iter _ (Locatable info) = match info.locate qid with | None -> () | Some ans -> raise (ObjFound (Other (ans, info))) in try String.Map.iter iter !locatable_map; Undefined qid with ObjFound obj -> obj let canonical_info env ref = let cref = QGlobRef.canonize env ref in if GlobRef.UserOrd.equal ref cref then mt () else match Nametab.path_of_global cref with | path -> spc() ++ str "(syntactically equal to" ++ spc() ++ pr_path path ++ str ")" | exception Not_found -> spc() ++ str "(missing canonical, bug?)" let pr_located_qualid env = function | Term ref -> let ref_str = let open GlobRef in match ref with ConstRef _ -> "Constant" | IndRef _ -> "Inductive" | ConstructRef _ -> "Constructor" | VarRef _ -> "Variable" in let extra = canonical_info env ref in str ref_str ++ spc () ++ pr_path (Nametab.path_of_global ref) ++ extra | Abbreviation kn -> str "Notation" ++ spc () ++ pr_path (Nametab.path_of_abbreviation kn) | Dir dir -> let s,mp = let open Nametab in let open GlobDirRef in match dir with | DirOpenModule mp -> "Open Module", ModPath.print mp | DirOpenModtype mp -> "Open Module Type", ModPath.print mp | DirOpenSection dir -> "Open Section", DirPath.print dir in str s ++ spc () ++ mp | Module mp -> str "Module" ++ spc () ++ DirPath.print (Nametab.dirpath_of_module mp) | ModuleType mp -> str "Module Type" ++ spc () ++ pr_path (Nametab.path_of_modtype mp) | Other (obj, info) -> info.name obj | Undefined qid -> pr_qualid qid ++ spc () ++ str "not a defined object." let maybe_error_reject_univ_decl na udecl = let open GlobRef in match na, udecl with | _, None | Term (ConstRef _ | IndRef _ | ConstructRef _), Some _ -> () | (Term (VarRef _) | Abbreviation _ | Dir _ | Module _ | ModuleType _ | Other _ | Undefined _), Some udecl -> (* TODO Print na somehow *) user_err (str "This object does not support universe names.") let print_any_name access env sigma na udecl = maybe_error_reject_univ_decl na udecl; match na with | Term gref -> print_global_reference access env sigma gref udecl | Abbreviation kn -> print_abbreviation access env sigma kn | Module mp -> print_module mp | Dir _ -> mt () | ModuleType mp -> print_modtype mp | Other (obj, info) -> info.print obj | Undefined qid -> try (* A goal variable which is not a section variable *) let dir,str = repr_qualid qid in if not (DirPath.is_empty dir) then raise Not_found; print_named_decl env sigma true str with Not_found -> user_err ?loc:qid.loc (pr_qualid qid ++ spc () ++ str "not a defined object.") let print_notation_interpretation env sigma (entry,ntn) df sc c = let filter = Notation.{ notation_entry_pattern = [entry]; interp_rule_key_pattern = Some (Inl ntn); use_pattern = OnlyPrinting; scope_pattern = sc; interpretation_pattern = Some c; } in Vernacstate.System.protect (fun () -> Notation.toggle_notations ~on:false ~all:false ~verbose:false (pr_glob_constr_env env sigma) filter; hov 0 (str "Notation" ++ spc () ++ Notation_ops.pr_notation_info (pr_glob_constr_env env sigma) df (snd c))) () let print_name access env sigma na udecl = match na with | {loc; v=Constrexpr.ByNotation (ntn,sc)} -> let ntn, df, sc, c, ref = Notation.interp_notation_as_global_reference_expanded ?loc ~head:false (fun _ -> true) ntn sc in print_notation_interpretation env sigma ntn df (Some sc) c ++ fnl () ++ fnl () ++ print_any_name access env sigma (Term ref) udecl | {loc; v=Constrexpr.AN ref} -> print_any_name access env sigma (locate_any_name ref) udecl (** Command [Print Notation] *) let print_notation_grammar env sigma ntn = let ng = List.hd (Notgram_ops.grammar_of_notation ntn) in let assoc = ng.Notation_gram.notgram_assoc in let prdf () = Pp.str "no associativity" in Pp.(pr_opt_no_spc_default prdf Gramlib.Gramext.pr_assoc assoc) exception PrintNotationNotFound of Constrexpr.notation_entry * string let () = CErrors.register_handler @@ function | PrintNotationNotFound (entry, ntn_str) -> let entry_string = match entry with | Constrexpr.InConstrEntry -> "." | Constrexpr.InCustomEntry e -> " in " ^ e ^ " entry." in Some Pp.(str "\"" ++ str ntn_str ++ str "\"" ++ spc () ++ str "cannot be interpreted as a known notation" ++ str entry_string ++ spc () ++ strbrk "Make sure that symbols are surrounded by spaces and that holes are explicitly denoted by \"_\".") | _ -> None let error_print_notation_not_found e s = raise @@ PrintNotationNotFound (e, s) let print_notation env sigma entry raw_ntn = (* make sure entry exists *) let () = match entry with | Constrexpr.InConstrEntry -> () | Constrexpr.InCustomEntry e -> Metasyntax.check_custom_entry e in (* convert notation string to key. eg. "x + y" to "_ + _" *) let interp_ntn = Notation.interpret_notation_string raw_ntn in let ntn = (entry, interp_ntn) in try let lvl = Notation.level_of_notation ntn in let args = Notgram_ops.non_terminals_of_notation ntn in let pplvl = Metasyntax.pr_level ntn lvl args in Pp.(str "Notation \"" ++ str interp_ntn ++ str "\"" ++ spc () ++ pplvl ++ pr_comma () ++ print_notation_grammar env sigma ntn ++ str ".") with Not_found -> error_print_notation_not_found entry raw_ntn (** Command [About] *) let print_about_global_reference ?loc env ref udecl = pr_infos_list (print_ref env false ref udecl :: blankline :: print_polymorphism env ref @ print_name_infos env ref @ print_reduction_behaviour ref @ print_opacity env ref @ print_bidi_hints ref @ [hov 0 (str "Expands to: " ++ pr_located_qualid env (Term ref))]) let print_about_abbreviation env sigma kn = let (vars,c) = glob_constr_of_abbreviation kn in let pp = match DAst.get c with | GRef (gref,_udecl) -> (* TODO: don't drop universes? *) [print_about_global_reference env gref None] | _ -> [] in print_abbreviation_body env kn (vars,c) ++ fnl () ++ hov 0 (str "Expands to: " ++ pr_located_qualid env (Abbreviation kn)) ++ with_line_skip pp let print_about_any ?loc env sigma k udecl = maybe_error_reject_univ_decl k udecl; match k with | Term ref -> Dumpglob.add_glob ?loc ref; print_about_global_reference env ref udecl | Abbreviation kn -> v 0 (print_about_abbreviation env sigma kn) | Dir _ | Module _ | ModuleType _ | Undefined _ -> hov 0 (pr_located_qualid env k) | Other (obj, info) -> hov 0 (info.about obj) let print_about env sigma na udecl = match na with | {loc;v=Constrexpr.ByNotation (ntn,sc)} -> let ntn, df, sc, c, ref = Notation.interp_notation_as_global_reference_expanded ?loc ~head:false (fun _ -> true) ntn sc in print_notation_interpretation env sigma ntn df (Some sc) c ++ fnl () ++ fnl () ++ print_about_any ?loc env sigma (Term ref) udecl | {loc;v=Constrexpr.AN ref} -> print_about_any ?loc env sigma (locate_any_name ref) udecl (* Command [Inspect], for debug *) let inspect env sigma depth = print_context env sigma ~with_values:None (Some depth) (Lib.contents ()) (*************************************************************************) (* Pretty-printing functions coming from classops.ml *) (** Command [Print Classes] *) open Coercionops let print_coercion_value v = Printer.pr_global v.coe_value let print_path ((i,j),p) = hov 2 ( str"[" ++ hov 0 (prlist_with_sep pr_semicolon print_coercion_value p) ++ str"] : ") ++ pr_class i ++ str" >-> " ++ pr_class j ++ str (if path_is_reversible p then " (reversible)" else "") let _ = Coercionops.install_path_printer print_path let print_graph () = prlist_with_sep fnl print_path (inheritance_graph()) (** Command [Print Classes] *) let print_classes () = pr_sequence pr_class (classes()) (** Command [Print Coercions] *) let print_coercions () = pr_sequence print_coercion_value (coercions()) (** Command [Print Coercion Paths] *) let print_coercion_paths cls clt = let p = try lookup_path_between_class (cls, clt) with Not_found -> user_err (str"No path between " ++ pr_class cls ++ str" and " ++ pr_class clt ++ str ".") in print_path ((cls, clt), p) (** Command [Print Canonical Projections] *) let print_canonical_projections env sigma grefs = let open Structures in let match_proj_gref { CSTable.projection; value; solution } gr = QGlobRef.equal env projection gr || begin match value with | ValuePattern.Const_cs y -> QGlobRef.equal env y gr | _ -> false end || QGlobRef.equal env solution gr in let projs = List.filter (fun p -> List.for_all (match_proj_gref p) grefs) (CSTable.entries ()) in prlist_with_sep fnl (fun { CSTable.projection; value; solution } -> ValuePattern.print value ++ str " <- " ++ pr_global projection ++ str " ( " ++ pr_global solution ++ str " )") projs (***********************************************) (** Pretty-printing functions for type classes *) (** Command [Print Typeclasses] *) open Typeclasses let pr_typeclass env t = print_ref env false t.cl_impl None let print_typeclasses () = let env = Global.env () in prlist_with_sep fnl (pr_typeclass env) (typeclasses ()) (** Command [Print Instances] *) let pr_instance env i = (* print_constant_with_infos i.is_impl *) (* lighter *) print_ref env false (instance_impl i) None ++ begin match hint_priority i with | None -> mt () | Some i -> spc () ++ str "|" ++ spc () ++ int i end let print_all_instances () = let env = Global.env () in let inst = all_instances () in prlist_with_sep fnl (pr_instance env) inst let print_instances r = let env = Global.env () in let inst = instances_exn env (Evd.from_env env) r in prlist_with_sep fnl (pr_instance env) inst (*********************) (* Commands [Locate] *) let canonize_ref = let open GlobRef in function | ConstRef c -> let kn = Constant.canonical c in if KerName.equal (Constant.user c) kn then None else Some (ConstRef (Constant.make1 kn)) | IndRef (ind,i) -> let kn = MutInd.canonical ind in if KerName.equal (MutInd.user ind) kn then None else Some (IndRef (MutInd.make1 kn, i)) | ConstructRef ((ind,i),j) -> let kn = MutInd.canonical ind in if KerName.equal (MutInd.user ind) kn then None else Some (ConstructRef ((MutInd.make1 kn, i),j)) | VarRef _ -> None let display_alias = function | Term r -> begin match canonize_ref r with | None -> mt () | Some r' -> let q' = Nametab.shortest_qualid_of_global Id.Set.empty r' in spc () ++ str "(alias of " ++ pr_qualid q' ++ str ")" end | _ -> mt () let locate_term qid = let expand = function | TrueGlobal ref -> Term ref, Nametab.shortest_qualid_of_global Id.Set.empty ref | Abbrev kn -> Abbreviation kn, Nametab.shortest_qualid_of_abbreviation Id.Set.empty kn in List.map expand (Nametab.locate_extended_all qid) let locate_module qid = let all = Nametab.locate_extended_all_module qid in let map mp = Module mp, Nametab.shortest_qualid_of_module mp in let mods = List.map map all in (* Don't forget the opened modules: they are not part of the same name tab. *) let all = Nametab.locate_extended_all_dir qid in let map dir = let open Nametab.GlobDirRef in match dir with | DirOpenModule _ -> Some (Dir dir, qid) | _ -> None in mods @ List.map_filter map all let locate_modtype qid = let all = Nametab.locate_extended_all_modtype qid in let map mp = ModuleType mp, Nametab.shortest_qualid_of_modtype mp in let modtypes = List.map map all in (* Don't forget the opened module types: they are not part of the same name tab. *) let all = Nametab.locate_extended_all_dir qid in let map dir = let open Nametab.GlobDirRef in match dir with | DirOpenModtype _ -> Some (Dir dir, qid) | _ -> None in modtypes @ List.map_filter map all let locate_other s qid = let Locatable info = String.Map.find s !locatable_map in let ans = info.locate_all qid in let map obj = (Other (obj, info), info.shortest_qualid obj) in List.map map ans type locatable_kind = | LocTerm | LocModule | LocOther of string | LocAny let print_located_qualid env name flags qid = let located = match flags with | LocTerm -> locate_term qid | LocModule -> locate_modtype qid @ locate_module qid | LocOther s -> locate_other s qid | LocAny -> locate_term qid @ locate_modtype qid @ locate_module qid @ String.Map.fold (fun s _ accu -> locate_other s qid @ accu) !locatable_map [] in match located with | [] -> let (dir,id) = repr_qualid qid in if DirPath.is_empty dir then str "No " ++ str name ++ str " of basename" ++ spc () ++ Id.print id else str "No " ++ str name ++ str " of suffix" ++ spc () ++ pr_qualid qid | l -> prlist_with_sep fnl (fun (o,oqid) -> hov 2 (pr_located_qualid env o ++ (if not (qualid_eq oqid qid) then spc() ++ str "(shorter name to refer to it in current context is " ++ pr_qualid oqid ++ str")" else mt ()) ++ display_alias o)) l let print_located_term env ref = print_located_qualid env "term" LocTerm ref let print_located_other env s ref = print_located_qualid env s (LocOther s) ref let print_located_module env ref = print_located_qualid env "module" LocModule ref let print_located_qualid env ref = print_located_qualid env "object" LocAny ref coq-8.20.0/vernac/prettyp.mli000066400000000000000000000076401466560755400161040ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* Termops.names_context (* unused? *) val print_closed_sections : bool ref val print_context (* unused? *) : env -> Evd.evar_map -> with_values:Global.indirect_accessor option -> int option -> 'a Lib.library_segment -> Pp.t val print_library_leaf : env -> Evd.evar_map -> with_values:Global.indirect_accessor option -> ModPath.t -> Libobject.t -> Pp.t option val print_library_node : Summary.Interp.frozen Lib.node -> Pp.t (* unused? *) val print_full_context : Global.indirect_accessor -> env -> Evd.evar_map -> Pp.t val print_full_context_typ : env -> Evd.evar_map -> Pp.t val print_full_pure_context : Global.indirect_accessor -> env -> Evd.evar_map -> Pp.t val print_sec_context : Global.indirect_accessor -> env -> Evd.evar_map -> qualid -> Pp.t val print_sec_context_typ : env -> Evd.evar_map -> qualid -> Pp.t val print_judgment : env -> Evd.evar_map -> EConstr.unsafe_judgment -> Pp.t val print_safe_judgment : Safe_typing.judgment -> Pp.t val print_name : Global.indirect_accessor -> env -> Evd.evar_map -> qualid Constrexpr.or_by_notation -> UnivNames.full_name_list option -> Pp.t val print_notation : env -> Evd.evar_map -> Constrexpr.notation_entry -> string -> Pp.t val print_abbreviation : Global.indirect_accessor -> env -> Evd.evar_map -> KerName.t -> Pp.t val print_about : env -> Evd.evar_map -> qualid Constrexpr.or_by_notation -> UnivNames.full_name_list option -> Pp.t val print_impargs : env -> GlobRef.t -> Pp.t (** Pretty-printing functions for classes and coercions *) val print_graph : unit -> Pp.t val print_classes : unit -> Pp.t val print_coercions : unit -> Pp.t val print_coercion_paths : Coercionops.cl_typ -> Coercionops.cl_typ -> Pp.t val print_canonical_projections : env -> Evd.evar_map -> GlobRef.t list -> Pp.t (** Pretty-printing functions for type classes and instances *) val print_typeclasses : unit -> Pp.t val print_instances : GlobRef.t -> Pp.t val print_all_instances : unit -> Pp.t val inspect : env -> Evd.evar_map -> int -> Pp.t (** {5 Locate} *) type 'a locatable_info = { locate : qualid -> 'a option; (** Locate the most precise object with the provided name if any. *) locate_all : qualid -> 'a list; (** Locate all objects whose name is a suffix of the provided name *) shortest_qualid : 'a -> qualid; (** Return the shortest name in the current context *) name : 'a -> Pp.t; (** Data as printed by the Locate command *) print : 'a -> Pp.t; (** Data as printed by the Print command *) about : 'a -> Pp.t; (** Data as printed by the About command *) } (** Generic data structure representing locatable objects. *) val register_locatable : string -> 'a locatable_info -> unit (** Define a new type of locatable objects that can be reached via the corresponding generic vernacular commands. The string should be a unique name describing the kind of objects considered and that is added as a grammar command prefix for vernacular commands Locate. *) val print_located_qualid : env -> qualid -> Pp.t val print_located_term : env -> qualid -> Pp.t val print_located_module : env -> qualid -> Pp.t val print_located_other : env -> string -> qualid -> Pp.t coq-8.20.0/vernac/printmod.ml000066400000000000000000000414661466560755400160640ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* !short) ; optwrite = ((:=) short) } (** Each time we have to print a non-globally visible structure, we place its elements in a fake fresh namespace. *) let mk_fake_top = let r = ref 0 in fun () -> incr r; Id.of_string ("FAKETOP"^(string_of_int !r)) let def s = tag_definition (str s) let keyword s = tag_keyword (str s) let get_new_id locals id = let rec get_id l id = let dir = DirPath.make [id] in if not (Nametab.exists_module dir || Nametab.exists_dir dir) then id else get_id (Id.Set.add id l) (Namegen.next_ident_away id l) in let avoid = List.fold_left (fun accu (_, id) -> Id.Set.add id accu) Id.Set.empty locals in get_id avoid id (** Inductive declarations *) open Reduction let print_params env sigma params = if List.is_empty params then mt () else Printer.pr_rel_context env sigma params ++ brk(1,2) let print_constructors envpar sigma names types = let pc = prlist_with_sep (fun () -> brk(1,0) ++ str "| ") (fun (id,c) -> Id.print id ++ str " : " ++ Printer.pr_lconstr_env envpar sigma c) (Array.to_list (Array.map2 (fun n t -> (n,t)) names types)) in hv 0 (str " " ++ pc) let build_ind_type mip = Inductive.type_of_inductive mip let get_fields = let rec prodec_rec l subst c = match kind c with | Prod (na,t,c) -> let id = match na.binder_name with Name id -> id | Anonymous -> Id.of_string "_" in prodec_rec ((id,true,Vars.substl subst t)::l) (mkVar id::subst) c | LetIn (na,b,_,c) -> let id = match na.binder_name with Name id -> id | Anonymous -> Id.of_string "_" in prodec_rec ((id,false,Vars.substl subst b)::l) (mkVar id::subst) c | _ -> List.rev l in prodec_rec [] [] let print_fields envpar sigma cstrtypes = let fields = get_fields cstrtypes.(0) in hv 2 (str "{ " ++ prlist_with_sep (fun () -> str ";" ++ brk(2,0)) (fun (id,b,c) -> Id.print id ++ str (if b then " : " else " := ") ++ Printer.pr_lconstr_env envpar sigma c) fields) ++ str" }" let is_canonical_as ind indname id = (* See record.ml *) let canonical_id = Record.canonical_inhabitant_id ~isclass:(Typeclasses.is_class (IndRef ind)) indname in Id.equal id canonical_id let print_as ind indname = function | Anonymous -> mt () (* TODO: get the "as" name also for non-primitive records *) | Name id -> if is_canonical_as ind indname id then mt () else str " as " ++ Id.print id let print_one_inductive env sigma isrecord mib ((_,i) as ind, as_clause) = let u = UVars.make_abstract_instance (Declareops.inductive_polymorphic_context mib) in let mip = mib.mind_packets.(i) in let paramdecls = Inductive.inductive_paramdecls (mib,u) in let env_params, params = Namegen.make_all_rel_context_name_different env (Evd.from_env env) (EConstr.of_rel_context paramdecls) in let params = EConstr.Unsafe.to_rel_context params in let nparamdecls = Context.Rel.length params in let args = Context.Rel.instance_list mkRel 0 params in let arity = hnf_prod_applist_decls env nparamdecls (build_ind_type ((mib,mip),u)) args in let cstrtypes = Inductive.type_of_constructors (ind,u) (mib,mip) in let cstrtypes = Array.map (fun c -> snd (Term.decompose_prod_n_decls nparamdecls c)) cstrtypes in if isrecord then assert (Array.length cstrtypes = 1); let inst = if Declareops.inductive_is_polymorphic mib then Printer.pr_universe_instance sigma u else mt () in hov 0 ( Id.print mip.mind_typename ++ inst ++ brk(1,4) ++ print_params env sigma params ++ str ": " ++ Printer.pr_lconstr_env env_params sigma arity ++ str " :=" ++ if isrecord then str " " ++ Id.print mip.mind_consnames.(0) else mt()) ++ if not isrecord then brk(0,2) ++ print_constructors env_params sigma mip.mind_consnames cstrtypes else brk(1,2) ++ print_fields env_params sigma cstrtypes ++ print_as ind mip.mind_typename as_clause let pr_mutual_inductive_body env mind mib udecl = let inds = List.init (Array.length mib.mind_packets) (fun x -> (mind, x)) in let default_as = List.make (Array.length mib.mind_packets) Anonymous in let keyword, isrecord, as_clause = let open Declarations in match mib.mind_finite with | Finite -> "Inductive", false, default_as | CoFinite -> "CoInductive", false, default_as | BiFinite -> match mib.mind_record with | FakeRecord when not !Flags.raw_print -> "Record", true, default_as | PrimRecord l -> "Record", true, Array.map_to_list (fun (id,_,_,_) -> Name id) l | FakeRecord | NotRecord -> "Variant", false, default_as in let bl = Printer.universe_binders_with_opt_names (Declareops.inductive_polymorphic_context mib) udecl in let sigma = Evd.from_ctx (UState.of_names bl) in let inds_as = List.combine inds as_clause in hov 0 (def keyword ++ spc () ++ prlist_with_sep (fun () -> fnl () ++ str" with ") (print_one_inductive env sigma isrecord mib) inds_as ++ str "." ++ Printer.pr_universes sigma ?variance:mib.mind_variance mib.mind_universes) (** Modpaths *) let rec print_local_modpath locals = function | MPbound mbid -> Id.print (Util.List.assoc_f MBId.equal mbid locals) | MPdot(mp,l) -> print_local_modpath locals mp ++ str "." ++ Label.print l | MPfile _ -> raise Not_found let print_modpath locals mp = try (* must be with let because streams are lazy! *) let qid = Nametab.shortest_qualid_of_module mp in pr_qualid qid with | Not_found -> print_local_modpath locals mp let print_kn locals kn = try let qid = Nametab.shortest_qualid_of_modtype kn in pr_qualid qid with Not_found -> try print_local_modpath locals kn with Not_found -> print_modpath locals kn let nametab_register_dir obj_mp = let id = mk_fake_top () in let obj_dir = DirPath.make [id] in Nametab.(push_module (Until 1) obj_dir obj_mp) (** Nota: the [global_reference] we register in the nametab below might differ from internal ones, since we cannot recreate here the canonical part of constant and inductive names, but only the user names. This works nonetheless since we search now [Nametab.the_globrevtab] modulo user name. *) let nametab_register_body mp dir (l,body) = let push id ref = Nametab.push (Nametab.Until (1+List.length (DirPath.repr dir))) (make_path dir id) ref in match body with | SFBmodule _ -> () (* TODO *) | SFBmodtype _ -> () (* TODO *) | SFBrules _ -> () (* TODO? *) | SFBconst _ -> push (Label.to_id l) (GlobRef.ConstRef (Constant.make2 mp l)) | SFBmind mib -> let mind = MutInd.make2 mp l in Array.iteri (fun i mip -> push mip.mind_typename (GlobRef.IndRef (mind,i)); Array.iteri (fun j id -> push id (GlobRef.ConstructRef ((mind,i),j+1))) mip.mind_consnames) mib.mind_packets (* TODO only import printing-relevant objects (or find a way to print without importing) *) let import_module = Declaremods.Interp.import_module Libobject.unfiltered let process_module_binding = Declaremods.process_module_binding let nametab_register_module_body mp struc = (* If [mp] is a globally visible module, we simply import it *) try import_module ~export:Lib.Import mp with Not_found -> (* Otherwise we try to emulate an import by playing with nametab *) nametab_register_dir mp; List.iter (nametab_register_body mp DirPath.empty) struc let get_typ_expr_alg mtb = match mtb.mod_type_alg with | Some (MENoFunctor me) -> me | _ -> raise Not_found let nametab_register_modparam used mbid mtb = let id = MBId.to_id mbid in match mtb.mod_type with | MoreFunctor _ -> id (* functorial param : nothing to register *) | NoFunctor struc -> (* We first try to use the algebraic type expression if any, via a Declaremods function that converts back to module entries *) try let () = process_module_binding mbid (get_typ_expr_alg mtb) in id with e when CErrors.noncritical e -> (* Otherwise, we try to play with the nametab ourselves *) let mp = MPbound mbid in let check id = Id.Set.mem id used || Nametab.exists_module (DirPath.make [id]) in let id = Namegen.next_ident_away_from id check in let dir = DirPath.make [id] in nametab_register_dir mp; List.iter (nametab_register_body mp dir) struc; id let print_body is_impl extent env mp (l,body) = let name = Label.print l in hov 2 (match body with | SFBmodule _ -> keyword "Module" ++ spc () ++ name | SFBmodtype _ -> keyword "Module Type" ++ spc () ++ name | SFBrules _ -> keyword "Rewrite Rule" ++ spc () ++ name (* TODO: correct? *) | SFBconst cb -> let ctx = Declareops.constant_polymorphic_context cb in (match cb.const_body with | Def _ -> def "Definition" ++ spc () | OpaqueDef _ when is_impl -> def "Theorem" ++ spc () | _ -> def "Parameter" ++ spc ()) ++ name ++ (match extent with | OnlyNames -> mt () | WithContents -> let bl = Printer.universe_binders_with_opt_names ctx None in let sigma = Evd.from_ctx (UState.of_names bl) in str " :" ++ spc () ++ hov 0 (Printer.pr_ltype_env env sigma cb.const_type) ++ (match cb.const_body with | Def l when is_impl -> spc () ++ hov 2 (str ":= " ++ Printer.pr_lconstr_env env sigma l) | _ -> mt ()) ++ str "." ++ Printer.pr_abstract_universe_ctx sigma ctx) | SFBmind mib -> match extent with | WithContents -> pr_mutual_inductive_body env (MutInd.make2 mp l) mib None | OnlyNames -> let keyword = let open Declarations in match mib.mind_finite with | Finite -> def "Inductive" | BiFinite -> def "Variant" | CoFinite -> def "CoInductive" in keyword ++ spc () ++ name) let print_struct is_impl extent env mp struc = prlist_with_sep spc (print_body is_impl extent env mp) struc let print_structure is_type extent env mp locals struc = let env' = Modops.add_structure mp struc Mod_subst.empty_delta_resolver env in nametab_register_module_body mp struc; let kwd = if is_type then "Sig" else "Struct" in hv 2 (keyword kwd ++ spc () ++ print_struct false extent env' mp struc ++ brk (1,-2) ++ keyword "End") let rec flatten_app mexpr l = match mexpr with | MEapply (mexpr, arg) -> flatten_app mexpr (arg::l) | MEident mp -> mp::l | MEwith _ -> assert false let rec print_typ_expr extent env mp locals mty = match mty with | MEident kn -> print_kn locals kn | MEapply _ -> let lapp = flatten_app mty [] in let fapp = List.hd lapp in let mapp = List.tl lapp in hov 3 (str"(" ++ (print_kn locals fapp) ++ spc () ++ prlist_with_sep spc (print_modpath locals) mapp ++ str")") | MEwith(me,WithDef(idl,(c, _)))-> let s = String.concat "." (List.map Id.to_string idl) in let body = match extent with | WithContents -> let sigma = Evd.from_env env in spc() ++ str ":=" ++ spc() ++ Printer.pr_lconstr_env env sigma c | OnlyNames -> mt() in hov 2 (print_typ_expr extent env mp locals me ++ spc() ++ str "with" ++ spc() ++ def "Definition"++ spc() ++ str s ++ body) | MEwith(me,WithMod(idl,mp'))-> let s = String.concat "." (List.map Id.to_string idl) in let body = match extent with | WithContents -> spc() ++ str ":="++ spc() ++ print_modpath locals mp' | OnlyNames -> mt () in hov 2 (print_typ_expr extent env mp locals me ++ spc() ++ str "with" ++ spc() ++ keyword "Module"++ spc() ++ str s ++ body) let print_mod_expr env mp locals = function | MEident mp -> print_modpath locals mp | MEapply _ as me -> let lapp = flatten_app me [] in hov 3 (str"(" ++ prlist_with_sep spc (print_modpath locals) lapp ++ str")") | MEwith _ -> assert false (* No 'with' syntax for modules *) let rec print_functor fty fatom is_type extent env mp used locals = function | NoFunctor me -> fatom is_type extent env mp locals me | MoreFunctor (mbid,mtb1,me2) -> let id = nametab_register_modparam !used mbid mtb1 in let () = used := Id.Set.add id !used in let mp1 = MPbound mbid in let pr_mtb1 = fty extent env mp1 used locals mtb1 in let env' = Modops.add_module_type mp1 mtb1 env in let locals' = (mbid, get_new_id locals (MBId.to_id mbid))::locals in let kwd = if is_type then "Funsig" else "Functor" in hov 2 (keyword kwd ++ spc () ++ str "(" ++ Id.print id ++ str ":" ++ pr_mtb1 ++ str ")" ++ spc() ++ print_functor fty fatom is_type extent env' mp used locals' me2) let rec print_expression x = print_functor print_modtype (function true -> print_typ_expr | false -> fun _ -> print_mod_expr) x and print_signature x = print_functor print_modtype print_structure x and print_modtype extent env mp used locals mtb = match mtb.mod_type_alg with | Some me -> let me = Modops.annotate_module_expression me mtb.mod_type in print_expression true extent env mp used locals me | None -> print_signature true extent env mp used locals mtb.mod_type (** Since we might play with nametab above, we should reset to prior state after the printing *) let print_expression' is_type extent env mp me = Vernacstate.System.protect (fun e -> print_expression is_type extent env mp (ref Id.Set.empty) [] e) me let print_signature' is_type extent env mp me = Vernacstate.System.protect (fun e -> print_signature is_type extent env mp (ref Id.Set.empty) [] e) me let unsafe_print_module extent env mp with_body mb = let name = print_modpath [] mp in let pr_equals = spc () ++ str ":= " in let body = match with_body, mb.mod_expr with | false, _ | true, Abstract -> mt() | _, Algebraic me -> let me = Modops.annotate_module_expression me mb.mod_type in pr_equals ++ print_expression' false extent env mp me | _, Struct sign -> let sign = Modops.annotate_struct_body sign mb.mod_type in pr_equals ++ print_signature' false extent env mp sign | _, FullStruct -> pr_equals ++ print_signature' false extent env mp mb.mod_type in let modtype = match mb.mod_expr, mb.mod_type_alg with | FullStruct, _ -> mt () | _, Some ty -> let ty = Modops.annotate_module_expression ty mb.mod_type in brk (1,1) ++ str": " ++ print_expression' true extent env mp ty | _, _ -> brk (1,1) ++ str": " ++ print_signature' true extent env mp mb.mod_type in hv 0 (keyword "Module" ++ spc () ++ name ++ modtype ++ body) exception ShortPrinting let print_module ~with_body mp = let me = Global.lookup_module mp in try if !short then raise ShortPrinting; unsafe_print_module WithContents (Global.env ()) mp with_body me with e when CErrors.noncritical e -> unsafe_print_module OnlyNames (Global.env ()) mp with_body me let print_modtype kn = let mtb = Global.lookup_modtype kn in let name = print_kn [] kn in hv 1 (keyword "Module Type" ++ spc () ++ name ++ str " =" ++ spc () ++ try if !short then raise ShortPrinting; print_signature' true WithContents (Global.env ()) kn mtb.mod_type with e when CErrors.noncritical e -> print_signature' true OnlyNames (Global.env ()) kn mtb.mod_type) coq-8.20.0/vernac/printmod.mli000066400000000000000000000016311466560755400162230ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* MutInd.t -> Declarations.mutual_inductive_body -> UnivNames.full_name_list option -> Pp.t val print_module : with_body:bool -> ModPath.t -> Pp.t val print_modtype : ModPath.t -> Pp.t coq-8.20.0/vernac/proof_using.ml000066400000000000000000000223111466560755400165460ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* let vb = match decl with | LocalAssum _ -> Id.Set.empty | LocalDef (_,b,_) -> Termops.global_vars_set env sigma b in let vty = Termops.global_vars_set env sigma (NamedDecl.get_type decl) in let vbty = Id.Set.union vb vty in if Id.Set.exists (fun v -> Id.Set.mem v s) vbty then Id.Set.add (NamedDecl.get_id decl) (Id.Set.union s vbty) else s) s (EConstr.named_context env) in if Id.Set.equal s s' then s else close_fwd env sigma s' let set_of_type env sigma fixnames ty = List.fold_right Id.Set.remove fixnames (List.fold_left (fun acc ty -> Id.Set.union (Termops.global_vars_set env sigma ty) acc) Id.Set.empty ty) let full_set fixnames env = let add id ids = if List.mem_f Id.equal id fixnames then ids else Id.Set.add id ids in List.fold_right add (List.map NamedDecl.get_id (named_context env)) Id.Set.empty let warn_all_collection_precedence = CWarnings.create ~name:"all-collection-precedence" ~category:Deprecation.Version.v8_15 Pp.(fun () -> str "Variable " ++ Id.print all_collection_id ++ str " is shadowed by Collection named " ++ Id.print all_collection_id ++ str " containing all variables.") let warn_collection_precedence = CWarnings.create ~name:"collection-precedence" ~category:Deprecation.Version.v8_15 Pp.(fun id -> Id.print id ++ str " is both name of a Collection and Variable, Collection " ++ Id.print id ++ str " takes precedence over Variable.") let warn_redefine_collection = CWarnings.create ~name:"collection-redefinition" ~category:Deprecation.Version.v8_15 Pp.(fun id -> str "New Collection definition of " ++ Id.print id ++ str " shadows the previous one.") let warn_variable_shadowing = CWarnings.create ~name:"variable-shadowing" ~category:Deprecation.Version.v8_15 Pp.(fun id -> Id.print id ++ str " was already a defined Variable, the name " ++ Id.print id ++ str " will refer to Collection when executing \"Proof using\" command.") let err_redefine_all_collection () = CErrors.user_err Pp.(str "\"" ++ Id.print all_collection_id ++ str "\" is a predefined collection containing all variables. It can't be redefined.") let process_expr env sigma fixnames e v_ty = let variable_exists id = try ignore (lookup_named id env); true with | Not_found -> false in let rec aux = function | SsEmpty -> Id.Set.empty | SsType -> v_ty | SsSingl { CAst.v = id } -> set_of_id id | SsUnion(e1,e2) -> Id.Set.union (aux e1) (aux e2) | SsSubstr(e1,e2) -> Id.Set.diff (aux e1) (aux e2) | SsCompl e -> Id.Set.diff (full_set fixnames env) (aux e) | SsFwdClose e -> close_fwd env sigma (aux e) and set_of_id id = if Id.equal id all_collection_id then begin if variable_exists all_collection_id then warn_all_collection_precedence (); full_set fixnames env end else if is_known_name id then begin if variable_exists id then warn_collection_precedence id; aux (CList.assoc_f Id.equal id !known_names) end else if List.exists (Id.equal id) fixnames then CErrors.user_err Pp.(str "Invalid recursive variable: " ++ Id.print id ++ str ".") else if not (List.exists (NamedDecl.get_id %> Id.equal id) (named_context env)) then CErrors.user_err Pp.(str "Unknown variable: " ++ Id.print id ++ str ".") else Id.Set.singleton id in aux e let process_expr env sigma fixnames e ty = let v_ty = set_of_type env sigma fixnames ty in let s = Id.Set.union v_ty (process_expr env sigma fixnames e v_ty) in Id.Set.elements s type t = Names.Id.Set.t let definition_using env evd ~fixnames ~using ~terms = let l = process_expr env evd fixnames using terms in Names.Id.Set.(List.fold_right add l empty) let name_set id expr = if Id.equal id all_collection_id then err_redefine_all_collection (); if is_known_name id then warn_redefine_collection id; if Termops.is_section_variable (Global.env ()) id then warn_variable_shadowing id; known_names := (id,expr) :: !known_names let minimize_hyps env ids = let rec aux ids = let ids' = Id.Set.fold (fun id alive -> let impl_by_id = Id.Set.remove id (really_needed env (Id.Set.singleton id)) in if Id.Set.is_empty impl_by_id then alive else Id.Set.diff alive impl_by_id) ids ids in if Id.Set.equal ids ids' then ids else aux ids' in aux ids let remove_ids_and_lets env s ids = let not_ids id = not (Id.Set.mem id ids) in let no_body id = named_body id env = None in let deps id = really_needed env (Id.Set.singleton id) in (Id.Set.filter (fun id -> not_ids id && (no_body id || Id.Set.exists not_ids (Id.Set.filter no_body (deps id)))) s) let record_proof_using expr = Aux_file.record_in_aux "suggest_proof_using" expr let debug_proof_using = CDebug.create ~name:"proof-using" () (* Variables in [skip] come from after the definition, so don't count for "All". Used in the variable case since the env contains the variable itself. *) let suggest_common env ppid used ids_typ skip = let module S = Id.Set in let open Pp in let pr_set parens s = let wrap ppcmds = if parens && S.cardinal s > 1 then str "(" ++ ppcmds ++ str ")" else ppcmds in wrap (prlist_with_sep (fun _ -> str" ") Id.print (S.elements s)) in let needed = minimize_hyps env (remove_ids_and_lets env used ids_typ) in let all_needed = really_needed env needed in let all = List.fold_left (fun all d -> S.add (NamedDecl.get_id d) all) S.empty (named_context env) in let all = S.diff all skip in let fwd_typ = close_fwd env (Evd.from_env env) ids_typ in let () = debug_proof_using (fun () -> str "All " ++ pr_set false all ++ fnl() ++ str "Type " ++ pr_set false ids_typ ++ fnl() ++ str "needed " ++ pr_set false needed ++ fnl() ++ str "all_needed " ++ pr_set false all_needed ++ fnl() ++ str "Type* " ++ pr_set false fwd_typ) in let valid_exprs = ref [] in let valid e = valid_exprs := e :: !valid_exprs in if S.is_empty needed then valid (str "Type"); if S.equal all_needed fwd_typ then valid (str "Type*"); if S.equal all all_needed then valid(str "All"); valid (pr_set false needed); Feedback.msg_info ( str"The proof of "++ ppid ++ spc() ++ str "should start with one of the following commands:"++spc()++ v 0 ( prlist_with_sep cut (fun x->str"Proof using " ++x++ str". ") !valid_exprs)); if Aux_file.recording () then let s = string_of_ppcmds (prlist_with_sep (fun _ -> str";") (fun x->x) !valid_exprs) in record_proof_using s let suggest_proof_using = ref false let () = Goptions.(declare_bool_option { optstage = Summary.Stage.Interp; optdepr = None; optkey = ["Suggest";"Proof";"Using"]; optread = (fun () -> !suggest_proof_using); optwrite = ((:=) suggest_proof_using) }) let suggest_constant env kn = if !suggest_proof_using then begin let open Declarations in let body = lookup_constant kn env in let used = Id.Set.of_list @@ List.map NamedDecl.get_id body.const_hyps in let ids_typ = global_vars_set env body.const_type in suggest_common env (Printer.pr_constant env kn) used ids_typ Id.Set.empty end let suggest_variable env id = if !suggest_proof_using then begin match lookup_named id env with | LocalDef (_,body,typ) -> let ids_typ = global_vars_set env typ in let ids_body = global_vars_set env body in let used = Id.Set.union ids_body ids_typ in suggest_common env (Id.print id) used ids_typ (Id.Set.singleton id) | LocalAssum _ -> assert false end let value = ref None let using_to_string us = Pp.string_of_ppcmds (Ppvernac.pr_using us) let entry = Pcoq.eoi_entry G_vernac.section_subset_expr let using_from_string us = Pcoq.Entry.parse entry (Pcoq.Parsable.make (Gramlib.Stream.of_string ("( "^us^" )"))) let proof_using_opt_name = ["Default";"Proof";"Using"] let () = Goptions.(declare_stringopt_option { optstage = Summary.Stage.Interp; optdepr = None; optkey = proof_using_opt_name; optread = (fun () -> Option.map using_to_string !value); optwrite = (fun b -> value := Option.map using_from_string b); }) let get_default_proof_using () = !value coq-8.20.0/vernac/proof_using.mli000066400000000000000000000027741466560755400167320ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* Evd.evar_map -> fixnames:Names.Id.t list (* names of fixpoint occurring recursively, if any *) -> using:Vernacexpr.section_subset_expr -> terms:EConstr.constr list -> t val name_set : Names.Id.t -> Vernacexpr.section_subset_expr -> unit val suggest_constant : Environ.env -> Names.Constant.t -> unit val suggest_variable : Environ.env -> Names.Id.t -> unit val get_default_proof_using : unit -> Vernacexpr.section_subset_expr option val proof_using_opt_name : string list (** For the stm *) val using_from_string : string -> Vernacexpr.section_subset_expr coq-8.20.0/vernac/pvernac.ml000066400000000000000000000060431466560755400156560ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* CErrors.anomaly Pp.(str "proof mode not found: " ++ str ename) in let lookup_proof_mode name = if Hashtbl.mem proof_mode name then Some name else None in let list_proof_modes () = Hashtbl.fold CString.Map.add proof_mode CString.Map.empty in register_proof_mode, find_proof_mode, lookup_proof_mode, list_proof_modes let proof_mode_to_string name = name let command_entry_ref = ref None module Vernac_ = struct (* The different kinds of vernacular commands *) let gallina = Entry.make "gallina" let gallina_ext = Entry.make "gallina_ext" let command = Entry.make "command" let syntax = Entry.make "syntax_command" let vernac_control = Entry.make "vernac_control" let inductive_or_record_definition = Entry.make "inductive_or_record_definition" let fix_definition = Entry.make "fix_definition" let red_expr = Entry.make "red_expr" let hint_info = Entry.make "hint_info" (* Main vernac entry *) let main_entry = Entry.make "vernac" let noedit_mode = Entry.make "noedit_command" let () = let act_vernac v loc = Some v in let act_eoi _ loc = None in let rule = [ Pcoq.(Production.make (Rule.next Rule.stop (Symbol.token Tok.PEOI)) act_eoi); Pcoq.(Production.make (Rule.next Rule.stop (Symbol.nterm vernac_control)) act_vernac); ] in Pcoq.(grammar_extend main_entry (Fresh (Gramlib.Gramext.First, [None, None, rule]))) let select_tactic_entry spec = match spec with | None -> noedit_mode | Some ename -> find_proof_mode ename let command_entry = Pcoq.Entry.(of_parser "command_entry" { parser_fun = (fun _kwstate strm -> Pcoq.Entry.parse_token_stream (select_tactic_entry !command_entry_ref) strm) }) end module Unsafe = struct let set_tactic_entry oname = command_entry_ref := oname end let main_entry proof_mode = Unsafe.set_tactic_entry proof_mode; Vernac_.main_entry let () = register_grammar Redexpr.wit_red_expr (Vernac_.red_expr); coq-8.20.0/vernac/pvernac.mli000066400000000000000000000043571466560755400160350ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* unit end (** The main entry: reads an optional vernac command *) val main_entry : proof_mode option -> vernac_control option Entry.t (** Grammar entry for tactics: proof mode(s). By default Coq's grammar has an empty entry (non-terminal) for tactics. A plugin can register its non-terminal by providing a name and a grammar entry. For example the Ltac plugin register the "Classic" grammar entry for parsing its tactics. *) val register_proof_mode : string -> Vernacexpr.vernac_expr Entry.t -> proof_mode val lookup_proof_mode : string -> proof_mode option val proof_mode_to_string : proof_mode -> string val list_proof_modes : unit -> Vernacexpr.vernac_expr Entry.t CString.Map.t coq-8.20.0/vernac/recLemmas.ml000066400000000000000000000071111466560755400161250ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* let typ = Declare.CInfo.get_typ x in let (hyps,ccl) = EConstr.decompose_prod_decls sigma typ in let whnf_hyp_hds = EConstr.map_rel_context_in_env (fun env c -> fst (Reductionops.whd_all_stack env sigma c)) (Global.env()) hyps in let ind_hyps = List.flatten (List.map_i (fun i decl -> let t = RelDecl.get_type decl in match EConstr.kind sigma t with | Ind ((kn,_ as ind),u) when let mind = Global.lookup_mind kn in mind.mind_finite <> Declarations.CoFinite -> [ind,x,i] | _ -> []) 0 (List.rev (List.filter Context.Rel.Declaration.is_local_assum whnf_hyp_hds))) in let ind_ccl = let cclenv = EConstr.push_rel_context hyps (Global.env()) in let whnf_ccl,_ = Reductionops.whd_all_stack cclenv sigma ccl in match EConstr.kind sigma whnf_ccl with | Ind ((kn,_ as ind),u) when (Global.lookup_mind kn).mind_finite == Declarations.CoFinite -> [ind,x,0] | _ -> [] in ind_hyps,ind_ccl) thms in let inds_hyps,ind_ccls = List.split inds in let of_same_mutind ((kn,_),_,_) = function ((kn',_),_,_) -> Environ.QMutInd.equal (Global.env ()) kn kn' in (* Check if all conclusions are coinductive in the same type *) (* (degenerated cartesian product since there is at most one coind ccl) *) let same_indccl = List.cartesians_filter (fun hyp oks -> if List.for_all (of_same_mutind hyp) oks then Some (hyp::oks) else None) [] ind_ccls in let common_same_indhyp = List.cartesians_filter (fun hyp oks -> if List.for_all (of_same_mutind hyp) oks then Some (hyp::oks) else None) [] inds_hyps in let possibly_cofix = not (List.is_empty same_indccl) in (* all conclusions are coinductive *) let possible_fix_indices = match common_same_indhyp with | [] -> [] | _::_ -> (* assume the largest indices as possible *) List.map (List.map pi3) inds_hyps in if not possibly_cofix && List.is_empty possible_fix_indices then CErrors.user_err Pp.(str ("Cannot find common (mutual) inductive premises or coinductive" ^ " conclusions in the statements.")); Pretyping.{possibly_cofix; possible_fix_indices} type mutual_info = | NonMutual of EConstr.t Declare.CInfo.t | Mutual of Pretyping.possible_guard let look_for_possibly_mutual_statements sigma thms : mutual_info = match thms with | [thm] -> (* One non recursively proved theorem *) NonMutual thm | _::_ as thms -> (* More than one statement and/or an explicit decreasing mark: *) Mutual (find_mutually_recursive_statements sigma thms) | [] -> CErrors.anomaly (Pp.str "Empty list of theorems.") coq-8.20.0/vernac/recLemmas.mli000066400000000000000000000015711466560755400163020ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* EConstr.t Declare.CInfo.t list -> mutual_info coq-8.20.0/vernac/record.ml000066400000000000000000001305151466560755400155000ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* let sigma, (i, b, t), impl = match d with | Vernacexpr.AssumExpr({CAst.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.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_env | Name id -> Id.Map.add id (Constrintern.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) in 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) -> let sigma = RelDecl.fold_constr (fun c sigma -> ComInductive.maybe_unify_params_in env sigma ~ninds ~nparams ~binders:k c) f sigma in EConstr.push_rel f env, k+1, sigma) newfs in sigma, (impls, newfs) let check_anonymous_type ind = match ind with | { CAst.v = CSort s } -> Constrexpr_ops.(sort_expr_eq expr_Type_sort s) | _ -> false let error_parameters_must_be_named bk {CAst.loc; v=name} = match bk, name with | Default _, Anonymous -> CErrors.user_err ?loc (str "Record parameters must be named.") | _ -> () let check_parameters_must_be_named = function | CLocalDef (b, _, _, _) -> error_parameters_must_be_named default_binder_kind b | CLocalAssum (ls, _, bk, _ce) -> List.iter (error_parameters_must_be_named bk) ls | CLocalPattern {CAst.loc} -> Loc.raise ?loc (Gramlib.Grammar.Error "pattern with quote not allowed in record parameters") (** [DataI.t] contains the information used in record interpretation, it is a strict subset of [Ast.t] thus this should be eventually removed or merged with [Ast.t] *) module DataI = struct type t = { name : Id.t ; arity : Constrexpr.constr_expr option (** declared sort for the record *) ; nots : Metasyntax.notation_interpretation_decl list list (** notations for fields *) ; fs : Vernacexpr.local_decl_expr list } end (** [DataR.t] contains record data after interpretation / type-inference *) module DataR = struct type t = { arity : Constr.t ; default_dep_elim : DeclareInd.default_dep_elim ; implfs : Impargs.manual_implicits list ; fields : Constr.rel_declaration list } end module Data = struct type projection_flags = { pf_coercion: bool; pf_reversible: bool; pf_instance: bool; pf_priority: int option; pf_locality: Goptions.option_locality; pf_canonical: bool; } type raw_data = DataR.t type t = { id : Id.t ; idbuild : Id.t ; is_coercion : bool ; proj_flags : projection_flags list ; rdata : raw_data ; inhabitant_id : Id.t } end (** Is [s] a single local level (type or qsort)? If so return it. *) let is_sort_variable sigma s = match EConstr.ESorts.kind sigma s with | SProp | Prop | Set -> None | Type u | QSort (_, u) -> match Univ.Universe.level u with | None -> None | Some l -> if Univ.Level.Set.mem l (fst (Evd.universe_context_set sigma)) then Some l else None let build_type_telescope ~unconstrained_sorts newps env0 sigma { DataI.arity; _ } = match arity with | None -> let sigma, s = Evd.new_sort_variable Evd.univ_flexible_alg sigma in sigma, (EConstr.mkSort s, s) | Some { CAst.v = CSort s; loc } when Constrexpr_ops.(sort_expr_eq expr_Type_sort s) -> (* special case: the user wrote ": Type". We want to allow it to become algebraic (and Prop but that may change in the future) *) let sigma, s = Evd.new_sort_variable ?loc UState.univ_flexible_alg sigma in sigma, (EConstr.mkSort s, s) | Some t -> let env = EConstr.push_rel_context newps env0 in let impls = Constrintern.empty_internalization_env in let sigma, s = let t = Constrintern.intern_gen IsType ~impls env sigma t in let flags = { Pretyping.all_no_fail_flags with program_mode = false; unconstrained_sorts } in Pretyping.understand_tcc ~flags env sigma ~expected_type:IsType t in let sred = Reductionops.whd_allnolet env sigma s in (match EConstr.kind sigma sred with | Sort s' -> (sigma, (s, s')) | _ -> user_err ?loc:(constr_loc t) (str"Sort expected.")) type tc_result = Impargs.manual_implicits (* Part relative to closing the definitions *) * UState.named_universes_entry * Entries.variance_entry * Constr.rel_context * DataR.t list (* returned DefaultElim value will eventually be discarded *) let def_class_levels ~def env_ar sigma aritysorts ctors = let s, ctor = match aritysorts, ctors with | [s], [_,ctor] -> begin match ctor with | [LocalAssum (_,t)] -> s, t | _ -> assert false end | _ -> CErrors.user_err Pp.(str "Mutual definitional classes are not supported.") in let ctor_sort = Retyping.get_sort_of env_ar sigma ctor in let is_prop_ctor = EConstr.ESorts.is_prop sigma ctor_sort in let sigma = Evd.set_leq_sort env_ar sigma ctor_sort s in if Option.cata (Evd.is_flexible_level sigma) false (is_sort_variable sigma s) && is_prop_ctor then (* We assume that the level in aritysort is not constrained and clear it, if it is flexible *) let sigma = Evd.set_eq_sort env_ar sigma EConstr.ESorts.set s in (sigma, [DeclareInd.DefaultElim, EConstr.mkProp]) else sigma, [DefaultElim, EConstr.mkSort s] (* ps = parameter list *) let typecheck_params_and_fields def poly udecl ps (records : DataI.t list) : tc_result = let env0 = Global.env () in (* Special case elaboration for template-polymorphic inductives, lower bound on introduced universes is Prop so that we do not miss any Set <= i constraint for universes that might actually be instantiated with Prop. *) let is_template = List.exists (fun { DataI.arity; _} -> Option.cata check_anonymous_type true arity) records in let unconstrained_sorts = not poly && not def && is_template in let sigma, decl, variances = Constrintern.interp_cumul_univ_decl_opt env0 udecl in let () = List.iter check_parameters_must_be_named ps in let sigma, (impls_env, ((_env1,newps), imps)) = Constrintern.interp_context_evars ~program_mode:false ~unconstrained_sorts env0 sigma ps in let sigma, typs = List.fold_left_map (build_type_telescope ~unconstrained_sorts newps env0) sigma records in let typs, aritysorts = List.split typs in let arities = List.map (fun typ -> EConstr.it_mkProd_or_LetIn typ newps) typs in let relevances = List.map (fun s -> EConstr.ESorts.relevance_of_sort s) aritysorts in let fold accu { DataI.name; _ } arity r = EConstr.push_rel (LocalAssum (make_annot (Name name) r,arity)) accu in let env_ar = EConstr.push_rel_context newps (List.fold_left3 fold env0 records arities relevances) in let impls_env = let ids = List.map (fun { DataI.name; _ } -> name) records in let imps = List.map (fun _ -> imps) arities in Constrintern.compute_internalization_env env0 sigma ~impls:impls_env Constrintern.Inductive ids arities imps in let ninds = List.length arities in let nparams = List.length newps in let fold sigma { DataI.nots; fs; _ } = interp_fields_evars env_ar sigma ~ninds ~nparams impls_env nots fs in let (sigma, data) = List.fold_left_map fold sigma records in let sigma = Pretyping.solve_remaining_evars Pretyping.all_and_fail_flags env_ar sigma in let sigma, typs = if def then def_class_levels ~def env_ar sigma aritysorts data else (* each inductive has one constructor *) let ctors = List.map (fun (_,newfs) -> [newfs]) data in let indnames = List.map (fun x -> x.DataI.name) records in let arities_explicit = List.map (fun x -> Option.has_some x.DataI.arity) records in let sigma, (default_dep_elim, typs) = ComInductive.Internal.inductive_levels env_ar sigma ~poly ~indnames ~arities_explicit typs ctors in sigma, List.combine default_dep_elim typs in (* TODO: Have this use Declaredef.prepare_definition *) let lbound = if unconstrained_sorts then UGraph.Bound.Prop else UGraph.Bound.Set in let sigma, (newps, ans) = (* too complex for Evarutil.finalize as we normalize non-constr *) let sigma = Evd.minimize_universes ~lbound sigma in let uvars = ref Univ.Level.Set.empty in let nf c = let _, varsc = EConstr.universes_of_constr sigma c in let c = EConstr.to_constr sigma c in uvars := Univ.Level.Set.union !uvars varsc; c in let nf_rel r = EConstr.ERelevance.kind sigma r in let map_decl = RelDecl.map_constr_het nf_rel nf in let newps = List.map map_decl newps in let map (implfs, fields) (default_dep_elim, typ) = let fields = List.map map_decl fields in let arity = nf typ in { DataR.arity; default_dep_elim; implfs; fields } in let ans = List.map2 map data typs in let sigma = Evd.restrict_universe_context ~lbound sigma !uvars in sigma, (newps, ans) in let univs = Evd.check_univ_decl ~poly sigma decl in let ce t = Pretyping.check_evars env0 sigma (EConstr.of_constr t) in let () = List.iter (iter_constr ce) (List.rev newps) in imps, univs, variances, newps, ans type record_error = | MissingProj of Id.t * Id.t list | BadTypedProj of Id.t * env * Type_errors.type_error let warn_cannot_define_projection = CWarnings.create ~name:"cannot-define-projection" ~category:CWarnings.CoreCategories.records (fun msg -> hov 0 msg) type arity_error = | NonInformativeToInformative | StrongEliminationOnNonSmallType let error_elim_explain kp ki = let open Sorts in match kp,ki with | (InType | InSet), InProp -> Some NonInformativeToInformative | InType, InSet -> Some StrongEliminationOnNonSmallType (* if Set impredicative *) | _ -> None (* If a projection is not definable, we throw an error if the user asked it to be a coercion or instance. Otherwise, we just print an info message. The user might still want to name the field of the record. *) let warning_or_error ~info flags indsp err = let st = match err with | MissingProj (fi,projs) -> let s,have = if List.length projs > 1 then "s","were" else "","was" in (Id.print fi ++ strbrk" cannot be defined because the projection" ++ str s ++ spc () ++ prlist_with_sep pr_comma Id.print projs ++ spc () ++ str have ++ strbrk " not defined.") | BadTypedProj (fi,env,te) -> let err = match te with | ElimArity (_, _, Some s) -> error_elim_explain (Sorts.family s) (Inductiveops.elim_sort (Global.lookup_inductive indsp)) | _ -> None in match err with | Some NonInformativeToInformative -> (Id.print fi ++ strbrk" cannot be defined because it is informative and " ++ Printer.pr_inductive (Global.env()) indsp ++ strbrk " is not.") | Some StrongEliminationOnNonSmallType -> (Id.print fi ++ strbrk" cannot be defined because it is large and " ++ Printer.pr_inductive (Global.env()) indsp ++ strbrk " is not.") | None -> (Id.print fi ++ str " cannot be defined because it is not typable:" ++ spc() ++ Himsg.explain_type_error env (Evd.from_env env) (Pretype_errors.of_type_error te)) in if flags.Data.pf_coercion || flags.Data.pf_instance then user_err ~info st; warn_cannot_define_projection (hov 0 st) type field_status = | NoProjection of Name.t | Projection of constr exception NotDefinable of record_error (* This replaces previous projection bodies in current projection *) (* Undefined projs are collected and, at least one undefined proj occurs *) (* in the body of current projection then the latter can not be defined *) (* [c] is defined in ctxt [[params;fields]] and [l] is an instance of *) (* [[fields]] defined in ctxt [[params;x:ind]] *) let subst_projection fid l c = let lv = List.length l in let bad_projs = ref [] in let rec substrec depth c = match Constr.kind c with | Rel k -> (* We are in context [[params;fields;x:ind;...depth...]] *) if k <= depth+1 then c else if k-depth-1 <= lv then match List.nth l (k-depth-2) with | Projection t -> lift depth t | NoProjection (Name id) -> bad_projs := id :: !bad_projs; mkRel k | NoProjection Anonymous -> user_err (str "Field " ++ Id.print fid ++ str " depends on the " ++ pr_nth (k-depth-1) ++ str " field which has no name.") else mkRel (k-lv) | _ -> Constr.map_with_binders succ substrec depth c in let c' = lift 1 c in (* to get [c] defined in ctxt [[params;fields;x:ind]] *) let c'' = substrec 0 c' in if not (List.is_empty !bad_projs) then raise (NotDefinable (MissingProj (fid,List.rev !bad_projs))); c'' let instantiate_possibly_recursive_type ind u ntypes paramdecls fields = let subst = List.map_i (fun i _ -> mkRel i) 1 paramdecls in let subst' = List.init ntypes (fun i -> mkIndU ((ind, ntypes - i - 1), u)) in Vars.substl_rel_context (subst @ subst') fields (* We build projections *) (** Declare projection [ref] over [from] a coercion or a typeclass instance according to [flags]. *) (* remove the last argument (it will become alway true) after deprecation phase (started in 8.17, c.f. https://github.com/coq/coq/pull/16230) *) let declare_proj_coercion_instance ~flags ref from ~with_coercion = if with_coercion && flags.Data.pf_coercion then begin let cl = ComCoercion.class_of_global from in let local = flags.Data.pf_locality = Goptions.OptLocal in ComCoercion.try_add_new_coercion_with_source ref ~local ~reversible:flags.Data.pf_reversible ~source:cl end; if flags.Data.pf_instance then begin let env = Global.env () in let sigma = Evd.from_env env in let info = Typeclasses.{ hint_priority = flags.Data.pf_priority; hint_pattern = None } in let local = match flags.Data.pf_locality with | Goptions.OptLocal -> Hints.Local | Goptions.(OptDefault | OptExport) -> Hints.Export | Goptions.OptGlobal -> Hints.SuperGlobal in Classes.declare_instance ~warn:true env sigma (Some info) local ref end (* TODO: refactor the declaration part here; this requires some surgery as Evarutil.finalize is called too early in the path *) (** This builds and _declares_ a named projection, the code looks tricky due to the term manipulation. It also handles declaring the implicits parameters, coercion status, etc... of the projection; this could be refactored as noted above by moving to the higher-level declare constant API *) let build_named_proj ~primitive ~flags ~poly ~univs ~uinstance ~kind env paramdecls paramargs decl impls fid subst nfi ti i indsp mib lifted_fields x rp = let ccl = subst_projection fid subst ti in let body, p_opt = match decl with | LocalDef (_,ci,_) -> subst_projection fid subst ci, None | LocalAssum ({binder_relevance=rci},_) -> (* [ccl] is defined in context [params;x:rp] *) (* [ccl'] is defined in context [params;x:rp;x:rp] *) if primitive then let p = Projection.Repr.make indsp ~proj_npars:mib.mind_nparams ~proj_arg:i (Label.of_id fid) in mkProj (Projection.make p false, rci, mkRel 1), Some (p,rci) else let ccl' = liftn 1 2 ccl in let p = mkLambda (x, lift 1 rp, ccl') in let branch = it_mkLambda_or_LetIn (mkRel nfi) lifted_fields in let ci = Inductiveops.make_case_info env indsp LetStyle in (* Record projections are always NoInvert because they're at constant relevance *) mkCase (Inductive.contract_case env (ci, (p, rci), NoInvert, mkRel 1, [|branch|])), None in let proj = it_mkLambda_or_LetIn (mkLambda (x,rp,body)) paramdecls in let projtyp = it_mkProd_or_LetIn (mkProd (x,rp,ccl)) paramdecls in let univs = match fst univs with | Entries.Monomorphic_entry -> UState.Monomorphic_entry Univ.ContextSet.empty, snd univs | Entries.Polymorphic_entry uctx -> UState.Polymorphic_entry uctx, snd univs in let entry = Declare.definition_entry ~univs ~types:projtyp proj in let kind = Decls.IsDefinition kind in let kn = try Declare.declare_constant ~name:fid ~kind (Declare.DefinitionEntry entry) with Type_errors.TypeError (ctx,te) as exn when not primitive -> let _, info = Exninfo.capture exn in Exninfo.iraise (NotDefinable (BadTypedProj (fid,ctx,te)),info) in Declare.definition_message fid; let term = match p_opt with | Some (p,r) -> let _ = DeclareInd.declare_primitive_projection p kn in mkProj (Projection.make p false, r, mkRel 1) | None -> let proj_args = (*Rel 1 refers to "x"*) paramargs@[mkRel 1] in match decl with | LocalDef _ when primitive -> body | _ -> applist (mkConstU (kn,uinstance),proj_args) in let refi = GlobRef.ConstRef kn in Impargs.maybe_declare_manual_implicits false refi impls; declare_proj_coercion_instance ~flags refi (GlobRef.IndRef indsp) ~with_coercion:true; let i = if is_local_assum decl then i+1 else i in (Some kn, i, Projection term::subst) (** [build_proj] will build a projection for each field, or skip if the field is anonymous, i.e. [_ : t] *) let build_proj env mib indsp primitive x rp lifted_fields ~poly paramdecls paramargs ~uinstance ~kind ~univs (nfi,i,kinds,subst) flags decl impls = let fi = RelDecl.get_name decl in let ti = RelDecl.get_type decl in let (sp_proj,i,subst) = match fi with | Anonymous -> (None,i,NoProjection fi::subst) | Name fid -> try build_named_proj ~primitive ~flags ~poly ~univs ~uinstance ~kind env paramdecls paramargs decl impls fid subst nfi ti i indsp mib lifted_fields x rp with NotDefinable why as exn -> let _, info = Exninfo.capture exn in warning_or_error ~info flags indsp why; (None,i,NoProjection fi::subst) in (nfi - 1, i, { Structure.proj_name = fi ; proj_true = is_local_assum decl ; proj_canonical = flags.Data.pf_canonical ; proj_body = sp_proj } :: kinds , subst) (** [declare_projections] prepares the common context for all record projections and then calls [build_proj] for each one. *) let declare_projections indsp univs ?(kind=Decls.StructureComponent) inhabitant_id flags fieldimpls fields = let env = Global.env() in let (mib,mip) = Global.lookup_inductive indsp in let poly = Declareops.inductive_is_polymorphic mib in let uinstance = match fst univs with | Polymorphic_entry uctx -> UVars.UContext.instance uctx | Monomorphic_entry -> UVars.Instance.empty in let paramdecls = Inductive.inductive_paramdecls (mib, uinstance) in let r = mkIndU (indsp,uinstance) in let rp = applist (r, Context.Rel.instance_list mkRel 0 paramdecls) in let paramargs = Context.Rel.instance_list mkRel 1 paramdecls in (*def in [[params;x:rp]]*) let x = make_annot (Name inhabitant_id) (Inductive.relevance_of_ind_body mip uinstance) in let fields = instantiate_possibly_recursive_type (fst indsp) uinstance mib.mind_ntypes paramdecls fields in let lifted_fields = Vars.lift_rel_context 1 fields in let primitive = match mib.mind_record with | PrimRecord _ -> true | FakeRecord | NotRecord -> false in let (_,_,canonical_projections,_) = List.fold_left3 (build_proj env mib indsp primitive x rp lifted_fields ~poly paramdecls paramargs ~uinstance ~kind ~univs) (List.length fields,0,[],[]) flags (List.rev fields) (List.rev fieldimpls) in List.rev canonical_projections open Typeclasses let load_structure _ structure = Structure.register structure let cache_structure o = load_structure 1 o let subst_structure (subst, obj) = Structure.subst subst obj let discharge_structure x = Some x let rebuild_structure s = Structure.rebuild (Global.env()) s let inStruc : Structure.t -> Libobject.obj = let open Libobject in declare_object {(default_object "STRUCTURE") with cache_function = cache_structure; load_function = load_structure; subst_function = subst_structure; classify_function = (fun _ -> Substitute); discharge_function = discharge_structure; rebuild_function = rebuild_structure; } let declare_structure_entry o = Lib.add_leaf (inStruc o) (** In the type of every projection, the record is bound to a variable named using the first character of the record type. We rename it to avoid collisions with names already used in the field types. *) (** Get all names bound at the head of [t]. *) let rec add_bound_names_constr (names : Id.Set.t) (t : constr) : Id.Set.t = match destProd t with | (b, _, t) -> let names = match b.binder_name with | Name.Anonymous -> names | Name.Name n -> Id.Set.add n names in add_bound_names_constr names t | exception DestKO -> names (** Get all names bound in any record field. *) let bound_names_rdata { DataR.fields; _ } : Id.Set.t = let add_names names field = add_bound_names_constr names (RelDecl.get_type field) in List.fold_left add_names Id.Set.empty fields (** Main record declaration part: The entry point is [definition_structure], which will match on the declared [kind] and then either follow the regular record declaration path to [declare_structure] or handle the record as a class declaration with [declare_class]. *) (** [declare_structure] does two principal things: - prepares and declares the low-level (mutual) inductive corresponding to [record_data] - prepares and declares the corresponding record projections, mainly taken care of by [declare_projections] *) module Record_decl = struct type t = { mie : Entries.mutual_inductive_entry; default_dep_elim : DeclareInd.default_dep_elim list; records : Data.t list; primitive_proj : bool; impls : DeclareInd.one_inductive_impls list; globnames : UState.named_universes_entry; global_univ_decls : Univ.ContextSet.t option; projunivs : Entries.universes_entry; ubinders : UnivNames.universe_binders; projections_kind : Decls.definition_object_kind; poly : bool; indlocs : Loc.t option list; } end module Ast = struct open Vernacexpr type t = { name : Names.lident ; is_coercion : coercion_flag ; binders: local_binder_expr list ; cfs : (local_decl_expr * record_field_attr) list ; idbuild : Id.t ; sort : constr_expr option ; default_inhabitant_id : Id.t option } let to_datai { name; cfs; sort; _ } = let fs = List.map fst cfs in { DataI.name = name.CAst.v ; arity = sort ; nots = List.map (fun (_, { rf_notation }) -> List.map Metasyntax.prepare_where_notation rf_notation) cfs ; fs } end 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 | _ -> acc in let indlocs = records |> List.map (fun { Ast.name; _ } -> name ) in let fields_names = records |> List.fold_left (fun acc { Ast.cfs; _ } -> List.fold_left extract_name acc cfs) [] in let allnames = fields_names @ (indlocs |> List.map (fun x -> x.CAst.v)) in match List.duplicates Id.equal allnames with | [] -> List.map (fun x -> x.CAst.loc) indlocs | id :: _ -> user_err (str "Two objects have the same name" ++ spc () ++ quote (Id.print id) ++ str ".") type kind_class = NotClass | RecordClass | DefClass let kind_class = let open Vernacexpr in function Class true -> DefClass | Class false -> RecordClass | Inductive_kw | CoInductive | Variant | Record | Structure -> NotClass (** Pick a variable name for a record, avoiding names bound in its fields. *) let canonical_inhabitant_id ~isclass ind_id = if isclass then ind_id else Id.of_string (Unicode.lowercase_first_char (Id.to_string ind_id)) let check_priorities kind records = let open Vernacexpr in let isnot_class = kind_class kind <> RecordClass in let has_priority { Ast.cfs; _ } = List.exists (fun (_, { rf_priority }) -> not (Option.is_empty rf_priority)) cfs in if isnot_class && List.exists has_priority records then user_err Pp.(str "Priorities only allowed for type class substructures.") let extract_record_data records = let data = List.map Ast.to_datai records in let ps = match records with | [] -> CErrors.anomaly (str "Empty record block.") | r :: rem -> let eq_local_binders bl1 bl2 = List.equal local_binder_eq bl1 bl2 in match List.find_opt (fun r' -> not @@ eq_local_binders r.Ast.binders r'.Ast.binders) rem with | None -> r.Ast.binders | Some r' -> ComInductive.Internal.error_differing_params ~kind:"record" (r.name, (r.binders,None)) (r'.name, (r'.binders,None)) in ps, data let implicits_of_context ctx = List.map (fun name -> CAst.make (Some (name,true))) (List.rev (Anonymous :: (List.filter_map (function | LocalDef _ -> None | LocalAssum _ as d -> Some (RelDecl.get_name d)) ctx))) (* deprecated in 8.16, to be removed at the end of the deprecation phase (c.f., https://github.com/coq/coq/pull/15802 ) *) let warn_future_coercion_class_constructor = CWarnings.create ~name:"future-coercion-class-constructor" ~category:Deprecation.Version.v8_16 ~default:CWarnings.AsError Pp.(fun () -> str "'Class >' currently does nothing. Use 'Class' instead.") (* deprecated in 8.17, to be removed at the end of the deprecation phase (c.f., https://github.com/coq/coq/pull/16230 ) *) let warn_future_coercion_class_field = CWarnings.create ~name:"future-coercion-class-field" ~category:Deprecation.Version.v8_17 ~default:CWarnings.AsError Pp.(fun definitional -> strbrk "A coercion will be introduced instead of an instance in future versions when using ':>' in 'Class' declarations. " ++ strbrk "Replace ':>' with '::' (or use '#[global] Existing Instance field.' for compatibility with Coq < 8.18). Beware that the default locality for '::' is #[export], as opposed to #[global] for ':>' currently." ++ strbrk (if definitional then " Add an explicit #[global] attribute if you need to keep the current behavior. For example: \"Class foo := #[global] baz :: bar.\"" else " Add an explicit #[global] attribute to the field if you need to keep the current behavior. For example: \"Class foo := { #[global] field :: bar }.\"")) let check_proj_flags kind rf = let open Vernacexpr in let pf_coercion, pf_reversible = match rf.rf_coercion with (* replace "kind_class kind = NotClass" with true after deprecation phase *) | AddCoercion -> kind_class kind = NotClass, Option.default true rf.rf_reversible | NoCoercion -> if rf.rf_reversible <> None then Attributes.(unsupported_attributes [CAst.make ("reversible (without :>)",VernacFlagEmpty)]); false, false in let pf_instance = match rf.rf_instance with NoInstance -> false | BackInstance -> true | BackInstanceWarning -> kind_class kind <> NotClass in let pf_priority = rf.rf_priority in let pf_locality = begin match rf.rf_coercion, rf.rf_instance with | NoCoercion, NoInstance -> if rf.rf_locality <> Goptions.OptDefault then Attributes.(unsupported_attributes [CAst.make ("locality (without :> or ::)",VernacFlagEmpty)]) | AddCoercion, NoInstance -> if rf.rf_locality = Goptions.OptExport then Attributes.(unsupported_attributes [CAst.make ("export (without ::)",VernacFlagEmpty)]) | _ -> () end; rf.rf_locality in (* remove following let after deprecation phase (started in 8.17, c.f., https://github.com/coq/coq/pull/16230 ) *) let pf_locality = match rf.rf_instance, rf.rf_locality with | BackInstanceWarning, Goptions.OptDefault -> Goptions.OptGlobal | _ -> pf_locality in let pf_canonical = rf.rf_canonical in Data.{ pf_coercion; pf_reversible; pf_instance; pf_priority; pf_locality; pf_canonical } (* remove the definitional argument at the end of the deprecation phase (started in 8.17) (c.f., https://github.com/coq/coq/pull/16230 ) *) let pre_process_structure ?(definitional=false) udecl kind ~poly (records : Ast.t list) = let indlocs = check_unique_names records in let () = check_priorities kind records in let ps, data = extract_record_data records in let impargs, univs, variances, params, data = (* In theory we should be able to use [Notation.with_notation_protection], due to the call to Metasyntax.set_notation_for_interpretation, however something is messing state beyond that. *) Vernacstate.System.protect (fun () -> typecheck_params_and_fields (kind = Class true) poly udecl ps data) () in let adjust_impls impls = match kind_class kind with | NotClass -> impargs @ [CAst.make None] @ impls | _ -> implicits_of_context params @ impls in let data = List.map (fun ({ DataR.implfs; _ } as d) -> { d with DataR.implfs = List.map adjust_impls implfs }) data in let map rdata { Ast.name; is_coercion; cfs; idbuild; default_inhabitant_id; _ } = let proj_flags = List.map (fun (_, rf) -> check_proj_flags kind rf) cfs in let inhabitant_id = match default_inhabitant_id with | Some n -> n | None -> let canonical_inhabitant_id = canonical_inhabitant_id ~isclass:(kind_class kind != NotClass) name.CAst.v in Namegen.next_ident_away canonical_inhabitant_id (bound_names_rdata rdata) in let is_coercion = match is_coercion with AddCoercion -> true | NoCoercion -> false in if kind_class kind <> NotClass then begin if is_coercion then warn_future_coercion_class_constructor (); if List.exists (function (_, Vernacexpr.{ rf_instance = BackInstanceWarning; _ }) -> true | _ -> false) cfs then warn_future_coercion_class_field definitional end; { Data.id = name.CAst.v; idbuild; rdata; is_coercion; proj_flags; inhabitant_id } in let data = List.map2 map data records in let projections_kind = Decls.(match kind_class kind with NotClass -> StructureComponent | _ -> Method) in impargs, params, univs, variances, projections_kind, data, indlocs let interp_structure_core ~cumulative finite ~univs ~variances ~primitive_proj impargs params template ~projections_kind ~indlocs data = let nparams = List.length params in let (univs, ubinders) = univs in let poly, projunivs = match univs with | UState.Monomorphic_entry _ -> false, Entries.Monomorphic_entry | UState.Polymorphic_entry uctx -> true, Entries.Polymorphic_entry uctx in let ntypes = List.length data in let mk_block i { Data.id; idbuild; rdata = { DataR.arity; fields; _ }; _ } = let nfields = List.length fields in let args = Context.Rel.instance_list mkRel nfields params in let ind = applist (mkRel (ntypes - i + nparams + nfields), args) in let type_constructor = it_mkProd_or_LetIn ind fields in { mind_entry_typename = id; mind_entry_arity = arity; mind_entry_consnames = [idbuild]; mind_entry_lc = [type_constructor] } in let blocks = List.mapi mk_block data in let ind_univs, global_univ_decls = match blocks, data with | [entry], [data] -> ComInductive.compute_template_inductive ~user_template:template ~ctx_params:params ~univ_entry:univs entry (if Term.isArity entry.mind_entry_arity then SyntaxAllowsTemplatePoly else SyntaxNoTemplatePoly) | _ -> begin match template with | Some true -> user_err Pp.(str "Template-polymorphism not allowed with mutual records.") | Some false | None -> match univs with | UState.Polymorphic_entry uctx -> Polymorphic_ind_entry uctx, Univ.ContextSet.empty | UState.Monomorphic_entry uctx -> Monomorphic_ind_entry, uctx end in let primitive = primitive_proj && List.for_all (fun { Data.rdata = { DataR.fields; _ }; _ } -> List.exists is_local_assum fields) data in let globnames, global_univ_decls = match ind_univs with | Monomorphic_ind_entry -> (univs, ubinders), Some global_univ_decls | Template_ind_entry _ -> (univs, ubinders), Some global_univ_decls | Polymorphic_ind_entry _ -> (univs, UnivNames.empty_binders), None in let univs = ind_univs in let variance = ComInductive.variance_of_entry ~cumulative ~variances univs in let mie = { mind_entry_params = params; mind_entry_record = Some (if primitive then Some (Array.map_of_list (fun a -> a.Data.inhabitant_id) data) else None); mind_entry_finite = finite; mind_entry_inds = blocks; mind_entry_private = None; mind_entry_universes = univs; mind_entry_variance = variance; } in let impls = List.map (fun _ -> impargs, []) data in let default_dep_elim = List.map (fun d -> d.Data.rdata.default_dep_elim) data in let open Record_decl in { mie; default_dep_elim; primitive_proj; impls; globnames; global_univ_decls; projunivs; ubinders; projections_kind; poly; records = data; indlocs; } let interp_structure udecl kind ~template ~cumulative ~poly ~primitive_proj finite records = assert (kind <> Vernacexpr.Class true); let impargs, params, univs, variances, projections_kind, data, indlocs = pre_process_structure udecl kind ~poly records in interp_structure_core ~cumulative finite ~univs ~variances ~primitive_proj impargs params template ~projections_kind ~indlocs data let declare_structure { Record_decl.mie; default_dep_elim; primitive_proj; impls; globnames; global_univ_decls; projunivs; ubinders; projections_kind; poly; records; indlocs } = Option.iter (Global.push_context_set ~strict:true) global_univ_decls; let kn = DeclareInd.declare_mutual_inductive_with_eliminations mie globnames impls ~primitive_expected:primitive_proj ~indlocs ~default_dep_elim in let map i { Data.is_coercion; proj_flags; rdata = { DataR.implfs; fields; _}; inhabitant_id; _ } = let rsp = (kn, i) in (* This is ind path of idstruc *) let cstr = (rsp, 1) in let projections = declare_projections rsp (projunivs,ubinders) ~kind:projections_kind inhabitant_id proj_flags implfs fields in let build = GlobRef.ConstructRef cstr in let () = if is_coercion then ComCoercion.try_add_new_coercion build ~local:false ~reversible:false in let struc = Structure.make (Global.env ()) rsp projections in let () = declare_structure_entry struc in GlobRef.IndRef rsp in List.mapi map records, [] let get_class_params : Data.t list -> Data.t = function | [data] -> data | _ -> CErrors.user_err (str "Mutual definitional classes are not supported.") (* declare definitional class (typeclasses that are not record) *) (* [data] is a list with a single [Data.t] with a single field (in [Data.rdata]) and [Data.is_coercion] must be [NoCoercion] *) let declare_class_constant ~univs paramimpls params data = let {Data.id; rdata; is_coercion; proj_flags; inhabitant_id} = get_class_params data in assert (not is_coercion); (* should be ensured by caller *) let implfs = rdata.DataR.implfs in let field, binder, proj_name, proj_flags = match rdata.DataR.fields, proj_flags with | [ LocalAssum ({binder_name=Name proj_name} as binder, field) | LocalDef ({binder_name=Name proj_name} as binder, _, field) ], [proj_flags] -> let binder = {binder with binder_name=Name inhabitant_id} in field, binder, proj_name, proj_flags | _ -> assert false in (* should be ensured by caller *) let class_body = it_mkLambda_or_LetIn field params in let class_type = it_mkProd_or_LetIn rdata.DataR.arity params in let class_entry = Declare.definition_entry ~types:class_type ~univs class_body in let cst = Declare.declare_constant ~name:id (Declare.DefinitionEntry class_entry) ~kind:Decls.(IsDefinition Definition) in let inst, univs = match univs with | UState.Monomorphic_entry _, ubinders -> UVars.Instance.empty, (UState.Monomorphic_entry Univ.ContextSet.empty, ubinders) | UState.Polymorphic_entry uctx, _ -> UVars.UContext.instance uctx, univs in let cstu = (cst, inst) in let inst_type = appvectc (mkConstU cstu) (Context.Rel.instance mkRel 0 params) in let proj_type = it_mkProd_or_LetIn (mkProd(binder, inst_type, lift 1 field)) params in let proj_body = it_mkLambda_or_LetIn (mkLambda (binder, inst_type, mkRel 1)) params in let proj_entry = Declare.definition_entry ~types:proj_type ~univs proj_body in let proj_cst = Declare.declare_constant ~name:proj_name (Declare.DefinitionEntry proj_entry) ~kind:Decls.(IsDefinition Definition) in let cref = GlobRef.ConstRef cst in Impargs.declare_manual_implicits false cref paramimpls; Impargs.declare_manual_implicits false (GlobRef.ConstRef proj_cst) (List.hd implfs); Classes.set_typeclass_transparency ~locality:Hints.SuperGlobal [Evaluable.EvalConstRef cst] false; let () = declare_proj_coercion_instance ~flags:proj_flags (GlobRef.ConstRef proj_cst) cref ~with_coercion:false in let m = { meth_name = Name proj_name; meth_info = None; meth_const = Some proj_cst; } in [cref], [m] (** [declare_class] will prepare and declare a [Class]. This is done in 2 steps: 1. two markedly different paths are followed depending on whether the class declaration refers to a constant "definitional classes" (with [declare_class_constant]) or to a record (with [declare_structure]), that is to say: Class foo := bar : T. which is equivalent to Definition foo := T. Definition bar (x:foo) : T := x. Existing Class foo. vs Class foo := { ... }. 2. now, declare the class, using the information ([inds] and [def]) from 1. in the form of [Classes.typeclass] *) let declare_class ~univs params inds def data = let { Data.rdata } = get_class_params data in let fields = rdata.DataR.fields in let map ind = let map decl y = { meth_name = RelDecl.get_name decl; meth_info = None; meth_const = y; } in let l = match ind with | GlobRef.IndRef ind -> List.map2 map (List.rev fields) (Structure.find_projections ind) | _ -> def in ind, l in let data = List.map map inds in let univs, params, fields = match fst univs with | UState.Polymorphic_entry uctx -> let usubst, auctx = UVars.abstract_universes uctx in let usubst = UVars.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 params = Context.Rel.map map params in auctx, params, fields | UState.Monomorphic_entry _ -> UVars.AbstractContext.empty, params, fields in let map (impl, projs) = let k = { cl_univs = univs; cl_impl = impl; cl_strict = typeclasses_strict (); cl_unique = typeclasses_unique (); cl_context = params; cl_props = fields; cl_projs = projs } in Classes.add_class k in List.iter map data let add_constant_class cst = let env = Global.env () in let ty, univs = Typeops.type_of_global_in_context env (GlobRef.ConstRef cst) in let r = (Environ.lookup_constant cst env).const_relevance in let ctx, _ = decompose_prod_decls ty in let args = Context.Rel.instance Constr.mkRel 0 ctx in let t = mkApp (mkConstU (cst, UVars.make_abstract_instance univs), args) in let tc = { cl_univs = univs; cl_impl = GlobRef.ConstRef cst; cl_context = ctx; cl_props = [LocalAssum (make_annot Anonymous r, t)]; cl_projs = []; cl_strict = typeclasses_strict (); cl_unique = typeclasses_unique () } in Classes.add_class tc; Classes.set_typeclass_transparency ~locality:Hints.SuperGlobal [Evaluable.EvalConstRef cst] false let add_inductive_class ind = let env = Global.env () in let mind, oneind = Inductive.lookup_mind_specif env ind in let k = let ctx = oneind.mind_arity_ctxt in let univs = Declareops.inductive_polymorphic_context mind in let inst = UVars.make_abstract_instance univs in let ty = Inductive.type_of_inductive ((mind, oneind), inst) in let r = oneind.mind_relevance in { cl_univs = univs; cl_impl = GlobRef.IndRef ind; cl_context = ctx; cl_props = [LocalAssum (make_annot Anonymous r, ty)]; cl_projs = []; cl_strict = typeclasses_strict (); cl_unique = typeclasses_unique () } in Classes.add_class k let warn_already_existing_class = CWarnings.create ~name:"already-existing-class" ~category:CWarnings.CoreCategories.automation Pp.(fun g -> Printer.pr_global g ++ str " is already declared as a typeclass.") let declare_existing_class g = if Typeclasses.is_class g then warn_already_existing_class g else match g with | GlobRef.ConstRef x -> add_constant_class x | GlobRef.IndRef x -> add_inductive_class x | _ -> user_err (Pp.str"Unsupported class type, only constants and inductives are allowed.") (** [fs] corresponds to fields and [ps] to parameters; [proj_flags] is a list telling if the corresponding fields must me declared as coercions or subinstances. *) let definition_structure udecl kind ~template ~cumulative ~poly ~primitive_proj finite (records : Ast.t list) : GlobRef.t list = let impargs, params, univs, variances, projections_kind, data, indlocs = let definitional = kind_class kind = DefClass in pre_process_structure ~definitional udecl kind ~poly records in let inds, def = match kind_class kind with | DefClass -> declare_class_constant ~univs impargs params data | RecordClass | NotClass -> (* remove the following block after deprecation phase (started in 8.16, c.f., https://github.com/coq/coq/pull/15802 ) *) let data = if kind_class kind = NotClass then data else List.map (fun d -> { d with Data.is_coercion = false }) data in let structure = interp_structure_core ~cumulative finite ~univs ~variances ~primitive_proj impargs params template ~projections_kind ~indlocs data in declare_structure structure in if kind_class kind <> NotClass then declare_class ~univs params inds def data; inds module Internal = struct type nonrec projection_flags = Data.projection_flags = { pf_coercion: bool; pf_reversible: bool; pf_instance: bool; pf_priority: int option; pf_locality: Goptions.option_locality; pf_canonical: bool; } let declare_projections = declare_projections let declare_structure_entry = declare_structure_entry end coq-8.20.0/vernac/record.mli000066400000000000000000000066341466560755400156550ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* inductive_kind -> template:bool option -> cumulative:bool -> poly:bool -> primitive_proj:bool -> Declarations.recursivity_kind -> Ast.t list -> GlobRef.t list module Data : sig type projection_flags = { pf_coercion: bool; pf_reversible: bool; pf_instance: bool; pf_priority: int option; pf_locality: Goptions.option_locality; pf_canonical: bool; } type raw_data type t = { id : Id.t ; idbuild : Id.t ; is_coercion : bool ; proj_flags : projection_flags list ; rdata : raw_data ; inhabitant_id : Id.t } end (** A record is an inductive [mie] with extra metadata in [records] *) module Record_decl : sig type t = { mie : Entries.mutual_inductive_entry; default_dep_elim : DeclareInd.default_dep_elim list; records : Data.t list; (* TODO: this part could be factored in mie *) primitive_proj : bool; impls : DeclareInd.one_inductive_impls list; globnames : UState.named_universes_entry; global_univ_decls : Univ.ContextSet.t option; projunivs : Entries.universes_entry; ubinders : UnivNames.universe_binders; projections_kind : Decls.definition_object_kind; poly : bool; indlocs : Loc.t option list; } end (** Ast.t list at the constr level *) val interp_structure : cumul_univ_decl_expr option -> inductive_kind -> template:bool option -> cumulative:bool -> poly:bool -> primitive_proj:bool -> Declarations.recursivity_kind -> Ast.t list -> Record_decl.t val declare_existing_class : GlobRef.t -> unit val canonical_inhabitant_id : isclass:bool -> Id.t -> Id.t (* Implementation internals, consult Coq developers before using; current user Elpi, see https://github.com/LPCIC/coq-elpi/pull/151 *) module Internal : sig type projection_flags = { pf_coercion: bool; pf_reversible: bool; pf_instance: bool; pf_priority: int option; pf_locality: Goptions.option_locality; pf_canonical: bool; } val declare_projections : Names.inductive -> Entries.universes_entry * UnivNames.universe_binders -> ?kind:Decls.definition_object_kind -> Names.Id.t -> projection_flags list -> Impargs.manual_implicits list -> Constr.rel_context -> Structure.projection list val declare_structure_entry : Structure.t -> unit end coq-8.20.0/vernac/retrieveObl.ml000066400000000000000000000245251466560755400165070ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * INRIA, CNRS and contributors - Copyright 1999-2018 *) (* if Evd.is_obligation_evar evm key then () else let loc, k = Evd.evar_source evi in Pretype_errors.error_unsolvable_implicit ?loc env evm key None) (Evd.undefined_map evm) type obligation_info = ( Names.Id.t * Constr.types * Evar_kinds.t Loc.located * (bool * Evar_kinds.obligation_definition_status) * Int.Set.t * unit Proofview.tactic option ) array type oblinfo = { ev_name : int * Id.t ; ev_hyps : EConstr.named_context ; ev_status : bool * Evar_kinds.obligation_definition_status ; ev_chop : int option ; ev_src : Evar_kinds.t Loc.located ; ev_typ : Constr.types ; ev_tac : unit Proofview.tactic option ; ev_deps : Int.Set.t } (** Substitute evar references in t using de Bruijn indices, where n binders were passed through. *) let succfix (depth, fixrels) = (succ depth, List.map succ fixrels) let subst_evar_constr evm evs n idf t = let seen = ref Int.Set.empty in let transparent = ref Id.Set.empty in let evar_info id = CList.assoc_f Evar.equal id evs in let rec substrec (depth, fixrels) c = match EConstr.kind evm c with | Constr.Evar (k, args) -> let {ev_name = id, idstr; ev_hyps = hyps; ev_chop = chop} = try evar_info k with Not_found -> CErrors.anomaly ~label:"eterm" Pp.( str "existential variable " ++ int (Evar.repr k) ++ str " not found.") in seen := Int.Set.add id !seen; (* Evar arguments are created in inverse order, and we must not apply to defined ones (i.e. LetIn's) *) let args = let args = Evd.expand_existential evm (k, args) in let n = match chop with None -> 0 | Some c -> c in let l, r = CList.chop n (List.rev args) in List.rev r in let args = let rec aux hyps args acc = let open Context.Named.Declaration in match (hyps, args) with | LocalAssum _ :: tlh, c :: tla -> aux tlh tla (substrec (depth, fixrels) c :: acc) | LocalDef _ :: tlh, _ :: tla -> aux tlh tla acc | [], [] -> acc | _, _ -> acc (*failwith "subst_evars: invalid argument"*) in aux hyps args [] in if List.exists (fun x -> match EConstr.kind evm x with | Constr.Rel n -> Int.List.mem n fixrels | _ -> false) args then transparent := Id.Set.add idstr !transparent; EConstr.mkApp (idf idstr, Array.of_list args) | Constr.Fix _ -> EConstr.map_with_binders evm succfix substrec (depth, 1 :: fixrels) c | _ -> EConstr.map_with_binders evm succfix substrec (depth, fixrels) c in let t' = substrec (0, []) t in (EConstr.to_constr evm t', !seen, !transparent) (** Substitute variable references in t using de Bruijn indices, where n binders were passed through. *) let subst_vars acc n t = let var_index id = Util.List.index Id.equal id acc in let rec substrec depth c = match Constr.kind c with | Constr.Var v -> ( try Constr.mkRel (depth + var_index v) with Not_found -> c ) | _ -> Constr.map_with_binders succ substrec depth c in substrec 0 t (** Rewrite type of an evar ([ H1 : t1, ... Hn : tn |- concl ]) to a product : forall H1 : t1, ..., forall Hn : tn, concl. Changes evars and hypothesis references to variable references. *) let etype_of_evar evm evs hyps concl = let open Context.Named.Declaration in let rec aux acc n = function | decl :: tl -> ( let t', s, trans = subst_evar_constr evm evs n EConstr.mkVar (Context.Named.Declaration.get_type decl) in let t'' = subst_vars acc 0 t' in let rest, s', trans' = aux (Context.Named.Declaration.get_id decl :: acc) (succ n) tl in let s' = Int.Set.union s s' in let trans' = Id.Set.union trans trans' in match decl with | LocalDef (id, c, _) -> let c', s'', trans'' = subst_evar_constr evm evs n EConstr.mkVar c in let c' = subst_vars acc 0 c' in ( Term.mkNamedProd_or_LetIn (LocalDef (EConstr.Unsafe.to_binder_annot id, c', t'')) rest , Int.Set.union s'' s' , Id.Set.union trans'' trans' ) | LocalAssum (id, _) -> (Term.mkNamedProd_or_LetIn (LocalAssum (EConstr.Unsafe.to_binder_annot id, t'')) rest, s', trans') ) | [] -> let t', s, trans = subst_evar_constr evm evs n EConstr.mkVar concl in (subst_vars acc 0 t', s, trans) in aux [] 0 (List.rev hyps) let trunc_named_context n ctx = let len = List.length ctx in CList.firstn (len - n) ctx let rec chop_product n t = let pop t = Vars.lift (-1) t in if Int.equal n 0 then Some t else match Constr.kind t with | Constr.Prod (_, _, b) -> if Vars.noccurn 1 b then chop_product (pred n) (pop b) else None | _ -> None let evar_dependencies evm oev = let one_step deps = Evar.Set.fold (fun ev s -> let evi = Evd.find_undefined evm ev in let deps' = Evd.evars_of_filtered_evar_info evm evi in if Evar.Set.mem oev deps' then invalid_arg ( "Ill-formed evar map: cycle detected for evar " ^ Pp.string_of_ppcmds @@ Evar.print oev ) else Evar.Set.union deps' s) deps deps in let rec aux deps = let deps' = one_step deps in if Evar.Set.equal deps deps' then deps else aux deps' in aux (Evar.Set.singleton oev) let move_after ((id, ev, deps) as obl) l = let rec aux restdeps = function | ((id', _, _) as obl') :: tl -> let restdeps' = Evar.Set.remove id' restdeps in if Evar.Set.is_empty restdeps' then obl' :: obl :: tl else obl' :: aux restdeps' tl | [] -> [obl] in aux (Evar.Set.remove id deps) l let sort_dependencies evl = let rec aux l found list = match l with | ((id, ev, deps) as obl) :: tl -> let found' = Evar.Set.union found (Evar.Set.singleton id) in if Evar.Set.subset deps found' then aux tl found' (obl :: list) else aux (move_after obl tl) found list | [] -> List.rev list in aux evl Evar.Set.empty [] type obligation_name_lifter = (Names.Id.t -> EConstr.t) -> EConstr.t -> Constr.t let retrieve_obligations env name evm fs ?deps ?status t ty = (* 'Serialize' the evars *) let nc = Environ.named_context env in let nc_len = Context.Named.length nc in let evm = Evarutil.nf_evar_map_undefined evm in let evl = Evd.undefined_map evm in let evl = match deps with | None -> evl | Some deps -> Evar.Map.filter (fun ev _ -> Evar.Set.mem ev deps) evl in let evl = Evar.Map.bindings evl in let evl = List.map (fun (id, ev) -> (id, ev, evar_dependencies evm id)) evl in let sevl = sort_dependencies evl in let evl = List.map (fun (id, ev, _) -> (id, ev)) sevl in let evn = let i = ref (-1) in List.rev_map (fun (id, ev) -> incr i; ( id , ( !i , Id.of_string (Id.to_string name ^ "_obligation_" ^ string_of_int (succ !i)) ) , ev )) evl in let evts = (* Remove existential variables in types and build the corresponding products *) List.fold_right (fun (id, (n, nstr), ev) evs -> let hyps = Evd.evar_filtered_context ev in let hyps = trunc_named_context nc_len hyps in let evtyp, deps, transp = etype_of_evar evm evs hyps (Evd.evar_concl ev) in let evtyp, hyps, chop = match chop_product fs evtyp with | Some t -> (t, trunc_named_context fs hyps, fs) | None -> (evtyp, hyps, 0) in let loc, k = Evd.evar_source (Evd.find_undefined evm id) in let status = match k with | Evar_kinds.QuestionMark {Evar_kinds.qm_obligation = o} -> o | _ -> ( match status with | Some o -> o | None -> Evar_kinds.Define (not (Program.get_proofs_transparency ())) ) in let force_status, status, chop = match status with | Evar_kinds.Define true as stat -> if not (Int.equal chop fs) then (true, Evar_kinds.Define false, None) else (false, stat, Some chop) | s -> (false, s, None) in let info = { ev_name = (n, nstr) ; ev_hyps = hyps ; ev_status = (force_status, status) ; ev_chop = chop ; ev_src = (loc, k) ; ev_typ = evtyp ; ev_deps = deps ; ev_tac = None } in (id, info) :: evs) evn [] in let t', _, transparent = (* Substitute evar refs in the term by variables *) subst_evar_constr evm evts 0 EConstr.mkVar t in let ty, _, _ = subst_evar_constr evm evts 0 EConstr.mkVar ty in let evars = List.map (fun (ev, info) -> let { ev_name = _, name ; ev_status = force_status, status ; ev_src = src ; ev_typ = typ ; ev_deps = deps ; ev_tac = tac } = info in let force_status, status = match status with | Evar_kinds.Define true when Id.Set.mem name transparent -> (true, Evar_kinds.Define false) | _ -> (force_status, status) in (name, typ, src, (force_status, status), deps, tac)) evts in let evnames = List.map (fun (ev, info) -> (ev, snd info.ev_name)) evts in let evmap f c = Util.pi1 (subst_evar_constr evm evts 0 f c) in (Array.of_list (List.rev evars), (evnames, evmap), t', ty) coq-8.20.0/vernac/retrieveObl.mli000066400000000000000000000036601466560755400166550ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * INRIA, CNRS and contributors - Copyright 1999-2018 *) (* Evd.evar_map -> unit type obligation_info = ( Names.Id.t * Constr.types * Evar_kinds.t Loc.located * (bool * Evar_kinds.obligation_definition_status) * Int.Set.t * unit Proofview.tactic option ) array (** ident, type, location of the original evar, (opaque or transparent, expand or define), dependencies as indexes into the array, tactic to solve it *) type obligation_name_lifter = (Names.Id.t -> EConstr.t) -> EConstr.t -> Constr.t val retrieve_obligations : Environ.env -> Names.Id.t -> Evd.evar_map -> int -> ?deps:Evar.Set.t -> ?status:Evar_kinds.obligation_definition_status -> EConstr.t -> EConstr.types -> obligation_info * ( (Evar.t * Names.Id.t) list * obligation_name_lifter ) * Constr.t * Constr.t (** [retrieve_obligations env id sigma fs ?status body type] returns [obls, (evnames, evmap), nbody, ntype] a list of obligations built from evars in [body, type]. [fs] is the number of function prototypes to try to clear from evars contexts. [evnames, evmap] is the list of names / substitution functions used to program with holes. This is not used in Coq, but in the equations plugin; [evnames] is actually redundant with the information contained in [obls] *) coq-8.20.0/vernac/search.ml000066400000000000000000000331751466560755400154730ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* Decls.logical_kind option -> env -> Evd.evar_map -> constr -> bool type display_function = GlobRef.t -> Decls.logical_kind option -> env -> Evd.evar_map -> constr -> unit (* This option restricts the output of [SearchPattern ...], etc. to the names of the symbols matching the query, separated by a newline. This type of output is useful for editors (like emacs), to generate a list of completion candidates without having to parse through the types of all symbols. *) type glob_search_item = | GlobSearchSubPattern of glob_search_where * bool * constr_pattern | GlobSearchString of string | GlobSearchKind of Decls.logical_kind | GlobSearchFilter of (GlobRef.t -> bool) type glob_search_request = | GlobSearchLiteral of glob_search_item | GlobSearchDisjConj of (bool * glob_search_request) list list module SearchBlacklist = Goptions.MakeStringTable (struct let key = ["Search";"Blacklist"] let title = "Current search blacklist : " let member_message s b = str "Search blacklist does " ++ (if b then mt () else str "not ") ++ str "include " ++ str s end) (* The functions iter_constructors and iter_declarations implement the behavior needed for the Coq searching commands. These functions take as first argument the procedure that will be called to treat each entry. This procedure receives the name of the object, the assumptions that will make it possible to print its type, and the constr term that represent its type. *) let iter_constructors indsp u fn env sigma nconstr = for i = 1 to nconstr do let typ = Inductive.type_of_constructor ((indsp, i), u) (Inductive.lookup_mind_specif env indsp) in fn (GlobRef.ConstructRef (indsp, i)) None env sigma typ done (* FIXME: this is a Libobject hack that should be replaced with a proper registration mechanism. *) module DynHandle = Libobject.Dyn.Map(struct type 'a t = 'a -> unit end) let handle h (Libobject.Dyn.Dyn (tag, o)) = match DynHandle.find tag h with | f -> f o | exception Not_found -> () (* General search over declarations *) let generic_search env sigma (fn : GlobRef.t -> Decls.logical_kind option -> env -> Evd.evar_map -> constr -> unit) = List.iter (fun d -> fn (GlobRef.VarRef (NamedDecl.get_id d)) None env sigma (NamedDecl.get_type d)) (Environ.named_context env); let iter_obj prefix lobj = match lobj with | AtomicObject o -> let handler = DynHandle.add Declare.Internal.Constant.tag begin fun (id,obj) -> let kn = KerName.make prefix.Nametab.obj_mp (Label.of_id id) in let cst = Global.constant_of_delta_kn kn in let gr = GlobRef.ConstRef cst in let (typ, _) = Typeops.type_of_global_in_context (Global.env ()) gr in let kind = Declare.Internal.Constant.kind obj in fn gr (Some kind) env sigma typ end @@ DynHandle.add DeclareInd.Internal.objInductive begin fun (id,_) -> let kn = KerName.make prefix.Nametab.obj_mp (Label.of_id id) in let mind = Global.mind_of_delta_kn kn in let mib = Global.lookup_mind mind in let iter_packet i mip = let ind = (mind, i) in let u = UVars.make_abstract_instance (Declareops.inductive_polymorphic_context mib) in let typ = Inductive.type_of_inductive (Inductive.lookup_mind_specif env ind, u) in let () = fn (GlobRef.IndRef ind) None env sigma typ in let len = Array.length mip.mind_user_lc in iter_constructors ind u fn env sigma len in Array.iteri iter_packet mib.mind_packets end @@ DynHandle.empty in handle handler o | _ -> () in try Declaremods.iter_all_interp_segments iter_obj with Not_found -> () (** This module defines a preference on constrs in the form of a [compare] function (preferred constr must be big for this functions, so preferences such as small constr must use a reversed order). This priority will be used to order search results and propose first results which are more likely to be relevant to the query, this is why the type [t] contains the other elements required of a search. *) module ConstrPriority = struct (* The priority is memoised here. Because of the very localised use of this module, it is not worth it making a convenient interface. *) type t = GlobRef.t * Decls.logical_kind option * Environ.env * Evd.evar_map * Constr.t * priority and priority = int module ConstrSet = CSet.Make(Constr) (** A measure of the size of a term *) let rec size t = Constr.fold (fun s t -> 1 + s + size t) 0 t (** Set of the "symbols" (definitions, inductives, constructors) which appear in a term. *) let rec symbols acc t = let open Constr in match kind t with | Const _ | Ind _ | Construct _ -> ConstrSet.add t acc | _ -> Constr.fold symbols acc t (** The number of distinct "symbols" (see {!symbols}) which appear in a term. *) let num_symbols t = ConstrSet.(cardinal (symbols empty t)) let priority gref t : priority = -(3*(num_symbols t) + size t) let compare (_,_,_,_,_,p1) (_,_,_,_,_,p2) = Stdlib.compare p1 p2 end module PriorityQueue = Heap.Functional(ConstrPriority) let rec iter_priority_queue q fn = (* Tail-rec! *) match PriorityQueue.maximum q with | (gref,kind,env,sigma,t,_) -> fn gref kind env sigma t; iter_priority_queue (PriorityQueue.remove q) fn | exception Heap.EmptyHeap -> () let prioritize_search seq fn = let acc = ref PriorityQueue.empty in let iter gref kind env sigma t = let p = ConstrPriority.priority gref t in acc := PriorityQueue.add (gref,kind,env,sigma,t,p) !acc in let () = seq iter in iter_priority_queue !acc fn (** Filters *) (** This function tries to see whether the conclusion matches a pattern. FIXME: this is quite dummy, we may find a more efficient algorithm. *) let rec pattern_filter pat ref env sigma typ = let typ = Termops.strip_outer_cast sigma typ in if Constr_matching.is_matching env sigma pat typ then true else match EConstr.kind sigma typ with | Prod (_, _, typ) | LetIn (_, _, _, typ) -> pattern_filter pat ref env sigma typ | _ -> false let full_name_of_reference ref = let (dir,id) = repr_path (Nametab.path_of_global ref) in DirPath.to_string dir ^ "." ^ Id.to_string id (** Whether a reference is blacklisted *) let blacklist_filter ref kind env sigma typ = let name = full_name_of_reference ref in let is_not_bl str = not (String.string_contains ~where:name ~what:str) in CString.Set.for_all is_not_bl (SearchBlacklist.v ()) let module_filter mods ref kind env sigma typ = let sp = Nametab.path_of_global ref in let sl = dirpath sp in match mods with | SearchOutside mods -> let is_outside md = not (is_dirpath_prefix_of md sl) in List.for_all is_outside mods | SearchInside mods -> let is_inside md = is_dirpath_prefix_of md sl in List.is_empty mods || List.exists is_inside mods let name_of_reference ref = Id.to_string (Nametab.basename_of_global ref) let search_filter query gr kind env sigma typ = match query with | GlobSearchSubPattern (where,head,pat) -> let open Context.Rel.Declaration in let rec collect env hyps typ = match Constr.kind typ with | LetIn (na,b,t,c) -> collect (push_rel (LocalDef (na,b,t)) env) ((env,b) :: (env,t) :: hyps) c | Prod (na,t,c) -> collect (push_rel (LocalAssum (na,t)) env) ((env,t) :: hyps) c | _ -> (hyps,(env,typ)) in let typl= match where with | InHyp -> fst (collect env [] typ) | InConcl -> [snd (collect env [] typ)] | Anywhere -> if head then let hyps, ccl = collect env [] typ in ccl :: hyps else [env,typ] in List.exists (fun (env,typ) -> let f = if head then Constr_matching.is_matching_head else Constr_matching.is_matching_appsubterm ~closed:false in f env sigma pat (EConstr.of_constr typ)) typl | GlobSearchString s -> String.string_contains ~where:(name_of_reference gr) ~what:s | GlobSearchKind k -> (match kind with None -> false | Some k' -> k = k') | GlobSearchFilter f -> f gr (** SearchPattern *) let search_pattern env sigma pat mods pr_search = let filter ref kind env sigma typ = module_filter mods ref kind env sigma typ && pattern_filter pat ref env sigma (EConstr.of_constr typ) && blacklist_filter ref kind env sigma typ in let iter ref kind env sigma typ = if filter ref kind env sigma typ then pr_search ref kind env sigma typ in generic_search env sigma iter (** SearchRewrite *) let eq () = Coqlib.(lib_ref "core.eq.type") let rewrite_pat1 pat = PApp (PRef (eq ()), [| PMeta None; pat; PMeta None |]) let rewrite_pat2 pat = PApp (PRef (eq ()), [| PMeta None; PMeta None; pat |]) let search_rewrite env sigma pat mods pr_search = let pat1 = rewrite_pat1 pat in let pat2 = rewrite_pat2 pat in let filter ref kind env sigma typ = module_filter mods ref kind env sigma typ && (pattern_filter pat1 ref env sigma (EConstr.of_constr typ) || pattern_filter pat2 ref env sigma (EConstr.of_constr typ)) && blacklist_filter ref kind env sigma typ in let iter ref kind env sigma typ = if filter ref kind env sigma typ then pr_search ref kind env sigma typ in generic_search env sigma iter (** Search *) let search env sigma items mods pr_search = let filter ref kind env sigma typ = let eqb b1 b2 = if b1 then b2 else not b2 in module_filter mods ref kind env sigma typ && let rec aux = function | GlobSearchLiteral i -> search_filter i ref kind env sigma typ | GlobSearchDisjConj l -> List.exists (List.for_all aux') l and aux' (b,s) = eqb b (aux s) in List.for_all aux' items && blacklist_filter ref kind env sigma typ in let iter ref kind env sigma typ = if filter ref kind env sigma typ then pr_search ref kind env sigma typ in generic_search env sigma iter type search_constraint = | Name_Pattern of Str.regexp | Type_Pattern of Pattern.constr_pattern | SubType_Pattern of Pattern.constr_pattern | In_Module of Names.DirPath.t | Include_Blacklist type 'a coq_object = { coq_object_prefix : string list; coq_object_qualid : string list; coq_object_object : 'a; } let interface_search env sigma = let rec extract_flags name tpe subtpe mods blacklist = function | [] -> (name, tpe, subtpe, mods, blacklist) | (Name_Pattern regexp, b) :: l -> extract_flags ((regexp, b) :: name) tpe subtpe mods blacklist l | (Type_Pattern pat, b) :: l -> extract_flags name ((pat, b) :: tpe) subtpe mods blacklist l | (SubType_Pattern pat, b) :: l -> extract_flags name tpe ((pat, b) :: subtpe) mods blacklist l | (In_Module id, b) :: l -> extract_flags name tpe subtpe ((id, b) :: mods) blacklist l | (Include_Blacklist, b) :: l -> extract_flags name tpe subtpe mods b l in fun flags -> let (name, tpe, subtpe, mods, blacklist) = extract_flags [] [] [] [] false flags in let filter_function ref env sigma constr = let id = Names.Id.to_string (Nametab.basename_of_global ref) in let path = Libnames.dirpath (Nametab.path_of_global ref) in let toggle x b = if x then b else not b in let match_name (regexp, flag) = toggle (Str.string_match regexp id 0) flag in let match_type (pat, flag) = toggle (Constr_matching.is_matching env sigma pat (EConstr.of_constr constr)) flag in let match_subtype (pat, flag) = toggle (Constr_matching.is_matching_appsubterm ~closed:false env sigma pat (EConstr.of_constr constr)) flag in let match_module (mdl, flag) = toggle (Libnames.is_dirpath_prefix_of mdl path) flag in List.for_all match_name name && List.for_all match_type tpe && List.for_all match_subtype subtpe && List.for_all match_module mods && (blacklist || blacklist_filter ref kind env sigma constr) in let ans = ref [] in let print_function ref env sigma constr = let fullpath = DirPath.repr (Nametab.dirpath_of_global ref) in let qualid = Nametab.shortest_qualid_of_global Id.Set.empty ref in let (shortpath, basename) = Libnames.repr_qualid qualid in let shortpath = DirPath.repr shortpath in (* [shortpath] is a suffix of [fullpath] and we're looking for the missing prefix *) let rec prefix full short accu = match full, short with | _, [] -> let full = List.rev_map Id.to_string full in (full, accu) | _ :: full, m :: short -> prefix full short (Id.to_string m :: accu) | _ -> assert false in let (prefix, qualid) = prefix fullpath shortpath [Id.to_string basename] in let answer = { coq_object_prefix = prefix; coq_object_qualid = qualid; coq_object_object = constr; } in ans := answer :: !ans; in let iter ref kind env sigma typ = if filter_function ref env sigma typ then print_function ref env sigma typ in let () = generic_search env sigma iter in !ans coq-8.20.0/vernac/search.mli000066400000000000000000000071371466560755400156430ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* bool) type glob_search_request = | GlobSearchLiteral of glob_search_item | GlobSearchDisjConj of (bool * glob_search_request) list list type filter_function = GlobRef.t -> Decls.logical_kind option -> env -> Evd.evar_map -> constr -> bool type display_function = GlobRef.t -> Decls.logical_kind option -> env -> Evd.evar_map -> constr -> unit (** {6 Generic filter functions} *) val blacklist_filter : filter_function (** Check whether a reference is blacklisted. *) val module_filter : DirPath.t list search_restriction -> filter_function (** Check whether a reference pertains or not to a set of modules *) val search_filter : glob_search_item -> filter_function (** {6 Specialized search functions} [search_xxx gl pattern modinout] searches the hypothesis of the [gl]th goal and the global environment for things matching [pattern] and satisfying module exclude/include clauses of [modinout]. *) val search_rewrite : env -> Evd.evar_map -> constr_pattern -> DirPath.t list search_restriction -> display_function -> unit val search_pattern : env -> Evd.evar_map -> constr_pattern -> DirPath.t list search_restriction -> display_function -> unit val search : env -> Evd.evar_map -> (bool * glob_search_request) list -> DirPath.t list search_restriction -> display_function -> unit type search_constraint = | Name_Pattern of Str.regexp (** Whether the name satisfies a regexp (uses Ocaml Str syntax) *) | Type_Pattern of Pattern.constr_pattern (** Whether the object type satisfies a pattern *) | SubType_Pattern of Pattern.constr_pattern (** Whether some subtype of object type satisfies a pattern *) | In_Module of Names.DirPath.t (** Whether the object pertains to a module *) | Include_Blacklist (** Bypass the Search blacklist *) type 'a coq_object = { coq_object_prefix : string list; coq_object_qualid : string list; coq_object_object : 'a; } val interface_search : env -> Evd.evar_map -> (search_constraint * bool) list -> constr coq_object list (** {6 Generic search function} *) val generic_search : env -> Evd.evar_map -> display_function -> unit (** This function iterates over all hypothesis of the goal numbered [glnum] (if present) and all known declarations. *) (** {6 Search function modifiers} *) val prioritize_search : (display_function -> unit) -> display_function -> unit (** [prioritize_search iter] iterates over the values of [iter] (seen as a sequence of declarations), in a relevance order. This requires to perform the entire iteration of [iter] before starting streaming. So [prioritize_search] should not be used for low-latency streaming. *) coq-8.20.0/vernac/synterp.ml000066400000000000000000000555641466560755400157400ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* match Pvernac.lookup_proof_mode name with | Some pm -> pm | None -> CErrors.user_err Pp.(str (Format.sprintf "No proof mode named \"%s\"." name))) Pvernac.proof_mode_to_string () let module_locality = Attributes.Notations.(locality >>= fun l -> return (make_module_locality l)) let with_locality ~atts f = let local = Attributes.(parse locality atts) in f ~local let with_module_locality ~atts f = let module_local = Attributes.(parse module_locality atts) in f ~module_local let warn_legacy_export_set = CWarnings.create ~name:"legacy-export-set" ~category:Deprecation.Version.v8_18 Pp.(fun () -> strbrk "Syntax \"Export Set\" is deprecated, use the attribute syntax \"#[export] Set\" instead.") let deprecated_nonuniform = CWarnings.create ~name:"deprecated-nonuniform-attribute" ~category:Deprecation.Version.v8_18 Pp.(fun () -> strbrk "Attribute '#[nonuniform]' is deprecated, \ use '#[warning=\"-uniform-inheritance\"]' instead.") let warnings_att = Attributes.attribute_of_list [ "warnings", Attributes.payload_parser ~cat:(^) ~name:"warnings"; "warning", Attributes.payload_parser ~cat:(^) ~name:"warning"; ] let with_generic_atts ~check atts f = let atts, warnings = Attributes.parse_with_extra warnings_att atts in let atts, nonuniform = Attributes.parse_with_extra ComCoercion.nonuniform atts in let warnings = let () = if nonuniform <> None && check then deprecated_nonuniform () in if nonuniform <> Some true then warnings else let ui = "-uniform-inheritance" in Some (match warnings with Some w -> w ^ "," ^ ui | None -> ui) in match warnings with | None -> f ~atts | Some warnings -> if check then CWarnings.check_unknown_warnings warnings; CWarnings.with_warn warnings (fun () -> f ~atts) () type module_entry = Modintern.module_struct_expr * Names.ModPath.t * Modintern.module_kind * Entries.inline type control_entry = | ControlTime of { synterp_duration: System.duration } | ControlInstructions of { synterp_instructions: System.instruction_count } | ControlRedirect of string | ControlTimeout of { remaining : float } | ControlFail of { st : Vernacstate.Synterp.t } | ControlSucceed of { st : Vernacstate.Synterp.t } type synterp_entry = | EVernacNoop | EVernacNotation of { local : bool; decl : Metasyntax.notation_interpretation_decl } | EVernacBeginSection of lident | EVernacEndSegment of lident | EVernacRequire of Library.library_t list * DirPath.t list * export_with_cats option * (qualid * import_filter_expr) list | EVernacImport of (export_flag * Libobject.open_filter) * (Names.ModPath.t CAst.t * import_filter_expr) list | EVernacDeclareModule of Lib.export * lident * Declaremods.module_params_expr * module_entry | EVernacDefineModule of Lib.export * lident * Declaremods.module_params_expr * ((export_flag * Libobject.open_filter) * Names.ModPath.t) list * module_entry Declaremods.module_signature * module_entry list | EVernacDeclareModuleType of lident * Declaremods.module_params_expr * ((export_flag * Libobject.open_filter) * Names.ModPath.t) list * module_entry list * module_entry list | EVernacInclude of Declaremods.module_expr list | EVernacSetOption of { export : bool; key : Goptions.option_name; value : Vernacexpr.option_setting } | EVernacLoad of Vernacexpr.verbose_flag * (vernac_control_entry * Vernacstate.Synterp.t) list | EVernacExtend of Vernactypes.typed_vernac and vernac_entry = synterp_entry Vernacexpr.vernac_expr_gen and vernac_control_entry = (control_entry, synterp_entry) Vernacexpr.vernac_control_gen_r CAst.t let synterp_reserved_notation ~module_local ~infix l = Metasyntax.add_reserved_notation ~local:module_local ~infix l let synterp_custom_entry ~module_local s = Metasyntax.declare_custom_entry module_local s (* Assumes cats is irrelevant if f is ImportNames *) let import_module_syntax_with_filter ~export cats m f = match f with | ImportAll -> Declaremods.Synterp.import_module cats ~export m | ImportNames ns -> () let synterp_import_mod (export,cats) qid f = let loc = qid.loc in let m = try Nametab.locate_module qid with Not_found -> CErrors.user_err ?loc Pp.(str "Cannot find module " ++ pr_qualid qid) in import_module_syntax_with_filter ~export cats m f; m let synterp_import_cats cats = Option.cata (fun cats -> Libobject.make_filter ~finite:(not cats.negative) cats.import_cats) Libobject.unfiltered cats let check_no_filter_when_using_cats l = List.iter (function | _, ImportAll -> () | q, ImportNames _ -> CErrors.user_err ?loc:q.loc Pp.(str "Cannot combine importing by categories and importing by names.")) l let synterp_import export refl = if Option.has_some (snd export) then check_no_filter_when_using_cats refl; let export = on_snd synterp_import_cats export in export, List.map (fun (qid,f) -> CAst.make ?loc:qid.loc @@ synterp_import_mod export qid f, f) refl let synterp_define_module export {loc;v=id} (binders_ast : module_binder list) mty_ast_o mexpr_ast_l = if Lib.sections_are_opened () then user_err Pp.(str "Modules and Module Types are not allowed inside sections."); let export = Option.map (on_snd synterp_import_cats) export in match mexpr_ast_l with | [] -> let binders_ast,argsexport = List.fold_right (fun (export,idl,ty) (args,argsexport) -> (idl,ty)::args, (List.map (fun {v=i} -> Option.map (on_snd synterp_import_cats) export,i)idl)@argsexport) binders_ast ([],[]) in let mp, args, sign = Declaremods.Synterp.start_module export id binders_ast mty_ast_o in let argsexports = List.map_filter (fun (export,id) -> Option.map (fun export -> export, synterp_import_mod export (qualid_of_ident id) ImportAll ) export ) argsexport in export, args, argsexports, [], sign | _::_ -> let binders_ast = List.map (fun (export,idl,ty) -> if not (Option.is_empty export) then user_err Pp.(str "Arguments of a functor definition can be imported only if the definition is interactive. Remove the \"Export\" and \"Import\" keywords from every functor argument.") else (idl,ty)) binders_ast in let mp, args, expr, sign = Declaremods.Synterp.declare_module id binders_ast mty_ast_o mexpr_ast_l in Option.iter (fun (export,cats) -> ignore (synterp_import_mod (export,cats) (qualid_of_ident id) ImportAll)) export; export, args, [], expr, sign let synterp_declare_module_type_syntax {loc;v=id} binders_ast mty_sign mty_ast_l = if Lib.sections_are_opened () then user_err Pp.(str "Modules and Module Types are not allowed inside sections."); match mty_ast_l with | [] -> let binders_ast,argsexport = List.fold_right (fun (export,idl,ty) (args,argsexport) -> (idl,ty)::args, (List.map (fun {v=i} -> Option.map (on_snd synterp_import_cats) export,i)idl)@argsexport) binders_ast ([],[]) in let mp, args, sign = Declaremods.Synterp.start_modtype id binders_ast mty_sign in let argsexport = List.map_filter (fun (export,id) -> Option.map (fun export -> export, synterp_import_mod export (qualid_of_ident ?loc id) ImportAll) export ) argsexport in args, argsexport, [], sign | _ :: _ -> let binders_ast = List.map (fun (export,idl,ty) -> if not (Option.is_empty export) then user_err Pp.(str "Arguments of a functor definition can be imported only if the definition is interactive. Remove the \"Export\" and \"Import\" keywords from every functor argument.") else (idl,ty)) binders_ast in let mp, args, expr, sign = Declaremods.Synterp.declare_modtype id binders_ast mty_sign mty_ast_l in args, [], expr, sign let synterp_declare_module export {loc;v=id} binders_ast mty_ast = let binders_ast = List.map (fun (export,idl,ty) -> if not (Option.is_empty export) then user_err Pp.(str "Arguments of a functor declaration cannot be exported. Remove the \"Export\" and \"Import\" keywords from every functor argument.") else (idl,ty)) binders_ast in let mp, args, expr, sign = Declaremods.Synterp.declare_module id binders_ast (Declaremods.Enforce mty_ast) [] in assert (List.is_empty expr); let sign = match sign with Declaremods.Enforce x -> x | _ -> assert false in let export = Option.map (on_snd synterp_import_cats) export in Option.iter (fun export -> ignore @@ synterp_import_mod export (qualid_of_ident id) ImportAll) export; mp, export, args, sign let synterp_include l = Declaremods.Synterp.declare_include l let synterp_end_module export {loc;v=id} = let _ = Declaremods.Synterp.end_module () in Option.map (fun export -> synterp_import_mod export (qualid_of_ident ?loc id) ImportAll) export let synterp_end_section {CAst.loc; v} = Dumpglob.dump_reference ?loc (DirPath.to_string (Lib.current_dirpath true)) "<>" "sec"; Lib.Synterp.close_section () let synterp_end_segment ({v=id} as lid) = let ss = Lib.Synterp.find_opening_node id in match ss with | Lib.OpenedModule (false,export,_,_) -> ignore (synterp_end_module export lid) | Lib.OpenedModule (true,_,_,_) -> ignore (Declaremods.Synterp.end_modtype ()) | Lib.OpenedSection _ -> synterp_end_section lid | _ -> assert false let err_unmapped_library ?from qid = let prefix = match from with | None -> mt () | Some from -> str " with prefix " ++ DirPath.print from in strbrk "Cannot find a physical path bound to logical path " ++ pr_qualid qid ++ prefix ++ str "." let err_notfound_library ?from qid = let prefix = match from with | None -> mt () | Some from -> str " with prefix " ++ DirPath.print from in let bonus = if !Flags.load_vos_libraries then mt () else str " (while searching for a .vos file)" in strbrk "Unable to locate library " ++ pr_qualid qid ++ prefix ++ bonus ++ str "." exception UnmappedLibrary of Names.DirPath.t option * Libnames.qualid exception NotFoundLibrary of Names.DirPath.t option * Libnames.qualid let _ = CErrors.register_handler begin function | UnmappedLibrary (from, qid) -> Some (err_unmapped_library ?from qid) | NotFoundLibrary (from, qid) -> Some (err_notfound_library ?from qid) | _ -> None end let synterp_require ~intern from export qidl = let root = match from with | None -> None | Some from -> let (hd, tl) = Libnames.repr_qualid from in Some (Libnames.add_dirpath_suffix hd tl) in let locate (qid,_) = let open Loadpath in match locate_qualified_library ?root qid with | Ok (dir,_) -> (qid.loc, dir) | Error LibUnmappedDir -> Loc.raise ?loc:qid.loc (UnmappedLibrary (root, qid)) | Error LibNotFound -> Loc.raise ?loc:qid.loc (NotFoundLibrary (root, qid)) in let modrefl = List.map locate qidl in let filenames = Library.require_library_syntax_from_dirpath ~intern modrefl in Option.iter (fun (export,cats) -> let cats = synterp_import_cats cats in List.iter2 (fun (_, m) (_, f) -> import_module_syntax_with_filter ~export cats (MPfile m) f) modrefl qidl) export; filenames, List.map snd modrefl (*****************************) (* Auxiliary file management *) let expand filename = Envars.expand_path_macros ~warn:(fun x -> Feedback.msg_warning (str x)) filename let synterp_declare_ml_module ~local l = let local = Option.default false local in let l = List.map expand l in Mltop.declare_ml_modules local l let warn_chdir = CWarnings.create ~name:"change-dir-deprecated" ~category:Deprecation.Version.v8_20 (fun () -> strbrk "Command \"Cd\" is deprecated." ++ spc () ++ strbrk "Use command-line \"-output-directory dir\" instead, or, alternatively, " ++ strbrk "for extraction, \"Set Extraction Output Directory\".") let synterp_chdir = function | None -> Feedback.msg_notice (str (Sys.getcwd())) | Some path -> warn_chdir (); begin try Sys.chdir (expand path) with Sys_error err -> (* Cd is typically used to control the output directory of extraction. A failed Cd could lead to overwriting .ml files so we make it an error. *) user_err Pp.(str ("Cd failed: " ^ err)) end; Flags.if_verbose Feedback.msg_info (str (Sys.getcwd())) (* External dependencies *) let synterp_extra_dep ?loc from file id = if Lib.sections_are_opened () then user_err ?loc Pp.(str "Extra Dependencies cannot be declared inside sections."); let hd, tl = Libnames.repr_qualid from in let from = Libnames.add_dirpath_suffix hd tl in ComExtraDeps.declare_extra_dep ?loc ~from ~file id let synterp_begin_section ({v=id} as lid) = Dumpglob.dump_definition lid true "sec"; Lib.Synterp.open_section id (** A global default timeout, controlled by option "Set Default Timeout n". Use "Unset Default Timeout" to deactivate it (or set it to 0). *) let check_timeout n = if n <= 0 then CErrors.user_err Pp.(str "Timeout must be > 0.") (* Timeout *) let with_timeout ~timeout:n (f : 'a -> 'b) (x : 'a) : 'b = check_timeout n; let n = float_of_int n in let start = Unix.gettimeofday () in begin match Control.timeout n f x with | None -> Exninfo.iraise (Exninfo.capture CErrors.Timeout) | Some (ctrl,v) -> let stop = Unix.gettimeofday () in let remaining = n -. (start -. stop) in if remaining <= 0. then Exninfo.iraise (Exninfo.capture CErrors.Timeout) else ControlTimeout { remaining } :: ctrl, v end let test_mode = ref false (* Restoring the state is the caller's responsibility *) let with_fail f : (Loc.t option * Pp.t, 'a) result = try let x = f () in Error x with (* Fail Timeout is a common pattern so we need to support it. *) | e -> (* The error has to be printed in the failing state *) let _, info as exn = Exninfo.capture e in if CErrors.is_anomaly e && e != CErrors.Timeout then Exninfo.iraise exn; Ok (Loc.get_loc info, CErrors.iprint exn) let real_error_loc ~cmdloc ~eloc = if Loc.finer eloc cmdloc then eloc else cmdloc let with_fail ~loc f = let st = Vernacstate.Synterp.freeze () in let res = with_fail f in let transient_st = Vernacstate.Synterp.freeze () in Vernacstate.Synterp.unfreeze st; match res with | Error (ctrl, v) -> ControlFail { st = transient_st } :: ctrl, v | Ok (eloc, msg) -> let loc = if !test_mode then real_error_loc ~cmdloc:loc ~eloc else None in if not !Flags.quiet || !test_mode then Feedback.msg_notice ?loc Pp.(str "The command has indeed failed with message:" ++ fnl () ++ msg); [], VernacSynterp EVernacNoop let with_succeed f = let st = Vernacstate.Synterp.freeze () in let (ctrl, v) = f () in let transient_st = Vernacstate.Synterp.freeze () in Vernacstate.Synterp.unfreeze st; ControlSucceed { st = transient_st } :: ctrl, v let synpure_control : control_flag -> control_entry = let freeze = Vernacstate.Synterp.freeze in function | ControlTime -> ControlTime { synterp_duration = System.empty_duration } | ControlInstructions -> ControlInstructions { synterp_instructions = Ok 0L } | ControlRedirect s -> ControlRedirect s | ControlTimeout timeout -> check_timeout timeout; ControlTimeout { remaining = float_of_int timeout } | ControlFail -> ControlFail { st = freeze() } | ControlSucceed -> ControlSucceed { st = freeze() } (* We restore the state always *) let rec synterp_control_flag ~loc (f : control_flag list) fn expr = match f with | [] -> [], fn expr | ControlFail :: l -> with_fail ~loc (fun () -> synterp_control_flag ~loc l fn expr) | ControlSucceed :: l -> with_succeed (fun () -> synterp_control_flag ~loc l fn expr) | ControlTimeout timeout :: l -> with_timeout ~timeout (synterp_control_flag ~loc l fn) expr | ControlTime :: l -> begin match System.measure_duration (synterp_control_flag ~loc l fn) expr with | Ok((ctrl,v), synterp_duration) -> ControlTime { synterp_duration } :: ctrl, v | Error(exn, synterp_duration) as e -> Feedback.msg_notice @@ System.fmt_transaction_result e; Exninfo.iraise exn end | ControlInstructions :: l -> begin match System.count_instructions (synterp_control_flag ~loc l fn) expr with | Ok((ctrl,v), synterp_instructions) -> ControlInstructions { synterp_instructions } :: ctrl, v | Error(exn, synterp_instructions) as e -> Feedback.msg_notice @@ System.fmt_instructions_result e; Exninfo.iraise exn end | ControlRedirect s :: l -> let (ctrl, v) = Topfmt.with_output_to_file s (synterp_control_flag ~loc l fn) expr in (ControlRedirect s :: ctrl, v) let rec synterp ~intern ?loc ~atts v = match v with | VernacSynterp v0 -> let e = begin match v0 with | VernacReservedNotation (infix, sl) -> with_module_locality ~atts synterp_reserved_notation ~infix sl; EVernacNoop | VernacNotation (infix,ntn_decl) -> let local, user_warns = Attributes.(parse Notations.(module_locality ++ user_warns) atts) in let decl = Metasyntax.add_notation_syntax ~local ~infix user_warns ntn_decl in EVernacNotation { local; decl } | VernacDeclareCustomEntry s -> with_module_locality ~atts synterp_custom_entry s; EVernacNoop | VernacDefineModule (export,lid,bl,mtys,mexprl) -> let export, args, argsexport, expr, sign = synterp_define_module export lid bl mtys mexprl in EVernacDefineModule (export,lid,args,argsexport,sign,expr) | VernacDeclareModuleType (lid,bl,mtys,mtyo) -> let args, argsexport, expr, sign = synterp_declare_module_type_syntax lid bl mtys mtyo in EVernacDeclareModuleType (lid,args,argsexport,sign,expr) | VernacDeclareModule (export,lid,bl,mtyo) -> let mp, export, args, sign = synterp_declare_module export lid bl mtyo in EVernacDeclareModule (export,lid,args,sign) | VernacInclude in_asts -> EVernacInclude (synterp_include in_asts) | VernacBeginSection lid -> synterp_begin_section lid; EVernacBeginSection lid | VernacEndSegment lid -> synterp_end_segment lid; EVernacEndSegment lid | VernacRequire (from, export, qidl) -> let needed, modrefl = synterp_require ~intern from export qidl in EVernacRequire (needed, modrefl, export, qidl) | VernacImport (export,qidl) -> let export, mpl = synterp_import export qidl in EVernacImport (export,mpl) | VernacDeclareMLModule l -> with_locality ~atts synterp_declare_ml_module l; EVernacNoop | VernacChdir s -> unsupported_attributes atts; synterp_chdir s; EVernacNoop | VernacExtraDependency(from,file,id) -> unsupported_attributes atts; synterp_extra_dep ?loc from file id; EVernacNoop | VernacSetOption (export,key,value) -> let atts = if export then begin warn_legacy_export_set ?loc (); CAst.make ?loc ("export", VernacFlagEmpty) :: atts end else atts in let locality = parse option_locality atts in Vernacoptions.vernac_set_option ~locality ~stage:Summary.Stage.Synterp key value; EVernacSetOption { export; key; value } | VernacProofMode mn -> unsupported_attributes atts; EVernacNoop | VernacLoad (verbosely, fname) -> unsupported_attributes atts; synterp_load ~intern verbosely fname | VernacExtend (opn,args) -> let f = Vernacextend.type_vernac ?loc ~atts opn args () in EVernacExtend(f) end in VernacSynterp e | VernacSynPure x -> VernacSynPure x and synterp_load ~intern verbosely fname = let fname = Envars.expand_path_macros ~warn:(fun x -> Feedback.msg_warning (Pp.str x)) fname in let fname = CUnix.make_suffix fname ".v" in let input = let longfname = Loadpath.locate_file fname in let in_chan = Util.open_utf8_file_in longfname in Pcoq.Parsable.make ~loc:Loc.(initial (InFile { dirpath=None; file=longfname})) (Gramlib.Stream.of_channel in_chan) in (* Parsing loop *) let v_mod = if verbosely then Flags.verbosely else Flags.silently in let parse_sentence proof_mode = Pcoq.Entry.parse (Pvernac.main_entry proof_mode) in let proof_mode = Some (get_default_proof_mode ()) in let rec load_loop entries = match parse_sentence proof_mode input with | None -> entries | Some cmd -> let entry = v_mod (synterp_control ~intern) cmd in let st = Vernacstate.Synterp.freeze () in (load_loop [@ocaml.tailcall]) ((entry,st)::entries) in let entries = List.rev @@ load_loop [] in EVernacLoad(verbosely, entries) and synterp_control ~intern CAst.{ loc; v = cmd } = let fn expr = with_generic_atts ~check:true cmd.attrs (fun ~atts -> synterp ~intern ?loc ~atts cmd.expr) in let control, expr = synterp_control_flag ~loc cmd.control fn cmd.expr in CAst.make ?loc { expr; control; attrs = cmd.attrs } let default_timeout = ref None let () = let open Goptions in declare_int_option { optstage = Summary.Stage.Synterp; optdepr = None; optkey = ["Default";"Timeout"]; optread = (fun () -> !default_timeout); optwrite = (fun n -> Option.iter check_timeout n; default_timeout := n) } let has_timeout ctrl = ctrl |> List.exists (function | Vernacexpr.ControlTimeout _ -> true | _ -> false) let add_default_timeout control = match !default_timeout with | None -> control | Some n -> if has_timeout control then control else Vernacexpr.ControlTimeout n :: control let synterp_control ~intern cmd = synterp_control ~intern (CAst.map (fun cmd -> { cmd with control = add_default_timeout cmd.control }) cmd) let synterp_control ~intern cmd = Flags.with_option Flags.in_synterp_phase (synterp_control ~intern) cmd coq-8.20.0/vernac/synterp.mli000066400000000000000000000106041466560755400160730ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* (local:bool option -> 'a) -> 'a val with_module_locality : atts:Attributes.vernac_flags -> (module_local:bool -> 'a) -> 'a val with_generic_atts : check:bool -> Attributes.vernac_flags -> (atts:Attributes.vernac_flags -> 'a) -> 'a type module_entry = Modintern.module_struct_expr * Names.ModPath.t * Modintern.module_kind * Entries.inline type control_entry = | ControlTime of { synterp_duration: System.duration } | ControlInstructions of { synterp_instructions: System.instruction_count } | ControlRedirect of string | ControlTimeout of { remaining : float } | ControlFail of { st : Vernacstate.Synterp.t } | ControlSucceed of { st : Vernacstate.Synterp.t } (** Interprete control flag assuming a synpure command. *) val synpure_control : Vernacexpr.control_flag -> control_entry type synterp_entry = | EVernacNoop | EVernacNotation of { local : bool; decl : Metasyntax.notation_interpretation_decl } | EVernacBeginSection of Names.lident | EVernacEndSegment of Names.lident | EVernacRequire of Library.library_t list * DirPath.t list * Vernacexpr.export_with_cats option * (qualid * Vernacexpr.import_filter_expr) list | EVernacImport of (Vernacexpr.export_flag * Libobject.open_filter) * (Names.ModPath.t CAst.t * Vernacexpr.import_filter_expr) list | EVernacDeclareModule of Lib.export * lident * Declaremods.module_params_expr * module_entry | EVernacDefineModule of Lib.export * lident * Declaremods.module_params_expr * ((Vernacexpr.export_flag * Libobject.open_filter) * Names.ModPath.t) list * module_entry Declaremods.module_signature * module_entry list | EVernacDeclareModuleType of lident * Declaremods.module_params_expr * ((Vernacexpr.export_flag * Libobject.open_filter) * Names.ModPath.t) list * module_entry list * module_entry list | EVernacInclude of Declaremods.module_expr list | EVernacSetOption of { export : bool; key : Goptions.option_name; value : Vernacexpr.option_setting } | EVernacLoad of Vernacexpr.verbose_flag * (vernac_control_entry * Vernacstate.Synterp.t) list | EVernacExtend of Vernactypes.typed_vernac and vernac_entry = synterp_entry Vernacexpr.vernac_expr_gen (** [vernac_control_entry] defines elaborated vernacular expressions, after the syntactic interpretation phase and before full interpretation *) and vernac_control_entry = (control_entry, synterp_entry) Vernacexpr.vernac_control_gen_r CAst.t exception UnmappedLibrary of Names.DirPath.t option * Libnames.qualid exception NotFoundLibrary of Names.DirPath.t option * Libnames.qualid (** [synterp_require] performs the syntactic interpretation phase of `Require` commands *) val synterp_require : intern:Library.Intern.t -> Libnames.qualid option -> Vernacexpr.export_with_cats option -> (Libnames.qualid * Vernacexpr.import_filter_expr) list -> Library.library_t list * DirPath.t list (** [synterp_control] is the main entry point of the syntactic interpretation phase *) val synterp_control : intern:Library.Intern.t -> Vernacexpr.vernac_control -> vernac_control_entry val add_default_timeout : Vernacexpr.control_flag list -> Vernacexpr.control_flag list (** Default proof mode set by `start_proof` *) val get_default_proof_mode : unit -> Pvernac.proof_mode val proof_mode_opt_name : string list (** Flag set when the test-suite is called. Its only effect to display verbose information for [Fail] *) val test_mode : bool ref coq-8.20.0/vernac/topfmt.ml000066400000000000000000000357501466560755400155400ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* pp_global_params -> unit * set the parameters of a formatter *) let set_gp ft gp = Format.pp_set_margin ft gp.margin ; Format.pp_set_max_indent ft gp.max_indent ; Format.pp_set_max_boxes ft gp.max_depth ; Format.pp_set_ellipsis_text ft gp.ellipsis let set_dflt_gp ft = set_gp ft dflt_gp let get_gp ft = { margin = Format.pp_get_margin ft (); max_indent = Format.pp_get_max_indent ft (); max_depth = Format.pp_get_max_boxes ft (); ellipsis = Format.pp_get_ellipsis_text ft () } (* with_fp : 'a pp_formatter_params -> Format.formatter * returns of formatter for given formatter functions *) let with_fp chan out_function flush_function = let ft = Format.make_formatter out_function flush_function in Format.pp_set_formatter_out_channel ft chan; ft (* Output on a channel ch *) let with_output_to ch = let ft = with_fp ch (output_substring ch) (fun () -> flush ch) in set_gp ft deep_gp; ft let std_ft = ref Format.std_formatter let _ = set_dflt_gp !std_ft let err_ft = ref Format.err_formatter let _ = set_gp !err_ft deep_gp let deep_ft = ref (with_output_to stdout) let _ = set_gp !deep_ft deep_gp (* For parametrization through vernacular *) let default = Format.pp_get_max_boxes !std_ft () let default_margin = Format.pp_get_margin !std_ft () let get_depth_boxes () = Some (Format.pp_get_max_boxes !std_ft ()) let set_depth_boxes v = Format.pp_set_max_boxes !std_ft (match v with None -> default | Some v -> v) let get_margin0 () = Format.pp_get_margin !std_ft () let () = Profile_tactic.set_get_printing_width get_margin0 let get_margin () = Some (get_margin0()) let set_margin v = let v = match v with None -> default_margin | Some v -> v in Format.pp_set_margin Format.str_formatter v; Format.pp_set_margin !std_ft v; Format.pp_set_margin !deep_ft v; Format.pp_set_margin !err_ft v; (* Heuristic, based on usage: the column on the right of max_indent column is 20% of width, capped to 30 characters *) let m = max (64 * v / 100) (v-30) in Format.pp_set_max_indent Format.str_formatter m; Format.pp_set_max_indent !std_ft m; Format.pp_set_max_indent !deep_ft m; Format.pp_set_max_indent !err_ft m (** Console display of feedback *) (** Default tags *) module Tag = struct let error = "message.error" let warning = "message.warning" let debug = "message.debug" end let msgnl_with fmt strm = pp_with fmt (strm ++ fnl ()); Format.pp_print_flush fmt () module Emacs = struct (* Special chars for emacs, to detect warnings inside goal output *) let quote_warning_start = "" let quote_warning_end = "" let quote_info_start = "" let quote_info_end = "" let quote_emacs q_start q_end msg = hov 0 (seq [str q_start; brk(0,0); msg; brk(0,0); str q_end]) let quote_warning = quote_emacs quote_warning_start quote_warning_end let quote_info = quote_emacs quote_info_start quote_info_end end let dbg_hdr = tag Tag.debug (str "Debug:") ++ spc () let info_hdr = mt () let warn_hdr = tag Tag.warning (str "Warning:") ++ spc () let err_hdr = tag Tag.error (str "Error:") ++ spc () let make_body quoter info ?pre_hdr s = pr_opt_no_spc (fun x -> x ++ fnl ()) pre_hdr ++ quoter (hov 0 (info ++ s)) (* The empty quoter *) let noq x = x (* Generic logger *) let gen_logger dbg warn ?pre_hdr level msg = let open Feedback in match level with | Debug -> msgnl_with !std_ft (make_body dbg dbg_hdr ?pre_hdr msg) | Info -> msgnl_with !std_ft (make_body dbg info_hdr ?pre_hdr msg) | Notice -> msgnl_with !std_ft (make_body noq info_hdr ?pre_hdr msg) | Warning -> Flags.if_warn (fun () -> msgnl_with !err_ft (make_body warn warn_hdr ?pre_hdr msg)) () | Error -> msgnl_with !err_ft (make_body noq err_hdr ?pre_hdr msg) (** Standard loggers *) (* We provide a generic clear_log_backend callback for backends wanting to do cleanup after the print. *) let std_logger_cleanup = ref (fun () -> ()) let std_logger ?pre_hdr level msg = gen_logger (fun x -> x) (fun x -> x) ?pre_hdr level msg; !std_logger_cleanup () (** Color logging. Moved from Ppstyle, it may need some more refactoring *) (* Tag map for terminal style *) let default_tag_map () = let open Terminal in [ (* Local to console toplevel *) "message.error" , make ~bold:true ~fg_color:`WHITE ~bg_color:`RED () ; "message.warning" , make ~bold:true ~fg_color:`WHITE ~bg_color:`YELLOW () ; "message.debug" , make ~bold:true ~fg_color:`WHITE ~bg_color:`MAGENTA () ; "message.prompt" , make ~fg_color:`GREEN () (* Coming from the printer *) ; "constr.evar" , make ~fg_color:`LIGHT_BLUE () ; "constr.keyword" , make ~bold:true () ; "constr.type" , make ~bold:true ~fg_color:`YELLOW () ; "constr.notation" , make ~fg_color:`WHITE () (* ["constr"; "variable"] is not assigned *) ; "constr.reference" , make ~fg_color:`LIGHT_GREEN () ; "constr.path" , make ~fg_color:`LIGHT_MAGENTA () ; "module.definition", make ~bold:true ~fg_color:`LIGHT_RED () ; "module.keyword" , make ~bold:true () ; "tactic.keyword" , make ~bold:true () ; "tactic.primitive" , make ~fg_color:`LIGHT_GREEN () ; "tactic.string" , make ~fg_color:`LIGHT_RED () ; "diff.added" , make ~bg_color:(`RGB(0,141,0)) ~underline:true () ; "diff.removed" , make ~bg_color:(`RGB(170,0,0)) ~underline:true () ; "diff.added.bg" , make ~bg_color:(`RGB(0,91,0)) () ; "diff.removed.bg" , make ~bg_color:(`RGB(91,0,0)) () ] let tag_map = ref CString.Map.empty let init_tag_map styles = let set accu (name, st) = CString.Map.add name st accu in tag_map := List.fold_left set !tag_map styles let default_styles () = init_tag_map (default_tag_map ()) let set_emacs_print_strings () = let open Terminal in let diff = "diff." in List.iter (fun b -> let (name, attrs) = b in if CString.is_sub diff name 0 then tag_map := CString.Map.add name { attrs with prefix = Some (Printf.sprintf "<%s>" name); suffix = Some (Printf.sprintf "" name) } !tag_map) (CString.Map.bindings !tag_map) let parse_color_config str = let styles = Terminal.parse str in init_tag_map styles let dump_tags () = CString.Map.bindings !tag_map let empty = Terminal.make () let default_style = Terminal.reset_style let get_style tag = try CString.Map.find tag !tag_map with Not_found -> empty;; let get_open_seq tags = let style = List.fold_left (fun a b -> Terminal.merge a (get_style b)) default_style tags in Terminal.eval (Terminal.diff default_style style);; let get_close_seq tags = let style = List.fold_left (fun a b -> Terminal.merge a (get_style b)) default_style tags in Terminal.eval (Terminal.diff style default_style);; let diff_tag_stack = ref [] (* global, just like std_ft *) (** Not thread-safe. We should put a lock somewhere if we print from different threads. Do we? *) let make_style_stack () = (* Default tag is to reset everything *) let style_stack = ref [] in let peek () = match !style_stack with | [] -> default_style (* Anomalous case, but for robustness *) | st :: _ -> st in let open_tag = function | Format.String_tag tag -> let (tpfx, ttag) = split_tag tag in if tpfx = end_pfx then "" else let style = get_style ttag in (* Merge the current settings and the style being pushed. This allows restoring the previous settings correctly in a pop when both set the same attribute. Example: current settings have red FG, the pushed style has green FG. When popping the style, we should set red FG, not default FG. *) let style = Terminal.merge (peek ()) style in let diff = Terminal.diff (peek ()) style in style_stack := style :: !style_stack; if tpfx = start_pfx then diff_tag_stack := ttag :: !diff_tag_stack; Terminal.eval diff | _ -> Terminal.eval default_style in let close_tag = function | Format.String_tag tag -> let (tpfx, _) = split_tag tag in if tpfx = start_pfx then "" else begin if tpfx = end_pfx then diff_tag_stack := (try List.tl !diff_tag_stack with tl -> []); match !style_stack with | [] -> (* Something went wrong, we fallback *) Terminal.eval default_style | cur :: rem -> style_stack := rem; if cur = (peek ()) then "" else if rem = [] then Terminal.reset else Terminal.eval (Terminal.diff cur (peek ())) end | _ -> Terminal.eval default_style in let clear () = style_stack := [] in open_tag, close_tag, clear let make_printing_functions () = let print_prefix ft = function | Format.String_tag tag -> let (tpfx, ttag) = split_tag tag in if tpfx <> end_pfx then let style = get_style ttag in (match style.Terminal.prefix with Some s -> Format.pp_print_as ft 0 s | None -> ()) | _ -> () in let print_suffix ft = function | Format.String_tag tag -> let (tpfx, ttag) = split_tag tag in if tpfx <> start_pfx then let style = get_style ttag in (match style.Terminal.suffix with Some s -> Format.pp_print_as ft 0 s | None -> ()) | _ -> () in print_prefix, print_suffix let init_output_fns () = let reopen_highlight = ref "" in let open Format in let fns = Format.pp_get_formatter_out_functions !std_ft () in let newline () = if !diff_tag_stack <> [] then begin let close = get_close_seq !diff_tag_stack in fns.out_string close 0 (String.length close); reopen_highlight := get_open_seq (List.rev !diff_tag_stack); end; fns.out_string "\n" 0 1 in let string s off n = if !reopen_highlight <> "" && String.trim (String.sub s off n) <> "" then begin fns.out_string !reopen_highlight 0 (String.length !reopen_highlight); reopen_highlight := "" end; fns.out_string s off n in let new_fns = { fns with out_string = string; out_newline = newline } in Format.pp_set_formatter_out_functions !std_ft new_fns;; let init_terminal_output ~color = let open_tag, close_tag, clear_tag = make_style_stack () in let print_prefix, print_suffix = make_printing_functions () in let tag_handler ft = { Format.mark_open_stag = open_tag; Format.mark_close_stag = close_tag; Format.print_open_stag = print_prefix ft; Format.print_close_stag = print_suffix ft; } in if color then (* Use 0-length markers *) begin std_logger_cleanup := clear_tag; init_output_fns (); Format.pp_set_mark_tags !std_ft true; Format.pp_set_mark_tags !err_ft true end else (* Use textual markers *) begin Format.pp_set_print_tags !std_ft true; Format.pp_set_print_tags !err_ft true end; Format.pp_set_formatter_stag_functions !std_ft (tag_handler !std_ft); Format.pp_set_formatter_stag_functions !err_ft (tag_handler !err_ft) (* Rules for emacs: - Debug/info: emacs_quote_info - Warning/Error: emacs_quote_err - Notice: unquoted *) let emacs_logger = gen_logger Emacs.quote_info Emacs.quote_warning (* This is specific to the toplevel *) type execution_phase = | ParsingCommandLine | Initialization | LoadingPrelude | LoadingRcFile | InteractiveLoop | CompilationPhase let default_phase = ref InteractiveLoop let in_phase ~phase f x = let op = !default_phase in default_phase := phase; try let res = f x in default_phase := op; res with exn -> let iexn = Exninfo.capture exn in default_phase := op; Exninfo.iraise iexn let pr_loc loc = Loc.pr loc ++ str ":" let pr_phase ?loc () = match !default_phase, loc with | LoadingRcFile, loc -> (* For when all errors go through feedback: str "While loading rcfile:" ++ Option.cata (fun loc -> fnl () ++ pr_loc loc) (mt ()) loc *) Option.map pr_loc loc | LoadingPrelude, loc -> Some (str "While loading initial state:" ++ Option.cata (fun loc -> fnl () ++ pr_loc loc) (mt ()) loc) | _, Some loc -> Some (pr_loc loc) | ParsingCommandLine, _ | Initialization, _ | CompilationPhase, _ -> None | InteractiveLoop, _ -> (* Note: interactive messages such as "foo is defined" are not located *) None let print_err_exn any = let (e, info) = Exninfo.capture any in let loc = Loc.get_loc info in let pre_hdr = pr_phase ?loc () in let msg = CErrors.iprint (e, info) ++ fnl () in std_logger ?pre_hdr Feedback.Error msg let with_output_to_file fname func input = let fname = String.concat "." [fname; "out"] in let fullfname = System.get_output_path fname in System.mkdir (Filename.dirname fullfname); let channel = open_out fullfname in let old_fmt = !std_ft, !err_ft, !deep_ft in let new_ft = Format.formatter_of_out_channel channel in set_gp new_ft (get_gp !std_ft); std_ft := new_ft; err_ft := new_ft; deep_ft := new_ft; try let output = func input in std_ft := Util.pi1 old_fmt; err_ft := Util.pi2 old_fmt; deep_ft := Util.pi3 old_fmt; Format.pp_print_flush new_ft (); close_out channel; output with reraise -> let reraise = Exninfo.capture reraise in std_ft := Util.pi1 old_fmt; err_ft := Util.pi2 old_fmt; deep_ft := Util.pi3 old_fmt; Format.pp_print_flush new_ft (); close_out channel; Exninfo.iraise reraise (* For coqtop -time, we display the position in the file, and a glimpse of the executed command *) let pr_cmd_header com = let shorten s = if Unicode.utf8_length s > 33 then (Unicode.utf8_sub s 0 30) ^ "..." else s in let noblank s = String.map (fun c -> match c with | ' ' | '\n' | '\t' | '\r' -> '~' | x -> x ) s in let (start,stop) = Option.cata Loc.unloc (0,0) com.CAst.loc in let safe_pr_vernac x = try Ppvernac.pr_vernac x with e -> str (Printexc.to_string e) in let cmd = noblank (shorten (string_of_ppcmds (safe_pr_vernac com))) in str "Chars " ++ int start ++ str " - " ++ int stop ++ str " [" ++ str cmd ++ str "] " coq-8.20.0/vernac/topfmt.mli000066400000000000000000000047661466560755400157140ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* pp_global_params -> unit val set_dflt_gp : Format.formatter -> unit val get_gp : Format.formatter -> pp_global_params (** {6 Output functions of pretty-printing. } *) val with_output_to : out_channel -> Format.formatter val std_ft : Format.formatter ref val err_ft : Format.formatter ref val deep_ft : Format.formatter ref (** {6 For parametrization through vernacular. } *) val set_depth_boxes : int option -> unit val get_depth_boxes : unit -> int option val set_margin : int option -> unit val get_margin : unit -> int option (** Console display of feedback, we may add some location information *) val std_logger : ?pre_hdr:Pp.t -> Feedback.level -> Pp.t -> unit val emacs_logger : ?pre_hdr:Pp.t -> Feedback.level -> Pp.t -> unit (** Color output *) val default_styles : unit -> unit val parse_color_config : string -> unit val dump_tags : unit -> (string * Terminal.style) list val set_emacs_print_strings : unit -> unit (** Initialization of interpretation of tags *) val init_terminal_output : color:bool -> unit (** Error printing *) (* To be deprecated when we can fully move to feedback-based error printing. *) type execution_phase = | ParsingCommandLine | Initialization | LoadingPrelude | LoadingRcFile | InteractiveLoop | CompilationPhase val in_phase : phase:execution_phase -> ('a -> 'b) -> 'a -> 'b val pr_phase : ?loc:Loc.t -> unit -> Pp.t option val print_err_exn : exn -> unit (** [with_output_to_file file f x] executes [f x] with logging redirected to a file [file] *) val with_output_to_file : string -> ('a -> 'b) -> 'a -> 'b val pr_cmd_header : Vernacexpr.vernac_control -> Pp.t coq-8.20.0/vernac/vernac_classifier.ml000066400000000000000000000231141466560755400177000ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* "Later" | VtNow -> "Now" let string_of_vernac_classification = function | VtStartProof _ -> "StartProof" | VtSideff (_,w) -> "Sideff"^" "^(string_of_vernac_when w) | VtQed (VtKeep VtKeepAxiom) -> "Qed(admitted)" | VtQed (VtKeep (VtKeepOpaque | VtKeepDefined)) -> "Qed(keep)" | VtQed VtDrop -> "Qed(drop)" | VtProofStep { proof_block_detection } -> "ProofStep " ^ Option.default "" proof_block_detection | VtQuery -> "Query" | VtMeta -> "Meta " | VtProofMode _ -> "Proof Mode" let vtkeep_of_opaque = function | Opaque -> VtKeepOpaque | Transparent -> VtKeepDefined let idents_of_name : Names.Name.t -> Names.Id.t list = function | Names.Anonymous -> [] | Names.Name n -> [n] let stm_allow_nested_proofs_option_name = ["Nested";"Proofs";"Allowed"] let options_affecting_stm_scheduling = [ Attributes.universe_polymorphism_option_name; stm_allow_nested_proofs_option_name; Synterp.proof_mode_opt_name; Attributes.program_mode_option_name; Proof_using.proof_using_opt_name; ] let classify_vernac e = let static_synterp_classifier ~atts e = match e with (* Univ poly compatibility: we run it now, so that we can just * look at Flags in stm.ml. Would be nicer to have the stm * look at the entire dag to detect this option. *) | VernacSetOption (_, l,_) when CList.exists (CList.equal String.equal l) options_affecting_stm_scheduling -> VtSideff ([], VtNow) | VernacBeginSection {v=id} -> VtSideff ([id], VtLater) | VernacChdir _ | VernacExtraDependency _ | VernacSetOption _ -> VtSideff ([], VtLater) (* (Local) Notations have to disappear *) | VernacEndSegment _ -> VtSideff ([], VtNow) (* Modules with parameters have to be executed: can import notations *) | VernacDeclareModule (exp,{v=id},bl,_) | VernacDefineModule (exp,{v=id},bl,_,_) -> VtSideff ([id], if bl = [] && exp = None then VtLater else VtNow) | VernacDeclareModuleType ({v=id},bl,_,_) -> VtSideff ([id], if bl = [] then VtLater else VtNow) (* These commands alter the parser *) | VernacDeclareCustomEntry _ | VernacNotation _ | VernacReservedNotation _ | VernacRequire _ | VernacImport _ | VernacInclude _ | VernacDeclareMLModule _ -> VtSideff ([], VtNow) | VernacProofMode pm -> (match Pvernac.lookup_proof_mode pm with | None -> CErrors.user_err Pp.(str (Format.sprintf "No proof mode named \"%s\"." pm)) | Some proof_mode -> VtProofMode proof_mode) (* Plugins should classify their commands *) | VernacLoad _ -> VtSideff ([], VtNow) | VernacExtend (s,l) -> try Vernacextend.get_vernac_classifier s l with Not_found -> anomaly(str"No classifier for"++spc()++str s.ext_entry ++str".") in let static_pure_classifier ~atts e = match e with (* Qed *) | VernacAbort -> VtQed VtDrop | VernacEndProof Admitted -> VtQed (VtKeep VtKeepAxiom) | VernacEndProof (Proved (opaque,_)) -> VtQed (VtKeep (vtkeep_of_opaque opaque)) | VernacExactProof _ -> VtQed (VtKeep VtKeepOpaque) (* Query *) | VernacShow _ | VernacPrint _ | VernacSearch _ | VernacLocate _ | VernacGlobalCheck _ | VernacCheckMayEval _ -> VtQuery (* ProofStep *) | VernacProof _ | VernacFocus _ | VernacUnfocus | VernacSubproof _ | VernacCheckGuard | VernacValidateProof | VernacUnfocused | VernacBullet _ -> VtProofStep { proof_block_detection = Some "bullet" } | VernacEndSubproof -> VtProofStep { proof_block_detection = Some "curly" } (* StartProof *) | VernacDefinition ((DoDischarge,_),({v=i},_),ProveBody _) -> VtStartProof(Doesn'tGuaranteeOpacity, idents_of_name i) | VernacDefinition (_,({v=i},_),ProveBody _) -> let polymorphic = Attributes.(parse_drop_extra polymorphic atts) in let guarantee = if polymorphic then Doesn'tGuaranteeOpacity else GuaranteesOpacity in VtStartProof(guarantee, idents_of_name i) | VernacStartTheoremProof (_,l) -> let polymorphic = Attributes.(parse_drop_extra polymorphic atts) in let ids = List.map (fun (({v=i}, _), _) -> i) l in let guarantee = if polymorphic then Doesn'tGuaranteeOpacity else GuaranteesOpacity in VtStartProof (guarantee,ids) | VernacFixpoint (discharge,l) -> let polymorphic = Attributes.(parse_drop_extra polymorphic atts) in let guarantee = if discharge = DoDischarge || polymorphic then Doesn'tGuaranteeOpacity else GuaranteesOpacity in let ids, open_proof = List.fold_left (fun (l,b) {Vernacexpr.fname={CAst.v=id}; body_def} -> id::l, b || body_def = None) ([],false) l in if open_proof then VtStartProof (guarantee,ids) else VtSideff (ids, VtLater) | VernacCoFixpoint (discharge,l) -> let polymorphic = Attributes.(parse_drop_extra polymorphic atts) in let guarantee = if discharge = DoDischarge || polymorphic then Doesn'tGuaranteeOpacity else GuaranteesOpacity in let ids, open_proof = List.fold_left (fun (l,b) { Vernacexpr.fname={CAst.v=id}; body_def } -> id::l, b || body_def = None) ([],false) l in if open_proof then VtStartProof (guarantee,ids) else VtSideff (ids, VtLater) (* Sideff: apply to all open branches. usually run on master only *) | VernacAssumption (_,_,l) -> let ids = List.flatten (List.map (fun (_,(l,_)) -> List.map (fun (id, _) -> id.v) l) l) in VtSideff (ids, VtLater) | VernacSymbol l -> let ids = List.flatten (List.map (fun (_,(l,_)) -> List.map (fun (id, _) -> id.v) l) l) in VtSideff (ids, VtLater) | VernacPrimitive ((id,_),_,_) -> VtSideff ([id.CAst.v], VtLater) | VernacDefinition (_,({v=id},_),DefineBody _) -> VtSideff (idents_of_name id, VtLater) | VernacInductive (_,l) -> let ids = List.map (fun (((_,({v=id},_)),_,_,cl),_) -> id :: match cl with | Constructors l -> List.map (fun (_,({v=id},_)) -> id) l | RecordDecl (oid,l,obinder) -> (match oid with Some {v=x} -> [x] | _ -> []) @ (match obinder with Some {v=x} -> [x] | _ -> []) @ CList.map_filter (function | AssumExpr({v=Names.Name n},_,_), _ -> Some n | _ -> None) l) l in VtSideff (List.flatten ids, VtLater) | VernacScheme l -> let ids = List.map (fun {v}->v) (CList.map_filter (fun (x,_) -> x) l) in VtSideff (ids, VtLater) | VernacCombinedScheme ({v=id},_) -> VtSideff ([id], VtLater) | VernacUniverse _ | VernacConstraint _ | VernacCanonical _ | VernacCoercion _ | VernacIdentityCoercion _ | VernacCreateHintDb _ | VernacRemoveHints _ | VernacHints _ | VernacArguments _ | VernacReserve _ | VernacGeneralizable _ | VernacSetOpacity _ | VernacSetStrategy _ | VernacAddOption _ | VernacRemoveOption _ | VernacMemOption _ | VernacPrintOption _ | VernacDeclareReduction _ | VernacExistingClass _ | VernacExistingInstance _ | VernacRegister _ | VernacNameSectionHypSet _ | VernacComments _ | VernacAttributes _ | VernacSchemeEquality _ | VernacAddRewRule _ | VernacDeclareInstance _ -> VtSideff ([], VtLater) (* Who knows *) | VernacOpenCloseScope _ | VernacDeclareScope _ | VernacDelimiters _ | VernacBindScope _ | VernacEnableNotation _ | VernacSyntacticDefinition _ | VernacContext _ (* TASSI: unsure *) -> VtSideff ([], VtNow) | VernacInstance ((name,_),_,_,props,_) -> let program, refine = Attributes.(parse_drop_extra Notations.(program ++ Classes.refine_att) atts) in if program || (props <> None && not refine) then VtSideff (idents_of_name name.CAst.v, VtLater) else let polymorphic = Attributes.(parse_drop_extra polymorphic atts) in let guarantee = if polymorphic then Doesn'tGuaranteeOpacity else GuaranteesOpacity in VtStartProof (guarantee, idents_of_name name.CAst.v) (* Stm will install a new classifier to handle these *) | VernacBack _ | VernacAbortAll | VernacUndoTo _ | VernacUndo _ | VernacResetName _ | VernacResetInitial | VernacRestart -> VtMeta in let static_classifier ~atts e = match e with | VernacSynPure e -> static_pure_classifier ~atts e | VernacSynterp e -> static_synterp_classifier ~atts e in let static_control_classifier ({ CAst.v ; _ } as cmd) = (* Fail Qed or Fail Lemma must not join/fork the DAG *) (* XXX why is Fail not always Query? *) if Vernacprop.has_query_control cmd then (match static_classifier ~atts:v.attrs v.expr with | VtQuery | VtProofStep _ | VtSideff _ | VtMeta as x -> x | VtQed _ -> VtProofStep { proof_block_detection = None } | VtStartProof _ | VtProofMode _ -> VtQuery) else static_classifier ~atts:v.attrs v.expr in static_control_classifier e coq-8.20.0/vernac/vernac_classifier.mli000066400000000000000000000016471466560755400200600ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* string (** What does a vernacular do *) val classify_vernac : Vernacexpr.vernac_control -> vernac_classification (** *) val stm_allow_nested_proofs_option_name : string list coq-8.20.0/vernac/vernacentries.ml000066400000000000000000003141551466560755400170760ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* let env = Global.env () in Evd.(from_env env, env) | Some p -> Declare.Proof.get_current_context p let get_goal_or_global_context ~pstate glnum = match pstate with | None -> let env = Global.env () in Evd.(from_env env, env) | Some p -> Declare.Proof.get_goal_context p glnum let cl_of_qualid = function | FunClass -> Coercionops.CL_FUN | SortClass -> Coercionops.CL_SORT | RefClass r -> ComCoercion.class_of_global (Smartlocate.smart_global ~head:true r) let scope_class_of_qualid qid = Notation.scope_class_of_class (cl_of_qualid qid) (** Standard attributes for definition-like commands. *) module DefAttributes = struct type t = { scope : definition_scope; locality : bool option; polymorphic : bool; program : bool; user_warns : UserWarn.t option; canonical_instance : bool; typing_flags : Declarations.typing_flags option; using : Vernacexpr.section_subset_expr option; reversible : bool; clearbody: bool option; } (* [locality] is used for [vernac_definition_hook], the raw Local/Global attribute is also used to generate [scope]. [locality] can't be computed back from [scope] because [Let Coercion] outside section generates [locality = None] but [scope = Global ImportNeedQualified] (which is otherwise associated with [locality = Some true]). Since [Let] (ie discharge = DoDischarge) does not allow explicit locality we could alternatively decide to change the default locality of the coercion from out-of-section [Let Coercion]. *) let importability_of_bool = function | true -> ImportNeedQualified | false -> ImportDefaultBehavior let warn_declaration_outside_section = CWarnings.create ~name:"declaration-outside-section" ~category:CWarnings.CoreCategories.vernacular ~default:CWarnings.AsError Pp.(fun (unexpected_thing, replacement) -> strbrk "Use of " ++ str unexpected_thing ++ strbrk " outside sections behaves as " ++ str replacement ++ str ".") let scope_of_locality locality_flag discharge deprecated_thing replacement : definition_scope = let open Vernacexpr in match locality_flag, discharge with | Some b, NoDischarge -> Global (importability_of_bool b) | None, NoDischarge -> Global ImportDefaultBehavior | None, DoDischarge when not (Lib.sections_are_opened ()) -> (* If a Let/Variable is defined outside a section, then we consider it as a local definition *) warn_declaration_outside_section (deprecated_thing, replacement); Global ImportNeedQualified | None, DoDischarge -> Discharge | Some true, DoDischarge -> CErrors.user_err Pp.(str "Local not allowed in this case") | Some false, DoDischarge -> CErrors.user_err Pp.(str "Global not allowed in this case") open Attributes open Attributes.Notations let clearbody = bool_attribute ~name:"clearbody" (* [XXX] EJGA: coercion is unused here *) let parse ?(coercion=false) ?(discharge=NoDischarge,"","") f = let discharge, deprecated_thing, replacement = discharge in let clearbody = match discharge with DoDischarge -> clearbody | NoDischarge -> return None in let (((((((locality, user_warns), polymorphic), program), canonical_instance), typing_flags), using), reversible), clearbody = parse (locality ++ user_warns ++ polymorphic ++ program ++ canonical_instance ++ typing_flags ++ using ++ reversible ++ clearbody) f in let using = Option.map Proof_using.using_from_string using in let reversible = Option.default false reversible in let () = if Option.has_some clearbody && not (Lib.sections_are_opened()) then CErrors.user_err Pp.(str "Cannot use attribute clearbody outside sections.") in let scope = scope_of_locality locality discharge deprecated_thing replacement in { scope; locality; polymorphic; program; user_warns; canonical_instance; typing_flags; using; reversible; clearbody } end let with_def_attributes ?coercion ?discharge ~atts f = let atts = DefAttributes.parse ?coercion ?discharge atts in if atts.DefAttributes.program then Declare.Obls.check_program_libraries (); f ~atts let with_section_locality ~atts f = let local = Attributes.(parse locality atts) in let section_local = make_section_locality local in f ~section_local (*******************) (* "Show" commands *) let show_proof ~pstate = (* spiwack: this would probably be cooler with a bit of polishing. *) try let pstate = Option.get pstate in let p = Declare.Proof.get pstate in let sigma, _ = Declare.Proof.get_current_context pstate in let pprf = Proof.partial_proof p in (* In the absence of an environment explicitly attached to the proof and on top of which side effects of the proof would be pushed, , we take the global environment which in practise should be a superset of the initial environment in which the proof was started *) let env = Global.env() in Pp.prlist_with_sep Pp.fnl (Printer.pr_econstr_env env sigma) pprf (* We print nothing if there are no goals left *) with | Proof.NoSuchGoal _ | Option.IsNone -> user_err (str "No goals to show.") let show_top_evars ~proof = (* spiwack: new as of Feb. 2010: shows goal evars in addition to non-goal evars. *) let Proof.{goals; sigma} = Proof.data proof in let shelf = Evd.shelf sigma in let given_up = Evar.Set.elements @@ Evd.given_up sigma in pr_evars_int sigma ~shelf ~given_up 1 (Evd.undefined_map sigma) let show_universes ~proof = let Proof.{goals;sigma} = Proof.data proof in let ctx = Evd.universe_context_set (Evd.minimize_universes sigma) in Termops.pr_evar_universe_context (Evd.evar_universe_context sigma) ++ fnl () ++ str "Normalized constraints:" ++ brk(1,1) ++ Univ.pr_universe_context_set (Termops.pr_evd_level sigma) ctx (* Simulate the Intro(s) tactic *) let show_intro ~proof all = let open EConstr in let Proof.{goals;sigma} = Proof.data proof in if not (List.is_empty goals) then begin let evi = Evd.find_undefined sigma (List.hd goals) in let env = Evd.evar_filtered_env (Global.env ()) evi in let l,_= decompose_prod_decls sigma (Termops.strip_outer_cast sigma (Evd.evar_concl evi)) in if all then let lid = Tactics.find_intro_names env sigma l in hov 0 (prlist_with_sep spc Id.print lid) else if not (List.is_empty l) then let n = List.last l in Id.print (List.hd (Tactics.find_intro_names env sigma [n])) else mt () end else mt () (** Textual display of a generic "match" template *) let show_match id = let patterns = try ComInductive.make_cases (Nametab.global_inductive id) with Not_found -> user_err Pp.(str "Unknown inductive type.") in let pr_branch l = str "| " ++ hov 1 (prlist_with_sep spc str l) ++ str " =>" in v 1 (str "match # with" ++ fnl () ++ prlist_with_sep fnl pr_branch patterns ++ fnl () ++ str "end" ++ fnl ()) (* "Print" commands *) let print_loadpath dir = let l = Loadpath.get_load_paths () in let l = match dir with | None -> l | Some dir -> let filter p = is_dirpath_prefix_of dir (Loadpath.logical p) in List.filter filter l in str "Logical Path / Physical path:" ++ fnl () ++ prlist_with_sep fnl Loadpath.pp l let print_libraries () = let loaded = Library.loaded_libraries () in str"Loaded library files: " ++ pr_vertical_list DirPath.print loaded let print_module qid = match Nametab.locate_module qid with | mp -> Printmod.print_module ~with_body:true mp | exception Not_found -> user_err (str"Unknown Module " ++ pr_qualid qid ++ str".") let print_modtype qid = try let kn = Nametab.locate_modtype qid in Printmod.print_modtype kn with Not_found -> (* Is there a module of this name ? If yes we display its type *) try let mp = Nametab.locate_module qid in Printmod.print_module ~with_body:false mp with Not_found -> user_err (str"Unknown Module Type or Module " ++ pr_qualid qid ++ str".") let print_namespace ~pstate ns = let ns = List.rev (Names.DirPath.repr ns) in (* [match_dirpath], [match_modulpath] are helpers for [matches] which checks whether a constant is in the namespace [ns]. *) let rec match_dirpath ns = function | [] -> Some ns | id::dir -> begin match match_dirpath ns dir with | Some [] as y -> y | Some (a::ns') -> if Names.Id.equal a id then Some ns' else None | None -> None end in let rec match_modulepath ns = function | MPbound _ -> None (* Not a proper namespace. *) | MPfile dir -> match_dirpath ns (Names.DirPath.repr dir) | MPdot (mp,lbl) -> let id = Names.Label.to_id lbl in begin match match_modulepath ns mp with | Some [] as y -> y | Some (a::ns') -> if Names.Id.equal a id then Some ns' else None | None -> None end in (* [qualified_minus n mp] returns a list of qualifiers representing [mp] except the [n] first (in the concrete syntax order). The idea is that if [mp] matches [ns], then [qualified_minus mp (length ns)] will be the correct representation of [mp] assuming [ns] is imported. *) (* precondition: [mp] matches some namespace of length [n] *) let qualified_minus n mp = let rec list_of_modulepath = function | MPbound _ -> assert false (* MPbound never matches *) | MPfile dir -> Names.DirPath.repr dir | MPdot (mp,lbl) -> (Names.Label.to_id lbl)::(list_of_modulepath mp) in snd (Util.List.chop n (List.rev (list_of_modulepath mp))) in let print_list pr l = prlist_with_sep (fun () -> str".") pr l in let print_kn kn = let (mp,lbl) = Names.KerName.repr kn in let qn = (qualified_minus (List.length ns) mp)@[Names.Label.to_id lbl] in print_list Id.print qn in let print_constant ~pstate k body = (* FIXME: universes *) let t = body.Declarations.const_type in let sigma, env = get_current_or_global_context ~pstate in print_kn k ++ str":" ++ spc() ++ Printer.pr_type_env env sigma t in let matches mp = match match_modulepath ns mp with | Some [] -> true | _ -> false in let constants_in_namespace = Environ.fold_constants (fun c body acc -> let kn = Constant.user c in if matches (KerName.modpath kn) then acc++fnl()++hov 2 (print_constant ~pstate kn body) else acc) (Global.env ()) (str"") in (print_list Id.print ns)++str":"++fnl()++constants_in_namespace let print_strategy r = let open Conv_oracle in let pr_level = function | Expand -> str "expand" | Level 0 -> str "transparent" | Level n -> str "level" ++ spc() ++ int n | Opaque -> str "opaque" in let pr_strategy (ref, lvl) = pr_global ref ++ str " : " ++ pr_level lvl in let oracle = Environ.oracle (Global.env ()) in match r with | None -> let fold key lvl (vacc, cacc, pacc) = match key with | Conv_oracle.EvalVarRef id -> ((GlobRef.VarRef id, lvl) :: vacc, cacc, pacc) | Conv_oracle.EvalConstRef cst -> (vacc, (GlobRef.ConstRef cst, lvl) :: cacc, pacc) | Conv_oracle.EvalProjectionRef p -> (vacc, cacc, (GlobRef.ConstRef (Projection.Repr.constant p), lvl) :: pacc) in let var_lvl, cst_lvl, prj_lvl = fold_strategy fold oracle ([], [], []) in let var_msg = if List.is_empty var_lvl then mt () else str "Variable strategies" ++ fnl () ++ hov 0 (prlist_with_sep fnl pr_strategy var_lvl) ++ fnl () in let cst_msg = if List.is_empty cst_lvl then mt () else str "Constant strategies" ++ fnl () ++ hov 0 (prlist_with_sep fnl pr_strategy cst_lvl) in let prj_msg = if List.is_empty prj_lvl then mt () else str "Projection strategies" ++ fnl () ++ hov 0 (prlist_with_sep fnl pr_strategy prj_lvl) in var_msg ++ cst_msg ++ prj_msg | Some r -> let r = Smartlocate.smart_global r in let key = let open GlobRef in match r with | VarRef id -> Evaluable.EvalVarRef id | ConstRef cst -> Evaluable.EvalConstRef cst | IndRef _ | ConstructRef _ -> user_err Pp.(str "The reference is not unfoldable.") in let lvl = get_strategy oracle (Evaluable.to_kevaluable key) in pr_strategy (r, lvl) let print_registered () = let pr_lib_ref (s,r) = pr_global r ++ str " registered as " ++ str s in hov 0 (prlist_with_sep fnl pr_lib_ref @@ Coqlib.get_lib_refs ()) let print_registered_schemes () = let schemes = DeclareScheme.all_schemes() in let pr_one_scheme ind (kind, c) = pr_global (ConstRef c) ++ str " registered as " ++ str kind ++ str " for " ++ pr_global (IndRef ind) in let pr_schemes_of_ind (ind, schemes) = prlist_with_sep fnl (pr_one_scheme ind) (CString.Map.bindings schemes) in hov 0 (prlist_with_sep fnl pr_schemes_of_ind (Indmap.bindings schemes)) let dump_universes output g = let open Univ in let dump_arc u = function | UGraph.Node ltle -> Univ.Level.Map.iter (fun v strict -> let typ = if strict then Lt else Le in output typ u v) ltle; | UGraph.Alias v -> output Eq u v in Univ.Level.Map.iter dump_arc g let dump_universes_gen prl g s = let fulls = System.get_output_path s in System.mkdir (Filename.dirname fulls); let output = open_out fulls in let output_constraint, close = if Filename.check_suffix s ".dot" || Filename.check_suffix s ".gv" then begin (* the lazy unit is to handle errors while printing the first line *) let init = lazy (Printf.fprintf output "digraph universes {\n") in begin fun kind left right -> let () = Lazy.force init in match kind with | Univ.Lt -> Printf.fprintf output " \"%s\" -> \"%s\" [style=bold];\n" right left | Univ.Le -> Printf.fprintf output " \"%s\" -> \"%s\" [style=solid];\n" right left | Univ.Eq -> Printf.fprintf output " \"%s\" -> \"%s\" [style=dashed];\n" left right end, begin fun () -> if Lazy.is_val init then Printf.fprintf output "}\n"; close_out output end end else begin begin fun kind left right -> let kind = match kind with | Univ.Lt -> "<" | Univ.Le -> "<=" | Univ.Eq -> "=" in Printf.fprintf output "%s %s %s ;\n" left kind right end, (fun () -> close_out output) end in let output_constraint k l r = output_constraint k (prl l) (prl r) in try dump_universes output_constraint g; close (); str "Universes written to file \"" ++ str s ++ str "\"." with reraise -> let reraise = Exninfo.capture reraise in close (); Exninfo.iraise reraise (* [XXX] EGJA: loc unused here *) let universe_subgraph ?loc kept univ = let open Univ in let parse q = try Level.make (Nametab.locate_universe q) with Not_found -> CErrors.user_err Pp.(str "Undeclared universe " ++ pr_qualid q ++ str".") in let kept = List.fold_left (fun kept q -> Level.Set.add (parse q) kept) Level.Set.empty kept in let csts = UGraph.constraints_for ~kept univ in let add u newgraph = let strict = UGraph.check_constraint univ (Level.set,Lt,u) in UGraph.add_universe u ~lbound:UGraph.Bound.Set ~strict newgraph in let univ = Level.Set.fold add kept UGraph.initial_universes in UGraph.merge_constraints csts univ let sort_universes g = let open Univ in let rec normalize u = match Level.Map.find u g with | UGraph.Alias u -> normalize u | UGraph.Node _ -> u in let get_next u = match Level.Map.find u g with | UGraph.Alias u -> assert false (* nodes are normalized *) | UGraph.Node ltle -> ltle in (* Compute the longest chain of Lt constraints from Set to any universe *) let rec traverse accu todo = match todo with | [] -> accu | (u, n) :: todo -> let () = assert (Level.equal (normalize u) u) in let n = match Level.Map.find u accu with | m -> if m < n then Some n else None | exception Not_found -> Some n in match n with | None -> traverse accu todo | Some n -> let accu = Level.Map.add u n accu in let next = get_next u in let fold v lt todo = let v = normalize v in if lt then (v, n + 1) :: todo else (v, n) :: todo in let todo = Level.Map.fold fold next todo in traverse accu todo in (* Only contains normalized nodes *) let levels = traverse Level.Map.empty [normalize Level.set, 0] in let max_level = Level.Map.fold (fun _ n accu -> max n accu) levels 0 in let dummy_mp = Names.DirPath.make [Names.Id.of_string "Type"] in let ulevels = Array.init max_level (fun i -> Level.(make (UGlobal.make dummy_mp "" i))) in (* Add the normal universes *) let fold (cur, ans) u = let ans = Level.Map.add cur (UGraph.Node (Level.Map.singleton u true)) ans in (u, ans) in let _, ans = Array.fold_left fold (Level.set, Level.Map.empty) ulevels in let ulevels = Array.cons Level.set ulevels in (* Add alias pointers *) let fold u _ ans = if Level.is_set u then ans else let n = Level.Map.find (normalize u) levels in Level.Map.add u (UGraph.Alias ulevels.(n)) ans in Level.Map.fold fold g ans let print_universes ?loc ~sort ~subgraph dst = let univ = Global.universes () in let univ = match subgraph with | None -> univ | Some g -> universe_subgraph ?loc g univ in let univ = UGraph.repr univ in let univ = if sort then sort_universes univ else univ in let pr_remaining = if Global.is_joined_environment () then mt () else str"There may remain asynchronous universe constraints" in let prl = UnivNames.pr_level_with_global_universes in begin match dst with | None -> UGraph.pr_universes prl univ ++ pr_remaining | Some s -> dump_universes_gen (fun u -> Pp.string_of_ppcmds (prl u)) univ s end (*********************) (* "Locate" commands *) let locate_file f = let file = Flags.silently Loadpath.locate_file f in str file let msg_found_library (fulldir, file) = if Library.library_is_loaded fulldir then hov 0 (DirPath.print fulldir ++ strbrk " has been loaded from file " ++ str file) else hov 0 (DirPath.print fulldir ++ strbrk " is bound to file " ++ str file) let print_located_library qid = let open Loadpath in match locate_qualified_library qid with | Ok lib -> msg_found_library lib | Error LibUnmappedDir -> raise (UnmappedLibrary (None, qid)) | Error LibNotFound -> raise (NotFoundLibrary (None, qid)) let smart_global r = let gr = Smartlocate.smart_global r in Dumpglob.add_glob ?loc:r.loc gr; gr let qualid_global id = smart_global (make ?loc:id.loc @@ Constrexpr.AN id) (**********) (* Syntax *) let vernac_declare_scope ~module_local sc = Metasyntax.declare_scope module_local sc let vernac_delimiters ~module_local sc action = match action with | Some lr -> Metasyntax.add_delimiters module_local sc lr | None -> Metasyntax.remove_delimiters module_local sc let vernac_bind_scope ~atts sc cll = let module_local, where = Attributes.(parse Notations.(module_locality ++ bind_scope_where) atts) in Metasyntax.add_class_scope module_local sc where (List.map scope_class_of_qualid cll) let vernac_open_close_scope ~section_local (to_open,s) = Metasyntax.open_close_scope section_local ~to_open s let interp_enable_notation_rule on ntn interp flags scope = let open Notation in let rule = Option.map (function | Inl ntn -> Inl (interpret_notation_string ntn) | Inr (vars,qid) -> Inr qid) ntn in let rec parse_notation_enable_flags all query = function | [] -> all, query | EnableNotationEntry CAst.{loc;v=entry} :: flags -> (match entry with InCustomEntry s when not (Egramcoq.exists_custom_entry s) -> user_err ?loc (str "Unknown custom entry.") | _ -> ()); parse_notation_enable_flags all { query with notation_entry_pattern = entry :: query.notation_entry_pattern } flags | EnableNotationOnly use :: flags -> parse_notation_enable_flags all { query with use_pattern = use } flags | EnableNotationAll :: flags -> parse_notation_enable_flags true query flags in let interp = Option.map (fun c -> let vars, recvars = match ntn with | None -> (* We expect the right-hand side to mention "_" in place of proper variables *) (* Or should we instead deactivate the check of free variables? *) ([], []) | Some (Inl ntn) -> let {recvars; mainvars} = decompose_raw_notation ntn in (mainvars, recvars) | Some (Inr (vars,qid)) -> (vars, []) in let ninterp_var_type = Id.Map.of_list (List.map (fun x -> (x, Notation_term.NtnInternTypeAny None)) vars) in let ninterp_rec_vars = Id.Map.of_list recvars in let nenv = Notation_term.{ ninterp_var_type; ninterp_rec_vars } in let (_acvars, ac, _reversibility) = Constrintern.interp_notation_constr (Global.env ()) nenv c in ([], ac)) interp in let default_notation_enable_pattern = { notation_entry_pattern = []; interp_rule_key_pattern = rule; use_pattern = ParsingAndPrinting; scope_pattern = scope; interpretation_pattern = interp; } in let all, notation_pattern = parse_notation_enable_flags false default_notation_enable_pattern flags in on, all, notation_pattern let vernac_enable_notation ~module_local on rule interp flags scope = let () = match rule, interp, scope with | None, None, None -> user_err (str "No notation provided.") | _ -> () in let on, all, notation_pattern = interp_enable_notation_rule on rule interp flags scope in Metasyntax.declare_notation_toggle module_local ~on ~all notation_pattern (***********) (* Gallina *) let check_name_freshness locality {CAst.loc;v=id} : unit = (* We check existence here: it's a bit late at Qed time *) if Termops.is_section_variable (Global.env ()) id || locality <> Discharge && Nametab.exists_cci (Lib.make_path id) || locality <> Discharge && Nametab.exists_cci (Lib.make_path_except_section id) then user_err ?loc (Id.print id ++ str " already exists.") let program_inference_hook env sigma ev = let tac = !Declare.Obls.default_tactic in let evi = Evd.find_undefined sigma ev in let evi = Evarutil.nf_evar_info sigma evi in let env = Evd.evar_filtered_env env evi in try let concl = Evd.evar_concl evi in if not (Evarutil.is_ground_env sigma env && Evarutil.is_ground_term sigma concl) then None else let c, sigma = Proof.refine_by_tactic ~name:(Id.of_string "program_subproof") ~poly:false env sigma concl (Tacticals.tclSOLVE [tac]) in Some (sigma, c) with | Logic_monad.TacticFailure e when noncritical e -> user_err Pp.(str "The statement obligations could not be resolved \ automatically, write a statement definition first.") (* XXX: Interpretation of lemma command, duplication with ComFixpoint / ComDefinition ? *) let interp_lemma ~program_mode ~flags ~scope env0 evd thms = let inference_hook = if program_mode then Some program_inference_hook else None in List.fold_left_map (fun evd ((id, _), (bl, t)) -> let evd, (impls, ((env, ctx), imps)) = Constrintern.interp_context_evars ~program_mode env0 evd bl in let evd, (t', imps') = Constrintern.interp_type_evars_impls ~flags ~impls env evd t in let flags = Pretyping.{ all_and_fail_flags with program_mode } in let evd = Pretyping.solve_remaining_evars ?hook:inference_hook flags env evd in let ids = List.map Context.Rel.Declaration.get_name ctx in let thm = Declare.CInfo.make ~name:id.CAst.v ~typ:(EConstr.it_mkProd_or_LetIn t' ctx) ~args:ids ~impargs:(imps @ imps') () in evd, thm) evd thms (* Checks done in start_lemma_com *) let post_check_evd ~udecl ~poly evd = let () = if not UState.(udecl.univdecl_extensible_instance && udecl.univdecl_extensible_constraints) then ignore (Evd.check_univ_decl ~poly evd udecl) in if poly then evd else (* We fix the variables to ensure they won't be lowered to Set *) Evd.fix_undefined_variables evd let start_lemma_com ~typing_flags ~program_mode ~poly ~scope ?clearbody ~kind ?user_warns ?using ?hook thms = let env0 = Global.env () in let env0 = Environ.update_typing_flags ?typing_flags env0 in let flags = Pretyping.{ all_no_fail_flags with program_mode } in let udecls = List.map (fun ((_,univs),_) -> univs) thms in let evd, udecl = Constrintern.interp_mutual_univ_decl_opt env0 udecls in let evd, thms = interp_lemma ~program_mode ~flags ~scope env0 evd thms in let mut_analysis = RecLemmas.look_for_possibly_mutual_statements evd thms in let evd = Evd.minimize_universes evd in let info = Declare.Info.make ?hook ~poly ~scope ?clearbody ~kind ~udecl ?typing_flags ?user_warns () in match mut_analysis with | RecLemmas.NonMutual thm -> let thm = Declare.CInfo.to_constr evd thm in let evd = post_check_evd ~udecl ~poly evd in Declare.Proof.start_definition ~info ~cinfo:thm ?using evd | RecLemmas.Mutual possible_guard -> let cinfo = List.map (Declare.CInfo.to_constr evd) thms in let evd = post_check_evd ~udecl ~poly evd in Declare.Proof.start_mutual_definitions ~info ~cinfo ~possible_guard ?using evd let vernac_definition_hook ~canonical_instance ~local ~poly ~reversible = let open Decls in function | Coercion -> Some (ComCoercion.add_coercion_hook ~reversible) | CanonicalStructure -> Some (Declare.Hook.(make (fun { S.dref } -> Canonical.declare_canonical_structure ?local dref))) | SubClass -> Some (ComCoercion.add_subclass_hook ~poly ~reversible) | Definition when canonical_instance -> Some (Declare.Hook.(make (fun { S.dref } -> Canonical.declare_canonical_structure ?local dref))) | Let when canonical_instance -> Some (Declare.Hook.(make (fun { S.dref } -> Canonical.declare_canonical_structure dref))) | _ -> None let default_thm_id = Id.of_string "Unnamed_thm" let fresh_name_for_anonymous_theorem () = Namegen.next_global_ident_away default_thm_id Id.Set.empty let vernac_definition_name lid local = let lid = match lid with | { v = Name.Anonymous; loc } -> CAst.make ?loc (fresh_name_for_anonymous_theorem ()) | { v = Name.Name n; loc } -> CAst.make ?loc n in check_name_freshness local lid; let () = match local with | Discharge -> Dumpglob.dump_definition lid true "var" | Global _ -> Dumpglob.dump_definition lid false "def" in lid let vernac_definition_interactive ~atts (discharge, kind) (lid, pl) bl t = let open DefAttributes in let scope, local, poly, program_mode, user_warns, typing_flags, using, clearbody = atts.scope, atts.locality, atts.polymorphic, atts.program, atts.user_warns, atts.typing_flags, atts.using, atts.clearbody in let canonical_instance, reversible = atts.canonical_instance, atts.reversible in let hook = vernac_definition_hook ~canonical_instance ~local ~poly ~reversible kind in let name = vernac_definition_name lid scope in start_lemma_com ~typing_flags ~program_mode ~poly ~scope ?clearbody ~kind:(Decls.IsDefinition kind) ?user_warns ?using ?hook [(name, pl), (bl, t)] let vernac_definition ~atts ~pm (discharge, kind) (lid, pl) bl red_option c typ_opt = let open DefAttributes in let scope, local, poly, program_mode, user_warns, typing_flags, using, clearbody = atts.scope, atts.locality, atts.polymorphic, atts.program, atts.user_warns, atts.typing_flags, atts.using, atts.clearbody in let canonical_instance, reversible = atts.canonical_instance, atts.reversible in let hook = vernac_definition_hook ~canonical_instance ~local ~poly kind ~reversible in let name = vernac_definition_name lid scope in let red_option = match red_option with | None -> None | Some r -> let env = Global.env () in let sigma = Evd.from_env env in Some (snd (Redexpr.interp_redexp_no_ltac env sigma r)) in if program_mode then let kind = Decls.IsDefinition kind in ComDefinition.do_definition_program ~pm ~name:name.v ?clearbody ~poly ?typing_flags ~scope ~kind ?user_warns ?using pl bl red_option c typ_opt ?hook else let () = ComDefinition.do_definition ~name:name.v ?clearbody ~poly ?typing_flags ~scope ~kind ?user_warns ?using pl bl red_option c typ_opt ?hook in pm (* NB: pstate argument to use combinators easily *) let vernac_start_proof ~atts kind l = let open DefAttributes in if Dumpglob.dump () then List.iter (fun ((id, _), _) -> Dumpglob.dump_definition id false "prf") l; let scope, poly, program_mode, user_warns, typing_flags, using = atts.scope, atts.polymorphic, atts.program, atts.user_warns, atts.typing_flags, atts.using in List.iter (fun ((id, _), _) -> check_name_freshness scope id) l; start_lemma_com ~typing_flags ~program_mode ~poly ~scope ~kind:(Decls.IsProof kind) ?user_warns ?using l let vernac_end_proof ~lemma ~pm = let open Vernacexpr in function | Admitted -> Declare.Proof.save_admitted ~pm ~proof:lemma | Proved (opaque,idopt) -> let pm, _ = Declare.Proof.save ~pm ~proof:lemma ~opaque ~idopt in pm let vernac_abort ~lemma:_ ~pm = pm let vernac_exact_proof ~lemma ~pm c = (* spiwack: for simplicity I do not enforce that "Proof proof_term" is called only at the beginning of a proof. *) let lemma, status = Declare.Proof.by (Tactics.exact_proof c) lemma in let pm, _ = Declare.Proof.save ~pm ~proof:lemma ~opaque:Opaque ~idopt:None in if not status then Feedback.feedback Feedback.AddedAxiom; pm let vernac_assumption ~atts kind l inline = let open DefAttributes in let scope, poly, program_mode, using, user_warns = atts.scope, atts.polymorphic, atts.program, atts.using, atts.user_warns in if Option.has_some using then Attributes.unsupported_attributes [CAst.make ("using",VernacFlagEmpty)]; ComAssumption.do_assumptions ~poly ~program_mode ~scope ~kind ?user_warns ~inline l let { Goptions.get = is_polymorphic_inductive_cumulativity } = declare_bool_option_and_ref ~key:["Polymorphic";"Inductive";"Cumulativity"] ~value:false () let polymorphic_cumulative ~is_defclass = let error_poly_context () = user_err Pp.(str "The cumulative attribute can only be used in a polymorphic context."); in let open Attributes in let open Notations in (* EJGA: this seems redudant with code in attributes.ml *) qualify_attribute "universes" (bool_attribute ~name:"polymorphic" ++ bool_attribute ~name:"cumulative") >>= fun (poly,cumul) -> if is_defclass && Option.has_some cumul then user_err Pp.(str "Definitional classes do not support the inductive cumulativity attribute."); match poly, cumul with | Some poly, Some cumul -> (* Case of Polymorphic|Monomorphic Cumulative|NonCumulative Inductive and #[ universes(polymorphic|monomorphic,cumulative|noncumulative) ] Inductive *) if poly then return (true, cumul) else error_poly_context () | Some poly, None -> (* Case of Polymorphic|Monomorphic Inductive and #[ universes(polymorphic|monomorphic) ] Inductive *) if poly then return (true, is_polymorphic_inductive_cumulativity ()) else return (false, false) | None, Some cumul -> (* Case of Cumulative|NonCumulative Inductive *) if is_universe_polymorphism () then return (true, cumul) else error_poly_context () | None, None -> (* Case of Inductive *) if is_universe_polymorphism () then return (true, is_polymorphic_inductive_cumulativity ()) else return (false, false) let { Goptions.get = get_uniform_inductive_parameters } = Goptions.declare_bool_option_and_ref ~key:["Uniform"; "Inductive"; "Parameters"] ~value:false () let should_treat_as_uniform () = if get_uniform_inductive_parameters () then ComInductive.UniformParameters else ComInductive.NonUniformParameters (* [XXX] EGJA: several arguments not used here *) let vernac_record ~template udecl ~cumulative k ~poly ?typing_flags ~primitive_proj finite records = let map ((is_coercion, name), binders, sort, nameopt, cfs, ido) = let idbuild = match nameopt with | None -> Nameops.add_prefix "Build_" name.v | Some lid -> lid.v in let default_inhabitant_id = Option.map (fun CAst.{v=id} -> id) ido in Record.Ast.{ name; is_coercion; binders; cfs; idbuild; sort; default_inhabitant_id } in let records = List.map map records in match typing_flags with | Some _ -> CErrors.user_err (Pp.str "Typing flags are not yet supported for records.") | None -> records let extract_inductive_udecl (indl:(inductive_expr * notation_declaration list) list) = match indl with | [] -> assert false | (((coe,(id,udecl)),b,c,d),e) :: rest -> let rest = List.map (fun (((coe,(id,udecl)),b,c,d),e) -> if Option.has_some udecl then user_err Pp.(strbrk "Universe binders must be on the first inductive of the block.") else (((coe,id),b,c,d),e)) rest in udecl, (((coe,id),b,c,d),e) :: rest let finite_of_kind = let open Declarations in function | Inductive_kw -> Finite | CoInductive -> CoFinite | Variant | Record | Structure | Class _ -> BiFinite let private_ind = let open Attributes in let open Notations in attribute_of_list [ "matching" , single_key_parser ~name:"Private (matching) inductive type" ~key:"matching" () ] |> qualify_attribute "private" >>= function | Some () -> return true | None -> return false (** Flag governing use of primitive projections. Disabled by default. *) let { Goptions.get = primitive_flag } = Goptions.declare_bool_option_and_ref ~key:["Primitive";"Projections"] ~value:false () let primitive_proj = let open Attributes in let open Notations in qualify_attribute "projections" (bool_attribute ~name:"primitive") >>= function | Some t -> return t | None -> return (primitive_flag ()) module Preprocessed_Mind_decl = struct type flags = { template : bool option; udecl : Constrexpr.cumul_univ_decl_expr option; cumulative : bool; poly : bool; finite : Declarations.recursivity_kind; } type record = { flags : flags; primitive_proj : bool; kind : Vernacexpr.inductive_kind; records : Record.Ast.t list; } type inductive = { flags : flags; typing_flags : Declarations.typing_flags option; private_ind : bool; uniform : ComInductive.uniform_inductive_flag; inductives : (Vernacexpr.one_inductive_expr * Vernacexpr.notation_declaration list) list; } type t = | Record of record | Inductive of inductive end let preprocess_inductive_decl ~atts kind indl = let udecl, indl = extract_inductive_udecl indl in let is_defclass = match kind, indl with | Class _, [ ( id , bl , c , Constructors [l]), [] ] -> Some (id, bl, c, l) | _ -> None in let finite = finite_of_kind kind in let is_record = function | ((_ , _ , _ , RecordDecl _), _) -> true | _ -> false in let is_constructor = function | ((_ , _ , _ , Constructors _), _) -> true | _ -> false in (* We only allow the #[projections(primitive)] attribute for records. *) let prim_proj_attr : bool Attributes.attribute = if List.for_all is_record indl then primitive_proj else Notations.return false in let (((template, (poly, cumulative)), private_ind), typing_flags), primitive_proj = Attributes.( parse Notations.( template ++ polymorphic_cumulative ~is_defclass:(Option.has_some is_defclass) ++ private_ind ++ typing_flags ++ prim_proj_attr) atts) in if Option.has_some is_defclass then (* Definitional class case *) let (id, bl, c, l) = Option.get is_defclass in let bl = match bl with | bl, None -> bl | _ -> CErrors.user_err Pp.(str "Definitional classes do not support the \"|\" syntax.") in if fst id = AddCoercion then user_err Pp.(str "Definitional classes do not support the \">\" syntax."); let ((attr, rf_coercion, rf_instance), (lid, ce)) = l in let rf_locality = match rf_coercion, rf_instance with | AddCoercion, _ | _, (BackInstance | BackInstanceWarning) -> parse option_locality attr | _ -> let () = unsupported_attributes attr in Goptions.OptDefault in let f = AssumExpr ((make ?loc:lid.loc @@ Name lid.v), [], ce), { rf_coercion ; rf_reversible = None ; rf_instance ; rf_priority = None ; rf_locality ; rf_notation = [] ; rf_canonical = true } in let recordl = [id, bl, c, None, [f], None] in let kind = Class true in let records = vernac_record ~template udecl ~cumulative kind ~poly ?typing_flags ~primitive_proj finite recordl in indl, Preprocessed_Mind_decl.(Record { flags = { template; udecl; cumulative; poly; finite; }; primitive_proj; kind; records }) else if List.for_all is_record indl then (* Mutual record case *) let () = match kind with | Variant -> user_err (str "The Variant keyword does not support syntax { ... }.") | Record | Structure | Class _ | Inductive_kw | CoInductive -> () in let check_where ((_, _, _, _), wh) = match wh with | [] -> () | _ :: _ -> user_err (str "\"where\" clause not supported for records.") in let () = List.iter check_where indl in let parse_record_field_attr (x, f) = let attr = let rev = match f.rfu_coercion with | AddCoercion -> reversible | NoCoercion -> Notations.return None in let loc = match f.rfu_coercion, f.rfu_instance with | AddCoercion, _ | _, (BackInstance | BackInstanceWarning) -> option_locality | _ -> Notations.return Goptions.OptDefault in Notations.(rev ++ loc ++ canonical_field) in let (rf_reversible, rf_locality), rf_canonical = parse attr f.rfu_attrs in x, { rf_coercion = f.rfu_coercion; rf_reversible; rf_instance = f.rfu_instance; rf_priority = f.rfu_priority; rf_locality; rf_notation = f.rfu_notation; rf_canonical } in let unpack ((id, bl, c, decl), _) = match decl with | RecordDecl (oc, fs, ido) -> let bl = match bl with | bl, None -> bl | _ -> CErrors.user_err Pp.(str "Records do not support the \"|\" syntax.") in (id, bl, c, oc, List.map parse_record_field_attr fs, ido) | Constructors _ -> assert false (* ruled out above *) in let kind = match kind with Class _ -> Class false | _ -> kind in let recordl = List.map unpack indl in let records = vernac_record ~template udecl ~cumulative kind ~poly ?typing_flags ~primitive_proj finite recordl in indl, Preprocessed_Mind_decl.(Record { flags = { template; udecl; cumulative; poly; finite; }; primitive_proj; kind; records }) else if List.for_all is_constructor indl then (* Mutual inductive case *) let () = match kind with | (Record | Structure) -> user_err (str "The Record keyword is for types defined using the syntax { ... }.") | Class _ -> user_err (str "Inductive classes not supported.") | Variant | Inductive_kw | CoInductive -> () in let check_name ((na, _, _, _), _) = match na with | (AddCoercion, _) -> user_err (str "Variant types do not handle the \"> Name\" \ syntax, which is reserved for records. Use the \":>\" \ syntax on constructors instead.") | _ -> () in let () = List.iter check_name indl in let unpack (((_, id) , bl, c, decl), ntn) = match decl with | Constructors l -> (id, bl, c, l), ntn | RecordDecl _ -> assert false (* ruled out above *) in let inductives = List.map unpack indl in let uniform = should_treat_as_uniform () in indl, Preprocessed_Mind_decl.(Inductive { flags = { template; udecl; cumulative; poly; finite }; typing_flags; private_ind; uniform; inductives }) else user_err (str "Mixed record-inductive definitions are not allowed.") let dump_inductive indl_for_glob decl = let open Preprocessed_Mind_decl in if Dumpglob.dump () then begin List.iter (fun (((coe,lid), _, _, cstrs), _) -> match cstrs with | Constructors cstrs -> Dumpglob.dump_definition lid false "ind"; List.iter (fun (_, (lid, _)) -> Dumpglob.dump_definition lid false "constr") cstrs | _ -> ()) indl_for_glob; match decl with (* [XXX] EJGA: only [records] used here *) | Record { flags = { template; udecl; cumulative; poly; finite; }; kind; primitive_proj; records } -> let dump_glob_proj (x, _) = match x with | Vernacexpr.(AssumExpr ({loc;v=Name id}, _, _) | DefExpr ({loc;v=Name id}, _, _, _)) -> Dumpglob.dump_definition (make ?loc id) false "proj" | _ -> () in records |> List.iter (fun { Record.Ast.cfs; name } -> let () = Dumpglob.dump_definition name false "rec" in List.iter dump_glob_proj cfs) | Inductive _ -> () end let vernac_inductive ~atts kind indl = let open Preprocessed_Mind_decl in let indl_for_glob, decl = preprocess_inductive_decl ~atts kind indl in dump_inductive indl_for_glob decl; match decl with | Record { flags = { template; udecl; cumulative; poly; finite; }; kind; primitive_proj; records } -> let _ : _ list = Record.definition_structure ~template udecl kind ~cumulative ~poly ~primitive_proj finite records in () | Inductive { flags = { template; udecl; cumulative; poly; finite; }; typing_flags; private_ind; uniform; inductives } -> ComInductive.do_mutual_inductive ~template udecl inductives ~cumulative ~poly ?typing_flags ~private_ind ~uniform finite let preprocess_inductive_decl ~atts kind indl = snd @@ preprocess_inductive_decl ~atts kind indl let vernac_fixpoint_common ~atts l = if Dumpglob.dump () then List.iter (fun { fname } -> Dumpglob.dump_definition fname false "def") l; let scope = atts.DefAttributes.scope in List.iter (fun { fname } -> check_name_freshness scope fname) l; scope let vernac_fixpoint ~atts ~pm l = let open DefAttributes in let scope = vernac_fixpoint_common ~atts l in let poly, typing_flags, program_mode, clearbody, using, user_warns = atts.polymorphic, atts.typing_flags, atts.program, atts.clearbody, atts.using, atts.user_warns in if program_mode then (* XXX: Switch to the attribute system and match on ~atts *) let opens = List.exists (fun { body_def } -> Option.is_empty body_def) l in if opens then CErrors.user_err Pp.(str"Program Fixpoint requires a body.") else let pm = Option.get pm in let pm = ComProgramFixpoint.do_fixpoint ~pm ~scope ?clearbody ~poly ?typing_flags ?user_warns ?using l in Some pm, None else let proof = ComFixpoint.do_fixpoint ~scope ?clearbody ~poly ?typing_flags ?user_warns ?using l in pm, proof let vernac_cofixpoint_common ~atts l = if Dumpglob.dump () then List.iter (fun { fname } -> Dumpglob.dump_definition fname false "def") l; let scope = atts.DefAttributes.scope in List.iter (fun { fname } -> check_name_freshness scope fname) l; scope let vernac_cofixpoint ~atts ~pm l = let open DefAttributes in let scope = vernac_cofixpoint_common ~atts l in let poly, typing_flags, using, clearbody, user_warns = atts.polymorphic, atts.typing_flags, atts.using, atts.clearbody, atts.user_warns in if atts.program then let opens = List.exists (fun { body_def } -> Option.is_empty body_def) l in if opens then CErrors.user_err Pp.(str"Program CoFixpoint requires a body.") else let pm = Option.get pm in let pm = ComProgramFixpoint.do_cofixpoint ~pm ~scope ?clearbody ~poly ?typing_flags ?user_warns ?using l in Some pm, None else let proof = ComFixpoint.do_cofixpoint ~scope ?clearbody ~poly ?typing_flags ?user_warns ?using l in pm, proof let vernac_scheme l = if Dumpglob.dump () then List.iter (fun (lid, sch) -> Option.iter (fun lid -> Dumpglob.dump_definition lid false "def") lid) l; Indschemes.do_scheme (Global.env ()) l let vernac_scheme_equality ?locmap sch id = Indschemes.do_scheme_equality ?locmap sch id (* [XXX] locmap unused here *) let vernac_combined_scheme lid l ~locmap = (* XXX why does this take idents and not qualids *) let l = List.map (fun id -> match qualid_global (qualid_of_ident ?loc:id.loc id.v) with | ConstRef c -> c | _ -> CErrors.user_err ?loc:id.loc Pp.(Pputils.pr_lident id ++ str " is not a constant.")) l in Indschemes.do_combined_scheme lid l let vernac_universe ~poly l = if poly && not (Lib.sections_are_opened ()) then user_err (str"Polymorphic universes can only be declared inside sections, " ++ str "use Monomorphic Universe instead."); DeclareUniv.do_universe ~poly l let vernac_constraint ~poly l = if poly && not (Lib.sections_are_opened ()) then user_err (str"Polymorphic universe constraints can only be declared" ++ str " inside sections, use Monomorphic Constraint instead."); DeclareUniv.do_constraint ~poly l (**********************) (* Modules *) let warn_not_importable = CWarnings.create ~name:"not-importable" Pp.(fun c -> str "Cannot import local constant " ++ Printer.pr_constant (Global.env()) c ++ str ", it will be ignored.") let importable_extended_global_of_path ?loc path = match Nametab.extended_global_of_path path with | Globnames.TrueGlobal (GlobRef.ConstRef c) as ref -> if Declare.is_local_constant c then begin warn_not_importable ?loc c; None end else Some ref | ref -> Some ref (* [XXX] n unused here *) let add_subnames_of ?loc len n ns full_n ref = let open GlobRef in let add1 r ns = (len, Globnames.TrueGlobal r) :: ns in match ref with | Globnames.Abbrev _ | Globnames.TrueGlobal (ConstRef _ | ConstructRef _ | VarRef _) -> CErrors.user_err ?loc Pp.(str "Only inductive types can be used with Import (...).") | Globnames.TrueGlobal (IndRef (mind,i)) -> let open Declarations in let dp = Libnames.dirpath full_n in let mib = Global.lookup_mind mind in let mip = mib.mind_packets.(i) in let ns = add1 (IndRef (mind,i)) ns in let ns = Array.fold_left_i (fun j ns _ -> add1 (ConstructRef ((mind,i),j+1)) ns) ns mip.mind_consnames in List.fold_left (fun ns f -> let s = Indrec.elimination_suffix f in let n_elim = Id.of_string (Id.to_string mip.mind_typename ^ s) in match importable_extended_global_of_path ?loc (Libnames.make_path dp n_elim) with | exception Not_found -> ns | None -> ns | Some ref -> (len, ref) :: ns) ns Sorts.all_families let interp_names m ns = let dp_m = Nametab.dirpath_of_module m in let ns = List.fold_left (fun ns (n,etc) -> let len, full_n = let dp_n,n = repr_qualid n in List.length (DirPath.repr dp_n), make_path (append_dirpath dp_m dp_n) n in let ref = try importable_extended_global_of_path ?loc:n.loc full_n with Not_found -> CErrors.user_err ?loc:n.loc Pp.(str "Cannot find name " ++ pr_qualid n ++ spc() ++ str "in module " ++ pr_qualid (Nametab.shortest_qualid_of_module m) ++ str ".") in (* TODO dumpglob? *) match ref with | Some ref -> let ns = (len,ref) :: ns in if etc then add_subnames_of ?loc:n.loc len n ns full_n ref else ns | None -> ns) [] ns in ns let cache_name (len,n) = let open Globnames in let open GlobRef in match n with | Abbrev kn -> Abbreviation.import_abbreviation (len+1) (Nametab.path_of_abbreviation kn) kn | TrueGlobal (VarRef _) -> assert false | TrueGlobal (ConstRef c) when Declare.is_local_constant c -> (* Can happen through functor application *) warn_not_importable c | TrueGlobal gr -> Nametab.(push (Exactly (len+1)) (path_of_global gr) gr) let cache_names ns = List.iter cache_name ns let subst_names (subst,ns) = List.Smart.map (on_snd (Globnames.subst_extended_reference subst)) ns let inExportNames = Libobject.declare_object (Libobject.global_object "EXPORTNAMES" ~cache:cache_names ~subst:(Some subst_names) ~discharge:(fun x -> Some x)) let import_names ~export m ns = let ns = interp_names m ns in match export with | Lib.Export -> Lib.add_leaf (inExportNames ns) | Lib.Import -> cache_names ns let interp_import_cats cats = Option.cata (fun cats -> Libobject.make_filter ~finite:(not cats.negative) cats.import_cats) Libobject.unfiltered cats (* Assumes cats is irrelevant if f is ImportNames *) let import_module_with_filter ~export cats m f = match f with | ImportAll -> Declaremods.import_module cats ~export m | ImportNames ns -> import_names ~export m ns let check_no_filter_when_using_cats l = List.iter (function | _, ImportAll -> () | q, ImportNames _ -> CErrors.user_err ?loc:q.loc Pp.(str "Cannot combine importing by categories and importing by names.")) l let vernac_import (export, cats) mpl = let import_mod (CAst.{v = mp; loc},f) = try let () = Dumpglob.dump_modref ?loc mp "mod" in let () = if Modops.is_functor (Global.lookup_module mp).Declarations.mod_type then CErrors.user_err ?loc Pp.(str "Cannot import functor " ++ str (ModPath.to_string mp) ++ str".") in import_module_with_filter ~export cats mp f with Not_found -> CErrors.user_err ?loc Pp.(str "Cannot find module " ++ str (ModPath.to_string mp) ++ str ".") in List.iter import_mod mpl let vernac_declare_module export {loc;v=id} binders_ast mty_ast = (* We check the state of the system (in section, in module type) and what module information is supplied *) if Lib.sections_are_opened () then user_err Pp.(str "Modules and Module Types are not allowed inside sections."); let mp = Declaremods.Interp.declare_module id binders_ast (Declaremods.Enforce mty_ast) [] in Dumpglob.dump_moddef ?loc mp "mod"; Flags.if_verbose Feedback.msg_info (str "Module " ++ Id.print id ++ str " is declared"); Option.iter (fun export -> vernac_import export [CAst.make ?loc mp, ImportAll]) export let vernac_define_module export {loc;v=id} binders_ast argsexport mty_ast_o mexpr_ast_l = (* We check the state of the system (in section, in module type) and what module information is supplied *) if Lib.sections_are_opened () then user_err Pp.(str "Modules and Module Types are not allowed inside sections."); match mexpr_ast_l with | [] -> let mp = Declaremods.Interp.start_module export id binders_ast mty_ast_o in Dumpglob.dump_moddef ?loc mp "mod"; Flags.if_verbose Feedback.msg_info (str "Interactive Module " ++ Id.print id ++ str " started"); List.iter (fun (export,mp) -> vernac_import export [CAst.make mp, ImportAll]) argsexport | _::_ -> let mp = Declaremods.Interp.declare_module id binders_ast mty_ast_o mexpr_ast_l in Dumpglob.dump_moddef ?loc mp "mod"; Flags.if_verbose Feedback.msg_info (str "Module " ++ Id.print id ++ str " is defined"); Option.iter (fun export -> vernac_import export [CAst.make ?loc mp, ImportAll]) export let vernac_end_module export {loc;v=id} = let mp = Declaremods.Interp.end_module () in Dumpglob.dump_modref ?loc mp "mod"; Flags.if_verbose Feedback.msg_info (str "Module " ++ Id.print id ++ str " is defined"); Option.iter (fun (export,filter) -> Declaremods.Interp.import_module filter ~export mp) export let vernac_declare_module_type {loc;v=id} binders_ast argsexport mty_sign mty_ast_l = if Lib.sections_are_opened () then user_err Pp.(str "Modules and Module Types are not allowed inside sections."); match mty_ast_l with | [] -> let mp = Declaremods.Interp.start_modtype id binders_ast mty_sign in Dumpglob.dump_moddef ?loc mp "modtype"; Flags.if_verbose Feedback.msg_info (str "Interactive Module Type " ++ Id.print id ++ str " started"); List.iter (fun (export,mp) -> vernac_import export [CAst.make ?loc mp, ImportAll]) argsexport | _ :: _ -> let mp = Declaremods.Interp.declare_modtype id binders_ast mty_sign mty_ast_l in Dumpglob.dump_moddef ?loc mp "modtype"; Flags.if_verbose Feedback.msg_info (str "Module Type " ++ Id.print id ++ str " is defined") let vernac_end_modtype {loc;v=id} = let mp = Declaremods.Interp.end_modtype () in Dumpglob.dump_modref ?loc mp "modtype"; Flags.if_verbose Feedback.msg_info (str "Module Type " ++ Id.print id ++ str " is defined") let vernac_include l = Declaremods.Interp.declare_include l (**********************) (* Gallina extensions *) (* Sections *) let vernac_begin_section ~poly {v=id} = Lib.Interp.open_section id; (* If there was no polymorphism attribute this just sets the option to its current value ie noop. *) set_bool_option_value_gen ~locality:OptLocal ["Universe"; "Polymorphism"] poly let vernac_end_section {CAst.loc; v} = Lib.Interp.close_section () let vernac_name_sec_hyp {v=id} set = Proof_using.name_set id set (* Dispatcher of the "End" command *) let msg_of_subsection ss id = let kind = match ss with | Lib.OpenedModule (false,_,_,_) -> "module" | Lib.OpenedModule (true,_,_,_) -> "module type" | Lib.OpenedSection _ -> "section" | _ -> "unknown" in Pp.str kind ++ spc () ++ Id.print id let vernac_end_segment ~pm ~proof ({v=id} as lid) = let ss = Lib.Interp.find_opening_node id in let what_for = msg_of_subsection ss lid.v in if Option.has_some proof then CErrors.user_err (Pp.str "Command not supported (Open proofs remain)"); Declare.Obls.check_solved_obligations ~pm ~what_for; match ss with | Lib.OpenedModule (false,export,_,_) -> vernac_end_module export lid | Lib.OpenedModule (true,_,_,_) -> vernac_end_modtype lid | Lib.OpenedSection _ -> vernac_end_section lid | _ -> assert false let vernac_end_segment lid = let open Vernactypes in typed_vernac { ignore_state with prog=Pop; proof=ReadOpt; } (fun {proof; prog} -> let () = vernac_end_segment ~pm:prog ~proof lid in no_state) let vernac_begin_segment ~interactive f = let open Vernactypes in let proof = Proof.(if interactive then Reject else Ignore) in let prog = Prog.(if interactive then Push else Ignore) in typed_vernac { ignore_state with prog; proof; } (fun (_:no_state) -> let () = f () in no_state) (* Libraries *) let warn_require_in_section = CWarnings.create ~name:"require-in-section" ~category:CWarnings.CoreCategories.fragile (fun () -> strbrk "Use of “Require” inside a section is fragile." ++ spc() ++ strbrk "It is not recommended to use this functionality in finished proof scripts.") let vernac_require_interp needed modrefl export qidl = if Lib.sections_are_opened () then warn_require_in_section (); let () = match export with | None -> List.iter (function | _, ImportAll -> () | {CAst.loc}, ImportNames _ -> CErrors.user_err ?loc Pp.(str "Used an import filter without importing.")) qidl | Some (_,cats) -> if Option.has_some cats then check_no_filter_when_using_cats qidl in if Dumpglob.dump () then List.iter2 (fun ({CAst.loc},_) dp -> Dumpglob.dump_libref ?loc dp "lib") qidl modrefl; (* Load *) Library.require_library_from_dirpath needed; (* Import*) Option.iter (fun (export,cats) -> let cats = interp_import_cats cats in List.iter2 (fun m (_,f) -> import_module_with_filter ~export cats (MPfile m) f) modrefl qidl) export let vernac_require ~intern from export qidl = let needed, modrefl = Synterp.synterp_require ~intern from export qidl in vernac_require_interp needed modrefl export qidl (* Coercions and canonical structures *) let vernac_canonical ~local r = Canonical.declare_canonical_structure ?local (smart_global r) let vernac_coercion ~atts ref qidst = let ref' = smart_global ref in match qidst with | Some (qids, qidt) -> let local, reversible = Attributes.parse Notations.(locality ++ reversible) atts in let local = enforce_locality local in let reversible = Option.default false reversible in let target = cl_of_qualid qidt in let source = cl_of_qualid qids in ComCoercion.try_add_new_coercion_with_target ref' ~local ~reversible ~source ~target; Flags.if_verbose Feedback.msg_info (pr_global ref' ++ str " is now a coercion") | None -> match Attributes.parse reversible atts with | None -> user_err (str "Expected `: Sourceclass >-> Targetclass`.") | Some reversible -> ComCoercion.change_reverse ref' ~reversible let vernac_identity_coercion ~atts id qids qidt = let local, poly = Attributes.(parse Notations.(locality ++ polymorphic) atts) in let local = enforce_locality local in let target = cl_of_qualid qidt in let source = cl_of_qualid qids in ComCoercion.try_add_new_identity_coercion id ~local ~poly ~source ~target (* Type classes *) let vernac_instance_program ~atts ~pm name bl t props info = Dumpglob.dump_constraint (fst name) false "inst"; let locality, poly = Attributes.(parse (Notations.(hint_locality ++ polymorphic))) atts in let pm, _id = Classes.new_instance_program ~pm ~locality ~poly name bl t props info in pm let vernac_instance_interactive ~atts name bl t info props = Dumpglob.dump_constraint (fst name) false "inst"; let locality, poly = Attributes.(parse (Notations.(hint_locality ++ polymorphic))) atts in let _id, pstate = Classes.new_instance_interactive ~locality ~poly name bl t info props in pstate let vernac_instance ~atts name bl t props info = Dumpglob.dump_constraint (fst name) false "inst"; let locality, poly = Attributes.(parse (Notations.(hint_locality ++ polymorphic))) atts in let _id : Id.t = Classes.new_instance ~locality ~poly name bl t props info in () let vernac_declare_instance ~atts id bl inst pri = Dumpglob.dump_definition (fst id) false "inst"; let (program, locality), poly = Attributes.(parse (Notations.(program ++ hint_locality ++ polymorphic))) atts in Classes.declare_new_instance ~program_mode:program ~locality ~poly id bl inst pri let vernac_context ~atts ctx = let program_mode, poly = Attributes.(parse (Notations.(program ++ polymorphic))) atts in ComAssumption.do_context ~program_mode ~poly ctx let vernac_existing_instance ~atts insts = let locality = Attributes.parse hint_locality atts in List.iter (fun (id, info) -> let g = qualid_global id in Classes.existing_instance ?loc:id.loc locality g (Some info)) insts let vernac_existing_class id = Record.declare_existing_class (qualid_global id) (***********) (* Solving *) let command_focus = Proof.new_focus_kind "command_focus" let focus_command_cond = Proof.no_cond command_focus let vernac_set_end_tac pstate tac = let env = Genintern.empty_glob_sign ~strict:true (Global.env ()) in let _, tac = Genintern.generic_intern env tac in (* TO DO verifier s'il faut pas mettre exist s | TacId s ici*) Declare.Proof.set_endline_tactic tac pstate (************) (* Commands *) let vernac_create_hintdb ~module_local id b = Hints.create_hint_db module_local id TransparentState.full b let warn_implicit_core_hint_db = CWarnings.create ~name:"implicit-core-hint-db" ~category:Deprecation.Version.v8_10 (fun () -> strbrk "Adding and removing hints in the core database implicitly is deprecated. " ++ strbrk"Please specify a hint database.") let vernac_remove_hints ~atts dbnames ids = let locality = Attributes.(parse hint_locality atts) in let dbnames = if List.is_empty dbnames then (warn_implicit_core_hint_db (); ["core"]) else dbnames in Hints.remove_hints ~locality dbnames (List.map Smartlocate.global_with_alias ids) let vernac_hints ~atts dbnames h = let dbnames = if List.is_empty dbnames then (warn_implicit_core_hint_db (); ["core"]) else dbnames in let locality, poly = Attributes.(parse Notations.(hint_locality ++ polymorphic) atts) in Hints.add_hints ~locality dbnames (ComHints.interp_hints ~poly h) let vernac_abbreviation ~atts lid x only_parsing = let module_local, user_warns = Attributes.(parse Notations.(module_locality ++ user_warns) atts) in Dumpglob.dump_definition lid false "abbrev"; Metasyntax.add_abbreviation ~local:module_local user_warns (Global.env()) lid.v x only_parsing let default_env () = { Notation_term.ninterp_var_type = Id.Map.empty; ninterp_rec_vars = Id.Map.empty; } let vernac_reserve bl = let sb_decl = (fun (idl,c) -> let env = Global.env() in let sigma = Evd.from_env env in let t,ctx = Constrintern.interp_type env sigma c in let t = Flags.without_option Detyping.print_universes (fun () -> Detyping.detype Detyping.Now Id.Set.empty env (Evd.from_ctx ctx) t) () in let t,_ = Notation_ops.notation_constr_of_glob_constr (default_env ()) t in Reserve.declare_reserved_type idl t) in List.iter sb_decl bl let vernac_generalizable ~local = let local = Option.default true local in Implicit_quantifiers.declare_generalizable ~local let allow_sprop_opt_name = ["Allow";"StrictProp"] let () = declare_bool_option { optstage = Summary.Stage.Interp; optdepr = None; optkey = allow_sprop_opt_name; optread = (fun () -> Global.sprop_allowed()); optwrite = Global.set_allow_sprop } let () = declare_bool_option { optstage = Summary.Stage.Interp; optdepr = None; optkey = ["Silent"]; optread = (fun () -> !Flags.quiet); optwrite = ((:=) Flags.quiet) } let () = declare_bool_option { optstage = Summary.Stage.Interp; optdepr = None; optkey = ["Implicit";"Arguments"]; optread = Impargs.is_implicit_args; optwrite = Impargs.make_implicit_args } let () = declare_bool_option { optstage = Summary.Stage.Interp; optdepr = None; optkey = ["Strict";"Implicit"]; optread = Impargs.is_strict_implicit_args; optwrite = Impargs.make_strict_implicit_args } let () = declare_bool_option { optstage = Summary.Stage.Interp; optdepr = None; optkey = ["Strongly";"Strict";"Implicit"]; optread = Impargs.is_strongly_strict_implicit_args; optwrite = Impargs.make_strongly_strict_implicit_args } let () = declare_bool_option { optstage = Summary.Stage.Interp; optdepr = None; optkey = ["Contextual";"Implicit"]; optread = Impargs.is_contextual_implicit_args; optwrite = Impargs.make_contextual_implicit_args } let () = declare_bool_option { optstage = Summary.Stage.Interp; optdepr = None; optkey = ["Reversible";"Pattern";"Implicit"]; optread = Impargs.is_reversible_pattern_implicit_args; optwrite = Impargs.make_reversible_pattern_implicit_args } let () = declare_bool_option { optstage = Summary.Stage.Interp; optdepr = None; optkey = ["Maximal";"Implicit";"Insertion"]; optread = Impargs.is_maximal_implicit_args; optwrite = Impargs.make_maximal_implicit_args } let () = declare_bool_option { optstage = Summary.Stage.Interp; optdepr = None; optkey = ["Printing";"Coercions"]; optread = (fun () -> !Constrextern.print_coercions); optwrite = (fun b -> Constrextern.print_coercions := b) } let () = declare_bool_option { optstage = Summary.Stage.Interp; optdepr = None; optkey = ["Printing";"Parentheses"]; optread = (fun () -> !Constrextern.print_parentheses); optwrite = (fun b -> Constrextern.print_parentheses := b) } let () = declare_bool_option { optstage = Summary.Stage.Interp; optdepr = None; optkey = ["Printing";"Implicit"]; optread = (fun () -> !Constrextern.print_implicits); optwrite = (fun b -> Constrextern.print_implicits := b) } let () = declare_bool_option { optstage = Summary.Stage.Interp; optdepr = None; optkey = ["Printing";"Implicit";"Defensive"]; optread = (fun () -> !Constrextern.print_implicits_defensive); optwrite = (fun b -> Constrextern.print_implicits_defensive := b) } let () = declare_bool_option { optstage = Summary.Stage.Interp; optdepr = None; optkey = ["Printing";"Projections"]; optread = (fun () -> !Constrextern.print_projections); optwrite = (fun b -> Constrextern.print_projections := b) } let () = declare_bool_option { optstage = Summary.Stage.Interp; optdepr = None; optkey = ["Printing";"Notations"]; optread = (fun () -> not !Constrextern.print_no_symbol); optwrite = (fun b -> Constrextern.print_no_symbol := not b) } let () = declare_bool_option { optstage = Summary.Stage.Interp; optdepr = None; optkey = ["Printing";"Raw";"Literals"]; optread = (fun () -> !Constrextern.print_raw_literal); optwrite = (fun b -> Constrextern.print_raw_literal := b) } let () = declare_bool_option { optstage = Summary.Stage.Interp; optdepr = None; optkey = ["Printing";"All"]; optread = (fun () -> !Flags.raw_print); optwrite = (fun b -> Flags.raw_print := b) } let () = declare_int_option { optstage = Summary.Stage.Interp; optdepr = None; optkey = ["Inline";"Level"]; optread = (fun () -> Some (Flags.get_inline_level ())); optwrite = (fun o -> let lev = Option.default Flags.default_inline_level o in Flags.set_inline_level lev) } let () = declare_bool_option { optstage = Summary.Stage.Interp; optdepr = None; optkey = ["Kernel"; "Term"; "Sharing"]; optread = (fun () -> (Global.typing_flags ()).Declarations.share_reduction); optwrite = Global.set_share_reduction } let () = declare_bool_option { optstage = Summary.Stage.Interp; optdepr = None; optkey = ["Printing";"Compact";"Contexts"]; optread = (fun () -> Printer.get_compact_context()); optwrite = (fun b -> Printer.set_compact_context b) } let () = declare_int_option { optstage = Summary.Stage.Interp; optdepr = None; optkey = ["Printing";"Depth"]; optread = Topfmt.get_depth_boxes; optwrite = Topfmt.set_depth_boxes } let () = declare_int_option { optstage = Summary.Stage.Interp; optdepr = None; optkey = ["Printing";"Width"]; optread = Topfmt.get_margin; optwrite = Topfmt.set_margin } let () = declare_bool_option { optstage = Summary.Stage.Interp; optdepr = None; optkey = ["Printing";"Universes"]; optread = (fun () -> !Constrextern.print_universes); optwrite = (fun b -> Constrextern.print_universes:=b) } let () = declare_bool_option { optstage = Summary.Stage.Interp; optdepr = None; optkey = ["Dump";"Bytecode"]; optread = (fun () -> !Vmbytegen.dump_bytecode); optwrite = (:=) Vmbytegen.dump_bytecode } let () = declare_bool_option { optstage = Summary.Stage.Interp; optdepr = None; optkey = ["Dump";"Lambda"]; optread = (fun () -> !Vmlambda.dump_lambda); optwrite = (:=) Vmlambda.dump_lambda } let () = declare_bool_option { optstage = Summary.Stage.Interp; optdepr = None; optkey = ["Parsing";"Explicit"]; optread = (fun () -> !Constrintern.parsing_explicit); optwrite = (fun b -> Constrintern.parsing_explicit := b) } let () = let preprocess flags = CWarnings.check_unknown_warnings flags; CWarnings.normalize_flags_string flags in declare_string_option ~preprocess { optstage = Summary.Stage.Interp; optdepr = None; optkey = ["Warnings"]; optread = CWarnings.get_flags; optwrite = CWarnings.set_flags } let () = declare_string_option { optstage = Summary.Stage.Interp; optdepr = None; optkey = ["Debug"]; optread = CDebug.get_flags; optwrite = CDebug.set_flags } let () = declare_bool_option { optstage = Summary.Stage.Interp; optdepr = None; optkey = ["Guard"; "Checking"]; optread = (fun () -> (Global.typing_flags ()).Declarations.check_guarded); optwrite = (fun b -> Global.set_check_guarded b) } let () = declare_bool_option { optstage = Summary.Stage.Interp; optdepr = None; optkey = ["Positivity"; "Checking"]; optread = (fun () -> (Global.typing_flags ()).Declarations.check_positive); optwrite = (fun b -> Global.set_check_positive b) } let () = declare_bool_option { optstage = Summary.Stage.Interp; optdepr = None; optkey = ["Universe"; "Checking"]; optread = (fun () -> (Global.typing_flags ()).Declarations.check_universes); optwrite = (fun b -> Global.set_check_universes b) } let () = declare_bool_option { optstage = Summary.Stage.Interp; optdepr = None; optkey = ["Definitional"; "UIP"]; optread = (fun () -> (Global.typing_flags ()).Declarations.allow_uip); optwrite = (fun b -> Global.set_typing_flags {(Global.typing_flags ()) with Declarations.allow_uip = b}) } let vernac_set_strategy ~local l = let local = Option.default false local in let glob_ref r = match smart_global r with | GlobRef.ConstRef sp -> begin match Structures.PrimitiveProjections.find_opt sp with | None -> Evaluable.EvalConstRef sp | Some p -> Evaluable.EvalProjectionRef p end | GlobRef.VarRef id -> Evaluable.EvalVarRef id | _ -> user_err Pp.(str "Cannot set an inductive type or a constructor as transparent.") in let l = List.map (fun (lev,ql) -> (lev,List.map glob_ref ql)) l in Redexpr.set_strategy local l let vernac_set_opacity ~on_proj_constant ~local (v,l) = let local = Option.default true local in let glob_ref r = match smart_global r with | GlobRef.ConstRef sp -> begin match Structures.PrimitiveProjections.find_opt sp with | None when on_proj_constant -> user_err Pp.(str "Only compatibility constant opacity can be set this way.") | None -> Evaluable.EvalConstRef sp | Some _ when on_proj_constant -> Evaluable.EvalConstRef sp | Some p -> Evaluable.EvalProjectionRef p end | GlobRef.VarRef id -> Evaluable.EvalVarRef id | _ -> user_err Pp.(str "Cannot set an inductive type or a constructor as transparent.") in let l = List.map glob_ref l in Redexpr.set_strategy local [v,l] let get_current_context_of_args ~pstate = match pstate with | None -> fun _ -> let env = Global.env () in Evd.(from_env env, env) | Some lemma -> function | Some n -> Declare.Proof.get_goal_context lemma n | None -> Declare.Proof.get_current_context lemma let query_command_selector ?loc = function | None -> None | Some (Goal_select.SelectNth n) -> Some n | _ -> user_err ?loc (str "Query commands only support the single numbered goal selector.") let check_may_eval env sigma redexp rc = let gc = Constrintern.intern_unknown_if_term_or_type env sigma rc in let sigma, c = Pretyping.understand_tcc env sigma gc in let sigma = Evarconv.solve_unif_constraints_with_heuristics env sigma in Evarconv.check_problems_are_solved env sigma; let sigma = Evd.minimize_universes sigma in let uctx = Evd.universe_context_set sigma in let env = Environ.push_context_set uctx (Evarutil.nf_env_evar sigma env) in let { Environ.uj_val=c; uj_type=ty; } = if Evarutil.has_undefined_evars sigma c || List.exists (Context.Named.Declaration.exists (Evarutil.has_undefined_evars sigma)) (EConstr.named_context env) then Evarutil.j_nf_evar sigma (Retyping.get_judgment_of env sigma c) else let c = EConstr.to_constr sigma c in (* OK to call kernel which does not support evars *) Environ.on_judgment EConstr.of_constr (Arguments_renaming.rename_typing env c) in let sigma, c = match redexp with | None -> sigma, c | Some r -> let sigma, r = Redexpr.interp_redexp_no_ltac env sigma r in let r, _ = Redexpr.reduction_of_red_expr env r in let sigma, c = r env sigma c in sigma, c in let pp = let evars_of_term c = Evarutil.undefined_evars_of_term sigma c in let l = Evar.Set.union (evars_of_term c) (evars_of_term ty) in let j = { Environ.uj_val = c; uj_type = Reductionops.nf_betaiota env sigma ty } in Prettyp.print_judgment env sigma j ++ pr_ne_evar_set (fnl () ++ str "where" ++ fnl ()) (mt ()) sigma l in let hdr = if Option.has_some redexp then str " = " else mt() in hdr ++ pp ++ Printer.pr_universe_ctx_set sigma uctx let vernac_check_may_eval ~pstate redexp glopt rc = let glopt = query_command_selector glopt in let sigma, env = get_current_context_of_args ~pstate glopt in check_may_eval env sigma redexp rc let vernac_declare_reduction ~local s r = let local = Option.default false local in let env = Global.env () in let sigma = Evd.from_env env in Redexpr.declare_red_expr local s (snd (Redexpr.interp_redexp_no_ltac env sigma r)) (* The same but avoiding the current goal context if any *) let vernac_global_check c = let env = Global.env() in let sigma = Evd.from_env env in let c = Constrintern.intern_constr env sigma c in let sigma, c = Pretyping.understand_tcc ~flags:Pretyping.all_and_fail_flags env sigma c in let sigma = Evd.collapse_sort_variables sigma in let senv = Global.safe_env() in let uctx = Evd.universe_context_set sigma in let senv = Safe_typing.push_context_set ~strict:false uctx senv in let c = EConstr.to_constr sigma c in let j = Safe_typing.typing senv c in Prettyp.print_safe_judgment j ++ pr_universe_ctx_set sigma uctx (* Printing "About" information of a hypothesis of the current goal. We only print the type and a small statement to this comes from the goal. Precondition: there must be at least one current goal. *) let print_about_hyp_globs ~pstate ?loc ref_or_by_not udecl glopt = let exception NoHyp in let open Context.Named.Declaration in try (* Fallback early to globals *) let pstate = match pstate with | None -> raise Not_found | Some pstate -> pstate in (* FIXME error on non None udecl if we find the hyp. *) let glnumopt = query_command_selector ?loc glopt in let pf = Declare.Proof.get pstate in let Proof.{goals; sigma} = Proof.data pf in let ev, id = let open Constrexpr in match glnumopt, ref_or_by_not.v with | None,AN qid when qualid_is_ident qid -> (* goal number not given, catch any failure *) (match List.nth_opt goals 0 with | None -> raise NoHyp | Some goal -> goal), qualid_basename qid | Some n,AN qid when qualid_is_ident qid -> (* goal number given, catch if wong *) (match List.nth_opt goals (n - 1) with | None -> user_err ?loc (str "No such goal: " ++ int n ++ str ".") | Some goal -> goal), qualid_basename qid | _ , _ -> raise NoHyp in let hyps = Evd.evar_filtered_context (Evd.find_undefined sigma ev) in let decl = Context.Named.lookup id hyps in let natureofid = match decl with | LocalAssum _ -> "Hypothesis" | LocalDef (_,bdy,_) ->"Constant (let in)" in let sigma, env = Declare.Proof.get_current_context pstate in v 0 (Id.print id ++ str":" ++ pr_econstr_env env sigma (NamedDecl.get_type decl) ++ fnl() ++ fnl() ++ str natureofid ++ str " of the goal context.") with (* fallback to globals *) | NoHyp | Not_found -> let sigma, env = get_current_or_global_context ~pstate in Prettyp.print_about env sigma ref_or_by_not udecl let vernac_print = let no_state f = Vernactypes.(typed_vernac_gen ignore_state (fun _ -> no_state, f ())) in let with_pstate f = let f {Vernactypes.proof} = Vernactypes.no_state, f ~pstate:proof in Vernactypes.(typed_vernac_gen { ignore_state with proof = ReadOpt } f) in let with_proof_env f = with_pstate (fun ~pstate -> let sigma, env = get_current_or_global_context ~pstate in f env sigma) in let with_proof_env_and_opaques f = let open Vernactypes in let f {proof; opaque_access} = let sigma, env = get_current_or_global_context ~pstate:proof in no_state, f ~opaque_access env sigma in typed_vernac_gen { ignore_state with proof = ReadOpt; opaque_access = Access } f in function | PrintTypingFlags -> with_proof_env @@ fun env _sigma -> pr_typing_flags (Environ.typing_flags env) | PrintTables -> no_state print_tables | PrintFullContext -> with_proof_env Prettyp.print_full_context_typ | PrintSectionContext qid -> with_proof_env @@ fun env sigma -> Prettyp.print_sec_context_typ env sigma qid | PrintInspect n -> with_proof_env @@ fun env sigma -> Prettyp.inspect env sigma n | PrintGrammar ent -> no_state @@ fun () -> Metasyntax.pr_grammar ent | PrintCustomGrammar ent -> no_state @@ fun () -> Metasyntax.pr_custom_grammar ent | PrintKeywords -> no_state Metasyntax.pr_keywords | PrintLoadPath dir -> (* For compatibility ? *) no_state @@ fun () -> print_loadpath dir | PrintLibraries -> no_state print_libraries | PrintModule qid -> no_state @@ fun () -> print_module qid | PrintModuleType qid -> no_state @@ fun () -> print_modtype qid | PrintNamespace ns -> with_pstate @@ print_namespace ns | PrintMLLoadPath -> no_state Mltop.print_ml_path | PrintMLModules -> no_state Mltop.print_ml_modules | PrintDebugGC -> no_state Mltop.print_gc | PrintName (qid,udecl) -> with_proof_env_and_opaques @@ fun ~opaque_access env sigma -> Prettyp.print_name opaque_access env sigma qid udecl | PrintGraph -> no_state Prettyp.print_graph | PrintClasses -> no_state Prettyp.print_classes | PrintTypeclasses -> no_state Prettyp.print_typeclasses | PrintInstances c -> no_state @@ fun () -> Prettyp.print_instances (smart_global c) | PrintCoercions -> no_state Prettyp.print_coercions | PrintNotation (entry, ntnstr) -> with_proof_env @@ fun env sigma -> Prettyp.print_notation env sigma entry ntnstr | PrintCoercionPaths (cls,clt) -> no_state @@ fun () -> Prettyp.print_coercion_paths (cl_of_qualid cls) (cl_of_qualid clt) | PrintCanonicalConversions qids -> with_proof_env @@ fun env sigma -> let grefs = List.map Smartlocate.smart_global qids in Prettyp.print_canonical_projections env sigma grefs | PrintUniverses (sort, subgraph, dst) -> no_state @@ fun ()-> print_universes ~sort ~subgraph dst | PrintHint r -> with_proof_env @@ fun env sigma -> Hints.pr_hint_ref env sigma (smart_global r) | PrintHintGoal -> with_pstate @@ fun ~pstate -> begin match pstate with | Some pstate -> let pf = Declare.Proof.get pstate in Hints.pr_applicable_hint pf | None -> str "No proof in progress" end | PrintHintDbName s -> with_proof_env @@ fun env sigma -> Hints.pr_hint_db_by_name env sigma s | PrintHintDb -> with_proof_env @@ fun env sigma -> Hints.pr_searchtable env sigma | PrintScopes -> with_proof_env @@ fun env sigma -> Notation.pr_scopes (Constrextern.without_symbols (pr_glob_constr_env env sigma)) | PrintScope s -> with_proof_env @@ fun env sigma -> Notation.pr_scope (Constrextern.without_symbols (pr_glob_constr_env env sigma)) s | PrintVisibility s -> with_proof_env @@ fun env sigma -> Notation.pr_visibility (Constrextern.without_symbols (pr_glob_constr_env env sigma)) s | PrintAbout (ref_or_by_not,udecl,glnumopt) -> with_pstate @@ print_about_hyp_globs ref_or_by_not udecl glnumopt | PrintImplicit qid -> with_proof_env @@ fun env _sigma -> Prettyp.print_impargs env (smart_global qid) | PrintAssumptions (o,t,r) -> with_proof_env_and_opaques @@ fun ~opaque_access env sigma -> (* Prints all the axioms and section variables used by a term *) let gr = smart_global r in let cstr, _ = UnivGen.fresh_global_instance env gr in let st = Conv_oracle.get_transp_state (Environ.oracle env) in let nassums = Assumptions.assumptions opaque_access st ~add_opaque:o ~add_transparent:t gr cstr in Printer.pr_assumptionset env sigma nassums | PrintStrategy r -> no_state @@ fun () -> print_strategy r | PrintRegistered -> no_state print_registered | PrintRegisteredSchemes -> no_state print_registered_schemes let vernac_search ~pstate ~atts s gopt r = let open ComSearch in let gopt = query_command_selector gopt in let sigma, env = match gopt with (* 1st goal by default if it exists, otherwise no goal at all *) | None -> begin try get_goal_or_global_context ~pstate 1 with Proof.NoSuchGoal _ -> let env = Global.env () in Evd.from_env env, env end (* if goal selector is given and wrong, then let exceptions be raised. *) | Some g -> get_goal_or_global_context ~pstate g in interp_search env sigma s r let vernac_locate ~pstate query = let open Constrexpr in let sigma, env = get_current_or_global_context ~pstate in match query with | LocateAny {v=AN qid} -> Prettyp.print_located_qualid env qid | LocateTerm {v=AN qid} -> Prettyp.print_located_term env qid | LocateAny {v=ByNotation (ntn, sc)} (* TODO : handle Ltac notations *) | LocateTerm {v=ByNotation (ntn, sc)} -> Notation.locate_notation (Constrextern.without_symbols (pr_glob_constr_env env sigma)) ntn sc | LocateLibrary qid -> print_located_library qid | LocateModule qid -> Prettyp.print_located_module env qid | LocateOther (s, qid) -> Prettyp.print_located_other env s qid | LocateFile f -> locate_file f let warn_unknown_scheme_kind = CWarnings.create ~name:"unknown-scheme-kind" Pp.(fun sk -> str "Unknown scheme kind " ++ Libnames.pr_qualid sk ++ str ".") let vernac_register qid r = let gr = Smartlocate.global_with_alias qid in match r with | RegisterInline -> begin match gr with | GlobRef.ConstRef c -> Global.register_inline c | _ -> CErrors.user_err ?loc:qid.loc (Pp.str "Register Inline: expecting a constant.") end | RegisterCoqlib n -> let ns, id = Libnames.repr_qualid n in if DirPath.equal (dirpath_of_string "kernel") ns then begin if Lib.sections_are_opened () then user_err Pp.(str "Registering a kernel type is not allowed in sections."); let CPrimitives.PIE pind = match Id.to_string id with | "ind_bool" -> CPrimitives.(PIE PIT_bool) | "ind_carry" -> CPrimitives.(PIE PIT_carry) | "ind_pair" -> CPrimitives.(PIE PIT_pair) | "ind_cmp" -> CPrimitives.(PIE PIT_cmp) | "ind_f_cmp" -> CPrimitives.(PIE PIT_f_cmp) | "ind_f_class" -> CPrimitives.(PIE PIT_f_class) | k -> CErrors.user_err ?loc:n.loc Pp.(str "Register: unknown identifier “" ++ str k ++ str "” in the \"kernel\" namespace.") in match gr with | GlobRef.IndRef ind -> Global.register_inductive ind pind | _ -> CErrors.user_err ?loc:qid.loc (Pp.str "Register in kernel: expecting an inductive type.") end else Coqlib.register_ref (Libnames.string_of_qualid n) gr | RegisterScheme { inductive; scheme_kind } -> let gr = match gr with | ConstRef c -> c | _ -> CErrors.user_err ?loc:qid.loc Pp.(str "Register Scheme: expecing a constant.") in let scheme_kind_s = Libnames.string_of_qualid scheme_kind in let () = if not (Ind_tables.is_declared_scheme_object scheme_kind_s) then warn_unknown_scheme_kind ?loc:scheme_kind.loc scheme_kind in let ind = Smartlocate.global_inductive_with_alias inductive in Dumpglob.add_glob ?loc:inductive.loc (IndRef ind); DeclareScheme.declare_scheme scheme_kind_s (ind,gr) let vernac_library_attributes atts = if Global.is_curmod_library () && not (Lib.sections_are_opened ()) then let user_warns = Attributes.parse user_warns atts in let user_warns = Option.default UserWarn.empty user_warns in Lib.Synterp.declare_info user_warns else user_err (Pp.str "A library attribute should be at toplevel of the library.") (********************) (* Proof management *) let vernac_focus ~pstate gln = Declare.Proof.map ~f:(fun p -> match gln with | None -> Proof.focus focus_command_cond () 1 p | Some 0 -> user_err Pp.(str "Invalid goal number: 0. Goal numbering starts with 1.") | Some n -> Proof.focus focus_command_cond () n p) pstate (* Unfocuses one step in the focus stack. *) let vernac_unfocus ~pstate = Declare.Proof.map ~f:(fun p -> Proof.unfocus command_focus p ()) pstate (* Checks that a proof is fully unfocused. Raises an error if not. *) let vernac_unfocused ~pstate = let p = Declare.Proof.get pstate in if Proof.unfocused p then str"The proof is indeed fully unfocused." else user_err Pp.(str "The proof is not fully unfocused.") (* "{" focuses on the first goal, "n: {" focuses on the n-th goal "}" unfocuses, provided that the proof of the goal has been completed. *) let subproof_kind = Proof.new_focus_kind "subproof" let subproof_cond = Proof.done_cond subproof_kind let vernac_subproof gln ~pstate = Declare.Proof.map ~f:(fun p -> match gln with | None -> Proof.focus subproof_cond () 1 p | Some (Goal_select.SelectNth n) -> Proof.focus subproof_cond () n p | Some (Goal_select.SelectId id) -> Proof.focus_id subproof_cond () id p | _ -> user_err (str "Brackets do not support multi-goal selectors.")) pstate let vernac_end_subproof ~pstate = Declare.Proof.map ~f:(fun p -> Proof.unfocus subproof_kind p ()) pstate let vernac_bullet (bullet : Proof_bullet.t) ~pstate = Declare.Proof.map ~f:(fun p -> Proof_bullet.put p bullet) pstate (* Stack is needed due to show proof names, should deprecate / remove and take pstate *) let vernac_show ~pstate = match pstate with (* Show functions that don't require a proof state *) | None -> begin function | ShowProof -> show_proof ~pstate:None | ShowMatch id -> show_match id | _ -> user_err (str "This command requires an open proof.") end (* Show functions that require a proof state *) | Some pstate -> let proof = Declare.Proof.get pstate in begin function | ShowGoal goalref -> begin match goalref with | OpenSubgoals -> pr_open_subgoals proof | NthGoal n -> pr_nth_open_subgoal ~proof n | GoalId id -> pr_goal_by_id ~proof id end | ShowExistentials -> show_top_evars ~proof | ShowUniverses -> show_universes ~proof (* Deprecate *) | ShowProofNames -> Id.print (Declare.Proof.get_name pstate) | ShowIntros all -> show_intro ~proof all | ShowProof -> show_proof ~pstate:(Some pstate) | ShowMatch id -> show_match id end let vernac_check_guard ~pstate = let pts = Declare.Proof.get pstate in let pfterm = List.hd (Proof.partial_proof pts) in let { Proof.entry; Proof.sigma } = Proof.data pts in let hyps, _, _ = List.hd (Proofview.initial_goals entry) in let env = Environ.reset_with_named_context hyps (Global.env ()) in Inductiveops.control_only_guard env sigma pfterm; str "The condition holds up to here." let vernac_validate_proof ~pstate = let pts = Declare.Proof.get pstate in let { Proof.entry; Proof.sigma } = Proof.data pts in let hyps, pfterm, pftyp = List.hd (Proofview.initial_goals entry) in (* XXX can the initial hyps contain something broken? For now assume they're correct. NB: in the "Lemma foo args : bla." case the args are part of the term and intro'd after the proof is opened. Only the section variables are in the hyps. *) let env = Environ.reset_with_named_context hyps (Global.env ()) in let sigma = Evarconv.solve_unif_constraints_with_heuristics env sigma in let sigma' = Typing.check env sigma pfterm pftyp in let evar_issues = (* Use Evar.Map.merge as a kind of for_all2 *) Evar.Map.merge (fun e orig now -> match orig, now with | None, None -> assert false | Some _, Some _ -> None (* assume same *) | Some evi, None -> let EvarInfo evi' = Evd.find sigma' e in let body = match Evd.evar_body evi' with | Evar_empty -> assert false | Evar_defined body -> body in Some Pp.(str "Evar " ++ Printer.pr_evar sigma (e, evi) ++ spc() ++ str "was inferred by unification to be" ++ spc() ++ pr_econstr_env (Evd.evar_env env evi') sigma' body) | None, Some _ -> (* ignore new evar *) assert (not (Evd.is_defined sigma e)); None ) (Evd.undefined_map sigma) (Evd.undefined_map sigma') in (* TODO check ustate *) if Evar.Map.is_empty evar_issues then str "No issues found." else prlist_with_sep fnl snd (Evar.Map.bindings evar_issues) let vernac_proof pstate tac using = let is_let = match Declare.Proof.definition_scope pstate with | Discharge -> true | Global _ -> false in let using = if not is_let then Option.append using (Proof_using.get_default_proof_using ()) else let () = if Option.has_some using then CErrors.user_err Pp.(str "Let does not support Proof using.") in None in let tacs = if Option.is_empty tac then "tac:no" else "tac:yes" in let usings = if Option.is_empty using then "using:no" else "using:yes" in Aux_file.record_in_aux_at "VernacProof" (tacs^" "^usings); let pstate = Option.fold_left vernac_set_end_tac pstate tac in let set_proof_using ps using = Declare.Proof.set_proof_using ps using |> snd in let pstate = Option.fold_left set_proof_using pstate using in pstate let translate_vernac_synterp ?loc ~atts v = let open Vernactypes in match v with | EVernacNotation { local; decl } -> vtdefault(fun () -> Metasyntax.add_notation_interpretation ~local (Global.env()) decl) | EVernacDefineModule (export,lid,bl,argsexport,mtys,mexprl) -> let i () = unsupported_attributes atts; vernac_define_module export lid bl argsexport mtys mexprl in (* XXX: We should investigate if eventually this should be made VtNoProof in all cases. *) vernac_begin_segment ~interactive:(List.is_empty mexprl) i | EVernacDeclareModuleType (lid,bl,argsexport,mtys,exprl) -> vernac_begin_segment ~interactive:(List.is_empty exprl) (fun () -> unsupported_attributes atts; vernac_declare_module_type lid bl argsexport mtys exprl) (* Modules *) | EVernacDeclareModule (export,lid,bl,mty) -> vtdefault(fun () -> unsupported_attributes atts; vernac_declare_module export lid bl mty) | EVernacInclude in_asts -> vtdefault(fun () -> unsupported_attributes atts; vernac_include in_asts) (* Gallina extensions *) | EVernacBeginSection lid -> vernac_begin_segment ~interactive:true (fun () -> vernac_begin_section ~poly:(only_polymorphism atts) lid) | EVernacEndSegment lid -> unsupported_attributes atts; vernac_end_segment lid | EVernacRequire (needed, modrefl, export, qidl) -> vtdefault(fun () -> unsupported_attributes atts; vernac_require_interp needed modrefl export qidl) | EVernacImport (export,mpl) -> vtdefault(fun () -> unsupported_attributes atts; vernac_import export mpl) | EVernacSetOption { export; key; value } -> vtdefault(fun () -> let atts = if export then CAst.make ?loc ("export", VernacFlagEmpty) :: atts else atts in Vernacoptions.vernac_set_option ~locality:(parse option_locality atts) ~stage:Summary.Stage.Interp key value) | EVernacNoop -> vtdefault(fun () -> ()) | EVernacLoad _ -> anomaly (str "type_vernac") (* Extensions *) | EVernacExtend f -> f let translate_pure_vernac ?loc ~atts v = let open Vernactypes in match v with | VernacAbortAll | VernacRestart | VernacUndo _ | VernacUndoTo _ | VernacResetName _ | VernacResetInitial | VernacBack _ -> anomaly (str "type_vernac") (* Syntax *) | VernacDeclareScope sc -> vtdefault(fun () -> with_module_locality ~atts vernac_declare_scope sc) | VernacDelimiters (sc,lr) -> vtdefault(fun () -> with_module_locality ~atts vernac_delimiters sc lr) | VernacBindScope (sc,rl) -> vtdefault(fun () -> vernac_bind_scope ~atts sc rl) | VernacOpenCloseScope (b, s) -> vtdefault(fun () -> with_section_locality ~atts vernac_open_close_scope (b,s)) | VernacEnableNotation (on,rule,interp,flags,scope) -> vtdefault(fun () -> with_module_locality ~atts vernac_enable_notation on rule interp flags scope) (* Gallina *) | VernacDefinition ((discharge,kind as dkind),lid,DefineBody (bl,red_option,c,typ)) -> let coercion = match kind with Decls.Coercion -> true | _ -> false in vtmodifyprogram (fun ~pm -> with_def_attributes ~coercion ~discharge:(discharge, "\"Let\"", "\"#[local] Definition\"") ~atts vernac_definition ~pm dkind lid bl red_option c typ) | VernacDefinition ((discharge,kind as dkind),lid,ProveBody(bl,typ)) -> let coercion = match kind with Decls.Coercion -> true | _ -> false in vtopenproof(fun () -> with_def_attributes ~coercion ~discharge:(discharge, "\"Let\"", "\"#[local] Definition\"") ~atts vernac_definition_interactive dkind lid bl typ) | VernacStartTheoremProof (k,l) -> vtopenproof(fun () -> with_def_attributes ~atts vernac_start_proof k l) | VernacExactProof c -> vtcloseproof (fun ~lemma -> unsupported_attributes atts; vernac_exact_proof ~lemma c) | VernacAssumption ((discharge,kind),nl,l) -> vtdefault(fun () -> with_def_attributes ~atts ~discharge:(discharge, "\"Variable\" or \"Hypothesis\"", "\"#[local] Parameter\" or \"#[local] Axiom\"") vernac_assumption kind l nl) | VernacSymbol l -> vtdefault (fun () -> let unfold_fix, poly = Attributes.(parse Notations.(unfold_fix ++ polymorphic)) atts in ComRewriteRule.do_symbols ~poly ~unfold_fix l) | VernacInductive (finite, l) -> vtdefault(fun () -> vernac_inductive ~atts finite l) | VernacFixpoint (discharge, l) -> let opens = List.exists (fun { body_def } -> Option.is_empty body_def) l in let discharge = discharge, "\"Let Fixpoint\"", "\"#[local] Fixpoint\"" in (if opens then vtopenproof (fun () -> let pm, proof = with_def_attributes ~discharge ~atts (vernac_fixpoint ~pm:None) l in assert (Option.is_empty pm); Option.get proof) else vtmodifyprogram (fun ~pm -> let pm, proof = with_def_attributes ~discharge ~atts (vernac_fixpoint ~pm:(Some pm)) l in assert (Option.is_empty proof); Option.get pm)) | VernacCoFixpoint (discharge, l) -> let opens = List.exists (fun { body_def } -> Option.is_empty body_def) l in let discharge = discharge, "\"Let CoFixpoint\"", "\"#[local] CoFixpoint\"" in (if opens then vtopenproof (fun () -> let pm, proof = with_def_attributes ~discharge ~atts (vernac_cofixpoint ~pm:None) l in assert (Option.is_empty pm); Option.get proof) else vtmodifyprogram (fun ~pm -> let pm, proof = with_def_attributes ~discharge ~atts (vernac_cofixpoint ~pm:(Some pm)) l in assert (Option.is_empty proof); Option.get pm)) | VernacScheme l -> vtdefault(fun () -> unsupported_attributes atts; vernac_scheme l) | VernacSchemeEquality (sch,id) -> vtdefault(fun () -> unsupported_attributes atts; vernac_scheme_equality sch id ~locmap:(Ind_tables.Locmap.default loc)) | VernacCombinedScheme (id, l) -> vtdefault(fun () -> unsupported_attributes atts; vernac_combined_scheme id l ~locmap:(Ind_tables.Locmap.default loc)) | VernacUniverse l -> vtdefault(fun () -> vernac_universe ~poly:(only_polymorphism atts) l) | VernacConstraint l -> vtdefault(fun () -> vernac_constraint ~poly:(only_polymorphism atts) l) | VernacAddRewRule (id, c) -> vtdefault (fun () -> unsupported_attributes atts; ComRewriteRule.do_rules id.v c) (* Gallina extensions *) | VernacNameSectionHypSet (lid, set) -> vtdefault(fun () -> unsupported_attributes atts; vernac_name_sec_hyp lid set) | VernacCanonical qid -> vtdefault(fun () -> vernac_canonical ~local:(only_locality atts) qid) | VernacCoercion (r,st) -> vtdefault(fun () -> vernac_coercion ~atts r st) | VernacIdentityCoercion ({v=id},s,t) -> vtdefault(fun () -> vernac_identity_coercion ~atts id s t) (* Type classes *) | VernacInstance (name, bl, t, props, info) -> let atts, program = Attributes.(parse_with_extra program) atts in if program then vtmodifyprogram (vernac_instance_program ~atts name bl t props info) else begin match props with | None -> vtopenproof (fun () -> vernac_instance_interactive ~atts name bl t info None) | Some props -> let atts, refine = Attributes.parse_with_extra Classes.refine_att atts in if refine then vtopenproof (fun () -> vernac_instance_interactive ~atts name bl t info (Some props)) else vtdefault (fun () -> vernac_instance ~atts name bl t props info) end | VernacDeclareInstance (id, bl, inst, info) -> vtdefault(fun () -> vernac_declare_instance ~atts id bl inst info) | VernacContext sup -> vtdefault(fun () -> vernac_context ~atts sup) | VernacExistingInstance insts -> vtdefault(fun () -> vernac_existing_instance ~atts insts) | VernacExistingClass id -> vtdefault(fun () -> unsupported_attributes atts; vernac_existing_class id) (* Commands *) | VernacCreateHintDb (dbname,b) -> vtdefault(fun () -> with_module_locality ~atts vernac_create_hintdb dbname b) | VernacRemoveHints (dbnames,ids) -> vtdefault(fun () -> vernac_remove_hints ~atts dbnames ids) | VernacHints (dbnames,hints) -> vtdefault(fun () -> vernac_hints ~atts dbnames hints) | VernacSyntacticDefinition (id,c,b) -> vtdefault(fun () -> vernac_abbreviation ~atts id c b) | VernacArguments (qid, args, more_implicits, flags) -> vtdefault(fun () -> with_section_locality ~atts (ComArguments.vernac_arguments qid args more_implicits flags)) | VernacReserve bl -> vtdefault(fun () -> unsupported_attributes atts; vernac_reserve bl) | VernacGeneralizable gen -> vtdefault(fun () -> with_locality ~atts vernac_generalizable gen) | VernacSetOpacity (qidl, on_proj_constant) -> vtdefault(fun () -> with_locality ~atts (vernac_set_opacity ~on_proj_constant) qidl) | VernacSetStrategy l -> vtdefault(fun () -> with_locality ~atts vernac_set_strategy l) | VernacRemoveOption (key,v) -> vtdefault(fun () -> unsupported_attributes atts; Vernacoptions.vernac_remove_option key v) | VernacAddOption (key,v) -> vtdefault(fun () -> unsupported_attributes atts; Vernacoptions.vernac_add_option key v) | VernacMemOption (key,v) -> vtdefault(fun () -> unsupported_attributes atts; Vernacoptions.vernac_mem_option key v) | VernacPrintOption key -> vtdefault(fun () -> unsupported_attributes atts; Vernacoptions.vernac_print_option key) | VernacCheckMayEval (r,g,c) -> vtreadproofopt(fun ~pstate -> unsupported_attributes atts; Feedback.msg_notice @@ vernac_check_may_eval ~pstate r g c) | VernacDeclareReduction (s,r) -> vtdefault(fun () -> with_locality ~atts vernac_declare_reduction s r) | VernacGlobalCheck c -> vtdefault(fun () -> unsupported_attributes atts; Feedback.msg_notice @@ vernac_global_check c) | VernacPrint p -> unsupported_attributes atts; Vernactypes.map_typed_vernac Feedback.msg_notice (vernac_print p) | VernacSearch (s,g,r) -> vtreadproofopt( unsupported_attributes atts; vernac_search ~atts s g r) | VernacLocate l -> vtreadproofopt(fun ~pstate -> unsupported_attributes atts; Feedback.msg_notice @@ vernac_locate ~pstate l) | VernacRegister (qid, r) -> vtnoproof(fun () -> unsupported_attributes atts; vernac_register qid r) | VernacPrimitive ((id, udecl), prim, typopt) -> vtdefault(fun () -> unsupported_attributes atts; ComPrimitive.do_primitive id udecl prim typopt) | VernacComments l -> vtdefault(fun () -> unsupported_attributes atts; Flags.if_verbose Feedback.msg_info (str "Comments ok\n")) | VernacAttributes atts -> vtdefault(fun () -> vernac_library_attributes atts) (* Proof management *) | VernacFocus n -> vtmodifyproof(unsupported_attributes atts;vernac_focus n) | VernacUnfocus -> vtmodifyproof(unsupported_attributes atts;vernac_unfocus) | VernacUnfocused -> vtreadproof(fun ~pstate -> unsupported_attributes atts; Feedback.msg_notice @@ vernac_unfocused ~pstate) | VernacBullet b -> vtmodifyproof( unsupported_attributes atts; vernac_bullet b) | VernacSubproof n -> vtmodifyproof( unsupported_attributes atts; vernac_subproof n) | VernacEndSubproof -> vtmodifyproof( unsupported_attributes atts; vernac_end_subproof) | VernacShow s -> vtreadproofopt(fun ~pstate -> unsupported_attributes atts; Feedback.msg_notice @@ vernac_show ~pstate s) | VernacCheckGuard -> vtreadproof(fun ~pstate -> unsupported_attributes atts; Feedback.msg_notice @@ vernac_check_guard ~pstate) | VernacValidateProof -> vtreadproof(fun ~pstate -> unsupported_attributes atts; Feedback.msg_notice @@ vernac_validate_proof ~pstate) | VernacProof (tac, using) -> vtmodifyproof(fun ~pstate -> unsupported_attributes atts; vernac_proof pstate tac using) | VernacEndProof pe -> unsupported_attributes atts; vtcloseproof (vernac_end_proof pe) | VernacAbort -> unsupported_attributes atts; vtcloseproof vernac_abort let translate_vernac ?loc ~atts v = match v with | VernacSynterp e -> translate_vernac_synterp ?loc ~atts e | VernacSynPure e -> translate_pure_vernac ?loc ~atts e coq-8.20.0/vernac/vernacentries.mli000066400000000000000000000047261466560755400172470ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* Evd.evar_map -> Genredexpr.raw_red_expr option -> Constrexpr.constr_expr -> Pp.t (** Vernac Translation into the Vernac DSL *) val translate_vernac : ?loc:Loc.t -> atts:Attributes.vernac_flags -> Synterp.vernac_entry -> Vernactypes.typed_vernac (** Vernacular require command, used by the command line *) val vernac_require : intern:Library.Intern.t -> Libnames.qualid option -> Vernacexpr.export_with_cats option -> (Libnames.qualid * Vernacexpr.import_filter_expr) list -> unit (** Interp phase of the require command *) val vernac_require_interp : Library.library_t list -> Names.DirPath.t list -> Vernacexpr.export_with_cats option -> (Libnames.qualid * Vernacexpr.import_filter_expr) list -> unit (** Miscellaneous stuff *) val command_focus : unit Proof.focus_kind val allow_sprop_opt_name : string list (** pre-processing and validation of VernacInductive *) module Preprocessed_Mind_decl : sig type flags = { template : bool option; udecl : Constrexpr.cumul_univ_decl_expr option; cumulative : bool; poly : bool; finite : Declarations.recursivity_kind; } type record = { flags : flags; primitive_proj : bool; kind : Vernacexpr.inductive_kind; records : Record.Ast.t list; } type inductive = { flags : flags; typing_flags : Declarations.typing_flags option; private_ind : bool; uniform : ComInductive.uniform_inductive_flag; inductives : (Vernacexpr.one_inductive_expr * Vernacexpr.notation_declaration list) list; } type t = | Record of record | Inductive of inductive end val preprocess_inductive_decl : atts:Attributes.vernac_flags -> Vernacexpr.inductive_kind -> (Vernacexpr.inductive_expr * Vernacexpr.notation_declaration list) list -> Preprocessed_Mind_decl.t coq-8.20.0/vernac/vernacexpr.mli000066400000000000000000000455451466560755400165600ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* is used instead of :: to declare instances in classes) *) type instance_flag = BackInstance | BackInstanceWarning | NoInstance type export_flag = Lib.export_flag = Export | Import type import_categories = { negative : bool; import_cats : string CAst.t list; } type export_with_cats = export_flag * import_categories option type infix_flag = bool (* true = Infix; false = Notation *) type one_import_filter_name = qualid * bool (* import inductive components *) type import_filter_expr = | ImportAll | ImportNames of one_import_filter_name list type locality_flag = bool (* true = Local *) type option_setting = | OptionUnset | OptionSetTrue | OptionSetInt of int | OptionSetString of string (** Identifier and optional list of bound universes and constraints. *) type definition_expr = | ProveBody of local_binder_expr list * constr_expr | DefineBody of local_binder_expr list * Genredexpr.raw_red_expr option * constr_expr * constr_expr option type notation_format = | TextFormat of lstring type syntax_modifier = | SetItemLevel of string list * Notation_term.notation_binder_kind option * Extend.production_level | SetItemScope of string list * scope_name | SetLevel of int | SetCustomEntry of string * int option | SetAssoc of Gramlib.Gramext.g_assoc | SetEntryType of string * Extend.simple_constr_prod_entry_key | SetOnlyParsing | SetOnlyPrinting | SetFormat of notation_format type notation_enable_modifier = | EnableNotationEntry of notation_entry CAst.t | EnableNotationOnly of Notationextern.notation_use | EnableNotationAll type notation_declaration = { ntn_decl_string : lstring ; ntn_decl_interp : constr_expr ; ntn_decl_scope : scope_name option ; ntn_decl_modifiers : syntax_modifier CAst.t list } type 'a fix_expr_gen = { fname : lident ; univs : universe_decl_expr option ; rec_order : 'a ; binders : local_binder_expr list ; rtype : constr_expr ; body_def : constr_expr option ; notations : notation_declaration list } type fixpoint_expr = recursion_order_expr option fix_expr_gen type cofixpoint_expr = unit fix_expr_gen type local_decl_expr = | 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 type class_binder = lident * constr_expr list type 'a with_coercion = coercion_flag * 'a type 'a with_coercion_instance = (Attributes.vernac_flags * coercion_flag * instance_flag) * 'a (* Attributes of a record field declaration *) type record_field_attr = { rf_coercion: coercion_flag; (* the projection is an implicit coercion *) rf_reversible: bool option; (* coercion is reversible, if relevant *) rf_instance: instance_flag; (* the projection is an instance *) rf_priority: int option; (* priority of the instance, if relevant *) rf_locality: Goptions.option_locality; (* locality of coercion and instance *) rf_notation: notation_declaration list; rf_canonical: bool; (* use this projection in the search for canonical instances *) } (* Same before parsing the attributes *) type record_field_attr_unparsed = { rfu_attrs: Attributes.vernac_flags; rfu_coercion: coercion_flag; rfu_instance: instance_flag; rfu_priority: int option; rfu_notation: notation_declaration list; } type constructor_expr = (lident * constr_expr) with_coercion_instance type constructor_list_or_record_decl_expr = | Constructors of constructor_expr list | RecordDecl of lident option * (local_decl_expr * record_field_attr_unparsed) list * lident option type inductive_params_expr = local_binder_expr list * local_binder_expr list option (** If the option is nonempty the "|" marker was used *) type inductive_expr = cumul_ident_decl with_coercion * inductive_params_expr * constr_expr option * constructor_list_or_record_decl_expr type one_inductive_expr = lident * inductive_params_expr * constr_expr option * constructor_expr list type typeclass_constraint = name_decl * Glob_term.binding_kind * constr_expr and typeclass_context = typeclass_constraint list type proof_expr = ident_decl * (local_binder_expr list * constr_expr) type opacity_flag = Opaque | Transparent type proof_end = | Admitted (* name in `Save ident` when closing goal *) | Proved of opacity_flag * lident option type scheme_type = | SchemeInduction | SchemeMinimality | SchemeElimination | SchemeCase type equality_scheme_type = | SchemeBooleanEquality | SchemeEquality (* The data of a Scheme decleration *) type scheme = { sch_type : scheme_type ; sch_qualid : Libnames.qualid Constrexpr.or_by_notation ; sch_sort : Sorts.family ; } type section_subset_expr = | SsEmpty | SsType | SsSingl of lident | SsCompl of section_subset_expr | SsUnion of section_subset_expr * section_subset_expr | SsSubstr of section_subset_expr * section_subset_expr | SsFwdClose of section_subset_expr (** Extension identifiers for the VERNAC EXTEND mechanism. {b ("Extraction", 0} indicates {b Extraction {i qualid}} command. {b ("Extraction", 1} indicates {b Recursive Extraction {i qualid}} command. {b ("Extraction", 2)} indicates {b Extraction "{i filename}" {i qualid{_ 1}} ... {i qualid{_ n}}} command. {b ("ExtractionLibrary", 0)} indicates {b Extraction Library {i ident}} command. {b ("RecursiveExtractionLibrary", 0)} indicates {b Recursive Extraction Library {i ident}} command. {b ("SeparateExtraction", 0)} indicates {b Separate Extraction {i qualid{_ 1}} ... {i qualid{_ n}}} command. {b ("ExtractionLanguage", 0)} indicates {b Extraction Language Ocaml} or {b Extraction Language Haskell} or {b Extraction Language Scheme} or {b Extraction Language JSON} commands. {b ("ExtractionImplicit", 0)} indicates {b Extraction Implicit {i qualid} \[ {i ident{_1}} ... {i ident{_n} } \] } command. {b ("ExtractionConstant", 0)} indicates {b Extract Constant {i qualid} => {i string}} command. {b ("ExtractionInlinedConstant", 0)} indicates {b Extract Inlined Constant {i qualid} => {i string}} command. {b ("ExtractionInductive", 0)} indicates {b Extract Inductive {i qualid} => {i string} [ {i string} ... {string} ] {i optstring}} command. {b ("ExtractionBlacklist", 0)} indicates {b Extraction Blacklist {i ident{_1}} ... {i ident{_n}}} command. *) (* This type allows registering the inlining of constants in native compiler. It will be extended with primitive inductive types and operators *) type register_kind = | RegisterInline | RegisterCoqlib of qualid | RegisterScheme of { inductive : qualid; scheme_kind : qualid } (** {6 Types concerning the module layer} *) type module_ast_inl = module_ast * Declaremods.inline type module_binder = export_with_cats option * lident list * module_ast_inl (** {6 The type of vernacular expressions} *) type vernac_one_argument_status = { name : Name.t; recarg_like : bool; notation_scope : scope_delimiter CAst.t list; implicit_status : Glob_term.binding_kind; } type vernac_argument_status = | VolatileArg | BidiArg | RealArg of vernac_one_argument_status type arguments_modifier = [ `Assert | `ClearBidiHint | `ClearImplicits | `ClearScopes | `DefaultImplicits | `ExtraScopes | `ReductionDontExposeCase | `ReductionNeverUnfold | `Rename ] type extend_name = { ext_plugin : string; (** Name of the plugin where the extension is defined as per DECLARE PLUGIN *) ext_entry : string; (** Name of the vernac entry where the tactic is defined, typically found after the VERNAC EXTEND statement in the source. *) ext_index : int; (* Index of the extension in the VERNAC EXTEND statement. Each parsing branch is given an offset, starting from zero. *) } type discharge = DoDischarge | NoDischarge type hint_info_expr = Constrexpr.constr_pattern_expr Typeclasses.hint_info_gen type reference_or_constr = | HintsReference of Libnames.qualid | HintsConstr of Constrexpr.constr_expr type hints_expr = | HintsResolve of (hint_info_expr * bool * reference_or_constr) list | HintsResolveIFF of bool * Libnames.qualid list * int option | HintsImmediate of reference_or_constr list | HintsUnfold of Libnames.qualid list | HintsTransparency of Libnames.qualid Hints.hints_transparency_target * bool | HintsMode of Libnames.qualid * Hints.hint_mode list | HintsConstructors of Libnames.qualid list | HintsExtern of int * Constrexpr.constr_expr option * Genarg.raw_generic_argument (** [synterp_vernac_expr] describes the AST of commands which have effects on parsing or parsing extensions *) type synterp_vernac_expr = | VernacLoad of verbose_flag * string | VernacReservedNotation of infix_flag * (lstring * syntax_modifier CAst.t list) | VernacNotation of infix_flag * notation_declaration | VernacDeclareCustomEntry of string | VernacBeginSection of lident | VernacEndSegment of lident | VernacRequire of qualid option * export_with_cats option * (qualid * import_filter_expr) list | VernacImport of export_with_cats * (qualid * import_filter_expr) list (* Modules and Module Types *) | VernacDeclareModule of export_with_cats option * lident * module_binder list * module_ast_inl | VernacDefineModule of export_with_cats option * lident * module_binder list * module_ast_inl Declaremods.module_signature * module_ast_inl list | VernacDeclareModuleType of lident * module_binder list * module_ast_inl list * module_ast_inl list | VernacInclude of module_ast_inl list (* Auxiliary file and library management *) | VernacDeclareMLModule of string list | VernacChdir of string option | VernacExtraDependency of qualid * string * Id.t option | VernacSetOption of bool (* Export modifier? *) * Goptions.option_name * option_setting | VernacProofMode of string (* For extension *) | VernacExtend of extend_name * Genarg.raw_generic_argument list (** [synpure_vernac_expr] describes the AST of commands which have no effect on parsing or parsing extensions. On these ASTs, the syntactic interpretation phase is the identity. *) type nonrec synpure_vernac_expr = (* Syntax *) | VernacOpenCloseScope of bool * scope_name | VernacDeclareScope of scope_name | VernacDelimiters of scope_name * string option | VernacBindScope of scope_name * coercion_class list | VernacEnableNotation of bool * (string, Id.t list * qualid) Util.union option * constr_expr option * notation_enable_modifier list * notation_with_optional_scope option (* Gallina *) | VernacDefinition of (discharge * Decls.definition_object_kind) * name_decl * definition_expr | VernacStartTheoremProof of Decls.theorem_kind * proof_expr list | VernacEndProof of proof_end | VernacExactProof of constr_expr | VernacAssumption of (discharge * Decls.assumption_object_kind) * Declaremods.inline * (ident_decl list * constr_expr) with_coercion list | VernacSymbol of (ident_decl list * constr_expr) with_coercion list | VernacInductive of inductive_kind * (inductive_expr * notation_declaration list) list | VernacFixpoint of discharge * fixpoint_expr list | VernacCoFixpoint of discharge * cofixpoint_expr list | VernacScheme of (lident option * scheme) list | VernacSchemeEquality of equality_scheme_type * Libnames.qualid Constrexpr.or_by_notation | VernacCombinedScheme of lident * lident list | VernacUniverse of lident list | VernacConstraint of univ_constraint_expr list | VernacAddRewRule of lident * (universe_decl_expr option * constr_expr * constr_expr) list (* Gallina extensions *) | VernacCanonical of qualid or_by_notation | VernacCoercion of qualid or_by_notation * (coercion_class * coercion_class) option | VernacIdentityCoercion of lident * coercion_class * coercion_class | VernacNameSectionHypSet of lident * section_subset_expr (* Type classes *) | VernacInstance of name_decl * (* name *) local_binder_expr list * (* binders *) constr_expr * (* type *) (bool * constr_expr) option * (* body (bool=true when using {}) *) hint_info_expr | VernacDeclareInstance of ident_decl * (* name *) local_binder_expr list * (* binders *) constr_expr * (* type *) hint_info_expr | VernacContext of local_binder_expr list | VernacExistingInstance of (qualid * hint_info_expr) list (* instances names, priorities and patterns *) | VernacExistingClass of qualid (* inductive or definition name *) (* Resetting *) | VernacResetName of lident | VernacResetInitial | VernacBack of int (* Commands *) | VernacCreateHintDb of string * bool | VernacRemoveHints of string list * qualid list | VernacHints of string list * hints_expr | VernacSyntacticDefinition of lident * (Id.t list * constr_expr) * syntax_modifier CAst.t list | VernacArguments of qualid or_by_notation * vernac_argument_status list (* Main arguments status list *) * (Name.t * Glob_term.binding_kind) list list (* Extra implicit status lists *) * arguments_modifier list | VernacReserve of simple_binder list | VernacGeneralizable of (lident list) option | VernacSetOpacity of (Conv_oracle.level * qualid or_by_notation list) * bool | VernacSetStrategy of (Conv_oracle.level * qualid or_by_notation list) list | VernacMemOption of Goptions.option_name * Goptions.table_value list | VernacPrintOption of Goptions.option_name | VernacCheckMayEval of Genredexpr.raw_red_expr option * Goal_select.t option * constr_expr | VernacGlobalCheck of constr_expr | VernacDeclareReduction of string * Genredexpr.raw_red_expr | VernacPrint of printable | VernacSearch of searchable * Goal_select.t option * qualid list search_restriction | VernacLocate of locatable | VernacRegister of qualid * register_kind | VernacPrimitive of ident_decl * CPrimitives.op_or_type * constr_expr option | VernacComments of comment list | VernacAttributes of Attributes.vernac_flags (* Proof management *) | VernacAbort | VernacAbortAll | VernacRestart | VernacUndo of int | VernacUndoTo of int | VernacFocus of int option | VernacUnfocus | VernacUnfocused | VernacBullet of Proof_bullet.t | VernacSubproof of Goal_select.t option | VernacEndSubproof | VernacShow of showable | VernacCheckGuard | VernacValidateProof | VernacProof of Genarg.raw_generic_argument option * section_subset_expr option | VernacAddOption of Goptions.option_name * Goptions.table_value list | VernacRemoveOption of Goptions.option_name * Goptions.table_value list (** We classify vernacular expressions in two categories. [VernacSynterp] represents commands which have an effect on parsing or on parsing extensions. [VernacSynPure] represents commands which have no such effects. *) type 'a vernac_expr_gen = | VernacSynterp of 'a | VernacSynPure of synpure_vernac_expr type vernac_expr = synterp_vernac_expr vernac_expr_gen type control_flag = | ControlTime | ControlInstructions | ControlRedirect of string | ControlTimeout of int | ControlFail | ControlSucceed type ('a, 'b) vernac_control_gen_r = { control : 'a list ; attrs : Attributes.vernac_flags ; expr : 'b vernac_expr_gen } and 'a vernac_control_gen = (control_flag, 'a) vernac_control_gen_r CAst.t type vernac_control = synterp_vernac_expr vernac_control_gen coq-8.20.0/vernac/vernacextend.ml000066400000000000000000000243001466560755400167020ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* atts:Attributes.vernac_flags -> unit -> typed_vernac type plugin_args = Genarg.raw_generic_argument list (* Table of vernac entries *) let vernac_tab = (Hashtbl.create 211 : (Vernacexpr.extend_name, bool * (plugin_args -> vernac_command)) Hashtbl.t) let vinterp_add depr s f = Hashtbl.replace vernac_tab s (depr, f) let vinterp_map s = try Hashtbl.find vernac_tab s with Not_found -> user_err (str"Cannot find vernac command " ++ str s.ext_entry ++ str".") let warn_deprecated_command = let open CWarnings in create ~name:"deprecated-command" ~category:CWarnings.CoreCategories.deprecated (fun pr -> str "Deprecated vernacular command: " ++ pr) (* Interpretation of a vernac command *) let type_vernac opn converted_args ?loc ~atts = let depr, callback = vinterp_map opn in let () = if depr then let rules = Egramml.get_extend_vernac_rule opn in let pr_gram = function | Egramml.GramTerminal s -> str s | Egramml.GramNonTerminal _ -> str "_" in let pr = pr_sequence pr_gram rules in warn_deprecated_command pr; in callback converted_args ?loc ~atts (** VERNAC EXTEND registering *) type classifier = Genarg.raw_generic_argument list -> vernac_classification (** Classifiers *) module StringPair = struct type t = string * string let compare (s1, s2) (t1, t2) = let c = String.compare s1 t1 in if Int.equal c 0 then String.compare s2 t2 else c end module StringPairMap = Map.Make(StringPair) let classifiers : classifier array StringPairMap.t ref = ref StringPairMap.empty let get_vernac_classifier e args = let open Vernacexpr in (StringPairMap.find (e.ext_plugin, e.ext_entry) !classifiers).(e.ext_index) args let declare_vernac_classifier name f = classifiers := StringPairMap.add name f !classifiers let classify_as_query = VtQuery let classify_as_sideeff = VtSideff ([], VtLater) let classify_as_proofstep = VtProofStep { proof_block_detection = None} type (_, _) ty_sig = | TyNil : (vernac_command, vernac_classification) ty_sig | TyTerminal : string * ('r, 's) ty_sig -> ('r, 's) ty_sig | TyNonTerminal : ('a, 'b, 'c) Extend.ty_user_symbol * ('r, 's) ty_sig -> ('a -> 'r, 'a -> 's) ty_sig type ty_ml = TyML : bool * ('r, 's) ty_sig * 'r * 's option -> ty_ml let type_error () = CErrors.anomaly (Pp.str "Ill-typed VERNAC EXTEND") let rec untype_classifier : type r s. (r, s) ty_sig -> s -> classifier = function | TyNil -> fun f args -> begin match args with | [] -> f | _ :: _ -> type_error () end | TyTerminal (_, ty) -> fun f args -> untype_classifier ty f args | TyNonTerminal (tu, ty) -> fun f args -> let open Genarg in begin match args with | [] -> type_error () | GenArg (Rawwit tag, v) :: args -> match Genarg.genarg_type_eq tag (Egramml.proj_symbol tu) with | None -> type_error () | Some Refl -> untype_classifier ty (f v) args end (** Stupid GADTs forces us to duplicate the definition just for typing *) let rec untype_command : type r s. (r, s) ty_sig -> r -> plugin_args -> vernac_command = function | TyNil -> fun f args -> begin match args with | [] -> f | _ :: _ -> type_error () end | TyTerminal (_, ty) -> fun f args -> untype_command ty f args | TyNonTerminal (tu, ty) -> fun f args -> let open Genarg in begin match args with | [] -> type_error () | GenArg (Rawwit tag, v) :: args -> match genarg_type_eq tag (Egramml.proj_symbol tu) with | None -> type_error () | Some Refl -> untype_command ty (f v) args end let rec untype_user_symbol : type s a b c. (a, b, c) Extend.ty_user_symbol -> (s, Gramlib.Grammar.norec, a) Pcoq.Symbol.t = let open Extend in function | TUlist1 l -> Pcoq.Symbol.list1 (untype_user_symbol l) | TUlist1sep (l, s) -> Pcoq.Symbol.list1sep (untype_user_symbol l) (Pcoq.Symbol.tokens [Pcoq.TPattern (Pcoq.terminal s)]) false | TUlist0 l -> Pcoq.Symbol.list0 (untype_user_symbol l) | TUlist0sep (l, s) -> Pcoq.Symbol.list0sep (untype_user_symbol l) (Pcoq.Symbol.tokens [Pcoq.TPattern (Pcoq.terminal s)]) false | TUopt o -> Pcoq.Symbol.opt (untype_user_symbol o) | TUentry a -> Pcoq.Symbol.nterm (Pcoq.genarg_grammar (Genarg.ExtraArg a)) | TUentryl (a, i) -> Pcoq.Symbol.nterml (Pcoq.genarg_grammar (Genarg.ExtraArg a)) (string_of_int i) let rec untype_grammar : type r s. (r, s) ty_sig -> 'a Egramml.grammar_prod_item list = function | TyNil -> [] | TyTerminal (tok, ty) -> Egramml.GramTerminal tok :: untype_grammar ty | TyNonTerminal (tu, ty) -> let t = Genarg.rawwit (Egramml.proj_symbol tu) in let symb = untype_user_symbol tu in Egramml.GramNonTerminal (Loc.tag (t, symb)) :: untype_grammar ty let declare_dynamic_vernac_extend ~command ?entry ~depr cl ty f = let cl = untype_classifier ty cl in let f = untype_command ty f in let r = untype_grammar ty in let ext = { command with Vernacexpr.ext_index = 0 } in vinterp_add depr ext f; Egramml.declare_vernac_command_grammar ~allow_override:true ext entry r; declare_vernac_classifier (ext.ext_plugin, ext.ext_entry) [|cl|]; ext let is_static_linking_done = ref false let static_linking_done () = is_static_linking_done := true let static_vernac_extend ~plugin ~command ?classifier ?entry ext = let get_classifier (TyML (_, ty, _, cl)) = match cl with | Some cl -> untype_classifier ty cl | None -> match classifier with | Some cl -> fun _ -> cl command | None -> let e = match entry with | None -> "COMMAND" | Some e -> Pcoq.Entry.name e in let msg = Printf.sprintf "\ Vernac entry \"%s\" misses a classifier. \ A classifier is a function that returns an expression \ of type vernac_classification (see Vernacexpr). You can: \n\ - Use '... EXTEND %s CLASSIFIED AS QUERY ...' if the \ new vernacular command does not alter the system state;\n\ - Use '... EXTEND %s CLASSIFIED AS SIDEFF ...' if the \ new vernacular command alters the system state but not the \ parser nor it starts a proof or ends one;\n\ - Use '... EXTEND %s CLASSIFIED BY f ...' to specify \ a global function f. The function f will be called passing\ \"%s\" as the only argument;\n\ - Add a specific classifier in each clause using the syntax:\n\ '[...] => [ f ] -> [...]'.\n\ Specific classifiers have precedence over global \ classifiers. Only one classifier is called." command e e e command in CErrors.user_err (Pp.strbrk msg) in let cl = Array.map_of_list get_classifier ext in let ext_plugin = Option.default "__" plugin in let iter i (TyML (depr, ty, f, _)) = let f = untype_command ty f in let r = untype_grammar ty in let ext = Vernacexpr.{ ext_plugin; ext_entry = command; ext_index = i } in let () = vinterp_add depr ext f in let () = Egramml.declare_vernac_command_grammar ~allow_override:false ext entry r in let () = match plugin with | None -> let () = if !is_static_linking_done then CErrors.anomaly Pp.(str "static_vernac_extend in dynlinked code must pass non-None plugin.") in Egramml.extend_vernac_command_grammar ~undoable:false ext | Some plugin -> Mltop.add_init_function plugin (fun () -> Egramml.extend_vernac_command_grammar ~undoable:true ext) in () in let () = declare_vernac_classifier (ext_plugin, command) cl in let () = List.iteri iter ext in () (** VERNAC ARGUMENT EXTEND registering *) type 'a argument_rule = | Arg_alias of 'a Pcoq.Entry.t | Arg_rules of 'a Pcoq.Production.t list type 'a vernac_argument = { arg_printer : Environ.env -> Evd.evar_map -> 'a -> Pp.t; arg_parsing : 'a argument_rule; } let vernac_argument_extend ~plugin ~name arg = let wit = Genarg.create_arg name in let entry = match arg.arg_parsing with | Arg_alias e -> let () = Pcoq.register_grammar wit e in e | Arg_rules rules -> let e = Pcoq.create_generic_entry2 name (Genarg.rawwit wit) in let plugin_uid = (plugin, "vernacargextend:"^name) in let () = Egramml.grammar_extend ~plugin_uid e (Pcoq.Fresh (Gramlib.Gramext.First, [None, None, rules])) in e in let pr = arg.arg_printer in let pr x = Genprint.PrinterBasic (fun env sigma -> pr env sigma x) in let () = Genprint.register_vernac_print0 wit pr in (wit, entry) coq-8.20.0/vernac/vernacextend.mli000066400000000000000000000134131466560755400170560ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* atts:Attributes.vernac_flags -> unit -> Vernactypes.typed_vernac type plugin_args = Genarg.raw_generic_argument list val type_vernac : Vernacexpr.extend_name -> plugin_args -> vernac_command (** {5 VERNAC EXTEND} *) type classifier = Genarg.raw_generic_argument list -> vernac_classification type (_, _) ty_sig = | TyNil : (vernac_command, vernac_classification) ty_sig | TyTerminal : string * ('r, 's) ty_sig -> ('r, 's) ty_sig | TyNonTerminal : ('a, 'b, 'c) Extend.ty_user_symbol * ('r, 's) ty_sig -> ('a -> 'r, 'a -> 's) ty_sig type ty_ml = TyML : bool (* deprecated *) * ('r, 's) ty_sig * 'r * 's option -> ty_ml (** Statically extend vernacular commands. This is used by coqpp VERNAC EXTEND. It should not be used directly, use [declare_dynamic_vernac_extend] instead. Commands added by plugins at Declare ML Module / Require time should provide [plugin]. Commands added without providing [plugin] cannot be removed from the grammar or modified. Not passing [plugin] is possible for non-plugin coq-core commands and deprecated for all other callers. *) val static_vernac_extend : plugin:string option -> command:string -> ?classifier:(string -> vernac_classification) -> ?entry:Vernacexpr.vernac_expr Pcoq.Entry.t -> ty_ml list -> unit (** Used to tell the system that all future vernac extends are from plugins. *) val static_linking_done : unit -> unit (** Dynamically extend vernacular commands (for instance when importing some module). Reusing a [command] string will replace previous uses. The result is undefined and probably produces anomalies if the previous grammar rule is still active and was different from the new one. The polymorphic arguments are as in [TyML]. The declared grammar extension is disabled, one needs to call [Egramml.extend_vernac_command_grammar] in order to enable it. That call should use [undoable:true] to make it possible to disable the extension, e.g. by backtracking over the command which enabled it. *) val declare_dynamic_vernac_extend : command:Vernacexpr.extend_name -> ?entry:Vernacexpr.vernac_expr Pcoq.Entry.t -> depr:bool -> 's (* classifier *) -> ('r, 's) ty_sig (* grammar *) -> 'r (* command interpretation *) -> Vernacexpr.extend_name (** {5 VERNAC ARGUMENT EXTEND} *) type 'a argument_rule = | Arg_alias of 'a Pcoq.Entry.t (** This is used because CAMLP5 parser can be dumb about rule factorization, which sometimes requires two entries to be the same. *) | Arg_rules of 'a Pcoq.Production.t list (** There is a discrepancy here as we use directly extension rules and thus entries instead of ty_user_symbol and thus arguments as roots. *) type 'a vernac_argument = { arg_printer : Environ.env -> Evd.evar_map -> 'a -> Pp.t; arg_parsing : 'a argument_rule; } val vernac_argument_extend : plugin:string -> name:string -> 'a vernac_argument -> 'a Genarg.vernac_genarg_type * 'a Pcoq.Entry.t (** {5 STM classifiers} *) val get_vernac_classifier : Vernacexpr.extend_name -> classifier (** Standard constant classifiers *) val classify_as_query : vernac_classification val classify_as_sideeff : vernac_classification val classify_as_proofstep : vernac_classification coq-8.20.0/vernac/vernacinterp.ml000066400000000000000000000241551466560755400167240ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* 'b) (x : 'a) : 'b = match Control.timeout timeout f x with | None -> Exninfo.iraise (Exninfo.capture CErrors.Timeout) | Some x -> x (* Fail *) (* Restoring the state is the caller's responsibility *) let with_fail f : (Loc.t option * Pp.t, unit) result = try let _ = f () in Error () with (* Fail Timeout is a common pattern so we need to support it. *) | e -> (* The error has to be printed in the failing state *) let _, info as exn = Exninfo.capture e in if CErrors.is_anomaly e && e != CErrors.Timeout then Exninfo.iraise exn; Ok (Loc.get_loc info, CErrors.iprint exn) let real_error_loc ~cmdloc ~eloc = if Loc.finer eloc cmdloc then eloc else cmdloc (* We restore the state always *) let with_fail ~loc ~st f = let res = with_fail f in Vernacstate.Interp.invalidate_cache (); Vernacstate.unfreeze_full_state st; match res with | Error () -> CErrors.user_err (Pp.str "The command has not failed!") | Ok (eloc, msg) -> let loc = if !Synterp.test_mode then real_error_loc ~cmdloc:loc ~eloc else None in if not !Flags.quiet || !Synterp.test_mode then Feedback.msg_notice ?loc Pp.(str "The command has indeed failed with message:" ++ fnl () ++ msg) let with_succeed ~st f = let () = ignore (f ()) in Vernacstate.Interp.invalidate_cache (); Vernacstate.unfreeze_full_state st; if not !Flags.quiet then Feedback.msg_notice Pp.(str "The command has succeeded and its effects have been reverted.") let locate_if_not_already ?loc (e, info) = (e, Option.cata (Loc.add_loc info) info (real_error_loc ~cmdloc:loc ~eloc:(Loc.get_loc info))) let interp_control_entry ~loc (f : control_entry) ~st (fn : st:Vernacstate.t -> Vernacstate.LemmaStack.t option * Declare.OblState.t NeList.t) = match f with | ControlFail { st = synterp_st } -> with_fail ~loc ~st (fun () -> Vernacstate.Synterp.unfreeze synterp_st; fn ~st); st.Vernacstate.interp.lemmas, st.Vernacstate.interp.program | ControlSucceed { st = synterp_st } -> with_succeed ~st (fun () -> Vernacstate.Synterp.unfreeze synterp_st; fn ~st); st.Vernacstate.interp.lemmas, st.Vernacstate.interp.program | ControlTimeout { remaining } -> vernac_timeout ~timeout:remaining (fun () -> fn ~st) () | ControlTime { synterp_duration } -> let result = System.measure_duration (fun () -> fn ~st) () in let result = Result.map (fun (v,d) -> v, System.duration_add d synterp_duration) result in Feedback.msg_notice @@ System.fmt_transaction_result result; begin match result with | Ok (v,_) -> v | Error (exn, _) -> Exninfo.iraise exn end | ControlInstructions { synterp_instructions } -> let result = System.count_instructions (fun () -> fn ~st) () in let result = Result.map (fun (v,d) -> v, System.instruction_count_add d synterp_instructions) result in Feedback.msg_notice @@ System.fmt_instructions_result result; begin match result with | Ok (v,_) -> v | Error (exn, _) -> Exninfo.iraise exn end | ControlRedirect s -> Topfmt.with_output_to_file s (fun () -> fn ~st) () (* "locality" is the prefix "Local" attribute, while the "local" component * is the outdated/deprecated "Local" attribute of some vernacular commands * still parsed as the obsolete_locality grammar entry for retrocompatibility. * loc is the Loc.t of the vernacular command being interpreted. *) let rec interp_expr ?loc ~atts ~st c = match c with (* The STM should handle that, but LOAD bypasses the STM... *) | VernacSynPure VernacAbortAll -> CErrors.user_err (Pp.str "AbortAll cannot be used through the Load command") | VernacSynPure VernacRestart -> CErrors.user_err (Pp.str "Restart cannot be used through the Load command") | VernacSynPure VernacUndo _ -> CErrors.user_err (Pp.str "Undo cannot be used through the Load command") | VernacSynPure VernacUndoTo _ -> CErrors.user_err (Pp.str "UndoTo cannot be used through the Load command") (* Resetting *) | VernacSynPure VernacResetName _ -> CErrors.anomaly (Pp.str "VernacResetName not handled by Stm.") | VernacSynPure VernacResetInitial -> CErrors.anomaly (Pp.str "VernacResetInitial not handled by Stm.") | VernacSynPure VernacBack _ -> CErrors.anomaly (Pp.str "VernacBack not handled by Stm.") | VernacSynterp EVernacLoad (verbosely, fname) -> Attributes.unsupported_attributes atts; vernac_load ~verbosely fname | v -> let fv = Vernacentries.translate_vernac ?loc ~atts v in let stack = st.Vernacstate.interp.lemmas in let program = st.Vernacstate.interp.program in let {Vernactypes.prog; proof; opaque_access=(); }, () = Vernactypes.run fv { prog=program; proof=stack; opaque_access=(); } in proof, prog and vernac_load ~verbosely entries = (* Note that no proof should be open here, so the state here is just token for now *) let st = Vernacstate.freeze_full_state () in let v_mod = if verbosely then Flags.verbosely else Flags.silently in let interp_entry (stack, pm) (CAst.{ loc; v = cmd }, synterp_st) = Vernacstate.Synterp.unfreeze synterp_st; let st = Vernacstate.{ synterp = synterp_st; interp = { st.interp with Interp.lemmas = stack; program = pm }} in v_mod (interp_control ~st) (CAst.make ?loc cmd) in let pm = st.Vernacstate.interp.program in let stack = st.Vernacstate.interp.lemmas in let stack, pm = Dumpglob.with_glob_output Dumpglob.NoGlob (fun () -> List.fold_left interp_entry (stack, pm) entries) () in (* If Load left a proof open, we fail too. *) if Option.has_some stack then CErrors.user_err Pp.(str "Files processed by Load cannot leave open proofs."); stack, pm and interp_control ~st ({ CAst.v = cmd; loc }) = List.fold_right (fun flag fn -> interp_control_entry ~loc flag fn) cmd.control (fun ~st -> let before_univs = Global.universes () in let pstack, pm = with_generic_atts ~check:false cmd.attrs (fun ~atts -> interp_expr ?loc ~atts ~st cmd.expr) in let after_univs = Global.universes () in if before_univs == after_univs then pstack, pm else let f = Declare.Proof.update_sigma_univs after_univs in Option.map (Vernacstate.LemmaStack.map ~f) pstack, pm) ~st (* XXX: This won't properly set the proof mode, as of today, it is controlled by the STM. Thus, we would need access information from the classifier. The proper fix is to move it to the STM, however, the way the proof mode is set there makes the task non trivial without a considerable amount of refactoring. *) (* Interpreting a possibly delayed proof *) let interp_qed_delayed ~proof ~st pe = let stack = st.Vernacstate.interp.lemmas in let pm = st.Vernacstate.interp.program in let stack = Option.cata (fun stack -> snd @@ Vernacstate.LemmaStack.pop stack) None stack in let pm = NeList.map_head (fun pm -> match pe with | Admitted -> Declare.Proof.save_lemma_admitted_delayed ~pm ~proof | Proved (_,idopt) -> let pm = Declare.Proof.save_lemma_proved_delayed ~pm ~proof ~idopt in pm) pm in stack, pm let interp_qed_delayed_control ~proof ~st ~control { CAst.loc; v=pe } = List.fold_right (fun flag fn -> interp_control_entry ~loc flag fn) control (fun ~st -> interp_qed_delayed ~proof ~st pe) ~st (* General interp with management of state *) (* Be careful with the cache here in case of an exception. *) let interp_gen ~verbosely ~st ~interp_fn cmd = try let v_mod = if verbosely then Flags.verbosely else Flags.silently in let ontop = v_mod (interp_fn ~st) cmd in Vernacstate.Declare.set ontop [@ocaml.warning "-3"]; Vernacstate.Interp.freeze_interp_state () with exn -> let exn = Exninfo.capture exn in let exn = locate_if_not_already ?loc:cmd.CAst.loc exn in Vernacstate.Interp.invalidate_cache (); Exninfo.iraise exn (* Regular interp *) let interp ~intern ?(verbosely=true) ~st cmd = Vernacstate.unfreeze_full_state st; vernac_pperr_endline Pp.(fun () -> str "interpreting: " ++ Ppvernac.pr_vernac_expr cmd.CAst.v.expr); let entry = NewProfile.profile "synterp" (fun () -> Synterp.synterp_control ~intern cmd) () in let interp = NewProfile.profile "interp" (fun () -> interp_gen ~verbosely ~st ~interp_fn:interp_control entry) () in Vernacstate.{ synterp = Vernacstate.Synterp.freeze (); interp } let interp_entry ?(verbosely=true) ~st entry = Vernacstate.unfreeze_full_state st; interp_gen ~verbosely ~st ~interp_fn:interp_control entry module Intern = struct let fs_intern dp = match Loadpath.locate_absolute_library dp with | Ok file -> Feedback.feedback @@ Feedback.FileDependency (Some file, Names.DirPath.to_string dp); let res, provenance = Library.intern_from_file file in Result.iter (fun _ -> Feedback.feedback @@ Feedback.FileLoaded (Names.DirPath.to_string dp, file)) res; res, provenance | Error e -> Loadpath.Error.raise dp e end let fs_intern = Intern.fs_intern let interp_qed_delayed_proof ~proof ~st ~control (CAst.{loc; v = pe } as e) : Vernacstate.Interp.t = (* Synterp duplication of control handling bites us here... *) let control = Synterp.add_default_timeout control in let control = List.map Synterp.synpure_control control in NewProfile.profile "interp-delayed-qed" (fun () -> interp_gen ~verbosely:false ~st ~interp_fn:(interp_qed_delayed_control ~proof ~control) e) () coq-8.20.0/vernac/vernacinterp.mli000066400000000000000000000025251466560755400170720ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* ?verbosely:bool -> st:Vernacstate.t -> Vernacexpr.vernac_control -> Vernacstate.t val interp_entry : ?verbosely:bool -> st:Vernacstate.t -> Synterp.vernac_control_entry -> Vernacstate.Interp.t (** Execute a Qed but with a proof_object which may contain a delayed proof and won't be forced *) val interp_qed_delayed_proof : proof:Declare.Proof.proof_object -> st:Vernacstate.t -> control:Vernacexpr.control_flag list -> Vernacexpr.proof_end CAst.t -> Vernacstate.Interp.t coq-8.20.0/vernac/vernacoptions.ml000066400000000000000000000044041466560755400171110ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* unset_option_value_gen ~locality ~stage key | OptionSetString s -> set_string_option_value_gen ~locality ~stage key s | OptionSetInt n -> set_int_option_value_gen ~locality ~stage key (Some n) | OptionSetTrue -> set_bool_option_value_gen ~locality ~stage key true let vernac_set_append_option ~locality ~stage key s = set_string_option_append_value_gen ~locality ~stage key s let vernac_set_option ~locality ~stage table v = match v with | OptionSetString s -> (* We make a special case for warnings and debug flags because appending is their natural semantics *) if CString.List.equal table ["Warnings"] || CString.List.equal table ["Debug"] then vernac_set_append_option ~locality ~stage table s else let (last, prefix) = List.sep_last table in if String.equal last "Append" && not (List.is_empty prefix) then vernac_set_append_option ~locality ~stage prefix s else vernac_set_option0 ~locality ~stage table v | _ -> vernac_set_option0 ~locality ~stage table v let iter_table f k v = Goptions.iter_table (Global.env()) f k v let vernac_add_option = iter_table { aux = fun table -> table.add } let vernac_remove_option = iter_table { aux = fun table -> table.remove } let vernac_mem_option = iter_table { aux = fun table -> table.mem } let vernac_print_option key = try (get_ref_table key).print () with Not_found -> try (get_string_table key).print () with Not_found -> try print_option_value key with Not_found -> error_undeclared_key key coq-8.20.0/vernac/vernacoptions.mli000066400000000000000000000022441466560755400172620ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* stage:Summary.Stage.t ->option_name -> string -> unit val vernac_set_option : locality:option_locality -> stage:Summary.Stage.t -> option_name -> Vernacexpr.option_setting -> unit val vernac_add_option : option_name -> table_value list -> unit val vernac_remove_option : option_name -> table_value list -> unit val vernac_mem_option : option_name -> table_value list -> unit val vernac_print_option : option_name -> unit coq-8.20.0/vernac/vernacprop.ml000066400000000000000000000027401466560755400163770ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* true | _ -> false) v.control (* Navigation commands are allowed in a coqtop session but not in a .v file *) let is_navigation_vernac = function | VernacSynPure (VernacResetInitial | VernacResetName _ | VernacBack _) -> true | _ -> false (* NB: Reset is now allowed again as asked by A. Chlipala *) let is_reset = function | VernacSynPure (VernacResetInitial | VernacResetName _) -> true | _ -> false let is_debug = function | VernacSynterp (VernacSetOption (_, ["Ltac";"Debug"], _)) -> true | _ -> false let is_undo = function | VernacSynPure (VernacUndo _ | VernacUndoTo _) -> true | _ -> false coq-8.20.0/vernac/vernacprop.mli000066400000000000000000000017441466560755400165530ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* bool val is_navigation_vernac : vernac_expr -> bool val is_reset : vernac_expr -> bool val is_debug : vernac_expr -> bool val is_undo : vernac_expr -> bool coq-8.20.0/vernac/vernacstate.ml000066400000000000000000000221741466560755400165420ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* t val unfreeze : t -> unit module Stm : sig val make_shallow : t -> t val lib : t -> Lib.Interp.frozen val summary : t -> Summary.Interp.frozen val replace_summary : t -> Summary.Interp.frozen -> t end end = struct type t = Lib.Interp.frozen * Summary.Interp.frozen let freeze () = (Lib.Interp.freeze (), Summary.Interp.freeze_summaries ()) let unfreeze (fl,fs) = Lib.Interp.unfreeze fl; Summary.Interp.unfreeze_summaries fs module Stm = struct let make_shallow (lib, summary) = Lib.Interp.drop_objects lib, Summary.Interp.make_marshallable summary let lib = fst let summary = snd let replace_summary (lib,_) summary = (lib,summary) end end module System = struct let protect f x = let synterp_st = Synterp.freeze () in let interp_st = Interp_system.freeze () in try let a = f x in Synterp.unfreeze synterp_st; Interp_system.unfreeze interp_st; a with reraise -> let reraise = Exninfo.capture reraise in begin Synterp.unfreeze synterp_st; Interp_system.unfreeze interp_st; Exninfo.iraise reraise end end module LemmaStack = struct type t = Declare.Proof.t NeList.t let map ~f x = NeList.map f x let map_top ~f x = NeList.map_head f x let pop x = NeList.head x, NeList.tail x let get_top = NeList.head let with_top x ~f = f (get_top x) let push ontop a = NeList.push a ontop let get_all_proof_names (pf : t) = let prj x = Declare.Proof.get x in List.map Proof.(function pf -> (data (prj pf)).name) (NeList.to_list pf) let copy_info src tgt = Declare.Proof.map ~f:(fun _ -> Declare.Proof.get tgt) src let copy_info ~(src : t) ~(tgt : t) = NeList.map2 copy_info src tgt end let s_cache = ref None let s_lemmas = ref None let s_program = ref (NeList.singleton Declare.OblState.empty) module Interp = struct module System = Interp_system type t = { system : System.t; (* summary + libstack *) lemmas : LemmaStack.t option; (* proofs of lemmas currently opened *) program : Declare.OblState.t NeList.t; (* obligations table *) opaques : Opaques.Summary.t; (* opaque proof terms *) } let invalidate_cache () = s_cache := None let update_cache rf v = rf := Some v; v let do_if_not_cached rf f v = match !rf with | None -> rf := Some v; f v | Some vc when vc != v -> rf := Some v; f v | Some _ -> () let freeze_interp_state () = { system = update_cache s_cache (System.freeze ()); lemmas = !s_lemmas; program = !s_program; opaques = Opaques.Summary.freeze (); } let make_shallow s = { s with system = System.Stm.make_shallow s.system } let unfreeze_interp_state { system; lemmas; program; opaques } = do_if_not_cached s_cache System.unfreeze system; s_lemmas := lemmas; s_program := program; Opaques.Summary.unfreeze opaques end type t = { synterp: Synterp.t ; interp: Interp.t } let freeze_full_state () = { synterp = Synterp.freeze (); interp = Interp.freeze_interp_state (); } let unfreeze_full_state st = NewProfile.profile "unfreeze_full_state" (fun () -> Synterp.unfreeze st.synterp; Interp.unfreeze_interp_state st.interp) () (* Compatibility module *) module Declare_ = struct let get_program () = !s_program let set (pstate,pm) = s_lemmas := pstate; s_program := pm let get_pstate () = Option.map (LemmaStack.with_top ~f:(fun x -> x)) !s_lemmas let unfreeze x = s_lemmas := Some x exception NoCurrentProof let () = CErrors.register_handler begin function | NoCurrentProof -> Some (Pp.(str "No focused proof (No proof-editing in progress).")) | _ -> None end let cc f = match !s_lemmas with | None -> raise NoCurrentProof | Some x -> LemmaStack.with_top ~f x let cc_stack f = match !s_lemmas with | None -> raise NoCurrentProof | Some x -> f x let dd f = match !s_lemmas with | None -> raise NoCurrentProof | Some x -> s_lemmas := Some (LemmaStack.map_top ~f x) let there_are_pending_proofs () = !s_lemmas <> None let get_open_goals () = cc Declare.Proof.get_open_goals let give_me_the_proof_opt () = Option.map (LemmaStack.with_top ~f:Declare.Proof.get) !s_lemmas let give_me_the_proof () = cc Declare.Proof.get let get_current_proof_name () = cc Declare.Proof.get_name let map_proof f = dd (Declare.Proof.map ~f) let with_current_proof f = match !s_lemmas with | None -> raise NoCurrentProof | Some stack -> let pf, res = LemmaStack.with_top stack ~f:(Declare.Proof.map_fold_endline ~f) in let stack = LemmaStack.map_top stack ~f:(fun _ -> pf) in s_lemmas := Some stack; res let return_proof () = cc Declare.Proof.return_proof let close_future_proof ~feedback_id pf = NewProfile.profile "close_future_proof" (fun () -> cc (fun pt -> Declare.Proof.close_future_proof ~feedback_id pt pf)) () let close_proof ~opaque ~keep_body_ucst_separate = NewProfile.profile "close_proof" (fun () -> cc (fun pt -> Declare.Proof.close_proof ~opaque ~keep_body_ucst_separate pt)) () let discard_all () = s_lemmas := None let update_sigma_univs ugraph = dd (Declare.Proof.update_sigma_univs ugraph) let get_current_context () = cc Declare.Proof.get_current_context let get_all_proof_names () = try cc_stack LemmaStack.get_all_proof_names with NoCurrentProof -> [] let copy_terminators ~src ~tgt = match src, tgt with | None, None -> None | Some _ , None -> None | None, Some x -> Some x | Some src, Some tgt -> Some (LemmaStack.copy_info ~src ~tgt) end (* STM-specific state-handling *) module Stm = struct (* Proof-related state, for workers; ideally the two counters would be contained in the lemmas state themselves, as there is no need for evar / metas to be global among proofs *) type nonrec pstate = LemmaStack.t option * int * (* Evarutil.meta_counter_summary_tag *) int (* Evd.evar_counter_summary_tag *) (* Parts of the system state that are morally part of the proof state *) let pstate { interp = { lemmas; system }} = let st = Interp.System.Stm.summary system in lemmas, Summary.Interp.project_from_summary st Evarutil.meta_counter_summary_tag, Summary.Interp.project_from_summary st Evd.evar_counter_summary_tag let set_pstate ({ interp = { lemmas; system } } as s) (pstate,c1,c2) = { s with interp = { s.interp with lemmas = Declare_.copy_terminators ~src:s.interp.lemmas ~tgt:pstate ; system = Interp.System.Stm.replace_summary s.interp.system begin let st = Interp.System.Stm.summary s.interp.system in let st = Summary.Interp.modify_summary st Evarutil.meta_counter_summary_tag c1 in let st = Summary.Interp.modify_summary st Evd.evar_counter_summary_tag c2 in st end } } type non_pstate = Summary.Synterp.frozen * Lib.Synterp.frozen * Summary.Interp.frozen * Lib.Interp.frozen let non_pstate { synterp; interp } = let system = interp.system in let st = Interp.System.Stm.summary system in let st = Summary.Interp.remove_from_summary st Evarutil.meta_counter_summary_tag in let st = Summary.Interp.remove_from_summary st Evd.evar_counter_summary_tag in Synterp.Stm.summary synterp, Synterp.Stm.lib synterp, st, Interp.System.Stm.lib system let same_env { interp = { system = s1 } } { interp = { system = s2 } } = let s1 = Interp.System.Stm.summary s1 in let e1 = Summary.Interp.project_from_summary s1 Global.global_env_summary_tag in let s2 = Interp.System.Stm.summary s2 in let e2 = Summary.Interp.project_from_summary s2 Global.global_env_summary_tag in e1 == e2 let make_shallow st = { interp = Interp.make_shallow st.interp ; synterp = Synterp.Stm.make_shallow st.synterp } end module Declare = Declare_ coq-8.20.0/vernac/vernacstate.mli000066400000000000000000000103771466560755400167150ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* t val freeze : unit -> t val unfreeze : t -> unit val parsing : t -> Pcoq.frozen_t end module System : sig (** [protect f x] runs [f x] and discards changes in the system state (both [Synterp.t] and [Interp.System.t]). It doesn't touch the proof functional state in [Interp.t] *) val protect : ('a -> 'b) -> 'a -> 'b end module LemmaStack : sig type t val pop : t -> Declare.Proof.t * t option val push : t option -> Declare.Proof.t -> t val map : f:(Declare.Proof.t -> Declare.Proof.t) -> t -> t val map_top : f:(Declare.Proof.t -> Declare.Proof.t) -> t -> t val with_top : t -> f:(Declare.Proof.t -> 'a ) -> 'a val get_top : t -> Declare.Proof.t val get_all_proof_names : t -> Names.Id.t list end module Interp : sig module System : sig type t end type t = { system : System.t (** summary + libstack *) ; lemmas : LemmaStack.t option (** proofs of lemmas currently opened *) ; program : Declare.OblState.t NeList.t (** program mode table. One per open module/section including the toplevel module. *) ; opaques : Opaques.Summary.t (** qed-terminated proofs *) } val freeze_interp_state : unit -> t val unfreeze_interp_state : t -> unit (* WARNING: Do not use, it will go away in future releases *) val invalidate_cache : unit -> unit end type t = { synterp: Synterp.t ; interp: Interp.t } val freeze_full_state : unit -> t val unfreeze_full_state : t -> unit (** STM-specific state handling *) module Stm : sig (** Proof state + meta/evar counters *) type pstate val pstate : t -> pstate val set_pstate : t -> pstate -> t (** Rest of the state, unfortunately this is used in low-level so we need to expose it *) type non_pstate = Summary.Synterp.frozen * Lib.Synterp.frozen * Summary.Interp.frozen * Lib.Interp.frozen val non_pstate : t -> non_pstate (** Checks if two states have the same Environ.env (physical eq) *) val same_env : t -> t -> bool (** Call [Lib.drop_objects] on the state *) val make_shallow : t -> t end (* Compatibility module: Do Not Use *) module Declare : sig exception NoCurrentProof val there_are_pending_proofs : unit -> bool val get_open_goals : unit -> int val give_me_the_proof : unit -> Proof.t val give_me_the_proof_opt : unit -> Proof.t option val get_current_proof_name : unit -> Names.Id.t val map_proof : (Proof.t -> Proof.t) -> unit val with_current_proof : (unit Proofview.tactic -> Proof.t -> Proof.t * 'a) -> 'a val return_proof : unit -> Declare.Proof.closed_proof_output val close_future_proof : feedback_id:Stateid.t -> Declare.Proof.closed_proof_output Future.computation -> Declare.Proof.proof_object val close_proof : opaque:Vernacexpr.opacity_flag -> keep_body_ucst_separate:bool -> Declare.Proof.proof_object val discard_all : unit -> unit val update_sigma_univs : UGraph.t -> unit val get_current_context : unit -> Evd.evar_map * Environ.env val get_all_proof_names : unit -> Names.Id.t list val copy_terminators : src:LemmaStack.t option -> tgt:LemmaStack.t option -> LemmaStack.t option (* Low-level stuff *) val get_program : unit -> Declare.OblState.t NeList.t val set : LemmaStack.t option * Declare.OblState.t NeList.t -> unit val get_pstate : unit -> Declare.Proof.t option val unfreeze : LemmaStack.t -> unit end [@@ocaml.deprecated "This module is internal and should not be used, instead, thread the proof state"] coq-8.20.0/vernac/vernactypes.ml000066400000000000000000000152171466560755400165660ustar00rootroot00000000000000 (** [('a,'b,'x) runner] means that any function taking ['a] and returning ['b] and some additional data can be interpreted as a function on a state ['x]. The additional return data ['d] is useful when combining runners. We don't need an additional input data as it can just go in the closure. *) type ('a,'b,'x) runner = { run : 'd. 'x -> ('a -> 'b * 'd) -> 'x * 'd } module Prog = struct type state = Declare.OblState.t type stack = state NeList.t type (_,_) t = | Ignore : (unit, unit) t | Modify : (state, state) t | Read : (state, unit) t | Push : (unit, unit) t | Pop : (state, unit) t let runner (type a b) (ty:(a,b) t) : (a,b,stack) runner = { run = fun pm f -> match ty with | Ignore -> let (), v = f () in pm, v | Modify -> let st, pm = NeList.repr pm in let st, v = f st in NeList.of_repr (st,pm), v | Read -> let (), v = f (NeList.head pm) in pm, v | Push -> let (), v = f () in NeList.push Declare.OblState.empty (Some pm), v | Pop -> let st, pm = NeList.repr pm in assert (not (CList.is_empty pm)); let (), v = f st in NeList.of_list pm, v } end module Proof = struct module LStack = Vernacstate.LemmaStack type state = Declare.Proof.t type stack = LStack.t option type (_,_) t = | Ignore : (unit, unit) t | Modify : (state, state) t | Read : (state, unit) t | ReadOpt : (state option, unit) t | Reject : (unit, unit) t | Close : (state, unit) t | Open : (unit, state) t let use = function | None -> CErrors.user_err (Pp.str "Command not supported (No proof-editing in progress).") | Some stack -> LStack.pop stack let runner (type a b) (ty:(a,b) t) : (a,b,stack) runner = { run = fun stack f -> match ty with | Ignore -> let (), v = f () in stack, v | Modify -> let p, rest = use stack in let p, v = f p in Some (LStack.push rest p), v | Read -> let p, _ = use stack in let (), v = f p in stack, v | ReadOpt -> let p = Option.map LStack.get_top stack in let (), v = f p in stack, v | Reject -> let () = if Option.has_some stack then CErrors.user_err (Pp.str "Command not supported (Open proofs remain).") in let (), v = f () in stack, v | Close -> let p, rest = use stack in let (), v = f p in rest, v | Open -> let p, v = f () in Some (LStack.push stack p), v } end module OpaqueAccess = struct (* Modification of opaque tables (by Require registering foreign tables and Qed/abstract/etc adding entries to the local table) is currently not tracked by vernactypes. *) type _ t = | Ignore : unit t | Access : Global.indirect_accessor t let access = Library.indirect_accessor[@@warning "-3"] let runner (type a) (ty:a t) : (a,unit,unit) runner = { run = fun () f -> match ty with | Ignore -> let (), v = f () in (), v | Access -> let (), v = f access in (), v } end (* lots of messing with tuples in there, can we do better? *) let combine_runners (type a b x c d y) (r1:(a,b,x) runner) (r2:(c,d,y) runner) : (a*c, b*d, x*y) runner = { run = fun (x,y) f -> match r1.run x @@ fun x -> match r2.run y @@ fun y -> match f (x,y) with ((b, d), o) -> (d, (b, o)) with (y, (b, o)) -> (b, (y, o)) with (x, (y, o)) -> ((x, y), o) } type ('prog,'proof,'opaque_access) state_gen = { prog : 'prog; proof : 'proof; opaque_access : 'opaque_access; } let tuple { prog; proof; opaque_access } = (prog, proof), opaque_access let untuple ((prog, proof), opaque_access) = { prog; proof; opaque_access } type no_state = (unit, unit, unit) state_gen let no_state = { prog = (); proof = (); opaque_access = (); } let ignore_state = { prog = Prog.Ignore; proof = Proof.Ignore; opaque_access = OpaqueAccess.Ignore } type 'r typed_vernac_gen = TypedVernac : { spec : (('inprog, 'outprog) Prog.t, ('inproof, 'outproof) Proof.t, 'inaccess OpaqueAccess.t) state_gen; run : ('inprog, 'inproof, 'inaccess) state_gen -> ('outprog, 'outproof, unit) state_gen * 'r; } -> 'r typed_vernac_gen let map_typed_vernac f (TypedVernac {spec; run}) = TypedVernac {spec; run = (fun st -> Util.on_snd f (run st)) } type typed_vernac = unit typed_vernac_gen type full_state = (Prog.stack,Vernacstate.LemmaStack.t option,unit) state_gen let run (TypedVernac { spec = { prog; proof; opaque_access }; run }) (st:full_state) : full_state * _ = let ( * ) = combine_runners in let runner = Prog.runner prog * Proof.runner proof * OpaqueAccess.runner opaque_access in let st, v = runner.run (tuple st) @@ fun st -> let st, v= run @@ untuple st in tuple st, v in untuple st, v let typed_vernac_gen spec run = TypedVernac { spec; run } let typed_vernac spec run = TypedVernac { spec; run = (fun st -> run st, () ) } let vtdefault f = typed_vernac ignore_state (fun (_:no_state) -> let () = f () in no_state) let vtnoproof f = typed_vernac { ignore_state with proof = Reject } (fun (_:no_state) -> let () = f () in no_state) let vtcloseproof f = typed_vernac { ignore_state with prog = Modify; proof = Close } (fun {prog; proof} -> let prog = f ~lemma:proof ~pm:prog in { no_state with prog }) let vtopenproof f = typed_vernac { ignore_state with proof = Open } (fun (_:no_state) -> let proof = f () in { no_state with proof }) let vtmodifyproof f = typed_vernac { ignore_state with proof = Modify } (fun {proof} -> let proof = f ~pstate:proof in { no_state with proof }) let vtreadproofopt f = typed_vernac { ignore_state with proof = ReadOpt } (fun {proof} -> let () = f ~pstate:proof in no_state) let vtreadproof f = typed_vernac { ignore_state with proof = Read } (fun {proof} -> let () = f ~pstate:proof in no_state) let vtreadprogram f = typed_vernac { ignore_state with prog = Read } (fun {prog} -> let () = f ~pm:prog in no_state) let vtmodifyprogram f = typed_vernac { ignore_state with prog = Modify } (fun {prog} -> let prog = f ~pm:prog in { no_state with prog }) let vtdeclareprogram f = typed_vernac { ignore_state with prog = Read; proof = Open } (fun {prog} -> let proof = f ~pm:prog in { no_state with proof }) let vtopenproofprogram f = typed_vernac { ignore_state with prog = Modify; proof = Open } (fun {prog} -> let prog, proof = f ~pm:prog in { no_state with prog; proof; }) let vtopaqueaccess f = typed_vernac { ignore_state with opaque_access = Access } (fun {opaque_access} -> let () = f ~opaque_access in no_state) coq-8.20.0/vernac/vernactypes.mli000066400000000000000000000073271466560755400167420ustar00rootroot00000000000000(************************************************************************) (* * The Coq Proof Assistant / The Coq Development Team *) (* v * Copyright INRIA, CNRS and contributors *) (* ('outprog, 'outproof, unit) state_gen * 'r; } -> 'r typed_vernac_gen type typed_vernac = unit typed_vernac_gen val typed_vernac_gen : (('inprog, 'outprog) Prog.t, ('inproof, 'outproof) Proof.t, 'inaccess OpaqueAccess.t) state_gen -> (('inprog, 'inproof, 'inaccess) state_gen -> ('outprog, 'outproof, unit) state_gen * 'r) -> 'r typed_vernac_gen val map_typed_vernac : ('a -> 'b) -> 'a typed_vernac_gen -> 'b typed_vernac_gen val typed_vernac : (('inprog, 'outprog) Prog.t, ('inproof, 'outproof) Proof.t, 'inaccess OpaqueAccess.t) state_gen -> (('inprog, 'inproof, 'inaccess) state_gen -> ('outprog, 'outproof, unit) state_gen) -> typed_vernac type full_state = (Prog.stack, Vernacstate.LemmaStack.t option, unit) state_gen val run : 'r typed_vernac_gen -> full_state -> full_state * 'r (** Some convenient typed_vernac constructors. Used by coqpp. *) val vtdefault : (unit -> unit) -> typed_vernac val vtnoproof : (unit -> unit) -> typed_vernac val vtcloseproof : (lemma:Declare.Proof.t -> pm:Declare.OblState.t -> Declare.OblState.t) -> typed_vernac val vtopenproof : (unit -> Declare.Proof.t) -> typed_vernac val vtmodifyproof : (pstate:Declare.Proof.t -> Declare.Proof.t) -> typed_vernac val vtreadproofopt : (pstate:Declare.Proof.t option -> unit) -> typed_vernac val vtreadproof : (pstate:Declare.Proof.t -> unit) -> typed_vernac val vtreadprogram : (pm:Declare.OblState.t -> unit) -> typed_vernac val vtmodifyprogram : (pm:Declare.OblState.t -> Declare.OblState.t) -> typed_vernac val vtdeclareprogram : (pm:Declare.OblState.t -> Declare.Proof.t) -> typed_vernac val vtopenproofprogram : (pm:Declare.OblState.t -> Declare.OblState.t * Declare.Proof.t) -> typed_vernac val vtopaqueaccess : (opaque_access:Global.indirect_accessor -> unit) -> typed_vernac
    • {{ _('Versions') }}
    {% for slug, url in versions %}
    {{ slug }}
    {% endfor %}
    {{ _('Downloads') }}
    {% for type, url in downloads %}
    {{ type }}
    {% endfor %}